1722 files changed, 300779 insertions, 20889 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..e81d4a3
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+_build
+*.sw?
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..a986f6c
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,21 @@
+all: _build/index.html
+
+_build:
+	mkdir -p $@
+	find app devel doc/ lang system -mindepth 4 -type f | grep '/src/' | parallel 'tools/highlight.py {}'
+
+_build/packages.rst: | _build
+	tools/makeindex.py > $@
+
+_build/index.html: README.rst _build/packages.rst
+	rst2html5.py --cloak-email-addresses --math-output=mathjax \
+		--syntax-highlight=short --link-stylesheet \
+		--stylesheet=../../style.min.css \
+		--template=./template.txt \
+		--footnote-references=superscript < README.rst > $@
+
+.PHONY: clean _build/packages.rst
+
+clean:
+	$(RM) -r _build
+
diff --git a/README.rst b/README.rst
new file mode 100644
index 0000000..f9dba99
--- /dev/null
+++ b/README.rst
@@ -0,0 +1,46 @@
+EUMEL source code
+=================
+
+Source code and documentation for the `EUMEL operating system`_. Most files
+have been extracted from archive disks using `EUMEL utilities`_.
+
+.. _EUMEL operating system: https://6xq.net/eumel/
+.. _EUMEL utilities: https://github.com/PromyLOPh/eumel-tools
+
+`This repository`_ is organized as follows:
+
+.. _This repository: https://github.com/PromyLOPh/eumel-src
+
+``<category>/<package>/<version>/{data,doc,src}``
+
+*Category* is one of these:
+
+app
+    User applications
+devel
+    Developer tools, mainly for debugging the system
+doc
+    Documentation for EUMEL, not belonging to any package
+lang
+    Programming language support (BASIC, PROLOG, LISP, DYNAMO)
+system
+    System packages (base, printer, …)
+
+*Package* is the software’s name (not to be confused by EUMEL’s packet
+concept), *version* is the package’s version (sometimes a best-guess) and these
+subdirectories may exist inside each version directory:
+
+data
+    Supplementary dataspaces
+doc
+    Documentation, usually EUMEL text files
+src
+    Source code, usually ELAN or assembly
+
+.. contents::
+
+Packages
+--------
+
+.. include:: _build/packages.rst
+
diff --git a/app/baisy/2.2.1-schulis/source-disk b/app/baisy/2.2.1-schulis/source-disk
new file mode 100644
index 0000000..17b0588
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/source-disk
@@ -0,0 +1 @@
+schulis-grundpaket-schulverwaltung-2.2.1/02_baisy-quellen.img
diff --git a/app/baisy/2.2.1-schulis/src/ANWENDUNG.files b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files
new file mode 100644
index 0000000..40d187b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files
@@ -0,0 +1,3 @@
+db reorganisation auftrag 
+logbuch verwaltung
+
diff --git a/app/baisy/2.2.1-schulis/src/BAISY SERVER.files b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files
new file mode 100644
index 0000000..d1cc99f
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files
@@ -0,0 +1,6 @@
+longrow 
+systembaum 
+isp.systembaumbearbeitung
+maskenverarbeitung 
+isp.baisy server
+
diff --git a/app/baisy/2.2.1-schulis/src/BASIS.files b/app/baisy/2.2.1-schulis/src/BASIS.files
new file mode 100644
index 0000000..f04fa3c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/BASIS.files
@@ -0,0 +1,7 @@
+db dd.sc 
+db phon.sc 
+db parse.sc 
+f packet.sc 
+isp.masken 
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DB REORG.files b/app/baisy/2.2.1-schulis/src/DB REORG.files
new file mode 100644
index 0000000..04f7bd7
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DB REORG.files
@@ -0,0 +1,5 @@
+db utils.sc 
+db reorg.sc 
+db reorganisation manager 
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DB.files b/app/baisy/2.2.1-schulis/src/DB.files
new file mode 100644
index 0000000..5ea703b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DB.files
@@ -0,0 +1,16 @@
+db fetch.baisy
+db kernel.sc 
+isp.init baisy server 
+isp.manager schnittstelle
+isp.schulis db nummern
+log.eintrag
+maskenerweiterung
+baisyio
+isp.meldungsfunktionen 
+isp.knoten
+sybifunktionen
+editorfunktionen 
+auskunftsfenster
+isp.auskunftsfunktionen
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DOS.files b/app/baisy/2.2.1-schulis/src/DOS.files
new file mode 100644
index 0000000..ff4d45c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DOS.files
@@ -0,0 +1,22 @@
+dump
+konvert
+open
+eu disk descriptor
+disk descriptor.dos
+block i/o
+name conversion.dos
+fat.dos
+dir.dos
+get put interface.dos
+fetch save interface
+fetch
+save
+manager/M.dos
+manager/S.dos
+bpb ds
+shard interface
+insert.dos
+dos hd inserter
+dos inserter
+
+
diff --git a/app/baisy/2.2.1-schulis/src/SICHERUNG.files b/app/baisy/2.2.1-schulis/src/SICHERUNG.files
new file mode 100644
index 0000000..d082e14
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/SICHERUNG.files
@@ -0,0 +1,8 @@
+db ddinfo.sc 
+isp.zusatz archive packet 
+db utils.sc
+isp archive.sc
+db archive.sc
+isp.monitor sicherungstask 
+
+
diff --git a/app/baisy/2.2.1-schulis/src/STANDARD.files b/app/baisy/2.2.1-schulis/src/STANDARD.files
new file mode 100644
index 0000000..0a0c982
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/STANDARD.files
@@ -0,0 +1,16 @@
+plausipruefung
+thesaurusfunktionen
+isp.standardmaskenbehandlung
+isp.benutzerberechtigungen
+umgebungswechsel manager
+systembauminterpreter
+aufruf manager
+standarddialog
+isp.sicherungsmonitor
+db scan
+allgemeine grundfunktionen 
+isp.objektliste
+isp.erf.steueroperationen
+isp.erf.abkuerzungen
+isp.erf.benutzerberechtigungen 
+
diff --git a/app/baisy/2.2.1-schulis/src/WERKZEUGE.files b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files
new file mode 100644
index 0000000..cf1f4f2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files
@@ -0,0 +1,8 @@
+isp.systembaumeditor
+schulis kommandobehandlung
+isp.maskendesign
+isp.erf.meldungen
+erf.auskuenfte
+isp.auskunftseditor
+new monitor baisy
+
diff --git a/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen
new file mode 100644
index 0000000..7d3b4c5
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen
@@ -0,0 +1,35 @@
+PACKET allgemeinegrundfunktionenDEFINES statleseschleife,rechtstext,
+aenderungsvermerksetzen,geplanteshjundsjberechnen,textnichtnull,jgstaufber,
+eingabenummerisch:LET sgaenderung="c02 aenderungsvermerk",schlakt="aktuell",
+schlgepl="geplant",blank=" ";PROC statleseschleife(INT CONST indexnummer,
+TEXT CONST startschluessel1,startschluessel2,INT CONST feldnr1,feldnr2,PROC (
+BOOL VAR )stataktion):vorbereitungen;leseschleife.vorbereitungen:LET 
+maxleseanzahl=10;BOOL VAR vorzeitigesende:=FALSE ;INT VAR anzahltupel;.
+leseschleife:putwert(feldnr1,startschluessel1);putwert(feldnr2,
+startschluessel2);search(indexnummer);IF dbstatus=0THEN einleseschleifeFI .
+einleseschleife:zaehlen;WHILE NOT schlussREP anzahltupel:=maxleseanzahl;
+multisucc(indexnummer,anzahltupel);stackdurchlaufPER ;.stackdurchlauf:IF 
+anzahltupel=0THEN dbstatus(1)ELSE WHILE anzahltupel<>0REP lesen;zaehlen;IF 
+vorzeitigesendeTHEN dbstatus(1);anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0
+.zaehlen:stataktion(vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END 
+PROC statleseschleife;TEXT PROC rechtstext(TEXT CONST t,INT CONST laenge):((
+laenge-length(t))*" ")+tEND PROC rechtstext;PROC aenderungsvermerksetzen(
+TEXT CONST schlwert):IF schlwert<>schlaktCAND schlwert<>schlgeplTHEN LEAVE 
+aenderungsvermerksetzenFI ;inittupel(dnrschluessel);putwert(fnrschlsachgebiet
+,sgaenderung);putwert(fnrschlschluessel,schlwert);search(dnrschluessel,TRUE )
+;IF dbstatus=okTHEN putwert(fnrschllangtext,date+blank+timeofday);update(
+dnrschluessel)ELSE putwert(fnrschlsachgebiet,sgaenderung);putwert(
+fnrschlschluessel,schlwert);putwert(fnrschllangtext,date+blank+timeofday);
+insert(dnrschluessel)FI END PROC aenderungsvermerksetzen;PROC 
+geplanteshjundsjberechnen(TEXT VAR halbjahr,schuljahr):TEXT VAR hilfe;IF 
+halbjahr="1"THEN halbjahr:="2";ELSE halbjahr:="1";schuljahr:=subtext(
+schuljahr,3);hilfe:=text(int(schuljahr)+1);schuljahrCAT subtext("0"+hilfe,
+LENGTH (hilfe))FI END PROC geplanteshjundsjberechnen;TEXT PROC textnichtnull(
+TEXT CONST txt):TEXT VAR t:=txt;IF t=length(t)*"0"THEN t:=""FI ;tEND PROC 
+textnichtnull;TEXT PROC jgstaufber(TEXT CONST jgst):LET erstestellejgst="0",
+maxsek1=10;INT VAR ijgst:=int(jgst);IF ijgst>=maxsek1THEN jgstELIF ijgst=0
+THEN ""ELSE erstestellejgst+text(ijgst)FI END PROC jgstaufber;BOOL PROC 
+eingabenummerisch(TEXT CONST t):INT VAR lv;FOR lvFROM 1UPTO length(t)REP IF 
+pos("0123456789",tSUB lv)=0THEN LEAVE eingabenummerischWITH FALSE FI PER ;
+TRUE END PROC eingabenummerisch;END PACKET allgemeinegrundfunktionen
+
diff --git a/app/baisy/2.2.1-schulis/src/aufruf manager b/app/baisy/2.2.1-schulis/src/aufruf manager
new file mode 100644
index 0000000..9577a95
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/aufruf manager
@@ -0,0 +1,39 @@
+PACKET aufrufmanagerDEFINES starteaufrufmanager:LET ack=0,nak=1,naksingletask
+=2;LET modussingleuser=1;PROC starteaufrufmanager:starteaufrufmanager(0)END 
+PROC starteaufrufmanager;PROC starteaufrufmanager(INT CONST modus):TASK VAR 
+sohn;initialisiere;REP warteaufdatenbankkennungundkanal;IF korrektTHEN 
+gruendesohntaskmitkanalnrunddatenbankkennungFI PER .initialisiere:break;
+disablestop;setautonom;initsybifunktionen;.warteaufdatenbankkennungundkanal:
+TASK VAR sender;INT VAR kanalnr;DATASPACE VAR datenbankkennung;clearerror;
+wait(datenbankkennung,kanalnr,sender).korrekt:NOT iserror.
+gruendesohntaskmitkanalnrunddatenbankkennung:IF modus=modussingleuserCAND 
+sohntaskschoneingerichtetTHEN quittung:=naksingletask;send(sender,quittung,
+niltask)ELSE gruendesohntask;meldesohnnameansenderFI .gruendesohntask:
+gruenden;IF korrektTHEN mitkanalnrunddatenbankkennungversorgenFI .gruenden:
+begin(PROC stellvertreter,sohn).mitkanalnrunddatenbankkennungversorgen:BOOL 
+VAR erfolg;call(sohn,kanalnr,datenbankkennung,erfolg).meldesohnnameansender:
+INT VAR quittung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;send(sender
+,quittung,sohn).END PROC starteaufrufmanager;BOOL PROC 
+sohntaskschoneingerichtet:accesscatalogue;exists(son(myself))END PROC 
+sohntaskschoneingerichtet;PROC stellvertreter:
+warteaufkanalnrunddatenbankkennung;geheaufkanalundsetzewerte;IF erfolgTHEN 
+warteaufauftrag;fuehreauftragausFI ;selbstmord.erfolg:NOT iserror.selbstmord:
+end(myself).warteaufkanalnrunddatenbankkennung:disablestop;DATASPACE VAR ds;
+TASK VAR vater;INT VAR kanalnr;wait(ds,kanalnr,vater).
+geheaufkanalundsetzewerte:INT VAR quittung;IF erfolgTHEN #quittung:=ack;
+oeffnedatenbank(ds)#datenbankeneroeffnenELSE quittung:=nakFI ;continue(
+kanalnr);send(vater,quittung,ds);forget(ds);initmeldungsfunktionen.
+datenbankeneroeffnen:oeffnedatenbank;fetchdd(schulisdbname);IF dbopen(
+schulisdbname)THEN systemdboff;quittung:=ackELSE quittung:=nakFI .
+warteaufauftrag:INT VAR knotenname;TASK VAR auftraggeber;REP wait(ds,
+knotenname,auftraggeber)UNTIL korrekterauftragPER .korrekterauftrag:
+knotenname>0.fuehreauftragaus:setzesystembaumundaktuellenknoten(ds,knotenname
+);starteanwendung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;break(
+quiet);send(auftraggeber,quittung,ds);forget(ds).END PROC stellvertreter;
+PROC call(TASK CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,BOOL VAR 
+erfolg):INT VAR replycode;call(zielmanager,kanal,ds,replycode);erfolg:=
+replycode=ack;forget(ds)END PROC call;PROC send(TASK CONST sender,INT CONST 
+quittung,TASK CONST sohn):DATASPACE VAR ds:=nilspace;IF quittung=ackTHEN 
+BOUND TASK VAR t:=ds;t:=sohnFI ;send(sender,quittung,ds);forget(ds)END PROC 
+send;END PACKET aufrufmanager;
+
diff --git a/app/baisy/2.2.1-schulis/src/auskunftsfenster b/app/baisy/2.2.1-schulis/src/auskunftsfenster
new file mode 100644
index 0000000..855f1a3
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/auskunftsfenster
@@ -0,0 +1,126 @@
+PACKET auskunftsfensterDEFINES WINDOW ,:=,=,shrink,grow,open,startwindow,
+auskunfterteilung,encode,subtext,textschonmalzeigen:LET zeilenlimit=200,#
+maxauskfeld=6,##editorfenster=78,#eol="�",stop="�",hop="�",#cr="
",#up="�",
+down="
+",esc="�",right="�",left="�";#escape=27,frage="?",halt="h",vor="+",
+zurueck="-",cleol="�";#LET cshrink=45,cgrow=43;TYPE WINDOW =STRUCT (INT lux,
+luy,rox,roy);BOOL VAR fuereditor:=FALSE ;BOOL OP =(WINDOW CONST v,w):((v.lux=
+w.lux)AND (v.luy=w.luy))AND ((v.rox=w.rox)AND (v.roy=w.roy))END OP =;OP :=(
+WINDOW VAR v,WINDOW CONST w):CONCR (v):=CONCR (w)END OP :=;WINDOW PROC 
+startwindow(INT CONST u,v,w,x):WINDOW :(u,v,w,x)END PROC startwindow;PROC 
+grow(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.lux)<=2THEN nx1:=w.lux;ELSE 
+nx1:=w.lux-2FI ;IF (w.rox)>=77THEN nx2:=w.rox;ELSE nx2:=w.rox+2FI ;IF (w.luy)
+=24THEN ny1:=w.luy;ELSE ny1:=w.luy+1FI ;IF (w.roy)=1THEN ny2:=w.roy;ELSE ny2
+:=w.roy-1FI ;WINDOW VAR v:=WINDOW :(nx1,ny1,nx2,ny2);w:=vEND PROC grow;PROC 
+shrink(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.roy+3)>=w.luyTHEN ny1:=w.
+luy;ny2:=w.roy;ELSE ny1:=w.luy-1;ny2:=w.roy+1;FI ;IF (w.lux+7)>=w.roxTHEN nx1
+:=w.lux;nx2:=w.roxELSE nx1:=w.lux+2;nx2:=w.rox-2FI ;WINDOW VAR v:=WINDOW :(
+nx1,ny1,nx2,ny2);erase(w);loeschespalte(w.rox-1,w);loeschespalte(w.lux+1,w);
+loeschespalte(w.rox+1,w);w:=vEND PROC shrink;PROC erase(WINDOW CONST w):
+loeschespalte(w.lux,w);loeschespalte(w.rox+2,w);loeschezeile(w.roy,w);
+loeschezeile(w.luy,w);END PROC erase;PROC open(WINDOW CONST w):INT VAR x1:=w.
+lux,y1:=w.luy,x2:=w.rox,y2:=w.roy;oeffnefenster(x1,y1,x2,y2)END PROC open;
+PROC unterlegung(INT CONST i,j):TEXT VAR grund;IF fuereditorTHEN cursor(j,i);
+grund:=(editorunterlegung(i)SUB j);IF grund=""THEN grund:=" "FI ;out(grund)
+ELSE reorganizescreen(i,j,j)FI END PROC unterlegung;PROC loeschespalte(INT 
+CONST col,WINDOW CONST w):INT VAR from,to;from:=w.roy;to:=w.luy;INT VAR i;
+FOR iFROM fromUPTO toREP unterlegung(i,col)PER END PROC loeschespalte;PROC 
+loeschezeile(INT CONST row,WINDOW CONST w):INT VAR from,to,lg,geslg;from:=w.
+lux;to:=w.rox;IF fuereditorTHEN cursor(from,row);TEXT CONST grund:=subtext(
+editorunterlegung(row),from,to+1);lg:=to-from+2;geslg:=length(grund);IF geslg
+<lgTHEN out(text(grund,lg))ELSE out(grund)FI ELSE reorganizescreen(row,from,
+to+1)FI END PROC loeschezeile;BOOL VAR nurschau:=FALSE ;PROC 
+textschonmalzeigen(TEXT CONST t,WINDOW VAR w,BOOL CONST editorwunsch):TEXT 
+VAR ausk:=t;nurschau:=TRUE ;auskunfterteilung(ausk,w,editorwunsch);nurschau:=
+FALSE END PROC textschonmalzeigen;PROC auskunfterteilung(TEXT VAR auskunft,
+WINDOW CONST v,BOOL CONST editorwunsch):initialisiere;
+auskunfterteilunganbenutzer;liefereevtlgewaehltenzeilenausschnitt.
+auskunfterteilunganbenutzer:REP warteaufreaktion;IF NOT nochinteresseTHEN 
+LEAVE auskunfterteilunganbenutzerFI ;zeigefensterPER .zeigefenster:
+bestimmeneuecursorposition;IF ausbereichgeratenTHEN bauefensterneuaufFI .
+bauefensterneuauf:IF seitenwechselCAND (interesse=down)THEN IF bottom>=lTHEN 
+LEAVE zeigefensterFI ;ELIF (interesse=down)THEN IF (bottom>=l)THEN LEAVE 
+zeigefensterFI ;seitenanfang:=aktuellezeile-zeilenzahl+2;zeigersetzen;ELSE 
+initialisiereseiteneu;IF seitenwechselCAND (interesse=up)THEN IF seitenanfang
+=1THEN LEAVE zeigefensterFI ;seitenanfang:=max(1,seitenanfang-zeilenzahl);
+zeigersetzenELIF (interesse=up)THEN IF seitenanfang=1THEN LEAVE zeigefenster
+FI ;seitenanfang:=seitenanfang-1;zeigersetzenELIF (interesse=hop)THEN 
+seitenanfang:=1;zeigersetzenELSE bereitefenstervor;zeigersetzenFI ;FI ;
+trageinfensterein;.initialisiereseiteneu:seitenanfang:=aktuellezeile-
+zeilenzahl+1.trageinfensterein:FOR iFROM 1UPTO zeilenzahlREP formatierezeile;
+schreibzeileinfensterPER ;cursor(posx,posy).zeigersetzen:bottom:=
+zeilenanfaenge(seitenanfang);aktuellezeile:=seitenanfang-1.initialisiere:
+WINDOW VAR w:=v;BOOL VAR ausbereichgeraten;INT VAR bottom:=1,top:=1,
+seitenanfang:=1;INT VAR aktuellezeile:=0;ROW zeilenlimitINT VAR 
+zeilenanfaenge;INT VAR i;BOOL VAR seitenwechsel:=TRUE ;TEXT VAR interesse:=
+down;INT VAR posy:=w.roy+1;INT VAR posx:=w.lux+3;fuereditor:=editorwunsch;
+bereitefenstervor;trageinfensterein;IF nurschauTHEN LEAVE auskunfterteilung
+FI .bestimmeneuecursorposition:cursor(w,interesse,seitenwechsel,posx,posy,
+ausbereichgeraten).bereitefenstervor:INT VAR x1:=w.lux,y1:=w.luy,x2:=w.rox,y2
+:=w.roy;INT CONST zeilenzahl:=y1-y2-1,spaltenzahl:=x2-x1-5;INT CONST l:=
+length(auskunft);TEXT CONST blankzeile:=spaltenzahl*" ";limito:=w.roy+1;
+limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3;.nochinteresse:(interesse<>
+esc).warteaufreaktion:seitenwechsel:=FALSE ;inchar(interesse);evtlschieben;
+IF geschobenTHEN open(w)FI ;IF hopbeginnTHEN seitenwechsel:=TRUE ;REP inchar(
+interesse)UNTIL erlaubtCOR hopbeginnPER ;FI .evtlschieben:BOOL VAR geschoben
+:=FALSE ;REP SELECT code(interesse)OF CASE cshrink:shrink(w)CASE cgrow:grow(w
+)OTHERWISE LEAVE evtlschiebenEND SELECT ;interesse:=incharety(2);geschoben:=
+TRUE PER .erlaubt:(interesse=up)COR (interesse=down)COR (interesse=left)COR (
+interesse=right).hopbeginn:interesse=hop.
+liefereevtlgewaehltenzeilenausschnitt:berechnezeilenincrement;IF NOT amanfang
+THEN berechnerelativzeile;TEXT VAR einkopiertext:=subtext(zeile,1,
+zeilenincrement);IF editorwunschTHEN type(einkopiertext)ELSE 
+inaktuellesmaskenfeld(einkopiertext)FI ELSE inaktuellesmaskenfeld("")FI .
+berechnezeilenincrement:INT VAR zeilenincrement:=posx-limitl;.amanfang:
+zeilenincrement=0.berechnerelativzeile:INT VAR relativzeile:=posy-limito+1;
+initialisiereseiteneu;zeigersetzen;FOR iFROM 1UPTO relativzeileREP 
+formatierezeilePER ;zeile:=text(zeile,spaltenzahl).formatierezeile:TEXT VAR 
+zeile:="";IF NOT blankbeabsichtigtTHEN bottomsuchenFI ;IF bottom>=lTHEN zeile
+:=blankzeileELSE top:=min(bottom+spaltenzahl-1,l);zeile:=subtext(auskunft,
+bottom,top,eol,stop,TRUE );topINCR 1FI ;aktuellezeileINCR 1;zeilenanfaenge(
+aktuellezeile):=bottom;bottom:=top.blankbeabsichtigt:subtext(auskunft,bottom-
+1,bottom-1)=stop.bottomsuchen:TEXT VAR bottomvergleich;WHILE (bottom<=l)REP 
+bottomvergleich:=subtext(auskunft,bottom,bottom);IF (bottomvergleich=" ")COR 
+(bottomvergleich=eol)THEN bottomINCR 1ELSE LEAVE bottomsuchenFI PER .
+schreibzeileinfenster:zeile:=text(zeile,spaltenzahl);cursor(x1+3,y2+i);out(
+zeile).END PROC auskunfterteilung;INT VAR limito,limitu,limitr,limitl;PROC 
+cursor(WINDOW CONST w,TEXT CONST interesse,BOOL CONST seitenwechsel,INT VAR 
+posx,posy,BOOL VAR ausbereichgeraten):limitssetzen;neueposition.limitssetzen:
+limito:=w.roy+1;limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3;
+ausbereichgeraten:=FALSE .neueposition:IF seitenwechselTHEN IF (interesse=
+left)THEN anzeilenanfangELSE IF (interesse=right)THEN anzeilenendeELSE IF (
+interesse=down)THEN eineseitevorELSE IF (interesse=up)THEN eineseitezurueck
+FI FI FI FI ELSE IF interesse=leftTHEN nachlinksELSE IF interesse=rightTHEN 
+nachrechtsELSE IF (interesse=down)THEN einezeilenachuntenELSE IF (interesse=
+up)THEN einezeilenachobenELSE cursornachlo;ausbereichgeraten:=TRUE FI FI FI 
+FI FI ;cursor(posx,posy).nachlinks:IF posx>limitlTHEN posxDECR 1FI .
+nachrechts:IF posx<limitrTHEN posxINCR 1FI .anzeilenanfang:posx:=limitl.
+anzeilenende:posx:=limitr.einezeilenachunten:IF posy<limituTHEN posyINCR 1
+ELSE cursornachlu;ausbereichgeraten:=TRUE FI .einezeilenachoben:IF posy>
+limitoTHEN posyDECR 1ELSE cursornachlo;ausbereichgeraten:=TRUE FI .
+eineseitevor:IF posy<limituTHEN posy:=limituELSE cursornachlu;
+ausbereichgeraten:=TRUE FI .eineseitezurueck:IF posy>limitoTHEN posy:=limito
+ELSE cursornachlo;ausbereichgeraten:=TRUE FI .cursornachlo:posx:=limitl;posy
+:=limito.cursornachlu:posx:=limitl;posy:=limitu.END PROC cursor;TEXT PROC 
+encode(TEXT CONST t):INT CONST max:=length(t);TEXT CONST vergleich:=subtext(t
+,max,max);IF vergleich=" "THEN subtext(t,1,max-1)+stopELSE t+eolFI END PROC 
+encode;TEXT PROC subtext(TEXT VAR auskunft,INT CONST bottom,INT VAR top,TEXT 
+CONST loe,TEXT CONST stp,BOOL CONST infenster):LET b=" ";TEXT VAR oberster;
+INT VAR lastblank;INT VAR i;TEXT VAR t,vergleich;konstruieret;t.konstruieret:
+FOR iFROM bottomUPTO topREP vergleich:=subtext(auskunft,i,i);IF vergleich=loe
+THEN IF NOT infensterTHEN t:=subtext(auskunft,bottom,i-1);top:=i;LEAVE 
+konstruieretFI ;replace(auskunft,i,b);lastblank:=iELIF vergleich=stpTHEN t:=
+subtext(auskunft,bottom,i-1);IF NOT infensterTHEN t:=t+bFI ;top:=i;LEAVE 
+konstruieretELIF vergleich=bTHEN lastblank:=iFI ;PER ;oberster:=subtext(
+auskunft,top+1,top+1);IF (lastblank<>top)CAND ((oberster<>b)CAND (oberster<>
+loe)CAND (oberster<>stp))THEN top:=lastblankFI ;t:=subtext(auskunft,bottom,
+top).END PROC subtext;PROC oeffnefenster(INT VAR x1,y1,x2,y2):
+zeichnegrundseite;zeichnezwischenlinien;zeichneunterseite.zeichnegrundseite:
+ermittlegrundkoordinaten;malepunkte.ermittlegrundkoordinaten:INT VAR x,y;x:=
+x1;y:=y2.malepunkte:INT VAR fensterbreite;fensterbreite:=x2-x1-1;cursor(x,y);
+out("");fensterbreite+2TIMESOUT " ";out("�").zeichnezwischenlinien:INT VAR 
+j,fensterlaenge;fensterbreiteDECR 2;fensterlaenge:=y1-y2;FOR jFROM 1UPTO 
+fensterlaenge-1REP yINCR 1;cursor(x,y);out(sp);fensterbreiteTIMESOUT " ";out(
+ep);PER .sp:" ".ep:" �".zeichneunterseite:yINCR 1;cursor(x,y);malepunkte.
+END PROC oeffnefenster;END PACKET auskunftsfenster
+
diff --git a/app/baisy/2.2.1-schulis/src/baisyio b/app/baisy/2.2.1-schulis/src/baisyio
new file mode 100644
index 0000000..d0dd294
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/baisyio
@@ -0,0 +1,51 @@
+PACKET baisyioDEFINES hardcopy,protected,protect,setzeschulisversion,
+schulisversion,get,putget,inaktuellesmaskenfeld,getcursorposfuerauskunft,
+bildschirmausdrucken:LET #variablenzahlklein=10,#variablenzahlgross=100,
+variablenzahlganzgross=200,cesc=27,cseiterueck=15,cseitevor=14,
+bildschirmausdruck="Bildschirm-Ausdruck",versilaenge=5,meldungsfeldnummer=1;
+INT VAR x,y;INT VAR xauskunft,yauskunft;LET xruhepos=1,yruhepos=24;BOOL VAR 
+cl,pr,se,sp,le;INT VAR dummy;TEXT VAR versionsnummer:="01";TEXT VAR 
+untergeschobenerfeldinhalt:="";PROC getcursorposfuerauskunft(INT VAR xpos,
+ypos):xpos:=xauskunft;ypos:=yauskunftEND PROC getcursorposfuerauskunft;PROC 
+hardcopy:FILE VAR f:=sequentialfile(output,bildschirmausdruck);screencopy(f);
+print(bildschirmausdruck);forget(bildschirmausdruck,quiet)END PROC hardcopy;
+PROC inaktuellesmaskenfeld(TEXT CONST auskunftsteiltext):
+untergeschobenerfeldinhalt:=auskunftsteiltextEND PROC inaktuellesmaskenfeld;
+BOOL PROC protected(TAG CONST t,INT CONST feld):fieldinfos(t,feld,dummy,cl,pr
+,se,sp,le);clOR prEND PROC protected;PROC protect(TAG VAR t,INT CONST feld,
+BOOL CONST prneu):fieldinfos(t,feld,dummy,cl,pr,se,sp,le);setfieldinfos(t,
+feld,cl,prneu,se);END PROC protect;PROC setzeschulisversion(TEXT CONST versi)
+:versionsnummer:=text(versi,versilaenge)END PROC setzeschulisversion;TEXT 
+PROC schulisversion:versionsnummerEND PROC schulisversion;PROC putget(TAG 
+CONST t,ROW variablenzahlgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR iFROM 
+posUPTO variablenzahlgrossREP IF fieldexists(t,i)THEN put(t,feld(i),i)FI PER 
+;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW variablenzahlgross
+TEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos);
+bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos);
+executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor(
+xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC putget(TAG 
+CONST t,ROW variablenzahlganzgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR i
+FROM posUPTO variablenzahlganzgrossREP IF fieldexists(t,i)THEN put(t,feld(i),
+i)FI PER ;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW 
+variablenzahlganzgrossTEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos)
+;bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos);
+executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor(
+xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC einkopieren(
+TAG CONST t,TEXT VAR feld,INT CONST pos):IF etwasuntergeschobenTHEN zeigees
+FI .etwasuntergeschoben:untergeschobenerfeldinhalt<>"".zeigees:feld:=
+untergeschobenerfeldinhalt;put(t,feld,pos);untergeschobenerfeldinhalt:="".
+END PROC einkopieren;PROC bestimmexykoordinatendesmeldungsfelds(TAG CONST t):
+cursor(t,meldungsfeldnummer);getcursor(x,y);END PROC 
+bestimmexykoordinatendesmeldungsfelds;PROC executeextendedcommandcode(TAG 
+CONST t,INT VAR pos):INT VAR charcode:=leavingcode;SELECT charcodeOF CASE 
+cseiterueck:tofirstfieldCASE cseitevor:tolastfieldOTHERWISE 
+executecommandcode(t,pos)END SELECT .tofirstfield:pos:=firstfield(t);WHILE 
+gesperrtREP pos:=nextfield(t,pos)PER .tolastfield:INT VAR oldpos;REP oldpos:=
+pos;pos:=nextfield(t,pos)UNTIL warletztesPER ;pos:=oldpos;WHILE gesperrtREP 
+pos:=priorfield(t,pos)PER .warletztes:pos<1.gesperrt:protected(t,pos).END 
+PROC executeextendedcommandcode;PROC bildschirmausdrucken(PROC (INT CONST )
+return):cursor(x,y);out(" Der Bildschirminhalt wird ausgedruckt.  ");
+hardcopy;pause(10);cursor(x,y);out(
+"===================================================");return(1)END PROC 
+bildschirmausdrucken;END PACKET baisyio;
+
diff --git a/app/baisy/2.2.1-schulis/src/block i-o b/app/baisy/2.2.1-schulis/src/block i-o
new file mode 100644
index 0000000..6ac925d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/block i-o
@@ -0,0 +1,52 @@
+PACKET diskblockioDEFINES readdiskblock,readdiskblockandcloseworkiferror,
+readdiskcluster,writediskblock,writediskblockandcloseworkiferror,
+writediskcluster,firstnondummydspage,blocknodumpmodus:BOOL VAR 
+blocknodumpflag:=FALSE ;LET writenormal=0;INT CONST firstnondummydspage:=2;
+INT VAR error;PROC readdiskblock(DATASPACE VAR ds,INT CONST dspageno,INT 
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN lesefehler(error
+)FI .END PROC readdiskblock;PROC readdiskblock(DATASPACE VAR ds,INT CONST 
+dspageno,REAL CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;
+checkrerun;readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN 
+lesefehler(error)FI .END PROC readdiskblock;PROC 
+readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,INT 
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework;
+lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC 
+readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,REAL 
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework;
+lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC 
+readdiskcluster(DATASPACE VAR ds,INT CONST firstdspageno,REAL CONST clusterno
+):IF blocknodumpflagTHEN dump("CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0
+UPTO sectorspercluster-1REP readdiskblock(ds,firstdspageno+i,blockno+real(i))
+PER .blockno:beginofcluster(clusterno).END PROC readdiskcluster;PROC 
+lesefehler(INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT 
+fehlercodeOF CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2:
+"Lesefehler"OTHERWISE "Lesefehler "+text(fehlercode)END SELECT .END PROC 
+lesefehler;PROC writediskblock(DATASPACE CONST ds,INT CONST dspageno,INT 
+CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno)FI ;checkrerun;
+writeblock(ds,dspageno,writenormal,eublock(blockno),error);IF error>0THEN 
+schreibfehler(error)FI .END PROC writediskblock;PROC writediskblock(
+DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag
+THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal,
+eublock(blockno),error);IF error>0THEN schreibfehler(error)FI .END PROC 
+writediskblock;PROC writediskblockandcloseworkiferror(DATASPACE CONST ds,INT 
+CONST dspageno,INT CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno
+)FI ;checkrerun;writeblock(ds,dspageno,writenormal,eublock(blockno),error);
+IF error>0THEN closework;schreibfehler(error)FI .END PROC 
+writediskblockandcloseworkiferror;PROC writediskblockandcloseworkiferror(
+DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag
+THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal,
+eublock(blockno),error);IF error>0THEN closework;schreibfehler(error)FI .END 
+PROC writediskblockandcloseworkiferror;PROC writediskcluster(DATASPACE CONST 
+ds,INT CONST firstdspageno,REAL CONST clusterno):IF blocknodumpflagTHEN dump(
+"CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0UPTO sectorspercluster-1REP 
+writediskblock(ds,firstdspageno+i,blockno+real(i))PER .blockno:beginofcluster
+(clusterno).END PROC writediskcluster;PROC schreibfehler(INT CONST fehlercode
+):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF CASE 1:
+"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Schreibfehler"OTHERWISE 
+"Schreibfehler "+text(fehlercode)END SELECT .END PROC schreibfehler;PROC 
+blocknodumpmodus(BOOL CONST status):blocknodumpflag:=statusEND PROC 
+blocknodumpmodus;END PACKET diskblockio;
+
diff --git a/app/baisy/2.2.1-schulis/src/bpb ds b/app/baisy/2.2.1-schulis/src/bpb ds
new file mode 100644
index 0000000..dabf721
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/bpb ds
diff --git a/app/baisy/2.2.1-schulis/src/db archive.sc b/app/baisy/2.2.1-schulis/src/db archive.sc
new file mode 100644
index 0000000..e68c5ce
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db archive.sc
@@ -0,0 +1,7 @@
+ PACKETdbarchive DEFINESdbtoarchive,dbfromarchive: TEXT VARuuuuuv:=""; PROCdbtoarchive( TEXT CONSTuuuuux):enablestop;logonarchive;fetchdb(uuuuux);uuuuuz;savetoarchive
+(db);uuuuvu;logoffarchive. ENDPROCdbtoarchive; PROCdbfromarchive( TEXT CONSTuuuuux):dbfromarchive(uuuuux,"") ENDPROCdbfromarchive; PROCdbfromarchive( TEXT CONSTuuuuux
+, TEXT CONSTuuuuwx):enablestop;logonarchive;uuuuuv:=postfix;postfix(uuuuwx);fetchfromarchive;uuuuuz; IF NOTtaskda(uuuuux) THEN IFyes("Server anlegen") CANDuuuuxw THEN
+restoredb(uuuuux);uuuuvu FI ELSErestoredb(uuuuux);uuuuvu FI;uuuuyv.uuuuyv:postfix("");fetchdd(uuuuux); BOOL VARuuuuyy:=dbopen(uuuuux);postfix(uuuuuv);logoffarchive
+.uuuuxw: IF NOTexists(uuuuux) THENcopy(uuuuux+uuuuwx,uuuuux) FI;createdb(uuuuux). ENDPROCdbfromarchive; PROCuuuuuz: IFonline THENline; FI ENDPROCuuuuuz; PROCuuuuvu
+:commanddialogue( FALSE);forget(db);commanddialogue( TRUE) ENDPROCuuuuvu; ENDPACKETdbarchive;
+
diff --git a/app/baisy/2.2.1-schulis/src/db dd.sc b/app/baisy/2.2.1-schulis/src/db dd.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db dd.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/db ddinfo.sc b/app/baisy/2.2.1-schulis/src/db ddinfo.sc
new file mode 100644
index 0000000..3993705
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db ddinfo.sc
@@ -0,0 +1,24 @@
+ PACKETddinfopacket DEFINESddinfo: REAL PROCuuuuuv( INT CONSTuuuuuw):records(uuuuuw) ENDPROCuuuuuv; PROCddinfo( TEXT CONSTuuuuvu):ddinfo(uuuuvu,"") ENDPROCddinfo;
+ PROCddinfo( TEXT CONSTuuuuvu,uuuuwu): INT VARuuuuwv,uuuuww:=1,uuuuwx; TEXT VARuuuuwy; IFuuuuvu="" ORuuuuvu="screen" THENpage ELSEforget(uuuuvu+".dd",quiet);sysout
+(uuuuvu+".dd"); IFuuuuvu="printer" THENputline("#type("""+uuuuwu+""")#") FI FI;uuuuxz;putline(" Datenbank:  <"+name(1)+">");putline("     Anzahl Dateien    erster Index   Max DatID  1. Freier Eintrag"
+);putline("              "+text(anzdateien)+"            "+text(firstindex)+"              "+text(maxdatid)+"              "+text(firstfree));uuuuyu;uuuuwv:=2; WHILE
+uuuuwv<firstfree REP IFwas(uuuuwv)=dateieintrag THENuuuuyy ELIFwas(uuuuwv)=indexeintrag THENuuuuzu ELSEuuuuwv INCR1 FI END REP;uuuuzw;uuuuzx;uuuuzy;uuuuzz; IFuuuuvu
+="" ORuuuuvu="screen" THENout("<RETURN>");pause;page ELSEsysout(""); IFuuuuvu="printer" THENprint(uuuuvu+".dd");forget(uuuuvu+".dd",quiet); FI FI.uuuuyy:uuuuxz;putline
+(" Datei:  "+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");uuuuwy:=compress(text(uuuuuv(uuuuwv),15,0));uuuuwy:=subtext(uuuuwy,1,length(uuuuwy)-1);putline("     Anzahl Schlüsselfelder: "
++text(anzkey(uuuuwv))+"   Befugnis: "+text(befugnis(uuuuwv))+"   Datensätze: "+uuuuwy);putline("         Feld                   Typ Länge XN YN XF YF Befug 1234567890123456"
+);uuuuwv INCR1;uuuuwx:=1; WHILEuuuuwv<firstfree CANDistfeld(was(uuuuwv)) REPuuuuxz;uuuvxz; IFlength(name(uuuuwv))>23 THENwrite(text(name(uuuuwv),23)+"<") ELSEwrite
+(text(name(uuuuwv),23)+" ") FI;write(code(feldtyp(uuuuwv))+"  "); IFfeldtyp(uuuuwv)=realfeld THENuuuuwy:=text(einglaenge(uuuuwv))+"."+text(nachkomma(uuuuwv));write
+(text("",5-length(uuuuwy)));write(uuuuwy+" ") ELSEwrite(text(einglaenge(uuuuwv),5)+" ") FI;write(text(posxname(uuuuwv),2)+" ");write(text(posyname(uuuuwv),2)+" ")
+;write(text(posxfeld(uuuuwv),2)+" ");write(text(posyfeld(uuuuwv),2)+" ");write(text(befugnis(uuuuwv),5)+" ");uuuwuy;line;uuuuwv INCR1; END REP;uuuuyu.uuuwvv:3*" "
+.uuuuzw:uuuuyu;line;write("INITIALISIERUNGEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFinitialisierung(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv
++"zu Feld "+text(text(uuuuwv),4)+": "+initialisierung(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuuzx:uuuuyu;line;write("PLAUSIBILITÄTEN");line;line;uuuuwv:=3; WHILE
+uuuuwv<firstfree REP IFplausi(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+plausi(uuuuwv),76)) FI;uuuuwv INCR1 PER;
+line.uuuuzy:uuuuyu;line;write("HILFSTEXTNUMMERN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFhilfstextnr(uuuuwv)>0 THENputline(uuuwvv+"zu Feld "+text(text(uuuuwv
+),4)+": "+text(hilfstextnr(uuuuwv))) FI;uuuuwv INCR1 PER;line.uuuuzz:uuuuyu;line;write("STANDARD-AKTIONEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFstandardaktion
+(uuuuwv) CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+zugriff(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuwuy: INT VARuuuxwx; FORuuuxwx
+ FROM1 UPTO16 REP IFswitch(uuuuwv,uuuxwx) THENwrite("*") ELSEwrite("-") FI PER.uuuuzu: TEXT VARuuuxxw:=""; WHILEuuuuwv<firstfree REPuuuuxz; IFphonetic(uuuuwv) THEN
+uuuxxw:=" Phon-Index: " ELSEuuuxxw:=" Index     : " FI;putline(uuuxxw+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");putline("     zu Datei   : "+name(dateinr(
+primdatid(uuuuwv))));putline("     über Felder: "+text(zugriff(uuuuwv),25));uuuuwv INCR1; PER.uuuuxz: TEXT VARindex:=text(uuuuww);write((3-length(index))*" ");write
+(index+")");uuuuww INCR1.uuuvxz:index:=text(uuuuwx);write((3-length(index))*" ");write(index+". ");uuuuwx INCR1.uuuuyu:write(6*"-------------");line. END PROCddinfo
+; BOOL PROCuuuwwv( INT CONSTuuuyuz):uuuyuz<>1 CANDwas(uuuyuz)<>dateieintrag CANDwas(uuuyuz)<>indexeintrag ENDPROCuuuwwv; ENDPACKETddinfopacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/db fetch.baisy b/app/baisy/2.2.1-schulis/src/db fetch.baisy
new file mode 100644
index 0000000..5f40dd1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db fetch.baisy
@@ -0,0 +1,28 @@
+PACKET fetch dd packet
+DEFINES fetch dd, 
+        server station
+:  
+ 
+LET save dd code = 36; 
+ 
+DATASPACE VAR ds; 
+ 
+INT VAR reply code, stat no:: station(myself);
+ 
+PROC server station (INT CONST server stat): 
+  stat no:= server stat 
+ENDPROC server station; 
+
+PROC fetch dd (TEXT CONST db name):  (* sf 4.12.86 *)
+  forget(ds); ds:= nilspace;
+  call (stat no/db name,save dd code,ds,reply code); 
+  IF reply code = save dd code
+    THEN
+      forget (db name,quiet); 
+      copy (ds,db name) 
+  FI; 
+  forget(ds)
+ENDPROC fetch dd;
+ 
+ENDPACKET fetch dd packet;
+
diff --git a/app/baisy/2.2.1-schulis/src/db kernel.sc b/app/baisy/2.2.1-schulis/src/db kernel.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db kernel.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/db parse.sc b/app/baisy/2.2.1-schulis/src/db parse.sc
new file mode 100644
index 0000000..38f0503
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db parse.sc
@@ -0,0 +1,38 @@
+ PACKETdbparse DEFINESparsetupel,buildtupel,buildkey,parsenooffields,reinitparsing,savetupel,restoretupel,istzahl: LETtextfeld=84,intfeld=73,realfeld=82,aktionsfeld
+=65,datumfeld=68,editorfeld=69,pointerfeld=80,#dateieintrag=1,#indexeintrag=2;#schluessel=1,daten=2,alles=3;# TEXT VARuuuuuv:=""; INT VARuuuuuw,uuuuux,uuuuuy; INT
+ VARuuuuuz,uuuuvu,uuuuvv; TEXT VARuuuuvw:="00",uuuuvx:="",uuuuvy:="",uuuuvz:="",uuuuwu:=""; BOOL VARuuuuwv; BOOL PROCuuuuww( TEXT CONSTuuuuwx):(uuuuwx>"/") AND(uuuuwx
+<":") END PROCuuuuww; PROCuuuuxv( INT CONSTuuuuxw):uuuuxv(uuuuxw,uuuuxz) ENDPROCuuuuxv; PROCuuuuxv( INT CONSTuuuuxw,uuuuyx): INT VARuuuuyy:=uuuuxw,uuuuzu:=4,uuuuzv
+:=0,uuuuuy:=anzattr(uuuuxw)+uuuuxw; WHILE(uuuuuy>uuuuyy) CANDuuuuzv<=uuuuyx REPuuuuyy INCR1; IF NOTstandardaktion(uuuuyy) THENputzugriff(uuuuyy,uuuvvu(uuuuyy,uuuuzu
+)) ELSEuuuuwv:= TRUE FI;uuuuzv INCR1 PER ENDPROCuuuuxv; INT VARuuuuxz:=maxint; PROCparsenooffields( INT CONSTuuuvww):uuuuxz:=uuuvww ENDPROCparsenooffields; INT PROC
+parsenooffields:uuuuxz ENDPROCparsenooffields; PROCreinitparsing:uuuuxz:=maxint ENDPROCreinitparsing; TEXT PROCuuuvvu( INT CONSTuuuuyy, INT VARuuuuzu):uuuuuz:=0;uuuuvu
+:=2;uuuuvv:=feldtyp(uuuuyy); SELECTuuuuvv OF CASEaktionsfeld,textfeld,pointerfeld,realfeld,editorfeld,datumfeld:#uuuvzw;uuuvzx;#uuuvzy;uuuuwv:=uuuuwv OR(uuuuvv=aktionsfeld
+)#change(uuuwuw,1,2+uuuuuz,"")# CASEintfeld:uuuuuz:=2;uuuuvu:=0;uuuvzx;#change(uuuwuw,1,2,"")# ENDSELECT;uuuuzu:=uuuuzu+uuuuuz+uuuuvu;uuuuvx.uuuvzy:uuuuvx:=subtext
+(uuuuwu,uuuuzu,uuuuzu+1);#uuuuuz:=wortnachint(uuuuvx);# IFuuuuvx<>"" THENuuuuuz:=uuuuvx ISUB1;uuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuuz
+:=0;uuuuvx:="" FI.uuuvzx: IFuuuuuz<>0 THENuuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuvx:="" FI. ENDPROCuuuvvu; PROCuuuxvv( INT CONSTuuuxvw
+): INT VARuuuxvx;disablestop; FORuuuxvx FROMuuuxvw+1 UPTOuuuxvw+anzattr(uuuxvw) REP IFfeldtyp(uuuxvx)=aktionsfeld CANDzugriff(uuuxvx)<>"" THEN IFactionlocked(uuuxvx
+) THEN#unlockaction(uuuxvx)# ELSEdo(zugriff(uuuxvx)); IFiserror THENactionfailure(uuuxvx, TRUE);clearerror ELSEactionfailure(uuuxvx, FALSE) FI FI FI PER;enablestop
+ ENDPROCuuuxvv; PROCparsetupel( INT CONSTuuuxxz, TEXT CONSTuuuxyu):parsetupel(uuuxxz,uuuxyu, FALSE, TRUE) ENDPROCparsetupel; PROCparsetupel( INT CONSTuuuxxz, TEXT
+ CONSTuuuxyu, BOOL CONSTuuuxzw,uuuxzx): INT VARuuuxzy:=uuuxxz; IF NOTuuuxzw THENuuuuwu:=uuuxyu;uuuyux FI.uuuyux: IFwas(uuuxxz)=indexeintrag THENuuuxzy:=dateinr(primdatid
+(uuuxxz)) FI;uuuuwv:= FALSE;uuuuxv(uuuxzy); IFuuuuwv CANDuuuxzx THENuuuxvv(uuuxzy) FI. ENDPROCparsetupel; PROCbuildtupel( INT CONSTuuuuxw, TEXT VARuuuxyu): INT VAR
+uuuuyy:=uuuuxw,uuuuuy:=anzattr(uuuuxw)+uuuuxw;replace(uuuuvw,1,uuuuxw);uuuuwu:="";uuuuwu CAT"D";uuuuwu CATuuuuvw; WHILEuuuuuy>uuuuyy REPuuuuyy INCR1; IFfeldtyp(uuuuyy
+)<>intfeld THEN IF NOTstandardaktion(uuuuyy) THENuuuyzz(zugriff(uuuuyy)) FI; ELSEuuuuwu CATzugriff(uuuuyy) FI PER;uuuxyu:=uuuuwu ENDPROCbuildtupel; PROCuuuyzz( TEXT
+ CONSTwert):replace(uuuuvw,1,length(wert));uuuuwu CATuuuuvw;uuuuwu CATwert ENDPROCuuuyzz; BOOL PROCistzahl( TEXT CONSTuuuzwv): INT VARuuuzww; FORuuuzww FROM1 UPTO
+length(uuuzwv) REP IF NOTuuuuww(uuuzwv SUBuuuzww) THEN LEAVEistzahl WITH FALSE FI PER; TRUE ENDPROCistzahl; PROCbuildkey( INT CONSTuuuuxw, TEXT VARuuuzyu,uuuzyv, BOOL
+ CONSTuuuzyw,uuuzyx): INT VARuuuzyy:=1,uuuzyz,uuuuyy:=uuuuxw,uuuzzw; BOOL VARuuuzzx:=phonetic(uuuuxw),uuuzzz:=(was(uuuuxw)=indexeintrag);uuuuvy:="";uuuzyu:=""; IF
+uuuzyx THENuuuzyv:="";buildkey(dateinr(primdatid(uuuuxw)),uuuzyu,uuuzyv, FALSE, FALSE);uuuzyu:="";uuuuvy:="" FI; IFuuuzzz THENuuvuwu ELSEuuvuwv FI; IFuuuzzx THENuuuzyu
+ CATcode(0) FI; IFuuuzzz THEN IF#uuvuwz ORuuvuxu ORuuvuxv???#uuuzyw THENuuuzyu CATuuuzyv FI ELSEuuuzyv:=uuuzyu; FI.uuvuwv:uuuuuy:=anzkey(uuuuxw)+uuuuxw; WHILEuuuuyy
+<uuuuuy REPuuuuyy INCR1;uuvuzw PER;.uuvuwu:uuuuuv:=zugriff(uuuuxw);uuuuuw:=dateinr(primdatid(uuuuxw));uuuuux:=length(uuuuuv);uuuzyz:=pos(uuuuuv,";");uuuuyy:=int(subtext
+(uuuuuv,1,uuuzyz-1))+uuuuuw;uuuzyy:=uuuzyz+1; WHILEuuuzyz>0 REPuuvuzw;uuuzyz:=pos(uuuuuv,";",uuuzyy);uuuuyy:=int(subtext(uuuuuv,uuuzyy,uuuzyz-1))+uuuuuw;uuuzyy:=uuuzyz
++1 PER;.uuvuzw:uuuzzw:=feldtyp(uuuuyy); IFuuuzzw=realfeld CORuuuzzw=datumfeld THENuuuzyu CATzugriff(uuuuyy) ELSE# IFuuuzzw=textfeld ORuuuzzw=intfeld ORuuuzzw=aktionsfeld
+ ORuuuzzw=editorfeld ORuuuzzw=pointerfeld THEN#uuvwuu FI; IF NOTuuuzzx THENuuuzyu CATcode(0) FI.uuvwuu: IF NOTstandardaktion(uuuuyy) THEN IFuuuzzx THENuuuzyu CATphoneticcode
+(zugriff(uuuuyy)) ELSEuuuuvy:=zugriff(uuuuyy); IFuuuzzw=textfeld CORuuuzzw=editorfeld THEN IFalpharechts(uuuuyy) CANDistzahl(uuuuvy) THENuuvwwx ELSEuuvwwy FI; FI;
+uuuzyu CATuuuuvy FI FI.uuvwwy:changeall(uuuuvy,"ß","ss");changeall(uuuuvy,"Ä","Ae");changeall(uuuuvy,"Ü","Ue");changeall(uuuuvy,"Ö","Oe");changeall(uuuuvy,"ä","ae"
+);changeall(uuuuvy,"ü","ue");changeall(uuuuvy,"ö","oe").uuvwwx:uuuuvy:=((einglaenge(uuuuyy)-length(uuuuvy))*"0")+uuuuvy. ENDPROCbuildkey; PROCsavetupel( INT CONST
+uuuxzy, TEXT VARuuvwzz): INT VARuuuuyy,uuvxuv; BOOL VARuuvxuw:= FALSE; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI;uuvwzz
+:=""; FORuuuuyy FROM1 UPTOmin(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy+uuvxuv)=pointerfeld; IFuuvxuw CANDlength(wert(uuuuyy+uuvxuv))<>uuvxxu THENuuvwzz CAT
+(uuvxxw+uuvxxx) ELSEuuvwzz CAT(wert(uuvxuv+uuuuyy)+uuvxxx) FI PER ENDPROCsavetupel; PROCrestoretupel( INT CONSTuuuxzy, TEXT CONSTuuvwzz): INT VARuuuuyy,uuvxuv,uuvxzw
+,uuuzyy:=1; BOOL VARuuvxuw:= FALSE;uuuuvz:=uuvwzz; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI; FORuuuuyy FROMuuvxuv+1
+ UPTOuuvxuv+min(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy)=pointerfeld; IFuuvxuw THENuuvxzw:=uuuzyy+4 ELSEuuvxzw:=pos(uuuuvz,uuvxxx,uuuzyy) FI;uuuuvy:=subtext
+(uuuuvz,uuuzyy,(uuvxzw-1));uuuzyy:=uuvxzw+1; IFuuvxuw CANDuuuuvy=uuvxxw THENuuuuvy:="" FI;putwert(uuuuyy,uuuuvy) PER ENDPROCrestoretupel; LETuuvxxx="�",uuvxxw="0000"
+,uuvxxu=4; ENDPACKETdbparse;
+
diff --git a/app/baisy/2.2.1-schulis/src/db phon.sc b/app/baisy/2.2.1-schulis/src/db phon.sc
new file mode 100644
index 0000000..b4d887a
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db phon.sc
@@ -0,0 +1,17 @@
+ PACKETphonpacket DEFINESphoneticcode,gross,allesgross:#$ IFmitphonetic THEN# LETa=65,uuuuuv=66,uuuuuw=67,uuuuux=68,e=69,uuuuuy=70,uuuuuz=71,uuuuvu=72,uuuuvv=73,uuuuvw
+=74,uuuuvx=75,uuuuvy=76,uuuuvz=77,uuuuwu=78,uuuuwv=79,uuuuww=80,uuuuwx=81,uuuuwy=82,uuuuwz=83,uuuuxu=84,uuuuxv=85,uuuuxw=86,uuuuxx=87,uuuuxy=88,uuuuxz=89,uuuuyu=90
+,uuuuyv=214,uuuuyw=215,uuuuyx=216,uuuuyy=251; TEXT VARuuuuyz:="",uuuuzu:="";#$ FI# TEXT PROCgross( TEXT CONSTuuuuzw): IFcode(uuuuzw)>96 CANDcode(uuuuzw)<123 THENcode
+(code(uuuuzw)-32) ELIFcode(uuuuzw)>216 CANDcode(uuuuzw)<220 THENcode(code(uuuuzw)-3) ELSEuuuuzw FI END PROCgross; TEXT PROCallesgross( TEXT CONSTword): TEXT VARuuuvvu
+:=""; INT VARuuuuvv; FORuuuuvv FROM1 UPTOlength(word) REPuuuvvu CATgross(word SUBuuuuvv); PER;uuuvvu END PROCallesgross; PROCchange( TEXT VARuuuvww, TEXT CONSTuuuvwx
+, INT CONSTpos):change(uuuvww,pos,pos,uuuvwx) ENDPROCchange; TEXT PROCphoneticcode( TEXT CONSTuuuvxv): TEXT VARuuuvxw:="";#$ IFmitphonetic THEN# INT VARuuuvxx:=1;
+ WHILEuuuvxx<=length(uuuvxv) REP SELECTcode(gross(uuuvxv SUBuuuvxx)) OF CASEuuuuvu:uuuvyy CASEa:uuuvxw CAT"6";uuuvzu CASEuuuuvv:uuuvxw CAT"8";uuuvzx CASEuuuuwv:uuuvxw
+ CAT"9";uuuwuu CASEuuuuxv:uuuvxw CAT"0";uuuwux CASEuuuuwz:uuuvxw CAT"2";uuuwvu CASEuuuuyv,uuuuyw,e:uuuvxw CAT"7" CASEuuuuvw,uuuuyx,uuuuxz:uuuvxw CAT"8" CASEuuuuuv
+,uuuuuy,uuuuww,uuuuxw,uuuuxx:uuuvxw CAT"1" CASEuuuuuw,uuuuuz,uuuuvx,uuuuwx,uuuuxy,uuuuyu,uuuuyy:uuuvxw CAT"2" CASEuuuuux,uuuuxu:uuuvxw CAT"3" CASEuuuuvy,uuuuwy:uuuvxw
+ CAT"4" CASEuuuuvz,uuuuwu:uuuvxw CAT"5" ENDSELECT;uuuvxx INCR1; IFlength(uuuvxw)>1 CAND(uuuvxw SUBlength(uuuvxw))=(uuuvxw SUB(length(uuuvxw)-1)) THENchange(uuuvxw
+,"",length(uuuvxw)) FI PER;#$ FI#uuuvxw.#$ IFmitphonetic THEN#uuuvyy:.uuuvzu: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="E" THENchange
+(uuuvxw,"7",length(uuuvxw));uuuvxx INCR1; ELSE IFuuuuzu="I" ORuuuuzu="Y" THENchange(uuuvxw,"7",length(uuuvxw));uuuvxw CAT"8";uuuvxx INCR1; FI FI FI.uuuwuu:uuuvzu;
+ IF(uuuvxw SUBlength(uuuvxw))="8" THENchange(uuuvxw,"0",length(uuuvxw)); FI.uuuvzx: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="H" THEN
+change(uuuvxw,"7",length(uuuvxw));uuuvxx INCR1; FI FI.uuuwux: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="E" THENchange(uuuvxw,"8",
+length(uuuvxw));uuuvxx INCR1; FI FI.uuuwvu: IFuuuvxx<length(uuuvxv)-1 THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1));uuuuyz:=gross(uuuvxv SUB(uuuvxx+2)); IFuuuuzu="C" AND
+uuuuyz="H" THENuuuvxx INCR2; FI FI.#$ FI# ENDPROCphoneticcode; ENDPACKETphonpacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorg.sc b/app/baisy/2.2.1-schulis/src/db reorg.sc
new file mode 100644
index 0000000..5903721
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorg.sc
@@ -0,0 +1,48 @@
+PACKET dbreorgDEFINES reorgdb:LET uuuuuv=".temporary";TEXT VAR uuuuuw:="";
+INT VAR uuuuux,uuuuuy;PROC reorgdb:enablestop;uuuuuw:=name(1);uuuuvv;uuuuvw;
+uuuuvx;BOOL VAR uuuuvy:=dbopen(uuuuuw)ENDPROC reorgdb;TYPE DD =STRUCT (TEXT 
+name,wert,initialisierung,plausi,INT was,uuuuwv,nachkomma,uuuuww,uuuuwx,
+uuuuwy,uuuuwz,uuuuxu,hilfstextnr,descript);LET uuuuxv=2978;TYPE DDROW =ROW 
+uuuuxvDD ;BOUND DDROW VAR newdd;PROC uuuuxx(INT CONST uuuuux):newdd[uuuuux].
+name:=name(uuuuux);newdd[uuuuux].wert:=zugriff(uuuuux);newdd[uuuuux].was:=was
+(uuuuux);newdd[uuuuux].uuuuwv:=anzattr(uuuuux);newdd[uuuuux].nachkomma:=
+nachkomma(uuuuux);newdd[uuuuux].uuuuww:=anzkey(uuuuux);newdd[uuuuux].uuuuwx:=
+datid(uuuuux);newdd[uuuuux].uuuuwy:=posxfeld(uuuuux);newdd[uuuuux].uuuuwz:=
+posyfeld(uuuuux);newdd[uuuuux].uuuuxu:=befugnis(uuuuux);newdd[uuuuux].
+descript:=descript(uuuuux);newdd[uuuuux].initialisierung:=initialisierung(
+uuuuux);newdd[uuuuux].plausi:=plausi(uuuuux);newdd[uuuuux].hilfstextnr:=
+hilfstextnr(uuuuux)ENDPROC uuuuxx;PROC uuuuvv:forget(uuuuuw+uuuuuv,quiet);
+rename(uuuuuw,uuuuuw+uuuuuv);newdd:=new(uuuuuw);FOR uuuuuxFROM 1UPTO 
+firstfree-1REP uuuuxx(uuuuux)PER ;forget(uuuuuw+uuuuuv,quiet)ENDPROC uuuuvv;
+LET uuuvzz=8192,uuuwuu=150;LET DATATABLE =ROW uuuvzzTEXT ;LET DINFOENTRIES =
+STRUCT (BOOL uuuwuw,uuuwux,INT firstfree,uuuwuy,uuuwuz,REAL uuuwvu);LET 
+DINFOTABLE =ROW uuuwuuDINFOENTRIES ;BOUND DINFOTABLE VAR uuuwvw;BOUND 
+DATATABLE VAR uuuwvx,uuuwvy;TEXT PROC uuuwvz(INT CONST uuuwwu):uuuuuw+".data"
++text(uuuwwu)END PROC uuuwvz;PROC uuuuvw:uuuwvw:=old(uuuwvz(0));FOR uuuuux
+FROM 1UPTO uuuwuuREP IF uuuwvw[uuuuux].uuuwuwTHEN uuuwyu;forget(uuuwvz(uuuuux
+)+uuuuuv,quiet)FI PER .uuuwyu:forget(uuuwvz(uuuuux)+uuuuuv,quiet);rename(
+uuuwvz(uuuuux),uuuwvz(uuuuux)+uuuuuv);uuuwvx:=new(uuuwvz(uuuuux));uuuwvy:=old
+(uuuwvz(uuuuux)+uuuuuv);FOR uuuuuyFROM 1UPTO uuuwvw[uuuuux].firstfree-1REP 
+uuuwvx[uuuuuy]:=uuuwvy[uuuuuy]PER .ENDPROC uuuuvw;LET uuuxwy=#21,#48,uuuxwz=#
+250;96;#160;LET BINFOENTRIES =STRUCT (BOOL uuuwuw,INT firstfree,uuuwuy,uuuwuz
+);LET BINFOTABLE =ROW uuuwuuBINFOENTRIES ;BOUND BINFOTABLE VAR uuuxxy;TYPE 
+ENTRY =STRUCT (TEXT uuuxxz,INT uuuxyu,uuuxyv);TYPE BLOCK =STRUCT (INT uuuxyw,
+uuuxyx,uuuxyy,uuuxyz,ROW uuuxwyBOOL map,ROW uuuxwyINT pointer,ROW uuuxwy
+ENTRY entry);LET BLOCKTABLE =ROW uuuxwzBLOCK ;BOUND BLOCKTABLE VAR uuuxzy,
+uuuxzz;TEXT PROC uuuyuu(INT CONST uuuwwu):uuuuuw+".tree"+text(uuuwwu)END 
+PROC uuuyuu;PROC uuuuvx:uuuxxy:=old(uuuyuu(0));FOR uuuuuxFROM 1UPTO uuuwuu
+REP IF uuuxxy[uuuuux].uuuwuwTHEN uuuywv;forget(uuuyuu(uuuuux)+uuuuuv,quiet)
+FI PER .uuuywv:forget(uuuyuu(uuuuux)+uuuuuv,quiet);rename(uuuyuu(uuuuux),
+uuuyuu(uuuuux)+uuuuuv);uuuxzz:=new(uuuyuu(uuuuux));uuuxzy:=old(uuuyuu(uuuuux)
++uuuuuv);#note("TREE "+text(uuuuux));noteline;note("first free:"+text(uuuxxy[
+uuuuux].firstfree));noteline;note("unused    :"+text(uuuxxy[uuuuux].uuuwuy));
+noteline;note("free      :"+text(uuuxxy[uuuuux].uuuwuz));noteline;#FOR uuuuuy
+FROM 1UPTO uuuxxy[uuuuux].firstfree-1REP uuuxzz[uuuuuy]:=uuuxzy[uuuuuy]PER .
+ENDPROC uuuuvx;OP :=(ENTRY VAR uuuzww,ENTRY CONST uuuzwx):CONCR (uuuzww):=
+CONCR (uuuzwx)ENDOP :=;OP :=(BLOCK VAR uuuzww,BLOCK CONST uuuzwx):INT VAR 
+uuuzxw;uuuzww.uuuxyw:=uuuzwx.uuuxyw;uuuzww.uuuxyx:=uuuzwx.uuuxyx;uuuzww.
+uuuxyy:=uuuzwx.uuuxyy;uuuzww.uuuxyz:=uuuzwx.uuuxyz;FOR uuuzxwFROM 1UPTO min(
+uuuzwx.uuuxyy-1,uuuxwy)REP uuuzww.entry[uuuzwx.pointer[uuuzxw]]:=uuuzwx.entry
+[uuuzwx.pointer[uuuzxw]]PER ;uuuzww.map:=uuuzwx.map;uuuzww.pointer:=uuuzwx.
+pointerENDOP :=;ENDPACKET dbreorg;
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorganisation auftrag b/app/baisy/2.2.1-schulis/src/db reorganisation auftrag
new file mode 100644
index 0000000..8731c5d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorganisation auftrag
@@ -0,0 +1,12 @@
+PACKET dbreorganisationauftragDEFINES reorganisierenderanwendungsdaten:PROC 
+reorganisierenderanwendungsdaten:LET namederzieltask="DB REORG";TASK VAR 
+zieltask;LET order=1;INT VAR ok;DATASPACE VAR ds;BOOL VAR fehler:=FALSE ;LET 
+meldnrbittewarten=69,meldnrkeinereorgtask=90,meldnrreorgerfolgreich=91,
+meldnrreorgnichtok=92;disablestop;zieltask:=/namederzieltask;IF iserrorTHEN 
+fehler:=TRUE ;clearerrorFI ;enablestop;IF fehlerTHEN standardmeldung(
+meldnrkeinereorgtask,"");return(1)ELSE standardmeldung(meldnrbittewarten,"");
+ds:=nilspace;call(zieltask,order,ds,ok);forget(ds);fehler:=ok>0;IF fehler
+THEN standardmeldung(meldnrreorgnichtok,"");return(1)ELSE standardmeldung(
+meldnrreorgerfolgreich,"");return(1)FI FI END PROC 
+reorganisierenderanwendungsdaten;END PACKET dbreorganisationauftrag
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorganisation manager b/app/baisy/2.2.1-schulis/src/db reorganisation manager
new file mode 100644
index 0000000..c26715d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorganisation manager
@@ -0,0 +1,15 @@
+PACKET dbreorganisationmanagerDEFINES dbreorganisationmanager:INT VAR order;
+DATASPACE VAR ds;TASK VAR ordertask;BOOL VAR reorgok;INT VAR returncode;LET 
+ack=0,nak=1;LET reorganisieren=1;LET dbname="EUMELbase.schulis";PROC 
+dbreorganisationmanager:setautonom;disablestop;break;REP warteaufauftrag;
+fuehreaus;meldezurueckPER .warteaufauftrag:wait(ds,order,ordertask).fuehreaus
+:reorgok:=TRUE ;IF order=reorganisierenTHEN datenbankreorganisieren(reorgok);
+IF reorgokTHEN returncode:=ackELSE returncode:=nakFI ;FI .meldezurueck:forget
+(ds);ds:=nilspace;send(ordertask,returncode,ds).END PROC 
+dbreorganisationmanager;PROC datenbankreorganisieren(BOOL VAR ok):
+commanddialogue(FALSE );forget(all);commanddialogue(TRUE );ok:=TRUE ;postfix(
+"");fetchdb(dbname);BOOL VAR b:=dbopen(dbname);reorgdb;IF iserrorTHEN ok:=
+FALSE ;clearerrorFI ;IF okTHEN restoredb(dbname)FI ;commanddialogue(FALSE );
+forget(all);commanddialogue(TRUE );END PROC datenbankreorganisierenEND 
+PACKET dbreorganisationmanager
+
diff --git a/app/baisy/2.2.1-schulis/src/db scan b/app/baisy/2.2.1-schulis/src/db scan
new file mode 100644
index 0000000..e7cf320
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db scan
@@ -0,0 +1,245 @@
+PACKET db scan
+ 
+(********************************************************************) 
+(*                                                                  *) 
+(*  AUTOR   :  Siegfried Fronzek (ISP GmbH)                         *) 
+(*  ZWECK   :  Navigation über eine Tupelmenge                      *) 
+(*                                                                  *) 
+(*             Vor Aufruf der Prozeduren scan first/scan forward    *) 
+(*             müssen die ersten n Schlüsselwerte gesetzt werden.   *) 
+(*             Diese Schlüsselwerte bestimmen die zu durchlaufende  *) 
+(*             Tupel-Menge.                                         *) 
+(*             Die Prozeduren scan last/scan pred bestimmen zum     *) 
+(*             vorgegebenen Schlüssel den vorherigen Datensatz!     *) 
+(*                                                                  *) 
+(*             Die Prozedur scan backward liefert einen Stack incl. *) 
+(*             (eventuell nächstem !!!!) Datensatz zum vorgegebenen *) 
+(*             Schlüssel, eignet sich also nicht zur Simulation     *) 
+(*             der Proczedur scan last im Stack-Betrieb.            *) 
+(*                                                                  *) 
+(*  DATUM   :  06.04.87                                             *) 
+(*  GEÄNDERT:  20.05.87 PROCs scan backward, scan stack entry       *) 
+(*                                                                  *) 
+(********************************************************************) 
+ 
+DEFINES scan first, scan last, scan succ, scan pred, 
+        scan status, scan stack entry,
+        scan forward, scan backward, scan stack succ, scan stack pred 
+        : 
+ 
+INT VAR scan db status:: db status; 
+ 
+PROC scan first (INT CONST index nr, BOOL PROC pruefung): 
+  BOOL VAR exact sve:: exact match; 
+  exact match (FALSE); 
+  scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) search); 
+  IF scan status <> ok 
+    THEN 
+      scan status (file empty) 
+  FI ; 
+  exact match (exact sve) 
+ENDPROC scan first; 
+ 
+PROC scan last (INT CONST index nr, BOOL PROC pruefung): 
+  change index; 
+  scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred); 
+  IF scan status <> ok 
+    THEN 
+      scan status (file empty) 
+  FI 
+ENDPROC scan last; 
+ 
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung): 
+  scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) succ); 
+ENDPROC scan succ; 
+ 
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung): 
+  scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred); 
+ENDPROC scan pred; 
+ 
+INT PROC scan status: 
+  scan db status 
+ENDPROC scan status; 
+ 
+PROC scan status (INT CONST stat): 
+  scan db status:= stat 
+ENDPROC scan status; 
+ 
+PROC scan rumpf (INT CONST index nr, BOOL PROC pruefung, 
+                 PROC (INT CONST) aktion ): 
+   TEXT VAR sve t:: "";
+   save tupel (index nr, sve t); 
+   aktion (index nr); 
+   IF db status <> ok 
+     THEN 
+       restore tupel (index nr, sve t); 
+       change index; 
+       scan status (db status) 
+     ELSE 
+       IF NOT pruefung 
+         THEN 
+           restore tupel (index nr, sve t); 
+           change index; 
+           scan status (end of file) 
+         ELSE 
+           scan status (ok) 
+       FI 
+   FI 
+ENDPROC scan rumpf; 
+ 
+(******************************************************************) 
+(*                                                                *)
+(*                   STACK ohne Datenraum                         *)
+(*                                                                *)
+(******************************************************************) 
+#
+PROC scan forward (INT CONST index nr, BOOL PROC pruefung,
+                   INT VAR anz tupels):
+  scan stack rumpf (index nr, BOOL PROC pruefung, 
+              PROC (INT CONST,INT VAR) multisearch forward, anz tupels)
+ENDPROC scan forward; 
+ 
+PROC scan backward (INT CONST index nr, BOOL PROC pruefung, 
+                    INT VAR anz tupels): 
+  scan stack rumpf (index nr, BOOL PROC pruefung, 
+              PROC (INT CONST,INT VAR) multisearch backward, anz tupels) 
+  (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem 
+                   ungültigen Startwert !!!!! *)
+ENDPROC scan backward; 
+ 
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): 
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+                    PROC (INT CONST,INT VAR) multisucc, anz tupels); 
+ENDPROC scan succ; 
+ 
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels): 
+  scan stack rumpf (index nr, BOOL PROC pruefung,
+                    PROC (INT CONST,INT VAR) multipred, anz tupels)
+ENDPROC scan pred; 
+ 
+PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung): 
+  scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc); 
+ENDPROC scan stack succ; 
+ 
+PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung): 
+  scan stack rumpf (index nr, BOOL PROC pruefung, PROC multipred); 
+ENDPROC scan stack pred; 
+ 
+BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung): 
+  stack entry (entry nr); 
+  pruefung 
+ENDPROC scan stack entry; 
+ 
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, 
+                 PROC (INT CONST,INT VAR) aktion, INT VAR anz tupels ): 
+   change index;
+   aktion (index nr, anz tupels); 
+   scan status (end of file); 
+   change index;
+   IF anz tupels = 0 COR db status <> ok 
+     THEN 
+       IF anz tupels <> 0 
+         THEN 
+           scan status (db status) 
+       FI
+     ELSE 
+           scan status (ok) 
+   FI 
+ENDPROC scan stack rumpf; 
+ 
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, 
+                 PROC aktion): 
+   aktion; 
+   change index;
+   IF NOT pruefung 
+     THEN 
+       scan status (end of file) 
+     ELSE 
+       scan status (ok) 
+   FI 
+ENDPROC scan stack rumpf; 
+ 
+ #
+(******************************************************************) 
+(*                                                                *)
+(*                   STACK mit Datenraum                          *)
+(*                                                                *)
+(******************************************************************) 
+ 
+ 
+PROC scan forward (INT CONST index nr, BOOL PROC pruefung,
+                   INT VAR anz tupels):
+  scan stack rumpf (index nr, BOOL PROC pruefung, 
+                    PROC (INT CONST,INT VAR) multisearch forward,
+                    anz tupels)
+ENDPROC scan forward; 
+ 
+PROC scan backward (INT CONST index nr, BOOL PROC pruefung, 
+                    INT VAR anz tupels):
+  scan stack rumpf (index nr, BOOL PROC pruefung, 
+                    PROC (INT CONST,INT VAR) multisearch backward,
+                    anz tupels)
+  (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem 
+                   ungültigen Startwert !!!!! *)
+ENDPROC scan backward; 
+ 
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+                    PROC (INT CONST,INT VAR) multisucc,
+                    anz tupels)
+ENDPROC scan succ; 
+ 
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+  scan stack rumpf (index nr, BOOL PROC pruefung,
+                    PROC (INT CONST,INT VAR) multipred,
+                    anz tupels)
+ENDPROC scan pred; 
+ 
+PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung):
+  scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc)
+ENDPROC scan stack succ; 
+ 
+PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung):
+  scan stack rumpf (index nr, BOOL PROC pruefung,
+                    PROC multipred)
+ENDPROC scan stack pred; 
+ 
+BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung ):
+  stack entry (entry nr);
+  pruefung 
+ENDPROC scan stack entry; 
+ 
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung,
+                       PROC (INT CONST,INT VAR) aktion,
+                       INT VAR anz tupels):
+   change index;
+   aktion (index nr, anz tupels);
+   scan status (end of file);
+   IF anz tupels = 0 COR db status <> ok 
+     THEN 
+       change index; 
+       IF anz tupels <> 0 
+         THEN 
+           scan status (db status) 
+       FI
+     ELSE 
+           scan status (ok) 
+   FI 
+ENDPROC scan stack rumpf; 
+ 
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung, 
+                 PROC aktion):
+   aktion;
+   IF NOT pruefung 
+     THEN 
+       change index; 
+       scan status (end of file) 
+     ELSE 
+       scan status (ok) 
+   FI 
+ENDPROC scan stack rumpf; 
+ 
+ 
+ENDPACKET db scan;
+
+
diff --git a/app/baisy/2.2.1-schulis/src/db utils.sc b/app/baisy/2.2.1-schulis/src/db utils.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db utils.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/dir.dos b/app/baisy/2.2.1-schulis/src/dir.dos
new file mode 100644
index 0000000..fd348a1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dir.dos
@@ -0,0 +1,187 @@
+PACKET dirDEFINES opendir,insertdirentry,deletedirentry,initdirds,fileinfo,
+formatdir,dirlist,fileexists,subdirexists,allfiles,allsubdirs:LET 
+maxdirentrys=1000;INITFLAG VAR dirblockdsused:=FALSE ;DATASPACE VAR 
+dirblockds;BOUND STRUCT (ALIGN dummy,ROW 64REAL daten)VAR dirblock;REAL VAR 
+lastreaddirblockno;PROC initdirblockio:lastreaddirblockno:=-1.0;IF NOT 
+initialized(dirblockdsused)THEN dirblockds:=nilspace;dirblock:=dirblockdsFI .
+END PROC initdirblockio;PROC readdirblock(REAL CONST blocknr):IF 
+lastreaddirblockno<>blocknrTHEN lastreaddirblockno:=-1.0;
+readdiskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknrFI .END PROC readdirblock;PROC writedirblock(REAL CONST blocknr):
+writediskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknr.END PROC writedirblock;PROC writedirblock:IF lastreaddirblockno<0.0
+THEN errorstop("Lesefehler")FI ;writedirblock(lastreaddirblockno)END PROC 
+writedirblock;PROC getdirentry(TEXT VAR entrybuffer,INT CONST blockentryno):
+entrybuffer:=32*".";INT CONST replaceoffset:=4*blockentryno;replace(
+entrybuffer,1,dirblock.daten[replaceoffset+1]);replace(entrybuffer,2,dirblock
+.daten[replaceoffset+2]);replace(entrybuffer,3,dirblock.daten[replaceoffset+3
+]);replace(entrybuffer,4,dirblock.daten[replaceoffset+4]).END PROC 
+getdirentry;PROC putdirentry(TEXT CONST entrybuffer,INT CONST blockentryno):
+INT CONST offset:=4*blockentryno;dirblock.daten[offset+1]:=entrybufferRSUB 1;
+dirblock.daten[offset+2]:=entrybufferRSUB 2;dirblock.daten[offset+3]:=
+entrybufferRSUB 3;dirblock.daten[offset+4]:=entrybufferRSUB 4.END PROC 
+putdirentry;LET DIRPOS =REAL ;DIRPOS PROC dirpos(REAL CONST blocknr,INT 
+CONST entrynr):blocknr*16.0+real(entrynr).END PROC dirpos;REAL PROC blockno(
+DIRPOS CONST p):floor(p/16.0)END PROC blockno;INT PROC entryno(DIRPOS CONST p
+):int(pMOD 16.0)END PROC entryno;PROC incr(DIRPOS VAR p):pINCR 1.0.END PROC 
+incr;LET FREELIST =STRUCT (ROW maxdirentrysDIRPOS stack,INT stacktop,DIRPOS 
+beginoffreearea,endofdir,REAL dirroot);PROC initfreelist(FREELIST VAR flist,
+REAL CONST root):flist.stacktop:=0;flist.beginoffreearea:=dirpos(9.0e99,0);
+flist.endofdir:=dirpos(-1.0,0);flist.dirroot:=root.END PROC initfreelist;
+PROC store(FREELIST VAR flist,DIRPOS CONST freepos):flist.stacktopINCR 1;
+flist.stack[flist.stacktop]:=freepos.END PROC store;PROC storebeginoffreearea
+(FREELIST VAR flist,DIRPOS CONST begin):flist.beginoffreearea:=beginEND PROC 
+storebeginoffreearea;PROC storeendofdir(FREELIST VAR flist,DIRPOS CONST end):
+flist.endofdir:=endEND PROC storeendofdir;DIRPOS PROC freedirpos(FREELIST 
+VAR flist):enablestop;DIRPOS VAR result;IF flist.stacktop>0THEN popELIF NOT 
+freeareaemptyTHEN firstoffreeareaELIF expansionallowededTHEN 
+allocatenewdircluster;result:=freedirpos(flist)ELSE errorstop(
+"Directory voll")FI ;result.pop:result:=flist.stack[flist.stacktop];flist.
+stacktopDECR 1.freeareaempty:flist.beginoffreearea>flist.endofdir.
+firstoffreearea:result:=flist.beginoffreearea;incr(flist.beginoffreearea).
+expansionalloweded:flist.dirroot>=2.0.allocatenewdircluster:REAL CONST 
+newdircluster:=availablefatentry;REAL VAR lastentryno;
+searchlastentrynooffatchain;fatentry(newdircluster,lastfatchainentry);
+fatentry(lastentryno,newdircluster);writefat;storebeginoffreearea(flist,
+dirpos(firstnewblock,0));storeendofdir(flist,dirpos(lastnewblock,15));
+initnewdircluster.searchlastentrynooffatchain:lastentryno:=flist.dirroot;
+WHILE NOT islastfatchainentry(fatentry(lastentryno))REP lastentryno:=fatentry
+(lastentryno)PER .firstnewblock:beginofcluster(newdircluster).lastnewblock:
+beginofcluster(newdircluster)+real(sectorspercluster-1).initnewdircluster:
+TEXT CONST emptydirentry:=32*"�";INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(
+emptydirentry,i)PER ;disablestop;REAL VAR blockno:=firstnewblock;WHILE 
+blockno<=lastnewblockREP writedirblock(blockno)PER .END PROC freedirpos;LET 
+FILEENTRY =STRUCT (TEXT dateandtime,REAL size,firstcluster,DIRPOS dirpos),
+FILELIST =STRUCT (THESAURUS thes,ROW maxdirentrysFILEENTRY entry);PROC 
+initfilelist(FILELIST VAR flist):flist.thes:=emptythesaurus.END PROC 
+initfilelist;PROC storefileentry(FILELIST VAR flist,TEXT CONST entrytext,
+DIRPOS CONST position):INT VAR entryindex;insert(flist.thes,filename,
+entryindex);storefileentry(flist.entry[entryindex],entrytext,position).
+filename:TEXT CONST namepre:=compress(subtext(entrytext,1,8)),namepost:=
+compress(subtext(entrytext,9,11));IF namepost<>""THEN namepre+"."+namepost
+ELSE namepreFI .END PROC storefileentry;PROC storefileentry(FILEENTRY VAR 
+fentry,TEXT CONST entrytext,DIRPOS CONST position):fentry.firstcluster:=real(
+entrytextISUB 14);fentry.dateandtime:=dosdate+"  "+dostime;fentry.size:=dint(
+entrytextISUB 15,entrytextISUB 16);fentry.dirpos:=position.dosdate:day+"."+
+month+"."+year.day:text2(code(entrytextSUB 25)MOD 32).month:text2(code(
+entrytextSUB 25)DIV 32+8*(code(entrytextSUB 26)MOD 2)).year:text(80+code(
+entrytextSUB 26)DIV 2,2).dostime:hour+":"+minute.hour:text2(code(entrytext
+SUB 24)DIV 8).minute:text2(code(entrytextSUB 23)DIV 32+8*(code(entrytextSUB 
+24)MOD 8)).END PROC storefileentry;TEXT PROC text2(INT CONST intvalue):IF 
+intvalue<10THEN "0"+text(intvalue)ELSE text(intvalue)FI .END PROC text2;
+DIRPOS PROC fileentrypos(FILELIST CONST flist,TEXT CONST filename):INT CONST 
+linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;flist.entry[linkindex].dirpos.
+END PROC fileentrypos;PROC delete(FILELIST VAR flist,TEXT CONST filename):
+INT VAR dummy;delete(flist.thes,filename,dummy).END PROC delete;PROC fileinfo
+(FILELIST CONST flist,TEXT CONST filename,REAL VAR firstclusterno,storage):
+INT CONST linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;firstclusterno:=flist.entry[
+linkindex].firstcluster;storage:=flist.entry[linkindex].sizeEND PROC fileinfo
+;BOOL PROC contains(FILELIST VAR flist,TEXT CONST filename):flist.thes
+CONTAINS filenameEND PROC contains;PROC list(FILE VAR f,FILELIST CONST flist)
+:INT VAR index:=0;TEXT VAR name;get(flist.thes,name,index);WHILE index>0REP 
+listfile;get(flist.thes,name,index)PER .listfile:write(f,centeredname);write(
+f,"  ");write(f,text(flist.entry[index].size,11,0));write(f,
+" Bytes belegt      ");write(f,flist.entry[index].dateandtime);write(f,
+"  +++  ");write(f,text(flist.entry[index].firstcluster));line(f).
+centeredname:INT VAR pointpos:=pos(name,".");IF pointpos>0THEN namepre+"."+
+namepostELSE text(name,12)FI .namepre:text(subtext(name,1,pointpos-1),8).
+namepost:text(subtext(name,pointpos+1,pointpos+4),3).END PROC list;LET 
+DIRENTRY =REAL ,DIRLIST =STRUCT (THESAURUS thes,ROW maxdirentrysDIRENTRY 
+entry);PROC initdirlist(DIRLIST VAR dlist):dlist.thes:=emptythesaurus.END 
+PROC initdirlist;PROC storesubdirentry(DIRLIST VAR dlist,TEXT CONST entrytext
+):INT VAR entryindex;insert(dlist.thes,subdirname,entryindex);dlist.entry[
+entryindex]:=real(entrytextISUB 14).subdirname:TEXT CONST namepre:=compress(
+subtext(entrytext,1,8)),namepost:=compress(subtext(entrytext,9,11));IF 
+namepost<>""THEN namepre+"."+namepostELSE namepreFI .END PROC 
+storesubdirentry;REAL PROC firstclusterofsubdir(DIRLIST CONST dlist,TEXT 
+CONST name):INT CONST linkindex:=link(dlist.thes,name);IF linkindex=0THEN 
+errorstop("Das Unterverzeichnis """+name+""" gibt es nicht")FI ;dlist.entry[
+linkindex].END PROC firstclusterofsubdir;BOOL PROC contains(DIRLIST CONST 
+dlist,TEXT CONST subdirname):dlist.thesCONTAINS subdirnameEND PROC contains;
+PROC list(FILE VAR f,DIRLIST CONST dlist):INT VAR index:=0;TEXT VAR name;get(
+dlist.thes,name,index);WHILE index>0REP listdir;get(dlist.thes,name,index)
+PER .listdir:write(f,centeredname);write(f,"   <DIR>");write(f,"  +++  ");
+write(f,text(dlist.entry[index]));line(f).centeredname:INT VAR pointpos:=pos(
+name,".");IF pointpos>0THEN namepre+"."+namepostELSE text(name,12)FI .namepre
+:text(subtext(name,1,pointpos-1),8).namepost:text(subtext(name,pointpos+1,
+pointpos+4),3).END PROC list;LET DIR =BOUND STRUCT (FILELIST filelist,
+DIRLIST dirlist,FREELIST freelist,TEXT path);DIR VAR dir;DATASPACE VAR dirds;
+INITFLAG VAR dirdsused:=FALSE ;PROC opendir(TEXT CONST pathstring):
+initdirblockio;initdirds;dir.path:=pathstring;loadmaindir;TEXT VAR restpath:=
+pathstring;WHILE restpath<>""REP TEXT CONST subdirname:=nextsubdirname(
+restpath);loadsubdirPER .loadmaindir:initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,0.0);storeendofdir(dir.freelist,dirpos
+(lastmaindirsector,15));BOOL VAR waslastdirsector:=FALSE ;REAL VAR blockno:=
+firstmaindirsector;INT VAR i;FOR iFROM 1UPTO dirsectorsREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+firstmaindirsector:real(beginofdir).lastmaindirsector:real(beginofdir+
+dirsectors-1).loadsubdir:REAL VAR clusterno:=firstclusterofsubdir(dir.dirlist
+,subdirname);waslastdirsector:=FALSE ;initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,clusterno);WHILE NOT 
+islastfatchainentry(clusterno)REP loadsubdirentrysofcluster;clusterno:=
+fatentry(clusterno)UNTIL waslastdirsectorPER .loadsubdirentrysofcluster:
+storeendofdir(dir.freelist,dirpos(lastblocknoofcluster,15));blockno:=
+beginofcluster(clusterno);FOR iFROM 1UPTO sectorsperclusterREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+lastblocknoofcluster:beginofcluster(clusterno)+real(sectorspercluster-1).END 
+PROC opendir;PROC loaddirblock(REAL CONST blockno,BOOL VAR waslastblock):
+waslastblock:=FALSE ;readdirblock(blockno);INT VAR entryno;TEXT VAR entry;
+FOR entrynoFROM 0UPTO 15REP getdirentry(entry,entryno);processentryUNTIL 
+waslastblockPER .processentry:SELECT pos("�.�",entrySUB 1)OF CASE 1:
+endofdirsearchCASE 2:CASE 3:freeentryOTHERWISE 
+volumelabelorfileentryorsubdirentryEND SELECT .endofdirsearch:waslastblock:=
+TRUE ;storebeginoffreearea(dir.freelist,dirpos(blockno,entryno)).freeentry:
+store(dir.freelist,dirpos(blockno,entryno)).
+volumelabelorfileentryorsubdirentry:INT CONST byte11:=code(entrySUB 12);IF (
+byte11AND 8)>0THEN ELIF (byte11AND 16)>0THEN subdirentryELSE fileentryFI .
+subdirentry:storesubdirentry(dir.dirlist,entry).fileentry:storefileentry(dir.
+filelist,entry,dirpos(blockno,entryno)).END PROC loaddirblock;TEXT PROC 
+nextsubdirname(TEXT VAR pathstring):TEXT VAR subdirname;IF (pathstringSUB 1)
+<>"\"THEN errorstop("ungültige Pfadbezeichnung")FI ;INT CONST backslashpos:=
+pos(pathstring,"\",2);IF backslashpos=0THEN subdirname:=subtext(pathstring,2)
+;pathstring:=""ELSE subdirname:=subtext(pathstring,2,backslashpos-1);
+pathstring:=subtext(pathstring,backslashpos)FI ;dosname(subdirname,readmodus)
+.END PROC nextsubdirname;PROC initdirds:IF initialized(dirdsused)THEN forget(
+dirds)FI ;dirds:=nilspace;dir:=dirds.END PROC initdirds;PROC insertdirentry(
+TEXT CONST name,REAL CONST startcluster,storage):DIRPOS CONST inspos:=
+freedirpos(dir.freelist);TEXT CONST entrystring:=entryname+" "+(10*"�")+
+dostime+dosdate+entrystartcluster+entrystorage;writeentryondisk;
+writeentryindirds.entryname:INT CONST pointpos:=pos(name,".");IF pointpos>0
+THEN subtext(name,1,pointpos-1)+(9-pointpos)*" "+subtext(name,pointpos+1)+(3-
+LENGTH name+pointpos)*" "ELSE name+(11-LENGTH name)*" "FI .dostime:TEXT 
+CONST akttime:=timeofday(clock(1));code((minuteMOD 8)*32)+code(8*hour+minute
+DIV 8).hour:int(subtext(akttime,1,2)).minute:int(subtext(akttime,4,5)).
+dosdate:TEXT CONST aktdate:=date(clock(1));code(32*(monthMOD 8)+day)+code((
+year-80)*2+monthDIV 8).day:int(subtext(aktdate,1,2)).month:int(subtext(
+aktdate,4,5)).year:int(subtext(aktdate,7,8)).entrystartcluster:TEXT VAR 
+buffer2:="12";replace(buffer2,1,lowword(startcluster));buffer2.entrystorage:
+TEXT VAR buffer4:="1234";replace(buffer4,1,lowword(storage));replace(buffer4,
+2,highword(storage));buffer4.writeentryondisk:readdirblock(blockno(inspos));
+putdirentry(entrystring,entryno(inspos));writedirblock.writeentryindirds:
+storefileentry(dir.filelist,entrystring,inspos).END PROC insertdirentry;PROC 
+deletedirentry(TEXT CONST name):TEXT VAR entry;DIRPOS CONST delpos:=
+fileentrypos(dir.filelist,name);readdirblock(blockno(delpos));getdirentry(
+entry,entryno(delpos));putdirentry("�"+subtext(entry,2,32),entryno(delpos));
+writedirblock;delete(dir.filelist,name);store(dir.freelist,delpos).END PROC 
+deletedirentry;PROC formatdir:initdirblockio;initdirds;buildemptydirblock;
+REAL VAR blockno:=real(beginofdir);disablestop;FOR iFROM 1UPTO dirsectorsREP 
+writedirblock(blockno);blocknoINCR 1.0PER ;enablestop;dir.path:="";
+initfilelist(dir.filelist);initdirlist(dir.dirlist);initfreelist(dir.freelist
+,0.0);storebeginoffreearea(dir.freelist,dirpos(real(beginofdir),0));
+storeendofdir(dir.freelist,dirpos(lastmaindirsector,15)).buildemptydirblock:
+INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(32*"�",i)PER .lastmaindirsector:
+real(beginofdir+dirsectors-1).END PROC formatdir;PROC fileinfo(TEXT CONST 
+filename,REAL VAR startcluster,size):fileinfo(dir.filelist,filename,
+startcluster,size)END PROC fileinfo;THESAURUS PROC allfiles:THESAURUS VAR t:=
+dir.filelist.thes;tEND PROC allfiles;THESAURUS PROC allsubdirs:dir.dirlist.
+thesEND PROC allsubdirs;BOOL PROC fileexists(TEXT CONST filename):contains(
+dir.filelist,filename)END PROC fileexists;BOOL PROC subdirexists(TEXT CONST 
+subdirname):contains(dir.dirlist,subdirname)END PROC subdirexists;PROC 
+dirlist(DATASPACE VAR ds):openlistfile;headline(listfile,listfilehead);list(
+listfile,dir.filelist);list(listfile,dir.dirlist).openlistfile:forget(ds);ds
+:=nilspace;FILE VAR listfile:=sequentialfile(output,ds);putline(listfile,"").
+listfilehead:"DOS"+pathstring.pathstring:IF dir.path<>""THEN "     PATH: "+
+dir.pathELSE ""FI .END PROC dirlist;END PACKET dir;
+
diff --git a/app/baisy/2.2.1-schulis/src/disk descriptor.dos b/app/baisy/2.2.1-schulis/src/disk descriptor.dos
new file mode 100644
index 0000000..5fa1ce0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/disk descriptor.dos
@@ -0,0 +1,73 @@
+PACKET dosdiskDEFINES opendosdisk,sectorspercluster,fatcopies,dirsectors,
+mediadescriptor,fatsectors,beginoffat,fatentrys,beginofdir,beginofcluster,
+clustersize,bpbexists,writebpb,eublock,bpbdumpmodus:INITFLAG VAR 
+bpbdsinitialisiert:=FALSE ;DATASPACE VAR bpbds;BOUND STRUCT (ALIGN dummy,ROW 
+512INT daten)VAR bpb;BOOL VAR bpbdumpflag:=FALSE ;REAL VAR beginofdataarea;
+INT VAR sectorspertrack,heads;IF exists("shard interface")THEN 
+loadshardinterfacetableFI ;TEXT CONST bpbtype254:="���"+"EUMELBPB"+"��"+"�"+
+"��"+"�"+"§�"+"§�"+"�"+"��"+"��"+"��"+"��",bpbtype255:="���"+"EUMELBPB"+"��"+
+"�"+"��"+"�"+"p�"+"��"+"�"+"��"+"��"+"��"+"��";PROC opendosdisk:enablestop;
+bpbdsanboundkoppeln;bpblesen;IF bpbungueltigTHEN versuchepseudobpbzuverwenden
+FI ;ueberpruefebpbaufgueltigkeit;globalevariableninitialisieren;IF 
+bpbdumpflagTHEN dumpschreibenFI .bpbdsanboundkoppeln:IF NOT initialized(
+bpbdsinitialisiert)THEN bpbds:=nilspace;bpb:=bpbdsFI .bpblesen:INT VAR return
+;checkrerun;readblock(bpbds,2,0,return);IF return<>0THEN lesefehler(return)
+FI .bpbungueltig:INT VAR wordno;FOR wordnoFROM 6UPTO 10REP IF bpb.daten[
+wordno+1]<>bpb.daten[wordno+2]THEN LEAVE bpbungueltigWITH FALSE FI PER ;TRUE 
+.versuchepseudobpbzuverwenden:lieserstenfatsektor;IF 
+fatsektorgueltigundpseudobpbvorhandenTHEN pseudobpbladenELSE errorstop(
+"Format unbekannt")FI .lieserstenfatsektor:checkrerun;readblock(bpbds,2,1,
+return);IF return<>0THEN lesefehler(return)FI .
+fatsektorgueltigundpseudobpbvorhanden:TEXT VAR fatstart:="1234";replace(
+fatstart,1,bpb.daten[1]);replace(fatstart,2,bpb.daten[2]);(fatstartSUB 2)="�"
+CAND (fatstartSUB 3)="�"CAND pseudobpbvorhanden.pseudobpbvorhanden:pos("��",
+fatstartSUB 1)>0.pseudobpbladen:INT VAR i;FOR iFROM 1UPTO 15REP bpb.daten[i]
+:=bpbpufferISUB iPER .bpbpuffer:IF pseudobpbname="�"THEN bpbtype255ELSE 
+bpbtype254FI .pseudobpbname:fatstartSUB 1.ueberpruefebpbaufgueltigkeit:IF 
+bytespersector<>512THEN errorstop(
+"DOS Format nicht implementiert (unzulässige Sektorgröße)")FI ;IF (fatsectors
+>64)THEN errorstop("ungültige DOS Disk (BPB)")FI .
+globalevariableninitialisieren:sectorspertrack:=bpbbyte(25)*256+bpbbyte(24);
+heads:=bpbbyte(27)*256+bpbbyte(26);beginofdataarea:=real(reservedsectors+
+fatcopies*fatsectors+dirsectors).dumpschreiben:dump("Sektoren pro Cluster",
+sectorspercluster);dump("Fat Kopien          ",fatcopies);dump(
+"Dir Sektoren        ",dirsectors);dump("Media Descriptor    ",
+mediadescriptor);dump("Sektoren pro Fat    ",fatsectors);dump(
+"Fat Anfang (0)      ",beginoffat(0));dump("Fat Einträge        ",fatentrys);
+dump("Dir Anfang          ",beginofdir).END PROC opendosdisk;PROC lesefehler(
+INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF 
+CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Lesefehler"OTHERWISE 
+"Lesefehler "+text(fehlercode)END SELECT .END PROC lesefehler;TEXT VAR 
+konvertierpuffer:="12";INT PROC bpbbyte(INT CONST byteno):replace(
+konvertierpuffer,1,bpb.daten[bytenoDIV 2+1]);code(konvertierpufferSUB 
+pufferpos).pufferpos:IF evenbytenoTHEN 1ELSE 2FI .evenbyteno:(bytenoMOD 2)=0.
+END PROC bpbbyte;INT PROC bytespersector:bpbbyte(12)*256+bpbbyte(11)END PROC 
+bytespersector;INT PROC sectorspercluster:bpbbyte(13)END PROC 
+sectorspercluster;INT PROC reservedsectors:bpbbyte(15)*256+bpbbyte(14)END 
+PROC reservedsectors;INT PROC fatcopies:bpbbyte(16)END PROC fatcopies;INT 
+PROC dirsectors:direntrysDIV direntryspersector.direntrys:bpbbyte(18)*256+
+bpbbyte(17).direntryspersector:16.END PROC dirsectors;REAL PROC dossectors:
+real(bpbbyte(20))*256.0+real(bpbbyte(19))END PROC dossectors;INT PROC 
+mediadescriptor:bpbbyte(21)END PROC mediadescriptor;INT PROC fatsectors:
+bpbbyte(23)*256+bpbbyte(22)END PROC fatsectors;INT PROC beginoffat(INT CONST 
+fatcopyno):reservedsectors+fatcopyno*fatsectorsEND PROC beginoffat;INT PROC 
+fatentrys:anzahldatencluster+2.anzahldatencluster:int((dossectors-
+tabellensektoren)/real(sectorspercluster)).tabellensektoren:real(
+reservedsectors+fatcopies*fatsectors+dirsectors).END PROC fatentrys;INT PROC 
+beginofdir:reservedsectors+fatcopies*fatsectors.END PROC beginofdir;REAL 
+PROC beginofcluster(REAL CONST clusterno):beginofdataarea+(clusterno-2.0)*
+real(sectorspercluster)END PROC beginofcluster;INT PROC clustersize:512*
+sectorsperclusterEND PROC clustersize;BOOL PROC bpbexists(INT CONST no):
+exists("bpb ds")AND no>0AND no<4.END PROC bpbexists;PROC writebpb(INT CONST 
+no):INT VAR return;writeblock(old("bpb ds"),no+1,0,0,return);IF return<>0
+THEN errorstop("Schreibfehler")FI .END PROC writebpb;INT PROC eublock(INT 
+CONST dosblockno):IF hdversionTHEN dosblocknoELSE dosblocknofloppyformatFI .
+dosblocknofloppyformat:IF pageformatTHEN head*eusectorsperhead+trac*eusectors
++sectorELSE head*eusectors+trac*abs(euheads)*eusectors+sectorFI .pageformat:
+euheads<0.sector:dosblocknoMOD sectorspertrack.trac:(dosblocknoDIV 
+sectorspertrack)DIV heads.head:(dosblocknoDIV sectorspertrack)MOD heads.
+eusectorsperhead:eusectors*eutracks.eusectors:eulastsector-eufirstsector+1.
+END PROC eublock;INT PROC eublock(REAL CONST dosblockno):eublock(lowword(
+dosblockno)).END PROC eublock;PROC bpbdumpmodus(BOOL CONST status):
+bpbdumpflag:=statusEND PROC bpbdumpmodus;END PACKET dosdisk;
+
diff --git a/app/baisy/2.2.1-schulis/src/dos hd inserter b/app/baisy/2.2.1-schulis/src/dos hd inserter
new file mode 100644
index 0000000..ed8da22
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dos hd inserter
@@ -0,0 +1,12 @@
+IF NOT singleuserTHEN do(
+"IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI"
+);FI ;archive("dos");checkoff;commanddialogue(FALSE );fetch("insert.dos",
+archive);fetch("bpb ds",archive);IF singleuserTHEN do(PROC (TEXT CONST )gens,
+ALL "insert.dos");gens("manager/S.dos")ELSE fetch(ALL "insert.dos",archive);
+fetch("manager/M.dos",archive);release(archive);do(PROC (TEXT CONST )genm,
+ALL "insert.dos");genm("manager/M.dos");FI ;do("hd version (TRUE)");forget(
+"insert.dos",quiet);forget("dos hd inserter",quiet);IF NOT singleuserTHEN do(
+"dos manager (29)")FI .singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name
+):insert(name);forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):fetch(
+t,archive);insert(t);forget(t,quiet)END PROC gens;
+
diff --git a/app/baisy/2.2.1-schulis/src/dos inserter b/app/baisy/2.2.1-schulis/src/dos inserter
new file mode 100644
index 0000000..fcf3d05
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dos inserter
@@ -0,0 +1,15 @@
+IF NOT singleuserTHEN do(
+"IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI"
+);FI ;archive("dos");checkoff;commanddialogue(FALSE );hol("shard interface");
+hol("bpb ds");hol("insert.dos");IF singleuserTHEN do(PROC (TEXT CONST )gens,
+ALL "insert.dos");gens("manager/S.dos")ELSE do(PROC (TEXT CONST )hol,ALL 
+"insert.dos");hol("manager/M.dos");release(archive);do(PROC (TEXT CONST )genm
+,ALL "insert.dos");genm("manager/M.dos");putline(
+"jetzt mit 'dos manager' bzw. 'dos manager (channnel)' starten");FI ;do(
+"hd version (FALSE)");do("load shard interface table");forget(
+"shard interface",quiet);forget("insert.dos",quiet);forget("dos inserter",
+quiet).singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name):insert(name);
+forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):hol(t);insert(t);
+forget(t,quiet)END PROC gens;PROC hol(TEXT CONST t):IF NOT exists(t)THEN 
+fetch(t,archive)FI END PROC hol;
+
diff --git a/app/baisy/2.2.1-schulis/src/dump b/app/baisy/2.2.1-schulis/src/dump
new file mode 100644
index 0000000..4eb0737
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dump
@@ -0,0 +1,12 @@
+PACKET dumpDEFINES dump:TEXT VAR ergebnis:="";PROC dump(TEXT CONST kommentar,
+dumptext):ergebnis:=kommentar;ergebnisCAT ": ";INT VAR i;FOR iFROM 1UPTO 
+LENGTH dumptextREP zeichenschreibenPER ;ergebnisschreiben.zeichenschreiben:
+INT CONST charcode:=code(dumptextSUB i);IF charcode<32THEN ergebnisCAT ("$"+
+text(charcode)+"$")ELSE ergebnisCAT code(charcode)FI .END PROC dump;PROC dump
+(TEXT CONST kommentar,INT CONST dumpint):ergebnis:=kommentar;ergebnisCAT ": "
+;ergebnisCAT text(dumpint);ergebnisschreiben.END PROC dump;PROC dump(TEXT 
+CONST kommentar,REAL CONST dumpreal):ergebnis:=kommentar;ergebnisCAT ": ";
+ergebnisCAT text(dumpreal);ergebnisschreiben.END PROC dump;PROC 
+ergebnisschreiben:FILE VAR f:=sequentialfile(output,"logbuch");putline(f,
+ergebnis);ergebnis:="".END PROC ergebnisschreiben;END PACKET dump;
+
diff --git a/app/baisy/2.2.1-schulis/src/editorfunktionen b/app/baisy/2.2.1-schulis/src/editorfunktionen
new file mode 100644
index 0000000..495f320
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/editorfunktionen
@@ -0,0 +1,56 @@
+PACKET editorfunktionenDEFINES editiere,editierewieeingestellt,zeigedatei,
+zeigedateiwieeingestellt,indateivorblaettern,killundenter,andateianfang,
+andateiende,aufeditstack,aufeditstackundloeschen,voneditstack,
+druckendereditorhilfsdatei,editorunterlegung,loeschendereditorhilfsdatei:LET 
+standardtasten="�bcqhst!19h?o",maxzeilenlaenge=78,maxzeilennr=23,
+erweiterungstasten="gpd";FILE VAR f;TEXT VAR editorhilfsdatei,editortasten;
+LET temp="temporäre Druckdatei";INT VAR basiszeile;ROW maxzeilennrTEXT VAR 
+untergrundzeile;PROC zeigedateiwieeingestellt:zeigedatei(editorhilfsdatei,
+editortasten)END PROC zeigedateiwieeingestellt;PROC zeigedatei(TEXT CONST 
+name,tasten):store(FALSE );f:=sequentialfile(modify,name);editorhilfsdatei:=
+name;editortasten:=tasten;openeditor(f,FALSE );edit(groesstereditor,
+standardtasten+tasten,PROC leaveeditor);INT VAR xkoord,ykoord;INT CONST 
+aktlineno:=lineno(f);geteditcursor(xkoord,ykoord);basiszeile:=aktlineno-
+ykoord;store(TRUE )END PROC zeigedatei;PROC indateivorblaettern(BOOL CONST 
+vorwaerts):IF vorwaertsTHEN toline(f,min(lines(f),lineno(f)+maxzeilennr))
+ELSE toline(f,max(1,lineno(f)-maxzeilennr))FI ;return(1)END PROC 
+indateivorblaettern;PROC editiere(TEXT CONST name):inituntergrundzeilen;
+editieren(name,standardtasten)END PROC editiere;PROC editiere(TEXT CONST name
+,TEXT CONST tasten):inituntergrundzeilen;editieren(name,standardtasten+tasten
+)END PROC editiere;PROC editiere(TEXT CONST name,BOOL CONST standard):
+inituntergrundzeilen;IF standardTHEN editiere(name)ELSE editiere(name,
+erweiterungstasten)FI END PROC editiere;PROC editiere(TEXT CONST name,TEXT 
+CONST tasten,BOOL CONST standard):inituntergrundzeilen;IF standardTHEN 
+editiere(name,tasten)ELSE editiere(name,erweiterungstasten+tasten)FI END 
+PROC editiere;PROC editierewieeingestellt:editieren(editorhilfsdatei,
+editortasten)END PROC editierewieeingestellt;PROC editieren(TEXT CONST name,
+TEXT CONST tasten):store(FALSE );f:=sequentialfile(modify,name);
+editorhilfsdatei:=name;editortasten:=tasten;edit(f,tasten,PROC leaveeditor);
+INT VAR xkoord,ykoord;INT CONST aktlineno:=lineno(f);geteditcursor(xkoord,
+ykoord);basiszeile:=aktlineno-ykoord;store(TRUE )END PROC editieren;PROC 
+leaveeditor(TEXT CONST t):IF pos("19"+erweiterungstasten,t)>0THEN 
+stdkommandointerpreter(t)ELSE seteingabe(t);quitFI END PROC leaveeditor;PROC 
+killundenter(INT CONST steps):forget(editorhilfsdatei,quiet);enter(steps)END 
+PROC killundenter;PROC andateianfang:toline(f,1);return(1)END PROC 
+andateianfang;PROC andateiende:toline(f,lines(f));return(1)END PROC 
+andateiende;PROC aufeditstackundloeschen:type("�p"+"�q");edit(f);return(1)
+END PROC aufeditstackundloeschen;PROC aufeditstack:type("�d"+"�q");edit(f);
+return(1)END PROC aufeditstack;PROC voneditstack:type("�g"+"�q");edit(f);
+return(1)END PROC voneditstack;PROC loeschendereditorhilfsdatei:forget(
+editorhilfsdatei,quiet);enter(2)END PROC loeschendereditorhilfsdatei;PROC 
+druckendereditorhilfsdatei:FILE VAR datei;forget(temp,quiet);copy(
+editorhilfsdatei,temp);datei:=sequentialfile(modify,temp);tofirstrecord(datei
+);INT VAR i;FOR iFROM 1UPTO 5REP insertrecord(datei)PER ;tofirstrecord(datei)
+;TEXT VAR satz:="Stand:   "+date+"    "+timeofday;writerecord(datei,satz);
+satz:="Dateiname:    "+editorhilfsdatei;toline(datei,2);writerecord(datei,
+satz);print(temp);forget(temp,quiet);return(1)END PROC 
+druckendereditorhilfsdatei;PROC inituntergrundzeilen:INT VAR zeilennr;FOR 
+zeilennrFROM 1UPTO maxzeilennrREP untergrundzeile(zeilennr):=""PER END PROC 
+inituntergrundzeilen;TEXT PROC editorunterlegung(INT CONST i):IF i=1THEN 
+blankzeileELSE IF schondaTHEN diesezeileELSE neuezeileFI FI .blankzeile:
+maxzeilenlaenge*" ".schonda:TEXT VAR diesezeile:=untergrundzeile(i-1);
+diesezeile<>"".neuezeile:TEXT VAR nzeile:="";toline(f,basiszeile+i);
+readrecord(f,nzeile);IF nzeile=""THEN nzeile:=blankzeileFI ;untergrundzeile(i
+-1):=nzeile;toline(f,basiszeile);nzeile.END PROC editorunterlegung;END 
+PACKET editorfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/erf.auskuenfte b/app/baisy/2.2.1-schulis/src/erf.auskuenfte
new file mode 100644
index 0000000..f838768
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/erf.auskuenfte
@@ -0,0 +1,66 @@
+PACKET erfauskuenfteDEFINES erfassungauskuenfte,sicherungauskunftsname,
+sicherungauskunftstext,zwischenspeicherungdestextes:LET maskenname=
+"mb erf auskuenfte",fnrletztesfeld=5,fnrschluessel=2,fnrmaskenname=3,
+fnrmaskenfeldnr=4,fnrschluesselverzeichnis=5,trenner=" = ",leer="";TEXT VAR 
+auskmaskenname,auskunftsname:="",auskunftstext:="",sicherungdestextes:="";
+INT VAR dateinummer:=0;TAG VAR auskmaske;PROC erfassungauskuenfte(INT CONST 
+proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2:
+zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+auskunftlesenCASE 7:auskunftaendernCASE 8:auskunfteinfuegenCASE 9:
+auskunftloeschenENDSELECT ;END PROC erfassungauskuenfte;PROC 
+setzeerfassungsparameter:dateinummer:=dnrausk;setzeerfassungsparameter(
+dateinummer,maskenname,fnrletztesfeld)END PROC setzeerfassungsparameter;PROC 
+zeigeschluesselzurbearbeitung:setzeerfassungsfeld("",fnrmaskenname);
+setzeerfassungsfeld("",fnrmaskenfeldnr);setzeerfassungsfeld(wert(fnrschlverz)
+,fnrschluesselverzeichnis)END PROC zeigeschluesselzurbearbeitung;PROC 
+pruefeplausibilitaet:LET leer="",meldungmaskegibtsnicht=8;INT VAR 
+fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert,
+fnrschluessel,1,32000,leer,fehlerstatus);IF fehlerstatus<>0THEN 
+setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;auskmaskenname
+:=erfassungswert(fnrmaskenname);IF auskunftsmaskennameangegebenTHEN IF 
+maskegibtes(auskmaskenname)THEN holemaske;ELSE setzefehlerstatus(
+fnrmaskenname);melde(erfassungsmaske,meldungmaskegibtsnicht);LEAVE 
+pruefeplausibilitaetFI ;FI .auskunftsmaskennameangegeben:auskmaskenname<>"".
+holemaske:initmaske(auskmaske,auskmaskenname).END PROC pruefeplausibilitaet;
+PROC setzewertefuerdbspeicherung:IF sicherungdestextes=""THEN putwert(
+fnrauskunftstext,auskunftstext)ELSE restoretupel(dnrausk,sicherungdestextes);
+FI ;putwert(fnrauskunftsname,erfassungswert(fnrschluessel));putwert(
+fnrschlverz,erfassungswert(fnrschluesselverzeichnis));END PROC 
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET 
+trennsymbolfuerobli="$";TEXT VAR identizeile:="";identizeile:=wert(
+fnrauskunftsname)+trenner;identizeileCAT wert(fnrauskunftstext);INT VAR 
+feldlaenge:=maxidentizeilenlaenge;setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemaxlang:subtext(identizeile,1,
+feldlaenge,"�","�",TRUE ).identizeilemitschluesselanhang:identizeilemaxlang+
+trennsymbolfuerobli+wert(fnrauskunftsname).END PROC 
+setzeidentiobjektfuerobjektliste;PROC auskunftlesen:INT VAR fehlerstatus;
+pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert,fnrschluessel,1
+,32000,leer,fehlerstatus);IF fehlerstatus=0THEN inittupel(dnrausk);putwert(
+fnrauskunftsname,erfassungswert(fnrschluessel));search(dnrausk,TRUE );IF 
+dbstatus=okTHEN saveupdateposition(dnrausk)FI ;auskunftstext:=wert(
+fnrauskunftstext);auskunftsname:=erfassungswert(fnrschluessel);ELSE dbstatus(
+notfound)FI ENDPROC auskunftlesen;TEXT PROC sicherungauskunftsname:
+auskunftsnameENDPROC sicherungauskunftsname;TEXT PROC sicherungauskunftstext:
+auskunftstextENDPROC sicherungauskunftstext;PROC zwischenspeicherungdestextes
+(TEXT CONST text):putwert(fnrauskunftstext,text);savetupel(dnrausk,
+sicherungdestextes)ENDPROC zwischenspeicherungdestextes;PROC auskunftaendern:
+restoreupdateposition(dnrausk);update(dnrausk);logbucheintrag("geändert");
+sicherungdestextes:="";IF dbstatus=okAND auskmaskenname<>""THEN 
+auskunftanmaskeanknuepfenFI END PROC auskunftaendern;PROC auskunfteinfuegen:
+insert(dnrausk);logbucheintrag("eingefügt");IF dbstatus=okAND auskmaskenname
+<>""THEN auskunftanmaskeanknuepfenFI ;sicherungdestextes:="";END PROC 
+auskunfteinfuegen;PROC auskunftloeschen:delete(dnrausk);logbucheintrag(
+"gelöscht");sicherungdestextes:="";END PROC auskunftloeschen;PROC 
+logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Auskunft ";
+eintragCAT schluessel;eintragCAT " ";eintragCAT logergaenzung;logeintrag(
+eintrag)END PROC logbucheintrag;TEXT PROC schluessel:erfassungswert(
+fnrschluessel)END PROC schluessel;PROC auskunftanmaskeanknuepfen:INT VAR ug:=
+int(subtext(erfassungswert(fnrmaskenfeldnr),1,3)),og:=int(subtext(
+erfassungswert(fnrmaskenfeldnr),4,6)),ab:=int(subtext(erfassungswert(
+fnrmaskenfeldnr),7,8));INT VAR ifnr;IF og=0THEN og:=ug;ab:=1ELSE IF ab=0THEN 
+ab:=1FI ;FI ;ifnr:=ug;WHILE ifnr<=ogREP IF fieldexists(auskmaske,ifnr)THEN 
+auskunftsnr(auskmaske,ifnr,int(schluessel))FI ;ifnrINCR abPER ;setzemaske(
+auskmaske);maskespeichern(auskmaskenname);END PROC auskunftanmaskeanknuepfen;
+END PACKET erfauskuenfte
+
diff --git a/app/baisy/2.2.1-schulis/src/eu disk descriptor b/app/baisy/2.2.1-schulis/src/eu disk descriptor
new file mode 100644
index 0000000..50f2b7d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/eu disk descriptor
@@ -0,0 +1,26 @@
+PACKET eudiskDEFINES loadshardinterfacetable,openeudisk,eusize,euheads,
+eutracks,eufirstsector,eulastsector:LET tablelength=15,sizefield=1,headfield=
+2,trackfield=3,firstsectorfield=4,lastsectorfield=5;ROW tablelengthROW 5INT 
+VAR formattable;INT VAR tabletop:=0,tablepointer;PROC openeudisk:enablestop;
+initcheckrerun;IF hdversionTHEN LEAVE openeudiskFI ;INT CONST blocks:=
+archiveblocks;IF blocks<=0THEN errorstop("keine Diskette eingelegt")FI ;
+searchformattableentry.searchformattableentry:IF tabletop<1THEN errorstop(
+"SHard-Interfacetabelle nicht geladen")FI ;tablepointer:=1;WHILE formattable[
+tablepointer][sizefield]<>blocksREP tablepointerINCR 1;IF tablepointer>
+tabletopTHEN errorstop("Diskettenformat nicht implementiert")FI PER .END 
+PROC openeudisk;PROC loadshardinterfacetable:FILE VAR f:=sequentialfile(input
+,"shard interface");TEXT VAR line;tabletop:=0;WHILE NOT eof(f)REP getline(f,
+line);IF (lineSUB 1)<>";"THEN loadlineFI PER .loadline:tabletopINCR 1;IF 
+tabletop>tablelengthTHEN errorstop("Shard Interface Tabelle zu groß")FI ;INT 
+VAR blankpos:=1;formattable[tabletop][sizefield]:=nextint;formattable[
+tabletop][headfield]:=nextint;formattable[tabletop][trackfield]:=nextint;
+formattable[tabletop][firstsectorfield]:=nextint;formattable[tabletop][
+lastsectorfield]:=nextint.nextint:line:=compress(subtext(line,blankpos))+" ";
+blankpos:=pos(line," ");int(subtext(line,1,blankpos-1)).END PROC 
+loadshardinterfacetable;INT PROC eusize:formattable[tablepointer][sizefield]
+END PROC eusize;INT PROC euheads:formattable[tablepointer][headfield]END 
+PROC euheads;INT PROC eutracks:formattable[tablepointer][trackfield]END PROC 
+eutracks;INT PROC eufirstsector:formattable[tablepointer][firstsectorfield]
+END PROC eufirstsector;INT PROC eulastsector:formattable[tablepointer][
+lastsectorfield]END PROC eulastsector;END PACKET eudisk;
+
diff --git a/app/baisy/2.2.1-schulis/src/f packet.sc b/app/baisy/2.2.1-schulis/src/f packet.sc
new file mode 100644
index 0000000..b9c3e15
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/f packet.sc
@@ -0,0 +1,9 @@
+ PACKETfpacket DEFINESfetchfast,savefast: LETuuuuuv=50,uuuuuw=51,uuuuux=47,uuuuuy=66,uuuuuz=0,uuuuvu=1; INT VARuuuuvv; DATASPACE VARuuuuvw; BOUND TEXT VARuuuuvx; TASK
+ VARuuuuvy; TEXT VARuuuuvz:=""; PROCfetchfast( TEXT CONSTuuuuwv): TASK VARuuuuww;uuuuvy:=/uuuuwv;forget(uuuuvw);uuuuvw:=nilspace;call(/uuuuwv,uuuuux,uuuuvw,uuuuvv
+); IFuuuuvv=uuuuuz THENuuuuyv FI.uuuuyv: REPforget(uuuuvw);wait(uuuuvw,uuuuvv,uuuuww); SELECTuuuuvv OF CASEuuuuuv:uuuuvx:=uuuuvw;uuuuvz:=uuuuvx;uuuvuv CASEuuuuuw:
+forget(uuuuvz,quiet);copy(uuuuvw,uuuuvz);uuuvuv OTHERWISE:uuuvvv ENDSELECT PER.uuuvvv: IFuuuuww=uuuuvy CANDuuuuvv=uuuuuy THEN LEAVEuuuuyv ELSEuuuvww FI.uuuvww:send
+(uuuuww,uuuuvu,uuuuvw).uuuvuv:send(uuuuww,uuuuuz,uuuuvw). ENDPROCfetchfast; PROCsavefast( TASK CONSTuuuvyv): THESAURUS VARuuuvyw:= ALLmyself; INT VARuuuvyx;uuuvyy
+;uuuvyz;uuuvzu.uuuvyy:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuz,uuuuvw).uuuvyz:uuuvyx:=0;get(uuuvyw,uuuuvz,uuuvyx); WHILEuuuvyx>0 REPuuuwvv;get(uuuvyw,uuuuvz
+,uuuvyx) PER;.uuuwvv:uuuwwu;uuuwwv.uuuwwu:forget(uuuuvw);uuuuvw:=nilspace;uuuuvx:=uuuuvw;uuuuvx:=uuuuvz;call(uuuvyv,uuuuuv,uuuuvw,uuuuvv).uuuwwv:forget(uuuuvw);uuuuvw
+:=old(uuuuvz);call(uuuvyv,uuuuuw,uuuuvw,uuuuvv).uuuvzu:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuy,uuuuvw). ENDPROCsavefast; ENDPACKETfpacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/fat.dos b/app/baisy/2.2.1-schulis/src/fat.dos
new file mode 100644
index 0000000..79129b9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fat.dos
@@ -0,0 +1,82 @@
+PACKET dosfatDEFINES readfat,writefat,firstfatblockok,clearfatds,formatfat,
+fatentry,lastfatchainentry,islastfatchainentry,erasefatchain,
+availablefatentry:LET fatsize=16384,maxanzahlfatsektoren=64;LET FAT =BOUND 
+STRUCT (ALIGN dummy,ROW 256INT blockrow,ROW fatsizeINT fatrow);DATASPACE VAR 
+fatds;INITFLAG VAR fatdsused:=FALSE ;FAT VAR fatstruktur;.fat:fatstruktur.
+fatrow.REAL VAR erstermoeglicherfreiereintrag;BOOL VAR kleinesfatformat;PROC 
+readfat:fatdsinitialisieren;fatbloeckelesen;fatformatbestimmen;
+erstermoeglicherfreiereintrag:=2.0.fatdsinitialisieren:clearfatds;fatstruktur
+:=fatds.fatbloeckelesen:LET keintestblock=FALSE ;INT VAR blockno;FOR blockno
+FROM 0UPTO fatsectors-1REP fatblocklesen(blockno,keintestblock)PER .
+fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE 
+kleinesfatformat:=FALSE FI .END PROC readfat;PROC writefat:disablestop;INT 
+VAR blocknr;FOR blocknrFROM 0UPTO fatsectors-1REP fatblockschreiben(blocknr)
+PER .END PROC writefat;BOOL PROC firstfatblockok:enablestop;LET testblock=
+TRUE ;fatblocklesen(0,testblock);INT VAR i;FOR iFROM 1UPTO 256REP 
+vergleichewoerterPER ;TRUE .vergleichewoerter:IF fat[i]<>fatstruktur.blockrow
+[i]THEN LEAVE firstfatblockokWITH FALSE FI .END PROC firstfatblockok;PROC 
+clearfatds:IF initialized(fatdsused)THEN forget(fatds)FI ;fatds:=nilspace.
+END PROC clearfatds;PROC formatfat:fatdsinitialisieren;fatformatbestimmen;
+erstermoeglicherfreiereintrag:=2.0;writefirstfourfatbytes;writeotherfatbytes;
+vermerkeschreibzugriffe;writefat.fatdsinitialisieren:clearfatds;fatstruktur:=
+fatds.fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE 
+kleinesfatformat:=FALSE FI .writefirstfourfatbytes:fat[1]:=word(
+mediadescriptor,255);IF kleinesfatformatTHEN fat[2]:=word(255,0)ELSE fat[2]:=
+word(255,255)FI .writeotherfatbytes:INT VAR i;FOR iFROM 3UPTO 256*fatsectors
+REP fat[i]:=0PER .vermerkeschreibzugriffe:FOR iFROM 0UPTO fatsectors-1REP 
+schreibzugriff(i)PER .END PROC formatfat;REAL PROC fatentry(REAL CONST 
+realentryno):INT CONST entryno:=int(realentryno);IF kleinesfatformatTHEN 
+construct12bitvalueELSE dint(fat[entryno+1],0)FI .construct12bitvalue:INT 
+CONST firstbyteno:=entryno+entrynoDIV 2;IF entrynoMOD 2=0THEN real((rightbyte
+MOD 16)*256+leftbyte)ELSE real(rightbyte*16+leftbyteDIV 16)FI .leftbyte:
+fatbyte(firstbyteno).rightbyte:fatbyte(firstbyteno+1).END PROC fatentry;TEXT 
+VAR convertbuffer:="12";INT PROC fatbyte(INT CONST no):replace(convertbuffer,
+1,word);IF evenbytenoTHEN code(convertbufferSUB 1)ELSE code(convertbufferSUB 
+2)FI .evenbyteno:noMOD 2=0.word:fat[noDIV 2+1].END PROC fatbyte;PROC fatentry
+(REAL CONST realentryno,realvalue):INT CONST entryno:=int(realentryno),value
+:=lowword(realvalue);IF kleinesfatformatTHEN write12bitvalueELSE fat[entryno+
+1]:=value;schreibzugriff(entrynoDIV 256)FI ;updatefirstpossibleavailableentry
+.write12bitvalue:INT CONST firstbyteno:=entryno+entrynoDIV 2;schreibzugriff(
+fatblockoffirstbyte);schreibzugriff(fatblockofsecondbyte);writevalue.
+fatblockoffirstbyte:firstbytenoDIV 512.fatblockofsecondbyte:secondbytenoDIV 
+512.writevalue:IF evenentrynoTHEN writefatbyte(firstbyteno,valueMOD 256);
+writefatbyte(secondbyteno,(rightbyteDIV 16)*16+valueDIV 256)ELSE writefatbyte
+(firstbyteno,(leftbyteMOD 16)+16*(valueMOD 16));writefatbyte(secondbyteno,
+valueDIV 16)FI .evenentryno:entrynoMOD 2=0.secondbyteno:firstbyteno+1.
+leftbyte:fatbyte(firstbyteno).rightbyte:fatbyte(secondbyteno).
+updatefirstpossibleavailableentry:IF value=0THEN 
+erstermoeglicherfreiereintrag:=min(erstermoeglicherfreiereintrag,realentryno)
+FI .END PROC fatentry;PROC writefatbyte(INT CONST byteno,newvalue):
+readoldword;changebyte;writenewword.readoldword:replace(convertbuffer,1,word)
+.writenewword:word:=convertbufferISUB 1.word:fat[bytenoDIV 2+1].changebyte:
+replace(convertbuffer,bytepos,code(newvalue)).bytepos:bytenoMOD 2+1.END PROC 
+writefatbyte;REAL PROC lastfatchainentry:IF kleinesfatformatTHEN 4088.0ELSE 
+65528.0FI .END PROC lastfatchainentry;BOOL PROC islastfatchainentry(REAL 
+CONST value):value>=lastfatchainentryEND PROC islastfatchainentry;PROC 
+erasefatchain(REAL CONST firstentryno):REAL VAR nextentryno:=firstentryno,
+actentryno:=0.0;WHILE nextentryexistsREP actentryno:=nextentryno;nextentryno
+:=fatentry(actentryno);fatentry(actentryno,0.0)PER .nextentryexists:NOT 
+islastfatchainentry(nextentryno).END PROC erasefatchain;REAL PROC 
+availablefatentry:INT VAR i;REAL VAR reali:=erstermoeglicherfreiereintrag;
+FOR iFROM int(erstermoeglicherfreiereintrag)UPTO fatentrys-1REP IF fatentry(
+reali)=0.0THEN erstermoeglicherfreiereintrag:=reali;LEAVE availablefatentry
+WITH erstermoeglicherfreiereintragFI ;realiINCR 1.0PER ;closework;errorstop(
+"MS-DOS Datentraeger voll");1.0e99.END PROC availablefatentry;PROC 
+fatblocklesen(INT CONST blocknr,BOOL CONST testblock):disablestop;IF NOT 
+testblockTHEN keinschreibzugriff(blocknr)FI ;INT VAR kopienr;FOR kopienrFROM 
+0UPTO fatcopies-1REP clearerror;readdiskblock(fatds,dsseitennr,diskblocknr)
+UNTIL NOT iserrorPER ;IF iserrorTHEN closeworkFI .dsseitennr:IF testblock
+THEN 2ELSE blocknr+2+1FI .diskblocknr:beginoffat(kopienr)+blocknr.END PROC 
+fatblocklesen;PROC fatblockschreiben(INT CONST blocknr):IF warschreibzugriff(
+blocknr)THEN wirklichschreibenFI .wirklichschreiben:disablestop;INT VAR 
+kopienr;FOR kopienrFROM 0UPTO fatcopies-1REP 
+writediskblockandcloseworkiferror(fatds,dsseitennr,diskblocknr)PER ;
+keinschreibzugriff(blocknr).dsseitennr:blocknr+2+1.diskblocknr:beginoffat(
+kopienr)+blocknr.END PROC fatblockschreiben;ROW maxanzahlfatsektorenBOOL VAR 
+schreibzugrifftabelle;PROC schreibzugriff(INT CONST fatsektor):
+schreibzugrifftabelle[fatsektor+1]:=TRUE END PROC schreibzugriff;PROC 
+keinschreibzugriff(INT CONST fatsektor):schreibzugrifftabelle[fatsektor+1]:=
+FALSE END PROC keinschreibzugriff;BOOL PROC warschreibzugriff(INT CONST 
+fatsektor):schreibzugrifftabelle[fatsektor+1]END PROC warschreibzugriff;END 
+PACKET dosfat;
+
diff --git a/app/baisy/2.2.1-schulis/src/fetch b/app/baisy/2.2.1-schulis/src/fetch
new file mode 100644
index 0000000..3b91788
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fetch
@@ -0,0 +1,108 @@
+PACKET fetchDEFINES fetch,checkfile:LET ascii=1,asciigerman=2,transparent=3,
+rowtext=5,ds=6,dump=7,atarist=10,ibm=11,minlineendchar="
+",maxlineendchar="
"
+,lf="
+",cr="
",tabcode=9,lfcode=10,ffcode=12,crcode=13,ctrlz="�",pagecmd=
+"#page#",rowtextlength=4000,rowtexttype=1000;BOUND STRUCT (INT size,ROW 
+rowtextlengthTEXT clusterrow)VAR clusterstruct;FILE VAR file;TEXT VAR buffer;
+INT VAR bufferlength;PROC fetch(TEXT CONST name,DATASPACE VAR fileds,INT 
+CONST mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent:
+fetchfilemode(fileds,name,mode)CASE rowtext:fetchrowtextmode(fileds,name)
+CASE ds:fetchdsmode(fileds,name)CASE dump:fetchdumpmode(fileds,name)
+OTHERWISE errorstop("Unzulässige Betriebsart")END SELECT .END PROC fetch;
+PROC fetchfilemode(DATASPACE VAR filespace,TEXT CONST name,INT CONST codetype
+):enablestop;initializefetchfilemode;openfetchdosfile(name);WHILE NOT 
+waslastfetchclusterREP gettextofcluster;writelines;IF lines(file)>3900THEN 
+putline(file,">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<")
+;LEAVE fetchfilemodeFI ;UNTIL fileendviactrlzPER ;writelastlineifnecessary;
+closefetchdosfile.initializefetchfilemode:buffer:="";bufferlength:=0;forget(
+filespace);filespace:=nilspace;file:=sequentialfile(output,filespace);BOOL 
+VAR fileendviactrlz:=FALSE .gettextofcluster:catnextfetchdoscluster(buffer);
+IF asciicodeTHEN ctrlzisbufferendFI ;adaptcode(buffer,bufferlength+1,codetype
+);bufferlength:=length(buffer).asciicode:(codetype=ascii)OR (codetype=
+asciigerman).ctrlzisbufferend:INT CONST ctrlzpos:=pos(buffer,ctrlz,
+bufferlength+1);fileendviactrlz:=ctrlzpos>0;IF fileendviactrlzTHEN buffer:=
+subtext(buffer,1,ctrlzpos-1);bufferlength:=length(buffer)FI .writelines:INT 
+VAR linebeginpos:=1,lineendpos;computelineendpos;WHILE lineendpos>0REP 
+putline(file,subtext(buffer,linebeginpos,lineendpos));exec(PROC (TEXT CONST ,
+INT CONST )controlcharconversion,file,codetype);linebeginpos:=lineendpos+1;
+computelineendposPER ;buffer:=subtext(buffer,linebeginpos);bufferlength:=
+length(buffer);IF bufferlength>5000THEN putline(file,buffer);exec(PROC (TEXT 
+CONST ,INT CONST )controlcharconversion,file,codetype);buffer:="";
+bufferlength:=0FI .computelineendpos:lineendpos:=linebeginpos;REP lineendpos
+:=pos(buffer,minlineendchar,maxlineendchar,lineendpos);INT CONST lineendcode
+:=code(bufferSUB lineendpos);SELECT lineendcodeOF CASE lfcode:lookforcrCASE 
+11:lineendposINCR 1CASE crcode:lookforlfEND SELECT UNTIL lineendcode<>11PER .
+lookforcr:IF lineendpos=bufferlengthTHEN lineendpos:=0ELIF (bufferSUB 
+lineendpos+1)=crTHEN lineendposINCR 1FI .lookforlf:IF lineendpos=bufferlength
+THEN lineendpos:=0ELIF (bufferSUB lineendpos+1)=lfTHEN lineendposINCR 1FI .
+writelastlineifnecessary:IF bufferlength>0THEN putline(file,buffer);exec(
+PROC (TEXT CONST ,INT CONST )controlcharconversion,file,codetype);FI .END 
+PROC fetchfilemode;PROC adaptcode(TEXT VAR textbuffer,INT CONST startpos,
+codetype):SELECT codetypeOF CASE ascii:cancelbit8CASE asciigerman:cancelbit8;
+asciigermanadaptionCASE atarist:ataristadaptionCASE ibm:ibmadaptionEND 
+SELECT .cancelbit8:INT VAR setpos:=pos(textbuffer,"�","�",startpos);WHILE 
+setpos>0REP replace(textbuffer,setpos,sevenbitchar);setpos:=pos(textbuffer,
+"�","�",setpos+1)PER .sevenbitchar:code(code(textbufferSUB setpos)AND 127).
+asciigermanadaption:changeallbyreplace(textbuffer,startpos,"[","Ä");
+changeallbyreplace(textbuffer,startpos,"\","Ö");changeallbyreplace(textbuffer
+,startpos,"]","Ü");changeallbyreplace(textbuffer,startpos,"{","ä");
+changeallbyreplace(textbuffer,startpos,"|","ö");changeallbyreplace(textbuffer
+,startpos,"}","ü");changeallbyreplace(textbuffer,startpos,"~","ß").
+ataristadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä");
+changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer
+,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä");
+changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer
+,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß").
+ibmadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä");
+changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer
+,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä");
+changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer
+,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß").END PROC 
+adaptcode;PROC changeallbyreplace(TEXT VAR string,INT CONST beginpos,TEXT 
+CONST old,new):INT VAR p:=pos(string,old,beginpos);WHILE p>0REP replace(
+string,p,new);p:=pos(string,old,p+1)PER .END PROC changeallbyreplace;PROC 
+controlcharconversion(TEXT VAR string,INT CONST codetype):IF codetype<>
+transparentTHEN codeconversionFI .codeconversion:INT VAR p:=pos(string,"�",
+"�",1);WHILE p>0REP convertchar;p:=pos(string,"�","�",p)PER .convertchar:INT 
+CONST charcode:=code(stringSUB p);SELECT charcodeOF CASE tabcode:expandtab
+CASE lfcode:change(string,p,p,"")CASE ffcode:change(string,p,p,pagecmd)CASE 
+crcode:change(string,p,p,"")OTHERWISE ersatzdarstellungEND SELECT .expandtab:
+change(string,p,p,(8-(p-1)MOD 8)*" ").ersatzdarstellung:TEXT CONST t:=text(
+charcode);change(string,p,p,"#"+(3-length(t))*"0"+t+"#").END PROC 
+controlcharconversion;PROC fetchrowtextmode(DATASPACE VAR filespace,TEXT 
+CONST name):enablestop;openfetchdosfile(name);initializefetchrowtextmode;
+WHILE NOT waslastfetchclusterREP clusterstruct.sizeINCR 1;clusterstruct.
+clusterrow[clusterstruct.size]:="";catnextfetchdoscluster(clusterstruct.
+clusterrow[clusterstruct.size])PER ;closefetchdosfile.
+initializefetchrowtextmode:forget(filespace);filespace:=nilspace;
+clusterstruct:=filespace;type(filespace,rowtexttype);clusterstruct.size:=0.
+END PROC fetchrowtextmode;PROC fetchdsmode(DATASPACE VAR inds,TEXT CONST name
+):enablestop;openfetchdosfile(name);initfetchdsmode;WHILE NOT 
+waslastfetchclusterREP readnextfetchdoscluster(inds,dsblockno);PER ;
+closefetchdosfile.initfetchdsmode:forget(inds);inds:=nilspace;INT VAR 
+dsblockno:=2.END PROC fetchdsmode;PROC fetchdumpmode(DATASPACE VAR filespace,
+TEXT CONST name):enablestop;openfetchdosfile(name);initializefetchdumpmode;
+WHILE NOT waslastfetchclusterREP TEXT VAR clusterbuffer:="";
+catnextfetchdoscluster(clusterbuffer);dumpclusterUNTIL offset>50000.0PER ;
+closefetchdosfile.initializefetchdumpmode:BOOL VAR fertig:=FALSE ;REAL VAR 
+offset:=0.0;forget(filespace);filespace:=nilspace;file:=sequentialfile(output
+,filespace).dumpcluster:TEXT VAR dumpline;INT VAR line,column;FOR lineFROM 0
+UPTO (clustersizeDIV 16)-1REP builddumpline;putline(file,dumpline);offset
+INCR 16.0UNTIL fertigPER .builddumpline:TEXT VAR charline:="";dumpline:=text(
+offset,6,0);dumpline:=subtext(dumpline,1,5);dumplineCAT "   ";FOR columnFROM 
+0UPTO 7REP convertchar;dumplineCAT " "PER ;dumplineCAT " ";FOR columnFROM 8
+UPTO 15REP convertchar;dumplineCAT " "PER ;dumplineCAT "  ";dumplineCAT 
+charline.convertchar:TEXT CONST char:=clusterbufferSUB (line*16+column+1);IF 
+char=""THEN fertig:=TRUE ;dumplineCAT "  ";LEAVE convertcharFI ;INT CONST 
+charcode:=code(char);LET hexchars="0123456789ABCDEF";dumplineCAT (hexchars
+SUB (charcodeDIV 16+1));dumplineCAT (hexcharsSUB (charcodeMOD 16+1));charline
+CAT showchar.showchar:IF (charcode>31AND charcode<127)THEN charELSE "."FI .
+END PROC fetchdumpmode;PROC checkfile(TEXT CONST name):disablestop;DATASPACE 
+VAR testds:=nilspace;enablecheckfile(name,testds);forget(testds);IF iserror
+THEN clearerror;errorstop("Fehler beim Prüflesen der Datei """+name+"""")FI .
+END PROC checkfile;PROC enablecheckfile(TEXT CONST name,DATASPACE VAR testds)
+:enablestop;openfetchdosfile(name);WHILE NOT waslastfetchclusterREP INT VAR 
+dummy:=2;readnextfetchdoscluster(testds,dummy)PER ;closefetchdosfile.END 
+PROC enablecheckfile;END PACKET fetch;
+
diff --git a/app/baisy/2.2.1-schulis/src/fetch save interface b/app/baisy/2.2.1-schulis/src/fetch save interface
new file mode 100644
index 0000000..24abb49
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fetch save interface
@@ -0,0 +1,16 @@
+PACKET fetchsaveDEFINES savefetchmode,path:LET ascii=1,asciigerman=2,
+transparent=3,rowtext=5,ds=6,dump=7,atarist=10,ibm=11;INT PROC savefetchmode(
+TEXT CONST reservestring):TEXT VAR modus;INT CONST p:=pos(reservestring,":");
+IF p=0THEN modus:=reservestringELSE modus:=subtext(reservestring,1,p-1)FI ;
+modusnormieren;IF modus="FILEASCII"THEN asciiELIF modus="FILEASCIIGERMAN"
+THEN asciigermanELIF modus="FILEATARIST"THEN ataristELIF modus="FILEIBM"THEN 
+ibmELIF modus="FILETRANSPARENT"THEN transparentELIF modus="ROWTEXT"THEN 
+rowtextELIF modus="DS"THEN dsELIF modus="DUMP"THEN dumpELSE errorstop(
+"Unzulässige Betriebsart");-1FI .modusnormieren:changeall(modus," ","");INT 
+VAR i;FOR iFROM 1UPTO LENGTH modusREP INT CONST charcode:=code(modusSUB i);
+IF islowercaseTHEN replace(modus,i,uppercasechar)FI PER .islowercase:charcode
+>96AND charcode<123.uppercasechar:code(charcode-32).END PROC savefetchmode;
+TEXT PROC path(TEXT CONST reservestring):INT CONST p:=pos(reservestring,":");
+IF p=0THEN ""ELSE subtext(reservestring,p+1)FI .END PROC path;END PACKET 
+fetchsave;
+
diff --git a/app/baisy/2.2.1-schulis/src/get put interface.dos b/app/baisy/2.2.1-schulis/src/get put interface.dos
new file mode 100644
index 0000000..1e80856
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/get put interface.dos
@@ -0,0 +1,103 @@
+PACKET dosgetputDEFINES logmodus,opendosdisk,closedosdisk,accessdosdisk,
+openfetchdosfile,closefetchdosfile,catnextfetchdoscluster,
+readnextfetchdoscluster,waslastfetchcluster,opensavedosfile,
+writenextsavedoscluster,closesavedosfile,erasedosfile,alldosfiles,
+alldossubdirs,dosfileexists,doslist,cleardosdisk,formatdosdisk:BOOL VAR 
+logflag:=FALSE ;PROC logmodus(BOOL CONST status):logflag:=statusEND PROC 
+logmodus;LET maxclustersize=8192,realspersector=64;LET CLUSTER =BOUND STRUCT 
+(ALIGN dummy,ROW maxclustersizeREAL clusterrow);CLUSTER VAR cluster;
+DATASPACE VAR clusterds;INITFLAG VAR clusterdsused:=FALSE ;TEXT VAR 
+convertbuffer;INT VAR convertbufferlength;PROC initclusterhandle:IF 
+initialized(clusterdsused)THEN forget(clusterds)FI ;clusterds:=nilspace;
+cluster:=clusterds;convertbuffer:="";convertbufferlength:=0.END PROC 
+initclusterhandle;PROC catclustertext(REAL CONST clusterno,TEXT VAR 
+destination,INT CONST to):readdiskcluster(clusterds,2,clusterno);
+initconvertbuffer;INT VAR i;FOR iFROM 1UPTO sectorspercluster*realspersector
+REP replace(convertbuffer,i,cluster.clusterrow[i])PER ;destinationCAT subtext
+(convertbuffer,1,to).initconvertbuffer:IF convertbufferlength<clustersize
+THEN convertbufferCAT (clustersize-convertbufferlength)*"*";
+convertbufferlength:=clustersizeFI .END PROC catclustertext;PROC 
+writetexttocluster(REAL CONST clusterno,TEXT CONST string):IF LENGTH string<
+clustersizeTHEN executewritetext(text(string,clustersize))ELSE 
+executewritetext(string)FI ;writediskcluster(clusterds,2,clusterno).END PROC 
+writetexttocluster;PROC executewritetext(TEXT CONST string):INT VAR i;FOR i
+FROM 1UPTO sectorspercluster*realspersectorREP cluster.clusterrow[i]:=string
+RSUB iPER .END PROC executewritetext;BOOL VAR diskopen:=FALSE ;TEXT VAR 
+actpath;REAL VAR lastaccesstime;PROC opendosdisk(TEXT CONST path):IF logflag
+THEN dump("open dos disk",path)FI ;enablestop;closework;initclusterhandle;
+actpath:=path;diskopen:=TRUE END PROC opendosdisk;PROC closedosdisk:IF 
+logflagTHEN dump("close dos disk","")FI ;enablestop;diskopen:=FALSE ;
+closework;initclusterhandle;clearfatds;initdirds.END PROC closedosdisk;PROC 
+accessdosdisk:enablestop;IF NOT diskopenTHEN errorstop(
+"DOS-Arbeit nicht eröffnet")FI ;IF workclosedCOR (
+lastaccessmorethan5secondsagoCAND diskchanged)THEN openeudisk;opendosdisk;
+readfat;opendir(actpath);lastaccesstime:=clock(1);openworkFI .
+lastaccessmorethan5secondsago:abs(clock(1)-lastaccesstime)>5.0.diskchanged:
+IF hdversionTHEN FALSE ELSE lastaccesstime:=clock(1);NOT firstfatblockokFI .
+END PROC accessdosdisk;REAL VAR nextfetchcluster,fetchrest;PROC 
+openfetchdosfile(TEXT CONST filename):IF logflagTHEN dump(
+"open fetch dos file",filename)FI ;enablestop;accessdosdisk;fileinfo(filename
+,nextfetchcluster,fetchrest).END PROC openfetchdosfile;BOOL PROC 
+waslastfetchcluster:IF logflagTHEN dump("was last fetch cluster","")FI ;
+islastfatchainentry(nextfetchcluster)OR fetchrest<=0.0.END PROC 
+waslastfetchcluster;PROC catnextfetchdoscluster(TEXT VAR buffer):IF logflag
+THEN dump("cat next fetch dos cluster","")FI ;enablestop;IF 
+waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;IF fetchrest<
+real(clustersize)THEN catclustertext(nextfetchcluster,buffer,int(fetchrest));
+fetchrest:=0.0ELSE catclustertext(nextfetchcluster,buffer,clustersize);
+fetchrestDECR real(clustersize)FI ;lastaccesstime:=clock(1);nextfetchcluster
+:=fatentry(nextfetchcluster).END PROC catnextfetchdoscluster;PROC 
+readnextfetchdoscluster(DATASPACE VAR readds,INT VAR startpage):IF logflag
+THEN dump("read next fetch dos cluster",startpage)FI ;enablestop;IF 
+waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;readdiskcluster(
+readds,startpage,nextfetchcluster);lastaccesstime:=clock(1);startpageINCR 
+sectorspercluster;nextfetchcluster:=fatentry(nextfetchcluster);IF fetchrest<
+real(clustersize)THEN fetchrest:=0.0ELSE fetchrestDECR real(clustersize)FI .
+END PROC readnextfetchdoscluster;PROC closefetchdosfile:IF logflagTHEN dump(
+"close fetch dos file","")FI ;END PROC closefetchdosfile;TEXT VAR savename;
+REAL VAR firstsavecluster,lastsavecluster,savesize;PROC opensavedosfile(TEXT 
+CONST filename):IF logflagTHEN dump("open save dos file",filename)FI ;
+enablestop;accessdosdisk;IF fileexists(filename)OR subdirexists(filename)
+THEN errorstop("die Datei """+filename+""" gibt es schon")FI ;savename:=
+filename;firstsavecluster:=-1.0;savesize:=0.0.END PROC opensavedosfile;PROC 
+writenextsavedoscluster(TEXT CONST buffer):IF logflagTHEN dump(
+"write next save dos cluster","")FI ;enablestop;REAL CONST savecluster:=
+availablefatentry;writetexttocluster(savecluster,buffer);lastaccesstime:=
+clock(1);savesizeINCR real(LENGTH buffer);IF firstsavecluster<2.0THEN 
+firstsavecluster:=saveclusterELSE fatentry(lastsavecluster,savecluster)FI ;
+fatentry(savecluster,lastfatchainentry);lastsavecluster:=savecluster.END 
+PROC writenextsavedoscluster;PROC writenextsavedoscluster(DATASPACE CONST 
+saveds,INT VAR startpage):IF logflagTHEN dump("write next save dos cluster",
+startpage)FI ;enablestop;REAL CONST savecluster:=availablefatentry;
+writediskcluster(saveds,startpage,savecluster);lastaccesstime:=clock(1);
+startpageINCR sectorspercluster;savesizeINCR real(clustersize);IF 
+firstsavecluster<2.0THEN firstsavecluster:=saveclusterELSE fatentry(
+lastsavecluster,savecluster)FI ;fatentry(savecluster,lastfatchainentry);
+lastsavecluster:=savecluster.END PROC writenextsavedoscluster;PROC 
+closesavedosfile:IF logflagTHEN dump("close save dos file","")FI ;enablestop;
+IF firstsavecluster<2.0THEN LEAVE closesavedosfileFI ;fatentry(
+lastsavecluster,lastfatchainentry);writefat;insertdirentry(savename,
+firstsavecluster,savesize);lastaccesstime:=clock(1).END PROC closesavedosfile
+;PROC erasedosfile(TEXT CONST filename):IF logflagTHEN dump("erase dos file",
+filename)FI ;enablestop;accessdosdisk;REAL VAR firstcluster,size;fileinfo(
+filename,firstcluster,size);deletedirentry(filename);erasefatchain(
+firstcluster);writefat;lastaccesstime:=clock(1).END PROC erasedosfile;
+THESAURUS PROC alldosfiles:IF logflagTHEN dump("all dosfile","")FI ;
+enablestop;accessdosdisk;allfiles.END PROC alldosfiles;THESAURUS PROC 
+alldossubdirs:IF logflagTHEN dump("all subdirs","")FI ;enablestop;
+accessdosdisk;allsubdirs.END PROC alldossubdirs;BOOL PROC dosfileexists(TEXT 
+CONST filename):IF logflagTHEN dump("dos file exists",filename)FI ;enablestop
+;accessdosdisk;fileexists(filename).END PROC dosfileexists;PROC doslist(
+DATASPACE VAR listds):IF logflagTHEN dump("dos list","")FI ;enablestop;
+accessdosdisk;dirlist(listds).END PROC doslist;PROC cleardosdisk:IF logflag
+THEN dump("clear dos disk","")FI ;enablestop;IF hdversionTHEN errorstop(
+"nicht implementiert")ELSE accessdosdisk;formatdir;formatfat;lastaccesstime:=
+clock(1)FI .END PROC cleardosdisk;PROC formatdosdisk(INT CONST formatcode):
+IF logflagTHEN dump("format dos disk ("+text(formatcode)+")","")FI ;
+enablestop;IF NOT diskopenTHEN errorstop("DOS-Arbeit nicht eröffnet")FI ;IF 
+hdversionTHEN errorstop("nicht implementiert")ELSE doformatFI .doformat:IF 
+bpbexists(formatcode)THEN closework;formatarchive(formatcode);openeudisk;
+writebpb(formatcode);opendosdisk;formatdir;formatfat;openworkELSE errorstop(
+"Format unzulässig")FI ;lastaccesstime:=clock(1).END PROC formatdosdisk;END 
+PACKET dosgetput;
+
diff --git a/app/baisy/2.2.1-schulis/src/insert.dos b/app/baisy/2.2.1-schulis/src/insert.dos
new file mode 100644
index 0000000..6788f3f
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/insert.dos
@@ -0,0 +1,15 @@
+dump
+konvert
+open
+eu disk descriptor
+disk descriptor.dos
+block i/o
+name conversion.dos
+fat.dos
+dir.dos
+get put interface.dos
+fetch save interface
+fetch
+save 
+
+
diff --git a/app/baisy/2.2.1-schulis/src/isp archive.sc b/app/baisy/2.2.1-schulis/src/isp archive.sc
new file mode 100644
index 0000000..f608a95
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp archive.sc
@@ -0,0 +1,35 @@
+ PACKETisparchive DEFINESarchivefiles,archivesize,savetoarchive,fetchfromarchive,initarchive,cleararchive,cleararchivetask,checkarchive,listarchive,formatarchive,
+channelfree,logonarchive,logoffarchive,cleareacharchive,writefactor,readafterwrite,kf: LETuuuuuv=1,uuuuuw=2,uuuuux=34,uuuuuy=35,uuuuuz=25,uuuuvu=26,uuuuvv=36,uuuuvw
+=37,uuuuvx=39,uuuuvy=40,uuuuvz=41,uuuuwu=42,uuuuwv=43,uuuuww=44,uuuuwx=45,uuuuwy=46,uuuuwz=47,uuuuxu=48,uuuuxv=200,uuuuxw="�",fehlertext="ARCHIVE-Fehler: "; LET ARCHIVECONTROL
+= STRUCT( INTuuuuxx, BOOLuuuuxy); BOUND ARCHIVECONTROL VARuuuuxz; INT VARuuuuyu,uuuuyv,uuuuyw,uuuuyx:=1; THESAURUS VARuuuuyy; TEXT VARuuuuyz:=""; BOOL VARuuuuzu:=
+ FALSE,uuuuzv:= FALSE,uuuuzw:= FALSE; BOUND STRUCT( INTuuuuzx, ROWuuuuxv TEXTuuuuzz) VARuuuvuu; DATASPACE VARuuuvuv; PROCkf( BOOL CONSTuuuvux):uuuuzw:=uuuvux ENDPROC
+kf; PROCreadafterwrite( BOOL CONSTuuuuxy):uuuuzv:=uuuuxy ENDPROCreadafterwrite; BOOL PROCreadafterwrite:uuuuzv ENDPROCreadafterwrite; PROCwritefactor( INT CONSTuuuuxy
+):uuuuyx:=uuuuxy ENDPROCwritefactor; INT PROCwritefactor:uuuuyx ENDPROCwritefactor; BOOL PROCcleareacharchive:uuuuzu ENDPROCcleareacharchive; PROCcleareacharchive
+( BOOL CONSTuuuvyx):uuuuzu:=uuuvyx ENDPROCcleareacharchive; PROCcleararchivetask:logoffarchive;logonarchive ENDPROCcleararchivetask; THESAURUS PROCarchivefiles:uuuuyy
+ ENDPROCarchivefiles; INT PROCarchivesize:archivesize( SOMEmyself) ENDPROCarchivesize; INT PROCarchivesize( THESAURUS CONSTuuuwvu):uuuuyy:=uuuwvu;uuuuyu:=0;uuuuyv
+:=1;uuuuyw:=0;get(uuuuyy,uuuuyz,uuuuyu); WHILEuuuuyu>0 REPuuuuyw INCRstorage(old(uuuuyz));uuuuyv INCR1;get(uuuuyy,uuuuyz,uuuuyu) PER;uuuuyw ENDPROCarchivesize; TASK
+ PROCuuuwyu:/"isp.archive" ENDPROCuuuwyu; BOUND TEXT VARuuuwyw; BOUND INT VARuuuwyx; DATASPACE VARuuuwyy; INT VARuuuwyz; TASK VARuuuwzu:=niltask; PROCformatarchive
+( TEXT CONSTuuuwzw):formatarchive(0,uuuwzw) ENDPROCformatarchive; PROCformatarchive( INT CONSTuuuxuv, TEXT CONSTuuuwzw): IFpos("0123",text(uuuxuv))>0 THENuuuxuy(uuuuvy
+,code(uuuxuv)+uuuwzw, TRUE) FI ENDPROCformatarchive; PROCsavetoarchive( THESAURUS CONSTuuuwvu): IFuuuuzu THENcleararchive; FI;do( PROC( TEXT CONST)uuuxwv,uuuwvu);
+ ENDPROCsavetoarchive; PROCfetchfromarchive:uuuxwz;uuuxxu;uuuxxv.uuuxwz:uuuxxx;call(uuuwyu,uuuuvz,uuuwyy,uuuwyz).uuuxxu: INT VARuuuxyx:=uuuuvz; WHILEuuuwyz<>uuuuvx
+ REPuuuxzv; IFuuuwyz=uuuuvw THENuuuxzy ELSEuuuxxx;call(uuuwyu,uuuxyx,uuuwyy,uuuwyz) FI PER.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop(
+fehlertext+uuuwyw) CASEuuuuvw: IFcommanddialogue THENuuuyvz;uuuwyw:=uuuwyy;out(uuuwyw) FI CASEuuuuvv:uuuyvz; IFuuuywz THENerrorstop("Archivieren inkonsistent abgebrochen"
+) FI;uuuxyx:=uuuuwu ENDSELECT.uuuxxv: INT VARuuuyxx;forget(uuuvuv);uuuvuv:=uuuwyy;uuuvuu:=uuuvuv; FORuuuyxx FROM1 UPTOuuuvuu.uuuuzx REP#out("<"+uuuvuu.uuuuzz[uuuyxx
+]+">");uuuyvz;#uuuyzy PER;forget(uuuvuv).uuuyzy:uuuxxx;uuuwyx:=uuuwyy;uuuwyx:=uuuyxx;call(uuuwyu,uuuuwv,uuuwyy,uuuwyz);forget(uuuvuu.uuuuzz[uuuyxx],quiet);copy(uuuwyy
+,uuuvuu.uuuuzz[uuuyxx]). ENDPROCfetchfromarchive; BOOL PROCuuuywz: REPuuuyvz; IFonline THENout(2*uuuuxw) FI; IFyes("Nachfolgende Archive-Diskette eingelegt") THEN
+ LEAVEuuuywz WITH FALSE FI UNTILuuuuzw COR( NOTuuuuzw CANDyes("Sicherung wirklich abbrechen")) PER; TRUE ENDPROCuuuywz; PROCuuuxwv( TEXT CONSTuuuzyw#, BOOL PROCuuuzyx
+#):save(uuuzyw,uuuwyu); IFcommanddialogue THENuuuyvz;out(""""+uuuzyw+""" wird gesichert!");#uuuyvz# FI;uuuzzx;uuuzzy.uuuzzx:uuuxxx;uuuuxz:=uuuwyy;uuuuxz.uuuuxx:=uuuuyx
+;uuuuxz.uuuuxy:=uuuuzv;call(uuuwyu,uuuuux,uuuwyy,uuuwyz);uuvuwv.uuvuwv: WHILEuuuwyz<>uuuuvv REPuuuxzv;uuuxzy PER.uuuzzy: REP IFuuuwyz=uuuuvv THENuuuyvz; IFuuuywz THEN
+errorstop("Sichern eventuell inkonsistent abgebrochen!"); LEAVEuuuxwv ELSE IFuuuuzu THENcleararchive; FI;out(""""+uuuzyw+""" wird gesichert!"); FI ELSEuuuxzv FI;uuuxxx
+; IF NOTuuvuzu THENcall(uuuwyu,uuuuuy,uuuwyy,uuuwyz) ELSEuuuxzy FI; PER.uuvuzu:uuuwyz=uuuuvw.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop
+(fehlertext+uuuwyw) CASEuuuuvx: LEAVEuuuxwv CASEuuuuvw: IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz;out(uuuwyw); FI ENDSELECT. ENDPROCuuuxwv; PROCinitarchive( TEXT
+ CONSTuuvvxu):uuuxuy(uuuuwz,uuvvxu, TRUE) ENDPROCinitarchive; PROCcheckarchive:uuuxuy(uuuuxu) ENDPROCcheckarchive; PROCcleararchive:uuuxuy(uuuuuz) ENDPROCcleararchive
+; PROClistarchive:uuuxuy(uuuuvu);forget("ISP-Archive",quiet);type(uuuwyy,1003);copy(uuuwyy,"ISP-Archive");show("ISP-Archive");forget("ISP-Archive",quiet) ENDPROClistarchive
+; PROClogonarchive:uuuxuy(uuuuwx,"", FALSE) ENDPROClogonarchive; PROClogoffarchive:uuuxuy(uuuuwy,"", FALSE) ENDPROClogoffarchive; PROCuuuxuy( INT CONSTuuvwvy):uuuxuy
+(uuvwvy,"", FALSE) ENDPROCuuuxuy; PROCuuuxuy( INT CONSTuuvwvy, TEXT CONSTuuvwwy, BOOL CONSTuuvwwz):uuvwxu; WHILEuuvwxv REPuuvwxw;uuuxzy PER.uuvwxv:uuuwyz<>uuuuvx.
+uuvwxu:uuuxxx; IFuuvwwz THENuuuwyw:=uuuwyy;uuuwyw:=uuvwwy FI;call(uuuwyu,uuvwvy,uuuwyy,uuuwyz).uuvwxw: IFuuuwyz=uuuuvw THEN IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz
+;out(uuuwyw) FI ELIFuuuwyz=uuuuuw THENuuuwyw:=uuuwyy;enablestop;errorstop(fehlertext+uuuwyw) FI. ENDPROCuuuxuy; PROCuuuxzy: REPforget(uuuwyy);wait(uuuwyy,uuuwyz,uuuwzu
+); IF NOT(uuuwzu=uuuwyu) THEN#note("IN WARTE: "+text(uuuwyz)+"/"+name(uuuwzu));noteline;#uuvxxy FI UNTILuuuwzu=uuuwyu PER ENDPROCuuuxzy; PROCuuvxxy:send(uuuwzu,uuuuuv
+,uuuwyy) ENDPROCuuvxxy; PROCchannelfree: DATASPACE VARuuvxzw:=nilspace;send(uuuwyu,uuuuww,uuvxzw);forget(uuvxzw) ENDPROCchannelfree; PROCuuuxxx:forget(uuuwyy);uuuwyy
+:=nilspace ENDPROCuuuxxx; PROCuuuyvz: IFonline THENline; FI ENDPROCuuuyvz; ENDPACKETisparchive;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftseditor b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor
new file mode 100644
index 0000000..abf50d4
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor
@@ -0,0 +1,27 @@
+PACKET ispauskunftseditorDEFINES auskunftstextaendernvp,
+auskunftstextaendernnp,auskunftstextspeichern:LET dateiname=
+"Auskunftstext zur Auskunft ";LET editorfenster=77,eol="�",stop="�";TEXT VAR 
+datnam;PROC auskunftstextaendernvp:datnam:=dateiname+sicherungauskunftsname;#
+FILE VAR dat:=sequentialfile(output,datnam);#store(FALSE );IF 
+sicherungauskunftstext<>""THEN auskunftindatei(datnam,sicherungauskunftstext)
+FI ;wordwrap(TRUE );page;editiere(datnam,"s",FALSE ).END PROC 
+auskunftstextaendernvp;PROC auskunftstextaendernnp:store(FALSE );
+editierewieeingestelltEND PROC auskunftstextaendernnp;PROC 
+auskunftstextspeichern(PROC (INT CONST )spezerfassungauskuenfte,BOOL CONST 
+speichern):originalsituation;IF speichernTHEN TEXT VAR t;auskunftintext(
+datnam,t);#putwert(fnrauskunftstext,t);#zwischenspeicherungdestextes(t);FI ;
+forget(datnam,quiet);return(1);angegebenedatenpruefenundevtlspeichern(
+speichern,PROC spezerfassungauskuenfte);END PROC auskunftstextspeichern;PROC 
+auskunftintext(TEXT CONST datnam,TEXT VAR auskunft):FILE VAR dat:=
+sequentialfile(input,datnam);TEXT VAR zeile;IF eof(dat)THEN close(dat);
+auskunft:=""ELSE auskunft:="";REP getline(dat,zeile);auskunft:=auskunft+
+encode(zeile);UNTIL eof(dat)PER ;FI END PROC auskunftintext;PROC 
+auskunftindatei(TEXT CONST datnam,TEXT CONST te):FILE VAR dat:=sequentialfile
+(output,datnam);TEXT VAR zeile,auskunft:=te;INT VAR bottom:=1,top:=1;INT VAR 
+l:=length(auskunft);formatierezeile;REP schreibe;formatierezeile;UNTIL (top>=
+l)CAND (zeile="")PER .formatierezeile:zeile:="";IF bottom>=lTHEN zeile:=""
+ELSE top:=min(bottom+editorfenster-1,l);zeile:=subtext(auskunft,bottom,top,
+eol,stop,FALSE );topINCR 1;bottom:=topFI .schreibe:putline(dat,zeile).END 
+PROC auskunftindatei;PROC originalsituation:reorganizescreen;store(TRUE )END 
+PROC originalsituation;END PACKET ispauskunftseditor;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
new file mode 100644
index 0000000..0f002ba
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
@@ -0,0 +1,69 @@
+PACKET auskunftsfunktionenDEFINES erteileauskunft,ergaenzeauskunft,
+auskunftszeilenende,auskunftstextende,editauskunft,quadrant:LET eol="�",stop=
+"�",fuereditor=TRUE ,fuermaske=FALSE ;TEXT CONST standardtext:=
+"Die gewünschte Auskunft ist leider noch nicht verfügbar!"+stop;TEXT CONST 
+auskunftszeilenende:=eol;TEXT CONST auskunftstextende:=stop;TEXT VAR 
+auskunftergaenzung:="";INT VAR auskunftergaenzungsnr:=0;PROC ergaenzeauskunft
+(TEXT CONST durch,INT CONST fuer):auskunftergaenzung:=durch;
+auskunftergaenzungsnr:=fuerEND PROC ergaenzeauskunft;TEXT PROC atext(INT 
+CONST nr):TEXT VAR grundauskunft;IF wert(fnrauskunftstext)=""THEN 
+grundauskunft:=standardtextELSE grundauskunft:=wert(fnrauskunftstext)FI ;IF (
+auskunftergaenzung<>"")CAND (nr=auskunftergaenzungsnr)THEN grundauskunftCAT 
+auskunftergaenzungFI ;grundauskunftEND PROC atext;TEXT PROC astichwort:
+systemdbon;wert(fnrschlverz)END PROC astichwort;WINDOW PROC altesfenster:INT 
+VAR i,j,k,l;quadrant(i,j,k,l);startwindow(i,j,k,l)END PROC altesfenster;PROC 
+quadrant(INT VAR i,j,k,l):merkeposition;fenster.merkeposition:INT VAR x,y;
+getcursorposfuerauskunft(x,y).fenster:INT VAR x1,y1,x2,y2;IF vierterquadrant
+THEN x1:=1;y1:=12;x2:=39;y2:=1ELIF dritterquadrantTHEN x1:=40;y1:=12;x2:=77;
+y2:=1ELIF zweiterquadrantTHEN x1:=1;y1:=24;x2:=39;y2:=13ELIF ersterquadrant
+THEN x1:=40;y1:=24;x2:=77;y2:=13FI ;i:=x1;j:=y1;k:=x2;l:=y2.ersterquadrant:(x
+<40)CAND (y<13).zweiterquadrant:(x>39)CAND (y<13).dritterquadrant:(x<40)CAND 
+(y>12).vierterquadrant:(x>39)CAND (y>12).END PROC quadrant;PROC holeauskunft(
+INT CONST name):putintwert(fnrauskunftsname,name);search(dnrausk,TRUE );END 
+PROC holeauskunft;PROC erteileauskunft(INT CONST nr):WINDOW VAR w:=
+altesfenster;TEXT VAR auskunft:="";TEXT CONST st:=" = ";INT CONST suchname:=
+nr;INT VAR anzahl:=5;systemdbon;erteileauskunftbody;systemdboff;
+wiederaufsetzen.erteileauskunftbody:IF menuedraussenTHEN reorganizescreenFI ;
+open(w);auskunftholen;zeige.auskunftholen:holeauskunft(suchname);.zeige:IF 
+dbstatus=okTHEN auskunft:=atext(suchname)ELSE auskunft:=standardtext;putwert(
+fnrschlverz,"")FI ;stwpruefen;auskunfterteilung(auskunft,w,fuermaske);.
+stwpruefen:IF astichwort<>""THEN textschonmalzeigen(auskunft,w,fuermaske);IF 
+pos(astichwort,"c")=1THEN schluesselverzeichnisausschluesseldateiELSE 
+schluesselverzeichnisnichtausschluesseldateiFI FI ;schlussstern.
+schluesselverzeichnisausschluesseldatei:#INT VAR i:=1;##02.02.88dr#TEXT VAR 
+bestname:=astichwort;systemdboff;bestandsuchen;IF bestandvorhandenTHEN 
+auskunftCAT stop;ankoppelnderabkuerzung;naechstelesen;WHILE erfolgreichREP 
+anhaengen;naechstelesenPER ELSE meldunganhaengen(auskunft,"Bestand "+bestname
++" ist nicht vorhanden")FI .bestandsuchen:inittupel(dnrschluessel);putwert(
+fnrschlsachgebiet,bestname);search(dnrschluessel,FALSE );.bestandvorhanden:
+dbstatus=okCAND wert(fnrschlsachgebiet)=bestname.naechstelesen:anzahl:=18;
+multisucc(dnrschluessel,anzahl);#iINCR 1##02.02.88dr#.erfolgreich:anzahl>0
+CAND wert(fnrschlsachgebiet)=bestname.anhaengen:WHILE anzahl>0REP multisucc;
+IF erfolgreichTHEN ankoppelnderabkuerzung;FI ;anzahlDECR 1UNTIL NOT 
+erfolgreichPER .ankoppelnderabkuerzung:auskunftCAT wert(fnrschlschluessel);
+auskunftCAT st;auskunftCAT wert(fnrschllangtext);auskunftCAT stop;.
+schluesselverzeichnisnichtausschluesseldatei:TEXT VAR dateiname:=astichwort;
+INT VAR dnr:=0;systemdboff;stopbeifalschemnamen(FALSE );dnr:=dateinr(
+dateiname);IF dnr>0THEN first(dnr);IF dbstatus=okTHEN auskunftCAT stop;
+anwendungsdatenkoppeln;dienaechstenanwendungsdatenlesenELSE meldunganhaengen(
+auskunft,"Keine Daten zu "+dateiname+" vorhanden")FI ELSE meldunganhaengen(
+auskunft,"Bestand "+dateiname+" ist nicht vorhanden")FI ;stopbeifalschemnamen
+(TRUE ).dienaechstenanwendungsdatenlesen:INT VAR a:=0;anzahl:=18;multisucc(
+dnr,anzahl);REP IF anzahl>0THEN WHILE a<anzahlREP multisucc;
+anwendungsdatenkoppeln;aINCR 1;PER ;a:=0;anzahl:=18;multisucc(dnr,anzahl)
+ELSE LEAVE dienaechstenanwendungsdatenlesenFI ;PER .anwendungsdatenkoppeln:
+auskunftCAT wert(dnr+1);auskunftCAT st;auskunftCAT wert(dnr+2);auskunftCAT 
+stop.schlussstern:auskunftCAT "*";auskunftCAT stop.wiederaufsetzen:
+reorganizescreen;setlasteditvalues;return(1).END PROC erteileauskunft;PROC 
+erteileauskunft:erteileauskunft(auskunftsnr)END PROC erteileauskunft;PROC 
+meldunganhaengen(TEXT VAR auskunft,TEXT CONST meldtext):auskunftCAT stop;
+auskunftCAT meldtext;auskunftCAT stop;.END PROC meldunganhaengen;PROC 
+editauskunft(INT CONST editnummer):systemdbon;erteileauskunftbody;systemdboff
+;wiederaufsetzen.erteileauskunftbody:auskunftholen;zeige.auskunftholen:
+WINDOW VAR w:=altesfenster;open(w);TEXT VAR auskunft:="";#INT VAR lu,ro;#
+cursor(1,2);holeauskunft(editnummer);IF dbstatus=okTHEN auskunft:=atext(
+editnummer)ELSE auskunft:=standardtextFI ;schlussstern.schlussstern:auskunft
+CAT "*";auskunftCAT stop.zeige:auskunfterteilung(auskunft,w,fuereditor).
+wiederaufsetzen:return(1).END PROC editauskunft;END PACKET 
+auskunftsfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.baisy server b/app/baisy/2.2.1-schulis/src/isp.baisy server
new file mode 100644
index 0000000..dfb77a9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.baisy server
@@ -0,0 +1,80 @@
+PACKET ispbaisyserverDEFINES baisyserver:LET PARAM =STRUCT (TEXT textkey1,
+textkey2,TAG maske);LET endcode=37,savedbcode=38,restoredbcode=39,
+maxthesaurusentry=252,nak=1,aktionsavebase=38,aktionloadbase=39,sendall=47,
+pruefen=40,init=41,loeschen=42,speichern=43,umbenennen=44,kopieren=45,liste=
+46,newtree=52,reorg=53,refinementlist=54,translate=55,retranslate=56,
+eraserefinement=57;LET ack=0,nack=1,ende=3;LET fehldat="Übersetzungsfehler:";
+BOUND PARAM VAR p;INT VAR status;PROC baisyserver:boot;globalmanager(PROC (
+DATASPACE VAR ,INT CONST ,INT CONST ,TASK CONST )baisyserver)END PROC 
+baisyserver;PROC baisyserver(DATASPACE VAR ds,INT CONST auftragsnr,INT CONST 
+dummy,TASK CONST auftraggeber):BOUND THESAURUS VAR boundthesau;THESAURUS VAR 
+thesau;enablestop;status:=ack;fuehreauftragaus;meldezurueck.fuehreauftragaus:
+IF auftragsnr>=newtreeTHEN baumbearbeitungELSE andererdienstFI .
+baumbearbeitung:IF auftragsnr=newtreeTHEN schicktabelleELSE bearbeitetabelle
+FI .bearbeitetabelle:TEXT VAR dateiname:=headline(sequentialfile(input,ds));
+forget(dateiname,quiet);copy(ds,dateiname);forget(ds);SELECT auftragsnrOF 
+CASE refinementlist:listeallerrefinementsCASE translate,reorg:
+bearbeitendesbaumesCASE retranslate:ausdembaumCASE eraserefinement:
+refinementloeschenOTHERWISE falscherauftragEND SELECT ;forget(dateiname,quiet
+).schicktabelle:p:=ds;TEXT VAR startknotenname:=p.textkey1;forget(ds);
+gibbaumtabelle(startknotenname,ds).listeallerrefinements:listederteilbaeume(
+dateiname);ds:=old(dateiname).ausdembaum:BOOL VAR ok;teilbaeumeaussystembaum(
+dateiname,ok);IF NOT okTHEN status:=nackFI ;ds:=old(dateiname).
+refinementloeschen:loescheteilbaeume(dateiname,ok);IF NOT okTHEN status:=nack
+FI ;ds:=old(dateiname).bearbeitendesbaumes:INT CONST dl:=length(dateiname);
+disablestop;continue(int(subtext(dateiname,dl-1,dl)));IF auftragsnr=reorg
+THEN reorganisierenELSE BOOL VAR falsch;uebersetze(dateiname,falsch)FI ;
+startesystembaum;break(quiet);clearerror;enablestop;IF falschTHEN status:=
+nack;ds:=old(fehldat);forget(fehldat,quiet)ELSE ds:=old(dateiname)FI .
+falscherauftrag:errorstop("Ungültiger Auftrag an "+name(myself)).
+andererdienst:p:=ds;SELECT auftragsnrOF CASE pruefen:maskepruefenCASE init:
+maskeinitialisierenCASE loeschen:maskeloeschenCASE speichern:maskespeichern
+CASE umbenennen:maskeumbenennenCASE kopieren:maskekopierenCASE liste:
+maskenlisteCASE sendall:savefast(auftraggeber)CASE aktionsavebase:#savebase#
+senddb(auftraggeber)CASE aktionloadbase:#fetchbase#boundthesau:=ds;thesau:=
+boundthesau;restoredb(auftraggeber,thesau);startesystembaum;
+startemaskenverarbeitungOTHERWISE systemaufrufEND SELECT .maskepruefen:IF 
+NOT tagexists(p.textkey1)THEN status:=endeFI .maskeinitialisieren:p.maske
+INITBY p.textkey1.maskeloeschen:forgettag(p.textkey1).maskespeichern:storetag
+(p.maske,p.textkey1).maskekopieren:copytag(p.textkey1,p.textkey2);.
+maskeumbenennen:renametag(p.textkey1,p.textkey2).maskenliste:TEXT VAR 
+listdatei:=p.textkey1;listedermasken(listdatei);forget(ds);ds:=old(listdatei)
+;forget(listdatei,quiet).meldezurueck:send(auftraggeber,status,ds).
+systemaufruf:IF auftragsnr>=100THEN forget(ds);LEAVE baisyserverELSE 
+freemanager(ds,auftragsnr,dummy,auftraggeber)FI .#savebase:sbase(auftraggeber
+).fetchbase:fbase(auftraggeber,katalog);boot.katalog:BOUND THESAURUS VAR kat
+:=ds;kat.#END PROC baisyserver;PROC boot:startesystembaum;
+startemaskenverarbeitungEND PROC boot;PROC sbase(TASK CONST auftraggeber):
+meldezurueck;saveall(auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace;
+send(auftraggeber,0,ds).END PROC sbase;PROC fbase(TASK CONST auftraggeber,
+THESAURUS VAR katalog):meldezurueck;interessierendeeintraege(katalog);fetch(
+katalog,auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace;send(
+auftraggeber,0,ds).END PROC fbase;PROC interessierendeeintraege(THESAURUS 
+VAR t):LET datenraumpraefix="BAISY-";beginneliste;naechster;WHILE 
+nochwelchedaREP pruefen;naechsterPER .beginneliste:TEXT VAR name;INT VAR 
+index:=0.naechster:get(t,name,index).nochwelcheda:index>0.pruefen:IF pos(name
+,datenraumpraefix)<>1THEN delete(t,index)FI .END PROC 
+interessierendeeintraege;ROW maxthesaurusentryDATASPACE VAR receiveddb;PROC 
+senddb(TASK CONST ordertask):THESAURUS VAR dbthesaurus:=ALL myself;DATASPACE 
+VAR ds;INT VAR tindex;forget(ds);ds:=nilspace;interessierendeeintraege(
+dbthesaurus);sendthesaurus;sendfilesinthesaurus.sendthesaurus:BOUND 
+THESAURUS VAR thesau:=ds;thesau:=dbthesaurus;send(ordertask,savedbcode,ds);.
+sendfilesinthesaurus:TEXT VAR fname;tindex:=0;get(dbthesaurus,fname,tindex);
+WHILE tindex>0REP sendfile;get(dbthesaurus,fname,tindex)PER ;sendend.sendfile
+:pause(10);forget(ds);ds:=old(fname);send(ordertask,savedbcode,ds);.sendend:
+pause(10);ds:=nilspace;send(ordertask,endcode,ds).ENDPROC senddb;PROC 
+restoredb(TASK CONST ordertask,THESAURUS CONST dbthesaurus):INT VAR replycode
+;#THESAURUS VAR olddb:=ALL myself;#DATASPACE VAR ds;TASK VAR sourcetask:=
+niltask;INT VAR tindex;TEXT VAR fname:="";#deleteallfiles;#sendack;rcvdb;
+builddb.#deleteallfiles:TEXT VAR fname;INT VAR tindex;tindex:=0;get(olddb,
+fname,tindex);WHILE tindex>0REP forget(fname,quiet);get(olddb,fname,tindex)
+PER .#sendack:forget(ds);ds:=nilspace;send(ordertask,restoredbcode,ds).rcvdb:
+INT VAR l:=1;REP forget(receiveddb[l]);wait(receiveddb[l],replycode,
+sourcetask);IF NOT (sourcetask=ordertask)THEN forget(receiveddb[l]);sendnack
+ELSE IF replycode=restoredbcodeTHEN lINCR 1ELSE forget(receiveddb[l])FI FI 
+UNTIL replycode=endcodePER .builddb:tindex:=0;l:=1;get(dbthesaurus,fname,
+tindex);WHILE tindex>0REP forget(fname,quiet);copy(receiveddb[l],fname);
+forget(receiveddb[l]);lINCR 1;get(dbthesaurus,fname,tindex)PER .sendnack:
+forget(ds);ds:=nilspace;send(sourcetask,nak,ds).ENDPROC restoredb;ENDPACKET 
+ispbaisyserver;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen
new file mode 100644
index 0000000..ba9f102
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen
@@ -0,0 +1,87 @@
+PACKET ispbenutzerberechtigungenDEFINES erstellebenutzungsberechtigung,
+identistart,aktuellebenutzerkenndatenlesen,pruefeberechtigung,
+setzeanfangsknotennamefuerbenutzerbestand,benutzerbestand:LET standardanfang=
+2,maskenname="mu identifikation",#benbest="cb benutzer",23.07.87#wer=47,
+falsch=39,#benmeth=2,#punkt=".";BOOL VAR pruefungnoetig,gefunden,berechtigt;
+INT VAR anzahlversuche;LET maxversuche=3;;TAG VAR aktuellemaske;INT VAR 
+aktuelleposition;TEXT VAR benutzername,geheimwort,benutzerberechtigung,
+startknotenname:="schulis";PROC hinweisauflizenzfreiesoftwaregeben:TEXT VAR 
+testname;holeberechtigungswert(testname);IF testname=""THEN 
+kopierhinweiszeigenFI .kopierhinweiszeigen:page;cursor(23,3);put(
+"schulis - Schulverwaltungssystem");cursor(27,8);put(
+"Lizenzfreie Software der");cursor(13,10);put(
+"Gesellschaft für Mathematik und Datenverarbeitung mbH");cursor(8,14);put(
+"Die Nutzung der Software ist nur im Schul- und Hochschulbereich ");cursor(20
+,15);put("für nichtkommerzielle Zwecke gestattet.");cursor(16,17);put(
+"Gewährleistung und Haftung werden ausgeschlossen.");cursor(26,23);put(
+"Weiter mit beliebiger Taste");pause(100).END PROC 
+hinweisauflizenzfreiesoftwaregeben;PROC identistart:
+frageentwicklernachseinemnamen;aktuellebenutzerkenndatenlesen;.
+frageentwicklernachseinemnamen:hinweisauflizenzfreiesoftwaregeben;page;
+benutzername:="";geheimwort:="";gefunden:=FALSE ;pruefungnoetig:=TRUE ;
+anzahlversuche:=0;standardkopfmaskeinitialisieren(startknotenname);
+standardkopfmaskeausgeben(text(vergleichsknoten));initmaske(aktuellemaske,
+maskenname);show(aktuellemaske);aktuelleposition:=standardanfang;.END PROC 
+identistart;PROC aktuellebenutzerkenndatenlesen:ROW 100TEXT VAR feld;
+berechtigt:=FALSE ;init(feld);feld(2):=benutzername;feld(3):=geheimwort;
+putget(aktuellemaske,feld,aktuelleposition);benutzername:=feld(2);geheimwort
+:=feld(3);END PROC aktuellebenutzerkenndatenlesen;PROC berechtigungholen:
+systemdbon;IF gefundenTHEN gefunden:=((startknotennameSUB 1)=wert(
+fnrbenutzbestand)CAND benutzername=wert(fnrbenutzname))FI ;
+benutzerberechtigung:="";IF NOT gefundenTHEN putwert(fnrbenutzname,
+benutzername);putwert(fnrbenutzbestand,(startknotennameSUB 1));search(
+dnrbenutz,TRUE );gefunden:=(dbstatus=ok);FI ;IF gefundenTHEN IF (geheimwort=
+wert(fnrbenutzgeheimwort))THEN benutzerberechtigung:=wert(fnrbenutzberecht);
+berechtigt:=TRUE ELSE berechtigt:=FALSE ;aktuelleposition:=standardanfang+1
+FI ELSE aktuelleposition:=standardanfangFI ;systemdboff;END PROC 
+berechtigungholen;PROC pruefeberechtigung:IF pruefungnoetigTHEN 
+berechtigungholen;IF NOT (gefundenAND berechtigt)THEN IF anzahlversuche<
+maxversucheTHEN anzahlversucheINCR 1ELSE anzahlversuche:=0;
+logbucheintraganmeldversuchFI ;meldedies;return(1)ELSE 
+logbucheintraganmeldung;setzebenutzerberechtigung(benutzerberechtigung);
+pruefungnoetig:=FALSE ;pageFI ELSE pageFI ;.meldedies:IF NOT gefundenTHEN 
+meldeauffaellig(aktuellemaske,wer)ELSE meldeauffaellig(aktuellemaske,falsch)
+FI .END PROC pruefeberechtigung;PROC logbucheintraganmeldung:LET 
+loggrenzeerreicht=9,keinreplyvonlog=2,meldungloggrenzeerreicht=93;INT VAR 
+logreply:=0;TEXT VAR eintrag:="Identifikation ";eintragCAT """";eintragCAT 
+name(myself);eintragCAT """ durch """;eintragCAT benutzername;eintragCAT """"
+;logeintrag(eintrag,logreply);IF logreply=loggrenzeerreichtTHEN 
+meldeauffaellig(aktuellemaske,meldungloggrenzeerreicht);pause(20)ELIF 
+logreply=keinreplyvonlogTHEN errorstop(
+"Zur Benutzung des schulis-Systems bitte erst LOG-Task einrichten")FI END 
+PROC logbucheintraganmeldung;PROC logbucheintraganmeldversuch:TEXT VAR 
+eintrag:="mehrfach Identifikation durch """;eintragCAT benutzername;eintrag
+CAT """ versucht";logeintrag(eintrag)END PROC logbucheintraganmeldversuch;
+PROC setzeanfangsknotennamefuerbenutzerbestand(TEXT CONST knotenname):
+startknotenname:=knotenname.END PROC 
+setzeanfangsknotennamefuerbenutzerbestand;TEXT PROC benutzerbestand:
+startknotennameEND PROC benutzerbestand;PROC erstellebenutzungsberechtigung(
+INT CONST felder,INT VAR fehlerin,TEXT VAR einausgabe):pruefeaufkorrektheit;
+pruefeaufpraefixeigenschaft;gebeergebnisaus.pruefeaufkorrektheit:INT VAR i,j,
+bottom;LET maxstring=100;ROW maxstringTEXT VAR strings;TEXT VAR string:="";
+FOR iFROM 1UPTO felderREP bottom:=(i-1)*11;string:=subtext(einausgabe,bottom+
+1,bottom+11);pruefeauffeldkorrektheit;IF korrektTHEN strings(i):=
+bereinigterstringELSE fehlerin:=i;LEAVE erstellebenutzungsberechtigungFI PER 
+.pruefeauffeldkorrektheit:BOOL VAR korrekt:=TRUE ;TEXT VAR bereinigterstring
+:="";TEXT VAR cstr:=compress(string);IF cstr=""THEN bereinigterstring:=""
+ELSE korrekt:=istmenuebaumkennung(cstr,bereinigterstring)FI .
+pruefeaufpraefixeigenschaft:FOR iFROM 1UPTO felderREP FOR jFROM 1UPTO felder
+REP IF i<>jTHEN IF istpraefix(strings(i),strings(j))THEN strings(j):=""FI FI 
+PER PER .gebeergebnisaus:TEXT VAR s,t:="";FOR iFROM 1UPTO felderREP s:=
+strings(i);IF s<>""THEN tCAT "/";tCAT sFI PER ;einausgabe:=t.END PROC 
+erstellebenutzungsberechtigung;BOOL PROC istmenuebaumkennung(TEXT CONST st,
+TEXT VAR bereinigterstring):INT VAR anfang:=1;INT VAR ende:=pos(st,punkt);
+INT VAR l:=length(st);IF ende=lTHEN istzahl(subtext(st,anfang,l-1),
+bereinigterstring)ELIF NOT (ende>0)THEN istzahl(subtext(st,anfang,l),
+bereinigterstring)ELIF istzahl(subtext(st,anfang,ende-1),bereinigterstring)
+THEN bereinigterstringCAT punkt;istmenuebaumkennung(subtext(st,ende+1,l),
+bereinigterstring)ELSE FALSE FI END PROC istmenuebaumkennung;BOOL PROC 
+istzahl(TEXT CONST t,TEXT VAR bereinigterstring):IF ((t<>"")CAND ((t<>"+")
+CAND (t<>"-")))CAND (length(t)<=2)THEN INT VAR i:=int(t);IF lastconversionok
+THEN bereinigterstringCAT text(i);TRUE ELSE FALSE FI ELSE FALSE FI END PROC 
+istzahl;BOOL PROC istpraefix(TEXT CONST s,t):IF (s="")OR (t="")THEN FALSE 
+ELSE pos(aufber(t),aufber(s))=1FI END PROC istpraefix;TEXT PROC aufber(TEXT 
+CONST t):INT CONST l:=length(t);IF (tSUB l)<>punktTHEN t+punktELSE tFI END 
+PROC aufber;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP 
+feld(i):=""PER END PROC initEND PACKET ispbenutzerberechtigungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen
new file mode 100644
index 0000000..2283aa1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen
@@ -0,0 +1,67 @@
+PACKET isperfabkuerzungenDEFINES starterfassungallgemabkuerzungen,
+erfassungallgemabkuerzungen,pruefungabkuerzungen:LET standardmaskenname=
+"mu erf abkuerzungen",bestandallerbestaende="c02 bestand aller bestaende",
+fnrletztesfeld=4,fnrschluessel=2,fnrlangtext=4,trenner=" = ";TEXT VAR 
+bestandname:="",aktmaskenname:="";TEXT VAR schluesselsicherung:="";INT VAR 
+maxschluessellaenge:=0,statistiknummer:=0;BOOL VAR gesamtbestand:=FALSE ,
+erstesmalgelesen:=TRUE ;PROC starterfassungallgemabkuerzungen(TEXT CONST 
+bestand):starterfassungallgemabkuerzungen(bestand,standardmaskenname)ENDPROC 
+starterfassungallgemabkuerzungen;PROC starterfassungallgemabkuerzungen(TEXT 
+CONST bestand,maskenname):reinitparsing;bestandname:=bestand;gesamtbestand:=
+bestandname=bestandallerbestaende;aktmaskenname:=maskenname;
+holeschluessellaengediesesbestands;
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT 
+CONST )erfassungallgemabkuerzungen).holeschluessellaengediesesbestands:
+systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,
+bestandallerbestaende);putwert(fnrschlschluessel,bestandname);search(
+dnrschluessel,TRUE );IF lesenfehlerfreiTHEN maxschluessellaenge:=int(wert(
+fnrschllangtext));ELSE maxschluessellaenge:=0;FI ;putwert(fnrschlsachgebiet,
+bestandname);.lesenfehlerfrei:dbstatus=0.ENDPROC 
+starterfassungallgemabkuerzungen;PROC erfassungallgemabkuerzungen(INT CONST 
+proznr):systemdboff;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2:
+zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+abkuerzunglesenCASE 7:abkuerzungaendernCASE 8:abkuerzungeinfuegenCASE 9:
+abkuerzungloeschenENDSELECT ENDPROC erfassungallgemabkuerzungen;PROC 
+setzeerfassungsparameter:erstesmalgelesen:=TRUE ;setzeerfassungsparameter(
+dnrschluessel,maxschluessellaenge,aktmaskenname,fnrletztesfeld)END PROC 
+setzeerfassungsparameter;PROC zeigeschluesselzurbearbeitung:
+setzeerfassungsfeld(wert(fnrschlschluessel),fnrschluessel);
+setzeerfassungsfeld(wert(fnrschllangtext),fnrlangtext)END PROC 
+zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet:INT VAR fehlerstatus
+:=0;setzefehlerstatus(fehlerstatus)ENDPROC pruefeplausibilitaet;PROC 
+setzewertefuerdbspeicherung:putwert(fnrschlsachgebiet,bestandname);putwert(
+fnrschlschluessel,compress(erfassungswert(fnrschluessel)));putwert(
+fnrschllangtext,erfassungswert(fnrlangtext))ENDPROC 
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET 
+trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(
+fnrschlschluessel)+trenner+wert(fnrschllangtext);identizeile:=subtext(
+identizeile,1,maxidentizeilenlaenge);setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+
+trennsymbolfuerobli+wert(fnrschlschluessel).ENDPROC 
+setzeidentiobjektfuerobjektliste;PROC abkuerzunglesen:putwert(
+fnrschlsachgebiet,bestandname);putwert(fnrschlschluessel,compress(
+erfassungswert(fnrschluessel)));search(dnrschluessel,TRUE );IF dbstatus=ok
+THEN saveupdateposition(dnrschluessel);IF erstesmalgelesenTHEN 
+schluesselsicherung:=wert(fnrschlschluessel);erstesmalgelesen:=FALSE ;FI FI 
+ENDPROC abkuerzunglesen;PROC abkuerzungaendern:restoreupdateposition(
+dnrschluessel);update(dnrschluessel);#IF dbstatus=okCAND statistikbestand
+CAND kuerzelgeaendertTHEN kuerzelnameinstatraumaendern(statistiknummer,
+schluesselsicherung,schluessel)FI ;dr11.05.88#erstesmalgelesen:=dbstatus=ok.#
+kuerzelgeaendert:schluesselsicherung<>schluessel.dr11.05.88#ENDPROC 
+abkuerzungaendern;PROC abkuerzungeinfuegen:insert(dnrschluessel);#IF dbstatus
+=okCAND statistikbestandTHEN kuerzelnameinstatraumeinfuegen(statistiknummer,
+wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:=dbstatus=okENDPROC 
+abkuerzungeinfuegen;PROC abkuerzungloeschen:delete(dnrschluessel);#IF 
+dbstatus=okCAND statistikbestandTHEN kuerzelnameausstatraumentfernen(
+statistiknummer,wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:=
+dbstatus=okEND PROC abkuerzungloeschen;TEXT PROC schluessel:erfassungswert(
+fnrschluessel)END PROC schluessel;BOOL PROC pruefungabkuerzungen:wert(
+fnrschlsachgebiet)=bestandnameEND PROC pruefungabkuerzungen;#dr11.05.88BOOL 
+PROC statistikbestand:LET anzstatistiken=8;ROW anzstatistikenTEXT CONST 
+statistikname:=ROW anzstatistikenTEXT :("","c02 schulart","c02 zugang",
+"c02 versetzung","c02 relizugehoerigkeit","","c02 abgang","c02 abschluss");
+FOR statistiknummerFROM 1UPTO anzstatistikenREP IF statistikname[
+statistiknummer]=bestandnameTHEN LEAVE statistikbestandWITH TRUE FI PER ;
+FALSE END PROC statistikbestand;#END PACKET isperfabkuerzungen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen
new file mode 100644
index 0000000..cab166c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen
@@ -0,0 +1,54 @@
+PACKET erfbenutzerberechtigungenDEFINES erfassungbenutzerberechtigungen:LET 
+maskenname="mu erf benutzerdaten",fnrschluessel=2,maxschluessellaenge=0,
+fnrgeheimwort=3,fnrberechtigunganfang=4,fnrberechtigungende=43,
+meldungkeineberechtigung=75,trenner=" = ";TEXT VAR felderinstring:="",bestand
+:="s";INT VAR dateinummer:=0;#25.03.87#PROC erfassungbenutzerberechtigungen(
+INT CONST proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameter
+CASE 2:zeigeschluesselfuerbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+benutzerlesenCASE 7:benutzeraendernCASE 8:benutzereinfuegenCASE 9:
+benutzerloeschenENDSELECT ;#systemdboff;##26.03.87#END PROC 
+erfassungbenutzerberechtigungen;PROC setzeerfassungsparameter:dateinummer:=
+dnrbenutz;bestand:=benutzerbestandSUB 1;setzeerfassungsparameter(dateinummer,
+maxschluessellaenge,maskenname,fnrberechtigungende)END PROC 
+setzeerfassungsparameter;PROC zeigeschluesselfuerbearbeitung:
+setzeerfassungsfeld(wert(fnrbenutzgeheimwort),fnrgeheimwort);
+berechtigungeninfeldersetzen(wert(fnrbenutzberecht),fnrberechtigunganfang)
+END PROC zeigeschluesselfuerbearbeitung;PROC berechtigungeninfeldersetzen(
+TEXT CONST berechtstring,INT CONST i):TEXT VAR t:=subtext(berechtstring,2);
+INT VAR p:=pos(t,"/");INT VAR l:=length(t);INT VAR j;IF p>0THEN 
+setzeerfassungsfeld(subtext(t,1,p-1),i);berechtigungeninfeldersetzen(subtext(
+t,p),i+1)ELSE setzeerfassungsfeld(subtext(t,1,l),i);FOR jFROM i+1UPTO 
+fnrberechtigungendeREP setzeerfassungsfeld("",j)PER FI END PROC 
+berechtigungeninfeldersetzen;PROC pruefeplausibilitaet:INT VAR fehlerstatus:=
+0;concatenation(felderinstring);erstellebenutzungsberechtigung(anzahl,
+fehlerstatus,felderinstring);IF fehlerstatus<>0THEN melde(erfassungsmaske,
+meldungkeineberechtigung);setzefehlerstatus(fnrberechtigunganfang+
+fehlerstatus-1);LEAVE pruefeplausibilitaetFI .anzahl:fnrberechtigungende-
+fnrberechtigunganfang+1.END PROC pruefeplausibilitaet;PROC concatenation(
+TEXT VAR t):INT VAR i;INT VAR l:=length(erfassungsmaske,fnrberechtigunganfang
+);t:="";FOR iFROM fnrberechtigunganfangUPTO fnrberechtigungendeREP IF 
+erfassungswert(i)<>""THEN tCAT text(erfassungswert(i),l)FI PER END PROC 
+concatenation;PROC setzewertefuerdbspeicherung:putwert(fnrbenutzbestand,
+bestand);putwert(fnrbenutzname,erfassungswert(fnrschluessel));putwert(
+fnrbenutzgeheimwort,erfassungswert(fnrgeheimwort));putwert(fnrbenutzberecht,
+felderinstring)END PROC setzewertefuerdbspeicherung;PROC 
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR 
+identizeile;identizeile:=wert(fnrbenutzname)+trenner+wert(fnrbenutzberecht);
+identizeile:=subtext(identizeile,1,maxidentizeilenlaenge);setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+
+trennsymbolfuerobli+wert(fnrbenutzname).END PROC 
+setzeidentiobjektfuerobjektliste;PROC benutzerlesen:inittupel(dnrbenutz);
+putwert(fnrbenutzbestand,bestand);putwert(fnrbenutzname,erfassungswert(
+fnrschluessel));search(dnrbenutz,TRUE );IF dbstatus=okTHEN saveupdateposition
+(dnrbenutz)FI END PROC benutzerlesen;PROC benutzeraendern:
+restoreupdateposition(dnrbenutz);update(dnrbenutz);logbucheintrag("Änderung")
+END PROC benutzeraendern;PROC benutzereinfuegen:insert(dnrbenutz);
+logbucheintrag("Neueinfügen")END PROC benutzereinfuegen;PROC benutzerloeschen
+:delete(dnrbenutz);logbucheintrag("Entfernen")END PROC benutzerloeschen;PROC 
+logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Anw. 10.5.1 ";
+eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel;eintragCAT 
+"""";logeintrag(eintrag)END PROC logbucheintrag;TEXT PROC schluessel:
+erfassungswert(fnrschluessel)END PROC schluessel;END PACKET 
+erfbenutzerberechtigungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.meldungen b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen
new file mode 100644
index 0000000..b431202
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen
@@ -0,0 +1,40 @@
+PACKET isperfmeldungenDEFINES erfassungmeldungen:LET maskenname=
+"mu erf abkuerzungen",maxschluessellaenge=4,fnrschluessel=2,fnrletztesfeld=4,
+fnrlangtext=4,trenner=" = ",leer="";INT VAR dateinummer:=0;PROC 
+erfassungmeldungen(INT CONST proznr):systemdbon;SELECT proznrOF CASE 1:
+setzeerfassungsparameterCASE 2:zeigeschluesselzurbearbeitungCASE 3:
+pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5:
+setzeidentiobjektfuerobjektlisteCASE 6:meldunglesenCASE 7:meldungaendernCASE 
+8:meldungeinfuegenCASE 9:meldungloeschenENDSELECT ;END PROC 
+erfassungmeldungen;PROC setzeerfassungsparameter:dateinummer:=dnrmeld;
+setzeerfassungsparameter(dateinummer,maxschluessellaenge,maskenname,
+fnrletztesfeld)END PROC setzeerfassungsparameter;PROC 
+zeigeschluesselzurbearbeitung:setzeerfassungsfeld(wert(fnrmeldungstext),
+fnrlangtext)END PROC zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet:
+INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )
+erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus<>0
+THEN setzefehlerstatus(fehlerstatus);FI END PROC pruefeplausibilitaet;PROC 
+setzewertefuerdbspeicherung:putintwert(fnrmeldungsname,int(erfassungswert(
+fnrschluessel)));search(dnrmeld,TRUE );putwert(fnrmeldungstext,erfassungswert
+(fnrlangtext))END PROC setzewertefuerdbspeicherung;PROC 
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR 
+identizeile;identizeile:=text(intwert(fnrmeldungsname))+trenner+wert(
+fnrmeldungstext);identizeile:=subtext(identizeile,1,maxidentizeilenlaenge);
+setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+text(intwert(
+fnrmeldungsname)).END PROC setzeidentiobjektfuerobjektliste;PROC meldunglesen
+:INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )
+erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus=0THEN 
+inittupel(dnrmeld);putintwert(fnrmeldungsname,int(schluessel));search(dnrmeld
+,TRUE );IF dbstatus=okTHEN saveupdateposition(dnrmeld)FI ELSE dbstatus(
+notfound)FI END PROC meldunglesen;PROC meldungaendern:restoreupdateposition(
+dnrmeld);update(dnrmeld);logbucheintrag("geändert")END PROC meldungaendern;
+PROC meldungeinfuegen:insert(dnrmeld);logbucheintrag("eingefügt")END PROC 
+meldungeinfuegen;PROC meldungloeschen:putintwert(fnrmeldungsname,int(
+schluessel));search(dnrmeld,TRUE );IF dbstatus=okTHEN delete(dnrmeld);
+logbucheintrag("gelöscht")FI END PROC meldungloeschen;PROC logbucheintrag(
+TEXT CONST logergaenzung):TEXT VAR eintrag:="Meldung ";eintragCAT schluessel;
+eintragCAT " ";eintragCAT logergaenzung;logeintrag(eintrag)END PROC 
+logbucheintrag;TEXT PROC schluessel:erfassungswert(fnrschluessel)END PROC 
+schluessel;END PACKET isperfmeldungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen
new file mode 100644
index 0000000..87654f0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen
@@ -0,0 +1,258 @@
+PACKET isperfsteueroperationenDEFINES 
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen,
+vonerfassungsbildschirmeinlesen,maskezeigenundallefeldereinlesen,
+allesvonerfassungsbildschirmeinlesen,schluesselbearbeiten,
+bearbeitetenschluesseleinlesen,angegebenedatenpruefenundevtlspeichern,
+schluesselloeschvorbereitung,schluesselloeschfrage,schluesselloeschen,
+neuenschluesseleinfuegen,schluesselzeigen,datensatzzeigen,
+ausgesuchtezurbearbeitung,ausgesuchtezumloeschen,zurueckzureinzelbearbeitung,
+erfassungswert,setzeerfassungsfeld,erfassungsmaske,setzefehlerstatus,
+setzeerfassungsparameter,erfassungsfelder,datumskonversion,datumrekonversion:
+LET fnrschluessel=2,fnrschluessellaenge=3,fnrerstesfeld=4;LET erfparamsetzen=
+1,erfwertezeigen=2,erfwertepruefen=3,erfwerteindbwerte=4,erfwertelesen=6,
+erfwerteaendern=7,erfwerteeinfuegen=8,erfwerteloeschen=9;LET 
+meldungloeschfrage=65,meldungspeicherung=50,meldungloeschung=61,
+meldungkeineloeschung=62,meldungkeineaenderung=63,meldunggibtsschon=64,
+meldunggibtsnicht=66,meldungletzter=67,meldungkeineliste=68,
+meldunglistenerstellung=7,pruefemeldung=57,meldungschluesselzulang=60,
+meldungnichteingefuegt=70;LET dateiname="Liste zu den allgemeinen Diensten",
+leer="",null=0,oblitrenner="$";LET dateinummerschluessel=137;BOOL VAR 
+neuerschluessel:=FALSE ;LET maxfelderzahl=100;ROW maxfelderzahlTEXT VAR 
+erfassungsfeld;TAG VAR maske;INT VAR startpos;FILE VAR f;TEXT VAR 
+programmname,aktschluessel;TEXT VAR aktmaskenname;INT VAR 
+aktmaxschluessellaenge,aktindex,aktdateinummer;INT VAR anzschlfelder:=1;INT 
+VAR fnraktletztesfeld,fnrakterstesfeld;INT VAR fnrfehlerhaftesfeld;PROC 
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT 
+CONST )erfassungspeziell):erfassungspeziell(erfparamsetzen);startprozedur;
+erfassungsbildschirmaufbauen;startpos:=fnrschluessel;
+vonerfassungsbildschirmeinlesen.END PROC 
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen;PROC 
+maskezeigenundallefeldereinlesen(PROC (INT CONST )erfassungspeziell):
+erfassungspeziell(erfparamsetzen);startprozedur;
+erfassungsbildschirmganzaufbauen;allesvonerfassungsbildschirmeinlesen.END 
+PROC maskezeigenundallefeldereinlesen;PROC startprozedur:
+programminitialisieren;bildschirminitialisieren.END PROC startprozedur;PROC 
+programminitialisieren:page;programmnameholen;standardkopfmaskeausgeben(
+programmname).programmnameholen:programmname:=text(vergleichsknoten).END 
+PROC programminitialisieren;PROC bildschirminitialisieren:initmaske(maske,
+aktmaskenname);erfassungsfelderzumanfanginitialisieren.
+erfassungsfelderzumanfanginitialisieren:INT VAR i;FOR iFROM 1UPTO min(
+maxfelderzahl,(fnraktletztesfeld+5))REP erfassungsfeld(i):=""PER .END PROC 
+bildschirminitialisieren;PROC erfassungsbildschirmaufbauen:
+standardkopfmaskeaktualisieren(programmname);erfassungsmaskeausgeben;
+felderzurausgabevorbereiten;felderausgeben.erfassungsmaskeausgeben:show(maske
+).felderzurausgabevorbereiten:IF schluessellaengenichtzuberuecksichtigenTHEN 
+fnrakterstesfeld:=fnrschluessellaengeELSE fnrakterstesfeld:=fnrerstesfeld;
+erfassungsfeld(fnrschluessellaenge):=text(aktmaxschluessellaenge)FI ;protect(
+maske,fnrakterstesfeld,fnraktletztesfeld+1,TRUE );loeschfeldverdecken.
+schluessellaengenichtzuberuecksichtigen:aktmaxschluessellaenge=0.
+loeschfeldverdecken:LET rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1)
+:=rahmenzeichen.felderausgeben:put(maske,erfassungsfeld,1);startpos:=
+fnrschluessel.END PROC erfassungsbildschirmaufbauen;PROC 
+erfassungsbildschirmganzaufbauen:standardkopfmaskeaktualisieren(programmname)
+;erfassungsmaskeausgeben;felderzurausgabevorbereiten;loeschfeldverdecken.
+erfassungsmaskeausgeben:show(maske).felderzurausgabevorbereiten:
+fnrakterstesfeld:=fnrschluessel+anzschlfelder;.loeschfeldverdecken:LET 
+rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1):=rahmenzeichen;protect(
+maske,fnraktletztesfeld+1,TRUE ).END PROC erfassungsbildschirmganzaufbauen;
+PROC vonerfassungsbildschirmeinlesen:schluesseleinlesen.schluesseleinlesen:
+get(maske,erfassungsfeld,startpos).END PROC vonerfassungsbildschirmeinlesen;
+PROC allesvonerfassungsbildschirmeinlesen:put(maske,erfassungsfeld,1);
+startpos:=fnrschluessel;get(maske,erfassungsfeld,startpos)END PROC 
+allesvonerfassungsbildschirmeinlesen;PROC schluesselbearbeiten(PROC (INT 
+CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;loeschemeldung
+(maske);aktschluessel:=erfassungsfeld(fnrschluessel);datendirektlesen(PROC (
+INT CONST )erfassungspeziell,schluesselexistiert);IF schluesselexistiertTHEN 
+zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell);
+bearbeitetenschluesseleinlesenELSE melde(maske,meldunggibtsnicht);return(1)
+FI .END PROC schluesselbearbeiten;PROC zeigeschluesselzurbearbeitung(PROC (
+INT CONST )erfassungspeziell):neuerschluessel:=FALSE ;protect(maske,
+fnrakterstesfeld,fnraktletztesfeld,FALSE );erfassungspeziell(erfwertezeigen);
+aktschluessel:=erfassungsfeld(fnrschluessel);startpos:=fnrschluessel;put(
+maske,erfassungsfeld,startpos);END PROC zeigeschluesselzurbearbeitung;PROC 
+bearbeitetenschluesseleinlesen:get(maske,erfassungsfeld,startpos);END PROC 
+bearbeitetenschluesseleinlesen;PROC angegebenedatenpruefenundevtlspeichern(
+BOOL CONST zuspeichern,PROC (INT CONST )erfassungspeziell):INT VAR schritte;
+IF zuspeichernTHEN speichernteil;ELSE nichtspeichernteil;FI .
+nichtspeichernteil:meldeauffaellig(maske,meldungkeineaenderung);
+vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell);
+return(schritte).speichernteil:fnrfehlerhaftesfeld:=0;
+pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell);IF 
+datenfehlerfreiTHEN erfassungspeziell(erfwertepruefen)FI ;IF datenfehlerfrei
+THEN BOOL VAR satzgeschrieben;datenwegschreiben;IF NOT satzgeschriebenAND 
+neuerschluesselTHEN melde(maske,meldungnichteingefuegt);return(1)ELSE 
+vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell);
+return(schritte)FI ELSE fehlerbehandeln;return(1)FI .datenwegschreiben:
+meldespeicherung;datenindatenbankspeichern.datenindatenbankspeichern:
+erfassungspeziell(erfwerteindbwerte);IF neuerschluesselTHEN 
+neuenschluesseleinfuegenELSE bearbeitetenschluesselzurueckschreibenFI .
+bearbeitetenschluesselzurueckschreiben:erfassungspeziell(erfwerteaendern);.
+neuenschluesseleinfuegen:erfassungspeziell(erfwerteeinfuegen);satzgeschrieben
+:=dbstatus=0.meldespeicherung:melde(maske,meldungspeicherung).datenfehlerfrei
+:fnrfehlerhaftesfeld=0.fehlerbehandeln:startpos:=fnrfehlerhaftesfeld.END 
+PROC angegebenedatenpruefenundevtlspeichern;PROC schluesselloeschvorbereitung
+(PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;
+loeschemeldung(maske);aktschluessel:=erfassungsfeld(fnrschluessel);
+datendirektlesen(PROC (INT CONST )erfassungspeziell,schluesselexistiert);IF 
+schluesselexistiertTHEN loeschennachfrage(PROC (INT CONST )erfassungspeziell)
+;schluesselloeschfrageELSE melde(maske,meldunggibtsnicht);return(1)FI .END 
+PROC schluesselloeschvorbereitung;PROC loeschennachfrage(PROC (INT CONST )
+erfassungspeziell):zeigeschluesselzurbearbeitung(PROC (INT CONST )
+erfassungspeziell);melde(maske,meldungloeschfrage);protect(maske,
+fnrschluessel,TRUE );END PROC loeschennachfrage;PROC schluesselloeschfrage:
+TEXT VAR xy;startpos:=fnraktletztesfeld+1;get(maske,xy,startpos).END PROC 
+schluesselloeschfrage;PROC schluesselloeschen(BOOL CONST zuloeschen,PROC (
+INT CONST )erfassungspeziell):INT VAR schritte;IF zuloeschenTHEN melde(maske,
+meldungloeschung);erfassungspeziell(erfwerteloeschen);IF dbstatus<>0THEN put(
+maske,("Löschen - Fehlerstatus: "+text(dbstatus)),1);pauseFI ELSE melde(maske
+,meldungkeineloeschung)FI ;vorbereitendernaechstenschluesselbehandlung(
+schritte,PROC erfassungspeziell);return(schritte).END PROC schluesselloeschen
+;PROC neuenschluesseleinfuegen(PROC (INT CONST )erfassungspeziell):BOOL VAR 
+schluesselexistiert;loeschemeldung(maske);aktschluessel:=erfassungsfeld(
+fnrschluessel);pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon
+);return(1)ELSE neuerschluesselvorbereitung;bearbeitetenschluesseleinlesenFI 
+.neuerschluesselvorbereitung:neuerschluessel:=TRUE ;protect(maske,
+fnrakterstesfeld,fnraktletztesfeld,FALSE );startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos).END PROC neuenschluesseleinfuegen;PROC 
+pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,BOOL VAR existiert):
+TEXT VAR schluessel:=compress(erfassungsfeld(fnrschluessel));existiert:=
+FALSE ;IF schluessel<>leerTHEN datendirektlesen(PROC (INT CONST )
+erfassungspeziell,existiert);existiert:=dbstatus=0;FI .END PROC 
+pruefeneuenschluessel;PROC vorbereitendernaechstenschluesselbehandlung(INT 
+VAR schritte,PROC (INT CONST )erfassungspeziell):IF exists(dateiname)THEN 
+holenaechstenschluesselauslisteELSE bereitenaechstebenutzereingabevor;
+schritte:=2FI .holenaechstenschluesselausliste:BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;TEXT VAR oblischl2:="";
+holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP 
+erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT 
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE 
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF 
+kannbearbeitetwerdenTHEN zeigeschluesselzurbearbeitung(PROC (INT CONST )
+erfassungspeziell);startpos:=fnrschluessel;put(maske,erfassungsfeld,startpos)
+;schritte:=1ELSE behandleendederlistenabarbeitung;schritte:=3FI .
+behandleendederlistenabarbeitung:melde(maske,meldungletzter);pause(20);
+bereitenaechstebenutzereingabevor.bereitenaechstebenutzereingabevor:protect(
+maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,fnraktletztesfeld,
+TRUE );erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos).END PROC vorbereitendernaechstenschluesselbehandlung
+;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell):schluesselzeigen(
+PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC pruefungdummy)END PROC 
+schluesselzeigen;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell,
+BOOL CONST scanja,BOOL PROC pruefungspeziell):IF aktindex=
+dateinummerschluesselTHEN systemdboff;datensatzzeigen(PROC (INT CONST )
+erfassungspeziell,scanja,BOOL PROC pruefungspeziell);LEAVE schluesselzeigen
+FI ;BOOL VAR listeexistiertnicht:=FALSE ;TEXT VAR sicherungstupel;systemdbon;
+savetupel(aktdateinummer,sicherungstupel);melde(maske,meldunglistenerstellung
+);systemdbon;restoretupel(aktdateinummer,sicherungstupel);systemdboff;
+aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex,
+aktschluessel,FALSE ,listeexistiertnicht);IF listeexistiertnichtTHEN melde(
+maske,meldungkeineliste);return(1)ELSE objektlistenausgabe(PROC (INT CONST )
+erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI END PROC 
+schluesselzeigen;PROC datensatzzeigen(PROC (INT CONST )erfassungspeziell):
+datensatzzeigen(PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC 
+pruefungdummy)END PROC datensatzzeigen;PROC datensatzzeigen(PROC (INT CONST )
+erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):BOOL VAR 
+listeexistiertnicht:=FALSE ;melde(maske,meldunglistenerstellung);
+aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex,
+aktschluessel,TRUE ,#26.03.87#listeexistiertnicht);IF listeexistiertnicht
+THEN melde(maske,meldungkeineliste);return(1)ELSE datensatzlistenausgabe(
+PROC (INT CONST )erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI .END 
+PROC datensatzzeigen;PROC ausgesuchtezurbearbeitung(PROC (INT CONST )
+erfassungspeziell):BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+objektlistebeenden(dateiname,TRUE );TEXT VAR oblischl2;
+holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP 
+erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT 
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE 
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF 
+kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;
+zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell);
+bearbeitetenschluesseleinlesenELSE erfassungsfelderinitialisieren;
+erfassungsbildschirmaufbauen;return(2)FI .END PROC ausgesuchtezurbearbeitung;
+PROC ausgesuchtezumloeschen(PROC (INT CONST )erfassungspeziell):BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;objektlistebeenden(dateiname,TRUE );TEXT VAR 
+oblischl2;holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE ok
+REP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT 
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE 
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF 
+kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;loeschennachfrage(PROC 
+(INT CONST )erfassungspeziell);schluesselloeschfrageELSE 
+erfassungsfelderinitialisieren;erfassungsbildschirmaufbauen;return(2)FI .END 
+PROC ausgesuchtezumloeschen;PROC datendirektlesen(PROC (INT CONST )
+erfassungspeziell,BOOL VAR dirok):erfassungspeziell(erfwertelesen);dirok:=
+dbstatus=0;END PROC datendirektlesen;PROC erfassungsfelderinitialisieren:
+erfassungsfeld(fnrschluessel):="";INT VAR feldnr;FOR feldnrFROM 
+fnrakterstesfeldUPTO fnraktletztesfeldREP erfassungsfeld(feldnr):="";PER .
+END PROC erfassungsfelderinitialisieren;PROC holeerstenschluesselausdatei(
+TEXT VAR feld1,feld2,BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;
+LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input,dateiname);
+holenaechstenschluesselausdatei(feld1,feld2,ok);END PROC 
+holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(TEXT VAR 
+feld1,feld2,BOOL VAR ok):TEXT VAR thesaurustext:="";IF eof(f)THEN ok:=FALSE ;
+loeschedieerstellteobjektlisteELSE getline(f,thesaurustext);
+bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:INT VAR schluesselbeginn:=pos(
+thesaurustext,oblitrenner);INT VAR schluesseltrennung:=pos(thesaurustext,
+oblitrenner,schluesselbeginn+1);IF schluesseltrennung>0THEN feld1:=subtext(
+thesaurustext,schluesselbeginn+1,schluesseltrennung-1);feld2:=subtext(
+thesaurustext,schluesseltrennung+1)ELSE feld1:=subtext(thesaurustext,
+schluesselbeginn+1);feld2:=leerFI .END PROC holenaechstenschluesselausdatei;
+PROC loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC 
+loeschedieerstellteobjektliste;PROC put(TAG CONST t,ROW maxfelderzahlTEXT 
+VAR pfeld,INT CONST pos):INT VAR i;FOR iFROM posUPTO maxfelderzahlREP IF 
+fieldexists(t,i)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC protect(TAG 
+VAR maske,INT CONST anfangfeld,endefeld,BOOL CONST schreibschutz):IF endefeld
+>=anfangfeldTHEN setzefeldschutzfuerdiebenanntenfelderFI .
+setzefeldschutzfuerdiebenanntenfelder:INT VAR feldnr;FOR feldnrFROM 
+anfangfeldUPTO endefeldREP protect(maske,feldnr,schreibschutz)PER .END PROC 
+protect;PROC pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell
+):melde(maske,pruefemeldung);INT VAR fehlstatus;pruefe(1,maske,TEXT PROC (
+INT CONST )erfassungswert,fnrschluessel,null,null,leer,fehlstatus);IF 
+fehlstatus<>0THEN setzefehlerstatus(fehlstatus);LEAVE 
+pruefeplausibilitaetallgemeinFI ;IF schluessellaengemussueberprueftwerden
+THEN IF eingabelaenge>aktmaxschluessellaengeTHEN melde(maske,
+meldungschluesselzulang);setzefehlerstatus(fnrschluessel);LEAVE 
+pruefeplausibilitaetallgemeinFI FI ;BOOL VAR schluesselexistiert;IF 
+neuerschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon
+);setzefehlerstatus(fnrschluessel)FI ELSE IF erfassungsfeld(fnrschluessel)<>
+aktschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN setzeaufaltensatzzurueck;
+melde(maske,meldunggibtsschon);setzefehlerstatus(fnrschluessel);ELSE 
+setzefehlerstatus(0);FI ELSE setzefehlerstatus(0);FI FI .
+setzeaufaltensatzzurueck:TEXT VAR falscherschluessel:=erfassungsfeld(
+fnrschluessel);erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(
+PROC (INT CONST )erfassungspeziell,schluesselexistiert);erfassungsfeld(
+fnrschluessel):=falscherschluessel.eingabelaenge:length(erfassungsfeld(
+fnrschluessel)).schluessellaengemussueberprueftwerden:aktmaxschluessellaenge>
+0.END PROC pruefeplausibilitaetallgemein;PROC zurueckzureinzelbearbeitung:
+loeschedieerstellteobjektliste;standardkopfmaskeaktualisieren(programmname);
+protect(maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,TRUE );
+erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos);return(3);END PROC zurueckzureinzelbearbeitung;PROC 
+setzeerfassungsfeld(TEXT CONST feldinhalt,INT CONST feldnr):erfassungsfeld(
+feldnr):=feldinhaltEND PROC setzeerfassungsfeld;TEXT PROC erfassungswert(INT 
+CONST feldnr):IF (feldnr>maxfelderzahl)OR (feldnr<1)THEN ""ELSE 
+erfassungsfeld(feldnr)FI .END PROC erfassungswert;ROW 100TEXT PROC 
+erfassungsfelder:erfassungsfeldEND PROC erfassungsfelder;TAG PROC 
+erfassungsmaske:maskeEND PROC erfassungsmaske;PROC setzefehlerstatus(INT 
+CONST feldnr):fnrfehlerhaftesfeld:=feldnr.END PROC setzefehlerstatus;PROC 
+setzeerfassungsparameter(INT CONST dateinummer,INT CONST schluessellaenge,
+TEXT CONST maskenname,INT CONST letzteserfassungsfeld):aktindex:=dateinummer;
+aktdateinummer:=dateinr(primdatid(dateinummer));aktmaxschluessellaenge:=
+schluessellaenge;aktmaskenname:=maskenname;fnraktletztesfeld:=
+letzteserfassungsfeld;anzschlfelder:=anzkey(dateinr(primdatid(aktdateinummer)
+));END PROC setzeerfassungsparameter;PROC setzeerfassungsparameter(INT CONST 
+dateinummer,TEXT CONST maskenname,INT CONST letzteserfassungsfeld):LET 
+keineschluessellaenge=0;setzeerfassungsparameter(dateinummer,
+keineschluessellaenge,maskenname,letzteserfassungsfeld).END PROC 
+setzeerfassungsparameter;TEXT PROC datumskonversion(TEXT CONST datum):TEXT 
+VAR d:=datum;IF nurblanksoderleer(datum)OR d="  .  .  "THEN "01.01.00"ELSE 
+changeall(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3);
+insertchar(d,".",6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC 
+datumskonversion;BOOL PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR i
+FROM 1UPTO length(t)REP IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH 
+FALSE FI PER ;TRUE ENDPROC nurblanksoderleer;TEXT PROC datumrekonversion(
+TEXT CONST datum):TEXT VAR d:=datum;changeall(d,".","");IF d="010100"THEN d:=
+""FI ;dENDPROC datumrekonversion;END PACKET isperfsteueroperationen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.init baisy server b/app/baisy/2.2.1-schulis/src/isp.init baisy server
new file mode 100644
index 0000000..98044ba
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.init baisy server
@@ -0,0 +1,4 @@
+PACKET ispinitbaisyserverDEFINES initbs,baisyserver:TASK VAR bs;PROC initbs:
+bs:=/"baisy server"END PROC initbs;TASK PROC baisyserver:bsEND PROC 
+baisyserver;initbsEND PACKET ispinitbaisyserver;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.knoten b/app/baisy/2.2.1-schulis/src/isp.knoten
new file mode 100644
index 0000000..6af3e22
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.knoten
@@ -0,0 +1,137 @@
+PACKET knotenDEFINES systembaum,setzesystembaumundaktuellenknoten,
+generierebaisymonitor,KNOTEN ,STACK ,KNOTENMENGE ,leeremenge,nilknoten,
+leererstack,anfangsknotenholen,einzelknotenholen,erster,weitere,naechster,
+attribute,maske,task,text,nummer,vorprozedur,nachprozedur,taste,isrefinement,
+isopen,knotenaufrufindex,HAT ,zahlderelemente,mengedernachfolger,:=,=,push,
+pop,hoehe,voll,leer:LET maxhoehe=20,bottom=1;LET maxkn=2190;TYPE LONGROW =
+TEXT ;TYPE KNOTENMENGE =INT ;TYPE KNOTEN =STRUCT (INT zeile,index);TYPE 
+INTKNOTEN =INT ;TYPE EINTRAG =STRUCT (TEXT attribute,INTKNOTEN vater,LONGROW 
+knotenmengenLONGROW knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,
+ROW maxknEINTRAG zeile);KNOTEN CONST nilknoten:=KNOTEN :(0,0);BOUND SYSTAB 
+VAR sysbaum;TYPE STACK =STRUCT (ROW maxhoeheKNOTEN st,INT top);LET maxat=6,
+tepos=1,mpos=2,vpos=3,npos=4,tpos=5,ppos=6;LET scanid=1;DATASPACE VAR ds;
+BOOL VAR verteilteraufruf;INT VAR newkind;TEXT VAR newsymbol;TEXT VAR 
+pruefstack;BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(
+newsymbol,newkind);END PROC next;PROC next(TEXT CONST proz):scan(proz);next
+END PROC next;BOOL PROC prozedurexistiert(TEXT CONST prozname):BOOL VAR da:=
+false;scanstring(da,prozname);da.END PROC prozedurexistiert;PROC scanstring(
+BOOL VAR da,TEXT CONST str):procpos:=1;next(str);analyse(da);WHILE NOT 
+schlussREP next(subtext(str,procpos+4));IF isidTHEN analyse(da)ELSE da:=false
+FI ;procposINCR 1PER .schluss:INT VAR procpos:=pos(str,"PROC",procpos);
+procpos=0.END PROC scanstring;PROC analyse(BOOL VAR da):IF schongeprueftTHEN 
+da:=trueELSE da:=analyseergebnis(newsymbol);IF daTHEN alsgeprueftvermerkenFI 
+FI .schongeprueft:pos(pruefstack,pruefname(newsymbol))>0.alsgeprueftvermerken
+:pruefstackCAT pruefname(newsymbol).END PROC analyse;BOOL PROC 
+analyseergebnis(TEXT CONST prozname):pruefungvorbereiten;IF iserrorTHEN 
+breakabfangen;falseELSE trueFI .pruefungvorbereiten:disablestop;type("�q");
+help(prozname).breakabfangen:TEXT VAR br:="";editget(br);clearerror.END PROC 
+analyseergebnis;TEXT PROC pruefname(TEXT CONST name):"/"+name+"/"END PROC 
+pruefname;TEXT PROC prozedur(TEXT CONST pname):IF pname<>""THEN IF 
+prozedurexistiert(pname)THEN pnameELSE "return(1)"FI ELSE pnameFI END PROC 
+prozedur;PROC generierebaisymonitor(TEXT CONST teilbaumname):LET maxcase=510;
+startemonitordatei;naechstezeile;WHILE NOT tabellenendeREP neuescase;
+naechstezeilePER ;schlusszeilen.startemonitordatei:richtedateiein;
+anfangszeile.richtedateiein:TEXT CONST monitorname:=teilbaumname+" monitor";
+forget(monitorname,quiet);FILE VAR f:=sequentialfile(output,monitorname).
+anfangszeile:putline(f,
+"PACKET baisymonitor DEFINES call,starten ueber monitor:");TEXT VAR anfaenge
+:="";INT VAR tabind:=0;INT VAR caseproczahl:=0;INT VAR aktcasezahl:=0;INT 
+VAR maxtabeintrag:=sysbaum.ersterfreier-1;pruefstack:="".naechstezeile:
+aktcasezahlINCR 1;tabindINCR 1;cout(tabind).tabellenende:tabind>maxtabeintrag
+.neuescase:IF aktcasezahl=1THEN neuecaseprocFI ;casewennnoetig;IF aktcasezahl
+=maxcaseTHEN schlusscaseprocFI .neuecaseproc:caseproczahlINCR 1;putline(f,
+"PROC case"+text(caseproczahl)+"(INT CONST i,BOOL CONST vor):");putline(f,
+"SELECT i OF").casewennnoetig:IF gueltigezeileTHEN KNOTEN VAR k;k.zeile:=
+tabind;TEXT VAR vproc:=prozedur(vorprozedur(k));IF vproc<>""THEN vprocteil;
+TEXT VAR nproc:=prozedur(nachprozedur(k));IF nproc<>""THEN nprocteilELSE put(
+f,"FI");line(f)FI FI FI .gueltigezeile:CONCR (sysbaum.zeile(tabind).vater)>=0
+.vprocteil:put(f,"CASE "+text(aktcasezahl)+": ");put(f,"IF vor THEN "+vproc).
+nprocteil:put(f," ELSE "+nproc+" FI");line(f).schlusszeilen:schlusscaseproc;
+procanfang;ifabfragen;procundpacketende.schlusscaseproc:putline(f,
+"END SELECT");putline(f,"END PROC case"+text(caseproczahl)+";");aktcasezahl:=
+0;anfaengeCAT text(tabind,4).procanfang:putline(f,"PROC call"+
+"(INT CONST i,BOOL CONST vor,TEXT CONST t):").ifabfragen:INT VAR ifzahl:=
+caseproczahl-1;IF ifzahl=0THEN einfacherfallELIF ifzahl=1THEN erstesif;
+elseteilELSE erstesif;alleelifs;elseteilFI .caseaufruf:TEXT VAR zusatz:="";
+TEXT VAR decr:=subtext(anfaenge,basis-3,basis);IF decr<>""THEN zusatz:=" - "+
+decrFI ;put(f,"case"+text(aktcaseindex)+"(i"+zusatz+",vor)");.einfacherfall:
+put(f,"case1(i,vor)");line(f).erstesif:INT VAR aktcaseindex;basis:=0;put(f,
+"IF i<="+subtext(anfaenge,1,4)+" THEN");einfacherfall.alleelifs:INT VAR elif;
+FOR elifFROM 1UPTO ifzahl-1REP neueselifPER .neueselif:put(f,"ELIF ");
+aktcaseindex:=elif+1;INT VAR basis:=elif*4;put(f,"i <="+subtext(anfaenge,
+basis+1,basis+4)+" THEN");caseaufruf;line(f).elseteil:put(f,"ELSE ");basis
+INCR 4;aktcaseindex:=ifzahl+1;caseaufruf;putline(f," FI").procundpacketende:
+putline(f,"END PROC call;");putline(f,"PROC starten ueber monitor:");putline(
+f,"start baisy("""+teilbaumname+
+""",PROC (INT CONST,BOOL CONST,TEXT CONST) call)");putline(f,
+"END PROC starten ueber monitor");putline(f,"END PACKET baisymonitor");
+pruefstack:="".END PROC generierebaisymonitor;DATASPACE PROC systembaum:ds
+END PROC systembaum;KNOTEN VAR aktuellerknoten;PROC 
+setzesystembaumundaktuellenknoten(DATASPACE CONST d,INT CONST s):ds:=d;
+aktuellerknoten.zeile:=sEND PROC setzesystembaumundaktuellenknoten;PROC 
+kopplesystembauman(TEXT CONST name):forget(ds);ladesystembaum(ds,name);
+sysbaum:=dsEND PROC kopplesystembauman;PROC anfangsknotenholen(TEXT CONST 
+name,KNOTEN VAR k,BOOL VAR ok):schaltersetzen;vglkn:=nilknoten;IF NOT 
+verteilteraufrufTHEN kopplesystembauman(name);suche(k,ok)ELSE ok:=TRUE ;
+sysbaum:=ds;k:=aktuellerknotenFI .schaltersetzen:verteilteraufruf:=name="".
+END PROC anfangsknotenholen;PROC einzelknotenholen(TEXT CONST name,KNOTEN 
+VAR einzelknoten,BOOL VAR ok):IF NOT verteilteraufrufTHEN 
+holeindexvoneinzelknoten;IF okTHEN vermerkeihnanletzterstelleFI ELSE 
+sucheunterdenangehaengtenindizesFI .holeindexvoneinzelknoten:DATASPACE VAR 
+savespace:=ds;kopplesystembauman(name);INT VAR index;suche(index,ok);forget(
+ds);ds:=savespace;forget(savespace);sysbaum:=ds.vermerkeihnanletzterstelle:
+einzelknoten.zeile:=index;sysbaum.maxeintragINCR 1;CONCR (sysbaum.zeile(
+sysbaum.maxeintrag).vater):=einzelknoten.zeile;sysbaum.zeile(sysbaum.
+maxeintrag).attribute:=taste(einzelknoten).sucheunterdenangehaengtenindizes:
+INT VAR i;FOR iFROM sysbaum.ersterfreierUPTO sysbaum.maxeintragREP IF sysbaum
+.zeile(i).attribute=nameTHEN einzelknoten.zeile:=CONCR (sysbaum.zeile(i).
+vater)FI PER .END PROC einzelknotenholen;PROC suche(KNOTEN VAR k,BOOL VAR ok)
+:suche(k.zeile,ok);sysbaum.maxeintragINCR 1;sysbaum.ersterfreier:=sysbaum.
+maxeintrag;CONCR (sysbaum.zeile(sysbaum.maxeintrag).vater):=k.zeileEND PROC 
+suche;PROC suche(INT VAR k,BOOL VAR ok):k:=CONCR (sysbaum.zeile(sysbaum.
+ersterfreier).vater);ok:=(k>0)END PROC suche;KNOTENMENGE PROC leeremenge:
+KNOTENMENGE :(0)END PROC leeremenge;STACK PROC leererstack:STACK VAR s;s.top
+:=bottom;sEND PROC leererstack;TEXT PROC knotentexte(KNOTEN CONST k):sysbaum.
+zeile(k.zeile).attributeEND PROC knotentexte;PROC knotentexte(KNOTEN VAR k,
+TEXT CONST t):sysbaum.zeile(k.zeile).attribute:=tEND PROC knotentexte;TEXT 
+PROC maske(KNOTEN CONST k):attribut(k,mpos)END PROC maske;TEXT PROC task(
+KNOTEN CONST k):attribut(k,ppos)END PROC task;INT PROC nummer(KNOTEN CONST k)
+:knotenaufrufindex(k)END PROC nummer;TEXT PROC text(KNOTEN CONST k):attribut(
+k,tepos)END PROC text;TEXT PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)
+END PROC vorprozedur;TEXT PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)
+END PROC nachprozedur;TEXT PROC taste(KNOTEN CONST k):attribut(k,tpos)END 
+PROC taste;TEXT VAR attext;TEXT PROC attribut(KNOTEN CONST k,INT CONST i):
+attribute(k);TEXT VAR amuster:="��",emuster:="��";replace(amuster,1,i);
+replace(emuster,1,i+1);INT VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i
+<maxatTHEN ende:=pos(attext,emuster,anfang)-1;subtext(attext,anfang,ende)
+ELSE subtext(attext,anfang)FI END PROC attribut;KNOTEN VAR vglkn;PROC 
+attribute(KNOTEN CONST k):IF NOT (k=vglkn)THEN attext:=knotentexte(k);vglkn:=
+kFI END PROC attribute;BOOL PROC isrefinement(KNOTEN CONST k):attribute(k);(
+attextSUB 1)="1"END PROC isrefinement;BOOL PROC isnormal(KNOTEN CONST k):
+attribute(k);(attextSUB 1)="0"END PROC isnormal;BOOL PROC isopen(KNOTEN 
+CONST k):NOT (isrefinement(k)COR isnormal(k))END PROC isopen;OP HAT (KNOTEN 
+VAR k,TEXT CONST t):knotentexte(k,t)END OP HAT ;INT PROC zahlderelemente(
+KNOTENMENGE CONST m):length(sysbaum.zeile(CONCR (m)).knoten)END PROC 
+zahlderelemente;INT PROC length(LONGROW CONST l):length(CONCR (l))DIV 2END 
+PROC length;PROC mengedernachfolger(KNOTEN CONST k,KNOTENMENGE VAR m):CONCR (
+m):=k.zeileEND PROC mengedernachfolger;KNOTEN PROC erster(KNOTENMENGE CONST m
+):KNOTEN VAR k;aktuellemenge:=sysbaum.zeile(CONCR (m)).knoten;aktuellelaenge
+:=length(aktuellemenge);mengenindex:=CONCR (m);k.zeile:=0;k.index:=0;
+naechster(k);kEND PROC erster;LONGROW VAR aktuellemenge;INT VAR 
+aktuellelaenge;INT VAR mengenindex;PROC naechster(KNOTEN VAR k):IF (
+aktuellelaenge>0)CAND (k.index<aktuellelaenge)THEN k.indexINCR 1;k.zeile:=
+CONCR (aktuellemenge)ISUB k.indexELSE k:=nilknotenFI END PROC naechster;INT 
+PROC knotenaufrufindex(KNOTEN CONST k):k.zeileEND PROC knotenaufrufindex;
+BOOL PROC weitere(KNOTEN CONST k,KNOTENMENGE CONST m):(CONCR (m)=mengenindex)
+CAND (k.index<>0)END PROC weitere;BOOL OP =(KNOTEN CONST k,l):k.zeile=l.zeile
+END OP =;OP :=(KNOTEN VAR ziel,KNOTEN CONST quelle):CONCR (ziel):=CONCR (
+quelle)END OP :=;OP :=(KNOTENMENGE VAR ziel,KNOTENMENGE CONST quelle):CONCR (
+ziel):=CONCR (quelle)END OP :=;OP :=(LONGROW VAR ziel,LONGROW CONST quelle):
+CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle
+):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,KNOTEN CONST k)
+:IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1FI END PROC push;PROC 
+pop(STACK VAR s,KNOTEN VAR k):IF NOT (s.top=bottom)THEN s.topDECR 1;k:=s.st(s
+.top);FI END PROC pop;INT PROC hoehe(STACK CONST s):s.top-1END PROC hoehe;
+BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll;BOOL PROC leer(
+STACK CONST s):s.top=bottomEND PROC leer;END PACKET knoten;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle
new file mode 100644
index 0000000..12ba492
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle
@@ -0,0 +1,82 @@
+PACKET ispmanagerschnittstelleDEFINES gibdatenbankkennung,oeffnedatenbank,
+initmaske,maskegibtes,maskeloeschen,maskespeichern,maskeumbenennen,
+maskekopieren,maskenliste,setzemaske,baumverarbeitung,ladesystembaum,
+schulisdbname,#08.02.88dr#baisydbname,#08.02.88dr#setzeschulisdbname,#08.02.
+88dr#setzebaisydbname,#08.02.88dr##dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname
+,fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname,
+fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext#:LET 
+PARAM =STRUCT (TEXT textkey1,textkey2,TAG maske);LET pruefen=40,init=41,
+loeschen=42,speichern=43,umbenennen=44,kopieren=45,liste=46,newtree=52;#dr06.
+07.88indasPACKET "isp schulis db nummern"übernommenLET dnrauskuenfte=2,
+fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7,fnrbenbestand=8,
+fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12,fnrmeldname=13,
+fnrmeldtext=14;#LET ack=0,error=2,ende=3,baumverarbeitungbasis=53;DATASPACE 
+VAR ds;BOUND PARAM VAR p;LET manager="baisy server";TASK VAR newmanager;INT 
+VAR replycode;TEXT VAR schulisdatenbank:="EUMELbase.schulis",baisydatenbank:=
+"EUMELbase.baisy";PROC initdbsneu:neuanmelden;neuinitialisieren.neuanmelden:
+newmanager:=baisyserver;.END PROC initdbsneu;PROC neuinitialisieren:forget(ds
+);ds:=nilspace;p:=dsEND PROC neuinitialisieren;LET KENNUNGALT =STRUCT (TASK 
+managerbaisy,managerschulis,INT baisy,schulis);LET DATENBANKKENNUNG =STRUCT (
+TASK newmanager,KENNUNGALT oldmanager);PROC gibdatenbankkennung(DATASPACE 
+VAR ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds;dbkennung.newmanager:=
+newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT VAR kennung:=d;
+dbkennung.oldmanager:=kennung;forget(d)END PROC gibdatenbankkennung;PROC 
+oeffnedatenbank(DATASPACE CONST ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds;
+newmanager:=dbkennung.newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT 
+VAR kennung:=d;kennung:=dbkennung.oldmanager;oeffneeumelbasebaisydatenbank;#
+oeffnedatenbankalt(d);ersetztdurch#kennung.managerbaisy:=/"ei";kennung.
+managerschulis:=/"ei";kennung.baisy:=999;kennung.schulis:=999;
+neuinitialisierenEND PROC oeffnedatenbank;PROC oeffnedatenbank:
+oeffneeumelbasebaisydatenbank;#oeffnedatenbankalt;#initdbsneuEND PROC 
+oeffnedatenbank;PROC oeffnedatenbank(TEXT CONST db):fetchdd(db);IF dbopen(db)
+THEN setzeschulisdbname(db);oeffnedatenbank;systemdboffELSE errorstop(
+"Datenbank der Anwendung konnte nicht geöffnet werden")FI ENDPROC 
+oeffnedatenbank;PROC setzebaisydbname(TEXT CONST bdbname):baisydatenbank:=
+bdbnameEND PROC setzebaisydbname;PROC setzeschulisdbname(TEXT CONST sdbname):
+schulisdatenbank:=sdbnameEND PROC setzeschulisdbname;TEXT PROC baisydbname:
+baisydatenbankEND PROC baisydbname;TEXT PROC schulisdbname:schulisdatenbank
+END PROC schulisdbname;PROC oeffneeumelbasebaisydatenbank:fetchdd(baisydbname
+);IF NOT systemdbopen(baisydbname)THEN errorstop("Datenbank "+baisydbname+
+" konnte nicht geöffnet werden")FI ;ENDPROC oeffneeumelbasebaisydatenbank;#
+dr06.07.88indasPACKET "isp.schulis db nummern"übernommenINT PROC dnrausk:
+dnrauskuenfteENDPROC dnrausk;INT PROC fnrauskunftsname:fnrausknameENDPROC 
+fnrauskunftsname;INT PROC fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT 
+PROC fnrauskunftstext:fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz:
+dnrbenutzerENDPROC dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC 
+fnrbenutzbestand;INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT 
+PROC fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC 
+fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld:
+dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC 
+fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;#
+PROC initmaske(TAG VAR t,TEXT CONST name):p.textkey1:=name;sendeauftrag(init)
+;t:=p.maskeEND PROC initmaske;BOOL PROC maskegibtes(TEXT CONST name):p.
+textkey1:=name;sendeauftrag(pruefen);replycode=ackEND PROC maskegibtes;PROC 
+maskeloeschen(TEXT CONST name):p.textkey1:=name;sendeauftrag(loeschen)END 
+PROC maskeloeschen;PROC maskespeichern(TEXT CONST name):p.textkey1:=name;
+sendeauftrag(speichern)END PROC maskespeichern;PROC maskeumbenennen(TEXT 
+CONST alt,neu):p.textkey1:=alt;p.textkey2:=neu;sendeauftrag(umbenennen)END 
+PROC maskeumbenennen;PROC maskekopieren(TEXT CONST alt,neu):p.textkey1:=alt;p
+.textkey2:=neu;sendeauftrag(kopieren)END PROC maskekopieren;PROC maskenliste(
+TEXT CONST dateiname):p.textkey1:=dateiname;sendeauftrag(liste);copy(ds,
+dateiname);neuinitialisierenEND PROC maskenliste;PROC setzemaske(TAG CONST t)
+:p.maske:=tEND PROC setzemaske;PROC ladesystembaum(DATASPACE VAR d,TEXT 
+CONST name):p.textkey1:=name;sendeauftrag(newtree);d:=ds;neuinitialisieren
+END PROC ladesystembaum;PROC baumverarbeitung(TEXT VAR dateiname,INT CONST 
+aktion):INT VAR wastun:=baumverarbeitungbasis+aktion;IF aktion>4THEN wastun
+DECR 2ELIF (aktion=2)COR (aktion=0)THEN FILE VAR f:=sequentialfile(input,
+dateiname);INT CONST ch:=channel(myself);TEXT CONST cht:=dateiname+text(ch,2)
+;headline(f,cht);break(quiet)FI ;DATASPACE VAR datei:=old(dateiname);INT VAR 
+re:=0;call(newmanager,wastun,datei,re);IF (aktion=2)COR (aktion=0)THEN 
+continue(ch)FI ;IF re<>ackTHEN IF re<0THEN errorstop("Keine Managertask")
+ELSE IF re=errorTHEN BOUND TEXT VAR t:=datei;errorstop(t)ELSE SELECT aktion
+OF CASE 2:dateiname:=headline(sequentialfile(input,datei));copy(datei,
+dateiname);forget(datei)CASE 3,4:forget(dateiname,quiet);forget(datei);
+dateiname:=""OTHERWISE standard;dateiname:=""END SELECT FI FI ELSE standard
+FI .standard:forget(dateiname,quiet);copy(datei,dateiname);forget(datei).END 
+PROC baumverarbeitung;PROC sendeauftrag(INT CONST auftragsnr):call(newmanager
+,auftragsnr,ds,replycode);IF (replycode<>ack)CAND (replycode<>ende)THEN IF 
+nomanagerTHEN errorstop(no)ELSE BOUND TEXT VAR t:=ds;TEXT VAR fehlermeldung:=
+t;neuinitialisieren;errorstop(fehlermeldung)FI ELSE p:=dsFI .nomanager:
+replycode<0.no:"Keine Managertask".END PROC sendeauftrag;END PACKET 
+ispmanagerschnittstelle;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.masken b/app/baisy/2.2.1-schulis/src/isp.masken
new file mode 100644
index 0000000..12d5ef2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.masken
@@ -0,0 +1,495 @@
+PACKET textalsrowDEFINES ins,del,CAT ,ipos,dump,replaceiac,VSUB ,VISUB :LET 
+nil13byte="�������������",nil4byte="����",nilbyte="�";TEXT VAR g1,code2:="��"
+;PROC ins(TEXT VAR row,INT CONST wo,was):replace(code2,1,was);g1:=subtext(row
+,2*wo-1);row:=subtext(row,1,2*wo-2);rowCAT code2;rowCAT g1END PROC ins;PROC 
+del(TEXT VAR row,INT CONST wo):g1:=subtext(row,2*wo+1);row:=subtext(row,1,2*
+wo-2);rowCAT g1END PROC del;OP CAT (TEXT VAR row,INT CONST was):replace(code2
+,1,was);rowCAT code2END OP CAT ;INT PROC ipos(TEXT CONST row,INT CONST was):
+INT VAR start:=0;replace(code2,1,was);REP start:=pos(row,code2,start+1)UNTIL 
+startMOD 2=1OR start=0PER ;(start+1)DIV 2END PROC ipos;PROC dump(TEXT VAR row
+):INT VAR i;FOR iFROM 1UPTO length(row)DIV 2REP put(rowISUB i)PER END PROC 
+dump;PROC replaceiac(TEXT VAR string,INT CONST wo,TEXT CONST was):IF LENGTH 
+string<=LENGTH was+wo-1THEN stretch(string,LENGTH was+wo-1)FI ;replace(string
+,wo,was)END PROC replaceiac;PROC stretch(TEXT VAR t,INT CONST wo):WHILE 
+LENGTH t<=wo-13REP tCAT nil13bytePER ;WHILE LENGTH t<=wo-4REP tCAT nil4byte
+PER ;WHILE LENGTH t<woREP tCAT nilbytePER END PROC stretch;PROC replaceiac(
+TEXT VAR string,INT CONST wo,INT CONST was):IF LENGTH string<=2*(wo+1)THEN 
+stretch(string,2*(wo+1))FI ;replace(string,wo,was)END PROC replaceiac;INT OP 
+VSUB (TEXT CONST string,INT CONST pos):code(stringSUB pos)END OP VSUB ;INT 
+OP VISUB (TEXT CONST string,INT CONST pos):IF pos*2<=LENGTH stringTHEN string
+ISUB posELSE 0FI END OP VISUB ;END PACKET textalsrow;#-S tand: 09.10.8617:45'
+10398-7873997831794-186313620-87233256154684296-17369#PACKET screenservice
+DEFINES screencursor,screenput,screenpage,screenline,screenout,screenbs,
+screencopy,checkscreen,screenreorganized,screendirty,screenok,
+reorganizescreen:#L screenlets#LET zeilen=24,spalten=80,ganzrichtig=0,
+ganzfalsch=1,teilweisefalsch=3;LET emptyline="�
+";TEXT CONST blankline:=
+spalten*" ";ROW zeilenTEXT VAR screen;TEXT VAR buffer;INT VAR screenstatus:=
+ganzfalsch;ROW zeilenBOOL VAR lineok;INT VAR zeile;INT VAR curx,cury,pbegin,
+pend;.allesrichtig:ROW zeilenBOOL :(TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE 
+,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,
+TRUE ,TRUE ,TRUE ,TRUE ,TRUE ).allesfalsch:ROW zeilenBOOL :(FALSE ,FALSE ,
+FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,
+FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE )
+.;BOOL PROC screenreorganized:screenstatus=ganzrichtigEND PROC 
+screenreorganized;PROC screendirty:screenstatus:=ganzfalsch;END PROC 
+screendirty;PROC screenok:screenstatus:=ganzrichtig;END PROC screenok;PROC 
+screenok(BOOL CONST wie,INT CONST von,bis):IF screenstatus=ganzfalschCAND wie
+THEN lineok:=allesfalsch;screenstatus:=teilweisefalschELIF screenstatus=
+ganzrichtigCAND NOT wieTHEN lineok:=allesrichtig;screenstatus:=
+teilweisefalschFI ;IF screenstatus=teilweisefalschTHEN FOR zeileFROM vonUPTO 
+bisREPEAT lineok(zeile):=wiePER FI END PROC screenok;PROC checkscreen:IF 
+screenstatus<>ganzrichtigTHEN reorganizescreenFI END PROC checkscreen;
+screenpage;PROC screencursor(INT CONST x,y):curx:=x;cury:=yEND PROC 
+screencursor;PROC screenpage:FOR curyFROM 1UPTO zeilen-1REPEAT screen(cury):=
+emptylinePER ;screen(zeilen):=blankline;cury:=1;curx:=1END PROC screenpage;
+PROC screenbs:curxDECR 1END PROC screenbs;PROC screenline:curyINCR 1;curx:=1;
+END PROC screenline;PROC screenput(TEXT CONST was):IF was>""THEN 
+checkworkline;getfirstparttoput;WHILE theremaybearestREP replacepart;
+getnextparttoputPER ;replacerestFI .getfirstparttoput:pbegin:=pos(was," ","�"
+,1);pend:=pos(was,"�","�",pbegin)-1.theremaybearest:pend>0.replacepart:buffer
+:=subtext(was,pbegin,pend);replace(workline,pbegin+curx-1,buffer).
+getnextparttoput:pbegin:=pos(was," ","�",pend+2);IF pbegin>0THEN pend:=pos(
+was,"�","�",pbegin)-1;ELSE pend:=0FI .replacerest:IF pbegin>0THEN IF pbegin=1
+THEN replace(workline,curx,was)ELSE buffer:=subtext(was,pbegin,LENGTH was);
+replace(workline,pbegin+curx-1,buffer)FI ;curxINCR LENGTH was;IF curx>spalten
+THEN curyINCR 1;curxDECR spaltenFI ;FI .END PROC screenput;PROC screenout(
+TEXT CONST was,INT CONST von,bis):buffer:=subtext(was,von,bis);checkscreen;
+IF buffer>""THEN checkworkline;replace(workline,curx,buffer);curxINCR ((bis-
+von)+1);IF curx>spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .workline:screen
+(cury).END PROC screenout;PROC screenout(TEXT CONST was):checkscreen;IF was>
+""THEN checkworkline;replace(workline,curx,was);curxINCR LENGTH was;IF curx>
+spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .END PROC screenout;PROC 
+reorganizescreen:out("�");IF screenstatus=teilweisefalschTHEN FOR zeileFROM 1
+UPTO zeilen-1REPEAT IF lineok(zeile)THEN out("
+")ELSE out(screen(zeile))FI 
+PER ;IF NOT lineok(zeilen)THEN outsubtext(screen(zeilen),1,spalten-1);FI 
+ELSE FOR zeileFROM 1UPTO zeilen-1REPEAT out(screen(zeile))PER ;outsubtext(
+screen(zeilen),1,spalten-1);FI ;cursor(curx,cury);screenok;END PROC 
+reorganizescreen;PROC screencopy(FILE VAR f):putline(f,"#page#");INT VAR 
+zeile;FOR zeileFROM 1UPTO zeilenREPEAT TEXT VAR t:=screen(zeile);changeall(t,
+"�"," ");changeall(t,"�"," ");putline(f,t)PER ;END PROC screencopy;PROC 
+reorganizescreen(INT CONST zeile,von,bis):cursor(von,zeile);IF LENGTH screen(
+zeile)<vonTHEN outsubtext(blankline,von,bis)ELSE outsubtext(screen(zeile),von
+,bis)FI END PROC reorganizescreen;.checkworkline:IF LENGTH (workline)<3THEN 
+workline:=blankline;FI .workline:screen(cury).END PACKET screenservice;
+PACKET maskDEFINES TAG ,:=,nil,show,put,get,putget,leavingcode,xsize,ysize,
+fields,fieldexists,formline,setautoesc,executecommandcode,length,cursor,
+clearfield,definefield,setlasteditvalues,setneweditvalues,searchfield,
+firstfield,nextfield,priorfield,fieldinfos,setfieldinfos,symbolicname,
+auskunftsnr,fieldwithname,store,storefalse,page,SCROLL ,design,designfields,
+designfield,designform,trans,TO ,transform,#V alt#fill,CLEARBY :#V std##L 
+eumelcodes##L codeintlets#LET invers="",endinvers="",left="�",right="�",
+home="�";LET chop=1,chome=1,cvor=2,cfeldende=18,crueck=8,cfeldanf=20,choch=3,
+cfeldrueck=19,crunter=10,causkunft=0,ctab=9,csettab=21,ceinf=11,caufbrech=22,
+causf=12,clearn=26,cfeldvor=13,cloeschende=24,cmark=16,cneu=17,cesc=27,
+cseiterueck=15,centry=6,cseitevor=14;LET hoptasten="?aouAOUBb§</>(!)-k'= #",
+hopcodes="�äöüÄÖÜßßß[\]{|}­k^~ \#";LET niltext="";#L maskenlets#LET tagtypenr=
+999,filetypenr=1003,taglines=24,maxfields=100;#boardlines=2000,##boardtype=
+777;#TEXT VAR cat;BOOL VAR beimletztenrausfallen:=FALSE ,prot:=FALSE ,
+outputallowed:=TRUE ;BOOL VAR closedbit,protectbit,darstbit,tabbit,leftbit,
+exitbit,rollbit,normal:=TRUE ;INT VAR workint,ausnr;PROC store(BOOL CONST ein
+):prot:=ein;IF NOT einTHEN screendirty;outputallowed:=TRUE FI END PROC store;
+PROC storefalse(INT CONST von,bis):prot:=FALSE ;screenok(FALSE ,von,bis);
+outputallowed:=TRUE END PROC storefalse;BOOL PROC store:protEND PROC store;
+PROC page:IF protTHEN screenpage;screenokFI ;IF outputallowedTHEN out("��")
+FI END PROC page;PROC xoutsubtext(TEXT CONST was,INT CONST von,bis):IF prot
+THEN screenout(was,von,bis)FI ;IF outputallowedTHEN outsubtext(was,von,bis)
+FI END PROC xoutsubtext;TYPE TAG =STRUCT (TEXT erstel,darst,diainfo,dbnam,
+ausknam,feld,x,y,len,tab,ROW taglinesTEXT formblatt,INT xmax,ymax,xs,ys,dbp,
+ver,durchs,art);OP :=(TAG VAR a,TAG CONST b):CONCR (a):=CONCR (b)END OP :=;
+PROC nil(TAG VAR t):t.formblatt:=ROW taglinesTEXT :("","","","","","","","",
+"","","","","","","","","","","","","","","","");t.xmax:=0;t.ymax:=0;t.xs:=1;
+t.ys:=1;t.dbp:=0;t.ver:=1;t.durchs:=0;t.art:=0;t.darst:="";t.erstel:="";t.
+diainfo:="";t.dbnam:="";t.ausknam:="";t.feld:="";t.x:="";t.y:="";t.tab:="";t.
+len:="";END PROC nil;INT PROC fields(TAG CONST a):LENGTH a.erstelEND PROC 
+fields;BOOL PROC fieldexists(TAG CONST a,INT CONST feldnr):(a.erstelVSUB 
+feldnr)>0END PROC fieldexists;INT PROC xsize(TAG CONST a):a.xmaxEND PROC 
+xsize;INT PROC ysize(TAG CONST a):a.ymaxEND PROC ysize;TEXT PROC formline(
+TAG CONST a,INT CONST l):a.formblatt(l)END PROC formline;PROC setinfo(TEXT 
+CONST string,INT CONST pos):workint:=stringVSUB pos;IF workint>0THEN 
+setallvaluesELSE normal:=TRUE FI .setallvalues:closedbit:=hbit;protectbit:=
+hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;
+normal:=FALSE .hbit:workint:=workint*2;IF workint>255THEN workintDECR 256;
+TRUE ELSE FALSE FI .END PROC setinfo;PROC clearfield(TAG VAR a,INT CONST feld
+):sucheanfangdesfeldelementstring;sucheendedesfeldelementstring;
+loeschefeldelementeintraege;korrigiereerstelverweise;loeschefeldeintraege.
+sucheanfangdesfeldelementstring:INT VAR anf:=pos(a.feld,code(feld)).
+sucheendedesfeldelementstring:INT VAR ende:=anf;WHILE (a.feldVSUB ende)=feld
+REP endeINCR 1PER ;endeDECR 1.loeschefeldelementeintraege:change(a.feld,anf,
+ende,"");change(a.x,anf,ende,"");change(a.y,anf,ende,"");change(a.len,anf,
+ende,"");change(a.tab,anf,ende,"").korrigiereerstelverweise:INT VAR feldnr;
+FOR feldnrFROM 1UPTO LENGTH a.erstelREP IF code(a.erstelSUB feldnr)>endeTHEN 
+replace(a.erstel,feldnr,code(decrementierterwert))FI ;PER .
+decrementierterwert:code(a.erstelSUB feldnr)-(ende-anf+1).
+loeschefeldeintraege:replace(a.erstel,feld,"�");replace(a.darst,feld,"�");
+replace(a.diainfo,feld,"�");IF LENGTH a.dbnam>=2*feldTHEN replace(a.dbnam,
+feld,0)FI ;IF LENGTH a.ausknam>=2*feldTHEN replace(a.ausknam,feld,0)FI .END 
+PROC clearfield;PROC definefield(TAG VAR t,TEXT CONST xb,yb,lenb,tabb,INT 
+CONST dbnam,auskinfo,feldnr,TEXT CONST darst,diainfo):IF fieldexists(t,feldnr
+)THEN clearfield(t,feldnr)FI ;elementarfeldpossuchen;elementarfeldereinfuegen
+;erstelverweisekorrigieren;feldeintragen.elementarfeldpossuchen:
+zumerstenelfeld;WHILE elfelddaCAND (liegtvorneuemCOR NOT isterstel)REP 
+oldnumber:=feld;elementarfeldposINCR 1PER .elementarfeldereinfuegen:
+insertchar(t.y,yb,elementarfeldpos);insertchar(t.x,xb,elementarfeldpos);
+insertchar(t.tab,tabb,elementarfeldpos);insertchar(t.len,lenb,
+elementarfeldpos);insertchar(t.feld,LENGTH xb*code(feldnr),elementarfeldpos).
+erstelverweisekorrigieren:INT VAR fnr;FOR fnrFROM 1UPTO LENGTH t.erstelREP 
+IF code(t.erstelSUB fnr)>=elementarfeldposTHEN replace(t.erstel,fnr,code(
+incrementierterwert))FI ;PER .incrementierterwert:code(t.erstelSUB fnr)+
+LENGTH xb.feldeintragen:replaceiac(t.erstel,feldnr,code(elementarfeldpos));
+replaceiac(t.diainfo,feldnr,diainfo);replaceiac(t.darst,feldnr,darst);IF 
+dbnam<>0THEN replaceiac(t.dbnam,feldnr,dbnam)FI ;IF auskinfo<>0THEN 
+replaceiac(t.ausknam,feldnr,auskinfo)FI .zumerstenelfeld:INT VAR oldnumber:=0
+;INT VAR elementarfeldpos:=1.liegtvorneuem:y<(ybSUB 1)OR (y=(ybSUB 1)AND x<(
+xbSUB 1)).isterstel:oldnumber<>feld.elfeldda:elementarfeldpos<=LENGTH t.x.y:t
+.ySUB elementarfeldpos.x:t.xSUB elementarfeldpos.feld:code(t.feldSUB 
+elementarfeldpos).END PROC definefield;OP SCROLL (TAG VAR t,INT CONST lines):
+cat:="";INT VAR i;FOR iFROM 1UPTO LENGTH (t.y)REP INT VAR v:=code(t.ySUB i)+
+lines;IF v<1OR v>taglinesTHEN errorstop(
+"Feld ausserhalb Bildschirm durch SCROLL")FI ;catCAT code(v)PER ;t.y:=cat;IF 
+lines>0THEN FOR iFROM min(taglines-lines,t.ymax)DOWNTO 1REP t.formblatt(i+
+lines):=t.formblatt(i)PER ;FOR iFROM linesDOWNTO 1REP t.formblatt(i):=""PER ;
+t.ymaxINCR lines;t.ymax:=min(taglines,t.ymax)ELSE FOR iFROM 1-linesUPTO min(t
+.ymax-lines,taglines)REP t.formblatt(i+lines):=t.formblatt(i)PER ;FOR iFROM t
+.ymax+lines+1UPTO t.ymaxREP t.formblatt(i):=""PER ;t.ymaxINCR lines;t.ymax:=
+max(t.ymax,1);FI .END OP SCROLL ;INT PROC fieldwithname(TAG CONST t,INT 
+CONST name):ipos(t.dbnam,name)END PROC fieldwithname;INT PROC symbolicname(
+TAG CONST t,INT CONST feld):t.dbnamVISUB feldEND PROC symbolicname;PROC 
+symbolicname(TAG VAR t,INT CONST feld,symbol):replaceiac(t.dbnam,feld,symbol)
+END PROC symbolicname;INT PROC auskunftsnr(TAG CONST t,INT CONST feld):t.
+ausknamVISUB feldEND PROC auskunftsnr;INT PROC auskunftsnr:ausnrEND PROC 
+auskunftsnr;PROC auskunftsnr(TAG VAR t,INT CONST feld,ausknr):replaceiac(t.
+ausknam,feld,ausknr)END PROC auskunftsnr;PROC fieldinfos(TAG CONST t,INT 
+CONST feld,INT VAR geheimcode,BOOL VAR closed,protected,secret,special,left):
+geheimcode:=code(t.darstSUB feld);setinfo(t.diainfo,feld);IF normalTHEN 
+closed:=FALSE ;protected:=FALSE ;secret:=FALSE ;special:=FALSE ;left:=FALSE ;
+ELSE closed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit
+;left:=leftbit;FI END PROC fieldinfos;PROC setfieldinfos(TAG VAR t,INT CONST 
+feld,BOOL CONST closed,protected,secret):INT VAR cd:=(t.diainfoVSUB feld)MOD 
+32;IF secretTHEN cdINCR 32FI ;IF protectedTHEN cdINCR 64FI ;IF closedTHEN cd
+INCR 128FI ;replaceiac(t.diainfo,feld,code(cd))END PROC setfieldinfos;PROC 
+transform(TAG CONST t,FILE VAR o):enablestop;buffer:="";bufferCAT t.xmax;
+bufferCAT t.ymax;bufferCAT t.xs;bufferCAT t.ys;bufferCAT t.dbp;bufferCAT t.
+ver;bufferCAT t.durchs;bufferCAT t.art;putline(o,buffer);putline(o,t.darst);
+putline(o,t.erstel);putline(o,t.diainfo);putline(o,t.dbnam);putline(o,t.
+ausknam);putline(o,t.feld);putline(o,t.x);putline(o,t.y);putline(o,t.tab);
+putline(o,t.len);putline(o,trtab);tTO o.END PROC transform;PROC transform(
+FILE VAR i,TAG VAR t):enablestop;TEXT VAR oldtrtab:=trtab;getline(i,buffer);t
+.xmax:=bufferISUB 1;IF t.xmax<>12336THEN t.ymax:=bufferISUB 2;t.xs:=buffer
+ISUB 3;t.ys:=bufferISUB 4;t.dbp:=bufferISUB 5;t.ver:=bufferISUB 6;t.durchs:=
+bufferISUB 7;t.art:=bufferISUB 8;getline(i,t.darst);getline(i,t.erstel);
+getline(i,t.diainfo);getline(i,t.dbnam);getline(i,t.ausknam);getline(i,t.feld
+);getline(i,t.x);getline(i,t.y);getline(i,t.tab);getline(i,t.len);getline(i,
+trtab);ELSE nil(t);FI ;iTO t;trtab:=oldtrtab;IF t.ver<>1THEN errorstop(
+"Datei enth�lt kein TAG")FI .END PROC transform;PROC filetotag(DATASPACE 
+CONST ei):type(ei,tagtypenr)END PROC filetotag;PROC tagtofile(DATASPACE 
+CONST ei):IF type(ei)=tagtypenrTHEN type(ei,filetypenr)ELSE errorstop(
+"TYPE nicht TAG")FI END PROC tagtofile;PROC efill(TAG VAR ff,TEXT CONST t,
+INT CONST elfeld):INT CONST abwo:=1;zumerstenelementarfeld;WHILE 
+nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF 
+gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE efillFI ;zumelementarfeld
+;PER ;gibrestaus.zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff
+.feldVSUB elfeld;ael:=elfeld;zumelementarfeld.fuelleelementarfeld:cat:=
+subtext(t,tout+1,tout+al);replace(ff.formblatt(ay),ax,cat);toutINCR al.
+nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR 1.
+zumelementarfeld:al:=ff.lenVSUB ael;ax:=ff.xVSUB ael;ay:=ff.yVSUB ael.
+gehoertzumnaechstenfeld:(ff.feldVSUB ael)<>afeld.gibrestaus:cat:=subtext(t,
+tout+1,tlen);replace(ff.formblatt(ay),ax,cat).markiereueberlauf:replace(ff.
+formblatt(ay),ax+al-1,"<").END PROC efill;PROC fill(TAG VAR t,TEXT CONST 
+inhalt,INT CONST feld):setinfo(t.diainfo,feld);INT VAR erstelem:=t.erstel
+VSUB feld;IF erstelem>0THEN IF normalCOR NOT closedbitTHEN efill(t,inhalt,
+erstelem)FI FI END PROC fill;OP CLEARBY (TAG VAR u,TAG CONST u1):INT VAR i;
+FOR iFROM 1UPTO u.ymaxREP u.formblatt(i):=u1.formblatt(i)PER ;END OP CLEARBY 
+;INT VAR afeld,ax,ay,al,ael,tlen,tout;PROC eput(TAG CONST ff,TEXT CONST t,
+INT CONST elfeld):eput(ff,t,elfeld,1)END PROC eput;PROC eput(TAG CONST ff,
+TEXT CONST t,INT CONST elfeld,INT CONST abwo):zumerstenelementarfeld;WHILE 
+nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF 
+gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE eputFI ;zumelementarfeld;
+PER ;gibrestaus;REP elementarfeldweiterzaehlen;IF gehoertzumnaechstenfeld
+THEN LEAVE eputFI ;zumelementarfeld;gibhintergrundausPER .
+zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff.feldVSUB elfeld;
+ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+
+al);toutINCR al.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:ael
+INCR 1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feld
+VSUB ael)<>afeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IF tout+al>tlenTHEN 
+xoutsubtext(grund,ax+tlen-tout,ax+al-1)FI .gibhintergrundaus:xoutsubtext(
+grund,ax,ax+al-1).grund:ff.formblatt(ay).markiereueberlauf:IF outputallowed
+THEN out("�<")FI ;IF protTHEN screenbs;screenout("<")FI .END PROC eput;PROC 
+positionieren(TAG CONST ff):al:=ff.lenVSUB ael;ax:=ff.xVSUB ael;ay:=ff.yVSUB 
+ael;IF protTHEN screencursor(ax,ay)FI ;IF outputallowedTHEN cursor(ax,ay)FI .
+END PROC positionieren;PROC cursor(TAG CONST ff,INT CONST feld):ael:=ff.
+erstelVSUB feld;positionieren(ff)END PROC cursor;INT PROC length(TAG CONST ff
+,INT CONST feld):zumerstenelementarfeld;IF ael<1THEN LEAVE lengthWITH 0FI ;
+INT VAR len:=0;REP lenINCR feldlaenge;zumnaechstenelementarfeld;UNTIL 
+gehoertzumnaechstenfeldPER ;len.zumerstenelementarfeld:ael:=ff.erstelVSUB 
+feld.zumnaechstenelementarfeld:aelINCR 1.gehoertzumnaechstenfeld:(ff.feld
+VSUB ael)<>feld.feldlaenge:ff.lenVSUB ael.END PROC length;PROC show(TAG 
+CONST ff):INT VAR i;IF protTHEN IF screenreorganizedTHEN FOR iFROM 1UPTO ff.
+ymaxREP screencursor(1,i);screenput(ff.formblatt(i))PER ;ELSE FOR iFROM 1
+UPTO ff.ymaxREP IF ff.formblatt(i)>""THEN screencursor(1,i);screenok(FALSE ,i
+,i);screenput(ff.formblatt(i))FI PER ;IF outputallowedTHEN reorganizescreen
+FI ;LEAVE showFI FI ;IF outputallowedTHEN out(home);out(ff.formblatt(1));FOR 
+iFROM 2UPTO ff.ymaxREP line;out(ff.formblatt(i))PER FI .END PROC show;INT 
+VAR charcode:=0,lastx,lasty;PROC translatecode:charcode:=code(char);SELECT 
+charcodeOF CASE chop:charcode:=chomeCASE cvor:charcode:=cfeldendeCASE crueck:
+charcode:=cfeldanfCASE choch:charcode:=cseiterueckCASE crunter:charcode:=
+cseitevorCASE ctab:charcode:=csettabCASE ceinf:charcode:=caufbrechCASE causf:
+charcode:=cloeschendeCASE cfeldvor:charcode:=cfeldrueckCASE cmark:charcode:=
+cneuCASE cesc:charcode:=clearnOTHERWISE charcode:=pos(hoptasten,char);IF 
+charcode=0THEN IF ischarTHEN FI ELSE char:=hopcodesSUB charcode;charcode:=
+code(char)FI END SELECT END PROC translatecode;TEXT VAR char,pseudochar;BOOL 
+PROC ischar:inchar(char);charcode:=code(char);IF charcode>31THEN TRUE ELIF 
+charcode=chopTHEN inchar(char);translatecode;charcode>31ELSE FALSE FI END 
+PROC ischar;INT VAR aktlimit,aktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo;
+PROC setfieldvalues(TAG CONST ta):aktlen:=ta.lenVSUB aktel;aktanf:=ta.xVSUB 
+aktel;aktline:=ta.yVSUB aktelEND PROC setfieldvalues;INT VAR nextfeld,nextel,
+nextwo,nextbegin;PROC setlasteditvalues:preset:=TRUE END PROC 
+setlasteditvalues;PROC setneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin
+;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROC setneweditvalues;BOOL VAR 
+preset:=FALSE ,feldda;PROC searchfield(TAG CONST t,INT CONST x,y,BOOL VAR 
+erfolg):erfolg:=FALSE ;nextel:=0;REP sucheelementinrichtigerzeileUNTIL 
+keinsmehrdaCOR xposstimmtPER ;IF erfolgTHEN nextfeld:=t.feldVSUB nextel;
+nextbegin:=1;INT VAR i:=t.erstelVSUB nextfeld;WHILE i<nextelREP nextbegin
+INCR (t.lenVSUB i);iINCR 1PER ;nextwo:=nextbegin+x-anfangFI .
+sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y),nextel+1).keinsmehrda:
+nextel=0.xposstimmt:erfolg:=anfang<=xAND ende>x;erfolg.anfang:t.xVSUB nextel.
+ende:(t.xVSUB nextel)+(t.lenVSUB nextel).END PROC searchfield;PROC editieren(
+TAG CONST ff,TEXT VAR eing,INT CONST feld):IF fieldexists(ff,feld)THEN 
+bestimmeeinstieg;REPEAT REPEAT wertesteuerzeichenausUNTIL ischarPER ;REPEAT 
+schreibezeichen;UNTIL wo>aktlimitCOR NOT ischarPER PER FI .bestimmeeinstieg:
+IF presetAND (feld=0COR feld=aktfeld)THEN ELSE aktfeld:=feld;aktel:=ff.erstel
+VSUB aktfeld;aktbegin:=1;wo:=1FI ;charcode:=centry;preset:=FALSE ;IF NOT 
+normalTHEN preparespecialeditingFI .preparespecialediting:IF darstbitTHEN 
+pseudochar:=ff.darstSUB feldFI .schreibezeichen:IF wo<=LENGTH eingTHEN 
+replace(eing,wo,char)ELSE eingCAT char;IF wo>LENGTH eing+1THEN 
+normalizepositionFI FI ;IF normalCOR NOT darstbitTHEN out(char)ELSE out(
+pseudochar)FI ;woINCR 1.wertesteuerzeichenaus:SELECT charcodeOF CASE cneu:
+neuschreibenCASE centry:setfieldvalues(ff);positionieren;aktlimit:=aktbegin+
+aktlen-1CASE cvor:IF wo<=LENGTH eingTHEN woINCR 1;out(right);forwardFI CASE 
+cfeldende:zumfeldendeCASE crueck:woDECR 1;out(left);backwardCASE cfeldanf:wo
+:=1;backwardtoendCASE ceinf:insertchar(eing," ",wo);restneuschreibenCASE 
+causf:IF LENGTH eing>0THEN IF wo>LENGTH eingTHEN woDECR 1;out(left);backward
+FI ;deletechar(eing,wo);restneuschreibenFI ;CASE cloeschende:eing:=subtext(
+eing,1,wo-1);restneuschreibenCASE choch:gouporleaveCASE crunter:godownorleave
+OTHERWISE :IF charcode>31THEN forwardELSE leaveFI END SELECT .zumfeldende:wo
+:=LENGTH eing+1;forward;positionieren.positionieren:cursor(aktanf+(wo-
+aktbegin),aktline).forward:WHILE wo>aktlimitREPEAT aktelINCR 1;IF 
+gehoertzumfeldTHEN aktbegin:=aktlimit+1;decodefieldlen;aktlimitINCR aktlen
+ELSE aktelDECR 1;wo:=aktlimitFI ;positionierenPER .leave:getcursor(lastx,
+lasty);LEAVE editieren.godownorleave:getcursor(lastx,lasty);searchfield(ff,
+lastx,lasty+1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:=nextwo;aktel:=
+nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:=aktbegin-1+aktlen;
+positionierenELSE LEAVE editierenFI .gouporleave:getcursor(lastx,lasty);
+searchfield(ff,lastx,lasty-1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:=
+nextwo;aktel:=nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:=
+aktbegin-1+aktlen;positionierenELSE LEAVE editierenFI .backward:IF wo<
+aktbeginTHEN IF wo<1THEN wo:=1ELSE aktelDECR 1;decodefieldlen;aktlimit:=
+aktbegin-1;aktbeginDECR aktlen;FI ;positionierenFI .backwardtoend:aktel:=ff.
+erstelVSUB aktfeld;decodefieldlen;aktbegin:=1;aktlimit:=aktlen;positionieren.
+normalizeposition:wo:=LENGTH eing;WHILE wo<aktbeginREP aktelDECR 1;
+decodefieldlen;aktlimit:=aktbegin-1;aktbeginDECR aktlenPER ;positionieren.
+decodefieldlen:setfieldvalues(ff).restneuschreiben:neuschreiben.neuschreiben:
+eput(ff,darstellstring,ff.erstelVSUB aktfeld);positionieren.darstellstring:
+IF normalCOR NOT darstbitTHEN eingELSE LENGTH (eing)*pseudocharFI .
+gehoertzumfeld:(ff.feldVSUB aktel)=aktfeld.END PROC editieren;TEXT PROC get(
+TAG CONST ff,INT CONST feld):TEXT VAR a:=niltext;get(ff,a,feld);aEND PROC get
+;PROC get(TAG CONST ff,TEXT VAR eingabe,INT CONST feld):IF protTHEN 
+checkscreenFI ;BOOL VAR p:=prot;prot:=FALSE ;setinfo(ff.diainfo,feld);
+editieren(ff,eingabe,feld);IF pTHEN prot:=TRUE ;outputallowed:=FALSE ;put(ff,
+eingabe,feld);outputallowed:=TRUE FI END PROC get;PROC putget(TAG CONST ff,
+TEXT VAR value,INT CONST feld):BOOL VAR p:=prot;prot:=FALSE ;outputallowed:=
+TRUE ;put(ff,value,feld);editieren(ff,value,feld);IF pTHEN prot:=TRUE ;
+outputallowed:=FALSE ;put(ff,value,feld);outputallowed:=TRUE FI END PROC 
+putget;PROC put(TAG CONST ff,TEXT CONST v,INT CONST feld):setinfo(ff.diainfo,
+feld);INT VAR erstelem:=ff.erstelVSUB feld;IF erstelem>0THEN IF normalCOR 
+NOT darstbitTHEN eput(ff,v,erstelem)ELSE eput(ff,LENGTH v*(ff.darstSUB feld),
+erstelem)FI FI END PROC put;INT PROC leavingcode:charcodeEND PROC leavingcode
+;PROC putget(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v)
+;get(ff,v,einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT 
+VAR fieldvalues):INT VAR iFOR iFROM 1UPTO LENGTH ff.erstelREP IF fieldexists(
+ff,i)THEN put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff,
+ROW maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=LENGTH ff.
+erstel;IF NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag")
+ELSE WHILE feld<=felderREPEAT get(ff,fieldvalues(feld),feld);
+executecommandcode(ff,feld)UNTIL charcode=cescPER FI END PROC get;PROC 
+executecommandcode(TAG CONST ff,INT VAR feld):SELECT charcodeOF CASE 
+cfeldrueck:topriorfieldCASE cfeldvor:tonextfieldCASE choch:goupifpossible
+CASE crunter:godownifpossibleCASE chome:tohomefieldCASE ctab:IF protTHEN 
+reorganizescreenFI ;setlasteditvaluesCASE cesc:ausnr:=auskunftsnr(ff,feld)
+END SELECT .topriorfield:REPEAT feld:=priorfield(ff,feld)UNTIL warerstesCOR 
+nichtgesperrtPER ;IF warerstesTHEN tohomefieldFI .tonextfield:INT VAR oldfeld
+:=feld;REP feld:=nextfield(ff,feld)UNTIL warletztesCOR nichtgesperrtPER ;IF 
+warletztesTHEN feld:=oldfeld;IF beimletztenrausfallenTHEN charcode:=cesc;
+beimletztenrausfallen:=FALSE FI FI .tohomefield:feld:=firstfield(ff);WHILE 
+gesperrtREP feld:=nextfield(ff,feld)PER .goupifpossible:BOOL VAR erfolg;
+searchfield(ff,lastx,lasty-1,erfolg);IF erfolgAND nextnichtgesperrtTHEN 
+setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .godownifpossible:
+searchfield(ff,lastx,lasty+1,erfolg);IF erfolgAND nextnichtgesperrtTHEN 
+setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .nichtgesperrt:(ff.
+diainfoVSUB feld)<64.nextnichtgesperrt:(ff.diainfoVSUB nextfeld)<64.gesperrt:
+NOT nichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROC 
+executecommandcode;PROC setautoesc:beimletztenrausfallen:=TRUE END PROC 
+setautoesc;INT PROC firstfield(TAG CONST t):t.feldVSUB 1END PROC firstfield;
+INT PROC nextfield(TAG CONST t,INT CONST feld):INT VAR el:=(t.erstelVSUB feld
+)+1;WHILE (t.feldVSUB el)=feldREP elINCR 1PER ;t.feldVSUB elEND PROC 
+nextfield;INT PROC priorfield(TAG CONST t,INT CONST feld):t.feldVSUB ((t.
+erstelVSUB feld)-1)END PROC priorfield;TEXT VAR buffer,blinkan,blinkaus;TEXT 
+VAR trtab:="!<> ",tr;TAG VAR hilfstag;nil(hilfstag);hilfstag.formblatt(
+taglines):="                                      Feldnummer : __ ";
+definefield(hilfstag,code(pos(hilfstag.formblatt(taglines),"_")),code(
+taglines),"�",".",0,0,1,"�","�");OP TO (FILE VAR a,TAG VAR t):INT VAR i,j;
+TEXT VAR char;t.xmax:=0;FOR jFROM 1UPTO taglinesREP IF NOT eof(a)THEN getline
+(a,buffer);transform;IF length(buffer)>t.xmaxTHEN t.xmax:=length(buffer)FI ;t
+.ymax:=jELSE tr:=niltext;FI ;t.formblatt(j):=tr;PER .transform:tr:=niltext;
+FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT pos(trtab,char)OF 
+CASE 2:trCAT inversCASE 3:trCAT endinversCASE 1:trCAT " "CASE 4:trCAT right
+OTHERWISE :trCAT charEND SELECT PER .END OP TO ;OP TO (TAG CONST t,FILE VAR f
+):INT VAR i,j;TEXT VAR pseudoblank:=trtabSUB 1,char;FOR jFROM 1UPTO t.ymax
+REP buffer:=t.formblatt(j);retransform;putline(f,tr)PER .retransform:tr:=
+niltext;FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT code(char)
+OF CASE 32:trCAT pseudoblankCASE 15:trCAT (trtabSUB 2)CASE 14:trCAT (trtab
+SUB 3)CASE cvor:trCAT " "OTHERWISE :trCAT charEND SELECT PER ;buffer:=tr.END 
+OP TO ;PROC trans(TEXT CONST x):IF LENGTH x=3THEN trtab:=x;trtabCAT " "ELSE 
+errorstop("falsche Umsetztabelle")FI END PROC trans;TEXT PROC blink(TAG 
+CONST t,INT VAR feld):blinkan:=length(t,feld)*"#";blinkaus:=LENGTH blinkan*
+"!";INT VAR i;FOR iFROM 1UPTO 20REP IF (iMOD 2)=0THEN put(t,blinkan,feld);
+ELSE put(t,blinkaus,feld);FI ;buffer:=incharety(3)UNTIL buffer<>""PER ;buffer
+END PROC blink;PROC findchar(TAG CONST f,TEXT CONST eingabe,INT VAR posx,posy
+):INT VAR posxn:=posx,posyn:=posy;WHILE (f.formblatt(posy)SUB posxn)=eingabe
+REP posxnINCR 1PER ;posxn:=pos(f.formblatt(posy),eingabe,posxn+1);WHILE posxn
+=0REP posynINCR 1;IF posyn>f.ymaxTHEN LEAVE findcharFI ;posxn:=pos(f.
+formblatt(posyn),eingabe)PER ;posx:=posxn;posy:=posyn.END PROC findchar;PROC 
+designelfield(TAG CONST t,INT CONST xm,ym,INT VAR x,y,l):cursortostartpos;
+cursortoendpos.cursortostartpos:TEXT VAR storage:="_";REP cursor(x,y);IF 
+ischarTHEN findchar(t,char,x,y);storage:=charELSE SELECT charcodeOF CASE 
+chome:x:=1;y:=1CASE cvor:x:=xMOD xm;xINCR 1CASE crueck:IF x=1THEN x:=xmELSE x
+DECR 1FI CASE cfeldanf:x:=1CASE cfeldende:x:=xmCASE choch:IF y=1THEN y:=ym
+ELSE yDECR 1FI CASE crunter:y:=yMOD ym;yINCR 1CASE causkunft:cursor(1,24);out
+("X=");put(text(x,2));out(" Y=");put(text(y,2))CASE cesc:LEAVE designelfield
+CASE ctab:findchar(t,storage,x,y)CASE cfeldvor:LEAVE cursortostartpos
+OTHERWISE :out("�")END SELECT FI PER .cursortoendpos:TEXT VAR aktchar:=t.
+formblatt(y)SUB x;IF aktchar>" "AND (t.formblatt(y)SUB x-1)<>aktcharTHEN l:=1
+;WHILE (t.formblatt(y)SUB (x+l))=aktcharREP lINCR 1PER ;FI ;markiere;REP 
+WHILE ischarREP out("�")PER ;IF charcode=cvorAND x+l<xm+1THEN lINCR 1;out(
+right);out(">");out(left);ELIF charcode=crueckAND l>1THEN 
+originalzeichenausgeben;lDECR 1ELIF charcode=cescTHEN LEAVE designelfield
+ELIF charcode=cfeldvorTHEN LEAVE cursortoendposFI PER .
+originalzeichenausgeben:out(" �");out(t.formblatt(y)SUB (x+l-1));out("��").
+markiere:cursor(x,y);lTIMESOUT ">";out(left).END PROC designelfield;INT VAR 
+el;PROC designfield(TAG CONST t,INT CONST feld,TEXT VAR x,y,l,ta):IF NOT 
+varsinitializedTHEN initializeFI ;REP designelement;elINCR 1PER .
+varsinitialized:LENGTH x=LENGTH yAND LENGTH y=LENGTH lAND LENGTH l=LENGTH ta
+AND LENGTH x>0.initialize:IF NOT fieldexists(t,feld)THEN x:="";y:="";l:="";ta
+:=""ELSE INT VAR begin:=t.erstelVSUB feld,end:=begin;WHILE (t.feldVSUB end)=
+feldREP endINCR 1PER ;endDECR 1;x:=subtext(t.x,begin,end);y:=subtext(t.y,
+begin,end);l:=subtext(t.len,begin,end);ta:=subtext(t.tab,begin,end);FI ;el:=1
+.designelement:INT VAR xb,yb,lb;cursor(1,24);out(text(el));out(
+". Teilfeld                 ");IF LENGTH x<elTHEN xb:=1;yb:=1;lb:=1ELSE xb:=x
+VSUB el;yb:=yVSUB el;lb:=lVSUB elFI ;designelfield(t,t.xmax,t.ymax,xb,yb,lb);
+IF charcode=cescTHEN LEAVE designfieldFI ;IF LENGTH x<elTHEN xCAT code(xb);y
+CAT code(yb);lCAT code(lb);taCAT "�"ELSE replace(x,el,code(xb));replace(y,el,
+code(yb));replace(l,el,code(lb));FI .END PROC designfield;PROC design(TAG 
+VAR todesign):REP designform(todesign);designfields(todesign);UNTIL 
+leavingcode<>cescCOR no("
�Formulardarstellung veraendern")PER END PROC 
+design;PROC designform(TAG VAR f):taginitialisieren;formulareditieren.
+formulareditieren:DATASPACE VAR wds:=nilspace;FILE VAR in:=sequentialfile(
+output,wds);fTO in;modify(in);headline(in,"Formular eingeben !");edit(in);
+page;input(in);reset(in);inTO f;forget(wds).taginitialisieren:IF f.ver<>1
+THEN nil(f)FI .END PROC designform;PROC dummie(INT VAR a,b,TEXT VAR c,BOOL 
+VAR d,e):LEAVE dummie;a:=b;d:=e;c:="";END PROC dummie;PROC designfields(TAG 
+VAR f):designfields(f,PROC dummie)END PROC designfields;PROC designfields(
+TAG VAR f,PROC (INT VAR ,INT VAR ,TEXT VAR ,BOOL VAR ,BOOL VAR )setparam):
+show(f);INT VAR feld:=2;TEXT VAR xrow,yrow,lrow,trow;REPEAT 
+feldnummereinlesen;benutzerwunscherfragen;benutzerwunschauswertenEND REP .
+benutzerwunscherfragen:IF fieldexists(f,feld)THEN REP cursor(1,24);out(
+"a(endern) ,l(oeschen), i(rrtum) ?");TEXT VAR ein:=blink(f,feld);IF ein="�"
+THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("aAäÄlLiI",ein)>0PER ;
+ELSE REP cursor(1,24);out("     n(eu einrichten), (i)rrtum ?");inchar(ein);
+IF ein="�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("nNiI",ein)>0
+PER ;FI ;cursor(1,24);out("                                 ").
+benutzerwunschauswerten:IF pos("lL",ein)>0THEN put(f,"",feld);clearfield(f,
+feld)ELSE IF fieldexists(f,feld)THEN put(f,"",feld);FI ;IF pos("iI",ein)=0
+THEN xrow:="";yrow:=" ";lrow:="";trow:="";designfield(f,feld,xrow,yrow,lrow,
+trow);parametersetzen;definefield(f,xrow,yrow,lrow,trow,sym,aus,feld,dar,dia)
+;feldINCR 1;FI FI .feldnummereinlesen:TEXT VAR itext:=text(feld);REPEAT 
+cursor(1,24);out("�");out(hilfstag.formblatt(taglines));putget(hilfstag,itext
+,1);IF leavingcode=cescTHEN LEAVE designfieldsFI ;feld:=int(itext);IF feld<1
+OR leavingcode=causkunftOR NOT lastconversionokTHEN dialogueELSE LEAVE 
+feldnummereinlesen;FI ;PER .dialogue:REP cursor(1,24);out(
+"q(uit), i(rrtum), m(aske neu zeigen), f(eldnummern)  �");inchar(ein);IF ein=
+"�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("qQiImMfF",ein)>0PER ;
+SELECT (pos("qQiImMfF",ein)-1)DIV 2OF CASE 0:LEAVE designfieldsCASE 1:LEAVE 
+dialogueCASE 2:show(f)CASE 3:INT VAR i;FOR iFROM 1UPTO fields(f)REP TEXT VAR 
+buf:=text(i);bufCAT "*";put(f,((length(f,i)-1)DIV LENGTH (buf)+1)*buf,i)PER 
+END SELECT .parametersetzen:INT VAR aus:=auskunftsnr(f,feld),sym:=
+symbolicname(f,feld);TEXT VAR dar:=f.darstSUB feld,dia;setinfo(f.diainfo,feld
+);BOOL VAR a:=closedbit,b:=protectbit,c:=darstbit;setparam(sym,aus,dar,b,c);
+setfieldinfos(f,feld,a,b,c);dia:=f.diainfoSUB feld;dar:=text(dar,1).END PROC 
+designfields;END PACKET mask;PACKET dateDEFINES monat,jahr,tag,datum,tmj,
+datumjh,nildatum,jahrestag,wochentag:LET seperatorzeichen=":./ ",
+seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b;
+BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC 
+nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90
+,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212,
+letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334
+,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j):
+INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0
+THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a
+:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a>
+letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<=
+letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<=
+letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<=
+letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI .
+januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m
+:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<=
+letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a-
+letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli
+THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli
+ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m
+:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a-
+letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum(
+TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j;
+IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5)
+*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum
+FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF 
+seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1);
+seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:=
+z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2
+)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ;
+IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH 
+nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q
+)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo):
+INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e
+FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j
+INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE 
+SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4,
+6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j)
+ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND 
+SELECT FI END PROC datum;INT PROC wochentag(INT CONST d):INT CONST x:=d-1;IF 
+x<0THEN 6-(-xMOD 7)ELSE xMOD 7FI END PROC wochentag;INT PROC jahrestag(INT 
+CONST d):INT VAR a;IF d<=beforefirstdayTHEN LEAVE jahrestagWITH -1FI ;a:=d;
+IF a<=0THEN aINCR (-(beforefirstday+1))FI ;a:=aMOD vierjahre;IF a>365THEN a
+DECR 366;a:=aMOD 365FI ;a+1END PROC jahrestag;INT PROC erg(INT CONST t,m,jc):
+INT VAR j:=jc;INT VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR 
+88;result:=-1FI ;resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:=
+tagundmonat+365*j;IF tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR 
+1ELIF tagimzyklus=erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ;
+result+tagimzyklus.erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:t
+CASE 2:t+letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+
+letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9
+:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+
+letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END 
+PROC erg;INT PROC tag(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);tEND PROC tag;
+INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END PROC jahr;
+INT PROC monat(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);mEND PROC monat;TEXT 
+PROC datumjh(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN 
+LEAVE datumjhWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT 
+seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT 
+seperatorzeichen1;IF j<100THEN eCAT "19"ELSE eCAT "20";jDECR 100FI ;eCAT code
+(jDIV 10+48);eCAT code(jMOD 10+48);eEND PROC datumjh;TEXT PROC datum(INT 
+CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN LEAVE datumWITH ""
+FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT seperatorzeichen1;eCAT 
+code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT seperatorzeichen1;eCAT code((j
+MOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND PROC datum;END PACKET date;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.maskendesign b/app/baisy/2.2.1-schulis/src/isp.maskendesign
new file mode 100644
index 0000000..a90acca
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.maskendesign
@@ -0,0 +1,302 @@
+PACKET maskendesignDEFINES maskstart,aktuellendesignnamenlesen,maskgenstart,
+holestandardvorgaben,maskenattributespeichern,einlesenderattribute,
+generieremaske,zeigegeneriertemaske,formularentwerfen,formularspeichern,
+felderentwerfen,felddefinitionenspeichern,maskenformularzeigen,
+definitionsnamenlesen,gesuchtesfeldanzeigen,feldloeschen,feldspeichern,
+feldnichtspeichern,feldmalen,feldaufneuenschirmmalen,feldattributesetzen,
+holeattribute,listeallermasken,loescheneinermaske,kopierenaendern,
+zweitennamenlesen,kopiereneinermaske,druckeneinermaske,neuernamefuereinemaske
+:LET standardanfang=2;LET z="Liste aller Masken";LET nummernmaske=
+"mb maskenfeldnummern",id="mb maskenbearbeitung1",zusatz=
+"mb maskenbearbeitung2",mgmatrix="mb maskgenmatrix",mg="mb maskengenerator",
+b1="mb maskenfeldattribute";LET dru=49;LET maxfeldnr=200;LET praefixs=
+"Formular für: ",praefixf="form.";TEXT VAR symbalphag:="#",symbalphau:="&",
+symbankreuz:="^",symbgeheim:="'",symbmeldung:="%",symbfortsetzunga:="<",
+symbfortsetzunge:=">",symbpseudoblank:="!",unterlegungalpha:="_",
+unterlegungankreuz:="_",unterlegunggeheim:="_",unterlegungmeldung:="=",
+anzeigeankreuz:="x",anzeigegeheim:="-";TEXT VAR symbolischemaske:="";TEXT 
+VAR formulardatei:="";TEXT VAR maskenname:="",zweitername:="";INT VAR 
+feldname:=standardanfang,loeschfeld;BOOL VAR da;#DBMASKE VAR dbm;nil(dbm);#
+TEXT VAR eingangsname;TAG VAR maske;;TAG VAR aktuellemaske;INT VAR 
+aktuelleposition;TEXT VAR logtextergaenzung;PROC maskstart:
+frageentwicklernachmaskennamen(id);aktuellendesignnamenlesenEND PROC 
+maskstart;PROC frageentwicklernachmaskennamen(TEXT CONST start):eingangsname
+:=start;standardstartproc(start)END PROC frageentwicklernachmaskennamen;PROC 
+aktuellendesignnamenlesen:standardmaskenfeld(maskenname,2);standardnproc;
+maskenname:=standardmaskenfeld(2);init(feld)END PROC 
+aktuellendesignnamenlesen;PROC maskgenstart:zeigemaske;holestandardvorgaben;.
+zeigemaske:frageentwicklernachmaskennamen(mg).END PROC maskgenstart;PROC 
+holestandardvorgaben:standardmaskenfeld("",1);standardmaskenfeld(maskenname,2
+);standardmaskenfeld(unterlegungalpha,3);standardmaskenfeld(symbalphag,4);
+standardmaskenfeld(symbalphau,5);standardmaskenfeld(symbankreuz,6);
+standardmaskenfeld(unterlegungankreuz,7);standardmaskenfeld(anzeigeankreuz,8)
+;standardmaskenfeld(symbgeheim,9);standardmaskenfeld(unterlegunggeheim,10);
+standardmaskenfeld(anzeigegeheim,11);standardmaskenfeld(symbmeldung,12);
+standardmaskenfeld(unterlegungmeldung,13);standardmaskenfeld(symbfortsetzunga
+,14);standardmaskenfeld(symbfortsetzunge,15);standardmaskenfeld(
+symbpseudoblank,16);standardnproc;maskenname:=standardmaskenfeld(2);
+unterlegungalpha:=standardmaskenfeld(3);symbalphag:=standardmaskenfeld(4);
+symbalphau:=standardmaskenfeld(5);symbankreuz:=standardmaskenfeld(6);
+unterlegungankreuz:=standardmaskenfeld(7);anzeigeankreuz:=standardmaskenfeld(
+8);symbgeheim:=standardmaskenfeld(9);unterlegunggeheim:=standardmaskenfeld(10
+);anzeigegeheim:=standardmaskenfeld(11);symbmeldung:=standardmaskenfeld(12);
+unterlegungmeldung:=standardmaskenfeld(13);symbfortsetzunga:=
+standardmaskenfeld(14);symbfortsetzunge:=standardmaskenfeld(15);
+symbpseudoblank:=standardmaskenfeld(16);trans(symbpseudoblank+
+symbfortsetzunga+symbfortsetzunge);.END PROC holestandardvorgaben;PROC 
+formularentwerfen(INT CONST nummerderauskunft):IF maskenname=""THEN 
+keineeingabe;return(1)ELSE setzedateinamen;IF NOT exists(symbolischemaske)
+THEN IF NOT maskedaTHEN logtextergaenzung:="eingefügt";neuELSE 
+logtextergaenzung:="geändert";aendernFI ;FI ;formularzeigen(nummerderauskunft
+)FI .keineeingabe:aktuelleposition:=standardanfang;standardmeldung(26,"").
+setzedateinamen:symbolischemaske:=praefixs+maskenname;formulardatei:=praefixf
++maskenname.maskeda:maskegibtes(maskenname).neu:init(feld);
+erzeugeleeresymbolischemaske(maskenname).aendern:erzeugesymbolischemaske(
+maskenname).END PROC formularentwerfen;PROC formularzeigen(INT CONST 
+nummerderauskunft):page;sagderauskunftwasaufdemeingangsschirmstand;editiere(
+symbolischemaske,"a",FALSE ).sagderauskunftwasaufdemeingangsschirmstand:TEXT 
+VAR eingangsinfo:="";eingangsinfoCAT infozeile("geschützt",symbalphag);
+eingangsinfoCAT infozeile("ungeschützt",symbalphau);eingangsinfoCAT infozeile
+("Ankreuzfeld",symbankreuz);eingangsinfoCAT infozeile("sonst. Geheimfeld",
+symbgeheim);eingangsinfoCAT infozeile("Meldungsfeld",symbmeldung);
+eingangsinfoCAT infozeile("Beginn Fortsetzung",symbfortsetzunga);eingangsinfo
+CAT infozeile("Ende Fortsetzung",symbfortsetzunge);eingangsinfoCAT infozeile(
+"Überdeckungszeichen",symbpseudoblank);eingangsinfoCAT auskunftstextende;
+ergaenzeauskunft(eingangsinfo,nummerderauskunft).END PROC formularzeigen;
+PROC generieremaske:erzeugemaske(maskenname);page;show(maske);
+zeigegeneriertemaskeEND PROC generieremaske;PROC zeigegeneriertemaske:INT 
+VAR feldind,maxfeld:=min(fields(maske),maxfeldnr);ROW maxfeldnrTEXT VAR 
+maskenfeld;INT VAR einstieg:=maxfeldnr;FOR feldindFROM 1UPTO maxfeldREP IF 
+fieldexists(maske,feldind)THEN maskenfeld(feldind):="";put(maske,"",feldind);
+cursor(maske,feldind);out(text(feldind));IF (NOT protected(maske,feldind))
+CAND (feldind<einstieg)THEN einstieg:=feldindFI ;FI PER ;IF einstieg>maxfeld
+THEN einstieg:=standardanfangFI ;get(maske,maskenfeld,einstieg)END PROC 
+zeigegeneriertemaske;ROW maxfeldnrTEXT VAR feld;INT VAR maxfeld;PROC 
+maskenattributesetzen:maskenholen;formularzeigen;attributezeigen;
+einlesenderattribute.maskenholen:initmaske(aktuellemaske,mgmatrix).
+formularzeigen:page;standardkopfmaskeausgeben(text(vergleichsknoten));show(
+aktuellemaske).attributezeigen:INT VAR i;INT VAR maxfields:=fields(
+aktuellemaske);feld(1):="";TEXT VAR hellername:=""+maskenname+" ";feld(2):=
+hellername+(length(aktuellemaske,2)-length(hellername))*" ";INT VAR zaehler:=
+3;FOR iFROM 2UPTO min(fields(maske),maxfeldnr-1)REP IF (fieldexists(maske,i))
+THEN IF feld(zaehler)=""THEN feld(zaehler):=text(i,3)+text(auskunftsnr(maske,
+i),5)+text(symbolicname(maske,i),3)FI ;zaehlerINCR 1FI PER ;FOR iFROM 1UPTO 
+zaehler-1REP IF fieldexists(aktuellemaske,i)THEN put(aktuellemaske,feld(i),i)
+FI PER ;FOR iFROM zaehlerUPTO maxfieldsREP protect(aktuellemaske,i,TRUE )PER 
+;maxfeld:=zaehler-1;aktuelleposition:=3.END PROC maskenattributesetzen;PROC 
+einlesenderattribute:get(aktuellemaske,feld,aktuelleposition)END PROC 
+einlesenderattribute;PROC maskenattributespeichern:INT VAR i;IF NOT 
+maskengeneratorTHEN gibtestag;IF NOT daTHEN meldezuerstformular;LEAVE 
+maskenattributespeichernFI ;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""PER ;FI ;
+maskenattributesetzen;FOR iFROM 3UPTO maxfeldREP INT VAR feldnr:=int(subtext(
+feld(i),1,3));auskunftsnr(maske,feldnr,int(subtext(feld(i),4,8)));
+symbolicname(maske,feldnr,int(subtext(feld(i),9,11)))PER .maskengenerator:
+eingangsname=mg.meldezuerstformular:standardmeldung(32,"");return(1).END 
+PROC maskenattributespeichern;PROC formularspeichern(INT CONST zurueck):
+schreibemaske(maske,maskenname);logbucheintrag(logtextergaenzung);IF exists(
+formulardatei)THEN forget(formulardatei,quiet)FI ;return(zurueck);
+frageentwicklernachmaskennamen(eingangsname);meldespeicherung.
+meldespeicherung:standardmeldung(27,"").END PROC formularspeichern;PROC 
+felderentwerfen:gibtestag;IF daTHEN initialisiereELSE meldezuerstformularFI .
+initialisiere:feldname:=standardanfang;maskenformularzeigen;
+definitionsnamenlesen.meldezuerstformular:standardmeldung(32,"");return(1).
+END PROC felderentwerfen;PROC gibtestag:initmaske(maske,maskenname);da:=
+maskegibtes(maskenname)END PROC gibtestag;PROC felddefinitionenspeichern:
+schreibemaske(maske,maskenname);return(2);frageentwicklernachmaskennamen(id);
+meldespeicherung;.meldespeicherung:standardmeldung(28,"").END PROC 
+felddefinitionenspeichern;PROC maskenformularzeigen:
+maskezuderfelderstelltwerdensollzeigen;entwicklernachfeldnamenfragen.
+maskezuderfelderstelltwerdensollzeigen:page;show(maske).END PROC 
+maskenformularzeigen;PROC entwicklernachfeldnamenfragen:aktuelleposition:=
+standardanfang;initmaske(aktuellemaske,nummernmaske);show(aktuellemaske).END 
+PROC entwicklernachfeldnamenfragen;PROC definitionsnamenlesen:TEXT VAR f:=
+text(feldname);ROW maxfeldnrTEXT VAR feld;init(feld);feld(2):=f;loeschfeld:=
+feldname;putget(aktuellemaske,feld,aktuelleposition);feldname:=int(feld(
+aktuelleposition));loeschemeldung(aktuellemaske);END PROC 
+definitionsnamenlesen;PROC gesuchtesfeldanzeigen:IF NOT fieldexists(maske,
+feldname)THEN meldefalschenummer;loeschenELSE TEXT CONST pointer:=(length(
+maske,feldname))*"?";loeschen;put(maske,pointer,feldname);meldegesuchtesfeld
+FI ;return(1).meldegesuchtesfeld:melde(aktuellemaske,10).loeschen:put(maske,
+"",loeschfeld).END PROC gesuchtesfeldanzeigen;PROC meldefalschenummer:melde(
+aktuellemaske,9).END PROC meldefalschenummer;LET null="�";TEXT VAR xrow,yrow,
+lrow,trow;BOOL VAR a,b,c,d,e;INT VAR sym,aus;TEXT VAR geheimzeichen;PROC 
+feldloeschen:INT VAR x,y;IF fieldexists(maske,feldname)THEN clearfield(maske,
+feldname);put(maske,"",loeschfeld);getcursor(x,y);cursor(1,y);out(formline(
+maske,y));melde(aktuellemaske,42)ELSE meldefalschenummerFI ;return(1)END 
+PROC feldloeschen;PROC feldmalen:xrow:="";yrow:=" ";lrow:="";trow:="";IF 
+menuedraussenTHEN reorganizescreenFI ;designfield(maske,feldname,xrow,yrow,
+lrow,trow)END PROC feldmalen;PROC feldaufneuenschirmmalen:reorganizescreen;
+designfield(maske,feldname,xrow,yrow,lrow,trow)END PROC 
+feldaufneuenschirmmalen;PROC feldattributesetzen:INT VAR gz;fieldinfos(maske,
+feldname,gz,a,b,c,d,e);geheimzeichen:=code(gz);baisymaskeholen;sym:=
+symbolicname(maske,feldname);aus:=auskunftsnr(maske,feldname);show(
+aktuellemaske);holeattribute;END PROC feldattributesetzen;PROC 
+baisymaskeholen:initmaske(aktuellemaske,b1)END PROC baisymaskeholen;PROC 
+holeattribute:ROW maxfeldnrTEXT VAR feld;init(feld);IF bTHEN feld(2):="X"FI ;
+IF cTHEN feld(3):=geheimzeichenFI ;feld(4):=text(sym);putget(aktuellemaske,
+feld,aktuelleposition);b:=feld(2)<>"";c:=feld(3)<>"";geheimzeichen:=feld(3);
+sym:=int(feld(4))END PROC holeattribute;PROC feldspeichern:definefield(maske,
+xrow,yrow,lrow,trow,sym,aus,feldname,geheimzeichen,null);setfieldinfos(maske,
+feldname,a,b,c);maskenformularzeigen;meldevorlaeufiguebernommen;return(3).
+meldevorlaeufiguebernommen:melde(aktuellemaske,41).END PROC feldspeichern;
+PROC feldnichtspeichern(INT CONST schritte):maskenformularzeigen;return(
+schritte)END PROC feldnichtspeichern;PROC listeallermasken:
+meldezusammenstellung;listen.listen:listezusammenstellen;zeigendermaskenliste
+.meldezusammenstellung:store(FALSE );standardmeldung(7,"");store(TRUE ).
+listezusammenstellen:maskenliste(z).END PROC listeallermasken;PROC 
+zeigendermaskenliste:page;editiere(z)END PROC zeigendermaskenliste;PROC 
+loescheneinermaske:IF maskenname=""THEN keineeingabe;return(1)ELSE IF 
+maskegibtes(maskenname)THEN loeschemaske(maskenname);logbucheintrag(
+"gelöscht");meldeloeschungELSE maskegibtesnichtFI ;return(1)FI .
+maskegibtesnicht:standardmeldung(8,"").meldeloeschung:standardmeldung(33,"").
+keineeingabe:standardmeldung(26,"").END PROC loescheneinermaske;PROC 
+kopierenaendern:maskekopierenoderaendern;IF NOT daTHEN maskegibtesnichtFI .
+maskegibtesnicht:standardmeldung(8,"");return(1).END PROC kopierenaendern;
+PROC maskekopierenoderaendern:IF NOT maskegibtes(maskenname)THEN da:=FALSE 
+ELSE da:=TRUE ;frageentwicklernachmaske;zweitennamenlesenFI .
+frageentwicklernachmaske:aktuelleposition:=standardanfang;initmaske(
+aktuellemaske,zusatz);zweitername:="";show(aktuellemaske).END PROC 
+maskekopierenoderaendern;PROC zweitennamenlesen:ROW maxfeldnrTEXT VAR feld;
+init(feld);feld(2):=zweitername;putget(aktuellemaske,feld,aktuelleposition);
+zweitername:=feld(2);loeschemeldung(aktuellemaske).END PROC zweitennamenlesen
+;PROC kopiereneinermaske:IF maskegibtes(zweitername)THEN da:=TRUE ;return(1)
+ELSE maskekopieren(maskenname,zweitername);da:=FALSE FI ;IF daTHEN gibtsschon
+ELSE return(2);frageentwicklernachmaskennamen(id);meldekopierungFI .
+gibtsschon:melde(aktuellemaske,31).meldekopierung:melde(aktuellemaske,29).
+END PROC kopiereneinermaske;PROC neuernamefuereinemaske:IF maskegibtes(
+zweitername)THEN da:=TRUE ;return(1)ELSE maskeumbenennen(maskenname,
+zweitername);da:=FALSE ;FI ;IF daTHEN gibtsschonELSE return(2);
+frageentwicklernachmaskennamen(id);meldeumbenennungFI .gibtsschon:melde(
+aktuellemaske,31).meldeumbenennung:melde(aktuellemaske,30).END PROC 
+neuernamefuereinemaske;PROC druckeneinermaske:BOOL VAR maskeda;TAG VAR t;IF 
+maskenname=""THEN keineeingabe;return(1)ELSE maskeda:=maskegibtes(t,
+maskenname);IF maskedaTHEN meldedrucken;fuehredurchELSE maskegibtesnichtFI ;
+return(1)FI .maskegibtesnicht:standardmeldung(8,"").keineeingabe:
+standardmeldung(26,"").meldedrucken:standardmeldung(dru,"").fuehredurch:
+kopfindatei;formularindatei;feldinformationenindatei;drucken.kopfindatei:LET 
+temp="temporäre Druckdatei";FILE VAR f:=sequentialfile(output,temp);putline(f
+,"Name der Maske: "+maskenname);putline(f,"Stand:          "+date+"  "+
+timeofday);line(f,2).drucken:print(temp);forget(temp,quiet).formularindatei:
+INT VAR fz:=min(fields(t),maxfeldnr);IF fz>0THEN INT VAR i;FOR iFROM 1UPTO fz
+REP IF fieldexists(t,i)THEN fill(t,text(i),i)FI PER FI ;tTO f.
+feldinformationenindatei:line(f,2);IF fz>0THEN ueberschrift;FOR iFROM 1UPTO 
+fzREP IF fieldexists(t,i)THEN tabellenzeileFI PER FI .ueberschrift:putline(f,
+"Nr...Länge...geschützt....geheim.....Symbol.....Auskunftsnr....").
+tabellenzeile:INT VAR gz;BOOL VAR a,b,c,d,e;fieldinfos(t,i,gz,a,b,c,d,e);
+TEXT VAR geheim:=code(gz);INT VAR sym:=0,aus:=0;sym:=symbolicname(t,i);aus:=
+auskunftsnr(t,i);put(f,text(text(i),4));put(f,text(text(length(t,i)),7));IF b
+THEN put(f,text("X",13))ELSE put(f,13*" ")FI ;IF cTHEN put(f,text(geheim,11))
+ELSE put(f,11*" ")FI ;IF sym<>0THEN put(f,text(text(sym),10))ELSE put(f,10*
+" ")FI ;IF aus<>0THEN put(f,text(aus))FI ;line(f,1).END PROC 
+druckeneinermaske;PROC schreibemaske(TAG VAR ta,TEXT CONST t):setzemaske(ta);
+maskespeichern(t)END PROC schreibemaske;PROC loeschemaske(TEXT CONST t):
+maskeloeschen(t)END PROC loeschemaske;BOOL PROC maskegibtes(TAG VAR t,TEXT 
+CONST name):initmaske(t,name);maskegibtes(name)END PROC maskegibtes;PROC 
+erzeugeleeresymbolischemaske(TEXT CONST maskenname):oeffneausgabedatei;
+schreibemarkierungenindatei.oeffneausgabedatei:TEXT CONST dateiname:=praefixs
++maskenname;forget(dateiname,quiet);FILE VAR f:=sequentialfile(output,
+dateiname).schreibemarkierungenindatei:dreileerzeilen;grundlinie;
+vieleleerzeilen;endlinie.dreileerzeilen:INT VAR i;FOR iFROM 1UPTO 3REP 
+putline(f,"")PER .grundlinie:putline(f,78*unterlegungmeldung).vieleleerzeilen
+:FOR iFROM 1UPTO 18REP putline(f,"")PER .endlinie:putline(f,3*
+unterlegungmeldung+72*symbmeldung+3*unterlegungmeldung).END PROC 
+erzeugeleeresymbolischemaske;PROC erzeugesymbolischemaske(TEXT CONST 
+maskenname):holeformular;oeffneausgabedatei;setzesymbole;
+zeigesymbolischemaske.holeformular:INT VAR i;INT CONST maxmaskenfeld:=
+maxfeldnr-1;initmaske(maske,maskenname);FOR iFROM 2UPTO maxmaskenfeldREP IF 
+fieldexists(maske,i)THEN feld(i+1):=text(i,3)+text(auskunftsnr(maske,i),5)+
+text(symbolicname(maske,i),3)ELSE feld(i+1):=""FI PER .oeffneausgabedatei:
+TEXT CONST dateiname:=praefixs+maskenname;forget(dateiname,quiet);FILE VAR f
+:=sequentialfile(output,dateiname).zeigesymbolischemaske:maskeTO f.
+setzesymbole:erstesfeld;REP symbolisierefeld;naechstesfeldUNTIL letztesfeld
+PER ;abschluss.erstesfeld:INT VAR aktfeld:=firstfield(maske),zeilennr:=1;INT 
+VAR altesfeld:=aktfeld;INT VAR zeilenpointer:=1.naechstesfeld:altesfeld:=
+aktfeld;aktfeld:=nextfield(maske,aktfeld).letztesfeld:aktfeld<0.
+symbolisierefeld:setzezeile;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;
+holeinformationenueberdasfeld;fuelledasfeldmitdensymbolen.
+fuelledasfeldmitdensymbolen:TEXT VAR alteszeichen;IF aktfeld=1THEN fill(maske
+,length(maske,1)*symbmeldung,aktfeld);alteszeichen:=symbmeldungELSE IF 
+geschuetztTHEN fill(maske,laenge*symbalphag,aktfeld);alteszeichen:=symbalphag
+ELSE IF geheimTHEN IF laenge=1THEN IF code(gz)=anzeigeankreuzTHEN fill(maske,
+symbankreuz,aktfeld);alteszeichen:=symbankreuzELSE fill(maske,symbgeheim,
+aktfeld);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbgeheim,aktfeld
+);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbalphau,aktfeld);
+alteszeichen:=symbalphauFI FI FI .holeinformationenueberdasfeld:INT VAR gz,x,
+y,laenge:=length(maske,aktfeld);BOOL VAR a,geschuetzt,geheim,d,e;fieldinfos(
+maske,aktfeld,gz,a,geschuetzt,geheim,d,e);.setzezeile:woliegtdasfeld;
+allevorhergehendenzeilen.woliegtdasfeld:cursor(maske,aktfeld);getcursor(x,y).
+allevorhergehendenzeilen:IF y>zeilennrTHEN INT VAR xalt:=x;x:=length(formline
+(maske,zeilennr))+1;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;x:=xalt;
+zeilenpointer:=1;zeileaktualisierenFI .zeileaktualisieren:zeilennr:=y;.
+abschluss:y:=ysize(maske)+1;allevorhergehendenzeilen.schoneinfeldinderzeile:
+zeilenpointer<>1.pruefeobfortsetzung:BOOL VAR fortsetzung:=
+schoneinfeldinderzeileCAND (pos(subtext(formline(maske,zeilennr),
+zeilenpointer,x-1),alteszeichen,laenge+1)>0).uebernehmenbiszudiesemfeld:IF 
+fortsetzungTHEN fill(maske,symbfortsetzunga+((length(maske,altesfeld)-2)*
+alteszeichen)+symbfortsetzunge,altesfeld)FI ;zeilenpointer:=x.END PROC 
+erzeugesymbolischemaske;PROC feldanfang(INT VAR fa,TEXT CONST zeile):INT 
+CONST zeilenlaenge:=length(zeile);WHILE NOT issymbol(subtext(zeile,fa,fa))
+REP faINCR 1UNTIL NOT inzeilePER .inzeile:NOT (fa>zeilenlaenge).END PROC 
+feldanfang;BOOL PROC issymbol(TEXT CONST s):TEXT VAR symb:=s;symbol(symb);
+symb<>""END PROC issymbol;PROC symbol(TEXT VAR s):IF NOT ((s=symbalphag)OR (s
+=symbalphau)OR (s=symbankreuz)OR (s=symbgeheim)OR (s=symbmeldung)OR (s=
+symbfortsetzunga)OR (s=symbfortsetzunge))THEN s:=""FI END PROC symbol;PROC 
+felddefinition(INT VAR fa,TEXT VAR zeile,INT VAR feldnr,INT CONST znr):IF 
+feldmitteilfeldernTHEN teilfelderELSE einfachesfeldFI ;setzefeld.
+feldmitteilfeldern:subtext(zeile,fa,fa)=symbfortsetzunga.teilfelder:
+geschuetzt:=FALSE ;geheim:=FALSE ;xkoord:="";ykoord:="";laengen:="";
+geheimzeichen:=code(0);TEXT VAR gesamtunterlegung:=unterlegungalpha;BOOL VAR 
+gesamtgeschuetzt:=TRUE ,gesamtgeheim:=FALSE ;teilfeldbearbeitung;unterlegung
+:=gesamtunterlegung;geschuetzt:=gesamtgeschuetzt;geheim:=gesamtgeheim.
+teilfeldbearbeitung:REP efeld(zeile,fa,unterlegung,xkoord,ykoord,laengen,
+geschuetzt,geheim,geheimzeichen,znr);IF (unterlegung=symbfortsetzunge)COR (
+unterlegung="")THEN LEAVE teilfeldbearbeitungELIF unterlegung<>""THEN 
+gesamtunterlegung:=unterlegung;gesamtgeschuetzt:=geschuetzt;gesamtgeheim:=
+geheimFI ;faINCR 1;feldanfang(fa,zeile);PER .einfachesfeld:TEXT VAR 
+unterlegung;BOOL VAR geschuetzt:=FALSE ,geheim:=FALSE ;TEXT VAR xkoord:="",
+ykoord:="",laengen:="",geheimzeichen:=code(0);efeld(zeile,fa,unterlegung,
+xkoord,ykoord,laengen,geschuetzt,geheim,geheimzeichen,znr);.setzefeld:INT 
+VAR fnr;IF meldungsfeldTHEN fnr:=1;geschuetzt:=TRUE ELSE fnr:=feldnr;feldnr
+INCR 1FI ;definefield(maske,xkoord,ykoord,laengen,code(0),0,0,fnr,
+geheimzeichen,code(0));setfieldinfos(maske,fnr,FALSE ,geschuetzt,geheim);
+ersetzedurchunterlegung(zeile,xkoord,laengen,unterlegung).meldungsfeld:
+subtext(zeile,fa,fa)=symbmeldung.END PROC felddefinition;PROC 
+ersetzedurchunterlegung(TEXT VAR zeile,TEXT CONST xkoord,laengen,unterlegung)
+:INT VAR eintragszahl:=length(xkoord),ind;FOR indFROM 1UPTO eintragszahlREP 
+ersetzungPER .ersetzung:INT VAR fstart,flaenge;fstart:=code(subtext(xkoord,
+ind,ind));flaenge:=code(subtext(laengen,ind,ind));replace(zeile,fstart,
+flaenge*unterlegung);.END PROC ersetzedurchunterlegung;PROC efeld(TEXT CONST 
+zeile,INT VAR fa,TEXT VAR unterlegung,xkoord,ykoord,laengen,BOOL VAR 
+geschuetzt,geheim,TEXT VAR geheimzeichen,INT CONST znr):INT VAR poszeile:=fa;
+IF issymbol(subtext(zeile,poszeile,poszeile))THEN WHILE issymbol(subtext(
+zeile,poszeile+1,poszeile+1))REP poszeileINCR 1PER ;xkoordCAT code(fa);ykoord
+CAT code(znr);laengenCAT code(poszeile-fa+1);fa:=poszeile;FI ;TEXT CONST s:=
+subtext(zeile,fa,fa);IF s=symbalphagTHEN geschuetzt:=TRUE ;unterlegung:=
+unterlegungalphaELIF s=symbalphauTHEN geschuetzt:=FALSE ;unterlegung:=
+unterlegungalphaELIF s=symbankreuzTHEN geheim:=TRUE ;unterlegung:=
+unterlegungankreuz;geheimzeichen:=anzeigeankreuzELIF s=symbgeheimTHEN geheim
+:=TRUE ;unterlegung:=unterlegunggeheim;geheimzeichen:=anzeigegeheimELIF s=
+symbmeldungTHEN unterlegung:=unterlegungmeldungELIF s=symbfortsetzungeTHEN 
+unterlegung:=symbfortsetzungeELSE unterlegung:=""FI END PROC efeld;PROC 
+erzeugemaske(TEXT CONST maskenname):oeffnedatei;
+generieremaskeausformulardatei;uebertrageformular;.oeffnedatei:forget(
+formulardatei,quiet);copy(symbolischemaske,formulardatei);FILE VAR datei:=
+sequentialfile(modify,formulardatei).uebertrageformular:input(datei);dateiTO 
+maske;forget(formulardatei,quiet).generieremaskeausformulardatei:
+holeerstezeile;REP generierefelderdieserzeile;schreibeformularzeile;
+holenaechstezeileUNTIL dateiendePER .holeerstezeile:ananfang;lesezeile.
+holenaechstezeile:einsweiter;lesezeile.dateiende:eof(datei).einsweiter:down(
+datei,1).ananfang:nil(maske);TEXT VAR zeile:="";toline(datei,1);INT VAR 
+feldnr:=2.lesezeile:readrecord(datei,zeile).schreibeformularzeile:writerecord
+(datei,zeile).generierefelderdieserzeile:startezeile;REP 
+findefeldspezifikation;definierenaechstesfeldPER .startezeile:INT VAR fa:=1.
+findefeldspezifikation:feldanfang(fa,zeile);IF fa>length(zeile)THEN LEAVE 
+generierefelderdieserzeileFI ;.definierenaechstesfeld:felddefinition(fa,zeile
+,feldnr,lineno(datei));faINCR 1.END PROC erzeugemaske;TEXT PROC infozeile(
+TEXT CONST t,s):auskunftstextende+t+" = "+sEND PROC infozeile;PROC init(ROW 
+maxfeldnrTEXT VAR feld):INT VAR i;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""
+PER END PROC init;PROC logbucheintrag(TEXT CONST logergaenzung):TEXT VAR 
+eintrag:="Maske ";eintragCAT maskenname;eintragCAT " ";eintragCAT 
+logergaenzung;logeintrag(eintrag)END PROC logbucheintrag;END PACKET 
+maskendesign
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen
new file mode 100644
index 0000000..1e65ec3
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen
@@ -0,0 +1,64 @@
+PACKET ispmeldungsfunktionenDEFINES melde,meldeauffaellig,loeschemeldung,
+meldungstext,initmeldungsfunktionen:LET maxmeldungen=500,
+namedesmeldungsdatenraums="Meldungsdatenraum";BOUND ROW maxmeldungenTEXT VAR 
+dsmeldung;INT VAR geliefert;LET anzahl=25;LET zeinfuegen="#",znormeinfuegen=
+"+",zhelleinfuegen="#",normausgabe=1,hellausgabe=2;BOOL VAR meldungdraussen:=
+FALSE ;PROC initmeldungsfunktionen:TASK VAR savetask;LET savetaskname=
+"anwendung";savetask:=task(savetaskname);IF NOT meldungsdatenraumdaTHEN IF 
+exists(namedesmeldungsdatenraums,savetask)THEN fetch(
+namedesmeldungsdatenraums,savetask)ELSE meldungenindatenraumschreiben;save(
+namedesmeldungsdatenraums,savetask)FI ;FI ;dsmeldung:=old(
+namedesmeldungsdatenraums).meldungsdatenraumda:exists(
+namedesmeldungsdatenraums).END PROC initmeldungsfunktionen;PROC melde(TAG 
+CONST t,INT CONST i):meldung(t,i,"",TRUE ,"",TRUE ,FALSE )END PROC melde;
+PROC melde(TAG CONST t,INT CONST i,TEXT CONST meldvar):meldung(t,i,"",TRUE ,
+meldvar,TRUE ,FALSE )END PROC melde;PROC meldeauffaellig(TAG CONST t,INT 
+CONST i):meldung(t,i,"",TRUE ,"",TRUE ,TRUE )END PROC meldeauffaellig;PROC 
+melde(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"",TRUE ,FALSE )
+END PROC melde;PROC melde(TAG CONST t,TEXT CONST mtext,TEXT CONST meldvar):
+meldung(t,0,mtext,FALSE ,meldvar,TRUE ,FALSE )END PROC melde;PROC 
+meldeauffaellig(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"",
+TRUE ,TRUE )END PROC meldeauffaellig;PROC meldung(TAG CONST t,INT CONST mnr,
+TEXT CONST mt,BOOL CONST was,TEXT CONST mvartext,BOOL CONST zentriert,BOOL 
+CONST hell):IF fieldexists(t,1)THEN TEXT VAR me;IF wasTHEN me:=meldungstext(
+mnr)ELSE me:=mtFI ;IF variablemeldungTHEN vartexteinfuegenFI ;IF hellTHEN 
+erhellen(t,me)FI ;IF zentriertTHEN centerFI ;put(t,me,1);meldungdraussen:=
+TRUE FI .center:INT CONST lmax:=length(t,1);INT CONST lmeld:=length(me);INT 
+CONST dif:=lmax-lmeld;IF lmeld>=lmaxTHEN LEAVE centerFI ;INT CONST bz:=dif
+DIV 2;me:=bz*" "+me+(dif-bz)*" ".variablemeldung:INT VAR einfuegepos:=pos(me,
+zeinfuegen);einfuegepos<>0.vartexteinfuegen:TEXT VAR ersatztext;INT VAR 
+textattr,aktpos:=1,posnorm,poshell;WHILE einfuegepos<>0REP 
+holeersatztextundattributausersatzzeile;ersetzeeinfuegezeichendurchersatztext
+;einfuegepos:=pos(me,zeinfuegen)PER .holeersatztextundattributausersatzzeile:
+posnorm:=pos(mvartext,znormeinfuegen,aktpos);poshell:=pos(mvartext,
+zhelleinfuegen,aktpos);IF posnorm=0THEN helloderendeELSE normoderhellFI .
+helloderende:IF poshell=0THEN ersatztext:="";textattr:=normausgabeELSE 
+holeteiltext(ersatztext,mvartext,aktpos,poshell);textattr:=hellausgabeFI .
+normoderhell:IF poshell=0THEN holeteiltext(ersatztext,mvartext,aktpos,posnorm
+);textattr:=normausgabeELIF normzuerstTHEN holeteiltext(ersatztext,mvartext,
+aktpos,posnorm);textattr:=normausgabeELSE holeteiltext(ersatztext,mvartext,
+aktpos,poshell);textattr:=hellausgabeFI .normzuerst:posnorm<poshell.
+ersetzeeinfuegezeichendurchersatztext:SELECT textattrOF CASE 1:change(me,
+zeinfuegen,ersatztext)CASE 2:erhellen(t,ersatztext);change(me,zeinfuegen,
+ersatztext)ENDSELECT .END PROC meldung;PROC holeteiltext(TEXT VAR akttext,
+TEXT CONST ersatzzeile,INT VAR abarbeitpos,INT CONST textendepos):akttext:=
+subtext(ersatzzeile,abarbeitpos,textendepos-1);abarbeitpos:=textendepos+1;
+END PROC holeteiltext;PROC loeschemeldung(TAG CONST t):IF meldungdraussen
+THEN put(t,"",1);meldungdraussen:=FALSE FI ;END PROC loeschemeldung;PROC 
+erhellen(TAG CONST t,TEXT VAR helltext):TEXT VAR ht:=helltext;helltext:=""+
+subtext(ht,1,meldfeldlaenge-4)+" ".meldfeldlaenge:length(t,1).END PROC 
+erhellen;TEXT PROC meldungstext(INT CONST meldnummer):IF meldnummer<0OR 
+meldnummer>maxmeldungenTHEN ""ELSE dsmeldung(meldnummer)FI END PROC 
+meldungstext;PROC meldungstext(INT CONST meldnr,TEXT VAR meldetext):meldetext
+:=meldungstext(meldnr)END PROC meldungstext;PROC 
+meldungenindatenraumschreiben:INT VAR iinit;forget(namedesmeldungsdatenraums,
+quiet);dsmeldung:=new(namedesmeldungsdatenraums);FOR iinitFROM 1UPTO 
+maxmeldungenREP dsmeldung(iinit):=""PER ;systemdbon;lieserstemeldung;
+dsmeldung(meldungsnr):=mtext;geliefert:=anzahl;WHILE 
+meldungindatenraumaufzunehmenAND geliefert=anzahlREP geliefert:=anzahl;
+multisucc(dnrmeld,geliefert);FOR iinitFROM 1UPTO geliefertREP stackentry(
+iinit);dsmeldung(meldungsnr):=mtext;PER ;PER ;systemdboff.meldungsnr:intwert(
+fnrmeldungsname).mtext:wert(fnrmeldungstext).lieserstemeldung:first(dnrmeld).
+meldungindatenraumaufzunehmen:dbstatus=ok.END PROC 
+meldungenindatenraumschreiben;END PACKET ispmeldungsfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask
new file mode 100644
index 0000000..2d4a7be
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask
@@ -0,0 +1,126 @@
+PACKET ispmonitorsicherungstaskDEFINES ispmonitorsicherungstask,sndbaisyfiles
+,rcvbaisyfiles,sndidafiles,rcvidafiles,ida,statistik,:LET initcode=25,
+listcode=26,checkcode=27,formatcode=40,logonarchivecode=45,logoffarchivecode=
+46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50,dddrucken=51,ack=0
+,errornak=2,nak=1,continuecode=100,endcode=37,savedbcode=38,restoredbcode=39,
+maxthesaurusentry=252;LET showcode=12,mlddbnichtda=
+"Keine vollständige DB bei Sicherungstask!",formfilename=
+"Namen der Formulare",statistikserver="statistik server",#25.09.90#
+statistikbasis="STATISTIK.basis";BOOL VAR idasicherung:=FALSE ,
+statistiksicherung:=FALSE ;#25.09.90#FILE VAR formfile;TEXT VAR nameoftask:=
+"",formname:="";LET stundenplanserver="stundenplan server";LET 
+stundenplanpraefix="Stundenplan-*";TASK VAR stundenplanservertask;LET 
+kurswahlserver="kurswahl server";LET kurswahlpraefix="Kurswahl-*";TASK VAR 
+kurswahlservertask;BOUND TEXT VAR message;DATASPACE VAR ds;INT VAR replycode;
+PROC ispmonitorsicherungstask(TEXT CONST sicherungstask):nameoftask:=
+sicherungstask;globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,TASK 
+CONST )ispmonitor)ENDPROC ispmonitorsicherungstask;PROC ispmonitor(DATASPACE 
+VAR dsp,INT CONST orderp,phasep,TASK CONST ordertaskp):INT VAR replycode;
+TASK VAR begintask;IF orderp>=continuecodeAND ordertaskp=supervisorTHEN 
+forget(dsp);spoolcommand(orderp)ELSE enablestop;ordertask(ordertaskp);SELECT 
+orderpOF CASE initcode:cleararchive;CASE listcode:listarchive;CASE 
+dbvomserver:forget(ALL myself-schulisdbname#17.10.88#-baisydbname);IF ida
+THEN rcvidafiles#25.09.90#ELIF statistikTHEN rcvstatfilesELSE fetchdb(
+nameoftask);IF baisyTHEN rcvbaisyfilesELSE receivestundenplan;
+receivekurswahldatenFI ;FI CASE dbzumserver:IF idaTHEN sndidafiles#25.09.90#
+ELIF statistikTHEN sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN 
+sndbaisyfilesELSE sendstundenplan;sendkurswahldatenFI FI CASE dbaufdisk:IF 
+ida#25.09.90#THEN savetoarchive(all-schulisdbname)ELIF NOT statistikCAND 
+dbnichtkomplettTHEN errorstop(mlddbnichtda)ELSE savetoarchive(all)FI CASE 
+dbvondisk:forget(ALL myself-schulisdbname#17.10.88#-baisydbname);
+fetchfromarchive;IF idaTHEN sndidafiles#25.09.90#ELIF statistikTHEN 
+sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN sndbaisyfilesELSE 
+sendstundenplan;sendkurswahldatenFI ;FI CASE formatcode:formatarchive(
+nameoftask)CASE checkcode:checkarchiveCASE logonarchivecode:logonarchiveCASE 
+logoffarchivecode:logoffarchiveCASE dddrucken:datadirdruckenOTHERWISE :
+errorstop("Falscher Auftrag!")ENDSELECT ;endemeldungFI .dbnichtkomplett:IF 
+NOT exists(nameoftask)COR (nameoftask="EUMELbase.baisy"CAND (NOT exists(
+"BAISY-0")COR NOT exists("BAISY-1")COR NOT exists("BAISY-2")COR NOT exists(
+"BAISY-3")))THEN TRUE ELSE FALSE FI .endemeldung:send(ordertaskp,ack,dsp).
+datadirdrucken:servereinrichten;out("Datenbankverzeichnis wird erstellt!");
+serverwecken.servereinrichten:begin("-",PROC servermonitor,begintask).
+serverwecken:call(begintask,dddrucken,dsp,replycode);IF replycode=errornak
+THEN message:=dsp;errorstop(message)ELSE send(ordertaskp,showcode,dsp)FI .
+ENDPROC ispmonitor;PROC servermonitor:TASK VAR fathertask;INT VAR ordercode;
+DATASPACE VAR ds;disablestop;wait(ds,ordercode,fathertask);postfix("");
+fetchdd(nameoftask);IF dbopen(nameoftask)THEN ddinfo("X")ELSE errorstop(
+"Drucken nicht möglich!")FI ;IF iserrorTHEN forget(ds);ds:=nilspace;message:=
+ds;message:=errormessage;ordercode:=errornakELSE forget(ds);ds:=old("X.dd")
+FI ;send(fathertask,ordercode,ds);end(myself)ENDPROC servermonitor;PROC 
+spoolcommand(INT CONST order):TEXT VAR commandline:="";enablestop;break(quiet
+);continue(order-continuecode);disablestop;REP #commanddialogue(TRUE );#
+getcommand(name(myself)+"-Monitor:",commandline);do(commandline)UNTIL NOT 
+onlinePER ;#commanddialogue(FALSE );#break(quiet);setautonomEND PROC 
+spoolcommand;ROW maxthesaurusentryDATASPACE VAR receiveddb;BOUND THESAURUS 
+VAR thesau;THESAURUS VAR dbthesaurus:=emptythesaurus;TASK VAR sourcetask:=
+niltask#,baisyserver:=/"baisy server"#;PROC rcvbaisyfiles:out(
+"BAISY-Files werden übertragen!");fetchfast(name(baisyserver));ENDPROC 
+rcvbaisyfiles;PROC sndbaisyfiles:THESAURUS VAR theo:=ALL myself,theodb:=
+emptythesaurus;LET baisyconst="BAISY-";TEXT VAR fname;INT VAR tindex:=0,l:=1;
+forget(ds);ds:=nilspace;thesau:=ds;thesau:=emptythesaurus;modifytheo;
+sendthesaurusandrcvok;senddb.modifytheo:get(theo,fname,tindex);WHILE tindex>0
+REP IF pos(fname,baisyconst)=1THEN insert(theodb,fname)FI ;get(theo,fname,
+tindex)PER ;thesau:=theodb.sendthesaurusandrcvok:REP call(baisyserver,
+restoredbcode,ds,replycode)UNTIL replycode=restoredbcodePER ;.senddb:tindex:=
+0;l:=1;get(theodb,fname,tindex);WHILE tindex>0REP sendfile;get(theodb,fname,
+tindex)PER ;sendend.sendfile:pause(10);forget(ds);ds:=old(fname);out(fname+
+" wird übertragen!");lINCR 1;send(baisyserver,restoredbcode,ds);.sendend:
+pause(10);ds:=nilspace;send(baisyserver,endcode,ds).ENDPROC sndbaisyfiles;
+PROC rcvidafiles:initformfile;first(dnrida);WHILE dbstatus=okREP IF 
+formexists(intwert(fnridanummer))THEN out("Formular "+wert(fnridanummer)+
+" gesichert!");getform(intwert(fnridanummer));formname:="";savetupel(dnrida,
+formname);putline(formfile,formname)FI ;succ(dnrida)PER .initformfile:forget(
+ALL myself-schulisdbname);formfile:=sequentialfile(output,formfilename).
+ENDPROC rcvidafiles;PROC sndidafiles:IF NOT exists(formfilename)THEN 
+errorstop("Druckausgaben nicht vollständig!")ELSE rueckspeichernFI .
+formdateienda:exists("FORMDATA."+wert(fnridanummer))CAND exists("FORMTEXT."+
+wert(fnridanummer)).rueckspeichern:formfile:=sequentialfile(input,
+formfilename);IF lines(formfile)>0THEN eigentlichesrueckspeichernFI .
+eigentlichesrueckspeichern:clearfile(dnrida);WHILE NOT eof(formfile)REP 
+getline(formfile,formname);restoretupel(dnrida,formname);IF formdateienda
+THEN openformular(intwert(fnridanummer));putform;out("Formular "+wert(
+fnridanummer)+" rückgesichert!");insert(dnrida)FI PER .ENDPROC sndidafiles;
+PROC rcvstatfiles:TASK CONST statserver:=task(statistikserver);THESAURUS VAR 
+stats:=ALL statserver;TEXT VAR name;INT VAR index:=0;sicheredatenbasis;get(
+stats,name,index);WHILE index>0REP out(name+" gesichert!");fetch(name,
+statserver);get(stats,name,index);PER ;pause(20).sicheredatenbasis:IF stats
+CONTAINS statistikbasisTHEN out("Statistik Datenbasis gesichert!");fetch(
+statistikbasis,statserver);stats:=stats-statistikbasis;FI .END PROC 
+rcvstatfiles;PROC sndstatfiles:THESAURUS CONST alle:=ALL myself;TASK CONST 
+statserver:=task(statistikserver);TEXT VAR name;INT VAR index:=0;IF 
+highestentry(alle)=0THEN errorstop("Keine Statistiken vorhanden!");ELSE 
+allesloeschen;rueckspeichern;pause(20);FI .allesloeschen:BOOL VAR 
+dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL statserver,
+statserver);commanddialogue(dialogschalter).rueckspeichern:get(alle,name,
+index);WHILE index>0REP IF name=statistikbasisTHEN out(
+"Statistik Datenbasis rückgesichert!");ELSE out(name+" rückgesichert!");FI ;
+save(name,statserver);get(alle,name,index);PER .END PROC sndstatfiles;PROC 
+receivestundenplan:disablestop;stundenplanservertask:=task(stundenplanserver)
+;IF iserrorTHEN clearerror;ELSE loeschestundenplandsintask;fetchall(
+stundenplanservertask);FI ;enablestop.loeschestundenplandsintask:BOOL VAR 
+dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE 
+stundenplanpraefix);commanddialogue(dialogschalter).END PROC 
+receivestundenplan;PROC sendstundenplan:disablestop;stundenplanservertask:=
+task(stundenplanserver);IF iserrorTHEN clearerror;ELSE 
+loeschestundenplandsinservertask;save(allLIKE stundenplanpraefix,
+stundenplanservertask);FI ;enablestop.loeschestundenplandsinservertask:BOOL 
+VAR dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL 
+stundenplanservertask,stundenplanservertask);commanddialogue(dialogschalter).
+END PROC sendstundenplan;PROC receivekurswahldaten:disablestop;
+kurswahlservertask:=task(kurswahlserver);IF iserrorTHEN clearerror;ELSE 
+loeschekurswahldsintask;fetch((ALL kurswahlservertask)LIKE kurswahlpraefix,
+kurswahlservertask);FI ;enablestop.loeschekurswahldsintask:BOOL VAR 
+dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE 
+kurswahlpraefix);commanddialogue(dialogschalter).END PROC 
+receivekurswahldaten;PROC sendkurswahldaten:disablestop;kurswahlservertask:=
+task(kurswahlserver);IF iserrorTHEN clearerror;ELSE 
+loeschekurswahldsinservertask;save(allLIKE kurswahlpraefix,kurswahlservertask
+);FI ;enablestop.loeschekurswahldsinservertask:BOOL VAR dialogschalter:=
+commanddialogue;commanddialogue(FALSE );erase(ALL kurswahlservertask,
+kurswahlservertask);commanddialogue(dialogschalter).END PROC 
+sendkurswahldaten;BOOL PROC baisy:nameoftask="EUMELbase.baisy"ENDPROC baisy;
+BOOL PROC ida:idasicherungENDPROC ida;PROC ida(BOOL CONST idas):idasicherung
+:=idasENDPROC ida;BOOL PROC statistik:statistiksicherungEND PROC statistik;
+PROC statistik(BOOL CONST stats):statistiksicherung:=statsEND PROC statistik;
+ENDPACKET ispmonitorsicherungstask
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.objektliste b/app/baisy/2.2.1-schulis/src/isp.objektliste
new file mode 100644
index 0000000..46262e1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.objektliste
@@ -0,0 +1,252 @@
+PACKET ispobjektlisteDEFINES objektlistestarten,objektlistenausgabe,
+listenobjektezeigen,datensatzlistenausgabe,datensatzlistezeigen,
+objektlistenmaskeeinlesen,objektlistebeenden,maxidentizeilenlaenge,
+setzeidentiwert,#savetupel,17.10.88##restoretupel,17.10.88#pruefungdummy,
+pruefungbenutzerbestand,satzlesen,einendatensatzlesen,bestandende,
+setzebestandende,plus,minus,eineseiteeinlesen,blaettern,initobli,
+inlisteblaettern,setzescanendewert,setzescanstartwert:TAG VAR aktuellemaske;
+TEXT VAR identiobjekt,sicherungstupel:="";TEXT VAR scanstartwert:="",
+scanendewert:="�";INT VAR posi,aktletztesfeld,dateinummer,aktindex;INT VAR 
+anzahltupel;LET erstesfeld=2,maxletztesfeld=36,markierung="x",keinemarkierung
+="",eingabefeldnr=2,felderprozeile=2,erfwerteinobli=5,schluesseltrenner="$";
+LET delimiter="�";LET andenanfang=1,ansende=2,vorwaerts=3,rueckwaerts=4;LET 
+meldungnichtblaettern=72;LET satzzahl=18;TEXT VAR scanwertsicherung,
+scantupelsicherung;INT VAR scanfeldsicherung,feldnummerstartwert;INT VAR 
+fenster,gelesen;INT VAR anzschluesselfelder:=1;LET zeilenlaenge=70;INT VAR 
+identizeilegesamtlaenge:=70;BOOL VAR ersterbildschirm,bestandsende;BOOL VAR 
+letzterbildschirm;BOOL VAR ersterdatensatz;BOOL VAR nureinedatenseiteROW 
+satzzahlBOOL VAR angekreuzt;ROW satzzahlTEXT VAR identitabelle;PROC 
+setzescanendewert(TEXT CONST endewert):scanendewert:=endewertENDPROC 
+setzescanendewert;PROC setzescanstartwert(TEXT CONST startwert):scanstartwert
+:=startwertENDPROC setzescanstartwert;PROC objektlistestarten(INT CONST 
+aktdateinummer,TEXT CONST startwert,BOOL CONST anwendung,BOOL VAR 
+listenendeerreicht):objektlistestarten(aktdateinummer,startwert,
+aktdateinummer+2,anwendung,listenendeerreicht)END PROC objektlistestarten;
+PROC objektlistestarten(INT CONST aktdateinummer,TEXT CONST startwert,INT 
+CONST fnrstartwert,BOOL CONST anwendung,BOOL VAR listenendeerreicht):LET 
+indextrenner=";";INT VAR erstertrenner:=0;TEXT VAR indextext:="";IF anwendung
+THEN systemdboffELSE systemdbonFI ;aktindex:=aktdateinummer;dateinummer:=
+dateinr(primdatid(aktindex));anzschluesselfelder:=anzkey(dateinummer);
+feldnummerstartwert:=fnrstartwert;IF scanueberdiedateinummerTHEN 
+scanfeldsicherung:=1;ELSE indextext:=zugriff(aktindex);erstertrenner:=pos(
+indextext,indextrenner);scanfeldsicherung:=int(subtext(indextext,1,
+erstertrenner-1));FI ;#IF scanueberdiedateinummerTHEN #IF 
+dateinummerzugelassenTHEN putwert(dateinummer+1,startwert)ELSE putwert(
+dateinummer+2,startwert);IF dateinummer=dnrbenutzTHEN putwert(
+fnrbenutzbestand,benutzerbestandSUB 1)FI ;FI ;#ELSE IF 
+uebereinenganzensekindexTHEN putwert(scanfeldsicherung,startwert)ELSE putwert
+(feldnummerstartwert,startwert)FI FI ;#scanwertsicherung:=wert(dateinummer+
+scanfeldsicherung);savescanwert;search(aktindex,FALSE );IF (
+scanueberdiedateinummerCOR uebereinenganzensekindex)CAND 
+dateinummerzugelassen#dr11.05.88#THEN listenendeerreicht:=dbstatus<>okELSE 
+listenendeerreicht:=dbstatus<>okCOR (dbstatus=okAND wert(dateinummer+
+scanfeldsicherung)<>scanwertsicherung)FI ;listenendenochnichterreicht(
+startwert,listenendeerreicht).dateinummerzugelassen:dateinummer<>
+dnrschluesselAND dateinummer<>dnrbenutz.END PROC objektlistestarten;PROC 
+listenendenochnichterreicht(TEXT CONST wert,BOOL CONST ende):IF NOT endeTHEN 
+ersterbildschirm:=(wert="");ersterdatensatz:=(wert="");letzterbildschirm:=
+FALSE ;bestandsende:=FALSE ;FI .END PROC listenendenochnichterreicht;PROC 
+objektlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,
+BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben;
+identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell
+,vorwaerts,FALSE ,scanja,BOOL PROC pruefungspeziell);
+objektlistenmaskeeinlesen.END PROC objektlistenausgabe;PROC 
+datensatzlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,
+BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben;
+identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell
+,vorwaerts,TRUE ,scanja,BOOL PROC pruefungspeziell);objektlistenmaskeeinlesen
+.ENDPROC datensatzlistenausgabe;PROC initobli:initobli(18)END PROC initobli;
+PROC initobli(INT CONST szahl):leererthesaurus;bestandsende:=FALSE ;fenster:=
+szahlEND PROC initobli;PROC listenmaskeholenundausgeben:LET listenmaskenname=
+"mu objektliste";initmaske(aktuellemaske,listenmaskenname);standardstartproc(
+listenmaskenname).END PROC listenmaskeholenundausgeben;PROC 
+listenobjektezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start):
+listenobjektezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL 
+PROC pruefungdummy)END PROC listenobjektezeigen;PROC listenobjektezeigen(
+PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL 
+PROC pruefungspeziell):IF aktindex=dnrschluesselTHEN inlisteblaettern(PROC 
+erfassungspeziell,start,TRUE ,scanja,BOOL PROC pruefungspeziell);ELSE 
+inlisteblaettern(PROC erfassungspeziell,start,FALSE ,scanja,BOOL PROC 
+pruefungspeziell);FI ;return(1).END PROC listenobjektezeigen;PROC 
+datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start):
+datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL 
+PROC pruefungdummy)END PROC datensatzlistezeigen;PROC datensatzlistezeigen(
+PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL 
+PROC pruefungspeziell):inlisteblaettern(PROC erfassungspeziell,start,TRUE ,
+scanja,BOOL PROC pruefungspeziell);return(1).END PROC datensatzlistezeigen;
+PROC inlisteblaettern(PROC (INT CONST )erfassungspeziell,INT CONST start,
+BOOL CONST anwendung,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF 
+anwendungTHEN systemdboffELSE systemdbonFI ;IF blaetternerforderlichTHEN posi
+:=eingabefeldnr;aktletztesfeld:=maxletztesfeld;blaettern(PROC 
+erfassungspeziell,start,scanja,BOOL PROC pruefungspeziell);IF (gelesen-1)<#
+satzzahl#fensterAND gelesen>0THEN leerzeilenFI ;ELSE 
+meldungdasnichtgeblaettertwirdFI ;IF NOT anwendungTHEN systemdboffFI ;posi:=
+eingabefeldnr.blaetternerforderlich:SELECT startOF CASE andenanfang:NOT 
+ersterbildschirmCASE ansende:NOT letzterbildschirmCASE vorwaerts:NOT 
+letzterbildschirmCASE rueckwaerts:NOT ersterbildschirmOTHERWISE FALSE END 
+SELECT .END PROC inlisteblaettern;PROC blaettern(PROC (INT CONST )
+erfassungspeziell,INT CONST start,BOOL CONST anwendung,BOOL CONST scanja,
+BOOL PROC pruefungspeziell):IF anwendungTHEN systemdboffELSE systemdbonFI ;
+IF blaetternerforderlichTHEN blaettern(PROC erfassungspeziell,start,scanja,
+BOOL PROC pruefungspeziell);ELSE standardmeldung(meldungnichtblaettern,"");
+FI ;IF NOT anwendungTHEN systemdboffFI ;.blaetternerforderlich:SELECT start
+OF CASE andenanfang:NOT ersterbildschirmCASE ansende:NOT letzterbildschirm
+CASE vorwaerts:NOT letzterbildschirmCASE rueckwaerts:NOT ersterbildschirm
+OTHERWISE FALSE END SELECT .END PROC blaettern;PROC zeigenschluessel:IF 
+identiobjekt=""THEN LEAVE zeigenschluesselFI ;INT VAR schluesselbeginn:=pos(
+identiobjekt,schluesseltrenner);identitabelle(posiDIV felderprozeile):=
+subtext(identiobjekt,schluesselbeginn);identiobjekt:=subtext(identiobjekt,1,
+schluesselbeginn-1);IF objektmarkiert(identitabelle(posiDIV felderprozeile))
+THEN markierungIN posi;angekreuzt(posiDIV felderprozeile):=TRUE ELSE 
+keinemarkierungIN posi;angekreuzt(posiDIV felderprozeile):=FALSE FI ;feldfrei
+(posi);identiobjektIN (posi+1);posiINCR felderprozeile.END PROC 
+zeigenschluessel;INT PROC maxidentizeilenlaenge:identizeilegesamtlaengeEND 
+PROC maxidentizeilenlaenge;PROC setzeidentiwert(TEXT CONST identizeile):
+identiobjekt:=identizeileEND PROC setzeidentiwert;PROC leerzeilen:
+aktletztesfeld:=posi-felderprozeile;WHILE posi<=maxletztesfeldREP 
+leerzeileausgeben;posiINCR felderprozeilePER .leerzeileausgeben:""IN posi;""
+IN (posi+1);feldschutz(posi).END PROC leerzeilen;BOOL PROC objektmarkiert(
+TEXT CONST suchtext):inthesaurus(suchtext).END PROC objektmarkiert;PROC 
+objektlistenmaskeeinlesen:infeld(eingabefeldnr);standardnproc;BOOL VAR 
+markneu,markalt;posi:=erstesfeld;WHILE posi<=aktletztesfeldREP markneu:=
+standardmaskenfeld(posi)<>"";markalt:=angekreuzt(posiDIV felderprozeile);IF 
+markierungsaenderungTHEN identiobjekt:=identitabelle(posiDIV felderprozeile);
+IF neuemarkierungTHEN trageinthesaurusein(identiobjekt)ELIF 
+markierungweggenommenTHEN loescheausthesaurus(identiobjekt)FI ;FI ;posiINCR 
+felderprozeile;PER .markierungsaenderung:(markaltAND NOT markneu)OR (NOT 
+markaltAND markneu).neuemarkierung:markneu.markierungweggenommen:markalt.END 
+PROC objektlistenmaskeeinlesen;PROC objektlistebeenden(TEXT CONST dateiname,
+BOOL CONST uebernahme):IF uebernahmeTHEN uebertragethesaurusindatei(dateiname
+);#sort(dateiname)sf18.2.87#FI ;END PROC objektlistebeenden;PROC 
+setzebestandende(BOOL CONST b):bestandsende:=bENDPROC setzebestandende;BOOL 
+PROC bestandende:bestandsendeENDPROC bestandende;PROC einendatensatzlesen(
+PROC (INT CONST ,BOOL PROC )mitscanner,PROC ohnescanner,BOOL CONST scanja,
+BOOL PROC pruefungspeziell):IF scanjaAND scanerlaubtTHEN mitscanner(aktindex,
+BOOL PROC pruefungspeziell)ELSE ohnescannerFI ENDPROC einendatensatzlesen;
+PROC satzlesen(INT CONST was,n,BOOL CONST scanja,BOOL PROC pruefungspeziell):
+TEXT VAR sicherung:="";anzahltupel:=n;SELECT wasOF CASE andenanfang:
+ersteseitelesenCASE ansende:letzteseitelesenCASE vorwaerts:naechsteseitelesen
+CASE rueckwaerts:vorherigeseitelesenENDSELECT ;savetupel(dateinummer,
+sicherung);bestandsende:=anzahltupel<nCOR (scanjaCAND (NOT scanstackentry(
+anzahltupel,BOOL PROC pruefungspeziell)));restoretupel(dateinummer,sicherung)
+;changeindex;nureinedatenseite:=(ersterdatensatzCAND was=vorwaertsCAND 
+bestandsende);IF ersterdatensatzCAND was=vorwaertsTHEN ersterdatensatz:=
+FALSE ;FI ;.ersteseitelesen:ersteletzteseite(scanstartwert,PROC (INT CONST ,
+BOOL PROC ,INT VAR )scanforward,PROC (INT CONST )first,scanja,BOOL PROC 
+pruefungspeziell,anzahltupel,feldnummerstartwert);IF NOT scanjaTHEN 
+multisearchforward(aktindex,anzahltupel)FI ;.letzteseitelesen:
+ersteletzteseite(scanendewert,PROC (INT CONST ,BOOL PROC ,INT VAR )scanpred,
+PROC (INT CONST )last,scanja,BOOL PROC pruefungspeziell,anzahltupel,
+feldnummerstartwert);IF NOT scanjaTHEN multisearchbackward(aktindex,
+anzahltupel)FI ;letzterbildschirm:=TRUE ;.naechsteseitelesen:IF 
+ersterdatensatzTHEN multisearchforward(aktindex,anzahltupel);ELSE changeindex
+;multisucc(aktindex,anzahltupel);ersterbildschirm:=FALSE FI .
+vorherigeseitelesen:multisearchbackward(aktindex,anzahltupel);.END PROC 
+satzlesen;PROC ersteletzteseite(TEXT CONST startwert,PROC (INT CONST ,BOOL 
+PROC ,INT VAR )mitscanner,PROC (INT CONST )ohnescanner,BOOL CONST scanja,
+BOOL PROC pruefungspeziell,INT VAR anzahl,INT CONST fnrstartwert):IF scanja
+CAND scanerlaubtTHEN setzestartwert;mitscanner(aktindex,BOOL PROC 
+pruefungspeziell,anzahl)ELSE ohnescanner(aktindex)FI .setzestartwert:INT VAR 
+k,ersteskeyfeld:=dateinummer+1;INT VAR letzteskeyfeld:=dateinummer+
+anzschluesselfelder;FOR kFROM ersteskeyfeldUPTO letzteskeyfeldREP putwert(k,
+"")PER ;restorescanwert;putwert(fnrstartwert,startwert);changeindex.END PROC 
+ersteletzteseite;PROC eineseiteeinlesen(TEXT CONST startwert,PROC (INT CONST 
+,BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST )ohnescanner,BOOL CONST 
+scanja,BOOL PROC pruefungspeziell,INT VAR anzahl):IF scanjaAND scanerlaubt
+THEN IF scanueberdiedateinummerTHEN putwert(aktindex+2,startwert)ELSE putwert
+(dateinummer+1,startwert)FI ;mitscanner(aktindex,BOOL PROC pruefungspeziell,
+anzahl)ELSE ohnescanner(aktindex)FI ;.END PROC eineseiteeinlesen;PROC 
+eineseiteeinlesen(PROC (INT CONST ,BOOL PROC ,INT VAR )mitscanner,PROC (INT 
+CONST ,INT VAR )ohnescanner,BOOL CONST scanja,BOOL PROC pruefungspeziell,INT 
+VAR anzahl):IF scanjaAND scanerlaubtTHEN dbstatus(ok);mitscanner(aktindex,
+BOOL PROC pruefungspeziell,anzahl)ELSE scanstatus(ok);ohnescanner(aktindex,
+anzahl)FI .END PROC eineseiteeinlesen;BOOL PROC scanerlaubt:aktindex<>
+dateinummerOR (scanueberdiedateinummerAND anzschluesselfelder>1)END PROC 
+scanerlaubt;BOOL PROC scanueberdiedateinummer:aktindex=dateinummerEND PROC 
+scanueberdiedateinummer;BOOL PROC uebereinenganzensekindex:was(aktindex)=
+indexeintragCAND feldnummerstartwert=0END PROC uebereinenganzensekindex;PROC 
+vorherigeseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl,
+BOOL CONST scanja,BOOL PROC pruefung):INT VAR lv,ende:=2;gelesen:=0;
+stackentry(anzahl-1);savetupel(dateinummer,sicherungstupel);IF 
+letzterbildschirmTHEN ende:=1FI ;FOR lvFROM anzahl-1DOWNTO endeREP stackentry
+(lv);erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1PER ;IF 
+ende=2THEN stackentry(ende-1)FI .END PROC vorherigeseitezeigen;PROC 
+naechsteseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl,BOOL 
+CONST scanja,BOOL PROC pruefung):INT VAR lv;gelesen:=0;
+sicherungfuerzurueckblaettern;IF bestandsendeTHEN letzterbildschirm:=TRUE ;
+ausgabeschleifemitscanueberpruefungELSE ausgabeschleifeohnescanueberpruefung
+FI .sicherungfuerzurueckblaettern:IF NOT ersterbildschirmTHEN savetupel(
+dateinummer,sicherungstupel);zeigenzeile;FI .
+ausgabeschleifemitscanueberpruefung:FOR lvFROM 1UPTO anzahlREP stackentry(lv)
+;IF (scanjaCAND pruefung)OR NOT scanjaTHEN zeigenzeile;ELSE LEAVE 
+naechsteseitezeigenFI PER .ausgabeschleifeohnescanueberpruefung:FOR lvFROM 1
+UPTO (anzahl-1)REP stackentry(lv);zeigenzeilePER ;stackentry(anzahl);.
+zeigenzeile:erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1.
+END PROC naechsteseitezeigen;PROC blaettern(PROC (INT CONST )
+erfassungspeziell,INT CONST aktion,BOOL CONST scanja,BOOL PROC 
+pruefungspeziell):SELECT aktionOF CASE andenanfang:blaettereandenanfangCASE 
+ansende:blaettereansendeCASE vorwaerts:blaetterevorwaertsCASE rueckwaerts:
+blaettererueckwaertsEND SELECT .blaettereandenanfang:anfang(PROC 
+erfassungspeziell,scanja,BOOL PROC pruefungspeziell).blaettereansende:
+ersterbildschirm:=FALSE ;ersterdatensatz:=FALSE ;aufbestandendepositionieren;
+IF bestandsendeTHEN anfang(PROC erfassungspeziell,scanja,BOOL PROC 
+pruefungspeziell)ELSE vorherigeseitezeigen(PROC erfassungspeziell,anzahltupel
+,scanja,BOOL PROC pruefungspeziell)FI .aufbestandendepositionieren:satzlesen(
+ansende,fenster+1,scanja,BOOL PROC pruefungspeziell);.blaetterevorwaerts:plus
+(fenster,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell).
+blaettererueckwaerts:restoretupel(dateinummer,sicherungstupel);changeindex;
+minus(fenster+2,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell).
+END PROC blaettern;PROC meldungdasnichtgeblaettertwird:TEXT VAR 
+zwischensicherung:="";savetupel(dateinummer,zwischensicherung);
+meldeauffaellig(aktuellemaske,meldungnichtblaettern);gelesen:=0;restoretupel(
+dateinummer,zwischensicherung);changeindex.END PROC 
+meldungdasnichtgeblaettertwird;PROC anfang(PROC (INT CONST )erfassungspeziell
+,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF scanjaTHEN restorescanwert;
+changeindexFI ;IF NOT ersterbildschirmTHEN ersterbildschirm:=TRUE ;
+aufanfangpositionieren;naechsteseitezeigen(PROC erfassungspeziell,anzahltupel
+,scanja,BOOL PROC pruefungspeziell);FI .aufanfangpositionieren:
+letzterbildschirm:=FALSE ;satzlesen(andenanfang,fenster+1,scanja,BOOL PROC 
+pruefungspeziell).END PROC anfang;PROC plus(INT CONST saetzevor,PROC (INT 
+CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):
+letzterbildschirm:=FALSE ;IF NOT ersterdatensatzTHEN ersterbildschirm:=FALSE 
+;satzlesen(vorwaerts,saetzevor,scanja,BOOL PROC pruefungspeziell);ELSE 
+satzlesen(vorwaerts,saetzevor+1,scanja,BOOL PROC pruefungspeziell);FI ;
+naechsteseitezeigen(PROC erfassungspeziell,anzahltupel,scanja,BOOL PROC 
+pruefungspeziell);IF nureinedatenseiteTHEN putwert(dateinummer+
+scanfeldsicherung,scanwertsicherung)FI ;END PROC plus;PROC minus(INT CONST 
+saetzezurueck,PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC 
+pruefungspeziell):#neudr30.01.87#satzlesen(rueckwaerts,saetzezurueck,scanja,
+BOOL PROC pruefungspeziell);IF bestandsendeTHEN anfang(PROC erfassungspeziell
+,scanja,BOOL PROC pruefungspeziell)ELSE ersterbildschirm:=FALSE ;
+letzterbildschirm:=FALSE ;vorherigeseitezeigen(PROC erfassungspeziell,
+saetzezurueck,scanja,BOOL PROC pruefungspeziell)FI .END PROC minus;PROC 
+initankreuzliste:INT VAR i;FOR iFROM 1UPTO satzzahlREP angekreuzt(i):=FALSE 
+PER ;END PROC initankreuzliste;#dr17.10.88PROC savetupel(INT CONST dnr,TEXT 
+VAR tupel):INT VAR fnr,primdat;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE 
+primdat:=dateinr(primdatid(dnr))FI ;tupel:="";FOR fnrFROM 1UPTO anzattr(
+primdat)REP tupelCAT (wert(primdat+fnr)+delimiter)PER ENDPROC savetupel;PROC 
+restoretupel(INT CONST dnr,TEXT VAR tupel):INT VAR fnr,primdat,p;TEXT VAR 
+feldwert,data:=tupel;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE primdat:=
+dateinr(primdatid(dnr))FI ;FOR fnrFROM primdat+1UPTO primdat+anzattr(primdat)
+REP p:=pos(data,delimiter);feldwert:=subtext(data,1,(p-1));putwert(fnr,
+feldwert);change(data,1,p,"")PER ENDPROC restoretupel;#BOOL PROC 
+pruefungdummy:TRUE END PROC pruefungdummy;BOOL PROC pruefungbenutzerbestand:(
+wert(fnrbenutzbestand))=(benutzerbestandSUB 1)END PROC 
+pruefungbenutzerbestand;TEXT VAR savedscan:="";LET savedscansep="�",dateityp=
+1;PROC savescanwert:savedscan:="";transversale(feldnummerstartwert,PROC (INT 
+CONST ,INT VAR )save,FALSE )ENDPROC savescanwert;PROC restorescanwert:
+transversale(feldnummerstartwert,PROC (INT CONST ,INT VAR )restore,TRUE )
+ENDPROC restorescanwert;PROC transversale(INT CONST fnrsetzfeld,PROC (INT 
+CONST ,INT VAR )pproc,BOOL CONST rsetzen):TEXT VAR z:=zugriffaufbauen;INT 
+VAR p:=1,psem:=pos(z,";"),i,fnrsf:=fnrsetzfeld-dateinummer;INT VAR fnr:=int(
+subtext(z,p,psem-1)),p1:=1;BOOL VAR pausf:=TRUE ;WHILE #fnr<>fnrsfCAND #fnr>0
+REP IF fnr=fnrsfTHEN pausf:=FALSE ELSE IF pausfTHEN pproc(fnr+dateinummer,p1)
+;ELSE IF rsetzenTHEN putwert(fnr+dateinummer,"")FI FI FI ;p:=psem+1;psem:=pos
+(z,";",p);fnr:=int(subtext(z,p,psem-1))PER .zugriffaufbauen:IF was(aktindex)=
+dateitypTHEN TEXT VAR x:="";FOR iFROM 1UPTO anzkey(aktindex)REP xCAT (text(i)
++";")PER ;xELSE zugriff(aktindex)FI .ENDPROC transversale;PROC save(INT 
+CONST fnr,INT VAR p):savedscanCAT (wert(fnr)+savedscansep)ENDPROC save;PROC 
+restore(INT CONST fnr,INT VAR p):INT VAR p2:=p;p:=pos(savedscan,savedscansep,
+p2)+1;putwert(fnr,subtext(savedscan,p2,p-2))ENDPROC restore;END PACKET 
+ispobjektliste;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.schulis db nummern b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern
new file mode 100644
index 0000000..f030559
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern
@@ -0,0 +1,225 @@
+PACKET ispschulisdbnummernDEFINES dnrschueler,fnrsufamnames,fnrsurufnames,
+fnrsugebdatums,fnrsustatuss,fnrsusgrpjgst,fnrsusgrpzugtut,fnrsutidakthjd,
+fnrsuartzugang,fnrsuneuerzugtut,fnrsugeschlechts,fnrsujgsteintr,
+fnrsuskennlschule,fnrsuklasselschule,fnrsuabgdats,fnrsuabggrund,
+fnrsuabschluss,fnrsuskennnschule,fnrsuvornames,fnrsunamenszusatzs,
+fnrsugebnames,fnrsuwohntbei,fnrsustrnrs,fnrsuplzorts,fnrsutelnrs,
+fnrsuortsteils,fnrsufamnamee,fnrsuvornamee,fnrsunamenszusatze,fnrsustrnre,
+fnrsuplzorte,fnrsutelnre,fnrsuverhes,fnrsustaatsangs,fnrsureligionsz,
+fnrsureligionsvz,fnrsuspaetaus,fnrsumuttersprache,fnrsugeborts,fnrsugebkreiss
+,fnrsujahreinschul,fnrsueintrittsdats,fnrsueintrittinsek,fnrsuvermerk1,
+fnrsuvermerk2,fnrsuvermerk3,fnrsuvermerk4,fnrsuvermerk5,fnrsuvermerk6,
+fnrsudiffdatennrs,fnrsutiddiffdaten,dnrdiffdaten,fnrdddiffdatennr,
+fnrdd1fremdfach,fnrdd1fremdb,fnrdd1fremde,fnrdd2fremdfach,fnrdd2fremdb,
+fnrdd2fremde,fnrdd3fremdfach,fnrdd3fremdb,fnrdd3fremde,fnrdd4fremdfach,
+fnrdd4fremdb,fnrdd4fremde,fnrddreliunter,fnrddabmeldedatreli,
+fnrddanmeldedatreli,fnrddkunstmusik,fnrddfach091a,fnrddfach091b,fnrddfach092a
+,fnrddfach092b,fnrddfach101a,fnrddfach101b,fnrddfach102a,fnrddfach102b,
+fnrddagthema1,fnrddagthema1b,fnrddagthema1e,fnrddagthema2,fnrddagthema2b,
+fnrddagthema2e,fnrddagthema3,fnrddagthema3b,fnrddagthema3e,dnrhalbjahresdaten
+,fnrhjdfamnames,fnrhjdrufnames,fnrhjdgebdats,fnrhjdsj,fnrhjdhj,fnrhjdjgst,
+fnrhjdkennung,fnrhjdversetzung,fnrhjdnachfach1,fnrhjdnachfach2,
+fnrhjdnachfach3,fnrhjdnachfach,fnrhjdnacherg,fnrhjdversstdm,fnrhjdversstdo,
+fnrhjdverspaet,fnrhjdbemzeug1,fnrhjdbemzeug2,fnrhjdbemzeug3,fnrhjdbemnach,
+fnrhjdvermblau,fnrhjdvermnachwarn,fnrhjdbemblau,fnrhjdbemnachwarn,fnrhjdfach,
+fnrhjdkursart,fnrhjdlerngrpkenn,fnrhjdklausurteiln,fnrhjdnotepunkte,
+fnrhjdbemerk,fnrhjdvermwarnung,dnrschulen,fnrschkennung,fnrschname,fnrschart,
+fnrschstrnr,fnrschplzort,fnrschtelnr,fnrschamtlnr,fnrschbundesland,
+dnraktschuelergruppen,fnrsgrpsj,fnrsgrphj,fnrsgrpjgst,fnrsgrpkennung,
+fnrsgrplehrer,fnrsgrpstellvlehrer,fnrsgrpintegabez,dnrschluessel,
+fnrschlsachgebiet,fnrschlschluessel,fnrschllangtext,dnrfaecher,fnrffach,
+fnrffachbez,fnrffachgrp,fnrffachbereich,dnrlehrer,fnrlparaphe,fnrlfamname,
+fnrlrufname,fnrlzusatz,fnrlamtsbeztitel,fnrlgeschlecht,fnrlsollstd,
+fnrlpflichtstd,fnrlerm1,fnrlermgrund1,fnrlerm2,fnrlermgrund2,fnrlerm3,
+fnrlermgrund3,fnrlerm4,fnrlermgrund4,fnrlsprechzeit,fnrlstrnr,fnrlplzort,
+fnrltelnr,dnrlehrbefaehigungen,fnrlbfach,fnrlbparaphe,fnrlbart,
+dnrfaecherangebot,fnrfangsj,fnrfanghj,fnrfangjgst,fnrfanglfdnr,fnrfangfach,
+fnrfangart,fnrfangwochenstd,fnrfanganzlv,dnrlehrveranstaltungen,fnrlvsj,
+fnrlvhj,fnrlvjgst,fnrlvfachkennung,fnrlvkopplung,fnrlvparaphe,fnrlvwochenstd,
+fnrlvklgrp1,fnrlvklgrp2,fnrlvklgrp3,fnrlvklgrp4,fnrlvraumgrp1,fnrlvraumgrp2,
+fnrlvart,dnrzeitraster,fnrzrsj,fnrzrhj,fnrzrtagstunde,fnrzrkennungteil,
+fnrzrbeginnuhr,fnrzrendeuhr,dnraufsichtszeiten,fnrazsj,fnrazhj,
+fnrazaufsichtszeit,fnraztagstdvor,fnraztagstdnach,fnrazbeginnuhr,fnrazendeuhr
+,fnrazbezeichnung,dnrzeitwuensche,fnrzwsj,fnrzwhj,fnrzwbezug,
+fnrzwbezugsobjekt,fnrzwbestimmtewuensche,fnrzwunbestimmtewuensche,
+dnrraumgruppen,fnrrgraumgrp,fnrrgraeume,dnrklassengruppen,fnrkgklassengrp,
+fnrkgschuelergrp,dnraufsichtsplan,fnrapsj,fnraphj,fnrapaufsichtszeit,
+fnrapaufsichtsort,fnrapparaphe,dnrvertretungen,fnrvdatum,fnrvtagstd,
+fnrvparaphe,fnrvanrechnung,fnrvveranstaltung,dnrida,fnridanummer,fnridaname,
+fnridastatus,fnridatyp,#ixsustat,dr05.04.88jetztüberflüssig#ixsustatschulkenn
+,ixsustatfamrufgeb,ixsustatjgstzug,ixsustatabgdat,ixsustatjgst,ixsustatgeb,
+ixsustatgeschlgeb,ixhjdfamrufgebjgsthj,ixhjdsjhjjgstkenn,ixhjdsjhjverjgstkenn
+,ixhjdversjhjjgstkenn,ixhjdverfamsjhjrufgeb,ixhjdsjhjverjgst,ixsgrpjgstkenn,
+ixlfamruf,ixlbpar,ixlbart,ixfangsjhjfach,ixlvsjhjkopp,ixlvsjhjkenn,
+ixlvsjhjpar,ixappar,ixvpar,dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname,
+fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname,
+fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext:LET 
+dnrauskuenfte=2,fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7,
+fnrbenbestand=8,fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12,
+fnrmeldname=13,fnrmeldtext=14;INT PROC dnrausk:dnrauskuenfteENDPROC dnrausk;
+INT PROC fnrauskunftsname:fnrausknameENDPROC fnrauskunftsname;INT PROC 
+fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT PROC fnrauskunftstext:
+fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz:dnrbenutzerENDPROC 
+dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC fnrbenutzbestand;
+INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT PROC 
+fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC 
+fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld:
+dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC 
+fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;#
+oeffnedatenbank(schulisdbname);systemdboff;#BOOL VAR b:=dbopen(schulisdbname)
+;INT CONST dnrschueler:=dateinr("Schüler"),fnrsufamnames:=feldnr(
+"Familienname.S"),fnrsurufnames:=feldnr("Rufname.S"),fnrsugebdatums:=feldnr(
+"Geburtsdatum.S"),fnrsustatuss:=feldnr("Status"),fnrsusgrpjgst:=feldnr(
+"SchülergruppeJgst"),fnrsusgrpzugtut:=feldnr("SchülergruppeZug/Tutor"),
+fnrsutidakthjd:=feldnr("Tid akt Hjd"),fnrsuartzugang:=feldnr(
+"Art des Zugangs"),fnrsuneuerzugtut:=feldnr("neuer Zug/Tutor"),
+fnrsugeschlechts:=feldnr("Geschlecht.S"),fnrsujgsteintr:=feldnr(
+"Jahrgangsstufe Eintr"),fnrsuskennlschule:=feldnr("Schulkenn. letzt Sch"),
+fnrsuklasselschule:=feldnr("Klasse letzte Schule"),fnrsuabgdats:=feldnr(
+"Abgangsdatum.S"),fnrsuabggrund:=feldnr("Abgangsgrund"),fnrsuabschluss:=
+feldnr("Abschluß"),fnrsuskennnschule:=feldnr("Schulkennung neue Sch"),
+fnrsuvornames:=feldnr("Vorname.S"),fnrsunamenszusatzs:=feldnr(
+"Namenszusatz.S"),fnrsugebnames:=feldnr("Geburtsname.S"),fnrsuwohntbei:=
+feldnr("Zusatz wohnt bei"),fnrsustrnrs:=feldnr("Straße, Nr.S"),fnrsuplzorts:=
+feldnr("PLZ, Ort.S"),fnrsutelnrs:=feldnr("Tel.Nr.S"),fnrsuortsteils:=feldnr(
+"Ortsteil.S"),fnrsufamnamee:=feldnr("Familienname.E"),fnrsuvornamee:=feldnr(
+"Vorname.E"),fnrsunamenszusatze:=feldnr("Namenszusatz.E"),fnrsustrnre:=feldnr
+("Straße, Nr.E"),fnrsuplzorte:=feldnr("PLZ, Ort.E"),fnrsutelnre:=feldnr(
+"Tel.Nr.E"),fnrsuverhes:=feldnr("Verhältnis.E-S"),fnrsustaatsangs:=feldnr(
+"Staatsangehörigkeit.S"),fnrsureligionsz:=feldnr("Religionszugehörigkeit"),
+fnrsureligionsvz:=feldnr("ReligionsvermerkZeugn"),fnrsuspaetaus:=feldnr(
+"Spätaussiedler"),fnrsumuttersprache:=feldnr("Muttersprache"),fnrsugeborts:=
+feldnr("Geburtsort.S"),fnrsugebkreiss:=feldnr("Geburtskreis/-land.S"),
+fnrsujahreinschul:=feldnr("Jahr der Einschulung"),fnrsueintrittsdats:=feldnr(
+"Eintrittsdatum.S"),fnrsueintrittinsek:=feldnr("Eintritt in Sek. II"),
+fnrsuvermerk1:=feldnr("Vermerk 1"),fnrsuvermerk2:=feldnr("Vermerk 2"),
+fnrsuvermerk3:=feldnr("Vermerk 3"),fnrsuvermerk4:=feldnr("Vermerk 4"),
+fnrsuvermerk5:=feldnr("Vermerk 5"),fnrsuvermerk6:=feldnr("Vermerk 6"),
+fnrsudiffdatennrs:=feldnr("Diffdaten Nr.S"),fnrsutiddiffdaten:=feldnr(
+"Tid Diffdaten");INT CONST dnrdiffdaten:=dateinr("Differenzierungsdaten"),
+fnrdddiffdatennr:=feldnr("Diffdaten Nr."),fnrdd1fremdfach:=feldnr(
+"Fach.1.Fremdsprache"),fnrdd1fremdb:=feldnr("Beginn.1.Fremdsprache"),
+fnrdd1fremde:=feldnr("Ende.1.Fremdsprache"),fnrdd2fremdfach:=feldnr(
+"Fach.2.Fremdsprache"),fnrdd2fremdb:=feldnr("Beginn.2.Fremdsprache"),
+fnrdd2fremde:=feldnr("Ende.2.Fremdsprache"),fnrdd3fremdfach:=feldnr(
+"Fach.3.Fremdsprache"),fnrdd3fremdb:=feldnr("Beginn.3.Fremdsprache"),
+fnrdd3fremde:=feldnr("Ende.3.Fremdsprache"),fnrdd4fremdfach:=feldnr(
+"Fach.4.Fremdsprache"),fnrdd4fremdb:=feldnr("Beginn.4.Fremdsprache"),
+fnrdd4fremde:=feldnr("Ende.4.Fremdsprache"),fnrddreliunter:=feldnr(
+"Religionsunterricht"),fnrddabmeldedatreli:=feldnr("Abmeldedatum.Religion"),
+fnrddanmeldedatreli:=feldnr("Wiederanmeld.Religion"),fnrddkunstmusik:=feldnr(
+"Kunst/Musik"),fnrddfach091a:=feldnr("FächerWP09.1.a"),fnrddfach091b:=feldnr(
+"FächerWP09.1.b"),fnrddfach092a:=feldnr("FächerWP09.2.a"),fnrddfach092b:=
+feldnr("FächerWP09.2.b"),fnrddfach101a:=feldnr("FächerWP10.1.a"),
+fnrddfach101b:=feldnr("FächerWP10.1.b"),fnrddfach102a:=feldnr(
+"FächerWP10.2.a"),fnrddfach102b:=feldnr("FächerWP10.2.b"),fnrddagthema1:=
+feldnr("AG.Thema1"),fnrddagthema1b:=feldnr("AG.Thema1.Beginn"),fnrddagthema1e
+:=feldnr("AG.Thema1.Ende"),fnrddagthema2:=feldnr("AG.Thema2"),fnrddagthema2b
+:=feldnr("AG.Thema2.Beginn"),fnrddagthema2e:=feldnr("AG.Thema2.Ende"),
+fnrddagthema3:=feldnr("AG.Thema3"),fnrddagthema3b:=feldnr("AG.Thema3.Beginn")
+,fnrddagthema3e:=feldnr("AG.Thema3.Ende");INT CONST dnrhalbjahresdaten:=
+dateinr("Halbjahresdaten"),fnrhjdfamnames:=feldnr("Hjd.Famname.S"),
+fnrhjdrufnames:=feldnr("Hjd.Rufname.S"),fnrhjdgebdats:=feldnr(
+"Hjd.Gebdatum.S"),fnrhjdsj:=feldnr("Hjd.Schuljahr"),fnrhjdhj:=feldnr(
+"Hjd.Halbjahr"),fnrhjdjgst:=feldnr("Hjd.Jahrgangsstufe"),fnrhjdkennung:=
+feldnr("Hjd.Kennung"),fnrhjdversetzung:=feldnr("Hjd.Versetzung"),
+fnrhjdnachfach1:=feldnr("Hjd.Nachprüfungsfach 1"),fnrhjdnachfach2:=feldnr(
+"Hjd.Nachprüfungsfach 2"),fnrhjdnachfach3:=feldnr("Hjd.Nachprüfungsfach 3"),
+fnrhjdnachfach:=feldnr("Hjd.Nachprüfungsfach"),fnrhjdnacherg:=feldnr(
+"Hjd.Nachprüfungsergebnis"),fnrhjdversstdm:=feldnr(
+"Hjd.versäumte Stunden mit"),fnrhjdversstdo:=feldnr(
+"Hjd.versäumte Stunden ohn"),fnrhjdverspaet:=feldnr("Hjd.Verspätungen"),
+fnrhjdbemzeug1:=feldnr("Hjd.Bemerk.Zeugnis 1"),fnrhjdbemzeug2:=feldnr(
+"Hjd.Bemerk.Zeugnis 2"),fnrhjdbemzeug3:=feldnr("Hjd.Bemerk.Zeugnis 3"),
+fnrhjdbemnach:=feldnr("Hjd.Bemerk.Nachprüfung"),fnrhjdvermblau:=feldnr(
+"Hjd.Vermerk.Blauer Brief"),fnrhjdvermnachwarn:=feldnr(
+"Hjd.Vermerk.Nachwarnung"),fnrhjdbemblau:=feldnr("Hjd.Bemerk.Blauer Brief"),
+fnrhjdbemnachwarn:=feldnr("Hjd.Bemerk.Nachwarnung"),fnrhjdfach:=feldnr(
+"Hjd.Fach"),fnrhjdkursart:=feldnr("Hjd.Kursart"),fnrhjdlerngrpkenn:=feldnr(
+"Hjd.Lerngrp.Kennung"),fnrhjdklausurteiln:=feldnr("Hjd.Klausurteilnahme"),
+fnrhjdnotepunkte:=feldnr("Hjd.Zeugnisnote/Punkte"),fnrhjdbemerk:=feldnr(
+"Hjd.Bemerkung"),fnrhjdvermwarnung:=feldnr("Hjd.Vermerk Warnung");INT CONST 
+dnrschulen:=dateinr("Schulen"),fnrschkennung:=feldnr("Schulkennung"),
+fnrschname:=feldnr("Schulname"),fnrschart:=feldnr("Schulart"),fnrschstrnr:=
+feldnr("Straße Nr.Schule"),fnrschplzort:=feldnr("PLZ, Ort.Schule"),
+fnrschtelnr:=feldnr("Tel. Nr.Schule"),fnrschamtlnr:=feldnr(
+"amtl. Schulnummer"),fnrschbundesland:=feldnr("Bundesland");INT CONST 
+dnraktschuelergruppen:=dateinr("aktuelle Schülergruppen"),fnrsgrpsj:=feldnr(
+"Schuljahr"),fnrsgrphj:=feldnr("Halbjahr"),fnrsgrpjgst:=feldnr(
+"Jahrgangsstufe"),fnrsgrpkennung:=feldnr("Kennung"),fnrsgrplehrer:=feldnr(
+"Klassenlehrer/Tutor"),fnrsgrpstellvlehrer:=feldnr("stellvertr. Klassenl."),
+fnrsgrpintegabez:=feldnr("intega Bezeichnung");INT CONST dnrschluessel:=
+dateinr("Schlüssel"),fnrschlsachgebiet:=feldnr("Sachgebiet"),
+fnrschlschluessel:=feldnr("Schlüssel"),fnrschllangtext:=feldnr("Langtext");
+INT CONST dnrfaecher:=dateinr("Fächer"),fnrffach:=feldnr("Fach"),fnrffachbez
+:=feldnr("Fachbezeichnung"),fnrffachgrp:=feldnr("Fachgruppe"),fnrffachbereich
+:=feldnr("Fachbereich");INT CONST dnrlehrer:=dateinr("Lehrer"),fnrlparaphe:=
+feldnr("Paraphe"),fnrlfamname:=feldnr("Familienname.L"),fnrlrufname:=feldnr(
+"Rufname.L"),fnrlzusatz:=feldnr("Namenszusatz.L"),fnrlamtsbeztitel:=feldnr(
+"Amtsbezeichnung Titel"),fnrlgeschlecht:=feldnr("Geschlecht.L"),fnrlsollstd:=
+feldnr("Sollstunden"),fnrlpflichtstd:=feldnr("Pflichtstunden"),fnrlerm1:=
+feldnr("Ermäßigung 1"),fnrlermgrund1:=feldnr("Ermäßigungsgrund 1"),fnrlerm2:=
+feldnr("Ermäßigung 2"),fnrlermgrund2:=feldnr("Ermäßigungsgrund 2"),fnrlerm3:=
+feldnr("Ermäßigung 3"),fnrlermgrund3:=feldnr("Ermäßigungsgrund 3"),fnrlerm4:=
+feldnr("Ermäßigung 4"),fnrlermgrund4:=feldnr("Ermäßigungsgrund 4"),
+fnrlsprechzeit:=feldnr("Sprechzeiten"),fnrlstrnr:=feldnr("Straße, Nr.L"),
+fnrlplzort:=feldnr("PLZ, Ort.L"),fnrltelnr:=feldnr("Tel. Nr.L");INT CONST 
+dnrlehrbefaehigungen:=dateinr("Lehrbefähigungen"),fnrlbfach:=feldnr("Lb.Fach"
+),fnrlbparaphe:=feldnr("Lb.Paraphe"),fnrlbart:=feldnr("Lb.Art");INT CONST 
+dnrfaecherangebot:=dateinr("Fächerangebot"),fnrfangsj:=feldnr("Fa.Schuljahr")
+,fnrfanghj:=feldnr("Fa.Halbjahr"),fnrfangjgst:=feldnr("Fa.Jgst"),fnrfanglfdnr
+:=feldnr("Fa.laufende Nr."),fnrfangfach:=feldnr("Fa.Fach"),fnrfangart:=feldnr
+("Fa.Art"),fnrfangwochenstd:=feldnr("Fa.Wochenstundenzahl"),fnrfanganzlv:=
+feldnr("Fa.Anzahl Lehrveranst.");INT CONST dnrlehrveranstaltungen:=dateinr(
+"Lehrveranstaltungen"),fnrlvsj:=feldnr("Lv.Schuljahr"),fnrlvhj:=feldnr(
+"Lv.Halbjahr"),fnrlvjgst:=feldnr("Lv.Jgst"),fnrlvfachkennung:=feldnr(
+"Lv.Fach Kennung"),fnrlvkopplung:=feldnr("Lv.Kopplung"),fnrlvparaphe:=feldnr(
+"Lv.Paraphe"),fnrlvwochenstd:=feldnr("Lv.Wochenstunden"),fnrlvklgrp1:=feldnr(
+"Lv.Klassengruppe 1"),fnrlvklgrp2:=feldnr("Lv.Klassengruppe 2"),fnrlvklgrp3:=
+feldnr("Lv.Klassengruppe 3"),fnrlvklgrp4:=feldnr("Lv.Klassengruppe 4"),
+fnrlvraumgrp1:=feldnr("Lv.Raumgruppe 1"),fnrlvraumgrp2:=feldnr(
+"Lv.Raumgruppe 2"),fnrlvart:=feldnr("Lv.Art");INT CONST dnrzeitraster:=
+dateinr("Zeitraster"),fnrzrsj:=feldnr("Zr.Schuljahr"),fnrzrhj:=feldnr(
+"Zr.Halbjahr"),fnrzrtagstunde:=feldnr("Zr.Tag Stunde"),fnrzrkennungteil:=
+feldnr("Zr.Kennung Tagesteil"),fnrzrbeginnuhr:=feldnr("Zr.Beginn Uhrzeit"),
+fnrzrendeuhr:=feldnr("Zr.Ende Uhrzeit");INT CONST dnraufsichtszeiten:=dateinr
+("Aufsichtszeiten"),fnrazsj:=feldnr("Az.Schuljahr"),fnrazhj:=feldnr(
+"Az.Halbjahr"),fnrazaufsichtszeit:=feldnr("Az.Aufsichtszeit"),fnraztagstdvor
+:=feldnr("Az.Tag Stunde vorher"),fnraztagstdnach:=feldnr(
+"Az.Tag Stunde nachher"),fnrazbeginnuhr:=feldnr("Az.Beginn Uhrzeit"),
+fnrazendeuhr:=feldnr("Az.Ende Uhrzeit"),fnrazbezeichnung:=feldnr(
+"Az.Bezeichnung");INT CONST dnrzeitwuensche:=dateinr("Zeitwünsche"),fnrzwsj:=
+feldnr("Zw.Schuljahr"),fnrzwhj:=feldnr("Zw.Halbjahr"),fnrzwbezug:=feldnr(
+"Zw.Bezug"),fnrzwbezugsobjekt:=feldnr("Zw.Bezugsobjekt"),
+fnrzwbestimmtewuensche:=feldnr("Zw.bestimmte Wünsche"),
+fnrzwunbestimmtewuensche:=feldnr("Zw.unbestimmte Wünsche");INT CONST 
+dnrraumgruppen:=dateinr("Raumgruppen"),fnrrgraumgrp:=feldnr("Raumgruppe"),
+fnrrgraeume:=feldnr("Räume");INT CONST dnrklassengruppen:=dateinr(
+"Klassengruppen"),fnrkgklassengrp:=feldnr("Klassengruppe"),fnrkgschuelergrp:=
+feldnr("Schülergruppen");INT CONST dnraufsichtsplan:=dateinr("Aufsichtsplan")
+,fnrapsj:=feldnr("Ap.Schuljahr"),fnraphj:=feldnr("Ap.Halbjahr"),
+fnrapaufsichtszeit:=feldnr("Ap.Aufsichtszeit"),fnrapaufsichtsort:=feldnr(
+"Ap.Aufsichtsort"),fnrapparaphe:=feldnr("Ap.Paraphe");INT CONST 
+dnrvertretungen:=dateinr("Vertretungen"),fnrvdatum:=feldnr("V.Datum"),
+fnrvtagstd:=feldnr("V.Tag Stunde"),fnrvparaphe:=feldnr("V.Paraphe"),
+fnrvanrechnung:=feldnr("V.Anrechnung"),fnrvveranstaltung:=feldnr(
+"V.Veranstaltung");INT CONST dnrida:=dateinr("Druckausgaben"),fnridanummer:=
+feldnr("Ida.Nr"),fnridaname:=feldnr("Ida.Name"),fnridastatus:=feldnr(
+"Ida.Status"),fnridatyp:=feldnr("Ida.Typ");INT CONST #ixsustat:=indexnr(
+"Status"),#ixsustatschulkenn:=indexnr("letzte Schule"),ixsustatfamrufgeb:=
+indexnr("Schuelerbestand"),ixsustatjgstzug:=indexnr("Status Jgst Zug"),
+ixsustatabgdat:=indexnr("Status Abgangsdatum"),ixsustatjgst:=indexnr(
+"SchülergruppeJgst"),ixsustatgeb:=indexnr("Geburtsdatum.S"),ixsustatgeschlgeb
+:=indexnr("Geschlecht, Gebdat"),ixhjdfamrufgebjgsthj:=indexnr(
+"ix hjd fam ruf geb jgst hj"),ixhjdsjhjjgstkenn:=indexnr(
+"hjd sj hj jgst kenn"),ixhjdsjhjverjgstkenn:=indexnr(
+"hjd sj hj vers jgst kenn"),ixhjdversjhjjgstkenn:=indexnr("Hjd.Versetzung"),
+ixhjdverfamsjhjrufgeb:=indexnr("Hjd.Famname der Wiederh"),ixhjdsjhjverjgst:=
+indexnr("hjd sj hj vers jgst"),ixsgrpjgstkenn:=indexnr("Gruppe"),ixlfamruf:=
+indexnr("Index.Lehrername"),ixlbpar:=indexnr("Index.Lb.Paraphe"),ixlbart:=
+indexnr("Index.Lb.Art"),ixfangsjhjfach:=indexnr("Index.Fa.Fach"),ixlvsjhjkopp
+:=indexnr("Index.Lv.Kopplung"),ixlvsjhjkenn:=indexnr("Index.Lv.Fach"),
+ixlvsjhjpar:=indexnr("Index.Lv.Paraphe"),ixappar:=indexnr("Index.Ap.Paraphe")
+,ixvpar:=indexnr("Index.V.Paraphe");#systemdbon#END PACKET 
+ispschulisdbnummern
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor
new file mode 100644
index 0000000..67ebbfb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor
@@ -0,0 +1,141 @@
+PACKET sicherungsmonitorDEFINES ladenstarten,sichernstarten,formatieren,
+endeformatieren,initialisieren,disketteueberpruefen,floppylisten,
+floppylistingzeigen,endefloppylisting,meldungquittieren,
+dbverzeichniserstellen,dbverzeichniszeigen,endedbverzeichnis,archiveanmelden,
+archiveabmelden,bestimmendersicherungstask,sicherungsloop,beendenarchivieren:
+LET initcode=25,listcode=26,checkcode=27,formatcode=40,logonarchivecode=45,
+logoffarchivecode=46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50,
+dddrucken=51,endemeldung=0,errornak=2,nak=1,keinedaten=59,floppyzuranzeige=
+180,formatkorrekt=181,initkorrekt=182,sichernkorrekt=183,ladenkorrekt=184,
+opkorrekt=185,unbekanntercode=186,inkonsicherung=187,floppyzurpruefung=199;
+LET yescode=10,outcode=11,showcode=12;LET meldungsfeld=1;LET 
+ankreuzauffloppyladen=6,ankreuzauffloppysichern=7,floppynamefeld=8,
+ankreuzschulis=2,ankreuzbaisy=3,ankreuzida=4,ankreuzstatistik=5,
+fragekennzeichnung=" ?";LET manager2="baisy",manager1="schulis",manager3=
+"ida",manager4="statistik";LET meldpattern1="Archiv",meldpattern2="e",
+meldpattern3="Diskette",patternlaenge=6;LET sicherung=" sicherung";INT VAR 
+quittung,stufe:=1,letzterauftragscode;TEXT VAR dbinhalt:="";TASK VAR 
+dbsicherungstask;DATASPACE VAR ds;BOUND TEXT VAR message;INT VAR 
+meldungsfeldlaenge,eingabestatus;TEXT VAR dbsicherung:="",anmeldetask:="";
+BOOL VAR endequittungda:=FALSE ,error:=FALSE ;LET logbucheintragsichern=
+"Anw. 10.1.1 Sicherung von ",logbucheintragladen="Anw. 10.1.2 Laden von ";
+PROC eingabepruefen:standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"",
+eingabestatus);IF eingabestatus=0THEN standardpruefe(5,ankreuzauffloppyladen,
+ankreuzauffloppysichern,0,"",eingabestatus);IF eingabestatus=0THEN 
+parametersetzenFI ;FI .END PROC eingabepruefen;PROC eingabepruefeneinfach:
+standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"",eingabestatus);IF 
+eingabestatus=0THEN parametersetzenFI .END PROC eingabepruefeneinfach;PROC 
+parametersetzen:IF standardmaskenfeld(ankreuzschulis)<>""THEN dbsicherung:=
+manager1;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELIF standardmaskenfeld(
+ankreuzbaisy)<>""THEN dbsicherung:=manager2;dbinhalt:=
+"EUMELbase.baisy-DB-Verzeichnis"ELIF standardmaskenfeld(ankreuzida)<>""THEN 
+dbsicherung:=manager3;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELSE #25.09
+.90#dbsicherung:=manager4;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"FI ;
+dbsicherungCAT sicherung;infeld(floppynamefeld);meldungsfeldlaenge:=
+standardfeldlaenge(meldungsfeld).END PROC parametersetzen;PROC 
+beendenarchivieren:archiveabmelden;enter(2)ENDPROC beendenarchivieren;PROC 
+ladenstarten:IF stufe=2THEN sicherungsloopELSE stufe1behandlungFI .
+stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN infeld(eingabestatus)
+;return(1)ELSE IF auffloppyTHEN archiveanmelden;IF anmeldetask=""THEN return(
+1);LEAVE ladenstartenELSE stufe:=2;logeintrag(logbucheintragladen+
+logbuchbehandeltedaten);archiveoperation(dbvondisk,dbsicherung);IF 
+endequittungdaOR errorTHEN return(1)FI FI ELSE logeintrag(logbucheintragladen
++logbuchbehandeltedaten);archiveoperation(dbzumserver,dbsicherung);return(1)
+FI FI .auffloppy:standardmaskenfeld(ankreuzauffloppyladen)<>"".END PROC 
+ladenstarten;PROC sichernstarten:IF stufe=2THEN sicherungsloopELSE 
+stufe1behandlungFI ;.stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN 
+infeld(eingabestatus);return(1)ELSE IF auffloppyTHEN archiveanmelden;IF 
+anmeldetask=""THEN return(1);LEAVE sichernstartenELSE stufe:=2;
+archiveoperation(dbaufdisk,dbsicherung);IF endequittungdaOR errorTHEN return(
+1)FI FI ELSE logeintrag(logbucheintragsichern+logbuchbehandeltedaten);
+archiveoperation(dbvomserver,dbsicherung);return(1)FI FI .END PROC 
+sichernstarten;TEXT PROC logbuchbehandeltedaten:IF standardmaskenfeld(
+ankreuzschulis)<>""THEN "Anwendungsdaten"ELIF standardmaskenfeld(ankreuzbaisy
+)<>""THEN "Systemdaten"ELIF standardmaskenfeld(ankreuzida)<>""THEN 
+"Anwenderspezifischen Druckausgaben"ELSE "Amtliche Statistik"FI END PROC 
+logbuchbehandeltedaten;BOOL PROC auffloppy:standardmaskenfeld(
+ankreuzauffloppysichern)<>""ENDPROC auffloppy;PROC formatieren:
+archiveanmelden;IF anmeldetask<>""THEN archiveoperation(formatcode,
+dbsicherung)FI ;infeld(2);return(2)END PROC formatieren;PROC endeformatieren:
+archiveabmelden;enter(2)ENDPROC endeformatieren;PROC initialisieren:
+archiveanmelden;IF anmeldetask<>""THEN archiveoperation(initcode,dbsicherung)
+FI ;infeld(2);return(2)END PROC initialisieren;PROC disketteueberpruefen:
+eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1)
+ELSE standardmeldung(floppyzurpruefung,"");archiveanmelden;IF anmeldetask<>""
+THEN archiveoperation(checkcode,dbsicherung)FI ;infeld(2);return(1)FI END 
+PROC disketteueberpruefen;PROC floppylisten:eingabepruefeneinfach;IF 
+eingabestatus<>0THEN infeld(eingabestatus);return(1)ELSE standardmeldung(
+floppyzuranzeige,"");archiveanmelden;IF anmeldetask<>""THEN archiveoperation(
+listcode,dbsicherung);IF errorTHEN return(1)FI ELSE return(1)FI FI END PROC 
+floppylisten;PROC dbverzeichniserstellen:eingabepruefeneinfach;IF 
+eingabestatus<>0THEN infeld(eingabestatus);return(1)ELIF standardmaskenfeld(
+ankreuzstatistik)<>""THEN standardmeldung(keinedaten,"");return(1)ELSE 
+archiveoperation(dddrucken,dbsicherung);FI END PROC dbverzeichniserstellen;
+PROC melde(TEXT CONST mt):TEXT CONST mtext:=""+subtext(mt,1,
+meldungsfeldlaenge-5)+" ";INT VAR textl:=length(mtext);INT VAR seitenlaenge
+:=meldungsfeldlaenge-textl;seitenlaenge:=seitenlaengeDIV 2;TEXT CONST fueller
+:=seitenlaenge*" ";TEXT VAR meldung:=fueller+mtext+fueller;
+evtlteiltextersetzen;meldungIN meldungsfeld.evtlteiltextersetzen:INT VAR 
+archpos:=pos(meldung,meldpattern1);IF archpos>0THEN IF NOT (pos(meldung,
+meldpattern3)>0)THEN TEXT VAR ergaenztemeldung:=subtext(meldung,1,archpos-1)+
+meldpattern3;INT VAR patternpos2:=archpos+patternlaenge;IF (meldungSUB 
+patternpos2)=meldpattern2THEN ergaenztemeldungCAT subtext(meldung,patternpos2
++1)ELSE ergaenztemeldungCAT subtext(meldung,patternpos2)FI ;meldung:=
+ergaenztemeldungFI FI .END PROC melde;TEXT PROC frage(TEXT CONST mess):#
+subtext(#mess#,textbeginn)#+fragekennzeichnungEND PROC frage;PROC 
+archiveoperation(INT CONST auftragscode,TEXT CONST sicherungstask):TASK VAR 
+sendingtask;letzterauftragscode:=auftragscode;dbsicherungstask:=/
+sicherungstask;forget(ds);ds:=nilspace;endequittungda:=FALSE ;error:=FALSE ;
+call(dbsicherungstask,auftragscode,ds,quittung);loop.loop:REP SELECT quittung
+OF CASE yescode:questionCASE showcode:showenCASE outcode:meldenCASE 
+endemeldung:beendenCASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT 
+;UNTIL endequittungdaPER .question:message:=ds;melde(frage(message));LEAVE 
+archiveoperation.showen:IF auftragscode=listcodeTHEN floppyELSE dbFI .floppy:
+forget(dbsicherung,quiet);copy(ds,dbsicherung);floppylistingzeigen;LEAVE 
+archiveoperation.db:forget(dbinhalt,quiet);copy(ds,dbinhalt);
+dbverzeichniszeigen;LEAVE archiveoperation.melden:message:=ds;standardmeldung
+(message,"");wartenaufnaechstesendung.wartenaufnaechstesendung:REP forget(ds)
+;wait(ds,quittung,sendingtask);IF NOT (sendingtask=dbsicherungstask)THEN 
+sendnakELSE LEAVE wartenaufnaechstesendungFI PER .beenden:IF 
+ungleichanmeldenundabmeldenTHEN standardmeldung(meldnr,"");archiveabmelden;
+FI ;stufe:=1;endequittungda:=TRUE .meldnr:SELECT auftragscodeOF CASE 
+formatcode:formatkorrektCASE initcode:initkorrektCASE dbvomserver,dbaufdisk:
+sichernkorrektCASE dbzumserver,dbvondisk:ladenkorrektOTHERWISE :opkorrekt
+ENDSELECT .ungleichanmeldenundabmelden:auftragscode<>logonarchivecodeCAND 
+auftragscode<>logoffarchivecode.fehlermelden:message:=ds;standardmeldung(
+message,"");IF ungleichanmeldenundabmeldenTHEN archiveabmeldenFI ;stufe:=1;
+error:=TRUE ;#return(1);#LEAVE archiveoperation.unknowncode:standardmeldung(
+unbekanntercode,": "+text(quittung)+"#");stufe:=1;#return(1);#LEAVE loop.
+sendnak:send(sendingtask,nak,ds).ENDPROC archiveoperation;PROC 
+floppylistingzeigen:editiere(dbsicherung)ENDPROC floppylistingzeigen;PROC 
+dbverzeichniszeigen:editiere(dbinhalt,FALSE )ENDPROC dbverzeichniszeigen;
+PROC endedbverzeichnis:killundenter(2)ENDPROC endedbverzeichnis;PROC 
+endefloppylisting:archiveabmelden;killundenter(2)ENDPROC endefloppylisting;
+PROC archiveanmelden:eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(
+eingabestatus);return(1)ELSE archiveoperation(logonarchivecode,dbsicherung);
+IF #quittung=endemeldung#endequittungdaCAND NOT errorTHEN anmeldetask:=
+dbsicherungELSE anmeldetask:=""FI FI ENDPROC archiveanmelden;PROC 
+archiveabmelden:IF anmeldetask<>""THEN archiveoperation(logoffarchivecode,
+anmeldetask);anmeldetask:=""FI ENDPROC archiveabmelden;PROC meldungquittieren
+(BOOL CONST b):BOUND BOOL VAR boolds;forget(ds);ds:=nilspace;boolds:=ds;
+boolds:=b;send(/dbsicherung,yescode,ds);forget(ds);IF bTHEN enter(1)ELSE 
+standardmeldung(inkonsicherung,"");archiveabmelden;#enter(2)#return(2)FI 
+ENDPROC meldungquittieren;PROC bestimmendersicherungstask:
+eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1)
+FI ENDPROC bestimmendersicherungstask;PROC sicherungsloop:TASK VAR 
+sendingtask;endequittungda:=FALSE ;REP wartenaufnaechstesendung;SELECT 
+quittungOF CASE yescode:questionCASE outcode:meldenCASE endemeldung:beenden
+CASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT ;PER .question:
+message:=ds;melde(frage(message));LEAVE sicherungsloop.melden:message:=ds;
+standardmeldung(message,"");#wartenaufnaechstesendung#.
+wartenaufnaechstesendung:REP forget(ds);wait(ds,quittung,sendingtask);IF NOT 
+(sendingtask=dbsicherungstask)THEN sendnakELSE LEAVE wartenaufnaechstesendung
+FI PER .beenden:standardmeldung(meldnr,"");archiveabmelden;stufe:=1;return(1)
+;endequittungda:=TRUE ;LEAVE sicherungsloop.meldnr:SELECT letzterauftragscode
+OF CASE dbvomserver,dbaufdisk:sichernkorrektCASE dbzumserver,dbvondisk:
+ladenkorrektOTHERWISE :opkorrektENDSELECT .fehlermelden:message:=ds;
+standardmeldung(message,"");archiveabmelden;error:=TRUE ;stufe:=1;return(1);
+LEAVE sicherungsloop.unknowncode:standardmeldung(unbekanntercode,"");stufe:=1
+;return(1);LEAVE sicherungsloop.sendnak:send(sendingtask,nak,ds).ENDPROC 
+sicherungsloop;END PACKET sicherungsmonitor
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung
new file mode 100644
index 0000000..1ebb1eb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung
@@ -0,0 +1,35 @@
+PACKET ispstandardmaskenbehandlungDEFINES schulkenndatum,
+standardkopfmaskeinitialisieren,standardkopfmaskeausgeben,
+standardkopfmaskeaktualisieren,setzeschulnamen,leseschulnamen:LET maskenname=
+"mu standardkopf",fnrsystem=2,fnrschule=3,fnrdatum=4,fnrversion=5,fnrtitel=6,
+fnrzeit=7;TAG VAR maske;#LET s2="Schulname";#TEXT VAR schuldaten:="";TEXT 
+VAR zeileschulname:="";TEXT VAR systemname:="";PROC 
+standardkopfmaskeinitialisieren(TEXT CONST system):setzeschulnamen(
+zeileschulname);systemname:=system;initmaske(maske,maskenname)END PROC 
+standardkopfmaskeinitialisieren;PROC standardkopfmaskeausgeben(TEXT CONST 
+programmname):TEXT VAR hilfe;hilfe:=systemname;zentrieretext(maske,hilfe,
+fnrsystem);fill(maske,hilfe,fnrsystem);fill(maske,schulisversion,fnrversion);
+fill(maske,date,fnrdatum);fill(maske,timeofday,fnrzeit);hilfe:=programmname;
+zentrieretext(maske,hilfe,fnrtitel);fill(maske,hilfe,fnrtitel);hilfe:=
+zeileschulname;zentrieretext(maske,hilfe,fnrschule);fill(maske,hilfe,
+fnrschule);show(maske).END PROC standardkopfmaskeausgeben;PROC 
+standardkopfmaskeaktualisieren(TEXT CONST programmname):TEXT VAR hilfe;put(
+maske,timeofday,fnrzeit);hilfe:=programmname;zentrieretext(maske,hilfe,
+fnrtitel);put(maske,hilfe,fnrtitel);END PROC standardkopfmaskeaktualisieren;
+PROC standardkopfmaskeaktualisieren:put(maske,timeofday,fnrzeit);END PROC 
+standardkopfmaskeaktualisieren;TEXT PROC leseschulnamen:zeileschulname
+ENDPROC leseschulnamen;PROC setzeschulnamen(TEXT CONST schulname):
+zeileschulname:=schulnameENDPROC setzeschulnamen;TEXT PROC schulkenndatum(
+TEXT CONST schluessel):LET schulkenndaten="c02 schulkenndaten";systemdboff;
+inittupel(dnrschluessel);putwert(fnrschlsachgebiet,schulkenndaten);putwert(
+fnrschlschluessel,schluessel);search(dnrschluessel,TRUE );IF dbstatus=okTHEN 
+schuldaten:=wert(fnrschllangtext)ELSE schuldaten:=""FI ;schuldatenENDPROC 
+schulkenndatum;PROC zentrieretext(TAG CONST maske,TEXT VAR text,INT CONST 
+feld):INT VAR leerlaenge;TEXT VAR leertext;LET leerzeichen=" ";leerlaenge:=(
+length(maske,feld)-length(text));IF (leerlaenge>0)THEN leertext:=(leerlaenge
+DIV 2)*leerzeichen;text:=leertext+text+leertext;IF (leerlaengeMOD 2<>0)THEN 
+text:=text+leerzeichenFI ;FI ;END PROC zentrieretext;END PACKET 
+ispstandardmaskenbehandlung;oeffnedatenbank(schulisdbname);setzeschulnamen(
+schulkenndatum("Schulname"));setzeschulisversion("2.2.1");
+standardkopfmaskeinitialisieren("schulis")
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung
new file mode 100644
index 0000000..8b2f189
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung
@@ -0,0 +1,236 @@
+PACKET systembaumbearbeitungneuDEFINES loescheteilbaeume,
+teilbaeumeaussystembaum,uebersetze:LET dp=":",refinementende=".";LET grenze=6
+;LET fehldat="Übersetzungsfehler:";FILE VAR quelle;KNOTENMENGE VAR ang,nach;
+TEXT VAR newsymbol:="";INT VAR newkind;TEXT VAR aktzeile:="";INT VAR 
+zeilenindex;ROW grenzeTEXT VAR at;FILE VAR f;INT CONST maxat:=6,tepos:=1,mpos
+:=2,vpos:=3,npos:=4,tpos:=5,ppos:=6;LET normkz="0",refkz="1";LET scanende=7,
+scanbold=2,scantext=4,scandel=6,scannumber=3,scanid=1;TEXT PROC attribute(
+KNOTEN CONST k):TEXT VAR attr;read(k,attr);attrEND PROC attribute;BOOL PROC 
+isrefinement(KNOTEN CONST k):(subtext(attribute(k),1,1)=refkz)END PROC 
+isrefinement;BOOL PROC isnormal(KNOTEN CONST k):(subtext(attribute(k),1,1)=
+normkz)END PROC isnormal;BOOL PROC isopen(KNOTEN CONST k):NOT (isrefinement(k
+)COR isnormal(k))END PROC isopen;PROC mengedernachfolger(KNOTEN CONST k,
+KNOTENMENGE VAR m):read(k,m)END PROC mengedernachfolger;PROC 
+neuenachfolgermenge(KNOTEN CONST k,KNOTENMENGE CONST m):write(k,m)END PROC 
+neuenachfolgermenge;PROC loescheteilbaeume(TEXT CONST datnam,BOOL VAR 
+gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL VAR )loesche,
+gefunden)END PROC loescheteilbaeume;PROC teilbaeumeaussystembaum(TEXT CONST 
+datnam,BOOL VAR gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL 
+VAR )retranslate,gefunden)END PROC teilbaeumeaussystembaum;PROC 
+bearbeiteteilbaeume(TEXT CONST datnam,PROC (TEXT CONST ,BOOL VAR )behandle,
+BOOL VAR gefunden):ersterteilbaum;WHILE weitereteilbaeumeREP behandleteilbaum
+;naechsterteilbaumPER .behandleteilbaum:behandle(teilbaumname,gefunden);IF 
+NOT gefundenTHEN line(f,2);putline(f,"(* Teilbaum "+teilbaumname+
+" existiert nicht *)");FI ;nextsymbol(newsymbol,typ).ersterteilbaum:f:=
+sequentialfile(input,datnam);TEXT VAR liste;getline(f,liste);forget(datnam,
+quiet);f:=sequentialfile(output,datnam);scan(liste);naechsterteilbaum.
+naechsterteilbaum:TEXT VAR teilbaumname;INT VAR typ;nextsymbol(teilbaumname,
+typ).weitereteilbaeume:typ<>scanende.END PROC bearbeiteteilbaeume;PROC 
+loesche(TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefunden
+THEN loeschediesenFI .sucheteilbaum:KNOTEN VAR teilbaumref;gefunden:=
+existiert(exporte,teilbaumref,teilbaumname).loeschediesen:#loescheunterbaum(
+teilbaumref);KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r
+:=erster(g);IF gueltig(r)THEN knotenloeschen(g,r)FI ;knotenloeschen(exporte,
+teilbaumref)#KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r
+:=erster(g);loescheunterbaum(teilbaumref);IF gueltig(r)THEN knotenloeschen(g,
+r)FI ;knotenloeschen(exporte,teilbaumref).END PROC loesche;PROC retranslate(
+TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefundenTHEN 
+schreibeteilbaumname;durchlaufeteilbaum;schreibeteilbaumendeFI .sucheteilbaum
+:KNOTEN VAR teilbaumref;gefunden:=existiert(exporte,teilbaumref,teilbaumname)
+.schreibeteilbaumname:putline(f,attribute(teilbaumref)+dp).
+schreibeteilbaumende:putline(f,refinementende).durchlaufeteilbaum:
+KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);ausbaum(erster(g),1).END 
+PROC retranslate;PROC ausbaum(KNOTEN CONST k,INT CONST stufe):stufennummer;
+IF istnochnichtdefiniertTHEN refinementnameschreiben;
+nochnichtdefiniertschreibenELIF istrefinementTHEN 
+refinementsuchenundschreibenELSE notierediesen;durchlaufeallesoehneFI .
+istrefinement:(isrefinement(k))CAND (stufe>1).istnochnichtdefiniert:isopen(k)
+.notierediesen:elemente(k,vorschub,zeile).stufennummer:TEXT VAR vorschub:=
+stufe*" ";TEXT VAR zeile:=vorschub+text(stufe);vorschub:=vorschub+"  ".
+refinementnameschreiben:KNOTEN VAR knoten:=k;refinementname.refinementname:
+put(f,zeile+" "+attribute(knoten));line(f).nochnichtdefiniertschreiben:put(f,
+vorschub+"  (* ist noch nicht definiert *)");line(f).
+refinementsuchenundschreiben:read(k,knoten);refinementname.
+durchlaufeallesoehne:KNOTENMENGE VAR soehne;mengedernachfolger(k,soehne);
+KNOTEN VAR sohn:=erster(soehne);WHILE gueltig(sohn)REP ausbaum(sohn,stufe+1);
+naechster(sohn,soehne)PER .END PROC ausbaum;PROC elemente(KNOTEN CONST k,
+TEXT CONST vorschub,TEXT CONST zeil):TEXT VAR at,zeile:=zeil;tex;mask;vorproz
+;nachproz;tast;prozess;absatz.tex:zeile:=zeile+" TEXT """+text(k)+"""";put(f,
+zeile).mask:at:=maske(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+
+"MASKE """+at+"""";put(f,zeile)FI .prozess:at:=task(k);IF at<>""THEN put(f,
+";");line(f);zeile:=vorschub+"TASK """+at+"""";put(f,zeile)FI .vorproz:at:=
+vorprozedur(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+"> "+at;put(f
+,zeile)FI .nachproz:at:=nachprozedur(k);IF at<>""THEN put(f,";");line(f);
+zeile:=vorschub+"< "+at;put(f,zeile)FI .tast:at:=taste(k);IF at<>""THEN put(f
+,";");line(f);zeile:=vorschub+"TASTE """+at+"""";put(f,zeile)FI .absatz:line(
+f).END PROC elemente;TEXT PROC maske(KNOTEN CONST k):attribut(k,mpos)END 
+PROC maske;TEXT PROC task(KNOTEN CONST k):attribut(k,ppos)END PROC task;TEXT 
+PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)END PROC vorprozedur;TEXT 
+PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)END PROC nachprozedur;TEXT 
+PROC taste(KNOTEN CONST k):attribut(k,tpos)END PROC taste;TEXT PROC attribut(
+KNOTEN CONST k,INT CONST i):TEXT VAR attext;attext:=attribute(k);TEXT VAR 
+amuster:="��",emuster:="��";replace(amuster,1,i);replace(emuster,1,i+1);INT 
+VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i<maxatTHEN ende:=pos(attext
+,emuster,anfang)-1;subtext(attext,anfang,ende)ELSE subtext(attext,anfang)FI 
+END PROC attribut;TEXT PROC text(KNOTEN CONST k):attribut(k,tepos)END PROC 
+text;OP HAT (KNOTEN CONST k,TEXT CONST t):write(k,t)END OP HAT ;OP NACH (
+KNOTEN CONST sohn,vater):KNOTENMENGE VAR m;mengedernachfolger(vater,m);
+inknotenmenge(m,sohn);write(vater,m);END OP NACH ;OP BEZUG (KNOTEN CONST sohn
+,KNOTEN CONST vater):write(sohn,vater);END OP BEZUG ;BOOL PROC schluss:
+dateiendeCOR is(refinementende)END PROC schluss;BOOL PROC dateiende:(newkind=
+scanende)CAND eof(quelle)END PROC dateiende;BOOL PROC isrand:(schlussCOR 
+isnumber)END PROC isrand;BOOL PROC is(TEXT CONST t):(t=newsymbol)END PROC is;
+BOOL PROC isbold:(newkind=scanbold)END PROC isbold;BOOL PROC iskeybold:(is(
+"TEXT")OR is(">")OR is("<")OR is("MASKE")OR is("TASTE")OR is("TASK"))END 
+PROC iskeybold;BOOL PROC istext:(newkind=scantext)END PROC istext;BOOL PROC 
+isdelimiter:(newkind=scandel)END PROC isdelimiter;BOOL PROC isprocedure(TEXT 
+VAR t):IF NOT isidTHEN FALSE ELSE t:=newsymbol;next;IF is("(")THEN INT VAR 
+klammernzaehler:=0;REP IF is("(")THEN klammernzaehlerINCR 1ELIF is(")")THEN 
+klammernzaehlerDECR 1FI ;IF istextTHEN t:=t+""""+newsymbol+""""ELSE t:=t+
+newsymbolFI ;nextUNTIL (klammernzaehler=0)PER FI ;is(";")COR israndFI END 
+PROC isprocedure;BOOL PROC isnumber:(newkind=scannumber)END PROC isnumber;
+BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(newsymbol,
+newkind);WHILE (newkind=scanende)CAND (NOT eof(quelle))REP getline(quelle,
+aktzeile);continuescan(aktzeile);aktuellezeile;nextsymbol(newsymbol,newkind);
+PER ;END PROC next;PROC lies(TEXT CONST t):IF NOT (t=newsymbol)THEN fehler(t)
+ELSE nextFI END PROC lies;PROC fehler(TEXT CONST f):FILE VAR fd:=
+sequentialfile(output,fehldat);TEXT VAR t:="Fehler bei : """;t:=t+newsymbol+
+""" in Zeile "+text(zeilenindex)+" , ";line(fd,5);putline(fd,t);t:=
+"denn erwartet wurde: """;t:=t+f;t:=t+"""   ";putline(fd,t);close(fd);stop
+END PROC fehler;PROC initparser:initscanner;END PROC initparser;PROC 
+initscanner:getline(quelle,aktzeile);scan(aktzeile);page;cursor(1,3);put(
+"Bearbeitet wird zur Zeit Zeile: ");zeilenindex:=1;aktuellezeile;END PROC 
+initscanner;PROC aktuellezeile:cursor(33,3);put(zeilenindex);zeilenindexINCR 
+1;END PROC aktuellezeile;PROC systembaum:enablestop;initparser;
+initialisieretemporaeregruppen;next;REP benannterteilbaum;nextUNTIL dateiende
+PER ;meldesyntaxkorrekt;uebernehmeindenbestand.initialisieretemporaeregruppen
+:ang:=leereknotenmenge;nach:=leereknotenmenge.meldesyntaxkorrekt:line(5);put(
+"   *  *  *   E i n g a b e   i s t   k o r r e k t   *  *  * ");line(5);put(
+" *  *  *   Ü b e r n a h m e   i n   M e n ü b a u m  *  *  * ").END PROC 
+systembaum;PROC benannterteilbaum:IF NOT isidTHEN fehler("Teilbaumname")FI ;
+erzeugeangebotsundsystemknotenaunds;next;baum(s);sistnachfolgervona;
+aistbezugsknotenvons.erzeugeangebotsundsystemknotenaunds:KNOTEN VAR a:=
+neuerknoten(ang);aHAT newsymbol;KNOTEN VAR s:=neuerknoten(system).
+sistnachfolgervona:sNACH a.aistbezugsknotenvons:sBEZUG a.END PROC 
+benannterteilbaum;PROC baum(KNOTEN VAR node):INT VAR i0;lies(":");IF NOT 
+isnumberTHEN fehler("Stufennummer")FI ;i0:=int(newsymbol);next;
+knotenattribute(node);zeigerefinementan;unterbaum(i0,node).zeigerefinementan:
+TEXT VAR t:=attribute(node);replace(t,1,"1");nodeHAT t.END PROC baum;PROC 
+unterbaum(INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT 
+isnumberTHEN IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE 
+unterbaumFI FI ;IF j>=kTHEN LEAVE unterbaumFI ;next;erzeugeneuensohns;
+dieseristinsystemnachfolgervonnode;sohn(k,s,node);soehne(k,node).
+erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system).
+dieseristinsystemnachfolgervonnode:sNACH node.END PROC unterbaum;PROC soehne(
+INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT isnumberTHEN 
+IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE soehneFI FI ;
+IF j>kTHEN LEAVE soehneFI ;IF NOT (j=k)THEN fehler("gleiche Stufennummer")FI 
+;next;erzeugeneuensohns;dieseristinsystemnachfolgervonnode;sohn(j,s,node);
+soehne(j,node).erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system).
+dieseristinsystemnachfolgervonnode:sNACH node.END PROC soehne;PROC sohn(INT 
+CONST k,KNOTEN VAR node,vater):IF iskeyboldTHEN knotenattribute(node);
+unterbaum(k,node)ELSE IF NOT isidTHEN fehler(
+"ein Teilbaumname oder Schlüsselwort")ELSE erzeugeneuenachfrageninnach;
+setzevateralsnachfolgervonn;next;FI FI .erzeugeneuenachfrageninnach:KNOTEN 
+VAR n:=neuerknoten(nach,newsymbol).setzevateralsnachfolgervonn:IF sohnvon(n,
+vater)THEN fehler(newsymbol+" nur einmal als Sohn auf Level "+text(k))FI ;
+vaterNACH n;nodeHAT newsymbol.END PROC sohn;PROC knotenattribute(KNOTEN VAR 
+node):initialisierehilfsvariablen;TEXT VAR t;attribut;WHILE iskeyboldREP 
+attributPER ;IF ((NOT isnumber)CAND (NOT schluss))THEN fehler(
+"Attribut oder Stufennummer")ELSE abschliessendebehandlungFI .
+initialisierehilfsvariablen:INT VAR i:=0;t:="0";FOR iFROM 1UPTO maxatREP at(i
+):=""PER .abschliessendebehandlung:merke(t);nodeHAT t.END PROC 
+knotenattribute;PROC attribut:TEXT VAR procname;IF is("TEXT")THEN next;IF 
+NOT istextTHEN fehler("ein Menuetext")FI ;setze(newsymbol,tepos);next;IF NOT 
+israndTHEN lies(";")FI ELSE IF is(">")THEN next;IF NOT isprocedure(procname)
+THEN fehler("ein Vor-Prozedur-Aufruf")FI ;setze(procname,vpos);IF NOT isrand
+THEN nextFI ELSE IF is("<")THEN next;IF NOT isprocedure(procname)THEN fehler(
+"ein Nach-Prozedur-Aufruf")FI ;setze(procname,npos);IF NOT israndTHEN nextFI 
+ELSE IF is("MASKE")THEN next;IF NOT istextTHEN fehler("ein Maskenname")FI ;
+setze(newsymbol,mpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASTE")
+THEN next;IF NOT istextTHEN fehler("ein Funktionstastenname")FI ;setze(
+newsymbol,tpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASK")THEN 
+next;IF NOT istextTHEN fehler("ein Taskname")FI ;setze(newsymbol,ppos);next;
+IF NOT israndTHEN lies(";")FI ELSE fehler("ein Schlüsselwort")FI FI FI FI FI 
+FI END PROC attribut;PROC setze(TEXT CONST t,INT CONST i):at(i):=tEND PROC 
+setze;PROC merke(TEXT VAR t):INT VAR i;TEXT VAR muster:="��";FOR iFROM 1UPTO 
+maxatREP replace(muster,1,i);tCAT muster;tCAT at(i)PER END PROC merke;PROC 
+uebersetze(TEXT CONST t,BOOL VAR fehler):quelle:=sequentialfile(input,t);INT 
+CONST azahl:=zahlderelemente(exporte),szahl:=zahlderelemente(system),nzahl:=
+zahlderelemente(importe);clearerror;disablestop;kopieresystembaum;systembaum;
+IF iserrorTHEN fehler:=TRUE ;setzesystembaumzurueck;LEAVE uebersetzeFI ;
+fehler:=FALSE ;line(3);put(
+" *  *  *   Ü b e r n a h m e   i s t   b e e n d e t  *  *  * ");line(2);
+statistik(azahl,szahl,nzahl);line(2);put(
+" *  *  *   D a t e n b a n k b e r e i n i g u n g   *  *  *  ");loesche;
+ueberschreibesystembaumEND PROC uebersetze;PROC statistik(INT CONST az,sz,nz)
+:INT CONST agesz:=zahlderelemente(exporte),sgesz:=zahlderelemente(system),
+ngesz:=zahlderelemente(importe);put("Zahl der Systembaumknoten insgesamt: ");
+put(sgesz);INT CONST sdif:=sgesz-sz,ndif:=ngesz-nz;line;IF sdif<0THEN put(
+"Entfernte Systemknoten: "+text(-sdif));ELSE put(
+"Neu erzeugte Systemknoten: "+text(sdif));FI ;line;put(
+"Neu definierte Teilbäume: "+text(agesz-az));line;IF ndif<0THEN put(
+"Abgedeckte Teilbaumreferenzen: "+text(-ndif))ELSE put(
+"Zusätzliche offene Teilbaumreferenzen: "+text(ndif))FI END PROC statistik;
+PROC loesche:knotenmengeloeschen(ang);knotenmengeloeschen(nach)END PROC 
+loesche;OP VEREINIGT (KNOTENMENGE VAR a,KNOTENMENGE CONST b):KNOTEN VAR k:=
+erster(b);WHILE gueltig(k)REP a+k;naechster(k,b)PER ;END OP VEREINIGT ;OP +(
+KNOTENMENGE VAR a,KNOTEN CONST b):inknotenmenge(a,b);END OP +;PROC 
+uebernehmeindenbestand:startepruefungmitneu;WHILE gueltig(neu)REP 
+pruefenderexporte;IF schondaTHEN aenderungELSE neuanlegenFI PER ;
+abgleichenvonexportenundimporten.startepruefungmitneu:KNOTEN VAR neu:=erster(
+ang);KNOTEN VAR alt;BOOL VAR gleich.pruefenderexporte:gleich:=existiert(
+exporte,alt,attribute(neu)).schonda:gleich.aenderung:
+loeschealleknotendesaltenrefinements;neuanlegenbisaufdenursprung.
+loeschealleknotendesaltenrefinements:rettebisherigenursprung;
+gehevomursprungausundloescheallesausserrefinements.rettebisherigenursprung:
+KNOTENMENGE VAR u;mengedernachfolger(alt,u);KNOTEN VAR ursprung:=erster(u).
+gehevomursprungausundloescheallesausserrefinements:loescheunterbaum(ursprung)
+.neuanlegenbisaufdenursprung:raufnachfolgervonneusetzen;
+derursprungwirdueberschrieben.raufnachfolgervonneusetzen:KNOTENMENGE VAR root
+;KNOTEN VAR r;mengedernachfolger(neu,root);r:=erster(root).
+derursprungwirdueberschrieben:move(r,ursprung);knotenloeschen(root,r);
+knotenloeschen(ang,neu).neuanlegen:inknotenmenge(exporte,neu,alt);
+ausknotenmenge(ang,neu).abgleichenvonexportenundimporten:KNOTENMENGE VAR 
+abzudeckendenachfragen;KNOTENMENGE VAR nachfragesoehne;BOOL VAR gibtes;TEXT 
+VAR importname;KNOTEN VAR importeinordner,importbezug;festimport:=erster(
+importe);WHILE gueltig(festimport)REP importname:=attribute(festimport);
+abgleichmitimporten;abgleichabschlussPER ;KNOTEN VAR aktimport:=erster(nach);
+WHILE gueltig(aktimport)REP importname:=attribute(aktimport);
+versucheabgleichmitexporten;IF gelungenTHEN importbezug:=aktimport;
+fuehreabgleichmitexportendurch;knotenloeschen(nach,aktimport)ELSE gibtes:=
+existiert(importe,importeinordner,importname);inknotenmenge(importe,aktimport
+,importeinordner);ausknotenmenge(nach,aktimport)FI ;PER .abgleichabschluss:
+versucheabgleichmitexporten;IF gelungenTHEN importbezug:=festimport;
+fuehreabgleichmitexportendurch;knotenloeschen(importe,festimport)ELSE 
+naechster(festimport,importe)FI .versucheabgleichmitexporten:KNOTEN VAR 
+aktexport;BOOL VAR gelungen;gelungen:=existiert(exporte,aktexport,importname)
+.abgleichmitimporten:KNOTEN VAR festimport;gelungen:=existiert(nach,aktimport
+,importname);IF gelungenTHEN verschmelzung;knotenloeschen(nach,aktimport)FI .
+verschmelzung:KNOTENMENGE VAR nfa;mengedernachfolger(aktimport,nfa);
+KNOTENMENGE VAR nfn;mengedernachfolger(festimport,nfn);nfnVEREINIGT nfa.
+fuehreabgleichmitexportendurch:finderefinementwurzel;
+markiererefinementalsbenutzt;sammlenachfragen;WHILE nochimbereichREP 
+deckenachfrageabPER .finderefinementwurzel:KNOTEN VAR refinementwurzel;
+KNOTENMENGE VAR exportiertesrefinement;mengedernachfolger(aktexport,
+exportiertesrefinement);refinementwurzel:=erster(exportiertesrefinement).
+markiererefinementalsbenutzt:write(aktexport,markierungsknoten).
+sammlenachfragen:mengedernachfolger(importbezug,abzudeckendenachfragen);
+KNOTEN VAR behandelterimport:=erster(abzudeckendenachfragen).nochimbereich:
+gueltig(behandelterimport).naechsterimport:naechster(behandelterimport,
+abzudeckendenachfragen).deckenachfrageab:findeungesaettigtensohn;IF gueltig(
+zuersetzendersohn)THEN ersetzediesendurchrefinement;naechsterimportELSE 
+ausknotenmenge(abzudeckendenachfragen,behandelterimport)FI .
+findeungesaettigtensohn:KNOTEN VAR zuersetzendersohn;mengedernachfolger(
+behandelterimport,nachfragesoehne);zuersetzendersohn:=erster(nachfragesoehne)
+;WHILE gueltig(zuersetzendersohn)CAND nochnichtgefundenREP naechster(
+zuersetzendersohn,nachfragesoehne)PER .nochnichtgefunden:(NOT isopen(
+zuersetzendersohn))COR (NOT (attribute(zuersetzendersohn)=attribute(
+importbezug))).ersetzediesendurchrefinement:knotenloeschen(nachfragesoehne,
+zuersetzendersohn);inknotenmenge(nachfragesoehne,refinementwurzel,
+zuersetzendersohn).END PROC uebernehmeindenbestand;PROC loescheunterbaum(
+KNOTEN CONST node):KNOTENMENGE VAR m;mengedernachfolger(node,m);KNOTEN VAR k
+:=erster(m);WHILE gueltig(k)REP IF NOT isrefinement(k)THEN loescheunterbaum(k
+);knotenloeschen(m,k)ELSE ausknotenmenge(m,k);FI PER END PROC 
+loescheunterbaum;END PACKET systembaumbearbeitungneu;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumeditor b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor
new file mode 100644
index 0000000..ffd3b6c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor
@@ -0,0 +1,72 @@
+PACKET systembaumeditorDEFINES startsystembaumeditor,aktuellensenamenlesen,
+baumausdatei,baumausdateizeigen,baumausdateiuebersetzen,
+systembaumreorganisieren,listederteilbaumdateien,listederteilbaeume,
+erwartereaktion,baumaendern,baumloeschen,eingangsbildschirmherstellen,
+internenbaumzeigen,internenbaumuebersetzen:LET z="Teilbaumliste",trenner=",",
+praefix="b.",standardanfang=2,maxfelder=10,reorg=0,dummy="dummy",baumdatei=1,
+teilbaeume=2,maskese1="mb baumdateibearbeitung",maskese2=
+"mb teilbaumbearbeitung",maxnamenlaenge=32,fehldat="Übersetzungsfehler:";;
+BOOL VAR fehler:=FALSE ;FILE VAR f;TEXT VAR namen:="";TEXT VAR dnam:="";;TAG 
+VAR aktuellemaske;INT VAR aktuelleposition;ROW 100TEXT VAR feld;INT VAR prog,
+teilbaumzahl;init(feld);PROC startsystembaumeditor(INT CONST kennung):
+werbinich;frageentwicklernachdemnamen;aktuellensenamenlesen.werbinich:TEXT 
+VAR maskenname;SELECT kennungOF CASE baumdatei:maskenname:=maskese1CASE 
+teilbaeume:maskenname:=maskese2END SELECT ;prog:=kennung.
+frageentwicklernachdemnamen:page;IF exists(dnam)THEN forget(dnam,quiet)FI ;
+IF exists(namen)THEN rename(namen,praefix+namen)FI ;aktuelleposition:=
+standardanfang;standardkopfmaskeausgeben(text(vergleichsknoten));initmaske(
+aktuellemaske,maskenname);show(aktuellemaske).END PROC startsystembaumeditor;
+PROC aktuellensenamenlesen:putget(aktuellemaske,feld,aktuelleposition);namen
+:=eingegebenenamen;loeschemeldung(aktuellemaske).END PROC 
+aktuellensenamenlesen;PROC baumausdatei:IF namen=""THEN melde(aktuellemaske,
+43);return(1)ELSE IF istree(namen)THEN meldeohneb;return(1)ELSE f:=
+sequentialfile(output,praefix+namen);close(f);baumausdateizeigenFI FI .
+meldeohneb:melde(aktuellemaske,44).END PROC baumausdatei;PROC 
+baumausdateizeigen:store(FALSE );page;TEXT VAR t:=praefix+namen;IF exists(t)
+THEN rename(t,namen)FI ;IF exists(fehldat)THEN forget(fehldat,quiet)FI ;
+editiere(namen,"ae",FALSE );store(TRUE )END PROC baumausdateizeigen;PROC 
+systembaumreorganisieren:FILE VAR f:=sequentialfile(output,dummy);close(f);
+dnam:=dummy;baumverarbeitung(dnam,reorg);eingangsbildschirmherstellen(1)END 
+PROC systembaumreorganisieren;PROC baumausdateiuebersetzen:translate(namen,
+fehler);rename(namen,praefix+namen);IF fehlerTHEN erwartereaktionELSE 
+eingangsbildschirmherstellen(2)FI END PROC baumausdateiuebersetzen;PROC 
+baumaendern:baumbearbeiten(1)END PROC baumaendern;PROC baumloeschen:
+baumbearbeiten(2)END PROC baumloeschen;PROC baumbearbeiten(INT CONST wie):
+TEXT VAR t:="";meldesuche;dnam:=subtext(namen,1,maxnamenlaenge);t:=
+bearbeitung(namen,wie);IF (t="")CAND teilbaumzahl=1THEN meldemisserfolg;
+return(1)ELSE loeschemeldung(aktuellemaske);IF loeschenundkeinfehlerTHEN 
+eingangsbildschirmherstellen(1);meldeloeschungELSE internenbaumzeigenFI FI .
+meldesuche:melde(aktuellemaske,24).meldemisserfolg:melde(aktuellemaske,25).
+meldeloeschung:melde(aktuellemaske,51).loeschenundkeinfehler:(wie=2)AND (t<>
+"").END PROC baumbearbeiten;PROC internenbaumzeigen:IF exists(fehldat)THEN 
+forget(fehldat,quiet)FI ;store(FALSE );page;editiere(dnam,"a",FALSE );store(
+TRUE )END PROC internenbaumzeigen;PROC internenbaumuebersetzen:store(FALSE );
+translate(dnam,fehler);store(TRUE );IF fehlerTHEN erwartereaktionELSE 
+eingangsbildschirmherstellen(2)FI END PROC internenbaumuebersetzen;PROC 
+listederteilbaeume:meldezusammenstellung;transactionlistederteilbaeume;
+zeigenderteilbaumliste.meldezusammenstellung:melde(aktuellemaske,7).END PROC 
+listederteilbaeume;PROC listederteilbaumdateien:melde(aktuellemaske,7);FILE 
+VAR f;f:=sequentialfile(output,z);line(f);beginlist;TEXT VAR s:="",t:=" ";
+REP getlistentry(s,t);IF istree(s)THEN put(f,t);put(f,s);line(f)FI UNTIL t=""
+PER ;close(f);sort(z);zeigenderteilbaumliste.END PROC listederteilbaumdateien
+;BOOL PROC istree(TEXT VAR t):INT VAR i;i:=pos(t,praefix);IF i>0THEN t:=3*" "
++subtext(t,i+2,length(t))FI ;i>0END PROC istree;PROC zeigenderteilbaumliste:
+page;editiere(z)END PROC zeigenderteilbaumliste;PROC erwartereaktion:store(
+FALSE );page;store(TRUE );IF fehlerTHEN editiere(fehldat,"a")FI ;END PROC 
+erwartereaktion;PROC transactionlistederteilbaeume:f:=sequentialfile(output,z
+);TEXT VAR dateiname:=z;baumverarbeitung(dateiname,1)END PROC 
+transactionlistederteilbaeume;PROC translate(TEXT CONST t,BOOL VAR b):TEXT 
+VAR dateiname:=t;baumverarbeitung(dateiname,2);b:=(dateiname<>t)END PROC 
+translate;TEXT PROC bearbeitung(TEXT CONST t,INT CONST wie):f:=sequentialfile
+(output,dnam);putline(f,t);TEXT VAR dateiname:=dnam;INT VAR methode:=2+wie;
+IF teilbaumzahl>1THEN methodeINCR 2FI ;baumverarbeitung(dateiname,methode);
+dateinameEND PROC bearbeitung;PROC eingangsbildschirmherstellen(INT CONST i):
+reorganizescreen;return(i);IF exists(dnam)THEN forget(dnam,quiet)FI ;
+standardkopfmaskeaktualisierenEND PROC eingangsbildschirmherstellen;TEXT 
+PROC eingegebenenamen:IF prog=baumdateiTHEN teilbaumzahl:=1;feld(
+standardanfang)ELSE teilbaumzahl:=0;INT VAR i;TEXT VAR t:="";FOR iFROM 
+standardanfangUPTO maxfelderREP IF feld(i)<>""THEN teilbaumzahlINCR 1;IF t<>
+""THEN tCAT trennerFI ;tCAT feld(i)FI PER ;tFI END PROC eingegebenenamen;
+PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP feld(i):=""
+PER END PROC init;END PACKET systembaumeditor;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet
new file mode 100644
index 0000000..0e8b352
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet
@@ -0,0 +1,13 @@
+PACKET zusatzarchivepacketDEFINES yes,out,show,ordertask:LET yescode=10,
+outcode=11,showcode=12;TASK VAR ordert:=niltask;BOUND BOOL VAR boolds;BOUND 
+TEXT VAR textds;#BOUND FILE VAR fileds;#DATASPACE VAR ds;INT VAR replycode;
+PROC ordertask(TASK CONST ot):ordert:=otENDPROC ordertask;TASK PROC ordertask
+:ordertENDPROC ordertask;BOOL PROC yes(TEXT CONST quest):BOOL VAR b;initds;
+textds:=ds;textds:=quest;call(ordertask,yescode,ds,replycode);IF replycode=
+yescodeTHEN ordentlichesendungELSE FALSE FI .ordentlichesendung:boolds:=ds;b
+:=CONCR (boolds);forget(ds);b.ENDPROC yes;PROC out(TEXT CONST txt):initds;
+textds:=ds;textds:=txt;send(ordertask,outcode,ds,replycode)ENDPROC out;PROC 
+show(TEXT CONST t):forget(ds);ds:=old(t);send(ordertask,showcode,ds,replycode
+)ENDPROC show;PROC initds:forget(ds);ds:=nilspaceENDPROC initds;ENDPACKET 
+zusatzarchivepacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/konvert b/app/baisy/2.2.1-schulis/src/konvert
new file mode 100644
index 0000000..098e253
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/konvert
@@ -0,0 +1,18 @@
+PACKET konvertDEFINES highbyte,lowbyte,word,changelowbyte,changehighbyte,dint
+,highword,lowword:INT PROC highbyte(INT CONST value):TEXT VAR x:="  ";replace
+(x,1,value);code(xSUB 2)END PROC highbyte;INT PROC lowbyte(INT CONST value):
+TEXT VAR x:="  ";replace(x,1,value);code(xSUB 1)END PROC lowbyte;INT PROC 
+word(INT CONST lowbyte,highbyte):TEXT CONST x:=code(lowbyte)+code(highbyte);x
+ISUB 1END PROC word;PROC changelowbyte(INT VAR word,INT CONST lowbyte):TEXT 
+VAR x:="  ";replace(x,1,word);replace(x,1,code(lowbyte));word:=xISUB 1END 
+PROC changelowbyte;PROC changehighbyte(INT VAR word,INT CONST highbyte):TEXT 
+VAR x:="  ";replace(x,1,word);replace(x,2,code(highbyte));word:=xISUB 1END 
+PROC changehighbyte;REAL PROC dint(INT CONST lowword,highword):reallowword+
+65536.0*realhighword.reallowword:real(lowbyte(lowword))+256.0*real(highbyte(
+lowword)).realhighword:real(lowbyte(highword))+256.0*real(highbyte(highword))
+.END PROC dint;INT PROC highword(REAL CONST doubleprecissionint):int(
+doubleprecissionint/65536.0)END PROC highword;INT PROC lowword(REAL CONST 
+doubleprecissionint):stringoflowbytesISUB 1.stringoflowbytes:code(int(
+doubleprecissionintMOD 256.0))+code(int((doubleprecissionintMOD 65536.0)/
+256.0)).END PROC lowword;END PACKET konvert;
+
diff --git a/app/baisy/2.2.1-schulis/src/log.eintrag b/app/baisy/2.2.1-schulis/src/log.eintrag
new file mode 100644
index 0000000..27dfea2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/log.eintrag
@@ -0,0 +1,14 @@
+PACKET logeintragDEFINES logeintrag:LET eintragtextorder=201,nak=1,
+logmanagername="LOG";INT VAR reply;BOUND TEXT VAR msg;PROC logeintrag(TEXT 
+CONST messagetext):INT VAR dummy;logeintrag(messagetext,dummy)END PROC 
+logeintrag;PROC logeintrag(TEXT CONST messagetext,INT VAR returncode):
+DATASPACE VAR ds:=nilspace;msg:=ds;CONCR (msg):=messagetext;logauftrag(
+eintragtextorder,ds,returncode);forget(ds).END PROC logeintrag;PROC 
+logauftrag(INT CONST opcode,DATASPACE VAR ds,INT VAR returncode):
+verschickeauftrag;bearbeiteggfantwort.verschickeauftrag:
+verschickeauftrageinmal;verschickeauftragggfnochmal.verschickeauftrageinmal:
+call(/logmanagername,opcode,ds,reply).verschickeauftragggfnochmal:WHILE 
+auftragnichtangenommenREPEAT pause(10);verschickeauftrageinmalEND REPEAT .
+auftragnichtangenommen:reply=nak.bearbeiteggfantwort:returncode:=reply.END 
+PROC logauftrag;END PACKET logeintrag
+
diff --git a/app/baisy/2.2.1-schulis/src/log.manager b/app/baisy/2.2.1-schulis/src/log.manager
new file mode 100644
index 0000000..d49e048
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/log.manager
@@ -0,0 +1,126 @@
+PACKET logmanagerDEFINES logmanager:LET zeilenwahl=10000,spaltenwahl=70;LET 
+maxzeilenprologdatei=4000;INT CONST logdateien:=max(2,zeilenwahlDIV 
+maxzeilenprologdatei+sign(zeilenwahlMOD maxzeilenprologdatei)),
+zeilenprologdatei:=zeilenwahlDIV logdateien,logzeilen:=zeilenprologdatei*
+logdateien,logspalten:=spaltenwahl,kritischelogzeilenanzahl:=(logzeilenDIV 5)
+*4;LET eintragfileorder=200,eintragtextorder=201,readloglimitsorder=202,
+logholenorder=301,gesichertvermerk=306,loeschenorder=307,ack=0,logack=7,
+letzteslogack=8,kritischegrenzeerreichtack=9,dateiexistiertnichtack=10,
+dateinichtgesichertack=11,meldungloggeloescht=" gelöscht",
+seitenwechselanweisung="",niltext="",zeilenproseite=60,nureinzeiligereintrag=
+1,maxlogdateien=8,vaterallerprivtasks="anwendung",logmanagername="LOG",
+lognamepre="logbuch.",lognamedatumzeittrenner="/",vonbistrenner="-",taskpre=
+", Task: ",terminalname=" Term.";BOUND TEXT VAR msg;FILE VAR logfile;
+DATASPACE VAR ds;INT CONST laengeseitenwechselanweisung:=LENGTH 
+seitenwechselanweisung;INT VAR seitenzeile,zeiger,ersteslog,letzteslog,
+benutztelogzeilen;TEXT VAR eintragssatz;INT VAR terminalnr;BOOL VAR 
+datumneuinlogschreiben:=TRUE ;LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt,
+zeilenkritisch),LDATEN =STRUCT (REAL von,bis,BOOL gesichert,INT zeilen),
+LOGBUCH =STRUCT (LDATEN daten,DATASPACE inhalt);ROW maxlogdateienLOGBUCH VAR 
+log;BOUND LLIMITS VAR loggrenzenmsg;PROC logmanager:enablestop;IF name(myself
+)<>logmanagernameTHEN renamemyself(logmanagername)END IF ;taskpassword("-");
+benutztelogzeilen:=0;initpacket;globalmanager(PROC (DATASPACE VAR ,INT CONST 
+,INT CONST ,TASK CONST )logmanagerfaenger).END PROC logmanager;PROC 
+logmanagerfaenger(DATASPACE VAR ds,INT CONST order,phase,TASK CONST ordertask
+):disablestop;logmanager(ds,order,phase,ordertask);trageggffehlermeldungein;
+enablestop.trageggffehlermeldungein:IF iserrorTHEN logeintrag(fehlermeldung)
+END IF .fehlermeldung:"Fehler: "+errormessage+" in Zeile "+text(errorline).
+END PROC logmanagerfaenger;PROC logmanager(DATASPACE VAR ds,INT CONST order,
+phase,TASK CONST ordertask):enablestop;IF order=eintragfileorderTHEN 
+nimmdateieintragvorELIF order=eintragtextorderTHEN nimmtexteintragvorELSE IF 
+istberechtigt(ordertask)THEN SELECT orderOF CASE readloglimitsorder:
+leseloggrenzenCASE logholenorder:logverschicken(ordertask)CASE 
+gesichertvermerk:vermerkesicherungCASE loeschenorder:loeschelogOTHERWISE 
+logeintrag(ordertask,"Falscher Auftrag für Task ""LOG"" von Task: "+name(
+ordertask))END SELECT ELSE logeintrag(ordertask,
+"Unberechtigter Logbuchzugriff von Task: "+name(ordertask))FI FI .
+nimmdateieintragvor:FILE VAR eintrag:=sequentialfile(input,ds);logeintrag(
+eintrag,ordertask);meldeeintrag.meldeeintrag:IF logbuchgroessekritischTHEN 
+send(ordertask,kritischegrenzeerreichtack,ds)ELSE send(ordertask,ack,ds)END 
+IF .logbuchgroessekritisch:benutztelogzeilen>=kritischelogzeilenanzahl.
+nimmtexteintragvor:msg:=ds;logeintrag(ordertask,CONCR (msg));meldeeintrag.
+vermerkesicherung:msg:=ds;zeiger:=ersteslog;WHILE logname(log[zeiger])<>
+CONCR (msg)AND zeiger<>letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[
+zeiger])<>CONCR (msg)THEN send(ordertask,dateiexistiertnichtack,ds)ELSE log[
+zeiger].daten.gesichert:=TRUE ;send(ordertask,ack,ds)FI .loeschelog:msg:=ds;
+zeiger:=ersteslog;WHILE logname(log[zeiger])<>CONCR (msg)AND zeiger<>
+letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[zeiger])<>CONCR (msg)
+THEN send(ordertask,dateiexistiertnichtack,ds)ELIF NOT log[zeiger].daten.
+gesichertTHEN send(ordertask,dateinichtgesichertack,ds)ELSE TEXT CONST 
+eintragstext:=logname(log[zeiger])+meldungloggeloescht;logbuchdateiloeschen(
+zeiger);logeintrag(ordertask,eintragstext);send(ordertask,ack,ds)FI .
+leseloggrenzen:forget(ds);ds:=nilspace;loggrenzenmsg:=ds;loggrenzenmsg.zeilen
+:=logzeilen;loggrenzenmsg.zeilenbenutzt:=benutztelogzeilen;loggrenzenmsg.
+zeilenkritisch:=kritischelogzeilenanzahl;send(ordertask,ack,ds).END PROC 
+logmanager;PROC logeintrag(FILE VAR eintrag,TASK CONST ordertask):
+bereiteeintragvor;schreibeeintrag.bereiteeintragvor:logeintragvorbereiten(
+ordertask,lines(eintrag));logeintragsimple(taskpre+name(ordertask),TRUE ).
+schreibeeintrag:WHILE nocheintragssaetzeREPEAT schreibeeintragssatzEND 
+REPEAT .nocheintragssaetze:NOT eof(eintrag).schreibeeintragssatz:getline(
+eintrag,eintragssatz);logeintragsimple(eintragssatz,FALSE ).END PROC 
+logeintrag;PROC seitenwechsel:seitenzeile:=0;putline(logfile,
+seitenwechselanweisung).END PROC seitenwechsel;PROC zeilenwechsel:seitenzeile
+INCR 1;line(logfile).END PROC zeilenwechsel;PROC logeintragvorbereiten(TASK 
+CONST task,INT CONST eintrzeilen):terminalnr:=channel(task);
+wechseledateiseiteoderzeile;IF date(logb.daten.bis)<>dateOR 
+datumneuinlogschreibenTHEN datumneuinlogschreiben:=FALSE ;zeilenwechsel;
+logeintragsimple(kennungen,FALSE )FI .wechseledateiseiteoderzeile:INT CONST 
+zeilen:=eintrzeilen+evtldatumszeile;IF dateiwechselerforderlichTHEN 
+wechseledateiELIF seitenwechselerforderlichTHEN bereiteseitenwechselvorEND 
+IF .dateiwechselerforderlich:zeilen+lines(logfile)>zeilenprologdatei.
+evtldatumszeile:IF date(logb.daten.bis)<>dateOR datumneuinlogschreibenTHEN 1
+ELSE 0FI .wechseledatei:logdateiwechsel.seitenwechselerforderlich:INT CONST 
+restzeilen:=zeilenproseite-seitenzeile;(zeilen>restzeilenCAND restzeilen<=5).
+bereiteseitenwechselvor:seitenwechsel.kennungen:date.END PROC 
+logeintragvorbereiten;PROC logeintragsimple(TEXT CONST eintragssatz,BOOL 
+CONST mitkennung):wechseleggfseiteoderzeile;nimmeintragvor;
+bringelogdatenaufneuestenstand.wechseleggfseiteoderzeile:IF seitenzeile=
+zeilenproseiteTHEN seitenwechselELIF seitenzeile>0THEN zeilenwechselELSE 
+seitenzeile:=1END IF .nimmeintragvor:put(logfile,subtext(ggfkennung+
+eintragssatz,1,logspalten)).ggfkennung:IF mitkennungTHEN timeofday+
+terminalname+text(terminalnr)+" "ELSE niltextEND IF .
+bringelogdatenaufneuestenstand:logb.daten.gesichert:=FALSE ;logb.daten.bis:=
+clock(1);logb.daten.zeilenINCR 1;benutztelogzeilenINCR 1.END PROC 
+logeintragsimple;PROC logeintrag(TEXT CONST zeile):logeintrag(myself,zeile).
+END PROC logeintrag;PROC logeintrag(TASK CONST task,TEXT CONST zeile):
+logeintragvorbereiten(task,nureinzeiligereintrag);logeintragsimple(zeile,
+TRUE ).END PROC logeintrag;PROC initpacket:initlogs;initlogdaten.initlogs:
+FOR zeigerFROM 1UPTO maxlogdateienREPEAT loesche(log[zeiger])END REPEAT .
+initlogdaten:ersteslog:=1;letzteslog:=1;logfileoeffnen;logeintrag(
+"Logbuch gestartet").END PROC initpacket;BOOL PROC istberechtigt(TASK CONST 
+ordertask):ordertask</vaterallerprivtasksEND PROC istberechtigt;PROC 
+logverschicken(TASK CONST ordertask):FILE VAR f;INT VAR reply:=0;
+verschickeersteslog;verschickealleweiterenlogs.verschickeersteslog:zeiger:=
+ersteslog;forget(ds);ds:=log[zeiger].inhalt;f:=sequentialfile(modify,ds);
+headline(f,logname(log[zeiger]));send(ordertask,letztesds,ds).
+verschickealleweiterenlogs:IF zeiger<>letzteslogTHEN REP zeiger:=next(zeiger)
+;forget(ds);ds:=log[zeiger].inhalt;f:=sequentialfile(modify,ds);headline(f,
+logname(log[zeiger]));call(ordertask,letztesds,ds,reply)UNTIL zeiger=
+letzteslogPER FI .letztesds:IF zeiger=letzteslogTHEN letzteslogackELSE logack
+END IF .END PROC logverschicken;PROC logbuchdateiloeschen(INT CONST zeiger):
+INT VAR vorgänger,nachfolger;benutztelogzeilenDECR log[zeiger].daten.zeilen;
+IF zeiger=letzteslogTHEN loesche(log[zeiger]);datumneuinlogschreiben:=TRUE ;
+logfileoeffnenELIF zeiger=ersteslogTHEN loesche(log[zeiger]);ersteslog:=next(
+ersteslog)ELSE vorgänger:=zeiger;REP nachfolger:=vorgänger;vorgänger:=prev(
+nachfolger);forget(log[nachfolger].inhalt);log[nachfolger]:=log[vorgänger];
+UNTIL vorgänger=ersteslogPER ;ersteslog:=nachfolger;forget(log[vorgänger].
+inhalt);log[vorgänger].inhalt:=nilspace;log[vorgänger].daten.von:=clock(1);
+log[vorgänger].daten.bis:=clock(1);log[vorgänger].daten.gesichert:=FALSE ;log
+[vorgänger].daten.zeilen:=0FI END PROC logbuchdateiloeschen;PROC loesche(
+LOGBUCH VAR log):forget(log.inhalt);log.inhalt:=nilspace;log.daten.von:=clock
+(1);log.daten.bis:=clock(1);log.daten.gesichert:=FALSE ;log.daten.zeilen:=0.
+END PROC loesche;PROC logdateiwechsel:vervollstaendigealteslog;starteneueslog
+;datumneuinlogschreiben:=TRUE .vervollstaendigealteslog:logb.daten.zeilen:=
+lines(logfile).starteneueslog:letzteslog:=next(letzteslog);IF letzteslog=
+ersteslogTHEN ersteslog:=next(ersteslog);benutztelogzeilenDECR logb.daten.
+zeilenEND IF ;loesche(logb);logfileoeffnen.END PROC logdateiwechsel;PROC 
+logfileoeffnen:logfile:=sequentialfile(output,logb.inhalt);maxlinelength(
+logfile,logspalten+laengeseitenwechselanweisung+1);seitenzeile:=lines(logfile
+)MOD zeilenproseite.END PROC logfileoeffnen;INT PROC next(INT CONST zeiger):
+zeigerMOD logdateien+1.END PROC next;INT PROC prev(INT CONST zeiger):IF 
+zeiger=1THEN logdateienELSE zeiger-1FI END PROC prev;TEXT PROC logname(
+LOGBUCH CONST aktuelleslog):lognamepre+date(aktuelleslog.daten.von)+
+lognamedatumzeittrenner+timeofday(aktuelleslog.daten.von)+vonbistrenner+date(
+aktuelleslog.daten.bis)+lognamedatumzeittrenner+timeofday(aktuelleslog.daten.
+bis).END PROC logname;.logb:log[letzteslog].END PACKET logmanager
+
diff --git a/app/baisy/2.2.1-schulis/src/logbuch verwaltung b/app/baisy/2.2.1-schulis/src/logbuch verwaltung
new file mode 100644
index 0000000..7d6577b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/logbuch verwaltung
@@ -0,0 +1,81 @@
+PACKET logbuchverwaltungDEFINES logbuchverwaltungstart,logbuchzeigen,
+logbuchdrucken,logbucheditordateidrucken,logbuchloeschen,
+logbuchzurueckzummenue:LET maskeeingang="ms logbuch verwaltung";LET 
+fnrzeilenaktuell=2,fnrzeilenmaximal=3,fnrzeilenkritisch=4,fnrauswahl1=5,
+fnrlogname1=6,fnrauswahl2=7,fnrlogname2=8,fnrauswahl3=9,fnrlogname3=10,
+fnrauskunftsfeld=11;LET meldnrfalscheauswahl=56,meldnrfehlerbeimloeschen=74,
+meldnrlogbuchwurdegelöscht=94,meldnrnochnichtgesichert=95,
+meldnrlogbuchwirdgedruckt=96;LET logbuchpraefix="logbuch.*";LET 
+zusätzlicherlaubtetasten="vr";LET laengelogname=45;INT VAR zeilenaktuell,
+zeilenmaximal,zeilenkritisch;THESAURUS VAR thes;INT VAR thesindex;LET 
+maxlogdateien=3;ROW maxlogdateienTEXT VAR logname;INT VAR ilogname,
+aktletzteslog;TEXT VAR dateinamezumzeigen;INT VAR ifnr,auswahl;INT VAR 
+replycode;LET ack=0,nak=1,dateinichtgesichertack=11,readloglimitsorder=202,
+logholenorder=301,gesichertvermerk=306,loeschenorder=307,logmanagername="LOG"
+;DATASPACE VAR ds;INT VAR reply;TASK VAR ordertask;BOUND TEXT VAR msgtext;
+LET letzteslogack=8;PROC logfetch:FILE VAR f;forget(ds);ds:=nilspace;auftrag(
+logholenorder,reply);f:=sequentialfile(input,ds);copy(ds,headline(f));forget(
+ds);WHILE reply<>letzteslogackREP warteauflogmanager;f:=sequentialfile(input,
+ds);copy(ds,headline(f));forget(ds);ds:=nilspace;send(ordertask,ack,ds);PER .
+warteauflogmanager:wait(ds,reply,ordertask);WHILE name(ordertask)<>
+logmanagernameREP forget(ds);wait(ds,reply,ordertask);PER .END PROC logfetch;
+PROC loggetloglimits(INT VAR anzzeilen,anzzeilenbenutzt,anzzeilenkritisch):
+LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt,zeilenkritisch);BOUND LLIMITS 
+VAR loggrenzenmsg;forget(ds);ds:=nilspace;loggrenzenmsg:=ds;auftrag(
+readloglimitsorder,reply);anzzeilen:=CONCR (loggrenzenmsg).zeilen;
+anzzeilenbenutzt:=CONCR (loggrenzenmsg).zeilenbenutzt;anzzeilenkritisch:=
+CONCR (loggrenzenmsg).zeilenkritisch;forget(ds)END PROC loggetloglimits;PROC 
+logsetsavedmark(TEXT CONST logbuchdateiname,INT VAR reply):forget(ds);ds:=
+nilspace;msgtext:=ds;msgtext:=logbuchdateiname;auftrag(gesichertvermerk,reply
+);forget(ds)END PROC logsetsavedmark;PROC logerasesavedlogs(TEXT CONST 
+logbuchdateiname,INT VAR reply):forget(ds);ds:=nilspace;msgtext:=ds;msgtext:=
+logbuchdateiname;auftrag(loeschenorder,reply);forget(ds)END PROC 
+logerasesavedlogs;PROC auftrag(INT CONST opcode,INT VAR reply):schickeauftrag
+;WHILE auftragnichtangenommenREPEAT pause(10);schickeauftragEND REPEAT .
+auftragnichtangenommen:reply=nak.schickeauftrag:call(/logmanagername,opcode,
+ds,reply).END PROC auftrag;PROC logbuchverwaltungstart:loggetloglimits(
+zeilenmaximal,zeilenaktuell,zeilenkritisch);vorhandenelogbuchdateienloeschen;
+FOR ilognameFROM 1UPTO maxlogdateienREP logname(ilogname):=""PER ;logfetch;
+thes:=allLIKE logbuchpraefix;thesindex:=0;ilogname:=0;get(thes,
+dateinamezumzeigen,thesindex);WHILE thesindex>0REP IF ilogname<maxlogdateien
+THEN ilognameINCR 1;logname(ilogname):=dateinamezumzeigen;aktletzteslog:=
+ilogname;FI ;get(thes,dateinamezumzeigen,thesindex);PER ;standardstartproc(
+maskeeingang);standardmaskenfeld(text(zeilenaktuell),fnrzeilenaktuell);
+standardmaskenfeld(text(zeilenmaximal),fnrzeilenmaximal);standardmaskenfeld(
+text(zeilenkritisch),fnrzeilenkritisch);logdateinamenaufbereitenundausgeben;
+infeld(fnrzeilenaktuell);standardfelderausgeben;infeld(fnrauskunftsfeld);
+standardnproc.logdateinamenaufbereitenundausgeben:ifnr:=fnrauswahl1;FOR 
+ilognameFROM 1UPTO maxlogdateienREP IF logname(ilogname)=""THEN feldschutz(
+ifnr);standardmaskenfeld("",ifnr);standardmaskenfeld(laengelogname*" ",ifnr+1
+);ELSE feldfrei(ifnr);standardmaskenfeld("",ifnr);standardmaskenfeld(
+nameaufber(ilogname),ifnr+1)FI ;ifnrINCR 2PER .END PROC 
+logbuchverwaltungstart;TEXT PROC nameaufber(INT CONST iname):TEXT VAR 
+ausgabename:="Logbuch vom ";ausgabenameCAT subtext(datname,9,22);ausgabename
+CAT " bis ";ausgabenameCAT subtext(datname,24,37);ausgabename.datname:logname
+(iname)END PROC nameaufber;PROC logbuchzeigen:auswahlbestimmen;IF auswahl=0
+THEN return(1)ELSE dateinamezumzeigen:=logname(auswahl);zeigedatei(
+dateinamezumzeigen,zusätzlicherlaubtetasten)FI END PROC logbuchzeigen;PROC 
+logbucheditordateidrucken:standardmeldung(meldnrlogbuchwirdgedruckt,"");print
+(dateinamezumzeigen);logsetsavedmark(dateinamezumzeigen,reply);return(1)END 
+PROC logbucheditordateidrucken;PROC logbuchdrucken:auswahlbestimmen;IF 
+auswahl=0THEN return(1)ELSE dateinamezumzeigen:=logname(auswahl);
+standardmeldung(meldnrlogbuchwirdgedruckt,"");print(dateinamezumzeigen);
+logsetsavedmark(dateinamezumzeigen,reply);return(1)FI END PROC logbuchdrucken
+;PROC logbuchloeschen:auswahlbestimmen;IF auswahl=0THEN return(1)ELSE 
+dateinamezumzeigen:=logname(auswahl);logerasesavedlogs(dateinamezumzeigen,
+reply);IF reply=ackTHEN standardmeldung(meldnrlogbuchwurdegelöscht,"");pause(
+10);enter(1)ELIF reply=dateinichtgesichertackTHEN standardmeldung(
+meldnrnochnichtgesichert,"");return(1)ELSE standardmeldung(
+meldnrfehlerbeimloeschen,"");return(1)FI FI END PROC logbuchloeschen;PROC 
+auswahlbestimmen:auswahl:=0;IF auswahl1THEN IF auswahl2OR auswahl3THEN 
+fehlermeldungELSE auswahl:=1FI ELIF auswahl2THEN IF auswahl3THEN 
+fehlermeldungELSE auswahl:=2FI ELIF auswahl3THEN auswahl:=3ELSE fehlermeldung
+FI .auswahl1:standardmaskenfeld(fnrauswahl1)<>"".auswahl2:standardmaskenfeld(
+fnrauswahl2)<>"".auswahl3:standardmaskenfeld(fnrauswahl3)<>"".fehlermeldung:
+standardmeldung(meldnrfalscheauswahl,"").END PROC auswahlbestimmen;PROC 
+logbuchzurueckzummenue:vorhandenelogbuchdateienloeschen;enter(2)END PROC 
+logbuchzurueckzummenue;PROC vorhandenelogbuchdateienloeschen:INT VAR kanal:=
+channel;commanddialogue(FALSE );break(quiet);forget(allLIKE logbuchpraefix);
+continue(kanal);commanddialogue(TRUE )END PROC 
+vorhandenelogbuchdateienloeschen;END PACKET logbuchverwaltung
+
diff --git a/app/baisy/2.2.1-schulis/src/longrow b/app/baisy/2.2.1-schulis/src/longrow
new file mode 100644
index 0000000..482cb8a
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/longrow
@@ -0,0 +1,38 @@
+PACKET longrowDEFINES LONGROW ,:=,newrow,insert,replace,delete,CAT ,length,
+pos,binsearch,_:TYPE LONGROW =TEXT ;LET nil13bytes="�������������",nil4bytes=
+"����",nilbyte="�",niltext="";TEXT VAR teil2,platzhalter:="��";OP :=(LONGROW 
+VAR r,LONGROW CONST s):CONCR (r):=CONCR (s)END OP :=;LONGROW PROC newrow:
+LONGROW VAR r;CONCR (r):=niltext;rEND PROC newrow;PROC insert(LONGROW VAR row
+,INT CONST wo,was):IF wo>0THEN replace(platzhalter,1,was);INT VAR trennpos:=2
+*wo-1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=subtext(CONCR (row),1
+,trennpos-1);CONCR (row)CAT platzhalter;CONCR (row)CAT teil2FI END PROC 
+insert;PROC replace(LONGROW VAR row,INT CONST wo,INT CONST was):IF length(row
+)<woTHEN stretch(row,2*wo)FI ;replace(CONCR (row),wo,was)END PROC replace;
+PROC replace(LONGROW VAR row,INT CONST wo,LONGROW CONST was):INT CONST rowl:=
+length(row);INT CONST wasl:=length(was);INT CONST elementpos:=2*wo-1;INT 
+CONST benoetigtelaenge:=wo+wasl-1;IF rowl<benoetigtelaengeTHEN stretch(row,
+benoetigtelaenge+benoetigtelaenge)FI ;replace(CONCR (row),elementpos,CONCR (
+was))END PROC replace;PROC delete(LONGROW VAR row,INT CONST wo):IF wo>0THEN 
+INT VAR trennpos:=2*wo+1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=
+subtext(CONCR (row),1,trennpos-3);CONCR (row)CAT teil2FI END PROC delete;OP 
+CAT (LONGROW VAR row,INT CONST was):replace(platzhalter,1,was);CONCR (row)
+CAT platzhalterEND OP CAT ;INT OP _(LONGROW CONST row,INT CONST i):CONCR (row
+)ISUB iEND OP _;INT PROC pos(LONGROW CONST row,INT CONST wert):INT VAR start
+:=0;replace(platzhalter,1,wert);REP start:=pos(CONCR (row),platzhalter,start+
+1)UNTIL gefundenCOR stringendePER ;(start+1)DIV 2.gefunden:((startMOD 2)=1).
+stringende:start=0.END PROC pos;INT PROC length(LONGROW CONST row):length(
+CONCR (row))DIV 2END PROC length;PROC binsearch(LONGROW CONST ordnung,TEXT 
+CONST muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,INT VAR indord):
+starteindenvorgegebenengrenzen;setzeaufdiemitte;WHILE nichtgefundenREP IF 
+NOT kleineralsvergleichselementTHEN untererhinterdiemitteELSE 
+obereristdiemitteFI ;IF nichtgefundenTHEN setzeaufdiemitteELSE 
+setzeaufunterenFI PER ;gibordnungsindex.starteindenvorgegebenengrenzen:INT 
+VAR m,u:=1,o:=length(ordnung)+1.setzeaufdiemitte:m:=(u+o)DIV 2.nichtgefunden:
+o>u.untererhinterdiemitte:u:=m+1.obereristdiemitte:o:=m.setzeaufunteren:m:=u.
+kleineralsvergleichselement:kleiner(muster,vergleichselement).
+vergleichselement:(ordnung_m).gibordnungsindex:indord:=m.END PROC binsearch;
+PROC stretch(LONGROW VAR row,INT CONST laenge):WHILE LENGTH CONCR (row)<=
+laenge-13REP CONCR (row)CAT nil13bytesPER ;WHILE LENGTH CONCR (row)<=laenge-4
+REP CONCR (row)CAT nil4bytesPER ;WHILE LENGTH CONCR (row)<laengeREP CONCR (
+row)CAT nilbytePER END PROC stretch;END PACKET longrow;
+
diff --git a/app/baisy/2.2.1-schulis/src/manager-M.dos b/app/baisy/2.2.1-schulis/src/manager-M.dos
new file mode 100644
index 0000000..a47bf6c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/manager-M.dos
@@ -0,0 +1,55 @@
+PACKET dosmanagermultiDEFINES providechannel,dosmanager:LET stdarchivechannel
+=31,ack=0,secondphaseack=5,falsecode=6,fetchcode=11,savecode=12,existscode=13
+,erasecode=14,listcode=15,allcode=17,clearcode=18,reservecode=19,freecode=20,
+checkreadcode=22,formatcode=23,logcode=78,quote="""";BOUND STRUCT (TEXT name,
+pass)VAR msg;TASK VAR ordertask;INT VAR doschannel;INT VAR fetchsavemodus;
+REAL VAR lastaccesstime:=0.0;TASK VAR diskowner:=niltask;TEXT VAR 
+savefilename;PROC providechannel(INT CONST channel):doschannel:=channelEND 
+PROC providechannel;IF hdversionTHEN providechannel(29)ELSE providechannel(
+stdarchivechannel)FI ;PROC dosmanager:dosmanager(doschannel)END PROC 
+dosmanager;PROC dosmanager(INT CONST channel):doschannel:=channel;
+taskpassword("-");globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,
+TASK CONST )dosmanager)END PROC dosmanager;PROC dosmanager(DATASPACE VAR ds,
+INT CONST ordercode,phase,TASK CONST fromtask):enablestop;ordertask:=fromtask
+;msg:=ds;IF NOT (ordertask=diskowner)AND ordercode<>freecodeAND ordercode<>
+reservecodeTHEN errorstop("DOS nicht angemeldet")FI ;IF ordertask=diskowner
+THEN lastaccesstime:=clock(1)FI ;SELECT ordercodeOF CASE fetchcode:fetchfile
+CASE savecode:savefileCASE erasecode:erasefileCASE clearcode:cleardiskCASE 
+existscode:existsfileCASE listcode:listdiskCASE allcode:deliverdirectoryCASE 
+reservecode:reserveCASE freecode:freeCASE checkreadcode:checkCASE formatcode:
+formatCASE logcode:sendlogOTHERWISE errorstop(
+"unbekannter Auftrag für Task: "+name(myself))END SELECT .fetchfile:fetch(
+dosname(msg.name,readmodus),ds,fetchsavemodus);managerok(ds).check:checkfile(
+dosname(msg.name,readmodus));managermessage(expandedname(msg.name,readmodus)+
+" ohne Fehler gelesen").format:IF phase=1THEN managerquestion(
+"Diskette formatieren")ELSE formatdosdisk(int(msg.name));managerok(ds)FI .
+savefile:IF phase=1THEN savefirstphaseELSE savesecondphaseFI .savefirstphase:
+savefilename:=dosname(msg.name,writemodus);IF dosfileexists(savefilename)
+THEN managerquestion(expandedname(msg.name,writemodus)+
+" auf der MS-DOS Disk ueberschreiben")ELSE send(ordertask,secondphaseack,ds)
+FI .savesecondphase:IF dosfileexists(savefilename)THEN erasedosfile(
+savefilename)FI ;save(savefilename,ds,fetchsavemodus);forget(ds);ds:=nilspace
+;managerok(ds).cleardisk:IF phase=1THEN managerquestion("Diskette loeschen")
+ELSE cleardosdisk;managerok(ds)FI .erasefile:IF dosfileexists(dosname(msg.
+name,readmodus))THEN IF phase=1THEN managerquestion(expandedname(msg.name,
+TRUE )+" auf der MS-DOS Disk loeschen")ELSE erasedosfile(dosname(msg.name,
+readmodus));managerok(ds)FI ELSE managermessage("die Datei "+expandedname(msg
+.name,TRUE )+" gibt es nicht auf der MS-DOS Disk")FI .existsfile:IF 
+dosfileexists(dosname(msg.name,readmodus))THEN managerok(ds)ELSE send(
+ordertask,falsecode,ds)FI .listdisk:doslist(ds);managerok(ds).sendlog:forget(
+ds);ds:=old("logbuch");managerok(ds).deliverdirectory:forget(ds);ds:=nilspace
+;BOUND THESAURUS VAR allnames:=ds;allnames:=alldosfiles;managerok(ds).reserve
+:IF reserveorfreepermittedTHEN continuechannel(doschannel);diskowner:=
+fromtask;fetchsavemodus:=savefetchmode(msg.name);opendosdisk(path(msg.name));
+forget("logbuch",quiet);managerok(ds)ELSE errorstop(
+"Archivlaufwerk wird von Task """+name(diskowner)+""" benutzt")FI .
+reserveorfreepermitted:fromtask=diskownerOR lastaccessmorethanfiveminutesago
+OR diskowner=niltaskOR NOT (exists(diskowner)OR station(diskowner)<>station(
+myself)).lastaccessmorethanfiveminutesago:abs(lastaccesstime-clock(1))>300.0.
+free:IF reserveorfreepermittedTHEN closedosdisk;diskowner:=niltask;break(
+quiet);managerok(ds)ELSE managermessage("DOS nicht angemeldet")FI .END PROC 
+dosmanager;PROC managerok(DATASPACE VAR ds):send(ordertask,ack,ds);
+lastaccesstime:=clock(1).END PROC managerok;TEXT PROC expandedname(TEXT 
+CONST name,BOOL CONST status):text(quote+dosname(name,status)+quote,14)END 
+PROC expandedname;END PACKET dosmanagermulti;
+
diff --git a/app/baisy/2.2.1-schulis/src/manager-S.dos b/app/baisy/2.2.1-schulis/src/manager-S.dos
new file mode 100644
index 0000000..2bbfc16
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/manager-S.dos
@@ -0,0 +1,67 @@
+PACKET dossingleDEFINES /,dos,providedoschannel,archive,reserve,release,save,
+fetch,erase,check,exists,ALL ,SOME ,clear,list,format:LET stdarchivechannel=
+31,mainchannel=1;INT VAR doschannel:=stdarchivechannel;INT VAR fetchsavemodus
+;TYPE DOSTASK =TEXT ;DOSTASK CONST dos:="DOS";OP :=(DOSTASK VAR d,TEXT CONST 
+t):CONCR (d):=tEND OP :=;DOSTASK OP /(TEXT CONST text):DOSTASK VAR d;CONCR (d
+):=text;dEND OP /;BOOL PROC isdostask(DOSTASK CONST d):CONCR (d)="DOS"END 
+PROC isdostask;PROC providedoschannel(INT CONST channelno):doschannel:=
+channelnoEND PROC providedoschannel;DATASPACE VAR space:=nilspace;forget(
+space);PROC reserve(TEXT CONST string,DOSTASK CONST task):IF isdostask(task)
+THEN fetchsavemodus:=savefetchmode(string);opendosdisk(path(string))ELSE 
+errorstop("die angesprochene Task existiert nicht")FI .END PROC reserve;PROC 
+archive(TEXT CONST string,DOSTASK CONST task):reserve(string,task)END PROC 
+archive;PROC release(DOSTASK CONST task):IF isdostask(task)THEN closedosdisk
+ELSE errorstop("die angesprochene Task existiert nicht")FI .END PROC release;
+PROC fetch(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN 
+fetchfromdosdiskELSE errorstop("die angesprochene Task existiert nicht")FI .
+fetchfromdosdisk:IF NOT exists(name)COR overwritepermittedTHEN dofetchFI .
+overwritepermitted:say("eigene Datei """);say(name);yes(
+""" auf der Diskette ueberschreiben").dofetch:lastparam(name);disablestop;
+continue(doschannel);fetch(dosname(name,readmodus),space,fetchsavemodus);
+continue(mainchannel);IF NOT iserrorTHEN forget(name,quiet);copy(space,name)
+FI ;forget(space).END PROC fetch;PROC erase(TEXT CONST name,DOSTASK CONST 
+task):IF isdostask(task)THEN doerasedosfileELSE errorstop(
+"die angesprochene Task existiert nicht")FI .doerasedosfile:IF NOT exists(
+name,/"DOS")THEN errorstop("die Datei """+name+""" gibt es nicht")ELIF yes(
+""""+dosname(name,readmodus)+""" auf Der Diskette loeschen")THEN disablestop;
+continue(doschannel);erasedosfile(dosname(name,readmodus));continue(
+mainchannel)FI .END PROC erase;PROC save(TEXT CONST name,DOSTASK CONST task):
+IF isdostask(task)THEN savetodosdiskELSE errorstop(
+"die angesprochene Task existiert nicht")FI .savetodosdisk:TEXT CONST 
+savefilename:=dosname(name,writemodus);disablestop;continue(doschannel);IF 
+NOT dosfileexists(savefilename)COR overwritepermittedTHEN IF dosfileexists(
+savefilename)THEN erasedosfile(savefilename)FI ;save(savefilename,old(name),
+fetchsavemodus);FI ;continue(mainchannel).overwritepermitted:continue(
+mainchannel);BOOL CONST result:=yes(""""+savefilename+
+""" auf der Diskette ueberschreiben");continue(doschannel);result.END PROC 
+save;PROC check(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN 
+disablestop;continue(doschannel);checkfile(dosname(name,readmodus));continue(
+mainchannel)ELSE errorstop("die angesprochene Task existiert nicht")FI .END 
+PROC check;BOOL PROC exists(TEXT CONST name,DOSTASK CONST task):IF isdostask(
+task)THEN disablestop;continue(doschannel);BOOL VAR dummy:=dosfileexists(
+dosname(name,readmodus));continue(mainchannel);enablestop;dummyELSE errorstop
+("die angesprochene Task existiert nicht");FALSE FI .END PROC exists;PROC 
+list(DOSTASK CONST from):forget(space);space:=nilspace;FILE VAR listfile:=
+sequentialfile(output,space);list(listfile,from);modify(listfile);show(
+listfile);forget(space).ENDPROC list;PROC list(FILE VAR listfile,DOSTASK 
+CONST from):IF isdostask(from)THEN listdosdiskELSE errorstop(
+"die angesprochene Task existiert nicht")FI .listdosdisk:disablestop;continue
+(doschannel);doslist(space);continue(mainchannel);enablestop;output(listfile)
+;FILE VAR listsource:=sequentialfile(output,space);TEXT VAR line;WHILE NOT 
+eof(listsource)REP getline(listsource,line);putline(listfile,line)PER .END 
+PROC list;THESAURUS OP ALL (DOSTASK CONST task):IF isdostask(task)THEN 
+disablestop;continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue(
+mainchannel);enablestop;dummyELSE errorstop(
+"die angesprochene Task existiert nicht");emptythesaurusFI .END OP ALL ;
+THESAURUS OP SOME (DOSTASK CONST task):IF isdostask(task)THEN disablestop;
+continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue(mainchannel);
+enablestop;SOME dummyELSE errorstop("die angesprochene Task existiert nicht")
+;emptythesaurusFI .END OP SOME ;PROC clear(DOSTASK CONST task):IF isdostask(
+task)THEN cleardiskELSE errorstop("die angesprochene Task existiert nicht")
+FI .cleardisk:disablestop;IF yes("Diskette loeschen")THEN continue(doschannel
+);cleardosdisk;continue(mainchannel)FI .END PROC clear;PROC format(INT CONST 
+formatcode,DOSTASK CONST task):IF isdostask(task)THEN formatdiskELSE 
+errorstop("die angesprochene Task existiert nicht")FI .formatdisk:disablestop
+;IF yes("Diskette formatieren")THEN continue(doschannel);formatdosdisk(
+formatcode);continue(mainchannel)FI .END PROC format;END PACKET dossingle;
+
diff --git a/app/baisy/2.2.1-schulis/src/maskenerweiterung b/app/baisy/2.2.1-schulis/src/maskenerweiterung
new file mode 100644
index 0000000..a61d7f0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/maskenerweiterung
@@ -0,0 +1,11 @@
+#-S tand: 04.11.8714:46'1238216893388-2761274802888164125853-15453-2245822115
+#PACKET maskenerweiterungDEFINES put,get,putget:LET maxfields=200;PROC putget
+(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v);get(ff,v,
+einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT VAR 
+fieldvalues):INT VAR iFOR iFROM 1UPTO fields(ff)REP IF fieldexists(ff,i)THEN 
+put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff,ROW 
+maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=fields(ff);IF 
+NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag")ELSE WHILE 
+feld<=felderREPEAT get(ff,fieldvalues(feld),feld);executecommandcode(ff,feld)
+UNTIL leavingcode=27PER FI END PROC get;END PACKET maskenerweiterung;
+
diff --git a/app/baisy/2.2.1-schulis/src/maskenverarbeitung b/app/baisy/2.2.1-schulis/src/maskenverarbeitung
new file mode 100644
index 0000000..a640f2c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/maskenverarbeitung
@@ -0,0 +1,125 @@
+PACKET maskenverarbeitungDEFINES INITBY ,tagexists,storetag,renametag,copytag
+,forgettag,listedermasken,startemaskenverarbeitung:LET datenraumpraefix=
+"BAISY-",datenraumbasis=2;LET maxtag=100,maxtab=20,maxinhalt=2000;LET niltext
+="",null=0;TYPE EINTRAG =STRUCT (TEXT name,INT dr,tagnr);TYPE INHALT =STRUCT 
+(LONGROW ordnung,INT maxeintrag,ersterfreier,ROW maxinhaltEINTRAG eintrag);
+TYPE ZEILE =STRUCT (BOOL gueltig,TAG maske);TYPE TAGTAB =STRUCT (INT 
+maxeintrag,zahldereintraege,ersterfreier,ROW maxtagZEILE zeile);BOUND INHALT 
+VAR inhaltsverzeichnis;ROW maxtabBOUND TAGTAB VAR tagtable;INT VAR maxeintrag
+,ersterfreier;OP INITBY (TAG VAR maske,TEXT CONST name):BOOL VAR gefunden;
+INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr,tagnr,gefunden);IF 
+gefundenTHEN maske:=tagtable(dr).zeile(tagnr).maskeELSE nil(maske)FI END OP 
+INITBY ;BOOL PROC tagexists(TEXT CONST name):tagindex(name)>nullEND PROC 
+tagexists;PROC storetag(TAG CONST maske,TEXT CONST name):BOOL VAR gefunden;
+INT VAR katalognr,inhaltnr,dr,tagnr;suchen(name,katalognr,dr,tagnr,gefunden);
+IF NOT gefundenTHEN neueinrichtenELSE ueberschreibenFI .neueinrichten:
+freieplaetzesuchen;einfuegen.freieplaetzesuchen:naechstenfreiensuchen(
+inhaltnr,dr,tagnr).einfuegen:intagtable;inkatalog.intagtable:tagtable(dr).
+zeile(tagnr).maske:=maske;tagtable(dr).zeile(tagnr).gueltig:=true.inkatalog:
+eintragmachen;inordnungaufnehmen.eintragmachen:EINTRAG VAR e;e.name:=name;e.
+dr:=dr;e.tagnr:=tagnr;inhaltsverzeichnis.eintrag(inhaltnr):=e.
+inordnungaufnehmen:IF katalognr=nullTHEN anhaengenELSE einkettenFI .anhaengen
+:inhaltsverzeichnis.ordnungCAT inhaltnr.einketten:insert(inhaltsverzeichnis.
+ordnung,pos(inhaltsverzeichnis.ordnung,katalognr),inhaltnr).ueberschreiben:
+tagtable(dr).zeile(tagnr).maske:=maske.END PROC storetag;PROC renametag(TEXT 
+CONST alt,neu):BOOL VAR gefunden;INT VAR alterindex,neuerindex,dr,tagnr;
+alterindex:=tagindex(alt);IF alterindex<>nullTHEN umbenennenFI .umbenennen:
+suchen(neu,neuerindex,dr,tagnr,gefunden);IF NOT gefundenTHEN 
+alterindexausordnung;neuerindexinordnung;nameueberschreibenFI .
+alterindexausordnung:delete(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis
+.ordnung,alterindex)).neuerindexinordnung:suchen(neu,neuerindex,dr,tagnr,
+gefunden);insert(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis.ordnung,
+neuerindex),alterindex).nameueberschreiben:inhaltsverzeichnis.eintrag(
+alterindex).name:=neu.END PROC renametag;PROC copytag(TEXT CONST alt,neu):
+TAG VAR maske;maskeINITBY alt;storetag(maske,neu)END PROC copytag;PROC 
+forgettag(TEXT CONST name):ungueltigmachen(tagindex(name))END PROC forgettag;
+PROC begintaglist:taglistindex:=0;taglistlaenge:=length(inhaltsverzeichnis.
+ordnung)END PROC begintaglist;INT VAR taglistindex,taglistlaenge;PROC 
+nexttaglistentry(TEXT VAR name):taglistindexINCR 1;name:=naechstereintrag.
+naechstereintrag:IF taglistindex>taglistlaengeTHEN niltextELSE 
+inhaltsverzeichnis.eintrag(eintragindex).nameFI .eintragindex:
+inhaltsverzeichnis.ordnung_taglistindex.END PROC nexttaglistentry;PROC 
+listedermasken:LET listname="Masken";listedermasken(listname);show(listname);
+forget(listname,quiet)END PROC listedermasken;PROC listedermasken(TEXT CONST 
+dateiname):LONGROW VAR refinements;FILE VAR f:=sequentialfile(output,
+dateiname);refinements:=inhaltsverzeichnis.ordnung;INT VAR i;FOR iFROM 1UPTO 
+length(refinements)REP put(f,inhaltsverzeichnis.eintrag(refinements_i).name);
+line(f)PER ;close(f)END PROC listedermasken;INT PROC tagindex(TEXT CONST name
+):BOOL VAR gefunden;INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr,
+tagnr,gefunden);IF gefundenTHEN eintragsnrELSE nullFI END PROC tagindex;PROC 
+suchen(TEXT CONST muster,INT VAR eintragsnr,dr,tagnr,BOOL VAR gefunden):
+LONGROW CONST ordnung:=inhaltsverzeichnis.ordnung;INT CONST l:=length(ordnung
+);eintragsnr:=null;IF l=nullTHEN gefunden:=falseELSE INT VAR ordnungsindex;
+binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,
+ordnungsindex);IF ordnungsindex>lTHEN gefunden:=falseELSE eintragsnr:=ordnung
+_ordnungsindex;EINTRAG VAR e;e:=inhaltsverzeichnis.eintrag(eintragsnr);dr:=e.
+dr;tagnr:=e.tagnr;gefunden:=(muster=e.name)FI FI .END PROC suchen;BOOL PROC 
+kleiner(TEXT CONST muster,INT CONST verzeichnispos):muster<=
+inhaltsverzeichnis.eintrag(verzeichnispos).nameEND PROC kleiner;OP :=(
+EINTRAG VAR e,EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC 
+naechstenfreiensuchen(INT VAR index,dr,tagnr):
+naechstenfreienininhaltsverzeichnis(index);dr:=ersterfreier;
+naechstefreiezeile(dr,tagnr)END PROC naechstenfreiensuchen;PROC 
+naechstenfreienininhaltsverzeichnis(INT VAR index):index:=inhaltsverzeichnis.
+ersterfreier;IF index>inhaltsverzeichnis.maxeintragTHEN inhaltsverzeichnis.
+maxeintrag:=inhaltsverzeichnis.ersterfreier;inhaltsverzeichnis.ersterfreier
+INCR 1ELSE INT VAR i;FOR iFROM index+1UPTO inhaltsverzeichnis.maxeintragREP 
+IF NOT istgueltigTHEN inhaltsverzeichnis.ersterfreier:=i;LEAVE 
+naechstenfreienininhaltsverzeichnisFI PER ;inhaltsverzeichnis.ersterfreier:=
+inhaltsverzeichnis.maxeintrag+1FI .istgueltig:inhaltsverzeichnis.eintrag(i).
+name<>niltext.END PROC naechstenfreienininhaltsverzeichnis;PROC 
+naechstenfreiendatenraum:IF ersterfreier>maxeintragTHEN neuerdatenraumansende
+ELSE INT VAR i;FOR iFROM ersterfreier+1UPTO maxeintragREP IF NOT 
+datenraumvollTHEN ersterfreier:=i;LEAVE naechstenfreiendatenraumFI PER ;
+ersterfreier:=maxeintrag+1;neuerdatenraumansendeFI .neuerdatenraumansende:
+datenraumneuankoppeln(ersterfreier);maxeintrag:=ersterfreier.datenraumvoll:
+tagtable(i).zahldereintraege>=maxtag.END PROC naechstenfreiendatenraum;PROC 
+naechstefreiezeile(INT VAR dr,INT VAR tagnr):IF tagtable(dr).zahldereintraege
+=maxtagTHEN naechstenfreiendatenraum;dr:=ersterfreierFI ;tagnr:=tagtable(dr).
+ersterfreier;tagtable(dr).zahldereintraegeINCR 1;IF tagtable(dr).ersterfreier
+>tagtable(dr).maxeintragTHEN tagtable(dr).maxeintrag:=tagtable(dr).
+ersterfreier;tagtable(dr).ersterfreierINCR 1ELSE INT VAR i;FOR iFROM tagtable
+(dr).ersterfreier+1UPTO tagtable(dr).maxeintragREP IF NOT istgueltigTHEN 
+tagtable(dr).ersterfreier:=i;LEAVE naechstefreiezeileFI PER ;tagtable(dr).
+ersterfreier:=tagtable(dr).maxeintrag+1FI .istgueltig:tagtable(dr).zeile(i).
+gueltig.END PROC naechstefreiezeile;PROC ungueltigmachen(INT CONST index):IF 
+gueltigerindexTHEN tagungueltigmachen;eintragungueltigmachen;
+inordnungungueltigmachenFI .gueltigerindex:index>0.tagungueltigmachen:
+EINTRAG VAR e:=inhaltsverzeichnis.eintrag(index);ungueltigmachen(e.dr,e.tagnr
+).eintragungueltigmachen:e.name:=niltext;inhaltsverzeichnis.eintrag(index):=e
+;IF inhaltsverzeichnis.ersterfreier>indexTHEN inhaltsverzeichnis.ersterfreier
+:=indexFI .inordnungungueltigmachen:delete(inhaltsverzeichnis.ordnung,pos(
+inhaltsverzeichnis.ordnung,index)).END PROC ungueltigmachen;PROC 
+ungueltigmachen(INT CONST dr,tagnr):eintragungueltigmachen;IF letztereintrag
+THEN datenraumungueltigmachenFI .eintragungueltigmachen:INT VAR eintragszahl
+:=tagtable(dr).zahldereintraege;eintragszahlDECR 1;IF NOT letztereintragTHEN 
+tagtable(dr).zahldereintraege:=eintragszahl;INT VAR ef:=tagtable(dr).
+ersterfreier;IF tagnr<efTHEN tagtable(dr).ersterfreier:=tagnrFI ;tagtable(dr)
+.zeile(tagnr).gueltig:=false;nil(tagtable(dr).zeile(tagnr).maske);FI .
+letztereintrag:eintragszahl=null.datenraumungueltigmachen:TEXT CONST drname:=
+datenraumname(dr);forget(drname,quiet);IF letzterdatenraumTHEN weglassenELSE 
+neuanlegenFI .letzterdatenraum:(dr=maxeintrag)CAND (dr<>1).weglassen:
+maxeintragDECR 1;ersterfreier:=min(ersterfreier,maxeintrag).neuanlegen:
+datenraumneuankoppeln(dr);ersterfreier:=min(ersterfreier,dr).END PROC 
+ungueltigmachen;PROC datenraumneuankoppeln(INT CONST dr):tagtable(dr):=new(
+datenraumname(dr));tagtable(dr).zahldereintraege:=null;tagtable(dr).
+maxeintrag:=null;tagtable(dr).ersterfreier:=1END PROC datenraumneuankoppeln;
+PROC startemaskenverarbeitung:IF daTHEN nurankoppelnELSE neuerzeugenFI .da:
+TEXT CONST verwaltungsname:=datenraumpraefix+text(datenraumbasis);exists(
+verwaltungsname).neuerzeugen:inhaltsverzeichnis:=new(verwaltungsname);
+inhaltsverzeichnis.maxeintrag:=0;inhaltsverzeichnis.ersterfreier:=1;
+inhaltsverzeichnis.ordnung:=newrow;maxeintrag:=0;ersterfreier:=1;
+naechstenfreiendatenraum.nurankoppeln:verwaltungankoppeln;restankoppeln.
+verwaltungankoppeln:inhaltsverzeichnis:=old(verwaltungsname).restankoppeln:
+beginneliste;naechster;WHILE nochwelchedaREP anbinden;naechsterPER ;abschluss
+.beginneliste:beginlist;maxeintrag:=null.abschluss:ersterfreier:=null;
+naechstenfreiendatenraum.naechster:TEXT VAR name,datum;getlistentry(name,
+datum).nochwelcheda:name<>niltext.anbinden:INT VAR index:=datenraumnummer(
+name)-datenraumbasis;IF index>nullTHEN tagtable(index):=old(name);maxeintrag
+:=max(maxeintrag,index)FI .END PROC startemaskenverarbeitung;INT PROC 
+datenraumnummer(TEXT CONST name):IF pos(name,datenraumpraefix)<>1THEN null
+ELSE int(name-datenraumpraefix)FI END PROC datenraumnummer;TEXT PROC 
+datenraumname(INT CONST nr):datenraumpraefix+text(nr+datenraumbasis)END PROC 
+datenraumname;TEXT OP -(TEXT CONST s,t):TEXT VAR kurz:=s;change(kurz,t,
+niltext);kurzEND OP -;END PACKET maskenverarbeitung;
+
diff --git a/app/baisy/2.2.1-schulis/src/name conversion.dos b/app/baisy/2.2.1-schulis/src/name conversion.dos
new file mode 100644
index 0000000..01113b9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/name conversion.dos
@@ -0,0 +1,22 @@
+PACKET nameconversionDEFINES dosname,readmodus,writemodus:BOOL CONST 
+readmodus:=TRUE ,writemodus:=NOT readmodus;LET uppercasechars=
+"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_",lowercasechars=
+"abcdefghijklmnopqrstuvwxyz";TEXT PROC dosname(TEXT CONST euname,BOOL CONST 
+readwritemodus):enablestop;INT CONST pointpos:=pos(euname,".");IF 
+nameextensionexistsTHEN changednamewithextensionELSE 
+changednamewithoutextensionFI .nameextensionexists:pointpos>0.
+changednamewithextension:TEXT CONST namepre:=compress(subtext(euname,1,
+pointpos-1)),namepost:=compress(subtext(euname,pointpos+1));IF LENGTH namepre
+=0OR LENGTH namepre>8OR LENGTH namepost>3THEN errorFI ;IF LENGTH namepost=0
+THEN newname(namepre,readwritemodus)ELSE newname(namepre,readwritemodus)+"."+
+newname(namepost,readwritemodus)FI .changednamewithoutextension:IF LENGTH 
+euname>8OR LENGTH euname<1THEN errorFI ;newname(euname,readwritemodus).error:
+errorstop("Unzulässiger Name").END PROC dosname;TEXT PROC newname(TEXT CONST 
+oldname,BOOL CONST readwritemodus):TEXT VAR new:="";INT VAR count;FOR count
+FROM 1UPTO LENGTH oldnameREP convertcharPER ;new.convertchar:TEXT CONST char
+:=oldnameSUB count;IF islowercasecharTHEN newCAT (uppercasecharsSUB stringpos
+)ELIF isuppercasecharOR readwritemodusTHEN newCAT charELSE errorstop(
+"Unzulässiger Name")FI .islowercasechar:pos(lowercasechars,char)>0.
+isuppercasechar:pos(uppercasechars,char)>0.stringpos:pos(lowercasechars,char)
+.END PROC newname;END PACKET nameconversion;
+
diff --git a/app/baisy/2.2.1-schulis/src/new monitor baisy b/app/baisy/2.2.1-schulis/src/new monitor baisy
new file mode 100644
index 0000000..f446230
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/new monitor baisy
@@ -0,0 +1,4 @@
+PACKET newmonitorbaisyDEFINES monitor:PROC monitor:commanddialogue(TRUE );
+disablestop;REP oeffnedatenbank(schulisdbname);startebaisy;clearerrorEND REP 
+.END PROC monitor;END PACKET newmonitorbaisy;
+
diff --git a/app/baisy/2.2.1-schulis/src/open b/app/baisy/2.2.1-schulis/src/open
new file mode 100644
index 0000000..28836c4
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/open
@@ -0,0 +1,11 @@
+PACKET openDEFINES openwork,closework,workopened,workclosed,initcheckrerun,
+checkrerun,hdversion:BOOL VAR open;INT VAR oldsession;BOOL VAR hdflag:=FALSE 
+;INITFLAG VAR packet:=FALSE ;PROC openwork:open:=TRUE END PROC openwork;PROC 
+closework:open:=FALSE END PROC closework;BOOL PROC workopened:IF NOT 
+initialized(packet)THEN closeworkFI ;openEND PROC workopened;BOOL PROC 
+workclosed:NOT workopenedEND PROC workclosed;PROC initcheckrerun:oldsession:=
+sessionEND PROC initcheckrerun;PROC checkrerun:IF session<>oldsessionTHEN 
+closework;errorstop("Diskettenzugriff im RERUN")FI .END PROC checkrerun;PROC 
+hdversion(BOOL CONST status):hdflag:=statusEND PROC hdversion;BOOL PROC 
+hdversion:hdflagEND PROC hdversion;END PACKET open;
+
diff --git a/app/baisy/2.2.1-schulis/src/plausipruefung b/app/baisy/2.2.1-schulis/src/plausipruefung
new file mode 100644
index 0000000..4b08653
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/plausipruefung
@@ -0,0 +1,88 @@
+PACKET plausipruefungDEFINES pruefe,imschlbestand,imbestand:LET 
+trennerfuerfeldwerte="�",dateinameschluessel="Schlüssel";PROC pruefe(INT 
+CONST pruefart,TAG CONST maske,TEXT PROC (INT CONST )prueftext,INT CONST 
+feldnummer,ug,og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT 
+pruefartOF CASE 1:pruefefeldgefuellt(maske,PROC prueftext,feldnummer,fstatus)
+CASE 2:pruefenumerisch(maske,PROC prueftext,feldnummer,fstatus)CASE 3:
+pruefenumgrenzen(maske,PROC prueftext,feldnummer,ug,og,fstatus)CASE 4:
+pruefeimbestand(maske,PROC prueftext,feldnummer,bestand,fstatus)CASE 5:
+pruefealternativen(maske,PROC prueftext,feldnummer,ug,fstatus)CASE 6:
+pruefedatum(maske,PROC prueftext,feldnummer,fstatus)END SELECT .END PROC 
+pruefe;PROC pruefefeldgefuellt(TAG CONST maske,TEXT PROC (INT CONST )eingabe,
+INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr)=""
+THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC 
+pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,TEXT PROC (INT CONST 
+)eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type;
+TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3
+THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol(
+teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus
+:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske,
+TEXT PROC (INT CONST )eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET 
+fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabe<ugOR 
+inteingabe>ogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;
+END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,TEXT PROC (
+INT CONST )eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET 
+fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c"
+THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+
+eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand
+(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig(
+maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC 
+pruefealternativen(TAG CONST maske,TEXT PROC (INT CONST )eingabe,INT CONST 
+fnr1,fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE 
+pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN 
+trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN 
+meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC 
+pruefealternativen;PROC pruefedatum(TAG CONST maske,TEXT PROC (INT CONST )
+eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag=
+"00";TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR 
+subtext(pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske,
+fehlermeldungsnr);fstatus:=fnrFI ;END PROC pruefedatum;PROC pruefe(INT CONST 
+pruefart,TAG CONST maske,ROW 100TEXT CONST prueftext,INT CONST feldnummer,ug,
+og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT pruefartOF CASE 1:
+pruefefeldgefuellt(maske,prueftext,feldnummer,fstatus)CASE 2:pruefenumerisch(
+maske,prueftext,feldnummer,fstatus)CASE 3:pruefenumgrenzen(maske,prueftext,
+feldnummer,ug,og,fstatus)CASE 4:pruefeimbestand(maske,prueftext,feldnummer,
+bestand,fstatus)CASE 5:pruefealternativen(maske,prueftext,feldnummer,ug,
+fstatus)CASE 6:pruefedatum(maske,prueftext,feldnummer,fstatus)END SELECT .
+END PROC pruefe;PROC pruefefeldgefuellt(TAG CONST maske,ROW 100TEXT CONST 
+eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr
+)=""THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC 
+pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,ROW 100TEXT CONST 
+eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type;
+TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3
+THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol(
+teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus
+:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske,
+ROW 100TEXT CONST eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET 
+fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabe<ugOR 
+inteingabe>ogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;
+END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,ROW 100TEXT 
+CONST eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET 
+fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c"
+THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+
+eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand
+(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig(
+maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC 
+pruefealternativen(TAG CONST maske,ROW 100TEXT CONST eingabe,INT CONST fnr1,
+fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE 
+pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN 
+trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN 
+meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC 
+pruefealternativen;PROC pruefedatum(TAG CONST maske,ROW 100TEXT CONST eingabe
+,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag="00";
+TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR subtext(
+pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske,fehlermeldungsnr);
+fstatus:=fnrFI ;END PROC pruefedatum;BOOL PROC imschlbestand(TEXT CONST 
+schlwert,bestand):imbestand(bestand+trennerfuerfeldwerte+schlwert,
+dateinameschluessel)END PROC imschlbestand;BOOL PROC imbestand(TEXT CONST 
+schlwerte,bestandname):INT VAR dateinummer,status,position,i;TEXT VAR suchkey
+:=schlwerte;systemdboff;stopbeifalschemnamen(FALSE );dateinummer:=dateinr(
+bestandname);IF dateinummer>0THEN parsenooffields(0);suchwertesetzen;search(
+dateinummer,TRUE );status:=dbstatus;reinitparsingELSE status:=1FI ;
+stopbeifalschemnamen(TRUE );status=0.suchwertesetzen:FOR iFROM 1UPTO anzkey(
+dateinummer)REP ermittleposition;putwert(dateinummer+i,suchwert);suchkey:=
+subtext(suchkey,position+2)UNTIL suchkey=""PER .ermittleposition:position:=
+pos(suchkey,trennerfuerfeldwerte);IF position=0THEN position:=length(suchkey)
+ELSE positionDECR 1FI .suchwert:subtext(suchkey,1,position).END PROC 
+imbestand;END PACKET plausipruefung;
+
diff --git a/app/baisy/2.2.1-schulis/src/save b/app/baisy/2.2.1-schulis/src/save
new file mode 100644
index 0000000..e634acd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/save
@@ -0,0 +1,61 @@
+PACKET saveDEFINES save:LET ascii=1,asciigerman=2,transparent=3,rowtext=5,ds=
+6,atarist=10,ibm=11,ff="�",ctrlz="�",crlf="

+",rowtextmodelength=4000;TEXT 
+VAR buffer;BOUND STRUCT (INT size,ROW rowtextmodelengthTEXT clusterrow)VAR 
+clusterstruct;PROC save(TEXT CONST filename,DATASPACE CONST fileds,INT CONST 
+mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent:
+savefilemode(fileds,filename,mode)CASE rowtext:saverowtextmode(fileds,
+filename)CASE ds:savedsmode(fileds,filename)OTHERWISE errorstop(
+"Unzulässige Betriebsart")END SELECT .END PROC save;PROC savefilemode(
+DATASPACE CONST filespace,TEXT CONST name,INT CONST codetype):enablestop;
+opensavedosfile(name);FILE VAR file:=sequentialfile(modify,filespace);buffer
+:="";INT VAR lineno;FOR linenoFROM 1UPTO lines(file)REP toline(file,lineno);
+buffercatfileline;WHILE length(buffer)>=clustersizeREP 
+writenextsavedoscluster(subtext(buffer,1,clustersize));buffer:=subtext(buffer
+,clustersize+1)PER PER ;IF asciicodeTHEN bufferCAT ctrlzFI ;writerest;
+closesavedosfile;buffer:="".buffercatfileline:exec(PROC (TEXT CONST ,INT 
+CONST )catadaptedline,file,codetype).asciicode:(codetype=ascii)OR (codetype=
+asciigerman).writerest:WHILE buffer<>""REP writenextsavedoscluster(subtext(
+buffer,1,clustersize));buffer:=subtext(buffer,clustersize+1)PER .END PROC 
+savefilemode;PROC catadaptedline(TEXT VAR line,INT CONST codetype):IF 
+codetype=transparentTHEN bufferCAT lineELSE changeescsequences;
+changeeumelprintchars;SELECT codetypeOF CASE ascii:asciichangeCASE 
+asciigerman:asciigermanchangeCASE atarist:ataristchangeCASE ibm:ibmchangeEND 
+SELECT ;bufferCAT line;IF (lineSUB length(line))<>ffTHEN bufferCAT crlfFI FI 
+.changeescsequences:changeall(line,"#page#",ff);INT VAR p:=pos(line,"#");
+WHILE p>0REP IF isescsequenceTHEN change(line,p,p+4,codedchar)FI ;p:=pos(line
+,"#",p+1)PER .isescsequence:LET digits="0123456789";(lineSUB (p+4))="#"CAND 
+pos(digits,lineSUB p+1)>0CAND pos(digits,lineSUB p+2)>0CAND pos(digits,line
+SUB p+3)>0.codedchar:code(int(subtext(line,p+1,p+3))).changeeumelprintchars:p
+:=pos(line,"k"," ",1);WHILE p>0REP replace(line,p,stdchar);p:=pos(line,"k",
+" ",p+1)PER .stdchar:"k-# "SUB (code(lineSUB p)-219).asciichange:changeall(
+line,"ß","#251#");p:=pos(line,"Ä","ü",1);WHILE p>0REP change(line,p,p,
+ersatzdarstellung(lineSUB p));p:=pos(line,"Ä","ü",p+1)PER .asciigermanchange:
+changeall(line,"[","#091#");changeall(line,"\","#092#");changeall(line,"]",
+"#093#");changeall(line,"{","#123#");changeall(line,"|","#124#");changeall(
+line,"}","#125#");changeall(line,"~","#126#");changeall(line,"ß","~");p:=pos(
+line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinasciigerman);p:=pos(line,
+"Ä","ü",p+1)PER .umlautinasciigerman:"[\]{|}"SUB (code(lineSUB p)-213).
+ibmchange:changeall(line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace
+(line,p,umlautinibm);p:=pos(line,"Ä","ü",p+1)PER .ataristchange:changeall(
+line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinibm)
+;p:=pos(line,"Ä","ü",p+1)PER .umlautinibm:"Ξ��ΔΥΑ"SUB (code(lineSUB p)-213).
+END PROC catadaptedline;TEXT PROC ersatzdarstellung(TEXT CONST char):TEXT 
+CONST t:=text(code(charSUB 1));"#"+(3-length(t))*"0"+t+"#"END PROC 
+ersatzdarstellung;PROC saverowtextmode(DATASPACE CONST space,TEXT CONST name)
+:enablestop;opensavedosfile(name);initsaverowtextmode;WHILE lineno<
+clusterstruct.sizeREP fillbuffer;writenextsavedoscluster(subtext(buffer,1,
+clustersize));rememberrestPER ;writerest;closesavedosfile;buffer:="".
+initsaverowtextmode:clusterstruct:=space;buffer:="";INT VAR lineno:=0.
+fillbuffer:WHILE lineno<clusterstruct.sizeAND NOT bufferfullREP linenoINCR 1;
+bufferCAT clusterstruct.clusterrow[lineno]PER .bufferfull:LENGTH buffer>=
+clustersize.rememberrest:buffer:=subtext(buffer,clustersize+1).writerest:
+WHILE buffer<>""REP writenextsavedoscluster(subtext(buffer,1,clustersize));
+rememberrestPER .END PROC saverowtextmode;PROC savedsmode(DATASPACE CONST 
+outds,TEXT CONST name):enablestop;opensavedosfile(name);INT VAR pageno:=
+firstnondummydspage;getlastallocateddspage;WHILE pageno<=lastallocateddspage
+REP writenextsavedoscluster(outds,pageno);PER ;closesavedosfile.
+getlastallocateddspage:INT VAR lastallocateddspage:=-1,i;FOR iFROM 1UPTO 
+dspages(outds)REP lastallocateddspage:=nextdspage(outds,lastallocateddspage)
+PER .END PROC savedsmode;END PACKET save;
+
diff --git a/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung
new file mode 100644
index 0000000..51fbcac
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung
@@ -0,0 +1,19 @@
+PACKET schuliskommandobehandlungDEFINES bsstart,aktuelleskommandolesen,
+kommandoausfuehren:LET standardanfang=2,id="mb kommandobearbeitung";TEXT VAR 
+name:="",fehl:="";#TEXT VAR titel:="";#BOOL VAR fehler:=FALSE ;;TAG VAR 
+aktuellemaske;INT VAR aktuelleposition;PROC bsstart:
+frageentwicklernachkommando;aktuelleskommandolesen.END PROC bsstart;PROC 
+frageentwicklernachkommando:page;fehl:="";standardkopfmaskeausgeben(text(
+vergleichsknoten));aktuelleposition:=standardanfang;initmaske(aktuellemaske,
+id);show(aktuellemaske).END PROC frageentwicklernachkommando;PROC 
+aktuelleskommandolesen:ROW 100TEXT VAR feld;init(feld);feld(2):=name;feld(4)
+:=fehl;putget(aktuellemaske,feld,aktuelleposition);name:=feld(2);IF fehler
+THEN loeschemeldung(aktuellemaske);put(aktuellemaske,"",4)FI .END PROC 
+aktuelleskommandolesen;PROC kommandoausfuehren:disablestop;melde(
+aktuellemaske,46);store(FALSE );do(name);store(TRUE );IF iserrorTHEN 
+clearerror;meldefehler;ELSE fehler:=FALSE ;fehl:="";reorganizescreenFI ;
+return(1);enablestop.meldefehler:meldeauffaellig(aktuellemaske,45);fehl:=
+errormessage.END PROC kommandoausfuehren;PROC init(ROW 100TEXT VAR feld):INT 
+VAR i;FOR iFROM 1UPTO 100REP feld(i):=""PER END PROC init;END PACKET 
+schuliskommandobehandlung;
+
diff --git a/dos/shard interface b/app/baisy/2.2.1-schulis/src/shard interface
index 20d9b76..20d9b76 100644
--- a/dos/shard interface
+++ b/app/baisy/2.2.1-schulis/src/shard interface
diff --git a/app/baisy/2.2.1-schulis/src/standarddialog b/app/baisy/2.2.1-schulis/src/standarddialog
new file mode 100644
index 0000000..7e498cb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/standarddialog
@@ -0,0 +1,34 @@
+PACKET standarddialogDEFINES standardstartproc,standardvproc,standardnproc,
+standardfelderausgeben,standardmaskenfeld,standardfeldlaenge,standardfeldname
+,standardmeldung,standardpruefe,infeld,IN ,feldschutz,feldfrei:LET maxfelder=
+200;TAG VAR maske;INT VAR einstieg;ROW maxfelderTEXT VAR feld;BOOL VAR 
+feldausgeben;LET xruhepos=1,yruhepos=24;INT PROC infeld:einstiegEND PROC 
+infeld;PROC standardstartproc(TEXT CONST maskenname):initmaske(maske,
+maskenname);page;initfeld;einstieg:=2;standardkopfmaskeausgeben(text(
+vergleichsknoten));feldausgeben:=FALSE ;show(maske)END PROC standardstartproc
+;PROC standardvproc(TEXT CONST maskenname):standardstartproc(maskenname);
+standardnprocEND PROC standardvproc;PROC standardnproc:IF feldausgebenTHEN 
+standardfelderausgebenFI ;get(maske,feld,einstieg);loeschemeldung(maske);
+cursor(xruhepos,yruhepos)END PROC standardnproc;PROC standardfelderausgeben:
+INT VAR fnr;INT VAR maxnr:=fields(maske);FOR fnrFROM einstiegUPTO maxnrREP 
+IF fieldexists(maske,fnr)THEN put(maske,feld(fnr),fnr)FI PER ;feldausgeben:=
+falseEND PROC standardfelderausgeben;PROC standardpruefe(INT CONST pruefart,
+INT CONST feldnummer,ug,og,TEXT CONST bestand,INT VAR status):pruefe(pruefart
+,maske,TEXT PROC (INT CONST )standardmaskenfeld,feldnummer,ug,og,bestand,
+status)END PROC standardpruefe;PROC feldschutz(INT CONST feldnr):protect(
+maske,feldnr,TRUE )END PROC feldschutz;PROC feldfrei(INT CONST feldnr):
+protect(maske,feldnr,FALSE )END PROC feldfrei;INT PROC standardfeldlaenge(
+INT CONST i):length(maske,i)END PROC standardfeldlaenge;INT PROC 
+standardfeldname(INT CONST i):symbolicname(maske,i)END PROC standardfeldname;
+TEXT PROC standardmaskenfeld(INT CONST i):feld(i)END PROC standardmaskenfeld;
+PROC standardmaskenfeld(TEXT CONST t,INT CONST i):feld(i):=t;feldausgeben:=
+TRUE END PROC standardmaskenfeld;PROC infeld(INT CONST i):einstieg:=i;cursor(
+maske,i)END PROC infeld;OP IN (TEXT CONST t,INT CONST feldnr):put(maske,t,
+feldnr);feld(feldnr):=tEND OP IN ;PROC standardmeldung(INT CONST mnr,TEXT 
+CONST ergaenzung):IF ergaenzung=""THEN meldeauffaellig(maske,mnr)ELSE melde(
+maske,mnr,ergaenzung)FI END PROC standardmeldung;PROC standardmeldung(TEXT 
+CONST meldungstext,TEXT CONST ergaenzung):IF ergaenzung=""THEN 
+meldeauffaellig(maske,meldungstext)ELSE melde(maske,meldungstext,ergaenzung)
+FI END PROC standardmeldung;PROC initfeld:INT VAR i;FOR iFROM 1UPTO maxfelder
+REP feld(i):=""PER END PROC initfeld;END PACKET standarddialog;
+
diff --git a/app/baisy/2.2.1-schulis/src/sybifunktionen b/app/baisy/2.2.1-schulis/src/sybifunktionen
new file mode 100644
index 0000000..ebe62ea
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/sybifunktionen
@@ -0,0 +1,71 @@
+PACKET sybifunktionenDEFINES initsybifunktionen,setzebenutzerberechtigung,
+holeberechtigungswert,setzeprogrammende,programmende,
+setzeeditorschalterzurueck,gesetztdurcheditor,setzeschalterfuermenueausgabe,
+loeschetastendruck,tastendruck,setzetastendruck,bittedasmenuezeigen,
+menuedraussen,seteingabe,vpwunsch,npwunsch,vpgewaehlt,npgewaehlt,enter,return
+,reenter,leave,setzevergleichsknoten,vergleichsknoten,knotenaufstackablegen,
+legehistorieknotenab,holehistorietext,stopbaisy,setzeverteilteanwendung,
+beendendessystembauminterpreters:TEXT VAR gedruecktetaste;BOOL VAR 
+programmendeschalter:=FALSE ,editorschalter:=FALSE ,schalterfuermenueausgabe
+:=FALSE ,vornachschalter,verteilteanwendung:=FALSE ;KNOTEN VAR k;STACK VAR s;
+INT VAR zurueckknotenanz;LET schaltervorprozedur=TRUE ,schalternachprozedur=
+FALSE ;TEXT VAR benutzerberechtigung:="";LET maxmenueebenen=4;LET 
+HISTORIEKNOTEN =STRUCT (TEXT knotentext,INT anwahlpos);ROW maxmenueebenen
+HISTORIEKNOTEN VAR hk;INT VAR aktebene;PROC setzeverteilteanwendung:
+verteilteanwendung:=TRUE END PROC setzeverteilteanwendung;PROC seteingabe(
+TEXT CONST t):gedruecktetaste:=t;editorschalter:=TRUE END PROC seteingabe;
+PROC setzeeditorschalterzurueck:editorschalter:=FALSE END PROC 
+setzeeditorschalterzurueck;BOOL PROC gesetztdurcheditor:editorschalterEND 
+PROC gesetztdurcheditor;PROC setzebenutzerberechtigung(TEXT CONST t):
+benutzerberechtigung:=tEND PROC setzebenutzerberechtigung;PROC 
+holeberechtigungswert(TEXT VAR t):t:=benutzerberechtigungEND PROC 
+holeberechtigungswert;PROC setzeprogrammende(BOOL CONST wahrwert):
+programmendeschalter:=wahrwertEND PROC setzeprogrammende;BOOL PROC 
+programmende:programmendeschalterEND PROC programmende;PROC 
+setzeschalterfuermenueausgabe(BOOL CONST sfma):schalterfuermenueausgabe:=sfma
+END PROC setzeschalterfuermenueausgabe;BOOL PROC menuedraussen:
+schalterfuermenueausgabeEND PROC menuedraussen;BOOL PROC bittedasmenuezeigen:
+schalterfuermenueausgabeEND PROC bittedasmenuezeigen;PROC loeschetastendruck:
+gedruecktetaste:=""END PROC loeschetastendruck;TEXT PROC tastendruck:
+gedruecktetasteEND PROC tastendruck;PROC setzetastendruck(TEXT CONST taste):
+gedruecktetaste:=tasteEND PROC setzetastendruck;PROC vpwunsch:vornachschalter
+:=schaltervorprozedurEND PROC vpwunsch;PROC npwunsch:vornachschalter:=
+schalternachprozedurEND PROC npwunsch;BOOL PROC vpgewaehlt:vornachschalter
+END PROC vpgewaehlt;BOOL PROC npgewaehlt:NOT vornachschalterEND PROC 
+npgewaehlt;PROC return(INT CONST zurueckknotenanzahl):zurueckknotenanz:=
+zurueckknotenanzahl;INT VAR knotenstackhoehe;knotenstackhoehe:=hoehe(s);
+npwunsch;IF knotenstackhoehe<zurueckknotenanzahlTHEN holeerstenstackknoten
+ELSE holenaechstenstackknotenFI END PROC return;PROC enter(INT CONST 
+zurueckknotenanzahl):zurueckknotenanz:=zurueckknotenanzahl;INT VAR 
+knotenstackhoehe;knotenstackhoehe:=hoehe(s);vpwunsch;IF knotenstackhoehe<
+zurueckknotenanzahlTHEN holeerstenstackknotenELSE holenaechstenstackknotenFI 
+END PROC enter;PROC reenter(INT CONST zurueckknotenanzahl):enter(
+zurueckknotenanzahl)END PROC reenter;PROC leave(INT CONST zurueckknotenanzahl
+):return(zurueckknotenanzahl)END PROC leave;PROC holeerstenstackknoten:IF 
+verteilteanwendungTHEN zurueckverzweigenvorbereitenELSE 
+lokalerstenstackknotenholenFI .zurueckverzweigenvorbereiten:
+programmendeschalter:=TRUE .lokalerstenstackknotenholen:REP pop(s,k)UNTIL 
+leer(s)PER ;aktebene:=0.END PROC holeerstenstackknoten;PROC 
+holenaechstenstackknoten:INT VAR zurueckknotenzaehler:=0;WHILE (
+zurueckknotenzaehler<zurueckknotenanz)REP pop(s,k);IF aktebene>0THEN IF text(
+k)=hk(aktebene).knotentextTHEN aktebeneDECR 1FI ;FI ;zurueckknotenzaehler
+INCR 1PER ;END PROC holenaechstenstackknoten;PROC knotenaufstackablegen(
+KNOTEN VAR stackknoten):push(s,k)END PROC knotenaufstackablegen;PROC 
+setzevergleichsknoten(KNOTEN CONST vglknoten):k:=vglknotenEND PROC 
+setzevergleichsknoten;KNOTEN PROC vergleichsknoten:kEND PROC vergleichsknoten
+;PROC beendendessystembauminterpreters:setzeprogrammende(TRUE );return(1)END 
+PROC beendendessystembauminterpreters;PROC initsybifunktionen:
+programmendeschalter:=FALSE ;verteilteanwendung:=FALSE ;s:=leererstack;
+aktebene:=0;store(TRUE );INT VAR ind;FOR indFROM 1UPTO maxmenueebenenREP hk(
+ind).knotentext:="";hk(ind).anwahlpos:=0;PER END PROC initsybifunktionen;
+PROC legehistorieknotenab(TEXT CONST ktext,INT CONST mpkt):IF aktebene<
+maxmenueebenenTHEN aktebeneINCR 1;hk(aktebene).knotentext:=ktext;hk(aktebene)
+.anwahlpos:=mpktFI END PROC legehistorieknotenab;PROC holehistorietext(TEXT 
+VAR ktext,INT VAR kpos,INT CONST nletzter):INT VAR hkzeiger;hkzeiger:=
+aktebene-nletzter+1;IF hkzeiger<1THEN ktext:=""ELSE ktext:=hk(hkzeiger).
+knotentext;kpos:=hk(hkzeiger).anwahlposFI END PROC holehistorietext;PROC 
+stopbaisy:logbucheintragabmeldung;benutzerberechtigung:="";enter(1);breakEND 
+PROC stopbaisy;PROC logbucheintragabmeldung:TEXT VAR eintrag:="Abmeldung """;
+eintragCAT name(myself);eintragCAT """";logeintrag(eintrag)END PROC 
+logbucheintragabmeldung;END PACKET sybifunktionen
+
diff --git a/app/baisy/2.2.1-schulis/src/systembaum b/app/baisy/2.2.1-schulis/src/systembaum
new file mode 100644
index 0000000..2497398
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/systembaum
@@ -0,0 +1,299 @@
+PACKET systembaumDEFINES sohnvon,reorganisieren,gibbaumtabelle,KNOTEN ,=,
+neuerknoten,nilknoten,markierungsknoten,erster,naechster,gueltig,suche,
+existiert,read,write,inknotenmenge,ausknotenmenge,knotenloeschen,move,
+KNOTENMENGE ,:=,zahlderelemente,leereknotenmenge,knotenmengeloeschen,exporte,
+importe,system,listederteilbaeume,startesystembaum,kopieresystembaum,
+ueberschreibesystembaum,setzesystembaumzurueck:BOOL PROC sohnvon(KNOTEN 
+CONST vater,sohn):pos(kmknoten,CONCR (sohn))>0.kmknoten:IF CONCR (vater)<=
+maxknTHEN systembaum.tabzeile(CONCR (vater)).knotenELSE verwaltung.tabzeile(
+CONCR (vater)-maxkn).knotenFI .ENDPROC sohnvon;LET maxkn=2190,niltext="",null
+=0,knindex=1;LET kn1=2191,kn2=2192,kn3=2193;LET systembaumname="BAISY-0",
+systembaumkopie="SBKOP",verwaltungsname="BAISY-1",verwaltungskopie="VWKOP";
+LET maxhoehe=100,bottom=1,refkz="1",erreichtkz="2";LET reorgincr=7000;TYPE 
+TUPEL =STRUCT (KNOTEN kn,INT index,BOOL markiert);TYPE STACK =STRUCT (ROW 
+maxhoeheTUPEL st,INT top);TYPE KNOTENMENGE =INT ;TYPE KNOTEN =INT ;TYPE 
+EINTRAG =STRUCT (TEXT attribute,KNOTEN vater,LONGROW knotenmengenLONGROW 
+knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,ROW maxknEINTRAG 
+tabzeile);KNOTEN CONST nilknoten:=KNOTEN :(null);KNOTEN CONST 
+markierungsknoten:=KNOTEN :(4711);BOUND SYSTAB VAR systembaum;BOUND SYSTAB 
+VAR verwaltung;BOUND SYSTAB VAR reorg;KNOTENMENGE VAR exp,imp,sys;PROC 
+gibbaumtabelle(TEXT CONST startknotenname,DATASPACE VAR ds):CONCR (systembaum
+.tabzeile(systembaum.ersterfreier).vater):=zeilennr(startknotenname);ds:=old(
+systembaumname)END PROC gibbaumtabelle;INT PROC zeilennr(TEXT CONST 
+startknotenname):KNOTEN VAR k;IF existiert(exporte,k,startknotenname)THEN 
+KNOTENMENGE VAR soehne;read(k,soehne);CONCR (erster(soehne))ELSE nullFI END 
+PROC zeilennr;OP :=(KNOTEN VAR k,KNOTEN CONST l):CONCR (k):=CONCR (l)END OP 
+:=;BOOL OP =(KNOTEN CONST k,KNOTEN CONST l):CONCR (k)=CONCR (l)END OP =;
+KNOTEN PROC neuerknoten(KNOTENMENGE CONST m):KNOTEN VAR k;CONCR (k):=
+neuereintrag(CONCR (m)<>CONCR (sys),true);inknotenmenge(m,k);kEND PROC 
+neuerknoten;KNOTEN PROC neuerknoten(KNOTENMENGE CONST m,TEXT CONST schluessel
+):KNOTEN VAR k;IF existiert(m,k,schluessel)THEN LEAVE neuerknotenWITH kFI ;
+KNOTEN VAR l;CONCR (l):=neuereintrag(CONCR (m)<>CONCR (sys),true);write(l,
+schluessel);inknotenmenge(m,l,k);lEND PROC neuerknoten;BOOL PROC existiert(
+KNOTENMENGE CONST a,KNOTEN VAR r,TEXT CONST muster):BOOL VAR gefunden;suche(a
+,muster,r,gefunden);gefundenEND PROC existiert;PROC read(KNOTEN CONST k,
+KNOTEN VAR vater):vater:=kvater.kvater:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn).vaterFI .
+END PROC read;PROC read(KNOTEN CONST k,KNOTENMENGE VAR soehne):CONCR (soehne)
+:=CONCR (k)END PROC read;PROC read(KNOTEN CONST k,TEXT VAR attribute):
+attribute:=kattribute.kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(
+CONCR (k)).attributeELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI .
+END PROC read;PROC read(KNOTEN CONST k,EINTRAG VAR attribute):attribute:=
+keintrag.keintrag:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE 
+verwaltung.tabzeile(CONCR (k)-maxkn)FI .END PROC read;PROC write(KNOTEN 
+CONST k,KNOTEN CONST vater):kvater:=vater.kvater:IF CONCR (k)<=maxknTHEN 
+systembaum.tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn)
+.vaterFI .END PROC write;PROC write(KNOTEN CONST k,KNOTENMENGE CONST soehne):
+kknoten:=sohnknoten.kknoten:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(
+CONCR (k)).knotenELSE verwaltung.tabzeile(CONCR (k)-maxkn).knotenFI .
+sohnknoten:IF CONCR (soehne)<=maxknTHEN systembaum.tabzeile(CONCR (soehne)).
+knotenELSE verwaltung.tabzeile(CONCR (soehne)-maxkn).knotenFI .END PROC write
+;PROC write(KNOTEN CONST k,TEXT CONST attribute):kattribute:=attribute.
+kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).attribute
+ELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI .END PROC write;PROC 
+write(KNOTEN CONST k,EINTRAG CONST attribute):keintrag:=attribute.keintrag:
+IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE verwaltung.
+tabzeile(CONCR (k)-maxkn)FI .END PROC write;PROC inknotenmenge(KNOTENMENGE 
+CONST km,KNOTEN CONST k):kmknotenCAT kindex;kknotenmengenCAT kmindex.kmknoten
+:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE 
+verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<=
+maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile
+(CONCR (k)-maxkn).knotenmengenFI .kindex:CONCR (k).kmindex:CONCR (km).END 
+PROC inknotenmenge;PROC inknotenmenge(KNOTENMENGE CONST km,KNOTEN CONST k,l):
+IF l=nilknotenTHEN inknotenmenge(km,k)ELSE insert(kmknoten,posl,kindex);
+kknotenmengenCAT kmindexFI .posl:pos(kmknoten,lindex).kmknoten:IF CONCR (km)
+<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE verwaltung.tabzeile(
+CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn).
+knotenmengenFI .kindex:CONCR (k).lindex:CONCR (l).kmindex:CONCR (km).END 
+PROC inknotenmenge;PROC ausknotenmenge(KNOTENMENGE CONST km,KNOTEN VAR k):
+KNOTEN VAR l:=k;naechster(l,km);delete(kmknoten,kindex);delete(kknotenmengen,
+kmindex);k:=l.kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km
+)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen:
+IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE 
+verwaltung.tabzeile(CONCR (k)-maxkn).knotenmengenFI .kindex:pos(kmknoten,
+CONCR (k)).kmindex:pos(kknotenmengen,CONCR (km)).END PROC ausknotenmenge;
+PROC knotenloeschen(KNOTENMENGE CONST km,KNOTEN VAR k):IF 
+knotenundknotenmengeexistierenTHEN ausallenmengen;sohnknotenmengeloeschen;
+ungueltigmachen(CONCR (l))FI .knotenundknotenmengeexistieren:(CONCR (km)<>0)
+CAND (CONCR (k)<>0).ausallenmengen:KNOTEN VAR nachf:=k;KNOTEN CONST l:=k;
+LONGROW VAR mengen:=kknotenmengen;INT VAR i,mindex;KNOTENMENGE VAR m;FOR i
+FROM 1UPTO length(mengen)REP mindex:=mengen_i;CONCR (m):=mindex;
+ausknotenmenge(m,k);IF mindex=CONCR (km)THEN nachf:=kFI ;k:=lPER ;k:=nachf.
+sohnknotenmengeloeschen:KNOTENMENGE VAR soehne;CONCR (soehne):=CONCR (l);
+knotenmengeloeschen(soehne).kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn).
+knotenmengenFI .END PROC knotenloeschen;PROC move(KNOTEN CONST k,KNOTEN 
+CONST l):eigenschaftenuebertragen;pointerpflegen.eigenschaftenuebertragen:
+systembaum.tabzeile(CONCR (l)).knoten:=systembaum.tabzeile(CONCR (k)).knoten;
+systembaum.tabzeile(CONCR (l)).attribute:=systembaum.tabzeile(CONCR (k)).
+attribute.pointerpflegen:soehnevonkumsetzen;vaetervonkumsetzen.
+soehnevonkumsetzen:soehneumsetzen(systembaum.tabzeile(CONCR (k)).knoten,k,l).
+vaetervonkumsetzen:vaeterumsetzen(systembaum.tabzeile(CONCR (k)).knotenmengen
+,k,l).END PROC move;PROC soehneumsetzen(LONGROW CONST soehne,KNOTEN CONST von
+,nach):INT VAR i;FOR iFROM 1UPTO length(soehne)REP INT VAR sohni:=soehne_i;
+replace(beisohni,posvon,CONCR (nach))PER .beisohni:systembaum.tabzeile(sohni)
+.knotenmengen.posvon:pos(beisohni,CONCR (von)).END PROC soehneumsetzen;PROC 
+vaeterumsetzen(LONGROW CONST vaeter,KNOTEN CONST von,nach):INT VAR i,refindex
+;refindex:=CONCR (systembaum.tabzeile(CONCR (von)).vater);FOR iFROM 1UPTO 
+length(vaeter)REP INT VAR vateri:=vaeter_i;vaterumsetzen(vateri,refindex,nach
+)PER END PROC vaeterumsetzen;PROC vaterumsetzen(INT CONST vaterindex,refindex
+,KNOTEN CONST nach):IF (vaterindex<>CONCR (system))CAND (vaterindex<>refindex
+)THEN KNOTENMENGE VAR vater;CONCR (vater):=vaterindex;inknotenmenge(vater,
+nach)FI END PROC vaterumsetzen;KNOTEN PROC erster(KNOTENMENGE CONST m):
+LONGROW CONST ordnung:=mknoten;ersternach(null,ordnung).mknoten:IF CONCR (m)
+<=maxknTHEN systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(
+CONCR (m)-maxkn).knotenFI .END PROC erster;PROC naechster(KNOTEN VAR k,
+KNOTENMENGE CONST m):LONGROW CONST ordnung:=mknoten;k:=ersternach(indexvonk,
+ordnung).indexvonk:pos(ordnung,CONCR (k)).mknoten:IF CONCR (m)<=maxknTHEN 
+systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn
+).knotenFI .END PROC naechster;BOOL PROC gueltig(KNOTEN CONST k):CONCR (k)<>
+nullEND PROC gueltig;PROC suche(KNOTENMENGE CONST m,TEXT CONST muster,KNOTEN 
+VAR k,BOOL VAR gefunden):LONGROW CONST ordnung:=mknoten;INT CONST l:=length(
+ordnung);IF l=nullTHEN gefunden:=false;k:=nilknotenELSE INT VAR ordnungsindex
+;binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,
+ordnungsindex);IF ordnungsindex>lTHEN gefunden:=false;k:=nilknotenELSE CONCR 
+(k):=ordnung_ordnungsindex;TEXT VAR gefundenesmuster;read(k,gefundenesmuster)
+;gefunden:=(muster=gefundenesmuster)FI FI .mknoten:IF CONCR (m)<=maxknTHEN 
+systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn
+).knotenFI .END PROC suche;OP :=(KNOTENMENGE VAR k,KNOTENMENGE CONST l):
+CONCR (k):=CONCR (l)END OP :=;INT PROC zahlderelemente(KNOTENMENGE CONST km):
+length(kmknoten).kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR 
+(km)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .END PROC 
+zahlderelemente;KNOTENMENGE PROC leereknotenmenge:KNOTENMENGE VAR k;CONCR (k)
+:=neuereintrag(true,false);kEND PROC leereknotenmenge;PROC 
+knotenmengeloeschen(KNOTENMENGE VAR km):IF knotenmengeexistiertTHEN 
+allezeigerloeschen;alsungueltigkennzeichnenFI .knotenmengeexistiert:CONCR (km
+)<>0.allezeigerloeschen:INT CONST kmind:=CONCR (km);LONGROW VAR knoten:=
+kmindknoten;INT VAR i,kindex;LONGROW VAR row;FOR iFROM 1UPTO length(knoten)
+REP kindex:=knoten_i;row:=kindexknotenmengen;delete(kindexknotenmengen,pos(
+row,kmind))PER ;.kmindknoten:IF kmind<=maxknTHEN systembaum.tabzeile(kmind).
+knotenELSE verwaltung.tabzeile(kmind-maxkn).knotenFI .kindexknotenmengen:IF 
+kindex<=maxknTHEN systembaum.tabzeile(kindex).knotenmengenELSE verwaltung.
+tabzeile(kindex-maxkn).knotenmengenFI .alsungueltigkennzeichnen:IF 
+nichtinknotenTHEN ungueltigmachen(kmind);ELSE kmindknoten:=newrowFI ;CONCR (
+km):=null.nichtinknoten:KNOTEN VAR vglknoten,kmknoten;CONCR (kmknoten):=kmind
+;read(kmknoten,vglknoten);CONCR (vglknoten)=knindex.END PROC 
+knotenmengeloeschen;KNOTENMENGE PROC exporte:expEND PROC exporte;KNOTENMENGE 
+PROC importe:impEND PROC importe;KNOTENMENGE PROC system:sysEND PROC system;
+PROC startesystembaum:IF verwaltungdaTHEN nurankoppelnELSE 
+ankoppelnundpermanenteknotenmengenerzeugenFI ;systembaumbehandeln.
+verwaltungda:exists(verwaltungsname).nurankoppeln:verwaltung:=old(
+verwaltungsname);CONCR (exp):=kn1;CONCR (imp):=kn2;CONCR (sys):=kn3.
+ankoppelnundpermanenteknotenmengenerzeugen:verwaltung:=new(verwaltungsname);
+verwaltung.maxeintrag:=0;verwaltung.ersterfreier:=1;exp:=leereknotenmenge;imp
+:=leereknotenmenge;sys:=leereknotenmenge.systembaumbehandeln:IF exists(
+systembaumname)THEN systembaum:=old(systembaumname)ELSE systembaum:=new(
+systembaumname);systembaum.maxeintrag:=0;systembaum.ersterfreier:=1;FI .END 
+PROC startesystembaum;PROC listederteilbaeume(TEXT CONST dateiname):LONGROW 
+VAR refinements;FILE VAR f:=sequentialfile(output,dateiname);refinements:=
+verwaltung.tabzeile(CONCR (exporte)-maxkn).knoten;INT VAR i;FOR iFROM 1UPTO 
+length(refinements)REP put(f,verwaltung.tabzeile((refinements_i)-maxkn).
+attribute);line(f)PER ;close(f)END PROC listederteilbaeume;PROC 
+kopieresystembaum:copy(systembaumname,systembaumkopie);systembaum:=old(
+systembaumkopie);copy(verwaltungsname,verwaltungskopie);verwaltung:=old(
+verwaltungskopie)END PROC kopieresystembaum;PROC ueberschreibesystembaum:
+forget(systembaumname,quiet);rename(systembaumkopie,systembaumname);forget(
+verwaltungsname,quiet);rename(verwaltungskopie,verwaltungsname)END PROC 
+ueberschreibesystembaum;PROC setzesystembaumzurueck:systembaum:=old(
+systembaumname);forget(systembaumkopie,quiet);verwaltung:=old(verwaltungsname
+);forget(verwaltungskopie,quiet)END PROC setzesystembaumzurueck;INT PROC 
+neuereintrag(BOOL CONST istverwaltung,istknoten):EINTRAG VAR e;e.attribute:=
+niltext;IF istknotenTHEN CONCR (e.vater):=null;ELSE CONCR (e.vater):=knindex
+FI ;e.knotenmengen:=newrow;e.knoten:=newrow;INT VAR eintragsnr;
+naechstenfreiensuchen(istverwaltung,eintragsnr);KNOTEN VAR k;CONCR (k):=
+eintragsnr;write(k,e);eintragsnrEND PROC neuereintrag;OP :=(EINTRAG VAR e,
+EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC naechstenfreiensuchen(
+BOOL CONST istverwaltung,INT VAR eintragsnr):IF istverwaltungTHEN 
+naechstenfreieninverwaltungsuchen(eintragsnr)ELSE 
+naechstenfreieninsystembaumsuchen(eintragsnr)FI END PROC 
+naechstenfreiensuchen;PROC naechstenfreieninsystembaumsuchen(INT VAR 
+eintragsnr):eintragsnr:=systembaum.ersterfreier;IF systembaum.ersterfreier>
+systembaum.maxeintragTHEN systembaum.maxeintrag:=systembaum.ersterfreier;
+systembaum.ersterfreierINCR 1ELSE INT VAR i;FOR iFROM systembaum.ersterfreier
++1UPTO systembaum.maxeintragREP IF NOT istgueltigTHEN systembaum.ersterfreier
+:=i;LEAVE naechstenfreieninsystembaumsuchenFI PER ;systembaum.ersterfreier:=
+systembaum.maxeintrag+1FI .istgueltig:CONCR (systembaum.tabzeile(i).vater)>=
+null.END PROC naechstenfreieninsystembaumsuchen;PROC 
+naechstenfreieninverwaltungsuchen(INT VAR eintragsnr):eintragsnr:=verwaltung.
+ersterfreier+maxkn;IF verwaltung.ersterfreier>verwaltung.maxeintragTHEN 
+verwaltung.maxeintrag:=verwaltung.ersterfreier;verwaltung.ersterfreierINCR 1
+ELSE INT VAR i;FOR iFROM verwaltung.ersterfreier+1UPTO verwaltung.maxeintrag
+REP IF NOT istgueltigTHEN verwaltung.ersterfreier:=i;LEAVE 
+naechstenfreieninverwaltungsuchenFI PER ;verwaltung.ersterfreier:=verwaltung.
+maxeintrag+1FI .istgueltig:CONCR (verwaltung.tabzeile(i).vater)>=null.END 
+PROC naechstenfreieninverwaltungsuchen;KNOTEN PROC ersternach(INT CONST 
+knindex,LONGROW CONST ordnung):KNOTEN VAR k:=nilknoten;INT CONST l:=length(
+ordnung);IF (l>0)CAND (knindex<l)THEN CONCR (k):=ordnung_(knindex+1)FI ;kEND 
+PROC ersternach;BOOL PROC kleiner(TEXT CONST muster,INT CONST i):KNOTEN VAR k
+;TEXT VAR vglmuster;CONCR (k):=i;read(k,vglmuster);muster<=vglmusterEND PROC 
+kleiner;PROC ungueltigmachen(INT CONST nr):EINTRAG VAR e;e.attribute:=niltext
+;CONCR (e.vater):=-1;e.knotenmengen:=newrow;e.knoten:=newrow;KNOTEN VAR k;
+CONCR (k):=nr;write(k,e);ersterfreier(nr)END PROC ungueltigmachen;PROC 
+ersterfreier(INT CONST nr):IF nr<=maxknTHEN ersterfreier(systembaum.
+ersterfreier,nr)ELSE ersterfreier(verwaltung.ersterfreier,nr-maxkn)FI END 
+PROC ersterfreier;PROC ersterfreier(INT VAR ef,INT CONST nr):IF nr<efTHEN ef
+:=nrFI END PROC ersterfreier;PROC reorganisieren:meldestartderreorganisation;
+reorganisieresystem;reorganisiereverwaltung.meldestartderreorganisation:out(
+"��");put("Der Systembaum wird reorganisiert").END PROC reorganisieren;PROC 
+reorganisieresystem:vorbereitung;ausfuehrung;abschluss.ausfuehrung:
+sammlealleunbenutztenrefinements;reorganisierediese.
+sammlealleunbenutztenrefinements:LONGROW VAR refinements;refinements:=
+verwaltung.tabzeile(CONCR (exporte)-maxkn).knoten;LONGROW VAR unbenutzte:=
+newrow,startknoten:=newrow;INT VAR i;EINTRAG VAR e;FOR iFROM 1UPTO length(
+refinements)REP INT VAR knnummer:=refinements_i;INT VAR relnummer:=knnummer-
+maxkn;e:=verwaltung.tabzeile(relnummer);IF NOT ((e.vater)=markierungsknoten)
+THEN unbenutzteCAT knnummer;startknotenCAT (e.knoten_1)FI PER .
+reorganisierediese:reorganisiere(unbenutzte,startknoten).vorbereitung:
+DATASPACE VAR ds:=nilspace;reorg:=ds;reorg.maxeintrag:=0;reorg.ersterfreier:=
+1.abschluss:forget(systembaumname,quiet);copy(ds,systembaumname);forget(ds).
+END PROC reorganisieresystem;PROC reorganisiereverwaltung:vorbereitung;
+ausfuehrung;abschluss.ausfuehrung:line;put(
+"Die Verwaltungsstruktur wird reorganisiert");INT VAR i;FOR iFROM 1UPTO reorg
+.maxeintragREP IF gueltigTHEN uebertrageELSE markiereFI PER .gueltig:cout(i);
+CONCR (verwaltung.tabzeile(i).vater)>=0.uebertrage:EINTRAG VAR e;e.attribute
+:=verwaltung.tabzeile(i).attribute;e.knotenmengen:=verwaltung.tabzeile(i).
+knotenmengen;e.vater:=verwaltung.tabzeile(i).vater;e.knoten:=decr(verwaltung.
+tabzeile(i).knoten);reorg.tabzeile(i):=e.markiere:CONCR (reorg.tabzeile(i).
+vater):=-1.vorbereitung:DATASPACE VAR ds:=nilspace;reorg:=ds;reorg.maxeintrag
+:=verwaltung.maxeintrag;reorg.ersterfreier:=verwaltung.ersterfreier.abschluss
+:forget(verwaltungsname,quiet);copy(ds,verwaltungsname);forget(ds);
+startesystembaum.END PROC reorganisiereverwaltung;PROC reorganisiere(LONGROW 
+CONST unbenutzte,startknoten):INT VAR i;FOR iFROM 1UPTO length(unbenutzte)
+REP reorganisiere(knoten,name)PER .knoten:KNOTEN :(startknoten_i).name:TEXT 
+VAR na;read(KNOTEN :(unbenutzte_i),na);na.END PROC reorganisiere;PROC 
+reorganisiere(KNOTEN CONST k,TEXT CONST teilbaumname):line;put("Teilbaum "+
+teilbaumname+"  wird reorganisiert");reorganisiere(k)END PROC reorganisiere;
+PROC reorganisiere(KNOTEN CONST k):vorbereitung;erstenaufstack;REP 
+stackbearbeitungUNTIL stackleerPER .stackbearbeitung:nimmoberstenvomstack;IF 
+(NOT oberstermarkiert)CAND hatsoehneTHEN markiertzurueck;
+allesoehneaufdenstackELSE oberstenuebertragenFI .vorbereitung:STACK VAR s:=
+leererstack.erstenaufstack:TUPEL VAR tup;IF schonmalerreicht(k)THEN LEAVE 
+reorganisiereELSE tup.kn:=k;tup.index:=naechsterindex;tup.markiert:=false;
+alserreichtkennzeichnen(k);vater.kn:=systembaum.tabzeile(CONCR (k)).vater;
+vater.index:=CONCR (vater.kn);hauptindexaendern(tup,vater);push(s,tup)FI .
+stackleer:leer(s).nimmoberstenvomstack:TUPEL VAR vater;pop(s,vater).
+oberstermarkiert:vater.markiert.markiertzurueck:vater.markiert:=true;push(s,
+vater).hatsoehne:KNOTENMENGE VAR soehne;read(vater.kn,soehne);INT VAR 
+sohnzahl:=zahlderelemente(soehne);sohnzahl>0.oberstenuebertragen:uebertrage(
+vater).allesoehneaufdenstack:INT VAR i;LONGROW VAR sohnverzeichnis:=
+systembaum.tabzeile(CONCR (soehne)).knoten;tup.markiert:=false;FOR iFROM 1
+UPTO sohnzahlREP holesohn;IF NOT (schonmalerreicht(sohn))THEN 
+itersohnaufstackELSE indexaendern(s,vater,sohn)FI PER .holesohn:KNOTEN VAR 
+sohn;CONCR (sohn):=sohnverzeichnis_i.itersohnaufstack:tup.kn:=sohn;tup.index
+:=naechsterindex;IF isrefinement(sohn)THEN alserreichtkennzeichnen(sohn)FI ;
+hauptindexaendern(tup,vater);push(s,tup).END PROC reorganisiere;BOOL PROC 
+schonmalerreicht(KNOTEN CONST k):is(k,erreichtkz)END PROC schonmalerreicht;
+BOOL PROC isrefinement(KNOTEN CONST k):is(k,refkz)END PROC isrefinement;BOOL 
+PROC is(KNOTEN CONST k,TEXT CONST muster):is(attribute(k),muster)END PROC is;
+BOOL PROC is(TEXT CONST k,TEXT CONST muster):(subtext(k,1,1)=muster)END PROC 
+is;PROC alserreichtkennzeichnen(KNOTEN CONST k):replace(systembaum.tabzeile(
+CONCR (k)).attribute,1,erreichtkz)END PROC alserreichtkennzeichnen;TEXT PROC 
+attribute(KNOTEN CONST k):systembaum.tabzeile(CONCR (k)).attributeEND PROC 
+attribute;INT PROC naechsterindex:reorg.maxeintragINCR 1;reorg.ersterfreier
+INCR 1;cout(reorg.maxeintrag);reorg.maxeintragEND PROC naechsterindex;PROC 
+uebertrage(TUPEL CONST tup):EINTRAG VAR e;INT VAR knummer:=CONCR (tup.kn);e.
+attribute:=systembaum.tabzeile(knummer).attribute;e.vater:=systembaum.
+tabzeile(knummer).vater;e.knotenmengen:=decr(systembaum.tabzeile(knummer).
+knotenmengen);e.knoten:=decr(systembaum.tabzeile(knummer).knoten);IF 
+schonmalerreichtTHEN replace(e.attribute,1,refkz)FI ;reorg.tabzeile(tup.index
+):=e;CONCR (systembaum.tabzeile(knummer).vater):=tup.index.schonmalerreicht:
+is(e.attribute,erreichtkz).END PROC uebertrage;PROC hauptindexaendern(TUPEL 
+CONST tup,TUPEL CONST vater):INT VAR knummer:=CONCR (tup.kn);LONGROW VAR 
+knotenmengen:=systembaum.tabzeile(knummer).knotenmengen;INT VAR i;FOR iFROM 1
+UPTO length(knotenmengen)REP IF verwaltungodervaterTHEN indexaendern(knummer,
+tup.index,iteknotenmenge,vater.index)FI PER .verwaltungodervater:INT VAR 
+iteknotenmenge:=knotenmengen_i;(iteknotenmenge>maxkn)COR (iteknotenmenge=
+CONCR (vater.kn)).END PROC hauptindexaendern;PROC indexaendern(STACK CONST s,
+TUPEL CONST vater,KNOTEN CONST sohn):INT VAR neuersohnindex:=CONCR (
+systembaum.tabzeile(CONCR (sohn)).vater);IF nochaufstackTHEN 
+sucheneuensohnindexFI ;indexaendern(CONCR (sohn),neuersohnindex,CONCR (vater.
+kn),vater.index);reorg.tabzeile(neuersohnindex).knotenmengen:=decr(systembaum
+.tabzeile(CONCR (sohn)).knotenmengen).nochaufstack:(neuersohnindex>maxkn).
+sucheneuensohnindex:search(s,CONCR (sohn),neuersohnindex);.END PROC 
+indexaendern;PROC indexaendern(INT CONST alterindex,nind,knalt,kneu):INT VAR 
+neuerindex:=nind+reorgincr,knneu:=kneu+reorgincr;IF knalt<=maxknTHEN 
+possystemELSE errechneposition;posverwaltung;FI .possystem:INT VAR ps:=pos(
+systemknoten,alterindex);replace(systemknoten,ps,neuerindex);replace(
+systemknotenmengen,knpos,knneu).systemknoten:systembaum.tabzeile(knalt).
+knoten.systemknotenmengen:systembaum.tabzeile(alterindex).knotenmengen.knpos:
+pos(systemknotenmengen,knalt).errechneposition:INT CONST position:=knalt-
+maxkn.posverwaltung:INT VAR pv:=pos(verwaltungsknoten,alterindex);replace(
+verwaltungsknoten,pv,neuerindex).verwaltungsknoten:verwaltung.tabzeile(
+position).knoten.END PROC indexaendern;LONGROW PROC decr(LONGROW CONST l):
+LONGROW VAR row:=newrow;INT VAR i;FOR iFROM 1UPTO length(l)REP rowCAT ((l_i)
+MOD reorgincr)PER ;rowEND PROC decr;STACK PROC leererstack:STACK VAR s;s.top
+:=bottom;sEND PROC leererstack;OP :=(TUPEL VAR ziel,TUPEL CONST quelle):
+CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle
+):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,TUPEL CONST k):
+IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1ELSE errorstop(
+"Stacküberlauf")FI END PROC push;PROC pop(STACK VAR s,TUPEL VAR k):IF NOT (s.
+top=bottom)THEN s.topDECR 1;k:=s.st(s.top)ELSE errorstop("Stackunterlauf")FI 
+END PROC pop;PROC search(STACK CONST s,INT CONST index,INT VAR neuersohnindex
+):INT VAR i:=0;REP iINCR 1;IF i>s.topTHEN errorstop("Rekursionsauflösung: "+
+text(index)+" nicht auf stack")FI UNTIL CONCR (s.st(i).kn)=indexPER ;
+neuersohnindex:=s.st(i).indexEND PROC search;INT PROC hoehe(STACK CONST s):s.
+top-1END PROC hoehe;BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll
+;BOOL PROC leer(STACK CONST s):s.top=bottomEND PROC leer;END PACKET 
+systembaum;
+
diff --git a/app/baisy/2.2.1-schulis/src/systembauminterpreter b/app/baisy/2.2.1-schulis/src/systembauminterpreter
new file mode 100644
index 0000000..222cdfe
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/systembauminterpreter
@@ -0,0 +1,390 @@
+PACKET systembauminterpreterDEFINES startebaisy,starteschulis,starteanwendung
+,startbaisy:LET esctaste="�",#crtaste="
",#obentaste="�",untentaste="
+",
+rechtstaste="�",hoptaste="�",ausrufezeichen="!",#leertaste=" ",#stufentrenner
+=".",berechttrenner="/",codefuerziffernull=48,codefuerzifferneun=57,
+titelfeldnr=2,felderanzahlbishistoriebeginn=2,historiebeginn=3,maxhknoten=4,
+felderanzahlbismenuebeginn=6,historieende=6,menuebeginn=7,maxmenuepunkte=20,
+felderpromenuepunkt=1,felderimanwahlmenue=18,fcursor=">",fcursorweg=" ",
+laengedescursors=2,offenermenuepunkt="noch nicht realisiert",menuemaskenname=
+"mb anwahlmenue",wartezeit=30,wegtext="  Ihr Weg durch das Menü:",stern="*",
+strich="-",if="Systemfehler ",zeile=" Zeile: ",fortsetzung=
+"Weiterarbeiten ist möglich. Fehlermeldung wird gedruckt!",POINTER =STRUCT (
+INT xpointer,ypointer);KNOTEN VAR k;ROW maxmenuepunkteKNOTEN VAR ktab;ROW 
+maxmenuepunkteBOOL VAR menuepunktanwaehlbar;ROW maxmenuepunktePOINTER VAR 
+pointer;TEXT VAR benutzerberechtigung:="";INT VAR aktfeldnr:=menuebeginn;
+TEXT VAR vpname,npname;BOOL VAR menuemaske:=FALSE ,cursorbewegungmithop:=
+FALSE ;LET zeilenzahlbildschirm=24,spaltenzahlbildschirm=79,
+rahmenzusatzzeilen=4,spaltendesmenuerands=10,maxmenuetextlaenge=60,
+tastenlaenge=4,zeichenblankstern=" *";TEXT VAR ueberschrift:="";INT VAR x1:=1
+,y1:=1,aktuellezeile,spaltendesmenuerahmens,zeilenzahldesfktmenues,
+anzblankstern,textlaenge,cursorx,cursory;KNOTEN VAR 
+knotenfuerbildschirmausdruck,knotenfuerauskunftserteilung;LET 
+knotennamefuerbildschirmausdruck="hardcopy",knotennamefuerauskunftserteilung=
+"auskunft",tastefuerbildschirmausdruck="o",tastefuerauskunftserteilung="?";
+PROC vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call):INT VAR 
+prozedurindex;prozedurindex:=knotenaufrufindex(k);enablestop;call(
+prozedurindex,TRUE ,vpname)END PROC vpausfuehren;PROC npausfuehren(PROC (INT 
+CONST ,BOOL CONST ,TEXT CONST )call):INT VAR prozedurindex;prozedurindex:=
+knotenaufrufindex(k);enablestop;call(prozedurindex,FALSE ,npname)END PROC 
+npausfuehren;BOOL PROC vpvorhanden:NOT ((vpname)="")END PROC vpvorhanden;
+BOOL PROC npvorhanden:NOT ((npname)="")END PROC npvorhanden;PROC 
+bereitemenuemaskenausgabevor:page;loeschetastendruckEND PROC 
+bereitemenuemaskenausgabevor;PROC tasteholen:TEXT VAR zwischentaste;inchar(
+zwischentaste);setzetastendruck(zwischentaste)END PROC tasteholen;PROC 
+gedaechtnisloeschen:TEXT VAR t:=" ";WHILE t<>""REP t:=incharetyPER END PROC 
+gedaechtnisloeschen;PROC setzeschalterfuermenueausgabenachfunktionstaste:IF (
+tastendruck=ausrufezeichen)OR (tastendruck="")THEN 
+setzeschalterfuermenueausgabe(TRUE )ELSE setzeschalterfuermenueausgabe(FALSE 
+)FI .END PROC setzeschalterfuermenueausgabenachfunktionstaste;BOOL PROC 
+anderermenuepunkt:IF nachobenoderuntenTHEN cursorbewegungmithop:=FALSE ;TRUE 
+ELIF tastendruck=hoptasteTHEN tasteholen;IF nachobenoderuntenTHEN 
+cursorbewegungmithop:=TRUE ;TRUE ELIF tastendruck=hoptasteTHEN 
+cursorbewegungmithop:=TRUE ;setzetastendruck(obentaste);TRUE ELSE FALSE FI 
+ELSE FALSE FI .nachobenoderunten:(tastendruck=obentaste)OR (tastendruck=
+untentaste).END PROC anderermenuepunkt;BOOL PROC 
+knotenwechselbeiprozedurausfuehrung:NOT (k=vergleichsknoten)END PROC 
+knotenwechselbeiprozedurausfuehrung;PROC menuetextzusammensetzen(INT CONST 
+mpkt,TEXT CONST stufennum,TEXT VAR menuetext):TEXT VAR kts,ktx;BOOL VAR 
+berechtigt:=FALSE ;IF ktab(mpkt)=nilknotenTHEN ktx:=offenermenuepunkt;
+behandlemenuepunkt(menuetext,mpkt,kts,ktx,FALSE )ELSE ktx:=text(ktab(mpkt));
+berechtigungspruefung(stufennum,mpkt,berechtigt);behandlemenuepunkt(menuetext
+,mpkt,kts,ktx,berechtigt)FI .END PROC menuetextzusammensetzen;PROC 
+behandlemenuepunkt(TEXT VAR menuetextaufber,INT CONST menuepunkt,TEXT CONST 
+ktaste,ktext,BOOL CONST berechtigt):IF berechtigtTHEN menuetextaufber:=""+
+text(menuepunktMOD 10,1)+" "+ktextELSE menuetextaufber:="    "+ktextFI ;
+setzemenuepunktzugang(menuepunkt+maxhknoten,berechtigt).END PROC 
+behandlemenuepunkt;PROC setzemenuepunktzugang(INT CONST feldnr,BOOL CONST 
+wahrwert):menuepunktanwaehlbar(feldnr):=wahrwertEND PROC 
+setzemenuepunktzugang;BOOL PROC zugangerlaubt(INT CONST feldnr):
+menuepunktanwaehlbar(feldnr)END PROC zugangerlaubt;PROC fehlerbehandeln:
+cursor(1,23);TEXT VAR fehlerzeile:=if+errormessage+zeile+text(errorline);put(
+""+fehlerzeile+"�");line;put(fortsetzung+"�");clearerror;#FILE VAR f:=
+sequentialfile(output,if);line(f);putline(f,date+"  "+timeofday);line(f);
+putline(f,text(vergleichsknoten));line(f);putline(f,fehlerzeile);print(if);
+forget(if,quiet)#END PROC fehlerbehandeln;PROC zeige(TEXT VAR te,INT CONST 
+start1,start2,schluss):INT VAR zeile2:=start1+1;cursor(1,start1);out(te);INT 
+CONST ende:=length(te),anfang:=pos(te,stern);INT CONST stellen:=ende-anfang+2
+;historiemalen;trennungslinie;restmalen.historiemalen:cursor(anfang,zeile2);
+out(stern);out(wegtext);cursor(ende,zeile2);out(stern);INT VAR i;FOR iFROM 
+zeile2+1UPTO start2-2REP zeilerausPER .trennungslinie:cursor(anfang,start2-1)
+;out(stern);(stellen-3)TIMESOUT strich;out(stern).restmalen:FOR iFROM start2
+UPTO schluss-1REP zeilerausPER ;cursor(1,schluss);out(te).zeileraus:cursor(
+anfang,i);out(stern);cursor(ende,i);out(stern).END PROC zeige;PROC 
+getposition(INT VAR x,y,INT CONST feldnr):POINTER CONST p:=pointer(feldnr);x
+:=p.xpointer;y:=p.ypointer;END PROC getposition;PROC putposition(TAG VAR t,
+INT CONST feldnr):POINTER VAR p;INT VAR x,y;getcursor(x,y);p.xpointer:=x-
+length(t,feldnr)-laengedescursors;p.ypointer:=y;pointer(feldnr):=pEND PROC 
+putposition;PROC ermittlegrenzwertedesmenuerahmens(INT CONST sohnanz,BOOL 
+CONST nichtvorhandenetaste):INT CONST mindestlaengewegenfehlermeldung:=31;
+ueberschrift:=text(k);spaltendesmenuerahmens:=maxtextlaenge+
+spaltendesmenuerands;IF geradespaltenanzahlTHEN spaltendesmenuerahmensINCR 1;
+textlaengeINCR 1FI ;bestimmezeilenzahldesfktmenues;legeeckpunktefest.
+geradespaltenanzahl:(spaltendesmenuerahmensMOD 2)=0.maxtextlaenge:INT VAR 
+menuepkt;IF nichtvorhandenetasteTHEN textlaenge:=
+mindestlaengewegenfehlermeldungELSE textlaenge:=0FI ;textlaenge:=max(
+textlaenge,length(ueberschrift));FOR menuepktFROM 1UPTO sohnanzREP textlaenge
+:=max(textlaenge,length(text(ktab(menuepkt))))PER ;textlaenge:=min(textlaenge
+,maxmenuetextlaenge);textlaenge.bestimmezeilenzahldesfktmenues:IF 
+nichtvorhandenetasteTHEN zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilen+1
+ELSE zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilenFI .legeeckpunktefest:
+bestimmepositionfuerfktmenueauscursorpos(x1,y1);
+veraenderex1fallshaelftedesbsnichtausreicht;
+veraenderey1fallshaelftedesbsnichtausreicht;aktuellezeile:=y1;anzblankstern:=
+spaltendesmenuerahmensDIV 2.veraenderex1fallshaelftedesbsnichtausreicht:IF (
+x1+spaltendesmenuerahmens)>spaltenzahlbildschirmTHEN x1:=
+spaltenzahlbildschirm-spaltendesmenuerahmensFI .
+veraenderey1fallshaelftedesbsnichtausreicht:IF (y1+zeilenzahldesfktmenues)>
+zeilenzahlbildschirmTHEN y1:=zeilenzahlbildschirm-zeilenzahldesfktmenuesFI .
+END PROC ermittlegrenzwertedesmenuerahmens;PROC 
+bestimmepositionfuerfktmenueauscursorpos(INT VAR xwert,ywert):
+bestimmecursorposition;bestimmeeckpunktlinksoben.bestimmecursorposition:
+getcursor(cursorx,cursory).bestimmeeckpunktlinksoben:IF vierterquadrantTHEN 
+xwert:=1;ywert:=1;ELIF dritterquadrantTHEN xwert:=40;ywert:=1;ELIF 
+zweiterquadrantTHEN xwert:=1;ywert:=13;ELIF ersterquadrantTHEN xwert:=40;
+ywert:=13;FI .ersterquadrant:(cursorx<40)CAND (cursory<13).zweiterquadrant:(
+cursorx>39)CAND (cursory<13).dritterquadrant:(cursorx<40)CAND (cursory>12).
+vierterquadrant:(cursorx>39)CAND (cursory>12).END PROC 
+bestimmepositionfuerfktmenueauscursorpos;PROC 
+zeigefunktionenmenueaufdembildschirm(INT CONST sohnanz,BOOL VAR 
+nichtvorhandenetaste):TEXT CONST meldungungueltigefkttaste:=
+"Diese Funktion gibt es nicht. ";zeigemenuekopfzeile;zeigeueberschriftzeile
+;zeigemenueteil;zeigemenueabschlusszeile.zeigemenuekopfzeile:
+setzecursoraufausgabeanfangsposition;zeichnesternzeile.
+setzecursoraufausgabeanfangsposition:cursor(x1,aktuellezeile).
+zeichnesternzeile:put("*"+(anzblankstern*zeichenblankstern)).
+zeigeueberschriftzeile:setzecursoraufnaechstenzeilenanfang;put("*  "+
+zentrierteueberschrift+"  *").zentrierteueberschrift:TEXT VAR zwtext:=
+zentriert(ueberschrift,textlaenge+tastenlaenge);IF length(zwtext)<(textlaenge
++tastenlaenge)THEN zwtextCAT " "FI ;zwtext.zeigemenueabschlusszeile:
+setzecursoraufnaechstenzeilenanfang;IF nichtvorhandenetasteTHEN 
+gebehinweisaufungueltigefkttaste;setzeschalterzurueck;
+setzecursoraufnaechstenzeilenanfangFI ;zeichnesternzeile.
+gebehinweisaufungueltigefkttaste:put("*  "+eingepasstemeldung+"  *").
+eingepasstemeldung:zwtext:=zentriert(meldungungueltigefkttaste,textlaenge+
+tastenlaenge);IF length(zwtext)<(textlaenge+tastenlaenge)THEN zwtextCAT " "
+FI ;zwtext.setzeschalterzurueck:nichtvorhandenetaste:=FALSE .
+setzecursoraufnaechstenzeilenanfang:aktuellezeileINCR 1;cursor(x1,
+aktuellezeile).zeigemenueteil:zeigeleerzeile;zeigemenuezeilen;zeigeleerzeile.
+zeigeleerzeile:setzecursoraufnaechstenzeilenanfang;leerzeile.leerzeile:put(
+"*"+((spaltendesmenuerahmens-2)*" ")+"*").zeigemenuezeilen:INT VAR menuepkt:=
+0;FOR menuepktFROM 1UPTO sohnanzREP zeigemenuezeilePER .zeigemenuezeile:
+setzecursoraufnaechstenzeilenanfang;put(anfangundfkttaste+aufbereitetertext+
+zeichenblankstern).anfangundfkttaste:"*   "+fkttaste+" ".fkttaste:TEXT VAR 
+aufbertaste:=taste(ktab(menuepkt));IF aufbertaste<>""THEN aufbertasteELSE " "
+FI .aufbereitetertext:IF menuetextzulangTHEN subtext(text(ktab(menuepkt)),1,
+textlaenge)ELSE text(ktab(menuepkt))+restblanksFI .menuetextzulang:length(
+text(ktab(menuepkt)))>textlaenge.restblanks:(textlaenge-length(text(ktab(
+menuepkt))))*" ".END PROC zeigefunktionenmenueaufdembildschirm;TEXT PROC 
+zentriert(TEXT CONST text,INT CONST breite):TEXT CONST blank:=" ";TEXT CONST 
+blanks:=blankausgleich;blanks+text+blanks.blankausgleich:((breite-length(text
+))DIV 2)*blank.END PROC zentriert;PROC einzelknotenfuerfunktionenmenueholen(
+BOOL CONST verteilteanwendung):BOOL VAR ok;IF verteilteanwendungTHEN 
+einzelknotenholen(tastefuerbildschirmausdruck,knotenfuerbildschirmausdruck,ok
+);einzelknotenholen(tastefuerauskunftserteilung,knotenfuerauskunftserteilung,
+ok)ELSE einzelknotenholen(knotennamefuerbildschirmausdruck,
+knotenfuerbildschirmausdruck,ok);einzelknotenholen(
+knotennamefuerauskunftserteilung,knotenfuerauskunftserteilung,ok)FI .END 
+PROC einzelknotenfuerfunktionenmenueholen;PROC startbaisy(TEXT CONST kn,PROC 
+(INT CONST ,BOOL CONST ,TEXT CONST )call):BOOL VAR menuepunktgefunden,
+anwahleineshistoriepunktes:=FALSE ,gueltigetasteimmenue:=FALSE ,
+anderemenueebene:=FALSE ,zurueckuebercursortaste:=FALSE ,nichtvorhandenetaste
+:=FALSE ,ebenenwechsel:=FALSE ,programmeinstiegnachmenueanwahl,#
+benutzerberechtigt:=FALSE ,#druckenkommtimfktmenuevor:=FALSE ,
+auskunftkommtimfktmenuevor:=FALSE ;TAG VAR t,men;TEXT VAR te,stufennummer:=""
+;INT VAR start1,start2,schluss,koordx;TEXT VAR anfangsknotenname;ROW 
+maxhknotenTEXT VAR histtexttab;ROW maxhknotenINT VAR histanwahlpos;INT VAR 
+sohnanzahl,mpkt,letztemenueanwahlpos:=menuebeginn,aktmaxmenuepunkte,x,y;
+KNOTEN VAR sk;KNOTENMENGE VAR ksoehne;initialisierenzumanfang;
+holenamedesanfangsknotens;fortlaufendeknotenbehandlung.
+fortlaufendeknotenbehandlung:REP behandleknotenPER .initialisierenzumanfang:
+IF kn<>""THEN initmaske(men,menuemaskenname);schluss:=ysize(men)FI ;ksoehne:=
+leeremenge;bildschirmwiederholspeichereinschalten.holenamedesanfangsknotens:
+anfangsknotenname:=text(k);.behandleknoten:setzevergleichsknoten(k);
+programmeinstiegnachmenueanwahl:=menuemaske;schaueobmaskediemenuemaskeist;IF 
+vpgewaehltTHEN vpname:=vorprozedur(k);IF vpvorhandenTHEN clearerror;
+disablestop;vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call);IF 
+programmendeTHEN LEAVE fortlaufendeknotenbehandlungFI ;IF iserrorTHEN 
+fehlerbehandeln;clearerrorFI ;enablestop;IF 
+knotenwechselbeiprozedurausfuehrungTHEN vaterknotenalsneuenknotennehmen;
+ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ;holefunktionstaste;ELSE 
+bereitemenuemaskenausgabevorFI ;ELSE IF npgewaehltTHEN npname:=nachprozedur(k
+);IF npvorhandenTHEN clearerror;disablestop;npausfuehren(PROC (INT CONST ,
+BOOL CONST ,TEXT CONST )call);IF programmendeTHEN LEAVE 
+fortlaufendeknotenbehandlungFI ;IF iserrorTHEN fehlerbehandeln;clearerrorFI ;
+enablestop;IF knotenwechselbeiprozedurausfuehrungTHEN 
+vaterknotenalsneuenknotennehmen;ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ;
+holefunktionstaste;ELSE bereitemenuemaskenausgabevorFI ;ELSE 
+bereitemenuemaskenausgabevorFI FI ;holeberechtigungswert(benutzerberechtigung
+);holeallesohnknoten;setzeschalterfuermenueausgabenachfunktionstaste;IF 
+bittedasmenuezeigenTHEN anwahluebermenueELSE direktefunktionstaste;IF 
+nichtvorhandenetasteTHEN setzeschalterfuermenueausgabe(TRUE );
+anwahluebermenueFI ;FI ;holenaechstenknoten.schaueobmaskediemenuemaskeist:
+menuemaske:=nachprozedur(k)="".direktefunktionstaste:menuepunktgefunden:=
+FALSE ;IF sohnanzahl>0THEN 
+pruefetasteundliefereknotenodermenuepunktnichtgefundenFI ;IF NOT 
+menuepunktgefundenTHEN IF tastendruck=tastefuerbildschirmausdruckTHEN sk:=
+knotenfuerbildschirmausdruck;merkeknotenalsgefundenenmenuepunktELIF 
+tastendruck=tastefuerauskunftserteilungTHEN sk:=knotenfuerauskunftserteilung;
+merkeknotenalsgefundenenmenuepunktELSE nichtvorhandenetaste:=TRUE FI FI .
+pruefetasteundliefereknotenodermenuepunktnichtgefunden:menuepunkt:=0;sk:=
+erster(ksoehne);WHILE weitere(sk,ksoehne)AND NOT menuepunktgefundenREP IF (
+NOT isopen(sk))CAND gesuchtetastegefundenTHEN 
+merkeknotenalsgefundenenmenuepunktFI ;naechster(sk)PER .
+merkeknotenalsgefundenenmenuepunkt:menuepunktgefunden:=TRUE ;menuepunktINCR 1
+;ktab(menuepunkt):=sk.gesuchtetastegefunden:taste(sk)=tastendruck.
+holeallesohnknoten:mengedernachfolger(k,ksoehne);sohnanzahl:=zahlderelemente(
+ksoehne).holefunktionstaste:IF NOT gesetztdurcheditorTHEN IF menuemaskeTHEN 
+loeschetastendruckELSE setzetastendruck(incharety(wartezeit))FI FI .
+anwahluebermenue:bildschirmwiederholspeicherausschalten;IF menuemaskeTHEN 
+maskeaufbauen;maskekomplettausgeben;menueanwahlbestimmen;
+setzeschalterfuermenueausgabe(FALSE )ELSE fktmenueaufbauenundausgeben;
+fktmenueanwahlbestimmenFI .fktmenueaufbauenundausgeben:
+holeallesohnknotenfuerfktmenue;ermittlegrenzwertedesmenuerahmens(sohnanzahl,
+nichtvorhandenetaste);zeigefunktionenmenueaufdembildschirm(sohnanzahl,
+nichtvorhandenetaste).holeallesohnknotenfuerfktmenue:menuepunkt:=0;
+druckenkommtimfktmenuevor:=FALSE ;auskunftkommtimfktmenuevor:=FALSE ;sk:=
+erster(ksoehne);REP knotentabfuellenUNTIL (menuepunkt>=sohnanzahl)OR (
+menuepunkt>=maxmenuepunkte)PER ;IF (NOT druckenkommtimfktmenuevor)CAND 
+sohnanzahl<maxmenuepunkteTHEN sohnanzahlINCR 1;ktab(sohnanzahl):=
+knotenfuerbildschirmausdruckFI ;IF (NOT auskunftkommtimfktmenuevor)CAND 
+sohnanzahl<maxmenuepunkteTHEN sohnanzahlINCR 1;ktab(sohnanzahl):=
+knotenfuerauskunftserteilungFI ;aktmaxmenuepunkte:=sohnanzahl.
+knotentabfuellen:menuepunktINCR 1;IF isopen(sk)THEN ktab(menuepunkt):=
+nilknotenELSE ktab(menuepunkt):=sk;IF taste(sk)=tastefuerbildschirmausdruck
+THEN druckenkommtimfktmenuevor:=TRUE ELIF taste(sk)=
+tastefuerauskunftserteilungTHEN auskunftkommtimfktmenuevor:=TRUE FI ;FI ;
+naechster(sk).fktmenueanwahlbestimmen:
+eventuellefehlermeldungimfktmenueausgeben;
+setzecursoraufeinleseanfangsposition;tasteholen;anderemenueebene:=FALSE ;REP 
+tastendruckimfktmenueUNTIL anderemenueebenePER ;
+bildschirmwiederholspeichereinschalten.
+eventuellefehlermeldungimfktmenueausgeben:.
+setzecursoraufeinleseanfangsposition:x:=x1+2;INT VAR yanfang:=y1+3;INT VAR 
+yende:=yanfang+sohnanzahl-1;y:=yanfang;fktcursorzeigen.tastendruckimfktmenue:
+IF anderermenuepunktTHEN fktcursorloeschen;neuenfktmenuepunktbestimmen;
+fktcursorzeigen;tasteholen;ELSE pruefefkttastezudiesemmenue;IF NOT 
+anderemenueebeneTHEN tasteholenFI FI .fktcursorloeschen:cursor(x,y);out(" ").
+fktcursorzeigen:cursor(x,y);out(">");cursor(x,y).pruefefkttastezudiesemmenue:
+IF tastendruck=rechtstasteTHEN anderemenueebene:=TRUE ;
+wandleypositioninmenuepunktnummerum;fktcursorloeschenELIF tastendruck=
+esctasteTHEN anderemenueebene:=TRUE ;funktionenmenueloeschenELSE 
+vergleichetastemitgueltigenfkttasten;IF gueltigetasteimmenueTHEN 
+anderemenueebene:=TRUE ;fktcursorloeschen;wandlemenuepunktnummerinypositionum
+;fktcursorzeigen;fktcursorloeschenFI FI .wandleypositioninmenuepunktnummerum:
+getcursor(x,y);menuepunkt:=y-yanfang+1.wandlemenuepunktnummerinypositionum:y
+:=yanfang+menuepunkt-1.funktionenmenueloeschen:
+schalterzurueckuebercursortasteein;IF vpvorhandenTHEN IF NOT 
+gesetztdurcheditorTHEN reorganizescreen;cursor(cursorx,cursory);
+setlasteditvalues;setzeschalterfuermenueausgabe(FALSE )FI ;return(0)ELSE 
+enter(1)FI .vergleichetastemitgueltigenfkttasten:gueltigetasteimmenue:=FALSE 
+;menuepunkt:=0;WHILE (NOT gueltigetasteimmenue)AND menuepunkt<
+aktmaxmenuepunkteREP menuepunktINCR 1;IF tastendruck=taste(ktab(menuepunkt))
+THEN gueltigetasteimmenue:=TRUE FI PER .neuenfktmenuepunktbestimmen:IF 
+cursorbewegungmithopTHEN aktuellerstenoderletztenfktmenuepunktbestimmenELSE 
+naechstenfktmenuepunktbestimmenFI .
+aktuellerstenoderletztenfktmenuepunktbestimmen:cursorbewegungmithop:=FALSE ;
+IF tastendruck=obentasteTHEN y:=yanfangELSE y:=yendeFI .
+naechstenfktmenuepunktbestimmen:IF tastendruck=obentasteTHEN IF y>yanfang
+THEN yDECR 1ELIF y=yanfangTHEN y:=yendeFI ELIF tastendruck=untentasteTHEN IF 
+y<yendeTHEN yINCR 1ELIF y=yendeTHEN y:=yanfangFI FI .maskeaufbauen:
+holemaskedesknotens;fuellemaske.holemaskedesknotens:t:=men.fuellemaske:
+fuelletitel;fuelletextederhistorie;fuelletextedersoehne.fuelletitel:put(t,
+text(k),titelfeldnr);getcursor(koordx,start2).fuelletextederhistorie:INT VAR 
+hknr,tabzeiger,histmpkt;menuefeldnr:=historieende;FOR hknrFROM 1UPTO 
+maxhknotenREP holehistorietext(menuetext,histmpkt,hknr);tabzeiger:=
+menuefeldnr-felderanzahlbishistoriebeginn;IF menuetext=""THEN 
+setzemenuepunktzugang(tabzeiger,FALSE );menuetext:=" "ELSE 
+setzemenuepunktzugang(tabzeiger,TRUE );histtexttab(hknr):=menuetext;
+histanwahlpos(hknr):=histmpkt;menuetext:=tabzeiger*" "+menuetext;put(t,
+menuetext,menuefeldnr);putposition(t,menuefeldnr);FI ;menuefeldnrDECR 1PER ;
+getposition(koordx,start1,historieende);start1:=start1-maxhknoten-1;te:=
+formline(men,start1);zeige(te,start1,start2,schluss).fuelletextedersoehne:
+TEXT VAR menuetext;INT VAR menuepunkt:=0,menuefeldnr;menuefeldnr:=menuebeginn
+;sk:=erster(ksoehne);WHILE (menuefeldnr<=felderimanwahlmenue)REP menuepunkt
+INCR 1;IF menuepunkt>sohnanzahlTHEN keinenmenuetext;ELSE IF isopen(sk)THEN 
+ktab(menuepunkt):=nilknotenELSE ktab(menuepunkt):=skFI ;
+menuetextzusammensetzen(menuepunkt,stufennummer,menuetext);naechster(sk);put(
+t,menuetext,menuefeldnr);putposition(t,menuefeldnr)FI ;menuefeldnrINCR 1PER ;
+aktmaxmenuepunkte:=menuepunkt.keinenmenuetext:menuetext:=" ";mpkt:=menuepunkt
++maxhknoten;setzemenuepunktzugang(mpkt,FALSE ).maskekomplettausgeben:
+eventuellefehlermeldungausgeben;erstenmenuepunktbestimmen;
+cursorpositionerrechnen;cursorzeigen;tasteholen;anderemenueebene:=FALSE ;REP 
+tastendruckindiesemmenueUNTIL anderemenueebenePER ;cursorloeschen;
+bildschirmwiederholspeichereinschalten.eventuellefehlermeldungausgeben:.
+erstenmenuepunktbestimmen:IF ebenenwechselTHEN ebenenwechsel:=FALSE ;
+aktfeldnr:=letztemenueanwahlposFI ;mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF NOT zugangerlaubt(mpkt)THEN setzetastendruck
+(untentaste);neuenmenuepunktbestimmenFI ;mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF (NOT zugangerlaubt(mpkt))AND menuemaskeTHEN 
+aktfeldnr:=historieendeFI .cursorpositionerrechnen:getposition(x,y,aktfeldnr)
+.cursorzeigen:cursor(x,y);out(fcursor);xDECR 1;cursor(x,y);out(" ").
+cursorloeschen:cursorvormenuepunktloeschen.cursorvormenuepunktloeschen:
+getcursor(x,y);cursor(x,y);out(fcursorweg).tastendruckindiesemmenue:IF 
+anderermenuepunktTHEN cursorloeschen;neuenmenuepunktbestimmen;
+cursorpositionerrechnen;cursorzeigen;tasteholenELSE 
+pruefetastendruckzudiesemmenue;IF NOT anderemenueebeneTHEN tasteholenFI FI .
+pruefetastendruckzudiesemmenue:IF tastendruck=rechtstasteTHEN 
+anderemenueebene:=TRUE ELIF code(tastendruck)>=codefuerziffernullAND code(
+tastendruck)<=codefuerzifferneunTHEN IF code(tastendruck)=codefuerziffernull
+THEN mpkt:=10ELSE mpkt:=code(tastendruck)-codefuerziffernullFI ;IF sohnanzahl
+<mpktTHEN gedaechtnisloeschen;out("�");cursor(x+1,y)ELIF NOT zugangerlaubt(
+mpkt+maxhknoten)THEN gedaechtnisloeschen;out("�");cursor(x+1,y)ELSE 
+anderemenueebene:=TRUE ;cursorloeschen;aktfeldnr:=menuebeginn+(mpkt-1)*
+felderpromenuepunkt;setzetastendruck(rechtstaste);cursorpositionerrechnen;
+cursorzeigenFI FI .neuenmenuepunktbestimmen:IF cursorbewegungmithopTHEN 
+aktuellerstenoderletztenmenuepunktbestimmenELSE naechstenmenuepunktbestimmen
+FI .aktuellerstenoderletztenmenuepunktbestimmen:BOOL VAR 
+erstenoderletztenmenuepunktgefunden:=FALSE ;WHILE NOT 
+erstenoderletztenmenuepunktgefundenREP naechstenmenuepunktbestimmen;IF 
+savefeldnr=aktfeldnrTHEN erstenoderletztenmenuepunktgefunden:=TRUE FI ;PER ;
+cursorbewegungmithop:=FALSE .naechstenmenuepunktbestimmen:BOOL VAR 
+neuenmenuepunktgefunden:=FALSE ;INT VAR savefeldnr:=aktfeldnr;REP 
+sucheneuenmenuepunktUNTIL neuenmenuepunktgefundenPER .sucheneuenmenuepunkt:
+IF tastendruck=obentasteTHEN aktfeldnrDECR felderpromenuepunktELIF 
+tastendruck=untentasteTHEN aktfeldnrINCR felderpromenuepunktFI ;IF 
+cursorbewegungmithopTHEN IF aktfeldnr<historiebeginnOR aktfeldnr>
+felderimanwahlmenueTHEN aktfeldnr:=savefeldnr;neuenmenuepunktgefunden:=TRUE ;
+LEAVE sucheneuenmenuepunktFI ELSE IF aktfeldnr<historiebeginnTHEN aktfeldnr:=
+fields(t)-felderpromenuepunkt+1ELIF aktfeldnr>fields(t)THEN aktfeldnr:=
+historiebeginnFI FI ;IF feldvorhandenTHEN mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF zugangerlaubt(mpkt)THEN 
+neuenmenuepunktgefunden:=TRUE FI ;FI .feldvorhanden:fieldexists(t,aktfeldnr).
+bildschirmwiederholspeicherausschalten:store(FALSE ).
+bildschirmwiederholspeichereinschalten:store(TRUE ).menueanwahlbestimmen:IF 
+menuemaskeTHEN IF aktfeldnr<menuebeginnTHEN letztemenueanwahlpos:=menuebeginn
+ELSE letztemenueanwahlpos:=aktfeldnrFI ;FI ;IF tastendruck=rechtstasteTHEN 
+bestimmemenuepunktfuernaechstesmenueELSE schalterzurueckuebercursortasteein;
+IF vpvorhandenTHEN IF NOT gesetztdurcheditorTHEN reorganizescreenFI ;return(0
+)ELSE enter(1)FI ;FI .bestimmemenuepunktfuernaechstesmenue:IF aktfeldnr>=
+menuebeginnTHEN aktfeldnrDECR felderanzahlbismenuebeginnELSE aktfeldnrDECR 
+felderanzahlbishistoriebeginn;anwahleineshistoriepunktes:=TRUE FI ;menuepunkt
+:=aktfeldnr.holenaechstenknoten:setzeeditorschalterzurueck;IF 
+zurueckuebercursortasteTHEN schalterzurueckuebercursortasteaus;
+vaterknotenalsneuenknotennehmenELIF historiepunktangewaehltTHEN 
+anwahleineshistoriepunktes:=FALSE ;textdeshistoriepunktesbestimmen;
+historieknotenalsneuenknotennehmenELSE knotenaufstackablegen(k);IF 
+aktuellerhistorieknotenTHEN legehistorieknotenab(text(k),menuepunkt)FI ;
+sohnknotenalsneuenknotennehmenFI .historiepunktangewaehlt:
+anwahleineshistoriepunktes.textdeshistoriepunktesbestimmen:TEXT VAR histtext;
+hknr:=maxhknoten+1-menuepunkt;histtext:=histtexttab(hknr);aktfeldnr:=
+historieende+histanwahlpos(hknr).historieknotenalsneuenknotennehmen:REP enter
+(1);vaterknotenalsneuenknotennehmenUNTIL text(k)=histtextPER .
+reduzierestufennummer:INT VAR lstufnr:=length(stufennummer);IF lstufnr<=3
+THEN stufennummer:=""ELSE IF subtext(stufennummer,lstufnr-1,lstufnr-1)=
+stufentrennerTHEN stufennummer:=subtext(stufennummer,1,lstufnr-2)ELSE 
+stufennummer:=subtext(stufennummer,1,lstufnr-3)FI ;FI .
+aktuellerhistorieknoten:menuemaskeOR (text(k)=anfangsknotenname).
+vaterknotenalsneuenknotennehmen:k:=vergleichsknoten;IF nachprozedur(k)=""
+THEN reduzierestufennummerFI .sohnknotenalsneuenknotennehmen:KNOTEN VAR 
+tabknoten:=ktab(menuepunkt);IF reinlokaleoperationTHEN k:=tabknoten;IF 
+menuemaskeTHEN erweiterestufennummerFI ;aktfeldnr:=menuebeginnELSE 
+fuehreknotenwechselmittaskwechseldurch;ebenenwechsel:=TRUE FI ;vpwunsch.
+reinlokaleoperation:TEXT CONST knotentask:=task(tabknoten);knotentask="".
+fuehreknotenwechselmittaskwechseldurch:INT VAR statustaskwechsel:=0;
+umgebungswechsel(tabknoten,knotentask,statustaskwechsel);k:=
+altermenueknotenaufstack;IF statustaskwechsel=1THEN cursor(1,23);put(
+"Verzweigung ist nicht möglich");pauseELIF statustaskwechsel=2THEN cursor(1,
+23);put("es wird bereits innerhalb dieser Anwendungen gearbeitet");pauseFI .
+altermenueknotenaufstack:enter(1);vergleichsknoten.erweiterestufennummer:IF 
+stufennummer=""THEN stufennummer:=berechttrenner+text(menuepunkt)ELSE 
+stufennummer:=stufennummer+stufentrenner+text(menuepunkt)FI .
+schalterzurueckuebercursortasteein:zurueckuebercursortaste:=TRUE .
+schalterzurueckuebercursortasteaus:zurueckuebercursortaste:=FALSE .END PROC 
+startbaisy;PROC berechtigungspruefung(TEXT CONST altnr,INT CONST neunr,BOOL 
+VAR berechtigt):IF NOT menuemaskeTHEN berechtigt:=TRUE ;LEAVE 
+berechtigungspruefungFI ;TEXT VAR berechtstring:=benutzerberechtigung;IF 
+keineberechtigungzugeteiltTHEN berechtigt:=FALSE ;LEAVE berechtigungspruefung
+FI ;berechtigt:=FALSE ;zupruefendestufennummeraufbauen;berechtigungholen;
+WHILE NOT berechtigtAND nocheineberechtigungdaREP IF 
+berechtistpraefixvonpruefnrOR pruefnristpraefixvonberechtTHEN berechtigt:=
+TRUE FI ;berechtigungholenPER .keineberechtigungzugeteilt:berechtstring="".
+nocheineberechtigungda:berecht<>"".zupruefendestufennummeraufbauen:TEXT VAR 
+pruefnr;IF altnr=""THEN pruefnr:=berechttrenner+text(neunr)ELSE pruefnr:=
+altnr+stufentrenner+text(neunr)FI ;pruefnrCAT stufentrenner.berechtigungholen
+:TEXT VAR berecht;IF berechtstringabgearbeitetTHEN berecht:=""ELSE 
+imberechtstringweitereberechtsuchen;IF nurnocheineberechtigungTHEN berecht:=
+berechtstring;berechtstring:=""ELSE berecht:=subtext(berechtstring,1,
+postrennz-1);berechtstring:=subtext(berechtstring,postrennz)FI ;berechtCAT 
+stufentrenner;FI .imberechtstringweitereberechtsuchen:INT VAR postrennz:=pos(
+berechtstring,berechttrenner,2).nurnocheineberechtigung:postrennz=0.
+berechtstringabgearbeitet:berechtstring="".berechtistpraefixvonpruefnr:pos(
+pruefnr,berecht)<>0.pruefnristpraefixvonberecht:pos(berecht,pruefnr)<>0.END 
+PROC berechtigungspruefung;PROC dummycall(INT CONST i,BOOL CONST b,TEXT 
+CONST knotenproc):do(knotenproc)END PROC dummycall;PROC startebaisy(TEXT 
+CONST kn):initsybifunktionen;BOOL VAR knotenda;anfangsknotenholen(kn,k,
+knotenda);holenamedesanfangsknotens;vpwunsch;IF NOT knotendaTHEN put(
+"kein knoten da");pause(50);setzeprogrammende(TRUE )ELIF isopen(k)THEN put(
+"knoten da, aber offen");pause(50);setzeprogrammende(TRUE )FI ;
+setzeanfangsknotennamefuerbenutzerbestand(kn);
+einzelknotenfuerfunktionenmenueholen(verteilt);monitorbehandlungundstart.
+holenamedesanfangsknotens:TEXT VAR anfangsknotenname;anfangsknotenname:=text(
+k);page.verteilt:anfangsknotenname="".monitorbehandlungundstart:putline(
+"Das System "+kn+" wird gestartet.");initmeldungsfunktionen;startbaisy(kn,
+PROC dummycall)END PROC startebaisy;PROC starteanwendung:BOOL VAR knotenda;
+anfangsknotenholen("",k,knotenda);vpwunsch;
+einzelknotenfuerfunktionenmenueholen(TRUE );setzeverteilteanwendung;
+startbaisy("",PROC dummycall)END PROC starteanwendung;PROC startebaisy:
+startebaisy("baisy")END PROC startebaisy;PROC starteschulis:startebaisy(
+"schulis")END PROC starteschulis;END PACKET systembauminterpreter;
+
diff --git a/app/baisy/2.2.1-schulis/src/thesaurusfunktionen b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen
new file mode 100644
index 0000000..d003dc9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen
@@ -0,0 +1,16 @@
+PACKET thesaurusfunktionenDEFINES leererthesaurus,trageinthesaurusein,
+loescheausthesaurus,inthesaurus,zeigethesaurus,uebertragethesaurusindatei:
+THESAURUS VAR saurus;PROC leererthesaurus:saurus:=emptythesaurus;END PROC 
+leererthesaurus;PROC trageinthesaurusein(TEXT CONST objekt):INT VAR index;IF 
+NOT inthesaurus(objekt)THEN insert(saurus,objekt,index)FI ;END PROC 
+trageinthesaurusein;PROC loescheausthesaurus(TEXT CONST loeschtext):INT VAR 
+index;delete(saurus,loeschtext,index);END PROC loescheausthesaurus;BOOL PROC 
+inthesaurus(TEXT CONST objekt):saurusCONTAINS objektEND PROC inthesaurus;
+PROC uebertragethesaurusindatei(TEXT CONST dateiname):IF exists(dateiname)
+THEN forget(dateiname,quiet)FI ;FILE VAR f:=sequentialfile(output,dateiname);
+TEXT VAR zeile;INT VAR index:=0;get(saurus,zeile,index);WHILE index>0REP 
+putline(f,zeile);get(saurus,zeile,index)PER ;END PROC 
+uebertragethesaurusindatei;PROC zeigethesaurus:TEXT VAR zeile;INT VAR index:=
+0;get(saurus,zeile,index);WHILE index>0REP putline(zeile);get(saurus,zeile,
+index)PER ;END PROC zeigethesaurus;END PACKET thesaurusfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/umgebungswechsel manager b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager
new file mode 100644
index 0000000..3b4debb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager
@@ -0,0 +1,19 @@
+PACKET umgebungswechselmanagerDEFINES umgebungswechsel:LET ack=0,nak=1,
+manager=" manager";PROC umgebungswechsel(KNOTEN CONST k,TEXT CONST zieltask,
+INT VAR fstatus):INT VAR kanal;pruefezieltask;IF fstatus=ackTHEN gibkanalfrei
+;sendedatenbankkennungundkanalanmanager;IF fstatus=ackTHEN 
+sendesystembaumundaktuellenknotenansohntaskFI ;belegekanalwiederFI .
+pruefezieltask:disablestop;TASK VAR zielmanager:=/(zieltask+manager),
+stellvertreter;IF iserrorTHEN fstatus:=nakELSE fstatus:=ackFI ;clearerror.
+sendedatenbankkennungundkanalanmanager:DATASPACE VAR dsvar:=nilspace;call(
+zielmanager,kanal,dsvar,stellvertreter,fstatus);forget(dsvar).
+sendesystembaumundaktuellenknotenansohntask:holesystembaumundanfangsknoten;
+call(stellvertreter,anfangsknoten,systembaumds,fstatus);forget(systembaumds).
+gibkanalfrei:kanal:=channel(myself);break(quiet).belegekanalwieder:continue(
+kanal).holesystembaumundanfangsknoten:DATASPACE VAR systembaumds:=systembaum;
+INT CONST anfangsknoten:=nummer(k).END PROC umgebungswechsel;PROC call(TASK 
+CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,TASK VAR stellvertreter,
+INT VAR fstatus):call(zielmanager,kanal,ds,fstatus);IF fstatus=ackTHEN BOUND 
+TASK VAR t:=ds;stellvertreter:=tFI ;forget(ds);break(quiet);END PROC call;
+END PACKET umgebungswechselmanager
+
diff --git a/app/conversion/1.0/source-disk b/app/conversion/1.0/source-disk
new file mode 100644
index 0000000..a14606d
--- /dev/null
+++ b/app/conversion/1.0/source-disk
@@ -0,0 +1 @@
+conversion/eumel-dos-konversion-1.0_1993-02-04.img
diff --git a/app/conversion/1.0/src/AGFA2ASC.TBL b/app/conversion/1.0/src/AGFA2ASC.TBL
new file mode 100644
index 0000000..4e171a5
--- /dev/null
+++ b/app/conversion/1.0/src/AGFA2ASC.TBL
@@ -0,0 +1,19 @@
+"�"  =  "`"      { linker Apostroph }

+"�"  =  """"     { linke Anf�hrungszeichen }

+

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "~a"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+"�"  =  "�"

+

diff --git a/app/conversion/1.0/src/ASKCNVRS.PAC b/app/conversion/1.0/src/ASKCNVRS.PAC
new file mode 100644
index 0000000..7d9dddd
--- /dev/null
+++ b/app/conversion/1.0/src/ASKCNVRS.PAC
@@ -0,0 +1,349 @@
+PACKET asksam conversion DEFINES append asksam field,

+                                 append asksam record,

+                                 convert to asksam :

+LET card prefix = " +--",

+    bo field    = "[ ",

+    eo field    = " ]",

+    eo line     = ""13""10"",

+    eo record   = ""0"",

+    eo doc      = ""0""0"",

+    dummy fn    = "@";

+LET max fields  = 50;

+TEXT VAR in l, out l, appended l, asksam record, buffer;

+INT VAR card no, in line no, out line no, last named field,

+        start pos, end pos, card lines, first line;

+FILE VAR f in, f out;

+THESAURUS VAR field names;

+ROW max fields BOOL VAR complex fields,

+                        to be copied;

+PROC convert to asksam (TEXT CONST input file) :

+  IF NOT exists (input file) THEN errorstop ("") FI;

+  TEXT CONST output file := dos file name (input file, "sam");

+  forget (output file);

+  f out := sequential file (output, output file);

+  field names := empty thesaurus;

+  IF input is eudas

+     THEN convert eudas to asksam (input file)

+  ELIF input is cardbox

+     THEN convert cardbox to asksam

+  ELSE stop process

+  FI

+.

+input is eudas :

+  type (old (input file)) = 3243

+.

+input is cardbox :

+  IF type (old (input file)) = 1003

+     THEN f in := sequential file (modify, input file);

+          toline (f in, 1);

+          down (f in, ""26""26"");

+          pattern found

+     ELSE FALSE

+  FI

+.

+stop process :

+  forget (output file, quiet);

+  errorstop ("Konversion nur f"219"r EUDAS- und Cardbox-Dateien m"218"glich.")

+END PROC convert to asksam;

+PROC convert eudas to asksam (TEXT CONST file name) :

+  oeffne (file name, FALSE);

+  get field names;

+  WHILE NOT dateiende REP

+    transfer one record;

+    weiter (1)

+  PER;

+  dateien loeschen (FALSE)

+.

+get field names :

+  asksam record := "";

+  last named field := anzahl felder;

+  auf satz (1);

+  FOR in line no FROM 1 UPTO last named field REP

+    feld lesen (in line no, in l);

+    IF in l <> ""

+       THEN to be copied [in line no] := TRUE;

+            complex fields [in line no] := is complex field;

+            append field name (in l);

+            feldnamen lesen (in line no, in l);

+            append asksam field (in l)

+       ELSE to be copied [in line no] := FALSE;

+            append field name (dummy fn)

+    FI

+  PER;

+  append asksam record;

+  weiter (1)

+.

+is complex field :

+  end pos := pos (in l, "{");

+  IF end pos <> 0

+     THEN end pos DECR 1;

+          WHILE (in l SUB end pos) = " " REP

+            end pos DECR 1

+          PER;

+          in l := subtext (in l, 1, end pos);

+          TRUE

+     ELSE FALSE

+  FI

+.

+transfer one record :

+  cout (satznummer);

+  asksam record := "";

+  out line no := 0;

+  transfer fields;

+  append asksam record

+.

+transfer fields :

+  FOR in line no FROM 1 UPTO last named field REP

+    IF to be copied [in line no] 

+       THEN feld lesen (in line no, in l);

+            IF in l <> ""

+               THEN IF complex fields [in line no]

+                       THEN transfer complex field (in l)

+                       ELSE append asksam field (in l)

+                    FI

+            FI

+    FI

+  PER

+END PROC convert eudas to asksam;

+PROC transfer complex field (TEXT CONST l) :

+  TEXT VAR transfer buffer;

+  start pos := 1;

+  REP

+    start pos INCR 1;

+    end pos := pos (l, "{", start pos + 1);

+    IF end pos = 0

+       THEN end pos := LENGTH l

+       ELSE end pos DECR 1

+    FI;

+    WHILE (l SUB end pos) = " " REP

+      end pos DECR 1

+    PER;

+    transfer buffer := subtext (l, start pos, end pos);

+    change (transfer buffer, "}", "");

+    append asksam field (transfer buffer);

+    start pos := pos (l, "{", end pos)

+  UNTIL start pos = 0 PER

+END PROC transfer complex field;

+PROC convert cardbox to asksam :

+  BOOL VAR line end;

+  ascertain number lines per card;

+  convert file;

+.

+ascertain number lines per card :

+  toline (f in, 1);

+  col (f in, 1);

+  downety (f in, card prefix);

+  first line := line no (f in);

+  down (f in, card prefix);

+  card lines := line no (f in) - first line

+.

+convert file :

+  line;

+  input (f in);

+  get field names;

+  card no := 0;

+  WHILE NOT eof (f in) REP

+    transfer one card

+  UNTIL asksam record = "" PER

+.

+get field names :

+  last named field := 0;

+  getline (f in, in l);

+  get names from first lines;

+  get names from bulk;

+.

+get names from first lines :

+  FOR in line no FROM 1 UPTO card lines - 2 REP

+    get cardbox line (in l);

+    in l := compress (in l);

+    IF in l > ""

+       THEN append field name (in l);

+            last named field := in line no

+       ELSE append field name (dummy fn)

+    FI

+  PER;

+.

+get names from bulk :

+  in line no := card lines - 2;

+  get cardbox line (in l);

+  end pos := 0;

+  REP

+    get card line (appended l, line end);

+    IF line end

+       THEN LEAVE get names from bulk

+    ELIF appended l <> ""

+       THEN in line no INCR 1;

+            append field name (compress (appended l));

+            last named field INCR 1

+    FI;

+  PER

+END PROC convert cardbox to asksam;

+PROC transfer one card :

+  BOOL VAR line end;

+  card no INCR 1;

+  cout (card no);

+  asksam record := "";

+  transfer first lines;

+  transfer bulk line;

+  append asksam record

+.

+transfer first lines :

+  getline (f in, in l);

+  IF pos (in l, card prefix) <> 2

+     THEN errorstop ("Programmfehler 1")

+  ELIF pos (in l, "LAST CARD") <> 0

+     THEN LEAVE transfer one card

+  FI;

+  out line no := 0;

+  FOR in line no FROM 1 UPTO card lines - 2 REP

+    get cardbox line (in l);

+    IF pos (in l, ""25""25"") = 1

+       THEN process hypertext

+       ELSE append asksam field (in l)

+    FI;

+  PER

+.

+process hypertext :

+  asksam record CAT ":"13""10""9"";

+  end pos := pos (in l, ".card") - 1;

+  appended l := subtext (in l, 55, end pos);

+  asksam record CAT appended l;

+  asksam record CAT ""255""13""10""13""10"";

+  asksam record CAT "(Datei zum Thema `";

+  asksam record CAT appended l;

+  asksam record CAT "')"13""10"";

+  out line no := 4

+.

+transfer bulk line :

+  get cardbox line (in l);

+  end pos := 0;

+  first line := 0;

+  in line no DECR 1;

+  REP

+    get card line (appended l, line end);

+    IF line end

+       THEN LEAVE transfer bulk line

+    FI;

+    in line no INCR 1;

+    cout (in line no);

+    append asksam field (appended l)

+  PER

+END PROC transfer one card;

+PROC get cardbox line (TEXT VAR t) :

+  getline (f in, t);

+  start pos := pos (t, "|");

+  IF start pos = 0

+     THEN errorstop ("Programmfehler 2")

+  FI;

+  t := subtext (t, start pos + 1)

+END PROC get cardbox line;

+PROC get card line (TEXT VAR t, BOOL VAR end) :

+  start pos := pos (in l, ""32"", ""255"", endpos + 1);

+  IF start pos = 0

+     THEN end := TRUE;

+          LEAVE get card line

+  FI;

+  end pos := pos (in l, ""26"", start pos);

+  IF end pos = 0     

+     THEN end := TRUE;

+          LEAVE get card line

+  FI;

+  end pos DECR 1;

+  t := subtext (in l, start pos, end pos);

+  end := FALSE

+END PROC get card line;

+PROC append asksam line (TEXT CONST t) :

+  asksam record CAT t;

+  out line no INCR 1;

+  IF out line no MOD 20 = 0

+     THEN asksam record CAT eo record

+     ELSE asksam record CAT eo line

+  FI

+END PROC append asksam line;

+PROC append asksam field (TEXT CONST t) :

+  BOOL VAR named field;

+  INT VAR s pos, e pos, length l;

+  IF t > " " CAND in line no <= last named field

+     THEN get field name (in line no, out l);

+          IF out l <> dummy fn

+             THEN out l CAT bo field;

+                  named field := TRUE

+             ELSE out l := "";

+                  named field := FALSE

+          FI

+     ELSE out l := "";

+          named field := FALSE

+  FI;

+  buffer := t;

+  prepare line for asksam (buffer);

+  out l CAT buffer;

+  transfer line

+.

+transfer line :

+  length l := LENGTH out l;

+  e pos := -1;

+  REP

+    s pos := e pos + 2;

+    IF (length l - s pos) > 79

+       THEN determine e pos;

+            transfer chunk

+       ELSE transfer rest

+    FI

+  PER

+.

+determine e pos :

+  e pos := s pos + 79;

+  move before last blank

+.

+move before last blank :

+  WHILE (out l SUB e pos) <> " " REP

+    e pos DECR 1

+  UNTIL e pos = s pos PER;

+  IF e pos = s pos

+     THEN e pos := s pos + 79

+     ELSE e pos DECR 1

+  FI

+.

+transfer chunk :

+  append asksam line (subtext (out l, s pos, e pos));

+.

+transfer rest :

+  buffer := subtext (out l, s pos);

+  IF named field

+     THEN buffer CAT eo field

+  FI;

+  append asksam line (buffer);

+  LEAVE transfer line

+END PROC append asksam field;

+PROC append asksam record :

+  IF was eo record

+     THEN asksam record CAT eo record

+     ELSE buffer := subtext (asksam record, 1, LENGTH asksam record - 2);

+          buffer CAT eo doc;

+          asksam record := buffer

+  FI;

+  putline (f out, asksam record)

+.

+was eo record :

+  out line no MOD 20 = 0

+END PROC append asksam record;

+PROC prepare line for asksam (TEXT VAR t) :

+  IF (t SUB LENGTH t) = " "

+     THEN t := subtext (t, 1, LENGTH t - 1)

+  FI;

+  replace eumel special characters (t);

+  change all (t, "[", ""174"");

+  change all (t, "]", ""175"");

+  change all (t, "#on(""i"")#", "<I>");

+  change all (t, "#off(""i"")#", "<i>")

+END PROC prepare line for asksam;

+PROC append field name (TEXT CONST fn) :

+  INT VAR index;

+  buffer := fn;

+  prepare line for asksam (buffer);

+  insert (field names, buffer, index)

+END PROC append field name;

+PROC get field name (INT CONST index, TEXT VAR fn) :

+  fn := name (field names, index)

+END PROC get field name;

+END PACKET asksam conversion;

diff --git a/app/conversion/1.0/src/DOSCNVRS.PAC b/app/conversion/1.0/src/DOSCNVRS.PAC
new file mode 100644
index 0000000..e9ac2d4
--- /dev/null
+++ b/app/conversion/1.0/src/DOSCNVRS.PAC
@@ -0,0 +1,203 @@
+PACKET dos conversion DEFINES 

+                              convert to dos file,

+                              dos file name,

+                              replace eumel special characters,

+                              replace multiple blanks by tab stops,

+                              trim end of line,

+                              refuse nonwrapped file 

+                              :

+LET eumel line display pos = 1,

+    dos   line display pos = 10;

+TEXT VAR in l, out l, next l, last char, buffer;

+INT VAR act l no, cursor x, cursor y,

+        this line indentation, next line indentation;

+PROC replace inadmissible characters (TEXT VAR t) :

+  LET inadmissible chars = """*+,./:;<=>?| ";

+  INT VAR i;

+  FOR i FROM 1 UPTO LENGTH inadmissible chars REP

+    last char := inadmissible chars SUB i;

+    change all (t, last char, "_")

+  PER

+END PROC replace inadmissible characters;

+TEXT PROC dos file name (TEXT CONST eumel file name) :

+  INT VAR p := rpos (eumel file name, ".");

+  IF p <> 0

+     THEN in l := subtext (eumel file name, p+1, p+3);

+          p := min (p, 9);

+          out l := subtext (eumel file name, 1, p-1);

+     ELSE in l := "dos";

+          out l := subtext (eumel file name, 1, 8)

+  FI;

+  dos fn (out l, in l)

+END PROC dos file name;

+TEXT PROC dos file name (TEXT CONST eumel name, extension) :

+  INT VAR p := rpos (eumel name, ".");

+  IF p <> 0

+     THEN p := min (p, 9);

+          out l := subtext (eumel name, 1, p-1);

+     ELSE out l := subtext (eumel name, 1, 8)

+  FI;

+  dos fn (out l, extension)

+END PROC dos file name;

+TEXT PROC dos fn (TEXT CONST name, extension) :

+  buffer := name;

+  replace inadmissible characters (buffer);

+  buffer CAT ".";

+  buffer CAT extension;

+  buffer

+END PROC dos fn;

+PROC convert to dos file (TEXT CONST eumel file name) :

+  LET tab char   = ""9"";

+  TEXT CONST dfn := dos file name (eumel file name);

+  BOOL VAR is last line of paragraph,

+           in table := FALSE;

+  get cursor (cursor x, cursor y);

+  FILE VAR f := sequential file (input, eumel file name);

+  IF word wrap (f)

+     THEN input (f)          

+     ELSE refuse nonwrapped file

+  FI;

+  forget (dfn, quiet);

+  FILE VAR g := sequential file (output, dfn);

+  max line length (g, max text length);

+  INT CONST file lines := lines (f);

+  act l no := 0;

+  out l := "";

+  getline (f, next l);

+  next line indentation := pos (next l, ""33"", ""255"", 1);

+  REP

+    in l := next l;

+    act l no INCR 1;

+    cursor (eumel line display pos, cursor y);

+    cout (act l no);

+    this line indentation := next line indentation;

+    IF act l no >= file lines

+       THEN next l := "";

+            next line indentation := 1

+       ELSE getline (f, next l);

+            next line indentation := pos (next l, ""33"", ""255"", 1)

+    FI;

+    trim act line;

+    out l CAT in l;

+    IF is last line of paragraph CAND

+       NOT only command line (in l)

+       THEN putline (g, out l);

+            out l := "";

+            cursor (dos line display pos, cursor y);

+            cout (line no (g))

+    FI

+  UNTIL act l no >= file lines PER

+.

+  trim act line :

+    IF pos (in l, "#table#") <> 0

+       THEN in table := TRUE

+    ELIF pos (in l, "#table end") <> 0 COR

+         pos (in l, "#tableend") <> 0

+       THEN in table := FALSE

+    FI;

+    trim end of line (in l, is last line of paragraph, in table);

+    replace eumel special characters (in l);

+    trim start of line;

+    replace multiple blanks by tab stops (in l, tab char)

+.

+  trim start of line :

+    IF this line indentation > 2

+       THEN IF is first line of paragraph

+               THEN change (in l, 1, this line indentation - 1, tab char)

+               ELSE in l := subtext (in l, this line indentation)

+            FI

+    FI

+.

+  is first line of paragraph : out l = ""

+END PROC convert to dos file;

+PROC replace eumel special characters (TEXT VAR l) :

+  LET eumel chars = ""217""218""219""214""215""216""251""221""220""222""223""252"",

+      dos   chars = ""132""148""129""142""153""154""225"-k# "21"";

+  INT VAR p;

+  FOR p FROM 1 UPTO LENGTH eumel chars REP

+    change all (l, eumel chars SUB p, dos chars SUB p)

+  PER

+END PROC replace eumel special characters;

+PROC replace eumel special characters (TEXT VAR l,

+     BOOL VAR contains number sign) :

+  LET eumel chars = ""217""218""219""214""215""216""251""221""220""223""252"",

+      dos   chars = ""132""148""129""142""153""154""225"-k "21"";

+  INT VAR p;

+  FOR p FROM 1 UPTO LENGTH eumel chars REP

+    change all (l, eumel chars SUB p, dos chars SUB p)

+  PER;

+  contains number sign := pos (l, ""222"") <> 0

+END PROC replace eumel special characters;

+PROC replace multiple blanks by tab stops (TEXT VAR line, TEXT CONST tab char) :

+  TEXT VAR new line := "";

+  INT VAR double blank pos, transfer start pos := 1,

+          blank length;

+  line loop;

+  line := new line

+.

+  line loop :

+    WHILE transfer start pos <> 0 REP

+      double blank pos := pos (line, "  ", transfer start pos);

+      IF double blank pos = 0

+         THEN transfer rest of line

+         ELSE transfer text;

+              transfer tab

+      FI

+    UNTIL double blank pos = 0 PER

+.

+  transfer rest of line :

+    buffer := subtext (line, transfer start pos);

+    new line CAT buffer

+.

+  transfer text :

+    buffer := subtext (line, transfer start pos, double blank pos - 1);

+    new line CAT buffer

+.

+  transfer tab :

+    transfer start pos := pos (line, ""33"", ""255"", double blank pos);

+    IF transfer start pos = 0            

+       THEN new line CAT ""13""10""

+       ELSE blank length := transfer start pos - double blank pos;

+            new line CAT (blank length DIV 2) * tab char

+    FI

+END PROC replace multiple blanks by tab stops;

+PROC replace multiple blanks by tab stops (TEXT VAR l) :

+  replace multiple blanks by tab stops (l, ""9"")

+END PROC replace multiple blanks by tab stops;

+PROC trim end of line (TEXT VAR l, BOOL VAR last paragraph line,

+                       BOOL CONST in table) :

+  LET syllabication hyphen = ""221"",

+      syllabication k      = ""220"",

+      protected blank      = ""223"";

+  INT CONST line end := LENGTH l;

+  last paragraph line := FALSE;

+  last char := l SUB line end;

+  IF last char = syllabication hyphen

+     THEN IF (l SUB (line end - 1)) = syllabication k

+             THEN l := subtext (l, 1, line end - 2);

+                  l CAT "c"

+             ELSE l := subtext (l, 1, line end - 1)

+          FI

+  ELIF last char = " " COR

+     (in table CAND last char = protected blank) COR

+     line end = 0

+     THEN l := subtext (l, 1, line end - 1);

+          IF NOT only command line (l)

+             THEN l CAT ""13""10"";

+                  last paragraph line := TRUE

+          FI

+  ELIF last char <> "-" CAND

+       NOT only command line (l) CAND

+       no footnote start at end of line

+     THEN l CAT " "

+  FI

+.

+no footnote start at end of line :

+  pos (l, "#foot#", line end - 5) <> line end - 5

+END PROC trim end of line;

+PROC refuse nonwrapped file :

+  putline (""13""10"F"219"r Dateien ohne `word wrap' (kein Leerzeichen am Absatzende)");

+  putline ("ist Konversion weder m"218"glich noch n"218"tig.");

+  errorstop ("Datei bitte direkt nach DOS schreiben.")

+END PROC refuse nonwrapped file;

+END PACKET dos conversion;

diff --git a/app/conversion/1.0/src/EU_CNVRS.DOC b/app/conversion/1.0/src/EU_CNVRS.DOC
new file mode 100644
index 0000000..fb71f95
--- /dev/null
+++ b/app/conversion/1.0/src/EU_CNVRS.DOC
@@ -0,0 +1,150 @@
+#type ("prop")##limit (16.0)# 

+#pagelength (26.5)##pageblock##linefeed (1.15)# 

+#head# 

+#right#%#free(1.0)# 

+#end# 

+#type("10")##on("b")##center#EUMEL-DOS-Konversion 

+#center#Konversion von Dateien des EUMEL-Systems nach DOS 

+#type("prop")# 

+ 

+Version 1.0, 06.02.93 

+ 

+Copyright:      Miquel Aguado 

+                Christian Lehmann 

+ 

+ 

+1. Leistungen 

+EUMEL-Textdateien werden samt Textkosmetik nach WordPerfect konvertiert. 

+EUDAS- und Cardboxdateien werden samt Feldstruktur nach AskSam konver-

+tiert. 

+ 

+2. Installation 

+2.1. EUMEL 

+- DOS-Task im Ibm-Modus reservieren (`reserve ("file ibm", dostask)', wo

+  dostask = /"DOS" oder = /"DOS HD"). 

+- Die Pakete (mit *.pac-Extension) von der Diskette lesen und in folgender

+  Reihenfolge insertieren: 

+    fileutil.pac 

+    doscnvrs.pac 

+    askcnvrs.pac 

+    fontanal.pac 

+    wp_knvrs.pac  (f�r die deutsche WordPerfect-Version) bzw. 

+    wp_cnvrs.pac  (f�r die englische WordPerfect-Version). 

+- Das Paket `askcnvrs.pac' kann nur unter EUDAS insertiert werden, wird

+  aber auch nur ben�tigt, wenn EUDAS- oder Cardbox-Dateien konvertiert

+  werden sollen. In dem Falle w�ren dann zuvor `fileutil.pac' und

+  `doscnvrs.pac' in derselben Task zu insertieren. 

+- Alle Dateien mit *.pac-Extension wieder aus dem System l�schen. 

+- Datei `agfa2asc.tbl' von der Diskette kopieren. 

+ 

+2.2. DOS 

+Die Datei 

+    ps_wp_dt.wpm   (f�r die deutsche WordPerfect-Version)  bzw. 

+    pseudowp.wpm   (f�r die englische WordPerfect-Version) 

+von der Diskette in das WordPerfect-Unterverzeichnis kopieren, in dem die

+Makros sind. 

+ 

+3. Benutzung 

+3.1. Text-Dateien 

+3.1.1. EUMEL 

+3.1.1.1. Vorbereitung 

+- In der zu konvertierenden Datei enthaltene Makros und selbstdefinierte

+  Textkosmetikanweisungen aufl�sen. 

+- Schrifttypen verschiedener Familien (z.B. `trium' und `modern') auf eine

+  Familie reduzieren, also z.B. `modern10' durch `trium12' ersetzen (vgl.

+  �3.1.1.3). 

+- Sicherstellen, da� die letzte Zeile der Datei ein Absatzzeichen hat. 

+- Datei mit `lineform' formatieren. (Die Konversion nach WordPerfect f�ngt

+  keine Textkosmetikfehler ab!) 

+- Solche Sonderzeichen, die nicht zum EUMEL-Standard geh�ren, in der zu

+  konvertierenden Datei an den Ascii-Code anpassen. Das geht z.B. mit

+  `filechange (TEXT CONST dateiname, umsetzungstabelle)'. Dazu ist die

+  Tabelle `agfa2asc.tbl' da. Sie mu� gegebenenfalls erweitert werden. 

+- Sicherstellen, da� die in der Datei benutzte Fonttabelle in der Task

+  `configurator' ist. 

+ 

+3.1.1.2. Konversion 

+- Datei mit 

+    konvertiere nach wp (TEXT CONST dateiname) 

+                               (f�r die deutsche WordPerfect-Version) bzw. 

+    convert to wp (TEXT CONST dateiname) 

+                               (f�r die englische WordPerfect-Version) 

+  konvertieren. 

+- DOS-Task im Transparent-Modus reservieren (`reserve ("file transparent",

+  dostask)'). 

+- Pr�konvertierte Datei (mit *.wpf-Extension) nach DOS schreiben. 

+ 

+3.1.1.3. Bei der �bertragung geht Information verloren: 

+- Makros und selbstdefinierte Textkosmetikanweisungen werden nicht

+  �bertragen. 

+- Einr�ckungen werden ungenau �bertragen. 

+- Schrifttypen verschiedener Familien (z.B. Times und Modern) werden

+  nicht auseinandergehalten, sondern zu einer Familie zusammengefa�t.

+  Qualit�tsunterschiede werden dabei auf Gr��enunterschiede reduziert.

+  Dabei entstehen sehr eng besetzte Gr��enskalen, die sp�ter nach den

+  Standards von WordPerfect wieder auseinandergezogen werden. 

+- Folgende Textkosmetik-Anweisungen werden in der aktuellen Version

+  ignoriert: 

+    page nr 

+    material 

+    skip, skip end 

+    head on 

+    fillchar 

+    mark cmd, mark end 

+    pageblock 

+    bsp 

+    counter1/2 

+    setcounter 

+    putcounter0/1 

+    storecounter 

+    fb 

+    fe 

+  Die meisten davon haben kein Gegenst�ck in WordPerfect. 

+ 

+3.1.2. DOS 

+3.1.2.1. Vorbereitung 

+- WordPerfect aufrufen. 

+- Folgende Einstellungen machen: 

+  - Drucker (SHIFT F7, d [deutsche Version] bzw. s [englische Version]); 

+  - gew�nschte Basis-Schrifttype (CTRL F8, 4); 

+  - Ma�einheit: cm (SHIFT F1, 3, 8, 1, c); 

+  - Standard-Tastatur (SHIFT F1, 5, 6) oder jedenfalls keine mit einer

+    anderen Funktionstastenbelegung. 

+ 

+3.1.2.2. Konversion 

+- Pr�konvertierte Datei laden. 

+- Makro aufrufen (ALT F10), und zwar 

+    ps_wp_dt.wpm   (f�r die deutsche WordPerfect-Version)  bzw. 

+    pseudowp.wpm   (f�r die englische WordPerfect-Version). 

+  Geduld! 

+ 

+3.1.2.3. Besonderheiten 

+Alle in EUMEL mit `count()' und `value()' durchnumerierten Z�hler sind in

+der WP-Datei in solche von (leeren) `Endnotes' gewandelt. Letztere befin-

+den sich am Ende der Datei und brauchen erst beim Drucken unterdr�ckt

+zu werden. Zus�tzliche wirkliche Endnotes (im Gegensatz zu Fu�noten) sind

+dann nat�rlich nicht m�glich. 

+ 

+3.2. Ascii-Dateien 

+EUMEL-Dateien, die in einem gew�hnlichen Ascii-Editor weiterverarbeitet

+werden sollen (z.B. Programmdateien), werden mit 

+    convert to dos file (TEXT CONST dateiname) 

+konvertiert und im Transparent-Modus nach DOS geschrieben. 

+ 

+3.3. Datenbank-Dateien 

+3.3.1. EUMEL 

+EUDAS- und Cardbox-Dateien werden nach AskSam konvertiert. 

+- Solche Sonderzeichen, die nicht zum EUMEL-Standard geh�ren, in zu

+  konvertierenden Dateien an den Ascii-Code anpassen. 

+- In den ersten Datensatz die neuen Feldnamen schreiben (in EUDAS neben

+  die zugeh�rigen alten Feldnamen, in Cardbox untereinander an den linken

+  Rand). 

+- Datei mit `convert to asksam (TEXT CONST dateiname)' konvertieren. 

+- DOS-Task im Transparent-Modus reservieren. 

+- Datei nach DOS schreiben. 

+ 

+3.3.2. DOS 

+- AskSam aufrufen. 

+- Neue Datei kreieren. 

+- Sam-Modus, Flie�text (`free mode') und `Formatiert' (`stream') einstellen. 

+- Konvertierte Datei importieren. 

diff --git a/app/conversion/1.0/src/FILEUTIL.PAC b/app/conversion/1.0/src/FILEUTIL.PAC
new file mode 100644
index 0000000..f772a38
--- /dev/null
+++ b/app/conversion/1.0/src/FILEUTIL.PAC
@@ -0,0 +1,142 @@
+PACKET eumel file utilities

+                             DEFINES sort,

+                                     in denoter,

+                                     even number of command delimiters,

+                                     extract command,

+                                     next text command pos,

+                                     word wrap,

+                                     enumerator,

+                                     enumeration offset :

+PROC sort (THESAURUS VAR th) :

+  disable stop;

+  FILE VAR d := sequential file (output, "dummy");

+  d FILLBY th;

+  sort ("dummy");

+  th := empty thesaurus;

+  input (d);

+  th FILLBY d;

+  forget ("dummy", quiet);

+  enable stop

+END PROC sort;

+BOOL PROC in denoter (TEXT CONST l, INT CONST p) :

+  INT VAR number of quotes := 0,

+          last quote pos,

+          quote pos := 0;

+  quote count loop;

+  number of quotes MOD 2 = 1

+.

+quote count loop :

+  REP

+    last quote pos := quote pos;

+    quote pos := pos (l, """", last quote pos + 1, p - 1);

+    IF quote pos <> 0

+       THEN number of quotes INCR 1

+       ELSE LEAVE quote count loop

+    FI

+ PER

+END PROC in denoter;

+BOOL PROC even number of command delimiters (TEXT CONST l, INT CONST end pos) :

+  INT VAR number := 0, current pos := 1, cross pos;

+  counting loop;

+  number MOD 2 = 0

+.

+  counting loop :

+  REP

+    cross pos := pos (l, "#", current pos, end pos);

+    IF cross pos <> 0

+       THEN number INCR 1;

+            current pos := cross pos + 1

+    FI

+  UNTIL cross pos = 0 PER

+END PROC even number of command delimiters;

+BOOL PROC even number of command delimiters (TEXT CONST l) :

+  even number of command delimiters (l, LENGTH l)

+END PROC even number of command delimiters;

+PROC extract command (TEXT CONST l, INT CONST start pos, INT VAR next pos,

+                      TEXT VAR cmd) :

+  next pos := pos (l, "#", start pos + 1);

+  IF next pos = 0

+     THEN errorstop ("unkorrekte Textanweisung")

+  FI;

+  cmd := subtext (l, start pos + 1, next pos - 1);

+  next pos INCR 1

+END PROC extract command;

+PROC next text command pos (TEXT CONST t, INT CONST start pos,

+                            INT VAR start cross pos, end cross pos) :

+  start cross pos := pos (t, "#", start pos);

+  IF start cross pos <> 0 

+     THEN end cross pos := pos (t, "#", start cross pos + 1)

+  FI

+END PROC next text command pos;

+BOOL PROC word wrap (TEXT CONST file name) :

+  FILE VAR f := sequential file (input, file name);

+  word wrap (f)

+END PROC word wrap;

+BOOL PROC word wrap (FILE VAR f) :

+  TEXT VAR l;

+  modify (f);       

+  toline (f, lines (f));

+  WHILE line no (f) > 1 REP

+    read record (f, l);

+    IF l <> ""

+       THEN LEAVE word wrap WITH (l SUB LENGTH l) = " "

+       ELSE up (f, 1)

+    FI

+  PER;

+  FALSE

+END PROC word wrap;

+INT PROC enumeration offset (TEXT CONST this line, next line,

+                             BOOL CONST in enumeration, INT CONST start pos) :

+  TEXT VAR initial chunk, next line initial chunk;

+  INT VAR blank pos, next line blank pos,

+          text start pos := 0, next line text start pos;

+  IF NOT only command line (this line)

+     THEN ascertain text start pos

+  FI;

+  text start pos

+.

+ascertain text start pos :

+  blank pos := pos (this line, " ", start pos);

+  IF blank pos > 1 CAND blank pos < LENGTH this line

+     THEN text start pos := pos (this line, ""33"", ""255"", blank pos);

+          IF is enumeration

+             THEN text start pos DECR 1

+             ELSE text start pos := 0

+          FI

+  FI

+.

+is enumeration :

+  neighboring lines correspond CAND this line is enumerated

+.

+neighboring lines correspond :

+  in enumeration COR next line corresponds

+.

+next line corresponds :

+  next line blank pos := pos (next line, " ", start pos);

+  next line text start pos :=

+                       pos (next line, ""33"", ""255"", next line blank pos);

+  text start pos = next line text start pos CAND

+  (next line indented COR also enumerated)

+.

+next line indented :

+  pos (next line, ""33"", ""255"", 1) = next line text start pos

+.

+also enumerated :

+  next line initial chunk

+                  := subtext (next line, start pos, next line blank pos - 1);

+  enumerator (next line initial chunk)

+.

+this line is enumerated :

+  initial chunk := subtext (this line, start pos, blank pos - 1);

+  enumerator (initial chunk)

+END PROC enumeration offset;

+BOOL PROC enumerator (TEXT CONST t) :

+  t = "-" COR substantial enumerator

+.

+substantial enumerator :

+  INT CONST l := LENGTH t;

+  TEXT CONST last char := t SUB l;

+  l < 20 CAND last char = ":" COR

+  l < 7 CAND pos (".)", last char) <> 0

+END PROC enumerator;

+END PACKET eumel file utilities;

diff --git a/app/conversion/1.0/src/FONTANAL.PAC b/app/conversion/1.0/src/FONTANAL.PAC
new file mode 100644
index 0000000..c1dc502
--- /dev/null
+++ b/app/conversion/1.0/src/FONTANAL.PAC
@@ -0,0 +1,261 @@
+PACKET font analysis DEFINES  find fonttable,

+                              analyze fonts,

+                              analyze indent levels :

+INT VAR th index, cmd index, no of params;

+TEXT VAR buffer line;

+TEXT PROC next type command (FILE VAR f, INT VAR line number, cont pos) :

+  INT VAR start pos;

+  TEXT VAR type cmd := "";

+  search loop;

+  line number := line no (f);

+  type cmd

+.

+  search loop :

+    REP

+      downety (f, "#type");

+      IF pattern found

+         THEN start pos := col (f);

+              read record (f, buffer line);

+              IF even number of command delimiters (buffer line, start pos - 1)

+                 THEN extract command (buffer line, start pos, cont pos, type cmd);

+                      col (f, cont pos);

+                      LEAVE search loop

+                 ELSE col (f, start pos + 1)

+              FI

+      FI

+    UNTIL NOT pattern found PER;

+    cont pos := col (f)

+END PROC next type command;

+PROC find fonttable (THESAURUS CONST used fonts th, TEXT VAR table name) :

+  LET old table type = 3009,

+      new table type = 3100;

+  TEXT VAR font name;

+  TEXT CONST users fonttable := fonttable;

+  INT VAR ds type, fonttable th index;

+  disable stop;

+  command dialogue (FALSE);

+  THESAURUS CONST fonttable th := ALL /"configurator";

+  try all fonttables;

+  fonttable (users fonttable);

+  command dialogue (TRUE);

+  enable stop;

+  IF table name = ""

+     THEN errorstop ("Keine zur Datei passende Fonttabelle gefunden")

+  FI

+.

+try all fonttables :

+  fonttable th index := 0;

+  get (fonttable th, table name, fonttable th index);

+  WHILE fonttable th index > 0 REP

+    fetch (table name, /"configurator");

+    ds type := type (old (table name));

+    forget (table name);

+    IF ds type = old table type COR ds type = new table type

+       THEN fonttable (table name);

+            IF is error

+               THEN put error;

+                    putline ("Fonttabelle `" + table name + "' kann nicht eingestellt werden.");

+                    IF yes ("Abbrechen")

+                       THEN enable stop

+                       ELSE clear error

+                    FI

+               ELSE IF all used fonts present

+                       THEN LEAVE try all fonttables

+                    FI

+            FI

+    FI;

+    get (fonttable th, table name, fonttable th index)

+  PER;

+  table name := ""

+.

+all used fonts present :

+  th index := 0;

+  get (used fonts th, font name, th index);

+  WHILE th index > 0 REP

+    IF NOT font exists (font name)

+       THEN LEAVE all used fonts present WITH FALSE

+    FI;

+    get (used fonts th, font name, th index)

+  PER;

+  TRUE

+END PROC find fonttable;

+PROC analyze fonts (FILE VAR f, TEXT VAR fonttable name,

+                    font numbers, INT VAR base font index) :

+  THESAURUS VAR font th;

+  TEXT VAR usage, base font;

+  fonttable name := "";

+  font numbers := "";

+  base font index := 0;

+  collect fonts (f, font th, usage);

+  IF highest entry (font th) <> 0

+     THEN analyze users fonts

+  FI;

+.

+analyze users fonts :

+  find fonttable (font th, fonttable name);

+  TEXT CONST users fonttable := fonttable;

+  fonttable (fonttable name);

+  provide font numbers (font th, font numbers, usage, base font);

+  sort fonts (font numbers);

+  base font index := pos (font numbers, base font);

+  IF users fonttable <> ""  

+     THEN fonttable (users fonttable)

+  FI

+END PROC analyze fonts;

+PROC analyze fonts (TEXT CONST file name, TEXT VAR fonttable name,

+                    font numbers, INT VAR base font index) :

+  FILE VAR f := sequential file (modify, file name);

+  analyze fonts (f, fonttable name, font numbers, base font index)

+END PROC analyze fonts;

+PROC collect fonts (FILE VAR f, THESAURUS VAR th, TEXT VAR line numbers) :

+  TEXT VAR cmd, font name, param2;

+  INT VAR current ln, last ln := 0,

+          act distance, current font lines,

+          next pos;

+  th := empty thesaurus;

+  line numbers := "";

+  toline (f, 1);

+  col (f, 1);

+  WHILE NOT eof (f) REP

+    cmd := next type command (f, current ln, next pos);

+    cout (current ln);

+    note text lines for last font;

+    process font cmd

+  PER

+.

+  note text lines for last font :

+    IF last ln <> 0

+       THEN act distance := current ln - last ln;

+            current font lines := line numbers ISUB th index;

+            current font lines INCR act distance;

+            replace (line numbers, th index, current font lines)

+    FI

+.

+process font cmd :

+  analyze command ("type:1.1", cmd, 0, cmd index, no of params,

+                   font name, param2);

+  IF cmd index = 1                

+     THEN th index := link (th, font name);

+          IF th index = 0

+             THEN add new font

+          FI;

+          last ln := current ln

+  FI

+.

+  add new font :

+    insert (th, font name, th index);

+    line numbers CAT ""0""0""

+END PROC collect fonts;

+PROC provide font numbers (THESAURUS CONST fonts th, TEXT VAR font numbers,

+                           line numbers, base font name) :

+  TEXT VAR font name, font no, old line numbers := line numbers;

+  font numbers := "";

+  line numbers := "";

+  INT VAR font index, line number, last greatest;

+  th index := 0;

+  get (fonts th, font name, th index);

+  WHILE th index > 0 REP

+    font no := code (font (font name));

+    font index := pos (font numbers, font no);

+    IF font index = 0

+       THEN transfer font

+       ELSE sum text line number  

+    FI;

+    get (fonts th, font name, th index)

+  PER;

+  determine font with most text

+.

+  transfer font :

+    font numbers CAT font no;

+    line numbers CAT (old line numbers ISUB th index)

+.

+  sum text line number :

+    line number := line numbers ISUB font index;

+    line number INCR (old line numbers ISUB th index);

+    replace (line numbers, font index, line number)

+.

+  determine font with most text :

+    last greatest := 0;

+    FOR font index FROM 1 UPTO (LENGTH line numbers) DIV 2 REP

+      line number := line numbers ISUB font index;

+      IF line number > last greatest

+         THEN last greatest := line number;

+              base font name := font numbers SUB font index

+      FI

+    PER;

+END PROC provide font numbers;

+PROC sort fonts (TEXT VAR fonts) :

+  TEXT VAR font name, spec font;

+  INT VAR font no, size;

+  th index := 0; 

+  disable stop;

+  FILE VAR f := sequential file (output, "fonts");

+  get font sizes;

+  sort ("fonts");

+  restore fonts text;

+  forget ("fonts", quiet);

+  enable stop

+.

+  get font sizes :

+    FOR th index FROM 1 UPTO LENGTH fonts REP

+      font name := fonts SUB th index;

+      font no := code (font name);

+      specify size

+    PER

+.

+  specify size :

+    size := (indentation pitch (font no) DIV 2)

+                * (font height (font no) DIV 2);

+    rotate (size, 8);

+    spec font := ""223""223"";

+    replace (spec font, 1, size);

+    spec font CAT font name;

+    putline (f, spec font)

+.

+  restore fonts text :

+    fonts := "";

+    input (f);

+    WHILE NOT eof (f) REP

+      getline (f, spec font);

+      font name := spec font SUB 3;

+      fonts CAT font name

+    PER

+END PROC sort fonts;

+PROC analyze indent levels (TEXT CONST file name, TEXT VAR levels string) :

+  FILE VAR f := sequential file (input, file name);

+  analyze indent levels (f, levels string);

+  modify (f)

+END PROC analyze indent levels;

+PROC analyze indent levels (FILE VAR f, TEXT VAR levels string) :

+  INT VAR i;

+  TEXT VAR l, act blanks, current item;

+  levels string := "";

+  WHILE NOT eof (f) REP

+    getline (f, l);

+    i := pos (l, ""33"", ""255"", 1) - 1;

+    IF i > 0

+       THEN act blanks := code (i);

+            i := 1;

+            IF not yet remembered

+               THEN insert act blanks

+            FI

+    FI

+  PER;

+  modify (f)

+.

+not yet remembered :

+  WHILE i <= LENGTH levels string REP

+    current item := levels string SUB i;

+    IF current item < act blanks

+       THEN i INCR 1

+    ELIF current item = act blanks

+       THEN LEAVE not yet remembered WITH FALSE

+    ELSE LEAVE not yet remembered WITH TRUE

+    FI

+  PER;

+  TRUE

+.

+insert act blanks :

+  insert char (levels string, act blanks, i)

+END PROC analyze indent levels;

+END PACKET font analysis;

diff --git a/app/conversion/1.0/src/PSEUDOWP.WPM b/app/conversion/1.0/src/PSEUDOWP.WPM
new file mode 100644
index 0000000..8c83ed6
--- /dev/null
+++ b/app/conversion/1.0/src/PSEUDOWP.WPM
diff --git a/app/conversion/1.0/src/PS_WP_DT.WPM b/app/conversion/1.0/src/PS_WP_DT.WPM
new file mode 100644
index 0000000..14fd586
--- /dev/null
+++ b/app/conversion/1.0/src/PS_WP_DT.WPM
diff --git a/app/conversion/1.0/src/SEQU2CUM.TBL b/app/conversion/1.0/src/SEQU2CUM.TBL
new file mode 100644
index 0000000..616b76c
--- /dev/null
+++ b/app/conversion/1.0/src/SEQU2CUM.TBL
@@ -0,0 +1 @@
+"�"   =  "�""�"   =  "�"   { Aufw�rtspfeil }"�"   =  "�"   { Abw�rtspfeil }"�a"  =  "�""�a"  =  "�""^a"  =  "�""�e"  =  "�""�e"  =  "�""^e"  =  "�""�i"  =  "�""�i"  =  "�""^i"  =  "�""�o"  =  "�""�o"  =  "�""^o"  =  "�""�u"  =  "�""�u"  =  "�""^u"  =  "�""~n"  =  "�""~N"  =  "�""�c"  =  "�""�C"  =  "�""@"   =  "�""�"   =  "�""|"   =  "�""�"   =  "�"
\ No newline at end of file
diff --git a/app/conversion/1.0/src/WP_CNVRS.PAC b/app/conversion/1.0/src/WP_CNVRS.PAC
new file mode 100644
index 0000000..c057a2e
--- /dev/null
+++ b/app/conversion/1.0/src/WP_CNVRS.PAC
@@ -0,0 +1,905 @@
+PACKET wordperfect conversion  DEFINES convert to wp :

+LET     type1        = 1,

+        linefeed     = 3,

+        limit        = 4,

+        free         = 5,

+        page cmd0    = 6,

+        page cmd1    = 7,

+        on           = 8,

+        off          = 9,

+        page nr      = 10,

+        pagelength   = 11,

+        start        = 12,

+        foot         = 13,

+        end          = 14,

+        head         = 15,

+        headeven     = 16,

+        headodd      = 17,

+        bottom       = 18,

+        bottomeven   = 19,

+        bottomodd    = 20,

+        block        = 21,

+        material     = 22,

+        columns      = 23,

+        columnsend   = 24,

+        ib0          = 25,

+        ib1          = 26,

+        ib2          = 27,

+        ie0          = 28,

+        ie1          = 29,

+        ie2          = 30,

+        topage       = 31,

+        goalpage     = 32,

+        count0       = 33,

+        count1       = 34,

+        setcount     = 35,

+        value0       = 36,

+        value1       = 37,

+        table        = 38,

+        table end    = 39,

+        r pos        = 40,

+        l pos        = 41,

+        c pos        = 42,

+        d pos        = 43,

+        b pos        = 44,

+        clear pos0   = 45,

+        clear pos1   = 46,

+        right        = 47,

+        center       = 48,

+        skip         = 49,

+        skip end     = 50,

+        u cmd        = 51,

+        d cmd        = 52,

+        e cmd        = 53,

+        head on      = 54,

+        head off     = 55,

+        bottom on    = 56,

+        bottom off   = 57,

+        count per page=58,

+        fillchar     = 59,

+        mark cmd     = 60,

+        mark end     = 61,

+        pageblock    = 62,

+        bsp          = 63,

+        counter1     = 64,

+        counter2     = 65,

+        setcounter   = 66,

+        putcounter0  = 67,

+        putcounter1  = 68,

+        storecounter = 69,

+        ub           = 70,

+        ue           = 71,

+        fb           = 72,

+        fe           = 73,

+        region       = 74,

+        region end   = 75;

+LET eumel line display pos = 1,

+    dos   line display pos = 10,

+    default tab insert pos = 21;

+LET cont paper width  = 20.88,

+    cont paper length = 30.48,

+    minimal margin    = 0.5;

+LET eumel modifications = "ibur";

+LET wp cmd start         = "<|",

+    wp cmd end           = "|>";

+ROW 6 TEXT VAR wp types on off := ROW 6 TEXT :

+    ("p\K13",

+     "p\K14",

+     "",

+     "p\K15",

+     "p\K16",

+     "p\K17");

+ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT :

+     ("p\K24",

+      "p\%",

+      "p\'",

+      "p\K28");

+ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT :

+     ("p\K11", "p\K12");

+TEXT VAR cosmetic cmds :=

+  "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2

+  pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0

+  headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";

+cosmetic cmds CAT

+  "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1

+  goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0

+  rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";

+cosmetic cmds CAT

+  "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0

+  bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2

+  markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01

+  storecounter:69.1";

+cosmetic cmds CAT

+  "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0";

+TEXT VAR font number string,

+         users tabs cmd, no users tabs cmd,

+         param1, param2,

+         act l, next l, dos l,

+         eumel chunk,

+         wp cmd, buffer, index buffer, paired move cmd;

+TEXT CONST wp enter tab menu := wp cmd start + "s\318",

+           wp clear tabs     := "0\\rt\\ri\\el",

+           wp quit tab menu  := "\&00" + wp cmd end,

+           wp return         := "\\rt",

+           global tabs cmd   := wp enter tab menu + wp clear tabs

+                                + "0,0.5c" + wp return + wp quit tab menu,

+           page no cmd       := wp cmd start + "s\3263" + wp cmd end;

+INT VAR cmd index, no of params,

+        base font index, base font offset,

+        current wp size, current script value,

+        mod flags,

+        current index number,

+        act l no,

+        dos l length,

+        first cross pos, second cross pos,

+        act text start, next text start,

+        act indent level, next indent level,

+        current tab insert pos,

+        current font,

+        cursor x, cursor y;

+REAL VAR paper width,

+         paper length,

+         current top margin,

+         current bottom margin,

+         current left margin,

+         current right margin,

+         current limit,

+         current pagelength,

+         current indent pitch;

+BOOL VAR in footnote,

+         in table,

+         in index,

+         in header,

+         in bottom,

+         in enum,

+         is last line of paragraph,

+         text in dos l,

+         line contains number sign

+         ;

+PROC convert to wp (TEXT CONST eumel file name) :

+  TEXT VAR wp file name, file fonttable, users fonttable := "";

+  BOOL VAR errors found := FALSE;

+  IF word wrap (eumel file name)

+     THEN 

+     ELSE refuse nonwrapped file

+  FI;

+  IF NOT errors found

+     THEN line;

+          say ("Schrifttypen werden analysiert ...");

+          analyze fonts (eumel file name, file fonttable,

+                         font number string, base font index);

+          line;

+          say ("Fu"251"noten werden plaziert ...");

+          move footnotes (eumel file name);

+          wp file name := dos file name (eumel file name, "wpf");

+          forget (wp file name, quiet);

+          line;

+          say ("Datei wird konvertiert ...");

+          line;

+          IF file fonttable <> ""

+             THEN users fonttable := fonttable;

+                  fonttable (file fonttable)

+          FI;

+          convert to wp file (eumel file name, wp file name);

+          forget (eumel file name, quiet);

+          rename (eumel file name + ".orig", eumel file name);

+          IF users fonttable <> ""   

+             THEN fonttable (users fonttable)

+          FI

+  FI

+END PROC convert to wp;

+PROC convert to wp (THESAURUS CONST th) :

+  do (PROC (TEXT CONST) convert to wp, th)

+END PROC convert to wp;

+PROC convert to wp :

+  convert to wp (std)

+END PROC convert to wp;

+PROC move footnotes (TEXT CONST file name) :

+  copy (file name, file name + ".orig");

+  FILE VAR f := sequential file (modify, file name);

+  INT VAR count line no, count col no,

+          foot line no, foot col no,

+          end line no, end col no,

+          value line no, value col no,

+          footnote lines, line length;

+  TEXT VAR count line tail;

+  toline (f, 1);

+  WHILE NOT eof (f) REP

+    cout (line no (f));

+    down (f, "#count#");

+    IF pattern found

+       THEN process note

+    FI

+  PER

+.

+process note :

+  count line no := line no (f);

+  count col no := col (f);

+  down (f, "#foot#");

+  IF pattern found

+     THEN foot line no := line no (f);

+          foot col no := col (f);

+          IF foot line no - count line no > 20

+             THEN LEAVE process note

+          FI;

+          isolate foot cmd if necessary;

+          down (f, "#end#");

+          IF pattern found

+             THEN end line no := line no (f);

+                  check for value;

+                  isolate end cmd if necessary;

+                  remove note;

+                  split count line;

+                  replace count by note

+             ELSE LEAVE process note

+          FI

+     ELSE LEAVE process note

+  FI

+.

+check for value :

+  toline (f, foot line no);

+  col (f, foot col no);

+  down (f, "#value#");

+  IF pattern found

+     THEN value line no := line no (f);

+          value col no := col (f);

+          IF value line no >= end line no

+             THEN LEAVE process note

+             ELSE delete value cmd

+          FI

+     ELSE LEAVE process note

+  FI;

+  toline (f, end line no)

+.

+delete value cmd :

+  read record (f, act l);

+  change (act l, "#u##value##e#", "");

+  change (act l, "#value#", "");

+  write record (f, act l)

+.

+isolate foot cmd if necessary :

+  read record (f, act l);

+  IF foot col no > 1

+     THEN next l := subtext (act l, foot col no);

+          IF (act l SUB (foot col no - 1)) = " "

+             THEN act l := subtext (act l, 1, foot col no - 2)

+             ELSE act l := subtext (act l, 1, foot col no - 1)

+          FI;

+          write record (f, act l);

+          down (f, 1);

+          insert record (f);

+          write record (f, next l)

+  FI

+.

+isolate end cmd if necessary :

+  read record (f, act l);

+  end col no INCR 5;

+  next l := subtext (act l, end col no);

+  IF next l > " "

+     THEN act l := subtext (act l, 1, end col no - 1);

+          write record (f, act l);

+          down (f, 1);

+          insert record (f);

+          write record (f, next l);

+          up (f, 1)

+  FI

+.

+remove note :

+  footnote lines := end line no - foot line no + 1;

+  remove (f, footnote lines)

+.

+split count line :

+  toline (f, count line no);

+  read record (f, act l);

+  cmd start := pos (act l, "#u##count##e#", count col no - 3);

+  IF cmd start = count col no - 3

+     THEN cmd end := cmd start + 12

+     ELSE cmd start := count col no;

+          cmd end := cmd start + 7

+  FI;

+  count line tail := subtext (act l, cmd end + 1);

+  IF (count line tail SUB LENGTH count line tail) = " "

+     CAND (only command line (count line tail) COR

+          LENGTH count line tail = 1)

+     THEN count line tail CAT "  "      

+  FI;

+  act l := subtext (act l, 1, cmd start - 1);

+  write record (f, act l)

+.

+replace count by note :

+  toline (f, count line no + 1);

+  reinsert (f);

+  append count line tail;

+  toline (f, count line no + 1);

+  read record (f, next l);

+  delete record (f);

+  up (f, 1);

+  read record (f, act l);

+  act l CAT next l;

+  line length := LENGTH act l;

+  IF pos (act l, "#foot#") = line length - 6 CAND

+     (act l SUB line length) = " "

+     THEN act l := subtext (act l, 1, line length - 1)

+  FI;

+  write record (f, act l)

+.

+append count line tail :

+  read record (f, act l);

+  end col no :=  pos (act l, "#end#");

+  act l := subtext (act l, 1, end col no + 4);

+  IF count line tail <> ""

+     THEN act l CAT count line tail

+     ELSE append next line

+  FI;

+  write record (f, act l)

+.

+append next line :

+  down (f, 1);

+  read record (f, next l);

+  IF next l > " "      

+     THEN delete record (f);

+          up (f, 1);

+          act l CAT " ";

+          act l CAT next l;

+          write record (f, act l)

+     ELSE up (f, 1)

+  FI

+.

+cmd start : first cross pos

+.

+cmd end : second cross pos

+END PROC move footnotes;

+PROC initialize values :

+  act l no              := 0;

+  current wp size       := 3;

+  current script value  := 0;

+  mod flags             := 0;

+  current index number  := 0;

+  current tab insert pos:= default tab insert pos;

+  paper length          := cont paper length;

+  paper width           := cont paper width;

+  current top margin    := 2.5;

+  current bottom margin := 2.5;

+  current left margin   := 3.0;

+  current right margin  := 2.0;

+  current pagelength    := paper length - current top margin - current bottom margin;

+  current limit         := paper width - current left margin - current right margin;

+  current font          := 1;

+  current indent pitch  := xstep conversion (indentation pitch (current font));

+  in enum               := FALSE;

+  in table              := FALSE;

+  in footnote           := FALSE;

+  in header             := FALSE;

+  in bottom             := FALSE;

+  in index              := FALSE;

+  text in dos l         := FALSE;

+  base font offset      := base font index - 3;

+  wp cmd                := "";

+  dos l                 := "";

+  dos l length          := 0;

+  next indent level     := 0;

+  no users tabs cmd     := no users tabs command;

+  users tabs cmd        := no users tabs cmd

+END PROC initialize values;

+TEXT PROC no users tabs command :

+  TEXT VAR t := wp enter tab menu;

+  t CAT wp clear tabs;

+  t CAT text (current limit - 2.0);

+  t CAT ",0.2c\\rt";    

+  t CAT wp quit tab menu;

+  t

+END PROC no users tabs command;

+INT PROC indent level (INT CONST text start pos) :

+  LET tab distance = 0.5;

+  IF text start pos < 3

+     THEN 0

+     ELSE positive indent level

+  FI

+.

+positive indent level :

+  REAL VAR left margin distance

+                         := real (text start pos - 1) * current indent pitch;

+  INT VAR ind level := int (round (left margin distance / tab distance, 0));

+  IF ind level = 0

+     THEN 1

+     ELSE ind level

+  FI

+END PROC indent level;

+PROC convert to wp file (TEXT CONST eumel file name, wp file name) :

+  get cursor (cursor x, cursor y);

+  FILE VAR eumel f := sequential file (input, eumel file name),

+           dos f   := sequential file (output, wp file name);

+  max line length (dos f, max text length);

+  INT CONST file lines := lines (eumel f);

+  BOOL VAR is last file line := FALSE;

+  set file defaults;

+  getline (eumel f, next l);

+  next text start := pos (next l, ""33"", ""255"", 1);

+  REP

+    act l := next l;

+    act l no INCR 1;

+    cursor (eumel line display pos, cursor y);

+    cout (act l no);

+    act text start := next text start;

+    IF act l no >= file lines

+       THEN next l := "";

+            next text start := 1;

+            is last file line := TRUE

+       ELSE getline (eumel f, next l);

+            get next text start

+    FI;

+    act indent level := next indent level;

+    next indent level := indent level (next text start);

+    process act line;

+    IF is last line of paragraph

+       THEN IF is last file line

+               THEN complement pending paired commands

+            FI;

+            putline (dos f, dos l);

+            dos l := "";

+            dos l length := 0;

+            text in dos l := FALSE;

+            cursor (dos line display pos, cursor y);

+            cout (line no (dos f))

+    FI

+  UNTIL act l no >= file lines PER

+END PROC convert to wp file;

+PROC set file defaults :

+  initialize values;

+  set endnote options;

+  no pagination;

+  wp cmd CAT global tabs cmd

+.

+set endnote options :

+  cat to wp command ("s\J243\J22\\rt\&")

+.

+no pagination :

+  cat to wp command ("s\32649\&")

+END PROC set file defaults;

+PROC get next text start :

+  next text start := pos (next l, ""33"", ""255"", 1);

+  IF next text start = 2

+     THEN next text start := 1

+  FI    

+END PROC get next text start;

+PROC process act line :

+  LET tab code        = "<|s\\tb|>",

+      indent code     = "<|s\\in|>",

+      margin rel code = "<|s\^|>";

+  INT VAR enum blanks, past enumerator pos;

+  trim end of line (act l, is last line of paragraph, in table);

+  replace eumel special characters (act l, line contains number sign);

+  trim start of line;

+  IF in table CAND NOT text in dos l

+     THEN replace multiple blanks by tab stops (act l, tab code)

+  FI;

+  transfer line in chunks

+.

+trim start of line :

+  IF NOT (text in dos l COR only command line (act l))

+     THEN IF NOT is last line of paragraph CAND

+             next indent level < act indent level    

+             THEN cat to dos l (next indent level * indent code);

+                  cat to dos l ((act indent level - next indent level) * tab code)

+             ELSE cat to dos l (act indent level * indent code)

+          FI;

+          enum blanks := enumeration offset (act l, next l, in enum, act text start);

+          IF enum blanks <> 0

+             THEN in enum := TRUE;

+                  past enumerator pos := pos (act l, " ", act text start);

+                  change (act l, past enumerator pos, enum blanks, indent code)

+             ELSE in enum := FALSE;

+                  IF NOT is last line of paragraph CAND

+                     next indent level > act indent level

+                     THEN cat to dos l (indent code);

+                          cat to dos l (margin rel code)

+                  FI

+          FI

+   FI

+END PROC process act line;

+PROC complement pending paired commands :

+  reset modifications;

+  IF current wp size <> 3

+     THEN cat to wp command (wp types on off [current wp size]);

+          cat to dos l (wp cmd)

+  FI;

+END PROC complement pending paired commands;

+PROC transfer line in chunks :

+  WHILE act text start <= LENGTH act l REP

+    next text command pos (act l, act text start, first cross pos, second cross pos);

+    IF first cross pos <> 0

+       THEN IF first cross pos <> act text start

+               THEN process text chunk (act text start, first cross pos - 1)

+            FI;

+            process eumel command (first cross pos, second cross pos);

+            act text start := second cross pos + 1

+       ELSE process text chunk (act text start, LENGTH act l);

+            LEAVE transfer line in chunks

+    FI;

+  PER

+END PROC transfer line in chunks;

+PROC process text chunk (INT CONST start pos, end pos) :

+  eumel chunk := subtext (act l, start pos, end pos);

+  IF in header COR in bottom

+     THEN change all (eumel chunk, "%", page no cmd)

+  FI;

+  IF line contains number sign

+     THEN change all (eumel chunk, ""222"", "#")

+  FI;

+  cat to dos l (eumel chunk);

+  text in dos l := TRUE;

+  IF in index

+     THEN index buffer CAT eumel chunk

+  FI

+END PROC process text chunk;

+PROC process eumel command (INT CONST start pos, end pos) :

+  eumel chunk := subtext (act l, start pos + 1, end pos - 1);

+  IF (eumel chunk SUB 1) = "-"

+     THEN process comment (eumel chunk)

+     ELSE process command

+  FI;

+  cat to dos l (wp cmd);

+  wp cmd := ""

+.

+  process command :

+    analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params,

+                     param1, param2);

+    customized command processing;

+    IF in index

+       THEN index buffer CAT wp cmd

+    FI

+.

+  customized command processing :

+    SELECT cmd index OF

+      CASE type1      : process type cmd (param1)

+      CASE linefeed   : cat to wp command ("s\316" + param1 + "\\rt\&")

+      CASE limit      : process limit (param1)

+      CASE free       : process free (param1)

+      CASE page cmd0  : cat to wp command ("s\_")

+      CASE page cmd1  : cat to wp command ("s\_\3261" + param1 + "\\rt\&")

+      CASE on         : process mod on (param1)

+      CASE off        : process mod off (param1)

+      CASE page nr    : 

+      CASE pagelength : process pagelength (param1)

+      CASE start      : process start (param1, param2)

+      CASE foot       : process footnote

+      CASE end        : process end

+      CASE head,

+           headeven,

+           headodd    : process head (cmd index)

+      CASE bottom,

+           bottomeven,

+           bottomodd  : process bottom (cmd index)

+      CASE block      : cat to wp command ("s\3134\&")

+      CASE material   :

+      CASE columns    : process columns

+      CASE columnsend : cat to wp command ("s\>12")

+      CASE ib0,

+           ib1,

+           ib2        : process index on (param1, param2)

+      CASE ie0, ie1, ie2 : process index off (param 1)

+      CASE topage     : cat to wp command ("s\<111" + param1 + wp return)

+      CASE goalpage   : cat to wp command ("s\<12" + param1 + wp return)

+      CASE count0     : cat to wp command ("s\051\\rt")

+      CASE count1     : process reference target (param1)

+      CASE setcount   : cat to wp command ("s\J13" + param1 + wp return)

+      CASE value0     : 

+      CASE value1     : cat to wp command ("s\<114" + param1 + wp return)

+      CASE table      : process table

+      CASE table end  : process table end

+      CASE r pos, l pos, c pos, d pos,

+           b pos      : process tab stop (eumel chunk SUB 1, param1)

+      CASE clear pos0 : process clear all tabs

+      CASE clear pos1 : process clear tab (param1)

+      CASE right      : cat to wp command ("s\=")

+      CASE center     : cat to wp command ("s\1")

+      CASE skip       :

+      CASE skip end   :

+      CASE u cmd      : process script cmd (1)

+      CASE d cmd      : process script cmd (2)

+      CASE e cmd      : process e cmd

+      CASE head on    :

+      CASE head off   : cat to wp command ("s\32311\&")

+      CASE bottom on  :

+      CASE bottom off : cat to wp command ("s\32411\&")

+      CASE count per page : cat to wp command ("s\J146y\&")

+      CASE fillchar   :

+      CASE mark cmd   :

+      CASE mark end    :

+      CASE pageblock  :

+      CASE bsp        :

+      CASE counter1   :

+      CASE counter2   :

+      CASE setcounter :

+      CASE putcounter0:

+      CASE putcounter1:

+      CASE storecounter:

+      CASE ub         : process mod on ("u")

+      CASE ue         : process mod off ("u")

+      CASE fb         :

+      CASE fe         :

+      CASE region, region end : cat to wp command ("p\3y")

+    END SELECT

+END PROC process eumel command;

+PROC process comment (TEXT CONST t) :

+  buffer := "p\Hy";

+  cat to wp command (buffer);

+  wp cmd CAT subtext (t, 2);

+  cat to wp command (buffer)

+END PROC process comment;

+PROC cat to dos l (TEXT CONST t) :

+  LET mtl = 32000;

+  INT CONST t length := LENGTH t;

+  IF mtl - t length < dos l length

+     THEN report ("Absatz ist zu lang")

+     ELSE dos l CAT t;

+          dos l length INCR t length

+  FI

+END PROC cat to dos l;

+PROC cat to wp command (TEXT CONST t) :

+  IF t <> ""

+     THEN wp cmd CAT wp cmd start;

+          wp cmd CAT t;

+          wp cmd CAT wp cmd end

+  FI

+END PROC cat to wp command;

+PROC process mod on (TEXT CONST kind of mod) :

+  TEXT CONST mod char := kind of mod SUB 1;

+  INT CONST mod no := pos (eumel modifications, mod char);

+  cat to wp command (wp mods on off [mod no]);

+  set bit (mod flags, mod no)

+END PROC process mod on;

+PROC process mod off (TEXT CONST kind of mod) :

+  TEXT CONST mod char := kind of mod SUB 1;

+  INT CONST mod no := pos (eumel modifications, mod char);

+  process mod off (mod no)

+END PROC process mod off;

+PROC process mod off (INT CONST mod no) :

+  cat to wp command (wp mods on off [mod no]);

+  reset bit (mod flags, mod no)

+END PROC process mod off;

+PROC reset modifications :

+  INT VAR mod no;

+  IF mod flags > 0

+     THEN FOR mod no FROM 1 UPTO 4 REP

+            IF bit (mod flags, mod no)

+               THEN process mod off (mod no)

+            FI

+          PER

+  FI

+END PROC reset modifications;

+PROC process type cmd (TEXT CONST wanted type) :

+  reset modifications;

+  current wp size off;

+  process type change (wanted type)

+.

+  current wp size off :

+    cat to wp command (wp types on off [current wp size])

+END PROC process type cmd;

+PROC process type change (TEXT CONST eumel type) :

+  current font             := font (eumel type);

+  current indent pitch     := xstep conversion (indentation pitch (current font));

+  TEXT CONST eumel type no := code (current font);

+  INT CONST eumel size     := pos (font number string, eumel type no);

+  current wp size          := eumel size - base font offset;

+  IF current wp size < 1

+     THEN current wp size := 1

+  ELIF current wp size > 6

+     THEN current wp size := 6

+  FI;

+  cat to wp command (wp types on off [current wp size])

+END PROC process type change;

+PROC process script cmd (INT CONST script value) :

+  current script value := script value;

+  cat to wp command (wp scripts on off [script value])

+END PROC process script cmd;

+PROC process e cmd :

+  cat to wp command (wp scripts on off [current script value]);

+  current script value := 0

+END PROC process e cmd;

+PROC process free (TEXT CONST cm) :

+  IF NOT in header COR in bottom  

+     THEN buffer := "s\3412";

+          buffer CAT cm;

+          buffer CAT "c\\rt\&";

+          cat to wp command (buffer)

+  FI

+END PROC process free;

+PROC process limit (TEXT CONST t limit) :

+  current limit := real (t limit);

+  current limit := min (current limit, paper width - 2.0 * minimal margin);

+  process horizontal margins

+END PROC process limit;

+PROC process horizontal margins :

+  current right margin := paper width - current limit - current left margin;

+  IF current right margin - minimal margin < 0.0

+     THEN current right margin := minimal margin;

+          current left margin := paper width - current limit - current right margin

+  FI;

+  wp cmd := wp cmd start;

+  wp cmd CAT "s\317";

+  wp cmd CAT text (current left margin);

+  wp cmd CAT "c\\rt";

+  wp cmd CAT text (current right margin);

+  wp cmd CAT "c\\rt\&";

+  wp cmd CAT wp cmd end;

+END PROC process horizontal margins;

+PROC process pagelength (TEXT CONST t length) :

+  current pagelength := real (t length);

+  current pagelength

+            := min (current pagelength, paper length - 2.0 * minimal margin);

+  process vertical margins

+END PROC process pagelength;

+PROC process vertical margins :

+  current bottom margin := paper length - current pagelength - current top margin;

+  IF current bottom margin - minimal margin < 0.0

+     THEN current bottom margin := minimal margin;

+          current top margin

+                 := paper length - current pagelength - current bottom margin

+  FI;

+  wp cmd := wp cmd start;

+  wp cmd CAT "s\325";

+  wp cmd CAT text (current top margin);

+  wp cmd CAT "c\\rt";

+  wp cmd CAT text (current bottom margin);

+  wp cmd CAT "c\\rt\&";

+  wp cmd CAT wp cmd end;

+END PROC process vertical margins;

+PROC process start (TEXT CONST t x, t y) :

+  current left margin := real (t x);

+  process horizontal margins;

+  current top margin  := real (t y);

+  process vertical margins

+END PROC process start;

+PROC process footnote :

+  IF in footnote

+     THEN report ("Fu"251"notenschachtelung")

+  FI;

+  paired move cmd := "f\J11 \\rt\&";

+  cat to wp command (paired move cmd);

+  in footnote := TRUE

+END PROC process footnote;

+PROC process head (INT CONST index) :

+  IF in header

+     THEN report ("Header-Schachtelung")

+  FI;

+  paired move cmd := "f\323";

+  IF index <= headeven

+     THEN paired move cmd CAT "1";

+          IF index = head

+             THEN paired move cmd CAT "2"

+             ELSE paired move cmd CAT "4"

+          FI

+     ELSE paired move cmd CAT "23"

+  FI;

+  paired move cmd CAT "\\rt\&00";

+  cat to wp command (paired move cmd);

+  in header := TRUE

+END PROC process head;

+PROC process bottom (INT CONST index) :

+  IF in bottom

+     THEN report ("Bottom-Schachtelung")

+  FI;

+  paired move cmd := "f\324";

+  IF index <= bottomeven

+     THEN paired move cmd CAT "1";

+          IF index = bottom

+             THEN paired move cmd CAT "2"

+             ELSE paired move cmd CAT "4"

+          FI

+     ELSE paired move cmd CAT "23"

+  FI;

+  paired move cmd CAT "\\rt\&00";

+  cat to wp command (paired move cmd);

+  in bottom := TRUE

+END PROC process bottom;

+PROC process end :

+  reset types and mods;

+  cat to wp command (paired move cmd);

+  IF in header

+     THEN in header := FALSE

+  ELIF in bottom

+     THEN in bottom := FALSE

+  ELIF in footnote

+     THEN in footnote := FALSE

+  ELSE report ("Unmotivierte End-Anweisung")

+  FI

+.

+reset types and mods :

+  reset modifications;

+  IF current wp size <> 3

+     THEN cat to wp command (wp types on off [current wp size]);

+          current wp size := 3;

+  FI

+END PROC process end;

+PROC process columns :

+  INT VAR fcp, scp;

+  cat to wp command ("s\>1301");          

+  next text command pos (act l, act text start, fcp, scp);

+  IF fcp = second cross pos + 1

+     THEN eumel chunk := subtext (act l, fcp + 1, scp - 1);

+          analyze command (cosmetic cmds, eumel chunk, 3, cmd index,

+                           no of params, param1, param2);

+          IF cmd index = limit

+             THEN second cross pos := scp

+          FI

+  FI                       

+END PROC process columns;

+PROC process index on (TEXT CONST index number, registered text) :

+  IF in index

+     THEN report ("Kann Indexschachtelung nicht verarbeiten")

+  FI;

+  current index number := int (index number);

+  index buffer := "<|s\<3";

+  IF registered text <> ""

+     THEN index buffer CAT registered text

+     ELSE in index := TRUE

+  FI

+END PROC process index on;

+PROC process index off (TEXT CONST index number) :

+  INT CONST index off number := int (index number);

+  IF current index number = index off number

+     THEN current index number := 0

+     ELSE report ("Kann Indexschachtelung nicht verarbeiten")

+  FI;

+  wp cmd := index buffer;

+  wp cmd CAT "\\rt\ |>";

+  in index := FALSE

+END PROC process index off;

+PROC process reference target (TEXT CONST marker) :

+  buffer := "s\J21\&\<12";

+  buffer CAT marker;

+  buffer CAT wp return;

+  cat to wp command (buffer)

+END PROC process reference target;

+PROC process table :

+  IF users tabs cmd <> no users tabs cmd

+     THEN wp cmd := users tabs cmd

+  FI;

+  in table := TRUE

+END PROC process table;

+PROC process table end :

+  wp cmd := global tabs cmd;

+  in table := FALSE

+END PROC process table end;

+PROC process tab stop (TEXT CONST tab type, tab pos) :

+  buffer := tab pos;

+  buffer CAT wp return;

+  IF pos ("rcd", tab type) <> 0

+     THEN buffer CAT tab type

+  FI;                     

+  insert new tab stop;

+  IF in table

+     THEN wp cmd CAT users tabs cmd

+  FI

+.

+insert new tab stop :

+  insert char (users tabs cmd, buffer, current tab insert pos);

+  current tab insert pos INCR LENGTH buffer

+END PROC process tab stop;

+PROC process clear all tabs :

+  users tabs cmd := no users tabs cmd;

+  current tab insert pos := default tab insert pos;

+END PROC process clear all tabs;

+PROC process clear tab (TEXT CONST tab pos) :

+  INT VAR del start, del end;

+  del start := pos (users tabs cmd, tab pos);

+  IF del start <> 0

+     THEN clear pos

+  FI

+.

+clear pos :

+  del end := pos (users tabs cmd, wp return, del start) + 4;

+  buffer := users tabs cmd SUB del end + 1;

+  IF pos ("rcd", buffer) <> 0

+     THEN del end INCR 1

+  FI;

+  change (users tabs cmd, del start, del end, "");

+  IF in table

+     THEN wp cmd CAT users tabs cmd

+  FI

+END PROC process clear tab;

+PROC report (TEXT CONST t) :

+  errorstop ("Zeile " + text (act l no) + ": " + t)

+END PROC report;

+END PACKET wordperfect conversion;

diff --git a/app/conversion/1.0/src/WP_KNVRS.PAC b/app/conversion/1.0/src/WP_KNVRS.PAC
new file mode 100644
index 0000000..993221c
--- /dev/null
+++ b/app/conversion/1.0/src/WP_KNVRS.PAC
@@ -0,0 +1,915 @@
+PACKET wordperfect conversion  DEFINES konvertiere nach wp :

+LET     type1        = 1,

+        linefeed     = 3,

+        limit        = 4,

+        free         = 5,

+        page cmd0    = 6,

+        page cmd1    = 7,

+        on           = 8,

+        off          = 9,

+        page nr      = 10,

+        pagelength   = 11,

+        start        = 12,

+        foot         = 13,

+        end          = 14,

+        head         = 15,

+        headeven     = 16,

+        headodd      = 17,

+        bottom       = 18,

+        bottomeven   = 19,

+        bottomodd    = 20,

+        block        = 21,

+        material     = 22,

+        columns      = 23,

+        columnsend   = 24,

+        ib0          = 25,

+        ib1          = 26,

+        ib2          = 27,

+        ie0          = 28,

+        ie1          = 29,

+        ie2          = 30,

+        topage       = 31,

+        goalpage     = 32,

+        count0       = 33,

+        count1       = 34,

+        setcount     = 35,

+        value0       = 36,

+        value1       = 37,

+        table        = 38,

+        table end    = 39,

+        r pos        = 40,

+        l pos        = 41,

+        c pos        = 42,

+        d pos        = 43,

+        b pos        = 44,

+        clear pos0   = 45,

+        clear pos1   = 46,

+        right        = 47,

+        center       = 48,

+        skip         = 49,

+        skip end     = 50,

+        u cmd        = 51,

+        d cmd        = 52,

+        e cmd        = 53,

+        head on      = 54,

+        head off     = 55,

+        bottom on    = 56,

+        bottom off   = 57,

+        count per page=58,

+        fillchar     = 59,

+        mark cmd     = 60,

+        mark end     = 61,

+        pageblock    = 62,

+        bsp          = 63,

+        counter1     = 64,

+        counter2     = 65,

+        setcounter   = 66,

+        putcounter0  = 67,

+        putcounter1  = 68,

+        storecounter = 69,

+        ub           = 70,

+        ue           = 71,

+        fb           = 72,

+        fe           = 73,

+        region       = 74,

+        region end   = 75;

+LET eumel line display pos = 1,

+    dos   line display pos = 10,

+    default tab insert pos = 21;

+LET cont paper width  = 20.88,

+    cont paper length = 30.48,

+    minimal margin    = 0.5;

+LET eumel modifications = "ibur";

+LET wp cmd start         = "<|",

+    wp cmd end           = "|>";

+ROW 6 TEXT VAR wp types on off := ROW 6 TEXT :

+    ("p\K13",

+     "p\K14",

+     "",

+     "p\K15",

+     "p\K16",

+     "p\K17");

+ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT :

+     ("p\K24",

+      "p\%",

+      "p\'",

+      "p\K28");

+ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT :

+     ("p\K11", "p\K12");

+TEXT VAR cosmetic cmds :=

+  "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2

+  pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0

+  headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";

+cosmetic cmds CAT

+  "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1

+  goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0

+  rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";

+cosmetic cmds CAT

+  "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0

+  bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2

+  markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01

+  storecounter:69.1";

+cosmetic cmds CAT

+  "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0";

+TEXT VAR font number string,

+         users tabs cmd, no users tabs cmd,

+         param1, param2,

+         act l, next l, dos l,

+         eumel chunk,

+         wp cmd, buffer, index buffer, paired move cmd;

+TEXT CONST wp enter tab menu := wp cmd start + "s\318",

+           wp clear tabs     := "0\\rt\\ri\\el",

+           wp quit tab menu  := "\&00" + wp cmd end,

+           wp return         := "\\rt",

+           global tabs cmd   := wp enter tab menu + wp clear tabs

+                                + "0.0,5c" + wp return + wp quit tab menu,

+           page no cmd       := wp cmd start + "s\3263" + wp cmd end;

+INT VAR cmd index, no of params,

+        base font index, base font offset,

+        current wp size, current script value,

+        mod flags,

+        current index number,

+        act l no,

+        dos l length,

+        first cross pos, second cross pos,

+        act text start, next text start,

+        act indent level, next indent level,

+        current tab insert pos,

+        current font,

+        cursor x, cursor y;

+REAL VAR paper width,

+         paper length,

+         current top margin,

+         current bottom margin,

+         current left margin,

+         current right margin,

+         current limit,

+         current pagelength,

+         current indent pitch;

+BOOL VAR in footnote,

+         in table,

+         in index,

+         in header,

+         in bottom,

+         in enum,

+         is last line of paragraph,

+         text in dos l,

+         line contains number sign

+         ;

+PROC konvertiere nach wp (TEXT CONST eumel file name) :

+  TEXT VAR wp file name, file fonttable, users fonttable := "";

+  BOOL VAR errors found := FALSE;

+  IF word wrap (eumel file name)

+     THEN 

+     ELSE refuse nonwrapped file

+  FI;

+  IF NOT errors found

+     THEN line;

+          say ("Schrifttypen werden analysiert ...");

+          analyze fonts (eumel file name, file fonttable,

+                         font number string, base font index);

+          line;

+          say ("Fu"251"noten werden plaziert ...");

+          move footnotes (eumel file name);

+          wp file name := dos file name (eumel file name, "wpf");

+          forget (wp file name, quiet);

+          line;

+          say ("Datei wird konvertiert ...");

+          line;

+          IF file fonttable <> ""

+             THEN users fonttable := fonttable;

+                  fonttable (file fonttable)

+          FI;

+          convert to wp file (eumel file name, wp file name);

+          forget (eumel file name, quiet);

+          rename (eumel file name + ".orig", eumel file name);

+          IF users fonttable <> ""   

+             THEN fonttable (users fonttable)

+          FI

+  FI

+END PROC konvertiere nach wp;

+PROC konvertiere nach wp (THESAURUS CONST th) :

+  do (PROC (TEXT CONST) konvertiere nach wp, th)

+END PROC konvertiere nach wp;

+PROC konvertiere nach wp :

+  konvertiere nach wp (std)

+END PROC konvertiere nach wp;

+PROC move footnotes (TEXT CONST file name) :

+  copy (file name, file name + ".orig");

+  FILE VAR f := sequential file (modify, file name);

+  INT VAR count line no, count col no,

+          foot line no, foot col no,

+          end line no, end col no,

+          value line no, value col no,

+          footnote lines, line length;

+  TEXT VAR count line tail;

+  toline (f, 1);

+  WHILE NOT eof (f) REP

+    cout (line no (f));

+    down (f, "#count#");

+    IF pattern found

+       THEN process note

+    FI

+  PER

+.

+process note :

+  count line no := line no (f);

+  count col no := col (f);

+  down (f, "#foot#");

+  IF pattern found

+     THEN foot line no := line no (f);

+          foot col no := col (f);

+          IF foot line no - count line no > 20

+             THEN LEAVE process note

+          FI;

+          isolate foot cmd if necessary;

+          down (f, "#end#");

+          IF pattern found

+             THEN end line no := line no (f);

+                  check for value;

+                  isolate end cmd if necessary;

+                  remove note;

+                  split count line;

+                  replace count by note

+             ELSE LEAVE process note

+          FI

+     ELSE LEAVE process note

+  FI

+.

+check for value :

+  toline (f, foot line no);

+  col (f, foot col no);

+  down (f, "#value#");

+  IF pattern found

+     THEN value line no := line no (f);

+          value col no := col (f);

+          IF value line no >= end line no

+             THEN LEAVE process note

+             ELSE delete value cmd

+          FI

+     ELSE LEAVE process note

+  FI;

+  toline (f, end line no)

+.

+delete value cmd :

+  read record (f, act l);

+  change (act l, "#u##value##e#", "");

+  change (act l, "#value#", "");

+  write record (f, act l)

+.

+isolate foot cmd if necessary :

+  read record (f, act l);

+  IF foot col no > 1

+     THEN next l := subtext (act l, foot col no);

+          IF (act l SUB (foot col no - 1)) = " "

+             THEN act l := subtext (act l, 1, foot col no - 2)

+             ELSE act l := subtext (act l, 1, foot col no - 1)

+          FI;

+          write record (f, act l);

+          down (f, 1);

+          insert record (f);

+          write record (f, next l)

+  FI

+.

+isolate end cmd if necessary :

+  read record (f, act l);

+  end col no INCR 5;

+  next l := subtext (act l, end col no);

+  IF next l > " "

+     THEN act l := subtext (act l, 1, end col no - 1);

+          write record (f, act l);

+          down (f, 1);

+          insert record (f);

+          write record (f, next l);

+          up (f, 1)

+  FI

+.

+remove note :

+  footnote lines := end line no - foot line no + 1;

+  remove (f, footnote lines)

+.

+split count line :

+  toline (f, count line no);

+  read record (f, act l);

+  cmd start := pos (act l, "#u##count##e#", count col no - 3);

+  IF cmd start = count col no - 3

+     THEN cmd end := cmd start + 12

+     ELSE cmd start := count col no;

+          cmd end := cmd start + 7

+  FI;

+  count line tail := subtext (act l, cmd end + 1);

+  IF (count line tail SUB LENGTH count line tail) = " "

+     CAND (only command line (count line tail) COR

+          LENGTH count line tail = 1)

+     THEN count line tail CAT "  "      

+  FI;

+  act l := subtext (act l, 1, cmd start - 1);

+  write record (f, act l)

+.

+replace count by note :

+  toline (f, count line no + 1);

+  reinsert (f);

+  append count line tail;

+  toline (f, count line no + 1);

+  read record (f, next l);

+  delete record (f);

+  up (f, 1);

+  read record (f, act l);

+  act l CAT next l;

+  line length := LENGTH act l;

+  IF pos (act l, "#foot#") = line length - 6 CAND

+     (act l SUB line length) = " "

+     THEN act l := subtext (act l, 1, line length - 1)

+  FI;

+  write record (f, act l)

+.

+append count line tail :

+  read record (f, act l);

+  end col no :=  pos (act l, "#end#");

+  act l := subtext (act l, 1, end col no + 4);

+  IF count line tail <> ""

+     THEN act l CAT count line tail

+     ELSE append next line

+  FI;

+  write record (f, act l)

+.

+append next line :

+  down (f, 1);

+  read record (f, next l);

+  IF next l > " "      

+     THEN delete record (f);

+          up (f, 1);

+          act l CAT " ";

+          act l CAT next l;

+          write record (f, act l)

+     ELSE up (f, 1)

+  FI

+.

+cmd start : first cross pos

+.

+cmd end : second cross pos

+END PROC move footnotes;

+PROC initialize values :

+  act l no              := 0;

+  current wp size       := 3;

+  current script value  := 0;

+  mod flags             := 0;

+  current index number  := 0;

+  current tab insert pos:= default tab insert pos;

+  paper length          := cont paper length;

+  paper width           := cont paper width;

+  current top margin    := 2.5;

+  current bottom margin := 2.5;

+  current left margin   := 3.0;

+  current right margin  := 2.0;

+  current pagelength    := paper length - current top margin - current bottom margin;

+  current limit         := paper width - current left margin - current right margin;

+  current font          := 1;

+  current indent pitch  := xstep conversion (indentation pitch (current font));

+  in enum               := FALSE;

+  in table              := FALSE;

+  in footnote           := FALSE;

+  in header             := FALSE;

+  in bottom             := FALSE;

+  in index              := FALSE;

+  text in dos l         := FALSE;

+  base font offset      := base font index - 3;

+  wp cmd                := "";

+  dos l                 := "";

+  dos l length          := 0;

+  next indent level     := 0;

+  no users tabs cmd     := no users tabs command;

+  users tabs cmd        := no users tabs cmd

+END PROC initialize values;

+TEXT PROC no users tabs command :

+  TEXT VAR t := wp enter tab menu;

+  t CAT wp clear tabs;

+  t CAT german real (current limit - 2.0);

+  t CAT ".0,2c\\rt";    

+  t CAT wp quit tab menu;

+  t

+END PROC no users tabs command;

+INT PROC indent level (INT CONST text start pos) :

+  LET tab distance = 0.5;

+  IF text start pos < 3

+     THEN 0

+     ELSE positive indent level

+  FI

+.

+positive indent level :

+  REAL VAR left margin distance

+                         := real (text start pos - 1) * current indent pitch;

+  INT VAR ind level := int (round (left margin distance / tab distance, 0));

+  IF ind level = 0

+     THEN 1

+     ELSE ind level

+  FI

+END PROC indent level;

+PROC convert to wp file (TEXT CONST eumel file name, wp file name) :

+  get cursor (cursor x, cursor y);

+  FILE VAR eumel f := sequential file (input, eumel file name),

+           dos f   := sequential file (output, wp file name);

+  max line length (dos f, max text length);

+  INT CONST file lines := lines (eumel f);

+  BOOL VAR is last file line := FALSE;

+  set file defaults;

+  getline (eumel f, next l);

+  next text start := pos (next l, ""33"", ""255"", 1);

+  REP

+    act l := next l;

+    act l no INCR 1;

+    cursor (eumel line display pos, cursor y);

+    cout (act l no);

+    act text start := next text start;

+    IF act l no >= file lines

+       THEN next l := "";

+            next text start := 1;

+            is last file line := TRUE

+       ELSE getline (eumel f, next l);

+            get next text start

+    FI;

+    act indent level := next indent level;

+    next indent level := indent level (next text start);

+    process act line;

+    IF is last line of paragraph

+       THEN IF is last file line

+               THEN complement pending paired commands

+            FI;

+            putline (dos f, dos l);

+            dos l := "";

+            dos l length := 0;

+            text in dos l := FALSE;

+            cursor (dos line display pos, cursor y);

+            cout (line no (dos f))

+    FI

+  UNTIL act l no >= file lines PER

+END PROC convert to wp file;

+PROC set file defaults :

+  initialize values;

+  set endnote options;

+  no pagination;

+  wp cmd CAT global tabs cmd

+.

+set endnote options :

+  cat to wp command ("s\J243\J22\\rt\&")

+.

+no pagination :

+  cat to wp command ("s\32649\&")

+END PROC set file defaults;

+PROC get next text start :

+  next text start := pos (next l, ""33"", ""255"", 1);

+  IF next text start = 2

+     THEN next text start := 1

+  FI    

+END PROC get next text start;

+PROC process act line :

+  LET tab code        = "<|s\\tb|>",

+      indent code     = "<|s\\in|>",

+      margin rel code = "<|s\^|>";

+  INT VAR enum blanks, past enumerator pos;

+  trim end of line (act l, is last line of paragraph, in table);

+  replace eumel special characters (act l, line contains number sign);

+  trim start of line;

+  IF in table CAND NOT text in dos l

+     THEN replace multiple blanks by tab stops (act l, tab code)

+  FI;

+  transfer line in chunks

+.

+trim start of line :

+  IF NOT (text in dos l COR only command line (act l))

+     THEN IF NOT is last line of paragraph CAND

+             next indent level < act indent level    

+             THEN cat to dos l (next indent level * indent code);

+                  cat to dos l ((act indent level - next indent level) * tab code)

+             ELSE cat to dos l (act indent level * indent code)

+          FI;

+          enum blanks := enumeration offset (act l, next l, in enum, act text start);

+          IF enum blanks <> 0

+             THEN in enum := TRUE;

+                  past enumerator pos := pos (act l, " ", act text start);

+                  change (act l, past enumerator pos, enum blanks, indent code)

+             ELSE in enum := FALSE;

+                  IF NOT is last line of paragraph CAND

+                     next indent level > act indent level

+                     THEN cat to dos l (indent code);

+                          cat to dos l (margin rel code)

+                  FI

+          FI

+   FI

+END PROC process act line;

+PROC complement pending paired commands :

+  reset modifications;

+  IF current wp size <> 3

+     THEN cat to wp command (wp types on off [current wp size]);

+          cat to dos l (wp cmd)

+  FI;

+END PROC complement pending paired commands;

+PROC transfer line in chunks :

+  WHILE act text start <= LENGTH act l REP

+    next text command pos (act l, act text start, first cross pos, second cross pos);

+    IF first cross pos <> 0

+       THEN IF first cross pos <> act text start

+               THEN process text chunk (act text start, first cross pos - 1)

+            FI;

+            process eumel command (first cross pos, second cross pos);

+            act text start := second cross pos + 1

+       ELSE process text chunk (act text start, LENGTH act l);

+            LEAVE transfer line in chunks

+    FI;

+  PER

+END PROC transfer line in chunks;

+PROC process text chunk (INT CONST start pos, end pos) :

+  eumel chunk := subtext (act l, start pos, end pos);

+  IF in header COR in bottom

+     THEN change all (eumel chunk, "%", page no cmd)

+  FI;

+  IF line contains number sign

+     THEN change all (eumel chunk, ""222"", "#")

+  FI;

+  cat to dos l (eumel chunk);

+  text in dos l := TRUE;

+  IF in index

+     THEN index buffer CAT eumel chunk

+  FI

+END PROC process text chunk;

+PROC process eumel command (INT CONST start pos, end pos) :

+  eumel chunk := subtext (act l, start pos + 1, end pos - 1);

+  IF (eumel chunk SUB 1) = "-"

+     THEN process comment (eumel chunk)

+     ELSE process command

+  FI;

+  cat to dos l (wp cmd);

+  wp cmd := ""

+.

+  process command :

+    analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params,

+                     param1, param2);

+    customized command processing;

+    IF in index

+       THEN index buffer CAT wp cmd

+    FI

+.

+  customized command processing :

+    SELECT cmd index OF

+      CASE type1      : process type cmd (param1)

+      CASE linefeed   : cat to wp command ("s\316" +

+                        german real (param1) + "\\rt\&")

+      CASE limit      : process limit (param1)

+      CASE free       : process free (param1)

+      CASE page cmd0  : cat to wp command ("s\_")

+      CASE page cmd1  : cat to wp command ("s\_\3261" + param1 + "\\rt\&")

+      CASE on         : process mod on (param1)

+      CASE off        : process mod off (param1)

+      CASE page nr    : 

+      CASE pagelength : process pagelength (param1)

+      CASE start      : process start (param1, param2)

+      CASE foot       : process footnote

+      CASE end        : process end

+      CASE head,

+           headeven,

+           headodd    : process head (cmd index)

+      CASE bottom,

+           bottomeven,

+           bottomodd  : process bottom (cmd index)

+      CASE block      : cat to wp command ("s\3134\&")

+      CASE material   :

+      CASE columns    : process columns

+      CASE columnsend : cat to wp command ("s\>12")

+      CASE ib0,

+           ib1,

+           ib2        : process index on (param1, param2)

+      CASE ie0, ie1, ie2 : process index off (param 1)

+      CASE topage     : cat to wp command ("s\<111" + param1 + wp return)

+      CASE goalpage   : cat to wp command ("s\<12" + param1 + wp return)

+      CASE count0     : cat to wp command ("s\051\\rt")

+      CASE count1     : process reference target (param1)

+      CASE setcount   : cat to wp command ("s\J13" + param1 + wp return)

+      CASE value0     : 

+      CASE value1     : cat to wp command ("s\<114" + param1 + wp return)

+      CASE table      : process table

+      CASE table end  : process table end

+      CASE r pos, l pos, c pos, d pos,

+           b pos      : process tab stop (eumel chunk SUB 1, param1)

+      CASE clear pos0 : process clear all tabs

+      CASE clear pos1 : process clear tab (param1)

+      CASE right      : cat to wp command ("s\=")

+      CASE center     : cat to wp command ("s\1")

+      CASE skip       :

+      CASE skip end   :

+      CASE u cmd      : process script cmd (1)

+      CASE d cmd      : process script cmd (2)

+      CASE e cmd      : process e cmd

+      CASE head on    :

+      CASE head off   : cat to wp command ("s\32311\&")

+      CASE bottom on  :

+      CASE bottom off : cat to wp command ("s\32411\&")

+      CASE count per page : cat to wp command ("s\J146y\&")

+      CASE fillchar   :

+      CASE mark cmd   :

+      CASE mark end    :

+      CASE pageblock  :

+      CASE bsp        :

+      CASE counter1   :

+      CASE counter2   :

+      CASE setcounter :

+      CASE putcounter0:

+      CASE putcounter1:

+      CASE storecounter:

+      CASE ub         : process mod on ("u")

+      CASE ue         : process mod off ("u")

+      CASE fb         :

+      CASE fe         :

+      CASE region, region end : cat to wp command ("p\3y")

+    END SELECT

+END PROC process eumel command;

+PROC process comment (TEXT CONST t) :

+  buffer := "p\Hy";

+  cat to wp command (buffer);

+  wp cmd CAT subtext (t, 2);

+  cat to wp command (buffer)

+END PROC process comment;

+PROC cat to dos l (TEXT CONST t) :

+  LET mtl = 32000;

+  INT CONST t length := LENGTH t;

+  IF mtl - t length < dos l length

+     THEN report ("Absatz ist zu lang")

+     ELSE dos l CAT t;

+          dos l length INCR t length

+  FI

+END PROC cat to dos l;

+PROC cat to wp command (TEXT CONST t) :

+  IF t <> ""

+     THEN wp cmd CAT wp cmd start;

+          wp cmd CAT t;

+          wp cmd CAT wp cmd end

+  FI

+END PROC cat to wp command;

+PROC process mod on (TEXT CONST kind of mod) :

+  TEXT CONST mod char := kind of mod SUB 1;

+  INT CONST mod no := pos (eumel modifications, mod char);

+  cat to wp command (wp mods on off [mod no]);

+  set bit (mod flags, mod no)

+END PROC process mod on;

+PROC process mod off (TEXT CONST kind of mod) :

+  TEXT CONST mod char := kind of mod SUB 1;

+  INT CONST mod no := pos (eumel modifications, mod char);

+  process mod off (mod no)

+END PROC process mod off;

+PROC process mod off (INT CONST mod no) :

+  cat to wp command (wp mods on off [mod no]);

+  reset bit (mod flags, mod no)

+END PROC process mod off;

+PROC reset modifications :

+  INT VAR mod no;

+  IF mod flags > 0

+     THEN FOR mod no FROM 1 UPTO 4 REP

+            IF bit (mod flags, mod no)

+               THEN process mod off (mod no)

+            FI

+          PER

+  FI

+END PROC reset modifications;

+PROC process type cmd (TEXT CONST wanted type) :

+  reset modifications;

+  current wp size off;

+  process type change (wanted type)

+.

+  current wp size off :

+    cat to wp command (wp types on off [current wp size])

+END PROC process type cmd;

+PROC process type change (TEXT CONST eumel type) :

+  current font             := font (eumel type);

+  current indent pitch     := xstep conversion (indentation pitch (current font));

+  TEXT CONST eumel type no := code (current font);

+  INT CONST eumel size     := pos (font number string, eumel type no);

+  current wp size          := eumel size - base font offset;

+  IF current wp size < 1

+     THEN current wp size := 1

+  ELIF current wp size > 6

+     THEN current wp size := 6

+  FI;

+  cat to wp command (wp types on off [current wp size])

+END PROC process type change;

+PROC process script cmd (INT CONST script value) :

+  current script value := script value;

+  cat to wp command (wp scripts on off [script value])

+END PROC process script cmd;

+PROC process e cmd :

+  cat to wp command (wp scripts on off [current script value]);

+  current script value := 0

+END PROC process e cmd;

+PROC process free (TEXT CONST cm) :

+  IF NOT in header COR in bottom  

+     THEN buffer := "s\3412";

+          buffer CAT german real (cm);

+          buffer CAT "c\\rt\&";

+          cat to wp command (buffer)

+  FI

+END PROC process free;

+PROC process limit (TEXT CONST t limit) :

+  current limit := real (t limit);

+  current limit := min (current limit, paper width - 2.0 * minimal margin);

+  process horizontal margins

+END PROC process limit;

+PROC process horizontal margins :

+  current right margin := paper width - current limit - current left margin;

+  IF current right margin - minimal margin < 0.0

+     THEN current right margin := minimal margin;

+          current left margin := paper width - current limit - current right margin

+  FI;

+  wp cmd := wp cmd start;

+  wp cmd CAT "s\317";

+  wp cmd CAT german real (current left margin);

+  wp cmd CAT "c\\rt";

+  wp cmd CAT german real (current right margin);

+  wp cmd CAT "c\\rt\&";

+  wp cmd CAT wp cmd end;

+END PROC process horizontal margins;

+PROC process pagelength (TEXT CONST t length) :

+  current pagelength := real (t length);

+  current pagelength

+            := min (current pagelength, paper length - 2.0 * minimal margin);

+  process vertical margins

+END PROC process pagelength;

+PROC process vertical margins :

+  current bottom margin := paper length - current pagelength - current top margin;

+  IF current bottom margin - minimal margin < 0.0

+     THEN current bottom margin := minimal margin;

+          current top margin

+                 := paper length - current pagelength - current bottom margin

+  FI;

+  wp cmd := wp cmd start;

+  wp cmd CAT "s\325";

+  wp cmd CAT german real (current top margin);

+  wp cmd CAT "c\\rt";

+  wp cmd CAT german real (current bottom margin);

+  wp cmd CAT "c\\rt\&";

+  wp cmd CAT wp cmd end;

+END PROC process vertical margins;

+PROC process start (TEXT CONST t x, t y) :

+  current left margin := real (t x);

+  process horizontal margins;

+  current top margin  := real (t y);

+  process vertical margins

+END PROC process start;

+PROC process footnote :

+  IF in footnote

+     THEN report ("Fu"251"notenschachtelung")

+  FI;

+  paired move cmd := "f\J11 \\rt\&";

+  cat to wp command (paired move cmd);

+  in footnote := TRUE

+END PROC process footnote;

+PROC process head (INT CONST index) :

+  IF in header

+     THEN report ("Header-Schachtelung")

+  FI;

+  paired move cmd := "f\323";

+  IF index <= headeven

+     THEN paired move cmd CAT "1";

+          IF index = head

+             THEN paired move cmd CAT "2"

+             ELSE paired move cmd CAT "4"

+          FI

+     ELSE paired move cmd CAT "23"

+  FI;

+  paired move cmd CAT "\\rt\&00";

+  cat to wp command (paired move cmd);

+  in header := TRUE

+END PROC process head;

+PROC process bottom (INT CONST index) :

+  IF in bottom

+     THEN report ("Bottom-Schachtelung")

+  FI;

+  paired move cmd := "f\324";

+  IF index <= bottomeven

+     THEN paired move cmd CAT "1";

+          IF index = bottom

+             THEN paired move cmd CAT "2"

+             ELSE paired move cmd CAT "4"

+          FI

+     ELSE paired move cmd CAT "23"

+  FI;

+  paired move cmd CAT "\\rt\&00";

+  cat to wp command (paired move cmd);

+  in bottom := TRUE

+END PROC process bottom;

+PROC process end :

+  reset types and mods;

+  cat to wp command (paired move cmd);

+  IF in header

+     THEN in header := FALSE

+  ELIF in bottom

+     THEN in bottom := FALSE

+  ELIF in footnote

+     THEN in footnote := FALSE

+  ELSE report ("Unmotivierte End-Anweisung")

+  FI

+.

+reset types and mods :

+  reset modifications;

+  IF current wp size <> 3

+     THEN cat to wp command (wp types on off [current wp size]);

+          current wp size := 3;

+  FI

+END PROC process end;

+PROC process columns :

+  INT VAR fcp, scp;

+  cat to wp command ("s\>1301");          

+  next text command pos (act l, act text start, fcp, scp);

+  IF fcp = second cross pos + 1

+     THEN eumel chunk := subtext (act l, fcp + 1, scp - 1);

+          analyze command (cosmetic cmds, eumel chunk, 3, cmd index,

+                           no of params, param1, param2);

+          IF cmd index = limit

+             THEN second cross pos := scp

+          FI

+  FI                       

+END PROC process columns;

+PROC process index on (TEXT CONST index number, registered text) :

+  IF in index

+     THEN report ("Kann Indexschachtelung nicht verarbeiten")

+  FI;

+  current index number := int (index number);

+  index buffer := "<|s\<3";

+  IF registered text <> ""

+     THEN index buffer CAT registered text

+     ELSE in index := TRUE

+  FI

+END PROC process index on;

+PROC process index off (TEXT CONST index number) :

+  INT CONST index off number := int (index number);

+  IF current index number = index off number

+     THEN current index number := 0

+     ELSE report ("Kann Indexschachtelung nicht verarbeiten")

+  FI;

+  wp cmd := index buffer;

+  wp cmd CAT "\\rt\ |>";

+  in index := FALSE

+END PROC process index off;

+PROC process reference target (TEXT CONST marker) :

+  buffer := "s\J21\&\<12";

+  buffer CAT marker;

+  buffer CAT wp return;

+  cat to wp command (buffer)

+END PROC process reference target;

+PROC process table :

+  IF users tabs cmd <> no users tabs cmd

+     THEN wp cmd := users tabs cmd

+  FI;

+  in table := TRUE

+END PROC process table;

+PROC process table end :

+  wp cmd := global tabs cmd;

+  in table := FALSE

+END PROC process table end;

+PROC process tab stop (TEXT CONST tab type, tab pos) :

+  buffer := german real (tab pos);

+  buffer CAT wp return;

+  IF pos ("rcd", tab type) <> 0

+     THEN buffer CAT tab type

+  FI;                     

+  insert new tab stop;

+  IF in table

+     THEN wp cmd CAT users tabs cmd

+  FI

+.

+insert new tab stop :

+  insert char (users tabs cmd, buffer, current tab insert pos);

+  current tab insert pos INCR LENGTH buffer

+END PROC process tab stop;

+PROC process clear all tabs :

+  users tabs cmd := no users tabs cmd;

+  current tab insert pos := default tab insert pos;

+END PROC process clear all tabs;

+PROC process clear tab (TEXT CONST tab pos) :

+  INT VAR del start, del end;

+  del start := pos (users tabs cmd, tab pos);

+  IF del start <> 0

+     THEN clear pos

+  FI

+.

+clear pos :

+  del end := pos (users tabs cmd, wp return, del start) + 4;

+  buffer := users tabs cmd SUB del end + 1;

+  IF pos ("rcd", buffer) <> 0

+     THEN del end INCR 1

+  FI;

+  change (users tabs cmd, del start, del end, "");

+  IF in table

+     THEN wp cmd CAT users tabs cmd

+  FI

+END PROC process clear tab;

+PROC report (TEXT CONST t) :

+  errorstop ("Zeile " + text (act l no) + ": " + t)

+END PROC report;

+TEXT PROC german real (TEXT CONST t) :

+  TEXT VAR t1 := t;

+  change (t1, ".", ",");

+  t1

+END PROC german real;

+TEXT PROC german real (REAL CONST r) :

+  TEXT VAR t := text (r);

+  german real (t)

+END PROC german real;

+END PACKET wordperfect conversion;

diff --git a/app/diskettenmonitor/3.5/source-disk b/app/diskettenmonitor/3.5/source-disk
new file mode 100644
index 0000000..10203de
--- /dev/null
+++ b/app/diskettenmonitor/3.5/source-disk
@@ -0,0 +1 @@
+debug/diskettenmonitor-3.5_1986-11-16.img
diff --git a/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle b/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle
new file mode 100644
index 0000000..f60101d
--- /dev/null
+++ b/app/diskettenmonitor/3.5/src/basic menu handling 3.5.quelle
@@ -0,0 +1,53 @@
+
+PACKET basic menu handling
+ 
+(************************************************************************) 
+(*                                                                      *) 
+(*  Basic Menu Handling Version 1.0                                   *) 
+(*                                                                      *) 
+(*                                                                      *) 
+(* Autor : Ingo Siekmann                                                *) 
+(* Stand : Donnerstag, den 12. Juni 1986                                *) 
+(*                                                                      *) 
+(* Lauffähig ab EUMEL Version 1.7.3                                     *) 
+(*                                                                      *) 
+(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert                     *) 
+(*                                                                      *) 
+(************************************************************************) 
+
+       DEFINES menue monitor :
+
+
+
+LET info line x pos    =    1 ,
+    info line y pos    =   20 ,
+    command line x pos =    1 ,
+    command line y pos =   21 ;
+
+LET first mon line    = "----------------------------------------------------------------------------" ,
+    command line      = ">__________________________________________________________________________<" ; 
+
+
+TEXT VAR char ;
+
+PROCEDURE menue monitor (TEXT CONST info line, chars,  (* I. Siekmann *)
+                         INT VAR command index) :      (* 12.06.1986  *)
+    enable stop ;
+    cursor (1, 17) ;
+    command index := 0 ;
+    out (first mon line) ;
+    cursor (info line x pos, info line y pos) ;
+    out (info line) ;
+    cursor (command line x pos, command line y pos) ; 
+    out (command line) ;
+    cursor (command line x pos + 1, command line y pos) ; 
+    REPEAT
+  (*  inchar (char) ;  *)
+      get char (char) ;
+      command index := pos (chars, char)
+    UNTIL command index > 0 COR is error END REPEAT ;
+    out (char) .
+END PROCEDURE menue monitor ;
+
+ENDPACKET basic menu handling ;
+
diff --git a/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle b/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle
new file mode 100644
index 0000000..d081c8e
--- /dev/null
+++ b/app/diskettenmonitor/3.5/src/disk 3.5-m.quelle
@@ -0,0 +1,2192 @@
+(************************************************************************) 
+(*                                                                      *)
+(*  DDDD   IIIII   SSSS  K  K      3333      55555      /  M     M      *)
+(*  D   D    I    S      K K           3     5         /   MM   MM      *)
+(*  D   D    I     SSS   KK         333      5555     /    M M M M      *)
+(*  D   D    I        S  K K           3         5   /     M  M  M      *)
+(*  DDDD   IIIII  SSSS   K  K      3333   O  5555   /      M     M      *)
+(*                                                                      *)
+(************************************************************************)
+(*                                                                      *)
+(* Diskettenmonitor   Version 3.5 Multi                                 *)
+(*                                                                      *)
+(* Autor : Ingo Siekmann unter freundlicher Mithilfe von Stefan Haase,  *)
+(*                                Nils Ehnert, APu und Frank Lenniger   *)
+(*                                                                      *)
+(* Stand : Sonntag, den 16. November 1986                               *)
+(*                                                                      *)
+(* Lauffähig ab EUMEL Version 1.7.3 /M in Systemtasks                   *)
+(*                                                                      *)
+(*                                                                      *)
+(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert                     *)
+(*                                                                      *)
+(************************************************************************)
+(************************************************************************)
+(*                                                                      *)
+(* Softwareaenderungen und Softwareneuerungen :                         *)
+(*                                                                      *)
+(* 03.01.1986 3.3.2.8 : Block- Asciieditor ueberarbeitet, neuer Header- *)
+(*                      editor (V1.3), Helpfunktion, gib kommando,      *)
+(*                      Fileaccess auch fuer 16-Files                   *)
+(* 15.01.1986 3.3.2.9 : Vorbereitung fuer den Suchmodus in 3.3.3.0,     *)
+(*                      Notbremse ins globalmenue mit ctrl g, byte ops  *)
+(*                      ueberarbeitet, pic dienste in vorbereitung      *)
+(*                      Headereditor (V1.4)                             *)
+(* 16.01.1986         : halt from terminal --> ctrl g := true           *)
+(* 16.01.1886 3.3.3.0 : Suchmodus ins Blockmenue (TEST), Blockeditor    *)
+(*                      Byteposops fuer Suchmodus einbauen              *)
+(* 21.01.1986         : inchar in get char umgewandelt                  *)
+(* 28.01.1986         : lernmodus eingebaut (???)                       *)
+(* 31.01.1986 3.3.3.1 : Suchmodus und Lernmodus wieder ausgebaut        *)
+(*                      beim Datenraumschreiben nur belegte Bloecke raus*)
+(* 14.02.1986 3.3.3.2 : Fehler Überarbeitet                             *)
+(* 20.02.1986         : Suchmodus vorbereitet (2. Versuch ?)            *)
+(* 06.03.1986 3.3.3.3 : Suchmodus eingebaut (Test)                      *)
+(* 10.03.1986         : Softwaretrennung zwischen Single und Multi      *)
+(* 12.03.1986         : read next block cmd ins blockmenu eingebaut     *)
+(*                      Fehler überarbeitet, Vorbereitung für besseren  *)
+(*                      Suchmodus                                       *)
+(* 17.03.1986 3.3.3.4 : configurator menü -> einstellen von disk type,  *)
+(*                      i/o channel, disk info. TEXT/HEX search .       *)
+(* 02.04.1986         : urflop ops mit versatzops                       *)
+(* 08.04.1986         : urflop menue mit versatz                        *)
+(* 30.04.1986 3.3.3.5 : Fehler ueberarbeitet                            *)
+(* 30.04.1986 3.3.3.6 : lab read/write ins space menue                  *)
+(* 05.05.1986 3.3.3.7 : hex / dez - get für alles, block editor über-   *)
+(*                      arbeitet, fehler überarbeitet. auslieferung für *)
+(*                      HRZ !                                           *)
+(* 06.06.1986 3.4     : Fehler im search und menue monitor behoben      *)
+(* 12.06.1986         : Fehler im Space/Header-Menue behoben            *)
+(* 16.11.1986 3.5     : Fehler im Urflopmenue behoben                   *)
+(*                                                                      *)
+(*       A C H T U N G  : Keine weitere Entwicklung von Version 3 !!    *)
+(*                                                                      *)
+(*            Bielefeld, den 16.11.1986        ULES                     *)
+(*                                                                      *)
+(*                      Ingo Siekmann                                   *)
+(*                                                                      *)
+(*                                                                      *)
+(************************************************************************)
+
+PACKET byte operations and disk monitor version 35 multi 
+ 
+       DEFINES  BYTE , 
+                HEX , 
+                ASCII , 
+                DECRL , 
+                DECRH , 
+                INCRL , 
+                INCRH ,
+                := ,
+                - ,
+                + ,
+                $ , 
+                hint ,
+                zu byte ,
+                lower byte ,
+                higher byte ,
+                set lower byte ,
+                set higher byte ,
+                nil byte ,
+                put ,
+                get ,
+
+                block in ,
+                block out ,
+
+                HEADER , 
+                header ,
+                nil header ,
+                is start header ,
+                is end header ,
+                is file header ,
+                name ,
+                date ,
+                type ,
+                pass ,
+                header edit ,
+
+                show first ,
+                show second ,
+                block edit ,
+                ascii edit ,
+
+                set ctrl g ,
+                reset ctrl g ,
+
+                set channel ,
+                read block ,
+                write block ,
+                seek space ,
+                seek block ,
+                read space ,
+                write space ,
+                check archive error ,
+
+                space nr ,
+                header nr ,
+
+                urlader lesen ,
+                urlader schreiben ,
+                urlader lesen auf seite ,
+                urlader schreiben von seite ,
+
+                search ,
+
+                io control ,
+
+                central disk monitor process : 
+
+
+
+LET start of volume = 1000 ,
+    end of volume   =    1 ,
+    file header     =    3 ;
+
+LET global info line  = "** GLOBAL : b / s / a / c / u / k / q     # stop --> ctrl g, help --> ""?"" **" ,
+    block info line   = "** BLOCK  : r / w / e / k / s / n / q     # stop --> ctrl g, help --> ""?"" **" ,
+    search info line  = "** SEARCH : a -> ascii / h -> hex / q -> quit / ctrl g -> stop            **" ,
+    editor info line  = "** EDITOR : f / s / d / e / k / p / q     # stop --> ctrl g, help --> ""?"" **" ,
+    space info line   = "** SPACE  : r, R, w, W, e, E, s, l, k, q  # stop --> ctrl g, help --> ""?"" **" ,
+    space header info = "** SPACE / HEADER : s -> read space / h -> read header / q -> quit        **" ,
+    archiv info line  = "** ARCHIV : a / r / l / f / s / k / q     # stop --> ctrl g, help --> ""?"" **" ,
+    urflop info line  = "** URFLOP : r / R / w / W / l / k / q     # stop --> ctrl g, help --> ""?"" **" ,
+    conf info line    = "** CONFIGURATOR : c / t / i / k / q       # stop --> ctrl g, help --> ""?"" **" ,
+    first mon line    = "----------------------------------------------------------------------------" ,
+    command line      = ">__________________________________________________________________________<" ; 
+ 
+LET global chars = "bsacuqk?"7"" ,
+    block chars  = "rweqksn?"7"" ,
+    search chars = "ahdq"7"" ,
+    editor chars = "fsdeqk?"7"p" ,
+    space chars  = "rRwWesqEkl?"7"" ,
+    archiv chars = "arlfsqk?"7"" ,
+    urflop chars = "rRwWlqk?"7"" ,
+    conf chars   = "ctikq?"7"" ;
+
+LET info line x pos    =    1 ,
+    info line y pos    =   20 ,
+    info line x pos 2  =    1 ,
+    info line y pos 2  =   24 ,
+    command line x pos =    1 ,
+    command line y pos =   21 ,
+    error line x pos   =    1 ,
+    error line y pos   =   22 ,
+
+    file type          = 1003 ,
+    file type 16       = 1002 ,
+
+    block 0            =    0 ,
+
+    std archive channel =  31 ,
+
+    type mode          =    1 ,
+    size mode          =    5 ,
+    std disk type      =    0 ;
+
+LET software stand      = "Sonntag, den 16.11.1986" ,
+    software version    = "Version  3.5 /Multi" ,
+    software bemerkung  = "*** Ende der Entwicklung der Version 3 ! ***" ,
+    software bemerkung1 = "" ;
+
+LET eumel 0 start block        = 10 ,
+    eumel 0 end block          = 65 ,
+    eumel 0 end block pic      = 62 ,
+    eumel 0 end block 1758     = 67 ,
+    pic char table start block = 63 ,
+    pic char table end block   = 65 ,
+    pic shard start block      =  0 ,
+    pic shard end block        = 79 ,
+
+    read write impossible error = 101 ,
+    read error                  = 102 ,
+    write error                 = 103 ,
+    block number error          = 104 ,
+    undef archive error         = 105 ;
+
+LET ibm 720 format 5            = 1440 ,
+    ibm 360 format 5            =  720 ,
+    pic 400 format 5            = 1600 ,
+    soft sd 8                   = 1232 ,
+    soft dd 8                   = 2464 ,
+    hard ss sd                  =  616 ,
+    hard ds sd                  = 1232 ;
+
+LET home                = ""1"" ,
+    left                = ""8"" ,
+    right               = ""2"" ,
+    up                  = ""3"" ,
+    down                = ""10"" ,
+    return              = ""13"" ,
+    tab                 = ""9"" ,
+    esc                 = ""27"" ,
+    cl eol              = ""5"" ,
+    cl eop              = ""4"" ;
+
+LET hex chars  = "0123456789ABCDEF" ,
+    hex marker = "h" ;
+
+LET start pos      = 479 , 
+    heap page nr   =   2 ; 
+ 
+
+TYPE HEADER = STRUCT (TEXT name, date, INT type, TEXT pass) ;
+ 
+TYPE BYTE = STRUCT (INT lower byte , higher byte) ; 
+
+
+HEADER CONST nil header := HEADER : ("", "", 0, "") ;
+BOUND HEADER VAR bound header ;
+BOUND TEXT VAR bound text ;
+
+INITFLAG VAR this packet := false ;
+
+ROW 256 BYTE VAR block ;
+ROW 32 TEXT VAR text block ;
+ROW 256 INT VAR block int ;
+
+DATASPACE VAR ds :: nilspace ; forget (ds) ;
+DATASPACE VAR afds :: nilspace ; forget (afds) ;
+DATASPACE VAR lds :: nilspace ; forget (lds) ;
+DATASPACE VAR uds :: nilspace ; forget (uds) ; 
+DATASPACE VAR blkinds :: nilspace ; forget (blkinds) ;
+
+FILE VAR af, f, lf ; 
+
+INT VAR command index, block nummer, space nummer, x, y, i, i1, xx, yy, 
+        archive channel := std archive channel, user channel, error answer,
+        header nummer, first sp block, integer, archiv size, error, block nr,
+        stpos, s, e, fb, fp, cx, cy, disk type := std disk type, ver ;
+
+TEXT VAR c, hex line :: "", tc, char, t, archive name, dummy,
+         stb1, stb2, own command line ;
+
+REAL VAR po ;
+
+BOOL VAR first := true, ende, list file ok, block shown, ctrl g, result ;
+ 
+
+(********************** PACKET bytes ok :       ****************************)
+
+
+BYTE PROC nil byte : 
+  BYTE : (0,0)
+END PROC nil byte ; 
+ 
+OP := (BYTE VAR byte , BYTE CONST old byte) : 
+  byte.lower byte  := old byte.lower byte ; 
+  byte.higher byte := old byte.higher byte. 
+END OP := ; 
+ 
+OP := (BYTE VAR byte , INT CONST int byte) : 
+  byte.lower byte  := int byte MOD 256 ; 
+  byte.higher byte := (int byte AND -256) DIV 256 AND 255 . 
+END OP := ; 
+ 
+OP := (ROW 256 BYTE VAR byte, ROW 256 INT CONST int byte) :
+  INT VAR i ;
+  FOR i FROM 1 UPTO 256 REPEAT
+    byte (i) := int byte (i)
+  END REPEAT .
+END OP := ;
+
+OP := (ROW 256 INT VAR int byte, ROW 256 BYTE CONST byte) :
+  INT VAR i ;
+  FOR i FROM 1 UPTO 256 REPEAT 
+    int byte (i) := byte (i)
+  END REPEAT .
+END OP := ;
+
+BYTE OP + (BYTE VAR byte , INT CONST int byte) : 
+  byte.lower byte := byte.lower byte + lower byte (int byte) ; 
+  byte.higher byte := byte.higher byte + higher byte (int byte) ; 
+  byte . 
+END OP + ; 
+ 
+BYTE OP - (BYTE VAR byte, INT CONST int byte) : 
+  byte.lower byte := byte.lower byte - lower byte (int byte) ; 
+  byte.higher byte := byte.higher byte - higher byte (int byte) ; 
+  byte . 
+END OP - ; 
+ 
+OP := (INT VAR int byte, BYTE CONST byte) : 
+  IF byte.higher byte > 127 
+    THEN int byte := minus * 255 + minus + byte.lower byte
+    ELSE int byte := byte.higher byte * 256 + byte.lower byte 
+  END IF
+
+.minus : byte.higher byte - 256 .
+END OP := ; 
+ 
+OP INCRL (BYTE VAR byte, INT CONST lower) :
+  byte.lower byte INCR lower 
+END OP INCRL ;
+
+OP INCRH (BYTE VAR byte, INT CONST high) :
+  byte.higher byte INCR high 
+END OP INCRH ;
+
+OP DECRL (BYTE VAR byte, INT CONST lower) :
+  byte.higher byte DECR lower
+END OP DECRL ;
+
+OP DECRH (BYTE VAR byte, INT CONST high) :
+  byte.higher byte DECR high
+END OP DECRH ;
+
+INT PROC lower byte (BYTE CONST byte) :
+  byte.lower byte .
+END PROC lower byte ;
+
+INT PROC higher byte (BYTE CONST byte) :
+  byte.higher byte .
+END PROC higher byte ;
+
+INT PROC lower byte (INT CONST int byte) : 
+  int byte MOD 256 . 
+END PROC lower byte ; 
+ 
+INT PROC higher byte (INT CONST int byte) : 
+  (int byte AND -256) DIV 256 AND 255 . 
+END PROC higher byte ; 
+ 
+PROC set lower byte (BYTE VAR byte, INT CONST lower byte) :
+  byte.lower byte := lower byte 
+END PROC set lower byte ;
+
+PROC set higher byte (BYTE VAR byte, INT CONST higher byte) :
+  byte.higher byte := higher byte 
+END PROC set higher byte ;
+ 
+OP HEX (TEXT VAR insert line , BYTE CONST byte) : 
+   insert line CAT (hex chars SUB (byte.lower byte  DIV 16 + 1)) ; 
+   insert line CAT (hex chars SUB (byte.lower byte  MOD 16 + 1)) ; 
+   insert line CAT " " ; 
+   insert line CAT (hex chars SUB (byte.higher byte DIV 16 + 1)) ; 
+   insert line CAT (hex chars SUB (byte.higher byte MOD 16 + 1)) ; 
+   insert line CAT " " . 
+END OP HEX ; 
+ 
+OP ASCII (TEXT VAR insert line , BYTE CONST byte) : 
+  insert line CAT ascii (byte.lower byte ) ; 
+  insert line CAT ascii (byte.higher byte) . 
+END OP ASCII ;
+ 
+TEXT PROC ascii (INT CONST half byte) : 
+  IF half byte >  31 AND half byte < 127 COR 
+     half byte > 213 AND half byte < 219 COR 
+     half byte = 251
+    THEN code (half byte) 
+    ELSE "." 
+  END IF . 
+END PROC ascii ; 
+ 
+PROC block in (ROW 256 BYTE VAR block bytes, INT CONST type , block nr) : 
+  ROW 256 INT VAR block ; 
+  reset block io ;
+  block in (block, type, block nr, error answer) ; 
+  block bytes := block ; 
+  check archive error (error answer, true) .
+END PROC block in ; 
+
+PROC block out (ROW 256 BYTE CONST bytes , INT CONST disk type, block nr) :
+  ROW 256 INT VAR int bytes := bytes ;
+  reset block io ;
+  block out (int bytes, disk type, block nr, error answer) ;
+  check archive error (error answer, true) .
+END PROC block out ;
+
+PROC put (BYTE CONST byte) : 
+  put ("LOW : " + text (byte.lower byte) + " HIGH : " + text (byte.higher byte)) .
+END PROC put ; 
+ 
+PROC get (BYTE VAR byte) : 
+  get (integer) ; 
+  byte := integer . 
+END PROC get ; 
+ 
+PROC zu byte (ROW 256 BYTE VAR bytes, TEXT CONST byte kette, INT CONST stelle) :
+  INT VAR lower, higher ;
+  lower := pos (hex chars, (byte kette SUB 1)) * 16 +
+           pos (hex chars, (byte kette SUB 2)) - 17 ;
+  higher:= pos (hex chars, (byte kette SUB 4)) * 16 +
+           pos (hex chars, (byte kette SUB 5)) - 17 ;
+  IF higher > 127
+    THEN bytes (stelle) := minus * 255 + minus + lower
+    ELSE bytes (stelle) := higher * 256 + lower
+  END IF .
+
+minus : higher - 256 .
+END PROC zu byte ;
+
+BYTE OPERATOR $ (TEXT CONST hex) : 
+    TEXT VAR byte kette :: ""; 
+    FOR i FROM 1 UPTO 4 REPEAT
+       IF (hex SUB i) = "" 
+         THEN byte kette CAT "0" 
+       ELIF (hex SUB i) = " " 
+         THEN (* Nix *) 
+         ELSE byte kette CAT (hex SUB i) 
+       END IF ; 
+    END REPEAT ; 
+    BYTE VAR byte ;
+    INT VAR lower, higher, i; 
+    lower := pos (hex chars, (byte kette SUB 1)) * 16 + 
+             pos (hex chars, (byte kette SUB 2)) - 17 ; 
+    higher:= pos (hex chars, (byte kette SUB 3)) * 16 + 
+             pos (hex chars, (byte kette SUB 4)) - 17 ; 
+    IF higher > 127 
+      THEN byte := minus * 255 + minus + lower 
+      ELSE byte := higher * 256 + lower
+    END IF ; 
+    byte . 
+
+minus : higher - 256 . 
+END OPERATOR $ ; 
+
+INT PROCEDURE hint (TEXT CONST he) :
+    INT VAR laenge :: length (he) ,
+            stelle ,
+            ziffer ,
+            ergebnis :: 0 ;
+
+    TEXT VAR h :: he ;
+
+    FOR stelle FROM 65 UPTO 70 REPEAT
+      change all (h, code (stelle + 32), code (stelle))
+    END REPEAT ;
+
+    FOR stelle FROM laenge DOWNTO 1 REP
+      ziffer := pos ("0123456789ABCDEF", h SUB stelle) - 1 ;
+      IF ziffer < 0 
+        THEN errorstop ("Unerlaubtes Zeichen in Hexadezimalzahl")
+      END IF ;
+      ergebnis := ergebnis + ziffer * 16 ** (laenge - stelle)
+    END REP ;
+    ergebnis
+END PROCEDURE hint ;
+
+
+(********************** PACKET header operations ***************************)
+
+
+OPERATOR := (HEADER VAR dest, HEADER CONST source) :
+    CONCR (dest) := CONCR (source) .
+END OPERATOR := ;
+
+HEADER PROCEDURE header (TEXT CONST name, date, INT CONST type,
+                         TEXT CONST pass) :
+    HEADER : (name, date, type, pass) .
+END PROCEDURE header ;
+
+BOOL PROCEDURE is start header (HEADER CONST header) :
+    CONCR (header).type = start of volume .
+END PROCEDURE is start header ;
+
+BOOL PROCEDURE is end header (HEADER CONST header) :
+    CONCR (header).type = end of volume .
+END PROCEDURE is end header ;
+
+BOOL PROCEDURE is file header (HEADER CONST header) :
+    CONCR (header).type = file header .
+END PROCEDURE is file header ;
+
+PROCEDURE name (HEADER VAR header, TEXT CONST new name) :
+    CONCR (header).name := new name .
+END PROCEDURE name ;
+
+TEXT PROCEDURE name (HEADER CONST header) :
+    CONCR (header).name .
+END PROCEDURE name ;
+
+PROCEDURE date (HEADER VAR header, TEXT CONST new date) :
+    CONCR (header).date := new date .
+END PROCEDURE date ;
+
+TEXT PROCEDURE date (HEADER CONST header) :
+    CONCR (header).date .
+END PROCEDURE date ;
+
+PROCEDURE type (HEADER VAR header, INT CONST new type) :
+    CONCR (header).type := new type .
+END PROCEDURE type ;
+
+INT PROCEDURE type (HEADER CONST header) :
+    CONCR (header).type .
+END PROCEDURE type ;
+
+PROCEDURE pass (HEADER VAR header, TEXT CONST new pass) :
+    CONCR (header).pass := new pass .
+END PROCEDURE pass ;
+
+TEXT PROCEDURE pass (HEADER CONST header) :
+    CONCR (header).pass .
+END PROCEDURE pass ;
+
+
+(**********************   Header-Editor V1.4    ****************************)
+
+
+PROCEDURE header edit (HEADER VAR header, TEXT CONST msg) :
+    TEXT VAR head :: ""15"HEADER - EDITOR V1.4" + (25 - LENGTH msg) * "." + msg +
+                     5 * "." + " "14"" ;
+    disable stop ;
+    REPEAT
+      out (home) ;
+      out (16 * (cl eol + down)) ;
+      cursor (6, 6) ;
+      putline (head) ;
+      cursor (6, 7) ;
+      put (""15"TEXT name : "14"") ;
+      edit get (CONCR (header).name, max text length, 38) ;
+      IF is error
+        THEN clear error ;
+             CONCR (header).name := "" ;
+             cursor (6, 7) ;
+             put (""15"TEXT name : "14"") ;
+             edit get (CONCR (header).name, max text length, 38) 
+      END IF ;
+      cursor (6, 8) ;
+      put (""15"TEXT date : "14"") ;
+      edit get (CONCR (header).date, max text length, 38) ;
+      IF is error
+        THEN clear error ;
+             CONCR (header).date := "" ;
+             cursor (6, 8) ;
+             put (""15"TEXT date : "14"") ;
+             edit get (CONCR (header).date, max text length, 38) 
+      END IF ;
+      cursor (6, 9) ;
+      put (""15"INT type  : "14"") ;
+      TEXT VAR d :: text (CONCR (header).type) ;
+      edit get (d, max text length, 38) ;
+      CONCR (header).type := int (d) ;
+      cursor (6, 10) ;
+      put (""15"TEXT pass : "14"") ;
+      edit get (CONCR (header).pass, max text length, 38) ;
+      IF is error
+        THEN clear error ;
+             CONCR (header).pass := "" ;
+             cursor (6, 10) ;
+             put (""15"TEXT pass : "14"") ;
+             edit get (CONCR (header).pass, max text length, 38) 
+      END IF ;
+      cursor (6, 13) ;
+    UNTIL NOT no (""15"header ok. "14"") END REPEAT 
+END PROCEDURE header edit ;
+ 
+
+(********************** PACKET block editor     ****************************)
+
+
+PROCEDURE show first (ROW 256 BYTE CONST block) :
+    out (home) ;
+    po := 1.0 ;
+    first := true ;
+    FOR i FROM 1 UPTO 16 REPEAT
+      text block (i) := text ((i - 1) * 16, 4) ;
+      text block (i) CAT " : " ;
+      get cursor (x, y) ;
+      FOR i1 FROM 1 UPTO 8 REPEAT
+         text block (i) HEX block ((i-1) * 8 + i1)
+      END REPEAT ;
+      text block (i) CAT "  *" ;
+      FOR i1 FROM 1 UPTO 8 REPEAT
+         text block (i) ASCII block ((i - 1) * 8 + i1)
+      END REPEAT ;
+      text block (i) CAT "*" ;
+      cursor (x, y) ;
+      putline (text block (i))
+    END REPEAT .
+END PROCEDURE show first ;
+
+PROCEDURE show second (ROW 256 BYTE CONST block) :
+    out (home) ;
+    po := 129.0 ;
+    first := false ;
+    FOR i FROM 17 UPTO 32 REPEAT
+      text block (i) := text ((i - 1) * 16, 4) ;
+      text block (i) CAT " : " ;
+      get cursor (x,y) ;
+      FOR i1 FROM 1 UPTO 8 REPEAT
+         text block (i) HEX block ((i - 1) * 8 + i1) 
+      END REPEAT ;
+      text block (i) CAT "  *" ;
+      FOR i1 FROM 1 UPTO 8 REPEAT
+         text block (i) ASCII block ((i - 1) * 8 + i1)
+      END REPEAT ;
+      text block (i) CAT "*" ;
+      cursor (x, y);
+      putline (text block (i))
+    END REPEAT .
+END PROCEDURE show second ;
+ 
+PROCEDURE block edit (ROW 256 BYTE VAR block, INT CONST st) :
+    IF st > 0
+      THEN IF st > 255
+             THEN push (255 * right)
+             ELSE push (st * right)
+           END IF 
+    END IF ;
+    BOOL VAR low :: TRUE ;
+    edit info ;
+    cursor (8, 1) ;
+    get cursor (x, y) ;
+    po := 1.0 ;
+    REPEAT 
+      get cursor (x, y) ;
+      cursor (x, y) ;
+  (*  inchar (t) ;  *)
+      get char (t) ;
+      IF (t = right OR t = " ") AND x < 53 
+        THEN cursor (x + 3, y) ; po INCR 0.5
+      ELIF (t = right OR t = " ") AND  x > 52 AND y < 16
+        THEN cursor (8, y + 1) ; po INCR 0.5
+      ELIF t = up AND y > 1
+        THEN cursor (x, y - 1) ; po DECR 8.0
+      ELIF t = left AND x > 8
+        THEN cursor (x - 3, y) ; po DECR 0.5
+      ELIF t = left AND x = 8 AND y <> 1
+        THEN cursor (53, y - 1) ; po DECR 0.5
+      ELIF t = down AND y < 16
+        THEN cursor (x, y + 1) ; po INCR 8.0
+      ELIF t = tab 
+        THEN IF first 
+               THEN show first (block)
+               ELSE show second (block)
+             END IF ;
+             ascii edit (block, first) ;
+             IF first 
+               THEN show first (block)
+               ELSE show second (block)
+             END IF ; 
+             IF t <> return
+               THEN edit info ;
+                    cursor (8, 1) ;
+             END IF 
+      ELIF t = ""7""
+        THEN set ctrl g 
+      END IF ;
+      get cursor (x, y) ;
+      cursor (x, y);
+      IF code (t) > 47 AND code (t) < 58 OR
+         code (t) > 96 AND code (t) < 103
+        THEN IF code (t) > 96 CAND code (t) < 103
+               THEN t := code (code (t) - 32)
+             END IF ;
+             out (left + "-" + 2 * right + "-" + 3 * left + t) ;
+             REPEAT
+           (*  inchar (tc) ;  *)
+               get char (tc) ;
+             UNTIL code (tc) > 47 AND code (tc) < 58 OR
+                   code (tc) > 96 AND code (tc) < 103   END REPEAT ;
+             IF code (tc) > 96 CAND code (tc) < 103
+               THEN tc := code (code (tc) - 32)
+             END IF ;
+             out (tc + " " + 4 * left + " ") ;
+             cursor (x, y) ;
+             t CAT tc ; 
+             INT VAR bp :: int (po) ; 
+             IF po MOD real (bp) = 0.0
+               THEN low := TRUE
+               ELSE low := FALSE
+             END IF ;
+             IF NOT first               (* ONE : 17.06.85 *)
+               THEN bp INCR 128
+             END IF ;
+             IF low
+               THEN set lower byte (block (bp), hint (t)) 
+               ELSE set higher byte (block (bp), hint (t)) 
+             END IF ;
+      END IF ;
+      info ;
+    UNTIL t = return COR ctrl g END REPEAT ;
+    IF first 
+      THEN show first (block)
+      ELSE show second (block)
+    END IF ;
+    cursor (1, 17) .
+
+info :
+  get cursor (x, y) ;
+  cursor (xx, yy) ;
+  IF po MOD real (int(po)) = 0.0
+    THEN put ("LOW") 
+    ELSE put ("HIGH")
+  END IF ; 
+  cursor (x,y) .
+
+edit info :
+  cursor (1, 23) ;
+  put (cl eol + "Block-Editor : Hexmodus,") ;
+  IF first
+    THEN put ("First Block")
+    ELSE put ("Second Block")
+  END IF ;
+  put (",") ;
+  get cursor (xx, yy) .
+END PROCEDURE block edit ;
+ 
+PROCEDURE block edit (ROW 256 BYTE VAR block, BOOL CONST first,
+                      INT CONST st) :
+ 
+    IF st > 0
+      THEN IF st > 255
+             THEN push (255 * right)
+             ELSE push (st * right)
+           END IF 
+    END IF ;
+    BOOL VAR low :: TRUE ;
+    edit info ;
+    cursor (8, 1) ;
+    get cursor (x, y) ;
+    po := 1.0 ;
+    REPEAT 
+      get cursor (x, y) ;
+      cursor (x, y) ;
+  (*  inchar (t) ;  *)
+      get char (t) ;
+      IF (t = right OR t = " ") AND x < 53 
+        THEN cursor (x + 3, y) ; po INCR 0.5
+      ELIF (t = right OR t = " ") AND  x > 52 AND y < 16
+        THEN cursor (8, y + 1) ; po INCR 0.5
+      ELIF t = up AND y > 1
+        THEN cursor (x, y - 1) ; po DECR 8.0
+      ELIF t = left AND x > 8
+        THEN cursor (x - 3, y) ; po DECR 0.5
+      ELIF t = left AND x = 8 AND y <> 1
+        THEN cursor (53, y - 1) ; po DECR 0.5
+      ELIF t = down AND y < 16
+        THEN cursor (x, y + 1) ; po INCR 8.0
+      ELIF t = tab 
+        THEN IF first 
+               THEN show first (block)
+               ELSE show second (block)
+             END IF ;
+             ascii edit (block, first) ;
+             IF first 
+               THEN show first (block)
+               ELSE show second (block)
+             END IF ; 
+             IF t <> return
+               THEN edit info ;
+                    cursor (8, 1) ;
+             END IF 
+      ELIF t = ""7""
+        THEN set ctrl g
+      END IF ;
+      get cursor (x, y) ;
+      cursor (x, y);
+      IF code (t) > 47 AND code (t) < 58 OR
+         code (t) > 96 AND code (t) < 103
+        THEN IF code (t) > 96 CAND code (t) < 103
+               THEN t := code (code (t) - 32)
+             END IF ;
+             out (left + "-" + 2 * right + "-" + 3 * left + t) ;
+             REPEAT
+           (*  inchar (tc) ;  *)
+               get char (tc) ;
+             UNTIL code (tc) > 47 AND code (tc) < 58 OR
+                   code (tc) > 96 AND code (tc) < 103   END REPEAT ;
+             IF code (tc) > 96 CAND code (tc) < 103
+               THEN tc := code (code (tc) - 32)
+             END IF ;
+             out (tc + " " + 4 * left + " ") ;
+             cursor (x, y) ;
+             t CAT tc ; 
+             INT VAR bp :: int (po) ; 
+             IF po MOD real (bp) = 0.0
+               THEN low := TRUE
+               ELSE low := FALSE
+             END IF ;
+             IF NOT first               (* ONE : 17.06.85 *)
+               THEN bp INCR 128
+             END IF ;
+             IF low
+               THEN set lower byte (block (bp), hint (t)) 
+               ELSE set higher byte (block (bp), hint (t)) 
+             END IF ;
+      END IF ;
+      info ;
+    UNTIL t = return COR ctrl g END REPEAT ;
+    IF first 
+      THEN show first (block)
+      ELSE show second (block)
+    END IF ;
+    cursor (1, 17) .
+
+info :
+  get cursor (x, y) ;
+  cursor (xx, yy) ;
+  IF po MOD real (int(po)) = 0.0
+    THEN put ("LOW") 
+    ELSE put ("HIGH")
+  END IF ; 
+  cursor (x,y) .
+
+edit info :
+  cursor (1, 23) ;
+  put (cl eol + "Block-Editor : Hexmodus,") ;
+  IF first
+    THEN put ("First Block")
+    ELSE put ("Second Block")
+  END IF ;
+  put (",") ;
+  get cursor (xx, yy) .
+END PROCEDURE block edit ;
+ 
+PROCEDURE ascii edit (ROW 256 BYTE VAR block, BOOL CONST first) :
+    BOOL VAR low ;
+    edit info ;
+    cursor (59, 1) ;
+    x := 1 ;
+    y := 1 ;
+    po := 1.0 ;
+    REPEAT
+      get char (t) ;
+      IF po < 1.0 AND first
+        THEN po := 1.0
+      END IF ;
+      IF po < 129.0 AND NOT first
+        THEN po := 129.0 
+      END IF ;
+      IF po > 128.5 AND first
+        THEN po := 128.5 
+      END IF ;
+      IF po > 256.5 AND NOT first
+        THEN po := 256.5 
+      END IF ;
+      SELECT pos (""9""8""2""3""10""13""7"", t) OF
+        CASE 1, 6 : quit ascii edit
+        CASE 2    : IF x > 1 COR (x = 1 AND y > 1)
+                      THEN x DECR 1; po DECR 0.5
+                    END IF 
+        CASE 3    : IF x < 16 COR (x = 16 AND y <> 16)
+                      THEN x INCR 1; po INCR 0.5 
+                    END IF 
+        CASE 4    : IF y > 1
+                      THEN y DECR 1 ;
+                           po DECR 8.0 
+                    END IF 
+        CASE 5    : IF y < 16
+                      THEN y INCR 1 ;
+                           po INCR 8.0 
+                    END IF 
+        CASE 7    : set ctrl g
+       OTHERWISE IF code (t) >= 32 AND code (t) <= 126
+                   THEN set char ; push (""2"")
+                 END IF
+      END SELECT ;
+      IF x < 1 AND y = 1
+        THEN x := 1
+      ELIF x < 1 AND y > 1
+        THEN x := 16 ;
+             y DECR 1
+      ELIF x > 16 AND y = 16
+        THEN x := 16 ;
+      ELIF x > 16 AND y < 16
+        THEN x := 1 ;
+             y INCR 1
+      ELIF y < 1
+        THEN y := 1
+      ELIF y > 16
+        THEN y := 16
+      END IF ;
+      info ;
+    UNTIL ctrl g END REPEAT .
+
+quit ascii edit :
+  x := 8 ;
+  y := 1 ;
+  cursor (x, y) ;
+  po := 1.0 ;
+  LEAVE ascii edit .
+
+set char :
+  out (t) ;
+  INT VAR bp :: int (po) ;
+  IF x MOD 2 = 0 
+    THEN set higher byte (block (bp), code (t))
+    ELSE set lower  byte (block (bp), code (t))
+  END IF.
+
+info :
+  cursor (xx, yy) ;
+  IF po MOD real (int (po)) = 0.0
+    THEN put ("LOW") 
+    ELSE put ("HIGH")
+  END IF ; 
+  cursor (58 + x, y) .
+
+edit info :
+  cursor (1, 23) ;
+  put (""5"Block-Editor : Asciimodus,") ;
+  IF first
+    THEN put ("First Block")
+    ELSE put ("Second Block")
+  END IF ;
+  put (",") ;
+  get cursor (xx, yy) .
+END PROCEDURE ascii edit ;
+
+
+(********************** PACKET block i/o :      ****************************)
+
+
+PROCEDURE set channel (INT CONST channel) :
+    archive channel := channel .
+END PROCEDURE set channel ;
+
+PROCEDURE read block (ROW 256 BYTE VAR block byte, INT CONST block nummer) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    block in (block int, disk type, block nummer, error answer) ;
+    IF is error
+      THEN clear error
+    END IF ;
+    break (quiet) ;
+    continue (user channel) ;
+    enable stop ;
+    check archive error (error answer, true) ;
+    block byte := block int .
+END PROCEDURE read block ;
+
+PROCEDURE write block (ROW 256 BYTE VAR block byte, INT CONST block nummer) :
+    user channel := channel ;
+    enable stop ;
+    block int := block byte ;
+    continue (archive channel) ;
+    disable stop ;
+    block out (block int, disk type, block nummer, error answer) ;
+    IF is error
+      THEN clear error
+    END IF ;
+    break (quiet) ;
+    continue (user channel) ;
+    enable stop ;
+    check archive error (error answer, false) .
+END PROCEDURE write block;
+
+PROCEDURE read block (ROW 256 INT VAR block int, INT CONST block nummer) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    block in (block int, disk type, block nummer, error answer) ;
+    IF is error
+      THEN clear error
+    END IF ;
+    break (quiet) ;
+    continue (user channel) ;
+    enable stop ;
+    check archive error (error answer, true) .
+END PROCEDURE read block ;
+
+PROC write block (ROW 256 INT VAR block int, INT CONST block nummer) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    block out (block int, disk type, block nummer, error answer) ;
+    IF is error
+      THEN clear error
+    END IF ;
+    break (quiet) ;
+    continue (user channel) ;
+    enable stop ;
+    check archive error (error answer, false) .
+END PROCEDURE write block ;
+
+
+(********************** PACKET space i/o :      ****************************)
+
+
+PROCEDURE seek space (INT CONST space) :
+    user channel := channel ;
+    enable stop ;
+    rewind ;
+    INT VAR i ;
+    continue (archive channel) ;
+    disable stop ;
+    FOR i FROM 1 UPTO space REPEAT
+      skip dataspace
+    UNTIL is error END REPEAT ;
+    break (quiet) ;
+    continue (user channel) .
+END PROCEDURE seek space ;
+
+PROCEDURE seek block (INT CONST block nr) :
+    seek (block nr) .
+END PROCEDURE seek block ;
+
+PROCEDURE read space (DATASPACE VAR ds) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    read (ds) ;
+    break (quiet) ;
+    continue (user channel) .
+END PROCEDURE read space ;
+
+PROCEDURE read space (DATASPACE VAR ds, INT VAR max pages,
+                      BOOL CONST errors) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    read (ds, max pages, errors) ;
+    break (quiet) ;
+    continue (user channel) .
+END PROCEDURE read space ;
+
+PROCEDURE write space (DATASPACE CONST ds) :
+    user channel := channel ;
+    enable stop ;
+    continue (archive channel) ;
+    disable stop ;
+    write (ds) ;
+    break (quiet) ;
+    continue (user channel) .
+END PROCEDURE write space ;
+
+PROCEDURE check archive error (INT CONST code, BOOL CONST read) :
+    enable stop ;
+    IF read 
+      THEN SELECT code OF
+             CASE 0 :
+             CASE 1 : error stop (read write impossible error,
+                                  "Lesen unmoeglich (1)")
+             CASE 2 : error stop (read error,
+                                  "Lesefehler (2)")
+             CASE 3 : error stop (block number error,
+                                  "Blocknummer zu hoch (3)")
+            OTHERWISE error stop (undef archive error,
+                                  "Archivfehler unbekannt ("+ text (code) +")") 
+           END SELECT
+      ELSE SELECT code OF
+             CASE 0 :
+             CASE 1 : error stop (read write impossible error,
+                                  "Schreiben unmoeglich (1)")
+             CASE 2 : error stop (write error,
+                                  "Schreibfehler (2)")
+             CASE 3 : error stop (block number error,
+                                  "Blocknummer zu hoch (3)")
+            OTHERWISE error stop (undef archive error,
+                                  "Archivfehler unbekannt ("+ text (code) +")")
+           END SELECT
+    END IF .
+END PROCEDURE check archive error ;
+
+
+(********************** PACKET menue monitor :  ****************************)
+
+
+PROCEDURE fehler behandeln :
+    IF is error CAND error message <> "" 
+      THEN IF is halt from terminal
+             THEN set ctrl g 
+             ELSE cursor (error line x pos, error line y pos) ; 
+                  clear error ;
+                  put (cl eol +"Fehler : "+ error message) 
+           END IF 
+    END IF .
+END PROCEDURE fehler behandeln ;
+
+PROCEDURE set ctrl g :
+    ctrl g := true .
+END PROCEDURE set ctrl g ;
+
+PROCEDURE reset ctrl g :
+    ctrl g := false .
+END PROCEDURE reset ctrl g ;
+
+PROCEDURE fehler loeschen :
+    INT VAR x, y ;
+    get cursor (x, y) ;
+    cursor (1, 22) ;
+    out (cl eol) ;
+    cursor (1, 18) ;
+    out (cl eol) ;
+    cursor (1, 23) ;
+    out (cl eol) ;
+    cursor (x, y) .
+END PROCEDURE fehler loeschen ;
+
+
+(**********************     Global-Menue        ****************************)
+
+
+PROCEDURE global menue :
+    ende := false ;
+    user channel := channel ;
+    disable stop ;
+    REPEAT
+      menue monitor (global info line, global chars, command index) ;
+      fehler loeschen ;
+      SELECT command index OF
+        CASE 1 : block menue
+        CASE 2 : space menue
+        CASE 3 : archive menue
+        CASE 4 : configurator menue
+        CASE 5 : urflop menue
+        CASE 6 : out ("uit");ende := true ;
+        CASE 7 : get and do one command ; block shown := false 
+        CASE 8 : global menue help ; block shown := false 
+        CASE 9 : set ctrl g 
+      END SELECT ;
+      fehler behandeln ;
+    UNTIL ende COR ctrl g END REPEAT ;
+    reset ctrl g ;
+    ende := false .
+END PROCEDURE global menue ;
+
+
+(**********************     Block-Menue         ****************************)
+
+
+PROCEDURE block menue :
+    disable stop ;
+    REPEAT
+      menue monitor (block info line, block chars, command index) ;
+      fehler loeschen ;
+      SELECT command index OF
+       CASE 1 : read one block
+       CASE 2 : write one block
+       CASE 3 : edit block menue
+       CASE 4 : LEAVE block menue
+       CASE 5 : get and do one command 
+       CASE 6 : search menue
+       CASE 7 : push ("r"+ text (block nummer + 1) +" ")
+       CASE 8 : block menue help ; block shown := false 
+       CASE 9 : set ctrl g
+     END SELECT ;
+     show first three ints ;
+     display info line ;
+     fehler behandeln 
+   UNTIL ctrl g END REPEAT .
+ 
+read one block :
+  out ("ead Block : ") ;
+  x get (block nummer) ;
+  IF NOT is error
+    THEN reset block io ;
+         read block (block, block nummer)
+  END IF ;
+  IF NOT is error
+    THEN show first (block) ; block shown := true
+  END IF .
+
+write one block :
+  out ("rite") ;
+  IF yes ("write auf Block "+ text (block nummer))
+    THEN reset block io ;
+         write block (block, block nummer)
+  ELIF yes ("write auf einen anderen Block")
+    THEN out (" auf Block : ") ;
+         x get (block nummer) ;
+         IF NOT is error
+           THEN reset block io ;
+                write block (block, block nummer) 
+         END IF 
+  END IF .
+
+show first three ints :
+  cursor (1, 18) ;
+  put (""5"1.INT : ") ;
+  TEXT VAR h :: "" ; h HEX block (1) ;
+  INT VAR ih := block (1) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) ;
+  put (", 2.INT : ") ;
+  h := "" ; h HEX block (2) ;
+  ih := block (2) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) ;
+  put (", 3.INT : ") ;
+  h := "" ; h HEX block (3) ;
+  ih := block (3) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) .
+END PROCEDURE block menue ;
+
+
+(**********************     Search-Menue        ****************************)
+
+
+PROCEDURE search menue :
+    disable stop ;
+    menue monitor (search info line, search chars, command index) ;
+    fehler loeschen ;
+    SELECT command index OF
+       CASE 1 : ascii search
+       CASE 2 : hex search
+       CASE 3 : dez search
+       CASE 4 : LEAVE search menue
+       CASE 5 : set ctrl g
+     END SELECT ;
+     display info line ;
+     fehler behandeln .
+
+ascii search :
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("Suchtext :") ; getline (t) ; 
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("suchen nach """+ t +""" von Block :") ;
+  x get (s) ; 
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("suchen nach """+ t +""" von Block") ;
+  put (s) ; put ("bis Block :") ; x get (e) ;
+  search (t, s, e, fb, fp) ; 
+  out (""13"") ;
+  IF fp > 0 
+    THEN put (cl eol +"Gefunden auf Block") ; put (fb) ;
+         put (", Position") ; put (fp) ; 
+         read block (block, fb) ; 
+         IF fp < 256 
+           THEN show first (block) 
+           ELSE show second (block) 
+         END IF ; 
+         block shown := true ;
+         st pos := (fp MOD 256) - 1 ;
+         block nummer := fb ;
+    ELSE put ("Nicht gefunden !!"); 
+  FI .
+
+hex search :
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("Suchhex :") ; getline (t) ; 
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("suchen nach """+ t +""" von Block :") ;
+  x get (s) ; 
+  cursor (command line x pos + 1, command line y pos) ;
+  put ("suchen nach """+ t +""" von Block") ;
+  put (s) ; put ("bis Block :") ; x get (e) ;
+  change all (t, " ", "") ;
+  TEXT VAR such hex := "" ;
+  i := 1 ;
+  REPEAT
+    such hex CAT code (hint (subtext (t, i, i + 1))) ;
+    i INCR 2
+  UNTIL i >= length (t) END REPEAT ;
+  search (such hex, s, e, fb, fp) ; 
+  out (""13"") ;
+  IF fp > 0 
+    THEN put (cl eol +"Gefunden auf Block") ; put (fb) ;
+         put (", Position") ; put (fp) ; 
+         read block (block, fb) ; 
+         IF fp < 256 
+           THEN show first (block) 
+           ELSE show second (block) 
+         END IF ; 
+         block shown := true ;
+         st pos := (fp MOD 256) - 1 ;
+         block nummer := fb ;
+    ELSE put ("Nicht gefunden !!"); 
+  FI .
+
+dez search :
+  error stop ("gibt es noch nicht !") .
+END PROCEDURE search menue ; 
+
+
+(**********************  Block-Editor-Menue     ****************************)
+
+
+PROCEDURE edit block menue :
+    INT VAR command index ;
+    disable stop ;
+    REPEAT
+      fehler loeschen ; 
+      show first three ints ;
+      menue monitor (editor info line, editor chars, command index) ;
+      SELECT command index OF
+        CASE 1 : out ("irst") ;
+                 show first (block) ;
+                 block shown := true 
+        CASE 2 : out ("econd") ;
+                 show second (block) ;
+                 block shown := true 
+        CASE 3 : out ("ump") ;
+                 show first (block) ; block edit (block, stpos) ;
+                 show second (block) ; block edit (block, stpos) ;
+                 block shown := true ;
+        CASE 4 : IF NOT block shown 
+                   THEN IF first
+                          THEN show first (block)
+                          ELSE show second (block)
+                        END IF ;
+                        block shown := true 
+                 END IF ;
+              (* IF first AND stpos >= 256
+                   THEN show second (block) ;
+                        block shown := true
+                 ELIF NOT first AND stpos <= 256
+                   THEN show first (block) ;
+                        block shown := true
+                 END IF ;                            *) (* ??? *)
+                 block edit (block, stpos) 
+        CASE 5 : LEAVE edit block menue
+        CASE 6 : get and do one command ; block shown := false 
+        CASE 7 : block editor menue help ;  block shown := false 
+        CASE 8 : set ctrl g
+        CASE 9 : INT VAR old st pos := st pos ;
+                 out ("os auf Byte : ") ; 
+                 x get (st pos) ;
+                 IF st pos < 0 OR st pos > 513
+                   THEN st pos := old st pos ;
+                        error stop ("Zahl nicht ok")
+                 END IF 
+      END SELECT ;
+      fehler behandeln
+    UNTIL ctrl g END REPEAT .
+
+show first three ints :
+  cursor (1, 18) ;
+  put (""5"1.INT : ") ;
+  TEXT VAR h :: "" ; h HEX block (1) ;
+  INT VAR ih := block (1) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) ;
+  put (", 2.INT : ") ;
+  h := "" ; h HEX block (2) ;
+  ih := block (2) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) ;
+  put (", 3.INT : ") ;
+  h := "" ; h HEX block (3) ;
+  ih := block (3) ;
+  h CAT ("/ " + text (ih)) ;
+  put (h) .
+END PROCEDURE edit block menue ;
+
+
+(**********************     Space-Menue         ****************************)
+
+
+PROCEDURE space menue :
+    disable stop ;
+    REPEAT
+      menue monitor (space info line, space chars, command index) ;
+      fehler loeschen ;
+      rewind ;
+      SELECT command index OF
+        CASE  1 : read one space 
+        CASE  2 : bit map read
+        CASE  3 : write one space
+        CASE  4 : bit map write
+        CASE  5 : edit one space
+        CASE  6 : copy one space 
+        CASE  7 : LEAVE space menue
+        CASE  8 : new edit
+        CASE  9 : get and do one command 
+        CASE 10 : load one space 
+        CASE 11 : space menue help 
+        CASE 12 : set ctrl g
+      END SELECT ;
+      fehler behandeln ;
+      display info line ;
+    UNTIL ctrl g END REPEAT .
+
+load one space :
+  out ("aden aus Datei : ") ;
+  getline (dummy) ;
+  forget (ds) ;
+  ds := nilspace ;
+  ds := old (dummy) .
+
+read one space :
+  cursor (info line x pos, info line y pos) ;
+  out (space header info) ;
+  cursor (command line x pos + 2, command line y pos) ;
+  out ("ead ") ;
+  REPEAT
+    get char (dummy)
+  UNTIL pos ("shq"7"", dummy) > 0 END REPEAT ;
+  IF dummy = "s"
+    THEN out ("Space : ") ; read one s
+  ELIF dummy = "h"
+    THEN out ("Header : ") ; read one h
+  ELIF dummy = ""7""
+    THEN set ctrl g
+  END IF .
+
+read one s :
+  x get (space nummer) ;
+  IF NOT is error
+    THEN seek space (space nummer) ;
+         first sp block := block number + 1 ;
+         forget (ds) ;
+         ds := nilspace ;
+         read space (ds)
+  END IF .
+
+read one h :
+  x get (header nummer) ;
+  space nummer := space nr (header nummer) ; 
+  IF NOT is error
+    THEN seek space (space nummer) ;
+         first sp block := block number + 1 ;
+         forget (ds) ;
+         ds := nilspace ;
+         read space (ds)
+  END IF .
+
+bit map read :
+  out ("ead Space ab Block : ") ;
+  x get (s) ;
+  cursor (command line x pos + 1, command line y pos) ;
+  out ("Read Space ab Block "+ text (s) +" Max. Bloecke : ") ;
+  x get (e) ;
+  seek block (s) ;
+  IF e = 0 
+    THEN e := 32000
+  END IF ;
+  forget (ds) ;
+  ds := nilspace ;
+  IF yes ("bei Lesefehlern abbrechen")
+    THEN read space (ds, e, true)
+    ELSE read space (ds, e, false)
+  END IF .
+
+write one space :
+  out ("rite") ;
+  IF yes ("write auf Space "+ text (space nummer))
+    THEN seek space (space nummer) ;
+         write space (ds) 
+  ELIF yes ("write auf einen anderen Space")
+    THEN out (" auf Space : ") ;
+         x get (space nummer) ;
+         IF NOT is error
+           THEN seek space (space nummer) ;
+                write space (ds)
+         END IF 
+  END IF .
+
+bit map write :
+  out ("rite Space ab Block : ") ;
+  x get (s) ;
+  seek block (s) ;
+  write space (ds) .
+
+edit one space :
+  IF type (ds) = file type 16
+    THEN change to 17 ;
+         f := sequential file (modify, ds) ;
+         edit (f, 1, 1, x size - 2, 16) ;
+         block shown := false 
+  ELIF type (ds) = file type
+    THEN f := sequential file (modify, ds) ;
+         edit (f, 1, 1, x size - 2, 16) ;
+         block shown := false 
+  ELIF ds pages (ds) = 1 CAND type (ds) = 0
+    THEN edit header ;
+         block shown := false 
+  END IF .
+
+change to 17 :
+  TEXT VAR t := "" ;
+  REPEAT
+    t CAT "­"
+  UNTIL NOT exists (t) END REPEAT ;
+  copy (ds, t) ;
+  reorganize (t) ;
+  forget (ds) ;
+  ds := nilspace ;
+  ds := old (t) ;
+  forget (t, quiet) .
+
+copy one space :
+  put ("ave in Datei : ") ;
+  getline (t) ;
+  copy (ds, t) .
+
+edit header :
+  bound header := ds ;
+  cursor (1, 23) ;
+  out (cl eol +"Header-Editor : ") ;
+  IF is start header (bound header)
+    THEN out ("Header ist ein Archiv-Startheader.")
+  ELIF is file header (bound header)
+    THEN out ("Header ist ein File-Header.")
+  ELIF is end header (bound header)
+    THEN out ("Header ist ein Archiv-Endheader.")
+    ELSE out ("Header ist unbekannt (Headertype = "+ text (type (bound header)) +").")
+  END IF ;
+  header edit (bound header, "Headernummer : "+ text (header nr) + " ") .
+
+new edit :
+  out (left +"new edit ") ;
+  block shown := false ;
+  IF yes ("Neuen Headerspace erstellen")
+    THEN create new header 
+    ELSE create new file
+  END IF .
+
+create new header :
+  forget (ds) ;
+  ds := nilspace ;
+  bound header := ds ;
+  bound header := nil header ;
+  cursor (1, 23) ;
+  out (cl eol +"Header-Editor : ") ;
+  put ("Neuen Header erstellen") ;
+  header edit (bound header, "Neuen Header erstellen") .
+ 
+create new file :
+  forget (ds) ;
+  ds := nilspace ;
+  f := sequential file (modify, ds) ;
+  edit (f, 1, 1, x size - 2, 16) .
+END PROCEDURE space menue ;
+
+
+(**********************   Configurator-Menu     ****************************)
+
+
+PROCEDURE configurator menue :
+    disable stop ;
+    REPEAT
+      display conf info ;
+      menue monitor (conf info line, conf chars, command index) ;
+      fehler loeschen ;
+      SELECT command index OF
+        CASE  1 : put ("hannel :") ; x get (archive channel) ;
+        CASE  2 : put (left +"disktype :") ; x get (disk type) ;
+        CASE  3 : disk info
+        CASE  4 : get and do one command 
+        CASE  5 : LEAVE configurator menue
+        CASE  6 : conf menue help 
+        CASE  7 : set ctrl g
+      END SELECT ;
+      fehler behandeln ;
+      display info line ;
+    UNTIL ctrl g END REPEAT .
+
+display conf info :
+  cursor (1, 19) ;
+  put (cl eol +"I/O Channel :") ; put (archive channel) ; put (",") ;
+  put ("Disktype :") ; put (disk type) ; put (",") ;
+  put ("Operatorchannel :") ; put (channel) ;
+  cursor (1, 18) ;
+  put ("Zeit :") ; put (time of day) ; put (", Datum :") ; put (date) ;
+  INT VAR x size, x used ;
+  storage (x size, x used) ;
+  put (",") ; put (x used) ; put ("K von") ; 
+  put (int (real (x size + 24) * 64.0 / 63.0)) ;
+  put ("K sind belegt !") .
+
+disk info :
+  INT VAR size, io, error ;
+  io control (archive channel, io, size, error) ;
+  out (home + 16 * (cl eol + down)) ;
+  out (home + down) ;
+  putline ("Diskinfo :") ;
+  putline (first mon line) ;
+  put ("Disksize :") ; put (size) ; put ("Blocks,") ;
+  put (size DIV 2) ; put ("kB.") ;
+  line ;
+  put ("Disktype :") ;
+  IF size = ibm 720 format 5
+    THEN putline ("5 1/4 Zoll, IBM-720 kB Format, 80 Tracks,") ;
+         putline ("           double sided/double density, softsectored") 
+  ELIF size = ibm 360 format 5
+    THEN putline ("5 1/4 Zoll, IBM-360 kB Format, 40 Tracks,") ;
+         putline ("           single sided/double density, softsectored") 
+  ELIF size = pic 400 format 5
+    THEN putline ("5 1/4 Zoll, PIC400 Format, 80 Tracks,") ;
+         putline ("           double sided/double density, softsectored") 
+  ELIF size = soft sd 8
+    THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,") ;
+         putline ("           single sided/double density, softsectored") 
+  ELIF size = soft dd 8
+    THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,") ;
+         putline ("           double sided/double density, softsectored") 
+  ELIF size = hard ss sd 
+    THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,") ;
+         putline ("           single sided/single density, hardsectored")
+  ELIF size = hard ds sd
+    THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,") ;
+         putline ("           double sided/single density, hardsectored")
+    ELSE putline ("Unbekannter Disktype") ; line
+  END IF ;
+  putline (first mon line) .
+END PROCEDURE configurator menue ;
+
+
+
+(**********************   Header/Space Ops.     ****************************)
+
+
+INT PROCEDURE header nr :
+  IF space nummer = 0
+    THEN 0
+    ELSE (space nummer + 1) DIV 2
+  END IF .
+END PROCEDURE header nr ;
+
+INT PROCEDURE space nr (INT CONST header nummer) :
+  IF header nummer = 0 COR header nummer = 1
+    THEN header nummer
+    ELSE header nummer * 2 - 1
+  END IF 
+END PROCEDURE space nr ;
+
+
+(**********************     Archiv-Menue        ****************************)
+
+
+PROCEDURE archive menue :
+    archive (archive name) ;
+    disable stop ;
+    REPEAT
+      menue monitor (archiv info line, archiv chars, command index) ;
+      fehler loeschen ;
+      SELECT command index OF
+        CASE 1 : archive anmelden
+        CASE 2 : out ("elease (archive)") ;
+                 release (archive) ; archivename := "" 
+        CASE 3 : out ("ist (archive)") ;
+                 list archive ;
+                 block shown := false 
+        CASE 4 : out ("etch (SOME archive, archive)") ;
+                 fetch (SOME archive, archive) ;
+                 block shown := false 
+        CASE 5 : out ("ave (SOME all, archive)") ;
+                 save (SOME all, archive) ;
+                 block shown := false 
+        CASE 6 : release (archive) ;
+                 LEAVE archive menue
+        CASE 7 : get and do one command ;
+                 block shown := false 
+        CASE 8 : archiv menue help ;
+                 block shown := false
+        CASE 9 : set ctrl g
+      END SELECT ;
+      fehler behandeln
+    UNTIL ctrl g END REPEAT .
+
+archive anmelden :
+  put ("rchivename : ") ;
+  getline (archivename) ;
+  archive (archivename) .
+
+list archive :
+  IF NOT (list file ok) COR no (""13"Alte Archiveliste zeigen")
+    THEN forget (af ds) ;
+         af ds := nilspace ;
+         af := sequential file (output, af ds) ;
+         list (af, archive) ;
+         list file ok := true 
+  END IF ;
+  edit (af, 1, 1, xsize - 2, 16) .
+END PROCEDURE archive menue ;
+
+
+(**********************     Urflop-Menue        ****************************)
+
+
+PROCEDURE urflop menue :
+    INT VAR s, e ;
+    disable stop ;
+    REPEAT
+      menue monitor (urflop info line, urflop chars, command index) ;
+      fehler loeschen ;
+      SELECT command index OF
+        CASE 1 : read
+        CASE 2 : x read
+        CASE 3 : write
+        CASE 4 : x write
+        CASE 5 : list task ;
+                 block shown := false 
+        CASE 6 : LEAVE urflop menue
+        CASE 7 : get and do one command ;
+                 block shown := false 
+        CASE 8 : urflop menue help ;
+                 block shown := false 
+        CASE 9 : set ctrl g
+      END SELECT ;
+      fehler behandeln
+    UNTIL ctrl g END REPEAT .
+
+list task :
+  forget (l ds) ;
+  l ds := nilspace ;
+  lf := sequential file (output, l ds) ;
+  list (lf) ;
+  edit (lf, 1, 1, xsize - 2, 16) .
+
+write :
+  out ("rite Datenraumname : ") ;
+  getline (t) ;
+  IF yes ("Urlader schreiben wie gelesen")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               -1)
+  ELIF yes ("Urlader für PIC 400 (Shard 6.xx) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block, 
+                               eumel 0 end block pic)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               eumel 0 end block)
+  ELIF yes ("Urlader für PIC 400 (ab Shard 7.13 für EUMEL Ver. 1758) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               eumel 0 end block 1758)
+  END IF .
+
+x write :
+  out ("rite Datenraumname : ") ;
+  getline (t) ;
+  cursor (command line x pos, command line y pos) ; 
+  out (">Write Datenraum """+ t +""" von Block : ") ;
+  x get (s) ;
+  cursor (command line x pos, command line y pos) ; 
+  out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis : ") ;
+  x get (e) ;
+  cursor (command line x pos, command line y pos) ; 
+  out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+       " Block "+ text (e)) ;
+  IF yes ("mit Versatz")
+    THEN cursor (command line x pos, command line y pos) ; 
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Versatz : ") ;
+         x get (ver) ;
+         cursor (command line x pos, command line y pos) ; 
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Ver. "+ text (ver) + " --> ") ;
+         urlader schreiben (t, s, e, ver)
+    ELSE cursor (command line x pos, command line y pos) ; 
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" --> ") ;
+         urlader schreiben (t, s, e)
+  END IF .
+
+read :
+  out ("ead Datenraumname : ") ;
+  getline (t) ;
+  IF yes ("Urlader für PIC 400 (Shard 6.xx) lesen")
+    THEN urlader lesen (t, eumel 0 start block, 
+                           eumel 0 end block pic)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) lesen")
+    THEN urlader lesen (t, eumel 0 start block,
+                           eumel 0 end block)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx für EUMEL Ver. 1758) lesen")
+    THEN urlader lesen (t, eumel 0 start block,
+                           eumel 0 end block 1758)
+  END IF .
+
+x read :
+  out ("ead Datenraumname : ") ;
+  getline (t) ;
+  cursor (command line x pos, command line y pos) ; 
+  out (">Read Datenraum """+ t +""" von Block : ") ;
+  x get (s) ;
+  cursor (command line x pos, command line y pos) ; 
+  out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis : ") ;
+  x get (e) ;
+  IF yes ("mit Versatz")
+    THEN cursor (command line x pos, command line y pos) ; 
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Versatz : ") ;
+         x get (ver) ;
+         cursor (command line x pos, command line y pos) ; 
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Ver. "+ text (ver) + " --> ") ;
+         urlader lesen (t, s, e, ver)
+    ELSE cursor (command line x pos, command line y pos) ; 
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" --> ") ;
+         urlader lesen (t, s, e)
+  END IF .
+END PROCEDURE urflop menue ;
+
+
+(**********************  Disk - Monitor Call    ****************************)
+
+
+PROCEDURE central disk monitor process :
+    archive ("disk") ;
+    release (archive) ;
+    space nummer := -1 ;
+    block nummer := -1 ;
+    header nummer := -1 ;
+    first sp block := -1 ;
+    st pos := 0 ;
+    archive name := "" ;
+    list file ok := false ;
+    block shown := false ;
+    reset ctrl g ;
+    page ;
+    line (3) ;
+    putline ("D I S K  -  M O N I T O R") ;
+    putline ("=========================") ;
+    line ;
+    putline ("Autor : Ingo Siekmann") ;
+    putline ("Stand : "+ software stand) ;
+    putline (software version) ;
+    putline ("Bem.  : "+ software bemerkung) ;
+    putline ("        "+ software bemerkung1) ;
+    line ;
+    putline ("(c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert") ;
+    line ;
+    initialize if necessary ;
+    global menue ;
+    line ;
+    unblock (archive) ;
+    IF archive name <> "" CAND NOT ctrl g
+      THEN archive (archive name)
+    END IF . 
+END PROCEDURE central disk monitor process ;
+
+
+(**********************     Unterprogramme      ****************************)
+
+
+THESAURUS OPERATOR SOME (THESAURUS CONST thesaurus) :
+    DATASPACE VAR edit space :: nilspace ;
+    THESAURUS VAR result := empty thesaurus ;
+    FILE VAR file := sequential file (output, edit space) ;
+    file FILLBY thesaurus ;
+    modify (file) ;
+    edit (file, 1, 1, xsize - 2, 16) ;
+    input (file) ;
+    result FILLBY file ;
+    forget (edit space) ;
+    result .
+END OPERATOR SOME ;
+
+THESAURUS OPERATOR SOME (TASK CONST dest task) :
+    SOME ALL dest task .
+END OPERATOR SOME ;
+
+PROCEDURE display info line :
+    INT VAR x, y ;
+    get cursor (x, y) ;
+    cursor (1, 24) ;
+    put (cl eol +"Block : ") ; put (block nummer) ;
+    put (", Space : ") ; put (space nummer) ;
+    put (", First Sp Block : ") ; put (first sp block) ;
+    put (", Header : ") ; put (header nummer) ;
+    cursor (x, y) .
+END PROCEDURE display info line ;
+
+PROCEDURE x get (INT VAR i) :
+    enable stop ;
+    get (dummy) ;
+    IF (dummy SUB length (dummy)) = hex marker
+      THEN i := hint (text (dummy, length (dummy) - 1))
+      ELSE i := int (dummy)
+    END IF ;
+    IF NOT last conversion ok
+      THEN error stop ("Zahl ist nicht korrekt")
+    END IF .
+END PROCEDURE x get ;
+ 
+
+(**********************     Urflop - Ops.       ****************************)
+
+
+PROCEDURE urlader lesen (TEXT CONST urname, INT CONST start, end) :
+    urlader lesen (urname, start, end, 0) .
+END PROCEDURE urlader lesen ;
+
+PROCEDURE urlader schreiben (TEXT CONST urname, INT CONST start, end) :
+    urlader schreiben (urname, start, end, 0) .
+END PROCEDURE urlader schreiben ;
+
+PROCEDURE urlader lesen auf seite (TEXT CONST urname, INT CONST start, end,
+                                   auf) :
+    urlader lesen (urname, start, end, auf - start) .
+END PROCEDURE urlader lesen auf seite ;
+
+PROCEDURE urlader schreiben von seite (TEXT CONST urname, INT CONST start,
+                                       end, von) :
+    urlader schreiben (urname, start, end, von - start) .
+END PROCEDURE urlader schreiben von seite ;
+
+PROCEDURE urlader lesen (TEXT CONST urname, INT CONST start, end, ver) : 
+    IF exists (urname) 
+      THEN error stop (""""+ urname +""" gibt es schon") 
+    END IF ; 
+    forget (uds) ; 
+    uds := nilspace ; 
+    reset block io ;
+    reset ctrl g ;
+    FOR block nr FROM start UPTO end REPEAT 
+      continue (archive channel) ; 
+      disable stop ; 
+      block in (uds, block nr + ver, disk type, block nr, error) ; 
+      continue (user channel) ; 
+      enable stop ; 
+      check archive error (error, true) ; 
+      cout (block nr) ;
+      dummy := incharety ;
+      IF dummy = ""7""
+        THEN set ctrl g
+      END IF 
+    UNTIL dummy = esc COR ctrl g END REPEAT ; 
+    IF NOT ctrl g
+      THEN copy (uds, urname) ; 
+    END IF ;
+    forget (uds) . 
+END PROCEDURE urlader lesen ; 
+ 
+PROCEDURE urlader schreiben (TEXT CONST urname, INT CONST start, end, ver) :
+    forget (uds) ; 
+    uds := old (urname) ; 
+    reset ctrl g ;
+    reset block io ;
+    block nr := start;
+    IF block nr = -1
+      THEN block nr := next ds page (uds, block nr) 
+    END IF ;
+    WHILE block nr <> -1 REPEAT 
+      continue (archive channel) ; 
+      disable stop ; 
+      block out (uds, block nr + ver, disk type, block nr, error) ; 
+      break (quiet);
+      continue (user channel) ; 
+      enable stop ; 
+      check archive error (error, false) ; 
+      cout (block nr) ;
+      dummy := incharety ;
+      IF dummy = ""7""
+        THEN set ctrl g
+      END IF ;
+      IF end = -1 COR start = -1
+        THEN block nr := next ds page (uds, block nr)
+      ELIF block nr = end
+        THEN block nr := -1
+        ELSE block nr INCR 1
+      END IF 
+    UNTIL dummy = esc COR ctrl g END REPEAT ; 
+    forget (uds) . 
+END PROCEDURE urlader schreiben ; 
+ 
+
+(**********************     Unterprogramme      ****************************)
+
+
+PROCEDURE reset block io : 
+    user channel := channel ;
+    INT VAR i, s, e ;
+    io control (archive channel, i, s, e) ;
+    check archive error (e, true) .
+END PROCEDURE reset block io ;
+
+PROCEDURE get and do one command :
+    initialize if necessary ;
+    cursor (1, 21) ;
+    out (cl eop) ;
+    get command ("gib ein EUMEL-Kommando : ", own command line) ;
+    do (own command line) .
+END PROCEDURE get and do one command  ;
+
+PROCEDURE io control (INT VAR io, size, error) :
+    ROW 256 INT VAR block ;
+    control (type mode, 0, 0, io) ;
+    control (size mode, 0, 0, size) ;
+    block in (block, std disk type, block 0, error) .
+END PROCEDURE io control ;
+
+PROCEDURE io control (INT CONST io channel, INT VAR io, size, error) :
+    INT VAR op channel :: channel ;
+    continue (io channel) ;
+    io control (io, size, error) ;
+    break (quiet) ;
+    continue (op channel) .
+END PROCEDURE io control ;
+
+
+(**********************    Menue - Help Ops     ****************************)
+
+
+PROCEDURE global menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Global-Menue : ") ;
+    line ;
+    putline ("b --> Aufruf des Block-Menüs (direkter Block i/o)") ;
+    putline ("s --> Aufruf des Space-Menüs (direkter Space- und Header i/o)") ;
+    putline ("a --> Aufruf des Archiv-Menüs (normale Archivoperationen)") ;
+    putline ("u --> Aufruf des Urflop-Menüs (Urlader/Datenraum <-> Floppy)") ;
+    putline ("c --> Aufruf des Konfigurator-Menüs") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)") ;
+END PROCEDURE global menue help ;
+
+PROCEDURE block menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Block-Menü : ") ;
+    line ;
+    putline ("r --> Lesen eines Blockes (block in)") ;
+    putline ("n --> Lesen des nächsten Blockes") ;
+    putline ("w --> Schreiben eines Blockes (block out)") ;
+    line ;
+    putline ("s --> Suchen nach einem Text") ;
+    line ;
+    putline ("e --> Aufruf des Blockeditor-Menüs") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Block-Menüs (Rückkehr ins Global-Menü)") ;
+END PROCEDURE block menue help ;
+
+PROCEDURE block editor menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Blockeditor-Menü : ") ;
+    line ;
+    putline ("f --> Zeigen der ersten 256 Bytes des aktuellen Blockes") ;
+    putline ("s --> Zeigen der zweiten 256 Bytes des aktuellen Blockes") ;
+    line ;
+    putline ("e --> Editieren des aktullen Teilblockes") ;
+    putline ("d --> Editieren des ersten und zweiten Teilblockes") ;
+    line ;
+    putline ("p --> Position setzen, auf der der Editor beginnen soll.") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Blockeditor-Menüs (Rückkehr ins Block-Menü)") ;
+END PROCEDURE block editor menue help ;
+
+PROCEDURE space menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Space-Menü : ") ;
+    line ;
+    putline ("r --> Lesen eines Datenraums bzw. eines Headers") ;
+    putline ("R --> Lesen eines Datenraums ab Block x") ;
+    putline ("w --> Schreiben eines Datenraums bzw. eines Headers") ;
+    putline ("W --> Schreiben eines Datenraums ab Block x") ;
+    line ;
+    putline ("e --> Editieren des aktullen Datenraums (Datei o. Header)") ;
+    putline ("E --> Editieren einer neuen Datei oder eines Header") ;
+    line ;
+    putline ("s --> Kopieren des aktuellen Datenraums in eine benannten Datenraum") ;
+    putline ("l --> Kopieren eines benannten Datenraums in den aktuellen Datenraum") ; 
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    putline ("q --> Verlassen des Space-Menüs (Rückkehr ins Global-Menü)") ; 
+END PROCEDURE space menue help ;
+
+PROCEDURE archiv menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Archiv-Menü : ") ;
+    line ;
+    putline ("a --> Archiv anmelden") ;
+    putline ("r --> Archiv abmelden") ;
+    line ;
+    putline ("f --> Einige Dateien vom Archiv in die Task laden") ;
+    putline ("s --> Einige Dateien der Task auf das Archiv schreiben") ;
+    putline ("l --> Dateiliste des Archives zeigen") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)") ; 
+END PROCEDURE archiv menue help ;
+
+PROCEDURE urflop menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Urflop-Menü : ") ; 
+    line ;
+    putline ("r --> Lesen der Blöcke 10 bis 62 in einen benannten Datenraum") ;
+    putline ("R --> Lesen der Blöcke x bis y in einen benannten Datenraum") ;
+    line ;
+    putline ("w --> Schreiben der Blöcke 10 bis 62 aus einem benannten Datenraum") ;
+    putline ("W --> Schreiben der Blöcke x bis y aus einem benannten Datenraum") ;
+    line ;
+    putline ("l --> Dateiliste der Task zeigen (list)") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Urflop-Menüs (Rückkehr ins Global-Menü)") ; 
+END PROCEDURE urflop menue help ;
+
+PROCEDURE conf menue help :
+    out (home + cl eop) ;
+    line ;
+    putline ("Help für das Configurator-Menü :") ;
+    line ;
+    putline ("c --> Einstellen des Kanals, auf dem der Block i/o abläuft") ;
+    putline ("t --> Einstellen des Diskettentypes (EUMEL, CPM etc)") ;
+    line ;
+    putline ("i --> Disketteninfo") ;
+    line ;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)") ;
+    line ;
+    putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)") ; 
+END PROCEDURE conf menue help ;
+
+BOOL PROCEDURE is halt from terminal :
+    is error CAND error code = 1
+END PROCEDURE is halt from terminal ;
+ 
+PROCEDURE block in (TEXT VAR block, INT CONST block nr, disk type, 
+                    INT VAR error) : 
+    initialize if necessary ;
+    block in (blkinds, heap page nr, disk type, block nr, error) ; 
+    block := subtext (bound text, start pos, LENGTH bound text) ; 
+END PROCEDURE block in ; 
+
+PROCEDURE initialize if necessary :
+    IF NOT initialized (this packet)
+      THEN forget (blkinds) ;
+           blkinds := nilspace ; 
+           bound text := blkinds ; 
+           bound text := (start pos + 511) * " " ;
+           own command line := "" ;
+           archive channel := std archive channel ;
+           disk type := std disk type 
+    END IF .
+END PROCEDURE initialize if necessary ;
+
+BOOL PROCEDURE yes (TEXT CONST msg) :
+    get cursor (cx, cy) ;
+    cursor (command line x pos + 1, command line y pos + 1) ;
+    result := NOT no (msg) ;
+    cursor (cx, cy) ;
+    result .
+END PROCEDURE yes ;
+(* 
+INT OPERATOR $ (TEXT CONST hex) :
+    INT VAR laenge := length (hex), stelle, ziffer, ergebnis := 0 ;
+    FOR stelle FROM laenge DOWNTO 1 REPEAT
+      ziffer := pos ("0123456789ABCDEF", hex SUB stelle) - 1 ;
+      IF ziffer < 0
+        THEN error stop ("Ist keine Hexzahl")
+      END IF ;
+      ergebnis INCR ziffer * 16 ** (laenge - stelle)
+    END REPEAT ;
+    ergebnis .
+END OPERATOR $ ;
+*)
+PROCEDURE search (TEXT CONST st, INT CONST start block, end block, 
+                  INT VAR fbnr, fpos) : 
+    enable stop ;
+    INT CONST l := LENGTH st - 1 ;
+    reset ctrl g ;
+    reset block io ;
+    FOR fbnr FROM start block UPTO end block REPEAT
+      cout (fbnr) ;
+      continue (archive channel) ;
+      block in (stb1, fbnr, disk type, error) ;
+      IF error = 0
+        THEN block in (stb2, fbnr + 1, disk type, error) 
+      END IF ;
+      break (quiet) ; 
+      continue (user channel) ; 
+      check archive error (error, true) ; 
+      stb1 CAT text (stb2, l) ; 
+    UNTIL pos (stb1, st) > 0 COR incharety = ""27"" END REPEAT ; 
+    fpos := pos (stb1, st) 
+END PROCEDURE search ; 
+
+END PACKET byte operations and disk monitor version 35 multi ;
+
diff --git a/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle b/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle
new file mode 100644
index 0000000..68de7f5
--- /dev/null
+++ b/app/diskettenmonitor/3.5/src/disk cmd 3.5.quelle
@@ -0,0 +1,36 @@
+ 
+PACKET disk cmd 
+ 
+(************************************************************************) 
+(*                                                                      *) 
+(*  Disk - Menuecall    Version 3.5                                   *) 
+(*                                                                      *) 
+(*                                                                      *) 
+(* Autor : Ingo Siekmann                                                *) 
+(* Stand : Sonntag, den 16.11.1986                                      *) 
+(*                                                                      *) 
+(* Lauffähig ab EUMEL Version 1.7.3 /M und insertiertem                 *) 
+(* Diskmonitor ab Version 3.4                                           *) 
+(*                                                                      *) 
+(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert                     *) 
+(*                                                                      *) 
+(************************************************************************) 
+ 
+      DEFINES disk , 
+              disk monitor : 
+ 
+ 
+
+lernsequenz auf taste legen ("d", "disk"13"") ; 
+ 
+ 
+PROCEDURE disk : 
+    central disk monitor process . 
+END PROCEDURE disk ; 
+ 
+PROCEDURE disk monitor : 
+    central disk monitor process . 
+END PROCEDURE disk monitor ; 
+ 
+END PACKET disk cmd ; 
+
diff --git a/app/diskettenmonitor/3.5/src/m.rename archive^2.c b/app/diskettenmonitor/3.5/src/m.rename archive^2.c
new file mode 100644
index 0000000..445fba5
--- /dev/null
+++ b/app/diskettenmonitor/3.5/src/m.rename archive^2.c
@@ -0,0 +1,3 @@
+PACKETrenamearchivecmdDEFINESrenamearchive:DATASPACE VARds:=nilspace;forget(ds);LET HEADER = STRUCT(TEXTname,date,INTtype,TEXTpass);BOUND HEADER VARheader;INT VARopc;PROCrenamearchive(TEXT CONSTnewname):archive(newname);release(archive);opc:=channel;forget(ds);ds:=nilspace;continue(31);disablestop;rewind;read(ds);break(quiet);enablestop;continue(opc);header:=ds;IFyes("archiv """+header.name+""" in """+newname+""" umbenennen")THENheader.name:=newname;continue(31);disablestop;rewind;write(ds);brea
+k(quiet);enablestop;continue(opc);archive(newname)FI;forget(ds).ENDPROCrenamearchive;ENDPACKETrenamearchivecmd;
+
diff --git a/app/diskettenmonitor/3.5/src/read heap b/app/diskettenmonitor/3.5/src/read heap
new file mode 100644
index 0000000..533e78c
--- /dev/null
+++ b/app/diskettenmonitor/3.5/src/read heap
@@ -0,0 +1,107 @@
+DATASPACE VARd:=nilspace; forget(d); 
+BOUND TEXT VAR t; 
+INT CONST c := channel; 
+LET a = 31; 
+INT VAR block, anfang, ende, weiter; 
+disablestop; 
+exec; 
+forget(d); 
+break (quiet); 
+continue (c); 
+ 
+PROC blockin : 
+  block INCR 1; 
+  INT VAR error; 
+  replace (t, anfang, subtext (t, weiter)); 
+  blockin (d, 3, 0, block, error); 
+  IF error <> 0 THEN 
+    errorstop ("Fehlercode "+text (error)+" auf Block "+text(block)) 
+  FI; 
+END PROC blockin; 
+ 
+PROC exec : 
+enable stop; 
+TEXT VAR zeile := "datei"; 
+editget (zeile); 
+IF exists (zeile) THEN forget (zeile) FI; 
+FILE VAR f := sequential file (output, new (zeile)); 
+forget (d); d := nilspace; 
+t := d; 
+t := ""; 
+REP 
+  t CAT ""255""; 
+  anfang := LENGTH t; 
+UNTIL dspages (d) = 2 PER; 
+REP 
+  ende := LENGTH t; 
+  t CAT ""255""; 
+UNTIL dspages (d) > 2 PER; 
+weiter := LENGTH t; 
+t := subtext (t, 1, ende); 
+t CAT subtext (t, anfang); 
+put (anfang); put (ende); put (weiter); put (LENGTH t); 
+put (weiter - anfang); put (LENGTH t - ende); line; 
+continue (a); 
+control (5, 0, 0, block); 
+block := -1; 
+blockin; 
+block := 406; 
+blockin; (* 407 lesen (ans ende) *) 
+replace (t, LENGTH t DIV 2, 12352); 
+INT VAR p := LENGTH t - 1, o; 
+(* 
+INT VAR p := pos (t, ""255"", weiter), o; 
+IF p <> 0 THEN p := pos (t, ""0"", ""254"", p); 
+FI; 
+*) 
+zeile := ""; 
+REP 
+  naechsten block verarbeiten; 
+  blockin; 
+  p DECR weiter; 
+  p INCR anfang; 
+UNTIL block > 1170 PER; 
+errorstop ("kein ende gefunden") . 
+ 
+naechsten block verarbeiten : 
+  REP 
+    IF p < anfang COR p MOD 2 = 0 THEN 
+      errorstop ("Fehler bei "+text(block)+", "+text (p - anfang)); 
+    FI; 
+    IF p > ende THEN LEAVE naechsten block verarbeiten FI; 
+    continue (c); 
+    put (block - 1); 
+    put (p -anfang); 
+    INT VAR l := t ISUB p DIV 2 + 1; 
+    put (l); 
+    IF l <= 0 THEN (* continue (c); 
+      put (block); put (p - anfang); put (l); *) LEAVE exec 
+    FI; 
+    put (""); 
+    continue (a); 
+    p INCR 2; 
+    IF p + l - 1 > LENGTH t THEN 
+      l INCR LENGTH zeile; 
+      zeile CAT subtext (t, p); 
+      l DECR LENGTH zeile; 
+      replace (t, LENGTH t DIV 2, l); 
+      p := LENGTH t - 1; 
+    ELSE 
+      o := LENGTH zeile; 
+      zeile CAT subtext (t, p, p + l - 1); 
+      p INCR l; 
+      l INCR o; 
+      IF LENGTH zeile <> l THEN 
+        errorstop ("Laengenfehler bei "+text(block)+", "+text (p - anfang) 
+                  +", "+text(LENGTH zeile)); 
+      FI; 
+      WHILE (zeile SUB l) = ""255"" REP l DECR 1 PER; 
+      zeile := subtext (zeile, 1, l); 
+      putline (f, zeile); 
+      zeile := ""; 
+    FI; 
+  PER . 
+ 
+END PROC exec; 
+
+
diff --git a/app/diskettenmonitor/3.7/source-disk b/app/diskettenmonitor/3.7/source-disk
new file mode 100644
index 0000000..d79c6a7
--- /dev/null
+++ b/app/diskettenmonitor/3.7/source-disk
@@ -0,0 +1 @@
+debug/diskettenmonitor-3.7_1990-04-28.img
diff --git a/app/diskettenmonitor/3.7/src/PAC digit conversion b/app/diskettenmonitor/3.7/src/PAC digit conversion
new file mode 100644
index 0000000..034eccf
--- /dev/null
+++ b/app/diskettenmonitor/3.7/src/PAC digit conversion
@@ -0,0 +1,93 @@
+PACKET digit conversion DEFINES bin,
+                                dec,
+                                hex :
+
+{ Rechnet Dezimalzahlen in Hexadezimalzahlen um und umgekehrt,
+  sowie Dezimalzahlen in Binärzahlen.
+
+  Autor              Version  Datum
+  Christian Lehmann  2        07.09.90                                     }
+
+LET hex letters = "123456789abcdef";
+
+TEXT CONST empty binary digit := 16 * "0",
+           empty hex digit    := "0000";
+
+ROW  4 INT CONST sedecimal powers := ROW  4 INT : (1, 16, 256, 4096);
+ROW 16 INT CONST binary powers    := ROW 16 INT :
+   (  1,   2,    4,    8,   16,   32,    64,    128,
+    256, 512, 1024, 2048, 4096, 8192, 16384, -32767-1);
+
+INT PROC dec (TEXT CONST hex text):
+  INT VAR stellen := LENGTH hex text;
+  IF stellen > 4 COR hex text > "7fff"
+     THEN errorstop ("Zahl zu groß")
+  FI;
+  INT VAR dec result := 0, stelle, hex digit;
+  TEXT VAR hex letter;
+  FOR stelle FROM 1 UPTO stellen REP
+    hex letter := hex text SUB (stellen - stelle + 1);
+    hex digit := pos (hex letters, hex letter);
+    IF hex digit <> 0
+       THEN dec result INCR hex digit * sedecimal powers [stelle]
+    ELIF hex letter <> "0"
+       THEN errorstop ("Hexadezimalzahl fehlerhaft")
+    FI
+  PER;
+  dec result
+END PROC dec;
+{ kann nicht durch `replace' zu Beginn verkleinert werden }
+
+TEXT PROC hex (INT CONST decimal int) :
+  INT VAR nibble no, nibble bit no, bit no := 16, hex digit;
+  TEXT VAR hex result := empty hex digit;
+  FOR nibble no FROM 4 DOWNTO 1 REP
+    hex digit := 0;
+    FOR nibble bit no FROM 4 DOWNTO 1 REP
+      IF (decimal int AND binary powers [bit no]) = binary powers [bit no]
+         THEN hex digit INCR binary powers [nibble bit no]
+      FI;
+      bit no DECR 1
+    PER;
+    IF hex digit <> 0
+       THEN replace (hex result, 5 - nibble no, (hex letters SUB hex digit))
+    FI
+  PER;
+  hex result
+END PROC hex;
+
+TEXT PROC bin (INT CONST dez) :
+  TEXT VAR bin result := empty binary digit;
+  INT VAR bit no;
+  FOR bit no FROM 16 DOWNTO 1 REP
+    IF (dez AND binary powers [bit no]) = binary powers [bit no]
+       THEN replace (bin result, 17 - bit no, "1")
+    FI
+  PER;
+  bin result
+END PROC bin;
+
+END PACKET digit conversion;
+
+(* Test *)
+(*
+
+INT VAR x, y;
+TEXT VAR z;
+page;
+putline ("Dezimalzahl oder Hexadezimalzahl (mit Kleinbuchstaben und `h' am Schluß)");
+putline ("Abbruch durch `0'");
+REP
+  line;
+  get cursor (x, y);
+  put ("Zahl:");
+  get (z);
+  cursor (x + 14, y);
+  put (":");
+  IF (z SUB LENGTH z) = "h"
+     THEN put (dec (subtext (z, 1, LENGTH z - 1)))
+     ELSE put (hex (z))
+  FI
+UNTIL z = "0" PER
+*)
+
diff --git a/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle b/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle
new file mode 100644
index 0000000..6a02811
--- /dev/null
+++ b/app/diskettenmonitor/3.7/src/basic menu handling 3.6.quelle
@@ -0,0 +1,53 @@
+
+PACKET basic menu handling
+
+(************************************************************************)
+(*                                                                      *)
+(*  Basic Menu Handling Version 1.0                                   *)
+(*                                                                      *)
+(*                                                                      *)
+(* Autor : Ingo Siekmann                                                *)
+(* Stand : Donnerstag, den 12. Juni 1986                                *)
+(*                                                                      *)
+(* Lauffähig ab EUMEL Version 1.7.3                                     *)
+(*                                                                      *)
+(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert                     *)
+(*                                                                      *)
+(************************************************************************)
+
+       DEFINES menue monitor :
+
+
+
+LET info line x pos    =    1 ,
+    info line y pos    =   20 ,
+    command line x pos =    1 ,
+    command line y pos =   21 ;
+
+LET first mon line    = "----------------------------------------------------------------------------" ,
+    command line      = ">__________________________________________________________________________<" ;
+
+
+TEXT VAR char ;
+
+PROCEDURE menue monitor (TEXT CONST info line, chars,  (* I. Siekmann *)
+                         INT VAR command index) :      (* 12.06.1986  *)
+    enable stop ;
+    cursor (1, 17) ;
+    command index := 0 ;
+    out (first mon line) ;
+    cursor (info line x pos, info line y pos) ;
+    out (info line) ;
+    cursor (command line x pos, command line y pos) ;
+    out (command line) ;
+    cursor (command line x pos + 1, command line y pos) ;
+    REPEAT
+  (*  inchar (char) ;  *)
+      get char (char) ;
+      command index := pos (chars, char)
+    UNTIL command index > 0 COR is error END REPEAT ;
+    out (char) .
+END PROCEDURE menue monitor ;
+
+ENDPACKET basic menu handling ;
+
diff --git a/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle b/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle
new file mode 100644
index 0000000..b4471a6
--- /dev/null
+++ b/app/diskettenmonitor/3.7/src/disk 3.7-m.quelle
@@ -0,0 +1,2218 @@
+(************************************************************************)
+(*                                                                      *)
+(*  DDDD   IIIII   SSSS  K  K      3333       666       /  M     M      *)
+(*  D   D    I    S      K K           3     6         /   MM   MM      *)
+(*  D   D    I     SSS   KK         333      6666     /    M M M M      *)
+(*  D   D    I        S  K K           3     6   6   /     M  M  M      *)
+(*  DDDD   IIIII  SSSS   K  K      3333   O   666   /      M     M      *)
+(*                                                                      *)
+(************************************************************************)
+(*                                                                      *)
+(* Diskettenmonitor   Version 3.6 Multi                                 *)
+(*                                                                      *)
+(* Autor : Ingo Siekmann unter freundlicher Mithilfe von Stefan Haase,  *)
+(*                                Nils Ehnert, APu und Frank Lenniger   *)
+(*                                                                      *)
+(* Stand : Montag, den 09. Februar 1987                                 *)
+(*                                                                      *)
+(* Lauffähig ab EUMEL Version 1.8.1 /M in Systemtasks                   *)
+(*                                                                      *)
+(*                                                                      *)
+(* (c) 1987 by ULES c/o Ingo Siekmann & Nils Ehnert                     *)
+(*                                                                      *)
+(************************************************************************)
+(*                                                                      *)
+(* Softwareaenderungen und Softwareneuerungen :                         *)
+(*                                                                      *)
+(* 03.01.1986 3.3.2.8 : Block- Asciieditor ueberarbeitet, neuer Header- *)
+(*                      editor (V1.3), Helpfunktion, gib kommando,      *)
+(*                      Fileaccess auch fuer 16-Files                   *)
+(* 15.01.1986 3.3.2.9 : Vorbereitung fuer den Suchmodus in 3.3.3.0,     *)
+(*                      Notbremse ins globalmenue mit ctrl g, byte ops  *)
+(*                      ueberarbeitet, pic dienste in vorbereitung      *)
+(*                      Headereditor (V1.4)                             *)
+(* 16.01.1986         : halt from terminal --> ctrl g := true           *)
+(* 16.01.1886 3.3.3.0 : Suchmodus ins Blockmenue (TEST), Blockeditor    *)
+(*                      Byteposops fuer Suchmodus einbauen              *)
+(* 21.01.1986         : inchar in get char umgewandelt                  *)
+(* 28.01.1986         : lernmodus eingebaut (???)                       *)
+(* 31.01.1986 3.3.3.1 : Suchmodus und Lernmodus wieder ausgebaut        *)
+(*                      beim Datenraumschreiben nur belegte Bloecke raus*)
+(* 14.02.1986 3.3.3.2 : Fehler Überarbeitet                             *)
+(* 20.02.1986         : Suchmodus vorbereitet (2. Versuch ?)            *)
+(* 06.03.1986 3.3.3.3 : Suchmodus eingebaut (Test)                      *)
+(* 10.03.1986         : Softwaretrennung zwischen Single und Multi      *)
+(* 12.03.1986         : read next block cmd ins blockmenu eingebaut     *)
+(*                      Fehler überarbeitet, Vorbereitung für besseren  *)
+(*                      Suchmodus                                       *)
+(* 17.03.1986 3.3.3.4 : configurator menü -> einstellen von disk type,  *)
+(*                      i/o channel, disk info. TEXT/HEX search.       *)
+(* 02.04.1986         : urflop ops mit versatzops                       *)
+(* 08.04.1986         : urflop menue mit versatz                        *)
+(* 30.04.1986 3.3.3.5 : Fehler ueberarbeitet                            *)
+(* 30.04.1986 3.3.3.6 : lab read/write ins space menue                  *)
+(* 05.05.1986 3.3.3.7 : hex / dez - get für alles, block editor über-   *)
+(*                      arbeitet, fehler überarbeitet. auslieferung für *)
+(*                      HRZ !                                           *)
+(* 06.06.1986 3.4     : Fehler im search und menue monitor behoben      *)
+(* 12.06.1986         : Fehler im Space/Header-Menue behoben            *)
+(* 16.11.1986 3.5     : Fehler im Urflopmenue behoben                   *)
+(* 09.02.1987 3.6     : Doktormenu eingebaut                            *)
+(* 28.04.90   3.7     : Optimierungen CL                                *)
+(*                                                                      *)
+(*       A C H T U N G  : Keine weitere Entwicklung von Version 3 !!    *)
+(*                                                                      *)
+(*            Bielefeld, den 08.02.1987        ULES                     *)
+(*                                                                      *)
+(*                      Ingo Siekmann                                   *)
+(*                                                                      *)
+(* Version disk 3.6/s teilt nur mit, daß es sie nicht gibt !            *)
+(************************************************************************)
+
+PACKET byte operations and disk monitor version 36 multi
+
+       DEFINES  WORD,          { BYTE in WORD umbenannt cl 8.2.89 }
+                CATHEX,        { HEX  in CATHEX                         }
+                CATASCII,      { ASCII in CATASCII  umbenannt cl 28.04.90 }
+                DECRL,
+                DECRH,
+                INCRL,
+                INCRH,
+                :=,
+                -,
+                +,
+                $,
+                hint,
+                zu byte,
+                lower byte,
+                higher byte,
+                set lower byte,
+                set higher byte,
+                nil byte,
+                put,
+                get,
+
+                block in,
+                block out,
+
+                HEADER,
+                header,
+                nil header,
+                is start header,
+                is end header,
+                is file header,
+                name,
+                date,
+                type,
+                pass,
+                header edit,
+
+                show first,
+                show second,
+                block edit,
+                ascii edit,
+
+                set ctrl g,
+                reset ctrl g,
+
+                set channel,
+                read block,
+                write block,
+                seek space,
+                seek block,
+                read space,
+                write space,
+                check archive error,
+
+                space nr,
+                header nr,
+
+                urlader lesen,
+                urlader schreiben,
+                urlader lesen auf seite,
+                urlader schreiben von seite,
+
+                heap lesen,
+                search,
+                io control,
+
+                central disk monitor process :
+
+
+LET start of volume = 1000,
+    end of volume   =    1,
+    file header     =    3;
+
+LET global info line  = "** GLOBAL : b / s / a / c / u / d / q     # stop --> ctrl g, help --> ""?"" **",
+    block info line   = "** BLOCK  : r / w / e / k / s / n / q     # stop --> ctrl g, help --> ""?"" **",
+    search info line  = "** SEARCH : a -> ascii / h -> hex / q -> quit / ctrl g -> stop            **",
+    editor info line  = "** EDITOR : f / s / d / e / k / p / q     # stop --> ctrl g, help --> ""?"" **",
+    space info line   = "** SPACE  : r, R, w, W, e, E, s, l, k, q  # stop --> ctrl g, help --> ""?"" **",
+    space header info = "** SPACE / HEADER : s -> read space / h -> read header / q -> quit        **",
+    archiv info line  = "** ARCHIV : a / r / l / f / s / k / q     # stop --> ctrl g, help --> ""?"" **",
+    urflop info line  = "** URFLOP : r / R / w / W / l / k / q     # stop --> ctrl g, help --> ""?"" **",
+    conf info line    = "** CONFIGURATOR : c / t / i / k / q       # stop --> ctrl g, help --> ""?"" **",
+    doctor info line  = "** DOCTOR : a / e / r / h / k / q         # stop --> ctrl g, help --> ""?"" **",
+    first mon line    = "̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊̊";
+
+LET global chars = "bsacuqk?d"7"",
+    block chars  = "rweqksn?"7"",
+    search chars = "ahdq"7"",
+    editor chars = "fsdeqk?"7"p",
+    space chars  = "rRwWesqEkl?"7"",
+    archiv chars = "arlfsqk?"7"",
+    urflop chars = "rRwWlqk?"7"",
+    conf chars   = "ctikq?"7"",
+    doctor chars = "aerhkq?"7"";
+
+LET info line x pos    =    1,
+    info line y pos    =   20,
+    command line x pos =    1,
+    command line y pos =   21,
+    error line x pos   =    1,
+    error line y pos   =   22,
+
+    file type          = 1003,
+    file type 16       = 1002,
+
+    block 0            =    0,
+
+    std archive channel =  31,
+
+    type mode          =    1,
+    size mode          =    5,
+    std disk type      =    0;
+
+LET software stand      = "Montag, den 09.02.1987",
+    software version    = "Version  3.6 /Multi",
+    software bemerkung  = "Doktormenue eingebaut,",
+    software bemerkung1 = "*** Ende der Entwicklung der Version 3 ! ***";
+
+LET eumel 0 start block        = 10,
+    eumel 0 end block          = 65,
+    eumel 0 end block pic      = 62,
+    eumel 0 end block 1758     = 67,
+
+(*  pic char table start block = 63,
+    pic char table end block   = 65,
+    pic shard start block      =  0,
+    pic shard end block        = 79,  *)
+
+    read write impossible error = 101,
+    read error                  = 102,
+    write error                 = 103,
+    block number error          = 104,
+    undef archive error         = 105;
+
+LET ibm 720 format 5            = 1440,
+    ibm 360 format 5            =  720,
+    pic 400 format 5            = 1600,
+    soft sd 8                   = 1232,
+    soft dd 8                   = 2464,
+    hard ss sd                  =  616,
+    hard ds sd                  = 1232;
+
+LET home                = ""1"",
+    left                = ""8"",
+    right               = ""2"",
+    up                  = ""3"",
+    down                = ""10"",
+    return              = ""13"",
+    tab                 = ""9"",
+    esc                 = ""27"",
+    cl eol              = ""5"",
+    cl eop              = ""4"";
+
+LET hex chars  = "0123456789ABCDEF",
+    hex marker = "h";
+
+LET start pos      = 479,
+    heap page nr   =   2;
+
+TYPE HEADER = STRUCT (TEXT name, date, INT type, TEXT pass);
+TYPE WORD = STRUCT (INT lower byte, higher byte);
+
+HEADER CONST nil header := HEADER : ("", "", 0, "");
+BOUND HEADER VAR bound header;
+BOUND TEXT VAR bound text;
+
+INITFLAG VAR this packet := false;
+
+ROW 256 WORD VAR block;
+ROW 32 TEXT VAR text block;
+ROW 256 INT VAR block int;
+
+DATASPACE VAR ds :: nilspace; forget (ds);
+DATASPACE VAR afds :: nilspace; forget (afds);
+DATASPACE VAR lds :: nilspace; forget (lds);
+DATASPACE VAR uds :: nilspace; forget (uds);
+DATASPACE VAR blkinds :: nilspace; forget (blkinds);
+
+FILE VAR af, f, lf;
+
+INT VAR command index, block nummer, space nummer, x, y, i, i1, xx, yy,
+        archive channel := std archive channel, user channel, error answer,
+        header nummer, first sp block, integer, error, block nr,
+        stpos, s, e, fb, fp, cx, cy, disk type := std disk type, ver, last file;
+
+TEXT VAR tc, t, archive name, dummy,
+         stb1, stb2, own command line;
+
+REAL VAR po;
+
+BOOL VAR first := true, ende, list file ok, block shown, ctrl g, result;
+
+
+(********************** PACKET bytes ok :       ****************************)
+
+WORD PROC nil byte :
+  WORD : (0,0)
+END PROC nil byte;
+
+OP := (WORD VAR byte, WORD CONST old byte) :
+  byte.lower byte  := old byte.lower byte;
+  byte.higher byte := old byte.higher byte.
+END OP :=;
+
+OP := (WORD VAR byte, INT CONST int byte) :
+  byte.lower byte  := int byte MOD 256;
+  byte.higher byte := (int byte AND -256) DIV 256 AND 255.
+END OP :=;
+
+OP := (ROW 256 WORD VAR byte, ROW 256 INT CONST int byte) :
+  INT VAR i;
+  FOR i FROM 1 UPTO 256 REP
+    byte [i] := int byte [i]
+  PER.
+END OP :=;
+
+OP := (ROW 256 INT VAR int byte, ROW 256 WORD CONST byte) :
+  INT VAR i;
+  FOR i FROM 1 UPTO 256 REP
+    int byte [i] := byte [i]
+  PER.
+END OP :=;
+
+WORD OP + (WORD VAR byte, INT CONST int byte) :
+  byte.lower byte := byte.lower byte + lower byte (int byte);
+  byte.higher byte := byte.higher byte + higher byte (int byte);
+  byte.
+END OP +;
+
+WORD OP - (WORD VAR byte, INT CONST int byte) :
+  byte.lower byte := byte.lower byte - lower byte (int byte);
+  byte.higher byte := byte.higher byte - higher byte (int byte);
+  byte.
+END OP -;
+
+OP := (INT VAR int byte, WORD CONST byte) :
+  IF byte.higher byte > 127
+    THEN int byte := minus * 255 + minus + byte.lower byte
+    ELSE int byte := byte.higher byte * 256 + byte.lower byte
+  FI
+
+.minus : byte.higher byte - 256.
+END OP :=;
+
+OP INCRL (WORD VAR byte, INT CONST lower) :
+  byte.lower byte INCR lower
+END OP INCRL;
+
+OP INCRH (WORD VAR byte, INT CONST high) :
+  byte.higher byte INCR high
+END OP INCRH;
+
+OP DECRL (WORD VAR byte, INT CONST lower) :
+  byte.higher byte DECR lower
+END OP DECRL;
+
+OP DECRH (WORD VAR byte, INT CONST high) :
+  byte.higher byte DECR high
+END OP DECRH;
+
+INT PROC lower byte (WORD CONST byte) :
+  byte.lower byte.
+END PROC lower byte;
+
+INT PROC higher byte (WORD CONST byte) :
+  byte.higher byte.
+END PROC higher byte;
+
+INT PROC lower byte (INT CONST int byte) :
+  int byte MOD 256.
+END PROC lower byte;
+
+INT PROC higher byte (INT CONST int byte) :
+  (int byte AND -256) DIV 256 AND 255.
+END PROC higher byte;
+
+PROC set lower byte (WORD VAR byte, INT CONST lower byte) :
+  byte.lower byte := lower byte
+END PROC set lower byte;
+
+PROC set higher byte (WORD VAR byte, INT CONST higher byte) :
+  byte.higher byte := higher byte
+END PROC set higher byte;
+
+OP CATHEX (TEXT VAR insert line, WORD CONST byte) :
+   insert line CAT (hex chars SUB (byte.lower byte  DIV 16 + 1));
+   insert line CAT (hex chars SUB (byte.lower byte  MOD 16 + 1));
+   insert line CAT " ";
+   insert line CAT (hex chars SUB (byte.higher byte DIV 16 + 1));
+   insert line CAT (hex chars SUB (byte.higher byte MOD 16 + 1));
+   insert line CAT " ".
+END OP CATHEX;
+
+OP CATASCII (TEXT VAR insert line, WORD CONST byte) :
+  insert line CAT ascii (byte.lower byte );
+  insert line CAT ascii (byte.higher byte).
+END OP CATASCII;
+
+TEXT PROC ascii (INT CONST half byte) :
+(*IF half byte >  31 AND half byte < 127 COR
+     half byte > 213 AND half byte < 219 COR
+     half byte = 251                             8.2.89 cl  *)
+  IF half byte > 18 CAND half byte < 255
+    THEN code (half byte)
+    ELSE "."
+  FI.
+END PROC ascii;
+
+PROC block in (ROW 256 WORD VAR block bytes, INT CONST type, block nr) :
+  ROW 256 INT VAR block;
+  reset block io;
+  block in (block, type, block nr, error answer);
+  block bytes := block;
+  check archive error (error answer, true).
+END PROC block in;
+
+PROC block out (ROW 256 WORD CONST bytes, INT CONST disk type, block nr) :
+  ROW 256 INT VAR int bytes := bytes;
+  reset block io;
+  block out (int bytes, disk type, block nr, error answer);
+  check archive error (error answer, true).
+END PROC block out;
+
+PROC put (WORD CONST byte) :
+  put ("LOW :");
+  put (text (byte.lower byte));
+  put ("HIGH :");
+  put (text (byte.higher byte))
+END PROC put;
+
+PROC get (WORD VAR byte) :
+  get (integer);
+  byte := integer.
+END PROC get;
+
+PROC zu byte (ROW 256 WORD VAR bytes, TEXT CONST byte kette, INT CONST stelle) :
+  INT VAR lower, higher;
+  lower := pos (hex chars, (byte kette SUB 1)) * 16 +
+           pos (hex chars, (byte kette SUB 2)) - 17;
+  higher:= pos (hex chars, (byte kette SUB 4)) * 16 +
+           pos (hex chars, (byte kette SUB 5)) - 17;
+  IF higher > 127
+    THEN bytes [stelle] := minus * 255 + minus + lower
+    ELSE bytes [stelle] := higher * 256 + lower
+  FI.
+
+minus : higher - 256.
+END PROC zu byte;
+
+WORD OP $ (TEXT CONST hex) :
+    TEXT VAR byte kette :: "";
+    FOR i FROM 1 UPTO 4 REP
+       IF (hex SUB i) = ""
+         THEN byte kette CAT "0"
+       ELIF (hex SUB i) <> " "
+         THEN byte kette CAT (hex SUB i)
+       FI;
+    PER;
+    WORD VAR byte;
+    INT VAR lower, higher, i;
+    lower := pos (hex chars, (byte kette SUB 1)) * 16 +
+             pos (hex chars, (byte kette SUB 2)) - 17;
+    higher:= pos (hex chars, (byte kette SUB 3)) * 16 +
+             pos (hex chars, (byte kette SUB 4)) - 17;
+    IF higher > 127
+      THEN byte := minus * 255 + minus + lower
+      ELSE byte := higher * 256 + lower
+    FI;
+    byte.
+
+minus : higher - 256.
+END OP $;
+
+INT PROC hint (TEXT CONST he) :
+  INT VAR laenge :: length (he),
+          stelle,
+          ziffer,
+          ergebnis :: 0;
+
+  TEXT VAR h :: he;
+
+  FOR stelle FROM 65 UPTO 70 REP
+    change all (h, code (stelle + 32), code (stelle))
+  PER;
+
+  FOR stelle FROM laenge DOWNTO 1 REP
+    ziffer := pos ("0123456789ABCDEF", h SUB stelle) - 1;
+    IF ziffer < 0
+      THEN errorstop ("Unerlaubtes Zeichen in Hexadezimalzahl")
+    FI;
+    ergebnis INCR ziffer * 16 ** (laenge - stelle)
+  PER;
+  ergebnis
+END PROC hint;
+
+
+(********************** PACKET header operations ***************************)
+
+OP := (HEADER VAR dest, HEADER CONST source) :
+    CONCR (dest) := CONCR (source).
+END OP :=;
+
+HEADER PROC header (TEXT CONST name, date, INT CONST type, TEXT CONST pass) :
+    HEADER : (name, date, type, pass).
+END PROC header;
+
+BOOL PROC is start header (HEADER CONST header) :
+    CONCR (header).type = start of volume.
+END PROC is start header;
+
+BOOL PROC is end header (HEADER CONST header) :
+    CONCR (header).type = end of volume.
+END PROC is end header;
+
+BOOL PROC is file header (HEADER CONST header) :
+    CONCR (header).type = file header.
+END PROC is file header;
+
+PROC name (HEADER VAR header, TEXT CONST new name) :
+    CONCR (header).name := new name.
+END PROC name;
+
+TEXT PROC name (HEADER CONST header) :
+    CONCR (header).name.
+END PROC name;
+
+PROC date (HEADER VAR header, TEXT CONST new date) :
+    CONCR (header).date := new date.
+END PROC date;
+
+TEXT PROC date (HEADER CONST header) :
+    CONCR (header).date.
+END PROC date;
+
+PROC type (HEADER VAR header, INT CONST new type) :
+    CONCR (header).type := new type.
+END PROC type;
+
+INT PROC type (HEADER CONST header) :
+    CONCR (header).type.
+END PROC type;
+
+PROC pass (HEADER VAR header, TEXT CONST new pass) :
+    CONCR (header).pass := new pass.
+END PROC pass;
+
+TEXT PROC pass (HEADER CONST header) :
+    CONCR (header).pass.
+END PROC pass;
+
+
+(**********************   Header-Editor V1.4    ****************************)
+
+PROC header edit (HEADER VAR header, TEXT CONST msg) :
+    TEXT VAR head :: ""15"HEADER - EDITOR V1.4" + (25 - LENGTH msg) * "." + msg +
+                     5 * "." + " "14"";
+    disable stop;
+    REP
+      out (home);
+      out (16 * (cl eol + down));
+      cursor (6, 6);
+      putline (head);
+      cursor (6, 7);
+      put (""15"TEXT name : "14"");
+      edit get (CONCR (header).name, max text length, 38);
+      IF is error
+        THEN clear error;
+             CONCR (header).name := "";
+             cursor (6, 7);
+             put (""15"TEXT name : "14"");
+             edit get (CONCR (header).name, max text length, 38)
+      FI;
+      cursor (6, 8);
+      put (""15"TEXT date : "14"");
+      edit get (CONCR (header).date, max text length, 38);
+      IF is error
+        THEN clear error;
+             CONCR (header).date := "";
+             cursor (6, 8);
+             put (""15"TEXT date : "14"");
+             edit get (CONCR (header).date, max text length, 38)
+      FI;
+      cursor (6, 9);
+      put (""15"INT type  : "14"");
+      TEXT VAR d :: text (CONCR (header).type);
+      edit get (d, max text length, 38);
+      CONCR (header).type := int (d);
+      cursor (6, 10);
+      put (""15"TEXT pass : "14"");
+      edit get (CONCR (header).pass, max text length, 38);
+      IF is error
+        THEN clear error;
+             CONCR (header).pass := "";
+             cursor (6, 10);
+             put (""15"TEXT pass : "14"");
+             edit get (CONCR (header).pass, max text length, 38)
+      FI;
+      cursor (6, 13);
+    UNTIL NOT no (""15"header ok. "14"") PER
+END PROC header edit;
+
+
+(********************** PACKET block editor     ****************************)
+
+PROC show first (ROW 256 WORD CONST block) :
+    out (home);
+    po := 1.0;
+    first := true;
+    FOR i FROM 1 UPTO 16 REP
+      text block [i] := text ((i - 1) * 16, 4);
+      text block [i] CAT " � ";
+(*    get cursor (x, y); *)
+      FOR i1 FROM 1 UPTO 8 REP
+         text block [i] CATHEX block [(i-1) * 8 + i1]
+      PER;
+      text block [i] CAT "  �";
+      FOR i1 FROM 1 UPTO 8 REP
+         text block [i] CATASCII block [(i - 1) * 8 + i1]
+      PER;
+      text block [i] CAT "�";
+(*    cursor (x, y);    *)
+      putline (text block [i])
+    PER.
+END PROC show first;
+
+PROC show second (ROW 256 WORD CONST block) :
+    out (home);
+    po := 129.0;
+    first := false;
+    FOR i FROM 17 UPTO 32 REP
+      text block [i] := text ((i - 1) * 16, 4);
+      text block [i] CAT " � ";
+(*    get cursor (x,y);  *)
+      FOR i1 FROM 1 UPTO 8 REP
+         text block [i] CATHEX block [(i - 1) * 8 + i1]
+      PER;
+      text block [i] CAT "  �";
+      FOR i1 FROM 1 UPTO 8 REP
+         text block [i] CATASCII block [(i - 1) * 8 + i1]
+      PER;
+      text block [i] CAT "�";
+(*    cursor (x, y);     *)
+      putline (text block [i])
+    PER.
+END PROC show second;
+
+PROC block edit (ROW 256 WORD VAR block, INT CONST st) :
+    IF st > 0
+      THEN IF st > 255
+             THEN push (255 * right)
+             ELSE push (st * right)
+           FI
+    FI;
+    BOOL VAR low :: TRUE;
+    edit info;
+    cursor (8, 1);
+(*  get cursor (x, y); *)
+    po := 1.0;
+    REP
+      get cursor (x, y);
+      cursor (x, y);
+  (*  inchar (t);  *)
+      get char (t);
+      IF (t = right OR t = " ") AND x < 53
+        THEN cursor (x + 3, y); po INCR 0.5
+      ELIF (t = right OR t = " ") AND  x > 52 AND y < 16
+        THEN cursor (8, y + 1); po INCR 0.5
+      ELIF t = up AND y > 1
+        THEN cursor (x, y - 1); po DECR 8.0
+      ELIF t = left AND x > 8
+        THEN cursor (x - 3, y); po DECR 0.5
+      ELIF t = left AND x = 8 AND y <> 1
+        THEN cursor (53, y - 1); po DECR 0.5
+      ELIF t = down AND y < 16
+        THEN cursor (x, y + 1); po INCR 8.0
+      ELIF t = tab
+        THEN IF first
+               THEN show first (block)
+               ELSE show second (block)
+             FI;
+             ascii edit (block, first);
+             IF first
+               THEN show first (block)
+               ELSE show second (block)
+             FI;
+             IF t <> return
+               THEN edit info;
+                    cursor (8, 1);
+             FI
+      ELIF t = ""7""
+        THEN set ctrl g
+      FI;
+      get cursor (x, y);
+      cursor (x, y);
+      IF code (t) > 47 AND code (t) < 58 OR
+         code (t) > 96 AND code (t) < 103
+        THEN IF code (t) > 96 CAND code (t) < 103
+               THEN t := code (code (t) - 32)
+             FI;
+             out (left + "-" + 2 * right + "-" + 3 * left + t);
+             REP
+           (*  inchar (tc);  *)
+               get char (tc);
+             UNTIL code (tc) > 47 AND code (tc) < 58 OR
+                   code (tc) > 96 AND code (tc) < 103   PER;
+             IF code (tc) > 96 CAND code (tc) < 103
+               THEN tc := code (code (tc) - 32)
+             FI;
+             out (tc + " " + 4 * left + " ");
+             cursor (x, y);
+             t CAT tc;
+             INT VAR bp :: int (po);
+             IF po MOD real (bp) = 0.0
+               THEN low := TRUE
+               ELSE low := FALSE
+             FI;
+             IF NOT first               (* ONE : 17.06.85 *)
+               THEN bp INCR 128
+             FI;
+             IF low
+               THEN set lower byte (block [bp], hint (t))
+               ELSE set higher byte (block [bp], hint (t))
+             FI;
+      FI;
+      info;
+    UNTIL t = return COR ctrl g PER;
+    IF first
+      THEN show first (block)
+      ELSE show second (block)
+    FI;
+    cursor (1, 17).
+
+info :
+  get cursor (x, y);
+  cursor (xx, yy);
+  IF po MOD real (int(po)) = 0.0
+    THEN put ("LOW")
+    ELSE put ("HIGH")
+  FI;
+  cursor (x,y).
+
+edit info :
+  cursor (1, 23);
+  put (cl eol + "Block-Editor : Hexmodus,");
+  IF first
+    THEN put ("First Block")
+    ELSE put ("Second Block")
+  FI;
+  put (",");
+  get cursor (xx, yy).
+END PROC block edit;
+
+PROC ascii edit (ROW 256 WORD VAR block, BOOL CONST first) :
+    edit info;
+    cursor (59, 1);
+    x := 1;
+    y := 1;
+    po := 1.0;
+    REP
+      get char (t);
+      IF po < 1.0 AND first
+        THEN po := 1.0
+      FI;
+      IF po < 129.0 AND NOT first
+        THEN po := 129.0
+      FI;
+      IF po > 128.5 AND first
+        THEN po := 128.5
+      FI;
+      IF po > 256.5 AND NOT first
+        THEN po := 256.5
+      FI;
+      SELECT pos (""9""8""2""3""10""13""7"", t) OF
+        CASE 1, 6 : quit ascii edit
+        CASE 2    : IF x > 1 COR (x = 1 AND y > 1)
+                      THEN x DECR 1; po DECR 0.5
+                    FI
+        CASE 3    : IF x < 16 COR (x = 16 AND y <> 16)
+                      THEN x INCR 1; po INCR 0.5
+                    FI
+        CASE 4    : IF y > 1
+                      THEN y DECR 1;
+                           po DECR 8.0
+                    FI
+        CASE 5    : IF y < 16
+                      THEN y INCR 1;
+                           po INCR 8.0
+                    FI
+        CASE 7    : set ctrl g
+       OTHERWISE IF code (t) >= 32 AND code (t) <= 126
+                   THEN set char; push (""2"")
+                 FI
+      END SELECT;
+      IF x < 1 AND y = 1
+        THEN x := 1
+      ELIF x < 1 AND y > 1
+        THEN x := 16;
+             y DECR 1
+      ELIF x > 16 AND y = 16
+        THEN x := 16;
+      ELIF x > 16 AND y < 16
+        THEN x := 1;
+             y INCR 1
+      ELIF y < 1
+        THEN y := 1
+      ELIF y > 16
+        THEN y := 16
+      FI;
+      info;
+    UNTIL ctrl g PER.
+
+quit ascii edit :
+  x := 8;
+  y := 1;
+  cursor (x, y);
+  po := 1.0;
+  LEAVE ascii edit.
+
+set char :
+  out (t);
+  INT VAR bp :: int (po);
+  IF x MOD 2 = 0
+    THEN set higher byte (block [bp], code (t))
+    ELSE set lower  byte (block [bp], code (t))
+  FI.
+
+info :
+  cursor (xx, yy);
+  IF po MOD real (int (po)) = 0.0
+    THEN put ("LOW")
+    ELSE put ("HIGH")
+  FI;
+  cursor (58 + x, y).
+
+edit info :
+  cursor (1, 23);
+  put (""5"Block-Editor : Asciimodus,");
+  IF first
+    THEN put ("First Block")
+    ELSE put ("Second Block")
+  FI;
+  put (",");
+  get cursor (xx, yy).
+END PROC ascii edit;
+
+
+(********************** PACKET block i/o :      ****************************)
+
+PROC set channel (INT CONST channel) :
+    archive channel := channel.
+END PROC set channel;
+
+PROC read block (ROW 256 WORD VAR block byte, INT CONST block nummer) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    block in (block int, disk type, block nummer, error answer);
+    IF is error
+      THEN clear error
+    FI;
+    break (quiet);
+    continue (user channel);
+    enable stop;
+    check archive error (error answer, true);
+    block byte := block int.
+END PROC read block;
+
+PROC write block (ROW 256 WORD VAR block byte, INT CONST block nummer) :
+    user channel := channel;
+    enable stop;
+    block int := block byte;
+    continue (archive channel);
+    disable stop;
+    block out (block int, disk type, block nummer, error answer);
+    IF is error
+      THEN clear error
+    FI;
+    break (quiet);
+    continue (user channel);
+    enable stop;
+    check archive error (error answer, false).
+END PROC write block;
+
+PROC read block (ROW 256 INT VAR block int, INT CONST block nummer) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    block in (block int, disk type, block nummer, error answer);
+    IF is error
+      THEN clear error
+    FI;
+    break (quiet);
+    continue (user channel);
+    enable stop;
+    check archive error (error answer, true).
+END PROC read block;
+
+PROC write block (ROW 256 INT VAR block int, INT CONST block nummer) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    block out (block int, disk type, block nummer, error answer);
+    IF is error
+      THEN clear error
+    FI;
+    break (quiet);
+    continue (user channel);
+    enable stop;
+    check archive error (error answer, false).
+END PROC write block;
+
+
+(********************** PACKET space i/o :      ****************************)
+
+PROC seek space (INT CONST space) :
+    user channel := channel;
+    enable stop;
+    rewind;
+    INT VAR i;
+    continue (archive channel);
+    disable stop;
+    FOR i FROM 1 UPTO space REP
+      skip dataspace
+    UNTIL is error PER;
+    break (quiet);
+    continue (user channel).
+END PROC seek space;
+
+PROC seek block (INT CONST block nr) :
+    seek (block nr).
+END PROC seek block;
+
+PROC read space (DATASPACE VAR ds) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    read (ds);
+    break (quiet);
+    continue (user channel).
+END PROC read space;
+
+PROC read space (DATASPACE VAR ds, INT VAR max pages,
+                      BOOL CONST errors) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    read (ds, max pages, errors);
+    break (quiet);
+    continue (user channel).
+END PROC read space;
+
+PROC write space (DATASPACE CONST ds) :
+    user channel := channel;
+    enable stop;
+    continue (archive channel);
+    disable stop;
+    write (ds);
+    break (quiet);
+    continue (user channel).
+END PROC write space;
+
+PROC check archive error (INT CONST code, BOOL CONST read) :
+    enable stop;
+    IF read
+      THEN SELECT code OF
+             CASE 0 :
+             CASE 1 : error stop (read write impossible error,
+                                  "Lesen unmoeglich (1)")
+             CASE 2 : error stop (read error,
+                                  "Lesefehler (2)")
+             CASE 3 : error stop (block number error,
+                                  "Blocknummer zu hoch (3)")
+            OTHERWISE error stop (undef archive error,
+                                  "Archivfehler unbekannt ("+ text (code) +")")
+           END SELECT
+      ELSE SELECT code OF
+             CASE 0 :
+             CASE 1 : error stop (read write impossible error,
+                                  "Schreiben unmoeglich (1)")
+             CASE 2 : error stop (write error,
+                                  "Schreibfehler (2)")
+             CASE 3 : error stop (block number error,
+                                  "Blocknummer zu hoch (3)")
+            OTHERWISE error stop (undef archive error,
+                                  "Archivfehler unbekannt ("+ text (code) +")")
+           END SELECT
+    FI.
+END PROC check archive error;
+
+
+(********************** PACKET menue monitor :  ****************************)
+
+PROC fehler behandeln :
+    IF is error CAND error message <> ""
+      THEN IF is halt from terminal
+             THEN set ctrl g
+             ELSE cursor (error line x pos, error line y pos);
+                  clear error;
+                  put (cl eol +"Fehler : "+ error message)
+           FI
+    FI.
+END PROC fehler behandeln;
+
+PROC set ctrl g :
+    ctrl g := true.
+END PROC set ctrl g;
+
+PROC reset ctrl g :
+    ctrl g := false.
+END PROC reset ctrl g;
+
+PROC fehler loeschen :
+    INT VAR x, y;
+    get cursor (x, y);
+    cursor (1, 22);
+    out (cl eol);
+    cursor (1, 18);
+    out (cl eol);
+    cursor (1, 23);
+    out (cl eol);
+    cursor (x, y).
+END PROC fehler loeschen;
+
+
+(**********************     Global-Menue        ****************************)
+
+PROC global menue :
+    ende := false;
+    user channel := channel;
+    disable stop;
+    REP
+      menue monitor (global info line, global chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+        CASE  1 : block menue
+        CASE  2 : space menue
+        CASE  3 : archive menue
+        CASE  4 : configurator menue
+        CASE  5 : urflop menue
+        CASE  6 : out ("uit");ende := true;
+        CASE  7 : get and do one command; block shown := false
+        CASE  8 : global menue help; block shown := false
+        CASE  9 : doctor menue
+        CASE 10 : set ctrl g
+      END SELECT;
+      fehler behandeln;
+    UNTIL ende COR ctrl g PER;
+    reset ctrl g;
+    ende := false.
+END PROC global menue;
+
+PROC doctor menue :
+    DATASPACE VAR head ds := nilspace; forget (head ds);
+    BOUND HEADER VAR head;
+    TEXT VAR new archive name;
+    disable stop;
+    REP
+      menue monitor (doctor info line, doctor chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+        CASE 1 : neuer archiv start header
+        CASE 2 : neuer archiv end header
+        CASE 3 : rette eine datei
+        CASE 4 : heap auslutschen
+        CASE 5 : get and do one command; block shown := false
+        CASE 6 : LEAVE doctor menue
+        CASE 7 : doctor menue help; block shown := false
+        CASE 8 : set ctrl g
+      END SELECT;
+      fehler behandeln;
+    UNTIL ende COR ctrl g PER.
+
+neuer archiv start header :
+  cursor (2, 21);
+  forget (head ds);
+  head ds := nilspace;
+  head := head ds;
+  out ("gib neuen Archivnamen : ");
+  getline (new archive name);
+  head := nil header;
+  name (head, new archive name);
+  type (head, 1000);
+  date (head, "0.0");
+  seek space (0);
+  write space (head ds).
+
+neuer archiv end header :
+  cursor (2, 21);
+  forget (head ds);
+  head ds := nilspace;
+  head := head ds;
+  out ("Nach der wievielten Datei soll das Ende geschrieben werden : ");
+  get (last file);
+  name (head, "");
+  date (head, "");
+  type (head, 1);
+  pass (head, "");
+  cursor (1, 22); out (""5"");
+  IF yes ("Neues Archivende nach der "+ text (last file) +
+          " Datei schreiben")
+    THEN seek space ((last file * 2) + 1);
+         write space (head ds)
+  FI.
+
+rette eine datei :
+  cursor (2, 21);
+  out ("Die wievielte Datei soll gerettet werden : ");
+  get (filenr);
+  seek space (file nr * 2);
+  forget (head ds);
+  head ds := nilspace;
+  read space (head ds);
+  rename file.
+
+rename file :
+  TEXT VAR new name := "";
+  IF type (head ds) = 1003
+    THEN f := sequential file (input, head ds);
+         new name := head line (f);
+         close (f);
+         IF no ("soll die gerettete Datei """+ new name +""" heissen")
+           THEN get command ("gib Dateinamen :", new name)
+         FI;
+    ELSE IF yes ("soll die Datei einen bestimmten Namen bekommen")
+           THEN get command ("gib Dateinamen :", new name)
+         FI
+  FI;
+  copy (head ds, new name).
+
+heap auslutschen :
+  INT VAR h start, h end, file nr;
+  TEXT VAR h dat;
+  cursor (2, 21);
+  out ("Heap lesen ab Block : ");
+  get (h start);
+  cursor (2, 21);
+  out ("Heap lesen ab Block "); put (h start); put ("bis Block :");
+  get (h end);
+  cursor (1, 22);
+  out ("in Datei : ");
+  getline (h dat);
+  cursor (60, 22);
+  out ("Block : ");
+  heap lesen (h start, h end, archive channel, h dat).
+
+END PROC doctor menue;
+
+
+(**********************     Block-Menue         ****************************)
+
+PROC block menue :
+    disable stop;
+    REP
+      menue monitor (block info line, block chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+       CASE 1 : read one block
+       CASE 2 : write one block
+       CASE 3 : edit block menue
+       CASE 4 : LEAVE block menue
+       CASE 5 : get and do one command
+       CASE 6 : search menue
+       CASE 7 : read next block
+       CASE 8 : block menue help; block shown := false
+       CASE 9 : set ctrl g
+     END SELECT;
+     show first three ints;
+     display info line;
+     fehler behandeln
+   UNTIL ctrl g PER.
+
+read one block :
+  out ("ead Block : ");
+  x get (block nummer);
+  IF NOT is error
+    THEN reset block io;
+         read block (block, block nummer)
+  FI;
+  IF NOT is error
+    THEN show first (block); block shown := true
+  FI.
+
+write one block :
+  out ("rite");
+  IF yes ("write auf Block "+ text (block nummer))
+    THEN reset block io;
+         write block (block, block nummer)
+  ELIF yes ("write auf einen anderen Block")
+    THEN out (" auf Block : ");
+         x get (block nummer);
+         IF NOT is error
+           THEN reset block io;
+                write block (block, block nummer)
+         FI
+  FI.
+
+read next block :
+  put (""8"read Block :");
+  block nummer INCR 1;
+  out (text (block nummer));
+  reset block io;
+  read block (block, block nummer);
+  IF NOT is error
+    THEN show first (block); block shown := true
+  FI.
+
+END PROC block menue;
+
+
+(**********************     Search-Menue        ****************************)
+
+PROC search menue :
+    disable stop;
+    menue monitor (search info line, search chars, command index);
+    fehler loeschen;
+    SELECT command index OF
+       CASE 1 : ascii search
+       CASE 2 : hex search
+       CASE 3 : dez search
+       CASE 4 : LEAVE search menue
+       CASE 5 : set ctrl g
+     END SELECT;
+     display info line;
+     fehler behandeln.
+
+ascii search :
+  cursor (command line x pos + 1, command line y pos);
+  put ("Suchtext :"); getline (t);
+  cursor (command line x pos + 1, command line y pos);
+  put ("suchen nach """+ t +""" von Block :");
+  x get (s);
+  cursor (command line x pos + 1, command line y pos);
+  put ("suchen nach """+ t +""" von Block");
+  put (s); put ("bis Block :"); x get (e);
+  search (t, s, e, fb, fp);
+  out (""13"");
+  IF fp > 0
+    THEN put (cl eol +"Gefunden auf Block"); put (fb);
+         put (", Position"); put (fp);
+         read block (block, fb);
+         IF fp < 256
+           THEN show first (block)
+           ELSE show second (block)
+         FI;
+         block shown := true;
+         st pos := (fp MOD 256) - 1;
+         block nummer := fb;
+    ELSE put ("Nicht gefunden !!");
+  FI.
+
+hex search :
+  cursor (command line x pos + 1, command line y pos);
+  put ("Suchhex :"); getline (t);
+  cursor (command line x pos + 1, command line y pos);
+  put ("suchen nach """+ t +""" von Block :");
+  x get (s);
+  cursor (command line x pos + 1, command line y pos);
+  put ("suchen nach """+ t +""" von Block");
+  put (s); put ("bis Block :"); x get (e);
+  change all (t, " ", "");
+  TEXT VAR such hex := "";
+  i := 1;
+  REP
+    such hex CAT code (hint (subtext (t, i, i + 1)));
+    i INCR 2
+  UNTIL i >= length (t) PER;
+  search (such hex, s, e, fb, fp);
+  out (""13"");
+  IF fp > 0
+    THEN put (cl eol +"Gefunden auf Block"); put (fb);
+         put (", Position"); put (fp);
+         read block (block, fb);
+         IF fp < 256
+           THEN show first (block)
+           ELSE show second (block)
+         FI;
+         block shown := true;
+         st pos := (fp MOD 256) - 1;
+         block nummer := fb;
+    ELSE put ("Nicht gefunden !!");
+  FI.
+
+dez search :
+  error stop ("gibt es noch nicht !").
+END PROC search menue;
+
+
+(**********************  Block-Editor-Menue     ****************************)
+
+PROC edit block menue :
+    INT VAR command index;
+    disable stop;
+    REP
+      fehler loeschen;
+      show first three ints;
+      menue monitor (editor info line, editor chars, command index);
+      SELECT command index OF
+        CASE 1 : out ("irst");
+                 show first (block);
+                 block shown := true
+        CASE 2 : out ("econd");
+                 show second (block);
+                 block shown := true
+        CASE 3 : out ("ump");
+                 show first (block); block edit (block, stpos);
+                 show second (block); block edit (block, stpos);
+                 block shown := true;
+        CASE 4 : IF NOT block shown
+                   THEN IF first
+                          THEN show first (block)
+                          ELSE show second (block)
+                        FI;
+                        block shown := true
+                 FI;
+              (* IF first AND stpos >= 256
+                   THEN show second (block);
+                        block shown := true
+                 ELIF NOT first AND stpos <= 256
+                   THEN show first (block);
+                        block shown := true
+                 FI;                            *) (* ??? *)
+                 block edit (block, stpos)
+        CASE 5 : LEAVE edit block menue
+        CASE 6 : get and do one command; block shown := false
+        CASE 7 : block editor menue help;  block shown := false
+        CASE 8 : set ctrl g
+        CASE 9 : INT VAR old st pos := st pos;
+                 out ("os auf Byte : ");
+                 x get (st pos);
+                 IF st pos < 0 OR st pos > 513
+                   THEN st pos := old st pos;
+                        error stop ("Zahl nicht ok")
+                 FI
+      END SELECT;
+      fehler behandeln
+    UNTIL ctrl g PER.
+
+END PROC edit block menue;
+
+
+(**********************     Space-Menue         ****************************)
+
+PROC space menue :
+    disable stop;
+    REP
+      menue monitor (space info line, space chars, command index);
+      fehler loeschen;
+      rewind;
+      SELECT command index OF
+        CASE  1 : read one space
+        CASE  2 : bit map read
+        CASE  3 : write one space
+        CASE  4 : bit map write
+        CASE  5 : edit one space
+        CASE  6 : copy one space
+        CASE  7 : LEAVE space menue
+        CASE  8 : new edit
+        CASE  9 : get and do one command
+        CASE 10 : load one space
+        CASE 11 : space menue help
+        CASE 12 : set ctrl g
+      END SELECT;
+      fehler behandeln;
+      display info line;
+    UNTIL ctrl g PER.
+
+load one space :
+  out ("aden aus Datei : ");
+  getline (dummy);
+  forget (ds);
+  ds := nilspace;
+  ds := old (dummy).
+
+read one space :
+  cursor (info line x pos, info line y pos);
+  out (space header info);
+  cursor (command line x pos + 2, command line y pos);
+  out ("ead ");
+  REP
+    get char (dummy)
+  UNTIL pos ("shq"7"", dummy) > 0 PER;
+  IF dummy = "s"
+    THEN out ("Space : "); read one s
+  ELIF dummy = "h"
+    THEN out ("Header : "); read one h
+  ELIF dummy = ""7""
+    THEN set ctrl g
+  FI.
+
+read one s :
+  x get (space nummer);
+  IF NOT is error
+    THEN seek space (space nummer);
+         first sp block := block number + 1;
+         forget (ds);
+         ds := nilspace;
+         read space (ds)
+  FI.
+
+read one h :
+  x get (header nummer);
+  space nummer := space nr (header nummer);
+  IF NOT is error
+    THEN seek space (space nummer);
+         first sp block := block number + 1;
+         forget (ds);
+         ds := nilspace;
+         read space (ds)
+  FI.
+
+bit map read :
+  out ("ead Space ab Block : ");
+  x get (s);
+  cursor (command line x pos + 1, command line y pos);
+  out ("Read Space ab Block "+ text (s) +" Max. Bloecke : ");
+  x get (e);
+  seek block (s);
+  IF e = 0
+    THEN e := 32000
+  FI;
+  forget (ds);
+  ds := nilspace;
+  IF yes ("bei Lesefehlern abbrechen")
+    THEN read space (ds, e, true)
+    ELSE read space (ds, e, false)
+  FI.
+
+write one space :
+  out ("rite");
+  IF yes ("write auf Space "+ text (space nummer))
+    THEN seek space (space nummer);
+         write space (ds)
+  ELIF yes ("write auf einen anderen Space")
+    THEN out (" auf Space : ");
+         x get (space nummer);
+         IF NOT is error
+           THEN seek space (space nummer);
+                write space (ds)
+         FI
+  FI.
+
+bit map write :
+  out ("rite Space ab Block : ");
+  x get (s);
+  seek block (s);
+  write space (ds).
+
+edit one space :
+  IF type (ds) = file type 16
+    THEN change to 17;
+         f := sequential file (modify, ds);
+         edit (f, 1, 1, x size - 2, 16);
+         block shown := false
+  ELIF type (ds) = file type
+    THEN f := sequential file (modify, ds);
+         edit (f, 1, 1, x size - 2, 16);
+         block shown := false
+  ELIF ds pages (ds) = 1 CAND type (ds) = 0
+    THEN edit header;
+         block shown := false
+  FI.
+
+change to 17 :
+  TEXT VAR t := "";
+  REP
+    t CAT "­"
+  UNTIL NOT exists (t) PER;
+  copy (ds, t);
+  reorganize (t);
+  forget (ds);
+  ds := nilspace;
+  ds := old (t);
+  forget (t, quiet).
+
+copy one space :
+  put ("ave in Datei : ");
+  getline (t);
+  copy (ds, t).
+
+edit header :
+  bound header := ds;
+  cursor (1, 23);
+  out (cl eol +"Header-Editor : ");
+  IF is start header (bound header)
+    THEN out ("Header ist ein Archiv-Startheader.")
+  ELIF is file header (bound header)
+    THEN out ("Header ist ein File-Header.")
+  ELIF is end header (bound header)
+    THEN out ("Header ist ein Archiv-Endheader.")
+    ELSE out ("Header ist unbekannt (Headertype = "+ text (type (bound header)) +").")
+  FI;
+  header edit (bound header, "Headernummer : "+ text (header nr) + " ").
+
+new edit :
+  out (left +"new edit ");
+  block shown := false;
+  IF yes ("Neuen Headerspace erstellen")
+    THEN create new header
+    ELSE create new file
+  FI.
+
+create new header :
+  forget (ds);
+  ds := nilspace;
+  bound header := ds;
+  bound header := nil header;
+  cursor (1, 23);
+  out (cl eol +"Header-Editor : ");
+  put ("Neuen Header erstellen");
+  header edit (bound header, "Neuen Header erstellen").
+
+create new file :
+  forget (ds);
+  ds := nilspace;
+  f := sequential file (modify, ds);
+  edit (f, 1, 1, x size - 2, 16).
+END PROC space menue;
+
+
+(**********************   Configurator-Menu     ****************************)
+
+PROC configurator menue :
+    disable stop;
+    REP
+      display conf info;
+      menue monitor (conf info line, conf chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+        CASE  1 : put ("hannel :"); x get (archive channel);
+        CASE  2 : put (left +"disktype :"); x get (disk type);
+        CASE  3 : disk info
+        CASE  4 : get and do one command
+        CASE  5 : LEAVE configurator menue
+        CASE  6 : conf menue help
+        CASE  7 : set ctrl g
+      END SELECT;
+      fehler behandeln;
+      display info line;
+    UNTIL ctrl g PER.
+
+display conf info :
+  cursor (1, 19);
+  put (cl eol +"I/O Channel :"); put (archive channel); put (",");
+  put ("Disktype :"); put (disk type); put (",");
+  put ("Operatorchannel :"); put (channel);
+  cursor (1, 18);
+  put ("Zeit :"); put (time of day); put (", Datum :"); put (date);
+  INT VAR x size, x used;
+  storage (x size, x used);
+  put (","); put (x used); put ("K von");
+  put (int (real (x size + 24) * 64.0 / 63.0));
+  put ("K sind belegt !").
+
+disk info :
+  INT VAR size, io, error;
+  io control (archive channel, io, size, error);
+  out (home + 16 * (cl eol + down));
+  out (home + down);
+  putline ("Diskinfo :");
+  putline (first mon line);
+  put ("Disksize :"); put (size); put ("Blocks,");
+  put (size DIV 2); put ("kB.");
+  line;
+  put ("Disktype :");
+  IF size = ibm 720 format 5
+    THEN putline ("5 1/4 Zoll, IBM-720 kB Format, 80 Tracks,");
+         putline ("           double sided/double density, softsectored")
+  ELIF size = ibm 360 format 5
+    THEN putline ("5 1/4 Zoll, IBM-360 kB Format, 40 Tracks,");
+         putline ("           single sided/double density, softsectored")
+  ELIF size = pic 400 format 5
+    THEN putline ("5 1/4 Zoll, PIC400 Format, 80 Tracks,");
+         putline ("           double sided/double density, softsectored")
+  ELIF size = soft sd 8
+    THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,");
+         putline ("           single sided/double density, softsectored")
+  ELIF size = soft dd 8
+    THEN putline ("8 Zoll, EUMEL-Format, 77 Tracks,");
+         putline ("           double sided/double density, softsectored")
+  ELIF size = hard ss sd
+    THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,");
+         putline ("           single sided/single density, hardsectored")
+  ELIF size = hard ds sd
+    THEN putline ("8 Zoll, EUMEL-Format, 32 Tracks,");
+         putline ("           double sided/single density, hardsectored")
+    ELSE putline ("Unbekannter Disktype"); line
+  FI;
+  putline (first mon line).
+END PROC configurator menue;
+
+
+(**********************   Header/Space Ops.     ****************************)
+
+INT PROC header nr :
+  IF space nummer = 0
+    THEN 0
+    ELSE (space nummer + 1) DIV 2
+  FI.
+END PROC header nr;
+
+INT PROC space nr (INT CONST header nummer) :
+  IF header nummer = 0 COR header nummer = 1
+    THEN header nummer
+    ELSE header nummer * 2 - 1
+  FI
+END PROC space nr;
+
+
+(**********************     Archiv-Menue        ****************************)
+
+PROC archive menue :
+    archive (archive name);
+    disable stop;
+    REP
+      menue monitor (archiv info line, archiv chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+        CASE 1 : archive anmelden
+        CASE 2 : out ("elease (archive)");
+                 release (archive); archivename := ""
+        CASE 3 : out ("ist (archive)");
+                 list archive;
+                 block shown := false
+        CASE 4 : out ("etch (SOME archive, archive)");
+                 fetch (SOME archive, archive);
+                 block shown := false
+        CASE 5 : out ("ave (SOME all, archive)");
+                 save (SOME all, archive);
+                 block shown := false
+        CASE 6 : release (archive);
+                 LEAVE archive menue
+        CASE 7 : get and do one command;
+                 block shown := false
+        CASE 8 : archiv menue help;
+                 block shown := false
+        CASE 9 : set ctrl g
+      END SELECT;
+      fehler behandeln
+    UNTIL ctrl g PER.
+
+archive anmelden :
+  put ("rchivename : ");
+  getline (archivename);
+  archive (archivename).
+
+list archive :
+  IF NOT (list file ok) COR no (""13"Alte Archiveliste zeigen")
+    THEN forget (af ds);
+         af ds := nilspace;
+         af := sequential file (output, af ds);
+         list (af, archive);
+         list file ok := true
+  FI;
+  edit (af, 1, 1, xsize - 2, 16).
+END PROC archive menue;
+
+
+(**********************     Urflop-Menue        ****************************)
+
+PROC urflop menue :
+    INT VAR s, e;
+    disable stop;
+    REP
+      menue monitor (urflop info line, urflop chars, command index);
+      fehler loeschen;
+      SELECT command index OF
+        CASE 1 : read
+        CASE 2 : x read
+        CASE 3 : write
+        CASE 4 : x write
+        CASE 5 : list task;
+                 block shown := false
+        CASE 6 : LEAVE urflop menue
+        CASE 7 : get and do one command;
+                 block shown := false
+        CASE 8 : urflop menue help;
+                 block shown := false
+        CASE 9 : set ctrl g
+      END SELECT;
+      fehler behandeln
+    UNTIL ctrl g PER.
+
+list task :
+  forget (l ds);
+  l ds := nilspace;
+  lf := sequential file (output, l ds);
+  list (lf);
+  edit (lf, 1, 1, xsize - 2, 16).
+
+write :
+  out ("rite Datenraumname : ");
+  getline (t);
+  IF yes ("Urlader schreiben wie gelesen")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               -1)
+  ELIF yes ("Urlader für PIC 400 (Shard 6.xx) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               eumel 0 end block pic)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               eumel 0 end block)
+  ELIF yes ("Urlader für PIC 400 (ab Shard 7.13 für EUMEL Ver. 1758) schreiben")
+    THEN urlader schreiben (t, eumel 0 start block,
+                               eumel 0 end block 1758)
+  FI.
+
+x write :
+  out ("rite Datenraumname : ");
+  getline (t);
+  cursor (command line x pos, command line y pos);
+  out (">Write Datenraum """+ t +""" von Block : ");
+  x get (s);
+  cursor (command line x pos, command line y pos);
+  out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis : ");
+  x get (e);
+  cursor (command line x pos, command line y pos);
+  out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+       " Block "+ text (e));
+  IF yes ("mit Versatz")
+    THEN cursor (command line x pos, command line y pos);
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Versatz : ");
+         x get (ver);
+         cursor (command line x pos, command line y pos);
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Ver. "+ text (ver) + " --> ");
+         urlader schreiben (t, s, e, ver)
+    ELSE cursor (command line x pos, command line y pos);
+         out (">Write Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" --> ");
+         urlader schreiben (t, s, e)
+  FI.
+
+read :
+  out ("ead Datenraumname : ");
+  getline (t);
+  IF yes ("Urlader für PIC 400 (Shard 6.xx) lesen")
+    THEN urlader lesen (t, eumel 0 start block,
+                           eumel 0 end block pic)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx, u. Bicos Masch.) lesen")
+    THEN urlader lesen (t, eumel 0 start block,
+                           eumel 0 end block)
+  ELIF yes ("Urlader für PIC 400 (Shard 7.xx für EUMEL Ver. 1758) lesen")
+    THEN urlader lesen (t, eumel 0 start block,
+                           eumel 0 end block 1758)
+  FI.
+
+x read :
+  out ("ead Datenraumname : ");
+  getline (t);
+  cursor (command line x pos, command line y pos);
+  out (">Read Datenraum """+ t +""" von Block : ");
+  x get (s);
+  cursor (command line x pos, command line y pos);
+  out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis : ");
+  x get (e);
+  IF yes ("mit Versatz")
+    THEN cursor (command line x pos, command line y pos);
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Versatz : ");
+         x get (ver);
+         cursor (command line x pos, command line y pos);
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" Ver. "+ text (ver) + " --> ");
+         urlader lesen (t, s, e, ver)
+    ELSE cursor (command line x pos, command line y pos);
+         out (">Read Datenraum """+ t +""" von Block "+ text (s) + " bis"+
+              " Block "+ text (e) +" --> ");
+         urlader lesen (t, s, e)
+  FI.
+END PROC urflop menue;
+
+
+(**********************  Disk - Monitor Call    ****************************)
+
+PROC central disk monitor process :
+    archive ("disk");
+    release (archive);
+    space nummer := -1;
+    block nummer := -1;
+    header nummer := -1;
+    first sp block := -1;
+    st pos := 0;
+    archive name := "";
+    list file ok := false;
+    block shown := false;
+    reset ctrl g;
+    page;
+    line (3);
+    putline ("D I S K  -  M O N I T O R");
+    putline ("=========================");
+    line;
+    putline ("Autor : Ingo Siekmann");
+    putline ("Stand : "+ software stand);
+    putline (software version);
+    putline ("Bem.  : "+ software bemerkung);
+    putline ("        "+ software bemerkung1);
+    line;
+    putline ("(c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert");
+    line;
+    initialize if necessary;
+    global menue;
+    line;
+    unblock (archive);
+    IF archive name <> "" CAND NOT ctrl g
+      THEN archive (archive name)
+    FI.
+END PROC central disk monitor process;
+
+
+(**********************     Unterprogramme      ****************************)
+
+THESAURUS OP SOME (THESAURUS CONST thesaurus) :
+    DATASPACE VAR edit space :: nilspace;
+    THESAURUS VAR result := empty thesaurus;
+    FILE VAR file := sequential file (output, edit space);
+    file FILLBY thesaurus;
+    modify (file);
+    edit (file, 1, 1, xsize - 2, 16);
+    input (file);
+    result FILLBY file;
+    forget (edit space);
+    result.
+END OP SOME;
+
+THESAURUS OP SOME (TASK CONST dest task) :
+    SOME ALL dest task.
+END OP SOME;
+
+PROC display info line :
+    INT VAR x, y;
+    get cursor (x, y);
+    cursor (1, 24);
+    put (cl eol +"Block : "); put (block nummer);
+    put (", Space : "); put (space nummer);
+    put (", First Sp Block : "); put (first sp block);
+    put (", Header : "); put (header nummer);
+    cursor (x, y).
+END PROC display info line;
+
+PROC show first three ints :
+  INT VAR i, ih;
+  cursor (1, 18);
+  out (cleol);
+  FOR i FROM 1 UPTO 3 REP
+    out (text (i));
+    put (". INT:");
+    dummy := ""; dummy CATHEX block [i];
+    put (dummy);
+    put ("/");
+    ih := block [i];
+    out (text (ih));
+    out (",  ")
+  PER
+END PROC show first three ints;
+
+PROC x get (INT VAR i) :
+    enable stop;
+    get (dummy);
+    IF (dummy SUB length (dummy)) = hex marker
+      THEN i := hint (text (dummy, length (dummy) - 1))
+      ELSE i := int (dummy)
+    FI;
+    IF NOT last conversion ok
+      THEN error stop ("Zahl ist nicht korrekt")
+    FI.
+END PROC x get;
+
+
+(**********************     Urflop - Ops.       ****************************)
+
+PROC urlader lesen (TEXT CONST urname, INT CONST start, end) :
+    urlader lesen (urname, start, end, 0).
+END PROC urlader lesen;
+
+PROC urlader schreiben (TEXT CONST urname, INT CONST start, end) :
+    urlader schreiben (urname, start, end, 0).
+END PROC urlader schreiben;
+
+PROC urlader lesen auf seite (TEXT CONST urname, INT CONST start, end,
+                                   auf) :
+    urlader lesen (urname, start, end, auf - start).
+END PROC urlader lesen auf seite;
+
+PROC urlader schreiben von seite (TEXT CONST urname, INT CONST start,
+                                       end, von) :
+    urlader schreiben (urname, start, end, von - start).
+END PROC urlader schreiben von seite;
+
+PROC urlader lesen (TEXT CONST urname, INT CONST start, end, ver) :
+    IF exists (urname)
+      THEN error stop (""""+ urname +""" gibt es schon")
+    FI;
+    forget (uds);
+    uds := nilspace;
+    reset block io;
+    reset ctrl g;
+    FOR block nr FROM start UPTO end REP
+      continue (archive channel);
+      disable stop;
+      block in (uds, block nr + ver, disk type, block nr, error);
+      continue (user channel);
+      enable stop;
+      check archive error (error, true);
+      cout (block nr);
+      dummy := incharety;
+      IF dummy = ""7""
+        THEN set ctrl g
+      FI
+    UNTIL dummy = esc COR ctrl g PER;
+    IF NOT ctrl g
+      THEN copy (uds, urname);
+    FI;
+    forget (uds).
+END PROC urlader lesen;
+
+PROC urlader schreiben (TEXT CONST urname, INT CONST start, end, ver) :
+    forget (uds);
+    uds := old (urname);
+    reset ctrl g;
+    reset block io;
+    block nr := start;
+    IF block nr = -1
+      THEN block nr := next ds page (uds, block nr)
+    FI;
+    WHILE block nr <> -1 REP
+      continue (archive channel);
+      disable stop;
+      block out (uds, block nr + ver, disk type, block nr, error);
+      break (quiet);
+      continue (user channel);
+      enable stop;
+      check archive error (error, false);
+      cout (block nr);
+      dummy := incharety;
+      IF dummy = ""7""
+        THEN set ctrl g
+      FI;
+      IF end = -1 COR start = -1
+        THEN block nr := next ds page (uds, block nr)
+      ELIF block nr = end
+        THEN block nr := -1
+        ELSE block nr INCR 1
+      FI
+    UNTIL dummy = esc COR ctrl g PER;
+    forget (uds).
+END PROC urlader schreiben;
+
+
+(**********************     Unterprogramme      ****************************)
+
+PROC reset block io :
+    user channel := channel;
+    INT VAR i, s, e;
+    io control (archive channel, i, s, e);
+    check archive error (e, true).
+END PROC reset block io;
+
+PROC get and do one command :
+    initialize if necessary;
+    cursor (1, 21);
+    out (cl eop);
+    get command ("gib ein EUMEL-Kommando : ", own command line);
+    do (own command line).
+END PROC get and do one command ;
+
+PROC io control (INT VAR io, size, error) :
+    ROW 256 INT VAR block;
+    control (type mode, 0, 0, io);
+    control (size mode, 0, 0, size);
+    block in (block, std disk type, block 0, error).
+END PROC io control;
+
+PROC io control (INT CONST io channel, INT VAR io, size, error) :
+    INT VAR op channel :: channel;
+    continue (io channel);
+    io control (io, size, error);
+    break (quiet);
+    continue (op channel).
+END PROC io control;
+
+
+(**********************    Menue - Help Ops     ****************************)
+
+PROC doctor menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Doktor-Menue : ");
+    line;
+    putline ("a --> Neuen Archivnamen (Archivanfang) schreiben");
+    putline ("e --> Neues Archivende schreiben");
+    line;
+    putline ("r --> Eine Datei von der Archiv-Diskette retten");
+    line;
+    putline ("h --> Heapteil einer Datei auf der Diskette lesen");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)");
+END PROC doctor menue help;
+
+PROC global menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Global-Menue : ");
+    line;
+    putline ("b --> Aufruf des Block-Menüs (direkter Block i/o)");
+    putline ("s --> Aufruf des Space-Menüs (direkter Space- und Header i/o)");
+    putline ("a --> Aufruf des Archiv-Menüs (normale Archivoperationen)");
+    putline ("u --> Aufruf des Urflop-Menüs (Urlader/Datenraum <-> Floppy)");
+    putline ("c --> Aufruf des Konfigurator-Menüs");
+    putline ("d --> Aufruf des Doktor-Menüs");
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Diskettenmonitors (quit wie im Editor)");
+END PROC global menue help;
+
+PROC block menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Block-Menü : ");
+    line;
+    putline ("r --> Lesen eines Blockes (block in)");
+    putline ("n --> Lesen des nächsten Blockes");
+    putline ("w --> Schreiben eines Blockes (block out)");
+    line;
+    putline ("s --> Suchen nach einem Text");
+    line;
+    putline ("e --> Aufruf des Blockeditor-Menüs");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Block-Menüs (Rückkehr ins Global-Menü)");
+END PROC block menue help;
+
+PROC block editor menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Blockeditor-Menü : ");
+    line;
+    putline ("f --> Zeigen der ersten 256 Bytes des aktuellen Blockes");
+    putline ("s --> Zeigen der zweiten 256 Bytes des aktuellen Blockes");
+    line;
+    putline ("e --> Editieren des aktuellen Teilblockes");
+    putline ("d --> Editieren des ersten und zweiten Teilblockes");
+    line;
+    putline ("p --> Position setzen, auf der der Editor beginnen soll");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Blockeditor-Menüs (Rückkehr ins Block-Menü)");
+END PROC block editor menue help;
+
+PROC space menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Space-Menü : ");
+    line;
+    putline ("r --> Lesen eines Datenraums bzw. eines Headers");
+    putline ("R --> Lesen eines Datenraums ab Block x");
+    putline ("w --> Schreiben eines Datenraums bzw. eines Headers");
+    putline ("W --> Schreiben eines Datenraums ab Block x");
+    line;
+    putline ("e --> Editieren des aktuellen Datenraums (Datei o. Header)");
+    putline ("E --> Editieren einer neuen Datei oder eines Header");
+    line;
+    putline ("s --> Kopieren des aktuellen Datenraums in einen benannten Datenraum");
+    putline ("l --> Kopieren eines benannten Datenraums in den aktuellen Datenraum");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    putline ("q --> Verlassen des Space-Menüs (Rückkehr ins Global-Menü)");
+END PROC space menue help;
+
+PROC archiv menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Archiv-Menü : ");
+    line;
+    putline ("a --> Archiv anmelden");
+    putline ("r --> Archiv abmelden");
+    line;
+    putline ("f --> Einige Dateien vom Archiv in die Task laden");
+    putline ("s --> Einige Dateien der Task auf das Archiv schreiben");
+    putline ("l --> Dateiliste des Archives zeigen");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Archiv-Menüs (Rückkehr ins Global-Menü)");
+END PROC archiv menue help;
+
+PROC urflop menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Urflop-Menü : ");
+    line;
+    putline ("r --> Lesen der Blöcke 10 bis 62 in einen benannten Datenraum");
+    putline ("R --> Lesen der Blöcke x bis y in einen benannten Datenraum");
+    line;
+    putline ("w --> Schreiben der Blöcke 10 bis 62 aus einem benannten Datenraum");
+    putline ("W --> Schreiben der Blöcke x bis y aus einem benannten Datenraum");
+    line;
+    putline ("l --> Dateiliste der Task zeigen (list)");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Urflop-Menüs (Rückkehr ins Global-Menü)");
+END PROC urflop menue help;
+
+PROC conf menue help :
+    out (home + cl eop);
+    line;
+    putline ("Help für das Configurator-Menü :");
+    line;
+    putline ("c --> Einstellen des Kanals, auf dem der Block i/o abläuft");
+    putline ("t --> Einstellen des Diskettentypes (EUMEL, CPM etc)");
+    line;
+    putline ("i --> Disketteninfo");
+    line;
+    putline ("k --> Möglichkeit, ein EUMEL/ELAN - Kommando zu geben (gib kommando :)");
+    line;
+    putline ("q --> Verlassen des Konfigurator-Menüs (Rückkehr ins Global-Menü)");
+END PROC conf menue help;
+
+BOOL PROC is halt from terminal :
+    is error CAND error code = 1
+END PROC is halt from terminal;
+
+PROC block in (TEXT VAR block, INT CONST block nr, disk type,
+                    INT VAR error) :
+    initialize if necessary;
+    block in (blkinds, heap page nr, disk type, block nr, error);
+    block := subtext (bound text, start pos, LENGTH bound text);
+END PROC block in;
+
+PROC initialize if necessary :
+    IF NOT initialized (this packet)
+      THEN forget (blkinds);
+           blkinds := nilspace;
+           bound text := blkinds;
+           bound text := (start pos + 511) * " ";
+           own command line := "";
+           archive channel := std archive channel;
+           disk type := std disk type
+    FI.
+END PROC initialize if necessary;
+
+BOOL PROC yes (TEXT CONST msg) :
+    get cursor (cx, cy);
+    cursor (command line x pos + 1, command line y pos + 1);
+    result := NOT no (msg);
+    cursor (cx, cy);
+    result.
+END PROC yes;
+(*
+INT OP $ (TEXT CONST hex) :
+    INT VAR laenge := length (hex), stelle, ziffer, ergebnis := 0;
+    FOR stelle FROM laenge DOWNTO 1 REP
+      ziffer := pos ("0123456789ABCDEF", hex SUB stelle) - 1;
+      IF ziffer < 0
+        THEN error stop ("Ist keine Hexzahl")
+      FI;
+      ergebnis INCR ziffer * 16 ** (laenge - stelle)
+    PER;
+    ergebnis.
+END OP $;
+*)
+PROC search (TEXT CONST st, INT CONST start block, end block,
+                  INT VAR fbnr, fpos) :
+    enable stop;
+    INT CONST l := LENGTH st - 1;
+    reset ctrl g;
+    reset block io;
+    FOR fbnr FROM start block UPTO end block REP
+      cout (fbnr);
+      continue (archive channel);
+      block in (stb1, fbnr, disk type, error);
+      IF error = 0
+        THEN block in (stb2, fbnr + 1, disk type, error)
+      FI;
+      break (quiet);
+      continue (user channel);
+      check archive error (error, true);
+      stb1 CAT text (stb2, l);
+    UNTIL pos (stb1, st) > 0 COR incharety = ""27"" PER;
+    fpos := pos (stb1, st)
+END PROC search;
+
+PROC heap lesen (INT CONST start block, end block, channel nr,
+                      TEXT CONST output filename) :
+
+    FILE VAR f;
+    ROW 256 INT VAR block;
+    INT VAR i, j;
+    TEXT VAR t;
+    IF exists (output filename)
+      THEN error stop (""""+ output filename +""" gibt es schon")
+    FI;
+    f := sequential file (output, output filename);
+    max line length (f, 100);
+    t := "";
+    reset ctrl g;
+    set channel (channel nr);
+    FOR i FROM start block UPTO end block REP
+      c out (i);
+      read block (block, i);
+      j := 1;
+      REP
+        IF lower byte (block [j]) = 255 COR higher byte (block [j]) = 255
+          THEN putline (f, t);
+               t := ""; hihi;
+               j INCR 1
+        FI;
+        IF j < 257
+          THEN IF lower byte (block [j]) = 220 COR
+                  lower byte (block [j]) = 221
+                 THEN t CAT code (lower byte (block [j]))
+                 ELSE t CAT ascii (lower byte (block [j]));
+               FI;
+               IF higher byte (block [j]) = 220 COR
+                  higher byte (block [j]) = 221
+                 THEN t CAT code (higher byte (block [j]))
+                 ELSE t CAT ascii (higher byte (block [j]));
+               FI
+        FI;
+        j INCR 1;
+      UNTIL j >= 255 PER;
+    UNTIL incharety = ""27"" PER.
+
+hihi :
+  REP
+    j INCR 1;
+    IF j > 256
+     THEN LEAVE hihi
+    FI
+  UNTIL lower byte (block [j]) <> 255 CAND
+        higher byte (block [j]) <> 255 PER.
+
+END PROC heap lesen;
+
+END PACKET byte operations and disk monitor version 36 multi;
+
diff --git a/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle b/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle
new file mode 100644
index 0000000..8660a67
--- /dev/null
+++ b/app/diskettenmonitor/3.7/src/disk cmd 3.6.quelle
@@ -0,0 +1,48 @@
+
+PACKET disk cmd
+
+(************************************************************************)
+(*                                                                      *)
+(*  Disk - Menuecall    Version 3.6                                   *)
+(*                                                                      *)
+(*                                                                      *)
+(* Autor : Ingo Siekmann                                                *)
+(* Stand : Montag, den 09.02.1987                                       *)
+(*                                                                      *)
+(* Lauffähig ab EUMEL Version 1.8.1 /M und insertiertem                 *)
+(* Diskmonitor ab Version 3.6                                           *)
+(*                                                                      *)
+(* (c) 1986 by ULES c/o Ingo Siekmann & Nils Ehnert                     *)
+(*                                                                      *)
+(************************************************************************)
+
+      DEFINES disk ,
+              disk monitor ,
+              disk doctor :
+
+
+lernsequenz auf taste legen ("d", "disk monitor"13"") ;
+lernsequenz auf taste legen ("D", "disk doctor"13"") ;
+
+
+PROCEDURE disk :
+
+    central disk monitor process .
+
+END PROCEDURE disk ;
+
+PROCEDURE disk monitor :
+
+    central disk monitor process .
+
+END PROCEDURE disk monitor ;
+
+PROCEDURE disk doctor :
+
+    push ("d") ;
+    disk monitor .
+
+END PROCEDURE disk doctor ;
+
+END PACKET disk cmd ;
+
diff --git a/app/eudas/3.4/source-disk b/app/eudas/3.4/source-disk
new file mode 100644
index 0000000..309d823
--- /dev/null
+++ b/app/eudas/3.4/source-disk
@@ -0,0 +1 @@
+eudas/eudas-3.4.img
diff --git a/app/eudas/3.4/src/eudas.1 b/app/eudas/3.4/src/eudas.1
new file mode 100644
index 0000000..5c8bb63
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.1
@@ -0,0 +1,37 @@
+PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0=" ist keine Feldnummer";TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT
+ VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0.w0:p0+p0<(j0ISUB1)-1.END PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1-
+s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1REPreplace(j0,y0,w1+v1)END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)<t1REPy0INCR1END REP.z1:(CONCR(j0)ISUBy0)=t1.a2:(CONCR(j0)ISUB(y0+1))=t1+length(x1).END PROCfeldindex;END PACKETeudassatzzugriffe;
+PACKETeudasdateienDEFINES EUDAT,oeffne,satznr,dateiende,saetze,aufsatz,weiter,zurueck,satzlesen,satzaendern,satzloeschen,satzeinfuegen,feldlesen,feldaendern,feldbearbeiten,felderzahl,feldnamenlesen,feldnamenaendern,notizenlesen,notizenaendern,feldinfo,dezimalkomma,wertberechnen,reorganisiere,sortiere,sortierreihenfolge,unsortiertesaetze:LETb2=531,c2=121,d2=5000,e2=3243,f2=64,g2=48;LET INTVEC=TEXT,INDEX=STRUCT(INTh2,i2,INTj2,k2,INTVECl2),EINTRAG=STRUCT(INTh2,i2,m2,n2,SATZj0),DATEI=STRUCT(INTfelderzahl,SATZo2,INTVECfeldinfo,TEXTp2,INTq2,r2,s2,INTt2,u2,INTv2,satznr,INTw2,x2,y2,INTz2,a3,ROW3TEXTb3,ROWb2INTc3,ROWc2INDEXindex,ROWd2EINTRAGd3);TYPE EUDAT=BOUND DATEI;LETe0="";LETe3="Datei ist keine EUDAS-Datei",f3="inkonsistente EUDAS-Datei",g3="EUDAS-Datei voll",h3="Nicht erlaubtes Dezimalkomma";TEXT VARi3;TEXT VARj3:="  ";INTVEC CONSTk3:=l3(f2,1);LETm3="";TEXT VARn3;INTVEC PROCl3(INT CONSTlength,o3):replace(j3,1,o3);length*j3END PROCl3;PROCinsert(INTVEC VARp3,INT CONSTpos,o3):INT CONSTbegin:=
+pos+pos-1;IFbegin<1THENq3ELIFbegin>length(p3)+1THENr3ELSEreplace(j3,1,o3);n3:=subtext(p3,begin);p3:=subtext(p3,1,begin-1);p3CATj3;p3CATn3END IF END PROCinsert;PROCdelete(INTVEC VARp3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>=length(p3)THENr3ELSEn3:=subtext(p3,begin+2);p3:=subtext(p3,1,begin-1);p3CATn3END IF END PROCdelete;INT PROCpos(INTVEC CONSTp3,INT CONSTo3):replace(j3,1,o3);INT VARbegin:=1;REPbegin:=pos(p3,j3,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCs3(INTVEC VARt3,u3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>length(t3)+1THENr3ELSEu3:=subtext(t3,begin);t3:=subtext(t3,1,begin-1)END IF END PROCs3;PROCv3(INTVEC VARt3,u3,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENq3ELIFbegin>length(t3)+1THENr3ELSEu3:=subtext(t3,1,begin-1);t3:=subtext(t3,begin)END IF END PROCv3;.r3:errorstop(9,e0).q3:errorstop(10,e0).PROCw3(DATEI VARx3):x3.felderzahl:=0;x3.feldinfo:=m3;satzinitialisieren(x3.o2);x3.p2:=e0;x3.q2:=1;x3.r2:=
+1;x3.t2:=0;x3.s2:=0;x3.v2:=0;x3.u2:=1;x3.z2:=0;x3.b3(1):=e0;x3.b3(2):=e0;x3.b3(3):=e0;x3.satznr:=1;x3.w2:=1;x3.x2:=1;x3.y2:=1;x3.index(1).l2:=k3;x3.index(1):=INDEX:(0,0,1,1,l3(1,1));INT VARl0;FORl0FROM1UPTOb2REPx3.c3(l0):=0END REP;x3.d3(1):=EINTRAG:(0,0,1,0,y3).y3:x3.o2.END PROCw3;PROCoeffne(EUDAT VARx3,TEXT CONSTz3):enablestop;IF NOTexists(z3)THEN CONCR(x3):=new(z3);w3(CONCR(x3));type(old(z3),e2)ELIFtype(old(z3))=e2THEN CONCR(x3):=old(z3)ELSEerrorstop(e3)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARx3,DATASPACE CONSTa4):IFtype(a4)<0THEN CONCR(x3):=a4;w3(CONCR(x3));type(a4,e2)ELIFtype(a4)=e2THEN CONCR(x3):=a4ELSEerrorstop(e3)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTx3,INT CONSTp0,TEXT VARq0):feldlesen(b4,p0,q0).b4:x3.d3(x3.y2).j0.END PROCfeldlesen;PROCfeldaendern(EUDAT VARx3,INT CONSTp0,TEXT CONSTc4):IFd4THENe4(CONCR(x3));f4;feldaendern(b4,p0,c4)END IF.d4:x3.y2<>1.f4:IFp0=1THENdisablestop;g4(CONCR(x3),h4(c4))END IF.b4:x3.d3(x3.y2).j0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONST
+x3):x3.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTx3,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):feldbearbeiten(b4,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0).b4:x3.d3(x3.y2).j0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTx3,SATZ VARi4):i4:=x3.o2END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARx3,SATZ CONSTj4):x3.o2:=j4;INT CONSTk4:=felderzahl(j4);IFk4>x3.felderzahlTHENl4;x3.felderzahl:=k4END IF.l4:x3.feldinfoCATl3(m4,-1).m4:k4-length(x3.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTx3,INT CONSTp0):x3.feldinfoISUBp0END PROCfeldinfo;PROCfeldinfo(EUDAT VARx3,INT CONSTp0,n4):replace(x3.feldinfo,p0,n4);IFpos(x3.p2,code(p0))>0THENx3.z2:=x3.v2END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTx3):x3.satznrEND PROCsatznr;BOOL PROCdateiende(EUDAT CONSTx3):x3.satznr>x3.v2END PROCdateiende;INT PROCsaetze(EUDAT CONSTx3):x3.v2END PROCsaetze;PROCo4(DATEI VARx3,INT CONSTw2,k2,satznr):IFw2<1ORw2>x3.r2CORk2<1ORk2>x3.index(w2).j2THENerrorstop(f3)
+END IF;disablestop;x3.w2:=w2;x3.x2:=k2;x3.satznr:=satznr;x3.y2:=x3.index(w2).l2ISUBk2END PROCo4;PROCaufsatz(EUDAT VARx3,INT CONSTp4):INT VARsatznr;IFp4<1THENsatznr:=1ELIFp4>x3.v2THENsatznr:=x3.v2+1ELSEsatznr:=p4END IF;q4(CONCR(x3),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARx3,TEXT CONSTx1):aufsatz(x3,1);IFr4THENweiter(x3,x1)END IF.r4:feldlesen(x3,1,i3);i3<>x1.END PROCaufsatz;PROCq4(DATEI VARx3,INT CONSTsatznr):IFs4THENo4(x3,1,1,1)END IF;INT VARw2:=x3.w2,t4:=x3.satznr-x3.x2;IFsatznr>x3.satznrTHENu4ELSEv4END IF;o4(x3,w2,k2,satznr).s4:satznr+satznr<x3.satznr.u4:WHILEw4REPt4INCRj2;w2:=x3.index(w2).i2END REP.w4:INT CONSTj2:=x3.index(w2).j2;t4+j2<satznr.v4:WHILEx4REPw2:=x3.index(w2).h2;t4DECRx3.index(w2).j2END REP.x4:t4>=satznr.k2:satznr-t4.END PROCq4;PROCweiter(EUDAT VARx3):y4(CONCR(x3))END PROCweiter;PROCy4(DATEI VARx3):IFz4THENa5END IF.z4:x3.y2<>1.a5:INT VARw2:=x3.w2,k2:=x3.x2;IFk2=index.j2THENw2:=index.i2;k2:=1ELSEk2INCR1END IF;o4(x3,w2,k2,x3.satznr+1).index:x3.index(w2).END PROCy4;PROC
+zurueck(EUDAT VARx3):b5(CONCR(x3))END PROCzurueck;PROCb5(DATEI VARx3):IFc5THENd5END IF.c5:x3.satznr<>1.d5:INT VARw2:=x3.w2,k2:=x3.x2;IFk2=1THENw2:=m2.h2;k2:=m2.j2ELSEk2DECR1END IF;o4(x3,w2,k2,x3.satznr-1).m2:x3.index(w2).END PROCb5;PROCweiter(EUDAT VARx3,TEXT CONSTx1):y4(CONCR(x3),x1)END PROCweiter;PROCy4(DATEI VARx3,TEXT CONSTx1):e5;WHILEf5CANDg5REPh5END REP;IFf5THENi5(x3,k2)ELSEq4(x3,x3.v2+1)END IF.e5:INT VARj5,k2:=x3.y2;IFg5THENk5(x3,h4(x1),k2,j5)ELSEh5END IF.f5:k2<>0.g5:feldlesen(b4,1,i3);i3<>x1.b4:x3.d3(k2).j0.h5:k2:=x3.d3(k2).i2.END PROCy4;PROCzurueck(EUDAT VARx3,TEXT CONSTx1):b5(CONCR(x3),x1)END PROCzurueck;PROCb5(DATEI VARx3,TEXT CONSTx1):e5;WHILEf5CANDg5REPl5END REP;IFf5THENi5(x3,k2)ELSEq4(x3,1)END IF.e5:INT VARk2:=x3.y2,j5;IFk2=1ORm5THENk5(x3,h4(x1),j5,k2)END IF.f5:k2<>0.g5:k2=x3.y2ORm5.m5:feldlesen(b4,1,i3);i3<>x1.b4:x3.d3(k2).j0.l5:k2:=x3.d3(k2).h2.END PROCb5;PROCi5(DATEI VARx3,INT CONSTk2):INT CONSTn5:=x3.d3(k2).m2;INT VARx2:=1,satznr:=0;WHILEx2<>n5REPsatznrINCRx3.index(x2
+).j2;x2:=x3.index(x2).i2END REP;x2:=pos(x3.index(n5).l2,k2);satznrINCRx2;o4(x3,n5,x2,satznr).END PROCi5;INT VARindex;PROCo5(TEXT CONSTp5,INT CONSTq5,r5):INT VARs5:=q5;index:=0;IFr5-q5<4THENt5ELSEu5END IF;index:=indexMODb2+1.t5:WHILEs5<=r5REPindex:=index*4;indexINCRcode(p5SUBs5);s5INCR1END REP.u5:WHILEs5<=r5REPindexINCRindex;indexINCRcode(p5SUBs5);IFindex>16000THENindex:=indexMODb2END IF;s5INCR1END REP.END PROCo5;INT PROCh4(TEXT CONSTp5):o5(p5,1,length(p5));indexEND PROCh4;INT PROCh4(SATZ CONSTj0):feldbearbeiten(j0,1,PROC(TEXT CONST,INT CONST,INT CONST)o5);indexEND PROCh4;PROCk5(DATEI CONSTx3,INT CONSTh4,INT VARk2,v5):INT VARw2:=x3.q2;v5:=x3.c3(h4);k2:=0;BOOL VARw5:=TRUE;WHILEw5ANDv5<>0REPx5;h5END REP.x5:IFy5THENz5ELSEa6END IF.y5:x3.d3(v5).m2=x3.w2.z5:w2:=x3.w2;INT CONSTb6:=pos(l2,v5);IFb6=0THENerrorstop(f3)ELIFb6<=c6THENw5:=FALSE END IF.l2:x3.index(w2).l2.c6:x3.x2.a6:WHILEw2<>x3.d3(v5).m2REP IFw2=x3.w2THENw5:=FALSE;LEAVEx5ELSEw2:=x3.index(w2).h2END IF END REP.h5:IFw5THENk2:=v5;v5:=x3.
+d3(k2).h2END IF.END PROCk5;PROCd6(DATEI VARx3,INT CONSTh4):disablestop;INT CONSTk2:=x3.y2,h2:=x3.d3(k2).h2,i2:=x3.d3(k2).i2;IFi2<>0THENx3.d3(i2).h2:=h2ELSEx3.c3(h4):=h2END IF;IFh2<>0THENx3.d3(h2).i2:=i2END IF.END PROCd6;PROCe6(DATEI VARx3,INT CONSTh4,i2,h2):disablestop;INT CONSTk2:=x3.y2;x3.d3(k2).h2:=h2;x3.d3(k2).i2:=i2;IFh2<>0THENx3.d3(h2).i2:=k2END IF;IFi2<>0THENx3.d3(i2).h2:=k2ELSEx3.c3(h4):=k2END IF END PROCe6;PROCsatzlesen(EUDAT CONSTx3,SATZ VARj0):j0:=x3.d3(x3.y2).j0END PROCsatzlesen;PROCsatzaendern(EUDAT VARx3,SATZ CONSTf6):IF NOTdateiende(x3)THENg6END IF.g6:e4(CONCR(x3));disablestop;g4(CONCR(x3),h4(f6));b4:=f6.b4:x3.d3(x3.y2).j0.END PROCsatzaendern;PROCg4(DATEI VARx3,INT CONSTh6):IFi6THENj6END IF.i6:INT CONSTk6:=h4(b4);k6<>h6.j6:l6;m6.l6:d6(x3,k6).m6:INT VARh2,i2;k5(x3,h6,h2,i2);e6(x3,h6,h2,i2).b4:x3.d3(x3.y2).j0.END PROCg4;PROCsatzloeschen(EUDAT VARx3):IF NOTdateiende(x3)THENn6END IF.n6:disablestop;o6(CONCR(x3));p6(CONCR(x3));x3.v2DECR1.END PROCsatzloeschen;PROCo6(DATEI VARx3
+):q6(x3);INT CONSTk2:=x3.y2;d6(x3,h4(b4));x3.d3(k2).i2:=x3.t2;x3.t2:=k2.b4:x3.d3(k2).j0.END PROCo6;PROCsatzeinfuegen(EUDAT VARx3,SATZ CONSTf6):r6(CONCR(x3),f6)END PROCsatzeinfuegen;PROCr6(DATEI VARx3,SATZ CONSTf6):INT VARk2,h2,i2;enablestop;s6;disablestop;x3.v2INCR1;t6(x3,k2);INT CONSTu6:=h4(f6);k5(x3,u6,i2,h2);e6(x3,u6,i2,h2);e4(x3).s6:IFx3.t2<>0THENk2:=x3.t2;x3.t2:=x3.d3(k2).i2ELIFx3.u2=d2THENerrorstop(g3)ELSEx3.u2INCR1;k2:=x3.u2END IF;x3.d3(k2).n2:=0;x3.d3(k2).j0:=f6.END PROCr6;INTVEC VARv6;PROCp6(DATEI VARx3):INT CONSTw2:=x3.w2,h2:=index.h2,i2:=index.i2;BOOL VARw6;delete(index.l2,x3.x2);index.j2DECR1;x6(x3,w2,i2,w6);IF NOTw6THENx6(x3,h2,w2,w6)END IF;y6(x3).index:x3.index(w2).END PROCp6;PROCx6(DATEI VARx3,INT CONSTs5,z6,BOOL VARw6):w6:=FALSE;IFs5<>0ANDz6<>0THENa7END IF.a7:INT CONSTb7:=index.j2,c7:=d7.j2;IFe7THENf7;w6:=TRUE END IF.e7:b7+c7<=g2ORb7=0ORc7=0.f7:index.j2INCRd7.j2;g7(x3,d7.l2,s5);index.l2CATd7.l2;h7.h7:index.i2:=d7.i2;IFindex.i2<>0THENx3.index(index.i2).h2:=s5ELSEx3.q2:=
+s5END IF;d7.i2:=x3.s2;x3.s2:=z6.index:x3.index(s5).d7:x3.index(z6).END PROCx6;PROCy6(DATEI VARx3):INT CONSTb4:=x3.satznr;o4(x3,1,1,1);q4(x3,b4)END PROCy6;PROCg7(DATEI VARx3,INTVEC CONSTl2,INT CONSTs5):INT VARl0;FORl0FROM1UPTOlength(l2)DIV2REPx3.d3(l2ISUBl0).m2:=s5END REP END PROCg7;PROCt6(DATEI VARx3,INT CONSTi7):INT VARw2:=x3.w2;IFindex.j2>=f2THENj7END IF;index.j2INCR1;insert(index.l2,x3.x2,i7);x3.y2:=i7;x3.d3(i7).m2:=w2.j7:INT VARu6:=0;k7;IFu6<>0THENl7ELSEm7(x3)END IF;y6(x3);w2:=x3.w2.k7:IFx3.s2<>0THENu6:=x3.s2;x3.s2:=d7.i2ELIFx3.r2<c2THENx3.r2INCR1;u6:=x3.r2;d7.l2:=k3END IF.l7:n7;o7;d7.j2:=index.j2-p7;s3(index.l2,d7.l2,p7+1);index.j2:=p7;g7(x3,d7.l2,u6).n7:INT CONSTq7:=index.i2;IFq7<>0THENx3.index(q7).h2:=u6ELSEx3.q2:=u6END IF;d7.i2:=q7;d7.h2:=w2;index.i2:=u6.o7:INT VARp7;IFr7THENp7:=g2ELSEp7:=index.j2DIV2+1END IF.r7:q7=0.index:x3.index(w2).d7:x3.index(u6).END PROCt6;PROCm7(DATEI VARx3):INT VARw2:=1;REPs7;t7END REP.s7:BOOL VARw6;REP INT CONSTi2:=index.i2;x6(x3,w2,i2,w6)UNTIL NOTw6
+END REP;IFi2=0THEN LEAVEm7ELIFu7THENv7END IF.u7:INT CONSTw7:=g2-index.j2;w7>0.v7:v3(d7.l2,v6,w7+1);d7.j2DECRw7;g7(x3,v6,w2);index.l2CATv6;index.j2:=g2.t7:w2:=i2.index:x3.index(w2).d7:x3.index(i2).END PROCm7;TEXT VARx7:=",";LETy7=1;TEXT PROCdezimalkomma:x7END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTz7):IFlength(z7)<>1THENerrorstop(h3)ELSEx7:=z7ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTx3):x3.z2END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTx3):x3.p2END PROCsortierreihenfolge;PROCe4(DATEI VARx3):IFa8(x3)THENdisablestop;x3.d3(x3.y2).n2INCRy7;x3.z2INCR1END IF END PROCe4;PROCq6(DATEI VARx3):IF NOTa8(x3)THENdisablestop;x3.d3(x3.y2).n2DECRy7;x3.z2DECR1END IF END PROCq6;BOOL PROCa8(DATEI CONSTx3,INT CONSTk2):(x3.d3(k2).n2ANDy7)=0END PROCa8;BOOL PROCa8(DATEI CONSTx3):a8(x3,x3.y2)END PROCa8;INTVEC VARb8;TEXT VARp2;TEXT VARc8,d8;PROCsortiere(EUDAT VARx3):p2:=x3.p2;IFp2=e0THENe8END IF;f8(CONCR(x3)).e8:INT VARl0;FORl0FROM1UPTOx3.felderzahlREPp2CATcode(l0)
+END REP.END PROCsortiere;PROCsortiere(EUDAT VARx3,TEXT CONSTk0):p2:=k0;f8(CONCR(x3))END PROCsortiere;PROCf8(DATEI VARx3):IFx3.p2<>p2THENx3.p2:=p2;x3.z2:=x3.v2+1ELIFx3.z2=0THEN LEAVEf8END IF;b8:=x3.feldinfo;IFg8THENh8(x3)ELSEi8(x3)END IF;q4(x3,1).g8:x3.v2DIVx3.z2<3.END PROCf8;PROCh8(DATEI VARx3):INT VARy2,j0:=1,j8;q4(x3,1);q6(x3);y2:=x3.y2;WHILEk8REPl8;m8;cout(j0)END REP;disablestop;m7(x3);o4(x3,1,1,1).k8:j0<x3.v2.l8:j0INCR1;q4(x3,j0);j8:=y2;y2:=x3.y2.m8:IFn8THENo8(x3,j0,y2);y2:=j8ELSEq6(x3)END IF.n8:x3.d3(j8).j0GROESSERx3.d3(y2).j0.END PROCh8;PROCi8(DATEI VARx3):INT VARl0;FORl0FROM1UPTOx3.u2REP IF NOTa8(x3,l0)THENo8(x3,x3.v2+1,l0);cout(l0)END IF END REP END PROCi8;PROCo8(DATEI VARx3,INT CONSTsatznr,y2):p8;q8.p8:INT VARt1:=1,u1:=satznr-1,r8;WHILEs8REPt8;u8END REP.s8:t1<=u1.t8:r8:=(t1+u1)DIV2;INT VARv8;q4(x3,r8);IF NOTa8(x3)THENw8END IF;v8:=x3.y2.w8:WHILEx3.satznr<u1REPy4(x3);IFx8THEN LEAVEw8END IF END REP;WHILEx3.satznr>t1REPb5(x3);IFx8THEN LEAVEw8END IF END REP;LEAVEp8.x8:a8(x3).u8:IF
+y8GROESSERx3.d3(y2).j0THENu1:=r8-1ELSEt1:=r8+1END IF.y8:x3.d3(v8).j0.q8:i5(x3,y2);IFx3.satznr<t1THENt1DECR1END IF;disablestop;q6(x3);p6(x3);q4(x3,t1);t6(x3,y2).END PROCo8;BOOL OP GROESSER(SATZ CONSTh0,i0):z8;SELECTb8ISUBa9OF CASE0:b9CASE1:c9CASE2:d9OTHERWISEe9END SELECT.z8:INT VARp0;FORp0FROM1UPTOlength(p2)REP INT CONSTa9:=code(p2SUBp0);feldlesen(h0,a9,c8);feldlesen(i0,a9,d8);SELECTb8ISUBa9OF CASE0:f9CASE1:g9OTHERWISEh9END SELECT END REP;LEAVE GROESSER WITH FALSE.g9:REAL VARi9,j9;wertberechnen(c8,i9);wertberechnen(d8,j9);IFi9<>j9THEN LEAVEz8END IF.f9:IF NOT(c8LEXEQUALd8)THEN LEAVEz8END IF.h9:IFc8<>d8THEN LEAVEz8END IF.c9:i9>j9.b9:c8LEXGREATERd8.d9:k9(c8);k9(d8);c8>d8.e9:c8>d8.END OP GROESSER;PROCwertberechnen(TEXT CONSTl9,REAL VARwert):LETm9="0123456789";TEXT VARn9:=x7,text;INT VARk2;INT CONSTo9:=length(l9);p9;WHILEk2<=o9REPq9;k2INCR1END REP;wert:=real(text).p9:k2:=pos(l9,"0","9",1);IFk2=0THENwert:=0.0;LEAVEwertberechnenELIFpos(l9,"-",1,k2)>0THENtext:="-"ELSEtext:=e0END IF;.q9:TEXT 
+CONSTr9:=l9SUBk2;IFpos(m9,r9)>0THENtextCATr9ELIFr9=n9THENtextCAT".";n9:=e0END IF.END PROCwertberechnen;PROCk9(TEXT VARs9):IFlength(s9)<>8THENs9:=e0ELSEs9:=subtext(s9,7)+subtext(s9,4,5)+subtext(s9,1,2)END IF END PROCk9;PROCreorganisiere(TEXT CONSTz3):EUDAT VARt9,u9;oeffne(t9,z3);disablestop;DATASPACE VARa4:=nilspace;oeffne(u9,a4);v9(CONCR(t9),u9);IF NOTiserrorTHENforget(z3,quiet);copy(a4,z3)END IF;forget(a4)END PROCreorganisiere;PROCv9(DATEI VARt9,EUDAT VARu9):enablestop;w9;x9(t9,CONCR(u9)).w9:q4(t9,1);aufsatz(u9,1);WHILE NOTdateiendeREPsatzeinfuegen(u9,y9);cout(t9.satznr);y4(t9);weiter(u9)END REP.dateiende:t9.satznr>t9.v2.y9:t9.d3(t9.y2).j0.END PROCv9;PROCx9(DATEI VARt9,u9):u9.felderzahl:=t9.felderzahl;u9.o2:=t9.o2;u9.feldinfo:=t9.feldinfo;u9.p2:=t9.p2;u9.b3(1):=t9.b3(1);u9.b3(2):=t9.b3(2);u9.b3(3):=t9.b3(3)END PROCx9;PROCnotizenlesen(EUDAT CONSTx3,INT CONSTp4,TEXT VARz9):z9:=x3.b3(p4)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARx3,INT CONSTp4,TEXT CONSTz9):x3.b3(p4):=z9END PROC
+notizenaendern;END PACKETeudasdateien;
+PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZo2,INTVECa10,INTb10,INTc10,DATASPACEa4,EUDATd10,SATZe10,BOOLf10,BOOLg10,h10,i10,TEXTx1,INTVECj10,INTk10),VERWEIS=STRUCT(INTx3,p5);LETe0="",m3="";LETmaxint=32767,l10=10,m10=256,n10=32;ROWl10DATEI VARo10;INT VARp10:=0,q10:=0,r10,s10:=0,t10,u10:=0,v10,w10,x10,y10:=0;BOOL VARz10:=TRUE,a11,b11;TEXT VARc11;ROWm10VERWEIS VARd11;ROWn10VERWEIS VARe11;INT VARf11;LETg11="Zuviel Dateien geoeffnet",h11="Datei existiert nicht",i11="Zu viele Felder",
+j11="Zu viele Koppelfelder",k11="keine Koppelfelder vorhanden",l11="kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",m11="keine Datei geoeffnet",n11="Datei nicht gesichert",o11="Suchmuster zu umfangreich";TEXT VARi3;TEXT VARg0:="  ";INTVEC VARx0;OP CAT(INTVEC VARtext,INT CONSTwert):replace(g0,1,wert);textCATg0END OP CAT;PROCinsert(INTVEC VARp3,INT CONSTk2,wert):INT CONSTp11:=k2+k2-2;x0:=subtext(p3,p11+1);p3:=subtext(p3,1,p11);p3CATwert;p3CATx0END PROCinsert;PROCdelete(INTVEC VARp3,INT CONSTk2):INT CONSTp11:=k2+k2-2;x0:=subtext(p3,p11+3);p3:=subtext(p3,1,p11);p3CATx0END PROCdelete;PROCq11(INTVEC VARp3,INT CONSTr11,s11):INT VARl0;FORl0FROMr11UPTOlength(p3)DIV2-1REPreplace(p3,l0,(p3ISUBl0)+s11)END REP END PROCq11;EUDAT VARt11;SATZ VARi4;PROCu11(TEXT CONSTz3):IFp10=l10THENerrorstop(g11)END IF;IF NOTexists(z3)THENerrorstop(h11)END IF;oeffne(t11,z3)END PROCu11;PROCv11(DATEI VARx3,TEXT CONSTz3):IFa11THENx3.a4:=old(z3);oeffne(x3.d10,x3.a4)ELSEoeffne(x3.d10,z3)END IF;x3.c10:=
+0;x3.g10:=FALSE;x3.h10:=FALSE;x3.name:=z3;w11(x3)END PROCv11;PROCx11(INT CONSTt1):INT VARy11:=t1;WHILEo10(y11).c10<>0REPy11:=o10(y11).c10END REP;o10(y11).c10:=p10END PROCx11;PROCz11:IFdateiende(o10(1).d10)THENaufsatz(1)ELSEaufsatz(satznr(o10(1).d10))END IF END PROCz11;PROCa12:t10:=felderzahl(o10(1).d10);u10:=t10;feldnamenlesen(o10(1).d10,o10(1).o2);f11:=0;INT VARl0;FORl0FROM1UPTOu10REPd11(l0).x3:=0END REP END PROCa12;PROCb12:y10INCR1;IFy10>32000THENy10:=-32000END IF END PROCb12;PROCoeffne(TEXT CONSTz3,BOOL CONSTc12):enablestop;suchbedingungloeschen;dateienloeschen(FALSE);u11(z3);a11:=c12;d12;v11(o10(p10),z3);z11;a12.d12:p10:=1;b12;x10:=0.END PROCoeffne;PROCkopple(TEXT CONSTz3):enablestop;IFp10=0THENerrorstop(m11)END IF;u11(z3);e12;f12;g12;v11(o10(p10),z3);h12.e12:feldnamenlesen(t11,i4);INT VARa10:=0;INTVEC VARi12:=m3;WHILEa10<felderzahl(t11)REPfeldlesen(i4,a10+1,i3);INT CONSTindex:=feldindex(o10(1).o2,i3);IFindex>0THENa10INCR1;i12CATindexEND IF UNTILindex=0END REP.f12:IFu10+felderzahl(
+t11)-a10>m10THENerrorstop(i11)ELIFf11+a10>n10THENerrorstop(j11)ELIFa10=0THENerrorstop(k11)END IF;p10INCR1;o10(p10).o2:=i4;o10(p10).a10:=i12;o10(p10).b10:=a10;INT VARp0:=a10;WHILEp0<felderzahl(t11)REPu10INCR1;p0INCR1;d11(u10).x3:=p10;d11(u10).p5:=p0END REP;FORp0FROM1UPTOa10REPj12END REP.j12:INT CONSTk12:=i12ISUBp0;IFd11(k12).x3=0THENl12ELSEm12END IF.l12:f11INCR1;e11(f11).x3:=p10;e11(f11).p5:=p0;d11(k12).x3:=f11;d11(k12).p5:=1.m12:INT CONSTn12:=d11(k12).x3+d11(k12).p5;o12;d11(k12).p5INCR1;e11(n12).x3:=p10;e11(n12).p5:=p0.o12:INT VARi7;FORi7FROMf11DOWNTOn12REPe11(i7+1):=e11(i7)END REP;f11INCR1;FORi7FROM1UPTOt10REP IFd11(i7).x3>=n12THENd11(i7).x3INCR1END IF END REP.g12:q10INCR1;IFs10=0THENs10:=p10ELSEx11(s10)END IF.h12:b12;o10(p10).f10:=FALSE;o10(p10).i10:=FALSE;p12(o10(p10)).END PROCkopple;PROCkette(TEXT CONSTz3):enablestop;IFp10=0THENerrorstop(m11)END IF;u11(z3);p10INCR1;v11(o10(p10),z3);x11(1);IFz10THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)q12):IFp10>1THEN
+errorstop(l11)ELSEaenderungeneintragen;q12(o10(1).d10);z11;a12;o10(1).h10:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTr12,TEXT CONSTz3):aenderungeneintragen;notizenaendern(o10(r12).d10,2,date);IFa11THENforget(z3,quiet);copy(o10(r12).a4,z3)END IF;o10(r12).h10:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTs12):aenderungeneintragen;t12;u12.t12:q10:=0;s10:=0;o10(1).c10:=0;u10:=0;z10:=TRUE.u12:WHILEp10>0REP IFv12AND NOTs12THENerrorstop(n11);LEAVEdateienloeschenEND IF;forget(o10(p10).a4);p10DECR1END REP.v12:a11ANDo10(p10).h10.END PROCdateienloeschen;INT PROCanzahlkoppeldateien:q10END PROCanzahlkoppeldateien;INT PROCanzahldateien:p10END PROCanzahldateien;BOOL PROCaendernerlaubt:a11END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTw12):aenderungeneintragen;o10(w12).h10END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTw12):o10(w12).nameEND PROCeudasdateiname;INT PROCdateiversion:y10END PROCdateiversion;INT PROCanzahlfelder:u10END PROCanzahlfelder;PROCfeldnamenlesen(
+INT CONSTp0,TEXT VARname):IFp0<=t10THENfeldlesen(o10(1).o2,p0,name)ELSEfeldlesen(x12,y12,name)END IF.x12:o10(d11(p0).x3).o2.y12:d11(p0).p5.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):IFp0<=t10THENfeldbearbeiten(o10(1).o2,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEfeldbearbeiten(x12,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)END IF.x12:o10(d11(p0).x3).o2.y12:d11(p0).p5.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTz12):INT VARa13:=t10,p4:=feldindex(o10(1).o2,z12),y11:=s10;WHILEp4=0ANDy11<>0REPp4:=feldindex(o10(y11).o2,z12);b13;y11:=o10(y11).c10END REP;p4.b13:INT CONSTc13:=o10(y11).b10;IFp4=0THENa13INCRfelderzahl(o10(y11).d10);a13DECRc13ELSEp4INCRa13;p4DECRc13END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTp0):IFp0<=t10THENfeldinfo(o10(1).d10,p0)ELSEfeldinfo(o10(x12).d10,y12)END IF.x12:d11(p0).x3.y12:d11(p0).p5.END PROCfeldinfo;PROCfeldlesen(INT CONSTp0,TEXT VARq0):IFp0<=t10THENfeldlesen(o10(r10).d10,p0,q0)ELSEd13
+END IF.d13:INT CONSTx12:=d11(p0).x3;IFo10(x12).f10THENfeldlesen(o10(x12).e10,y12,q0)ELSEfeldlesen(o10(x12).d10,y12,q0)END IF.y12:d11(p0).p5.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):IFp0<=t10THENfeldbearbeiten(o10(r10).d10,p0,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEe13END IF.e13:INT CONSTx12:=d11(p0).x3;IFo10(x12).f10THENfeldbearbeiten(o10(x12).e10,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)ELSEfeldbearbeiten(o10(x12).d10,y12,PROC(TEXT CONST,INT CONST,INT CONST)u0)END IF.y12:d11(p0).p5.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTp0,TEXT CONSTq0):INT CONSTx12:=d11(p0).x3;IFp0<=t10THENf13ELSEg13END IF.f13:o10(r10).h10:=TRUE;IFh13CANDi13THENj13END IF;feldaendern(o10(r10).d10,p0,q0).h13:x12>0.i13:feldlesen(o10(r10).d10,p0,i3);i3<>q0.j13:INT VARk13:=y12,l13:=x12;REPm13(o10(n13));o10(n13).i10:=TRUE;feldaendern(o10(n13).e10,k12,q0);l13INCR1;k13DECR1UNTILk13=0END REP.g13:m13(o10(x12));IFo13THENo10(x12).g10:=TRUE;feldaendern(o10(x12).e10,y12
+,q0)END IF.o13:feldlesen(o10(x12).e10,y12,i3);i3<>q0.y12:d11(p0).p5.n13:e11(l13).x3.k12:e11(l13).p5.END PROCfeldaendern;PROCm13(DATEI VARx3):IF NOTx3.f10THENx3.f10:=TRUE;p13END IF.p13:IFdateiende(x3.d10)THENsatzinitialisieren(x3.e10,x3.b10);q13ELSEsatzlesen(x3.d10,x3.e10)END IF.q13:INT VARl0;FORl0FROM1UPTOx3.b10REPfeldlesen(x3.a10ISUBl0,i3);feldaendern(x3.e10,l0,i3)END REP.END PROCm13;PROCp12(DATEI VARx3):r13;s13.r13:feldlesen(o10(r10).d10,t13,x1).t13:x3.a10ISUB1.x1:x3.x1.s13:aufsatz(x3.d10,x1);WHILE NOTu13(x3)REPweiter(x3.d10,x1)END REP;IFdateiende(x3.d10)THENm13(x3)ELSEx3.f10:=FALSE END IF.END PROCp12;PROCv13:INT VARy11:=s10;WHILEy11<>0REPp12(o10(y11));y11:=o10(y11).c10END REP;w10:=1END PROCv13;BOOL PROCu13(DATEI CONSTx3):IF NOTdateiende(x3.d10)THENw13END IF;TRUE.w13:INT VARx13;FORx13FROM2UPTOx3.b10REPfeldlesen(o10(r10).d10,a10ISUBx13,i3);feldbearbeiten(x3.d10,x13,PROC(TEXT CONST,INT CONST,INT CONST)y13);IF NOTz13THEN LEAVEu13WITH FALSE END IF END REP.a10:x3.a10.END PROCu13;BOOL VAR
+z13;PROCy13(TEXT CONSTj0,INT CONSTt1,u1):z13:=length(i3)+t1=u1+1CANDpos(j0,i3,t1,u1+1)=t1END PROCy13;LETa14=22101,b14="h",c14=""27"";BOOL VARd14;PROCe14:TEXT VARf14;d14:=FALSE;REPf14:=incharety;type(f14)UNTILf14=e0END REP END PROCe14;PROCg14:IFd14THENtype(c14)END IF END PROCg14;BOOL PROCh14:TEXT VARf14;REPf14:=incharety;IFf14=e0THEN LEAVEh14WITH FALSE ELSEi14END IF END REP;FALSE.i14:IFd14THENd14:=FALSE;j14ELSEk14END IF.j14:IFf14=b14THENl14;errorstop(a14,e0);LEAVEh14WITH TRUE ELSEtype(c14);type(f14)END IF.k14:IFf14=c14THENd14:=TRUE ELSEtype(f14)END IF.l14:REP UNTILgetcharety=e0END REP.END PROCh14;PROCweiter(INT CONSTm14):IF NOTz10THENaenderungeneintragen;n14END IF.n14:SELECTm14OF CASE1:o14CASE2:p14CASE3:q14END SELECT.o14:r14(FALSE).p14:e14;REPr14(b11);cout(satznummer)UNTILsatzausgewaehltORz10ORh14END REP;g14.q14:INT VARs14:=satznr(o10(r10).d10);WHILEt14ANDc10<>0REPu14;s14:=1END REP;aufsatz(o10(r10).d10,v14);cout(satznummer);v13;z10:=dateiende(o10(r10).d10);w14.t14:x14(o10(r10),s14+1);
+INT CONSTv14:=o10(r10).j10ISUBo10(r10).k10;v14<>maxint.c10:o10(r10).c10.END PROCweiter;PROCzurueck(INT CONSTm14):IFsatznummer>1THENaenderungeneintragen;y14END IF.y14:SELECTm14OF CASE1:z14CASE2:a15CASE3:b15END SELECT.z14:c15(FALSE).a15:e14;REPc15(b11);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORh14END REP;g14.b15:INT VARs14:=satznr(o10(r10).d10);WHILEt14ANDr10<>1REPd15;s14:=maxint-1END REP;aufsatz(o10(r10).d10,f6);cout(satznummer);v13;z10:=FALSE;w14.t14:INT VARf6;x14(o10(r10),s14);IFo10(r10).k10=1THENf6:=1;TRUE ELSEf6:=o10(r10).j10ISUB(o10(r10).k10-1);FALSE END IF.END PROCzurueck;PROCr14(BOOL CONSTe15):f15;IFg15THENo14;v13ELSEw10INCR1END IF;w14.f15:INT VARy11:=s10;WHILEy11>0REPh15;y11:=o10(y11).c10END REP.h15:BOOL VARi15;j15(o10(y11),i15);IFi15THEN LEAVEf15END IF.g15:y11=0.o14:IFe15THENweiter(o10(r10).d10,c11)ELSEweiter(o10(r10).d10)END IF;WHILEdateiende(o10(r10).d10)REPk15UNTILz10END REP.k15:IFo10(r10).c10<>0THENu14;l15ELSEz10:=TRUE END IF.l15:aufsatz(o10(r10).d10,1).END PROC
+r14;PROCj15(DATEI VARx3,BOOL VARi15):IFdateiende(x3.d10)THENi15:=FALSE ELSEm15END IF.m15:i15:=TRUE;REPweiter(x3.d10,x3.x1);IFdateiende(x3.d10)THENi15:=FALSE;aufsatz(x3.d10,x3.x1)END IF UNTILu13(x3)END REP.END PROCj15;PROCc15(BOOL CONSTe15):WHILEsatznr(o10(r10).d10)=1CANDsatznummer>1REPd15;n15(o10(r10).d10)END REP;IFe15THENzurueck(o10(r10).d10,c11)ELSEzurueck(o10(r10).d10)END IF;z10:=FALSE;v13;w14END PROCc15;PROCu14:v10INCRsaetze(o10(r10).d10);r10:=o10(r10).c10END PROCu14;PROCd15:INT VARu6:=1;WHILEo10(u6).c10<>r10REPu6:=o10(u6).c10END REP;v10DECRsaetze(o10(u6).d10);r10:=u6END PROCd15;PROCaenderungeneintragen:INT VARy11:=s10;WHILEy11<>0REPo15;y11:=o10(y11).c10END REP.o15:IFo10(y11).f10THENp15(o10(y11))END IF.END PROCaenderungeneintragen;PROCp15(DATEI VARx3):IFq15AND NOTr15THENs15ELIFt15ANDu15THENv15ELIFr15THENp12(x3)END IF;w15;g10:=FALSE;r15:=FALSE.q15:NOTdateiende(x3.d10)ANDg10.t15:felderzahl(e10)>x3.b10.u15:r15ORg10.v15:h10:=TRUE;feldlesen(e10,1,x3.x1);satzeinfuegen(x3.d10,e10).w15:x3.
+f10:=FALSE.s15:h10:=TRUE;satzaendern(x3.d10,e10).g10:x3.g10.r15:x3.i10.e10:x3.e10.h10:x3.h10.END PROCp15;PROCn15(EUDAT VARd10):aufsatz(d10,saetze(d10)+1)END PROCn15;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;r10:=1;v10:=0;WHILEx15ANDy15REPu14END REP;aufsatz(o10(r10).d10,satznr-v10);v13;z10:=dateiende(o10(r10).d10);w14.x15:satznr-v10>saetze(o10(r10).d10).y15:o10(r10).c10<>0.END PROCaufsatz;INT PROCsatznummer:v10+satznr(o10(r10).d10)END PROCsatznummer;INT PROCsatzkombination:w10END PROCsatzkombination;BOOL PROCdateiende:z10END PROCdateiende;SATZ VARy3;satzinitialisieren(y3);PROCsatzeinfuegen:aenderungeneintragen;z15;satzeinfuegen(o10(r10).d10,y3);o10(r10).h10:=TRUE;a16;z10:=FALSE;w14.z15:x14(o10(r10),satznr(o10(r10).d10));q11(o10(r10).j10,o10(r10).k10,1).a16:w10:=1;INT VARy11:=s10;WHILEy11<>0REPn15(o10(y11).d10);y11:=o10(y11).c10END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTz10THENaenderungeneintragen;b16;satzloeschen(o10(r10).d10);o10(r10).h10:=TRUE;aufsatz(satznummer)END 
+IF.b16:IFsatzmarkiertTHENdelete(o10(r10).j10,o10(r10).k10);x10DECR1END IF;q11(o10(r10).j10,o10(r10).k10,-1).END PROCsatzloeschen;LETc16=100;ROWc16STRUCT(INTp5,d16,e16,f16,TEXTx1)VARg16;INT VARh16,i16,j16:=1;BOOL VARk16,l16;suchbedingungloeschen;INT VARm16;LETn16=1,o16=2,p16=3,q16=4,r16=5,s16=6,t16=7,u16=8,v16=9;PROCw14:IFz10THENl16:=FALSE ELSEw16;l16:=x16END IF.w16:m16:=i16;WHILEm16>0REPfeldbearbeiten(y16,PROC(TEXT CONST,INT CONST,INT CONST)z16)END REP.y16:g16(m16).p5.x16:m16<0.END PROCw14;PROCz16(TEXT CONSTj0,INT CONSTq5,r5):IFa17THENm16:=g16(m16).e16ELSEm16:=g16(m16).f16END IF.a17:SELECTg16(m16).d16OF CASEn16:b17CASEo16:c17CASEp16:d17CASEq16:e17CASEr16:f17CASEs16:g17CASEt16:h17CASEu16:i17CASEv16:j17OTHERWISE FALSE END SELECT.b17:SELECTk17OF CASE0:l17;i3LEXEQUALx1CASE1:l17;m17=n17OTHERWISElength(x1)=r5-q5+1ANDc17END SELECT.c17:pos(j0,x1,q5,r5+1)=q5.d17:pos(j0,x1,r5+1-length(x1),r5+1)>0.e17:pos(j0,x1,q5,r5+1)>0.f17:l17;SELECTk17OF CASE0:x1LEXGREATERi3CASE1:m17<n17CASE2:o17;i3<x1
+OTHERWISEi3<x1END SELECT.g17:l17;SELECTk17OF CASE0:i3LEXGREATEREQUALx1CASE1:m17>=n17CASE2:o17;i3>=x1OTHERWISEi3>=x1END SELECT.h17:q5<=r5.i17:satzmarkiert.j17:TRUE.l17:i3:=subtext(j0,q5,r5).END PROCz16;TEXT PROCx1:g16(m16).x1END PROCx1;PROCo17:IFlength(i3)=8THEN TEXT CONSTp17:=subtext(i3,7,8);replace(i3,7,subtext(i3,1,2));replace(i3,1,p17)ELSEi3:=e0END IF END PROCo17;INT PROCk17:feldinfo(g16(m16).p5)END PROCk17;REAL PROCm17:REAL VARd8;wertberechnen(i3,d8);d8END PROCm17;REAL PROCn17:REAL VARd8;wertberechnen(x1,d8);d8END PROCn17;LETq17=";",r17=",",s17="..",t17="++",u17="--",v17="*";BOOL VARw17,x17,y17;INT VARz17,a18,b18,c18,d18;INTVEC VARe18;PROCsuchbedingung(INT CONSTp0,TEXT CONSTg16):INT VARt1:=1,f18:=0;INT CONSTg18:=length(g16)+1;a18:=0;d18:=p0;z17:=h16+1;WHILEt1<g18REPh18;i18;t1:=u1+2END REP.h18:INT VARj18:=pos(g16,r17,t1);IFj18=0THENj18:=g18END IF;IFf18<t1THENk18END IF;INT CONSTu1:=min(j18,f18)-1.k18:a18INCR1;w17:=TRUE;IFa18>1THENb11:=FALSE END IF;f18:=pos(g16,q17,t1);IFf18=0THENf18
+:=g18END IF.i18:l18;x17:=TRUE;INT CONSTm18:=pos(g16,s17,t1,u1+1);IFn18THENo18(e0,v16,-a18)ELIFm18=0THENe9ELSEp18END IF.l18:IFsubtext(g16,t1,t1+1)=u17THENt1INCR2;y17:=TRUE ELSEy17:=FALSE END IF.n18:t1>u1.e9:IFq18THENr18ELSEs18END IF.q18:t1+1=u1CANDsubtext(g16,t1,u1)=t17.r18:o18(e0,u16,-a18).s18:INT VARt18:=pos(g16,v17,t1,u1+1);IFt18=0THENu18ELIFt1=u1THENv18ELSEw18;REPx18END REP END IF.u18:IFy18AND NOTb11THENb11:=TRUE;c11:=g16END IF;o18(subtext(g16,t1,u1),n16,-a18).y18:p0=1ANDt1=1ANDu1=g18-1.v18:o18(e0,t16,-a18).w18:INT VARd16;IFt18=t1THENd16:=n16ELSEd16:=o16END IF.x18:IFd16<>n16THENz18END IF;t1:=t18+1;t18:=pos(g16,v17,t1,u1+1);IFt18=0THENt18:=u1+1;d16:=p16ELSEd16:=q16END IF.z18:TEXT CONSTx1:=subtext(g16,t1,t18-1);IFy17ORa19THEN IFy17THENx17:=TRUE END IF;o18(x1,d16,-a18);IFa19THEN LEAVEs18END IF ELSEo18(x1,d16,h16+2)END IF.a19:t18>=u1.p18:TEXT CONSTb19:=subtext(g16,t1,m18-1),c19:=subtext(g16,m18+2,u1);IFm18=t1THENo18(c19,r16,-a18)ELIFm18=u1-1THENo18(b19,s16,-a18)ELSEd19END IF.d19:IFy17
+THENo18(b19,s16,-a18);x17:=TRUE ELSEo18(b19,s16,h16+2)END IF;o18(c19,r16,-a18).END PROCsuchbedingung;PROCo18(TEXT CONSTe19,INT CONSTd16,e16):f19;g19;IFw17THENh19;i19;c18:=h16ELIFx17THENj19END IF;k19;l19.f19:k16:=FALSE;IFh16=0THENj16INCR1;IFj16>32000THENj16:=1END IF END IF.g19:IFh16=c16THENsuchbedingungloeschen;errorstop(o11)ELSEh16INCR1;i16:=1END IF.h19:IFa18>length(e18)DIV2THENe18CATh16;m19(1,0,h16)END IF;IFa18=length(e18)DIV2THENb18:=0ELSEb18:=e18ISUB(a18+1)END IF.i19:m19(1,-a18,h16);w17:=FALSE;x17:=FALSE.j19:m19(c18,b18,h16);c18:=h16;x17:=FALSE.k19:g16(h16).x1:=e19;INT CONSTn19:=feldinfo(d18);IFn19=2AND(d16=r16ORd16=s16)THENi3:=g16(h16).x1;o17;g16(h16).x1:=i3END IF.l19:g16(h16).d16:=d16;g16(h16).p5:=d18;IFy17THENg16(h16).e16:=b18;g16(h16).f16:=e16ELSEg16(h16).e16:=e16;g16(h16).f16:=b18END IF.END PROCo18;PROCm19(INT CONSTq5,wert,o19):INT VARl0;FORl0FROMq5UPTOh16-1REP IFg16(l0).e16=wertTHENg16(l0).e16:=o19ELIFg16(l0).f16=wertTHENg16(l0).f16:=o19END IF END REP END PROCm19;PROC
+suchbedingungloeschen:disablestop;h16:=0;i16:=-1;e18:=m3;b11:=FALSE;k16:=TRUE;l16:=NOTz10END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTk16THENw14;k16:=TRUE END IF;l16END PROCsatzausgewaehlt;INT PROCsuchversion:IFh16=0THEN0ELSEj16END IF END PROCsuchversion;PROCx14(DATEI VARx3,INT CONSTj0):IF(x3.j10ISUBx3.k10)<j0THENu4ELSEv4END IF.u4:REPx3.k10INCR1UNTIL(x3.j10ISUBx3.k10)>=j0END REP.v4:WHILEx3.k10>1CAND(x3.j10ISUB(x3.k10-1))>=j0REPx3.k10DECR1END REP.END PROCx14;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete(o10(r10).j10,o10(r10).k10);x10DECR1ELSEinsert(o10(r10).j10,o10(r10).k10,satznr(o10(r10).d10));x10INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTj0:=satznr(o10(r10).d10);x14(o10(r10),j0);j0=(o10(r10).j10ISUBo10(r10).k10)END PROCsatzmarkiert;INT PROCmarkiertesaetze:x10END PROCmarkiertesaetze;PROCmarkierungenloeschen:disablestop;INT VARy11:=1;REPw11(o10(y11));y11:=o10(y11).c10UNTILy11=0END REP;x10:=0END PROCmarkierungenloeschen;PROCw11(
+DATEI VARx3):x3.j10:=e0;x3.j10CATmaxint;x3.k10:=1END PROCw11;END PACKETdatenverwaltung;
+
diff --git a/app/eudas/3.4/src/eudas.2 b/app/eudas/3.4/src/eudas.2
new file mode 100644
index 0000000..427b4f8
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.2
@@ -0,0 +1,25 @@
+PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0="  ";TEXT VARm0;PROCinterpretiere(INT CONSTn0,o0,PROC(INT CONST,TEXT VAR)p0):INT VARq0,r0:=0,s0:=0,t0:=o0;u0(n0);WHILE NOTv0REPw0;IFx0THENr0INCR1ELSEy0;z0END IF END REP.z0:IFa1(q0)THENb1ELSEc1;s0:=0END IF.b1:SELECTq0OF CASEd1:e1CASEf1:g1OTHERWISE LEAVEinterpretiereEND SELECT.y0:WHILEr0>0REPh1(k0);r0DECR1END REP.e1:i1(i0).g1:i1(s0).x0:j1=j0ORj1=k0.c1:INT VARk1:=0,l1:=0;BOOL VARm1:=FALSE;REPn1;k1INCR1;IFi0=3THENm1:=TRUE END IF UNTILo1END REP.o1:IFi0<=2THEN TRUE ELIFs0<>0THENk1=s0ELSEl1=0END IF.n1:INT VARp1:=1,q1:=0,r1:=0,s1:=1,t1:=1;m0:=j0;REP IFu1THENv1END IF;IFw1THENx1END IF;y1;s1INCR1END REP.u1:k1=0.v1:z1(a2.c0,a2.d0,a2.e0);IF NOTb2THENc2END IF.b2:a2.c0>length(j1).c2:INT CONSTd2:=e2(t0);IFd2>0THENfeldlesen(d2,a2.g0)ELSEp0(-d2,a2.g0)END IF;t0INCR1;a2.f0:=0;IFa2.g0<>j0THENl1
+INCR1END IF.w1:a2.e0>=4.a2:h0(s1).y1:INT CONSTf2:=g2(a2);IFf2>0THENh2ELSEr1DECRf2END IF.h2:q1INCRf2;IFi2ANDq1>r1THENq1:=r1END IF;IFj2ANDk2THENl2END IF.i2:i0=2ORi0=4.j2:f2=a2.d0.k2:(a2.e0AND1)=0.l2:IF(j1SUB(a2.c0-1))=k0THEN INT VARm2:=n2(s1);WHILE(j1SUBm2)=k0REPm2INCR1;a2.d0INCR1;q1INCR1END REP END IF.x1:IFs1=1THEN IFb2THENo2END IF ELSEp2END IF.o2:IFm1THENh1(k0)ELSEh1(j1)END IF;LEAVEn1.p2:INT VARq2:=0,r2:=a2.c0;INT CONSTs2:=r2-length(j1);t2;u2;v2;w2.t2:IFs2>0THENq1INCRs2;r2DECR(s2-1)END IF;x2.x2:INT CONSTy2:=n2(s1-1),z2:=pos(j1,l0,y2,r2);IFz2>0THENr2:=z2;a3ELIFs2<0AND(j1SUB(r2-1))<>k0THENr2:=y2END IF.a3:INT VARb3:=r2+1;REPq2INCR1;b3INCR1UNTIL(j1SUBb3)<>k0END REP;q1INCRq2.u2:INT VARc3:=0;WHILEt1<s1REPd3;e3;f3;t1INCR1END REP.d3:INT CONSTc0:=g3.c0,d0:=g3.d0,e0:=g3.e0.e3:h3(p1,c0,m1);p1:=c0+d0.g3:h0(t1).f3:INT CONSTi3:=-g2(g3);IFi3=-d0ANDj3THENk3ELIFi3<=0THENl3ELIFj3ANDm3THENn3ELSEo3END IF.k3:c3INCRi3;IFi2THENp3END IF.p3:IFc3<0THENq3(-c3);c3:=0END IF.l3:IFr3THENq3(-i3)END IF;s3(g3);l1DECR1;
+IFt3THENu3ELSEc3INCRi3;v3END IF.r3:(e0AND2)=2.t3:(e0AND1)=1.u3:IF NOTr3THENq3(-i3)END IF.v3:IFi2ANDc3<0THENq3(-c3);c3:=0END IF.j3:NOTt3.m3:i3<=q1.n3:s3(g3);l1DECR1;c3INCRi3;q1DECRi3.o3:INT VARw3:=0,x3:=g3.f0+1,y3:=x3+d0-1;IFj3THENy3INCRq1END IF;IFr3ANDz3THENa4ELIFb4THENc4END IF;d4;IFj3THENc3INCRq1;q1:=0END IF.a4:INT CONSTe4:=length(g3.g0)-y3;x3INCRe4;y3INCRe4.b4:i0>=3.z3:NOTb4.d4:IFr3THENq3(w3)END IF;f4(g3.g0,x3,y3);IFg4THENq3(w3)END IF.g4:NOTr3.c4:IFpos(g3.g0,k0,x3,y3+1)>0THENh4END IF;INT CONSTi4:=pos(g3.g0,"!","�",y3+1);IFi4=0THENg3.f0:=length(g3.g0);l1DECR1ELSEg3.f0:=i4-1END IF.h4:y3INCR1;w3DECR1;WHILE(g3.g0SUBy3)<>k0REPy3DECR1;w3INCR1END REP;WHILE(g3.g0SUBy3)=k0REPy3DECR1;w3INCR1UNTILm2<x3END REP.v2:h3(p1,r2,m1);IFc3<0THEN IFr2<=length(j1)THENq3(-c3)END IF;p1:=r2ELSEp1:=r2+min(c3,q2)END IF.w2:IFs2>0THENj4;k4;LEAVEn1ELSEl4END IF.j4:IF NOTm1THENf4(j1,p1,length(j1))END IF.k4:INT VARm4:=length(m0);IF(m0SUBm4)=k0THEN REPm4DECR1UNTIL(m0SUBm4)<>k0END REP;m0:=subtext(m0,1,m4)END IF;IFn4
+THENm0CATk0END IF;h1(m0).n4:(j1SUB LENGTHj1)=k0AND(i0<3ORl1=0).l4:q1:=0;r1:=0.END PROCinterpretiere;INT PROCn2(INT CONSTo4):h0(o4).c0+h0(o4).d0END PROCn2;INT PROCg2(SPEICHER CONSTp4):p4.d0-length(p4.g0)+p4.f0END PROCg2;LETq4="          ";PROCq3(INT CONSTr4):INT VARs4:=r4;WHILEs4>=10REPm0CATq4;s4DECR10END REP;WHILEs4>0REPm0CATk0;s4DECR1END REP END PROCq3;PROCs3(SPEICHER VARp4):IFp4.f0=0THENm0CATp4.g0ELSEf4(p4.g0,p4.f0+1,length(p4.g0))END IF;p4.f0:=length(p4.g0)END PROCs3;PROCh3(INT CONSTt4,u4,BOOL CONSTm1):IFm1THENq3(u4-t4)ELSEf4(j1,t4,u4-1)END IF END PROCh3;TEXT VARv4;PROCf4(TEXT CONSTw4,INT CONSTt4,u4):v4:=subtext(w4,t4,u4);m0CATv4END PROCf4;FILE VARx4;TEXT VARj1;INT VARy4;LETz4="keine schliessende Klammer in Feldmuster",a5="kein Kommando in Kommandozeile",b5="unbekanntes Kommando";LETc5="&",d5="%",e5="%",f5="<",g5=">";LETh5=" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETi5=1,j5=2,k5=3,l5=4,m5=5,d1=6,f1=7,n5=100;
+INT VARo5,p5,q5;BOOL VARv0,r5;.s5:lineno(x4).t5:o5:=maxlinelength(x4).PROCu5(TEXT CONSTv5):REPy4INCR1UNTIL(j1SUBy4)<>v5END REP END PROCu5;PROCz1(INT VARx3,w5,e0):x5;IFb2THENx3:=max(o5,length(j1))+1;w5:=0;e0:=5ELSEx3:=y4;y5END IF.x5:z5(c5,d5).b2:y4>length(j1).y5:TEXT CONSTa6:=j1SUBy4;IFa6=d5THENe0:=0ELSEe0:=4END IF;b6;feldnamenlesen;c6.b6:u5(a6);IFy4-1>x3THENd6END IF.d6:e0INCR3.feldnamenlesen:IF(j1SUBy4)=f5THENe6ELSEf6END IF;IFg6THENz1(x3,w5,e0);LEAVEz1END IF.g6:p5>q5.e6:p5:=y4+1;q5:=pos(j1,g5,p5);IFq5=0THENh6(z4,subtext(j1,y4));q5:=length(j1)ELSEq5DECR1END IF;y4:=q5+2.f6:p5:=y4;z5(k0,d5);INT CONSTi6:=pos(j1,c5,p5,y4);IFi6>0THENy4:=i6END IF;q5:=y4-1.c6:IFj6THENk6;u5(a6)END IF;w5:=y4-x3.j6:(j1SUBy4)=a6.k6:e0:=e0OR1.END PROCz1;PROCz1(TEXT VARname):INT VARl6,w5,m6;z1(l6,w5,m6);IFw5>0THENname:=subtext(j1,p5,q5)ELSEname:=j0END IF END PROCz1;PROCz5(TEXT CONSTn6,o6):INT CONSTp6:=pos(j1,n6,y4),q6:=pos(j1,o6,y4);y4:=length(j1)+1;IFp6>0THENy4:=p6END IF;IFq6>0ANDq6<y4THENy4:=q6END IF END PROCz5;
+PROCu0(INT CONSTr6):toline(x4,r6);r5:=FALSE;v0:=eof(x4)END PROCu0;PROCw0:IFr5THENdown(x4)ELSEr5:=TRUE END IF;readrecord(x4,j1);y4:=1;v0:=lineno(x4)>=lines(x4)END PROCw0;BOOL PROCa1(INT VARq0):y4:=1;IF(j1SUB1)<>e5THEN FALSE ELIF(j1SUB2)<>e5THENs6;t6;TRUE ELSEq0:=n5;TRUE END IF.s6:TEXT VARu6;u5(k0);IFy4>length(j1)THENh6(a5,j1);q0:=0;LEAVEa1WITH TRUE END IF;INT CONSTv6:=pos(j1,k0,y4);IFv6=0THENu6:=subtext(j1,y4);u6CATk0;y4:=length(j1)+1ELSEu6:=subtext(j1,y4,v6);y4:=v6END IF.t6:INT CONSTw6:=pos(h5,u6);IFw6>0CAND(h5SUB(w6-2))=k0THENq0:=code(h5SUB(w6-1))ELSEq0:=0;h6(b5,u6);END IF.END PROCa1;PROCi1(INT VARx6):u5(k0);INT CONSTy6:=y4;WHILEz6REPy4INCR1END REP;IFy4>y6THENx6:=int(subtext(j1,y6,y4-1))ELSEx6:=-1END IF.z6:pos("0123456789",j1SUBy4)>0.END PROCi1;FILE VARa7;TEXT VARb7;BOOL VARc7;PROCd7(TEXT CONSTname):b7:=name;e7("PROC ",name," :")END PROCd7;PROCf7:e7("END PROC ",b7,";")END PROCf7;PROCg7(TEXT CONSTh7):c7:=TRUE;putline(a7,h7)END PROCg7;PROCg7(TEXT CONSTi7,j7,k7):c7:=TRUE;e7(i7,j7,k7)END 
+PROCg7;PROCe7(TEXT CONSTi7,j7,k7):write(a7,i7);write(a7,j7);write(a7,k7);line(a7)END PROCe7;TEXT VARl7;PROCg7(TEXT CONSTi7,INT CONSTm7,TEXT CONSTk7):l7:=subtext(j1,m7);g7(i7,l7,k7)END PROCg7;PROCn7(INT CONSTr6,o7):e7(";  interpretiere (",text(r6)+", "+text(o7),", PROC (INT CONST, TEXT VAR) abk);")END PROCn7;LETp7="kein % WIEDERHOLUNG gefunden",q7="Nur GRUPPE-Anweisung erlaubt",r7="keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",s7="illegale Gruppennummer",t7="diese Gruppe wurde schon definiert",u7="diese Abkuerzung ist nicht definiert",v7="dieser Abschnitt wurde schon einmal definiert",w7="falscher Modus",x7="diese Anweisung darf im Musterteil nicht vorkommen",y7="im Abkuerzungsteil darf keine Anweisung auftreten",z7="in dieser Zeile stehen zu viele Feldmuster",a8="das Druckmuster enthaelt zu viele Feldmuster",b8="nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",c8="kein Doppelpunkt nach Abkuerzung",d8="Abkuerzung mehrfach definiert",e8=
+"das Druckmuster enthaelt zu viele Abkuerzungen";LETf8=200,g8=4,h8=250,GRUPPE=STRUCT(BOOLi8,j8,TEXTg0),ABSCHNITT=STRUCT(INTo0,n0,TEXTd7);ROWf8INT VARe2;INT VARk8;ROWg8GRUPPE VARl8;ROW3ABSCHNITT VARm8;SATZ VARp0;TEXT VARn8;INT VARo8;OP CAT(TEXT VARp8,INT CONSTwert):TEXT VARq8:="  ";replace(q8,1,wert);p8CATq8END OP CAT;PROCr8:enablestop;u0(1);s8;t8;WHILE NOTv0REPu8END REP;v8.s8:INT VARq0;INT VARw8;o8:=0;satzinitialisieren(p0);n8:=j0;k8:=0;c7:=FALSE;m8(1):=ABSCHNITT:(0,0,"vorspann");m8(2):=ABSCHNITT:(0,0,"wdh");m8(3):=ABSCHNITT:(0,0,"nachspann");FORw8FROM1UPTOg8REPl8(w8).j8:=FALSE END REP.t8:BOOL VARx8:=FALSE;REP IFv0THENh6(p7);LEAVEr8END IF;w0;IFa1(q0)THENy8END IF END REP.y8:SELECTq0OF CASEn5:z8CASEm5:a9CASEi5,j5,k5:IF NOTx8THENd7("gruppen")END IF;f7;LEAVEt8OTHERWISE IFq0>0THENh6(q7)END IF END SELECT.z8:IFx8THENh6(r7,j1)ELSEreplace(j1,1,"  ");g7(j1)END IF.a9:IF NOTx8THENd7("gruppen");x8:=TRUE END IF;INT VARb9;i1(b9);IFb9<1ORb9>g8THENh6(s7,"GRUPPE")ELIFl8(b9).j8THENh6(t7,"GRUPPE")ELSEl8(
+b9).j8:=TRUE;c9END IF.c9:g7("gruppentest (",text(b9),", ");g7("            ",y4,");").u8:SELECTq0OF CASEi5:d9CASEj5:e9CASEk5:f9END SELECT.d9:g9(m8(1),q0).e9:i1(h9);i1(i9);g9(m8(2),q0).f9:g9(m8(3),q0).v8:IFc7THENj9;k9END IF;l9;IFc7THENm9;n9END IF.l9:FORw8FROM1UPTOo8REP IF(n8ISUBw8)>0THENh6(u7,o9,n8ISUBw8)ELSEp9END IF END REP.o9:TEXT VARq9;feldlesen(p0,w8,q9);q9.j9:FORw8FROM1UPTO3REP IFm8(w8).n0=0THENr9END IF END REP.r9:d7(m8(w8).d7);f7.k9:g7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFo8>0THENg7("SELECT nr OF")END IF.p9:TEXT CONSTs9:=text(w8);g7("CASE "+s9," : inhalt := abk",s9).m9:IFo8>0THENg7("END SELECT")END IF;g7("END PROC abk;").n9:g7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCr8;PROCg9(ABSCHNITT VARt9,INT VARq0):BOOL VARu9:=TRUE;d7(t9.d7);v9;w9;x9.v9:IFt9.n0<>0THENh6(v7,j1)END IF;t9.n0:=s5+1;t9.o0:=k8+1.w9:WHILE NOTv0REPw0;IFa1(q0)THENy9ELSEz9;a10END IF END REP;b10;LEAVEg9.y9:SELECTq0OF CASEn5:replace(j1,1,"  ");g7(j1);u9:=TRUE CASEi5,j5,k5:b10;
+LEAVEg9CASEl5:b10;LEAVEw9CASEd1:z9;INT VARc10;i1(c10);IFc10<1ORc10>4THENh6(w7,j1)END IF CASEf1:z9OTHERWISE IFq0>0THENh6(x7)END IF END SELECT.z9:IFu9THENn7(s5,k8+1);u9:=FALSE END IF.b10:f7.a10:TEXT VARname;INT VARd10:=0;REPz1(name);IFname=j0THEN LEAVEa10END IF;d10INCR1;e10END REP.e10:IFd10>=b0THENh6(z7)END IF;IFk8=f8THENh6(a8)ELSEk8INCR1END IF;f10.f10:INT VARg10:=feldnummer(name);IFg10=0THENg10:=feldindex(p0,name);IFg10=0THENh10(name,s5);e2(k8):=-o8ELSEe2(k8):=-g10END IF ELSEe2(k8):=g10END IF.x9:BOOL VARi10:=TRUE;WHILE NOTv0REPw0;IFa1(q0)THENj10ELIFk10THENl10END IF END REP.j10:SELECTq0OF CASEi5,j5,k5:LEAVEx9OTHERWISE IFq0>0THENh6(y7)END IF END SELECT.l10:IFi10THENg7(".");i10:=FALSE END IF;IFm10THENn10ELSEg7(j1)END IF.m10:(j1SUB1)=c5.n10:TEXT VARo10;z1(o10);IFo10=j0THENh6(b8,j1);LEAVEn10END IF;p10;q10.p10:LETr10=":";y4DECR1;u5(k0);IF(j1SUBy4)=r10THENy4INCR1ELSEh6(c8,j1)END IF.q10:h10(o10,0);g7(s10,y4-1,"").s10:"abk"+text(feldindex(p0,o10)).k10:j1<>j0ANDj1<>k0.END PROCg9;PROCh10(TEXT 
+CONSTname,INT CONSTr6):INT CONSTt10:=feldindex(p0,name);IFt10>0THENu10ELSEv10END IF.u10:IF(n8ISUBt10)>0THENreplace(n8,t10,r6)ELIFr6=0THENh6(d8,name)END IF.v10:IFo8=h8THENh6(e8)ELSEo8INCR1END IF;n8CATr6;feldaendern(p0,o8,name).END PROCh10;PROCh6(TEXT CONSTw10,x10,INT CONSTr6):LETy10="   ";TEXT VARz10:="FEHLER in Zeile ";z10CATtext(r6);IFx10<>j0THENz10CAT" bei >>";z10CATx10;z10CAT"<<"END IF;note(z10);noteline;note(y10);note(w10);noteline;IFonlineANDcommanddialogueTHENline;putline(z10);put(y10);putline(w10)END IF END PROCh6;PROCh6(TEXT CONSTw10):h6(w10,j0,s5)END PROCh6;PROCh6(TEXT CONSTw10,x10):h6(w10,x10,s5)END PROCh6;LETa11="keine Datei geoeffnet",b11="interner Fehler",c11="direkt Drucken nicht moeglich";TEXT VARd11,e11;BOOL VARf11,g11,h11,i11;FILE VARj11;INT VARh9,i9,k11,l11,m11,n11:=4000,o11;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTp11):enablestop;lastparam(p11);x4:=sequentialfile(input,p11);modify(x4);IFanzahldateien=0THENerrorstop(a11)END IF;disablestop;q11;r8
+;IFanythingnotedTHENnoteedit(x4)ELIFc7THENr11ELSEdrucke(PROCs11,PROCt11,PROCu11,PROCv11)END IF;forget(w11,quiet).q11:TEXT VARw11;INT VARw8:=0;REPw8INCR1;w11:=text(w8)UNTIL NOTexists(w11)END REP;a7:=sequentialfile(output,w11);headline(a7,"erzeugtes Programm").r11:run(w11);lastparam(p11).END PROCdrucke;PROCs11:END PROCs11;PROCt11:x11(1)END PROCt11;PROCu11:x11(2)END PROCu11;PROCv11:x11(3)END PROCv11;PROCx11(INT CONSTy11):IFm8(y11).n0>0THENinterpretiere(m8(y11).n0,m8(y11).o0,PROC(INT CONST,TEXT VAR)z11)END IF END PROCx11;PROCz11(INT CONSTy11,TEXT VARg0):errorstop(b11);g0:=code(y11)END PROCz11;PROCdrucke(PROCa12,PROCb12,PROCc12,PROCd12):INT VARe12,f12,g12;enablestop;h12;i12;j12;o11:=1;WHILE NOTdateiendeREPk12;cout(satznummer);l12;weiter(e12);m12END REP;n12;o12;aufsatz(1).i12:f12:=0;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF.j12:INT VARw8;FORw8FROM1UPTOg8REPl8(w8).g0:=j0END REP.k12:IFf12=0THEN
+a12;p12;q12(PROCb12)ELSEg11:=FALSE;r12;s12END IF;f12:=satznummer;g12:=satzkombination.r12:f11:=FALSE;a12.s12:IFf11THENt12(f12,g12,PROCd12)END IF;o11INCR1;IFf11THENq12(PROCb12)END IF.l12:IFi9<1THENt5ELSEo5:=i9END IF;IFk11<h9THENtoline(j11,l11)ELSEtoeof(j11);l11:=lineno(j11);k11:=0END IF;i0:=1;c12;k11INCR1.m12:IFm11>n11THENo12;h12END IF.n12:p12;IFf12=0THENq12(PROCd12)ELSEt12(f12,g12,PROCd12)END IF;u0(1).END PROCdrucke;PROCp12:INT VARw8;FORw8FROM1UPTOg8REPl8(w8).i8:=TRUE END REP;g11:=TRUE;f11:=TRUE END PROCp12;PROCq12(PROCt9):k11:=h9;toeof(j11);t5;i0:=1;t9END PROCq12;PROCt12(INT CONSTf12,g12,PROCd12):INT CONSTu12:=satznummer,v12:=satzkombination;aufsatz(f12);WHILEsatzkombination<>g12REPweiter(1)END REP;q12(PROCd12);aufsatz(u12);WHILEsatzkombination<>v12REPweiter(1)END REP END PROCt12;PROCh12:IF NOTh11THENw12END IF;j11:=sequentialfile(modify,e11);maxlinelength(j11,maxlinelength(x4));m11:=lines(j11);x12.w12:INT VARs4:=0;REPs4INCR1;e11:="EUDAS-Ausgabe."+text(s4);UNTIL NOTexists(e11)END REP.
+x12:u0(1);WHILE NOTv0REPy12END REP.y12:w0;INT VARq0;IFa1(q0)THENz12ELSEh1(j1)END IF.z12:IFq0<>n5ANDq0<>m5THEN LEAVEx12END IF.END PROCh12;PROCo12:IFh11THENh11:=FALSE ELIFi11THENdisablestop;a13END IF.a13:TEXT CONSTx6:=std;lastparam(e11);do("print (std)");IFiserrorTHENclearerror;errorstop(c11)ELSEforget(e11,quiet)END IF;lastparam(x6).END PROCo12;PROCh1(TEXT CONSTr6):IFk11>=h9ORk11=0THENinsertrecord(j11);writerecord(j11,r6);m11INCR1ELSEb13END IF;down(j11).b13:IFeof(j11)THENd11:=j0;insertrecord(j11);m11INCR1ELSEreadrecord(j11,d11)END IF;c13;writerecord(j11,d11).c13:INT CONSTd13:=o5*k11;WHILElength(d11)<d13REPd11CATk0END REP;d11CATr6.END PROCh1;PROCdirektdrucken(BOOL CONSTe12):i11:=e12END PROCdirektdrucken;BOOL PROCdirektdrucken:i11END PROCdirektdrucken;PROCdruckdatei(TEXT CONSTp11):e11:=p11;h11:=TRUE END PROCdruckdatei;PROCmaxdruckzeilen(INT CONSTe13):n11:=e13END PROCmaxdruckzeilen;PROCgruppentest(INT CONSTb9,TEXT CONSTf13):IFf13<>l8(b9).g0THENl8(b9).g0:=f13;l8(b9).i8:=TRUE;f11:=TRUE ELSEl8
+(b9).i8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTb9):IFb9>0THENl8(b9).i8ELSEg11END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(o11)END PROClfdnr;END PACKETeudasdrucken;
+PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARg13,h13,i13;INT VARj13;BOOL VARk13;LETj0="",INTVEC=TEXT;INTVEC VARl13;TEXT VARm13:="  ";OP CAT(INTVEC VARp8,INT CONSTn13):replace(m13,1,n13);p8CATm13END OP CAT;PROCstdkopiermuster(TEXT CONSTp11,FILE VARo13):p13;INT VARq13;r13;s13;INT VARg10;FORg10FROM1UPTOq13REPt13;IFu13THENv13ELSEw13END IF END REP.r13:output(o13);EUDAT VARx13;IFexists(p11)THENoeffne(x13,p11)END IF.s13:IFexists(p11)CANDfelderzahl(x13)>0THENfeldnamenlesen(x13,g13);q13:=felderzahl(x13)ELSEy13;q13:=anzahlfelderEND IF.y13:TEXT VARz13;satzinitialisieren(g13);FORg10FROM1UPTOanzahlfelderREPfeldnamenlesen(g10,z13);feldaendern(g13,g10,z13)END REP.u13:feldnummer(z13)>0.t13:feldlesen(g13,g10,z13);put(o13,textdarstellung(z13)).v13:write(o13,"K f(");write(o13,textdarstellung(z13));putline(o13,");").w13:putline(o13,"K """";").END PROCstdkopiermuster;PROCkopiere(
+TEXT CONSTp11,FILE VARo13):a14(b14,o13).b14:"kopiere ("+textdarstellung(p11)+", ".END PROCkopiere;PROCa14(TEXT CONSTc14,FILE VARo7):q11;write(a7,c14);putline(a7,"PROC programmfunktion);");putline(a7,"PROC programmfunktion:");d14;putline(a7,"END PROC programmfunktion");e14;forget(w11,quiet).q11:TEXT VARw11;INT VARw8:=0;REPw8INCR1;w11:=text(w8)UNTIL NOTexists(w11)END REP;disablestop;FILE VARa7:=sequentialfile(output,w11);headline(a7,f14).d14:TEXT VARr6;input(o7);WHILE NOTeof(o7)REPgetline(o7,r6);putline(a7,r6)END REP.e14:TEXT CONSTg14:=std;run(w11);lastparam(g14).END PROCa14;PROCkopiere(TEXT CONSTp11,PROCh14):p13;k13:=TRUE;EUDAT VARx13;oeffne(x13,p11);aufsatz(x13,saetze(x13)+1);feldnamenlesen(x13,h13);l13:=j0;INT VARe12;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF;WHILE NOTdateiendeREPsatzinitialisieren(i13);j13:=1;h14;i14;satzeinfuegen(x13,i13);weiter(x13);weiter(e12)END REP;aufsatz(1).i14:
+IFk13THENfeldnamenaendern(x13,h13);k13:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTz13,j14):IFk13THENk14;END IF;feldaendern(i13,l13ISUBj13,j14);j13INCR1.k14:INT VARl14:=feldindex(h13,z13);IFl14=0THENl14:=felderzahl(h13)+1;feldaendern(h13,l14,z13);END IF;l13CATl14.END OP K;PROCverarbeite(FILE VARm14):a14("verarbeite (",m14)END PROCverarbeite;PROCverarbeite(PROCn14):p13;INT VARe12;aufsatz(1);IFmarkiertesaetze>0THENe12:=3;IF NOTsatzmarkiertTHENweiter(e12)END IF ELSEe12:=2;IF NOTsatzausgewaehltTHENweiter(e12)END IF END IF;WHILE NOTdateiendeREPn14;weiter(e12)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTz13,j14):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13)ELSEfeldaendern(y11,j14)END IF END OP V;TEXT VARp14,q14;LETr14="""";TEXT PROCf(TEXT CONSTz13):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13);p14:=j0ELSEfeldlesen(y11,p14)END IF;p14END PROCf;REAL PROCwert(TEXT CONSTz13):INT CONSTy11:=feldnummer(z13);IFy11=0THENo14(z13);0.0ELSEfeldlesen(y11,p14);REAL VARs14;wertberechnen(p14,
+s14);s14END IF END PROCwert;REAL PROCwert(TEXT CONSTz13,INT CONSTt14):round(wert(z13),t14)END PROCwert;TEXT PROCzahltext(REAL CONSTu14,INT CONSTt14):REAL CONSTv14:=round(abs(u14),t14);INT CONSTw14:=decimalexponent(v14)+t14+2;IFu14<0.0THENq14:="-"ELSEq14:=j0END IF;IFv14<1.0THENq14CAT"0"ENDIF;q14CATtext(v14,w14,t14);IFt14>0THENchange(q14,".",dezimalkomma)ELSEchange(q14,".",j0)END IF;q14END PROCzahltext;TEXT PROCzahltext(TEXT CONSTz13,INT CONSTt14):zahltext(wert(z13),t14)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTx14):p14:=x14;y14;changeall(p14,r14,r14+r14);insertchar(p14,r14,1);p14CATr14;p14.y14:INT VARz14:=1;WHILEa15REPchange(p14,z14,z14,b15)END REP.a15:z14:=pos(p14,""0"",""31"",z14);z14>0.b15:r14+text(code(p14SUBz14))+r14.END PROCtextdarstellung;PROCo14(TEXT CONSTz13):errorstop(c15+textdarstellung(z13)+d15)END PROCo14;PROCp13:IFanzahldateien=0THENerrorstop(a11)END IF END PROCp13;SATZ VARe15;EUDAT VARf15;LETf14="erzeugtes Programm",a11="keine Datei geoeffnet",g15=
+"Kein Satz zum Tragen vorhanden",h15="Zieldatei hat falsche Felderzahl",i15=" existiert nicht",j15=" verletzt die Pruefbedingung.",k15=" ist in der Zieldatei bereits vorhanden.",d15=" ist nicht definiert.",l15=" ist nicht in der Wertemenge.",m15=" stimmt nicht mit der Maske ueberein.";LETn15="Satz",c15="Das Feld ";INT VARo15;FILE VARp15;BOOL VARq15:=FALSE,r15,s15;TEXT VARt15;PROCtrage(TEXT CONSTp11,FILE VARu15,BOOL CONSTv15):disablestop;q15:=v15;IFq15THENp15:=u15;output(p15)END IF;w15(p11);q15:=FALSE END PROCtrage;PROCw15(TEXT CONSTp11):enablestop;IFanzahldateien>0THENaufsatz(1)END IF;x15(p11);INT VARe12;IFmarkiertesaetze>0THENe12:=3ELSEe12:=2END IF;INT VARo11:=0;REP IF NOTy15THENweiter(e12)ELSEcout(satznummer+o11)END IF;IFdateiendeTHENaufsatz(1);LEAVEw15END IF;z15END REP.y15:IFe12=3THENsatzmarkiertELSEsatzausgewaehltEND IF.z15:r15:=TRUE;IFq15THENnotizenlesen(f15,1,t15);do(t15)END IF;IFr15THENa16;IFr15THENsatzloeschen;o11INCR1END IF END IF;IF NOTr15THENweiter(e12)END IF.END PROCw15;
+PROCx15(TEXT CONSTp11):IFdateiendeTHENerrorstop(g15)END IF;oeffne(f15,p11);o15:=0;IFfelderzahl(f15)=0THENb16ELIFfelderzahl(f15)<>anzahlfelderTHENerrorstop(h15)END IF;aufsatz(f15,saetze(f15)+1).b16:satzinitialisieren(e15,anzahlfelder);INT VARg10;FORg10FROM1UPTOanzahlfelderREPfeldnamenlesen(g10,p14);feldaendern(e15,g10,p14)END REP;feldnamenaendern(f15,e15).END PROCx15;PROCa16:IFo15>0CANDc16THENd16("",k15)ELSEe16;satzeinfuegen(f15,e15);weiter(f15)END IF.e16:satzinitialisieren(e15,anzahlfelder);INT VARg10;FORg10FROM1UPTOanzahlfelderREPfeldlesen(g10,p14);feldaendern(e15,g10,p14)END REP.c16:TEXT VARo7;INT CONSTf16:=satznr(f15);feldlesen(1,o7);s15:=FALSE;aufsatz(f15,o7);WHILE NOTdateiende(f15)REPg16;weiter(f15,o7)UNTILs15END REP;aufsatz(f15,f16);s15.g16:INT VARw8;s15:=TRUE;FORw8FROM2UPTOo15REPfeldlesen(f15,w8,p14);feldbearbeiten(w8,PROC(TEXT CONST,INT CONST,INT CONST)h16);IF NOTs15THEN LEAVEg16END IF END REP.END PROCa16;PROCh16(TEXT CONSTi16,INT CONSTt4,u4):IFj16COR(length(p14)>0CANDk16)THEN
+s15:=FALSE END IF.j16:(u4-t4+1)<>length(p14).k16:pos(i16,p14,t4,u4+1)<>t4.END PROCh16;PROCd16(TEXT CONSTl16,z10):IFq15THENm16ELSEerrorstop(z10)END IF.m16:put(p15,n15);put(p15,satznummer);IFl16<>""THENwrite(p15,c15);write(p15,textdarstellung(l16))END IF;putline(p15,z10);r15:=FALSE.END PROCd16;PROCeindeutigefelder(INT CONSTr4):o15:=r4END PROCeindeutigefelder;PROCpruefe(TEXT CONSTl16,BOOL CONSTn16):IF NOTn16THENd16(l16,j15)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTl16,o16):INT CONSTy11:=feldnummer(l16);IFy11=0THENd16(l16,d15)ELSEp16END IF.p16:INT VARz14:=0;LETq16=",";feldlesen(y11,p14);IFr16THEN LEAVEp16END IF;p14CATq16;REPz14:=pos(o16,p14,z14+1);IFz14=1ORz14>1CAND(o16SUBz14-1)=q16THEN LEAVEp16END IF UNTILz14=0END REP;d16(l16,l15).r16:INT CONSTs16:=length(o16)-length(p14);(o16SUBs16)=q16ANDpos(o16,p14,s16+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTl16,t16):INT CONSTy11:=feldnummer(l16);IFy11=0THENd16(l16,d15)ELSEfeldlesen(y11,p14);u16END IF.u16:INT VARz14;TEXT CONSTm2:=code(
+length(t16)+1);TEXT VARv16:=""1"";FORz14FROM1UPTOlength(p14)REP TEXT CONSTv5:=p14SUBz14;w16UNTILv16=""END REP;IFx16THENd16(l16,m15)END IF.w16:INT VARy16:=1;WHILEy16<=length(v16)REP INT CONSTz16:=code(v16SUBy16);IF(t16SUBz16)="*"THENa17ELIFb17THENreplace(v16,y16,code(z16+1));y16INCR1ELSEdeletechar(v16,y16)END IF END REP.a17:IFz16=length(t16)THEN LEAVEfeldmaskeEND IF;y16INCR1;IFpos(v16,code(z16+1))=0THENinsertchar(v16,code(z16+1),y16)END IF.b17:SELECTpos("9XAa",t16SUBz16)OF CASE1:pos("0123456789",v5)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",v5)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",v5)>0OTHERWISE(t16SUBz16)=v5END SELECT.x16:(v16=""CORpos(v16,m2)=0)ANDc17.c17:(t16SUBlength(t16))<>"*"ORpos(v16,code(length(t16)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTp11):x15(p11);INT CONSTd17:=satznr(f15);a16;satzloeschen;aufsatz(f15,d17)END PROCtragesatz;PROCholesatz(TEXT CONSTp11):p13;IF NOTexists(p11)THENerrorstop(textdarstellung(p11)+i15)END IF;oeffne(f15,p11);IFfelderzahl(f15)
+<>anzahlfelderTHENerrorstop(h15)ELIFsaetze(f15)=0THENerrorstop(g15)END IF;aufsatz(f15,saetze(f15));satzlesen(f15,e15);e17;satzloeschen(f15).e17:satzeinfuegen;INT VARg10;FORg10FROM1UPTOfelderzahl(e15)REPfeldlesen(e15,g10,p14);feldaendern(g10,p14)END REP.END PROCholesatz;END PACKETverarbeitung;
+
diff --git a/app/eudas/3.4/src/eudas.3 b/app/eudas/3.4/src/eudas.3
new file mode 100644
index 0000000..f0218aa
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.3
@@ -0,0 +1,32 @@
+PACKETfensterDEFINES FENSTER,fensterinitialisieren,fenstergroessesetzen,fenstergroesse,fensterveraendert,fensterzugriff,bildschirmneu:TYPE FENSTER=STRUCT(INTb0,c0);LETd0=16,BITVEKTOR=INT,GROESSE=STRUCT(INTe0,f0,g0,h0);ROWd0STRUCT(INTi0,j0,BITVEKTORk0,GROESSEl0)VARm0;INT VARn0:=1;BITVEKTOR VARo0;INT VARp0;FORp0FROM2UPTOd0REPm0(p0).i0:=0END REP;m0(1).i0:=1;m0(1).j0:=0;m0(1).k0:=0;m0(1).l0:=GROESSE:(1,1,79,24);PROCfensterinitialisieren(FENSTER VARf):f.b0:=1;m0(1).i0INCR1;f.c0:=n0;n0INCR1;IFn0>=32000THENn0:=-32000END IF END PROCfensterinitialisieren;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARq0;r0;IFq0>d0THENs0;t0;u0END IF;v0.r0:q0:=1;WHILEq0<=d0REP IFw0THEN LEAVEr0END IF;q0INCR1END REP.w0:x0.e0=e0ANDx0.f0=f0ANDx0.g0=g0ANDx0.h0=h0.x0:m0(q0).l0.s0:q0:=1;WHILEq0<=d0REP IFm0(q0).i0=0THEN LEAVEs0END IF;q0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.t0:m0(q0).i0:=0;m0(q0).j0:=0;m0(q0).l0:=GROESSE:(e0,f0,g0,h0);m0(q0).k0:=0.u0:INT VARy0;FOR
+y0FROM1UPTOd0REP IFm0(y0).i0>0THENz0END IF END REP.z0:IFa1(b1,c1)THENsetbit(m0(q0).k0,y0);setbit(m0(y0).k0,q0)ELSEresetbit(m0(y0).k0,q0)END IF.b1:m0(q0).l0.c1:m0(y0).l0.v0:m0(f.b0).i0DECR1;f.b0:=q0;m0(q0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCa1(GROESSE CONSTa,d1):e1ANDf1.e1:IFa.e0<=d1.e0THENd1.e0<=a.e0+a.g0ELSEa.e0<=d1.e0+d1.g0END IF.f1:IFa.f0<=d1.f0THENd1.f0<=a.f0+a.h0ELSEa.f0<=d1.f0+d1.h0END IF.END PROCa1;PROCfenstergroesse(FENSTER CONSTf,INT VARe0,f0,g0,h0):e0:=x0.e0;f0:=x0.f0;g0:=x0.g0;h0:=x0.h0.x0:m0(f.b0).l0.END PROCfenstergroesse;PROCfensterveraendert(FENSTER CONSTf):m0(f.b0).j0:=0;o0:=o0ORg1.g1:m0(f.b0).k0.END PROCfensterveraendert;PROCfensterzugriff(FENSTER CONSTf,BOOL VARh1):h1:=bit(o0,f.b0);IFm0(f.b0).j0<>f.c0THENm0(f.b0).j0:=f.c0;h1:=TRUE END IF;o0:=o0ORg1;resetbit(o0,f.b0).g1:m0(f.b0).k0.END PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARi1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit(
+BITVEKTOR VARj1,INT CONSTq0):j1:=j1ORi1(q0)END PROCsetbit;PROCresetbit(BITVEKTOR VARj1,INT CONSTq0):j1:=j1AND(-1-i1(q0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTj1,INT CONSTq0):(j1ANDi1(q0))<>0END PROCbit;END PACKETfenster;
+PACKETeudasmenuesDEFINESersetzungstext,
+##globalmanager,menuemanager,
+##menuedateneinlesen,menuenamen,menueloeschen,menueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,statuszeile,statusanzeigen,dialogfenster,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW9TEXT VARk1;PROCersetzungstext(INT CONSTl1,TEXT CONSTm1):k1(l1):=m1END PROCersetzungstext;PROCn1(INT CONSTl1,TEXT VARm1):SELECTl1OF CASE1:m1:=timeofdayCASE2:m1:=date
+##CASE3:m1:=name(myself)
+##OTHERWISEm1:=k1(l1)END SELECT END PROCn1;ROW10TEXT VARo1:=ROW10TEXT:("MENUE","BILD","FELD","ERSETZE","ENDE","AUSWAHL","VORSPANN","HILFE","SEITE","");LETp1=1,q1=2,r1=3,s1=4,t1=5,u1=6,v1=7,w1=8,x1=9;LETy1=2,integer=3,z1=4,a2=7;LETb2="FEHLER in Zeile ";FILE VARc2;TEXT VARd2,e2;PROCf2:IFeof(c2)THENd2:="%DUMMY"ELSEreadrecord(c2,d2);IFd2=g2THENd2:=h2END IF;cout(lineno(c2));down(c2)END IF END PROCf2;BOOL PROCi2:IF(d2SUB1)=j2THENk2ELSE FALSE END IF.k2:INT VARl2;replace(d2,1,h2);scan(d2);replace(d2,1,j2);nextsymbol(e2,l2);IFl2<>y1THENm2(n2);FALSE ELSE TRUE END IF.END PROCi2;BOOL PROCo2(INT CONSTp2):o1(p2)=e2END PROCo2;INT PROCq2:TEXT VARr2;INT VARl2;nextsymbol(r2,l2);IFl2=integerTHENint(r2)ELSE IFl2<>a2THENm2(s2)END IF;-1END IF END PROCq2;TEXT PROCt2:TEXT VARr2;INT VARl2;nextsymbol(r2,l2);IFl2=z1THENr2ELSE IFl2<>a2THENm2(u2)END IF;g2END IF END PROCt2;PROCm2(TEXT CONSTv2):note(b2);note(lineno(c2)-1);noteline;note(v2);noteline;line;putline(v2)END PROCm2;INT VARh0,g0,w2,x2;PROCy2(INT CONSTz2,a3)
+:cursor(w2+z2-1,x2+a3-1)END PROCy2;LETb3="Zeile ist ohne Zusammenhang",c3="K Menuedaten im Speicher";PROCmenuedateneinlesen(FILE VARf):d3;modify(f);toline(f,1);c2:=f;WHILE NOTeof(c2)REPf2;IFi2THENe3ELIF NOTanythingnotedTHENm2(b3)END IF END REP;f3.e3:IFo2(p1)THENg3ELIFo2(u1)THENh3ELIFo2(w1)THENi3ELIF NOTanythingnotedTHENm2(b3)END IF.f3:IFonlineTHENline;put(j3DIV2);putline(c3)END IF.j3:dspages(k3(1))+dspages(k3(2))+dspages(k3(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZl3,m3,n3,o3,TEXTp3,q3,r3);BOUND ROW200MENUE VARs3;INT VARt3;TEXT VARu3,v3;LETg2="",h2=" ",w3="­",j2="%",x3="&",y3=""7"",z3=""27"",a4=""5"",b4="-"8"",c4="+";LETd4="% BILD erwartet",e4="Feldnummer beim %FELD-Kommando fehlt",f4="% ENDE erwartet",g4="Zeile muss mit '&' beginnen",h4="ein Parameter fehlt",i4="Ersetzungstexte gehen nur von 1 bis 9",j4="Name fehlt",n2="Kommandozeile enthaelt kein Kommando",s2="Parameter soll eine Zahl sein",u2="Parameter soll ein TEXT sein",k4="Wiederholungszeile fehlt";PROCg3:TEXT VAR
+name:=t2;IFname=g2THENm2(j4)ELSE INT VARindex;l4;g3(s3(index))END IF.l4:index:=link(m4(2),name);IFindex=0THENinsert(m4(2),name,index)END IF.END PROCg3;PROCg3(MENUE VARn4):o4;p4;q4;r4.o4:satzinitialisieren(n4.l3);satzinitialisieren(n4.m3);satzinitialisieren(n4.n3);satzinitialisieren(n4.o3);n4.p3:=g2;n4.q3:=g2;n4.r3:=g2.p4:s4;INT VARt4:=1;REPf2;IFi2THEN LEAVEp4ELSEu4;t4INCR1END IF END REP.s4:f2;IF NOT(i2CANDo2(q1))THENm2(d4)END IF.u4:INT VARv4:=0;REPv4:=pos(d2,w3,v4+1);IFv4>0THENn4.q3CATcode(v4);n4.r3CATcode(t4)END IF UNTILv4=0END REP;feldaendern(n4.l3,t4,d2).q4:WHILEo2(r1)REPw4END REP.w4:INT VARx4:=q2;IFx4=-1THENm2(e4);x4:=100END IF;y4;z4;a5.y4:feldaendern(n4.m3,x4,t2).z4:TEXT CONSTb5:=t2;INT VARc5;FORc5FROM1UPTOlength(b5)REPn4.p3CATcode(x4);n4.p3CAT(b5SUBc5)END REP.a5:TEXT VARd5:=g2;f2;WHILE NOTi2REPd5CATd2;f2END REP;feldaendern(n4.n3,x4,d5).r4:IFo2(s1)THENe5END IF;IF NOTo2(t1)THENm2(f4)END IF.e5:f2;WHILE NOTi2REPf5;f2END REP.f5:g5(n4.o3);h5(n4.l3).END PROCg3;PROCg5(SATZ VARo3):IF(d2
+SUB1)<>x3THENm2(g4);u3:=g2ELSEi5;j5END IF.i5:INT CONSTk5:=pos(d2,h2);IFk5=0THENm2(h4);u3:=g2ELSEu3:=subtext(d2,2,k5-1);scan(subtext(d2,k5))END IF.j5:t3:=q2;IFt3<1ORt3>9THENm2(i4)ELSE TEXT CONSTl5:=t2;feldaendern(o3,t3,l5);feldaendern(o3,t3+10,u3)END IF.END PROCg5;PROCh5(SATZ VARl3):IFu3=g2THEN LEAVEh5END IF;INT VARt4;FORt4FROM1UPTOfelderzahl(l3)REPfeldlesen(l3,t4,v3);m5;n5END REP.m5:INT VARq0;BOOL VARo5:=FALSE;REPq0:=pos(v3,x3+u3);IFq0>0THENo5:=TRUE;replace(v3,q0+1,text(t3))END IF UNTILq0=0END REP.n5:IFo5THENfeldaendern(l3,t4,v3)END IF.END PROCh5;LETp5="Auswaehlen: PFEILE    Ausfuehren: LEER    Zurueck: ESC q    Hilfe: ESC ?",q5="Eingabe beenden: RETURN    Eingabe abbrechen: ESC h    Hilfe: ESC ?",r5="Kommando wird ausgefuehrt ..",s5=""15"gib kommando: ",t5=""14"",u5=" existiert nicht.";TEXT VARv5,w5:=g2;PROCmenueanbieten(TEXT CONSTname,FENSTER VARf,BOOL CONSTx5,PROC(INT CONST)y5):d3;INT CONSTindex:=link(m4(2),name);IFindex=0THENz5(name)ELSEa6(s3(index),f,x5,PROC(INT CONST)y5)END IF 
+END PROCmenueanbieten;PROCa6(MENUE CONSTn4,FENSTER VARf,BOOL CONSTx5,PROC(INT CONST)y5):disablestop;INT VARwahl,b6:=1,c6:=0;fensterveraendert(f);REPd6;IFwahl>0THENy5(wahl)END IF;b6:=abs(wahl)UNTILwahl=0END REP;fensterveraendert(f).d6:INT VARe6:=0;f6;g6(f,c6);neuerdialog;statusanzeigen(p5);h6;REPi6;j6END REP.f6:wahl:=1;IFiserrorTHENfehlerausgeben;k6END IF.h6:IFc6>=code(n4.r3SUBb6)THENy2(code(n4.q3SUBb6),code(n4.r3SUBb6));out(b4)END IF.i6:REPl6;IFiserrorTHENclearerror;c6:=0ELSE LEAVEi6END IF END REP.l6:TEXT VARm6;WHILEc6<h0REPm6:=getcharety;n6END REP;o6;p6(m6).n6:IFm6=g2THENc6INCR1;y2(1,c6);q6(n4.l3,n4.o3,c6)ELSE LEAVEl6END IF.o6:y2(code(n4.q3SUBwahl),code(n4.r3SUBwahl)).j6:INT VARr6;SELECTe6OF CASE0:s6CASE1:t6CASE2:u6END SELECT.s6:SELECTpos(""1""2""3""8""9""10""13""27" ",m6)OF CASE1:e6:=1CASE2:v6CASE3:w6CASE4:x6CASE5:y6CASE6:z6CASE7:a7CASE8:e6:=2CASE9:b7OTHERWISEc7END SELECT.t6:SELECTpos(""1""2""3""8""10"",m6)OF CASE1:d7CASE2:e7CASE3:f7CASE4:g7CASE5:h7OTHERWISEout(y3)END SELECT;e6:=0.u6
+:SELECTpos(""1""27"?kqh",m6)OF CASE1:eschopausfuehrenCASE2:i7CASE3:j7CASE4:k6CASE5,6:k7OTHERWISEl7END SELECT;e6:=0.v6:r6:=pos(n4.r3,n4.r3SUBwahl,wahl+1);IFr6>0THENwahl:=r6END IF.w6:r6:=m7(n4.q3,n4.q3SUBwahl,wahl-1);IFr6>0THENwahl:=r6END IF.x6:r6:=pos(n4.r3,n4.r3SUBwahl);IFr6<wahlTHENwahlDECR1END IF.y6:IFwahl<length(n4.r3)THENwahlINCR1END IF.z6:r6:=pos(n4.q3,n4.q3SUBwahl,wahl+1);IFr6>0THENwahl:=r6END IF.a7:r6:=m7(n4.r3,n4.r3SUBwahl);IFr6<length(n4.r3)THENwahl:=r6+1END IF.c7:IFn7THENo7ELIFm6<=" "THENpush(z3+m6)END IF.n7:r6:=0;REPr6:=pos(n4.p3,m6,r6+1)UNTIL(r6MOD2)=0END REP;r6>0.o7:wahl:=code(n4.p3SUBr6-1);o6;p7(n4,wahl,c6);LEAVEd6.d7:wahl:=1.e7:wahl:=m7(n4.r3,n4.r3SUBwahl).f7:wahl:=pos(n4.q3,n4.q3SUBwahl).g7:wahl:=pos(n4.r3,n4.r3SUBwahl).h7:wahl:=m7(n4.q3,n4.q3SUBwahl).l7:push(lernsequenzauftaste(m6)).i7:IFx5THENq7;REPy2(1,r7);s7;t7;u7UNTILv7END REP;statusanzeigen(p5)END IF.t7:IFc6>0THENy2(1,r7);q6(n4.l3,n4.o3,r7)END IF.q7:INT VARr7;IFc6<h0THENr7:=c6ELSEr7:=code(n4.r3SUBwahl)END IF.u7:IF
+pos(v5,"!","�",1)>0THENstatusanzeigen(r5);dialog;do(v5);w7;g6(f,c6);neuerdialogEND IF.w7:INT VARz2,a3;getcursor(z2,a3);IFa3=24THENbildschirmneuEND IF.v7:NOTiserror.j7:TEXT VARx7;feldlesen(n4.m3,wahl,x7);hilfeanbieten(x7,f);IFiserrorTHENfehlerausgebenEND IF;g6(f,c6);statusanzeigen(p5).k6:wahl:=b6.k7:wahl:=0;LEAVEd6.b7:p7(n4,wahl,c6);LEAVEd6.END PROCa6;PROCg6(FENSTER CONSTf,INT VARc6):BOOL VARh1;fensterzugriff(f,h1);fenstergroesse(f,w2,x2,g0,h0);IFh1THENc6:=0;y2(1,1)END IF END PROCg6;PROCp6(TEXT VARy7):enablestop;getchar(y7)END PROCp6;PROCp7(MENUE CONSTn4,INT VARwahl,INT CONSTc6):IFz7THENout(c4)END IF;TEXT VARd5;feldlesen(n4.n3,wahl,d5);IFd5<>g2ANDd5<>h2THENdo(d5);wahl:=-wahlEND IF.z7:c6>=code(n4.r3SUBwahl).END PROCp7;INT PROCm7(TEXT CONSTa8,b8,INT CONSTc8):INT VARc5:=c8;WHILEc5>0CAND(a8SUBc5)<>b8REPc5DECR1END REP;c5END PROCm7;INT PROCm7(TEXT CONSTa8,b8):m7(a8,b8,length(a8))END PROCm7;PROCeschopausfuehren:TEXT VARd8:=g2,e8;lernsequenzauftastelegen(""0"",g2);push(""27""1""0""0"");editget(
+d8,32000,0,""0"","",e8);d8:=lernsequenzauftaste(""0"");IFd8<>g2THENf8ELSEg8END IF.f8:REPgetchar(e8)UNTILpos(""1""2""8""11""12"",e8)=0END REP;lernsequenzauftastelegen(e8,d8).g8:getchar(e8).END PROCeschopausfuehren;INT VARh8,k5,i8;PROCq6(SATZ CONSTl3,o3,INT CONSTt4):h8:=1;IFt4<=felderzahl(l3)THENj8END IF;k8.j8:REPfeldbearbeiten(l3,t4,PROC(TEXT CONST,INT CONST,INT CONST)l8);IFi8>0THENm8END IF;h8:=k5+1UNTILi8=0END REP.m8:TEXT VARn8,o8;n1(i8,n8);feldlesen(o3,i8,o8);n8CATo8;p8;outsubtext(n8,1,q8);k5INCRq8.p8:INT VARq8:=length(o8);IFq8=0THEN IFn8=g2THENn8:=h2;q8:=1ELSEq8:=length(n8)END IF END IF;IFk5+q8>g0THENq8DECRg0-k5END IF.k8:IFw2+g0>=80THENout(a4)ELSEg0-h8TIMESOUTh2END IF.END PROCq6;PROCl8(TEXT CONSTm1,INT CONSTr8,s8):INT CONSTt8:=r8-1;h8INCRt8;k5:=pos(m1,x3,h8,s8+1);IFk5=0THENk5:=s8;i8:=0ELSEk5DECR1;i8:=int(m1SUBk5+2)END IF;IFk5>g0+t8THENk5:=g0+t8;i8:=0END IF;outsubtext(m1,h8,k5);k5DECRt8END PROCl8;PROCs7:LETu8=""27"k";TEXT VARv8;INT VARz2,a3;getcursor(z2,a3);IFiserrorTHENfehlerausgeben
+;v5:=w5ELSEv5:=g2END IF;statusanzeigen(q5);w8;REPx8UNTILv8<>u8END REP;IFpos(v5,"!","�",1)>0THENw5:=v5END IF;cursor(z2,a3).w8:cursor(w2,a3);out(s5);g0-15TIMESOUTh2;out(t5).x8:cursor(w2+15,a3);editget(v5,32000,g0-17,"","kh",v8);IFiserrorTHENclearerrorELIFv8=u8THENv5:=w5ELIFv8=y8THENv5:=g2END IF.END PROCs7;PROCz5(TEXT CONSTz8):errorstop(textdarstellung(z8)+u5)END PROCz5;TYPE AUSWAHL=STRUCT(SATZa9,b9,c9,o3,TEXTd9,q3,e9);BOUND ROW200AUSWAHL VARf9;PROCh3:TEXT VARname:=t2;IFname=g2THENm2(j4)ELSE INT VARindex:=link(m4(3),name);IFindex=0THENinsert(m4(3),name,index)END IF;h3(f9(index))END IF END PROCh3;PROCh3(AUSWAHL VARa):o4;IFg9THENh9END IF;p4;r4.o4:satzinitialisieren(a.a9);satzinitialisieren(a.b9);satzinitialisieren(a.c9);satzinitialisieren(a.o3);a.d9:=g2;a.q3:=g2;a.e9:=g2.g9:f2;i2CANDo2(v1).h9:INT VARt4:=1;REPf2;IFi2THEN LEAVEh9ELSEi9;t4INCR1END IF END REP.i9:feldaendern(a.a9,t4,d2).p4:s4;t4:=1;BOOL VARj9:=TRUE;REPf2;IFi2THENk9;LEAVEp4ELSEu4;t4INCR1END IF END REP.s4:IF NOT(i2CANDo2(q1))THEN
+m2(d4)END IF.k9:IFj9THENm2(k4)END IF.u4:IFj9THENl9ELSEm9END IF.l9:IFpos(d2,w3)>0THENn9;t4:=0;j9:=FALSE ELSEfeldaendern(a.b9,t4,d2)END IF.n9:o9;a.d9:=d2;p9.o9:INT VARv4:=0;REPv4:=pos(d2,w3,v4+1);IFv4>0THENa.q3CATcode(v4)END IF UNTILv4=0END REP.p9:FORv4FROM1UPTOlength(a.q3)-1REPa.e9CATcode(q9-4)END REP;a.e9CAT""0"".q9:code(a.q3SUBv4+1)-code(a.q3SUBv4).m9:feldaendern(a.c9,t4,d2).r4:IFo2(s1)THENe5END IF;IF NOTo2(t1)THENm2(f4)END IF.e5:f2;WHILE NOTi2REPf5;f2END REP.f5:g5(a.o3);h5(a.a9);h5(a.b9);h5(a.c9).END PROCh3;LETr9=""1""8""10"",s9="+"27"q",t9="Fenster zu klein",u9="Ankreuzen: 'x'    Durchstreichen: 'o'    Beenden: ESC q    Hilfe: ESC ?";INT VARv9,w9,x9,y9,z9,a10,b10,c10;LET INTVEC=TEXT;INTVEC VARd10;TEXT VARe10;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTf10,PROC(TEXT VAR,INT CONST)g10):d3;INT CONSTindex:=link(m4(3),name);IFindex=0THENz5(name)ELSEa6(f9(index),f,f10,PROC(TEXT VAR,INT CONST)g10)END IF END PROCauswahlanbieten;PROCa6(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONST
+f10,PROC(TEXT VAR,INT CONST)g10):INT VARc6:=0,e6:=0;enablestop;h10;statusanzeigen(u9);i10;j10;k10;REPi6;l10END REP.h10:BOOL VARm10;fensterzugriff(f,m10);fenstergroesse(f,w2,x2,g0,h0).i10:INT VARn10:=1024;v9:=n10;REPn10:=n10DIV2;g10(d2,v9);IFd2=g2THENv9DECRn10ELSEv9INCRn10END IF UNTILn10=1END REP;g10(d2,v9);IFd2=g2THENv9DECR1END IF.k10:INT VARo10:=y9+1,p10:=1,q10:=1;d10:=g2;e10:=a.q3.j10:x9:=felderzahl(a.a9);y9:=x9+felderzahl(a.b9);w9:=length(a.q3);z9:=(v9+w9-1)DIVw9;a10:=y9+z9;b10:=a10+felderzahl(a.c9);c10:=0;IFy9>=h0THENerrorstop(t9)END IF.i6:REPl6;IFiserrorTHENclearerror;c6:=0ELSE LEAVEi6END IF END REP.l6:TEXT VARm6;WHILEc6<h0REPm6:=getcharety;n6END REP;o6;p6(m6).n6:IFm6=g2THENc6INCR1;r10ELSE LEAVEl6END IF.r10:INT CONSTs10:=c6+c10;y2(1,c6);IFc6<=x9THENq6(a.a9,a.o3,c6)ELIFs10<=y9THENq6(a.b9,a.o3,s10-x9)ELIFs10<=a10THENt10ELSEq6(a.c9,a.o3,s10-a10)END IF.t10:u10(a,v10,PROC(TEXT VAR,INT CONST)g10).v10:(s10-y9-1)*w9+1.o6:y2(code(e10SUBp10),o10).l10:SELECTe6OF CASE0:s6CASE1:t6CASE2:u6END 
+SELECT.s6:SELECTpos(""1""2""3""8""9""10""13""27" +x-o",m6)OF CASE1:e6:=1CASE2:v6CASE3:w6CASE4:x6CASE5:y6CASE6:z6CASE7:a7CASE8:e6:=2CASE9:w10CASE10,11:x10CASE12,13:y10OTHERWISEc7END SELECT.t6:SELECTpos(""1""2""3""8""10""13"+x-o",m6)OF CASE1:d7CASE2:e7CASE3:f7CASE4:g7CASE5:h7CASE6:z10CASE7,8:a11CASE9,10:b11OTHERWISEout(y3)END SELECT;e6:=0.u6:SELECTpos(""1"19?qh",m6)OF CASE1:eschopausfuehrenCASE2:c11CASE3:d11CASE4:j7CASE5:k7CASE6:errorstop(g2)OTHERWISEl7END SELECT;e6:=0.v6:IFp10<w9ANDq10<v9THENp10INCR1;q10INCR1END IF.w6:IFq10>w9THENo10DECR1;q10DECRw9;IFo10<=x9THENo10INCR1;c10DECR1;c6:=x9END IF END IF.x6:IFp10>1THENp10DECR1;q10DECR1END IF.y6:IFp10=w9THENpush(""13"")ELSEpush(""1""2"")END IF.z6:IFq10+w9<=v9THENo10INCR1;q10INCRw9;IFo10>h0THENo10DECR1;c10INCR1;c6:=x9END IF END IF.a7:IFo10+c10<a10THENpush(r9)END IF.w10:push(s9).x10:IFe11(q10)=0ANDq10<=v9THENd10CATq10;IFo10<=c6THENf11(o10,p10,length(d10)DIV2)END IF END IF.y10:INT CONSTg11:=e11(q10);IFg11>0THENh11;i11END IF.h11:change(d10,2*g11-1
+,2*g11,g2).c7:IFm6<h2THENpush(lernsequenzauftaste(m6))ELSEout(y3)END IF.d7:g7;j11.e7:WHILEq10<v9ANDp10<w9REPq10INCR1;p10INCR1END REP.f7:IFo10=x9+1THENk11ELSEj11END IF.k11:INT VARl11:=min(h0-x9,c10);c10DECRl11;INT CONSTm11:=n11;o10INCRm11;q10DECR(l11-m11)*w9;IFl11>0THENc6:=x9END IF.n11:max(0,y9-x9-c10).j11:WHILEq10>w9ANDo10>x9+1REPo10DECR1;q10DECRw9END REP.g7:q10DECR(p10-1);p10:=1.h7:IFo10=h0THENo11ELSEp11END IF.o11:l11:=min(h0-x9,b10-o10-c10);c10INCRl11;INT CONSTq11:=max(0,o10+c10-a10+r11);o10DECRq11;q10INCR(l11-q11)*w9;IFl11>0THENc6:=x9END IF.r11:IFp10>v9MODw9THEN1ELSE0END IF.p11:WHILEo10<h0ANDq10+w9<=v9REPo10INCR1;q10INCRw9END REP.z10:c10INCR(o10-x9-1);o10:=x9+1;c6:=x9.a11:INT VARs11;FORs11FROM1UPTOv9REP IFe11(s11)=0THENd10CATs11END IF END REP;i11.b11:d10:=g2;i11.j7:hilfeanbieten(f10,f);statusanzeigen(u9);c6:=0.k7:LEAVEa6.l7:push(lernsequenzauftaste(m6)).c11:o10:=y9+1;q10:=1;p10:=1;c10:=0;c6:=x9.d11:IFa10<=h0THENo10:=a10ELSEo10:=max(x9+1,h0+a10-b10)END IF;c10:=a10-o10;p10:=(v9-1)MOD
+w9+1;q10:=v9;c6:=x9.END PROCa6;PROCi11:INT VARy7,t11,s11;s11:=u11;FORy7FROMv11UPTOw11REP FORt11FROM1UPTOw9REPf11(y7,t11,e11(s11));s11INCR1END REP END REP.u11:max(0,c10-y9+x9)*w9+1.v11:max(x9,y9-c10)+1.w11:min(h0,a10-c10).END PROCi11;TEXT VARx11:="xx";INT PROCe11(INT CONSTy11):replace(x11,1,y11);INT VARc5:=0;REPc5:=pos(d10,x11,c5+1)UNTILc5=0ORc5MOD2=1END REP;(c5+1)DIV2END PROCe11;OP CAT(INTVEC VARz11,INT CONSTwert):replace(x11,1,wert);z11CATx11END OP CAT;PROCu10(AUSWAHL CONSTa,INT CONSTv10,PROC(TEXT VAR,INT CONST)g10):INT VARc5:=1,y11,t11:=1;FORy11FROMv10UPTOv10+w9-1REPoutsubtext(a.d9,c5,a12-5);b12;g10(d2,y11);INT CONSTc12:=min(d12,length(d2));outsubtext(d2,1,c12);c5:=a12+c12+2;t11INCR1END REP;k8.a12:code(e10SUBt11).b12:INT CONSTe12:=e11(y11);IFe12=0THENout("    o ")ELSEout(text(e12,3));out(" x ")END IF.d12:IFt11=w9THENg0-a12-1ELSEcode(a.e9SUBt11)END IF.k8:outsubtext(a.d9,c5,g0);IFw2+g0>=80THENout(a4)ELSEg0-max(c5,length(a.d9))TIMESOUTh2END IF.END PROCu10;PROCf11(INT CONSTd2,f12,wert):
+y2(code(e10SUBf12)-4,d2);IFwert=0THENout("    o ")ELSEout(text(wert,3));out(" x ")END IF END PROCf11;INT PROCwahl(INT CONSTq0):IFq0+q0<=length(d10)THENd10ISUBq0ELSE0END IF END PROCwahl;LETg12=200,h12=5000;LET HILFE=STRUCT(INTi12,ROWg12THESAURUSj12,ROWg12SATZk12,ROWh12SATZl12);BOUND HILFE VARm12;INT VARn12,o12,p12,q12;LETr12="Das Hilfsgebiet existiert bereits",s12="Diese Seite ist in der anderen Hilfe nicht vorhanden";PROCi3:TEXT VARname:=t2;IFname=g2THENm2(j4)ELSEt12;u12;v12END IF.t12:INT CONSTw12:=pos(name,"/");TEXT VARx12;IFw12=0THENx12:=nameELSEx12:=subtext(name,1,w12-1)END IF;y12;z12.y12:INT VARa13:=link(m4(1),x12);IFa13=0THENinsert(m4(1),x12,a13);m12.j12(a13):=emptythesaurus;satzinitialisieren(m12.k12(a13))ELIFw12=0THENm2(r12);LEAVEi3END IF.z12:INT VARb13;TEXT VARc13:=subtext(name,w12+1);IFw12=0THENb13:=1ELSEb13:=link(m12.j12(a13),c13);IFb13=0THENinsert(m12.j12(a13),c13,b13)END IF END IF.u12:INT VARd13:=m12.i12;IFd13<0THENd13:=0END IF;TEXT VARe13:=g2;f2;WHILEi2CANDo2(x1)REPf13END 
+REP.f13:INT CONSTg13:=q2;TEXT CONSTh13:=t2;IFh13<>g2THENi13;f2ELSEj13END IF.i13:TEXT VARk13;l13(h13,k13);IFg13+g13<=length(k13)THENe13CAT(k13ISUBg13)ELSEm2(s12)END IF.j13:INT VARt4:=1;d13INCR1;e13CATd13;satzinitialisieren(m12.l12(d13));REPf2;IFi2THEN LEAVEj13ELSEfeldaendern(m12.l12(d13),t4,d2);t4INCR1END IF END REP.v12:IF NOTo2(t1)THENm2(f4)END IF;IF NOTanythingnotedTHENfeldaendern(m12.k12(a13),b13,e13);m12.i12:=d13END IF.END PROCi3;PROCl13(TEXT CONSTname,TEXT VARe13):INT CONSTw12:=pos(name,"/");INT VARx12,b13:=0;IFw12=0THENx12:=link(m4(1),name)ELSEx12:=link(m4(1),subtext(name,1,w12-1));m13END IF;IFb13=0THENb13:=1END IF;IFx12=0THENerrorstop(n13)ELSEfeldlesen(m12.k12(x12),b13,e13)END IF.m13:IFx12>0THENb13:=link(m12.j12(x12),subtext(name,w12+1))END IF.END PROCl13;LETn13="Hilfe existiert nicht",o13="Hilfe ist leer",p13="Zurueck: ESC q       Seite weiter: ESC w       Seite zurueck: ESC z";PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;d3;TEXT VARe13;q13;l13(name,e13);IFe13=g2
+THENerrorstop(o13)ELSEr13END IF.q13:fensterveraendert(f);fenstergroesse(f,n12,o12,p12,q12).r13:s13;statusanzeigen(p13);INT VARk12:=1;REPt13;u13END REP.t13:INT CONSTv13:=e13ISUBk12;w13(m12.l12(v13)).u13:TEXT VARm6;REPgetchar(m6);IFm6=z3THENgetchar(m6);u7;LEAVEu13ELSEout(y3)END IF END REP.u7:SELECTpos("qwz?"1"",m6)OF CASE1:LEAVEhilfeanbietenCASE2:x13CASE3:y13CASE4:z13CASE5:eschopausfuehrenOTHERWISEout(y3)END SELECT.x13:IF2*k12<length(e13)THENk12INCR1END IF.y13:IFk12>1THENk12DECR1END IF.z13:k12:=1.END PROChilfeanbieten;PROCw13(SATZ CONSTa14):INT VARt4;FORt4FROM1UPTOq12REPcursor(n12,o12+t4-1);feldbearbeiten(a14,t4,PROC(TEXT CONST,INT CONST,INT CONST)b14)END REP;cursor(n12,o12+q12-1)END PROCw13;PROCb14(TEXT CONSTl3,INT CONSTr8,s8):IFs8-r8+1>p12THENk5:=r8+p12-1ELSEk5:=s8END IF;outsubtext(l3,r8,k5);IFn12+p12>=80THENout(a4)ELSEp12+r8-k5-1TIMESOUTh2END IF END PROCb14;TEXT VARc14:=g2,d14;PROCstatuszeile(TEXT CONSTe14,f14):c14:=e14;d14:=f14END PROCstatuszeile;PROCstatusanzeigen(TEXT CONSTstatus):
+IFc14<>g2THENout(c14);out(status);out(d14)END IF END PROCstatusanzeigen;LETg14=""4"",h14=""27"?",i14=""27"q",y8=""27"h",j14="Bejahen: j,J    Verneinen: n,N    Abbrechen: ESC h    Hilfe: ESC ?",k14="Eingabe beenden: RETURN    Abbrechen: ESC h    Hilfe: ESC ?",l14="Eingabe beenden: RETURN   Zeigen: ESC z   Abbrechen: ESC h   Hilfe: ESC ?",m14="    Fehler quittieren ESC q    Informationen zur Fehlermeldung: ESC ?",n14=""15" !!! FEHLER !!!  "14"";FENSTER VARo14;fensterinitialisieren(o14);INT VARp14,q14,r14,s14,t14;TEXT VARu14;PROCdialogfenster(INT CONSTz2,a3,v14,w14):fenstergroessesetzen(o14,z2,a3,v14,w14);q14:=z2;r14:=a3;s14:=v14;t14:=w14;u14:=g2END PROCdialogfenster;PROCneuerdialog:p14:=t14END PROCneuerdialog;PROCneuerdialog(TEXT CONSTx14):p14:=t14;u14:=x14END PROCneuerdialog;PROCdialog:BOOL VARh1;fensterzugriff(o14,h1);p14INCR1;IFp14>t14ORh1THENy14;p14:=1END IF;cursor(q14,r14+p14-1).y14:BOOL CONSTz14:=q14+s14>=80;IFz14ANDr14+t14>24ANDq14=1THENcursor(q14,r14);out(g14)ELSEa15END IF;out(
+u14).a15:p14:=0;REPcursor(q14,r14+p14);IFz14THENout(a4)ELSEs14TIMESOUTh2END IF;p14INCR1UNTILp14>=t14END REP.END PROCdialog;BOOL PROCja(TEXT CONSTb15,f10):REPstatusanzeigen(j14);dialog;out(b15);out(" ? (j/n) ");s13;c15END REP;FALSE.c15:TEXT VARm6;REPgetchar(m6);IFm6="j"ORm6="J"THENout(m6);LEAVEjaWITH TRUE ELIFm6="n"ORm6="N"THENout(m6);LEAVEjaWITH FALSE ELIFm6=z3THENd15ELSEout(y3)END IF END REP.d15:getchar(m6);IFm6="?"THENhilfeanbieten(f10,o14);neuerdialog;LEAVEc15ELIFm6="h"THENerrorstop(g2);LEAVEjaWITH FALSE ELIFm6=""1""THENeschopausfuehrenELSEout(y3)END IF.END PROCja;PROCeditget(TEXT CONSTe15,TEXT VARm6,TEXT CONSTf15,f10):TEXT VARv8;g15;dialog;out(e15);out(h2);editget(m6,1000,h15,"","?hq"+f15,v8);IFv8=h14THENhilfeanbieten(f10,o14);neuerdialog;editget(e15,m6,"",f10)ELIFv8=y8ORv8=i14THENerrorstop(g2)ELIFlength(v8)=2THENm6:=v8END IF.g15:IFpos(f15,"z")>0THENstatusanzeigen(l14)ELSEstatusanzeigen(k14)END IF.h15:s14-length(e15)-1.END PROCeditget;PROCfehlerausgeben:TEXT CONSTv2:=errormessage;
+IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;s13;IFv2<>g2THENstatusanzeigen(m14);i15;j15;neuerdialogEND IF.i15:dialog;IFp14=t14THENneuerdialog;dialogEND IF;out(y3);out(n14);dialog;outsubtext(errormessage,1,s14).j15:TEXT VARm6;getchar(m6);IFm6=z3THENd15END IF.d15:getchar(m6);IFm6="?"THENhilfeanbieten("FEHLER/"+text(errorcode),o14)ELIFm6=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCs13:WHILEgetcharety<>g2REP END REP END PROCs13;LETk15=3,l15=1070,m15=0,n15=2;ROWk15DATASPACE VARk3;ROWk15THESAURUS VARm4;BOOL VARo15:=FALSE;INITFLAG VARp15;PROCd3:IF NOTinitialized(p15)THENq15END IF.q15:BOOL VARv7:=o15;r15;IFv7THENs15ELSEmenueloeschenEND IF.r15:INT VARl1;FORl1FROM1UPTOk15WHILEv7REPt15END REP.t15:
+##INT VARu15,v15;FORv15FROM1UPTO10REPforget(k3(l1));k3(l1):=nilspace;pingpong(father,l15+l1,k3(l1),u15);IFu15=m15THEN LEAVEt15ELIFu15<>n15THENpause(15)END IF UNTILu15=n15END REP;forget(k3(l1));k3(l1):=nilspace;
+##v7:=FALSE.END PROCd3;THESAURUS PROCmenuenamen(INT CONSTl1):d3;IFl1<0THENm12.j12(-l1)ELSEm4(l1)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTl1):d3;IFl1<0THENw15(name,m12.j12(-l1))ELSEw15(name,m4(l1))END IF END PROCmenueloeschen;PROCw15(TEXT CONSTname,THESAURUS VARm1):INT CONSTindex:=link(m1,name);IFindex>0THENdelete(m1,index)END IF END PROCw15;PROCmenueloeschen:INT VARl1;FORl1FROM1UPTOk15REPforget(k3(l1));k3(l1):=nilspace;m4(l1):=emptythesaurusEND REP;s15END PROCmenueloeschen;PROCs15:m12:=k3(1);s3:=k3(2);f9:=k3(3)END PROCs15;
+##PROCmenuemanager(DATASPACE VARx15,INT CONSTy15,z15,TASK CONSTa16):o15:=TRUE;IFy15>l15ANDy15<=l15+k15THENb16ELSEfreemanager(x15,y15,z15,a16)END IF.b16:IFa16<myselfTHENd3;forget(x15);x15:=k3(y15-l15);send(a16,m15,x15)ELSEerrorstop("Auftrag nur fuer Soehne erlaubt")END IF.END PROCmenuemanager;PROCglobalmanager:globalmanager(PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)menuemanager)END PROCglobalmanager;
+##END PACKETeudasmenues;
+
diff --git a/app/eudas/3.4/src/eudas.4 b/app/eudas/3.4/src/eudas.4
new file mode 100644
index 0000000..5aa9237
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.4
@@ -0,0 +1,31 @@
+PACKETsatzanzeigeDEFINESanzeigefenster,uebersichtsanzeige,bildausgeben,aendern,einfuegen,suchen,feldauswahl,rollen,exitdurch,exitzeichen:LETb0=256;LETc0=" ",d0="",e0=""5"",f0=""4"",g0=""15"",h0=""14"",i0=" "14"",j0=" "14" ";ROWb0STRUCT(INTk0,l0)VARm0;ROW24INT VARn0;ROW24INT VARo0;INT VARp0,q0,r0:=24,s0:=79,t0:=1,u0:=1,v0,w0,x0,y0,z0,a1:=0,b1:=0,c1:=dateiversion-1,d1:=0;BOOL VARe1,f1:=TRUE,g1:=TRUE,h1;FENSTER VARfenster;fensterinitialisieren(fenster);DATASPACE VARi1;FILE VAReditfile;TEXT VARj1,k1,l1;LETm1="Anzeigefenster zu klein";PROCanzeigefenster(INT CONSTn1,o1,p1,q1):IFp1>=39THENfenstergroessesetzen(fenster,n1,o1,p1,q1);g1:=n1+p1>=80;s0:=p1;r0:=q1;u0:=n1;t0:=o1;f1:=TRUE ELSEerrorstop(m1)END IF END PROCanzeigefenster;PROCuebersichtsanzeige(BOOL CONSTja):e1:=ja;x0:=0;z0:=suchversion;h1:=TRUE END PROCuebersichtsanzeige;BOOL PROCuebersichtsanzeige:e1END PROCuebersichtsanzeige;PROCr1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENh1:=TRUE END 
+IF END PROCr1;PROCs1:IFt1ORf1THENu1;v1;w1;x1;y1;z1END IF.t1:c1<>dateiversionORd1<>anzahldateien.u1:p0:=0;j1:=d0;WHILEp0<anzahlfelderREPp0INCR1;m0(p0).k0:=p0;j1CATcode(p0)END REP;q0:=1.v1:INT VARk0;v0:=11;FORk0FROM1UPTOanzahlfelderREPfeldnamenbearbeiten(k0,PROC(TEXT CONST,INT CONST,INT CONST)a2)END REP;v0:=min(v0,s0DIV2);w0:=s0-v0-3.x1:x0:=0;h1:=TRUE.y1:forget(i1);i1:=nilspace.z1:c1:=dateiversion;d1:=anzahldateien;f1:=FALSE.END PROCs1;PROCa2(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTe2:=length(b2);v0:=max(v0,d2-c2+1)END PROCa2;PROCrollen(INT CONSTf2):IFe1THENy0INCRf2ELSEg2END IF.g2:q0:=q0+f2;IFq0<1THENq0:=1ELIFq0>h2THENq0:=max(h2,1)END IF;h1:=TRUE.h2:p0-r0+3.END PROCrollen;PROCfeldauswahl(TEXT CONSTi2):s1;IFe1THENj1:=i2ELSEj2END IF;h1:=TRUE.j2:p0:=length(i2);INT VARk2;FORk2FROM1UPTOp0REPm0(k2).k0:=code(i2SUBk2)END REP;q0:=1.END PROCfeldauswahl;INT VARl2;PROCm2:type(i1,-1);editfile:=sequentialfile(modify,i1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);l2:=1END PROCm2;.n2:l2<=p0.
+PROCo2(PROC(TEXT CONST,INT CONST)p2):q2;IFeof(editfile)THENp2("",k0)ELIFr2THENs2;t2;p2(l1,k0)ELIFu2THENreadrecord(editfile,l1);t2;p2(l1,k0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)p2,editfile,k0);down(editfile)END IF.q2:INT CONSTc2:=l2,k0:=m0(c2).k0;REPl2INCR1UNTILl2>p0CORv2END REP.v2:m0(l2).k0<>k0.r2:l2-c2>1.s2:l1:="";REPexec(PROC(TEXT CONST,INT CONST)w2,editfile,length(l1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=l2END REP.u2:INT CONSTx2:=len(editfile);subtext(editfile,x2,x2)=c0.END PROCo2;PROCw2(TEXT CONSTy2,INT CONSTz2):IFz2>0CAND(l1SUBz2)<>c0THENl1CATc0END IF;l1CATy2END PROCw2;PROCt2:INT VARx2:=length(l1);WHILE(l1SUBx2)=c0REPx2DECR1END REP;l1:=subtext(l1,1,x2)END PROCt2;LETa3="Satz einfuegen",b3="Satz aendern",c3="Suchmuster eingeben";PROCeinfuegen(PROCd3):enablestop;s1;IFp0>0THENm2;headline(editfile,a3);r1;e3(PROCd3);satzeinfuegen;f3END IF END PROCeinfuegen;PROCf3:WHILEn2REPo2(PROC(TEXT CONST,INT CONST)g3)END REP;aenderungeneintragenEND PROCf3;PROCg3(TEXT 
+CONSTh3,INT CONSTk0):feldaendern(k0,h3)END PROCg3;PROCaendern(PROCd3):enablestop;IFdateiendeTHENeinfuegen(PROCd3)ELSEi3END IF.i3:s1;IFp0>0THENm2;headline(editfile,b3);r1;j3(h1);k3;e3(PROCd3);f3END IF.k3:l3:=1;WHILEl3<=p0REPfeldbearbeiten(m0(l3).k0,PROC(TEXT CONST,INT CONST,INT CONST)m3);insertrecord(editfile);writerecord(editfile,l1);down(editfile);l3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARl3;PROCm3(TEXT CONSTb2,INT CONSTc2,d2):l1:=subtext(b2,n3,o3).n3:c2+m0(l3).l0.o3:IFp3THENd2ELSEc2+m0(l3+1).l0-1END IF.p3:l3=p0CORm0(l3+1).k0<>m0(l3).k0.END PROCm3;PROCsuchen(PROCd3):enablestop;s1;suchbedingungloeschen;IFp0>0THENm2;headline(editfile,c3);r1;e3(PROCd3);q3END IF.q3:WHILEn2REPo2(PROC(TEXT CONST,INT CONST)r3)END REP.END PROCsuchen;PROCr3(TEXT CONSTs3,INT CONSTk0):suchbedingung(k0,s3)END PROCr3;PROCbildausgeben(BOOL CONSTt3):enablestop;s1;r1;IFe1THENu3(t3)ELIFt3ORh1ORv3ORz0<>suchversionTHENj3(h1);a1:=satznummer;b1:=satzkombination;z0:=suchversion;w3(TRUE)ELSEx3(TRUE)END IF.v3:
+satznummer<>a1ORb1<>satzkombination.END PROCbildausgeben;INT VARl0;BOOL VARy3;PROCj3(BOOL CONSTz3):INT VARk2:=1,a4:=0;y3:=TRUE;WHILEk2<=p0OR NOTy3REPb4END REP.b4:IFy3CANDm0(k2).k0=a4THENc4ELSE IFd4THENe4END IF;m0(k2).l0:=l0;feldbearbeiten(m0(k2).k0,PROC(TEXT CONST,INT CONST,INT CONST)f4);k2INCR1END IF.c4:IFz3THENg4(k2)ELSEm0(k2).l0:=l0;k2INCR1END IF.d4:k2>p0CORm0(k2).k0<>a4.e4:IFy3THENh4ELSEi4(k2);m0(k2).k0:=a4END IF.h4:a4:=m0(k2).k0;l0:=0.END PROCj3;PROCf4(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTj4:=d2-c2-l0+1;IFj4>w0-2THENl0INCRw0-2;k4;y3:=FALSE ELSEl0INCRj4;y3:=TRUE END IF.k4:INT VARl4:=c2+l0;IFm4ANDn4THENl4DECR1;WHILE(b2SUBl4)<>c0REPl4DECR1;l0DECR1END REP END IF.m4:(b2SUBl4)<>c0.n4:pos(b2,c0,l4-w0,l4)>0.END PROCf4;PROCi4(INT CONSTk2):INT VARo4;FORo4FROMp0DOWNTOk2REPm0(o4+1):=m0(o4)END REP;p0INCR1;h1:=TRUE END PROCi4;PROCg4(INT CONSTk2):INT VARo4;FORo4FROMk2+1UPTOp0REPm0(o4-1):=m0(o4)END REP;p0DECR1;h1:=TRUE END PROCg4;INT VARp4;TEXT VARq4,r4,s4,t4:="",u4;LETv4=
+""15" Bild verschoben ! ESC 1 druecken ! "14"",w4=""3""10"19"11""12"q?h";LETx4=1,y4=2,z4=3,a5=4,b5=5,c5=6,d5=7,e5=8,f5=9;PROCe3(PROCd3):INT VARg5:=q0;h5;REPw3(FALSE);i5;j5;k5;l5UNTILm5END REP;n5;toline(editfile,1);col(editfile,1).h5:BOOL CONSTo5:=e1;IFe1THENuebersichtsanzeige(FALSE)END IF.i5:IFlines(editfile)<p0+1THENoutput(editfile);line(editfile,p0-lines(editfile)+2);modify(editfile)END IF.j5:IFq0<>1THENp5(q0-1,r4)END IF;p5(q5,s4);toline(editfile,g5).q5:min(p0+1,q0+r0-1).k5:openeditor(groesstereditor+1,editfile,TRUE,u0+v0+3,t0,w0,r5);edit(groesstereditor,w4+t4,PROC(TEXT CONST)s5).r5:min(p0-q0+2,r0).l5:g5:=lineno(editfile);t5;SELECTp4OF CASEx4:u5CASEy4:v5CASEz4:w5CASEa5:x5CASEb5:y5CASEc5:z5CASEe5:d3;h1:=TRUE CASEf5:n5;errorstop(d0)END SELECT.t5:INT CONSTa6:=col(editfile);col(editfile,1);IFq0<>1THENb6(q0-1,r4)END IF;b6(q5,s4);col(editfile,a6).u5:INT VARc6;c6:=g5-q0;rollen(-r0+1);g5:=q0+c6.v5:c6:=g5-q0;rollen(r0-1);g5:=min(q0+c6,p0).w5:rollen(-999);g5:=1.x5:c6:=g5-q0;rollen(999);g5:=min
+(q0+c6,p0).y5:toline(editfile,g5);d6;i4(g5).d6:readrecord(editfile,l1);q4:=subtext(l1,a6);l1:=subtext(l1,1,a6-1);writerecord(editfile,l1);down(editfile);insertrecord(editfile);writerecord(editfile,q4).z5:toline(editfile,g5);IFa6=1AND(e6CANDf6ORg6CANDh6)THENi6ELSEj6END IF.e6:g5<>p0.f6:m0(g5+1).k0=m0(g5).k0.g6:g5<>1.h6:m0(g5-1).k0=m0(g5).k0.i6:deleterecord(editfile);g4(g5).j6:readrecord(editfile,l1);l1:=subtext(l1,1,a6-1);writerecord(editfile,l1).m5:p4=d5.n5:IFo5THENuebersichtsanzeige(TRUE)END IF.END PROCe3;PROCs5(TEXT CONSTk6):enablestop;setbusyindicator;p4:=pos(w4,k6);IFp4>0THENu4:=k6;quitELIFpos(t4,k6)>0THENp4:=d5;u4:=k6;quitELIFkommandoauftaste(k6)<>d0THENstdkommandointerpreter(k6)ELSEnichtsneuEND IF END PROCs5;PROCp5(INT CONSTk2,TEXT VARl6):toline(editfile,k2);readrecord(editfile,l6);writerecord(editfile,v4)END PROCp5;PROCb6(INT CONSTk2,TEXT CONSTl6):toline(editfile,k2);IFeof(editfile)CORpos(editfile,v4,1)=0THENtoline(editfile,1);down(editfile,v4);IFeof(editfile)THENtoline(editfile,
+k2);insertrecord(editfile)END IF END IF;writerecord(editfile,l6)END PROCb6;PROCexitzeichen(TEXT CONSTm6):t4:=m6END PROCexitzeichen;TEXT PROCexitdurch:u4END PROCexitdurch;INT VARn6;LETo6="ENDE",p6="SUCH+",q6="SUCH-",r6="MARK+",s6="MARK-",t6=".....",u6="       ",v6=" Feld    "14" ",w6=" Satz   ";PROCw3(BOOL CONSTx6):INT VARy6:=t0+1,z6:=0;INT CONSTa7:=q0+r0-2;x3(x6);n6:=q0;WHILEn6<=a7REPb7;c7;d7;y6INCR1;n6INCR1END REP;h1:=FALSE.b7:IFh1THENcursor(u0,y6);IFn6<=p0THENe7ELIFn6=p0+1THENf7ELSEg7END IF END IF.e7:out(g0);IFm0(n6).k0=z6THENv0TIMESOUTc0ELSEz6:=m0(n6).k0;feldnamenbearbeiten(z6,PROC(TEXT CONST,INT CONST,INT CONST)h7)END IF;out(i0).f7:out(g0);s0-4TIMESOUT".";out(j0).g7:IFg1THEN IFt0+r0=25THENout(f0);h1:=FALSE;LEAVEw3ELSEout(e0)END IF ELSEs0TIMESOUTc0END IF.c7:IFx6ANDn6<=p0THENcursor(u0+v0+3,y6);feldbearbeiten(m0(n6).k0,PROC(TEXT CONST,INT CONST,INT CONST)i7)END IF.d7:IF NOTh1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(t4,input)>0THENa1:=0;LEAVEw3END IF END IF END
+ IF.END PROCw3;PROCx3(BOOL CONSTx6):j7;k7;cursor(u0,t0);IF NOTx6THENoutsubtext(k1,1,v0+3);LEAVEx3END IF;replace(k1,v0+7,l7);replace(k1,v0+14,m7);out(k1);cursor(u0+s0-5,t0);out(text(q0)).j7:TEXT VARsatznr;IFdateiendeTHENsatznr:=o6ELSEsatznr:=text(satznummer);IFanzahlkoppeldateien>0THENsatznrCAT"-";satznrCATtext(satzkombination)END IF END IF.k7:replace(k1,7,u6);replace(k1,7,satznr).l7:IFsuchversion=0THENt6ELIFsatzausgewaehltTHENp6ELSEq6END IF.m7:IFmarkiertesaetze=0THENt6ELIFsatzmarkiertTHENr6ELSEs6END IF.END PROCx3;PROCh7(TEXT CONSTb2,INT CONSTc2,d2):IFd2-c2>=v0THENoutsubtext(b2,c2,c2+v0-1)ELSEoutsubtext(b2,c2,d2);v0-d2+c2-1TIMESOUTc0END IF END PROCh7;PROCi7(TEXT CONSTb2,INT CONSTc2,d2):INT VARx2;IFn6=p0CORn7THENx2:=d2ELSEx2:=c2+m0(n6+1).l0-1END IF;outsubtext(b2,c2+m0(n6).l0,x2);IFg1THENout(e0)ELSEo7TIMESOUTc0END IF.n7:m0(n6+1).k0<>m0(n6).k0.o7:w0-x2+c2+m0(n6).l0-1.END PROCi7;PROCw1:k1:=text(w6,v0+3);k1CATg0;INT VARo4;INT CONSTp7:=s0-length(k1)-11;FORo4FROM1UPTOp7REPk1CAT"."END REP;k1CAT
+v6;q7.q7:TEXT VARr7:=eudasdateiname(1);r7:=subtext(r7,1,p7-20);r7CATc0;replace(k1,v0+21,c0);replace(k1,v0+22,r7).END PROCw1;INT VARs7;BOOL VARt7;LETu7=""15"Satznr. ",v7="  << DATEIENDE >>";PROCu3(BOOL CONSTt3):BOOL VARw7:=TRUE;INT VARo4;INT CONSTx7:=x0;y7;t7:=FALSE;IFh1ORw7THENz7;h1:=FALSE ELSEa8END IF;y0:=0;b8.y7:IFsuchversion<>z0ORc8THENd8;z0:=suchversionELIFx0>0CANDy0<>0THENe8ELIFf8THENg8;x0:=1ELIF NOTt3THENw7:=FALSE END IF.c8:satznummer+y0<0.d8:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;g8;x0:=1.f8:x0=0CORh8.h8:IFi8(x0)THEN FALSE ELSEj8END IF.j8:FORo4FROM1UPTOr0-1REP IFi8(o4)THENx0:=o4;LEAVEj8WITH FALSE END IF END REP;TRUE.e8:IFy0<0THENu5ELSEv5END IF.u5:IF-y0<x0THENx0INCRy0;w7:=FALSE ELSEk8(1);FORo4FROM1UPTO-y0WHILEsatznummer>1REPzurueck(2)END REP;g8END IF.v5:IFy0+x0<r0THENx0INCRy0;w7:=FALSE ELIFy0<r0-1THENl8ELIFn0(r0-1)<>0THENm8END IF.l8:INT CONSTn8:=y0+1;IFn0(n8)<>0THENn0(1):=n0(n8);o0(1):=o0(n8)END IF.m8:k8(r0-1);FORo4FROM1UPTOy0-r0+2WHILE NOTdateiendeREPweiter(2)END 
+REP;g8.z7:o8;p8;INT VARq8;FORq8FROM2UPTOr0-1REPr8END REP.o8:cursor(u0,t0);out(u7);s7:=s0-10;INT VARfeldindex;FORfeldindexFROM1UPTOlength(j1)WHILEs7>0REPfeldnamenbearbeiten(code(j1SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)s8)END REP;t8;cursor(u0+s0-1,t0);out(h0).p8:k8(1);u8(1);v8.r8:cursor(u0,t0+q8);IFdateiendeTHENn0(q8):=0;s7:=s0;t8ELSEw8;u8(q8);v8END IF.w8:IFw7THENweiter(2);x8;n0(q8):=satznummer;o0(q8):=satzkombinationELSEk8(q8)END IF.x8:IF NOT(satzausgewaehltORdateiende)THENh1:=TRUE;LEAVEu3END IF.a8:u8(x7).b8:t7:=TRUE;WHILEn0(x0)=0REPx0DECR1END REP;u8(x0);k8(x0);y8.END PROCu3;PROCk8(INT CONSTs3):aufsatz(n0(s3));WHILEsatzkombination<>o0(s3)REPweiter(1)END REP END PROCk8;PROCg8:n0(1):=satznummer;o0(1):=satzkombinationEND PROCg8;BOOL PROCi8(INT CONSTs3):satznummer=n0(s3)CANDsatzkombination=o0(s3)END PROCi8;PROCs8(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTr0:=min(s7,d2-c2+1);outsubtext(b2,c2,c2+r0-1);s7DECRr0;IFs7>=2THENout(", ");s7DECR2ELIFs7=1THENout(",");s7:=0END IF END PROCs8;
+PROCu8(INT CONSTs3):cursor(u0,t0+s3);IFt7THENout(g0)ELSEout(c0)END IF;outtext(text(n0(s3)),1,5);IFt7THENout(h0)ELSEout(c0)END IF;s7:=s0-7END PROCu8;PROCt8:IFg1THENout(e0)ELSEs7TIMESOUTc0END IF END PROCt8;PROCv8:IFsatzausgewaehltTHENy8;z8ELIFdateiendeTHENout(v7);s7DECR17ELSEy8;out("<< >>");s7DECR5END IF;t8.z8:INT VARfeldindex;FORfeldindexFROM1UPTOlength(j1)WHILEs7>0REPfeldbearbeiten(code(j1SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)s8)END REP.END PROCv8;PROCy8:IFsatzmarkiertTHENout("+ ")ELSEout("- ")END IF;s7DECR2END PROCy8;END PACKETsatzanzeige;
+PACKETeudassteuerungDEFINESeudas,dateiverwaltung,edit,dateinamenanfordern,ausfuehrung,einzelausfuehrung:LETa9=1003,b9=3243;LETd0="",c0=" ",c9=""7"",d9=""27"z",e0=""5"",e9=""27"qa",f9=""27"qb";FILE VARg9;DATASPACE VARh9;INT VARi9,j9:=dateiversion-1;FENSTER VARx4,y4;TEXT VARk9;fensterinitialisieren(x4);fensterinitialisieren(y4);fenstergroessesetzen(x4,1,1,79,6);fenstergroessesetzen(y4,1,8,79,17);dialogfenster(1,9,79,16);neuerdialog(""6""7""0":"+75*"-"+":"5"");anzeigefenster(1,8,79,17);statuszeile(""6""6""0" ",""5"");LETl9="Bitte erst eine Datei oeffnen !",m9="Bei geketteten oder gekoppelten Dateien nicht moeglich",n9="Keine Sicherung noetig.",o9="Interne Arbeitskopien loeschen",p9="Arbeitskopie ",q9=" unveraendert.",r9=" veraendert! Sichern",s9="Alte Version ueberschreiben",t9="Sondern unter dem Namen:",u9=" ueberschreiben",v9="Datei wieder sortieren",w9="Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)",x9="Pruefbedingungen aendern",y9="Feldnamen anfuegen",z9="Neuer Feldname:",
+a10="Neuer Typ (TEXT,DIN,ZAHL,DATUM):",b10="Neue Feldnamen eingeben",c10="TEXT",d10="DIN",e10="ZAHL",f10="DATUM",g10="Alte Feldreihenfolge aendern",h10=""7"ACHTUNG: System voll, Dateien loeschen!";PROCeudas:page;bildschirmneu;dialog;i9:=heapsize;menueanbieten("EUDAS-Hauptmenue",x4,TRUE,PROC(INT CONST)i10);j10;page;bildschirmneuEND PROCeudas;PROCi10(INT CONSTk10):enablestop;SELECTk10OF CASE1:l10CASE2:m10CASE3:n10CASE4:o10CASE5:p10CASE6:q10CASE7:r10CASE8:dateiverwaltungEND SELECT;s10;t10.l10:u10;exitzeichen("wz");bildausgeben(TRUE);menueanbieten("EUDAS-Ansehen",x4,TRUE,PROC(INT CONST)v10);dialog.m10:neuerdialog;dialog;menueanbieten("EUDAS-Bearbeiten",x4,TRUE,PROC(INT CONST)w10).u10:IFanzahldateien=0OR NOTexists(eudasdateiname(1))THENerrorstop(l9)END IF.n10:j10;dateienloeschen(TRUE);forget(h9);x10:=TRUE;ausfuehrung(PROC(TEXT CONST)y10,b9).o10:u10;IFanzahldateien>1THENerrorstop(m9)ELSEzugriff(PROC(EUDAT VAR)z10)END IF.p10:ausfuehrung(PROC(TEXT CONST)kopple,b9).q10:u10;IFanzahldateien>1THEN
+errorstop(m9)ELSEzugriff(PROC(EUDAT VAR)a11)END IF.r10:IFaendernerlaubtTHENb11ELSEdialog;out(n9)END IF.b11:INT VARc11;FORc11FROM1UPTOanzahldateienREPd11(c11)END REP;IFja(o9,"JA/Dateien loeschen")THENdateienloeschen(TRUE)ELSEerrorstop(d0)END IF.t10:IFheapsize-i9>4THENcollectheapgarbage;i9:=heapsizeEND IF.END PROCi10;PROCj10:INT VARc11;FORc11FROM1UPTOanzahldateienREP IFinhaltveraendert(c11)THENd11(c11)END IF END REP END PROCj10;PROCd11(INT CONSTc11):e11;IFinhaltveraendert(c11)THEN IFja(e5,"JA/sichere")THENf11END IF ELSEdialog;out(e5)END IF.e11:TEXT VARe5:=p9;e5CATtextdarstellung(eudasdateiname(c11));IFinhaltveraendert(c11)THENe5CATr9ELSEe5CATq9END IF.f11:TEXT VARname:=eudasdateiname(c11);IFja(s9,"JA/alte version")THENforget(name,quiet)ELSEg11END IF;sichere(c11,name);h11.g11:editget(t9,name,"","GET/Sicherungsname");IFexists(name)THENi11END IF.i11:IFja(textdarstellung(name)+u9,"JA/ueber")THENforget(name,quiet)ELSEd11(c11);LEAVEd11END IF.h11:EUDAT VARj11;oeffne(j11,name);IFk11CANDl11THENm11
+;sortiere(j11)END IF.k11:sortierreihenfolge(j11)<>d0CANDunsortiertesaetze(j11)>0.l11:ja(v9,"JA/Sicherungssortierung").END PROCd11;BOOL VARx10;PROCy10(TEXT CONSTr7):BOOL VARn11;IFx10THENo11;oeffne(r7,n11);x10:=FALSE ELSEkette(r7)END IF.o11:IF NOTexists(r7)THENp11(r7);EUDAT VARj11;oeffne(j11,r7);z10(j11);n11:=TRUE ELSEn11:=ja(w9,"JA/oeffne")END IF.END PROCy10;PROCz10(EUDAT VARj11):SATZ VARb2;feldnamenlesen(j11,b2);IFq11THENr11END IF;s11;IFja(x9,"JA/Pruefbed")THENt11END IF.q11:IFfelderzahl(b2)>0THENja(y9,"JA/feldnamen")ELSE TRUE END IF.r11:DATASPACE VARu11:=nilspace;FILE VARf:=sequentialfile(output,u11);disablestop;v11(f,b2);forget(u11);enablestop;feldnamenaendern(j11,b2).s11:w11;auswahlanbieten("EUDAS-Felder",y4,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)x11);INT VARk0:=1;WHILEwahl(k0)>0REPg3;k0INCR1END REP;feldnamenaendern(j11,b2).w11:satzinitialisieren(y11);FORk0FROM1UPTOfelderzahl(b2)REPfeldlesen(b2,k0,k9);feldaendern(y11,k0,z11+textdarstellung(k9))END REP.z11:"("+a12(feldinfo(j11,k0))+
+") ".g3:TEXT VARb12;feldlesen(b2,wahl(k0),b12);editget(z9,b12,"","GET/feldname");feldaendern(b2,wahl(k0),b12);TEXT VARc12:=a12(feldinfo(j11,wahl(k0)));REPeditget(a10,c12,"","GET/feldtyp")UNTILd12(c12)>=-1END REP;feldinfo(j11,wahl(k0),d12(c12)).t11:u11:=nilspace;f:=sequentialfile(output,u11);notizenlesen(j11,1,k9);disablestop;e12(f,k9);forget(u11);enablestop;notizenaendern(j11,1,k9).END PROCz10;PROCv11(FILE VARf,SATZ VARb2):enablestop;f12;g12.f12:modify(f);headline(f,b10);edit(f,y4,"EDIT/Feldnamen").g12:INT VARk0:=felderzahl(b2);input(f);WHILE NOTeof(f)REPgetline(f,k9);h12;k0INCR1;feldaendern(b2,k0,k9)END REP.h12:IF(k9SUBlength(k9))=c0THENk9:=subtext(k9,1,length(k9)-1)END IF.END PROCv11;TEXT PROCa12(INT CONSTc12):SELECTc12+1OF CASE0:c10CASE1:d10CASE2:e10CASE3:f10OTHERWISEd0END SELECT END PROCa12;INT PROCd12(TEXT CONSTi12):IFi12=c10THEN-1ELIFi12=d10THEN0ELIFi12=e10THEN1ELIFi12=f10THEN2ELSE-2END IF END PROCd12;PROCe12(FILE VARf,TEXT VARj12):LETk12="#-#";enablestop;l12;m12;n12.l12:INT VAR
+c2:=1,d2;REPd2:=pos(j12,k12,c2);IFd2=0THENputline(f,subtext(j12,c2))ELSEputline(f,subtext(j12,c2,d2-1))END IF;c2:=d2+3UNTILd2=0ORc2>length(j12)END REP.m12:modify(f);headline(f,x9);edit(f,y4,"EDIT/Pruefbed").n12:TEXT VARs3;j12:=d0;input(f);WHILE NOTeof(f)REPgetline(f,s3);h12;j12CATs3;j12CATk12END REP.h12:IF(s3SUBlength(s3))=c0THENs3:=subtext(s3,1,length(s3)-1)END IF.END PROCe12;PROCa11(EUDAT VARj11):TEXT VARo12:=sortierreihenfolge(j11);IFo12=d0CORp12THENq12;m11;sortiere(j11,o12)ELSEm11;sortiere(j11)END IF.p12:ja(g10,"JA/Sortierfelder").q12:feldnamenlesen(j11,y11);auswahlanbieten("EUDAS-Sortierfelder",y4,"AUSWAHL/Sortierfelder",PROC(TEXT VAR,INT CONST)x11);INT VARk0:=1;o12:=d0;WHILEwahl(k0)<>0REPo12CATcode(wahl(k0));k0INCR1END REP.END PROCa11;PROCs10:INT VARr12,s12;storage(r12,s12);IFs12>r12THENneuerdialog;dialog;out(h10)END IF END PROCs10;LETt12="     Rollen: ESC OBEN / ESC UNTEN    Zurueck: ESC q    Hilfe: ESC ?",u12=
+"Zeile loeschen: ESC RUBOUT  Abbruch: ESC h  Beenden: ESC q  Hilfe: ESC ?",v12="Ungueltige Satznummer",w12="Neue Satznummer:",x12=" Bitte warten.. ";PROCv10(INT CONSTk10):y12(k10);IFiserrorTHENfehlerausgeben;bildausgeben(TRUE);errorstop(d0)END IF END PROCv10;PROCy12(INT CONSTk10):enablestop;SELECTk10OF CASE1:z12CASE2:a13CASE3:b13CASE4:c13CASE5:d13CASE6:e13CASE7:f13CASE8:m10END SELECT;s10.z12:m11;weiter(2);IFuebersichtsanzeigeTHENrollen(1)END IF;bildausgeben(FALSE).a13:m11;zurueck(2);bildausgeben(FALSE).b13:disablestop;exitzeichen("");statusanzeigen(u12);suchen(PROCg13);exitzeichen("wz");enablestop;bildausgeben(TRUE).c13:suchbedingungloeschen;bildausgeben(FALSE).d13:TEXT VARh13:=d0;editget(w12,h13,"","GET/auf satz");INT CONSTi13:=int(h13);IFlastconversionokTHENaufsatz(i13);bildausgeben(FALSE)ELSEerrorstop(v12)END IF.e13:statusanzeigen(t12);TEXT VARj13;REPcursor(1,7);getchar(j13);k13END REP.k13:SELECTpos(""3""10""27"",j13)OF CASE1:rollen(-1)CASE2:rollen(1)CASE3:l13OTHERWISEout(c9)END 
+SELECT;bildausgeben(FALSE).l13:getchar(j13);SELECTpos(""3""10"19q?"1"",j13)OF CASE1:rollen(-16)CASE2:rollen(16)CASE3:rollen(-9999)CASE4:rollen(9999)CASE5:LEAVEe13CASE6:m13CASE7:eschopausfuehrenOTHERWISEout(c9)END SELECT.m13:hilfeanbieten("EUDAS/rollen",y4);statusanzeigen(t12).f13:menueanbieten("EUDAS-Einzelsatz",x4,TRUE,PROC(INT CONST)n13).m10:push(f9).END PROCy12;PROCg13:hilfeanbieten("EDIT/Suchen",y4)END PROCg13;PROCm11:cursor(1,7);out(x12);out(e0)END PROCm11;BOOL VARo13;LETp13="Aenderungen sind nicht erlaubt",w6="Satz ";PROCn13(INT CONSTk10):q13(k10);IFiserrorTHENfehlerausgeben;bildausgeben(TRUE);errorstop(d0)END IF END PROCn13;PROCq13(INT CONSTk10):enablestop;BOOL VARt3:=TRUE;SELECTk10OF CASE1:r13CASE2:s13CASE3:t13CASE4:u13CASE5:v13CASE6:w13CASE7:x13CASE8:y13END SELECT;s10;bildausgeben(t3).r13:z13;exitzeichen("wz");REPstatusanzeigen(u12);einfuegen(PROCa14);b14;IFo13THENsatzloeschenEND IF;c14END REP.c14:SELECTpos("wz",exitdurch)OF CASE0:LEAVEr13CASE1:IF NOTo13THENm11;weiter(2)END IF
+ CASE2:IF NOTo13THENm11;zurueck(2)END IF END SELECT.s13:z13;exitzeichen("wz");REPd14;statusanzeigen(u12);aendern(PROCe14);b14;IFo13THENsatzloeschenEND IF;f14END REP.f14:SELECTpos("wz",exitdurch)OF CASE0:LEAVEs13CASE1:IF NOTo13THENm11;weiter(2)END IF CASE2:IF NOTo13THENm11;zurueck(2)END IF END SELECT.d14:IFj9=dateiversionTHENmodify(g9);toline(g9,1);col(g9,1);g14END IF.g14:TEXT CONSTi13:=w6+text(satznummer);downety(g9,i13);IF NOTeof(g9)THENh14END IF.h14:INT VARk2:=1;fensterveraendert(x4);REPcursor(1,k2);IFeof(g9)THENout(e0)ELSEexec(PROC(TEXT CONST,INT CONST)i14,g9,0);down(g9,i13)END IF;k2INCR1UNTILk2>6END REP.t13:markierungaendern;t3:=FALSE.u13:markierungenloeschen.v13:z13;dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)k14,b9).w13:z13;dateinamenanfordern(l14);einzelausfuehrung(PROC(TEXT CONST)holesatz,b9).x13:uebersichtsanzeige(NOTuebersichtsanzeige).y13:auswahlanbieten("EUDAS-Anzeigefelder",y4,"AUSWAHL/Anzeigefelder",PROC(TEXT VAR,INT CONST)m14);TEXT VARi2:=d0;INT VARh13:=1;
+WHILEwahl(h13)>0REPi2CATcode(wahl(h13));h13INCR1END REP;feldauswahl(i2);t3:=FALSE.END PROCq13;PROCz13:IF NOTaendernerlaubtTHENerrorstop(p13)END IF END PROCz13;PROCa14:hilfeanbieten("EDIT/Einfuegen",y4)END PROCa14;PROCe14:hilfeanbieten("EDIT/Aendern",y4)END PROCe14;PROCi14(TEXT CONSTs3,INT CONSTe2):INT CONSTn14:=e2;outsubtext(s3,l0);out(e0).l0:pos(s3,c0,6)+1.END PROCi14;PROCb14:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)o14)END PROCb14;PROCo14(TEXT CONSTb2,INT CONSTc2,d2):INT CONSTn14:=d2;o13:=c2<3ORc2>length(b2)END PROCo14;PROCm14(TEXT VARname,INT CONSTh13):IFh13<=anzahlfelderTHENfeldnamenlesen(h13,name)ELSEname:=d0END IF END PROCm14;PROCk14(TEXT CONSTr7):IFexists(r7)THENp14ELSEp11(r7)END IF;m11;tragesatz(r7).p14:IFq14(r7)<>0THENerrorstop(r14)END IF.END PROCk14;LETs14="Zieldatei anschliessend sortieren",t14="Pruefbedingungen testen",u14="Prueffehler festgestellt",r14="Zieldatei darf nicht geoeffnet sein",v14="Kopiermuster aendern";PROCw10(INT CONSTk10):enablestop;SELECTk10OF 
+CASE1:w14CASE2:x14CASE3:y14CASE4:z14CASE5:a15CASE6:b15CASE7:l10CASE8:dateiverwaltungEND SELECT;c15;s10.w14:dateinamenanfordern(d15);ausfuehrung(PROC(TEXT CONST)e15,a9).x14:z13;dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)f15,b9).y14:ausfuehrung(PROC(TEXT CONST)g15,a9).z14:dateinamenanfordern(j14);einzelausfuehrung(PROC(TEXT CONST)h15,b9).a15:ausfuehrung(PROC(TEXT CONST)print,a9).b15:z13;dateinamenanfordern(i15);ausfuehrung(PROC(TEXT CONST)j15,a9).l10:push(e9).END PROCw10;PROCk15:IFl15THENclearerrorEND IF.l15:iserrorCANDerrormessage=d0.END PROCk15;PROCe15(TEXT CONSTr7):IF NOTexists(r7)THENg15(r7)END IF;m11;dialog;disablestop;drucke(r7);k15END PROCe15;PROCf15(TEXT CONSTr7):BOOL VARm15;IFexists(r7)THENp14;n15ELSEp11(r7);m15:=FALSE END IF;BOOL CONSTo15:=ja(s14,"JA/sortieren");m11;p15;trage(r7,g9,m15);q15;IFo15THEN EUDAT VARj11;oeffne(j11,r7);sortiere(j11)END IF.p14:IFq14(r7)<>0THENerrorstop(r14)END IF.n15:m15:=ja(t14,"JA/testen").p15:IFm15THENforget(h9);h9:=nilspace;g9:=
+sequentialfile(output,h9);j9:=dateiversionELSEforget(h9);j9:=dateiversion-1END IF.q15:IFm15CANDlines(g9)>0THENdialog;put(lines(g9));put(u14)END IF.END PROCf15;PROCg15(TEXT CONSTr7):r15(r7,"EDIT/Druckmuster")END PROCg15;PROCj15(TEXT CONSTr7):IF NOTexists(r7)THENr15(r7,"EDIT/Verarbeite")END IF;m11;dialog;FILE VARf:=sequentialfile(input,r7);disablestop;verarbeite(f);k15.END PROCj15;PROCh15(TEXT CONSTr7):IFexists(r7)THENp14ELSEp11(r7)END IF;BOOL CONSTo15:=ja(s14,"JA/sortieren");disablestop;DATASPACE VARu11:=nilspace;FILE VARf:=sequentialfile(output,u11);s15(f,r7);forget(u11);enablestop;IFo15THEN EUDAT VARj11;oeffne(j11,r7);sortiere(j11)END IF.p14:IFq14(r7)<>0THENerrorstop(r14)END IF.END PROCh15;PROCs15(FILE VARf,TEXT CONSTr7):enablestop;stdkopiermuster(r7,f);headline(f,v14);REPclearerror;enablestop;edit(f,y4,"EDIT/Kopiermuster");m11;dialog;disablestop;kopiere(r7,f);IFiserrorTHENbildschirmneuEND IF UNTIL NOTt15END REP.t15:iserrorCANDerrormessage=d0CANDerrorcode=0.END PROCs15;INT PROCq14(TEXT
+ CONSTr7):INT VARc11;FORc11FROM1UPTOanzahldateienREP IFeudasdateiname(c11)=r7THEN LEAVEq14WITHc11END IF END REP;0END PROCq14;PROCr15(TEXT CONSTr7,d3):IF NOTexists(r7)THENp11(r7)END IF;FILE VARf:=sequentialfile(modify,r7);edit(f,y4,d3)END PROCr15;PROCprint(TEXT CONSTr7):do("print ("+textdarstellung(r7)+")")END PROCprint;PROCc15:INT VARu15,v15;getcursor(u15,v15);IFv15=24THENbildschirmneu;dialogEND IF END PROCc15;TEXT VARw15:=d0;THESAURUS VARx15;BOOL VARy15,z15;LETa16="Name des Archivs:",b16=" auf Archiv ueberschreiben",c16="Neuer Name:",d16=" im System ueberschreiben",e16=" auf Archiv loeschen",f16=" im System loeschen",g16=" neu einrichten";PROCdateiverwaltung:neuerdialog;dialog;disablestop;y15:=FALSE;menueanbieten("EUDAS-Dateiverwaltung",x4,TRUE,PROC(INT CONST)h16);IFy15THENrelease(archive)END IF END PROCdateiverwaltung;PROCh16(INT CONSTk10):enablestop;SELECTk10OF CASE1:i16CASE2:j16CASE3:k16CASE4:l16CASE5:m16CASE6:n16CASE7:o16CASE8:p16END SELECT;s10.i16:q16;archive(w15);y15:=TRUE;m11;
+x15:=ALLarchive;ausfuehrung(PROC(TEXT CONST)r16,0).j16:ausfuehrung(PROC(TEXT CONST)s16,0).k16:disablestop;t16;m11;x15:=ALLarchive;IFu16THENx15:=ALLarchiveEND IF;enablestop;v16(PROC(TEXT CONST)w16).l16:ausfuehrung(PROC(TEXT CONST)x16,0).m16:q16;archive(w15);y15:=TRUE;m11;x15:=ALLarchive;v16(PROC(TEXT CONST)m16).n16:ausfuehrung(PROC(TEXT CONST)y16,0).o16:t16;disablestop;m11;list(archive);IFu16THENlist(archive)END IF;z16;enablestop;bildschirmneu;dialog.p16:list;z16;bildschirmneu;dialog.END PROCh16;PROCz16:WHILEgetcharety<>d0REP END REP END PROCz16;PROCq16:editget(a16,w15,"","GET/Archivname")END PROCq16;PROCt16:IF NOTy15THENarchive(w15);y15:=TRUE END IF END PROCt16;BOOL PROCu16:IFiserrorTHEN TEXT CONSTa17:=errormessage;IFsubtext(a17,1,14)="Archiv heisst "CANDsubtext(a17,16,20)<>"?????"THENclearerror;b17;LEAVEu16WITH TRUE END IF END IF;FALSE.b17:w15:=subtext(a17,16,length(a17)-1);archive(w15).END PROCu16;PROCr16(TEXT CONSTr7):disablestop;IF NOT(x15CONTAINSr7)CORc17THENd17;m11;e17;save(r7,
+archive);f17END IF.c17:ja(textdarstellung(r7)+b16,"JA/save").d17:INT CONSTh13:=q14(r7);IFh13>0CANDinhaltveraendert(h13)THENd11(h13)END IF.END PROCr16;PROCs16(TEXT CONSTr7):m11;IFtype(old(r7))=b9THENreorganisiere(r7)ELSEreorganize(r7)END IF END PROCs16;PROCx16(TEXT CONSTr7):TEXT VARg17:=r7;IFexists(r7)THENeditget(c16,g17,"","GET/rename")END IF;rename(r7,g17)END PROCx16;PROCw16(TEXT CONSTr7):disablestop;IF NOTexists(r7)CORh17THENm11;e17;fetch(r7,archive);f17END IF.h17:ja(textdarstellung(r7)+d16,"JA/fetch").END PROCw16;PROCm16(TEXT CONSTr7):disablestop;IF NOT(x15CONTAINSr7)CORm16THENm11;e17;erase(r7,archive);f17END IF.m16:ja(textdarstellung(r7)+e16,"JA/erase").END PROCm16;PROCy16(TEXT CONSTr7):IFexists(r7)CANDi17THENforget(r7,quiet)END IF.i17:ja(textdarstellung(r7)+f16,"JA/forget").END PROCy16;PROCe17:z15:=commanddialogue;commanddialogue(FALSE)END PROCe17;PROCf17:commanddialogue(z15)END PROCf17;PROCv16(PROC(TEXT CONST)j17):TEXT VARr7:=d0;editget(k17,r7,"z","GET/Dateiname");IFr7=d9THENl17
+ELSElastparam(r7);j17(r7)END IF.l17:m17(x15,0);auswahlanbieten("EUDAS-Archivauswahl",y4,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)x11);n17(PROC(TEXT CONST)j17).END PROCv16;SATZ VARy11;LETk17="Name der Datei:",j14="Name der Zieldatei:",i15="Name der Verarbeitungsvorschrift:",d15="Name des Druckmusters:",l14="Name der Quelldatei:";TEXT VARo17:=k17;PROCm17(THESAURUS CONSTi12,INT CONSTc12):INT VARl4:=1,c2:=0;satzinitialisieren(y11);REPget(i12,k9,c2);IFk9=d0THEN LEAVEm17ELIFc12=0CORtype(old(k9))=c12THENfeldaendern(y11,l4,k9);l4INCR1END IF END REP END PROCm17;PROCp17(TEXT VARh3,INT CONSTl4):IFl4<=256THENfeldlesen(y11,l4,h3);IFh3<>d0THENh3:=textdarstellung(h3)END IF ELSEh3:=d0END IF END PROCp17;PROCn17(PROC(TEXT CONST)j17):INT VARl4:=1;REP IFwahl(l4)=0THEN LEAVEn17ELSEfeldlesen(y11,wahl(l4),k9);dialog;out(text(l4,3));out(". ");out(textdarstellung(k9));lastparam(k9);j17(k9)END IF;l4INCR1END REP END PROCn17;PROCausfuehrung(PROC(TEXT CONST)j17,INT CONSTc12):TEXT VARr7;dateinamenanfordern(r7,c12);
+IFr7=d9THENn17(PROC(TEXT CONST)j17)ELSElastparam(r7);j17(r7)END IF END PROCausfuehrung;PROCeinzelausfuehrung(PROC(TEXT CONST)j17,INT CONSTc12):TEXT VARr7;dateinamenanfordern(r7,c12);IFr7=d9THEN IFwahl(1)=0THENerrorstop(d0)ELSEfeldlesen(y11,wahl(1),r7)END IF END IF;lastparam(r7);j17(r7)END PROCeinzelausfuehrung;PROCdateinamenanfordern(TEXT CONSTq17):o17:=q17END PROCdateinamenanfordern;PROCdateinamenanfordern(TEXT VARr7,INT CONSTc12):IFexists(std)AND(c12=0CORtype(old(std))=c12)THENr7:=stdELSEr7:=d0END IF;disablestop;editget(o17,r7,"z","GET/Dateiname");o17:=k17;enablestop;IFr7=d0THENerrorstop(d0)ELIFr7=d9THENm17(all,c12);auswahlanbieten("EUDAS-Dateiauswahl",y4,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)p17)END IF END PROCdateinamenanfordern;PROCx11(TEXT VARh3,INT CONSTl4):IFl4<=256THENfeldlesen(y11,l4,h3)ELSEh3:=d0END IF END PROCx11;PROCp11(TEXT CONSTr7):IF NOTja(textdarstellung(r7)+g16,"JA/einrichten")THENerrorstop(d0)END IF END PROCp11;LETr17=
+"Editieren    ESC h - Abbruch   ESC q - Verlassen   ESC ? - Hilfe";PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTd3):INT VARu15,v15,s17,t17;fenstergroesse(fenster,u15,v15,s17,t17);fensterveraendert(fenster);enablestop;REPstatusanzeigen(r17);openeditor(groesstereditor+1,f,TRUE,u15,v15,s17,t17);edit(groesstereditor,"eqvw19dpgn"9"?h",PROC(TEXT CONST)u17);SELECTv17OF CASE0:LEAVEeditCASE1:hilfeanbieten(d3,fenster)CASE2:errorstop(d0)END SELECT END REP END PROCedit;INT VARv17;PROCu17(TEXT CONSTk6):v17:=pos("?h",k6);IFv17>0THENquitELSEstdkommandointerpreter(k6)END IF END PROCu17;END PACKETeudassteuerung;
+
diff --git a/app/eudas/3.4/src/eudas.gen-m b/app/eudas/3.4/src/eudas.gen-m
new file mode 100644
index 0000000..4a4dc5d
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.gen-m
@@ -0,0 +1,49 @@
+INT VAR size, used;
+BOOL VAR einzeln;
+storage (size, used);
+einzeln := size - used < 500;
+forget ("eudas.gen/m", quiet);
+page;
+putline ("EUDAS - automatische Generierung");
+line;
+IF NOT einzeln THEN
+  holen ("eudas.1");
+  holen ("eudas.2");
+  holen ("eudas.3");
+  holen ("eudas.4");
+  holen ("eudas.init");
+  release (archive)
+END IF;
+check off;
+gen ("eudas.1");
+gen ("eudas.2");
+gen ("eudas.3");
+gen ("eudas.4");
+IF anything noted THEN
+  push (""27"q"); note edit; pause (100)
+END IF;
+holen ("eudas.init");
+IF einzeln THEN
+  release (archive)
+END IF;
+do("FILE VARf:=sequentialfile(modify,""eudas.init"");menuedateneinlesen(f)");
+forget ("eudas.init", quiet);
+check on;
+do ("global manager");
+
+PROC vom archiv (TEXT CONST datei):
+  out (""""); out (datei); putline (""" wird geholt.");
+  fetch (datei, archive)
+END PROC vom archiv;
+
+PROC holen (TEXT CONST datei) :
+  IF NOT exists (datei) THEN vom archiv (datei) END IF
+END PROC holen;
+
+PROC gen (TEXT CONST datei) :
+  holen (datei);
+  out (""""); out (datei); out (""" wird uebersetzt: ");
+  insert (datei);
+  forget (datei, quiet)
+END PROC gen;
+
diff --git a/app/eudas/3.4/src/eudas.gen-s b/app/eudas/3.4/src/eudas.gen-s
new file mode 100644
index 0000000..b9541ff
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.gen-s
@@ -0,0 +1,39 @@
+forget ("eudas.gen/s", quiet);
+page;
+putline ("EUDAS - automatische Generierung");
+line;
+check off;
+gen ("eudas.1");
+gen ("eudas.2");
+holen ("eudas.3");
+FILE VAR f := sequential file (modify, "eudas.3");
+to line (f, 30); delete record (f);
+to line (f, 28); delete record (f);
+to line (f, 7);  delete record (f);
+to line (f, 5);  delete record (f);
+gen ("eudas.3");
+gen ("eudas.4");
+IF anything noted THEN
+  push (""27"q"); note edit; pause (100)
+END IF;
+holen ("eudas.init"); 
+do("FILE VARf:=sequentialfile(modify,""eudas.init"");menuedateneinlesen(f)");
+forget ("eudas.init", quiet);
+check on;
+
+PROC vom archiv (TEXT CONST datei):
+  out (""""); out (datei); putline (""" wird geholt.");
+  fetch (datei, archive)
+END PROC vom archiv;
+
+PROC holen (TEXT CONST datei) :
+  IF NOT exists (datei) THEN vom archiv (datei) END IF
+END PROC holen;
+
+PROC gen (TEXT CONST datei) :
+  holen (datei);
+  out (""""); out (datei); out (""" wird uebersetzt: ");
+  insert (datei);
+  forget (datei, quiet)
+END PROC gen;
+
diff --git a/app/eudas/3.4/src/eudas.init b/app/eudas/3.4/src/eudas.init
new file mode 100644
index 0000000..ab9bcbb
--- /dev/null
+++ b/app/eudas/3.4/src/eudas.init
@@ -0,0 +1,1034 @@
+% MENUE "EUDAS-Hauptmenue" 
+% BILD 
+:---------------------- < EUDAS - Hauptmenue > -----------------------------:
+:  a ­ aktuelle Datei ansehen (M)     b ­ aktuelle Datei bearbeiten (M)     :
+:  o ­ Datei zum Bearbeiten oeffnen   f ­ Feldstruktur aendern              :
+:  k ­ Dateien koppeln                r ­ EUDAS-Datei sortieren             :
+:  s ­ aktuelle Dateien sichern       v ­ Dateiverwaltung (M)               :
+:---------------------------------------------------------------------------:
+% FELD 1 "EUDAS/11" "aA"
+% FELD 2 "EUDAS/12" "bB"
+% FELD 3 "EUDAS/13" "oO"
+% FELD 4 "EUDAS/14" "fF"
+% FELD 5 "EUDAS/15" "kK"
+% FELD 6 "EUDAS/16" "rR"
+% FELD 7 "EUDAS/17" "sS"
+% FELD 8 "EUDAS/18" "vV"
+% ENDE
+% MENUE "EUDAS-Ansehen" 
+% BILD 
+:-------------------------- << Ansehen >> ----------------------------------:
+:  w ­ Satz weiter                    z ­ Satz zurueck                      :
+:  s ­ Selektion einstellen           l ­ Selektion loeschen                :
+:  d ­ direkt auf Satz                v ­ Bild vertikal verschieben         :
+:  e ­ Einzelsatz bearbeiten (M)      b ­ aktuelle Datei bearbeiten (M)     :
+:---------------------------------------------------------------------------:
+% FELD 1 "EUDAS/21" "wW"
+% FELD 2 "EUDAS/22" "zZ"
+% FELD 3 "EUDAS/23" "sS"
+% FELD 4 "EUDAS/24" "lL"
+% FELD 5 "EUDAS/25" "dD"
+% FELD 6 "EUDAS/26" "vV"
+% FELD 7 "EUDAS/27" "eE"
+% FELD 8 "EUDAS/28" "bB"
+% ENDE
+% MENUE "EUDAS-Einzelsatz" 
+% BILD 
+:------------------- <<< Einzelsatz bearbeiten >>> -------------------------:
+:  e ­ neuen Satz einfuegen           a ­ Satz aendern                      :
+:  m ­ Markierung aendern             l ­ alle Markierungen loeschen        :
+:  t ­ Satz tragen                    h ­ Satz holen                        :
+:  d ­ Darstellung umschalten         f ­ Feldauswahl                       :
+:---------------------------------------------------------------------------:
+% FELD 1 "EUDAS/31" "eE"
+% FELD 2 "EUDAS/32" "aA"
+% FELD 3 "EUDAS/33" "mM"
+% FELD 4 "EUDAS/34" "lL"
+% FELD 5 "EUDAS/35" "tT"
+% FELD 6 "EUDAS/36" "hH"
+% FELD 7 "EUDAS/37" "dD"
+% FELD 8 "EUDAS/38" "fF"
+% ENDE
+% MENUE "EUDAS-Bearbeiten" 
+% BILD 
+:-------------------- << aktuelle Datei bearbeiten >> ----------------------:
+:  d ­ nach Muster drucken            t ­ Saetze tragen                     :
+:  e ­ Textdatei erstellen/aendern    k ­ Saetze kopieren                   :
+:  u ­ Textdatei drucken              n ­ nach Vorschrift aendern           :
+:  a ­ aktuelle Datei ansehen (M)     v ­ Dateiverwaltung (M)               :
+:---------------------------------------------------------------------------:
+% FELD 1 "EUDAS/41" "dD"
+% FELD 2 "EUDAS/42" "tT"
+% FELD 3 "EUDAS/43" "eE"
+% FELD 4 "EUDAS/44" "kK"
+% FELD 5 "EUDAS/45" "uU"
+% FELD 6 "EUDAS/46" "nN"
+% FELD 7 "EUDAS/47" "aA"
+% FELD 8 "EUDAS/48" "vV"
+% ENDE
+% MENUE "EUDAS-Dateiverwaltung"
+% BILD 
+:---------------------- << Dateiverwaltung >> ------------------------------:
+:  s ­ Datei auf Archiv sichern       r ­ Datei reorganisieren              :
+:  h ­ Datei von Archiv holen         n ­ Datei umbenennen                  :
+:  o ­ Datei auf Archiv loeschen      l ­ Datei loeschen                    :
+:  a ­ Archivuebersicht               u ­ Dateiuebersicht                   :
+:---------------------------------------------------------------------------:
+% FELD 1 "EUDAS/51" "sS"
+% FELD 2 "EUDAS/52" "rR"
+% FELD 3 "EUDAS/53" "hH"
+% FELD 4 "EUDAS/54" "nN"
+% FELD 5 "EUDAS/55" "oO"
+% FELD 6 "EUDAS/56" "lL"
+% FELD 7 "EUDAS/57" "aA"
+% FELD 8 "EUDAS/58" "uU"
+% ENDE
+% AUSWAHL "EUDAS-Felder"
+% VORSPANN
+:---------------------------------------------------------------------------:
+ Bitte die Felder, die geaendert werden sollen, ankreuzen:
+% BILD
+:---------------------------------------------------------------------------:
+      ­
+:---------------------------------------------------------------------------:
+% ENDE
+% AUSWAHL "EUDAS-Sortierfelder"
+% VORSPANN
+:---------------------------------------------------------------------------:
+ Bitte die Felder, nach denen sortiert werden soll, in Reihenfolge ankreuzen:
+% BILD
+:---------------------------------------------------------------------------:
+      ­
+:---------------------------------------------------------------------------:
+% ENDE
+% AUSWAHL "EUDAS-Anzeigefelder"
+% VORSPANN
+:---------------------------------------------------------------------------:
+ Bitte die Felder, die angezeigt werden sollen, in Reihenfolge ankreuzen:
+% BILD
+:---------------------------------------------------------------------------:
+      ­
+:---------------------------------------------------------------------------:
+% ENDE
+% AUSWAHL "EUDAS-Archivauswahl"
+% VORSPANN
+:---------------------------------------------------------------------------:
+ Auswahl der Dateien auf dem Archiv. Gewuenschte Datei(en) bitte ankreuzen:
+% BILD
+:---------------------------------------------------------------------------:
+      ­
+:---------------------------------------------------------------------------:
+% ENDE
+% AUSWAHL "EUDAS-Dateiauswahl"
+% VORSPANN
+:---------------------------------------------------------------------------:
+ Auswahl der vorhandenen Dateien. Gewuenschte Datei(en) bitte ankreuzen:
+% BILD
+:---------------------------------------------------------------------------:
+      ­
+:---------------------------------------------------------------------------:
+% ENDE
+% HILFE "EUDAS/Allgemein"
+% SEITE 1
+:--- MENÜBEDIENUNG ---
+: Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind durch ein
+: vorangestelltes Minuszeichen gekennzeichnet. Mit den Pfeiltasten können
+: Sie die Schreibmarke zu einer beliebigen Position bewegen. Diese Funktion
+: können Sie dann durch Drücken der Leertaste ausführen.
+:---
+% ENDE
+% HILFE "EUDAS/rollen"
+% SEITE 1
+:---
+: Sie können mit verschiedenen Tasten(kombinationen) den Bildausschnitt
+: vertikal verschieben. Möglichkeiten:
+:  OBEN, UNTEN          eine Zeile rauf oder runter
+:  ESC OBEN, ESC UNTEN  eine Seite rauf oder runter
+:  ESC '1', ESC '9'     auf erste oder letzte Zeile
+:  ESC 'q'              zurück ins Menü
+:---
+% ENDE
+% HILFE "EUDAS/11"
+% SEITE 1
+:--- aktuelle Datei ansehen ---
+: Mit dieser Funktion schalten Sie in ein Untermenü, in dem Sie sich die
+: Dateiinhalte der geöffneten Datei ansehen können. Ist keine Datei ge-
+: öffnet, können Sie diese Funktion nicht ausführen.
+:   => Informationen zur Menübedienung auf der nächsten Seite (ESC 'w')
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/12"
+% SEITE 1
+:--- aktuelle Datei bearbeiten ---
+: Diese Auswahl führt in ein Untermenü, in dem Sie die geöffnete Datei als
+: Ganzes bearbeiten können (Drucken, Kopieren usw.). Es muß dazu eine Datei
+: geöffnet sein.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/13"
+% SEITE 1
+:--- Datei zum Bearbeiten öffnen ---
+: Diese Funktion öffnet eine neue Datei. Sie können angeben, ob Sie die Datei
+: nur ansehen oder auch ändern wollen. Die vorher geöffnete Datei wird ggf.
+: gesichert. Wenn Sie eine neue Datei angeben, wird diese eingerichtet. Dabei
+: müssen Sie die Feldnamen eingeben.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/14"
+% SEITE 1
+:--- Feldstruktur aendern ---
+: Mit dieser Funktion können Sie
+:  1. neue Feldnamen anfügen
+:  2. Feldnamen und Feldtypen ändern
+:  3. Prüfbedingungen eingeben
+:---
+% SEITE 2
+:--- 1. neue Feldnamen anfügen
+: Sie können neue Feldnamen der Datei am Ende anfügen. Sie müssen die Namen
+: untereinander im Editor in der gewünschten Reihenfolge angeben. Vorher
+: werden Sie jedoch gefragt, ob Sie diese Funktion überhaupt ausführen wol-
+: len.
+:---
+% SEITE 3
+:--- 2. Feldnamen und Feldtypen ändern
+: In diesem Teil wird Ihnen eine Auswahl aller vorhandenen Felder angeboten,
+: in der jeweils auch der Typ angegeben ist. Wenn Sie diese Funktion nicht
+: ausführen wollen, beenden Sie die Auswahl einfach mit ESC q. Sonst wählen
+: Sie die Felder aus, deren Namen oder Typ Sie ändern wollen.
+:---
+% SEITE 4
+:--- 3. Prüfbedingungen eingeben
+: Vor dieser Funktion werden Sie ebenfalls gefragt, ob Sie sie ausführen
+: wollen. Wenn ja, können Sie im Editor ein Prüfprogramm eingeben, das mit
+: der Datei gespeichert wird und beim Reintragen neuer Sätze ausgeführt wird.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/15"
+% SEITE 1
+:--- Dateien koppeln ---
+: Mit dieser Funktion können Sie eine Datei angeben, die zu den bisher ge-
+: öffneten Dateien dazugekoppelt wird. Anschließend werden zu jedem Satz der
+: existierenden Datei die in den Koppelfeldern übereinstimmenden Sätze der
+: Koppeldatei gezeigt. 
+:---
+% SEITE 2
+:--- Koppelfelder
+: Als Koppelfelder werden dabei die ersten Felder der Koppeldatei betrachtet,
+: die auch in der geöffneten Datei vorhanden sind.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/16"
+% SEITE 1
+:--- EUDAS-Datei sortieren ---
+: Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei sortiert werden.
+: Die Reihenfolge, in der die Felder berücksichtigt werden, kann vorher ange-
+: geben werden. Eventuell müssen zum richtigen Sortieren Feldtypen vergeben
+: werden (s. "Feldstruktur aendern").
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/17"
+% SEITE 1
+:--- aktuelle Dateien sichern ---
+: EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der Dateien.
+: Wenn Ändern erlaubt ist, müssen geänderte Arbeitskopien mit dieser Funktion
+: gesichert werden. Für eine veränderte Datei kann dabei auch ein neuer Name
+: angegeben werden, damit die alte Version erhalten bleibt.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/18"
+% SEITE 1
+:--- Dateiverwaltung ---
+: Diese Auswahl führt in ein Untermenü, in dem Dateien auf dem Archiv und im
+: System verwaltet werden können. Dateien können umbenannt, gelöscht oder
+: reorganisiert, sowie zwischen Archivdiskette und System hin- und her-
+: transportiert werden. 
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/21"
+% SEITE 1
+:--- Satz weiter ---
+: Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn eine Such-
+: bedingung eingestellt ist, werden nicht ausgewählte Sätze übersprungen.
+:
+:   => Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w')
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/22"
+% SEITE 1
+:--- Satz zurueck ---
+: Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung eingestellt
+: ist, werden nicht ausgewählte Sätze übersprungen.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/23"
+% SEITE 1
+:--- Selektion einstellen ---
+: Mit dieser Funktion kann eine Suchbedingung als Suchmuster eingegeben 
+: werden, die angibt, welche Sätze bearbeitet werden sollen. Die vorher
+: eingestellte Suchbedingung wird automatisch gelöscht. Die Bedingungen für
+: die einzelnen Felder können im Editor eingegeben werden.
+:---
+% SEITE 2
+:--- mögliche Bedingungen
+: Text    identisch mit     Text..      größergleich
+: *Text   endet mit         ..Text      kleiner
+: Text*   beginnt mit       Text..Text  zwischen
+: *Text*  enthält           *           nicht leer
+:---
+% SEITE 3
+:--- Kombination von Bedingungen
+: --Bed      Verneinung
+: Bedingungen für verschiedene Felder: UND
+: Komma zwischen Bed.: lokales ODER (Prio höher als UND)
+: Semikolon zwischen Bed.: globales ODER (Prio niedriger als UND)
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/24"
+% SEITE 1
+:--- Selektion löschen ---
+: Mit dieser Funktion kann eine eingestellte Suchbedingung wieder gelöscht
+: werden, so daß wieder alle Sätze sichtbar sind.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/25"
+% SEITE 1
+:--- direkt auf Satz ---
+: Mit dieser Funktion kann ein bestimmter Satz direkt angewählt werden. Dazu
+: müssen Sie lediglich dessen Satznummer angeben.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/26"
+% SEITE 1
+:--- Bild vertikal verschieben ---
+: In dieser Funktion kann mit verschiedenen Tasten(kombinationen) die Anzeige
+: vertikal verschoben werden, wenn nicht alle Daten auf den Bildschirm
+: passen.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/27"
+% SEITE 1
+:--- Einzelsatz bearbeiten ---
+: Diese Auswahl führt in ein Untermenü, in dem der aktuelle Satz bearbeitet
+: werden kann. Außerdem können dort neue Sätze eingegeben und Einstellungen
+: der Anzeige verändert werden.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/28"
+% SEITE 1
+:--- aktuelle Datei bearbeiten ---
+: Diese Auswahl führt in das Nebenmenü zum Bearbeiten der aktuellen Datei
+: als Ganzes. Hier werden Funktionen zum Drucken, Tragen, Kopieren und
+: Verarbeiten angeboten.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/31"
+% SEITE 1
+:--- neuen Satz einfügen ---
+: Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz eingefügt.
+: Die Inhalte dieses zunächst leeren Satzes können Sie mit Hilfe des 
+: Editors neben die einzelnen Feldnamen schreiben.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/32"
+% SEITE 1
+:--- Satz aendern ---
+: Mit dieser Funktion können Sie die Inhalte des aktuellen Satzes verändern.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/33"
+% SEITE 1
+:--- Markierung ändern ---
+: Mit dieser Funktion können Sie einen Satz markieren, damit später nur die
+: markierten Sätze bearbeitet werden. Ist der Satz schon markiert, wird die
+: Markierung wieder gelöscht. Wenn mindestens ein Satz markiert ist, er-
+: scheint die Markierungsinformation in der Überschrift.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/34"
+% SEITE 1
+:--- Markierungen loeschen ---
+: Mit dieser Funktion werden alle Markierungen in der Datei gelöscht.
+: Die Markierungsinformation wird nicht mehr angezeigt. Die Markierungen
+: werden auch beim neuen Öffnen gelöscht, da sie nicht permanent in der
+: Datei gespeichert sind.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/35"
+% SEITE 1
+:--- Satz tragen ---
+: Mit dieser Funktion kann der aktuelle Satz in eine andere Datei trans-
+: portiert werden. Anschließend wird er gelöscht. Der Satz wird am Ende der
+: Zieldatei angefügt, wobei diese gegebenenfalls eingerichtet wird. Den
+: Namen der Zieldatei können Sie eingeben.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/36"
+% SEITE 1
+:--- Satz holen ---
+: Diese Funktion holt den letzten Satz einer anderen Datei und fügt ihn vor
+: dem aktuellen Satz ein. Damit wird das letzte 'Tragen' wieder rückgängig
+: gemacht. Die Dateien müssen gleiche Felderzahl haben.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/37"
+% SEITE 1
+:--- Darstellung umschalten ---
+: Diese Funktion schaltet zwischen Normaldarstellung und Übersichtsanzeige
+: um. In der Normaldarstellung wird immer nur ein Satz angezeigt, in der
+: Übersichtsanzeige werden mehrere Sätze dargestellt, wobei jeder Satz eine
+: Zeile in Anspruch nimmt.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/38"
+% SEITE 1
+:--- Feldauswahl ---
+: Mit dieser Funktion kann gewählt werden, welche Felder in welcher Reihen-
+: folge angezeigt werden sollen. Die Auswahl kann für Übersichts- und
+: Normalanzeige unterschiedlich gewählt werden. Alle Felder werden zum
+: Ankreuzen angeboten.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/41"
+% SEITE 1
+:--- nach Muster drucken ---
+: Mit dieser Funktion können die Inhalte der Datei nach einem Druckmuster
+: ausgedruckt werden. Das Druckmuster ist eine Textdatei und muß vorher er-
+: stellt werden. Es gibt die Form des Ausdrucks an. Über den Aufbau eines
+: Druckmusters lesen Sie am besten das Benutzerhandbuch.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/42"
+% SEITE 1
+:--- Saetze tragen ---
+: Diese Funktion trägt alle Sätze in eine andere Datei und löscht sie danach.
+: Die Zieldatei muß gleiche Felderzahl haben, damit keine Information ver-
+: lorengeht. Beim Tragen können auch die Prüfbedingungen der Zieldatei ge-
+: prüft werden, wenn Sie die entsprechende Frage bejahen.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/43"
+% SEITE 1
+:--- Textdatei erstellen/aendern ---
+: Mit dieser Funktion kann eine Textdatei erstellt, geändert oder angesehen
+: werden. Es wird der normale Editor verwendet.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/44"
+% SEITE 1
+:--- Saetze kopieren ---
+: Diese Funktion kopiert die ausgewählten Sätze in eine andere Datei. Welche
+: Felder in welcher Reihenfolge kopiert werden sollen, wird durch ein Kopier-
+: muster bestimmt, das nach der Struktur der Zieldatei bestimmt wird und
+: dann von Ihnen noch geändert werden kann.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/45"
+% SEITE 1
+:--- Textdatei drucken ---
+: Mit dieser Funktion wird eine Textdatei direkt ausgedruckt. Die Datei kann
+: Anweisungen zur Druckersteuerung enthalten, die Sie dem EUMEL-Benutzer-
+: handbuch entnehmen können.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/46"
+% SEITE 1
+:--- nach Vorschrift aendern ---
+: Diese Funktion ermöglicht es, die geöffnete Datei nach einer Vorschrift
+: automatisch zu ändern. Die Art der Änderungen wird dabei durch ein
+: Verarbeitungsmuster festgelegt, das vorher als Textdatei erstellt werden
+: muß. Über die Form des Verarbeitungsmusters s. Benutzerhandbuch.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/47"
+% SEITE 1
+:--- aktuelle Datei ansehen ---
+: Diese Funktion führt in ein Nebenmenü, in dem Sie die Inhalte der geöff-
+: neten Datei ansehen können.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/48"
+% SEITE 1
+:--- Dateiverwaltung ---
+: Diese Auswahl führt in ein Nebenmenü, in dem Dateien auf dem Archiv und im
+: System verwaltet werden können. Dateien können umbenannt, gelöscht oder
+: reorganisiert, sowie zwischen Archivdiskette und System hin- und her-
+: transportiert werden. 
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/51"
+% SEITE 1
+:--- Datei auf Archiv sichern ---
+: Diese Funktion schreibt eine oder mehrere Dateien auf das Archiv. Der
+: Archivname muß vorher eingegeben werden. Dann kann entweder der Name der
+: gewünschten Datei eingegeben werden oder mit ESC 'z' eine Auswahl von 
+: Dateien angekreuzt werden.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/52"
+% SEITE 1
+:--- Datei reorganisieren ---
+: Diese Funktion reorganisiert eine Datei, an der viel geändert wurde, zur
+: Platz- und Zeitersparnis. Es können sowohl Textdateien als auch EUDAS-
+: Dateien angegeben werden.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/53"
+% SEITE 1
+:--- Datei von Archiv holen ---
+: Diese Funktion holt eine Datei vom Archiv ins System. Der Archivname wird
+: automatisch bestimmt. Sie können dann entweder den gewünschten Dateinamen
+: angeben oder mit ESC 'z' eine Auswahl aller Dateien auf dem Archiv abrufen.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/54"
+% SEITE 1
+:--- Datei umbenennen ---
+: Mit dieser Funktion können Sie für eine Datei auf dem System einen neuen
+: Namen vergeben. Wenn Sie den neuen Namen eingeben, wird Ihnen der alte Name
+: angeboten. Sie können ihn ändern oder ganz überschreiben. Dadurch ersparen
+: Sie sich bei kleinen Änderungen das Neutippen.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/55"
+% SEITE 1
+:--- Datei auf Archiv loeschen ---
+: Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu löschen. Der
+: Platz dieser Datei wird jedoch nur dann wiederverwendet, wenn keine Dateien
+: mehr dahinter stehen. Der Archivname muß eingegeben werden. Sie können bei
+: der Eingabe des Dateinamens mit ESC 'z' eine Dateiauswahl abrufen.
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/56"
+% SEITE 1
+:--- Datei loeschen ---
+: Diese Funktion löscht eine Datei auf dem System nach Anfrage. Sie können 
+: den Dateinamen eingeben oder mit ESC 'z' eine Auswahl aller vorhandenen
+: Dateien abrufen.
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/57"
+% SEITE 1
+:--- Archivuebersicht ---
+: Diese Funktion liefert eine Übersicht der Dateien auf dem Archiv. Ver-
+: lassen Sie diese Übersicht mit ESC 'q'.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "EUDAS/58"
+% SEITE 1
+:--- Dateiuebersicht ---
+: Diese Funktion liefert eine Übersicht über alle im System vorhandenen
+: Dateien. Verlassen Sie diese Übersicht mit ESC 'q'.
+:
+:
+:---
+% SEITE 1 "EUDAS/Allgemein"
+% ENDE
+% HILFE "AUSWAHL/Allgemein"
+% SEITE 1
+:--- AUSWAHL ---
+: Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen Teil auszu-
+: wählen. Die gewünschten Namen werden einfach in beliebiger Reihenfolge
+: angekreuzt und anschließend in dieser Reihenfolge verwendet.
+: Die Schreibmarke (Cursor) gibt an, welcher Name gerade angekreuzt werden
+: kann. Mit den Pfeiltasten kann der Cursor auf den Kreisen bewegt werden.
+: 'x' kreuzt einen Namen an, 'o' loescht die Ankreuzung wieder.
+: Mit ESC 'q' wird die Auswahl verlassen. ESC 'a' bricht die Auswahl und
+: die folgende Funktion ab. Falls das Angebot nicht auf den Bildschirm paßt,
+: wird es gerollt. ESC '1' positioniert immer auf den Anfang und ESC '9' 
+: auf das Ende der Auswahl. Mit HOP 'x' werden alle noch nicht angekreuzten
+: Namen angekreuzt, mit HOP 'o' werden alle Ankreuzungen geloescht.
+:---
+% ENDE
+% HILFE "AUSWAHL/Felder"
+% SEITE 1
+:---
+: Sie können hier alle Felder ankreuzen, die Sie ändern wollen. Ändern können
+: Sie den Feldnamen und den Feldtyp. Wollen Sie keine Felder ändern, drücken
+: Sie einfach ESC 'q'.
+:---
+% SEITE 1 "AUSWAHL/Allgemein"
+% ENDE
+% HILFE "AUSWAHL/Sortierfelder"
+% SEITE 1
+:---
+: Kreuzen Sie hier die Felder an, die bei der Sortierung berücksichtigt
+: werden sollen. Die Reihenfolge des Ankreuzens ist wichtig. Beim Vergleich
+: zweier Sätze wird erst das als erstes angekreuzte Feld verglichen und
+: danach die Einordnung der Sätze bestimmt. Ist dieses Feld bei beiden
+: gleich, wird das nächste angekreuzte Feld untersucht usw.
+:---
+% SEITE 1 "AUSWAHL/Allgemein"
+% ENDE
+% HILFE "AUSWAHL/Anzeigefelder"
+% SEITE 1
+:---
+: Kreuzen Sie hier alle Felder an, die Sie angezeigt haben möchten. Die
+: Felder erscheinen in der angekreuzten Reihenfolge. Für beide Arten der
+: Anzeige können Sie eine separate Feldauswahl einstellen.
+:---
+% SEITE 1 "AUSWAHL/Allgemein"
+% ENDE
+% HILFE "AUSWAHL/Archiv"
+% SEITE 1
+:---
+: Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien an. Kreuzen
+: Sie die Dateien an, die Sie bearbeiten möchten. Die Dateien werden in
+: der angekreuzten Reihenfolge verwendet.
+:---
+% SEITE 1 "AUSWAHL/Allgemein"
+% ENDE
+% HILFE "AUSWAHL/Datei"
+% SEITE 1
+:---
+: Diese Auswahl zeigt alle Dateien auf dem System, die Sie verwenden können.
+: Kreuzen Sie die gewünschte(n) Datei(en) an.
+:---
+% SEITE 1 "AUSWAHL/Allgemein"
+% ENDE
+% HILFE "FEHLER/Allgemein"
+% SEITE 1
+:--- FEHLERMELDUNGEN ---
+: Fehlermeldungen werden von einem Programm abgesetzt, wenn es seine Funktion
+: nicht durchführen kann. Der Text der Meldung identifiziert die Ursache des
+: Problems. Zur Zeit liegen noch keine meldungsspezifischen Informationen
+: vor, schauen Sie ggf. in das Benutzerhandbuch.
+:---
+% ENDE
+% HILFE "FEHLER/9"
+% SEITE 1
+:---
+: Diese Fehlermeldung deutet auf einen internen Programmfehler (wenn Sie
+: nicht selber ein Programm geschrieben haben). Melden Sie diesen Fehler
+: bitte, damit eine Korrektur vorgenommen werden kann. Schreiben Sie sich
+: dazu die Begleitumstände auf (welche Datei haben Sie benutzt, welche
+: Funktion). Versuchen Sie gegebenenfalls, den Fehler zu wiederholen. Es
+: ist nämlich z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei
+: auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der Fehler an einer
+: bestimmten Datei liegt, sichern Sie diese Datei bitte auf einer Diskette,
+: um sie eventuell einschicken zu können. 
+:---
+% ENDE
+% HILFE "FEHLER/10"
+% SEITE 1 "FEHLER/9"
+% ENDE
+% HILFE "FEHLER/11"
+% SEITE 1 "FEHLER/9"
+% ENDE
+% HILFE "FEHLER/14"
+% SEITE 1 "FEHLER/9"
+% ENDE
+% HILFE "GET/Allgemein"
+% SEITE 1
+:--- EINGABE ---
+: Die Eingabe erwartet von Ihnen eine bestimmte Information, die Sie eingeben
+: sollen. Die Art der Information wird durch den Anforderungstext angegeben.
+: Wenn Sie sich beim Eintippen verschrieben haben, können Sie mit den Pfeil-
+: tasten zurückgehen und den Text korrigieren. Eine bereits dastehende
+: Information können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN
+: schaltet in den Einfügemodus (Zeichen werden nicht mehr überschrieben).
+: Beenden Sie die Eingabe mit RETURN. ESC 'h' bricht die Eingabe und die
+: folgende Funktion ab. Wenn in der Statuszeile angegeben, können Sie mit
+: ESC 'z' eine Auswahl verfügbarer Namen abrufen, die Sie dann Ankreuzen
+: können.
+:---
+% ENDE
+% HILFE "GET/Sicherungsname"
+% SEITE 1
+:---
+: Sie können jetzt den Namen angeben, unter dem die Arbeitskopie gespeichert
+: werden soll. Ihnen wird der alte Name zum Überschreiben angeboten. Drücken
+: Sie nur RETURN, wird der alte Name genommen und die alte Version über-
+: schrieben.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/Dateiname"
+% SEITE 1
+:---
+: Bitte geben Sie den Namen der Datei ein, mit dem die Operation ausgeführt
+: werden soll. Mit ESC 'z' können Sie sich die zur Verfügung stehenden Namen
+: auch als Auswahl zeigen lassen.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/feldname"
+% SEITE 1
+:---
+: Sie können den Namen des angegebenen Feldes ändern, indem Sie den alten
+: Namen überschreiben bzw. korrigieren.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/feldtyp"
+% SEITE 1
+:---
+: Sie können hier einen von vier möglichen Typen eingeben:
+:  TEXT  normaler Text mit Vergleich nach EUMEL-Code.
+:  DIN   Text, der nach DIN 5007 verglichen wird (Umlaute richtig,
+:        Groß-/Kleinschreibung und Sonderzeichen ignoriert).
+:  ZAHL  Alle nichtnumerischen Zeichen außer Minus und Dezimalkomma werden
+:        beim Vergleichen ignoriert.
+:  DATUM Datum der Form "tt.mm.jj"
+: Die Feldtypen werden beim Sortieren und Suchen beachtet.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/auf Satz"
+% SEITE 1
+:---
+: Sie können hier die Satznummer des Satzes eingeben, den Sie sehen wollen.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/Archivname"
+% SEITE 1
+:---
+: Geben Sie den Namen des eingelegten Archivs ein (zur Sicherheit). Der
+: zuletzt verwendete Name wird zum Ändern angeboten.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "GET/rename"
+% SEITE 1
+:---
+: Sie können den alten Namen der Datei durch Überschreiben und Korrigieren
+: ändern.
+:---
+% SEITE 1 "GET/Allgemein"
+% ENDE
+% HILFE "JA/Allgemein"
+% SEITE 1
+:--- FRAGEN ---
+: Das Programm stellt Ihnen eine Frage, die Sie bejahen oder verneinen kön-
+: nen. Sie bejahen die Frage, indem Sie 'j' drücken und verneinen Sie mit 'n'
+: (beides groß oder klein). Mit ESC 'h' können Sie die Funktion abbrechen.
+:---
+% ENDE
+% HILFE "JA/oeffne"
+% SEITE 1
+:---
+: Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur ansehen wollen.
+: In diesem Fall wird keine Sicherheitskopie erstellt. Verneinen Sie die
+: Frage, wird eine interen Kopie angelegt, die Sie dann verändern können.
+: Die Kopie muß nach dem Ändern gesichert werden.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/alte version"
+% SEITE 1
+:---
+: Wenn Sie diese Frage bejahen, wird die Arbeitskopie unter dem angegebenen
+: Namen gesichert. Die alte Version geht dadurch verloren. Wenn Sie die Frage
+: verneinen, haben Sie Gelegenheit, einen neuen Namen anzugeben, damit die 
+: alte Version erhalten bleiben kann.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/Datei loeschen"
+% SEITE 1
+:---
+: Beim Sichern hatten Sie Gelegenheit, alle veränderten Dateien zu sichern.
+: Die Sicherheitskopien können damit gelöscht werden. Dazu bejahen Sie die
+: Frage. Wenn die Dateien jedoch noch geöffnet bleiben sollen, oder Sie eine
+: Datei aus Versehen nicht gesichert haben, müssen Sie diese Frage verneinen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/sichere"
+% SEITE 1
+:---
+: Die interne Arbeitskopie der angegebenen Datei wurde gegenüber dem Original
+: verändert. Wenn Sie diese Änderungen behalten wollen, müssen Sie die Frage 
+: bejahen. Sie haben dann noch die Möglichkeit, die geänderte Version unter
+: neuem Namen zu sichern, um die alte Version zu behalten. Wenn Sie die Frage
+: verneinen, gehen die Änderungen verloren und das Original bleibt erhalten.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/ueber"
+% SEITE 1
+:---
+: Sie haben für die Arbeitskopie einen Namen angegeben, der noch existiert.
+: Bejahen Sie die Frage, wird die alte Datei dieses Namens überschrieben.
+: Anderenfalls erhalten Sie eine neue Gelegenheit, einen Namen einzugeben.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/Sicherungssortierung"
+% SEITE 1
+:---
+: Die angegebene Datei war früher schon einmal sortiert worden. Die Sor-
+: tierung wurde jedoch durch nachfolgende Änderungen zerstört. Wenn Sie die
+: Datei wieder sortiert haben wollen, beantworten Sie die Frage mit 'j'.
+: Die Sortierung dauert nicht lange, wenn nur wenige Sätze verändert wurden.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/Pruefbed"
+% SEITE 1
+:---
+: Die Prüfbedingungen einer Datei sind nur für die Funktion "Saetze tragen"
+: relevant. In der Regel können Sie diese Frage verneinen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/feldnamen"
+% SEITE 1
+:---
+: Falls Sie neue Felder zu den existierenden anfügen wollen, müssen Sie diese
+: Frage bejahen. Sie erhalten dann Gelegenheit, die neuen Namen im Editor
+: einzugeben.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/Sortierfelder"
+% SEITE 1
+:---
+: Die Reihenfolge, in der die Felder bei der Sortierung berücksichtigt wer-
+: den, ist in der EUDAS-Datei intern gespeichert. Wenn Sie diese Reihenfolge,
+: die beim letzten Sortieren angegeben wurde, ändern möchten, müssen Sie die 
+: Frage bejahen. Sie können dann die neue Feldreihenfolge auswählen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/sortieren"
+% SEITE 1
+:---
+: Wenn Sie diese Frage bejahen, wird die Zieldatei nach Ausführung der
+: Funktion in ihrer eingestellten Feldreihenfolge sortiert.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/forget"
+% SEITE 1
+:---
+: Wenn Sie diese Frage bejahen, wird die Datei wirklich gelöscht. Wenn Sie
+: die Datei irrtümlich gewählt haben, müssen Sie die Frage verneinen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/einrichten"
+% SEITE 1
+:---
+: Sie haben eine Datei angegeben, die noch nicht existiert. Wenn Sie die
+: Frage bejahen, wird die Datei neu eingerichtet. Anderenfalls wird die
+: Funktion abgebrochen, so daß Sie Gelegenheit haben, die Funktion mit einem
+: neuen Namen zu wiederholen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/testen"
+% SEITE 1
+:---
+: Wenn Sie diese Frage bejahen, werden beim Tragen die Prüfbedingungen der
+: Zieldatei abgefragt. Sätze, die diese Bedingungen nicht erfüllen, werden
+: nicht getragen und können danach geändert werden. Beim Ändern wird dann
+: jeweils die den Satz betreffende Meldung ausgegeben. Die Prüfbedingungen
+: der Zieldatei können Sie mit der Funktion "Feldstruktur aendern" angeben
+: oder ändern.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/save"
+% SEITE 1
+:---
+: Die angegebene Datei befindet sich bereits auf dem Archiv. Wenn Sie die
+: Datei überschreiben wollen, müssen Sie die Frage bejahen. Ansonsten wird
+: die Datei nicht auf das Archiv geschrieben (keine Wirkung).
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/fetch"
+% SEITE 1
+:---
+: Die angegebene Datei ist bereits im System vorhanden. Wenn Sie diese Datei
+: überschreiben wollen, müssen Sie die Frage bejahen. Anderenfalls wird keine
+: Aktion vorgenommen.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "JA/erase"
+% SEITE 1
+:---
+: Zur Sicherheit wird gefragt, ob Sie die angegebene Datei wirklich auf dem 
+: Archiv löschen wollen. Wenn Sie die Frage verneinen, wird keine Aktion
+: durchgeführt.
+:---
+% SEITE 1 "JA/Allgemein"
+% ENDE
+% HILFE "EDIT/Allgemein"
+% SEITE 1
+:--- EDITOR ---
+: Mit dem Editor können Sie einen Text zeilenweise eingeben. Dabei können
+: Sie den Cursor mit den Pfeiltasten bewegen. RUBOUT löscht ein Zeichen,
+: RUBIN schaltet in den Einfügemodus um. Für weitere Informationen zum Editor
+: s. EUMEL-Benutzerhandbuch. ESC 'q' verläßt den Editor normal. Mit ESC 'h'
+: wird die Funktion abgebrochen.
+:---
+% ENDE
+% HILFE "EDIT/Feldnamen"
+% SEITE 1
+:---
+: Sie können hier die neuen Feldnamen in der gewünschten Reihenfolge unter-
+: einander eingeben. Jeder Feldname muß in einer Zeile stehen und ohne
+: Anführungsstriche geschrieben sein.
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Pruefbed"
+% SEITE 1
+:---
+: Sie können hier die Prüfbedingungen der Datei eingeben bzw. ändern. Die
+: Prüfbedingungen sind ein ELAN-Programm. Da ELAN-Programme formatfrei sind,
+: kann es sein, daß Ihr Programm beim nächsten Mal anders erscheint, als Sie
+: es eingegeben haben.
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Suchen"
+% SEITE 1
+:---
+: Sie können jetzt eine Selektionsbedingung einstellen. Dazu müssen Sie
+: jeweils neben den Feldnamen eine Bedingung schreiben. Mögliche Bedingungen
+: sind:
+:  Text         muß gleich sein
+:  Text*        muß mit Text anfangen
+:  *Text        muß mit Text enden
+:  *Text*       enthält Text
+:  Text..       muß größer oder gleich Text sein
+:  ..Text       muß kleiner als Text sein oder mit Text anfangen
+:  Text1..Text2 liegt zwischen den beiden Texten
+: "--" verneint eine Bedingung. Weitere Bedingungen und Kombination von
+: Bedingungen s. EUDAS-Benutzerhandbuch.
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Einfuegen"
+% SEITE 1
+:---
+: Sie können hier die Inhalte eines neuen Satzes eingeben, der vor dem
+: aktuellen Satz eingefügt wird. 
+: Spezielle Tastenkombinationen:
+:  ESC RUBOUT     Rest der Zeile löschen
+:  ESC RUBIN      Zeile aufbrechen
+:  ESC OBEN       nach oben blättern
+:  ESC UNTEN      nach unten blättern
+:  ESC '1'        auf erste Zeile
+:  ESC '9'        auf letzte Zeile
+:  ESC 'h'        Abbruch, der Satz wird nicht eingefügt
+:  ESC 'w'        Beenden und gleich den nächsten Satz einfügen
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Aendern"
+% SEITE 1
+:---
+: Sie können die Inhalte des aktuellen Satzes hier abändern.
+: Spezielle Tastenkombinationen:
+:  ESC RUBOUT     Rest der Zeile löschen
+:  ESC RUBIN      Zeile aufbrechen
+:  ESC OBEN       nach oben blättern
+:  ESC UNTEN      nach unten blättern
+:  ESC '1'        auf erste Zeile
+:  ESC '9'        auf letzte Zeile
+:  ESC 'h'        Abbruch, der Satz bleibt unverändert
+:  ESC 'w'        Beenden und gleich den nächsten Satz ändern
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Druckmuster"
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Verarbeite"
+% SEITE 1
+:---
+: Sie können hier eine Verarbeitungsvorschrift eingeben. Die Verarbeitungs-
+: vorschrift ist ein ELAN-Programm. Ein Feld wird geändert durch den
+: Operator "V":
+:  "Feldname" V "neuer Feldinhalt";
+: Statt des neuen Feldinhalts kann auch ein beliebiger ELAN-Ausdruck ange-
+: geben werden. Mit 
+:  f ("Feldname")
+: wird der Inhalt eines Feldes als Text geliefert.
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+% HILFE "EDIT/Kopiermuster"
+% SEITE 1
+:---
+: Sie können das hier angegebene Kopiermuster verändern. Sollen Felder nicht
+: kopiert werden, brauchen Sie nur die entsprechenden Zeilen zu löschen.
+: Soll eine Feld andere Inhalte bekommen, geben Sie in dem Ausdruck
+:  "Feldname" K f ("Feldname");
+: hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge der K-Aus-
+: drücke bestimmt die Reihenfolge der Feldnamen in der Zieldatei, wenn die
+: Zieldatei noch nicht existierte.
+:---
+% SEITE 1 "EDIT/Allgemein"
+% ENDE
+
+
diff --git a/doc/eudas/abb.1-1 b/app/eudas/4.3/doc/abb.1-1
index 06c27fd..06c27fd 100644
--- a/doc/eudas/abb.1-1
+++ b/app/eudas/4.3/doc/abb.1-1
diff --git a/doc/eudas/abb.4-1 b/app/eudas/4.3/doc/abb.4-1
index 439e052..439e052 100644
--- a/doc/eudas/abb.4-1
+++ b/app/eudas/4.3/doc/abb.4-1
diff --git a/doc/eudas/abb.4-2 b/app/eudas/4.3/doc/abb.4-2
index a836def..a836def 100644
--- a/doc/eudas/abb.4-2
+++ b/app/eudas/4.3/doc/abb.4-2
diff --git a/doc/eudas/abb.6-1 b/app/eudas/4.3/doc/abb.6-1
index fb83242..fb83242 100644
--- a/doc/eudas/abb.6-1
+++ b/app/eudas/4.3/doc/abb.6-1
diff --git a/doc/eudas/abb.6-2 b/app/eudas/4.3/doc/abb.6-2
index 7771a29..7771a29 100644
--- a/doc/eudas/abb.6-2
+++ b/app/eudas/4.3/doc/abb.6-2
diff --git a/doc/eudas/abb.7-1 b/app/eudas/4.3/doc/abb.7-1
index 3536ad9..3536ad9 100644
--- a/doc/eudas/abb.7-1
+++ b/app/eudas/4.3/doc/abb.7-1
diff --git a/doc/eudas/abb.9-1 b/app/eudas/4.3/doc/abb.9-1
index 774b78b..774b78b 100644
--- a/doc/eudas/abb.9-1
+++ b/app/eudas/4.3/doc/abb.9-1
diff --git a/doc/eudas/abb.9-2 b/app/eudas/4.3/doc/abb.9-2
index 4e9444d..4e9444d 100644
--- a/doc/eudas/abb.9-2
+++ b/app/eudas/4.3/doc/abb.9-2
diff --git a/doc/eudas/abb.9-3 b/app/eudas/4.3/doc/abb.9-3
index 9b190ab..9b190ab 100644
--- a/doc/eudas/abb.9-3
+++ b/app/eudas/4.3/doc/abb.9-3
diff --git a/doc/eudas/abb.9-4 b/app/eudas/4.3/doc/abb.9-4
index e243265..e243265 100644
--- a/doc/eudas/abb.9-4
+++ b/app/eudas/4.3/doc/abb.9-4
diff --git a/doc/eudas/abb.9-5 b/app/eudas/4.3/doc/abb.9-5
index c00655c..c00655c 100644
--- a/doc/eudas/abb.9-5
+++ b/app/eudas/4.3/doc/abb.9-5
diff --git a/doc/eudas/bildergenerator b/app/eudas/4.3/doc/bildergenerator
index 8129476..8129476 100644
--- a/doc/eudas/bildergenerator
+++ b/app/eudas/4.3/doc/bildergenerator
diff --git a/doc/eudas/eudas.hdb.1 b/app/eudas/4.3/doc/eudas.hdb.1
index 40b5a84..40b5a84 100644
--- a/doc/eudas/eudas.hdb.1
+++ b/app/eudas/4.3/doc/eudas.hdb.1
diff --git a/doc/eudas/eudas.hdb.10 b/app/eudas/4.3/doc/eudas.hdb.10
index 442f575..442f575 100644
--- a/doc/eudas/eudas.hdb.10
+++ b/app/eudas/4.3/doc/eudas.hdb.10
diff --git a/doc/eudas/eudas.hdb.11 b/app/eudas/4.3/doc/eudas.hdb.11
index 6a59847..6a59847 100644
--- a/doc/eudas/eudas.hdb.11
+++ b/app/eudas/4.3/doc/eudas.hdb.11
diff --git a/doc/eudas/eudas.hdb.12 b/app/eudas/4.3/doc/eudas.hdb.12
index fba5ca5..fba5ca5 100644
--- a/doc/eudas/eudas.hdb.12
+++ b/app/eudas/4.3/doc/eudas.hdb.12
diff --git a/doc/eudas/eudas.hdb.13 b/app/eudas/4.3/doc/eudas.hdb.13
index 435fbfc..435fbfc 100644
--- a/doc/eudas/eudas.hdb.13
+++ b/app/eudas/4.3/doc/eudas.hdb.13
diff --git a/doc/eudas/eudas.hdb.14 b/app/eudas/4.3/doc/eudas.hdb.14
index 1aa3c87..1aa3c87 100644
--- a/doc/eudas/eudas.hdb.14
+++ b/app/eudas/4.3/doc/eudas.hdb.14
diff --git a/doc/eudas/eudas.hdb.15 b/app/eudas/4.3/doc/eudas.hdb.15
index c0a22cf..c0a22cf 100644
--- a/doc/eudas/eudas.hdb.15
+++ b/app/eudas/4.3/doc/eudas.hdb.15
diff --git a/doc/eudas/eudas.hdb.16 b/app/eudas/4.3/doc/eudas.hdb.16
index 5f5d575..5f5d575 100644
--- a/doc/eudas/eudas.hdb.16
+++ b/app/eudas/4.3/doc/eudas.hdb.16
diff --git a/doc/eudas/eudas.hdb.2 b/app/eudas/4.3/doc/eudas.hdb.2
index f3f14e1..f3f14e1 100644
--- a/doc/eudas/eudas.hdb.2
+++ b/app/eudas/4.3/doc/eudas.hdb.2
diff --git a/doc/eudas/eudas.hdb.3 b/app/eudas/4.3/doc/eudas.hdb.3
index e89ff4f..e89ff4f 100644
--- a/doc/eudas/eudas.hdb.3
+++ b/app/eudas/4.3/doc/eudas.hdb.3
diff --git a/doc/eudas/eudas.hdb.5 b/app/eudas/4.3/doc/eudas.hdb.5
index b5927ea..b5927ea 100644
--- a/doc/eudas/eudas.hdb.5
+++ b/app/eudas/4.3/doc/eudas.hdb.5
diff --git a/doc/eudas/eudas.hdb.6 b/app/eudas/4.3/doc/eudas.hdb.6
index e617881..e617881 100644
--- a/doc/eudas/eudas.hdb.6
+++ b/app/eudas/4.3/doc/eudas.hdb.6
diff --git a/doc/eudas/eudas.hdb.7 b/app/eudas/4.3/doc/eudas.hdb.7
index d6f1bf3..d6f1bf3 100644
--- a/doc/eudas/eudas.hdb.7
+++ b/app/eudas/4.3/doc/eudas.hdb.7
diff --git a/doc/eudas/eudas.hdb.8 b/app/eudas/4.3/doc/eudas.hdb.8
index 83246e9..83246e9 100644
--- a/doc/eudas/eudas.hdb.8
+++ b/app/eudas/4.3/doc/eudas.hdb.8
diff --git a/doc/eudas/eudas.hdb.9 b/app/eudas/4.3/doc/eudas.hdb.9
index 341feca..341feca 100644
--- a/doc/eudas/eudas.hdb.9
+++ b/app/eudas/4.3/doc/eudas.hdb.9
diff --git a/doc/eudas/eudas.hdb.inhalt b/app/eudas/4.3/doc/eudas.hdb.inhalt
index 62134f8..62134f8 100644
--- a/doc/eudas/eudas.hdb.inhalt
+++ b/app/eudas/4.3/doc/eudas.hdb.inhalt
diff --git a/doc/eudas/eudas.hdb.macros b/app/eudas/4.3/doc/eudas.hdb.macros
index d06e6d1..d06e6d1 100644
--- a/doc/eudas/eudas.hdb.macros
+++ b/app/eudas/4.3/doc/eudas.hdb.macros
diff --git a/doc/eudas/eudas.hdb.titel b/app/eudas/4.3/doc/eudas.hdb.titel
index b8cc805..b8cc805 100644
--- a/doc/eudas/eudas.hdb.titel
+++ b/app/eudas/4.3/doc/eudas.hdb.titel
diff --git a/doc/eudas/eudas.hdb.vorwort b/app/eudas/4.3/doc/eudas.hdb.vorwort
index 6f7f17c..6f7f17c 100644
--- a/doc/eudas/eudas.hdb.vorwort
+++ b/app/eudas/4.3/doc/eudas.hdb.vorwort
diff --git a/doc/eudas/eudas.ref.1 b/app/eudas/4.3/doc/eudas.ref.1
index 7c66368..7c66368 100644
--- a/doc/eudas/eudas.ref.1
+++ b/app/eudas/4.3/doc/eudas.ref.1
diff --git a/doc/eudas/eudas.ref.10 b/app/eudas/4.3/doc/eudas.ref.10
index fbfcf7e..fbfcf7e 100644
--- a/doc/eudas/eudas.ref.10
+++ b/app/eudas/4.3/doc/eudas.ref.10
diff --git a/doc/eudas/eudas.ref.11 b/app/eudas/4.3/doc/eudas.ref.11
index 48d36c3..48d36c3 100644
--- a/doc/eudas/eudas.ref.11
+++ b/app/eudas/4.3/doc/eudas.ref.11
diff --git a/doc/eudas/eudas.ref.2 b/app/eudas/4.3/doc/eudas.ref.2
index 2447897..2447897 100644
--- a/doc/eudas/eudas.ref.2
+++ b/app/eudas/4.3/doc/eudas.ref.2
diff --git a/doc/eudas/eudas.ref.3 b/app/eudas/4.3/doc/eudas.ref.3
index 9b58b9b..9b58b9b 100644
--- a/doc/eudas/eudas.ref.3
+++ b/app/eudas/4.3/doc/eudas.ref.3
diff --git a/doc/eudas/eudas.ref.4 b/app/eudas/4.3/doc/eudas.ref.4
index cfd6daf..cfd6daf 100644
--- a/doc/eudas/eudas.ref.4
+++ b/app/eudas/4.3/doc/eudas.ref.4
diff --git a/doc/eudas/eudas.ref.5 b/app/eudas/4.3/doc/eudas.ref.5
index 02971ea..02971ea 100644
--- a/doc/eudas/eudas.ref.5
+++ b/app/eudas/4.3/doc/eudas.ref.5
diff --git a/doc/eudas/eudas.ref.6 b/app/eudas/4.3/doc/eudas.ref.6
index 7c8ada6..7c8ada6 100644
--- a/doc/eudas/eudas.ref.6
+++ b/app/eudas/4.3/doc/eudas.ref.6
diff --git a/doc/eudas/eudas.ref.7 b/app/eudas/4.3/doc/eudas.ref.7
index 31b3031..31b3031 100644
--- a/doc/eudas/eudas.ref.7
+++ b/app/eudas/4.3/doc/eudas.ref.7
diff --git a/doc/eudas/eudas.ref.8 b/app/eudas/4.3/doc/eudas.ref.8
index fc2b3bc..fc2b3bc 100644
--- a/doc/eudas/eudas.ref.8
+++ b/app/eudas/4.3/doc/eudas.ref.8
diff --git a/doc/eudas/eudas.ref.9 b/app/eudas/4.3/doc/eudas.ref.9
index dc2dd0d..dc2dd0d 100644
--- a/doc/eudas/eudas.ref.9
+++ b/app/eudas/4.3/doc/eudas.ref.9
diff --git a/doc/eudas/eudas.ref.fehler b/app/eudas/4.3/doc/eudas.ref.fehler
index 736d009..736d009 100644
--- a/doc/eudas/eudas.ref.fehler
+++ b/app/eudas/4.3/doc/eudas.ref.fehler
diff --git a/doc/eudas/eudas.ref.inhalt b/app/eudas/4.3/doc/eudas.ref.inhalt
index ae997cb..ae997cb 100644
--- a/doc/eudas/eudas.ref.inhalt
+++ b/app/eudas/4.3/doc/eudas.ref.inhalt
diff --git a/doc/eudas/eudas.ref.macros b/app/eudas/4.3/doc/eudas.ref.macros
index 1d24468..1d24468 100644
--- a/doc/eudas/eudas.ref.macros
+++ b/app/eudas/4.3/doc/eudas.ref.macros
diff --git a/doc/eudas/eudas.ref.proz b/app/eudas/4.3/doc/eudas.ref.proz
index 2007bc1..2007bc1 100644
--- a/doc/eudas/eudas.ref.proz
+++ b/app/eudas/4.3/doc/eudas.ref.proz
diff --git a/doc/eudas/eudas.ref.reg b/app/eudas/4.3/doc/eudas.ref.reg
index a34307a..a34307a 100644
--- a/doc/eudas/eudas.ref.reg
+++ b/app/eudas/4.3/doc/eudas.ref.reg
diff --git a/doc/eudas/eudas.ref.titel b/app/eudas/4.3/doc/eudas.ref.titel
index 223a839..223a839 100644
--- a/doc/eudas/eudas.ref.titel
+++ b/app/eudas/4.3/doc/eudas.ref.titel
diff --git a/doc/eudas/eudas.ref.vorwort b/app/eudas/4.3/doc/eudas.ref.vorwort
index f911be8..f911be8 100644
--- a/doc/eudas/eudas.ref.vorwort
+++ b/app/eudas/4.3/doc/eudas.ref.vorwort
diff --git a/doc/eudas/ref.abb.1-1 b/app/eudas/4.3/doc/ref.abb.1-1
index d3b3217..d3b3217 100644
--- a/doc/eudas/ref.abb.1-1
+++ b/app/eudas/4.3/doc/ref.abb.1-1
diff --git a/doc/eudas/register b/app/eudas/4.3/doc/register
index 9cca0fc..9cca0fc 100644
--- a/doc/eudas/register
+++ b/app/eudas/4.3/doc/register
diff --git a/doc/eudas/uedas.hdb.4 b/app/eudas/4.3/doc/uedas.hdb.4
index ecbfd58..ecbfd58 100644
--- a/doc/eudas/uedas.hdb.4
+++ b/app/eudas/4.3/doc/uedas.hdb.4
diff --git a/eudas/Adressen b/app/eudas/4.3/src/Adressen
index 74f0e3d..74f0e3d 100644
--- a/eudas/Adressen
+++ b/app/eudas/4.3/src/Adressen
diff --git a/eudas/dummy.text b/app/eudas/4.3/src/dummy.text
index 0eb03b0..0eb03b0 100644
--- a/eudas/dummy.text
+++ b/app/eudas/4.3/src/dummy.text
diff --git a/eudas/eudas.1 b/app/eudas/4.3/src/eudas.1
index 18607c4..18607c4 100644
--- a/eudas/eudas.1
+++ b/app/eudas/4.3/src/eudas.1
diff --git a/eudas/eudas.2 b/app/eudas/4.3/src/eudas.2
index 0048409..0048409 100644
--- a/eudas/eudas.2
+++ b/app/eudas/4.3/src/eudas.2
diff --git a/eudas/eudas.3 b/app/eudas/4.3/src/eudas.3
index 98f0fae..98f0fae 100644
--- a/eudas/eudas.3
+++ b/app/eudas/4.3/src/eudas.3
diff --git a/eudas/eudas.4 b/app/eudas/4.3/src/eudas.4
index 4605022..4605022 100644
--- a/eudas/eudas.4
+++ b/app/eudas/4.3/src/eudas.4
diff --git a/eudas/eudas.generator b/app/eudas/4.3/src/eudas.generator
index 96269e9..96269e9 100644
--- a/eudas/eudas.generator
+++ b/app/eudas/4.3/src/eudas.generator
diff --git a/eudas/eudas.init b/app/eudas/4.3/src/eudas.init
index 54fa28d..54fa28d 100644
--- a/eudas/eudas.init
+++ b/app/eudas/4.3/src/eudas.init
diff --git a/eudas/pos.173 b/app/eudas/4.3/src/pos.173
index a9706a3..a9706a3 100644
--- a/eudas/pos.173
+++ b/app/eudas/4.3/src/pos.173
diff --git a/app/eudas/4.4/doc/ref-manual/abb.1-1 b/app/eudas/4.4/doc/ref-manual/abb.1-1
new file mode 100644
index 0000000..4f705dc
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.1-1
@@ -0,0 +1,71 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 7.1); (*viewport (0.0,0.0,13.5,7.1); *) 
+scale (1.0,1.0,0.0,0.0);
+(*clear pixels;*)
+ 
+karteikasten (1.0, 3.5, "Kartei A", "Wegner", "Herbert"); 
+karteikasten (5.0, 0.5, "Kartei B", "Regmann", "Karin"); 
+   
+LET myname = "abb.1-1";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (10000);
+*)
+PROC karteikasten (REAL CONST x, y, TEXT CONST name, t name, t vorname) : 
+ 
+  move (x - 0.1, y); 
+  draw (x + 3.6, y); 
+  draw (x + 3.6, y + 1.0); 
+  draw (x - 0.1, y + 1.0); 
+  draw (x - 0.1, y); 
+ 
+  move (x + 0.1, y + 1.1); 
+  draw (x + 0.5, y + 1.5); 
+  move (x + 0.1, y + 1.1); 
+  draw (x + 3.6, y + 1.1);
+  move (x - 0.1, y + 1.0); 
+  draw (x + 0.5, y + 1.6); 
+ 
+  move (x + 3.6, y); 
+  draw (x + 5.2, y + 1.6); 
+  draw (x + 5.2, y + 2.6); 
+  draw (x + 3.6, y + 1.0); 
+    move (x + 3.6, y + 1.1); draw (x + 5.0, y + 2.5); 
+    move (x + 5.2, y + 2.6); draw (x + 5.0, y + 2.6); 
+ 
+  move (x + 0.5, y + 1.1); 
+  draw (x + 0.5, y + 2.5); 
+  draw (x + 4.0, y + 2.5); 
+  draw (x + 4.0, y + 1.5); 
+  move (x + 0.5, y + 2.5); 
+  draw (x + 1.5, y + 3.5); 
+  draw (x + 5.0, y + 3.5); 
+  draw (x + 5.0, y + 2.5); 
+  move (x + 5.0, y + 3.5); 
+  draw (x + 4.0, y + 2.5); 
+  REAL VAR x off := 0.1; 
+  WHILE x off < 1.0 REP 
+    move (x + 0.5 + xoff, y + 2.5 + x off); 
+    draw (x + 4.0 + xoff, y + 2.5 + xoff); 
+    draw (x + 4.0 + xoff, y + 1.5 + xoff); 
+    x off INCR 0.1 
+  END REP; 
+  font size (0.5); 
+  font expansion (1.5); 
+  move (x + 0.5, y + 0.2); draw (name); 
+  font size (0.25);
+  move (x + 0.7, y + 2.10); draw ("Name"); 
+  move (x + 0.7, y + 1.65); draw ("Vorname"); 
+  move (x + 0.7, y + 1.20); draw ("Strasse");
+  move (x + 2.1, y + 2.10); draw (": " + t name); 
+  move (x + 2.1, y + 1.65); draw (": " + t vorname); 
+  move (x + 2.1, y + 1.20); draw (":");
+ 
+END PROC karteikasten;
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.4-1 b/app/eudas/4.4/doc/ref-manual/abb.4-1
new file mode 100644
index 0000000..439e052
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.4-1
@@ -0,0 +1,43 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 3.2);   viewport (0.0,0.0,13.5,3.2);    
+(* scale (2.0,2.0,0.0,0.0); *)
+(*clear pixels;*) 
+ 
+font size (0.25); 
+font expansion (1.5);
+ 
+INT VAR i; 
+FOR i FROM 0 UPTO 4 REP 
+  move (2.0, real (i) * 0.5); 
+  draw (10.0, real (i) * 0.5); 
+  move (2.1, real (i) * 0.5 + 0.1); 
+  draw ("Feld " + code (code ("E") - i)); 
+END REP;
+move (2.0, 2.5); 
+draw (10.0, 2.5); 
+move (2.0, 2.5); 
+draw (2.0, 0.0); 
+move (3.5, 3.0); 
+draw (10.0, 3.0); 
+FOR i FROM 1 UPTO 4 REP 
+  move (2.0 + real (i) * 1.5, 3.0); 
+  draw (2.0 + real (i) * 1.5, 0.0); 
+  move (2.2 + real (i) * 1.5, 2.6); 
+  draw ("Satz " + text (i)) 
+END REP;
+move (9.5, 3.0); 
+draw (9.5, 0.0);
+(* 
+pause (1000);
+*) 
+   
+LET myname = "abb.4-1";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.4-2 b/app/eudas/4.4/doc/ref-manual/abb.4-2
new file mode 100644
index 0000000..a836def
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.4-2
@@ -0,0 +1,46 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 2.0); viewport (0.0,0.0,13.5,2.0); 
+(*scale (1.7,1.7,-1.6,0.0);*) 
+(* 
+clear pixels;
+*)
+ 
+kasten (1.0, 0.0, 3.0, 1.5); 
+kasten (7.0, 0.0, 3.0, 1.5); 
+font size (0.4); font expansion (1.5); 
+move (1.8, 0.6); draw ("Menü"); 
+move (7.9, 0.6); draw ("Hilfe"); 
+move (4.5, 1.0); draw (6.5, 1.0); 
+  draw (6.25, 1.25); move (6.5, 1.0); draw (6.25, 0.75); 
+move (6.5, 0.5); draw (4.5, 0.5); 
+  draw (4.75, 0.75); move (4.5, 0.5); draw (4.75, 0.25); 
+font size (0.25); 
+move (5.0, 1.1); draw ("ESC '?'"); 
+move (5.0, 0.6); draw ("ESC 'q'"); 
+move (10.5, 1.0); draw (11.5, 1.0); draw (11.5, 0.5); draw (10.5, 0.5); 
+  draw (10.75, 0.75); move (10.5, 0.5); draw (10.75, 0.25); 
+move (11.8, 0.9); draw ("ESC 'w'"); 
+move (11.8, 0.4); draw ("ESC 'z'");
+ 
+ 
+LET myname = "abb.4-2";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000);
+*)
+PROC kasten (REAL CONST x anf, y anf, x l, y l) : 
+ 
+  move (x anf, y anf); 
+  draw (x anf, y anf + y l); 
+  draw (x anf + x l, y anf + y l); 
+  draw (x anf +  x l, y anf); 
+  draw (x anf, y anf) 
+ 
+END PROC kasten;
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.6-1 b/app/eudas/4.4/doc/ref-manual/abb.6-1
new file mode 100644
index 0000000..fb83242
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.6-1
@@ -0,0 +1,75 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0); 
+(*scale (1.0,1.0, 0.0,0.0);*)
+(* 
+clear pixels;
+*)
+ 
+move (2.25, 1.0); draw (4.75, 1.0); 
+move (2.25, 3.0); draw (4.75, 3.0); 
+  move (2.5, 1.0); draw (2.5, 3.3); 
+  move (3.0, 1.0); draw (3.0, 3.3); 
+  move (3.5, 1.0); draw (3.5, 3.3); 
+  move (4.0, 1.0); draw (4.0, 3.3); 
+  move (4.5, 1.0); draw (4.5, 3.3); 
+font size (0.30); font expansion (1.5); 
+move (2.6, 3.1); draw ("4"); 
+move (2.6, 2.0); draw ("M");
+move (3.1, 3.1); draw ("5"); 
+move (3.1, 2.0); draw ("N"); 
+move (3.6, 3.1); draw ("6"); 
+move (3.6, 2.0); draw ("O"); 
+move (4.1, 3.1); draw ("7"); 
+move (4.1, 2.0); draw ("P"); 
+  pfeil (3.75, 0.75); 
+ 
+move (5.0, 2.0); draw (7.0, 2.0); draw (6.75, 2.25); 
+  move (7.0, 2.0); draw (6.75, 1.75); 
+move (5.0, 2.1); draw ("Einfügen"); 
+ 
+move (7.25, 1.0); draw (8.5, 1.0); move (9.0, 1.0); draw (10.25, 1.0); 
+move (7.25, 3.0); draw (8.5, 3.0); move (9.0, 3.0); draw (10.25, 3.0); 
+  move (7.5, 1.0); draw (7.5, 3.3); 
+  move (8.0, 1.0); draw (8.0, 3.3); 
+  move (8.5, 1.0); draw (8.5, 3.3); 
+  move (9.0, 1.0); draw (9.0, 3.3); 
+  move (9.5, 1.0); draw (9.5, 3.3); 
+  move (10.0, 1.0); draw (10.0, 3.3); 
+move (7.6, 3.1); draw ("4"); 
+move (7.6, 2.0); draw ("M"); 
+move (8.1, 3.1); draw ("5"); 
+move (8.1, 2.0); draw ("N"); 
+move (8.6, 3.1); draw ("6"); 
+move (9.1, 3.1); draw ("7"); 
+move (9.1, 2.0); draw ("O"); 
+move (9.6, 3.1); draw ("8"); 
+move (9.6, 2.0); draw ("P"); 
+ 
+pfeil (8.75, 0.75);
+ 
+PROC pfeil (REAL CONST x spitze, y spitze) : 
+ 
+  move (x spitze, y spitze); 
+  draw (x spitze + 0.25, y spitze - 0.25); 
+  draw (x spitze + 0.1, y spitze - 0.25); 
+  draw (x spitze + 0.1, y spitze - 0.5); 
+  draw (x spitze - 0.1, y spitze - 0.5); 
+  draw (x spitze - 0.1, y spitze - 0.25); 
+  draw (x spitze - 0.25, y spitze - 0.25); 
+  draw (x spitze, y spitze) 
+ 
+END PROC pfeil; 
+ 
+ 
+LET myname = "abb.6-1";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000)
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.6-2 b/app/eudas/4.4/doc/ref-manual/abb.6-2
new file mode 100644
index 0000000..7771a29
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.6-2
@@ -0,0 +1,77 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 5.0); viewport (0.0,0.0,13.5,5.0); 
+(*scale (1.4,1.4, 0.0,0.0);*) 
+(*clear pixels;*) 
+ 
+move (2.5, 4.5); draw (12.4, 4.5); draw (12.4, 4.0); draw (11.0, 4.0); 
+  draw (11.0, 3.5); move (10.5, 3.5); draw (10.5, 4.0); draw (2.5, 4.0); 
+move (13.5, 4.5); draw (12.5, 4.5); draw (12.5, 3.5); move (13.0, 3.5); 
+  draw (13.0, 4.0); draw (13.5, 4.0); 
+move (2.5, 3.5); draw (13.5, 3.5); move (13.5, 3.0); draw (10.0, 3.0); 
+  draw (10.0, 2.5); move (9.5, 2.5); draw (9.5, 3.0); draw (2.5, 3.0); 
+move (10.5, 3.0); draw (10.5, 2.5); move (11.0, 2.5); draw (11.0, 3.0); 
+move (12.5, 2.5); draw (12.5, 3.0); move (13.0, 3.0); draw (13.0, 2.5); 
+move (2.5, 2.5); draw (6.4, 2.5); draw (6.4, 2.0); draw (4.0, 2.0); 
+  draw (4.0, 1.5); draw (6.5, 1.5); draw (6.5, 2.5); draw (13.5, 2.5); 
+  move (13.5, 2.0); draw (7.0, 2.0); draw (7.0, 1.5); draw (9.0, 1.5); 
+  draw (9.0, 1.0); draw (3.5, 1.0); draw (3.5, 2.0); draw (2.5, 2.0); 
+move (9.5, 2.0); draw (9.5, 1.0); draw (10.4, 1.0); draw (10.4, 1.5); 
+  draw (10.0, 1.5); draw (10.0, 2.0); 
+move (10.5, 2.0); draw (10.5, 1.0); draw (13.0, 1.0); draw (13.0, 2.0); 
+  move (11.0, 2.0); draw (11.0, 1.5); draw (12.5, 1.5); draw (12.5, 2.0); 
+move (4.5, 1.5); draw (4.75, 1.25); draw (4.5, 1.0); 
+move (5.5, 1.5); draw (5.75, 1.25); draw (5.5, 1.0); 
+move (7.5, 1.5); draw (7.75, 1.25); draw (7.5, 1.0); 
+move (11.5, 1.5); draw (11.75, 1.25); draw (11.5, 1.0); 
+ 
+font size (0.25); font expansion (1.4); 
+move (2.5, 4.1); draw ("K0"); 
+move (2.5, 3.1); draw ("N0"); 
+move (2.5, 2.1); draw ("A0"); 
+ 
+move (0.0, 4.1); draw ("'Kalender'"); 
+move (0.0, 3.1); draw ("'Namen'"); 
+move (0.0, 2.1); draw ("'Adressen'"); 
+move (0.0, 1.1); draw ("Arbeitskopie"); 
+ 
+move (4.9, 1.1); draw ("A1"); 
+move (5.9, 1.1); draw ("A2"); 
+move (7.9, 1.1); draw ("A3"); 
+move (11.9, 1.1); draw ("K1"); 
+ 
+x alignment (right); 
+move (13.5, 4.1); draw ("K1"); 
+move (13.5, 3.1); draw ("N0"); 
+move (13.5, 2.1); draw ("A2"); 
+ 
+x alignment (normal); 
+font size (0.2); 
+INT VAR i; 
+FOR i FROM 0 UPTO 10 REP 
+  time (2.5 + real (i) * 1.0, i) 
+END REP; 
+ 
+PROC time (REAL CONST x pos, INT CONST nr) : 
+ 
+  move (x pos, 4.9); draw (x pos, 4.6); 
+  move (x pos, 3.9); draw (x pos, 3.6); 
+  move (x pos, 2.9); draw (x pos, 2.6); 
+  move (x pos, 1.9); draw (x pos, 1.6); 
+  move (x pos, 0.9); draw (x pos, 0.6); 
+  move (x pos + 0.1, 0.6); draw (text (nr)) 
+ 
+END PROC time; 
+ 
+ 
+LET myname = "abb.6-2";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000); 
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.7-1 b/app/eudas/4.4/doc/ref-manual/abb.7-1
new file mode 100644
index 0000000..3536ad9
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.7-1
@@ -0,0 +1,46 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 6.0);   viewport (0.0,0.0,13.5,6.0);
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+kasten (5.0, 4.5, 3.0, 1.0); 
+kasten (5.0, 1.5, 3.0, 1.0); 
+kasten (1.5, 3.0, 3.0, 1.0); 
+font size (0.35); font expansion (1.5); 
+x alignment (center);
+move (6.5, 4.8); draw ("Druckmuster"); 
+move (6.5, 1.8); draw ("Druckdatei"); 
+move (3.0, 3.3); draw ("EUDAS-Datei"); 
+move (6.5, 0.0); draw ("Drucker"); 
+ 
+move (6.5, 4.25); draw (6.5, 2.75); draw (6.25, 3.0); 
+  move (6.5, 2.75); draw (6.75, 3.0); 
+move (4.75, 3.5); draw (6.25, 3.5); draw (6.0, 3.75); 
+  move (6.25, 3.5); draw (6.0, 3.25); 
+move (6.5, 1.25); draw (6.5, 0.5); draw (6.75, 0.75); 
+  move (6.5, 0.5); draw (6.25, 0.75); 
+ 
+
+PROC kasten (REAL CONST x anf, y anf, x l, y l) : 
+ 
+  move (x anf, y anf); 
+  draw (x anf, y anf + y l); 
+  draw (x anf + x l, y anf + y l); 
+  draw (x anf +  x l, y anf); 
+  draw (x anf, y anf) 
+ 
+END PROC kasten;
+
+ 
+LET myname = "abb.7-1";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000); 
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-1 b/app/eudas/4.4/doc/ref-manual/abb.9-1
new file mode 100644
index 0000000..774b78b
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.9-1
@@ -0,0 +1,41 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 4.0); viewport (0.0,0.0,13.5,4.0);
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+move (1.5, 1.0); draw (8.75, 1.0); 
+move (1.5, 3.5); draw (8.75, 3.5); 
+INT VAR i; 
+FOR i FROM 0 UPTO 9 REP 
+  move (1.75 + real (i) * 0.75, 3.7); 
+  draw (1.75 + real (i) * 0.75, 1.0); 
+END REP; 
+ 
+move (4.7, 3.7); draw (4.7, 1.0); 
+ 
+font size (0.25); font expansion (1.5); 
+x alignment (center); 
+FOR i FROM 0 UPTO 8 REP 
+  move (2.125 + real (i) * 0.75, 3.6); draw (text (i + 110)) 
+END REP; 
+FOR i FROM 1 UPTO 5 REP 
+  move (2.125 + real (i + 3) * 0.75, 0.6); draw ("(" + text (i) + ")") 
+END REP;
+ 
+font size (0.35); x alignment  (left); 
+move (2.0, 0.0); draw ("Datei A"); 
+move (5.0, 0.0); draw ("Datei B"); 
+ 
+ 
+LET myname = "abb.9-1";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000)
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-2 b/app/eudas/4.4/doc/ref-manual/abb.9-2
new file mode 100644
index 0000000..4e9444d
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.9-2
@@ -0,0 +1,96 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 6.5); viewport (0.0,0.0,13.5,6.5); 
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+INT VAR i; 
+move (4.0, 0.0); draw (4.0, 2.0); 
+move (5.5, 0.0); draw (5.5, 2.0); 
+FOR i FROM 0 UPTO 4 REP 
+  move (4.0, real (i) * 0.5); 
+  draw (5.5, real (i) * 0.5)
+END REP; 
+ 
+move (4.0, 3.0); draw (4.0, 6.0); 
+move (5.5, 3.0); draw (5.5, 6.0); 
+FOR i FROM 0 UPTO 6 REP 
+  move (4.0, real (i) * 0.5 + 3.0); 
+  draw (5.5, real (i) * 0.5 + 3.0) 
+END REP; 
+ 
+move (7.5, 2.0); draw (7.5, 6.0); 
+move (9.0, 2.0); draw (9.0, 6.0); 
+FOR i FROM 0 UPTO 8 REP 
+  move (7.5, real (i) * 0.5 + 2.0); 
+  draw (9.0, real (i) * 0.5 + 2.0) 
+END REP; 
+ 
+strichel (5.5, 6.0, 7.5, 6.0); 
+strichel (5.5, 3.0, 7.5, 3.0); 
+strichel (5.5, 1.0, 7.5, 3.0); 
+strichel (5.5, 0.0, 7.5, 2.0); 
+ 
+move (5.5, 4.75); draw (6.0, 4.75); 
+  draw (6.0, 1.75); draw (5.5, 1.75); 
+move (4.0, 3.75); draw (3.5, 3.75); 
+  draw (3.5, 1.25); draw (4.0, 1.25); 
+ 
+font size (0.4); font expansion (1.5); 
+move (0.0, 0.8); draw ("Koppeldatei"); 
+move (0.0, 4.3); draw ("Hauptdatei"); 
+move (10.0, 4.3); draw ("virtuelle"); 
+move (10.0, 3.4); draw ("Datei");
+ 
+font size (0.3); 
+move (4.5, 0.1); draw ("H2"); 
+move (4.5, 0.6); draw ("H1"); 
+move (4.5, 1.1); draw ("B"); 
+move (4.5, 1.6); draw ("A"); 
+move (4.5, 3.1); draw ("F4"); 
+move (4.5, 3.6); draw ("B"); 
+move (4.5, 4.1); draw ("F3"); 
+move (4.5, 4.6); draw ("A"); 
+move (4.5, 5.1); draw ("F2"); 
+move (4.5, 5.6); draw ("F1"); 
+move (8.0, 5.6); draw ("F1"); 
+move (8.0, 5.1); draw ("F2"); 
+move (8.0, 4.6); draw ("A"); 
+move (8.0, 4.1); draw ("F3"); 
+move (8.0, 3.6); draw ("B"); 
+move (8.0, 3.1); draw ("F4"); 
+move (8.0, 2.6); draw ("H1"); 
+move (8.0, 2.1); draw ("H2"); 
+ 
+PROC strichel (REAL CONST x anf, y anf, x end, y end) : 
+ 
+  REAL VAR laenge := x end - x anf; 
+  INT VAR teile := int (abstand/ 0.4); 
+  REAL VAR verhaeltnis := (y end - y anf) / laenge;
+  laenge := laenge / (real (2 * teile + 1)); 
+  INT VAR i; 
+  FOR i FROM 0 UPTO teile REP 
+    move (x anf + real (i + i) * laenge, 
+          y anf + verhaeltnis * real (i + i) * laenge); 
+    draw (x anf + real (i + i + 1) * laenge, 
+          y anf + verhaeltnis * real (i + i + 1) * laenge) 
+  END REP . 
+ 
+abstand : 
+  sqrt ((y end - y anf) + (y end - y anf) + 
+        (x end - x anf) * (x end - x anf)) . 
+ 
+END PROC strichel; 
+ 
+ 
+LET myname = "abb.9-2";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000);
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-3 b/app/eudas/4.4/doc/ref-manual/abb.9-3
new file mode 100644
index 0000000..9b190ab
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.9-3
@@ -0,0 +1,113 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); 
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+x alignment (center); 
+font size (0.3); font expansion (1.2); 
+kasten (1.5, 5.0, 2.0, 1.5); 
+move (2.5, 5.9); draw ("EUDAS-"); 
+move (2.5, 5.3); draw ("Datei 1"); 
+move (3.5, 5.75); draw (4.0, 5.75); 
+kasten (4.0, 5.0, 2.0, 1.5); 
+move (5.0, 5.9); draw ("gekettete"); 
+move (5.0, 5.3); draw ("Datei A"); 
+move (6.0, 5.75); draw (6.5, 5.75);
+kasten (6.5, 5.0, 2.0, 1.5); 
+move (7.5, 5.9); draw ("gekettete"); 
+move (7.5, 5.3); draw ("Datei B"); 
+kasten (1.5, 2.0, 2.0, 1.5); 
+move (2.5, 2.9); draw ("gekoppelte"); 
+move (2.5, 2.3); draw ("Datei C");
+kasten (4.0, 0.0, 2.0, 1.5); 
+move (5.0, 0.9); draw ("gekoppelte"); 
+move (5.0, 0.3); draw ("Datei D"); 
+ 
+punkt (9.0, 5.75); 
+punkt (9.25, 5.75); 
+punkt (9.5, 5.75); 
+ 
+strichel (1.0, 4.5, 10.0, 4.5); 
+strichel (1.0, 7.0, 10.0, 7.0); 
+strichel (1.0, 4.5, 1.0, 7.0); 
+x alignment (right); font size (0.4);
+move (10.0, 3.9); 
+draw ("Hauptdatei"); 
+ 
+punkt (2.5, 3.75); 
+punkt (2.5, 4.0); 
+punkt (2.5, 4.25); 
+ 
+punkt (5.0, 1.75); 
+punkt (5.0, 2.0); 
+punkt (5.0, 2.25); 
+punkt (5.0, 2.5); 
+punkt (5.0, 2.75); 
+punkt (5.0, 3.0); 
+punkt (5.0, 3.25); 
+punkt (5.0, 3.5); 
+punkt (5.0, 3.75); 
+punkt (5.0, 4.0); 
+punkt (5.0, 4.25); 
+ 
+PROC punkt (REAL CONST x pos, y pos) : 
+ 
+  LET p size = 0.025;
+  move (x pos, y pos + p size); 
+  draw (x pos + p size, y pos); 
+  draw (x pos, y pos - p size); 
+  draw (x pos - p size, y pos); 
+  draw (x pos, y pos + p size) 
+ 
+END PROC punkt; 
+ 
+ 
+PROC strichel (REAL CONST x anf, y anf, x end, y end) : 
+ 
+  REAL VAR laenge := x end - x anf; 
+  INT VAR teile := int (abstand/ 0.4); 
+  REAL VAR senkrecht, verhaeltnis; 
+  IF laenge <> 0.0 THEN
+    verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 
+  ELSE 
+    verhaeltnis := 1.0; senkrecht := 0.0 ; 
+    laenge := y end - y anf
+  END IF;
+  laenge := laenge / (real (2 * teile + 1)); 
+  INT VAR i; 
+  FOR i FROM 0 UPTO teile REP 
+    move (x anf + real (i + i) * laenge * senkrecht,
+          y anf + verhaeltnis * real (i + i) * laenge); 
+    draw (x anf + real (i + i + 1) * laenge * senkrecht,
+          y anf + verhaeltnis * real (i + i + 1) * laenge) 
+  END REP . 
+ 
+abstand : 
+  sqrt ((y end - y anf) * (y end - y anf) + 
+        (x end - x anf) * (x end - x anf)) . 
+ 
+END PROC strichel; 
+ 
+PROC kasten (REAL CONST x anf, y anf, x l, y l) : 
+ 
+  move (x anf, y anf); 
+  draw (x anf, y anf + y l); 
+  draw (x anf + x l, y anf + y l); 
+  draw (x anf +  x l, y anf); 
+  draw (x anf, y anf) 
+ 
+END PROC kasten;
+ 
+ 
+LET myname = "abb.9-3";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000)
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-4 b/app/eudas/4.4/doc/ref-manual/abb.9-4
new file mode 100644
index 0000000..e243265
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.9-4
@@ -0,0 +1,98 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 6.0); viewport (0.0,0.0,13.5,6.0);
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+kasten (2.0, 1.0, 1.4, 2.0); 
+kasten (3.5, 1.0, 1.4, 2.0); 
+kasten (6.5, 1.0, 1.4, 2.0); 
+kasten (2.0, 3.4, 1.4, 2.0); 
+kasten (5.0, 3.4, 1.4, 2.0); 
+kasten (6.5, 3.4, 1.4, 2.0); 
+  strichel (3.5, 3.4, 3.5, 5.4); 
+  strichel (3.5, 5.4, 4.9, 5.4); 
+  strichel (4.9, 5.4, 4.9, 3.4); 
+  strichel (4.9, 3.4, 3.5, 3.4); 
+move (1.9, 2.7); draw (1.5, 2.7); 
+draw (1.5, 4.6); draw (1.9, 4.6);
+ 
+x alignment (center); 
+font size (0.3); font expansion (1.4); 
+ 
+move (2.7, 5.6); draw ("22-1"); 
+move (2.7, 4.9); draw ("X"); 
+move (2.7, 4.4); draw ("K"); 
+move (2.7, 2.5); draw ("K"); 
+move (2.7, 2.0); draw ("N1"); 
+move (2.7, 0.4); draw ("(114)"); 
+ 
+move (4.2, 5.6); draw ("22-2"); 
+move (4.2, 4.9); draw ("X"); 
+move (4.2, 4.4); draw ("K"); 
+move (4.2, 2.5); draw ("K"); 
+move (4.2, 2.0); draw ("N2"); 
+move (4.2, 0.4); draw ("(209)"); 
+ 
+move (5.7, 5.6); draw ("23-1"); 
+move (5.7, 4.9); draw ("Y"); 
+move (5.7, 4.4); draw ("L"); 
+ 
+move (7.2, 5.6); draw ("24-1"); 
+move (7.2, 4.9); draw ("Z"); 
+move (7.2, 4.4); draw ("M"); 
+move (7.2, 2.5); draw ("M"); 
+move (7.2, 0.4); draw ("(17)"); 
+ 
+font size (0.4); x alignment (normal);
+move (8.5, 2.0); draw ("Koppeldatei"); 
+move (8.5, 4.4); draw ("Hauptdatei"); 
+ 
+PROC strichel (REAL CONST x anf, y anf, x end, y end) : 
+ 
+  REAL VAR laenge := x end - x anf; 
+  INT VAR teile := int (abstand/ 0.4); 
+  REAL VAR senkrecht, verhaeltnis; 
+  IF laenge <> 0.0 THEN
+    verhaeltnis := (y end - y anf) / laenge; senkrecht := 1.0 
+  ELSE 
+    verhaeltnis := 1.0; senkrecht := 0.0 ; 
+    laenge := y end - y anf
+  END IF;
+  laenge := laenge / (real (2 * teile + 1)); 
+  INT VAR i; 
+  FOR i FROM 0 UPTO teile REP 
+    move (x anf + real (i + i) * laenge * senkrecht,
+          y anf + verhaeltnis * real (i + i) * laenge); 
+    draw (x anf + real (i + i + 1) * laenge * senkrecht,
+          y anf + verhaeltnis * real (i + i + 1) * laenge) 
+  END REP . 
+ 
+abstand : 
+  sqrt ((y end - y anf) * (y end - y anf) + 
+        (x end - x anf) * (x end - x anf)) . 
+ 
+END PROC strichel; 
+ 
+PROC kasten (REAL CONST x anf, y anf, x l, y l) : 
+ 
+  move (x anf, y anf); 
+  draw (x anf, y anf + y l); 
+  draw (x anf + x l, y anf + y l); 
+  draw (x anf +  x l, y anf); 
+  draw (x anf, y anf) 
+ 
+END PROC kasten;
+ 
+ 
+LET myname = "abb.9-4";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000)
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/abb.9-5 b/app/eudas/4.4/doc/ref-manual/abb.9-5
new file mode 100644
index 0000000..c00655c
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/abb.9-5
@@ -0,0 +1,51 @@
+init dgs; 
+window (0.0, 0.0, 13.5, 7.0); viewport (0.0,0.0,13.5,7.0); 
+(*scale (1.7,1.7, 0.0,0.0);*)
+(*clear pixels;*)
+ 
+kasten (1.5, 0.0, 3.5, 2.0); 
+kasten (7.0, 0.0, 3.5, 2.0); 
+kasten (4.0, 4.0, 4.0, 3.0); 
+  kasten (5.0, 5.5, 2.0, 1.0); 
+ 
+move (3.25, 2.25); draw (4.75, 3.75); 
+  draw (4.5, 3.75); move (4.75, 3.75); draw (4.75, 3.5); 
+  move (3.25, 2.25); draw (3.5, 2.25); 
+  move (3.25, 2.25); draw (3.25, 2.5); 
+move (8.75, 2.25); draw (7.25, 3.75); 
+  draw (7.5, 3.75); move (7.25, 3.75); draw (7.25, 3.5);
+  move (8.75, 2.25); draw (8.5, 2.25); 
+  move (8.75, 2.25); draw (8.75, 2.5);
+ 
+x alignment (center); 
+font size (0.4); font expansion (1.4); 
+ 
+move (3.25, 0.2); draw ("Benutzer A"); 
+move (8.75, 0.2); draw ("Benutzer B"); 
+move (6.0, 4.3); draw ("Manager"); 
+font size (0.3);
+move (6.0, 5.6); draw ("Kunden"); 
+ 
+PROC kasten (REAL CONST x anf, y anf, x l, y l) : 
+ 
+  move (x anf, y anf); 
+  draw (x anf, y anf + y l); 
+  draw (x anf + x l, y anf + y l); 
+  draw (x anf +  x l, y anf); 
+  draw (x anf, y anf) 
+ 
+END PROC kasten;
+ 
+ 
+LET myname = "abb.9-5";
+save pixels (myname + ".p"); 
+FILE VAR f := sequential file (modify, myname + ".p"); 
+to line (f, 1); insert record (f); 
+write record (f, "#linefeed (0.8)#"); 
+insert record (f); write record (f, myname); 
+to eof (f); insert record (f); write record (f, myname); 
+to line (f, 1);
+(* 
+pause (9000)
+*)
+
diff --git a/app/eudas/4.4/doc/ref-manual/bildergenerator b/app/eudas/4.4/doc/ref-manual/bildergenerator
new file mode 100644
index 0000000..8129476
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/bildergenerator
@@ -0,0 +1,25 @@
+PROC starten : 
+ 
+  command dialogue (FALSE); 
+  disable stop; 
+  fetch (name, /"DGS NEC"); 
+  run (name); 
+  save (name + ".p", /"DGS NEC"); 
+  end (myself) 
+ 
+END PROC starten; 
+ 
+TEXT VAR name; 
+ 
+PROC gen (TEXT CONST t) : 
+ 
+  name := t; 
+  begin ("p", PROC starten, a); 
+  TASK VAR a; 
+  WHILE exists (a) REP pause (100) END REP 
+ 
+END PROC gen; 
+ 
+gen ("abb.4-2"); 
+gen ("abb.6-1");
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.1 b/app/eudas/4.4/doc/ref-manual/eudas.ref.1
new file mode 100644
index 0000000..4ca390a
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.1
@@ -0,0 +1,323 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (3)# 
+#kapitel ("1", "Zustände", "und", "Bedienung")# 
+ 
+ 
+ 
+#abschnitt ("1.1", "ZUSTÄNDE", "Zustände")# 
+ 
+EUDAS befindet sich zu jeder Zeit in einem von 11 verschiedenen
+Zuständen. Für jeden Zustand ist festgelegt, welche Eingabetasten
+benutzt werden können und welche Wirkung sie haben. Bestimmte
+Tastenfunktionen führen in einen anderen Zustand. Obwohl für
+jeden Zustand andere Tastenkombinationen gültig sind, wird für die
+gleiche Funktion in jedem Zustand auch die gleiche Taste oder
+Tastenkombination verwendet. 
+    Die wichtigsten Tastenfunktionen eines Zustandes werden in
+der #on("i")#Statuszeile#off("i")# am oberen Bildschirmrand angezeigt. 
+    Im folgenden sind alle möglichen Zustände als Übersicht be­
+schrieben. Eine Übersicht der Zustandsübergänge enthält Abb. 1-1. 
+    Zu jedem Zustand wird die entsprechende Statuszeile darge­
+stellt sowie alle möglichen Tastenfunktionen und ihre Bedeutung. 
+ 
+#bildschirm# 
+EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+#text# 
+_____________________________________________________ 
+ 
+OBEN         Anwahl der nächsthöheren Funktion 
+UNTEN        Anwahl der nächsttieferen Funktion 
+RECHTS       Anwahl des nächsten Menüs zur Rechten 
+LINKS        Anwahl des nächsten Menüs zur Linken 
+HOP OBEN     Anwahl der ersten Funktion 
+HOP UNTEN    Anwahl der letzten Funktion 
+'1' .. '6'   Anwahl des entsprechenden Menüs 
+LEER         Ausführen der gewählten Funktion 
+'Buchstabe'  Ausführen der Funktion mit 'Buchstabe' davor 
+ESC '?'      Hilfestellung zur gewählten Funktion 
+ESC ESC      Eingabe von ELAN-Kommandos 
+ 
+ 
+#bildschirm# 
+HILFE:    Beenden: ESC q    Seite weiter: ESC w    Seite zurueck: ESC z 
+#text# 
+_____________________________________________________ 
+ 
+ESC 'w'      Blättern zur nächsten Seite 
+ESC 'z'      Blättern zur vorigen Seite 
+ESC 'q'      Verlassen (Rückkehr in alten Zustand) 
+ 
+ 
+#bildschirm# 
+AUSWAHL:  Ankreuzen: 'x'  Durchstreichen: 'o'  Beenden: ESC q  Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+'x'          Auswahl ankreuzen 
+'o'          Ankreuzen rückgängig machen 
+LEER         Ankreuzen und Auswahl sofort verlassen 
+OBEN         Zur nächsten Auswahl nach oben 
+UNTEN        Zur nächsten Auswahl nach unten 
+HOP OBEN     Zur obersten Auswahl bzw. eine Seite zurück 
+HOP UNTEN    Zur untersten Auswahl bzw. eine Seite weiter 
+HOP RETURN   Aktuelle Auswahl wird erste auf der Seite 
+ESC '1'      zur ersten Auswahl 
+ESC '9'      zur letzten Auswahl 
+ESC 'q'      Auswahl verlassen und weitermachen 
+ESC '?'      Hilfe zur Auswahl 
+HOP 'x'      alle freien Wahlen ankreuzen 
+HOP 'o'      alle Kreuze entfernen 
+ESC 'h'      Auswahl und Funktion abbrechen 
+ 
+ 
+#bildschirm# 
+EINGABE:  Bestätigen: RETURN  Zeigen: ESC z  Abbrechen: ESC h  Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+RECHTS       zum nächsten Zeichen 
+LINKS        zum vorigen Zeichen 
+HOP RECHTS   zum letzten Zeichen 
+HOP LINKS    zum ersten Zeichen 
+RUBOUT       Zeichen löschen 
+RUBIN        Einfügemodus umschalten 
+HOP RUBOUT   Rest der Zeile löschen 
+'Zeichen'    Zeichen überschreiben oder einfügen 
+RETURN       Eingabe abschließen und weitermachen 
+ESC '?'      Hilfe zur Eingabe 
+ESC 'h'      Eingabe und Funktion abbrechen 
+ESC 'z'      Auswahl zeigen (falls in Statuszeile aufgeführt) 
+ 
+ 
+#bildschirm# 
+FRAGE:   Bejahen: j,J   Verneinen: n,N   Abbrechen: ESC h   Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+'j', 'J'     Frage bejahen 
+'n', 'N'     Frage verneinen 
+ESC '?'      Hilfe zur Frage 
+ESC 'h'      Frage und Funktion abbrechen 
+ 
+ 
+#bildschirm# 
+!!! FEHLER !!!     Quittieren: ESC q     Hilfe zur Meldung: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+ESC '?'      Hilfe zum Fehler 
+ESC 'Taste'  Fehler quittieren 
+'Taste'      Fehler quittieren 
+ 
+ 
+#bildschirm# 
+SATZ ÄNDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ? 
+SATZ EINFÜGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ? 
+SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+ESC OBEN     eine Seite zurück blättern 
+ESC UNTEN    eine Seite vor blättern 
+ESC '?'      Hilfe zum Satzeditor 
+ESC 'p'      ganzen Satz merken (nicht bei Suchmuster) 
+ESC 'g'      Satz durch gemerkten ersetzen (nicht bei Such­
+             muster) 
+ESC 'h'      Abbruch der Funktion 
+ESC 'D'      Tagesdatum schreiben 
+ESC 'F'      Prüffehler nach Tragen editieren 
+ESC 'w'      Verlassen und mit nächstem Satz erneut aufrufen
+             (nicht im Suchmuster) 
+ESC 'z'      Verlassen und mit vorigem Satz erneut aufrufen
+             (nicht im Suchmuster) 
+ESC RUBIN    Rest der Zeile in neue Zeile umbrechen 
+ESC RUBOUT   Rest der Zeile löschen 
+HOP RUBIN    nicht verwenden! 
+HOP RUBOUT   nicht verwenden! 
+#f2# 
+Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). 
+ 
+ 
+#bildschirm# 
+Bitte warten.. 
+#text# 
+_____________________________________________________ 
+ 
+keine Tasten erlaubt (außer SV) 
+ 
+ 
+#bildschirm# 
+ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+HOP OBEN     auf erste Zeile bzw. eine Seite zurück 
+HOP UNTEN    auf letzte Zeile bzw. eine Seite vor 
+ESC '?'      Hilfe zur Übersicht 
+ESC 'h'      Abbruch der Funktion 
+ESC 'q'      Verlassen 
+ 
+ 
+#bildschirm# 
+EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ? 
+#text# 
+_____________________________________________________ 
+ 
+ESC 'F'      Feldnamen anzeigen und auswählen 
+ESC 'h'      Abbruch der Funktion 
+#f2# 
+Weitere Tasten siehe EUMEL-Benutzerhandbuch (Editor). 
+ 
+ 
+#bildschirm# 
+Gib Kommando: 
+#text# 
+_____________________________________________________ 
+ 
+Tasten siehe EINGABE. 
+ 
+ 
+#free (18.5)# 
+#beispiel# 
+#center#Abb. 1-1   Zustandsübergänge 
+#text# 
+ 
+ 
+ 
+#abschnitt ("1.2", "MENÜS", "Menüs")# 
+ 
+Menüs dienen zur Auswahl von Funktionen. Sie werden am linken
+Rand des Bildschirms angezeigt. Welches Menü aktiv ist, wird durch
+Markierung des Menünamens in der obersten Bildschirmzeile unter
+allen zur Verfügung stehenden Menüs angezeigt. In jedem Menü ist
+die zuletzt ausgeführte Funktion ebenfalls markiert. 
+ 
+#a ("Ausführen von Funktionen")# Zum Ausführen einer bestimmten Funk­
+tion wird mit Hilfe der Cursortasten ein bestimmtes Menü und die
+gewünschte Funktion angewählt. Die Funktion wird dann durch
+Drücken der Leertaste ausgeführt. Alternativ kann auch der vor der
+Funktion stehende Buchstabe gedrückt werden. 
+    Die einzelnen Menüs können auch durch Nummern (1 bis 6)
+angewählt werden (absolute Positionierung). 
+    Soll eine andere Taste als die Leertaste zum Ausführen ver­
+wendet werden, so kann dies durch die Prozedur 'ausfuehrtaste'
+angegeben werden (s. Abschnitt 10.3). 
+    Funktionen, deren Ausführung augenblicklich nicht möglich
+oder nicht sinnvoll ist, werden durch ein vorangestelltes Minuszei­
+chen gekennzeichnet. Sie können zwar angewählt, nicht aber ausge­
+führt werden. 
+    Durch ESC '?' wird ein erläuternder Hilfstext zur gerade ange­
+wählten Funktion angezeigt. Näheres dazu s. Abschnitt 1.4. 
+    Durch ESC ESC kann ein beliebiges ELAN-Kommando eingegeben
+und ausgeführt werden. Die Eingabe des Kommandos erfolgt in der
+Statuszeile. 
+ 
+ 
+#abschnitt ("1.3", "AUSWAHL", "Auswahl")# 
+ 
+Die Auswahlfunktion dient dazu, aus vorhandenen Datei- oder
+Feldnamen in bestimmter Reihenfolge auszuwählen. Die einzelnen
+Namen werden untereinander aufgelistet. 
+    Vor jedem Namen ist ein 'o' zum Ankreuzen angegeben. Mit den
+Cursortasten kann der Cursor vor einen bestimmten Namen positio­
+niert werden. Mit 'x' kann dieser Name dann angekreuzt werden. Das
+Ankreuzen kann durch 'o' wieder rückgängig gemacht werden. 
+    Die Reihenfolge des Ankreuzens wird durch vorangestellte
+Nummern gekennzeichnet. Die Namen werden von der entsprechenden
+Funktion später in genau dieser Reihenfolge verwendet. 
+    Wenn nicht alle Namen auf den Bildschirm passen, kann die
+Darstellung gerollt werden. Ein Teil der Überschrift bleibt dabei
+stehen; am Anfang und am Ende wird jeweils eine Abschlußzeile zur
+Kennzeichnung mitgerollt. 
+    Mit ESC '?' kann eine Hilfestellung abgerufen werden. Mit ESC
+'q' wird die Auswahl beendet. Mit ESC 'h' können die Auswahl und
+die in Ausführung befindliche Operation abgebrochen werden. 
+ 
+ 
+#abschnitt ("1.4", "HILFE UND DIALOG", "Hilfe und Dialog")# 
+ 
+In den meisten Situationen kann durch ESC '?' eine spezifische
+Hilfestellung abgerufen werden. Die Anzeige der Hilfsinformation
+geschieht im rechten Bildschirmteil. 
+    Die Texte sind seitenweise aufgebaut. Es wird immer eine Seite
+angezeigt. Mit ESC 'w' bzw. ESC 'z' kann auf die nächste bzw, vorige
+Seite umgeblättert werden. Mit ESC 'q' wird die Hilfestellung wieder
+verlassen und die Situation wiederhergestellt, in der die Hilfe auf­
+gerufen wurde. 
+ 
+#a ("Fragen")# Die meisten Funktionen wickeln zur Eingabe von zusätz­
+lichen Parametern oder zum Stellen von Fragen einen Dialog in der
+unteren Schirmhälfte ab. Es gibt zwei Möglichkeiten des Dialogs:
+eine Frage oder die Eingabe eines Textes. 
+    Bei einer Frage kann man mit 'j' oder 'n' antworten. Sowohl
+große als auch kleine Buchstaben werden akzeptiert. Mit ESC '?'
+kann eine Hilfsinformation zu der Frage abgerufen werden. ESC 'h'
+bricht die fragende Funktion ab. 
+ 
+#a ("Eingabe")# Bei der Eingabe eines Textes können die üblichen Opera­
+tionen zum Editieren in einer Zeile verwendet werden. Die Eingabe
+wird durch RETURN beendet. Auch hier kann durch ESC '?' eine
+Hilfsinformation abgerufen werden. ESC 'h' bricht ebenfalls die fra­
+gende Funktion ab. In einigen Fällen (ersichtlich aus der Statuszei­
+le) kann durch ESC 'z' eine Auswahl der verfügbaren Namen abgeru­
+fen werden. 
+ 
+ 
+#abschnitt ("1.5", "EDITOR", "Editor")# 
+ 
+Der EUMEL-Editor wird in EUDAS auf zweierlei Weise aufgerufen.
+Zum einen dient er im Satzformular zum Eingeben von Daten und
+Suchmustern. Dort wird er als #on("i")#Satzeditor#off("i")# bezeichnet. Da hier die
+Feldnamen mit berücksichtigt werden müssen, gibt es einige Unter­
+schiede zum normalen Editor. 
+    An anderen Stellen wird der Editor ohne Änderungen eingesetzt
+zum Eingeben von Feldnamen oder Mustern. In diesem Fall finden
+Sie die Bedienungshinweise im EUMEL-Benutzerhandbuch. 
+ 
+#a ("Satzeditor")# Beim Ändern, Einfügen und Eingeben des Suchmusters
+wird im EUDAS-Formular der Editor aufgerufen. Das Editorfenster
+beschränkt sich auf den rechten Teil des Formulars, der einen Teil
+der Überschrift und die Feldinhalte umfaßt. Im Satzeditor können
+dann die entsprechenden Inhalte eingegeben bzw. verändert werden. 
+    Rollen unter Beibehaltung der Korrespondenz ist durch ESC
+OBEN und ESC UNTEN möglich. Diese Funktionen wirken wie bei der
+Anzeige - das Editorfenster wird ebenfalls entsprechend mitgerollt.
+Mit ESC '1' kann wie üblich auf die erste, mit ESC '9' auf die letzte
+Zeile gesprungen werden. Auch diese Funktionen passen die Feld­
+namen entsprechend an. 
+    Falls die für ein Feld vorgesehenen Zeilen nicht für den Inhalt
+ausreichen, kann durch ESC RUBIN eine weitere Zeile für dieses Feld
+bereitgestellt werden. ESC RUBIN wirkt wie zweimal HOP RUBIN, die
+Korrespondenz mit den Feldnamen bleibt jedoch gewahrt. 
+    Zum Löschen steht ESC RUBOUT zur Verfügung. Es löscht eine
+ganze Zeile, aber nur, wenn für dieses Feld noch andere Zeilen zur
+Verfügung stehen, wird die Zeile tatsächlich vom Bildschirm ent­
+fernt. Im Normalfall bleibt sonst eine Leerzeile für dieses Feld ste­
+hen. 
+    Ist die Information für ein Feld auf mehrere Zeilen verteilt, so
+werden diese Zeilen zur Verarbeitung aneinandergehängt. Gegebe­
+nenfalls wird zwischen zwei Zeilen noch ein Leerzeichen eingefügt. 
+    Der Editor kann wie üblich mit ESC 'q' verlassen werden. ESC
+'h' bricht die Funktion ab, ohne die erfolgten Änderungen und Ein­
+gaben zu berücksichtigen. Mit ESC 'w' und ESC 'z' kann das Bearbei­
+ten von mehreren Sätzen beschleunigt werden. Durch diese Tasten­
+kombinationen wird der Editor verlassen und die gleiche Operation
+(Ändern/Einfügen) beim nächsten bzw. vorigen Satz wiederholt. 
+ 
+#a ("Hinweis")# Aus technischen Gründen kann das Editorfenster gegen­
+über den Feldnamen verschoben werden (durch Rollen mit HOP
+UNTEN zum Beispiel). Dabei geht die sichtbare Korrespondenz zwi­
+schen Feldnamen und Feldinhalten verloren. Ein solcher Fall wird
+durch einen markierten Balken mit entsprechender Meldung ange­
+zeigt. Durch ESC '1' wird das Fenster aber wieder zurechtgerückt. 
+    Aus diesem Grund sollte im Satzeditor auf HOP OBEN und HOP
+UNTEN sowie auf RETURN am Ende des Fensters verzichtet werden.
+Auch HOP RUBIN und HOP RUBOUT sollten nicht verwendet werden,
+weil auf diese Weise die Anzahl der Zeilen verändert wird. Eine
+solche Störung kann nicht durch ESC '1' beseitigt werden. Von Hand
+müssen die entsprechenden Zeilen wieder gelöscht oder eingefügt
+werden. 
+ 
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.10 b/app/eudas/4.4/doc/ref-manual/eudas.ref.10
new file mode 100644
index 0000000..2478130
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.10
@@ -0,0 +1,394 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (97)# 
+#kapitel ("10", "Programmierung", "der", "Menüs")# 
+ 
+ 
+ 
+#abschnitt ("10.1", "MENÜFORMAT", "Menüformat")# 
+ 
+EUDAS verwendet drei verschiedene Strukturen zur Benutzerunter­
+stützung: Menü, Auswahl und Hilfestellung. Ein Menü dient zur
+Auswahl von Funktionen, eine Auswahl bietet Feld- oder Datei­
+namen an und eine Hilfestellung zeigt einen Informationstext. 
+    Alle diese Strukturen werden aus einer Initialisierungsdatei
+eingelesen. Die Initialisierungsdatei ist eine normale Textdatei. Ihr
+Format soll in diesem Abschnitt beschrieben werden. 
+    Die Strukturen können in beliebiger Reihenfolge in der Initiali­
+sierungsdatei stehen. Jede Struktur wird durch eine spezielle
+Anweisung eingeleitet. Anweisungen beginnen ähnlich wie im
+Druckmuster mit einem Prozentzeichen. Dementsprechend gibt es die
+drei Anweisungen 
+ 
+#beispiel# 
+    % MENUE "Name" 
+    % AUSWAHL "Name" 
+    % HILFE "Gebiet/Name" 
+#text# 
+ 
+die jeweils eine Struktur einleiten. Beendet wird eine Definition
+immer mit 
+ 
+#beispiel# 
+    % ENDE 
+#text# 
+ 
+#a ("Menü")# Für ein Menü wird noch der Text angegeben, der auf dem
+Bildschirm erscheinen soll. Er wird durch die Anweisung 
+ 
+#beispiel# 
+    % BILD 
+#text# 
+ 
+eingeleitet. Danach folgen Zeilen mit dem Bildschirminhalt in der
+gewünschten Größe (die tatsächliche Anzeigegröße wird erst beim
+Aufruf angegeben). Dabei werden die Auswahlpositionen, auf denen
+der Cursor sich bewegen kann, durch ein geschütztes Leerzeichen in
+Spalte 2 festgelegt. 
+    Nach der Angabe des Bildes muß für jede mögliche Auswahl­
+position noch eine weitere Angabe gemacht werden. Die Auswahl­
+positionen (oder Felder) werden dabei von oben nach unten durch­
+gezählt. Begonnen wird mit der Nummer 1. 
+    Eine Felddefinition hat das Format 
+ 
+#beispiel# 
+    % FELD nr "Hilfstext" "Tasten" 
+#text# 
+ 
+Die Nummer identifiziert das Feld. Der Hilfstext gibt den Namen der
+Hilfestellung an, die gezeigt werden soll, wenn auf diesem Feld ESC
+'?' gedrückt wird. Die Tasten sind alle Zeichen, die gedrückt werden
+können, um dieses Feld direkt auszuführen. 
+    Anschließend an die Felddefinition kann in weiteren Zeilen
+noch ein ELAN-Programm folgen, das bei Auswahl des Feldes aus­
+geführt wird. 
+ 
+#a ("Auswahl")# Für eine Auswahl muß zuerst ein Vorspann angegeben
+werden, der immer in den ersten Bildschirmzeilen der Auswahl an­
+gezeigt wird. Dieser wird durch 
+ 
+#beispiel# 
+    % VORSPANN 
+#text# 
+ 
+eingeleitet. Danach folgt das Bild. Das Bild setzt sich aus drei Tei­
+len zusammen. Die erste Zeile, in der ein geschütztes Leerzeichen
+vorkommt, bildet den Wiederholungsteil. Diese Zeile wird nachher so
+oft wie nötig mit entsprechenden Inhalten wiederholt, wobei das
+geschützte Leerzeichen als Bindestrich dargestellt wird, auf dem
+sich der Cursor bewegen kann. Die Teile davor und danach werden
+jeweils bei Bedarf mitgerollt. 
+    Die Wiederholungszeile darf mehrere geschützte Leerzeichen
+enthalten. Die Inhalte werden dann in mehreren Spalten angezeigt.
+Zu beachten ist, daß vor einem Trennstrich noch mindestens fünf
+Zeichen Platz für eine laufende Nummer bleiben müssen. 
+ 
+#a ("Hilfe")# Der Name einer Hilfestellung setzt sich aus zwei Teilen
+zusammen, die durch einen Schrägstrich getrennt werden. Der erste
+Name gibt die Kategorie der Hilfestellung an, der zweite Name den
+Einzeltext. Dies dient dazu, die relativ große Zahl der Hilfstexte
+überschaubar zu machen. Als Beispiel 
+ 
+#beispiel# 
+    % HILFE "JA/Allgemein" 
+#text# 
+ 
+Eine Hilfestellung besteht einfach aus mehreren Seiten Text. Jede
+Seite wird durch die AnweisungQ
+ 
+#beispiel# 
+Q̈Q̈Q̈Q̈Q̈Q̈Q̈Q
+#text# 
+ 
+
+
+
+
+
+ 
+#beispiel# 
+
+#text# 
+ 
+
+
+
+Text folgen. 
+ 
+ 
+
+ 
+
+
+
+
+hinzugefügt. 
+
+
+
+
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+    deutung: 
+
+
+
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+ 
+#proc# 
+
+
+
+#endproc# 
+
+
+
+ 
+#beispiel# 
+
+
+
+ 
+
+
+
+
+        ELSE 
+
+
+ 
+
+ 
+
+
+#text# 
+ 
+ 
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+selbst. 
+ 
+#proc# 
+
+
+
+
+#endproc# 
+
+
+
+
+
+
+
+
+#f2# 
+
+
+
+
+
+#f2# 
+
+
+
+
+
+
+
+
+
+
+
+
+#f2# 
+    FEHLER: 
+#f1# 
+
+
+ 
+#proc# 
+
+
+#endproc# 
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+#f2# 
+    FEHLER: 
+#f1# 
+
+
+
+ 
+#proc# 
+
+
+
+#endproc# 
+
+
+
+
+
+#f2# 
+    FEHLER: 
+#f1# 
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+#f2# 
+    FEHLER: 
+#f1# 
+
+
+ 
+#proc# 
+
+#endproc# 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+ 
+#proc# 
+PROC dialog 
+#endproc# 
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+ 
+#proc# 
+
+
+#endproc# 
+
+
+
+
+
+ 
+#proc# 
+
+#endproc# 
+
+
+
+
+    den. 
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.11 b/app/eudas/4.4/doc/ref-manual/eudas.ref.11
new file mode 100644
index 0000000..3c555d1
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.11
@@ -0,0 +1,327 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (105)# 
+#kapitel ("11", "Programmierung", "von", "Anwendungen")# 
+ 
+ 
+ 
+Zur Realisierung eigener EUDAS-Anwendungen mit Hilfe von ELAN-
+Programmen gibt es mehrere Möglichkeiten mit zunehmender Lei­
+stungsfähigkeit, aber auch steigender Komplexität und Fehleranfäl­
+ligkeit. In den folgenden Abschnitten werden die drei wesentlichen
+Methoden vorgestellt. Sie sollten erst dann eine kompliziertere
+Methode in Angriff nehmen, wenn Sie die einfachere beherrschen. 
+ 
+ 
+#abschnitt ("11.1", "MUSTERPROGRAMME", "Musterprogramme")# 
+ 
+Die bevorzugte Methode zur Erstellung eigener Anwendungen unter
+EUDAS ist die Programmierung von Mustern. EUDAS läßt dies bei
+Druckmustern, Kopiermustern und Änderungsmustern zu. 
+    In diesem Fall steuert EUDAS den Ablauf des Programms im
+groben automatisch. Die jeweils unterschiedlichen Anweisungen, was
+im einzelnen zu tun ist, werden in ELAN programmiert. Aus dem
+Muster mit diesen zusätzlichen Anweisungen generiert EUDAS dann
+das Programm und führt es mit Hilfe des ELAN-Compilers aus. 
+ 
+#a ("Vorteile")# Diese Methode hat den Vorteil, daß nur die minimal not­
+wendigen Anweisungen tatsächlich selbst programmiert werden
+müssen. Dafür reichen bereits geringe ELAN-Kenntnisse vollkommen
+aus. Ein Muster kann relativ schnell erstellt und getestet werden.
+Durch den einfachen Aufbau ist auch die Fehlerwahrscheinlichkeit
+beim Entwickeln geringer als bei anderen Methoden. 
+    Daneben lassen sich die Musterprogramme jeweils bequem im
+Menü durch Angabe des Namens oder durch Ankreuzen ausführen,
+also auch durch unbedarfte Benutzer. 
+ 
+#a ("Nachteile")# Nachteil dieser Methode ist, daß jeweils beim Aufruf das
+Programm nochmal neu erzeugt und übersetzt werden muß, da die
+Übersetzung auch von der gerade geöffneten Datei abhängt. Dies
+stört besonders bei umfangreichen Druckmustern (auf langsamen
+Rechnern). 
+    Zum zweiten wird ein umfangreiches Druckmuster auch bald
+unübersichtlich, da Strukturierungshilfen für größere Programme
+fehlen. Der eigentliche Mustertext ist dann schwer von den zahlrei­
+chen Abkürzungen zu trennen. 
+    Als Abhilfe für diese beiden Nachteile bietet es sich an, um­
+fangreichere Abkürzungen bzw. Ausdrücke eingebettet in ein
+ELAN-Paket aus dem Muster herauszunehmen und vorher zu in­
+sertieren. 
+    Dadurch fällt zum einen die ständige Neuübersetzung dieser
+Ausdrücke weg, zum anderen ist das eigentliche Muster wieder
+überschaubar. Voraussetzung zur Anwendung eines solchen Musters
+ist dann jedoch, daß das zugehörige Paket in der jeweiligen Task
+bereits vorher übersetzt wurde. 
+    Die nachfolgenden Beispiele zeigen, wie dieses Verfahren in der
+Realität aussehen kann. 
+ 
+#a ("Beispiel 1")# In der Schulverwaltung soll ein Kopier- oder Ände­
+rungsmuster erstellt werden, das die Versetzung am Schuljahresende
+realisiert. Angenommen wird eine Datei, die alle Schüler enthält.
+Schüler, die nicht versetzt werden, sind vorher im Feld 'Versetzung'
+mit einem beliebigen Text gekennzeichnet worden (zum Beispiel
+'Nachprüfung' o.ä.). 
+    Die Versetzung kann auf zweierlei Weise erfolgen: zum einen
+durch automatische Änderung, wenn die alte Version noch auf einer
+Archivdiskette aufgehoben wird, oder durch Kopieren in eine neue
+Datei. 
+    Bei beiden Mustern ist die einzige Änderung die Angabe der
+neuen Klasse. Daher bietet es sich an, eine Prozedur 'neue klasse'
+zu definieren, die als Ergebnis die neue Klasse eines Schülers lie­
+fert. Diese Prozedur kann dann im Änderungsmuster wie folgt ver­
+wendet werden: 
+ 
+#beispiel# 
+        "Klasse" V neue klasse; 
+#text# 
+ 
+Entsprechend läuft die Verwendung im Kopiermuster: 
+ 
+#beispiel# 
+        "Name" K f ("Name"); 
+        "Vorname" K f ("Vorname"); 
+        "Klasse" K neue klasse; 
+        ... 
+#text# 
+ 
+Die Prozedur 'neue klasse' muß dann in einem Paket definiert wer­
+den, das etwa folgendes Aussehen haben könnte (spezifische Ände­
+rungen natürlich möglich): 
+ 
+#beispiel# 
+    PACKET klassenwechsel DEFINES neue klasse: 
+ 
+    TEXT PROC neue klasse : 
+ 
+      IF f ("Versetzung") = "" THEN 
+        klasse um 1 erhoeht 
+      ELSE 
+        alte klasse ohne zusatz 
+      END IF . 
+ 
+    klasse um 1 erhoeht : 
+      INT CONST alte klasse := int (f ("Klasse")); 
+      IF alte klasse < 9 THEN 
+        "0" + text (alte klasse + 1) + zusatz 
+      ELSE 
+        text (alte klasse + 1) + zusatz 
+      END IF . 
+ 
+    zusatz : 
+      f ("Klasse") SUB 3. 
+ 
+    alte klasse ohne zusatz : 
+      subtext (f ("Klasse"), 1, 2) . 
+ 
+    END PROC neue klasse; 
+ 
+    END PACKET klassenwechsel; 
+#text# 
+ 
+Schüler, die versetzt werden, erhalten ihre neue Jahrgangsstufe mit
+dem alten Klassenzusatz zugeteilt. Dabei ist darauf zu achten, daß
+die Klassen 5 bis 9 eine '0' vorangestellt bekommen, damit die
+Sortierung funktioniert. 
+    Schüler, die nicht versetzt werden, behalten ihre alte Jahr­
+gangsstufe, allerdings ohne einen Klassenzusatz, der ihnen an­
+schließend manuell zugewiesen werden muß. 
+    Zur Benutzung muß das oben angegebene Paket in eine Text­
+datei geschrieben und mit dem Kommando 'insert' fest insertiert
+werden. 
+ 
+#a ("Beispiel 2")# Aus einer Datei mit bibliographischen Einträgen sollen
+bestimmte Literaturhinweise gedruckt werden. Der Literaturhinweis
+soll jeweils als Endlostext umbrochen werden. Dafür müssen in einer
+Abkürzung alle Daten verkettet werden. Es sei das folgende ein­
+fache Druckmuster vorgegeben: 
+ 
+#beispiel# 
+    % WIEDERHOLUNG 
+    % MODUS 3 
+    [&<krz>]    &titel 
+ 
+    % ABKUERZUNGEN 
+    &krz :  f ("Kurzbez") .    (* z.B. "Lew84" *) 
+    &titel :  titel lang . 
+#text# 
+ 
+Die Prozedur 'titel lang' wird in folgendem Paket definiert: 
+ 
+#beispiel# 
+    PACKET bibliographie DEFINES titel lang : 
+ 
+    TEXT VAR puffer;   (* verringert Heap-Belastung *) 
+ 
+    TEXT PROC titel lang : 
+ 
+      puffer := f ("Name 1"); 
+      puffer CAT ", "; 
+      puffer CAT f ("Vorname 1"); 
+      ggf weitere namen; 
+      titel kursiv; 
+      enthalten in; 
+      erscheinungsort und jahr; 
+      puffer . 
+ 
+    ggf weitere namen: 
+      IF f ("Name 2") <> "" THEN 
+        puffer CAT "; "; 
+        puffer CAT f ("Name 2") 
+      END IF . 
+ 
+    titel kursiv : 
+      puffer CAT "   \#on (""i"")\#"; 
+      puffer CAT f ("Titel"); 
+      puffer CAT "\#off (""i"")\#, " . 
+ 
+    enthalten in : 
+      IF f ("in") <> "" THEN 
+        puffer CAT " in: "; 
+        puffer CAT f ("in"); 
+        puffer CAT ", " 
+      END IF . 
+ 
+    erscheinungsort und jahr : 
+      puffer CAT f ("Ort"); 
+      puffer CAT ", "; 
+      puffer CAT f ("Jahr") . 
+ 
+    END PROC titel lang; 
+ 
+    END PACKET bibliographie; 
+#text# 
+ 
+Die Puffervariable wird verwendet, um die bei Verwendung des
+Operators '+' entstehende Heapbelastung zu verringern. An diese
+Variable werden nacheinander alle notwendigen Daten mit den ent­
+sprechenden Trennzeichen angehängt. 
+    Im Druckmuster wird dieser lange Text dann im Modus 3 auf
+mehrere Zeilen umbrochen, wobei die Einrückung erhalten bleibt. Die
+Druckausgabe kann dann bei Bedarf noch mit 'lineform' bearbeitet
+werden, um einen noch besseren Umbruch zu erzielen. 
+ 
+ 
+#abschnitt ("11.2", "DATEIANWENDUNGEN", "Dateianwendungen")# 
+ 
+Die zweite Möglichkeit der Programmierung unter EUDAS besteht
+darin, ELAN-Programme zu schreiben, die EUDAS-Dateien mit Hilfe
+des in Kapitel 6 beschriebenen Datentyps EUDAT manipulieren. Die
+Programmierung gestaltet sich ähnlich wie mit FILEs. 
+ 
+#a ("Vorteile")# Durch dieses Verfahren haben Sie volle Freiheit der Pro­
+grammierung. Da lediglich die Struktur der EUDAS-Dateien als
+Datenspeicher verwendet wird, sind sehr viele Anwendungen denk­
+bar. 
+    Außerdem können so beliebig viele Dateien gleichzeitig bear­
+beitet werden. Da die Programme nicht auf die virtuelle Datei zu­
+greifen, ist ein Konflikt mit dem aktuellen Zustand von EUDAS
+nahezu ausgeschlossen. 
+ 
+#a ("Nachteile")# Der Nachteil dieses Verfahrens ist, daß viele Dinge
+selbst programmiert werden müssen, so zum Beispiel das Durchgehen
+einer Datei. Auch die Hilfsmittel der virtuellen Datei wie Such­
+muster, Koppeln und alle Anwendungen, die auf die virtuelle Datei
+zugreifen, stehen nicht zur Verfügung. 
+ 
+#a ("Beispiel 1")# Die in Abschnitt 6.6 vorgestellte Anwendung als Asso­
+ziativspeicher kann als Beispiel für diese Methode dienen. 
+ 
+#a ("Beispiel 2")# Eine EUDAS-Datei (zum Beispiel eine Schülerdatei) soll
+in mehrere Dateien aufgespalten werden (zum Beispiel klassen­
+weise). Dies kann durch das folgende Beispielprogramm bewirkt
+werden: 
+ 
+#beispiel# 
+    LET 
+      klassenfeld = 3, 
+      quellname = "Schüler", 
+      zielname = "Jahrgang "; 
+    ROW 9 EUDAT VAR ziel; 
+    EUDAT VAR quelle; 
+    SATZ VAR feldnamen; 
+ 
+    quelle oeffnen; 
+    zieldateien einrichten; 
+    auf satz (quelle, 1); 
+    WHILE NOT dateiende (quelle) REP 
+      aktuellen satz kopieren; 
+      weiter (quelle) 
+    END REP . 
+ 
+    quelle oeffnen : 
+      oeffne (quelle, quellname); 
+      feldnamen lesen (quelle, feldnamen) . 
+ 
+    zieldateien einrichten : 
+      INT VAR i; 
+      FOR i FROM 1 UPTO 9 REP 
+        oeffne (ziel (i), zielname + text (i + 4)); 
+        feldnamen aendern (ziel (i), feldnamen) 
+      END REP . 
+ 
+    aktuellen satz kopieren : 
+      SATZ VAR satz; 
+      satz lesen (quelle, satz); 
+      satz einfuegen (ziel (stufe), satz); 
+      weiter (ziel (stufe)) . 
+ 
+    stufe : 
+      TEXT VAR klasse; 
+      feld lesen (satz, klassenfeld, klasse); 
+      int (klasse) - 4 . 
+#text# 
+ 
+ 
+#abschnitt ("11.3", "INTEGRIERTE ANWENDUNGEN", "Integrierte Anwendungen")# 
+ 
+Die schwierigste Möglichkeit, Anwendungen unter EUDAS zu reali­
+sieren, ist ihre Integration. Ein solches Programm greift selbst auf
+die virtuelle Datei zu, nutzt die Funktionen von EUDAS so weit wie
+möglich und definiert vielleicht sogar ein eigenes Menü. 
+ 
+#a ("Vorteile")# Auf diese Weise können natürlich alle Möglichkeiten
+ausgeschöpft werden. Sie können Programme erstellen, die als eine
+natürliche Erweiterung von EUDAS wirken oder EUDAS ganz erset­
+zen. 
+ 
+#a ("Nachteile")# Eine solche Integration ist aber besonders schwierig,
+wenn EUDAS und die Erweiterung nebeneinander benutzt werden
+sollen. In diesem Fall hat EUDAS keine komplette Kontrolle der
+Interaktion, so daß leicht undefinierte Zustände möglich sind. 
+    Weniger Probleme treten auf, wenn sichergestellt ist, daß nur
+die Anwendung selbst verwendet wird. Auch in diesem Fall ist zu
+beachten, daß EUDAS nicht als Programmierumgebung für Anwen­
+dungssysteme konzipiert wurde und daher nicht immer leicht zu
+benutzen ist. 
+    Am einfachsten ist es noch, nur eigene Menüs für eine andere
+Anwendung zu verwenden, da die Menüprozeduren relativ unabhän­
+gig vom Rest sind. 
+ 
+#a ("Richtlinien")# Bei Erweiterungen von EUDAS sind folgende Richtlinien
+zu beachten: 
+#f2# 
+1. Ein Programm, das selber Dateien für die virtuelle Datei öffnen
+   will, sollte vorher prüfen, ob noch eine Datei geöffnet ist und in
+   diesem Fall abbrechen. Beim Multi-User-Betrieb ist nämlich
+   sonst nicht gewährleistet, daß alle Sperren wieder entfernt
+   werden. 
+#f2# 
+2. Ein solches Programm sollte seine eigenen Dateien vor dem
+   Wechsel zu EUDAS selbst wieder sichern und die Arbeitskopien
+   löschen, damit der Ausgangszustand zu Beginn des Programms
+   wiederhergestellt wird. 
+#f2# 
+3. Programme, die Menüs benutzen, sollten nicht unter EUDAS auf­
+   gerufen werden, da sonst eine Beeinflussung der EUDAS-Menüs
+   möglich ist. 
+#f2# 
+An dieser Stelle soll noch einmal von der Erstellung integrierter
+Anwendungen abgeraten werden, wenn es auch andere Möglichkeiten
+gibt, das gegebene Problem mit EUDAS zu lösen. Der hohe Aufwand
+dieser Methode rechtfertigt sich nur in wenigen Fällen. 
+    Experimentierfreudige Anwender werden sich durch diese War­
+nung sowieso nicht abhalten lassen. Ihnen sollte aber bewußt sein,
+daß ein solches Vorgehen auf eigene Gefahr stattfindet und kein
+Anspruch auf Beratung oder Fehlerbeseitigung in einem solchen Fall
+besteht. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.2 b/app/eudas/4.4/doc/ref-manual/eudas.ref.2
new file mode 100644
index 0000000..bed3bf6
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.2
@@ -0,0 +1,820 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (13)# 
+#kapitel ("2", "Zusammenstellung", "der", "Funktionen")# 
+ 
+ 
+ 
+Im folgenden finden Sie eine Übersicht über alle Menüfunktionen. Zu
+jeder Funktion ist aufgeführt, welche Parameter angegeben werden
+müssen. Die Parameter werden als Text erfragt. Bei einigen Funk­
+tionen können alle möglichen Parameterwerte mit ESC 'z' (Zeigen)
+als Auswahl abgerufen werden. Bei manchen können in der Auswahl
+mehrere Werte angekreuzt werden, die dann nacheinander abgear­
+beitet werden. Welcher Fall zutrifft, ist jeweils aufgeführt. 
+ 
+ 
+#abschnitt ("2.1", "MENÜ 'ÖFFNEN'", "Menü 'Öffnen'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#O           EUDAS-Datei Öffnen#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, eine Wahl 
+#f2# 
+Zweck:      Stellt eine EUDAS-Datei als aktuelle Arbeitsdatei ein.
+            Falls eine vorher geöffnete Datei verändert wurde,
+            wird sie nach Anfrage gesichert. Falls die zu öffnende
+            Datei noch nicht existiert, kann sie nach Anfrage
+            eingerichtet werden. Dabei müssen dann die Feld­
+            namen angegeben werden. 
+#f2# 
+            Es wird gefragt, ob die Datei geändert werden soll. In
+            diesem Fall wird eine Arbeitskopie hergestellt. Fast
+            alle EUDAS-Funktionen beziehen sich nachher auf die
+            so eingestellte Datei. 
+#f2# 
+            Ist ein Mehrbenutzer-Manager eingestellt, kann auch
+            eine Datei aus dieser Managertask als Parameter
+            angegeben werden. Die Datei wird dann automatisch
+            von dort kopiert und eine Sperre im Manager gesetzt,
+            falls Änderungen vorgenommen werden sollen. 
+#f2# 
+Verweise:   Abschnitt 3.2 
+            Benutzerhandbuch Abschnitt 5.1 und 9.1 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#E           EUDAS-Datei Ketten#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Falls bereits eine EUDAS-Datei geöffnet ist, kann eine
+            weitere Datei gleicher Struktur logisch angekettet
+            werden. Bei der Bearbeitung werden dann beide Datei­
+            en wie eine zusammenhängende Datei behandelt. 
+#f2# 
+            Die gekettete Datei kann ebenfalls verändert werden,
+            wenn dies beim Öffnen der ersten Datei angegeben
+            wurde. Die angegebene Datei kann auch aus einem
+            Manager stammen. 
+#f2# 
+Verweise:   Abschnitt 3.2 
+            Benutzerhandbuch Abschnitt 9.2 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#K           EUDAS-Datei Koppeln#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Falls bereits eine Datei geöffnet ist, kann eine andere
+            EUDAS-Datei dazugekoppelt werden. Dazu muß min­
+            destens das erste Feld der zu koppelnden Datei in der
+            bereits geöffneten Datei vorkommen. 
+#f2# 
+            Nach dem Koppeln erscheinen beide Dateien wie eine
+            Datei. Zu jedem Satz der ersten Datei erscheinen je­
+            weils alle Sätze der Koppeldatei, die in dem Koppelfeld
+            übereinstimmen. 
+#f2# 
+            Die gekoppelte Datei kann ebenfalls verändert werden,
+            wenn dies beim Öffnen der ersten Datei angegeben
+            wurde. Die angegebene Datei kann auch aus einem
+            Manager stammen. 
+#f2# 
+Verweise:   Abschnitt 3.3 
+            Benutzerhandbuch Abschnitt 9.3 und 9.4 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#S           Arbeitskopie Sichern#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Wurde eine EUDAS-Datei geöffnet und verändert, muß
+            zum Schluß die veränderte Arbeitskopie wieder ge­
+            sichert werden. Die Arbeitskopie kann entweder ge­
+            löscht werden, die alte Version ersetzen oder unter
+            einem neuen Namen registriert werden. 
+#f2# 
+            Für jede veränderte Datei wird zunächst erfragt, ob
+            die alte Version überschrieben werden soll. Dies ist
+            der Normalfall. Bei Verneinung dieser Frage muß ein
+            neuer Name für die Arbeitskopie angegeben werden. 
+#f2# 
+            Zum Schluß wird erfragt, ob alle Arbeitskopien ge­
+            löscht werden sollen (Normalfall: ja). Anderenfalls
+            bleiben die Dateien weiter geöffnet. 
+#f2# 
+Verweise:   Abschnitt 3.5 
+            Benutzerhandbuch Abschnitt 6.4 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#N           Notizen ansehen/ändern#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Zu jeder EUDAS-Datei kann als Notiz ein beliebiger
+            Text gespeichert werden. Dieser Text der aktuellen
+            Datei wird mit dieser Funktion im Editor angezeigt
+            und kann verändert werden, wenn eine Arbeitskopie
+            angelegt wurde. Anderenfalls werden etwaige Verän­
+            derungen einfach ignoriert. 
+#f2# 
+Verweise:   Abschnitt 3.1 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#F           Feldstruktur ändern#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Mit dieser Funktion können neue Felder an die aktu­
+            elle Datei angefügt werden. Außerdem lassen sich
+            Feldnamen und Feldtypen ändern. Die Feldtypen be­
+            stimmen die Behandlung eines Feldes beim Suchen oder
+            Sortieren (z.B. von Zahlen). 
+#f2# 
+            Zunächst wird erfragt, ob neue Feldnamen angefügt
+            werden sollen. Diese können dann im Editor eingege­
+            ben werden. Danach wird gefragt, ob Feldnamen oder
+            Feldtypen geändert werden sollen (neu angefügte
+            Felder erhalten erst einmal den Typ TEXT). Falls die
+            Frage bejaht wird, können in einer Auswahl die zu
+            ändernden Felder angekreuzt werden. Für jedes ange­
+            kreuzte Feld werden dann der Name und der Typ zum
+            Überschreiben angeboten. 
+#f2# 
+Verweise:   Abschnitt 3.1 
+            Benutzerhandbuch Abschnitt 11.1 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#P           Prüfbedingungen ansehen/ändern#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Beim Tragen in eine EUDAS-Datei können Bedingungen
+            für die zu tragenden Sätze überprüft werden. Diese
+            Bedingungen für die aktuelle Datei können mit dieser
+            Funktion angezeigt und, falls erlaubt, auch geändert
+            werden. 
+#f2# 
+Verweise:   Abschnitt 3.1 und 4.4 
+            Benutzerhandbuch Abschnitt 11.3 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#M           Mehrbenutzer Manager einstellen#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Managertaskname, kein Zeigen 
+#f2# 
+Zweck:      EUDAS kann beim Öffnen eine Datei von einer anderen
+            Task des Systems kopieren. Dadurch können mehrere
+            Benutzer kontrolliert auf die gleiche Datei zugreifen.
+            Wenn diese Möglichkeit verwendet werden soll, muß
+            mit dieser Funktion zunächst die in Frage kommende
+            Managertask angegeben werden. 
+#f2# 
+Verweise:   Abschnitt 3.7 
+            Benutzerhandbuch Abschnitt 9.6 
+ 
+ 
+#abschnitt ("2.2", "MENÜ 'EINZELSATZ'", "Menü 'Einzelsatz'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#W           Weiter#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Geht einen Satz weiter in der aktuellen Datei - falls
+            eine Suchbedingung eingestellt ist, weiter zum näch­
+            sten ausgewählten Satz. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 5.2 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#Z           Zurück#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Geht einen Satz zurück in der aktuellen Datei - falls
+            eine Suchbedingung eingestellt ist, zurück zum vori­
+            gen ausgewählten Satz. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 5.2 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#N           Auf Satz Nr. ..#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Positioniert auf einen bestimmten Satz der aktuellen
+            Datei, dessen Satznummer eingegeben werden muß, und
+            zwar unabhängig, ob der Satz durch die Suchbedingung
+            ausgewählt wird oder nicht. Trifft die eingestellte
+            Suchbedingung nicht auf den Satz zu, erscheint
+            'SUCH-' in der Überschrift. Existiert die eingegebene
+            Satznummer nicht, positioniert EUDAS hinter den
+            letzten Satz der Datei. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 5.2 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#S           Suchbedingung Setzen#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Es kann eine neue Suchbedingung für die aktuelle
+            Datei eingegeben werden, bzw. eine vorher eingestellte
+            Suchbedingung wird zum Ändern angeboten. Die Such­
+            bedingung wird in Form eines Suchmusters in das
+            Satzformular geschrieben. 
+#f2# 
+            Die eingestellte Suchbedingung wird beim Positionieren
+            und bei allen Bearbeitungsfunktionen beachtet. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 5.3, 5.4 und 10.3 
+ 
+ 
+#linefeed (0.5)# 
+#on("b")#L           Suchbedingung Löschen#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Die eingestellte Suchbedingung wird wieder gelöscht. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 5.3 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#M           Markierung umkehren#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Mit dieser Funktion können einzelne Sätze zur späte­
+            ren Bearbeitung markiert werden. Falls der aktuelle
+            Satz bereits markiert ist, wird die Markierung wieder
+            entfernt, ansonsten wird er markiert. 
+#f2# 
+            Wenn mindestens ein Satz markiert ist, beachten die
+            Bearbeitungsfunktionen nur die markierten Sätze. So
+            kann eine manuelle Auswahl durchgeführt werden. Die
+            Markierung bleibt nur bis zum Sichern bestehen. Sie
+            ist keine permanente Eigenschaft einer EUDAS-Datei. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 10.4 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#E           Datensatz Einfügen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Mit dieser Funktion wird vor dem aktuellen Satz ein
+            leerer Satz eingefügt, für den anschließend die Feld­
+            inhalte im Satzformular eingetragen werden können. 
+#f2# 
+Verweise:   Abschnitt 3.4 
+            Benutzerhandbuch Abschnitt 6.2 und 10.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#A           Datensatz Ändern#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Die Inhalte des aktuellen Satzes werden im Satzformu­
+            lar zum Ändern angeboten. 
+#f2# 
+Verweise:   Abschnitt 3.4 
+            Benutzerhandbuch Abschnitt 6.3 und 10.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#T           Datensatz Tragen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, eine Wahl 
+#f2# 
+Zweck:      Mit dieser Funktion kann der aktuelle Satz in eine
+            anderen EUDAS-Datei gleicher Struktur transportiert
+            werden. In der Zieldatei wird er am Ende angefügt. 
+#f2# 
+Verweise:   Abschnitt 4.4 
+            Benutzerhandbuch Abschnitt 6.3 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#H           Datensatz Holen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, eine Wahl 
+#f2# 
+Zweck:      Mit dieser Funktion kann der letzte Satz einer ande­
+            ren Datei vor dem aktuellen Satz eingefügt werden,
+            sofern die Struktur gleich ist. Damit kann ein vorher­
+            gegangenes Tragen rückgängig gemacht werden. 
+#f2# 
+Verweise:   Abschnitt 4.4 
+            Benutzerhandbuch Abschnitt 6.3 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#F           Feldauswahl#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Die Felder der aktuellen Datei werden in einer Aus­
+            wahl angeboten. Am Bildschirm werden danach nur die
+            ausgewählten Felder in der gewählten Reihenfolge
+            dargestellt. Die Auswahl hat jedoch nur Auswirkung
+            auf die Darstellung am Bildschirm, anderen Funktionen
+            stehen nach wie vor alle Felder zur Verfügung. Die
+            Auswahl gilt bis zum Sichern, sie wird also nicht mit
+            der Datei abgespeichert. 
+#f2# 
+Verweise:   Abschnitt 4.1 
+            Benutzerhandbuch Abschnitt 10.1 
+ 
+ 
+#abschnitt ("2.3", "MENÜ 'GESAMTDATEI'", "Menü 'Gesamtdatei'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#K           Satzauswahl Kopieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, eine Wahl 
+            Name Kopiermuster, ohne Zeigen 
+#f2# 
+Zweck:      Mit dieser Funktion werden die ausgewählten bzw.
+            markierten Sätze der aktuellen Datei in eine andere
+            Datei kopiert. Welche Felder kopiert werden sollen und
+            in welcher Reihenfolge, wird durch ein Kopiermuster
+            festgelegt. Dieses Kopiermuster kann benannt werden
+            oder unbenannt nur für ein Mal erstellt werden. Wird
+            das Kopiermuster neu erstellt, wird ein Standard-
+            Kopiermuster zum Ändern angeboten. 
+#f2# 
+Verweise:   Abschnitt 4.4 
+            Benutzerhandbuch Abschnitt 11.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#T           Satzauswahl Tragen#off("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  EUDAS-Dateiname, mit Zeigen, eine Wahl 
+#f2# 
+Zweck:      Transportieren der ausgewählten bzw. markierten
+            Sätze in eine andere Datei gleicher Struktur. Die Sätze
+            werden in der Zieldatei am Ende eingefügt. 
+#f2# 
+Verweise:   Abschnitt 4.4 
+            Benutzerhandbuch Abschnitt 11.3 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#V           Satzauswahl Verändern#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Name Änderungsmuster, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Bearbeiten der ausgewählten bzw. markierten Sätze
+            der aktuellen Datei nach Vorgabe einer Änderungs­
+            vorschrift. 
+#f2# 
+Verweise:   Abschnitt 4.4 
+            Benutzerhandbuch Abschnitt 11.4 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#U           Übersicht Satzauswahl#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Anzeige aller ausgewählten Sätze in einem Über­
+            sichtsformat mit einem Satz pro Bildschirmzeile. Die
+            Felder, die in der Übersicht angezeigt werden sollen,
+            können vorher ausgewählt werden. In der Übersicht ist
+            Blättern und Markieren von Sätzen möglich. 
+#f2# 
+Verweise:   Abschnitt 4.1 
+            Benutzerhandbuch Abschnitt 10.5 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#S           Aktuelle Datei Sortieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Sortieren der aktuellen Datei in beliebiger Reihenfolge
+            auf- oder absteigend. Zum Sortieren muß eine Ar­
+            beitskopie angelegt sein. Die Feldreihenfolge, in der
+            sortiert werden soll, wird vorher erfragt. 
+#f2# 
+Verweise:   Abschnitt 4.3 
+            Benutzerhandbuch Abschnitt 11.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#L           Alle Markierungen Löschen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Löschen aller Markierungen der aktuellen Datei. 
+#f2# 
+Verweise:   Abschnitt 4.2 
+            Benutzerhandbuch Abschnitt 10.4 
+ 
+ 
+#abschnitt ("2.4", "MENÜ 'DRUCKEN'", "Menü 'Drucken'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#D           Satzauswahl Drucken#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Name Druckmuster, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Ausdruck des Inhalts der ausgewählten oder markier­
+            ten Sätze in druckbarer Form nach Vorgabe eines
+            Druckmusters. Die Ausgabe kann automatisch zum
+            Drucker geschickt werden oder erst in einer Datei
+            zwischengespeichert werden. 
+#f2# 
+Verweise:   Kapitel 5 
+            Benutzerhandbuch Abschnitt 7.1 und 7.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#R           Richtung Druckausgabe#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Mit dieser Funktion kann festgelegt werden, ob die
+            Druckausgabe automatisch zum Drucker geschickt wird,
+            in eine bestimmte Datei oder in eine automatisch
+            eingerichtete Datei geschrieben wird. 
+#f2# 
+            Die Angabe einer bestimmten Datei gilt nur für den
+            nächsten Druckvorgang. Sie muß also gegebenenfalls
+            wieder neu eingestellt werden. 
+#f2# 
+Verweise:   Abschnitt 5.2 
+            Benutzerhandbuch Abschnitt 7.2 und 12.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#E           Textdatei Editieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Name Textdatei, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Aufruf des EUMEL-Editors zum Erstellen und Ändern
+            von Druckmustern und Änderungsmustern sowie zum
+            Ansehen der Druckausgabe. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 7.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#A           Textdatei Ausdrucken#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Name Textdatei, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Mit dieser Funktion kann eine Textdatei oder die
+            zwischengespeicherte Ausgabe des Druckens einer
+            EUDAS-Datei zum Drucker geschickt werden. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 7.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#N           Textdatei Nachbearbeiten#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Name Textdatei, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Mit dieser Funktion kann die zwischengespeicherte
+            Ausgabe des Druckens einer EUDAS-Datei mit den
+            Textkosmetikprogrammen 'lineform' und 'pageform'
+            bearbeitet werden. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 12.1 
+ 
+ 
+#abschnitt ("2.5", "MENÜ 'DATEIEN'", "Menü 'Dateien'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#U          Übersicht Dateien System#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Übersicht über die Dateien im System in der aktuellen
+            Benutzertask. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#L           Datei Löschen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Löschen einer beliebigen Datei in der aktuellen Be­
+            nutzertask nach Anfrage. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#N           Datei Umbenennen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+            Neuer Name, ohne Zeigen 
+#f2# 
+Zweck:      Umbenennen einer beliebigen Datei in der aktuellen
+            Benutzertask. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#K           Datei Kopieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+            Zieldateiname, ohne Zeigen 
+#f2# 
+Zweck:      Anfertigen einer logischen Kopie einer beliebigen
+            Datei in der aktuellen Benutzertask. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#P           Platzbedarf einer Datei#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Zeigt den belegten Speicherplatz einer beliebigen
+            Datei in der aktuellen Benutzertask. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#A           Datei Aufräumen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Reorganisieren einer Textdatei oder einer EUDAS-
+            Datei, um Platz zu sparen oder den Zugriff zu be­
+            schleunigen. Empfiehlt sich bei stark veränderten
+            oder umsortierten Dateien. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.1 
+ 
+ 
+#abschnitt ("2.6", "MENÜ 'ARCHIV'", "Menü 'Archiv'")# 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#U           Übersicht Dateien Archiv#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Übersicht aller Dateien auf der eingelegten Archivdis­
+            kette. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#D           Archivübersicht Drucken#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Die Archivübersicht wird direkt zum Drucker ge­
+            schickt. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#K           Datei Kopieren vom Archiv#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Eine Datei auf der Archivdiskette wird in die aktuelle
+            Benutzertask kopiert. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#S           Datei Schreiben auf Archiv#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Archivname 
+            Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Eine Datei aus der aktuellen Benutzertask wird auf
+            die eingelegte Archivdiskette geschrieben. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#L           Datei Löschen auf Archiv#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Archivname 
+            Dateiname, mit Zeigen, mehrfache Wahl 
+#f2# 
+Zweck:      Löschen einer Datei auf der eingelegten Archivdisket­
+            te. Der Platz kann jedoch nicht immer wiederverwendet
+            werden. 
+#f2# 
+Verweis:    Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#I           Archivdiskette Initialisieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  keine 
+#f2# 
+Zweck:      Mit dieser Funktion kann eine Archivdiskette komplett
+            gelöscht werden. Die Diskette kann dabei auch gleich­
+            zeitig formatiert werden, falls der Rechner dies zu­
+            läßt. Das Initialisieren ist notwendig, bevor eine neue
+            Diskette als Archiv verwendet werden kann. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#Z           Zielarchiv einstellen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Managertaskname, ohne Zeigen 
+#f2# 
+Zweck:      Mit dieser Funktion kann eine Managertask angegeben
+            werden, die als Ziel der Archivoperationen dient.
+            Damit können Dateien auch in beliebigen Managertasks
+            oder über das EUMEL-Netz gesichert werden. 
+#f2# 
+            Es wird erfragt, ob die angegebene Task ein Archiv­
+            manager oder ein gewöhnlicher Dateimanager ist. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#P           Paßwort einstellen#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Paßwort 
+#f2# 
+Zweck:      Mit dieser Funktion kann ein Paßwort eingestellt
+            werden, das bei der Kommunikation mit allgemeinen
+            Managertasks überprüft wird. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+#linefeed (0.5)# 
+#on ("b")#R           Archivmanager Reservieren#off ("b")# 
+#linefeed (1.07)# 
+_____________________________________________________ 
+ 
+Parameter:  Reservierungstext 
+#f2# 
+Zweck:      Falls als Zielarchiv eine Managertask eingestellt ist,
+            die zwar kein Archivmanager ist, aber reserviert
+            werden muß (z.B. 'DOS'), kann die Reservierung mit
+            dieser Funktion ausgeführt werden. Die Freigabe
+            erfolgt automatisch beim Verlassen des Menüs. 
+#f2# 
+Verweise:   Benutzerhandbuch Abschnitt 16.2 
+ 
+ 
+ 
+#abschnitt ("2.7", "KURZABFRAGE", "Kurzabfrage")# 
+ 
+Wird 'eudas' innerhalb des EUMEL-Editors aufgerufen, so wird eine
+spezielle Kurzabfrage gestartet. Diese ermöglicht die Übernahme von
+Druckdaten direkt in die editierte Datei. 
+    Zunächst wird der Dateiname der zu verwendenden EUDAS-
+Datei erfragt. Diese Datei wird dann geöffnet. Vorher geöffnete und
+veränderte Dateien werden nach Anfrage gesichert. 
+    Als nächstes kann für die folgende Übersicht eine Feldauswahl
+eingestellt werden, damit die relevanten Felder auch auf dem Bild­
+schirm erscheinen. 
+    Danach beginnt ein wiederholbarer Prozeß mit der Eingabe
+eines Suchmusters nach Anfrage. Die ausgewählten Sätze werden
+dann in einer Übersicht gezeigt. In der Übersicht können auch Sätze
+markiert werden. 
+    Nach Verlassen der Übersicht bestehen drei Möglichkeiten zum
+Drucken: Falls mindestens ein Satz markiert wurde, können nach
+Anfrage alle markierten Sätze gedruckt werden. Wurde kein Satz
+markiert, können nach Anfrage alle ausgewählten (bzw. vorher
+angezeigten) Sätze gedruckt werden. Wird diese Frage jeweils ver­
+neint, kann nach Anfrage auch der aktuelle Satz als einziger ge­
+druckt werden. 
+    Wurde eine der Fragen bejaht, wird der Name des Druckmusters
+erfragt, das bereits existieren muß. Das Ergebnis der Druckausgabe
+wird dann an der aktuellen Cursorposition in der editierten Datei
+eingefügt. 
+    Der Prozeß kann danach mit einem anderen Suchmuster wieder­
+holt werden. Dabei werden alle Markierungen wieder gelöscht. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.3 b/app/eudas/4.4/doc/ref-manual/eudas.ref.3
new file mode 100644
index 0000000..77c3fc6
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.3
@@ -0,0 +1,256 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (31)# 
+#kapitel ("3", "Das", "virtuelle", "Dateimodell")# 
+ 
+ 
+ 
+#abschnitt ("3.1", "DATEISTRUKTUR", "Dateistruktur")# 
+ 
+Eine EUDAS-Datei hat folgende Bestandteile: 
+ 
+- 0 bis 5000 #on("i")#Sätze#off("i")#, von 1 an durchnumeriert. Jeder Satz enthält für
+  jedes Feld einen variabel langen Text als Inhalt, der standard­
+  mäßig leer ist. 
+ 
+- 1 bis 256 #on("i")#Felder#off("i")#, die die Sätze aufteilen. Jedes Feld besitzt einen
+  #on("i")#Feldnamen#off("i")# als Text und einen von vier #on("i")#Feldtypen#off("i")# (TEXT, ZAHL,
+  DATUM oder DIN). Der Feldname dient zur Identifizierung des
+  Feldes, der Feldtyp spezifiziert die Art der Behandlung beim Ver­
+  gleichen von Feldern. 
+ 
+- Drei Zusatztexte. Der erste nimmt die #on("i")#Prüfbedingungen#off("i")# auf, der
+  zweite speichert das Datum der letzten Veränderung und der
+  dritte kann allgemeine #on("i")#Notizen#off("i")# aufnehmen. 
+ 
+- Einen #on("i")#Satzzeiger#off("i")#, der einen bestimmten Satz als aktuellen Satz
+  auszeichnet. Der Satzzeiger kann durch Positionierungsoperatio­
+  nen verändert werden. 
+ 
+- Eine #on("i")#Sortierreihenfolge#off("i")#, die angibt, in welcher Feldreihenfolge die
+  Datei zuletzt sortiert worden ist. Dazu für jeden Satz eine Anga­
+  be, ob er entsprechend dieser Reihenfolge an der richtigen Posi­
+  tion steht. 
+ 
+- Eine interne Datenstruktur, die beschleunigten Zugriff auf eine
+  Satz nach dem Inhalt des ersten Feldes ermöglicht. Diese Struktur
+  steht ganz unter Kontrolle von EUDAS und kann nicht von außen
+  manipuliert werden. 
+ 
+ 
+#abschnitt ("3.2", "ÖFFNEN", "Öffnen")# 
+ 
+#a ("Virtuelle Datei")# Die meisten EUDAS-Funktionen arbeiten nicht
+direkt auf einer EUDAS-Datei, sondern auf der sogenannten #on("i")#vir­
+tuellen Datei#off("i")#, die aus mehreren realen Dateien bestehen kann. Die
+virtuelle Datei erscheint nach außen hin wie eine einzelne
+EUDAS-Datei. Die Operationen auf der virtuellen Datei werden je­
+weils auf die einzelnen Bestandteile abgebildet. 
+    Damit eine EUDAS-Datei Bestandteil der virtuellen Datei wird,
+muß sie geöffnet werden. Dieses Öffnen kann auf dreierlei Art und
+Weise geschehen. 
+    Das Öffnen der ersten Datei stellt eine neue virtuelle Datei
+her. Die Feldnamen und Feldeigenschaften der ersten Datei werden
+in der virtuellen Datei übernommen. Dies ist der Normalfall, in dem
+sich die virtuelle Datei noch nicht von der zugrundeliegenden Datei
+unterscheidet. 
+    Bei diesem ersten Öffnen muß angegeben werden, ob die vir­
+tuelle Datei verändert werden soll oder nicht. Falls die virtuelle
+Datei verändert werden soll, wird eine Arbeitskopie aller geöffneten
+Dateien angelegt. Die Ursprungsdateien können erst am Ende der
+Arbeit mit den geänderten Kopien überschrieben werden. 
+ 
+#a ("Weitere Dateien")# Weitere Dateien können gekettet oder gekoppelt
+werden. Gekettete Dateien werden logisch an die zuerst geöffnete
+Datei angehängt. Ihre Dateistruktur wird ignoriert, sollte aber mit
+der ersten Datei übereinstimmen. Die Folge aneinander geketteter
+EUDAS-Dateien wird als #on("i")#Hauptdatei#off("i")# bezeichnet. 
+    In der Hauptdatei werden die Sätze von 1 an durchnumeriert;
+die Aufeinanderfolge der Sätze wird durch die Anordnung der Sätze
+in den einzelnen Dateien und die Reihenfolge bestimmt, in der die
+Dateien gekettet wurden. 
+    Die gekoppelten Dateien werden der Hauptdatei untergeordnet.
+Die in ihnen enthaltenen Informationen werden nur angezeigt, wenn
+sie mit einem Satzinhalt der Hauptdatei korrespondieren. Der
+Mechanismus dieser Satzkopplung wird im nächsten Abschnitt
+beschrieben. 
+ 
+#beispiel# 
+#free (8.0)# 
+ 
+#center#Abb. 3-1   Schematischer Aufbau der virtuellen Datei 
+#text# 
+ 
+ 
+#abschnitt ("3.3", "KOPPELN", "Koppeln")# 
+ 
+    Die Sätze der gekoppelten Dateien werden in Relation zu den
+Sätzen in der Hauptdatei gesetzt. Zu jedem Satz in der Hauptdatei
+kann eine Anzahl von Sätzen aus jeder Koppeldatei gehören. Diese
+Sätze müssen in den Inhalten der sogenannten #on("i")#Koppelfelder#off("i")# über­
+einstimmen. 
+    Welche Felder Koppelfelder sind, richtet sich nach den Feld­
+namen. Die ersten Felder der Koppeldatei, die auch in der Haupt­
+datei vorhanden sind, werden als Koppelfelder betrachtet. Die Kop­
+pelfelder müssen also bei der Koppeldatei am Anfang stehen - in
+der Hauptdatei kann jedes beliebige Feld ein Koppelfeld sein. 
+    Wenn eine Datei zur virtuellen Datei gekoppelt wird, werden
+alle Felder, die nicht Koppelfelder sind, in die virtuelle Datei auf­
+genommen. Die Koppelfelder brauchen nicht noch mal wiederholt zu
+werden, da ihr Inhalt ja immer identisch ist. 
+    Zu beachten ist, daß bei diesem Verfahren auch Namenskonflik­
+te entstehen können, wenn nach den Koppelfeldern später wieder
+ein Feldname vorkommt, der auch in der Hauptdatei vorhanden ist.
+In den Fällen, in denen Felder durch ihren Namen angesprochen
+werden, ist dann das zweite Feld gleichen Namens nicht verfügbar. 
+ 
+#beispiel# 
+#free (7.0)# 
+ 
+#center#Abb. 3-2   Schema des Koppelvorgangs 
+#text# 
+ 
+#a ("Kombinationen")# Beim Vorwärtsgehen in der virtuellen Datei werden
+zu jedem Satz der Hauptdatei nacheinander alle möglichen Kombina­
+tionen der zugehörigen Koppelsätze angezeigt, denn es können
+mehrere passende Koppelsätze vorhanden sein. Die Satznummer
+bleibt dabei gleich; die einzelnen Kombinationen werden von 1 an
+durchgezählt. Beim Rückwärtsgehen wird aus technischen Gründen
+immer nur die erste Kombination angezeigt. 
+    Existiert zu einem Satz kein passender Koppelsatz, so bleiben
+die entsprechenden Felder leer. Die Koppelsätze müssen in der
+ganzen Koppeldatei gesucht werden, daher ist bei großen Koppel­
+dateien die Suchzeit zu berücksichtigen. 
+ 
+ 
+#abschnitt ("3.4", "ÄNDERUNGEN", "Änderungen")# 
+ 
+In der virtuellen Datei kann auch geändert werden. Dabei ist jedoch
+Vorsicht angebracht. Es muß festgelegt sein, wie Änderungen der
+einzelnen Felder auf die beteiligten Dateien abgebildet werden. 
+    Falls die virtuelle Datei keine Koppeldateien enthält, werden
+Änderungen am aktuellen Satz an der zugehörigen Datei durchge­
+führt. Das Löschen eines Satzes wird auch direkt in der Datei
+durchgeführt. Ein neuer Satz wird immer in der Datei eingefügt, zu
+der der aktuelle Satz gehört - am Ende der ersten Datei kann also
+kein Satz eingefügt werden, wenn noch weitere Dateien folgen. 
+    Enthält die virtuelle Datei Koppeldateien, werden die Änderun­
+gen in der Hauptdatei wie oben beschrieben durchgeführt. Änderun­
+gen, die Felder in den Koppeldateien betreffen, werden nach folgen­
+der Entscheidungstabelle behandelt: 
+ 
+                                   1  2  3  4  5 
+                                  --------------- 
+    Koppelfelder verändert         N  J  J  N  N 
+    Übrige Felder verändert        N  -  -  J  J 
+    Übrige Felder leer             -  J  N  -  N 
+    Vorher Koppelsatz vorhanden    -  -  -  J  N 
+                                  --------------- 
+    Neuen Satz einfügen                  x     x 
+    Koppelsatz ändern                       x 
+    Kopplung aktualisieren            x 
+ 
+Fall 1: Es wurden keine Veränderungen an den Feldern des Kop­
+        pelsatzes vorgenommen, daher ist auch keine Aktion not­
+        wendig. 
+ 
+Fall 2: Eines der Koppelfelder wurde verändert. Die Änderung wird
+        in der Hauptdatei durchgeführt. Die übrigen Felder des
+        Koppelsatzes sind jedoch als leer angegeben. In diesem Fall
+        wird der Koppelsatz nicht verändert, sondern nur eine
+        neue Korrespondenz gesucht. 
+ 
+Fall 3: Eines der Koppelfelder wurde verändert, gleichzeitig ent­
+        halten aber auch die anderen Felder Informationen. In
+        diesem Fall wird ein neuer Satz in der Koppeldatei ange­
+        fügt, der die neuen Inhalte enthält. So wird vermieden,
+        daß an anderer Stelle plötzlich kein passender Koppelsatz
+        mehr vorhanden ist. 
+ 
+Fall 4: Nur Felder der Koppeldatei, die nicht Koppelfelder sind,
+        wurden verändert, außerdem existierte ein korrespondie­
+        render Satz in der Koppeldatei. In diesem Fall werden die
+        Informationen im Koppelsatz abgeändert. 
+ 
+Fall 5: Wie 4, nur war vorher noch kein Koppelsatz vorhanden
+        (Felder waren leer). In diesem Fall muß ein neuer Satz in
+        die Koppeldatei eingefügt werden. Einfügungen in die
+        Koppeldatei geschehen immer am Dateiende. 
+ 
+#a ("Einfügen/Löschen")# Beim Löschen eines Satzes der virtuellen Datei
+durch Tragen bleiben die Koppeldateien unverändert. Nach dem
+Einfügen eines neuen Satzes wird nur dann ein Satz in einer Kop­
+peldatei eingefügt, wenn dieser Satz nicht nur Koppelfelder enthal­
+ten würde. Falls beim Einfügen nur die Koppelfelder angegeben
+werden, wird ein korrespondierender Satz in der Koppeldatei ge­
+sucht. Vergleichen Sie hierzu die Regeln beim Ändern. 
+ 
+ 
+#abschnitt ("3.5", "SICHERN", "Sichern")# 
+ 
+Falls Änderungen der virtuellen Datei erlaubt sind, arbeitet EUDAS
+immer auf Sicherheitskopien der beteiligten Dateien. Eine Datei, die
+wirklich verändert wurde, muß vor dem Aufbau einer neuen virtuel­
+len Datei gesichert oder explizit gelöscht werden. 
+    Für jede einzelne Datei kann festgelegt werden, ob sie gesi­
+chert werden soll oder nicht. Als Hilfe wird dazu für jede Datei
+angegeben, ob sie tatsächlich verändert wurde oder nicht. Die
+Arbeitskopie kann beim Sichern die alte Version überschreiben oder
+unter einem neuen Namen gesichert werden. 
+    Am Ende des Sicherns können die Arbeitskopien gelöscht wer­
+den. Anderenfalls werden die Dateien so betrachtet, als ob sie di­
+rekt nach dem Sichern wieder geöffnet worden wären und stehen
+weiterhin zur Verfügung. 
+    Falls alle Dateien entweder gesichert oder nicht verändert
+sind, werden beim nächsten Öffnen einer neuen virtuellen Datei die
+vorherigen Arbeitskopien gelöscht. 
+ 
+ 
+#abschnitt ("3.6", "UMSCHALTEN AUF KOPPELDATEI", "Umschalten auf Koppeldatei")# 
+ 
+Falls eine Datei gekoppelt ist, kann man die virtuelle Datei auf
+diese Koppeldatei umschalten. Dadurch verhält sich die virtuelle
+Datei so, als ob nur diese Koppeldatei geöffnet wäre. Die Einstel­
+lungen der Hauptdatei wie Markierungen und Suchbedingung bleiben
+jedoch erhalten und stehen beim Zurückschalten wieder zur Verfü­
+gung. 
+    Die Satzposition der Koppeldatei beim letzten Umschalten wird
+ebenfalls gespeichert und wird beim nächsten Umschalten wieder
+eingenommen, unabhängig von der tatsächlichen Satzposition der
+Koppeldatei zu diesem Zeitpunkt. 
+    Für die Koppeldatei können eigene Markierungen vergeben
+werden, die auch nach dem Umschalten gespeichert bleiben. Auch
+ein Suchmuster kann für die Koppeldatei eingestellt werden, dies
+geht jedoch beim Zurückschalten wieder verloren. Die eingestellte
+Feldauswahl für die Bildschirmanzeige geht leider bei jedem Um­
+schalten verloren. 
+    Das Umschalten kann entweder im Menü 'Einzelsatz' oder beim
+Einfügen und Ändern durch ESC 'K' bewirkt werden, ebenso das
+Zurückschalten nur im Menü 'Einzelsatz'. Beim Umschalten aus Ein­
+fügen oder Ändern erfolgt beim Zurückschalten eine Rückkehr in
+diesen Zustand. Dabei können nach Anfrage die Koppelfelder des
+aktuellen Satzes der Koppeldatei in die Hauptdatei übernommen und
+damit eine bestimmte Kopplung bewirkt werden. 
+ 
+ 
+#abschnitt ("3.7", "MEHRBENUTZERBETRIEB", "Mehrbenutzerbetrieb")# 
+ 
+Durch Einstellen einer Managertask für den Mehrbenutzerbetrieb
+können auch Dateien dieser Managertask beim Öffnen direkt ver­
+wendet werden. Die Datei wird automatisch aus der Managertask
+kopiert und geöffnet. 
+    Falls die Datei geändert werden soll, wird eine Sperre in der
+Managertask gesetzt, die verhindert, daß auch ein anderer Benutzer
+diese Datei zum Ändern öffnet. Beim Sichern erfolgt dann ein Rück­
+schreiben der Arbeitskopie. Die Sperre wird jedoch erst dann zu­
+rückgesetzt, wenn alle Arbeitskopien gelöscht werden, da erst dann
+keine Möglichkeit des Rückschreibens mehr besteht. 
+    Alle Dateien der Managertask werden bei der Dateiauswahl zum
+Öffnen mit angeboten. Falls eine Datei in beiden Tasks existiert,
+wird die Datei in der Managertask genommen, die Datei der eigenen
+Task jedoch erst nach Anfrage überschrieben. 
+    Damit die Sperre funktionieren kann, muß EUDAS in der Mana­
+gertask zur Verfügung stehen und die Task muß #on("i")#nach#off("i")# dem Insertie­
+ren von EUDAS als 'global manager' definiert werden (nicht 'free
+global manager' verwenden). 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.4 b/app/eudas/4.4/doc/ref-manual/eudas.ref.4
new file mode 100644
index 0000000..92ec931
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.4
@@ -0,0 +1,421 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (39)# 
+#kapitel ("4", "Ansehen", "und", "Bearbeiten")# 
+ 
+ 
+ 
+#abschnitt ("4.1", "ANZEIGE", "Anzeige")# 
+ 
+Die Anzeige und Eingabe von Einzelsätzen sowie die Eingabe von
+Suchmustern geschieht in einem Standardformular in einem recht­
+eckigen Fenster. Dieses Fenster befindet sich in der rechten Bild­
+schirmhälfte. 
+    Das Formular besteht aus vier Teilen: der Überschrift, den
+Feldnamen, den Feldinhalten und der Abschlußzeile (s. Abbildung). 
+ 
+#bildschirm# 
+                          Überschrift 
+#free (0.3)# 
+      Satz 33       ..SUCH+..MARK-... datei ............... Feld 1 
+      Feld 1      
+      Feld 2 
+      Feld 3              Feldinhalte 
+      
+      Feld 4 
+      .............................................................. 
+#free (0.3)# 
+  Feldnamen                    Abschlußzeile 
+ 
+#text# 
+ 
+#a ("Überschrift")# Die Überschrift zeigt folgende Informationen an: 
+ 
+    #bsp ("Satz n[-m]")# 
+    Die Satznummer des aktuellen Satzes, bei gekoppelten Dateien
+    auch die Satzkombination. 
+ 
+    #bsp ("SUCH+/-")# 
+    Zeigt an, ob der aktuelle Satz die eingestellte Suchbedingung
+    erfüllt oder nicht (wird während Eintragungen nicht angezeigt).
+    Wenn keine Suchbedingung eingestellt ist, erscheint diese An­
+    zeige nicht. 
+ 
+    #bsp ("MARK+/-")# 
+    Zeigt an, ob der aktuelle Satz markiert ist oder nicht (Wird
+    während Eintragungen nicht angezeigt). Wenn kein Satz mar­
+    kiert ist, erscheint diese Anzeige nicht. 
+ 
+    #bsp ("ENDE")# 
+    Wird hinter dem letzten Satz der Datei als Kennzeichnung des
+    Endesatzes ausgegeben. 
+ 
+    #bsp ("'Dateiname'")# 
+    Gibt den Namen der ersten geöffneten Datei an. 
+ 
+    #bsp ("<KOPPPEL>")# 
+    Erscheint statt des Dateinamens, wenn auf eine Koppeldatei
+    umgeschaltet wurde. 
+ 
+    #bsp ("Feld n/Zeile n")# 
+    Zeilennummer des obersten angezeigten Feldes (bei Anzeige)
+    bzw. der aktuellen Cursorzeile (während Eintragungen). 
+ 
+#a ("Feldteil")# Die Feldnamen sind zur Unterscheidung von den Feld­
+inhalten invers dargestellt. Die Breite der Feldnamen richtet sich
+nach der Länge des längsten Feldnamens. Ist dieser zu lang, um
+noch eine ordentliche Anzeige zu ermöglichen, wird bei einer be­
+stimmten Länge der Rest des Namens abgeschnitten. 
+    Zwischen dem Feldnamen an der linken Seite und dem dane­
+benstehenden Feldinhalt besteht immer eine Korrespondenz, d.h. der
+Inhalt eines Feldes wird direkt neben dem Namen dargestellt. In der
+Regel wird pro Feld eine Bildschirmzeile reserviert. Kann der Feld­
+inhalt jedoch nicht mehr in einer Zeile untergebracht werden, wer­
+den weitere Zeilen zur Darstellung dieses Feldes herangezogen. In
+diesen Zeilen steht statt des Feldnamens nur ein markierter Leer­
+raum. 
+    Alle folgenden Zeilen ohne Namen gehören zu dem gleichen
+Feld. Der Inhalt wird auf diese Zeilen umbrochen, d.h. wenn ein
+Wort nicht mehr auf die Zeile paßt, wird es komplett in die nächste
+Zeile geschrieben (wie beim Editor). Wörter werden nur dann zer­
+schnitten, wenn sie nicht als Ganzes auf eine Zeile passen. Wörter
+werden untereinander durch Leerzeichen getrennt. 
+    Aus Effizienzgründen werden in bestimmten Fällen auch mehr
+Folgezeilen als nötig angezeigt. Hat nämlich ein neuer Satz einen
+kürzeren Inhalt als der vorige, so werden die Feldnamen nur dann
+wieder zusammengerückt, wenn das ganze Bild neugeschrieben wer­
+den muß. Anderenfalls werden nur die Feldinhalte aktualisiert. 
+    Die Bildausgabe wird unterbrochen, wenn 'w' oder 'z' gedrückt
+wurde, da dann die Inhalte des aktuellen Satzes nicht mehr inter­
+essieren. 
+ 
+#a ("Rollen")# Da nicht alle Felder auf den Bildschirm passen müssen,
+kann das Bild gerollt werden. 
+    Mit ESC UNTEN wird um eine Seite nach unten geblättert, mit
+ESC OBEN wieder zurück. Hinter dem letzten Feld erscheint ein
+markierter Balken als Abschlußzeile. Weiter als bis zum Erscheinen
+dieses Balken kann nicht gerollt werden. Mit ESC '1' wird ganz an
+den Anfang gerollt, mit ESC '9' ganz ans Ende. 
+    Bei Feldern, die sich über mehrere Zeilen erstrecken, kann es
+passieren, daß nach dem Rollen die erste Bildschirmzeile nicht die
+erste Zeile eines Feldes ist, also der erste Teil eines Feldes nicht
+dargestellt wird. Trotzdem wird in diesem Fall in der ersten Anzei­
+gezeile der Feldname angezeigt. 
+ 
+#a ("Feldauswahl")# Man kann auswählen, welche Felder in welcher Rei­
+henfolge angezeigt werden sollen. Dies dient der besseren Übersicht.
+Von der Anzeige werden nur die ausgewählten Felder behandelt, die
+anderen Felder bleiben leer, werden nicht verändert oder berück­
+sichtigt. Die Anzeigeauswahl ändert jedoch nichts an der Datei­
+struktur. 
+    Die Feldauswahl ist keine permanente Eigenschaft einer
+EUDAS-Datei. Sie geht daher bei einem neuen Öffnen oder beim
+Umschalten auf eine Koppeldatei verloren. 
+ 
+#a ("Übersicht")# Im Gegensatz zur normalen Anzeige, bei der ein Satz pro
+Bildschirm dargestellt wird, können in der Übersicht mehrere Sätze
+gleichzeitig überschaut werden. Dabei wird jeder Satz in einer Zeile
+untergebracht. Die Auswahl der Felder, die in der Übersicht er­
+scheinen sollen, wird vor Beginn der Funktion erfragt. 
+    In jeder Zeile steht die Nummer des jeweiligen Satzes, eine
+Anzeige, ob er markiert ist (+) oder nicht (-) und die Feldinhalte
+in der gewählten Reihenfolge und Auswahl, jeweils duch Komma und
+Leerzeichen getrennt. Inhalte, die nicht mehr auf die Zeile passen,
+werden abgeschnitten. 
+    Es werden nur durch das Suchmuster ausgewählte Sätze ange­
+zeigt. Ist der aktuelle Satz nicht ausgewählt, so erscheint an seiner
+Stelle #bsp("'<< >>'")# als Hinweis. In der Überschrift sind die Feldnamen
+angegeben - durch Komma getrennt, so viele wie hinpassen. 
+    Die Satznummer des aktuellen Satzes ist jeweils markiert. In
+der Übersicht kann geblättert werden. HOP OBEN und HOP UNTEN,
+OBEN und UNTEN wirken wie im Editor. 
+    Durch '+' oder '-' kann auch die Markierung des aktuellen
+Satzes verändert werden. 
+ 
+ 
+#abschnitt ("4.2", "SATZAUSWAHL", "Satzauswahl")# 
+ 
+Die Auswahl der Sätze, die gedruckt oder mit den Funktionen aus
+Abschnitt 4.4 bearbeitet werden sollen, kann entweder durch eine
+Suchbedingung oder durch Markierung vorgenommen werden. Wenn
+mindestens ein Satz markiert ist, werden von den Bearbeitungs­
+funktionen nur die markierten Sätze behandelt. Anderenfalls wird
+die eingestellte Suchbedingung beachtet. 
+    Die Bildschirmanzeige richtet sich immer nur nach der einge­
+stellten Suchbedingung. 
+ 
+#a ("Suchmuster")# Ein Suchmuster gibt für jedes Feld bestimmte Bedin­
+gungen an. Es wird im Standardformular mit Hilfe des Satzeditors
+eingegeben. Dabei stehen neben jedem Feld die Bedingungen für
+dieses Feld in einer intuitiv verständlichen Form. Folgende Einzel­
+bedingungen sind möglich: 
+ 
+    #bsp("Muster")#            Inhalt ist gleich Muster 
+    #bsp("Muster..")#          Inhalt ist größergleich Muster 
+    #bsp("..Muster")#          Inhalt ist kleiner Muster 
+    #bsp("Muster1..Muster2")#  Inhalt liegt dazwischen 
+    #bsp("*Muster")#           Inhalt endet mit Muster 
+    #bsp("Muster*")#           Inhalt beginnt mit Muster 
+    #bsp("*Muster*")#          Inhalt enthält Muster 
+    #bsp("*")#                 Inhalt ist nicht leer 
+    #bsp("++")#                Satz markiert (unabhängig vom Feldinhalt) 
+ 
+Die ersten vier Einzelbedingungen beachten auch den Typ eines
+Feldes (wie er bei der Feldstruktur eingegeben werden kann und
+beim Sortieren beachtet wird). So werden z.B. bei der Gleichheit von
+Zahlen alle nicht-numerischen Zeichen ignoriert (s. Sortieren). 
+    Die drei Bedingungen mit Stern können auch miteinander ver­
+knüpft werden. Die Einzelbedingungen müssen dann alle zutreffen,
+damit der Satz ausgewählt wird. So bedeutet zum Beispiel das
+Muster #bsp ("'M1*M2*M3*M4'")#, daß das Feld mit 'M1' beginnen und mit 'M4'
+enden muß. Außerdem muß es 'M2' und 'M3' enthalten, jedoch nicht
+unbedingt in der angegebenen Reihenfolge. 
+    Wird der Mustertext durch '&' und einen gültigen Feldnamen der
+aktuellen Datei ersetzt, findet der Vergleich nicht mit einem
+Mustertext, sondern mit dem Inhalt des angegebenen Feldes statt.
+Als Feldtyp für den Vergleich wird in diesem Fall der Typ des Fel­
+des genommen, in dem der Vergleich steht. 
+ 
+#a ("Verknüpfung")# Einzelbedingungen können durch Voranstellen von
+'--' verneint werden. Einzelbedingungen für verschiedene Felder
+werden mit UND verknüpft. 
+    Es gibt zwei Arten der ODER-Verknüpfung: die lokale und die
+globale. Die lokale ODER-Verknüpfung wird durch ein Komma zwi­
+schen Einzelbedingungen realisiert. Sie hat eine höhere Priorität als
+das UND zwischen verschiedenen Feldern. So hat folgendes Such­
+muster 
+ 
+#beispiel# 
+    Feld1   Bed1,Bed2 
+    Feld2   Bed3 
+#text# 
+ 
+die Bedeutung 
+ 
+#beispiel# 
+    ( Bed1 (Feld1) ODER Bed2 (Feld2) ) UND Bed3 (Feld3) 
+#text# 
+ 
+Die globale ODER-Verknüpfung wird durch ein Semikolon repräsen­
+tiert. Alle Einzelbedingungen nach dem n-ten Semikolon aller Zeilen
+werden zu einer Alternative zusammengefaßt. Damit hat das Such­
+muster 
+ 
+#beispiel# 
+    Feld1   Bed1;Bed2 
+    Feld2   Bed3 
+#text# 
+ 
+die Bedeutung 
+ 
+#beispiel# 
+    ( Bed1 (Feld1) UND Bed3 (Feld2) ) ODER Bed2 (Feld1) 
+#text# 
+ 
+Damit ergibt sich für die Priorität der einzelnen Konstruktionen
+folgende Reihenfolge: 
+ 
+    höchste        Einzelbedingung 
+                   Verkettung von Einzelbedingungen (UND) 
+                   Verneinung 
+                   lokales ODER 
+                   UND zwischen Feldern 
+    niedrigste     globales ODER 
+ 
+#a ("Optimierung")# Wenn für das erste Feld einer Datei eine Gleich-
+Bedingung angegeben wurde und keine globale Alternative vorhan­
+den ist, kann der Suchvorgang wegen der Dateistruktur optimiert
+werden, indem nur Sätze untersucht werden müssen, die im ersten
+Feld den gesuchten Text enthalten. 
+ 
+#a ("Reservierte Zeichen")# Im Rahmen der Analyse einer Musterzeile
+wirken folgende Zeichenfolgen als unbeschränkt reservierte Zeichen: 
+ 
+#beispiel# 
+        ,    ;    ..    * 
+#text# 
+ 
+Sie dürfen daher in keinem Mustertext oder Feldnamen vorkommen,
+da sie als Separator wirken. Die beiden folgenden Zeichenfolgen
+werden nur zu Anfang eines durch die vorstehenden Separatoren
+gebildeten Abschnitts erkannt: 
+ 
+#beispiel# 
+        --    &    ++ 
+#text# 
+ 
+Sie dürfen daher prinzipiell an weiterer Stelle vorkommen, ohne als
+Sonderzeichen erkannt zu werden. Alle anderen Zeichen in der Zeile
+werden dem Mustertext bzw. Feldnamen ohne weitere Interpretation
+zugeordnet. 
+ 
+ 
+#abschnitt ("4.3", "SORTIEREN UND REORGANISIEREN", "Sortieren und Reorganisieren")# 
+ 
+Eine EUDAS-Datei kann in einer beliebigen Feldreihenfolge sortiert
+werden. Mit dieser Angabe kann man bestimmen, welche Felder beim
+Vergleich zweier Sätze berücksichtigt werden sollen und in welcher
+Reihenfolge. 
+    Die Sortierreihenfolge wird in der Datei gespeichert und wird
+anschließend immer wieder verwendet, wenn keine anderen Angaben
+gemacht wurden. 
+    Der Sortierzustand einer Datei wird ebenfalls gespeichert. Wenn
+nur wenige Sätze seit der letzten Sortierung verändert wurden,
+müssen auch nur diese Sätze einsortiert werden. 
+ 
+#a ("Feldtypen")# Um eine korrekte Sortierung auch von Zahlen oder
+Daten sicherzustellen, wird jedem Feld einer EUDAS-Datei ein Feld­
+typ zugeordnet, der beim Sortieren (und auch beim Suchen) berück­
+sichtigt wird. 
+    Es gibt folgende Feldtypen (als Standard wird der Typ TEXT
+verwendet): 
+ 
+  TEXT   Vergleich von Texten nach dem EUMEL-Code der einzel­
+         nen Zeichen. Dies ist Standard und sorgt für schnellst­
+         möglichen Vergleich. Die weiteren Typen brauchen erheb­
+         lich mehr Zeit. 
+ 
+  DIN    Vergleich nach DIN 5007 (s. EUMEL-Benutzerhandbuch).
+         Umlaute werden korrekt eingeordnet, Groß- und Klein­
+         buchstaben werden gleichbehandelt, Sonderzeichen werden
+         ignoriert. 
+ 
+  ZAHL   Der Wert einer Zahl wird verglichen. Außer den Ziffern,
+         dem Dezimalkomma und dem Minuszeichen vor der ersten
+         Ziffer werden alle anderen Zeichen ignoriert. Das Dezi­
+         malkomma ist standardmäßig auf ',' eingestellt, kann aber
+         verändert werden (s. Abschnitt 6.5). Die nicht ignorierten
+         Zeichen werden in eine REAL-Zahl umgewandelt und dann
+         verglichen. 
+ 
+  DATUM  Es werden Daten der Form 'tt.mm.jj' verglichen. In diesem
+         Fall werden Tag und Jahr vertauscht und dann vergli­
+         chen. Texte mit einer anderen Länge als 8 werden alle
+         als gleich betrachtet. 
+ 
+#a ("Reorganisieren")# Wenn viele Änderungen an einer EUDAS-Datei
+vorgenommen worden sind, steigt ihr Platzbedarf durch viele Text­
+leichen an. In diesem Fall empfiehlt es sich, die Datei zu reorgani­
+sieren. Auch wenn beim Sortieren viele Sätze vertauscht wurden,
+sollte die Datei reorganisiert werden, da beim Sortieren die physi­
+kalische Reihenfolge der Sätze nicht verändert wird. In diesem Fall
+ergibt sich nach dem Reorganisieren ein Geschwindigkeitsvorteil. 
+ 
+ 
+#abschnitt ("4.4", "BEARBEITEN", "Bearbeiten")# 
+ 
+#a ("Kopieren")# Durch Kopieren kann ein Ausschnitt aus der virtuellen
+Datei in eine andere EUDAS-Datei kopiert werden. Es werden alle
+ausgewählten Sätze kopiert. Wenn mindestens ein Satz markiert ist,
+werden alle markierten Sätze als ausgewählt betrachtet, ansonsten
+alle, die durch die Suchbedingung angegeben sind. Die kopierten
+Sätze werden am Ende der Zieldatei angefügt. 
+    Welche Felder kopiert werden sollen, wird durch das Kopier­
+muster angegeben. Hierbei können auch mehrere Felder zu einem
+verschmolzen werden. Allgemein ergeben sich die Felder der Ziel­
+datei aus einem beliebigen ELAN-Ausdruck. 
+    Das Kopiermuster ist ein ELAN-Programm und enthält im we­
+sentlichen Ausdrücke der Form 
+ 
+#beispiel# 
+        "Feldname" K Ausdruck ; 
+#text# 
+ 
+Durch diese Anweisung wird der Ausdruck in das Feld der Zieldatei
+mit dem angegebenen Namen kopiert. Existiert dieses Feld in der
+Zieldatei noch nicht, so wird es als letztes angefügt. Falls die
+Zieldatei noch nicht existiert, wird sie eingerichtet. In diesem Fall
+bestimmt also die Reihenfolge der 'K'-Ausdrücke die Reihenfolge der
+Feldnamen in der Zieldatei. 
+    Da die Reihenfolge der 'K'-Ausdrücke wichtig ist, dürfen diese
+nicht in einer IF-Anweisung stehen, sondern müssen für jeden Satz
+komplett in der gleichen Reihenfolge ausgeführt werden. 
+ 
+#a ("Standard-Kopiermuster")# Vor dem Kopieren wird ein Standard-
+Kopiermuster zum Editieren angeboten, das sich nach der Zieldatei
+richtet. Existiert die Zieldatei noch nicht, wird das Muster so kon­
+struiert, daß alle Felder der virtuellen Datei unverändert kopiert
+werden. Wollen Sie einige Felder nicht kopieren, brauchen Sie nur
+die entsprechenden Zeilen zu löschen; wollen Sie die Felder in eine
+andere Reihenfolge bringen, müssen Sie die Zeilen umordnen. 
+    Existiert die Zieldatei bereits, gibt das Standard-Kopiermuster
+an, daß alle Felder der Zieldatei einen Wert erhalten. Ist ein Feld
+der Zieldatei in der virtuellen Datei enthalten, so wird dieses ko­
+piert, ansonsten erhält das Feld einen leeren Inhalt. Sie können in
+diesem Fall weitere Felder angeben oder für die leeren Felder Aus­
+drücke formulieren. 
+ 
+#a ("Tragen")# Durch Tragen werden alle ausgewählten Sätze der virtuel­
+len Datei in eine andere Datei transportiert. Sie sind in der vir­
+tuellen Datei dann nicht mehr vorhanden. Damit bei diesem Vorgang
+keine Informationen verlorengehen können, muß die Zieldatei so
+viele Felder haben wie die virtuelle Datei. Normalerweise sollte sie
+in der Feldstruktur mit der virtuellen Datei übereinstimmen. 
+    Die getragenen Sätze werden jeweils am Ende der Datei ange­
+fügt. 
+    Beim Tragen können zusätzlich noch Konsistenzbedingungen
+überprüft werden. Die Prüfbedingungen sind in der Zieldatei gespei­
+chert und können beim Ändern der Feldstruktur angegeben werden. 
+    Die Prüfbedingung ist ein ELAN-Programm, das vor dem Tragen
+des jeweiligen Satzes ausgeführt wird. Durch spezielle Testprozedu­
+ren kann das Tragen des Satzes verhindert werden, wenn diese
+Prozeduren ein negatives Ergebnis liefern. Gleichzeitig wird eine
+Meldung in eine Protokolldatei geschrieben, die dann zur Identifi­
+zierung der fehlerhaften Sätze dienen kann. 
+    Folgende Prüfprozeduren stehen zur Verfügung (siehe auch
+Abschnitt 8.3): 
+ 
+#beispiel# 
+    pruefe ("Feldname", Bedingung) 
+#text# 
+        Hiermit kann eine beliebige Bedingung (BOOL-Ausdruck in
+        ELAN) überprüft werden. 
+ 
+#beispiel# 
+    wertemenge ("Feldname", "Wert1,Wert2,...,Wertn") 
+#text# 
+        Das Feld muß einen in der angegebenen Liste enthaltenen
+        Werte annehmen. 
+ 
+#beispiel# 
+    feldmaske ("Feldname", "Maske") 
+#text# 
+        Das Feld wird auf Übereinstimmung mit der Maske geprüft.
+        Fünf spezielle Zeichen in der Maske können dabei auf
+        mehrere Zeichen zutreffen: 
+          '9'  alle Ziffern 
+          'a'  alle Kleinbuchstaben, Umlaute, 'ß' 
+          'A'  alle Großbuchstaben, Umlaute 
+          'X'  alle Zeichen 
+          '*'  Folge von beliebigen Zeichen 
+        Der Stern sollte sparsam angewendet werden, da er verar­
+        beitungsaufwendig ist. 
+ 
+#beispiel# 
+    eindeutige felder (n) 
+#text# 
+        Die Zahl 'n' gibt an, die wieviel ersten Felder der Zieldatei
+        eindeutig sein müssen. Stimmt der zu tragende Satz mit
+        einem Satz der Zieldatei in diesen Feldern überein, wird
+        eine Fehlermeldung erzeugt. 
+ 
+Es können auch einzelne Sätze manuell getragen werden. In diesem
+Fall wird die Prüfbedingung nicht getestet. Ebenso kann der Satz
+wieder zurückgeholt und in der aktuellen Datei eingefügt werden. 
+ 
+#a ("Nach Vorschrift ändern")# Die ausgewählten Sätze der virtuellen
+Datei können automatisch nach einer Verarbeitungsvorchrift geän­
+dert werden. Die Verarbeitungsvorschrift ist ein ELAN-Programm, in
+dem mit Hilfe des Operators 'V' Änderungen angegeben werden: 
+ 
+#beispiel# 
+        "Feldname" V TEXT-Ausdruck ; 
+#text# 
+ 
+Das angegebene Feld erhält den Inhalt, der durch den Ausdruck
+angegeben ist. Änderungen an Koppeldateien werden wie im Dialog
+behandelt (s. Abschnitt 3.4). 
+ 
+ 
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.5 b/app/eudas/4.4/doc/ref-manual/eudas.ref.5
new file mode 100644
index 0000000..02127a6
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.5
@@ -0,0 +1,415 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (49)# 
+#kapitel ("5", "Drucken", "und", "Druckmuster")# 
+ 
+ 
+ 
+#abschnitt ("5.1", "DRUCKMUSTERSYNTAX", "Druckmustersyntax")# 
+ 
+Ein Druckmuster ist eine Beschreibung für die Form, in der die In­
+halte einer EUDAS-Datei ausgedruckt werden sollen. Der syntakti­
+sche Aufbau des Druckmusters ist zeilenorientiert und gehorcht
+folgender Syntax: 
+ 
+    Druckmuster : 
+      [ Initialisierungsteil ] 
+      [ Vorspann ] 
+      [ Wiederholungsteil ] 
+      [ Nachspann ] 
+ 
+    Initialisierungsteil : 
+      ( Kommandozeile #char (""124"")# Textzeile )#bsp ("*")# 
+      ( GRUPPE-Anweisung #char(""124"")# Textzeile )#bsp ("*")# 
+ 
+    Vorspann : 
+      VORSPANN-Anweisung  Abschnitt 
+ 
+    Wiederholungsteil : 
+      WIEDERHOLUNG-Anweisung  Abschnitt 
+ 
+    Nachspann : 
+      NACHSPANN-Anweisung  Abschnitt 
+ 
+    Abschnitt : 
+      Musterteil 
+      [ ABKUERZUNGEN-Anweisung  Abkürzungsteil ] 
+ 
+    Musterteil : 
+      ( Musterzeile #char(""124"")# Kommandozeile #char(""124"")# 
+        MODUS-Anweisung #char (""124"")# MEHR-Anweisung )#bsp ("*")# 
+ 
+Zur Notation: [] bedeutet optional, ()#bsp("*")# beliebig häufige Wiederho­
+lung, #char(""124"")# Alternative und keine Angabe einfache Aneinanderreihung.
+Die verschiedenen Zeilentypen werden weiter unten beschrieben. 
+    Zusätzlich gilt die Bedingung, daß von Vorspann, Wiederho­
+lungsteil und Nachspann mindestens einer vorhanden sein muß. 
+ 
+#a ("Zeilentypen")# Im Druckmuster gibt es 6 verschiedene Zeilentypen: 
+ 
+#on("i")#Kommandozeilen#off("i")# 
+    Eine Kommandozeile beginnt mit '%%' in der ersten und zweiten
+    Spalte. Der Inhalt der Zeile ab Spalte 3 wird dem ELAN-Compi­
+    ler übergeben. Die Bedeutung dieser Zeilen ergibt sich aus dem
+    in 5.4 beschriebenen Übersetzungsmechanismus. 
+ 
+#on("i")#Anweisungen#off("i")# 
+    Anweisungen beginnen mit '%' in der ersten Spalte und dienen
+    zur Steuerung des Druckgenerators. Der Name der Anweisung
+    muß in Großbuchstaben und ohne Leerzeichen geschrieben
+    werden. Davor dürfen sich noch Leerzeichen befinden. An­
+    schließend können noch Parameter folgen, die nur durch Leer­
+    zeichen getrennt aneinander gereiht werden. Die Syntax einer
+    Anweisung ähnelt der eines Operators in ELAN. 
+ 
+#on("i")#Textzeilen#off("i")# 
+    Textzeilen sind die nicht anderweitig markierten Zeilen im
+    Initialisierungsteil. Sie werden unverändert an den Anfang
+    jeder Druckdatei gestellt. 
+ 
+#on("i")#Musterzeilen#off("i")# 
+    Musterzeilen sind nicht besonders gekennzeichnete Zeilen im
+    Musterteil. Sie enthalten Feldmuster und werden nach dem
+    Einsetzen von Inhalten in die Ausgabedatei übernommen. Die
+    Interpretation der Musterzeilen wird in Abschnitt 5.3 beschrie­
+    ben. 
+ 
+#on("i")#Abkürzungszeilen#off("i")# 
+    Abkürzungszeilen markieren den Beginn einer Abkürzung im
+    Abkürzungsteil eines Abschnittes. Sie werden durch '&' in der
+    ersten Spalte gekennzeichnet. Darauf folgt ohne Zwischenraum
+    der Name einer Abkürzung (ohne Leerzeichen) und danach
+    durch Leerzeichen getrennt ein Semikolon. Der Name der Ab­
+    kürzung wird bei der Übersetzung durch einen Refinementnamen
+    ersetzt und die Zeile dem ELAN-Compiler übergeben. Der Rest
+    der Zeile kann also den Beginn eines werteliefernden Refine­
+    ments enthalten. 
+ 
+#on("i")#Programmzeilen#off("i")# 
+    Programmzeilen sind die nicht durch '&' markierten Zeilen im
+    Abkürzungsteil. Sie werden unverändert an den ELAN-Compiler
+    übergeben. Der erlaubte Inhalt richtet sich nach dem Überset­
+    zungsmechanismus (5.4). 
+ 
+ 
+#abschnitt ("5.2", "DER DRUCKVORGANG", "Der Druckvorgang")# 
+ 
+Der Druckvorgang besteht im wesentlichen darin, daß für alle zu
+bearbeitenden Sätze der Wiederholungsteil einmal interpretiert wird
+und das Ergebnis in eine Ausgabedatei geschrieben wird, die dann
+gedruckt werden kann. Wenn mindestens ein Satz markiert ist, wer­
+den alle markierten Sätze der virtuellen Datei bearbeitet, ansonsten
+alle durch die Suchbedingung erfaßten. 
+ 
+#a ("Gruppen")# Eine #on("i")#Gruppe#off("i")# ist eine Folge von Sätzen, die in einem be­
+stimmten Merkmal übereinstimmen. Durch eine GRUPPE-Anweisung
+der Form 
+ 
+#beispiel# 
+        % GRUPPE n  Ausdruck 
+#text# 
+ 
+werden aufeinanderfolgende Sätze mit gleichem Wert des angegebe­
+nen Ausdrucks gruppiert. Über die Nummer 'n' kann festgestellt
+werden, ob sich das angegebene Merkmal verändert hat. Dies ge­
+schieht mit der Prozedur 
+ 
+#beispiel# 
+        BOOL PROC gruppenwechsel (INT CONST gruppennr) 
+#text# 
+ 
+Immer wenn zwischen zwei Sätzen ein Gruppenwechsel stattfindet,
+wird beim vorigen Satz der Nachspann und beim folgenden Satz der
+Vorspann einmal interpretiert. Dies führt dazu, daß entsprechende
+Vorspann- bzw. Nachspannzeilen gedruckt werden. 
+    Vor dem ersten und nach dem letzten zu bearbeitenden Satz
+wechseln alle Gruppen, d.h. dort wird immer ein Vorspann bzw.
+Nachspann erzeugt. 
+    Ist ein zu interpretierender Abschnitt nicht vorhanden, so wird
+an dieser Stelle keine Ausgabe erzeugt. Die Textzeilen des Initali­
+sierungsteils werden auf jeden Fall bei Beginn des Druckvorganges
+in die Ausgabedatei geschrieben. Falls die Ausgabedatei voll ist,
+wird eine neue Datei angefangen und die Zeilen des Initialisie­
+rungsteils erneut an den Anfang gestellt. 
+ 
+#beispiel# 
+        Satz-  Gruppen-  Ausgabe 
+        nummer merkmal 
+#free (0.1)# 
+                                     Initialisierungsteil 
+        ------------------------------------------------- 
+          1        x                 Vorspann 
+                         WDH-Teil 
+          2        x     WDH-Teil 
+                                     Nachspann 
+        ------------------------------------------------- 
+          3        y                 Vorspann 
+                         WDH-Teil 
+          4        y     WDH-Teil 
+          5        y     WDH-Teil 
+                                     Nachspann 
+        ------------------------------------------------- 
+        ENDE 
+ 
+#center#Abb. 5-1   Ablauf des Druckvorganges mit Gruppen 
+#text# 
+ 
+#a ("Spaltendruck")# Normalerweise werden die Ausgaben der einzelnen
+Abschnitte hintereinander in der Ausgabedatei plaziert. Durch An­
+gabe einer Nummer als Parameter in der WIEDERHOLUNG-Anweisung
+können auch soviel Spalten wie angegeben nebeneinander gedruckt
+werden. Die Spaltenbreite wird dabei durch das Dateilimit (Komman­
+do 'limit' im Editor) festgelegt. Alternativ kann die Spaltenbreite
+auch als zweiter Parameter durch Leerzeichen getrennt angegeben
+werden. 
+    Vorspann und Nachspann werden jedoch auf jeden Fall wieder
+in eine eigene Zeile geschrieben, der Spaltendruck also unterbro­
+chen. 
+ 
+ 
+#abschnitt ("5.3", "INTERPRETATION VON MUSTERZEILEN", "Interpretation von Musterzeilen")# 
+ 
+Musterzeilen können Feldmuster enthalten, die bei der Interpreta­
+tion durch entsprechende Inhalte ersetzt werden, ehe die Muster­
+zeile in die Ausgabedatei übernommen wird. Der Beginn eines Feld­
+musters wird durch ein Musterzeichen ('&' oder '%') markiert. Wo
+und wie der Inhalt eingesetzt wird, kann durch folgende Variationen
+angegeben werden: 
+ 
+#beispiel# 
+        Typ ! Beispiel  ! Position ! Länge    ! bündig 
+        ----+-----------+------------------------------ 
+         1  ! &Name     ! fest     ! variabel ! links 
+         2  ! %Name     ! variabel ! variabel ! links 
+         3  ! &Name&&&  ! fest     ! fest     ! links 
+         4  ! %Name%%%  ! variabel ! fest     ! links 
+         5  ! &&&Name&  ! fest     ! fest     ! rechts 
+         6  ! %%%Name%  ! variabel ! fest     ! rechts 
+#text# 
+ 
+Der in dem Feldmuster angegebene Name muß Name einer Abkür­
+zung in irgendeinem Abkürzungsteil oder eines Feldes sein. Der
+Name darf kein Leerzeichen oder Musterzeichen enthalten. Falls dies
+doch der Fall ist, muß der Name in spitze Klammern eingeschlossen
+werden. 
+    Bei fester Länge wird bei zu kurzem Inhalt mit Leerzeichen
+aufgefüllt, bei zu langem Inhalt abgeschnitten. Bei linksbündigem
+Einsetzen geschieht dies an der rechten, sonst an der linken Seite. 
+    Feldmuster variabler Länge können je nach Inhalt dazu führen,
+daß der folgende Teil der Musterzeile verschoben wird. Für diesen
+Einsetzprozeß gelten die folgenden Regeln: 
+ 
+#a ("Position")# Feldmuster fester Position (mit '&' beginnend) werden
+immer in der Position eingesetzt, in der sie stehen. Feldmuster
+variabler Position (mit '%' beginnen) können nach rechts verschoben
+werden, wenn vorherige Inhalte länger als ihre Muster sind, und
+nach links, wenn Modus 1 oder 3 eingestellt ist und vorherige In­
+halte kürzer sind. 
+ 
+#a ("Länge")# Feldmuster variabler Länge erhalten auf jeden Fall den
+Platz, der durch die Länge des Feldmusters reserviert ist. Sind die
+Inhalte kürzer, kann der gewonnene Platz als Reserve für andere
+Feldmuster verwendet werden; sind die Inhalte länger, so wird der
+Inhalt so weit eingesetzt, wie noch Reserve vorhanden ist und der
+Rest abgeschnitten. 
+    Muß in ein Feldmuster variabler Länge ein leerer Inhalt einge­
+setzt werden, so werden beim Drucken auch die auf das Feldmuster
+folgenden Leerzeichen unterdrückt, falls vor dem Feldmuster noch
+ein Leerzeichen steht oder das Feldmuster in Spalte 1 beginnt. 
+    Feldmuster fester Länge werden immer in ihrer reservierten
+Länge eingesetzt. Sie werden im folgenden behandelt wie Feldmuster
+variabler Länge, deren Inhalt so lang ist wie das Feldmuster. 
+ 
+#a ("Verteilung")# Die Verteilung der verschiebbaren Feldmuster auf der
+Zeile geschieht jeweils in dem Abschnitt zwischen zwei Feldmustern
+fester Position bzw. Zeilenanfang oder Zeilenende. Für jeden Ab­
+schnitt wird festgestellt, wieviel Stellen die Inhalte insgesamt mehr
+oder weniger als ihre Muster benötigen. 
+    Der Längenausgleich geschieht zwischen dem letzten Feldmuster
+und dem Ende des Abschnitts. Dort wird ein Pufferplatz bestimmt,
+der bei Überlänge bis auf ein Leerzeichen verkleinert werden kann
+und an dem bei Unterlänge zusätzliche Leerzeichen eingefügt wer­
+den. 
+    Außer am Pufferplatz wird an keinem Mustertext des Abschnitts
+etwas geändert. Zwischentexte zwischen den Feldmustern werden
+unverändert übertragen und mit den umgebenden Feldmustern ver­
+schoben. 
+    Als Pufferplatz wird die erste Lücke hinter dem letzten Feld­
+muster eines Abschnittes verwendet, die mehr als ein Leerzeichen
+enthält. Ist keine solche Lücke vorhanden, wird das Ende des Ab­
+schnitts verwendet, falls dort ein Leerzeichen steht, und sonst das
+Ende des letzten Feldmusters. 
+    Die durch den Pufferplatz und kürzere Inhalte gewonnene Re­
+serve wird von links an die Feldmuster mit Überlänge verteilt, bis
+die Reserve verbraucht ist. 
+ 
+#a ("Zeilende")# Das Zeilenende wird als ein Quasi-Feldmuster mit fester
+Position aufgefaßt, das am Limit der Druckmusterdatei steht. Es
+sind also keine Einsetzungen möglich, die über das Limit der Datei
+hinausgehen. Als Pufferplatz wird hier jedoch die erste Blanklücke
+vom Zeilenende her verwendet, damit Mustertexte am Zeilenende
+gegebenenfalls stehenbleiben. Ist keine solche Lücke vorhanden, so
+wird das Zeilenende als Pufferplatz verwendet. 
+    Obwohl nicht als Pufferplatz ausgewiesen, kann der Raum zwi­
+schen Zeilenende und Dateilimit als Reserve verwendet werden. 
+ 
+#a ("Modi")# Der Einsetzmechanismus kann durch die MODUS-Anweisung
+mit einem Parameter verändert werden. Folgende Modi stehen zur
+Verfügung: 
+ 
+#beispiel# 
+        Modus ! Effekt 
+        ------+---------------------------------------- 
+          1   ! Normalmodus. 
+              ! '%'-Feldmuster werden auch 
+              ! nach links geschoben. 
+              ! Keine Zeilenwiederholung. 
+        ------+---------------------------------------- 
+          2   ! Tabellenmodus. 
+              ! '%'-Feldmuster werden nicht 
+              ! nach links geschoben. 
+              ! Keine Zeilenwiederholung. 
+        ------+---------------------------------------- 
+          3   ! Normalmodus mit Zeilenwiederholung. 
+              ! '%'-Feldmuster werden auch 
+              ! nach links geschoben. 
+              ! Zeilenwiederholung ohne Zwischentexte. 
+        ------+---------------------------------------- 
+          4   ! Tabellenmodus mit Zeilenwiederholung. 
+              ! '%'-Feldmuster werden nicht 
+              ! nach links geschoben. 
+              ! Zeilenwiederholung mit Zwischentexten. 
+        ------+---------------------------------------- 
+#text# 
+ 
+Bei Zeilenwiederholung werden Inhalte in einer folgenden Zeile
+fortgesetzt, falls sie in der ersten Zeile nicht untergebracht werden
+konnten. Dazu wird die Musterzeile mit den Restinhalten erneut
+interpretiert. Je nach Modus werden auch die Zwischentexte noch
+wiederholt. Der Restinhalt umfaßt immer noch das ganze letzte Wort,
+das nicht mehr auf die vorige Zeile paßte. Es findet also ein Um­
+bruch statt. Die Positionen, die in der vorigen Zeile vom Anfang des
+Wortes eingenommen würden, werden durch Leerzeichen ersetzt. 
+    Durch die MEHR-Anweisung mit einem Parameter kann die Zahl
+der Zeilenwiederholungen für die nächste Musterzeile festgesetzt
+werden. Dies hat jedoch nur eine Auswirkung, falls Zeilenwieder­
+holung zugelassen ist. Stehen zur Interpretation keine Restinhalte
+mehr zur Verfügung, wird mit leeren Inhalten weitergearbeitet. Kann
+ein Inhalt bei der vorgegebenen Anzahl von Zeilen nicht ganz dar­
+gestellt werden, wird der Rest nicht ausgegeben. 
+ 
+ 
+#abschnitt ("5.4", "ANSCHLUSS ZUM ELAN-COMPILER", "Anschluß zum ELAN-Compiler")# 
+ 
+Falls in einem Druckmuster Abkürzungen, Kommandozeilen oder
+Gruppendefinitionen vorkommen, wird das Druckmuster in ein
+ELAN-Programm umgewandelt, das dann vom ELAN-Compiler über­
+setzt wird. 
+    Alle Zeilen eines Abkürzungsteils werden direkt in das Pro­
+gramm übernommen, wobei der Name einer Abkürzung durch einen
+beliebig gewählten Refinementnamen ersetzt wird ('abk' + eine lau­
+fende Nummer). Alle Abkürzungen und Refinements werden als glo­
+bale Refinements definiert, also außerhalb von Prozeduren. Dadurch
+wird erreicht, daß sie an jeder Stelle verwendet werden können. 
+    Damit eine Abkürzung richtig als Refinement übersetzt wird,
+muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements
+sind beliebig, da sie nur in selbstdefinierten Anweisungen verwen­
+det werden. Die Refinements der Abkürzungen werden in einer Zu­
+weisung an eine TEXT-Variable verwendet, damit der Druckgenera­
+tor auf den entsprechenden Wert zugreifen kann. 
+    Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Eine
+Folge von Musterzeilen wird in eine Anweisung übersetzt, diese
+Musterzeilen einzusetzen und zu drucken. Eine '%%'-Anweisung wird
+einfach unverändert dazwischengeschrieben. Die Prozedur für den
+Wiederholungsteil wird einmal für jeden ausgewählten Satz aufgeru­
+fen, die Vorspann- und die Nachspann-Prozedur einmal bei jedem
+Gruppenwechsel. 
+    Anweisungen im Initialisierungsteil werden an den Anfang des
+Programms als globale Definitionen gestellt. 
+ 
+#a ("Fehler")# Findet sich in dem erzeugten ELAN-Programm ein Fehler,
+der durch den Druckgenerator nicht erkannt werden konnte (z.B.
+eine Abkürzung liefert keinen Wert), so muß der ELAN-Compiler
+diesen Fehler erkennen. Anschließend zeigt er das erzeugte Pro­
+gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie
+müssen nun die Fehlermeldung lokalisieren und anhand der eben
+gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­
+setzen, damit Sie dort den Fehler korrigieren können. 
+ 
+ 
+#abschnitt ("5.5", "FEHLERMELDUNGEN", "Fehlermeldungen")# 
+ 
+Folgende Fehlermeldungen können bei der Übersetzung eines Druck­
+musters auftreten: 
+ 
+#on("i")#keine schliessende Klammer in Feldmuster#off("i")# 
+  Wenn der Name in einem Feldmuster in spitze Klammern einge­
+  schlossen werden soll, muß noch in der gleichen Zeile eine
+  schließende Klammer vorhanden sein. 
+ 
+#on("i")#kein Kommando in Kommandozeile#off("i")# 
+  Eine Zeile, die mit '%' beginnt, enthält keinen weiteren Text. 
+ 
+#on("i")#unbekanntes Kommando#off("i")# 
+  Das erste Wort in einer Kommandozeile ist kein bekanntes Kom­
+  mando. 
+ 
+#on("i")#kein % WIEDERHOLUNG gefunden#off("i")# 
+  Das Druckmuster enthält keine Anweisung, die den Beginn eines
+  Abschnittes markiert. Es muß aber mindestens ein Abschnitt
+  vorhanden sein. 
+ 
+#on("i")#nur GRUPPE-Anweisung erlaubt#off("i")# 
+  Im Initialisierungsteil ist nur die GRUPPE-Anweisung erlaubt. 
+ 
+#on("i")#keine ELAN-Anweisung im Initialisierungsteil nach Gruppen­ 
+definition#off("i")# 
+  Sobald im Initialisierungsteil eine GRUPPE-Anweisung aufgetreten
+  ist, ist keine Kommandozeile mehr möglich. 
+ 
+#on("i")#illegale Gruppennummer#off("i")# 
+  In einer GRUPPE-Anweisung wurde eine zu große Nummer angege­
+  ben. Gruppen sollten von 1 an durchnumeriert werden. 
+ 
+#on("i")#diese Gruppe wurde schon definiert#off("i")# 
+  Eine Gruppennummer wurde mehrfach verwendet. 
+ 
+#on("i")#diese Abkürzung ist nicht definiert#off("i")# 
+  Ein Name in einem Feldmuster tritt nicht als Feld-oder Abkür­
+  zungsname auf. Eventuell enthält er ein Leerzeichen! 
+ 
+#on("i")#dieser Abschnitt wurde schon einmal definiert#off("i")# 
+  Kein Abschnitt kann mehrmals angegeben werden. 
+ 
+#on("i")#falscher Modus#off("i")# 
+  In einer MODUS-Anweisung wurde ein nicht definierter Modus als
+  Parameter angegeben. 
+ 
+#on("i")#diese Anweisung darf im Musterteil nicht vorkommen#off("i")# 
+ 
+#on("i")#im Abkürzungsteil darf keine Anweisung auftreten#off("i")# 
+ 
+#on("i")#in dieser Zeile stehen zu viele Feldmuster#off("i")# 
+  Es können maximal 24 Feldmuster in einer Zeile stehen. Abhilfe:
+  mehrere Feldmuster durch eine Abkürzung zusammenfassen. 
+ 
+#on("i")#das Druckmuster enthält zu viele Feldmuster#off("i")# 
+  Die Gesamtanzahl der Feldmuster ist begrenzt. Abhilfe: mehrere
+  Feldmuster durch eine Abkürzung zusammenfassen. 
+ 
+#on("i")#nach dem "&" soll direkt der Name einer Abkürzung folgen#off("i")# 
+  In einer Abkürzungszeile stehen Leerzeichen hinter dem '&'. 
+ 
+#on("i")#kein Doppelpunkt nach Abkürzung#off("i")# 
+  Nach dem Abkürzungsnamen in einer Abkürzungszeile muß durch
+  ein Leerzeichen getrennt ein Doppelpunkt folgen. 
+ 
+#on("i")#Abkürzung mehrfach definiert#off("i")# 
+  Die Abkürzung wurde unter dem gleichen Namen schon einmal,
+  vielleicht in einem anderen Abschnitt, definiert. 
+ 
+#on("i")#das Druckmuster enthält zu viele Abkürzungen#off("i")# 
+  Abhilfe: mehrere Abkürzungen zu einem Ausdruck zusammenfas­
+  sen. 
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.6 b/app/eudas/4.4/doc/ref-manual/eudas.ref.6
new file mode 100644
index 0000000..92c7610
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.6
@@ -0,0 +1,466 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (61)# 
+#kapitel ("6","Struktur","von","EUDAS-Dateien")# 
+ 
+ 
+ 
+EUDAS-Dateien können unabhängig von EUDAS über den Daten­
+typ EUDAT manipuliert werden. Die zur Verfügung stehenden Zu­
+griffsoperationen sind in diesem Kapitel beschrieben. 
+    Der Datentyp EUDAT ist analog zum Datentyp FILE. Jede
+EUDAT-Variable kann an eine EUDAS-Datei angekoppelt werden.
+Dadurch lassen sich beliebig viele EUDAS-Dateien gleichzeitig be­
+arbeiten. Wie der Abschnitt 6.6 zeigt, sind so auch ganz andere
+Anwendungen realisierbar. 
+    Die wesentlichen EUDAS-Funktionen (Ansehen, Suchen, Druk­
+ken) können jedoch nicht direkt auf EUDAT-Variablen angewendet
+werden, sondern greifen auf die virtuelle Datei zu, die im nächsten
+Kapitel beschreiben wird. 
+ 
+ 
+#abschnitt ("6.1", "DER DATENTYP SATZ", "Der Datentyp SATZ")# 
+ 
+Der Datentyp SATZ stellt einen einzelnen EUDAS-Satz dar, der
+intern als TEXT realisiert ist. Ein SATZ besteht aus bis zu 256
+Feldern, die jeweils einen TEXT enthalten können. Nach dem Initi­
+alisieren sind alle Felder mit "" vorbelegt. Die Felder können über
+Nummern von 1 bis 256 angesprochen werden. 
+    Damit kann man sich einen SATZ als dynamisches ROW n TEXT
+vorstellen, das bis zu 256 Elemente haben kann. Anders als ein
+entsprechendes ROW belegt ein leerer SATZ praktisch keinen Spei­
+cherplatz. 
+    Folgende Zugriffsprozeduren stehen zur Verfügung: 
+ 
+#proc# 
+TYPE SATZ 
+ 
+OP := (SATZ VAR, SATZ CONST) 
+ 
+PROC satz initialisieren (SATZ VAR) 
+#endproc# 
+    Jeder SATZ muß vor Benutzung initialisiert werden. 
+ 
+#proc# 
+INT PROC felderzahl (SATZ CONST) 
+#endproc# 
+    Liefert die Nummer des höchsten belegten Feldes. 
+ 
+#proc# 
+PROC feld lesen (SATZ CONST, INT CONST feldnr, 
+                 TEXT VAR inhalt) 
+#endproc# 
+    Liest den Inhalt des Feldes 'feldnr' in 'inhalt'. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#n ist keine Feldnummer#off("i")# 
+    'n' liegt außerhalb des Bereiches 1..256. 
+ 
+#proc# 
+PROC feld bearbeiten (SATZ CONST, INT CONST feldnr, 
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 
+#endproc# 
+    Ruft 'bearbeite' auf, wobei 'bearbeite' ein Text und zwei Posi­
+    tionen in diesem Text übergeben werden. Die Positionen geben
+    das erste und das letzte Zeichen des durch 'feldnr' ausgewähl­
+    ten Feldes an. Ist der Anfang größer als das Ende, so ist das
+    Feld leer. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#n ist keine Feldnummer#off("i")# 
+    'n' liegt außerhalb des Bereiches 1..256. 
+ 
+#proc# 
+PROC feld aendern (SATZ VAR, INT CONST feldnr, 
+                   TEXT CONST inhalt) 
+#endproc# 
+    Schreibt 'inhalt' in das Feld mit der Nummer 'feldnr' 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#n ist keine Feldnummer#off("i")# 
+    'n' liegt außerhalb des Bereiches 1..256. 
+ 
+#proc# 
+INT PROC feldindex (SATZ CONST, TEXT CONST muster) 
+#endproc# 
+    Falls eines der Felder 'muster' enthält, wird die Nummer dieses
+    Feldes geliefert, sonst 0. 
+ 
+ 
+#abschnitt ("6.2","DER DATENTYP EUDAT","Der Datentyp EUDAT")# 
+ 
+Der Datentyp EUDAT muß ähnlich wie ein FILE an einen benann­
+ten oder unbenannten Datenraum angekoppelt werden. Der Daten­
+raum hat anschließend den Typ 3243. Weitere Zugriffe auf eine
+EUDAT-Variable sind erst nach erfolgtem Ankoppeln zulässig. An­
+derenfalls können undefinierte Fehler entstehen. 
+ 
+#proc# 
+TYPE EUDAT 
+ 
+PROC oeffne (EUDAT VAR, TEXT CONST dateiname) 
+#endproc# 
+    Koppelt die EUDAT-Variable an die EUDAS-Datei mit dem
+    Namen 'dateiname' an. Die Datei wird eingerichtet, falls sie
+    noch nicht existiert. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Die angegebene Datei hat nicht den Typ 3243. 
+ 
+#proc# 
+PROC oeffne (EUDAT VAR, DATASPACE CONST ds) 
+#endproc# 
+    Koppelt die EUDAT-Variable an den Datenraum 'ds'. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Der Datenraum wurde bereits verwendet und hat nicht den Typ
+    3243. 
+ 
+Eine EUDAS-Datei ist in Felder und Sätze unterteilt. Die Felder
+werden beim Zugriff über Nummern angesprochen. Jedem Feld ist
+jedoch zur Identifikation ein TEXT als Feldname zugeordnet. Die
+Feldnamen werden als SATZ gespeichert, wobei jedes Feld seinen
+zugeordneten Namen enthält. 
+ 
+#proc# 
+INT PROC felderzahl (EUDAT CONST) 
+#endproc# 
+    Liefert Anzahl der benannten Felder. Ist zu Anfang 0. 
+ 
+#proc# 
+PROC feldnamen aendern (EUDAT VAR, 
+                        SATZ CONST neue namen) 
+#endproc# 
+    Setzt die Feldnamen einer Datei. Ist 'felderzahl (neue namen)'
+    größer als die Felderzahl der Datei, so wird die Felderzahl der
+    Datei entsprechend heraufgesetzt. 
+ 
+#proc# 
+PROC feldnamen lesen (EUDAT CONST, SATZ VAR namen) 
+#endproc# 
+    Liefert alle Feldnamen in einer SATZ-Variablen. 
+ 
+Eine EUDAS-Datei enthält drei zusätzliche Notiztexte. Zwei davon
+sind bereits reserviert, und zwar: 
+#free (0.2)# 
+  1: Prüfbedingungen 
+  2: Datum der letzten Änderung 
+#f2# 
+Der dritte kann für freie Notizen verwendet werden. 
+ 
+#proc# 
+PROC notizen lesen (EUDAT CONST, INT CONST notiz nr, 
+                    TEXT VAR notizen) 
+#endproc# 
+    Schreibt die Notizen der EUDAS-Datei in 'notizen' ('notiz nr' =
+   1,2,3). 
+ 
+#proc# 
+PROC notizen aendern (EUDAT VAR, INT CONST notiz nr, 
+                      TEXT CONST notizen) 
+#endproc# 
+    Ändert die Notizen. Alte Notizen werden dabei überschrieben
+    ('notiz nr' = 1,2,3). 
+ 
+ 
+#abschnitt ("6.3", "SATZPOSITION", "Satzposition")# 
+ 
+Eine EUDAS-Datei läßt sich sequentiell vorwärts und rückwärts
+bearbeiten. Dazu gibt es eine aktuelle Satzposition. Ein bestimmter
+Satz kann auch direkt angesprungen werden. Die Prozeduren, die
+nach dem Inhalt des ersten Feldes suchen, arbeiten besonders
+schnell, da die entsprechenden Sätze über eine Hashmethode gefun­
+den werden. 
+ 
+#proc# 
+INT PROC satznr (EUDAT CONST) 
+#endproc# 
+    Liefert aktuelle Satzposition. 
+ 
+#proc# 
+INT PROC saetze (EUDAT CONST) 
+#endproc# 
+    Liefert Anzahl der Sätze. 
+ 
+#proc# 
+BOOL PROC dateiende (EUDAT CONST) 
+#endproc# 
+    Liefert TRUE, wenn 'satznr' groesser als 'saetze' ist. Die letzte
+    erreichbare Satzposition liegt um eins hinter dem letzten Satz
+    (um auch am Ende anfügen zu können). 
+ 
+#proc# 
+PROC auf satz (EUDAT VAR, INT CONST satznr) 
+#endproc# 
+    Positioniert auf den gewünschten Satz. Bei nicht existierenden
+    Sätzen wird auf den ersten bzw. hinter den letzten Satz ge­
+    sprungen. 
+ 
+#proc# 
+PROC weiter (EUDAT VAR) 
+#endproc# 
+    Geht einen Satz weiter, jedoch nicht über das Dateiende hinaus. 
+ 
+#proc# 
+PROC zurueck (EUDAT VAR) 
+#endproc# 
+    Geht einen Satz zurück, falls der erste Satz noch nicht erreicht
+    ist. 
+ 
+#proc# 
+PROC auf satz (EUDAT VAR, TEXT CONST muster) 
+#endproc# 
+    Positioniert auf den ersten Satz, der als erstes Feld 'muster'
+    enthält, anderenfalls hinter den letzten Satz. 
+ 
+#proc# 
+PROC weiter (EUDAT VAR, TEXT CONST muster) 
+#endproc# 
+    Geht weiter, bis das erste Feld 'muster' enthält, bzw. bis hinter
+    den letzten Satz. 
+ 
+#proc# 
+PROC zurueck (EUDAT VAR, TEXT CONST muster) 
+#endproc# 
+    Geht zurück, bis das erste Feld 'muster' enthält, bzw. auf den
+    ersten Satz der EUDAS-Datei. 
+ 
+ 
+#abschnitt ("6.4", "SATZZUGRIFFE", "Satzzugriffe")# 
+ 
+Der aktuelle Satz ist ein SATZ-Objekt. Auf die Felder des aktuellen
+Satzes kann direkt zugegriffen werden. 
+ 
+#proc# 
+PROC feld lesen (EUDAT CONST, INT CONST feldnr, 
+                 TEXT VAR inhalt) 
+#endproc# 
+    Wirkt wie 'feld lesen' auf den aktuellen Satz. 
+ 
+#proc# 
+PROC feld aendern (EUDAT VAR, INT CONST feldnr, 
+                   TEXT CONST inhalt) 
+#endproc# 
+    Wirkt wie 'feld aendern' auf den aktuellen Satz. 
+ 
+#proc# 
+PROC feld bearbeiten (EUDAT CONST, INT CONST feldnr, 
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 
+#endproc# 
+     Wirkt wie 'feld bearbeiten' auf den aktuellen Satz. 
+ 
+Der aktuelle Satz kann auch als Ganzes bearbeitet werden. 
+ 
+#proc# 
+PROC satz lesen (EUDAT CONST, SATZ VAR satz) 
+#endproc# 
+    Liefert den aktuellen Satz. 
+ 
+#proc# 
+PROC satz aendern (EUDAT VAR, SATZ CONST satz) 
+#endproc# 
+    Ersetzt den aktuellen Satz durch 'satz'. 
+ 
+#proc# 
+PROC satz einfuegen (EUDAT VAR, SATZ CONST satz) 
+#endproc# 
+    Fügt 'satz' vor dem aktuellen Satz ein. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#EUDAS-Datei voll#off("i")# 
+    Eine EUDAS-Datei faßt mindestens 5000 Sätze. 
+ 
+#proc# 
+PROC satz loeschen (EUDAT VAR) 
+#endproc# 
+    Löscht den aktuellen Satz. 
+ 
+ 
+#abschnitt ("6.5", "SORTIEREN UND REORGANISIEREN", "Sortieren und Reorganisieren")# 
+ 
+Zum Sortieren können für die einzelnen Felder Typen angegeben
+werden, damit auch Zahlen und Daten richtig sortiert werden kön­
+nen. Außerdem kann die Feldreihenfolge angegeben werden, nach
+der sortiert werden soll. 
+ 
+#proc# 
+PROC feldinfo (EUDAT VAR, INT CONST feldnr, info) 
+#endproc# 
+    Setzt den Feldtyp des Feldes 'feldnr'. Es bedeuten 
+      -1 : normaler Text (Standard) 
+       0 : Text nach DIN. Ziffern und Sonderzeichen werden igno­
+           riert. Groß-und Kleinbuchstaben gelten gleich. Umlaute
+           werden beachtet. 
+       1 : Zahl (beim Vergleich werden alle Zeichen außer Zif­
+           fern ignoriert). 
+       2 : Datum. Es werden Daten der Form "tt.mm.jj" vergli­
+           chen. 
+ 
+#proc# 
+INT PROC feldinfo (EUDAT CONST, INT CONST feldnr) 
+#endproc# 
+    Der Feldtyp des angegebenen Feldes wird geliefert. Zu Anfang
+    ist -1 voreingestellt. 
+ 
+#proc# 
+INT PROC unsortierte saetze (EUDAT CONST) 
+#endproc# 
+    Liefert die Anzahl von Sätzen, die seit dem letzten Sortiervor­
+    gang geändert wurden. Bei einer neuen Datei, die noch nie
+    sortiert wurde, wird immer 0 geliefert. 
+ 
+#proc# 
+PROC dezimalkomma (TEXT CONST komma) 
+#endproc# 
+    Stellt das Dezimalkomma ein, das beim Vergleich von Zahlen
+    gelten soll. 
+#f2# 
+    FEHLER: 
+#f2# 
+    #on("i")#Nicht erlaubtes Dezimalkomma#off("i")# 
+    Nur Texte der Länge 1 sind zugelassen. 
+ 
+#proc# 
+TEXT PROC dezimalkomma 
+#endproc# 
+    Liefert das eingestellte Dezimalkomma ("," ist voreingestellt). 
+ 
+#proc# 
+PROC sortiere (EUDAT VAR, TEXT CONST reihenfolge) 
+#endproc# 
+    Sortiert die Datei in der von 'reihenfolge' angegebenen Reihen­
+    folge. Dabei enthält 'reihenfolge' an der Stelle #bsp ("2*i+1")# den Code
+    der Feldnummer, die als i-te in der Sortierung berücksichtigt
+    werden soll. Das Zeichen an der Stelle #bsp ("2*i")# gibt an, ob das Feld
+    mit der davorstehenden Feldnummer aufsteigend ('+') oder
+    absteigend ('-') sortiert werden soll. 
+ 
+#proc# 
+PROC sortiere (EUDAT VAR) 
+#endproc# 
+    Sortiert die Datei in der zuletzt eingestellten Reihenfolge.
+    Wurde noch keine Reihenfolge angegeben, wird die Datei in der
+    Feldreihenfolge sortiert. 
+ 
+#proc# 
+TEXT PROC sortierreihenfolge (EUDAT CONST) 
+#endproc# 
+    Liefert die zuletzt eingestellte Reihenfolge. Wurde noch nicht
+    sortiert, so wird "" geliefert. 
+ 
+Nach umfangreichen Änderungen an einer EUDAS-Datei ist eine
+Reorganisation sinnvoll, um "Textleichen" zu beseitigen. 
+ 
+#proc# 
+PROC reorganisiere (TEXT CONST dateiname) 
+#endproc# 
+    Die EUDAS-Datei mit dem Namen 'dateiname' wird reorgani­
+    siert. 
+ 
+ 
+#abschnitt ("6.6", "EUDAS-DATEIEN ALS ASSOZIATIVSPEICHER", "EUDAS-Dateien als Assoziativspeicher")# 
+ 
+In diesem Abschnitt soll ein Beispiel erläutert werden, in dem
+EUDAS-Dateien unabhängig von EUDAS für einen ganz anderen
+Zweck benutzt werden. Das folgende kurze Paket soll ein Abkür­
+zungsverzeichnis realisieren, das auf einer EUDAS-Datei basiert. 
+ 
+#beispiel# 
+    PACKET abkuerzungsverzeichnis 
+      DEFINES 
+      verzeichnis laden, 
+      abkuerzung einfuegen, 
+      abkuerzung aendern, 
+      abkuerzung loeschen, 
+      langform : 
+ 
+    EUDAT VAR verz; 
+    SATZ VAR satz; 
+    TEXT VAR inhalt; 
+ 
+    PROC verzeichnis laden (TEXT CONST dateiname) : 
+ 
+      oeffne (verz, dateiname) 
+ 
+    END PROC verzeichnis laden; 
+ 
+    PROC abkuerzung einfuegen (TEXT CONST abk, lang) : 
+ 
+      auf satz (verz, abk); 
+      IF NOT dateiende (verz) THEN 
+        errorstop ("Abkürzung existiert bereits") 
+      ELSE 
+        satz initialisieren (satz); 
+        feld aendern (satz, 1, abk); 
+        feld aendern (satz, 2, lang); 
+        satz einfuegen (satz) 
+      END IF 
+ 
+    END PROC abkuerzung einfuegen; 
+ 
+    PROC abkuerzung aendern (TEXT CONST abk, lang) : 
+ 
+      auf satz (verz, abk); 
+      IF dateiende (verz) THEN 
+        errorstop ("Abkürzung existiert nicht") 
+      ELSE 
+        feld aendern (verz, 2, lang) 
+      END IF 
+ 
+    END PROC abkuerzung aendern; 
+ 
+    PROC abkuerzung loeschen (TEXT CONST abk) : 
+ 
+      auf satz (verz, abk); 
+      IF NOT dateiende (verz) THEN 
+        satz loeschen (verz) 
+      END IF 
+ 
+    END PROC abkuerzung loeschen; 
+ 
+    TEXT PROC langform (TEXT CONST abk) : 
+ 
+      auf satz (verz, abk); 
+      IF dateiende (verz) THEN 
+        inhalt := ""; 
+        errorstop ("Abkürzung nicht vorhanden") 
+      ELSE 
+        feld lesen (verz, 2, inhalt) 
+      END IF; 
+      inhalt
+ 
+    END PROC langform; 
+ 
+    END PACKET abkuerzungsverzeichnis; 
+#text# 
+ 
+Die Prozedur 'verzeichnis laden' koppelt die interne EUDAT-Vari­
+able 'verz' an eine benannte EUDAS-Datei, die eventuell vorher mit
+EUDAS erstellt wurde. In diesem Beispiel sind die Feldnamen egal;
+falls die übergebene EUDAS-Datei noch nicht existiert, wird sie mit
+0 Feldern eingerichtet, was aber nur für eine spätere Anzeige mit
+EUDAS störend wäre. 
+    Grundlage für das Aufsuchen einer bestimmten Abkürzung bil­
+det immer die Prozedur 'auf satz', die nach dem Inhalt des ersten
+Feldes optimiert sucht. Falls die Abkürzung nicht gefunden wurde,
+wird auf das Dateiende positioniert, daher wird jeweils 'dateiende'
+abgefragt. 
+    Beim Einfügen eines neuen Satzes muß eine komplette Satz­
+variable angegeben werden, die bereits mit den Inhalten gefüllt ist.
+Beim späteren Ändern kann jedoch direkt auf ein Feld zugegriffen
+werden, ohne die Satzvariable explizit rauszuholen. 
+    Die Abfrage einer bestimmten Abkürzung bereitet dann keine
+Schwierigkeiten mehr. 
+    Für die Verwendung von EUDAS-Dateien in diesem Beispiel
+spricht zum einen die einfache Programmierung, zum anderen aber
+auch die Möglichkeit, das erstellte Verzeichnis mit den Hilfsmitteln
+von EUDAS zu warten und auszudrucken. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.7 b/app/eudas/4.4/doc/ref-manual/eudas.ref.7
new file mode 100644
index 0000000..47533ac
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.7
@@ -0,0 +1,519 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (71)# 
+#kapitel ("7", "Verwaltung", "der offenen", "Dateien")# 
+ 
+ 
+Die in diesem Kapitel beschriebene Schnittstelle verbindet mehrere
+EUDAS-Dateien zu einem großen Dateimodell. Diese virtuelle Datei
+dient als Grundlage für die meisten EUDAS-Funktionen. Zuerst muß
+eine Datei als Bestandteil der virtuellen Datei geöffnet werden, ehe
+sie bearbeitet werden kann. Es ist so bei den Funktionen keine
+Angabe mehr nötig, welche Datei gemeint ist. 
+    Diese Schnittstelle ist in vielen Teilen für die interne
+EUDAS-Anwendung ausgelegt. Bei einigen Prozeduren werden aus
+Effizienzgründen keinerlei Überprüfungen auf illegale Aufrufe oder
+Parameter durchgeführt. Wollen Sie eine solche Prozedur dennoch
+verwenden, sollten Sie die Einhaltung der angegebenen Bedingungen
+sorgfältig überprüfen. 
+ 
+ 
+#abschnitt ("7.1", "DATEIVERWALTUNG", "Dateiverwaltung")# 
+ 
+Mit 'oeffne' wird eine Datei zum Bearbeiten geöffnet. Mit 'kette' und
+'kopple' können weitere Dateien dazugekettet bzw. dazugekoppelt
+werden. Durch 'sichere' können veränderte Kopien zurückgeschrie­
+ben werden. Durch 'dateien loeschen' werden die internen Kopien
+gelöscht. 
+    Mit 'anzahl dateien' kann die Anzahl der vorhandenen Dateien
+erfragt werden. 'anzahl koppeldateien' gibt Auskunft darüber, wie­
+viel Dateien davon gekoppelt sind. 'aendern erlaubt' gibt den Status
+wieder, der beim Öffnen der ersten Datei angegeben wurde. 'inhalt
+veraendert' gibt an, ob die angegebene Datei verändert wurde. Mit
+'eudas dateiname' können die Namen der geöffneten Dateien erfragt
+werden. Bei jedem 'oeffne' wird 'dateiversion' um 1 erhöht. Dies
+dient dazu, ein erfolgtes neues Öffnen von anderen Stellen aus zu
+entdecken. 
+    Mit 'auf koppeldatei' kann die virtuelle Datei auf eine Koppel­
+datei umgeschaltet werden, so daß der Eindruck entsteht, nur diese
+Datei wäre geöffnet worden. 
+ 
+#proc# 
+PROC oeffne (TEXT CONST dateiname, 
+             BOOL CONST aendern erlaubt) 
+#endproc# 
+    Falls Ändern erlaubt sein soll, wird eine Kopie der angegebenen
+    Datei zur Bearbeitung für EUDAS angelegt. Vorher geöffnete
+    Dateien werden gelöscht. Die Änderungserlaubnis wird entspre­
+    chend gesetzt. Es wird die Satzposition der EUDAS-Datei ange­
+    nommen (Ausnahme: steht die EUDAS-Datei hinter dem letzten
+    Satz, wird auf Satz 1 positioniert). 'dateiversion' sowie 'anzahl
+    dateien' werden um 1 erhöht. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Datei nicht gesichert#off("i")# 
+    Eine vorher geöffnete Datei war verändert, aber nicht gesi­
+    chert. 
+#f1# 
+    #on("i")#Datei existiert nicht#off("i")# 
+    Die angegebene Datei ist nicht vorhanden. 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Die angegebene Datei hat nicht den für EUDAS-Dateien festge­
+    legten Typ. 
+ 
+#proc# 
+PROC kopple (TEXT CONST dateiname) 
+#endproc# 
+    Die angegebene Datei wird zu den bereits geöffneten Dateien
+    dazugekoppelt. Falls Ändern erlaubt ist, wird eine Kopie dieser
+    Datei verwendet. Dabei werden die ersten Felder der Datei, die
+    bereits in der Hauptdatei vorhanden sind, als Koppelfelder
+    festgelegt. Alle weiteren Felder werden zusätzlich zu den bis­
+    herigen angelegt. 'dateiversion', 'anzahl dateien' und 'anzahl 
+    koppeldateien' werden um 1 erhöht. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß vorher eine Datei geöffnet werden. 
+#f1# 
+    #on("i")#Zuviel Dateien geoeffnet#off("i")# 
+    Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. 
+#f1# 
+    #on("i")#Datei existiert nicht#off("i")# 
+    Die angegebene Datei ist nicht vorhanden. 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Die angegebene Datei hat nicht den für EUDAS-Dateien festge­
+    legten Typ. 
+#f1# 
+    #on("i")#Zu viele Felder#off("i")# 
+    Die Anzahl der Felder insgesamt ist begrenzt. 
+#f1# 
+    #on("i")#Zu viele Koppelfelder#off("i")# 
+    Die Anzahl der Koppelfelder ist begrenzt. 
+#f1# 
+    #on("i")#keine Koppelfelder vorhanden#off("i")# 
+    Das erste Feld der zu koppelnden Datei ist in der Hauptdatei
+    nicht vorhanden (unterschiedliche Feldnamen). 
+ 
+#proc# 
+PROC kette (TEXT CONST dateiname) 
+#endproc# 
+    Die angegebene Datei wird an die Hauptdatei angekettet, d.h.
+    die Sätze der neuen Datei werden am bisherigen Dateiende
+    angefügt. Falls Ändern erlaubt ist, wird eine Kopie dieser Datei
+    verwendet. Die zu kettende Datei muß in der Feldstruktur nicht
+    mit der Hauptdatei übereinstimmen. Die aktuelle Satzposition
+    wird beibehalten. 'dateiversion' und 'anzahl dateien' werden um
+    1 erhöht. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß vorher eine Datei geöffnet werden. 
+#f1# 
+    #on("i")#Zuviel Dateien geoeffnet#off("i")# 
+    Die Anzahl der gleichzeitig geöffneten Dateien ist begrenzt. 
+#f1# 
+    #on("i")#Datei existiert nicht#off("i")# 
+    Die angegebene Datei ist nicht vorhanden. 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Die angegebene Datei hat nicht den für EUDAS-Dateien festge­
+    legten Typ. 
+ 
+#proc# 
+PROC sichere (INT CONST dateinr, TEXT CONST dateiname) 
+#endproc# 
+    Die geöffneten Dateien werden in der Reihenfolge ihres Öffnens
+    durchnumeriert (von 1 an). Die Arbeitskopie mit der angegebe­
+    nen Nummer wird unter dem angegebenen Namen gesichert, aber
+    selbst nicht verändert. Die vorher unter diesem Namen vorhan­
+    dene Datei wird gelöscht. War die zu sichernde Arbeitskopie
+    verändert worden, so wird sie anschließend als nicht verändert
+    angesehen. 
+    Bedingungen: 
+      1 <= dateinr <= anzahl dateien 
+ 
+#proc# 
+PROC dateien loeschen (BOOL CONST auch geaenderte) 
+#endproc# 
+    Es werden alle geöffneten Arbeitskopien gelöscht. EUDAS wird
+    wieder in den Anfangszustand versetzt. Wird 'auch geaenderte'
+    angegeben, wird bei geänderten, aber nicht gesicherten Dateien
+    die Fehlermeldung unterdrückt. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Datei nicht gesichert#off("i")# 
+    Eine vorher geöffnete Datei war verändert, aber nicht gesi­
+    chert. 
+ 
+#proc# 
+BOOL PROC auf koppeldatei 
+#endproc# 
+    Liefert TRUE, wenn auf eine Koppeldatei umgeschaltet wurde. 
+ 
+#proc# 
+PROC auf koppeldatei (INT CONST nr) 
+#endproc# 
+    Umschalten auf Koppeldatei 'nr'. Ist bereits umgeschaltet, wird
+    wieder zurückgeschaltet. In diesem Fall werden bei 'nr' = 1 die
+    Koppelfelder übernommen, anderenfalls nicht. Beim Umschalten
+    bleiben Satzposition, Markierungen und Suchmuster gespeichert.
+    In der Koppeldatei wird die beim letzten Umschalten eingestell­
+    te Position wieder eingenommen. 'dateiversion' wird um 1 er­
+    höht. 
+ 
+#proc# 
+INT PROC anzahl dateien 
+#endproc# 
+    Gibt die Anzahl der insgesamt geöffneten Dateien an. 
+ 
+#proc# 
+INT PROC anzahl koppeldateien 
+#endproc# 
+    Gibt die Anzahl der gekoppelten Dateien an. 
+ 
+#proc# 
+BOOL PROC aendern erlaubt 
+#endproc# 
+    Reflektiert den Status, der bei 'oeffne' gesetzt wurde. 
+ 
+#proc# 
+BOOL PROC inhalt veraendert (INT CONST dateinr) 
+#endproc# 
+    Gibt an, ob die geöffnete Datei mit der angegebenen Nummer
+    verändert wurde. Wird ggf. von 'sichere' zurückgesetzt. 
+    Bedingung: 
+      1 <= dateinr <= anzahl dateien 
+ 
+#proc# 
+TEXT PROC eudas dateiname (INT CONST dateinr) 
+#endproc# 
+    Liefert den Namen, unter dem die entsprechende Datei geöffnet
+    wurde. 
+    Bedingung: 
+      1 <= dateinr <= anzahl dateien 
+ 
+#proc# 
+INT PROC dateiversion 
+#endproc# 
+    Wird bei jedem 'oeffne', 'kette' und 'kopple' zyklisch erhöht. 
+ 
+#proc# 
+INT PROC folgedatei (INT CONST dateinr) 
+#endproc# 
+    Eine geöffnete EUDAS-Datei wird in eine von zwei Listen auf­
+    genommen, die der geketteten Dateien und die der gekoppelten.
+    Diese Prozedur liefert jeweils die Nummer der nächsten Datei in
+    der Liste, am Ende aber 0. Die Liste der geketteten Dateien
+    beginnt immer mit 1, mit 'folgedatei (0)' erhält man die erste
+    gekoppelte Datei. 
+    Bedingung: 
+      0 <= dateinr <= anzahl dateien 
+ 
+ 
+#abschnitt ("7.2", "FELDSTRUKTUR", "Feldstruktur")# 
+ 
+Die einzelnen Sätze der kombinierten EUDAS-Datei sind in Felder
+unterteilt. Diese setzen sich zusammen aus den Feldern der Haupt­
+datei und der einzelnen Koppeldateien, wobei die Koppelfelder je­
+weils nur einmal auftauchen. 
+    'anzahl felder' liefert die Anzahl der vorhanden Felder. Mit
+'feldnamen lesen' und 'feldnamen bearbeiten' können die Feldnamen
+abgefragt werden. 'feldnummer' liefert einen Index für einen vor­
+gegebenen Feldnamen, da die Felder immer über Nummern angespro­
+chen werden. 
+    Die Prozeduren 'feld lesen' und 'feld bearbeiten' ermöglichen
+den Zugriff auf den Feldinhalt des aktuellen Satzes; durch 'feld
+aendern' kann dieser Inhalt abgeändert werden. 
+ 
+#proc# 
+INT PROC anzahl felder 
+#endproc# 
+    Liefert die Anzahl der vorhanden Felder. 
+ 
+#proc# 
+PROC feldnamen lesen (INT CONST feldnr, 
+                      TEXT VAR feldname) 
+#endproc# 
+    Liefert in 'feldname' den Namen des Feldes mit der Nummer
+    'feldnr'. 
+    Bedingung: 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+PROC feldnamen bearbeiten (INT CONST feldnr, 
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 
+#endproc# 
+    Die Prozedur 'bearbeite' wird aufgerufen. Als Parameter werden
+    ein Text und Anfangs- und Endposition des gewünschten Feld­
+    namens in diesem Text übergeben. Verhindert unnötiges Kopie­
+    ren des Feldnamens in eine TEXT-Variable. Der übergebene
+    Text darf nicht verändert werden! 
+    Bedingung: 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+INT PROC feldnummer (TEXT CONST feldname) 
+#endproc# 
+    Liefert den index zu dem angegebenen Feldnamen. Falls ein
+    solcher Name nicht existiert, wird 0 geliefert. 
+ 
+#proc# 
+PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) 
+#endproc# 
+    Liefert den Inhalt des angegebenen Feldes. 
+    Bedingung: 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+PROC feld bearbeiten (INT CONST feldnr, 
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) 
+#endproc# 
+    Die Prozedur 'bearbeite' wird aufgerufen. Der Feldinhalt des
+    angegebenen Feldes steht im übergebenen Text innerhalb der
+    Grenzen. Ist die Obergrenze kleiner als die Untergrenze, so ist
+    das Feld leer. 
+    Bedingung: 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) 
+#endproc# 
+    Ändert den Inhalt des angegebenen Feldes. 
+    Bedingung: 
+      NOT ende der datei 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+INT PROC feldinfo (INT CONST feldnummer) 
+#endproc# 
+    Liefert den Typ des angegebenen Feldes. 
+    Bedingung: 
+      1 <= feldnummer <= anzahl felder 
+ 
+#proc# 
+PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) 
+#endproc# 
+    Liest die angegebenen Notizen ('nr' = 1,2,3) aus der ersten
+    Datei oder der umgeschalteten Koppeldatei. 
+ 
+#proc# 
+PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) 
+#endproc# 
+    Ändert die Notizen ('nr' = 1,2,3) der ersten Datei oder der um­
+    geschalteten Koppeldatei. 
+ 
+ 
+#abschnitt ("7.3", "POSITIONIERUNG", "Positionierung")# 
+ 
+Das virtuelle Dateimodell von EUDAS verfügt ebenfalls über eine
+Satzposition, die verändert werden kann. 
+    Durch 'satznummer' wird die aktuelle Satznummer geliefert,
+beim Koppeln kann über 'satzkombination' die Reihenfolge der Kop­
+pelkombinationen bestimmt werden. 'dateiende' zeigt an, ob die
+Satzposition hinter dem letzten Satz liegt. Mit 'weiter' und 'zurueck'
+erfolgt die eigentliche Positionierung. Hier kann außer der Positio­
+nierung um Einzelsätze auch die Positionierung auf den nächsten
+ausgewählten oder markierten Satz angefordert werden. Mit 'auf 
+satz' schließlich kann ein bestimmter Satz angesprungen werden. 
+ 
+#proc# 
+INT PROC satznummer 
+#endproc# 
+    Liefert die Nummer des aktuellen Satzes. Die Sätze werden von
+    1 an durchnumeriert, wobei über die geketteten Dateien wei­
+    tergezählt wird. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+INT PROC satzkombination 
+#endproc# 
+    Liefert die laufende Nummer der Koppelkombination des aktuel­
+    len Satzes. Wird nur durch 'weiter' im Einzelsatzmodus erhöht.
+    Normalerweise 1. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+BOOL PROC dateiende 
+#endproc# 
+    Gibt an, ob die Satzposition hinter dem letzten Satz liegt. 
+ 
+#proc# 
+PROC weiter (INT CONST modus) 
+#endproc# 
+    Erhöht die aktuelle Satzposition. Für 'modus' gibt es 3 Möglich­
+    keiten: 
+    1: Falls eine weitere Satzkombination besteht, wird diese ein­
+       genommen, sonst zum nächsten Satz. 
+    2: Zum nächsten durch Suchbedingung ausgewählten Satz. Wird
+       optimiert. 
+    3: Zum nächsten markierten Satz. Wird optimiert. 
+    Ist kein Satz mehr vorhanden, wird die Satzposition hinter dem
+    letzten Satz eingenommen. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC zurueck (INT CONST modus) 
+#endproc# 
+    Geht um einen Satz zurück. Die Modusangabe ist wie bei 'wei­
+    ter', jedoch wird im Modus 1 keine weitere Satzkombination
+    ausprobiert. Die Positionierung endet bei Satz 1. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC auf satz (INT CONST satznr) 
+#endproc# 
+    Geht auf den angegebenen Satz. Ist 'satznr' < 1, wird auf Satz 1
+    positioniert, ist der angegebene Satz nicht vorhanden, wird
+    hinter den letzten Satz positioniert. Es wird jeweils die erste
+    Satzkombination eingenommen. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+ 
+#abschnitt ("7.4", "ÄNDERUNGEN", "Änderungen")# 
+ 
+Sätze des Dateimodells können eingefügt oder gelöscht werden.
+Durch das Einfügen entsteht ein leerer Satz vor dem aktuellen Satz;
+alle weiteren Sätze rücken eine Stelle weiter. Beim Löschen wird
+dieser Vorgang wieder rückgängig gemacht. 
+    Durch 'satz einfuegen' wird ein Leersatz eingefügt; durch
+'satz loeschen' wird der aktuelle Satz gelöscht. 
+    Sätze in gekoppelten Dateien werden grundsätzlich nicht ge­
+löscht; auch beim Einfügen entsteht nicht automatisch ein Leersatz
+in den gekoppelten Dateien. Änderungen in den Koppeldateien
+(durch 'feld aendern') werden gepuffert. Durch 'aenderungen ein­
+tragen' werden die Änderungen dann in die Koppeldateien eingetra­
+gen. Dabei kann auch ein neuer Satz in die Koppeldatei eingefügt
+werden. Bei Positionierungen wird diese Prozedur automatisch auf­
+gerufen. 
+ 
+#proc# 
+PROC satz einfuegen 
+#endproc# 
+    Fügt vor dem aktuellen Satz einen Leersatz ein. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC satz loeschen 
+#endproc# 
+    Löscht den aktuellen Satz. Hat hinter dem letzten Satz keine
+    Wirkung. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC aenderungen eintragen 
+#endproc# 
+    Trägt die gepufferten Änderungen in die Koppeldateien ein.
+    Dabei können die folgenden Fälle auftreten: 
+    1. Der Satz in der Koppeldatei wird geändert. 
+       Dies geschieht dann, wenn vorher ein passender Satz in der
+       Koppeldatei vorhanden war und die Koppelfelder nicht ver­
+       ändert wurden. 
+    2. In der Koppeldatei wird ein neuer Satz eingefügt. 
+       Wenn die Koppelfelder und noch andere Felder einer Datei
+       geändert wurden, wird in dieser Datei ein neuer Satz einge­
+       fügt. 
+    3. Es wird neu gekoppelt. 
+       Wurden nur die Koppelfelder einer Datei geändert, wird ein
+       neuer, zu diesen Feldern passender Satz gesucht. Nach
+       'aenderungen eintragen' erscheinen unter den Feldern der
+       Datei die neuen Inhalte. 
+ 
+ 
+#abschnitt ("7.5", "SUCHBEDINGUNGEN", "Suchbedingungen")# 
+ 
+Über 'suchbedingung' kann eine Suchbedingung eingetragen werden,
+die für jeden Satz geprüft werden soll. Mit 'satz ausgewaehlt' wird
+erfragt, ob der aktuelle Satz die Suchbedingung erfüllt. Die Such­
+bedingung kann mit 'suchbedingung loeschen' wieder ausgeschaltet
+werden. 
+    Einzelne Sätze können auch markiert werden. Nach einem Öff­
+nen ist zunächst kein Satz markiert. Durch 'markierung  aendern'
+kann die Markierung eines Satzes geändert werden. 'satz markiert'
+fragt ab, ob der aktuelle Satz markiert ist. 'markierte saetze' liefert
+die Anzahl der markierten Sätze. Mit 'markierungen loeschen' wer­
+den alle Markierungen entfernt. 
+ 
+#proc# 
+PROC suchbedingung (INT CONST feldnr, 
+                    TEXT CONST bedingung) 
+#endproc# 
+    Stellt für das angegebene Feld die im Text als Muster angege­
+    bene Suchbedingung ein. Weitere Aufrufe verknüpfen die Be­
+    dingungen mit UND (auch wenn das gleiche Feld erneut angege­
+    ben wird). 
+    Bedingung: 
+      anzahl dateien > 0 
+      1 <= feldnr <= anzahl felder 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Suchmuster zu umfangreich#off("i")# 
+    Es wurden zu viele Vergleiche gefordert. 
+ 
+#proc# 
+BOOL PROC satz ausgewaehlt 
+#endproc# 
+    Gibt an, ob die Suchbedingung auf den aktuellen Satz zutrifft.
+    Hinter dem letzten Satz wird immer FALSE geliefert. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) 
+#endproc# 
+    Liefert die zuletzt für das angegebene Feld eingestellte Bedin­
+    gung, falls die Suchbedingung nicht gelöscht und keine Datei
+    neu geöffnet wurde. 
+    Bedingung: 
+      1 <= feldnr <= anzahl felder 
+ 
+#proc# 
+PROC suchbedingung loeschen 
+#endproc# 
+    Löscht die eingestellte Suchbedingung wieder. Anschließend
+    sind alle Sätze ausgewählt. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC markierung aendern 
+#endproc# 
+    Ändert die Markierung des aktuellen Satzes ins Gegenteil. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+BOOL PROC satz markiert 
+#endproc# 
+    Gibt an, ob der aktuelle Satz markiert ist. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+INT PROC markierte saetze 
+#endproc# 
+    Gibt an, wieviel Sätze insgesamt markiert sind. 
+    Bedingung: 
+      anzahl dateien > 0 
+ 
+#proc# 
+PROC markierungen loeschen 
+#endproc# 
+    Löscht alle Markierungen. 
+    Bedingung: 
+      anzahl dateien > 0 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.8 b/app/eudas/4.4/doc/ref-manual/eudas.ref.8
new file mode 100644
index 0000000..5e8d220
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.8
@@ -0,0 +1,444 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (83)# 
+#kapitel ("8", "Funktionen", "zur", "Bearbeitung")# 
+ 
+ 
+ 
+Die Verarbeitungsfunktionen arbeiten jeweils auf der aktuell geöff­
+neten Datei. Falls mindestens ein Satz markiert ist, werden nur
+markierte Sätze bearbeitet, anderenfalls die durch die Suchbedin­
+gung ausgewählten Sätze. 
+ 
+ 
+#abschnitt ("8.1", "DRUCKEN", "Drucken")# 
+ 
+Zum Drucken wird ein Druckmuster als Textdatei benötigt. Dessen
+Name muß beim Aufruf der Prozedur 'drucke' angegeben werden.
+Werden beim Übersetzen des Druckmusters Fehler entdeckt, so wird
+der Paralleleditor aufgerufen und kein Druckvorgang durchgeführt. 
+    Normalerweise sendet der Druckgenerator die Ausgabe direkt
+zum Drucker. Alternativ kann die Ausgabe auch in eine Datei ge­
+schrieben werden. Dieses Verfahren kann mit 'direkt drucken' umge­
+stellt werden. Der Aufruf 
+ 
+#beispiel# 
+    direkt drucken (TRUE) 
+#text# 
+ 
+sendet alle Dateien direkt zum Drucker, mit 
+ 
+#beispiel# 
+    direkt drucken (FALSE) 
+#text# 
+ 
+wird die Ausgabe in Dateien abgelegt. Diese Dateien erhalten Namen
+der Form 
+ 
+#beispiel# 
+    "Druckmustername.a$n" 
+#text# 
+ 
+wobei 'n' eine laufende Nummer zur Unterscheidung ist. 
+    Soll die Druckausgabe in eine ganz bestimmte Datei geleitet
+werden, so kann vor dem Aufruf von 'drucke' die Prozedur 'druck­
+datei' aufgerufen werden, die als Parameter den Namen der Ausga­
+bedatei erhält. Existiert die Datei noch nicht, wird sie eingerichtet,
+ansonsten wird die Ausgabe am Ende angehängt. 
+    Die Einstellung der Ausgabedatei gilt nur für einen Druckvor­
+gang und überschreibt für diesen Druckvorgang 'direkt drucken'.
+Beim nächsten Druckvorgang wird wieder die durch 'direkt drucken'
+festgelegte Einstellung verwendet. 
+    Wenn beim Drucken ein großes Ausgabevolumen anfällt, kann es
+sinnvoll sein, die Ausgabe in mehrere kleine Dateien aufzuteilen.
+Dies gilt auch, wenn direkt gedruckt werden soll, da auch in diesem
+Fall eine Zwischendatei erzeugt werden muß. Die maximale Anzahl
+von Zeilen pro Datei wird durch 'max druckzeilen' angegeben. 
+    Der dort angegeben Wert gilt nur ungefähr - ein Wechsel der
+Ausgabedatei findet dann statt, wenn die Ausgabedatei nach Bear­
+beitung eines Satzes die Maximalanzahl überschritten hat. In die
+neue Datei wird anschließend zuerst der Initialisierungsteil des
+Druckmusters kopiert, ehe mit der Ausgabe des nächsten Satzes
+fortgefahren wird. 
+ 
+Die Prozeduren im einzelnen: 
+ 
+#proc# 
+PROC drucke (TEXT CONST druckmuster) 
+#endproc# 
+    Die aktuell geöffnete Datei wird nach dem angegebenen Druck­
+    muster gedruckt. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Datei "druckmuster" existiert nicht#off("i")# 
+    Das angegebene Druckmuster ist nicht vorhanden. 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Zum Drucken muß eine Datei geöffnet sein. 
+#f1# 
+    #on("i")#direkt Drucken nicht möglich#off("i")# 
+    Es ist kein Druckprogramm installiert oder der Spooler läßt sich
+    mit 'print' nicht ansprechen. Der Druck wird abgebrochen, die
+    Ausgabedatei ist noch vorhanden. 
+ 
+#proc# 
+PROC direkt drucken (BOOL CONST ja) 
+#endproc# 
+    Gibt an, ob die Druckausgaben direkt gedruckt oder in einer
+    Datei gesammelt werden sollen. 
+ 
+#proc# 
+PROC druckdatei (TEXT CONST ausgabedatei) 
+#endproc# 
+    Leitet die Druckausgabe des nächsten Druckvorgangs in die
+    Datei 'ausgabedatei'. Die Einstellung von 'direkt drucken' wird
+    für diesen Druckvorgang überschrieben. Die Ausgabe wird am
+    Ende der Datei angehängt, falls nötig, wird die Ausgabedatei
+    vorher eingerichtet. 
+ 
+#proc# 
+PROC maxdruckzeilen (INT CONST zeilen) 
+#endproc# 
+    Stellt die maximale Anzahl von Zeilen für die Ausgabedatei ein.
+    Beim Überschreiten dieses Wertes wird eine neue Datei ange­
+    fangen. Standardwert ist 4000. 
+ 
+#proc# 
+TEXT PROC lfd nr 
+#endproc# 
+    Liefert während des Druckens die laufende Nummer des gerade
+    gedruckten Satzes als Text. 
+ 
+#proc# 
+BOOL PROC gruppenwechsel (INT CONST gruppennr) 
+#endproc# 
+    Kann innerhalb eines Vor- oder Nachspanns beim Drucken ab­
+    gefragt werden, um festzustellen, ob die angegebene Gruppe
+    gewechselt und damit den Vor- bzw. Nachspann mitverursacht
+    hat (es können zu einem Zeitpunkt mehrere Gruppen wechseln).
+    Die Gruppennummer 0 gibt die Standardgruppe an, die nur vor
+    dem ersten und nach dem letzten Satz wechselt. 
+ 
+ 
+#abschnitt ("8.2", "KOPIEREN", "Kopieren")# 
+ 
+Zum selektiven Kopieren von EUDAS-Dateien wird ein Kopiermuster
+benötigt. Dieses gibt die Zuordnung zwischen Feldern der Ziel- und
+der Quelldatei an. Die Quelldatei ist immer die aktuell geöffnete
+Datei. 
+    Die Kopierfunktion wird durch 'kopiere' aufgerufen. Parameter
+sind der Name der Zieldatei und das Kopiermuster als FILE. Alter­
+nativ kann statt des Kopiermusters eine Prozedur übergeben wer­
+den, die die Kopieranweisungen erhält. 
+    Der eigentliche Kopiervorgang wird durch den Operator 'K'
+bewirkt. Dieser erhält den Zielfeldnamen und einen TEXT-Aus­
+druck als Parameter. Der Wert des TEXT-Ausdrucks wird in das
+jeweilige Feld der Zieldatei geschrieben. 
+    Existiert die Zieldatei noch nicht, so wird sie mit den Feldern
+eingerichtet, die in den einzelnen 'K'-Ausdrücken angegeben sind
+und zwar in der angeführten Reihenfolge. Existiert die Zieldatei, so
+werden gegebenenfalls noch nicht vorhandene Felder am Ende ange­
+fügt. 
+    Die Prozedur 'std kopiermuster' liefert zu einer gegebenen
+Zieldatei ein Standard-Muster, das als Auswahlgrundlage dienen
+kann. Existiert die Zieldatei nicht, werden alle Felder der Quell­
+datei 1 : 1 kopiert, anderenfalls wird zu jedem Feld der Zieldatei
+ein passendes Feld der Quelldatei gesucht - die Feldreihenfolge
+richtet sich in diesem Fall nach der Zieldatei. 
+ 
+#proc# 
+PROC kopiere (TEXT CONST dateiname, 
+              FILE VAR kopiermuster) 
+#endproc# 
+    Die aktuell geöffnete Datei wird nach den Angaben in 'kopier­
+    muster' in die Datei 'dateiname' kopiert. Das Kopiermuster wird
+    dem ELAN-Compiler übergeben. Tritt bei der Übersetzung ein
+    Fehler auf, wird der Paralleleditor aufgerufen. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Zieldatei existiert, ist aber keine EUDAS-Datei. 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß eine virtuelle Datei vorhanden sein. 
+ 
+#proc# 
+PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) 
+#endproc# 
+    Wie oben, nur ist die Kopierfunktion gleich als Prozedur vor­
+    handen. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Zieldatei existiert, ist aber keine EUDAS-Datei. 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß eine virtuelle Datei vorhanden sein. 
+ 
+#proc# 
+OP K (TEXT CONST feldname, ausdruck) 
+#endproc# 
+    Kopiert den Ausdruck in das Feld 'feldname' der Zieldatei.
+    Dieses Feld wird eingerichtet, falls es noch nicht existiert.
+    Dieser Operator ist nur während eines Kopiervorganges de­
+    finiert (also in einem Kopiermuster oder einer Kopierfunktion).
+    Er darf nicht in einer IF-Klausel stehen, sondern muß bei
+    jedem Satz mit gleichem Feldnamen an der gleichen Stelle auf­
+    gerufen werden. 
+ 
+#proc# 
+PROC std kopiermuster (TEXT CONST dateiname, 
+                       FILE VAR kopiermuster) 
+#endproc# 
+    Liefert ein Standard-Kopiermuster, abhängig von der Zieldatei
+    'dateiname'. Existiert diese nicht, wird die Quelldatei unverän­
+    dert kopiert, ansonsten richtet sich das Kopiermuster nach der
+    Zieldatei. 
+ 
+ 
+#abschnitt ("8.3", "TRAGEN", "Tragen")# 
+ 
+Durch Tragen können Sätze komplett in eine Zieldatei transportiert
+werden. In der Quelldatei sind sie anschließend nicht mehr vorhan­
+den. Eine ganze Auswahl von Sätzen kann mit 'trage' transportiert
+werden. 'trage satz' transportiert nur den aktuellen Satz. Mit
+'hole satz' kann der letzte Satz der Zieldatei wieder zurückgeholt
+werden, so daß eine EUDAS-Datei auch als Zwischenspeicher für
+Einzelsätze verwendet werden kann. 
+    Existiert die Zieldatei bereits, muß sie mindestens so viele
+Felder wie die Quelldatei besitzen, damit keine Informationen ver­
+lorengehen können. Die Feldnamen müssen nicht übereinstimmen.
+Existiert die Zieldatei noch nicht, wird sie mit den Feldern der
+Quelldatei eingerichtet. 
+    Die Tragefunktion kann um eine gleichzeitige Prüfung erweitert
+werden. Dabei werden Bedingungen überprüft, die bei der Zieldatei
+gespeichert sind. Sätze, die diese Bedingungen verletzen, werden
+nicht getragen. Eine entsprechende Meldung wird in eine Protokoll­
+datei geschrieben, die als Parameter übergeben werden muß. 
+    Die Prüfbedingungen stehen als ausführbares Programm in den
+Notizen der Zieldatei. Prüfbedingungen können mit mehreren Proze­
+duren formuliert werden. 'pruefe' nimmt eine beliebige Bedingung als
+Parameter und gibt bei Mißerfolg eine Meldung aus. 'wertemenge'
+prüft auf Übereinstimmung mit einem der angegebenen Werte. 'feld­
+maske' legt eine Maske für ein Feld fest, die auf den Inhalt zutref­
+fen muß. 
+    Mit Hilfe der Prozedur 'eindeutige felder' können Satzduplikate
+erkannt werden. Auch diese werden nicht getragen. 
+    Die bei den Prüfbedingungen angegebenen Feldnamen müssen in
+der Quelldatei vorhanden sein. Falls eine Prüfprozedur außerhalb
+von 'trage' aufgerufen wird, führt eine Verletzung der Prüfbedin­
+gung zu einem 'errorstop'. 
+ 
+#proc# 
+PROC trage (TEXT CONST dateiname, 
+            FILE VAR protokoll, BOOL CONST test) 
+#endproc# 
+    Alle ausgewählten Sätze werden in die Datei 'dateiname' getra­
+    gen. Diese wird gegebenenfalls eingerichtet. Falls 'test' ange­
+    geben ist, werden die in den Notizen der Zieldatei enthaltenen
+    Bedingungen geprüft. Nur in diesem Fall muß 'protokoll' initial­
+    isiert sein. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#kein Satz zum Tragen vorhanden#off("i")# 
+    Die Quelldatei ist leer oder es ist keine Datei geöffnet. 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Zieldatei existiert, ist aber keine EUDAS-Datei. 
+#f1# 
+    #on("i")#Zieldatei hat falsche Felderzahl#off("i")# 
+    Zu wenig Felder in der Zieldatei. 
+ 
+#proc# 
+PROC trage satz (TEXT CONST dateiname) 
+#endproc# 
+    Der aktuelle Satz wird in die Datei 'dateiname' getragen. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#kein Satz zum Tragen vorhanden#off("i")# 
+    Keine Datei geöffnet oder Datei ist am Ende. 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Zieldatei existiert, ist aber keine EUDAS-Datei. 
+#f1# 
+    #on("i")#Zieldatei hat falsche Felderzahl#off("i")# 
+    Zu wenig Felder in der Zieldatei. 
+ 
+#proc# 
+PROC pruefe (TEXT CONST feldname, BOOL CONST bedingung) 
+#endproc# 
+    Wenn die angegebene Bedingung FALSE liefert, wird eine Mel­
+    dung in die Protokolldatei geschrieben und der jeweilige Satz
+    nicht getragen. 
+ 
+#proc# 
+PROC wertemenge (TEXT CONST feldname. menge) 
+#endproc# 
+    Es wird geprüft, ob das angegebene Feld in der Wertemenge
+    enthalten ist. Die einzelnen Werte in der Wertemenge werden
+    dabei durch Komma getrennt. Leerzeichen sind signifikant. 
+ 
+#proc# 
+PROC feldmaske (TEXT CONST feldname, maske) 
+#endproc# 
+    Es wird geprüft, ob das angegebene Feld zu der Maske paßt. Die
+    Zeichen in der Maske haben dabei folgende Bedeutung: 
+      '9'   trifft auf jede Ziffer zu 
+      'X'   trifft auf jedes Zeichen zu 
+      'A'   trifft auf jeden Großbuchstaben zu (einschließlich
+            Umlaute) 
+      'a'   trifft auf jeden Kleinbuchstaben zu (einschließlich
+            Umlaute und 'ß') 
+      '*'   trifft auf eine Folge beliebiger Zeichen zu (auch die
+            leere Folge). Eine sparsame Verwendung wird empfoh­
+            len, da die Bearbeitung sehr aufwendig ist. 
+    Alle anderen Zeichen treffen nur auf ein gleiches Zeichen zu. 
+ 
+#proc# 
+PROC eindeutige felder (INT CONST anzahl) 
+#endproc# 
+    Gibt an, die wieviel ersten Felder einen Satz eindeutig identifi­
+    zieren sollen. Ein Satz, der mit einem Satz der Datei in diesen
+    Feldern übereinstimmt, wird nicht getragen. Ohne diese Angabe
+    wird keine derartige Prüfung vorgenommen. 
+ 
+#proc# 
+PROC hole satz (TEXT CONST dateiname) 
+#endproc# 
+    Holt den letzten Satz der angegebenen Datei und fügt ihn vor
+    dem aktuellen Satz ein. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#"dateiname" existiert nicht#off("i")# 
+#f1# 
+    #on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+    Zieldatei existiert, ist aber keine EUDAS-Datei. 
+#f1# 
+    #on("i")#Zieldatei hat falsche Felderzahl#off("i")# 
+    Zu viele Felder in der angegebenen Datei. 
+#f1# 
+    #on("i")#Kein Satz zum Tragen vorhanden#off("i")# 
+    Die angegebene Datei ist leer. 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß eine virtuelle Datei vorhanden sein. 
+ 
+ 
+#abschnitt ("8.4", "VERARBEITUNG", "Verarbeitung")# 
+ 
+Die ausgewählten Sätze der aktuellen Datei können nach einer
+Verarbeitungsvorschrift verändert oder geprüft werden. Dies ge­
+schieht durch die Prozedur 'verarbeite'. Als Parameter kann ent­
+weder ein Verarbeitungsmuster als FILE oder die Verarbeitungs­
+funktion direkt als Prozedur übergeben werden. 
+    Die Vorschrift wird durch den Operator 'V' realisiert. 
+ 
+#proc# 
+PROC verarbeite (FILE VAR verarbeitungsmuster) 
+#endproc# 
+    Die aktuelle Datei wird nach dem angegebenen Muster bearbei­
+    tet. Enthält die Vorschrift, die dem ELAN-Compiler übergeben
+    wird, einen Fehler, wird der Paralleleditor aufgerufen. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß eine virtuelle Datei vorhanden sein. 
+ 
+#proc# 
+PROC verarbeite (PROC verarbeitungsfunktion) 
+#endproc# 
+    Wie oben, nur wird die Vorschrift direkt als Prozedur überge­
+    ben. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#keine Datei geoeffnet#off("i")# 
+    Es muß eine virtuelle Datei vorhanden sein. 
+ 
+#proc# 
+OP V (TEXT CONST feldname, ausdruck) 
+#endproc# 
+    Das angegebene Feld des aktuellen Satzes wird durch den Aus­
+    druck ersetzt. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# 
+    Das angegebene Feld ist nicht vorhanden. 
+ 
+ 
+#abschnitt ("8.5", "FUNKTIONEN IN AUSDRÜCKEN", "Funktionen in Ausdrücken")# 
+ 
+Für Ausdrücke bei den in diesem Kapitel beschriebenen Prozeduren
+sind einfache Funktionen zur Abfrage von Feldinhalten vorhanden.
+Mit 'f' kann der Inhalt eines benannten Feldes erfragt werden, bei
+'wert' wird der Inhalt erst in eine REAL-Zahl umgewandelt, wobei
+nichtnumerische Zeichen ignoriert werden. 
+    Die Prozedur 'textdarstellung' kann dazu verwendet werden,
+den Wert einer TEXT-Variablen als TEXT-Denoter in ELAN-Syntax
+darzustellen. 
+    Die Prozedur 'zahltext' kann dazu verwendet werden, aus einer
+REAL-Zahl einen mit der richtigen Zahl von Nachkommastellen ver­
+sehenen, variabel langen Text zu machen. 
+ 
+#proc# 
+TEXT PROC f (TEXT CONST feldname) 
+#endproc# 
+    Liefert den Inhalt des angegebenen Feldes. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# 
+ 
+#proc# 
+REAL PROC wert (TEXT CONST feldname) 
+#endproc# 
+    Liefert den Inhalt des angegebenen Feldes als REAL. Dabei
+    werden nichtnumerische Zeichen ignoriert, ausgenommen das
+    Minuszeichen und das eingestellte Dezimalkomma (s. 'dezimal­
+    komma'). Tritt kein numerisches Zeichen auf, wird der Wert 0.0
+    geliefert. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# 
+ 
+#proc# 
+REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) 
+#endproc# 
+    Wie 'wert' mit einem Parameter, nur daß das Ergebnis auf die
+    angegebene Anzahl von Nachkommastellen gerundet wird. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Das Feld "feldname" ist nicht definiert.#off("i")# 
+ 
+#proc# 
+TEXT PROC textdarstellung (TEXT CONST anzeigetext) 
+#endproc# 
+    Liefert 'anzeigetext' als TEXT-Denoter, also in Anführungs­
+    strichen. Anführungsstriche im Text werden dabei verdoppelt.
+    Steuerzeichen von 0 bis 31 werden in lesbare Form gebracht. 
+ 
+#proc# 
+TEXT PROC zahltext (REAL CONST wert, INT CONST kommastellen) 
+#endproc# 
+    Liefert den Text des angegebenen Werts mit dem eingestellten
+    Dezimalkomma und mit der angegebenen Zahl von Nachkomma­
+    stellen. Sind die Kommastellen 0, wird auch das Komma unter­
+    drückt. Der Text erhält soviel Stellen, wie zur Darstellung
+    benötigt werden. 
+ 
+#proc# 
+TEXT PROC zahltext (TEXT CONST feldname, 
+                    INT CONST kommastellen) 
+#endproc# 
+    Wirkt wie 'zahltext (wert (feldname), kommastellen)'. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.9 b/app/eudas/4.4/doc/ref-manual/eudas.ref.9
new file mode 100644
index 0000000..85dd337
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.9
@@ -0,0 +1,184 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (93)# 
+#kapitel ("9", "Anzeige", " ", " ")# 
+ 
+ 
+ 
+#abschnitt ("9.1", "FENSTERVERWALTER", "Fensterverwalter")# 
+ 
+Funktionen, die einen Teil des Bildschirms in einem rechteckigen
+Fenster beschreiben, werden über den Fensterverwalter untereinan­
+der koordiniert. Jede Funktion fordert für ihren Fensterbereich eine
+Variable vom Typ FENSTER an. Vor jedem Bildschirmzugriff kann die
+Funktion erfahren, ob andere Programme den Bildschirm im Fenster­
+bereich überschrieben haben. Gleichzeitig meldet sie damit Verän­
+derungen an anderen Fenstern an, die sich mit dem eigenen über­
+schneiden. 
+ 
+#proc# 
+PROC fenster initialisieren (FENSTER VAR neu) 
+#endproc# 
+    Jede Fenstervariable muß vor Benutzung initialisiert werden. 
+ 
+#proc# 
+PROC fenstergroesse setzen (FENSTER VAR fenster, 
+                            INT CONST x anf, y anf, 
+                                      x laenge, y laenge) 
+#endproc# 
+    Die Fenstergröße des Fensters wird gesetzt. 'x anf' und 'y anf'
+    werden von 1..n gezählt. Die Größe eines 24x80-Bildschirms
+    entspricht den Angaben (1, 1, 79, 24). Da das letzte Zeichen
+    einer Zeile wegen Rollgefahr nicht benutzt werden kann, werden
+    nur 79 Spalten angegeben. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#zu viele Fenster#off("i")# 
+    Es sind nur 16 verschiedene Fenstergrößen möglich. 
+ 
+#proc# 
+PROC fenstergroesse (FENSTER CONST fenster, 
+                     INT VAR x anf, y anf, 
+                             x laenge, y laenge) 
+#endproc# 
+    Meldet die eingestellte Größe des Fensters. 
+ 
+#proc# 
+PROC fensterzugriff (FENSTER CONST mein fenster, 
+                     BOOL VAR veraendert) 
+#endproc# 
+    Ein Zugriff auf 'mein fenster' wird angemeldet. 'veraendert' gibt
+    an, ob das Fenster seit dem letzten Zugriff durch einen über­
+    schneidenden Zugriff verändert wurde. Beim ersten Zugriff ist
+    'veraendert' immer TRUE. 
+ 
+#proc# 
+PROC fenster veraendert (FENSTER CONST fenster) 
+#endproc# 
+    Falls ein Unterprogramm eine FENSTER-Variable des Hauptpro­
+    grammes benutzt, kennzeichnet das Unterprogramm das Fenster
+    mit dieser Prozedur als benutzt, damit das Hauptprogramm das
+    Bild neu ausgibt. 
+ 
+#proc# 
+PROC bildschirm neu 
+#endproc# 
+    Gibt an, daß der Bildschirm von einer Funktion benutzt wurde,
+    die ihre Zugriffe nicht über den Fensterverwalter anmeldet.
+    Alle Fenster werden als verändert gekennzeichnet. 
+ 
+ 
+#abschnitt ("9.2", "ANZEIGEGRUNDFUNKTIONEN", "Anzeigegrundfunktionen")# 
+ 
+Sämtliche Anzeigefunktionen werden in einem Fenster abgewickelt,
+dessen Größe durch 'anzeigefenster' bestimmt wird. 
+    Die Funktion 'bildausgeben' übernimmt die eigentliche Ausgabe.
+Dabei kann durch Parameter mitgeteilt werden, ob sich an der Datei
+außer der Markierung etwas geändert hat. Hat sich nichts geändert,
+wird zur Optimierung unter Umständen nur die Markierung neu
+ausgegeben. Das Bild wird jedoch auf jeden Fall ganz ausgegeben,
+wenn das Fenster von anderer Seite verändert wurde. Auch das
+Öffnen einer neuen Datei wird automatisch erkannt und richtig
+behandelt. 
+    Welche Felder dargestellt werden sollen, kann durch 'feldaus­
+wahl' angegeben werden. Dabei ist für jeden Anzeigemodus eine
+eigene Feldauswahl möglich. Die Darstellung kann durch 'rollen' in
+vertikaler Richtung verschoben werden. 
+    Mit 'uebersicht' kann die Übersicht ausgegeben werden. Ihre
+Größe wird durch 'uebersichtsfenster' angegeben. 
+ 
+#proc# 
+PROC anzeigefenster (INT CONST x anf, y anf, 
+                               x laenge, y laenge) 
+#endproc# 
+    Das Anzeigefenster wird in der entsprechenden Größe reser­
+    viert. 
+#f2# 
+    FEHLER: 
+#f1# 
+    #on("i")#Anzeigefenster zu klein#off("i")# 
+    Das Fenster ist zu schmal (< 40 Zeichen), um eine sinnvolle
+    Anzeige zuzulassen. 
+ 
+#proc# 
+PROC bild ausgeben (BOOL CONST datei veraendert) 
+#endproc# 
+    Im Anzeigefenster wird das Bild je nach eingestelltem Modus
+    ausgegeben, wenn das Fenster verändert wurde oder 'satz ver­
+    aendert' TRUE ist. 'satz veraendert' muß immer dann angegeben
+    werden, wenn am Inhalt der virtuellen Datei etwas verändert
+    wurde. 
+ 
+#proc# 
+PROC feldauswahl (TEXT CONST feldcode) 
+#endproc# 
+    Die im aktuellen Modus anzuzeigenden Felder und ihre Reihen­
+    folge werden ausgewählt. Dabei enthält 'feldcodes' an der i-ten
+    Stelle den Code der Feldnummer des Feldes, das an i-ter Posi­
+    tion erscheinen soll. 
+ 
+#proc# 
+PROC rollen (INT CONST anzahl) 
+#endproc# 
+    Die Darstellung wird um die angegebene Anzahl von Zeilen
+    gerollt. Bei einer positiven Angabe wird zu höheren Feld- bzw.
+    Satznummern gerollt (Bild bewegt sich umgekehrt). Beim ersten
+    bzw. letzten Feld bzw. Satz hört das Rollen automatisch auf. 
+ 
+#proc# 
+PROC uebersichtsfenster (INT CONST x anf, y anf, 
+                                   x laenge, y laenge) 
+#endproc# 
+    Legt die Größe des Übersichtsfensters fest. 
+ 
+#proc# 
+PROC uebersicht (TEXT CONST feldauswahl) 
+#endproc# 
+    Ruft eine Übersicht der aktuellen Datei auf, in der geblättert
+    und markiert werden kann. In 'feldauswahl' steht an der Stelle
+    i der Code der Feldnummer, die als i-tes in der Aufzählung
+    erscheinen soll. 
+ 
+ 
+#abschnitt ("9.3", "EDITORFUNKTIONEN", "Editorfunktionen")# 
+ 
+Es stehen drei Funktionen zur Verfügung, die den Editor im Anzei­
+gemodus benutzen. Sie dienen zum Einfügen und Ändern sowie zum
+Eingeben eines Suchmusters. 
+    Der Editor wird durch ESC 'q' verlassen. Weitere ESC-Funk­
+tionen, die zum Verlassen führen sollen, können durch 'exit zeichen'
+angegegeben und nach Funktionsausführung mit 'exit durch' abge­
+fragt werden. 
+ 
+#proc# 
+PROC aendern (PROC hilfe) 
+#endproc# 
+    Bietet den aktuellen Satz zum Ändern an. Steht die virtuelle
+    Datei am Ende, wird automatisch 'einfuegen' durchgeführt. Bei
+    ESC '?' wird 'hilfe' aufgerufen. 
+ 
+#proc# 
+PROC einfuegen (PROC hilfe) 
+#endproc# 
+    Fügt vor dem aktuellen Satz einen Satz ein, dessen Inhalt im
+    Editor angegeben wird. Bei ESC '?' wird 'hilfe' aufgerufen. 
+ 
+#proc# 
+PROC suchen (PROC hilfe) 
+#endproc# 
+    Im Editor wird eine neue Suchbedingung eingegeben. Bei ESC '?'
+    wird 'hilfe' aufgerufen. 
+ 
+#proc# 
+PROC exit durch (TEXT CONST zeichenkette) 
+#endproc# 
+    Gibt die Zeichen an, die beim Drücken nach ESC zum Verlassen
+    des Editors führen sollen. Die eingegebenen Daten werden je­
+    doch vorher auf jeden Fall noch verarbeitet. 
+ 
+#proc# 
+TEXT PROC exit durch 
+#endproc# 
+    Gibt an, durch welches Zeichen der Editor verlassen wurde. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler b/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler
new file mode 100644
index 0000000..6ce4287
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.fehler
@@ -0,0 +1,129 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (115)# 
+#kapitel (" ", "Fehlermeldungen", " ", " ")# 
+ 
+ 
+ 
+In diesem Kapitel sind alle Fehlermeldungen aufgeführt, die von
+EUDAS erzeugt werden und zum Abbruch einer Funktion führen
+können. 
+ 
+#on("i")#'n' ist keine Feldnummer#off("i")# 
+  Es wurde eine Nummer als Feldnummer angegeben, die nicht er­
+  laubt ist. 
+ 
+#on("i")#Datei ist keine EUDAS-Datei#off("i")# 
+  Es wurde versucht, eine andere Datei als EUDAS-Datei zu bear­
+  beiten. 
+ 
+#on("i")#inkonsistente EUDAS-Datei#off("i")# 
+  Die interne Struktur der Datei ist zerstört. Kann durch Hardware­
+  probleme (Archiv-Lesefehler) oder EUDAS-interne Fehler ent­
+  standen sein. 
+ 
+#on("i")#EUDAS-Datei voll#off("i")# 
+  Eine EUDAS-Datei kann nur eine bestimmte Anzahl von Sätzen
+  aufnehmen (mindestens 5000). 
+ 
+#on("i")#Nicht erlaubtes Dezimalkomma#off("i")# 
+  Als Dezimalkomma kann nur ein einzelnes Zeichen angegeben
+  werden. 
+ 
+#on("i")#Zuviel Dateien geoeffnet#off("i")# 
+  Es können nicht mehr als 10 Dateien gleichzeitig geöffnet, geket­
+  tet und gekoppelt sein. 
+ 
+#on("i")#Zu viele Felder#off("i")# 
+  Alle geöffneten Dateien zusammen dürfen nicht mehr als 256
+  Felder der virtuellen Datei ergeben. 
+ 
+#on("i")#Zu viele Koppelfelder#off("i")# 
+  Es dürfen insgesamt nicht mehr als 32 Koppelfelder entstehen. 
+ 
+#on("i")#keine Koppelfelder vorhanden#off("i")# 
+  Eine Datei kann nicht gekoppelt werden, wenn Sie kein Koppelfeld
+  besitzt. 
+ 
+#on("i")#keine Datei geoeffnet#off("i")# 
+  Es kann nicht gekettet oder gekoppelt werden, wenn noch keine
+  Datei geöffnet wurde. Ebenfalls sind keine Verarbeitungsproze­
+  duren möglich. 
+ 
+#on("i")#Nicht möglich, wenn auf Koppeldatei geschaltet#off("i")# 
+  Wenn auf eine Koppeldatei umgeschaltet wurde, ist Öffnen, Ketten
+  und Koppeln nicht möglich. 
+ 
+#on("i")#kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien#off("i")# 
+  Wenn Dateien gekettet oder gekoppelt sind, ist Sortieren und
+  Ändern der Feldstruktur nicht möglich. 
+ 
+#on("i")#Datei nicht gesichert#off("i")# 
+  Eine vorher geöffnete Datei ist verändert und nicht gesichert. 
+ 
+#on("i")#Datei wird von anderer Task geändert#off("i")# 
+  Das Öffnen der Datei zum Ändern ist im Moment nicht möglich, da
+  ein anderer Benutzer sie bereits ändert. 
+ 
+#on("i")#Suchmuster zu umfangreich#off("i")# 
+  Ein Suchmuster darf nicht mehr als 100 Vergleiche erfordern. 
+ 
+#on("i")#direkt Drucken nicht moeglich#off("i")# 
+  Entweder ist kein Druckprogramm installiert oder die Spooltask
+  reagiert nicht. 
+ 
+#on("i")#Das Feld "Feldname" ist nicht definiert#off("i")# 
+  Sie haben einen falschen Namen angegeben. 
+ 
+#on("i")#Kein Satz zum Tragen vorhanden#off("i")# 
+  Es wurde versucht, aus einer leeren Datei oder am Dateiende zu
+  tragen. 
+ 
+#on("i")#Zieldatei hat falsche Felderzahl#off("i")# 
+  Eine Zieldatei beim Tragen hat weniger Felder als die aktuelle
+  Datei. Daher würden beim Tragen Informationen verlorengehen. 
+ 
+#on("i")#Zieldatei darf nicht geöffnet sein#off("i")# 
+  Eine geöffnete Datei ist als Zieldatei nicht zulässig. 
+ 
+#on("i")#Das Feld "Feldname" verletzt die Pruefbedingung#off("i")# 
+  Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und
+  die Bedingung war nicht erfüllt. 
+ 
+#on("i")#Das Feld "Feldname" ist nicht in der Wertemenge#off("i")# 
+  Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und
+  die Bedingung war nicht erfüllt. 
+ 
+#on("i")#Das Feld "Feldname" stimmt nicht mit der Maske ueberein#off("i")# 
+  Eine Prüfprozedur wurde außerhalb des Tragens aufgerufen und
+  die Bedingung war nicht erfüllt. 
+ 
+#on("i")#Zu viele Fenster#off("i")# 
+  Es sind nicht mehr als 16 verschiedene Größen von Fenstern
+  möglich. 
+ 
+#on("i")#Fenster zu klein#off("i")# 
+  Ein Menü wurde in einem zu kleinen Fenster aufgerufen. 
+ 
+#on("i")#Hilfe existiert nicht#off("i")# 
+  Es wurde versucht, eine nicht vorhandene Hilfestellung aufzu­
+  rufen. 
+ 
+#on("i")#Hilfe ist leer#off("i")# 
+  Die angewählte Hilfestellung enthält keinen Text. 
+ 
+#on("i")#Anzeigefenster zu klein#off("i")# 
+  Das Anzeigefenster muß mindestens 40 Zeichen breit sein. 
+ 
+#on("i")#Ungueltige Satznummer#off("i")# 
+  Der angegebene Text stellt keine Satznummer dar. 
+ 
+#on("i")#kein rekursiver Aufruf#off("i")# 
+  Innerhalb von EUDAS darf 'eudas' nicht erneut aufgerufen wer­
+  den. 
+ 
+#on("i")#Task existiert nicht#off("i")# 
+  Es wurde versucht, eine nicht existente Task als Manager einzu­
+  stellen. 
+ 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt b/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt
new file mode 100644
index 0000000..a9ac27f
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.inhalt
@@ -0,0 +1,137 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page(3)# 
+#kapitel (" ", " Inhalt", "", " ")# 
+ 
+ 
+ 
+#type ("12")# 
+      Vorwort  . . . . . . . . . . . . . . . . . . .  i 
+      Inhalt . . . . . . . . . . . . . . . . . . . .  iii 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("I.", "FUNKTIONEN ZUM NACHSCHLAGEN", "Funktionen zum Nachschlagen")# 
+ 
+#type ("prop")# 
+#on("b")#1   Zustände und Bedienung#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+1.1   Zustände . . . . . . . . . . . . . . . . . . .  3 
+1.2   Menüs  . . . . . . . . . . . . . . . . . . . .  8 
+1.3   Auswahl  . . . . . . . . . . . . . . . . . . .  8 
+1.4   Hilfe und Dialog . . . . . . . . . . . . . . .  9 
+1.5   Editor . . . . . . . . . . . . . . . . . . . .  9 
+ 
+#type ("prop")# 
+#on("b")#2   Zusammenstellung der Funktionen#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+2.1   Menü 'Öffnen'  . . . . . . . . . . . . . . . .  13 
+2.2   Menü 'Einzelsatz'  . . . . . . . . . . . . . .  17 
+2.3   Menü 'Gesamtdatei' . . . . . . . . . . . . . .  21 
+2.4   Menü 'Drucken' . . . . . . . . . . . . . . . .  23 
+2.5   Menü 'Dateien' . . . . . . . . . . . . . . . .  25 
+2.6   Menü 'Archiv'  . . . . . . . . . . . . . . . .  27 
+2.7   Kurzabfrage  . . . . . . . . . . . . . . . . .  29 
+ 
+#type ("prop")# 
+#on("b")#3   Das virtuelle Dateimodell#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+3.1   Dateistruktur  . . . . . . . . . . . . . . . .  31 
+3.2   Öffnen . . . . . . . . . . . . . . . . . . . .  32 
+3.3   Koppeln  . . . . . . . . . . . . . . . . . . .  33 
+3.4   Änderungen . . . . . . . . . . . . . . . . . .  34 
+3.5   Sichern  . . . . . . . . . . . . . . . . . . .  36 
+3.6   Umschalten auf Koppeldatei . . . . . . . . . .  36 
+3.7   Mehrbenutzerbetrieb  . . . . . . . . . . . . .  37 
+ 
+#type ("prop")# 
+#on("b")#4   Ansehen und Bearbeiten#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+4.1   Anzeige  . . . . . . . . . . . . . . . . . . .  39 
+4.2   Satzauswahl  . . . . . . . . . . . . . . . . .  42 
+4.3   Sortieren und Reorganisieren . . . . . . . . .  44 
+4.4   Bearbeiten . . . . . . . . . . . . . . . . . .  46 
+ 
+#type ("prop")# 
+#on("b")#5   Drucken und Druckmuster#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+5.1   Druckmustersyntax  . . . . . . . . . . . . . .  49 
+5.2   Der Druckvorgang . . . . . . . . . . . . . . .  51 
+5.3   Interpretation von Musterzeilen  . . . . . . .  52 
+5.4   Anschluß zum ELAN-Compiler . . . . . . . . . .  56 
+5.5   Fehlermeldungen  . . . . . . . . . . . . . . .  57 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("II.", "EUDAS FÜR PROGRAMMIERER", "EUDAS für Programmierer")# 
+ 
+#type ("prop")# 
+#on("b")#6   Struktur von EUDAS-Dateien#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+6.1   Der Datentyp SATZ  . . . . . . . . . . . . . .  61 
+6.2   Der Datentyp EUDAT . . . . . . . . . . . . . .  63 
+6.3   Satzposition . . . . . . . . . . . . . . . . .  64 
+6.4   Satzzugriffe . . . . . . . . . . . . . . . . .  65 
+6.5   Sortieren und Reorganisieren . . . . . . . . .  66 
+6.6   EUDAS-Dateien als Assoziativspeicher . . . . .  68 
+ 
+#type ("prop")# 
+#on("b")#7   Verwaltung der offenen Dateien#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+7.1   Dateiverwaltung  . . . . . . . . . . . . . . .  71 
+7.2   Feldstruktur . . . . . . . . . . . . . . . . .  75 
+7.3   Positionierung . . . . . . . . . . . . . . . .  77 
+7.4   Änderungen . . . . . . . . . . . . . . . . . .  78 
+7.5   Suchbedingungen  . . . . . . . . . . . . . . .  79 
+ 
+#type ("prop")# 
+#on("b")#8   Funktionen zur Bearbeitung#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+8.1   Drucken  . . . . . . . . . . . . . . . . . . .  83 
+8.2   Kopieren . . . . . . . . . . . . . . . . . . .  85 
+8.3   Tragen . . . . . . . . . . . . . . . . . . . .  87 
+8.4   Verarbeitung . . . . . . . . . . . . . . . . .  89 
+8.5   Funktionen in Ausdrücken . . . . . . . . . . .  90 
+ 
+#type ("prop")# 
+#on("b")#9   Anzeige#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+9.1   Fensterverwalter . . . . . . . . . . . . . . .  93 
+9.2   Anzeigegrundfunktionen . . . . . . . . . . . .  94 
+9.3   Editorfunktionen . . . . . . . . . . . . . . .  95 
+ 
+#type ("prop")# 
+#on("b")#10  Programmierung der Menüs#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+10.1  Menüformat . . . . . . . . . . . . . . . . . .  97 
+10.2  Verwaltung der Menüs . . . . . . . . . . . . .  99 
+10.3  Aufruf . . . . . . . . . . . . . . . . . . . .  101 
+10.4  Dialog . . . . . . . . . . . . . . . . . . . .  103 
+ 
+#type ("prop")# 
+#on("b")#11  Programmierung von Anwendungen#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+11.1  Musterprogramme  . . . . . . . . . . . . . . .  105 
+11.2  Dateianwendungen . . . . . . . . . . . . . . .  109 
+11.3  Integrierte Anwendungen  . . . . . . . . . . .  111 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("III.", "ANHANG", "Anhang")# 
+ 
+#type ("12")# 
+      Fehlermeldungen  . . . . . . . . . . . . . . .  115 
+      Prozeduren mit Parametern  . . . . . . . . . .  119 
+      Register . . . . . . . . . . . . . . . . . . .  125 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.macros b/app/eudas/4.4/doc/ref-manual/eudas.ref.macros
new file mode 100644
index 0000000..e86794e
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.macros
@@ -0,0 +1,70 @@
+#*format# 
+#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# 
+#:firsthead (false)# 
+#linefeed (1.07)# 
+#*macro end# 
+#*text# 
+#type ("prop10")# 
+#linefeed (1.07)# 
+#*macro end# 
+#*beispiel# 
+#type ("12")# 
+#linefeed (0.97)# 
+#*macro end# 
+#*bildschirm# 
+#type ("15")# 
+#linefeed(0.83)# 
+#*macro end# 
+#*proc# 
+#type ("12")# 
+#*macro end# 
+#*endproc# 
+#free (0.1)# 
+#type ("prop10")# 
+#linefeed (1.07)# 
+#*macro end# 
+#*abschnitt ($1,$2,$3)# 
+#headodd# 
+#on("b")#$1#right#$3    %#off("b")# 
+#free (1.0)# 
+#end# 
+#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# 
+#*macro end# 
+#*char($1)# 
+$1
+#*macro end# 
+#*kapitel ($1,$2,$3,$4)# 
+#free (1.3)# 
+#"nlq"# 
+#type("roman.24")# 
+#on("b")##center#$1#off("b")# 
+#free (0.2)# 
+#type ("roman.18")# 
+#on("b")##center#$2 #off("b")# 
+#on("b")##center# $3#off("b")# 
+#on("b")##center#$4#off("b")# 
+#type ("prop10")# 
+#free (0.6)# 
+#headeven# 
+#on("b")#%    $2 $3 $4#off("b")# 
+#free (1.0)# 
+#end# 
+#headodd# 
+#right##on("b")#%#off("b")# 
+#free (1.0)# 
+#end# 
+#*macro end# 
+#*f2# 
+#free (0.2)# 
+#*macro end# 
+#*a ($1)# 
+#on("b")#$1.#off("b")# 
+#*macro end# 
+#*bsp ($1)# 
+#type("12")#$1#type("prop")#
+#*macro end# 
+#*f1# 
+#free (0.1)# 
+#*macro end# 
+
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.proz b/app/eudas/4.4/doc/ref-manual/eudas.ref.proz
new file mode 100644
index 0000000..7ec9b50
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.proz
@@ -0,0 +1,195 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (119)# 
+#kapitel (" ", "Prozeduren", "mit", "Parametern")# 
+ 
+ 
+ 
+#beispiel# 
+:= (SATZ VAR, SATZ CONST)                                   6.1 
+ 
+aendern (PROC hilfe)                                        9.3 
+aendern erlaubt : BOOL                                      7.1 
+aenderungen eintragen                                       7.4 
+anzahl dateien : INT                                        7.1 
+anzahl felder : INT                                         7.2 
+anzahl koppeldateien : INT                                  7.1 
+anzeigefenster (INT CONST x anf, y anf, 
+                          x laenge, y laenge)               9.2 
+auf satz (EUDAT VAR, INT CONST satznr)                      6.3 
+auf satz (EUDAT VAR, TEXT CONST muster)                     6.3 
+auf satz (INT CONST satznr)                                 7.3 
+ausfuehrtaste (TEXT CONST taste)                           10.3 
+auswahl anbieten (TEXT CONST name, FENSTER CONST f, 
+                  TEXT CONST hilfe, 
+                  PROC (TEXT VAR, INT CONST) inhalt)       10.3 
+ 
+bild ausgeben (BOOL CONST datei veraendert)                 9.2 
+bildschirm neu                                              9.1 
+ 
+dateiende (EUDAT CONST) : BOOL                              6.3 
+dateiende : BOOL                                            7.3 
+dateien loeschen (BOOL CONST auch geaenderte)               7.1 
+dateiversion : INT                                          7.1 
+dezimalkomma (TEXT CONST komma)                             6.5 
+dezimalkomma : TEXT                                         6.5 
+dialog                                                     10.4 
+dialogfenster (INT CONST x anf, y anf, 
+                         x laenge, y laenge)               10.4 
+direkt drucken (BOOL CONST ja)                              8.1 
+druckdatei (TEXT CONST dateiname)                           8.1 
+drucke (TEXT CONST mustername)                              8.1 
+ 
+editget (TEXT CONST prompt, TEXT VAR eingabe, 
+         TEXT CONST res, hilfe)                            10.4 
+eindeutige felder (INT CONST anzahl)                        8.3 
+einfuegen (PROC hilfe)                                      9.3 
+eudas dateiname (INT CONST dateinr) : TEXT                  7.1 
+EUDAT                                                       6.2 
+exit durch (TEXT CONST exit zeichen)                        9.3 
+exit durch : TEXT                                           9.3 
+ 
+f (TEXT CONST feldname) : TEXT                              8.5 
+fehler ausgeben                                            10.4 
+feld aendern (SATZ VAR, INT CONST feldnr, 
+              TEXT CONST inhalt)                            6.1 
+feld aendern (EUDAT VAR, INT CONST feldnr, 
+              TEXT CONST inhalt)                            6.4 
+feld aendern (INT CONST feldnr, TEXT CONST inhalt)          7.2 
+feldauswahl (TEXT CONST feldcodes)                          9.2 
+feld bearbeiten (SATZ CONST, INT CONST feldnr, 
+  PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)        6.1 
+feld bearbeiten (EUDAT CONST, INT CONST feldnr, 
+  PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)        6.4 
+feld bearbeiten (INT CONST feldnr, 
+  PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)        7.2 
+felderzahl (SATZ CONST) : INT                               6.1 
+felderzahl (EUDAT CONST) : INT                              6.2 
+feldindex (SATZ CONST, TEXT CONST muster) : INT             6.1 
+feldinfo (EUDAT VAR, INT CONST feldnr, info)                6.5 
+feldinfo (EUDAT CONST, INT CONST feldnr) : INT              6.5 
+feld lesen (SATZ CONST, INT CONST feldnr, 
+            TEXT VAR inhalt)                                6.1 
+feld lesen (EUDAT CONST, INT CONST feldnr, 
+            TEXT VAR inhalt)                                6.4 
+feld lesen (INT CONST feldnr, TEXT VAR inhalt)              7.2 
+feldmaske (TEXT CONST feldname, maske)                      8.3 
+feldnamen aendern (EUDAT VAR, SATZ CONST namen)             6.2 
+feldnamen bearbeiten (INT CONST feldnr, 
+  PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)        7.2 
+feldnamen lesen (EUDAT CONST, SATZ VAR namen)               6.2 
+feldnamen lesen (INT CONST feldnr, TEXT VAR name)           7.2 
+feldnummer (TEXT CONST feldname) : INT                      7.2 
+FENSTER                                                     9.1 
+fenstergroesse (FENSTER CONST f, 
+                INT VAR x anf, y anf, 
+                        x laenge, y laenge)                 9.1 
+fenstergroesse setzen (FENSTER VAR fenster, 
+                       INT CONST x anf, y anf, 
+                                 x laenge, y laenge)        9.1 
+fenster initialisieren (FENSTER VAR fenster)                9.1 
+fenster veraendert (FENSTER CONST fenster)                  9.1 
+fensterzugriff (FENSTER CONST fenster, 
+                BOOL VAR veraendert)                        9.1 
+ 
+global manager                                             10.2 
+gruppenwechsel (INT CONST gruppennr) : BOOL                 8.1 
+ 
+hilfe anbieten (TEXT CONST name, FENSTER CONST f)          10.3 
+hole satz (TEXT CONST dateiname)                            8.3 
+ 
+inhalt veraendert (INT CONST dateinr) : BOOL                7.1 
+ja (TEXT CONST frage, hilfe) : BOOL                        10.4 
+ 
+K (TEXT CONST feldname, ausdruck)                           8.2 
+kette (TEXT CONST dateiname)                                7.1 
+kopiere (TEXT CONST dateiname, FILE VAR muster)             8.2 
+kopiere (TEXT CONST dateiname, PROC kopierfunktion)         8.2 
+kopple (TEXT CONST dateiname)                               7.1 
+ 
+lfd nr : TEXT                                               8.1 
+ 
+markierte saetze : INT                                      7.5 
+markierung aendern                                          7.5 
+markierungen loeschen                                       7.5 
+maxdruckzeilen (INT CONST anzahl zeilen)                    8.1 
+menue anbieten (ROW 6 TEXT CONST menuenamen, 
+                FENSTER VAR f, 
+                BOOL CONST esc erlaubt, 
+                PROC (INT CONST, INT CONST) interpreter)   10.3 
+menuedaten einlesen (TEXT CONST dateiname)                 10.2 
+menue loeschen (TEXT CONST name, INT CONST index)          10.2 
+menue loeschen (BOOL CONST hilfen reduzieren)              10.2 
+menue manager (DATASPACE VAR ds, 
+               INT CONST order, phase, 
+               TASK CONST order task)                      10.2 
+menuenamen (INT CONST index) : THESAURUS                   10.2 
+ 
+neuer dialog                                               10.4 
+notizen aendern (EUDAT VAR, INT CONST notiz nr, 
+                 TEXT CONST notizen)                        6.2 
+notizen lesen (EUDAT CONST, INT CONST notiz nr, 
+               TEXT VAR notizen)                            6.2 
+ 
+oeffne (EUDAT VAR, TEXT CONST dateiname)                    6.2 
+oeffne (TEXT CONST dateiname, 
+        BOOL CONST aendern erlaubt)                         7.1 
+ 
+pruefe (TEXT CONST feldname, BOOL CONST bedingung)          8.3 
+ 
+reorganisiere (TEXT CONST dateiname)                        6.5 
+rollen (INT CONST anzahl)                                   9.2 
+ 
+saetze (EUDAT CONST) : INT                                  6.3 
+SATZ                                                        6.1 
+satz aendern (EUDAT VAR, SATZ CONST neuer satz)             6.4 
+satz ausgewaehlt : BOOL                                     7.5 
+satz einfuegen (EUDAT VAR, SATZ CONST satz)                 6.4 
+satz einfuegen                                              7.4 
+satz initialisieren (SATZ VAR satz)                         6.1 
+satzkombination : INT                                       7.3 
+satz lesen (EUDAT CONST, SATZ VAR satz)                     6.4 
+satz loeschen (EUDAT VAR)                                   6.4 
+satz loeschen                                               7.4 
+satz markiert : BOOL                                        7.5 
+satznr (EUDAT CONST) : INT                                  6.3 
+satznummer : INT                                            7.3 
+sichere (INT CONST dateinr, TEXT CONST dateiname)           7.1 
+sortiere (EUDAT VAR, TEXT CONST reihenfolge)                6.5 
+sortiere (EUDAT VAR)                                        6.5 
+sortierreihenfolge (EUDAT CONST) : TEXT                     6.5 
+status anzeigen (TEXT CONST zeile)                         10.3 
+std kopiermuster (TEXT CONST dateiname, FILE VAR f)         8.2 
+suchbedingung (INT CONST feldnr, 
+               TEXT CONST bedingung)                        7.5 
+suchbedingung loeschen                                      7.5 
+suchen (PROC hilfe)                                         9.3 
+ 
+textdarstellung (TEXT CONST text) : TEXT                    8.5 
+trage (TEXT CONST dateiname, FILE VAR protokoll, 
+       BOOL CONST test)                                     8.3 
+trage satz (TEXT CONST dateiname)                           8.3 
+ 
+unsortierte saetze (EUDAT CONST) : INT                      6.5 
+ 
+V (TEXT CONST feldname, ausdruck)                           8.4 
+verarbeite (FILE VAR verarbeitungsmuster)                   8.4 
+verarbeite (PROC verarbeitungsfunktion)                     8.4 
+ 
+waehlbar (INT CONST menuenr, funktionsnr, 
+          BOOL CONST moeglich)                             10.3 
+wahl (INT CONST stelle) : INT                              10.3 
+weiter (EUDAT VAR)                                          6.3 
+weiter (EUDAT VAR, TEXT CONST muster)                       6.3 
+weiter (INT CONST modus)                                    7.3 
+wert (TEXT CONST feldname) : REAL                           8.5 
+wert (TEXT CONST feldname, INT CONST kommastellen) : REAL   8.5 
+wertemenge (TEXT CONST feldname, menge)                     8.3 
+ 
+zahltext (REAL CONST wert, INT CONST kommastellen) : TEXT   8.5 
+zahltext (TEXT CONST feldname, 
+          INT CONST kommastellen) : TEXT                    8.5 
+zurueck (EUDAT VAR)                                         6.3 
+zurueck (EUDAT VAR, TEXT CONST muster)                      6.3 
+zurueck (INT CONST modus)                                   7.3 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.reg b/app/eudas/4.4/doc/ref-manual/eudas.ref.reg
new file mode 100644
index 0000000..61ebef9
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.reg
@@ -0,0 +1,426 @@
+#type ("prop")##limit (6.5)# 
+#format# 
+#page (125)# 
+#kapitel (" ", "Register ", "", " ")# 
+ 
+ 
+ 
+#columns (2, 0.5)# 
+#limit (6.5)# 
+ABKUERZUNGEN-Anweisung 49 
+Abkürzungsteil 49 
+Abkürzungsverzeichnis 68 
+Abkürzungszeile 50 
+Abschlußzeile 39 
+aendern 96 
+Ändern 10, 19 
+  -, nach Vorschrift 48 
+aendern erlaubt 74 
+Änderungen 34 
+aenderungen eintragen 79 
+Änderungsmuster 21 
+Alternative 43 
+Ankreuzen 8 
+anzahl dateien 74 
+anzahl felder 75 
+anzahl koppeldateien 74 
+Anzeige 39, 93 
+anzeigefenster 95 
+Arbeitskopie 13, 32 
+  -, löschen 15, 36 
+  -, sichern 15, 36 
+Archivmanager 28 
+  -, reservieren 29 
+Archiv (Menü) 27 
+Archivübersicht drucken 27 
+Assoziativspeicher 68 
+auf koppeldatei 74 
+Aufräumen 26 
+auf satz 65, 78 
+Auf Satz Nr. 17 
+Ausdrucken 24 
+Ausführen 8 
+ausfuehrtaste 8, 102 
+AUSWAHL 97 
+AUSWAHL: 4 
+Auswahl 8 
+  -, Format 98 
+auswahl anbieten 103 
+ 
+Bearbeiten 46 
+BILD 97 
+bild ausgeben 95 
+bildschirm neu 94 
+ 
+Datei, aufräumen 26 
+  -, kopieren (logisch) 25 
+  -, kopieren vom Archiv 27 
+  -, löschen 25 
+  -, löschen auf Archiv 28 
+  -, Platzbedarf 26 
+  -, reorganisieren 26 
+  -, schreiben auf Archiv 27 
+  -, umbenennen 25 
+  -, virtuelle 32, 71 
+Dateianwendungen 109 
+Dateien Archiv, Übersicht 27 
+dateiende 64, 78 
+dateien loeschen 74 
+Dateien (Menü) 25 
+Dateien System, Übersicht 25 
+Dateilimit 52 
+Dateimanager 28 
+Dateiname 40 
+dateiversion 75 
+DATUM 45 
+Dezimalkomma 45 
+dezimalkomma 67 
+dialog 104 
+Dialog 9, 103 
+dialogfenster 104 
+DIN 45 
+direkt drucken 83f. 
+Druckausgabe, Richtung 23 
+druckdatei 85 
+drucke 84 
+Drucken 23, 49, 83 
+  -, Archivübersicht 27 
+Drucken (Menü) 23 
+Druckmuster 23, 49, 83 
+  -, Fehler 56 
+Druckvorgang 51 
+ 
+editget 104 
+EDITIEREN: 6 
+Editieren 23 
+  -, Zeile 9 
+Editor 9, 29 
+eindeutige felder 47, 89 
+einfuegen 96 
+Einfügen 10, 19 
+  -, Satz 36 
+  -, Zeile 10 
+EINGABE: 4 
+Eingabe 9 
+Einzelsatz (Menü) 17 
+ELAN-Compiler 56 
+ELAN-Kommandos 8 
+ENDE 97 
+Endekennzeichnung 40 
+ESC '?' 6 
+ESC '9' 4 
+ESC '1' 4 
+ESC '?' 4 
+ESC '?' 3 
+ESC 'D' 5 
+ESC ESC 3 
+ESC 'F' 5f. 
+ESC 'g' 5 
+ESC 'h' 4ff. 
+ESC 'K' 36 
+ESC OBEN 5 
+ESC 'p' 5 
+ESC 'q' 4, 6 
+ESC RUBIN 5 
+ESC RUBOUT 5 
+ESC UNTEN 5 
+ESC 'w' 4f. 
+ESC 'z' 4f. 
+eudas 29 
+EUDAS: 3 
+EUDAS-Datei, aufspalten 110 
+  -, drucken 23, 49, 83 
+  -, einrichten 13 
+  -, ketten 14, 32 
+  -, kopieren 21, 46, 85 
+  -, koppeln 14, 32 
+  -, nach Vorschrift ändern 48 
+  -, öffnen 13, 32 
+  -, reorganisieren 67 
+  -, sortieren 22 
+  -, Struktur 31, 61 
+  -, tragen 46, 87 
+  -, Übersicht 22 
+  -, verändern 21 
+eudas dateiname 75 
+EUDAT 61, 63, 109 
+EUMEL-Netz 28 
+exit durch 96 
+ 
+f 91 
+FEHLER 5 
+fehler ausgeben 104 
+Feld 31 
+FELD 98 
+feld aendern 62, 65, 76 
+Feldauswahl 20, 41, 95 
+feld bearbeiten 62, 65, 76 
+felderzahl 62, 63 
+feldindex 62 
+feldinfo 66, 77 
+Feldinhalt 31, 39 
+feld lesen 65, 76 
+feldmaske 47, 89 
+Feldmuster 53 
+Feldname 31, 39 
+  -, ändern 16 
+  -, anfügen 16 
+feldnamen aendern 63 
+feldnamen bearbeiten 76 
+feldnamen lesen 64, 76 
+feldnummer 76 
+Feldstruktur 15 
+Feldtyp 31, 42 
+Feldtypen 45, 66 
+  -, ändern 16 
+Feldvergleich 43 
+Fenster 93 
+fenstergroesse 94 
+fenstergroesse setzen 93 
+fenster initialisieren 93 
+fenster veraendert 94 
+fensterzugriff 94 
+folgedatei 75 
+Folgezeilen 41 
+Formular 39 
+FRAGE: 5 
+Fragen 9 
+Funktion, ausführen 8 
+  -, gesperrte 8 
+ 
+Gesamtdatei (Menü) 21 
+Gib Kommando: 6 
+global manager 36, 100 
+Gruppe 51 
+GRUPPE-Anweisung 49 
+gruppenwechsel 51, 85 
+ 
+Hauptdatei 32 
+HILFE: 4 
+HILFE 97, 99 
+Hilfe 9 
+  -, Format 98 
+hilfe anbieten 103 
+Holen 19 
+hole satz 89 
+HOP LINKS 4 
+HOP 'o' 4 
+HOP OBEN 3ff. 
+HOP RECHTS 4 
+HOP RETURN 4 
+HOP RUBOUT 4 
+HOP UNTEN 3ff. 
+HOP 'x' 4 
+ 
+inhalt veraendert 74 
+Initialisieren 28 
+Initialisierungsteil 49 
+ 
+ja 104 
+ 
+K 46, 86 
+kette 73 
+Ketten 14, 32 
+Klassenwechsel 106 
+Kombinationen 34 
+Kommandos 8 
+Kommandozeile 50 
+kopiere 86 
+Kopieren 21, 46, 85 
+Kopieren (logisch) 25 
+Kopieren vom Archiv 27 
+Kopiermuster 21, 46 
+KOPPEL 40 
+Koppeldatei, umschalten auf 36 
+Koppelfelder 33 
+Koppeln 14, 32f. 
+kopple 72 
+Kurzabfrage 29 
+ 
+LEER 3f. 
+Leertaste 8 
+lfd nr 85 
+lineform 24 
+LINKS 3f. 
+Literaturangaben 108 
+Löschen 25 
+  -, Satz 36 
+  -, Zeile 10 
+Löschen auf Archiv 28 
+ 
+Manager 13 
+Manager (Mehrbenutzer) 16, 36 
+markierte saetze 81 
+Markierung 18, 40, 42 
+markierung aendern 81 
+Markierungen löschen 22 
+markierungen loeschen 81 
+maxdruckzeilen 85 
+MEHR-Anweisung 50 
+MENUE 97 
+Menü 8 
+  -, Aufruf 101 
+  -, Verwaltung 99 
+menue anbieten 101 
+menuedaten einlesen 99 
+Menüformat 97 
+menue loeschen 100 
+menue manager 100 
+menuenamen 100 
+Modi 55 
+MODUS-Anweisung 50 
+Musterprogramme 105 
+Musterteil 50 
+Musterzeichen 53 
+Musterzeile 50 
+  -, Interpretation 52 
+ 
+Nachbearbeiten 24 
+Nachspann 49 
+NACHSPANN-Anweisung 49 
+Namenskonflikte 33 
+neuer dialog 104 
+Normalmodus 55 
+Notizen 15, 31, 64 
+notizen aendern 64, 77 
+notizen lesen 64, 77 
+ 
+'o' 4 
+OBEN 3f. 
+ODER-Verknüpfung 43 
+oeffne 63, 72 
+Öffnen 32 
+Öffnen (Menü) 13 
+ 
+pageform 24 
+Paralleleditor 56, 83 
+Paßwort 29 
+Platzbedarf 26 
+Positionieren 17, 31, 64, 77 
+Priorität 44 
+Programmzeile 51 
+Protokolldatei 47 
+Prüfbedingungen 16, 31, 47, 64,
+   87 
+pruefe 47, 88 
+Pufferplatz 54 
+ 
+RECHTS 3f. 
+Refinement 56 
+reorganisiere 67 
+Reorganisieren 26, 45, 67 
+Reservieren 29 
+RETURN 4 
+Richtung Druckausgabe 23 
+rollen 95 
+Rollen 41 
+RUBIN 4 
+RUBOUT 4 
+ 
+saetze 64 
+SATZ 61 
+Satz 31 
+satz aendern 66 
+satz ausgewaehlt 80 
+Satzauswahl 42 
+Satzeditor 9 
+satz einfuegen 66, 79 
+Satzformular 39 
+satz initialisieren 62 
+satzkombination 77 
+satz lesen 66 
+satz loeschen 66, 79 
+satz markiert 81 
+satznr 64 
+satznummer 77 
+Satznummer 39 
+Satzposition 64 
+Satzzeiger 31 
+Satzzugriffe 65 
+Schreiben auf Archiv 27 
+SEITE 99 
+sichere 73 
+Sichern 15, 36 
+sortiere 67 
+Sortieren 22, 31, 44, 66 
+Sortierreihenfolge 31, 44 
+sortierreihenfolge 67 
+Sortierzustand 45 
+Spaltendruck 52 
+Sperre 36 
+Standard-Kopiermuster 21, 46 
+status anzeigen 103 
+Statuszeile 3 
+std kopiermuster 87 
+Suchbedingung 17, 39, 42 
+  -, löschen 18 
+  -, setzen 18 
+suchbedingung 80 
+suchbedingung lesen 80 
+suchbedingung loeschen 80 
+suchen 96 
+Suchen, Optimierung 44 
+Suchmuster 42 
+  -, eingeben 10 
+ 
+Tabellenmodus 55 
+Tasten 3 
+Tastenfunktionen 3 
+TEXT 45 
+textdarstellung 91 
+Textdatei, ausdrucken 24 
+  -, editieren 23 
+  -, nachbearbeiten 24 
+Textzeile 49f. 
+trage 88 
+Tragen 16, 19, 21, 46, 87 
+trage satz 88 
+ 
+uebersicht 95 
+uebersichtsfenster 95 
+Umbenennen 25 
+Umbruch 40, 55 
+Umschalten auf Koppeldatei 36 
+UND-Verknüpfung 43 
+unsortierte saetze 67 
+UNTEN 3f. 
+Überschrift 39 
+Übersicht 22, 41 
+Übersicht Dateien Archiv 27 
+Übersicht Dateien System 25 
+ 
+V 48, 90 
+Verändern 21 
+verarbeite 90 
+Verarbeitung 89 
+Verknüpfung von Bedingungen
+43 
+virtuelle Datei 32, 71 
+VORSPANN 98 
+Vorspann 49 
+VORSPANN-Anweisung 49 
+ 
+waehlbar 102 
+wahl 103 
+Warten 6 
+weiter 65, 78 
+Weiter 17 
+wert 91 
+wertemenge 47, 88 
+WIEDERHOLUNG-Anweisung 49 
+Wiederholungsteil 49 
+ 
+'x' 4 
+ 
+ZAHL 45 
+zahltext 91 
+Zeichen, reservierte 44 
+ZEIGEN: 6 
+Zeilenende 54 
+Zeilenwiederholung 55 
+Zielarchiv 28 
+Zurück 17 
+zurueck 65, 78 
+Zustand 3 
+Zustandsübergänge 7 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.titel b/app/eudas/4.4/doc/ref-manual/eudas.ref.titel
new file mode 100644
index 0000000..289de34
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.titel
@@ -0,0 +1,68 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#free (6.0)# 
+#type ("roman.18")# 
+#on("b")#EUDAS#off("b")# 
+#free (1.0)# 
+#type ("roman.14")# 
+#on("b")#Anwender-#off("b")# 
+#on("b")#Datenverwaltungssystem#off("b")# 
+#free (2.0)# 
+#type ("10")# 
+#on ("b")#VERSION 4#off("b")# 
+#free(1.0)# 
+#on("u")#                                                    #off("u")# 
+#free (0.5)# 
+#on("b")#REFERENZHANDBUCH#off("b")# 
+#type ("prop")##block# 
+#page# 
+#free (9.5)# 
+Hergestellt mit Hilfe der EUMEL-Textverarbeitung und des Pro­
+gramms FontMaster der Martin Schönbeck GmbH. 
+#free (1.7)# 
+Ausgabe September 1987 
+ 
+Dieses Handbuch und das zugehörige Programm sind urheberrechtlich
+geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­
+vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. 
+ 
+Es kann keine Garantie dafür übernommen werden, daß das Pro­
+gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­
+tung dafür liegt beim Kunden. 
+ 
+Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­
+heit und Vollständigkeit der Angaben wird aber keine Gewähr über­
+nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert
+werden. 
+ 
+(c) Copyright 1987  Thomas Berlage 
+                    Software-Systeme 
+                    Im alten Keller 3 
+#free (0.1)# 
+                    D-5205 Sankt Augustin 1 
+#page# 
+#type ("roman.24")# 
+#free (7.0)# 
+#center##on("b")#I.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#FUNKTIONEN#off("b")# 
+#center##on("b")#ZUM#off ("b")# 
+#center##on("b")#NACHSCHLAGEN#off("b")# 
+#page# 
+#type ("roman.24")# 
+#free (7.0)# 
+#center##on("b")#II.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#EUDAS#off("b")# 
+#center##on("b")#FÜR#off ("b")# 
+#center##on("b")#PROGRAMMIERER#off("b")# 
+#page# 
+#free (7.0)# 
+#type ("roman.24")# 
+#center##on("b")#III.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#ANHANG#off("b")# 
+
diff --git a/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort b/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort
new file mode 100644
index 0000000..f3880f4
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/eudas.ref.vorwort
@@ -0,0 +1,29 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (1)# 
+#kapitel (" ", "Vorwort", " ", " ")# 
+ 
+ 
+ 
+Lieber EUDAS-Benutzer! 
+ 
+Dies ist das zweite Handbuch, das Sie zu EUDAS bekommen. Wenn
+Sie sich mit EUDAS noch nicht auskennen, sollten Sie zunächst das
+#on("i")#Benutzerhandbuch#off("i")# zu Rate ziehen, ehe Sie in dieses Handbuch
+schauen. 
+ 
+    Das #on("i")#Referenzhandbuch#off("i")# ist in zwei Teile geteilt. Im ersten Teil
+finden Sie eine Übersicht über alle EUDAS-Funktionen (im Kapitel
+2) sowie zusammengefaßte Informationen über die Bedienung (Kapi­
+tel 1) und die genaue Wirkung der einzelnen Funktionen (Kapitel 3
+bis 5). Dieser Teil soll Ihnen zum Nachschlagen dienen, wenn Sie
+eine bestimmte Information suchen. 
+    Im zweiten Teil sind alle Informationen zusammengefaßt, die
+ein Programmierer zur Benutzung der EUDAS-Funktionen braucht. Es
+sei an dieser Stelle jedoch davon abgeraten, sofort eigene Program­
+me zu schreiben, da sich in vielen Fällen die gleiche Wirkung auch
+durch Programmierung innerhalb von EUDAS-Funktionen erreichen
+läßt (zum Beispiel in Druck- und Änderungsmustern). 
+    Im Zweifelsfall orientieren Sie sich anhand von Kapitel 11, wie
+Sie Ihr Problem am besten lösen können. 
+
diff --git a/app/eudas/4.4/doc/ref-manual/ref.abb.1-1 b/app/eudas/4.4/doc/ref-manual/ref.abb.1-1
new file mode 100644
index 0000000..bc70722
--- /dev/null
+++ b/app/eudas/4.4/doc/ref-manual/ref.abb.1-1
@@ -0,0 +1,58 @@
+#type ("prop")##limit (13.5)# 
+#start (3.5, 5.0)# 
+#lpos (0.5)##c pos (3.5)##c pos (4.7)##cpos (7.0)##c pos (10.5)# 
+#table# 
+         eudas   ESC q    
+ 
+      ESC ESC     ESC h 
+#free (0.2)# 
+#type ("roman.12")# 
+GIB KDO:        EUDAS    
+#type ("prop")# 
+#free (0.2)# 
+      ESC h       
+    RET           LEER  'Buchst.'    
+ 
+            ESC q           
+ 
+#type ("roman.12")# 
+            FEHLER 
+ 
+ 
+   WARTEN          
+#type ("prop")# 
+         n, j    
+#type ("roman.12")# 
+            FRAGE 
+#type ("prop")# 
+ 
+         RET    
+#type ("roman.12")# 
+            EINGABE 
+#type ("prop")# 
+#linefeed (0.5)# 
+ 
+ 
+            ESC z           
+         ESC q    
+#linefeed (1.0)# 
+#type ("roman.12")# 
+            AUSWAHL 
+#type ("prop")# 
+ 
+         ESC q    
+#type ("roman.12")# 
+            EDITIEREN 
+#type ("prop")# 
+ 
+         ESC q    
+#type ("roman.12")# 
+            SATZEDITOR 
+#type ("prop")# 
+ESC ?   ESC q             
+         ESC q    
+#type ("roman.12")# 
+HILFE           ZEIGEN 
+#type ("prop")# 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.1 b/app/eudas/4.4/doc/user-manual/eudas.hdb.1
new file mode 100644
index 0000000..0c6871b
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.1
@@ -0,0 +1,254 @@
+#type ("prop10")##limit (14.0)# 
+#page (3)# 
+#format# 
+#kapitel ("1", "Was", "kann", "EUDAS ?")# 
+ 
+ 
+ 
+In diesem Kapitel wollen wir Ihnen erklären, was EUDAS Ihnen ei­
+gentlich bringen soll. Sie arbeiten sicher nicht nur aus Spaß am
+Computer, sondern wollen ihn für bestimmte Aufgaben einsetzen. Ein
+Computer kann bestimmte Aufgaben nur dann bearbeiten, wenn er
+dafür programmiert worden ist. 
+    EUDAS ist nun ein Programm, das allgemein Aufgaben der Da­
+tenverwaltung lösen kann. Zunächst wollen wir Ihnen erläutern,
+wodurch dieses Anwendungsgebiet genau charakterisiert wird. 
+ 
+ 
+#abschnitt ("1.1", "TEXTVERARBEITUNG UND DATENVERWALTUNG", "Textverarbeitung und Datenverwaltung")# 
+ 
+Es gibt zwei Einsatzbereiche des Computers, die von fast jedem An­
+wender benötigt werden, egal auf welchem Spezialgebiet er tätig ist:
+nämlich die #on("i")#Textverarbeitung#off("i")# und die #on("i")#Datenverwaltung#off("i")#. Durch die
+Unterscheidung dieser beiden Bereiche werden die charakteristi­
+schen Merkmale der Datenverwaltung abgegrenzt. 
+ 
+#a ("Textverarbeitung")# Die Textverarbeitung befaßt sich damit, einen
+beliebigen Text auf einem Rechner zu erfassen und anschließend
+über einen Drucker wieder auszugeben. Der Sinn dieser Arbeit liegt
+darin, daß man einen einmal eingegebenen Text sehr einfach ändern
+kann. Außerdem kann der Computer einige unangenehme Aufgaben
+übernehmen, die beim Schreiben von Texten auftreten: die Auftei­
+lung auf Zeilen und Seiten, die Seitennumerierung und vieles mehr. 
+    Charakteristisch für die Textverarbeitung ist, daß der Einfluß
+des Computers sich auf kosmetische Details beschränkt. Die Spei­
+cherung und eventuelle Aufbereitung zum Drucken haben praktisch
+nichts mit dem Inhalt des Textes zu tun. Dies wäre für den Rechner
+auch sehr schwierig, da die im Text enthaltenen Informationen in
+menschlicher Sprache vorliegen, die für einen Rechner nicht ver­
+ständlich ist. 
+ 
+#a ("Datenverwaltung")# Bei der Datenverwaltung werden ebenfalls textu­
+elle Informationen gespeichert, diese liegen aber in einer aufberei­
+teten Form vor, die einen Teil des Inhalts für den Computer ver­
+ständlich macht. Bei der Datenverwaltung werden Objekte betrach­
+tet, die verschiedene Eigenschaften haben können. Ein solches
+Objekt kann z.B. eine Person sein. Als Eigenschaften werden mit
+dieser Person zusammenhängende Informationen betrachetet, die für
+die jeweilige Anwendung wichtig sind. 
+    Ein Beispiel für eine solche Betrachtungsweise ist der Arbeit­
+nehmer im Betrieb. Einige der typischerweise erfaßten Daten sind
+Name, Adresse, Telefon, Geburtsdatum und Geschlecht. Alle diese
+Daten sind Eigenschaften oder #on("i")#Attribute#off("i")#, die einem bestimmten
+Menschen mehr oder weniger fest zugeordnet sind. 
+    Die Betonung inhaltlicher Beziehungen erleichtert es dem Com­
+puter, die gespeicherten Daten in verschiedenen Variationen aus­
+zuwerten. 
+ 
+#a ("Beispiel")# Um die Unterscheidung zwischen Textverarbeitung und
+Datenverwaltung deutlicher zu machen, werden im folgenden Bei­
+spiel die Informationen über eine Person in zwei unterschiedlichen
+Formen dargeboten, die für den Menschen die gleiche Aussagekraft
+haben: 
+ 
+    1.  Frau Magdalene Kant, geb. Hagedorn, wurde am 12. Januar
+        1946 geboren. Sie wohnt in Bonn in der Meckenheimer Allee
+        112. Seit 1977 arbeitet sie in unserer Firma. Sie ist tele­
+        fonisch erreichbar unter der Nummer 0228/356782. 
+ 
+    2.  Name:              Magdalene 
+        Vorname:           Kant 
+        Geburtsname:       Hagedorn 
+        Geburtsdatum:      12.01.46 
+        Geschlecht:        weiblich 
+        Strasse:           Meckenheimer Allee 112 
+        PLZ:               5200 
+        Wohnort:           Bonn 1 
+        Vorwahl:           0228 
+        Telefon:           356782 
+        beschäftigt seit:  1977 
+ 
+Die Form der Darstellung wie in der ersten Alternative eignet sich
+nur für den Menschen, da die gleiche Information auf viele ver­
+schiedene Weisen ausgedrückt werden könnte (z.B. unterschiedlicher
+Satzbau). Die zweite Alternative beschränkt sich auf die für die
+bestimmte Anwendung wesentlichen Zusammenhänge; der Computer
+kann die Aufteilung der Information in einzelne Attribute ausnut­
+zen. 
+    In dieser zweiten Form können Sie Daten mit EUDAS erfassen
+und auch auswerten. Die Attribute können Sie jeweils passend zu
+den erfaßten Daten selbst bestimmen. 
+    Für Daten in der ersten Form steht Ihnen die EUMEL-Textver­
+arbeitung zur Verfügung. EUDAS wurde so entwickelt, daß Sie auch
+Daten an die Textverarbeitung übergeben können. 
+    Es ist nämlich möglich, einen freien Text aus der Attributdar­
+stellung automatisch zu erzeugen, indem Sie dem Computer den
+Satzbau mit entsprechenden Platzhaltern vorgeben. Der Rechner
+setzt die einzelnen Attribute dann an die angegebenen Stellen.
+Diese Funktion ist ein Kernstück von EUDAS und wird in Abschnitt
+1.3 näher erläutert. 
+ 
+ 
+#abschnitt ("1.2", "EUDAS ALS KARTEIKASTEN", "EUDAS als Karteikasten")# 
+ 
+Wie Sie vielleicht schon bemerkt haben, ähnelt die zweite Form der
+Darstellung einer Karteikarte, auf der Platz für bestimmte Einträge
+freigehalten wird. Anhand dieses Modells können Sie sich in vielen
+Fällen die Arbeitsweise von EUDAS veranschaulichen. Sie sollten die
+Analogie allerdings nicht zu weit treiben: EUDAS schaufelt ja nicht
+wirklich mit Karteikarten herum. Manche Funktionen sind eben
+computerspezifisch und ließen sich mit Karteikarten gar nicht
+durchführen. 
+   Mit EUDAS können Sie die möglichen Einträge auf den Karteikar­
+ten (also die Attribute) völlig frei bestimmen; die einzige Beschrän­
+kung besteht darin, daß Sie in einem Karteikasten nur Karten mit
+völlig gleichem Aufbau verwenden können. Wenn Sie eine neue Kar­
+teikarte entwerfen wollen, brauchen Sie nur Namen für die einzel­
+nen Einträge anzugeben. EUDAS zeigt Ihnen dann quasi eine Karte
+am Bildschirm, in der diese Einträge aufgeführt sind. 
+    Sie können nun am Bildschirm Daten auf diese Karteikarten
+schreiben. Dabei dürfen die Einträge fast beliebig lang sein; wenn
+der Platz auf dem Bildschirm nicht reicht, können Sie sich Ihre
+überdimensionale Karteikarte in Ausschnitten ansehen. 
+    Die einmal eingegebenen Daten bleiben nun so lange gespei­
+chert, wie Sie wollen (bzw. bis Ihr Rechner zusammenfällt). Haben
+Sie beim Eintragen Fehler gemacht, können Sie diese jederzeit kor­
+rigieren oder später noch weitere Informationen ergänzen. 
+ 
+#beispiel# 
+#free (7.5)# 
+ 
+#center#Abb. 1-1   EUDAS als Karteikasten 
+#text# 
+ 
+#a ("Anwendungen")# Mit den gespeicherten Daten können Sie nun ver­
+schiedene Dinge anstellen (bzw. vom Rechner anstellen lassen). Das
+Einfachste ist natürlich das, was Sie mit einer Kartei auch machen
+würden, sich nämlich einzelne Karteikarten anzuschauen. 
+    Um eine bestimmte Karteikarte herauszufinden, geben Sie
+EUDAS einfach den Inhalt vor, nach dem gesucht werden soll. Hier
+zeigt sich bereits der erste Vorteil eines Computers: Die Suche in
+der EUDAS-Kartei ist viel schneller, als Sie es von Hand könnten.
+Außerdem kann der Rechner keine Karte zufällig übersehen. 
+    EUDAS zeigt sich auch dann überlegen, wenn Sie einen ganz
+bestimmten Teil der Kartei durchforsten müssen. Eine Bücherei muß
+z.B. regelmäßig alle Bücher heraussuchen, deren Leihfrist über­
+schritten ist. Der Computer durchsucht in solchen Fällen ermü­
+dungsfrei auch große Datenmengen. 
+    Wenn Sie die Karteikarten in einer bestimmten Reihenfolge
+haben wollen, kann EUDAS auch das Sortieren übernehmen. Weitere
+automatische Vorgänge betreffen z.B. das Rauswerfen überflüssiger
+oder veralteter Karten. Die Einträge können auch nach einer be­
+stimmten Vorschrift alle geändert werden. Solche Aufgaben treten
+z.B. in der Schule auf, wo die Schüler jedes Jahr versetzt werden
+müssen (natürlich bis auf Ausnahmen). 
+    Auch Beziehungen zwischen verschiedenen Karteien kann
+EUDAS herstellen. Dies kann man noch einmal an dem Beispiel der
+Bücherei illustrieren. Wenn ein Buch gefunden wurde, dessen Leih­
+frist überschritten ist, muß der zugehörige Ausleiher gefunden und
+angeschrieben werden. Das Heraussuchen beider Karten kann EUDAS
+in einem Arbeitsgang durchführen. 
+ 
+ 
+#abschnitt ("1.3", "DRUCKEN", "Drucken")# 
+ 
+Eine besondere Stärke von EUDAS ist die Möglichkeit, die gespei­
+cherten Daten in schriftlicher Form auszuwerten. Dadurch, daß die
+Daten in einer Form gespeichert sind, die den Inhalt widerspiegelt,
+können die gleichen Daten in vielen verschiedenen Formen auf
+Papier ausgegeben werden. 
+ 
+#beispiel# 
+ 
+ 
+                                Karl Eudas         
+              An                Poltersdorf        
+              XXXXXXXXXXX                          
+              XXXXXXXXXXX                          
+                                                   
+              XXXX XXXXXXXXXXXX                    
+                                                   
+              Lieber XXXXXXX !                     
+                                                   
+              Dies ist ein Beispiel für ein        
+              Druckmuster.                         
+                                                   
+                              Viele Grüße          
+                                                   
+ 
+ 
+#center#Abb. 1-2   Muster für die Druckausgabe 
+#text# 
+ 
+Zu diesem Zweck geben Sie EUDAS ein Muster des gewünschten Aus­
+drucks vor. Der Rechner setzt dann an entsprechend markierten
+Leerstellen die gespeicherten Informationen ein und druckt das
+Ergebnis aus. Auf diese Weise ersparen Sie sich die umfangreiche
+Schreibarbeit, die anfällt, wenn die Informationen auf den Kartei­
+karten in anderer Form benötigt werden. 
+    Natürlich müssen Sie zum Entwerfen des Formulars kein ge­
+wiefter Programmierer sein. Wenn Sie einen Rundbrief verschicken
+wollen, schreiben Sie den Brief, als wollten Sie Ihn nur einmal
+schicken. Lediglich im Adressfeld müssen Sie Platzhalter an den
+Stellen vorsehen, an denen später die wirklichen Adressen stehen
+sollen. 
+ 
+#a ("Verwendungsmöglichkeiten")# Die Möglichkeiten für solche Formulare
+sind unbegrenzt. Beispiele sind Briefe, Adreßaufkleber, Überwei­
+sungsaufträge und sortierte Listen. Mit den Inhalten einer Kartei
+können Sie beliebig viele verschiedene Ausgaben erzeugen. Bei dem
+obigen Beispiel der Leihbücherei könnten Sie EUDAS dazu einsetzen,
+nicht nur die säumigen Ausleiher herauszufinden, sondern die Mah­
+nung gleich fertig für einen Fensterbriefumschlag herzustellen. Für
+den Bediener bliebe die einzige Tätigkeit, diesen Vorgang anzuwer­
+fen. 
+    Wie weiter oben schon erwähnt, können Sie diese Ausgaben von
+EUDAS auch zur Textverarbeitung übernehmen. So können Sie zum
+Beispiel die Literaturliste für ein Buch mit EUDAS führen und Aus­
+züge später jeweils an die passenden Stellen einfügen. 
+ 
+#a ("Berechnungen")# Die Druckfunktion von EUDAS kann jedoch nicht nur
+zum Ausfüllen von Formularen verwendet werden. Wenn Sie Berech­
+nungen anstellen oder Auswertungen vornehmen wollen, können Sie
+im Druckmuster auch Anweisungen der Sprache ELAN verwenden.
+Damit haben Sie eine komplette Programmiersprache für Ihre Muster
+zur Verfügung. 
+    Ehe Sie einen Schreck bekommen: Selbst für komplizierte Muster
+brauchen Sie nur einen ganz kleinen Teil von ELAN zu beherrschen,
+da die meiste Arbeit immer von EUDAS übernommen wird (Sie müssen
+also nicht etwa selber ein ganzes Programm schreiben). 
+    Anwendungen für diese Möglichkeit gibt es genug. Angefangen
+von einfachen Zählungen bis hin zu statistischen Auswertungen,
+von einfachen Summen bis zum kompletten Rechnungsschreiben.
+Immer nimmt Ihnen EUDAS alles das ab, was automatisch ablaufen
+kann. Sie versorgen EUDAS nur noch mit den passenden Formeln für
+Ihre Anwendung. 
+ 
+ 
+#abschnitt ("1.4", "GRENZEN", "Grenzen")# 
+ 
+Natürlich können Sie nicht alle Probleme mit EUDAS gleichermaßen
+gut lösen. EUDAS verwendet ein einfaches Modell (Karteikasten) und
+versucht, mit möglichst wenig Informationen von Ihrer Seite auszu­
+kommen. Kompliziertere Sachverhalte verlangen auch kompliziertere
+Strukturen, die Sie dann selbst entwerfen müssen. Eine einfache
+Lösung mit EUDAS kann in solchen Fällen zu langsam oder zu um­
+ständlich sein. 
+    Wenn Sie jedoch die wenigen Strukturprinzipien von EUDAS
+verstanden haben, werden Sie sehr schnell viele Probleme mit
+EUDAS lösen können. Zuerst erfassen Sie einfach alle Daten, die Sie
+brauchen und überlegen sich erst dann, in welcher Form Sie diese
+Daten haben wollen. Auch nachträglich können Sie jederzeit noch
+neue Daten und Formulare hinzufügen, so daß Sie mit der Zeit
+EUDAS gewinnbringend für viele Routineaufgaben benutzen werden. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.10 b/app/eudas/4.4/doc/user-manual/eudas.hdb.10
new file mode 100644
index 0000000..9d48385
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.10
@@ -0,0 +1,485 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (97)# 
+#kapitel("10", "Datenabfrage", "am", "Bildschirm")# 
+ 
+ 
+ 
+#abschnitt ("10.1", "FELDAUSWAHL", "Feldauswahl")# 
+ 
+Da die Anzahl der möglichen Felder bei EUDAS-Dateien viel größer
+ist als die Anzahl der zur Verfügung stehenden Zeilen auf dem
+Bildschirm (255 gegenüber 22), muß es eine Möglichkeit geben, auch
+die übrigen Felder anzusehen. 
+ 
+#a ("Rollen")# Dazu kann man den Bildschirmausschnitt in vertikaler
+Richtung #on("i")#rollen#off("i")#. Sie müssen sich die Bildschirmanzeige als einen
+Ausschnitt des wirklichen Satzes vorstellen. Um weitere Inhalte des
+Satzes zu sehen, verschieben Sie den Ausschnitt einfach. 
+    Dazu dienen die beiden Tastenkombinationen ESC OBEN und ESC
+UNTEN. Diese Kombinationen wirken nur im Menü "Einzelsatz". An
+der Bildschirmanzeige ändert sich natürlich nur dann etwas, wenn
+es noch weitere Felder zum Anzeigen gibt. 
+    Ob dies der Fall ist, können Sie an zwei Indikatoren ablesen.
+Zum einen wird hinter dem letzten Feld eine markierte Abschluß­
+zeile ausgegeben. Ist diese nicht sichtbar, gibt es noch Felder, die
+Sie mit ESC UNTEN hochholen können. Zum anderen steht die Num­
+mer der ersten Zeile in der Überschrift. Ist diese Nummer größer als
+1, können Sie mit ESC OBEN noch Felder sichtbar machen. 
+    Das Rollen ist oft auch dann notwendig, wenn sich ein Feld
+über mehrere Zeilen erstreckt. In diesem Fall kann es passieren,
+daß die erste Zeile des Feldes nicht mehr sichtbar ist, da sie ober­
+halb des Anzeigebereichs liegen würde. 
+ 
+#a ("Feldauswahl")# Eine weitere Möglichkeit bei zu vielen Feldern be­
+steht darin, nur die interessanten Felder zur Anzeige auszuwählen.
+Dies geschieht mit der Funktion 
+#free (0.2)# 
+#beispiel# 
+        F Feldauswahl 
+#text# 
+#free (0.2)# 
+Ihnen werden alle Felder zur Auswahl angeboten. Kreuzen Sie die
+Felder an, die Sie sehen wollen und denken Sie daran, daß die Rei­
+henfolge des Ankreuzens beachtet wird. Anschließend werden Ihnen
+nur die ausgewählten Felder angezeigt. Falls Sie kein Feld ankreu­
+zen, bleibt die alte Feldauswahl bestehen. 
+    Wollen Sie wieder alle Felder sehen, müssen Sie diese nicht alle
+einzeln ankreuzen. Mit HOP 'x' in der Auswahl werden alle Felder
+angekreuzt (die noch nicht angekreuzt waren). Diese Tastenkombi­
+nation können Sie allgemein bei einer Auswahl verwenden. Sie
+können die Kreuzchen mit 'o' auch wieder löschen, um zum Beispiel
+"alle außer einem" auszuwählen. 
+    Beachten Sie, daß die Auswahl der anzuzeigenden Felder nichts
+mit der eigentlichen Dateistruktur zu tun hat, sondern nur für die
+Anzeige gilt. Den Verarbeitungsfunktionen (zum Beispiel Drucken)
+stehen natürlich nach wie vor alle Felder zur Verfügung. 
+    Unvermutete Effekte können dann entstehen, wenn Sie bei
+einer eingestellten Feldauswahl ändern oder einfügen. Die nicht
+ausgewählten Felder werden beim Ändern natürlich nicht geändert
+und beim Einfügen einfach leer gelassen. 
+ 
+ 
+#abschnitt ("10.2", "SATZEDITOR", "Satzeditor")# 
+ 
+An dieser Stelle sollen noch einige weitere Funktionen des Satz­
+editors vorgestellt werden, die Sie noch nicht kennengelernt haben. 
+ 
+#a ("Rollen im Satzeditor")# Sie können auch rollen, wenn Sie sich im
+Satzeditor befinden (also beim Suchen, Einfügen und Ändern). Den­
+ken Sie daran, daß Sie die Einzelsatzanzeige immer mit ESC OBEN
+und ESC UNTEN rollen, während sonst (Editor, Auswahl von Datei­
+namen) immer mit HOP OBEN und HOP UNTEN gerollt wird. 
+    Diese Diskrepanz hat technische Gründe und läßt sich leider
+nicht vermeiden. Wie Sie sich vielleicht erinnern, führt das Blättern
+mit HOP OBEN und HOP UNTEN im Satzeditor dazu, daß die Korre­
+spondenz zwischen Feldnamen und Feldinhalt verlorengeht. Daher
+muß an dieser Stelle mit ESC statt HOP gearbeitet werden. 
+ 
+#a ("Ähnliche Sätze")# Wenn Sie mehrere ähnliche Sätze eintragen müssen,
+bietet Ihnen EUDAS eine Erleichterung an. Sie können nämlich beim
+Einfügen die Daten eines anderen Satzes übernehmen. 
+    Dazu müssen Sie beim Ändern oder Einfügen des anderen Satzes
+ESC 'p' drücken. Der Inhalt des Satzes wird dann in einen Zwischen­
+speicher gebracht. Beachten Sie, daß im Gegensatz zum EUMEL-
+Editor kein Text markiert sein muß, sondern immer der ganze Satz
+transportiert wird. 
+    Beim Einfügen eines neuen Satzes können Sie diesen Satz dann
+mit ESC 'g' in den Satzeditor übernehmen. Alle vorherigen Inhalte
+werden überschrieben. Anschließend können Sie die Daten nach
+Wunsch abändern. 
+    Der Inhalt des Zwischenspeichers kann beliebig oft auf diese
+Weise kopiert werden. Der Inhalt des Zwischenspeichers wird bei
+Ändern der Feldauswahl oder beim Öffnen einer neuen Datei ge­
+löscht. 
+ 
+#a ("Tagesdatum")# Im Satzeditor können Sie mit ESC 'D' das aktuelle
+Tagesdatum abfragen. Es wird an der aktuellen Cursorposition ein­
+getragen, als ob Sie es selbst getippt hätten. 
+    Auf diese Weise können Sie Sätze einfach mit Datum versehen
+oder nach Sätzen suchen, die mit dem Tagesdatum in Beziehung
+stehen (zum Beispiel 'Fälligkeit = Heute'). 
+ 
+ 
+#abschnitt ("10.3", "SUCHMUSTER", "Suchmuster")# 
+ 
+Die bisher genannten Möglichkeiten des Suchmusters sind noch
+etwas beschränkt. Eine Bedingung in unserer Adressendatei, die wir
+im Suchmuster noch nicht ausdrücken können, wäre zum Beispiel:
+Suche alle Adressen der Personen, die Wegner oder Simmern heißen. 
+    Diese Alternative, Wegner ODER Simmern, kann nun in EUDAS
+durch ein Komma ausgedrückt werden: 
+ 
+#beispiel# 
+        Name     Wegner,Simmern 
+        Vorname 
+#text# 
+ 
+Beachten Sie, daß hinter dem Komma kein Leerzeichen folgen darf,
+wie Sie es vielleicht gewohnt sind, in einem Text zu schreiben.
+EUDAS kann nämlich nicht unterscheiden, ob Sie das Leerzeichen
+nur aus optischen Gründen geschrieben haben, oder ob Sie danach
+suchen wollen. 
+ 
+#a ("Lokale Alternative")# Die eben beschriebene Konstruktionsmethode
+heißt #on("i")#lokale Alternative#off("i")#. Lokal deshalb, weil Sie nur innerhalb
+eines Feldes gilt. Was das bedeuten soll, sehen Sie, wenn Sie die
+Bedingung mit einer weiteren Bedingung für ein anderes Feld kom­
+binieren: 
+ 
+#beispiel# 
+        Name     Wegner,Simmern 
+        Vorname 
+        Strasse 
+        PLZ      5* 
+        Ort 
+#text# 
+ 
+Dieses Muster hat die Bedeutung: Wähle alle Personen namens Weg­
+ner oder Simmern aus, die im PLZ-Bereich 5 wohnen. Die beiden
+Bedingungen für den Namen sind mit der Bedingung für die PLZ mit
+UND verknüpft - das heißt, eine der beiden ersten Bedingungen muß
+zutreffen #on("i")#und#off("i")# die untere Bedingung. Dieses UND ist global, da es
+Bedingungen für verschiedene Felder miteinander verbindet. 
+    Natürlich können Sie für mehrere Felder gleichzeitig lokale
+Alternativen angeben. Eine anderes Suchmuster könnte zum Beispiel
+so aussehen: 
+ 
+#beispiel# 
+        Name     Wegner,Simmern 
+        Vorname 
+        Strasse 
+        PLZ      5,5000 
+        Ort 
+#text# 
+ 
+In diesem Fall muß eine ausgewählte Person Wegner oder Simmern
+heißen und in Köln wohnen. 
+ 
+#a ("Globale Alternative")# Es wird nun aber für bestimmte Situationen
+noch eine andere Art von Alternativen benötigt. Als Beispiel soll
+ein Suchmuster dienen, das folgende Bedingung ausdrückt. Gesucht
+ist eine weibliche Person mit Namen Simmern oder eine männliche
+Person mit Namen Wegner. 
+    Dieser Fall läßt sich mit unseren bisherigen Mitteln nicht lö­
+sen. Es wird nämlich eine Alternative zwischen zwei zusammen­
+gesetzten Bedingungen gefordert. Als Ausweg bietet sich an, prak­
+tisch mehrere Suchmuster anzugeben, die dann mit ODER verknüpft
+werden. 
+     Um diese verschiedenen Suchmuster optisch am Bildschirm zu
+kennzeichnen, wird ein Semikolon als sogenannte #on("i")#globale Alternati­
+ve#off("i")# verwendet. Das Semikolon trennt das Suchmuster quasi in ver­
+schiedene Spalten auf, die jeweils eine eigene Bedingung enthalten
+können. Unser gewünschtes Suchmuster würde also so aussehen: 
+ 
+#beispiel# 
+        Name     Wegner;Simmern 
+        Vorname 
+        Strasse 
+        PLZ 
+        Ort 
+        m/w      m;w 
+#text# 
+ 
+Ebenso wie bei lokalen Alternativen darf hinter dem Semikolon kein
+Leerzeichen folgen. Daher kann das zweite Semikolon auch nicht
+direkt unter dem ersten stehen. Die Spalten werden also einfach nur
+durchgezählt: nach dem ersten Semikolon beginnt die zweite Spal­
+te, nach dem zweiten Semikolon die dritte usw. 
+    In Zeilen, in denen keine Bedingungen stehen, kann auch das
+Semikolon weggelassen werden. Es kann ebenfalls weggelassen wer­
+den, wenn die weiteren Spalten leer sind. Steht ein Semikolon direkt
+am Anfang der Zeile, so ist die erste Spalte leer. 
+    Um dies zu illustrieren, sei hier noch ein weiteres Beispiel
+angegeben: 
+ 
+#beispiel# 
+        Name     Wegner 
+        Vorname  ;Anna-Maria 
+        Strasse 
+#text# 
+ 
+In diesem Fall muß eine ausgewählte Person mit Nachnamen Wegner
+oder mit Vornamen Anna-Maria heißen. 
+ 
+#a ("Stern")# Bis jetzt haben Sie hauptsächlich Bedingungen betrachtet,
+die exakt zutreffen mußten. Sie wissen aber bereits, daß man auch
+Bedingungen angeben kann, bei denen nur ein Teil des zu suchen­
+den Feldes bekannt ist, nämlich indem der unbekannte Teil mit
+einem Stern markiert wird. 
+    In Kapitel 5 haben Sie gelernt, daß der Stern nur am Anfang
+und Ende des Musters stehen kann. Dies trifft nicht ganz zu, denn
+Sie können den Stern auch inmitten eines Textes anwenden. So
+trifft die Bedingung #bsp("'Si*n'")# auf alle Namen zu, die mit 'Si' beginnen
+und mit 'n' enden. 
+    Beachten Sie hier das "und" in der Formulierung der Bedingung.
+Das Muster ist eigentlich eine Schreibweise für zwei Bedingungen
+für ein Feld, die mit UND verknüpft sind. 
+    Sie können auch noch weitere Sterne in das Muster aufnehmen.
+Dabei gibt es jedoch eine Kleinigkeit zu beachten. Das Muster
+#bsp("'*x*y*'")# bedeutet: das Feld muß ein 'x' und ein 'y' enthalten. Über
+die Reihenfolge der beiden Zeichen ist jedoch in dieser Bedingung
+nichts gesagt, obwohl es vielleicht vom Aussehen suggeriert wird. 
+    Denken Sie daran, keine zwei Sterne nebeneinander zu schrei­
+ben - eine solche Bedingung hätte keinen Sinn. 
+    Es gibt eine weitere spezielle Bedingung, die mit Hilfe des
+Sterns formuliert wird. Ein einzelner Stern bedeutet nämlich: Das
+Feld ist nicht leer. Beachten Sie den kleinen Unterschied: ein Stern
+in einem Muster kann für einen beliebigen Text stehen, der auch
+leer sein kann. Ein einzelner Stern jedoch steht für einen beliebigen
+Text, der nicht leer ist. 
+    Damit Sie ein Gefühl für die Verwendung des Sterns bekommen,
+hier noch ein paar Beispiele: 
+ 
+#beispiel# 
+Mei*r* 
+#text# 
+    Der Name beginnt mit 'Mei' und enthält ein 'r'. Trifft zu auf
+    'Meier', 'Meiring', aber nicht auf 'Meiling' oder 'Merzei'. 
+ 
+#beispiel# 
+Donau*dampf*schiff*schaft 
+#text# 
+    Feld beginnt mit 'Donau', endet mit 'schaft' und enthält
+    'dampf' und 'schiff'. Trifft zu auf 'Donaudampfschiffahrtsge­
+    sellschaft', aber auch auf 'Donaugesellschiffdampffahrtschaft'. 
+ 
+#beispiel# 
+Roller*erfahren 
+#text# 
+    Dieses Muster muß man ganz genau interpretieren. Es bedeutet:
+    der Inhalt beginnt mit 'Roller' und endet mit 'erfahren'. Das
+    Muster trifft nicht nur auf 'Roller erfahren' sondern auch auf
+    'Rollerfahren' zu. Der Stern verliert also in diesem Fall seine
+    symbolische Bedeutung als Platzhalter für einen bestimmten
+    Text. 
+ 
+#a ("Vergleiche")# Es gibt in EUDAS noch weitere Muster, die einen gan­
+zen Bereich von Werten auswählen. Diese betreffen Bedingungen der
+Art "größer als" und "kleiner als". Solche Vergleichsbeziehungen
+werden durch zwei Punkte dargestellt. 
+    So wählt das Muster #bsp("'K..'")# alle Felder aus, die in der alphabe­
+tischen Reihenfolge hinter 'K' liegen, wobei das 'K' selbst mit ein­
+geschlossen ist. Umgekehrt trifft #bsp("'..K'")# auf alle Felder zu, die davor
+liegen. 
+    Sie können beide Bedingungen auch kombinieren. So trifft die
+Bedingung #bsp("'A..K'")# auf alle Felder zu, die im Lexikon unter 'A' bis
+'J' erscheinen (die Felder mit 'K' sind hier ausgeschlossen). Beach­
+ten Sie, daß die direkte Kombination wieder die Verknüpfung zweier
+einzelner Bedingungen mit UND darstellt. 
+ 
+#a ("Negation")# Um den Bereich möglicher Suchmuster noch zu erweitern,
+können Sie einzelne Bedingungen auch noch verneinen. Dies ge­
+schieht durch Voranstellen zweier Minuszeichen. So bedeutet das
+Muster #bsp("'--Meier'")#, daß alle Personen ausgewählt werden, die nicht
+Meier heißen. 
+    Die Verneinung bezieht sich immer auf das unmittelbar folgende
+Muster (bis zum nächsten Komma, Semikolon oder dem Zeilenende)
+und nicht etwa auf eine ganze Zeile. Sie umfaßt jedoch die UND-
+Verknüpfung der kombinierten Bedingungen. So sind zum Beispiel die
+Muster #bsp("'--E..M'")#, #bsp("'--E..,--..M'")# und #bsp("'..E,M..'")# völlig gleichbedeu­
+tend. 
+ 
+#a ("Feldvergleich")# Als letztes haben Sie im Suchmuster auch noch die
+Möglichkeit, ein Feld mit anderen Feldern des gleichen Satzes zu
+vergleichen. Bisher hatten Sie ein Feld ja immer nur mit konstanten
+Texten verglichen. 
+    Um dies zu erreichen, geben Sie statt eines Vergleichstextes
+den Feldnamen des Feldes an, mit dem Sie vergleichen wollen. Zur
+Kennzeichnung müssen Sie dem Namen noch ein '&' voranstellen.
+Diese Konstruktion funktioniert mit allen bisher besprochenen Ver­
+gleichen. Beispielsweise trifft 
+ 
+#beispiel# 
+        Feld1     ..&Feld2 
+#text# 
+ 
+auf alle Sätze zu, in denen der Inhalt von Feld1 kleiner ist als der
+Inhalt von Feld2. 
+    Im Gegensatz zum Druckmuster dürfen in den Feldnamen zwar
+Leerzeichen enthalten sein, nicht jedoch 
+#free (0.2)# 
+#beispiel# 
+        ..     *     ,     ; 
+#text# 
+#free (0.2)# 
+da diese Zeichen als reservierte Zeichen gelten und jeweils als
+Begrenzer wirken. Die gleiche Beschränkung gilt dementsprechend
+auch für konstante Vergleichstexte. 
+    Beachten Sie, daß hinter dem '&' bis zum nächsten Begrenzer­
+zeichen ein gültiger (vorhandener) Feldname stehen muß. Anderen­
+falls wird der Text als konstantes Muster betrachtet. 
+    Wie schon oben gesagt, kann der Feldvergleich mit allen Ver­
+gleichen verwendet werden. Auch gemischte Konstruktionen sind
+zulässig, beispielsweise 
+ 
+#beispiel# 
+        Feld1     A..&Feld3,*&Feld9* 
+#text# 
+ 
+Diese Bedingung trifft zu, wenn Feld1 größer oder gleich 'A', aber
+kleiner als der Inhalt von Feld3 ist, oder wenn der Inhalt von Feld9
+darin vorkommt. 
+ 
+#a ("Optimierung")# Hier noch eine Bemerkung zur Geschwindigkeit des
+Suchens. Je mehr Bedingungen Sie angeben, desto mehr Vergleiche
+müssen beim Suchen angestellt werden und desto länger dauert es. 
+    Das erste Feld einer Datei erfährt jedoch eine Sonderbehand­
+lung. Wenn Sie für dieses Feld ein Muster für Übereinstimmung
+angeben, kann der Suchvorgang enorm beschleunigt werden, da das
+erste Feld einer Datei intern speziell verwaltet wird. Damit das
+Verfahren funktioniert, dürfen keine globalen Alternativen oder
+lokale Alternativen für das erste Feld verwendet werden. 
+    Diese Suchoptimierung sollten Sie bereits beim Einrichten einer
+Datei berücksichtigen. Geben Sie als erstes Feld das an, nach dem
+am ehesten direkt gesucht wird. Typisches Beispiel hierfür ist der
+Nachname, aber auch Artikelnummern sind sinnvoll. Wichtig ist, daß
+das erste Feld nicht zu oft identisch ist und auch mehr als zwei
+Buchstaben enthält, damit die Optimierung ihre volle Wirksamkeit
+entfaltet. 
+    Denken Sie daran, daß durch die Feldauswahl ein beliebiges
+Feld als erstes auf dem Bildschirm stehen kann. Für die Optimierung
+wird jedoch immer das Feld betrachtet, das beim Einrichten der
+Datei als erstes angegeben wurde. 
+ 
+ 
+#abschnitt ("10.4", "MARKIEREN", "Markieren")# 
+ 
+Manchmal entsteht die Situation, daß Sie eine Reihe von Sätzen
+bearbeiten wollen, aber keine Suchbedingung formulieren können,
+die auf alle diese Sätze zutrifft. In diesem Fall bietet EUDAS Ihnen
+die Möglichkeit, solche Sätze von Hand zu markieren. 
+    Ein Beispiel: Sie haben eine ganze Reihe von Sätzen geändert
+und wollen diese Änderungen als Protokoll ausdrucken. Es läßt sich
+aber nicht mit Hilfe eines Suchmusters feststellen, welche Sätze
+geändert wurden. 
+    Als Abhilfe wählen Sie bei jedem geänderten Satz die Funktion 
+#free (0.2)# 
+#beispiel# 
+        M Markierung 
+#text# 
+#free (0.2)# 
+Dadurch wird der bisher unmarkierte Satz markiert. Dies wird
+kenntlich an der Anzeige #bsp("'MARK+'")# in der Überschrift. Sobald Sie den
+ersten Satz markiert haben, erscheint bei jedem Satz, ob er markiert
+ist oder nicht. 
+    Haben Sie einen Satz irrtümlich markiert, können Sie die Mar­
+kierung mit der gleichen Funktion auch wieder entfernen. 
+    Alle Funktionen, die bisher die durch das Suchmuster ausge­
+wählten Sätze bearbeitet haben, arbeiten nun nur noch auf den
+markierten Sätzen. Somit können Sie anschließend mit der Druck­
+funktion die gewünschten Sätze drucken. Die Markierung hat also
+Priorität über die eingestellte Suchbedingung. Lediglich die Bewe­
+gung am Bildschirm beachtet immer nur die Suchbedingung. 
+    Sie können alle Markierungen der Datei mit der Funktion 
+#free (0.2)# 
+#beispiel# 
+        Alle Markier. 
+        L Löschen 
+#text# 
+#free (0.2)# 
+im Menü 'Gesamtdatei' wieder entfernen. Anschließend wird beim
+Drucken wieder das Suchmuster beachtet. Die Markierungen ver­
+schwinden auch, wenn eine neue Datei geöffnet wird. Die Markie­
+rungen sind also nicht permanent in einer Datei gespeichert, son­
+dern existieren nur, während die Datei geöffnet ist. 
+    Bei Koppeldateien können Sie aus technischen Gründen immer
+nur alle Kombinationen auf einmal markieren. Die Markierung einer
+Kombination markiert auch alle anderen Kombinationen des gleichen
+Satzes. 
+ 
+ 
+#abschnitt ("10.5", "ÜBERSICHT", "Übersicht")# 
+ 
+Wie Sie bisher gesehen haben, zeigte EUDAS immer einen einzigen
+Satz in dem Standardformular auf dem Bildschirm. Es gibt jedoch
+auch eine Möglichkeit, mehrere Sätze gleichzeitig zu betrachten.
+Dazu dient die Funktion 
+#free (0.2)# 
+#beispiel# 
+        U Übersicht 
+#text# 
+#free (0.2)# 
+im Menü 'Gesamtdatei'. 
+    In der Übersicht nimmt jeder Satz nur eine Bildschirmzeile in
+Anspruch. Die Feldinhalte werden, durch Komma getrennt, in der
+Zeile nacheinander aufgezählt, bis kein Platz mehr vorhanden ist.
+Am Anfang jeder Zeile steht die Satznummer und ob der jeweilige
+Satz markiert ist (entweder '+' für markiert oder '-'). In der Über­
+schrift stehen in gleicher Weise die Feldnamen angegeben. 
+    Der aktuelle Satz wird innerhalb der Übersichtsanzeige immer
+durch eine inverse Satznummer dargestellt. Es werden nur die durch
+das eingestellte Suchmuster ausgewählten Sätze gezeigt. Trifft die
+Selektionsbedingung nicht auf den aktuellen Satz zu, wird an seiner
+Stelle zur Information ein leerer Platzhalter angezeigt. Hinter dem
+letzten Satz wird auch das Dateiende als besonders gekennzeichne­
+ter Satz angegeben. 
+ 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      ÜBERSICHT:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ? 
+      Satznr. Name, Vorname, PLZ, Ort, Strasse, m/w, 
+      1     - Wegner, Herbert, Krämergasse 12, 5000, Köln, m, 
+      2     - Sandmann, Helga, Willicher Weg 109, 5300, Bonn 1, w, 
+      3     - Katani, Albert, Lindenstr. 3, 5210, Troisdorf, m, 
+      4     - Ulmen, Peter, Mozartstraße 17, 5, Köln 60, m, 
+      5     - Regmann, Karin, Grengelweg 44, 5000, Köln 90, w, 
+      6     - Arken, Hubert, Talweg 12, 5200, Siegburg, m, 
+      7     - Simmern, Anna-Maria, Platanenweg 67, 5, Köln 3, w, 
+      8     - Kaufmann-Drescher, Angelika, Hauptstr. 123, 53, Bonn 2, w, 
+      9     - Fuhrmann, Harald, Glockengasse 44, 5000, Köln 1, m, 
+      10    - Seefeld, Friedrich, Kabelgasse, 5000, Köln-Ehrenfeld, m, 
+      11    - << DATEIENDE >> 
+ 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 10-1   Übersicht 
+#text# 
+ 
+#a ("Feldauswahl")# Wenn Sie die Funktion aufrufen, haben Sie zuerst
+noch die Möglichkeit, nur einen Teil der vorhandenen Felder zur
+Anzeige auszuwählen. Dazu bejahen Sie die Frage und können dann
+die Felder in der gewünschten Reihenfolge ankreuzen. Analog zur
+Funktion 'Feldauswahl' wird auch hier die zuletzt für die Übersicht
+verwendete Feldauswahl beibehalten, wenn Sie die Frage verneinen
+oder kein Feld ankreuzen. Die Feldauswahl für die Übersicht ist
+unabhängig von der Feldauswahl für die normale Satzanzeige. 
+    Von der Möglichkeit zur Feldauswahl sollten Sie Gebrauch ma­
+chen, denn durch die komprimierte Darstellung der Übersicht kann
+meistens nur ein kleiner Teil eines Satzes dargestellt werden. 
+ 
+#a ("Rollen")# Nachdem die Sätze auf dem Bildschirm erschienen sind,
+haben Sie wieder die Möglichkeit, die Darstellung zu rollen. Dazu
+können Sie die Pfeiltasten OBEN und UNTEN sowie die Tastenkombi­
+nationen HOP OBEN und HOP UNTEN verwenden. Diese Funktionen
+verschieben den invers dargestellten aktuellen Satz und funktio­
+nieren wie im Editor. Beachten Sie auch hier wieder den Unterschied
+zum Rollen in der Einzelsatzanzeige. 
+    Das Rollen wirkt wie ein Positionieren mit 'Weiter' oder 'Zu­
+rück'. Nach der Rückkehr aus der Übersicht können Sie sich also an
+einer ganz anderen Stelle in der Datei befinden. 
+   Es stehen Ihnen zum Rollen auch noch die folgenden Tasten­
+kombinationen zur Verfügung (wie im Editor): HOP RETURN macht
+den aktuellen Satz zum ersten auf der Seite. ESC '1' zeigt den er­
+sten Satz der Datei, ESC '9' analog dazu den letzten. 
+    Wenn Sie eine komplizierte Suchbedingung eingestellt haben
+und EUDAS viele Sätze erfolglos überprüfen muß, dauert der Bild­
+aufbau natürlich entsprechend lange. EUDAS gibt zu Ihrer Informa­
+tion aber immer die Nummer des Satzes aus, der gerade überprüft
+wird. Außerdem werden Tastenbefehle nach jeder Zeile angenommen,
+so daß Sie schon weiterblättern können, wenn Sie den ersten Satz
+gesehen haben. 
+ 
+#a ("Markieren")# In der Übersicht können Sie auch Sätze markieren. Mit
+'+' markieren Sie den aktuellen Satz; mit '-' entfernen Sie die Mar­
+kierung wieder. So können Sie einfach die Sätze ankreuzen, die Sie
+später bearbeiten wollen. 
+ 
+#a ("Verlassen")# Mit ESC 'q' können Sie die Übersicht wieder verlassen,
+auch mitten beim Aufbau des Bildes. Haben Sie erkannt, daß EUDAS
+sinnlos mit einer falschen Suchbedingung sucht, können Sie die
+Funktion auch mit ESC 'h' (Halt) abbrechen und gegebenenfalls ein
+neues Suchmuster einstellen. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.11 b/app/eudas/4.4/doc/user-manual/eudas.hdb.11
new file mode 100644
index 0000000..957a413
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.11
@@ -0,0 +1,645 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (109)# 
+#kapitel ("11", "Funktionen", "zur", "Bearbeitung")# 
+ 
+ 
+ 
+#abschnitt ("11.1", "SORTIEREN", "Sortieren")# 
+ 
+Wenn Sie die Sätze in Ihrer EUDAS-Datei in einer bestimmten Rei­
+henfolge haben wollen (dies wird in vielen Fällen zum Drucken
+verlangt), müssen Sie die Datei sortieren. Sie können EUDAS ange­
+ben, in welcher Reihenfolge die Sortierung erfolgen soll. Um die
+aktuelle Datei zu sortieren, rufen Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Akt. Datei 
+        S Sortieren 
+#text# 
+#free (0.2)# 
+auf. Falls die Datei noch nie sortiert wurde, wird Ihnen auf jeden
+Fall die Sortierreihenfolge zum Auswählen angeboten. Anderenfalls
+werden Sie gefragt, ob Sie die vorherige Sortierreihenfolge ändern
+wollen. 
+    Das Sortieren wird als Veränderung betrachtet und nur auf der
+Arbeitskopie durchgeführt! 
+ 
+#a ("Sortierreihenfolge")# Die Sortierreihenfolge gibt an, welche Felder in
+welcher Reihenfolge beim Vergleichen zweier Sätze benutzt werden
+sollen. Zuerst wird das an erster Stelle angegebene Feld verglichen.
+Sind die Inhalte hier unterschiedlich, wird die Einordnung der Sätze
+nach diesem Feld bestimmt. 
+    Sind die Inhalte in diesem Feld aber gleich, so wird nach dem
+nächsten Feld verglichen. Ist kein weiteres Feld in der Sortierrei­
+henfolge angegeben, wird der Vergleich an dieser Stelle mit einem
+zufälligen Ergebnis abgebrochen, das heißt, es kann nicht vorher­
+gesagt werden, welcher der beiden Sätze zuerst kommt. 
+    Die Sortierreihenfolge können Sie in einer Menüauswahl einge­
+ben. Kreuzen Sie die Felder an, die Sie vergleichen wollen und ach­
+ten Sie auf die richtige Reihenfolge. Die eingegebene Reihenfolge
+wird in der Datei gespeichert, um beim nächsten Sortiervorgang
+wiederverwendet zu werden. 
+    Nachdem Sie alle bei der Sortierung zu berücksichtigenden
+angekreuzt haben, werden Sie für jedes dieser Felder gefragt, ob
+nach dem Feld aufsteigend oder absteigend sortiert werden soll. 
+ 
+#a ("Ablauf")# Der Ablauf des Sortierens wird durch Ausgabe von Satz­
+nummern dargestellt. Bis zur ausgegebenen Satznummer sind alle
+Sätze richtig sortiert. Bei Bedarf kann der Vorgang durch SV und
+dann 'halt' abgebrochen werden. Die Datei bleibt dabei auf jeden
+Fall intakt. 
+ 
+#a ("Optimierung")# Die gespeicherte Sortierreihenfolge wird auch noch zu
+einer weiteren Optimierung benutzt. Wenn eine Datei sortiert war
+und nur wenige Änderungen stattgefunden haben, brauchen beim
+nächsten Sortiervorgang nur die wenigen veränderten Sätze einzeln
+einsortiert zu werden. Das funktioniert natürlich nur unter der
+Voraussetzung, daß die gleiche Sortierreihenfolge gewählt wird. Das
+Sortieren braucht in diesem Fall erheblich weniger Zeit. 
+ 
+#a ("Probleme")# Normalerweise werden die einzelnen Felder nach dem
+EUMEL-Zeichencode verglichen. Das bedeutet, daß sich die Reihen­
+folge der Zeichen nach dem EUMEL-Zeichencode richtet. Ein Zeichen
+mit einem höheren Code wird also vor einem Zeichen mit einem
+niedrigeren Code einsortiert. 
+    In manchen Fällen ergeben sich mit diesem Vergleichsverfahren
+aber auch Schwierigkeiten. Wenn in einem Feld Zahlen oder DM-
+Beträge stehen, führt die Methode zu falschen Ergebnissen. Die '10'
+wird zum Beispiel vor der '2' einsortiert. Warum? Texte werden
+immer linksbündig geschrieben und verglichen. Bei Zahlen richtet
+sich die Wertigkeit jedoch nach dem Abstand vom Komma. 
+    Da bei Texten zuerst das erste Zeichen verglichen wird, ent­
+steht hier durch Vergleich von '1' und '2' der Eindruck, die '10'
+käme vor der '2'. Korrigieren könnte man dies, indem man ein Leer­
+zeichen vor die '2' schreibt. Wenn also die (nicht geschriebenen)
+Dezimalkommata direkt untereinanderstehen, werden Zahlen richtig
+verglichen. 
+ 
+#a ("Typ ZAHL")# EUDAS hat jedoch eine bequemere Art, dieses Problem zu
+behandeln. Ein Feld, das Zahlen enthalten soll, bekommt einen spe­
+ziellen Typ ZAHL zugewiesen, der zu einer richtigen Sortierung
+führt. 
+    Bei Feldern vom Typ ZAHL ignoriert EUDAS bei Vergleichen alle
+nichtnumerischen Zeichen und vergleicht den Wert der Zahl. So
+können Sie zum Beispiel in einem Satz '2,50 DM' und im anderen
+Satz '10 DM' eintragen - EUDAS kann jetzt die richtige Reihenfolge
+feststellen. 
+    Übrigens: falls Sie numerische Werte lieber mit einem Dezi­
+malpunkt statt einem Dezimalkomma schreiben, können Sie EUDAS
+das mit dem ELAN-Kommando 
+ 
+#beispiel# 
+        dezimalkomma (".") 
+#text# 
+ 
+mitteilen. Wenn Sie ein solches Kommando eingeben wollen, können
+Sie im EUDAS-Menü ESC ESC drücken. In der Statuszeile erscheint
+dann die Aufforderung: 
+ 
+#beispiel# 
+        Gib Kommando: 
+#text# 
+ 
+Hier können Sie wie im Editor oder im EUMEL-Monitor ein beliebiges
+Kommando eingeben und ausführen. 
+    Die Normaleinstellung für das Dezimalkomma erreichen Sie
+wieder durch das Kommando 
+ 
+#beispiel# 
+        dezimalkomma (",") 
+#text# 
+ 
+ 
+#a ("Typ ändern")# Die Feldtypen sind eine permanente Eigenschaft einer
+EUDAS-Datei. Beim Einrichten einer neuen Datei wird zunächst der
+Standardtyp für alle Felder genommen. Sie erhalten jedoch Gelegen­
+heit, abweichende Feldtypen zu vergeben, wenn Sie die Frage 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Feldnamen oder Feldtypen ändern (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+bejahen. 
+    Auch nachträglich können Sie die Feldtypen noch ändern. Dies
+geschieht mit der Funktion 
+#free (0.2)# 
+#beispiel# 
+        F Feldstrukt. 
+#text# 
+#free (0.2)# 
+im Menü 'Öffnen'. Zunächst werden Sie gefragt, ob Sie noch weitere
+Feldnamen anfügen wollen. So könnten Sie die Datei um weitere
+Felder ergänzen, die bei allen Sätzen zunächst leer sind. Die neuen
+Felder müssen Sie wie beim Einrichten der Datei untereinander im
+Editor schreiben. 
+    Als zweites erscheint dann die gleiche Frage wie oben. Wenn
+Sie diese bejahen, wird Ihnen eine Auswahl der zu ändernden Fel­
+der mit Feldnamen und den zugehörigen Feldtypen angeboten. Kreu­
+zen Sie hier die Felder an, deren Feldtypen Sie ändern möchten. 
+    Da Sie mit dieser Funktion sowohl Feldnamen als auch Feld­
+typen verändern können, wird Ihnen für jedes Feld zunächst der
+Name zum Ändern angeboten. Sie können den Namen korrigieren oder
+überschreiben. Die Namensänderung hat jedoch keine Auswirkung
+auf den Feldinhalt! 
+    Wenn Sie den Namen nicht ändern wollen, drücken Sie einfach
+RETURN. Anschließend können Sie für das Feld den neuen Feldtyp
+angeben. Tippen Sie einen der vier Feldtypen als Text ein und
+drücken Sie RETURN. Anschließend hat das Feld einen neuen Typ.
+Die verschiedenen möglichen Typen werden jetzt genau erklärt. 
+ 
+#a ("Feldtypen")# TEXT ist der Standardtyp, der die Feldinhalte nach
+EUMEL-Zeichencode vergleicht. Den Typ ZAHL hatten wir schon
+weiter oben kennengelernt. Daneben gibt es noch den Typ DATUM. 
+    Dieser Typ vergleicht Daten der Form 'tt.mm.jj'. Soll ein sol­
+ches Datum richtig einsortiert werden, müßte es anderenfalls in der
+Reihenfolge umgedreht werden (also 'jj.mm.tt'). Dies ist aber nicht
+nötig, wenn das Feld den Typ DATUM bekommt. Beachten Sie, daß
+alle Inhalte, die nicht die beschriebene Form haben, als gleich be­
+trachtet werden. 
+    Der letzte Typ ist DIN. Dabei werden Texte nach DIN 5007 ver­
+glichen. Das bedeutet, daß Groß- und Kleinbuchstaben als gleich
+angesehen werden, daß alle nichtalphabetischen Zeichen ignoriert
+werden und die Umlaute ihren richtigen Platz bekommen (Umlaute
+werden in normalen Texten hinter allen anderen Zeichen einsor­
+tiert). Da hierfür ein relativ großer Zeitaufwand notwendig ist,
+sollte dieser Typ nur dann gewählt werden, wenn er erforderlich ist.
+Den schnellsten Vergleich ermöglicht der Typ TEXT. 
+ 
+#a ("Hinweis")# Beachten Sie, daß mit der Vergabe von Feldtypen keine
+Überprüfung der Eingabe verbunden ist. Insbesondere beim Datum
+wird nicht geprüft, ob die Form 'tt.mm.jj' eingehalten wurde. Wollen
+Sie solche Überprüfungen vornehmen, lesen Sie bitte Abschnitt 11.3. 
+ 
+ 
+#abschnitt ("11.2", "KOPIEREN", "Kopieren")# 
+ 
+In diesem Abschnitt sollen Sie erfahren, wie Sie eine EUDAS-Datei
+#on("i")#kopieren#off("i")# können. Diese Funktion kann nicht nur ein inhaltsgleiches
+Duplikat einer EUDAS-Datei herstellen (dies könnten Sie einfacher
+durch eine logische Kopie bewerkstelligen, s. 16.1), sondern auch
+komplizierte Umstrukturierungen vornehmen. 
+ 
+#a ("Kopiermuster")# Der Schlüssel zu dieser Leistungsfähigkeit ist das
+#on("i")#Kopiermuster#off("i")#. Wie beim Druckmuster legen Sie dadurch die genauen
+Auswirkungen der Funktion fest. 
+    Für jedes Feld in der Zieldatei, in die kopiert werden soll,
+enthält das Kopiermuster die Angabe, woraus der Inhalt dieses
+Feldes entstehen soll. Durch Auswahl und Reihenfolge dieser Anga­
+ben bestimmen Sie die Struktur der Zieldatei. 
+    Im einfachsten Fall sieht die Kopieranweisung für ein Feld wie
+folgt aus: 
+ 
+#beispiel# 
+        "Feldname" K f ("Feldname"); 
+#text# 
+ 
+Das 'K' dient zur Festlegung der Kopierfunktion. Auf der linken
+Seite steht in Anführungsstrichen der Name des Zielfeldes. Der
+Ausdruck auf der rechten Seite gibt den zukünftigen Inhalt des
+Feldes an. Der Ausdruck im obigen Beispiel steht einfach für den
+Inhalt des Feldes 'Feldname' in der aktuellen Datei. Das Semikolon
+am Ende dient zur Abgrenzung, da der ganze Ausdruck auch mehrere
+Zeilen lang sein darf. 
+    In der oben genannten Form würde das Feld 'Feldname' iden­
+tisch in die Zieldatei kopiert. Weitere Möglichkeiten besprechen wir
+später. 
+ 
+#a ("Feldreihenfolge")# Zunächst wollen wir uns damit befassen, wie Sie
+die Feldreihenfolge in der Zieldatei beeinflussen können. Dies ge­
+schieht einfach dadurch, daß Sie die Kopieranweisungen in der ge­
+wünschten Reihenfolge aufschreiben. Damit können wir bereits ein
+erstes komplettes Beispiel betrachten: 
+ 
+#beispiel# 
+        "Name" K f ("Name"); 
+        "Vorname" K f ("Vorname"); 
+        "PLZ" K f ("PLZ"); 
+        "Ort" K f ("Ort"); 
+        "Strasse" K f ("Strasse"); 
+        "m/w" K f ("m/w"); 
+#text# 
+ 
+Dieses Kopiermuster würde die bereits beschriebene Adressendatei
+identisch kopieren, da alle Felder in der gleichen Reihenfolge vor­
+kommen. 
+    Wenn Sie jedoch die Feldreihenfolge ändern wollen (um zum
+Beispiel ein anderes Feld als erstes zu optimieren), brauchen Sie
+bloß die Reihenfolge im Kopiermuster zu verändern: 
+ 
+#beispiel# 
+        "Ort" K f ("Ort"); 
+        "Name" K f ("Name"); 
+        "Vorname" K f ("Vorname"); 
+        "PLZ" K f ("PLZ"); 
+        "Strasse" K f ("Strasse"); 
+        "m/w" K f ("m/w"); 
+#text# 
+ 
+Im Gegensatz zur Auswahl der Feldreihenfolge für die Anzeige än­
+dern Sie so die Feldreihenfolge für die Zieldatei permanent. 
+ 
+#a ("Felder anfügen")# Die beiden angegebenen Kopiermuster haben jedoch
+nur dann die beschriebene Wirkung, wenn die Zieldatei noch nicht
+existert. Bei einer existierenden Datei kann die Feldreihenfolge
+nicht mehr geändert werden; daher hat die Reihenfolge der Kopier­
+anweisungen dann keine Wirkung. 
+    Sie können jedoch zu einer existierenden Zieldatei noch Felder
+hinzufügen. EUDAS verwendet nämlich folgende einfache Vorschrift: 
+ 
+#limit (12.0)# 
+    Wenn als Zielfeld in einer Kopieranweisung ein Feld
+    genannt wird, das in der Zieldatei noch nicht vorkommt,
+    wird es als weiteres Feld der Zieldatei hinzugefügt. 
+#limit (13.5)# 
+ 
+Diese Strategie hat im Fall der nicht existierenden Datei zur Folge,
+daß alle Felder neu sind und in der Reihenfolge ihres Auftretens
+eingerichtet werden. Existiert die Datei schon, werden zusätzliche
+Felder am Ende angefügt. 
+    Beachten Sie, daß zusätzliche Felder für eine existierende
+Datei nur in den neu hinzukopierten Sätzen gefüllt sind. In den
+alten Sätzen bleiben alle neuen Felder einfach leer. 
+ 
+#a ("Satzauswahl")# An dieser Stelle sollte erwähnt werden, daß wie bei
+allen Funktionen, die die gesamte Datei betreffen, nur die durch die
+Suchbedingung ausgewählten Sätze kopiert werden. Ist mindestens
+ein Satz markiert, werden nur die markierten Sätze kopiert und die
+Suchbedingung ignoriert. 
+ 
+#a ("Teildatei")# Jetzt können Sie auch die zweite wichtige Aufgabe des
+Kopierens verstehen. Sie können aus einer Datei einen Teil der
+Sätze und einen Teil der Felder #on("i")#herausziehen#off("i")#. Danach haben Sie
+unter Umständen eine wesentlich kleinere Datei, die sich auch
+schneller bearbeiten läßt. Gerade wenn Sie nicht den allerneuesten
+64-Bit-Supercomputer haben, können Sie so viel Zeit sparen, wenn
+Sie wiederholt nur mit einem Teil der Datei arbeiten müssen. 
+    Die Auswahl der Sätze für einen solchen Zweck erfolgt über ein
+Suchmuster; im Kopiermuster geben Sie dann nur die gewünschten
+Felder an. 
+ 
+#a ("Aufruf")# An dieser Stelle wollen wir jetzt endlich behandeln, wie Sie
+die Kopierfunktion aufrufen. Dazu gibt es die Auswahl 
+#free (0.2)# 
+#beispiel# 
+        Satzauswahl 
+        K Kopieren 
+#text# 
+#free (0.2)# 
+im Menü "Gesamtdatei". Als erstes werden Sie nach dem Namen der
+Zieldatei gefragt. Existiert die Zieldatei schon und war sie vorher
+sortiert, werden Sie gefragt, ob Sie die Datei zum Schluß wieder
+sortieren wollen. Wie immer beim Sortieren werden auch hier gege­
+benenfalls nur die neu hinzugekommenen Sätze einsortiert. 
+    Als nächstes müssen Sie den Namen des Kopiermusters angeben.
+Da das Kopiermuster eine normale Textdatei ist, können Sie sich
+einen beliebigen Namen ausdenken, unter dem das Muster dann
+gespeichert wird. 
+    Wollen Sie das Kopiermuster nicht aufbewahren, sondern nur
+einmal verwenden, brauchen Sie keinen Namen anzugeben. Drücken
+Sie einfach RETURN und für die Dauer des Kopierens wird das
+Kopiermuster als unbenannte Datei eingerichtet. 
+    Nachdem Sie den Namen des Kopiermusters eingegeben haben,
+gelangen Sie in den Editor, wo Sie das Muster ändern können. Damit
+Sie beim ersten Mal nicht so viel tippen müssen, bietet EUDAS Ihnen
+bei einer neuen Musterdatei ein #on("i")#Standard-Kopiermuster#off("i")# zum Ändern
+an. Das Aussehen des Standard-Kopiermusters richtet sich danach,
+ob die Zieldatei schon existiert oder nicht. 
+    Existiert die Zieldatei noch nicht, so werden im Standard-
+Kopiermuster alle Felder der Ausgangsdatei in ihrer originalen Rei­
+henfolge angegeben. Wenn Sie dieses Muster nicht noch ändern, wird
+die aktuelle Datei identisch kopiert. 
+    Sie können jedoch die Feldreihenfolge verändern oder Felder
+weglassen, indem Sie einfach die entsprechenden Zeilen vertauschen
+oder löschen. Für Umbenennungen überschreiben Sie einfach den
+Namen auf der linken Seite der Kopieranweisung. So können Sie das
+Kopiermuster mit geringstem Aufwand erstellen. 
+    Existiert die Zieldatei jedoch schon, werden Ihnen im Kopier­
+muster alle Felder der Zieldatei angeboten. Bei Feldern, die in der
+aktuellen Datei nicht vorkommen, erscheint folgende Anweisung: 
+ 
+#beispiel# 
+        "Anrede" K ""; 
+#text# 
+ 
+Obwohl die Anweisung in diesem Fall keine Wirkung hat (wenn man
+sie wegließe, würde das Feld ebenfalls leer bleiben), ist sie dennoch
+aufgeführt, damit Sie auf der rechten Seite einen entsprechenden
+Ausdruck einsetzen können. 
+    Bei den angebotenen Anweisungen hat eine Änderung der Rei­
+henfolge oder eines Feldnamens keinen Sinn, da diese Felder ja alle
+bereits existieren. Jedoch können Sie die Ausdrücke auf der rechten
+Seite variieren und neue Anweisungen (Felder) hinzufügen. 
+ 
+#a ("Ablauf")# Wenn Sie die Eingabe des Kopiermusters mit ESC 'q' verlas­
+sen, wird das Kopiermuster übersetzt. Dabei können Fehlermeldun­
+gen auftreten. Sie können dann die Fehler korrigieren, wobei Sie die
+Fehlermeldungen gleichzeitig auf dem Bildschirm sehen können. War
+das Kopiermuster korrekt,  werden alle ausgewählten (bzw. markier­
+ten) Sätze der aktuellen Datei in die Zieldatei kopiert und diese
+anschließend gegebenenfalls noch sortiert. 
+    Die kopierten Sätze werden jeweils am Ende der Zieldatei ange­
+fügt. War die Zieldatei vorher schon sortiert, können Sie angeben,
+daß die neuen Sätze zum Schluß noch einsortiert werden. Anderen­
+falls können Sie die Datei anschließend mit der Funktion 'Sortieren'
+sortieren. 
+ 
+#a ("ELAN-Ausdrücke")# Wenn Sie schon einmal programmiert haben, wird
+Ihnen vielleicht aufgefallen sein, daß ein Kopiermuster einem
+ELAN-Programm verdächtig ähnlich sieht. Diese Vermutung trügt Sie
+nicht. Dies läßt den Schluß zu, daß Sie noch mehr ELAN hier an­
+bringen können. 
+    Haben Sie noch nie programmiert, sollten Sie jetzt nicht in
+Panik geraten, denn das Wichtigste dieses Abschnitts haben Sie
+bereits gelernt. Vielleicht sind Ihnen die folgenden Beispiele bereits
+ganz nützlich. Um alle Möglichkeiten auszunutzen, sollten Sie sich
+aber irgendwann (später!) mit den Kapiteln 14 und 15 befassen, in
+denen Sie Genaueres erfahren. 
+    Zunächst sei festgestellt, daß der rechte Teil einer Kopieran­
+weisung ein beliebiger ELAN-Ausdruck sein kann, der einen TEXT
+liefert. Den wichtigsten Ausdruck kennen Sie bereits: 
+ 
+#beispiel# 
+        f ("Feldname") 
+#text# 
+ 
+liefert den Inhalt des Feldes 'Feldname' des aktuellen Satzes der
+aktuellen Datei. Gibt es das Feld nicht, erscheint eine Fehlermel­
+dung bei der Ausführung. 
+    Sie können jedoch auch einen konstanten Text angeben, der
+dann für alle Sätze gleich ist. Dazu schließen Sie den Text einfach
+in Anführungsstriche ein. Die folgende Kopieranweisung dient dazu,
+ein neues Feld einzurichten, das aber vorläufig noch leer bleiben
+soll: 
+ 
+#beispiel# 
+        "Feldname" K ""; 
+#text# 
+ 
+Ebenso können Sie mehrere Felder zu einem neuen verbinden, zum
+Beispiel: 
+ 
+#beispiel# 
+        "Wohnort" K f ("PLZ") + " " + f ("Ort"); 
+#text# 
+ 
+Das Pluszeichen kennzeichnet die Aneinanderreihung von zwei Tex­
+ten. Denken Sie auch immer an das Semikolon am Ende. In gleicher
+Weise können Sie viele andere Textfunktionen verwenden, die in
+Kapitel 14 beschrieben sind. 
+    Prinzipiell können Sie auch Bedingungen mit IF abfragen, wie
+zum Beispiel in der folgenden Übersetzung: 
+ 
+#beispiel# 
+        IF f ("m/w") = "w" THEN 
+            "Anrede" K "Frau" 
+        ELSE 
+            "Anrede" K "Herr" 
+        END IF; 
+#text# 
+ 
+Auf diese Weise können Sie Kodierungen verschiedenster Art auto­
+matisch umsetzen. Sie müssen hierbei jedoch unbedingt darauf ach­
+ten, daß innerhalb der IF-Konstruktion immer eine Kopieranweisung
+ausgeführt wird. Falls nämlich kein Fall zutrifft und für ein Feld
+keine Kopieranweisung ausgeführt wird, wird das Feld bei einer
+neuen Datei auch nicht richtig eingerichtet. 
+ 
+ 
+#abschnitt ("11.3", "TRAGEN", "Tragen")# 
+ 
+In Kapitel 6 hatten Sie gesehen, wie man einzelne Sätze aus der
+aktuellen Datei in eine andere trägt, und auch, wie man sie wieder
+zurückholen kann. Diese Funktion diente im wesentlichen dazu,
+nicht mehr benötigte Sätze zu entfernen. 
+    Sie haben aber auch die Möglichkeit, eine ganze Reihe von
+Sätzen in einem Arbeitsgang zu tragen, nämlich alle durch das
+Suchmuster ausgewählten beziehungsweise alle markierten Sätze.
+Diese Funktion dient ebenfalls dazu, Sätze zu entfernen, beispiels­
+weise alle Sätze, die vor einem gewissen Stichtag liegen. Als wei­
+tere Anwendung können Sie beim Tragen aber auch Bedingungen
+überprüfen. 
+    Diese #on("i")#Prüfbedingungen#off("i")# sollen sicherstellen, daß die Daten in
+einer Datei ganz bestimmten Richtlinien entsprechen. Zum Beispiel
+kann geprüft werden, ob ein eingegebenen Datum stimmen kann, ob
+ein Satz doppelt aufgenommen wurde oder ob eine Artikelnummer die
+richtige Anzahl von Stellen hat. 
+    Die Prüfbedingungen werden einer Datei fest zugeordnet. Sie
+können mit der Funktion 
+#free (0.2)# 
+#beispiel# 
+        P Prüfbed. 
+#text# 
+#free (0.2)# 
+im Menü 'Öffnen' eingegeben oder geändert werden. Die Prüfbedin­
+gungen werden als Text im Editor geschrieben. 
+ 
+#a ("Ablauf")# Das ganze Verfahren läuft nun so ab: Sie fügen neue Sätze
+immer erst in eine Zwischendatei ein, die die gleiche Struktur wie
+die eigentliche Datei hat. Wenn Sie alle Sätze fertig eingegeben
+haben, tragen Sie diese Datei komplett in die gewünschte Datei.
+Dabei werden die Prüfbedingungen getestet. 
+    Erfüllt ein Satz die Bedingungen, wird er anstandslos getragen.
+Trifft eine Bedingung aber nicht zu, bleibt der Satz in der Zwi­
+schendatei und eine entsprechende Meldung wird ausgegeben. Die
+Meldungen werden gespeichert, um Sie später nochmal abrufen zu
+können. 
+    Sie müssen jetzt in der Zwischendatei die notwendigen Ände­
+rungen durchführen, damit die Prüfbedingungen erfüllt werden. Beim
+Aufruf der Funktion 
+#free (0.2)# 
+#beispiel# 
+        A Ändern 
+#text# 
+#free (0.2)# 
+können Sie mit Hilfe der Tastenkombination ESC 'P' (großes P) die
+Datei mit den Fehlermeldungen in einem kleinen Teilfenster editie­
+ren. Anhand dieser Hinweise können Sie dann den Satz korrigieren.
+Die Meldungen bleiben bis zum nächsten Öffnen oder Tragen erhal­
+ten. 
+    Nach der Korrektur können Sie den gleichen Vorgang erneut
+aufrufen - es sind ja nur noch die zuerst fehlerhaften Sätze in der
+Zwischendatei. Bei Bedarf können Sie diesen Vorgang wiederholen,
+bis alle Sätze korrekt übernommen worden sind. 
+ 
+#a ("Aufruf")# Das Tragen wird aufgerufen durch die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Satzauswahl 
+        T Tragen 
+#text# 
+#free (0.2)# 
+Nach Eingabe des Zieldateinamens müssen Sie noch angeben, ob Sie
+die Prüfbedingungen testen wollen. 
+ 
+#a ("Prüfbedingungen")# Zu diskutieren bleibt noch die Form der Prüfbe­
+dingungen. Diese stellen ein kleines ELAN-Programm dar, in dem
+einige spezielle Prozeduren zum Prüfen enthalten sind. Wenn Sie
+nicht ELAN programmieren können, sollte Sie diese Bemerkung nicht
+erschrecken: die Prüfbedingungen sind einfach genug. 
+    Sie schreiben also die Prüfbedingungen jeweils untereinander.
+Eine mögliche Bedingung ist 
+ 
+#beispiel# 
+        wertemenge ("Feldname", "Wert1,Wert2,Wert3,Wert4"); 
+#text# 
+ 
+Diese Bedingung gibt an, daß das Feld einen der angegebenen Werte
+haben muß. Die Werte werden untereinander durch Komma getrennt.
+Es gibt jedoch keine Möglichkeit, Werte mit Komma darzustellen, da
+das Komma immer als Trennung wirkt. Leerzeichen dürfen in den
+Werten vorkommen, sie müssen dann aber auch genau so im Feld
+stehen. 
+    Wir könnten zum Beispiel eine Bedingung für unser Feld 'm/w'
+wie folgt formulieren 
+ 
+#beispiel# 
+        wertemenge ("m/w", "m,w"); 
+#text# 
+ 
+EUDAS würde sich dann beschweren, wenn das Feld leer wäre (ir­
+gendein Geschlecht muß die Person ja wohl haben). Wenn das Feld
+auch leer sein darf, geben Sie einfach zwei Kommata hintereinander
+oder ein Komma am Anfang an: 
+ 
+#beispiel# 
+        wertemenge ("m/w", ",m,w"); 
+#text# 
+ 
+Eine andere Möglichkeit der Prüfbedingung besteht darin, eine
+Maske für ein Feld zu definieren. Diese Maske gibt an, daß an be­
+stimmten Stellen des Feldes nur bestimmte Zeichen stehen dürfen.
+So könnte man zum Beispiel folgende Maske für ein Datumsfeld
+angeben: 
+ 
+#beispiel# 
+        feldmaske ("Datum", "99.99.99"); 
+#text# 
+ 
+Die Neunen haben hier eine spezielle Bedeutung und und stehen für
+eine beliebige Ziffer. Es gibt noch einige weitere Zeichen, die eine
+reservierte Bedeutung haben, nämlich: 
+ 
+#beispiel# 
+        '9'   für jede Ziffer (wie schon erwähnt) 
+        'X'   für jedes Zeichen 
+        'A'   für jeden Großbuchstaben 
+        'a'   für jeden Kleinbuchstaben 
+        '*'   für eine Folge beliebiger Zeichen 
+#text# 
+ 
+Alle anderen Zeichen im Muster stehen für sich selbst. Eine Sonder­
+stellung besitzt der Stern; er sollte sparsam verwendet werden, da
+seine Benutzung etwas aufwendiger ist. Der Stern kann auch für
+eine leere Zeichenfolge stehen. Als weiteres Beispiel könnte man
+definieren 
+ 
+#beispiel# 
+        feldmaske ("Name", "A*"); 
+#text# 
+ 
+damit immer ein Name angegeben ist, der noch dazu mit einem Groß­
+buchstaben beginnt. 
+    Für Bedingungen, die sich nicht mit diesen beiden Prozeduren
+formulieren lassen, gibt es noch 
+ 
+#beispiel# 
+        pruefe ("Feldname", Bedingung); 
+#text# 
+ 
+Diese Prozedur erhält einen logischen (booleschen) Wert als Parame­
+ter, der einen Vergleich darstellt. Ist dieser Parameter falsch
+(FALSE), wird eine entsprechende Fehlermeldung protokolliert. So
+könnte man folgende Bedingung angeben: 
+ 
+#beispiel# 
+        pruefe ("Alter", wert ("Alter") > 18.0); 
+#text# 
+ 
+Diese Bedingung würde sicherstellen, daß alle Personen in der Datei
+volljährig sind ('wert' ist eine von EUDAS definierte Funktion, die
+den Inhalt eines Feldes als REAL-Zahl liefert - denken Sie auch
+daran, daß der ELAN-Compiler Zahlen mit Dezimalpunkt geschrieben
+haben möchte). 
+    Da die Prüfbedingungen ein ELAN-Programm sind, können Sie
+natürlich sämtliche ELAN-Anweisungen verwenden. 
+    Weiterhin haben Sie die Möglichkeit, Doppeleinträge zu verhin­
+dern. Dazu geben Sie mit Hilfe der Prozedur 
+ 
+#beispiel# 
+        eindeutige felder (n); 
+#text# 
+ 
+wieviele Felder vom ersten an eindeutig sein sollen. Ein zu tragen­
+der Satz, der mit irgendeinem anderen Satz in diesen Feldern über­
+einstimmt, wird als fehlerhaft zurückgewiesen. In unserer Adressen­
+datei könnte man 
+ 
+#beispiel# 
+        eindeutige felder (2); 
+#text# 
+ 
+angeben. Damit würde ein neuer Satz mit bereits vorhandenem Na­
+men und Vornamen abgelehnt. 
+ 
+#a ("Limit")# Aus technischen Gründen können die Prüfbedingungen einer
+Datei nur 2000 Zeichen umfassen. Wollen Sie aufwendigere Bedin­
+gungen konstruieren, sollten Sie sich diese als Prozedur definieren
+und insertieren. In den Prüfbedingungen müssen Sie dann nur diese
+Prozedur aufrufen. 
+ 
+ 
+#abschnitt ("11.4", "AUTOMATISCHE ÄNDERUNGEN", "Automatische Änderungen")# 
+ 
+Mit EUDAS können Sie die geöffnete Datei nicht nur satzweise von
+Hand ändern, sondern auch automatisch die ganze Datei. Dazu müs­
+sen Sie dem Rechner eine Vorschrift geben, nach der er handeln
+kann. Ein solches #on("i")#Änderungsmuster#off("i")# stellt im Prinzip schon ein klei­
+nes Programm dar. Der Änderungsvorgang wird durch die Auswahl 
+#free (0.2)# 
+#beispiel# 
+        V Verändern 
+#text# 
+#free (0.2)# 
+aufgerufen. Dabei wird der Name des Änderungsmusters erfragt. Dies
+ist eine normale Textdatei. Existiert das Muster noch nicht, können
+Sie den Inhalt an dieser Stelle im Editor angeben. Anschließend
+werden alle ausgewählten Sätze nach der Vorschrift bearbeitet.
+Dabei wird jeweils die aktuelle Satznummer ausgegeben. 
+ 
+#a ("Änderungsmuster")# Da auch ein Kopiermuster ein Programm ist, ist
+es nicht erstaunlich, daß Änderungsmuster ganz ähnlich aussehen.
+Eine typische Zeile sieht etwa so aus: 
+ 
+#beispiel# 
+        "Feldname" V "neuer Inhalt"; 
+#text# 
+ 
+Diese Zeile bedeutet: Ersetze den Inhalt des Feldes 'Feldname'
+durch den Text 'neuer Inhalt'. Anstelle des neuen Textes kann
+wieder ein beliebiger ELAN-Ausdruck stehen. Ein Beispiel, in dem
+ein Feld einen Stern angehängt bekommt, sieht dann so aus: 
+ 
+#beispiel# 
+        "Feldname" V f ("Feldname") + "*"; 
+#text# 
+ 
+Beachten Sie, daß Sie den Ausdruck auf der rechten Seite eventuell
+in Klammern setzen müssen (obwohl der Operator 'V' die niedrigste
+Priorität hat). Wenn Sie sich nicht sicher sind, können Sie den Aus­
+druck immer in Klammern einschließen. 
+    Ebenso wie im Kopiermuster können Sie hier beliebige ELAN-
+Ausdrücke verwenden. Auch IF-Abfragen und ähnliche Konstruktio­
+nen sind möglich, im Gegensatz zum Kopiermuster sogar ohne Be­
+schränkungen. 
+    Im Vergleich zu einem separat geschriebenen ELAN-Programm
+hat das Änderungsmuster den Vorteil, daß Sie nur die eigentlichen
+Veränderungsanweisungen kodieren müssen. Die wiederholte Anwen­
+dung auf die ausgewählten Sätze erledigt EUDAS automatisch. Wol­
+len Sie eine solche Änderungsanweisung fest insertieren, so brau­
+chen Sie das Muster nur in eine Prozedur zu verpacken und EUDAS
+zu übergeben (Näheres s. Referenzhandbuch). 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.12 b/app/eudas/4.4/doc/user-manual/eudas.hdb.12
new file mode 100644
index 0000000..b62dcbf
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.12
@@ -0,0 +1,431 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (123)# 
+#kapitel ("12", "Weitere", "Möglichkeiten", "zum Drucken")# 
+ 
+ 
+ 
+#abschnitt ("12.1", "ANSCHLUSS AN DIE TEXTVERARBEITUNG", "Anschluß an die Textverarbeitung")# 
+ 
+Auf zweierlei Art und Weise kann der EUDAS-Druckgenerator mit
+den Programmen der EUMEL-Textverarbeitung zusammenarbeiten.
+Zum ersten können Ausgabedateien des Druckprozesses anschließend
+mit den Textkosmetik-Werkzeugen bearbeitet werden. Zum anderen
+kann EUDAS im Editor direkt Daten aus einer EUDAS-Datei in die
+editierte Datei importieren. 
+ 
+#a ("Druckrichtung")# Wie Sie schon in Kapitel 7 gesehen haben, kann
+man die Ausgabe des Druckgenerators statt auf den Drucker in eine
+Datei umleiten. Die Datei erhält dann einen automatisch generierten
+Namen. Sie können jedoch auch festlegen, daß die Ausgabe in eine
+ganz bestimmte Datei geschrieben werden soll. Dazu wählen Sie die
+Funktion 
+#f2# 
+#beispiel# 
+        Ausgabe 
+        R Richtung 
+#text# 
+#f2# 
+im Druckmenü. Es erscheint die Frage 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Ausgabe automatisch zum Drucker (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Verneinen Sie die Frage und es erscheint 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Ausgabe in bestimmte Datei (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Wenn Sie diese Frage auch verneinen, erhält die Ausgabedatei einen
+automatisch generierten Namen. Wenn Sie die Frage aber bejahen,
+können Sie anschließend den Namen der Ausgabedatei angeben. 
+    Existiert die angegebene Datei schon, wird der Ausdruck am
+Ende der Datei angefügt. Anderenfalls wird die Datei neu eingerich­
+tet. 
+    Die Angabe der Ausgabedatei gilt jedoch nur für den folgenden
+Druckvorgang. Wenn Sie mehrmals in die gleiche Datei drucken wol­
+len, müssen Sie den Namen immer wieder neu angeben. Falls Sie dies
+vergessen, wird die folgenden Male wieder ein Name automatisch
+generiert. 
+ 
+#a ("Begrenzung der Dateigröße")# Für kleinere Systeme ist es vorteilhaft,
+wenn die Druckausgabe nicht in einer großen Datei gesammelt wird,
+sondern sich auf mehrere kleine Dateien verteilt. Da die Ausgabe­
+datei nach dem Drucken gelöscht wird, kann man auf diese Weise
+einen Hintergrundengpaß vermeiden. Es besteht die Möglichkeit, die
+maximale Größe der Ausgabedatei mit dem ELAN-Kommando 
+#f2# 
+#beispiel# 
+        maxdruckzeilen (1000) 
+#text# 
+#f2# 
+auf eine bestimmte Zeilenzahl (maximal 4000) zu beschränken. Wenn
+der Druckgenerator nach der Bearbeitung eines Satzes feststellt,
+daß diese Maximalzahl überschritten wurde, wird die Ausgabedatei
+direkt gedruckt (falls durch 'Richtung' eingestellt) und eine neue
+Ausgabedatei eröffnet. 
+ 
+#a ("Initialisierungsteil")# Dabei ist jedoch zu beachten, daß Drucker­
+steuerungsanweisungen, die im Vorspann eingestellt wurden, jetzt in
+der neuen Datei nicht mehr vorhanden sind. In einem solchen Fall
+würden die folgenden Teile der Ausgabe mit einer anderen Einstel­
+lung gedruckt. 
+    Um dies zu vermeiden, können Sie solche Anweisungen in den
+#on("i")#Initialisierungsteil#off("i")# schreiben. Der Initialisierungsteil umfaßt alle
+Zeilen des Druckmusters bis zum ersten Abschnitt, also bis zur
+ersten Anweisung. Zeilen im Initialisierungsteil werden beim Eröff­
+nen einer neuen Ausgabedatei an den Anfang dieser Datei ge­
+schrieben. 
+    Druckersteuerungsanweisungen, die ein bestimmtes Schriftbild
+der Ausgabe erzeugen ('type', 'limit', 'linefeed', 'start' usw.), sollten
+also in den Initialisierungsteil vor Beginn aller Abschnitte ge­
+schrieben werden. 
+ 
+#a ("Nachbearbeitung")# Wenn Sie in der Druckausgabe verschiedene
+Schriften oder Proportionalschrift verwenden wollen, sollten Sie die
+folgenden Hinweise beachten. Da EUDAS keine Informationen über
+die Schriftbreiten und -größen hat, werden alle Schrifttypen gleich
+behandelt. Dies gilt insbesondere für die Zeilenbreite, die ja durch
+das Dateilimit des Druckmusters festgelegt ist. 
+    So kann es passieren, daß Zeilen mit kleinen Schrifttypen zu
+früh abgeschnitten werden, während Zeilen mit großen Schriften
+nicht mehr auf das Blatt passen. Für diesen Fall sollten Sie das
+größte benötigte Limit einstellen (zum Beispiel 135 bei Schmal­
+schrift auf DIN A 4) und die Ausgabedatei anschließend mit 'line­
+form' bearbeiten. 
+    'lineform' verteilt zu langen Text auf mehrere Zeilen. Außerdem
+werden gegebenenfalls Trennungen durchgeführt. 
+    'lineform' benötigt zur Information Absatzmarken. Fehlt an
+einer Zeile die Absatzmarke, wird die nächste Zeile so weit wie
+möglich direkt angehängt. Die Absatzmarken in der Ausgabedatei
+werden direkt aus dem Druckmuster übernommen (es ist nicht mög­
+lich, Absatzzeilen durch eingesetzte Leerzeichen zu erzeugen). Im
+Normalfall sollten alle Zeilen im Druckmuster eine Absatzmarke
+haben. 
+    Wenn Sie seitenorientierte Überschriften haben möchten, kön­
+nen Sie auch 'pageform' einsetzen. Die gewünschten Überschrift­
+anweisungen können Sie im Initialisierungsteil angeben. 
+    Die beiden Funktionen wählen Sie über den Menüpunkt 
+#f2# 
+#beispiel# 
+        N Nachbearb. 
+#text# 
+#f2# 
+im Druckmenü. Dort können Sie den Namen der Ausgabedatei ange­
+ben, die Sie bearbeiten möchten. Es wird jeweils gefragt, ob Sie
+'lineform' und 'pageform' anwenden wollen. Das Ergebnis der Bear­
+beitung können Sie danach ausdrucken. 
+ 
+#a ("EUDAS im Editor")# Wenn Sie sich im Editor zum Zweck der Textver­
+arbeitung befinden, können Sie Daten aus einer EUDAS-Datei direkt
+in die editierte Datei übernehmen. Dazu wählen Sie zunächst die
+gewünschten Sätze aus - danach geben Sie den Namen eines Druck­
+musters an. EUDAS druckt die gewählten Sätze unter Beachtung des
+Druckmusters direkt in die editierte Datei. 
+    Wenn Sie das Kommando 
+#f2# 
+#beispiel# 
+        eudas 
+#text# 
+#f2# 
+im Editor geben (nach ESC ESC), gelangen Sie in ein spezielles
+Kurzprogramm, das alle notwendigen Information von Ihnen erfragt. 
+    Zunächst müssen Sie den Namen der gewünschten EUDAS-Datei
+angeben. Diese Datei wird dann automatisch geöffnet. Vorher geöff­
+nete Dateien werden nach Anfrage gesichert. Beachten Sie, daß
+keine Datei mehr geöffnet ist, wenn Sie später EUDAS wieder normal
+aufrufen. 
+    Danach wird Ihnen eine Übersicht aller Sätze gezeigt - in einer
+Form, die Sie aus der Funktion 'Übersicht' bereits kennen. Wie dort
+wird Ihnen zunächst eine Auswahl der Felder angeboten, um die
+Anzeige übersichtlich zu halten. Anschließend können Sie noch ein
+Suchmuster angeben. 
+    In der Übersicht können Sie sich dann zu einem bestimmten
+Satz bewegen oder mehrere Sätze markieren. Nach dem Verlassen der
+Übersicht können Sie den aktuellen Satz oder alle ausgewählten
+(bzw. markierten) Sätze drucken. Natürlich können Sie auch beide
+Fragen verneinen. 
+    Zum Drucken wird der Name des Druckmusters erfragt. Dieses
+muß bereits existieren. Die Ausgabe wird an der Stelle eingefügt, an
+der der Cursor in der editierten Datei steht - die Zeile wird bei
+Bedarf aufgesplittet. 
+    Nach dem Drucken können Sie den Vorgang wiederholen, wenn
+Sie zum Beispiel einen weiteren Satz drucken wollen. Dazu können
+Sie auch ein neues Suchmuster angeben. Markierungen von Sätzen
+werden nach dem Drucken gelöscht. 
+ 
+ 
+#abschnitt ("12.2", "SPALTENDRUCK", "Spaltendruck")# 
+ 
+Für manche Anwendungen reicht es nicht aus, wenn die bearbeite­
+ten Sätze jeweils untereinander in der Ausgabe erscheinen. Häufig­
+stes Beispiel dafür ist der Etikettendruck. Hierfür werden vielfach
+mehrbahnige Formulare eingesetzt. 
+    In diesem Fall müssen die Sätze bis zur gewünschten Anzahl
+von Spalten nebeneinander gesetzt werden - erst danach wird die
+nächste Reihe angefangen. 
+    EUDAS unterstützt diese Anwendung. Dazu wird hinter der
+'%WIEDERHOLUNG'-Anweisung die Anzahl der Spalten als Parameter
+geschrieben (durch Leerzeichen getrennt). Der Wiederholungsteil
+wird dann mit der angegebenen Anzahl von Spalten gedruckt. Zu
+beachten ist, daß Vorspann und Nachspann diese Spaltenanordnung
+durchbrechen, also immer hinter dem bisher Gedruckten beginnen. 
+    Die Spaltenbreite wird vom Dateilimit des Druckmusters be­
+stimmt. Die Zeilen eines Wiederholungsteils werden bis zum Limit
+mit Leerzeichen aufgefüllt, wenn der nächste Wiederholungsteil
+danebengesetzt wird. 
+    Alternativ kann die Spaltenbreite in Zeichen auch als zweiter
+Parameter angegeben werden. Der Wert gilt jedoch nur für den Wie­
+derholungsteil - Vor- und Nachspann richten sich immer nur nach
+dem Dateilimit. 
+    Es spielt keine Rolle, ob die nebeneinandergesetzten Wieder­
+holungsteile unterschiedliche Längen haben. Die kürzeren Teile
+werden einfach bei Bedarf durch Leerzeilen ergänzt. Es ist jedoch zu
+beachten, daß sich auf diese Weise unterschiedliche Längen für die
+einzelnen Reihen ergeben können. 
+    Beispiel: Das Ergebnis für Satz 1, 3, 4 und 5 sei vier Zeilen
+lang, für Satz 2 aber fünf Zeilen. Bei zweispaltigem Druck wird die
+erste Reihe eine Zeile länger als die folgenden (s. dazu Abb. 12-1). 
+ 
+#beispiel# 
+        Satz 1              Satz 2 
+        braucht             braucht 
+        vier Zeilen.        ausnahmsweise 
+        ----------------    fünf Zeilen. 
+                            ---------------- 
+        Satz 3              Satz 4 
+        braucht             braucht 
+        vier Zeilen.        vier Zeilen. 
+        ----------------    ---------------- 
+        Satz 5 
+        braucht 
+        vier Zeilen. 
+        ----------------
+ 
+#center#Abb. 12-1   Seitenaufteilung beim Spaltendruck 
+#text# 
+ 
+#a ("Beispiel")# Zum Abschluß noch als Beispiel ein Druckmuster für ein
+dreibahniges Etikettenformular. Die Spaltenbreite und die Länge des
+Wiederholungsteils richten sich natürlich nach dem verwendeten
+Formular und müssen im Einzelfall ausprobiert werden. 
+ 
+#beispiel# 
+        % VORSPANN 
+        \#start (1.0, 0.8)\# 
+        % WIEDERHOLUNG 3 40 
+ 
+        &Vorname %Name 
+        &Strasse 
+ 
+        &PLZ %Ort 
+        \#free (1.693)\# 
+#text# 
+ 
+ 
+#abschnitt ("12.3", "MODI", "Modi")# 
+ 
+Gesetzt der Fall, Sie wollen eine Tabelle drucken, deren Einträge
+auf jeden Fall in voller Länge erscheinen sollen, auch wenn sie die
+Spaltenbreite überschreiten. Dies würde bedeuten, daß Tabellenein­
+träge nach rechts geschoben werden, wenn vorhergehende Einträge
+länger sind. Für diesen Fall können also nur Feldmuster variabler
+Position (mit '%') eingesetzt werden. Diese werden jedoch auch nach
+links geschoben, wenn vorher kürzere Inhalte auftreten. 
+ 
+#a ("Tabellenmodus")# Um dieses Linksschieben zu unterdrücken, können
+Sie mit folgender Anweisung im Musterteil in den #on("i")#Tabellenmodus#off("i")#
+umschalten: 
+ 
+#beispiel# 
+        % MODUS 2 
+#text# 
+ 
+Der so eingestellte Modus gilt bis zum Ende des jeweiligen Ab­
+schnitts. Zu Beginn eines Abschnitts ist der Modus 1 (Normalmodus)
+eingestellt. 
+ 
+#a ("Beispiel")# Um diese Anweisung auszuprobieren, sollten Sie folgendes
+Druckmuster auf unsere Beispieldatei anwenden: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        % MODUS 2 
+        &Vorname %Name 
+#text# 
+ 
+In der Ausgabe können Sie sehen, daß der Nachname nicht nach
+links geschoben wird, so daß eine Tabelle entsteht. Ist der Vorname
+jedoch zu lang, wird die Tabelleneinteilung durchbrochen und der
+Nachname nach rechts geschoben, um den Vornamen nicht abschnei­
+den zu müssen: 
+ 
+#beispiel# 
+        Herbert  Wegner 
+        Helga    Sandmann 
+        Albert   Katani 
+        Peter    Ulmen 
+        Karin    Regmann 
+        Hubert   Arken 
+        Anna-Maria Simmern 
+        Angelika Kaufmann-Drescher 
+        Harald   Fuhrmann 
+        Friedrich Seefeld 
+#text# 
+ 
+#a ("Zeilenfortsetzung")# Eine weitere Möglichkeit, überlange Feldinhalte
+einzusetzen, besteht darin, daß der Rest des Inhaltes, der nicht
+mehr in den reservierten Raum paßt, in der nächsten Zeile fortge­
+setzt wird. Dies wird im Modus 3 erreicht. Falls ein Feldinhalt ab­
+geschnitten werden müßte, wird in diesem Modus die gleiche Mu­
+sterzeile nochmal mit den restlichen Inhalten gedruckt. Dies wird
+fortgesetzt, bis alle Inhalte abgearbeitet sind. 
+    Damit die Fortsetzung sinnvoll ist, wird das letzte Wort ganz in
+die nächste Zeile übernommen, falls es zerschnitten würde (ähnlich
+wie im Editor). Der dadurch freiwerdende Raum in der vorigen Zeile
+wird mit Leerzeichen gefüllt. Ist rechtsbündiges Einsetzen verlangt,
+werden die einzelnen Teile jeweils rechtsbündig in ihrem reservier­
+ten Platz justiert. 
+    Dieser Modus ist besonders interessant, wenn Sie längere Kom­
+mentare in eine EUDAS-Datei eintragen, die Sie dann natürlich auch
+wieder drucken wollen. Den Text tragen Sie bereits in mehreren
+Zeilen in die EUDAS-Datei ein. Beachten Sie, daß der Umbruch des
+Textes im Druck nicht mit dem Umbruch des Textes am Bildschirm
+übereinstimmt. Wollen Sie dies verhindern, müssen Sie jeden Absatz
+des Textes in ein eigenes Feld schreiben. 
+    Wie zu Anfang des Kapitels bereits angedeutet, kann der Um­
+bruch bei Proportionalschrift nicht korrekt sein, da EUDAS die Zei­
+chenbreiten nicht kennt. Um die nachfolgende Bearbeitung mit
+'lineform' zu ermöglichen, werden bei fortgesetzten Feldern grund­
+sätzlich keine Absatzmarken an die Zeilen geschrieben. Lediglich die
+letzte Fortsetzungszeile erhält eine Absatzmarke. 
+    In den Fortsetzungszeilen, werden die Feldmuster, deren Inhalte
+bereits abgearbeitet sind, leer eingesetzt. Die Mustertexte zwischen
+den Feldmustern werden in den Fortsetzungszeilen durch Leerzei­
+chen ersetzt. 
+    Die Anzahl der Fortsetzungszeilen kann durch die Anweisung 
+ 
+#beispiel# 
+        % MEHR n 
+#text# 
+ 
+auf eine bestimmte Zahl 'n' festgelegt werden. Wenn alle Inhalte
+abgearbeitet wurden, aber die Anzahl der Zeilen noch nicht erreicht
+ist, werden entsprechend viele Zeilen mit leeren Inhalten erzeugt. 
+    Die Zeilenwiederholung kann auch mit dem Tabellenmodus kom­
+biniert werden. Dies wird im Modus 4 erreicht. Felder variabler
+Position werden auch in diesem Modus nicht nach links geschoben.
+Außerdem werden aber in Fortsetzungszeilen die Mustertexte zwi­
+schen den Feldmustern wiederholt, um z.B. Tabellenbegrenzungen zu
+erzeugen. 
+ 
+#a ("Beispiele")# Zur Verdeutlichung hier noch einige Beispiele. Das fol­
+gende Druckmuster: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        % MODUS 3 
+        Kommentar: &Kommentar 
+        ---------- 
+#text# 
+ 
+könnte folgende Ausgabe bewirken: 
+ 
+#beispiel# 
+        Kommentar: Dies ist ein längerer Kommentar aus 
+                   einer EUDAS-Datei, der zum Drucken 
+                   auf eine Breite von 48 Zeichen 
+                   umbrochen worden ist. Nur die letzte 
+                   Zeile hat eine Absatzmarke. 
+        ---------- 
+#text# 
+ 
+Soll die Anzahl der Zeilen immer gleich bleiben, könnte man folgen­
+des Druckmuster verwenden: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        % MODUS 3 
+        % MEHR 5 
+        Kommentar: &Kommentar 
+    ---------- 
+#text# 
+ 
+Mit einem kürzeren Text ergäbe sich folgendes Bild: 
+ 
+#beispiel# 
+        Kommentar: Nur ein kurzer Text. 
+ 
+ 
+ 
+ 
+        ---------- 
+#text# 
+ 
+Für eine Tabelle würde man den Modus 4 benutzen: 
+ 
+#beispiel# 
+    % VORSPANN 
+    -------------------------------------------------------- 
+    ! Abk.    ! Kommentar                                  ! 
+    !---------+--------------------------------------------! 
+    % WIEDERHOLUNG 
+    % MODUS 4 
+    ! &abk    ! &Kommentar&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! 
+    ----------+--------------------------------------------- 
+#text# 
+ 
+Als Ausgabe könnte folgender Text erscheinen: 
+ 
+#beispiel# 
+    -------------------------------------------------------- 
+    ! Abk.    ! Kommentar                                  ! 
+    !---------+--------------------------------------------! 
+    ! MA11    ! Dieser Kurs hat eine Menge an besonderen   ! 
+    !         ! Eigenschaften, die ihn für jüngere         ! 
+    !         ! Teilnehmer geeignet erscheinen lassen.     ! 
+    !---------+--------------------------------------------! 
+    ! TD04    ! Stellt keine besonderen Anforderungen.     ! 
+    !---------+--------------------------------------------! 
+    ! PM01    ! Seit dem 01.01. eingerichtet und noch      ! 
+    !         ! nicht voll besetzt.                        ! 
+    ----------+--------------------------------------------- 
+#text# 
+ 
+Beachten Sie hier, daß Tabelleneinträge hier nicht wie im Modus 2
+geschoben, sondern auf weitere Zeilen verteilt werden, wenn sie zu
+lang sind. Außerdem werden die Tabellenbegrenzungen mit wieder­
+holt. Das Feldmuster für Kommentar muß jedoch mit fester Länge
+angegeben werden, da sonst die rechte Tabellenbegrenzung bis zum
+Dateilimit geschoben würde. 
+ 
+#a ("Zusammenfassung")# Zum Abschluß dieses Abschnitts eine Zusammen­
+fassung aller möglichen Modi: 
+ 
+    Modus   Effekt 
+ 
+      1     Normalmodus. 
+            '%'-Feldmuster werden auch nach links geschoben. 
+            Keine Zeilenwiederholung. 
+#f2# 
+      2     Tabellenmodus. 
+            '%'-Feldmuster werden nicht nach links geschoben. 
+            Keine Zeilenwiederholung. 
+#f2# 
+      3     Normalmodus mit Zeilenwiederholung. 
+            '%'-Feldmuster werden auch nach links geschoben. 
+            Zeilenwiederholung ohne Zwischentexte. 
+#f2# 
+      4     Tabellenmodus mit Zeilenwiederholung. 
+            '%'-Feldmuster werden nicht nach links geschoben. 
+            Zeilenwiederholung mit Zwischentexten. 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.13 b/app/eudas/4.4/doc/user-manual/eudas.hdb.13
new file mode 100644
index 0000000..387d439
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.13
@@ -0,0 +1,734 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (133)# 
+#kapitel ("13", "Programmierung", "von", "Druckmustern")# 
+ 
+ 
+ 
+#abschnitt ("13.1", "ABKÜRZUNGEN", "Abkürzungen")# 
+ 
+In den vorigen Kapiteln haben Sie erfahren, daß man Feldmuster
+von ganz bestimmter Länge definieren kann, deren Inhalt in genau
+dieser Länge eingesetzt und bei Bedarf abgeschnitten wird. Bei der
+Angabe dieser Länge spielt jedoch die Länge des Feldnamens eine
+ganz entscheidende Rolle. Das kürzeste Feldmuster fester Länge, das
+Sie definieren können, ist nämlich zwei Zeichen länger als der Feld­
+name (ein Musterzeichen vorher und eins nachher). 
+    Hätte das Feld 'PLZ' den Namen 'Postleitzahl' bekommen, so
+müßte ein solches Feldmuster mindestens eine Länge von 14 Zeichen
+haben. Damit Sie mit diesem Feldnamen auch ein Feldmuster der
+Länge 4 bekommen können (Postleitzahlen haben in den seltensten
+Fällen mehr als 4 Stellen), haben Sie die Möglichkeit, den Namen
+'Postleitzahl' für die Verwendung im Druckmuster geeignet abzu­
+kürzen. 
+    Abkürzungen haben jedoch noch eine viel weitreichendere
+Bedeutung. Mit ihnen ist es möglich, nicht nur die Feldinhalte einer
+EUDAS-Datei einzusetzen, sondern auch jeden anderen Text, den Sie
+mit einem ELAN-Programm erzeugen können. 
+    Die einfachsten zusätzlichen Daten, die Sie verwenden können,
+sind z.B. Datum und Uhrzeit. Für weitergehende Zwecke können Sie
+die Inhalte der EUDAS-Datei auch für Berechnungen verwenden und
+damit so umfangreiche Probleme wie das Schreiben von Rechnungen
+oder statistische Auswertungen unter Verwendung eines Druck­
+musters lösen. 
+ 
+#a ("Abkürzungsteil")# Abkürzungen werden in einem speziellen Abkür­
+zungsteil am Ende eines Abschnittes angegeben. Der Abkürzungsteil
+wird durch die Anweisung 
+ 
+#beispiel# 
+        % ABKUERZUNGEN 
+#text# 
+ 
+eingeleitet. Eine Abkürzungsdefinition hat eine ähnliche Form wie
+ein Refinement (Falls Sie nicht wissen, was das ist, vergessen Sie
+es). Zu Beginn steht der Name der Abkürzung in Form eines Feld­
+musters, beginnend in der ersten Spalte. Danach folgt, durch Leer­
+zeichen getrennt, ein Doppelpunkt in der gleichen Zeile. Daran
+schließt sich ein beliebiger ELAN-Ausdruck an, der sich in freiem
+Format über beliebig viele Zeilen erstrecken kann und mit einem
+Punkt abgeschlossen werden muß. Dieser ELAN-Ausdruck muß ein
+TEXT-Objekt liefern. 
+ 
+#a ("Feldinhalt")# Für die Abfrage von Inhalten aus einer EUDAS-Datei
+ist der Ausdruck 
+#f2# 
+#beispiel# 
+        f ("Feldname") 
+#text# 
+#f2# 
+vordefiniert. Die Abkürzung des Feldes 'Postleitzahl' würde also als
+Ausschnitt folgendermaßen aussehen: 
+ 
+#beispiel# 
+    % ABKUERZUNGEN 
+    &p :  f ("Postleitzahl") . 
+#text# 
+ 
+Mit dieser Definition kann man im Muster so verfahren, als ob das
+Feld 'Postleitzahl' auch 'p' hieße. Diese einfachste Form der Ab­
+kürzung können Sie natürlich variieren, indem Sie für 'p' und
+'Postleitzahl' Ihre eigenen Namen einsetzen. 
+ 
+#a ("Übersetzung")# Beachten Sie, daß das Druckmuster in ein ELAN-Pro­
+gramm umgeformt werden muß, da ELAN-Ausdrücke in ihm vorkom­
+men. Das automatisch erzeugte ELAN-Programm wird dann vom
+ELAN-Compiler übersetzt und ausgeführt. Fehler in den ELAN-Aus­
+drücken im Abkürzungsteil können erst vom ELAN-Compiler ent­
+deckt werden. Dieser kennt jedoch das Druckmuster nicht und mel­
+det die Fehler anhand des generierten Programms. Sie müssen in
+einem solchen Fall aufpassen, daß Sie die Fehlerquelle an der rich­
+tigen Stelle im Druckmuster lokalisieren (Hilfestellungen dazu sind
+im Kapitel über die Übersetzung von Druckmustern zu finden). 
+ 
+#a ("Beispiel")# Um die Verwendung von Abkürzungen zu demonstrieren,
+wollen wir folgendes Druckmuster betrachten: 
+ 
+#beispiel# 
+        % VORSPANN 
+        Adressenliste als Beispiel für Abkürzungen 
+        Stand: &Datum 
+        ------------------------------------------ 
+        % ABKUERZUNGEN 
+        &Datum : date . 
+ 
+        % WIEDERHOLUNG 
+        &&l :  &Vorname %Name 
+               &Strasse 
+          &&p& &Ort 
+        ------------------------------------------ 
+        % ABKUERZUNGEN 
+        &l : lfd nr . 
+        &p : f ("PLZ") . 
+ 
+        % NACHSPANN 
+        &l Adressen gedruckt. 
+#text# 
+ 
+Dieses Beispiel enthält eine ganze Reihe interessanter Details. Als
+erstes sollten Sie registrieren, daß auch im Vorspann oder Nach­
+spann Feldmuster verwendet werden können. Soll in diesem Fall ein
+Feldinhalt aus der EUDAS-Datei eingesetzt werden, so werden beim
+Vorspann die Inhalte des ersten und beim Nachspann die Inhalte des
+letzten durch Suchmuster ausgewählten Satzes verwendet. Daher
+kann auch jeder Abschnitt einen Abkürzungsteil haben. Abkürzun­
+gen gelten jedoch für alle Abschnitte (s. '&l'); die Aufteilung in
+mehrere Abkürzungsteile fördert im wesentlichen die Übersichtlich­
+keit. 
+    Versuchen Sie, an diesem Beispiel die wichtigsten Unterschiede
+zwischen dem #on("i")#Musterteil#off("i")# und dem #on("i")#Abkürzungsteil#off("i")# eines Abschnittes
+zu verstehen. Das Format des Musterteiles soll in die Ausgabe
+übernommen werden; daher ist dort die Stellung jedes Wortes wich­
+tig. Im Abkürzungsteil definieren Sie Abkürzungen ohne bestimm­
+tes Format - mit der einzigen Ausnahme, daß eine Abkürzungs­
+definition mit einem '&' in der ersten Spalte anfangen und ein
+Leerzeichen vor dem Doppelpunkt haben muß. Wie Sie sehen, dürfen
+dort Leerzeilen zur besseren Lesbarkeit eingefügt werden. 
+Sie sollten bei unserem Beispiel folgende Ausgabe erhalten: 
+ 
+#beispiel# 
+        Adressenliste als Beispiel für Abkürzungen 
+        Stand: 28.12.84 
+        ------------------------------------------ 
+          1 :  Herbert Wegner 
+               Krämergasse 12 
+          5000 Köln 
+        ------------------------------------------ 
+          2 :  Helga Sandmann 
+               Willicher Weg 109 
+          5300 Bonn 1 
+        ------------------------------------------ 
+          3 :  Albert Katani 
+               Lindenstr. 3 
+          5210 Troisdorf 
+        ------------------------------------------ 
+          4 :  Peter Ulmen 
+               Mozartstraße 17 
+             5 Köln 60 
+        ------------------------------------------ 
+          5 :  Karin Regmann 
+               Grengelweg 44 
+          5000 Köln 90 
+        ------------------------------------------ 
+          6 :  Hubert Arken 
+               Talweg 12 
+          5200 Siegburg 
+        ------------------------------------------ 
+          7 :  Anna-Maria Simmern 
+               Platanenweg 67 
+             5 Köln 3 
+        ------------------------------------------ 
+          8 :  Angelika Kaufmann-Drescher 
+               Hauptstr. 123 
+            53 Bonn 2 
+        ------------------------------------------ 
+          9 :  Harald Fuhrmann 
+               Glockengasse 44 
+          5000 Köln 1 
+        ------------------------------------------ 
+         10 :  Friedrich Seefeld 
+               Kabelgasse 
+          5000 Köln-Ehrenfeld 
+        ------------------------------------------ 
+        10 Adressen gedruckt. 
+#text# 
+ 
+Nun zu den Abkürzungen im einzelnen. Das Feld 'PLZ' muß abge­
+kürzt werden, damit es rechtsbündig vor den Ort gedruckt werden
+kann. Die Abkürzung 'p' benutzt die im vorigen Kapitel beschriebe­
+ne Form zur Abfrage des Feldinhaltes. 
+    'Datum' wird als Abkürzung für das aktuelle Datum definiert,
+ein häufig benötigter Fall. 'date' ist der ELAN-Ausdruck, der das
+Datum liefert. (Bemerkung für ELAN-Programmierer: der Name der
+Abkürzung gehorcht nicht der ELAN-Syntax für Bezeichner). 
+    Eine für Tabellen sinnvolle Funktion wird bei der Definition
+von 'l' verwendet. Der von EUDAS definierte Ausdruck 'lfd nr' lie­
+fert die laufende Nummer des gerade gedruckten Satzes als Text.
+Dabei ist zu beachten, daß die laufende Nummer nicht mit der Satz­
+nummer übereinstimmt, sondern nur während des Druckvorganges
+von 1 an bei jedem gedruckten Satz hochgezählt wird. Diese Funk­
+tion dient dazu, die Sätze in der Liste durchzunumerieren. 
+    Die laufende Nummer soll in der Liste rechtsbündig mit Doppel­
+punkt vor dem Namen stehen. Dazu wird das Feldmuster '&&l' be­
+nutzt, eine Form, die eigentlich keinen Sinn hat (die Kombination
+'variable Länge' und 'rechtsbündig' gibt es nicht). Um ein möglichst
+kurzes Feldmuster schreiben zu können, wird in diesem Fall jedoch
+feste Länge unterstellt (auch ohne folgendes '&'). Damit hat das
+kürzeste Feldmuster fester Länge drei Zeichen sowohl im linksbün­
+digen ('&l&') wie auch im rechtsbündigen Fall ('&&l'). 
+ 
+#a ("Auswertungen")# Die Verwendung der Abkürzung 'l' im Nachspann
+kann als erstes Beispiel für eine Auswertungsfunktion gelten. Da
+für den Nachspann die Daten des letzten Satzes verwendet werden,
+erscheint hier die laufende Nummer des letzten Satzes und somit die
+Anzahl der Sätze, die gedruckt wurden. Das kann dazu benutzt
+werden, die Sätze zu zählen, die eine bestimmte Suchbedingung
+erfüllen. Folgendes Druckmuster zählt die Anzahl der Frauen oder
+Männer in der Datei: 
+ 
+#beispiel# 
+        % NACHSPANN 
+        &l Personen mit dem Geschlecht '%<m/w>' vorhanden. 
+        % ABKUERZUNGEN 
+        &l : lfd nr . 
+#text# 
+ 
+Wenn Sie vor dem Drucken jetzt die Suchbedingung 'm' für das Feld
+'m/w' einstellen, werden alle Männer ausgewählt. Das Drucken be­
+steht in diesem Fall nur aus dem Hochzählen der laufenden Nummer
+für jeden Mann. Im Nachspann kann das Ergebnis dann ausgegeben
+werden; zugleich soll der aktuelle Wert des Feldes 'm/w' gedruckt
+werden, damit das Druckmuster auch für das Zählen der Frauen
+verwendet werden kann. 
+    Die beiden möglichen Ausgaben würden dann so aussehen: 
+ 
+#beispiel# 
+        6 Personen mit dem Geschlecht 'm' vorhanden. 
+ 
+        4 Personen mit dem Geschlecht 'w' vorhanden. 
+#text# 
+ 
+#a ("Zusammenfassung")# Wir können die Erkenntnisse dieses Abschnittes
+wie folgt zusammenfassen: 
+#f2# 
+#bsp("*")#  Feldmuster können auch im Vorspann und Nachspann verwendet
+   werden. Im Vorspann werden die Daten des ersten, im Nachspann
+   die Daten des letzten ausgewählten Satzes verwendet. 
+#f2# 
+#bsp("*")#  Der Musterteil eines Abschnittes definiert ein Format; der Ab­
+   kürzungsteil ist formatfrei. 
+#f2# 
+#bsp("*")#  'lfd nr' dient zum Durchnumerieren aller gedruckten Sätze. 
+#f2# 
+#bsp("*")#  Ein rechtsbündiges Feldmuster hat immer auch feste Länge. 
+ 
+#a ("Komplexe Abkürzungen")# Mit Hilfe von Abkürzungen können wir
+jetzt auch bessere Musterbriefe schreiben. Ein Problem, das bereits
+angesprochen wurde, besteht darin, daß in der Anrede je nach Ge­
+schlecht 'Herr' oder 'Frau' stehen soll. Um dieses Problem zu lösen,
+wird der Inhalt des Feldes 'm/w' benötigt. 
+    Da in einer Abkürzung jede ELAN-Anweisung erlaubt ist, die
+einen Text liefert, können natürlich auch #on("i")#IF-Anweisungen#off("i")# verwen­
+det werden. Mit diesen Informationen können wir jetzt die Abkür­
+zung 'Anrede' definieren: 
+ 
+#beispiel# 
+        % ABKUERZUNGEN 
+        &Anrede : 
+          IF f ("m/w") = "w" THEN 
+            "Frau" 
+          ELSE 
+            "Herr" 
+          END IF . 
+#text# 
+ 
+Für Nicht-Programmierer: Die IF-Anweisung besteht aus einer Ab­
+frage und zwei Alternativen. Die Abfrage steht zwischen dem IF und
+dem THEN und besteht in der Regel aus einer Abfrage, ob zwei
+Dinge gleich oder ungleich (<>), größer oder kleiner sind. Außerdem
+können mehrere Abfragen mit AND (und) und OR (oder) kombiniert
+werden. Näheres dazu im Kapitel 14. 
+    Die Alternative hinter dem THEN wird ausgewählt, wenn die
+Abfrage zutrifft. An dieser Stelle sind wieder beliebige Ausdrücke
+erlaubt, die einen Text liefern, einschließlich erneuter IF-Anwei­
+sungen (Schachtelung). Die Alternative zwischen ELSE und END IF
+wird ausgewählt, wenn die Abfrage nicht zutrifft. 
+ 
+#a ("Textkonstanten")# Bisher wurden nur ELAN-Funktionen als Textlie­
+feranten betrachtet ('date', 'lfd nr', 'f'). In unserem Fall werden
+aber #on("i")#Textkonstanten#off("i")# in den Alternativen der IF-Anweisung benö­
+tigt. Textkonstanten werden in ELAN in Anführungsstriche einge­
+schlossen, die aber nicht zum Text gehören. Innerhalb einer Text­
+konstanten werden Leerzeichen wie alle anderen Zeichen angesehen
+(erscheinen also auch nachher in der Ausgabe). 
+    Bei solchen Abkürzungen, die längere Anweisungen umfassen,
+sollten Sie das freie Format ausnutzen und eine möglichst über­
+sichtliche Darstellung wählen. Wie Sie sehen, muß nur der Doppel­
+punkt noch in der ersten Zeile stehen, der Rest kann sich beliebig
+auf die folgenden Zeilen erstrecken. 
+ 
+#a ("Beispiel")# Ein typischer Einsatz einer IF-Anweisung für die Anrede
+sieht so aus: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+ 
+        Sehr geehrte&Anrede %<Name>! 
+ 
+        ... 
+        % ABKUERZUNGEN 
+        &Anrede : 
+          IF f ("m/w") = "m" THEN 
+            "r Herr" 
+          ELSE 
+            " Frau" 
+          END IF . 
+#text# 
+ 
+Sie sollten jetzt diese Konstruktion in einen Musterbrief einfügen
+können. Probieren Sie ihn dann als Beispiel aus ! 
+ 
+#a ("Weitere Möglichkeiten")# Durch Verwendung von Abkürzungen ist es
+auch möglich, rechtsbündige Felder mit einer Länge von weniger als
+3 Zeichen zu simulieren. Dies geschieht mit Hilfe der Textoperatio­
+nen von ELAN. Ohne ELAN-Vorkenntnisse können Sie dieses Bei­
+spiel überlesen. In unserer Liste im obigen Beispiel sind die laufen­
+den Nummern höchstens zweistellig und sollten deshalb auch nur
+zwei Stellen belegen. Dies würde folgende Abkürzung ermöglichen: 
+ 
+#beispiel# 
+        % ABKUERZUNGEN 
+        &l :  text (lfd nr als zahl, 2) . 
+        lfd nr als zahl : int (lfd nr) . 
+#text# 
+ 
+Die Prozedur 'text' wird dazu benutzt, eine Zahl rechtsbündig auf
+zwei Stellen zu formatieren (s. EUMEL-Benutzerhandbuch). Da die
+Abkürzung immer eine Länge von zwei Zeichen hat, kann sie auch in
+einem Feldmuster variabler Länge eingesetzt werden. Die Attribute
+'feste Länge' und 'rechtsbündig' werden in diesem Fall also nicht
+durch das Feldmuster, sondern durch die Abkürzung selbst erzeugt. 
+    Um die Prozedur 'text' anwenden zu können, muß die laufende
+Nummer als Zahl (sprich: INT-Objekt) vorliegen. Diese Umwandlung
+wird mit der Prozedur 'int' vorgenommen, die einen Text in eine
+Zahl umwandelt. Obwohl man 'int (lfd nr)' direkt in den Aufruf von
+'text' hätte schreiben können, wird hier als Demonstration dafür ein
+Refinement verwendet. 
+    Refinements können in einem Abkürzungsteil neben Abkürzun­
+gen stehen und von allen Abkürzungen benutzt werden. Sie werden
+ähnlich geschrieben wie Abkürzungen, nur ihr Name muß in Klein­
+buchstaben geschrieben werden, dafür muß er nicht in der ersten
+Spalte anfangen und kann Leerzeichen enthalten. Bei komplizierte­
+ren Ausdrücken sollten Refinements zur besseren Lesbarkeit einge­
+setzt werden. 
+    Sie können die IF-Anweisung auch mit beliebig vielen ELIF-
+Teilen versehen. Achten Sie jedoch darauf, daß die IF-Anweisung
+#on("i")#immer#off("i")# irgendeinen Wert liefern muß. Sie dürfen also den ELSE-Teil
+nicht weglassen. Statt einer IF-Anweisung können Sie natürlich
+auch eine SELECT-Anweisung verwenden. Es stehen Ihnen im Prin­
+zip alle werteliefernden Anweisungen von ELAN zur Verfügung. 
+    Die Programmiersprache ELAN bietet Ihnen noch weit mehr
+Möglichkeiten, als hier beschrieben werden können. So können Sie
+sich eigene Prozeduren definieren und diese dann in Abkürzungen
+verwenden. In Kapitel 14 und 15 finden Sie eine Einführung in die
+wichtigsten Konstrukte, die für EUDAS gebraucht werden. 
+ 
+ 
+#abschnitt ("13.2", "BEDINGTE MUSTERTEILE", "Bedingte Musterteile")# 
+ 
+Wenn größere Teile des Druckmusters in Abhängigkeit von bestimm­
+ten Daten unterschiedlich ausfallen sollen, werden die dazu benö­
+tigten Abkürzungen sehr umfangreich. Für solche Fälle kann man
+IF-Anweisungen auch im Musterteil eines Abschnitts verwenden. In
+diesem Fall werden die Alternativen der IF-Anweisung durch
+Musterzeilen dargestellt. 
+    Im Musterteil müssen jedoch die Zeilen, die Teil der IF-An­
+weisung sind, von den Musterzeilen unterschieden werden. Deshalb
+werden die Anweisungszeilen durch ein '%'-Zeichen in der ersten
+#on("i")#und#off("i")# zweiten Spalte gekennzeichnet. Das zweite '%'-Zeichen dient
+zur Unterscheidung von Anweisungen an den Druckgenerator, die
+nicht an den ELAN-Compiler übergeben werden sollen. 
+    Mit einer IF-Anweisung im Musterteil kann man das Anredepro­
+blem auch folgendermaßen lösen: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        %% IF f ("m/w") = "w" THEN 
+        Sehr geehrte Frau &<Name>! 
+        %% ELSE 
+        Sehr geehrter Herr &<Name>! 
+        %% END IF; 
+#text# 
+ 
+Beachten Sie den Unterschied, daß die IF-Anweisung hier mit einem
+Semikolon abgeschlossen werden muß - in Abkürzungen mußte ja ein
+Punkt danach folgen. Außerdem darf hier der ELSE-Teil (die zweite
+Alternative) fehlen, während in einer Abkürzung in jeder Alternati­
+ve etwas stehen muß (zumindest der leere Text ""). 
+    Falls sich der IF-THEN-Teil über mehr als eine Zeile erstrek­
+ken soll, muß jede dieser Zeilen mit '%%' beginnen, da die Folgezei­
+len sonst als Musterzeilen gedruckt würden. Benutzen Sie in einem
+solchen Fall jedoch besser ein Refinement, das Sie im Abkürzungs­
+teil definieren müssen. 
+    Sie können im Musterteil auch andere ELAN-Anweisungen
+verwenden. Der Unterschied zu Abkürzungen liegt darin, daß die
+Musterzeilen nicht als Werte angesehen werden, die die Anweisung
+liefern muß, sondern als Anweisungen, die dort aufgeführten Mu­
+sterzeilen einzusetzen und zu drucken. Daher kann im Musterteil
+auch eine FOR-Schleife sinnvoll sein, wenn in Abhängigkeit eines
+Wertes eine bestimmte Anzahl von Zeilen gedruckt werden soll. 
+ 
+ 
+#abschnitt ("13.3", "ÜBERSETZUNG", "Übersetzung")# 
+ 
+Wenn Sie bis jetzt auch als ELAN-Programmierer immer noch nicht
+ganz durchblicken, wie Sie welche ELAN-Anweisungen verwenden
+können, dann ist das noch kein Anlaß zur Sorge. Es ist kaum mög­
+lich, die genauen Auswirkungen beliebiger Anweisungen zu be­
+schreiben, ohne den Übersetzungsprozeß zu schildern, der diese
+Anweisungen zu einem ELAN-Programm zusammenbindet. Daher soll
+diese Übersetzung jetzt genauer erklärt werden. 
+ 
+#a ("Übersetzungsmechanismus")# Alle Zeilen eines Abkürzungsteils wer­
+den direkt in das Programm übernommen, wobei der Name einer Ab­
+kürzung durch einen beliebig gewählten Refinementnamen ersetzt
+wird ('abk' + eine laufende Nummer). Alle Abkürzungen und Re­
+finements werden als globale Refinements definiert, also außerhalb
+von Prozeduren. Dadurch wird erreicht, daß sie an jeder Stelle
+verwendet werden können. 
+    Damit eine Abkürzung richtig als Refinement übersetzt wird,
+muß sie ein TEXT-Objekt als Wert liefern. Die anderen Refinements
+sind beliebig, da Sie nur in selbstdefinierten Anweisungen verwen­
+det werden. Die Refinements der Abkürzungen werden in einer Zu­
+weisung an eine TEXT-Variable verwendet, damit der Druckgenera­
+tor auf den entsprechenden Wert zugreifen kann. 
+    Jeder Abschnitt wird dagegen als eine Prozedur übersetzt. Jede
+Folge von Musterzeilen wird in eine Anweisung übersetzt, diese
+Musterzeilen einzusetzen und zu drucken. Jede '%%'-Anweisung
+wird einfach unverändert dazwischen geschrieben. Die Vorspann-
+Prozedur wird einmal zu Anfang aufgerufen, die Prozedur für den
+Wiederholungsteil einmal für jeden ausgewählten Satz und die Nach­
+spann-Prozedur einmal am Schluß. 
+    Bei Fehlern im ELAN-Teil zeigt der Compiler das erzeugte Pro­
+gramm zusammen mit seinen Fehlermeldungen im Paralleleditor. Sie
+müssen nun die Fehlermeldung lokalisieren und anhand der eben
+gegebenen Hinweise in das ursprüngliche Druckmuster zurücküber­
+setzen, damit Sie dort den Fehler korrigieren können. 
+ 
+#a ("Beispiel")# Nun müßten Sie genug Informationen haben, um beliebige
+ELAN-Anweisungen in das Druckmuster einfügen zu können. Als
+Beispiel wollen wir versuchen, alle Männer und Frauen in der
+Adressendatei zu zählen, ohne ein Suchmuster einstellen zu müssen
+und ohne den Druckvorgang zweimal ablaufen zu lassen (wie dies
+bei dem obigen Beispiel der Fall war). Ein erster Versuch könnte so
+aussehen: 
+ 
+#beispiel# 
+        % VORSPANN 
+        %% INT VAR maenner, frauen; 
+        %% maenner := 0; 
+        %% frauen := 0; 
+        % WIEDERHOLUNG 
+        %% IF f ("m/w") = "m" THEN 
+        %%   maenner INCR 1 
+        %% ELSE 
+        %%   frauen INCR 1 
+        %% END IF 
+        % NACHSPANN 
+        &maenner Männer und %frauen Frauen vorhanden. 
+#text# 
+ 
+Aber Vorsicht! In diesem Beispiel sind mehrere Fehler eingebaut.
+Finden Sie sie! 
+ 
+#a ("Fehler im Beispiel")# Der erste Fehler befindet sich im Nachspann.
+Hier wird versucht, die Namen der beiden Variablen 'maenner' und
+'frauen' direkt in einem Feldmuster zu verwenden. Diese beiden
+Namen sind dem Druckgenerator nicht bekannt, sondern nur dem
+ELAN-Compiler. Um die Werte der beiden Variablen einsetzen zu
+können, müssen Sie also zwei geeignete Abkürzungen definieren. 
+    Der zweite Fehler ist schwieriger zu finden. Wie oben gesagt,
+wird jeder Abschnitt in eine Prozedur übersetzt. Die in einem Ab­
+schnitt definierten Variablen können also nur in diesem Abschnitt
+verwendet werden (sie sind lokal) und auch nicht im Abkürzungs­
+teil, da dieser wieder global vereinbart wird. Die beiden im Vor­
+spann definierten Variablen stehen also im Wiederholungsteil und im
+Nachspann nicht zur Verfügung. 
+ 
+#a ("Anweisungen im Initialisierungsteil")# Für diesen Fall gibt es die
+Möglichkeit, ELAN-Anweisungen vor allen Abschnitten im Initiali­
+sierungsteil zu definieren. Diese Anweisungen sind dann ebenfalls
+global. Das richtige Druckmuster finden Sie auf der nächsten Seite. 
+    Natürlich könnten Sie die Initialisierung der beiden Variablen
+auch noch aus dem Vorspann herausnehmen. Denken Sie daran, daß
+Sie aus INT-Variablen erst einen Text machen müssen, ehe Sie sie
+in eine Musterzeile einsetzen können. Beachten Sie Schreibweise der
+Variablen: in ELAN können die Umlaute nicht in Bezeichnern ver­
+wendet werden, daher muß die Variable mit 'ae' geschrieben wer­
+den. Im Mustertext und in Abkürzungs- und Feldnamen können die
+Umlaute jedoch frei verwendet werden. 
+ 
+#beispiel# 
+        %% INT VAR maenner, frauen; 
+        % VORSPANN 
+        %% maenner := 0; 
+        %% frauen := 0; 
+        % WIEDERHOLUNG 
+        %% IF f ("m/w") = "m" THEN 
+        %%   maenner INCR 1 
+        %% ELSE 
+        %%   frauen INCR 1 
+        %% END IF 
+        % NACHSPANN 
+        &m Männer und %f Frauen vorhanden . 
+        % ABKUERZUNGEN 
+        &m : text (maenner) . 
+        &f : text (frauen) . 
+#text# 
+ 
+ 
+#abschnitt ("13.4", "GRUPPEN", "Gruppen")# 
+ 
+Der Druckgenerator bietet die Möglichkeit, Vorspann und Nachspann
+nicht nur am Anfang und am Ende, sondern auch an bestimmten
+Stellen zwischen Sätzen zu drucken. Diese Stellen sind dadurch
+bestimmt, daß ein bestimmtes Merkmal (z.B. ein Feldinhalt) seinen
+Wert ändert. Ein solches Merkmal wird im Druckmuster #on("i")#Gruppe#off("i")# ge­
+nannt. 
+    Ein Beispiel für die Verwendung von Gruppen ist eine Schüler­
+datei, die nach Klassen geordnet ist. Definiert man das Feld 'Klas­
+se' als Gruppe, so wird jeweils am Ende einer Klasse ein Nachspann
+und am Beginn einer Klasse ein Vorspann gedruckt. 
+    Dieses Verfahren ist eine Erweiterung der bisher beschriebenen
+Methode, indem eine Datei quasi in mehrere Dateien untergliedert
+wird, die jedoch in einem Arbeitsgang gedruckt werden können.
+Voraussetzung dafür ist jedoch, daß die Datei nach dem Gruppen­
+merkmal geordnet ist - der Druckgenerator sammelt nicht erst alle
+Schüler einer Klasse aus der Datei, sondern erwartet sie hinter­
+einander. 
+ 
+#a ("Gruppendefinition")# Eine Gruppe wird im Initialisierungsteil des
+Druckmusters (also vor allen Abschnitten) definiert. Notwendige
+Daten sind eine Nummer zur Identifizierung und das Merkmal. Die
+Nummer sollte am sinnvollsten von 1 an vergeben werden; die mög­
+lichen Werte sind nach oben hin beschränkt. Das Merkmal ist ein
+beliebiger ELAN-Ausdruck, der einen Text liefert. Sinnvollerweise
+wird er den Inhalt eines Feldes enthalten. 
+    Gruppendefinitionen müssen nach allen ELAN-Anweisungen im
+Initialisierungsteil folgen, und zwar, weil die Gruppendefinitionen
+alle in einer Prozedur zusammengefaßt werden, die bei jedem neuen
+Satz auf Gruppenwechsel testet. 
+    Unter der Annahme, daß die oben erwähnte Schülerdatei ein
+Feld 'Klasse' besitzt, würde die Gruppe wie folgt definiert: 
+ 
+#beispiel# 
+        % GRUPPE  1  f ("Klasse") 
+#text# 
+ 
+Nach der Anweisung 'GRUPPE' folgt die Gruppennummer und dann
+ein ELAN-Ausdruck. Die ganze Definition muß in einer Zeile stehen;
+reicht der Platz nicht aus, müssen Sie in einem Abkürzungsteil ein
+Refinement definieren. 
+ 
+#a ("Klassenliste")# Das komplette Druckmuster für die Klassenliste könn­
+te folgendes Aussehen haben, wenn außer 'Klasse' auch noch die
+Felder 'Name' und 'Vorname' vorhanden sind: 
+ 
+#beispiel# 
+        % GRUPPE  1  f ("Klasse") 
+        % VORSPANN 
+        Klassenliste für Klasse &Klasse 
+        ---------------------------- 
+        % WIEDERHOLUNG 
+        &Vorname %Name 
+        % NACHSPANN 
+        \#page\# 
+#text# 
+ 
+Wenn eine Gruppe definiert ist, werden im Nachspann immer die
+Feldinhalte des letzten Satzes vor dem Gruppenwechsel gedruckt, im
+Vorspann die Inhalte des ersten Satzes nach dem Wechsel. Daher
+kann hier im Vorspann die Klasse gedruckt werden, da sie sich erst
+ändert, wenn schon wieder der nächste Vorspann gedruckt wird. 
+ 
+#a ("Mehrere Gruppen")# Wie die Identifikation über eine Gruppennummer
+vermuten läßt, können Sie mehrere Gruppen definieren. Nachspann
+und Vorspann werden jeweils gedruckt, wenn sich das Merkmal ir­
+gendeiner Gruppe ändert. Ob eine bestimmte Gruppe gewechselt hat,
+kann mit der Abfrage 
+ 
+#beispiel# 
+        BOOL PROC gruppenwechsel (INT CONST gruppennummer) 
+#text# 
+ 
+in einer IF-Anweisung ermittelt werden. Vor dem ersten und nach
+dem letzten Satz wechseln automatisch alle Gruppen. 
+    Die ganze Datei bildet eine Quasi-Gruppe mit der Nummer 0.
+Sie ist immer definiert und wechselt nur vor dem ersten und nach
+dem letzten Satz. Sie ist es, die bewirkt, daß Vorspann und Nach­
+spann in ihrer normalen Weise gedruckt werden. 
+ 
+#a ("Anwendungsbeispiel")# Um einige der Möglichkeiten zu illustrieren,
+die durch Gruppen geschaffen werden, wollen wir als Beispiel eine
+Anwendung betrachten, die neue Wege für die Benutzung von EUDAS
+aufzeigt. 
+    Aus einer Datei, in der für jede Bestellung der Kunde, der Ar­
+tikel, die bestellte Menge und der Einzelpreis des Artikels einge­
+tragen werden, sollen anschließend Rechnungen gedruckt werden.
+Die Datei soll folgende Felder haben: 
+ 
+#beispiel# 
+        'Kundennummer' 
+        'Artikelnummer' 
+        'Einzelpreis' 
+        'Menge' 
+#text# 
+ 
+Als Voraussetzung müssen die Bestellungen in der Datei jeweils
+nach Kunden geordnet vorliegen. Die Kundennummer wird als Gruppe
+definiert, so daß die Bestellungen eines Kunden zu einer Rechnung
+zusammengefaßt werden können. Das Druckmuster rechnet dann die
+einzelnen Preise zusammen und gibt eine Endsumme aus. 
+    Damit in der Rechnung Name und Adresse des Kunden auftau­
+chen können, wird zu der Bestellungsdatei die Kundendatei gekop­
+pelt, die folgende Felder haben soll: 
+ 
+#beispiel# 
+        'Kundennummer' 
+        'Name' 
+        'Vorname' 
+        'Strasse' 
+        'PLZ' 
+        'Ort' 
+#text# 
+ 
+Stellen Sie sich zum Ausprobieren des folgenden Druckmusters ge­
+gebenenfalls eigene Daten zusammen. Hier nun das Druckmuster: 
+ 
+#beispiel# 
+    %% REAL VAR gesamtpreis, summe; 
+    % GRUPPE  1  f ("Kundennummer") 
+    % VORSPANN 
+    %% summe := 0.0; 
+                                      Fa. Kraus & Sohn 
+                                      Schotterstr. 10 
+ 
+                                      5000 Köln 1 
+    &Vorname %Name 
+    &Strasse 
+ 
+    &PLZ &Ort                         &Datum 
+ 
+                   R E C H N U N G 
+                   =============== 
+ 
+    Menge  Artikelnr.       Einzelpreis  Gesamtpreis 
+    ------------------------------------------------ 
+    % ABKUERZUNGEN 
+    &Datum : date . 
+ 
+    % WIEDERHOLUNG 
+    %% gesamtpreis := round 
+    %%   (wert ("Einzelpreis") * wert ("Menge"), 2); 
+    %% summe INCR gesamtpreis; 
+    &Menge &Artikelnummer     &&&&epr&&    &&&&gpr&& 
+    % ABKUERZUNGEN 
+    &epr :  f ("Einzelpreis") . 
+    &gpr :  zahltext (gesamtpreis, 2) . 
+ 
+    % NACHSPANN 
+    ------------------------------------------------ 
+                             Summe:        &&&&sum&& 
+                             + 14% MWSt.   &&&Mwst&& 
+                                           ========= 
+                             Endbetrag     &&&&end&& 
+    \#page\# 
+    % ABKUERZUNGEN 
+    &sum  : zahltext (summe, 2) . 
+    &Mwst : zahltext (mwst, 2) . 
+    &end  : zahltext (summe + mwst, 2) . 
+    mwst  : round (summe * 0.14, 2) . 
+#text# 
+ 
+Im Initialisierungsteil dieses Druckmusters wird die Kundennummer
+als Gruppe definiert. Dies hat zur Folge, daß für jeden neuen Kun­
+den eine neue Rechnung begonnen wird, nachdem vorher im Nach­
+spann die Rechnungssumme des vorherigen Kunden berechnet und
+ausgedruckt wurde. Vor dieser Gruppendefinition sind 'gesamtpreis'
+und 'summe' definiert, die später als globale Variablen zur Verfü­
+gung stehen sollen. Diese Zeile darf nicht nach der Gruppendefini­
+tion stehen. 
+    Im Vorspann wird der Kopf der Rechnung angegeben. Dieser
+enthält neben den Daten des Kunden (aus der gekoppelten Kun­
+dendatei) noch das Datum. Die Kundennummer wird nur zum Kop­
+peln und als Gruppenmerkmal benötigt, erscheint also nicht auf der
+Rechnung. 
+    Es fällt auf, daß im Firmennamen ein '&'-Zeichen auftaucht,
+das doch für die Markierung von Feldmustern reserviert ist. Die
+beiden Musterzeichen können jedoch im normalen Text auftauchen,
+wenn ihnen direkt ein Leerzeichen folgt. In diesem Fall werden Sie
+nicht als Beginn eines Feldmusters interpretiert, sondern unverän­
+dert gedruckt. Der gleiche Fall taucht noch mit '%' im Nachspann
+auf. 
+    Im Wiederholungsteil wird zunächst aus dem Einzelpreis und der
+Menge des jeweiligen Artikels der Gesamtpreis für diesen Artikel
+berechnet. Für die Abfrage der Feldinhalte wird die Funktion 'wert'
+verwendet, die wie 'f' funktioniert, jedoch gleich einen REAL-Wert
+liefert. 
+    Zu beachten ist, daß 'wert' wie beim Sortieren von Zahl alle
+Sonderzeichen ignoriert. Weiterhin müssen die Zahlen mit dem ein­
+gestellten Dezimalkomma geschrieben werden (also normalerweise
+mit Komma), damit ihr Wert richtig erkannt wird. Anderenfalls soll­
+ten Sie den Dezimalpunkt einstellen (s. 11.1). 
+    Damit kaufmännisch richtig gerechnet wird, wird der Gesamt­
+preis auf 2 Nachkommastellen gerundet und erst dann aufsummiert.
+Würde der Gesamtpreis nur zum Einsetzen gerundet, könnten bei der
+anschließenden Addition der nicht gerundeten Werte eine falsche
+Gesamtsumme entstehen. 
+    Erst nach diesen Berechnungen kann die Musterzeile folgen, in
+die die Werte dann eingesetzt werden. Um eine Ausgabe mit zwei
+Nachkommastellen zu erzeugen, wird die von EUDAS definierte
+Funktion 'zahltext' benutzt. Diese erzeugt aus einem REAL-Wert
+einen Text mit der angegebenen Anzahl von Kommastellen und setzt
+das korrekte Dezimalkomma ein. Das Ergebnis dieser Funktion wird
+dann rechtsbündig eingesetzt. 
+    Im Nachspann wird dann der summierte Wert mit aufgeschlage­
+ner Mehrwertsteuer gedruckt. Die Mehrwertsteuer muß ebenfalls auf
+zwei Nachkommastellen gerundet werden. 
+ 
+#a ("Erweiterung")# Zur Erweiterung könnten Sie die Bestelldatei noch mit
+einer Artikeldatei koppeln, die etwa folgende Struktur haben würde: 
+ 
+#beispiel# 
+        'Artikelnummer' 
+        'Bezeichnung' 
+        'Einzelpreis' 
+#text# 
+ 
+In diesem Fall könnten Sie noch jeweils die Artikelbezeichnung in
+eine Rechnungszeile drucken. Außerdem würde der Preis zentral
+gespeichert. Eine entsprechende Änderung des Druckmusters sollte
+Ihnen keine Schwierigkeiten bereiten. 
+ 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.14 b/app/eudas/4.4/doc/user-manual/eudas.hdb.14
new file mode 100644
index 0000000..895d7d9
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.14
@@ -0,0 +1,697 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (151)# 
+#kapitel ("14", "Ausdrücke", "in", "ELAN")# 
+ 
+ 
+ 
+#abschnitt ("14.1", "WAS SIND AUSDRÜCKE ?", "Was sind Ausdrücke ?")# 
+ 
+In diesem Kapitel wollen wir uns mit ELAN-Ausdrücken beschäfti­
+gen, wie sie für EUDAS gebraucht werden. Natürlich kann dies keine
+ernsthafte Einführung für ELAN-Programmierer sein - mit solchen
+Ambitionen halten Sie sich am besten an die entsprechende ELAN-
+Literatur. 
+    Dieser Text richtet sich eher an den Benutzer, der kaum Erfah­
+rung mit ELAN hat, aber die Möglichkeiten von EUDAS optimal nut­
+zen will. Viele fortgeschrittene Fähigkeiten von EUDAS laufen ja
+über ELAN-Programme. 
+ 
+#a ("Vorkommen")# Sie haben ELAN-Ausdrücke bereits an verschiedenen
+Stellen eingesetzt, wenn Sie sich mit den vorhergehenden Kapiteln
+befaßt haben. ELAN-Ausdrücke werden in nahezu allen Verarbei­
+tungsfunktionen benötigt. 
+    Im Druckmuster dienen sie dazu, den Inhalt eines Feldmusters
+festzulegen. Die Definition einer Abkürzung besteht immer aus dem
+Namen der Abkürzung und einem Ausdruck. Ebenso wird in einer
+Gruppendefinition ein Ausdruck angegeben. 
+    Beim Kopiermuster und beim Änderungsmuster besteht jeweils
+die rechte Seite einer Anweisung aus einem Ausdruck. Weiterhin
+werden Ausdrücke auch in anderen ELAN-Konstruktionen benötigt,
+wie zum Beispiel direkt am Anfang einer IF-Anweisung. 
+ 
+#a ("Bedeutung")# Ein Ausdruck steht allgemein für einen Wert. Im ein­
+fachsten Fall kann dies eine Konstante sein, der Wert des Aus­
+drucks ändert sich also nicht. Anderenfalls spricht man von einem
+zusammengesetzten Ausdruck. Dessen Wert ergibt sich dann durch
+die Ausführung der im Ausdruck angegebenen Operationen. Dieser
+Wert kann je nach dem aktuellen Zustand des Systems verschieden
+sein, da er jedes Mal neu berechnet wird, wenn er gebraucht wird. 
+    Ein Beispiel für einen zusammengesetzten Ausdruck ist #bsp ("2+2")#
+Dieser Ausdruck steht für den Wert 4. 
+    Der Wert eines Ausdrucks ist das, was uns eigentlich interes­
+siert. Beim Druckvorgang wird dieser Wert dann gedruckt, beim
+Kopieren und Verändern in ein Feld eingetragen. 
+ 
+#a ("Zusammensetzung")# Ausdrücke lassen sich aus verschiedenen Ele­
+menten zusammensetzen. Grundlage bilden die Konstanten. Konstan­
+ten können durch #on("i")#Operatoren#off("i")# miteinander verknüpft werden. So ist
+in dem Ausdruck #bsp ("2+3")# das #bsp ("'+'")# ein Operator, der die Konstanten #bsp("2")#
+und #bsp("3")# verknüpft. Das Ergebnis der Verknüpfung hängt natürlich vom
+jeweiligen Operator ab. 
+    Wie Sie schon in der Schule gelernt haben ("Punktrechnung vor
+Strichrechnung"), muß man die Reihenfolge der Operatoren festlegen,
+wenn mehrere Operatoren im Spiel sind. Ähnliche Regeln gibt es für
+alle Operatoren in ELAN. 
+    Wenn eine andere Reihenfolge der Operatoren erwünscht ist,
+können Sie diese durch Einsatz von Klammern verändern. Auch dies
+dürfte Ihnen aus der Schule noch in Erinnerung sein. Der Unter­
+schied in ELAN ist lediglich, daß es dort einige zusätzliche Opera­
+toren gibt, die Ihnen nicht aus der Mathematik vertraut sind. 
+    Ein weiteres Konstruktionselement von Ausdrücken sind #on("i")#Funk­
+tionen#off("i")#. Auch diese kennen Sie aus der Schule. Lediglich die
+Schreibweise muß für den "dummen" Computer etwas ausführlicher
+gehalten werden (Beispiel: #bsp ("sin (3.14 * x)")#). 
+    Die Argumente der Funktion hinter dem Funktionsnamen müssen
+auf jeden Fall in Klammern stehen. In der Terminologie der Pro­
+grammiersprachen spricht man von #on("i")#Parametern#off("i")#. Parameter können
+wieder komplexe Ausdrücke sein. Bei Funktionen mit mehreren
+Parametern werden diese durch Komma getrennt: 
+#f2# 
+#beispiel# 
+        min (2.5 * x, x + 1.25) 
+#text# 
+ 
+ 
+#abschnitt ("14.2", "DATENTYPEN", "Datentypen")# 
+ 
+Bevor wir beginnen, konkrete Ausdrücke zu behandeln, müssen wir
+erst das Konzept der #on("i")#Datentypen#off("i")# einführen. Grundidee dabei ist,
+daß es verschiedene Klassen von Werten gibt, die nicht einfach
+untereinander gemischt werden können. 
+    So gibt es in ELAN einen grundlegenden Unterschied zwischen
+#on("i")#Zahlen#off("i")# und #on("i")#Texten#off("i")#. Texte bestehen aus einer beliebigen Aneinan­
+derreihung von Zeichen, die im Normalfall nur für den betrachten­
+den Menschen eine Bedeutung haben. Mit Zahlen kann man dagegen
+Berechnungen anstellen. 
+    Der tiefere Grund für die Trennung in verschiedene Typen ist
+also, daß für jeden Typ gewisse Operationen definiert snd, die nur
+für diesen Typ sinnvoll sind. So ist zum Beispiel die Addition der
+beiden Texte #bsp("""abc""")# und #bsp("""-/-""")# völlig sinnlos. 
+    Aber nicht nur die Operationen sind verschieden, sondern auch
+die interne Darstellung im Rechner. So werden der Text #bsp ("""1234""")# und
+die Zahl #bsp ("1234")# völlig anders gespeichert, obwohl man ihnen die glei­
+che Bedeutung beimessen könnte. 
+ 
+#a ("Grundtypen")# In ELAN gibt es vier verschiedene Grundtypen, die für
+uns wichtig sind. Sie können sich in ELAN auch eigene Typen
+schaffen, dies geht jedoch weit über unsere Bedürfnisse hinaus. 
+    Der in EUDAS am meisten verwendete Typ heißt #on("i")#TEXT#off("i")#. TEXT-
+Objekte bestehen aus einer Folge von 0 bis 32000 Zeichen. Die Zei­
+chen entstammen einem Satz von 256 verschiedenen Symbolen, die
+jeweils eine andere Darstellung haben. Einige der Zeichen lassen
+sich überhaupt nicht darstellen, sondern führen bestimmte Funktio­
+nen aus (zum Beispiel Bildschirm löschen). 
+    Sämtliche Feldinhalte einer EUDAS-Datei sind TEXTe, ebenso
+die Zeilen von Textdateien. Auch Datei- und Feldnamen sind
+TEXTe. Von daher besteht eigentlich kein Grund, warum Sie sich
+außer zur Programmierung noch mit anderen Datentypen beschäfti­
+gen sollten. 
+    Neben den Texten gibt es noch die Zahlen. Diese sind in ihrer
+internen Darstellung so beschaffen, daß ein effizientes Rechnen mit
+ihnen möglich ist. Andererseits können sie nicht mehr beliebige
+Informationen darstellen, sondern haben eine sehr eingeschränkte
+Bedeutung. 
+    Um unterschiedichen Bedürfnissen gerecht zu werden, gibt es in
+ELAN zwei verschiedene Zahltypen. Der Typ #on("i")#INT#off("i")# umfaßt nur ganze
+Zahlen ohne Kommastellen. Damit die Zahl möglichst wenig Spei­
+cherplatz belegt, ist der Wertebereich bei den meisten Rechnern auf
+-32768..32767 beschränkt (die krummen Zahlen ergeben sich wegen
+der Binärarithmetik des Rechners). Dieser Typ eignet sich am besten
+zum Abzählen und zum Auswählen aus einer festen Anzahl von
+Objekten (zum Beispiel Feld 1 bis Feld 255). 
+    Zum eigentlichen Rechnen gibt es den Typ #on("i")#REAL#off("i")#. Dieser umfaßt
+auch Kommazahlen. Genauigkeit, Wertebereich und Darstellung sind
+nahezu identisch mit den Möglichkeiten eines Taschenrechners. der
+Typ REAL wird immer dann verwendet, wenn mit realen Größen
+(Geldbeträge, physikalische Werte) gerechnet werden muß. 
+    Zuletzt gibt es noch den Typ #on("i")#BOOL#off("i")#. Er hat nur zwei mögliche
+Werte, nämlich TRUE (wahr) und FALSE (falsch). Er wird dazu benö­
+tigt, Ausdrücke zu schreiben, die den Zweig einer IF-Anweisung
+bestimmen. 
+ 
+#a ("Denotation")# ELAN verfügt über einen strengen Typenschutz; das
+heißt, Objekte verschiedenen Typs dürfen nicht gemischt werden.
+Daher muß schon bei der Schreibweise der Konstanten festgelegt
+sein, welchen Typ die Konstante hat. 
+    Bei Texten geschieht dies durch den Einschluß in Anführungs­
+striche. Die Anführungsstriche sorgen gleichzeitig auch für eine
+Abgrenzung der Zeichen des Textes und des umgebenden Programms.
+Sie kennen diese Schreibweise bereits von vielen Stellen in EUDAS. 
+    Ebenfalls keine Probleme bereitet der Typ BOOL, da die
+Schreibweise der beiden möglichen Werte TRUE und FALSE eindeutig
+ist. 
+    Problematisch wird es bei den Zahlen. Da die ganzen Zahlen in
+den rationalen Zahlen enthalten sind, muß für die ganzen Zahlen
+durch die Schreibweise festgelegt werden, zu welchem der beiden
+Typen sie gehören. Man hat festgelegt, daß REAL-Zahlen immer mit
+Komma geschrieben werden müssen, während Zahlen ohne Komma den
+Typ INT haben (das Komma wird in ELAN bei den REAL-Zahlen in
+internationaler Schreibweise als Punkt notiert). 
+    So ist #bsp("4")# eine INT-Zahl, während #bsp("4.0")# den Typ REAL besitzt.
+Denken Sie in Zukunft immer daran, welcher Zahltyp jeweils ver­
+langt wird und richten Sie die Schreibweise danach. 
+ 
+#a ("Unterschied zu Feldtypen")# Verwechseln Sie die hier vorgestellten
+Datentypen nicht mit den Feldtypen einer EUDAS-Datei. Die Feld­
+typen beziehen sich immer auf den gleichen Datentyp, nämlich
+TEXT. Die Feldtypen bestimmen lediglich die spezielle Behandlung
+des Feldes beim Suchen und Sortieren, während Datentypen tat­
+sächlich Unterschiede in der Speicherung und den anwendbaren
+Operationen bedeuten. 
+    Daher können Sie Feldtypen auch nach Bedarf ändern, während
+der Datentyp eines Objekts ein für alle Mal feststeht. Merken Sie
+sich, daß Feldinhalte in EUDAS immer den Typ TEXT haben. 
+ 
+#a ("Umwandlungen")# Obwohl verschiedene Datentypen nicht miteinander
+gemischt werden dürfen, können sie mit speziellen Funktionen in­
+einander umgewandelt werden. So ist zum Beispiel die Addition von
+#bsp("1")# und #bsp("1.5")# verboten, aber der folgende Ausdruck 
+#f2# 
+#beispiel# 
+        real (1) + 1.5 
+#text# 
+#f2# 
+liefert den Wert #bsp("2.5")# mit dem Typ REAL. Umgekehrt geht die Um­
+wandlung mit der Funktion 'int', dabei werden jedoch die Nachkom­
+mastellen abgeschnitten. Weitere Hinweise dazu erhalten Sie im
+Abschnitt 14.4. 
+    Wichtiger jedoch ist die Umwandlung von Zahlen in TEXT-Ob­
+jekte. Was Sie auf Ihrem Bildschirm oder Ausdruck sehen, sind ja
+immer nur Zeichenfolgen und damit Texte. Zahlen (INT oder REAL)
+in ihrer internen Darstellung können Sie prinzipiell nicht sehen. Sie
+müssen zur Darstellung immer in Texte umgewandelt werden. 
+    Auch beim Rechnen mit Werten aus EUDAS-Dateien müssen
+mehrere Umwandlungen stattfinden. Der Feldinhalt, der ja ein TEXT
+ist, muß zunächst in eine Zahl umgewandelt werden. Dann wird mit
+dieser Zahl gerechnet. Wenn das Ergebnis wieder in ein Feld einge­
+tragen oder gedruckt werden soll, muß eine Rückumwandlung in
+einen Text vorgenommen werden. 
+    Die zum Umwandeln benötigten Funktionen werden ebenfalls im
+Abschnitt 14.4 besprochen. 
+ 
+#a ("Funktionsbeschreibung")# In den zwei folgenden Abschnitten sollen
+die wichtigsten Funktionen und Operatoren anhand von Beispielen
+beschrieben werden. Da jede Funktion nur auf bestimmte Datentypen
+angewendet werden kann, gibt es eine Notation, die genau die Form
+eines Funktionsaufrufs festlegt. 
+#f2# 
+#beispiel# 
+        INT PROC min (INT CONST a, b) 
+#text# 
+#f2# 
+Die obige Schreibweise hat folgende Bedeutung: Spezifiziert wird die
+Funktion 'min', die als Ergebnis einen INT-Wert liefert (das INT
+ganz links). Die Bezeichnung PROC gibt an, daß es sich um eine
+Funktion handelt. In Klammern ist dann angegeben, welche Parame­
+ter verwendet werden müssen. Die Funktion hat zwei Parameter,
+beide vom Typ INT. Die Bezeichnung CONST gibt an, daß auch Kon­
+stanten verwendet werden dürfen (Normalfall). 
+    Zu beachten ist, daß bei jedem Aufruf beide Parameter vorhan­
+den und vom Typ INT sein müssen. Anderenfalls gibt es eine Feh­
+lermeldung. 
+    Die gleiche Schreibweise wird auch zur Spezifikation von Ope­
+ratoren verwendet: 
+#f2# 
+#beispiel# 
+        INT OP + (INT CONST a, b) 
+#text# 
+#f2# 
+Jedoch dürfen Operatoren nicht mit Parametern in Klammern ge­
+schrieben werden, sondern der Operator wird zwischen die Parameter
+geschrieben. 
+    Eine Besonderheit von ELAN ist es, daß es verschiedene Opera­
+toren und Funktionen mit gleichem Namen geben kann. Die Funktio­
+nen werden nur unterschieden nach dem Typ ihrer Parameter. So
+gibt es nicht nur den oben genannten Operator #bsp("'+'")#, sondern auch
+den folgenden: 
+#f2# 
+#beispiel# 
+        REAL OP + (REAL CONST a, b) 
+#text# 
+#f2# 
+Obwohl im Aussehen gleich, handelt es sich doch um verschiedene
+Operatoren mit möglicherweise völlig verschiedener Wirkung. Dies
+sieht man an diesem Beispiel: 
+#f2# 
+#beispiel# 
+        TEXT OP + (TEXT CONST a, b) 
+#text# 
+#f2# 
+Dieser Operator führt nun keine Addition aus, sondern eine #on("i")#Verket­
+tung#off("i")# zweier Texte. Je nach Typ der Parameter wird der entspre­
+chende Operator ausgesucht. 
+ 
+ 
+#abschnitt ("14.3", "TEXT-FUNKTIONEN", "TEXT-Funktionen")# 
+ 
+In diesem Abschnitt wollen wir die wichtigsten Funktionen und
+Operatoren zur Behandlung von Texten beschreiben. Wie Sie noch
+sehen werden, spielt dabei aber auch der Typ INT eine gewisse
+Rolle. 
+ 
+#a ("EUDAS-Abfragen")# Die wichtigste Funktion zur Abfrage von Inhal­
+ten der aktuellen Datei sollten Sie bereits kennen: 
+#f2# 
+#beispiel# 
+        TEXT PROC f (TEXT CONST feldname) 
+#text# 
+#f2# 
+Neu ist eigentlich nur die Schreibweise der Spezifikation. Sie sollten
+aber in der Lage sein, daraus einen konkreten Ausdruck zu kon­
+struieren. Bisher haben wir immer die Schreibweise 
+#f2# 
+#beispiel# 
+        f ("Feldname") 
+#text# 
+#f2# 
+verwendet. Dies ist jedoch nur ein Beispiel. Die korrekte Angabe
+finden Sie oben. 
+    Die Funktion 'f' darf natürlich nicht angewendet werden, wenn
+keine Datei geöffnet ist. In die Verlegenheit kommen Sie aber nur
+beim Ausprobieren, denn alle gefährlichen EUDAS-Funktionen sind
+sonst gesperrt. 
+    Falls das angegebene Feld nicht existiert, wird mit einer Feh­
+lermeldung abgebrochen. Beachten Sie, daß dies immer erst bei der
+Ausführung festgestellt werden kann. Bei der Eingabe, zum Beispiel
+eines Druckmusters, kann dies noch nicht überprüft werden. 
+    Eine weitere Abfrage, die EUDAS während des Druckens ermög­
+licht, ist die Funktion 
+#f2# 
+#beispiel# 
+        TEXT PROC lfd nr 
+#text# 
+#f2# 
+Diese hat keine Parameter und liefert die laufende Nummer des
+gedruckten Satzes #on("i")#als Text#off("i")#. 
+    Diese beiden Funktionen können als Ausgangsbasis dienen zur
+Manipulation mit weiteren Funktionen. 
+ 
+#a ("Verkettung")# Zur Verkettung von Teiltexten gibt es den oben schon
+beschriebenen Operator '+'. Wenn Sie mehr als zwei Texte verketten
+wollen, können Sie den Operator beliebig hintereinander verwenden: 
+#f2# 
+#beispiel# 
+        f ("PLZ") + " " + f ("Ort") 
+#text# 
+#f2# 
+Wie in diesem Beispiel können Sie sowohl Konstanten als auch Tex­
+te, die von anderen Funktionen geliefert werden, verketten. Beach­
+ten Sie, daß die Texte immer ohne Zwischenraum aneinandergehängt
+werden; daher wird im obigen Beispiel ein Leerzeichen extra ange­
+geben. 
+    Wenn Sie eine bestimmte Anzahl von gleichen Zeichen haben
+möchten (zum Beispiel für horizontale Linien oder große Zwischen­
+räume), können Sie dafür folgenden Operator verwenden: 
+#f2# 
+#beispiel# 
+        TEXT OP * (INT CONST anzahl, TEXT CONST einzeltext) 
+#text# 
+#f2# 
+Hier sehen Sie als Beispiel einen Operator, der mit verschiedenen
+Datentypen arbeitet. Sie müssen die Parameter jedoch immer in der
+angegebenen Reihenfolge benutzen. Das folgende Beispiel ist kor­
+rekt: 
+#f2# 
+#beispiel# 
+        20 * "-" 
+#text# 
+#f2# 
+während dies nicht erlaubt ist: 
+#f2# 
+#beispiel# 
+        "-" * 20 
+#text# 
+#f2# 
+Wieder können Sie diesen Operator mit anderen Funktionen verknü­
+pfen: 
+#f2# 
+#beispiel# 
+        "!" + 10 * " " + "!" + 5 * "-" + "!" 
+#text# 
+#f2# 
+Da der Multiplikationsoperator Vorrang vor der Addition hat, kom­
+men Sie hier sogar ohne Klammern aus (überlegen Sie sich, wo ein
+Fehler auftreten würde, wenn dies nicht so wäre). Als Ergebnis
+dieses komplexen Ausdrucks ergäbe sich der folgende Text: 
+#f2# 
+#beispiel# 
+        "!          !-----!" 
+#text# 
+ 
+#a ("Teiltexte")# Um auch Teile von Texten bearbeiten zu können, werden
+die Zeichen eines Textes von 1 an (mit INT-Zahlen) durchnumeriert.
+Anhand dieser Positionen können Sie Teiltexte extrahieren. 
+    Damit Sie die Position des letztes Zeichens (und damit die An­
+zahl der Zeichen) erfragen können, gibt es die Funktion 
+#f2# 
+#beispiel# 
+        INT PROC length (TEXT CONST text) 
+#text# 
+#f2# 
+Wieviel Zeichen in einem Feld stehen, können Sie also mit 
+#f2# 
+#beispiel# 
+        length (f ("Feldname")) 
+#text# 
+#f2# 
+erfahren. 
+    Einen Teiltext bekommen Sie mit der Funktion 'subtext'. Diese
+gibt es in zwei Ausführungen. 
+#f2# 
+#beispiel# 
+        TEXT PROC subtext (TEXT CONST text, INT CONST anfang) 
+#text# 
+#f2# 
+liefert den Teiltext von einer bestimmten Position an (einschließ­
+lich) bis zum Textende. Mit 
+#f2# 
+#beispiel# 
+       TEXT PROC subtext (TEXT CONST t, INT CONST anf, ende) 
+#text# 
+#f2# 
+können Sie auch die Position des letzten Zeichens (einschließlich)
+angeben. Daher würden die beiden folgenden Aufrufe 
+#f2# 
+#beispiel# 
+        subtext (f ("Feldname"), 1) 
+        subtext (f ("Feldname"), 1, length (f ("Feldname"))) 
+#text# 
+#f2# 
+den Feldinhalt unverändert liefern. Ein weiteres Beispiel: 
+#f2# 
+#beispiel# 
+        subtext ("Ein Text als Beispiel", 5, 8) 
+#text# 
+#f2# 
+liefert als Ergebnis #bsp("""Text""")#. 
+    Es gibt noch den Operator 'SUB', der jeweils nur ein Zeichen
+aus dem Text liefert: 
+#f2# 
+#beispiel# 
+        TEXT OP SUB (TEXT CONST text, INT CONST stelle) 
+#text# 
+#f2# 
+Der Aufruf ist gleichwertig zu einem Aufruf von 'subtext', in dem
+beide Stellen gleich sind. 
+    Bei beiden Funktionen wird nicht vorhandener Text einfach
+ignoriert. So liefert 
+#f2# 
+#beispiel# 
+        subtext ("Hallo", 4, 8) 
+#text# 
+#f2# 
+das Ergebnis #bsp ("""lo""")# und 
+#f2# 
+#beispiel# 
+        "Hallo" SUB 10 
+#text# 
+#f2# 
+den leeren Text #bsp("""""")#. 
+ 
+#a ("Verschachtelte Ausdrücke")# Wie Sie bereits gesehen haben, kann
+man Ausdrücke ineinander verschachteln. Dies ist in unserem Fall
+sehr nützlich, wenn Teiltexte bestimmt werden sollen, deren Posi­
+tion nicht konstant ist. Ein Beispiel, in dem 'length' bei der Fest­
+legung der Endposition verwendet wird, haben Sie weiter oben
+bereits gesehen. 
+    Als weitere Möglichkeit können Sie mit Positionen, die ja INT-
+Zahlen sind, ganz normal rechnen. Folgender Ausdruck liefert zum
+Beispiel die letzten drei Zeichen eines Feldes: 
+#f2# 
+#beispiel# 
+        subtext (f ("Feldname"), length (f ("Feldname")) - 2) 
+#text# 
+#f2# 
+Wichtig ist, daß ein Ausdruck, der wieder als Parameter für einen
+anderen Ausdruck verwendet werden soll, den richtigen Typ hat,
+der von dem anderen Ausdruck verlangt wird. 
+    In dem obigen Beispiel muß als Position ein INT verwendet
+werden. Diese Position wird vom Operator '-' berechnet. Es gibt
+aber nur einen Subtraktionsoperator, der einen INT liefert, nämlich
+den, der wiederum zwei INTs subtrahiert. Glücklicherweise sind
+sowohl 'length' als auch die 2 vom Typ INT, anderenfalls wäre der
+Ausdruck fehlerhaft. 'length' wiederum benötigt einen TEXT als
+Parameter, der von der Funktion 'f' stammt, die als Parameter eben­
+falls einen TEXT verlangt. 
+    Wie Sie sehen, kann es durchaus verwickelt zugehen, wenn ein
+Ausdruck aus den verschiedensten Teilausdrücken unterschiedlichen
+Typs zusammengesetzt ist. Die gleiche Überprüfung wie eben ge­
+schildert sollten Sie bei jedem Ausdruck vornehmen, damit keine
+Fehlermeldung erscheint. 
+ 
+#a ("Variable Positionen")# Zur Berechnung von Positionen gibt es noch
+eine weitere nützliche Prozedur, nämlich 
+#f2# 
+#beispiel# 
+        INT PROC pos (TEXT CONST text, teiltext) 
+#text# 
+#f2# 
+Sie liefert die Position, an der der angegebene Teiltext zum ersten
+Mal in dem Text vorkommt, oder 0, wenn der Teiltext nicht darin
+vorkommt. So ist 
+#f2# 
+#beispiel# 
+        pos ("Hallo", "l") = 3 
+#text# 
+#f2# 
+und 
+#f2# 
+#beispiel# 
+        pos ("Hallo", "lo") = 4 
+#text# 
+#f2# 
+und 
+#f2# 
+#beispiel# 
+        pos ("Hallo", "xx") = 0 
+#text# 
+#f2# 
+Diese Funktion kann zum Beispiel dazu verwendet werden, ein Feld
+in mehrere Teile aufzuspalten. Sind zum Beispiel Name und Vorname
+in einem Feld durch Leerzeichen getrennt hintereinandergeschrie­
+ben, liefert 
+#f2# 
+#beispiel# 
+        subtext (f ("Name"), 1, pos (f ("Name"), " ") - 1) 
+#text# 
+#f2# 
+den Vornamen und entsprechend 
+#f2# 
+#beispiel# 
+        subtext (f ("Name"), pos (f ("Name"), " ") + 1) 
+#text# 
+#f2# 
+den Nachnamen. Soll die Position erst ab einer gewissen Stelle ge­
+sucht werden, gibt es noch die folgende Variation der Funktion: 
+#f2# 
+#beispiel# 
+        INT PROC pos (TEXT CONST text, teiltext, INT CONST ab) 
+#text# 
+#f2# 
+Bei dieser Funktion wird erst ab der angegebenen Stelle einschließ­
+lich gesucht. 
+ 
+ 
+#abschnitt ("14.4", "RECHENFUNKTIONEN", "Rechenfunktionen")# 
+ 
+#a ("Umwandlungen")# Bevor mit dem Inhalt eines Feldes gerechnet wer­
+den kann (auch wenn das Feld den Feldtyp ZAHL hat), muß der Wert
+des Feldinhaltes als REAL-Zahl berechnet werden. Dazu gibt es die
+Funktion 
+#f2# 
+#beispiel# 
+        REAL PROC wert (TEXT CONST feldname) 
+#text# 
+#f2# 
+Die Funktion 'wert' ignoriert alle Sonderzeichen in dem Feld außer
+dem Minuszeichen (als Vorzeichen) und dem eingestellten Dezimal­
+komma. Wenn das Feld 'Summe' beispielsweise #bsp("""-***20,09 DM""")# ent­
+hält, ergibt sich 
+#f2# 
+#beispiel# 
+        wert ("Summe") = 20.09 
+#text# 
+#f2# 
+Zum kaufmännischen Rechnen ist es manchmal erforderlich, den Wert
+auf eine bestimmte Anzahl von Nachkommastellen zu runden. Diese
+Anzahl kann man bei einer Variante von 'wert' als Parameter ange­
+ben: 
+#f2# 
+#beispiel# 
+        REAL PROC wert (TEXT CONST feldname, 
+                        INT CONST kommastellen) 
+#text# 
+#f2# 
+Mit den so erhaltenen Werten können Sie dann die weiter unten
+beschriebenen Berechnungen durchführen. Bevor Sie das Ergebnis
+jedoch drucken oder in ein Feld eintragen können, müssen Sie den
+REAL-Wert wieder in einen TEXT verwandeln. Dazu dient die Funk­
+tion 
+#f2# 
+#beispiel# 
+        TEXT PROC zahltext (REAL CONST wert, 
+                            INT CONST kommastellen) 
+#text# 
+#f2# 
+Der übergebene Wert wird mit der gewünschten Anzahl von Komma­
+stellen als Text formatiert. Dazu wird der Wert gerundet. Außerdem
+wird statt eines Punktes das eingestellte Dezimalkomma eingesetzt.
+Die Länge des Textes richtet sich nach der Anzahl von benötigten
+Stellen, es werden also keine führenden Nullen oder Leerzeichen
+eingesetzt (dafür kann man den Text beim Drucken ja rechtsbündig
+einsetzen). 
+    Wird 0 als Kommastellen angegeben, wird auch kein Dezimal­
+komma erzeugt (Darstellung wie ein INT). Als Abkürzung können Sie
+auch 
+#f2# 
+#beispiel# 
+        TEXT PROC zahltext (TEXT CONST feldname, 
+                            INT CONST kommastellen) 
+#text# 
+#f2# 
+als Ersatz für 
+#f2# 
+#beispiel# 
+        zahltext (wert ("Feldname"), kommastellen) 
+#text# 
+#f2# 
+verwenden. So kann ein Feld einheitlich zum Drucken formatiert
+werden. 
+ 
+#a ("Arithmetik")# Sowohl mit INT- als auch mit REAL-Zahlen (jedoch
+nicht gemischt) können Sie die üblichen Rechenoperatoren #bsp("'+'")#, #bsp("'-'")#
+und #bsp("'*'")# verwenden. Auch Minimum ('min') und Maximum ('max') sind
+für zwei Parameter dieser Typen definiert. 
+    Lediglich die Division wird bei beiden Typen unterschiedlich
+gehandhabt. Für REAL-Zahlen gibt es den Operator #bsp("'/'")# für die
+übliche Division. Da die ganzzahlige Division eine andere Bedeutung
+hat, wird dafür der Operator 'DIV' verwendet. Den Rest der ganz­
+zahligen Division liefert 'MOD'. 
+    'abs' liefert den Wert eines REAL oder INT ohne das Vorzeichen.
+Die Umwandlungsfunktionen 'int' und 'real' hatten wir ja bereits
+weiter oben erwähnt. 
+    Für REAL-Zahlen gibt es noch weitere mathematische Funktio­
+nen (Exponentialfunktion, Trigonometrie), die Sie am besten im
+EUMEL-Benutzerhandbuch nachschlagen, wenn Bedarf dafür besteht. 
+ 
+ 
+#abschnitt ("14.5", "ABFRAGEN", "Abfragen")# 
+ 
+#a ("IF-Abfragen")# Wie Sie schon im vorigen Kapitel gesehen haben,
+kann man in Druckmustern auch IF-Abfragen als Ausdrücke ver­
+wenden. Die IF-Abfragen können zwar auch ineinander verschach­
+telt werden, sie dürfen jedoch nicht mehr innerhalb eines normalen
+Ausdrucks angewendet werden. 
+    Eine IF-Abfrage enthält 3 Teilausdrücke in folgender Form: 
+ 
+#beispiel# 
+        IF 'BOOL-Ausdruck' THEN 
+          'Ausdruck1' 
+        ELSE 
+          'Ausdruck2' 
+        END IF 
+#text# 
+ 
+Der erste Ausdruck muß einen Wert vom Typ BOOL liefern, der ent­
+scheidet, welcher der beiden Teilausdrücke ausgewertet wird. Wir
+werden gleich noch sehen, was für Möglichkeiten es da gibt. 
+    Die beiden Teilausdrücke dürfen auch wieder IF-Abfragen sein,
+sind sie es jedoch nicht, dürfen in ihnen dann keine IF-Abfragen
+mehr vorkommen. Die IF-Abfragen liegen also immer auf der äußer­
+sten Ebene. 
+    Die beiden Teilausdrücke dürfen einen beliebigen Typ haben, er
+muß jedoch für beide gleich sein. 
+    Als Ergebnis der IF-Abfrage wird 'Ausdruck1' geliefert, wenn
+der BOOL-Ausdruck wahr ist, sonst 'Ausdruck2'. 
+ 
+#a ("Vergleiche")# Die wesentlichen Operationen, die boolesche Ausdrücke
+zur Verwendung in IF-Abfragen bilden, sind die Vergleichsoperato­
+ren: 
+ 
+#beispiel# 
+        =   <>   <=   >=   <   > 
+#text# 
+ 
+Sie vergleichen jeweils zwei Elemente vom Typ TEXT, INT oder REAL
+und liefern TRUE (wahr) oder FALSE (falsch). Selbstverständlich
+können auch sie zwei zusammengesetzte Teilausdrücke vergleichen. 
+    Eine Anwendung ist zum Beispiel der Test, ob ein Text in einem
+anderen enthalten ist: 
+ 
+#beispiel# 
+        IF pos (f ("Betrag"), "DM") > 0 THEN 
+          "deutsches Geld" 
+        ELSE 
+          "ausländisches Geld" 
+        END IF 
+#text# 
+ 
+Die Funktion 'pos' wird hier dazu benutzt, festzustellen, ob es sich
+um deutsches oder ausländisches Geld handelt. 
+    Oft müssen jedoch mehrere Vergleiche miteinander kombiniert
+werden. Zu diesem Zweck gibt es die beiden Operatoren AND (und)
+und OR (oder). Damit AND das Ergebnis TRUE liefert, müssen beide
+Vergleiche wahr sein, bei OR muß mindestens einer der beiden wahl
+sein. 
+    Die Reihenfolge aller dieser Operatoren ist so gewählt, daß
+normalerweise keine Klammern benötigt werden. Funktionen haben
+immer Vorrang vor Operatoren, bei den Operatoren kommt die Multi­
+plikation vor der Addition, dann kommen die Vergleiche, danach das
+AND und danach das OR. Alle anderen Operatoren (#on("i")#insbesondere
+SUB#off("i")#) teilen sich den letzten Rang. 
+    Wenn Sie also in einem Ausdruck mehrere Vergleiche mit AND
+und OR verknüpfen, und das OR soll stärker binden als das AND,
+müssen Sie dies durch Klammern ausdrücken. 
+    Den oben besprochenen Operator SUB sollten Sie immer in
+Klammern setzen, wenn Sie ihn in einem Vergleich benutzen. Da er
+die niedrigste Priorität hat, gäbe es sonst mit Sicherheit Fehler: 
+ 
+#beispiel# 
+        IF (f ("Name") SUB 1) = "M" THEN 
+          "vielleicht Müller" 
+        ELSE 
+          "bestimmt nicht" 
+        END IF 
+#text# 
+ 
+#a ("Refinements")# Bisher hatten wir gesagt, daß IF-Abfragen nicht
+innerhalb von anderen Ausdrücken verwendet werden dürfen. Diese
+Einschränkung kann man umgehen, indem man #on("i")#Refinements#off("i")# verwen­
+det. 
+    Ein Refinement hat im Druckmuster eine ähnliche Wirkung wie
+eine Abkürzung, lediglich der Name darf nur mit Kleinbuchstaben
+und Ziffern geschrieben sein und kann nicht als Feldmuster ver­
+wendet werden. 
+ 
+#beispiel# 
+        &abk : 
+          subtext (f ("Name"), namensanfang) . 
+        namensanfang : 
+          IF pos (f ("Name"), " ") > 0 THEN 
+            pos (f ("Name"), " ") + 1 
+          ELSE 
+            length (f ("Name")) 
+          END IF . 
+#text# 
+ 
+Innerhalb von Refinements dürfen auch wieder andere Refinements
+verwendet werden. 
+    Auch in Kopier- und Änderungsmustern können Sie Refinements
+verwenden. Hier müssen Sie jedoch darauf achten, daß alle Refine­
+ments am Ende gesammelt werden und vor dem ersten Refinement
+ein Punkt stehen muß. Ebenso müssen die Refinements wie im
+Druckmuster durch Punkte voneinander getrennt sein: 
+ 
+#beispiel# 
+        "Anrede" K anrede; 
+        . 
+        anrede : 
+          IF f ("m/w") = "w" THEN 
+            "Frau" 
+          ELSE 
+            "Herr" 
+          END IF . 
+#text# 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.15 b/app/eudas/4.4/doc/user-manual/eudas.hdb.15
new file mode 100644
index 0000000..c15fb9a
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.15
@@ -0,0 +1,269 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (165)# 
+#kapitel ("15", "Anweisungen", "in", "ELAN")# 
+ 
+ 
+ 
+#abschnitt ("15.1", "VARIABLEN UND ZUWEISUNGEN", "Variablen und Zuweisungen")# 
+ 
+Im vorigen Kapitel haben wir Ausdrücke in ELAN kennengelernt. Der
+Wert eines Ausdrucks wird bei jeder Verwendung erneut berechnet.
+Wenn wir den Wert eines Ausdrucks aufbewahren wollen, müssen wir
+ihn schon in eine EUDAS-Datei schreiben. 
+    Oft tritt jedoch die Notwendigkeit auf, Werte zu merken, ohne
+sie in einer Datei zu speichern. Beispiel dafür ist ein Zählvorgang im
+Druckmuster. In jedem Wiederholungsteil muß der dazukommende
+Wert zum bisherigen, aufsummierten und aufbewahrten Wert addiert
+werden. Das Zwischenergebnis der Zählung muß also irgendwo ge­
+speichert werden. 
+ 
+#a ("Variablen")# Zu diesem Zweck gibt es Variablen. Sie sind ähnlich wie
+Felder in einer Datei. Ihre Existenz ist jedoch unabhängig von einer
+Datei. Außerdem sind sie zu Anfang nicht einfach leer, sondern
+haben einen undefinierten Wert. 
+    Variablen müssen im Programm definiert werden. Sie existieren
+dann während der Ausführung dieses Programms und gehen an­
+schließend verloren. Zu Beginn des Programms sind sie, wie schon
+gesagt, undefiniert. 
+    Eine Variable muß immer einen Typ haben. Dieser Typ ist für
+die Lebensdauer der Variable unveränderlich. Die Variable kann
+natürlich nur Werte dieses Typs annehmen. 
+    Eine Variablendefinition (oder auch -deklaration) besteht aus
+der Angabe eines Typs, dem Schlüsselwort #bsp ("VAR")# und einem freige­
+wählten Namen. Wie schon bei den Refinements darf ein solcher
+Name nur aus Kleinbuchstaben (keine Umlaute) und eventuell Zif­
+fern bestehen. Dagegen darf der Name Leerzeichen enthalten. 
+Beispiel: 
+ 
+#beispiel# 
+        INT VAR zaehler; 
+        TEXT VAR feldname; 
+        REAL VAR mein ergebnis 1; 
+#text# 
+ 
+Das Semikolon am Ende beschließt die Definition. 
+    Die Lebensdauer einer Variablen hängt davon ab, an welcher
+Stelle sie definiert ist. Eine Variable, die im Druckmuster im Initia­
+lisierungsteil definiert ist, behält ihren Wert für die gesamte Dauer
+des Druckvorgangs. Eine Variable in einem Abschnitt lebt dagegen
+nur für eine Abarbeitung dieses Abschnitts. Bei der nächsten Abar­
+beitung ist sie wieder undefiniert. 
+    Das gleiche gilt für Kopier- und Änderungsmuster. Auch hier
+sind Variablen nur für die Dauer der Bearbeitung eines Satzes
+gültig. 
+ 
+#a ("Zuweisung")# Um einer Variablen einen Wert zu geben, führt man eine
+#on ("i")#Zuweisung#off("i")# aus. Die Zuweisung wird durch Doppelpunkt und Gleich­
+heitszeichen aneinandergeschrieben gekennzeichnet. Auf der linken
+Seite steht die Variable, auf der rechten Seite eine Ausdruck: 
+ 
+#beispiel# 
+        zaehler := 1; 
+#text# 
+ 
+Wie oben schließt das Semikolon die Anweisung ab. Nach der Aus­
+führung hat die Variable den Wert 1. Der Wert vorher ist für die
+Zuweisung egal, er kann definiert oder undefiniert sein. 
+    Eine Variable kann in einem Ausdruck verwendet werden, indem
+man einfach den Namen hinschreibt. Der Ausdruck 
+ 
+#beispiel# 
+        zaehler + 1 
+#text# 
+ 
+hat nach der obigen Zuweisung den Wert 2. Eine Variable muß bei
+der Verwendung definiert sein, sonst können beliebige Fehler ent­
+stehen. Es muß also vor der ersten Verwendung ausdrücklich eine
+Zuweisung erfolgt sein. 
+    Da Variablen in Ausdrücken verwendet werden können und
+Ausdrücke auf der rechten Seite einer Zuweisung stehen, ist folgen­
+de Konstruktion möglich: 
+ 
+#beispiel# 
+        zaehler := zaehler + 1; 
+#text# 
+ 
+Diese Zeile bewirkt, daß der Wert der Variable um 1 erhöht wird.
+Zuerst wird bei der Zuweisung der Wert des Ausdrucks auf der rech­
+ten Seite bestimmt. Zu diesem Zeitpunkt habe die Variable bei­
+spielsweise den Wert 1. Der Ausdruck hat dann den Wert 2 (1+1).
+Dieser Wert wird der neue Wert der Variablen. 
+    Bei der nächsten Ausführung würde sich der gleiche Vorgang
+wiederholen, so daß die Variable anschließend den Wert 3 hat. 
+    Auch bei der Zuweisung gilt natürlich, daß die Variable auf der
+linken Seite den gleichen Datentyp haben muß wie der Ausdruck auf
+der rechten Seite. 
+ 
+#a ("Initialisierung")# Sie können Variablendeklaration und Zuweisung
+auch miteinander verknüpfen, so daß die Variable gleich zu Anfang
+einen Wert erhält: 
+ 
+#beispiel# 
+        INT VAR zaehler := 0; 
+#text# 
+ 
+Dieses Verfahren ist eine gute Vorsichtsmaßregel, damit Sie keine
+undefinierten Variablen verwenden. 
+ 
+#a ("Inkrement")# Da der Fall so häufig auftritt, daß der Wert einer Vari­
+ablen um einen bestimmten Wert erhöht wird (bei allen Zählvorgän­
+gen), gibt es auch dafür eine Abkürzung, und zwar die beiden Ope­
+ratoren INCR und DECR. 
+ 
+#beispiel# 
+        zaehler INCR 1; 
+        mein ergebnis 1 DECR 24.4; 
+#text# 
+ 
+Die Operatoren sind für REALs und INTs definiert. INCR erhöht um
+einen Betrag, DECR erniedrigt. Auf der rechten Seite darf wieder ein
+beliebiger Ausdruck stehen. 
+    Für TEXTe gibt es eine ähnliche Abkürzung, allerdings nur für
+die Addition (Verkettung). Hier heißt der Operator CAT. Die beiden
+folgenden Zeilen haben die gleiche Bedeutung: 
+ 
+#beispiel# 
+        feldname := feldname + "."; 
+        feldname CAT "."; 
+#text# 
+ 
+ 
+#abschnitt ("15.2", "WEITERE KONSTRUKTIONEN", "Weitere Konstruktionen")# 
+ 
+#a ("IF")# Die Ihnen bereits bekannte IF-Konstruktion dient nicht nur
+dazu, Werte zu liefern, sondern steuert auch die Abarbeitung von
+beliebigen Anweisungen. Diese Anweisungen können Kopier- und
+Änderungsanweisungen sein (s. Kapitel 11), oder die oben beschrie­
+benen Zuweisungen. 
+    In einem Teil der IF-Konstruktion können auch mehrere Anwei­
+sungen stehen. Diese müssen dann jedoch unbedingt durch Semiko­
+lon getrennt sein. Mehrere Anweisungen hintereinander haben ein­
+fach die Bedeutung der Ausführung in der notierten Reihenfolge. 
+    Als drittes kann auch der ELSE-Teil weggelassen, da nicht in
+jedem Fall ein Ergebnis erwartet wird. Falls die Bedingung nicht
+zutrifft, muß nicht unbedingt etwas ausgeführt werden. 
+ 
+#beispiel# 
+        IF zaehler > 0 THEN 
+          zaehler DECR 1; 
+          mein ergebnis 1 INCR wert ("zaehlfeld") 
+        END IF; 
+#text# 
+ 
+Auch diese IF-Konstruktion kann wieder geschachtelt werden. Für
+viele Fälle gibt es jedoch einen ELIF-Teil, der die Verschachtelung
+erspart: 
+ 
+#beispiel# 
+        IF f ("m/w") = "m" THEN 
+          maenner INCR 1 
+        ELIF f ("m/w") = "w" THEN 
+          frauen INCR 1 
+        ELSE 
+          zweifelhaft INCR 1 
+        END IF; 
+#text# 
+ 
+Der ELIF-Teil beinhaltet noch einmal einen Test. Dieser Test wird
+jedoch nur dann durchgeführt, wenn die erste Bedingung falsch war.
+Gibt es noch mehr Wahlmöglichkeiten, können Sie beliebig viele
+ELIF-Teile benutzen. 
+    Beachten Sie, daß die letzte Anweisung in einem Teil der IF-
+Konstruktion nicht unbedingt ein folgendes Semikolon haben muß
+(das Semikolon soll nur trennen). Ein Semikolon an dieser Stelle
+kann aber auch nicht schaden. 
+ 
+#a ("Werteliefernde Programme")# Nicht nur Ausdrücke können Werte lie­
+fern, sondern auch ganze Anweisungsfolgen. Dies ist eine Erweite­
+rung der werteliefernden IF-Konstruktion. Sie können dies für Ab­
+kürzungen oder Refinements ausnutzen. 
+ 
+#beispiel# 
+        endergebnis : 
+          gesammelte zeichen CAT "."; 
+          gesammelte zeichen . 
+#text# 
+ 
+In diesem Beispiel werden in einer Textvariable bestimmte Zeichen
+gesammelt. Zum Schluß soll ein Punkt angefügt werden und dieser
+Text dann als Ergebnis des Refinements geliefert werden. 
+    Damit eine Anweisungsfolge einen Wert liefert, muß am Ende
+der Anweisungsfolge ein Ausdruck stehen. Der Wert des Ausdrucks
+nach Abarbeitung der Anweisungen ist dann der Wert der Anwei­
+sungsfolge. 
+    Allerdings kann man den gleichen Wert oft verschieden aus­
+drücken. Folgendes Refinement hat die gleiche Wirkung wie oben: 
+ 
+#beispiel# 
+        endergebnis : 
+          gesammelte zeichen + "." . 
+#text# 
+ 
+In manchen Fällen ist eine Formulierung als werteliefernde Anwei­
+sungsfolge jedoch übersichtlicher. 
+ 
+#a ("Beispiel")# Zum Abschluß dieses Kapitels wollen wir als Beispiel eine
+statistische Auswertung einer Zahlenreihe als Druckmuster formu­
+lieren. 
+    Gegeben sei eine Datei mit folgenden Feldern: 
+ 
+#beispiel# 
+        "Meßwert 1" 
+        "Meßwert 2" 
+#text# 
+ 
+Wir wollen als Ergebnis Mittelwert und Standardabweichung der
+beiden Meßwerte ausdrucken. Dazu dient das Druckmuster auf der
+folgenden Seite. 
+    Im Initialisierungsteil des Druckmusters werden die notwendi­
+gen Variablen definiert und initialisiert. Beachten Sie hier, daß in
+einer Definition mehrere Variablen durch Komma getrennt aufgeführt
+werden können, wenn sie den gleichen Typ haben. 
+    Im Wiederholungsteil müssen dann jeweils die Zwischensummen
+aktualisiert werden. Da mit der Funktion 'wert' eine relativ auf­
+wendige Umwandlung verbunden ist, wird der Wert des jeweiligen
+Feldes erst einmal in einer Variable zwischengespeichert, da er
+mehrmals benötigt wird. Diese Zwischenspeicherungsvariable muß
+nicht initialisiert werden 
+    Im Nachspann werden dann die Ergebnisse gedruckt. Die Formeln
+sind jeweils als Abkürzungen definiert. Die Funktion 'zahltext' sorgt
+dafür, daß die Werte mit drei Nachkommastellen (gerundet) aufge­
+führt werden. 
+    Da die Formeln relativ komplex sind, werden sie auf mehrere
+Zeilen verteilt (in ELAN hat das Zeilenende keine Bedeutung). 
+ 
+#beispiel# 
+        %% REAL VAR 
+        %%   messwert, 
+        %%   summe 1 := 0.0, quadratsumme 1 := 0.0, 
+        %%   summe 2 := 0.0, quadratsumme 2 := 0.0; 
+        %% INT VAR anzahl := 0; 
+        % WIEDERHOLUNG 
+        %% anzahl INCR 1; 
+        %% messwert := wert ("Meßwert 1"); 
+        %% summe 1 INCR messwert; 
+        %% quadratsumme 1 INCR messwert * messwert; 
+        %% messwert := wert ("Meßwert 2"); 
+        %% summe 2 INCR messwert; 
+        %% quadratsumme 2 INCR messwert * messwert; 
+        % NACHSPANN 
+        &anz Meßwerte. 
+                               Meßwert 1       Meßwert 2 
+        Mittelwert             &&mw1&&&&       &&mw2&&&& 
+        Standardabweichung     &&st1&&&&       &&st2&&&& 
+        % ABKUERZUNGEN 
+        &mw1 : zahltext (summe 1 / real (anzahl), 3) . 
+        &mw2 : zahltext (summe 2 / real (anzahl), 3) . 
+        &st1 : zahltext 
+          (sqrt ((quadratsumme 1 - summe 1 * summe 1 / 
+               real (anzahl)) / real (anzahl - 1)), 3) . 
+        &st2 : zahltext 
+          (sqrt ((quadratsumme 2 - summe 2 * summe 2 / 
+               real (anzahl)) / real (anzahl - 1)), 3) . 
+#text# 
+ 
+Mit entsprechenden Formeln können Sie dieses Beispiel für Ihre
+eigenen Statistiken erweitern. Die Beispiele der letzten beiden Ka­
+pitel sollten Ihnen genügend Anregungen dafür gegeben haben. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.16 b/app/eudas/4.4/doc/user-manual/eudas.hdb.16
new file mode 100644
index 0000000..b0e84ee
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.16
@@ -0,0 +1,329 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (171)# 
+#kapitel ("16", "Dateiverwaltung", "mit", "EUDAS")# 
+ 
+ 
+ 
+#abschnitt ("16.1", "DATEIEN IM SYSTEM", "Dateien im System")# 
+ 
+Zum Bearbeiten von Dateien innerhalb des Systems gibt es das Menü
+'Dateien', das Sie bereits in Kapitel 4 kurz kennengelernt haben.
+An dieser Stelle sollen die übrigen Funktionen dieses Menüs be­
+sprochen werden. 
+ 
+#beispiel# 
+        -------------- 
+        Dateien System 
+        U Übersicht 
+        -------------- 
+        Datei 
+        L Löschen 
+        N Umbenennen 
+        K Kopieren 
+        P Platzbedarf 
+        A Aufräumen 
+        -------------- 
+ 
+#center#Abb. 16-1   Menü 'Dateien' 
+#text# 
+ 
+Beachten Sie, daß alle Funktionen in diesem Menü mit Dateien
+beliebiger Struktur arbeiten können, also sowohl mit Textdateien
+als auch EUDAS-Dateien (und anderen). Dies liegt daran, daß
+Dateien an dieser Stelle einfach als "schwarze Kästen" mit beliebi­
+gem Inhalt betrachtet werden. 
+ 
+#a ("Übersicht")# Die Funktion 'Übersicht' haben Sie bereits ausprobiert.
+Sie zeigt in einem Editorfenster an der rechten Seite alle Dateien,
+die sich in Ihrer Task befinden. Falls nicht alle Dateien auf den
+Bildschirm passen, können Sie das Fenster mit HOP OBEN und HOP
+UNTEN rollen. Sie verlassen die Übersicht wie üblich mit ESC 'q'. 
+ 
+#a ("Löschen")# Auch die Funktion 'Löschen' sollten Sie schon kennen.
+Mit dieser Funktion verschwindet eine Datei auf Nimmerwieder­
+sehen. Daher werden Sie sicherheitshalber immer gefragt, ob Sie die
+Datei wirklich löschen wollen. Sie können in einer Auswahl auch
+alle zu löschenden Dateien ankreuzen (dann wird trotzdem nochmal
+gefragt). 
+    Eine EUDAS-Datei, die gerade geöffnet ist, können Sie nicht
+löschen (sonst würde EUDAS zumindest durcheinanderkommen). Sie
+müssen die Datei zuerst sichern - oder nicht sichern, aber die
+Arbeitskopien löschen. 
+ 
+#a ("Umbenennen")# Mit der Funktion 'Umbenennen' können Sie einer Datei
+einen neuen Namen geben. Sie werden zuerst aufgefordert, den alten
+Namen der Datei einzugeben. Alternativ können Sie hier wieder die
+umzubenennenden Dateien auswählen. Danach wird Ihnen (für jede
+ausgewählte Datei) der alte Dateiname zum Überschreiben angebo­
+ten. 
+    Sie können diesen Namen mit den üblichen Editierfunktionen
+verändern oder mit HOP RUBOUT löschen und ganz neu eingeben.
+Auf diese Weise sparen Sie sich erheblichen Tippaufwand, wenn Sie
+einen langen Dateinamen an nur einer Stelle verändern wollen. 
+ 
+#a ("Kopieren")# Wie in Abschnitt 11.2 bereits angedeutet, gibt es eine
+Funktion zum logischen Kopieren von Dateien. Dies ist eine Funk­
+tion, die sich auf spezielle Eigenschaften des EUMEL-Systems
+stützt. Wenn Sie eine Datei #on("i")#logisch#off("i")# kopieren, wird lediglich ein
+Verweis kopiert. Die Daten werden zunächst nur einmal für beide
+Dateien gespeichert. 
+    Natürlich hätte das Ganze wenig Sinn, wenn danach bei Ände­
+rungen immer beide Dateien geändert würden. Bei Änderungen an
+einer Datei werden jedoch nur die geänderten Daten getrennt ange­
+legt, der Rest wird weiterhin gemeinsam benutzt. Die beiden Dateien
+sind also nach außen hin komplett unabhängig, intern werden je­
+doch gemeinsame Daten so weit wie möglich geteilt. Auf diese Weise
+wird sowohl Zeit als auch Speicherplatz gespart. 
+    Dieses Verfahren ist besonders dann sinnvoll, wenn Sie sich
+einen bestimmten Stand einer Datei aufbewahren wollen. In diesem
+Fall stellen Sie sich eine logische Kopie her und arbeiten mit dem
+Original weiter. Es werden dann nur die Daten zusätzlich angelegt,
+die Sie seit der Kopie verändert haben. 
+    EUDAS benutzt die gleiche Funktion auch für die Arbeitskopie.
+Die Arbeitskopie teilt ebenfalls ihre Daten mit dem Original. Ande­
+renfalls wäre es ja auch zeitlich gar nicht möglich, beim Öffnen eine
+Arbeitskopie anzufertigen. 
+    Beim Aufruf der Funktion 'Kopieren' werden Sie zunächst nach
+dem Namen der Datei gefragt (wie üblich mit Auswahlmöglichkeit).
+Dann können Sie einen neuen Namen für die Kopie angeben. Dieser
+neue Name darf jedoch nicht für eine andere Datei vergeben sein.
+Wollen Sie eine andere Datei überkopieren, müssen Sie diese zu­
+nächst löschen. 
+    Denken Sie daran, daß die hier beschriebene Funktion sich
+wesentlich vom Kopieren im Menü 'Gesamtdatei' unterscheidet. Dort
+wird nämlich eine tatsächliche Kopie durchgeführt, dafür können Sie
+sich dann auch selektiv bestimmte Daten herausgreifen. Außerdem
+gilt die dortige Funktion nur für EUDAS-Dateien. 
+ 
+#a ("Platzbedarf")# Zu Ihrer Information können Sie sich auch den Platz­
+bedarf anzeigen lassen, den eine Datei auf dem Speichermedium hat.
+Wenn Sie den Namen der Datei angegeben haben, wird Ihnen die
+Größe in "Kilobyte" (KB) angegeben. Ein KB entspricht etwa 1000
+Zeichen, also einer halben vollgeschriebenen Bildschirmseite. 
+    Bei logisch kopierten Dateien wird für jede Datei der benötigte
+Platz separat angegeben. Sie können die Zahlen also nicht einfach
+addieren, um den Gesamtspeicherbedarf zu ermitteln, da Sie dann
+die gemeinsam benutzten Bereiche doppelt zählen würden. 
+ 
+#a ("Aufräumen")# Wenn eine Datei viel geändert wurde, führen zwei
+Effekte zu einer langsameren Verarbeitung dieser Datei. Zum einen
+wird durch Textleichen der Platzbedarf größer. Dies tritt vor allem
+dann auf, wenn zu einzelnen Sätzen immer etwas hinzugefügt wurde
+(eine Folge der Flexibilität, mit variablen Textlängen operieren zu
+dürfen). 
+    Da der Platzbedarf der Datei also wächst, sind mehr Speicher­
+zugriffe notwendig, als es dem Inhalt entspricht. Doch nicht nur der
+Platz, sondern auch die Verteilung der Sätze machen sich unange­
+nehm bemerkbar. Da vergrößerte Sätze intern am Ende der Datei
+gespeichert werden, werden logisch aufeinanderfolgende Sätze phy­
+sikalisch weit verstreut. 
+    Der gleiche Effekt ensteht auch durch Umsortieren oder Ein­
+fügen von Sätzen. Um die Datei sequentiell zu bearbeiten, sind also
+ständig wechselnde Speicherzugriffe erforderlich. 
+    Die beiden beschriebenen Effekte führen zur Geschwindigkeits­
+verringerung. Dies kann verhindert werden, indem die Datei in eine
+frische Datei umkopiert wird. Diesen Vorgang nennt man #on("i")#Reorgani­
+sieren#off("i")#. Dafür gibt es die Funktion 'Aufräumen'. 
+    Während des Umkopierens werden die Satznummern ausgegeben.
+Achten Sie darauf, daß zum Reorganisieren genügend Platz auf dem
+System vorhanden ist, um eine komplette Kopie der zu reorganisie­
+renden Datei aufzunehmen. 
+    Zum Reorganisieren muß nämlich tatsächlich eine physikalische
+Kopie angefertigt werden. Eine logische Kopie oder das Schreiben
+auf das Archiv reorganisieren eine Datei dagegen nicht, wohl aber
+die Funktion 'Kopieren' im Menü 'Gesamtdatei'. 
+    Da der Inhalt gelesen werden muß, funktioniert die Funktion
+'Aufräumen' im Gegensatz zu den oben gemachten Versprechungen
+nur für Textdateien oder EUDAS-Dateien, nicht aber für andere
+Dateitypen. Die Unterscheidung der Dateitypen wird automatisch
+vorgenommen. 
+ 
+ 
+#abschnitt ("16.2", "DATEIEN AUF DEM ARCHIV", "Dateien auf dem Archiv")# 
+ 
+Mit den Funktionen im Menü 'Archiv' können Sie nicht nur Dateien
+auf dem Archiv behandeln, sondern auch in anderen Tasks oder per
+EUMEL-Netz sogar auf anderen Rechnern. 
+ 
+#beispiel# 
+        -------------- 
+        Dateien Archiv 
+        U Übersicht 
+        D Üb. Drucken 
+        -------------- 
+        Datei 
+        K Kopieren 
+          vom Archiv 
+        S Schreiben 
+          auf Archiv 
+        L Löschen 
+          auf Archiv 
+        -------------- 
+        Archivdiskette 
+        I Init 
+        -------------- 
+        Z Zielarchiv 
+        P Paßwort 
+        R Reservieren 
+        -------------- 
+ 
+#center#Abb. 16-2   Menue 'Archiv' 
+#text# 
+ 
+#a ("Zielarchiv")# Dazu können Sie die Task einstellen, mit der Sie arbei­
+ten möchten. Normaleinstellung ist die Task 'ARCHIVE', die Ihre
+Archivdiskette bedient. Dies wird auch in der untersten Bildschirm­
+zeile angezeigt. 
+    Die Task stellen Sie mit der Funktion 'Zielarchiv' ein. Sie
+werden dann nach dem Namen der Task gefragt. Diese Task muß
+eine Managertask sein (also unabhängig vom Bildschirm arbeiten)
+und sie muß bereits existieren. 
+    Wenn Sie auf Ihrem Rechner das EUMEL-Netz installiert haben,
+werden Sie auch nach der Nummer der Zielstation gefragt, also der
+Nummer des Rechners, auf dem die gewünschte Task arbeitet. Durch
+Drücken von RETURN wird automatisch Ihre eigene Stationsnummer
+verwendet. 
+    Nun gibt es zwei Arten von Managertasks, mit denen EUDAS
+zusammenarbeiten kann, #on("i")#Archivmanager#off("i")# und normale Dateimanager.
+Der Unterschied besteht darin, daß ein Archivmanager für einen
+Benutzer reserviert werden muß, damit man nicht auf Disketten
+eines anderen Benutzers zugreifen kann. Normale Dateimanager
+können und sollen dagegen von mehreren Benutzern in beliebiger
+Reihenfolge angesprochen werden. 
+    Manche Rechner haben mehrere Archivmanager für mehrere
+Diskettenlaufwerke. Durch das Einstellen des Zielarchivs können Sie
+auf verschiedenen Laufwerken archivieren. Ein Archivmanager kann
+sich natürlich auch auf einem anderen Rechner befinden. Sie benut­
+zen dann dessen Diskettenlaufwerk. 
+    Beim Einstellen des Zielarchivs wird als letztes gefragt, ob die
+Zieltask ein Archivmanager ist oder nicht. Im Normalfall sollten Sie
+die Frage bejahen, wenn Sie 'ARCHIVE' einstellen, und ansonsten
+verneinen (s. die obigen Ausnahmefälle). 
+    Das eingestellte Zielarchiv wird jeweils in der untersten Bild­
+schirmzeile angezeigt. 
+    Die Reservierung eines Archivmanagers findet beim ersten Zu­
+griff statt. Beim Umschalten des Zielarchivs oder Verlassen des
+Menüs wird die Reservierung automatisch wieder aufgehoben. 
+ 
+#a ("Übersicht")# Mit der Funktion 'Übersicht' können Sie eine Auflistung
+aller Dateien abrufen, die sich auf der Archivdiskette (bzw. in dem
+eingestellten Manager) befinden. Wie die Dateiübersicht im System
+können Sie die Darstellung wie im Editor rollen und mit ESC 'q'
+verlassen. 
+    Wollen Sie die Übersicht gedruckt haben, rufen Sie die Funktion
+'Übersicht drucken' auf. Die Übersicht wird dann nochmals zusam­
+mengestellt und gleich gedruckt. 
+ 
+#a ("Schreiben und Lesen")# Mit den Funktionen 'Kopieren vom Archiv'
+und 'Schreiben auf Archiv' können Sie Dateien zwischen dem Archiv
+und Ihrer Task hin und her transportieren. Es wird jeweils eine
+Kopie angefertigt, das heißt das Original auf der Diskette oder in
+Ihrer Task wird nicht verändert. 
+    Wenn die transportierte Datei an ihrem Ziel schon existiert,
+wird gefragt, ob die vorher existierende Datei gelöscht (überschrie­
+ben) werden soll. Überschreiben aus Versehen ist nicht möglich,
+wenn Sie die Frage sorgfältig beantworten. 
+    Beim Aufruf der Funktionen können Sie den gewünschten Da­
+teinamen angeben oder in der Auswahl ankreuzen. Die Auswahl ist
+hier besonders sinnvoll, wenn Sie mehrere Dateien (eventuell sogar
+in einer bestimmten Reihenfolge) sichern müssen. Außerdem können
+Sie ja keine Datei transportieren, die nicht existiert; alle Möglich­
+keiten werden Ihnen also durch Ankreuzen angeboten. 
+    Beachten Sie, daß beim Überschreiben einer Datei auf einer
+Archivdiskette der Speicherplatz der alten (überschriebenen) Ver­
+sion im allgemeinen nicht wiederverwendet werden kann. In diesem
+Fall kann das Archiv voll werden, obwohl eigentlich genügend Platz
+da wäre. 
+ 
+#a ("Löschen")# Das gleiche Problem tritt auf beim Löschen einer Datei
+auf dem Archiv. Mit der Funktion 'Löschen auf Archiv' können Sie
+zwar die Datei auf der Diskette ungültig machen, der Platz wird
+jedoch nur dann wiederverwendet, wenn es die letzte Datei auf der
+Diskette war. Anderenfalls bleiben "Leichen" übrig, die Sie in der
+Archivübersicht als Striche erkennen können. 
+    Diese Probleme treten jedoch mit anderen Managern nicht auf,
+da diese Ihren Speicherplatz intelligenter verwalten können. 
+ 
+#a ("Initialisieren")# Als Abhilfe bei einem übergelaufenen Archiv müssen
+Sie das ganze Archiv initialisieren und neu beschreiben. Dazu gibt
+es die Funktion 'Init'. 
+    Diese Funktion müssen Sie auch dann verwenden, wenn Sie eine
+Archivdiskette zum ersten Mal verwenden. Auf dem Archiv muß
+nämlich als erstes der Archivname eingetragen werden, ehe es be­
+nutzt werden kann. Diesen Namen müssen Sie hier angeben. 
+    Alle alten Daten des Archivs werden komplett gelöscht. Daher
+müssen Sie vorher die noch gültigen Daten vom Archiv ins System
+kopiert haben. Wenn das Archiv vorher schon beschrieben war,
+werden Sie anhand des Namens gefragt, ob Sie die richtige Diskette
+zum Überschreiben eingelegt haben. 
+    Wenn Sie eine fabrikneue Diskette aus der Verpackung nehmen,
+müssen Sie diese vor der Initialisierung #on("i")#formatieren#off("i")#. Dabei wird die
+Diskette auf ein bestimmtes physikalisches Format eingestellt. Ohne
+diese Operation ist weder Schreiben noch Lesen überhaupt möglich. 
+    In der Regel muß eine Diskette nur einmal formatiert werden.
+Sie können sie jedoch jederzeit wieder formatieren (wenn Sie zum
+Beispiel nicht wissen, was Ihnen da für eine alte Diskette in die
+Finger geraten ist). 
+    Am Anfang des Initialisierens werden Sie gefragt, ob Sie die
+Diskette formatieren wollen. Manche Rechner unterstützen diese
+Operation innerhalb des EUMEL-Systems nicht. In diesem Fall (und
+natürlich auch sonst normalerweise) müssen Sie die Frage vernei­
+nen. Das Formatieren muß dann vorher irgendwie außerhalb des
+Systems geschehen sein. 
+    Das Initialisieren funktioniert natürlich nur bei Archivmana­
+gern. Bei einer anderen Zieltask ist diese Funktion gesperrt. 
+ 
+#a ("Paßwort")# Dateien in einem allgemeinen Dateimanager (nicht jedoch
+auf dem Archiv) können Sie mit einem Paßwort gegen unbefugten
+Zugriff sichern. Sinnvolle Voraussetzung dafür ist, daß der Datei­
+manager selbst mit einem anderen Paßwort gegen Betreten gesichert
+ist. 
+    Das von Ihnen verwendete Paßwort geben Sie mit der Funktion
+'Paßwort' ein. Damit Ihnen niemand über die Schulter schauen
+kann, werden alle Zeichen auf dem Bildschirm als Punkte darge­
+stellt. Anschließend müssen Sie das Paßwort noch einmal eingeben,
+damit sich kein unbemerkter Schreibfehler eingeschlichen hat. 
+    Das Paßwort wird dann bei allen Transport- und Löschopera­
+tionen abgefragt. Eine Datei im Manager erhält Ihr Paßwort zuge­
+wiesen, wenn Sie sie das erste Mal im Manager ablegen. Bei allen
+folgenden Zugriffen muß das gleiche Paßwort eingestellt sein, sonst
+wird der Zugriff verweigert. 
+    Natürlich können Sie für verschiedene Dateien verschiedene
+Paßwörter einstellen. Trotz Einstellung eines Paßworts können auch
+andere Benutzer ihre Dateien im gleichen Manager ablegen. 
+    Sie können auch für Schreiben (und Löschen) sowie Lesen
+unterschiedliche Paßwörter einstellen. Dazu benutzen Sie einfach
+einen Trennstrich in der Form 
+#f2# 
+#beispiel# 
+        Schreibpaßwort/Lesepaßwort 
+#text# 
+#f2# 
+Soll eine Datei überhaupt nicht überschrieben oder gelöscht werden
+können, können Sie '-' als Schreibpaßwort verwenden: 
+#f2# 
+#beispiel# 
+        -/Lesepaßwort 
+#text# 
+#f2# 
+Die Datei kann dann nur beim direkten Betreten der Managertask
+verändert werden. 
+    Wollen Sie die Paßworteinstellung wieder aufheben, drücken Sie
+bei der Paßworteingabe nur RETURN, da der leere Text als "kein
+Paßwort" interpretiert wird. 
+ 
+#a ("Reservieren")# Wollen Sie eine Task als Zieltask verwenden, die zwar
+kein Archivmanager ist, aber reserviert werden muß (zum Beispiel
+'DOS' zum Ansprechen fremder Diskettenformate) müssen Sie die
+Reservierung mit der Funktion 'Reservieren' selbst vornehmen. Die
+Zieltask darf nicht als Archivmanager gekennzeichnet sein (dann ist
+die Funktion 'Reservieren' nämlich gesperrt). 
+    Bei der Reservierung müssen Sie den Reservierungsparameter
+(abhängig von der Art der Zieltask - bei 'DOS' beispielsweise den
+Modus) als Text eingeben. Nach der Reservierung können Sie die
+anderen Funktionen des Archivmenüs verwenden. 
+    Die Freigabe der Zieltask erfolgt automatisch beim Verlassen
+des Menüs oder beim Einstellen einer neuen Zieltask. 
+
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.2 b/app/eudas/4.4/doc/user-manual/eudas.hdb.2
new file mode 100644
index 0000000..a72ba81
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.2
@@ -0,0 +1,164 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (11)# 
+#kapitel ("2", "Installation", "des", "Programms")# 
+ 
+ 
+ 
+Bevor Sie EUDAS auf Ihrem System benutzen können, müssen Sie das
+Programm zuvor installieren. Wenn EUDAS schon auf Ihrem System
+zur Verfügung steht, können Sie dieses Kapitel getrost überlesen. 
+ 
+ 
+#abschnitt ("2.1", "LIEFERUMFANG", "Lieferumfang")# 
+ 
+EUDAS wird auf einer Diskette geliefert, die alle notwendigen Pro­
+gramme enthält. Um den Inhalt der Diskette feststellen zu können,
+starten Sie Ihr System und bringen es dazu, daß 'gib kommando:'
+erscheint. Dann legen Sie die Diskette ein und geben das Kommando 
+ 
+#beispiel# 
+    archive ("EUDAS"); list (archive); release (archive) 
+#text# 
+ 
+Anschließend erscheint eine Übersicht der auf dem Archiv vorhan­
+denen Programmteile. Folgende Namen sollten sich in dieser Über­
+sicht wiederfinden: 
+ 
+#beispiel# 
+    "eudas.1" 
+    "eudas.2" 
+    "eudas.3" 
+    "eudas.4" 
+    "eudas.init" 
+    "eudas.generator" 
+    "Adressen" 
+#text# 
+ 
+Eventuell können noch weitere Namen in der Übersicht auftauchen.
+Sollte einer der angegebenen Namen nicht vorhanden sein, rekla­
+mieren Sie die Diskette. Falls Sie statt der Übersicht eine Fehler­
+meldung erhalten, sollten Sie überprüfen, ob die Diskette das rich­
+tige Format besitzt oder Ihr Diskettenlaufwerk Probleme bereitet. 
+    Wenn Sie so den Inhalt der Diskette kontrolliert haben, können
+Sie EUDAS installieren. Je nachdem, ob Sie ein Single-User oder ein
+Multi-User System benutzen, sind die Anweisungen unterschiedlich.
+Sie brauchen nur den Sie betreffenden der beiden folgenden Ab­
+schnitte zu lesen. Falls Sie nicht wissen, welches System Sie benut­
+zen: ein Multi-User System wird auf der Systemdiskette und am
+Bildschirm durch die Kennzeichnung 'EUMEL x.y.z/M' identifiziert,
+bei einem Single-User System steht als letztes Zeichen ein 'S'. 
+ 
+ 
+#abschnitt ("2.2", "SINGLE-USER", "Single-User")# 
+ 
+Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem
+Single-User System installieren wollen. 
+    Sie können EUDAS immer nur auf einer bestimmten Hinter­
+grunddiskette installieren. Auf dieser Diskette sollten noch min­
+destens 250 KB frei sein (stellen Sie dies durch das Kommando
+'storage info' sicher). EUDAS kann anschließend auch nur auf dieser
+Diskette verwendet werden. 
+    Starten Sie nun die gewünschte Diskette. Dann legen Sie die
+Diskette, auf der EUDAS sich befindet, in das Archivlaufwerk. Geben
+Sie dann das Kommando 
+ 
+#beispiel# 
+    archive ("EUDAS"); fetch ("eudas.generator", archive); run 
+#text# 
+ 
+Sie haben damit das Generatorprogramm gestartet, das die Installa­
+tion automatisch durchführt. Lassen Sie während dieses Vorganges
+das EUDAS-Archiv eingelegt. Sie werden benachrichtigt, wenn die
+Generierung abgeschlossen ist. 
+    Wenn Sie EUDAS auf allen Ihren Hintergrunddisketten haben
+möchten, können Sie das so erzeugte System als Muttersystem
+sichern. Mit dem Kommando 'save system' können Sie den Hinter­
+grund komprimiert auf eine leere Archivdiskette schreiben. Mit
+dieser Sicherung können Sie dann jederzeit neue Systemdisketten
+wie von Ihrem Originalsystem herstellen. 
+ 
+#a("Einschränkungen")# Aus Platzgründen hat die Single-User-Version
+von EUDAS folgende Einschränkungen: 
+#free (0.2)# 
+#bsp("*")#  Sie können die Funktionen Ketten und Koppeln nicht verwenden. 
+#free (0.2)# 
+#bsp("*")#  Sie können im Druckmuster keine ELAN-Anweisungen und -Aus­
+   drücke verwenden. 
+#free (0.2)# 
+#bsp("*")#  Es stehen nur einige allgemeine Hilfstexte zur Verfügung. 
+#free (0.2)# 
+#bsp("*")#  Funktionen, die mehrere Tasks vorausssetzen, sind ebenfalls
+   gesperrt. 
+#free (0.2)# 
+Die betreffenden Funktionen sind zwar gegebenenfalls im Menü
+enthalten, lassen sich aber nicht aufrufen. 
+ 
+ 
+#abschnitt ("2.3", "MULTI-USER", "Multi-User")# 
+ 
+Dieser Abschnitt betrifft Sie nur, wenn Sie EUDAS auf einem Mul­
+ti-User System installieren wollen. 
+    EUDAS muß in einer bestimmten Task installiert werden. Alle
+neuen Söhne und Enkel dieser Task können dann EUDAS aufrufen.
+Im Normalfall wird diese Task 'PUBLIC' sein. 
+    Zum Installieren müssen Sie in diese Task gehen (in diesem
+Beispiel 'PUBLIC'). Dazu rufen Sie durch Tippen der SV-Taste den
+Supervisor und geben das Kommando 
+ 
+#beispiel# 
+    continue ("PUBLIC") 
+#text# 
+ 
+Stelle Sie mit Hilfe des 'storage info'-Kommandos fest, ob auf Ihrem
+Hintergrund noch mindestens 300 KB frei sind (dieser Platz wird zur
+Generierung benötigt). Dann legen Sie die EUDAS-Archivdiskette ein
+und geben folgendes Kommando 
+ 
+#beispiel# 
+    archive ("EUDAS"); fetch ("eudas.generator", archive); run 
+#text# 
+ 
+Falls die Task 'PUBLIC' Söhne besitzt, werden Sie gefragt, ob Sie
+diese löschen wollen. EUDAS steht nämlich nur in den Söhnen zur
+Verfügung, die #on("i")#nach#off("i")# der Installation eingerichtet wurden. Antworten
+Sie auf die Frage durch einfaches Tippen von 'j' oder 'n'. wenn Sie
+die Frage verneinen, können Sie die Generierung zu diesem Zeit­
+punkt auch noch abbrechen und zunächst die Söhne aufräumen. 
+    Es erscheint die Frage 
+#f2# 
+#beispiel# 
+        Ausführliche Hilfstexte installieren ? (j/n) 
+#text# 
+#f2# 
+Verneinen Sie die Frage, wenn in Ihrem System der Speicherplatz
+kritisch ist (zum Beispiel wenn Sie keine Festplatte haben). Es
+werden dann nur die wichtigsten allgemeinen Hilfstexte installiert
+(Ersparnis etwa 40 KByte). 
+    Anschließend wird die automatische Generierung gestartet.
+Lassen Sie die EUDAS-Archivdiskette eingelegt. Die Generierung ist
+beendet, wenn das EUMEL-Bild erscheint. Die Task, in der die
+Generierung stattfindet, wird automatisch zu einer Managertask, das
+heißt, daß man von ihr Söhne einrichten kann. 
+    Sie können das so erweiterte System auch mit 'save system' auf
+einer oder mehreren Archivdiskette sichern. Lesen Sie dazu die
+Hinweise zur Systemsicherung im EUMEL-Systemhandbuch. 
+ 
+#a ("Korrekturversionen")# Falls Sie später einmal eine Korrekturversion
+von EUDAS bekommen, sollten Sie vor der neuen Generierung die
+Task, in der EUDAS vorher generiert war, löschen (Vorsicht: alle
+Söhne werden mitgelöscht) und wieder neu einrichten. Anderenfalls
+bleibt die alte Version als unzugängliche "Leiche" auf Ihrem System
+liegen. 
+    In diesem Fall und auch, wenn Sie mehrere Programme in der
+gleichen Task installieren, kann es zum Überlauf der internen Über­
+setzertabellen kommen. Für größere Installationen oder wenn Sie
+viele verschiedene Programme benutzen, empfiehlt es sich, zur
+Generierung eine eigene Task 'EUDAS' als Sohn von 'PUBLIC' zu
+verwenden. Sie dürfen dann aber in 'PUBLIC' nicht zu viel insertie­
+ren, da 'EUDAS' ja alle Programme von 'PUBLIC' erbt. Denken Sie
+daran, daß Sie EUDAS nur in Tasks benutzen können, die unter der
+Task 'EUDAS' eingerichtet wurden. 
+ 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.3 b/app/eudas/4.4/doc/user-manual/eudas.hdb.3
new file mode 100644
index 0000000..51da351
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.3
@@ -0,0 +1,504 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (15)# 
+#kapitel ("3", "Ein Beispiel", "zum", "Ausprobieren")# 
+ 
+ 
+ 
+Bevor Sie in die tieferen Geheimnisse von EUDAS einsteigen, sollen
+Sie in diesem Kapitel erst einige Erfahrungen mit der Bedienung
+sammeln. Dadurch erhalten Sie Sicherheit im Umgang mit dem Pro­
+gramm und haben bereits einen Eindruck dessen, was Sie anschlie­
+ßend erwartet. 
+    Das Durchlesen dieses Kapitels ist nur dann sinnvoll, wenn Sie
+die Anweisungen selbst am Rechner ausprobieren. Anderenfalls
+beginnen Sie besser mit dem nächsten Kapitel. 
+    Im folgenden sind die Eingaben, die Sie machen sollen, kursiv
+gedruckt, während Ausgaben des Rechners normal erscheinen.
+Außerdem erscheinen spezielle Tasten in spitzen Klammern: 
+#f2# 
+#beispiel# 
+            <RET> 
+#text# 
+#f2# 
+Bitte tippen Sie nicht die eckigen Klammern oder Großbuchstaben,
+sondern die entsprechende Taste. Oft haben die Sondertasten auch
+etwas andere Bezeichnungen (die obige zum Beispiel 'CR', 'Carriage
+Return', 'RETURN', 'ENTER'). Bitte fragen Sie bei Unklarheiten Ihren
+Systemlieferanten oder -betreuer. 
+ 
+ 
+#abschnitt ("3.1", "START", "Start")# 
+ 
+Die Anweisungen zum Starten von EUDAS sind unterschiedlich, je
+nachdem wie Ihr System eingerichtet ist. Bitte beachten Sie daher
+die verschiedenen Fälle. 
+ 
+1. Falls Sie EUDAS nicht selbst installiert haben, fragen Sie am
+   besten Ihren Systembetreuer. Ansonsten verhalten Sie sich wie
+   unter 2. 
+ 
+2. Falls Sie EUDAS nach den Anweisungen von Kapitel 2 in einem
+   Multi-User-System eingerichtet haben, müssen Sie zunächst eine
+   Arbeitstask (Arbeitsbereich) einrichten. Dazu tippen Sie die
+   SV-Taste (diese trägt häufig die unterschiedlichsten Bezeich­
+   nungen). Es erscheint 
+ 
+#beispiel# 
+                      EUMEL x.y.z/M 
+ 
+           gib supervisor kommando : 
+#text# 
+ 
+   Sie tippen nun folgendes Kommando: 
+ 
+#beispiel# 
+           #on("i")#begin ("arbeit")#off("i")#<RET> 
+#text# 
+ 
+   Vergessen Sie nicht die RETURN-Taste am Schluß. Machen Sie
+   jetzt weiter bei Punkt 4. 
+ 
+3. Falls Sie ein Single-User-System besitzen, starten Sie die
+   Systemdiskette und geben das Datum ein. Dann machen Sie wei­
+   ter mit Punkt 4. 
+ 
+4. Danach erscheint: 
+ 
+#beispiel# 
+           gib kommando : 
+#text# 
+ 
+   und Sie tippen: 
+ 
+#beispiel# 
+           #on("i")#eudas#off("i")#<RET> 
+#text# 
+ 
+   Als Ergebnis wird das EUDAS-Eingangsmenü angezeigt (s. Abb.
+   3-1 auf der nächsten Seite). 
+ 
+ 
+#abschnitt ("3.2", "DATEN EINTRAGEN", "Daten eintragen")# 
+ 
+Als Beispiel sollen Sie eine kleine Adressenkartei einrichten. Der
+Fachausdruck für eine elektronische Kartei ist #on("i")#Datei#off("i")#. 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      EUDAS-Datei   : 
+      O Öffnen      : 
+      - Ketten      : 
+      - Koppeln     :              EEEEE U   U DDDD    A    SSSS 
+      --------------:              E     U   U D   D  A A  S 
+      Arbeitskopie  :              EEE   U   U D   D AAAAA  SSS 
+      - Sichern     :              E     U   U D   D A   A     S 
+      --------------:              EEEEE  UUU  DDDD  A   A SSSS 
+      Aktuelle Datei: 
+      - Notizen     :              Version 4.3 
+      - Feldstrukt. :              Stand: 14.07.87 
+      - Prüfbeding. : 
+      --------------:              (C) Copyright 
+      Mehrbenutzer  :              Thomas Berlage 
+      M Manager     :              Software-Systeme 
+      --------------: 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+      Akt.Datei:                    Manager:                        Datum: 22.07.87 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 3-1   EUDAS-Eingangsmenü 
+#text# 
+ 
+    Zunächst müssen Sie eine neue Datei einrichten. Dazu tippen
+Sie die Leertaste. Dadurch wird die invers dargestellte Funktion
+'Öffnen' ausgeführt. Folgen Sie bitte dem nachstehenden Dialog auf
+der rechten Bildschirmseite: 
+ 
+#beispiel# 
+        Name der Datei: #on ("i")#Mitglieder#off("i")#<RET> 
+        "Mitglieder" neu einrichten ? (j/n) #on("i")#j#off("i")# 
+#text# 
+ 
+Unter der Überschrift 'Neue Feldnamen' tippen Sie jetzt folgendes
+(bitte keine Leerstellen vor den Namen tippen): 
+ 
+#beispiel# 
+        #on("i")#Name#off("i")#<RET> 
+        #on("i")#Vorname#off("i")#<RET> 
+        #on("i")#PLZ#off("i")#<RET> 
+        #on("i")#Ort#off("i")#<RET> 
+        #on("i")#Strasse#off("i")#<RET> 
+        #on("i")#m/w#off("i")#<ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+Zum Schluß beantworten Sie noch eine Frage: 
+ 
+#beispiel# 
+        Feldnamen oder Feldtypen aendern ? (j/n) #on("i")#n#off("i")# 
+#text# 
+ 
+Damit ist die neue Datei eingerichtet. 
+    Nun tippen Sie die Pfeiltaste #bsp("<RECHTS>")#. Es erscheint ein neues
+Menübild (s. Abb. 3-2). 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: Satz 1        .........ENDE... Mitglieder .......... Feld 1 
+      Positionieren : Name 
+      W Weiter      : Vorname 
+      Z Zurück      : PLZ 
+      N Satz.Nr     : Ort 
+      --------------: Strasse 
+      Suchbedingung : m/w 
+      S Setzen      : ........................................................... 
+      L Löschen     : 
+      M Markierung  : 
+      --------------: 
+      Datensatz     : 
+      E Einfügen    : 
+      A Ändern      : 
+      T Tragen      : 
+      H Holen       : 
+      --------------: 
+      F Feldauswahl : 
+      --------------: 
+                    : 
+                    : 
+                    : 
+ 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 3-2   Menü 'Einzelsatz' 
+#text# 
+ 
+Nun tippen Sie so lange die Pfeiltaste #bsp("<UNTEN>")#, bis die Funktion
+'Einfügen' invers markiert ist. Dann tippen Sie die Leertaste zum Aus­
+führen dieser Funktion. Die Schreibmarke springt nach rechts ins
+Datenfeld zum Eingeben. Geben Sie jetzt den ersten Datensatz wie
+folgt ein: 
+ 
+#beispiel# 
+        #on("i")#Wegner#off("i")#<RET> 
+        #on("i")#Herbert#off("i")#<RET> 
+        #on("i")#5000#off("i")#<RET> 
+        #on("i")#Köln#off("i")#<RET> 
+        #on("i")#Krämergasse 12#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#w#off("i")# 
+#text# 
+ 
+Anschließend wird das Datenfeld wieder freigemacht, so daß Sie
+gleich den zweiten Datensatz eingeben können. Dies tun Sie auf die
+gleiche Weise, nur mit anderen Daten: 
+ 
+#beispiel# 
+        #on("i")#Sandmann#off("i")#<RET> 
+        #on("i")#Helga#off("i")#<RET> 
+        #on("i")#5300#off("i")#<RET> 
+        #on("i")#Bonn 1#off("i")#<RET> 
+        #on("i")#Willicher Weg 109#off("i")#<RET> 
+        #on("i")#w#off("i")#<ESC>#on("i")#w#off("i")# 
+#text# 
+ 
+Ebenso verfahren Sie dann weiter mit den folgenden Daten. Falls Sie
+sich vertippt haben, können Sie mit den vier Pfeiltasten an die
+entsprechende Stelle gehen und die falschen Buchstaben über­
+schreiben. 
+ 
+#beispiel# 
+        #on("i")#Katani#off("i")#<RET> 
+        #on("i")#Albert#off("i")#<RET> 
+        #on("i")#5210#off("i")#<RET> 
+        #on("i")#Troisdorf#off("i")#<RET> 
+        #on("i")#Lindenstr. 3#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Ulmen#off("i")#<RET> 
+        #on("i")#Peter#off("i")#<RET> 
+        #on("i")#5#off("i")#<RET> 
+        #on("i")#Köln 60#off("i")#<RET> 
+        #on("i")#Mozartstraße 17#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Regmann#off("i")#<RET> 
+        #on("i")#Karin#off("i")#<RET> 
+        #on("i")#5000#off("i")#<RET> 
+        #on("i")#Köln 90#off("i")#<RET> 
+        #on("i")#Grengelweg 44#off("i")#<RET> 
+        #on("i")#w#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Arken#off("i")#<RET> 
+        #on("i")#Hubert#off("i")#<RET> 
+        #on("i")#5200#off("i")#<RET> 
+        #on("i")#Siegburg#off("i")#<RET> 
+        #on("i")#Talweg 12#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Simmern#off("i")#<RET> 
+        #on("i")#Anna-Maria#off("i")#<RET> 
+        #on("i")#5#off("i")#<RET> 
+        #on("i")#Köln 3#off("i")#<RET> 
+        #on("i")#Platanenweg 67#off("i")#<RET> 
+        #on("i")#w#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Kaufmann-Drescher#off("i")#<RET> 
+        #on("i")#Angelika#off("i")#<RET> 
+        #on("i")#53#off("i")#<RET> 
+        #on("i")#Bonn#off("i")#<RET> 
+        #on("i")#Hauptstr. 123#off("i")#<RET> 
+        #on("i")#w#off("i")#<ESC>#on("i")#w#off("i")# 
+ 
+        #on("i")#Fuhrmann#off("i")#<RET> 
+        #on("i")#Harald#off("i")#<RET> 
+        #on("i")#5000#off("i")#<RET> 
+        #on("i")#Köln 1#off("i")#<RET> 
+        #on("i")#Glockengasse 44#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#w#off("i")# 
+#text# 
+ 
+Bei der letzten Adresse ist die letzte Taste unterschiedlich, da Sie
+keine weiteren Daten mehr eintragen wollen. Bitte beachten Sie dies. 
+ 
+#beispiel# 
+        #on("i")#Seefeld#off("i")#<RET> 
+        #on("i")#Friedrich#off("i")#<RET> 
+        #on("i")#5000#off("i")#<RET> 
+        #on("i")#Köln-Ehrenfeld#off("i")#<RET> 
+        #on("i")#Kabelgasse#off("i")#<RET> 
+        #on("i")#m#off("i")#<ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+Damit die neu eingetragenen Daten permanent gespeichert sind,
+müssen Sie sie #on("i")#sichern#off("i")#. Dazu kehren Sie durch Tippen von #bsp("<LINKS>")#
+in das erste Menü zurück. Dort tippen Sie wieder so lange #bsp("<UNTEN>")#,
+bis die Funktion 'Sichern' markiert ist. Tippen Sie dann die Leer­
+taste zum Ausführen und folgen dem nachstehenden Dialog: 
+ 
+#beispiel# 
+        Arbeitskopie "Mitglieder" veraendert! Sichern ? (j/n) #on("i")#j#off("i")# 
+        Alte Version ueberschreiben ? (j/n) #on("i")#j#off("i")# 
+        Interne Arbeitskopien loeschen ? (j/n) #on("i")#j#off("i")# 
+#text# 
+ 
+Damit steht Ihnen nun eine Mitgliederdatei mit 10 Einträgen zur
+weiteren Verfügung. 
+ 
+ 
+#abschnitt ("3.3", "DATEN ABFRAGEN", "Daten abfragen")# 
+ 
+Um Daten abzufragen, müssen Sie die Datei zunächst wieder öffnen.
+Dazu bewegen Sie die inverse Markierung durch mehrmaliges Tippen
+von #bsp("<OBEN>")# nach oben bis zur Funktion 'Öffnen' und tippen Sie die
+Leertaste. Danach ergibt sich folgender Dialog: 
+ 
+#beispiel# 
+        Name der Datei: #on("i")#Mitglieder#off("i")#<RET> 
+        Wollen Sie etwas aendern (eine Arbeitskopie einrichten) 
+                                                 ? (j/n) #on("i")#n#off("i")# 
+#text# 
+ 
+Danach gehen Sie durch Tippen von #bsp ("<RECHTS>")# in das zweite Menü.
+Dort erscheint jetzt die zehnte Adresse. 
+    Zunächst sollen Sie an den Anfang gehen. Dazu schieben Sie
+die Markierung auf die Funktion 'Satz.Nr' mit Hilfe der Pfeiltasten
+und tippen dann die Leertaste. Nach folgender Angabe 
+ 
+#beispiel# 
+        Neue Satznummer: #on("i")#1#off("i")#<RET> 
+#text# 
+ 
+erscheint die erste Adresse. Nun sollen Sie nach der Adresse von
+Harald Fuhrmann suchen. Dazu bringen Sie die Markierung auf die
+Funktion 'Suchbedingung Setzen' und tippen die Leertaste. Die
+Schreibmarke springt wieder in das Datenfeld. Dort geben Sie ein: 
+ 
+#beispiel# 
+        #on("i")#Fuhrmann#off("i")#<ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+In der markierten Überschrift erscheint 'SUCH-' zum Zeichen, daß
+eine Suchbedingung eingestellt ist. Dann schieben Sie die Markie­
+rung auf die Funktion 'Weiter' und tippen die Leertaste. Kurz da­
+nach erscheint die Adresse von Herrn Fuhrmann mit dem Hinweis
+'SUCH+' (gefunden). 
+    Führen Sie dann die Funktion 'Zurück' aus (Verschieben der
+Markierung und Tippen der Leertaste). Es erscheint wieder die erste
+Adresse mit dem Hinweis 'SUCH-' (kein weiterer Fuhrmann gefun­
+den). Führen Sie dann die Funktion `Suchbedingung Löschen' aus.
+Der 'SUCH'-Hinweis verschwindet wieder. 
+    Als nächstes sollen Sie die Daten nach allen weiblichen Mit­
+gliedern durchsuchen. Dazu führen Sie wieder die Funktion 'Such­
+bedingung Setzen' aus. Diesmal tippen Sie im Datenfeld fünfmal die
+Pfeiltaste #bsp ("<UNTEN>")#, bis die Schreibmarke neben der Bezeichnung
+'m/w' steht. Dort tippen Sie 
+ 
+#beispiel# 
+        #on("i")#w#off("i")#<ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+Wenn Sie jetzt die Funktion 'Weiter' ausführen, erscheint das erste
+weibliche Mitglied, Frau Sandmann. Da aber noch weitere Frauen in
+der Datei vorkommen, führen Sie erneut 'Weiter' aus und es erschei­
+nen die nächsten weiblichen Mitglieder. 
+    Wenn kein gesuchtes Mitglied mehr gefunden wurde, erscheint
+ein leeres Datenfeld mit den Bezeichnungen 'ENDE' und 'SUCH-' in
+der Überschrift. Durch mehrmaliges Ausführen von 'Zurück' können
+Sie die weiblichen Mitglieder wieder in der umgekehrten Reihenfolge
+ansehen, bis Sie an den Anfang der Datei kommen. 
+    Bitte lassen Sie die Suchbedingung eingestellt, denn im näch­
+sten Abschnitt wollen wir alle weiblichen Mitglieder ausdrucken. 
+ 
+ 
+#abschnitt ("3.4", "DRUCKEN", "Drucken")# 
+ 
+Zuerst begeben Sie sich durch zweimaliges Tippen von #bsp ("<RECHTS>")# in
+das Druckmenü, das in Abb. 3-3 gezeigt wird. 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      Satzauswahl   : 
+      D Drucken     : 
+      --------------: 
+      Druckausgabe  : 
+      R Richtung    : 
+      --------------: 
+      Textdatei     : 
+      E Editieren   : 
+      A Ausdrucken  : 
+      N Nachbearb.  : 
+      --------------: 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+      Akt.Datei: "Mitglieder"                                       Datum: 22.07.87 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 3-3   Menü 'Drucken' 
+#text# 
+ 
+Zunächst müssen Sie ein Druckmuster erstellen, das angibt, wie der
+Druck aussehen soll. Dazu führen Sie die Funktion 'Textdatei Edi­
+tieren' aus. Es erscheint die Aufforderung: 
+ 
+#beispiel# 
+        Name der Datei: #on("i")#liste#off("i")#<RET> 
+#text# 
+ 
+Dann wird der Bildschirm gelöscht und Sie können folgendes einge­
+ben: 
+ 
+#beispiel# 
+        #on("i")#% VORSPANN#off ("i")#<RET> 
+        #on("i")#Liste der weiblichen Mitglieder#off ("i")#<RET> 
+        #on("i")#-------------------------------#off ("i")#<RET> 
+        #on("i")#% WIEDERHOLUNG#off ("i")#<RET> 
+        #on("i")#&Vorname %Name#off ("i")#<ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+Ebenso wie beim Eingeben von Daten können Sie hier mit den Pfeil­
+tasten auf fehlerhafte Stellen zurückgehen und dort korrigieren. 
+    Nun sollten Sie sich vergewissern, ob Ihr Drucker eingeschaltet
+und bereit (Ready) ist. Falls Sie keinen Drucker haben, folgen Sie
+bitte den Anweisungen unter 2. Anderenfalls gehen Sie wie folgt
+vor. 
+ 
+1. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie
+   folgende Frage: 
+ 
+#beispiel# 
+        Ausgabe automatisch zum Drucker ? (j/n) #on("i")#j#off("i")# 
+#text# 
+ 
+   Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen
+   des Druckmusters an: 
+ 
+#beispiel# 
+        Name des Druckmusters: #on("i")#liste#off ("i")#<RET> 
+#text# 
+ 
+   Als Ergebnis sollte folgende Liste auf Ihrem Drucker erscheinen: 
+ 
+#beispiel# 
+        Liste der weiblichen Mitglieder 
+        ------------------------------- 
+        Helga Sandmann 
+        Karin Regmann 
+        Anna-Maria Simmern 
+        Angelika Kaufmann-Drescher 
+#text# 
+ 
+2. Rufen Sie die Funktion 'Richtung' auf und beantworten Sie
+   folgende Fragen: 
+ 
+#beispiel# 
+        Ausgabe automatisch zum Drucker ? (j/n) #on("i")#n#off("i")# 
+        Ausgabe in bestimmte Datei ? (j/n) #on("i")#n#off("i")# 
+#text# 
+ 
+   Dann rufen Sie die Funktion 'Drucken' auf und geben den Namen
+   des Druckmusters an: 
+ 
+#beispiel# 
+        Name des Druckmusters: #on("i")#liste#off ("i")#<RET> 
+#text# 
+ 
+   Nach dem Ende des Druckprozesses (wenn das Sternchen vor
+   'Drucken' wieder durch ein 'D' ersetzt worden ist), rufen Sie
+   wieder die Funktion 'Textdatei Editieren' auf und geben folgen­
+   den Namen an: 
+ 
+#beispiel# 
+        Name der Datei: #on("i")#liste.a$1#off("i")#<RET> 
+#text# 
+ 
+   Es erscheint die gleiche Ausgabe wie unter 1 beschrieben auf
+   dem Bildschirm. Wenn Sie die Ausgabe genug gesehen haben,
+   kehren Sie durch 
+ 
+#beispiel# 
+        <ESC>#on("i")#q#off("i")# 
+#text# 
+ 
+   wieder in das Menü zurück. 
+ 
+ 
+#abschnitt ("3.5", "ERGEBNIS", "Ergebnis")# 
+ 
+Da Sie sich wieder im Menü befinden, könne Sie EUDAS durch 
+#f2# 
+        <ESC>#on("i")#q#off("i")# 
+#f2# 
+wieder verlassen. Danach können Sie Ihre Sitzung beenden, etwas
+Anderes tun oder EUDAS erneut aufrufen. 
+ 
+    Sie haben nun selbst ausprobiert, wie Sie unter EUDAS Daten
+eingeben können, wie Sie diese Daten abrufen und in ihnen suchen
+können. Sie haben die Daten auch schon ausgedruckt. 
+    Damit Sie besser verstehen, was Sie soeben gemacht haben,
+werden Sie in den folgenden vier Kapiteln die Grundfunktionen von
+EUDAS mit den dazugehörigen Erläuterungen kennenlernen. 
+    Danach können Sie dann selber Ihre eigene Anwendung entwer­
+fen und EUDAS zu Ihrer Arbeitserleichterung einsetzen. 
+
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.4 b/app/eudas/4.4/doc/user-manual/eudas.hdb.4
new file mode 100644
index 0000000..dc86791
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.4
@@ -0,0 +1,676 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (27)# 
+#kapitel ("4", "Umgang mit", "Dateien", "und Menüs")# 
+ 
+ 
+ 
+Zu Anfang dieses Teils sollen Sie zunächst die Terminologie von
+EUDAS kennenlernen. Das Karteikartenmodell des ersten Kapitels
+muß ja auf einem Rechner realisiert werden. Dazu müssen erst eini­
+ge Ausdrücke erklärt werden. 
+ 
+ 
+#abschnitt ("4.1", "EUDAS-DATEIEN", "EUDAS-Dateien")# 
+ 
+Der wichtigste Ausdruck, der Ihnen noch sehr häufig begegnen wird,
+ist #on("i")#Datei#off("i")#. Eine Datei ist eine Sammlung von Informationen in einem
+Computer, die als ein Objekt transportiert und behandelt werden
+können. Dieser Name wurde analog zu "Kartei" gebildet, mit dem
+Unterschied, daß eine "Daten-Kartei" gemeint ist. 
+    Jede Datei hat einen eigenen Namen, durch den sie identifiziert
+wird. Der Name ist oft in Anführungsstriche eingeschlossen - die
+Anführungsstriche gehören jedoch nicht zum Namen, sondern dienen
+nur zur Abgrenzung, welche Zeichen zum Namen gehören. Der Name
+ist also wie die Aufschrift auf einem Aktenordner. Wenn alle Ordner
+im Schrank stehen, können Sie anhand des Namens den richtigen
+Ordner finden, anderenfalls müßten Sie alle Ordner öffnen. 
+ 
+#a ("Dateiarten")# Dateien werden nun für viele verschiedene Arten von
+Informationen benutzt. Sie können einerseits Texte enthalten oder
+auch Karteien, Grafiken, Formeln oder Zahlenkolonnen. Sie haben
+bereits im ersten Kapitel den Unterschied zwischen Datenverwaltung
+und Textverarbeitung kennengelernt. In diesem Zusammenhang sind
+die beiden ersten Verwendungsweisen wichtig. 
+ 
+#limit (12.0)# 
+        #on("i")#Textdateien#off("i")# 
+        sind Dateien, die normale Texte enthalten, die mit
+        dem Editor verändert und einfach ausgedruckt
+        werden können. In ihnen werden also Informationen
+        gespeichert, wie die Textverarbeitung sie benötigt. 
+ 
+        #on("i")#EUDAS-Dateien#off("i")# 
+        sind dagegen Dateien, die Informationen in der
+        Form von Karteikarten enthalten. Sie haben also
+        die Struktur, wie sie von der Datenverwaltung be­
+        nötigt wird. 
+#limit (13.5)# 
+ 
+    Der Computer kann aber auch alle Arten von Dateien gleich­
+behandeln, und zwar dann, wenn der Inhalt der Dateien nicht be­
+trachtet werden muß. 
+    Ein häufiger Fall ist zum Beispiel, wenn Dateien zur Sicherung
+auf eine Diskette geschrieben werden sollen. In diesem Fall genügt
+die Angabe des Namens; dem Rechner ist es egal, welchen Inhalt die
+Datei hat. 
+    Anders ist es aber, wenn Sie den Inhalt betrachten wollen.
+Dazu brauchen Sie dann ein Programm, das die innere Struktur der
+Datei kennt. Textdateien können Sie zum Beispiel mit dem Editor
+ansehen. EUDAS-Dateien müssen Sie jedoch mit EUDAS ansehen, da
+der Editor die EUDAS-Struktur nicht kennt. Es ist in vielen Fällen
+sinnvoll, durch einen Zusatz im Dateinamen zu kennzeichnen, ob es
+sich um eine Textdatei oder eine EUDAS-Datei handelt. 
+ 
+#beispiel# 
+#free (3.7)# 
+ 
+#center#Abb. 4-1   Struktur einer EUDAS-Datei 
+#text# 
+ 
+#a ("Terminologie")# EUDAS verwendet bestimmte Ausdrücke, um die
+Strukturelemente einer EUDAS-Datei zu kennzeichnen. Die Struktur
+einer EUDAS-Datei ist schematisch in Abb. 4-1 dargestellt. Die
+Ausdrücke wurden nun nicht direkt aus dem Karteikartenmodell
+übernommen, da es auch noch andere Modelle gibt und keine fal­
+schen Assoziationen auftreten sollen. 
+    EUDAS verwendet die Bezeichnung #on("i")#Satz#off("i")# für eine Karteikarte.
+Eine EUDAS-Datei besteht also aus einer Anzahl von gleichartigen
+Sätzen. Zur Veranschaulichung kann man sich diese nebeneinander­
+gelegt vorstellen. 
+    Jeder Satz ist unterteilt in sogenannte #on("i")#Felder#off("i")#. Ein Feld ent­
+spricht einem Attribut bzw. einem Eintrag auf der Karteikarte. Ein
+Feld ist wiederum unterteilt in einen #on("i")#Feldnamen#off("i")# und einen #on("i")#Feldin­
+halt#off("i")#. 
+    Der Feldname identifiziert ein bestimmtes Feld innerhalb eines
+Satzes. Die Feldnamen sind natürlich für alle Sätze gleich. Die
+Feldnamen einer EUDAS-Datei sind beliebig und können von Ihnen
+selbst festgelegt werden. 
+    Der Feldinhalt enthält die eigentliche Information des entspre­
+chenden Attributs. Der Feldinhalt darf ebenfalls aus beliebig vielen
+Zeichen bestehen. Die Feldinhalte sind natürlich für jeden Satz
+verschieden und stellen die eigentliche gespeicherte Information
+dar. 
+ 
+#a ("Grenzen")# Aus technischen Gründen gibt es natürlich auch einige
+Beschränkungen, die hier nicht verschwiegen werden sollen. Eine
+Datei kann maximal etwa 5000 Sätze enthalten, ein Satz darf aus
+maximal 255 Feldern bestehen. Insgesamt kann ein Satz etwa 32000
+Zeichen umfassen. Die einzelnen Sätze in der EUDAS-Datei werden
+durch ihre jeweilige Positionsnummer identifiziert, also quasi von 1
+bis 5000 durchnumeriert. 
+ 
+ 
+#abschnitt ("4.2", "EUDAS-MENÜS", "EUDAS-Menüs")# 
+ 
+In den folgenden Abschnitten sollen Sie lernen, wie die Bedienung
+von EUDAS funktioniert. Dazu sollen Sie eine EUDAS-Beispieldatei
+von der EUDAS-Diskette in Ihr System holen. Diese Datei brauchen
+Sie dann später, um die Funktionen von EUDAS zu kennenzulernen. 
+    Die Beispieldatei hat den gleichen Inhalt wie die in Kapitel 3
+von Ihnen erstellte Datei. Falls Ihnen also die EUDAS-Archiv­
+diskette nicht zur Verfügung steht, können Sie in diesem Kapitel
+auch jede andere Archivdiskette verwenden. 
+    Bitte beachten Sie im folgenden, daß Sie einfache Anführungs­
+striche nicht mit eingeben, doppelte Anführungsstriche aber wohl. 
+ 
+#a ("EUDAS-Aufruf")# Zuerst müssen Sie EUDAS aufrufen. Dazu begeben
+Sie sich in die in Kapitel 3 eingerichtete Task ('continue ("arbeit")')
+und geben bei 'gib kommando:' das Kommando 'eudas': 
+ 
+#beispiel# 
+        gib kommando: 
+        #on("i")#eudas#off("i")#<RET> 
+#text# 
+ 
+Falls Ihr System über Menüs gesteuert wird, müssen Sie eine ent­
+sprechende Funktion wählen. Anschließend erscheint folgendes
+Menü: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      EUDAS-Datei   : 
+      O Öffnen      : 
+      - Ketten      : 
+      - Koppeln     : 
+      --------------: 
+      Arbeitskopie  : 
+      - Sichern     : 
+      --------------: 
+      Aktuelle Datei: 
+      - Notizen     : 
+      - Feldstrukt. : 
+      - Prüfbeding. : 
+      --------------: 
+      Mehrbenutzer  : 
+      M Manager     : 
+      --------------: 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+      Akt.Datei:                    Manager:                       Datum: 22.07.87 
+___________________________________________________________________________________________ 
+#text# 
+ 
+#a ("Menüs")# Ein #on("i")#Menü#off("i")# ist eine Auswahl für einige verschiedene Funk­
+tionen. Die Funktionen sind jeweils benannt und werden durch einen
+davorstehenden Buchstaben oder ein Minuszeichen gekennzeichnet.
+Eine der Funktionen ist immer durch inverse Darstellung markiert. 
+    Diese Markierung können Sie nun mit Hilfe der Pfeiltasten OBEN
+und UNTEN verschieben. Auf diese Weise können Sie sich die ge­
+wünschte Funktion auswählen. Die Funktionen werden jedoch durch
+das Markieren nicht ausgeführt. Sie können also beliebig mit den
+Pfeiltasten herumexperimentieren. 
+    Ausgeführt wird die markierte Funktion, wenn Sie die Leertaste
+drücken. Sofort erscheint ein Stern vor dem Funktionsnamen, um
+anzuzeigen, daß die Ausführung beginnt. Probieren Sie dies jetzt
+nicht aus, dazu ist später Gelegenheit. 
+    Funktionen mit einem Minuszeichen davor können Sie zwar
+anwählen (markieren), aber nicht ausführen. Solche Funktionen sind
+momentan gesperrt, weil ihre Ausführung keinen Sinn hat oder sogar
+Fehler erzeugen würde. 
+    Mit den Pfeiltasten LINKS und RECHTS können Sie im Menüzu­
+stand weitere EUDAS-Menüs abrufen. Welche Menüs zur Verfügung
+stehen, zeigt Ihnen die oberste Bildschirmzeile. Das aktuelle Menü
+ist jeweils invers dargestellt. 
+ 
+#a ("Hilfe")# Wenn Sie nun wissen möchten, welche Bedeutung die mar­
+kierte Funktion hat (die Funktionsbezeichnungen sind aus Platz­
+gründen sehr kurz gehalten), können Sie einen #on("i")#Hilfstext#off("i")# zu dieser
+Funktion abrufen. Dies erfolgt durch die Betätigung der Tasten ESC
+und '?' hintereinander. Diese doppelten Tastenkombinationen mit der
+ESC-Taste am Anfang werden Ihnen noch sehr häufig begegnen -
+denken Sie immer daran, die Tasten hintereinander und nicht
+gleichzeitig zu tippen. Der zeitliche Abstand zwischen den Tasten­
+drücken kann beliebig lang sein; hingegen sollten Sie eine Taste
+nicht zu lange drücken, da sonst eventuell eine automatische Wie­
+derholfunktion Ihrer Tastatur startet. 
+    Probieren Sie nun die Tastenkombination ESC '?' aus. Als Reak­
+tion erscheint in der rechten Hälfte des Bildschirms ein Text. Dieser
+sollte Ihnen die gewünschten Informationen bieten. 
+    Gleichzeitig hat sich aber auch die oberste Bildschirmzeile
+verändert. Sie zeigt jetzt folgendes Bild: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      HILFE:  Beenden: ESC q   Seite weiter: ESC w   Seite zurueck: ESC z 
+___________________________________________________________________________________________ 
+#text# 
+ 
+#a ("Zustände")# Wenn Sie sich nicht im Menü befinden, fungiert die ober­
+ste Zeile als sogenannte #on("i")#Statuszeile#off("i")#. Diese Zeile zeigt immer an, in
+welchem #on("i")#Zustand#off("i")# das Programm sich befindet. Der Zustand des Pro­
+gramms hat nämlich Einfluß darauf, welche Tasten Sie drücken
+können und wie das Programm darauf reagiert. Die Statuszeile zeigt
+daher außer dem Zustand auch die wichtigsten Tastenfunktionen. 
+    Sie kennen jetzt also schon zwei Zustände von EUDAS: den
+Menüzustand und den Hilfe-Zustand. 
+ 
+#a ("Hilfe-Zustand")# Vom Menüzustand kommen Sie über die Tastenkom­
+bination ESC '?' in den Hilfe-Zustand. Im Hilfe-Zustand haben die
+Pfeiltasten OBEN und UNTEN keine Wirkung mehr (probieren Sie dies
+aus). 
+    Ein Hilfstext besteht im allgemeinen aus mehreren Seiten. Die
+erste Seite enthält dabei die speziellen Informationen, danach
+folgen dann allgemeine Informationen. Mit den Tastenkombinationen
+ESC 'w' und ESC 'z' können Sie zwischen den Seiten umschalten
+(denken Sie daran, was oben über Tastenkombinationen gesagt
+wurde). Wenn Sie dies ausprobieren, werden Sie auf der zweiten
+Seite allgemeine Hinweise zur Menübedienung finden. Auf der letz­
+ten Seite wird ESC 'w' ignoriert, ebenso ESC 'z' auf der ersten Seite. 
+    Mit der Tastenkombination ESC 'q' (quit) kehren Sie aus dem
+Hilfezustand in den vorherigen Zustand zurück. Diese Tastenkombi­
+nation löst allgemein in EUDAS die Rückkehr in den alten Zustand
+aus. Wenn Sie ESC 'q' getippt haben, erscheint die alte Menüzeile
+und Sie können wieder Funktionen auswählen. 
+    Der Hilfszustand läßt sich von nahezu allen (noch zu bespre­
+chenden) Zuständen mit ESC '?' aufrufen. Es wird jeweils ein zum
+aktuellen Zustand passender Hilfstext ausgegeben. 
+    Die möglichen Zustandsübergange sind nochmal in Abb. 4-2
+zusammengefaßt. 
+ 
+#beispiel# 
+#free (2.5)# 
+ 
+#center#Abb. 4-2   Menü- und Hilfezustand 
+#text# 
+ 
+#a ("EUDAS verlassen")# Im Menüzustand können Sie EUDAS jederzeit
+durch Tippen von ESC 'q' verlassen. Sie landen dann wieder bei 'gib
+kommando:'. 
+ 
+ 
+#abschnitt ("4.3", "ARCHIVMENÜ", "Archivmenü")# 
+ 
+#a ("System/Archiv")# An dieser Stelle müssen Sie sich die Begriffe #on("i")#Archiv#off("i")#
+und #on("i")#System#off("i")# klarmachen. Als Archiv bezeichnet man die Möglichkeit,
+bei Bedarf Disketten in Ihren Rechner einlegen können, um Dateien
+(und Programme) von anderen Rechnern zu übernehmen. Um diese
+Dateien bearbeiten zu können, müssen Sie sie in das System (Ihre
+Festplatte oder Hintergrunddiskette) kopieren. 
+    Die wichtigste Aufgabe des Archivs ist es, Daten vor Beschädi­
+gung zu sichern. Durch Fehlbedienung oder Systemfehler kann es
+nämlich leicht geschehen, daß die Daten in Ihrem System verloren
+gehen oder zerstört werden. Wenn Sie die Daten jedoch auf einer
+Diskette gesichert und die Diskette sicher verwahrt haben, können
+Sie die Daten wiederherstellen. 
+    Es ist sehr wichtig, daß Sie Ihre Dateien auf Archivdisketten
+sichern, denn ein einziger Hardwarefehler kann die Arbeit von
+Jahren vernichten (Sagen Sie nicht: "Mir passiert so etwas nicht" -
+bis jetzt hat es noch jeden erwischt). 
+ 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      Dateien Archiv: 
+      U Übersicht   : 
+      D Üb. Drucken : 
+      --------------: 
+      Datei         : 
+      K Kopieren    : 
+        vom Archiv  : 
+      S Schreiben   : 
+        auf Archiv  : 
+      L Löschen     : 
+        auf Archiv  : 
+      --------------: 
+      Archivdiskette: 
+      I Init        : 
+      --------------: 
+      Z Zielarchiv  : 
+      P Paßwort     : 
+      - Reservieren : 
+      --------------: 
+                    : 
+                    : 
+      Akt.Datei:                    Ziel: "ARCHIVE"                Datum: 22.07.87 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 4-3   Archivmenü 
+#text# 
+ 
+#a ("Archivmenü")# Wenn Sie EUDAS aufrufen, befinden Sie sich immer im
+ersten Menü. Sie benötigen jedoch jetzt Funktionen aus dem sech­
+sten Menü 'Archiv'. Wählen Sie dieses Menü jetzt an. Es erscheint
+das in Abb. 4-3 dargestellte Bild. Die Funktionen in diesem Menü
+befassen sich mit beliebigen Dateien auf dem Archiv. 
+    Für den Versuch legen Sie bitte die EUDAS-Archivdiskette ein.
+Dann wählen Sie die Funktion 'Übersicht' in dem Menü an, wenn sie
+nicht schon markiert ist. Sie können nun die ausgewählte Funktion
+durch Tippen der Leertaste ausführen. 
+    In der obersten Zeile erscheint nun der Hinweis 'Bitte war­
+ten..'. Er zeigt an, daß nun eine Funktion ausgeführt wird, bei der
+Sie zunächst nichts tun können. Sie sollten in diesem Zustand keine
+Tasten drücken, denn EUDAS kann nicht darauf reagieren. 
+ 
+#a ("Archivübersicht")# Nach einer mehr oder minder langen Aktivitäts­
+phase Ihres Diskettenlaufwerks erscheint dann die Archivübersicht.
+Das Erscheinungsbild mit dem markierten Editorbalken in der ober­
+sten Zeile kommt Ihnen vielleicht bekannt vor. Sie haben nämlich
+nichts anderes als das EUMEL-Kommando 'list (archive)' ausgeführt.
+Neu ist lediglich die Statuszeile: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      ZEIGEN:    Blättern: HOP OBEN, HOP UNTEN    Beenden: ESC q    Hilfe: ESC ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Wenn Sie sich die Übersicht angeschaut haben, verlassen Sie den
+Editor wieder mit ESC 'q'. 
+    Beachten Sie, daß Sie unter EUDAS das Archiv nicht extra an­
+melden müssen; dies geschieht automatisch, wenn Sie eine Funktion
+aufrufen. Bei Leseoperationen müssen Sie nicht einmal den Archiv­
+namen wissen. Das Archiv wird automatisch wieder abgemeldet,
+wenn Sie das Archivmenü verlassen. 
+ 
+#a ("Archiv lesen")# Unter den in der Übersicht aufgelisteten Dateien
+sollten Sie auch die Datei finden, die Sie brauchen. Sie heißt
+'Adressen'. An dieser Stelle ein kleiner Hinweis: An vielen Stellen
+werden Sie sehen, daß Dateinamen in Anführungsstriche einge­
+schlossen sind. Die Anführungsstriche gehören jedoch #on("i")#nicht#off("i")# zum
+Namen. Sie dienen nur zur Abgrenzung, da in Dateinamen beliebige
+Zeichen erlaubt sind. Wenn Sie aufgefordert werden, einen Datei­
+namen einzugeben, müssen Sie dies immer ohne Anführungsstriche
+tun. 
+    Hoffentlich haben Sie in der ganzen Diskussion nicht das Ziel
+aus den Augen verloren: Sie sollten eine Datei ins System holen, um
+nachher mit ihr zu experimentieren. Zu diesem Zweck gibt es im
+Archivmenü die Funktion 
+#free (0.2)# 
+#beispiel# 
+        K Kopieren 
+          (vom Archiv) 
+#text# 
+#free (0.2)# 
+Wählen Sie diese Funktion jetzt mit den Pfeiltasten aus und drücken
+Sie zum Ausführen die Leertaste. 
+ 
+#a ("Eingabezustand")# Nach kurzem 'Bitte warten..'-Zustand werden Sie
+im rechten Bildschirmteil nach dem Namen der Datei gefragt. Gleich­
+zeitig erscheint eine neue Statuszeile. Es ergibt sich folgendes Bild: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EINGABE:   Bestätigen: RETURN   Zeigen: ESC z   Abbrechen: ESC h   Hilfe: ESC ? 
+      --------------:Dateiname: 
+      Dateien Archiv: 
+      U Übersicht   : 
+      D Üb. drucken : 
+      --------------: 
+      Datei         : 
+      * Kopieren    : 
+        vom Archiv  : 
+          ... 
+ 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Sie können in diesem Zustand den Namen der gewünschten Datei
+eingeben. Außer den in der Statuszeile genannten Funktionen kön­
+nen Sie die aus dem Editor bekannten Tasten benutzen, um den
+Text in der Zeile gegebenenfalls zu korrigieren (Pfeiltasten LINKS
+und RECHTS, RUBOUT, RUBIN). Die Schreibmarke (Cursor) zeigt Ihnen
+an, wo das nächste Zeichen plaziert wird. 
+ 
+#a ("Abbruch")# Eine Tastenkombination verdient noch besondere Beach­
+tung: Mit ESC 'h' können Sie in vielen Situationen eine Funktion
+noch abbrechen - zum Beispiel wenn Sie irrtümlich die falsche
+Funktion gewählt haben. 
+    Im Gegensatz zu ESC 'q' erfolgt hier die sofortige Rückkehr aus
+der Funktion ins Menü, möglichst ohne daß die Funktion Auswir­
+kungen hinterläßt. Bei einem Abbruch bleibt also in der Regel das
+System unverändert. 
+ 
+#a ("Fehlerzustand")# Um auch die Fehlerbehandlung von EUDAS auszu­
+probieren, sollten Sie hier einen falschen Namen eingeben, zum
+Beispiel: 
+#free (0.2)# 
+#beispiel# 
+            Dateiname: #on("i")#Adresen#off("i")#<RET> 
+#text# 
+#free (0.2)# 
+EUDAS sucht jetzt auf der Diskette nach einer Datei dieses Namens,
+findet sie aber nicht. Als Reaktion erscheint dann die Meldung: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+       !!! FEHLER !!!       Quittieren: ESC q     Hilfe zur Meldung: ESC ? 
+      --------------:Dateiname: Adresen 
+      Dateien Archiv:>>> "Adresen" gibt es nicht 
+      U Übersicht   : 
+      D Üb. drucken : 
+      --------------: 
+          ... 
+ 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Im Normalfall sollten Sie die Fehlermeldung mit ESC 'q' quittieren,
+damit Sie den Befehl erneut versuchen können. Auch hier haben Sie
+die Möglichkeit, eine besondere Information zu dem Fehler abzurufen
+(es liegen jedoch nicht für alle möglichen Fehler spezielle Texte
+vor). 
+    Nach dem Quittieren des Fehlers befinden Sie sich wieder im
+Menüzustand. Wiederholen Sie jetzt die Funktion, indem Sie die
+Leertaste tippen. Sie werden dann erneut nach dem Namen gefragt. 
+ 
+#a ("Auswahlzustand")# Um endlich ans Ziel zu kommen, benutzen Sie
+diesmal eine sehr komfortable Abkürzung, die EUDAS Ihnen bietet.
+Durch Drücken von ESC 'z' können Sie sich nämlich alle möglichen
+Namen anzeigen lassen und den gewünschten einfach ankreuzen. 
+    Anschließend sieht der Bildschirm wie in Abb. 4-4 aus. In die­
+sem Zustand können Sie mit den Pfeiltasten den Cursor zur ge­
+wünschten Datei bewegen und diese ankreuzen. Da Sie auch meh­
+rere Dateien in beliebiger Folge ankreuzen können, erscheint eine
+'1' vor der Datei zur Anzeige der Reihenfolge. Sie wollen aber nur
+diese eine Datei 'Adressen' holen und beenden die Auswahl daher
+mit ESC 'q'. Wenn alles glattgeht, wird jetzt die Datei vom Archiv
+ins System kopiert. 
+ 
+#a ("Archiv schreiben")# Auf nahezu gleiche Weise können Sie mit der
+Funktion 
+#f2# 
+#beispiel# 
+        S Schreiben 
+          auf Archiv 
+#text# 
+#f2# 
+eine Datei wieder auf die Diskette schreiben. Als erstes müssen Sie
+dann den Namen der Archivdiskette eingeben, damit Sie nicht aus
+Versehen auf eine falsche Archivdiskette schreiben. 
+    Auch hier können Sie die gewünschten Dateien ankreuzen (na­
+türlich bietet EUDAS dann die Dateien des Systems an). Sie brau­
+chen keine Angst zu haben, aus Versehen eine Datei mit gleichem
+Namen zu überschreiben - EUDAS fragt in solchen Fällen immer
+nochmal an. 
+ 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      AUSWAHL:  Ankreuzen: 'x'  Durchstreichen: 'o'  Beenden: ESC q  Hilfe: ESC ? 
+      --------------:-------------------------------------------------------------- 
+      Dateien Archiv: Auswahl der Dateien auf dem Archiv. 
+      U Übersicht   : Gewuenschte Datei(en) bitte ankreuzen: 
+      D Üb. Drucken :-------------------------------------------------------------- 
+      --------------:     o  "eudas.1" 
+      Datei         :     o  "eudas.2" 
+      * Kopieren    :     o  "eudas.3" 
+        vom Archiv  :     o  "eudas.4" 
+      S Schreiben   :     o  "eudas.init" 
+        auf Archiv  :     o  "eudas.generator" 
+      L Löschen     :     o  "Adressen" 
+        auf Archiv  :-------------------------------------------------------------- 
+      --------------: 
+      Archivdiskette: 
+      I Init        : 
+      --------------: 
+      Z Zielarchiv  : 
+      P Paßwort     : 
+      - Reservieren : 
+      --------------: 
+                    : 
+                    : 
+      Akt.Datei:                    Ziel: "ARCHIVE"                Datum: 22.07.87 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 4-4   Dateiauswahl 
+#text# 
+ 
+ 
+#abschnitt ("4.4", "DATEIVERWALTUNG", "Dateiverwaltung")# 
+ 
+So: nach dieser anstrengenden Arbeit sollen Sie sich überzeugen,
+daß die Datei 'Adressen' nun wirklich im System zur Verfügung
+steht. Dazu gehen Sie mit LINKS ein Menü zurück. Dieses Menü
+beschäftigt sich mit Dateien im System und ist in Abb. 4-5 gezeigt. 
+    Auch hier finden Sie eine Funktion "Übersicht". Rufen Sie diese
+auf. Ganz analog zum Archiv erscheint eine Übersicht aller Dateien
+im Editor. Verlassen Sie die Übersicht wieder mit ESC 'q'. 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      Dateien System: 
+      U Übersicht   : 
+      --------------: 
+      Datei         : 
+      L Löschen     : 
+      N Umbenennen  : 
+      K Kopieren    : 
+      P Platzbedarf : 
+      A Aufräumen   : 
+      --------------: 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+                    : 
+      Akt.Datei:                    Task: "arbeit"                 Datum: 22.07.87 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 4-5   Menü 'Dateien' 
+#text# 
+ 
+#a ("Datei löschen")# Eine weitere Funktion aus diesem Menü werden Sie
+ebenfalls noch öfter brauchen, nämlich 
+#free (0.2)# 
+#beispiel# 
+        L Löschen 
+#text# 
+#free (0.2)# 
+Mit dieser Funktion können Sie eine Datei wieder aus dem System
+entfernen - zum Beispiel wenn Sie sich die Adressen angesehen
+haben und danach den Speicherplatz nicht weiter verschwenden
+wollen. Als letztes Beispiel sollen Sie auch diese Funktion aufrufen
+(keine Angst, wir löschen die Datei nicht wirklich, es gibt vorher
+noch eine Notbremse). 
+ 
+#a ("Fragezustand")# Als erstes werden Sie wieder nach dem Dateinamen
+gefragt (dies ist Ihnen schon bekannt). Hier haben Sie jetzt die
+Wahl, ob Sie den Namen eingeben oder mit ESC 'z' ankreuzen. Da das
+Löschen unwiederbringlich ist, werden Sie anschließend zur Sicher­
+heit gefragt, ob Sie die Datei wirklich löschen wollen: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      FRAGE:  Bejahen: j,J   Verneinen: n,N   Abbrechen: ESC h    Hilfe: ESC ? 
+      --------------:Dateiname: Adressen 
+      Dateien System:"Adressen" im System loeschen (j/n) ? 
+      U Übersicht   : 
+      --------------: 
+           ... 
+ 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Diese Frage können Sie bejahen oder verneinen (oder die Funktion
+ohne Auswirkungen abbrechen). In diesem Fall sollten Sie die Frage
+verneinen - es sei denn, Ihnen hat das Spielen mit EUDAS so gut
+gefallen, daß Sie die ganze Prozedur wiederholen und die Datei
+nochmal vom Archiv holen wollen. 
+ 
+ 
+#abschnitt ("4.5", "BEDIENUNGSREGELN", "Bedienungsregeln")# 
+ 
+Mit dieser letzten Demonstration haben Sie jetzt schon fast alle
+Arten des Umgangs mit EUDAS kennengelernt. Sicher ist dies beim
+ersten Mal sehr verwirrend. Mit vier Regeln können Sie jedoch
+EUDAS immer bedienen: 
+ 
+#limit (12.0)# 
+    1. Achten Sie darauf, welche möglichen Tastendrücke
+       in der Statuszeile stehen. Richten Sie sich danach! 
+#free (0.2)# 
+    2. Sind Sie sich unsicher, rufen Sie Hilfsfunktion mit
+       ESC '?' auf. Damit erhalten Sie weitere Informatio­
+       nen. 
+#free (0.2)# 
+    3. Funktioniert diese Tastenkombination nicht (geben
+       Sie dem Rechner eine kurze Zeit zum Reagieren),
+       versuchen Sie die Tastenkombinationen ESC 'h' (Ab­
+       bruch) oder ESC 'q' (Verlassen). Falls sich daraufhin
+       etwas verändert, fangen Sie wieder mit 1. an. 
+#free (0.2)# 
+    4. Erfolgt darauf keine Reaktion, drücken Sie die SV-
+       Taste und versuchen Sie das Programm mit 'halt' zu
+       stoppen. Führt auch das nicht zum Erfolg, hat sich
+       Ihr Rechner "aufgehängt". Sie müssen den Rechner
+       dann neu starten. Wenn Sie keine Erfahrung mit
+       einer solchen Situation haben, wenden Sie sich an
+       Ihren Händler oder Systembetreuer. 
+#limit (13.5)# 
+ 
+Im Zusammenhang mit dem letzten Punkt sei nochmal auf die Wich­
+tigkeit einer regelmäßigen Datensicherung auf Archivdisketten
+hingewiesen. Im Normalfall sollten Sie aber mit den Punkten 1 bis 3
+zurechtkommen. 
+ 
+#a ("Zustände")# Im letzten Abschnitt haben Sie eine ganze Reihe von
+Zuständen kennengelernt, die EUDAS einnehmen kann. In jedem
+Zustand haben Sie verschiedene Möglichkeiten zur Reaktion. Glück­
+licherweise erscheinen diese Möglichkeiten zum großen Teil in der
+Statuszeile. 
+    Damit Sie die verwirrenden Erfahrungen des letzten Abschnitts
+etwas ordnen können, wollen wir an dieser Stelle die verschiedenen
+Zustände noch einmal zusammenfassen. Der Beschreibung vorange­
+stellt ist die jeweilige Kennzeichnung am Beginn der Statuszeile. 
+ 
+#bsp ("EUDAS:")# Menüzustand. Sie können Menü und Funktion mit den Pfeil­
+    tasten anwählen und eine Funktion durch Tippen der Leertaste
+    ausführen. ESC '?' gibt Hilfestellung zu jeder Funktion. ESC 'q'
+    beendet EUDAS. 
+ 
+#bsp ("HILFE:")# Sie können mit ESC 'w' und ESC 'z' im Hilfstext blättern. Mit
+    ESC 'q' kommen Sie in den alten Zustand. 
+ 
+#bsp ("AUSWAHL:")# Hier können Sie die gewünschten Namen mit 'x' ankreuzen
+    und mit 'o' wieder entfernen. Normales Beenden mit ESC 'q'.
+    Hilfestellung durch ESC '?'. Abbruch der gesamten Funktion mit
+    ESC 'h'. 
+ 
+#bsp ("EINGABE:")# Hier können Sie eine einzelne Zeile eingeben oder ändern
+    (wie im Editor). Einfügen und Löschen mit RUBIN und RUBOUT.
+    Abbruch und Hilfestellung möglich. 
+ 
+#bsp ("FRAGE:")# Beantworten Sie die gestellte Frage mit 'j' oder 'n'. Abbruch
+    (ESC 'h') und Hilfestellung (ESC '?') möglich. 
+ 
+#bsp ("ZEIGEN:")# Mit HOP OBEN und HOP UNTEN können Sie in der Übersicht
+    blättern. Ende der Übersicht mit ESC 'q'. Hilfestellung möglich. 
+ 
+#bsp ("!!! FEHLER !!!")# Quittieren Sie die Meldung mit ESC 'q'. Hilfestellung
+    möglich. 
+ 
+#bsp ("Bitte warten..")# In diesem Zustand keine Taste drücken, der Rechner
+    ist beschäftigt. 
+ 
+Drei weitere Zustände, die Sie noch nicht kennengelernt haben, sind
+hier schon mal der Vollständigkeit halber aufgeführt: 
+ 
+#bsp ("SATZ ÄNDERN:")# 
+#bsp ("SATZ EINFÜGEN:")# 
+#bsp ("SUCHMUSTER EINGEBEN:")# Satzeditor zum Eingeben von Feldinhalten.
+    Normales Verlassen mit ESC 'q'. Abbruch und Hilfestellung mög­
+    lich. Beschreibung s. 6.2. 
+ 
+#bsp ("EDITIEREN:")# EUMEL-Editor mit Änderungsmöglichkeit für beliebige
+    Texte. Normales Verlassen mit ESC 'q'. Hilfestellung möglich.
+    Beschreibung der Möglichkeiten siehe EUMEL-Benutzerhand­
+    buch. 
+ 
+#bsp ("Gib Kommando:")# Hier können Sie ein beliebiges ELAN-Kommando ein­
+    geben und mit RETURN bestätigen. Abbruch und Hilfestellung
+    möglich. Kann im Menü durch ESC ESC aufgerufen werden. 
+ 
+Wie Sie sehen, werden auch hier wieder die gleichen Tastenkombi­
+nationen verwendet, die Sie schon kennen. 
+    In dieser Übersicht sind jeweils nur die wichtigsten Tastenkom­
+binationen aufgeführt. Informieren Sie sich gegebenenfalls mit ESC
+'?'. Einige weitere Tastenfunktionen werden Sie im folgenden noch
+kennenlernen. Eine vollständige Übersicht finden Sie im Referenz­
+handbuch. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.5 b/app/eudas/4.4/doc/user-manual/eudas.hdb.5
new file mode 100644
index 0000000..f3abc69
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.5
@@ -0,0 +1,373 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (43)# 
+#kapitel ("5", "Gespeicherte", "Daten", "abfragen")# 
+ 
+ 
+ 
+#abschnitt ("5.1", "ÖFFNEN", "Öffnen")# 
+ 
+Als letzte Vorbereitung, bevor Sie mit der Adreßdatei spielen kön­
+nen, müssen Sie die Datei wie einen Karteikasten #on("i")#öffnen#off("i")#. Nach dem
+Öffnen beziehen sich alle weiteren Funktionen auf die gerade ge­
+öffnete Datei. Aus diesem Grund darf auch immer nur eine einzige
+Datei geöffnet sein - als hätte auf Ihrem Schreibtisch nur ein Kar­
+teikasten Platz. 
+    Dazu wählen Sie jetzt wieder das erste Menü an. Dort finden
+Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        O Öffnen 
+#text# 
+#free (0.2)# 
+Wählen Sie diese Funktion aus. Dann drücken Sie die Leertaste, um
+die Funktion auszuführen. Als erstes erscheint im unteren Teil des
+Bildschirms eine Frage: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Wollen Sie etwas aendern (eine Arbeitskopie anlegen) (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Der Cursor bleibt hinter der Frage stehen. Sie kennen diesen Frage­
+zustand ja schon. 
+    In diesem Fall wollen Sie an der Spieldatei nichts verändern,
+Sie beantworten die Frage also mit einem 'n'. Als nächstes werden
+Sie nach dem Namen gefragt (Beachten Sie auch hier wieder die
+Statuszeile). 
+    Tippen Sie nun 'Adressen' und beenden Sie die Eingabe mit
+RETURN. EUDAS öffnet die Datei und kehrt zum Menü zurück. Alter­
+nativ können Sie die Datei auch in einer Auswahl ankreuzen, wenn
+Sie ESC 'z' tippen. 
+ 
+#a ("Fußzeile")# Nach der Ausführung dieser Funktion sollten Sie Ihre
+Aufmerksamkeit auf die letzte Zeile des Bildschirms richten. Hier
+finden Sie jetzt folgendes vor: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Akt.Datei: "Adressen"         Manager:                        Datum: 22.07.87 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Neben dem Datum und dem eingestellten Manager (dies kommt viel
+später) sehen Sie hier, welche Datei Sie geöffnet haben und nun
+bearbeiten können. Diese Fußzeile finden Sie auch in den ande­
+ren Menüs. Lediglich die mittlere Angabe ändert sich bei den ande­
+ren Menüs (eine Erläuterung dazu finden Sie in späteren Kapiteln). 
+ 
+#a ("Anzeige")# Zum Anzeigen der Daten in der Adreßdatei müssen Sie das
+zweite Menü 'Einzelsatz' anwählen (durch Drücken der Pfeiltaste
+RECHTS). Am linken Rand erscheint das neue Menü mit den Anzei­
+gefunktionen. Der Rest des Bildschirms enthält das Formular für die
+Adreßdatei mit den Daten des ersten Satzes. Abbildung 5-1 zeigt
+das Bild, das sich dann ergibt. 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: Satz 1    ................... Adressen ....... Zeile 1 
+      Positionieren : Name     Wegner 
+      W Weiter      : Vorname  Herbert 
+      Z Zurück      : PLZ      5000 
+      N Satz.Nr     : Ort      Köln 
+      --------------: Strasse  Krämergasse 12 
+      Suchbedingung : m/w      m 
+      S Setzen      : ........................................................... 
+      L Löschen     : 
+      M Markierung  : 
+      --------------: 
+      Datensatz     : 
+      - Einfügen    : 
+      - Ändern      : 
+      - Tragen      : 
+      - Holen       : 
+      --------------: 
+      F Feldauswahl : 
+      --------------: 
+                    : 
+                    : 
+                    : 
+ 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 5-1   Menü 'Einzelsatz' 
+#text# 
+ 
+Das automatisch generierte Formular zeigt immer genau einen Satz.
+Das Formular besteht aus drei Teilen: der Überschrift, dem Feldteil
+und der Abschlußzeile. In der #on("i")#Überschrift#off("i")# steht der Name der Datei
+("Adressen"), die Satznummer (1) und die Nummer der ersten ange­
+zeigten Zeile (immer 1, außer wenn die Datei mehr Felder hat, als
+auf den Bildschirm passen). In manchen Fällen können auch noch
+weitere Informationen dort auftauchen, wie wir später sehen wer­
+den. 
+    Im #on("i")#Feldteil#off("i")# befindet sich der eigentliche Inhalt, und zwar sind
+links markiert die Feldnamen zu sehen, während rechts die zugehö­
+rigen Inhalte des betreffenden Satzes stehen. Dieses Bild ähnelt
+einer Karteikarte mit einem festen Format. 
+    Die #on("i")#Abschlußzeile#off("i")# am Ende gibt an, daß für diesen Satz keine
+weiteren Informationen mehr vorhanden sind. Wir werden aber spä­
+ter noch sehen, wie man anderenfalls die restlichen Informatio­
+nen sichtbar machen kann. 
+ 
+ 
+#abschnitt ("5.2", "BEWEGEN", "Bewegen")# 
+ 
+Nun wollen Sie nicht immer nur einen Satz betrachten (das wäre ja
+furchtbar langweilig). Daher müssen Sie die Möglichkeit haben, sich
+in der Datei zu "bewegen". Dies geschieht mit Hilfe der beiden
+Funktionen 
+#free (0.2)# 
+#beispiel# 
+        W Weiter 
+#text# 
+#free (0.2)# 
+und 
+#free (0.2)# 
+#beispiel# 
+        Z Zurück 
+#text# 
+#free (0.2)# 
+Sie haben die Wirkung, daß der Satz mit der nächsthöheren bzw.
+nächstniedrigeren Satznummer angezeigt wird. Natürlich funktioniert
+dies nur, wenn noch ein Satz vorhanden ist: am Anfang (Satz 1)
+können Sie nicht zurückgehen. In diesem Fall ignoriert EUDAS Ihren
+Befehl einfach. 
+    Wenn Sie bis zum Ende der Datei gehen (keine Angst - diese
+Datei enthält nur 10 Sätze), werden Sie feststellen, daß zum Schluß
+ein ganz leerer Satz erscheint. Dieser Satz ist eine Art Endemarkie­
+rung; er informiert Sie, daß keine weiteren Sätze vorhanden sind.
+Dieser Satz ist aber kein richtiger Satz, daher wird in der Über­
+schrift 'ENDE' angezeigt. (Wenn Ihnen diese Art Endemarkierung
+merkwürdig erscheint: sie hat schon einen triftigen Grund, s.6.2). 
+    Um einen Satz mit bekannter Satznummer gezielt anzuwählen,
+können Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        N Satz.Nr 
+#text# 
+#free (0.2)# 
+verwenden. Sie müssen anschließend die Satznummer eingeben (Bitte
+mit RETURN beenden). Ist der Satz vorhanden, erscheint dieser,
+ansonsten stehen Sie am Ende der Datei. 
+ 
+#a ("Aufruf über Buchstaben")# Vielleicht ist Ihnen inzwischen schon
+aufgefallen, daß vor jeder Funktion in einem Menü ein Buchstabe
+steht. Damit hat es folgendes auf sich: da das Positionieren des
+Cursors zum Auswählen einer Funktion mehrere Tastendrücke erfor­
+dern kann, haben Sie die Möglichkeit, jede Funktion auch über
+einen Buchstaben auszuführen. 
+    Dies ist besonders dann sinnvoll, wenn Sie mit den eben be­
+sprochenen Funktionen schnell in der Datei "blättern" wollen. An­
+dererseits müssen Sie sich aber für eine schnelle Reaktion auch
+einige der Tasten merken. Für die Praxis empfiehlt sich folgender
+Kompromiß: die meistgebrauchten Funktionen über Buchstaben und
+der Rest durch Positionieren im Menü. 
+ 
+ 
+#abschnitt ("5.3", "SUCHEN", "Suchen")# 
+ 
+Stellen Sie sich vor, die Datei wäre größer und Sie müßten eine
+bestimmte Adresse heraussuchen. Dazu würden Sie durch die ganze
+Datei durchgehen, bis die gewünschte Adresse erscheint. Das wäre
+natürlich bei vielen Adressen eine ungeheuer mühselige Arbeit, die
+mit einem Karteikasten wahrscheinlich schneller zu erledigen wäre. 
+    EUDAS bietet Ihnen jedoch die Möglichkeit, nach bestimmten
+Sätzen zu suchen. Dazu müssen Sie angeben, wonach gesucht werden
+soll. Als Beispiel wollen wir die Adresse von Frau Simmern su­
+chen. Bewegen Sie sich zunächst zurück bis auf den ersten Satz.
+Dann wählen Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Suchbedingung 
+        S Setzen 
+#text# 
+#free (0.2)# 
+Auf dem Bildschirm verschwinden die Feldinhalte und der Cursor
+steht hinter dem ersten Feldnamen. Dies bedeutet, daß Sie neben
+die Feldnamen etwas schreiben können. Auch in der Statuszeile
+erscheint statt der Anzeige der Menünamen ein Hinweis auf die
+Eingabemöglichkeit (s. Abb. 5-2). Sie befinden sich jetzt in einem
+Zustand, in dem Sie hinter die Feldnamen etwas schreiben können
+(dem sogenannten #on("i")#Satzeditor#off("i")#). 
+    Als Angabe, was gesucht werden soll, schreiben Sie jetzt in der
+ersten Zeile neben 'Name' die Bedingung 'Simmern'. Sie haben jetzt
+ein einfaches #on("i")#Suchmuster#off("i")# angegeben. Ein Suchmuster besteht aus
+Bedingungen, die neben die Feldnamen geschrieben werden. Unser
+einfaches Suchmuster lautet übersetzt: 
+ 
+    Wähle alle Sätze aus, bei denen 'Simmern' im Feld 'Name'
+    steht. 
+ 
+Beenden Sie die Eingabe des Suchmusters mit ESC 'q'. Es erscheint
+wieder das vorherige Bild, mit dem Unterschied, daß jetzt in der
+Überschrift ein 'SUCH-' auftaucht. EUDAS steht immer noch auf dem
+ersten Satz. 
+    Die Anzeige 'SUCH' gibt an, daß ein Suchmuster eingestellt
+wurde. Das Minuszeichen bedeutet, daß der aktuelle Satz die Such­
+bedingung jedoch #on("i")#nicht#off("i")# erfüllt. 
+ 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ? 
+      --------------: Satz 1    .................... ............... Zeile 1 
+      Positionieren : Name     Simmern 
+      W Weiter      : Vorname 
+      Z Zurück      : PLZ 
+      N Satz.Nr     : Ort 
+      --------------: Strasse 
+      Suchbedingung : m/w 
+      * Setzen      : ........................................................... 
+      L Löschen     : 
+      M Markierung  : 
+      --------------: 
+      Datensatz     : 
+      - Einfügen    : 
+      - Ändern      : 
+      - Tragen      : 
+      - Holen       : 
+      --------------: 
+      F Feldauswahl : 
+      --------------: 
+                    : 
+                    : 
+___________________________________________________________________________________________ 
+ 
+#beispiel# 
+#center#Abb. 5-2  Eingabe eines Suchmusters 
+#text# 
+ 
+#a ("Positionierung")# Das Suchen beginnt erst, wenn Sie sich in der Datei
+bewegen. In diesem Fall erhalten die Funktionen 'Satz weiter' und
+'Satz zurück' eine etwas geänderte Bedeutung. Sie gehen nämlich
+nicht einfach zum nächsten bzw. vorigen Satz, sondern zum näch­
+sten bzw. vorigen #on("i")#ausgewählten#off("i")# Satz. 
+    Als Indikator, daß Sie sich auf dem gesuchten Satz befinden,
+dient die Anzeige 'SUCH+'. Probieren Sie dies jetzt aus, indem Sie
+weitergehen. Als nächster Satz erscheint der gewünschte Satz 7. Die
+nicht ausgewählten Sätze wurden also übersprungen. Das gleiche
+passiert, wenn Sie noch weiter gehen. Da kein passender Satz mehr
+vorhanden ist, erscheint der leere Endesatz. 
+ 
+#limit (12.0)# 
+    Denken Sie daran, daß das Einstellen der Suchbedingung
+    noch keine Suche bewirkt. Diese müssen Sie selbst
+    durch Positionieren mit 'Weiter' oder 'Zurück' auslösen. 
+#limit (13.5)# 
+ 
+Sollten Sie sich nicht am Anfang der Datei befinden, wenn Sie eine
+Suchbedingung einstellen, kann es sein, daß sich der gesuchte Satz
+vor oder hinter der aktuellen Position befindet. In diesem Fall
+müssen Sie entscheiden, ob Sie vorwärts oder rückwärts gehen.
+Wenn Sie rückwärts gehen und der Satz ist nicht in diesem Ab­
+schnitt, erscheint der erste Satz mit der Anzeige 'SUCH-'. Gehen Sie
+dann wieder vorwärts, finden Sie den Satz auf jeden Fall. 
+    Die Funktion 'Satz.Nr' richtet sich natürlich nicht nach der
+eingestellten Bedingung, da Sie ja eine bestimmte Satznummer wün­
+schen. Aus der 'SUCH'-Anzeige können Sie jedoch entnehmen, ob
+die Suchbedingung auf diesen Satz zutrifft. 
+ 
+#a ("Suchbedingung löschen")# Wollen Sie wieder alle Sätze sehen, müssen
+Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Suchbedingung 
+        L Löschen 
+#text# 
+#free (0.2)# 
+auswählen. Die Anzeige 'SUCH' verschwindet wieder, um anzudeu­
+ten, daß keine Suchbedingung mehr eingestellt ist. 
+ 
+#a ("Beispiel")# Um den Charakter einer Selektion nochmal deutlich zu
+machen, sollen Sie jetzt eine Bedingung einstellen, die auf mehrere
+Sätze zutrifft. Dies hätte uns auch eben passieren können, wenn es
+mehrere Simmern gegeben hätte. Wir können zum Beispiel alle weib­
+lichen Personen auswählen. 
+    Als erstes löschen Sie die alte Suchbedingung. Tun Sie dies
+nicht, wird Ihnen beim nächsten Eingeben das alte Suchmuster zum
+Ändern angeboten. Dies ist praktisch, wenn ein Suchmuster nicht
+den erhofften Erfolg brachte und Sie es modifizieren wollen. 
+    Danach wählen Sie erneut die Funktion 'Suchbedingung setzen'.
+Nun bewegen Sie den Cursor mit der Pfeiltaste UNTEN neben den
+Feldnamen 'm/w'. Dort tragen Sie die Bedingung 'w' ein. Verlassen
+Sie die Eingabe mit ESC 'q'. 
+    Wenn Sie sich jetzt in der Datei bewegen, sehen Sie, daß immer
+nur weibliche Personen angezeigt werden - die männlichen werden
+unterdrückt (in Umkehrung der Realität). 
+ 
+#beispiel# 
+              !  1  !     !  3  !  4  !     !  6  ! 
+        +-----+-----+-----+-----+-----+-----+-----+ 
+        !Name ! ..  !     ! ..  ! ..  !     ! ..  ! 
+        !     !     !     !     !     !     !     ! 
+           :     :           :     :           : 
+        !     !     !     !     !     !     !     ! 
+        !m/w  ! w   !     ! w   ! w   !     ! w   ! 
+        +-----+-----+     +-----+-----+     +-----+ 
+ 
+#center#Abb. 5-3  Wirkung einer Selektion 
+#text# 
+ 
+ 
+#abschnitt ("5.4", "SUCHBEDINGUNGEN", "Suchbedingungen")# 
+ 
+Im letzten Abschnitt haben Sie gesehen, wie das Einstellen einer
+Suchbedingung funktioniert. In diesem Abschnitt sollen Sie weitere
+Möglichkeiten zur Formulierung von Suchmustern kennenlernen. 
+    Die erste Möglichkeit kennen Sie schon. Wenn neben einen
+Feldnamen ein Text geschrieben wird, bedeutet dies, daß ausge­
+wählte Sätze im Inhalt dieses Feldes mit dem Text übereinstimmen
+müssen. 
+ 
+#a ("Kombination")# Nun kann es sein, daß mehrere Bedingungen gelten
+müssen. Im ersten Beispiel des vorigen Abschnitts hätten wir zum
+Beispiel auch noch den Vornamen 'Anna-Maria' angeben können, um
+bei mehreren Simmern die richtige auszuwählen. Wird also in mehre­
+re Felder eine Bedingung geschrieben, müssen alle diese Bedingun­
+gen gleichzeitig zutreffen. 
+    Würden Sie in unserem Beispiel noch als dritte Bedingung 'm'
+für das Feld 'm/w' angeben, würde gar kein Satz mehr ausgewählt,
+da Anna-Maria Simmern natürlich nicht männlich ist. Auch das
+kann also passieren. 
+ 
+#beispiel# 
+        Name     Simmern 
+        Vorname  Anna-Maria 
+        .. 
+        .. 
+        m/w      m 
+ 
+#center#Abb. 5-4   Kombination von Bedingungen 
+#text# 
+ 
+#a ("Stern")# Die Bedingungen, die wir bis jetzt kennengelernt haben,
+müssen alle ganz exakt zutreffen. Häufig tritt aber der Fall auf,
+daß der gesuchte Name nicht genau bekannt ist. In diesem Fall
+kann der Name im Suchmuster auch teilweise eingegeben werden.
+Der unbekannte Teil am Anfang oder am Ende wird einfach durch
+einen Stern markiert. 
+    Wenn Sie also als Bedingung #bsp ("'Sim*'")# für den Namen angeben, so
+würde dies auf den Namen Simmern zutreffen, aber zum Beispiel
+auch auf Simmerath oder Simon. Die Bedingung #bsp("'*mern'")# würde nicht
+nur auf Simmern zutreffen, sondern auch auf Pommern. 
+    Der Stern kann aber auch für einen leeren Text stehen. So
+trifft #bsp("'Simmern*"')# auf Simmern zu, aber auch auf Doppelnamen. die
+mit Simmern beginnen. Wissen Sie jetzt nicht, ob Simmern in dem
+Doppelnamen vorne oder hinten erscheint, können Sie auch an bei­
+den Seiten einen Stern machen. Die Bedingung #bsp("'*Simmern*'")# trifft
+nicht nur auf Simmern, sondern sowohl auf Deckerath-Simmern als
+auch auf Simmern-Jakob zu. 
+    Es gibt noch eine Reihe von weiteren Möglichkeiten, Bedingun­
+gen im Suchmuster zu formulieren. Auch komplexe Kombinationen
+von Bedingungen sind möglich. Mit dem bisher Besprochenen sollten
+Sie aber in vielen Fällen auskommen. Die übrigen Möglichkeiten
+werden in Abschnitt 10.2 erklärt. Schauen Sie bei Bedarf dort nach. 
+ 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.6 b/app/eudas/4.4/doc/user-manual/eudas.hdb.6
new file mode 100644
index 0000000..fc752a1
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.6
@@ -0,0 +1,382 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (51)# 
+#kapitel ("6", "Daten", "eingeben und", "ändern")# 
+ 
+ 
+ 
+#abschnitt ("6.1", "NEUE DATEI EINRICHTEN", "Neue Datei einrichten")# 
+ 
+Nachdem Sie sich bis jetzt an einer existierenden Datei erprobt
+haben, können Sie nun dazu übergehen, eine eigene neue Datei
+einzurichten. Als Beispiel sollen Sie ein kleines Telefonregister
+erstellen. 
+    Dazu gehen Sie wieder in das Menü 'Öffnen' zurück und wäh­
+len erneut die Funktion 
+#free (0.2)# 
+#beispiel# 
+        O Öffnen 
+#text# 
+#free (0.2)# 
+indem Sie mehrmals OBEN tippen, bis die Funktion markiert. Dann
+tippen Sie die Lerrtaste zum Ausführen. Als Dateinamen geben Sie
+'Telefonnummern' an. 
+    Da die Datei 'Telefonnummern' noch nicht existiert, werden Sie
+gefragt: 
+#f2# 
+#beispiel# 
+        "Telefonnummern" neu einrichten ? (j/n) #on("i")#j#off("i")# 
+#text# 
+#f2# 
+Es kann ja sein, daß Sie sich vertippt haben und eine andere,
+existierende Datei meinten. In unserem Fall wird die Datei aber
+wirklich neu eingerichtet, daher bejahen Sie die Frage. 
+ 
+#a ("Feldnamen eingeben")# Wenn Sie beim Öffnen eine Datei neu einrich­
+ten, müssen Sie zuerst die Feldnamen festlegen, zum Beispiel diese: 
+ 
+#beispiel# 
+        'Name' 
+        'Vorname' 
+        'Strasse' 
+        'PLZ' 
+        'Ort' 
+        'Telefon' 
+        'Bemerkungen' 
+#text# 
+ 
+Ihnen wird jetzt Gelegenheit gegeben, die Feldnamen untereinander
+einzugeben. Zur Korrektur können Sie die gleichen Tasten verwen­
+den wie im Editor (beachten Sie dazu die Statuszeile am oberen
+Bildschirmrand. 
+   Geben Sie die Namen in dieser Reihenfolge ein. Tippen Sie nach
+jedem Namen die RETURN-Taste, damit der nächste Name in eine
+neue Zeile kommt. Beenden Sie die Eingabe mit ESC 'q'. 
+    Die folgende Frage ermöglicht es Ihnen, noch weitere Eigen­
+schaften der Felder festzulegen. Dies ist jedoch im Normalfall nicht
+nötig. Beantworten Sie also die Frage mit 'n'. Ihre Datei ist nun
+eingerichtet. 
+    Wie Sie sehen, besteht das Einrichten einer Datei eigentlich
+nur aus der Eingabe der Feldnamen. Wenn Sie später noch Felder
+anfügen wollen, ist dies ohne weiteres möglich. 
+ 
+ 
+#abschnitt ("6.2", "SÄTZE EINFÜGEN", "Sätze Einfügen")# 
+ 
+Nachdem die Datei nun eingerichtet worden ist, sollen Sie zunächst
+einige Sätze eingeben. Wenn Sie wieder das Menü 'Einzelsatz' an­
+wählen, sehen Sie nur den leeren Satz mit der Anzeige 'ENDE', der
+das Dateiende markiert. Um neue Sätze aufzunehmen, gibt es die
+Funktion 
+#free (0.2)# 
+#beispiel# 
+        E Einfügen 
+#text# 
+#free (0.2)# 
+Wenn Sie diese Funktion aufrufen, geschieht etwas Ähnliches wie
+beim Eingeben des Suchmusters. Der Cursor wandert wieder hinter
+den ersten Feldnamen und in der Statuszeile erscheint die Auffor­
+derung 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+        SATZ EINFUEGEN:   Abbruch: ESC h   Beenden: ESC q   Hilfe: ESC ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Sie können nun die Feldinhalte der einzelnen Felder neben die
+entsprechenden Feldnamen schreiben. Mit der RETURN-Taste schlie­
+ßen Sie eine Zeile ab und gelangen in die nächste. 
+    Um eventuelle falsche Eingaben zu korrigieren, können Sie
+ähnlich wie im Editor mit den Pfeiltasten herumfahren und falsche
+Eingaben überschreiben. Die Taste RUBOUT löscht falsche Zeichen.
+Sie beenden die Eingabe mit ESC 'q'. Anschließend ist der neue Satz
+vorhanden. 
+ 
+#beispiel# 
+#free (4.5)# 
+ 
+#center#Abb. 6-1   Einfügen 
+#text# 
+ 
+#a ("Wirkung")# Die Wirkungsweise der Funktion 'Einfügen' verdeutlicht
+die Abb. 6-1. Dargestellt ist ein Ausschnitt aus einer Datei mit den
+Sätzen 4 bis 7 und durch Buchstaben dargestellten, beliebigen In­
+halten. Satz 6 sei der aktuelle Satz. 
+    Beim Einfügen wird nun vor dem aktuellen Satz eine Lücke für
+den neuen Satz geschaffen, die zunächst noch leer ist und dann von
+Ihnen ausgefüllt werden muß. Die Satznummern aller folgenden Sätze
+erhöhen sich um 1. 
+    Die Leerstelle bleibt nur dann erhalten, wenn Sie Daten für den
+neuen Satz eingeben. Anderenfalls wird nach ESC 'q' wieder der alte
+Zustand hergestellt. 
+    Dieses Verfahren erklärt auch, warum das Ende der Datei ein
+leerer Pseudosatz ist. Um nämlich am Ende der Datei einen neuen
+Satz anzufügen, muß man vor dem Endesatz einen Satz einfügen. 
+    Nachdem Sie also jetzt den ersten Satz eingegeben haben,
+müssen Sie sich wieder zum Ende bewegen, damit der nächste Satz
+hinter dem ersten steht. Für diesen häufig benötigten Vorgang gibt
+es eine Abkürzung: Wenn Sie die Eingabe mit ESC 'w' (Weiter) statt
+ESC 'q' beenden, geht EUDAS nach dem Einfügen des Satzes weiter
+zum nächsten und fügt dort wieder einen Satz ein. 
+    Auf diese Weise können Sie also schnell eine ganze Reihe von
+Sätzen nacheinander eingeben. Nachdem Sie einen Satz eingegeben
+haben, tippen Sie ESC 'w' und können gleich anschließend schon mit
+der Eingabe des nächsten Satzes beginnen. Alle so eingegebenen
+Sätze erscheinen nachher in der Reihenfolge der Eingabe. 
+ 
+#a ("Satzeditor")# Bei der Eingabe eines neuen Satzes haben Sie nahezu
+alle Möglichkeiten, die auch der EUMEL-Editor bietet. Der be­
+schreibbare Bereich ist jedoch kleiner. Er umfaßt das ganze Gebiet,
+in dem sonst die Feldinhalte erscheinen. 
+    Wie beim Editor können Sie den Cursor mit den Cursortasten
+(Pfeiltasten) bewegen. Mit der Taste RUBOUT können Sie ein Zeichen
+löschen. Die restlichen Zeichen der Zeile rücken dann nach. Mit
+RUBIN dagegen schalten Sie in einen Einfügemodus um. Alle einge­
+gebenen Zeichen werden dann eingefügt - der Rest der Zeile rückt
+entsprechend nach rechts. Nochmaliges Tippen von RUBIN schaltet
+wieder in den alten Modus. Welcher Modus eingeschaltet ist, steht
+in der Überschriftzeile. 
+    Mit der Kombination ESC RUBOUT können Sie den Rest einer
+Zeile ab der Cursorposition löschen. Steht der Cursor in der ersten
+Spalte, wird dementsprechend die ganze Zeile gelöscht. Im Unter­
+schied zum EUMEL-Editor rücken die folgenden Zeilen jedoch nicht
+herauf. 
+    Entsprechend fügen Sie mit der Funktion ESC RUBIN eine neue
+Zeile ein. Dies ist immer dann erforderlich, wenn ein Feldinhalt
+nicht auf eine Zeile paßt. Der Teil der Zeile, der hinter dem Cursor
+steht, wird bei ESC RUBIN in die neue Zeile mitgenommen. 
+    Normalerweise tippen Sie ESC RUBIN, wenn Sie an das Ende
+einer Zeile kommen. Wenn Sie aber weiterschreiben, wird die Zeile
+einfach gerollt. Dies ist nicht weiter schlimm, aber Sie können den
+ganzen Feldinhalt nicht auf einmal sehen. 
+    In der normalen Anzeige wird ein überlanger Inhalt auf jeden
+Fall auf mehrere Zeilen verteilt. 
+ 
+#a ("Warnung")# Ein Hinweis für alle, die sich mit der Editorbedienung
+schon auskennen: EUDAS benutzt den Editor als Unterprogramm.
+Jedoch haben einige Editorfunktionen unliebsame Auswirkungen.
+Besonders gefährlich sind hier HOP RUBOUT und HOP RUBIN. Diese
+Funktion zerstören die Korrespondenz zwischen Feldnamen und
+Feldinhalten, das heißt der Feldinhalt steht nicht mehr neben dem
+Feldnamen. 
+    Weiterhin können Sie das Editorbild rollen, ohne daß die Feld­
+namen mitrollen (zum Beispiel wenn Sie in der untersten Zeile
+RETURN drücken). In diesem Fall ist die Korrespondenz auch nicht
+erhalten, das heißt die Inhalte stehen falsch, sind aber eigentlich
+richtig. 
+    In solchen Fällen erscheint am oberen oder unteren Rand der
+Hinweis #bsp("""Bitte ESC '1' druecken""")#. Wenn das Editorbild nur gerollt
+wurde, verschwindet durch ESC '1' der Hinweis wieder und das Bild
+ist in Ordnung. Wenn jedoch Zeilen gelöscht oder eingefügt wurden,
+müssen Sie diese Änderungen von Hand wieder rückgängig machen,
+bis der Hinweis verschwindet. Sie sollten also HOP RUBOUT und HOP
+RUBIN im Satzeditor nicht verwenden. 
+    Im Zweifelsfall, wenn Sie meinen, den Satz durcheinanderge­
+bracht zu haben, können Sie immer mit ESC 'h' abbrechen. Es steht
+dann der vorherige Zustand für einen neuen Versuch zur Verfügung. 
+ 
+ 
+#abschnitt ("6.3", "DATEN ÄNDERN", "Daten ändern")# 
+ 
+Wenn Sie nachträglich noch eingegebene Daten ändern wollen, kön­
+nen Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        A Ändern 
+#text# 
+#free (0.2)# 
+verwenden. Sie haben anschließend wie beim Einfügen Gelegenheit,
+neue Daten einzugeben. Allerdings werden Ihnen die bisherigen
+Daten gleich mit angeboten, so daß Sie nur die Änderungen ein­
+geben müssen. Alles andere kann unverändert bleiben. Auch diese
+Funktion wird mit ESC 'q' verlassen. ESC 'w' funktioniert beim
+Ändern ebenfalls (der nächste Satz wird zum Ändern angeboten). 
+   Stellen Sie beim Ändern oder Einfügen fest, daß Sie irgendeinen
+krassen Fehler gemacht haben, können Sie die Operation mit ESC 'h'
+abbrechen. Beim Ändern bleibt dann der alte Zustand unverändert,
+beim Einfügen wird kein Satz eingefügt. 
+ 
+#a ("Löschen")# Für den Fall, daß Sie einen Satz wieder ganz aus der
+Datei löschen wollen, hat EUDAS eine besondere Vorsichtsmaßnahme
+vorgesehen. Damit der Satz nicht gleich unwiederbringlich verloren­
+geht, müssen Sie ihn zunächst in eine andere Datei #on("i")#tragen#off("i")#. Falls
+das Löschen ein Irrtum war, können Sie den Satz von dort noch
+wiederholen. In vielen Fällen besteht ohnehin die Anforderung, daß
+auch die nicht mehr aktuellen Daten noch eine gewisse Zeit aufge­
+hoben werden müssen. 
+    Zum Tragen gibt es die Funktion 
+#f2# 
+#beispiel# 
+        Datensatz 
+        T Tragen 
+#text# 
+#f2# 
+Sie werden nach einem Dateinamen gefragt. Geben Sie hier zum
+Beispiel 'müll' an. Da diese Datei noch nicht existiert, werden Sie
+gefragt, ob Sie sie neu einrichten wollen (falls Sie sich vielleicht
+verschrieben haben). Danach wird der aktuelle Satz in die Datei
+'müll' transportiert. Am Bildschirm erscheint der nächste Satz. Der
+getragene Satz kommt an das Ende der Zieldatei. 
+    Eine Bedingung beim Tragen ist, daß die Zieldatei immer die
+gleichen Felder haben muß wie die aktuelle Datei. Sie können also
+nicht aus verschieden strukturierten Dateien in die gleiche Datei
+tragen. 
+    Zum Zurückholen eines Satzes benutzen Sie die Funktion 
+#f2# 
+#beispiel# 
+        Datensatz 
+        H Holen 
+#text# 
+#f2# 
+Der letzte Satz der Datei, die Sie angeben, wird vor dem aktuellen
+Satz eingefügt. Dadurch wird der Effekt des letzten Tragens wieder
+aufgehoben. 
+    Um die getragenen Sätze endgültig zu vernichten, müssen Sie
+die Zieldatei als Ganzes löschen. Die dazu notwendige Funktion aus
+dem Menü 'Dateien' haben Sie bereits in Abschnitt 4.4 kennenge­
+lernt. 
+ 
+ 
+#abschnitt ("6.4", "ARBEITSKOPIE SICHERN", "Arbeitskopie sichern")# 
+ 
+Wenn Sie eine Datei zum Ändern öffnen oder sie gerade neu einge­
+richtet haben, wird von dieser Datei intern eine Arbeitskopie ange­
+legt, die dann geändert wird. Sie müssen diese Arbeitskopie nach
+den Änderungen sichern, damit die Änderungen wirksam werden. 
+    In unserem Beispiel ist die Datei "Telefonnummern" immer noch
+leer. Die Änderungen sind momentan nur in der internen Kopie
+vorhanden. Wenn Sie die Datei zum Beispiel auf eine Archivdiskette
+schreiben wollten, würden Sie eine leere Datei auf der Diskette
+haben. 
+    Zum Sichern rufen Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        S Sichern 
+#text# 
+#free (0.2)# 
+im ersten Menü auf. Es erscheint dann folgende Frage: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Arbeitskopie "Telefonnummern" veraendert! Sichern (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Beantworten Sie diese Frage mit 'j'. Als nächstes wird gefragt: 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Alte Version überschreiben (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Beantworten Sie auch diese Frage mit 'j'. Die Arbeitskopie über­
+schreibt dann die (leere) Version vor dem Ändern. 
+    Wenn Sie die Frage verneint hätten, könnten Sie anschließend
+einen neuen Namen für die Arbeitskopie angeben. Dies wäre dann
+sinnvoll, wenn Sie den Stand vor den Änderungen noch aufbewahren
+wollen. In diesem Fall ist es jedoch nutzlos, die alte leere Datei
+noch behalten zu wollen. 
+    Abschließend wird gefragt, ob Sie die Arbeitskopien löschen
+wollen. Wenn Sie noch weiter mit der Datei arbeiten wollen, vernei­
+nen Sie diese Frage. Die Datei bleibt dann geöffnet. Anderenfalls
+müßten Sie die Datei neu öffnen, wenn Sie sie wieder ansehen wol­
+len. 
+ 
+#a ("Arbeitskopien")# Es ist sehr wichtig, daß Sie sich die Funktionsweise
+mit der Arbeitskopie immer vor Augen halten, damit Sie später bei
+der Arbeit mit EUDAS nicht überrascht werden. 
+    Eine Arbeitskopie wird immer dann angelegt, wenn Sie beim
+Öffnen einer EUDAS-Datei angeben, daß Sie diese Datei ändern
+wollen. In dem Beispiel haben Sie eine neue Datei eingerichtet.
+EUDAS nimmt dann automatisch an, daß Sie ändern wollen. Öffnen
+Sie eine existierende Datei, werden Sie gefragt 
+#f2# 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      Wollen Sie etwas ändern (Arbeitskopie anlegen) (j/n) ? 
+___________________________________________________________________________________________ 
+#text# 
+ 
+Wenn Sie diese Frage verneinen, wird keine Arbeitskopie angelegt;
+alle Änderungsfunktionen werden jedoch gesperrt. Daran können Sie
+auch erkennen, daß keine Arbeitskopie vorliegt. 
+    Die Arbeitskopie, die EUDAS sich anlegt, ist anonym. Wenn Sie
+sich also im Menü 'Dateien' eine Übersicht zeigen lassen, erscheint
+nur das Original. Bevor Sie mit diesem Original etwas anstellen
+(zum Beispiel auf Archiv schreiben), sollten Sie sich vergewissern,
+daß Sie die Arbeitskopie gesichert haben, da das Original sonst
+nicht auf dem neuesten Stand ist. 
+    Um Sie in diesem Fall zu warnen, erscheint vor einer geöffneten
+Datei in einer Dateiauswahl das Symbol #bsp ("<!>")#, zum Beispiel: 
+ 
+#beispiel# 
+          o <!> "Telefonnummern" 
+          o "Mitglieder" 
+#text# 
+ 
+Wenn Sie dieses Symbol sehen, sollten Sie die Datei lieber erst
+sichern, bevor Sie etwas mit ihr anstellen. 
+ 
+#a ("Beispiel")# Um die Arbeitsweise von EUDAS noch besser zu verstehen,
+betrachten Sie das Beispiel in Abb. 6-2. Nehmen Sie an, Sie haben
+drei EUDAS-Dateien 'Kalender', 'Namen' und 'Adressen' mit ihren
+Anfangsinhalten K0, N0 und A0 (symbolisch). In dem Diagramm sind
+die Vorgänge zu den Zeitpunkten 0 bis 10 mit ihren Auswirkungen
+auf die Inhalte der Dateien und der Arbeitskopie dargestellt. 
+ 
+#beispiel# 
+#free (5.5)# 
+#center#Abb. 6-2   Beispiel zur Arbeitskopie 
+#text# 
+ 
+Zu den einzelnen Zeitpunkten passiere folgendes: 
+ 
+0:   Anfangszustand. Es wurde noch keine Datei geöffnet, also ist
+     keine Arbeitskopie vorhanden. Es könnte aber auch eine
+     beliebige Datei ohne Änderungserlaubnis geöffnet sein. 
+#free (0.2)# 
+1:   Die Datei 'Adressen' wird geöffnet zum Ändern. Der momen­
+     tane Zustand der Datei wird als Arbeitskopie übernommen. 
+#free (0.2)# 
+2:   Es wird eine Änderung vorgenommen (zum Beispiel) ein Satz
+     eingefügt). Diese Änderung betrifft aber nur die Kopie - die
+     Datei 'Adressen' als Original bleibt unverändert. 
+#free (0.2)# 
+3:   Eine weitere Änderung führt zum Inhalt A2 der Arbeitsko­
+     pie. 
+#free (0.2)# 
+4:   Aufruf von 'Sichern'. Die alte Version von 'Adressen' wird
+     überschrieben und durch den Inhalt A2 ersetzt. Die Frage
+     nach dem Löschen der Arbeitskopie wird verneint; daher bleibt
+     die Kopie auch erhalten. 
+#free (0.2)# 
+5:   Die Kopie wird erneut verändert. 
+#free (0.2)# 
+6:   Aufruf von 'Sichern'. Die Frage, ob die Kopie gesichert wer­
+     den soll, wird verneint. Die Arbeitskopie soll jedoch gelöscht
+     werden. Als Ergebnis geht die Änderung A3 verloren (viel­
+     leicht war diese Änderung ein Irrtum). Die Datei 'Adressen'
+     wird nicht verändert. Es ist keine Arbeitskopie mehr vor­
+     handen. 
+#free (0.2)# 
+7:   Die Datei 'Namen' wird zum Ändern geöffnet. 
+#free (0.2)# 
+8:   Die Datei 'Kalender' wird zum Ändern geöffnet. Da an der
+     vorigen Arbeitskopie keine Änderungen vorgenommen wurden,
+     kann die Kopie einfach überschrieben werden. Anderenfalls
+     wäre an dieser Stelle die Möglichkeit zum Sichern angeboten
+     worden. 
+#free (0.2)# 
+9:   Es wird eine Änderung durchgeführt. 
+#free (0.2)# 
+10:  Die geänderte Arbeitskopie wird gesichert, das Original über­
+     schrieben und die Arbeitskopie gelöscht (Normalfall). 
+ 
+
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.7 b/app/eudas/4.4/doc/user-manual/eudas.hdb.7
new file mode 100644
index 0000000..67f635d
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.7
@@ -0,0 +1,665 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (61)# 
+#kapitel ("7", "Ausdrucken", "der", "Daten")# 
+ 
+ 
+ 
+#abschnitt ("7.1", "DRUCKMUSTER", "Druckmuster")# 
+ 
+Nachdem Sie sich die Inhalte der EUDAS-Datei ausgiebig am Bild­
+schirm angesehen haben, möchten Sie die gespeicherten Daten sicher
+auch in gedruckter Form auf Papier sehen. Sie können eine
+EUDAS-Datei jedoch nicht ohne weiteres ausdrucken, da sie eine
+andere Struktur als normale Textdateien hat. 
+    Vor dem Drucken müssen also die Inhalte der EUDAS-Datei
+zunächst in lesbarer Form in eine Textdatei geschrieben werden.
+EUDAS kann diese Aufgabe jedoch ohne Ihre Hilfe nicht alleine be­
+wältigen. 
+    Es taucht nämlich das Problem auf, daß die Dateiinhalte in
+vielen verschiedenen Formen dargestellt werden können (Sie erin­
+nern sich sicher noch an das erste Kapitel). Vielleicht wollen Sie
+bestimmte Überschriften haben oder die Daten müssen auf ein be­
+stimmtes Formular passen. 
+    Um die Ausgabe nach Ihren Wünschen zu gestalten, müssen Sie
+also dem Rechner genau angeben, an welcher Stelle welche Felder
+gedruckt werden sollen usw. Dies geht am einfachsten, indem Sie
+dem Rechner ein Muster vorsetzen, nach dem er dann die richtigen
+Ausdrucke erstellen kann. Dieses Muster schreiben Sie in eine eige­
+ne Textdatei, die #on("i")#Druckmuster#off("i")# genannt wird. Aus den Daten der
+EUDAS-Datei und der Form, die im Druckmuster angegeben ist, wird
+dann eine weitere Textdatei erzeugt, die die Daten in der ge­
+wünschten Form enthält und die anschließend automatisch gedruckt
+werden kann. 
+    Durch ein Druckmuster erhalten Sie fast völlige Freiheit in der
+Gestaltung Ihrer Ausdrucke. Zum Beispiel können aus einer einzigen
+Adressendatei einfache Listen, Einladungskarten oder Rundbriefe
+erzeugt werden. Für eine einfache Adressenliste entspricht das
+Druckmuster einer Zeile der Liste, wobei angegeben wird, in welche
+Spalten die Inhalte gedruckt werden. Zum Drucken von Einladungs­
+karten wird als Druckmuster eine Einladungskarte verwendet, in der
+die Stellen markiert sind, an denen die Adresse erscheinen soll. Das
+gleiche kann man mit einem Brief machen, der dann mit jeder
+Adresse einmal ausgedruckt wird. 
+ 
+#a ("Druckverfahren")# Man kann sich diesen Druckprozeß wie folgt vor­
+stellen: 
+ 
+#beispiel# 
+#free (6.5)# 
+ 
+#center#Abb. 7-1   Druckverfahren 
+#text# 
+ 
+Vereinfacht gesagt (das genaue Verfahren wird später beschrieben)
+wird für jeden Satz der EUDAS-Datei das Druckmuster einmal in die
+Druckdatei übernommen. Dabei werden die Inhalte aus der EUDAS-
+Datei in einer noch anzugebenden Weise an den gewünschten Stellen
+eingefügt. 
+    Im weiteren sollen Sie erfahren, wie ein Druckmuster genau
+aussieht und wie daraus ein Ausdruck entsteht. 
+ 
+#a ("Beispiel")# Im folgenden sollen Sie zur Demonstration die bereits in
+Kapitel 3 und 4 beschriebene Beispieldatei verwenden. Nach Mög­
+lichkeit sollten Sie die angegebenen Beispiele mit dieser Datei
+selbst am Rechner ausprobieren. 
+ 
+Folgende Sätze befinden sich in der Datei: 
+ 
+#beispiel# 
+     Vorname Name, Strasse, PLZ Ort, m/w 
+     ------------------------------------------------------- 
+     Herbert Wegner, Krämergasse 12, 5000 Köln, m 
+     Helga Sandmann, Willicher Weg 109, 5300 Bonn 1, w 
+     Albert Katani, Lindenstr. 3, 5210 Troisdorf, m 
+     Peter Ulmen, Mozartstraße 17, 5 Köln 60, m 
+     Karin Regmann, Grengelweg 44, 5000 Köln 90, w 
+     Hubert Arken, Talweg 12, 5200 Siegburg, m 
+     Anna-Maria Simmern, Platanenweg 67, 5 Köln 3, w 
+     Angelika Kaufmann-Drescher, Hauptstr. 123, 53 Bonn 2, w 
+     Harald Fuhrmann, Glockengasse 44, 5000 Köln 1, m 
+     Friedrich Seefeld, Kabelgasse, 5000 Köln-Ehrenfeld, m 
+#text# 
+ 
+Wie Sie sehen, wurde die Reihenfolge der Felder gegenüber der Datei
+teilweise verändert und Name und Vorname ohne Komma hinterein­
+andergeschrieben, während die anderen Feldinhalte durch Komma
+getrennt sind. Diese Liste wurde unter Verwendung eines Druck­
+musters erzeugt. 
+    Da dieses Druckmuster jedoch vorerst noch zu kompliziert ist,
+sollen Sie erst einmal ein einfacheres Druckmuster erstellen und
+versuchen, nur die Namen aus der Datei in Tabellenform auszuge­
+ben. 
+    Das dafür nötige Druckmuster hat folgendes Aussehen: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        ! &Name              ! &Vorname         ! 
+#text# 
+ 
+Das Druckmuster besteht nur aus zwei Zeilen, von der die zwei­
+te das eigentliche Muster darstellt. Die erste Zeile ist eine #on("i")# Anwei­
+sung#off("i")# an den Druckgenerator. 'WIEDERHOLUNG' gibt an, daß die
+folgenden Zeilen für jeden Satz wiederholt werden sollen (warum
+diese Angabe notwendig ist, werden Sie später einsehen). Das Pro­
+zentzeichen kennzeichnet eine Anweisung und muß unbedingt in der
+ersten Spalte des Druckmusters stehen, also ganz am linken Rand. 
+    In der zweiten Zeile ist zu sehen, daß das Zeichen '&' dazu
+benutzt wird, die Stellen zu markieren, an denen nachher Feldin­
+halte eingesetzt werden sollen. Hinter dem '&'-Zeichen folgt der
+Name des Feldes, das an dieser Stelle eingesetzt werden soll. Eine
+solche Konstruktion wird #on("i")#Feldmuster#off("i")# genannt. Beachten Sie, daß
+Feldnamen hier immer ohne Anführungsstriche geschrieben werden
+müssen. Die Ausrufungszeichen bilden den eigentlichen Mustertext
+und werden unverändert als Tabellenbegrenzung in die Ausgabe
+übernommen. 
+    Als Ergebnis des Druckprozesses sollte folgende Ausgabe auf
+dem Drucker erscheinen: 
+ 
+#beispiel# 
+        ! Wegner             ! Herbert          ! 
+        ! Sandmann           ! Helga            ! 
+        ! Katani             ! Albert           ! 
+        ! Ulmen              ! Peter            ! 
+        ! Regmann            ! Karin            ! 
+        ! Arken              ! Hubert           ! 
+        ! Simmern            ! Anna-Maria       ! 
+        ! Kaufmann-Drescher  ! Angelika         ! 
+        ! Fuhrmann           ! Harald           ! 
+        ! Seefeld            ! Friedrich        ! 
+#text# 
+ 
+Sie können erkennen, daß die Feldmuster in der Ausgabe jeweils
+durch den Inhalt des zugehörigen Feldes ersetzt worden sind. Der
+übrige Text in der Musterzeile ist unverändert geblieben. Beachten
+Sie, daß das '&' ein reserviertes Zeichen ist, das ein Feldmuster im
+umgebenden Text kennzeichnet und daher (vorerst) nicht gedruckt
+werden kann. 
+ 
+ 
+#abschnitt ("7.2", "AUFRUF", "Aufruf")# 
+ 
+In diesem Abschnitt sollen Sie erfahren, wie Sie diese Ausgabe
+selbst erzeugen können. Damit der Druckgenerator arbeiten kann,
+müssen Sie die Datei 'Adressen' erst einmal öffnen. Anschließend
+wählen Sie das Menü 'Drucken' an. 
+ 
+#a ("Druckmuster erstellen")# Als nächstes müssen Sie das Druckmuster
+erstellen. Hierfür gibt es die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Textdatei 
+        E Editieren 
+#text# 
+#free (0.2)# 
+da das Druckmuster eine normale Textdatei ist. 
+    Wählen Sie diese Funktion. Sie werden dann nach einem Namen
+für das Druckmuster gefragt. Wir wollen das Druckmuster 'Namens­
+liste' nennen - Sie können aber auch einen beliebigen anderen
+Namen wählen. Denken Sie daran, die Anführungsstriche nicht mit
+einzugeben. 
+    Es erscheint anschließend das gewohnte Editorbild mit einer
+entsprechenden Statuszeile. Geben Sie die zwei Zeilen des Druck­
+musters ein und beenden Sie den Editor mit ESC 'q'. Damit ist das
+Druckmuster fertig. 
+ 
+    Die hier beschriebene Funktion können Sie nicht nur zum Er­
+stellen, sondern auch zum Ändern und einfachen Ansehen eines
+Druckmusters bzw. einer Textdatei allgemein verwenden. Es wird
+Ihnen immer der jeweilige Inhalt präsentiert, den Sie dann nach
+Belieben abändern können oder nicht. 
+ 
+#bildschirm# 
+___________________________________________________________________________________________ 
+ 
+      EUDAS:   Öffnen   Einzelsatz   Gesamtdatei   Drucken   Dateien   Archiv 
+      --------------: 
+      Satzauswahl   : 
+      D Drucken     : 
+      --------------: 
+      Druckausgabe  : 
+      R Richtung    : 
+      --------------: 
+      Textdatei     : 
+      E Editieren   : 
+      A Ausdrucken  : 
+      N Nachbearb.  : 
+      --------------: 
+ 
+___________________________________________________________________________________________ 
+#beispiel# 
+#center#Abb. 7-2   Menü "Drucken" 
+#text# 
+ 
+#a ("Ausgaberichtung")# Bevor Sie jetzt weitermachen, sollten Sie über­
+prüfen, ob an Ihrem System ein Drucker angeschlossen ist. Der
+Drucker sollte bei den folgenden Versuchen betriebsbereit sein. 
+    Ist kein Drucker angeschlossen oder wollen Sie kein Papier
+verschwenden, haben Sie die Möglichkeit, den Ausdruck als Text­
+datei zu erhalten. Dazu wählen Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        Ausgabe 
+        R Richtung 
+#text# 
+#free (0.2)# 
+an. Beantworten Sie beide Fragen, die Ihnen gestellt werden, mit
+'n'. Die Ausgaben stehen dann nachher in Dateien mit einem Namen
+der Form 
+#free (0.2)# 
+#beispiel# 
+        Namensliste.a$n 
+#text# 
+#free (0.2)# 
+die Sie sich mit der oben beschriebenen Funktion dann genau wie
+ein Druckmuster anschauen können. Der Name besteht also aus dem
+Namen des Druckmusters, dem ein #bsp("'.a$'")# angehängt wird. Die Nummer
+'n' dient zur Unterscheidung bei mehreren aufeinanderfolgenden
+Ausgaben. Um Verwirrung zu vermeiden, sollten Sie die Datei nach
+dem Anschauen löschen (im Menü 'Dateien'). 
+ 
+#a ("Druckaufruf")# Wenn Sie diese Hinweise beachtet haben, können Sie
+den Druckvorgang mit der Auswahl 
+#free (0.2)# 
+#beispiel# 
+        Satzauswahl 
+        D Drucken 
+#text# 
+#free (0.2)# 
+starten. Sie werden hier nach dem Namen des Druckmusters gefragt,
+das Sie verwenden wollen (Sie können ja durchaus eine ganze Reihe
+von verschiedenen Druckmustern haben). 
+    Sie können den Ablauf des Druckvorganges daran verfolgen,
+daß jeweils die Nummer des Satzes ausgegeben wird, der gerade
+bearbeitet wird. Probieren Sie eventuell auch kleine Abwandlungen
+des Druckmusters aus, indem Sie die Tabellenspalten schmaler oder
+breiter machen oder die Ausrufungszeichen durch ein anderes Zei­
+chen ersetzen (je nach Geschmack). 
+ 
+#a ("Ausgabedatei")# Wollen Sie die erzeugte Ausgabe (die in der Datei
+'Namensliste.a$1' steht) irgendwann tatsächlich ausdrucken, ver­
+wenden Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        A Ausdrucken 
+#text# 
+#free (0.2)# 
+Sie werden dann nach dem Namen der Textdatei gefragt. Beachten
+Sie, daß Sie diese Funktion #on("i")#nicht#off("i")# zum Drucken von EUDAS-Dateien
+verwenden können, da aus einer EUDAS-Datei erst eine Druckdatei
+erzeugt werden muß. 
+    Auch wenn Sie angegeben haben, daß die Ausgabe des Druck­
+prozesses direkt ausgedruckt werden soll, startet Ihr Drucker erst,
+wenn EUDAS die ganze Datei durchgegangen ist und der Vorgang für
+Sie beendet ist. Dies liegt am EUMEL-System, das nur vollständige
+Druckaufträge entgegennimmt, damit sich mehrere Benutzer nicht in
+die Quere kommen können. In einem Multi-User-System können Sie
+weiterarbeiten, während der Drucker beschäftig ist. 
+ 
+#a ("Fehler")# Bevor der eigentliche Druckprozeß gestartet wird, wird das
+Druckmuster auf unsinnige oder unverständliche Konstruktionen
+überprüft. Ist dem Druckgenerator etwas suspekt, gibt er eine Feh­
+lermeldung aus, in der die fragliche Situation von seiner Seite aus
+beschrieben wird. Er kann natürlich nicht Ihren Fehler "verstehen".
+Daher müssen Sie unter Umständen eine Fehlermeldung erst inter­
+pretieren, ehe Sie die wahre Ursache erkennen können. 
+    Damit Sie einen aufgetretenen Fehler gleich korrigieren können,
+werden Ihnen das Druckmuster und die Fehlermeldungen parallel auf
+dem Bildschirm zum Ändern und Anschauen angeboten. Sie können
+mit dem Editor das Druckmuster ändern und in den Fehlermeldungen
+blättern. Diese Konfiguration wird Paralleleditor genannt. Mit ESC
+'w' wechseln Sie zwischen den beiden Bildschirmhälften. 
+ 
+#a ("Suchbedingung")# Wollen Sie nicht alle Namen ausdrucken, so können
+Sie vorher ein Suchmuster einstellen, das nur auf die gewünschten
+Namen zutrifft (wie im Kapitel 5 beschrieben). Der Druckgenerator
+richtet sich immer nach dem aktuell eingestellten Suchmuster und
+druckt nur die ausgewählten Sätze. Wenn Sie zum Beispiel die Na­
+men aller Frauen ausdrucken wollen, stellen Sie im Tastenmodus ein
+Suchmuster ein (das sollten Sie können), das für das Feld 'm/w' die
+Bedingung 'w' enthält. Danach können Sie den Druckgenerator auf­
+rufen. Vergessen Sie nicht, das Suchmuster anschließend wieder zu
+löschen. 
+ 
+#a ("Feldnamen abfragen")# Wenn Sie selber ein Druckmuster erstellen,
+wird es häufiger vorkommen, daß Sie die genaue Schreibweise der
+Feldnamen nicht im Kopf haben. Für diesen Zweck definiert EUDAS
+im Editor eine spezielle Tastenkombination. 
+    Wenn Sie dort ESC 'F' tippen (großes 'F'), erhalten Sie eine
+Auswahl aller Felder der gerade geöffneten Datei. Sie können sich
+die Namen einfach ansehen, aber auch direkt in den Text des
+Druckmusters übernehmen. 
+    Wenn Sie nämlich vor dem Verlassen der Auswahl mit ESC 'q'
+ein Feld ankreuzen, wird anschließend der Name in Anführungs­
+strichen an die Position geschrieben, an der vor dem Aufruf der
+Cursor stand. Auf diese Weise können Sie sich auch das Tippen
+langer Feldnamen vereinfachen. 
+    Beachten Sie, daß Sie im Normalfall im Druckmuster die Anfüh­
+rungsstriche wieder entfernen müssen. Die Anführungsstriche dienen
+zur Abgrenzung, wie weit der Feldname geht. Falls der Name Leer­
+zeichen enthält, beachten Sie bitte den Absatz 'Abgrenzung der
+Feldnamen' in Abschnitt 7.4. 
+ 
+ 
+#abschnitt ("7.3", "ABSCHNITTE", "Abschnitte")# 
+ 
+Die Tabellen, die Sie bis jetzt erzeugen können, sehen optisch noch
+nicht sehr gut aus. Es fehlt auf jeden Fall eine vernünftige Über­
+schrift. Um eine Überschrift zu erzeugen, können Sie im Druckmuster
+einen #on("i")#Vorspann#off("i")# definieren, der ganz zu Anfang einmal gedruckt
+wird. 
+    Dieser Vorspann wird durch die Anweisung 
+#f2# 
+#beispiel# 
+        % VORSPANN 
+#text# 
+#f2# 
+eingeleitet (bitte nicht vergessen, daß das '%'-Zeichen für eine
+Anweisung in der ersten Spalte stehen muß). Die folgenden Zeilen
+bis zur 'WIEDERHOLUNG'-Anweisung gehören zum Vorspann. Ein
+Druckmuster für unsere Namensliste mit Überschrift könnte dann so
+aussehen: 
+ 
+#beispiel# 
+        % VORSPANN 
+        Alle Namen aus der EUDAS-Datei 'adressen' 
+        ----------------------------------------- 
+        % WIEDERHOLUNG 
+        ! &Name              ! &Vorname         ! 
+#text# 
+ 
+Der Druckgenerator erzeugt mit diesem Druckmuster die gewünschte
+Liste mit Überschrift. Sie können als Vorspann natürlich auch einen
+beliebigen anderen Text verwenden. 
+    In einer analogen Weise können Sie die Liste noch durch eine
+waagerechte Linie abschließen, indem Sie einen #on("i")#Nachspann#off("i")# definie­
+ren. Die dafür notwendige Anweisung heißt 
+#f2# 
+#beispiel# 
+        % NACHSPANN 
+#text# 
+#f2# 
+Die Zeilen nach dieser Anweisung werden gedruckt, nachdem alle
+Sätze bearbeitet worden sind. Das folgende Druckmuster erzeugt
+schon eine sehr schöne Liste: 
+ 
+#beispiel# 
+        % VORSPANN 
+        Alle Namen aus der EUDAS-Datei 'adressen' 
+        ----------------------------------------- 
+        % WIEDERHOLUNG 
+        ! &Name              ! &Vorname         ! 
+        % NACHSPANN 
+        ----------------------------------------- 
+#text# 
+ 
+nämlich: 
+ 
+#beispiel# 
+        Alle Namen aus der EUDAS-Datei 'adressen' 
+        ----------------------------------------- 
+        ! Wegner             ! Herbert          ! 
+        ! Sandmann           ! Helga            ! 
+        ! Katani             ! Albert           ! 
+        ! Ulmen              ! Peter            ! 
+        ! Regmann            ! Karin            ! 
+        ! Arken              ! Hubert           ! 
+        ! Simmern            ! Anna-Maria       ! 
+        ! Kaufmann-Drescher  ! Angelika         ! 
+        ! Fuhrmann           ! Harald           ! 
+        ! Seefeld            ! Friedrich        ! 
+        ----------------------------------------- 
+#text# 
+ 
+Die drei Teile, aus denen ein Druckmuster bestehen kann (Vorspann,
+Nachspann und Wiederholungsteil), werden #on("i")#Abschnitte#off("i")# genannt. Wie
+Sie später noch sehen werden, haben Abschnitte eine Reihe von
+gemeinsamen Eigenschaften. Ein Abschnitt wird durch eine eigene
+Anweisung eingeleitet und endet, wenn ein anderer Abschnitt be­
+ginnt oder das Druckmuster zu Ende ist. Alle Abschnitte können
+auch weggelassen werden, irgendein Abschnitt muß aber immer
+vorhanden sein. So ist es zum Beispiel möglich, ein Druckmuster zu
+bauen, das nur aus einem Nachspann besteht (Sie werden allerdings
+jetzt noch nicht verstehen können, warum so etwas sinnvoll sein
+kann). 
+    Zum Abschluß dieses Kapitels hier noch einmal eine Übersicht
+der bisher vorgestellten Anweisungen: 
+ 
+#beispiel# 
+        Anweisung      !  Bedeutung 
+        ---------------+---------------------------------- 
+        % VORSPANN     ! leitet Vorspann ein 
+        % WIEDERHOLUNG ! leitet Wiederholungsteil ein 
+        % NACHSPANN    ! leitet Nachspann ein 
+#text# 
+ 
+ 
+#abschnitt ("7.4", "FELDMUSTER", "Feldmuster")# 
+ 
+Mit den bis jetzt beschriebenen Möglichkeiten des Druckgenerators
+können Sie schon sehr viel anfangen. Es fehlt aber noch die Mög­
+lichkeit, mehrere Feldinhalte direkt hintereinander zu schreiben,
+egal wie lang diese Inhalte sind. Diese Fähigkeit wird zum Beispiel
+für die anfangs vorgestellte Liste benötigt. 
+ 
+#a ("Variable Position")# Die Feldmuster, die Sie bis jetzt kennen, begin­
+nen mit einem '&'-Zeichen und werden immer genau an der Stelle
+gedruckt, an der sie stehen (feste Position). Sie können ein Feld­
+muster aber auch mit '%' beginnen lassen. In diesem Fall kann der
+Inhalt verschoben werden (variable Position), je nachdem, ob vorhe­
+rige Inhalte kürzer oder länger sind. 
+    '%' ist wie '&' ein reserviertes Zeichen, kann also nicht direkt
+gedruckt werden. Da '&' und '%' Feldmuster einleiten, heißen sie
+#on("i")#Musterzeichen#off("i")#. 
+    Um Feldmuster variabler Position einmal auszuprobieren, soll­
+ten Sie unser bisheriges Druckmuster in der folgenden Weise um­
+schreiben: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        &Vorname %Name 
+#text# 
+ 
+(Vorspann und Nachspann der Einfachheit halber mal weggelassen).
+Als Ergebnis erhalten wir: 
+ 
+#beispiel# 
+        Herbert Wegner 
+        Helga Sandmann 
+        Albert Katani 
+        Peter Ulmen 
+        Karin Regmann 
+        Hubert Arken 
+        Anna-Maria Simmern 
+        Angelika Kaufmann-Drescher 
+        Harald Fuhrmann 
+        Friedrich Seefeld 
+#text# 
+ 
+Das Feldmuster '%Name' ist also entsprechend der Länge des Vor­
+namens nach links oder nach rechts gerutscht. Zu beachten ist, daß
+ein Feldmuster mit '%' nicht in der ersten Spalte stehen darf, denn
+dann würde die Zeile als Anweisung angesehen. Ein Feldmuster
+variabler Position wäre ja auch in der ersten Spalte wenig sinnvoll. 
+ 
+#a ("Feste Länge")# Außer den beiden bisher besprochenen einfachen
+Arten (mit '&' oder '%') gibt es noch weitere Ausprägungen von
+Feldmustern für besondere Fälle. Wird ein Feldmuster noch von
+weiteren Musterzeichen gefolgt, dann wird dieses Feldmuster immer
+in der reservierten Länge eingesetzt. Die reservierte Länge reicht
+vom ersten bis zum letzten Musterzeichen. Durch die zusätzlichen
+Musterzeichen wird also ein bestimmter Platz freigehalten. 
+    Ersetzt man im obigen Druckmuster '&Vorname' durch
+'&Vorname&&', wird der Effekt des folgenden '%'-Feldes wieder
+aufgehoben, da jetzt für alle Vornamen die gleiche Länge verwendet
+wird (Probieren Sie dies aus). 
+    Bei einem solchen Feldmuster mit fester Länge wird der Inhalt
+abgeschnitten, falls er diese Länge überschreitet; ist der Inhalt
+kürzer, wird rechts mit Leerstellen aufgefüllt. Aber auch bei Feld­
+mustern mit variabler Länge (also ohne folgende Musterzeichen)
+kann abgeschnitten werden, nämlich genau dann, wenn der Inhalt so
+lang ist, daß ein folgendes Feld mit fester Position (mit '&' anfan­
+gend) überschrieben würde. Hätten wir also in unserem ersten
+Druckmuster nicht genügend Platz für die Spalten vorgesehen,
+wären einige Namen abgeschnitten worden (probieren Sie es nochmal
+aus, falls es Ihnen nicht schon passiert ist). 
+    In einem weiteren Fall werden Feldmuster variabler Länge
+abgeschnitten, nämlich wenn die generierte Zeile die maximale
+Zeilenlänge überschreitet. Die maximale Zeilenlänge richtet sich
+nach dem Dateilimit, das für das Druckmuster eingestellt ist. Nor­
+malerweise ist dies 77, so daß Sie in Normalschrift die Zeilenbreite
+auf einem DIN A4-Blatt nicht überschreiten. 
+    Benutzen Sie jedoch breites Papier oder eine schmale Schrift,
+sollten Sie während der Eingabe des Druckmusters ESC ESC tippen
+und das Kommando 
+#f2# 
+#beispiel# 
+        limit (135) 
+#text# 
+#f2# 
+eingeben. EUDAS nutzt dann die volle Zeilenbreite aus. 
+ 
+#a ("Rechtsbündig")# Sie sind jetzt aber noch nicht zu Ende mit den
+Feldmustervariationen. Eine letzte Möglichkeit besteht darin, den
+Inhalt rechtsbündig in ein Feldmuster einzusetzen. Dies hat natür­
+lich nur Sinn bei fester Länge. Man erreicht dies dadurch, daß man
+das Feldmuster mit mehreren Musterzeichen beginnen läßt. So ist 
+#f2# 
+#beispiel# 
+        %%Vorname% 
+#text# 
+#f2# 
+die rechtsbündige Version von 
+#f2# 
+#beispiel# 
+        %Vorname%% 
+#text# 
+#f2# 
+Beide Feldmuster sind gleich lang, beim ersten wird jedoch am lin­
+ken Rand aufgefüllt oder abgeschnitten, beim zweiten dagegen am
+rechten Rand. 
+ 
+#a ("Zusammenfassung")# Hier noch einmal eine Zusammenstellung
+aller möglichen Feldmustertypen: 
+ 
+#beispiel# 
+        Typ ! Beispiel  ! Position ! Länge    ! bündig 
+        ----+-----------+------------------------------ 
+         1  ! &Name     ! fest     ! variabel ! links 
+         2  ! %Name     ! variabel ! variabel ! links 
+         3  ! &Name&&&  ! fest     ! fest     ! links 
+         4  ! %Name%%%  ! variabel ! fest     ! links 
+         5  ! &&&Name&  ! fest     ! fest     ! rechts 
+         6  ! %%%Name%  ! variabel ! fest     ! rechts 
+#text# 
+ 
+Wir können zusammenfassen: 
+#free (0.2)# 
+#bsp("*")#  Feldmuster dienen im Druckmuster dazu, Stellen zu markieren, an
+   denen Inhalte eingesetzt werden sollen. 
+#free (0.2)# 
+#bsp("*")#  Feldmuster beginnen mit einem Musterzeichen ('&' oder '%');
+   darauf folgt der Feldname. 
+#free (0.2)# 
+#bsp("*")#  Durch '&' wird feste und durch '%' variable Position festgelegt. 
+#free (0.2)# 
+#bsp("*")#  Durch zusätzliche Musterzeichen kann eine feste Länge angege­
+   ben werden; mehrere Musterzeichen am Anfang führen zu rechts­
+   bündigem Einsetzen. 
+ 
+#a ("Abgrenzung der Feldnamen")# Als nächstes sollen Sie den Fall be­
+trachten, daß Sie einen Namen in der oft auftretenden Form 
+#f2# 
+#beispiel# 
+        Name, Vorname 
+#text# 
+#f2# 
+schreiben wollen. Die Schwierigkeit liegt in dem Komma, das direkt
+hinter dem Namen folgen soll. Sie könnten versuchen, diese Situa­
+tion im Druckmuster folgendermaßen darzustellen: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        &Name, %Vorname 
+#text# 
+ 
+In diesem Fall erhalten Sie aber die Fehlermeldung 
+ 
+#beispiel# 
+        FEHLER in Zeile 2 bei >>Name,<< 
+           diese Abkuerzung ist nicht definiert 
+#text# 
+ 
+Wenn Sie sich nicht genau vorstellen können, wie der Druckgenera­
+tor ein Feldmuster liest, wird Ihnen dieser Fehler mysteriös er­
+scheinen, denn 'Name' ist doch als Feld definiert (was eine Abkür­
+zung ist, werden Sie in Kapitel 13 lernen). Den entscheidenden
+Hinweis liefert jedoch das Komma. Offensichtlich hat der Druck­
+generator das Komma als Teil des Feldnamens angesehen. 
+    Dies liegt daran, daß ja irgendwann der Feldname in einem
+Feldmuster beendet sein muß. Normalerweise interpretiert der
+Druckgenerator ein Leerzeichen oder Musterzeichen als Ende des
+Namens, alle vorherigen Zeichen gehören mit zum Feldnamen. Wenn
+nun aber nach dem Feldmuster kein Leerzeichen folgen soll (wie in
+unserem Beispiel) oder der Feldname selbst Leerzeichen enthält
+(dies ist ja erlaubt, könnte aber im Druckmuster nie erkannt wer­
+den), muß noch eine zusätzliche Angabe erfolgen. 
+    In solchen Fällen kann der Feldname in spitze Klammern einge­
+schlossen werden. Der Druckgenerator sieht den Feldnamen dann bei
+der ersten schließenden Klammer als beendet an, wobei die Klam­
+mern natürlich nicht zum Feldnamen gehören, aber auch nicht ge­
+druckt werden. 
+    Das obige Beispiel müßte also richtig so formuliert werden: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+        &<Name>, %Vorname 
+#text# 
+ 
+Wenn Sie dieses Druckmuster ausprobieren, werden Sie sehen, daß
+die Namen tatsächlich in der gewünschten Form erscheinen. 
+ 
+#a ("Leerautomatik")# Es gibt noch eine trickreiche Automatik in EUDAS,
+die in manchen Fällen ganz nützlich ist - und zwar in Fällen, in
+denen Sie mehrere Felder als Aufzählung durch Leerzeichen ge­
+trennt drucken wollen. Nehmen wir an, unsere Adreßdatei hätte
+noch ein Feld 'Titel', in das Sie bei Bedarf 'Dr.' oder 'Prof. Dr.'
+eintragen. In der Adresse würden Sie dann angeben: 
+ 
+#beispiel# 
+        &Titel %Vorname %Name 
+#text# 
+ 
+Wenn der Titel jedoch leer ist, würde ein störendes Leerzeichen vor
+dem Namen bleiben. In einem solchen Fall entfernt EUDAS das Leer­
+zeichen automatisch. Vorbedingung für diese Automatik ist, daß es
+sich um ein Feld variabler Länge handelt und vor dem Feld noch ein
+Leerzeichen steht (außer in Spalte 1). 
+ 
+#a ("Aufgabe")# Sie sollten jetzt die Möglichkeiten des Druckgenerators
+soweit kennengelernt haben, daß Sie ein Druckmuster für die zu
+Anfang des Kapitels erwähnte Liste aller Dateiinhalte erstellen
+können. Versuchen Sie dies zunächst allein, ehe Sie die Lösung
+nachschauen. 
+ 
+ 
+Hier nun die Lösung: 
+ 
+#beispiel# 
+     % VORSPANN 
+     Vorname Name, Strasse, PLZ Ort, m/w 
+     ------------------------------------------------------- 
+     % WIEDERHOLUNG 
+     &Vorname %<Name>, %<Strasse>, %PLZ %<Ort>, %m/w 
+#text# 
+ 
+Beachten Sie die spitzen Klammern, die nötig sind, um das Kom­
+ma ohne Zwischenraum anzuschließen. 
+ 
+#a ("Beispiel")# Als letztes Beispiel sollen Sie einen Fall betrachten, bei
+dem pro Satz mehr als eine einzelne Listenzeile gedruckt werden
+soll, und zwar sollen Sie einen Brief schreiben, in den der Druck­
+generator die Adressen verschiedener Leute einfügen soll. Die Er­
+stellung von Formbriefen ist eine sehr häufige Anwendung von
+EUDAS. Mit den bisher beschriebenen Konstrukten kann man etwa
+folgendes Druckmuster schreiben: 
+ 
+#beispiel# 
+        % WIEDERHOLUNG 
+             &Vorname %Name 
+             &Strasse 
+             &PLZ %Ort 
+ 
+             Lieber &Vorname ! 
+ 
+             Ich lade Dich mit diesem Brief zu 
+             meiner nächsten Party ein. 
+             Bring gute Laune und was zu Essen mit. 
+ 
+                                     Viele Grüße 
+        \#page\# 
+#text# 
+ 
+Die letzte Zeile zeigt eine Möglichkeit, von der Sie wahrscheinlich
+öfter Gebrauch machen werden, nämlich Druckersteuerungsanwei­
+sungen in das Druckmuster einzufügen. Die Anweisung '\#page\#'
+wird an den Drucker weitergereicht und bewirkt, daß nach jedem
+Brief eine neue Seite angefangen wird (Sie wollen sicher nicht
+mehrere Briefe auf ein Blatt drucken). Sie können auch andere An­
+weisungen verwenden, z.B. neue Schrifttypen einstellen. Informieren
+Sie sich gegebenenfalls, welche Anweisungen die Textkosmetik zur
+Verfügung stellt. 
+ 
+#a ("Ausblick")# Sie kennen jetzt bereits einen großen Teil der Möglich­
+keiten des Druckgenerators. Einige wünschenswerte Fähigkeiten
+fehlen jedoch noch. So wäre es vorteilhaft, wenn abhängig vom
+Inhalt des Feldes 'm/w' die Anrede 'Sehr geehrter Herr' oder 'Sehr
+geehrte Frau' erzeugt werden könnte. Außerdem könnte das im
+Rechner vorhandene Datum automatisch in den Brief übernommen
+werden. Diese Möglichkeiten werden den Kapiteln 12 und 13 be­
+schrieben. 
+    Sie sollten diese jedoch erst dann durchlesen, wenn Sie eine
+gewisse Sicherheit im Umgang mit Druckmustern erlangt haben.
+Zuvor sollten Sie die Inhalte dieses Kapitels beherrschen, damit Sie
+EUDAS gut nutzen können. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.8 b/app/eudas/4.4/doc/user-manual/eudas.hdb.8
new file mode 100644
index 0000000..3799dce
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.8
@@ -0,0 +1,187 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (75)# 
+#kapitel ("8", "Was war", "und was", "noch kommt")# 
+ 
+ 
+ 
+#abschnitt ("8.1", "RÜCKBLICK", "Rückblick")# 
+ 
+So! Wenn Sie bis hierhin gut mitgearbeitet haben, haben Sie die
+erste und wichtigste Etappe beim Erlernen von EUDAS schon ge­
+schafft. Bevor Sie kennenlernen, was für Möglichkeiten Ihnen EUDAS
+sonst noch bietet, wollen wir die wichtigsten Dinge rekapitulieren,
+die Sie gelernt haben sollten. 
+ 
+#a ("EUDAS-Dateien")# Sie sollten wissen, wie EUDAS-Dateien aussehen,
+und daß sie sich von normalen Textdateien unterscheiden. Diese
+Unterscheidung sollten Sie immer beachten, denn es gibt Funktio­
+nen, die nur EUDAS-Dateien annehmen (zum Beispiel 'Öffnen'),
+andere, die nur Textdateien annehmen (zum Beispiel 'Textdatei
+erstellen') und solche, die mit beliebigen Arten von Dateien "ohne
+Ansehen der Person" funktionieren (zum Beispiel 'Kopieren vom
+Archiv'). 
+ 
+#a("Bedienung")# Sie sollten wissen, wie man eine Funktion im Menü
+aufruft; wie Sie EUDAS die notwendigen Informationen (zum Beispiel
+Dateinamen) mitgeben und wie Sie in besonderen Situationen (Feh­
+ler, Abbruch) reagieren können. Zur problemlosen Bedienung sollten
+Sie auch die jeweilige Statuszeile interpretieren können. 
+ 
+#a("Dateiverwaltung")# Sie sollten wissen, wie Sie Dateien von Archiv­
+disketten holen und dort auch wieder abspeichern können. Dazu ist
+die Dateiauswahl durch Ankreuzen sehr hilfreich. Sie sollten von
+Anfang an darauf achten, daß Sie Ihre Dateien regelmäßig auf dem
+Archiv sichern, damit Sie bei etwaigen Problemen mit Ihrem Rechner
+die Daten nicht verlieren. 
+ 
+#a("Öffnen")# Sie sollten wissen, daß Sie eine EUDAS-Datei vor dem
+Bearbeiten erst öffnen müssen. Weiterhin sollten Sie mit der Ar­
+beitskopie umgehen können, die EUDAS bei Änderungen anlegt.
+Denken Sie daran, Ihre Datei nach Änderungen zu sichern. Sie soll­
+ten auch neue EUDAS-Dateien mit eigener Struktur anlegen können. 
+ 
+#a("Ansehen und Ändern")# Sie sollten wissen, wie Sie die Daten Ihrer
+EUDAS-Dateien am Bildschirm abrufen können - entweder manuell
+oder mit Hilfe eines Suchmusters. Sie sollten Änderungen und Ein­
+fügungen durchführen können. 
+ 
+#a("Drucken")# Sie sollten wissen, wie Sie die Daten einer EUDAS-Datei
+mit Hilfe eines Druckmusters ausdrucken können. Denken Sie daran,
+daß dies ein zweistufiger Vorgang ist (Generierung der Druckdatei -
+Ausgeben an Drucker), den Sie an verschiedenen Stellen beeinflus­
+sen können. 
+ 
+Lesen Sie das entsprechende Kapitel erneut durch, wenn Sie sich bei
+einem Punkt dieser Aufzählung nicht sicher sind. Wichtig ist auch,
+daß Sie die bschriebenen Funktionen selbst am Rechner ausprobiert
+haben. 
+    Wenn Sie dies alles geduldig absolviert haben, sind Sie in der
+Lage, EUDAS sinnvoll für Ihre eigenen Probleme einzusetzen. Sie
+sollten jetzt ruhig versuchen, eigene Lösungen zu realisieren. Sicher
+werden Sie dabei erkennen, daß Ihnen noch einige Möglichkeiten
+fehlen. Die Chancen sind aber gut, daß EUDAS Ihnen diese Möglich­
+keiten bietet. 
+    Im nächsten Abschnitt erhalten Sie einen Überblick darüber,
+was EUDAS noch zur Verfügung stellt. Dort können Sie sich orien­
+tieren, welche Kapitel Sie lesen sollten, wenn Sie bestimmte Fragen
+haben. 
+ 
+ 
+#abschnitt ("8.2", "AUSBLICK", "Ausblick")# 
+ 
+Im zweiten Teil dieses Handbuchs erwarten Sie eine ganze Reihe
+interessanter Themen. Dort werden Erweiterungen und Verallgemei­
+nerungen von Funktionen beschreiben, die Sie bereits kennen. Viele
+Funktionen sind jedoch ganz neu und manchmal auch nicht ganz
+einfach zu beherrschen. 
+ 
+#a ("Kapitel 9")# Das neunte Kapitel befaßt sich mit der grundsätzlichen
+Struktur der geöffneten Datei. Sie erfahren, daß Sie mehr als eine
+Datei gleichzeitig öffnen und bearbeiten können. Zum einen können
+Sie gleichartige Dateien verketten oder Dateien über Beziehungen
+koppeln. Insbesondere das Koppeln ist eine wichtige Grundlage für
+viele fortgeschrittene Anwendungen von EUDAS. 
+    In diesem Kapitel wird auch beschrieben, wie Sie auf einem
+Mehrplatzsystem von mehreren Plätzen aus auf die gleichen EUDAS-
+Dateien zugreifen können. Die Fähigkeiten von EUDAS auf diesem
+Gebiet erreichen nicht das Niveau von großen Datenbanksystemen,
+sind jedoch einfach anzuwenden und in vielen Fällen nützlich. 
+ 
+#a ("Kapitel 10")# Im zehnten Kapitel erfahren Sie, wie Sie den Bildschirm
+übersichtlicher gestalten können, wenn Sie Dateien mit zahlreichen
+Feldern benötigen. Sie können bestimmte Felder auswählen, aber
+auch die Sätze einfach ausschnittweise ansehen. 
+    Das Suchmuster besitzt noch viele Fähigkeiten, die im ersten
+Teil nicht zur Sprache gekommen sind. Sie können mehrere Bedin­
+gungen auf verschiedene Weisen miteinander kombinieren. Auch
+einige neue Vergleiche treten auf. Außerdem können Sie mehrere
+Felder eines Satzes miteinander vergleichen. 
+    Zum schnellen Überblick steht Ihnen eine Funktion bereit, die
+jeweils einen Satz pro Bildschirmzeile anzeigt. In dieser Übersicht
+können Sie blättern und auch Sätze markieren (ankreuzen), um Sie
+später zu bearbeiten. 
+ 
+#a ("Kapitel 11")# Das elfte Kapitel ist den Funktionen zur Bearbeitung
+gewidmet. Dort erfahren Sie, wie Sie eine Datei sortieren können.
+Außerdem können Sie eine Datei ausschnittweise kopieren, wobei Sie
+noch eine Vielzahl von Manipulationsmöglichkeiten haben. 
+    Auch das Tragen von mehreren Sätzen in einem Arbeitsgang ist
+möglich. Dabei können Konsistenzbedingungen einer Datei überprüft
+werden. 
+    Als letztes erfahren Sie, wie man eine EUDAS-Datei automa­
+tisch nach einer beliebigen Vorschrift ändern kann. Hier, wie bei
+den vorherigen Funktionen, werden Sie zum ersten Mal erkennen,
+wieviel man mit der Programmiersprache ELAN innerhalb von EUDAS
+ohne viel Aufwand machen kann. 
+ 
+#a ("Kapitel 12")# Das nächste Kapitel zeigt Ihnen weitere Möglichkeiten
+zum Drucken. Sie können die Druckausgabe vor dem Drucken noch
+mit den Programmen der EUMEL-Textverarbeitung aufbereiten. Auch
+innerhalb der EUMEL-Textverarbeitung können Sie EUDAS aufrufen,
+um Daten aus einer EUDAS-Datei in den Text einzufügen. 
+    EUDAS kann auch in mehreren Spalten drucken (zum Beispiel
+für Etiketten). Schließlich wird noch beschrieben, wie Sie lange
+Felder auf mehrere Zeilen aufteilen können und welche speziellen
+Möglichkeiten Sie zur Erzeugung von Tabellen haben. 
+ 
+#a ("Kapitel 13")# Ab hier beginnt die Beschreibung dessen, was die
+Ausgabe des Druckgenerators so ungeheuer anpassungsfähig macht:
+die Verwendung der Programmiersprache ELAN. 
+    Mit einfachsten ELAN-Elementen können Sie komplizierte For­
+matierungswünsche erfüllen. Dazu können Sie den Inhalt von Feld­
+mustern durch vorherige Bearbeitung und durch die Abfrage von
+Bedingungen manipulieren. Ganze Musterteile können in Abhängig­
+keit von Bedingungen variabel gestaltet werden. 
+    Auch der Ablauf von Druckvorgängen kann von Bedingungen
+abhängig gemacht werden. So lassen sich gesteuert Vorspann und
+Nachspann innerhalb des Ausdrucks einfügen und Zwischenüber­
+schriften oder -summen bilden (Gruppenverarbeitung). 
+ 
+#a ("Kapitel 14 und 15")# Für denjenigen, der noch nie mit ELAN zu tun
+hatte, werden diese Möglichkeiten sicher nicht ganz einfach zu
+verstehen sein. Obwohl die vorherigen Kapitel viele benutzbare
+Beispiele enthalten, ist zur vollen Ausnutzung ein gewisses Ver­
+ständnis von ELAN notwendig. 
+    Dies soll in den Kapitel 14 und 15 vermittelt werden, und zwar
+in dem Umfang, in dem es in EUDAS nötig ist (Sie sollen hier nicht
+zum ELAN-Programmierer ausgebildet werden). Für den ELAN-
+Kenner bieten diese Kapitel sicher nichts Neues, aber sie enthalten
+viele Beispiele und Beschreibungen der Funktionen, die für EUDAS
+wichtig sind. 
+    Dabei geht Kapitel 15 weiter auf die Sprachmittel für Zählvor­
+gänge, Auswertungen und statistische Anwendungen ein, während in
+Kapitel 14 die grundlegenden Ausdrücke zur Formulierung von
+Manipulationen besprochen werden. 
+ 
+#a ("Kapitel 16")# Im letzten Kapitel geht es dann wieder harmloser zu.
+Hier werden die Funktionen beschrieben, die unter EUDAS zur
+allgemeinen Dateiverwaltung zur Verfügung stehen. Im Grunde sind
+dies alles Funktionen, die vom EUMEL-System zur Verfügung ge­
+stellt werden. EUDAS integriert sie lediglich in ein Menüsystem,
+damit Sie als Benutzer die Funktionen möglichst einfach aufrufen
+können. 
+    Aber auch dem erfahrenen EUMEL-Benutzer bieten die Funktio­
+nen einen zusätzlichen Komfort, da auch hier die praktische Aus­
+wahl durch Ankreuzen in allen Funktionen vertreten ist. Außerdem
+wird die Anzahl von Tastendrücken zum Erreichen eines Ziels ver­
+ringert. Daher besteht auch für den "Profi" keine Notwendigkeit,
+grundsätzlich mit einer Kommandoschnittstelle weiterzuarbeiten. 
+ 
+#a ("Referenzhandbuch")# Im Referenzhandbuch sind alle hier besproche­
+nen Funktionen noch einmal in einer sehr kurzen, zusammenfassen­
+den und abstrakten Form aufgeführt. Dort sollen Sie nachschlagen,
+wenn Sie eine ganz bestimmte Information suchen und sich mit
+EUDAS bereits auskennen. 
+    Sie können jedoch auch ohne das Referenzhandbuch auskommen,
+denn alles, was Sie wissen müssen, steht auch hier im Benutzer­
+handbuch. 
+    Das Referenzhandbuch enthält auch einen Teil, der sich spe­
+ziell an den ELAN-Programmierer wendet, der besondere Anwendun­
+gen mit EUDAS realisieren will. Allerdings sollten alle dort be­
+schriebenen Möglichkeiten mit Vorsicht betrachtet werden, da sie im
+Normalfall nicht so abgesichert sind, wie die hier beschriebenen
+Fähigkeiten. Auch sollten Sie mit den Einsatzmöglichkeiten von
+ELAN, wie sie in den Kapitel 11 und 13 beschrieben sind, wirklich
+alle praktischen Probleme erledigen können. 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.9 b/app/eudas/4.4/doc/user-manual/eudas.hdb.9
new file mode 100644
index 0000000..8294ca0
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.9
@@ -0,0 +1,534 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#page (83)# 
+#kapitel ("9", "Das", "virtuelle", "Dateikonzept")# 
+ 
+ 
+ 
+#abschnitt ("9.1", "KONZEPT", "Konzept")# 
+ 
+Bisher haben Sie zu einem Zeitpunkt immer nur eine EUDAS-Datei
+bearbeiten können. Wenn Sie zu einer anderen Datei wechseln woll­
+ten, mußten Sie die eine Datei sichern und die andere Datei wieder
+öffnen. Es gibt jedoch Fälle, in denen Beziehungen zwischen mehre­
+ren Dateien bestehen. Daher kann EUDAS auch mit mehreren Dateien
+gleichzeitig umgehen. 
+    Es hat jedoch Vorteile, wenn man nur mit einer Datei arbeitet.
+Sie müssen dann nicht immer den Namen der gewünschten Datei
+angeben, wenn Sie eine Funktion ausführen. Dies brauchen Sie nur
+einmal beim Öffnen zu tun - danach ist eindeutig festgelegt, wel­
+che Datei gemeint ist. 
+    EUDAS versucht diese Vorteile auch bei mehreren Dateien zu
+erhalten. Die verschiedenen Dateien werden so kombiniert, daß eine
+neue Datei entsteht. Sie arbeiten dann nur mit dieser Datei, die alle
+Daten der Einzeldateien enthält. 
+    Damit Sie aber nicht so lange warten müssen, geschieht dieser
+Kombinationsvorgang erst beim Ansehen. Die kombinierte Datei ist
+also nicht wirklich vorhanden, sondern ihre Einzelsätze werden nur
+bei Bedarf erzeugt. Daher heißt diese Gesamtdatei auch #on("i")#virtuelle#off("i")#
+(scheinbare) Datei. 
+    Eine Kombination von Dateien ist auf zwei Arten möglich. Sie
+können gleichartige Dateien hintereinander#on("i")#ketten#off("i")#, oder Sie können
+Dateien über gemeinsame Felder #on("i")#koppeln#off("i")#. Beide Methoden können
+auch kombiniert werden. 
+ 
+#a ("Änderungen")# Die virtuelle Datei kann auch verändert werden. Die
+Veränderungen werden dann in den entsprechenden Ursprungsda­
+teien vorgenommen. Es ist jedoch nicht immer eindeutig, wie diese
+Änderungen aussehen sollen. Achten Sie daher auf die speziellen
+Regeln, die bei solchen Änderungen gelten, damit Sie die Auswir­
+kungen einer Änderung abschätzen können. 
+    Wenn Sie Veränderungen vorgenommen haben, müssen Sie die
+Arbeitskopien anschließend wieder sichern. Denken Sie daran, daß
+EUDAS immer auf unbenannten Kopien arbeitet, wenn Sie ändern
+wollen. Beim Sichern von mehreren Dateien wird Ihnen zu jeder
+Datei einzeln angezeigt, ob sie tatsächlich verändert wurde. Sie
+können dann ebenfalls einzeln entscheiden, ob Sie die Datei sichern
+wollen oder nicht. 
+ 
+ 
+#abschnitt ("9.2", "KETTEN", "Ketten")# 
+ 
+Wenn Sie einmal EUDAS-Dateien mit mehreren tausend Sätzen er­
+stellen, werden Sie feststellen, daß deren Handhabung recht um­
+ständlich sein kann. Da die Datei sehr groß ist, dauern zum Beispiel
+Kopiervorgänge aufs Archiv viel länger als bei kleinen Dateien. 
+    Wenn Sie nun auch noch für jede kleine Änderung die Datei
+vom Archiv holen und anschließend wieder zurückschreiben müssen,
+werden Sie einen Weg suchen, diese Arbeit zu erleichtern. Die ein­
+fachste Möglichkeit wäre, einen schnelleren Rechner zu kaufen. Dies
+ist gleichzeitig aber auch die teuerste. 
+ 
+#beispiel# 
+#free (4.5)# 
+ 
+#center#Abb. 9-1   Verkettung von A und B 
+#text# 
+ 
+EUDAS ermöglicht es Ihnen nun, die große Datei in mehrere kleine
+aufzuspalten. In der Regel gibt es bei solch großen Dateien ein
+Kriterium, nach dem die Sätze in verschiedene Dateien verteilt
+werden können. Jede einzelne Datei kann nun bequem geändert
+werden. 
+    Ein Problem entsteht jedoch, wenn alle Dateien zusammen ver­
+arbeitet werden müssen (zum Beispiel beim Drucken). Für einen
+solchen Vorgang können Sie die kleineren Dateien logisch aneinan­
+derketten. 
+    Dies bedeutet für Sie, daß alle kleinen Dateien wie eine große
+Datei wirken. Wenn Sie beim Bewegen in der Datei das Ende einer
+einzelnen Datei erreichen, kommen Sie automatisch an den Anfang
+der nächsten Datei. 
+ 
+#a ("Aufruf")# Damit dies funktioniert, müssen die Dateien natürlich
+gleiche Feldstruktur haben. Außerdem ist die Zahl der verkettbaren
+Dateien aus technischen Gründen auf 10 beschränkt. 
+    Sie können die Dateien verketten, indem Sie die Funktion 
+#free (0.2)# 
+#beispiel# 
+        K Ketten 
+#text# 
+#free (0.2)# 
+im Menü 'Öffnen' aufrufen. 
+ 
+#a ("Änderungen")# In der virtuellen Datei ist sowohl Einfügen als auch
+Ändern erlaubt. Beim Einfügen ist jedoch zu beachten, daß am Ende
+einer Datei nicht angefügt werden kann. Dies liegt daran, daß Sie
+entweder vor dem letzten Satz der einen Datei oder vor dem ersten
+Satz der anderen Datei einfügen. Der Endesatz der einen Datei, der
+normalerweise sichtbar wäre, wird übersprungen. 
+    Am Ende der letzten Datei können Sie natürlich anfügen, da
+deren Endemarkierung als Ende der ganzen Datei ja wieder sichtbar
+ist. 
+ 
+ 
+#abschnitt ("9.3", "KOPPELN", "Koppeln")# 
+ 
+Nachdem das Verketten von Dateien noch ganz einfach zu verstehen
+war, kommt jetzt eine Funktion auf Sie zu, die kompliziertere Mög­
+lichkeiten in sich birgt: nämlich das Koppeln. 
+    Es kommt häufiger vor, daß sich ein Feld einer Datei auf einen
+bestimmten Satz in einer anderen Datei bezieht. So könnten zum
+Beispiel die Ausleihen einer Bücherei in folgender Datei gespeichert
+sein: 
+ 
+#beispiel# 
+        'Name' 
+        'Vorname' 
+        'Datum' 
+        'Buch-Nr.' 
+#text# 
+ 
+Wenn jetzt ein Ausleiher sein Rückgabedatum überschritten hat,
+möchte die Bücherei dem Kunden ein Mahnschreiben schicken. Auf
+diesem Schreiben soll aber nicht die Buch-Nr. erscheinen, sondern
+Autor und Titel des Buches. 
+    Diese Sekundärinformationen sind in einer anderen Datei ge­
+speichert, der Bestandskartei: 
+ 
+#beispiel# 
+        'Buch-Nr.' 
+        'Autor' 
+        'Titel' 
+        'Verlag' 
+#text# 
+ 
+Alle Dateistrukturen hier sind natürlich zwecks größerer Übersicht­
+lichkeit vereinfacht. Um jetzt dem Kunden das Mahnschreiben zu
+schicken, müssen die Informationen in den beiden Dateien korreliert
+werden. 
+ 
+#a ("Aufruf")# Zuerst wird die Ausleihdatei normal geöffnet. Dazu wird
+dann die Bestandsdatei mit Hilfe der Funktion 
+#free (0.2)# 
+#beispiel# 
+        K Koppeln 
+#text# 
+#free (0.2)# 
+gekoppelt. Dies hat folgenden Effekt: 
+    Die Sätze erscheinen normal so, wie sie in der Ausleihdatei
+auftauchen, also für jede Ausleihe genau ein Satz. Dazu erscheint
+aber jeweils die Beschreibung des ausgeliehenen Buches aus der
+Bestandsdatei: die beiden Dateien wurden über das Feld "Buch-Nr."
+gekoppelt. 
+    Als Struktur ergibt sich für die kombinierte Datei: 
+ 
+#beispiel# 
+        'Name' 
+        'Vorname' 
+        'Datum' 
+        'Buch-Nr.' 
+        'Titel' 
+        'Autor' 
+        'Verlag' 
+#text# 
+ 
+Die Felder der Koppeldatei wurden also noch hinzugefügt. 
+ 
+#a ("Koppelfelder")# Zwei Dinge sind in diesem Zusammenhang wichtig:
+Damit der Koppelvorgang ohne allzuviele Vorgaben auskommen kann,
+müssen Felder, über die gekoppelt wird, den gleichen Namen haben
+- und zwar exakt Zeichen für Zeichen. Zum zweiten muß ein solches
+#on("i")#Koppelfeld#off("i")# am Anfang der gekoppelten Datei (in unserem Fall der
+Bestandsdatei) stehen. Dies ist aus technischen Gründen notwendig,
+damit der Koppelvorgang in vernünftiger Geschwindigkeit ablaufen
+kann. 
+ 
+#beispiel# 
+#free (7.0)# 
+ 
+#center#Abb. 9-2   Schema des Koppelvorgangs 
+#text# 
+ 
+#a ("Mehrere Dateien")# Genau wie beim Ketten ist die Kombination der
+Dateien nicht physikalisch, sondern nur scheinbar vollzogen worden.
+Bis zum Limit der maximal geöffneten Dateien (10) können Sie auch
+weitere Dateien dazukoppeln. Die Koppelfelder dieser Dateien kön­
+nen sich jedoch immer nur auf die erste Datei beziehen, also nicht
+auf eine andere Koppeldatei. 
+    Dies könnte man in unserem Beispiel ausnutzen. Die Bücherei
+hat sicher auch eine Datei ihrer Mitglieder. Diese könnte etwa so
+aussehen: 
+ 
+#beispiel# 
+        'Name' 
+        'Vorname' 
+        'm/w' 
+        'Strasse' 
+        'PLZ' 
+        'Ort' 
+#text# 
+ 
+Diese Datei können wir ebenfalls zur Ausleihdatei dazukoppeln.
+Damit haben wir auch gleich die Quelle gewonnen, aus der wir die
+Anschrift für das Mahnschreiben gewinnen können. 
+    Die Kopplung geschieht in diesem Fall über zwei Felder, näm­
+lich 'Name' und 'Vorname'. Damit ein Mitglied eindeutig identifi­
+ziert wird, werden beide Namen gebraucht. Dies berücksichtigt auch
+das Koppelverfahren. Wiederum müssen die Namen exakt mit Namen
+der ersten Datei übereinstimmen. 
+    Wenn mehrere Koppelfelder für eine Koppeldatei notwendig sind,
+müssen Sie alle hintereinander stehen. Wäre die Struktur der Mit­
+gliederdatei etwa 
+ 
+#beispiel# 
+        'Name' 
+        'Titel' 
+        'Vorname' 
+        'm/w' 
+        'Strasse' 
+        'PLZ' 
+        'Ort' 
+#text# 
+ 
+würde nur über 'Name' gekoppelt, da 'Titel' in der ersten Datei
+nicht vorkommt. Alle weiteren Felder können dann keine Koppelfel­
+der mehr werden. Durch Umstellen der Feldreihenfolge der Koppel­
+datei (durch Umkopieren) oder durch entsprechende Benennung von
+Feldern können Sie immer den gewünschten Effekt erzielen. 
+ 
+#beispiel# 
+#free (8.0)# 
+ 
+#center#Abb. 9-3   Aufbau der virtuellen Datei 
+#text# 
+ 
+#a ("Zusammenfassung")# An dieser Stelle wollen wir die Ergebnisse die­
+ses Abschnitts als Regel zusammenfassen: 
+ 
+#limit (12.0)# 
+    Die ersten Felder der Koppeldatei, die wörtlich an be­
+    liebiger Stelle auch in der ersten Datei auftauchen,
+    werden Koppelfelder genannt. Zu einem Satz der ersten
+    Datei wird ein Satz der Koppeldatei gezeigt, der im In­
+    halt der Koppelfelder übereinstimmt. 
+#limit (13.5)# 
+ 
+Übersetzt in unser Beispiel heißt dies: 'Buch-Nr.' bzw. 'Name' und
+'Vorname' sind Koppelfelder. Zu einer bestimmten Ausleihe erschei­
+nen die Daten des Buches mit der angegebenen Buch-Nr. bzw. die
+Adresse des Mitgliedes mit den angegebenen Namen. 
+ 
+ 
+#abschnitt ("9.4", "AUSWIRKUNGEN DES KOPPELNS", "Auswirkungen des Koppelns")# 
+ 
+Nachdem Sie nun das Grundprinzip des Koppelns kennen, sollen Sie
+einige Auswirkungen dieses Verfahrens kennenlernen. 
+    Ein Beispiel dazu finden Sie in Abb. 9-4. Dargestellt sind je­
+weils die Satznummern und einige Inhalte. Die zweite Zeile in der
+Hauptdatei und die erste in der Koppeldatei stellen das Koppelfeld
+dar. 
+ 
+#beispiel# 
+#free (6.5)# 
+ 
+#center#Abb. 9-4   Kombinationen 
+#text# 
+ 
+#a ("Kombinationen")# Zuerst muß geklärt werden, was passiert, wenn es
+keinen passenden Satz in der Koppeldatei gibt. Zum Beispiel könnte
+eine Buchnummer eingegeben worden sein, die in der Bestandsdatei
+nicht existiert. In diesem Fall zeigt EUDAS für die Felder der Kop­
+peldatei einfach einen leeren Inhalt an (siehe Satz 23 der Haupt­
+datei, es gibt keinen Satz mit 'L' in der Koppeldatei). 
+    Wenn umgekehrt zu einem bestimmten Buch keine Ausleihe
+existiert, macht das natürlich nichts - das Buch erscheint nur
+dann, wenn Sie die Bestandsdatei alleine öffnen. 
+    Weiterhin kann es passieren, daß es zwei passende Sätze in der
+Koppeldatei gibt. Dies kommt dann vor, wenn zwei Mitglieder glei­
+chen Namen und gleichen Vornamen haben (was gar nicht so selten
+ist). In diesem Fall zeigt EUDAS beide Kombinationen an (siehe
+Satz 23 der Hauptdatei). Die Ausleihe erscheint also zweimal, je­
+weils mit einem anderen Mitglied. 
+    Damit man diesen Fall ohne weiteres erkennen kann, führt
+EUDAS bei Kopplungen zwei Nummern: zum einen die normale Satz­
+nummer und zum anderen eine Kombinationsnummer. In dem eben
+besprochenen Fall würde die Satznummer gleichbleiben, die Kombi­
+nationsnummer aber hochgezählt werden. Am Bildschirm wird die
+Kombinationsnummer durch Bindestrich getrennt hinter die Satz­
+nummer geschrieben, wenn Sie Dateien koppeln. 
+    Das Durchgehen aller Kombinationen zu einem Satz der Haupt­
+datei passiert aber nur dann, wenn Sie sich mit der Funktion 'Satz
+weiter' in der Datei bewegen. Wenn Sie rückwärts gehen oder auf
+einen bestimmten Satz positionieren, wird immer nur die erste Kom­
+bination angezeigt (Dies hat zum Teil technische Gründe). Beim
+Zurückgehen von Satz 23-1 in dem Beispiel würde also auf Satz
+22-1 positioniert und die Kombination 22-2 übersprungen. 
+ 
+#a ("Änderungen")# Auch wenn Sie Dateien gekoppelt haben, können Sie
+immer noch Sätze ändern und einfügen (wenn Sie dies beim Öffnen
+erlaubt haben). Die Auswirkungen der Veränderungen sind jedoch
+nicht mehr ganz so einfach wie bei geketteten Dateien, wo sich die
+Änderungen ja einfach auf den aktuellen Satz bezogen. 
+    Als Grundregel gilt, daß Änderungen möglichst wenig Auswir­
+kungen auf die Koppeldateien haben sollen. Das führt dazu, daß
+beim Einfügen eines neuen Satzes oder beim Entfernen eines Satzes
+durch Tragen keine Aktion in der Koppeldatei durchgeführt wird.
+Dies ist auch nicht nötig, denn wenn zum Beispiel ein neuer (zu­
+nächst leerer) Satz eingefügt wird, existiert sowieso noch kein
+passender Satz in der Koppeldatei und die entsprechenden Felder
+bleiben leer. Hingegen darf beim Entfernen eines Satzes der Satz in
+der Koppeldatei nicht entfernt werden, da er ja noch zu einem an­
+deren Satz gehören könnte. 
+    Änderungen an den Koppelfeldern können nun zu drei verschie­
+denen Reaktionen führen: 
+ 
+1.  Es wird kein Satz der Koppeldatei geändert, sondern nur ein
+    neuer passender Satz gesucht. Dies geschieht immer dann, wenn
+    außer den Koppelfeldern nur leere Inhalte für die Felder der
+    Koppeldatei angegeben sind. Nach dem Ändern oder Einfügen
+    werden dann die Inhalte des neuen Koppelsatzes angezeigt. 
+ 
+    Beispiel: Bei einer Ausleihe geben Sie Name und Vorname des
+    Ausleihers an, nicht aber seine Adresse. Wenn Sie den Satzedi­
+    tor beim Einfügen mit ESC 'q' verlassen, wird die zugehörige
+    Adresse angezeigt (falls der entsprechende Name in der Kop­
+    peldatei vorhanden ist). 
+ 
+2.  Es wird ein neuer Satz in der Koppeldatei angefügt. Dies ge­
+    schieht immer dann, wenn die Koppelfelder verändert wurden
+    und die anderen Felder der Koppeldatei nicht leer sind. Da­
+    durch soll verhindert werden, daß die Koppelfelder in einem
+    Satz verändert werden, der vielleicht noch zu einem anderen
+    Satz paßt. 
+ 
+    Beispiel: Sie geben bei einer Ausleihe auch die Adresse mit
+    an. Wenn eine Person mit gleichem Namen und Vornamen bereits
+    existiert, wird die dort gespeicherte Adresse nicht überschrie­
+    ben. Stattdessen wird die zweite Adresse auch in die Koppel­
+    datei eingetragen. Beim nächsten Ansehen bekommen Sie dann
+    zwei Adressen angezeigt. So wird verhindert, daß Sie ungewollt
+    die erste Adresse vernichten. 
+ 
+3.  Der Satz in der Koppeldatei wird verändert. Dies geschieht nur
+    dann, wenn die Koppelfelder unverändert geblieben sind, der
+    Rest sich aber geändert hat. 
+ 
+    Beispiel: Sie ändern eine Ausleihe mit der zugehörigen
+    Adresse. Sie geben nur eine neue Straße an und lassen Name
+    und Vorname unverändert. Der Satz in der Koppeldatei enthält
+    anschließend die neue Straße. 
+ 
+Da Koppeldateien keine Sortierung besitzen müssen, werden neue
+Sätze der Koppeldatei immer am Ende angefügt. Dies ist zu beach­
+ten, wenn die Koppeldatei auch allein verwendet werden soll. Ge­
+gebenenfalls müssen Sie die Koppeldatei dann erst sortieren. 
+ 
+ 
+#abschnitt ("9.5", "UMSCHALTEN AUF KOPPELDATEI", "Umschalten auf Koppeldatei")# 
+ 
+Häufig kommt es vor, daß Sie beim Einfügen eines neuen Satzes mit
+gekoppelten Dateien die Verbindung mit einem existierenden Satz
+der Koppeldatei erreichen wollen, aber den notwendigen Inhalt der
+Koppelfelder nicht auswendig wissen. 
+    So wollen Sie beim Eingeben einer Ausleihe Name und Vorname
+des Entleihers nicht immer wieder abtippen. Dabei ist auch die
+Gefahr von Eingabefehlern sehr groß. Stattdessen wollen Sie lieber
+erst den Entleiher in der Mitgliederdatei suchen und dessen Namen
+dann automatisch in den Entleihsatz übernehmen. 
+    Hierfür bietet Ihnen EUDAS eine Unterstützung an. 
+ 
+#a ("Ausführung")# Während Sie sich in der virtuellen Datei befinden,
+können Sie auf eine bestimmte Koppeldatei umschalten, die Sie dann
+wie eine Einzeldatei bearbeiten können. Beim Zurückschalten haben
+Sie dann die Möglichkeit, die Koppelfelder des gefundenen Satzes zu
+übernehmen. 
+    Das Umschalten bewirken Sie durch die Tastenkombination ESC
+'K' (großes K) nur im Menü 'Einzelsatz' sowie im Satzeditor beim
+Einfügen und Ändern. An anderen Stellen hat dieser Befehl keine
+Wirkung. Bei mehreren Koppeldateien werden Ihnen die Dateien der
+Reihenfolge nach angeboten. Durch Verneinung aller Fragen können
+Sie die Funktion ohne Wirkung beenden. 
+    Haben Sie nun umgeschaltet, wird Ihnen die Koppeldatei dar­
+geboten, als hätten Sie sie allein geöffnet. Sie können die Datei
+auch beliebig ändern (wenn Sie dies beim Öffnen angegeben haben).
+Nur die Anzeige #bsp ("<KOPPEL>")# in der Bildüberschrift zeigt an, daß Sie
+sich in einer Koppeldatei befinden. Sie können auch Funktionen in
+anderen Menüs aufrufen. 
+    Das Zurückschalten geschieht im Menü 'Einzelsatz' mit der
+gleichen Tastenkombination. Alle Einstellungen der virtuellen Datei
+von vorher bis auf die Feldauswahl bleiben erhalten. 
+    Wenn Sie nicht im Menü, sondern im Satzeditor (also beim
+Ändern oder Einfügen) umschalten, werden Sie zunächst wieder aus
+dem Satzeditor rausgeworfen. Sie können dann in der Koppeldatei
+den gewünschten Satz aufsuchen (oder neu eintragen). Beim Zurück­
+schalten werden Sie gefragt, ob Sie die Koppelfelder übernehmen
+wollen oder nicht. Danach kehren Sie automatisch wieder in den
+Satzeditor zurück, wobei jetzt die Koppelfelder gegebenenfalls aus­
+gefüllt oder überschrieben sind. 
+    Durch erneutes Umschalten können Sie den Vorgang auch für
+weitere Koppeldateien wiederholen. 
+    Die Position, die Sie beim Umschalten in der Koppeldatei einge­
+nommen haben, wird bis zum nächsten Umschalten gespeichert. Sie
+kommen dann zunächst wieder auf den gleichen Satz. So können Sie
+die gleichen Koppelfelder wie beim letzten Mal übernehmen, indem
+Sie einfach zweimal ESC 'K' tippen. 
+ 
+#a ("Beispiel")# Der typische Vorgang beim Entleihen würde dann wie folgt
+aussehen. Zunächst öffnen Sie die Entleihdatei mit Änderungser­
+laubnis; dann koppeln Sie die Mitgliederdatei und die Bestandsdatei
+dazu. 
+    Für eine neue Ausleihe rufen Sie zunächst die Funktion 'Ein­
+fügen' auf. Dann tippen Sie ESC 'K' und schalten auf die Mitglie­
+derdatei um. Dort suchen Sie das Mitglied und schalten wieder zu­
+rück. Existierte das Mitglied noch nicht, können Sie es gleich ein­
+tragen. Beim Zurückschalten übernehmen Sie den Namen des Mit­
+glieds. 
+    Dann tragen Sie die Nummer des Buches ein (die müssen Sie nur
+dann suchen, wenn Sie nicht auf dem Buch steht). Das Entleihdatum
+erhalten Sie mit Hilfe der Tastenkombination ESC 'D' (wird im näch­
+sten Kapitel beschrieben). 
+    Wollen Sie mehrere Ausleihen für ein Mitglied eintragen, so
+tippen Sie beim nächsten Einfügen einfach zweimal ESC 'K', ohne
+dazwischen eine Positionierung vorzunehmen. 
+ 
+ 
+#abschnitt ("9.6", "MEHRFACHBENUTZUNG", "Mehrfachbenutzung")# 
+ 
+EUDAS ermöglicht es mehreren Benutzern an einem Rechner, mit den
+gleichen Dateien zu arbeiten. Dies ist eigentlich nichts Besonderes,
+denn das EUMEL-System ist ja bereits von Haus aus dazu geeignet.
+Es müssen jedoch einige Schutzvorkehrungen getroffen werden,
+damit dadurch keine Probleme entstehen. 
+    Als Grundvoraussetzung für die Mehrfachbenutzung müssen
+EUDAS-Dateien in einer unabhängigen #on("i")#Managertask#off("i")# gespeichert
+sein. Eine Managertask kann man sich durch das Kommando 'global
+manager' einrichten. In dieser Task sollte dann nicht mehr gearbei­
+tet werden. 
+    Stattdessen kann sich der Benutzer Dateien aus dieser Mana­
+gertask kopieren und auch wieder dorthin zurückschreiben. Wie Sie
+dies im EUDAS-Menü bewerkstelligen können, wird im Kapitel 16
+beschrieben. Es sei nochmal betont, daß dies eine Methode ist, die
+Sie für beliebige Dateien verwenden können. 
+    Im Kapitel 16 ist weiterhin auch beschrieben, wie Sie solche
+Dateien mit #on("i")#Passworten#off("i")# schützen können, so daß sie nicht jeder
+benutzen kann. Schauen Sie bei Bedarf dort nach. 
+ 
+#beispiel# 
+#free (7.7)# 
+ 
+#center#Abb. 9-5   Mehrfachbenutzung 
+#text# 
+ 
+#a ("Konflikte")# Wir wollen uns jedoch jetzt um ein Problem kümmern, das
+bei dieser Art von Mehrfachbenutzung auftritt. Nehmen wir an,
+unsere Bücherei habe zwei Plätze, an denen Entleihen durchgeführt
+werden können. Beide Plätze sollen mit der gleichen Entleihdatei
+arbeiten (wie Sie gleich noch sehen werden und aus anderen Grün­
+den würde man EUDAS für eine solche Bücherei nicht einsetzen -
+wir wollen hier nur das Prinzip illustrieren). 
+    Der Ablauf wäre dann folgendermaßen. Jeder Platz kopiert sich
+für eine Entleihe die gemeinsame Datei aus der Managertask, öffnet
+sie, trägt die Entleihe ein und sichert die Datei wieder. Dann wird
+die Datei in die Managertask zurückgeschrieben, wo sie die alte
+Entleihdatei ersetzt. 
+    Abgesehen von dem viel zu hohen manuellen Aufwand kann der
+Fall eintreten, daß beide gleichzeitig eine Entleihe bearbeiten.
+Nehmen wir an, beide benutzen die Entleihdatei mit dem symboli­
+schen Inhalt A. Auf Platz 1 kommt noch die Entleihe B, auf Platz 2
+die Entleihe C dazu. Platz 1 will anschließend den Inhalt AB zu­
+rückschreiben, Platz 2 den Inhalt AC. 
+    Je nach der zeitlichen Reihenfolge wird nur eine der beiden
+Versionen übrigbleiben, da derjenige, der später zurücksichert, die
+vorherige Version überschreibt. Richtig sollte die endgültige Version
+ABC herauskommen. Unser Beispiel führt jedoch auf jeden Fall zu
+einer fehlerhaften Datei. 
+    Grund dafür ist, daß beim Zurückschreiben der ganzen Datei ein
+Platz gesperrt werden muß, während der andere Platz eine Datei
+zum Ändern angefordert hat. Man könnte auch dazu übergehen, nur
+einzelne Sätze zu übertragen; diese Methode wird jedoch von EUDAS
+wegen des hohen Aufwandes nicht unterstützt (daher würde man
+EUDAS eben auch nicht für eine Mehrplatz-Bücherei nehmen). 
+    In vielen Fällen reicht das Sperren ganzer Dateien jedoch aus,
+besonders, wenn nicht ganz so häufig an einzelnen Sätzen geändert
+wird. EUDAS bietet dafür neben der notwendigen Sperre auch noch
+eine automatische Versendung der Dateien an. 
+ 
+#a ("Manager")# Es bietet sich an, dieses Kopieren der Dateien beim Öff­
+nen (auch Koppeln und Ketten) und Sichern automatisch durchzu­
+führen. Als Voraussetzung dafür müssen Sie EUDAS angeben, mit
+welcher Managertask Sie arbeiten wollen. Dazu dient die Funktion 
+#free (0.2)# 
+#beispiel# 
+        M Manager 
+#text# 
+#free (0.2)# 
+im Menü 'Öffnen'. Sie werden dann nach dem Namen der Task ge­
+fragt. Geben Sie keinen Namen an, wird der Managermodus wieder
+ausgeschaltet. Welche Task als Manager eingestellt ist, sehen Sie in
+der untersten Bildschirmzeile. 
+    In der Task, die Sie angeben, muß EUDAS insertiert sein (oder
+in einem Vater), da sonst die Sperre nicht funktioniert. 
+    Wenn Sie nun einen solchen Manager angegeben haben, können
+Sie beim Öffnen Dateinamen aus dieser Task angeben. Auch bei ESC
+'z' werden Ihnen alle Namen aus dem Manager mit angeboten. Wenn
+Sie einen solchen Namen angeben, der nicht aus Ihrer eigenen Task
+stammt, wird die Datei vor dem Öffnen automatisch kopiert. Wenn
+Sie angegeben haben, daß Sie die Datei verändern wollen, wird in
+der Managertask eine entsprechende Sperre gesetzt. 
+    Wenn Sie die Datei nach Änderungen dann sichern, wird die
+geänderte Kopie zurückgeschrieben. Die Sperre wird jedoch erst
+dann aufgehoben, wenn Sie die Arbeitskopien endgültig löschen. 
+    Möchte nun ein anderer Benutzer diese Datei öffnen, während
+Sie sie ändern, kann er dies nur, wenn er sie nicht ändern will.
+Natürlich wird die Datei dann auch nicht wieder zurückgeschickt.
+Will er sie ändern, erhält er eine Fehlermeldung und kann den
+Versuch später wiederholen. 
+ 
+#a ("Vorsichtsmaßregeln")# Bedenken Sie, daß der Schutz nur wirksam sein
+kann, wenn Sie diesen Vorgang nicht unter Umgehung der Menü­
+steuerung ausführen. Würden Sie sich zum Beispiel eine Datei vom
+Manager holen (s. Kapitel 16), ohne daß Sie ein Änderungsvorhaben
+anmelden können, können Sie diese Datei ja trotzdem ändern und
+wieder zurückschicken. In diesem Fall hat EUDAS keine Kontrolle
+mehr über die Datei. 
+    Aus dem gleichen Grund sollten Sie sich die Managertask auch
+nicht an Ihren Bildschirm holen, denn auch dann könnten Sie ohne
+Kontrolle Änderungen durchführen (zudem kann der Manager wäh­
+rend dieser Zeit nicht auf andere Benutzer reagieren). 
+    Nur wenn Sie eine neue Datei im Manager anlegen, müssen Sie
+dies von Hand tun. Dazu erstellen Sie die Datei ganz normal und
+schreiben Sie mit der in Kapitel 16 beschriebenen Funktion zum
+Manager. Sie sollten jedoch darauf achten, daß dort nicht schon
+eine Datei gleichen Namens liegt (EUDAS fragt ja dann, ob über­
+schrieben werden soll). 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt b/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt
new file mode 100644
index 0000000..edd8709
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.inhalt
@@ -0,0 +1,172 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#kapitel (" ", " Inhalt", "", " ")# 
+ 
+ 
+ 
+#type ("12")# 
+      Vorwort  . . . . . . . . . . . . . . . . . . .  i 
+      Inhalt . . . . . . . . . . . . . . . . . . . .  iii 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("I.", "DIE ERSTEN SCHRITTE", "Die ersten Schritte")# 
+ 
+#type ("prop")# 
+#on("b")#1   Was kann EUDAS ?#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+1.1   Textverarbeitung und Datenverwaltung . . . . .  3 
+1.2   EUDAS als Karteikasten . . . . . . . . . . . .  5 
+1.3   Drucken  . . . . . . . . . . . . . . . . . . .  7 
+1.4   Grenzen  . . . . . . . . . . . . . . . . . . .  9 
+ 
+#type ("prop")# 
+#on("b")#2   Installation#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+2.1   Lieferumfang . . . . . . . . . . . . . . . . .  11 
+2.2   Single-User  . . . . . . . . . . . . . . . . .  12 
+2.3   Multi-User . . . . . . . . . . . . . . . . . .  13 
+ 
+#type ("prop")# 
+#on("b")#3   Ein Beispiel zum Ausprobieren#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+3.1   Start  . . . . . . . . . . . . . . . . . . . .  15 
+3.2   Daten eintragen  . . . . . . . . . . . . . . .  16 
+3.3   Daten abfragen . . . . . . . . . . . . . . . .  21 
+3.4   Drucken  . . . . . . . . . . . . . . . . . . .  22 
+3.5   Ergebnis . . . . . . . . . . . . . . . . . . .  24 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("II.", "EINFÜHRUNG IN DIE BENUTZUNG", "Einführung in die Benutzung")# 
+ 
+#type ("prop")# 
+#on("b")#4   Umgang mit Dateien und Menüs#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+4.1   EUDAS-Dateien  . . . . . . . . . . . . . . . .  27 
+4.2   EUDAS-Menüs  . . . . . . . . . . . . . . . . .  29 
+4.3   Archivmenü . . . . . . . . . . . . . . . . . .  32 
+4.4   Dateiverwaltung  . . . . . . . . . . . . . . .  37 
+4.5   Bedienungsregeln . . . . . . . . . . . . . . .  39 
+ 
+#type ("prop")# 
+#on("b")#5   Gespeicherte Daten abfragen#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+5.1   Öffnen . . . . . . . . . . . . . . . . . . . .  43 
+5.2   Bewegen  . . . . . . . . . . . . . . . . . . .  45 
+5.3   Suchen . . . . . . . . . . . . . . . . . . . .  46 
+5.4   Suchbedingungen  . . . . . . . . . . . . . . .  49 
+ 
+#type ("prop")# 
+#on("b")#6   Daten eingeben und ändern#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+6.1   Neue Datei einrichten  . . . . . . . . . . . .  51 
+6.2   Sätze einfügen . . . . . . . . . . . . . . . .  52 
+6.3   Daten ändern . . . . . . . . . . . . . . . . .  55 
+6.4   Arbeitskopie sichern . . . . . . . . . . . . .  56 
+ 
+#type ("prop")# 
+#on("b")#7   Ausdrucken der Daten#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+7.1   Druckmuster  . . . . . . . . . . . . . . . . .  61 
+7.2   Aufruf . . . . . . . . . . . . . . . . . . . .  64 
+7.3   Abschnitte . . . . . . . . . . . . . . . . . .  67 
+7.4   Feldmuster . . . . . . . . . . . . . . . . . .  69 
+ 
+#type ("prop")# 
+#on("b")#8   Was war und was noch kommt#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+8.1   Rückblick  . . . . . . . . . . . . . . . . . .  75 
+8.2   Ausblick . . . . . . . . . . . . . . . . . . .  76 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("III.", "WEITERE MÖGLICHKEITEN", "Weitere Möglichkeiten")# 
+ 
+#type ("prop")# 
+#on("b")#9   Das virtuelle Dateikonzept#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+9.1   Konzept  . . . . . . . . . . . . . . . . . . .  83 
+9.2   Ketten . . . . . . . . . . . . . . . . . . . .  84 
+9.3   Koppeln  . . . . . . . . . . . . . . . . . . .  85 
+9.4   Auswirkungen des Koppelns  . . . . . . . . . .  89 
+9.5   Umschalten auf Koppeldatei . . . . . . . . . .  92 
+9.6   Mehrfachbenutzung  . . . . . . . . . . . . . .  93 
+ 
+#type ("prop")# 
+#on("b")#10  Datenabfrage am Bildschirm#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+10.1  Feldauswahl  . . . . . . . . . . . . . . . . .  97 
+10.2  Satzeditor . . . . . . . . . . . . . . . . . .  98 
+10.3  Suchmuster . . . . . . . . . . . . . . . . . .  99 
+10.4  Markieren  . . . . . . . . . . . . . . . . . .  104 
+10.5  Übersicht  . . . . . . . . . . . . . . . . . .  105 
+ 
+#type ("prop")# 
+#on("b")#11  Funktionen zur Bearbeitung#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+11.1  Sortieren  . . . . . . . . . . . . . . . . . .  109 
+11.2  Kopieren . . . . . . . . . . . . . . . . . . .  112 
+11.3  Tragen . . . . . . . . . . . . . . . . . . . .  118 
+11.4  Automatische Änderungen  . . . . . . . . . . .  121 
+ 
+#type ("prop")# 
+#on("b")#12  Weitere Möglichkeiten zum Drucken#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+12.1  Anschluß an die Textverarbeitung . . . . . . .  123 
+12.2  Spaltendruck . . . . . . . . . . . . . . . . .  126 
+12.3  Modi . . . . . . . . . . . . . . . . . . . . .  128 
+ 
+#type ("prop")# 
+#on("b")#13  Programmierung von Druckmustern#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+13.1  Abkürzungen  . . . . . . . . . . . . . . . . .  133 
+13.2  Bedingte Musterteile . . . . . . . . . . . . .  141 
+13.3  Übersetzung  . . . . . . . . . . . . . . . . .  142 
+13.4  Gruppen  . . . . . . . . . . . . . . . . . . .  144 
+ 
+#type ("prop")# 
+#on("b")#14  Ausdrücke in ELAN#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+14.1  Was sind Ausdrücke ? . . . . . . . . . . . . .  151 
+14.2  Datentypen . . . . . . . . . . . . . . . . . .  152 
+14.3  TEXT-Funktionen  . . . . . . . . . . . . . . .  156 
+14.4  Rechenfunktionen . . . . . . . . . . . . . . .  160 
+14.5  Abfragen . . . . . . . . . . . . . . . . . . .  161 
+ 
+#type ("prop")# 
+#on("b")#15  Anweisungen in ELAN#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+15.1  Variablen und Zuweisungen  . . . . . . . . . .  165 
+15.2  Weitere Konstruktionen . . . . . . . . . . . .  168 
+ 
+#type ("prop")# 
+#on("b")#16  Dateiverwaltung mit EUDAS#off("b")# 
+#free (0.2)# 
+#type ("12")# 
+16.1  Dateien im System  . . . . . . . . . . . . . .  171 
+16.2  Dateien auf dem Archiv . . . . . . . . . . . .  174 
+ 
+ 
+#type ("prop")# 
+#abschnitt ("IV.", "ANHANG", "Anhang")# 
+ 
+#type ("12")# 
+      Register . . . . . . . . . . . . . . . . . . .  181 
+
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.macros b/app/eudas/4.4/doc/user-manual/eudas.hdb.macros
new file mode 100644
index 0000000..2def44f
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.macros
@@ -0,0 +1,66 @@
+#*format# 
+#limit (13.5)##start (3.5,2.5)##pagelength (21.0)##block# 
+#:firsthead (false)# 
+#linefeed (1.07)# 
+#*macro end# 
+#*text# 
+#type ("prop10")# 
+#linefeed (1.07)# 
+#*macro end# 
+#*beispiel# 
+#type ("12")# 
+#linefeed (0.97)# 
+#*macro end# 
+#*bildschirm# 
+#type ("17")# 
+#linefeed(0.83)# 
+#*macro end# 
+#*proc# 
+#type ("12")# 
+#*macro end# 
+#*endproc# 
+#free (0.1)# 
+#type ("prop10")# 
+#linefeed (1.0)# 
+#*macro end# 
+#*abschnitt ($1,$2,$3)# 
+#headodd# 
+#on("b")#$1#right#$3    %#off("b")# 
+#free (1.0)# 
+#end# 
+#on("b")##ib(9)#$1#ie(9,"   $3")# $2#off("b")# 
+#*macro end# 
+#*char($1)# 
+$1
+#*macro end# 
+#*kapitel ($1,$2,$3,$4)# 
+#free (1.3)# 
+#"nlq"# 
+#type("roman.24")# 
+#on("b")##center#$1#off("b")# 
+#free (0.2)# 
+#type ("roman.18")# 
+#on("b")##center#$2 #off("b")# 
+#on("b")##center# $3#off("b")# 
+#on("b")##center#$4#off("b")# 
+#type ("prop10")# 
+#free (0.6)# 
+#headeven# 
+#on("b")#%    $2 $3 $4#off("b")# 
+#free (1.0)# 
+#end# 
+#headodd# 
+#right##on("b")#%#off("b")# 
+#free (1.0)# 
+#end# 
+#*macro end# 
+#*f2# 
+#free (0.2)# 
+#*macro end# 
+#*a ($1)# 
+#on("b")#$1.#off("b")# 
+#*macro end# 
+#*bsp ($1)# 
+#type("12")#$1#type("prop")#
+#*macro end# 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.titel b/app/eudas/4.4/doc/user-manual/eudas.hdb.titel
new file mode 100644
index 0000000..022235c
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.titel
@@ -0,0 +1,73 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#free (6.0)# 
+#type ("roman.18")# 
+#on("b")#EUDAS#off("b")# 
+#free (1.0)# 
+#type ("roman.14")# 
+#on("b")#Anwender-#off("b")# 
+#on("b")#Datenverwaltungssystem#off("b")# 
+#free (2.0)# 
+#type ("10")# 
+#on ("b")#VERSION 4#off("b")# 
+#free(1.0)# 
+#on("u")#                                                    #off("u")# 
+#free (0.5)# 
+#on("b")#BENUTZERHANDBUCH#off("b")# 
+#type ("prop")##block# 
+#page# 
+#free (12.0)# 
+Ausgabe Juli 1987 
+ 
+Dieses Handbuch und das zugehörige Programm sind urheberrechtlich
+geschützt. Die dadurch begründeten Rechte, insbesondere der Ver­
+vielfältigung in irgendeiner Form, bleiben dem Autor vorbehalten. 
+ 
+Es kann keine Garantie dafür übernommen werden, daß das Pro­
+gramm für eine bestimmte Anwendung geeignet ist. Die Verantwor­
+tung dafür liegt beim Kunden. 
+ 
+Das Handbuch wurde mit größter Sorgfalt erstellt. Für die Korrekt­
+heit und Vollständigkeit der Angaben wird aber keine Gewähr über­
+nommen. Das Handbuch kann jederzeit ohne Ankündigung geändert
+werden. 
+ 
+(c) Copyright 1987  Thomas Berlage 
+                    Software-Systeme 
+                    Im alten Keller 3 
+#free (0.1)# 
+                    D-5205 Sankt Augustin 1 
+#page# 
+#type ("roman.24")# 
+#free (7.0)# 
+#center##on("b")#I.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#DIE#off("b")# 
+#center##on("b")#ERSTEN#off ("b")# 
+#center##on("b")#SCHRITTE#off("b")# 
+#page# 
+#type ("roman.24")# 
+#free (7.0)# 
+#center##on("b")#II.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#EINFÜHRUNG#off("b")# 
+#center##on("b")#IN DIE#off ("b")# 
+#center##on("b")#BENUTZUNG#off("b")# 
+#page# 
+#free (7.0)# 
+#type ("roman.24")# 
+#center##on("b")#III.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#WEITERE#off("b")# 
+#center##on("b")#MÖGLICHKEITEN#off("b")# 
+#page# 
+#free (7.0)# 
+#type ("roman.24")# 
+#center##on("b")#IV.#off("b")# 
+#free (1.0)# 
+#type ("roman.18")# 
+#center##on("b")#ANHANG#off("b")# 
+
diff --git a/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort b/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort
new file mode 100644
index 0000000..2b372b4
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/eudas.hdb.vorwort
@@ -0,0 +1,59 @@
+#type ("prop")##limit (14.0)# 
+#format# 
+#kapitel (" ", " Vorwort", "", " ")# 
+ 
+ 
+ 
+Lieber EUDAS-Benutzer ! 
+ 
+Dieses Handbuch soll Sie bei Ihrer Arbeit mit EUDAS begleiten. Ob­
+wohl EUDAS nicht schwierig zu bedienen ist, gibt es doch eine Reihe
+von Dingen zu lernen, ehe Sie ein EUDAS-Spezialist geworden sind. 
+    Um Ihnen diesen Weg möglichst einfach zu machen, ist die
+EUDAS-Dokumentation in zwei Handbücher aufgeteilt. Dies ist das
+#on("b")#Benutzerhandbuch#off("b")#, das Ihnen eine gut lesbare Einführung in alle
+Fähigkeiten von EUDAS bieten soll. Außerdem gibt es noch das
+#on("b")#Referenzhandbuch#off("b")#, das Ihnen zum Nachschlagen und als Hilfe beim
+Programmieren dienen soll. 
+ 
+    Bis Sie EUDAS gut beherrschen, sollten Sie sich also mit dem
+Benutzerhandbuch beschäftigen. Das Benutzerhandbuch ist nochmal
+in drei Teile aufgeteilt, um Ihnen das Lernen zu erleichtern. In
+jedem Teil werden die vorher behandelten Dinge zyklisch wieder
+aufgenommen und auf höherem Niveau erweitert. 
+    Der allererste Teil des Handbuchs umfaßt nur drei Kapitel und
+soll Ihnen über den ersten Tag mit EUDAS hinweghelfen. Dort finden
+Sie eine Übersicht, was Sie mit EUDAS anfangen können, wie Sie das
+Programm auf Ihrem Rechner installieren und ein kurzes Beispiel
+zum Ausprobieren. 
+    Im zweiten Teil lernen Sie dann die Grundkonzepte von EUDAS
+anhand von zahlreichen Beispielen kennen. Sie sollten die Beispiele
+am Rechner ausprobieren und ihre Bedeutung verstehen. Nach dem
+Durcharbeiten dieses Teils (was höchstens wenige Tage in Anspruch
+nimmt) sind Sie dann in der Lage, EUDAS für eigene Zwecke anzu­
+wenden. 
+    Wenn Ihre Ansprüche dann wachsen, sollten Sie sich mit dem
+dritten Teil befassen. Hier erhalten Sie Einblick in weitergehende
+Möglichkeiten von EUDAS. Die einzelnen Kapitel sind relativ unab­
+hängig voneinander, so daß Sie nur die für Sie interessanten
+genauer durchlesen müssen. 
+   In Kapitel 8 finden Sie als Orientierung nicht nur eine Wieder­
+holung dessen, was Sie im zweiten Teil gelernt haben sollten, son­
+dern auch eine Übersicht, welche weiteren Möglichkeiten im dritten
+Teil noch beschrieben werden. 
+ 
+    Im Referenzhandbuch finden Sie später, wenn Sie einige Erfah­
+rung gesammelt haben, eine genaue Beschreibung der Wirkungsweise
+aller Funktionen. Um diese zu verstehen, sollten Sie jedoch bereits
+eine grobe Ahnung der Wirkungsweise haben. 
+    Als zweites finden Sie im Referenzhandbuch Informationen für
+Programmierer, die EUDAS-Funktionen in eigenen Programmen ver­
+wenden wollen. Dies sollte jedoch in den meisten Fällen nicht not­
+wendig sein, so daß dieser Teil für Spezialisten reserviert bleibt. 
+ 
+    Trotz größter Bemühungen kann das Handbuch natürlich nicht
+frei von Unklarheiten und Fehlern sein. Anregungen und Kritik sind
+daher dringend erwünscht, um diese Dokumentation zu verbessern. 
+ 
+Und nun viel Spaß bei Ihrer Arbeit mit EUDAS ! 
+
diff --git a/app/eudas/4.4/doc/user-manual/register b/app/eudas/4.4/doc/user-manual/register
new file mode 100644
index 0000000..59e47df
--- /dev/null
+++ b/app/eudas/4.4/doc/user-manual/register
@@ -0,0 +1,482 @@
+#type ("prop")##limit (6.5)# 
+#format# 
+#page (181)# 
+#kapitel (" ", "Register ", "", " ")# 
+ 
+ 
+ 
+#columns (2, 0.5)# 
+#limit (6.5)# 
+#bsp("%")# 63, 69, 148 
+#bsp("%%")# 141 
+#bsp("&")# 63, 69, 103, 148 
+#bsp("<!>")# 57 
+#bsp("--")# 103 
+#bsp("..")# 102 
+#bsp(".a$")# 65 
+#bsp("'+'")# 107 
+#bsp("'-'")# 107 
+ 
+Abbruch 35 
+Abkürzungen 133 
+Abkürzungsteil 134, 140 
+Absatzmarken 125, 129 
+Abschlußzeile 45 
+Abschneiden 71 
+Abschnitt 67, 69, 134 
+Alternative 99 
+  -, globale 100 
+  -, lokale 99 
+AND 162 
+Ändern 55 
+Änderungen 83, 85, 90, 95 
+  -, automatisch 121 
+Änderungsmuster 121, 166 
+Anführungsstrich 27, 34 
+Ankreuzen 36, 40 
+Anrede 138 
+Anweisung 63 
+  -, Textkosmetik 74 
+Anzeige 44 
+  -, rollen 97 
+Arbeitsbereich 16 
+Arbeitskopie 56, 84, 173 
+  -, Beispiel 58 
+  -, löschen 57 
+Arbeitstask 16 
+Archiv 32 
+  -, anmelden 34 
+  -diskette 36 
+  -, lesen 34 
+  -, löschen 176 
+  -manager 175, 177 
+  -menü 33, 174 
+  -name 34, 36 
+  -, schreiben 36 
+  -übersicht 175 
+Arithmetik 161 
+Attribut 4, 29 
+Aufräumen 173 
+Ausdrucken 66 
+Ausdrücke 116, 151 
+  -, Zusammensetzung 152 
+Ausgabedatei 66 
+Ausgaberichtung 65 
+Auswahlzustand 36, 40 
+Automatische Änderungen 121 
+ 
+Bedienungsregeln 39 
+begin 16 
+Benutzerhandbuch i 
+Berechnungen 8 
+Bewegen 45 
+Bildschirmaufbau 45 
+Bitte warten 34, 40 
+blättern 46 
+BOOL 154, 162 
+ 
+Carriage Return 15 
+CAT 167 
+CONST 155 
+CR 15 
+Cursor 35, 46 
+  -tasten 54 
+ 
+date 137 
+Datei 27 
+  -arten 27 
+  -, aufräumen 173 
+  -auswahl 36 
+  -größe, Begrenzung 124 
+  -, kopieren 172 
+  -limit 71 
+  -, löschen 38, 172 
+  -namen 172 
+  -, Platzbedarf 173 
+  -, reorganisieren 174 
+  -sperre 95 
+  -, umbenennen 172 
+  -verwaltung 37 
+  -, virtuelle 83 
+Dateien, Archiv 174 
+  - (Menü) 38, 171 
+  -, System 171 
+DATEIENDE 106 
+Daten, ändern 55 
+  -, anzeigen 44 
+  -, sichern 33 
+  -typen 152 
+  -typen, umwandeln 154 
+  -verwaltung 3 
+Datum 44, 99, 133, 137 
+DATUM 112 
+DECR 167 
+Denotation 154 
+Dezimalkomma 111, 161 
+Dezimalpunkt 148 
+DIN 112 
+Diskette 28, 32 
+  -, formatieren 176 
+  -, initialisieren 176 
+Diskettenlaufwerk 175 
+Doppeleinträge 121 
+DOS 178 
+Druckausgabe, Bearbeitung 125 
+Drucken 7, 61 
+  -, Ablauf 66 
+  -, Aufruf 64, 66 
+  - (Menü) 22, 65 
+  -, Übersicht 175 
+Druckersteuerungsanweisungen
+   74, 124 
+Druckmuster 13, 23, 61, 166 
+  -, Fehler 134 
+  -, Übersetzung 134, 142 
+  -, Zeilenlänge 71 
+Druckrichtung 123 
+Druckverfahren 62 
+ 
+Editieren 64 
+Editor 34, 41, 52, 125 
+eindeutige felder 121 
+Einfügen 18, 52 
+Eingabe, Daten 52 
+  -, Suchmuster 46 
+Eingabeüberprüfung 112 
+Eingabezustand 35, 40 
+Eingangsmenü 17 
+Einzelsatz (Menü) 18, 44, 92, 97 
+ELAN-Anweisungen 141 
+ELAN-Ausdrücke 116, 151 
+ELAN-Compiler 134 
+ELIF 168 
+ELSE 139 
+ENDE 45 
+Endesatz 45, 48, 53, 85 
+ENTER 15 
+ESC '1' 107 
+ESC '?' 31, 39, 40 
+ESC '9' 107 
+ESC 'D' 99 
+ESC ESC 41, 111 
+ESC 'F' 67 
+ESC 'g' 99 
+ESC 'h' 35, 39, 40, 55, 107 
+ESC 'K' 92 
+ESC OBEN 97 
+ESC 'p' 99 
+ESC 'P' 118 
+ESC 'q' 32ff.,40 , 47, 65, 107 
+ESC RUBIN 54 
+ESC RUBOUT 54 
+ESC UNTEN 97 
+ESC 'w' 32, 40, 53 
+ESC 'z' 32, 36, 40, 95 
+Etiketten 126 
+eudas 30, 125 
+EUDAS-Archivdiskette 11, 29 
+EUDAS-Datei 27, 61, 171 
+  -, drucken 61 
+  -, einrichten 17, 51 
+  -, Grenzen 29 
+  -, kopieren 113 
+  -, Mehrfachbenutzung 93 
+  -, Struktur 28 
+EUDAS, Aufruf 30 
+  -, Installation 11 
+  -, Start 15 
+  -, Verlassen 24, 32 
+EUMEL-Netz 175 
+EUMEL-Textverarbeitung 5 
+EUMEL-Zeichencode 110 
+ 
+f 117, 134, 156 
+FALSE 154 
+Fehler, Druckmuster 66 
+  -, quittieren 36 
+  -zustand 35, 40 
+Feld 29 
+Feldauswahl 97, 106 
+Felder, anfügen 111, 114 
+Feldinhalt 29, 156, 160 
+feldmaske 120 
+Feldmuster 63, 69 
+Feldmustertypen 71 
+Feldnamen 29, 67 
+  -, abfragen 67 
+  -, Abgrenzung 72 
+  -, ändern 112 
+  -, eingeben 51 
+  -, Länge 133 
+Feldreihenfolge 113 
+Feldstruktur 111 
+Feldteil 45 
+Feldtypen 110, 154 
+  -, ändern 111 
+Feldvergleich 103 
+Formatieren 177 
+Formbrief 74 
+Formular 8, 44 
+Fragezustand 38, 40 
+Funktionen 152 
+  -, ausführen 31, 46 
+  -, auswählen 30 
+  -, gesperrt 31 
+Fußzeile 44 
+ 
+Gib Kommando 41, 11 
+global manager 93 
+GRUPPE 145 
+Gruppen 144 
+  -definition 145 
+  -, mehrere 145 
+  -wechsel 145 
+gruppenwechsel 145 
+ 
+halt 39, 110 
+Hardwarefehler 33 
+Hauptdatei 87ff. 
+Hilfe 31 
+Hilfezustand 31, 40 
+Hilfstexte 13, 31 
+Hintergrunddiskette 12 
+Hintergrundengpaß 124 
+Holen 56 
+HOP OBEN 40, 98, 106 
+HOP RETURN 106 
+HOP RUBIN 54 
+HOP RUBOUT 54 
+HOP UNTEN 40, 98, 106 
+HOP 'x' 98 
+ 
+IF 117 
+IF-Abfragen 161, 168 
+IF-Anweisungen 138 
+INCR 167 
+Init 176 
+Initialisierungsteil 124, 143 
+Installation 11 
+int 140 
+INT 153 
+ 
+K 113 
+Karteikarten 5 
+KB 173 
+Ketten 13, 83, 85, 95 
+Kilobyte 173 
+Klammern 163 
+  -, spitze 72 
+Kombination 89 
+Kombinationsnummer 90 
+Kopieren, logisch 172 
+  -, EUDAS-Datei 112 
+  - (vom Archiv) 34, 176 
+Kopieranweisung 113 
+Kopiermuster 113, 115, 166 
+  -, Übersetzung 116 
+KOPPEL 92 
+Koppeldatei, Markierung 105 
+  -, Position 93 
+  -, umschalten 92 
+Koppelfeld 86, 89 
+  -, übernehmen 92 
+Koppeln 13, 83, 85, 95 
+  -, mehrere Dateien 87 
+Koppelvorgang, Schema 87 
+Korrekturversion 14 
+ 
+Länge, feste 70, 137 
+  -, variable 70 
+Leerautomatik 73 
+Leertaste 17, 31 
+length 158 
+lfd nr 137, 157 
+limit 71, 125 
+lineform 125, 129 
+LINKS 31, 35 
+linksbündig 71 
+Linksschieben 128 
+list (archive) 34 
+Löschen 55 
+  - (auf Archiv) 176 
+  - (Datei) 172 
+ 
+Manager 93, 95 
+Managertask 175 
+MARK 104 
+Markieren 104 
+  -, in Übersicht 107 
+Markierung 104 
+  -, löschen 105 
+maxdruckzeilen 124 
+MEHR 129 
+Mehrfachbenutzung 93 
+Menü 30 
+Menüzustand 31, 40 
+min 155 
+Modi 128 
+Multi-User 12 
+Multi-User-System 16 
+Musterbrief 139 
+Musterteil 135 
+Musterzeichen 70 
+ 
+Nachbearbeitung 125 
+Nachspann 68, 144 
+NACHSPANN 68 
+Negation 103 
+Netz 175 
+Numerieren 137 
+ 
+'o' 40, 98 
+OBEN 30, 106 
+ODER 100 
+Öffnen 17, 21, 43, 51, 57, 83, 95 
+  - (Menü) 30 
+Operatoren 152, 155 
+  -, Priorität 163 
+OR 163 
+ 
+pageform 125 
+Paralleleditor 67, 142 
+Parameter 152 
+Paßwort 94, 177 
+Pfeiltasten 54 
+Platzbedarf, Datei 173 
+pos 159 
+Position, feste 69 
+  -, variable 69 
+Positionierung 48 
+Proportionalschrift 129 
+Prüfbedingungen 118 
+pruefe 120 
+PUBLIC 13 
+ 
+REAL 153 
+real 155 
+RECHTS 31, 55 
+rechtsbündig 71, 137 
+Referenzhandbuch i, 79 
+Refinement 134, 140, 163 
+Reorganisieren 174 
+Reservieren 178 
+RET 15 
+RETURN 15 
+Richtung, Druckausgabe 65, 123 
+Rollen 97, 106 
+RUBIN 35, 54 
+RUBOUT 35, 54 
+Runden 160 
+ 
+Satz 29 
+  -, anwählen 46 
+  -editor 41, 47, 53, 92, 98 
+  -, einfügen 52 
+  -, holen 56 
+  -, löschen 55 
+  -, tragen 55 
+Satz.Nr 46, 48 
+Satznummer 45, 90 
+Satzauswahl, kopieren 114 
+Schreiben (auf Archiv) 36, 176 
+Schreibmarke 35 
+Schrifttypen 125 
+Selektion 48 
+Sichern 20, 56, 84, 95 
+Single-User 12 
+Single-User-System 16 
+Sortieren 109 
+  -, Optimierung 110 
+  -, Zieldatei 115 
+Sortierreihenfolge 109 
+Spaltenbreite 126 
+Spaltendruck 126 
+Speicherplatz 14, 38, 176 
+  -, Datei 173 
+Sperren von Dateien 95 
+Standard-Kopiermuster 115 
+Stationsnummer 175 
+Statistik 169 
+Statuszeile 31, 39 
+Stern 50, 101 
+SUB 158, 163 
+subtext 158 
+SUCH 47 
+Suchbedingung f. Drucken 67 
+Suchbedingung, Kombination 49 
+Suchbedingung löschen 48 
+Suchbedingung setzen 46 
+Suchen 21, 46 
+  -, Optimierung 104 
+Suchmuster 47, 99 
+  -, Eingabe 47 
+SV-Taste 16, 39 
+System 32 
+ 
+Tabellenmodus 128 
+Tagesdatum 99 
+Task, Manager 93 
+Tasks 13 
+Teildatei 114 
+Teiltexte 158 
+TEXT 112, 153 
+text 140 
+Textdatei 28, 61, 171 
+  -, ändern 65 
+  -, ansehen 65 
+  -, ausdrucken 66 
+  -, editieren 64 
+Texte, verketten 156 
+Text-Funktionen 156 
+Textkonstanten 139 
+Text, konstanter 117 
+Text, Länge 158 
+Textverarbeitung 3, 123 
+THEN 139 
+Tragen 55, 118 
+TRUE 154 
+ 
+Uhrzeit 133 
+Umbruch 129 
+Umlaute 143 
+Umschalten auf Koppeldatei 92 
+UND 100ff. 
+UNTEN 30, 106 
+Überschrift 45, 68 
+Übersicht (Archiv) 34, 175 
+  - (Dateien) 37, 171 
+  - (Sätze) 105 
+ 
+V 122 
+VAR 165 
+Variablen 165 
+  -, Initialisierung 143, 167 
+  -, Lebensdauer 166 
+  -, Typ 165 
+Verändern 121 
+Vergleiche 102, 162 
+virtuelle Datei 83 
+Vorspann 68, 144 
+VORSPANN 68 
+ 
+Weiter 45, 48, 90 
+wert 148, 160 
+wertemenge 119 
+WIEDERHOLUNG 63, 126 
+ 
+'x' 36, 40 
+ 
+ZAHL 110 
+zahltext 148, 160 
+Zeichen, reservierte 64, 69, 103 
+Zeigen 40 
+Zeile einfügen 54 
+Zeilenfortsetzung 129 
+Zeilenlänge 71 
+Zielarchiv 175 
+Zieldatei, Struktur 113 
+Zurück 45, 48, 90 
+Zustand 31, 40 
+Zuweisung 166 
+ 
+
diff --git a/app/eudas/4.4/source-disk b/app/eudas/4.4/source-disk
new file mode 100644
index 0000000..5777895
--- /dev/null
+++ b/app/eudas/4.4/source-disk
@@ -0,0 +1,3 @@
+eudas/eudas-4_refdoc_1987-09.img
+eudas/eudas-4_userdoc_1987-07.img
+eudas/eudas-4.4_1987-10-01.img
diff --git a/app/eudas/4.4/src/eudas.dateistruktur b/app/eudas/4.4/src/eudas.dateistruktur
new file mode 100644
index 0000000..b4a57e5
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.dateistruktur
@@ -0,0 +1,1690 @@
+PACKET eudas dateien
+
+(*************************************************************************)
+(*                                                                       *)
+(*     EUDAS-Dateien als indexsequentielle Dateien                       *)
+(*                                                                       *)
+(*     Version 05                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 25.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  EUDAT,
+(*dump,   Test *)
+  oeffne,
+  satznr,
+  dateiende,
+  saetze,
+  auf satz,
+  weiter,
+  zurueck,
+  satz lesen,
+  satz aendern,
+  satz loeschen,
+  satz einfuegen,
+  feld lesen,
+  feld aendern,
+  feld bearbeiten,
+  felderzahl,
+  feldnamen lesen,
+  feldnamen aendern,
+  notizen lesen,
+  notizen aendern,
+  feldinfo,
+  automatischer schluessel,
+  dezimalkomma,
+  wert berechnen,
+  reorganisiere,
+  sortiere,
+  sortierreihenfolge,
+  unsortierte saetze :
+
+
+LET
+  maxhash = 531,
+  maxindex = 121,
+  maxsatz = 5000,
+  eudat typ = 3243,
+  maxeintrag = 64,
+  dreiviertel maxeintrag = 48;
+
+LET
+  INTVEC = TEXT,
+
+  INDEX = STRUCT
+    (INT vorgaenger, nachfolger,
+    INT eintraege, stelle,
+    INTVEC satzindex),
+
+  EINTRAG = STRUCT
+    (INT vorgaenger, nachfolger, indexblock, attribut,
+    SATZ satz),
+
+  DATEI = STRUCT 
+    (INT felderzahl,
+    SATZ feldnamen,
+    INTVEC feldinfo,
+    TEXT sortierfelder,
+    INT letzter index, indexblocks, erster leerindex,
+    INT erster leersatz, anz satzeintraege,
+    INT anz saetze, satznr,
+    INT indexzeiger, indexstelle, satzzeiger,
+    INT anz unsortierte, schluesselzaehler,
+    ROW 3 TEXT notizen,
+    ROW maxhash INT hashliste,
+    ROW maxindex INDEX index,
+    ROW maxsatz EINTRAG ablage);
+
+TYPE EUDAT = BOUND DATEI;
+
+LET
+  niltext = "";
+
+LET
+  datei ist keine eudas datei =  #201#
+    "Datei ist keine EUDAS-Datei",
+  inkonsistente datei =  #202#
+    "inkonsistente EUDAS-Datei",
+  eudas datei voll =  #203#
+    "EUDAS-Datei voll",
+  nicht erlaubtes dezimalkomma =  #204#
+    "Nicht erlaubtes Dezimalkomma";
+
+TEXT VAR
+   feldpuffer;
+
+TEXT VAR
+  inttext := "  ";
+
+INTVEC CONST
+  blockreservierung := intvec (maxeintrag, 1);
+
+
+(*************************** Test-Dump ***********************************)
+(*
+PROC dump (EUDAT CONST datei, TEXT CONST file) :
+
+  FILE VAR f := sequential file (output, file);
+  idump (CONCR (datei), f)
+
+END PROC dump;
+
+PROC idump (DATEI CONST datei, FILE VAR f) :
+
+  put (f, "Felderzahl:"); put (f, datei. felderzahl); line (f);
+  INT VAR i; putline (f, "feldnamen:");
+  FOR i FROM 1 UPTO felderzahl (datei. feldnamen) REP
+    TEXT VAR feld; feld lesen (datei. feldnamen, i, feld);
+    write (f, feld); write (f, ",")
+  END REP; line (f); putline (f, "feldinfo:");
+  FOR i FROM  1 UPTO length (datei. feldinfo) DIV 2 REP
+    put (f, datei. feldinfo ISUB i)
+  END REP; line (f);
+  put (f, "letzter index:"); put (f, datei. letzter index);
+  put (f, "indexblocks:"); put (f, datei. indexblocks);
+  put (f, "erster leerindex:"); put (f, datei. erster leerindex); line (f);
+  put (f, "erster leersatz:"); put (f, datei. erster leersatz);
+  put (f, "anz satzeintraege:"); put (f, datei. anz satzeintraege); line (f);
+  put (f, "anz saetze:"); put (f, datei. anz saetze);
+  put (f, "satznr:"); put (f, datei.satznr); line (f);
+  put (f, "indexzeiger:"); put (f, datei. indexzeiger);
+  put (f, "indexstelle:"); put (f, datei. indexstelle);
+  put (f, "satzzeiger:"); put (f, datei. satzzeiger); line (f);
+  put (f, "anz unsortierte:"); put (f, datei. anz unsortierte); line (f);
+  ROW 10 INT VAR anzahl ketten;
+  FOR i FROM 1 UPTO 10 REP anzahl ketten (i) := 0 END REP;
+  FOR i FROM 1 UPTO maxhash REP
+    INT VAR laenge := 0;
+    laenge der hashkette bestimmen;
+    IF laenge > 10 THEN laenge := 10 END IF;
+    IF laenge > 0 THEN anzahl ketten (laenge) INCR 1 END IF
+  END REP;
+  put (f, "Hash:");
+  FOR i FROM 1 UPTO 10 REP put (f, anzahl ketten (i)) END REP; line (f);
+  FOR i FROM 1 UPTO datei. indexblocks REP
+    put (f, "INDEX"); put (f, i); put (f, "vor:"); put (f,
+    datei. index (i). vorgaenger); put (f, "nach:"); put (f, 
+    datei. index (i). nachfolger); put (f, "eintraege:"); put (f,
+    datei. index (i). eintraege); line (f); INT VAR j;
+    FOR j FROM 1 UPTO length (datei. index (i). satzindex) DIV 2 REP
+      put (f, datei. index (i). satzindex ISUB j)
+    END REP;
+    line (f)
+  END REP;
+  FOR i FROM 1 UPTO datei. anz satzeintraege REP
+    put (f, "SATZ"); put (f,i); put (f, "vor:"); put (f,
+    datei. ablage (i). vorgaenger); put (f, "nach:"); put (f,
+    datei. ablage (i). nachfolger); put (f, "index:"); put (f,
+    datei. ablage (i). indexblock); put (f, "attr:"); put (f,
+    datei. ablage (i). attribut); line (f);
+    FOR j FROM 1 UPTO felderzahl (datei. ablage (i). satz) REP
+      feld lesen (datei. ablage (i). satz, j, feld); 
+      write (f, feld); write (f, ",")
+    END REP; cout (i);
+    line (f)
+  END REP .
+
+laenge der hashkette bestimmen :
+  INT VAR index := datei. hashliste (i);
+  WHILE index <> 0 REP
+    index := datei. ablage (index). vorgaenger;
+    laenge INCR 1
+  END REP .
+
+END PROC i dump;
+*)
+
+(**************************** INTVEC *************************************)
+
+(* An Stelle von maximal dimensionierten ROW max INT werden an ver-      *)
+(* schiedenen Stellen TEXTe mit eingeschriebenen Integern verwendet.     *)
+(* Auf diese Art und Weise werden auch das Einfuegen und Loeschen, sowie *)
+(* das Aufsplitten und Zusammenfuegen effizienter realisiert.            *)
+
+LET
+  empty intvec = "";
+
+TEXT VAR 
+  buffer;
+
+INTVEC PROC intvec (INT CONST length, value) :
+
+  replace (inttext, 1, value);
+  length * inttext
+
+END PROC intvec;
+
+PROC insert (INTVEC VAR vector, INT CONST pos, value) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (vector) + 1 THEN
+    subscript overflow
+  ELSE
+    replace (inttext, 1, value);
+    buffer := subtext (vector, begin);
+    vector := subtext (vector, 1, begin - 1);
+    vector CAT inttext;
+    vector CAT buffer
+  END IF
+
+END PROC insert;
+
+PROC delete (INTVEC VAR vector, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin >= length (vector) THEN
+    subscript overflow
+  ELSE
+    buffer := subtext (vector, begin + 2);
+    vector := subtext (vector, 1, begin - 1);
+    vector CAT buffer
+  END IF
+
+END PROC delete;
+
+INT PROC pos (INTVEC CONST vector, INT CONST value) :
+
+  replace (inttext, 1, value);
+  INT VAR begin := 1;
+  REP
+    begin := pos (vector, inttext, begin) + 1
+  UNTIL (begin AND 1) = 0 OR begin = 1 END REP;
+  begin DIV 2
+
+END PROC pos;
+
+PROC split up (INTVEC VAR source, dest, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (source) + 1 THEN
+    subscript overflow
+  ELSE
+    dest := subtext (source, begin);
+    source := subtext (source, 1, begin - 1)
+  END IF
+
+END PROC split up;
+
+PROC split down (INTVEC VAR source, dest, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (source) + 1 THEN
+    subscript overflow
+  ELSE
+    dest := subtext (source, 1, begin - 1);
+    source := subtext (source, begin)
+  END IF
+
+END PROC split down;
+
+.
+subscript overflow :
+  errorstop (9, niltext) .
+
+subscript underflow :
+  errorstop (10, niltext) .
+
+
+(************************** Datei oeffnen ********************************)
+
+PROC initialisiere eudat (DATEI VAR datei) :
+
+  datei. felderzahl := 0;
+  datei. feldinfo := empty intvec;
+  satz initialisieren (datei. feldnamen);
+  datei. sortierfelder := niltext;
+  datei. letzter index := 1;
+  datei. indexblocks := 1;
+  datei. erster leersatz := 0;
+  datei. erster leerindex := 0;
+  datei. anz saetze := 0;
+  datei. anz satzeintraege := 1;
+  datei. anz unsortierte := 0;
+  datei. notizen (1) := niltext;
+  datei. notizen (2) := niltext;
+  datei. notizen (3) := niltext;
+  datei. satznr := 1;
+  datei. indexzeiger := 1;
+  datei. indexstelle := 1;
+  datei. satzzeiger := 1;
+  datei. index (1). satzindex := blockreservierung;
+  datei. index (1) := INDEX : (0, 0, 1, 1, intvec(1, 1));
+  INT VAR i;
+  FOR i FROM 1 UPTO maxhash REP
+    datei. hashliste (i) := 0
+  END REP;
+  datei. ablage (1) := EINTRAG : (0, 0, 1, 0, leersatz) .
+
+leersatz :
+  datei. feldnamen .
+
+END PROC initialisiere eudat;
+
+PROC oeffne (EUDAT VAR datei, TEXT CONST dateiname) :
+
+  enable stop;
+  IF NOT exists (dateiname) THEN
+    CONCR (datei) := new (dateiname);
+    initialisiere eudat (CONCR (datei));
+    type (old (dateiname), eudat typ)
+  ELIF type (old (dateiname)) = eudat typ THEN
+    CONCR (datei) := old (dateiname)
+  ELSE
+    errorstop (datei ist keine eudas datei)
+  ENDIF
+
+END PROC oeffne;
+
+PROC oeffne (EUDAT VAR datei, DATASPACE CONST ds) :
+
+  IF type (ds) < 0 THEN
+    CONCR (datei) := ds;
+    initialisiere eudat (CONCR (datei));
+    type (ds, eudat typ)
+  ELIF type (ds) = eudat typ THEN
+    CONCR (datei) := ds
+  ELSE
+    errorstop (datei ist keine eudas datei)
+  END IF
+
+END PROC oeffne;
+
+
+(************************* Feldzugriffe **********************************)
+
+PROC feld lesen (EUDAT CONST datei, INT CONST feldnr, TEXT VAR inhalt) :
+
+  feld lesen (aktueller satz, feldnr, inhalt) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld lesen;
+
+PROC feld aendern (EUDAT VAR datei, INT CONST feldnr, 
+                                    TEXT CONST neuer inhalt) :
+
+  IF nicht hinter letztem satz THEN
+    aktueller satz unsortiert (CONCR (datei));
+    moeglicherweise schluessel aendern;
+    feld aendern (aktueller satz, feldnr, neuer inhalt)
+  END IF .
+
+nicht hinter letztem satz :
+  datei. satzzeiger <> 1 .
+
+moeglicherweise schluessel aendern :
+  IF feldnr = 1 THEN
+    disable stop;
+    schluessel aendern (CONCR (datei), hashindex (neuer inhalt))
+  END IF .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld aendern;
+
+INT PROC felderzahl (EUDAT CONST datei) :
+
+  datei. felderzahl
+
+END PROC felderzahl;
+
+PROC feld bearbeiten (EUDAT CONST datei, INT CONST feldnr,
+                      PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  feld bearbeiten (aktueller satz, feldnr,
+                   PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld bearbeiten;
+
+
+(************************* Feldinformationen *****************************)
+
+(* Jedes Feld der Datei hat einen Namen und eine Typinformation. Die     *)
+(* Anzahl der vorhandenen Felder richtet sich nach dem hoechsten ver-    *)
+(* gebenen Feldnamen. 'feldinfo' kann folgende Werte annehmen :          *)
+(*  -1 : normales Textfeld                                               *)
+(*   0 : Textfeld, das nach DIN-Norm verglichen wird                     *)
+(*   1 : Zahlfeld (alle irrelevanten Zeichen werden ignoriert)           *)
+(*   2 : Datum mit einer Laenge von 8 Zeichen                            *)
+(* Das Feldinfo eines noch nicht eingerichteten Feldes fuehrt zu         *)
+(* einer Fehlermeldung.                                                  *)
+
+PROC feldnamen lesen (EUDAT CONST datei, SATZ VAR namen) :
+
+  namen := datei. feldnamen
+
+END PROC feldnamen lesen;
+
+PROC feldnamen aendern (EUDAT VAR datei, SATZ CONST neue namen) :
+
+  datei. feldnamen := neue namen;
+  INT CONST neue felder := felderzahl (neue namen);
+  IF neue felder > datei. felderzahl THEN
+    feldinfo erweitern;
+    datei. felderzahl := neue felder
+  END IF .
+
+feldinfo erweitern :
+  datei. feldinfo CAT intvec (fehlende zeilen, - 1) .
+
+fehlende zeilen :
+  neue felder - length (datei. feldinfo) DIV 2.
+
+END PROC feldnamen aendern;
+
+INT PROC feldinfo (EUDAT CONST datei, INT CONST feldnr) :
+
+  datei. feldinfo ISUB feldnr
+
+END PROC feldinfo;
+
+PROC feldinfo (EUDAT VAR datei, INT CONST feldnr, zeilen) :
+
+  replace (datei. feldinfo, feldnr, zeilen);
+  IF pos (datei. sortierfelder, code (feldnr)) > 0 THEN
+    datei. anz unsortierte := datei. anz saetze
+  END IF
+
+END PROC feldinfo;
+
+
+(*************************** Positionsabfragen ***************************)
+
+INT PROC satznr (EUDAT CONST datei) :
+
+  datei. satznr
+
+END PROC satznr;
+
+BOOL PROC dateiende (EUDAT CONST datei) :
+
+  datei. satznr > datei. anz saetze
+
+END PROC dateiende;
+
+INT PROC saetze (EUDAT CONST datei) :
+
+  datei. anz saetze
+
+END PROC saetze;
+
+
+(***************************** Positionieren *****************************)
+
+(* Positioniert werden kann nach der Satznummer oder nach dem ersten     *)
+(* Feld. Das erste Feld kann durch eine Hashtabelle schnell gefunden     *)
+(* werden. In der Hashtabelle sind die Saetze nach absoluten Positionen  *)
+(* eingetragen und nicht nach Satznummern. Ueber den Rueckverweis auf    *)
+(* den Indexblock kann die Satznummer zu einem gegebenen Satz gefunden   *)
+(* werden.                                                               *)
+
+PROC neue satzposition (DATEI VAR datei, INT CONST indexzeiger, stelle,
+                                                   satznr) :
+
+  IF indexzeiger < 1 OR indexzeiger > datei. indexblocks COR
+     stelle < 1 OR stelle > datei. index (indexzeiger). eintraege THEN
+    errorstop (inkonsistente datei)
+  END IF;
+  disable stop;
+  datei. indexzeiger := indexzeiger;
+  datei. indexstelle := stelle;
+  datei. satznr := satznr;
+  datei. satzzeiger := datei. index (indexzeiger). satzindex ISUB stelle
+
+END PROC neue satzposition;
+
+PROC auf satz (EUDAT VAR datei, INT CONST nr) :
+
+  INT VAR satznr;
+  IF nr < 1 THEN
+    satznr := 1
+  ELIF nr > datei. anz saetze THEN
+    satznr := datei. anz saetze + 1
+  ELSE
+    satznr := nr
+  END IF;
+  auf satz intern (CONCR (datei), satznr)
+
+END PROC auf satz;
+
+PROC auf satz (EUDAT VAR datei, TEXT CONST muster) :
+
+  auf satz (datei, 1);
+  IF nicht auf erstem satz THEN
+    weiter (datei, muster)
+  END IF .
+
+nicht auf erstem satz :
+  feld lesen (datei, 1, feldpuffer);
+  feldpuffer <> muster .
+
+END PROC auf satz;
+
+PROC auf satz intern (DATEI VAR datei, INT CONST satznr) :
+
+  IF von anfang naeher THEN
+    neue satzposition (datei, 1, 1, 1)
+  END IF;
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    erreichter satz := datei. satznr - datei. indexstelle;
+  IF satznr > datei. satznr THEN
+    vorwaerts gehen
+  ELSE
+    rueckwaerts gehen
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, satznr) .
+
+von anfang naeher :
+  satznr + satznr < datei. satznr .
+
+vorwaerts gehen :
+  WHILE noch vor satz REP
+    erreichter satz INCR eintraege;
+    indexzeiger := datei. index (indexzeiger). nachfolger
+  END REP .
+
+noch vor satz :
+  INT CONST eintraege := datei. index (indexzeiger). eintraege;
+  erreichter satz + eintraege < satznr .
+
+rueckwaerts gehen :
+  WHILE noch hinter satz REP
+    indexzeiger := datei. index (indexzeiger). vorgaenger;
+    erreichter satz DECR datei. index (indexzeiger). eintraege
+  END REP .
+
+noch hinter satz :
+  erreichter satz >= satznr .
+
+stelle :
+  satznr - erreichter satz .
+
+END PROC auf satz intern;
+
+PROC weiter (EUDAT VAR datei) :
+
+  weiter intern (CONCR (datei))
+
+END PROC weiter;
+
+PROC weiter intern (DATEI VAR datei) :
+
+  IF nicht dateiende THEN
+    naechster satz
+  END IF .
+
+nicht dateiende :
+  datei. satzzeiger <> 1 .
+
+naechster satz :
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    stelle := datei. indexstelle;
+
+  IF stelle = index. eintraege THEN
+    indexzeiger := index. nachfolger;
+    stelle := 1
+  ELSE
+    stelle INCR 1
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, datei. satznr + 1) .
+
+index :
+  datei. index (indexzeiger) .
+
+END PROC weiter intern;
+
+PROC zurueck (EUDAT VAR datei) :
+
+  zurueck intern (CONCR (datei))
+
+END PROC zurueck;
+
+PROC zurueck intern (DATEI VAR datei) :
+
+  IF nicht am anfang THEN
+    voriger satz
+  END IF .
+
+nicht am anfang :
+  datei. satznr <> 1 .
+
+voriger satz :
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    stelle := datei. indexstelle;
+
+  IF stelle = 1 THEN
+    indexzeiger := indexblock. vorgaenger;
+    stelle := indexblock. eintraege
+  ELSE
+    stelle DECR 1
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, datei. satznr - 1) .
+
+indexblock :
+  datei. index (indexzeiger) .
+
+END PROC zurueck intern;
+
+PROC weiter (EUDAT VAR datei, TEXT CONST muster) :
+
+  weiter intern (CONCR (datei), muster)
+
+END PROC weiter;
+
+PROC weiter intern (DATEI VAR datei, TEXT CONST muster) :
+
+  stelle in hashkette bestimmen;
+  WHILE noch weitere saetze CAND muster nicht gefunden REP
+    eine stelle weiter
+  END REP;
+  IF noch weitere saetze THEN
+    positioniere intern (datei, stelle)
+  ELSE
+    auf satz intern (datei, datei. anz saetze + 1)
+  END IF .
+
+stelle in hashkette bestimmen :
+  INT VAR dummy, stelle := datei. satzzeiger;
+  IF muster nicht gefunden THEN
+    stelle in hashkette (datei, hashindex (muster), stelle, dummy)
+  ELSE
+    eine stelle weiter
+  END IF .
+
+noch weitere saetze :
+  stelle <> 0 .
+
+muster nicht gefunden :
+  feld lesen (aktueller satz, 1, feldpuffer);
+  feldpuffer <> muster .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+eine stelle weiter :
+  stelle := datei. ablage (stelle). nachfolger .
+
+END PROC weiter intern;
+
+PROC zurueck (EUDAT VAR datei, TEXT CONST muster) :
+
+  zurueck intern (CONCR (datei), muster)
+
+END PROC zurueck;
+
+PROC zurueck intern (DATEI VAR datei, TEXT CONST muster) :
+
+  stelle in hashkette bestimmen;
+  WHILE noch weitere saetze CAND muster nicht gefunden REP
+    eine stelle zurueck
+  END REP;
+  IF noch weitere saetze THEN
+    positioniere intern (datei, stelle)
+  ELSE
+    auf satz intern (datei, 1)
+  END IF .
+
+stelle in hashkette bestimmen :
+  INT VAR stelle := datei. satzzeiger, dummy;
+  IF stelle = 1 OR schluessel stimmt nicht ueberein THEN
+    stelle in hashkette (datei, hashindex (muster), dummy, stelle)
+  END IF .
+
+noch weitere saetze :
+  stelle <> 0 .
+
+muster nicht gefunden :
+  stelle = datei. satzzeiger OR schluessel stimmt nicht ueberein .
+
+schluessel stimmt nicht ueberein :
+  feld lesen (aktueller satz, 1, feldpuffer);
+  feldpuffer <> muster .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+eine stelle zurueck :
+  stelle := datei. ablage (stelle). vorgaenger .
+
+END PROC zurueck intern;
+
+PROC positioniere intern (DATEI VAR datei, INT CONST stelle) :
+
+  INT CONST zielblock := datei. ablage (stelle). indexblock;
+  INT VAR 
+    indexstelle := 1,
+    satznr := 0;
+  WHILE indexstelle <> zielblock REP
+    satznr INCR datei. index (indexstelle). eintraege;
+    indexstelle := datei. index (indexstelle). nachfolger
+  END REP;
+  indexstelle := pos (datei. index (zielblock). satzindex, stelle);
+  satznr INCR indexstelle;
+  neue satzposition (datei, zielblock, indexstelle, satznr) .
+
+END PROC positioniere intern;
+
+
+(************************* Hashverwaltung ********************************)
+
+INT VAR index;
+
+PROC hashindex berechnen (TEXT CONST feld, INT CONST von, bis) :
+
+  INT VAR
+    zeiger := von;
+  index := 0;
+  IF bis - von < 4 THEN
+    mit faktor 4 streuen
+  ELSE
+    mit faktor 2 streuen
+  END IF;
+  index := index MOD maxhash + 1 .
+
+mit faktor 4 streuen :
+  WHILE zeiger <= bis REP
+    index := index * 4;
+    index INCR code (feld SUB zeiger);
+    zeiger INCR 1
+  END REP .
+
+mit faktor 2 streuen :
+  WHILE zeiger <= bis REP
+    index INCR index;
+    index INCR code (feld SUB zeiger);
+    IF index > 16000 THEN index := index MOD maxhash END IF;
+    zeiger INCR 1
+  END REP .
+
+END PROC hashindex berechnen;
+
+INT PROC hashindex (TEXT CONST feld) :
+
+  hashindex berechnen (feld, 1, length (feld));
+  index
+
+END PROC hashindex;
+
+INT PROC hashindex (SATZ CONST satz) :
+
+  feld bearbeiten (satz, 1,
+       PROC (TEXT CONST, INT CONST, INT CONST) hashindex berechnen);
+  index
+
+END PROC hashindex;
+
+PROC stelle in hashkette (DATEI CONST datei, INT CONST hashindex,
+                          INT VAR stelle, vorher) :
+
+  INT VAR indexzeiger := datei. letzter index;
+  vorher := datei. hashliste (hashindex);
+  stelle := 0;
+  BOOL VAR hinter aktuellem satz := TRUE;
+  WHILE hinter aktuellem satz AND vorher <> 0 REP
+    stelle untersuchen;
+    eine stelle weiter
+  END REP .
+
+stelle untersuchen :
+  IF verweis auf aktuellen block THEN
+    ueberpruefe innerhalb block
+  ELSE
+    teste ob aktueller block in indexkette
+  END IF .
+
+verweis auf aktuellen block :
+  datei. ablage (vorher). indexblock = datei. indexzeiger .
+
+ueberpruefe innerhalb block :
+  indexzeiger := datei. indexzeiger;
+  INT CONST stelle in block := pos (satzindex, vorher);
+  IF stelle in block = 0 THEN
+    errorstop (inkonsistente datei)
+  ELIF stelle in block <= aktuelle stelle THEN
+    hinter aktuellem satz := FALSE
+  END IF .
+
+satzindex :
+  datei. index (indexzeiger). satzindex .
+
+aktuelle stelle :
+  datei. indexstelle .
+
+teste ob aktueller block in indexkette :
+  WHILE indexzeiger <> datei. ablage (vorher). indexblock REP
+    IF indexzeiger = datei. indexzeiger THEN
+      hinter aktuellem satz := FALSE;
+      LEAVE stelle untersuchen
+    ELSE
+      indexzeiger := datei. index (indexzeiger). vorgaenger
+    END IF
+  END REP .
+
+eine stelle weiter :
+  IF hinter aktuellem satz THEN
+    stelle := vorher;
+    vorher := datei. ablage (stelle). vorgaenger
+  END IF .
+
+END PROC stelle in hashkette;
+
+PROC hash ausketten (DATEI VAR datei, INT CONST hashindex) :
+
+  disable stop;
+  INT CONST
+    stelle := datei. satzzeiger,
+    vorgaenger := datei. ablage (stelle). vorgaenger,
+    nachfolger := datei. ablage (stelle). nachfolger;
+
+  IF nachfolger <> 0 THEN
+    datei. ablage (nachfolger). vorgaenger := vorgaenger
+  ELSE
+    datei. hashliste (hashindex) := vorgaenger
+  END IF;
+  IF vorgaenger <> 0 THEN
+    datei. ablage (vorgaenger). nachfolger := nachfolger
+  END IF .
+
+END PROC hash ausketten;
+
+PROC hash einketten (DATEI VAR datei, INT CONST hashindex, 
+                                                nachfolger, vorgaenger) :
+
+  disable stop;
+  INT CONST stelle := datei. satzzeiger;
+  datei. ablage (stelle). vorgaenger := vorgaenger;
+  datei. ablage (stelle). nachfolger := nachfolger;
+  IF vorgaenger <> 0 THEN
+    datei. ablage (vorgaenger). nachfolger := stelle
+  END IF;
+  IF nachfolger <> 0 THEN
+    datei. ablage (nachfolger). vorgaenger := stelle
+  ELSE
+    datei. hashliste (hashindex) := stelle
+  END IF
+
+END PROC hash einketten;
+
+
+(************************** Satzzugriffe *********************************)
+
+PROC satz lesen (EUDAT CONST datei, SATZ VAR satz) :
+
+  satz := datei. ablage (datei. satzzeiger). satz
+
+END PROC satz lesen;
+
+PROC satz aendern (EUDAT VAR datei, SATZ CONST neuer satz) :
+
+  IF NOT dateiende (datei) THEN
+    satz wirklich aendern
+  END IF .
+
+satz wirklich aendern :
+  aktueller satz unsortiert (CONCR (datei));
+  disable stop;
+  schluessel aendern (CONCR (datei), hashindex (neuer satz));
+  aktueller satz := neuer satz .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC satz aendern;
+
+PROC schluessel aendern (DATEI VAR datei, INT CONST neuer hashindex) :
+
+  IF anderer hashindex THEN
+    in neue hashkette
+  END IF .
+
+anderer hashindex :
+  INT CONST alter hashindex := hashindex (aktueller satz);
+  alter hashindex <> neuer hashindex .
+
+in neue hashkette :
+  in alter kette ausketten;
+  in neuer kette einketten .
+
+in alter kette ausketten :
+  hash ausketten (datei, alter hashindex) .
+
+in neuer kette einketten :
+  INT VAR vorgaenger, nachfolger;
+  stelle in hashkette (datei, neuer hashindex, vorgaenger, nachfolger);
+  hash einketten (datei, neuer hashindex, vorgaenger, nachfolger) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC schluessel aendern;
+
+PROC satz loeschen (EUDAT VAR datei) :
+
+  IF NOT dateiende (datei) THEN
+    satz wirklich loeschen
+  END IF .
+
+satz wirklich loeschen :
+  disable stop;
+  satzeintrag loeschen (CONCR (datei));
+  indexeintrag loeschen (CONCR (datei));
+  datei. anz saetze DECR 1 .
+
+END PROC satz loeschen;
+
+PROC satzeintrag loeschen (DATEI VAR datei) :
+
+  aktueller satz sortiert (datei);
+  INT CONST stelle := datei. satzzeiger;
+  hash ausketten (datei, hashindex (aktueller satz));
+  datei. ablage (stelle). nachfolger := datei. erster leersatz;
+  datei. erster leersatz := stelle .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+END PROC satzeintrag loeschen;
+
+PROC satz einfuegen (EUDAT VAR datei, SATZ CONST neuer satz) :
+
+  satz einfuegen intern (CONCR (datei), neuer satz)
+
+END PROC satz einfuegen;
+
+PROC satz einfuegen intern (DATEI VAR datei, SATZ CONST neuer satz) :
+
+  INT VAR
+    stelle,
+    vorgaenger,
+    nachfolger;
+
+  enable stop;
+  satzeintrag belegen;
+  ggf schluessel einfuegen;
+  disable stop;
+  datei. anz saetze INCR 1;
+  indexeintrag einfuegen (datei, stelle);
+  INT CONST neuer index := hashindex (feldpuffer);
+  stelle in hashkette (datei, neuer index, nachfolger, vorgaenger);
+  hash einketten (datei, neuer index, nachfolger, vorgaenger);
+  aktueller satz unsortiert (datei) .
+
+satzeintrag belegen :
+  IF datei. erster leersatz <> 0 THEN
+    stelle := datei. erster leersatz;
+    datei. erster leersatz := datei. ablage (stelle). nachfolger
+  ELIF datei. anz satzeintraege = maxsatz THEN
+    errorstop (eudas datei voll)
+  ELSE
+    datei. anz satzeintraege INCR 1;
+    stelle := datei. anz satzeintraege
+  END IF;
+  datei. ablage (stelle). attribut := 0;
+  datei. ablage (stelle). satz := neuer satz .
+
+ggf schluessel einfuegen :
+  feld lesen (neuer satz, 1, feldpuffer);
+  IF datei. schluesselzaehler > 0 THEN
+    IF feldpuffer = "" THEN
+      neuen schluessel erzeugen;
+      feld aendern (datei. ablage (stelle). satz, 1, feldpuffer)
+    END IF
+  END IF .
+
+neuen schluessel erzeugen :
+  feldpuffer := text (datei. schluesselzaehler);
+  feldpuffer := fuehrende nullen + feldpuffer;
+  IF datei. schluesselzaehler > 32000 THEN
+    datei. schluesselzaehler := 1
+  ELSE
+    datei. schluesselzaehler INCR 1
+  END IF .
+
+fuehrende nullen :
+  (4 - length (feldpuffer)) * "0" .
+
+END PROC satz einfuegen intern;
+
+PROC automatischer schluessel (EUDAT VAR eudat, BOOL CONST automatisch) :
+
+  IF automatisch AND eudat. schluesselzaehler < 0 OR
+     NOT automatisch AND eudat. schluesselzaehler > 0 THEN
+    eudat. schluesselzaehler := - eudat. schluesselzaehler
+  END IF
+
+END PROC automatischer schluessel;
+
+BOOL PROC automatischer schluessel (EUDAT CONST eudat) :
+
+  eudat. schluesselzaehler > 0
+
+END PROC automatischer schluessel;
+
+
+(************************* Indexverwaltung *******************************)
+
+(* Die logische Reihenfolge der Saetze wird durch einen Index herge-     *)
+(* stellt. Dieser besteht aus einer Liste von INTVECs. Ein Listenelement *)
+(* nimmt Satzeintraege auf, bis die Maximalgroesse erreicht ist. In      *)
+(* diesem Fall wird ein neues Listenelement eingefuegt. Beim Loeschen    *)
+(* von Eintraegen wird ueberprueft, ob zwei benachbarte Eintraege kom-   *)
+(* biniert werden koennen. Steht fuer eine Anforderung kein Eintrag mehr *)
+(* zur Verfuegung, wird der ganze Index reorganisiert. Es ist garantiert,*)
+(* dass der Index die maximale Anzahl von Satzeintraegen aufnehmen kann. *)
+
+INTVEC VAR indexpuffer;
+
+
+PROC indexeintrag loeschen (DATEI VAR datei) :
+
+  INT CONST
+    indexzeiger := datei. indexzeiger,
+    vorgaenger := index. vorgaenger,
+    nachfolger := index. nachfolger;
+  BOOL VAR moeglich;
+  delete (index. satzindex, datei. indexstelle);
+  index. eintraege DECR 1;
+  indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich);
+  IF NOT moeglich THEN
+    indizes zusammenlegen (datei, vorgaenger, indexzeiger, moeglich)
+  END IF;
+  indexzeiger justieren (datei) .
+
+index :
+  datei. index (indexzeiger) .
+
+END PROC indexeintrag loeschen;
+
+PROC indizes zusammenlegen (DATEI VAR datei, INT CONST zeiger, folgezeiger,
+                                             BOOL VAR moeglich) :
+
+  moeglich := FALSE;
+  IF zeiger <> 0 AND folgezeiger <> 0 THEN
+    versuche zusammenzulegen
+  END IF .
+
+versuche zusammenzulegen :
+  INT CONST
+    eintraege a := index. eintraege,
+    eintraege b := folgeindex. eintraege;
+  IF zusammenlegbar THEN
+    wirklich zusammenlegen;
+    moeglich := TRUE
+  END IF .
+
+zusammenlegbar:
+  eintraege a + eintraege b <= dreiviertel maxeintrag OR
+  eintraege a = 0 OR eintraege b = 0 .
+
+wirklich zusammenlegen :
+  index. eintraege INCR folgeindex. eintraege;
+  indexverweise aendern (datei, folgeindex. satzindex, zeiger);
+  index. satzindex CAT folgeindex. satzindex;
+  folgeindex ausketten .
+
+folgeindex ausketten :
+  index. nachfolger := folgeindex. nachfolger;
+  IF index. nachfolger <> 0 THEN
+    datei. index (index. nachfolger). vorgaenger := zeiger
+  ELSE
+    datei. letzter index := zeiger
+  END IF;
+  folgeindex. nachfolger := datei. erster leerindex;
+  datei. erster leerindex := folgezeiger .
+
+index :
+  datei. index (zeiger) .
+
+folgeindex :
+  datei. index (folgezeiger) .
+
+END PROC indizes zusammenlegen;
+
+PROC indexzeiger justieren (DATEI VAR datei) :
+
+  INT CONST aktueller satz := datei. satznr;
+  neue satzposition (datei, 1, 1, 1);
+  auf satz intern (datei, aktueller satz)
+
+END PROC indexzeiger justieren;
+
+PROC indexverweise aendern (DATEI VAR datei, INTVEC CONST satzindex,
+                                             INT CONST zeiger) :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO length (satzindex) DIV 2 REP
+    datei. ablage (satzindex ISUB i). indexblock := zeiger
+  END REP
+
+END PROC indexverweise aendern;
+
+PROC indexeintrag einfuegen (DATEI VAR datei, INT CONST eintrag) :
+
+  INT VAR indexzeiger := datei. indexzeiger;
+  IF index. eintraege >= maxeintrag THEN
+    platz schaffen
+  END IF;
+  index. eintraege INCR 1;
+  insert (index. satzindex, datei. indexstelle, eintrag);
+  datei. satzzeiger := eintrag;
+  datei. ablage (eintrag). indexblock := indexzeiger .
+
+platz schaffen :
+  INT VAR neuer index := 0;
+  neuen indexblock besorgen;
+  IF neuer index <> 0 THEN
+    index aufsplitten
+  ELSE
+    index reorganisieren (datei)
+  END IF;
+  indexzeiger justieren (datei);
+  indexzeiger := datei. indexzeiger .
+
+neuen indexblock besorgen :
+  IF datei. erster leerindex <> 0 THEN
+    neuer index := datei. erster leerindex;
+    datei. erster leerindex := folgeindex. nachfolger
+  ELIF datei. indexblocks < maxindex THEN
+    datei. indexblocks INCR 1;
+    neuer index := datei. indexblocks;
+    folgeindex. satzindex := blockreservierung
+  END IF .
+
+index aufsplitten :
+  neuen block einketten;
+  splitpunkt bestimmen;
+  folgeindex. eintraege := index. eintraege - halbe eintraege;
+  split up (index. satzindex, folgeindex. satzindex, halbe eintraege + 1);
+  index. eintraege := halbe eintraege;
+  indexverweise aendern (datei, folgeindex. satzindex, neuer index) .
+
+neuen block einketten :
+  INT CONST alter nachfolger := index. nachfolger;
+  IF alter nachfolger <> 0 THEN
+    datei. index (alter nachfolger). vorgaenger := neuer index
+  ELSE
+    datei. letzter index := neuer index
+  END IF;
+  folgeindex. nachfolger := alter nachfolger;
+  folgeindex. vorgaenger := indexzeiger;
+  index. nachfolger := neuer index .
+
+splitpunkt bestimmen :
+  INT VAR halbe eintraege;
+  IF letzter block THEN
+    halbe eintraege := dreiviertel maxeintrag
+  ELSE
+    halbe eintraege := index. eintraege DIV 2 + 1
+  END IF .
+
+letzter block :
+  alter nachfolger = 0 .
+
+index :
+  datei. index (indexzeiger) .
+
+folgeindex :
+  datei. index (neuer index) .
+ 
+END PROC indexeintrag einfuegen;
+
+PROC index reorganisieren (DATEI VAR datei) :
+
+  INT VAR indexzeiger := 1;
+  REP
+    index auffuellen;
+    zum naechsten index
+  END REP .
+
+index auffuellen :
+  BOOL VAR moeglich;
+  REP
+    INT CONST nachfolger := index. nachfolger;
+    indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich)
+  UNTIL NOT moeglich END REP;
+  IF nachfolger = 0 THEN
+    LEAVE index reorganisieren
+  ELIF noch platz THEN
+    rest auffuellen
+  END IF .
+
+noch platz :
+  INT CONST platz := dreiviertel maxeintrag - index. eintraege;
+  platz > 0 .
+
+rest auffuellen :
+  split down (folgeindex. satzindex, indexpuffer, platz + 1); 
+  folgeindex. eintraege DECR platz;
+  indexverweise aendern (datei, indexpuffer, indexzeiger);
+  index. satzindex CAT indexpuffer;
+  index. eintraege := dreiviertel maxeintrag .
+
+zum naechsten index :
+  indexzeiger := nachfolger .
+
+index :
+  datei. index (indexzeiger) .
+
+folgeindex :
+  datei. index (nachfolger) .
+
+END PROC index reorganisieren;
+
+
+(************************* Sortierabfragen *******************************)
+
+TEXT VAR dez komma := ",";
+
+LET
+  sortmask = 1;
+
+TEXT PROC dezimalkomma :
+
+  dez komma
+
+END PROC dezimalkomma;
+
+PROC dezimalkomma (TEXT CONST neues komma) :
+
+  IF length (neues komma) <> 1 THEN
+    errorstop (nicht erlaubtes dezimalkomma)
+  ELSE
+    dez komma := neues komma
+  ENDIF
+
+END PROC dezimalkomma;
+
+INT PROC unsortierte saetze (EUDAT CONST datei) :
+
+  datei. anz unsortierte
+
+END PROC unsortierte saetze;
+
+TEXT PROC sortierreihenfolge (EUDAT CONST datei) :
+
+  datei. sortierfelder
+
+END PROC sortierreihenfolge;
+
+PROC aktueller satz unsortiert (DATEI VAR datei) :
+
+  IF sortiert (datei) THEN
+    disable stop;
+    datei. ablage (datei. satzzeiger). attribut INCR sortmask;
+    datei. anz unsortierte INCR 1
+  END IF
+
+END PROC aktueller satz unsortiert;
+
+PROC aktueller satz sortiert (DATEI VAR datei) :
+
+  IF NOT sortiert (datei) THEN
+    disable stop;
+    datei. ablage (datei. satzzeiger). attribut DECR sortmask;
+    datei. anz unsortierte DECR 1
+  END IF
+
+END PROC aktueller satz sortiert;
+
+BOOL PROC sortiert (DATEI CONST datei, INT CONST stelle) :
+
+  (datei. ablage (stelle). attribut AND sortmask) = 0
+
+END PROC sortiert;
+
+BOOL PROC sortiert (DATEI CONST datei) :
+
+  sortiert (datei, datei. satzzeiger)
+
+END PROC sortiert;
+
+
+(************************* Sortieren *************************************)
+
+(* Eine Datei kann in einer beliebigen Feldreihenfolge sortiert werden.  *)
+(* Dabei wird das Feldinfo beachtet. Wurden seit der letzten Sortierung  *)
+(* nur wenige Saetze geaendert (deren Plaetze in 'unsortierte' gespei-   *)
+(* chert sind), werden nur diese Saetze einsortiert.                     *)
+
+INTVEC VAR sortierinfo;
+
+TEXT VAR sortierfelder;
+
+TEXT VAR l, r;
+
+
+PROC sortiere (EUDAT VAR datei) :
+
+  sortierfelder := datei. sortierfelder;
+  IF sortierfelder = niltext THEN
+    standardbelegung
+  END IF;
+  sortiere intern (CONCR (datei)) .
+
+standardbelegung :
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. felderzahl REP
+    sortierfelder CAT code (i)
+  END REP .
+
+END PROC sortiere;
+
+PROC sortiere (EUDAT VAR datei, TEXT CONST felder) :
+
+  sortierfelder := felder;
+  sortiere intern (CONCR (datei))
+
+END PROC sortiere;
+
+PROC sortiere intern (DATEI VAR datei) :
+
+  IF datei. sortierfelder <> sortierfelder THEN
+    datei. sortierfelder := sortierfelder;
+    datei. anz unsortierte := datei. anz saetze + 1
+  ELIF datei. anz unsortierte = 0 THEN
+    LEAVE sortiere intern
+  END IF;
+  sortierinfo := datei. feldinfo;
+  IF mehr als ein drittel THEN
+    komplett sortieren (datei);
+    datei. anz unsortierte := 0
+  ELSE
+    einzeln sortieren (datei)
+  END IF;
+  auf satz intern (datei, 1) .
+
+mehr als ein drittel :
+  datei. anz saetze DIV datei. anz unsortierte < 3 .
+
+END PROC sortiere intern;
+
+PROC komplett sortieren (DATEI VAR datei) :
+
+  INT VAR
+    satzzeiger,
+    satz := 1,
+    satz vorher;
+
+  auf satz intern (datei, 1);
+  aktueller satz sortiert (datei);
+  satzzeiger := datei. satzzeiger;
+  WHILE noch satz vorhanden REP
+    zum naechsten satz;
+    satz richtig einsortieren;
+    cout (satz)
+  END REP;
+  disable stop;
+  index reorganisieren (datei);
+  neue satzposition (datei, 1, 1, 1) .
+
+noch satz vorhanden :
+  satz < datei. anz saetze .
+
+zum naechsten satz :
+  satz INCR 1;
+  auf satz intern (datei, satz);
+  satz vorher := satzzeiger;
+  satzzeiger := datei. satzzeiger .
+
+satz richtig einsortieren :
+  IF satz kleiner als vorgaenger THEN
+    satz einsortieren (datei, satz, satzzeiger);
+    satzzeiger := satz vorher
+  ELSE
+    aktueller satz sortiert (datei)
+  END IF .
+
+satz kleiner als vorgaenger :
+  datei. ablage (satz vorher). satz GROESSER
+  datei. ablage (satzzeiger). satz .
+
+END PROC komplett sortieren;
+
+PROC einzeln sortieren (DATEI VAR datei) :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. anz satzeintraege REP
+    IF NOT sortiert (datei, i) THEN
+      satz einsortieren (datei, datei. anz saetze + 1, i);
+      cout (i)
+    END IF
+  END REP
+
+END PROC einzeln sortieren;
+
+PROC satz einsortieren (DATEI VAR datei, INT CONST satznr, satzzeiger) :
+
+  stelle suchen;
+  an dieser stelle einfuegen .
+
+stelle suchen :
+  INT VAR
+    anfang := 1,
+    ende := satznr - 1,
+    mitte;
+  WHILE stelle nicht gefunden REP
+    intervall in der mitte halbieren;
+    teilintervall auswaehlen
+  END REP .
+
+stelle nicht gefunden :
+  anfang <= ende .
+
+intervall in der mitte halbieren :
+  mitte := (anfang + ende) DIV 2;
+  INT VAR vergleichssatz;
+  auf satz intern (datei, mitte);
+  IF NOT sortiert (datei) THEN
+    passenden vergleichssatz suchen
+  END IF;
+  vergleichssatz := datei. satzzeiger .
+
+passenden vergleichssatz suchen :
+  WHILE datei. satznr < ende REP
+    weiter intern (datei);
+    IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF
+  END REP;
+  WHILE datei. satznr > anfang REP
+    zurueck intern (datei);
+    IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF
+  END REP;
+  LEAVE stelle suchen .
+
+satz richtig :
+  sortiert (datei) .
+
+teilintervall auswaehlen :
+  IF zu vergleichender satz GROESSER datei. ablage (satzzeiger). satz THEN
+    ende := mitte - 1
+  ELSE
+    anfang := mitte + 1
+  END IF .
+
+zu vergleichender satz :
+  datei. ablage (vergleichssatz). satz .
+
+an dieser stelle einfuegen :
+  positioniere intern (datei, satzzeiger);
+  IF datei. satznr < anfang THEN anfang DECR 1 END IF;
+  disable stop;
+  aktueller satz sortiert (datei);
+  in hashkette ausketten;
+  indexeintrag loeschen (datei);
+  auf satz intern (datei, anfang);
+  indexeintrag einfuegen (datei, satzzeiger);
+  in hashkette einketten .
+
+in hashkette ausketten :
+  INT CONST h index := hashindex (aktueller satz);
+  hash ausketten (datei, h index) .
+
+in hashkette einketten :
+  INT VAR vorgaenger, nachfolger;
+  stelle in hashkette (datei, h index, vorgaenger, nachfolger);
+  hash einketten (datei, h index, vorgaenger, nachfolger) .
+
+aktueller satz :
+  datei. ablage (satzzeiger). satz .
+
+END PROC satz einsortieren;
+
+BOOL OP GROESSER (SATZ CONST links, rechts) :
+
+  ungleiches feld suchen;
+  sortierrichtung feststellen;
+  SELECT sortierinfo ISUB vergleichsfeld OF
+    CASE 0 : din vergleich
+    CASE 1 : zahl vergleich
+    CASE 2 : datum vergleich
+    OTHERWISE text vergleich
+  END SELECT .
+
+ungleiches feld suchen :
+  INT VAR nr zeiger := 1;
+  WHILE nr zeiger < length (sortierfelder) REP
+    INT CONST vergleichsfeld := code (sortierfelder SUB nr zeiger);
+    feld lesen (links, vergleichsfeld, l);
+    feld lesen (rechts, vergleichsfeld, r);
+    SELECT sortierinfo ISUB vergleichsfeld OF
+      CASE 0 : din gleich
+      CASE 1 : zahl gleich
+      OTHERWISE text gleich
+    END SELECT;
+    nr zeiger INCR 2
+  END REP;
+  LEAVE GROESSER WITH FALSE .
+
+sortierrichtung feststellen :
+  BOOL VAR aufsteigend;
+  IF (sortierfelder SUB (nr zeiger + 1)) = "-" THEN
+    aufsteigend := FALSE
+  ELSE
+    aufsteigend := TRUE
+  END IF .
+
+zahl gleich :
+  REAL VAR l wert, r wert;
+  wert berechnen (l, l wert);
+  wert berechnen (r, r wert);
+  IF l wert <> r wert THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+din gleich :
+  IF NOT (l LEXEQUAL r) THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+text gleich :
+  IF l <> r THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+zahl vergleich :
+  IF aufsteigend THEN
+    l wert > r wert
+  ELSE
+    l wert < r wert
+  END IF .
+
+din vergleich :
+  IF aufsteigend THEN
+    l LEXGREATER r
+  ELSE
+    r LEXGREATER l
+  END IF .
+
+datum vergleich :
+  datum umdrehen (l);
+  datum umdrehen (r);
+  IF aufsteigend THEN
+    l > r
+  ELSE
+    l < r
+  END IF .
+
+textvergleich :
+  IF aufsteigend THEN
+    l > r
+  ELSE
+    l < r
+  END IF .
+
+END OP GROESSER;
+
+PROC wert berechnen (TEXT CONST zahl, REAL VAR wert) :
+
+  LET ziffern = "0123456789";
+  TEXT VAR komma := dez komma, text; 
+  INT VAR stelle;
+  INT CONST laenge := length (zahl); 
+  anfang bestimmen; 
+  WHILE stelle <= laenge REP 
+    zeichen untersuchen; 
+    stelle INCR 1 
+  END REP; 
+  wert := real (text) . 
+ 
+anfang bestimmen : 
+  stelle := pos (zahl, "0", "9", 1); 
+  IF stelle = 0 THEN 
+     wert := 0.0; LEAVE wert berechnen
+  ELIF pos (zahl, "-", 1, stelle) > 0 THEN 
+    text := "-" 
+  ELSE 
+    text := niltext
+  END IF; .
+ 
+zeichen untersuchen: 
+  TEXT CONST char := zahl SUB stelle; 
+  IF pos (ziffern, char) > 0 THEN 
+    text CAT char 
+  ELIF char = komma THEN 
+    text CAT "."; komma := niltext
+  END IF . 
+ 
+END PROC wert berechnen;
+
+PROC datum umdrehen (TEXT VAR datum) :
+
+  IF length (datum) <> 8 THEN
+    datum := niltext
+  ELSE
+    datum := subtext (datum, 7) + subtext (datum, 4, 5) +
+             subtext (datum, 1, 2)
+  END IF
+
+END PROC datum umdrehen;
+
+
+(**************************** Reorganisieren *****************************)
+
+PROC reorganisiere (TEXT CONST dateiname) :
+
+  EUDAT VAR datei 1, datei 2;
+  oeffne (datei 1, dateiname);
+  disable stop;
+  DATASPACE VAR ds := nilspace;
+  oeffne (datei 2, ds);
+  kopiere eudat (CONCR (datei 1), datei 2);
+  IF NOT is error THEN
+    forget (dateiname, quiet);
+    copy (ds, dateiname)
+  END IF;
+  forget (ds)
+
+END PROC reorganisiere;
+
+PROC kopiere eudat (DATEI VAR datei 1, EUDAT VAR datei 2) :
+
+  enable stop;
+  kopiere saetze;
+  kopiere interna (datei 1, CONCR (datei 2)) .
+
+kopiere saetze :
+  auf satz intern (datei 1, 1);
+  auf satz (datei 2, 1);
+  WHILE NOT dateiende REP
+    satz einfuegen (datei 2, kopiersatz);
+    cout (datei 1. satznr);
+    weiter intern (datei 1);
+    weiter (datei 2)
+  END REP .
+
+dateiende :
+  datei 1. satznr > datei 1. anz saetze .
+
+kopiersatz :
+  datei 1. ablage (datei 1. satzzeiger). satz .
+
+END PROC kopiere eudat;
+
+PROC kopiere interna (DATEI VAR datei 1, datei 2) :
+
+  datei 2. felderzahl := datei 1. felderzahl;
+  datei 2. feldnamen := datei 1. feldnamen;
+  datei 2. feldinfo := datei 1. feldinfo;
+  datei 2. sortierfelder := datei 1. sortierfelder;
+  datei 2. notizen (1) := datei 1. notizen (1);
+  datei 2. notizen (2) := datei 1. notizen (2);
+  datei 2. notizen (3) := datei 1. notizen (3)
+
+END PROC kopiere interna;
+
+
+(************************* Notizen ***************************************)
+
+PROC notizen lesen (EUDAT CONST datei, INT CONST nr, TEXT VAR notiztext) :
+
+  notiztext := datei. notizen (nr)
+
+END PROC notizen lesen;
+
+PROC notizen aendern (EUDAT VAR datei, INT CONST nr, TEXT CONST notiztext) :
+
+  datei. notizen (nr) := notiztext
+
+END PROC notizen aendern;
+
+END PACKET eudas dateien;
+
diff --git a/app/eudas/4.4/src/eudas.datenverwaltung b/app/eudas/4.4/src/eudas.datenverwaltung
new file mode 100644
index 0000000..bd4f74f
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.datenverwaltung
@@ -0,0 +1,1989 @@
+PACKET datenverwaltung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Verwaltung der aktuellen EUDAS-Dateien                            *)
+(*                                                                       *)
+(*     Version 09                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 01.10.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  oeffne,
+  kopple,
+  kette,
+  zugriff,
+  sichere,
+  dateien loeschen,
+  auf koppeldatei,
+
+  anzahl koppeldateien,
+  anzahl dateien,
+  aendern erlaubt,
+  inhalt veraendert,
+  eudas dateiname,
+  folgedatei,
+
+  dateiversion,
+
+  anzahl felder,
+  feldnamen lesen,
+  feldnamen bearbeiten,
+  feldnummer,
+  feldinfo,
+  notizen lesen,
+  notizen aendern,
+
+  feld lesen,
+  feld bearbeiten,
+  feld aendern,
+
+  satznummer,
+  satzkombination,
+  dateiende,
+  weiter,
+  zurueck,
+  auf satz,
+
+  satz einfuegen,
+  satz loeschen,
+  aenderungen eintragen,
+
+  suchbedingung,
+  suchbedingung lesen,
+  suchbedingung loeschen,
+  suchversion,
+  satz ausgewaehlt,
+  markierung aendern,
+  satz markiert,
+  markierungen loeschen,
+  markierte saetze :
+
+
+LET
+  INTVEC = TEXT,
+
+  DATEI = STRUCT
+    (TEXT name,
+     SATZ feldnamen,
+     INTVEC koppelfelder,
+     INT anz koppelfelder,
+     INT naechste datei,
+     INT alte koppelposition,
+     DATASPACE ds,
+     EUDAT eudat,
+     SATZ satzpuffer,
+     BOOL gepuffert,
+     BOOL veraendert, datei veraendert, koppelfeld veraendert,
+     TEXT muster,
+     INTVEC marksaetze,
+     INT markzeiger),
+
+  VERWEIS = STRUCT (INT datei, feld);
+ 
+LET
+  niltext = "",
+  empty intvec =  "";
+
+LET
+  maxint = 32767,
+  maxdateien = 10,
+  maxfelder = 256,
+  maxkoppeln = 32;
+
+ROW maxdateien DATEI VAR daten;
+
+INT VAR
+  anz dateien := 0,
+  anz koppeldateien := 0,
+  hauptdatei,
+  erste koppeldatei := 0,
+  felderzahl der ersten datei,
+  anz felder := 0,
+  satznummer offset,
+  kombination,
+  markierungen,
+  laufzaehler := 0;
+
+BOOL VAR
+  ende der datei := TRUE,
+  aenderungserlaubnis,
+  globales muster vorhanden;
+
+TEXT VAR globales muster;
+
+ROW maxfelder VERWEIS VAR verweis;
+
+ROW maxkoppeln VERWEIS VAR koppeln;
+
+INT VAR koppeleintraege;
+
+LET
+  zuviel dateien =  #301#
+    "Zuviel Dateien geoeffnet",
+  datei existiert nicht =  #302#
+    "Datei existiert nicht",
+  nicht im umgeschalteten zustand =  #303#
+    "Nicht moeglich, wenn auf Koppeldatei geschaltet",
+  zu viele felder =  #304#
+    "Zu viele Felder",
+  zu viele koppelfelder =  #305#
+    "Zu viele Koppelfelder",
+  keine koppelfelder =  #306#
+    "keine Koppelfelder vorhanden",
+  kein zugriff bei ketten oder koppeln =  #307#
+    "kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",
+  keine datei geoeffnet =  #308#
+    "keine Datei geoeffnet",
+  datei nicht gesichert =  #309#
+    "Datei nicht gesichert",
+  suchmuster zu umfangreich =  #310#
+    "Suchmuster zu umfangreich";
+
+TEXT VAR feldpuffer;
+
+
+(***************************** INTVEC ************************************)
+
+TEXT VAR raum fuer ein int := "  ";
+
+INTVEC VAR puffer;
+
+OP CAT (INTVEC VAR text, INT CONST wert) :
+
+  replace (raum fuer ein int, 1, wert);
+  text CAT raum fuer ein int
+
+END OP CAT;
+
+PROC insert (INTVEC VAR vector, INT CONST stelle, wert) :
+
+  INT CONST trennung := stelle + stelle - 2;
+  puffer := subtext (vector, trennung + 1);
+  vector := subtext (vector, 1, trennung);
+  vector CAT wert;
+  vector CAT puffer
+
+END PROC insert;
+
+PROC delete (INTVEC VAR vector, INT CONST stelle) :
+
+  INT CONST trennung := stelle + stelle - 2;
+  puffer := subtext (vector, trennung + 3);
+  vector := subtext (vector, 1, trennung);
+  vector CAT puffer
+
+END PROC delete;
+
+PROC inkrement (INTVEC VAR vector, INT CONST ab, um) :
+
+  INT VAR i;
+  FOR i FROM ab UPTO length (vector) DIV 2 - 1 REP
+    replace (vector, i, (vector ISUB i) + um)
+  END REP
+
+END PROC inkrement;
+
+
+(***************************** Dateien eintragen *************************)
+
+EUDAT VAR eudas datei;
+
+SATZ VAR namen;
+
+PROC datei testen (TEXT CONST dateiname) :
+
+  IF anz dateien = maxdateien THEN
+    errorstop (zuviel dateien)
+  END IF;
+  IF NOT exists (dateiname) THEN
+    errorstop (datei existiert nicht)
+  END IF;
+  IF umgeschaltet THEN
+    errorstop (nicht im umgeschalteten zustand)
+  END IF;
+  oeffne (eudas datei, dateiname)
+
+END PROC datei testen;
+
+PROC datei eintragen (DATEI VAR datei, TEXT CONST dateiname) :
+
+  IF aenderungserlaubnis THEN
+    datei. ds := old (dateiname);
+    oeffne (datei. eudat, datei. ds)
+  ELSE
+    oeffne (datei. eudat, dateiname)
+  END IF;
+  datei. naechste datei := 0;
+  datei. veraendert := FALSE;
+  datei. datei veraendert := FALSE;
+  datei. name := dateiname;
+  mark loeschen (datei)
+
+END PROC datei eintragen;
+
+PROC in dateikette (INT CONST anfang) :
+
+  INT VAR dateiindex := anfang;
+  WHILE daten (dateiindex). naechste datei <> 0 REP
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  daten (dateiindex). naechste datei := anz dateien
+
+END PROC in dateikette;
+
+PROC anfangsposition einnehmen :
+
+  IF dateiende (daten (1). eudat) THEN
+    auf satz (1)
+  ELSE
+    auf satz (satznr (daten (1). eudat))
+  END IF
+
+END PROC anfangsposition einnehmen;
+
+PROC felder anlegen :
+
+  felderzahl der ersten datei := felderzahl (daten (1). eudat);
+  anz felder := felderzahl der ersten datei;
+  feldnamen lesen (daten (1). eudat, daten (1). feldnamen);
+  koppeleintraege := 0;
+  INT VAR i;
+  FOR i FROM 1 UPTO anz felder REP
+    verweis (i). datei := 0
+  END REP
+
+END PROC felder anlegen;
+
+PROC laufzaehler erhoehen :
+
+  laufzaehler INCR 1;
+  IF laufzaehler > 32000 THEN
+    laufzaehler := - 32000
+  END IF
+
+END PROC laufzaehler erhoehen;
+
+PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern) :
+
+  enable stop;
+  dateien loeschen (FALSE);
+  suchbedingung loeschen;
+  datei testen (dateiname);
+  aenderungserlaubnis := auch aendern;
+  status setzen;
+  datei eintragen (daten (anz dateien), dateiname);
+  anfangsposition einnehmen;
+  felder anlegen .
+
+status setzen :
+  anz dateien := 1;
+  laufzaehler erhoehen;
+  markierungen := 0 .
+
+END PROC oeffne;
+
+PROC kopple (TEXT CONST dateiname) :
+
+  enable stop;
+  IF anz dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  datei testen (dateiname);
+  koppelfelder bestimmen;
+  platz in feldtabellen belegen;
+  in kette der koppeldateien einfuegen;
+  datei eintragen (daten (anz dateien), dateiname);
+  koppelstatus setzen .
+
+koppelfelder bestimmen :
+  feldnamen lesen (eudas datei, namen);
+  INT VAR koppelfelder := 0;
+  INTVEC VAR koppelfeldnr := empty intvec;
+  WHILE koppelfelder < felderzahl (eudas datei) REP
+    feld lesen (namen, koppelfelder + 1, feldpuffer);
+    INT CONST index := feldindex (daten (1). feldnamen, feldpuffer);
+    IF index > 0 THEN
+      koppelfelder INCR 1;
+      koppelfeldnr CAT index
+    END IF
+  UNTIL index = 0 END REP .
+
+platz in feldtabellen belegen :
+  IF anz felder + felderzahl (eudas datei) - koppelfelder > maxfelder THEN
+    errorstop (zu viele felder)
+  ELIF koppeleintraege + koppelfelder > maxkoppeln THEN
+    errorstop (zu viele koppelfelder)
+  ELIF koppelfelder = 0 THEN
+    errorstop (keine koppelfelder)
+  END IF;
+  anz dateien INCR 1;
+  daten (anz dateien). feldnamen := namen;
+  daten (anz dateien). koppelfelder := koppelfeldnr;
+  daten (anz dateien). anz koppelfelder := koppelfelder;
+  INT VAR feldnr := koppelfelder;
+  WHILE feldnr < felderzahl (eudas datei) REP
+    anz felder INCR 1; feldnr INCR 1;
+    verweis (anz felder). datei := anz dateien;
+    verweis (anz felder). feld := feldnr
+  END REP;
+  FOR feldnr FROM 1 UPTO koppelfelder REP
+    koppelfeld eintragen
+  END REP .
+
+koppelfeld eintragen :
+  INT CONST koppelfeld := koppelfeldnr ISUB feldnr;
+  IF verweis (koppelfeld). datei = 0 THEN
+    neues koppelfeld eintragen
+  ELSE
+    alten eintrag erweitern
+  END IF .
+
+neues koppelfeld eintragen :
+  koppeleintraege INCR 1;
+  koppeln (koppeleintraege). datei := anz dateien;
+  koppeln (koppeleintraege). feld := feldnr;
+  verweis (koppelfeld). datei := koppeleintraege;
+  verweis (koppelfeld). feld := 1 .
+
+alten eintrag erweitern :
+  INT CONST eintragposition :=
+    verweis (koppelfeld). datei + verweis (koppelfeld). feld;
+  folgende eintraege hochschieben;
+  verweis (koppelfeld). feld INCR 1;
+  koppeln (eintragposition). datei := anz dateien;
+  koppeln (eintragposition). feld := feldnr .
+
+folgende eintraege hochschieben :
+  INT VAR eintrag;
+  FOR eintrag FROM koppeleintraege DOWNTO eintragposition REP
+    koppeln (eintrag + 1) := koppeln (eintrag)
+  END REP;
+  koppeleintraege INCR 1;
+  FOR eintrag FROM 1 UPTO felderzahl der ersten datei REP
+    IF verweis (eintrag). datei >= eintragposition THEN
+      verweis (eintrag). datei INCR 1
+    END IF
+  END REP .
+
+in kette der koppeldateien einfuegen :
+  anz koppeldateien INCR 1;
+  IF erste koppeldatei = 0 THEN
+    erste koppeldatei := anz dateien
+  ELSE
+    in dateikette (erste koppeldatei)
+  END IF .
+
+koppelstatus setzen :
+  laufzaehler erhoehen;
+  daten (anz dateien). gepuffert := FALSE;
+  daten (anz dateien). koppelfeld veraendert := FALSE;
+  daten (anz dateien). alte koppelposition := satznr (eudas datei);
+  koppeldatei aktualisieren (daten (anz dateien)) .
+
+END PROC kopple;
+
+PROC kette (TEXT CONST dateiname) :
+
+  enable stop;
+  IF anz dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  datei testen (dateiname);
+  anz dateien INCR 1;
+  datei eintragen (daten (anz dateien), dateiname);
+  in dateikette (1);
+  IF ende der datei THEN auf satz (satznummer) END IF
+
+END PROC kette;
+
+PROC zugriff (PROC (EUDAT VAR) bearbeitung) :
+
+  IF anz dateien > 1 OR umgeschaltet THEN
+    errorstop (kein zugriff bei ketten oder koppeln)
+  ELSE
+    aenderungen eintragen;
+    bearbeitung (daten (1). eudat);
+    laufzaehler erhoehen;
+    anfangsposition einnehmen;
+    felder anlegen;
+    daten (1). datei veraendert := TRUE
+  ENDIF
+
+END PROC zugriff;
+
+PROC sichere (INT CONST dateinummer, TEXT CONST dateiname) :
+
+  aenderungen eintragen;
+  notizen aendern (daten (dateinummer). eudat, 2, date);
+  IF aenderungserlaubnis THEN
+    forget (dateiname, quiet);
+    copy (daten (dateinummer). ds, dateiname)
+  END IF;
+  daten (dateinummer). datei veraendert := FALSE
+
+END PROC sichere;
+
+PROC dateien loeschen (BOOL CONST auch geaenderte) :
+
+  aenderungen eintragen;
+  IF umgeschaltet THEN auf koppeldatei (0) END IF;
+  kontrollvariablen loeschen;
+  dateien einzeln loeschen .
+
+kontrollvariablen loeschen :
+  anz koppeldateien := 0;
+  erste koppeldatei := 0;
+  daten (1). naechste datei := 0;
+  anz felder := 0;
+  ende der datei := TRUE .
+
+dateien einzeln loeschen :
+  WHILE anz dateien > 0 REP
+    IF wirklich veraendert AND NOT auch geaenderte THEN
+      errorstop (datei nicht gesichert);
+      LEAVE dateien loeschen
+    END IF;
+    forget (daten (anz dateien). ds);
+    anz dateien DECR 1
+  END REP .
+
+wirklich veraendert :
+  aenderungserlaubnis AND daten (anz dateien). datei veraendert .
+
+END PROC dateien loeschen;
+
+
+(*********************** Umschalten Koppeldatei **************************)
+
+INT VAR
+  save hauptdatei,
+  save felderzahl der ersten datei,
+  save anz felder,
+  save satznummer offset,
+  save kombination,
+  save markierungen,
+  save erste koppeldatei,
+  save naechste koppeldatei;
+
+BOOL VAR
+  save globales muster vorhanden;
+
+INTVEC VAR
+  save oder anfang;
+
+SATZ VAR
+  save muster gespeichert;
+
+
+BOOL VAR
+  umgeschaltet := FALSE;
+
+INT VAR
+  anzahl hauptmuster := 0,
+  feldnamendatei := 1;
+
+
+BOOL PROC auf koppeldatei :
+
+  umgeschaltet
+
+END PROC auf koppeldatei;
+
+PROC auf koppeldatei (INT CONST nr) :
+
+  disable stop;
+  laufzaehler erhoehen;
+  IF umgeschaltet THEN
+    alte variablen wiederherstellen;
+    umgeschaltet := FALSE;
+    ggf koppelfelder uebernehmen;
+    fuer korrekten zustand sorgen
+  ELSE
+    alte variablen sichern;
+    umgeschaltet := TRUE;
+    neuen zustand herstellen
+  END IF .
+
+alte variablen wiederherstellen :
+  hauptdatei := save hauptdatei;
+  felderzahl der ersten datei := save felderzahl der ersten datei;
+  anz felder := save anz felder;
+  satznummer offset := save satznummer offset;
+  markierungen := save markierungen;
+  erste koppeldatei := save erste koppeldatei;
+  daten (feldnamendatei). naechste datei := save naechste koppeldatei;
+  anzahl muster := anzahl hauptmuster;
+  globales muster vorhanden := save globales muster vorhanden;
+  oder anfang := save oder anfang;
+  muster gespeichert := save muster gespeichert;
+  IF anzahl muster > 0 THEN
+    erster musterindex := 1
+  ELSE
+    erster musterindex := -1
+  END IF .
+
+fuer korrekten zustand sorgen :
+  anzahl hauptmuster := 0;
+  feldnamendatei := 1;
+  enable stop;
+  auf satz (satznummer);
+  WHILE kombination <> save kombination REP
+    weiter (1)
+  END REP .
+
+ggf koppelfelder uebernehmen :
+  daten (feldnamendatei). alte koppelposition :=
+    satznr (daten (feldnamendatei). eudat);
+  IF nr = 1 AND NOT dateiende (daten (hauptdatei). eudat) THEN
+    alle koppelfelder in hauptdatei uebernehmen
+  END IF .
+
+alle koppelfelder in hauptdatei uebernehmen :
+  INT VAR koppel nr;
+  FOR koppel nr FROM 1 UPTO daten (feldnamendatei). anz koppelfelder REP
+    feld aendern (daten (hauptdatei). eudat, feld nr koppelfeld,
+                  feldinhalt koppelfeld)
+  END REP;
+  save kombination := 1 .
+
+feld nr koppelfeld :
+  daten (feldnamendatei). koppelfelder ISUB koppel nr .
+
+feldinhalt koppelfeld :
+  feld lesen (daten (feldnamendatei). eudat, koppel nr, feldpuffer);
+  feldpuffer .
+
+alte variablen sichern :
+  save hauptdatei := hauptdatei;
+  save felderzahl der ersten datei := felderzahl der ersten datei;
+  save anz felder := anz felder;
+  save satznummer offset := satznummer offset;
+  save kombination := kombination;
+  save markierungen := markierungen;
+  save erste koppeldatei := erste koppeldatei;
+  save naechste koppeldatei := daten (nr). naechste datei;
+  save globales muster vorhanden := globales muster vorhanden;
+  save oder anfang := oder anfang;
+  save muster gespeichert := muster gespeichert .
+
+neuen zustand herstellen :
+  hauptdatei := nr;
+  anzahl hauptmuster := anzahl muster;
+  feldnamendatei := nr;
+  felderzahl der ersten datei := felderzahl (daten (nr). eudat);
+  anz felder := felderzahl der ersten datei;
+  satznummer offset := 0;
+  markierungen := (length (daten (nr). marksaetze) - 1) DIV 2;
+  erste koppeldatei := 0;
+  daten (nr). naechste datei := 0;
+  suchbedingung loeschen;
+  auf satz (daten (nr). alte koppelposition) .
+
+END PROC auf koppeldatei;
+
+
+(************************** Dateiabfragen ********************************)
+
+INT PROC anzahl koppeldateien :
+
+  anz koppeldateien
+
+END PROC anzahl koppeldateien;
+
+INT PROC anzahl dateien :
+
+  anz dateien
+
+END PROC anzahl dateien;
+
+BOOL PROC aendern erlaubt :
+
+  aenderungserlaubnis
+
+END PROC aendern erlaubt;
+
+BOOL PROC inhalt veraendert (INT CONST dateinr) :
+
+  aenderungen eintragen;
+  daten (dateinr). datei veraendert
+
+END PROC inhalt veraendert;
+
+TEXT PROC eudas dateiname (INT CONST dateinr) :
+
+  daten (dateinr). name
+
+END PROC eudas dateiname;
+
+INT PROC folgedatei (INT CONST dateinr) :
+
+  IF dateinr = 0 THEN
+    erste koppeldatei
+  ELSE
+    daten (dateinr). naechste datei
+  END IF
+
+END PROC folgedatei;
+
+
+(*************************** Dateiversion ********************************)
+
+(* Die Dateiversion wird bei jedem neuen 'oeffne' hochgezaehlt. Sie      *)
+(* dient dazu, ein neues 'oeffne' festzustellen, um eventuell als        *)
+(* Optimierung gespeicherte Daten als ungueltig zu kennzeichnen.         *)
+
+INT PROC dateiversion :
+
+  laufzaehler
+
+END PROC dateiversion;
+
+
+(******************************* Felder **********************************)
+
+INT PROC anzahl felder :
+
+  anz felder
+
+END PROC anzahl felder;
+
+PROC feldnamen lesen (INT CONST feldnr, TEXT VAR name) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld lesen (daten (feldnamendatei). feldnamen, feldnr, name)
+  ELSE
+    feld lesen (dateiverweis, feldverweis, name)
+  END IF .
+
+dateiverweis :
+  daten (verweis (feldnr). datei). feldnamen .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldnamen lesen;
+
+PROC feldnamen bearbeiten (INT CONST feldnr,
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld bearbeiten (daten (feldnamendatei). feldnamen, feldnr,
+              PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    feld bearbeiten (dateiverweis, feldverweis,
+              PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  END IF .
+
+dateiverweis :
+  daten (verweis (feldnr). datei). feldnamen .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldnamen bearbeiten;
+
+INT PROC feldnummer (TEXT CONST feldname) :
+
+  INT VAR 
+    offset := felderzahl der ersten datei,
+    nr := feldindex (daten (feldnamendatei). feldnamen, feldname),
+    dateiindex := erste koppeldatei;
+  WHILE nr = 0 AND dateiindex <> 0 REP
+    nr := feldindex (daten (dateiindex). feldnamen, feldname);
+    offset oder nr erhoehen;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  nr .
+
+offset oder nr erhoehen :
+  INT CONST zahl der koppelfelder := daten (dateiindex). anz koppelfelder;
+  IF nr = 0 THEN
+    offset INCR felderzahl (daten (dateiindex). eudat);
+    offset DECR zahl der koppelfelder
+  ELSE
+    nr INCR offset;
+    nr DECR zahl der koppelfelder
+  END IF .
+
+END PROC feldnummer;
+
+INT PROC feldinfo (INT CONST feldnr) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feldinfo (daten (feldnamendatei). eudat, feldnr)
+  ELSE
+    feldinfo (daten (dateiverweis). eudat, feldverweis)
+  END IF .
+
+dateiverweis :
+  verweis (feldnr). datei .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldinfo;
+
+PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) :
+
+  notizen lesen (daten (feldnamendatei). eudat, nr, inhalt)
+
+END PROC notizen lesen;
+
+PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) :
+
+  notizen aendern (daten (feldnamendatei). eudat, nr, inhalt)
+
+END PROC notizen aendern;
+
+
+(*************************** Feldzugriffe ********************************)
+
+PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld lesen (daten (hauptdatei). eudat, feldnr, inhalt)
+  ELSE
+    in koppeldatei lesen
+  END IF .
+
+in koppeldatei lesen :
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF daten (dateiverweis). gepuffert THEN
+    feld lesen (daten (dateiverweis). satzpuffer, feldverweis, inhalt)
+  ELSE
+    feld lesen (daten (dateiverweis). eudat, feldverweis, inhalt)
+  END IF .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feld lesen;
+
+PROC feld bearbeiten (INT CONST feldnr,
+          PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld bearbeiten (daten (hauptdatei). eudat, feldnr,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    in koppeldatei bearbeiten
+  END IF .
+
+in koppeldatei bearbeiten :
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF daten (dateiverweis). gepuffert THEN
+    feld bearbeiten (daten (dateiverweis). satzpuffer, feldverweis,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    feld bearbeiten (daten (dateiverweis). eudat, feldverweis,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  END IF .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feld bearbeiten;
+
+PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) :
+
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF feldnr <= felderzahl der ersten datei THEN
+    in hauptdatei aendern
+  ELSE
+    in koppeldatei aendern
+  END IF .
+
+in hauptdatei aendern :
+  daten (hauptdatei). datei veraendert := TRUE;
+  IF ist koppelfeld CAND wirklich veraenderung THEN
+    weitere dateien aktualisieren
+  END IF;
+  feld aendern (daten (hauptdatei). eudat, feldnr, inhalt) .
+
+ist koppelfeld :
+  NOT umgeschaltet CAND dateiverweis > 0 .
+
+wirklich veraenderung :
+  feld lesen (daten (hauptdatei). eudat, feldnr, feldpuffer);
+  feldpuffer <> inhalt .
+
+weitere dateien aktualisieren :
+  INT VAR
+    koppelzaehler := feldverweis,
+    koppelverweis := dateiverweis;
+  REP 
+    satzpuffer aktualisieren (daten (koppeldatei));
+    daten (koppeldatei). koppelfeld veraendert := TRUE;
+    feld aendern (daten (koppeldatei). satzpuffer, koppelfeld, inhalt);
+    koppelverweis INCR 1;
+    koppelzaehler DECR 1
+  UNTIL koppelzaehler = 0 END REP .
+
+in koppeldatei aendern :
+  satzpuffer aktualisieren (daten (dateiverweis));
+  IF koppeldatei wirklich veraendert THEN
+    daten (dateiverweis). veraendert := TRUE;
+    feld aendern (daten (dateiverweis). satzpuffer, feldverweis, inhalt)
+  END IF .
+
+koppeldatei wirklich veraendert :
+  feld lesen (daten (dateiverweis). satzpuffer, feldverweis, feldpuffer);
+  feldpuffer <> inhalt .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+koppeldatei :
+  koppeln (koppelverweis). datei .
+
+koppelfeld :
+  koppeln (koppelverweis). feld .
+
+END PROC feld aendern;
+
+PROC satzpuffer aktualisieren (DATEI VAR datei) :
+
+  IF NOT datei. gepuffert THEN
+    datei. gepuffert := TRUE;
+    satzpuffer lesen
+  END IF .
+
+satzpuffer lesen :
+  IF dateiende (datei. eudat) THEN
+    satz initialisieren (datei. satzpuffer, datei. anz koppelfelder);
+    koppelfelder in satzpuffer schreiben
+  ELSE
+    satz lesen (datei. eudat, datei. satzpuffer)
+  END IF .
+
+koppelfelder in satzpuffer schreiben :
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. anz koppelfelder REP
+    feld lesen (datei. koppelfelder ISUB i, feldpuffer);
+    feld aendern (datei. satzpuffer, i, feldpuffer)
+  END REP .
+
+END PROC satzpuffer aktualisieren;
+
+PROC koppeldatei aktualisieren (DATEI VAR datei) :
+
+  muster lesen;
+  koppeldatei positionieren .
+
+muster lesen :
+  feld lesen (daten (hauptdatei). eudat, musterfeld, muster) .
+
+musterfeld :
+  datei. koppelfelder ISUB 1 .
+
+muster :
+  datei. muster .
+
+koppeldatei positionieren :
+  auf satz (datei. eudat, muster);
+  WHILE NOT koppelfelder gleich (datei) REP
+    weiter (datei. eudat, muster)
+  END REP;
+  IF dateiende (datei. eudat) THEN
+    satzpuffer aktualisieren (datei)
+  ELSE
+    datei. gepuffert := FALSE
+  END IF .
+
+END PROC koppeldatei aktualisieren;
+
+PROC koppeldateien aktualisieren :
+
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    koppeldatei aktualisieren (daten (dateiindex));
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  kombination := 1
+
+END PROC koppeldateien aktualisieren;
+
+BOOL PROC koppelfelder gleich (DATEI CONST datei) :
+
+  IF NOT dateiende (datei. eudat) THEN
+    koppelfelder vergleichen
+  END IF;
+  TRUE .
+
+koppelfelder vergleichen :
+  INT VAR koppelindex;
+  FOR koppelindex FROM 2 UPTO datei. anz koppelfelder REP
+    feld lesen (daten (hauptdatei). eudat, koppelfelder ISUB koppelindex,
+                feldpuffer);
+    feld bearbeiten (datei. eudat, koppelindex,
+         PROC (TEXT CONST, INT CONST, INT CONST) feld vergleichen);
+    IF NOT vergleich erfolgreich THEN
+      LEAVE koppelfelder gleich WITH FALSE
+    END IF
+  END REP .
+
+koppelfelder :
+  datei. koppelfelder .
+
+END PROC koppelfelder gleich;
+
+BOOL VAR vergleich erfolgreich;
+
+PROC feld vergleichen (TEXT CONST satz, INT CONST anfang, ende) :
+
+  vergleich erfolgreich := length (feldpuffer) + anfang = ende + 1 CAND
+            pos (satz, feldpuffer, anfang, ende + 1) = anfang
+
+END PROC feld vergleichen;
+
+
+(**************************** Anhalten ***********************************)
+
+LET
+  halt error = 22101,
+  halt zeichen = "h",
+  esc = ""27"";
+
+BOOL VAR esc zustand;
+
+
+PROC halt abfrage starten :
+
+  TEXT VAR z;
+  esc zustand := FALSE;
+  REP
+    z := incharety; type (z)
+  UNTIL z = niltext END REP
+
+END PROC halt abfrage starten;
+
+PROC halt abfrage beenden :
+
+  IF esc zustand THEN
+    type (esc)
+  END IF
+
+END PROC halt abfrage beenden;
+
+BOOL PROC angehalten :
+
+  TEXT VAR z;
+  REP
+    z := incharety;
+    IF z = niltext THEN
+      LEAVE angehalten WITH FALSE
+    ELSE
+      zeichen behandeln
+    END IF
+  END REP;
+  FALSE .
+
+zeichen behandeln :
+  IF esc zustand THEN
+    esc zustand := FALSE;
+    auf halt zeichen testen
+  ELSE
+    auf esc testen
+  END IF .
+
+auf halt zeichen testen :
+  IF z = halt zeichen THEN
+    tastenpuffer loeschen;
+    errorstop (halt error, niltext);
+    LEAVE angehalten WITH TRUE
+  ELSE
+    type (esc); type (z)
+  END IF .
+
+auf esc testen :
+  IF z = esc THEN
+    esc zustand := TRUE
+  ELSE
+    type (z)
+  END IF .
+
+tastenpuffer loeschen :
+  REP UNTIL getcharety = niltext END REP .
+
+END PROC angehalten;
+
+
+(************************** Positionieren ********************************)
+
+PROC weiter (INT CONST modus) :
+
+  IF NOT ende der datei THEN
+    aenderungen eintragen;
+    nach modus weiter gehen
+  END IF .
+
+nach modus weitergehen :
+  SELECT modus OF
+  CASE 1 : einen satz weiter
+  CASE 2 : weiter bis ausgewaehlt
+  CASE 3 : weiter bis markiert
+  END SELECT .
+
+einen satz weiter :
+  weiter gehen (FALSE) .
+
+weiter bis ausgewaehlt :
+  halt abfrage starten;
+  REP
+    weiter gehen (globales muster vorhanden);
+    cout (satznummer)
+  UNTIL satz ausgewaehlt OR ende der datei OR angehalten END REP;
+  halt abfrage beenden .
+
+weiter bis markiert :
+  INT VAR satzpos := satznr (daten (hauptdatei). eudat);
+  WHILE kein markierter satz mehr AND naechste datei <> 0 REP
+    eine datei weiter;
+    satzpos := 1
+  END REP;
+  auf satz (daten (hauptdatei). eudat, naechster markierter satz);
+  cout (satznummer);
+  koppeldateien aktualisieren;
+  ende der datei := dateiende (daten (hauptdatei). eudat);
+  suchbedingung auswerten .
+
+kein markierter satz mehr :
+  mark stelle (daten (hauptdatei), satzpos + 1);
+  INT CONST naechster markierter satz :=
+    daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger;
+  naechster markierter satz = maxint .
+
+naechste datei :
+  daten (hauptdatei). naechste datei .
+
+END PROC weiter;
+
+PROC zurueck (INT CONST modus) :
+
+  IF satznummer > 1 THEN
+    aenderungen eintragen;
+    nach modus zurueckgehen
+  END IF .
+
+nach modus zurueckgehen :
+  SELECT modus OF
+  CASE 1 : einen satz zurueck
+  CASE 2 : zurueck bis ausgewaehlt
+  CASE 3 : zurueck bis markiert
+  END SELECT .
+
+einen satz zurueck :
+  zurueck gehen (FALSE) .
+
+zurueck bis ausgewaehlt :
+  halt abfrage starten;
+  REP
+    zurueck gehen (globales muster vorhanden);
+    cout (satznummer)
+  UNTIL satz ausgewaehlt OR satznummer = 1 OR angehalten END REP;
+  halt abfrage beenden .
+
+zurueck bis markiert :
+  INT VAR satzpos := satznr (daten (hauptdatei). eudat);
+  WHILE kein markierter satz mehr AND hauptdatei <> 1 REP
+    eine datei zurueck;
+    satzpos := maxint - 1
+  END REP;
+  auf satz (daten (hauptdatei). eudat, neuer satz);
+  cout (satznummer);
+  koppeldateien aktualisieren;
+  ende der datei := FALSE;
+  suchbedingung auswerten .
+
+kein markierter satz mehr :
+  INT VAR neuer satz;
+  mark stelle (daten (hauptdatei), satzpos);
+  IF daten (hauptdatei). markzeiger = 1 THEN
+    neuer satz := 1;
+    TRUE
+  ELSE
+    neuer satz := daten (hauptdatei). marksaetze ISUB
+                  (daten (hauptdatei). markzeiger - 1);
+    FALSE
+  END IF .
+
+END PROC zurueck;
+
+PROC weiter gehen (BOOL CONST muster vorgegeben) :
+
+  neue kombination suchen;
+  IF keine kombination mehr THEN
+    einen satz weiter;
+    koppeldateien aktualisieren
+  ELSE
+    kombination INCR 1
+  END IF;
+  suchbedingung auswerten .
+
+neue kombination suchen :
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex > 0 REP
+    in koppeldatei weitergehen;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+in koppeldatei weitergehen :
+  BOOL VAR match gefunden;
+  kombination suchen (daten (dateiindex), match gefunden);
+  IF match gefunden THEN
+    LEAVE neue kombination suchen
+  END IF .
+
+keine kombination mehr :
+  dateiindex = 0 .
+
+einen satz weiter :
+  IF muster vorgegeben THEN
+    weiter (daten (hauptdatei). eudat, globales muster)
+  ELSE
+    weiter (daten (hauptdatei). eudat)
+  END IF;
+  WHILE dateiende (daten (hauptdatei). eudat) REP
+    auf naechste datei
+  UNTIL ende der datei END REP .
+
+auf naechste datei :
+  IF daten (hauptdatei). naechste datei <> 0 THEN
+    eine datei weiter;
+    auf ersten satz der naechsten datei
+  ELSE
+    ende der datei := TRUE
+  END IF .
+
+auf ersten satz der naechsten datei :
+  auf satz (daten (hauptdatei). eudat, 1) .
+
+END PROC weiter gehen;
+
+PROC kombination suchen (DATEI VAR datei, BOOL VAR match gefunden) :
+
+  IF dateiende (datei. eudat) THEN
+    match gefunden := FALSE
+  ELSE
+    in datei weitergehen
+  END IF .
+
+in datei weitergehen :
+  match gefunden := TRUE;
+  REP
+    weiter (datei. eudat, datei. muster);
+    IF dateiende (datei. eudat) THEN
+      match gefunden := FALSE;
+      auf satz (datei. eudat, datei. muster)
+    END IF
+  UNTIL koppelfelder gleich (datei) END REP .
+
+END PROC kombination suchen;
+
+PROC zurueck gehen (BOOL CONST muster vorgegeben) :
+
+  WHILE satznr (daten (hauptdatei). eudat) = 1 CAND satznummer > 1 REP
+    eine datei zurueck;
+    auf dateiende (daten (hauptdatei). eudat)
+  END REP;
+  IF muster vorgegeben THEN
+    zurueck (daten (hauptdatei). eudat, globales muster)
+  ELSE
+    zurueck (daten (hauptdatei). eudat)
+  END IF;
+  ende der datei := FALSE;
+  koppeldateien aktualisieren;
+  suchbedingung auswerten
+
+END PROC zurueck gehen;
+
+PROC eine datei weiter :
+
+  satznummer offset INCR saetze (daten (hauptdatei). eudat);
+  hauptdatei := daten (hauptdatei). naechste datei
+
+END PROC eine datei weiter;
+
+PROC eine datei zurueck :
+
+  INT VAR neuer index := 1;
+  WHILE daten (neuer index). naechste datei <> hauptdatei REP
+    neuer index := daten (neuer index). naechste datei
+  END REP;
+  satznummer offset DECR saetze (daten (neuer index). eudat);
+  hauptdatei := neuer index
+
+END PROC eine datei zurueck;
+
+PROC aenderungen eintragen :
+
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    koppeldatei betrachten;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+koppeldatei betrachten :
+  IF daten (dateiindex). gepuffert THEN
+    datei aktualisieren (daten (dateiindex))
+  END IF .
+
+END PROC aenderungen eintragen;
+
+PROC datei aktualisieren (DATEI VAR datei) :
+
+  IF alter satz geaendert AND NOT koppelfelder veraendert THEN
+    satz in koppeldatei aendern
+  ELIF nicht nur koppelfelder belegt AND irgendwas veraendert THEN
+    neuen satz in koppeldatei einfuegen
+  ELIF koppelfelder veraendert THEN
+    koppeldatei aktualisieren (datei)
+  END IF;
+  puffer deaktivieren;
+  veraendert := FALSE;
+  koppelfelder veraendert := FALSE .
+
+alter satz geaendert :
+  NOT dateiende (datei. eudat) AND veraendert .
+
+nicht nur koppelfelder belegt :
+  felderzahl (satzpuffer) > datei. anz koppelfelder .
+
+irgendwas veraendert :
+  koppelfelder veraendert OR veraendert .
+
+neuen satz in koppeldatei einfuegen :
+  datei veraendert := TRUE;
+  feld lesen (satzpuffer, 1, datei. muster);
+  satz einfuegen (datei. eudat, satzpuffer) .
+
+puffer deaktivieren :
+  datei. gepuffert := FALSE .
+
+satz in koppeldatei aendern :
+  datei veraendert := TRUE;
+  satz aendern (datei. eudat, satzpuffer) .
+
+veraendert :
+  datei. veraendert .
+
+koppelfelder veraendert :
+  datei. koppelfeld veraendert .
+
+satzpuffer :
+  datei. satzpuffer .
+
+datei veraendert :
+  datei. datei veraendert .
+
+END PROC datei aktualisieren;
+
+PROC auf dateiende (EUDAT VAR eudat) :
+
+  auf satz (eudat, saetze (eudat) + 1)
+
+END PROC auf dateiende;
+
+PROC auf satz (INT CONST satznr) :
+
+  aenderungen eintragen;
+  hauptdatei := feldnamendatei;
+  satznummer offset := 0;
+  WHILE ueber datei hinaus AND noch weitere datei REP
+    eine datei weiter
+  END REP;
+  auf satz (daten (hauptdatei). eudat, satznr - satznummer offset);
+  koppeldateien aktualisieren;
+  ende der datei := dateiende (daten (hauptdatei). eudat);
+  suchbedingung auswerten .
+
+ueber datei hinaus :
+  satznr - satznummer offset > saetze (daten (hauptdatei). eudat) .
+
+noch weitere datei :
+  daten (hauptdatei). naechste datei <> 0 .
+
+END PROC auf satz;
+
+INT PROC satznummer :
+
+  satznummer offset + satznr (daten (hauptdatei). eudat)
+
+END PROC satznummer;
+
+INT PROC satzkombination :
+
+  kombination
+
+END PROC satzkombination;
+
+BOOL PROC dateiende :
+
+  ende der datei
+
+END PROC dateiende;
+
+
+(*************************** Satzverwaltung ******************************)
+
+SATZ VAR leersatz;
+satz initialisieren (leersatz);
+
+PROC satz einfuegen :
+
+  aenderungen eintragen;
+  mark satz einfuegen;
+  satz einfuegen (daten (hauptdatei). eudat, leersatz);
+  daten (hauptdatei). datei veraendert := TRUE;
+  alle koppeldateien ans ende;
+  ende der datei := FALSE;
+  suchbedingung auswerten .
+
+mark satz einfuegen :
+  mark stelle (daten (hauptdatei), satznr (daten (hauptdatei). eudat));
+  inkrement (daten (hauptdatei). marksaetze,
+             daten (hauptdatei). markzeiger, 1) .
+
+alle koppeldateien ans ende :
+  kombination := 1;
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    auf dateiende (daten (dateiindex). eudat);
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+END PROC satz einfuegen;
+
+PROC satz loeschen :
+
+  IF NOT ende der datei THEN
+    aenderungen eintragen;
+    mark satz loeschen;
+    satz loeschen (daten (hauptdatei). eudat);
+    daten (hauptdatei). datei veraendert := TRUE;
+    auf satz (satznummer)
+  END IF .
+
+mark satz loeschen :
+  IF satz markiert THEN
+    delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger);
+    markierungen DECR 1
+  END IF;
+  inkrement (daten (hauptdatei). marksaetze,
+             daten (hauptdatei). markzeiger, -1) .
+
+END PROC satz loeschen;
+
+
+(*************************** Suchmuster **********************************)
+
+LET
+  maxmuster = 100;
+
+ROW maxmuster STRUCT (INT feld, relator, true exit, false exit,
+                      TEXT muster)
+              VAR bedingung;
+
+SATZ VAR muster gespeichert;
+
+INT VAR
+  anzahl muster,
+  erster musterindex,
+  versionszaehler := 1;
+
+BOOL VAR
+  bereits ausgewertet,
+  erfuellt;
+
+suchbedingung loeschen;
+
+INT VAR
+  muster index;
+
+LET
+  gleich test = 1,
+  beginn test = 2,
+  endet test = 3,
+  enthalten test = 4,
+  kleiner test = 5,
+  groesser test = 6,
+  nicht leer test = 7,
+  markiert test = 8,
+  true test = 9;
+
+
+PROC suchbedingung auswerten :
+
+  IF ende der datei THEN
+    erfuellt := FALSE
+  ELSE
+    kette verfolgen;
+    erfuellt := in true exit
+  END IF .
+
+kette verfolgen :
+  musterindex := erster musterindex;
+  WHILE muster index > 0 REP
+    gegenfeld bearbeiten;
+    feld bearbeiten (suchfeld, 
+         PROC (TEXT CONST, INT CONST, INT CONST) bedingung ueberpruefen)
+  END REP .
+
+gegenfeld bearbeiten :
+  INT VAR verwendeter relator := bedingung (musterindex). relator;
+  IF verwendeter relator >= 256 THEN
+    gegenfeld lesen;
+    bei datum umdrehen
+  END IF .
+
+gegenfeld lesen :
+  feld lesen ((verwendeter relator AND 255) + 1, feldpuffer) .
+
+bei datum umdrehen :
+  IF jeweiliges feldinfo = 2 THEN
+    feldpuffer drehen
+  END IF;
+  bedingung (musterindex). muster := feldpuffer .
+
+suchfeld :
+  bedingung (musterindex). feld .
+
+in true exit :
+  musterindex < 0 .
+
+END PROC suchbedingung auswerten;
+
+PROC bedingung ueberpruefen (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR verwendeter relator := bedingung (musterindex). relator;
+  IF verwendeter relator >= 256 THEN
+    verwendeter relator := verwendeter relator DIV 256
+  END IF;
+  IF bedingung trifft zu THEN
+    musterindex := bedingung (musterindex). true exit
+  ELSE
+    musterindex := bedingung (musterindex). false exit
+  END IF .
+
+bedingung trifft zu :
+  SELECT verwendeter relator OF
+    CASE gleich test     :  ist gleich
+    CASE beginn test     :  beginnt mit
+    CASE endet test      :  endet mit
+    CASE enthalten test  :  ist enthalten
+    CASE kleiner test    :  ist kleiner
+    CASE groesser test   :  ist groesser
+    CASE nicht leer test :  ist nicht leer
+    CASE markiert test   :  ist markiert
+    CASE true test       :  ist true
+    OTHERWISE FALSE
+  END SELECT .
+
+ist gleich :
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : feldpuffer als subtext; feldpuffer LEXEQUAL muster
+  CASE 1 : feldpuffer als subtext; feldwert = musterwert
+  OTHERWISE length (muster) = bis - von + 1 AND text gleich
+  END SELECT .
+
+text gleich :
+  von > bis COR beginnt mit .
+
+beginnt mit :
+  pos (satz, muster, von, bis) = von .
+
+endet mit :
+  pos (satz, muster, bis + 1 - length (muster), bis) > 0 .
+
+ist enthalten :
+  pos (satz, muster, von, bis) > 0 .
+
+ist kleiner :
+  feldpuffer als subtext;
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : muster LEXGREATER feldpuffer
+  CASE 1 : feldwert < musterwert
+  CASE 2 : feldpuffer drehen; feldpuffer < muster
+  OTHERWISE feldpuffer < muster
+  END SELECT .
+
+ist groesser :
+  feldpuffer als subtext;
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : feldpuffer LEXGREATEREQUAL muster
+  CASE 1 : feldwert >= musterwert
+  CASE 2 : feldpuffer drehen; feldpuffer >= muster
+  OTHERWISE feldpuffer >= muster
+  END SELECT .
+
+ist nicht leer :
+  von <= bis .
+
+ist markiert :
+  satz markiert .
+
+ist true :
+  TRUE .
+
+feldpuffer als subtext :
+  feldpuffer := subtext (satz, von, bis) .
+
+END PROC bedingung ueberpruefen;
+
+TEXT PROC muster :
+
+  bedingung (musterindex). muster
+
+END PROC muster;
+
+PROC feldpuffer drehen :
+
+  IF length (feldpuffer) = 8 THEN
+    TEXT CONST jahr := subtext (feldpuffer, 7, 8);
+    replace (feldpuffer, 7, subtext (feldpuffer, 1, 2));
+    replace (feldpuffer, 1, jahr)
+  ELSE
+    feldpuffer := niltext
+  END IF
+
+END PROC feldpuffer drehen;
+
+INT PROC jeweiliges feldinfo :
+  feldinfo (bedingung (musterindex). feld)
+END PROC jeweiliges feldinfo;
+
+REAL PROC feldwert :
+
+  REAL VAR r;
+  wert berechnen (feldpuffer, r);
+  r
+
+END PROC feldwert;
+
+REAL PROC musterwert :
+
+  REAL VAR r;
+  wert berechnen (muster, r);
+  r
+
+END PROC musterwert;
+
+
+LET
+  grosses oder = ";",
+  kleines oder = ",",
+  intervall symbol = "..",
+  markierungssymbol = "++",
+  negation = "--",
+  stern = "*";
+
+BOOL VAR
+  neue alternative,
+  neue disjunktion,
+  verneinung;
+
+INT VAR
+  erstes feldmuster,
+  oder index,
+  naechster oder anfang,
+  anfang der disjunktion,
+  bearbeitetes feld;
+
+INTVEC VAR oder anfang;
+
+
+PROC suchbedingung (INT CONST feldnr, TEXT CONST bedingung) :
+
+  INT VAR
+    anfang := 1,
+    semi pos := 0;
+  INT CONST
+    bedingung ende := length (bedingung) + 1;
+  oder index := 0;
+  bearbeitetes feld := feldnr;
+  erstes feldmuster := anzahl muster + 1;
+  WHILE anfang < bedingung ende REP
+    feldende feststellen;
+    bedingung eintragen;
+    anfang := ende + 2
+  END REP;
+  feld aendern (muster gespeichert, feldnr, bedingung) .
+
+feldende feststellen :
+  INT VAR
+    oder pos := pos (bedingung, kleines oder, anfang);
+  IF oder pos = 0 THEN oder pos := bedingung ende END IF;
+  IF semi pos < anfang THEN
+    neue alternative beginnen
+  END IF;
+  INT CONST ende := min (oder pos, semi pos) - 1 .
+
+neue alternative beginnen :
+  oder index INCR 1;
+  neue alternative := TRUE;
+  IF oder index > 1 THEN globales muster vorhanden := FALSE END IF;
+  semi pos := pos (bedingung, grosses oder, anfang);
+  IF semi pos = 0 THEN semi pos := bedingung ende END IF .
+
+bedingung eintragen :
+  verneinung testen;
+  neue disjunktion := TRUE;
+  INT CONST
+    intervall pos := pos (bedingung, intervall symbol, anfang, ende + 1);
+  IF leere bedingung THEN
+    eintragen (niltext, true test, - oder index)
+  ELIF intervall pos = 0 THEN
+    textvergleich
+  ELSE
+    groessenvergleich
+  END IF .
+
+verneinung testen :
+  IF subtext (bedingung, anfang, anfang + 1) = negation THEN
+    anfang INCR 2; verneinung := TRUE
+  ELSE
+    verneinung := FALSE
+  END IF .
+
+leere bedingung :
+  anfang > ende .
+
+text vergleich :
+  IF test auf markierung THEN
+    test auf markierung eintragen
+  ELSE
+    sterne suchen
+  END IF .
+
+test auf markierung :
+  anfang + 1 = ende CAND 
+    subtext (bedingung, anfang, ende) = markierungssymbol .
+
+test auf markierung eintragen :
+  eintragen (niltext, markiert test, - oder index) .
+
+sterne suchen :
+  INT VAR stern pos := pos (bedingung, stern, anfang, ende + 1);
+  IF stern pos = 0 THEN
+    teste ob feld gleich
+  ELIF anfang = ende THEN
+    test auf nichtleeres feld
+  ELSE
+    relator bestimmen;
+    REP
+      teste auf enthalten sein
+    END REP
+  END IF .
+
+teste ob feld gleich :
+  IF globales muster moeglich THEN
+    globales muster vorhanden := TRUE;
+    globales muster := bedingung
+  END IF;
+  eintragen (subtext (bedingung, anfang, ende), gleich test, - oder index) .
+
+globales muster moeglich :
+  feldnr = 1 AND anfang = 1 AND ende = bedingung ende - 1 AND
+  noch keine globalen alternativen AND NOT umgeschaltet AND
+  (bedingung SUB 1) <> "&" .
+
+noch keine globalen alternativen :
+  length (oder anfang) <= 2 .
+
+test auf nichtleeres feld :
+  eintragen (niltext, nichtleer test, - oder index) .
+
+relator bestimmen :
+  INT VAR relator;
+  IF stern pos = anfang THEN
+    relator := gleich test
+  ELSE
+    relator := beginn test
+  END IF .
+
+teste auf enthalten sein :
+  IF relator <> gleich test THEN
+    teilmuster eintragen
+  END IF;
+  anfang := stern pos + 1;
+  stern pos := pos (bedingung, stern, anfang, ende + 1);
+  IF stern pos = 0 THEN
+    stern pos := ende + 1;
+    relator := endet test
+  ELSE
+    relator := enthalten test
+  END IF .
+
+teilmuster eintragen :
+  TEXT CONST muster := subtext (bedingung, anfang, stern pos - 1);
+  IF verneinung OR letztes feld THEN
+    IF verneinung THEN neue disjunktion := TRUE END IF;
+    eintragen (muster, relator, - oder index);
+    IF letztes feld THEN LEAVE sterne suchen END IF
+  ELSE
+    eintragen (muster, relator, anzahl muster + 2)
+  END IF .
+
+letztes feld :
+  stern pos >= ende .
+
+groessenvergleich :
+  TEXT CONST
+    muster 1 := subtext (bedingung, anfang, intervall pos - 1),
+    muster 2 := subtext (bedingung, intervall pos + 2, ende);
+  IF intervall pos = anfang THEN
+    eintragen (muster 2, kleiner test, - oder index)
+  ELIF intervall pos = ende - 1 THEN
+    eintragen (muster 1, groesser test, - oder index)
+  ELSE
+    intervall eintragen
+  END IF .
+
+intervall eintragen :
+  IF verneinung THEN
+    eintragen (muster 1, groesser test, - oder index);
+    neue disjunktion := TRUE
+  ELSE
+    eintragen (muster 1, groesser test, anzahl muster + 2)
+  END IF;
+  eintragen (muster 2, kleiner test, - oder index) .
+
+END PROC suchbedingung;
+
+PROC eintragen (TEXT CONST textmuster, INT CONST relator, true exit) :
+
+  musterstatus verwalten;
+  musterplatz belegen;
+  IF neue alternative THEN
+    alte false exits auf neuen anfang setzen;
+    alte true exits auf diesen platz setzen;
+    anfang der disjunktion := anzahl muster
+  ELIF neue disjunktion THEN
+    false exits der letzten disjunktion anketten
+  END IF;
+  vergleichsdaten eintragen;
+  textmuster eintragen .
+
+musterstatus verwalten :
+  bereits ausgewertet := FALSE;
+  IF anzahl muster = anzahl hauptmuster THEN
+    versionszaehler INCR 1;
+    IF versionszaehler > 32000 THEN versionszaehler := 1 END IF
+  END IF .
+
+musterplatz belegen :
+  IF anzahl muster = maxmuster THEN
+    suchbedingung loeschen;
+    errorstop (suchmuster zu umfangreich)
+  ELSE
+    anzahl muster INCR 1;
+    erster musterindex := anzahl hauptmuster + 1
+  END IF .
+
+alte false exits auf neuen anfang setzen :
+  IF oder index > length (oder anfang) DIV 2 THEN
+    oder anfang CAT anzahl muster;
+    setze verkettung (erster musterindex, 0, anzahl muster)
+  END IF;
+  IF oder index = length (oder anfang) DIV 2 THEN
+    naechster oder anfang := 0
+  ELSE
+    naechster oder anfang := oder anfang ISUB (oder index + 1)
+  END IF .
+
+alte true exits auf diesen platz setzen :
+  setze verkettung (erster musterindex, - oder index, anzahl muster);
+  neue alternative := FALSE;
+  neue disjunktion := FALSE .
+
+false exits der letzten disjunktion anketten :
+  setze verkettung (anfang der disjunktion, naechster oder anfang,
+                    anzahl muster);
+  anfang der disjunktion := anzahl muster;
+  neue disjunktion := FALSE .
+
+vergleichsdaten eintragen :
+  bedingung (anzahl muster). relator := relator;
+  bedingung (anzahl muster). feld := bearbeitetes feld;
+  IF verneinung THEN
+    bedingung (anzahl muster). true exit := naechster oder anfang;
+    bedingung (anzahl muster). false exit := true exit
+  ELSE
+    bedingung (anzahl muster). true exit := true exit;
+    bedingung (anzahl muster). false exit := naechster oder anfang
+  END IF .
+
+textmuster eintragen :
+  IF textmuster ist gegenfeld THEN
+    feldnummer des gegenfelds eintragen
+  ELSE
+    textmuster original eintragen
+  END IF .
+
+textmuster ist gegenfeld :
+  (textmuster SUB 1) = "&" CAND gueltiges feld .
+
+gueltiges feld :
+  INT CONST nr gegenfeld := feldnummer (subtext (textmuster, 2));
+  nr gegenfeld > 0 .
+
+feldnummer des gegenfelds eintragen :
+  bedingung (anzahl muster). relator := nr gegenfeld - 1 + 256 * relator .
+
+textmuster original eintragen :
+  INT CONST info := feldinfo (bearbeitetes feld);
+  IF info = 2 AND (relator = kleiner test OR relator = groesser test) THEN
+    feldpuffer := textmuster;
+    feldpuffer drehen;
+    bedingung (anzahl muster). muster := feldpuffer
+  ELSE
+    bedingung (anzahl muster). muster := textmuster
+  END IF .
+
+END PROC eintragen;
+
+PROC setze verkettung (INT CONST von, wert, durch) :
+
+  INT VAR i;
+  FOR i FROM von UPTO anzahl muster - 1 REP
+    IF bedingung (i). true exit = wert THEN
+      bedingung (i). true exit := durch
+    ELIF bedingung (i). false exit = wert THEN
+      bedingung (i). false exit := durch
+    END IF
+  END REP
+
+END PROC setze verkettung;
+
+PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) :
+
+  feld lesen (muster gespeichert, feldnr, bedingung)
+
+END PROC suchbedingung lesen;
+
+PROC suchbedingung loeschen :
+
+  disable stop;
+  IF umgeschaltet THEN
+    anzahl muster := anzahl hauptmuster
+  ELSE
+    anzahl hauptmuster := 0;
+    anzahl muster := 0
+  END IF;
+  erster musterindex := -1;
+  oder anfang := empty intvec;
+  satz initialisieren (muster gespeichert);
+  globales muster vorhanden := FALSE;
+  bereits ausgewertet := TRUE;
+  erfuellt := NOT ende der datei
+
+END PROC suchbedingung loeschen;
+
+BOOL PROC satz ausgewaehlt :
+
+  IF NOT bereits ausgewertet THEN
+    suchbedingung auswerten;
+    bereits ausgewertet := TRUE
+  END IF;
+  erfuellt
+
+END PROC satz ausgewaehlt;
+
+INT PROC suchversion :
+
+  IF anzahl muster = anzahl hauptmuster THEN
+    0
+  ELSE
+    versionszaehler
+  END IF
+
+END PROC suchversion;
+
+
+(*************************** Markierung **********************************)
+
+PROC mark stelle (DATEI VAR datei, INT CONST satz) :
+
+  IF (datei. marksaetze ISUB datei. markzeiger) < satz THEN
+    vorwaerts gehen
+  ELSE
+    rueckwaerts gehen
+  END IF .
+
+vorwaerts gehen :
+  REP
+    datei. markzeiger INCR 1
+  UNTIL (datei. marksaetze ISUB datei. markzeiger) >= satz END REP .
+
+rueckwaerts gehen :
+  WHILE datei. markzeiger > 1 CAND
+      (datei. marksaetze ISUB (datei. markzeiger - 1)) >= satz REP
+    datei. markzeiger DECR 1
+  END REP .
+
+END PROC mark stelle;
+
+PROC markierung aendern :
+
+  disable stop;
+  IF satz markiert THEN
+    delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger);
+    markierungen DECR 1
+  ELSE
+    insert (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger,
+            satznr (daten (hauptdatei). eudat));
+    markierungen INCR 1
+  END IF
+
+END PROC markierung aendern;
+
+BOOL PROC satz markiert :
+
+  INT CONST satz := satznr (daten (hauptdatei). eudat);
+  mark stelle (daten (hauptdatei), satz);
+  satz =
+    (daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger) 
+
+END PROC satz markiert;
+
+INT PROC markierte saetze :
+
+  markierungen
+
+END PROC markierte saetze;
+
+PROC markierungen loeschen :
+
+  disable stop;
+  IF umgeschaltet THEN
+    mark loeschen (daten (hauptdatei))
+  ELSE
+    in allen geketteten dateien loeschen
+  END IF;
+  markierungen := 0 .
+
+in allen geketteten dateien loeschen :
+  INT VAR dateiindex := 1;
+  REP
+    mark loeschen (daten (dateiindex));
+    dateiindex := daten (dateiindex). naechste datei
+  UNTIL dateiindex = 0 END REP .
+
+END PROC markierungen loeschen;
+
+PROC mark loeschen (DATEI VAR datei) :
+
+  datei. marksaetze := niltext;
+  datei. marksaetze CAT maxint;
+  datei. markzeiger := 1
+
+END PROC mark loeschen;
+
+
+END PACKET datenverwaltung;
+
diff --git a/app/eudas/4.4/src/eudas.drucken b/app/eudas/4.4/src/eudas.drucken
new file mode 100644
index 0000000..3176c23
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.drucken
@@ -0,0 +1,1891 @@
+PACKET eudas drucken
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Drucken von EUDAS-Dateien nach Druckmuster                        *)
+(*                                                                       *)
+(*     Version 10                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 01.10.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+(*dump,    (* Test *) *)
+
+  drucke,
+  interpretiere,
+  gruppentest,
+
+  druckdatei,
+  direkt drucken,
+  max druckzeilen,
+
+  gruppenwechsel,
+  lfd nr :
+
+
+(*************************** Musterinterpreter ***************************)
+
+(*
+  EXPORTS
+
+  INT max musterspeicher
+  INT VAR interpretationsmodus
+  interpretiere (INT CONST erste zeile, erstes muster,
+                 PROC (INT CONST, TEXT VAR) abk)
+*)
+
+
+LET
+  max musterspeicher = 25,
+  SPEICHER = STRUCT (INT  feldanfang,
+                          feldlaenge,
+                          setzmodus,
+                          bearbeitet bis,
+                     TEXT inhalt);
+
+ROW max musterspeicher SPEICHER VAR musterspeicher;
+
+INT VAR interpretationsmodus;
+
+LET
+  niltext = "",
+  blank = " ",
+  zwei blanks = "  ";
+
+TEXT VAR ausgabezeile;
+
+
+PROC interpretiere (INT CONST erste zeile, erstes muster,
+                    PROC (INT CONST, TEXT VAR) abkuerzungen) : 
+
+  INT VAR
+    kommandoindex,
+    anzahl leerzeilen := 0,
+    anzahl wiederholungen := 0,
+    aktuelles muster := erstes muster;
+
+  muster auf zeile (erste zeile);
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF leerzeile THEN
+      anzahl leerzeilen INCR 1
+    ELSE
+      letzte leerzeilen beruecksichtigen;
+      zeile auswerten
+    END IF
+  END REP .
+
+zeile auswerten :
+  IF kommandozeile (kommandoindex) THEN
+    kommando auswerten
+  ELSE
+    zeile interpretieren;
+    anzahl wiederholungen := 0
+  END IF .
+
+kommando auswerten :
+  SELECT kommandoindex OF
+  CASE modus index :  modus umstellen
+  CASE mehr index  :  anzahl wiederholungen setzen
+  OTHERWISE LEAVE interpretiere
+  END SELECT .
+
+letzte leerzeilen beruecksichtigen :
+  WHILE anzahl leerzeilen > 0 REP
+    zeile drucken (blank);
+    anzahl leerzeilen DECR 1
+  END REP .
+
+modus umstellen :
+  int param (interpretationsmodus) .
+
+anzahl wiederholungen setzen :
+  int param (anzahl wiederholungen) .
+
+leerzeile :
+  musterzeile = niltext OR musterzeile = blank .
+
+zeile interpretieren :
+  INT VAR
+    zeilenzaehler := 0,
+    zu bearbeitende inhalte := 0;
+  BOOL VAR
+    blanks dazwischen := FALSE;
+
+  REP
+    einen zeilendurchgang;
+    zeilenzaehler INCR 1;
+    IF interpretationsmodus = 3 THEN
+      blanks dazwischen := TRUE
+    END IF
+  UNTIL zeile fertig bearbeitet END REP .
+
+zeile fertig bearbeitet :
+  IF interpretationsmodus <= 2 THEN
+    TRUE
+  ELIF anzahl wiederholungen <> 0 THEN
+    zeilenzaehler = anzahl wiederholungen
+  ELSE
+    zu bearbeitende inhalte = 0
+  END IF .
+
+einen zeilendurchgang :
+  INT VAR
+    letztes feldende := 1,
+    reservelaenge := 0,
+    benoetigte reserve := 0,
+    einzulesendes muster := 1,
+    einzusetzendes muster := 1;
+
+  ausgabezeile := niltext;
+  REP
+    IF musterinhalt abspeichern THEN
+      musterinhalt besorgen
+    END IF;
+    IF festes muster THEN
+      zeilenabschnitt ausgeben
+    END IF;
+    einsetzdaten sammeln;
+    einzulesendes muster INCR 1
+  END REP .
+
+musterinhalt abspeichern :
+  zeilenzaehler = 0 .
+
+musterinhalt besorgen :
+  naechstes muster (lesespeicher. feldanfang, lesespeicher. feldlaenge,
+                    lesespeicher. setzmodus);
+  IF NOT zeilenende THEN
+    musterinhalt lesen
+  END IF .
+
+zeilenende :
+  lesespeicher. feldanfang > length (musterzeile) .
+
+musterinhalt lesen :
+  INT CONST musterfunktion := musterindex (aktuelles muster);
+  IF musterfunktion > 0 THEN
+    feld lesen (musterfunktion, lesespeicher. inhalt)
+  ELSE
+    abkuerzungen (-musterfunktion, lesespeicher. inhalt)
+  END IF;
+  aktuelles muster INCR 1;
+  lesespeicher. bearbeitet bis := 0;
+  IF lesespeicher. inhalt <> niltext THEN
+    zu bearbeitende inhalte INCR 1
+  END IF .
+
+festes muster :
+  lesespeicher. setzmodus >= 4 .
+
+lesespeicher :
+  musterspeicher (einzulesendes muster) .
+
+einsetzdaten sammeln :
+  INT CONST reserve := setzdifferenz (lesespeicher);
+  IF reserve > 0 THEN
+    reserve merken
+  ELSE
+    benoetigte reserve DECR reserve
+  END IF .
+
+reserve merken :
+  reservelaenge INCR reserve;
+  IF linksschieben verboten AND reservelaenge > benoetigte reserve THEN
+    reservelaenge := benoetigte reserve
+  END IF;
+  IF kein inhalt mehr einzusetzen AND variabel THEN
+    loeschbare blanks zaehlen
+  END IF .
+
+linksschieben verboten :
+  interpretationsmodus = 2 OR interpretationsmodus = 4 .
+
+kein inhalt mehr einzusetzen :
+  reserve = lesespeicher. feldlaenge .
+
+variabel :
+  (lesespeicher. setzmodus AND 1) = 0 .
+
+loeschbare blanks zaehlen :
+  IF lesespeicher. feldanfang = 1 COR
+     (musterzeile SUB (lesespeicher. feldanfang - 1)) = blank THEN
+    INT VAR ende := feldende (einzulesendes muster);
+    WHILE (musterzeile SUB ende) = blank REP
+      ende INCR 1;
+      lesespeicher. feldlaenge INCR 1;
+      reservelaenge INCR 1
+    END REP
+  END IF .
+
+zeilenabschnitt ausgeben :
+  IF einzulesendes muster = 1 THEN
+    IF zeilenende THEN
+      zeile ganz ausgeben
+    END IF
+  ELSE
+    zeile bis dahin zusammenstellen
+  END IF .
+
+zeile ganz ausgeben :
+  IF blanks dazwischen THEN
+    zeile drucken (blank)
+  ELSE
+    zeile drucken (musterzeile)
+  END IF;
+  LEAVE einen zeilendurchgang .
+
+zeile bis dahin zusammenstellen :
+  INT VAR
+    blankluecke := 0,
+    blankpuffer := lesespeicher. feldanfang;
+  INT CONST
+    endeluecke := blankpuffer - length (musterzeile);
+  blankluecke suchen;
+  alle zwischenliegenden muster in ausgabedatei kopieren;
+  letzten zwischenraum kopieren;
+  zeilenende behandeln .
+
+blankluecke suchen :
+  IF endeluecke > 0 THEN
+    reservelaenge INCR endeluecke;
+    blankpuffer DECR (endeluecke - 1)
+  END IF;
+  rueckwaerts zwei blanks suchen .
+
+rueckwaerts zwei blanks suchen :
+  INT CONST
+    ende voriges feld := feldende (einzulesendes muster - 1),
+    leerstelle :=
+      pos (musterzeile, zwei blanks, ende voriges feld, blankpuffer);
+  IF leerstelle > 0 THEN
+    blankpuffer := leerstelle;
+    groesse der blankluecke bestimmen
+  ELIF endeluecke < 0 AND (musterzeile SUB (blankpuffer - 1)) <> blank THEN
+    blankpuffer := ende voriges feld
+  END IF .
+
+groesse der blankluecke bestimmen :
+  INT VAR ende der luecke := blankpuffer + 1;
+  REP
+    blankluecke INCR 1;
+    ende der luecke INCR 1
+  UNTIL (musterzeile SUB ende der luecke) <> blank END REP;
+  reservelaenge INCR blankluecke .
+
+alle zwischenliegenden muster in ausgabedatei kopieren :
+  INT VAR verschiebung := 0;
+  WHILE einzusetzendes muster < einzulesendes muster REP
+    setzspeicher in einzelvariablen lesen;
+    musterzwischenraum kopieren;
+    muster einsetzen;
+    einzusetzendes muster INCR 1
+  END REP .
+
+setzspeicher in einzelvariablen lesen :
+  INT CONST
+    feldanfang := setzspeicher. feldanfang,
+    feldlaenge := setzspeicher. feldlaenge,
+    setzmodus := setzspeicher. setzmodus .
+
+musterzwischenraum kopieren :
+  zwischenraum (letztes feldende, feldanfang, blanks dazwischen);
+  letztes feldende := feldanfang + feldlaenge .
+
+setzspeicher :
+  musterspeicher (einzusetzendes muster) .
+
+muster einsetzen :
+  INT CONST ueberschuss := - setzdifferenz (setzspeicher);
+  IF ueberschuss = - feldlaenge THEN
+    leeres feld behandeln
+  ELIF ueberschuss <= 0 THEN
+    in voller laenge einsetzen
+  ELIF variable laenge AND reserve vorhanden THEN
+    einsetzen und nach rechts schieben
+  ELSE
+    bis zur grenze einsetzen
+  END IF .
+
+leeres feld behandeln :
+  IF variable laenge THEN
+    verschiebung INCR ueberschuss;
+    IF linksschieben verboten THEN
+      verschiebung korrigieren
+    END IF
+  ELSE
+    blanks anfuegen (-ueberschuss)
+  END IF .
+
+verschiebung korrigieren :
+  IF verschiebung < 0 THEN
+    blanks anfuegen (-verschiebung);
+    verschiebung := 0
+  END IF .
+
+in voller laenge einsetzen :
+  IF rechtsbuendig THEN
+    blanks anfuegen (-ueberschuss)
+  END IF;
+  musterspeicher ganz ausgeben (setzspeicher);
+  zu bearbeitende inhalte DECR 1;
+  IF feste laenge THEN
+    ggf mit blanks auffuellen
+  ELSE
+    verschiebung INCR ueberschuss;
+    linksschieben korrigieren
+  END IF .
+
+rechtsbuendig :
+  (setzmodus AND 2) = 2 .
+
+feste laenge :
+  (setzmodus AND 1) = 1 .
+
+ggf mit blanks auffuellen :
+  IF NOT rechtsbuendig THEN
+    blanks anfuegen (-ueberschuss)
+  END IF .
+
+linksschieben korrigieren :
+  IF linksschieben verboten AND verschiebung < 0 THEN
+    blanks anfuegen (-verschiebung);
+    verschiebung := 0
+  END IF .
+
+variable laenge :
+  NOT feste laenge .
+
+reserve vorhanden :
+  ueberschuss <= reservelaenge .
+
+einsetzen und nach rechts schieben :
+  musterspeicher ganz ausgeben (setzspeicher);
+  zu bearbeitende inhalte DECR 1;
+  verschiebung INCR ueberschuss;
+  reservelaenge DECR ueberschuss .
+
+bis zur grenze einsetzen :
+  INT VAR
+    umbruchblanks := 0,
+    anfang := setzspeicher. bearbeitet bis + 1,
+    setz ende := anfang + feldlaenge - 1;
+  IF variable laenge THEN
+    setz ende INCR reservelaenge
+  END IF;
+  IF rechtsbuendig AND keine mehrfachzeilen THEN
+    rechten teil einsetzen
+  ELIF mehrfachzeilen erlaubt THEN
+    umbruch
+  END IF;
+  teilfeld ausgeben;
+  IF variable laenge THEN
+    verschiebung INCR reservelaenge;
+    reservelaenge := 0
+  END IF .
+
+rechten teil einsetzen :
+  INT CONST nach rechts := length (setzspeicher. inhalt) - setz ende;
+  anfang INCR nach rechts;
+  setz ende INCR nach rechts .
+
+mehrfachzeilen erlaubt :
+  interpretationsmodus >= 3 .
+
+keine mehrfachzeilen :
+  NOT mehrfachzeilen erlaubt .
+
+teilfeld ausgeben :
+  IF rechtsbuendig THEN
+    blanks anfuegen (umbruchblanks)
+  END IF;
+  druckausgabe (setzspeicher. inhalt, anfang, setz ende);
+  IF linksbuendig THEN
+    blanks anfuegen (umbruchblanks)
+  END IF .
+
+linksbuendig :
+  NOT rechtsbuendig .
+
+umbruch :
+  IF pos (setzspeicher. inhalt, blank, anfang, setz ende) > 0 THEN
+    ende zuruecksetzen
+  END IF;
+  INT CONST naechstes wort :=
+    pos (setzspeicher. inhalt, ""33"", ""254"", setz ende + 1);
+  IF naechstes wort = 0 THEN
+    setzspeicher. bearbeitet bis := length (setzspeicher. inhalt);
+    zu bearbeitende inhalte DECR 1
+  ELSE
+    setzspeicher. bearbeitet bis := naechstes wort - 1
+  END IF .
+
+ende zuruecksetzen :
+  setz ende INCR 1; umbruchblanks DECR 1;
+  WHILE (setzspeicher. inhalt SUB setz ende) <> blank REP
+    setz ende DECR 1;
+    umbruchblanks INCR 1
+  END REP;
+  WHILE (setzspeicher. inhalt SUB setz ende)  = blank REP
+    setz ende DECR 1;
+    umbruchblanks INCR 1
+  UNTIL ende < anfang END REP .
+
+letzten zwischenraum kopieren :
+  zwischenraum (letztes feldende, blankpuffer, blanks dazwischen);
+  IF verschiebung < 0 THEN
+    IF blankpuffer <= length (musterzeile) THEN
+      blanks anfuegen (-verschiebung)
+    END IF;
+    letztes feldende := blankpuffer
+  ELSE
+    letztes feldende := blankpuffer + min (verschiebung, blankluecke)
+  END IF .
+
+zeilenende behandeln :
+  IF endeluecke > 0 THEN
+    rest der musterzeile drucken;
+    zeile ausgeben;
+    LEAVE einen zeilendurchgang
+  ELSE
+    folgenden abschnitt vorbereiten
+  END IF .
+
+rest der musterzeile drucken :
+  IF NOT blanks dazwischen THEN
+    druckausgabe (musterzeile, letztes feldende, length (musterzeile))
+  END IF .
+
+zeile ausgeben :
+  INT VAR neues ende := length (ausgabezeile);
+  IF (ausgabezeile SUB neues ende) = blank THEN
+    REP
+      neues ende DECR 1
+    UNTIL (ausgabezeile SUB neues ende) <> blank END REP;
+    ausgabezeile := subtext (ausgabezeile, 1, neues ende)
+  END IF;
+  IF absatzmarkierung noetig THEN
+    ausgabezeile CAT blank
+  END IF;
+  zeile drucken (ausgabezeile) .
+
+absatzmarkierung noetig :
+  (musterzeile SUB LENGTH musterzeile) = blank AND
+    (interpretationsmodus <> 3 OR zu bearbeitende inhalte = 0) .
+
+folgenden abschnitt vorbereiten :
+  reservelaenge := 0;
+  benoetigte reserve := 0 .
+
+END PROC interpretiere;
+
+INT PROC feldende (INT CONST speicherindex) :
+
+  musterspeicher (speicherindex). feldanfang +
+    musterspeicher (speicherindex). feldlaenge
+
+END PROC feldende;
+
+INT PROC setzdifferenz (SPEICHER CONST speicher) :
+
+  speicher. feldlaenge - length (speicher. inhalt) +
+    speicher. bearbeitet bis
+
+END PROC setzdifferenz;
+
+LET
+  zehn blanks = "          ";
+
+PROC blanks anfuegen (INT CONST anzahl) :
+
+  INT VAR zaehler := anzahl;
+  WHILE zaehler >= 10 REP
+    ausgabezeile CAT zehn blanks;
+    zaehler DECR 10
+  END REP;
+  WHILE zaehler > 0 REP
+    ausgabezeile CAT blank;
+    zaehler DECR 1
+  END REP
+
+END PROC blanks anfuegen;
+
+PROC musterspeicher ganz ausgeben (SPEICHER VAR speicher) :
+
+  IF speicher. bearbeitet bis = 0 THEN
+    ausgabezeile CAT speicher. inhalt
+  ELSE
+    druckausgabe (speicher. inhalt, speicher. bearbeitet bis + 1,
+                  length (speicher. inhalt))
+  END IF;
+  speicher. bearbeitet bis := length (speicher. inhalt)
+
+END PROC musterspeicher ganz ausgeben;
+
+PROC zwischenraum (INT CONST von, bis, BOOL CONST blanks dazwischen) :
+
+  IF blanks dazwischen THEN
+    blanks anfuegen (bis - von)
+  ELSE
+    druckausgabe (musterzeile, von, bis - 1)
+  END IF
+
+END PROC zwischenraum;
+
+TEXT VAR ausgabepuffer;
+
+PROC druckausgabe (TEXT CONST context, INT CONST von, bis) :
+
+  ausgabepuffer := subtext (context, von, bis);
+  ausgabezeile CAT ausgabepuffer
+
+END PROC druckausgabe;
+
+
+(************************* Musterscanner *********************************)
+
+(*
+  EXPORTS
+
+  FILE VAR druckmuster
+  naechstes muster (TEXT VAR mustername)
+  naechstes muster (INT VAR musteranfang, musterlaenge, setzmodus)
+  musterzeile lesen
+  TEXT musterzeile
+  INT zeilennr
+  muster auf zeile (INT CONST neue zeile)
+  BOOL kommandozeile (INT VAR kommandoindex)
+  int param (INT VAR param)
+  INT m pos
+  BOOL druckmusterende
+  ueberlesen (TEXT CONST zeichen)
+  INT musterzeilenbreite
+  standard musterzeilenbreite
+*)
+
+
+FILE VAR druckmuster;
+
+TEXT VAR musterzeile;
+
+INT VAR m pos;
+
+LET
+  keine schliessende klammer =  #401#
+    "keine schliessende Klammer in Feldmuster",
+  kein kommando in kommandozeile =  #402#
+    "kein Kommando in Kommandozeile",
+  unbekanntes kommando =  #403#
+    "unbekanntes Kommando";
+
+LET
+  fix symbol = "&",
+  var symbol = "%",
+  com symbol = "%",
+  klammer auf = "<",
+  klammer zu = ">";
+
+LET
+  kommandos =  #404#
+   " "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN
+   "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "
+ 
+
+LET
+  vor index     = 1,
+  wdh index     = 2,
+  nach index    = 3,
+  abk index     = 4,
+  gruppe index  = 5,
+  modus index   = 6,
+  mehr index    = 7,
+  do index      = 100;
+ 
+INT VAR
+  musterzeilenbreite,
+  name anfang,
+  name ende;
+
+BOOL VAR
+  druckmusterende,
+  zeile gelesen;
+
+
+.
+zeilennr :
+  line no (druckmuster) .
+
+standard musterzeilenbreite :
+  musterzeilenbreite := maxlinelength (druckmuster) .
+
+
+PROC ueberlesen (TEXT CONST zeichen) :
+
+  REP
+    m pos INCR 1
+  UNTIL (musterzeile SUB m pos) <> zeichen END REP
+
+END PROC ueberlesen;
+
+PROC naechstes muster (INT VAR anfang, laenge, setzmodus) :
+
+  m pos auf naechsten anfang;
+  IF zeilenende THEN
+    anfang := max (musterzeilenbreite, length (musterzeile)) + 1;
+    laenge := 0;
+    setzmodus := 5
+  ELSE
+    anfang := m pos;
+    muster lesen
+  END IF .
+
+m pos auf naechsten anfang :
+  m pos auf zeichen (fix symbol, var symbol) .
+
+zeilenende :
+  m pos > length (musterzeile) .
+
+muster lesen :
+  TEXT CONST musterzeichen := musterzeile SUB m pos;
+  IF musterzeichen = var symbol THEN
+    setzmodus := 0
+  ELSE
+    setzmodus := 4
+  END IF;
+  anfangszeichen ueberlesen;
+  feldnamen lesen;
+  endezeichen ueberlesen .
+ 
+anfangszeichen ueberlesen :
+  ueberlesen (musterzeichen);
+  IF m pos - 1 > anfang THEN
+    ist rechtsbuendig
+  END IF .
+
+ist rechtsbuendig :
+  setzmodus INCR 3 .
+
+feldnamen lesen :
+  IF (musterzeile SUB m pos) = klammer auf THEN
+    bis klammer zu lesen
+  ELSE
+    bis blank oder muster lesen
+  END IF;
+  IF leerer feldname THEN
+    naechstes muster (anfang, laenge, setzmodus);
+    LEAVE naechstes muster
+  END IF .
+
+leerer feldname :
+  name anfang > name ende .
+
+bis klammer zu lesen :
+  name anfang := m pos + 1;
+  name ende := pos (musterzeile, klammer zu, name anfang);
+  IF name ende = 0 THEN
+    fehler (keine schliessende klammer, subtext (musterzeile, m pos));
+    name ende := length (musterzeile)
+  ELSE
+    name ende DECR 1
+  END IF;
+  m pos := name ende + 2 .
+
+bis blank oder muster lesen :
+  name anfang := m pos;
+  m pos auf zeichen (blank, var symbol);
+  INT CONST zwischenpos := pos (musterzeile, fix symbol, name anfang, m pos);
+  IF zwischenpos > 0 THEN
+    m pos := zwischenpos
+  END IF;
+  name ende := m pos - 1 .
+
+endezeichen ueberlesen :
+  IF musterzeichen angetroffen THEN
+    ist fest;
+    ueberlesen (musterzeichen)
+  END IF;
+  laenge := m pos - anfang .
+
+musterzeichen angetroffen :
+  (musterzeile SUB m pos) = musterzeichen .
+
+ist fest :
+  setzmodus := setzmodus OR 1 .
+
+END PROC naechstes muster;
+
+PROC naechstes muster (TEXT VAR name) :
+
+  INT VAR d1, laenge, d3;
+  naechstes muster (d1, laenge, d3);
+  IF laenge > 0 THEN
+    name := subtext (musterzeile, name anfang, name ende)
+  ELSE
+    name := niltext
+  END IF
+
+END PROC naechstes muster;
+
+PROC m pos auf zeichen (TEXT CONST zeichen 1, zeichen 2) :
+
+  INT CONST 
+    pos 1 := pos (musterzeile, zeichen 1, m pos),
+    pos 2 := pos (musterzeile, zeichen 2, m pos);
+  m pos := length (musterzeile) + 1;
+  IF pos 1 > 0 THEN
+    m pos := pos 1
+  END IF;
+  IF pos 2 > 0 AND pos 2 < m pos THEN
+    m pos := pos 2
+  END IF
+
+END PROC m pos auf zeichen;
+
+PROC muster auf zeile (INT CONST zeile) :
+
+  to line (druckmuster, zeile);
+  zeile gelesen := FALSE;
+  druckmusterende := eof (druckmuster)
+
+END PROC muster auf zeile;
+
+PROC musterzeile lesen :
+
+  IF zeile gelesen THEN
+    down (druckmuster)
+  ELSE
+    zeile gelesen := TRUE
+  END IF;
+  read record (druckmuster, musterzeile);
+  m pos := 1;
+  druckmusterende := line no (druckmuster) >= lines (druckmuster)
+
+END PROC musterzeile lesen;
+
+BOOL PROC kommandozeile (INT VAR kommandoindex) :
+
+  m pos := 1;
+  IF (musterzeile SUB 1) <> com symbol THEN
+    FALSE
+  ELIF (musterzeile SUB 2) <> com symbol THEN
+    kommando abtrennen;
+    kommandoindex bestimmen;
+    TRUE
+  ELSE
+    kommandoindex := do index;
+    TRUE
+  END IF .
+
+kommando abtrennen :
+  TEXT VAR kommando;
+  ueberlesen (blank);
+  IF m pos > length (musterzeile) THEN
+    fehler (kein kommando in kommandozeile, musterzeile);
+    kommandoindex := 0;
+    LEAVE kommandozeile WITH TRUE
+  END IF;
+  INT CONST blank pos := pos (musterzeile, blank, m pos);
+  IF blank pos = 0 THEN
+    kommando := subtext (musterzeile, m pos);
+    kommando CAT blank;
+    m pos := length (musterzeile) + 1
+  ELSE
+    kommando := subtext (musterzeile, m pos, blank pos);
+    m pos := blank pos
+  END IF .
+
+kommandoindex bestimmen :
+  INT CONST wo := pos (kommandos, kommando);
+  IF wo > 0 CAND (kommandos SUB (wo - 2)) = blank THEN
+    kommandoindex := code (kommandos SUB (wo - 1))
+  ELSE
+    kommandoindex := 0;
+    fehler (unbekanntes kommando, kommando);
+  END IF .
+
+END PROC kommandozeile;
+
+PROC int param (INT VAR param) :
+
+  ueberlesen (blank);
+  INT CONST par anfang := m pos;
+  WHILE ziffer REP
+    m pos INCR 1
+  END REP;
+  IF m pos > par anfang THEN
+    param := int (subtext (musterzeile, par anfang, m pos - 1))
+  ELSE
+    param := -1
+  END IF .
+
+ziffer :
+  pos ("0123456789", musterzeile SUB m pos) > 0 .
+
+END PROC int param;
+
+
+(**************************** Codegenerierung ****************************)
+
+(*
+  EXPORTS
+
+  FILE VAR programm
+  BOOL wird uebersetzt
+  proc name (TEXT CONST name)
+  end proc
+  anweisung (TEXT CONST text)
+  anweisung (TEXT CONST pre, mid, post)
+  anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post)
+  interpret anweisung (INT CONST zeile, muster)
+*)
+
+FILE VAR programm;
+
+TEXT VAR
+  aktuelle proc;
+
+BOOL VAR
+  wird uebersetzt;
+
+
+PROC proc name (TEXT CONST name) :
+
+  aktuelle proc := name;
+  programmausgabe ("PROC ", name, " :")
+
+END PROC proc name;
+
+PROC end proc :
+
+  programmausgabe ("END PROC ", aktuelle proc, ";")
+
+END PROC end proc;
+
+PROC anweisung (TEXT CONST programmtext) :
+
+  wird uebersetzt := TRUE;
+  putline (programm, programmtext)
+
+END PROC anweisung;
+
+PROC anweisung (TEXT CONST pre, mid, post) :
+
+  wird uebersetzt := TRUE;
+  programmausgabe (pre, mid, post)
+
+END PROC anweisung;
+
+PROC programmausgabe (TEXT CONST pre, mid, post) :
+
+  write (programm, pre);
+  write (programm, mid);
+  write (programm, post);
+  line (programm)
+
+END PROC programmausgabe;
+
+TEXT VAR textpuffer;
+
+PROC anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) :
+
+  text puffer := subtext (musterzeile, spalte);
+  anweisung (pre, textpuffer, post)
+
+END PROC anweisung;
+
+PROC interpret anweisung (INT CONST zeile, muster) :
+
+  programmausgabe (";  interpretiere (",
+                  text (zeile) + ", " + text (muster),
+                  ", PROC (INT CONST, TEXT VAR) abk);")
+
+END PROC interpret anweisung;
+
+
+(************************ Muster uebersetzen *****************************)
+
+(*
+  EXPORTS
+
+  druckmuster uebersetzen
+  ROW 3 ABSCHNITT VAR abschnitte
+  ROW max muster INT VAR musterindex
+  fehler (TEXT CONST meldung)
+  ROW maxgruppen GRUPPE VAR gruppen
+
+*)
+
+
+LET
+  vorzeitiges ende =  #405#
+    "kein % WIEDERHOLUNG gefunden",
+  nur gruppe erlaubt =  #406#
+    "Nur GRUPPE-Anweisung erlaubt",
+  kein do mehr erlaubt nach gruppen =  #407#
+    "keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",
+  illegale gruppennummer =  #408#
+    "illegale Gruppennummer",
+  gruppe schon definiert =  #409#
+    "diese Gruppe wurde schon definiert",
+  abkuerzung nicht definiert =  #410#
+    "diese Abkuerzung ist nicht definiert",
+  abschnitt mehrfach definiert =  #411#
+    "dieser Abschnitt wurde schon einmal definiert",
+  falscher modus =  #412#
+    "falscher Modus",
+  im musterteil nicht erlaubt =  #413#
+    "diese Anweisung darf im Musterteil nicht vorkommen",
+  im abkuerzungsteil nicht erlaubt =  #414#
+    "im Abkuerzungsteil darf keine Anweisung auftreten",
+  zuviele muster pro zeile =  #415#
+    "in dieser Zeile stehen zu viele Feldmuster",
+  zuviele muster =  #416#
+    "das Druckmuster enthaelt zu viele Feldmuster",
+  name der abkuerzung fehlt =  #417#
+    "nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",
+  kein doppelpunkt nach abkuerzung =  #418#
+    "kein Doppelpunkt nach Abkuerzung",
+  abkuerzung mehrfach definiert =  #419#
+    "Abkuerzung mehrfach definiert",
+  zu viele abkuerzungen =  #420#
+    "das Druckmuster enthaelt zu viele Abkuerzungen";
+
+LET
+  max muster = 200,
+  max gruppen = 4,
+  max abkuerzungen = 250,
+
+  GRUPPE = STRUCT (BOOL wechsel,
+                        definiert,
+                   TEXT inhalt),
+
+  ABSCHNITT = STRUCT (INT  erstes muster,
+                           erste zeile,
+                      TEXT proc name);
+
+
+ROW max muster INT VAR musterindex;
+
+INT VAR anzahl muster;
+
+ROW maxgruppen GRUPPE VAR gruppen;
+
+ROW 3 ABSCHNITT VAR abschnitte;
+
+SATZ VAR abkuerzungen;
+
+TEXT VAR
+  abkuerzungszeile;
+
+INT VAR
+  anzahl abkuerzungen;
+
+
+OP CAT (TEXT VAR intvec, INT CONST wert) :
+
+  TEXT VAR platz fuer int := "  ";
+  replace (platz fuer int, 1, wert);
+  intvec CAT platz fuer int
+
+END OP CAT;
+
+PROC druckmuster uebersetzen :
+
+  enable stop;
+  muster auf zeile (1);
+  uebersetzungsvariablen initialisieren;
+  initialisierungsteil uebersetzen;
+  WHILE NOT druckmusterende REP
+    einen von drei abschnitten uebersetzen
+  END REP;
+  abkuerzungen einsetzen .
+
+uebersetzungsvariablen initialisieren :
+  INT VAR kommandoindex;
+  INT VAR i;
+  anzahl abkuerzungen := 0;
+  satz initialisieren (abkuerzungen);
+  abkuerzungszeile := niltext;
+  anzahl muster := 0;
+  wird uebersetzt := FALSE;
+  abschnitte (1) := ABSCHNITT : (0, 0, "vorspann");
+  abschnitte (2) := ABSCHNITT : (0, 0, "wdh");
+  abschnitte (3) := ABSCHNITT : (0, 0, "nachspann");
+  FOR i FROM 1 UPTO max gruppen REP
+    gruppen (i). definiert := FALSE
+  END REP .
+
+initialisierungsteil uebersetzen :
+  BOOL VAR
+    schon gruppendefinition := FALSE;
+
+  REP
+    IF druckmusterende THEN
+      fehler (vorzeitiges ende);
+      LEAVE druckmuster uebersetzen
+    END IF;
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      initialisierungskommando uebersetzen
+    END IF
+  END REP .
+
+initialisierungskommando uebersetzen :
+  SELECT kommandoindex OF
+
+  CASE do index :
+    do kommando kopieren
+
+  CASE gruppe index :
+    gruppendefinition aufnehmen
+
+  CASE vor index, wdh index, nach index :
+    IF NOT schon gruppendefinition THEN
+      proc name ("gruppen")
+    END IF;
+    end proc;
+    LEAVE initialisierungsteil uebersetzen
+
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (nur gruppe erlaubt)
+    END IF
+
+  END SELECT .
+
+do kommando kopieren :
+  IF schon gruppendefinition THEN
+    fehler (kein do mehr erlaubt nach gruppen, musterzeile)
+  ELSE
+    replace (musterzeile, 1, "  ");
+    anweisung (musterzeile)
+  END IF .
+
+gruppendefinition aufnehmen :
+  IF NOT schon gruppendefinition THEN
+    proc name ("gruppen");
+    schon gruppendefinition := TRUE
+  END IF;
+  INT VAR gruppennr;
+  int param (gruppennr);
+  IF gruppennr < 1 OR gruppennr > max gruppen THEN
+    fehler (illegale gruppennummer, musterzeile)
+  ELIF gruppen (gruppennr). definiert THEN
+    fehler (gruppe schon definiert, musterzeile)
+  ELSE
+    gruppen (gruppennr). definiert := TRUE;
+    ausdruck uebersetzen
+  END IF .
+
+ausdruck uebersetzen :
+  anweisung ("gruppentest (", text (gruppennr), ", ");
+  anweisung ("            ", m pos, ");") .
+
+einen von drei abschnitten uebersetzen :
+  SELECT kommandoindex OF
+  CASE vor index  :  vorspann uebersetzen
+  CASE wdh index  :  wiederholungsteil uebersetzen
+  CASE nach index :  nachspann uebersetzen
+  END SELECT .
+
+vorspann uebersetzen :
+  abschnitt uebersetzen (abschnitte (1), kommandoindex) .
+
+wiederholungsteil uebersetzen :
+  int param (spalten); int param (spaltenbreite);
+  abschnitt uebersetzen (abschnitte (2), kommandoindex) .
+
+nachspann uebersetzen :
+  abschnitt uebersetzen (abschnitte (3), kommandoindex) .
+
+abkuerzungen einsetzen :
+  IF wird uebersetzt THEN
+    fehlende procs definieren;
+    abk headline
+  END IF;
+  abkuerzungen ueberpruefen;
+  IF wird uebersetzt THEN
+    abk ende;
+    druckaufruf
+  END IF .
+
+abkuerzungen ueberpruefen :
+  FOR i FROM 1 UPTO anzahl abkuerzungen REP
+    IF (abkuerzungszeile ISUB i) > 0 THEN
+      fehler (abkuerzung nicht definiert,
+              name der abkuerzung, abkuerzungszeile ISUB i)
+    ELSE
+      anweisung in abk proc generieren
+    END IF
+  END REP .
+
+name der abkuerzung :
+  TEXT VAR puffer;
+  feld lesen (abkuerzungen, i, puffer);
+  puffer .
+
+fehlende procs definieren :
+  FOR i FROM 1 UPTO 3 REP
+    IF abschnitte (i). erste zeile = 0 THEN
+      abschnitt proc definieren
+    END IF
+  END REP .
+
+abschnitt proc definieren :
+  proc name (abschnitte (i). proc name);
+  end proc .
+
+abk headline :
+  anweisung ("PROC abk (INT CONST nr, TEXT VAR inhalt) :");
+  IF anzahl abkuerzungen > 0 THEN
+    anweisung ("SELECT nr OF")
+  ELSE
+    anweisung ("inhalt := text (nr)")
+  END IF .
+
+anweisung in abk proc generieren :
+  TEXT CONST lfd index := text (i);
+  anweisung ("CASE " + lfd index, " : inhalt := abk", lfd index) .
+
+abk ende :
+  IF anzahl abkuerzungen > 0 THEN
+    anweisung ("END SELECT")
+  END IF;
+  anweisung ("END PROC abk;") .
+
+druckaufruf :
+  anweisung
+    ("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)") .
+
+END PROC druckmuster uebersetzen;
+
+PROC abschnitt uebersetzen (ABSCHNITT VAR abschnitt,
+                            INT VAR kommandoindex) :
+
+  BOOL VAR war do zeile := TRUE;  (* generiert erstes 'interpretiere' *)
+  proc name (abschnitt. proc name);
+  abschnitt anfang speichern;
+  musterteil uebersetzen;
+  abkuerzungen uebersetzen .
+
+abschnitt anfang speichern :
+  IF abschnitt. erste zeile <> 0 THEN
+    fehler (abschnitt mehrfach definiert, musterzeile)
+  END IF;
+  abschnitt. erste zeile := zeilennr + 1;
+  abschnitt. erstes muster := anzahl muster + 1 .
+
+musterteil uebersetzen :
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      abschnitt kommando uebersetzen
+    ELSE
+      interpret anweisung generieren;
+      musterzeile auf feldmuster untersuchen
+    END IF
+  END REP;
+  abschnitt beenden;
+  LEAVE abschnitt uebersetzen .
+
+abschnitt kommando uebersetzen :
+  SELECT kommandoindex OF
+
+  CASE do index :
+    replace (musterzeile, 1, "  ");
+    anweisung (musterzeile);
+    war do zeile := TRUE
+
+  CASE vor index, wdh index, nach index :
+    abschnitt beenden;
+    LEAVE abschnitt uebersetzen
+
+  CASE abk index :
+    abschnitt beenden;
+    LEAVE musterteil uebersetzen
+
+  CASE modus index :
+    interpret anweisung generieren;
+    INT VAR parameter;
+    int param (parameter);
+    IF parameter < 1 OR parameter > 4 THEN
+      fehler (falscher modus, musterzeile)
+    END IF
+
+  CASE mehr index :
+    interpret anweisung generieren
+
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (im musterteil nicht erlaubt)
+    END IF
+
+  END SELECT .
+
+interpret anweisung generieren :
+  IF war do zeile THEN
+    interpret anweisung (zeilennr, anzahl muster + 1);
+    war do zeile := FALSE
+  END IF .
+
+abschnitt beenden :
+  end proc .
+
+musterzeile auf feldmuster untersuchen :
+  TEXT VAR name;
+  INT VAR muster pro zeile := 0;
+ 
+  REP
+    naechstes muster (name);
+    IF name = niltext THEN
+      LEAVE musterzeile auf feldmuster untersuchen
+    END IF;
+    muster pro zeile INCR 1;
+    muster uebersetzen
+  END REP .
+
+muster uebersetzen :
+  IF muster pro zeile >= max musterspeicher THEN
+    fehler (zu viele muster pro zeile)
+  END IF;
+  IF anzahl muster = max muster THEN
+    fehler (zu viele muster)
+  ELSE
+    anzahl muster INCR 1
+  END IF;
+  vorlaeufigen musterindex suchen .
+
+vorlaeufigen musterindex suchen :
+  INT VAR feldnr := feldnummer (name);
+  IF feldnr = 0 THEN
+    feldnr := feldindex (abkuerzungen, name);
+    IF feldnr = 0 THEN
+      abkuerzung eintragen (name, zeilennr);
+      musterindex (anzahl muster) := -anzahl abkuerzungen
+    ELSE
+      musterindex (anzahl muster) := -feldnr
+    END IF
+  ELSE
+    musterindex (anzahl muster) := feldnr
+  END IF .
+
+abkuerzungen uebersetzen :
+  BOOL VAR erste abkuerzungszeile := TRUE;
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      auf ende pruefen
+    ELIF zeile nicht leer THEN
+      abkuerzung behandeln
+    END IF
+  END REP .
+
+auf ende pruefen :
+  SELECT kommandoindex OF
+  CASE vor index, wdh index, nach index :
+    LEAVE abkuerzungen uebersetzen
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (im abkuerzungsteil nicht erlaubt)
+    END IF
+  END SELECT .
+
+abkuerzung behandeln :
+  IF erste abkuerzungszeile THEN
+    anweisung (".");
+    erste abkuerzungszeile := FALSE
+  END IF;
+  IF erste zeile einer abkuerzung THEN
+    namen isolieren
+  ELSE
+    anweisung (musterzeile)
+  END IF .
+
+erste zeile einer abkuerzung :
+  (musterzeile SUB 1) = fix symbol .
+
+namen isolieren :
+  TEXT VAR abkuerzungsname;
+  naechstes muster (abkuerzungsname);
+  IF abkuerzungsname = niltext THEN
+    fehler (name der abkuerzung fehlt, musterzeile);
+    LEAVE namen isolieren
+  END IF;
+  doppelpunkt suchen;
+  an compiler uebergeben .
+
+doppelpunkt suchen :
+  LET doppelpunkt = ":";
+  m pos DECR 1;   (* wegen 'ueberlesen' *)
+  ueberlesen (blank);
+  IF (musterzeile SUB m pos) = doppelpunkt THEN
+    m pos INCR 1
+  ELSE
+    fehler (kein doppelpunkt nach abkuerzung, musterzeile)
+  END IF .
+
+an compiler uebergeben :
+  abkuerzung eintragen (abkuerzungsname, 0);
+  anweisung (refinement name, m pos - 1, "") .
+
+refinement name :
+  "abk" + text (feldindex (abkuerzungen, abkuerzungsname)) .
+
+zeile nicht leer :
+  musterzeile <> niltext AND musterzeile <> blank .
+
+END PROC abschnitt uebersetzen;
+
+PROC abkuerzung eintragen (TEXT CONST name, INT CONST zeile) :
+
+  INT CONST vorhanden := feldindex (abkuerzungen, name);
+  IF vorhanden > 0 THEN
+    alten eintrag ergaenzen
+  ELSE
+    neu anlegen
+  END IF .
+
+alten eintrag ergaenzen :
+  IF (abkuerzungszeile ISUB vorhanden) > 0 THEN
+    replace (abkuerzungszeile, vorhanden, zeile) 
+  ELIF zeile = 0 THEN
+    fehler (abkuerzung mehrfach definiert, name)
+  END IF .
+
+neu anlegen :
+  IF anzahl abkuerzungen = max abkuerzungen THEN
+    fehler (zu viele abkuerzungen)
+  ELSE
+    anzahl abkuerzungen INCR 1
+  END IF;
+  abkuerzungszeile CAT zeile;
+  feld aendern (abkuerzungen, anzahl abkuerzungen, name) .
+
+END PROC abkuerzung eintragen;
+
+LET
+  fehler in =  #421#
+    "FEHLER in Zeile ",
+  fehler bei =  #422#
+    " bei >>",
+  fehler ende =  #423#
+    "<<";
+
+PROC fehler (TEXT CONST fehlermeldung, bei, INT CONST zeile) :
+
+  LET
+    blanks = "   ";
+  TEXT VAR
+    meldung := fehler in;
+  meldung CAT text (zeile);
+  IF bei <> niltext THEN
+    meldung CAT fehler bei;
+    meldung CAT bei;
+    meldung CAT fehler ende
+  END IF;
+  note (meldung); note line;
+  note (blanks); note (fehlermeldung); note line;
+  IF online AND command dialogue THEN
+    line;
+    putline (meldung);
+    put (blanks); putline (fehlermeldung)
+  END IF
+
+END PROC fehler;
+
+PROC fehler (TEXT CONST fehlermeldung) :
+
+  fehler (fehlermeldung, niltext, zeilennr)
+
+END PROC fehler;
+
+PROC fehler (TEXT CONST fehlermeldung, bei) :
+
+  fehler (fehlermeldung, bei, zeilennr)
+
+END PROC fehler;
+
+
+(************************** Drucksteuerung *******************************)
+
+(*
+  EXPORTS
+
+  drucke (TEXT CONST dateiname)
+  drucke (PROC gruppen, PROC vor, PROC wdh, PROC nach)
+  druckdatei (TEXT CONST dateiname)
+  direkt drucken (BOOL CONST modus)
+  BOOL direkt drucken
+  max druckzeilen (INT CONST zeilen)
+  BOOL gruppenwechsel (INT CONST gruppennr)
+  gruppentest (INT CONST gruppe, TEXT CONST merkmal)
+  TEXT lfd nr
+  zeile drucken (TEXT CONST zeile)
+  INT spalten
+  INT spaltenbreite
+*)
+
+
+LET
+  erzeugtes programm =   #424#
+    "erzeugtes Programm",
+  keine datei geoeffnet =  #425#
+    "keine Datei geoeffnet",
+  interner fehler =  #426#
+    "interner Fehler",
+  druckausgabe steht in =  #427#
+    "Druckausgabe steht in",
+  zum drucker geschickt =  #428#
+    "zum Drucker geschickt.",
+  direkt drucken nicht moeglich =  #429#
+    "direkt Drucken nicht moeglich",
+  eudas ausgabe punkt =  #430#
+    ".a$";
+
+TEXT VAR
+  spaltenpuffer,
+  druckdateiname;
+
+BOOL VAR
+  wechsel erfolgt,
+  wechsel 0,
+  externer dateiname,
+  direkt ausdrucken;
+
+FILE VAR ausgabe;
+
+INT VAR
+  spalten,
+  spaltenbreite,
+  gedruckte spalten,
+  gemeinsamer anfang,
+  gedruckte zeilen,
+  max zeilen := 4000,
+  satzzaehler;
+
+
+PROC drucke :
+
+  drucke (last param)
+
+END PROC drucke;
+
+PROC drucke (TEXT CONST dateiname) :
+
+  enable stop;
+  last param (dateiname);
+  druckmuster := sequential file (input, dateiname);
+  modify (druckmuster);
+  IF anzahl dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  disable stop;
+  programmdatei einrichten;
+  druckmuster uebersetzen;
+  IF anything noted THEN
+    note edit (druckmuster)
+  ELIF wird uebersetzt THEN
+    programm uebersetzen
+  ELSE
+    drucke (PROC dummy gruppentest,
+            PROC std vor, PROC std wdh, PROC std nach)
+  END IF;
+  forget (programmdatei, quiet) .
+
+programmdatei einrichten :
+  TEXT VAR programmdatei;
+  INT VAR i := 0;
+  REP
+    i INCR 1;
+    programmdatei := text (i)
+  UNTIL NOT exists (programmdatei) END REP;
+  programm := sequential file (output, programmdatei);
+  headline (programm, erzeugtes programm) .
+
+programm uebersetzen : 
+  run (programmdatei);
+  last param (dateiname) .
+
+END PROC drucke;
+
+PROC dummy gruppentest :  END PROC dummy gruppentest;
+
+PROC std vor :
+
+  abschnitt ausfuehren (1)
+
+END PROC std vor;
+
+PROC std wdh :
+
+  abschnitt ausfuehren (2)
+
+END PROC std wdh;
+
+PROC std nach :
+
+  abschnitt ausfuehren (3)
+
+END PROC std nach;
+
+PROC abschnitt ausfuehren (INT CONST nr) :
+
+  IF abschnitte (nr). erste zeile > 0 THEN
+    interpretiere (abschnitte (nr). erste zeile,
+                   abschnitte (nr). erstes muster,
+                   PROC (INT CONST, TEXT VAR) std abk)
+  END IF
+
+END PROC abschnitt ausfuehren;
+
+PROC std abk (INT CONST nr, TEXT VAR inhalt) :
+
+  errorstop (interner fehler);
+  inhalt := code (nr)         (* Dummy-Anweisung, damit Parameter benutzt *)
+
+END PROC std abk;
+
+PROC drucke (PROC grp test, PROC vorspann, PROC wdh, PROC nachspann) :
+
+  INT VAR
+    modus,
+    letzter satz,
+    letzte kombination;
+
+  enable stop;
+  druckdatei eroeffnen;
+  auf ersten satz;
+  gruppen initialisieren;
+  satzzaehler := 1;
+  WHILE NOT dateiende REP
+    bei gruppenwechsel nachspann und vorspann;
+    cout (satznummer);
+    wiederholungsteil interpretieren;
+    weiter (modus);
+    ende der druckdatei ueberpruefen
+  END REP;
+  letzten nachspann drucken;
+  datei ausdrucken;
+  auf satz (1) .
+
+auf ersten satz :
+  letzter satz := 0;
+  auf satz (1);
+  IF markierte saetze > 0 THEN
+    modus := 3;
+    IF NOT satz markiert THEN weiter (modus) END IF
+  ELSE
+    modus := 2;
+    IF NOT satz ausgewaehlt THEN weiter (modus) END IF
+  END IF .
+
+gruppen initialisieren :
+  INT VAR i;
+  FOR i FROM 1 UPTO maxgruppen REP
+    gruppen (i). inhalt := niltext
+  END REP .
+
+bei gruppenwechsel nachspann und vorspann :
+  IF letzter satz = 0 THEN
+    grp test;
+    alle gruppen wechseln;
+    abschnitt interpretieren (PROC vorspann)
+  ELSE
+    wechsel 0 := FALSE;
+    gruppenwechsel testen;
+    gruppenwechsel mit nachspann
+  END IF;
+  letzter satz := satznummer;
+  letzte kombination := satzkombination .
+
+gruppenwechsel testen :
+  wechsel erfolgt := FALSE;
+  grp test .
+
+gruppenwechsel mit nachspann :
+  IF wechsel erfolgt THEN
+    nachspann drucken (letzter satz, letzte kombination, PROC nachspann)
+  END IF;
+  satzzaehler INCR 1;
+  IF wechsel erfolgt THEN
+    abschnitt interpretieren (PROC vorspann)
+  END IF .
+
+wiederholungsteil interpretieren :
+  IF spaltenbreite < 1 THEN
+    standard musterzeilenbreite
+  ELSE
+    musterzeilenbreite := spaltenbreite
+  END IF;
+  IF gedruckte spalten < spalten THEN
+    to line (ausgabe, gemeinsamer anfang)
+  ELSE
+    to line (ausgabe, gedruckte zeilen + 1);
+    gemeinsamer anfang := gedruckte zeilen + 1;
+    gedruckte spalten := 0
+  END IF;
+  interpretationsmodus := 1;
+  wdh;
+  gedruckte spalten INCR 1 .
+
+ende der druckdatei ueberpruefen :
+  IF gedruckte zeilen > maxzeilen THEN
+    datei ausdrucken;
+    druckdatei eroeffnen
+  END IF .
+
+letzten nachspann drucken :
+  alle gruppen wechseln;
+  IF letzter satz = 0 THEN
+    abschnitt interpretieren (PROC nachspann)
+  ELSE
+    nachspann drucken (letzter satz, letzte kombination, PROC nachspann)
+  END IF;
+  muster auf zeile (1) .
+
+END PROC drucke;
+
+PROC alle gruppen wechseln :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO max gruppen REP
+    gruppen (i). wechsel := TRUE
+  END REP;
+  wechsel 0 := TRUE;
+  wechsel erfolgt := TRUE
+
+END PROC alle gruppen wechseln;
+
+PROC abschnitt interpretieren (PROC abschnitt) :
+
+  gedruckte spalten := spalten;
+  to line (ausgabe, gedruckte zeilen + 1);
+  standard musterzeilenbreite;
+  interpretationsmodus := 1;
+  abschnitt
+
+END PROC abschnitt interpretieren;
+
+PROC nachspann drucken (INT CONST letzter satz, letzte kombination,
+                        PROC nachspann) :
+
+  INT CONST
+    aktueller satz := satznummer,
+    aktuelle kombination := satzkombination;
+  auf satz (letzter satz);
+  WHILE satzkombination <> letzte kombination REP weiter (1) END REP;
+  abschnitt interpretieren (PROC nachspann);
+  auf satz (aktueller satz);
+  WHILE satzkombination <> aktuelle kombination REP weiter (1) END REP
+
+END PROC nachspann drucken;
+
+PROC druckdatei eroeffnen :
+
+  IF aktueller editor > 0 THEN
+    in editfile schreiben
+  ELSE
+    in ausgabedatei schreiben
+  END IF;
+  druckanweisungen uebertragen .
+
+in editfile schreiben :
+  ausgabe := edit file;
+  IF col > 1 THEN
+    split line (ausgabe, col, FALSE);
+    down (ausgabe); col (ausgabe, 1)
+  END IF;
+  gedruckte zeilen := line no (ausgabe) - 1 .
+
+in ausgabedatei schreiben :
+  IF NOT externer dateiname THEN
+    druckdateinamen generieren
+  END IF;
+  ausgabe := sequential file (modify, druckdateiname);
+  max linelength (ausgabe, max linelength (druckmuster));
+  gedruckte zeilen := lines (ausgabe) .
+
+druckdateinamen generieren :
+  INT VAR zaehler := 0;
+  REP
+    zaehler INCR 1;
+    druckdateiname :=
+       headline (druckmuster) + eudas ausgabe punkt + text (zaehler);
+  UNTIL NOT exists (druckdateiname) END REP .
+
+druckanweisungen uebertragen :
+  muster auf zeile (1);
+  WHILE NOT druckmusterende REP
+    zeile uebertragen
+  END REP .
+
+zeile uebertragen :
+  musterzeile lesen;
+  INT VAR kommandoindex;
+  IF kommandozeile (kommandoindex) THEN
+    auf ende testen
+  ELSE
+    zeile drucken (musterzeile)
+  END IF .
+
+auf ende testen :
+  IF kommandoindex <> do index AND kommandoindex <> gruppe index THEN
+    LEAVE druckanweisungen uebertragen
+  END IF .
+
+END PROC druckdatei eroeffnen;
+
+PROC datei ausdrucken :
+
+  IF aktueller editor > 0 THEN
+  ELIF externer dateiname THEN
+    externer dateiname := FALSE;
+  ELIF direkt ausdrucken THEN
+    disable stop;
+    ausdruck versuchen
+  ELSE
+    line; put (druckausgabe steht in);
+    putline (textdarstellung (druckdateiname));
+    pause (40)
+  END IF .
+
+ausdruck versuchen :
+  TEXT CONST param := std;
+  last param (druckdateiname);
+  do ("print (std)");
+  IF is error THEN
+    clear error;
+    errorstop (direkt drucken nicht moeglich)
+  ELSE
+    line; put (textdarstellung (druckdateiname));
+    putline (zum drucker geschickt);
+    forget (druckdateiname, quiet);
+    pause (40)
+  END IF;
+  last param (param) .
+
+END PROC datei ausdrucken;
+
+PROC zeile drucken (TEXT CONST zeile) :
+
+  IF gedruckte spalten >= spalten OR gedruckte spalten = 0 THEN
+    insert record (ausgabe);
+    write record (ausgabe, zeile);
+    gedruckte zeilen INCR 1
+  ELSE
+    an zeile anfuegen
+  END IF;
+  down (ausgabe) .
+
+an zeile anfuegen :
+  IF eof (ausgabe) THEN
+    spaltenpuffer := niltext;
+    insert record (ausgabe);
+    gedruckte zeilen INCR 1
+  ELSE
+    read record (ausgabe, spaltenpuffer)
+  END IF;
+  spaltenpuffer verlaengern;
+  write record (ausgabe, spaltenpuffer) .
+
+spaltenpuffer verlaengern :
+  INT CONST ziellaenge := musterzeilenbreite * gedruckte spalten;
+  WHILE length (spaltenpuffer) < ziellaenge REP
+    spaltenpuffer CAT blank
+  END REP;
+  spaltenpuffer CAT zeile .
+
+END PROC zeile drucken;
+
+PROC direkt drucken (BOOL CONST modus) :
+
+  direkt ausdrucken := modus
+
+END PROC direkt drucken;
+
+BOOL PROC direkt drucken :
+
+  direkt ausdrucken
+
+END PROC direkt drucken;
+
+PROC druckdatei (TEXT CONST dateiname) :
+
+  druckdateiname := dateiname;
+  externer dateiname := TRUE
+
+END PROC druckdatei;
+
+TEXT PROC druckdatei :
+
+  druckdateiname
+
+END PROC druckdatei;
+
+PROC max druckzeilen (INT CONST zeilen) :
+
+  max zeilen := zeilen
+
+END PROC max druckzeilen;
+
+PROC gruppentest (INT CONST gruppennr, TEXT CONST merkmal) :
+
+  IF merkmal <> gruppen (gruppennr). inhalt THEN
+    gruppen (gruppennr). inhalt := merkmal;
+    gruppen (gruppennr). wechsel := TRUE;
+    wechsel erfolgt := TRUE
+  ELSE
+    gruppen (gruppennr). wechsel := FALSE
+  END IF
+
+END PROC gruppentest;
+
+BOOL PROC gruppenwechsel (INT CONST gruppennr) :
+
+  IF gruppennr > 0 THEN
+    gruppen (gruppennr). wechsel
+  ELSE
+    wechsel 0
+  END IF
+
+END PROC gruppenwechsel;
+
+TEXT PROC lfd nr :
+
+  text (satzzaehler)
+
+END PROC lfd nr;
+
+(*
+PROC dump :
+
+  FILE VAR d := sequential file (output, "EUDAS-DUMP");
+  put (d, "anzahl muster :"); put (d, anzahl muster); line (d);
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl muster REP
+    put (d, musterindex (i));
+  END REP;
+  line (d);
+  put (d, "anzahl abkuerzungen :"); put (d, anzahl abkuerzungen);
+  line (d);
+  FOR i FROM 1 UPTO anzahl abkuerzungen REP
+    TEXT VAR p; feld lesen (abkuerzungen, i, p);
+    write (d, """"); write (d, p); write (d, """ ");
+    put (d, abkuerzungsindex ISUB i)
+  END REP;
+  line (d);
+  FOR i FROM 1 UPTO 3 REP
+    put (d, abschnitte (i). proc name); put (d, abschnitte (i). erste zeile);
+    put (d, abschnitte (i). erstes muster); line (d)
+  END REP;
+  edit ("EUDAS-DUMP");
+  forget ("EUDAS-DUMP")
+
+END PROC dump; *)
+
+END PACKET eudas drucken;
+
diff --git a/app/eudas/4.4/src/eudas.fenster b/app/eudas/4.4/src/eudas.fenster
new file mode 100644
index 0000000..3281404
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.fenster
@@ -0,0 +1,238 @@
+PACKET fenster
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Bildschirmaufteilung in Fenster                                   *)
+(*                                                                       *)
+(*     Version 05                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 17.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  FENSTER,
+  fenster initialisieren,
+  fenstergroesse setzen,
+  fenstergroesse,
+  fenster veraendert,
+  fensterzugriff,
+  bildschirm neu :
+
+
+TYPE FENSTER = STRUCT (INT koordinaten, version);
+
+LET
+  maxfenster = 16,
+  BITVEKTOR = INT,
+  GROESSE = STRUCT (INT x anf, y anf, x laenge, y laenge);
+
+ROW maxfenster STRUCT (INT referenzen, aktuelle version,
+                       BITVEKTOR ueberschneidungen,
+                       GROESSE groesse)
+               VAR fenstergroessen;
+
+INT VAR naechste version := 1;
+
+BITVEKTOR VAR veraenderungen;
+
+INT VAR i;
+FOR i FROM 2 UPTO maxfenster REP
+  fenstergroessen (i). referenzen := 0
+END REP;
+fenstergroessen (1). referenzen := 1;
+fenstergroessen (1). aktuelle version := 0;
+fenstergroessen (1). ueberschneidungen := 0;
+fenstergroessen (1). groesse := GROESSE : (1, 1, 79, 24);
+
+
+(************************* fenster anfordern *****************************)
+
+PROC fenster initialisieren (FENSTER VAR f) :
+
+  f. koordinaten := 1;
+  fenstergroessen (1). referenzen INCR 1;
+  f. version := naechste version;
+  naechste version INCR 1;
+  IF naechste version >= 32000 THEN naechste version := -32000 END IF
+
+END PROC fenster initialisieren;
+
+PROC fenstergroesse setzen (FENSTER VAR f,
+                            INT CONST x anf, y anf, x laenge, y laenge) :
+
+  INT VAR stelle;
+  passendes fenster suchen;
+  IF stelle > maxfenster THEN
+    freie stelle suchen;
+    neue koordinaten initialisieren;
+    ueberschneidungen bestimmen
+  END IF;
+  auf referenz setzen .
+
+passendes fenster suchen :
+  stelle := 1;
+  WHILE stelle <= maxfenster REP
+    IF groesse passt THEN
+      LEAVE passendes fenster suchen
+    END IF;
+    stelle INCR 1
+  END REP .
+
+groesse passt :
+  g. x anf = x anf AND g. y anf = y anf AND g. x laenge = x laenge AND
+    g. y laenge = y laenge .
+
+g :
+  fenstergroessen (stelle). groesse .
+
+freie stelle suchen :
+  stelle := 1;
+  WHILE stelle <= maxfenster REP
+    IF fenstergroessen (stelle). referenzen = 0 THEN
+      LEAVE freie stelle suchen
+    END IF;
+    stelle INCR 1
+  END REP;
+  errorstop ("zu viele Fenstergroessen");
+  LEAVE fenstergroesse setzen .
+
+neue koordinaten initialisieren :
+  fenstergroessen (stelle). referenzen := 0;
+  fenstergroessen (stelle). aktuelle version := 0;
+  fenstergroessen (stelle). groesse :=
+    GROESSE : (x anf, y anf, x laenge, y laenge);
+  fenstergroessen (stelle). ueberschneidungen := 0 .
+
+ueberschneidungen bestimmen :
+  INT VAR vergleich;
+  FOR vergleich FROM 1 UPTO maxfenster REP
+    IF fenstergroessen (vergleich). referenzen > 0 THEN
+      vergleiche auf ueberschneidung
+    END IF
+  END REP .
+
+vergleiche auf ueberschneidung :
+  IF ueberschneidung (neues fenster, vergleichsfenster) THEN
+    set bit (fenstergroessen (stelle). ueberschneidungen, vergleich);
+    set bit (fenstergroessen (vergleich). ueberschneidungen, stelle)
+  ELSE
+    reset bit (fenstergroessen (vergleich). ueberschneidungen, stelle)
+  END IF .
+
+neues fenster :
+  fenstergroessen (stelle). groesse .
+
+vergleichsfenster :
+  fenstergroessen (vergleich). groesse .
+
+auf referenz setzen :
+  fenstergroessen (f. koordinaten). referenzen DECR 1;
+  f. koordinaten := stelle;
+  fenstergroessen (stelle). referenzen INCR 1 .
+
+END PROC fenstergroesse setzen;
+
+BOOL PROC ueberschneidung (GROESSE CONST a, b) :
+
+  ueberschneidung in x richtung AND ueberschneidung in y richtung .
+
+ueberschneidung in x richtung :
+  IF a. x anf <= b. x anf THEN
+    b. x anf < a. x anf + a. x laenge
+  ELSE
+    a. x anf < b. x anf + b. x laenge
+  END IF .
+
+ueberschneidung in y richtung :
+  IF a. y anf <= b. y anf THEN
+    b. y anf < a. y anf + a. y laenge
+  ELSE
+    a. y anf < b. y anf + b. y laenge
+  END IF .
+
+END PROC ueberschneidung;
+
+PROC fenstergroesse (FENSTER CONST f,
+                     INT VAR x anf, y anf, x laenge, y laenge) :
+
+  x anf := g. x anf;
+  y anf := g. y anf;
+  x laenge := g. x laenge;
+  y laenge := g. y laenge .
+
+g :
+  fenstergroessen (f. koordinaten). groesse .
+
+END PROC fenstergroesse;
+
+
+(************************** fenster veraendert ***************************)
+
+PROC fenster veraendert (FENSTER CONST f) :
+
+  fenstergroessen (f. koordinaten). aktuelle version := 0;
+  veraenderungen := veraenderungen OR meine ueberschneidungen .
+
+meine ueberschneidungen :
+  fenstergroessen (f. koordinaten). ueberschneidungen .
+
+END PROC fenster veraendert;
+
+
+(************************** fensterzugriff *******************************)
+
+PROC fensterzugriff (FENSTER CONST f, BOOL VAR veraendert) :
+
+  veraendert := bit (veraenderungen, f. koordinaten);
+  IF fenstergroessen (f. koordinaten). aktuelle version <> f. version THEN
+    fenstergroessen (f. koordinaten). aktuelle version := f. version;
+    veraendert := TRUE
+  END IF;
+  veraenderungen := veraenderungen OR meine ueberschneidungen;
+  reset bit (veraenderungen, f. koordinaten) .
+
+meine ueberschneidungen :
+  fenstergroessen (f. koordinaten). ueberschneidungen .
+
+END PROC fensterzugriff;
+
+
+(************************ bildschirm neu *********************************)
+
+PROC bildschirm neu :
+
+  veraenderungen := - 1
+
+END PROC bildschirm neu;
+
+
+(**************************** BITVEKTOR **********************************)
+
+(* Erforderlich, da 'reset bit' im EUMEL nicht richtig funktionierte.    *)
+
+ROW 16 INT VAR bitwert := ROW 16 INT :
+ (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);
+
+PROC set bit (BITVEKTOR VAR vektor, INT CONST stelle) :
+
+  vektor := vektor OR bitwert (stelle)
+
+END PROC set bit;
+
+PROC reset bit (BITVEKTOR VAR vektor, INT CONST stelle) :
+
+  vektor := vektor AND (-1 - bitwert (stelle))
+
+END PROC reset bit;
+
+BOOL PROC bit (BITVEKTOR CONST vektor, INT CONST stelle) :
+
+  (vektor AND bitwert (stelle)) <> 0
+
+END PROC bit;
+
+END PACKET fenster;
+
diff --git a/app/eudas/4.4/src/eudas.menues b/app/eudas/4.4/src/eudas.menues
new file mode 100644
index 0000000..6204848
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.menues
@@ -0,0 +1,2616 @@
+PACKET eudas menues
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Menue-Manager                                                     *)
+(*                                                                       *)
+(*     Version 09                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 31.07.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+##                   (* Nur Multi-User *)
+  global manager,
+  menue manager,
+##
+  lock,
+  free,
+  menuedaten einlesen,
+  menuenamen,
+  menue loeschen,
+
+  waehlbar,
+  ausfuehrtaste,
+  menue anbieten,
+  auswahl anbieten,
+  wahl,
+  esc hop ausfuehren,
+
+  hilfe anbieten,
+  status anzeigen,
+
+  dialogfenster,
+  dialogfenster loeschen,
+  dialog,
+  neuer dialog,
+  ja,
+  editget,
+  fehler ausgeben :
+
+
+(***************************** Zeilenanalyse *****************************)
+
+ROW 8 TEXT VAR kommandotext :=
+  ROW 8 TEXT : ("MENUE", "BILD", "FELD", "ENDE", "AUSWAHL",
+                 "VORSPANN", "HILFE", "SEITE");
+
+LET
+  menue kommando    = 1,
+  bild kommando     = 2,
+  feld kommando     = 3,
+  ende kommando     = 4,
+  auswahl kommando  = 5,
+  vorspann kommando = 6,
+  hilfe kommando    = 7,
+  seite kommando    = 8;
+
+LET
+  bold = 2,
+  integer = 3,
+  string = 4,
+  end of line = 7;
+
+LET
+  fehler in zeile =  #701#
+    "FEHLER in Zeile ";
+
+FILE VAR file;
+
+TEXT VAR
+  zeile,
+  kommando;
+
+
+PROC zeile lesen :
+
+  IF eof (file) THEN
+    zeile := "%DUMMY"
+  ELSE
+    read record (file, zeile);
+    IF zeile = niltext THEN zeile := blank END IF;
+    cout (line no (file));
+    down (file)
+  END IF
+
+END PROC zeile lesen;
+
+BOOL PROC kommandozeile :
+
+  IF (zeile SUB 1) = kommandozeichen THEN
+    kommando isolieren
+  ELSE
+    FALSE
+  END IF .
+
+kommando isolieren :
+  INT VAR typ;
+  replace (zeile, 1, blank);
+  scan (zeile);
+  replace (zeile, 1, kommandozeichen);
+  next symbol (kommando, typ);
+  IF typ <> bold THEN
+    fehler (kein kommando angegeben);
+    FALSE
+  ELSE
+    TRUE
+  END IF .
+
+END PROC kommandozeile;
+
+BOOL PROC kommando ist (INT CONST identifikation) :
+
+  kommandotext (identifikation) = kommando
+
+END PROC kommando ist;
+
+INT PROC int parameter :
+
+  TEXT VAR symbol;
+  INT VAR typ;
+  next symbol (symbol, typ);
+  IF typ = integer THEN
+    int (symbol)
+  ELSE
+    IF typ <> end of line THEN fehler (kein int parameter) END IF;
+    -1
+  END IF
+
+END PROC int parameter;
+
+TEXT PROC text parameter :
+
+  TEXT VAR symbol;
+  INT VAR typ;
+  next symbol (symbol, typ);
+  IF typ = string THEN
+    symbol
+  ELSE
+    IF typ <> end of line THEN fehler (kein text parameter) END IF;
+    niltext
+  END IF
+
+END PROC text parameter;
+
+PROC fehler (TEXT CONST meldung) :
+
+  note (fehler in zeile); note (line no (file) - 1); note line;
+  note (meldung); note line;
+  line; putline (meldung)
+
+END PROC fehler;
+
+
+(***************************** Fensterkoordinaten ************************)
+
+INT VAR
+  y laenge,
+  x laenge,
+  x pos,
+  y pos;
+
+PROC f cursor (INT CONST x, y) :
+
+  cursor (x pos + x - 1, y pos + y - 1)
+
+END PROC f cursor;
+
+
+(**************************** Einlesen zentral ***************************)
+
+LET
+  zeile ohne zusammenhang =  #702#
+    "Zeile ist ohne Zusammenhang",
+  k menuedaten im speicher =  #703#
+    "K Menuedaten im Speicher";
+
+PROC menuedaten einlesen (TEXT CONST dateiname) :
+
+  ggf initialisieren;
+  file := sequential file (input, dateiname);
+  modify (file);
+  to line (file, 1);
+  WHILE NOT eof (file) REP
+    zeile lesen;
+    IF kommandozeile THEN
+      eventuell verteilen
+    ELIF NOT anything noted THEN
+      fehler (zeile ohne zusammenhang)
+    END IF
+  END REP;
+  seiten anzeigen;
+  IF anything noted THEN
+    note edit (file)
+  END IF .
+
+eventuell verteilen :
+  IF kommando ist (menue kommando) THEN
+    menue aus datei lesen
+  ELIF kommando ist (auswahl kommando) THEN
+    auswahl aus datei lesen
+  ELIF kommando ist (hilfe kommando) THEN
+    hilfe aus datei lesen
+  ELIF NOT anything noted THEN
+    fehler (zeile ohne zusammenhang)
+  END IF .
+
+seiten anzeigen :
+  IF online THEN
+    line; put (anzahl ds seiten DIV 2);
+    putline (k menuedaten im speicher)
+  END IF .
+
+anzahl ds seiten :
+  ds pages (menueds (1)) + ds pages (menueds (2)) + ds pages (menueds (3)) .
+
+END PROC menuedaten einlesen;
+
+
+(**************************** TYPE MENUE *********************************)
+
+TYPE MENUE = STRUCT (SATZ
+                       bild,
+                       hilfen,
+                       kommandos,
+                     TEXT
+                       feldtasten,
+                       feldzeilen);
+
+BOUND ROW 200 MENUE VAR menues;
+
+
+(************************** Menue Einlesen *******************************)
+
+TEXT VAR
+  m feldzeilen,
+  m feldtasten;
+
+SATZ VAR
+  m hilfen,
+  m kommandos;
+
+LET
+  niltext = "",
+  blank = " ",
+  feldmarkierung = ""223"",
+  markierungsspalte = 2,
+  kommandozeichen = "%",
+  piep = ""7"",
+  esc = ""27"",
+  cleol = ""5"";
+
+LET
+  bildkommando erwartet =  #704#
+    "% BILD erwartet",
+  keine feldnr angegeben =  #705#
+    "Feldnummer beim %FELD-Kommando fehlt",
+  ende fehlt =  #706#
+    "% ENDE erwartet",
+  kein name angegeben =  #707#
+    "Name fehlt",
+  kein kommando angegeben =  #708#
+    "Kommandozeile enthaelt kein Kommando",
+  kein int parameter =  #709#
+    "Parameter soll eine Zahl sein",
+  kein text parameter =  #710#
+    "Parameter soll ein TEXT sein",
+  keine wiederholungszeile =  #711#
+    "Wiederholungszeile fehlt";
+
+
+PROC menue aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    INT VAR index;
+    neues menue einfuegen;
+    menue aus datei lesen (menues (index))
+  END IF .
+
+neues menue einfuegen :
+  index := link (thesaurus (2), name);
+  IF index = 0 THEN
+    insert (thesaurus (2), name, index)
+  END IF .
+
+END PROC menue aus datei lesen;
+
+PROC menue aus datei lesen (MENUE VAR m) :
+
+  menue initialisieren;
+  bild einlesen;
+  felddefinitionen bearbeiten;
+  auf ende testen;
+  ergebnis abspeichern .
+
+menue initialisieren :
+  satz initialisieren (m. bild);
+  satz initialisieren (m hilfen);
+  satz initialisieren (m kommandos);
+  m feldtasten := niltext;
+  m feldzeilen := niltext .
+
+bild einlesen :
+  teste auf bild kommando;
+  INT VAR zeilennr := 1;
+  REP
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE bild einlesen
+    ELSE
+      bildzeile bearbeiten;
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+teste auf bild kommando :
+  zeile lesen;
+  IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN
+    fehler (bild kommando erwartet)
+  END IF .
+
+bildzeile bearbeiten :
+  IF (zeile SUB markierungsspalte) = feldmarkierung THEN
+    m feldzeilen CAT code (zeilennr);
+    replace (zeile, markierungsspalte, blank)
+  END IF;
+  feld aendern (m. bild, zeilennr, zeile) .
+
+felddefinitionen bearbeiten :
+  WHILE kommando ist (feld kommando) REP
+    eine felddefinition bearbeiten
+  END REP .
+
+eine felddefinition bearbeiten :
+  INT VAR feldnr := int parameter;
+  IF feldnr = -1 THEN
+    fehler (keine feldnr angegeben);
+    feldnr := 100
+  END IF;
+  hilfe text einlesen;
+  feldtasten einlesen;
+  kommandos einlesen .
+
+hilfe text einlesen :
+  feld aendern (m hilfen, feldnr, text parameter) .
+
+feldtasten einlesen :
+  TEXT CONST tasten := text parameter;
+  INT VAR p;
+  FOR p FROM 1 UPTO length (tasten) REP
+    m feldtasten CAT code (feldnr);
+    m feldtasten CAT (tasten SUB p)
+  END REP .
+
+kommandos einlesen :
+  TEXT VAR k := niltext;
+  zeile lesen;
+  WHILE NOT kommandozeile REP
+    k CAT zeile;
+    zeile lesen
+  END REP;
+  feld aendern (m kommandos, feldnr, k) .
+
+auf ende testen :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF .
+
+ergebnis abspeichern :
+  m. hilfen := m hilfen;
+  m. kommandos := m kommandos;
+  m. feldtasten := m feldtasten;
+  m. feldzeilen := m feldzeilen .
+
+END PROC menue aus datei lesen;
+
+
+(************************** Menue in Datei *******************************)
+(*
+PROC menue in datei schreiben (MENUE CONST m, FILE VAR f, TEXT CONST name) :
+
+  output (f);
+  put (f, "% MENUE");
+  putline (f, textdarstellung (name));
+  bild rekonstruieren;
+  felddefinitionen rekonstruieren;
+  putline (f, "% ENDE") .
+
+bild rekonstruieren :
+  INT VAR zeilennr;
+  putline (f, "% BILD");
+  FOR zeilennr FROM 1 UPTO felderzahl (m. bild) REP
+    feld lesen (m. bild, zeilennr, zeile);
+    feldmarkierungen wiederherstellen;
+    putline (f, zeile)
+  END REP .
+
+feldmarkierungen wiederherstellen :
+  INT VAR zeilenpos := pos (m. feldzeilen, code (zeilennr));
+  IF zeilenpos > 0 THEN
+    REP
+      replace (zeile, markierungsspalte, feldmarkierung);
+      zeilenpos INCR 1
+    UNTIL (m. feldzeilen SUB zeilenpos) <> code (zeilennr) END REP
+  END IF .
+
+felddefinitionen rekonstruieren :
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO length (m. feldzeilen) REP
+    put (f, "% FELD");
+    put (f, feldnr);
+    feld lesen (m. hilfen, feldnr, zeile);
+    put (f, textdarstellung (zeile));
+    feldzeichen sammeln;
+    kommandos ausgeben
+  END REP .
+
+feldzeichen sammeln :
+  INT VAR stelle := 1;
+  zeile := niltext;
+  WHILE stelle < length (m. feldtasten) REP
+    IF code (m. feldtasten SUB stelle) = feldnr THEN
+      zeile CAT (m. feldtasten SUB stelle + 1)
+    END IF;
+    stelle INCR 1
+  END REP;
+  putline (f, textdarstellung (zeile)) .
+
+kommandos ausgeben :
+  INT VAR anfang := 1;
+  feld lesen (m. kommandos, feldnr, zeile);
+  REP
+    stelle := pos (zeile, ";", anfang);
+    IF stelle = 0 THEN
+      zeilenrest ausgeben;
+      LEAVE kommandos ausgeben
+    ELSE
+      putline (f, subtext (zeile, anfang, stelle));
+      anfang := stelle + 1
+    END IF
+  END REP .
+
+zeilenrest ausgeben :
+  IF anfang <= length (zeile) THEN
+    putline (f, subtext (zeile, anfang))
+  END IF .
+
+END PROC menue in datei schreiben;
+*)
+
+(*************************** Menue anbieten ******************************)
+
+LET
+  ausfuehren status = #712#
+    "Kommando wird ausgeführt ..",
+  gib kommando =  #713#
+    ""15"Gib Kommando: ",
+  falsche ausfuehrtaste =  #714#
+    "falsche Ausfuehrtaste",
+  t existiert nicht =  #715#
+    " existiert nicht.";
+
+LET
+  blank 24 = "                        ",
+  begin mark = ""15"",
+  end mark = ""14"",
+  ausfuehren marke = "*"8"";
+
+INT VAR
+  rekursionstiefe := 0,
+  markenpos,
+  gezeichnete zeilen;
+
+BOOL VAR
+  funktionssperre veraendert,
+  menue init durchgefuehrt;
+
+TEXT VAR 
+  balken,
+  sperrzeichen,
+  menuefunktionstasten := ""32""1""2""3""8""10""13""27"",
+  edit kommando,
+  altes kommando := niltext;
+
+ROW 6 TEXT VAR
+  funktionssperre;
+
+FENSTER VAR balkenfenster;
+fenster initialisieren (balkenfenster);
+fenstergroesse setzen (balkenfenster, 1, 1, 79, 1);
+
+
+PROC waehlbar (INT CONST menue, funktion, BOOL CONST moeglich) :
+
+  IF moeglich THEN
+    ggf sperre aufheben
+  ELSE
+    sperre setzen
+  END IF;
+  funktionssperre veraendert := TRUE .
+
+ggf sperre aufheben :
+  IF length (funktionssperre (menue)) >= funktion THEN
+    replace (funktionssperre (menue), funktion, " ")
+  END IF .
+
+sperre setzen :
+  WHILE length (funktionssperre (menue)) < funktion REP
+    funktionssperre (menue) CAT " "
+  END REP;
+  replace (funktionssperre (menue), funktion, "-") .
+
+END PROC waehlbar;
+
+PROC ausfuehrtaste (TEXT CONST taste) :
+
+  IF length (taste) <> 1 COR taste schon belegt THEN
+    errorstop (falsche ausfuehrtaste)
+  ELSE
+    replace (menuefunktionstasten, 1, taste)
+  END IF .
+
+taste schon belegt :
+  taste <> ""13"" AND pos (menuefunktionstasten, taste, 2) > 0 .
+
+END PROC ausfuehrtaste;
+
+PROC menue anbieten (ROW 6 TEXT CONST menuenamen,
+                     FENSTER VAR f, BOOL CONST esc erlaubt,
+                     PROC (INT CONST, INT CONST) interpreter) :
+
+  ROW 6 INT VAR
+    m anfang,
+    m ende,
+    m wahl;
+
+  INT VAR
+    menuenr intern,
+    leistenindex := 0,
+    neuer leistenindex := 1,
+    leave code := 0,
+    besetzte menues;
+
+  TEXT VAR 
+    menuebalken;
+
+  ROW 6 TEXT VAR
+    sperre;
+
+  ggf initialisieren;
+  menuebalken aufbauen;
+  funktionssperre aufbauen;
+  disable stop;
+  REP
+    menuebalken und sperre aktualisieren;
+    menue aufrufen;
+    funktion ausfuehren
+  END REP .
+
+menuebalken aufbauen :
+  rekursionstiefe INCR 1;
+  INT CONST meine rekursionstiefe := rekursionstiefe;
+  menuebalken := ""6""0""0"";
+  identifikation extrahieren;
+  weitere menues anfuegen;
+  menuebalken CAT cl eol .
+
+identifikation extrahieren :
+  INT VAR ppos := pos (menuenamen (1), ".");
+  IF ppos > 0 THEN
+    menuebalken CAT subtext (menuenamen (1), 1, ppos - 1)
+  END IF;
+  menuebalken CAT ":   " .
+
+weitere menues anfuegen :
+  besetzte menues := 0;
+  WHILE besetzte menues < 6 CAND noch ein menue vorhanden REP
+    besetzte menues INCR 1;
+    ein weiteres menue;
+    m wahl (besetzte menues) := 1
+  END REP .
+
+noch ein menue vorhanden :
+  menuenamen (besetzte menues + 1) <> niltext .
+
+ein weiteres menue :
+  m anfang (besetzte menues) := length (menuebalken);
+  ppos := pos (menuenamen (besetzte menues), ".");
+  IF ppos = 0 THEN
+    menuebalken CAT menuenamen (besetzte menues)
+  ELSE
+    menuebalken CAT subtext (menuenamen (besetzte menues), ppos + 1)
+  END IF;
+  menuebalken CAT "   ";
+  m ende (besetzte menues) := length (menuebalken) - 1 .
+
+funktionssperre aufbauen :
+  INT VAR i;
+  FOR i FROM 1 UPTO 6 REP
+    funktionssperre (i) := niltext
+  END REP;
+  funktionssperre veraendert := TRUE;
+  interpreter (0, 0) .
+
+menuebalken und sperre aktualisieren :
+  IF neuer leistenindex > 0 THEN
+    altes menue demarkieren;
+    neues menue markieren;
+    leistenindex := neuer leistenindex;
+    neuer leistenindex := 0;
+    neues menue auswaehlen
+  ELIF rekursionstiefe <> meine rekursionstiefe THEN
+    balken := menuebalken;
+    funktionssperre := sperre;
+    rekursionstiefe := meine rekursionstiefe
+  ELIF funktionssperre veraendert THEN
+    sperre := funktionssperre
+  END IF .
+
+altes menue demarkieren :
+  IF leistenindex > 0 THEN
+    replace (menuebalken, m anfang (leistenindex), " ");
+    replace (menuebalken, m ende (leistenindex), " ");
+    IF menue init durchgefuehrt THEN
+      interpreter (leistenindex, -1)
+    END IF
+  END IF .
+
+neues menue markieren :
+  replace (menuebalken, m anfang (neuer leistenindex), begin mark);
+  replace (menuebalken, m ende (neuer leistenindex), end mark);
+  fenster veraendert (balkenfenster);
+  balken := menuebalken;
+  menuebalken anzeigen .
+
+neues menue auswaehlen :
+  menuenr intern := link (thesaurus (2), menuenamen (leistenindex));
+  IF menuenr intern = 0 THEN
+    existiert nicht (menuenamen (leistenindex));
+    LEAVE menue anbieten
+  END IF;
+  menue init durchgefuehrt := FALSE;
+  funktionssperre veraendert := TRUE;
+  fenster veraendert (f) .
+
+menue aufrufen :
+  leave code := leistenindex;
+  anbieten (menues (menuenr intern), f, leave code, m wahl (leistenindex),
+            PROC (INT CONST, INT CONST) interpreter) .
+
+funktion ausfuehren :
+  SELECT leave code OF
+  CASE 0 :  menue verlassen
+  CASE 1 :  kommandodialog
+  CASE 2 :  menuewechsel nach rechts
+  CASE 3 :  menuewechsel nach links
+  CASE 4 :  wahl behandeln
+  OTHERWISE direkte menuewahl
+  END SELECT .
+
+menuewechsel nach rechts :
+  IF leistenindex < besetzte menues THEN
+    neuer leistenindex := leistenindex + 1
+  ELSE
+    neuer leistenindex := 1
+  END IF .
+
+menuewechsel nach links :
+  IF leistenindex > 1 THEN
+    neuer leistenindex := leistenindex - 1
+  ELSE
+    neuer leistenindex := besetzte menues
+  END IF .
+
+direkte menuewahl :
+  leave code := leave code - 10;
+  IF leave code <= besetzte menues THEN
+    neuer leistenindex := leave code
+  END IF .
+
+kommandodialog :
+  IF esc erlaubt THEN
+    BOOL VAR bild veraendert := FALSE;
+    REP
+      editget kommando;
+      kommando ausfuehren
+    UNTIL erfolgreich END REP;
+    IF bild veraendert THEN
+      bildschirm neu;
+      dialogfenster loeschen;
+      interpreter (leistenindex, -2)
+    END IF
+  END IF .
+
+kommando ausfuehren :
+  IF echtes kommando THEN
+    bild veraendert := TRUE;
+    status anzeigen (ausfuehren status);
+    cursor (1, 2); out (cl eop);
+    do (edit kommando)
+  END IF .
+
+echtes kommando :
+  pos (edit kommando, ""33"", ""254"", 1) > 0 .
+
+erfolgreich :
+  NOT is error .
+
+menue verlassen :
+  IF menue init durchgefuehrt THEN
+    interpreter (leistenindex, -1)
+  END IF;
+  fenster veraendert (f);
+  LEAVE menue anbieten .
+
+wahl behandeln :
+  IF m wahl (leistenindex) > 0 THEN
+    interpreter (menuenr intern, m wahl (leistenindex))
+  ELSE
+    m wahl (leistenindex) := - m wahl (leistenindex)
+  END IF .
+
+END PROC menue anbieten;
+
+PROC menuebalken anzeigen :
+
+  BOOL VAR veraendert;
+  fensterzugriff (balkenfenster, veraendert);
+  IF veraendert THEN out (balken) END IF
+
+END PROC menuebalken anzeigen;
+
+PROC anbieten (MENUE CONST m, FENSTER VAR f, INT VAR menuenr, wahl,
+               PROC (INT CONST, INT CONST) interpreter) :
+
+  INT VAR
+    tastenzustand := 0;
+
+  fehler behandeln;
+  neuen fensterzugriff anmelden (f);
+  IF gezeichnete zeilen = 0 THEN
+    markenpos := 0
+  END IF;
+  neuer dialog;
+  geaenderte funktionssperre beruecksichtigen;
+  REP
+    menuebalken anzeigen;
+    auf eingabe warten;
+    menuefunktion
+  END REP .
+
+fehler behandeln :
+  IF wahl > length (m. feldzeilen) THEN
+    wahl := markenpos;
+  ELIF is error THEN
+    fehler ausgeben;
+    interpreter (menuenr, -2);
+  END IF .
+
+geaenderte funktionssperre beruecksichtigen :
+  IF funktionssperre veraendert THEN
+    sperrzeichen setzen;
+    bereits angezeigte funktionen korrigieren;
+    funktionssperre veraendert := FALSE
+  END IF .
+
+sperrzeichen setzen :
+  sperrzeichen := blank 24;
+  INT VAR i;
+  FOR i FROM 1 UPTO length (funktionssperre (menuenr)) REP
+    replace (sperrzeichen, code (m. feldzeilen SUB i),
+             funktionssperre (menuenr) SUB i)
+  END REP .
+
+bereits angezeigte funktionen korrigieren :
+  INT VAR f index;
+  FOR f index FROM 1 UPTO length (m. feldzeilen) REP
+    INT CONST funktionszeile := code (m. feldzeilen SUB f index);
+    IF funktionszeile > gezeichnete zeilen THEN
+      LEAVE bereits angezeigte funktionen korrigieren
+    END IF;
+    erstes zeichen ausgeben (m. bild, funktionszeile)
+  END REP .
+
+auf eingabe warten :
+  REP
+    ausgabe und zeichen annehmen;
+    IF is error THEN
+      halt vom terminal behandeln
+    ELSE
+      LEAVE auf eingabe warten
+    END IF
+  END REP .
+
+ausgabe und zeichen annehmen :
+  TEXT VAR eingabe;
+  BOOL VAR menue jetzt fertig ausgegeben := FALSE;
+  WHILE gezeichnete zeilen < y laenge REP
+    eingabe := getcharety;
+    eventuell eine zeile ausgeben
+  END REP;
+  bildschirm update;
+  cursor positionieren (m, wahl);
+  getchar mit enable stop (eingabe) .
+
+eventuell eine zeile ausgeben :
+  IF eingabe = niltext THEN
+    ggf init durchfuehren;
+    gezeichnete zeilen INCR 1;
+    menuezeile markiert oder nicht markiert ausgeben
+  ELSE
+    LEAVE ausgabe und zeichen annehmen
+  END IF .
+
+ggf init durchfuehren :
+  IF NOT menue init durchgefuehrt AND gezeichnete zeilen = 0 THEN
+    interpreter (menuenr, 0);
+    menue init durchgefuehrt := TRUE
+  END IF .
+
+menuezeile markiert oder nicht markiert ausgeben :
+  IF gezeichnete zeilen = code (m. feldzeilen SUB wahl) THEN
+    menuezeile ausgeben (m. bild, gezeichnete zeilen, TRUE);
+    markenpos := wahl
+  ELSE
+    menuezeile ausgeben (m. bild, gezeichnete zeilen, FALSE)
+  END IF;
+  IF gezeichnete zeilen = y laenge THEN
+    menue jetzt fertig ausgegeben := TRUE
+  END IF .
+
+bildschirm update :
+  IF menue jetzt fertig ausgegeben AND NOT is error THEN
+    interpreter (menuenr, -2);
+    IF is error THEN clear error END IF
+  END IF .
+
+halt vom terminal behandeln :
+  fehler ausgeben;
+  menuebalken anzeigen;
+  gezeichnete zeilen := 0 .
+
+menuefunktion :
+  INT VAR posi;
+  SELECT tastenzustand OF
+  CASE 0 : normale funktion
+  CASE 1 : hop funktion
+  CASE 2 : esc funktion
+  END SELECT .
+
+normale funktion :
+  SELECT pos (menuefunktionstasten, eingabe) OF
+  CASE 1 : leerzeichen ausfuehren
+  CASE 2 : tastenzustand := 1
+  CASE 3 : rechts ausfuehren
+  CASE 4 : oben ausfuehren
+  CASE 5 : links ausfuehren
+  CASE 6 : unten ausfuehren
+  CASE 7 : return ausfuehren
+  CASE 8 : tastenzustand := 2
+  OTHERWISE sondertaste
+  END SELECT .
+
+hop funktion :
+  SELECT pos (""1""3""10"", eingabe) OF
+  CASE 1 : hop hop ausfuehren
+  CASE 2 : hop oben ausfuehren
+  CASE 3 : hop unten ausfuehren
+  OTHERWISE out (piep)
+  END SELECT;
+  tastenzustand := 0 .
+
+esc funktion :
+  SELECT pos (""1""27"?qh", eingabe) OF
+  CASE 1 : esc hop ausfuehren
+  CASE 2 : esc esc ausfuehren
+  CASE 3 : esc fragezeichen ausfuehren
+  CASE 4, 5 : esc q ausfuehren
+  OTHERWISE belegte taste
+  END SELECT;
+  tastenzustand := 0 .
+
+rechts ausfuehren :
+  leave code := 2;
+  LEAVE anbieten .
+
+oben ausfuehren :
+  IF wahl > 1 THEN
+    wahl DECR 1
+  ELSE
+    wahl := length (m. feldzeilen)
+  END IF .
+
+links ausfuehren :
+  leave code := 3;
+  LEAVE anbieten .
+
+unten ausfuehren :
+  IF wahl < length (m. feldzeilen) THEN
+    wahl INCR 1
+  ELSE
+    wahl := 1
+  END IF .
+
+return ausfuehren :
+  unten ausfuehren .
+
+sondertaste :
+  IF menuewahl THEN
+    menuewahl bearbeiten
+  ELIF wahl fuer bestimmtes feld THEN
+    feld waehlen
+  ELIF eingabe <= ""32"" THEN
+    push (esc + eingabe)
+  END IF .
+
+menuewahl :
+  pos ("123456", eingabe) > 0 .
+
+menuewahl bearbeiten :
+  leave code := code (eingabe) - 38;
+  LEAVE anbieten .
+
+wahl fuer bestimmtes feld :
+  posi := 0;
+  REP
+    posi := pos (m. feldtasten, eingabe, posi + 1)
+  UNTIL (posi MOD 2) = 0 END REP;
+  posi > 0 AND feld mit bildschirmposition .
+
+feld mit bildschirmposition :
+  code (m. feldtasten SUB posi - 1) <= length (m. feldzeilen) .
+
+feld waehlen :
+  wahl := code (m. feldtasten SUB posi - 1);
+  cursor positionieren (m, wahl);
+  IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN
+    wahl getroffen (m, wahl, gezeichnete zeilen);
+    leave code := 4;
+    LEAVE anbieten
+  END IF .
+
+hop hop ausfuehren :
+  wahl := 1 .
+
+hop oben ausfuehren :
+  wahl := 1 .
+
+hop unten ausfuehren :
+  wahl := length (m. feldzeilen) .
+
+belegte taste :
+  IF esc sonderfunktion THEN
+    wahl := code (m. feldtasten SUB posi - 1);
+    leave code := 4;
+    LEAVE anbieten
+  ELSE
+    push (lernsequenz auf taste (eingabe))
+  END IF .
+
+esc sonderfunktion :
+  posi := 0;
+  REP
+    posi := pos (m. feldtasten, eingabe, posi + 1)
+  UNTIL (posi MOD 2) = 0 CAND
+        (posi = 0 COR feld ohne bildschirmposition) END REP;
+  posi > 0 .
+
+feld ohne bildschirmposition :
+  code (m. feldtasten SUB posi - 1) > length (m. feldzeilen) .
+
+esc esc ausfuehren :
+  leave code := 1;
+  LEAVE anbieten .
+
+esc fragezeichen ausfuehren :
+  TEXT VAR hilfe name;
+  feld lesen (m. hilfen, wahl, hilfe name);
+  hilfe anbieten (hilfe name, d fenster);
+  IF is error THEN fehler ausgeben END IF;
+  interpreter (menuenr, -2);
+  neuen fensterzugriff anmelden (f) .
+
+esc q ausfuehren :
+  leave code := 0;
+  LEAVE anbieten .
+
+leerzeichen ausfuehren :
+  IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN
+    wahl getroffen (m, wahl, gezeichnete zeilen);
+    leave code := 4;
+    LEAVE anbieten
+  END IF .
+
+leave code :
+  menuenr .
+
+END PROC anbieten;
+
+PROC neuen fensterzugriff anmelden (FENSTER CONST f) :
+
+  BOOL VAR veraendert;
+  fensterzugriff (f, veraendert);
+  fenstergroesse (f, x pos, y pos, x laenge, y laenge);
+  IF veraendert THEN
+    gezeichnete zeilen := 0;
+    f cursor (1, 1)
+  END IF
+
+END PROC neuen fensterzugriff anmelden;
+
+PROC cursor positionieren (MENUE CONST m, INT CONST wahl) :
+
+  INT CONST wahlzeile := code (m. feldzeilen SUB wahl);
+  IF markenpos > 0 THEN
+    IF markenpos = wahl THEN
+      erstes zeichen ausgeben (m. bild, wahlzeile)
+    ELSE
+      INT CONST markenzeile := code (m. feldzeilen SUB markenpos);
+      menuezeile ausgeben (m. bild, markenzeile, FALSE);
+      menuezeile ausgeben (m. bild, wahlzeile, TRUE);
+      markenpos := wahl
+    END IF
+  END IF;
+  f cursor (1, wahlzeile)
+
+END PROC cursor positionieren;
+
+PROC getchar mit enable stop (TEXT VAR z) :
+
+  enable stop;
+  getchar (z)
+
+END PROC getchar mit enable stop;
+
+PROC wahl getroffen (MENUE CONST m, INT VAR wahl,
+                     INT CONST gezeichnete zeilen) :
+
+  INT CONST
+    y pos := code (m. feldzeilen SUB wahl);
+  IF zeile bereits gezeichnet THEN
+    ausfuehrung markieren
+  END IF;
+  TEXT VAR k;
+  feld lesen (m. kommandos, wahl, k);
+  IF k <> niltext AND k <> blank THEN
+    do (k);
+    bildschirm neu;
+    wahl := - wahl
+  END IF .
+
+zeile bereits gezeichnet :
+  gezeichnete zeilen >= y pos .
+
+ausfuehrung markieren :
+  f cursor (1, y pos);
+  out (ausfuehren marke) .
+
+END PROC wahl getroffen;
+
+PROC esc hop ausfuehren :
+
+  TEXT VAR
+    puffer := niltext,
+    ausgang;
+  lernsequenz auf taste legen (""0"", niltext);
+  push (""27""1""0""0"");
+  editget (puffer, 32000, 0, ""0"", "", ausgang);
+  puffer := lernsequenz auf taste (""0"");
+  IF puffer <> niltext THEN
+    gelerntes auf richtige taste legen
+  ELSE
+    letzten nullcode auslesen
+  END IF .
+
+gelerntes auf richtige taste legen :
+  REP
+    getchar (ausgang)
+  UNTIL pos (""1""2""8""11""12"", ausgang) = 0 END REP;
+  lernsequenz auf taste legen (ausgang, puffer) .
+
+letzten nullcode auslesen :
+  getchar (ausgang) .
+
+END PROC esc hop ausfuehren;
+
+
+INT VAR
+  anfang,
+  ende,
+  mark ende;
+
+PROC erstes zeichen ausgeben (SATZ CONST bild, INT CONST bildzeile) :
+
+  f cursor (1, bildzeile);
+  IF (sperrzeichen SUB bildzeile) <> blank THEN
+    out (sperrzeichen SUB bildzeile)
+  ELSE
+    feld bearbeiten (bild, bildzeile,
+      PROC (TEXT CONST, INT CONST, INT CONST) zeichen 1)
+  END IF
+
+END PROC erstes zeichen ausgeben;
+
+PROC zeichen 1 (TEXT CONST satz, INT CONST anfang, ende) :
+
+  out (satz SUB anfang + ende - ende)
+
+END PROC zeichen 1;
+
+PROC menuezeile ausgeben (SATZ CONST bild,
+                          INT CONST zeilennr, BOOL CONST markiert) :
+
+  enable stop;
+  IF markiert THEN
+    erstes zeichen ausgeben (bild, zeilennr);
+    out (begin mark);
+    anfang := 3; mark ende := 1;
+  ELSE
+    f cursor (1, zeilennr);
+    IF (sperrzeichen SUB zeilennr) = "-" THEN
+      out ("-"); anfang := 2
+    ELSE
+      anfang := 1
+    END IF;
+    mark ende := 0
+  END IF;
+  bildzeile ausgeben (bild, zeilennr)
+
+END PROC menuezeile ausgeben;
+
+PROC menuezeile ausgeben (SATZ CONST bild, INT CONST zeilennr) :
+
+  anfang := 1; mark ende := 0;
+  bildzeile ausgeben (bild, zeilennr)
+
+END PROC menuezeile ausgeben;
+
+PROC bildzeile ausgeben (SATZ CONST bild, INT CONST zeilennr) :
+
+  IF zeilennr <= felderzahl (bild) THEN
+    zeileninhalt ausgeben
+  ELSE
+    ende := 0
+  END IF;
+  zeilenrest loeschen .
+
+zeileninhalt ausgeben :
+  feld bearbeiten (bild, zeilennr,
+    PROC (TEXT CONST, INT CONST, INT CONST) abschnitt ausgeben) .
+
+zeilenrest loeschen :
+  IF x pos + x laenge >= 80 AND mark ende = 0 THEN
+    out (cleol)
+  ELSE
+    x laenge - ende - mark ende - 1 TIMESOUT blank;
+    ggf endemarkierung;
+    out (":")
+  END IF .
+
+ggf endemarkierung :
+  IF mark ende > 0 THEN
+    out (end mark)
+  END IF .
+
+END PROC bildzeile ausgeben;
+
+PROC abschnitt ausgeben (TEXT CONST t, INT CONST von, bis) :
+
+  INT CONST offset := von - 1;
+  anfang INCR offset;
+  ende := min (bis, x laenge + offset - mark ende - 1);
+  outsubtext (t, anfang, ende);
+  ende DECR offset
+
+END PROC abschnitt ausgeben;
+
+PROC editget kommando :
+
+  LET esc k = ""27"k";
+  TEXT VAR
+    exit char;
+  fenster veraendert (balkenfenster);
+  bei fehler altes kommando wiederholen;
+  markierte zeile ausgeben;
+  REP
+    kommando editieren
+  UNTIL exit char <> esc k END REP;
+  IF pos (edit kommando , ""33"", ""254"", 1) > 0 THEN
+    altes kommando := edit kommando
+  END IF .
+
+bei fehler altes kommando wiederholen :
+  IF is error THEN
+    fehler ausgeben;
+    edit kommando := altes kommando
+  ELSE
+    edit kommando := niltext
+  END IF .
+
+markierte zeile ausgeben :
+  cursor (1, 1);
+  out (gib kommando);
+  x laenge - 15 TIMESOUT blank;
+  out (end mark) .
+
+kommando editieren :
+  cursor (16, 1);
+  editget (edit kommando, 32000, 62, "", "kh", exit char);
+  IF is error THEN
+    clear error
+  ELIF exit char = esc k THEN
+    edit kommando := altes kommando
+  ELIF exit char = esc h THEN
+    edit kommando := niltext
+  END IF .
+
+END PROC edit get kommando;
+
+PROC existiert nicht (TEXT CONST dateiname) :
+
+  errorstop (textdarstellung (dateiname) + t existiert nicht)
+
+END PROC existiert nicht;
+
+
+(*************************** Auswahl Einlesen ****************************)
+
+TYPE AUSWAHL = STRUCT (
+                 SATZ
+                   kopf,
+                   vorspann,
+                   nachspann,
+                 TEXT
+                   wiederholung,
+                   feldspalten,
+                   feldlaengen);
+
+BOUND ROW 200 AUSWAHL VAR auswahlen;
+
+
+PROC auswahl aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    INT VAR index := link (thesaurus (3), name);
+    IF index = 0 THEN
+      insert (thesaurus (3), name, index)
+    END IF;
+    auswahl aus datei lesen (auswahlen (index))
+  END IF
+
+END PROC auswahl aus datei lesen;
+
+PROC auswahl aus datei lesen (AUSWAHL VAR a) :
+
+  menue initialisieren;
+  IF kopf vorhanden THEN
+    kopf einlesen
+  END IF;
+  bild einlesen;
+  teste auf ende .
+
+menue initialisieren :
+  satz initialisieren (a. kopf);
+  satz initialisieren (a. vorspann);
+  satz initialisieren (a. nachspann);
+  a. wiederholung := niltext;
+  a. feldspalten := niltext;
+  a. feldlaengen := niltext .
+
+kopf vorhanden :
+  zeile lesen;
+  kommandozeile CAND kommando ist (vorspann kommando) .
+
+kopf einlesen :
+  INT VAR zeilennr := 1;
+  REP 
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE kopf einlesen
+    ELSE
+      kopfzeile bearbeiten;
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+kopfzeile bearbeiten :
+  feld aendern (a. kopf, zeilennr, zeile) .
+
+bild einlesen :
+  teste auf bildkommando;
+  zeilennr := 1;
+  BOOL VAR noch vorspann := TRUE;
+  REP
+    zeile lesen;
+    IF kommandozeile THEN
+      teste ob wiederholung gewesen;
+      LEAVE bild einlesen
+    ELSE
+      bildzeile bearbeiten;
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+teste auf bildkommando :
+  IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN
+    fehler (bild kommando erwartet)
+  END IF .
+
+teste ob wiederholung gewesen :
+  IF noch vorspann THEN
+    fehler (keine wiederholungszeile)
+  END IF .
+
+bildzeile bearbeiten :
+  IF noch vorspann THEN
+    teste auf wiederholung
+  ELSE
+    nachspannzeile
+  END IF .
+
+teste auf wiederholung :
+  IF pos (zeile, feldmarkierung) > 0 THEN
+    behandle wiederholungszeile;
+    zeilennr := 0;
+    noch vorspann := FALSE
+  ELSE
+    feld aendern (a. vorspann, zeilennr, zeile)
+  END IF .
+
+behandle wiederholungszeile :
+  spalten suchen;
+  a. wiederholung := zeile;
+  feldlaengen berechnen .
+
+spalten suchen :
+  INT VAR feldpos := 0;
+  REP
+    feldpos := pos (zeile, feldmarkierung, feldpos + 1);
+    IF feldpos > 0 THEN
+      a. feldspalten CAT code (feldpos)
+    END IF
+  UNTIL feldpos = 0 END REP .
+
+feldlaengen berechnen :
+  FOR feldpos FROM 1 UPTO length (a. feldspalten) - 1 REP
+    a. feldlaengen CAT code (spaltenabstand - 4)
+  END REP;
+  a. feldlaengen CAT ""0"" .
+
+spaltenabstand :
+  code (a. feldspalten SUB feldpos + 1) - code (a. feldspalten SUB feldpos) .
+
+nachspannzeile :
+  feld aendern (a. nachspann, zeilennr, zeile) .
+
+teste auf ende :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF .
+
+END PROC auswahl aus datei lesen;
+
+
+(*************************** Auswahl anbieten ****************************)
+
+LET
+  hop links unten = ""1""8""10"",
+  plus esc q = "+"27"q";
+
+LET
+  fenster zu klein =  #716#
+    "Fenster zu klein",
+  auswahlstatus =  #717#
+"AUSWAHL:  Ankreuzen: 'x'  Durchstreichen: 'o'  Beenden: ESC q  Hilfe: ESC ?";
+
+INT VAR
+  wahlen,
+  spalten,
+  kopfzeilen,
+  bis vorspann,
+  wiederholungszeilen,
+  bis wiederholung,
+  gesamtzeilen,
+  gerollt;
+
+LET INTVEC = TEXT;
+
+INTVEC VAR gewaehlt;
+
+TEXT VAR spaltenpositionen;
+
+
+PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, TEXT CONST hilfe,
+                       PROC (TEXT VAR, INT CONST) inhalt) :
+
+  ggf initialisieren;
+  INT CONST index := link (thesaurus (3), name);
+  IF index = 0 THEN
+    existiert nicht (name)
+  ELSE
+    anbieten (auswahlen (index), f, hilfe, PROC (TEXT VAR, INT CONST) inhalt)
+  END IF
+
+END PROC auswahl anbieten;
+
+PROC anbieten (AUSWAHL CONST a, FENSTER CONST f, TEXT CONST hilfe,
+               PROC (TEXT VAR, INT CONST) inhalt) :
+
+  INT VAR
+    gezeichnete zeilen := 0,
+    tastenzustand := 0;
+  enable stop;
+  fensterzugriff durchfuehren;
+  status anzeigen (auswahlstatus);
+  anzahl der wahlen feststellen;
+  bildparameter berechnen;
+  auswahl initialisieren;
+  REP
+    auf eingabe warten;
+    auswahlfunktion durchfuehren
+  END REP .
+
+fensterzugriff durchfuehren :
+  BOOL VAR dummy;
+  fensterzugriff (f, dummy);
+  fenstergroesse (f, x pos, y pos, x laenge, y laenge) .
+
+anzahl der wahlen feststellen :
+  INT VAR
+    schritt := 1024;
+  wahlen := schritt;
+  REP
+    schritt := schritt DIV 2;
+    inhalt (zeile, wahlen);
+    IF zeile = niltext THEN
+      wahlen DECR schritt
+    ELSE
+      wahlen INCR schritt
+    END IF
+  UNTIL schritt = 1 END REP;
+  inhalt (zeile, wahlen);
+  IF zeile = niltext THEN wahlen DECR 1 END IF .
+
+auswahl initialisieren :
+  INT VAR
+    akt zeile := bis vorspann + 1,
+    akt spalte := 1,
+    akt wahl := 1;
+  gewaehlt := niltext;
+  spaltenpositionen := a. feldspalten .
+
+bildparameter berechnen :
+  kopfzeilen := felderzahl (a. kopf);
+  bis vorspann := kopfzeilen + felderzahl (a. vorspann);
+  spalten := length (a. feldspalten);
+  wiederholungszeilen := (wahlen + spalten - 1) DIV spalten;
+  bis wiederholung := bis vorspann + wiederholungszeilen;
+  gesamtzeilen := bis wiederholung + felderzahl (a. nachspann);
+  gerollt := 0;
+  IF bis vorspann >= y laenge THEN
+    errorstop (fenster zu klein)
+  END IF .
+
+auf eingabe warten :
+  REP
+    ausgabe und zeichen annehmen;
+    IF is error THEN
+      clear error;
+      gezeichnete zeilen := 0
+    ELSE
+      LEAVE auf eingabe warten
+    END IF
+  END REP .
+
+ausgabe und zeichen annehmen :
+  TEXT VAR eingabe;
+  WHILE gezeichnete zeilen < y laenge REP
+    eingabe := getcharety;
+    eventuell eine zeile ausgeben
+  END REP;
+  cursor positionieren;
+  getchar mit enable stop (eingabe) .
+
+eventuell eine zeile ausgeben :
+  IF eingabe = niltext THEN
+    gezeichnete zeilen INCR 1;
+    entsprechende zeile ausgeben
+  ELSE
+    LEAVE ausgabe und zeichen annehmen
+  END IF .
+
+entsprechende zeile ausgeben :
+  INT CONST tatsaechliche zeile := gezeichnete zeilen + gerollt;
+  f cursor (1, gezeichnete zeilen);
+  IF gezeichnete zeilen <= kopfzeilen THEN
+    menuezeile ausgeben (a. kopf, gezeichnete zeilen)
+  ELIF tatsaechliche zeile <= bis vorspann THEN
+    menuezeile ausgeben (a. vorspann, tatsaechliche zeile - kopfzeilen)
+  ELIF tatsaechliche zeile <= bis wiederholung THEN
+    wiederholungszeile ausgeben
+  ELSE
+    menuezeile ausgeben (a. nachspann,
+                         tatsaechliche zeile - bis wiederholung)
+  END IF .
+
+wiederholungszeile ausgeben :
+  auswahlzeile ausgeben (a, erste wahl,
+                         PROC (TEXT VAR, INT CONST) inhalt) .
+
+erste wahl :
+  (tatsaechliche zeile - bis vorspann - 1) * spalten + 1 .
+
+cursor positionieren :
+  f cursor (code (spaltenpositionen SUB akt spalte), akt zeile) .
+
+auswahlfunktion durchfuehren :
+  SELECT tastenzustand OF
+  CASE 0 : normale funktion
+  CASE 1 : hop funktion
+  CASE 2 : esc funktion
+  END SELECT .
+
+normale funktion :
+  SELECT pos (""1""2""3""8""9""10""13""27" +x-o", eingabe) OF
+  CASE 1 : tastenzustand := 1
+  CASE 2 : rechts ausfuehren
+  CASE 3 : oben ausfuehren
+  CASE 4 : links ausfuehren
+  CASE 5 : tab ausfuehren
+  CASE 6 : unten ausfuehren
+  CASE 7 : return ausfuehren
+  CASE 8 : tastenzustand := 2
+  CASE 9 : leertaste ausfuehren
+  CASE 10, 11 : plus ausfuehren
+  CASE 12, 13 : minus ausfuehren
+  OTHERWISE sondertaste
+  END SELECT .
+
+hop funktion :
+  SELECT pos (""1""2""3""8""10""13"+x-o", eingabe) OF
+  CASE 1 : hop hop ausfuehren
+  CASE 2 : hop rechts ausfuehren
+  CASE 3 : hop oben ausfuehren
+  CASE 4 : hop links ausfuehren
+  CASE 5 : hop unten ausfuehren
+  CASE 6 : hop return ausfuehren
+  CASE 7, 8 : hop plus ausfuehren
+  CASE 9, 10 : hop minus ausfuehren
+  OTHERWISE out (piep)
+  END SELECT;
+  tastenzustand := 0 .
+
+esc funktion :
+  SELECT pos (""1"19?qh", eingabe) OF
+  CASE 1 : esc hop ausfuehren
+  CASE 2 : esc 1 ausfuehren
+  CASE 3 : esc 9 ausfuehren
+  CASE 4 : esc fragezeichen ausfuehren
+  CASE 5 : esc q ausfuehren
+  CASE 6 : errorstop (niltext)
+  OTHERWISE belegte taste
+  END SELECT;
+  tastenzustand := 0 .
+
+rechts ausfuehren :
+  IF akt spalte < spalten AND akt wahl < wahlen THEN
+    akt spalte INCR 1;
+    akt wahl INCR 1
+  END IF .
+
+oben ausfuehren :
+  IF akt wahl > spalten THEN
+    akt zeile DECR 1;
+    akt wahl DECR spalten;
+    IF akt zeile <= kopfzeilen THEN
+      akt zeile INCR 1;
+      gerollt DECR 1;
+      gezeichnete zeilen := kopfzeilen
+    END IF
+  END IF .
+
+links ausfuehren :
+  IF akt spalte > 1 THEN
+    akt spalte DECR 1;
+    akt wahl DECR 1
+  END IF .
+
+tab ausfuehren :
+  IF akt spalte = spalten THEN
+    push (""13"")     (* return *)
+  ELSE
+    push (""1""2"")   (* hop rechts *)
+  END IF .
+
+unten ausfuehren :
+  IF akt wahl + spalten <= wahlen THEN
+    akt zeile INCR 1;
+    akt wahl INCR spalten;
+    IF akt zeile > y laenge THEN
+      akt zeile DECR 1;
+      gerollt INCR 1;
+      gezeichnete zeilen := kopfzeilen
+    END IF
+  END IF .
+
+return ausfuehren :
+  IF akt zeile + gerollt < bis wiederholung THEN
+    push (hop links unten)
+  END IF .
+
+leertaste ausfuehren :
+  push (plus esc q) .
+
+plus ausfuehren :
+  IF wahlpos (akt wahl) = 0 AND akt wahl <= wahlen THEN
+    gewaehlt CAT akt wahl;
+    IF akt zeile <= gezeichnete zeilen THEN
+      wahlnummer (akt zeile, akt spalte, length (gewaehlt) DIV 2)
+    END IF
+  END IF .
+
+minus ausfuehren :
+  INT CONST alte pos := wahlpos (akt wahl);
+  IF alte pos > 0 THEN
+    wahl entfernen;
+    wahlpositionen ausgeben
+  END IF .
+
+wahl entfernen :
+  change (gewaehlt, 2 * alte pos - 1, 2 * alte pos, niltext) .
+
+sondertaste :
+  IF eingabe < blank THEN
+    push (lernsequenz auf taste (eingabe))
+  ELSE
+    out (piep)
+  END IF .
+
+hop hop ausfuehren :
+  hop links ausfuehren; nach oben .
+
+hop rechts ausfuehren :
+  WHILE akt wahl < wahlen AND akt spalte < spalten REP
+    akt wahl INCR 1; akt spalte INCR 1
+  END REP .
+
+hop oben ausfuehren :
+  IF akt zeile = kopfzeilen + 1 THEN
+    nach oben rollen
+  ELSE
+    nach oben
+  END IF .
+
+nach oben rollen :
+  INT VAR um := min (y laenge - kopfzeilen, gerollt);
+  gerollt DECR um;
+  INT CONST runter := noch angezeigter vorspann;
+  akt zeile INCR runter;
+  akt wahl DECR (um - runter) * spalten;
+  IF um > 0 THEN
+    gezeichnete zeilen := kopfzeilen
+  END IF .
+
+noch angezeigter vorspann :
+  max (0, bis vorspann - kopfzeilen - gerollt) .
+
+nach oben :
+  WHILE akt wahl > spalten AND akt zeile > kopfzeilen + 1 REP
+    akt zeile DECR 1;
+    akt wahl DECR spalten
+  END REP .
+
+hop links ausfuehren :
+  akt wahl DECR (akt spalte - 1);
+  akt spalte := 1 .
+
+hop unten ausfuehren :
+  IF akt zeile = y laenge THEN
+    nach unten rollen
+  ELSE
+    nach unten
+  END IF .
+
+nach unten rollen :
+  um := min (y laenge - kopfzeilen, gesamtzeilen - akt zeile - gerollt);
+  gerollt INCR um;
+  INT CONST rauf := max (0, akt zeile + gerollt - bis wiederholung
+                                                + spaltenkorrektur);
+  akt zeile DECR rauf;
+  akt wahl INCR (um - rauf) * spalten;
+  IF um > 0 THEN
+    gezeichnete zeilen := kopfzeilen
+  END IF .
+
+spaltenkorrektur :
+  IF akt spalte - 1 > wahlen MOD spalten THEN
+    1
+  ELSE
+    0
+  END IF .
+
+nach unten :
+  WHILE akt zeile < y laenge AND akt wahl + spalten <= wahlen REP
+    akt zeile INCR 1;
+    akt wahl INCR spalten
+  END REP .
+
+hop return ausfuehren :
+  gerollt INCR (akt zeile - kopfzeilen - 1);
+  akt zeile := kopfzeilen + 1;
+  gezeichnete zeilen := kopfzeilen .
+
+hop plus ausfuehren :
+  INT VAR w;
+  FOR w FROM 1 UPTO wahlen REP
+    IF wahlpos (w) = 0 THEN
+      gewaehlt CAT w
+    END IF
+  END REP;
+  wahlpositionen ausgeben .
+
+hop minus ausfuehren :
+  gewaehlt := niltext;
+  wahlpositionen ausgeben .
+
+esc fragezeichen ausfuehren :
+  hilfe anbieten (hilfe, f);
+  status anzeigen (auswahlstatus);
+  gezeichnete zeilen := 0 .
+
+esc q ausfuehren :
+  LEAVE anbieten .
+
+belegte taste :
+  push (lernsequenz auf taste (eingabe)) .
+
+esc 1 ausfuehren :
+  akt zeile := bis vorspann + 1;
+  akt wahl := 1;
+  akt spalte := 1;
+  gerollt := 0;
+  gezeichnete zeilen := kopfzeilen .
+
+esc 9 ausfuehren :
+  IF bis wiederholung <= y laenge THEN
+    akt zeile := bis wiederholung
+  ELSE
+    akt zeile := max (kopfzeilen + 1,
+                      y laenge + bis wiederholung - gesamtzeilen)
+  END IF;
+  gerollt := bis wiederholung - akt zeile;
+  akt spalte := (wahlen - 1) MOD spalten + 1;
+  akt wahl := wahlen;
+  gezeichnete zeilen := kopfzeilen .
+
+END PROC anbieten;
+
+PROC wahlpositionen ausgeben :
+
+  INT VAR z, s, w;
+  w := erste angezeigte wahl;
+  FOR z FROM erste wahlzeile UPTO letzte wahlzeile REP
+    FOR s FROM 1 UPTO spalten REP
+      wahlnummer (z, s, wahlpos (w));
+      w INCR 1
+    END REP
+  END REP .
+
+erste angezeigte wahl :
+  max (0, gerollt - bis vorspann + kopfzeilen) * spalten + 1 .
+
+erste wahlzeile :
+  max (kopfzeilen, bis vorspann - gerollt) + 1 .
+
+letzte wahlzeile :
+  min (y laenge, bis wiederholung - gerollt) .
+
+END PROC wahlpositionen ausgeben;
+
+
+TEXT VAR zwei bytes := "xx";
+
+INT PROC wahlpos (INT CONST feld) :
+
+  replace (zwei bytes, 1, feld);
+  INT VAR p := 0;
+  REP
+    p := pos (gewaehlt, zwei bytes, p + 1)
+  UNTIL p = 0 OR p MOD 2 = 1 END REP;
+  (p + 1) DIV 2
+
+END PROC wahlpos;
+
+OP CAT (INTVEC VAR intvec, INT CONST wert) :
+
+  replace (zwei bytes, 1, wert);
+  intvec CAT zwei bytes
+
+END OP CAT;
+
+PROC auswahlzeile ausgeben (AUSWAHL CONST a, INT CONST erste wahl,
+                            PROC (TEXT VAR, INT CONST) inhalt) :
+
+  INT VAR
+    p := 1,
+    feld,
+    s := 1;
+  FOR feld FROM erste wahl UPTO erste wahl + spalten - 1 REP
+    outsubtext (a. wiederholung, p, spaltenpos - 5);
+    position ausgeben;
+    inhalt (zeile, feld);
+    INT CONST f laenge := min (jeweilige feldlaenge, length (zeile));
+    outsubtext (zeile, 1, f laenge);
+    p := spaltenpos + f laenge + 2;
+    s INCR 1
+  END REP;
+  zeilenrest loeschen .
+
+spaltenpos :
+  code (spaltenpositionen SUB s) .
+
+position ausgeben :
+  INT CONST n := wahlpos (feld);
+  IF n = 0 THEN
+    out ("    o ")
+  ELSE
+    out (text (n, 3)); out (" x ")
+  END IF .
+
+jeweilige feldlaenge :
+  IF s = spalten THEN
+    x laenge - spaltenpos - 1
+  ELSE
+    code (a. feldlaengen SUB s)
+  END IF .
+
+zeilenrest loeschen :
+  outsubtext (a. wiederholung, p, x laenge);
+  IF x pos + x laenge >= 80 THEN
+    out (cl eol)
+  ELSE
+    x laenge - max (p, length (a. wiederholung)) TIMESOUT blank
+  END IF .
+
+END PROC auswahlzeile ausgeben;
+
+PROC wahlnummer (INT CONST zeile, spalte, wert) :
+
+  f cursor (code (spaltenpositionen SUB spalte) - 4, zeile);
+  IF wert = 0 THEN
+    out ("    o ")
+  ELSE
+    out (text (wert, 3)); out (" x ")
+  END IF
+
+END PROC wahlnummer;
+
+INT PROC wahl (INT CONST stelle) :
+
+  IF stelle + stelle <= length (gewaehlt) THEN
+    gewaehlt ISUB stelle
+  ELSE
+    0
+  END IF
+
+END PROC wahl;
+
+
+(************************ Hilfen *****************************************)
+
+LET
+  maxgebiete = 200,
+  maxseiten = 5000;
+
+LET HILFE = STRUCT (
+              INT anzahl seiten,
+              ROW maxgebiete THESAURUS hilfsnamen,
+              ROW maxgebiete SATZ seitenindex,
+              ROW maxseiten SATZ seiten);
+
+BOUND HILFE VAR h;
+
+INT VAR hx, hy, hxl, hyl;
+
+BOOL VAR hilfen sparen := FALSE;
+
+
+(************************* Hilfe einlesen ********************************)
+
+LET
+  hilfsgebiet existiert bereits = #718#
+    "Das Hilfsgebiet existiert bereits",
+  seite existiert nicht =  #719#
+    "Diese Seite ist in der anderen Hilfe nicht vorhanden";
+
+
+PROC hilfe aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  BOOL VAR hilfe ueberspringen;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    eintrag reservieren;
+    seiten einlesen;
+    hilfe abspeichern
+  END IF .
+
+eintrag reservieren :
+  INT CONST trennung := pos (name, "/");
+  TEXT VAR gebiet;
+  IF trennung = 0 THEN
+    gebiet := name
+  ELSE
+    gebiet := subtext (name, 1, trennung - 1)
+  END IF;
+  gebietsindex bestimmen;
+  einzelindex bestimmen .
+
+gebietsindex bestimmen :
+  INT VAR gebietsindex := link (thesaurus (1), gebiet);
+  hilfe ueberspringen := FALSE;
+  IF gebietsindex = 0 THEN
+    insert (thesaurus (1), gebiet, gebietsindex);
+    h. hilfsnamen (gebietsindex) := empty thesaurus;
+    satz initialisieren (h. seitenindex (gebietsindex));
+  ELIF trennung = 0 THEN
+    fehler (hilfsgebiet existiert bereits);
+    LEAVE hilfe aus datei lesen
+  ELIF hilfen sparen THEN
+    hilfe ueberspringen := TRUE
+  END IF .
+
+einzelindex bestimmen :
+  INT VAR einzelindex;
+  TEXT VAR einzelname := subtext (name, trennung + 1);
+  IF trennung = 0 THEN
+    einzelindex := 1
+  ELSE
+    einzelindex := link (h. hilfsnamen (gebietsindex), einzelname);
+    IF einzelindex = 0 AND NOT hilfe ueberspringen THEN
+      insert (h. hilfsnamen (gebietsindex), einzelname, einzelindex)
+    END IF
+  END IF .
+
+seiten einlesen :
+  INT VAR vorlaeufige seiten := h. anzahl seiten;
+  IF vorlaeufige seiten < 0 THEN
+    vorlaeufige seiten := 0
+  END IF;
+  TEXT VAR alle seiten := niltext;
+  zeile lesen;
+  WHILE kommandozeile CAND kommando ist (seite kommando) REP
+    eine seite einlesen
+  END REP .
+
+eine seite einlesen :
+  INT CONST seitennr := int parameter;
+  TEXT CONST referenz := text parameter;
+  IF referenz <> niltext THEN
+    seitenreferenz besorgen;
+    zeile lesen
+  ELSE
+    neue seite einlesen
+  END IF .
+
+seitenreferenz besorgen :
+  TEXT VAR referenzseiten;
+  seiten bestimmen (referenz, referenzseiten);
+  IF seitennr + seitennr <= length (referenzseiten) THEN
+    alle seiten CAT (referenzseiten ISUB seitennr)
+  ELIF NOT (anything noted OR hilfe ueberspringen) THEN
+    fehler (seite existiert nicht)
+  END IF .
+
+neue seite einlesen :
+  INT VAR zeilennr := 1;
+  IF NOT hilfe ueberspringen THEN
+    vorlaeufige seiten INCR 1;
+    alle seiten CAT vorlaeufige seiten;
+    satz initialisieren (h. seiten (vorlaeufige seiten))
+  END IF;
+  REP
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE neue seite einlesen
+    ELIF NOT hilfe ueberspringen THEN
+      feld aendern (h. seiten (vorlaeufige seiten), zeilennr, zeile);
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+hilfe abspeichern :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF;
+  IF NOT (anything noted OR hilfe ueberspringen) THEN
+    feld aendern (h. seitenindex (gebietsindex), einzelindex, alle seiten);
+    h. anzahl seiten := vorlaeufige seiten
+  END IF .
+
+END PROC hilfe aus datei lesen;
+
+PROC seiten bestimmen (TEXT CONST name, TEXT VAR alle seiten) :
+
+  INT CONST trennung := pos (name, "/");
+  INT VAR
+    gebiet,
+    einzelindex := 0;
+  IF trennung = 0 THEN
+    gebiet := link (thesaurus (1), name)
+  ELSE
+    gebiet := link (thesaurus (1), subtext (name, 1, trennung - 1));
+    einzelindex suchen
+  END IF;
+  IF einzelindex = 0 THEN
+    einzelindex := 1
+  END IF;
+  IF gebiet = 0 THEN
+    errorstop (hilfe existiert nicht)
+  ELSE
+    feld lesen (h. seitenindex (gebiet), einzelindex, alle seiten)
+  END IF .
+
+einzelindex suchen :
+  IF gebiet > 0 THEN
+    einzelindex :=
+      link (h. hilfsnamen (gebiet), subtext (name, trennung + 1))
+  END IF .
+
+END PROC seiten bestimmen;
+
+
+(************************* Hilfe anbieten ********************************)
+
+LET
+  hilfe existiert nicht =  #720#
+    "Hilfe existiert nicht",
+  hilfe ist leer =  #721#
+    "Hilfe ist leer",
+  hilfe status =  #722#
+"HILFE:  Beenden: ESC q     Seite weiter: ESC w     Seite zurueck: ESC z";
+
+
+PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) :
+
+  enable stop;
+  ggf initialisieren;
+  TEXT VAR alle seiten;
+  fensterzugriff anmelden;
+  seiten bestimmen (name, alle seiten);
+  IF alle seiten = niltext THEN
+    errorstop (hilfe ist leer)
+  ELSE
+    seiten ausgeben
+  END IF .
+
+fensterzugriff anmelden :
+  fenster veraendert (f);
+  fenstergroesse (f, hx, hy, hxl, hyl) .
+
+seiten ausgeben :
+  tastenpuffer loeschen;
+  status anzeigen (hilfe status);
+  INT VAR seitenindex := 1;
+  REP
+    eine seite ausgeben;
+    kommando annehmen
+  END REP .
+
+eine seite ausgeben :
+  INT CONST tatsaechliche seite := alle seiten ISUB seitenindex;
+  seite ausgeben (h. seiten (tatsaechliche seite)) .
+
+kommando annehmen :
+  TEXT VAR eingabe;
+  REP
+    getchar (eingabe);
+    IF eingabe = esc THEN
+      getchar (eingabe);
+      kommando ausfuehren;
+      LEAVE kommando annehmen
+    ELSE
+      out (piep)
+    END IF
+  END REP .
+
+kommando ausfuehren :
+  SELECT pos ("qwz?"1"", eingabe) OF
+  CASE 1 :  LEAVE hilfe anbieten
+  CASE 2 :  eine seite weiter
+  CASE 3 :  eine seite zurueck
+  CASE 4 :  an anfang
+  CASE 5 :  esc hop ausfuehren
+  OTHERWISE out (piep)
+  END SELECT .
+
+eine seite weiter :
+  IF 2 * seitenindex < length (alle seiten) THEN
+    seitenindex INCR 1
+  END IF .
+
+eine seite zurueck :
+  IF seitenindex > 1 THEN
+    seitenindex DECR 1
+  END IF .
+
+an anfang :
+  seitenindex := 1 .
+
+END PROC hilfe anbieten;
+
+PROC seite ausgeben (SATZ CONST seite) :
+
+  INT VAR zeilennr;
+  FOR zeilennr FROM 1 UPTO hyl REP
+    cursor (hx, hy + zeilennr - 1);
+    feld bearbeiten (seite, zeilennr,
+      PROC (TEXT CONST, INT CONST, INT CONST) zeile ausgeben)
+  END REP;
+  cursor (hx, hy + hyl - 1)
+
+END PROC seite ausgeben;
+
+PROC zeile ausgeben (TEXT CONST bild, INT CONST von, bis) :
+
+  IF bis - von + 1 > hxl THEN
+    ende := von + hxl - 1
+  ELSE
+    ende := bis
+  END IF;
+  outsubtext (bild, von, ende);
+  IF hx + hxl >= 80 THEN
+    out (cleol)
+  ELSE
+    hxl + von - ende - 1 TIMESOUT blank
+  END IF
+
+END PROC zeile ausgeben;
+
+
+(*********************** Statuszeile *************************************)
+
+PROC status anzeigen (TEXT CONST status) :
+
+  cursor (1, 1);
+  out (status);
+  out (cl eol);
+  fenster veraendert (balkenfenster)
+
+END PROC status anzeigen;
+
+
+(******************************* Dialog **********************************)
+
+LET
+  cleop = ""4"",
+  esc fragezeichen = ""27"?",
+  esc q = ""27"q",
+  esc h = ""27"h";
+
+LET
+  ja nein text =  #723#
+    " ? (j/n) ",
+  ja zeichen =  #724#
+    "jJ",
+  nein zeichen =  #725#
+    "nN",
+  ja status =  #726#
+"FRAGE:  Bejahen: j,J    Verneinen: n,N    Abbrechen: ESC h    Hilfe: ESC ?",
+  editget status ohne esc z =  #727#
+"EINGABE:  Bestätigen: RETURN    Abbrechen: ESC h    Hilfe: ESC ?",
+  editget status mit esc z =  #728#
+"EINGABE:  Bestätigen: RETURN   Zeigen: ESC z   Abbruch: ESC h  Hilfe: ESC ?",
+  fehler status =  #729#
+""15"!!! FEHLER !!! "14"     Quittieren: ESC q     Hilfe zur Meldung: ESC ?";
+
+FENSTER VAR d fenster;
+fenster initialisieren (d fenster);
+
+INT VAR
+  dialogzeile,
+  dx,
+  dy,
+  dxl,
+  dyl;
+
+
+PROC dialogfenster (INT CONST x, y, x l, y l) :
+
+  fenstergroesse setzen (d fenster, x, y, x l, y l);
+  dx := x; dy := y; dxl := x l; dyl := y l
+
+END PROC dialogfenster;
+
+PROC neuer dialog :
+
+  dialogzeile := dyl
+
+END PROC neuer dialog;
+
+PROC dialog :
+
+  BOOL VAR veraendert;
+  fensterzugriff (d fenster, veraendert);
+  dialogzeile INCR 1;
+  IF dialogzeile > dyl OR veraendert THEN
+    dialogfenster loeschen;
+    dialogzeile := 1
+  END IF;
+  cursor (dx, dy + dialogzeile - 1) .
+
+END PROC dialog;
+
+PROC dialogfenster loeschen :
+
+  BOOL CONST bis zeilenende := dx + dxl >= 80;
+  dialogzeile := 0;
+  REP
+    cursor (dx, dy + dialogzeile);
+    IF bis zeilenende THEN
+      out (cleol)
+    ELSE
+      dxl TIMESOUT blank
+    END IF;
+    dialogzeile INCR 1
+  UNTIL dialogzeile >= dyl END REP .
+
+END PROC dialogfenster loeschen;
+
+BOOL PROC ja (TEXT CONST frage, hilfe) :
+
+  REP
+    status anzeigen (ja status);
+    dialog;
+    out (frage); out (ja nein text);
+    tastenpuffer loeschen;
+    zeichen annehmen und auswerten
+  END REP;
+  FALSE .
+
+zeichen annehmen und auswerten :
+  TEXT VAR eingabe;
+  REP
+    getchar (eingabe);
+    IF pos (ja zeichen, eingabe) > 0 THEN
+      out (eingabe); LEAVE ja WITH TRUE
+    ELIF pos (nein zeichen, eingabe) > 0 THEN
+      out (eingabe); LEAVE ja WITH FALSE
+    ELIF eingabe = esc THEN
+      esc funktionen
+    ELSE
+      out (piep)
+    END IF
+  END REP .
+
+esc funktionen :
+  getchar (eingabe);
+  IF eingabe = "?" THEN
+    hilfe anbieten (hilfe, d fenster);
+    neuer dialog;
+    LEAVE zeichen annehmen und auswerten
+  ELIF eingabe = "h" THEN
+    errorstop (niltext);
+    LEAVE ja WITH FALSE
+  ELIF eingabe = ""1"" THEN
+    esc hop ausfuehren
+  ELSE
+    out (piep)
+  END IF .
+
+END PROC ja;
+
+PROC editget (TEXT CONST prompt, TEXT VAR eingabe, TEXT CONST res, hilfe) :
+
+  TEXT VAR exit char;
+  passenden status anzeigen;
+  dialog;
+  out (prompt); out (blank);
+  editget (eingabe, 1000, editlaenge, "", "?hq" + res, exit char);
+  IF exit char = esc fragezeichen THEN
+    hilfe anbieten (hilfe, d fenster);
+    neuer dialog;
+    editget (prompt, eingabe, res, hilfe)
+  ELIF exit char = esc h OR exit char = esc q THEN
+    errorstop (niltext)
+  ELIF length (exit char) = 2 THEN
+    eingabe := exit char
+  END IF .
+
+passenden status anzeigen :
+  IF pos (res, "z") > 0 THEN
+    status anzeigen (editget status mit esc z)
+  ELSE
+    status anzeigen (editget status ohne esc z)
+  END IF .
+
+editlaenge :
+  dxl - length (prompt) - 1 .
+
+END PROC editget;
+
+PROC fehler ausgeben :
+
+  TEXT CONST meldung := errormessage;
+  IF error code = 1 THEN
+    page; bildschirm neu
+  END IF;
+  clear error;
+  tastenpuffer loeschen;
+  IF meldung <> niltext THEN
+    status anzeigen (fehler status);
+    meldung ausgeben;
+    eingabe abwarten;
+    neuer dialog
+  END IF .
+
+meldung ausgeben :
+  dialog;
+  out (piep); out (">>> ");
+  outsubtext (errormessage, 1, dxl) .
+
+eingabe abwarten :
+  TEXT VAR eingabe;
+  getchar (eingabe);
+  IF eingabe = esc THEN
+    esc funktionen
+  END IF .
+
+esc funktionen :
+  getchar (eingabe);
+  IF eingabe = "?" THEN
+    hilfe anbieten ("FEHLER/" + text (errorcode), d fenster)
+  ELIF eingabe = ""1"" THEN
+    esc hop ausfuehren
+  END IF .
+
+END PROC fehler ausgeben;
+
+PROC tastenpuffer loeschen :
+
+  WHILE getcharety <> niltext REP END REP
+
+END PROC tastenpuffer loeschen;
+
+
+(************************** Menue Manager ********************************)
+
+LET
+  max ds = 3,
+  save order = 12,
+  erase order = 14,
+  fetch order = 1070,
+  lock order = 1068,
+  free order = 1069,
+  ack = 0,
+  error nak = 2;
+ 
+ROW maxds DATASPACE VAR menue ds;
+
+ROW maxds THESAURUS VAR thesaurus;
+
+BOOL VAR vater ist menuemanager := FALSE;
+
+INITFLAG VAR menueinitialisierung;
+
+
+PROC ggf initialisieren :
+
+  IF NOT initialized (menueinitialisierung) THEN
+    initialisierung durchfuehren
+  END IF .
+
+initialisierung durchfuehren :
+  BOOL VAR erfolgreich := vater ist menuemanager;
+  datenraeume holen;
+  IF erfolgreich THEN
+    ankoppeln
+  ELSE
+    menue loeschen (FALSE)
+  END IF .
+
+datenraeume holen :
+  INT VAR nr;
+  FOR nr FROM 1 UPTO maxds
+  WHILE erfolgreich REP
+    versuche zu holen
+  END REP .
+
+versuche zu holen :
+##                      (* nur im Multi-User *)
+  INT VAR
+    reply,
+    retries;
+  FOR retries FROM 1 UPTO 10 REP
+    forget (menue ds (nr));
+    menue ds (nr) := nilspace;
+    pingpong (father, fetch order + nr, menue ds (nr), reply);
+    IF reply = ack THEN
+      LEAVE versuche zu holen
+    ELIF reply <> error nak THEN
+      pause (15)
+    END IF
+  UNTIL reply = error nak END REP;
+  forget (menue ds (nr));
+  menue ds (nr) := nilspace;
+##
+  erfolgreich := FALSE .
+
+END PROC ggf initialisieren;
+
+THESAURUS PROC menuenamen (INT CONST nr) :
+
+  ggf initialisieren;
+  IF nr < 0 THEN
+    h. hilfsnamen (- nr)
+  ELSE
+    thesaurus (nr)
+  END IF
+
+END PROC menuenamen;
+
+PROC menue loeschen (TEXT CONST name, INT CONST nr) :
+
+  ggf initialisieren;
+  IF nr < 0 THEN
+    loeschen (name, h. hilfsnamen (- nr))
+  ELSE
+    loeschen (name, thesaurus (nr))
+  END IF
+
+END PROC menue loeschen;
+
+PROC loeschen (TEXT CONST name, THESAURUS VAR t) :
+
+  INT CONST index := link (t, name);
+  IF index > 0 THEN
+    delete (t, index)
+  END IF
+
+END PROC loeschen;
+
+PROC menue loeschen (BOOL CONST hilfen reduzieren) :
+
+  INT VAR nr;
+  menueinitialisierung := TRUE;
+  hilfen sparen := hilfen reduzieren;
+  FOR nr FROM 1 UPTO max ds REP
+    forget (menue ds (nr));
+    menue ds (nr) := nilspace;
+    thesaurus (nr) := empty thesaurus
+  END REP;
+  ankoppeln
+
+END PROC menue loeschen;
+
+PROC ankoppeln :
+
+  h := menue ds (1);
+  menues := menue ds (2);
+  auswahlen := menue ds (3)
+
+END PROC ankoppeln;
+
+##                        (* nur im Multi-User *)
+
+LET
+  lock aktiv =  #730#
+    "Datei wird von anderer Task geaendert.",
+  auftrag nur fuer soehne =  #731#
+    "Auftrag nur fuer Soehne erlaubt";
+
+THESAURUS VAR locks := empty thesaurus;
+
+ROW 200 TASK VAR lock owner;
+
+TEXT VAR save file name;
+
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;
+
+PROC menue manager (DATASPACE VAR ds, INT CONST order, phase,
+                    TASK CONST order task) :
+
+  enable stop;
+  vater ist menue manager := TRUE;
+  IF order >= lock order AND order <= fetch order + max ds THEN
+    menue auftrag
+  ELSE
+    IF order = save order OR order = erase order THEN
+      save pre
+    END IF;
+    free manager (ds, order, phase, order task)
+  END IF .
+
+menue auftrag :
+  IF order = lock order THEN
+    lock ausfuehren
+  ELIF order = free order THEN
+    free ausfuehren
+  ELSE
+    menue fetch
+  END IF .
+
+lock ausfuehren :
+  msg := ds;
+  set lock (msg. name, order task);
+  send (order task, ack, ds) .
+
+free ausfuehren :
+  msg := ds;
+  reset lock (msg. name);
+  send (order task, ack, ds) .
+
+save pre :
+  IF phase = 1 THEN
+    lock ueberpruefen
+  ELSE
+    reset lock (save file name)
+  END IF .
+
+lock ueberpruefen :
+  msg := ds;
+  save file name := msg. name;
+  IF gesperrt und task ungleich THEN
+    errorstop (lock aktiv)
+  END IF .
+
+gesperrt und task ungleich :
+  INT VAR stelle := link (locks, save file name);
+  stelle > 0 CAND NOT (lock owner (stelle) = order task) .
+
+menue fetch :
+  IF order task < myself THEN
+    ggf initialisieren;
+    forget (ds); ds := menue ds (order - fetch order);
+    send (order task, ack, ds)
+  ELSE
+    errorstop (auftrag nur fuer soehne)
+  END IF .
+
+END PROC menue manager;
+
+PROC set lock (TEXT CONST dateiname, TASK CONST owner) :
+
+  INT VAR i := link (locks, dateiname);
+  IF i = 0 THEN
+    insert (locks, dateiname, i);
+    ggf reorganisieren;
+    lock owner (i) := owner
+  ELIF exists (lock owner (i)) THEN
+    IF NOT (lock owner (i) = owner) THEN
+      errorstop (lock aktiv)
+    END IF
+  ELSE
+    lock owner (i) := owner
+  END IF .
+
+ggf reorganisieren :
+  IF i = 0 THEN
+    locks reorganisieren;
+    insert (locks, dateiname, i)
+  END IF .
+
+locks reorganisieren :
+  TEXT VAR eintrag;
+  i := 0;
+  REP
+    get (locks, eintrag, i);
+    IF i = 0 THEN
+      LEAVE locks reorganisieren
+    END IF;
+    IF NOT exists (eintrag) OR NOT exists (lock owner (i)) THEN
+      delete (locks, i)
+    END IF
+  END REP .
+
+END PROC set lock;
+
+PROC reset lock (TEXT CONST dateiname) :
+
+  INT VAR i;
+  delete (locks, dateiname, i)
+
+END PROC reset lock;
+
+PROC global manager :
+
+  global manager (PROC (DATASPACE VAR, INT CONST, INT CONST,
+                        TASK CONST) menue manager)
+
+END PROC global manager;
+##
+
+PROC lock (TEXT CONST dateiname, TASK CONST manager) :
+
+  call (lock order, dateiname, manager)
+
+END PROC lock;
+
+PROC free (TEXT CONST dateiname, TASK CONST manager) :
+
+  call (free order, dateiname, manager)
+
+END PROC free;
+
+END PACKET eudas menues;
+
diff --git a/app/eudas/4.4/src/eudas.satzanzeige b/app/eudas/4.4/src/eudas.satzanzeige
new file mode 100644
index 0000000..25afc8e
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.satzanzeige
@@ -0,0 +1,993 @@
+PACKET satzanzeige 
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Anzeige von EUDAS-Saetzen                                         *)
+(*                                                                       *)
+(*     Version 09                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 31.07.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  anzeigefenster,
+  bild ausgeben,
+  aendern,
+  einfuegen,
+  suchen,
+  feldauswahl,
+  rollen,
+  exit durch,
+  exit zeichen :
+
+
+LET
+  maxfelder = 256;
+
+LET
+  blank = " ",
+  niltext = "",
+  cleol = ""5"",
+  begin mark = ""15"",
+  blank end mark = " "14"",
+  blank end mark blank = " "14" ";
+
+ROW maxfelder STRUCT (INT feldnr, anfang) VAR zeilen;
+
+INT VAR
+  anzahl zeilen,
+  erste zeile,
+  laenge := 24,
+  breite := 79,
+  zeilen anf := 1,
+  spalten anf := 1,
+  feldnamenlaenge,
+  inhaltsbreite,
+  zuletzt angezeigter satz := 0,
+  letzte kombi := 0,
+  anzeigeversion := dateiversion - 1,
+  anzeigedateien := 0;
+
+BOOL VAR
+  neues fenster := TRUE,
+  bis zeilenende := TRUE,
+  save ds voll := FALSE,
+  namen ausgeben;
+
+FENSTER VAR fenster;
+fenster initialisieren (fenster);
+
+DATASPACE VAR
+  save ds,
+  edit ds;
+
+FILE VAR edit file;
+
+TEXT VAR
+  ueberschrift,
+  zeilenpuffer;
+
+LET
+  fenster zu klein =  #801#
+    "Anzeigefenster zu klein";
+
+
+PROC anzeigefenster (INT CONST x anf, y anf, x laenge, y laenge) :
+
+  IF x laenge >= 39 THEN
+    fenstergroesse setzen (fenster, x anf, y anf, x laenge, y laenge);
+    bis zeilenende := x anf + x laenge >= 80;
+    breite := x laenge; laenge := y laenge;
+    spalten anf := x anf;
+    zeilen anf := y anf;
+    neues fenster := TRUE
+  ELSE
+    errorstop (fenster zu klein)
+  END IF
+
+END PROC anzeigefenster;
+
+PROC fensterzugriff anmelden :
+
+  BOOL VAR fenster veraendert;
+  fensterzugriff (fenster, fenster veraendert);
+  IF fenster veraendert THEN
+    namen ausgeben := TRUE
+  END IF
+
+END PROC fensterzugriff anmelden;
+
+PROC zeilendeskriptor aktualisieren :
+
+  IF neue datei seit letztem mal OR neues fenster THEN
+    neue feldnummern uebernehmen;
+    feldnamenlaenge bestimmen;
+    ueberschrift generieren;
+    fuer bildausgabe sorgen;
+    edit datei loeschen;
+    veraenderungsstatus merken
+  END IF .
+
+neue datei seit letztem mal :
+  anzeigeversion <> dateiversion .
+
+neue feldnummern uebernehmen :
+  anzahl zeilen := 0;
+  WHILE anzahl zeilen < anzahl felder REP
+    anzahl zeilen INCR 1;
+    zeilen (anzahl zeilen). feldnr := anzahl zeilen
+  END REP;
+  erste zeile := 1 .
+
+feldnamenlaenge bestimmen :
+  INT VAR feldnr;
+  feldnamenlaenge := 11;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen bearbeiten (feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) namen max)
+  END REP;
+  feldnamenlaenge := min (feldnamenlaenge, breite DIV 2);
+  inhaltsbreite := breite - feldnamenlaenge - 3 .
+
+fuer bildausgabe sorgen :
+  namen ausgeben := TRUE .
+
+edit datei loeschen :
+  forget (edit ds);
+  edit ds := nilspace;
+  IF neue datei seit letztem mal AND save ds voll THEN
+    forget (save ds);
+    save ds voll := FALSE
+  END IF .
+
+veraenderungsstatus merken :
+  anzeigeversion := dateiversion;
+  anzeigedateien := anzahl dateien;
+  neues fenster := FALSE .
+
+END PROC zeilendeskriptor aktualisieren;
+
+PROC namen max (TEXT CONST satz, INT CONST von, bis) :
+
+  feldnamenlaenge INCR length (satz) - length (satz);
+      (* damit Parameter benutzt *)
+  feldnamenlaenge := max (feldnamenlaenge, bis - von + 1)
+
+END PROC namen max;
+
+PROC rollen (INT CONST vektor) :
+
+  erste zeile := erste zeile + vektor;
+  IF erste zeile < 1 THEN
+    erste zeile := 1
+  ELIF erste zeile > letzte zeile THEN
+    erste zeile := max (letzte zeile, 1)
+  END IF;
+  namen ausgeben := TRUE .
+
+letzte zeile :
+  anzahl zeilen - laenge + 3 .
+
+END PROC rollen;
+
+PROC feldauswahl (TEXT CONST wahlvektor) :
+
+  zeilendeskriptor aktualisieren;
+  feldnummern uebernehmen;
+  namen ausgeben := TRUE .
+
+feldnummern uebernehmen :
+  anzahl zeilen := length (wahlvektor);
+  INT VAR zeilennr;
+  FOR zeilennr FROM 1 UPTO anzahl zeilen REP
+    zeilen (zeilennr). feldnr := code (wahlvektor SUB zeilennr)
+  END REP;
+  erste zeile := 1 .
+
+END PROC feldauswahl;
+
+
+(**************************** editfile ***********************************)
+
+INT VAR gelesene zeile;
+
+PROC edit file loeschen :
+
+  type (edit ds, - 1);
+  edit file := sequential file (modify, edit ds);
+  edit info (edit file, -1);
+  to line (editfile, 1);
+  col (editfile, 1);
+  maxlinelength (edit file, 10000);
+  gelesene zeile := 1
+
+END PROC edit file loeschen;
+
+.
+noch zeile zu bearbeiten :
+  gelesene zeile <= anzahl zeilen .
+
+PROC naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) bearbeite) :
+
+  zu bearbeitende zeilen bestimmen;
+  IF eof (editfile) THEN
+    bearbeite ("", feldnr)
+  ELIF mehrere zeilen THEN
+    zeilen verketten;
+    blanks abschneiden;
+    bearbeite (zeilenpuffer, feldnr)
+  ELIF blanks am ende THEN
+    read record (edit file, zeilenpuffer);
+    blanks abschneiden;
+    bearbeite (zeilenpuffer, feldnr);
+    down (edit file)
+  ELSE
+    exec (PROC (TEXT CONST, INT CONST) bearbeite, edit file, feldnr);
+    down (edit file)
+  END IF .
+
+zu bearbeitende zeilen bestimmen :
+  INT CONST
+    von := gelesene zeile,
+    feldnr := zeilen (von). feldnr;
+  REP 
+    gelesene zeile INCR 1
+  UNTIL gelesene zeile > anzahl zeilen COR neues feld END REP .
+
+neues feld :
+  zeilen (gelesene zeile). feldnr <> feldnr .
+
+mehrere zeilen :
+  gelesene zeile - von > 1 .
+
+zeilen verketten :
+  zeilenpuffer := "";
+  REP
+    exec (PROC (TEXT CONST, INT CONST) verkette,
+          edit file, length (zeilenpuffer));
+    down (edit file)
+  UNTIL eof (edit file) OR line no (edit file) = gelesene zeile END REP .
+
+blanks am ende :
+  INT CONST ende := len (edit file);
+  subtext (edit file, ende, ende) = blank .
+
+END PROC naechste zeile bearbeiten;
+
+PROC verkette (TEXT CONST edit zeile, INT CONST pufferlaenge) :
+
+  IF pufferlaenge > 0 CAND (zeilenpuffer SUB pufferlaenge) <> blank
+                      CAND (edit zeile SUB 1) <> blank THEN
+    zeilenpuffer CAT blank
+  END IF;
+  zeilenpuffer CAT edit zeile
+
+END PROC verkette;
+
+PROC blanks abschneiden :
+
+  INT VAR ende := length (zeilenpuffer);
+  WHILE (zeilenpuffer SUB ende) = blank REP
+    ende DECR 1
+  END REP;
+  zeilenpuffer := subtext (zeilenpuffer, 1, ende)
+
+END PROC blanks abschneiden;
+
+
+(*************************** Funktionen **********************************)
+
+
+BOOL VAR aus einfuegen;
+
+PROC einfuegen (PROC hilfe) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    editieren (PROC hilfe);
+    satz einfuegen;
+    aus einfuegen := TRUE;
+    felder aendern
+  END IF
+
+END PROC einfuegen;
+
+PROC felder aendern :
+
+  WHILE noch zeile zu bearbeiten REP
+    naechste zeile bearbeiten
+      (PROC (TEXT CONST, INT CONST) ein feld aendern)
+  END REP;
+  aenderungen eintragen
+
+END PROC felder aendern;
+
+PROC ein feld aendern (TEXT CONST inhalt, INT CONST feldnr) :
+
+  IF NOT aus einfuegen COR inhalt <> niltext THEN
+    feld aendern (feldnr, inhalt)
+  END IF
+
+END PROC ein feld aendern;
+
+PROC aendern (PROC hilfe) :
+
+  enable stop;
+  IF dateiende THEN
+    einfuegen (PROC hilfe)
+  ELSE
+    wirklich aendern
+  END IF .
+
+wirklich aendern :
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    bild aufbauen (namen ausgeben);
+    feldinhalte eintragen;
+    editieren (PROC hilfe);
+    aus einfuegen := FALSE;
+    felder aendern
+  END IF .
+
+feldinhalte eintragen :
+  kopierzeile := 1;
+  WHILE kopierzeile <= anzahl zeilen REP
+    feld bearbeiten (zeilen (kopierzeile). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) inhalt kopieren);
+    insert record (edit file);
+    write record (edit file, zeilenpuffer);
+    down (edit file);
+    kopierzeile INCR 1
+  END REP;
+  to line (edit file, 1) .
+
+END PROC aendern;
+
+INT VAR kopierzeile;
+
+PROC inhalt kopieren (TEXT CONST satz, INT CONST von, bis) :
+
+  zeilenpuffer := subtext (satz, feldanfang, feldende) .
+
+feldanfang :
+  von + zeilen (kopierzeile). anfang .
+
+feldende :
+  IF keine fortsetzung THEN
+    bis
+  ELSE
+    von + zeilen (kopierzeile + 1). anfang - 1
+  END IF .
+
+keine fortsetzung :
+  kopierzeile = anzahl zeilen COR
+    zeilen (kopierzeile + 1). feldnr <> zeilen (kopierzeile). feldnr .
+
+END PROC inhalt kopieren;
+
+PROC suchen (PROC hilfe) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    IF such version <> 0 THEN
+      altes suchmuster eintragen
+    END IF;
+    editieren (PROC hilfe);
+    suchbedingung einstellen
+  END IF .
+
+altes suchmuster eintragen :
+  kopierzeile := 1;
+  WHILE kopierzeile <= anzahl zeilen REP
+    insert record (edit file);
+    suchmusterzeile eintragen;
+    down (edit file);
+    kopierzeile INCR 1
+  END REP;
+  to line (edit file, 1) .
+
+suchmusterzeile eintragen :
+  IF zeilen (kopierzeile). anfang = 0 THEN
+    suchbedingung lesen (zeilen (kopierzeile). feldnr, zeilenpuffer);
+    write record (edit file, zeilenpuffer)
+  END IF .
+
+suchbedingung einstellen :
+  suchbedingung loeschen;
+  WHILE noch zeile zu bearbeiten REP
+    naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) zeilenbedingung)
+  END REP .
+
+END PROC suchen;
+
+PROC zeilenbedingung (TEXT CONST zeile, INT CONST feldnr) :
+
+  suchbedingung (feldnr, zeile)
+
+END PROC zeilenbedingung;
+
+PROC bild ausgeben (BOOL CONST datei veraendert) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  fensterzugriff anmelden;
+  IF datei veraendert OR namen ausgeben OR anderer satz THEN
+    bild aufbauen (namen ausgeben);
+    zuletzt angezeigter satz := satznummer;
+    letzte kombi := satzkombination;
+    einzelbild ausgeben (TRUE)
+  ELSE
+    ueberschrift ausgeben (TRUE)
+  END IF .
+
+anderer satz :
+  satznummer <> zuletzt angezeigter satz OR letzte kombi <> satzkombination .
+
+END PROC bild ausgeben;
+
+
+(*************************** Bild aufbauen *******************************)
+
+INT VAR anfang;
+
+BOOL VAR fertig;
+
+
+PROC bild aufbauen (BOOL CONST kuerzen erlaubt) :
+
+  INT VAR
+    zeilennr := 1,
+    alte feldnr := 0;
+  fertig := TRUE;
+  WHILE zeilennr <= anzahl zeilen OR NOT fertig REP
+    eine zeile behandeln
+  END REP .
+
+eine zeile behandeln :
+  IF fertig CAND zeilen (zeilennr). feldnr = alte feldnr THEN
+    eventuell zusammenruecken
+  ELSE
+    IF altes feld beendet THEN
+      feldwechsel
+    END IF;
+    zeilen (zeilennr). anfang := anfang;
+    feld bearbeiten (zeilen (zeilennr). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) laenge bestimmen);
+    zeilennr INCR 1
+  END IF .
+
+eventuell zusammenruecken :
+  IF kuerzen erlaubt THEN
+    zeile loeschen (zeilennr)
+  ELSE
+    zeilen (zeilennr). anfang := anfang;
+    zeilennr INCR 1
+  END IF .
+
+altes feld beendet :
+  zeilennr > anzahl zeilen COR zeilen (zeilennr). feldnr <> alte feldnr .
+
+feldwechsel :
+  IF fertig THEN
+    neues feld anfangen
+  ELSE
+    zeile einfuegen (zeilennr);
+    zeilen (zeilennr). feldnr := alte feldnr
+  END IF .
+
+neues feld anfangen :
+  alte feldnr := zeilen (zeilennr). feldnr;
+  anfang := 0 .
+
+END PROC bild aufbauen;
+
+PROC laenge bestimmen (TEXT CONST satz, INT CONST von, bis) :
+
+  INT CONST restlaenge := bis - von - anfang + 1;
+  IF restlaenge > inhaltsbreite - 2 THEN
+    anfang INCR inhaltsbreite - 2;
+    rueckwaerts blank suchen;
+    fertig := FALSE
+  ELSE
+    anfang INCR restlaenge;
+    fertig := TRUE
+  END IF .
+
+rueckwaerts blank suchen :
+  INT VAR stelle := von + anfang - 1;
+  IF trennung im wort AND blanks vorhanden THEN
+    WHILE (satz SUB stelle) <> blank REP
+      stelle DECR 1; anfang DECR 1
+    END REP
+  END IF .
+
+trennung im wort :
+  (satz SUB stelle) <> blank .
+
+blanks vorhanden :
+  pos (satz, blank, stelle - inhaltsbreite, stelle - 1) > 0 .
+
+END PROC laenge bestimmen;
+
+PROC zeile einfuegen (INT CONST zeilennr) :
+
+  INT VAR i;
+  FOR i FROM anzahl zeilen DOWNTO zeilennr REP
+    zeilen (i+1) := zeilen (i)
+  END REP;
+  anzahl zeilen INCR 1;
+  namen ausgeben := TRUE
+
+END PROC zeile einfuegen;
+
+PROC zeile loeschen (INT CONST zeilennr) :
+
+  INT VAR i;
+  FOR i FROM zeilennr + 1 UPTO anzahl zeilen REP
+    zeilen (i-1) := zeilen (i)
+  END REP;
+  anzahl zeilen DECR 1;
+  namen ausgeben := TRUE
+
+END PROC zeile loeschen;
+
+
+(************************** Editieren ************************************)
+
+INT VAR rueckkehrcode;
+
+TEXT VAR
+  zeilenrest,
+  zeile vorher,
+  zeile nachher,
+  quit zeichen := "",
+  quit durch;
+
+LET
+  hinweiszeile =  #802#
+    ""15" Bild verschoben ! ESC 1 druecken ! "14"";
+
+LET
+  eudas res = ""3""10"19"11""12"q?hpg";
+
+LET
+  oben = 1,
+  unten = 2,
+  eins = 3,
+  neun = 4,
+  rubin = 5,
+  rubout = 6,
+  edit ende = 7,
+  frage = 8,
+  abbruch = 9,
+  double = 10,
+  esc get = 11;
+
+
+PROC editieren (PROC hilfe) :
+
+  INT VAR alte zeilennr := erste zeile;
+  lernsequenz auf taste legen ("D", date);
+  REP
+    einzelbild ausgeben (FALSE);
+    file verlaengern;
+    erste und letzte zeile markieren;
+    file editieren;
+    nachbehandeln
+  UNTIL wirklich verlassen END REP;
+  to line (edit file, 1);
+  col (edit file, 1) .
+
+file verlaengern :
+  IF lines (edit file) < anzahl zeilen + 1 THEN
+    output (edit file);
+    line (editfile, anzahl zeilen - lines (editfile) + 2);
+    modify (edit file)
+  END IF .
+
+erste und letzte zeile markieren :
+  IF erste zeile <> 1 THEN
+    einsetzen (erste zeile - 1, zeile vorher)
+  END IF;
+  einsetzen (zeile nach bildschirm, zeile nachher);
+  to line (edit file, alte zeilennr) .
+
+zeile nach bildschirm :
+  min (anzahl zeilen + 1, erste zeile + laenge - 1) .
+
+file editieren :
+  open editor (groesster editor + 1, edit file, TRUE,
+    spalten anf + feldnamenlaenge + 3, zeilen anf,
+    inhaltsbreite, editlaenge);
+  edit (groesster editor, eudas res + quit zeichen,
+        PROC (TEXT CONST) eudas interpreter) .
+
+editlaenge :
+  min (anzahl zeilen - erste zeile + 2, laenge) .
+
+nachbehandeln :
+  alte zeilennr := line no (edit file);
+  hinweiszeilen entfernen;
+  SELECT rueckkehrcode OF
+  CASE oben :    nach oben rollen
+  CASE unten :   nach unten rollen
+  CASE eins :    auf erste zeile
+  CASE neun :    auf letzte zeile
+  CASE rubin :   zeile umbrechen
+  CASE rubout :  zeile entfernen
+  CASE frage :   hilfe; namen ausgeben := TRUE
+  CASE abbruch : errorstop (niltext)
+  CASE double :  in save ds kopieren
+  CASE esc get : aus save ds holen
+  END SELECT .
+
+hinweiszeilen entfernen :
+  INT CONST spalte := col (edit file);
+  col (edit file, 1);
+  IF erste zeile <> 1 THEN
+    entfernen (erste zeile - 1, zeile vorher)
+  END IF;
+  entfernen (zeile nach bildschirm, zeile nachher);
+  col (edit file, spalte) .
+
+nach oben rollen :
+  INT VAR abstand;
+  abstand := alte zeilennr - erste zeile;
+  rollen (-laenge + 1);
+  alte zeilennr := erste zeile + abstand .
+
+nach unten rollen :
+  abstand := alte zeilennr - erste zeile;
+  rollen (laenge - 1);
+  alte zeilennr := min (erste zeile + abstand, anzahl zeilen) .
+
+auf erste zeile :
+  rollen (-999);
+  alte zeilennr := 1 .
+
+auf letzte zeile :
+  abstand := alte zeilennr - erste zeile;
+  rollen (999);
+  alte zeilennr := min (erste zeile + abstand, anzahl zeilen) .
+
+zeile umbrechen :
+  to line (edit file, alte zeilennr);
+  aktuelle zeile aufsplitten;
+  zeile einfuegen (alte zeilennr) .
+
+aktuelle zeile aufsplitten :
+  read record (edit file, zeilenpuffer);
+  zeilenrest := subtext (zeilenpuffer, spalte);
+  zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1);
+  write record (edit file, zeilenpuffer);
+  down (edit file);
+  insert record (edit file);
+  write record (edit file, zeilenrest) .
+
+zeile entfernen :
+  to line (edit file, alte zeilennr);
+  IF spalte = 1 AND
+     (nicht letzte zeile CAND noch gleiche dahinter OR
+      nicht erste zeile CAND noch gleiche davor) THEN
+    ganz loeschen
+  ELSE
+    nur ueberschreiben
+  END IF .
+
+nicht letzte zeile :
+  alte zeilennr <> anzahl zeilen .
+
+noch gleiche dahinter :
+  zeilen (alte zeilennr + 1). feldnr = zeilen (alte zeilennr). feldnr .
+
+nicht erste zeile :
+  alte zeilennr <> 1 .
+
+noch gleiche davor :
+  zeilen (alte zeilennr - 1). feldnr = zeilen (alte zeilennr). feldnr .
+
+ganz loeschen :
+  delete record (edit file);
+  zeile loeschen (alte zeilennr) .
+
+nur ueberschreiben :
+  read record (edit file, zeilenpuffer);
+  zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1);
+  write record (edit file, zeilenpuffer) .
+
+in save ds kopieren :
+  forget (save ds);
+  save ds := edit ds;
+  save ds voll := TRUE .
+
+aus save ds holen :
+  IF save ds voll THEN
+    forget (edit ds);
+    edit ds := save ds;
+    edit file := sequential file (modify, edit ds)
+  END IF .
+
+wirklich verlassen :
+  rueckkehrcode = edit ende .
+
+END PROC editieren;
+
+PROC eudas interpreter (TEXT CONST zeichen) :
+
+  enable stop;
+  set busy indicator;
+  rueckkehrcode := pos (eudas res, zeichen);
+  IF rueckkehrcode > 0 THEN
+    quit durch := zeichen;
+    quit
+  ELIF pos (quit zeichen, zeichen) > 0 THEN
+    rueckkehrcode := edit ende;
+    quit durch := zeichen;
+    quit
+  ELIF kommando auf taste (zeichen) <> niltext THEN
+    std kommando interpreter (zeichen)
+  ELSE
+    nichts neu
+  END IF
+
+END PROC eudas interpreter;
+
+PROC einsetzen (INT CONST zeilennr, TEXT VAR speicher) :
+
+  to line (edit file, zeilennr);
+  read record (edit file, speicher);
+  write record (edit file, hinweiszeile)
+
+END PROC einsetzen;
+
+PROC entfernen (INT CONST zeilennr, TEXT CONST speicher) :
+
+  to line (edit file, zeilennr);
+  IF eof (edit file) COR pos (edit file, hinweiszeile, 1) = 0 THEN
+    to line (edit file, 1);
+    down (edit file, hinweiszeile);
+    IF eof (edit file) THEN
+      to line (edit file, zeilennr);
+      insert record (edit file)
+    END IF
+  END IF;
+  write record (edit file, speicher)
+
+END PROC entfernen;
+
+PROC exit zeichen (TEXT CONST zeichenkette) :
+
+  quit zeichen := zeichenkette
+
+END PROC exit zeichen;
+
+TEXT PROC exit durch : 
+
+  quit durch
+
+END PROC exit durch;
+
+
+(****************************** Ausgabe **********************************)
+
+INT VAR ausgabezeile;
+
+LET
+  t ende =  #803#
+    "ENDE.",
+  t such plus =  #804#
+    "SUCH+",
+  t such minus =  #805#
+    "SUCH-",
+  t mark plus =  #806#
+    "MARK+",
+  t mark minus =  #807#
+    "MARK-",
+  t feld =  #808#
+    " Feld    "14" ",
+  t satz =  #809#
+    " Satz   ",
+  t koppel =  #810#
+    "< KOPPEL >";
+
+LET
+  fuenf punkte = ".....",
+  sieben blanks = "       ";
+
+
+PROC einzelbild ausgeben (BOOL CONST auch inhalte) :
+
+  INT VAR
+    bildschirmzeile := zeilen anf + 1,
+    aktuelles feld := 0;
+  INT CONST letzte ausgabezeile := erste zeile + laenge - 2;
+  ueberschrift ausgeben (auch inhalte);
+  ausgabezeile := erste zeile;
+  WHILE ausgabezeile <= letzte ausgabezeile REP
+    feldnamen ausgeben;
+    feldinhalt ausgeben;
+    evtl unterbrechung;
+    bildschirmzeile INCR 1;
+    ausgabezeile INCR 1
+  END REP;
+  namen ausgeben := FALSE .
+
+feldnamen ausgeben :
+  IF namen ausgeben THEN
+    cursor (spalten anf, bildschirmzeile);
+    IF ausgabezeile <= anzahl zeilen THEN
+      namen tatsaechlich ausgeben
+    ELIF ausgabezeile = anzahl zeilen + 1 THEN
+      endebalken ausgeben
+    ELSE
+      bildschirmzeile loeschen
+    END IF
+  END IF .
+
+namen tatsaechlich ausgeben :
+  out (begin mark);
+  IF zeilen (ausgabezeile). feldnr = aktuelles feld THEN
+    feldnamenlaenge TIMESOUT blank
+  ELSE
+    aktuelles feld := zeilen (ausgabezeile). feldnr;
+    feldnamen bearbeiten (aktuelles feld,
+      PROC (TEXT CONST, INT CONST, INT CONST) randanzeige)
+  END IF;
+  out (blank end mark) .
+
+endebalken ausgeben :
+  out (begin mark);
+  breite - 4 TIMESOUT ".";
+  out (blank end mark blank) .
+
+bildschirmzeile loeschen :
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    breite TIMESOUT blank
+  END IF .
+
+feldinhalt ausgeben :
+  IF auch inhalte AND ausgabezeile <= anzahl zeilen THEN
+    cursor (spalten anf + feldnamenlaenge + 3, bildschirmzeile);
+    feld bearbeiten (zeilen (ausgabezeile). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) feldteil ausgeben)
+  END IF .
+
+evtl unterbrechung :
+  IF NOT namen ausgeben THEN
+    TEXT CONST input := getcharety;
+    IF input <> niltext THEN
+      push (input);
+      IF pos (quit zeichen, input) > 0 THEN
+        zuletzt angezeigter satz := 0;
+        LEAVE einzelbild ausgeben
+      END IF
+    END IF
+  END IF .
+
+END PROC einzelbild ausgeben;
+
+PROC ueberschrift ausgeben (BOOL CONST auch inhalte) :
+
+  satznummer bestimmen;
+  satznummer in ueberschrift;
+  cursor (spalten anf, zeilen anf);
+  IF NOT auch inhalte THEN
+    outsubtext (ueberschrift, 1, feldnamenlaenge + 3);
+    LEAVE ueberschrift ausgeben
+  END IF;
+  replace (ueberschrift, feldnamenlaenge +  7, auswahlzeichen);
+  replace (ueberschrift, feldnamenlaenge + 14, markzeichen);
+  out (ueberschrift);
+  cursor (spalten anf + breite - 5, zeilen anf);
+  out (text (erste zeile)) .
+
+satznummer bestimmen :
+  TEXT VAR satznr;
+  satznr := text (satznummer);
+  IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN
+    satznr CAT "-";
+    satznr CAT text (satzkombination)
+  END IF .
+
+satznummer in ueberschrift :
+  replace (ueberschrift, 7, sieben blanks);
+  replace (ueberschrift, 7, satznr) .
+
+auswahlzeichen :
+  IF such version = 0 THEN
+    fuenf punkte
+  ELIF satz ausgewaehlt THEN
+    t such plus
+  ELSE
+    t such minus
+  END IF .
+
+markzeichen :
+  IF dateiende THEN
+    t ende
+  ELIF markierte saetze = 0 THEN
+    fuenf punkte
+  ELIF satz markiert THEN
+    t mark plus
+  ELSE
+    t mark minus
+  END IF .
+
+END PROC ueberschrift ausgeben;
+
+PROC randanzeige (TEXT CONST satz, INT CONST von, bis) :
+
+  IF bis - von >= feldnamenlaenge THEN
+    outsubtext (satz, von, von + feldnamenlaenge - 1)
+  ELSE
+    outsubtext (satz, von, bis);
+    feldnamenlaenge - bis + von - 1 TIMESOUT blank
+  END IF
+
+END PROC randanzeige;
+
+PROC feldteil ausgeben (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR ende;
+  IF ausgabezeile = anzahl zeilen COR letzte feldzeile THEN
+    ende := bis
+  ELSE
+    ende := von + zeilen (ausgabezeile + 1). anfang - 1
+  END IF;
+  outsubtext (satz, von + zeilen (ausgabezeile). anfang, ende);
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    laenge bis zum rand TIMESOUT blank
+  END IF .
+
+letzte feldzeile :
+  zeilen (ausgabezeile + 1). feldnr <> zeilen (ausgabezeile). feldnr .
+
+laenge bis zum rand :
+  inhaltsbreite - ende + von + zeilen (ausgabezeile). anfang - 1 .
+
+END PROC feldteil ausgeben;
+
+PROC ueberschrift generieren :
+
+  ueberschrift := text (t satz, feldnamenlaenge + 3);
+  ueberschrift CAT begin mark;
+  INT VAR i;
+  INT CONST punktlaenge := breite - length (ueberschrift) - 11;
+  FOR i FROM 1 UPTO punktlaenge REP
+    ueberschrift CAT "."
+  END REP;
+  ueberschrift CAT t feld;
+  dateiname in ueberschrift .
+
+dateiname in ueberschrift :
+  TEXT VAR dateiname;
+  IF auf koppeldatei THEN
+    dateiname := t koppel
+  ELSE
+    dateiname := eudas dateiname (1)
+  END IF;
+  dateiname := subtext (dateiname, 1, punktlaenge - 20);
+  dateiname CAT blank;
+  replace (ueberschrift, feldnamenlaenge + 21, blank);
+  replace (ueberschrift, feldnamenlaenge + 22, dateiname) .
+
+END PROC ueberschrift generieren;
+
+
+END PACKET satzanzeige;
+
diff --git a/app/eudas/4.4/src/eudas.satzzugriffe b/app/eudas/4.4/src/eudas.satzzugriffe
new file mode 100644
index 0000000..d3f53f1
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.satzzugriffe
@@ -0,0 +1,271 @@
+PACKET eudas satzzugriffe
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Feldstrukturierung von Texten                                     *)
+(*                                                                       *)
+(*     Version 03                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 17.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  SATZ,
+  := ,
+  satz initialisieren,
+  felderzahl,
+  feld lesen,
+  feld bearbeiten,
+  feld aendern,
+  feldindex :
+
+
+LET
+  maximale felderzahl = 256,
+  zeigerlaenge = 2;
+
+LET
+  blank = " ",
+  niltext = "";
+ 
+LET
+  illegale feldnummer =  #101#
+    " ist keine Feldnummer";
+
+TEXT VAR
+  raum fuer ein int := zeigerlaenge * blank;
+
+ 
+(**************************** Typ SATZ ***********************************)
+
+TYPE SATZ = TEXT;
+
+OP := (SATZ VAR links, SATZ CONST rechts) :
+
+  CONCR (links) := CONCR (rechts)
+
+END OP := ;
+
+
+(************************ Satz initialisieren ****************************)
+
+PROC satz initialisieren (SATZ VAR satz) :
+
+  satz initialisieren (satz, 0)
+
+END PROC satz initialisieren;
+
+PROC satz initialisieren (SATZ VAR satz, INT CONST felder) :
+
+  replace (raum fuer ein int, 1, 2 * felder + 3);
+  INT VAR i;
+  CONCR (satz) := niltext;
+  FOR i FROM 1 UPTO felder + 1 REP
+    CONCR (satz) CAT raum fuer ein int
+  END REP
+
+END PROC satz initialisieren;
+
+
+(*************************** Felderzahl **********************************)
+
+INT PROC felderzahl (SATZ CONST satz) :
+
+  INT VAR letzter zeiger := (CONCR (satz) ISUB 1) DIV 2;
+  INT CONST satzende := CONCR (satz) ISUB letzter zeiger;
+  REP
+    letzter zeiger DECR 1
+  UNTIL letzter zeiger <= 0 COR kein leeres feld END REP;
+  letzter zeiger .
+
+kein leeres feld :
+  (CONCR (satz) ISUB letzter zeiger) <> satzende .
+
+END PROC felderzahl;
+
+
+(************************** Feld lesen ***********************************)
+
+PROC feld lesen (SATZ CONST satz, INT CONST feldnr, TEXT VAR inhalt) :
+
+  feldgrenzen bestimmen (CONCR (satz), feldnr);
+  IF NOT is error THEN
+    inhalt := subtext (CONCR (satz), feldanfang, feldende)
+  END IF
+
+END PROC feld lesen;
+
+PROC feld bearbeiten (SATZ CONST satz, INT CONST feldnr,
+                      PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  feldgrenzen bestimmen (CONCR (satz), feldnr);
+  IF NOT is error THEN
+    bearbeite (CONCR (satz), feldanfang, feldende)
+  END IF
+
+END PROC feld bearbeiten;
+
+
+(************************ Feldgrenzen bestimmen **************************)
+
+INT VAR
+  feldanfang,
+  feldende;
+
+PROC feldgrenzen bestimmen (TEXT CONST satz, INT CONST feldnr) :
+
+  IF illegales feld THEN
+    errorstop (text (feldnr) + illegale feldnummer)
+  ELIF vorhandenes feld THEN
+    feldanfang := satz ISUB feldnr;
+    feldende := (satz ISUB feldnr + 1) - 1
+  ELSE
+    feldanfang := 1; feldende := 0
+  END IF .
+
+illegales feld :
+  feldnr <= 0 OR feldnr > maximale felderzahl .
+
+vorhandenes feld :
+  feldnr + feldnr < (satz ISUB 1) - 1 .
+
+END PROC feldgrenzen bestimmen;
+
+
+(*************************** Feld aendern ********************************)
+
+TEXT VAR puffer;
+
+PROC feld aendern (SATZ VAR satz, INT CONST feldnr, TEXT CONST inhalt) : 
+
+  INT VAR zeigerstelle;
+  INT CONST satzfelder := ((CONCR (satz) ISUB 1) - 2) DIV 2;
+  IF normales feld THEN
+    normal ersetzen
+  ELSE
+    errorstop (text (feldnr) + illegale feldnummer)
+  END IF .
+
+normales feld :
+  feldnr > 0 AND feldnr <= maximale felderzahl .
+
+normal ersetzen :
+  INT CONST fehlende zeiger := feldnr - satzfelder;
+  IF fehlende zeiger <= 0 THEN
+    vorhandenes feld ersetzen
+  ELIF inhalt <> niltext THEN
+    neues feld anfuegen
+  END IF .
+
+neues feld anfuegen :
+  INT CONST endezeiger := CONCR (satz) ISUB (satzfelder + 1);
+  puffer := subtext (CONCR (satz), erstes feld, endezeiger - 1);
+  CONCR (satz) := subtext (CONCR (satz), 1, satzfelder + satzfelder);
+  korrigiere zeiger (CONCR (satz), 1, satzfelder, platz fuer zeiger);
+  neue zeiger anfuegen;
+  endezeiger anfuegen;
+  CONCR (satz) CAT puffer;
+  CONCR (satz) CAT inhalt .
+
+platz fuer zeiger :
+  fehlende zeiger + fehlende zeiger .
+
+neue zeiger anfuegen :
+  INT CONST neuer zeiger := endezeiger + platz fuer zeiger;
+  FOR zeigerstelle FROM satzfelder + 1 UPTO feldnr REP
+    zeiger anfuegen (CONCR (satz), neuer zeiger)
+  END REP .
+
+endezeiger anfuegen :
+  zeiger anfuegen (CONCR (satz), neuer zeiger + length (inhalt)) .
+
+erstes feld:
+  CONCR (satz) ISUB 1 .
+
+vorhandenes feld ersetzen :
+  INT CONST
+    feldanfang := CONCR (satz) ISUB feldnr,
+    naechster feldanfang := CONCR (satz) ISUB (feldnr + 1);
+  IF feldanfang > length (CONCR (satz)) THEN
+    optimiere leerfelder
+  ELSE
+    ersetze beliebig
+  END IF .
+
+optimiere leerfelder :
+  korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1,
+                     length (inhalt));
+  CONCR (satz) CAT inhalt .
+
+ersetze beliebig :
+  puffer := subtext (CONCR (satz), naechster feldanfang);
+  CONCR (satz) := subtext (CONCR (satz), 1, feldanfang - 1);
+  korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1,
+                   laengendifferenz);
+  CONCR (satz) CAT inhalt;
+  CONCR (satz) CAT puffer  .
+
+laengendifferenz :
+  length (inhalt) - feldlaenge .
+
+feldlaenge :
+  naechster feldanfang - feldanfang .
+
+END PROC feld aendern;
+
+PROC zeiger anfuegen (TEXT VAR satz, INT CONST zeigerwert) :
+
+  replace (raum fuer ein int, 1, zeigerwert);
+  satz CAT raum fuer ein int
+
+END PROC zeiger anfuegen;
+
+PROC korrigiere zeiger (TEXT VAR satz, INT CONST anfang, ende, differenz) :
+
+  INT VAR zeigerstelle;
+  FOR zeigerstelle FROM anfang UPTO ende REP
+    replace (satz, zeigerstelle, alter zeiger + differenz)
+  END REP .
+
+alter zeiger :
+  satz ISUB zeigerstelle .
+
+END PROC korrigiere zeiger;
+
+
+(*************************** 'feldindex' *********************************)
+
+INT PROC feldindex (SATZ CONST satz, TEXT CONST muster) :
+
+  INT VAR
+    anfang := (CONCR (satz) ISUB 1) - 1,
+    zeigerstelle := 1;
+
+  REP
+    anfang := pos (CONCR (satz), muster, anfang + 1);
+    IF anfang = 0 THEN
+      LEAVE feldindex WITH 0
+    END IF;
+    durchsuche zeiger ob feldanfang
+  UNTIL zeiger zeigt auf anfang CAND naechster zeiger hinter ende END REP;
+  zeigerstelle .
+
+durchsuche zeiger ob feldanfang :
+  WHILE (CONCR (satz) ISUB zeigerstelle) < anfang REP
+    zeigerstelle INCR 1
+  END REP .
+
+zeiger zeigt auf anfang :
+  (CONCR (satz) ISUB zeigerstelle) = anfang .
+
+naechster zeiger hinter ende :
+  (CONCR (satz) ISUB (zeigerstelle + 1)) = anfang + length (muster) .
+
+END PROC feldindex;
+
+
+END PACKET eudas satzzugriffe;
+
diff --git a/app/eudas/4.4/src/eudas.steuerung b/app/eudas/4.4/src/eudas.steuerung
new file mode 100644
index 0000000..817a8e7
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.steuerung
@@ -0,0 +1,2761 @@
+PACKET eudas steuerung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Menuesteuerung von EUDAS                                          *)
+(*                                                                       *)
+(*     Version 09                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 01.10.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  eudas,
+
+  einzelsicherung,
+  suchen,
+  aendern,
+  einfuegen,
+  prueffehler editieren,
+  feldstruktur,
+
+  dateiverwaltung,
+  archivverwaltung,
+
+  edit,
+  dateinamen anfordern,
+  ausfuehrung,
+  einzelausfuehrung :
+
+
+(**************************** Variablen ***********************************)
+
+LET
+  file typ = 1003,
+  eudas typ = 3243;
+
+LET
+  niltext = "",
+  blank = " ",
+  esc z = ""27"z",
+  cleop = ""4"",
+  cleol = ""5"";
+
+
+FILE VAR test file;
+
+DATASPACE VAR test ds;
+
+INT VAR
+  belegter heap,
+  test version := dateiversion - 1;
+
+FENSTER VAR
+  ganz,
+  links,
+  rechts,
+  fuss;
+
+TEXT VAR
+  feldpuffer;
+
+fenster initialisieren (ganz);
+fenster initialisieren (links);
+fenster initialisieren (rechts);
+fenster initialisieren (fuss);
+fenstergroesse setzen (ganz, 1, 2, 79, 23);
+fenstergroesse setzen (links, 1, 2, 15, 22);
+fenstergroesse setzen (rechts, 16, 2, 64, 22);
+fenstergroesse setzen (fuss, 1, 24, 79, 1);
+dialogfenster (16, 2, 64, 22);
+anzeigefenster (16, 2, 64, 23);
+uebersichtsfenster (1, 2, 79, 23);
+
+
+(*************************** EUDAS ***************************************)
+
+TEXT VAR
+  fusszeile;
+
+BOOL VAR
+  eudas schon aktiv := FALSE;
+
+LET
+  menue 1 =  #1001#
+    "EUDAS.Öffnen",
+  menue 2 =  #1002#
+    "EUDAS.Einzelsatz",
+  menue 3 =  #1003#
+    "EUDAS.Gesamtdatei",
+  menue 4 =  #1004#
+    "EUDAS.Drucken",
+  menue 5 =  #1005#
+    "EUDAS.Dateien",
+  menue 6 =  #1006#
+    "EUDAS.Archiv";
+
+LET
+  kein rekursiver aufruf =  #1007#
+    "EUDAS kann nicht unter EUDAS aufgerufen werden",
+  suchmuster eingeben =  #1008#
+    "Suchbedingung einstellen",
+  alle saetze drucken =  #1009#
+    "Alle Saetze drucken",
+  alle markierten saetze drucken =  #1010#
+    "Alle markierten Satze drucken",
+  einzelsatz drucken =  #1011#
+    "Aktuellen Satz drucken",
+  uebersicht wiederholen =  #1012#
+    "Mit neuer Auswahl noch einmal",
+  akt datei =  #1013#
+    "Akt.Datei: ",
+  datum doppelpunkt =  #1014#
+    " Datum: ";
+
+
+PROC version ausgeben :
+
+  cursor (30, 6);
+  out ("EEEEE U   U DDDD    A    SSSS");
+  cursor (30, 7);
+  out ("E     U   U D   D  A A  S");
+  cursor (30, 8);
+  out ("EEE   U   U D   D AAAAA  SSS");
+  cursor (30, 9);
+  out ("E     U   U D   D A   A     S");
+  cursor (30, 10);
+  out ("EEEEE  UUU  DDDD  A   A SSSS");
+  cursor (30, 12);
+  out ("Version 4.4");
+  cursor (30, 13);
+  out ("Stand: 01.10.87");
+  cursor (30, 15);
+  out ("(C) COPYRIGHT:");
+  cursor (30, 16);
+  out ("Thomas Berlage");
+  cursor (30, 17);
+  out ("Software-Systeme")
+
+END PROC version ausgeben;
+
+PROC eudas :
+
+  IF aktueller editor > 0 THEN
+    eudas kurzabfrage
+  ELIF eudas schon aktiv THEN
+    errorstop (kein rekursiver aufruf)
+  ELSE
+    eudas aufrufen
+  END IF .
+
+eudas aufrufen :
+  page; bildschirm neu;
+  version ausgeben;
+  belegter heap := heap size;
+  fusszeile aufbauen;
+  disable stop;
+  eudas schon aktiv := TRUE;
+  menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3,
+                                menue 4, menue 5, menue 6),
+                  links, TRUE,
+                  PROC (INT CONST, INT CONST) eudas interpreter);
+  eudas schon aktiv := FALSE;
+  enable stop;
+  auf sicherung ueberpruefen;
+  page; bildschirm neu
+
+END PROC eudas;
+
+PROC eudas kurzabfrage :
+
+  TEXT VAR gewaehlte feldnamen;
+  bild frei;
+  auf sicherung ueberpruefen;
+  IF nicht alle gesichert THEN
+    LEAVE eudas kurzabfrage
+  END IF;
+  oeffnen im menue (FALSE);
+  auf satz (1);
+  feldauswahl fuer uebersicht (gewaehlte feldnamen);
+  REP
+    ggf suchmuster eingeben;
+    uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe);
+    bild frei;
+    saetze drucken
+  UNTIL nicht noch einmal END REP;
+  dateien loeschen (FALSE) .
+
+nicht alle gesichert :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF inhalt veraendert (datei nr) THEN
+      LEAVE nicht alle gesichert WITH TRUE
+    END IF
+  END REP;
+  FALSE .
+
+ggf suchmuster eingeben :
+  IF ja (suchmuster eingeben, "JA/Suchmuster") THEN
+    suchen; alles neu
+  END IF .
+
+saetze drucken :
+  IF markierte saetze = 0 CAND alle drucken THEN
+    dateinamen anfordern (name des druckmusters);
+    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
+  ELIF markierte saetze > 0 CAND alle markierten drucken THEN
+    dateinamen anfordern (name des druckmusters);
+    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
+    markierungen loeschen
+  ELIF einzelsatz THEN
+    markierungen loeschen; markierung aendern;
+    dateinamen anfordern (name des druckmusters);
+    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
+    markierungen loeschen
+  END IF .
+
+alle drucken :
+  ja (alle saetze drucken, "JA/alle Satze") .
+
+alle markierten drucken :
+  ja (alle markierten saetze drucken, "JA/alle markierten") .
+
+einzelsatz :
+  ja (einzelsatz drucken, "JA/Einzelsatz drucken") .
+
+nicht noch einmal :
+  NOT ja (uebersicht wiederholen, "JA/noch einmal") .
+
+END PROC eudas kurzabfrage;
+
+PROC bild frei :
+
+  bildschirm neu;
+  cursor (1, 1);
+  out (cleop);
+  cursor (15, 1);
+  23 TIMESOUT (""10":"8"")
+
+END PROC bild frei;
+
+PROC drucke uebersicht (TEXT CONST dateiname) :
+
+  bild frei fuer uebersetzung;
+  disable stop;
+  drucke (dateiname);
+  uebersetzungsfehler behandeln;
+  bild frei
+
+END PROC drucke uebersicht;
+
+PROC eudas interpreter (INT CONST menuenr, wahl nr) :
+
+  enable stop;
+  SELECT menuenr OF
+  CASE 0 : waehlbarkeit setzen
+  CASE 1 : oeffnen interpreter (wahl nr)
+  CASE 2 : anzeigen interpreter (wahl nr)
+  CASE 3 : bearbeiten interpreter (wahl nr)
+  CASE 4 : drucken interpreter (wahl nr)
+  CASE 5 : dateiverwaltung (wahl nr)
+  CASE 6 : archivverwaltung (wahl nr)
+  END SELECT .
+
+waehlbarkeit setzen :
+  IF anzahl dateien = 0 THEN
+    oeffnen sperre (FALSE);
+    aendern sperre (FALSE)
+  ELIF NOT aendern erlaubt THEN
+    aendern sperre (FALSE)
+  END IF;
+  ketten koppeln sperre;
+  waehlbar (6, 6, ziel ist manager);
+  waehlbar (6, 9, NOT ziel ist manager);
+  IF single user THEN
+    waehlbar (1, 8, FALSE);   (* Manager *)
+    waehlbar (6, 7, FALSE)    (* Zielarchiv *)
+  END IF .
+
+single user :
+  FALSE .
+
+END PROC eudas interpreter;
+
+PROC oeffnen sperre (BOOL CONST wie) :
+
+  INT VAR i;
+  waehlbar (1, 4, wie);
+  waehlbar (1, 5, wie);
+  waehlbar (1, 7, wie);
+  FOR i FROM 1 UPTO 11 REP
+    waehlbar (2, i, wie)
+  END REP;
+  waehlbar (3, 1, wie);
+  waehlbar (3, 4, wie);
+  waehlbar (3, 6, wie);
+  waehlbar (4, 1, wie)
+
+END PROC oeffnen sperre;
+
+PROC ketten koppeln sperre :
+
+  BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt;
+  waehlbar (1, 6, wie);
+  waehlbar (3, 5, wie);
+  wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei;
+  waehlbar (1, 2, wie);
+  waehlbar (1, 3, wie)
+
+END PROC ketten koppeln sperre;
+
+PROC aendern sperre (BOOL CONST wie) :
+
+  INT VAR i;
+  FOR i FROM 7 UPTO 10 REP
+    waehlbar (2, i, wie)
+  END REP;
+  waehlbar (3, 2, wie);
+  waehlbar (3, 3, wie)
+
+END PROC aendern sperre;
+
+PROC fusszeile aufbauen :
+
+  fenster veraendert (fuss);
+  fusszeile := ""6""23""0"";
+  fusszeile CAT akt datei;
+  IF anzahl dateien > 0 THEN
+    fusszeile CAT """";
+    fusszeile CAT eudas dateiname (1);
+    fusszeile CAT """"
+  END IF;
+  IF anzahl dateien > 1 THEN
+    fusszeile CAT " .. "
+  END IF;
+  fusszeile CAT ""5""6""23"";
+  fusszeile CAT code (79 - length (date) - length (datum doppelpunkt));
+  fusszeile CAT datum doppelpunkt;
+  fusszeile CAT date
+
+END PROC fusszeile aufbauen;
+
+PROC fusszeile ausgeben (TEXT CONST prompt, inhalt) :
+
+  BOOL VAR fuss veraendert;
+  fensterzugriff (fuss, fuss veraendert);
+  IF fuss veraendert THEN
+    out (fusszeile);
+    cursor (35, 24);
+    out (prompt);
+    IF inhalt <> niltext THEN
+      out (""""); outsubtext (inhalt, 1, 22 - length (prompt)); out (""" ")
+    END IF
+  END IF
+
+END PROC fusszeile ausgeben;
+
+
+(**************************** Menue 'Oeffnen' *****************************)
+
+THESAURUS VAR zusaetzliche namen := empty thesaurus;
+
+BOOL VAR
+  nach aendern fragen,
+  multi user manager eingestellt := FALSE;
+
+TASK VAR multi user manager;
+
+TEXT VAR
+  manager taskname := niltext,
+  herkunftszeichen := niltext;
+
+LET
+  p manager =  #1015#
+    " Manager: ",
+  keine sicherung noetig =  #1017#
+    "Keine Sicherung noetig.",
+  arbeitskopien loeschen =  #1018#
+    "Interne Arbeitskopien loeschen",
+  t arbeitskopie =  #1019#
+    "Arbeitskopie ",
+  t unveraendert =  #1020#
+    " unveraendert.",
+  t veraendert =  #1021#
+    " veraendert! Sichern",
+  alte version ueberschreiben =  #1022#
+    "Alte Version ueberschreiben",
+  unter dem namen =  #1023#
+    "Sondern unter dem Namen:",
+  ueberschreiben =  #1024#
+    " ueberschreiben",
+  sortierung wiederherstellen =  #1025#
+    "Datei wieder sortieren",
+  t notizen ansehen =  #1026#
+    "Notizen",
+  name task =  #1027#
+    "Name Managertask:",
+  task existiert nicht =  #1028#
+    "Task existiert nicht !",
+  wollen sie etwas veraendern =  #1029#
+    "Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)",
+  markierungen geloescht =  #1030#
+    "Alle Markierungen gelöscht.",
+  t pruefbedingungen =  #1032#
+    "Pruefbedingungen",
+  felder aendern =  #1033#
+    "Feldnamen oder Feldtypen aendern",
+  t feldnamen anfuegen =  #1034#
+    "Feldnamen anfuegen",
+  neuer feldname =  #1035#
+    "Neuer Feldname:",
+  neuer typ =  #1036#
+    "Neuer Typ (TEXT,DIN,ZAHL,DATUM):",
+  neue feldnamen eingeben =  #1037#
+    "Neue Feldnamen",
+  id text =  #1038#
+    "TEXT",
+  id din =  #1039#
+    "DIN",
+  id zahl =  #1040#
+    "ZAHL",
+  id datum =  #1041#
+    "DATUM",
+  alte feldreihenfolge aendern =  #1042#
+    "Alte Feldreihenfolge aendern",
+  speicherengpass =  #1043#
+    ""7"ACHTUNG: System voll, Dateien loeschen!";
+
+
+PROC oeffnen interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : auf geschlossene datei pruefen
+  CASE 1 : neue datei oeffnen
+  CASE 2 : datei ketten
+  CASE 3 : datei koppeln
+  CASE 4 : aktuelle datei sichern
+  CASE 5 : notizen editieren
+  CASE 6 : feldstruktur aendern
+  CASE 7 : pruefbedingungen aendern
+  CASE 8 : multi user manager einstellen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  fusszeile ausgeben (p manager, manager taskname);
+  storage kontrollieren;
+  heap kontrollieren .
+
+auf geschlossene datei pruefen :
+  IF anzahl dateien = 0 THEN
+    eudas interpreter (0, 0)
+  END IF .
+
+neue datei oeffnen :
+  auf sicherung ueberpruefen;
+  oeffnen im menue (TRUE);
+  push (2) .
+
+datei ketten :
+  disable stop;
+  manager pre;
+  ausfuehrung (PROC (TEXT CONST) ketten, eudas typ);
+  manager post;
+  enable stop;
+  ketten koppeln sperre .
+
+datei koppeln :
+  disable stop;
+  manager pre;
+  ausfuehrung (PROC (TEXT CONST) koppeln, eudas typ);
+  manager post;
+  enable stop;
+  ketten koppeln sperre .
+
+aktuelle datei sichern :
+  IF aendern erlaubt THEN
+    einzeldateien abfragen
+  ELSE
+    dialog; out (keine sicherung noetig);
+    dateien aus manager loeschen
+  END IF;
+  sperre setzen .
+
+einzeldateien abfragen :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    einzelsicherung (datei nr)
+  END REP;
+  IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN
+    dateien aus manager zuruecksichern;
+    dateien loeschen (TRUE)
+  END IF .
+
+sperre setzen :
+  IF anzahl dateien = 0 THEN
+    oeffnen sperre (FALSE);
+    aendern sperre (FALSE)
+  END IF;
+  ketten koppeln sperre;
+  fusszeile aufbauen .
+
+dateien aus manager loeschen :
+  INT CONST vorhandene dateien := anzahl dateien;
+  dateien loeschen (FALSE);
+  FOR datei nr FROM 1 UPTO vorhandene dateien REP
+    IF manager herkunft (datei nr) THEN
+      loeschen (eudas dateiname (datei nr))
+    END IF
+  END REP .
+
+notizen editieren :
+  notizen ansehen;
+  dialogfenster loeschen .
+
+feldstruktur aendern :
+  zugriff (PROC (EUDAT VAR) feldstruktur) .
+
+pruefbedingungen aendern :
+  pruefbedingungen;
+  dialogfenster loeschen .
+
+multi user manager einstellen :
+  manager taskname := "";
+  fenster veraendert (fuss);
+  editget (name task, manager taskname, "", "GET/multi task");
+  IF manager taskname = "" THEN
+    multi user manager eingestellt := FALSE
+  ELIF exists (/manager taskname) THEN
+    multi user manager := task (manager taskname);
+    multi user manager eingestellt := TRUE
+  ELSE
+    multi user manager eingestellt := FALSE;
+    manager taskname := "";
+    errorstop (task existiert nicht)
+  END IF .
+
+heap kontrollieren :
+  IF heap size - belegter heap > 4 THEN
+    collect heap garbage;
+    belegter heap := heap size
+  END IF .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen;
+    fenster veraendert (fuss);
+    LEAVE oeffnen interpreter
+  END IF .
+
+END PROC oeffnen interpreter;
+
+PROC auf sicherung ueberpruefen :
+
+  BOOL VAR notwendig := FALSE;
+  IF aendern erlaubt THEN
+    wirklich pruefen
+  END IF;
+  IF notwendig THEN dialog (* Leerzeile *) END IF .
+
+wirklich pruefen :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF inhalt veraendert (datei nr) THEN
+      einzelsicherung (datei nr);
+      notwendig := TRUE;
+      ggf last param korrigieren
+    END IF
+  END REP .
+
+ggf last param korrigieren :
+  IF datei nr = 1 CAND std = eudas dateiname (1) THEN
+    last param (niltext)
+  END IF .
+
+END PROC auf sicherung ueberpruefen;
+
+PROC einzelsicherung (INT CONST datei nr) :
+
+  frage zusammenbauen;
+  IF inhalt veraendert (datei nr) THEN
+    IF ja (frage, "JA/sichere") THEN
+      sicherung durchfuehren
+    END IF
+  ELSE
+    dialog; out (frage)
+  END IF .
+
+frage zusammenbauen :
+  TEXT VAR frage := t arbeitskopie;
+  frage CAT textdarstellung (eudas dateiname (datei nr));
+  IF inhalt veraendert (datei nr) THEN
+    frage CAT t veraendert
+  ELSE
+    frage CAT t unveraendert
+  END IF .
+
+sicherung durchfuehren :
+  TEXT VAR name := eudas dateiname (datei nr);
+  IF ja (alte version ueberschreiben, "JA/alte version") THEN
+    forget (name, quiet)
+  ELIF manager herkunft (datei nr) THEN
+    errorstop (niltext)
+  ELSE
+    neuen namen erfragen
+  END IF;
+  sichere (datei nr, name);
+  eventuell sortierung wiederherstellen .
+
+neuen namen erfragen :
+  edit get (unter dem namen, name, "", "GET/Sicherungsname");
+  IF exists (name) THEN
+    eventuell ueberschreiben
+  END IF .
+
+eventuell ueberschreiben :
+  IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber") THEN
+    forget (name, quiet)
+  ELSE
+    einzelsicherung (datei nr);
+    LEAVE einzelsicherung
+  END IF .
+
+eventuell sortierung wiederherstellen :
+  EUDAT VAR eudat;
+  oeffne (eudat, name);
+  IF war sortiert CAND soll sortiert werden THEN
+    bitte warten;
+    sortiere (eudat)
+  END IF .
+
+war sortiert :
+  sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 .
+
+soll sortiert werden :
+  ja (sortierung wiederherstellen, "JA/Sicherungssortierung") .
+
+END PROC einzelsicherung;
+
+PROC oeffnen im menue (BOOL CONST aendern fragen) :
+
+  IF aendern erlaubt THEN
+    dateien aus manager zuruecksichern
+  END IF;
+  dateien loeschen (TRUE);
+  oeffnen sperre (FALSE);
+  aendern sperre (FALSE);
+  forget (test ds);
+  disable stop;
+  manager pre;
+  nach aendern fragen := aendern fragen;
+  einzelausfuehrung (PROC (TEXT CONST) oeffnen, eudas typ);
+  manager post;
+  ketten koppeln sperre;
+  enable stop;
+  IF anzahl dateien > 0 THEN
+    oeffnen sperre (TRUE);
+    aendern sperre (aendern erlaubt)
+  END IF
+
+END PROC oeffnen im menue;
+
+PROC manager pre :
+
+  IF multi user manager eingestellt THEN
+    zusaetzliche namen := ALL multi user manager
+  END IF
+
+END PROC manager pre;
+
+PROC manager post :
+
+  zusaetzliche namen := empty thesaurus;
+  fusszeile aufbauen
+
+END PROC manager post;
+
+PROC dateien aus manager zuruecksichern :
+
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF manager herkunft (datei nr) THEN
+      save oder free an manager
+    END IF
+  END REP .
+
+save oder free an manager :
+  IF in manager ueberschreiben THEN
+    disable stop;
+    set command dialogue false;
+    save (eudas dateiname (datei nr), multi user manager);
+    reset command dialogue;
+    enable stop;
+    forget (eudas dateiname (datei nr), quiet)
+  ELSE
+    free (eudas dateiname (datei nr), multi user manager)
+  END IF;
+  herkunft eintragen (datei nr, FALSE) .
+
+in manager ueberschreiben :
+  exists (eudas dateiname (datei nr)) .
+
+END PROC dateien aus manager zuruecksichern;
+
+PROC multi datei loeschen :
+
+  IF manager herkunft (anzahl dateien) AND aendern erlaubt THEN
+    forget (eudas dateiname (anzahl dateien), quiet)
+  END IF
+
+END PROC multi datei loeschen;
+
+PROC oeffnen (TEXT CONST dateiname) :
+
+  BOOL VAR auch aendern;
+  eventuell neu einrichten;
+  oeffne (dateiname, auch aendern);
+  multi datei loeschen .
+
+eventuell neu einrichten :
+  IF datei existiert nicht AND nach aendern fragen THEN
+    frage ob einrichten (dateiname);
+    EUDAT VAR eudat;
+    oeffne (eudat, dateiname);
+    feldstruktur (eudat);
+    auch aendern := TRUE
+  ELSE
+    auch aendern :=
+      nach aendern fragen CAND ja (wollen sie etwas veraendern, "JA/oeffne");
+    aus manager besorgen (dateiname, auch aendern)
+  END IF .
+
+datei existiert nicht :
+  NOT exists (dateiname) AND NOT (zusaetzliche namen CONTAINS dateiname) .
+
+END PROC oeffnen;
+
+PROC ketten (TEXT CONST dateiname) :
+
+  aus manager besorgen (dateiname, aendern erlaubt);
+  kette (dateiname);
+  multi datei loeschen
+
+END PROC ketten;
+
+PROC koppeln (TEXT CONST dateiname) :
+
+  aus manager besorgen (dateiname, aendern erlaubt);
+  kopple (dateiname);
+  multi datei loeschen
+
+END PROC koppeln;
+
+PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock) :
+
+  BOOL VAR herkunft := FALSE;
+  IF multi user manager eingestellt THEN
+    manager abfragen
+  END IF;
+  herkunft eintragen (anzahl dateien + 1, herkunft) .
+
+manager abfragen :
+  IF (zusaetzliche namen CONTAINS dateiname) CAND
+    (NOT exists (dateiname) COR eigene datei ueberschreiben) THEN
+    IF mit lock THEN
+      lock (dateiname, multi user manager)
+    END IF;
+    forget (dateiname, quiet);
+    fetch (dateiname, multi user manager);
+    herkunft := TRUE
+  END IF .
+
+eigene datei ueberschreiben :
+  ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") .
+
+END PROC aus manager besorgen;
+
+PROC herkunft eintragen (INT CONST dateiindex, BOOL CONST herkunft) :
+
+  WHILE length (herkunftszeichen) < dateiindex REP
+    herkunftszeichen CAT blank
+  END REP;
+  replace (herkunftszeichen, dateiindex, entsprechendes zeichen) .
+
+entsprechendes zeichen :
+  IF herkunft THEN
+    "-"
+  ELSE
+    blank
+  END IF .
+
+END PROC herkunft eintragen;
+
+BOOL PROC manager herkunft (INT CONST dateiindex) :
+
+  IF length (herkunftszeichen) < dateiindex THEN
+    FALSE
+  ELSE
+    (herkunftszeichen SUB dateiindex) <> blank
+  END IF
+
+END PROC manager herkunft;
+
+PROC notizen ansehen :
+
+  notizen lesen (3, feldpuffer);
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  disable stop;
+  headline (f, t notizen ansehen);
+  notizen anbieten (f, feldpuffer, ganz, "EDIT/Notizen");
+  forget (ds);
+  enable stop;
+  IF aendern erlaubt THEN
+    notizen aendern (3, feldpuffer)
+  END IF
+
+END PROC notizen ansehen;
+
+PROC notizen anbieten (FILE VAR f, TEXT VAR puffer,
+                       FENSTER CONST edit fenster, TEXT CONST hilfsname) :
+
+  LET trennzeichen = "#-#";
+  enable stop;
+  notizen in datei;
+  datei editieren;
+  notizen aus datei .
+
+notizen in datei :
+  INT VAR
+    von := 1,
+    bis;
+  REP
+    bis := pos (puffer, trennzeichen, von);
+    IF bis = 0 THEN
+      putline (f, subtext (puffer, von))
+    ELSE
+      putline (f, subtext (puffer, von, bis - 1))
+    END IF;
+    von := bis + 3
+  UNTIL bis = 0 OR von > length (puffer) END REP .
+
+datei editieren :
+  modify (f);
+  edit (f, edit fenster, hilfsname, TRUE) .
+
+notizen aus datei :
+  TEXT VAR zeile;
+  puffer := niltext;
+  input (f);
+  WHILE NOT eof (f) REP
+    getline (f, zeile);
+    blank entfernen;
+    puffer CAT zeile;
+    puffer CAT trennzeichen
+  END REP .
+
+blank entfernen :
+  IF (zeile SUB length (zeile)) = blank THEN
+    zeile := subtext (zeile, 1, length (zeile) - 1)
+  END IF .
+
+END PROC notizen anbieten;
+
+PROC feldstruktur (EUDAT VAR eudat) :
+
+  SATZ VAR satz;
+  feldnamen lesen (eudat, satz);
+  IF feldnamen anfuegen THEN
+    feldnamen editieren
+  END IF;
+  IF ja (felder aendern, "JA/Feldaendern") THEN
+    auswahl zu aendernder felder
+  END IF .
+
+feldnamen anfuegen :
+  IF felderzahl (satz) > 0 THEN
+    ja (t feldnamen anfuegen, "JA/feldnamen") 
+  ELSE
+    TRUE
+  END IF .
+
+feldnamen editieren :
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  disable stop;
+  feldnamen anbieten (f, satz);
+  forget (ds);
+  enable stop;
+  feldnamen aendern (eudat, satz) .
+
+auswahl zu aendernder felder :
+  feldtypen dazuschreiben;
+  auswahl anbieten ("EUDAS-Felder", rechts, "AUSWAHL/Felder",
+                     PROC (TEXT VAR, INT CONST) aus sammel);
+  INT VAR feldnr := 1;
+  WHILE wahl (feldnr) > 0 REP
+    ein feld aendern;
+    feldnr INCR 1
+  END REP;
+  feldnamen aendern (eudat, satz) .
+
+feldtypen dazuschreiben :
+  satz initialisieren (sammel);
+  FOR feldnr FROM 1 UPTO felderzahl (satz) REP
+    feld lesen (satz, feldnr, feldpuffer);
+    feld aendern (sammel, feldnr, info + textdarstellung (feldpuffer))
+  END REP .
+
+info :
+  "(" + typtext (feldinfo (eudat, feldnr)) + ") " .
+
+ein feld aendern :
+  TEXT VAR feldname;
+  feld lesen (satz, wahl (feldnr), feldname);
+  editget (neuer feldname, feldname, "", "GET/feldname");
+  feld aendern (satz, wahl (feldnr), feldname);
+  TEXT VAR typ := typtext (feldinfo (eudat, wahl (feldnr)));
+  REP
+    editget (neuer typ, typ, "", "GET/feldtyp")
+  UNTIL texttyp (typ) >= -1 END REP;
+  feldinfo (eudat, wahl (feldnr), texttyp (typ)) .
+
+END PROC feldstruktur;
+
+PROC pruefbedingungen :
+
+  enable stop;
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  headline (f, t pruefbedingungen);
+  notizen lesen (1, feldpuffer);
+  disable stop;
+  notizen anbieten (f, feldpuffer, ganz, "EDIT/Pruefbed");
+  forget (ds);
+  enable stop;
+  IF aendern erlaubt THEN
+    notizen aendern (1, feldpuffer)
+  END IF .
+
+END PROC pruefbedingungen;
+
+PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) :
+
+  enable stop;
+  neue namen editieren;
+  neue namen zurueckschreiben .
+
+neue namen editieren :
+  modify (f);
+  headline (f, neue feldnamen eingeben);
+  edit (f, rechts, "EDIT/Feldnamen", TRUE) .
+
+neue namen zurueckschreiben :
+  INT VAR feldnr := felderzahl (satz);
+  input (f);
+  WHILE NOT eof (f) REP
+    getline (f, feldpuffer);
+    blank entfernen;
+    feldnr INCR 1;
+    feld aendern (satz, feldnr, feldpuffer)
+  END REP .
+
+blank entfernen :
+  IF (feldpuffer SUB length (feldpuffer)) = blank THEN
+    feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1)
+  END IF .
+
+END PROC feldnamen anbieten;
+
+TEXT PROC typtext (INT CONST typ) :
+
+  SELECT typ + 1 OF
+  CASE 0 : id text
+  CASE 1 : id din
+  CASE 2 : id zahl
+  CASE 3 : id datum
+  OTHERWISE niltext
+  END SELECT
+
+END PROC typtext;
+
+INT PROC texttyp (TEXT CONST t) :
+
+  IF t = id text THEN -1
+  ELIF t = id din THEN 0
+  ELIF t = id zahl THEN 1
+  ELIF t = id datum THEN 2
+  ELSE -2
+  END IF
+
+END PROC texttyp;
+
+PROC storage kontrollieren :
+
+  INT VAR size, used;
+  storage (size, used);
+  IF used > size THEN
+    neuer dialog; dialog;
+    out (speicherengpass)
+  END IF
+
+END PROC storage kontrollieren;
+
+
+(************************* Menue 'Einzelsatz' *****************************)
+
+BOOL VAR
+  satz leer,
+  umgeschaltet aus einfuegen := FALSE,
+  umgeschaltet aus aendern := FALSE;
+
+LET
+  aendern status =  #1044#
+"SATZ AENDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  einfuegen status =  #1045#
+"SATZ EINFUEGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  suchen status =  #1046#
+"SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  umschalten auf =  #1047#
+    "Umschalten auf Koppeldatei ",
+  koppelfelder uebernehmen =  #1048#
+    "Koppelfelder uebernehmen",
+  ungueltige satznummer =  #1049#
+    "Ungueltige Satznummer",
+  neue satznummer =  #1050#
+    "Neue Satznummer:",
+  t bitte warten =  #1051#
+    " Bitte warten.. ",
+  wzk =  #1052#
+    "wzK",
+  wz =  #1053#
+    "wz";
+
+LET
+  blanks unten links = ""6""23""0"              :",
+  blanks unten ganz  = ""6""23""0"              :"5"";
+
+
+PROC anzeigen interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : anzeige einschalten
+  CASE 1 : einen satz weiter
+  CASE 2 : einen satz zurueck
+  CASE 3 : direkt auf satz
+  CASE 4 : saetze auswaehlen
+  CASE 5 : auswahlbedingung loeschen
+  CASE 6 : aktuelle markierung aendern
+  CASE 7 : neuen satz einfuegen
+  CASE 8 : aktuellen satz aendern
+  CASE 9 : einzelsatz tragen
+  CASE 10: einzelsatz holen
+  CASE 11: felder auswaehlen
+  CASE 12: esc oben
+  CASE 13: esc unten
+  CASE 14: esc 1
+  CASE 15: esc 9
+  CASE 16: esc k
+  OTHERWISE anzeige update
+  END SELECT;
+  storage kontrollieren .
+
+anzeige einschalten :
+  exit zeichen (wz) .
+
+einen satz weiter :
+  bitte warten;
+  weiter (2);
+  bild ausgeben (FALSE) .
+
+einen satz zurueck :
+  bitte warten;
+  zurueck (2);
+  bild ausgeben (FALSE) .
+
+saetze auswaehlen :
+  suchen;
+  bild ausgeben (TRUE) .
+
+auswahlbedingung loeschen :
+  suchbedingung loeschen;
+  bild ausgeben (FALSE) .
+
+direkt auf satz :
+  TEXT VAR nr := niltext;
+  fusszeile ganz loeschen;
+  editget (neue satznummer, nr, "", "GET/auf satz");
+  INT CONST ziel := int (nr);
+  IF nr = niltext THEN
+    bild ausgeben (FALSE)
+  ELIF last conversion ok THEN
+    auf satz (ziel);
+    bild ausgeben (FALSE)
+  ELSE
+    errorstop (ungueltige satznummer)
+  END IF .
+
+neuen satz einfuegen :
+  einfuegen;
+  bild ausgeben (TRUE) .
+
+aktuellen satz aendern :
+  aendern;
+  bild ausgeben (TRUE) .
+
+aktuelle markierung aendern :
+  markierung aendern;
+  bild ausgeben (FALSE) .
+
+einzelsatz tragen :
+  last param darf nicht geoeffnet sein;
+  fusszeile ganz loeschen;
+  dateinamen anfordern (name der zieldatei);
+  einzelausfuehrung (PROC (TEXT CONST) trage satz und frage, eudas typ);
+  bild ausgeben (TRUE) .
+
+einzelsatz holen :
+  last param darf nicht geoeffnet sein;
+  fusszeile ganz loeschen;
+  dateinamen anfordern (name der quelldatei);
+  einzelausfuehrung (PROC (TEXT CONST) hole satz, eudas typ);
+  bild ausgeben (TRUE) .
+
+felder auswaehlen :
+  TEXT VAR wahlvektor;
+  fusszeile ganz loeschen;
+  felder waehlen lassen (wahlvektor);
+  IF wahlvektor <> niltext THEN
+    feldauswahl (wahlvektor)
+  END IF;
+  bild ausgeben (TRUE) .
+
+esc oben :
+  rollcursor;
+  rollen (-23);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc unten :
+  rollcursor;
+  rollen (23);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc 1 :
+  rollcursor;
+  rollen (-9999);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc 9 :
+  rollcursor;
+  rollen (9999);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc k :
+  IF auf koppeldatei THEN
+    zurueckschalten
+  ELSE
+    auf koppeldatei umschalten
+  END IF;
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (TRUE)
+  END IF .
+
+zurueckschalten :
+  IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN
+    fragen ob koppelfelder uebernehmen;
+    wieder in alte operation
+  ELSE
+    auf koppeldatei (0)
+  END IF;
+  ketten koppeln sperre .
+
+fragen ob koppelfelder uebernehmen :
+  fusszeile ganz loeschen;
+  IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN
+    auf koppeldatei (1)
+  ELSE
+    auf koppeldatei (0)
+  END IF .
+
+wieder in alte operation :
+  umgeschaltet aus einfuegen := FALSE;
+  IF umgeschaltet aus aendern THEN
+    umgeschaltet aus aendern := FALSE;
+    aendern
+  ELSE
+    einfuegen intern (TRUE)
+  END IF .
+
+anzeige update :
+  IF wahl nr = -2 THEN
+    IF anzahl dateien > 0 THEN
+      fusszeile links loeschen;
+      bild ausgeben (FALSE)
+    ELSE
+      fusszeile ganz loeschen
+    END IF
+  ELSE
+    dialogfenster loeschen;
+    fenster veraendert (fuss)
+  END IF .
+
+fusszeile links loeschen :
+  out (blanks unten links) .
+
+fusszeile ganz loeschen :
+  out (blanks unten ganz) .
+
+END PROC anzeigen interpreter;
+
+PROC suchen :
+
+  disable stop;
+  exit zeichen ("");
+  status anzeigen (suchen status);
+  suchen (PROC suchen hilfe);
+  exit zeichen (wz)
+
+END PROC suchen;
+
+PROC suchen hilfe :
+
+  hilfe anbieten ("EDIT/Suchen", rechts)
+
+END PROC suchen hilfe;
+
+PROC bitte warten :
+
+  status anzeigen (t bitte warten)
+
+END PROC bitte warten;
+
+PROC einfuegen :
+
+  einfuegen intern (FALSE)
+
+END PROC einfuegen;
+
+PROC einfuegen intern (BOOL CONST nach umschalten) :
+
+  BOOL VAR weiter aendern := nach umschalten;
+  exit zeichen setzen;
+  REP
+    status anzeigen (einfuegen status);
+    IF weiter aendern THEN
+      aendern (PROC einfuegen hilfe);
+      weiter aendern := FALSE
+    ELSE
+      einfuegen (PROC einfuegen hilfe)
+    END IF;
+    satz untersuchen;
+    exit zeichen bei einfuegen behandeln
+  END REP .
+
+exit zeichen bei einfuegen behandeln :
+  SELECT pos (wzk, exit durch) OF
+  CASE 0 : IF satz leer THEN
+             satz loeschen
+           END IF;
+           LEAVE einfuegen intern
+  CASE 1 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; weiter (2)
+           END IF
+  CASE 2 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; zurueck (2)
+           END IF
+  CASE 3 : auf koppeldatei umschalten;
+           IF auf koppeldatei THEN
+             umgeschaltet aus einfuegen := TRUE;
+             LEAVE einfuegen intern
+           END IF;
+           weiter aendern := TRUE
+  END SELECT .
+
+END PROC einfuegen intern;
+
+PROC einfuegen hilfe :
+
+  hilfe anbieten ("EDIT/Einfuegen", rechts)
+
+END PROC einfuegen hilfe;
+
+PROC exit zeichen setzen :
+
+  IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN
+    exit zeichen (wzk)
+  ELSE
+    exit zeichen (wz)
+  END IF
+
+END PROC exit zeichen setzen;
+
+PROC aendern :
+
+  exit zeichen setzen;
+  kommando auf taste legen ("F", "prueffehler editieren");
+  REP
+    status anzeigen (aendern status);
+    aendern (PROC aendern hilfe);
+    satz untersuchen;
+    exit zeichen bei aendern behandeln
+  END REP .
+
+exit zeichen bei aendern behandeln :
+  SELECT pos (wzk, exit durch) OF
+  CASE 0 : IF satz leer THEN
+             satz loeschen
+           END IF;
+           LEAVE aendern
+  CASE 1 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; weiter (2)
+           END IF
+  CASE 2 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; zurueck (2)
+           END IF
+  CASE 3 : auf koppeldatei umschalten;
+           IF auf koppeldatei THEN
+             umgeschaltet aus aendern := TRUE;
+             LEAVE aendern
+           END IF
+  END SELECT .
+
+END PROC aendern;
+
+PROC aendern hilfe :
+
+  hilfe anbieten ("EDIT/Aendern", rechts)
+
+END PROC aendern hilfe;
+
+PROC prueffehler editieren :
+
+  IF test version = datei version THEN
+    modify (test file);
+    edit (test file)
+  END IF
+
+END PROC prueffehler editieren;
+
+PROC auf koppeldatei umschalten :
+
+  INT VAR datei nr := folgedatei (0);
+  WHILE datei nr > 0 REP
+    out (blanks unten ganz);
+    IF auf diese datei schalten THEN
+      auf koppeldatei (datei nr);
+      ketten koppeln sperre;
+      LEAVE auf koppeldatei umschalten
+    END IF;
+    datei nr := folgedatei (datei nr)
+  END REP .
+
+auf diese datei schalten :
+  ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)),
+      "JA/umschalten") .
+
+END PROC auf koppeldatei umschalten;
+
+PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) :
+
+  outsubtext (zeile, anfang); out (cleol) .
+
+anfang :
+  pos (zeile, blank, 6) + 1 + dummy - dummy .
+
+END PROC zeilenrest ausgeben;
+
+PROC satz untersuchen :
+
+  feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer)
+
+END PROC satz untersuchen;
+
+PROC ob leer (TEXT CONST satz, INT CONST von, bis) :
+
+  satz leer := von < 3 OR von > length (satz) + bis - bis
+
+END PROC ob leer;
+
+PROC rollcursor :
+
+  cursor (15, 24)
+
+END PROC rollcursor;
+
+PROC trage satz und frage (TEXT CONST dateiname) :
+
+  IF exists (dateiname) THEN
+    teste auf offen
+  ELSE
+    frage ob einrichten (dateiname)
+  END IF;
+  bitte warten;
+  trage satz (dateiname) .
+
+teste auf offen :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF .
+
+END PROC trage satz und frage;
+
+PROC felder waehlen lassen (TEXT VAR wahlvektor) :
+
+  auswahl anbieten ("EUDAS-Anzeigefelder", rechts, "AUSWAHL/Anzeigefelder",
+                    PROC (TEXT VAR, INT CONST) gib namen);
+  wahlvektor := niltext;
+  INT VAR nr := 1;
+  WHILE wahl (nr) > 0 REP
+    wahlvektor CAT code (wahl (nr));
+    nr INCR 1
+  END REP
+
+END PROC felder waehlen lassen;
+
+
+(************************* Menue 'Gesamtdatei' ***************************)
+
+LET
+  felder auswaehlen =  #1054#
+    "Angezeigte Felder auswaehlen",
+  aufsteigend sortieren =  #1055#
+    " aufsteigend sortieren";
+
+DATASPACE VAR
+  kopier ds;
+
+
+PROC bearbeiten interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 1 : saetze kopieren
+  CASE 2 : saetze tragen
+  CASE 3 : nach vorschrift aendern
+  CASE 4 : uebersicht ausgeben
+  CASE 5 : datei sortieren
+  CASE 6 : alle markierungen loeschen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+saetze tragen :
+  last param darf nicht geoeffnet sein;
+  dateinamen anfordern (name der zieldatei);
+  einzelausfuehrung (PROC (TEXT CONST) trage saetze, eudas typ) .
+
+saetze kopieren :
+  last param darf nicht geoeffnet sein;
+  dateinamen anfordern (name der zieldatei);
+  einzelausfuehrung (PROC (TEXT CONST) kopiere saetze, eudas typ);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+nach vorschrift aendern :
+  dateinamen anfordern (name der verarbeitungsvorschrift);
+  ausfuehrung (PROC (TEXT CONST) verarbeite mit edit, file typ);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+uebersicht ausgeben :
+  TEXT VAR uebersichtsauswahl;
+  feldauswahl fuer uebersicht (uebersichtsauswahl);
+  uebersicht (uebersichtsauswahl, PROC uebersicht hilfe);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+datei sortieren :
+  zugriff (PROC (EUDAT VAR) einzelsortiere) .
+
+alle markierungen loeschen :
+  markierungen loeschen;
+  dialog; out (markierungen geloescht) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen;
+    fenster veraendert (fuss)
+  ELIF wahl nr = -2 THEN
+    fusszeile ausgeben ("", "")
+  END IF .
+
+END PROC bearbeiten interpreter;
+
+PROC last param darf nicht geoeffnet sein :
+
+  IF index der arbeitskopie (std) <> 0 THEN
+    last param (niltext)
+  END IF
+
+END PROC last param darf nicht geoeffnet sein;
+
+PROC trage saetze (TEXT CONST dateiname) :
+
+  BOOL VAR mit test;
+  IF exists (dateiname) THEN
+    teste auf offen;
+    frage ob testen
+  ELSE
+    frage ob einrichten (dateiname);
+    mit test := FALSE
+  END IF;
+  BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren");
+  bitte warten;
+  ggf datei initialisieren;
+  trage (dateiname, test file, mit test);
+  fehlerzahl ausgeben;
+  IF mit sortieren THEN
+    EUDAT VAR eudat;
+    oeffne (eudat, dateiname);
+    sortiere (eudat)
+  END IF .
+
+teste auf offen :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF .
+
+frage ob testen :
+  mit test := ja (pruefbedingungen testen, "JA/testen") .
+
+ggf datei initialisieren :
+  IF mit test THEN
+    forget (test ds);
+    test ds := nilspace;
+    test file := sequential file (output, test ds);
+    test version := datei version
+  ELSE
+    forget (test ds);
+    test version := datei version - 1
+  END IF .
+
+fehlerzahl ausgeben :
+  IF mit test CAND lines (test file) > 0 THEN
+    dialog; put (lines (test file));
+    put (prueffehler festgestellt)
+  END IF .
+
+END PROC trage saetze;
+
+PROC verarbeite mit edit (TEXT CONST dateiname) :
+
+  IF NOT exists (dateiname) THEN
+    edit unten (dateiname, "EDIT/Verarbeite")
+  END IF;
+  bild frei fuer uebersetzung;
+  FILE VAR f := sequential file (input, dateiname);
+  disable stop;
+  verarbeite (f);
+  uebersetzungsfehler behandeln .
+
+END PROC verarbeite mit edit;
+
+PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) :
+
+  uebersichtsauswahl := niltext;
+  IF ja (felder auswaehlen, "JA/Ub.Felder") THEN
+    felder waehlen lassen (uebersichtsauswahl)
+  END IF
+
+END PROC feldauswahl fuer uebersicht;
+
+PROC uebersicht hilfe :
+
+  hilfe anbieten ("UEBERSICHT", ganz)
+
+END PROC uebersicht hilfe;
+
+PROC kopiere saetze (TEXT CONST dateiname) :
+
+  disable stop;
+  kopier ds := nilspace;
+  kopiere saetze intern (dateiname);
+  forget (kopier ds)
+
+END PROC kopiere saetze;
+
+PROC kopiere saetze intern (TEXT CONST dateiname) :
+
+  TEXT VAR mustername := "";
+  FILE VAR f;
+  EUDAT VAR eudat;
+  BOOL VAR mit sortieren := FALSE;
+
+  enable stop;
+  IF exists (dateiname) THEN
+    teste auf offen und sortieren
+  ELSE
+    frage ob einrichten (dateiname)
+  END IF;
+  editget (name kopiermuster, mustername, "", "GET/kopiermuster");
+  IF exists (mustername) THEN
+    f := sequential file (input, mustername)
+  ELSE
+    ggf kopiermuster einrichten;
+    std kopiermuster (dateiname, f)
+  END IF;
+  modify (f);
+  wirklich kopieren;
+  ggf sortieren .
+
+teste auf offen und sortieren :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF;
+  oeffne (eudat, dateiname);
+  IF sortierreihenfolge (eudat) <> niltext THEN
+    mit sortieren := ja (sortierfrage, "JA/sortieren")
+  END IF .
+
+ggf kopiermuster einrichten :
+  IF mustername = niltext THEN
+    f := sequential file (output, kopier ds)
+  ELSE
+    frage ob einrichten (mustername);
+    f := sequential file (output, mustername)
+  END IF .
+
+wirklich kopieren :
+  edit (f, ganz, "EDIT/Kopiermuster", TRUE);
+  bild frei fuer uebersetzung;
+  kopiere (dateiname, f) .
+
+ggf sortieren :
+  IF mit sortieren THEN
+    oeffne (eudat, dateiname);
+    sortiere (eudat)
+  END IF .
+
+END PROC kopiere saetze intern;
+
+INT PROC index der arbeitskopie (TEXT CONST dateiname) :
+
+  INT VAR dateinr;
+  FOR dateinr FROM 1 UPTO anzahl dateien REP
+    IF eudas dateiname (dateinr) = dateiname THEN
+      LEAVE index der arbeitskopie WITH dateinr
+    END IF
+  END REP;
+  0
+
+END PROC index der arbeitskopie;
+
+PROC edit unten (TEXT CONST dateiname, hilfe) :
+
+  IF NOT exists (dateiname) THEN
+    frage ob einrichten (dateiname)
+  END IF;
+  FILE VAR f := sequential file (modify, dateiname);
+  edit (f, ganz, hilfe, TRUE)
+
+END PROC edit unten;
+
+PROC bild frei fuer uebersetzung :
+
+  bitte warten;
+  cursor (1, 2);
+  out (cl eop);
+  bildschirm neu
+
+END PROC bild frei fuer uebersetzung;
+
+PROC einzelsortiere (EUDAT VAR eudat) :
+
+  TEXT VAR reihenfolge := sortierreihenfolge (eudat);
+  IF reihenfolge = niltext COR alte reihenfolge aendern THEN
+    sortierreihenfolge aendern;
+    bitte warten;
+    sortiere (eudat, reihenfolge)
+  ELSE
+    bitte warten;
+    sortiere (eudat)
+  END IF .
+
+alte reihenfolge aendern :
+  ja (alte feldreihenfolge aendern, "JA/Sortierfelder") .
+
+sortierreihenfolge aendern :
+  feldnamen lesen (eudat, sammel);
+  auswahl anbieten ("EUDAS-Sortierfelder", rechts, "AUSWAHL/Sortierfelder",
+                    PROC (TEXT VAR, INT CONST) aus sammel);
+  INT VAR feldnr := 1;
+  reihenfolge := niltext;
+  WHILE wahl (feldnr) <> 0 REP
+    reihenfolge CAT code (wahl (feldnr));
+    nach richtung fragen;
+    feldnr INCR 1
+  END REP .
+
+nach richtung fragen :
+  feld lesen (sammel, wahl (feldnr), feldpuffer);
+  IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren,
+         "JA/Sortierrichtung") THEN
+    reihenfolge CAT "+"
+  ELSE
+    reihenfolge CAT "-"
+  END IF .
+
+END PROC einzelsortiere;
+
+PROC gib namen (TEXT VAR name, INT CONST nr) :
+
+  IF nr <= anzahl felder THEN
+    feldnamen lesen (nr, name)
+  ELSE
+    name := niltext
+  END IF
+
+END PROC gib namen;
+
+
+(************************* Menue 'Drucken' ********************************)
+
+LET
+  direkt ausgabe =  #1056#
+    "Ausgabe automatisch zum Drucker",
+  in bestimmte datei =  #1057#
+    "Ausgabe in bestimmte Datei",
+  name druckzieldatei =  #1058#
+    "Name Ausgabedatei:",
+  sortierfrage =  #1059#
+    "Zieldatei anschliessend sortieren",
+  pruefbedingungen testen =  #1060#
+    "Pruefbedingungen testen",
+  prueffehler festgestellt =  #1061#
+    "Prueffehler festgestellt",
+  nicht in offene datei =  #1062#
+    "Zieldatei darf nicht geoeffnet sein",
+  name kopiermuster =  #1063#
+    "Name Kopiermuster (RET=Std):";
+
+LET
+  z form =  #1093#
+    " zeilenweise formatieren",
+  s form =  #1094#
+    " seitenweise formatieren";
+
+BOOL VAR
+  zeilen automatisch := FALSE,
+  seiten automatisch := FALSE;
+
+
+PROC drucken interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 1 : nach muster drucken
+  CASE 2 : ausgaberichtung umschalten
+  CASE 3 : musterdatei aendern
+  CASE 4 : textdatei drucken
+  CASE 5 : nachbearbeiten
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+nach muster drucken :
+  dateinamen anfordern (name des druckmusters);
+  ausfuehrung (PROC (TEXT CONST) drucke mit edit, file typ);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+ausgaberichtung umschalten :
+  direkt drucken (ja (direktausgabe, "JA/direkt drucken"));
+  IF NOT direkt drucken CAND ja (in bestimmte datei, "JA/Druckdatei") THEN
+    TEXT VAR dateiname := niltext;
+    editget (name druckzieldatei, dateiname, "", "GET/Druckdatei");
+    IF dateiname <> niltext THEN
+      druckdatei (dateiname)
+    END IF
+  END IF .
+
+musterdatei aendern :
+  ausfuehrung (PROC (TEXT CONST) muster edit, file typ);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+textdatei drucken :
+  ausfuehrung (PROC (TEXT CONST) print, file typ) .
+
+nachbearbeiten :
+  ausfuehrung (PROC (TEXT CONST) nachbearbeitung, file typ);
+  dialogfenster loeschen;
+  fusszeile ausgeben ("", "") .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen;
+    fenster veraendert (fuss)
+  ELIF wahl nr = -2 THEN
+    fusszeile ausgeben ("", "")
+  END IF .
+
+END PROC drucken interpreter;
+
+PROC uebersetzungsfehler behandeln :
+
+  IF uebersetzungsfehler THEN
+    clear error
+  END IF .
+
+uebersetzungsfehler :
+  is error CAND errormessage = niltext .
+
+END PROC uebersetzungsfehler behandeln;
+
+PROC drucke mit edit (TEXT CONST dateiname) :
+
+  IF NOT exists (dateiname) THEN
+    muster edit (dateiname)
+  END IF;
+  bild frei fuer uebersetzung;
+  disable stop;
+  drucke (dateiname);
+  uebersetzungsfehler behandeln
+
+END PROC drucke mit edit;
+
+PROC muster edit (TEXT CONST dateiname) :
+
+  edit unten (dateiname, "EDIT/Druckmuster")
+ 
+END PROC muster edit;
+
+PROC print (TEXT CONST dateiname) :
+
+  do ("print (" + textdarstellung (dateiname) + ")")
+
+END PROC print;
+
+PROC nachbearbeitung (TEXT CONST dateiname) :
+
+  IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN
+    zeilen formatieren
+  END IF;
+  IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN
+    seiten formatieren
+  END IF .
+
+zeilen formatieren :
+  IF zeilen automatisch THEN
+    autoform (dateiname)
+  ELSE
+    lineform (dateiname)
+  END IF;
+  page;
+  bildschirm neu .
+
+seiten formatieren :
+  IF seiten automatisch THEN
+    autopageform (dateiname)
+  ELSE
+    pageform (dateiname)
+  END IF;
+  bildschirm neu .
+
+END PROC nachbearbeitung;
+
+PROC formatieren automatisch (BOOL CONST za, sa) :
+
+  zeilen automatisch := za;
+  seiten automatisch := sa
+
+END PROC formatieren automatisch;
+
+
+(********************** Menue 'Dateien' ***********************************)
+
+TEXT VAR arbeitsbereich;
+
+LET
+  p task =  #1064#
+    " Task: ",
+  t neuer name =  #1065#
+    "Neuer Name:",
+  t zieldatei =  #1066#
+    "Zieldatei:",
+  t belegt =  #1067#
+    " belegt ",
+  t kb =  #1068#
+    "KB.",
+  t existiert nicht =  #1069#
+    " existiert nicht.",
+  t loeschen =  #1070#
+    " im dieser Task loeschen",
+  t neu einrichten =  #1071#
+    " neu einrichten";
+
+
+PROC dateiverwaltung (INT CONST wahl nr) :
+
+  enable stop;
+  SELECT wahl nr OF
+  CASE 0 : arbeitsbereich bestimmen
+  CASE 1 : dateiuebersicht
+  CASE 2 : datei loeschen
+  CASE 3 : datei umbenennen
+  CASE 4 : datei kopieren
+  CASE 5 : speicherbelegung datei
+  CASE 6 : datei reorganisieren
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+arbeitsbereich bestimmen :
+  arbeitsbereich := name (myself) .
+
+datei reorganisieren :
+  ausfuehrung (PROC (TEXT CONST) aufraeumen, 0) .
+
+datei umbenennen :
+  ausfuehrung (PROC (TEXT CONST) umbenennen, 0) .
+
+datei loeschen :
+  ausfuehrung (PROC (TEXT CONST) loeschen, 0) .
+
+dateiuebersicht :
+  disable stop;
+  DATASPACE VAR list ds := nilspace;
+  FILE VAR f := sequential file (output, list ds);
+  list (f);
+  IF NOT is error THEN
+    edit (f, rechts, "SHOW/Uebersicht", FALSE)
+  END IF;
+  forget (list ds);
+  enable stop;
+  tastenpuffer loeschen .
+
+datei kopieren :
+  ausfuehrung (PROC (TEXT CONST) ds kopieren, 0) .
+
+speicherbelegung datei :
+  ausfuehrung (PROC (TEXT CONST) speicherbelegung, 0) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen;
+    fenster veraendert (fuss)
+  ELIF wahl nr = -2 THEN
+    fusszeile ausgeben (p task, arbeitsbereich)
+  END IF .
+
+END PROC dateiverwaltung;
+
+PROC tastenpuffer loeschen :
+
+  WHILE getcharety <> niltext REP END REP
+
+END PROC tastenpuffer loeschen;
+
+PROC aufraeumen (TEXT CONST dateiname) :
+
+  IF type (old (dateiname)) = eudas typ THEN
+    reorganisiere (dateiname)
+  ELSE
+    reorganize (dateiname)
+  END IF
+
+END PROC aufraeumen;
+
+PROC umbenennen (TEXT CONST dateiname) :
+
+  TEXT VAR neuer name := dateiname;
+  IF exists (dateiname) THEN
+    editget (t neuer name, neuer name, "", "GET/rename")
+  END IF;
+  rename (dateiname, neuer name)
+
+END PROC umbenennen;
+
+PROC loeschen (TEXT CONST dateiname) :
+
+  IF offene datei THEN
+    errorstop (nicht in offene datei)
+  ELIF exists (dateiname) CAND frage bejaht THEN
+    forget (dateiname, quiet)
+  END IF .
+
+offene datei :
+  index der arbeitskopie (dateiname) <> 0 .
+
+frage bejaht :
+  ja (textdarstellung (dateiname) + t loeschen, "JA/forget") .
+
+END PROC loeschen;
+
+PROC ds kopieren (TEXT CONST dateiname) :
+
+  TEXT VAR zieldatei := niltext;
+  editget (t zieldatei, zieldatei, "", "GET/copy");
+  copy (dateiname, zieldatei)
+
+END PROC ds kopieren;
+
+PROC speicherbelegung (TEXT CONST dateiname) :
+
+  dialog; 
+  out (textdarstellung (dateiname));
+  IF exists (dateiname) THEN
+    out (t belegt);
+    put (ds pages (old (dateiname)) DIV 2);
+    out (t kb)
+  ELSE
+    out (t existiert nicht)
+  END IF
+
+END PROC speicherbelegung;
+
+
+(*********************** Menue 'Archiv' ***********************************)
+
+TEXT VAR
+  letzter archivname := niltext,
+  zielarchiv := "ARCHIVE";
+
+INT VAR zielstation := 0;
+
+THESAURUS VAR archivinhalt;
+
+BOOL VAR
+  archivzugriff,
+  ziel ist manager := TRUE,
+  dialogue state;
+
+LET
+  p zielarchiv =  #1072#
+    " Ziel: ",
+  archiv heisst =  #1073#
+    "Archiv heisst ",
+  name des archivs =  #1074#
+    "Name des Archivs:",
+  name zielarchiv =  #1075#
+    "Name Zielarchiv:",
+  nr zielstation =  #1076#
+    "Nr. der Zielstation (od. RETURN):",
+  ist ziel archivmanager =  #1077#
+    "Ist das Zielarchiv ein Archivmanager",
+  diskette formatieren =  #1078#
+    "Archivdiskette vorher formatieren",
+  neuer archivname =  #1079#
+    "Neuer Archivname:",
+  t im system ueberschreiben =  #1080#
+    " im System ueberschreiben",
+  t auf archiv loeschen =  #1081#
+    " auf Archiv loeschen",
+  t archiv =  #1082#
+    "Archiv ",
+  t ueberschreiben =  #1083#
+    " ueberschreiben",
+  frage archiv initialisieren =  #1084#
+    "Archiv initialisieren",
+  t auf archiv ueberschreiben =  #1085#
+    " auf Archiv ueberschreiben";
+
+LET
+  t passwort =  #1095#
+    "Passwort: ",
+  passwortwiederholung falsch =  #1096#
+    "Passwort stimmt nicht mit der ersten Eingabe überein",
+  bitte passwort wiederholen =  #1097#
+    "Passwort zur Kontrolle bitte nochmal eingeben.",
+  passwort loeschen =  #1098#
+    "Passwort loeschen",
+  falsche stationsnr =  #1099#
+    "Unzlaessige Stationsnummer",
+  task ist kein manager =  #1100#
+    "Angegebene Task ist kein Manager";
+
+
+PROC archivverwaltung (INT CONST wahl nr) :
+
+  enable stop;
+  SELECT wahl nr OF
+  CASE 0 : eintritt
+  CASE 1 : archivuebersicht
+  CASE 2 : uebersicht drucken
+  CASE 3 : datei vom archiv holen
+  CASE 4 : datei auf archiv sichern
+  CASE 5 : auf archiv loeschen
+  CASE 6 : archiv initialisieren
+  CASE 7 : zielarchiv einstellen
+  CASE 8 : passwort einstellen
+  CASE 9 : reservieren
+  OTHERWISE verlassen
+  END SELECT;
+  storage kontrollieren .
+
+eintritt :
+  archivzugriff := FALSE .
+
+datei auf archiv sichern :
+  IF ziel ist manager THEN
+    archivnamen holen
+  END IF;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  ausfuehrung (PROC (TEXT CONST) archivieren, 0) .
+
+datei vom archiv holen :
+  disable stop;
+  archiv anmelden;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  IF falscher name THEN archivinhalt := ALL eudas archiv END IF;
+  enable stop;
+  auf archiv (PROC (TEXT CONST) holen) .
+
+auf archiv loeschen :
+  IF ziel ist manager THEN
+    archivnamen holen
+  END IF;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  auf archiv (PROC (TEXT CONST) auf archiv loeschen) .
+
+archivuebersicht :
+  archiv anmelden;
+  disable stop;
+  bitte warten;
+  DATASPACE VAR list ds := nilspace;
+  f :=sequential file (output, list ds);
+  list (f, eudas archiv);
+  IF falscher name THEN list (f, eudas archiv) END IF;
+  IF NOT is error THEN
+    modify (f); to line (f, 1);
+    write record (f, headline (f));
+    headline (f, niltext);
+    edit (f, rechts, "SHOW/Uebersicht", FALSE)
+  END IF;
+  forget (list ds);
+  tastenpuffer loeschen;
+  enable stop .
+
+uebersicht drucken :
+  archiv anmelden;
+  namen generieren;
+  FILE VAR f := sequential file (output, list name);
+  disable stop;
+  bitte warten;
+  list (f, eudas archiv);
+  IF falscher name THEN list (f, eudas archiv) END IF;
+  enable stop;
+  modify (f);
+  insert record (f);
+  write record (f, headline (f));
+  print (list name);
+  forget (list name, quiet) .
+
+namen generieren :
+  INT VAR i := 0;
+  TEXT VAR list name;
+  REP
+    i INCR 1;
+    list name := "Archivliste " + text (i)
+  UNTIL NOT exists (list name) END REP .
+
+archiv initialisieren :
+  archiv anmelden;
+  IF ja (diskette formatieren, "JA/format") THEN
+    archiv formatieren
+  ELIF benanntes archiv THEN
+    IF loeschen verneint THEN LEAVE archiv initialisieren END IF
+  ELSE
+    IF initialisieren verneint THEN LEAVE archiv initialisieren END IF
+  END IF;
+  neuen namen erfragen;
+  tatsaechlich initialisieren .
+
+archiv formatieren :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  format (eudas archiv);
+  reset command dialogue;
+  enable stop .
+
+benanntes archiv :
+  reserve ("", eudas archiv);
+  bitte warten;
+  disable stop;
+  archivinhalt := ALL eudas archiv;
+  BOOL CONST ergebnis := falscher name;
+  clear error;
+  enable stop;
+  ergebnis .
+
+loeschen verneint :
+  NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben,
+          "JA/archiv loeschen") .
+
+initialisieren verneint :
+  NOT ja (frage archiv initialisieren, "JA/archiv init") .
+
+neuen namen erfragen :
+  editget (neuer archivname, letzter archivname, "", "GET/Archivname");
+  reserve (letzter archivname, eudas archiv) .
+
+tatsaechlich initialisieren :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  clear (eudas archiv);
+  reset command dialogue .
+
+zielarchiv einstellen :
+  TEXT VAR zieltaskname := zielarchiv;
+  IF archivzugriff THEN
+    release (eudas archiv); archivzugriff := FALSE
+  END IF;
+  editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv");
+  IF zieltaskname = niltext THEN
+    LEAVE zielarchiv einstellen
+  END IF;
+  zielstation einlesen;
+  ziel ist manager := ja (ist ziel archivmanager, "JA/Zielmanager");
+  werte uebertragen;
+  waehlbar (6, 6, ziel ist manager);
+  waehlbar (6, 9, NOT ziel ist manager);
+  bildschirm neu;
+  fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv) .
+
+zielstation einlesen :
+  TEXT VAR rechner := text (station (myself));
+  IF station (myself) <> 0 THEN
+    editget (nr zielstation, rechner, "", "GET/Zielstation")
+  END IF .
+
+werte uebertragen :
+  zielstation := int (rechner);
+  IF NOT last conversion ok THEN
+    errorstop (falsche stationsnr)
+  END IF;
+  zielarchiv := zieltaskname;
+  teste auf manager (eudas archiv) .
+
+stationsnr :
+  IF zielstation = 0 THEN
+    niltext
+  ELSE
+    text (zielstation) + "/"
+  END IF .
+
+reservieren :
+  TEXT VAR parameter := niltext;
+  editget (name des archivs, parameter, "", "GET/Archivname");
+  reserve (parameter, eudas archiv);
+  archivzugriff := TRUE .
+
+verlassen :
+  IF wahl nr = -1 THEN
+    IF archivzugriff THEN
+      release (eudas archiv)
+    END IF;
+    dialogfenster loeschen;
+    fenster veraendert (fuss)
+  ELIF wahl nr = -2 THEN
+    fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv)
+  END IF .
+
+END PROC archivverwaltung;
+
+TASK PROC eudas archiv :
+
+  IF zielstation = 0 THEN
+    task (zielarchiv)
+  ELSE
+    zielstation / zielarchiv
+  END IF
+
+END PROC eudas archiv;
+
+PROC teste auf manager (TASK CONST t) :
+
+  INT VAR i;
+  IF station (t) = station (myself) THEN
+    FOR i FROM 1 UPTO 5 REP
+      IF status (t) = 2 OR status (t) = 6 THEN
+        LEAVE teste auf manager
+      END IF;
+      pause (10)
+    END REP;
+    errorstop (task ist kein manager)
+  END IF
+
+END PROC teste auf manager;
+
+PROC archivnamen holen :
+
+  TEXT VAR neuer archivname := letzter archivname;
+  editget (name des archivs, neuer archivname, "", "GET/Archivname");
+  IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN
+    reserve (neuer archivname, eudas archiv);
+    archivzugriff := TRUE
+  END IF;
+  letzter archivname := neuer archivname
+ 
+END PROC archivnamen holen;
+
+PROC archiv anmelden :
+
+  IF NOT archivzugriff AND ziel ist manager THEN
+    reserve (letzter archivname, eudas archiv);
+    archivzugriff := TRUE
+  END IF
+
+END PROC archiv anmelden;
+
+BOOL PROC falscher name :
+
+  IF ziel ist manager AND is error THEN
+    TEXT CONST meldung := errormessage;
+    IF subtext (meldung, 1, 14) = archiv heisst CAND
+       subtext (meldung, 16, 20) <> "?????" THEN
+      clear error;
+      nochmal anmelden;
+      LEAVE falscher name WITH TRUE
+    END IF
+  END IF;
+  FALSE .
+
+nochmal anmelden :
+  letzter archivname := subtext (meldung, 16, length (meldung) - 1);
+  reserve (letzter archivname, eudas archiv) .
+
+END PROC falscher name;
+
+PROC archivieren (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN
+    vorher eventuell sichern;
+    bitte warten;
+    set command dialogue false;
+    save (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+auf archiv ueberschreiben :
+  ja (textdarstellung (dateiname) + t auf archiv ueberschreiben, "JA/save") .
+
+vorher eventuell sichern :
+  INT CONST nr := index der arbeitskopie (dateiname);
+  IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN
+    einzelsicherung (nr)
+  END IF .
+
+END PROC archivieren;
+
+PROC holen (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN
+    bitte warten;
+    set command dialogue false;
+    fetch (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+eigene datei ueberschreiben :
+  ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") .
+
+END PROC holen;
+
+PROC auf archiv loeschen (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN
+    bitte warten;
+    set command dialogue false;
+    erase (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+auf archiv loeschen :
+  ja (textdarstellung (dateiname) + t auf archiv loeschen, "JA/erase") .
+
+END PROC auf archiv loeschen;
+
+PROC set command dialogue false :
+
+  dialogue state := command dialogue;
+  command dialogue (FALSE)
+
+END PROC set command dialogue false;
+
+PROC reset command dialogue :
+
+  command dialogue (dialogue state)
+
+END PROC reset command dialogue;
+
+PROC auf archiv (PROC (TEXT CONST) operation) :
+
+  TEXT VAR dateiname := niltext;
+  editget (name der datei, dateiname, "z", "GET/Dateiname");
+  IF dateiname = esc z THEN
+    uebersicht zeigen
+  ELSE
+    last param (dateiname);
+    operation (dateiname)
+  END IF .
+
+uebersicht zeigen :
+  dateinamen sammeln (archivinhalt, 0);
+  auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv",
+                    PROC (TEXT VAR, INT CONST) als text);
+  operation ausfuehren (PROC (TEXT CONST) operation) .
+
+END PROC auf archiv;
+
+PROC passwort einstellen :
+
+  BOUND ROW 2 TEXT VAR pw;
+  DATASPACE VAR ds := nilspace;
+  pw := ds;
+  disable stop;
+  passwort holen (pw (1));
+  IF pw (1) = niltext THEN
+    fragen ob loeschen
+  ELSE
+    doppelt eingeben
+  END IF;
+  forget (ds) .
+
+fragen ob loeschen :
+  IF ja (passwort loeschen, "JA/pw loeschen") THEN
+    dialog; dialog;
+    enter password (niltext)
+  END IF .
+
+doppelt eingeben :
+  dialog; out (bitte passwort wiederholen);
+  passwort holen (pw (2));
+  IF pw (1) <> pw (2) THEN
+    errorstop (passwortwiederholung falsch)
+  ELSE
+    dialog; dialog;
+    enter password (pw (1))
+  END IF .
+
+END PROC passwort einstellen;
+
+PROC passwort holen (TEXT VAR wort) :
+
+  enable stop;
+  dialog; out (t passwort);
+  get secret line (wort)
+
+END PROC passwort holen;
+
+
+(******************** Parameter-Auswahl ***********************************)
+
+SATZ VAR sammel;
+
+LET
+  name der datei =  #1086#
+    "Name der Datei:",
+  name der zieldatei =  #1087#
+    "Name der Zieldatei:",
+  name der verarbeitungsvorschrift =  #1088#
+    "Name der Verarbeitungsvorschrift:",
+  name des druckmusters =  #1089#
+    "Name des Druckmusters:",
+  name der quelldatei =  #1090#
+    "Name der Quelldatei:";
+
+LET
+  keine datei zur auswahl =  #1101#
+    "Keine Datei zur Auswahl vorhanden.";
+
+TEXT VAR
+  aktueller prompt := name der datei,
+  offene;
+
+
+PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ) :
+
+  uebergebene namen sammeln;
+  offene dateien merken;
+  zusaetzliche namen dazu;
+  meldung falls keine datei .
+
+offene dateien merken :
+  offene := niltext;
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl dateien REP
+    INT CONST t link := feldindex (sammel, eudas dateiname (i));
+    IF t link > 0 THEN
+      offene CAT code (t link)
+    END IF
+  END REP .
+
+uebergebene namen sammeln :
+  INT VAR
+    stelle := 1,
+    von := 0;
+  satz initialisieren (sammel);
+  REP
+    get (t, feldpuffer, von);
+    IF feldpuffer = niltext THEN
+      LEAVE uebergebene namen sammeln
+    ELIF typ = 0 COR type (old (feldpuffer)) = typ THEN
+      feld aendern (sammel, stelle, feldpuffer);
+      stelle INCR 1
+    END IF
+  END REP .
+
+zusaetzliche namen dazu :
+  von := 0;
+  REP
+    get (zusaetzliche namen, feldpuffer, von);
+    IF feldpuffer = niltext THEN
+      LEAVE zusaetzliche namen dazu
+    ELIF NOT (t CONTAINS feldpuffer) THEN
+      feld aendern (sammel, stelle, feldpuffer);
+      stelle INCR 1
+    END IF
+  END REP .
+
+meldung falls keine datei :
+  IF stelle = 1 THEN
+    dialog; out (keine datei zur auswahl);
+    errorstop (niltext)
+  END IF .
+
+END PROC dateinamen sammeln;
+
+PROC als text (TEXT VAR inhalt, INT CONST stelle) :
+
+  IF stelle < 256 THEN
+    feld lesen (sammel, stelle, inhalt);
+    IF pos (offene, code (stelle)) > 0 THEN
+      inhalt := "<!> " + textdarstellung (inhalt)
+    ELIF inhalt <> niltext THEN
+      inhalt := textdarstellung (inhalt)
+    END IF
+  ELSE
+    inhalt := niltext
+  END IF
+
+END PROC als text;
+
+PROC operation ausfuehren (PROC (TEXT CONST) operation) :
+
+  INT VAR
+    stelle := 1;
+  REP
+    IF wahl (stelle) = 0 THEN
+      LEAVE operation ausfuehren
+    ELSE
+      feld lesen (sammel, wahl (stelle), feldpuffer);
+      dialog; out (text (stelle, 3)); out (". ");
+      out (textdarstellung (feldpuffer));
+      last param (feldpuffer);
+      operation (feldpuffer)
+    END IF;
+    stelle INCR 1
+  END REP
+
+END PROC operation ausfuehren;
+
+PROC ausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) :
+
+  enable stop;
+  TEXT VAR dateiname;
+  dateinamen anfordern (dateiname, typ);
+  IF dateiname = esc z THEN
+    operation ausfuehren (PROC (TEXT CONST) operation)
+  ELSE
+    last param (dateiname);
+    operation (dateiname)
+  END IF
+
+END PROC ausfuehrung;
+
+PROC einzelausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) :
+
+  enable stop;
+  TEXT VAR dateiname;
+  dateinamen anfordern (dateiname, typ);
+  IF dateiname = esc z THEN
+    IF wahl (1) = 0 THEN
+      errorstop (niltext)
+    ELSE
+      feld lesen (sammel, wahl (1), dateiname)
+    END IF
+  END IF;
+  last param (dateiname);
+  operation (dateiname)
+
+END PROC einzelausfuehrung;
+
+PROC dateinamen anfordern (TEXT CONST prompt) :
+
+  aktueller prompt := prompt
+
+END PROC dateinamen anfordern;
+
+PROC dateinamen anfordern (TEXT VAR dateiname, INT CONST typ) :
+
+  IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN
+    dateiname := std
+  ELSE
+    dateiname := niltext
+  END IF;
+  disable stop;
+  editget (aktueller prompt, dateiname, "z", "GET/Dateiname");
+  aktueller prompt := name der datei;
+  enable stop;
+  IF dateiname = niltext THEN
+    errorstop (niltext)
+  ELIF dateiname = esc z THEN
+    dateinamen sammeln (all, typ);
+    auswahl anbieten ("EUDAS-Dateiauswahl", rechts, "AUSWAHL/Datei",
+                      PROC (TEXT VAR, INT CONST) als text);
+    bitte warten
+  END IF
+
+END PROC dateinamen anfordern;
+
+PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) :
+
+  IF stelle <= 256 THEN
+    feld lesen (sammel, stelle, inhalt)
+  ELSE
+    inhalt := niltext
+  END IF
+
+END PROC aus sammel;
+
+PROC frage ob einrichten (TEXT CONST dateiname) :
+
+  IF NOT ja (textdarstellung (dateiname) + t neu einrichten, 
+             "JA/einrichten") THEN
+    errorstop (niltext)
+  END IF
+
+END PROC frage ob einrichten;
+
+
+(************************** Editor ****************************************)
+
+LET
+  edit status =  #1091#
+"EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?",
+  show status =  #1092#
+"ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ?";
+
+INT VAR return code;
+
+BOOL VAR
+  zeige edit status,
+  feldanzeige erlaubt;
+
+
+PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe,
+           BOOL CONST aendern) :
+
+  INT VAR x, y, x l, y l;
+  fenstergroesse (fenster, x, y, x l, y l);
+  fenster veraendert (fenster);
+  enable stop;
+  feldanzeige erlauben;
+  zeige edit status := aendern;
+  REP
+    edit status anzeigen;
+    open editor (groesster editor + 1, f, aendern, x, y, x l, y l);
+    edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo);
+    return code behandeln
+  END REP .
+
+feldanzeige erlauben :
+  IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN
+    feldanzeige erlaubt := TRUE
+  ELSE
+    feldanzeige erlaubt := FALSE
+  END IF .
+
+return code behandeln :
+  SELECT return code OF
+  CASE 0 : LEAVE edit
+  CASE 1 : hilfe anbieten (hilfe, fenster)
+  CASE 2 : errorstop (niltext)
+  END SELECT .
+
+END PROC edit;
+
+PROC edit status anzeigen :
+
+  IF zeige edit status THEN
+    status anzeigen (edit status)
+  ELSE
+    status anzeigen (show status)
+  END IF
+
+END PROC edit status anzeigen;
+
+PROC kdo (TEXT CONST zeichen) :
+
+  return code := pos ("q?h", zeichen);
+  IF return code > 0 THEN
+    return code DECR 1;
+    quit
+  ELIF feldanzeige erlaubt CAND zeichen = "F" THEN
+    feldnamen anzeigen;
+    edit status anzeigen
+  ELSE
+    std kommando interpreter (zeichen);
+    edit status anzeigen;
+    bildschirm neu
+  END IF
+
+END PROC kdo;
+
+PROC feldnamen anzeigen :
+
+  IF anzahl felder > 0 THEN
+    feldnamen sammeln;
+    sammlung zur auswahl anbieten;
+    ergebnis in editor uebernehmen
+  END IF .
+
+feldnamen sammeln :
+  INT VAR feldnr;
+  satz initialisieren (sammel, anzahl felder);
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldpuffer);
+    feld aendern (sammel, feldnr, feldpuffer)
+  END REP .
+
+sammlung zur auswahl anbieten :
+  auswahl anbieten ("EUDAS-Editfelder", rechts, "AUSWAHL/Feldnamen",
+                    PROC (TEXT VAR, INT CONST) aus sammel) .
+
+ergebnis in editor uebernehmen :
+  INT VAR stelle := 1;
+  WHILE wahl (stelle) > 0 REP
+    IF stelle > 1 THEN push (blank) END IF;
+    feldnamen lesen (wahl (stelle), feldpuffer);
+    push (""""); push (feldpuffer); push ("""");
+    stelle INCR 1
+  END REP .
+
+END PROC feldnamen anzeigen;
+
+END PACKET eudas steuerung;
+
diff --git a/app/eudas/4.4/src/eudas.uebersicht b/app/eudas/4.4/src/eudas.uebersicht
new file mode 100644
index 0000000..4029956
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.uebersicht
@@ -0,0 +1,420 @@
+PACKET uebersichtsanzeige
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Anzeige von EUDAS-Dateien als Übersicht                           *)
+(*                                                                       *)
+(*     Version 02                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 08.07.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  uebersicht,
+  uebersichtsfenster :
+
+
+ROW 24 INT VAR zeilensatz;
+
+ROW 24 INT VAR zeilenkombi;
+
+FENSTER VAR fenster;
+fenster initialisieren (fenster);
+
+INT VAR
+  laenge := 24,
+  breite := 79,
+  zeilen anf := 1,
+  spalten anf := 1,
+  freier rest,
+  feldversion := -1;
+
+BOOL VAR
+  bis zeilenende,
+  satznummer markieren;
+
+TEXT VAR
+  feldnummern;
+
+LET
+  niltext = "",
+  begin mark = ""15"",
+  end mark = ""14"",
+  blank = " ",
+  piep = ""7"",
+  cleol = ""5"";
+
+LET
+  t satznr =  #901#
+    ""15"Satznr. ",
+  t dateiende =  #902#
+    "  << DATEIENDE >>",
+  uebersicht status =  #903#
+"UEBERSICHT:   Rollen: HOP OBEN, HOP UNTEN   Beenden: ESC q   Hilfe: ESC ?";
+
+
+PROC uebersichtsfenster (INT CONST x anf, y anf, x laenge, y laenge) :
+
+  fenstergroesse setzen (fenster, x anf, y anf, x laenge, y laenge);
+  bis zeilenende := x anf + x laenge >= 80;
+  laenge := y laenge;
+  breite := x laenge;
+  zeilen anf := y anf;
+  spalten anf := x anf
+
+END PROC uebersichtsfenster;
+
+PROC uebersicht (TEXT CONST nummern, PROC hilfe) :
+
+  TEXT VAR eingabezeichen;
+  BOOL VAR dummy;
+  INT VAR
+    angezeigter satz := 1,
+    ausgegebene zeilen := 0,
+    eingabezustand := 1;
+
+  fensterzugriff (fenster, dummy);
+  status anzeigen (uebersicht status);
+  feldnummern bestimmen;
+  satznummer markieren := FALSE;
+  aktueller satz wird erster;
+  REP
+    kommando annehmen und zeile ausgeben;
+    alte markierung entfernen;
+    kommando interpretieren
+  END REP .
+
+feldnummern bestimmen :
+  IF nummern = niltext THEN
+    ggf alte auswahl uebernehmen
+  ELSE
+    feldnummern := nummern;
+    feldversion := dateiversion
+  END IF .
+
+ggf alte auswahl uebernehmen :
+  IF feldversion <> dateiversion THEN
+    alle felder anzeigen;
+    feldversion := dateiversion
+  END IF .
+
+alle felder anzeigen :
+  INT VAR i;
+  feldnummern := niltext;
+  FOR i FROM 1 UPTO anzahl felder REP
+    feldnummern CAT code (i)
+  END REP .
+
+kommando annehmen und zeile ausgeben :
+  WHILE ausgegebene zeilen < laenge REP
+    eingabezeichen := getcharety;
+    IF eingabezeichen <> "" THEN
+      LEAVE kommando annehmen und zeile ausgeben
+    END IF;
+    eine zeile ausgeben;
+    ausgegebene zeilen INCR 1
+  END REP;
+  aktuellen satz markieren und einnehmen;
+  getchar (eingabezeichen) .
+
+eine zeile ausgeben :
+  IF ausgegebene zeilen = 0 THEN
+    ueberschrift ausgeben
+  ELIF ausgegebene zeilen = 1 THEN
+    erste zeile ausgeben
+  ELSE
+    weitere zeile ausgeben
+  END IF .
+
+ueberschrift ausgeben :
+  cursor (spalten anf, zeilen anf);
+  out (t satznr);
+  freier rest := breite - 10;
+  INT VAR feldindex;
+  FOR feldindex FROM 1 UPTO length (feldnummern)
+  WHILE freier rest > 0 REP
+    feldnamen bearbeiten (code (feldnummern SUB feldindex),
+      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
+  END REP;
+  zeilenrest loeschen;
+  cursor (spalten anf + breite - 1, zeilen anf);
+  out (end mark) .
+
+erste zeile ausgeben :
+  auf uebersichtssatz (1);
+  satznummer in zeile (1);
+  satz als zeile ausgeben .
+
+weitere zeile ausgeben :
+  cursor (spalten anf, zeilen anf + ausgegebene zeilen);
+  IF dateiende THEN
+    zeilensatz (ausgegebene zeilen) := 0;
+    freier rest := breite;
+    zeilenrest loeschen
+  ELSE
+    naechsten satz einnehmen;
+    satznummer in zeile (ausgegebene zeilen);
+    satz als zeile ausgeben
+  END IF .
+
+naechsten satz einnehmen :
+  weiter (2);
+  auf abbruch testen;
+  zeilensatz (ausgegebene zeilen) := satznummer;
+  zeilenkombi (ausgegebene zeilen) := satzkombination .
+
+auf abbruch testen :
+  IF NOT (satz ausgewaehlt OR dateiende) THEN
+    LEAVE uebersicht
+  END IF .
+
+alte markierung entfernen :
+  IF angezeigter satz < ausgegebene zeilen THEN
+    satznummer in zeile (angezeigter satz)
+  END IF;
+  cursor (spalten anf, zeilen anf + angezeigter satz) .
+
+aktuellen satz markieren und einnehmen :
+  satznummer markieren := TRUE;
+  WHILE zeilensatz (angezeigter satz) = 0 REP
+    angezeigter satz DECR 1
+  END REP;
+  satznummer in zeile (angezeigter satz);
+  auf uebersichtssatz (angezeigter satz);
+  markierung ausgeben;
+  satznummer markieren := FALSE .
+
+kommando interpretieren :
+  SELECT eingabezustand OF
+  CASE 1 : normales kommando interpretieren
+  CASE 2 : hop kommando interpretieren
+  CASE 3 : esc kommando interpretieren
+  END SELECT .
+
+normales kommando interpretieren :
+  SELECT pos (""3""10""1""27"+-", eingabezeichen) OF
+  CASE 1 : zeile nach oben
+  CASE 2 : zeile nach unten
+  CASE 3 : eingabezustand := 2
+  CASE 4 : eingabezustand := 3
+  CASE 5 : markieren
+  CASE 6 : demarkieren
+  OTHERWISE out (piep)
+  END SELECT .
+
+hop kommando interpretieren :
+  SELECT pos (""3""10""13"", eingabezeichen) OF
+  CASE 1 : seite nach oben
+  CASE 2 : seite nach unten
+  CASE 3 : hop return
+  OTHERWISE out (piep)
+  END SELECT;
+  eingabezustand := 1 .
+
+esc kommando interpretieren :
+  SELECT pos ("19qh?", eingabezeichen) OF
+  CASE 1 : esc 1
+  CASE 2 : esc 9
+  CASE 3, 4 : esc q
+  CASE 5 : hilfestellung
+  OTHERWISE out (piep)
+  END SELECT;
+  eingabezustand := 1 .
+
+zeile nach oben :
+  IF angezeigter satz > 1 THEN
+    angezeigter satz DECR 1;
+  ELSE
+    nach oben rollen (1);
+    ausgegebene zeilen := 1
+  END IF .
+
+zeile nach unten :
+  IF NOT dateiende THEN
+    IF angezeigter satz < laenge - 1 THEN
+      angezeigter satz INCR 1
+    ELSE
+      zeilensatz (1) := zeilensatz (2);
+      zeilenkombi (1) := zeilenkombi (2);
+      ausgegebene zeilen := 1
+    END IF
+  END IF .
+
+markieren :
+  IF NOT satz markiert THEN
+    markierung aendern
+  END IF .
+
+demarkieren :
+  IF satz markiert THEN
+    markierung aendern
+  END IF .
+
+seite nach oben :
+  IF angezeigter satz > 1 THEN
+    angezeigter satz := 1
+  ELSE
+    nach oben rollen (laenge - 1);
+    ausgegebene zeilen := 1
+  END IF .
+
+seite nach unten :
+  IF angezeigter satz = laenge - 1 AND NOT dateiende THEN
+    weiter (2);
+    aktueller satz wird erster;
+    ausgegebene zeilen := 1
+  ELSE
+    angezeigter satz := laenge - 1
+  END IF .
+
+hop return :
+  IF angezeigter satz <> 1 THEN
+    zeilensatz (1) := zeilensatz (angezeigter satz);
+    zeilenkombi (1) := zeilenkombi (angezeigter satz);
+    angezeigter satz := 1;
+    ausgegebene zeilen := 1
+  END IF .
+
+esc 1 :
+  auf satz (1);
+  IF NOT satz ausgewaehlt THEN
+    weiter (2)
+  END IF;
+  aktueller satz wird erster;
+  angezeigter satz := 1;
+  ausgegebene zeilen := 1 .
+
+esc 9 :
+  auf satz (32767);
+  aktueller satz wird erster;
+  nach oben rollen (laenge - 2);
+  ausgegebene zeilen := 1 .
+
+esc q :
+  satznummer markieren := true;
+  satznummer in zeile (angezeigter satz);
+  LEAVE uebersicht .
+
+hilfestellung :
+  hilfe;
+  status anzeigen (uebersicht status);
+  ausgegebene zeilen := 0 .
+
+END PROC uebersicht;
+
+PROC nach oben rollen (INT CONST gerollt) :
+
+  INT VAR i;
+  auf uebersichtssatz (1);
+  FOR i FROM 1 UPTO gerollt
+  WHILE satznummer > 1 REP
+    zurueck (2)
+  END REP;
+  aktueller satz wird erster
+
+END PROC nach oben rollen;
+
+PROC auf uebersichtssatz (INT CONST zeile) :
+
+  auf satz (zeilensatz (zeile));
+  WHILE satzkombination <> zeilenkombi (zeile) REP
+    weiter (1)
+  END REP
+
+END PROC auf uebersichtssatz;
+
+PROC aktueller satz wird erster :
+
+  zeilensatz (1) := satznummer;
+  zeilenkombi (1) := satzkombination
+
+END PROC aktueller satz wird erster;
+
+BOOL PROC uebereinstimmung (INT CONST zeile) :
+
+  satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile)
+
+END PROC uebereinstimmung;
+
+PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) :
+
+  INT CONST laenge := min (freier rest, bis - von + 1);
+  outsubtext (satz, von, von + laenge - 1);
+  freier rest DECR laenge;
+  IF freier rest >= 2 THEN
+    out (", "); freier rest DECR 2
+  ELIF freier rest = 1 THEN
+    out (","); freier rest := 0
+  END IF
+
+END PROC feld bis rest;
+
+PROC satznummer in zeile (INT CONST zeile) :
+
+  cursor (spalten anf, zeilen anf + zeile);
+  IF satznummer markieren THEN
+    out (begin mark)
+  ELSE
+    out (blank)
+  END IF;
+  outtext (text (zeilensatz (zeile)), 1, 5);
+  IF satznummer markieren THEN
+    out (end mark)
+  ELSE
+    out (blank)
+  END IF;
+  freier rest := breite - 7
+
+END PROC satznummer in zeile;
+
+PROC zeilenrest loeschen :
+
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    freier rest TIMESOUT blank
+  END IF
+
+END PROC zeilenrest loeschen;
+
+PROC satz als zeile ausgeben :
+
+  IF satz ausgewaehlt THEN
+    markierung ausgeben;
+    felder ausgeben
+  ELIF dateiende THEN
+    out (t dateiende);
+    freier rest DECR 17
+  ELSE
+    markierung ausgeben;
+    out ("<< >>");
+    freier rest DECR 5
+  END IF;
+  zeilenrest loeschen .
+
+felder ausgeben :
+  INT VAR feldindex;
+  FOR feldindex FROM 1 UPTO length (feldnummern)
+  WHILE freier rest > 0 REP
+    feld bearbeiten (code (feldnummern SUB feldindex),
+      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
+  END REP .
+
+END PROC satz als zeile ausgeben;
+
+PROC markierung ausgeben :
+
+  IF satz markiert THEN
+    out ("+ ")
+  ELSE
+    out ("- ")
+  END IF;
+  freier rest DECR 2
+
+END PROC markierung ausgeben;
+
+END PACKET uebersichtsanzeige;
+
diff --git a/app/eudas/4.4/src/eudas.verarbeitung b/app/eudas/4.4/src/eudas.verarbeitung
new file mode 100644
index 0000000..95af7cc
--- /dev/null
+++ b/app/eudas/4.4/src/eudas.verarbeitung
@@ -0,0 +1,731 @@
+PACKET verarbeitung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Automatische Verarbeitung von EUDAS-Dateien                       *)
+(*                                                                       *)
+(*     Version 05                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 17.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  kopiere,
+  std kopiermuster,
+  verarbeite,
+  trage,
+  eindeutige felder,
+  pruefe,
+  wertemenge,
+  feldmaske,
+  trage satz,
+  hole satz,
+  K,
+  V,
+  f,
+  wert,
+  zahltext,
+  textdarstellung :
+
+
+SATZ VAR
+  zielfeldnamen,
+  kopierfeldnamen,
+  kopiersatz;
+
+INT VAR kopierindex;
+
+BOOL VAR erstes mal;
+
+LET
+  niltext = "",
+  INTVEC = TEXT;
+
+INTVEC VAR kopiervektor;
+
+TEXT VAR zwei bytes := "  ";
+
+
+OP CAT (INTVEC VAR intvec, INT CONST zahl) :
+
+  replace (zwei bytes, 1, zahl);
+  intvec CAT zwei bytes
+
+END OP CAT;
+
+PROC std kopiermuster (TEXT CONST dateiname, FILE VAR kopiermuster) :
+
+  teste ob datei vorhanden;
+  INT VAR zielfelder;
+  dateien oeffnen;
+  feldnamen bestimmen;
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO zielfelder REP
+    feldnamen auslesen;
+    IF feld vorhanden THEN
+      direkt kopieren
+    ELSE
+      leer kopieren
+    END IF
+  END REP .
+
+dateien oeffnen :
+  output (kopiermuster);
+  EUDAT VAR eudas datei;
+  IF exists (dateiname) THEN
+    oeffne (eudas datei, dateiname)
+  END IF .
+
+feldnamen bestimmen :
+  IF exists (dateiname) CAND felderzahl (eudas datei) > 0 THEN
+    feldnamen lesen (eudas datei, zielfeldnamen);
+    zielfelder := felderzahl (eudas datei)
+  ELSE
+    quellfeldnamen kopieren;
+    zielfelder := anzahl felder
+  END IF .
+
+quellfeldnamen kopieren :
+  TEXT VAR feldname;
+  satz initialisieren (zielfeldnamen);
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldname);
+    feld aendern (zielfeldnamen, feldnr, feldname)
+  END REP .
+
+feld vorhanden :
+  feldnummer (feldname) > 0 .
+
+feldnamen auslesen :
+  feld lesen (zielfeldnamen, feldnr, feldname);
+  put (kopiermuster, textdarstellung (feldname)) .
+
+direkt kopieren :
+  write (kopiermuster, "K f(");
+  write (kopiermuster, textdarstellung (feldname));
+  putline (kopiermuster, ");") .
+
+leer kopieren :
+  putline (kopiermuster, "K """";") .
+
+END PROC std kopiermuster;
+
+PROC kopiere (TEXT CONST dateiname, FILE VAR kopiermuster) :
+
+  programmfunktion (kopieraufruf, kopiermuster) .
+
+kopieraufruf :
+  "kopiere (" + textdarstellung (dateiname) + ", " .
+
+END PROC kopiere;
+
+PROC programmfunktion (TEXT CONST aufruf, FILE VAR muster) :
+
+  programmdatei einrichten;
+  write (programm, aufruf);
+  putline (programm, "PROC programmfunktion);");
+  putline (programm, "PROC programmfunktion:");
+  muster kopieren;
+  putline (programm, "END PROC programmfunktion");
+  programm ausfuehren;
+  forget (programm datei, quiet) .
+
+programmdatei einrichten :
+  TEXT VAR programmdatei;
+  INT VAR i := 0;
+  REP
+    i INCR 1;
+    programmdatei := text (i)
+  UNTIL NOT exists (programmdatei) END REP;
+  disable stop;
+  FILE VAR programm := sequential file (output, programm datei);
+  headline (programm, erzeugtes programm) .
+
+muster kopieren :
+  TEXT VAR zeile;
+  input (muster);
+  WHILE NOT eof (muster) REP
+    getline (muster, zeile);
+    putline (programm, zeile)
+  END REP .
+
+programm ausfuehren :
+  TEXT CONST alter last param := std;
+  run (programmdatei);
+  last param (alter last param) .
+
+END PROC programm funktion;
+
+PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+  IF dateiende THEN
+    auf satz (1);
+    LEAVE kopiere
+  ELSE
+    zieldatei einrichten
+  END IF;
+
+  WHILE NOT dateiende REP
+    satz initialisieren (kopiersatz);
+    kopierindex := 1;
+    kopierfunktion;
+    evtl feldnamen einrichten;
+    satz einfuegen (eudas datei, kopiersatz);
+    weiter (eudas datei);
+    weiter (modus)
+  END REP;
+  auf satz (1) .
+
+zieldatei einrichten :
+  erstes mal := TRUE;
+  EUDAT VAR eudas datei;
+  oeffne (eudas datei, dateiname);
+  auf satz (eudas datei, saetze (eudas datei) + 1);
+  feldnamen lesen (eudas datei, kopierfeldnamen);
+  kopiervektor := niltext .
+
+evtl feldnamen einrichten :
+  IF erstes mal THEN
+    feldnamen aendern (eudas datei, kopierfeldnamen);
+    erstes mal := FALSE
+  END IF
+
+END PROC kopiere;
+
+OP K (TEXT CONST feldname, ausdruck) :
+
+  IF erstes mal THEN
+    kopiervektor erstellen;
+  END IF;
+  feld aendern (kopiersatz, kopiervektor ISUB kopierindex, ausdruck);
+  kopierindex INCR 1 .
+
+kopiervektor erstellen :
+  INT VAR aktueller index := feldindex (kopierfeldnamen, feldname);
+  IF aktueller index = 0 THEN
+    aktueller index := felderzahl (kopierfeldnamen) + 1;
+    feld aendern (kopierfeldnamen, aktueller index, feldname);
+  END IF;
+  kopiervektor CAT aktueller index .
+
+END OP K;
+
+PROC verarbeite (FILE VAR verarbeitungsmuster) :
+
+  programmfunktion ("verarbeite (", verarbeitungsmuster)
+
+END PROC verarbeite;
+
+PROC verarbeite (PROC verarbeitungsfunktion) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+
+  WHILE NOT dateiende REP
+    verarbeitungsfunktion;
+    weiter (modus)
+  END REP;
+  auf satz (1)
+
+END PROC verarbeite;
+
+OP V (TEXT CONST feldname, ausdruck) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname)
+  ELSE
+    feld aendern (nr, ausdruck)
+  END IF
+
+END OP V;
+
+PROC auf ersten satz (INT VAR modus) :
+
+  teste ob datei vorhanden;
+  auf satz (1);
+  IF markierte saetze > 0 THEN
+    modus := 3;
+    IF NOT satz markiert THEN weiter (modus) END IF
+  ELSE
+    modus := 2;
+    IF NOT satz ausgewaehlt THEN weiter (modus) END IF
+  END IF
+
+END PROC auf ersten satz;
+
+PROC teste ob datei vorhanden :
+
+  IF anzahl dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF .
+
+END PROC teste ob datei vorhanden;
+
+
+(******************************** Zugriffe *******************************)
+
+TEXT VAR
+  feldpuffer,
+  werttext;
+
+LET quote = """";
+
+
+TEXT PROC f (TEXT CONST feldname) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname);
+    feldpuffer := niltext
+  ELSE
+    feld lesen (nr, feldpuffer)
+  END IF;
+  feldpuffer
+
+END PROC f;
+
+REAL PROC wert (TEXT CONST feldname) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname);
+    0.0
+  ELSE
+    feld lesen (nr, feldpuffer);
+    REAL VAR ergebnis;
+    wert berechnen (feldpuffer, ergebnis);
+    ergebnis
+  END IF
+
+END PROC wert;
+
+REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) :
+
+  round (wert (feldname), kommastellen)
+
+END PROC wert;
+
+TEXT PROC zahltext (REAL CONST feldwert, INT CONST kommastellen) :
+
+  REAL CONST w := round (abs (feldwert), kommastellen);
+  INT VAR stellen := exponent der zahl + kommastellen + 2;
+  IF feldwert < 0.0 THEN
+    werttext := "-"
+  ELSE
+    werttext := niltext
+  END IF;
+  IF w < 1.0 AND w <> 0.0 THEN
+    werttext CAT "0";
+    stellen DECR 1
+  ENDIF;
+  werttext CAT text (w, stellen, kommastellen);
+  IF kommastellen > 0 THEN
+    change (werttext, ".", dezimalkomma)
+  ELSE
+    change (werttext, ".", niltext)
+  END IF;
+  werttext .
+
+exponent der zahl :
+  max (0, decimal exponent (w)) .
+
+END PROC zahltext;
+
+TEXT PROC zahltext (TEXT CONST feldname, INT CONST kommastellen) :
+
+  zahltext (wert (feldname), kommastellen)
+
+END PROC zahltext;
+
+TEXT PROC textdarstellung (TEXT CONST anzeigetext) :
+
+  feldpuffer := anzeigetext;
+  change all (feldpuffer, quote, quote + quote);
+  steuerzeichen umwandeln;
+  insert char (feldpuffer, quote, 1);
+  feldpuffer CAT quote;
+  feldpuffer .
+
+steuerzeichen umwandeln :
+  INT VAR stelle := 1;
+  WHILE steuerzeichen vorhanden REP
+    change (feldpuffer, stelle, stelle, steuertext)
+  END REP .
+
+steuerzeichen vorhanden :
+  stelle := pos (feldpuffer, ""0"", ""31"", stelle);
+  stelle > 0 .
+
+steuertext :
+  quote + text (code (feldpuffer SUB stelle)) + quote .
+
+END PROC textdarstellung;
+
+PROC unbekannt (TEXT CONST feldname) :
+
+  errorstop (t das feld + textdarstellung (feldname) + 
+             nicht definiert)
+
+END PROC unbekannt;
+
+
+(****************************** Tragen ***********************************)
+
+SATZ VAR tragsatz;
+
+EUDAT VAR zieldatei;
+
+LET
+  erzeugtes programm =  #501#
+    "erzeugtes Programm",
+  keine datei geoeffnet =  #502#
+    "keine Datei geoeffnet",
+  kein satz vorhanden =  #503#
+    "Kein Satz zum Tragen vorhanden",
+  falsche felderzahl =  #504#
+    "Zieldatei hat falsche Felderzahl",
+  existiert nicht =  #505#
+    " existiert nicht",
+  verletzt die pruefbedingung =  #506#
+    " verletzt die Pruefbedingung.",
+  bereits vorhanden =  #507#
+    " ist in der Zieldatei bereits vorhanden.",
+  nicht definiert =  #508#
+    " ist nicht definiert.",
+  nicht in wertemenge =  #509#
+    " ist nicht in der Wertemenge.",
+  passt nicht zu maske =  #510#
+    " stimmt nicht mit der Maske ueberein.",
+  t satz =  #511#
+    "Satz ",
+  t das feld =  #512#
+    "Das Feld ";
+
+INT VAR
+  anzahl eindeutiger felder;
+
+FILE VAR protokoll;
+
+BOOL VAR
+  testen := FALSE,
+  test erfolgreich,
+  uebereinstimmung;
+
+TEXT VAR testprogramm;
+
+
+PROC trage (TEXT CONST dateiname, FILE VAR protokoll file, BOOL CONST test) :
+
+  disable stop;
+  testen := test;
+  IF testen THEN
+    protokoll := protokoll file;
+    output (protokoll)
+  END IF;
+  trage intern (dateiname);
+  testen := FALSE
+
+END PROC trage;
+
+PROC trage intern (TEXT CONST dateiname) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+  tragen vorbereiten (dateiname);
+
+  INT VAR satzzaehler := 0;
+  REP
+    IF NOT ausgewaehlt THEN
+      weiter (modus)
+    ELSE
+      cout (satznummer + satzzaehler)
+    END IF;
+    IF dateiende THEN auf satz (1); LEAVE trage intern END IF;
+    satz testen und tragen
+  END REP .
+
+ausgewaehlt :
+  IF modus = 3 THEN satz markiert ELSE satz ausgewaehlt END IF .
+
+satz testen und tragen :
+  test erfolgreich := TRUE;
+  IF testen THEN
+    notizen lesen (zieldatei, 1, testprogramm);
+    do (testprogramm)
+  END IF;
+  IF test erfolgreich THEN
+    trage einzelsatz;
+    IF test erfolgreich THEN
+      satz loeschen;
+      satzzaehler INCR 1
+    END IF
+  END IF;
+  IF NOT test erfolgreich THEN
+    weiter (modus)
+  END IF .
+
+END PROC trage intern;
+
+PROC tragen vorbereiten (TEXT CONST dateiname) :
+
+  IF dateiende THEN
+    errorstop (kein satz vorhanden)
+  END IF;
+  oeffne (zieldatei, dateiname);
+  anzahl eindeutiger felder := 0;
+  IF felderzahl (zieldatei) = 0 THEN
+    zieldatei einrichten
+  ELIF felderzahl (zieldatei) <> anzahl felder THEN
+    errorstop (falsche felderzahl)
+  END IF;
+  auf satz (zieldatei, saetze (zieldatei) + 1) .
+
+zieldatei einrichten :
+  satz initialisieren (tragsatz, anzahl felder);
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldpuffer);
+    feld aendern (tragsatz, feldnr, feldpuffer)
+  END REP;
+  feldnamen aendern (zieldatei, tragsatz) .
+
+END PROC tragen vorbereiten;
+
+PROC trage einzelsatz :
+
+  IF anzahl eindeutiger felder > 0 CAND schon vorhanden THEN
+    protokolliere  ("", bereits vorhanden)
+  ELSE
+    tragsatz aufbauen;
+    satz einfuegen (zieldatei, tragsatz);
+    weiter (zieldatei)
+  END IF .
+
+tragsatz aufbauen :
+  satz initialisieren (tragsatz, anzahl felder);
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feld lesen (feldnr, feldpuffer);
+    feld aendern (tragsatz, feldnr, feldpuffer)
+  END REP .
+
+schon vorhanden :
+  TEXT VAR muster;
+  INT CONST alte satznummer := satznr (zieldatei);
+  feld lesen (1, muster);
+  uebereinstimmung := FALSE;
+  auf satz (zieldatei, muster);
+  WHILE NOT dateiende (zieldatei) REP
+    teste auf uebereinstimmung;
+    weiter (zieldatei, muster)
+  UNTIL uebereinstimmung END REP;
+  auf satz (zieldatei, alte satznummer);
+  uebereinstimmung .
+
+teste auf uebereinstimmung :
+  INT VAR i;
+  uebereinstimmung := TRUE;
+  FOR i FROM 2 UPTO anzahl eindeutiger felder REP
+    feld lesen (zieldatei, i, feldpuffer);
+    feld bearbeiten (i,
+      PROC (TEXT CONST, INT CONST, INT CONST) felduebereinstimmung);
+    IF NOT uebereinstimmung THEN 
+      LEAVE teste auf uebereinstimmung
+    END IF
+  END REP .
+
+END PROC trage einzelsatz;
+
+PROC felduebereinstimmung (TEXT CONST satz, INT CONST von, bis) :
+
+  IF laengen ungleich COR
+       (length (feldpuffer) > 0 CAND text ungleich) THEN
+    uebereinstimmung := FALSE
+  END IF .
+
+laengen ungleich :
+  (bis - von + 1) <> length (feldpuffer) .
+
+text ungleich :
+  pos (satz, feldpuffer, von, bis + 1) <> von .
+
+END PROC felduebereinstimmung;
+
+PROC protokolliere (TEXT CONST feld, meldung) :
+
+  IF testen THEN
+    in protokoll
+  ELSE
+    errorstop (meldung)
+  END IF .
+
+in protokoll :
+  put (protokoll, t satz); put (protokoll, satznummer);
+  IF feld <> "" THEN
+    write (protokoll, t das feld);
+    write (protokoll, textdarstellung (feld))
+  END IF;
+  putline (protokoll, meldung);
+  test erfolgreich := FALSE .
+
+END PROC protokolliere;
+
+PROC eindeutige felder (INT CONST anzahl) :
+
+  anzahl eindeutiger felder := anzahl
+
+END PROC eindeutige felder;
+
+PROC pruefe (TEXT CONST feld, BOOL CONST bedingung) :
+
+  IF NOT bedingung THEN
+    protokolliere (feld, verletzt die pruefbedingung)
+  END IF
+
+END PROC pruefe;
+
+PROC wertemenge (TEXT CONST feld, menge) :
+
+  INT CONST nr := feldnummer (feld);
+  IF nr = 0 THEN
+    protokolliere (feld, nicht definiert)
+  ELSE
+    pruefe ob enthalten
+  END IF .
+
+pruefe ob enthalten :
+  INT VAR stelle := 0;
+  LET komma = ",";
+  feld lesen (nr, feldpuffer);
+  IF ist letztes element THEN
+    LEAVE pruefe ob enthalten
+  END IF;
+  feldpuffer CAT komma;
+  REP
+    stelle := pos (menge, feldpuffer, stelle + 1);
+    IF stelle = 1 OR
+       stelle > 1 CAND (menge SUB stelle - 1) = komma THEN
+         LEAVE pruefe ob enthalten
+    END IF
+  UNTIL stelle = 0 END REP;
+  protokolliere (feld, nicht in wertemenge) .
+
+ist letztes element :
+  INT CONST letzter anfang := length (menge) - length (feldpuffer);
+  (menge SUB letzter anfang) = komma AND
+    pos (menge, feldpuffer, letzter anfang + 1) > 0 .
+
+END PROC wertemenge;
+
+PROC feldmaske (TEXT CONST feld, maske) :
+
+  INT CONST nr := feldnummer (feld);
+  IF nr = 0 THEN
+    protokolliere (feld, nicht definiert)
+  ELSE
+    feld lesen (nr, feldpuffer);
+    mit maske vergleichen
+  END IF .
+
+mit maske vergleichen :
+  INT VAR stelle;
+  TEXT CONST ende := code (length (maske) + 1);
+  TEXT VAR moegliche positionen := ""1"";
+  FOR stelle FROM 1 UPTO length (feldpuffer) REP
+    TEXT CONST zeichen := feldpuffer SUB stelle;
+    zeichen vergleichen
+  UNTIL moegliche positionen = "" END REP;
+  IF nicht erfolgreich THEN
+    protokolliere (feld, passt nicht zu maske)
+  END IF .
+
+zeichen vergleichen :
+  INT VAR moeglich := 1;
+  WHILE moeglich <= length (moegliche positionen) REP
+    INT CONST position := code (moegliche positionen SUB moeglich);
+    IF (maske SUB position) = "*" THEN
+      stern behandeln
+    ELIF vergleich trifft zu THEN
+      replace (moegliche positionen, moeglich, code (position + 1));
+      moeglich INCR 1
+    ELSE
+      delete char (moegliche positionen, moeglich)
+    END IF
+  END REP .
+
+stern behandeln :
+  IF position = length (maske) THEN
+    LEAVE feldmaske
+  END IF;
+  moeglich INCR 1;
+  IF pos (moegliche positionen, code (position + 1)) = 0 THEN
+    insert char (moegliche positionen, code (position + 1), moeglich)
+  END IF .
+
+vergleich trifft zu :
+  SELECT pos ("9XAa", maske SUB position) OF
+  CASE 1 : pos ("0123456789", zeichen) > 0
+  CASE 2 : TRUE
+  CASE 3 : pos ("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", zeichen) > 0
+  CASE 4 : pos ("abcdefghijklmnopqrstuvwxyzäöüß", zeichen) > 0
+  OTHERWISE (maske SUB position) = zeichen
+  END SELECT .
+
+nicht erfolgreich :
+  (moegliche positionen = "" COR pos (moegliche positionen, ende) = 0)
+  AND nicht gerade stern am ende .
+
+nicht gerade stern am ende :
+  (maske SUB length (maske)) <> "*" OR 
+    pos (moegliche positionen, code (length (maske))) = 0 .
+
+END PROC feldmaske;
+
+PROC trage satz (TEXT CONST dateiname) :
+
+   tragen vorbereiten (dateiname);
+   INT CONST alter satz := satznr (zieldatei);
+   trage einzelsatz;
+   satz loeschen;
+   auf satz (zieldatei, alter satz)
+
+END PROC trage satz;
+
+PROC hole satz (TEXT CONST dateiname) :
+
+  teste ob datei vorhanden;
+  IF NOT exists (dateiname) THEN
+    errorstop (textdarstellung (dateiname) + existiert nicht)
+  END IF;
+  oeffne (zieldatei, dateiname);
+  IF felderzahl (zieldatei) <> anzahl felder THEN
+    errorstop (falsche felderzahl)
+  ELIF saetze (zieldatei) = 0 THEN
+    errorstop (kein satz vorhanden)
+  END IF;
+  auf satz (zieldatei, saetze (zieldatei));
+  satz lesen (zieldatei, tragsatz);
+  tragsatz einfuegen;
+  satz loeschen (zieldatei) .
+
+tragsatz einfuegen :
+  satz einfuegen;
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO felderzahl (tragsatz) REP
+    feld lesen (tragsatz, feldnr, feldpuffer);
+    feld aendern (feldnr, feldpuffer)
+  END REP .
+
+END PROC hole satz;
+
+END PACKET verarbeitung;
+
diff --git a/app/eudas/5.3/source-disk b/app/eudas/5.3/source-disk
new file mode 100644
index 0000000..64243e5
--- /dev/null
+++ b/app/eudas/5.3/source-disk
@@ -0,0 +1,2 @@
+eudas/eudas-5.3_1989-02-06.1.img
+eudas/eudas-5.3_1989-02-06.2.img
diff --git a/app/eudas/5.3/src/Adressen b/app/eudas/5.3/src/Adressen
new file mode 100644
index 0000000..74f0e3d
--- /dev/null
+++ b/app/eudas/5.3/src/Adressen
diff --git a/app/eudas/5.3/src/boxzeichen b/app/eudas/5.3/src/boxzeichen
new file mode 100644
index 0000000..12c3bb8
--- /dev/null
+++ b/app/eudas/5.3/src/boxzeichen
@@ -0,0 +1,3 @@
+box zeichen (""205""186""201""187""200""188""199""182""196"", 
+             ""15""14"", ""178" ")
+
diff --git a/app/eudas/5.3/src/dummy.text b/app/eudas/5.3/src/dummy.text
new file mode 100644
index 0000000..0eb03b0
--- /dev/null
+++ b/app/eudas/5.3/src/dummy.text
@@ -0,0 +1,14 @@
+PACKET dummy text DEFINES 
+  lineform, pageform, autoform, autopageform : 
+ 
+PROC lineform (TEXT CONST datei) :  fehler  END PROC lineform; 
+PROC pageform (TEXT CONST datei) :  fehler  END PROC pageform; 
+PROC autoform (TEXT CONST datei) :  fehler  END PROC autoform; 
+PROC autopageform (TEXT CONST datei) :  fehler  END PROC autopageform; 
+ 
+PROC fehler : 
+  errorstop ("Keine Textverarbeitung installiert")
+END PROC fehler; 
+ 
+END PACKET dummy text; 
+
diff --git a/app/eudas/5.3/src/eudas.1 b/app/eudas/5.3/src/eudas.1
new file mode 100644
index 0000000..9a6070c
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.1
@@ -0,0 +1,49 @@
+PACKETeudasdateienDEFINES EUDAT,oeffne,satznr,dateiende,saetze,aufsatz,weiter,zurueck,satzlesen,satzaendern,satzloeschen,satzeinfuegen,feldlesen,feldaendern,feldbearbeiten,felderzahl,feldnamenlesen,feldnamenaendern,notizenlesen,notizenaendern,feldinfo,automatischerschluessel,dezimalkomma,wertberechnen,reorganisiere,sortiere,sortierreihenfolge,unsortiertesaetze:LETb0=531,c0=121,d0=5000,e0=3243,f0=64,g0=48;LET INTVEC=TEXT,INDEX=STRUCT(INTh0,i0,INTj0,k0,INTVECl0),EINTRAG=STRUCT(INTh0,i0,m0,n0,SATZo0),DATEI=STRUCT(INTfelderzahl,SATZp0,INTVECfeldinfo,TEXTq0,INTr0,s0,t0,INTu0,v0,INTw0,satznr,INTx0,y0,z0,INTa1,b1,ROW3TEXTc1,ROWb0INTd1,ROWc0INDEXindex,ROWd0EINTRAGe1);TYPE EUDAT=BOUND DATEI;LETf1="";LETg1=
+#201#"Datei ist keine EUDAS-Datei",h1=
+#202#"inkonsistente EUDAS-Datei",i1=
+#203#"EUDAS-Datei voll",j1=
+#204#"Nicht erlaubtes Dezimalkomma";
+TEXT VARk1;TEXT VARl1:="  ";INTVEC CONSTm1:=n1(f0,1);LETo1="";TEXT VARp1;INTVEC PROCn1(INT CONSTlength,q1):replace(l1,1,q1);length*l1END PROCn1;PROCinsert(INTVEC VARr1,INT CONSTpos,q1):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(r1)+1THENt1ELSEreplace(l1,1,q1);p1:=subtext(r1,begin);r1:=subtext(r1,1,begin-1);r1CATl1;r1CATp1END IF END PROCinsert;PROCdelete(INTVEC VARr1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>=length(r1)THENt1ELSEp1:=subtext(r1,begin+2);r1:=subtext(r1,1,begin-1);r1CATp1END IF END PROCdelete;INT PROCpos(INTVEC CONSTr1,INT CONSTq1):replace(l1,1,q1);INT VARbegin:=1;REPbegin:=pos(r1,l1,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCu1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:=subtext(v1,begin);v1:=subtext(v1,1,begin-1)END IF END PROCu1;PROCx1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:=
+subtext(v1,1,begin-1);v1:=subtext(v1,begin)END IF END PROCx1;.t1:errorstop(9,f1).s1:errorstop(10,f1).PROCy1(DATEI VARz1):z1.felderzahl:=0;z1.feldinfo:=o1;satzinitialisieren(z1.p0);z1.q0:=f1;z1.r0:=1;z1.s0:=1;z1.u0:=0;z1.t0:=0;z1.w0:=0;z1.v0:=1;z1.a1:=0;z1.c1(1):=f1;z1.c1(2):=f1;z1.c1(3):=f1;z1.satznr:=1;z1.x0:=1;z1.y0:=1;z1.z0:=1;z1.index(1).l0:=m1;z1.index(1):=INDEX:(0,0,1,1,n1(1,1));INT VARa2;FORa2FROM1UPTOb0REPz1.d1(a2):=0END REP;z1.e1(1):=EINTRAG:(0,0,1,0,b2).b2:z1.p0.END PROCy1;PROCoeffne(EUDAT VARz1,TEXT CONSTc2):enablestop;IF NOTexists(c2)THEN CONCR(z1):=new(c2);y1(CONCR(z1));type(old(c2),e0)ELIFtype(old(c2))=e0THEN CONCR(z1):=old(c2)ELSEerrorstop(g1)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARz1,DATASPACE CONSTd2):IFtype(d2)<0THEN CONCR(z1):=d2;y1(CONCR(z1));type(d2,e0)ELIFtype(d2)=e0THEN CONCR(z1):=d2ELSEerrorstop(g1)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTz1,INT CONSTe2,TEXT VARf2):feldlesen(g2,e2,f2).g2:z1.e1(z1.z0).o0.END PROCfeldlesen;PROCfeldaendern(EUDAT VARz1,INT 
+CONSTe2,TEXT CONSTh2):IFi2THENj2(CONCR(z1));k2;feldaendern(g2,e2,h2)END IF.i2:z1.z0<>1.k2:IFe2=1THENdisablestop;l2(CONCR(z1),m2(h2))END IF.g2:z1.e1(z1.z0).o0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONSTz1):z1.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTz1,INT CONSTe2,PROC(TEXT CONST,INT CONST,INT CONST)n2):feldbearbeiten(g2,e2,PROC(TEXT CONST,INT CONST,INT CONST)n2).g2:z1.e1(z1.z0).o0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTz1,SATZ VARo2):o2:=z1.p0END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARz1,SATZ CONSTp2):z1.p0:=p2;INT CONSTq2:=felderzahl(p2);IFq2>z1.felderzahlTHENr2;z1.felderzahl:=q2END IF.r2:z1.feldinfoCATn1(s2,-1).s2:q2-length(z1.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTz1,INT CONSTe2):z1.feldinfoISUBe2END PROCfeldinfo;PROCfeldinfo(EUDAT VARz1,INT CONSTe2,t2):replace(z1.feldinfo,e2,t2);IFpos(z1.q0,code(e2))>0THENz1.a1:=z1.w0END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTz1):z1.satznrEND PROCsatznr;BOOL PROC
+dateiende(EUDAT CONSTz1):z1.satznr>z1.w0END PROCdateiende;INT PROCsaetze(EUDAT CONSTz1):z1.w0END PROCsaetze;PROCu2(DATEI VARz1,INT CONSTx0,k0,satznr):IFx0<1ORx0>z1.s0CORk0<1ORk0>z1.index(x0).j0THENerrorstop(h1)END IF;disablestop;z1.x0:=x0;z1.y0:=k0;z1.satznr:=satznr;z1.z0:=z1.index(x0).l0ISUBk0END PROCu2;PROCaufsatz(EUDAT VARz1,INT CONSTv2):INT VARsatznr;IFv2<1THENsatznr:=1ELIFv2>z1.w0THENsatznr:=z1.w0+1ELSEsatznr:=v2END IF;w2(CONCR(z1),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARz1,TEXT CONSTx2):aufsatz(z1,1);IFy2THENweiter(z1,x2)END IF.y2:feldlesen(z1,1,k1);k1<>x2.END PROCaufsatz;PROCw2(DATEI VARz1,INT CONSTsatznr):IFz2THENu2(z1,1,1,1)END IF;INT VARx0:=z1.x0,a3:=z1.satznr-z1.y0;IFsatznr>z1.satznrTHENb3ELSEc3END IF;u2(z1,x0,k0,satznr).z2:satznr+satznr<z1.satznr.b3:WHILEd3REPa3INCRj0;x0:=z1.index(x0).i0END REP.d3:INT CONSTj0:=z1.index(x0).j0;a3+j0<satznr.c3:WHILEe3REPx0:=z1.index(x0).h0;a3DECRz1.index(x0).j0END REP.e3:a3>=satznr.k0:satznr-a3.END PROCw2;PROCweiter(EUDAT VARz1):f3(CONCR(
+z1))END PROCweiter;PROCf3(DATEI VARz1):IFg3THENh3END IF.g3:z1.z0<>1.h3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=index.j0THENx0:=index.i0;k0:=1ELSEk0INCR1END IF;u2(z1,x0,k0,z1.satznr+1).index:z1.index(x0).END PROCf3;PROCzurueck(EUDAT VARz1):i3(CONCR(z1))END PROCzurueck;PROCi3(DATEI VARz1):IFj3THENk3END IF.j3:z1.satznr<>1.k3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=1THENx0:=m0.h0;k0:=m0.j0ELSEk0DECR1END IF;u2(z1,x0,k0,z1.satznr-1).m0:z1.index(x0).END PROCi3;PROCweiter(EUDAT VARz1,TEXT CONSTx2):f3(CONCR(z1),x2)END PROCweiter;PROCf3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPo3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,z1.w0+1)END IF.l3:INT VARdummy,k0:=z1.z0;IFn3THENq3(z1,m2(x2),k0,dummy)ELSEo3END IF.m3:k0<>0.n3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.o3:k0:=z1.e1(k0).i0.END PROCf3;PROCzurueck(EUDAT VARz1,TEXT CONSTx2):i3(CONCR(z1),x2)END PROCzurueck;PROCi3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPr3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,1)END IF.l3:INT VARk0:=z1.z0,dummy;IFk0=1ORs3THENq3(z1,m2(x2),dummy,k0)
+END IF.m3:k0<>0.n3:k0=z1.z0ORs3.s3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.r3:k0:=z1.e1(k0).h0.END PROCi3;PROCp3(DATEI VARz1,INT CONSTk0):INT CONSTt3:=z1.e1(k0).m0;INT VARy0:=1,satznr:=0;WHILEy0<>t3REPsatznrINCRz1.index(y0).j0;y0:=z1.index(y0).i0END REP;y0:=pos(z1.index(t3).l0,k0);satznrINCRy0;u2(z1,t3,y0,satznr).END PROCp3;INT VARindex;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):INT VARy3:=w3;index:=0;IFx3-w3<4THENz3ELSEa4END IF;index:=indexMODb0+1.z3:WHILEy3<=x3REPindex:=index*4;indexINCRcode(v3SUBy3);y3INCR1END REP.a4:WHILEy3<=x3REPindexINCRindex;indexINCRcode(v3SUBy3);IFindex>16000THENindex:=indexMODb0END IF;y3INCR1END REP.END PROCu3;INT PROCm2(TEXT CONSTv3):u3(v3,1,length(v3));indexEND PROCm2;INT PROCm2(SATZ CONSTo0):feldbearbeiten(o0,1,PROC(TEXT CONST,INT CONST,INT CONST)u3);indexEND PROCm2;PROCq3(DATEI CONSTz1,INT CONSTm2,INT VARk0,b4):INT VARx0:=z1.r0;b4:=z1.d1(m2);k0:=0;BOOL VARc4:=TRUE;WHILEc4ANDb4<>0REPd4;o3END REP.d4:IFe4THENf4ELSEg4END IF.e4:z1.e1(b4).m0=z1.x0.f4:x0:=z1.x0;INT 
+CONSTh4:=pos(l0,b4);IFh4=0THENerrorstop(h1)ELIFh4<=i4THENc4:=FALSE END IF.l0:z1.index(x0).l0.i4:z1.y0.g4:WHILEx0<>z1.e1(b4).m0REP IFx0=z1.x0THENc4:=FALSE;LEAVEd4ELSEx0:=z1.index(x0).h0END IF END REP.o3:IFc4THENk0:=b4;b4:=z1.e1(k0).h0END IF.END PROCq3;PROCj4(DATEI VARz1,INT CONSTm2):disablestop;INT CONSTk0:=z1.z0,h0:=z1.e1(k0).h0,i0:=z1.e1(k0).i0;IFi0<>0THENz1.e1(i0).h0:=h0ELSEz1.d1(m2):=h0END IF;IFh0<>0THENz1.e1(h0).i0:=i0END IF.END PROCj4;PROCk4(DATEI VARz1,INT CONSTm2,i0,h0):disablestop;INT CONSTk0:=z1.z0;z1.e1(k0).h0:=h0;z1.e1(k0).i0:=i0;IFh0<>0THENz1.e1(h0).i0:=k0END IF;IFi0<>0THENz1.e1(i0).h0:=k0ELSEz1.d1(m2):=k0END IF END PROCk4;PROCsatzlesen(EUDAT CONSTz1,SATZ VARo0):o0:=z1.e1(z1.z0).o0END PROCsatzlesen;PROCsatzaendern(EUDAT VARz1,SATZ CONSTl4):IF NOTdateiende(z1)THENm4END IF.m4:j2(CONCR(z1));disablestop;l2(CONCR(z1),m2(l4));g2:=l4.g2:z1.e1(z1.z0).o0.END PROCsatzaendern;PROCl2(DATEI VARz1,INT CONSTn4):IFo4THENp4END IF.o4:INT CONSTq4:=m2(g2);q4<>n4.p4:r4;s4.r4:j4(z1,q4).s4:INT 
+VARh0,i0;q3(z1,n4,h0,i0);k4(z1,n4,h0,i0).g2:z1.e1(z1.z0).o0.END PROCl2;PROCsatzloeschen(EUDAT VARz1):IF NOTdateiende(z1)THENt4END IF.t4:disablestop;u4(CONCR(z1));v4(CONCR(z1));z1.w0DECR1.END PROCsatzloeschen;PROCu4(DATEI VARz1):w4(z1);INT CONSTk0:=z1.z0;j4(z1,m2(g2));z1.e1(k0).i0:=z1.u0;z1.u0:=k0.g2:z1.e1(k0).o0.END PROCu4;PROCsatzeinfuegen(EUDAT VARz1,SATZ CONSTl4):x4(CONCR(z1),l4)END PROCsatzeinfuegen;PROCx4(DATEI VARz1,SATZ CONSTl4):INT VARk0,h0,i0;enablestop;y4;z4;disablestop;z1.w0INCR1;a5(z1,k0);INT CONSTb5:=m2(k1);q3(z1,b5,i0,h0);k4(z1,b5,i0,h0);j2(z1).y4:IFz1.u0<>0THENk0:=z1.u0;z1.u0:=z1.e1(k0).i0ELIFz1.v0=d0THENerrorstop(i1)ELSEz1.v0INCR1;k0:=z1.v0END IF;z1.e1(k0).n0:=0;z1.e1(k0).o0:=l4.z4:feldlesen(l4,1,k1);IFz1.b1>0THEN IFk1=""THENc5;feldaendern(z1.e1(k0).o0,1,k1)END IF END IF.c5:k1:=text(z1.b1);k1:=d5+k1;IFz1.b1>32000THENz1.b1:=1ELSEz1.b1INCR1END IF.d5:(4-length(k1))*"0".END PROCx4;PROCautomatischerschluessel(EUDAT VARe5,BOOL CONSTf5):IFf5ANDe5.b1<0OR NOTf5ANDe5.b1>0THENe5.
+b1:=-e5.b1END IF END PROCautomatischerschluessel;BOOL PROCautomatischerschluessel(EUDAT CONSTe5):e5.b1>0END PROCautomatischerschluessel;INTVEC VARg5;PROCv4(DATEI VARz1):INT CONSTx0:=z1.x0,h0:=index.h0,i0:=index.i0;BOOL VARh5;delete(index.l0,z1.y0);index.j0DECR1;i5(z1,x0,i0,h5);IF NOTh5THENi5(z1,h0,x0,h5)END IF;j5(z1).index:z1.index(x0).END PROCv4;PROCi5(DATEI VARz1,INT CONSTy3,k5,BOOL VARh5):h5:=FALSE;IFy3<>0ANDk5<>0THENl5END IF.l5:INT CONSTm5:=index.j0,n5:=o5.j0;IFp5THENq5;h5:=TRUE END IF.p5:m5+n5<=g0ORm5=0ORn5=0.q5:index.j0INCRo5.j0;r5(z1,o5.l0,y3);index.l0CATo5.l0;s5.s5:index.i0:=o5.i0;IFindex.i0<>0THENz1.index(index.i0).h0:=y3ELSEz1.r0:=y3END IF;o5.i0:=z1.t0;z1.t0:=k5.index:z1.index(y3).o5:z1.index(k5).END PROCi5;PROCj5(DATEI VARz1):INT CONSTg2:=z1.satznr;u2(z1,1,1,1);w2(z1,g2)END PROCj5;PROCr5(DATEI VARz1,INTVEC CONSTl0,INT CONSTy3):INT VARa2;FORa2FROM1UPTOlength(l0)DIV2REPz1.e1(l0ISUBa2).m0:=y3END REP END PROCr5;PROCa5(DATEI VARz1,INT CONSTt5):INT VARx0:=z1.x0;IFindex.j0>=f0THEN
+u5END IF;index.j0INCR1;insert(index.l0,z1.y0,t5);z1.z0:=t5;z1.e1(t5).m0:=x0.u5:INT VARb5:=0;v5;IFb5<>0THENw5ELSEx5(z1)END IF;j5(z1);x0:=z1.x0.v5:IFz1.t0<>0THENb5:=z1.t0;z1.t0:=o5.i0ELIFz1.s0<c0THENz1.s0INCR1;b5:=z1.s0;o5.l0:=m1END IF.w5:y5;z5;o5.j0:=index.j0-a6;u1(index.l0,o5.l0,a6+1);index.j0:=a6;r5(z1,o5.l0,b5).y5:INT CONSTb6:=index.i0;IFb6<>0THENz1.index(b6).h0:=b5ELSEz1.r0:=b5END IF;o5.i0:=b6;o5.h0:=x0;index.i0:=b5.z5:INT VARa6;IFc6THENa6:=g0ELSEa6:=index.j0DIV2+1END IF.c6:b6=0.index:z1.index(x0).o5:z1.index(b5).END PROCa5;PROCx5(DATEI VARz1):INT VARx0:=1;REPd6;e6END REP.d6:BOOL VARh5;REP INT CONSTi0:=index.i0;i5(z1,x0,i0,h5)UNTIL NOTh5END REP;IFi0=0THEN LEAVEx5ELIFf6THENg6END IF.f6:INT CONSTh6:=g0-index.j0;h6>0.g6:x1(o5.l0,g5,h6+1);o5.j0DECRh6;r5(z1,g5,x0);index.l0CATg5;index.j0:=g0.e6:x0:=i0.index:z1.index(x0).o5:z1.index(i0).END PROCx5;TEXT VARi6:=",";LETj6=1;TEXT PROCdezimalkomma:i6END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTk6):IFlength(k6)<>1THENerrorstop(j1)ELSEi6:=k6
+ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTz1):z1.a1END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTz1):z1.q0END PROCsortierreihenfolge;PROCj2(DATEI VARz1):IFl6(z1)THENdisablestop;z1.e1(z1.z0).n0INCRj6;z1.a1INCR1END IF END PROCj2;PROCw4(DATEI VARz1):IF NOTl6(z1)THENdisablestop;z1.e1(z1.z0).n0DECRj6;z1.a1DECR1END IF END PROCw4;BOOL PROCl6(DATEI CONSTz1,INT CONSTk0):(z1.e1(k0).n0ANDj6)=0END PROCl6;BOOL PROCl6(DATEI CONSTz1):l6(z1,z1.z0)END PROCl6;INTVEC VARm6;TEXT VARq0;TEXT VARn6,o6;PROCsortiere(EUDAT VARz1):q0:=z1.q0;IFq0=f1THENp6END IF;q6(CONCR(z1)).p6:INT VARa2;FORa2FROM1UPTOz1.felderzahlREPq0CATcode(a2)END REP.END PROCsortiere;PROCsortiere(EUDAT VARz1,TEXT CONSTr6):q0:=r6;q6(CONCR(z1))END PROCsortiere;PROCq6(DATEI VARz1):IFz1.q0<>q0THENz1.q0:=q0;z1.a1:=z1.w0+1ELIFz1.a1=0THEN LEAVEq6END IF;m6:=z1.feldinfo;IFs6THENt6(z1);z1.a1:=0ELSEu6(z1)END IF;w2(z1,1).s6:z1.w0DIVz1.a1<3.END PROCq6;PROCt6(DATEI VARz1):INT VARz0,o0:=1,v6;w2(z1,1);w4(z1);z0:=z1.z0
+;WHILEw6REPx6;y6;cout(o0)END REP;disablestop;x5(z1);u2(z1,1,1,1).w6:o0<z1.w0.x6:o0INCR1;w2(z1,o0);v6:=z0;z0:=z1.z0.y6:IFz6THENa7(z1,o0,z0);z0:=v6ELSEw4(z1)END IF.z6:z1.e1(v6).o0GROESSERz1.e1(z0).o0.END PROCt6;PROCu6(DATEI VARz1):INT VARa2;FORa2FROM1UPTOz1.v0REP IF NOTl6(z1,a2)THENa7(z1,z1.w0+1,a2);cout(a2)END IF END REP END PROCu6;PROCa7(DATEI VARz1,INT CONSTsatznr,z0):b7;c7.b7:INT VARd7:=1,e7:=satznr-1,f7;WHILEg7REPh7;i7END REP.g7:d7<=e7.h7:f7:=(d7+e7)DIV2;INT VARj7;w2(z1,f7);IF NOTl6(z1)THENk7END IF;j7:=z1.z0.k7:WHILEz1.satznr<e7REPf3(z1);IFl7THEN LEAVEk7END IF END REP;WHILEz1.satznr>d7REPi3(z1);IFl7THEN LEAVEk7END IF END REP;LEAVEb7.l7:l6(z1).i7:IFm7GROESSERz1.e1(z0).o0THENe7:=f7-1ELSEd7:=f7+1END IF.m7:z1.e1(j7).o0.c7:p3(z1,z0);IFz1.satznr<d7THENd7DECR1END IF;disablestop;w4(z1);n7;v4(z1);w2(z1,d7);a5(z1,z0);o7.n7:INT CONSTp7:=m2(g2);j4(z1,p7).o7:INT VARh0,i0;q3(z1,p7,h0,i0);k4(z1,p7,h0,i0).g2:z1.e1(z0).o0.END PROCa7;BOOL OP GROESSER(SATZ CONSTq7,r7):s7;t7;SELECTm6ISUBu7OF CASE0:v7
+CASE1:w7CASE2:x7OTHERWISEy7END SELECT.s7:INT VARz7:=1;WHILEz7<length(q0)REP INT CONSTu7:=code(q0SUBz7);feldlesen(q7,u7,n6);feldlesen(r7,u7,o6);SELECTm6ISUBu7OF CASE0:a8CASE1:b8OTHERWISEc8END SELECT;z7INCR2END REP;LEAVE GROESSER WITH FALSE.t7:BOOL VARd8;IF(q0SUB(z7+1))="-"THENd8:=FALSE ELSEd8:=TRUE END IF.b8:REAL VARe8,f8;wertberechnen(n6,e8);wertberechnen(o6,f8);IFe8<>f8THEN LEAVEs7END IF.a8:IF NOT(n6LEXEQUALo6)THEN LEAVEs7END IF.c8:IFn6<>o6THEN LEAVEs7END IF.w7:IFd8THENe8>f8ELSEe8<f8END IF.v7:IFd8THENn6LEXGREATERo6ELSEo6LEXGREATERn6END IF.x7:g8(n6);g8(o6);IFd8THENn6>o6ELSEn6<o6END IF.y7:IFd8THENn6>o6ELSEn6<o6END IF.END OP GROESSER;PROCwertberechnen(TEXT CONSTh8,REAL VARwert):LETi8="0123456789";TEXT VARj8:=i6,text;INT VARk0;INT CONSTk8:=length(h8);l8;WHILEk0<=k8REPm8;k0INCR1END REP;wert:=real(text).l8:k0:=pos(h8,"0","9",1);IFk0=0THENwert:=0.0;LEAVEwertberechnenELIFpos(h8,"-",1,k0)>0THENtext:="-"ELSEtext:=f1END IF;.m8:TEXT CONSTn8:=h8SUBk0;IFpos(i8,n8)>0THENtextCATn8ELIFn8=j8THENtextCAT
+".";j8:=f1END IF.END PROCwertberechnen;PROCg8(TEXT VARo8):IFlength(o8)<>8THENo8:=f1ELSEo8:=subtext(o8,7)+subtext(o8,4,5)+subtext(o8,1,2)END IF END PROCg8;PROCreorganisiere(TEXT CONSTc2):EUDAT VARp8,q8;oeffne(p8,c2);disablestop;DATASPACE VARd2:=nilspace;oeffne(q8,d2);r8(CONCR(p8),q8);IF NOTiserrorTHENforget(c2,quiet);copy(d2,c2)END IF;forget(d2)END PROCreorganisiere;PROCr8(DATEI VARp8,EUDAT VARq8):enablestop;s8;t8(p8,CONCR(q8)).s8:w2(p8,1);aufsatz(q8,1);WHILE NOTdateiendeREPsatzeinfuegen(q8,u8);cout(p8.satznr);f3(p8);weiter(q8)END REP.dateiende:p8.satznr>p8.w0.u8:p8.e1(p8.z0).o0.END PROCr8;PROCt8(DATEI VARp8,q8):q8.felderzahl:=p8.felderzahl;q8.p0:=p8.p0;q8.feldinfo:=p8.feldinfo;q8.q0:=p8.q0;q8.c1(1):=p8.c1(1);q8.c1(2):=p8.c1(2);q8.c1(3):=p8.c1(3)END PROCt8;PROCnotizenlesen(EUDAT CONSTz1,INT CONSTv2,TEXT VARv8):v8:=z1.c1(v2)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARz1,INT CONSTv2,TEXT CONSTv8):z1.c1(v2):=v8END PROCnotizenaendern;END PACKETeudasdateien;
+PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,aufkoppeldatei,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,folgedatei,herkunft,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,notizenlesen,notizenaendern,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingunglesen,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZb0,INTVECc0,INTd0,INTe0,INTf0,TASKg0,DATASPACEh0,EUDATi0,SATZj0,BOOLk0,BOOLl0,m0,n0,TEXTo0,INTVECp0,INTq0),VERWEIS=STRUCT(INTr0,s0);LETt0="",u0="";LETmaxint=32767,v0=10,w0=256,x0=32;ROWv0DATEI VARy0;INT VARz0:=0,a1:=0,b1,c1:=0,d1,e1:=0,f1,g1,h1,i1:=0;BOOL VARj1:=TRUE,k1,l1;TEXT VARm1;ROWw0VERWEIS VARn1;ROWx0VERWEIS VARo1;INT VARp1;LETq1=
+#301#"Zuviel Dateien geoeffnet",r1=
+#302#"Datei existiert nicht",s1=
+#303#"Nicht moeglich, wenn auf Koppeldatei geschaltet",t1=
+#304#"Zu viele Felder",u1=
+#305#"Zu viele Koppelfelder",v1=
+#306#"keine Koppelfelder vorhanden",w1=
+#307#"kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",x1=
+#308#"keine Datei geoeffnet",y1=
+#309#"Datei nicht gesichert",z1=
+#310#"Suchmuster zu umfangreich";
+TEXT VARa2;TEXT VARb2:="  ";INTVEC VARc2;OP CAT(INTVEC VARtext,INT CONSTwert):replace(b2,1,wert);textCATb2END OP CAT;PROCinsert(INTVEC VARd2,INT CONSTe2,wert):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+1);d2:=subtext(d2,1,f2);d2CATwert;d2CATc2END PROCinsert;PROCdelete(INTVEC VARd2,INT CONSTe2):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+3);d2:=subtext(d2,1,f2);d2CATc2END PROCdelete;PROCg2(INTVEC VARd2,INT CONSTh2,i2):INT VARj2;FORj2FROMh2UPTOlength(d2)DIV2-1REPreplace(d2,j2,(d2ISUBj2)+i2)END REP END PROCg2;EUDAT VARk2;SATZ VARl2;PROCm2(TEXT CONSTn2):IFz0=v0THENerrorstop(q1)END IF;IF NOTexists(n2)THENerrorstop(r1)END IF;IFo2THENerrorstop(s1)END IF;oeffne(k2,n2)END PROCm2;PROCp2(DATEI VARr0,TEXT CONSTn2,TASK CONSTq2):IFk1OR NOTisniltask(q2)THENr0.h0:=old(n2);oeffne(r0.i0,r0.h0);IF NOTk1THENforget(n2,quiet)END IF ELSEoeffne(r0.i0,n2)END IF;r0.g0:=q2;r0.e0:=0;r0.l0:=FALSE;r0.m0:=FALSE;r0.name:=n2;r2(r0)END PROCp2;PROCs2(INT CONSTt2):INT VARu2:=t2;WHILEy0(u2).e0<>0REPu2:=y0(u2).e0END REP;y0(u2).e0:=
+z0END PROCs2;PROCv2:IFdateiende(y0(1).i0)THENaufsatz(1)ELSEaufsatz(satznr(y0(1).i0))END IF END PROCv2;PROCw2:d1:=felderzahl(y0(1).i0);e1:=d1;feldnamenlesen(y0(1).i0,y0(1).b0);p1:=0;INT VARj2;FORj2FROM1UPTOe1REPn1(j2).r0:=0END REP END PROCw2;PROCx2:i1INCR1;IFi1>32000THENi1:=-32000END IF END PROCx2;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2):oeffne(n2,y2,niltask)END PROCoeffne;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2,TASK CONSTq2):enablestop;dateienloeschen(FALSE);suchbedingungloeschen;m2(n2);k1:=y2;z2;p2(y0(z0),n2,q2);v2;w2.z2:z0:=1;x2;h1:=0.END PROCoeffne;PROCkopple(TEXT CONSTn2):kopple(n2,niltask)END PROCkopple;PROCkopple(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);a3;b3;c3;p2(y0(z0),n2,q2);d3.a3:feldnamenlesen(k2,l2);INT VARc0:=0;INTVEC VARe3:=u0;WHILEc0<felderzahl(k2)REPfeldlesen(l2,c0+1,a2);INT CONSTindex:=feldindex(y0(1).b0,a2);IFindex>0THENc0INCR1;e3CATindexEND IF UNTILindex=0END REP.b3:IFe1+felderzahl(k2)-c0>w0THENerrorstop(t1)ELIFp1+c0>x0THENerrorstop(u1)
+ELIFc0=0THENerrorstop(v1)END IF;z0INCR1;y0(z0).b0:=l2;y0(z0).c0:=e3;y0(z0).d0:=c0;INT VARf3:=c0;WHILEf3<felderzahl(k2)REPe1INCR1;f3INCR1;n1(e1).r0:=z0;n1(e1).s0:=f3END REP;FORf3FROM1UPTOc0REPg3END REP.g3:INT CONSTh3:=e3ISUBf3;IFn1(h3).r0=0THENi3ELSEj3END IF.i3:p1INCR1;o1(p1).r0:=z0;o1(p1).s0:=f3;n1(h3).r0:=p1;n1(h3).s0:=1.j3:INT CONSTk3:=n1(h3).r0+n1(h3).s0;l3;n1(h3).s0INCR1;o1(k3).r0:=z0;o1(k3).s0:=f3.l3:INT VARm3;FORm3FROMp1DOWNTOk3REPo1(m3+1):=o1(m3)END REP;p1INCR1;FORm3FROM1UPTOd1REP IFn1(m3).r0>=k3THENn1(m3).r0INCR1END IF END REP.c3:a1INCR1;IFc1=0THENc1:=z0ELSEs2(c1)END IF.d3:x2;y0(z0).k0:=FALSE;y0(z0).n0:=FALSE;y0(z0).f0:=satznr(k2);n3(y0(z0)).END PROCkopple;PROCkette(TEXT CONSTn2):kette(n2,niltask)END PROCkette;PROCkette(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);z0INCR1;p2(y0(z0),n2,q2);s2(1);IFj1THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)o3):IFz0>1ORo2THENerrorstop(w1)ELSEaenderungeneintragen;o3(y0(1).i0);x2;v2;w2;y0(
+1).m0:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTp3,TEXT CONSTn2):aenderungeneintragen;notizenaendern(y0(p3).i0,2,date);IFk1THENforget(n2,quiet);copy(y0(p3).h0,n2)END IF;y0(p3).m0:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTq3):aenderungeneintragen;IFo2THENaufkoppeldatei(0)END IF;r3;s3.r3:a1:=0;c1:=0;y0(1).e0:=0;e1:=0;j1:=TRUE.s3:WHILEz0>0REP IFt3AND NOTq3THENerrorstop(y1);LEAVEdateienloeschenEND IF;forget(y0(z0).h0);z0DECR1END REP.t3:k1ANDy0(z0).m0.END PROCdateienloeschen;INT VARu3,v3,w3,x3,y3,z3,a4,b4;BOOL VARc4;INTVEC VARd4;SATZ VARe4;BOOL VARo2:=FALSE;INT VARf4:=0,g4:=1;BOOL PROCaufkoppeldatei:o2END PROCaufkoppeldatei;PROCaufkoppeldatei(INT CONSTh4):disablestop;x2;IFo2THENi4;o2:=FALSE;j4;k4ELSEl4;o2:=TRUE;m4END IF.i4:b1:=u3;d1:=v3;e1:=w3;f1:=x3;h1:=z3;c1:=a4;y0(g4).e0:=b4;n4:=f4;l1:=c4;o4:=d4;p4:=e4;IFn4>0THENq4:=1ELSEq4:=-1END IF.k4:f4:=0;g4:=1;enablestop;aufsatz(satznummer);WHILEg1<>y3REPweiter(1)END REP.j4:y0(g4).f0:=satznr(y0(g4).i0);IFh4=1AND NOTdateiende(y0(b1)
+.i0)THENr4END IF.r4:INT VARs4;FORs4FROM1UPTOy0(g4).d0REPfeldaendern(y0(b1).i0,t4,u4)END REP;y3:=1.t4:y0(g4).c0ISUBs4.u4:feldlesen(y0(g4).i0,s4,a2);a2.l4:u3:=b1;v3:=d1;w3:=e1;x3:=f1;y3:=g1;z3:=h1;a4:=c1;b4:=y0(h4).e0;c4:=l1;d4:=o4;e4:=p4.m4:b1:=h4;f4:=n4;g4:=h4;d1:=felderzahl(y0(h4).i0);e1:=d1;f1:=0;h1:=(length(y0(h4).p0)-1)DIV2;c1:=0;y0(h4).e0:=0;suchbedingungloeschen;aufsatz(y0(h4).f0).END PROCaufkoppeldatei;INT PROCanzahlkoppeldateien:a1END PROCanzahlkoppeldateien;INT PROCanzahldateien:z0END PROCanzahldateien;BOOL PROCaendernerlaubt:k1END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTv4):aenderungeneintragen;y0(v4).m0END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTv4):y0(v4).nameEND PROCeudasdateiname;INT PROCfolgedatei(INT CONSTv4):IFv4=0THENc1ELSEy0(v4).e0END IF END PROCfolgedatei;TASK PROCherkunft(INT CONSTv4):y0(v4).g0END PROCherkunft;INT PROCdateiversion:i1END PROCdateiversion;INT PROCanzahlfelder:e1END PROCanzahlfelder;PROCfeldnamenlesen(INT CONSTf3,TEXT VAR
+name):IFf3<=d1THENfeldlesen(y0(g4).b0,f3,name)ELSEfeldlesen(w4,x4,name)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(g4).b0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(w4,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTz4):INT VARa5:=d1,h4:=feldindex(y0(g4).b0,z4),u2:=c1;WHILEh4=0ANDu2<>0REPh4:=feldindex(y0(u2).b0,z4);b5;u2:=y0(u2).e0END REP;h4.b5:INT CONSTc5:=y0(u2).d0;IFh4=0THENa5INCRfelderzahl(y0(u2).i0);a5DECRc5ELSEh4INCRa5;h4DECRc5END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTf3):IFf3<=d1THENfeldinfo(y0(g4).i0,f3)ELSEfeldinfo(y0(w4).i0,x4)END IF.w4:n1(f3).r0.x4:n1(f3).s0.END PROCfeldinfo;PROCnotizenlesen(INT CONSTh4,TEXT VARd5):notizenlesen(y0(g4).i0,h4,d5)END PROCnotizenlesen;PROCnotizenaendern(INT CONSTh4,TEXT CONSTd5):notizenaendern(y0(g4).i0,h4
+,d5);y0(g4).m0:=TRUE END PROCnotizenaendern;PROCfeldlesen(INT CONSTf3,TEXT VARd5):IFf3<=d1THENfeldlesen(y0(b1).i0,f3,d5)ELSEe5END IF.e5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldlesen(y0(w4).j0,x4,d5)ELSEfeldlesen(y0(w4).i0,x4,d5)END IF.x4:n1(f3).s0.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(b1).i0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEf5END IF.f5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldbearbeiten(y0(w4).j0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(y0(w4).i0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.x4:n1(f3).s0.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTf3,TEXT CONSTd5):INT CONSTw4:=n1(f3).r0;IFf3<=d1THENg5ELSEh5END IF.g5:y0(b1).m0:=TRUE;IFi5CANDj5THENk5END IF;feldaendern(y0(b1).i0,f3,d5).i5:NOTo2CANDw4>0.j5:feldlesen(y0(b1).i0,f3,a2);a2<>d5.k5:INT VARl5:=x4,m5:=w4;REPn5(y0(o5));y0(o5).n0:=TRUE;feldaendern(y0(o5).j0,h3,d5);m5INCR1;l5DECR1UNTILl5=0END REP.h5:n5(y0(w4));
+IFp5THENy0(w4).l0:=TRUE;feldaendern(y0(w4).j0,x4,d5)END IF.p5:feldlesen(y0(w4).j0,x4,a2);a2<>d5.x4:n1(f3).s0.o5:o1(m5).r0.h3:o1(m5).s0.END PROCfeldaendern;PROCn5(DATEI VARr0):IF NOTr0.k0THENr0.k0:=TRUE;q5END IF.q5:IFdateiende(r0.i0)THENsatzinitialisieren(r0.j0,r0.d0);r5ELSEsatzlesen(r0.i0,r0.j0)END IF.r5:INT VARj2;FORj2FROM1UPTOr0.d0REPfeldlesen(r0.c0ISUBj2,a2);feldaendern(r0.j0,j2,a2)END REP.END PROCn5;PROCn3(DATEI VARr0):s5;t5.s5:feldlesen(y0(b1).i0,u5,o0).u5:r0.c0ISUB1.o0:r0.o0.t5:aufsatz(r0.i0,o0);WHILE NOTv5(r0)REPweiter(r0.i0,o0)END REP;IFdateiende(r0.i0)THENn5(r0)ELSEr0.k0:=FALSE END IF.END PROCn3;PROCw5:INT VARu2:=c1;WHILEu2<>0REPn3(y0(u2));u2:=y0(u2).e0END REP;g1:=1END PROCw5;BOOL PROCv5(DATEI CONSTr0):IF NOTdateiende(r0.i0)THENx5END IF;TRUE.x5:INT VARy5;FORy5FROM2UPTOr0.d0REPfeldlesen(y0(b1).i0,c0ISUBy5,a2);feldbearbeiten(r0.i0,y5,PROC(TEXT CONST,INT CONST,INT CONST)z5);IF NOTa6THEN LEAVEv5WITH FALSE END IF END REP.c0:r0.c0.END PROCv5;BOOL VARa6;PROCz5(TEXT CONSTb6,INT CONST
+t2,c6):a6:=length(a2)+t2=c6+1CANDpos(b6,a2,t2,c6+1)=t2END PROCz5;LETd6=22101,e6="h",f6=""27"";BOOL VARg6;PROCh6:TEXT VARi6;g6:=FALSE;REPi6:=incharety;type(i6)UNTILi6=t0END REP END PROCh6;PROCj6:IFg6THENtype(f6)END IF END PROCj6;BOOL PROCk6:TEXT VARi6;REPi6:=incharety;IFi6=t0THEN LEAVEk6WITH FALSE ELSEl6END IF END REP;FALSE.l6:IFg6THENg6:=FALSE;m6ELSEn6END IF.m6:IFi6=e6THENo6;errorstop(d6,t0);LEAVEk6WITH TRUE ELSEtype(f6);type(i6)END IF.n6:IFi6=f6THENg6:=TRUE ELSEtype(i6)END IF.o6:REP UNTILgetcharety=t0END REP.END PROCk6;PROCweiter(INT CONSTp6):IF NOTj1THENaenderungeneintragen;q6END IF.q6:SELECTp6OF CASE1:r6CASE2:s6CASE3:t6END SELECT.r6:u6(FALSE).s6:h6;REPu6(l1);cout(satznummer)UNTILsatzausgewaehltORj1ORk6END REP;j6.t6:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDe0<>0REPx6;v6:=1END REP;aufsatz(y0(b1).i0,y6);cout(satznummer);w5;j1:=dateiende(y0(b1).i0);z6.w6:a7(y0(b1),v6+1);INT CONSTy6:=y0(b1).p0ISUBy0(b1).q0;y6=maxint.e0:y0(b1).e0.END PROCweiter;PROCzurueck(INT CONSTp6):IFsatznummer>1THEN
+aenderungeneintragen;b7END IF.b7:SELECTp6OF CASE1:c7CASE2:d7CASE3:e7END SELECT.c7:f7(FALSE).d7:h6;REPf7(l1);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORk6END REP;j6.e7:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDb1<>1REPg7;v6:=maxint-1END REP;aufsatz(y0(b1).i0,h7);cout(satznummer);w5;j1:=FALSE;z6.w6:INT VARh7;a7(y0(b1),v6);IFy0(b1).q0=1THENh7:=1;TRUE ELSEh7:=y0(b1).p0ISUB(y0(b1).q0-1);FALSE END IF.END PROCzurueck;PROCu6(BOOL CONSTi7):j7;IFk7THENr6;w5ELSEg1INCR1END IF;z6.j7:INT VARu2:=c1;WHILEu2>0REPl7;u2:=y0(u2).e0END REP.l7:BOOL VARm7;n7(y0(u2),m7);IFm7THEN LEAVEj7END IF.k7:u2=0.r6:IFi7THENweiter(y0(b1).i0,m1)ELSEweiter(y0(b1).i0)END IF;WHILEdateiende(y0(b1).i0)REPo7UNTILj1END REP.o7:IFy0(b1).e0<>0THENx6;p7ELSEj1:=TRUE END IF.p7:aufsatz(y0(b1).i0,1).END PROCu6;PROCn7(DATEI VARr0,BOOL VARm7):IFdateiende(r0.i0)THENm7:=FALSE ELSEq7END IF.q7:m7:=TRUE;REPweiter(r0.i0,r0.o0);IFdateiende(r0.i0)THENm7:=FALSE;aufsatz(r0.i0,r0.o0)END IF UNTILv5(r0)END REP.END PROCn7;PROCf7(BOOL CONSTi7):
+WHILEsatznr(y0(b1).i0)=1CANDsatznummer>1REPg7;r7(y0(b1).i0)END REP;IFi7THENzurueck(y0(b1).i0,m1)ELSEzurueck(y0(b1).i0)END IF;j1:=FALSE;w5;z6END PROCf7;PROCx6:f1INCRsaetze(y0(b1).i0);b1:=y0(b1).e0END PROCx6;PROCg7:INT VARs7:=1;WHILEy0(s7).e0<>b1REPs7:=y0(s7).e0END REP;f1DECRsaetze(y0(s7).i0);b1:=s7END PROCg7;PROCaenderungeneintragen:INT VARu2:=c1;WHILEu2<>0REPt7;u2:=y0(u2).e0END REP.t7:IFy0(u2).k0THENu7(y0(u2))END IF.END PROCaenderungeneintragen;PROCu7(DATEI VARr0):IFv7AND NOTw7THENx7ELIFy7ANDz7THENa8ELIFw7THENn3(r0)END IF;b8;l0:=FALSE;w7:=FALSE.v7:NOTdateiende(r0.i0)ANDl0.y7:felderzahl(j0)>r0.d0.z7:w7ORl0.a8:m0:=TRUE;feldlesen(j0,1,r0.o0);satzeinfuegen(r0.i0,j0).b8:r0.k0:=FALSE.x7:m0:=TRUE;satzaendern(r0.i0,j0).l0:r0.l0.w7:r0.n0.j0:r0.j0.m0:r0.m0.END PROCu7;PROCr7(EUDAT VARi0):aufsatz(i0,saetze(i0)+1)END PROCr7;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;b1:=g4;f1:=0;WHILEc8ANDd8REPx6END REP;aufsatz(y0(b1).i0,satznr-f1);w5;j1:=dateiende(y0(b1).i0);z6.c8:satznr-f1>saetze(y0(b1).i0
+).d8:y0(b1).e0<>0.END PROCaufsatz;PROCaufsatz(TEXT CONSTe8):aenderungeneintragen;f8(e8,j1);w5;z6END PROCaufsatz;PROCf8(TEXT CONSTe8,BOOL CONSTg8):IFg8THENaufsatz(1)END IF;REPaufsatz(y0(b1).i0,e8);IF NOTdateiende(y0(b1).i0)THENj1:=FALSE;LEAVEf8ELIFy0(b1).e0=0THENj1:=TRUE;IF NOTg8THENf8(e8,TRUE)END IF;LEAVEf8END IF;x6END REP END PROCf8;INT PROCsatznummer:f1+satznr(y0(b1).i0)END PROCsatznummer;INT PROCsatzkombination:g1END PROCsatzkombination;BOOL PROCdateiende:j1END PROCdateiende;SATZ VARh8;satzinitialisieren(h8);PROCsatzeinfuegen:aenderungeneintragen;i8;satzeinfuegen(y0(b1).i0,h8);y0(b1).m0:=TRUE;j8;j1:=FALSE;z6.i8:a7(y0(b1),satznr(y0(b1).i0));g2(y0(b1).p0,y0(b1).q0,1).j8:g1:=1;INT VARu2:=c1;WHILEu2<>0REPr7(y0(u2).i0);u2:=y0(u2).e0END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTj1THENaenderungeneintragen;k8;satzloeschen(y0(b1).i0);y0(b1).m0:=TRUE;aufsatz(satznummer)END IF.k8:IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1END IF;g2(y0(b1).p0,y0(b1).q0,-1).END PROCsatzloeschen;
+LETl8=100;ROWl8STRUCT(INTs0,m8,n8,o8,TEXTo0)VARp8;SATZ VARp4;INT VARn4,q4,q8:=1;BOOL VARr8,s8;suchbedingungloeschen;INT VARt8;LETu8=1,v8=2,w8=3,x8=4,y8=5,z8=6,a9=7,b9=8,c9=9;PROCz6:IFj1THENs8:=FALSE ELSEd9;s8:=e9END IF.d9:t8:=q4;WHILEt8>0REPf9;feldbearbeiten(g9,PROC(TEXT CONST,INT CONST,INT CONST)h9)END REP.f9:INT VARi9:=p8(t8).m8;IFi9>=256THENj9;k9END IF.j9:feldlesen((i9AND255)+1,a2).k9:IFl9=2THENm9END IF;p8(t8).o0:=a2.g9:p8(t8).s0.e9:t8<0.END PROCz6;PROCh9(TEXT CONSTb6,INT CONSTn9,o9):INT VARi9:=p8(t8).m8;IFi9>=256THENi9:=i9DIV256END IF;IFp9THENt8:=p8(t8).n8ELSEt8:=p8(t8).o8END IF.p9:SELECTi9OF CASEu8:q9CASEv8:r9CASEw8:s9CASEx8:t9CASEy8:u9CASEz8:v9CASEa9:w9CASEb9:x9CASEc9:y9OTHERWISE FALSE END SELECT.q9:SELECTl9OF CASE0:z9;a2LEXEQUALo0CASE1:z9;a10=b10OTHERWISElength(o0)=o9-n9+1ANDc10END SELECT.c10:n9>o9CORr9.r9:pos(b6,o0,n9,o9)=n9.s9:pos(b6,o0,o9+1-length(o0),o9)>0.t9:pos(b6,o0,n9,o9)>0.u9:z9;SELECTl9OF CASE0:o0LEXGREATERa2CASE1:a10<b10CASE2:m9;a2<o0OTHERWISEa2<o0END SELECT.v9:z9;
+SELECTl9OF CASE0:a2LEXGREATEREQUALo0CASE1:a10>=b10CASE2:m9;a2>=o0OTHERWISEa2>=o0END SELECT.w9:n9<=o9.x9:satzmarkiert.y9:TRUE.z9:a2:=subtext(b6,n9,o9).END PROCh9;TEXT PROCo0:p8(t8).o0END PROCo0;PROCm9:IFlength(a2)=8THEN TEXT CONSTd10:=subtext(a2,7,8);replace(a2,7,subtext(a2,1,2));replace(a2,1,d10)ELSEa2:=t0END IF END PROCm9;INT PROCl9:feldinfo(p8(t8).s0)END PROCl9;REAL PROCa10:REAL VARe10;wertberechnen(a2,e10);e10END PROCa10;REAL PROCb10:REAL VARe10;wertberechnen(o0,e10);e10END PROCb10;LETf10=";",g10=",",h10="..",i10="++",j10="--",k10="*";BOOL VARl10,m10,n10;INT VARo10,p10,q10,r10,s10;INTVEC VARo4;PROCsuchbedingung(INT CONSTf3,TEXT CONSTp8):INT VARt2:=1,t10:=0;INT CONSTu10:=length(p8)+1;p10:=0;s10:=f3;o10:=n4+1;WHILEt2<u10REPv10;w10;t2:=c6+2END REP;feldaendern(p4,f3,p8).v10:INT VARx10:=pos(p8,g10,t2);IFx10=0THENx10:=u10END IF;IFt10<t2THENy10END IF;INT CONSTc6:=min(x10,t10)-1.y10:p10INCR1;l10:=TRUE;IFp10>1THENl1:=FALSE END IF;t10:=pos(p8,f10,t2);IFt10=0THENt10:=u10END IF.w10:z10;m10:=
+TRUE;INT CONSTa11:=pos(p8,h10,t2,c6+1);IFb11THENc11(t0,c9,-p10)ELIFa11=0THENd11ELSEe11END IF.z10:IFsubtext(p8,t2,t2+1)=j10THENt2INCR2;n10:=TRUE ELSEn10:=FALSE END IF.b11:t2>c6.d11:IFf11THENg11ELSEh11END IF.f11:t2+1=c6CANDsubtext(p8,t2,c6)=i10.g11:c11(t0,b9,-p10).h11:INT VARi11:=pos(p8,k10,t2,c6+1);IFi11=0THENj11ELIFt2=c6THENk11ELSEl11;REPm11END REP END IF.j11:IFn11THENl1:=TRUE;m1:=p8END IF;c11(subtext(p8,t2,c6),u8,-p10).n11:f3=1ANDt2=1ANDc6=u10-1ANDo11AND NOTo2AND(p8SUB1)<>"&".o11:length(o4)<=2.k11:c11(t0,a9,-p10).l11:INT VARm8;IFi11=t2THENm8:=u8ELSEm8:=v8END IF.m11:IFm8<>u8THENp11END IF;t2:=i11+1;i11:=pos(p8,k10,t2,c6+1);IFi11=0THENi11:=c6+1;m8:=w8ELSEm8:=x8END IF.p11:TEXT CONSTo0:=subtext(p8,t2,i11-1);IFn10ORq11THEN IFn10THENm10:=TRUE END IF;c11(o0,m8,-p10);IFq11THEN LEAVEh11END IF ELSEc11(o0,m8,n4+2)END IF.q11:i11>=c6.e11:TEXT CONSTr11:=subtext(p8,t2,a11-1),s11:=subtext(p8,a11+2,c6);IFa11=t2THENc11(s11,y8,-p10)ELIFa11=c6-1THENc11(r11,z8,-p10)ELSEt11END IF.t11:IFn10THENc11(r11,z8,-
+p10);m10:=TRUE ELSEc11(r11,z8,n4+2)END IF;c11(s11,y8,-p10).END PROCsuchbedingung;PROCc11(TEXT CONSTu11,INT CONSTm8,n8):v11;w11;IFl10THENx11;y11;r10:=n4ELIFm10THENz11END IF;a12;b12.v11:r8:=FALSE;IFn4=f4THENq8INCR1;IFq8>32000THENq8:=1END IF END IF.w11:IFn4=l8THENsuchbedingungloeschen;errorstop(z1)ELSEn4INCR1;q4:=f4+1END IF.x11:IFp10>length(o4)DIV2THENo4CATn4;c12(q4,0,n4)END IF;IFp10=length(o4)DIV2THENq10:=0ELSEq10:=o4ISUB(p10+1)END IF.y11:c12(q4,-p10,n4);l10:=FALSE;m10:=FALSE.z11:c12(r10,q10,n4);r10:=n4;m10:=FALSE.a12:p8(n4).m8:=m8;p8(n4).s0:=s10;IFn10THENp8(n4).n8:=q10;p8(n4).o8:=n8ELSEp8(n4).n8:=n8;p8(n4).o8:=q10END IF.b12:IFd12THENe12ELSEf12END IF.d12:(u11SUB1)="&"CANDg12.g12:INT CONSTh12:=feldnummer(subtext(u11,2));h12>0.e12:p8(n4).m8:=h12-1+256*m8.f12:INT CONSTi12:=feldinfo(s10);IFi12=2AND(m8=y8ORm8=z8)THENa2:=u11;m9;p8(n4).o0:=a2ELSEp8(n4).o0:=u11END IF.END PROCc11;PROCc12(INT CONSTn9,wert,j12):INT VARj2;FORj2FROMn9UPTOn4-1REP IFp8(j2).n8=wertTHENp8(j2).n8:=j12ELIFp8(j2).o8=wert
+THENp8(j2).o8:=j12END IF END REP END PROCc12;PROCsuchbedingunglesen(INT CONSTf3,TEXT VARp8):feldlesen(p4,f3,p8)END PROCsuchbedingunglesen;PROCsuchbedingungloeschen:disablestop;IFo2THENn4:=f4ELSEf4:=0;n4:=0END IF;q4:=-1;o4:=u0;satzinitialisieren(p4);l1:=FALSE;r8:=TRUE;s8:=NOTj1END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTr8THENz6;r8:=TRUE END IF;s8END PROCsatzausgewaehlt;INT PROCsuchversion:IFn4=f4THEN0ELSEq8END IF END PROCsuchversion;PROCa7(DATEI VARr0,INT CONSTb6):IF(r0.p0ISUBr0.q0)<b6THENk12ELSEl12END IF.k12:REPr0.q0INCR1UNTIL(r0.p0ISUBr0.q0)>=b6END REP.l12:WHILEr0.q0>1CAND(r0.p0ISUB(r0.q0-1))>=b6REPr0.q0DECR1END REP.END PROCa7;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1ELSEinsert(y0(b1).p0,y0(b1).q0,satznr(y0(b1).i0));h1INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTb6:=satznr(y0(b1).i0);a7(y0(b1),b6);b6=(y0(b1).p0ISUBy0(b1).q0)END PROCsatzmarkiert;INT PROCmarkiertesaetze:h1END PROCmarkiertesaetze;PROC
+markierungenloeschen:disablestop;IFo2THENr2(y0(b1))ELSEm12END IF;h1:=0.m12:INT VARu2:=1;REPr2(y0(u2));u2:=y0(u2).e0UNTILu2=0END REP.END PROCmarkierungenloeschen;PROCr2(DATEI VARr0):r0.p0:=t0;r0.p0CATmaxint;r0.q0:=1END PROCr2;END PACKETdatenverwaltung;
+
diff --git a/app/eudas/5.3/src/eudas.2 b/app/eudas/5.3/src/eudas.2
new file mode 100644
index 0000000..50fc707
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.2
@@ -0,0 +1,73 @@
+PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARb0,c0,d0;INT VARe0;BOOL VARf0;LETg0="",INTVEC=TEXT;INTVEC VARh0;TEXT VARi0:="  ";OP CAT(INTVEC VARj0,INT CONSTk0):replace(i0,1,k0);j0CATi0END OP CAT;PROCstdkopiermuster(TEXT CONSTl0,FILE VARm0):n0;INT VARo0;p0;q0;INT VARr0;FORr0FROM1UPTOo0REPs0;IFt0THENu0ELSEv0END IF END REP.p0:output(m0);EUDAT VARw0;IFexists(l0)THENoeffne(w0,l0)END IF.q0:IFexists(l0)CANDfelderzahl(w0)>0THENfeldnamenlesen(w0,b0);o0:=felderzahl(w0)ELSEx0;o0:=anzahlfelderEND IF.x0:TEXT VARy0;satzinitialisieren(b0);FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,y0);feldaendern(b0,r0,y0)END REP.t0:feldnummer(y0)>0.s0:feldlesen(b0,r0,y0);put(m0,textdarstellung(y0)).u0:write(m0,"K f(");write(m0,textdarstellung(y0));putline(m0,");").v0:putline(m0,"K """";").END PROCstdkopiermuster;PROCkopiere(TEXT CONSTl0,FILE VARm0):z0(a1,m0).a1:"kopiere ("+
+textdarstellung(l0)+", ".END PROCkopiere;PROCz0(TEXT CONSTb1,FILE VARc1):d1;write(e1,b1);putline(e1,"PROC programmfunktion);");putline(e1,"PROC programmfunktion:");f1;putline(e1,"END PROC programmfunktion");g1;forget(h1,quiet).d1:TEXT VARh1;INT VARi1:=0;REPi1INCR1;h1:=text(i1)UNTIL NOTexists(h1)END REP;disablestop;FILE VARe1:=sequentialfile(output,h1);headline(e1,j1).f1:TEXT VARk1;input(c1);WHILE NOTeof(c1)REPgetline(c1,k1);putline(e1,k1)END REP.g1:TEXT CONSTl1:=std;run(h1);lastparam(l1).END PROCz0;PROCkopiere(TEXT CONSTl0,PROCm1):enablestop;INT VARn1;o1(n1);IFdateiendeTHENaufsatz(1);LEAVEkopiereELSEp1END IF;WHILE NOTdateiendeREPsatzinitialisieren(d0);e0:=1;m1;q1;satzeinfuegen(w0,d0);weiter(w0);weiter(n1)END REP;aufsatz(1).p1:f0:=TRUE;EUDAT VARw0;oeffne(w0,l0);aufsatz(w0,saetze(w0)+1);feldnamenlesen(w0,c0);h0:=g0.q1:IFf0THENfeldnamenaendern(w0,c0);f0:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTy0,r1):IFf0THENs1;END IF;feldaendern(d0,h0ISUBe0,r1);e0INCR1.s1:INT VARt1:=feldindex(c0,y0);
+IFt1=0THENt1:=felderzahl(c0)+1;feldaendern(c0,t1,y0);END IF;h0CATt1.END OP K;PROCverarbeite(FILE VARu1):z0("verarbeite (",u1)END PROCverarbeite;PROCverarbeite(PROCv1):enablestop;INT VARn1;o1(n1);WHILE NOTdateiendeREPv1;weiter(n1)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTy0,r1):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0)ELSEfeldaendern(w1,r1)END IF END OP V;PROCo1(INT VARn1):n0;aufsatz(1);IFmarkiertesaetze>0THENn1:=3;IF NOTsatzmarkiertTHENweiter(n1)END IF ELSEn1:=2;IF NOTsatzausgewaehltTHENweiter(n1)END IF END IF END PROCo1;PROCn0:IFanzahldateien=0THENerrorstop(y1)END IF.END PROCn0;TEXT VARz1,a2;LETb2="""";TEXT PROCf(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);z1:=g0ELSEfeldlesen(w1,z1)END IF;z1END PROCf;REAL PROCwert(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);0.0ELSEfeldlesen(w1,z1);REAL VARc2;wertberechnen(z1,c2);c2END IF END PROCwert;REAL PROCwert(TEXT CONSTy0,INT CONSTd2):round(wert(y0),d2)END PROCwert;TEXT PROCzahltext(REAL CONSTe2,INT 
+CONSTd2):REAL CONSTf2:=round(abs(e2),d2);INT VARg2:=h2+d2+2;IFe2<0.0THENa2:="-"ELSEa2:=g0END IF;IFf2<1.0ANDf2<>0.0THENa2CAT"0";g2DECR1ENDIF;a2CATtext(f2,g2,d2);IFd2>0THENchange(a2,".",dezimalkomma)ELSEchange(a2,".",g0)END IF;a2.h2:max(0,decimalexponent(f2)).END PROCzahltext;TEXT PROCzahltext(TEXT CONSTy0,INT CONSTd2):zahltext(wert(y0),d2)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTi2):z1:=i2;changeall(z1,b2,b2+b2);j2;insertchar(z1,b2,1);z1CATb2;z1.j2:INT VARk2:=1;WHILEl2REPchange(z1,k2,k2,m2)END REP.l2:k2:=pos(z1,""0"",""31"",k2);k2>0.m2:b2+text(code(z1SUBk2))+b2.END PROCtextdarstellung;PROCx1(TEXT CONSTy0):errorstop(n2+textdarstellung(y0)+o2)END PROCx1;SATZ VARp2;EUDAT VARq2;LETj1=
+#501#"erzeugtes Programm",y1=
+#502#"keine Datei geoeffnet",r2=
+#503#"Kein Satz zum Tragen vorhanden",s2=
+#504#"Zieldatei hat falsche Felderzahl",t2=
+#505#" existiert nicht",u2=
+#506#" verletzt die Pruefbedingung.",v2=
+#507#" ist in der Zieldatei bereits vorhanden.",o2=
+#508#" ist nicht definiert.",w2=
+#509#" ist nicht in der Wertemenge.",x2=
+#510#" stimmt nicht mit der Maske ueberein.",y2=
+#511#"Satz ",n2=
+#512#"Das Feld ";
+INT VARz2;FILE VARa3;BOOL VARb3:=FALSE,c3,d3;TEXT VARe3;PROCtrage(TEXT CONSTl0,FILE VARf3,BOOL CONSTg3):disablestop;b3:=g3;IFb3THENa3:=f3;output(a3)END IF;h3(l0);b3:=FALSE END PROCtrage;PROCh3(TEXT CONSTl0):enablestop;INT VARn1;o1(n1);i3(l0);INT VARj3:=0;REP IF NOTk3THENweiter(n1)ELSEcout(satznummer+j3)END IF;IFdateiendeTHENaufsatz(1);LEAVEh3END IF;l3END REP.k3:IFn1=3THENsatzmarkiertELSEsatzausgewaehltEND IF.l3:c3:=TRUE;IFb3THENnotizenlesen(q2,1,e3);do(e3)END IF;IFc3THENm3;IFc3THENsatzloeschen;j3INCR1END IF END IF;IF NOTc3THENweiter(n1)END IF.END PROCh3;PROCi3(TEXT CONSTl0):IFdateiendeTHENerrorstop(r2)END IF;oeffne(q2,l0);z2:=0;IFfelderzahl(q2)=0THENp1ELIFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)END IF;aufsatz(q2,saetze(q2)+1).p1:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,z1);feldaendern(p2,r0,z1)END REP;feldnamenaendern(q2,p2);n3;o3.n3:FORr0FROM1UPTOanzahlfelderREPfeldinfo(q2,r0,feldinfo(r0))END REP.o3:INT VARi1;FORi1FROM1UPTO3REP
+notizenlesen(i1,z1);notizenaendern(q2,i1,z1)END REP.END PROCi3;PROCm3:IFz2>0CANDp3THENq3("",v2)ELSEr3;satzeinfuegen(q2,p2);weiter(q2)END IF.r3:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldlesen(r0,z1);feldaendern(p2,r0,z1)END REP.p3:TEXT VARc1;INT CONSTs3:=satznr(q2);feldlesen(1,c1);d3:=FALSE;aufsatz(q2,c1);WHILE NOTdateiende(q2)REPt3;weiter(q2,c1)UNTILd3END REP;aufsatz(q2,s3);d3.t3:INT VARi1;d3:=TRUE;FORi1FROM2UPTOz2REPfeldlesen(q2,i1,z1);feldbearbeiten(i1,PROC(TEXT CONST,INT CONST,INT CONST)u3);IF NOTd3THEN LEAVEt3END IF END REP.END PROCm3;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):IFy3COR(length(z1)>0CANDz3)THENd3:=FALSE END IF.y3:(x3-w3+1)<>length(z1).z3:pos(v3,z1,w3,x3+1)<>w3.END PROCu3;PROCq3(TEXT CONSTa4,b4):IFb3THENc4ELSEerrorstop(b4)END IF.c4:put(a3,y2);put(a3,satznummer);IFa4<>""THENwrite(a3,n2);write(a3,textdarstellung(a4))END IF;putline(a3,b4);c3:=FALSE.END PROCq3;PROCeindeutigefelder(INT CONSTd4):z2:=d4END PROCeindeutigefelder;PROCpruefe(TEXT 
+CONSTa4,BOOL CONSTe4):IF NOTe4THENq3(a4,u2)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTa4,f4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEg4END IF.g4:INT VARk2:=0;LETh4=",";feldlesen(w1,z1);IFi4THEN LEAVEg4END IF;z1CATh4;REPk2:=pos(f4,z1,k2+1);IFk2=1ORk2>1CAND(f4SUBk2-1)=h4THEN LEAVEg4END IF UNTILk2=0END REP;q3(a4,w2).i4:INT CONSTj4:=length(f4)-length(z1);(f4SUBj4)=h4ANDpos(f4,z1,j4+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTa4,k4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEfeldlesen(w1,z1);l4END IF.l4:INT VARk2;TEXT CONSTm4:=code(length(k4)+1);TEXT VARn4:=""1"";FORk2FROM1UPTOlength(z1)REP TEXT CONSTo4:=z1SUBk2;p4UNTILn4=""END REP;IFq4THENq3(a4,x2)END IF.p4:INT VARr4:=1;WHILEr4<=length(n4)REP INT CONSTs4:=code(n4SUBr4);IF(k4SUBs4)="*"THENt4ELIFu4THENreplace(n4,r4,code(s4+1));r4INCR1ELSEdeletechar(n4,r4)END IF END REP.t4:IFs4=length(k4)THEN LEAVEfeldmaskeEND IF;r4INCR1;IFpos(n4,code(s4+1))=0THENinsertchar(n4,code(s4+1),r4)END IF.u4:SELECTpos("9XAa",k4SUBs4)OF CASE
+1:pos("0123456789",o4)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",o4)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",o4)>0OTHERWISE(k4SUBs4)=o4END SELECT.q4:(n4=""CORpos(n4,m4)=0)ANDv4.v4:(k4SUBlength(k4))<>"*"ORpos(n4,code(length(k4)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTl0):i3(l0);INT CONSTw4:=satznr(q2);m3;satzloeschen;aufsatz(q2,w4)END PROCtragesatz;PROCholesatz(TEXT CONSTl0):n0;IF NOTexists(l0)THENerrorstop(textdarstellung(l0)+t2)END IF;oeffne(q2,l0);IFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)ELIFsaetze(q2)=0THENerrorstop(r2)END IF;aufsatz(q2,saetze(q2));satzlesen(q2,p2);x4;satzloeschen(q2).x4:satzeinfuegen;INT VARr0;FORr0FROM1UPTOfelderzahl(p2)REPfeldlesen(p2,r0,z1);feldaendern(r0,z1)END REP.END PROCholesatz;END PACKETverarbeitung;
+PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,druckrichtung,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0="#",m0="  ";TEXT VARn0;PROCinterpretiere(INT CONSTo0,p0,PROC(INT CONST,TEXT VAR)q0):INT VARr0,s0:=0,t0:=0,u0:=p0;v0(o0);WHILE NOTw0REPx0;IFy0THENs0INCR1ELSEz0;a1END IF END REP.a1:IFb1(r0)THENc1ELSEd1;t0:=0END IF.c1:SELECTr0OF CASEe1:f1CASEg1:h1OTHERWISE LEAVEinterpretiereEND SELECT.z0:WHILEs0>0REPi1(k0);s0DECR1END REP.f1:j1(i0).h1:j1(t0).y0:k1=j0ORk1=k0.d1:INT VARl1:=0,m1:=0;BOOL VARn1:=FALSE;REPo1;l1INCR1;IFi0=3THENn1:=TRUE END IF UNTILp1END REP.p1:IFi0<=2THEN TRUE ELIFt0<>0THENl1=t0ELSEm1=0END IF.o1:INT VARq1:=1,r1:=0,s1:=0,t1:=1,u1:=1;n0:=j0;REP IFv1THENw1END IF;IFx1THENy1END IF;z1;t1INCR1END REP.v1:l1=0.w1:a2(b2.c0,b2.d0,b2.e0);IF NOTc2THENd2;e2END IF.c2:b2.c0>length(k1).d2:IFf2ANDg2THENh2END IF.g2:(b2.e0AND1)=0.h2:INT VARi2:=b2.c0+b2.d0;IF(k1SUBi2)=k0THEN
+ WHILE(k1SUBi2+1)=k0REPi2INCR1;b2.d0INCR1END REP END IF.e2:INT CONSTj2:=k2(u0);IFj2>0THENfeldlesen(j2,b2.g0)ELSEq0(-j2,b2.g0)END IF;u0INCR1;b2.f0:=0;IFb2.g0<>j0THENm1INCR1END IF.x1:b2.e0>=4.b2:h0(t1).z1:INT CONSTreserve:=l2(b2);IFreserve>0THENm2ELSEs1DECRreserveEND IF.m2:r1INCRreserve;IFf2ANDr1>s1THENr1:=s1END IF;IFn2ANDo2THENp2END IF.f2:i0=2ORi0=4.n2:reserve=b2.d0.o2:(b2.e0AND1)=0.p2:IFb2.c0=1COR(k1SUB(b2.c0-1))=k0THEN INT VARq2:=r2(t1);WHILE(k1SUBq2)=k0REPq2INCR1;b2.d0INCR1;r1INCR1END REP END IF.y1:IFt1=1THEN IFc2THENs2END IF ELSEt2END IF.s2:IFn1THENi1(k0)ELSEi1(k1)END IF;LEAVEo1.t2:INT VARu2:=0,v2:=b2.c0;INT CONSTw2:=v2-length(k1);x2;y2;z2;a3.x2:IFw2>0THENr1INCRw2;v2DECR(w2-1)END IF;b3.b3:INT CONSTc3:=r2(t1-1),d3:=pos(k1,m0,c3,v2);IFd3>0THENv2:=d3;e3ELIFw2<0AND(k1SUB(v2-1))<>k0THENv2:=c3END IF.e3:INT VARf3:=v2+1;REPu2INCR1;f3INCR1UNTIL(k1SUBf3)<>k0END REP;r1INCRu2.y2:INT VARg3:=0;WHILEu1<t1REPh3;i3;j3;u1INCR1END REP.h3:INT CONSTc0:=k3.c0,d0:=k3.d0,e0:=k3.e0.i3:l3(q1,c0,n1);q1:=c0+d0
+.k3:h0(u1).j3:INT CONSTm3:=-l2(k3);IFm3=-d0THENn3ELIFm3<=0THENo3ELIFp3ANDq3THENr3ELSEs3END IF.n3:IFp3THENg3INCRm3;IFf2THENt3END IF ELSEu3(-m3)END IF.t3:IFg3<0THENu3(-g3);g3:=0END IF.o3:IFv3THENu3(-m3)END IF;w3(k3);m1DECR1;IFx3THENy3ELSEg3INCRm3;z3END IF.v3:(e0AND2)=2.x3:(e0AND1)=1.y3:IF NOTv3THENu3(-m3)END IF.z3:IFf2ANDg3<0THENu3(-g3);g3:=0END IF.p3:NOTx3.q3:m3<=r1.r3:w3(k3);m1DECR1;g3INCRm3;r1DECRm3.s3:INT VARa4:=0,b4:=k3.f0+1,c4:=b4+d0-1,d4:=d0;IFp3THENc4INCRr1;d4INCRr1END IF;IFv3ANDe4THENf4END IF;g4;IFh4THENi4END IF;j4;IFp3THENg3INCRr1;r1:=0END IF.f4:INT CONSTk4:=length(k3.g0)-c4;b4INCRk4;c4INCRk4.g4:INT VARl4;REPl4:=d4-c4+b4-1+m4(k3.g0,b4,c4);IFl4=0THEN LEAVEg4ELIFv3THENb4DECRl4ELSEc4INCRl4END IF END REP.h4:i0>=3.e4:NOTh4.j4:IFv3THENu3(a4)END IF;n4(k3.g0,b4,c4);IFo4THENu3(a4)END IF.o4:NOTv3.i4:IFpos(k3.g0,k0,b4,c4)>0THENp4END IF;INT CONSTq4:=pos(k3.g0,"!","�",c4+1);IFq4=0THENk3.f0:=length(k3.g0);m1DECR1ELSEk3.f0:=q4-1END IF.p4:c4INCR1;a4DECR1;WHILE(k3.g0SUBc4)<>k0REPc4DECR1;a4INCR1
+END REP;WHILE(k3.g0SUBc4)=k0REPc4DECR1;a4INCR1UNTILq2<b4END REP.z2:l3(q1,v2,n1);IFg3<0THEN IFv2<=length(k1)THENu3(-g3)END IF;q1:=v2ELSEq1:=v2+min(g3,u2)END IF.a3:IFw2>0THENr4;s4;LEAVEo1ELSEt4END IF.r4:IF NOTn1THENn4(k1,q1,length(k1))END IF.s4:INT VARu4:=length(n0);IF(n0SUBu4)=k0THEN REPu4DECR1UNTIL(n0SUBu4)<>k0END REP;n0:=subtext(n0,1,u4)END IF;IFv4THENn0CATk0END IF;i1(n0).v4:(k1SUB LENGTHk1)=k0AND(i0<>3ORm1=0).t4:r1:=0;s1:=0.END PROCinterpretiere;INT PROCr2(INT CONSTw4):h0(w4).c0+h0(w4).d0END PROCr2;INT PROCl2(SPEICHER CONSTx4):x4.d0-length(x4.g0)+m4(x4.g0)+x4.f0END PROCl2;INT PROCm4(TEXT CONSTy4):m4(y4,1,length(y4))END PROCm4;INT PROCm4(TEXT CONSTy4,INT CONSTz4,a5):INT CONSTb5:=pos(y4,l0,z4,a5);INT VARc5:=b5,d5,e5:=0;WHILEc5>0REPf5;IFg5THENh5ELSEi5END IF;j5END REP;e5.f5:d5:=pos(y4,l0,c5+1,a5).g5:d5=0.h5:IFa5=length(y4)THENe5INCRb5ELSEe5INCR(a5-c5+1)END IF.i5:e5INCR(d5-c5+1).j5:IFd5>0THENc5:=pos(y4,l0,d5+1,a5)ELSEc5:=0END IF.END PROCm4;LETk5="          ";PROCu3(INT CONSTl5):INT VARm5
+:=l5;WHILEm5>=10REPn0CATk5;m5DECR10END REP;WHILEm5>0REPn0CATk0;m5DECR1END REP END PROCu3;PROCw3(SPEICHER VARx4):IFx4.f0=0THENn0CATx4.g0ELSEn4(x4.g0,x4.f0+1,length(x4.g0))END IF;x4.f0:=length(x4.g0)END PROCw3;PROCl3(INT CONSTz4,a5,BOOL CONSTn1):IFn1THENu3(a5-z4)ELSEn4(k1,z4,a5-1)END IF END PROCl3;TEXT VARn5;PROCn4(TEXT CONSTo5,INT CONSTz4,a5):n5:=subtext(o5,z4,a5);n0CATn5END PROCn4;FILE VARp5;TEXT VARk1;INT VARq5;LETr5=
+#401#"keine schliessende Klammer in Feldmuster",s5=
+#402#"kein Kommando in Kommandozeile",t5=
+#403#"unbekanntes Kommando";
+LETu5="&",v5="%",w5="%",x5="<",y5=">";LETz5=
+#404#" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETa6=1,b6=2,c6=3,d6=4,e6=5,e1=6,g1=7,f6=100;INT VARg6,h6,i6;BOOL VARw0,j6;.k6:lineno(p5).l6:g6:=maxlinelength(p5).PROCm6(TEXT CONSTn6):REPq5INCR1UNTIL(k1SUBq5)<>n6END REP END PROCm6;PROCa2(INT VARb4,e5,e0):o6;IFc2THENb4:=max(g6,length(k1))+1;e5:=0;e0:=5ELSEb4:=q5;p6END IF.o6:q6(u5,v5).c2:q5>length(k1).p6:TEXT CONSTr6:=k1SUBq5;IFr6=v5THENe0:=0ELSEe0:=4END IF;s6;feldnamenlesen;t6.s6:m6(r6);IFq5-1>b4THENu6END IF.u6:e0INCR3.feldnamenlesen:IF(k1SUBq5)=x5THENv6ELSEw6END IF;IFx6THENa2(b4,e5,e0);LEAVEa2END IF.x6:h6>i6.v6:h6:=q5+1;i6:=pos(k1,y5,h6);IFi6=0THENy6(r5,subtext(k1,q5));i6:=length(k1)ELSEi6DECR1END IF;q5:=i6+2.w6:h6:=q5;q6(k0,v5);INT CONSTz6:=pos(k1,u5,h6,q5);IFz6>0THENq5:=z6END IF;i6:=q5-1.t6:IFa7THENb7;m6(r6)END IF;e5:=q5-b4.a7:(k1SUBq5)=r6.b7:e0:=e0OR1.END PROCa2;PROCa2(TEXT VARname):INT VARc7,e5,d7;a2(c7,e5,d7);IFe5>0THENname:=subtext(k1,h6,i6)ELSEname:=j0END 
+IF END PROCa2;PROCq6(TEXT CONSTe7,f7):INT CONSTg7:=pos(k1,e7,q5),h7:=pos(k1,f7,q5);q5:=length(k1)+1;IFg7>0THENq5:=g7END IF;IFh7>0ANDh7<q5THENq5:=h7END IF END PROCq6;PROCv0(INT CONSTi7):toline(p5,i7);j6:=FALSE;w0:=eof(p5)END PROCv0;PROCx0:IFj6THENdown(p5)ELSEj6:=TRUE END IF;readrecord(p5,k1);q5:=1;w0:=lineno(p5)>=lines(p5)END PROCx0;BOOL PROCb1(INT VARr0):q5:=1;IF(k1SUB1)<>w5THEN FALSE ELIF(k1SUB2)<>w5THENj7;k7;TRUE ELSEr0:=f6;TRUE END IF.j7:TEXT VARl7;m6(k0);IFq5>length(k1)THENy6(s5,k1);r0:=0;LEAVEb1WITH TRUE END IF;INT CONSTm7:=pos(k1,k0,q5);IFm7=0THENl7:=subtext(k1,q5);l7CATk0;q5:=length(k1)+1ELSEl7:=subtext(k1,q5,m7);q5:=m7END IF.k7:INT CONSTn7:=pos(z5,l7);IFn7>0CAND(z5SUB(n7-2))=k0THENr0:=code(z5SUB(n7-1))ELSEr0:=0;y6(t5,l7);END IF.END PROCb1;PROCj1(INT VARo7):m6(k0);INT CONSTp7:=q5;WHILEq7REPq5INCR1END REP;IFq5>p7THENo7:=int(subtext(k1,p7,q5-1))ELSEo7:=-1END IF.q7:pos("0123456789",k1SUBq5)>0.END PROCj1;FILE VARr7;TEXT VARs7;BOOL VARt7;PROCu7(TEXT CONSTname):s7:=name;v7("PROC ",
+name," :")END PROCu7;PROCw7:v7("END PROC ",s7,";")END PROCw7;PROCx7(TEXT CONSTy7):t7:=TRUE;putline(r7,y7)END PROCx7;PROCx7(TEXT CONSTz7,a8,b8):t7:=TRUE;v7(z7,a8,b8)END PROCx7;PROCv7(TEXT CONSTz7,a8,b8):write(r7,z7);write(r7,a8);write(r7,b8);line(r7)END PROCv7;TEXT VARc8;PROCx7(TEXT CONSTz7,INT CONSTd8,TEXT CONSTb8):c8:=subtext(k1,d8);x7(z7,c8,b8)END PROCx7;PROCe8(INT CONSTi7,f8):v7(";  interpretiere (",text(i7)+", "+text(f8),", PROC (INT CONST, TEXT VAR) abk);")END PROCe8;LETg8=
+#405#"kein % WIEDERHOLUNG gefunden",h8=
+#406#"Nur GRUPPE-Anweisung erlaubt",i8=
+#407#"keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",j8=
+#408#"illegale Gruppennummer",k8=
+#409#"diese Gruppe wurde schon definiert",l8=
+#410#"diese Abkuerzung ist nicht definiert",m8=
+#411#"dieser Abschnitt wurde schon einmal definiert",n8=
+#412#"falscher Modus",o8=
+#413#"diese Anweisung darf im Musterteil nicht vorkommen",p8=
+#414#"im Abkuerzungsteil darf keine Anweisung auftreten",q8=
+#415#"in dieser Zeile stehen zu viele Feldmuster",r8=
+#416#"das Druckmuster enthaelt zu viele Feldmuster",s8=
+#417#"nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",t8=
+#418#"kein Doppelpunkt nach Abkuerzung",u8=
+#419#"Abkuerzung mehrfach definiert",v8=
+#420#"das Druckmuster enthaelt zu viele Abkuerzungen";
+LETw8=200,x8=4,y8=250,GRUPPE=STRUCT(BOOLz8,a9,TEXTg0),ABSCHNITT=STRUCT(INTp0,o0,TEXTu7);ROWw8INT VARk2;INT VARb9;ROWx8GRUPPE VARc9;ROW3ABSCHNITT VARd9;SATZ VARq0;TEXT VARe9;INT VARf9;OP CAT(TEXT VARg9,INT CONSTwert):TEXT VARh9:="  ";replace(h9,1,wert);g9CATh9END OP CAT;PROCi9:enablestop;v0(1);j9;k9;WHILE NOTw0REPl9END REP;m9.j9:INT VARr0;INT VARn9;f9:=0;satzinitialisieren(q0);e9:=j0;b9:=0;t7:=FALSE;d9(1):=ABSCHNITT:(0,0,"vorspann");d9(2):=ABSCHNITT:(0,0,"wdh");d9(3):=ABSCHNITT:(0,0,"nachspann");FORn9FROM1UPTOx8REPc9(n9).a9:=FALSE END REP.k9:BOOL VARo9:=FALSE;REP IFw0THENy6(g8);LEAVEi9END IF;x0;IFb1(r0)THENp9END IF END REP.p9:SELECTr0OF CASEf6:q9CASEe6:r9CASEa6,b6,c6:IF NOTo9THENu7("gruppen")END IF;w7;LEAVEk9OTHERWISE IFr0>0THENy6(h8)END IF END SELECT.q9:IFo9THENy6(i8,k1)ELSEreplace(k1,1,"  ");x7(k1)END IF.r9:IF NOTo9THENu7("gruppen");o9:=TRUE END IF;INT VARs9;j1(s9);IFs9<1ORs9>x8THENy6(j8,k1)ELIFc9(s9).a9THENy6(k8,k1)ELSEc9(s9).a9:=TRUE;t9END IF.t9:x7("gruppentest (",text(s9),", ");x7(
+"            ",q5,");").l9:SELECTr0OF CASEa6:u9CASEb6:v9CASEc6:w9END SELECT.u9:x9(d9(1),r0).v9:j1(y9);j1(z9);x9(d9(2),r0).w9:x9(d9(3),r0).m9:IFt7THENa10;b10END IF;c10;IFt7THENd10;e10END IF.c10:FORn9FROM1UPTOf9REP IF(e9ISUBn9)>0THENy6(l8,f10,e9ISUBn9)ELSEg10END IF END REP.f10:TEXT VARh10;feldlesen(q0,n9,h10);h10.a10:FORn9FROM1UPTO3REP IFd9(n9).o0=0THENi10END IF END REP.i10:u7(d9(n9).u7);w7.b10:x7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFf9>0THENx7("SELECT nr OF")ELSEx7("inhalt := text (nr)")END IF.g10:TEXT CONSTj10:=text(n9);x7("CASE "+j10," : inhalt := abk",j10).d10:IFf9>0THENx7("END SELECT")END IF;x7("END PROC abk;").e10:x7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCi9;PROCx9(ABSCHNITT VARk10,INT VARr0):BOOL VARl10:=TRUE;u7(k10.u7);m10;n10;o10.m10:IFk10.o0<>0THENy6(m8,k1)END IF;k10.o0:=k6+1;k10.p0:=b9+1.n10:WHILE NOTw0REPx0;IFb1(r0)THENp10ELSEq10;r10END IF END REP;s10;LEAVEx9.p10:SELECTr0OF CASEf6:replace(k1,1,"  ");x7(k1);l10:=TRUE CASEa6,b6,c6:
+s10;LEAVEx9CASEd6:s10;LEAVEn10CASEe1:q10;INT VARt10;j1(t10);IFt10<1ORt10>4THENy6(n8,k1)END IF CASEg1:q10OTHERWISE IFr0>0THENy6(o8)END IF END SELECT.q10:IFl10THENe8(k6,b9+1);l10:=FALSE END IF.s10:w7.r10:TEXT VARname;INT VARu10:=0;REPa2(name);IFname=j0THEN LEAVEr10END IF;u10INCR1;v10END REP.v10:IFu10>=b0THENy6(q8)END IF;IFb9=w8THENy6(r8)ELSEb9INCR1END IF;w10.w10:INT VARx10:=feldnummer(name);IFx10=0THENx10:=feldindex(q0,name);IFx10=0THENy10(name,k6);k2(b9):=-f9ELSEk2(b9):=-x10END IF ELSEk2(b9):=x10END IF.o10:BOOL VARz10:=TRUE;WHILE NOTw0REPx0;IFb1(r0)THENa11ELIFb11THENc11END IF END REP.a11:SELECTr0OF CASEa6,b6,c6:LEAVEo10OTHERWISE IFr0>0THENy6(p8)END IF END SELECT.c11:IFz10THENx7(".");z10:=FALSE END IF;IFd11THENe11ELSEx7(k1)END IF.d11:(k1SUB1)=u5.e11:TEXT VARf11;a2(f11);IFf11=j0THENy6(s8,k1);LEAVEe11END IF;g11;h11.g11:LETi11=":";q5DECR1;m6(k0);IF(k1SUBq5)=i11THENq5INCR1ELSEy6(t8,k1)END IF.h11:y10(f11,0);x7(j11,q5-1,"").j11:"abk"+text(feldindex(q0,f11)).b11:k1<>j0ANDk1<>k0.END PROCx9;PROC
+y10(TEXT CONSTname,INT CONSTi7):INT CONSTk11:=feldindex(q0,name);IFk11>0THENl11ELSEm11END IF.l11:IF(e9ISUBk11)>0THENreplace(e9,k11,i7)ELIFi7=0THENy6(u8,name)END IF.m11:IFf9=y8THENy6(v8)ELSEf9INCR1END IF;e9CATi7;feldaendern(q0,f9,name).END PROCy10;LETn11=
+#421#"FEHLER in Zeile ",o11=
+#422#" bei >>",p11=
+#423#"<<";
+PROCy6(TEXT CONSTq11,r11,INT CONSTi7):LETs11="   ";TEXT VARt11:=n11;t11CATtext(i7);IFr11<>j0THENt11CATo11;t11CATr11;t11CATp11END IF;note(t11);noteline;note(s11);note(q11);noteline;IFonlineANDcommanddialogueTHENline;putline(t11);put(s11);putline(q11)END IF END PROCy6;PROCy6(TEXT CONSTq11):y6(q11,j0,k6)END PROCy6;PROCy6(TEXT CONSTq11,r11):y6(q11,r11,k6)END PROCy6;LETu11=
+#424#"erzeugtes Programm",v11=
+#425#"keine Datei geoeffnet",w11=
+#426#"interner Fehler",x11=
+#427#"Druckausgabe steht in",y11=
+#428#"zum Drucker geschickt.",z11=
+#429#"direkt Drucken nicht moeglich",a12=
+#430#".a$";
+TEXT VARb12,c12:="";BOOL VARd12,e12,f12,g12:=FALSE;FILE VARh12;INT VARy9,z9,i12,j12,k12,l12:=1,m12:=4000,n12;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTo12):enablestop;lastparam(o12);p5:=sequentialfile(input,o12);modify(p5);IFanzahldateien=0THENerrorstop(v11)END IF;disablestop;p12;i9;IFanythingnotedTHENnoteedit(p5)ELIFt7THENq12ELSEdrucke(PROCr12,PROCs12,PROCt12,PROCu12)END IF;forget(v12,quiet).p12:TEXT VARv12;INT VARn9:=0;REPn9INCR1;v12:=text(n9)UNTIL NOTexists(v12)END REP;r7:=sequentialfile(output,v12);headline(r7,u11).q12:run(v12);lastparam(o12).END PROCdrucke;PROCr12:END PROCr12;PROCs12:w12(1)END PROCs12;PROCt12:w12(2)END PROCt12;PROCu12:w12(3)END PROCu12;PROCw12(INT CONSTx12):IFd9(x12).o0>0THENinterpretiere(d9(x12).o0,d9(x12).p0,PROC(INT CONST,TEXT VAR)y12)END IF END PROCw12;PROCy12(INT CONSTx12,TEXT VARg0):errorstop(w11);g0:=code(x12)END PROCy12;PROCdrucke(PROCz12,PROCa13,PROCb13,PROCc13):INT VARd13,e13,f13;enablestop;g13;h13;i13;n12:=1;WHILE NOTdateiendeREP
+j13;cout(satznummer);k13;weiter(d13);l13END REP;m13;n13;aufsatz(1).h13:e13:=0;aufsatz(1);IFmarkiertesaetze>0THENd13:=3;IF NOTsatzmarkiertTHENweiter(d13)END IF ELSEd13:=2;IF NOTsatzausgewaehltTHENweiter(d13)END IF END IF.i13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).g0:=j0END REP.j13:IFe13=0THENz12;o13;p13(PROCa13)ELSEe12:=FALSE;q13;r13END IF;e13:=satznummer;f13:=satzkombination.q13:d12:=FALSE;z12.r13:IFd12THENs13(e13,f13,PROCc13)END IF;n12INCR1;IFd12THENp13(PROCa13)END IF.k13:IFz9<1THENl6ELSEg6:=z9END IF;IFi12<y9THENtoline(h12,j12)ELSEtoline(h12,k12+1);j12:=k12+1;i12:=0END IF;i0:=1;b13;i12INCR1.l13:IFk12>m12THENn13;g13END IF.m13:o13;IFe13=0THENp13(PROCc13)ELSEs13(e13,f13,PROCc13)END IF;v0(1).END PROCdrucke;PROCo13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).z8:=TRUE END REP;e12:=TRUE;d12:=TRUE END PROCo13;PROCp13(PROCk10):i12:=y9;toline(h12,k12+1);l6;i0:=1;k10END PROCp13;PROCs13(INT CONSTe13,f13,PROCc13):INT CONSTt13:=satznummer,u13:=satzkombination;aufsatz(e13);WHILEsatzkombination<>f13REPweiter(1)
+END REP;p13(PROCc13);aufsatz(t13);WHILEsatzkombination<>u13REPweiter(1)END REP END PROCs13;PROCg13:IFaktuellereditor>0THENv13ELSEw13END IF;x13.v13:h12:=editfile;IFcol>1THENsplitline(h12,col,FALSE);down(h12);col(h12,1)END IF;k12:=lineno(h12)-1.w13:IF NOTf12THENy13END IF;h12:=sequentialfile(modify,c12);maxlinelength(h12,maxlinelength(p5));k12:=lines(h12).y13:INT VARm5:=0;REPm5INCR1;c12:=headline(p5)+a12+text(m5);UNTIL NOTexists(c12)END REP.x13:v0(1);WHILE NOTw0REPz13END REP.z13:x0;INT VARr0;IFb1(r0)THENa14ELSEi1(k1)END IF.a14:IFr0<>f6ANDr0<>e6THEN LEAVEx13END IF.END PROCg13;PROCn13:IFaktuellereditor>0THEN LEAVEn13ELIFf12THENf12:=FALSE;ELIFg12THENdisablestop;b14ELIFonlineANDl12>1THENline;put(x11);putline(textdarstellung(c12));pause(40)END IF;toline(h12,1).b14:TEXT CONSTo7:=std;lastparam(c12);do("print (std)");IFiserrorTHENclearerror;errorstop(z11)ELIFonlineTHENline;put(textdarstellung(c12));putline(y11);forget(c12,quiet);pause(40)END IF;lastparam(o7).END PROCn13;PROCi1(TEXT CONSTi7):IFi12
+>=y9ORi12=0THENinsertrecord(h12);writerecord(h12,i7);k12INCR1ELSEc14END IF;down(h12).c14:IFeof(h12)THENb12:=j0;insertrecord(h12);k12INCR1ELSEreadrecord(h12,b12)END IF;d14;writerecord(h12,b12).d14:INT CONSTe14:=g6*i12;WHILElength(b12)<e14REPb12CATk0END REP;b12CATi7.END PROCi1;PROCdruckrichtung(INT CONSTf14):l12:=f14;g12:=(f14=0)END PROCdruckrichtung;INT PROCdruckrichtung:l12END PROCdruckrichtung;PROCdirektdrucken(BOOL CONSTd13):g12:=d13;IFd13THENl12:=0ELIFl12=0THENl12:=1END IF END PROCdirektdrucken;BOOL PROCdirektdrucken:g12END PROCdirektdrucken;PROCdruckdatei(TEXT CONSTo12):c12:=o12;f12:=TRUE END PROCdruckdatei;TEXT PROCdruckdatei:c12END PROCdruckdatei;PROCmaxdruckzeilen(INT CONSTg14):m12:=g14END PROCmaxdruckzeilen;PROCgruppentest(INT CONSTs9,TEXT CONSTh14):IFh14<>c9(s9).g0THENc9(s9).g0:=h14;c9(s9).z8:=TRUE;d12:=TRUE ELSEc9(s9).z8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTs9):IFs9>0THENc9(s9).z8ELSEe12END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(n12)END 
+PROClfdnr;END PACKETeudasdrucken;
+PACKETeudasstdlistenDEFINESdruckestandardlisten,stdlistenbreite,stdlistenlaenge,stdlistenfont:LETb0="******* Listendruckmuster *******";FILE VARf;TEXT VARc0,d0;TEXT VARe0:="";INT VARf0:=70,g0:=60;PROCstdlistenbreite(INT CONSTh0):f0:=h0END PROCstdlistenbreite;INT PROCstdlistenbreite:f0END PROCstdlistenbreite;PROCstdlistenlaenge(INT CONSTi0):g0:=i0END PROCstdlistenlaenge;INT PROCstdlistenlaenge:g0END PROCstdlistenlaenge;PROCstdlistenfont(TEXT CONSTfont):e0:=fontEND PROCstdlistenfont;TEXT PROCstdlistenfont:e0END PROCstdlistenfont;PROCdruckestandardlisten(INT CONSTj0,TEXT CONSTk0):forget(b0,quiet);f:=sequentialfile(output,b0);maxlinelength(f,f0);IFl0THENm0(k0)ELSEn0(k0)END IF;TEXT CONSTo0:=std;drucke(b0);forget(b0,quiet);lastparam(o0).l0:j0=2.END PROCdruckestandardlisten;ROW100INT VARp0;INT VARq0,r0,s0,t0,u0;PROCv0:IFe0<>""THENputline(f,"#type("+textdarstellung(e0)+")#")END IF;putline(f,"% GRUPPE 1 seitennummer");putline(f,"% VOR");put(f,date);put(f,timeofday);put(f,"Uhr:");put(f,
+eudasdateiname(1));write(f,(f0-length(eudasdateiname(1))-25)*" ");putline(f,"&&-S");line(f)END PROCv0;PROCw0:putline(f,"% NACH");putline(f,"#page#");putline(f,"% ABK");putline(f,"&? : lfd nr .");putline(f,"&-S : seitennummer .");putline(f,"seitennummer :");putline(f,"  text (int (lfd nr) DIV saetze pro seite + 1) .");write(f,"saetze pro seite : ");put(f,(g0-2)DIVq0-1);putline(f,".")END PROCw0;PROCm0(TEXT CONSTk0):v0;x0;y0;w0.x0:write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFz0<length(k0)THENwrite(f,d0+", ")ELSEwrite(f,d0)END IF END REP;line(f);putline(f,maxlinelength(f)*"-");q0:=1.y0:putline(f,"% WDH");INT CONSTa1:=maxlinelength(f);INT VARz0;maxlinelength(f,10000);write(f,"&&? ");FORz0FROM1UPTOlength(k0)REPb1END REP;line(f);maxlinelength(f,a1).b1:write(f,"%<");feldnamenlesen(code(k0SUBz0),d0);write(f,d0);write(f,">");IFz0<length(k0)THENwrite(f,", ")END IF.END PROCm0;PROCc1(TEXT CONSTk0):INT VARz0;d1;aufsatz(1);INT VARe1;IFmarkiertesaetze>0THENe1:=3;IF NOT
+satzmarkiertTHENweiter(3)END IF ELSEe1:=2;IF NOTsatzausgewaehltTHENweiter(2)END IF END IF;WHILE NOTdateiendeREPf1;weiter(e1)END REP.d1:t0:=length(k0);FORz0FROM1UPTOt0REPp0(z0):=2END REP;u0:=0.f1:INT VARg1:=0;FORz0FROM1UPTOt0REPfeldbearbeiten(code(k0SUBz0),PROC(TEXT CONST,INT CONST,INT CONST)h1);IFs0>p0(z0)THENp0(z0):=s0END IF;g1INCRs0END REP;IFg1>u0THENu0:=g1END IF.END PROCc1;PROCh1(TEXT CONSTi1,INT CONSTj1,k1):s0:=k1-j1+1END PROCh1;PROCn0(TEXT CONSTk0):c1(k0);v0;x0;y0;l1;w0.x0:TEXT VARm1:="";INT VARz0;r0:=4;q0:=1;write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFlength(d0)+2>=p0(z0)THENn1END IF;r0INCRp0(z0)+1;IFr0>f0THENline(f);r0:=p0(z0)+1;q0INCR1END IF;write(f,text(d0,p0(z0)+1))END REP;line(f);putline(f,maxlinelength(f)*"-").n1:m1CAT(k0SUBz0).y0:putline(f,"% WDH");write(f,"&&? ");FORz0FROM1UPTOlength(k0)REPo1END REP;line(f).o1:INT CONSTp1:=pos(m1,k0SUBz0);c0:="&";IFp1>0THENc0CATtext(code(p1+64),p0(z0))ELSEfeldnamenlesen(code(k0SUBz0),d0);c0CATtext("<"+d0+
+">",p0(z0))END IF;write(f,c0).l1:IFm1<>""THENputline(f,"% ABK");FORz0FROM1UPTOlength(m1)REPq1END REP END IF.q1:write(f,"&");write(f,code(z0+64));write(f," : ");write(f,"f (");feldnamenlesen(code(m1SUBz0),d0);write(f,textdarstellung(d0));putline(f,") .").END PROCn0;END PACKETeudasstdlisten;
+
diff --git a/app/eudas/5.3/src/eudas.3 b/app/eudas/5.3/src/eudas.3
new file mode 100644
index 0000000..92b783f
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.3
@@ -0,0 +1,43 @@
+PACKETsatzanzeigeDEFINESanzeigefenster,bildausgeben,aendern,einfuegen,suchen,feldauswahl,rollen,exitdurch,exitzeichen:LETb0=256;LETc0=" ",d0="",e0=""5"",f0=""15"",g0=" "14"",h0=" "14" ";ROWb0STRUCT(INTi0,j0)VARk0;INT VARl0,m0,n0:=24,o0:=79,p0:=1,q0:=1,r0,s0,t0:=0,u0:=0,v0:=dateiversion-1,w0:=0;BOOL VARx0:=TRUE,y0:=TRUE,z0:=FALSE,a1;FENSTER VARfenster;fensterinitialisieren(fenster);DATASPACE VARb1,c1;FILE VAReditfile;TEXT VARd1,e1;LETf1=
+#801#"Anzeigefenster zu klein";
+PROCanzeigefenster(FENSTER CONSTg1):INT VARh1,i1,j1,k1;fenstergroesse(g1,h1,i1,j1,k1);IFj1>=39THENfenstergroessesetzen(fenster,g1);y0:=h1+j1>=xsize;o0:=j1;n0:=k1;q0:=h1;p0:=i1;x0:=TRUE ELSEerrorstop(f1)END IF END PROCanzeigefenster;FENSTER PROCanzeigefenster:fensterEND PROCanzeigefenster;PROCl1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENa1:=TRUE END IF END PROCl1;PROCm1:IFn1ORx0THENo1;p1;q1;r1;s1;t1END IF.n1:v0<>dateiversion.o1:l0:=0;WHILEl0<anzahlfelderREPl0INCR1;k0(l0).i0:=l0END REP;m0:=1.p1:INT VARi0;r0:=11;FORi0FROM1UPTOanzahlfelderREPfeldnamenbearbeiten(i0,PROC(TEXT CONST,INT CONST,INT CONST)u1)END REP;r0:=min(r0,o0DIV3);s0:=o0-r0-3.r1:a1:=TRUE.s1:forget(c1);c1:=nilspace;IFn1ANDz0THENforget(b1);z0:=FALSE END IF.t1:v0:=dateiversion;w0:=anzahldateien;x0:=FALSE.END PROCm1;PROCu1(TEXT CONSTv1,INT CONSTw1,x1):r0INCRlength(v1)-length(v1);r0:=max(r0,x1-w1+1)END PROCu1;PROCrollen(INT CONSTy1):m0:=m0+y1;IFm0<1THENm0:=1ELIFm0>z1THENm0:=max(z1,
+1)END IF;a1:=TRUE.z1:l0-n0+3.END PROCrollen;PROCfeldauswahl(TEXT CONSTa2):m1;b2;a1:=TRUE.b2:l0:=length(a2);INT VARc2;FORc2FROM1UPTOl0REPk0(c2).i0:=code(a2SUBc2)END REP;m0:=1.END PROCfeldauswahl;INT VARd2;PROCe2:type(c1,-1);editfile:=sequentialfile(modify,c1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);maxlinelength(editfile,10000);d2:=1END PROCe2;.f2:d2<=l0.PROCg2(PROC(TEXT CONST,INT CONST)h2):i2;IFeof(editfile)THENh2("",i0)ELIFj2THENk2;l2;h2(e1,i0)ELIFm2THENreadrecord(editfile,e1);l2;h2(e1,i0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)h2,editfile,i0);down(editfile)END IF.i2:INT CONSTw1:=d2,i0:=k0(w1).i0;REPd2INCR1UNTILd2>l0CORn2END REP.n2:k0(d2).i0<>i0.j2:d2-w1>1.k2:e1:="";REPexec(PROC(TEXT CONST,INT CONST)o2,editfile,length(e1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=d2END REP.m2:INT CONSTp2:=len(editfile);subtext(editfile,p2,p2)=c0.END PROCg2;PROCo2(TEXT CONSTq2,INT CONSTr2):IFr2>0CAND(e1SUBr2)<>c0CAND(q2SUB1)<>c0THENe1CATc0END IF;e1CATq2END PROCo2;
+PROCl2:INT VARp2:=length(e1);WHILE(e1SUBp2)=c0REPp2DECR1END REP;e1:=subtext(e1,1,p2)END PROCl2;BOOL VARs2;PROCeinfuegen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;u2(PROCt2);satzeinfuegen;s2:=TRUE;v2END IF END PROCeinfuegen;PROCv2:WHILEf2REPg2(PROC(TEXT CONST,INT CONST)w2)END REP;aenderungeneintragenEND PROCv2;PROCw2(TEXT CONSTx2,INT CONSTi0):IF NOTs2CORx2<>d0THENfeldaendern(i0,x2)END IF END PROCw2;PROCaendern(PROCt2):enablestop;IFdateiendeTHENeinfuegen(PROCt2)ELSEy2END IF.y2:m1;IFl0>0THENe2;l1;z2(a1);a3;u2(PROCt2);s2:=FALSE;v2END IF.a3:b3:=1;WHILEb3<=l0REPfeldbearbeiten(k0(b3).i0,PROC(TEXT CONST,INT CONST,INT CONST)c3);insertrecord(editfile);writerecord(editfile,e1);down(editfile);b3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARb3;PROCc3(TEXT CONSTv1,INT CONSTw1,x1):e1:=subtext(v1,d3,e3).d3:w1+k0(b3).j0.e3:IFf3THENx1ELSEw1+k0(b3+1).j0-1END IF.f3:b3=l0CORk0(b3+1).i0<>k0(b3).i0.END PROCc3;PROCsuchen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;IFsuchversion<>0THENg3END IF;u2(PROCt2);h3END 
+IF.g3:b3:=1;WHILEb3<=l0REPinsertrecord(editfile);i3;down(editfile);b3INCR1END REP;toline(editfile,1).i3:IFk0(b3).j0=0THENsuchbedingunglesen(k0(b3).i0,e1);writerecord(editfile,e1)END IF.h3:suchbedingungloeschen;WHILEf2REPg2(PROC(TEXT CONST,INT CONST)j3)END REP.END PROCsuchen;PROCj3(TEXT CONSTk3,INT CONSTi0):suchbedingung(i0,k3)END PROCj3;PROCbildausgeben(BOOL CONSTl3):enablestop;m1;l1;IFl3ORa1ORm3THENz2(a1);t0:=satznummer;u0:=satzkombination;n3(TRUE)ELSEo3(TRUE)END IF.m3:satznummer<>t0ORu0<>satzkombination.END PROCbildausgeben;INT VARj0;BOOL VARp3;PROCz2(BOOL CONSTq3):INT VARc2:=1,r3:=0;p3:=TRUE;WHILEc2<=l0OR NOTp3REPs3END REP.s3:IFp3CANDk0(c2).i0=r3THENt3ELSE IFu3THENv3END IF;k0(c2).j0:=j0;feldbearbeiten(k0(c2).i0,PROC(TEXT CONST,INT CONST,INT CONST)w3);c2INCR1END IF.t3:IFq3THENx3(c2)ELSEk0(c2).j0:=j0;c2INCR1END IF.u3:c2>l0CORk0(c2).i0<>r3.v3:IFp3THENy3ELSEz3(c2);k0(c2).i0:=r3END IF.y3:r3:=k0(c2).i0;j0:=0.END PROCz2;PROCw3(TEXT CONSTv1,INT CONSTw1,x1):INT CONSTa4:=x1-w1-j0+1;IFa4>s0-2
+THENj0INCRs0-2;b4;p3:=FALSE ELSEj0INCRa4;p3:=TRUE END IF.b4:INT VARc4:=w1+j0-1;IFd4ANDe4THEN WHILE(v1SUBc4)<>c0REPc4DECR1;j0DECR1END REP END IF.d4:(v1SUBc4)<>c0.e4:pos(v1,c0,c4-s0+3,c4-1)>0.END PROCw3;PROCz3(INT CONSTc2):INT VARf4;FORf4FROMl0DOWNTOc2REPk0(f4+1):=k0(f4)END REP;l0INCR1;a1:=TRUE END PROCz3;PROCx3(INT CONSTc2):INT VARf4;FORf4FROMc2+1UPTOl0REPk0(f4-1):=k0(f4)END REP;l0DECR1;a1:=TRUE END PROCx3;INT VARg4;TEXT VARh4,i4,j4,k4:="",l4;LETm4=
+#802#""15" Bild verschoben ! ESC 1 druecken ! "14"";
+LETn4=""3""10"19"11""12""13"q?hpg";LETo4=1,p4=2,q4=3,r4=4,s4=5,t4=6,u4=7,v4=8,w4=9,x4=10,y4=11,z4=12;PROCu2(PROCt2):INT VARa5:=m0;lernsequenzauftastelegen("D",date);REPn3(FALSE);b5;c5;d5;e5UNTILf5END REP;toline(editfile,1);col(editfile,1).b5:IFlines(editfile)<l0+1THENoutput(editfile);line(editfile,l0-lines(editfile)+2);modify(editfile)END IF.c5:IFm0<>1THENg5(m0-1,i4)END IF;g5(h5,j4);toline(editfile,a5).h5:min(l0+1,m0+n0-1).d5:openeditor(groesstereditor+1,editfile,TRUE,q0+r0+3,p0,s0,i5);edit(groesstereditor,n4+k4,PROC(TEXT CONST)j5);k5.k5:INT VARl5,m5;getcursor(l5,m5);IFl5<>1THENbildschirmneuEND IF.i5:min(l0-m0+2,n0).e5:a5:=lineno(editfile);n5;SELECTg4OF CASEo4:o5CASEp4:p5CASEq4:q5CASEr4:r5CASEs4:s5CASEt4:t5CASEu4:u5CASEw4:t2;a1:=TRUE CASEx4:errorstop(d0)CASEy4:v5CASEz4:w5END SELECT.n5:INT CONSTx5:=col(editfile);col(editfile,1);IFm0<>1THENy5(m0-1,i4)END IF;y5(h5,j4);col(editfile,x5).o5:INT VARz5;z5:=a5-m0;rollen(-n0+1);a5:=m0+z5.p5:z5:=a5-m0;rollen(n0-1);a5:=min(m0+z5,l0).q5:rollen(-999
+);a5:=1.r5:z5:=a5-m0;rollen(999);a5:=min(m0+z5,l0).s5:toline(editfile,a5);a6;z3(a5).a6:readrecord(editfile,e1);h4:=subtext(e1,x5);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1);down(editfile);insertrecord(editfile);writerecord(editfile,h4).t5:toline(editfile,a5);IFx5=1AND(b6CANDc6ORd6CANDe6)THENf6ELSEg6END IF.b6:a5<>l0.c6:k0(a5+1).i0=k0(a5).i0.d6:a5<>1.e6:k0(a5-1).i0=k0(a5).i0.f6:deleterecord(editfile);x3(a5);IFa5>l0THENa5:=l0END IF.g6:readrecord(editfile,e1);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1).u5:z5:=a5-m0;rollen(z5).v5:forget(b1);b1:=c1;z0:=TRUE.w5:IFz0THENforget(c1);c1:=b1;editfile:=sequentialfile(modify,c1)END IF.f5:g4=v4.END PROCu2;PROCj5(TEXT CONSTh6):enablestop;setbusyindicator;g4:=pos(n4,h6);IFg4>0THENl4:=h6;quitELIFpos(k4,h6)>0THENg4:=v4;l4:=h6;quitELIFkommandoauftaste(h6)<>d0THENstdkommandointerpreter(h6)ELSEnichtsneuEND IF END PROCj5;PROCg5(INT CONSTc2,TEXT VARi6):toline(editfile,c2);readrecord(editfile,i6);writerecord(editfile,m4)END PROCg5;PROCy5(INT CONSTc2,
+TEXT CONSTi6):toline(editfile,c2);IFeof(editfile)CORpos(editfile,m4,1)=0THENtoline(editfile,1);down(editfile,m4);IFeof(editfile)THENtoline(editfile,c2);insertrecord(editfile)END IF END IF;writerecord(editfile,i6)END PROCy5;PROCexitzeichen(TEXT CONSTj6):k4:=j6END PROCexitzeichen;TEXT PROCexitdurch:l4END PROCexitdurch;INT VARk6;LETl6=
+#803#"ENDE.",m6=
+#804#"SUCH+",n6=
+#805#"SUCH-",o6=
+#806#"MARK+",p6=
+#807#"MARK-",q6=
+#808#" Zeile    "14" ",r6=
+#809#" Satz   ",s6=
+#810#"<KOPPEL>";
+LETt6=".....",u6="       ";PROCn3(BOOL CONSTv6):INT VARw6:=p0+1,x6:=0;INT CONSTy6:=m0+n0-2;o3(v6);k6:=m0;WHILEk6<=y6REPz6;a7;b7;w6INCR1;k6INCR1END REP;a1:=FALSE.z6:IFa1THENcursor(q0,w6);IFk6<=l0THENc7ELIFk6=l0+1THENd7ELSEe7END IF END IF.c7:out(f0);IFk0(k6).i0=x6THENr0TIMESOUTc0ELSEx6:=k0(k6).i0;feldnamenbearbeiten(x6,PROC(TEXT CONST,INT CONST,INT CONST)f7)END IF;out(g0).d7:out(f0);o0-4TIMESOUT".";out(h0).e7:IFy0THENout(e0)ELSEo0TIMESOUTc0END IF.a7:IFv6ANDk6<=l0THENcursor(q0+r0+3,w6);feldbearbeiten(k0(k6).i0,PROC(TEXT CONST,INT CONST,INT CONST)g7)END IF.b7:IF NOTa1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(k4,input)>0THENt0:=0;LEAVEn3END IF END IF END IF.END PROCn3;PROCo3(BOOL CONSTv6):h7;i7;cursor(q0,p0);IF NOTv6THENoutsubtext(d1,1,r0+3);LEAVEo3END IF;replace(d1,r0+7,j7);replace(d1,r0+14,k7);out(d1);cursor(q0+o0-5,p0);out(text(m0)).h7:TEXT VARsatznr;satznr:=text(satznummer);IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENsatznrCAT"-";satznrCATtext(satzkombination
+)END IF.i7:replace(d1,7,u6);replace(d1,7,satznr).j7:IFsuchversion=0THENt6ELIFsatzausgewaehltTHENm6ELSEn6END IF.k7:IFdateiendeTHENl6ELIFmarkiertesaetze=0THENt6ELIFsatzmarkiertTHENo6ELSEp6END IF.END PROCo3;PROCf7(TEXT CONSTv1,INT CONSTw1,x1):IFx1-w1>=r0THENoutsubtext(v1,w1,w1+r0-1)ELSEoutsubtext(v1,w1,x1);r0-x1+w1-1TIMESOUTc0END IF END PROCf7;PROCg7(TEXT CONSTv1,INT CONSTw1,x1):INT VARp2;IFk6=l0CORl7THENp2:=x1ELSEp2:=w1+k0(k6+1).j0-1END IF;outsubtext(v1,w1+k0(k6).j0,p2);IFy0THENout(e0)ELSEm7TIMESOUTc0END IF.l7:k0(k6+1).i0<>k0(k6).i0.m7:s0-p2+w1+k0(k6).j0-1.END PROCg7;PROCq1:d1:=text(r6,r0+3);d1CATf0;INT VARf4;INT CONSTn7:=o0-length(d1)-12;FORf4FROM1UPTOn7REPd1CAT"."END REP;d1CATq6;o7.o7:IFaufkoppeldateiTHENreplace(d1,r0+22,s6)END IF.END PROCq1;END PACKETsatzanzeige;
+PACKETuebersichtsanzeigeDEFINESuebersicht,uebersichtsfenster:ROW24INT VARb0;ROW24INT VARc0;FENSTER VARfenster;fensterinitialisieren(fenster);INT VARd0:=24,e0:=79,f0:=1,g0:=1,h0,i0:=-1;BOOL VARj0;TEXT VARk0;LETl0="",m0=""15"",n0=""14"",o0=" ",p0=""7"",q0=""5"";LETr0=
+#901#""15"Satznr. ",s0=
+#902#"  << DATEIENDE >>",t0=
+#903#"UEBERSICHT:   Rollen: HOP OBEN, HOP UNTEN   Beenden: ESC q   Hilfe: ESC ?";
+PROCuebersichtsfenster(FENSTER CONSTu0):fenstergroesse(u0,g0,f0,e0,d0);fenstergroessesetzen(fenster,u0);j0:=g0+e0>=xsizeEND PROCuebersichtsfenster;FENSTER PROCuebersichtsfenster:fensterEND PROCuebersichtsfenster;PROCuebersicht(TEXT CONSTv0,PROCw0):TEXT VARx0;BOOL VARdummy;INT VARy0:=1,z0:=0,a1:=1;fensterzugriff(fenster,dummy);statusanzeigen(t0);b1;c1;REPd1;e1;f1END REP.b1:IFv0=l0THENg1ELSEk0:=v0;i0:=dateiversionEND IF.g1:IFi0<>dateiversionTHENh1;i0:=dateiversionEND IF.h1:INT VARi1;k0:=l0;FORi1FROM1UPTOanzahlfelderREPk0CATcode(i1)END REP.d1:WHILEz0<d0REPx0:=getcharety;IFx0<>""THEN LEAVEd1END IF;j1;z0INCR1END REP;k1;getchar(x0).j1:IFz0=0THENl1ELIFz0=1THENm1ELSEn1END IF.l1:cursor(g0,f0);out(r0);h0:=e0-length(r0)-1;INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldnamenbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP;p1;cursor(g0+e0-1,f0);out(n0).m1:q1(1);r1(1);s1.n1:cursor(g0,f0+z0);IFdateiendeTHENb0(z0):=0;h0:=e0;p1ELSEt1;r1(z0);s1END IF.t1:
+weiter(2);u1;b0(z0):=satznummer;c0(z0):=satzkombination.u1:IF NOT(satzausgewaehltORdateiende)THEN LEAVEuebersichtEND IF.e1:cursor(g0,f0+y0).k1:WHILEb0(y0)=0REPy0DECR1END REP;q1(y0);cursor(g0+6,f0+y0).f1:SELECTa1OF CASE1:v1CASE2:w1CASE3:x1END SELECT.v1:SELECTpos(""3""10""1""27"+-",x0)OF CASE1:y1CASE2:z1CASE3:a1:=2CASE4:a1:=3CASE5:a2CASE6:b2OTHERWISEout(p0)END SELECT.w1:SELECTpos(""3""10""13"",x0)OF CASE1:c2CASE2:d2CASE3:e2OTHERWISEout(p0)END SELECT;a1:=1.x1:SELECTpos("19qh?",x0)OF CASE1:f2CASE2:g2CASE3,4:h2CASE5:i2OTHERWISEout(p0)END SELECT;a1:=1.y1:IFy0>1THENy0DECR1;ELSEj2(1);z0:=1END IF.z1:IF NOTdateiendeTHEN IFy0<d0-1THENy0INCR1ELSEb0(1):=b0(2);c0(1):=c0(2);z0:=1END IF END IF.a2:IF NOTsatzmarkiertTHENmarkierungaendern;IFy0<z0THENr1(y0)END IF END IF.b2:IFsatzmarkiertTHENmarkierungaendern;IFy0<z0THENr1(y0)END IF END IF.c2:IFy0>1THENy0:=1ELSEj2(d0-1);z0:=1END IF.d2:IFy0=d0-1AND NOTdateiendeTHENweiter(2);c1;z0:=1ELSEy0:=d0-1END IF.e2:IFy0<>1THENb0(1):=b0(y0);c0(1):=c0(y0);y0:=1;z0:=1END 
+IF.f2:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;c1;y0:=1;z0:=1.g2:aufsatz(32767);c1;j2(d0-2);z0:=1.h2:LEAVEuebersicht.i2:w0;statusanzeigen(t0);z0:=0.END PROCuebersicht;PROCj2(INT CONSTk2):INT VARi1;q1(1);FORi1FROM1UPTOk2WHILEsatznummer>1REPzurueck(2)END REP;c1END PROCj2;PROCq1(INT CONSTl2):aufsatz(b0(l2));WHILEsatzkombination<>c0(l2)REPweiter(1)END REP END PROCq1;PROCc1:b0(1):=satznummer;c0(1):=satzkombinationEND PROCc1;BOOL PROCm2(INT CONSTl2):satznummer=b0(l2)CANDsatzkombination=c0(l2)END PROCm2;PROCo1(TEXT CONSTn2,INT CONSTo2,p2):INT CONSTd0:=min(h0,p2-o2+1);outsubtext(n2,o2,o2+d0-1);h0DECRd0;IFh0>=2THENout(", ");h0DECR2ELIFh0=1THENout(",");h0:=0END IF END PROCo1;PROCr1(INT CONSTl2):cursor(g0,f0+l2);IFsatzmarkiertTHENout(m0)ELSEout(o0)END IF;outtext(text(satznummer),1,5);IFsatzmarkiertTHENout(n0)ELSEout(o0)END IF;h0:=e0-7END PROCr1;PROCp1:IFj0THENout(q0)ELSEh0TIMESOUTo0END IF END PROCp1;PROCs1:IFsatzausgewaehltTHENq2ELIFdateiendeTHENout(s0);h0DECRlength(s0)ELSEout("<< >>")
+;h0DECR5END IF;p1.q2:INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP.END PROCs1;END PACKETuebersichtsanzeige; 
+PACKETeudasdialoghilfenDEFINESfenstergroessenbestimmen,fensterlinks,fensterrechts,fensterganz,ausfuehrung,aufarchiv,bittewarten,frageobeinrichten,setcommanddialoguefalse,resetcommanddialogue,edit:LETb0=16;INT VARc0:=0,d0;FENSTER VARe0,f0,g0,h0;fensterinitialisieren(h0);fensterinitialisieren(e0);fensterinitialisieren(f0);fensterinitialisieren(g0);PROCfenstergroessenbestimmen:IFxsize<>c0ORysize<>d0THENi0;c0:=xsize;d0:=ysizeEND IF.i0:fenstergroessesetzen(e0,1,2,xsize-1,ysize-1);fenstergroessesetzen(f0,1,2,b0,ysize-2);fenstergroessesetzen(g0,b0+1,2,xsize-b0-1,ysize-2);fenstergroessesetzen(h0,1,ysize,xsize-1,1);dialogfenster(g0);anzeigefenster(g0);uebersichtsfenster(e0).END PROCfenstergroessenbestimmen;FENSTER PROCfensterrechts:g0END PROCfensterrechts;FENSTER PROCfensterlinks:f0END PROCfensterlinks;FENSTER PROCfensterganz:e0END PROCfensterganz;LETj0=
+#1001#"Keine Datei zur Auswahl vorhanden.",k0=
+#1002#"Name der Datei: ";
+SATZ VARl0;THESAURUS VARm0;TEXT VARn0,o0,p0;LETq0="",r0=""27"z",s0=""5"";LETt0=11,u0=0;DATASPACE VARv0;INITFLAG VARw0;BOUND STRUCT(TEXTname,x0,y0)VARz0;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,PROC(TEXT CONST)d1):ausfuehrung(a1,b1,c1,niltask,PROC(TEXT CONST)d1)END PROCausfuehrung;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,TASK CONSTe1,PROC(TEXT CONST)d1):enablestop;f1;IFo0=q0THENerrorstop(q0)ELIFg1THENo0:=subtext(o0,3);h1(all,c1,e1);auswahlanbieten("EUDAS-Dateiauswahl",g0,i1,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)j1);bittewarten;k1(PROC(TEXT CONST)d1)ELSElastparam(o0);d1(o0)END IF.f1:IFexists(std)AND(c1=0CORtype(old(std))=c1)THENo0:=stdELSEo0:=q0END IF;editget(a1,o0,"z","GET/Dateiname").i1:IFb1THEN1ELSE1024END IF.END PROCausfuehrung;PROCaufarchiv(PROC(TEXT CONST)d1,THESAURUS CONSTl1):o0:=q0;editget(k0,o0,"z","GET/Dateiname");IFo0=q0THENerrorstop(q0)ELIFg1THENm1ELSElastparam(o0);d1(o0)END IF.m1:o0:=subtext(o0,3);h1(l1,0,niltask);auswahlanbieten(
+"EUDAS-Archivauswahl",g0,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)j1);k1(PROC(TEXT CONST)d1).END PROCaufarchiv;PROCh1(THESAURUS CONSTn1,INT CONSTc1,TASK CONSTe1):BOOL CONSTo1:=pos(o0,"*")=0;p1;q1;r1;s1.p1:INT VARt1:=1,u1:=0;satzinitialisieren(l0);REPget(n1,n0,u1);IFn0=q0THEN LEAVEp1ELIFv1ANDw1THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.v1:c1=0CORtype(old(n0))=c1.w1:o1COR(n0LIKEo0).q1:p0:=q0;INT VARx1;FORx1FROM1UPTOanzahldateienREP INT CONSTy1:=feldindex(l0,eudasdateiname(x1));IFy1>0THENp0CATcode(y1)END IF END REP.r1:IF NOTisniltask(e1)THENm0:=ALLe1;z1END IF.z1:u1:=0;REPget(m0,n0,u1);IFn0=q0THEN LEAVEz1ELIFw1CANDa2CANDb2THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.a2:NOT(n1CONTAINSn0).b2:c1=0CORc2(n0,e1)=c1.s1:IFt1=1THENdialog(j0);errorstop(q0)END IF.END PROCh1;INT PROCc2(TEXT CONSTd2,TASK CONSTe2):enablestop;INT VARf2,g2;IF NOTinitialized(w0)THENv0:=nilspaceEND IF;forget(v0);v0:=nilspace;z0:=v0;z0.name:=d2;z0.x0:=writepassword;z0.y0:=readpassword;call(e2,t0,v0,f2);IFf2<>u0THENg2
+:=0ELSEg2:=type(v0)END IF;forget(v0);g2END PROCc2;BOOL PROCg1:subtext(o0,1,2)=r0END PROCg1;PROCj1(TEXT VARh2,INT CONSTt1):IFt1<256THENfeldlesen(l0,t1,h2);IFpos(p0,code(t1))>0THENh2:="<!> "+textdarstellung(h2)ELIFh2<>q0THENh2:=textdarstellung(h2)END IF ELSEh2:=q0END IF END PROCj1;PROCk1(PROC(TEXT CONST)d1):INT VARt1:=1;REP IFwahl(t1)=0THEN LEAVEk1ELSEfeldlesen(l0,wahl(t1),n0);i2;lastparam(n0);d1(n0)END IF;t1INCR1END REP.i2:IFonlineTHENfensterveraendert(h0);cursor(1,ysize);out(s0);out(text(t1));out(". ");out(textdarstellung(n0))END IF.END PROCk1;LETj2=
+#1003#"EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?",k2=
+#1004#"ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ?";
+INT VARl2;BOOL VARm2,n2;PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTo2,BOOL CONSTaendern):INT VARp2,q2,r2,s2;fenstergroesse(fenster,p2,q2,r2,s2);fensterveraendert(fenster);enablestop;t2;m2:=aendern;REPu2;openeditor(groesstereditor+1,f,aendern,p2,q2,r2,s2);edit(groesstereditor,"eqvw19dpgn"9"?hF",PROC(TEXT CONST)v2);w2END REP.t2:IFaendernANDq2<3ANDs2>22ANDp2<14ANDr2>75THENn2:=TRUE ELSEn2:=FALSE END IF.w2:SELECTl2OF CASE0:LEAVEeditCASE1:hilfeanbieten(o2,fenster)CASE2:errorstop(q0)END SELECT.END PROCedit;PROCu2:IFm2THENstatusanzeigen(j2)ELSEstatusanzeigen(k2)END IF END PROCu2;PROCv2(TEXT CONSTx2):l2:=pos("q?h",x2);IFl2>0THENl2DECR1;quitELIFn2CANDx2="F"THENdo("feldnamen anzeigen");u2ELSEstdkommandointerpreter(x2);u2;bildschirmneuEND IF END PROCv2;BOOL VARy2;PROCsetcommanddialoguefalse:y2:=commanddialogue;commanddialogue(FALSE)END PROCsetcommanddialoguefalse;PROCresetcommanddialogue:commanddialogue(y2)END PROCresetcommanddialogue;LETz2=
+#1005#" Bitte warten.. ",a3=
+#1006#" neu einrichten";
+PROCbittewarten:statusanzeigen(z2)END PROCbittewarten;PROCfrageobeinrichten(TEXT CONSTd2):IF NOTja(textdarstellung(d2)+a3,"JA/einrichten")THENerrorstop(q0)END IF END PROCfrageobeinrichten;END PACKETeudasdialoghilfen;
+
+
diff --git a/app/eudas/5.3/src/eudas.4 b/app/eudas/5.3/src/eudas.4
new file mode 100644
index 0000000..7170f43
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.4
@@ -0,0 +1,134 @@
+PACKETeudassteuerungDEFINESeudas,einzelsicherung,suchen,aendern,einfuegen,prueffehlereditieren,feldstruktur,feldnamenanzeigen,formatierenautomatisch,arbeitsbereichbestimmen,dateiverwaltung,archivverwaltung:INT VARb0:=1003,c0:=3243;IFd0THENb0:=1004END IF.d0:maxintDIV2>17000.;LETe0="",f0=" ",g0=""4"",h0=""5"";FILE VARi0;DATASPACE VARj0;INT VARk0,l0:=dateiversion-1;TEXT VARm0;BOOL VARn0:=FALSE;LETo0=
+#1101#"EUDAS.Öffnen",p0=
+#1102#"EUDAS.Einzelsatz",q0=
+#1103#"EUDAS.Gesamtdatei",r0=
+#1104#"EUDAS.Drucken",s0=
+#1105#"EUDAS.Dateien",t0=
+#1106#"EUDAS.Archiv";
+LETu0=
+#1107#"EUDAS kann nicht unter EUDAS aufgerufen werden",v0=
+#1108#"Suchbedingung einstellen",w0=
+#1109#"Alle Sätze drucken",x0=
+#1110#"Alle markierten Sätze drucken",y0=
+#1111#"Aktuellen Satz drucken",z0=
+#1112#"Mit neuer Auswahl noch einmal",a1=
+#1113#""15"Akt.Datei "14"",b1=
+#1114#""15"Datum "14"";
+PROCeudas:IFaktuellereditor>0THENc1ELIFn0THENerrorstop(u0)ELSEd1END IF.d1:fenstergroessenbestimmen;page;bildschirmneu;k0:=heapsize;disablestop;n0:=TRUE;menueanbieten(ROW6TEXT:(o0,p0,q0,r0,s0,t0),fensterlinks,TRUE,PROC(INT CONST,INT CONST)e1);n0:=FALSE;enablestop;f1;page;bildschirmneuEND PROCeudas;PROCc1:TEXT VARg1:=e0;h1;f1;IFi1THEN LEAVEc1END IF;j1(FALSE);aufsatz(1);k1(g1);REPl1;uebersicht(g1,PROCm1);h1;n1UNTILo1END REP;dateienloeschen(FALSE).i1:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THEN LEAVEi1WITH TRUE END IF END REP;FALSE.l1:IFja(v0,"JA/Suchmuster")THENsuchen;allesneuEND IF.n1:IFmarkiertesaetze=0CANDq1THENr1(s1,b0,PROC(TEXT CONST)t1)ELIFmarkiertesaetze>0CANDu1THENr1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenELIFv1THENmarkierungenloeschen;markierungaendern;r1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenEND IF.q1:ja(w0,"JA/alle Saetze",FALSE).u1:ja(x0,"JA/alle markierten").v1:ja(y0,"JA/Einzelsatz drucken").o1:NOTja(z0,"JA/noch einmal",FALSE).END PROCc1;
+PROCh1:bildschirmneu;cursor(1,1);out(g0)END PROCh1;PROCt1(TEXT CONSTw1):x1;disablestop;drucke(w1);y1;h1END PROCt1;PROCe1(INT CONSTz1,a2):enablestop;SELECTz1OF CASE0:b2CASE1:c2(a2)CASE2:d2(a2)CASE3:e2(a2)CASE4:f2(a2)CASE5:dateiverwaltung(a2)CASE6:archivverwaltung(z1,a2)END SELECT.b2:IFanzahldateien=0THENg2(FALSE);h2(FALSE)ELIF NOTaendernerlaubtTHENh2(FALSE)END IF;i2;fusszeile("","",35,b1,64);fussteil(3,date).END PROCe1;PROCg2(BOOL CONSTj2):INT VARk2;waehlbar(1,4,j2);waehlbar(1,5,j2);waehlbar(1,7,j2);FORk2FROM1UPTO12REPwaehlbar(2,k2,j2)END REP;waehlbar(3,1,j2);waehlbar(3,4,j2);waehlbar(3,6,j2);waehlbar(4,1,j2)END PROCg2;PROCi2:BOOL VARj2:=anzahldateien=1ANDaendernerlaubt;waehlbar(1,6,j2);waehlbar(3,5,j2);j2:=anzahldateien>0ANDanzahldateien<10AND NOTaufkoppeldatei;waehlbar(1,2,j2);waehlbar(1,3,j2)END PROCi2;PROCh2(BOOL CONSTj2):INT VARk2;FORk2FROM8UPTO11REPwaehlbar(2,k2,j2)END REP;waehlbar(3,2,j2);waehlbar(3,3,j2)END PROCh2;LETl2=
+#1115#""15"Manager "14"",m2=
+#1116#"Manager ausschalten",n2=
+#1117#"Keine Sicherung nötig.",o2=
+#1118#"Interne Arbeitskopien löschen",p2=
+#1119#"Arbeitskopie ",q2=
+#1120#" unverändert.",r2=
+#1121#" verändert! Optionen zum Sichern:",s2=
+#1125#"Sichern unter dem neuen Namen:",t2=
+#1126#" überschreiben",u2=
+#1127#"Datei wieder sortieren",v2=
+#1128#"Notizen",w2=
+#1129#"Name Managertask:",x2=
+#1130#"Task existiert nicht !",y2=
+#1131#"Wollen Sie etwas verändern (eine Arbeitskopie anlegen)",z2=
+#1132#"Alle Markierungen gelöscht.",a3=
+#1133#"Prüfbedingungen",b3=
+#1134#"Feldnamen ändern",c3=
+#1135#"Feldtypen ändern",d3=
+#1136#"Feldnamen anfügen",e3=
+#1137#"Neuer Feldname:",f3=
+#1138#"Typwahl für Feld ",g3=
+#1139#"Neue Feldnamen",h3=
+#1140#"TEXT ",i3=
+#1141#" DIN ",j3=
+#1142#"ZAHL ",k3=
+#1143#"DATUM",l3=
+#1144#"Alte Feldreihenfolge ändern",m3=
+#1145#""7"ACHTUNG: System voll, Dateien löschen!";
+BOOL VARn3,o3:=FALSE;TASK VARp3:=niltask;TEXT VARq3:=e0;SATZ VARr3;ROW6TEXT VARs3;s3(1):=h3;s3(2):=i3;s3(3):=j3;s3(4):=k3;s3(5):=e0;s3(6):=e0;PROCc2(INT CONSTa2):SELECTa2OF CASE0:t3CASE1:u3CASE2:v3CASE3:w3CASE4:x3CASE5:y3CASE6:z3CASE7:a4CASE8:b4OTHERWISEc4END SELECT;d4;e4.t3:IFanzahldateien=0THENe1(0,0)END IF;f4;fussteil(2,l2,q3).u3:f1;j1(TRUE);IFanzahldateien>0THENpush("2")END IF.v3:g4(PROC(TEXT CONST)h4).w3:g4(PROC(TEXT CONST)i4).x3:IFaendernerlaubtTHENj4ELSEdateienloeschen(FALSE);dialog(n2)END IF;k4.j4:INT VARp1;FORp1FROM1UPTOanzahldateienREPeinzelsicherung(p1)END REP;IFja(o2,"JA/Dateien loeschen")THENl4;dateienloeschen(TRUE)END IF.k4:IFanzahldateien=0THENg2(FALSE);h2(FALSE)END IF;i2;f4.y3:m4;dialogfensterloeschen.z3:zugriff(PROC(EUDAT VAR)feldstruktur).a4:n4;dialogfensterloeschen.b4:TEXT VARo4:="";editget(w2,o4,"","GET/multi task");IFo4=e0THEN IFp4THENq4(e0,FALSE)END IF ELIFexiststask(o4)THENr4(task(o4));q4(o4,TRUE)ELSEerrorstop(x2)END IF.p4:ja(m2,"JA/manager aus").e4:IFheapsize-k0
+>4THENcollectheapgarbage;k0:=heapsizeEND IF.c4:IFa2=-1THENdialogfensterloeschen;LEAVEc2END IF.END PROCc2;PROCg4(PROC(TEXT CONST)s4):ausfuehrung(t4,TRUE,c0,p3,PROC(TEXT CONST)s4);i2;f4END PROCg4;PROCf4:TEXT VARu4:=e0;IFanzahldateien>0THENu4CAT"""";u4CATeudasdateiname(1);u4CAT""""END IF;IFanzahldateien>1THENu4CAT" .."END IF;fussteil(1,a1,u4)END PROCf4;PROCq4(TEXT CONSTv4,BOOL CONSTw4):IFw4THENp3:=task(v4)ELSEp3:=niltaskEND IF;o3:=w4;q3:=v4;fussteil(2,q3)END PROCq4;PROCf1:BOOL VARx4:=FALSE;IFaendernerlaubtTHENy4END IF.y4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THENeinzelsicherung(p1);x4:=TRUE;z4END IF END REP.z4:IFp1=1CANDstd=eudasdateiname(1)THENlastparam(e0)END IF.END PROCf1;PROCeinzelsicherung(INT CONSTp1):a5;IFinhaltveraendert(p1)THENb5ELSEdialog(c5)END IF.a5:TEXT VARc5:=p2;c5CATtextdarstellung(eudasdateiname(p1));IFinhaltveraendert(p1)THENc5CATr2ELSEc5CATq2END IF.b5:INT VARd5:=1;auswahlanbieten("WAHL.Sichern",c5,"WAHL/sichere",d5);e5.e5:TEXT VARname:=
+eudasdateiname(p1);SELECTd5OF CASE1:f5CASE3:g5END SELECT;IFd5<>2THENh5END IF.f5:forget(name,quiet).g5:editget(s2,name,"","GET/Sicherungsname");IFexists(name)ORi5THENj5END IF.i5:k5(p1)CANDexists(name,herkunft(p1)).j5:IFja(textdarstellung(name)+t2,"JA/ueber",FALSE)THENforget(name,quiet)ELSEeinzelsicherung(p1);LEAVEeinzelsicherungEND IF.h5:sichere(p1,name);l5;m5.l5:EUDAT VARn5;oeffne(n5,name);IFo5CANDp5THENbittewarten;sortiere(n5)END IF.o5:sortierreihenfolge(n5)<>e0CANDunsortiertesaetze(n5)>0.p5:ja(u2,"JA/Sicherungssortierung").m5:IFk5(p1)THENdisablestop;setcommanddialoguefalse;save(name,herkunft(p1));resetcommanddialogue;enablestop;forget(name,quiet)END IF.END PROCeinzelsicherung;PROCj1(BOOL CONSTq5):IFaendernerlaubtTHENl4END IF;dateienloeschen(TRUE);g2(FALSE);h2(FALSE);forget(j0);disablestop;n3:=q5;g4(PROC(TEXT CONST)r5);enablestop;IFanzahldateien>0THENg2(TRUE);h2(aendernerlaubt)END IF END PROCj1;PROCl4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFk5(p1)THENs5END IF END REP.s5:free(
+eudasdateiname(p1),herkunft(p1)).END PROCl4;PROCr5(TEXT CONSTw1):BOOL VARt5;TASK VARu5;v5;oeffne(w1,t5,u5).v5:IFw5ANDn3THENfrageobeinrichten(w1);EUDAT VARn5;oeffne(n5,w1);feldstruktur(n5);t5:=TRUE;u5:=niltaskELSEt5:=n3CANDja(y2,"JA/oeffne",FALSE);x5(w1,t5,u5)END IF.w5:NOTexists(w1)ANDy5.y5:NOTo3COR NOTexists(w1,p3).END PROCr5;PROCh4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kette(w1,u5)END PROCh4;PROCi4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kopple(w1,u5)END PROCi4;PROCx5(TEXT CONSTw1,BOOL CONSTz5,TASK VARu5):u5:=niltask;IFo3THENa6END IF.a6:IF NOTexists(w1)CANDexists(w1,p3)THEN IFz5THENlock(w1,p3)END IF;forget(w1,quiet);fetch(w1,p3);u5:=p3END IF.END PROCx5;BOOL PROCk5(INT CONSTp1):NOTisniltask(herkunft(p1))END PROCk5;PROCm4:notizenlesen(3,m0);DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;headline(f,v2);c6(f,m0,fensterganz,"EDIT/Notizen");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(3,m0)END IF END PROCm4;PROCc6(FILE VARf,TEXT 
+VARd6,FENSTER CONSTe6,TEXT CONSTf6):LETg6="#-#";enablestop;h6;i6;j6.h6:INT VARk6:=1,l6;REPl6:=pos(d6,g6,k6);IFl6=0THENputline(f,subtext(d6,k6))ELSEputline(f,subtext(d6,k6,l6-1))END IF;k6:=l6+3UNTILl6=0ORk6>length(d6)END REP.i6:modify(f);edit(f,e6,f6,TRUE).j6:TEXT VARm6;d6:=e0;input(f);WHILE NOTeof(f)REPgetline(f,m6);n6;d6CATm6;d6CATg6END REP.n6:IF(m6SUBlength(m6))=f0THENm6:=subtext(m6,1,length(m6)-1)END IF.END PROCc6;PROCfeldstruktur(EUDAT VARn5):INT VARo6;feldnamenlesen(n5,r3);IFp6THENq6END IF;IFr6THENs6END IF;IFja(c3,"JA/Feldtypen aendern",FALSE)THENt6END IF;feldnamenaendern(n5,r3).p6:felderzahl(r3)>0CANDja(b3,"JA/Feldnamen aendern",FALSE).r6:felderzahl(r3)=0CORja(d3,"JA/feldnamen",FALSE).q6:u6(n5);o6:=1;WHILEwahl(o6)>0REPv6;o6INCR1END REP.v6:TEXT VARw6;feldlesen(r3,wahl(o6),w6);editget(e3,w6,"","GET/feldname");feldaendern(r3,wahl(o6),w6).s6:DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;x6(f,r3);forget(b6);enablestop;feldnamenaendern(n5,r3).t6:u6(n5);o6:=
+1;WHILEwahl(o6)>0REPy6;o6INCR1END REP.y6:INT VARd5:=feldinfo(n5,wahl(o6))+2;feldlesen(r3,wahl(o6),w6);auswahlanbieten("WAHL.Typen",f3+textdarstellung(w6),"WAHL/Feldtypen",d5);feldinfo(n5,wahl(o6),d5-2).END PROCfeldstruktur;PROCu6(EUDAT CONSTn5):z6;auswahlanbieten("EUDAS-Felder",fensterrechts,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)a7).z6:INT VARo6;satzinitialisieren(b7);FORo6FROM1UPTOfelderzahl(r3)REPfeldlesen(r3,o6,m0);feldaendern(b7,o6,c7+m0)END REP.c7:"<"+s3(feldinfo(n5,o6)+2)+"> ".END PROCu6;PROCn4:enablestop;DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);headline(f,a3);notizenlesen(1,m0);disablestop;c6(f,m0,fensterganz,"EDIT/Pruefbed");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(1,m0)END IF.END PROCn4;PROCx6(FILE VARf,SATZ VARd7):enablestop;e7;f7.e7:modify(f);headline(f,g3);edit(f,fensterrechts,"EDIT/Feldnamen",TRUE).f7:INT VARo6:=felderzahl(d7);input(f);WHILE NOTeof(f)REPgetline(f,m0);n6;o6INCR1;feldaendern(d7,o6,m0)END REP.n6:IF(m0SUBlength(m0))=f0
+THENm0:=subtext(m0,1,length(m0)-1)END IF.END PROCx6;PROCd4:INT VARg7,h7;storage(g7,h7);IFh7>g7THENneuerdialog;dialog(m3)END IF END PROCd4;BOOL VARi7,j7:=FALSE,k7:=FALSE;LETl7=
+#1146#"SATZ ÄNDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",m7=
+#1147#"SATZ EINFÜGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",n7=
+#1148#"SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",o7=
+#1149#"Umschalten auf Koppeldatei ",p7=
+#1150#"Koppelfelder übernehmen",q7=
+#1151#"Ungültige Satznummer",r7=
+#1152#"Neue Satznummer:",s7=
+#1153#"wzK",t7=
+#1154#"wz";
+PROCd2(INT CONSTa2):SELECTa2OF CASE0:u7CASE1:v7CASE2:w7CASE3:x7CASE4:y7CASE5:z7CASE6:a8CASE7:b8CASE8:c8CASE9:d8CASE10:e8CASE11:f8CASE12:g8CASE13:h8CASE14:i8CASE15:j8CASE16:k8CASE17:l8OTHERWISEm8END SELECT;d4.u7:f4;fussteil(2,"","");exitzeichen(t7).v7:bittewarten;weiter(2);bildausgeben(FALSE).w7:bittewarten;zurueck(2);bildausgeben(FALSE).z7:suchen;bildausgeben(TRUE).a8:suchbedingungloeschen;bildausgeben(FALSE).x7:TEXT VARn8:=e0;editget(r7,n8,"","GET/auf Satz");INT CONSTo8:=int(n8);IFn8=e0THENbildausgeben(FALSE)ELIFlastconversionokTHENaufsatz(o8);bildausgeben(FALSE)ELSEerrorstop(q7)END IF.y7:TEXT VARp8;feldnamenlesen(1,p8);n8:=e0;editget(p8+":",n8,"","GET/auf Schluessel");aufsatz(n8);bildausgeben(FALSE).c8:einfuegen;bildausgeben(TRUE).d8:aendern;bildausgeben(TRUE).b8:markierungaendern;bildausgeben(FALSE).e8:q8;r1(r8,c0,PROC(TEXT CONST)s8);bildausgeben(TRUE).f8:q8;r1(t8,c0,PROC(TEXT CONST)holesatz);bildausgeben(TRUE).g8:TEXT VARu8:=e0;v8(u8,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder");
+IFu8<>e0THENfeldauswahl(u8)END IF;bildausgeben(TRUE).h8:w8;rollen(-23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.i8:w8;rollen(23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.j8:w8;rollen(-9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.k8:w8;rollen(9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.l8:IFaufkoppeldateiTHENx8ELSEy8END IF;IFanzahldateien>0THENbildausgeben(TRUE)END IF.x8:IF(k7ORj7)THENz8;a9ELSEaufkoppeldatei(0)END IF;i2.z8:IF NOTdateiendeCANDja(p7,"JA/uebernehmen")THENaufkoppeldatei(1)ELSEaufkoppeldatei(0)END IF.a9:j7:=FALSE;IFk7THENk7:=FALSE;aendernELSEb9(TRUE)END IF.m8:IFa2=-2THEN IFanzahldateien>0THENbildausgeben(FALSE)END IF ELSEdialogfensterloeschenEND IF.END PROCd2;PROCsuchen:disablestop;exitzeichen("");statusanzeigen(n7);suchen(PROCc9);exitzeichen(t7)END PROCsuchen;PROCc9:hilfeanbieten("EDIT/Suchen",fensterrechts)END PROCc9;PROCeinfuegen:b9(FALSE)END PROCeinfuegen;PROCb9(BOOL CONSTd9):BOOL VARe9:=d9;f9;REPstatusanzeigen(m7);IFe9THENaendern(PROCg9);e9
+:=FALSE ELSEeinfuegen(PROCg9)END IF;h9;i9END REP.i9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEb9CASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenELSEbittewarten;zurueck(2)END IF CASE3:y8;IFaufkoppeldateiTHENj7:=TRUE;LEAVEb9END IF;e9:=TRUE END SELECT.END PROCb9;PROCg9:hilfeanbieten("EDIT/Einfuegen",fensterrechts)END PROCg9;PROCf9:IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENexitzeichen(s7)ELSEexitzeichen(t7)END IF END PROCf9;PROCaendern:f9;kommandoauftastelegen("F","prueffehler editieren");REPstatusanzeigen(l7);aendern(PROCj9);h9;k9END REP.k9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEaendernCASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenEND IF;bittewarten;zurueck(2)CASE3:y8;IFaufkoppeldateiTHENk7:=TRUE;LEAVEaendernEND IF END SELECT.END PROCaendern;PROCj9:hilfeanbieten("EDIT/Aendern",fensterrechts)END PROCj9;PROCprueffehlereditieren:IFl0=dateiversionTHENmodify(i0);edit(
+i0)END IF END PROCprueffehlereditieren;PROCy8:INT VARp1:=folgedatei(0);WHILEp1>0REP IFl9THENaufkoppeldatei(p1);i2;LEAVEy8END IF;p1:=folgedatei(p1)END REP.l9:ja(o7+textdarstellung(eudasdateiname(p1)),"JA/umschalten").END PROCy8;PROCm9(TEXT CONSTm6,INT CONSTdummy):outsubtext(m6,n9);out(h0).n9:pos(m6,f0,6)+1+dummy-dummy.END PROCm9;PROCh9:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)o9)END PROCh9;PROCo9(TEXT CONSTd7,INT CONSTk6,l6):i7:=k6<3ORk6>length(d7)+l6-l6END PROCo9;PROCw8:cursor(15,24)END PROCw8;PROCs8(TEXT CONSTw1):IFexists(w1)THENp9ELSEfrageobeinrichten(w1)END IF;bittewarten;tragesatz(w1).p9:IFq9(w1)<>0THENerrorstop(r9)END IF.END PROCs8;PROCv8(TEXT VARu8,TEXT CONSTs9,t9):auswahlanbieten(s9,fensterrechts,256,t9,u8,PROC(TEXT VAR,INT CONST)u9);u8:=e0;INT VARn8:=1;WHILEwahl(n8)>0REPu8CATcode(wahl(n8));n8INCR1END REP END PROCv8;LETt4=
+#1155#"Name der Datei:",r8=
+#1156#"Name der Zieldatei:",v9=
+#1157#"Name der Verarbeitungsvorschrift:",s1=
+#1158#"Name des Druckmusters:",t8=
+#1159#"Name der Quelldatei:";
+LETg8=
+#1160#"Angezeigte Felder auswählen",w9=
+#1161#" aufsteigend sortieren";
+TEXT VARx9:=e0;INT VARy9:=0;DATASPACE VARz9;PROCe2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:b10CASE2:c10CASE3:d10CASE4:e10CASE5:f10CASE6:g10OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").c10:q8;r1(r8,c0,PROC(TEXT CONST)h10).b10:q8;r1(r8,c0,PROC(TEXT CONST)i10);dialogfensterloeschen.d10:ausfuehrung(v9,b0,PROC(TEXT CONST)j10);dialogfensterloeschen.e10:IFdateiversion<>y9THENx9:=e0;y9:=dateiversionEND IF;k1(x9);uebersicht(x9,PROCm1);dialogfensterloeschen.f10:zugriff(PROC(EUDAT VAR)k10).g10:markierungenloeschen;dialog(z2).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCe2;PROCq8:IFq9(std)<>0THENlastparam(e0)END IF END PROCq8;PROCh10(TEXT CONSTw1):BOOL VARl10;IFexists(w1)THENp9;m10ELSEfrageobeinrichten(w1);l10:=FALSE END IF;BOOL CONSTn10:=ja(o10,"JA/sortieren");bittewarten;p10;trage(w1,i0,l10);q10;IFn10THEN EUDAT VARn5;oeffne(n5,w1);sortiere(n5)END IF.p9:IFq9(w1)<>0THENerrorstop(r9)END IF.m10:l10:=ja(r10,"JA/testen").p10:IFl10THENforget(j0);j0:=nilspace;i0:=sequentialfile(output,j0);l0:=
+dateiversionELSEforget(j0);l0:=dateiversion-1END IF.q10:IFl10CANDlines(i0)>0THENdialog(text(lines(i0))+s10)END IF.END PROCh10;PROCj10(TEXT CONSTw1):IF NOTexists(w1)THENt10(w1,"EDIT/Verarbeite")END IF;x1;FILE VARf:=sequentialfile(input,w1);disablestop;verarbeite(f);y1.END PROCj10;PROCk1(TEXT VARx9):IFja(g8,"JA/Ub.Felder")THENv8(x9,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder")END IF END PROCk1;PROCm1:hilfeanbieten("UEBERSICHT",fensterganz)END PROCm1;PROCi10(TEXT CONSTw1):disablestop;z9:=nilspace;u10(w1);forget(z9)END PROCi10;PROCu10(TEXT CONSTw1):TEXT VARv10:="";FILE VARf;EUDAT VARn5;BOOL VARn10:=FALSE;enablestop;IFexists(w1)THENw10ELSEfrageobeinrichten(w1)END IF;editget(x10,v10,"","GET/kopiermuster");IFexists(v10)THENf:=sequentialfile(input,v10)ELSEy10;stdkopiermuster(w1,f)END IF;modify(f);z10;a11.w10:IFq9(w1)<>0THENerrorstop(r9)END IF;oeffne(n5,w1);IFsortierreihenfolge(n5)<>e0THENn10:=ja(o10,"JA/sortieren")END IF.y10:IFv10=e0THENf:=sequentialfile(output,z9)ELSEfrageobeinrichten(v10);f
+:=sequentialfile(output,v10)END IF.z10:edit(f,fensterganz,"EDIT/Kopiermuster",TRUE);x1;kopiere(w1,f).a11:IFn10THENoeffne(n5,w1);sortiere(n5)END IF.END PROCu10;INT PROCq9(TEXT CONSTw1):INT VARp1;FORp1FROM1UPTOanzahldateienREP IFeudasdateiname(p1)=w1THEN LEAVEq9WITHp1END IF END REP;0END PROCq9;PROCt10(TEXT CONSTw1,b11):IF NOTexists(w1)THENfrageobeinrichten(w1)END IF;FILE VARf:=sequentialfile(modify,w1);edit(f,fensterganz,b11,TRUE)END PROCt10;PROCx1:bittewarten;cursor(1,2);out(g0);bildschirmneuEND PROCx1;PROCk10(EUDAT VARn5):TEXT VARc11:=sortierreihenfolge(n5);IFc11=e0CORd11THENe11;bittewarten;sortiere(n5,c11)ELSEbittewarten;sortiere(n5)END IF.d11:ja(l3,"JA/Sortierfelder",FALSE).e11:feldnamenlesen(n5,b7);auswahlanbieten("EUDAS-Sortierfelder",fensterrechts,1024,"AUSWAHL/Sortierfelder",c11,PROC(TEXT VAR,INT CONST)a7);INT VARo6:=1;c11:=e0;WHILEwahl(o6)<>0REPc11CATcode(wahl(o6));f11;o6INCR1END REP.f11:feldlesen(b7,wahl(o6),m0);IFja(textdarstellung(m0)+w9,"JA/Sortierrichtung")THENc11CAT"+"ELSE
+c11CAT"-"END IF.END PROCk10;PROCu9(TEXT VARname,INT CONSTn8):IFn8<=anzahlfelderTHENfeldnamenlesen(n8,name)ELSEname:=e0END IF END PROCu9;LETg11=
+#1163#"Name Ausgabedatei:",h11=
+#1210#"Erzeugte Ausgabe ausdrucken",i11=
+#1211#"Erzeugte Ausgabe löschen",j11=
+#1212#"Richtung der Druckausgabe:",k11=
+#1213#"Form der Liste:",l11=
+#1214#"Anzahl Zeichen pro Zeile:",m11=
+#1215#"Eingabe ist keine gültige Zahl",o10=
+#1164#"Zieldatei anschließend sortieren",r10=
+#1165#"Prüfbedingungen testen",s10=
+#1166#"Prüffehler festgestellt",r9=
+#1167#"Zieldatei darf nicht geöffnet sein",x10=
+#1168#"Name Kopiermuster (RET=Std):";
+LETn11=
+#1169#" zeilenweise formatieren",o11=
+#1170#" seitenweise formatieren";
+LETp11=0,q11=1,r11=2;BOOL VARs11:=FALSE,t11:=FALSE;PROCf2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:u11CASE2:v11CASE3:w11CASE4:x11CASE5:y11CASE6:z11OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").u11:ausfuehrung(s1,b0,PROC(TEXT CONST)a12);dialogfensterloeschen.v11:INT VARb12:=1;auswahlanbieten("WAHL.Std-Listen",k11,"WAHL/Std-Listen",b12);c12;d12;e12;f12;x1;druckestandardlisten(b12,g12);h12.c12:TEXT VARg12:=e0;v8(g12,"EUDAS-Druckfelder","AUSWAHL/Druckfelder").d12:.e12:TEXT VARi12:=text(stdlistenbreite);editget(l11,i12,"","GET/listenbreite");INT CONSTj12:=int(i12);IF NOTlastconversionokTHENerrorstop(m11)ELSEstdlistenbreite(j12)END IF.w11:INT VARd5:=druckrichtung+1;auswahlanbieten("WAHL.Richtung",j11,"WAHL/Richtung",d5);druckrichtung(d5-1).x11:ausfuehrung(t4,b0,PROC(TEXT CONST)k12);dialogfensterloeschen.y11:ausfuehrung(t4,b0,PROC(TEXT CONST)print).z11:ausfuehrung(t4,b0,PROC(TEXT CONST)l12);dialogfensterloeschen.c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCf2;PROCy1:IFm12THENclearerror
+END IF.m12:iserrorCANDerrormessage=e0.END PROCy1;PROCa12(TEXT CONSTw1):IF NOTexists(w1)THENk12(w1)END IF;f12;x1;disablestop;drucke(w1);h12;y1.END PROCa12;PROCf12:IFdruckrichtung=r11THEN TEXT VARw1:=druckdatei;IFpos(w1,"$")>0THENw1:=e0END IF;editget(g11,w1,"","GET/Druckdatei");IFw1<>e0THENdruckdatei(w1)END IF END IF END PROCf12;PROCh12:IF NOTiserrorCANDdruckrichtung=q11CANDexists(druckdatei)THENenablestop;n12END IF.n12:FILE VARo12:=sequentialfile(input,druckdatei);edit(o12,fensterganz,"EDIT/Druckausgabe",TRUE);IFja(h11,"JA/Ausgabe drucken",FALSE)THENprint(druckdatei)END IF;IFja(i11,"JA/Ausgabe loeschen",FALSE)THENforget(druckdatei,quiet)END IF.END PROCh12;PROCk12(TEXT CONSTw1):t10(w1,"EDIT/Druckmuster")END PROCk12;PROCprint(TEXT CONSTw1):do("print ("+textdarstellung(w1)+")")END PROCprint;PROCl12(TEXT CONSTw1):IFja(textdarstellung(w1)+n11,"JA/zeilenform")THENp12END IF;IFja(textdarstellung(w1)+o11,"JA/seitenform")THENseitenformatierenEND IF.p12:IFs11THENautoform(w1)ELSElineform(w1)END IF;
+page;bildschirmneu.seitenformatieren:IFt11THENautopageform(w1)ELSEpageform(w1)END IF;bildschirmneu.END PROCl12;PROCformatierenautomatisch(BOOL CONSTq12,r12):s11:=q12;t11:=r12END PROCformatierenautomatisch;INITFLAG VARs12;TEXT VARt12;LETu12=
+#1171#""15"Bereich "14"",v12=
+#1172#"Neuer Name:",w12=
+#1173#"Zieldatei:",x12=
+#1174#"belegt ",y12=
+#1175#"KB.",z12=
+#1176#" existiert nicht.",a13=
+#1177#" in dieser Task löschen";
+PROCdateiverwaltung(INT CONSTa2):enablestop;SELECTa2OF CASE0:a10CASE1:b13CASE2:c13CASE3:d13CASE4:e13CASE5:f13CASE6:g13OTHERWISEc4END SELECT;d4.a10:arbeitsbereichbestimmen;fussteil(2,"","").g13:ausfuehrung(PROC(TEXT CONST)h13).d13:ausfuehrung(PROC(TEXT CONST)i13).c13:ausfuehrung(PROC(TEXT CONST)j13).b13:disablestop;DATASPACE VARk13:=nilspace;FILE VARf:=sequentialfile(output,k13);list(f);IF NOTiserrorTHENedit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);enablestop;l13.e13:ausfuehrung(PROC(TEXT CONST)m13).f13:ausfuehrung(PROC(TEXT CONST)n13).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCdateiverwaltung;PROCarbeitsbereichbestimmen:IF NOTinitialized(s12)THENo13END IF;fussteil(1,u12,t12).o13:IFstation(myself)<>0THENt12:=text(station(myself))+"/"""ELSEt12:=""""END IF;t12CATname(myself);t12CAT"""".END PROCarbeitsbereichbestimmen;PROCl13:WHILEgetcharety<>e0REP END REP END PROCl13;PROCh13(TEXT CONSTw1):bittewarten;IFtype(old(w1))=c0THENreorganisiere(w1)ELSEreorganize(w1)END IF 
+END PROCh13;PROCi13(TEXT CONSTw1):TEXT VARp13:=w1;IFexists(w1)THENeditget(v12,p13,"","GET/rename")END IF;rename(w1,p13)END PROCi13;PROCj13(TEXT CONSTw1):IFq13THENerrorstop(r9)ELIFexists(w1)CANDr13THENforget(w1,quiet)END IF.q13:q9(w1)<>0.r13:ja(textdarstellung(w1)+a13,"JA/forget",FALSE).END PROCj13;PROCm13(TEXT CONSTw1):TEXT VARs13:=e0;editget(w12,s13,"","GET/copy");copy(w1,s13)END PROCm13;PROCn13(TEXT CONSTw1):dialog(textdarstellung(w1));IFexists(w1)THENout(x12);put(storage(old(w1)));out(y12)ELSEout(z12)END IF END PROCn13;TEXT VARt13:=e0,u13:="ARCHIVE";INT VARv13:=0;THESAURUS VARw13;BOOL VARx13,y13:=TRUE;LETz13=
+#1182#""15"Ziel "14"",a14=
+#1183#"Archiv heisst ",b14=
+#1184#"Name des Archivs:",c14=
+#1185#"Name Zielarchiv:",d14=
+#1186#"Nr. der Zielstation (od. RETURN):",e14=
+#1187#"Art des Zielarchivs:",f14=
+#1188#"Diskette neu formatieren",g14=
+#1189#"Neuer Archivname:",h14=
+#1190#" in dieser Task überschreiben",i14=
+#1191#" auf Archiv löschen",j14=
+#1192#"Archiv ",k14=
+#1193#" überschreiben",l14=
+#1194#"Diskette eingelegt",m14=
+#1195#" auf Archiv überschreiben",n14=
+#1196#"Mögliche Diskettenformate: ";
+LETo14=
+#1197#"Passwort: ",p14=
+#1198#"Passwort stimmt nicht mit der ersten Eingabe überein",q14=
+#1199#"Passwort zur Kontrolle bitte nochmal eingeben:",r14=
+#1200#"Passwort löschen",s14=
+#1201#"Unzulässige Stationsnummer",t14=
+#1202#"Angegebene Task ist kein Manager";
+ROW4TEXT VARu14;u14(1):="ARCHIVE";u14(2):="PUBLIC";u14(3):="ARCHIVE360";u14(4):="DOS";PROCarchivverwaltung(INT CONSTz1,a2):enablestop;SELECTa2OF CASE0:v14CASE1:w14CASE2:x14CASE3:y14CASE4:z14CASE5:a15CASE6:b15CASE7:c15CASE8:d15CASE9:e15OTHERWISEf15END SELECT;d4.v14:arbeitsbereichbestimmen;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);fussteil(2,z13,g15+u13);x13:=FALSE.z14:IFy13THENh15END IF;bittewarten;w13:=ALLi15;ausfuehrung(PROC(TEXT CONST)j15).y14:disablestop;k15;bittewarten;w13:=ALLi15;IFl15THENw13:=ALLi15END IF;enablestop;aufarchiv(PROC(TEXT CONST)m15,w13).a15:IFy13THENh15END IF;bittewarten;w13:=ALLi15;aufarchiv(PROC(TEXT CONST)a15,w13).w14:k15;disablestop;bittewarten;DATASPACE VARk13:=nilspace;f:=sequentialfile(output,k13);list(f,i15);IFl15THENlist(f,i15)END IF;IF NOTiserrorTHENmodify(f);toline(f,1);writerecord(f,headline(f));headline(f,e0);edit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);l13;enablestop.x14:k15;n15;FILE VARf:=sequentialfile(output,o15);disablestop;
+bittewarten;list(f,i15);IFl15THENlist(f,i15)END IF;IFiserrorTHENforget(o15,quiet)END IF;enablestop;modify(f);insertrecord(f);writerecord(f,headline(f));print(o15);forget(o15,quiet).n15:INT VARk2:=0;TEXT VARo15;REPk2INCR1;o15:="Archivliste "+text(k2)UNTIL NOTexists(o15)END REP.b15:k15;IFp15CORq15CANDr15THEN LEAVEb15END IF;BOOL CONSTs15:=ja(f14,"JA/format");t15;u15.p15:NOTja(l14,"JA/eingelegt").q15:reserve("",i15);bittewarten;disablestop;w13:=ALLi15;BOOL CONSTd5:=l15;clearerror;enablestop;d5.r15:NOTja(j14+textdarstellung(t13)+k14,"JA/archiv loeschen").t15:editget(g14,t13,"","GET/Archivname");reserve(t13,i15).u15:IFs15THENv15;w15ELSEx15END IF.x15:bittewarten;disablestop;setcommanddialoguefalse;clear(i15);resetcommanddialogue.v15:INT VARstd:=1;auswahlanbieten("WAHL.Format",n14,"WAHL/format",std);stdDECR1.w15:bittewarten;disablestop;setcommanddialoguefalse;format(std,i15);resetcommanddialogue;enablestop.c15:INT VARy15:=1;IFx13THENrelease(i15);x13:=FALSE END IF;auswahlanbieten("WAHL.Ziel",
+e14,"WAHL/zielarchiv",y15);TEXT VARz15:=u14(y15);IFy15>1THENa16END IF;b16;c16;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);bildschirmneu;fussteil(2,g15+u13).a16:editget(c14,z15,"","GET/Zielarchiv");IFz15=e0THEN LEAVEc15END IF;u14(y15):=z15.b16:TEXT VARd16:=text(station(myself));IFstation(myself)<>0THENeditget(d14,d16,"","GET/Zielstation")END IF.c16:v13:=int(d16);IF NOTlastconversionokTHENerrorstop(s14)END IF;u13:=z15;y13:=y15=1ORy15=3;r4(i15).g15:IFv13=0THENe0ELSEtext(v13)+"/"END IF.e15:TEXT VARe16:=e0;editget(b14,e16,"","GET/Archivname");reserve(e16,i15);x13:=TRUE.f15:IFa2=-1THEN IFx13THENrelease(i15)END IF;dialogfensterloeschenEND IF.END PROCarchivverwaltung;TASK PROCi15:IFv13=0THENtask(u13)ELSEv13/u13END IF END PROCi15;PROCr4(TASK CONSTf16):INT VARk2;IFstation(f16)=station(myself)THEN FORk2FROM1UPTO5REP IFstatus(f16)=2ORstatus(f16)=6THEN LEAVEr4END IF;pause(10)END REP;errorstop(t14)END IF END PROCr4;PROCh15:TEXT VARg14:=t13;editget(b14,g14,"","GET/Archivname");IF NOTx13ORg14<>t13THEN
+reserve(g14,i15);x13:=TRUE END IF;t13:=g14END PROCh15;PROCk15:IF NOTx13ANDy13THENreserve(t13,i15);x13:=TRUE END IF END PROCk15;BOOL PROCl15:IFy13ANDiserrorTHEN TEXT CONSTg16:=errormessage;IFsubtext(g16,1,14)=a14CANDsubtext(g16,16,20)<>"?????"THENclearerror;h16;LEAVEl15WITH TRUE END IF END IF;FALSE.h16:t13:=subtext(g16,16,length(g16)-1);reserve(t13,i15).END PROCl15;PROCj15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORi16THENj16;bittewarten;setcommanddialoguefalse;save(w1,i15);resetcommanddialogueEND IF.i16:ja(textdarstellung(w1)+m14,"JA/save",FALSE).j16:INT CONSTn8:=q9(w1);IFn8>0CANDaendernerlaubtCANDinhaltveraendert(n8)THENeinzelsicherung(n8)END IF.END PROCj15;PROCm15(TEXT CONSTw1):disablestop;IF NOTexists(w1)CORk16THENbittewarten;setcommanddialoguefalse;fetch(w1,i15);resetcommanddialogueEND IF.k16:ja(textdarstellung(w1)+h14,"JA/fetch",FALSE).END PROCm15;PROCa15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORa15THENbittewarten;setcommanddialoguefalse;erase(w1,i15);
+resetcommanddialogueEND IF.a15:ja(textdarstellung(w1)+i14,"JA/erase",FALSE).END PROCa15;PROCd15:BOUND ROW2TEXT VARl16;DATASPACE VARb6:=nilspace;l16:=b6;disablestop;m16(o14,l16(1));IFl16(1)=e0THENn16ELSEo16END IF;forget(b6).n16:IFja(r14,"JA/pw loeschen")THENsetcommanddialoguefalse;enterpassword(e0);resetcommanddialogueEND IF.o16:m16(q14,l16(2));IFl16(1)<>l16(2)THENerrorstop(p14)ELSEsetcommanddialoguefalse;enterpassword(l16(1));resetcommanddialogueEND IF.END PROCd15;PROCm16(TEXT CONSTp16,TEXT VARq16):enablestop;dialog(p16);getsecretline(q16)END PROCm16;SATZ VARb7;PROCa7(TEXT VARr16,INT CONSTs16):IFs16<=256THENfeldlesen(b7,s16,r16)ELSEr16:=e0END IF END PROCa7;PROCfeldnamenanzeigen:IFanzahlfelder>0THENt16;u16;v16END IF.t16:INT VARo6;satzinitialisieren(b7,anzahlfelder);FORo6FROM1UPTOanzahlfelderREPfeldnamenlesen(o6,m0);feldaendern(b7,o6,m0)END REP.u16:auswahlanbieten("EUDAS-Editfelder",fensterrechts,"AUSWAHL/Feldnamen",PROC(TEXT VAR,INT CONST)a7).v16:INT VARs16:=1;WHILEwahl(s16)>0REP IFs16>
+1THENtype(f0)END IF;feldnamenlesen(wahl(s16),m0);type("<");type(m0);type(">");s16INCR1END REP.END PROCfeldnamenanzeigen;PROCr1(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,TRUE,w16,PROC(TEXT CONST)s4)END PROCr1;PROCausfuehrung(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,FALSE,w16,PROC(TEXT CONST)s4)END PROCausfuehrung;PROCausfuehrung(PROC(TEXT CONST)s4):ausfuehrung(t4,0,PROC(TEXT CONST)s4)END PROCausfuehrung;END PACKETeudassteuerung;
+
diff --git a/app/eudas/5.3/src/eudas.alt b/app/eudas/5.3/src/eudas.alt
new file mode 100644
index 0000000..41ca9b0
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.alt
@@ -0,0 +1,44 @@
+PACKET eudas alt nach neu 
+ 
+  DEFINES 
+ 
+  eudas alt nach neu : 
+ 
+ 
+DATASPACE VAR scratch; 
+ 
+PROC eudas alt nach neu (TEXT CONST datei alt, datei neu) :
+
+  IF exists (datei neu) THEN
+    errorstop ("Zieldatei existiert bereits")
+  ELSE
+    FILE VAR f := sequential file (input, datei alt);
+    forget (scratch); scratch := nilspace;
+    BOUND TEXT VAR zeile := scratch;
+    BOUND SATZ VAR neu := scratch;
+    zieldatei einrichten;
+    kopieren;
+    forget (scratch)
+  END IF .
+
+zieldatei einrichten :
+  getline (f, zeile);
+  IF (zeile ISUB 1) < 3 OR (zeile ISUB 1) > 256 THEN
+    errorstop ("Ausgangsdatei ist keine EUDAS-Datei")
+  END IF;
+  EUDAT VAR e;
+  oeffne (e, datei neu);
+  feldnamen aendern (e, neu) .
+
+kopieren :
+  WHILE NOT eof (f) REP
+    getline (f, zeile);
+    satz einfuegen (e, neu);
+    cout (satznr (e));
+    weiter (e)
+  END REP .
+
+END PROC eudas alt nach neu;
+
+END PACKET eudas alt nach neu; 
+
diff --git a/app/eudas/5.3/src/eudas.dateien.05 b/app/eudas/5.3/src/eudas.dateien.05
new file mode 100644
index 0000000..b4a57e5
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.dateien.05
@@ -0,0 +1,1690 @@
+PACKET eudas dateien
+
+(*************************************************************************)
+(*                                                                       *)
+(*     EUDAS-Dateien als indexsequentielle Dateien                       *)
+(*                                                                       *)
+(*     Version 05                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 25.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  EUDAT,
+(*dump,   Test *)
+  oeffne,
+  satznr,
+  dateiende,
+  saetze,
+  auf satz,
+  weiter,
+  zurueck,
+  satz lesen,
+  satz aendern,
+  satz loeschen,
+  satz einfuegen,
+  feld lesen,
+  feld aendern,
+  feld bearbeiten,
+  felderzahl,
+  feldnamen lesen,
+  feldnamen aendern,
+  notizen lesen,
+  notizen aendern,
+  feldinfo,
+  automatischer schluessel,
+  dezimalkomma,
+  wert berechnen,
+  reorganisiere,
+  sortiere,
+  sortierreihenfolge,
+  unsortierte saetze :
+
+
+LET
+  maxhash = 531,
+  maxindex = 121,
+  maxsatz = 5000,
+  eudat typ = 3243,
+  maxeintrag = 64,
+  dreiviertel maxeintrag = 48;
+
+LET
+  INTVEC = TEXT,
+
+  INDEX = STRUCT
+    (INT vorgaenger, nachfolger,
+    INT eintraege, stelle,
+    INTVEC satzindex),
+
+  EINTRAG = STRUCT
+    (INT vorgaenger, nachfolger, indexblock, attribut,
+    SATZ satz),
+
+  DATEI = STRUCT 
+    (INT felderzahl,
+    SATZ feldnamen,
+    INTVEC feldinfo,
+    TEXT sortierfelder,
+    INT letzter index, indexblocks, erster leerindex,
+    INT erster leersatz, anz satzeintraege,
+    INT anz saetze, satznr,
+    INT indexzeiger, indexstelle, satzzeiger,
+    INT anz unsortierte, schluesselzaehler,
+    ROW 3 TEXT notizen,
+    ROW maxhash INT hashliste,
+    ROW maxindex INDEX index,
+    ROW maxsatz EINTRAG ablage);
+
+TYPE EUDAT = BOUND DATEI;
+
+LET
+  niltext = "";
+
+LET
+  datei ist keine eudas datei =  #201#
+    "Datei ist keine EUDAS-Datei",
+  inkonsistente datei =  #202#
+    "inkonsistente EUDAS-Datei",
+  eudas datei voll =  #203#
+    "EUDAS-Datei voll",
+  nicht erlaubtes dezimalkomma =  #204#
+    "Nicht erlaubtes Dezimalkomma";
+
+TEXT VAR
+   feldpuffer;
+
+TEXT VAR
+  inttext := "  ";
+
+INTVEC CONST
+  blockreservierung := intvec (maxeintrag, 1);
+
+
+(*************************** Test-Dump ***********************************)
+(*
+PROC dump (EUDAT CONST datei, TEXT CONST file) :
+
+  FILE VAR f := sequential file (output, file);
+  idump (CONCR (datei), f)
+
+END PROC dump;
+
+PROC idump (DATEI CONST datei, FILE VAR f) :
+
+  put (f, "Felderzahl:"); put (f, datei. felderzahl); line (f);
+  INT VAR i; putline (f, "feldnamen:");
+  FOR i FROM 1 UPTO felderzahl (datei. feldnamen) REP
+    TEXT VAR feld; feld lesen (datei. feldnamen, i, feld);
+    write (f, feld); write (f, ",")
+  END REP; line (f); putline (f, "feldinfo:");
+  FOR i FROM  1 UPTO length (datei. feldinfo) DIV 2 REP
+    put (f, datei. feldinfo ISUB i)
+  END REP; line (f);
+  put (f, "letzter index:"); put (f, datei. letzter index);
+  put (f, "indexblocks:"); put (f, datei. indexblocks);
+  put (f, "erster leerindex:"); put (f, datei. erster leerindex); line (f);
+  put (f, "erster leersatz:"); put (f, datei. erster leersatz);
+  put (f, "anz satzeintraege:"); put (f, datei. anz satzeintraege); line (f);
+  put (f, "anz saetze:"); put (f, datei. anz saetze);
+  put (f, "satznr:"); put (f, datei.satznr); line (f);
+  put (f, "indexzeiger:"); put (f, datei. indexzeiger);
+  put (f, "indexstelle:"); put (f, datei. indexstelle);
+  put (f, "satzzeiger:"); put (f, datei. satzzeiger); line (f);
+  put (f, "anz unsortierte:"); put (f, datei. anz unsortierte); line (f);
+  ROW 10 INT VAR anzahl ketten;
+  FOR i FROM 1 UPTO 10 REP anzahl ketten (i) := 0 END REP;
+  FOR i FROM 1 UPTO maxhash REP
+    INT VAR laenge := 0;
+    laenge der hashkette bestimmen;
+    IF laenge > 10 THEN laenge := 10 END IF;
+    IF laenge > 0 THEN anzahl ketten (laenge) INCR 1 END IF
+  END REP;
+  put (f, "Hash:");
+  FOR i FROM 1 UPTO 10 REP put (f, anzahl ketten (i)) END REP; line (f);
+  FOR i FROM 1 UPTO datei. indexblocks REP
+    put (f, "INDEX"); put (f, i); put (f, "vor:"); put (f,
+    datei. index (i). vorgaenger); put (f, "nach:"); put (f, 
+    datei. index (i). nachfolger); put (f, "eintraege:"); put (f,
+    datei. index (i). eintraege); line (f); INT VAR j;
+    FOR j FROM 1 UPTO length (datei. index (i). satzindex) DIV 2 REP
+      put (f, datei. index (i). satzindex ISUB j)
+    END REP;
+    line (f)
+  END REP;
+  FOR i FROM 1 UPTO datei. anz satzeintraege REP
+    put (f, "SATZ"); put (f,i); put (f, "vor:"); put (f,
+    datei. ablage (i). vorgaenger); put (f, "nach:"); put (f,
+    datei. ablage (i). nachfolger); put (f, "index:"); put (f,
+    datei. ablage (i). indexblock); put (f, "attr:"); put (f,
+    datei. ablage (i). attribut); line (f);
+    FOR j FROM 1 UPTO felderzahl (datei. ablage (i). satz) REP
+      feld lesen (datei. ablage (i). satz, j, feld); 
+      write (f, feld); write (f, ",")
+    END REP; cout (i);
+    line (f)
+  END REP .
+
+laenge der hashkette bestimmen :
+  INT VAR index := datei. hashliste (i);
+  WHILE index <> 0 REP
+    index := datei. ablage (index). vorgaenger;
+    laenge INCR 1
+  END REP .
+
+END PROC i dump;
+*)
+
+(**************************** INTVEC *************************************)
+
+(* An Stelle von maximal dimensionierten ROW max INT werden an ver-      *)
+(* schiedenen Stellen TEXTe mit eingeschriebenen Integern verwendet.     *)
+(* Auf diese Art und Weise werden auch das Einfuegen und Loeschen, sowie *)
+(* das Aufsplitten und Zusammenfuegen effizienter realisiert.            *)
+
+LET
+  empty intvec = "";
+
+TEXT VAR 
+  buffer;
+
+INTVEC PROC intvec (INT CONST length, value) :
+
+  replace (inttext, 1, value);
+  length * inttext
+
+END PROC intvec;
+
+PROC insert (INTVEC VAR vector, INT CONST pos, value) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (vector) + 1 THEN
+    subscript overflow
+  ELSE
+    replace (inttext, 1, value);
+    buffer := subtext (vector, begin);
+    vector := subtext (vector, 1, begin - 1);
+    vector CAT inttext;
+    vector CAT buffer
+  END IF
+
+END PROC insert;
+
+PROC delete (INTVEC VAR vector, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin >= length (vector) THEN
+    subscript overflow
+  ELSE
+    buffer := subtext (vector, begin + 2);
+    vector := subtext (vector, 1, begin - 1);
+    vector CAT buffer
+  END IF
+
+END PROC delete;
+
+INT PROC pos (INTVEC CONST vector, INT CONST value) :
+
+  replace (inttext, 1, value);
+  INT VAR begin := 1;
+  REP
+    begin := pos (vector, inttext, begin) + 1
+  UNTIL (begin AND 1) = 0 OR begin = 1 END REP;
+  begin DIV 2
+
+END PROC pos;
+
+PROC split up (INTVEC VAR source, dest, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (source) + 1 THEN
+    subscript overflow
+  ELSE
+    dest := subtext (source, begin);
+    source := subtext (source, 1, begin - 1)
+  END IF
+
+END PROC split up;
+
+PROC split down (INTVEC VAR source, dest, INT CONST pos) :
+
+  INT CONST begin := pos + pos - 1;
+  IF begin < 1 THEN
+    subscript underflow
+  ELIF begin > length (source) + 1 THEN
+    subscript overflow
+  ELSE
+    dest := subtext (source, 1, begin - 1);
+    source := subtext (source, begin)
+  END IF
+
+END PROC split down;
+
+.
+subscript overflow :
+  errorstop (9, niltext) .
+
+subscript underflow :
+  errorstop (10, niltext) .
+
+
+(************************** Datei oeffnen ********************************)
+
+PROC initialisiere eudat (DATEI VAR datei) :
+
+  datei. felderzahl := 0;
+  datei. feldinfo := empty intvec;
+  satz initialisieren (datei. feldnamen);
+  datei. sortierfelder := niltext;
+  datei. letzter index := 1;
+  datei. indexblocks := 1;
+  datei. erster leersatz := 0;
+  datei. erster leerindex := 0;
+  datei. anz saetze := 0;
+  datei. anz satzeintraege := 1;
+  datei. anz unsortierte := 0;
+  datei. notizen (1) := niltext;
+  datei. notizen (2) := niltext;
+  datei. notizen (3) := niltext;
+  datei. satznr := 1;
+  datei. indexzeiger := 1;
+  datei. indexstelle := 1;
+  datei. satzzeiger := 1;
+  datei. index (1). satzindex := blockreservierung;
+  datei. index (1) := INDEX : (0, 0, 1, 1, intvec(1, 1));
+  INT VAR i;
+  FOR i FROM 1 UPTO maxhash REP
+    datei. hashliste (i) := 0
+  END REP;
+  datei. ablage (1) := EINTRAG : (0, 0, 1, 0, leersatz) .
+
+leersatz :
+  datei. feldnamen .
+
+END PROC initialisiere eudat;
+
+PROC oeffne (EUDAT VAR datei, TEXT CONST dateiname) :
+
+  enable stop;
+  IF NOT exists (dateiname) THEN
+    CONCR (datei) := new (dateiname);
+    initialisiere eudat (CONCR (datei));
+    type (old (dateiname), eudat typ)
+  ELIF type (old (dateiname)) = eudat typ THEN
+    CONCR (datei) := old (dateiname)
+  ELSE
+    errorstop (datei ist keine eudas datei)
+  ENDIF
+
+END PROC oeffne;
+
+PROC oeffne (EUDAT VAR datei, DATASPACE CONST ds) :
+
+  IF type (ds) < 0 THEN
+    CONCR (datei) := ds;
+    initialisiere eudat (CONCR (datei));
+    type (ds, eudat typ)
+  ELIF type (ds) = eudat typ THEN
+    CONCR (datei) := ds
+  ELSE
+    errorstop (datei ist keine eudas datei)
+  END IF
+
+END PROC oeffne;
+
+
+(************************* Feldzugriffe **********************************)
+
+PROC feld lesen (EUDAT CONST datei, INT CONST feldnr, TEXT VAR inhalt) :
+
+  feld lesen (aktueller satz, feldnr, inhalt) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld lesen;
+
+PROC feld aendern (EUDAT VAR datei, INT CONST feldnr, 
+                                    TEXT CONST neuer inhalt) :
+
+  IF nicht hinter letztem satz THEN
+    aktueller satz unsortiert (CONCR (datei));
+    moeglicherweise schluessel aendern;
+    feld aendern (aktueller satz, feldnr, neuer inhalt)
+  END IF .
+
+nicht hinter letztem satz :
+  datei. satzzeiger <> 1 .
+
+moeglicherweise schluessel aendern :
+  IF feldnr = 1 THEN
+    disable stop;
+    schluessel aendern (CONCR (datei), hashindex (neuer inhalt))
+  END IF .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld aendern;
+
+INT PROC felderzahl (EUDAT CONST datei) :
+
+  datei. felderzahl
+
+END PROC felderzahl;
+
+PROC feld bearbeiten (EUDAT CONST datei, INT CONST feldnr,
+                      PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  feld bearbeiten (aktueller satz, feldnr,
+                   PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC feld bearbeiten;
+
+
+(************************* Feldinformationen *****************************)
+
+(* Jedes Feld der Datei hat einen Namen und eine Typinformation. Die     *)
+(* Anzahl der vorhandenen Felder richtet sich nach dem hoechsten ver-    *)
+(* gebenen Feldnamen. 'feldinfo' kann folgende Werte annehmen :          *)
+(*  -1 : normales Textfeld                                               *)
+(*   0 : Textfeld, das nach DIN-Norm verglichen wird                     *)
+(*   1 : Zahlfeld (alle irrelevanten Zeichen werden ignoriert)           *)
+(*   2 : Datum mit einer Laenge von 8 Zeichen                            *)
+(* Das Feldinfo eines noch nicht eingerichteten Feldes fuehrt zu         *)
+(* einer Fehlermeldung.                                                  *)
+
+PROC feldnamen lesen (EUDAT CONST datei, SATZ VAR namen) :
+
+  namen := datei. feldnamen
+
+END PROC feldnamen lesen;
+
+PROC feldnamen aendern (EUDAT VAR datei, SATZ CONST neue namen) :
+
+  datei. feldnamen := neue namen;
+  INT CONST neue felder := felderzahl (neue namen);
+  IF neue felder > datei. felderzahl THEN
+    feldinfo erweitern;
+    datei. felderzahl := neue felder
+  END IF .
+
+feldinfo erweitern :
+  datei. feldinfo CAT intvec (fehlende zeilen, - 1) .
+
+fehlende zeilen :
+  neue felder - length (datei. feldinfo) DIV 2.
+
+END PROC feldnamen aendern;
+
+INT PROC feldinfo (EUDAT CONST datei, INT CONST feldnr) :
+
+  datei. feldinfo ISUB feldnr
+
+END PROC feldinfo;
+
+PROC feldinfo (EUDAT VAR datei, INT CONST feldnr, zeilen) :
+
+  replace (datei. feldinfo, feldnr, zeilen);
+  IF pos (datei. sortierfelder, code (feldnr)) > 0 THEN
+    datei. anz unsortierte := datei. anz saetze
+  END IF
+
+END PROC feldinfo;
+
+
+(*************************** Positionsabfragen ***************************)
+
+INT PROC satznr (EUDAT CONST datei) :
+
+  datei. satznr
+
+END PROC satznr;
+
+BOOL PROC dateiende (EUDAT CONST datei) :
+
+  datei. satznr > datei. anz saetze
+
+END PROC dateiende;
+
+INT PROC saetze (EUDAT CONST datei) :
+
+  datei. anz saetze
+
+END PROC saetze;
+
+
+(***************************** Positionieren *****************************)
+
+(* Positioniert werden kann nach der Satznummer oder nach dem ersten     *)
+(* Feld. Das erste Feld kann durch eine Hashtabelle schnell gefunden     *)
+(* werden. In der Hashtabelle sind die Saetze nach absoluten Positionen  *)
+(* eingetragen und nicht nach Satznummern. Ueber den Rueckverweis auf    *)
+(* den Indexblock kann die Satznummer zu einem gegebenen Satz gefunden   *)
+(* werden.                                                               *)
+
+PROC neue satzposition (DATEI VAR datei, INT CONST indexzeiger, stelle,
+                                                   satznr) :
+
+  IF indexzeiger < 1 OR indexzeiger > datei. indexblocks COR
+     stelle < 1 OR stelle > datei. index (indexzeiger). eintraege THEN
+    errorstop (inkonsistente datei)
+  END IF;
+  disable stop;
+  datei. indexzeiger := indexzeiger;
+  datei. indexstelle := stelle;
+  datei. satznr := satznr;
+  datei. satzzeiger := datei. index (indexzeiger). satzindex ISUB stelle
+
+END PROC neue satzposition;
+
+PROC auf satz (EUDAT VAR datei, INT CONST nr) :
+
+  INT VAR satznr;
+  IF nr < 1 THEN
+    satznr := 1
+  ELIF nr > datei. anz saetze THEN
+    satznr := datei. anz saetze + 1
+  ELSE
+    satznr := nr
+  END IF;
+  auf satz intern (CONCR (datei), satznr)
+
+END PROC auf satz;
+
+PROC auf satz (EUDAT VAR datei, TEXT CONST muster) :
+
+  auf satz (datei, 1);
+  IF nicht auf erstem satz THEN
+    weiter (datei, muster)
+  END IF .
+
+nicht auf erstem satz :
+  feld lesen (datei, 1, feldpuffer);
+  feldpuffer <> muster .
+
+END PROC auf satz;
+
+PROC auf satz intern (DATEI VAR datei, INT CONST satznr) :
+
+  IF von anfang naeher THEN
+    neue satzposition (datei, 1, 1, 1)
+  END IF;
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    erreichter satz := datei. satznr - datei. indexstelle;
+  IF satznr > datei. satznr THEN
+    vorwaerts gehen
+  ELSE
+    rueckwaerts gehen
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, satznr) .
+
+von anfang naeher :
+  satznr + satznr < datei. satznr .
+
+vorwaerts gehen :
+  WHILE noch vor satz REP
+    erreichter satz INCR eintraege;
+    indexzeiger := datei. index (indexzeiger). nachfolger
+  END REP .
+
+noch vor satz :
+  INT CONST eintraege := datei. index (indexzeiger). eintraege;
+  erreichter satz + eintraege < satznr .
+
+rueckwaerts gehen :
+  WHILE noch hinter satz REP
+    indexzeiger := datei. index (indexzeiger). vorgaenger;
+    erreichter satz DECR datei. index (indexzeiger). eintraege
+  END REP .
+
+noch hinter satz :
+  erreichter satz >= satznr .
+
+stelle :
+  satznr - erreichter satz .
+
+END PROC auf satz intern;
+
+PROC weiter (EUDAT VAR datei) :
+
+  weiter intern (CONCR (datei))
+
+END PROC weiter;
+
+PROC weiter intern (DATEI VAR datei) :
+
+  IF nicht dateiende THEN
+    naechster satz
+  END IF .
+
+nicht dateiende :
+  datei. satzzeiger <> 1 .
+
+naechster satz :
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    stelle := datei. indexstelle;
+
+  IF stelle = index. eintraege THEN
+    indexzeiger := index. nachfolger;
+    stelle := 1
+  ELSE
+    stelle INCR 1
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, datei. satznr + 1) .
+
+index :
+  datei. index (indexzeiger) .
+
+END PROC weiter intern;
+
+PROC zurueck (EUDAT VAR datei) :
+
+  zurueck intern (CONCR (datei))
+
+END PROC zurueck;
+
+PROC zurueck intern (DATEI VAR datei) :
+
+  IF nicht am anfang THEN
+    voriger satz
+  END IF .
+
+nicht am anfang :
+  datei. satznr <> 1 .
+
+voriger satz :
+  INT VAR
+    indexzeiger := datei. indexzeiger,
+    stelle := datei. indexstelle;
+
+  IF stelle = 1 THEN
+    indexzeiger := indexblock. vorgaenger;
+    stelle := indexblock. eintraege
+  ELSE
+    stelle DECR 1
+  END IF;
+  neue satzposition (datei, indexzeiger, stelle, datei. satznr - 1) .
+
+indexblock :
+  datei. index (indexzeiger) .
+
+END PROC zurueck intern;
+
+PROC weiter (EUDAT VAR datei, TEXT CONST muster) :
+
+  weiter intern (CONCR (datei), muster)
+
+END PROC weiter;
+
+PROC weiter intern (DATEI VAR datei, TEXT CONST muster) :
+
+  stelle in hashkette bestimmen;
+  WHILE noch weitere saetze CAND muster nicht gefunden REP
+    eine stelle weiter
+  END REP;
+  IF noch weitere saetze THEN
+    positioniere intern (datei, stelle)
+  ELSE
+    auf satz intern (datei, datei. anz saetze + 1)
+  END IF .
+
+stelle in hashkette bestimmen :
+  INT VAR dummy, stelle := datei. satzzeiger;
+  IF muster nicht gefunden THEN
+    stelle in hashkette (datei, hashindex (muster), stelle, dummy)
+  ELSE
+    eine stelle weiter
+  END IF .
+
+noch weitere saetze :
+  stelle <> 0 .
+
+muster nicht gefunden :
+  feld lesen (aktueller satz, 1, feldpuffer);
+  feldpuffer <> muster .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+eine stelle weiter :
+  stelle := datei. ablage (stelle). nachfolger .
+
+END PROC weiter intern;
+
+PROC zurueck (EUDAT VAR datei, TEXT CONST muster) :
+
+  zurueck intern (CONCR (datei), muster)
+
+END PROC zurueck;
+
+PROC zurueck intern (DATEI VAR datei, TEXT CONST muster) :
+
+  stelle in hashkette bestimmen;
+  WHILE noch weitere saetze CAND muster nicht gefunden REP
+    eine stelle zurueck
+  END REP;
+  IF noch weitere saetze THEN
+    positioniere intern (datei, stelle)
+  ELSE
+    auf satz intern (datei, 1)
+  END IF .
+
+stelle in hashkette bestimmen :
+  INT VAR stelle := datei. satzzeiger, dummy;
+  IF stelle = 1 OR schluessel stimmt nicht ueberein THEN
+    stelle in hashkette (datei, hashindex (muster), dummy, stelle)
+  END IF .
+
+noch weitere saetze :
+  stelle <> 0 .
+
+muster nicht gefunden :
+  stelle = datei. satzzeiger OR schluessel stimmt nicht ueberein .
+
+schluessel stimmt nicht ueberein :
+  feld lesen (aktueller satz, 1, feldpuffer);
+  feldpuffer <> muster .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+eine stelle zurueck :
+  stelle := datei. ablage (stelle). vorgaenger .
+
+END PROC zurueck intern;
+
+PROC positioniere intern (DATEI VAR datei, INT CONST stelle) :
+
+  INT CONST zielblock := datei. ablage (stelle). indexblock;
+  INT VAR 
+    indexstelle := 1,
+    satznr := 0;
+  WHILE indexstelle <> zielblock REP
+    satznr INCR datei. index (indexstelle). eintraege;
+    indexstelle := datei. index (indexstelle). nachfolger
+  END REP;
+  indexstelle := pos (datei. index (zielblock). satzindex, stelle);
+  satznr INCR indexstelle;
+  neue satzposition (datei, zielblock, indexstelle, satznr) .
+
+END PROC positioniere intern;
+
+
+(************************* Hashverwaltung ********************************)
+
+INT VAR index;
+
+PROC hashindex berechnen (TEXT CONST feld, INT CONST von, bis) :
+
+  INT VAR
+    zeiger := von;
+  index := 0;
+  IF bis - von < 4 THEN
+    mit faktor 4 streuen
+  ELSE
+    mit faktor 2 streuen
+  END IF;
+  index := index MOD maxhash + 1 .
+
+mit faktor 4 streuen :
+  WHILE zeiger <= bis REP
+    index := index * 4;
+    index INCR code (feld SUB zeiger);
+    zeiger INCR 1
+  END REP .
+
+mit faktor 2 streuen :
+  WHILE zeiger <= bis REP
+    index INCR index;
+    index INCR code (feld SUB zeiger);
+    IF index > 16000 THEN index := index MOD maxhash END IF;
+    zeiger INCR 1
+  END REP .
+
+END PROC hashindex berechnen;
+
+INT PROC hashindex (TEXT CONST feld) :
+
+  hashindex berechnen (feld, 1, length (feld));
+  index
+
+END PROC hashindex;
+
+INT PROC hashindex (SATZ CONST satz) :
+
+  feld bearbeiten (satz, 1,
+       PROC (TEXT CONST, INT CONST, INT CONST) hashindex berechnen);
+  index
+
+END PROC hashindex;
+
+PROC stelle in hashkette (DATEI CONST datei, INT CONST hashindex,
+                          INT VAR stelle, vorher) :
+
+  INT VAR indexzeiger := datei. letzter index;
+  vorher := datei. hashliste (hashindex);
+  stelle := 0;
+  BOOL VAR hinter aktuellem satz := TRUE;
+  WHILE hinter aktuellem satz AND vorher <> 0 REP
+    stelle untersuchen;
+    eine stelle weiter
+  END REP .
+
+stelle untersuchen :
+  IF verweis auf aktuellen block THEN
+    ueberpruefe innerhalb block
+  ELSE
+    teste ob aktueller block in indexkette
+  END IF .
+
+verweis auf aktuellen block :
+  datei. ablage (vorher). indexblock = datei. indexzeiger .
+
+ueberpruefe innerhalb block :
+  indexzeiger := datei. indexzeiger;
+  INT CONST stelle in block := pos (satzindex, vorher);
+  IF stelle in block = 0 THEN
+    errorstop (inkonsistente datei)
+  ELIF stelle in block <= aktuelle stelle THEN
+    hinter aktuellem satz := FALSE
+  END IF .
+
+satzindex :
+  datei. index (indexzeiger). satzindex .
+
+aktuelle stelle :
+  datei. indexstelle .
+
+teste ob aktueller block in indexkette :
+  WHILE indexzeiger <> datei. ablage (vorher). indexblock REP
+    IF indexzeiger = datei. indexzeiger THEN
+      hinter aktuellem satz := FALSE;
+      LEAVE stelle untersuchen
+    ELSE
+      indexzeiger := datei. index (indexzeiger). vorgaenger
+    END IF
+  END REP .
+
+eine stelle weiter :
+  IF hinter aktuellem satz THEN
+    stelle := vorher;
+    vorher := datei. ablage (stelle). vorgaenger
+  END IF .
+
+END PROC stelle in hashkette;
+
+PROC hash ausketten (DATEI VAR datei, INT CONST hashindex) :
+
+  disable stop;
+  INT CONST
+    stelle := datei. satzzeiger,
+    vorgaenger := datei. ablage (stelle). vorgaenger,
+    nachfolger := datei. ablage (stelle). nachfolger;
+
+  IF nachfolger <> 0 THEN
+    datei. ablage (nachfolger). vorgaenger := vorgaenger
+  ELSE
+    datei. hashliste (hashindex) := vorgaenger
+  END IF;
+  IF vorgaenger <> 0 THEN
+    datei. ablage (vorgaenger). nachfolger := nachfolger
+  END IF .
+
+END PROC hash ausketten;
+
+PROC hash einketten (DATEI VAR datei, INT CONST hashindex, 
+                                                nachfolger, vorgaenger) :
+
+  disable stop;
+  INT CONST stelle := datei. satzzeiger;
+  datei. ablage (stelle). vorgaenger := vorgaenger;
+  datei. ablage (stelle). nachfolger := nachfolger;
+  IF vorgaenger <> 0 THEN
+    datei. ablage (vorgaenger). nachfolger := stelle
+  END IF;
+  IF nachfolger <> 0 THEN
+    datei. ablage (nachfolger). vorgaenger := stelle
+  ELSE
+    datei. hashliste (hashindex) := stelle
+  END IF
+
+END PROC hash einketten;
+
+
+(************************** Satzzugriffe *********************************)
+
+PROC satz lesen (EUDAT CONST datei, SATZ VAR satz) :
+
+  satz := datei. ablage (datei. satzzeiger). satz
+
+END PROC satz lesen;
+
+PROC satz aendern (EUDAT VAR datei, SATZ CONST neuer satz) :
+
+  IF NOT dateiende (datei) THEN
+    satz wirklich aendern
+  END IF .
+
+satz wirklich aendern :
+  aktueller satz unsortiert (CONCR (datei));
+  disable stop;
+  schluessel aendern (CONCR (datei), hashindex (neuer satz));
+  aktueller satz := neuer satz .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC satz aendern;
+
+PROC schluessel aendern (DATEI VAR datei, INT CONST neuer hashindex) :
+
+  IF anderer hashindex THEN
+    in neue hashkette
+  END IF .
+
+anderer hashindex :
+  INT CONST alter hashindex := hashindex (aktueller satz);
+  alter hashindex <> neuer hashindex .
+
+in neue hashkette :
+  in alter kette ausketten;
+  in neuer kette einketten .
+
+in alter kette ausketten :
+  hash ausketten (datei, alter hashindex) .
+
+in neuer kette einketten :
+  INT VAR vorgaenger, nachfolger;
+  stelle in hashkette (datei, neuer hashindex, vorgaenger, nachfolger);
+  hash einketten (datei, neuer hashindex, vorgaenger, nachfolger) .
+
+aktueller satz :
+  datei. ablage (datei. satzzeiger). satz .
+
+END PROC schluessel aendern;
+
+PROC satz loeschen (EUDAT VAR datei) :
+
+  IF NOT dateiende (datei) THEN
+    satz wirklich loeschen
+  END IF .
+
+satz wirklich loeschen :
+  disable stop;
+  satzeintrag loeschen (CONCR (datei));
+  indexeintrag loeschen (CONCR (datei));
+  datei. anz saetze DECR 1 .
+
+END PROC satz loeschen;
+
+PROC satzeintrag loeschen (DATEI VAR datei) :
+
+  aktueller satz sortiert (datei);
+  INT CONST stelle := datei. satzzeiger;
+  hash ausketten (datei, hashindex (aktueller satz));
+  datei. ablage (stelle). nachfolger := datei. erster leersatz;
+  datei. erster leersatz := stelle .
+
+aktueller satz :
+  datei. ablage (stelle). satz .
+
+END PROC satzeintrag loeschen;
+
+PROC satz einfuegen (EUDAT VAR datei, SATZ CONST neuer satz) :
+
+  satz einfuegen intern (CONCR (datei), neuer satz)
+
+END PROC satz einfuegen;
+
+PROC satz einfuegen intern (DATEI VAR datei, SATZ CONST neuer satz) :
+
+  INT VAR
+    stelle,
+    vorgaenger,
+    nachfolger;
+
+  enable stop;
+  satzeintrag belegen;
+  ggf schluessel einfuegen;
+  disable stop;
+  datei. anz saetze INCR 1;
+  indexeintrag einfuegen (datei, stelle);
+  INT CONST neuer index := hashindex (feldpuffer);
+  stelle in hashkette (datei, neuer index, nachfolger, vorgaenger);
+  hash einketten (datei, neuer index, nachfolger, vorgaenger);
+  aktueller satz unsortiert (datei) .
+
+satzeintrag belegen :
+  IF datei. erster leersatz <> 0 THEN
+    stelle := datei. erster leersatz;
+    datei. erster leersatz := datei. ablage (stelle). nachfolger
+  ELIF datei. anz satzeintraege = maxsatz THEN
+    errorstop (eudas datei voll)
+  ELSE
+    datei. anz satzeintraege INCR 1;
+    stelle := datei. anz satzeintraege
+  END IF;
+  datei. ablage (stelle). attribut := 0;
+  datei. ablage (stelle). satz := neuer satz .
+
+ggf schluessel einfuegen :
+  feld lesen (neuer satz, 1, feldpuffer);
+  IF datei. schluesselzaehler > 0 THEN
+    IF feldpuffer = "" THEN
+      neuen schluessel erzeugen;
+      feld aendern (datei. ablage (stelle). satz, 1, feldpuffer)
+    END IF
+  END IF .
+
+neuen schluessel erzeugen :
+  feldpuffer := text (datei. schluesselzaehler);
+  feldpuffer := fuehrende nullen + feldpuffer;
+  IF datei. schluesselzaehler > 32000 THEN
+    datei. schluesselzaehler := 1
+  ELSE
+    datei. schluesselzaehler INCR 1
+  END IF .
+
+fuehrende nullen :
+  (4 - length (feldpuffer)) * "0" .
+
+END PROC satz einfuegen intern;
+
+PROC automatischer schluessel (EUDAT VAR eudat, BOOL CONST automatisch) :
+
+  IF automatisch AND eudat. schluesselzaehler < 0 OR
+     NOT automatisch AND eudat. schluesselzaehler > 0 THEN
+    eudat. schluesselzaehler := - eudat. schluesselzaehler
+  END IF
+
+END PROC automatischer schluessel;
+
+BOOL PROC automatischer schluessel (EUDAT CONST eudat) :
+
+  eudat. schluesselzaehler > 0
+
+END PROC automatischer schluessel;
+
+
+(************************* Indexverwaltung *******************************)
+
+(* Die logische Reihenfolge der Saetze wird durch einen Index herge-     *)
+(* stellt. Dieser besteht aus einer Liste von INTVECs. Ein Listenelement *)
+(* nimmt Satzeintraege auf, bis die Maximalgroesse erreicht ist. In      *)
+(* diesem Fall wird ein neues Listenelement eingefuegt. Beim Loeschen    *)
+(* von Eintraegen wird ueberprueft, ob zwei benachbarte Eintraege kom-   *)
+(* biniert werden koennen. Steht fuer eine Anforderung kein Eintrag mehr *)
+(* zur Verfuegung, wird der ganze Index reorganisiert. Es ist garantiert,*)
+(* dass der Index die maximale Anzahl von Satzeintraegen aufnehmen kann. *)
+
+INTVEC VAR indexpuffer;
+
+
+PROC indexeintrag loeschen (DATEI VAR datei) :
+
+  INT CONST
+    indexzeiger := datei. indexzeiger,
+    vorgaenger := index. vorgaenger,
+    nachfolger := index. nachfolger;
+  BOOL VAR moeglich;
+  delete (index. satzindex, datei. indexstelle);
+  index. eintraege DECR 1;
+  indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich);
+  IF NOT moeglich THEN
+    indizes zusammenlegen (datei, vorgaenger, indexzeiger, moeglich)
+  END IF;
+  indexzeiger justieren (datei) .
+
+index :
+  datei. index (indexzeiger) .
+
+END PROC indexeintrag loeschen;
+
+PROC indizes zusammenlegen (DATEI VAR datei, INT CONST zeiger, folgezeiger,
+                                             BOOL VAR moeglich) :
+
+  moeglich := FALSE;
+  IF zeiger <> 0 AND folgezeiger <> 0 THEN
+    versuche zusammenzulegen
+  END IF .
+
+versuche zusammenzulegen :
+  INT CONST
+    eintraege a := index. eintraege,
+    eintraege b := folgeindex. eintraege;
+  IF zusammenlegbar THEN
+    wirklich zusammenlegen;
+    moeglich := TRUE
+  END IF .
+
+zusammenlegbar:
+  eintraege a + eintraege b <= dreiviertel maxeintrag OR
+  eintraege a = 0 OR eintraege b = 0 .
+
+wirklich zusammenlegen :
+  index. eintraege INCR folgeindex. eintraege;
+  indexverweise aendern (datei, folgeindex. satzindex, zeiger);
+  index. satzindex CAT folgeindex. satzindex;
+  folgeindex ausketten .
+
+folgeindex ausketten :
+  index. nachfolger := folgeindex. nachfolger;
+  IF index. nachfolger <> 0 THEN
+    datei. index (index. nachfolger). vorgaenger := zeiger
+  ELSE
+    datei. letzter index := zeiger
+  END IF;
+  folgeindex. nachfolger := datei. erster leerindex;
+  datei. erster leerindex := folgezeiger .
+
+index :
+  datei. index (zeiger) .
+
+folgeindex :
+  datei. index (folgezeiger) .
+
+END PROC indizes zusammenlegen;
+
+PROC indexzeiger justieren (DATEI VAR datei) :
+
+  INT CONST aktueller satz := datei. satznr;
+  neue satzposition (datei, 1, 1, 1);
+  auf satz intern (datei, aktueller satz)
+
+END PROC indexzeiger justieren;
+
+PROC indexverweise aendern (DATEI VAR datei, INTVEC CONST satzindex,
+                                             INT CONST zeiger) :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO length (satzindex) DIV 2 REP
+    datei. ablage (satzindex ISUB i). indexblock := zeiger
+  END REP
+
+END PROC indexverweise aendern;
+
+PROC indexeintrag einfuegen (DATEI VAR datei, INT CONST eintrag) :
+
+  INT VAR indexzeiger := datei. indexzeiger;
+  IF index. eintraege >= maxeintrag THEN
+    platz schaffen
+  END IF;
+  index. eintraege INCR 1;
+  insert (index. satzindex, datei. indexstelle, eintrag);
+  datei. satzzeiger := eintrag;
+  datei. ablage (eintrag). indexblock := indexzeiger .
+
+platz schaffen :
+  INT VAR neuer index := 0;
+  neuen indexblock besorgen;
+  IF neuer index <> 0 THEN
+    index aufsplitten
+  ELSE
+    index reorganisieren (datei)
+  END IF;
+  indexzeiger justieren (datei);
+  indexzeiger := datei. indexzeiger .
+
+neuen indexblock besorgen :
+  IF datei. erster leerindex <> 0 THEN
+    neuer index := datei. erster leerindex;
+    datei. erster leerindex := folgeindex. nachfolger
+  ELIF datei. indexblocks < maxindex THEN
+    datei. indexblocks INCR 1;
+    neuer index := datei. indexblocks;
+    folgeindex. satzindex := blockreservierung
+  END IF .
+
+index aufsplitten :
+  neuen block einketten;
+  splitpunkt bestimmen;
+  folgeindex. eintraege := index. eintraege - halbe eintraege;
+  split up (index. satzindex, folgeindex. satzindex, halbe eintraege + 1);
+  index. eintraege := halbe eintraege;
+  indexverweise aendern (datei, folgeindex. satzindex, neuer index) .
+
+neuen block einketten :
+  INT CONST alter nachfolger := index. nachfolger;
+  IF alter nachfolger <> 0 THEN
+    datei. index (alter nachfolger). vorgaenger := neuer index
+  ELSE
+    datei. letzter index := neuer index
+  END IF;
+  folgeindex. nachfolger := alter nachfolger;
+  folgeindex. vorgaenger := indexzeiger;
+  index. nachfolger := neuer index .
+
+splitpunkt bestimmen :
+  INT VAR halbe eintraege;
+  IF letzter block THEN
+    halbe eintraege := dreiviertel maxeintrag
+  ELSE
+    halbe eintraege := index. eintraege DIV 2 + 1
+  END IF .
+
+letzter block :
+  alter nachfolger = 0 .
+
+index :
+  datei. index (indexzeiger) .
+
+folgeindex :
+  datei. index (neuer index) .
+ 
+END PROC indexeintrag einfuegen;
+
+PROC index reorganisieren (DATEI VAR datei) :
+
+  INT VAR indexzeiger := 1;
+  REP
+    index auffuellen;
+    zum naechsten index
+  END REP .
+
+index auffuellen :
+  BOOL VAR moeglich;
+  REP
+    INT CONST nachfolger := index. nachfolger;
+    indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich)
+  UNTIL NOT moeglich END REP;
+  IF nachfolger = 0 THEN
+    LEAVE index reorganisieren
+  ELIF noch platz THEN
+    rest auffuellen
+  END IF .
+
+noch platz :
+  INT CONST platz := dreiviertel maxeintrag - index. eintraege;
+  platz > 0 .
+
+rest auffuellen :
+  split down (folgeindex. satzindex, indexpuffer, platz + 1); 
+  folgeindex. eintraege DECR platz;
+  indexverweise aendern (datei, indexpuffer, indexzeiger);
+  index. satzindex CAT indexpuffer;
+  index. eintraege := dreiviertel maxeintrag .
+
+zum naechsten index :
+  indexzeiger := nachfolger .
+
+index :
+  datei. index (indexzeiger) .
+
+folgeindex :
+  datei. index (nachfolger) .
+
+END PROC index reorganisieren;
+
+
+(************************* Sortierabfragen *******************************)
+
+TEXT VAR dez komma := ",";
+
+LET
+  sortmask = 1;
+
+TEXT PROC dezimalkomma :
+
+  dez komma
+
+END PROC dezimalkomma;
+
+PROC dezimalkomma (TEXT CONST neues komma) :
+
+  IF length (neues komma) <> 1 THEN
+    errorstop (nicht erlaubtes dezimalkomma)
+  ELSE
+    dez komma := neues komma
+  ENDIF
+
+END PROC dezimalkomma;
+
+INT PROC unsortierte saetze (EUDAT CONST datei) :
+
+  datei. anz unsortierte
+
+END PROC unsortierte saetze;
+
+TEXT PROC sortierreihenfolge (EUDAT CONST datei) :
+
+  datei. sortierfelder
+
+END PROC sortierreihenfolge;
+
+PROC aktueller satz unsortiert (DATEI VAR datei) :
+
+  IF sortiert (datei) THEN
+    disable stop;
+    datei. ablage (datei. satzzeiger). attribut INCR sortmask;
+    datei. anz unsortierte INCR 1
+  END IF
+
+END PROC aktueller satz unsortiert;
+
+PROC aktueller satz sortiert (DATEI VAR datei) :
+
+  IF NOT sortiert (datei) THEN
+    disable stop;
+    datei. ablage (datei. satzzeiger). attribut DECR sortmask;
+    datei. anz unsortierte DECR 1
+  END IF
+
+END PROC aktueller satz sortiert;
+
+BOOL PROC sortiert (DATEI CONST datei, INT CONST stelle) :
+
+  (datei. ablage (stelle). attribut AND sortmask) = 0
+
+END PROC sortiert;
+
+BOOL PROC sortiert (DATEI CONST datei) :
+
+  sortiert (datei, datei. satzzeiger)
+
+END PROC sortiert;
+
+
+(************************* Sortieren *************************************)
+
+(* Eine Datei kann in einer beliebigen Feldreihenfolge sortiert werden.  *)
+(* Dabei wird das Feldinfo beachtet. Wurden seit der letzten Sortierung  *)
+(* nur wenige Saetze geaendert (deren Plaetze in 'unsortierte' gespei-   *)
+(* chert sind), werden nur diese Saetze einsortiert.                     *)
+
+INTVEC VAR sortierinfo;
+
+TEXT VAR sortierfelder;
+
+TEXT VAR l, r;
+
+
+PROC sortiere (EUDAT VAR datei) :
+
+  sortierfelder := datei. sortierfelder;
+  IF sortierfelder = niltext THEN
+    standardbelegung
+  END IF;
+  sortiere intern (CONCR (datei)) .
+
+standardbelegung :
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. felderzahl REP
+    sortierfelder CAT code (i)
+  END REP .
+
+END PROC sortiere;
+
+PROC sortiere (EUDAT VAR datei, TEXT CONST felder) :
+
+  sortierfelder := felder;
+  sortiere intern (CONCR (datei))
+
+END PROC sortiere;
+
+PROC sortiere intern (DATEI VAR datei) :
+
+  IF datei. sortierfelder <> sortierfelder THEN
+    datei. sortierfelder := sortierfelder;
+    datei. anz unsortierte := datei. anz saetze + 1
+  ELIF datei. anz unsortierte = 0 THEN
+    LEAVE sortiere intern
+  END IF;
+  sortierinfo := datei. feldinfo;
+  IF mehr als ein drittel THEN
+    komplett sortieren (datei);
+    datei. anz unsortierte := 0
+  ELSE
+    einzeln sortieren (datei)
+  END IF;
+  auf satz intern (datei, 1) .
+
+mehr als ein drittel :
+  datei. anz saetze DIV datei. anz unsortierte < 3 .
+
+END PROC sortiere intern;
+
+PROC komplett sortieren (DATEI VAR datei) :
+
+  INT VAR
+    satzzeiger,
+    satz := 1,
+    satz vorher;
+
+  auf satz intern (datei, 1);
+  aktueller satz sortiert (datei);
+  satzzeiger := datei. satzzeiger;
+  WHILE noch satz vorhanden REP
+    zum naechsten satz;
+    satz richtig einsortieren;
+    cout (satz)
+  END REP;
+  disable stop;
+  index reorganisieren (datei);
+  neue satzposition (datei, 1, 1, 1) .
+
+noch satz vorhanden :
+  satz < datei. anz saetze .
+
+zum naechsten satz :
+  satz INCR 1;
+  auf satz intern (datei, satz);
+  satz vorher := satzzeiger;
+  satzzeiger := datei. satzzeiger .
+
+satz richtig einsortieren :
+  IF satz kleiner als vorgaenger THEN
+    satz einsortieren (datei, satz, satzzeiger);
+    satzzeiger := satz vorher
+  ELSE
+    aktueller satz sortiert (datei)
+  END IF .
+
+satz kleiner als vorgaenger :
+  datei. ablage (satz vorher). satz GROESSER
+  datei. ablage (satzzeiger). satz .
+
+END PROC komplett sortieren;
+
+PROC einzeln sortieren (DATEI VAR datei) :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. anz satzeintraege REP
+    IF NOT sortiert (datei, i) THEN
+      satz einsortieren (datei, datei. anz saetze + 1, i);
+      cout (i)
+    END IF
+  END REP
+
+END PROC einzeln sortieren;
+
+PROC satz einsortieren (DATEI VAR datei, INT CONST satznr, satzzeiger) :
+
+  stelle suchen;
+  an dieser stelle einfuegen .
+
+stelle suchen :
+  INT VAR
+    anfang := 1,
+    ende := satznr - 1,
+    mitte;
+  WHILE stelle nicht gefunden REP
+    intervall in der mitte halbieren;
+    teilintervall auswaehlen
+  END REP .
+
+stelle nicht gefunden :
+  anfang <= ende .
+
+intervall in der mitte halbieren :
+  mitte := (anfang + ende) DIV 2;
+  INT VAR vergleichssatz;
+  auf satz intern (datei, mitte);
+  IF NOT sortiert (datei) THEN
+    passenden vergleichssatz suchen
+  END IF;
+  vergleichssatz := datei. satzzeiger .
+
+passenden vergleichssatz suchen :
+  WHILE datei. satznr < ende REP
+    weiter intern (datei);
+    IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF
+  END REP;
+  WHILE datei. satznr > anfang REP
+    zurueck intern (datei);
+    IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF
+  END REP;
+  LEAVE stelle suchen .
+
+satz richtig :
+  sortiert (datei) .
+
+teilintervall auswaehlen :
+  IF zu vergleichender satz GROESSER datei. ablage (satzzeiger). satz THEN
+    ende := mitte - 1
+  ELSE
+    anfang := mitte + 1
+  END IF .
+
+zu vergleichender satz :
+  datei. ablage (vergleichssatz). satz .
+
+an dieser stelle einfuegen :
+  positioniere intern (datei, satzzeiger);
+  IF datei. satznr < anfang THEN anfang DECR 1 END IF;
+  disable stop;
+  aktueller satz sortiert (datei);
+  in hashkette ausketten;
+  indexeintrag loeschen (datei);
+  auf satz intern (datei, anfang);
+  indexeintrag einfuegen (datei, satzzeiger);
+  in hashkette einketten .
+
+in hashkette ausketten :
+  INT CONST h index := hashindex (aktueller satz);
+  hash ausketten (datei, h index) .
+
+in hashkette einketten :
+  INT VAR vorgaenger, nachfolger;
+  stelle in hashkette (datei, h index, vorgaenger, nachfolger);
+  hash einketten (datei, h index, vorgaenger, nachfolger) .
+
+aktueller satz :
+  datei. ablage (satzzeiger). satz .
+
+END PROC satz einsortieren;
+
+BOOL OP GROESSER (SATZ CONST links, rechts) :
+
+  ungleiches feld suchen;
+  sortierrichtung feststellen;
+  SELECT sortierinfo ISUB vergleichsfeld OF
+    CASE 0 : din vergleich
+    CASE 1 : zahl vergleich
+    CASE 2 : datum vergleich
+    OTHERWISE text vergleich
+  END SELECT .
+
+ungleiches feld suchen :
+  INT VAR nr zeiger := 1;
+  WHILE nr zeiger < length (sortierfelder) REP
+    INT CONST vergleichsfeld := code (sortierfelder SUB nr zeiger);
+    feld lesen (links, vergleichsfeld, l);
+    feld lesen (rechts, vergleichsfeld, r);
+    SELECT sortierinfo ISUB vergleichsfeld OF
+      CASE 0 : din gleich
+      CASE 1 : zahl gleich
+      OTHERWISE text gleich
+    END SELECT;
+    nr zeiger INCR 2
+  END REP;
+  LEAVE GROESSER WITH FALSE .
+
+sortierrichtung feststellen :
+  BOOL VAR aufsteigend;
+  IF (sortierfelder SUB (nr zeiger + 1)) = "-" THEN
+    aufsteigend := FALSE
+  ELSE
+    aufsteigend := TRUE
+  END IF .
+
+zahl gleich :
+  REAL VAR l wert, r wert;
+  wert berechnen (l, l wert);
+  wert berechnen (r, r wert);
+  IF l wert <> r wert THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+din gleich :
+  IF NOT (l LEXEQUAL r) THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+text gleich :
+  IF l <> r THEN
+    LEAVE ungleiches feld suchen
+  END IF .
+
+zahl vergleich :
+  IF aufsteigend THEN
+    l wert > r wert
+  ELSE
+    l wert < r wert
+  END IF .
+
+din vergleich :
+  IF aufsteigend THEN
+    l LEXGREATER r
+  ELSE
+    r LEXGREATER l
+  END IF .
+
+datum vergleich :
+  datum umdrehen (l);
+  datum umdrehen (r);
+  IF aufsteigend THEN
+    l > r
+  ELSE
+    l < r
+  END IF .
+
+textvergleich :
+  IF aufsteigend THEN
+    l > r
+  ELSE
+    l < r
+  END IF .
+
+END OP GROESSER;
+
+PROC wert berechnen (TEXT CONST zahl, REAL VAR wert) :
+
+  LET ziffern = "0123456789";
+  TEXT VAR komma := dez komma, text; 
+  INT VAR stelle;
+  INT CONST laenge := length (zahl); 
+  anfang bestimmen; 
+  WHILE stelle <= laenge REP 
+    zeichen untersuchen; 
+    stelle INCR 1 
+  END REP; 
+  wert := real (text) . 
+ 
+anfang bestimmen : 
+  stelle := pos (zahl, "0", "9", 1); 
+  IF stelle = 0 THEN 
+     wert := 0.0; LEAVE wert berechnen
+  ELIF pos (zahl, "-", 1, stelle) > 0 THEN 
+    text := "-" 
+  ELSE 
+    text := niltext
+  END IF; .
+ 
+zeichen untersuchen: 
+  TEXT CONST char := zahl SUB stelle; 
+  IF pos (ziffern, char) > 0 THEN 
+    text CAT char 
+  ELIF char = komma THEN 
+    text CAT "."; komma := niltext
+  END IF . 
+ 
+END PROC wert berechnen;
+
+PROC datum umdrehen (TEXT VAR datum) :
+
+  IF length (datum) <> 8 THEN
+    datum := niltext
+  ELSE
+    datum := subtext (datum, 7) + subtext (datum, 4, 5) +
+             subtext (datum, 1, 2)
+  END IF
+
+END PROC datum umdrehen;
+
+
+(**************************** Reorganisieren *****************************)
+
+PROC reorganisiere (TEXT CONST dateiname) :
+
+  EUDAT VAR datei 1, datei 2;
+  oeffne (datei 1, dateiname);
+  disable stop;
+  DATASPACE VAR ds := nilspace;
+  oeffne (datei 2, ds);
+  kopiere eudat (CONCR (datei 1), datei 2);
+  IF NOT is error THEN
+    forget (dateiname, quiet);
+    copy (ds, dateiname)
+  END IF;
+  forget (ds)
+
+END PROC reorganisiere;
+
+PROC kopiere eudat (DATEI VAR datei 1, EUDAT VAR datei 2) :
+
+  enable stop;
+  kopiere saetze;
+  kopiere interna (datei 1, CONCR (datei 2)) .
+
+kopiere saetze :
+  auf satz intern (datei 1, 1);
+  auf satz (datei 2, 1);
+  WHILE NOT dateiende REP
+    satz einfuegen (datei 2, kopiersatz);
+    cout (datei 1. satznr);
+    weiter intern (datei 1);
+    weiter (datei 2)
+  END REP .
+
+dateiende :
+  datei 1. satznr > datei 1. anz saetze .
+
+kopiersatz :
+  datei 1. ablage (datei 1. satzzeiger). satz .
+
+END PROC kopiere eudat;
+
+PROC kopiere interna (DATEI VAR datei 1, datei 2) :
+
+  datei 2. felderzahl := datei 1. felderzahl;
+  datei 2. feldnamen := datei 1. feldnamen;
+  datei 2. feldinfo := datei 1. feldinfo;
+  datei 2. sortierfelder := datei 1. sortierfelder;
+  datei 2. notizen (1) := datei 1. notizen (1);
+  datei 2. notizen (2) := datei 1. notizen (2);
+  datei 2. notizen (3) := datei 1. notizen (3)
+
+END PROC kopiere interna;
+
+
+(************************* Notizen ***************************************)
+
+PROC notizen lesen (EUDAT CONST datei, INT CONST nr, TEXT VAR notiztext) :
+
+  notiztext := datei. notizen (nr)
+
+END PROC notizen lesen;
+
+PROC notizen aendern (EUDAT VAR datei, INT CONST nr, TEXT CONST notiztext) :
+
+  datei. notizen (nr) := notiztext
+
+END PROC notizen aendern;
+
+END PACKET eudas dateien;
+
diff --git a/app/eudas/5.3/src/eudas.dialoghilfen.04 b/app/eudas/5.3/src/eudas.dialoghilfen.04
new file mode 100644
index 0000000..b204978
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.dialoghilfen.04
@@ -0,0 +1,435 @@
+PACKET eudas dialoghilfen
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Dialoghilfen für EUDAS                                            *)
+(*                                                                       *)
+(*     Version 04                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 15.10.88                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  fenstergroessen bestimmen,
+  fenster links,
+  fenster rechts,
+  fenster ganz,
+
+  ausfuehrung,
+  auf archiv,
+  bitte warten,
+  frage ob einrichten,
+  set command dialogue false,
+  reset command dialogue,
+  edit :
+
+
+(**************************** Fenster *************************************)
+
+LET
+  breite links = 16;
+
+INT VAR
+  last x size := 0,
+  last y size;
+
+FENSTER VAR
+  ganz,
+  links,
+  rechts,
+  fuss;
+
+fenster initialisieren (fuss);
+fenster initialisieren (ganz);
+fenster initialisieren (links);
+fenster initialisieren (rechts);
+
+
+PROC fenstergroessen bestimmen :
+
+  IF x size <> last x size OR y size <> last y size THEN
+    neue fenstergroessen;
+    last x size := x size;
+    last y size := y size
+  END IF .
+
+neue fenstergroessen :
+  fenstergroesse setzen (ganz, 1, 2, x size - 1, y size - 1);
+  fenstergroesse setzen (links, 1, 2, breite links, y size - 2);
+  fenstergroesse setzen (rechts,
+    breite links + 1, 2, x size - breite links - 1, y size - 2);
+  fenstergroesse setzen (fuss, 1, y size, x size - 1, 1);
+  dialogfenster (rechts);
+  anzeigefenster (rechts);
+  uebersichtsfenster (ganz) .
+
+END PROC fenstergroessen bestimmen;
+
+FENSTER PROC fenster rechts : rechts END PROC fenster rechts;
+
+FENSTER PROC fenster links : links  END PROC fenster links;
+
+FENSTER PROC fenster ganz : ganz  END PROC fenster ganz;
+
+
+(******************** Parameter-Auswahl ***********************************)
+
+LET
+  keine datei zur auswahl =  #1001#
+    "Keine Datei zur Auswahl vorhanden.",
+  name der datei =  #1002#
+    "Name der Datei: ";
+
+SATZ VAR sammel;
+
+THESAURUS VAR
+  zusaetzliche namen;
+
+TEXT VAR
+  feldpuffer,
+  dateiname,
+  offene;
+
+LET
+  niltext = "",
+  esc z = ""27"z",
+  cleol = ""5"";
+
+LET
+  fetch code = 11,
+  ack = 0;
+
+DATASPACE VAR ds;
+
+INITFLAG VAR init ds;
+
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;
+
+PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ,
+                  PROC (TEXT CONST) operation) :
+
+  ausfuehrung (prompt, nur eine, typ, niltask,
+               PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ,
+                  TASK CONST zusatztask,
+                  PROC (TEXT CONST) operation) :
+
+  enable stop;
+  dateinamen anfordern;
+  IF dateiname = niltext THEN
+    errorstop (niltext)
+  ELIF ist esc z THEN
+    dateiname := subtext (dateiname, 3);
+    dateinamen sammeln (all, typ, zusatztask);
+    auswahl anbieten ("EUDAS-Dateiauswahl", rechts, max wahl,
+                      "AUSWAHL/Datei",
+                      PROC (TEXT VAR, INT CONST) als text);
+    bitte warten;
+    operation ausfuehren (PROC (TEXT CONST) operation)
+  ELSE
+    last param (dateiname);
+    operation (dateiname)
+  END IF .
+
+dateinamen anfordern :
+  IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN
+    dateiname := std
+  ELSE
+    dateiname := niltext
+  END IF;
+  editget (prompt, dateiname, "z", "GET/Dateiname") .
+
+max wahl :
+  IF nur eine THEN 1 ELSE 1024 END IF .
+
+END PROC ausfuehrung;
+
+PROC auf archiv (PROC (TEXT CONST) operation, THESAURUS CONST archivinhalt) :
+
+  dateiname := niltext;
+  editget (name der datei, dateiname, "z", "GET/Dateiname");
+  IF dateiname = niltext THEN
+    errorstop (niltext)
+  ELIF ist esc z THEN
+    uebersicht zeigen
+  ELSE
+    last param (dateiname);
+    operation (dateiname)
+  END IF .
+
+uebersicht zeigen :
+  dateiname := subtext (dateiname, 3);
+  dateinamen sammeln (archivinhalt, 0, niltask);
+  auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv",
+                    PROC (TEXT VAR, INT CONST) als text);
+  operation ausfuehren (PROC (TEXT CONST) operation) .
+
+END PROC auf archiv;
+
+PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ,
+                         TASK CONST zusatztask) :
+
+  BOOL CONST kein pattern := pos (dateiname, "*") = 0;
+  uebergebene namen sammeln;
+  offene dateien merken;
+  zusaetzliche namen dazu;
+  meldung falls keine datei .
+
+uebergebene namen sammeln :
+  INT VAR
+    stelle := 1,
+    von := 0;
+  satz initialisieren (sammel);
+  REP
+    get (t, feldpuffer, von);
+    IF feldpuffer = niltext THEN
+      LEAVE uebergebene namen sammeln
+    ELIF richtiger typ AND nach pattern THEN
+      feld aendern (sammel, stelle, feldpuffer);
+      stelle INCR 1
+    END IF
+  END REP .
+
+richtiger typ :
+  typ = 0 COR type (old (feldpuffer)) = typ .
+
+nach pattern :
+  kein pattern COR (feldpuffer LIKE dateiname) .
+
+offene dateien merken :
+  offene := niltext;
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl dateien REP
+    INT CONST t link := feldindex (sammel, eudas dateiname (i));
+    IF t link > 0 THEN
+      offene CAT code (t link)
+    END IF
+  END REP .
+
+zusaetzliche namen dazu :
+  IF NOT is niltask (zusatztask) THEN
+    zusaetzliche namen := ALL zusatztask;
+    zusaetzliche namen nach typ abfragen
+  END IF .
+
+zusaetzliche namen nach typ abfragen :
+  von := 0;
+  REP
+    get (zusaetzliche namen, feldpuffer, von);
+    IF feldpuffer = niltext THEN
+      LEAVE zusaetzliche namen nach typ abfragen
+    ELIF nach pattern CAND noch nicht enthalten CAND typ stimmt THEN
+      feld aendern (sammel, stelle, feldpuffer);
+      stelle INCR 1
+    END IF
+  END REP .
+
+noch nicht enthalten :
+  NOT (t CONTAINS feldpuffer) .
+
+typ stimmt :
+  typ = 0 COR tasktyp (feldpuffer, zusatztask) = typ .
+
+meldung falls keine datei :
+  IF stelle = 1 THEN
+    dialog (keine datei zur auswahl);
+    errorstop (niltext)
+  END IF .
+
+END PROC dateinamen sammeln;
+
+INT PROC tasktyp (TEXT CONST datei, TASK CONST zieltask) :
+
+  enable stop;
+  INT VAR reply, result;
+  IF NOT initialized (init ds) THEN ds := nilspace END IF;
+  forget (ds); ds := nilspace;
+  msg := ds;
+  msg. name := datei;
+  msg. write pass := write password;
+  msg. read pass := read password;
+  call (zieltask, fetch code, ds, reply);
+  IF reply <> ack THEN
+    result := 0
+  ELSE
+    result := type (ds)
+  END IF;
+  forget (ds);
+  result
+
+END PROC tasktyp;
+
+BOOL PROC ist esc z :
+
+  subtext (dateiname, 1, 2) = esc z
+
+END PROC ist esc z;
+
+PROC als text (TEXT VAR inhalt, INT CONST stelle) :
+
+  IF stelle < 256 THEN
+    feld lesen (sammel, stelle, inhalt);
+    IF pos (offene, code (stelle)) > 0 THEN
+      inhalt := "<!> " + textdarstellung (inhalt)
+    ELIF inhalt <> niltext THEN
+      inhalt := textdarstellung (inhalt)
+    END IF
+  ELSE
+    inhalt := niltext
+  END IF
+
+END PROC als text;
+
+PROC operation ausfuehren (PROC (TEXT CONST) operation) :
+
+  INT VAR
+    stelle := 1;
+  REP
+    IF wahl (stelle) = 0 THEN
+      LEAVE operation ausfuehren
+    ELSE
+      feld lesen (sammel, wahl (stelle), feldpuffer);
+      meldung in fusszeile;
+      last param (feldpuffer);
+      operation (feldpuffer)
+    END IF;
+    stelle INCR 1
+  END REP .
+
+meldung in fusszeile :
+  IF online THEN
+    fenster veraendert (fuss);
+    cursor (1, y size); out (cleol);
+    out (text (stelle)); out (". ");
+    out (textdarstellung (feldpuffer))
+  END IF .
+
+END PROC operation ausfuehren;
+
+
+(************************** Editor ****************************************)
+
+LET
+  edit status =  #1003#
+"EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?",
+  show status =  #1004#
+"ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ?";
+
+INT VAR return code;
+
+BOOL VAR
+  zeige edit status,
+  feldanzeige erlaubt;
+
+
+PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe,
+           BOOL CONST aendern) :
+
+  INT VAR x, y, x l, y l;
+  fenstergroesse (fenster, x, y, x l, y l);
+  fenster veraendert (fenster);
+  enable stop;
+  feldanzeige erlauben;
+  zeige edit status := aendern;
+  REP
+    edit status anzeigen;
+    open editor (groesster editor + 1, f, aendern, x, y, x l, y l);
+    edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo);
+    return code behandeln
+  END REP .
+
+feldanzeige erlauben :
+  IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN
+    feldanzeige erlaubt := TRUE
+  ELSE
+    feldanzeige erlaubt := FALSE
+  END IF .
+
+return code behandeln :
+  SELECT return code OF
+  CASE 0 : LEAVE edit
+  CASE 1 : hilfe anbieten (hilfe, fenster)
+  CASE 2 : errorstop (niltext)
+  END SELECT .
+
+END PROC edit;
+
+PROC edit status anzeigen :
+
+  IF zeige edit status THEN
+    status anzeigen (edit status)
+  ELSE
+    status anzeigen (show status)
+  END IF
+
+END PROC edit status anzeigen;
+
+PROC kdo (TEXT CONST zeichen) :
+
+  return code := pos ("q?h", zeichen);
+  IF return code > 0 THEN
+    return code DECR 1;
+    quit
+  ELIF feldanzeige erlaubt CAND zeichen = "F" THEN
+    do ("feldnamen anzeigen");
+    edit status anzeigen
+  ELSE
+    std kommando interpreter (zeichen);
+    edit status anzeigen;
+    bildschirm neu
+  END IF
+
+END PROC kdo;
+
+
+(**************************** Kommandodialog *******************************)
+
+BOOL VAR dialogue state;
+
+PROC set command dialogue false :
+
+  dialogue state := command dialogue;
+  command dialogue (FALSE)
+
+END PROC set command dialogue false;
+
+PROC reset command dialogue :
+
+  command dialogue (dialogue state)
+
+END PROC reset command dialogue;
+
+
+(************************** Verschiedenes ********************************)
+
+LET
+  t bitte warten =  #1005#
+    " Bitte warten.. ",
+  t neu einrichten =  #1006#
+    " neu einrichten";
+
+
+PROC bitte warten :
+
+  status anzeigen (t bitte warten)
+
+END PROC bitte warten;
+
+PROC frage ob einrichten (TEXT CONST datei) :
+
+  IF NOT ja (textdarstellung (datei) + t neu einrichten, 
+             "JA/einrichten") THEN
+    errorstop (niltext)
+  END IF
+
+END PROC frage ob einrichten;
+
+
+END PACKET eudas dialoghilfen;
+
diff --git a/app/eudas/5.3/src/eudas.drucken.13 b/app/eudas/5.3/src/eudas.drucken.13
new file mode 100644
index 0000000..b191dc5
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.drucken.13
@@ -0,0 +1,2001 @@
+PACKET eudas drucken
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Drucken von EUDAS-Dateien nach Druckmuster                        *)
+(*                                                                       *)
+(*     Version 13                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 06.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+(*dump,    (* Test *) *)
+
+  drucke,
+  interpretiere,
+  gruppentest,
+
+  druckdatei,
+  direkt drucken,
+  druckrichtung,
+  max druckzeilen,
+
+  gruppenwechsel,
+  lfd nr :
+
+
+(*************************** Musterinterpreter ***************************)
+
+(*
+  EXPORTS
+
+  INT max musterspeicher
+  INT VAR interpretationsmodus
+  interpretiere (INT CONST erste zeile, erstes muster,
+                 PROC (INT CONST, TEXT VAR) abk)
+*)
+
+
+LET
+  max musterspeicher = 25,
+  SPEICHER = STRUCT (INT  feldanfang,
+                          feldlaenge,
+                          setzmodus,
+                          bearbeitet bis,
+                     TEXT inhalt);
+
+ROW max musterspeicher SPEICHER VAR musterspeicher;
+
+INT VAR interpretationsmodus;
+
+LET
+  niltext = "",
+  blank = " ",
+  fis = "#",
+  zwei blanks = "  ";
+
+TEXT VAR ausgabezeile;
+
+
+PROC interpretiere (INT CONST erste zeile, erstes muster,
+                    PROC (INT CONST, TEXT VAR) abkuerzungen) : 
+
+  INT VAR
+    kommandoindex,
+    anzahl leerzeilen := 0,
+    anzahl wiederholungen := 0,
+    aktuelles muster := erstes muster;
+
+  muster auf zeile (erste zeile);
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF leerzeile THEN
+      anzahl leerzeilen INCR 1
+    ELSE
+      letzte leerzeilen beruecksichtigen;
+      zeile auswerten
+    END IF
+  END REP .
+
+zeile auswerten :
+  IF kommandozeile (kommandoindex) THEN
+    kommando auswerten
+  ELSE
+    zeile interpretieren;
+    anzahl wiederholungen := 0
+  END IF .
+
+kommando auswerten :
+  SELECT kommandoindex OF
+  CASE modus index :  modus umstellen
+  CASE mehr index  :  anzahl wiederholungen setzen
+  OTHERWISE LEAVE interpretiere
+  END SELECT .
+
+letzte leerzeilen beruecksichtigen :
+  WHILE anzahl leerzeilen > 0 REP
+    zeile drucken (blank);
+    anzahl leerzeilen DECR 1
+  END REP .
+
+modus umstellen :
+  int param (interpretationsmodus) .
+
+anzahl wiederholungen setzen :
+  int param (anzahl wiederholungen) .
+
+leerzeile :
+  musterzeile = niltext OR musterzeile = blank .
+
+zeile interpretieren :
+  INT VAR
+    zeilenzaehler := 0,
+    zu bearbeitende inhalte := 0;
+  BOOL VAR
+    blanks dazwischen := FALSE;
+
+  REP
+    einen zeilendurchgang;
+    zeilenzaehler INCR 1;
+    IF interpretationsmodus = 3 THEN
+      blanks dazwischen := TRUE
+    END IF
+  UNTIL zeile fertig bearbeitet END REP .
+
+zeile fertig bearbeitet :
+  IF interpretationsmodus <= 2 THEN
+    TRUE
+  ELIF anzahl wiederholungen <> 0 THEN
+    zeilenzaehler = anzahl wiederholungen
+  ELSE
+    zu bearbeitende inhalte = 0
+  END IF .
+
+einen zeilendurchgang :
+  INT VAR
+    letztes feldende := 1,
+    reservelaenge := 0,
+    benoetigte reserve := 0,
+    einzulesendes muster := 1,
+    einzusetzendes muster := 1;
+
+  ausgabezeile := niltext;
+  REP
+    IF musterinhalt abspeichern THEN
+      musterinhalt besorgen
+    END IF;
+    IF festes muster THEN
+      zeilenabschnitt ausgeben
+    END IF;
+    einsetzdaten sammeln;
+    einzulesendes muster INCR 1
+  END REP .
+
+musterinhalt abspeichern :
+  zeilenzaehler = 0 .
+
+musterinhalt besorgen :
+  naechstes muster (lesespeicher. feldanfang, lesespeicher. feldlaenge,
+                    lesespeicher. setzmodus);
+  IF NOT zeilenende THEN
+    tabellenmodus beruecksichtigen;
+    musterinhalt lesen
+  END IF .
+
+zeilenende :
+  lesespeicher. feldanfang > length (musterzeile) .
+
+tabellenmodus beruecksichtigen :
+  IF linksschieben verboten AND setzmodus variabel THEN
+    folgende leerzeichen schlucken
+  END IF .
+
+setzmodus variabel :
+  (lesespeicher. setzmodus AND 1) = 0 .
+
+folgende leerzeichen schlucken :
+  INT VAR nach name := lesespeicher. feldanfang + lesespeicher. feldlaenge;
+  IF (musterzeile SUB nach name) = blank THEN
+    WHILE (musterzeile SUB nach name + 1) = blank REP
+      nach name INCR 1;
+      lesespeicher. feldlaenge INCR 1
+    END REP
+  END IF .
+
+musterinhalt lesen :
+  INT CONST musterfunktion := musterindex (aktuelles muster);
+  IF musterfunktion > 0 THEN
+    feld lesen (musterfunktion, lesespeicher. inhalt)
+  ELSE
+    abkuerzungen (-musterfunktion, lesespeicher. inhalt)
+  END IF;
+  aktuelles muster INCR 1;
+  lesespeicher. bearbeitet bis := 0;
+  IF lesespeicher. inhalt <> niltext THEN
+    zu bearbeitende inhalte INCR 1
+  END IF .
+
+festes muster :
+  lesespeicher. setzmodus >= 4 .
+
+lesespeicher :
+  musterspeicher (einzulesendes muster) .
+
+einsetzdaten sammeln :
+  INT CONST reserve := setzdifferenz (lesespeicher);
+  IF reserve > 0 THEN
+    reserve merken
+  ELSE
+    benoetigte reserve DECR reserve
+  END IF .
+
+reserve merken :
+  reservelaenge INCR reserve;
+  IF linksschieben verboten AND reservelaenge > benoetigte reserve THEN
+    reservelaenge := benoetigte reserve
+  END IF;
+  IF kein inhalt mehr einzusetzen AND variabel THEN
+    loeschbare blanks zaehlen
+  END IF .
+
+linksschieben verboten :
+  interpretationsmodus = 2 OR interpretationsmodus = 4 .
+
+kein inhalt mehr einzusetzen :
+  reserve = lesespeicher. feldlaenge .
+
+variabel :
+  (lesespeicher. setzmodus AND 1) = 0 .
+
+loeschbare blanks zaehlen :
+  IF lesespeicher. feldanfang = 1 COR
+     (musterzeile SUB (lesespeicher. feldanfang - 1)) = blank THEN
+    INT VAR ende := feldende (einzulesendes muster);
+    WHILE (musterzeile SUB ende) = blank REP
+      ende INCR 1;
+      lesespeicher. feldlaenge INCR 1;
+      reservelaenge INCR 1
+    END REP
+  END IF .
+
+zeilenabschnitt ausgeben :
+  IF einzulesendes muster = 1 THEN
+    IF zeilenende THEN
+      zeile ganz ausgeben
+    END IF
+  ELSE
+    zeile bis dahin zusammenstellen
+  END IF .
+
+zeile ganz ausgeben :
+  IF blanks dazwischen THEN
+    zeile drucken (blank)
+  ELSE
+    zeile drucken (musterzeile)
+  END IF;
+  LEAVE einen zeilendurchgang .
+
+zeile bis dahin zusammenstellen :
+  INT VAR
+    blankluecke := 0,
+    blankpuffer := lesespeicher. feldanfang;
+  INT CONST
+    endeluecke := blankpuffer - length (musterzeile);
+  blankluecke suchen;
+  alle zwischenliegenden muster in ausgabedatei kopieren;
+  letzten zwischenraum kopieren;
+  zeilenende behandeln .
+
+blankluecke suchen :
+  IF endeluecke > 0 THEN
+    reservelaenge INCR endeluecke;
+    blankpuffer DECR (endeluecke - 1)
+  END IF;
+  rueckwaerts zwei blanks suchen .
+
+rueckwaerts zwei blanks suchen :
+  INT CONST
+    ende voriges feld := feldende (einzulesendes muster - 1),
+    leerstelle :=
+      pos (musterzeile, zwei blanks, ende voriges feld, blankpuffer);
+  IF leerstelle > 0 THEN
+    blankpuffer := leerstelle;
+    groesse der blankluecke bestimmen
+  ELIF endeluecke < 0 AND (musterzeile SUB (blankpuffer - 1)) <> blank THEN
+    blankpuffer := ende voriges feld
+  END IF .
+
+groesse der blankluecke bestimmen :
+  INT VAR ende der luecke := blankpuffer + 1;
+  REP
+    blankluecke INCR 1;
+    ende der luecke INCR 1
+  UNTIL (musterzeile SUB ende der luecke) <> blank END REP;
+  reservelaenge INCR blankluecke .
+
+alle zwischenliegenden muster in ausgabedatei kopieren :
+  INT VAR verschiebung := 0;
+  WHILE einzusetzendes muster < einzulesendes muster REP
+    setzspeicher in einzelvariablen lesen;
+    musterzwischenraum kopieren;
+    muster einsetzen;
+    einzusetzendes muster INCR 1
+  END REP .
+
+setzspeicher in einzelvariablen lesen :
+  INT CONST
+    feldanfang := setzspeicher. feldanfang,
+    feldlaenge := setzspeicher. feldlaenge,
+    setzmodus := setzspeicher. setzmodus .
+
+musterzwischenraum kopieren :
+  zwischenraum (letztes feldende, feldanfang, blanks dazwischen);
+  letztes feldende := feldanfang + feldlaenge .
+
+setzspeicher :
+  musterspeicher (einzusetzendes muster) .
+
+muster einsetzen :
+  INT CONST ueberschuss := - setzdifferenz (setzspeicher);
+  IF ueberschuss = - feldlaenge THEN
+    leeres feld behandeln
+  ELIF ueberschuss <= 0 THEN
+    in voller laenge einsetzen
+  ELIF variable laenge AND reserve vorhanden THEN
+    einsetzen und nach rechts schieben
+  ELSE
+    bis zur grenze einsetzen
+  END IF .
+
+leeres feld behandeln :
+  IF variable laenge THEN
+    verschiebung INCR ueberschuss;
+    IF linksschieben verboten THEN
+      verschiebung korrigieren
+    END IF
+  ELSE
+    blanks anfuegen (-ueberschuss)
+  END IF .
+
+verschiebung korrigieren :
+  IF verschiebung < 0 THEN
+    blanks anfuegen (-verschiebung);
+    verschiebung := 0
+  END IF .
+
+in voller laenge einsetzen :
+  IF rechtsbuendig THEN
+    blanks anfuegen (-ueberschuss)
+  END IF;
+  musterspeicher ganz ausgeben (setzspeicher);
+  zu bearbeitende inhalte DECR 1;
+  IF feste laenge THEN
+    ggf mit blanks auffuellen
+  ELSE
+    verschiebung INCR ueberschuss;
+    linksschieben korrigieren
+  END IF .
+
+rechtsbuendig :
+  (setzmodus AND 2) = 2 .
+
+feste laenge :
+  (setzmodus AND 1) = 1 .
+
+ggf mit blanks auffuellen :
+  IF NOT rechtsbuendig THEN
+    blanks anfuegen (-ueberschuss)
+  END IF .
+
+linksschieben korrigieren :
+  IF linksschieben verboten AND verschiebung < 0 THEN
+    blanks anfuegen (-verschiebung);
+    verschiebung := 0
+  END IF .
+
+variable laenge :
+  NOT feste laenge .
+
+reserve vorhanden :
+  ueberschuss <= reservelaenge .
+
+einsetzen und nach rechts schieben :
+  musterspeicher ganz ausgeben (setzspeicher);
+  zu bearbeitende inhalte DECR 1;
+  verschiebung INCR ueberschuss;
+  reservelaenge DECR ueberschuss .
+
+bis zur grenze einsetzen :
+  INT VAR
+    umbruchblanks := 0,
+    anfang := setzspeicher. bearbeitet bis + 1,
+    setz ende := anfang + feldlaenge - 1,
+    einsetzlaenge := feldlaenge;
+  IF variable laenge THEN
+    setz ende INCR reservelaenge;
+    einsetzlaenge INCR reservelaenge
+  END IF;
+  IF rechtsbuendig AND keine mehrfachzeilen THEN
+    rechten teil einsetzen
+  END IF;
+  textanweisungen beruecksichtigen;
+  IF mehrfachzeilen erlaubt THEN
+    umbruch
+  END IF;
+  teilfeld ausgeben;
+  IF variable laenge THEN
+    verschiebung INCR reservelaenge;
+    reservelaenge := 0
+  END IF .
+
+rechten teil einsetzen :
+  INT CONST nach rechts := length (setzspeicher. inhalt) - setz ende;
+  anfang INCR nach rechts;
+  setz ende INCR nach rechts .
+
+textanweisungen beruecksichtigen :
+  INT VAR mehr platz;
+  REP
+    mehr platz := einsetzlaenge - setz ende + anfang - 1 +
+                  kommandolaenge (setzspeicher. inhalt, anfang, setz ende);
+    IF mehr platz = 0 THEN
+      LEAVE textanweisungen beruecksichtigen
+    ELIF rechtsbuendig THEN
+      anfang DECR mehr platz
+    ELSE
+      setz ende INCR mehr platz
+    END IF
+  END REP .
+
+mehrfachzeilen erlaubt :
+  interpretationsmodus >= 3 .
+
+keine mehrfachzeilen :
+  NOT mehrfachzeilen erlaubt .
+
+teilfeld ausgeben :
+  IF rechtsbuendig THEN
+    blanks anfuegen (umbruchblanks)
+  END IF;
+  druckausgabe (setzspeicher. inhalt, anfang, setz ende);
+  IF linksbuendig THEN
+    blanks anfuegen (umbruchblanks)
+  END IF .
+
+linksbuendig :
+  NOT rechtsbuendig .
+
+umbruch :
+  IF pos (setzspeicher. inhalt, blank, anfang, setz ende) > 0 THEN
+    ende zuruecksetzen
+  END IF;
+  INT CONST naechstes wort :=
+    pos (setzspeicher. inhalt, ""33"", ""254"", setz ende + 1);
+  IF naechstes wort = 0 THEN
+    setzspeicher. bearbeitet bis := length (setzspeicher. inhalt);
+    zu bearbeitende inhalte DECR 1
+  ELSE
+    setzspeicher. bearbeitet bis := naechstes wort - 1
+  END IF .
+
+ende zuruecksetzen :
+  setz ende INCR 1; umbruchblanks DECR 1;
+  WHILE (setzspeicher. inhalt SUB setz ende) <> blank REP
+    setz ende DECR 1;
+    umbruchblanks INCR 1
+  END REP;
+  WHILE (setzspeicher. inhalt SUB setz ende)  = blank REP
+    setz ende DECR 1;
+    umbruchblanks INCR 1
+  UNTIL ende < anfang END REP .
+
+letzten zwischenraum kopieren :
+  zwischenraum (letztes feldende, blankpuffer, blanks dazwischen);
+  IF verschiebung < 0 THEN
+    IF blankpuffer <= length (musterzeile) THEN
+      blanks anfuegen (-verschiebung)
+    END IF;
+    letztes feldende := blankpuffer
+  ELSE
+    letztes feldende := blankpuffer + min (verschiebung, blankluecke)
+  END IF .
+
+zeilenende behandeln :
+  IF endeluecke > 0 THEN
+    rest der musterzeile drucken;
+    zeile ausgeben;
+    LEAVE einen zeilendurchgang
+  ELSE
+    folgenden abschnitt vorbereiten
+  END IF .
+
+rest der musterzeile drucken :
+  IF NOT blanks dazwischen THEN
+    druckausgabe (musterzeile, letztes feldende, length (musterzeile))
+  END IF .
+
+zeile ausgeben :
+  INT VAR neues ende := length (ausgabezeile);
+  IF (ausgabezeile SUB neues ende) = blank THEN
+    REP
+      neues ende DECR 1
+    UNTIL (ausgabezeile SUB neues ende) <> blank END REP;
+    ausgabezeile := subtext (ausgabezeile, 1, neues ende)
+  END IF;
+  IF absatzmarkierung noetig THEN
+    ausgabezeile CAT blank
+  END IF;
+  zeile drucken (ausgabezeile) .
+
+absatzmarkierung noetig :
+  (musterzeile SUB LENGTH musterzeile) = blank AND
+    (interpretationsmodus <> 3 OR zu bearbeitende inhalte = 0) .
+
+folgenden abschnitt vorbereiten :
+  reservelaenge := 0;
+  benoetigte reserve := 0 .
+
+END PROC interpretiere;
+
+INT PROC feldende (INT CONST speicherindex) :
+
+  musterspeicher (speicherindex). feldanfang +
+    musterspeicher (speicherindex). feldlaenge
+
+END PROC feldende;
+
+INT PROC setzdifferenz (SPEICHER CONST speicher) :
+
+  speicher. feldlaenge - length (speicher. inhalt) +
+    kommandolaenge (speicher. inhalt) + speicher. bearbeitet bis
+
+END PROC setzdifferenz;
+
+INT PROC kommandolaenge (TEXT CONST inh) :
+
+  kommandolaenge (inh, 1, length (inh))
+
+END PROC kommandolaenge;
+
+INT PROC kommandolaenge (TEXT CONST inh, INT CONST von, bis) :
+
+  INT CONST
+    first fis := pos (inh, fis, von, bis);
+  INT VAR
+    p := first fis,
+    n,
+    laenge := 0;
+
+  WHILE p > 0 REP
+    naechstes fis suchen;
+    IF kein naechstes THEN
+      rand korrigieren
+    ELSE
+      laenge addieren
+    END IF;
+    fis anfang suchen
+  END REP;
+  laenge .
+
+naechstes fis suchen :
+  n := pos (inh, fis, p + 1, bis) .
+
+kein naechstes :
+  n = 0 .
+
+rand korrigieren :
+  IF bis = length (inh) THEN
+    laenge INCR first fis
+  ELSE
+    laenge INCR (bis - p + 1)
+  END IF .
+
+laenge addieren :
+  laenge INCR (n - p + 1) .
+
+fis anfang suchen :
+  IF n > 0 THEN
+    p := pos (inh, fis, n + 1, bis)
+  ELSE
+    p := 0
+  END IF .
+
+END PROC kommando laenge;
+
+LET
+  zehn blanks = "          ";
+
+PROC blanks anfuegen (INT CONST anzahl) :
+
+  INT VAR zaehler := anzahl;
+  WHILE zaehler >= 10 REP
+    ausgabezeile CAT zehn blanks;
+    zaehler DECR 10
+  END REP;
+  WHILE zaehler > 0 REP
+    ausgabezeile CAT blank;
+    zaehler DECR 1
+  END REP
+
+END PROC blanks anfuegen;
+
+PROC musterspeicher ganz ausgeben (SPEICHER VAR speicher) :
+
+  IF speicher. bearbeitet bis = 0 THEN
+    ausgabezeile CAT speicher. inhalt
+  ELSE
+    druckausgabe (speicher. inhalt, speicher. bearbeitet bis + 1,
+                  length (speicher. inhalt))
+  END IF;
+  speicher. bearbeitet bis := length (speicher. inhalt)
+
+END PROC musterspeicher ganz ausgeben;
+
+PROC zwischenraum (INT CONST von, bis, BOOL CONST blanks dazwischen) :
+
+  IF blanks dazwischen THEN
+    blanks anfuegen (bis - von)
+  ELSE
+    druckausgabe (musterzeile, von, bis - 1)
+  END IF
+
+END PROC zwischenraum;
+
+TEXT VAR ausgabepuffer;
+
+PROC druckausgabe (TEXT CONST context, INT CONST von, bis) :
+
+  ausgabepuffer := subtext (context, von, bis);
+  ausgabezeile CAT ausgabepuffer
+
+END PROC druckausgabe;
+
+
+(************************* Musterscanner *********************************)
+
+(*
+  EXPORTS
+
+  FILE VAR druckmuster
+  naechstes muster (TEXT VAR mustername)
+  naechstes muster (INT VAR musteranfang, musterlaenge, setzmodus)
+  musterzeile lesen
+  TEXT musterzeile
+  INT zeilennr
+  muster auf zeile (INT CONST neue zeile)
+  BOOL kommandozeile (INT VAR kommandoindex)
+  int param (INT VAR param)
+  INT m pos
+  BOOL druckmusterende
+  ueberlesen (TEXT CONST zeichen)
+  INT musterzeilenbreite
+  standard musterzeilenbreite
+*)
+
+
+FILE VAR druckmuster;
+
+TEXT VAR musterzeile;
+
+INT VAR m pos;
+
+LET
+  keine schliessende klammer =  #401#
+    "keine schliessende Klammer in Feldmuster",
+  kein kommando in kommandozeile =  #402#
+    "kein Kommando in Kommandozeile",
+  unbekanntes kommando =  #403#
+    "unbekanntes Kommando";
+
+LET
+  fix symbol = "&",
+  var symbol = "%",
+  com symbol = "%",
+  klammer auf = "<",
+  klammer zu = ">";
+
+LET
+  kommandos =  #404#
+   " "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN
+   "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "
+ 
+
+LET
+  vor index     = 1,
+  wdh index     = 2,
+  nach index    = 3,
+  abk index     = 4,
+  gruppe index  = 5,
+  modus index   = 6,
+  mehr index    = 7,
+  do index      = 100;
+ 
+INT VAR
+  musterzeilenbreite,
+  name anfang,
+  name ende;
+
+BOOL VAR
+  druckmusterende,
+  zeile gelesen;
+
+
+.
+zeilennr :
+  line no (druckmuster) .
+
+standard musterzeilenbreite :
+  musterzeilenbreite := maxlinelength (druckmuster) .
+
+
+PROC ueberlesen (TEXT CONST zeichen) :
+
+  REP
+    m pos INCR 1
+  UNTIL (musterzeile SUB m pos) <> zeichen END REP
+
+END PROC ueberlesen;
+
+PROC naechstes muster (INT VAR anfang, laenge, setzmodus) :
+
+  m pos auf naechsten anfang;
+  IF zeilenende THEN
+    anfang := max (musterzeilenbreite, length (musterzeile)) + 1;
+    laenge := 0;
+    setzmodus := 5
+  ELSE
+    anfang := m pos;
+    muster lesen
+  END IF .
+
+m pos auf naechsten anfang :
+  m pos auf zeichen (fix symbol, var symbol) .
+
+zeilenende :
+  m pos > length (musterzeile) .
+
+muster lesen :
+  TEXT CONST musterzeichen := musterzeile SUB m pos;
+  IF musterzeichen = var symbol THEN
+    setzmodus := 0
+  ELSE
+    setzmodus := 4
+  END IF;
+  anfangszeichen ueberlesen;
+  feldnamen lesen;
+  endezeichen ueberlesen .
+ 
+anfangszeichen ueberlesen :
+  ueberlesen (musterzeichen);
+  IF m pos - 1 > anfang THEN
+    ist rechtsbuendig
+  END IF .
+
+ist rechtsbuendig :
+  setzmodus INCR 3 .
+
+feldnamen lesen :
+  IF (musterzeile SUB m pos) = klammer auf THEN
+    bis klammer zu lesen
+  ELSE
+    bis blank oder muster lesen
+  END IF;
+  IF leerer feldname THEN
+    naechstes muster (anfang, laenge, setzmodus);
+    LEAVE naechstes muster
+  END IF .
+
+leerer feldname :
+  name anfang > name ende .
+
+bis klammer zu lesen :
+  name anfang := m pos + 1;
+  name ende := pos (musterzeile, klammer zu, name anfang);
+  IF name ende = 0 THEN
+    fehler (keine schliessende klammer, subtext (musterzeile, m pos));
+    name ende := length (musterzeile)
+  ELSE
+    name ende DECR 1
+  END IF;
+  m pos := name ende + 2 .
+
+bis blank oder muster lesen :
+  name anfang := m pos;
+  m pos auf zeichen (blank, var symbol);
+  INT CONST zwischenpos := pos (musterzeile, fix symbol, name anfang, m pos);
+  IF zwischenpos > 0 THEN
+    m pos := zwischenpos
+  END IF;
+  name ende := m pos - 1 .
+
+endezeichen ueberlesen :
+  IF musterzeichen angetroffen THEN
+    ist fest;
+    ueberlesen (musterzeichen)
+  END IF;
+  laenge := m pos - anfang .
+
+musterzeichen angetroffen :
+  (musterzeile SUB m pos) = musterzeichen .
+
+ist fest :
+  setzmodus := setzmodus OR 1 .
+
+END PROC naechstes muster;
+
+PROC naechstes muster (TEXT VAR name) :
+
+  INT VAR d1, laenge, d3;
+  naechstes muster (d1, laenge, d3);
+  IF laenge > 0 THEN
+    name := subtext (musterzeile, name anfang, name ende)
+  ELSE
+    name := niltext
+  END IF
+
+END PROC naechstes muster;
+
+PROC m pos auf zeichen (TEXT CONST zeichen 1, zeichen 2) :
+
+  INT CONST 
+    pos 1 := pos (musterzeile, zeichen 1, m pos),
+    pos 2 := pos (musterzeile, zeichen 2, m pos);
+  m pos := length (musterzeile) + 1;
+  IF pos 1 > 0 THEN
+    m pos := pos 1
+  END IF;
+  IF pos 2 > 0 AND pos 2 < m pos THEN
+    m pos := pos 2
+  END IF
+
+END PROC m pos auf zeichen;
+
+PROC muster auf zeile (INT CONST zeile) :
+
+  to line (druckmuster, zeile);
+  zeile gelesen := FALSE;
+  druckmusterende := eof (druckmuster)
+
+END PROC muster auf zeile;
+
+PROC musterzeile lesen :
+
+  IF zeile gelesen THEN
+    down (druckmuster)
+  ELSE
+    zeile gelesen := TRUE
+  END IF;
+  read record (druckmuster, musterzeile);
+  m pos := 1;
+  druckmusterende := line no (druckmuster) >= lines (druckmuster)
+
+END PROC musterzeile lesen;
+
+BOOL PROC kommandozeile (INT VAR kommandoindex) :
+
+  m pos := 1;
+  IF (musterzeile SUB 1) <> com symbol THEN
+    FALSE
+  ELIF (musterzeile SUB 2) <> com symbol THEN
+    kommando abtrennen;
+    kommandoindex bestimmen;
+    TRUE
+  ELSE
+    kommandoindex := do index;
+    TRUE
+  END IF .
+
+kommando abtrennen :
+  TEXT VAR kommando;
+  ueberlesen (blank);
+  IF m pos > length (musterzeile) THEN
+    fehler (kein kommando in kommandozeile, musterzeile);
+    kommandoindex := 0;
+    LEAVE kommandozeile WITH TRUE
+  END IF;
+  INT CONST blank pos := pos (musterzeile, blank, m pos);
+  IF blank pos = 0 THEN
+    kommando := subtext (musterzeile, m pos);
+    kommando CAT blank;
+    m pos := length (musterzeile) + 1
+  ELSE
+    kommando := subtext (musterzeile, m pos, blank pos);
+    m pos := blank pos
+  END IF .
+
+kommandoindex bestimmen :
+  INT CONST wo := pos (kommandos, kommando);
+  IF wo > 0 CAND (kommandos SUB (wo - 2)) = blank THEN
+    kommandoindex := code (kommandos SUB (wo - 1))
+  ELSE
+    kommandoindex := 0;
+    fehler (unbekanntes kommando, kommando);
+  END IF .
+
+END PROC kommandozeile;
+
+PROC int param (INT VAR param) :
+
+  ueberlesen (blank);
+  INT CONST par anfang := m pos;
+  WHILE ziffer REP
+    m pos INCR 1
+  END REP;
+  IF m pos > par anfang THEN
+    param := int (subtext (musterzeile, par anfang, m pos - 1))
+  ELSE
+    param := -1
+  END IF .
+
+ziffer :
+  pos ("0123456789", musterzeile SUB m pos) > 0 .
+
+END PROC int param;
+
+
+(**************************** Codegenerierung ****************************)
+
+(*
+  EXPORTS
+
+  FILE VAR programm
+  BOOL wird uebersetzt
+  proc name (TEXT CONST name)
+  end proc
+  anweisung (TEXT CONST text)
+  anweisung (TEXT CONST pre, mid, post)
+  anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post)
+  interpret anweisung (INT CONST zeile, muster)
+*)
+
+FILE VAR programm;
+
+TEXT VAR
+  aktuelle proc;
+
+BOOL VAR
+  wird uebersetzt;
+
+
+PROC proc name (TEXT CONST name) :
+
+  aktuelle proc := name;
+  programmausgabe ("PROC ", name, " :")
+
+END PROC proc name;
+
+PROC end proc :
+
+  programmausgabe ("END PROC ", aktuelle proc, ";")
+
+END PROC end proc;
+
+PROC anweisung (TEXT CONST programmtext) :
+
+  wird uebersetzt := TRUE;
+  putline (programm, programmtext)
+
+END PROC anweisung;
+
+PROC anweisung (TEXT CONST pre, mid, post) :
+
+  wird uebersetzt := TRUE;
+  programmausgabe (pre, mid, post)
+
+END PROC anweisung;
+
+PROC programmausgabe (TEXT CONST pre, mid, post) :
+
+  write (programm, pre);
+  write (programm, mid);
+  write (programm, post);
+  line (programm)
+
+END PROC programmausgabe;
+
+TEXT VAR textpuffer;
+
+PROC anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) :
+
+  text puffer := subtext (musterzeile, spalte);
+  anweisung (pre, textpuffer, post)
+
+END PROC anweisung;
+
+PROC interpret anweisung (INT CONST zeile, muster) :
+
+  programmausgabe (";  interpretiere (",
+                  text (zeile) + ", " + text (muster),
+                  ", PROC (INT CONST, TEXT VAR) abk);")
+
+END PROC interpret anweisung;
+
+
+(************************ Muster uebersetzen *****************************)
+
+(*
+  EXPORTS
+
+  druckmuster uebersetzen
+  ROW 3 ABSCHNITT VAR abschnitte
+  ROW max muster INT VAR musterindex
+  fehler (TEXT CONST meldung)
+  ROW maxgruppen GRUPPE VAR gruppen
+
+*)
+
+
+LET
+  vorzeitiges ende =  #405#
+    "kein % WIEDERHOLUNG gefunden",
+  nur gruppe erlaubt =  #406#
+    "Nur GRUPPE-Anweisung erlaubt",
+  kein do mehr erlaubt nach gruppen =  #407#
+    "keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",
+  illegale gruppennummer =  #408#
+    "illegale Gruppennummer",
+  gruppe schon definiert =  #409#
+    "diese Gruppe wurde schon definiert",
+  abkuerzung nicht definiert =  #410#
+    "diese Abkuerzung ist nicht definiert",
+  abschnitt mehrfach definiert =  #411#
+    "dieser Abschnitt wurde schon einmal definiert",
+  falscher modus =  #412#
+    "falscher Modus",
+  im musterteil nicht erlaubt =  #413#
+    "diese Anweisung darf im Musterteil nicht vorkommen",
+  im abkuerzungsteil nicht erlaubt =  #414#
+    "im Abkuerzungsteil darf keine Anweisung auftreten",
+  zuviele muster pro zeile =  #415#
+    "in dieser Zeile stehen zu viele Feldmuster",
+  zuviele muster =  #416#
+    "das Druckmuster enthaelt zu viele Feldmuster",
+  name der abkuerzung fehlt =  #417#
+    "nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",
+  kein doppelpunkt nach abkuerzung =  #418#
+    "kein Doppelpunkt nach Abkuerzung",
+  abkuerzung mehrfach definiert =  #419#
+    "Abkuerzung mehrfach definiert",
+  zu viele abkuerzungen =  #420#
+    "das Druckmuster enthaelt zu viele Abkuerzungen";
+
+LET
+  max muster = 200,
+  max gruppen = 4,
+  max abkuerzungen = 250,
+
+  GRUPPE = STRUCT (BOOL wechsel,
+                        definiert,
+                   TEXT inhalt),
+
+  ABSCHNITT = STRUCT (INT  erstes muster,
+                           erste zeile,
+                      TEXT proc name);
+
+
+ROW max muster INT VAR musterindex;
+
+INT VAR anzahl muster;
+
+ROW maxgruppen GRUPPE VAR gruppen;
+
+ROW 3 ABSCHNITT VAR abschnitte;
+
+SATZ VAR abkuerzungen;
+
+TEXT VAR
+  abkuerzungszeile;
+
+INT VAR
+  anzahl abkuerzungen;
+
+
+OP CAT (TEXT VAR intvec, INT CONST wert) :
+
+  TEXT VAR platz fuer int := "  ";
+  replace (platz fuer int, 1, wert);
+  intvec CAT platz fuer int
+
+END OP CAT;
+
+PROC druckmuster uebersetzen :
+
+  enable stop;
+  muster auf zeile (1);
+  uebersetzungsvariablen initialisieren;
+  initialisierungsteil uebersetzen;
+  WHILE NOT druckmusterende REP
+    einen von drei abschnitten uebersetzen
+  END REP;
+  abkuerzungen einsetzen .
+
+uebersetzungsvariablen initialisieren :
+  INT VAR kommandoindex;
+  INT VAR i;
+  anzahl abkuerzungen := 0;
+  satz initialisieren (abkuerzungen);
+  abkuerzungszeile := niltext;
+  anzahl muster := 0;
+  wird uebersetzt := FALSE;
+  abschnitte (1) := ABSCHNITT : (0, 0, "vorspann");
+  abschnitte (2) := ABSCHNITT : (0, 0, "wdh");
+  abschnitte (3) := ABSCHNITT : (0, 0, "nachspann");
+  FOR i FROM 1 UPTO max gruppen REP
+    gruppen (i). definiert := FALSE
+  END REP .
+
+initialisierungsteil uebersetzen :
+  BOOL VAR
+    schon gruppendefinition := FALSE;
+
+  REP
+    IF druckmusterende THEN
+      fehler (vorzeitiges ende);
+      LEAVE druckmuster uebersetzen
+    END IF;
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      initialisierungskommando uebersetzen
+    END IF
+  END REP .
+
+initialisierungskommando uebersetzen :
+  SELECT kommandoindex OF
+
+  CASE do index :
+    do kommando kopieren
+
+  CASE gruppe index :
+    gruppendefinition aufnehmen
+
+  CASE vor index, wdh index, nach index :
+    IF NOT schon gruppendefinition THEN
+      proc name ("gruppen")
+    END IF;
+    end proc;
+    LEAVE initialisierungsteil uebersetzen
+
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (nur gruppe erlaubt)
+    END IF
+
+  END SELECT .
+
+do kommando kopieren :
+  IF schon gruppendefinition THEN
+    fehler (kein do mehr erlaubt nach gruppen, musterzeile)
+  ELSE
+    replace (musterzeile, 1, "  ");
+    anweisung (musterzeile)
+  END IF .
+
+gruppendefinition aufnehmen :
+  IF NOT schon gruppendefinition THEN
+    proc name ("gruppen");
+    schon gruppendefinition := TRUE
+  END IF;
+  INT VAR gruppennr;
+  int param (gruppennr);
+  IF gruppennr < 1 OR gruppennr > max gruppen THEN
+    fehler (illegale gruppennummer, musterzeile)
+  ELIF gruppen (gruppennr). definiert THEN
+    fehler (gruppe schon definiert, musterzeile)
+  ELSE
+    gruppen (gruppennr). definiert := TRUE;
+    ausdruck uebersetzen
+  END IF .
+
+ausdruck uebersetzen :
+  anweisung ("gruppentest (", text (gruppennr), ", ");
+  anweisung ("            ", m pos, ");") .
+
+einen von drei abschnitten uebersetzen :
+  SELECT kommandoindex OF
+  CASE vor index  :  vorspann uebersetzen
+  CASE wdh index  :  wiederholungsteil uebersetzen
+  CASE nach index :  nachspann uebersetzen
+  END SELECT .
+
+vorspann uebersetzen :
+  abschnitt uebersetzen (abschnitte (1), kommandoindex) .
+
+wiederholungsteil uebersetzen :
+  int param (spalten); int param (spaltenbreite);
+  abschnitt uebersetzen (abschnitte (2), kommandoindex) .
+
+nachspann uebersetzen :
+  abschnitt uebersetzen (abschnitte (3), kommandoindex) .
+
+abkuerzungen einsetzen :
+  IF wird uebersetzt THEN
+    fehlende procs definieren;
+    abk headline
+  END IF;
+  abkuerzungen ueberpruefen;
+  IF wird uebersetzt THEN
+    abk ende;
+    druckaufruf
+  END IF .
+
+abkuerzungen ueberpruefen :
+  FOR i FROM 1 UPTO anzahl abkuerzungen REP
+    IF (abkuerzungszeile ISUB i) > 0 THEN
+      fehler (abkuerzung nicht definiert,
+              name der abkuerzung, abkuerzungszeile ISUB i)
+    ELSE
+      anweisung in abk proc generieren
+    END IF
+  END REP .
+
+name der abkuerzung :
+  TEXT VAR puffer;
+  feld lesen (abkuerzungen, i, puffer);
+  puffer .
+
+fehlende procs definieren :
+  FOR i FROM 1 UPTO 3 REP
+    IF abschnitte (i). erste zeile = 0 THEN
+      abschnitt proc definieren
+    END IF
+  END REP .
+
+abschnitt proc definieren :
+  proc name (abschnitte (i). proc name);
+  end proc .
+
+abk headline :
+  anweisung ("PROC abk (INT CONST nr, TEXT VAR inhalt) :");
+  IF anzahl abkuerzungen > 0 THEN
+    anweisung ("SELECT nr OF")
+  ELSE
+    anweisung ("inhalt := text (nr)")
+  END IF .
+
+anweisung in abk proc generieren :
+  TEXT CONST lfd index := text (i);
+  anweisung ("CASE " + lfd index, " : inhalt := abk", lfd index) .
+
+abk ende :
+  IF anzahl abkuerzungen > 0 THEN
+    anweisung ("END SELECT")
+  END IF;
+  anweisung ("END PROC abk;") .
+
+druckaufruf :
+  anweisung
+    ("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)") .
+
+END PROC druckmuster uebersetzen;
+
+PROC abschnitt uebersetzen (ABSCHNITT VAR abschnitt,
+                            INT VAR kommandoindex) :
+
+  BOOL VAR war do zeile := TRUE;  (* generiert erstes 'interpretiere' *)
+  proc name (abschnitt. proc name);
+  abschnitt anfang speichern;
+  musterteil uebersetzen;
+  abkuerzungen uebersetzen .
+
+abschnitt anfang speichern :
+  IF abschnitt. erste zeile <> 0 THEN
+    fehler (abschnitt mehrfach definiert, musterzeile)
+  END IF;
+  abschnitt. erste zeile := zeilennr + 1;
+  abschnitt. erstes muster := anzahl muster + 1 .
+
+musterteil uebersetzen :
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      abschnitt kommando uebersetzen
+    ELSE
+      interpret anweisung generieren;
+      musterzeile auf feldmuster untersuchen
+    END IF
+  END REP;
+  abschnitt beenden;
+  LEAVE abschnitt uebersetzen .
+
+abschnitt kommando uebersetzen :
+  SELECT kommandoindex OF
+
+  CASE do index :
+    replace (musterzeile, 1, "  ");
+    anweisung (musterzeile);
+    war do zeile := TRUE
+
+  CASE vor index, wdh index, nach index :
+    abschnitt beenden;
+    LEAVE abschnitt uebersetzen
+
+  CASE abk index :
+    abschnitt beenden;
+    LEAVE musterteil uebersetzen
+
+  CASE modus index :
+    interpret anweisung generieren;
+    INT VAR parameter;
+    int param (parameter);
+    IF parameter < 1 OR parameter > 4 THEN
+      fehler (falscher modus, musterzeile)
+    END IF
+
+  CASE mehr index :
+    interpret anweisung generieren
+
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (im musterteil nicht erlaubt)
+    END IF
+
+  END SELECT .
+
+interpret anweisung generieren :
+  IF war do zeile THEN
+    interpret anweisung (zeilennr, anzahl muster + 1);
+    war do zeile := FALSE
+  END IF .
+
+abschnitt beenden :
+  end proc .
+
+musterzeile auf feldmuster untersuchen :
+  TEXT VAR name;
+  INT VAR muster pro zeile := 0;
+ 
+  REP
+    naechstes muster (name);
+    IF name = niltext THEN
+      LEAVE musterzeile auf feldmuster untersuchen
+    END IF;
+    muster pro zeile INCR 1;
+    muster uebersetzen
+  END REP .
+
+muster uebersetzen :
+  IF muster pro zeile >= max musterspeicher THEN
+    fehler (zu viele muster pro zeile)
+  END IF;
+  IF anzahl muster = max muster THEN
+    fehler (zu viele muster)
+  ELSE
+    anzahl muster INCR 1
+  END IF;
+  vorlaeufigen musterindex suchen .
+
+vorlaeufigen musterindex suchen :
+  INT VAR feldnr := feldnummer (name);
+  IF feldnr = 0 THEN
+    feldnr := feldindex (abkuerzungen, name);
+    IF feldnr = 0 THEN
+      abkuerzung eintragen (name, zeilennr);
+      musterindex (anzahl muster) := -anzahl abkuerzungen
+    ELSE
+      musterindex (anzahl muster) := -feldnr
+    END IF
+  ELSE
+    musterindex (anzahl muster) := feldnr
+  END IF .
+
+abkuerzungen uebersetzen :
+  BOOL VAR erste abkuerzungszeile := TRUE;
+  WHILE NOT druckmusterende REP
+    musterzeile lesen;
+    IF kommandozeile (kommandoindex) THEN
+      auf ende pruefen
+    ELIF zeile nicht leer THEN
+      abkuerzung behandeln
+    END IF
+  END REP .
+
+auf ende pruefen :
+  SELECT kommandoindex OF
+  CASE vor index, wdh index, nach index :
+    LEAVE abkuerzungen uebersetzen
+  OTHERWISE
+    IF kommandoindex > 0 THEN
+      fehler (im abkuerzungsteil nicht erlaubt)
+    END IF
+  END SELECT .
+
+abkuerzung behandeln :
+  IF erste abkuerzungszeile THEN
+    anweisung (".");
+    erste abkuerzungszeile := FALSE
+  END IF;
+  IF erste zeile einer abkuerzung THEN
+    namen isolieren
+  ELSE
+    anweisung (musterzeile)
+  END IF .
+
+erste zeile einer abkuerzung :
+  (musterzeile SUB 1) = fix symbol .
+
+namen isolieren :
+  TEXT VAR abkuerzungsname;
+  naechstes muster (abkuerzungsname);
+  IF abkuerzungsname = niltext THEN
+    fehler (name der abkuerzung fehlt, musterzeile);
+    LEAVE namen isolieren
+  END IF;
+  doppelpunkt suchen;
+  an compiler uebergeben .
+
+doppelpunkt suchen :
+  LET doppelpunkt = ":";
+  m pos DECR 1;   (* wegen 'ueberlesen' *)
+  ueberlesen (blank);
+  IF (musterzeile SUB m pos) = doppelpunkt THEN
+    m pos INCR 1
+  ELSE
+    fehler (kein doppelpunkt nach abkuerzung, musterzeile)
+  END IF .
+
+an compiler uebergeben :
+  abkuerzung eintragen (abkuerzungsname, 0);
+  anweisung (refinement name, m pos - 1, "") .
+
+refinement name :
+  "abk" + text (feldindex (abkuerzungen, abkuerzungsname)) .
+
+zeile nicht leer :
+  musterzeile <> niltext AND musterzeile <> blank .
+
+END PROC abschnitt uebersetzen;
+
+PROC abkuerzung eintragen (TEXT CONST name, INT CONST zeile) :
+
+  INT CONST vorhanden := feldindex (abkuerzungen, name);
+  IF vorhanden > 0 THEN
+    alten eintrag ergaenzen
+  ELSE
+    neu anlegen
+  END IF .
+
+alten eintrag ergaenzen :
+  IF (abkuerzungszeile ISUB vorhanden) > 0 THEN
+    replace (abkuerzungszeile, vorhanden, zeile) 
+  ELIF zeile = 0 THEN
+    fehler (abkuerzung mehrfach definiert, name)
+  END IF .
+
+neu anlegen :
+  IF anzahl abkuerzungen = max abkuerzungen THEN
+    fehler (zu viele abkuerzungen)
+  ELSE
+    anzahl abkuerzungen INCR 1
+  END IF;
+  abkuerzungszeile CAT zeile;
+  feld aendern (abkuerzungen, anzahl abkuerzungen, name) .
+
+END PROC abkuerzung eintragen;
+
+LET
+  fehler in =  #421#
+    "FEHLER in Zeile ",
+  fehler bei =  #422#
+    " bei >>",
+  fehler ende =  #423#
+    "<<";
+
+PROC fehler (TEXT CONST fehlermeldung, bei, INT CONST zeile) :
+
+  LET
+    blanks = "   ";
+  TEXT VAR
+    meldung := fehler in;
+  meldung CAT text (zeile);
+  IF bei <> niltext THEN
+    meldung CAT fehler bei;
+    meldung CAT bei;
+    meldung CAT fehler ende
+  END IF;
+  note (meldung); note line;
+  note (blanks); note (fehlermeldung); note line;
+  IF online AND command dialogue THEN
+    line;
+    putline (meldung);
+    put (blanks); putline (fehlermeldung)
+  END IF
+
+END PROC fehler;
+
+PROC fehler (TEXT CONST fehlermeldung) :
+
+  fehler (fehlermeldung, niltext, zeilennr)
+
+END PROC fehler;
+
+PROC fehler (TEXT CONST fehlermeldung, bei) :
+
+  fehler (fehlermeldung, bei, zeilennr)
+
+END PROC fehler;
+
+
+(************************** Drucksteuerung *******************************)
+
+(*
+  EXPORTS
+
+  drucke (TEXT CONST dateiname)
+  drucke (PROC gruppen, PROC vor, PROC wdh, PROC nach)
+  druckdatei (TEXT CONST dateiname)
+  direkt drucken (BOOL CONST modus)
+  BOOL direkt drucken
+  max druckzeilen (INT CONST zeilen)
+  BOOL gruppenwechsel (INT CONST gruppennr)
+  gruppentest (INT CONST gruppe, TEXT CONST merkmal)
+  TEXT lfd nr
+  zeile drucken (TEXT CONST zeile)
+  INT spalten
+  INT spaltenbreite
+*)
+
+
+LET
+  erzeugtes programm =   #424#
+    "erzeugtes Programm",
+  keine datei geoeffnet =  #425#
+    "keine Datei geoeffnet",
+  interner fehler =  #426#
+    "interner Fehler",
+  druckausgabe steht in =  #427#
+    "Druckausgabe steht in",
+  zum drucker geschickt =  #428#
+    "zum Drucker geschickt.",
+  direkt drucken nicht moeglich =  #429#
+    "direkt Drucken nicht moeglich",
+  eudas ausgabe punkt =  #430#
+    ".a$";
+
+TEXT VAR
+  spaltenpuffer,
+  druckdateiname := "";
+
+BOOL VAR
+  wechsel erfolgt,
+  wechsel 0,
+  externer dateiname,
+  direkt ausdrucken := FALSE;
+
+FILE VAR ausgabe;
+
+INT VAR
+  spalten,
+  spaltenbreite,
+  gedruckte spalten,
+  gemeinsamer anfang,
+  gedruckte zeilen,
+  richtung := 1,
+  max zeilen := 4000,
+  satzzaehler;
+
+
+PROC drucke :
+
+  drucke (last param)
+
+END PROC drucke;
+
+PROC drucke (TEXT CONST dateiname) :
+
+  enable stop;
+  last param (dateiname);
+  druckmuster := sequential file (input, dateiname);
+  modify (druckmuster);
+  IF anzahl dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  disable stop;
+  programmdatei einrichten;
+  druckmuster uebersetzen;
+  IF anything noted THEN
+    note edit (druckmuster)
+  ELIF wird uebersetzt THEN
+    programm uebersetzen
+  ELSE
+    drucke (PROC dummy gruppentest,
+            PROC std vor, PROC std wdh, PROC std nach)
+  END IF;
+  forget (programmdatei, quiet) .
+
+programmdatei einrichten :
+  TEXT VAR programmdatei;
+  INT VAR i := 0;
+  REP
+    i INCR 1;
+    programmdatei := text (i)
+  UNTIL NOT exists (programmdatei) END REP;
+  programm := sequential file (output, programmdatei);
+  headline (programm, erzeugtes programm) .
+
+programm uebersetzen : 
+  run (programmdatei);
+  last param (dateiname) .
+
+END PROC drucke;
+
+PROC dummy gruppentest :  END PROC dummy gruppentest;
+
+PROC std vor :
+
+  abschnitt ausfuehren (1)
+
+END PROC std vor;
+
+PROC std wdh :
+
+  abschnitt ausfuehren (2)
+
+END PROC std wdh;
+
+PROC std nach :
+
+  abschnitt ausfuehren (3)
+
+END PROC std nach;
+
+PROC abschnitt ausfuehren (INT CONST nr) :
+
+  IF abschnitte (nr). erste zeile > 0 THEN
+    interpretiere (abschnitte (nr). erste zeile,
+                   abschnitte (nr). erstes muster,
+                   PROC (INT CONST, TEXT VAR) std abk)
+  END IF
+
+END PROC abschnitt ausfuehren;
+
+PROC std abk (INT CONST nr, TEXT VAR inhalt) :
+
+  errorstop (interner fehler);
+  inhalt := code (nr)         (* Dummy-Anweisung, damit Parameter benutzt *)
+
+END PROC std abk;
+
+PROC drucke (PROC grp test, PROC vorspann, PROC wdh, PROC nachspann) :
+
+  INT VAR
+    modus,
+    letzter satz,
+    letzte kombination;
+
+  enable stop;
+  druckdatei eroeffnen;
+  auf ersten satz;
+  gruppen initialisieren;
+  satzzaehler := 1;
+  WHILE NOT dateiende REP
+    bei gruppenwechsel nachspann und vorspann;
+    cout (satznummer);
+    wiederholungsteil interpretieren;
+    weiter (modus);
+    ende der druckdatei ueberpruefen
+  END REP;
+  letzten nachspann drucken;
+  datei ausdrucken;
+  auf satz (1) .
+
+auf ersten satz :
+  letzter satz := 0;
+  auf satz (1);
+  IF markierte saetze > 0 THEN
+    modus := 3;
+    IF NOT satz markiert THEN weiter (modus) END IF
+  ELSE
+    modus := 2;
+    IF NOT satz ausgewaehlt THEN weiter (modus) END IF
+  END IF .
+
+gruppen initialisieren :
+  INT VAR i;
+  FOR i FROM 1 UPTO maxgruppen REP
+    gruppen (i). inhalt := niltext
+  END REP .
+
+bei gruppenwechsel nachspann und vorspann :
+  IF letzter satz = 0 THEN
+    grp test;
+    alle gruppen wechseln;
+    abschnitt interpretieren (PROC vorspann)
+  ELSE
+    wechsel 0 := FALSE;
+    gruppenwechsel testen;
+    gruppenwechsel mit nachspann
+  END IF;
+  letzter satz := satznummer;
+  letzte kombination := satzkombination .
+
+gruppenwechsel testen :
+  wechsel erfolgt := FALSE;
+  grp test .
+
+gruppenwechsel mit nachspann :
+  IF wechsel erfolgt THEN
+    nachspann drucken (letzter satz, letzte kombination, PROC nachspann)
+  END IF;
+  satzzaehler INCR 1;
+  IF wechsel erfolgt THEN
+    abschnitt interpretieren (PROC vorspann)
+  END IF .
+
+wiederholungsteil interpretieren :
+  IF spaltenbreite < 1 THEN
+    standard musterzeilenbreite
+  ELSE
+    musterzeilenbreite := spaltenbreite
+  END IF;
+  IF gedruckte spalten < spalten THEN
+    to line (ausgabe, gemeinsamer anfang)
+  ELSE
+    to line (ausgabe, gedruckte zeilen + 1);
+    gemeinsamer anfang := gedruckte zeilen + 1;
+    gedruckte spalten := 0
+  END IF;
+  interpretationsmodus := 1;
+  wdh;
+  gedruckte spalten INCR 1 .
+
+ende der druckdatei ueberpruefen :
+  IF gedruckte zeilen > maxzeilen THEN
+    datei ausdrucken;
+    druckdatei eroeffnen
+  END IF .
+
+letzten nachspann drucken :
+  alle gruppen wechseln;
+  IF letzter satz = 0 THEN
+    abschnitt interpretieren (PROC nachspann)
+  ELSE
+    nachspann drucken (letzter satz, letzte kombination, PROC nachspann)
+  END IF;
+  muster auf zeile (1) .
+
+END PROC drucke;
+
+PROC alle gruppen wechseln :
+
+  INT VAR i;
+  FOR i FROM 1 UPTO max gruppen REP
+    gruppen (i). wechsel := TRUE
+  END REP;
+  wechsel 0 := TRUE;
+  wechsel erfolgt := TRUE
+
+END PROC alle gruppen wechseln;
+
+PROC abschnitt interpretieren (PROC abschnitt) :
+
+  gedruckte spalten := spalten;
+  to line (ausgabe, gedruckte zeilen + 1);
+  standard musterzeilenbreite;
+  interpretationsmodus := 1;
+  abschnitt
+
+END PROC abschnitt interpretieren;
+
+PROC nachspann drucken (INT CONST letzter satz, letzte kombination,
+                        PROC nachspann) :
+
+  INT CONST
+    aktueller satz := satznummer,
+    aktuelle kombination := satzkombination;
+  auf satz (letzter satz);
+  WHILE satzkombination <> letzte kombination REP weiter (1) END REP;
+  abschnitt interpretieren (PROC nachspann);
+  auf satz (aktueller satz);
+  WHILE satzkombination <> aktuelle kombination REP weiter (1) END REP
+
+END PROC nachspann drucken;
+
+PROC druckdatei eroeffnen :
+
+  IF aktueller editor > 0 THEN
+    in editfile schreiben
+  ELSE
+    in ausgabedatei schreiben
+  END IF;
+  druckanweisungen uebertragen .
+
+in editfile schreiben :
+  ausgabe := edit file;
+  IF col > 1 THEN
+    split line (ausgabe, col, FALSE);
+    down (ausgabe); col (ausgabe, 1)
+  END IF;
+  gedruckte zeilen := line no (ausgabe) - 1 .
+
+in ausgabedatei schreiben :
+  IF NOT externer dateiname THEN
+    druckdateinamen generieren
+  END IF;
+  ausgabe := sequential file (modify, druckdateiname);
+  max linelength (ausgabe, max linelength (druckmuster));
+  gedruckte zeilen := lines (ausgabe) .
+
+druckdateinamen generieren :
+  INT VAR zaehler := 0;
+  REP
+    zaehler INCR 1;
+    druckdateiname :=
+       headline (druckmuster) + eudas ausgabe punkt + text (zaehler);
+  UNTIL NOT exists (druckdateiname) END REP .
+
+druckanweisungen uebertragen :
+  muster auf zeile (1);
+  WHILE NOT druckmusterende REP
+    zeile uebertragen
+  END REP .
+
+zeile uebertragen :
+  musterzeile lesen;
+  INT VAR kommandoindex;
+  IF kommandozeile (kommandoindex) THEN
+    auf ende testen
+  ELSE
+    zeile drucken (musterzeile)
+  END IF .
+
+auf ende testen :
+  IF kommandoindex <> do index AND kommandoindex <> gruppe index THEN
+    LEAVE druckanweisungen uebertragen
+  END IF .
+
+END PROC druckdatei eroeffnen;
+
+PROC datei ausdrucken :
+
+  IF aktueller editor > 0 THEN
+    LEAVE datei ausdrucken
+  ELIF externer dateiname THEN
+    externer dateiname := FALSE;
+  ELIF direkt ausdrucken THEN
+    disable stop;
+    ausdruck versuchen
+  ELIF online AND richtung > 1 THEN
+    line; put (druckausgabe steht in);
+    putline (textdarstellung (druckdateiname));
+    pause (40)
+  END IF;
+  to line (ausgabe, 1) .
+
+ausdruck versuchen :
+  TEXT CONST param := std;
+  last param (druckdateiname);
+  do ("print (std)");
+  IF is error THEN
+    clear error;
+    errorstop (direkt drucken nicht moeglich)
+  ELIF online THEN
+    line; put (textdarstellung (druckdateiname));
+    putline (zum drucker geschickt);
+    forget (druckdateiname, quiet);
+    pause (40)
+  END IF;
+  last param (param) .
+
+END PROC datei ausdrucken;
+
+PROC zeile drucken (TEXT CONST zeile) :
+
+  IF gedruckte spalten >= spalten OR gedruckte spalten = 0 THEN
+    insert record (ausgabe);
+    write record (ausgabe, zeile);
+    gedruckte zeilen INCR 1
+  ELSE
+    an zeile anfuegen
+  END IF;
+  down (ausgabe) .
+
+an zeile anfuegen :
+  IF eof (ausgabe) THEN
+    spaltenpuffer := niltext;
+    insert record (ausgabe);
+    gedruckte zeilen INCR 1
+  ELSE
+    read record (ausgabe, spaltenpuffer)
+  END IF;
+  spaltenpuffer verlaengern;
+  write record (ausgabe, spaltenpuffer) .
+
+spaltenpuffer verlaengern :
+  INT CONST ziellaenge := musterzeilenbreite * gedruckte spalten;
+  WHILE length (spaltenpuffer) < ziellaenge REP
+    spaltenpuffer CAT blank
+  END REP;
+  spaltenpuffer CAT zeile .
+
+END PROC zeile drucken;
+
+PROC druckrichtung (INT CONST r) :
+
+  richtung := r;
+  direkt ausdrucken := (r = 0)
+
+END PROC druckrichtung;
+
+INT PROC druckrichtung :
+
+  richtung
+
+END PROC druckrichtung;
+
+PROC direkt drucken (BOOL CONST modus) :
+
+  direkt ausdrucken := modus;
+  IF modus THEN
+    richtung := 0
+  ELIF richtung = 0 THEN
+    richtung := 1
+  END IF
+
+END PROC direkt drucken;
+
+BOOL PROC direkt drucken :
+
+  direkt ausdrucken
+
+END PROC direkt drucken;
+
+PROC druckdatei (TEXT CONST dateiname) :
+
+  druckdateiname := dateiname;
+  externer dateiname := TRUE
+
+END PROC druckdatei;
+
+TEXT PROC druckdatei :
+
+  druckdateiname
+
+END PROC druckdatei;
+
+PROC max druckzeilen (INT CONST zeilen) :
+
+  max zeilen := zeilen
+
+END PROC max druckzeilen;
+
+PROC gruppentest (INT CONST gruppennr, TEXT CONST merkmal) :
+
+  IF merkmal <> gruppen (gruppennr). inhalt THEN
+    gruppen (gruppennr). inhalt := merkmal;
+    gruppen (gruppennr). wechsel := TRUE;
+    wechsel erfolgt := TRUE
+  ELSE
+    gruppen (gruppennr). wechsel := FALSE
+  END IF
+
+END PROC gruppentest;
+
+BOOL PROC gruppenwechsel (INT CONST gruppennr) :
+
+  IF gruppennr > 0 THEN
+    gruppen (gruppennr). wechsel
+  ELSE
+    wechsel 0
+  END IF
+
+END PROC gruppenwechsel;
+
+TEXT PROC lfd nr :
+
+  text (satzzaehler)
+
+END PROC lfd nr;
+
+(*
+PROC dump :
+
+  FILE VAR d := sequential file (output, "EUDAS-DUMP");
+  put (d, "anzahl muster :"); put (d, anzahl muster); line (d);
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl muster REP
+    put (d, musterindex (i));
+  END REP;
+  line (d);
+  put (d, "anzahl abkuerzungen :"); put (d, anzahl abkuerzungen);
+  line (d);
+  FOR i FROM 1 UPTO anzahl abkuerzungen REP
+    TEXT VAR p; feld lesen (abkuerzungen, i, p);
+    write (d, """"); write (d, p); write (d, """ ");
+    put (d, abkuerzungsindex ISUB i)
+  END REP;
+  line (d);
+  FOR i FROM 1 UPTO 3 REP
+    put (d, abschnitte (i). proc name); put (d, abschnitte (i). erste zeile);
+    put (d, abschnitte (i). erstes muster); line (d)
+  END REP;
+  edit ("EUDAS-DUMP");
+  forget ("EUDAS-DUMP")
+
+END PROC dump; *)
+
+END PACKET eudas drucken;
+
diff --git a/app/eudas/5.3/src/eudas.fenster.06 b/app/eudas/5.3/src/eudas.fenster.06
new file mode 100644
index 0000000..cb9578b
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.fenster.06
@@ -0,0 +1,253 @@
+PACKET fenster
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Bildschirmaufteilung in Fenster                                   *)
+(*                                                                       *)
+(*     Version 06                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 15.01.88                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  FENSTER,
+  fenster initialisieren,
+  fenstergroesse setzen,
+  fenstergroesse,
+  fenster veraendert,
+  fensterzugriff,
+  bildschirm neu :
+
+
+TYPE FENSTER = STRUCT (INT koordinaten, version);
+
+LET
+  maxfenster = 16,
+  BITVEKTOR = INT,
+  GROESSE = STRUCT (INT x anf, y anf, x laenge, y laenge);
+
+ROW maxfenster STRUCT (INT referenzen, aktuelle version,
+                       BITVEKTOR ueberschneidungen,
+                       GROESSE groesse)
+               VAR fenstergroessen;
+
+INT VAR naechste version := 1;
+
+BITVEKTOR VAR veraenderungen;
+
+INT VAR i;
+FOR i FROM 2 UPTO maxfenster REP
+  fenstergroessen (i). referenzen := 0
+END REP;
+fenstergroessen (1). referenzen := 1;
+fenstergroessen (1). aktuelle version := 0;
+fenstergroessen (1). ueberschneidungen := 0;
+fenstergroessen (1). groesse := GROESSE : (1, 1, 79, 24);
+
+
+(************************* fenster anfordern *****************************)
+
+PROC fenster initialisieren (FENSTER VAR f) :
+
+  f. koordinaten := 1;
+  fenstergroessen (1). referenzen INCR 1;
+  neue version (f. version)
+
+END PROC fenster initialisieren;
+
+PROC neue version (INT VAR version) :
+
+  version := naechste version;
+  naechste version INCR 1;
+  IF naechste version >= 32000 THEN naechste version := -32000 END IF
+
+END PROC neue version;
+
+PROC fenstergroesse setzen (FENSTER VAR links, FENSTER CONST rechts) :
+
+  neue version (links. version);
+  fenstergroessen (links. koordinaten). referenzen DECR 1;
+  links. koordinaten := rechts. koordinaten;
+  fenstergroessen (rechts. koordinaten). referenzen INCR 1
+
+END PROC fenstergroesse setzen;
+
+PROC fenstergroesse setzen (FENSTER VAR f,
+                            INT CONST x anf, y anf, x laenge, y laenge) :
+
+  INT VAR stelle;
+  passendes fenster suchen;
+  IF stelle > maxfenster THEN
+    freie stelle suchen;
+    neue koordinaten initialisieren;
+    ueberschneidungen bestimmen
+  END IF;
+  auf referenz setzen .
+
+passendes fenster suchen :
+  stelle := 1;
+  WHILE stelle <= maxfenster REP
+    IF groesse passt THEN
+      LEAVE passendes fenster suchen
+    END IF;
+    stelle INCR 1
+  END REP .
+
+groesse passt :
+  g. x anf = x anf AND g. y anf = y anf AND g. x laenge = x laenge AND
+    g. y laenge = y laenge .
+
+g :
+  fenstergroessen (stelle). groesse .
+
+freie stelle suchen :
+  stelle := 1;
+  WHILE stelle <= maxfenster REP
+    IF fenstergroessen (stelle). referenzen = 0 THEN
+      LEAVE freie stelle suchen
+    END IF;
+    stelle INCR 1
+  END REP;
+  errorstop ("zu viele Fenstergroessen");
+  LEAVE fenstergroesse setzen .
+
+neue koordinaten initialisieren :
+  fenstergroessen (stelle). referenzen := 0;
+  fenstergroessen (stelle). aktuelle version := 0;
+  fenstergroessen (stelle). groesse :=
+    GROESSE : (x anf, y anf, x laenge, y laenge);
+  fenstergroessen (stelle). ueberschneidungen := 0 .
+
+ueberschneidungen bestimmen :
+  INT VAR vergleich;
+  FOR vergleich FROM 1 UPTO maxfenster REP
+    IF fenstergroessen (vergleich). referenzen > 0 THEN
+      vergleiche auf ueberschneidung
+    END IF
+  END REP .
+
+vergleiche auf ueberschneidung :
+  IF ueberschneidung (neues fenster, vergleichsfenster) THEN
+    set bit (fenstergroessen (stelle). ueberschneidungen, vergleich);
+    set bit (fenstergroessen (vergleich). ueberschneidungen, stelle)
+  ELSE
+    reset bit (fenstergroessen (vergleich). ueberschneidungen, stelle)
+  END IF .
+
+neues fenster :
+  fenstergroessen (stelle). groesse .
+
+vergleichsfenster :
+  fenstergroessen (vergleich). groesse .
+
+auf referenz setzen :
+  fenstergroessen (f. koordinaten). referenzen DECR 1;
+  f. koordinaten := stelle;
+  fenstergroessen (stelle). referenzen INCR 1 .
+
+END PROC fenstergroesse setzen;
+
+BOOL PROC ueberschneidung (GROESSE CONST a, b) :
+
+  ueberschneidung in x richtung AND ueberschneidung in y richtung .
+
+ueberschneidung in x richtung :
+  IF a. x anf <= b. x anf THEN
+    b. x anf < a. x anf + a. x laenge
+  ELSE
+    a. x anf < b. x anf + b. x laenge
+  END IF .
+
+ueberschneidung in y richtung :
+  IF a. y anf <= b. y anf THEN
+    b. y anf < a. y anf + a. y laenge
+  ELSE
+    a. y anf < b. y anf + b. y laenge
+  END IF .
+
+END PROC ueberschneidung;
+
+PROC fenstergroesse (FENSTER CONST f,
+                     INT VAR x anf, y anf, x laenge, y laenge) :
+
+  x anf := g. x anf;
+  y anf := g. y anf;
+  x laenge := g. x laenge;
+  y laenge := g. y laenge .
+
+g :
+  fenstergroessen (f. koordinaten). groesse .
+
+END PROC fenstergroesse;
+
+
+(************************** fenster veraendert ***************************)
+
+PROC fenster veraendert (FENSTER CONST f) :
+
+  fenstergroessen (f. koordinaten). aktuelle version := 0;
+  veraenderungen := veraenderungen OR meine ueberschneidungen .
+
+meine ueberschneidungen :
+  fenstergroessen (f. koordinaten). ueberschneidungen .
+
+END PROC fenster veraendert;
+
+
+(************************** fensterzugriff *******************************)
+
+PROC fensterzugriff (FENSTER CONST f, BOOL VAR veraendert) :
+
+  veraendert := bit (veraenderungen, f. koordinaten);
+  IF fenstergroessen (f. koordinaten). aktuelle version <> f. version THEN
+    fenstergroessen (f. koordinaten). aktuelle version := f. version;
+    veraendert := TRUE
+  END IF;
+  veraenderungen := veraenderungen OR meine ueberschneidungen;
+  reset bit (veraenderungen, f. koordinaten) .
+
+meine ueberschneidungen :
+  fenstergroessen (f. koordinaten). ueberschneidungen .
+
+END PROC fensterzugriff;
+
+
+(************************ bildschirm neu *********************************)
+
+PROC bildschirm neu :
+
+  veraenderungen := - 1
+
+END PROC bildschirm neu;
+
+
+(**************************** BITVEKTOR **********************************)
+
+(* Erforderlich, da 'reset bit' im EUMEL nicht richtig funktionierte.    *)
+
+ROW 16 INT VAR bitwert := ROW 16 INT :
+ (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);
+
+PROC set bit (BITVEKTOR VAR vektor, INT CONST stelle) :
+
+  vektor := vektor OR bitwert (stelle)
+
+END PROC set bit;
+
+PROC reset bit (BITVEKTOR VAR vektor, INT CONST stelle) :
+
+  vektor := vektor AND (-1 - bitwert (stelle))
+
+END PROC reset bit;
+
+BOOL PROC bit (BITVEKTOR CONST vektor, INT CONST stelle) :
+
+  (vektor AND bitwert (stelle)) <> 0
+
+END PROC bit;
+
+END PACKET fenster;
+
diff --git a/app/eudas/5.3/src/eudas.generator b/app/eudas/5.3/src/eudas.generator
new file mode 100644
index 0000000..ebafebc
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.generator
@@ -0,0 +1,105 @@
+INT VAR size, used;
+BOOL VAR einzeln, sparen, box, l3;
+TASK VAR ar;
+IF (pcb (9) AND 255) = 1 THEN
+  errorstop ("Nicht für Single-User-Systeme geeignet")
+END IF;
+storage (size, used);
+einzeln := size - used < 500;
+soehne loeschen;
+forget ("eudas.generator", quiet);
+page;
+putline ("EUDAS - automatische Generierung");
+putline ("Version 5.3 vom 06.02.89");
+line;
+sparen := no ("Ausfuehrliche Hilfstexte installieren");
+box := yes ("Mit IBM Grafikzeichen");
+l3 := maxint DIV 2 > 17000;
+IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF;
+line;
+disable stop;
+do ("TEXT VARt:=additionalcommands");
+IF is error THEN
+  clear error;
+  enable stop;
+  gen ("dummy.text")
+END IF;
+enable stop;
+IF id (0) < 175 THEN
+  gen ("pos.173")
+END IF;
+IF l3 THEN
+  gen ("isub.replace")
+END IF;
+IF NOT einzeln THEN
+  holen ("menues.1");
+  holen ("eudas.1");
+  holen ("eudas.2");
+  holen ("eudas.3");
+  holen ("eudas.4");
+  holen ("eudas.init.14");
+  IF box THEN holen ("boxzeichen") END IF;
+  release (ar)
+END IF;
+check off;
+gen ("menues.1");
+IF box THEN gen ("boxzeichen") END IF;
+gen ("eudas.1");
+gen ("eudas.2");
+gen ("eudas.3");
+gen ("eudas.4");
+IF anything noted THEN
+  push (""27"q"); note edit; pause (100)
+END IF;
+holen ("eudas.init.14");
+IF einzeln THEN
+  release (ar)
+END IF;
+IF sparen THEN do ("menue loeschen (TRUE)") END IF;
+reorg ("eudas.init.14");
+do ("menuedaten einlesen (""eudas.init.14"")");
+forget ("eudas.init.14", quiet);
+check on;
+do ("global manager");
+
+PROC reorg (TEXT CONST dateiname) :
+  IF l3 CAND type (old (dateiname)) = 1003 THEN
+    reorganize (dateiname)
+  END IF
+END PROC reorg;
+
+PROC vom archiv (TEXT CONST datei):
+  out (""""); out (datei); putline (""" wird geholt.");
+  fetch (datei, ar)
+END PROC vom archiv;
+
+PROC holen (TEXT CONST datei) :
+  IF NOT exists (datei) THEN vom archiv (datei) END IF
+END PROC holen;
+
+PROC gen (TEXT CONST datei) :
+  holen (datei);
+  cursor (1, 7); out (""4"");
+  out (""""); out (datei); out (""" wird uebersetzt: ");
+  reorg (datei);
+  insert (datei);
+  forget (datei, quiet)
+END PROC gen;
+
+PROC soehne loeschen :
+
+  command dialogue (TRUE);
+  access catalogue;
+  TASK VAR sohn := son (myself);
+  WHILE NOT is niltask (sohn) REP
+    TASK CONST naechster := brother (sohn);
+    IF yes ("Sohntask """ + name (sohn) + """ loeschen") THEN
+      end (sohn)
+    ELIF yes ("Generierung abbrechen") THEN
+      errorstop ("")
+    END IF;
+    sohn := naechster
+  END REP
+
+END PROC soehne loeschen;
+
diff --git a/app/eudas/5.3/src/eudas.init.14 b/app/eudas/5.3/src/eudas.init.14
new file mode 100644
index 0000000..69ac8c7
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.init.14
@@ -0,0 +1,1625 @@
+% MENUE "EUDAS.Öffnen" 
+% BILD 
+EUDAS-Datei 
+  Öffnen 
+  Anketten 
+  Koppeln 
+- 
+Arbeitskopie 
+  Sichern 
+- 
+Aktuelle Datei 
+  Notizen 
+  Feldstrukt. 
+  Prüfbeding. 
+- 
+Mehrbenutzer 
+  Manager 
+% FELD 1 "EUDAS/1O" "oOöÖ" 
+% FELD 2 "EUDAS/1E" "aA" 
+% FELD 3 "EUDAS/1K" "kK" 
+% FELD 4 "EUDAS/1S" "sS" 
+% FELD 5 "EUDAS/1N" "nN" 
+% FELD 6 "EUDAS/1F" "fF" 
+% FELD 7 "EUDAS/1P" "pP" 
+% FELD 8 "EUDAS/1M" "mM" 
+% ENDE 
+% MENUE "EUDAS.Einzelsatz" 
+% BILD 
+Positionieren 
+  Weiter 
+  Zurück 
+  Nr. Direkt
+  Inh. Direkt
+- 
+Suchbedingung 
+  Setzen 
+  Löschen 
+  Markierung 
+- 
+Datensatz 
+  Einfügen 
+  Ändern 
+  Tragen 
+  Holen 
+- 
+  Feldauswahl 
+% FELD 1 "EUDAS/2W" "wW" 
+% FELD 2 "EUDAS/2Z" "zZ" 
+% FELD 3 "EUDAS/2N" "nN" 
+% FELD 4 "EUDAS/2I" "iI" 
+% FELD 5 "EUDAS/2S" "sS" 
+% FELD 6 "EUDAS/2L" "lL" 
+% FELD 7 "EUDAS/2M" "mM" 
+% FELD 8 "EUDAS/2E" "eE" 
+% FELD 9 "EUDAS/2A" "aAäÄ" 
+% FELD 10 "EUDAS/2T" "tT" 
+% FELD 11 "EUDAS/2H" "hH" 
+% FELD 12 "EUDAS/2F" "fF" 
+% FELD 13 "" ""3"" 
+% FELD 14 "" ""10"" 
+% FELD 15 ""  "1" 
+% FELD 16 ""  "9" 
+% FELD 17 ""  "K" 
+% ENDE 
+% MENUE "EUDAS.Gesamtdatei" 
+% BILD 
+Satzauswahl 
+  Kopieren 
+  Tragen 
+  Verändern 
+  Übersicht 
+- 
+Aktuelle Datei 
+  Sortieren 
+- 
+Alle Markier. 
+  Löschen 
+% FELD 1 "EUDAS/3K" "kK" 
+% FELD 2 "EUDAS/3T" "tT" 
+% FELD 3 "EUDAS/3V" "vV" 
+% FELD 4 "EUDAS/3U" "uUüÜ" 
+% FELD 5 "EUDAS/3S" "sS" 
+% FELD 6 "EUDAS/3L" "lL" 
+% ENDE 
+% MENUE "EUDAS.Drucken" 
+% BILD 
+Druckausgabe 
+  Generieren 
+  Std.-Listen 
+  Richtung 
+- 
+Textdatei 
+  Editieren 
+  Drucken 
+  Nachbearb. 
+% FELD 1 "EUDAS/4D" "gG" 
+% FELD 2 "EUDAS/4S" "sS" 
+% FELD 3 "EUDAS/4R" "rR" 
+% FELD 4 "EUDAS/4E" "eE" 
+% FELD 5 "EUDAS/4A" "dD" 
+% FELD 6 "EUDAS/4N" "nN" 
+% ENDE 
+% MENUE "EUDAS.Dateien" 
+% BILD 
+Dieser Bereich 
+  Übersicht 
+- 
+Datei 
+  Löschen 
+  Namen änd. 
+  Kopieren 
+  Platzbedarf 
+  Aufräumen 
+% FELD 1 "EUDAS/5U" "UuüÜ" 
+% FELD 2 "EUDAS/5L" "Ll" 
+% FELD 3 "EUDAS/5N" "Nn" 
+% FELD 4 "EUDAS/5K" "Kk" 
+% FELD 5 "EUDAS/5P" "Pp" 
+% FELD 6 "EUDAS/5A" "Aa" 
+% ENDE 
+% MENUE "EUDAS.Archiv" 
+% BILD 
+Dateien Archiv 
+  Übersicht 
+  Drucke Übs. 
+- 
+Datei 
+  Kopieren 
+    vom Archiv 
+  Schreiben 
+    auf Archiv 
+  Löschen 
+    auf Archiv 
+- 
+Archivdiskette 
+  Init 
+- 
+  Zielarchiv 
+  Passwort 
+  Reservieren 
+% FELD 1 "EUDAS/6U" "UuÜü" 
+% FELD 2 "EUDAS/6D" "Dd" 
+% FELD 3 "EUDAS/6K" "Kk" 
+% FELD 4 "EUDAS/6S" "Ss" 
+% FELD 5 "EUDAS/6L" "Ll" 
+% FELD 6 "EUDAS/6I" "Ii" 
+% FELD 7 "EUDAS/6Z" "Zz" 
+% FELD 8 "EUDAS/6P" "Pp" 
+% FELD 9 "EUDAS/6R" "Rr" 
+% ENDE 
+% MENUE "WAHL.Ja" 
+% BILD 
+ Ja   
+Nein  
+% FELD 1 "" "jJ" 
+% FELD 2 "" "nN" 
+% ENDE 
+% MENUE "WAHL.Typen" 
+% BILD 
+TEXT   
+NDIN   
+ZAHL   
+DATUM  
+% FELD 1 "" "tT" 
+% FELD 2 "" "nN" 
+% FELD 3 "" "zZ" 
+% FELD 4 "" "dD" 
+% ENDE 
+% MENUE "WAHL.Sichern" 
+% BILD 
+Statt alter Version  
+Ignorieren  
+Unter neuem Namen  
+% FELD 1 "" "sS" 
+% FELD 2 "" "iI" 
+% FELD 3 "" "uU" 
+% ENDE 
+% MENUE "WAHL.Ziel" 
+% BILD 
+Standard  
+Dateimanager  
+And.Laufwerk  
+Fremdformate  
+% FELD 1 "" "sS" 
+% FELD 2 "" "dD" 
+% FELD 3 "" "aA" 
+% FELD 4 "" "fF" 
+% ENDE 
+% MENUE "WAHL.Format" 
+% BILD 
+Standard  
+360 KB  
+720 KB  
+1,2 MB  
+% FELD 1 "" "sS" 
+% FELD 2 ""  "3" 
+% FELD 3 ""  "7" 
+% FELD 4 ""  "1" 
+% ENDE 
+% MENUE "WAHL.Richtung" 
+% BILD 
+Drucker  
+Bildschirm  
+Textdatei  
+% FELD 1 "" "dD" 
+% FELD 2 "" "bB" 
+% FELD 3 "" "tT" 
+% ENDE 
+% MENUE "WAHL.Std-Listen" 
+% BILD 
+Spaltenliste  
+Kommaliste  
+% FELD 1 "" "kK" 
+% FELD 2 "" "sS" 
+% ENDE 
+% AUSWAHL "EUDAS-Felder" 
+ Bitte die Felder, die geändert werden sollen, ankreuzen: 
+% ENDE 
+% AUSWAHL "EUDAS-Sortierfelder" 
+ Bitte die Felder, nach denen sortiert werden soll, 
+ in Reihenfolge ankreuzen: 
+% ENDE 
+% AUSWAHL "EUDAS-Anzeigefelder" 
+ Bitte die Felder, die angezeigt werden sollen, 
+ in Reihenfolge ankreuzen: 
+% ENDE 
+% AUSWAHL "EUDAS-Editfelder" 
+ Bitte die Felder ankreuzen, die in die Datei übernommen 
+ werden sollen: 
+% ENDE 
+% AUSWAHL "EUDAS-Druckfelder" 
+ Bitte die Felder ankreuzen, deren Inhalte gedruckt 
+ werden sollen: 
+% ENDE 
+% AUSWAHL "EUDAS-Archivauswahl" 
+ Auswahl der Dateien auf dem Archiv. 
+ Gewünschte Datei(en) bitte ankreuzen: 
+% ENDE 
+% AUSWAHL "EUDAS-Dateiauswahl" 
+ Auswahl der vorhandenen Dateien. 
+ Gewünschte Datei(en) bitte ankreuzen: 
+% ENDE 
+% HILFE "EUDAS/Allgemein" 
+% SEITE 1 
+MENÜBEDIENUNG: 
+- 
+Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind
+durch einen vorangestellten Buchstaben gekennzeichnet. Mit den
+Pfeiltasten können Sie die Markierung zu einer beliebigen
+Position auf und ab bewegen. Diese Funktion können Sie dann
+durch Drücken der Leertaste ausführen. Durch ESC '?'
+(nacheinander gedrückt) erhalten Sie Informationen zur gerade
+markierten Funktion. 
+Funktionen, die im momentanen Zustand nicht ausgeführt werden
+können, sind durch ein Minuszeichen gekennzeichnet. 
+In der obersten Bildschirmzeile sind weitere Menüs aufgeführt,
+die Sie aufrufen können. Das aktuelle Menü ist invers
+markiert. Ein anderes Menü wählen Sie durch Drücken der
+Pfeiltasten RECHTS oder LINKS. Wollen Sie das Programm wieder
+verlassen, drücken Sie die ESC-Taste und 'q' hintereinander. 
+% ENDE 
+% HILFE "EUDAS/1O" 
+% SEITE 1 
+Öffnen zum Bearbeiten: 
+- 
+Diese Funktion öffnet eine EUDAS-Datei zur anschließenden
+Bearbeitung. Sie können angeben, ob Sie die Datei nur ansehen
+oder auch ändern wollen. Die vorher geöffnete Datei wird ggf.
+gesichert. Wenn Sie eine neue Datei angeben, wird diese
+eingerichtet. Dabei müssen Sie die Feldnamen eingeben. 
+ 
+=> Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w') 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1E" 
+% SEITE 1 
+EUDAS-Datei ketten: 
+- 
+Mit dieser Funktion können Sie eine EUDAS-Datei logisch an die
+bereits geöffnete Datei anketten. Dazu müssen jedoch die
+beiden Dateien in ihrer Feldstruktur übereinstimmen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1N" 
+% SEITE 1 
+Notizen ansehen/ändern: 
+- 
+Mit dieser Funktion können Sie der aktuell geöffneten Datei
+Notizen zuordnen bzw. sich die vorherigen Notizen ansehen.
+Dazu wird der normale Editor verwendet. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1M" 
+% SEITE 1 
+Manager (Mehrbenutzerbetrieb): 
+- 
+Mit dieser Funktion können Sie die Task festlegen, aus der
+beim Öffnen automatisch EUDAS-Dateien geholt werden können.
+Dadurch können mehrere Benutzer auf die gleiche Datei
+zugreifen, jedoch immer nur einer ändern. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1F" 
+% SEITE 1 
+Feldstruktur ändern: 
+- 
+Mit dieser Funktion können Sie 
+ 
+1. neue Feldnamen anfügen 
+   Sie können neue Feldnamen der Datei am Ende anfügen. Sie
+   müssen die Namen untereinander im Editor in der gewünschten
+   Reihenfolge angeben. Vorher werden Sie jedoch gefragt, ob
+   Sie diese Funktion überhaupt ausführen wollen. 
+ 
+2. Feldnamen und Feldtypen ändern 
+   In diesem Teil wird Ihnen eine Auswahl aller vorhandenen
+   Felder angeboten, in der jeweils auch der Typ angegeben
+   ist. Wenn Sie diese Funktion nicht ausführen wollen,
+   beenden Sie die Auswahl einfach mit ESC q. Sonst wählen Sie
+   die Felder aus, deren Namen oder Typ Sie ändern wollen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1P" 
+% SEITE 1 
+Prüfbedingungen: 
+- 
+Bei dieser Funktion können Sie im Editor ein Prüfprogramm
+eingeben, das mit der Datei gespeichert wird und beim
+Reintragen neuer Sätze ausgeführt wird. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1K" 
+% SEITE 1 
+EUDAS-Datei koppeln: 
+- 
+Mit dieser Funktion können Sie eine Datei angeben, die zu den
+bisher geöffneten Dateien dazugekoppelt wird. Anschließend
+werden zu jedem Satz der existierenden Datei die in den
+Koppelfeldern übereinstimmenden Sätze der Koppeldatei gezeigt. 
+Als Koppelfelder werden dabei die ersten Felder der
+Koppeldatei betrachtet, die auch in der geöffneten Datei
+vorhanden sind. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3S" 
+% SEITE 1 
+Aktuelle Datei sortieren: 
+- 
+Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei
+sortiert werden. Die Reihenfolge, in der die Felder
+berücksichtigt werden, kann vorher angegeben werden. Eventuell
+müssen zum richtigen Sortieren Feldtypen vergeben werden (s.
+"Feldstrukt."). 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/1S" 
+% SEITE 1 
+Aktuelle Dateien sichern: 
+- 
+EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der
+Dateien. Wenn Ändern erlaubt ist, müssen geänderte
+Arbeitskopien mit dieser Funktion gesichert werden. Für eine
+veränderte Datei kann dabei auch ein neuer Name angegeben
+werden, damit die alte Version erhalten bleibt. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2W" 
+% SEITE 1 
+Satz weiter: 
+- 
+Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn
+eine Suchbedingung eingestellt ist, werden nicht ausgewählte
+Sätze übersprungen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2Z" 
+% SEITE 1 
+Satz zurück: 
+- 
+Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung
+eingestellt ist, werden nicht ausgewählte Sätze übersprungen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2S" 
+% SEITE 1 
+Suchbedingung setzen: 
+- 
+Mit dieser Funktion kann eine Suchbedingung als Suchmuster
+eingegeben werden, die angibt, welche Sätze bearbeitet werden
+sollen. Die vorher eingestellte Suchbedingung wird automatisch
+gelöscht. Die Bedingungen für die einzelnen Felder können im
+Editor eingegeben werden. 
+ 
+mögliche Bedingungen: 
+  Text     identisch mit     Text..       größergleich 
+  *Text    endet mit         ..Text       kleiner 
+  Text*    beginnt mit       Text..Text   zwischen 
+  *Text*   enthält           *            nicht leer 
+ 
+  --Bed      Verneinung 
+ 
+Kombination von Bedingungen: 
+  Bedingungen für verschiedene Felder: 
+    UND 
+  Komma zwischen Bedingungen: 
+    lokales ODER (Prio höher als UND) 
+  Semikolon zwischen Bedingungen: 
+    globales ODER (Prio niedriger als UND) 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2L" 
+% SEITE 1 
+Suchbedingung löschen: 
+- 
+Mit dieser Funktion kann eine eingestellte Suchbedingung
+wieder gelöscht werden, so daß wieder alle Sätze sichtbar
+sind. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2N" 
+% SEITE 1 
+auf Satz Nr.: 
+- 
+Mit dieser Funktion kann ein bestimmter Satz direkt angewählt
+werden. Dazu müssen Sie lediglich dessen Satznummer angeben. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2I" 
+% SEITE 1 
+Nach Inhalt direkt positionieren 
+- 
+Mit dieser Funktion kann auf einen bestimmten Satz nach dem
+Inhalt seines ersten Feldes (Schlüsselfeld) positioniert
+werden. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2E" 
+% SEITE 1 
+neuen Satz einfügen: 
+- 
+Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz
+eingefügt. Die Inhalte dieses zunächst leeren Satzes können
+Sie mit Hilfe des Editors neben die einzelnen Feldnamen
+schreiben. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2A" 
+% SEITE 1 
+Satz ändern: 
+- 
+Mit dieser Funktion können Sie die Inhalte des aktuellen
+Satzes verändern. Am Bildschirm können Sie die Daten mit Hilfe
+des Editors ändern, löschen und Neues hinzufügen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2M" 
+% SEITE 1 
+Markierung ein/aus: 
+- 
+Mit dieser Funktion können Sie einen Satz markieren, damit
+später nur die markierten Sätze bearbeitet werden. Ist der
+Satz schon markiert, wird die Markierung wieder gelöscht. Wenn
+mindestens ein Satz markiert ist, erscheint die
+Markierungsinformation in der Überschrift. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3L" 
+% SEITE 1 
+Alle Markierungen loeschen: 
+- 
+Mit dieser Funktion werden alle Markierungen in der Datei
+gelöscht. Die Markierungsinformation wird nicht mehr
+angezeigt. Die Markierungen werden auch beim neuen Öffnen
+gelöscht, da sie nicht permanent in der Datei gespeichert
+sind. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2T" 
+% SEITE 1 
+Einzelsatz tragen: 
+- 
+Mit dieser Funktion kann der aktuelle Satz in eine andere
+Datei transportiert werden. Anschließend wird er gelöscht. Der
+Satz wird am Ende der Zieldatei angefügt, wobei diese
+gegebenenfalls eingerichtet wird. Den Namen der Zieldatei
+können Sie eingeben. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2H" 
+% SEITE 1 
+Einzelsatz holen: 
+- 
+Diese Funktion holt den letzten Satz einer anderen Datei und
+fügt ihn vor dem aktuellen Satz ein. Damit wird das letzte
+'Tragen' wieder rückgängig gemacht. Die Dateien müssen gleiche
+Felderzahl haben. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3U" 
+% SEITE 1 
+Übersicht: 
+- 
+Mit dieser Funktion können Sie sich eine Übersicht über
+mehrere Sätze verschaffen. Es werden vom aktuellen Satz an
+alle durch die Suchbedingung spezifizierten Sätze angezeigt,
+jeder Satz in einer Zeile. In dieser Übersicht können Sie
+blättern und auch bestimmte Sätze zur späteren Bearbeitung
+markieren. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/2F" 
+% SEITE 1 
+Auswahl Felder: 
+- 
+Mit dieser Funktion kann gewählt werden, welche Felder in
+welcher Reihenfolge angezeigt werden sollen. Alle Felder
+werden zum Ankreuzen angeboten. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4D" 
+% SEITE 1 
+Drucken nach Muster: 
+- 
+Mit dieser Funktion können die Inhalte der Datei nach einem
+Druckmuster ausgedruckt werden. Das Druckmuster ist eine
+Textdatei und muß vorher erstellt werden. Es gibt die Form des
+Ausdrucks an. Über den Aufbau eines Druckmusters lesen Sie am
+besten das Benutzerhandbuch. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3T" 
+% SEITE 1 
+Satzauswahl tragen 
+- 
+Diese Funktion trägt alle durch die Suchbedingung oder durch
+Markierung ausgewählten Sätze in eine andere Datei und löscht
+sie danach. Die Zieldatei muß gleiche Felderzahl haben, damit
+keine Information verlorengeht. Beim Tragen können auch die
+Prüfbedingungen der Zieldatei geprüft werden, wenn Sie die
+entsprechende Frage bejahen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4S" 
+% SEITE 1 
+Standard-Listen 
+- 
+Mit dieser Funktion können Standard-Listen einer Datei
+erzeugt werden, ohne ein Druckmuster zu schreiben. Es stehen
+ein Format mit Kommata als Trennzeichen sowie ein
+Spaltenformat zur Auswahl. Ansonsten gelten alle Optionen
+des normalen Generierens von Ausgaben. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4E" 
+% SEITE 1 
+Textdatei erstellen/aendern: 
+- 
+Mit dieser Funktion kann eine Textdatei erstellt, geändert
+oder angesehen werden. Es wird der normale Editor verwendet.
+Mit dieser Funktion werden auch Druckmuster bearbeitet. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3K" 
+% SEITE 1 
+Satzauswahl kopieren: 
+- 
+Diese Funktion kopiert alle durch die Suchbedingung oder durch
+Markierung ausgewählten Sätze in eine andere Datei. Welche
+Felder in welcher Reihenfolge kopiert werden sollen, wird
+durch ein Kopiermuster bestimmt, das nach der Struktur der
+Zieldatei bestimmt wird und dann von Ihnen noch geändert
+werden kann. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4R" 
+% SEITE 1 
+Richtung Ausgabe: 
+- 
+Mit dieser Funktion können Sie festlegen, ob die Ausgabe des
+Druckvorgangs direkt anschließend ausgedruckt werden soll,
+oder in eine Datei gespeichert wird. Sie können den Namen
+dieser Datei eingeben, anderenfalls wählt sich EUDAS selbst
+einen Namen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4A" 
+% SEITE 1 
+Textdatei ausdrucken: 
+- 
+Mit dieser Funktion wird eine Textdatei direkt ausgedruckt.
+Die Datei kann Anweisungen zur Druckersteuerung enthalten, die
+Sie dem EUMEL-Benutzerhandbuch entnehmen können. Sie können
+hiermit Ausgabedateien des Druckprozesses und das Druckmuster
+selbst ausdrucken. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/3V" 
+% SEITE 1 
+Ändern nach Vorschrift: 
+- 
+Diese Funktion ermöglicht es, alle durch die Suchbedingung
+oder durch Markierung ausgewählten Sätze nach einer Vorschrift
+automatisch zu ändern. Die Art der Änderungen wird dabei durch
+ein Verarbeitungsmuster festgelegt, das vorher als Textdatei
+erstellt werden muß. Über die Form des Verarbeitungsmusters s.
+Benutzerhandbuch. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/4N" 
+% SEITE 1 
+Textdatei nachbearbeiten: 
+- 
+Mit dieser Funktion können Sie eine Datei zeilenweise und
+seitenweise formatieren (lineform/pageform). Dies dient an
+dieser Stelle zur Bearbeitung von Druckdateien, die
+verschiedene oder Proportionalschriften enthalten. Sie werden
+jeweils für jede der beiden Funktionen gefragt, ob Sie sie
+ausführen wollen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6S" 
+% SEITE 1 
+Schreiben auf Archiv: 
+- 
+Diese Funktion schreibt eine oder mehrere Dateien auf das
+Archiv. Der Archivname muß vorher eingegeben werden. Dann kann
+entweder der Name der gewünschten Datei eingegeben werden oder
+mit ESC 'z' eine Auswahl von Dateien angekreuzt werden. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5A" 
+% SEITE 1 
+Datei aufräumen: 
+- 
+Diese Funktion reorganisiert eine Datei, an der viel geändert
+wurde, zur Platz- und Zeitersparnis. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5K" 
+% SEITE 1 
+Datei kopieren: 
+- 
+Mit dieser Funktion kann eine beliebige Datei logisch kopiert
+werden. Die Kopie ist identisch mit dem Original und belegt
+den gleichen Platz, erst bei Änderungen werden
+unterschiedliche Daten gespeichert. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5P" 
+% SEITE 1 
+Platzbedarf Datei: 
+- 
+Diese Funktion gibt an, wieviel Platz eine Datei im System
+belegt. Dieser Platz kann aber mit anderen Dateien geteilt
+sein. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6D" 
+% SEITE 1 
+Archivübersicht drucken: 
+- 
+Diese Funktion druckt die Übersicht der Archivdateien aus. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6I" 
+% SEITE 1 
+Archiv initialisieren: 
+- 
+Diese Funktion initialisiert einen Archivträger vor dem
+Beschreiben. Sämtliche Daten werden gelöscht. Auf Wunsch kann
+der Datenträger auch formatiert werden (falls vom System
+unterstützt). 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6Z" 
+% SEITE 1 
+Zielarchiv einstellen: 
+- 
+Mit dieser Funktion kann eine Managertask angegeben werden,
+auf die die Archivfunktionen angewendet werden. Dies dient
+sowohl zur Ansteuerung von mehreren Archiven (z.B. über Netz)
+als auch zur Kommunikation mit anderen Managern. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6P" 
+% SEITE 1 
+Passwort: 
+- 
+Mit dieser Funktion können Sie das Passwort einstellen, das
+beim Versenden von Dateien an andere Tasks verwendet wird.
+Beim Schreiben einer Datei wird das Passwort der Datei
+mitgegeben und beim Lesen wird überprüft, ob das Passwort
+übereinstimmt. Das Passwort kann in der Form
+Schreibpasswort/Lesepasswort angegeben werden. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6R" 
+% SEITE 1 
+Reservieren: 
+- 
+Mit dieser Funktion können Sie einen Kanalmanager (z.B.
+DOS-Task) reservieren. Die Reservierung wird beim Verlassen
+des Archivmenüs wieder aufgehoben. Den Parameter zur
+Reservierung (Modus bei DOS-Task) können Sie angeben. Bei
+normalen Archivtasks wird die Reservierung automatisch
+vorgenommen, daher ist diese Funktion dann gesperrt. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6K" 
+% SEITE 1 
+Kopieren vom Archiv: 
+- 
+Diese Funktion kopiert eine Datei vom Archiv ins System. Der
+Archivname wird automatisch bestimmt. Sie können dann entweder
+den gewünschten Dateinamen angeben oder mit ESC 'z' eine
+Auswahl aller Dateien auf dem Archiv abrufen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5N" 
+% SEITE 1 
+Datei Namen ändern: 
+- 
+Mit dieser Funktion können Sie für eine Datei auf dem System
+einen neuen Namen vergeben. Wenn Sie den neuen Namen eingeben,
+wird Ihnen der alte Name angeboten. Sie können ihn ändern oder
+ganz überschreiben. Dadurch ersparen Sie sich bei kleinen
+Änderungen das Neutippen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6L" 
+% SEITE 1 
+Löschen auf Archiv: 
+- 
+Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu
+löschen. Der Platz dieser Datei wird jedoch nur dann
+wiederverwendet, wenn keine Dateien mehr dahinter stehen. Der
+Archivname muß eingegeben werden. Sie können bei der Eingabe
+des Dateinamens mit ESC 'z' eine Dateiauswahl abrufen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5L" 
+% SEITE 1 
+Datei löschen: 
+- 
+Diese Funktion löscht eine Datei auf dem System nach Anfrage.
+Sie können den Dateinamen eingeben oder mit ESC 'z' eine
+Auswahl aller vorhandenen Dateien abrufen. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/6U" 
+% SEITE 1 
+Übersicht Archiv: 
+- 
+Diese Funktion liefert eine Übersicht der Dateien auf dem
+Archiv. Verlassen Sie diese Übersicht mit ESC 'q'. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "EUDAS/5U" 
+% SEITE 1 
+Übersicht Dateien: 
+- 
+Diese Funktion liefert eine Übersicht über alle im System
+vorhandenen Dateien. Verlassen Sie diese Übersicht mit ESC
+'q'. 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Allgemein" 
+% SEITE 1 
+AUSWAHL: 
+- 
+Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen
+Teil auszuwählen. Die gewünschten Namen werden einfach in
+beliebiger Reihenfolge angekreuzt und anschließend in dieser
+Reihenfolge verwendet. 
+Die Schreibmarke (Cursor) gibt an, welcher Name gerade
+angekreuzt werden kann. Mit den Pfeiltasten kann der Cursor
+auf den Kreisen bewegt werden. '+' kreuzt einen Namen an, '-'
+löscht die Ankreuzung wieder. 
+Mit ESC 'q' wird die Auswahl verlassen. ESC 'h' bricht die
+Auswahl und die folgende Funktion ab. Falls das Angebot nicht
+auf den Bildschirm paßt, wird es gerollt. ESC '1' positioniert
+immer auf den Anfang und ESC '9' auf das Ende der Auswahl. Mit
+HOP '+' werden alle noch nicht angekreuzten Namen angekreuzt,
+mit HOP '-' werden alle Ankreuzungen gelöscht. 
+Der Balken an der rechten Seite gibt an, welcher Teil der
+ganzen Auswahl sichtbar ist, wenn nicht alle Namen auf eine
+Seite passen. 
+% ENDE 
+% HILFE "AUSWAHL/Felder" 
+% SEITE 1 
+Feldauswahl: 
+- 
+Sie können hier alle Felder ankreuzen, die Sie ändern wollen.
+Ändern können Sie den Feldnamen bzw. den Feldtyp. Wollen Sie
+keine Felder ändern, drücken Sie einfach ESC 'q'. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Sortierfelder" 
+% SEITE 1 
+Auswahl Sortierfelder: 
+- 
+Kreuzen Sie hier die Felder an, die bei der Sortierung
+berücksichtigt werden sollen. Die Reihenfolge des Ankreuzens
+ist wichtig. Beim Vergleich zweier Sätze wird erst das als
+erstes angekreuzte Feld verglichen und danach die Einordnung
+der Sätze bestimmt. Ist dieses Feld bei beiden gleich, wird
+das nächste angekreuzte Feld untersucht usw. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Anzeigefelder" 
+% SEITE 1 
+Auswahl Anzeigefelder: 
+- 
+Kreuzen Sie hier alle Felder an, die Sie angezeigt haben
+möchten. Die Felder erscheinen in der angekreuzten
+Reihenfolge. Für beide Arten der Anzeige können Sie eine
+separate Feldauswahl einstellen. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Druckfelder" 
+% SEITE 1 
+Auswahl Druckfelder: 
+- 
+Kreuzen Sie hier alle Felder an, die Sie im Ausdruck sehen
+möchten. Die Reihenfolge des Ankreuzens bestimmt die
+Reihenfolge beim Ausdruck. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Feldnamen" 
+% SEITE 1 
+Auswahl Feldnamen: 
+- 
+Durch Blättern in der Auswahl können Sie die Schreibweise der
+Feldnamen ansehen. Die Namen, die Sie ankreuzen, werden danach
+mit spitzen Klammern in die gerade editierte Datei übernommen. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Archiv" 
+% SEITE 1 
+Auswahl Archivdateien: 
+- 
+Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien
+an. Kreuzen Sie die Dateien an, die Sie bearbeiten möchten.
+Die Dateien werden in der angekreuzten Reihenfolge verwendet. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Datei" 
+% SEITE 1 
+Auswahl Dateien: 
+- 
+Diese Auswahl zeigt alle Dateien auf dem System, die Sie
+verwenden können. Kreuzen Sie die gewünschte(n) Datei(en) an. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "FEHLER/Allgemein" 
+% SEITE 1 
+FEHLERMELDUNGEN: 
+- 
+Fehlermeldungen werden von einem Programm abgesetzt, wenn es
+seine Funktion nicht durchführen kann. Der Text der Meldung
+identifiziert die Ursache des Problems. Zur Zeit liegen noch
+keine meldungsspezifischen Informationen vor, schauen Sie ggf.
+in das Benutzerhandbuch. 
+% ENDE 
+% HILFE "FEHLER/9" 
+% SEITE 1 
+Programmfehler: 
+- 
+Diese Fehlermeldung deutet auf einen internen Programmfehler
+(wenn Sie nicht selber ein Programm geschrieben haben). Melden
+Sie diesen Fehler bitte, damit eine Korrektur vorgenommen
+werden kann. Schreiben Sie sich dazu die Begleitumstände auf
+(welche Datei haben Sie benutzt, welche Funktion). Versuchen
+Sie gegebenenfalls, den Fehler zu wiederholen. Es ist nämlich
+z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei
+auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der
+Fehler an einer bestimmten Datei liegt, sichern Sie diese
+Datei bitte auf einer Diskette, um sie eventuell einschicken
+zu können. 
+% ENDE 
+% HILFE "FEHLER/10" 
+% SEITE 1 "FEHLER/9" 
+% ENDE 
+% HILFE "FEHLER/11" 
+% SEITE 1 "FEHLER/9" 
+% ENDE 
+% HILFE "FEHLER/14" 
+% SEITE 1 "FEHLER/9" 
+% ENDE 
+% HILFE "GET/Allgemein" 
+% SEITE 1 
+EINGABE: 
+- 
+Die Eingabe erwartet von Ihnen eine bestimmte Information, die
+Sie eingeben sollen. Die Art der Information wird durch den
+Anforderungstext angegeben. Wenn Sie sich beim Eintippen
+verschrieben haben, können Sie mit den Pfeiltasten zurückgehen
+und den Text korrigieren. Eine bereits dastehende Information
+können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN
+schaltet in den Einfügemodus (Zeichen werden nicht mehr
+überschrieben). Beenden Sie die Eingabe mit RETURN. ESC 'h'
+bricht die Eingabe und die folgende Funktion ab. Wenn in der
+Statuszeile angegeben, können Sie mit ESC 'z' eine Auswahl
+verfügbarer Namen abrufen, die Sie dann Ankreuzen können. 
+% ENDE 
+% HILFE "GET/Sicherungsname" 
+% SEITE 1 
+Neuer Name für Arbeitskopie: 
+- 
+Sie können jetzt den Namen angeben, unter dem die Arbeitskopie
+gespeichert werden soll. Ihnen wird der alte Name zum
+Überschreiben angeboten. Drücken Sie nur RETURN, wird der alte
+Name genommen und die alte Version überschrieben. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Dateiname" 
+% SEITE 1 
+Dateiname: 
+- 
+Bitte geben Sie den Namen der Datei ein, mit dem die Operation
+ausgeführt werden soll. Mit ESC 'z' können Sie sich die zur
+Verfügung stehenden Namen auch als Auswahl zeigen lassen. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/feldname" 
+% SEITE 1 
+Feldname: 
+- 
+Sie können den Namen des angegebenen Feldes ändern, indem Sie
+den alten Namen überschreiben bzw. korrigieren. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/auf Satz" 
+% SEITE 1 
+Satznummer: 
+- 
+Sie können hier die Satznummer des Satzes eingeben, den Sie
+sehen wollen. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/auf Schluessel" 
+% SEITE 1 
+Inhalt des Schlüsselfeldes: 
+- 
+Geben Sie hier den Inhalt des Schlüsselfeldes von dem Satz
+an, den Sie suchen. Wenn Sie Suchbedingungen benötigen,
+müssen Sie ein Suchmuster einstellen. Direse Funktion prüft
+nur auf absolute Identität. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/listenbreite" 
+% SEITE 1 
+Maximale Listenbreite: 
+- 
+Geben Sie hier die maximal Anzahl von Zeichen an, die zum
+Ausdrucken zur Verfügung stehen. Werden mehr Zeichen für
+einen Satz gebraucht, werden Inhalte abgeschnitten. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/copy" 
+% SEITE 1 
+Dateiname für Kopie: 
+- 
+Geben Sie hier den Namen für die logische Kopie der Datei an.
+Dieser Name darf keine existierende Datei bezeichnen. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Archivname" 
+% SEITE 1 
+Name des Archivs: 
+- 
+Geben Sie den Namen des eingelegten Archivs ein (zur
+Sicherheit). Der zuletzt verwendete Name wird zum Ändern
+angeboten. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/rename" 
+% SEITE 1 
+Neuer Dateiname: 
+- 
+Sie können den alten Namen der Datei durch Überschreiben und
+Korrigieren ändern. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Druckdatei" 
+% SEITE 1 
+Name der Druckdatei: 
+- 
+Geben Sie hier den Namen der Datei ein, in die die Ausgabe des
+Druckprozesses geschrieben werden soll. Drücken Sie einfach
+RETURN, wenn Sie keinen besonderen Namen wollen. EUDAS erzeugt
+einen Namen der Form "druckmuster.a$n" mit 'n' zur
+Unterscheidung mehrerer Ausgaben. 
+Die angegebene Datei wird nur für den nächsten Druckvorgang
+verwendet. Sie müssen den Namen also jedes Mal wieder neu
+angeben. Existiert die Datei schon, wird die Ausgabe an das
+Ende angehängt. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Zielarchiv" 
+% SEITE 1 
+Name Zielarchiv: 
+- 
+Geben Sie hier entweder den Namen einer Archivtask ein
+(normalerweise "ARCHIVE") oder einer anderen Managertask. Bei
+Netzbetrieb können Sie auch die Station anschließend angeben. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Zielstation" 
+% SEITE 1 
+Zielstation: 
+- 
+Geben Sie hier die Stationsnummer der Zieltask ein. Wenn sich
+die Zieltask in Ihrem eigenen System befindet, brauchen Sie
+nur RETURN zu drücken. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/multi task" 
+% SEITE 1 
+Name Managertask: 
+- 
+Sie können hier den Namen einer EUDAS-Managertask angeben
+(EUDAS muß in dieser Task insertiert sein). Wenn Sie keinen
+Namen angeben, werden keine entsprechenden Abfragen beim
+Öffnen mehr gemacht. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/kopiermuster" 
+% SEITE 1 
+Name Kopiermuster: 
+- 
+Geben Sie den Namen einer Datei ein, in der das Kopiermuster
+stehen soll. Drücken Sie einfach RETURN, wenn Sie das Muster
+nicht aufbewahren wollen. Wenn die Datei noch nicht existiert,
+wird das Standard-Kopiermuster in die Datei geschrieben.
+Anschließend kann das Muster noch im Editor geändert werden. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "JA/Allgemein" 
+% SEITE 1 
+FRAGEN: 
+- 
+Das Programm stellt Ihnen eine Frage, die Sie bejahen oder
+verneinen können. Sie bejahen die Frage, indem Sie 'j' drücken
+und verneinen Sie mit 'n' (beides groß oder klein). Mit ESC
+'h' können Sie die Funktion abbrechen. 
+% ENDE 
+% HILFE "JA/oeffne" 
+% SEITE 1 
+Änderungen vornehmen? 
+- 
+Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur
+ansehen wollen. In diesem Fall wird keine Sicherheitskopie
+erstellt. Verneinen Sie die Frage, wird eine interen Kopie
+angelegt, die Sie dann verändern können. Die Kopie muß nach
+dem Ändern gesichert werden. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Dateien loeschen" 
+% SEITE 1 
+Arbeitskopien löschen? 
+- 
+Beim Sichern hatten Sie Gelegenheit, alle veränderten
+Arbeitskopien zu sichern. Die Arbeitskopien können damit
+gelöscht werden. Dazu bejahen Sie die Frage. Wenn die Dateien
+jedoch noch geöffnet bleiben sollen, oder Sie eine Datei aus
+Versehen nicht gesichert haben, müssen Sie diese Frage
+verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/ueber" 
+% SEITE 1 
+Datei überschreiben? 
+- 
+Sie haben für die Arbeitskopie einen Namen angegeben, der noch
+existiert. Bejahen Sie die Frage, wird die alte Datei dieses
+Namens überschrieben. Anderenfalls erhalten Sie eine neue
+Gelegenheit, einen Namen einzugeben. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Sicherungssortierung" 
+% SEITE 1 
+Sortierung wiederherstellen? 
+- 
+Die angegebene Datei war früher schon einmal sortiert worden.
+Die Sortierung wurde jedoch durch nachfolgende Änderungen
+zerstört. Wenn Sie die Datei wieder sortiert haben wollen,
+beantworten Sie die Frage mit 'j'. Die Sortierung dauert nicht
+lange, wenn nur wenige Sätze verändert wurden. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/feldnamen" 
+% SEITE 1 
+Feldnamen anfügen? 
+- 
+Falls Sie neue Felder zu den existierenden anfügen wollen,
+müssen Sie diese Frage bejahen. Sie erhalten dann Gelegenheit,
+die neuen Namen im Editor einzugeben. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Sortierfelder" 
+% SEITE 1 
+Sortierreihenfolge ändern? 
+- 
+Die Reihenfolge, in der die Felder bei der Sortierung
+berücksichtigt werden, ist in der EUDAS-Datei intern
+gespeichert. Wenn Sie diese Reihenfolge, die beim letzten
+Sortieren angegeben wurde, ändern möchten, müssen Sie die
+Frage bejahen. Sie können dann die neue Feldreihenfolge
+auswählen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/sortieren" 
+% SEITE 1 
+Zieldatei sortieren? 
+- 
+Wenn Sie diese Frage bejahen, wird die Zieldatei nach
+Ausführung der Funktion in ihrer eingestellten Feldreihenfolge
+sortiert. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/forget" 
+% SEITE 1 
+Datei löschen? 
+- 
+Wenn Sie diese Frage bejahen, wird die Datei wirklich
+gelöscht. Wenn Sie die Datei irrtümlich gewählt haben, müssen
+Sie die Frage verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/einrichten" 
+% SEITE 1 
+Datei neu einrichten? 
+- 
+Sie haben eine Datei angegeben, die noch nicht existiert. Wenn
+Sie die Frage bejahen, wird die Datei neu eingerichtet.
+Anderenfalls wird die Funktion abgebrochen, so daß Sie
+Gelegenheit haben, die Funktion mit einem neuen Namen zu
+wiederholen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/testen" 
+% SEITE 1 
+Prüfbedingungen beachten? 
+- 
+Wenn Sie diese Frage bejahen, werden beim Tragen die
+Prüfbedingungen der Zieldatei abgefragt. Sätze, die diese
+Bedingungen nicht erfüllen, werden nicht getragen und können
+danach geändert werden. Beim Ändern wird dann jeweils die den
+Satz betreffende Meldung ausgegeben. Die Prüfbedingungen der
+Zieldatei können Sie mit der Funktion "Feldstruktur aendern"
+angeben oder ändern. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/save" 
+% SEITE 1 
+Datei überschreiben? 
+- 
+Die angegebene Datei befindet sich bereits auf dem Archiv.
+Wenn Sie die Datei überschreiben wollen, müssen Sie die Frage
+bejahen. Ansonsten wird die Datei nicht auf das Archiv
+geschrieben (keine Wirkung). 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/fetch" 
+% SEITE 1 
+Datei überschreiben? 
+- 
+Die angegebene Datei ist bereits im System vorhanden. Wenn Sie
+diese Datei überschreiben wollen, müssen Sie die Frage
+bejahen. Anderenfalls wird keine Aktion vorgenommen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/erase" 
+% SEITE 1 
+Datei löschen? 
+- 
+Zur Sicherheit wird gefragt, ob Sie die angegebene Datei
+wirklich auf dem Archiv löschen wollen. Wenn Sie die Frage
+verneinen, wird keine Aktion durchgeführt. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/format" 
+% SEITE 1 
+Formatieren? 
+- 
+Wenn Ihr Rechner dies unterstützt, können Sie Archivdisketten
+vor dem Initialisieren noch physikalisch formatieren. Dies ist
+immer dann notwendig, wenn eine Diskette neu ist (vor der
+ersten Benutzung) oder wenn Schreibfehler aufgetreten sind,
+die sich nicht mehr reparieren lassen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/archiv loeschen" 
+% SEITE 1 
+Archiv löschen? 
+- 
+Wenn Sie irrtümlich die falsche Diskette eingelegt haben oder
+eine andere Funktion ausführen wollten, können Sie die
+Funktion durch Verneinen der Frage abbrechen. Achten Sie auf
+den angegebenen Archivnamen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/alle Saetze" 
+% SEITE 1 
+Alle Sätze drucken? 
+- 
+Wenn Sie die Frage bejahen, werden anschließend alle Sätze,
+die in der Übersicht zu sehen waren, gedruckt. Den Namen des
+Druckmusters können Sie dann gleich eingeben. Wenn Sie keinen
+oder nur den aktuellen Satz drucken wollen, müssen Sie die
+Frage verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/alle markierten" 
+% SEITE 1 
+Alle markierten Sätze drucken? 
+- 
+Wenn Sie die Frage bejahen, werden anschließend alle
+markierten Sätze gedruckt. Den Namen des Druckmusters können
+Sie dann gleich eingeben. Wenn Sie keinen oder nur den
+aktuellen Satz drucken wollen, müssen Sie die Frage verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Einzelsatz drucken" 
+% SEITE 1 
+Aktuellen Satz drucken? 
+- 
+Wenn Sie die Frage bejahen, wird der aktuelle (markierte) Satz
+gedruckt. Den Namen des Druckmusters können Sie dann gleich
+eingeben. Wenn Sie keinen Satz drucken wollen, müssen Sie die
+Frage verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/noch einmal" 
+% SEITE 1 
+Noch einmal? 
+- 
+Wenn Sie die Frage bejahen, können Sie noch einmal die Datei
+mit einer neuen Suchbedingung ansehen und erneut drucken.
+Sonst kehren Sie wieder in den Editor zurück. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Ub.Felder" 
+% SEITE 1 
+Felder auswählen? 
+- 
+Wenn Sie die Frage bejahen, können Sie einzelne Felder in
+einer bestimmten Reihenfolge für die Übersichtsanzeige
+auswählen. Anderenfalls werden alle Felder angezeigt. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Suchmuster" 
+% SEITE 1 
+Suchbedingung angeben? 
+- 
+Wenn Sie die Frage bejahen, können Sie eine Suchbedingung für
+die angezeigten Sätze angeben. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/umschalten" 
+% SEITE 1 
+Auf Koppeldatei umschalten? 
+- 
+Wenn Sie die Frage bejahen, schalten Sie auf die genannte
+Koppeldatei um. Damit wird diese Datei zeitweise als einzige
+geöffnete betrachtet. Damit können Sie einen bestimmten Satz
+aufsuchen, den Sie später beim Zurückschalten übernehmen
+können. Verneinen Sie die Frage, werden Ihnen weitere mögliche
+Koppeldateien angeboten, oder Sie kehren ohne Schaden zurück. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/uebernehmen" 
+% SEITE 1 
+Koppelfelder übernehmen? 
+- 
+Wenn Sie die Frage bejahen, werden die Koppelfelder des jetzt
+ausgewählten Satzes in den aktuellen Satz der ersten Datei
+übernommen, an dem Sie dann weiter ändern können. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Sortierrichtung" 
+% SEITE 1 
+Aufsteigend sortieren? 
+- 
+Wenn Sie die Frage bejahen, wird die Datei nach dem genannten
+Feld in aufsteigender Richtung sortiert, anderenfalls in
+absteigender. Für weitere Felder können Sie wieder eine andere
+Richtung angeben. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/zeilenform" 
+% SEITE 1 
+Zeilenweise formatieren? 
+- 
+Wenn Sie die Frage bejahen, wird die angegebene Datei
+zeilenweise interaktiv formatiert. Der Text wird unter
+Berücksichtigung der Schrifttypen gleichmäßig auf die Zeilen
+verteilt. Beachten Sie die Wirkung der Absatzmarken! 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/seitenform" 
+% SEITE 1 
+Seitenweise formatieren? 
+- 
+Wenn Sie die Frage bejahen, wird die angegebene Datei
+interaktiv seitenweise formatiert. Der Text wird bis zur
+angegebenen Seitenlänge auf die Seiten verteilt. Dabei werden
+Seitenköpfe und Fußnoten eingefügt. Das Ergebnis steht in der
+Datei "xxx.p". 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/pw loeschen" 
+% SEITE 1 
+Passwort löschen? 
+- 
+Wenn Sie die Frage bejahen, wird das Passwort gelöscht und das
+leere Passwort eingestellt. Anderenfalls bleibt das alte
+Passwort erhalten. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/manager aus" 
+% SEITE 1 
+Manager ausschalten? 
+- 
+Wenn Sie die Frage bejahen, berücksichtigt EUDAS im weiteren
+keine Managertask mehr. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Feldtypen aendern" 
+% SEITE 1 
+Feldtypen ändern? 
+- 
+Wenn Sie die Frage bejahen, können Sie den Typ von
+existierenden Feldern verändern. Der Feldtyp hat nur
+Auswirkungen beim Größenvergleich (Suchen und Sortieren). 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Feldnamen aendern" 
+% SEITE 1 
+Feldnamen ändern? 
+- 
+Wenn Sie die Frage bejahen, können Sie existierende Feldnamen
+in ihrer Schreibweise verändern. Diese Funktion hat keine
+Auswirkung auf die Dateiinhalte. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/eingelegt" 
+% SEITE 1 
+Diskette eingelegt? 
+- 
+Legen Sie bitte die gewünschte Diskette ein und bejahen Sie
+die Frage. Anderenfalls wird die Funktion ohne Wirkung
+beendet. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Ausgabe drucken" 
+% SEITE 1 
+Ausgabe drucken? 
+- 
+Wenn Sie die Frage bejahen, wird die gezeigte Datei sofort
+ausgedruckt. Anderenfalls können Sie sie ggf. aufbewahren. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Ausgabe loeschen" 
+% SEITE 1 
+Ausgabe löschen? 
+- 
+Wenn Sie die Frage bejahen, wird die gezeigte Datei
+gelöscht. Anderenfalls wird sie für eine weitere Bearbeitung
+aufbewahrt. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Allgemein" 
+% SEITE 1 
+EDITOR: 
+- 
+Mit dem Editor können Sie einen Text zeilenweise eingeben.
+Dabei können Sie den Cursor mit den Pfeiltasten bewegen.
+RUBOUT löscht ein Zeichen, RUBIN schaltet in den Einfügemodus
+um. Für weitere Informationen zum Editor s.
+EUMEL-Benutzerhandbuch. ESC 'q' verläßt den Editor normal. Mit
+ESC 'h' wird die Funktion abgebrochen. 
+% ENDE 
+% HILFE "EDIT/Feldnamen" 
+% SEITE 1 
+Neue Feldnamen: 
+- 
+Sie können hier die neuen Feldnamen in der gewünschten
+Reihenfolge untereinander eingeben. Jeder Feldname muß in
+einer Zeile stehen und ohne Anführungsstriche geschrieben
+sein. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Pruefbed" 
+% SEITE 1 
+Prüfbedingungen: 
+- 
+Sie können hier die Prüfbedingungen der Datei eingeben bzw.
+ändern. Die Prüfbedingungen sind ein ELAN-Programm. Da ELAN-
+Programme formatfrei sind, kann es sein, daß Ihr Programm beim
+nächsten Mal anders erscheint, als Sie es eingegeben haben. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Notizen" 
+% SEITE 1 
+Notizen: 
+- 
+Sie können jetzt zu der angegebenen Datei beliebige Notizen
+eingeben bzw. ändern. Sie befinden sich im Editor und können
+die gleichen Funktionen wie bei der normalen Texteingabe
+verwenden. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Suchen" 
+% SEITE 1 
+Suchmuster: 
+- 
+Sie können jetzt eine Selektionsbedingung einstellen. Dazu
+müssen Sie jeweils neben den Feldnamen eine Bedingung
+schreiben. Mögliche Bedingungen sind: 
+ Text         muß gleich sein 
+ Text*        muß mit Text anfangen 
+ *Text        muß mit Text enden 
+ *Text*       enthält Text 
+ Text..       muß größer oder gleich Text sein 
+ ..Text       muß kleiner als Text sein oder mit Text anfangen 
+ Text1..Text2 liegt zwischen den beiden Texten 
+"--" verneint eine Bedingung. Weitere Bedingungen und
+Kombination von Bedingungen s. EUDAS-Benutzerhandbuch. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Einfuegen" 
+% SEITE 1 
+Satz einfügen: 
+- 
+Sie können hier die Inhalte eines neuen Satzes eingeben, der
+vor dem aktuellen Satz eingefügt wird. 
+Spezielle Tastenkombinationen: 
+ ESC RUBOUT     Rest der Zeile löschen 
+ ESC RUBIN      Zeile aufbrechen 
+ ESC OBEN       nach oben blättern 
+ ESC UNTEN      nach unten blättern 
+ ESC '1'        auf erste Zeile 
+ ESC '9'        auf letzte Zeile 
+ ESC 'h'        Abbruch, der Satz wird nicht eingefügt 
+ ESC 'w'        Beenden und gleich den nächsten Satz einfügen 
+ ESC 'D'        aktuelles Tagesdatum schreiben 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Aendern" 
+% SEITE 1 
+Satz ändern: 
+- 
+Sie können die Inhalte des aktuellen Satzes hier abändern. 
+Spezielle Tastenkombinationen: 
+ ESC RUBOUT     Rest der Zeile löschen 
+ ESC RUBIN      Zeile aufbrechen 
+ ESC OBEN       nach oben blättern 
+ ESC UNTEN      nach unten blättern 
+ ESC '1'        auf erste Zeile 
+ ESC '9'        auf letzte Zeile 
+ ESC 'h'        Abbruch, der Satz bleibt unverändert 
+ ESC 'w'        Beenden und gleich den nächsten Satz ändern 
+ ESC 'D'        aktuelles Tagesdatum schreiben 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Druckmuster" 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Verarbeite" 
+% SEITE 1 
+Verarbeitungsvorschrift: 
+- 
+Sie können hier eine Verarbeitungsvorschrift eingeben. Die
+Verarbeitungsvorschrift ist ein ELAN-Programm. Ein Feld wird
+geändert durch den Operator "V": 
+  "Feldname" V "neuer Feldinhalt"; 
+Statt des neuen Feldinhalts kann auch ein beliebiger
+ELAN-Ausdruck angegeben werden. Mit 
+  f ("Feldname") 
+wird der Inhalt eines Feldes als Text geliefert. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Kopiermuster" 
+% SEITE 1 
+Kopiermuster: 
+- 
+Sie können das hier angegebene Kopiermuster verändern. Sollen
+Felder nicht kopiert werden, brauchen Sie nur die
+entsprechenden Zeilen zu löschen. Soll eine Feld andere
+Inhalte bekommen, geben Sie in dem Ausdruck 
+  "Feldname" K f ("Feldname"); 
+hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge
+der K-Ausdrücke bestimmt die Reihenfolge der Feldnamen in der
+Zieldatei, wenn die Zieldatei noch nicht existierte. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "EDIT/Druckausgabe" 
+% SEITE 1 
+Druckausgabe: 
+- 
+Sie können hier das Ergebnis der Druckgenerierung ansehen
+und ggf. noch verändern. Nach Verlassen des Editors mit ESC
+q wird der Text auf Anfrage gedruckt. 
+% SEITE 1 "EDIT/Allgemein" 
+% ENDE 
+% HILFE "UEBERSICHT" 
+% SEITE 1 
+UEBERSICHT: 
+- 
+In diesem Modus können Sie sich alle Sätze der Datei durch
+Blättern ansehen. Der aktuelle Satz ist jeweils markiert. Die
+eingestellte Suchbedingung wird beachtet. Mit den Pfeiltasten
+OBEN und UNTEN bewegen Sie sich vorwärts und rückwärts in der
+Datei. Mit HOP OBEN, HOP UNTEN und HOP RETURN blättern Sie wie
+im Editor. Mit ESC '1' gelangen Sie an den Anfang, mit ESC '9'
+an das Ende der Datei. Mit '+' und '-' können Sie die
+Markierung des aktuellen Satzes für spätere Verarbeitung
+ändern. Verlassen Sie die Übersicht mit ESC 'q'. 
+% ENDE 
+% HILFE "SHOW/Uebersicht" 
+% SEITE 1 
+Dateiübersicht: 
+- 
+In der gezeigten Dateiübersicht können Sie mit HOP OBEN und
+HOP UNTEN blättern, wenn nicht alle Dateien auf eine Seite
+passen. Verlassen Sie die Übersicht mit ESC 'q'. 
+% ENDE 
+% HILFE "WAHL/Allgemein" 
+% SEITE 1 
+Horizontale WAHL eines Parameters: 
+- 
+Sie können aus den angezeigten Alternativen eine auswaehlen,
+indem sie sie mit den Cursortasten RECHTS und LINKS markieren.
+Durch RETURN bestätigen Sie die getroffene Wahl. Sie können
+ihre Wahl auch durch Eintippen des ersten Buchstabens einer
+Option angeben (klein oder groß geschrieben). ESC 'h' bricht
+die aktuelle Funktion ab. 
+% ENDE 
+% HILFE "WAHL/Feldtypen" 
+% SEITE 1 
+Feldtypen: 
+- 
+Sie können hier einen von vier möglichen Typen auswaehlen: 
+ TEXT  normaler Text mit Vergleich nach EUMEL-Code. 
+ DIN   Text, der nach DIN 5007 verglichen wird (Umlaute
+ richtig, Groß-/Kleinschreibung und Sonderzeichen ignoriert). 
+ ZAHL  Alle nichtnumerischen Zeichen außer Minus und
+ Dezimalkomma werden beim Vergleichen ignoriert. 
+ DATUM Datum der Form "tt.mm.jj" 
+Die Feldtypen werden beim Sortieren und Suchen beachtet. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+% HILFE "WAHL/sichere" 
+% SEITE 1 
+Wahlmöglichkeiten beim Sichern: 
+- 
+Sie haben drei Möglichkeiten. 
+1. Die Arbeitskopie überschreibt die alte Version (Original)
+vor den Änderungen. 
+2. Sie ignoriere die Veränderungen momentan. Die Arbeitskopie
+bleibt weiter erhalten, wenn Sie am Ende des Sicherns
+nichts anderes angeben. 
+3. Die geänderte Arbeitskopie kann unter einem neuen Namen
+gespeichert werden, so daß das Original erhalten bleibt.
+Sie erhalten anschließend Gelegenheit zur Eingabe des neuen
+Namens. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+% HILFE "WAHL/format" 
+% SEITE 1 
+Auswahl des Diskettenformats: 
+- 
+Sie haben die Wahl zwischen den angegebenen Diskettenformaten.
+Wenn Sie sich damit nicht auskennen, wählen Sie das
+Standardformat. Die Angabe bezieht sich nur auf den
+Formatiervorgang; beim Lesen wird das Format der Diskette
+automatisch erkannt. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+% HILFE "WAHL/zielarchiv" 
+% SEITE 1 
+Art des Zielarchivs: 
+- 
+Sie können wählen zwischen: 
+ 
+Std-Archiv      Normales Archiv 
+Dateimanager    Eine Managertask wie z.B. PUBLIC 
+Zweites Archiv  Zur Bedienung eines zweiten Diskettenlaufwerks
+und zum Archivieren über Netz 
+Formatumsetzer  Für andere Diskettenformate, z.B. DOS 
+ 
+Außer im ersten Fall können Sie anschließend den Namen des
+Zielarchivs eingeben. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+% HILFE "WAHL/Richtung" 
+% SEITE 1 
+Richtung der Druckausgabe 
+- 
+Sie können wählen zwischen: 
+ 
+Drucker          Die Druckausgabe wird direkt gedruckt und
+dann gelöscht 
+Bildschirm       Die Ausgabe wird im Editor gezeigt und kann
+danach auf Anfrage gedruckt und gelöscht werden 
+Textdatei        Die Ausgabe erfolgt in eine Textdatei. Der
+Name dieser Datei wird vor jedem Drucken erfragt. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+% HILFE "WAHL/Std-Listen" 
+% SEITE 1 
+Art der Listen 
+- 
+Sie können wählen zwischen: 
+ 
+Kommaliste       Alle Felder werden durch Komma getrennt
+aneinandergehängt 
+Spaltenanordnung Die Felder werden in Spalten angeordnet,
+wobei die Spaltenbreite durch einen Durchlauf durch die
+Datei ermittelt wird. 
+% SEITE 1 "WAHL/Allgemein" 
+% ENDE 
+
diff --git a/app/eudas/5.3/src/eudas.listen.01 b/app/eudas/5.3/src/eudas.listen.01
new file mode 100644
index 0000000..47e7270
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.listen.01
@@ -0,0 +1,276 @@
+PACKET eudas std listen
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Drucken von Standardlisten ohne Druckmuster                       *)
+(*                                                                       *)
+(*     Version 01                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 06.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+ 
+  DEFINES
+
+  drucke standardlisten,
+  std listenbreite,
+  std listenlaenge,
+  std listenfont :
+
+
+LET
+  listendruckmuster = "******* Listendruckmuster *******";
+
+FILE VAR f;
+
+TEXT VAR puffer, feldname;
+
+TEXT VAR std font := "";
+
+INT VAR
+  std breite := 70,
+  std laenge := 60;
+
+
+
+PROC std listenbreite (INT CONST breite) :
+  std breite := breite
+END PROC std listenbreite;
+
+INT PROC std listenbreite :
+  std breite
+END PROC std listenbreite;
+
+PROC std listenlaenge (INT CONST laenge) :
+  std laenge := laenge
+END PROC std listenlaenge;
+
+INT PROC std listenlaenge :
+  std laenge
+END PROC std listenlaenge;
+
+PROC std listenfont (TEXT CONST font) :
+  std font := font
+END PROC std listenfont;
+
+TEXT PROC std listenfont :
+  std font
+END PROC std listenfont;
+
+PROC drucke standardlisten (INT CONST listenform, TEXT CONST feldliste) :
+
+  forget (listendruckmuster, quiet);
+  f := sequential file (output, listendruckmuster);
+  maxlinelength (f, std breite);
+  IF kommaliste THEN
+    generiere komma druckmuster (feldliste)
+  ELSE
+    generiere spalten druckmuster (feldliste)
+  END IF;
+  TEXT CONST last := std;
+  drucke (listendruckmuster);
+  forget (listendruckmuster, quiet);
+  last param (last) .
+
+kommaliste :
+  listenform = 2 .
+
+END PROC drucke standardlisten;
+
+ROW 100 INT VAR feld max;
+
+INT VAR
+  zeilen pro satz,
+  zeilenlaenge,
+  feldlaenge,
+  druckfelder,
+  ges max;
+
+PROC generiere listenkopf :
+
+  IF std font <> "" THEN
+    putline (f, "#type(" + textdarstellung (std font) + ")#")
+  END IF;
+  putline (f, "% GRUPPE 1 seitennummer");
+  putline (f, "% VOR");
+  put (f, date); put (f, time of day); put (f, "Uhr:");
+  put (f, eudas dateiname (1));
+  write (f, (std breite - length (eudas dateiname (1)) - 25) * " ");
+  putline (f, "&&-S");
+  line (f)
+
+END PROC generiere listenkopf;
+
+PROC generiere seitenvorschub :
+
+  putline (f, "% NACH");
+  putline (f, "#page#");
+  putline (f, "% ABK");
+  putline (f, "&? : lfd nr .");
+  putline (f, "&-S : seitennummer .");
+  putline (f, "seitennummer :");
+  putline (f, "  text (int (lfd nr) DIV saetze pro seite + 1) .");
+  write (f, "saetze pro seite : ");
+  put (f, (std laenge - 2) DIV zeilen pro satz - 1);
+  putline (f, ".")
+
+END PROC generiere seitenvorschub;
+
+PROC generiere komma druckmuster (TEXT CONST feldliste) :
+
+  generiere listenkopf;
+  generiere feldueberschriften;
+  generiere wiederholungsteil;
+  generiere seitenvorschub .
+
+generiere feldueberschriften :
+  write (f, "Nr. ");
+  FOR i FROM 1 UPTO length (feldliste) REP
+    feldnamen lesen (code (feldliste SUB i), feldname);
+    IF i < length (feldliste) THEN
+      write (f, feldname + ", ")
+    ELSE
+      write (f, feldname)
+    END IF
+  END REP;
+  line (f);
+  putline (f, maxlinelength (f) * "-");
+  zeilen pro satz := 1 .
+
+generiere wiederholungsteil :
+  putline (f, "% WDH");
+  INT CONST max alt := maxlinelength (f);
+  INT VAR i;
+  maxlinelength (f, 10000);
+  write (f, "&&? ");
+  FOR i FROM 1 UPTO length (feldliste) REP
+    ein feldname als muster
+  END REP;
+  line (f);
+  maxlinelength (f, max alt) .
+
+ein feldname als muster :
+  write (f, "%<");
+  feldnamen lesen (code (feldliste SUB i), feldname);
+  write (f, feldname);
+  write (f, ">");
+  IF i < length (feldliste) THEN write (f, ", ") END IF .
+
+END PROC generiere komma druckmuster;
+
+PROC maxima suchen (TEXT CONST feldliste) :
+
+  INT VAR i;
+  maxima initialisieren;
+  auf satz (1);
+  INT VAR modus;
+  IF markierte saetze > 0 THEN
+    modus := 3;
+    IF NOT satz markiert THEN weiter (3) END IF
+  ELSE
+    modus := 2;
+    IF NOT satz ausgewaehlt THEN weiter (2) END IF
+  END IF;
+
+  WHILE NOT dateiende REP
+    einen satz testen;
+    weiter (modus)
+  END REP .
+
+maxima initialisieren :
+  druckfelder := length (feldliste);
+  FOR i FROM 1 UPTO druckfelder REP
+    feld max (i) := 2
+  END REP;
+  ges max := 0 .
+
+einen satz testen :
+  INT VAR gesamt := 0;
+  FOR i FROM 1 UPTO druckfelder REP
+    feld bearbeiten (code (feldliste SUB i),
+                     PROC (TEXT CONST, INT CONST, INT CONST) fl);
+    IF feldlaenge > feld max (i) THEN feld max (i) := feldlaenge END IF;
+    gesamt INCR feldlaenge
+  END REP;
+  IF gesamt > ges max THEN ges max := gesamt END IF .
+
+END PROC maxima suchen;
+
+PROC fl (TEXT CONST satz, INT CONST von, bis) :
+  feldlaenge := bis - von + 1
+END PROC fl;
+
+PROC generiere spalten druckmuster (TEXT CONST feldliste) :
+
+  maxima suchen (feldliste);
+  generiere listenkopf;
+  generiere feldueberschriften;
+  generiere wiederholungsteil;
+  generiere abkuerzungen;
+  generiere seitenvorschub .
+
+generiere feldueberschriften :
+  TEXT VAR abk felder := "";
+  INT VAR i;
+  zeilenlaenge := 4;
+  zeilen pro satz := 1;
+  write (f, "Nr. ");
+  FOR i FROM 1 UPTO length (feldliste) REP
+    feldnamen lesen (code (feldliste SUB i), feldname);
+    IF length (feldname) + 2 >= feld max (i) THEN
+      abkuerzung einfuehren
+    END IF;
+    zeilenlaenge INCR feld max (i) + 1;
+    IF zeilenlaenge > std breite THEN
+      line (f); zeilenlaenge := feld max (i) + 1; zeilen pro satz INCR 1
+    END IF;
+    write (f, text (feldname, feld max (i) + 1))
+  END REP;
+  line (f);
+  putline (f, maxlinelength (f) * "-") .
+
+abkuerzung einfuehren :
+  abk felder CAT (feldliste SUB i) .
+
+generiere wiederholungsteil :
+  putline (f, "% WDH");
+  write (f, "&&? ");
+  FOR i FROM 1 UPTO length (feldliste) REP
+    ein feldmuster erzeugen
+  END REP;
+  line (f) .
+
+ein feldmuster erzeugen :
+  INT CONST abk pos := pos (abk felder, feldliste SUB i);
+  puffer := "&";
+  IF abk pos > 0 THEN
+    puffer CAT text (code (abk pos + 64), feld max (i))
+  ELSE
+    feldnamen lesen (code (feldliste SUB i), feldname);
+    puffer CAT text ("<" + feldname + ">", feld max (i))
+  END IF;
+  write (f, puffer) .
+
+generiere abkuerzungen :
+  IF abk felder <> "" THEN
+    putline (f, "% ABK");
+    FOR i FROM 1 UPTO length (abk felder) REP
+      eine abkuerzung generieren
+    END REP
+  END IF .
+
+eine abkuerzung generieren :
+  write (f, "&");
+  write (f, code (i + 64));
+  write (f, " : ");
+  write (f, "f (");
+  feldnamen lesen (code (abk felder SUB i), feldname);
+  write (f, textdarstellung (feldname));
+  putline (f, ") .") .
+
+END PROC generiere spalten druckmuster;
+
+
+END PACKET eudas std listen;
+
diff --git a/app/eudas/5.3/src/eudas.menues.14 b/app/eudas/5.3/src/eudas.menues.14
new file mode 100644
index 0000000..8ccdd5e
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.menues.14
@@ -0,0 +1,3157 @@
+PACKET eudas menues
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Menue-Manager                                                     *)
+(*                                                                       *)
+(*     Version 14                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 04.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  global manager,
+  menue manager,
+  lock,
+  free,
+  menuedaten einlesen,
+  menuenamen,
+  menue loeschen,
+
+  box zeichen,
+  waehlbar,
+  fusszeile,
+  fussteil,
+  ausfuehrtaste,
+  menue anbieten,
+  zeilenmenue anbieten,
+  auswahl anbieten,
+  wahl,
+  esc hop ausfuehren,
+
+  hilfe anbieten,
+  viel hilfe,
+  status anzeigen,
+  statuszeile,
+
+  dialogfenster,
+  dialogfenster loeschen,
+  dialog,
+  neuer dialog,
+  ja,
+  editget,
+  fehler ausgeben :
+
+
+(***************************** Zeilenanalyse *****************************)
+
+ROW 7 TEXT VAR kommandotext :=
+  ROW 7 TEXT : ("MENUE", "BILD", "FELD", "ENDE", "AUSWAHL",
+                 "HILFE", "SEITE");
+
+LET
+  menue kommando    = 1,
+  bild kommando     = 2,
+  feld kommando     = 3,
+  ende kommando     = 4,
+  auswahl kommando  = 5,
+  hilfe kommando    = 6,
+  seite kommando    = 7;
+
+LET
+  bold = 2,
+  integer = 3,
+  string = 4,
+  end of line = 7;
+
+LET
+  fehler in zeile =  #701#
+    "FEHLER in Zeile ";
+
+FILE VAR file;
+
+TEXT VAR
+  zeile,
+  kommando;
+
+
+PROC zeile lesen :
+
+  IF eof (file) THEN
+    zeile := "%DUMMY"
+  ELSE
+    read record (file, zeile);
+    IF zeile = niltext THEN zeile := blank END IF;
+    cout (line no (file));
+    down (file)
+  END IF
+
+END PROC zeile lesen;
+
+BOOL PROC kommandozeile :
+
+  IF (zeile SUB 1) = kommandozeichen THEN
+    kommando isolieren
+  ELSE
+    FALSE
+  END IF .
+
+kommando isolieren :
+  INT VAR typ;
+  replace (zeile, 1, blank);
+  scan (zeile);
+  replace (zeile, 1, kommandozeichen);
+  next symbol (kommando, typ);
+  IF typ <> bold THEN
+    fehler (kein kommando angegeben);
+    FALSE
+  ELSE
+    TRUE
+  END IF .
+
+END PROC kommandozeile;
+
+BOOL PROC kommando ist (INT CONST identifikation) :
+
+  kommandotext (identifikation) = kommando
+
+END PROC kommando ist;
+
+INT PROC int parameter :
+
+  TEXT VAR symbol;
+  INT VAR typ;
+  next symbol (symbol, typ);
+  IF typ = integer THEN
+    int (symbol)
+  ELSE
+    IF typ <> end of line THEN fehler (kein int parameter) END IF;
+    -1
+  END IF
+
+END PROC int parameter;
+
+TEXT PROC text parameter :
+
+  TEXT VAR symbol;
+  INT VAR typ;
+  next symbol (symbol, typ);
+  IF typ = string THEN
+    symbol
+  ELSE
+    IF typ <> end of line THEN fehler (kein text parameter) END IF;
+    niltext
+  END IF
+
+END PROC text parameter;
+
+PROC fehler (TEXT CONST meldung) :
+
+  note (fehler in zeile); note (line no (file) - 1); note line;
+  note (meldung); note line;
+  line; putline (meldung)
+
+END PROC fehler;
+
+
+(***************************** Fensterkoordinaten ************************)
+
+INT VAR
+  y laenge,
+  x laenge,
+  x pos,
+  y pos;
+
+PROC f cursor (INT CONST x, y) :
+
+  cursor (x pos + x - 1, y pos + y - 1)
+
+END PROC f cursor;
+
+
+(*************************** Box ****************************************)
+
+TEXT VAR
+  ecke links oben,
+  ecke rechts oben,
+  ecke links unten,
+  ecke rechts unten,
+  anschluss links,
+  anschluss rechts,
+  strich senkrecht,
+  strich waagerecht,
+  trennung waagerecht,
+  scroll voll,
+  scroll leer;
+
+TEXT VAR
+  blank 120 := 120 * " ",
+  strich 120,
+  trennung 120;
+
+box zeichen ("-:..`'::-", ""15""14"", "X ");
+
+
+PROC box zeichen (TEXT CONST begrenzer, s voll, s leer) :
+
+  scroll voll := s voll; scroll leer := s leer;
+  IF LENGTH begrenzer = 9 THEN
+    strich waagerecht := begrenzer SUB 1;
+    strich senkrecht := begrenzer SUB 2;
+    ecke links oben := begrenzer SUB 3;
+    ecke rechts oben := begrenzer SUB 4;
+    ecke links unten := begrenzer SUB 5;
+    ecke rechts unten := begrenzer SUB 6;
+    anschluss links := begrenzer SUB 7;
+    anschluss rechts := begrenzer SUB 8;
+    trennung waagerecht := begrenzer SUB 9
+  END IF;
+  strich 120 := 120 * strich waagerecht;
+  trennung 120 := 120 * trennung waagerecht
+
+END PROC box zeichen;
+
+PROC out oben (INT CONST laenge) :
+
+  out (ecke links oben);
+  outsubtext (strich 120, 1, laenge - 2);
+  out (ecke rechts oben)
+
+END PROC out oben;
+
+PROC out oben (INT CONST laenge, TEXT CONST kopf) :
+
+  out (ecke links oben);
+  outsubtext (strich 120, 1, laenge - 3 - length (kopf));
+  out (kopf);
+  out (strich waagerecht); out (ecke rechts oben)
+
+END PROC out oben;
+
+PROC out mitte (INT CONST laenge) :
+
+  out (anschluss links);
+  outsubtext (trennung 120, 1, laenge - 2);
+  out (anschluss rechts)
+
+END PROC out mitte;
+
+PROC out unten (INT CONST laenge) :
+
+  out (ecke links unten);
+  outsubtext (strich 120, 1, laenge - 2);
+  out (ecke rechts unten)
+
+END PROC out unten;
+
+PROC out leer (INT CONST x, laenge) :
+
+  IF x + laenge >= x size THEN
+    out (cleol)
+  ELSE
+    outsubtext (blank 120, 1, laenge)
+  END IF
+
+END PROC out leer;
+
+
+(**************************** Einlesen zentral ***************************)
+
+LET
+  zeile ohne zusammenhang =  #702#
+    "Zeile ist ohne Zusammenhang",
+  k menuedaten im speicher =  #703#
+    "K Menuedaten im Speicher";
+
+PROC menuedaten einlesen (TEXT CONST dateiname) :
+
+  ggf initialisieren;
+  file := sequential file (input, dateiname);
+  modify (file);
+  to line (file, 1);
+  WHILE NOT eof (file) REP
+    zeile lesen;
+    IF kommandozeile THEN
+      eventuell verteilen
+    ELIF NOT anything noted THEN
+      fehler (zeile ohne zusammenhang)
+    END IF
+  END REP;
+  seiten anzeigen;
+  IF anything noted THEN
+    note edit (file)
+  END IF .
+
+eventuell verteilen :
+  IF kommando ist (menue kommando) THEN
+    menue aus datei lesen
+  ELIF kommando ist (auswahl kommando) THEN
+    auswahl aus datei lesen
+  ELIF kommando ist (hilfe kommando) THEN
+    hilfe aus datei lesen
+  ELIF NOT anything noted THEN
+    fehler (zeile ohne zusammenhang)
+  END IF .
+
+seiten anzeigen :
+  IF online THEN
+    line; put (anzahl ds k);
+    putline (k menuedaten im speicher)
+  END IF .
+
+anzahl ds k :
+  storage (menueds (1)) + storage (menueds (2)) + storage (menueds (3)) .
+
+END PROC menuedaten einlesen;
+
+
+(**************************** TYPE MENUE *********************************)
+
+TYPE MENUE = STRUCT (SATZ
+                       bild,
+                       hilfen,
+                       kommandos,
+                     TEXT
+                       feldtasten,
+                       feldzeilen);
+
+BOUND ROW 200 MENUE VAR menues;
+
+
+(************************** Menue Einlesen *******************************)
+
+TEXT VAR
+  m feldzeilen,
+  m feldtasten;
+
+SATZ VAR
+  m hilfen,
+  m kommandos;
+
+LET
+  niltext = "",
+  blank = " ",
+  feldmarkierung = ""223"",
+  markierungsspalte = 2,
+  kommandozeichen = "%",
+  piep = ""7"",
+  esc = ""27"",
+  cleol = ""5"";
+
+LET
+  bildkommando erwartet =  #704#
+    "% BILD erwartet",
+  keine feldnr angegeben =  #705#
+    "Feldnummer beim %FELD-Kommando fehlt",
+  ende fehlt =  #706#
+    "% ENDE erwartet",
+  kein name angegeben =  #707#
+    "Name fehlt",
+  kein kommando angegeben =  #708#
+    "Kommandozeile enthaelt kein Kommando",
+  kein int parameter =  #709#
+    "Parameter soll eine Zahl sein",
+  kein text parameter =  #710#
+    "Parameter soll ein TEXT sein";
+
+
+PROC menue aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    INT VAR index;
+    neues menue einfuegen;
+    menue aus datei lesen (menues (index))
+  END IF .
+
+neues menue einfuegen :
+  index := link (thesaurus (2), name);
+  IF index = 0 THEN
+    insert (thesaurus (2), name, index)
+  END IF .
+
+END PROC menue aus datei lesen;
+
+PROC menue aus datei lesen (MENUE VAR m) :
+
+  menue initialisieren;
+  bild einlesen;
+  felddefinitionen bearbeiten;
+  auf ende testen;
+  ergebnis abspeichern .
+
+menue initialisieren :
+  satz initialisieren (m. bild);
+  satz initialisieren (m hilfen);
+  satz initialisieren (m kommandos);
+  m feldtasten := niltext;
+  m feldzeilen := niltext .
+
+bild einlesen :
+  teste auf bild kommando;
+  INT VAR zeilennr := 1;
+  REP
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE bild einlesen
+    ELSE
+      bildzeile bearbeiten;
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+teste auf bild kommando :
+  zeile lesen;
+  IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN
+    fehler (bild kommando erwartet)
+  END IF .
+
+bildzeile bearbeiten :
+  IF pos (zeile, feldmarkierung) > 0 THEN
+    m feldzeilen CAT code (zeilennr + 1);
+    IF (zeile SUB markierungsspalte) = feldmarkierung THEN
+      replace (zeile, markierungsspalte, blank)
+    END IF
+  END IF;
+  feld aendern (m. bild, zeilennr, zeile) .
+
+felddefinitionen bearbeiten :
+  WHILE kommando ist (feld kommando) REP
+    eine felddefinition bearbeiten
+  END REP .
+
+eine felddefinition bearbeiten :
+  INT VAR feldnr := int parameter;
+  IF feldnr = -1 THEN
+    fehler (keine feldnr angegeben);
+    feldnr := 100
+  END IF;
+  hilfe text einlesen;
+  feldtasten einlesen;
+  kommandos einlesen .
+
+hilfe text einlesen :
+  feld aendern (m hilfen, feldnr, text parameter) .
+
+feldtasten einlesen :
+  TEXT CONST tasten := text parameter;
+  INT VAR p;
+  FOR p FROM 1 UPTO length (tasten) REP
+    m feldtasten CAT code (feldnr);
+    m feldtasten CAT (tasten SUB p)
+  END REP .
+
+kommandos einlesen :
+  TEXT VAR k := niltext;
+  zeile lesen;
+  WHILE NOT kommandozeile REP
+    k CAT zeile;
+    zeile lesen
+  END REP;
+  feld aendern (m kommandos, feldnr, k) .
+
+auf ende testen :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF .
+
+ergebnis abspeichern :
+  m. hilfen := m hilfen;
+  m. kommandos := m kommandos;
+  m. feldtasten := m feldtasten;
+  m. feldzeilen := m feldzeilen .
+
+END PROC menue aus datei lesen;
+
+
+(*************************** Menue anbieten ******************************)
+
+LET
+  ausfuehren status = #711#
+    "Kommando wird ausgeführt ..",
+  gib kommando =  #712#
+    ""15"Gib Kommando: ",
+  falsche ausfuehrtaste =  #713#
+    "falsche Ausfuehrtaste",
+  t existiert nicht =  #714#
+    " existiert nicht.";
+
+LET
+  blank 50 = "                                                  ",
+  begin mark = ""15"",
+  end mark = ""14"",
+  frage marke = "?"8"",
+  ausfuehren marke = "*"8"";
+
+INT VAR
+  markenpos,
+  gezeichnete zeilen;
+
+BOOL VAR
+  ist zeilenmenue := FALSE,
+  funktionssperre veraendert,
+  menue init durchgefuehrt;
+
+TEXT VAR 
+  menuebalken := niltext,
+  sperrzeichen,
+  menuefunktionstasten := ""32""1""2""3""8""10""13""27"",
+  edit kommando,
+  altes kommando := niltext;
+
+ROW 6 TEXT VAR
+  funktionssperre := ROW 6 TEXT : ("", "", "", "", "", ""),
+  fusstexte := funktionssperre;
+
+FENSTER VAR
+  balkenfenster,
+  fussfenster;
+
+fenster initialisieren (balkenfenster);
+fenster initialisieren (fussfenster);
+
+
+PROC waehlbar (INT CONST menue, funktion, BOOL CONST moeglich) :
+
+  IF moeglich THEN
+    ggf sperre aufheben
+  ELSE
+    sperre setzen
+  END IF;
+  funktionssperre veraendert := TRUE .
+
+ggf sperre aufheben :
+  IF length (funktionssperre (menue)) >= funktion THEN
+    replace (funktionssperre (menue), funktion, " ")
+  END IF .
+
+sperre setzen :
+  WHILE length (funktionssperre (menue)) < funktion REP
+    funktionssperre (menue) CAT " "
+  END REP;
+  replace (funktionssperre (menue), funktion, "-") .
+
+END PROC waehlbar;
+
+PROC ausfuehrtaste (TEXT CONST taste) :
+
+  IF length (taste) <> 1 COR taste schon belegt THEN
+    errorstop (falsche ausfuehrtaste)
+  ELSE
+    replace (menuefunktionstasten, 1, taste)
+  END IF .
+
+taste schon belegt :
+  taste <> ""13"" AND pos (menuefunktionstasten, taste, 2) > 0 .
+
+END PROC ausfuehrtaste;
+
+PROC fusszeile (TEXT CONST prompt1,
+                TEXT CONST prompt2, INT CONST pos2,
+                TEXT CONST prompt3, INT CONST pos3) :
+
+  fusstexte (1) := code (1) + prompt1;
+  fusstexte (4) := niltext;
+  fusstexte (2) := code (pos2) + prompt2;
+  fusstexte (5) := niltext;
+  fusstexte (3) := code (pos3) + prompt3;
+  fusstexte (6) := niltext;
+  fenster veraendert (fussfenster)
+
+END PROC fusszeile;
+
+PROC fussteil (INT CONST index, TEXT CONST prompt, inhalt) :
+
+  fusszeile ausgeben;
+  fusstexte (index) := (fusstexte (index) SUB 1) + prompt;
+  cursor (code (fusstexte (index) SUB 1), y size);
+  outsubtext (fusstexte (index), 2);
+  fussteil (index, inhalt)
+
+END PROC fussteil;
+
+PROC fussteil (INT CONST index, TEXT CONST inhalt) :
+
+  INT VAR erlaubte laenge;
+  IF index = 3 THEN
+    erlaubte laenge := x size
+  ELSE
+    erlaubte laenge := code (fusstexte (index + 1) SUB 1)
+  END IF;
+  INT CONST verbrauchte laenge :=
+    code (fusstexte (index) SUB 1) + length (fusstexte (index)) - 1;
+  erlaubte laenge DECR verbrauchte laenge;
+  fusstexte (index + 3) := subtext (inhalt, 1, erlaubte laenge);
+  fusszeile ausgeben;
+  cursor (verbrauchte laenge, y size);
+  outsubtext (inhalt, 1, erlaubte laenge);
+  outsubtext (blank 120, 1, erlaubte laenge - length (fusstexte (index + 3)))
+
+END PROC fussteil;
+
+PROC fusszeile ausgeben :
+
+  BOOL VAR veraendert;
+  fensterzugriff (fussfenster, veraendert);
+  IF veraendert CAND fusstexte (1) <> niltext THEN
+    zeile ausgeben
+  END IF .
+
+zeile ausgeben :
+  INT VAR i;
+  cursor (1, y size); out (cleol);
+  FOR i FROM 1 UPTO 3 REP
+    cursor (code (fusstexte (i) SUB 1), y size);
+    outsubtext (fusstexte (i), 2);
+    out (fusstexte (i + 3))
+  END REP .
+
+END PROC fusszeile ausgeben;
+
+PROC menue anbieten (ROW 6 TEXT CONST menuenamen,
+                     FENSTER CONST f, BOOL CONST esc erlaubt,
+                     PROC (INT CONST, INT CONST) interpreter) :
+
+  ROW 6 INT VAR
+    m anfang,
+    m ende,
+    m wahl;
+
+  INT VAR
+    menuenr intern,
+    leistenindex := 0,
+    neuer leistenindex := 1,
+    leave code := 0,
+    besetzte menues;
+
+  TEXT VAR 
+    balken;
+
+  ROW 6 TEXT VAR
+    sperre,
+    fuss;
+
+  BOOL VAR
+    save zeilenmenue;
+
+  ggf initialisieren;
+  andere initialisierungen;
+  disable stop;
+  REP
+    menuebalken und sperre aktualisieren;
+    menue aufrufen;
+    funktion ausfuehren
+  END REP .
+
+andere initialisierungen :
+  fenstergroesse bestimmen;
+  rekursive werte sichern;
+  menuebalken aufbauen;
+  funktionssperre aufbauen .
+
+fenstergroesse bestimmen :
+  fenstergroesse setzen (balkenfenster, 1, 1, x size - 1, 1);
+  fenstergroesse setzen (fussfenster, 1, y size, x size - 1, 1) .
+
+rekursive werte sichern :
+  save zeilenmenue := ist zeilenmenue;
+  ist zeilenmenue := FALSE;
+  balken := menuebalken;
+  sperre := funktionssperre;
+  fuss := fusstexte .
+
+menuebalken aufbauen :
+  menuebalken := ""6""0""0"";
+  identifikation extrahieren;
+  weitere menues anfuegen;
+  menuebalken CAT cl eol .
+
+identifikation extrahieren :
+  INT VAR ppos := pos (menuenamen (1), ".");
+  IF ppos > 0 THEN
+    menuebalken CAT subtext (menuenamen (1), 1, ppos - 1)
+  END IF;
+  menuebalken CAT ":   " .
+
+weitere menues anfuegen :
+  besetzte menues := 0;
+  WHILE besetzte menues < 6 CAND noch ein menue vorhanden REP
+    besetzte menues INCR 1;
+    ein weiteres menue;
+    m wahl (besetzte menues) := 1
+  END REP .
+
+noch ein menue vorhanden :
+  menuenamen (besetzte menues + 1) <> niltext .
+
+ein weiteres menue :
+  m anfang (besetzte menues) := length (menuebalken);
+  ppos := pos (menuenamen (besetzte menues), ".");
+  IF ppos = 0 THEN
+    menuebalken CAT menuenamen (besetzte menues)
+  ELSE
+    menuebalken CAT subtext (menuenamen (besetzte menues), ppos + 1)
+  END IF;
+  menuebalken CAT "   ";
+  m ende (besetzte menues) := length (menuebalken) - 1 .
+
+funktionssperre aufbauen :
+  INT VAR i;
+  FOR i FROM 1 UPTO 6 REP
+    funktionssperre (i) := niltext;
+    fusstexte (i) := niltext
+  END REP;
+  funktionssperre veraendert := TRUE;
+  interpreter (0, 0) .
+
+menuebalken und sperre aktualisieren :
+  IF neuer leistenindex > 0 THEN
+    altes menue demarkieren;
+    neues menue markieren;
+    leistenindex := neuer leistenindex;
+    neuer leistenindex := 0;
+    neues menue auswaehlen
+  END IF .
+
+altes menue demarkieren :
+  IF leistenindex > 0 THEN
+    replace (menuebalken, m anfang (leistenindex), " ");
+    replace (menuebalken, m ende (leistenindex), " ");
+    IF menue init durchgefuehrt THEN
+      interpreter (leistenindex, -1)
+    END IF
+  END IF .
+
+neues menue markieren :
+  replace (menuebalken, m anfang (neuer leistenindex), begin mark);
+  replace (menuebalken, m ende (neuer leistenindex), end mark);
+  fenster veraendert (balkenfenster);
+  menuebalken anzeigen .
+
+neues menue auswaehlen :
+  menuenr intern := link (thesaurus (2), menuenamen (leistenindex));
+  IF menuenr intern = 0 THEN
+    existiert nicht (menuenamen (leistenindex));
+    LEAVE menue anbieten
+  END IF;
+  menue init durchgefuehrt := FALSE;
+  fenster veraendert (f) .
+
+menue aufrufen :
+  leave code := leistenindex;
+  anbieten (menues (menuenr intern), f, leave code, m wahl (leistenindex),
+            PROC (INT CONST, INT CONST) interpreter) .
+
+funktion ausfuehren :
+  SELECT leave code OF
+  CASE 0 :  menue verlassen
+  CASE 1 :  kommandodialog
+  CASE 2 :  menuewechsel nach rechts
+  CASE 3 :  menuewechsel nach links
+  CASE 4 :  wahl behandeln
+  OTHERWISE direkte menuewahl
+  END SELECT .
+
+menuewechsel nach rechts :
+  IF leistenindex < besetzte menues THEN
+    neuer leistenindex := leistenindex + 1
+  ELSE
+    neuer leistenindex := 1
+  END IF .
+
+menuewechsel nach links :
+  IF leistenindex > 1 THEN
+    neuer leistenindex := leistenindex - 1
+  ELSE
+    neuer leistenindex := besetzte menues
+  END IF .
+
+direkte menuewahl :
+  leave code := leave code - 10;
+  IF leave code <= besetzte menues THEN
+    neuer leistenindex := leave code
+  END IF .
+
+kommandodialog :
+  IF esc erlaubt THEN
+    BOOL VAR bild veraendert := FALSE;
+    REP
+      editget kommando;
+      kommando ausfuehren
+    UNTIL erfolgreich END REP;
+    IF bild veraendert THEN
+      bildschirm neu;
+      dialogfenster loeschen;
+      fusszeile ausgeben;
+      interpreter (leistenindex, -2)
+    END IF
+  END IF .
+
+kommando ausfuehren :
+  IF echtes kommando THEN
+    bild veraendert := TRUE;
+    status anzeigen (ausfuehren status);
+    cursor (1, 2); out (cl eop);
+    do (edit kommando)
+  END IF .
+
+echtes kommando :
+  pos (edit kommando, ""33"", ""254"", 1) > 0 .
+
+erfolgreich :
+  NOT is error .
+
+menue verlassen :
+  IF menue init durchgefuehrt THEN
+    interpreter (leistenindex, -1)
+  END IF;
+  fenster veraendert (f);
+  rekursive werte wiederherstellen;
+  LEAVE menue anbieten .
+
+rekursive werte wiederherstellen :
+  ist zeilenmenue := save zeilenmenue;
+  menuebalken := balken;
+  fenster veraendert (balkenfenster);
+  funktionssperre := sperre;
+  funktionssperre veraendert := TRUE;
+  fusstexte := fuss;
+  fenster veraendert (fussfenster) .
+
+wahl behandeln :
+  IF m wahl (leistenindex) > 0 THEN
+    interpreter (leistenindex, m wahl (leistenindex))
+  ELSE
+    m wahl (leistenindex) := - m wahl (leistenindex)
+  END IF;
+  fusszeile ausgeben .
+
+END PROC menue anbieten;
+
+PROC menuebalken anzeigen :
+
+  BOOL VAR veraendert;
+  fensterzugriff (balkenfenster, veraendert);
+  IF veraendert THEN out (menuebalken) END IF
+
+END PROC menuebalken anzeigen;
+
+PROC anbieten (MENUE CONST m, FENSTER CONST f, INT VAR menuenr, wahl,
+               PROC (INT CONST, INT CONST) interpreter) :
+
+  INT VAR
+    tastenzustand := 0;
+
+  fehler behandeln;
+  neuen fensterzugriff anmelden (f);
+  IF gezeichnete zeilen = 0 THEN
+    markenpos := 0
+  END IF;
+  neuer dialog;
+  geaenderte funktionssperre beruecksichtigen;
+  REP
+    menuebalken anzeigen;
+    auf eingabe warten;
+    menuefunktion
+  END REP .
+
+fehler behandeln :
+  IF wahl > length (m. feldzeilen) THEN
+    wahl := markenpos;
+  ELIF is error THEN
+    fehler ausgeben;
+    interpreter (menuenr, -2);
+  END IF .
+
+geaenderte funktionssperre beruecksichtigen :
+  IF funktionssperre veraendert THEN
+    sperrzeichen setzen (menuenr, m);
+    bereits angezeigte funktionen korrigieren;
+    funktionssperre veraendert := FALSE
+  END IF .
+
+bereits angezeigte funktionen korrigieren :
+  INT VAR f index;
+  FOR f index FROM 1 UPTO length (m. feldzeilen) REP
+    INT CONST funktionszeile := code (m. feldzeilen SUB f index);
+    IF funktionszeile > gezeichnete zeilen THEN
+      LEAVE bereits angezeigte funktionen korrigieren
+    END IF;
+    erstes zeichen ausgeben (m. bild, funktionszeile)
+  END REP .
+
+auf eingabe warten :
+  REP
+    ausgabe und zeichen annehmen;
+    IF is error THEN
+      halt vom terminal behandeln
+    ELSE
+      LEAVE auf eingabe warten
+    END IF
+  END REP .
+
+ausgabe und zeichen annehmen :
+  TEXT VAR eingabe;
+  BOOL VAR menue jetzt fertig ausgegeben := FALSE;
+  WHILE gezeichnete zeilen < y laenge REP
+    eingabe := getcharety;
+    eventuell eine zeile ausgeben
+  END REP;
+  bildschirm update;
+  cursor positionieren (m, wahl);
+  getchar mit enable stop (eingabe) .
+
+eventuell eine zeile ausgeben :
+  IF eingabe = niltext THEN
+    ggf init durchfuehren;
+    gezeichnete zeilen INCR 1;
+    menuezeile markiert oder nicht markiert ausgeben
+  ELSE
+    LEAVE ausgabe und zeichen annehmen
+  END IF .
+
+ggf init durchfuehren :
+  IF NOT menue init durchgefuehrt AND gezeichnete zeilen = 0 THEN
+    interpreter (menuenr, 0);
+    sperrzeichen setzen (menuenr, m);
+    menue init durchgefuehrt := TRUE
+  END IF .
+
+menuezeile markiert oder nicht markiert ausgeben :
+  IF gezeichnete zeilen = code (m. feldzeilen SUB wahl) THEN
+    menuezeile ausgeben (m. bild, gezeichnete zeilen, TRUE);
+    markenpos := wahl
+  ELSE
+    menuezeile ausgeben (m. bild, gezeichnete zeilen, FALSE)
+  END IF;
+  IF gezeichnete zeilen = y laenge THEN
+    menue jetzt fertig ausgegeben := TRUE
+  END IF .
+
+bildschirm update :
+  IF menue jetzt fertig ausgegeben AND NOT is error THEN
+    fusszeile ausgeben;
+    interpreter (menuenr, -2);
+    IF is error THEN clear error END IF
+  END IF .
+
+halt vom terminal behandeln :
+  fehler ausgeben;
+  menuebalken anzeigen;
+  gezeichnete zeilen := 0 .
+
+menuefunktion :
+  INT VAR posi;
+  SELECT tastenzustand OF
+  CASE 0 : normale funktion
+  CASE 1 : hop funktion
+  CASE 2 : esc funktion
+  END SELECT .
+
+normale funktion :
+  SELECT pos (menuefunktionstasten, eingabe) OF
+  CASE 1 : leerzeichen ausfuehren
+  CASE 2 : tastenzustand := 1
+  CASE 3 : rechts ausfuehren
+  CASE 4 : oben ausfuehren
+  CASE 5 : links ausfuehren
+  CASE 6 : unten ausfuehren
+  CASE 7 : return ausfuehren
+  CASE 8 : tastenzustand := 2
+  OTHERWISE sondertaste
+  END SELECT .
+
+hop funktion :
+  SELECT pos (""1""3""10"", eingabe) OF
+  CASE 1 : hop hop ausfuehren
+  CASE 2 : hop oben ausfuehren
+  CASE 3 : hop unten ausfuehren
+  OTHERWISE out (piep)
+  END SELECT;
+  tastenzustand := 0 .
+
+esc funktion :
+  SELECT pos (""1""27"?qh", eingabe) OF
+  CASE 1 : esc hop ausfuehren
+  CASE 2 : esc esc ausfuehren
+  CASE 3 : esc fragezeichen ausfuehren
+  CASE 4, 5 : esc q ausfuehren
+  OTHERWISE belegte taste
+  END SELECT;
+  tastenzustand := 0 .
+
+rechts ausfuehren :
+  leave code := 2;
+  LEAVE anbieten .
+
+oben ausfuehren :
+  IF wahl > 1 THEN
+    wahl DECR 1
+  ELSE
+    wahl := length (m. feldzeilen)
+  END IF .
+
+links ausfuehren :
+  leave code := 3;
+  LEAVE anbieten .
+
+unten ausfuehren :
+  IF wahl < length (m. feldzeilen) THEN
+    wahl INCR 1
+  ELSE
+    wahl := 1
+  END IF .
+
+return ausfuehren :
+  unten ausfuehren .
+
+sondertaste :
+  IF menuewahl THEN
+    menuewahl bearbeiten
+  ELIF wahl fuer bestimmtes feld THEN
+    feld waehlen
+  ELIF eingabe <= ""32"" THEN
+    push (esc + eingabe)
+  END IF .
+
+menuewahl :
+  pos ("123456", eingabe) > 0 .
+
+menuewahl bearbeiten :
+  leave code := code (eingabe) - 38;
+  LEAVE anbieten .
+
+wahl fuer bestimmtes feld :
+  posi := 0;
+  REP
+    posi := pos (m. feldtasten, eingabe, posi + 1)
+  UNTIL (posi MOD 2) = 0 END REP;
+  posi > 0 AND feld mit bildschirmposition .
+
+feld mit bildschirmposition :
+  code (m. feldtasten SUB posi - 1) <= length (m. feldzeilen) .
+
+feld waehlen :
+  wahl := code (m. feldtasten SUB posi - 1);
+  cursor positionieren (m, wahl);
+  IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN
+    wahl getroffen (m, wahl);
+    leave code := 4;
+    LEAVE anbieten
+  END IF .
+
+hop hop ausfuehren :
+  wahl := 1 .
+
+hop oben ausfuehren :
+  wahl := 1 .
+
+hop unten ausfuehren :
+  wahl := length (m. feldzeilen) .
+
+belegte taste :
+  IF esc sonderfunktion THEN
+    wahl := code (m. feldtasten SUB posi - 1);
+    leave code := 4;
+    LEAVE anbieten
+  ELSE
+    push (lernsequenz auf taste (eingabe))
+  END IF .
+
+esc sonderfunktion :
+  posi := 0;
+  REP
+    posi := pos (m. feldtasten, eingabe, posi + 1)
+  UNTIL (posi MOD 2) = 0 CAND
+        (posi = 0 COR feld ohne bildschirmposition) END REP;
+  posi > 0 .
+
+feld ohne bildschirmposition :
+  code (m. feldtasten SUB posi - 1) > length (m. feldzeilen) .
+
+esc esc ausfuehren :
+  leave code := 1;
+  LEAVE anbieten .
+
+esc fragezeichen ausfuehren :
+  TEXT VAR hilfe name;
+  wahl demarkieren (m, wahl, frage marke);
+  feld lesen (m. hilfen, wahl, hilfe name);
+  hilfe anbieten (hilfe name, d fenster);
+  IF is error THEN fehler ausgeben END IF;
+  interpreter (menuenr, -2);
+  neuen fensterzugriff anmelden (f) .
+
+esc q ausfuehren :
+  leave code := 0;
+  LEAVE anbieten .
+
+leerzeichen ausfuehren :
+  IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN
+    wahl getroffen (m, wahl);
+    leave code := 4;
+    LEAVE anbieten
+  END IF .
+
+leave code :
+  menuenr .
+
+END PROC anbieten;
+
+PROC neuen fensterzugriff anmelden (FENSTER CONST f) :
+
+  BOOL VAR veraendert;
+  fensterzugriff (f, veraendert);
+  fenstergroesse (f, x pos, y pos, x laenge, y laenge);
+  IF veraendert THEN
+    gezeichnete zeilen := 0;
+    f cursor (1, 1)
+  END IF
+
+END PROC neuen fensterzugriff anmelden;
+
+PROC sperrzeichen setzen (INT CONST menuenr, MENUE CONST m) :
+
+  sperrzeichen := blank 50;
+  INT VAR i;
+  FOR i FROM 1 UPTO length (funktionssperre (menuenr)) REP
+    replace (sperrzeichen, code (m. feldzeilen SUB i),
+             funktionssperre (menuenr) SUB i)
+  END REP
+
+END PROC sperrzeichen setzen;
+
+PROC cursor positionieren (MENUE CONST m, INT CONST wahl) :
+
+  INT CONST wahlzeile := code (m. feldzeilen SUB wahl);
+  IF markenpos > 0 AND markenpos <> wahl THEN
+    INT CONST markenzeile := code (m. feldzeilen SUB markenpos);
+    menuezeile ausgeben (m. bild, markenzeile, FALSE)
+  END IF;
+  menuezeile ausgeben (m. bild, wahlzeile, TRUE);
+  markenpos := wahl;
+  f cursor (2, wahlzeile)
+
+END PROC cursor positionieren;
+
+PROC getchar mit enable stop (TEXT VAR z) :
+
+  enable stop;
+  getchar (z)
+
+END PROC getchar mit enable stop;
+
+PROC wahl getroffen (MENUE CONST m, INT VAR wahl) :
+
+  wahl demarkieren (m, wahl, ausfuehren marke);
+  TEXT VAR k;
+  feld lesen (m. kommandos, wahl, k);
+  IF k <> niltext AND k <> blank THEN
+    do (k);
+    bildschirm neu;
+    wahl := - wahl
+  END IF .
+
+END PROC wahl getroffen;
+
+PROC wahl demarkieren (MENUE CONST m, INT CONST wahl, TEXT CONST m zeichen) :
+
+  INT CONST y pos := code (m. feldzeilen SUB wahl);
+  IF gezeichnete zeilen >= y pos THEN
+    menuezeile ausgeben (m. bild, y pos, FALSE);
+    f cursor (2, y pos);
+    out (m zeichen)
+  END IF .
+
+END PROC wahl demarkieren;
+
+PROC esc hop ausfuehren :
+
+  TEXT VAR
+    puffer := ""0"",
+    ausgang;
+  lernsequenz auf taste legen (""0"", niltext);
+  push (""27""1""0""0"");
+  editget (puffer, 1, 1, ""0"", "", ausgang);
+  out (""8"");
+  puffer := lernsequenz auf taste (""0"");
+  IF puffer <> niltext THEN
+    gelerntes auf richtige taste legen
+  ELSE
+    letzten nullcode auslesen
+  END IF .
+
+gelerntes auf richtige taste legen :
+  REP
+    getchar (ausgang)
+  UNTIL pos (""1""2""8""11""12"", ausgang) = 0 END REP;
+  lernsequenz auf taste legen (ausgang, puffer) .
+
+letzten nullcode auslesen :
+  getchar (ausgang) .
+
+END PROC esc hop ausfuehren;
+
+
+BOOL VAR
+  ist trennung;
+
+INT VAR
+  anfang,
+  ende,
+  mark ende;
+
+PROC erstes zeichen ausgeben (SATZ CONST bild, INT CONST bildzeile) :
+
+  f cursor (2, bildzeile);
+  IF (sperrzeichen SUB bildzeile) <> blank THEN
+    out (sperrzeichen SUB bildzeile)
+  ELSE
+    feld bearbeiten (bild, bildzeile - 1,
+      PROC (TEXT CONST, INT CONST, INT CONST) zeichen 1)
+  END IF
+
+END PROC erstes zeichen ausgeben;
+
+PROC zeichen 1 (TEXT CONST satz, INT CONST anfang, ende) :
+
+  out (satz SUB anfang + ende - ende)
+
+END PROC zeichen 1;
+
+PROC menuezeile ausgeben (SATZ CONST bild,
+                          INT CONST zeilennr, BOOL CONST markiert) :
+
+  enable stop;
+  f cursor (1, zeilennr);
+  IF markiert THEN
+    ist trennung := FALSE;
+    out (strich senkrecht);
+    erstes zeichen ausgeben (bild, zeilennr);
+    out (begin mark);
+    anfang := 3; mark ende := 1;
+    bildzeile ausgeben (bild, zeilennr - 1)
+  ELIF zeilennr = 1 THEN
+    out oben (x laenge)
+  ELIF zeilennr = y laenge THEN
+    out unten (x laenge)
+  ELIF zeilennr = felderzahl (bild) + 2 THEN
+    out mitte (x laenge)
+  ELSE
+    auf trennung pruefen;
+    IF (sperrzeichen SUB zeilennr) = "-" THEN
+      out ("-"); anfang := 2
+    ELSE
+      anfang := 1
+    END IF;
+    mark ende := 0;
+    bildzeile ausgeben (bild, zeilennr - 1)
+  END IF .
+
+auf trennung pruefen :
+  feld bearbeiten (bild, zeilennr - 1,
+    PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen) .
+
+END PROC menuezeile ausgeben;
+
+PROC trennung feststellen (TEXT CONST satz, INT CONST von, bis) :
+
+  ist trennung := (satz SUB von + bis - bis) = "-";
+  IF NOT ist trennung THEN
+    out (strich senkrecht)
+  END IF
+
+END PROC trennung feststellen;
+
+PROC menuezeile ausgeben (SATZ CONST bild, INT CONST zeilennr) :
+
+  feld bearbeiten (bild, zeilennr - 1,
+    PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen);
+  anfang := 1; mark ende := 0;
+  bildzeile ausgeben (bild, zeilennr - 1)
+
+END PROC menuezeile ausgeben;
+
+PROC bildzeile ausgeben (SATZ CONST bild, INT CONST zeilennr) :
+
+  IF ist trennung THEN
+    out mitte (x laenge)
+  ELSE
+    zeileninhalt ausgeben
+  END IF .
+
+zeileninhalt ausgeben :
+  feld bearbeiten (bild, zeilennr,
+    PROC (TEXT CONST, INT CONST, INT CONST) abschnitt ausgeben);
+  zeilenrest ausgeben .
+
+zeilenrest ausgeben :
+  outsubtext (blank 120, 1, x laenge - ende - mark ende - 2);
+  ggf endemarkierung;
+  rechte begrenzung .
+
+ggf endemarkierung :
+  IF mark ende > 0 THEN
+    out (end mark)
+  END IF .
+
+rechte begrenzung :
+  out (strich senkrecht) .
+
+END PROC bildzeile ausgeben;
+
+PROC abschnitt ausgeben (TEXT CONST t, INT CONST von, bis) :
+
+  INT CONST offset := von - 1;
+  anfang INCR offset;
+  ende := min (bis, x laenge + offset - mark ende - 2);
+  outsubtext (t, anfang, ende);
+  ende DECR offset
+
+END PROC abschnitt ausgeben;
+
+PROC editget kommando :
+
+  LET esc k = ""27"k";
+  TEXT VAR
+    exit char;
+  fenster veraendert (balkenfenster);
+  bei fehler altes kommando wiederholen;
+  markierte zeile ausgeben;
+  REP
+    kommando editieren
+  UNTIL exit char <> esc k END REP;
+  IF pos (edit kommando , ""33"", ""254"", 1) > 0 THEN
+    altes kommando := edit kommando
+  END IF .
+
+bei fehler altes kommando wiederholen :
+  IF is error THEN
+    fehler ausgeben;
+    edit kommando := altes kommando
+  ELSE
+    edit kommando := niltext
+  END IF .
+
+markierte zeile ausgeben :
+  cursor (1, 1);
+  out (gib kommando);
+  outsubtext (blank 120, 1, x laenge - 15);
+  out (end mark) .
+
+kommando editieren :
+  cursor (16, 1);
+  editget (edit kommando, 32000, 62, "", "kh", exit char);
+  IF is error THEN
+    clear error
+  ELIF exit char = esc k THEN
+    edit kommando := altes kommando
+  ELIF exit char = esc h THEN
+    edit kommando := niltext
+  END IF .
+
+END PROC edit get kommando;
+
+PROC existiert nicht (TEXT CONST dateiname) :
+
+  errorstop ("""" + dateiname + """" + t existiert nicht)
+
+END PROC existiert nicht;
+
+
+(*************************** Auswahl Einlesen ****************************)
+
+TYPE AUSWAHL = STRUCT (SATZ kopf);
+
+BOUND ROW 200 AUSWAHL VAR auswahlen;
+
+
+PROC auswahl aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    INT VAR index := link (thesaurus (3), name);
+    IF index = 0 THEN
+      insert (thesaurus (3), name, index)
+    END IF;
+    auswahl aus datei lesen (auswahlen (index))
+  END IF
+
+END PROC auswahl aus datei lesen;
+
+PROC auswahl aus datei lesen (AUSWAHL VAR a) :
+
+  menue initialisieren;
+  kopf einlesen;
+  teste auf ende .
+
+menue initialisieren :
+  satz initialisieren (a. kopf) .
+
+kopf einlesen :
+  INT VAR zeilennr := 1;
+  REP 
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE kopf einlesen
+    ELSE
+      kopfzeile bearbeiten;
+      zeilennr INCR 1
+    END IF
+  END REP .
+
+kopfzeile bearbeiten :
+  feld aendern (a. kopf, zeilennr, zeile) .
+
+teste auf ende :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF .
+
+END PROC auswahl aus datei lesen;
+
+
+(*************************** Auswahl anbieten ****************************)
+
+LET
+  unten = ""10"",
+  plus esc q = "+"27"q";
+
+LET
+  fenster zu klein =  #715#
+    "Fenster zu klein",
+  auswahlstatus =  #716#
+"AUSWAHL:  Ankreuzen: 'x'  Durchstreichen: 'o'  Beenden: ESC q  Hilfe: ESC ?";
+
+INT VAR
+  s anfang,
+  s ende,
+  wahlen,
+  kopfzeilen,
+  max wahllaenge,
+  gerollt;
+
+BOOL VAR
+  mit reihenfolge;
+
+LET INTVEC = TEXT;
+
+INTVEC VAR gewaehlt;
+
+
+PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, TEXT CONST hilfe,
+                       PROC (TEXT VAR, INT CONST) inhalt) :
+
+  auswahl anbieten (name, f, 1024, hilfe, niltext,
+                    PROC (TEXT VAR, INT CONST) inhalt)
+
+END PROC auswahl anbieten;
+
+PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl,
+                       TEXT CONST hilfe,
+                       PROC (TEXT VAR, INT CONST) inhalt) :
+
+  auswahl anbieten (name, f, max wahl, hilfe, niltext,
+                    PROC (TEXT VAR, INT CONST) inhalt)
+
+END PROC auswahl anbieten;
+
+PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl,
+                       TEXT CONST hilfe, anfangswahl,
+                       PROC (TEXT VAR, INT CONST) inhalt) :
+
+  ggf initialisieren;
+  INT CONST index := link (thesaurus (3), name);
+  IF index = 0 THEN
+    existiert nicht (name)
+  ELSE
+    anfangswahl initialisieren;
+    anbieten (auswahlen (index), f, hilfe, max wahl,
+              PROC (TEXT VAR, INT CONST) inhalt)
+  END IF .
+
+anfangswahl initialisieren :
+  INT VAR i;
+  gewaehlt := niltext;
+  FOR i FROM 1 UPTO length (anfangswahl) REP
+    gewaehlt CAT code (anfangswahl SUB i)
+  END REP .
+
+END PROC auswahl anbieten;
+
+PROC anbieten (AUSWAHL CONST a, FENSTER CONST f, TEXT CONST hilfe,
+               INT CONST max wahl,
+               PROC (TEXT VAR, INT CONST) inhalt) :
+
+  INT VAR
+    gezeichnete zeilen := 0,
+    tastenzustand := 0;
+  enable stop;
+  fensterzugriff durchfuehren;
+  status anzeigen (auswahlstatus);
+  anzahl der wahlen feststellen;
+  bildparameter berechnen;
+  auswahl initialisieren;
+  REP
+    auf eingabe warten;
+    auswahlfunktion durchfuehren
+  END REP .
+
+fensterzugriff durchfuehren :
+  BOOL VAR dummy;
+  fensterzugriff (f, dummy);
+  fenstergroesse (f, x pos, y pos, x laenge, y laenge) .
+
+anzahl der wahlen feststellen :
+  INT VAR
+    schritt := 1024;
+  wahlen := schritt;
+  REP
+    schritt := schritt DIV 2;
+    inhalt (zeile, wahlen);
+    IF zeile = niltext THEN
+      wahlen DECR schritt
+    ELSE
+      wahlen INCR schritt
+    END IF
+  UNTIL schritt = 1 END REP;
+  inhalt (zeile, wahlen);
+  IF zeile = niltext THEN wahlen DECR 1 END IF .
+
+bildparameter berechnen :
+  kopfzeilen := felderzahl (a. kopf) + 2;
+  gerollt := 0;
+  scroll bar berechnen;
+  IF kopfzeilen >= y laenge THEN
+    errorstop (fenster zu klein)
+  END IF .
+
+auswahl initialisieren :
+  INT VAR
+    akt zeile := kopfzeilen + 1,
+    alte akt zeile,
+    akt wahl := 1;
+  mit reihenfolge := max wahl > 1 .
+
+auf eingabe warten :
+  REP
+    ausgabe und zeichen annehmen;
+    IF is error THEN
+      clear error;
+      gezeichnete zeilen := 0
+    ELSE
+      LEAVE auf eingabe warten
+    END IF
+  END REP .
+
+ausgabe und zeichen annehmen :
+  TEXT VAR eingabe;
+  WHILE gezeichnete zeilen < y laenge REP
+    eingabe := getcharety;
+    eventuell eine zeile ausgeben
+  END REP;
+  cursor positionieren;
+  getchar mit enable stop (eingabe) .
+
+eventuell eine zeile ausgeben :
+  IF eingabe = niltext THEN
+    IF gezeichnete zeilen = kopfzeilen THEN
+      alte akt zeile := 999;
+      max wahllaenge := 10
+    END IF;
+    gezeichnete zeilen INCR 1;
+    entsprechende zeile ausgeben
+  ELSE
+    LEAVE ausgabe und zeichen annehmen
+  END IF .
+
+entsprechende zeile ausgeben :
+  f cursor (1, gezeichnete zeilen);
+  IF gezeichnete zeilen <= kopfzeilen THEN
+    kopfzeile ausgeben
+  ELSE
+    wiederholungszeile ausgeben
+  END IF .
+
+kopfzeile ausgeben :
+  IF gezeichnete zeilen = 1 THEN
+    out oben (x laenge)
+  ELIF gezeichnete zeilen = kopfzeilen THEN
+    out mitte (x laenge)
+  ELSE
+    menuezeile ausgeben (a. kopf, gezeichnete zeilen)
+  END IF .
+
+wiederholungszeile ausgeben :
+  INT CONST tatsaechliche zeile :=
+    gezeichnete zeilen + gerollt - kopfzeilen;
+  IF gezeichnete zeilen = y laenge THEN
+    out unten (x laenge)
+  ELIF tatsaechliche zeile <= wahlen THEN
+    auswahlzeile ausgeben (tatsaechliche zeile,
+                           scroll on zeile, FALSE,
+                           PROC (TEXT VAR, INT CONST) inhalt);
+    max wahllaenge := max (max wahllaenge, length (zeile))
+  ELIF tatsaechliche zeile = wahlen + 1 THEN
+    out mitte (x laenge)
+  ELSE
+    out (strich senkrecht);
+    outsubtext (blank 120, 1, x laenge - 2);
+    out (strich senkrecht)
+  END IF .
+
+scroll on zeile :
+  gezeichnete zeilen >= s anfang AND gezeichnete zeilen <= s ende .
+
+cursor positionieren :
+  IF akt zeile <> alte akt zeile THEN
+    IF alte akt zeile <= gezeichnete zeilen THEN
+      alte zeile demarkieren
+    END IF;
+    neue zeile markieren
+  END IF;
+  cursor (1, 1) .
+(*  f cursor (5, akt zeile) .*)
+
+alte zeile demarkieren :
+  f cursor (5, alte akt zeile);
+  auswahlzeile ausgeben (alte akt zeile + gerollt - kopfzeilen, FALSE,
+      PROC (TEXT VAR, INT CONST) inhalt) .
+
+neue zeile markieren :
+  f cursor (5, akt zeile);
+  auswahlzeile ausgeben (akt wahl, TRUE,
+      PROC (TEXT VAR, INT CONST) inhalt);
+  alte akt zeile := akt zeile .
+
+auswahlfunktion durchfuehren :
+  SELECT tastenzustand OF
+  CASE 0 : normale funktion
+  CASE 1 : hop funktion
+  CASE 2 : esc funktion
+  END SELECT .
+
+normale funktion :
+  SELECT pos (""1""3""10""13""27" +x-o", eingabe) OF
+  CASE 1 : tastenzustand := 1
+  CASE 2 : oben ausfuehren
+  CASE 3 : unten ausfuehren
+  CASE 4 : return ausfuehren
+  CASE 5 : tastenzustand := 2
+  CASE 6 : leertaste ausfuehren
+  CASE 7, 8  : plus ausfuehren
+  CASE 9, 10 : minus ausfuehren
+  OTHERWISE sondertaste
+  END SELECT .
+
+hop funktion :
+  SELECT pos (""3""10"+x-o", eingabe) OF
+  CASE 1 : hop oben ausfuehren
+  CASE 2 : hop unten ausfuehren
+  CASE 3, 4 : hop plus ausfuehren
+  CASE 5, 6 : hop minus ausfuehren
+  OTHERWISE out (piep)
+  END SELECT;
+  tastenzustand := 0 .
+
+esc funktion :
+  SELECT pos (""1"19?qh", eingabe) OF
+  CASE 1 : esc hop ausfuehren
+  CASE 2 : esc 1 ausfuehren
+  CASE 3 : esc 9 ausfuehren
+  CASE 4 : esc fragezeichen ausfuehren
+  CASE 5 : esc q ausfuehren
+  CASE 6 : errorstop (niltext)
+  OTHERWISE belegte taste
+  END SELECT;
+  tastenzustand := 0 .
+
+oben ausfuehren :
+  IF akt wahl > 1 THEN
+    akt zeile DECR 1;
+    akt wahl DECR 1;
+    IF akt zeile <= kopfzeilen THEN
+      akt zeile INCR 1;
+      gerollt DECR 1;
+      scroll bar berechnen;
+      gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen)
+    END IF
+  END IF .
+
+unten ausfuehren :
+  IF akt wahl < wahlen THEN
+    akt zeile INCR 1;
+    akt wahl INCR 1;
+    IF akt zeile >= y laenge THEN
+      akt zeile DECR 1;
+      gerollt INCR 1;
+      scroll bar berechnen;
+      gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen)
+    END IF
+  END IF .
+
+return ausfuehren :
+  push (unten) .
+
+leertaste ausfuehren :
+  push (plus esc q) .
+
+plus ausfuehren :
+  IF wahlpos (akt wahl) = 0 AND akt wahl <= wahlen THEN
+    wahl aufnehmen;
+    wahl sichtbar machen
+  END IF .
+
+wahl aufnehmen :
+  BOOL CONST an grenze := abs (max wahl) <= length (gewaehlt) DIV 2;
+  IF an grenze THEN
+    gewaehlt := subtext (gewaehlt, 3)
+  END IF;
+  gewaehlt CAT akt wahl .
+
+wahl sichtbar machen :
+  IF an grenze THEN
+    wahlpositionen ausgeben
+  ELIF akt zeile <= gezeichnete zeilen THEN
+    wahlnummer (akt zeile, length (gewaehlt) DIV 2)
+  END IF .
+
+minus ausfuehren :
+  INT CONST alte pos := wahlpos (akt wahl);
+  IF alte pos > 0 THEN
+    wahl entfernen;
+    wahlpositionen ausgeben
+  END IF .
+
+wahl entfernen :
+  change (gewaehlt, 2 * alte pos - 1, 2 * alte pos, niltext) .
+
+sondertaste :
+  IF eingabe < blank THEN
+    push (lernsequenz auf taste (eingabe))
+  ELSE
+    out (piep)
+  END IF .
+
+hop oben ausfuehren :
+  IF akt zeile = kopfzeilen + 1 THEN
+    nach oben rollen
+  ELSE
+    nach oben
+  END IF .
+
+nach oben rollen :
+  INT VAR um := min (y laenge - kopfzeilen - 1, gerollt);
+  gerollt DECR um;
+  akt wahl DECR um;
+  IF um > 0 THEN
+    scroll bar berechnen;
+    gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen)
+  END IF .
+
+nach oben :
+  um := akt zeile - kopfzeilen - 1;
+  akt zeile DECR um;
+  akt wahl DECR um .
+
+hop unten ausfuehren :
+  IF akt zeile = y laenge - 1 THEN
+    nach unten rollen
+  ELSE
+    nach unten
+  END IF .
+
+nach unten rollen :
+  um := min (y laenge - kopfzeilen - 1, wahlen - akt wahl);
+  gerollt INCR um;
+  akt wahl INCR um;
+  IF um > 0 THEN
+    scroll bar berechnen;
+    gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen)
+  END IF .
+
+nach unten :
+  um := min (wahlen - akt wahl, y laenge - akt zeile - 1);
+  akt zeile INCR um;
+  akt wahl INCR um .
+
+hop plus ausfuehren :
+  IF wahlen > abs (max wahl) THEN
+    out (piep); LEAVE hop plus ausfuehren
+  END IF;
+  INT VAR w;
+  FOR w FROM 1 UPTO wahlen REP
+    IF wahlpos (w) = 0 THEN
+      gewaehlt CAT w
+    END IF
+  END REP;
+  wahlpositionen ausgeben .
+
+hop minus ausfuehren :
+  gewaehlt := niltext;
+  wahlpositionen ausgeben .
+
+esc fragezeichen ausfuehren :
+  hilfe anbieten (hilfe, f);
+  status anzeigen (auswahlstatus);
+  gezeichnete zeilen := 0 .
+
+esc q ausfuehren :
+  LEAVE anbieten .
+
+belegte taste :
+  push (lernsequenz auf taste (eingabe)) .
+
+esc 1 ausfuehren :
+  akt zeile := kopfzeilen + 1;
+  akt wahl := 1;
+  gerollt := 0;
+  scroll bar berechnen;
+  gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) .
+
+esc 9 ausfuehren :
+  INT CONST letzte zeile := kopfzeilen + wahlen;
+  IF letzte zeile < y laenge THEN
+    akt zeile := letzte zeile;
+    gerollt := 0
+  ELSE
+    akt zeile := y laenge - 1;
+    gerollt := letzte zeile - y laenge + 1;
+    gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen)
+  END IF;
+  scroll bar berechnen;
+  akt wahl := wahlen .
+
+END PROC anbieten;
+
+PROC wahlpositionen ausgeben :
+
+  INT VAR z, w;
+  w := erste angezeigte wahl;
+  FOR z FROM erste wahlzeile UPTO letzte wahlzeile REP
+    wahlnummer (z, wahlpos (w));
+    w INCR 1
+  END REP .
+
+erste angezeigte wahl :
+  gerollt + 1 .
+
+erste wahlzeile :
+  kopfzeilen + 1 .
+
+letzte wahlzeile :
+  min (y laenge - 1, kopfzeilen + wahlen) .
+
+END PROC wahlpositionen ausgeben;
+
+PROC scrollbar berechnen :
+
+  INT CONST s laenge := y laenge - kopfzeilen - 1;
+  IF gerollt = 0 THEN
+    s anfang := 1
+  ELSE
+    s anfang := max (1, gerollt * s laenge DIV wahlen) + 1
+  END IF;
+  IF wahlen <= s laenge THEN
+    s ende := wahlen
+  ELIF wahlen - gerollt = s laenge THEN
+    s ende := s laenge
+  ELSE
+    s ende := min (s anfang + s laenge * s laenge DIV wahlen, s laenge - 1)
+  END IF;
+  s anfang INCR kopfzeilen;
+  s ende INCR kopfzeilen
+
+END PROC scrollbar berechnen;
+
+
+TEXT VAR zwei bytes := "xx";
+
+INT PROC wahlpos (INT CONST feld) :
+
+  replace (zwei bytes, 1, feld);
+  INT VAR p := 0;
+  REP
+    p := pos (gewaehlt, zwei bytes, p + 1)
+  UNTIL p = 0 OR p MOD 2 = 1 END REP;
+  (p + 1) DIV 2
+
+END PROC wahlpos;
+
+OP CAT (INTVEC VAR intvec, INT CONST wert) :
+
+  replace (zwei bytes, 1, wert);
+  intvec CAT zwei bytes
+
+END OP CAT;
+
+PROC auswahlzeile ausgeben (INT CONST erste wahl,
+                            BOOL CONST scroll ein, markiert,
+                            PROC (TEXT VAR, INT CONST) inhalt) :
+
+  out (strich senkrecht);
+  position ausgeben;
+  auswahlzeile ausgeben (erste wahl, markiert,
+      PROC (TEXT VAR, INT CONST) inhalt);
+  scrollbar ausgeben;
+  out (strich senkrecht) .
+
+position ausgeben :
+  INT CONST n := wahlpos (erste wahl);
+  IF n = 0 THEN
+    out ("   ")
+  ELIF mit reihenfolge THEN
+    out (text (n, 3));
+  ELSE
+    out (" x ")
+  END IF .
+
+scrollbar ausgeben :
+  IF scroll ein THEN out (scroll voll) ELSE out (scroll leer) END IF .
+
+END PROC auswahlzeile ausgeben;
+
+PROC auswahlzeile ausgeben (INT CONST erste wahl, BOOL CONST markiert,
+                            PROC (TEXT VAR, INT CONST) inhalt) :
+
+  inhalt (zeile, erste wahl);
+  INT VAR f laenge := min (x laenge - 8, length (zeile));
+  IF markiert THEN
+    f laenge := min (f laenge, x laenge - 9);
+    out (""15"")
+  ELSE
+    out (" ")
+  END IF;
+  outsubtext (zeile, 1, f laenge);
+  zeilenrest loeschen .
+
+zeilenrest loeschen :
+  IF markiert THEN
+    outsubtext (blank 120, 1, max wahllaenge - f laenge + 1);
+    out (""14"");
+    outsubtext (blank 120, 1, x laenge - max wahllaenge - 10)
+  ELSE
+    outsubtext (blank 120, 1, x laenge - f laenge - 8)
+  END IF .
+
+END PROC auswahlzeile ausgeben;
+
+PROC wahlnummer (INT CONST zeile, wert) :
+
+  f cursor (2, zeile);
+  IF wert = 0 THEN
+    out ("   ")
+  ELIF mit reihenfolge THEN
+    out (text (wert, 3))
+  ELSE
+    out (" x ")
+  END IF
+
+END PROC wahlnummer;
+
+INT PROC wahl (INT CONST stelle) :
+
+  IF stelle + stelle <= length (gewaehlt) THEN
+    gewaehlt ISUB stelle
+  ELSE
+    0
+  END IF
+
+END PROC wahl;
+
+
+(************************ Hilfen *****************************************)
+
+LET
+  maxgebiete = 200,
+  maxseiten = 5000;
+
+LET HILFE = STRUCT (
+              INT anzahl seiten,
+              ROW maxgebiete THESAURUS hilfsnamen,
+              ROW maxgebiete SATZ seitenindex,
+              ROW maxseiten SATZ seiten);
+
+BOUND HILFE VAR h;
+
+INT VAR hx, hy, hxl, hyl;
+
+BOOL VAR hilfen sparen := FALSE;
+
+TEXT VAR zeilenpuffer;
+
+
+(************************* Hilfe einlesen ********************************)
+
+LET
+  hilfsgebiet existiert bereits = #717#
+    "Das Hilfsgebiet existiert bereits",
+  seite existiert nicht =  #718#
+    "Diese Seite ist in der anderen Hilfe nicht vorhanden";
+
+
+PROC hilfe aus datei lesen :
+
+  TEXT VAR name := text parameter;
+  BOOL VAR hilfe ueberspringen;
+  IF name = niltext THEN
+    fehler (kein name angegeben)
+  ELSE
+    eintrag reservieren;
+    seiten einlesen;
+    hilfe abspeichern
+  END IF .
+
+eintrag reservieren :
+  INT CONST trennung := pos (name, "/");
+  TEXT VAR gebiet;
+  IF trennung = 0 THEN
+    gebiet := name
+  ELSE
+    gebiet := subtext (name, 1, trennung - 1)
+  END IF;
+  gebietsindex bestimmen;
+  einzelindex bestimmen .
+
+gebietsindex bestimmen :
+  INT VAR gebietsindex := link (thesaurus (1), gebiet);
+  hilfe ueberspringen := FALSE;
+  IF gebietsindex = 0 THEN
+    insert (thesaurus (1), gebiet, gebietsindex);
+    h. hilfsnamen (gebietsindex) := empty thesaurus;
+    satz initialisieren (h. seitenindex (gebietsindex));
+  ELIF trennung = 0 THEN
+    fehler (hilfsgebiet existiert bereits);
+    LEAVE hilfe aus datei lesen
+  ELIF hilfen sparen THEN
+    hilfe ueberspringen := TRUE
+  END IF .
+
+einzelindex bestimmen :
+  INT VAR einzelindex;
+  TEXT VAR einzelname := subtext (name, trennung + 1);
+  IF trennung = 0 THEN
+    einzelindex := 1
+  ELSE
+    einzelindex := link (h. hilfsnamen (gebietsindex), einzelname);
+    IF einzelindex = 0 AND NOT hilfe ueberspringen THEN
+      insert (h. hilfsnamen (gebietsindex), einzelname, einzelindex)
+    END IF
+  END IF .
+
+seiten einlesen :
+  INT VAR vorlaeufige seiten := h. anzahl seiten;
+  IF vorlaeufige seiten < 0 THEN
+    vorlaeufige seiten := 0
+  END IF;
+  TEXT VAR alle seiten := niltext;
+  zeile lesen;
+  WHILE kommandozeile CAND kommando ist (seite kommando) REP
+    eine seite einlesen
+  END REP .
+
+eine seite einlesen :
+  INT CONST seitennr := int parameter;
+  TEXT CONST referenz := text parameter;
+  IF referenz <> niltext THEN
+    seitenreferenz besorgen;
+    zeile lesen
+  ELSE
+    neue seite einlesen
+  END IF .
+
+seitenreferenz besorgen :
+  TEXT VAR referenzseiten;
+  seiten bestimmen (referenz, referenzseiten);
+  IF seitennr + seitennr <= length (referenzseiten) THEN
+    alle seiten CAT (referenzseiten ISUB seitennr)
+  ELIF NOT (anything noted OR hilfe ueberspringen) THEN
+    fehler (seite existiert nicht)
+  END IF .
+
+neue seite einlesen :
+  INT VAR zeilennr := 1;
+  IF NOT hilfe ueberspringen THEN
+    vorlaeufige seiten INCR 1;
+    alle seiten CAT vorlaeufige seiten;
+    satz initialisieren (h. seiten (vorlaeufige seiten))
+  END IF;
+  zeilenpuffer := niltext;
+  REP
+    zeile lesen;
+    IF kommandozeile THEN
+      LEAVE neue seite einlesen
+    ELIF NOT hilfe ueberspringen THEN
+      zeile in hilfe einfuegen
+    END IF
+  END REP .
+
+zeile in hilfe einfuegen :
+  zeilenpuffer CAT zeile;
+  feld aendern (h. seiten (vorlaeufige seiten), zeilennr, zeilenpuffer);
+  IF absatzzeile THEN
+    zeilennr INCR 1;
+    zeilenpuffer := niltext
+  ELSE
+    zeilenpuffer CAT blank
+  END IF .
+
+absatzzeile :
+  (zeilenpuffer SUB LENGTH zeilenpuffer) = blank .
+
+hilfe abspeichern :
+  IF NOT kommando ist (ende kommando) THEN
+    fehler (ende fehlt)
+  END IF;
+  IF NOT (anything noted OR hilfe ueberspringen) THEN
+    feld aendern (h. seitenindex (gebietsindex), einzelindex, alle seiten);
+    h. anzahl seiten := vorlaeufige seiten
+  END IF .
+
+END PROC hilfe aus datei lesen;
+
+PROC seiten bestimmen (TEXT CONST name, TEXT VAR alle seiten) :
+
+  INT CONST trennung := pos (name, "/");
+  INT VAR
+    gebiet,
+    einzelindex := 0;
+  IF trennung = 0 THEN
+    gebiet := link (thesaurus (1), name)
+  ELSE
+    gebiet := link (thesaurus (1), subtext (name, 1, trennung - 1));
+    einzelindex suchen
+  END IF;
+  IF einzelindex = 0 THEN
+    einzelindex := 1
+  END IF;
+  IF gebiet = 0 THEN
+    errorstop (hilfe existiert nicht)
+  ELSE
+    feld lesen (h. seitenindex (gebiet), einzelindex, alle seiten)
+  END IF .
+
+einzelindex suchen :
+  IF gebiet > 0 THEN
+    einzelindex :=
+      link (h. hilfsnamen (gebiet), subtext (name, trennung + 1))
+  END IF .
+
+END PROC seiten bestimmen;
+
+
+(************************* Hilfe anbieten ********************************)
+
+LET
+  hilfe existiert nicht =  #719#
+    "Hilfe existiert nicht",
+  hilfe ist leer =  #720#
+    "Hilfe ist leer",
+  t seite nr =  #721#
+    " Seite ",
+  t seite von =  #722#
+    " von ",
+  hilfe status =  #723#
+"HILFE:  Beenden: ESC q  Seite weiter: ESC UNTEN  Seite zurueck: ESC OBEN";
+
+
+TEXT VAR seitenkopf;
+
+INT VAR
+  einrueckbreite,
+  hilfszeilennr,
+  hilfsanfang;
+
+BOOL VAR ausfuehrliche hilfe := TRUE;
+
+
+PROC viel hilfe (BOOL CONST wirklich) :
+  ausfuehrliche hilfe := wirklich
+END PROC viel hilfe;
+
+BOOL PROC viel hilfe :  ausfuehrliche hilfe  END PROC viel hilfe;
+
+
+PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) :
+
+  enable stop;
+  ggf initialisieren;
+  TEXT VAR alle seiten;
+  fensterzugriff anmelden;
+  seiten bestimmen (name, alle seiten);
+  IF alle seiten = niltext THEN
+    errorstop (hilfe ist leer)
+  ELSE
+    seiten ausgeben
+  END IF .
+
+fensterzugriff anmelden :
+  fenster veraendert (f);
+  fenstergroesse (f, hx, hy, hxl, hyl) .
+
+seiten ausgeben :
+  INT CONST hilfeseiten := length (alle seiten) DIV 2;
+  tastenpuffer loeschen;
+  status anzeigen (hilfe status);
+  INT VAR seitenindex := 1;
+  REP
+    eine seite ausgeben;
+    kommando annehmen
+  END REP .
+
+eine seite ausgeben :
+  INT CONST tatsaechliche seite := alle seiten ISUB seitenindex;
+  seitenkopf := t seite nr + text (seitenindex) + t seite von;
+  seitenkopf CAT text (hilfeseiten); seitenkopf CAT " ";
+  IF length (seitenkopf) + 2 > hxl THEN seitenkopf := niltext END IF;
+  seite ausgeben (h. seiten (tatsaechliche seite)) .
+
+kommando annehmen :
+  TEXT VAR eingabe;
+  REP
+    getchar (eingabe);
+    IF eingabe = esc THEN
+      getchar (eingabe);
+      kommando ausfuehren;
+      LEAVE kommando annehmen
+    ELSE
+      out (piep)
+    END IF
+  END REP .
+
+kommando ausfuehren :
+  SELECT pos ("q"10""3"?"1"", eingabe) OF
+  CASE 1 :  LEAVE hilfe anbieten
+  CASE 2 :  eine seite weiter
+  CASE 3 :  eine seite zurueck
+  CASE 4 :  an anfang
+  CASE 5 :  esc hop ausfuehren
+  OTHERWISE out (piep)
+  END SELECT .
+
+eine seite weiter :
+  IF seitenindex < hilfeseiten THEN
+    seitenindex INCR 1
+  END IF .
+
+eine seite zurueck :
+  IF seitenindex > 1 THEN
+    seitenindex DECR 1
+  END IF .
+
+an anfang :
+  seitenindex := 1 .
+
+END PROC hilfe anbieten;
+
+PROC seite ausgeben (SATZ CONST seite) :
+
+  INT VAR zeilennr;
+  hilfszeilennr := 1;
+  hilfsanfang := 0;
+  kopfzeile ausgeben;
+  einrueckbreite := 0;
+  FOR zeilennr FROM 1 UPTO hyl - 2 REP
+    cursor (hx, hy + zeilennr);
+    feld bearbeiten (seite, hilfszeilennr,
+      PROC (TEXT CONST, INT CONST, INT CONST) zeile ausgeben)
+  END REP;
+  letzte zeile ausgeben .
+
+kopfzeile ausgeben :
+  cursor (hx, hy);
+  out oben (hxl, seitenkopf) .
+
+letzte zeile ausgeben :
+  cursor (hx, hy + hyl - 1);
+  out unten (hxl);
+  cursor (1, 1) .
+
+END PROC seite ausgeben;
+
+PROC zeile ausgeben (TEXT CONST bild, INT CONST von, bis) :
+
+  ende := min (hilfsanfang + von + hxl - 3 - einrueckbreite, bis);
+  IF von <= bis CAND (bild SUB von) = "-" THEN
+    out mitte (hxl);
+    hilfszeilennr INCR 1;
+    einrueckbreite := 0
+  ELSE
+    umbruch;
+    wirklich ausgeben;
+    naechsten zeilenanfang setzen
+  END IF .
+
+umbruch :
+  IF ende < bis THEN
+    IF umbruch noetig CAND umbruch moeglich THEN
+      ende zuruecksetzen
+    END IF
+  END IF .
+
+umbruch noetig :
+  (bild SUB ende + 1) <> " " AND (bild SUB ende) <> " " .
+
+umbruch moeglich :
+  pos (bild, " ", hilfsanfang + von, ende) > 0 .
+
+ende zuruecksetzen :
+  WHILE (bild SUB ende) <> " " REP ende DECR 1 END REP .
+
+wirklich ausgeben :
+  out (strich senkrecht);
+  outsubtext (blank 120, 1, einrueckbreite);
+  outsubtext (bild, von + hilfsanfang, ende);
+  outsubtext (blank 120, 1,
+              hxl + von + hilfsanfang - einrueckbreite - ende - 3);
+  out (strich senkrecht) .
+
+naechsten zeilenanfang setzen :
+  IF ende < bis THEN
+    ggf einrueckbreite setzen;
+    hilfsanfang := ende - von + 1;
+    ende INCR 1;
+    WHILE (bild SUB ende) = " " REP
+      hilfsanfang INCR 1; ende INCR 1
+    END REP
+  ELSE
+    hilfsanfang := 0;
+    hilfszeilennr INCR 1;
+    einrueckbreite := 0
+  END IF .
+
+ggf einrueckbreite setzen :
+  IF einrueckbreite = 0 CAND hilfsanfang = 0 THEN
+    einrueckbreite := pos (bild, "  ", von, ende);
+    IF einrueckbreite > 0 THEN
+      einrueckbreite auf wortanfang
+    END IF
+  END IF .
+
+einrueckbreite auf wortanfang :
+  WHILE (bild SUB einrueckbreite) = " " REP
+    einrueckbreite INCR 1
+  END REP;
+  einrueckbreite DECR von .
+
+END PROC zeile ausgeben;
+
+
+(*********************** Statuszeile *************************************)
+
+BOOL VAR status zeigen := TRUE;
+
+PROC statuszeile (BOOL CONST modus) :
+  status zeigen := modus
+END PROC statuszeile;
+
+BOOL PROC statuszeile :
+  status zeigen
+END PROC statuszeile;
+
+
+PROC status anzeigen (TEXT CONST status) :
+
+  IF status zeigen THEN
+    cursor (1, 1); out (" ");
+    out (status);
+    out (cl eol);
+    fenster veraendert (balkenfenster)
+  END IF
+
+END PROC status anzeigen;
+
+
+(***************************** Basisauswahl *******************************)
+
+LET max funktionen = 20;
+
+ROW max funktionen INT VAR w anf;
+
+INT VAR
+  position,
+  gesamtlaenge,
+  h zeile,
+  p zeile,
+  cursor x alt,
+  cursor y alt;
+
+TEXT VAR prompt;
+
+
+PROC basisauswahl (MENUE CONST m, INT CONST x anf, INT VAR wahl) :
+
+  enable stop;
+  BOOL VAR menue ausgegeben := FALSE;
+  REP
+    IF NOT menue ausgegeben THEN
+      menue ausgeben
+    END IF;
+    zeichen annehmen;
+    kommando ausfuehren
+  END REP .
+
+menue ausgeben :
+  INT VAR i;
+  cursor (x anf, h zeile);
+  position := x anf;
+  w anf (1) := position;
+  FOR i FROM 1 UPTO felderzahl (m. bild) REP
+    out (" "); position INCR 1;
+    feld bearbeiten (m. bild, i,
+      PROC (TEXT CONST, INT CONST, INT CONST) m out incr);
+    out (" "); position INCR 1;
+    w anf (i + 1) := position;
+  END REP;
+  gesamtlaenge := position;
+  menue ausgegeben := TRUE;
+  aktuelle wahl markieren (m. bild, wahl) .
+
+zeichen annehmen :
+  TEXT VAR zeichen;
+  getchar (zeichen) .
+
+kommando ausfuehren :
+  SELECT pos (""2""8""13" "1""27"", zeichen) OF
+  CASE 1 : neue wahl (m. bild, wahl, wahl + 1)
+  CASE 2 : neue wahl (m. bild, wahl, wahl - 1)
+  CASE 3, 4 : exit wahl (m. bild, wahl); LEAVE basisauswahl
+  CASE 5 : hop kommando
+  CASE 6 : esc kommando
+  OTHERWISE direkte wahl
+  END SELECT .
+
+direkte wahl:
+  INT VAR d pos := 0;
+  REP
+    d pos := pos (m. feldtasten, zeichen, d pos + 1)
+  UNTIL (d pos MOD 2) = 0 END REP;
+  IF d pos = 0 THEN
+    IF zeichen < ""32"" THEN push (""27"" + zeichen) ELSE out (""7"") END IF
+  ELSE
+    neue wahl (m. bild, wahl, code (m. feldtasten SUB d pos - 1));
+    exit wahl (m. bild, wahl);
+    LEAVE basisauswahl
+  END IF .
+
+esc kommando :
+  TEXT VAR zweites;
+  getchar (zweites);
+  SELECT pos (""1"qh?"27"", zweites) OF
+  CASE 1 : esc hop ausfuehren
+  CASE 2 : wahl := 0; LEAVE basisauswahl
+  CASE 3 : errorstop ("")
+  CASE 4 : exit wahl (m. bild, wahl); wahl := - wahl; 
+           LEAVE basisauswahl
+  CASE 5 : wahl := - 32000; LEAVE basisauswahl
+  OTHERWISE push (lernsequenz auf taste (zweites))
+  END SELECT .
+
+hop kommando :
+  getchar (zweites);
+  SELECT pos (""8""2"", zweites) OF
+  CASE 1 : neue wahl (m. bild, wahl, 1)
+  CASE 2 : neue wahl (m. bild, wahl, felderzahl (m. bild))
+  OTHERWISE out (""7"")
+  END SELECT .
+
+END PROC basisauswahl;
+
+PROC menueheader (SATZ CONST bild, INT CONST wahl) :
+
+  IF p zeile > 0 THEN
+    cursor (1, p zeile);
+    out (""15""); out (prompt); position := length (prompt) + 1;
+    feld bearbeiten (bild, wahl,
+      PROC (TEXT CONST, INT CONST, INT CONST) m out rechts);
+    out (" "14"")
+  END IF
+
+END PROC menueheader;
+
+PROC aktuelle wahl markieren (SATZ CONST bild, INT CONST wahl) :
+
+  menueheader (bild, wahl);
+  cursor (w anf (wahl), h zeile);
+  out (""15"");
+  feld bearbeiten (bild, wahl,
+    PROC (TEXT CONST, INT CONST, INT CONST) m out);
+  out (" "14"");
+  cursor (cursor x alt, cursor y alt)
+
+END PROC aktuelle wahl markieren;
+
+PROC neue wahl (SATZ CONST bild, INT VAR wahl, INT CONST neu) :
+
+  alte wahl demarkieren;
+  wahl := neu;
+  IF wahl < 1 THEN
+    wahl := felderzahl (bild)
+  ELIF wahl > felderzahl (bild) THEN
+    wahl := 1
+  END IF;
+  aktuelle wahl markieren (bild, wahl) .
+
+alte wahl demarkieren :
+  cursor (w anf (wahl), h zeile);
+  out (" ");
+  feld bearbeiten (bild, wahl,
+    PROC (TEXT CONST, INT CONST, INT CONST) m out);
+  out ("  ") .
+
+END PROC neue wahl;
+
+PROC exit wahl (SATZ CONST bild, INT CONST wahl) :
+
+  cursor (w anf (1), h zeile);
+  w anf (wahl) - w anf (1) + 1 TIMESOUT " ";
+  feld bearbeiten (bild, wahl,
+    PROC (TEXT CONST, INT CONST, INT CONST) m out);
+  gesamtlaenge - w anf (wahl + 1) + 2 TIMESOUT " "
+
+END PROC exit wahl;
+
+PROC m out incr (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR grenze := pos (satz, " ", von) - 1;
+  IF grenze < 0 THEN grenze := bis END IF;
+  outsubtext (satz, von, grenze);
+  position INCR grenze - von + 1
+
+END PROC m out incr;
+
+PROC m out (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR grenze := pos (satz, " ", von) - 1;
+  IF grenze < 0 THEN grenze := bis END IF;
+  outsubtext (satz, von, grenze)
+
+END PROC m out;
+
+PROC m out rechts (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR grenze := pos (satz, " ", von) + 1;
+  IF grenze < 2 THEN grenze := bis + 1 END IF;
+  x size - 5 - position - bis + grenze TIMESOUT " ";
+  outsubtext (satz, grenze, bis)
+
+END PROC m out rechts;
+
+PROC zeilenmenue anbieten (TEXT CONST m name, BOOL CONST esc erlaubt,
+                           PROC (INT CONST) kommandos) :
+
+  BOOL VAR save zeilenmenue := ist zeilenmenue;
+  INT VAR m index := link (thesaurus (2), m name);
+  IF m index = 0 THEN
+    existiert nicht (m name); LEAVE zeilenmenue anbieten
+  END IF;
+  h zeile := y size; p zeile := y size - 1;
+  get cursor (cursor x alt, cursor y alt);
+  prompt := m name;
+  disable stop;
+  ist zeilenmenue := TRUE;
+  auswahl durchfuehren;
+  kommando ausfuehren;
+  ist zeilenmenue := save zeilenmenue .
+
+auswahl durchfuehren :
+  INT VAR wahl := 1;
+  REP
+    basisauswahl (menues (m index), 1, wahl);
+    IF wahl >= 0 THEN
+      LEAVE auswahl durchfuehren
+    ELIF wahl = -32000 THEN
+      IF esc erlaubt THEN LEAVE auswahl durchfuehren END IF
+    ELSE
+      wahl := - wahl;
+      TEXT VAR hilfsname;
+      feld lesen (menues (m index). hilfen, wahl, hilfsname);
+      hilfe anbieten (hilfsname, d fenster)
+    END IF
+  UNTIL is error END REP .
+
+kommando ausfuehren :
+  IF wahl > 0 THEN
+    exec im enable stop (wahl, PROC (INT CONST) kommandos)
+  ELIF wahl = - 32000 THEN
+    gib kommando im menue
+  END IF .
+
+gib kommando im menue :
+  cursor (1, y size - 1);
+  out (""4""); out (gib kommando); out (""14"");
+  TEXT VAR dummy := "";
+  editget (dummy);
+  IF dummy <> "" THEN
+    do (dummy)
+  END IF .
+
+END PROC zeilenmenue anbieten;
+
+PROC exec im enable stop (INT CONST wahl, PROC (INT CONST) kommandos) :
+
+  enable stop;
+  kommandos (wahl)
+
+END PROC exec im enable stop;
+
+
+(******************************* Dialog **********************************)
+
+LET
+  cleop = ""4"",
+  esc fragezeichen = ""27"?",
+  esc q = ""27"q",
+  esc h = ""27"h";
+
+LET
+(*ja text = #724#
+    " Ja ",
+  nein text = #725#
+    "Nein",*)
+  fragezeichen = #726#
+    " ?",
+  horizontal auswahl status =  #727#
+"WAHL:  Wählen: <-, ->  Bestätigen: RETURN  Abbruch: ESC h  Hilfe: ESC ?",
+  ja status =  #728#
+"FRAGE:  Bejahen: j,J    Verneinen: n,N    Abbrechen: ESC h    Hilfe: ESC ?",
+  editget status ohne esc z =  #729#
+"EINGABE:  Bestätigen: RETURN    Abbrechen: ESC h    Hilfe: ESC ?",
+  editget status mit esc z =  #730#
+"EINGABE:  Bestätigen: RETURN   Zeigen: ESC z   Abbruch: ESC h  Hilfe: ESC ?",
+  fehler status =  #731#
+""15"!!! FEHLER !!! "14"     Quittieren: ESC q     Hilfe zur Meldung: ESC ?";
+
+FENSTER VAR d fenster;
+fenster initialisieren (d fenster);
+
+INT VAR
+  dialogzeile,
+  dx,
+  dy,
+  dxl,
+  dyl;
+
+
+PROC dialogfenster (FENSTER CONST fe) :
+
+  fenstergroesse (fe, dx, dy, dxl, dyl);
+  fenstergroesse setzen (d fenster, fe)
+
+END PROC dialogfenster;
+
+FENSTER PROC dialogfenster :
+
+  d fenster
+
+END PROC dialogfenster;
+
+PROC neuer dialog :
+
+  dialogzeile := dyl
+
+END PROC neuer dialog;
+
+PROC dialog box :
+
+  BOOL VAR veraendert;
+  fensterzugriff (d fenster, veraendert);
+  dialogzeile INCR 3;
+  IF dialogzeile + 3 > dyl OR veraendert THEN
+    loeschvorgang dialogfenster;
+    dialogzeile := 1
+  END IF;
+  rahmen zeichnen;
+  cursor (dx + 1, dy + dialogzeile) .
+
+rahmen zeichnen :
+  cursor (dx, dy + dialogzeile - 1);
+  out oben (dxl);
+  cursor (dx, dy + dialogzeile);
+  leere boxzeile;
+  cursor (dx, dy + dialogzeile + 1);
+  leere boxzeile;
+  cursor (dx, dy + dialogzeile + 2);
+  out unten (dxl) .
+
+END PROC dialog box;
+
+PROC leere boxzeile :
+
+  out (strich senkrecht);
+  outsubtext (blank 120, 1, dxl - 2);
+  out (strich senkrecht)
+
+END PROC leere boxzeile;
+
+PROC dialog (TEXT CONST ausgabe) :
+
+  dialog box;
+  outsubtext (ausgabe, 1, dxl - 2);
+  cursor (dx + 1, dy + dialogzeile + 1)
+
+END PROC dialog;
+
+PROC dialogfenster loeschen :
+
+  fenster veraendert (d fenster);
+  loeschvorgang dialogfenster
+
+END PROC dialogfenster loeschen;
+
+PROC loeschvorgang dialogfenster :
+
+  BOOL CONST bis zeilenende := dx + dxl >= x size;
+  dialogzeile := 0;
+  REP
+    cursor (dx, dy + dialogzeile);
+    IF bis zeilenende THEN
+      out (cleol)
+    ELSE
+      outsubtext (blank 120, 1, dxl)
+    END IF;
+    dialogzeile INCR 1
+  UNTIL dialogzeile >= dyl END REP
+
+END PROC loeschvorgang dialogfenster;
+
+PROC auswahl anbieten (TEXT CONST m name, prompt, hilfe, INT VAR ergebnis) :
+
+  INT VAR auswahl nr := link (thesaurus (2), m name);
+  IF auswahl nr = 0 THEN
+    existiert nicht (m name); LEAVE auswahl anbieten
+  END IF;
+  REP
+    status anzeigen (horizontal auswahl status);
+    dialog box;
+    outsubtext (prompt, 1, dxl - 2);
+    auswahl durchfuehren
+  END REP .
+
+auswahl durchfuehren :
+  INT CONST alte wahl := ergebnis;
+  h zeile := dy + dialogzeile + 1; p zeile := 0;
+  cursor x alt := 1; cursor y alt := 1;
+  basisauswahl (menues (auswahl nr), dx + 1, ergebnis);
+  IF ergebnis >= 0 THEN
+    IF ergebnis = 0 THEN ergebnis := alte wahl END IF;
+    LEAVE auswahl anbieten
+  ELIF ergebnis = - 32000 THEN
+    ergebnis := 1
+  ELSE
+    hilfe anbieten (hilfe, d fenster);
+    neuer dialog;
+    ergebnis := - ergebnis
+  END IF .
+
+END PROC auswahl anbieten;
+
+BOOL PROC ja (TEXT CONST frage, hilfe) :
+
+  ja (frage, hilfe, TRUE)
+
+END PROC ja;
+
+BOOL PROC ja (TEXT CONST frage, hilfe, BOOL CONST default) :
+
+  INT VAR wahl;
+  IF default THEN wahl := 1 ELSE wahl := 2 END IF;
+  REP
+    status anzeigen (ja status);
+    IF ist zeilenmenue THEN
+      cursor (1, y size);
+      INT CONST fragelaenge := min (length (frage), x size - 16);
+      outsubtext (frage, 1, fragelaenge); out (""5"")
+    ELSE
+      dialog box;
+      outsubtext (frage, 1, dxl - 4);
+    END IF;
+    out (fragezeichen);
+    tastenpuffer loeschen;
+    ja auswahl durchfuehren
+  END REP;
+  FALSE .
+
+ja auswahl durchfuehren :
+  basisauswahl initialisieren;
+  basisauswahl (ja auswahl, auswahl anfang, wahl);
+  IF wahl = 1 THEN
+    LEAVE ja WITH TRUE
+  ELIF wahl = 2 THEN
+    LEAVE ja WITH FALSE
+  ELIF wahl = -32000 THEN
+    wahl := 1
+  ELIF wahl = 0 THEN
+    errorstop ("")
+  ELSE
+    hilfe anbieten (hilfe, d fenster);
+    neuer dialog;
+    wahl := - wahl
+  END IF .
+
+basisauswahl initialisieren :
+  INT VAR auswahl anfang;
+  IF ist zeilenmenue THEN
+    h zeile := y size; p zeile := 0;
+    auswahl anfang := fragelaenge + 4
+  ELSE
+    h zeile := dy + dialogzeile + 1; p zeile := 0;
+    cursor x alt := 1; cursor y alt := 1;
+    auswahl anfang := dx + 1
+  END IF .
+
+ja auswahl :
+  menues (link (thesaurus (2), "WAHL.Ja")) .
+
+END PROC ja;
+
+PROC editget (TEXT CONST prompt, TEXT VAR eingabe, TEXT CONST res, hilfe) :
+
+  TEXT VAR exit char;
+  passenden status anzeigen;
+  IF ist zeilenmenue THEN
+    cursor (1, y size); out (""5""); put (prompt);
+  ELSE
+    dialog (prompt);
+(*  cursor (dx + 1, dy + dialogzeile + 1); out (">");
+  cursor (dx + dxl - 2, dy + dialogzeile + 1); out ("<");*)
+    cursor (dx + 1, dy + dialogzeile + 1)
+  END IF;
+  editget (eingabe, 1000, editlaenge, "", "?hq" + res, exit char);
+  cursor (1, 1);
+  IF exit char = esc fragezeichen THEN
+    hilfe anbieten (hilfe, d fenster);
+    neuer dialog;
+    editget (prompt, eingabe, res, hilfe)
+  ELIF exit char = esc h OR exit char = esc q THEN
+    errorstop (niltext)
+  ELIF length (exit char) = 2 THEN
+    eingabe := exit char + eingabe
+  END IF .
+
+passenden status anzeigen :
+  IF pos (res, "z") > 0 THEN
+    status anzeigen (editget status mit esc z)
+  ELSE
+    status anzeigen (editget status ohne esc z)
+  END IF .
+
+editlaenge :
+  IF ist zeilenmenue THEN
+    x size - length (prompt) - 2
+  ELSE
+    dxl - 4
+  END IF .
+
+END PROC editget;
+
+PROC fehler ausgeben :
+
+  TEXT CONST meldung := errormessage;
+  IF error code = 1 THEN
+    page; bildschirm neu
+  END IF;
+  clear error;
+  tastenpuffer loeschen;
+  IF meldung <> niltext THEN
+    status anzeigen (fehler status);
+    meldung ausgeben;
+    eingabe abwarten;
+    neuer dialog
+  END IF .
+
+meldung ausgeben :
+  dialog box;
+  out (piep); out (">>> ");
+  cursor (dx + 1, dy + dialogzeile + 1);
+  outsubtext (errormessage, 1, dxl - 2) .
+
+eingabe abwarten :
+  TEXT VAR eingabe;
+  cursor (1, 1);
+  getchar (eingabe);
+  IF eingabe = esc THEN
+    esc funktionen
+  END IF .
+
+esc funktionen :
+  getchar (eingabe);
+  IF eingabe = "?" THEN
+    hilfe anbieten ("FEHLER/" + text (errorcode), d fenster)
+  ELIF eingabe = ""1"" THEN
+    esc hop ausfuehren
+  END IF .
+
+END PROC fehler ausgeben;
+
+PROC tastenpuffer loeschen :
+
+  WHILE getcharety <> niltext REP END REP
+
+END PROC tastenpuffer loeschen;
+
+
+(************************** Menue Manager ********************************)
+
+LET
+  max ds = 3,
+  save order = 12,
+  erase order = 14,
+  fetch order = 1070,
+  lock order = 1068,
+  free order = 1069,
+  ack = 0,
+  error nak = 2;
+ 
+ROW maxds DATASPACE VAR menue ds;
+
+ROW maxds THESAURUS VAR thesaurus;
+
+BOOL VAR vater ist menuemanager := FALSE;
+
+INITFLAG VAR menueinitialisierung;
+
+
+PROC ggf initialisieren :
+
+  IF NOT initialized (menueinitialisierung) THEN
+    initialisierung durchfuehren
+  END IF .
+
+initialisierung durchfuehren :
+  BOOL VAR erfolgreich := vater ist menuemanager;
+  datenraeume holen;
+  IF erfolgreich THEN
+    ankoppeln
+  ELSE
+    menue loeschen (FALSE)
+  END IF .
+
+datenraeume holen :
+  INT VAR nr;
+  FOR nr FROM 1 UPTO maxds
+  WHILE erfolgreich REP
+    versuche zu holen
+  END REP .
+
+versuche zu holen :
+  INT VAR
+    reply,
+    retries;
+  FOR retries FROM 1 UPTO 10 REP
+    forget (menue ds (nr));
+    menue ds (nr) := nilspace;
+    pingpong (father, fetch order + nr, menue ds (nr), reply);
+    IF reply = ack THEN
+      LEAVE versuche zu holen
+    ELIF reply <> error nak THEN
+      pause (15)
+    END IF
+  UNTIL reply = error nak END REP;
+  forget (menue ds (nr));
+  menue ds (nr) := nilspace;
+  erfolgreich := FALSE .
+
+END PROC ggf initialisieren;
+
+THESAURUS PROC menuenamen (INT CONST nr) :
+
+  ggf initialisieren;
+  IF nr < 0 THEN
+    h. hilfsnamen (- nr)
+  ELSE
+    thesaurus (nr)
+  END IF
+
+END PROC menuenamen;
+
+PROC menue loeschen (TEXT CONST name, INT CONST nr) :
+
+  ggf initialisieren;
+  IF nr < 0 THEN
+    loeschen (name, h. hilfsnamen (- nr))
+  ELSE
+    loeschen (name, thesaurus (nr))
+  END IF
+
+END PROC menue loeschen;
+
+PROC loeschen (TEXT CONST name, THESAURUS VAR t) :
+
+  INT CONST index := link (t, name);
+  IF index > 0 THEN
+    delete (t, index)
+  END IF
+
+END PROC loeschen;
+
+PROC menue loeschen (BOOL CONST hilfen reduzieren) :
+
+  INT VAR nr;
+  menueinitialisierung := TRUE;
+  hilfen sparen := hilfen reduzieren;
+  FOR nr FROM 1 UPTO max ds REP
+    forget (menue ds (nr));
+    menue ds (nr) := nilspace;
+    thesaurus (nr) := empty thesaurus
+  END REP;
+  ankoppeln
+
+END PROC menue loeschen;
+
+PROC ankoppeln :
+
+  h := menue ds (1);
+  menues := menue ds (2);
+  auswahlen := menue ds (3)
+
+END PROC ankoppeln;
+
+
+LET
+  lock aktiv =  #732#
+    "Datei wird von anderer Task geaendert.",
+  auftrag nur fuer soehne =  #733#
+    "Auftrag nur fuer Soehne erlaubt";
+
+THESAURUS VAR locks := empty thesaurus;
+
+ROW 200 TASK VAR lock owner;
+
+TEXT VAR save file name;
+
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;
+
+PROC menue manager (DATASPACE VAR ds, INT CONST order, phase,
+                    TASK CONST order task) :
+
+  enable stop;
+  vater ist menue manager := TRUE;
+  IF order >= lock order AND order <= fetch order + max ds THEN
+    menue auftrag
+  ELSE
+    IF order = save order OR order = erase order THEN
+      save pre
+    END IF;
+    free manager (ds, order, phase, order task)
+  END IF .
+
+menue auftrag :
+  IF order = lock order THEN
+    lock ausfuehren
+  ELIF order = free order THEN
+    free ausfuehren
+  ELSE
+    menue fetch
+  END IF .
+
+lock ausfuehren :
+  msg := ds;
+  set lock (msg. name, order task);
+  send (order task, ack, ds) .
+
+free ausfuehren :
+  msg := ds;
+  reset lock (msg. name);
+  send (order task, ack, ds) .
+
+save pre :
+  IF phase = 1 THEN
+    lock ueberpruefen
+  ELIF order = erase order THEN
+    reset lock (save file name)
+  END IF .
+
+lock ueberpruefen :
+  msg := ds;
+  save file name := msg. name;
+  IF gesperrt und task ungleich THEN
+    errorstop (lock aktiv)
+  END IF .
+
+gesperrt und task ungleich :
+  INT VAR stelle := link (locks, save file name);
+  stelle > 0 CAND NOT (lock owner (stelle) = order task) .
+
+menue fetch :
+  IF order task < myself THEN
+    ggf initialisieren;
+    forget (ds); ds := menue ds (order - fetch order);
+    send (order task, ack, ds)
+  ELSE
+    errorstop (auftrag nur fuer soehne)
+  END IF .
+
+END PROC menue manager;
+
+PROC set lock (TEXT CONST dateiname, TASK CONST owner) :
+
+  INT VAR i := link (locks, dateiname);
+  IF i = 0 THEN
+    insert (locks, dateiname, i);
+    ggf reorganisieren;
+    lock owner (i) := owner
+  ELIF exists (lock owner (i)) THEN
+    IF NOT (lock owner (i) = owner) THEN
+      errorstop (lock aktiv)
+    END IF
+  ELSE
+    lock owner (i) := owner
+  END IF .
+
+ggf reorganisieren :
+  IF i = 0 THEN
+    locks reorganisieren;
+    insert (locks, dateiname, i)
+  END IF .
+
+locks reorganisieren :
+  TEXT VAR eintrag;
+  i := 0;
+  REP
+    get (locks, eintrag, i);
+    IF i = 0 THEN
+      LEAVE locks reorganisieren
+    END IF;
+    IF NOT exists (eintrag) OR NOT exists (lock owner (i)) THEN
+      delete (locks, i)
+    END IF
+  END REP .
+
+END PROC set lock;
+
+PROC reset lock (TEXT CONST dateiname) :
+
+  INT VAR i;
+  delete (locks, dateiname, i)
+
+END PROC reset lock;
+
+PROC global manager :
+
+  global manager (PROC (DATASPACE VAR, INT CONST, INT CONST,
+                        TASK CONST) menue manager)
+
+END PROC global manager;
+
+PROC lock (TEXT CONST dateiname, TASK CONST manager) :
+
+  call (lock order, dateiname, manager)
+
+END PROC lock;
+
+PROC free (TEXT CONST dateiname, TASK CONST manager) :
+
+  call (free order, dateiname, manager)
+
+END PROC free;
+
+END PACKET eudas menues;
+
diff --git a/app/eudas/5.3/src/eudas.saetze.03 b/app/eudas/5.3/src/eudas.saetze.03
new file mode 100644
index 0000000..d3f53f1
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.saetze.03
@@ -0,0 +1,271 @@
+PACKET eudas satzzugriffe
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Feldstrukturierung von Texten                                     *)
+(*                                                                       *)
+(*     Version 03                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 17.04.87                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  SATZ,
+  := ,
+  satz initialisieren,
+  felderzahl,
+  feld lesen,
+  feld bearbeiten,
+  feld aendern,
+  feldindex :
+
+
+LET
+  maximale felderzahl = 256,
+  zeigerlaenge = 2;
+
+LET
+  blank = " ",
+  niltext = "";
+ 
+LET
+  illegale feldnummer =  #101#
+    " ist keine Feldnummer";
+
+TEXT VAR
+  raum fuer ein int := zeigerlaenge * blank;
+
+ 
+(**************************** Typ SATZ ***********************************)
+
+TYPE SATZ = TEXT;
+
+OP := (SATZ VAR links, SATZ CONST rechts) :
+
+  CONCR (links) := CONCR (rechts)
+
+END OP := ;
+
+
+(************************ Satz initialisieren ****************************)
+
+PROC satz initialisieren (SATZ VAR satz) :
+
+  satz initialisieren (satz, 0)
+
+END PROC satz initialisieren;
+
+PROC satz initialisieren (SATZ VAR satz, INT CONST felder) :
+
+  replace (raum fuer ein int, 1, 2 * felder + 3);
+  INT VAR i;
+  CONCR (satz) := niltext;
+  FOR i FROM 1 UPTO felder + 1 REP
+    CONCR (satz) CAT raum fuer ein int
+  END REP
+
+END PROC satz initialisieren;
+
+
+(*************************** Felderzahl **********************************)
+
+INT PROC felderzahl (SATZ CONST satz) :
+
+  INT VAR letzter zeiger := (CONCR (satz) ISUB 1) DIV 2;
+  INT CONST satzende := CONCR (satz) ISUB letzter zeiger;
+  REP
+    letzter zeiger DECR 1
+  UNTIL letzter zeiger <= 0 COR kein leeres feld END REP;
+  letzter zeiger .
+
+kein leeres feld :
+  (CONCR (satz) ISUB letzter zeiger) <> satzende .
+
+END PROC felderzahl;
+
+
+(************************** Feld lesen ***********************************)
+
+PROC feld lesen (SATZ CONST satz, INT CONST feldnr, TEXT VAR inhalt) :
+
+  feldgrenzen bestimmen (CONCR (satz), feldnr);
+  IF NOT is error THEN
+    inhalt := subtext (CONCR (satz), feldanfang, feldende)
+  END IF
+
+END PROC feld lesen;
+
+PROC feld bearbeiten (SATZ CONST satz, INT CONST feldnr,
+                      PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  feldgrenzen bestimmen (CONCR (satz), feldnr);
+  IF NOT is error THEN
+    bearbeite (CONCR (satz), feldanfang, feldende)
+  END IF
+
+END PROC feld bearbeiten;
+
+
+(************************ Feldgrenzen bestimmen **************************)
+
+INT VAR
+  feldanfang,
+  feldende;
+
+PROC feldgrenzen bestimmen (TEXT CONST satz, INT CONST feldnr) :
+
+  IF illegales feld THEN
+    errorstop (text (feldnr) + illegale feldnummer)
+  ELIF vorhandenes feld THEN
+    feldanfang := satz ISUB feldnr;
+    feldende := (satz ISUB feldnr + 1) - 1
+  ELSE
+    feldanfang := 1; feldende := 0
+  END IF .
+
+illegales feld :
+  feldnr <= 0 OR feldnr > maximale felderzahl .
+
+vorhandenes feld :
+  feldnr + feldnr < (satz ISUB 1) - 1 .
+
+END PROC feldgrenzen bestimmen;
+
+
+(*************************** Feld aendern ********************************)
+
+TEXT VAR puffer;
+
+PROC feld aendern (SATZ VAR satz, INT CONST feldnr, TEXT CONST inhalt) : 
+
+  INT VAR zeigerstelle;
+  INT CONST satzfelder := ((CONCR (satz) ISUB 1) - 2) DIV 2;
+  IF normales feld THEN
+    normal ersetzen
+  ELSE
+    errorstop (text (feldnr) + illegale feldnummer)
+  END IF .
+
+normales feld :
+  feldnr > 0 AND feldnr <= maximale felderzahl .
+
+normal ersetzen :
+  INT CONST fehlende zeiger := feldnr - satzfelder;
+  IF fehlende zeiger <= 0 THEN
+    vorhandenes feld ersetzen
+  ELIF inhalt <> niltext THEN
+    neues feld anfuegen
+  END IF .
+
+neues feld anfuegen :
+  INT CONST endezeiger := CONCR (satz) ISUB (satzfelder + 1);
+  puffer := subtext (CONCR (satz), erstes feld, endezeiger - 1);
+  CONCR (satz) := subtext (CONCR (satz), 1, satzfelder + satzfelder);
+  korrigiere zeiger (CONCR (satz), 1, satzfelder, platz fuer zeiger);
+  neue zeiger anfuegen;
+  endezeiger anfuegen;
+  CONCR (satz) CAT puffer;
+  CONCR (satz) CAT inhalt .
+
+platz fuer zeiger :
+  fehlende zeiger + fehlende zeiger .
+
+neue zeiger anfuegen :
+  INT CONST neuer zeiger := endezeiger + platz fuer zeiger;
+  FOR zeigerstelle FROM satzfelder + 1 UPTO feldnr REP
+    zeiger anfuegen (CONCR (satz), neuer zeiger)
+  END REP .
+
+endezeiger anfuegen :
+  zeiger anfuegen (CONCR (satz), neuer zeiger + length (inhalt)) .
+
+erstes feld:
+  CONCR (satz) ISUB 1 .
+
+vorhandenes feld ersetzen :
+  INT CONST
+    feldanfang := CONCR (satz) ISUB feldnr,
+    naechster feldanfang := CONCR (satz) ISUB (feldnr + 1);
+  IF feldanfang > length (CONCR (satz)) THEN
+    optimiere leerfelder
+  ELSE
+    ersetze beliebig
+  END IF .
+
+optimiere leerfelder :
+  korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1,
+                     length (inhalt));
+  CONCR (satz) CAT inhalt .
+
+ersetze beliebig :
+  puffer := subtext (CONCR (satz), naechster feldanfang);
+  CONCR (satz) := subtext (CONCR (satz), 1, feldanfang - 1);
+  korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1,
+                   laengendifferenz);
+  CONCR (satz) CAT inhalt;
+  CONCR (satz) CAT puffer  .
+
+laengendifferenz :
+  length (inhalt) - feldlaenge .
+
+feldlaenge :
+  naechster feldanfang - feldanfang .
+
+END PROC feld aendern;
+
+PROC zeiger anfuegen (TEXT VAR satz, INT CONST zeigerwert) :
+
+  replace (raum fuer ein int, 1, zeigerwert);
+  satz CAT raum fuer ein int
+
+END PROC zeiger anfuegen;
+
+PROC korrigiere zeiger (TEXT VAR satz, INT CONST anfang, ende, differenz) :
+
+  INT VAR zeigerstelle;
+  FOR zeigerstelle FROM anfang UPTO ende REP
+    replace (satz, zeigerstelle, alter zeiger + differenz)
+  END REP .
+
+alter zeiger :
+  satz ISUB zeigerstelle .
+
+END PROC korrigiere zeiger;
+
+
+(*************************** 'feldindex' *********************************)
+
+INT PROC feldindex (SATZ CONST satz, TEXT CONST muster) :
+
+  INT VAR
+    anfang := (CONCR (satz) ISUB 1) - 1,
+    zeigerstelle := 1;
+
+  REP
+    anfang := pos (CONCR (satz), muster, anfang + 1);
+    IF anfang = 0 THEN
+      LEAVE feldindex WITH 0
+    END IF;
+    durchsuche zeiger ob feldanfang
+  UNTIL zeiger zeigt auf anfang CAND naechster zeiger hinter ende END REP;
+  zeigerstelle .
+
+durchsuche zeiger ob feldanfang :
+  WHILE (CONCR (satz) ISUB zeigerstelle) < anfang REP
+    zeigerstelle INCR 1
+  END REP .
+
+zeiger zeigt auf anfang :
+  (CONCR (satz) ISUB zeigerstelle) = anfang .
+
+naechster zeiger hinter ende :
+  (CONCR (satz) ISUB (zeigerstelle + 1)) = anfang + length (muster) .
+
+END PROC feldindex;
+
+
+END PACKET eudas satzzugriffe;
+
diff --git a/app/eudas/5.3/src/eudas.satzanzeige.12 b/app/eudas/5.3/src/eudas.satzanzeige.12
new file mode 100644
index 0000000..0fc5cd9
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.satzanzeige.12
@@ -0,0 +1,1007 @@
+PACKET satzanzeige 
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Anzeige von EUDAS-Saetzen                                         *)
+(*                                                                       *)
+(*     Version 12                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 05.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  anzeigefenster,
+  bild ausgeben,
+  aendern,
+  einfuegen,
+  suchen,
+  feldauswahl,
+  rollen,
+  exit durch,
+  exit zeichen :
+
+
+LET
+  maxfelder = 256;
+
+LET
+  blank = " ",
+  niltext = "",
+  cleol = ""5"",
+  begin mark = ""15"",
+  blank end mark = " "14"",
+  blank end mark blank = " "14" ";
+
+ROW maxfelder STRUCT (INT feldnr, anfang) VAR zeilen;
+
+INT VAR
+  anzahl zeilen,
+  erste zeile,
+  laenge := 24,
+  breite := 79,
+  zeilen anf := 1,
+  spalten anf := 1,
+  feldnamenlaenge,
+  inhaltsbreite,
+  zuletzt angezeigter satz := 0,
+  letzte kombi := 0,
+  anzeigeversion := dateiversion - 1,
+  anzeigedateien := 0;
+
+BOOL VAR
+  neues fenster := TRUE,
+  bis zeilenende := TRUE,
+  save ds voll := FALSE,
+  namen ausgeben;
+
+FENSTER VAR fenster;
+fenster initialisieren (fenster);
+
+DATASPACE VAR
+  save ds,
+  edit ds;
+
+FILE VAR edit file;
+
+TEXT VAR
+  ueberschrift,
+  zeilenpuffer;
+
+LET
+  fenster zu klein =  #801#
+    "Anzeigefenster zu klein";
+
+
+PROC anzeigefenster (FENSTER CONST fe) :
+
+  INT VAR x anf, y anf, x laenge, y laenge;
+  fenstergroesse (fe, x anf, y anf, x laenge, y laenge);
+  IF x laenge >= 39 THEN
+    fenstergroesse setzen (fenster, fe);
+    bis zeilenende := x anf + x laenge >= x size;
+    breite := x laenge; laenge := y laenge;
+    spalten anf := x anf;
+    zeilen anf := y anf;
+    neues fenster := TRUE
+  ELSE
+    errorstop (fenster zu klein)
+  END IF
+
+END PROC anzeigefenster;
+
+FENSTER PROC anzeigefenster :
+  fenster
+END PROC anzeigefenster;
+
+PROC fensterzugriff anmelden :
+
+  BOOL VAR fenster veraendert;
+  fensterzugriff (fenster, fenster veraendert);
+  IF fenster veraendert THEN
+    namen ausgeben := TRUE
+  END IF
+
+END PROC fensterzugriff anmelden;
+
+PROC zeilendeskriptor aktualisieren :
+
+  IF neue datei seit letztem mal OR neues fenster THEN
+    neue feldnummern uebernehmen;
+    feldnamenlaenge bestimmen;
+    ueberschrift generieren;
+    fuer bildausgabe sorgen;
+    edit datei loeschen;
+    veraenderungsstatus merken
+  END IF .
+
+neue datei seit letztem mal :
+  anzeigeversion <> dateiversion .
+
+neue feldnummern uebernehmen :
+  anzahl zeilen := 0;
+  WHILE anzahl zeilen < anzahl felder REP
+    anzahl zeilen INCR 1;
+    zeilen (anzahl zeilen). feldnr := anzahl zeilen
+  END REP;
+  erste zeile := 1 .
+
+feldnamenlaenge bestimmen :
+  INT VAR feldnr;
+  feldnamenlaenge := 11;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen bearbeiten (feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) namen max)
+  END REP;
+  feldnamenlaenge := min (feldnamenlaenge, breite DIV 3);
+  inhaltsbreite := breite - feldnamenlaenge - 3 .
+
+fuer bildausgabe sorgen :
+  namen ausgeben := TRUE .
+
+edit datei loeschen :
+  forget (edit ds);
+  edit ds := nilspace;
+  IF neue datei seit letztem mal AND save ds voll THEN
+    forget (save ds);
+    save ds voll := FALSE
+  END IF .
+
+veraenderungsstatus merken :
+  anzeigeversion := dateiversion;
+  anzeigedateien := anzahl dateien;
+  neues fenster := FALSE .
+
+END PROC zeilendeskriptor aktualisieren;
+
+PROC namen max (TEXT CONST satz, INT CONST von, bis) :
+
+  feldnamenlaenge INCR length (satz) - length (satz);
+      (* damit Parameter benutzt *)
+  feldnamenlaenge := max (feldnamenlaenge, bis - von + 1)
+
+END PROC namen max;
+
+PROC rollen (INT CONST vektor) :
+
+  erste zeile := erste zeile + vektor;
+  IF erste zeile < 1 THEN
+    erste zeile := 1
+  ELIF erste zeile > letzte zeile THEN
+    erste zeile := max (letzte zeile, 1)
+  END IF;
+  namen ausgeben := TRUE .
+
+letzte zeile :
+  anzahl zeilen - laenge + 3 .
+
+END PROC rollen;
+
+PROC feldauswahl (TEXT CONST wahlvektor) :
+
+  zeilendeskriptor aktualisieren;
+  feldnummern uebernehmen;
+  namen ausgeben := TRUE .
+
+feldnummern uebernehmen :
+  anzahl zeilen := length (wahlvektor);
+  INT VAR zeilennr;
+  FOR zeilennr FROM 1 UPTO anzahl zeilen REP
+    zeilen (zeilennr). feldnr := code (wahlvektor SUB zeilennr)
+  END REP;
+  erste zeile := 1 .
+
+END PROC feldauswahl;
+
+
+(**************************** editfile ***********************************)
+
+INT VAR gelesene zeile;
+
+PROC edit file loeschen :
+
+  type (edit ds, - 1);
+  edit file := sequential file (modify, edit ds);
+  edit info (edit file, -1);
+  to line (editfile, 1);
+  col (editfile, 1);
+  maxlinelength (edit file, 10000);
+  gelesene zeile := 1
+
+END PROC edit file loeschen;
+
+.
+noch zeile zu bearbeiten :
+  gelesene zeile <= anzahl zeilen .
+
+PROC naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) bearbeite) :
+
+  zu bearbeitende zeilen bestimmen;
+  IF eof (editfile) THEN
+    bearbeite ("", feldnr)
+  ELIF mehrere zeilen THEN
+    zeilen verketten;
+    blanks abschneiden;
+    bearbeite (zeilenpuffer, feldnr)
+  ELIF blanks am ende THEN
+    read record (edit file, zeilenpuffer);
+    blanks abschneiden;
+    bearbeite (zeilenpuffer, feldnr);
+    down (edit file)
+  ELSE
+    exec (PROC (TEXT CONST, INT CONST) bearbeite, edit file, feldnr);
+    down (edit file)
+  END IF .
+
+zu bearbeitende zeilen bestimmen :
+  INT CONST
+    von := gelesene zeile,
+    feldnr := zeilen (von). feldnr;
+  REP 
+    gelesene zeile INCR 1
+  UNTIL gelesene zeile > anzahl zeilen COR neues feld END REP .
+
+neues feld :
+  zeilen (gelesene zeile). feldnr <> feldnr .
+
+mehrere zeilen :
+  gelesene zeile - von > 1 .
+
+zeilen verketten :
+  zeilenpuffer := "";
+  REP
+    exec (PROC (TEXT CONST, INT CONST) verkette,
+          edit file, length (zeilenpuffer));
+    down (edit file)
+  UNTIL eof (edit file) OR line no (edit file) = gelesene zeile END REP .
+
+blanks am ende :
+  INT CONST ende := len (edit file);
+  subtext (edit file, ende, ende) = blank .
+
+END PROC naechste zeile bearbeiten;
+
+PROC verkette (TEXT CONST edit zeile, INT CONST pufferlaenge) :
+
+  IF pufferlaenge > 0 CAND (zeilenpuffer SUB pufferlaenge) <> blank
+                      CAND (edit zeile SUB 1) <> blank THEN
+    zeilenpuffer CAT blank
+  END IF;
+  zeilenpuffer CAT edit zeile
+
+END PROC verkette;
+
+PROC blanks abschneiden :
+
+  INT VAR ende := length (zeilenpuffer);
+  WHILE (zeilenpuffer SUB ende) = blank REP
+    ende DECR 1
+  END REP;
+  zeilenpuffer := subtext (zeilenpuffer, 1, ende)
+
+END PROC blanks abschneiden;
+
+
+(*************************** Funktionen **********************************)
+
+
+BOOL VAR aus einfuegen;
+
+PROC einfuegen (PROC hilfe) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    editieren (PROC hilfe);
+    satz einfuegen;
+    aus einfuegen := TRUE;
+    felder aendern
+  END IF
+
+END PROC einfuegen;
+
+PROC felder aendern :
+
+  WHILE noch zeile zu bearbeiten REP
+    naechste zeile bearbeiten
+      (PROC (TEXT CONST, INT CONST) ein feld aendern)
+  END REP;
+  aenderungen eintragen
+
+END PROC felder aendern;
+
+PROC ein feld aendern (TEXT CONST inhalt, INT CONST feldnr) :
+
+  IF NOT aus einfuegen COR inhalt <> niltext THEN
+    feld aendern (feldnr, inhalt)
+  END IF
+
+END PROC ein feld aendern;
+
+PROC aendern (PROC hilfe) :
+
+  enable stop;
+  IF dateiende THEN
+    einfuegen (PROC hilfe)
+  ELSE
+    wirklich aendern
+  END IF .
+
+wirklich aendern :
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    bild aufbauen (namen ausgeben);
+    feldinhalte eintragen;
+    editieren (PROC hilfe);
+    aus einfuegen := FALSE;
+    felder aendern
+  END IF .
+
+feldinhalte eintragen :
+  kopierzeile := 1;
+  WHILE kopierzeile <= anzahl zeilen REP
+    feld bearbeiten (zeilen (kopierzeile). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) inhalt kopieren);
+    insert record (edit file);
+    write record (edit file, zeilenpuffer);
+    down (edit file);
+    kopierzeile INCR 1
+  END REP;
+  to line (edit file, 1) .
+
+END PROC aendern;
+
+INT VAR kopierzeile;
+
+PROC inhalt kopieren (TEXT CONST satz, INT CONST von, bis) :
+
+  zeilenpuffer := subtext (satz, feldanfang, feldende) .
+
+feldanfang :
+  von + zeilen (kopierzeile). anfang .
+
+feldende :
+  IF keine fortsetzung THEN
+    bis
+  ELSE
+    von + zeilen (kopierzeile + 1). anfang - 1
+  END IF .
+
+keine fortsetzung :
+  kopierzeile = anzahl zeilen COR
+    zeilen (kopierzeile + 1). feldnr <> zeilen (kopierzeile). feldnr .
+
+END PROC inhalt kopieren;
+
+PROC suchen (PROC hilfe) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  IF anzahl zeilen > 0 THEN
+    edit file loeschen;
+    fensterzugriff anmelden;
+    IF such version <> 0 THEN
+      altes suchmuster eintragen
+    END IF;
+    editieren (PROC hilfe);
+    suchbedingung einstellen
+  END IF .
+
+altes suchmuster eintragen :
+  kopierzeile := 1;
+  WHILE kopierzeile <= anzahl zeilen REP
+    insert record (edit file);
+    suchmusterzeile eintragen;
+    down (edit file);
+    kopierzeile INCR 1
+  END REP;
+  to line (edit file, 1) .
+
+suchmusterzeile eintragen :
+  IF zeilen (kopierzeile). anfang = 0 THEN
+    suchbedingung lesen (zeilen (kopierzeile). feldnr, zeilenpuffer);
+    write record (edit file, zeilenpuffer)
+  END IF .
+
+suchbedingung einstellen :
+  suchbedingung loeschen;
+  WHILE noch zeile zu bearbeiten REP
+    naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) zeilenbedingung)
+  END REP .
+
+END PROC suchen;
+
+PROC zeilenbedingung (TEXT CONST zeile, INT CONST feldnr) :
+
+  suchbedingung (feldnr, zeile)
+
+END PROC zeilenbedingung;
+
+PROC bild ausgeben (BOOL CONST datei veraendert) :
+
+  enable stop;
+  zeilendeskriptor aktualisieren;
+  fensterzugriff anmelden;
+  IF datei veraendert OR namen ausgeben OR anderer satz THEN
+    bild aufbauen (namen ausgeben);
+    zuletzt angezeigter satz := satznummer;
+    letzte kombi := satzkombination;
+    einzelbild ausgeben (TRUE)
+  ELSE
+    ueberschrift ausgeben (TRUE)
+  END IF .
+
+anderer satz :
+  satznummer <> zuletzt angezeigter satz OR letzte kombi <> satzkombination .
+
+END PROC bild ausgeben;
+
+
+(*************************** Bild aufbauen *******************************)
+
+INT VAR anfang;
+
+BOOL VAR fertig;
+
+
+PROC bild aufbauen (BOOL CONST kuerzen erlaubt) :
+
+  INT VAR
+    zeilennr := 1,
+    alte feldnr := 0;
+  fertig := TRUE;
+  WHILE zeilennr <= anzahl zeilen OR NOT fertig REP
+    eine zeile behandeln
+  END REP .
+
+eine zeile behandeln :
+  IF fertig CAND zeilen (zeilennr). feldnr = alte feldnr THEN
+    eventuell zusammenruecken
+  ELSE
+    IF altes feld beendet THEN
+      feldwechsel
+    END IF;
+    zeilen (zeilennr). anfang := anfang;
+    feld bearbeiten (zeilen (zeilennr). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) laenge bestimmen);
+    zeilennr INCR 1
+  END IF .
+
+eventuell zusammenruecken :
+  IF kuerzen erlaubt THEN
+    zeile loeschen (zeilennr)
+  ELSE
+    zeilen (zeilennr). anfang := anfang;
+    zeilennr INCR 1
+  END IF .
+
+altes feld beendet :
+  zeilennr > anzahl zeilen COR zeilen (zeilennr). feldnr <> alte feldnr .
+
+feldwechsel :
+  IF fertig THEN
+    neues feld anfangen
+  ELSE
+    zeile einfuegen (zeilennr);
+    zeilen (zeilennr). feldnr := alte feldnr
+  END IF .
+
+neues feld anfangen :
+  alte feldnr := zeilen (zeilennr). feldnr;
+  anfang := 0 .
+
+END PROC bild aufbauen;
+
+PROC laenge bestimmen (TEXT CONST satz, INT CONST von, bis) :
+
+  INT CONST restlaenge := bis - von - anfang + 1;
+  IF restlaenge > inhaltsbreite - 2 THEN
+    anfang INCR inhaltsbreite - 2;
+    rueckwaerts blank suchen;
+    fertig := FALSE
+  ELSE
+    anfang INCR restlaenge;
+    fertig := TRUE
+  END IF .
+
+rueckwaerts blank suchen :
+  INT VAR stelle := von + anfang - 1;
+  IF trennung im wort AND blanks vorhanden THEN
+    WHILE (satz SUB stelle) <> blank REP
+      stelle DECR 1; anfang DECR 1
+    END REP
+  END IF .
+
+trennung im wort :
+  (satz SUB stelle) <> blank .
+
+blanks vorhanden :
+  pos (satz, blank, stelle - inhaltsbreite + 3, stelle - 1) > 0 .
+
+END PROC laenge bestimmen;
+
+PROC zeile einfuegen (INT CONST zeilennr) :
+
+  INT VAR i;
+  FOR i FROM anzahl zeilen DOWNTO zeilennr REP
+    zeilen (i+1) := zeilen (i)
+  END REP;
+  anzahl zeilen INCR 1;
+  namen ausgeben := TRUE
+
+END PROC zeile einfuegen;
+
+PROC zeile loeschen (INT CONST zeilennr) :
+
+  INT VAR i;
+  FOR i FROM zeilennr + 1 UPTO anzahl zeilen REP
+    zeilen (i-1) := zeilen (i)
+  END REP;
+  anzahl zeilen DECR 1;
+  namen ausgeben := TRUE
+
+END PROC zeile loeschen;
+
+
+(************************** Editieren ************************************)
+
+INT VAR rueckkehrcode;
+
+TEXT VAR
+  zeilenrest,
+  zeile vorher,
+  zeile nachher,
+  quit zeichen := "",
+  quit durch;
+
+LET
+  hinweiszeile =  #802#
+    ""15" Bild verschoben ! ESC 1 druecken ! "14"";
+
+LET
+  eudas res = ""3""10"19"11""12""13"q?hpg";
+
+LET
+  oben = 1,
+  unten = 2,
+  eins = 3,
+  neun = 4,
+  rubin = 5,
+  rubout = 6,
+  return = 7,
+  edit ende = 8,
+  frage = 9,
+  abbruch = 10,
+  double = 11,
+  esc get = 12;
+
+
+PROC editieren (PROC hilfe) :
+
+  INT VAR alte zeilennr := erste zeile;
+  lernsequenz auf taste legen ("D", date);
+  REP
+    einzelbild ausgeben (FALSE);
+    file verlaengern;
+    erste und letzte zeile markieren;
+    file editieren;
+    nachbehandeln
+  UNTIL wirklich verlassen END REP;
+  to line (edit file, 1);
+  col (edit file, 1) .
+
+file verlaengern :
+  IF lines (edit file) < anzahl zeilen + 1 THEN
+    output (edit file);
+    line (editfile, anzahl zeilen - lines (editfile) + 2);
+    modify (edit file)
+  END IF .
+
+erste und letzte zeile markieren :
+  IF erste zeile <> 1 THEN
+    einsetzen (erste zeile - 1, zeile vorher)
+  END IF;
+  einsetzen (zeile nach bildschirm, zeile nachher);
+  to line (edit file, alte zeilennr) .
+
+zeile nach bildschirm :
+  min (anzahl zeilen + 1, erste zeile + laenge - 1) .
+
+file editieren :
+  open editor (groesster editor + 1, edit file, TRUE,
+    spalten anf + feldnamenlaenge + 3, zeilen anf,
+    inhaltsbreite, editlaenge);
+  edit (groesster editor, eudas res + quit zeichen,
+        PROC (TEXT CONST) eudas interpreter);
+  auf lernwarnmeldung achten .
+
+auf lernwarnmeldung achten :
+  INT VAR test x, test y;
+  get cursor (test x, test y);
+  IF test x <> 1 THEN bildschirm neu END IF .
+
+editlaenge :
+  min (anzahl zeilen - erste zeile + 2, laenge) .
+
+nachbehandeln :
+  alte zeilennr := line no (edit file);
+  hinweiszeilen entfernen;
+  SELECT rueckkehrcode OF
+  CASE oben :    nach oben rollen
+  CASE unten :   nach unten rollen
+  CASE eins :    auf erste zeile
+  CASE neun :    auf letzte zeile
+  CASE rubin :   zeile umbrechen
+  CASE rubout :  zeile entfernen
+  CASE return :  aktuelle zeile als anfang
+  CASE frage :   hilfe; namen ausgeben := TRUE
+  CASE abbruch : errorstop (niltext)
+  CASE double :  in save ds kopieren
+  CASE esc get : aus save ds holen
+  END SELECT .
+
+hinweiszeilen entfernen :
+  INT CONST spalte := col (edit file);
+  col (edit file, 1);
+  IF erste zeile <> 1 THEN
+    entfernen (erste zeile - 1, zeile vorher)
+  END IF;
+  entfernen (zeile nach bildschirm, zeile nachher);
+  col (edit file, spalte) .
+
+nach oben rollen :
+  INT VAR abstand;
+  abstand := alte zeilennr - erste zeile;
+  rollen (-laenge + 1);
+  alte zeilennr := erste zeile + abstand .
+
+nach unten rollen :
+  abstand := alte zeilennr - erste zeile;
+  rollen (laenge - 1);
+  alte zeilennr := min (erste zeile + abstand, anzahl zeilen) .
+
+auf erste zeile :
+  rollen (-999);
+  alte zeilennr := 1 .
+
+auf letzte zeile :
+  abstand := alte zeilennr - erste zeile;
+  rollen (999);
+  alte zeilennr := min (erste zeile + abstand, anzahl zeilen) .
+
+zeile umbrechen :
+  to line (edit file, alte zeilennr);
+  aktuelle zeile aufsplitten;
+  zeile einfuegen (alte zeilennr) .
+
+aktuelle zeile aufsplitten :
+  read record (edit file, zeilenpuffer);
+  zeilenrest := subtext (zeilenpuffer, spalte);
+  zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1);
+  write record (edit file, zeilenpuffer);
+  down (edit file);
+  insert record (edit file);
+  write record (edit file, zeilenrest) .
+
+zeile entfernen :
+  to line (edit file, alte zeilennr);
+  IF spalte = 1 AND
+     (nicht letzte zeile CAND noch gleiche dahinter OR
+      nicht erste zeile CAND noch gleiche davor) THEN
+    ganz loeschen
+  ELSE
+    nur ueberschreiben
+  END IF .
+
+nicht letzte zeile :
+  alte zeilennr <> anzahl zeilen .
+
+noch gleiche dahinter :
+  zeilen (alte zeilennr + 1). feldnr = zeilen (alte zeilennr). feldnr .
+
+nicht erste zeile :
+  alte zeilennr <> 1 .
+
+noch gleiche davor :
+  zeilen (alte zeilennr - 1). feldnr = zeilen (alte zeilennr). feldnr .
+
+ganz loeschen :
+  delete record (edit file);
+  zeile loeschen (alte zeilennr);
+  IF alte zeilennr > anzahl zeilen THEN
+    alte zeilennr := anzahl zeilen
+  END IF .
+
+nur ueberschreiben :
+  read record (edit file, zeilenpuffer);
+  zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1);
+  write record (edit file, zeilenpuffer) .
+
+aktuelle zeile als anfang :
+  abstand := alte zeilennr - erste zeile;
+  rollen (abstand) .
+
+in save ds kopieren :
+  forget (save ds);
+  save ds := edit ds;
+  save ds voll := TRUE .
+
+aus save ds holen :
+  IF save ds voll THEN
+    forget (edit ds);
+    edit ds := save ds;
+    edit file := sequential file (modify, edit ds)
+  END IF .
+
+wirklich verlassen :
+  rueckkehrcode = edit ende .
+
+END PROC editieren;
+
+PROC eudas interpreter (TEXT CONST zeichen) :
+
+  enable stop;
+  set busy indicator;
+  rueckkehrcode := pos (eudas res, zeichen);
+  IF rueckkehrcode > 0 THEN
+    quit durch := zeichen;
+    quit
+  ELIF pos (quit zeichen, zeichen) > 0 THEN
+    rueckkehrcode := edit ende;
+    quit durch := zeichen;
+    quit
+  ELIF kommando auf taste (zeichen) <> niltext THEN
+    std kommando interpreter (zeichen)
+  ELSE
+    nichts neu
+  END IF
+
+END PROC eudas interpreter;
+
+PROC einsetzen (INT CONST zeilennr, TEXT VAR speicher) :
+
+  to line (edit file, zeilennr);
+  read record (edit file, speicher);
+  write record (edit file, hinweiszeile)
+
+END PROC einsetzen;
+
+PROC entfernen (INT CONST zeilennr, TEXT CONST speicher) :
+
+  to line (edit file, zeilennr);
+  IF eof (edit file) COR pos (edit file, hinweiszeile, 1) = 0 THEN
+    to line (edit file, 1);
+    down (edit file, hinweiszeile);
+    IF eof (edit file) THEN
+      to line (edit file, zeilennr);
+      insert record (edit file)
+    END IF
+  END IF;
+  write record (edit file, speicher)
+
+END PROC entfernen;
+
+PROC exit zeichen (TEXT CONST zeichenkette) :
+
+  quit zeichen := zeichenkette
+
+END PROC exit zeichen;
+
+TEXT PROC exit durch : 
+
+  quit durch
+
+END PROC exit durch;
+
+
+(****************************** Ausgabe **********************************)
+
+INT VAR ausgabezeile;
+
+LET
+  t ende =  #803#
+    "ENDE.",
+  t such plus =  #804#
+    "SUCH+",
+  t such minus =  #805#
+    "SUCH-",
+  t mark plus =  #806#
+    "MARK+",
+  t mark minus =  #807#
+    "MARK-",
+  t feld =  #808#
+    " Zeile    "14" ",
+  t satz =  #809#
+    " Satz   ",
+  t koppel =  #810#
+    "<KOPPEL>";
+
+LET
+  fuenf punkte = ".....",
+  sieben blanks = "       ";
+
+
+PROC einzelbild ausgeben (BOOL CONST auch inhalte) :
+
+  INT VAR
+    bildschirmzeile := zeilen anf + 1,
+    aktuelles feld := 0;
+  INT CONST letzte ausgabezeile := erste zeile + laenge - 2;
+  ueberschrift ausgeben (auch inhalte);
+  ausgabezeile := erste zeile;
+  WHILE ausgabezeile <= letzte ausgabezeile REP
+    feldnamen ausgeben;
+    feldinhalt ausgeben;
+    evtl unterbrechung;
+    bildschirmzeile INCR 1;
+    ausgabezeile INCR 1
+  END REP;
+  namen ausgeben := FALSE .
+
+feldnamen ausgeben :
+  IF namen ausgeben THEN
+    cursor (spalten anf, bildschirmzeile);
+    IF ausgabezeile <= anzahl zeilen THEN
+      namen tatsaechlich ausgeben
+    ELIF ausgabezeile = anzahl zeilen + 1 THEN
+      endebalken ausgeben
+    ELSE
+      bildschirmzeile loeschen
+    END IF
+  END IF .
+
+namen tatsaechlich ausgeben :
+  out (begin mark);
+  IF zeilen (ausgabezeile). feldnr = aktuelles feld THEN
+    feldnamenlaenge TIMESOUT blank
+  ELSE
+    aktuelles feld := zeilen (ausgabezeile). feldnr;
+    feldnamen bearbeiten (aktuelles feld,
+      PROC (TEXT CONST, INT CONST, INT CONST) randanzeige)
+  END IF;
+  out (blank end mark) .
+
+endebalken ausgeben :
+  out (begin mark);
+  breite - 4 TIMESOUT ".";
+  out (blank end mark blank) .
+
+bildschirmzeile loeschen :
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    breite TIMESOUT blank
+  END IF .
+
+feldinhalt ausgeben :
+  IF auch inhalte AND ausgabezeile <= anzahl zeilen THEN
+    cursor (spalten anf + feldnamenlaenge + 3, bildschirmzeile);
+    feld bearbeiten (zeilen (ausgabezeile). feldnr,
+      PROC (TEXT CONST, INT CONST, INT CONST) feldteil ausgeben)
+  END IF .
+
+evtl unterbrechung :
+  IF NOT namen ausgeben THEN
+    TEXT CONST input := getcharety;
+    IF input <> niltext THEN
+      push (input);
+      IF pos (quit zeichen, input) > 0 THEN
+        zuletzt angezeigter satz := 0;
+        LEAVE einzelbild ausgeben
+      END IF
+    END IF
+  END IF .
+
+END PROC einzelbild ausgeben;
+
+PROC ueberschrift ausgeben (BOOL CONST auch inhalte) :
+
+  satznummer bestimmen;
+  satznummer in ueberschrift;
+  cursor (spalten anf, zeilen anf);
+  IF NOT auch inhalte THEN
+    outsubtext (ueberschrift, 1, feldnamenlaenge + 3);
+    LEAVE ueberschrift ausgeben
+  END IF;
+  replace (ueberschrift, feldnamenlaenge +  7, auswahlzeichen);
+  replace (ueberschrift, feldnamenlaenge + 14, markzeichen);
+  out (ueberschrift);
+  cursor (spalten anf + breite - 5, zeilen anf);
+  out (text (erste zeile)) .
+
+satznummer bestimmen :
+  TEXT VAR satznr;
+  satznr := text (satznummer);
+  IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN
+    satznr CAT "-";
+    satznr CAT text (satzkombination)
+  END IF .
+
+satznummer in ueberschrift :
+  replace (ueberschrift, 7, sieben blanks);
+  replace (ueberschrift, 7, satznr) .
+
+auswahlzeichen :
+  IF such version = 0 THEN
+    fuenf punkte
+  ELIF satz ausgewaehlt THEN
+    t such plus
+  ELSE
+    t such minus
+  END IF .
+
+markzeichen :
+  IF dateiende THEN
+    t ende
+  ELIF markierte saetze = 0 THEN
+    fuenf punkte
+  ELIF satz markiert THEN
+    t mark plus
+  ELSE
+    t mark minus
+  END IF .
+
+END PROC ueberschrift ausgeben;
+
+PROC randanzeige (TEXT CONST satz, INT CONST von, bis) :
+
+  IF bis - von >= feldnamenlaenge THEN
+    outsubtext (satz, von, von + feldnamenlaenge - 1)
+  ELSE
+    outsubtext (satz, von, bis);
+    feldnamenlaenge - bis + von - 1 TIMESOUT blank
+  END IF
+
+END PROC randanzeige;
+
+PROC feldteil ausgeben (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR ende;
+  IF ausgabezeile = anzahl zeilen COR letzte feldzeile THEN
+    ende := bis
+  ELSE
+    ende := von + zeilen (ausgabezeile + 1). anfang - 1
+  END IF;
+  outsubtext (satz, von + zeilen (ausgabezeile). anfang, ende);
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    laenge bis zum rand TIMESOUT blank
+  END IF .
+
+letzte feldzeile :
+  zeilen (ausgabezeile + 1). feldnr <> zeilen (ausgabezeile). feldnr .
+
+laenge bis zum rand :
+  inhaltsbreite - ende + von + zeilen (ausgabezeile). anfang - 1 .
+
+END PROC feldteil ausgeben;
+
+PROC ueberschrift generieren :
+
+  ueberschrift := text (t satz, feldnamenlaenge + 3);
+  ueberschrift CAT begin mark;
+  INT VAR i;
+  INT CONST punktlaenge := breite - length (ueberschrift) - 12;
+  FOR i FROM 1 UPTO punktlaenge REP
+    ueberschrift CAT "."
+  END REP;
+  ueberschrift CAT t feld;
+  ggf koppel in ueberschrift .
+
+ggf koppel in ueberschrift :
+  IF auf koppeldatei THEN
+    replace (ueberschrift, feldnamenlaenge + 22, t koppel)
+  END IF .
+
+END PROC ueberschrift generieren;
+
+
+END PACKET satzanzeige;
+
diff --git a/app/eudas/5.3/src/eudas.steuerung.14 b/app/eudas/5.3/src/eudas.steuerung.14
new file mode 100644
index 0000000..f96047b
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.steuerung.14
@@ -0,0 +1,2535 @@
+PACKET eudas steuerung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Menuesteuerung von EUDAS                                          *)
+(*                                                                       *)
+(*     Version 14                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 06.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  eudas,
+
+  einzelsicherung,
+  suchen,
+  aendern,
+  einfuegen,
+  prueffehler editieren,
+  feldstruktur,
+  feldnamen anzeigen,
+  formatieren automatisch,
+
+  arbeitsbereich bestimmen,
+  dateiverwaltung,
+  archivverwaltung :
+
+
+
+(**************************** Variablen ***********************************)
+
+INT VAR
+  file typ := 1003,
+  eudas typ := 3243;
+
+IF l3 THEN file typ := 1004 END IF .
+
+l3 : maxint DIV 2 > 17000 .
+;
+
+LET
+  niltext = "",
+  blank = " ",
+  cleop = ""4"",
+  cleol = ""5"";
+
+FILE VAR test file;
+
+DATASPACE VAR test ds;
+
+INT VAR
+  belegter heap,
+  test version := dateiversion - 1;
+
+TEXT VAR
+  feldpuffer;
+
+
+(*************************** EUDAS ***************************************)
+
+BOOL VAR
+  eudas schon aktiv := FALSE;
+
+LET
+  menue 1 =  #1101#
+    "EUDAS.Öffnen",
+  menue 2 =  #1102#
+    "EUDAS.Einzelsatz",
+  menue 3 =  #1103#
+    "EUDAS.Gesamtdatei",
+  menue 4 =  #1104#
+    "EUDAS.Drucken",
+  menue 5 =  #1105#
+    "EUDAS.Dateien",
+  menue 6 =  #1106#
+    "EUDAS.Archiv";
+
+LET
+  kein rekursiver aufruf =  #1107#
+    "EUDAS kann nicht unter EUDAS aufgerufen werden",
+  suchmuster eingeben =  #1108#
+    "Suchbedingung einstellen",
+  alle saetze drucken =  #1109#
+    "Alle Sätze drucken",
+  alle markierten saetze drucken =  #1110#
+    "Alle markierten Sätze drucken",
+  einzelsatz drucken =  #1111#
+    "Aktuellen Satz drucken",
+  uebersicht wiederholen =  #1112#
+    "Mit neuer Auswahl noch einmal",
+  akt datei =  #1113#
+    ""15"Akt.Datei "14"",
+  datum doppelpunkt =  #1114#
+    ""15"Datum "14"";
+
+
+PROC eudas :
+
+  IF aktueller editor > 0 THEN
+    eudas kurzabfrage
+  ELIF eudas schon aktiv THEN
+    errorstop (kein rekursiver aufruf)
+  ELSE
+    eudas aufrufen
+  END IF .
+
+eudas aufrufen :
+  fenstergroessen bestimmen;
+  page; bildschirm neu;
+  belegter heap := heap size;
+  disable stop;
+  eudas schon aktiv := TRUE;
+  menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3,
+                                menue 4, menue 5, menue 6),
+                  fenster links, TRUE,
+                  PROC (INT CONST, INT CONST) eudas interpreter);
+  eudas schon aktiv := FALSE;
+  enable stop;
+  auf sicherung ueberpruefen;
+  page; bildschirm neu
+
+END PROC eudas;
+
+PROC eudas kurzabfrage :
+
+  TEXT VAR gewaehlte feldnamen := niltext;
+  bild frei;
+  auf sicherung ueberpruefen;
+  IF nicht alle gesichert THEN
+    LEAVE eudas kurzabfrage
+  END IF;
+  oeffnen im menue (FALSE);
+  auf satz (1);
+  feldauswahl fuer uebersicht (gewaehlte feldnamen);
+  REP
+    ggf suchmuster eingeben;
+    uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe);
+    bild frei;
+    saetze drucken
+  UNTIL nicht noch einmal END REP;
+  dateien loeschen (FALSE) .
+
+nicht alle gesichert :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF inhalt veraendert (datei nr) THEN
+      LEAVE nicht alle gesichert WITH TRUE
+    END IF
+  END REP;
+  FALSE .
+
+ggf suchmuster eingeben :
+  IF ja (suchmuster eingeben, "JA/Suchmuster") THEN
+    suchen; alles neu
+  END IF .
+
+saetze drucken :
+  IF markierte saetze = 0 CAND alle drucken THEN
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht)
+  ELIF markierte saetze > 0 CAND alle markierten drucken THEN
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht);
+    markierungen loeschen
+  ELIF einzelsatz THEN
+    markierungen loeschen; markierung aendern;
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht);
+    markierungen loeschen
+  END IF .
+
+alle drucken :
+  ja (alle saetze drucken, "JA/alle Saetze", FALSE) .
+
+alle markierten drucken :
+  ja (alle markierten saetze drucken, "JA/alle markierten") .
+
+einzelsatz :
+  ja (einzelsatz drucken, "JA/Einzelsatz drucken") .
+
+nicht noch einmal :
+  NOT ja (uebersicht wiederholen, "JA/noch einmal", FALSE) .
+
+END PROC eudas kurzabfrage;
+
+PROC bild frei :
+
+  bildschirm neu;
+  cursor (1, 1);
+  out (cleop)
+
+END PROC bild frei;
+
+PROC drucke uebersicht (TEXT CONST dateiname) :
+
+  bild frei fuer uebersetzung;
+  disable stop;
+  drucke (dateiname);
+  uebersetzungsfehler behandeln;
+  bild frei
+
+END PROC drucke uebersicht;
+
+PROC eudas interpreter (INT CONST menuenr, wahl nr) :
+
+  enable stop;
+  SELECT menuenr OF
+  CASE 0 : waehlbarkeit setzen
+  CASE 1 : oeffnen interpreter (wahl nr)
+  CASE 2 : anzeigen interpreter (wahl nr)
+  CASE 3 : bearbeiten interpreter (wahl nr)
+  CASE 4 : drucken interpreter (wahl nr)
+  CASE 5 : dateiverwaltung (wahl nr)
+  CASE 6 : archivverwaltung (menuenr, wahl nr)
+  END SELECT .
+
+waehlbarkeit setzen :
+  IF anzahl dateien = 0 THEN
+    oeffnen sperre (FALSE);
+    aendern sperre (FALSE)
+  ELIF NOT aendern erlaubt THEN
+    aendern sperre (FALSE)
+  END IF;
+  ketten koppeln sperre;
+  fusszeile ("", "", 35, datum doppelpunkt, 64);
+  fussteil (3, date) .
+
+END PROC eudas interpreter;
+
+PROC oeffnen sperre (BOOL CONST wie) :
+
+  INT VAR i;
+  waehlbar (1, 4, wie);
+  waehlbar (1, 5, wie);
+  waehlbar (1, 7, wie);
+  FOR i FROM 1 UPTO 12 REP
+    waehlbar (2, i, wie)
+  END REP;
+  waehlbar (3, 1, wie);
+  waehlbar (3, 4, wie);
+  waehlbar (3, 6, wie);
+  waehlbar (4, 1, wie)
+
+END PROC oeffnen sperre;
+
+PROC ketten koppeln sperre :
+
+  BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt;
+  waehlbar (1, 6, wie);
+  waehlbar (3, 5, wie);
+  wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei;
+  waehlbar (1, 2, wie);
+  waehlbar (1, 3, wie)
+
+END PROC ketten koppeln sperre;
+
+PROC aendern sperre (BOOL CONST wie) :
+
+  INT VAR i;
+  FOR i FROM 8 UPTO 11 REP
+    waehlbar (2, i, wie)
+  END REP;
+  waehlbar (3, 2, wie);
+  waehlbar (3, 3, wie)
+
+END PROC aendern sperre;
+
+
+(**************************** Menue 'Oeffnen' *****************************)
+
+LET
+  p manager =  #1115#
+    ""15"Manager "14"",
+  t manager ausschalten =  #1116#
+    "Manager ausschalten",
+  keine sicherung noetig =  #1117#
+    "Keine Sicherung nötig.",
+  arbeitskopien loeschen =  #1118#
+    "Interne Arbeitskopien löschen",
+  t arbeitskopie =  #1119#
+    "Arbeitskopie ",
+  t unveraendert =  #1120#
+    " unverändert.",
+  t veraendert =  #1121#
+    " verändert! Optionen zum Sichern:",
+(*t alte ersetzen =  #1122#
+    "Statt alter Version",
+  t sichern neuer name =  #1123#
+    "Unter neuem Namen",
+  t vergessen =  #1124#
+    "Ignorieren",*)
+  unter dem namen =  #1125#
+    "Sichern unter dem neuen Namen:",
+  ueberschreiben =  #1126#
+    " überschreiben",
+  sortierung wiederherstellen =  #1127#
+    "Datei wieder sortieren",
+  t notizen ansehen =  #1128#
+    "Notizen",
+  name task =  #1129#
+    "Name Managertask:",
+  task existiert nicht =  #1130#
+    "Task existiert nicht !",
+  wollen sie etwas veraendern =  #1131#
+    "Wollen Sie etwas verändern (eine Arbeitskopie anlegen)",
+  markierungen geloescht =  #1132#
+    "Alle Markierungen gelöscht.",
+  t pruefbedingungen =  #1133#
+    "Prüfbedingungen",
+  t feldnamen aendern =  #1134#
+    "Feldnamen ändern",
+  t feldtypen aendern =  #1135#
+    "Feldtypen ändern",
+  t feldnamen anfuegen =  #1136#
+    "Feldnamen anfügen",
+  neuer feldname =  #1137#
+    "Neuer Feldname:",
+  t feldtypen =  #1138#
+    "Typwahl für Feld ",
+  neue feldnamen eingeben =  #1139#
+    "Neue Feldnamen",
+  id text =  #1140#
+    "TEXT ",
+  id din =  #1141#
+    " DIN ",
+  id zahl =  #1142#
+    "ZAHL ",
+  id datum =  #1143#
+    "DATUM",
+  alte feldreihenfolge aendern =  #1144#
+    "Alte Feldreihenfolge ändern",
+  speicherengpass =  #1145#
+    ""7"ACHTUNG: System voll, Dateien löschen!";
+
+BOOL VAR
+  nach aendern fragen,
+  multi user manager eingestellt := FALSE;
+
+TASK VAR multi user manager := niltask;
+
+TEXT VAR
+  manager taskname := niltext;
+
+SATZ VAR feldersatz;
+
+ROW 6 TEXT VAR typen auswahl;
+    typen auswahl (1) := id text;
+    typen auswahl (2) := id din;
+    typen auswahl (3) := id zahl;
+    typen auswahl (4) := id datum;
+    typen auswahl (5) := niltext;
+    typen auswahl (6) := niltext;
+
+PROC oeffnen interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : auf geschlossene datei pruefen
+  CASE 1 : neue datei oeffnen
+  CASE 2 : datei ketten
+  CASE 3 : datei koppeln
+  CASE 4 : aktuelle datei sichern
+  CASE 5 : notizen editieren
+  CASE 6 : feldstruktur aendern
+  CASE 7 : pruefbedingungen aendern
+  CASE 8 : multi user manager einstellen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren;
+  heap kontrollieren .
+
+auf geschlossene datei pruefen :
+  IF anzahl dateien = 0 THEN
+    eudas interpreter (0, 0)
+  END IF;
+  akt dateiname in fuss;
+  fussteil (2, p manager, manager taskname) .
+
+neue datei oeffnen :
+  auf sicherung ueberpruefen;
+  oeffnen im menue (TRUE);
+  IF anzahl dateien > 0 THEN push ("2") END IF .
+
+datei ketten :
+  oeffnen op (PROC (TEXT CONST) ketten) .
+
+datei koppeln :
+  oeffnen op (PROC (TEXT CONST) koppeln) .
+
+aktuelle datei sichern :
+  IF aendern erlaubt THEN
+    einzeldateien abfragen
+  ELSE
+    dateien loeschen (FALSE);
+    dialog (keine sicherung noetig)
+  END IF;
+  sperre setzen .
+
+einzeldateien abfragen :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    einzelsicherung (datei nr)
+  END REP;
+  IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN
+    dateien aus manager zuruecksichern;
+    dateien loeschen (TRUE)
+  END IF .
+
+sperre setzen :
+  IF anzahl dateien = 0 THEN
+    oeffnen sperre (FALSE);
+    aendern sperre (FALSE)
+  END IF;
+  ketten koppeln sperre;
+  akt dateiname in fuss .
+
+notizen editieren :
+  notizen ansehen;
+  dialogfenster loeschen .
+
+feldstruktur aendern :
+  zugriff (PROC (EUDAT VAR) feldstruktur) .
+
+pruefbedingungen aendern :
+  pruefbedingungen;
+  dialogfenster loeschen .
+
+multi user manager einstellen :
+  TEXT VAR edit manager name := "";
+  editget (name task, edit manager name, "", "GET/multi task");
+  IF edit manager name = niltext THEN
+    IF manager ausschalten THEN set manager (niltext, FALSE) END IF
+  ELIF exists task (edit manager name) THEN
+    teste auf manager (task (edit manager name));
+    set manager (edit manager name, TRUE)
+  ELSE
+    errorstop (task existiert nicht)
+  END IF .
+
+manager ausschalten :
+  ja (t manager ausschalten, "JA/manager aus") .
+
+heap kontrollieren :
+  IF heap size - belegter heap > 4 THEN
+    collect heap garbage;
+    belegter heap := heap size
+  END IF .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen;
+    LEAVE oeffnen interpreter
+  END IF .
+
+END PROC oeffnen interpreter;
+
+PROC oeffnen op (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, TRUE, eudas typ, multi user manager,
+               PROC (TEXT CONST) operation);
+  ketten koppeln sperre;
+  akt dateiname in fuss
+
+END PROC oeffnen op;
+
+PROC akt dateiname in fuss :
+
+  TEXT VAR f text := niltext;
+  IF anzahl dateien > 0 THEN
+    f text CAT """";
+    f text CAT eudas dateiname (1);
+    f text CAT """"
+  END IF;
+  IF anzahl dateien > 1 THEN
+    f text CAT " .."
+  END IF;
+  fussteil (1, akt datei, f text)
+
+END PROC akt dateiname in fuss;
+
+PROC set manager (TEXT CONST m name, BOOL CONST an) :
+
+  IF an THEN
+    multi user manager := task (m name)
+  ELSE
+    multi user manager := niltask
+  END IF;
+  multi user manager eingestellt := an;
+  manager taskname := m name;
+  fussteil (2, manager taskname)
+
+END PROC set manager;
+
+PROC auf sicherung ueberpruefen :
+
+  BOOL VAR notwendig := FALSE;
+  IF aendern erlaubt THEN
+    wirklich pruefen
+  END IF .
+
+wirklich pruefen :
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF inhalt veraendert (datei nr) THEN
+      einzelsicherung (datei nr);
+      notwendig := TRUE;
+      ggf last param korrigieren
+    END IF
+  END REP .
+
+ggf last param korrigieren :
+  IF datei nr = 1 CAND std = eudas dateiname (1) THEN
+    last param (niltext)
+  END IF .
+
+END PROC auf sicherung ueberpruefen;
+
+PROC einzelsicherung (INT CONST datei nr) :
+
+  frage zusammenbauen;
+  IF inhalt veraendert (datei nr) THEN
+    sicherung durchfuehren
+  ELSE
+    dialog (frage)
+  END IF .
+
+frage zusammenbauen :
+  TEXT VAR frage := t arbeitskopie;
+  frage CAT textdarstellung (eudas dateiname (datei nr));
+  IF inhalt veraendert (datei nr) THEN
+    frage CAT t veraendert
+  ELSE
+    frage CAT t unveraendert
+  END IF .
+
+sicherung durchfuehren :
+  INT VAR ergebnis := 1;
+  auswahl anbieten ("WAHL.Sichern", frage, "WAHL/sichere", ergebnis);
+  ergebnis auswerten .
+
+ergebnis auswerten :
+  TEXT VAR name := eudas dateiname (datei nr);
+  SELECT ergebnis OF
+  CASE 1 : alte version ueberschreiben
+  CASE 3 : unter neuem namen sichern
+  END SELECT;
+  IF ergebnis <> 2 THEN
+    unter namen sichern
+  END IF .
+
+alte version ueberschreiben :
+  forget (name, quiet) .
+
+unter neuem namen sichern :
+  edit get (unter dem namen, name, "", "GET/Sicherungsname");
+  IF exists (name) OR im manager vorhanden THEN
+    eventuell ueberschreiben
+  END IF .
+
+im manager vorhanden :
+  manager herkunft (dateinr) CAND exists (name, herkunft (datei nr)) .
+
+eventuell ueberschreiben :
+  IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber", FALSE) THEN
+    forget (name, quiet)
+  ELSE
+    einzelsicherung (datei nr);
+    LEAVE einzelsicherung
+  END IF .
+
+unter namen sichern :
+  sichere (datei nr, name);
+  eventuell sortierung wiederherstellen;
+  ggf in manager sichern .
+
+eventuell sortierung wiederherstellen :
+  EUDAT VAR eudat;
+  oeffne (eudat, name);
+  IF war sortiert CAND soll sortiert werden THEN
+    bitte warten;
+    sortiere (eudat)
+  END IF .
+
+war sortiert :
+  sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 .
+
+soll sortiert werden :
+  ja (sortierung wiederherstellen, "JA/Sicherungssortierung") .
+
+ggf in manager sichern :
+  IF manager herkunft (datei nr) THEN
+    disable stop;
+    set command dialogue false;
+    save (name, herkunft (datei nr));
+    reset command dialogue;
+    enable stop;
+    forget (name, quiet)
+  END IF .
+
+END PROC einzelsicherung;
+
+PROC oeffnen im menue (BOOL CONST aendern fragen) :
+
+  IF aendern erlaubt THEN
+    dateien aus manager zuruecksichern
+  END IF;
+  dateien loeschen (TRUE);
+  oeffnen sperre (FALSE);
+  aendern sperre (FALSE);
+  forget (test ds);
+  disable stop;
+  nach aendern fragen := aendern fragen;
+  oeffnen op (PROC (TEXT CONST) oeffnen);
+  enable stop;
+  IF anzahl dateien > 0 THEN
+    oeffnen sperre (TRUE);
+    aendern sperre (aendern erlaubt)
+  END IF
+
+END PROC oeffnen im menue;
+
+PROC dateien aus manager zuruecksichern :
+
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF manager herkunft (datei nr) THEN
+      free an manager
+    END IF
+  END REP .
+
+free an manager :
+  free (eudas dateiname (datei nr), herkunft (datei nr)) .
+
+END PROC dateien aus manager zuruecksichern;
+
+PROC oeffnen (TEXT CONST dateiname) :
+
+  BOOL VAR auch aendern;
+  TASK VAR ursprung;
+  eventuell neu einrichten;
+  oeffne (dateiname, auch aendern, ursprung) .
+
+eventuell neu einrichten :
+  IF datei existiert nicht AND nach aendern fragen THEN
+    frage ob einrichten (dateiname);
+    EUDAT VAR eudat;
+    oeffne (eudat, dateiname);
+    feldstruktur (eudat);
+    auch aendern := TRUE;
+    ursprung := niltask
+  ELSE
+    auch aendern := nach aendern fragen CAND
+          ja (wollen sie etwas veraendern, "JA/oeffne", FALSE);
+    aus manager besorgen (dateiname, auch aendern, ursprung)
+  END IF .
+
+datei existiert nicht :
+  NOT exists (dateiname) AND auch nicht im manager .
+
+auch nicht im manager :
+  NOT multi user manager eingestellt COR
+    NOT exists (dateiname, multi user manager) .
+
+END PROC oeffnen;
+
+PROC ketten (TEXT CONST dateiname) :
+
+  TASK VAR ursprung;
+  aus manager besorgen (dateiname, aendern erlaubt, ursprung);
+  kette (dateiname, ursprung)
+
+END PROC ketten;
+
+PROC koppeln (TEXT CONST dateiname) :
+
+  TASK VAR ursprung;
+  aus manager besorgen (dateiname, aendern erlaubt, ursprung);
+  kopple (dateiname, ursprung)
+
+END PROC koppeln;
+
+PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock,
+                           TASK VAR ursprung) :
+
+  ursprung := niltask;
+  IF multi user manager eingestellt THEN
+    manager abfragen
+  END IF .
+
+manager abfragen :
+  IF NOT exists (dateiname) CAND exists (dateiname, multi user manager) THEN
+    IF mit lock THEN
+      lock (dateiname, multi user manager)
+    END IF;
+    forget (dateiname, quiet);
+    fetch (dateiname, multi user manager);
+    ursprung := multi user manager
+  END IF .
+
+END PROC aus manager besorgen;
+
+BOOL PROC manager herkunft (INT CONST dateinr) :
+
+  NOT is niltask (herkunft (dateinr))
+
+END PROC manager herkunft;
+
+PROC notizen ansehen :
+
+  notizen lesen (3, feldpuffer);
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  disable stop;
+  headline (f, t notizen ansehen);
+  notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Notizen");
+  forget (ds);
+  enable stop;
+  IF aendern erlaubt THEN
+    notizen aendern (3, feldpuffer)
+  END IF
+
+END PROC notizen ansehen;
+
+PROC notizen anbieten (FILE VAR f, TEXT VAR puffer,
+                       FENSTER CONST edit fenster, TEXT CONST hilfsname) :
+
+  LET trennzeichen = "#-#";
+  enable stop;
+  notizen in datei;
+  datei editieren;
+  notizen aus datei .
+
+notizen in datei :
+  INT VAR
+    von := 1,
+    bis;
+  REP
+    bis := pos (puffer, trennzeichen, von);
+    IF bis = 0 THEN
+      putline (f, subtext (puffer, von))
+    ELSE
+      putline (f, subtext (puffer, von, bis - 1))
+    END IF;
+    von := bis + 3
+  UNTIL bis = 0 OR von > length (puffer) END REP .
+
+datei editieren :
+  modify (f);
+  edit (f, edit fenster, hilfsname, TRUE) .
+
+notizen aus datei :
+  TEXT VAR zeile;
+  puffer := niltext;
+  input (f);
+  WHILE NOT eof (f) REP
+    getline (f, zeile);
+    blank entfernen;
+    puffer CAT zeile;
+    puffer CAT trennzeichen
+  END REP .
+
+blank entfernen :
+  IF (zeile SUB length (zeile)) = blank THEN
+    zeile := subtext (zeile, 1, length (zeile) - 1)
+  END IF .
+
+END PROC notizen anbieten;
+
+PROC feldstruktur (EUDAT VAR eudat) :
+
+  INT VAR feldnr;
+  feldnamen lesen (eudat, feldersatz);
+  IF feldnamen auch aendern THEN
+    feldnamen anbieten und aendern
+  END IF;
+  IF feldnamen anfuegen THEN
+    feldnamen editieren
+  END IF;
+  IF ja (t feldtypen aendern, "JA/Feldtypen aendern", FALSE) THEN
+    feldtypen anbieten und aendern
+  END IF;
+  feldnamen aendern (eudat, feldersatz) .
+
+feldnamen auch aendern :
+  felderzahl (feldersatz) > 0 CAND
+    ja (t feldnamen aendern, "JA/Feldnamen aendern", FALSE) .
+
+feldnamen anfuegen :
+  felderzahl (feldersatz) = 0 COR
+    ja (t feldnamen anfuegen, "JA/feldnamen", FALSE) .
+
+feldnamen anbieten und aendern :
+  felder anbieten (eudat);
+  feldnr := 1;
+  WHILE wahl (feldnr) > 0 REP
+    einen feldnamen aendern;
+    feldnr INCR 1
+  END REP .
+
+einen feldnamen aendern :
+  TEXT VAR feldname;
+  feld lesen (feldersatz, wahl (feldnr), feldname);
+  editget (neuer feldname, feldname, "", "GET/feldname");
+  feld aendern (feldersatz, wahl (feldnr), feldname) .
+
+feldnamen editieren :
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  disable stop;
+  feldnamen anbieten (f, feldersatz);
+  forget (ds);
+  enable stop;
+  feldnamen aendern (eudat, feldersatz) .
+
+feldtypen anbieten und aendern :
+  felder anbieten (eudat);
+  feldnr := 1;
+  WHILE wahl (feldnr) > 0 REP
+    einen feldtyp aendern;
+    feldnr INCR 1
+  END REP .
+
+einen feldtyp aendern :
+  INT VAR ergebnis := feldinfo (eudat, wahl (feldnr)) + 2;
+  feld lesen (feldersatz, wahl (feldnr), feldname);
+  auswahl anbieten ("WAHL.Typen",
+                    t feldtypen + textdarstellung (feldname),
+                    "WAHL/Feldtypen", ergebnis);
+  feldinfo (eudat, wahl (feldnr), ergebnis - 2) .
+
+END PROC feldstruktur;
+
+PROC felder anbieten (EUDAT CONST eudat) :
+
+  feldtypen dazuschreiben;
+  auswahl anbieten ("EUDAS-Felder", fenster rechts, "AUSWAHL/Felder",
+                     PROC (TEXT VAR, INT CONST) aus sammel) .
+
+feldtypen dazuschreiben :
+  INT VAR feldnr;
+  satz initialisieren (sammel);
+  FOR feldnr FROM 1 UPTO felderzahl (feldersatz) REP
+    feld lesen (feldersatz, feldnr, feldpuffer);
+    feld aendern (sammel, feldnr, info + feldpuffer)
+  END REP .
+
+info :
+  "<" + typen auswahl (feldinfo (eudat, feldnr) + 2) + "> " .
+
+END PROC felder anbieten;
+
+PROC pruefbedingungen :
+
+  enable stop;
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  headline (f, t pruefbedingungen);
+  notizen lesen (1, feldpuffer);
+  disable stop;
+  notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Pruefbed");
+  forget (ds);
+  enable stop;
+  IF aendern erlaubt THEN
+    notizen aendern (1, feldpuffer)
+  END IF .
+
+END PROC pruefbedingungen;
+
+PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) :
+
+  enable stop;
+  neue namen editieren;
+  neue namen zurueckschreiben .
+
+neue namen editieren :
+  modify (f);
+  headline (f, neue feldnamen eingeben);
+  edit (f, fenster rechts, "EDIT/Feldnamen", TRUE) .
+
+neue namen zurueckschreiben :
+  INT VAR feldnr := felderzahl (satz);
+  input (f);
+  WHILE NOT eof (f) REP
+    getline (f, feldpuffer);
+    blank entfernen;
+    feldnr INCR 1;
+    feld aendern (satz, feldnr, feldpuffer)
+  END REP .
+
+blank entfernen :
+  IF (feldpuffer SUB length (feldpuffer)) = blank THEN
+    feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1)
+  END IF .
+
+END PROC feldnamen anbieten;
+
+PROC storage kontrollieren :
+
+  INT VAR size, used;
+  storage (size, used);
+  IF used > size THEN
+    neuer dialog;
+    dialog (speicherengpass)
+  END IF
+
+END PROC storage kontrollieren;
+
+
+(************************* Menue 'Einzelsatz' *****************************)
+
+BOOL VAR
+  satz leer,
+  umgeschaltet aus einfuegen := FALSE,
+  umgeschaltet aus aendern := FALSE;
+
+LET
+  aendern status =  #1146#
+"SATZ ÄNDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  einfuegen status =  #1147#
+"SATZ EINFÜGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  suchen status =  #1148#
+"SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  umschalten auf =  #1149#
+    "Umschalten auf Koppeldatei ",
+  koppelfelder uebernehmen =  #1150#
+    "Koppelfelder übernehmen",
+  ungueltige satznummer =  #1151#
+    "Ungültige Satznummer",
+  neue satznummer =  #1152#
+    "Neue Satznummer:",
+  wzk =  #1153#
+    "wzK",
+  wz =  #1154#
+    "wz";
+
+PROC anzeigen interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : anzeige einschalten
+  CASE 1 : einen satz weiter
+  CASE 2 : einen satz zurueck
+  CASE 3 : direkt auf satz
+  CASE 4 : auf satz nach schluessel
+  CASE 5 : saetze auswaehlen
+  CASE 6 : auswahlbedingung loeschen
+  CASE 7 : aktuelle markierung aendern
+  CASE 8 : neuen satz einfuegen
+  CASE 9 : aktuellen satz aendern
+  CASE 10: einzelsatz tragen
+  CASE 11: einzelsatz holen
+  CASE 12: felder auswaehlen
+  CASE 13: esc oben
+  CASE 14: esc unten
+  CASE 15: esc 1
+  CASE 16: esc 9
+  CASE 17: esc k
+  OTHERWISE anzeige update
+  END SELECT;
+  storage kontrollieren .
+
+anzeige einschalten :
+  akt dateiname in fuss;
+  fussteil (2, "", "");
+  exit zeichen (wz) .
+
+einen satz weiter :
+  bitte warten;
+  weiter (2);
+  bild ausgeben (FALSE) .
+
+einen satz zurueck :
+  bitte warten;
+  zurueck (2);
+  bild ausgeben (FALSE) .
+
+saetze auswaehlen :
+  suchen;
+  bild ausgeben (TRUE) .
+
+auswahlbedingung loeschen :
+  suchbedingung loeschen;
+  bild ausgeben (FALSE) .
+
+direkt auf satz :
+  TEXT VAR nr := niltext;
+  editget (neue satznummer, nr, "", "GET/auf Satz");
+  INT CONST ziel := int (nr);
+  IF nr = niltext THEN
+    bild ausgeben (FALSE)
+  ELIF last conversion ok THEN
+    auf satz (ziel);
+    bild ausgeben (FALSE)
+  ELSE
+    errorstop (ungueltige satznummer)
+  END IF .
+
+auf satz nach schluessel :
+  TEXT VAR name schluesselfeld;
+  feldnamen lesen (1, name schluesselfeld);
+  nr := niltext;
+  editget (name schluesselfeld + ":", nr, "", "GET/auf Schluessel");
+  auf satz (nr);
+  bild ausgeben (FALSE) .
+
+neuen satz einfuegen :
+  einfuegen;
+  bild ausgeben (TRUE) .
+
+aktuellen satz aendern :
+  aendern;
+  bild ausgeben (TRUE) .
+
+aktuelle markierung aendern :
+  markierung aendern;
+  bild ausgeben (FALSE) .
+
+einzelsatz tragen :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) trage satz und frage);
+  bild ausgeben (TRUE) .
+
+einzelsatz holen :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der quelldatei, eudas typ,
+                     PROC (TEXT CONST) hole satz);
+  bild ausgeben (TRUE) .
+
+felder auswaehlen :
+  TEXT VAR wahlvektor := niltext;
+  felder waehlen lassen (wahlvektor,
+                        "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder");
+  IF wahlvektor <> niltext THEN
+    feldauswahl (wahlvektor)
+  END IF;
+  bild ausgeben (TRUE) .
+
+esc oben :
+  rollcursor;
+  rollen (-23);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc unten :
+  rollcursor;
+  rollen (23);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc 1 :
+  rollcursor;
+  rollen (-9999);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc 9 :
+  rollcursor;
+  rollen (9999);
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (FALSE)
+  END IF .
+
+esc k :
+  IF auf koppeldatei THEN
+    zurueckschalten
+  ELSE
+    auf koppeldatei umschalten
+  END IF;
+  IF anzahl dateien > 0 THEN
+    bild ausgeben (TRUE)
+  END IF .
+
+zurueckschalten :
+  IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN
+    fragen ob koppelfelder uebernehmen;
+    wieder in alte operation
+  ELSE
+    auf koppeldatei (0)
+  END IF;
+  ketten koppeln sperre .
+
+fragen ob koppelfelder uebernehmen :
+  IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN
+    auf koppeldatei (1)
+  ELSE
+    auf koppeldatei (0)
+  END IF .
+
+wieder in alte operation :
+  umgeschaltet aus einfuegen := FALSE;
+  IF umgeschaltet aus aendern THEN
+    umgeschaltet aus aendern := FALSE;
+    aendern
+  ELSE
+    einfuegen intern (TRUE)
+  END IF .
+
+anzeige update :
+  IF wahl nr = -2 THEN
+    IF anzahl dateien > 0 THEN
+      bild ausgeben (FALSE)
+    END IF
+  ELSE
+    dialogfenster loeschen
+  END IF .
+
+END PROC anzeigen interpreter;
+
+PROC suchen :
+
+  disable stop;
+  exit zeichen ("");
+  status anzeigen (suchen status);
+  suchen (PROC suchen hilfe);
+  exit zeichen (wz)
+
+END PROC suchen;
+
+PROC suchen hilfe :
+
+  hilfe anbieten ("EDIT/Suchen", fenster rechts)
+
+END PROC suchen hilfe;
+
+PROC einfuegen :
+
+  einfuegen intern (FALSE)
+
+END PROC einfuegen;
+
+PROC einfuegen intern (BOOL CONST nach umschalten) :
+
+  BOOL VAR weiter aendern := nach umschalten;
+  exit zeichen setzen;
+  REP
+    status anzeigen (einfuegen status);
+    IF weiter aendern THEN
+      aendern (PROC einfuegen hilfe);
+      weiter aendern := FALSE
+    ELSE
+      einfuegen (PROC einfuegen hilfe)
+    END IF;
+    satz untersuchen;
+    exit zeichen bei einfuegen behandeln
+  END REP .
+
+exit zeichen bei einfuegen behandeln :
+  SELECT pos (wzk, exit durch) OF
+  CASE 0 : IF satz leer THEN
+             satz loeschen
+           END IF;
+           LEAVE einfuegen intern
+  CASE 1 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; weiter (2)
+           END IF
+  CASE 2 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; zurueck (2)
+           END IF
+  CASE 3 : auf koppeldatei umschalten;
+           IF auf koppeldatei THEN
+             umgeschaltet aus einfuegen := TRUE;
+             LEAVE einfuegen intern
+           END IF;
+           weiter aendern := TRUE
+  END SELECT .
+
+END PROC einfuegen intern;
+
+PROC einfuegen hilfe :
+
+  hilfe anbieten ("EDIT/Einfuegen", fenster rechts)
+
+END PROC einfuegen hilfe;
+
+PROC exit zeichen setzen :
+
+  IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN
+    exit zeichen (wzk)
+  ELSE
+    exit zeichen (wz)
+  END IF
+
+END PROC exit zeichen setzen;
+
+PROC aendern :
+
+  exit zeichen setzen;
+  kommando auf taste legen ("F", "prueffehler editieren");
+  REP
+    status anzeigen (aendern status);
+    aendern (PROC aendern hilfe);
+    satz untersuchen;
+    exit zeichen bei aendern behandeln
+  END REP .
+
+exit zeichen bei aendern behandeln :
+  SELECT pos (wzk, exit durch) OF
+  CASE 0 : IF satz leer THEN
+             satz loeschen
+           END IF;
+           LEAVE aendern
+  CASE 1 : IF satz leer THEN
+             satz loeschen
+           ELSE
+             bitte warten; weiter (2)
+           END IF
+  CASE 2 : IF satz leer THEN
+             satz loeschen
+           END IF;
+           bitte warten; zurueck (2)
+  CASE 3 : auf koppeldatei umschalten;
+           IF auf koppeldatei THEN
+             umgeschaltet aus aendern := TRUE;
+             LEAVE aendern
+           END IF
+  END SELECT .
+
+END PROC aendern;
+
+PROC aendern hilfe :
+
+  hilfe anbieten ("EDIT/Aendern", fenster rechts)
+
+END PROC aendern hilfe;
+
+PROC prueffehler editieren :
+
+  IF test version = datei version THEN
+    modify (test file);
+    edit (test file)
+  END IF
+
+END PROC prueffehler editieren;
+
+PROC auf koppeldatei umschalten :
+
+  INT VAR datei nr := folgedatei (0);
+  WHILE datei nr > 0 REP
+    IF auf diese datei schalten THEN
+      auf koppeldatei (datei nr);
+      ketten koppeln sperre;
+      LEAVE auf koppeldatei umschalten
+    END IF;
+    datei nr := folgedatei (datei nr)
+  END REP .
+
+auf diese datei schalten :
+  ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)),
+      "JA/umschalten") .
+
+END PROC auf koppeldatei umschalten;
+
+PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) :
+
+  outsubtext (zeile, anfang); out (cleol) .
+
+anfang :
+  pos (zeile, blank, 6) + 1 + dummy - dummy .
+
+END PROC zeilenrest ausgeben;
+
+PROC satz untersuchen :
+
+  feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer)
+
+END PROC satz untersuchen;
+
+PROC ob leer (TEXT CONST satz, INT CONST von, bis) :
+
+  satz leer := von < 3 OR von > length (satz) + bis - bis
+
+END PROC ob leer;
+
+PROC rollcursor :
+
+  cursor (15, 24)
+
+END PROC rollcursor;
+
+PROC trage satz und frage (TEXT CONST dateiname) :
+
+  IF exists (dateiname) THEN
+    teste auf offen
+  ELSE
+    frage ob einrichten (dateiname)
+  END IF;
+  bitte warten;
+  trage satz (dateiname) .
+
+teste auf offen :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF .
+
+END PROC trage satz und frage;
+
+PROC felder waehlen lassen (TEXT VAR wahlvektor,
+                            TEXT CONST name auswahl, name hilfe) :
+
+  auswahl anbieten (name auswahl, fenster rechts, 256, name hilfe,
+                    wahlvektor,
+                    PROC (TEXT VAR, INT CONST) gib namen);
+  wahlvektor := niltext;
+  INT VAR nr := 1;
+  WHILE wahl (nr) > 0 REP
+    wahlvektor CAT code (wahl (nr));
+    nr INCR 1
+  END REP
+
+END PROC felder waehlen lassen;
+
+
+(************************* Menue 'Gesamtdatei' ***************************)
+
+LET
+  name der datei =  #1155#
+    "Name der Datei:",
+  name der zieldatei =  #1156#
+    "Name der Zieldatei:",
+  name der verarbeitungsvorschrift =  #1157#
+    "Name der Verarbeitungsvorschrift:",
+  name des druckmusters =  #1158#
+    "Name des Druckmusters:",
+  name der quelldatei =  #1159#
+    "Name der Quelldatei:";
+
+LET
+  felder auswaehlen =  #1160#
+    "Angezeigte Felder auswählen",
+  aufsteigend sortieren =  #1161#
+    " aufsteigend sortieren";
+
+TEXT VAR
+  uebersichtsauswahl := niltext;
+
+INT VAR
+  version uebersicht := 0;
+
+DATASPACE VAR
+  kopier ds;
+
+
+PROC bearbeiten interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : saetze kopieren
+  CASE 2 : saetze tragen
+  CASE 3 : nach vorschrift aendern
+  CASE 4 : uebersicht ausgeben
+  CASE 5 : datei sortieren
+  CASE 6 : alle markierungen loeschen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+fusszeile aktualisieren :
+  akt dateiname in fuss;
+  fussteil (2, "", "") .
+
+saetze tragen :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) trage saetze) .
+
+saetze kopieren :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) kopiere saetze);
+  dialogfenster loeschen .
+
+nach vorschrift aendern :
+  ausfuehrung (name der verarbeitungsvorschrift, file typ,
+               PROC (TEXT CONST) verarbeite mit edit);
+  dialogfenster loeschen .
+
+uebersicht ausgeben :
+  IF dateiversion <> version uebersicht THEN
+    uebersichtsauswahl := niltext;
+    version uebersicht := dateiversion
+  END IF;
+  feldauswahl fuer uebersicht (uebersichtsauswahl);
+  uebersicht (uebersichtsauswahl, PROC uebersicht hilfe);
+  dialogfenster loeschen .
+
+datei sortieren :
+  zugriff (PROC (EUDAT VAR) einzelsortiere) .
+
+alle markierungen loeschen :
+  markierungen loeschen;
+  dialog (markierungen geloescht) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  END IF .
+
+END PROC bearbeiten interpreter;
+
+PROC last param darf nicht geoeffnet sein :
+
+  IF index der arbeitskopie (std) <> 0 THEN
+    last param (niltext)
+  END IF
+
+END PROC last param darf nicht geoeffnet sein;
+
+PROC trage saetze (TEXT CONST dateiname) :
+
+  BOOL VAR mit test;
+  IF exists (dateiname) THEN
+    teste auf offen;
+    frage ob testen
+  ELSE
+    frage ob einrichten (dateiname);
+    mit test := FALSE
+  END IF;
+  BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren");
+  bitte warten;
+  ggf datei initialisieren;
+  trage (dateiname, test file, mit test);
+  fehlerzahl ausgeben;
+  IF mit sortieren THEN
+    EUDAT VAR eudat;
+    oeffne (eudat, dateiname);
+    sortiere (eudat)
+  END IF .
+
+teste auf offen :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF .
+
+frage ob testen :
+  mit test := ja (pruefbedingungen testen, "JA/testen") .
+
+ggf datei initialisieren :
+  IF mit test THEN
+    forget (test ds);
+    test ds := nilspace;
+    test file := sequential file (output, test ds);
+    test version := datei version
+  ELSE
+    forget (test ds);
+    test version := datei version - 1
+  END IF .
+
+fehlerzahl ausgeben :
+  IF mit test CAND lines (test file) > 0 THEN
+    dialog (text (lines (test file)) + prueffehler festgestellt)
+  END IF .
+
+END PROC trage saetze;
+
+PROC verarbeite mit edit (TEXT CONST dateiname) :
+
+  IF NOT exists (dateiname) THEN
+    edit unten (dateiname, "EDIT/Verarbeite")
+  END IF;
+  bild frei fuer uebersetzung;
+  FILE VAR f := sequential file (input, dateiname);
+  disable stop;
+  verarbeite (f);
+  uebersetzungsfehler behandeln .
+
+END PROC verarbeite mit edit;
+
+PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) :
+
+  IF ja (felder auswaehlen, "JA/Ub.Felder") THEN
+    felder waehlen lassen (uebersichtsauswahl,
+                          "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder")
+  END IF
+
+END PROC feldauswahl fuer uebersicht;
+
+PROC uebersicht hilfe :
+
+  hilfe anbieten ("UEBERSICHT", fenster ganz)
+
+END PROC uebersicht hilfe;
+
+PROC kopiere saetze (TEXT CONST dateiname) :
+
+  disable stop;
+  kopier ds := nilspace;
+  kopiere saetze intern (dateiname);
+  forget (kopier ds)
+
+END PROC kopiere saetze;
+
+PROC kopiere saetze intern (TEXT CONST dateiname) :
+
+  TEXT VAR mustername := "";
+  FILE VAR f;
+  EUDAT VAR eudat;
+  BOOL VAR mit sortieren := FALSE;
+
+  enable stop;
+  IF exists (dateiname) THEN
+    teste auf offen und sortieren
+  ELSE
+    frage ob einrichten (dateiname)
+  END IF;
+  editget (name kopiermuster, mustername, "", "GET/kopiermuster");
+  IF exists (mustername) THEN
+    f := sequential file (input, mustername)
+  ELSE
+    ggf kopiermuster einrichten;
+    std kopiermuster (dateiname, f)
+  END IF;
+  modify (f);
+  wirklich kopieren;
+  ggf sortieren .
+
+teste auf offen und sortieren :
+  IF index der arbeitskopie (dateiname) <> 0 THEN
+    errorstop (nicht in offene datei)
+  END IF;
+  oeffne (eudat, dateiname);
+  IF sortierreihenfolge (eudat) <> niltext THEN
+    mit sortieren := ja (sortierfrage, "JA/sortieren")
+  END IF .
+
+ggf kopiermuster einrichten :
+  IF mustername = niltext THEN
+    f := sequential file (output, kopier ds)
+  ELSE
+    frage ob einrichten (mustername);
+    f := sequential file (output, mustername)
+  END IF .
+
+wirklich kopieren :
+  edit (f, fenster ganz, "EDIT/Kopiermuster", TRUE);
+  bild frei fuer uebersetzung;
+  kopiere (dateiname, f) .
+
+ggf sortieren :
+  IF mit sortieren THEN
+    oeffne (eudat, dateiname);
+    sortiere (eudat)
+  END IF .
+
+END PROC kopiere saetze intern;
+
+INT PROC index der arbeitskopie (TEXT CONST dateiname) :
+
+  INT VAR dateinr;
+  FOR dateinr FROM 1 UPTO anzahl dateien REP
+    IF eudas dateiname (dateinr) = dateiname THEN
+      LEAVE index der arbeitskopie WITH dateinr
+    END IF
+  END REP;
+  0
+
+END PROC index der arbeitskopie;
+
+PROC edit unten (TEXT CONST dateiname, hilfe) :
+
+  IF NOT exists (dateiname) THEN
+    frage ob einrichten (dateiname)
+  END IF;
+  FILE VAR f := sequential file (modify, dateiname);
+  edit (f, fenster ganz, hilfe, TRUE)
+
+END PROC edit unten;
+
+PROC bild frei fuer uebersetzung :
+
+  bitte warten;
+  cursor (1, 2);
+  out (cl eop);
+  bildschirm neu
+
+END PROC bild frei fuer uebersetzung;
+
+PROC einzelsortiere (EUDAT VAR eudat) :
+
+  TEXT VAR reihenfolge := sortierreihenfolge (eudat);
+  IF reihenfolge = niltext COR alte reihenfolge aendern THEN
+    sortierreihenfolge aendern;
+    bitte warten;
+    sortiere (eudat, reihenfolge)
+  ELSE
+    bitte warten;
+    sortiere (eudat)
+  END IF .
+
+alte reihenfolge aendern :
+  ja (alte feldreihenfolge aendern, "JA/Sortierfelder", FALSE) .
+
+sortierreihenfolge aendern :
+  feldnamen lesen (eudat, sammel);
+  auswahl anbieten ("EUDAS-Sortierfelder", fenster rechts, 1024,
+                    "AUSWAHL/Sortierfelder", reihenfolge,
+                    PROC (TEXT VAR, INT CONST) aus sammel);
+  INT VAR feldnr := 1;
+  reihenfolge := niltext;
+  WHILE wahl (feldnr) <> 0 REP
+    reihenfolge CAT code (wahl (feldnr));
+    nach richtung fragen;
+    feldnr INCR 1
+  END REP .
+
+nach richtung fragen :
+  feld lesen (sammel, wahl (feldnr), feldpuffer);
+  IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren,
+         "JA/Sortierrichtung") THEN
+    reihenfolge CAT "+"
+  ELSE
+    reihenfolge CAT "-"
+  END IF .
+
+END PROC einzelsortiere;
+
+PROC gib namen (TEXT VAR name, INT CONST nr) :
+
+  IF nr <= anzahl felder THEN
+    feldnamen lesen (nr, name)
+  ELSE
+    name := niltext
+  END IF
+
+END PROC gib namen;
+
+
+(************************* Menue 'Drucken' ********************************)
+
+LET
+(*direkt ausgabe =  #1162#
+    "Ausgabe automatisch zum Drucker",*)
+  name druckzieldatei =  #1163#
+    "Name Ausgabedatei:",
+  zwischendatei drucken =  #1210#
+    "Erzeugte Ausgabe ausdrucken",
+  zwischendatei loeschen =  #1211#
+    "Erzeugte Ausgabe löschen",
+  welche richtung =  #1212#
+    "Richtung der Druckausgabe:",
+  welche listenform =  #1213#
+    "Form der Liste:",
+  t max listenbreite =  #1214#
+    "Anzahl Zeichen pro Zeile:",
+  keine zahl angegeben =  #1215#
+    "Eingabe ist keine gültige Zahl",
+  sortierfrage =  #1164#
+    "Zieldatei anschließend sortieren",
+  pruefbedingungen testen =  #1165#
+    "Prüfbedingungen testen",
+  prueffehler festgestellt =  #1166#
+    "Prüffehler festgestellt",
+  nicht in offene datei =  #1167#
+    "Zieldatei darf nicht geöffnet sein",
+  name kopiermuster =  #1168#
+    "Name Kopiermuster (RET=Std):";
+
+LET
+  z form =  #1169#
+    " zeilenweise formatieren",
+  s form =  #1170#
+    " seitenweise formatieren";
+
+LET
+  m drucke direkt     = 0,
+  m drucke auf schirm = 1,
+  m drucke in datei   = 2;
+
+BOOL VAR
+  zeilen automatisch := FALSE,
+  seiten automatisch := FALSE;
+
+
+PROC drucken interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : nach muster drucken
+  CASE 2 : standardlisten
+  CASE 3 : ausgaberichtung umschalten
+  CASE 4 : musterdatei aendern
+  CASE 5 : textdatei drucken
+  CASE 6 : nachbearbeiten
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+fusszeile aktualisieren :
+  akt dateiname in fuss;
+  fussteil (2, "", "") .
+
+nach muster drucken :
+  ausfuehrung (name des druckmusters, file typ,
+               PROC (TEXT CONST) drucke mit edit);
+  dialogfenster loeschen .
+
+standardlisten :
+  INT VAR listenform := 1;
+  auswahl anbieten ("WAHL.Std-Listen", welche listenform, "WAHL/Std-Listen",
+                    listenform);
+  feldliste erfragen;
+  listenfont erfragen;
+  listenbreite erfragen;
+  ausgabedatei erfragen;
+  bild frei fuer uebersetzung;
+  drucke standardlisten (listenform, feldliste);
+  ergebnis anbieten .
+
+feldliste erfragen :
+  TEXT VAR feldliste := niltext;
+  felder waehlen lassen (feldliste,
+                        "EUDAS-Druckfelder", "AUSWAHL/Druckfelder") .
+
+listenfont erfragen :
+  .
+
+listenbreite erfragen :
+  TEXT VAR edit zahl := text (std listenbreite);
+  editget (t max listenbreite, edit zahl, "", "GET/listenbreite");
+  INT CONST neue breite := int (edit zahl);
+  IF NOT last conversion ok THEN
+    errorstop (keine zahl angegeben)
+  ELSE
+    std listenbreite (neue breite)
+  END IF .
+
+ausgaberichtung umschalten :
+  INT VAR ergebnis := druckrichtung + 1;
+  auswahl anbieten ("WAHL.Richtung", welche richtung, "WAHL/Richtung",
+                    ergebnis);
+  druckrichtung (ergebnis - 1) .
+
+musterdatei aendern :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) muster edit);
+  dialogfenster loeschen .
+
+textdatei drucken :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) print) .
+
+nachbearbeiten :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) nachbearbeitung);
+  dialogfenster loeschen .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  END IF .
+
+END PROC drucken interpreter;
+
+PROC uebersetzungsfehler behandeln :
+
+  IF uebersetzungsfehler THEN
+    clear error
+  END IF .
+
+uebersetzungsfehler :
+  is error CAND errormessage = niltext .
+
+END PROC uebersetzungsfehler behandeln;
+
+PROC drucke mit edit (TEXT CONST dateiname) :
+
+  IF NOT exists (dateiname) THEN
+    muster edit (dateiname)
+  END IF;
+  ausgabedatei erfragen;
+  bild frei fuer uebersetzung;
+  disable stop;
+  drucke (dateiname);
+  ergebnis anbieten;
+  uebersetzungsfehler behandeln .
+
+END PROC drucke mit edit;
+
+PROC ausgabedatei erfragen :
+
+  IF druckrichtung = m drucke in datei THEN
+    TEXT VAR dateiname := druckdatei;
+    IF pos (dateiname, "$") > 0 THEN dateiname := niltext END IF;
+    editget (name druckzieldatei, dateiname, "", "GET/Druckdatei");
+    IF dateiname <> niltext THEN
+      druckdatei (dateiname)
+    END IF
+  END IF
+
+END PROC ausgabedatei erfragen;
+
+PROC ergebnis anbieten :
+
+  IF NOT is error CAND druckrichtung = m drucke auf schirm CAND
+       exists (druckdatei) THEN
+    enable stop;
+    zwischendatei zeigen
+  END IF .
+
+zwischendatei zeigen :
+  FILE VAR ausgabefile := sequential file (input, druckdatei);
+  edit (ausgabefile, fenster ganz, "EDIT/Druckausgabe", TRUE);
+  IF ja (zwischendatei drucken, "JA/Ausgabe drucken", FALSE) THEN
+    print (druckdatei)
+  END IF;
+  IF ja (zwischendatei loeschen, "JA/Ausgabe loeschen", FALSE) THEN
+    forget (druckdatei, quiet)
+  END IF .
+
+END PROC ergebnis anbieten;
+
+PROC muster edit (TEXT CONST dateiname) :
+
+  edit unten (dateiname, "EDIT/Druckmuster")
+ 
+END PROC muster edit;
+
+PROC print (TEXT CONST dateiname) :
+
+  do ("print (" + textdarstellung (dateiname) + ")")
+
+END PROC print;
+
+PROC nachbearbeitung (TEXT CONST dateiname) :
+
+  IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN
+    zeilen formatieren
+  END IF;
+  IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN
+    seiten formatieren
+  END IF .
+
+zeilen formatieren :
+  IF zeilen automatisch THEN
+    autoform (dateiname)
+  ELSE
+    lineform (dateiname)
+  END IF;
+  page;
+  bildschirm neu .
+
+seiten formatieren :
+  IF seiten automatisch THEN
+    autopageform (dateiname)
+  ELSE
+    pageform (dateiname)
+  END IF;
+  bildschirm neu .
+
+END PROC nachbearbeitung;
+
+PROC formatieren automatisch (BOOL CONST za, sa) :
+
+  zeilen automatisch := za;
+  seiten automatisch := sa
+
+END PROC formatieren automatisch;
+
+
+(********************** Menue 'Dateien' ***********************************)
+
+INITFLAG VAR diese task;
+
+TEXT VAR arbeitsbereich;
+
+LET
+  p task =  #1171#
+    ""15"Bereich "14"",
+  t neuer name =  #1172#
+    "Neuer Name:",
+  t zieldatei =  #1173#
+    "Zieldatei:",
+  t belegt =  #1174#
+    "belegt ",
+  t kb =  #1175#
+    "KB.",
+  t existiert nicht =  #1176#
+    " existiert nicht.",
+  t loeschen =  #1177#
+    " in dieser Task löschen";
+
+PROC dateiverwaltung (INT CONST wahl nr) :
+
+  enable stop;
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : dateiuebersicht
+  CASE 2 : datei loeschen
+  CASE 3 : datei umbenennen
+  CASE 4 : datei kopieren
+  CASE 5 : speicherbelegung datei
+  CASE 6 : datei reorganisieren
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+fusszeile aktualisieren :
+  arbeitsbereich bestimmen;
+  fussteil (2, "", "") .
+
+datei reorganisieren :
+  ausfuehrung (PROC (TEXT CONST) aufraeumen) .
+
+datei umbenennen :
+  ausfuehrung (PROC (TEXT CONST) umbenennen) .
+
+datei loeschen :
+  ausfuehrung (PROC (TEXT CONST) loeschen) .
+
+dateiuebersicht :
+  disable stop;
+  DATASPACE VAR list ds := nilspace;
+  FILE VAR f := sequential file (output, list ds);
+  list (f);
+  IF NOT is error THEN
+    edit (f, fenster rechts, "SHOW/Uebersicht", FALSE)
+  END IF;
+  forget (list ds);
+  enable stop;
+  tastenpuffer loeschen .
+
+datei kopieren :
+  ausfuehrung (PROC (TEXT CONST) ds kopieren) .
+
+speicherbelegung datei :
+  ausfuehrung (PROC (TEXT CONST) speicherbelegung) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  END IF .
+
+END PROC dateiverwaltung;
+
+PROC arbeitsbereich bestimmen :
+
+  IF NOT initialized (diese task) THEN
+    neu bestimmen
+  END IF;
+  fussteil (1, p task, arbeitsbereich) .
+
+neu bestimmen :
+  IF station (myself) <> 0 THEN
+    arbeitsbereich := text (station (myself)) + "/"""
+  ELSE
+    arbeitsbereich := """"
+  END IF;
+  arbeitsbereich CAT name (myself);
+  arbeitsbereich CAT """" .
+
+END PROC arbeitsbereich bestimmen;
+
+PROC tastenpuffer loeschen :
+
+  WHILE getcharety <> niltext REP END REP
+
+END PROC tastenpuffer loeschen;
+
+PROC aufraeumen (TEXT CONST dateiname) :
+
+  bitte warten;
+  IF type (old (dateiname)) = eudas typ THEN
+    reorganisiere (dateiname)
+  ELSE
+    reorganize (dateiname)
+  END IF
+
+END PROC aufraeumen;
+
+PROC umbenennen (TEXT CONST dateiname) :
+
+  TEXT VAR neuer name := dateiname;
+  IF exists (dateiname) THEN
+    editget (t neuer name, neuer name, "", "GET/rename")
+  END IF;
+  rename (dateiname, neuer name)
+
+END PROC umbenennen;
+
+PROC loeschen (TEXT CONST dateiname) :
+
+  IF offene datei THEN
+    errorstop (nicht in offene datei)
+  ELIF exists (dateiname) CAND frage bejaht THEN
+    forget (dateiname, quiet)
+  END IF .
+
+offene datei :
+  index der arbeitskopie (dateiname) <> 0 .
+
+frage bejaht :
+  ja (textdarstellung (dateiname) + t loeschen, "JA/forget", FALSE) .
+
+END PROC loeschen;
+
+PROC ds kopieren (TEXT CONST dateiname) :
+
+  TEXT VAR zieldatei := niltext;
+  editget (t zieldatei, zieldatei, "", "GET/copy");
+  copy (dateiname, zieldatei)
+
+END PROC ds kopieren;
+
+PROC speicherbelegung (TEXT CONST dateiname) :
+
+  dialog (textdarstellung (dateiname));
+  IF exists (dateiname) THEN
+    out (t belegt);
+    put (storage (old (dateiname)));
+    out (t kb)
+  ELSE
+    out (t existiert nicht)
+  END IF
+
+END PROC speicherbelegung;
+
+
+(*********************** Menue 'Archiv' ***********************************)
+
+TEXT VAR
+  letzter archivname := niltext,
+  zielarchiv := "ARCHIVE";
+
+INT VAR zielstation := 0;
+
+THESAURUS VAR archivinhalt;
+
+BOOL VAR
+  archivzugriff,
+  ziel ist manager := TRUE;
+
+LET
+  p zielarchiv =  #1182#
+    ""15"Ziel "14"",
+  archiv heisst =  #1183#
+    "Archiv heisst ",
+  name des archivs =  #1184#
+    "Name des Archivs:",
+  name zielarchiv =  #1185#
+    "Name Zielarchiv:",
+  nr zielstation =  #1186#
+    "Nr. der Zielstation (od. RETURN):",
+  t zielmodus =  #1187#
+    "Art des Zielarchivs:",
+  diskette formatieren =  #1188#
+    "Diskette neu formatieren",
+  neuer archivname =  #1189#
+    "Neuer Archivname:",
+  t im system ueberschreiben =  #1190#
+    " in dieser Task überschreiben",
+  t auf archiv loeschen =  #1191#
+    " auf Archiv löschen",
+  t archiv =  #1192#
+    "Archiv ",
+  t ueberschreiben =  #1193#
+    " überschreiben",
+  diskette eingelegt =  #1194#
+    "Diskette eingelegt",
+  t auf archiv ueberschreiben =  #1195#
+    " auf Archiv überschreiben",
+  t formatparameter =  #1196#
+    "Mögliche Diskettenformate: ";
+
+LET
+  t passwort =  #1197#
+    "Passwort: ",
+  passwortwiederholung falsch =  #1198#
+    "Passwort stimmt nicht mit der ersten Eingabe überein",
+  bitte passwort wiederholen =  #1199#
+    "Passwort zur Kontrolle bitte nochmal eingeben:",
+  passwort loeschen =  #1200#
+    "Passwort löschen",
+  falsche stationsnr =  #1201#
+    "Unzulässige Stationsnummer",
+  task ist kein manager =  #1202#
+    "Angegebene Task ist kein Manager";
+
+ROW 4 TEXT VAR archivtask;
+    archivtask (1) := "ARCHIVE";
+    archivtask (2) := "PUBLIC";
+    archivtask (3) := "ARCHIVE360";
+    archivtask (4) := "DOS";
+
+
+PROC archivverwaltung (INT CONST menue nr, wahl nr) :
+
+  enable stop;
+  SELECT wahl nr OF
+  CASE 0 : eintritt
+  CASE 1 : archivuebersicht
+  CASE 2 : uebersicht drucken
+  CASE 3 : datei vom archiv holen
+  CASE 4 : datei auf archiv sichern
+  CASE 5 : auf archiv loeschen
+  CASE 6 : archiv initialisieren
+  CASE 7 : zielarchiv einstellen
+  CASE 8 : passwort einstellen
+  CASE 9 : reservieren
+  OTHERWISE verlassen
+  END SELECT;
+  storage kontrollieren .
+
+eintritt :
+  arbeitsbereich bestimmen;
+  waehlbar (menue nr, 6, ziel ist manager);
+  waehlbar (menue nr, 9, NOT ziel ist manager);
+  fussteil (2, p zielarchiv, stationsnr + zielarchiv);
+  archivzugriff := FALSE .
+
+datei auf archiv sichern :
+  IF ziel ist manager THEN
+    archivnamen holen
+  END IF;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  ausfuehrung (PROC (TEXT CONST) archivieren) .
+
+datei vom archiv holen :
+  disable stop;
+  archiv anmelden;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  IF falscher name THEN archivinhalt := ALL eudas archiv END IF;
+  enable stop;
+  auf archiv (PROC (TEXT CONST) holen, archivinhalt) .
+
+auf archiv loeschen :
+  IF ziel ist manager THEN
+    archivnamen holen
+  END IF;
+  bitte warten;
+  archivinhalt := ALL eudas archiv;
+  auf archiv (PROC (TEXT CONST) auf archiv loeschen, archivinhalt) .
+
+archivuebersicht :
+  archiv anmelden;
+  disable stop;
+  bitte warten;
+  DATASPACE VAR list ds := nilspace;
+  f :=sequential file (output, list ds);
+  list (f, eudas archiv);
+  IF falscher name THEN list (f, eudas archiv) END IF;
+  IF NOT is error THEN
+    modify (f); to line (f, 1);
+    write record (f, headline (f));
+    headline (f, niltext);
+    edit (f, fenster rechts, "SHOW/Uebersicht", FALSE)
+  END IF;
+  forget (list ds);
+  tastenpuffer loeschen;
+  enable stop .
+
+uebersicht drucken :
+  archiv anmelden;
+  namen generieren;
+  FILE VAR f := sequential file (output, list name);
+  disable stop;
+  bitte warten;
+  list (f, eudas archiv);
+  IF falscher name THEN list (f, eudas archiv) END IF;
+  IF is error THEN forget (list name, quiet) END IF;
+  enable stop;
+  modify (f);
+  insert record (f);
+  write record (f, headline (f));
+  print (list name);
+  forget (list name, quiet) .
+
+namen generieren :
+  INT VAR i := 0;
+  TEXT VAR list name;
+  REP
+    i INCR 1;
+    list name := "Archivliste " + text (i)
+  UNTIL NOT exists (list name) END REP .
+
+archiv initialisieren :
+  archiv anmelden;
+  IF keine diskette COR benanntes archiv CAND loeschen verneint THEN
+    LEAVE archiv initialisieren
+  END IF;
+  BOOL CONST mit format := ja (diskette formatieren, "JA/format");
+  neuen namen erfragen;
+  tatsaechlich initialisieren .
+
+keine diskette :
+  NOT ja (diskette eingelegt, "JA/eingelegt") .
+
+benanntes archiv :
+  reserve ("", eudas archiv);
+  bitte warten;
+  disable stop;
+  archivinhalt := ALL eudas archiv;
+  BOOL CONST ergebnis := falscher name;
+  clear error;
+  enable stop;
+  ergebnis .
+
+loeschen verneint :
+  NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben,
+          "JA/archiv loeschen") .
+
+neuen namen erfragen :
+  editget (neuer archivname, letzter archivname, "", "GET/Archivname");
+  reserve (letzter archivname, eudas archiv) .
+
+tatsaechlich initialisieren :
+  IF mit format THEN
+    formatparameter abrufen;
+    archiv formatieren
+  ELSE
+    clear aufrufen
+  END IF .
+
+clear aufrufen :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  clear (eudas archiv);
+  reset command dialogue .
+
+formatparameter abrufen :
+  INT VAR std := 1;
+  auswahl anbieten ("WAHL.Format", t formatparameter, "WAHL/format", std);
+  std DECR 1 .
+
+archiv formatieren :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  format (std, eudas archiv);
+  reset command dialogue;
+  enable stop .
+
+zielarchiv einstellen :
+  INT VAR zielmodus := 1;
+  IF archivzugriff THEN
+    release (eudas archiv); archivzugriff := FALSE
+  END IF;
+  auswahl anbieten ("WAHL.Ziel", t zielmodus, "WAHL/zielarchiv", zielmodus);
+  TEXT VAR zieltaskname := archivtask (zielmodus);
+  IF zielmodus > 1 THEN
+    namen des zielarchivs erfragen
+  END IF;
+  zielstation einlesen;
+  werte uebertragen;
+  waehlbar (menue nr, 6, ziel ist manager);
+  waehlbar (menue nr, 9, NOT ziel ist manager);
+  bildschirm neu;
+  fussteil (2, stationsnr + zielarchiv) .
+
+namen des zielarchivs erfragen :
+  editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv");
+  IF zieltaskname = niltext THEN
+    LEAVE zielarchiv einstellen
+  END IF;
+  archivtask (zielmodus) := zieltaskname .
+
+zielstation einlesen :
+  TEXT VAR rechner := text (station (myself));
+  IF station (myself) <> 0 THEN
+    editget (nr zielstation, rechner, "", "GET/Zielstation")
+  END IF .
+
+werte uebertragen :
+  zielstation := int (rechner);
+  IF NOT last conversion ok THEN
+    errorstop (falsche stationsnr)
+  END IF;
+  zielarchiv := zieltaskname;
+  ziel ist manager := zielmodus = 1 OR zielmodus = 3;
+  teste auf manager (eudas archiv) .
+
+stationsnr :
+  IF zielstation = 0 THEN
+    niltext
+  ELSE
+    text (zielstation) + "/"
+  END IF .
+
+reservieren :
+  TEXT VAR parameter := niltext;
+  editget (name des archivs, parameter, "", "GET/Archivname");
+  reserve (parameter, eudas archiv);
+  archivzugriff := TRUE .
+
+verlassen :
+  IF wahl nr = -1 THEN
+    IF archivzugriff THEN
+      release (eudas archiv)
+    END IF;
+    dialogfenster loeschen
+  END IF .
+
+END PROC archivverwaltung;
+
+TASK PROC eudas archiv :
+
+  IF zielstation = 0 THEN
+    task (zielarchiv)
+  ELSE
+    zielstation / zielarchiv
+  END IF
+
+END PROC eudas archiv;
+
+PROC teste auf manager (TASK CONST t) :
+
+  INT VAR i;
+  IF station (t) = station (myself) THEN
+    FOR i FROM 1 UPTO 5 REP
+      IF status (t) = 2 OR status (t) = 6 THEN
+        LEAVE teste auf manager
+      END IF;
+      pause (10)
+    END REP;
+    errorstop (task ist kein manager)
+  END IF
+
+END PROC teste auf manager;
+
+PROC archivnamen holen :
+
+  TEXT VAR neuer archivname := letzter archivname;
+  editget (name des archivs, neuer archivname, "", "GET/Archivname");
+  IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN
+    reserve (neuer archivname, eudas archiv);
+    archivzugriff := TRUE
+  END IF;
+  letzter archivname := neuer archivname
+ 
+END PROC archivnamen holen;
+
+PROC archiv anmelden :
+
+  IF NOT archivzugriff AND ziel ist manager THEN
+    reserve (letzter archivname, eudas archiv);
+    archivzugriff := TRUE
+  END IF
+
+END PROC archiv anmelden;
+
+BOOL PROC falscher name :
+
+  IF ziel ist manager AND is error THEN
+    TEXT CONST meldung := errormessage;
+    IF subtext (meldung, 1, 14) = archiv heisst CAND
+       subtext (meldung, 16, 20) <> "?????" THEN
+      clear error;
+      nochmal anmelden;
+      LEAVE falscher name WITH TRUE
+    END IF
+  END IF;
+  FALSE .
+
+nochmal anmelden :
+  letzter archivname := subtext (meldung, 16, length (meldung) - 1);
+  reserve (letzter archivname, eudas archiv) .
+
+END PROC falscher name;
+
+PROC archivieren (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN
+    vorher eventuell sichern;
+    bitte warten;
+    set command dialogue false;
+    save (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+auf archiv ueberschreiben :
+  ja (textdarstellung (dateiname) + t auf archiv ueberschreiben,
+      "JA/save", FALSE) .
+
+vorher eventuell sichern :
+  INT CONST nr := index der arbeitskopie (dateiname);
+  IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN
+    einzelsicherung (nr)
+  END IF .
+
+END PROC archivieren;
+
+PROC holen (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN
+    bitte warten;
+    set command dialogue false;
+    fetch (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+eigene datei ueberschreiben :
+  ja (textdarstellung (dateiname) + t im system ueberschreiben,
+      "JA/fetch", FALSE) .
+
+END PROC holen;
+
+PROC auf archiv loeschen (TEXT CONST dateiname) :
+
+  disable stop;
+  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN
+    bitte warten;
+    set command dialogue false;
+    erase (dateiname, eudas archiv);
+    reset command dialogue
+  END IF .
+
+auf archiv loeschen :
+  ja (textdarstellung (dateiname) + t auf archiv loeschen,
+      "JA/erase", FALSE) .
+
+END PROC auf archiv loeschen;
+
+PROC passwort einstellen :
+
+  BOUND ROW 2 TEXT VAR pw;
+  DATASPACE VAR ds := nilspace;
+  pw := ds;
+  disable stop;
+  passwort holen (t passwort, pw (1));
+  IF pw (1) = niltext THEN
+    fragen ob loeschen
+  ELSE
+    doppelt eingeben
+  END IF;
+  forget (ds) .
+
+fragen ob loeschen :
+  IF ja (passwort loeschen, "JA/pw loeschen") THEN
+    set command dialogue false;
+    enter password (niltext);
+    reset command dialogue
+  END IF .
+
+doppelt eingeben :
+  passwort holen (bitte passwort wiederholen, pw (2));
+  IF pw (1) <> pw (2) THEN
+    errorstop (passwortwiederholung falsch)
+  ELSE
+    set command dialogue false;
+    enter password (pw (1));
+    reset command dialogue
+  END IF .
+
+END PROC passwort einstellen;
+
+PROC passwort holen (TEXT CONST prompt, TEXT VAR wort) :
+
+  enable stop;
+  dialog (prompt);
+  get secret line (wort)
+
+END PROC passwort holen;
+
+
+(********************** Auswahlinterface **********************************)
+
+SATZ VAR
+  sammel;
+
+PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) :
+
+  IF stelle <= 256 THEN
+    feld lesen (sammel, stelle, inhalt)
+  ELSE
+    inhalt := niltext
+  END IF
+
+END PROC aus sammel;
+
+PROC feldnamen anzeigen :
+
+  IF anzahl felder > 0 THEN
+    feldnamen sammeln;
+    sammlung zur auswahl anbieten;
+    ergebnis in editor uebernehmen
+  END IF .
+
+feldnamen sammeln :
+  INT VAR feldnr;
+  satz initialisieren (sammel, anzahl felder);
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldpuffer);
+    feld aendern (sammel, feldnr, feldpuffer)
+  END REP .
+
+sammlung zur auswahl anbieten :
+  auswahl anbieten ("EUDAS-Editfelder", fenster rechts,
+                    "AUSWAHL/Feldnamen",
+                    PROC (TEXT VAR, INT CONST) aus sammel) .
+
+ergebnis in editor uebernehmen :
+  INT VAR stelle := 1;
+  WHILE wahl (stelle) > 0 REP
+    IF stelle > 1 THEN type (blank) END IF;
+    feldnamen lesen (wahl (stelle), feldpuffer);
+    type ("<"); type (feldpuffer); type (">");
+    stelle INCR 1
+  END REP .
+
+END PROC feldnamen anzeigen;
+
+PROC einzelausfuehrung (TEXT CONST prompt, INT CONST typ,
+                        PROC (TEXT CONST) operation) :
+
+  ausfuehrung (prompt, TRUE, typ, PROC (TEXT CONST) operation)
+
+END PROC einzelausfuehrung;
+
+PROC ausfuehrung (TEXT CONST prompt, INT CONST typ,
+                  PROC (TEXT CONST) operation) :
+
+  ausfuehrung (prompt, FALSE, typ, PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+PROC ausfuehrung (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, 0, PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+END PACKET eudas steuerung;
+
diff --git a/app/eudas/5.3/src/eudas.uebersicht.04 b/app/eudas/5.3/src/eudas.uebersicht.04
new file mode 100644
index 0000000..be597da
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.uebersicht.04
@@ -0,0 +1,404 @@
+PACKET uebersichtsanzeige
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Anzeige von EUDAS-Dateien als Übersicht                           *)
+(*                                                                       *)
+(*     Version 04                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 14.01.88                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  uebersicht,
+  uebersichtsfenster :
+
+
+ROW 24 INT VAR zeilensatz;
+
+ROW 24 INT VAR zeilenkombi;
+
+FENSTER VAR fenster;
+fenster initialisieren (fenster);
+
+INT VAR
+  laenge := 24,
+  breite := 79,
+  zeilen anf := 1,
+  spalten anf := 1,
+  freier rest,
+  feldversion := -1;
+
+BOOL VAR
+  bis zeilenende;
+
+TEXT VAR
+  feldnummern;
+
+LET
+  niltext = "",
+  begin mark = ""15"",
+  end mark = ""14"",
+  blank = " ",
+  piep = ""7"",
+  cleol = ""5"";
+
+LET
+  t satznr =  #901#
+    ""15"Satznr. ",
+  t dateiende =  #902#
+    "  << DATEIENDE >>",
+  uebersicht status =  #903#
+"UEBERSICHT:   Rollen: HOP OBEN, HOP UNTEN   Beenden: ESC q   Hilfe: ESC ?";
+
+
+PROC uebersichtsfenster (FENSTER CONST fe) :
+
+  fenstergroesse (fe, spalten anf, zeilen anf, breite, laenge);
+  fenstergroesse setzen (fenster, fe);
+  bis zeilenende := spalten anf + breite >= x size
+
+END PROC uebersichtsfenster;
+
+FENSTER PROC uebersichtsfenster :
+  fenster
+END PROC uebersichtsfenster;
+
+PROC uebersicht (TEXT CONST nummern, PROC hilfe) :
+
+  TEXT VAR eingabezeichen;
+  BOOL VAR dummy;
+  INT VAR
+    angezeigter satz := 1,
+    ausgegebene zeilen := 0,
+    eingabezustand := 1;
+
+  fensterzugriff (fenster, dummy);
+  status anzeigen (uebersicht status);
+  feldnummern bestimmen;
+  aktueller satz wird erster;
+  REP
+    kommando annehmen und zeile ausgeben;
+    cursor auf zeilenanfang;
+    kommando interpretieren
+  END REP .
+
+feldnummern bestimmen :
+  IF nummern = niltext THEN
+    ggf alte auswahl uebernehmen
+  ELSE
+    feldnummern := nummern;
+    feldversion := dateiversion
+  END IF .
+
+ggf alte auswahl uebernehmen :
+  IF feldversion <> dateiversion THEN
+    alle felder anzeigen;
+    feldversion := dateiversion
+  END IF .
+
+alle felder anzeigen :
+  INT VAR i;
+  feldnummern := niltext;
+  FOR i FROM 1 UPTO anzahl felder REP
+    feldnummern CAT code (i)
+  END REP .
+
+kommando annehmen und zeile ausgeben :
+  WHILE ausgegebene zeilen < laenge REP
+    eingabezeichen := getcharety;
+    IF eingabezeichen <> "" THEN
+      LEAVE kommando annehmen und zeile ausgeben
+    END IF;
+    eine zeile ausgeben;
+    ausgegebene zeilen INCR 1
+  END REP;
+  aktuellen satz markieren und einnehmen;
+  getchar (eingabezeichen) .
+
+eine zeile ausgeben :
+  IF ausgegebene zeilen = 0 THEN
+    ueberschrift ausgeben
+  ELIF ausgegebene zeilen = 1 THEN
+    erste zeile ausgeben
+  ELSE
+    weitere zeile ausgeben
+  END IF .
+
+ueberschrift ausgeben :
+  cursor (spalten anf, zeilen anf);
+  out (t satznr);
+  freier rest := breite - length (t satznr) - 1;
+  INT VAR feldindex;
+  FOR feldindex FROM 1 UPTO length (feldnummern)
+  WHILE freier rest > 0 REP
+    feldnamen bearbeiten (code (feldnummern SUB feldindex),
+      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
+  END REP;
+  zeilenrest loeschen;
+  cursor (spalten anf + breite - 1, zeilen anf);
+  out (end mark) .
+
+erste zeile ausgeben :
+  auf uebersichtssatz (1);
+  satznummer in zeile (1);
+  satz als zeile ausgeben .
+
+weitere zeile ausgeben :
+  cursor (spalten anf, zeilen anf + ausgegebene zeilen);
+  IF dateiende THEN
+    zeilensatz (ausgegebene zeilen) := 0;
+    freier rest := breite;
+    zeilenrest loeschen
+  ELSE
+    naechsten satz einnehmen;
+    satznummer in zeile (ausgegebene zeilen);
+    satz als zeile ausgeben
+  END IF .
+
+naechsten satz einnehmen :
+  weiter (2);
+  auf abbruch testen;
+  zeilensatz (ausgegebene zeilen) := satznummer;
+  zeilenkombi (ausgegebene zeilen) := satzkombination .
+
+auf abbruch testen :
+  IF NOT (satz ausgewaehlt OR dateiende) THEN
+    LEAVE uebersicht
+  END IF .
+
+cursor auf zeilenanfang :
+  cursor (spalten anf, zeilen anf + angezeigter satz) .
+
+aktuellen satz markieren und einnehmen :
+  WHILE zeilensatz (angezeigter satz) = 0 REP
+    angezeigter satz DECR 1
+  END REP;
+  auf uebersichtssatz (angezeigter satz);
+  cursor (spalten anf + 6, zeilen anf + angezeigter satz) .
+
+kommando interpretieren :
+  SELECT eingabezustand OF
+  CASE 1 : normales kommando interpretieren
+  CASE 2 : hop kommando interpretieren
+  CASE 3 : esc kommando interpretieren
+  END SELECT .
+
+normales kommando interpretieren :
+  SELECT pos (""3""10""1""27"+-", eingabezeichen) OF
+  CASE 1 : zeile nach oben
+  CASE 2 : zeile nach unten
+  CASE 3 : eingabezustand := 2
+  CASE 4 : eingabezustand := 3
+  CASE 5 : markieren
+  CASE 6 : demarkieren
+  OTHERWISE out (piep)
+  END SELECT .
+
+hop kommando interpretieren :
+  SELECT pos (""3""10""13"", eingabezeichen) OF
+  CASE 1 : seite nach oben
+  CASE 2 : seite nach unten
+  CASE 3 : hop return
+  OTHERWISE out (piep)
+  END SELECT;
+  eingabezustand := 1 .
+
+esc kommando interpretieren :
+  SELECT pos ("19qh?", eingabezeichen) OF
+  CASE 1 : esc 1
+  CASE 2 : esc 9
+  CASE 3, 4 : esc q
+  CASE 5 : hilfestellung
+  OTHERWISE out (piep)
+  END SELECT;
+  eingabezustand := 1 .
+
+zeile nach oben :
+  IF angezeigter satz > 1 THEN
+    angezeigter satz DECR 1;
+  ELSE
+    nach oben rollen (1);
+    ausgegebene zeilen := 1
+  END IF .
+
+zeile nach unten :
+  IF NOT dateiende THEN
+    IF angezeigter satz < laenge - 1 THEN
+      angezeigter satz INCR 1
+    ELSE
+      zeilensatz (1) := zeilensatz (2);
+      zeilenkombi (1) := zeilenkombi (2);
+      ausgegebene zeilen := 1
+    END IF
+  END IF .
+
+markieren :
+  IF NOT satz markiert THEN
+    markierung aendern;
+    IF angezeigter satz < ausgegebene zeilen THEN
+      satznummer in zeile (angezeigter satz)
+    END IF
+  END IF .
+
+demarkieren :
+  IF satz markiert THEN
+    markierung aendern;
+    IF angezeigter satz < ausgegebene zeilen THEN
+      satznummer in zeile (angezeigter satz)
+    END IF
+  END IF .
+
+seite nach oben :
+  IF angezeigter satz > 1 THEN
+    angezeigter satz := 1
+  ELSE
+    nach oben rollen (laenge - 1);
+    ausgegebene zeilen := 1
+  END IF .
+
+seite nach unten :
+  IF angezeigter satz = laenge - 1 AND NOT dateiende THEN
+    weiter (2);
+    aktueller satz wird erster;
+    ausgegebene zeilen := 1
+  ELSE
+    angezeigter satz := laenge - 1
+  END IF .
+
+hop return :
+  IF angezeigter satz <> 1 THEN
+    zeilensatz (1) := zeilensatz (angezeigter satz);
+    zeilenkombi (1) := zeilenkombi (angezeigter satz);
+    angezeigter satz := 1;
+    ausgegebene zeilen := 1
+  END IF .
+
+esc 1 :
+  auf satz (1);
+  IF NOT satz ausgewaehlt THEN
+    weiter (2)
+  END IF;
+  aktueller satz wird erster;
+  angezeigter satz := 1;
+  ausgegebene zeilen := 1 .
+
+esc 9 :
+  auf satz (32767);
+  aktueller satz wird erster;
+  nach oben rollen (laenge - 2);
+  ausgegebene zeilen := 1 .
+
+esc q :
+  LEAVE uebersicht .
+
+hilfestellung :
+  hilfe;
+  status anzeigen (uebersicht status);
+  ausgegebene zeilen := 0 .
+
+END PROC uebersicht;
+
+PROC nach oben rollen (INT CONST gerollt) :
+
+  INT VAR i;
+  auf uebersichtssatz (1);
+  FOR i FROM 1 UPTO gerollt
+  WHILE satznummer > 1 REP
+    zurueck (2)
+  END REP;
+  aktueller satz wird erster
+
+END PROC nach oben rollen;
+
+PROC auf uebersichtssatz (INT CONST zeile) :
+
+  auf satz (zeilensatz (zeile));
+  WHILE satzkombination <> zeilenkombi (zeile) REP
+    weiter (1)
+  END REP
+
+END PROC auf uebersichtssatz;
+
+PROC aktueller satz wird erster :
+
+  zeilensatz (1) := satznummer;
+  zeilenkombi (1) := satzkombination
+
+END PROC aktueller satz wird erster;
+
+BOOL PROC uebereinstimmung (INT CONST zeile) :
+
+  satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile)
+
+END PROC uebereinstimmung;
+
+PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) :
+
+  INT CONST laenge := min (freier rest, bis - von + 1);
+  outsubtext (satz, von, von + laenge - 1);
+  freier rest DECR laenge;
+  IF freier rest >= 2 THEN
+    out (", "); freier rest DECR 2
+  ELIF freier rest = 1 THEN
+    out (","); freier rest := 0
+  END IF
+
+END PROC feld bis rest;
+
+PROC satznummer in zeile (INT CONST zeile) :
+
+  cursor (spalten anf, zeilen anf + zeile);
+  IF satz markiert THEN
+    out (begin mark)
+  ELSE
+    out (blank)
+  END IF;
+  outtext (text (satznummer), 1, 5);
+  IF satz markiert THEN
+    out (end mark)
+  ELSE
+    out (blank)
+  END IF;
+  freier rest := breite - 7
+
+END PROC satznummer in zeile;
+
+PROC zeilenrest loeschen :
+
+  IF bis zeilenende THEN
+    out (cleol)
+  ELSE
+    freier rest TIMESOUT blank
+  END IF
+
+END PROC zeilenrest loeschen;
+
+PROC satz als zeile ausgeben :
+
+  IF satz ausgewaehlt THEN
+    felder ausgeben
+  ELIF dateiende THEN
+    out (t dateiende);
+    freier rest DECR length (t dateiende)
+  ELSE
+    out ("<< >>");
+    freier rest DECR 5
+  END IF;
+  zeilenrest loeschen .
+
+felder ausgeben :
+  INT VAR feldindex;
+  FOR feldindex FROM 1 UPTO length (feldnummern)
+  WHILE freier rest > 0 REP
+    feld bearbeiten (code (feldnummern SUB feldindex),
+      PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest)
+  END REP .
+
+END PROC satz als zeile ausgeben;
+
+END PACKET uebersichtsanzeige;
+
diff --git a/app/eudas/5.3/src/eudas.verarbeiten.06 b/app/eudas/5.3/src/eudas.verarbeiten.06
new file mode 100644
index 0000000..8d91407
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.verarbeiten.06
@@ -0,0 +1,745 @@
+PACKET verarbeitung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Automatische Verarbeitung von EUDAS-Dateien                       *)
+(*                                                                       *)
+(*     Version 06                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 04.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  kopiere,
+  std kopiermuster,
+  verarbeite,
+  trage,
+  eindeutige felder,
+  pruefe,
+  wertemenge,
+  feldmaske,
+  trage satz,
+  hole satz,
+  K,
+  V,
+  f,
+  wert,
+  zahltext,
+  textdarstellung :
+
+
+SATZ VAR
+  zielfeldnamen,
+  kopierfeldnamen,
+  kopiersatz;
+
+INT VAR kopierindex;
+
+BOOL VAR erstes mal;
+
+LET
+  niltext = "",
+  INTVEC = TEXT;
+
+INTVEC VAR kopiervektor;
+
+TEXT VAR zwei bytes := "  ";
+
+
+OP CAT (INTVEC VAR intvec, INT CONST zahl) :
+
+  replace (zwei bytes, 1, zahl);
+  intvec CAT zwei bytes
+
+END OP CAT;
+
+PROC std kopiermuster (TEXT CONST dateiname, FILE VAR kopiermuster) :
+
+  teste ob datei vorhanden;
+  INT VAR zielfelder;
+  dateien oeffnen;
+  feldnamen bestimmen;
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO zielfelder REP
+    feldnamen auslesen;
+    IF feld vorhanden THEN
+      direkt kopieren
+    ELSE
+      leer kopieren
+    END IF
+  END REP .
+
+dateien oeffnen :
+  output (kopiermuster);
+  EUDAT VAR eudas datei;
+  IF exists (dateiname) THEN
+    oeffne (eudas datei, dateiname)
+  END IF .
+
+feldnamen bestimmen :
+  IF exists (dateiname) CAND felderzahl (eudas datei) > 0 THEN
+    feldnamen lesen (eudas datei, zielfeldnamen);
+    zielfelder := felderzahl (eudas datei)
+  ELSE
+    quellfeldnamen kopieren;
+    zielfelder := anzahl felder
+  END IF .
+
+quellfeldnamen kopieren :
+  TEXT VAR feldname;
+  satz initialisieren (zielfeldnamen);
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldname);
+    feld aendern (zielfeldnamen, feldnr, feldname)
+  END REP .
+
+feld vorhanden :
+  feldnummer (feldname) > 0 .
+
+feldnamen auslesen :
+  feld lesen (zielfeldnamen, feldnr, feldname);
+  put (kopiermuster, textdarstellung (feldname)) .
+
+direkt kopieren :
+  write (kopiermuster, "K f(");
+  write (kopiermuster, textdarstellung (feldname));
+  putline (kopiermuster, ");") .
+
+leer kopieren :
+  putline (kopiermuster, "K """";") .
+
+END PROC std kopiermuster;
+
+PROC kopiere (TEXT CONST dateiname, FILE VAR kopiermuster) :
+
+  programmfunktion (kopieraufruf, kopiermuster) .
+
+kopieraufruf :
+  "kopiere (" + textdarstellung (dateiname) + ", " .
+
+END PROC kopiere;
+
+PROC programmfunktion (TEXT CONST aufruf, FILE VAR muster) :
+
+  programmdatei einrichten;
+  write (programm, aufruf);
+  putline (programm, "PROC programmfunktion);");
+  putline (programm, "PROC programmfunktion:");
+  muster kopieren;
+  putline (programm, "END PROC programmfunktion");
+  programm ausfuehren;
+  forget (programm datei, quiet) .
+
+programmdatei einrichten :
+  TEXT VAR programmdatei;
+  INT VAR i := 0;
+  REP
+    i INCR 1;
+    programmdatei := text (i)
+  UNTIL NOT exists (programmdatei) END REP;
+  disable stop;
+  FILE VAR programm := sequential file (output, programm datei);
+  headline (programm, erzeugtes programm) .
+
+muster kopieren :
+  TEXT VAR zeile;
+  input (muster);
+  WHILE NOT eof (muster) REP
+    getline (muster, zeile);
+    putline (programm, zeile)
+  END REP .
+
+programm ausfuehren :
+  TEXT CONST alter last param := std;
+  run (programmdatei);
+  last param (alter last param) .
+
+END PROC programm funktion;
+
+PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+  IF dateiende THEN
+    auf satz (1);
+    LEAVE kopiere
+  ELSE
+    zieldatei einrichten
+  END IF;
+
+  WHILE NOT dateiende REP
+    satz initialisieren (kopiersatz);
+    kopierindex := 1;
+    kopierfunktion;
+    evtl feldnamen einrichten;
+    satz einfuegen (eudas datei, kopiersatz);
+    weiter (eudas datei);
+    weiter (modus)
+  END REP;
+  auf satz (1) .
+
+zieldatei einrichten :
+  erstes mal := TRUE;
+  EUDAT VAR eudas datei;
+  oeffne (eudas datei, dateiname);
+  auf satz (eudas datei, saetze (eudas datei) + 1);
+  feldnamen lesen (eudas datei, kopierfeldnamen);
+  kopiervektor := niltext .
+
+evtl feldnamen einrichten :
+  IF erstes mal THEN
+    feldnamen aendern (eudas datei, kopierfeldnamen);
+    erstes mal := FALSE
+  END IF
+
+END PROC kopiere;
+
+OP K (TEXT CONST feldname, ausdruck) :
+
+  IF erstes mal THEN
+    kopiervektor erstellen;
+  END IF;
+  feld aendern (kopiersatz, kopiervektor ISUB kopierindex, ausdruck);
+  kopierindex INCR 1 .
+
+kopiervektor erstellen :
+  INT VAR aktueller index := feldindex (kopierfeldnamen, feldname);
+  IF aktueller index = 0 THEN
+    aktueller index := felderzahl (kopierfeldnamen) + 1;
+    feld aendern (kopierfeldnamen, aktueller index, feldname);
+  END IF;
+  kopiervektor CAT aktueller index .
+
+END OP K;
+
+PROC verarbeite (FILE VAR verarbeitungsmuster) :
+
+  programmfunktion ("verarbeite (", verarbeitungsmuster)
+
+END PROC verarbeite;
+
+PROC verarbeite (PROC verarbeitungsfunktion) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+
+  WHILE NOT dateiende REP
+    verarbeitungsfunktion;
+    weiter (modus)
+  END REP;
+  auf satz (1)
+
+END PROC verarbeite;
+
+OP V (TEXT CONST feldname, ausdruck) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname)
+  ELSE
+    feld aendern (nr, ausdruck)
+  END IF
+
+END OP V;
+
+PROC auf ersten satz (INT VAR modus) :
+
+  teste ob datei vorhanden;
+  auf satz (1);
+  IF markierte saetze > 0 THEN
+    modus := 3;
+    IF NOT satz markiert THEN weiter (modus) END IF
+  ELSE
+    modus := 2;
+    IF NOT satz ausgewaehlt THEN weiter (modus) END IF
+  END IF
+
+END PROC auf ersten satz;
+
+PROC teste ob datei vorhanden :
+
+  IF anzahl dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF .
+
+END PROC teste ob datei vorhanden;
+
+
+(******************************** Zugriffe *******************************)
+
+TEXT VAR
+  feldpuffer,
+  werttext;
+
+LET quote = """";
+
+
+TEXT PROC f (TEXT CONST feldname) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname);
+    feldpuffer := niltext
+  ELSE
+    feld lesen (nr, feldpuffer)
+  END IF;
+  feldpuffer
+
+END PROC f;
+
+REAL PROC wert (TEXT CONST feldname) :
+
+  INT CONST nr := feldnummer (feldname);
+  IF nr = 0 THEN
+    unbekannt (feldname);
+    0.0
+  ELSE
+    feld lesen (nr, feldpuffer);
+    REAL VAR ergebnis;
+    wert berechnen (feldpuffer, ergebnis);
+    ergebnis
+  END IF
+
+END PROC wert;
+
+REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) :
+
+  round (wert (feldname), kommastellen)
+
+END PROC wert;
+
+TEXT PROC zahltext (REAL CONST feldwert, INT CONST kommastellen) :
+
+  REAL CONST w := round (abs (feldwert), kommastellen);
+  INT VAR stellen := exponent der zahl + kommastellen + 2;
+  IF feldwert < 0.0 THEN
+    werttext := "-"
+  ELSE
+    werttext := niltext
+  END IF;
+  IF w < 1.0 AND w <> 0.0 THEN
+    werttext CAT "0";
+    stellen DECR 1
+  ENDIF;
+  werttext CAT text (w, stellen, kommastellen);
+  IF kommastellen > 0 THEN
+    change (werttext, ".", dezimalkomma)
+  ELSE
+    change (werttext, ".", niltext)
+  END IF;
+  werttext .
+
+exponent der zahl :
+  max (0, decimal exponent (w)) .
+
+END PROC zahltext;
+
+TEXT PROC zahltext (TEXT CONST feldname, INT CONST kommastellen) :
+
+  zahltext (wert (feldname), kommastellen)
+
+END PROC zahltext;
+
+TEXT PROC textdarstellung (TEXT CONST anzeigetext) :
+
+  feldpuffer := anzeigetext;
+  change all (feldpuffer, quote, quote + quote);
+  steuerzeichen umwandeln;
+  insert char (feldpuffer, quote, 1);
+  feldpuffer CAT quote;
+  feldpuffer .
+
+steuerzeichen umwandeln :
+  INT VAR stelle := 1;
+  WHILE steuerzeichen vorhanden REP
+    change (feldpuffer, stelle, stelle, steuertext)
+  END REP .
+
+steuerzeichen vorhanden :
+  stelle := pos (feldpuffer, ""0"", ""31"", stelle);
+  stelle > 0 .
+
+steuertext :
+  quote + text (code (feldpuffer SUB stelle)) + quote .
+
+END PROC textdarstellung;
+
+PROC unbekannt (TEXT CONST feldname) :
+
+  errorstop (t das feld + textdarstellung (feldname) + 
+             nicht definiert)
+
+END PROC unbekannt;
+
+
+(****************************** Tragen ***********************************)
+
+SATZ VAR tragsatz;
+
+EUDAT VAR zieldatei;
+
+LET
+  erzeugtes programm =  #501#
+    "erzeugtes Programm",
+  keine datei geoeffnet =  #502#
+    "keine Datei geoeffnet",
+  kein satz vorhanden =  #503#
+    "Kein Satz zum Tragen vorhanden",
+  falsche felderzahl =  #504#
+    "Zieldatei hat falsche Felderzahl",
+  existiert nicht =  #505#
+    " existiert nicht",
+  verletzt die pruefbedingung =  #506#
+    " verletzt die Pruefbedingung.",
+  bereits vorhanden =  #507#
+    " ist in der Zieldatei bereits vorhanden.",
+  nicht definiert =  #508#
+    " ist nicht definiert.",
+  nicht in wertemenge =  #509#
+    " ist nicht in der Wertemenge.",
+  passt nicht zu maske =  #510#
+    " stimmt nicht mit der Maske ueberein.",
+  t satz =  #511#
+    "Satz ",
+  t das feld =  #512#
+    "Das Feld ";
+
+INT VAR
+  anzahl eindeutiger felder;
+
+FILE VAR protokoll;
+
+BOOL VAR
+  testen := FALSE,
+  test erfolgreich,
+  uebereinstimmung;
+
+TEXT VAR testprogramm;
+
+
+PROC trage (TEXT CONST dateiname, FILE VAR protokoll file, BOOL CONST test) :
+
+  disable stop;
+  testen := test;
+  IF testen THEN
+    protokoll := protokoll file;
+    output (protokoll)
+  END IF;
+  trage intern (dateiname);
+  testen := FALSE
+
+END PROC trage;
+
+PROC trage intern (TEXT CONST dateiname) :
+
+  enable stop;
+  INT VAR modus;
+  auf ersten satz (modus);
+  tragen vorbereiten (dateiname);
+
+  INT VAR satzzaehler := 0;
+  REP
+    IF NOT ausgewaehlt THEN
+      weiter (modus)
+    ELSE
+      cout (satznummer + satzzaehler)
+    END IF;
+    IF dateiende THEN auf satz (1); LEAVE trage intern END IF;
+    satz testen und tragen
+  END REP .
+
+ausgewaehlt :
+  IF modus = 3 THEN satz markiert ELSE satz ausgewaehlt END IF .
+
+satz testen und tragen :
+  test erfolgreich := TRUE;
+  IF testen THEN
+    notizen lesen (zieldatei, 1, testprogramm);
+    do (testprogramm)
+  END IF;
+  IF test erfolgreich THEN
+    trage einzelsatz;
+    IF test erfolgreich THEN
+      satz loeschen;
+      satzzaehler INCR 1
+    END IF
+  END IF;
+  IF NOT test erfolgreich THEN
+    weiter (modus)
+  END IF .
+
+END PROC trage intern;
+
+PROC tragen vorbereiten (TEXT CONST dateiname) :
+
+  IF dateiende THEN
+    errorstop (kein satz vorhanden)
+  END IF;
+  oeffne (zieldatei, dateiname);
+  anzahl eindeutiger felder := 0;
+  IF felderzahl (zieldatei) = 0 THEN
+    zieldatei einrichten
+  ELIF felderzahl (zieldatei) <> anzahl felder THEN
+    errorstop (falsche felderzahl)
+  END IF;
+  auf satz (zieldatei, saetze (zieldatei) + 1) .
+
+zieldatei einrichten :
+  satz initialisieren (tragsatz, anzahl felder);
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (feldnr, feldpuffer);
+    feld aendern (tragsatz, feldnr, feldpuffer)
+  END REP;
+  feldnamen aendern (zieldatei, tragsatz);
+  feldinfo kopieren;
+  notizen kopieren .
+
+feldinfo kopieren :
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feldinfo (zieldatei, feldnr, feldinfo (feldnr))
+  END REP .
+
+notizen kopieren :
+  INT VAR i;
+  FOR i FROM 1 UPTO 3 REP
+    notizen lesen (i, feldpuffer);
+    notizen aendern (zieldatei, i, feldpuffer)
+  END REP .
+
+END PROC tragen vorbereiten;
+
+PROC trage einzelsatz :
+
+  IF anzahl eindeutiger felder > 0 CAND schon vorhanden THEN
+    protokolliere  ("", bereits vorhanden)
+  ELSE
+    tragsatz aufbauen;
+    satz einfuegen (zieldatei, tragsatz);
+    weiter (zieldatei)
+  END IF .
+
+tragsatz aufbauen :
+  satz initialisieren (tragsatz, anzahl felder);
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO anzahl felder REP
+    feld lesen (feldnr, feldpuffer);
+    feld aendern (tragsatz, feldnr, feldpuffer)
+  END REP .
+
+schon vorhanden :
+  TEXT VAR muster;
+  INT CONST alte satznummer := satznr (zieldatei);
+  feld lesen (1, muster);
+  uebereinstimmung := FALSE;
+  auf satz (zieldatei, muster);
+  WHILE NOT dateiende (zieldatei) REP
+    teste auf uebereinstimmung;
+    weiter (zieldatei, muster)
+  UNTIL uebereinstimmung END REP;
+  auf satz (zieldatei, alte satznummer);
+  uebereinstimmung .
+
+teste auf uebereinstimmung :
+  INT VAR i;
+  uebereinstimmung := TRUE;
+  FOR i FROM 2 UPTO anzahl eindeutiger felder REP
+    feld lesen (zieldatei, i, feldpuffer);
+    feld bearbeiten (i,
+      PROC (TEXT CONST, INT CONST, INT CONST) felduebereinstimmung);
+    IF NOT uebereinstimmung THEN 
+      LEAVE teste auf uebereinstimmung
+    END IF
+  END REP .
+
+END PROC trage einzelsatz;
+
+PROC felduebereinstimmung (TEXT CONST satz, INT CONST von, bis) :
+
+  IF laengen ungleich COR
+       (length (feldpuffer) > 0 CAND text ungleich) THEN
+    uebereinstimmung := FALSE
+  END IF .
+
+laengen ungleich :
+  (bis - von + 1) <> length (feldpuffer) .
+
+text ungleich :
+  pos (satz, feldpuffer, von, bis + 1) <> von .
+
+END PROC felduebereinstimmung;
+
+PROC protokolliere (TEXT CONST feld, meldung) :
+
+  IF testen THEN
+    in protokoll
+  ELSE
+    errorstop (meldung)
+  END IF .
+
+in protokoll :
+  put (protokoll, t satz); put (protokoll, satznummer);
+  IF feld <> "" THEN
+    write (protokoll, t das feld);
+    write (protokoll, textdarstellung (feld))
+  END IF;
+  putline (protokoll, meldung);
+  test erfolgreich := FALSE .
+
+END PROC protokolliere;
+
+PROC eindeutige felder (INT CONST anzahl) :
+
+  anzahl eindeutiger felder := anzahl
+
+END PROC eindeutige felder;
+
+PROC pruefe (TEXT CONST feld, BOOL CONST bedingung) :
+
+  IF NOT bedingung THEN
+    protokolliere (feld, verletzt die pruefbedingung)
+  END IF
+
+END PROC pruefe;
+
+PROC wertemenge (TEXT CONST feld, menge) :
+
+  INT CONST nr := feldnummer (feld);
+  IF nr = 0 THEN
+    protokolliere (feld, nicht definiert)
+  ELSE
+    pruefe ob enthalten
+  END IF .
+
+pruefe ob enthalten :
+  INT VAR stelle := 0;
+  LET komma = ",";
+  feld lesen (nr, feldpuffer);
+  IF ist letztes element THEN
+    LEAVE pruefe ob enthalten
+  END IF;
+  feldpuffer CAT komma;
+  REP
+    stelle := pos (menge, feldpuffer, stelle + 1);
+    IF stelle = 1 OR
+       stelle > 1 CAND (menge SUB stelle - 1) = komma THEN
+         LEAVE pruefe ob enthalten
+    END IF
+  UNTIL stelle = 0 END REP;
+  protokolliere (feld, nicht in wertemenge) .
+
+ist letztes element :
+  INT CONST letzter anfang := length (menge) - length (feldpuffer);
+  (menge SUB letzter anfang) = komma AND
+    pos (menge, feldpuffer, letzter anfang + 1) > 0 .
+
+END PROC wertemenge;
+
+PROC feldmaske (TEXT CONST feld, maske) :
+
+  INT CONST nr := feldnummer (feld);
+  IF nr = 0 THEN
+    protokolliere (feld, nicht definiert)
+  ELSE
+    feld lesen (nr, feldpuffer);
+    mit maske vergleichen
+  END IF .
+
+mit maske vergleichen :
+  INT VAR stelle;
+  TEXT CONST ende := code (length (maske) + 1);
+  TEXT VAR moegliche positionen := ""1"";
+  FOR stelle FROM 1 UPTO length (feldpuffer) REP
+    TEXT CONST zeichen := feldpuffer SUB stelle;
+    zeichen vergleichen
+  UNTIL moegliche positionen = "" END REP;
+  IF nicht erfolgreich THEN
+    protokolliere (feld, passt nicht zu maske)
+  END IF .
+
+zeichen vergleichen :
+  INT VAR moeglich := 1;
+  WHILE moeglich <= length (moegliche positionen) REP
+    INT CONST position := code (moegliche positionen SUB moeglich);
+    IF (maske SUB position) = "*" THEN
+      stern behandeln
+    ELIF vergleich trifft zu THEN
+      replace (moegliche positionen, moeglich, code (position + 1));
+      moeglich INCR 1
+    ELSE
+      delete char (moegliche positionen, moeglich)
+    END IF
+  END REP .
+
+stern behandeln :
+  IF position = length (maske) THEN
+    LEAVE feldmaske
+  END IF;
+  moeglich INCR 1;
+  IF pos (moegliche positionen, code (position + 1)) = 0 THEN
+    insert char (moegliche positionen, code (position + 1), moeglich)
+  END IF .
+
+vergleich trifft zu :
+  SELECT pos ("9XAa", maske SUB position) OF
+  CASE 1 : pos ("0123456789", zeichen) > 0
+  CASE 2 : TRUE
+  CASE 3 : pos ("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", zeichen) > 0
+  CASE 4 : pos ("abcdefghijklmnopqrstuvwxyzäöüß", zeichen) > 0
+  OTHERWISE (maske SUB position) = zeichen
+  END SELECT .
+
+nicht erfolgreich :
+  (moegliche positionen = "" COR pos (moegliche positionen, ende) = 0)
+  AND nicht gerade stern am ende .
+
+nicht gerade stern am ende :
+  (maske SUB length (maske)) <> "*" OR 
+    pos (moegliche positionen, code (length (maske))) = 0 .
+
+END PROC feldmaske;
+
+PROC trage satz (TEXT CONST dateiname) :
+
+   tragen vorbereiten (dateiname);
+   INT CONST alter satz := satznr (zieldatei);
+   trage einzelsatz;
+   satz loeschen;
+   auf satz (zieldatei, alter satz)
+
+END PROC trage satz;
+
+PROC hole satz (TEXT CONST dateiname) :
+
+  teste ob datei vorhanden;
+  IF NOT exists (dateiname) THEN
+    errorstop (textdarstellung (dateiname) + existiert nicht)
+  END IF;
+  oeffne (zieldatei, dateiname);
+  IF felderzahl (zieldatei) <> anzahl felder THEN
+    errorstop (falsche felderzahl)
+  ELIF saetze (zieldatei) = 0 THEN
+    errorstop (kein satz vorhanden)
+  END IF;
+  auf satz (zieldatei, saetze (zieldatei));
+  satz lesen (zieldatei, tragsatz);
+  tragsatz einfuegen;
+  satz loeschen (zieldatei) .
+
+tragsatz einfuegen :
+  satz einfuegen;
+  INT VAR feldnr;
+  FOR feldnr FROM 1 UPTO felderzahl (tragsatz) REP
+    feld lesen (tragsatz, feldnr, feldpuffer);
+    feld aendern (feldnr, feldpuffer)
+  END REP .
+
+END PROC hole satz;
+
+END PACKET verarbeitung;
+
diff --git a/app/eudas/5.3/src/eudas.verwaltung.11 b/app/eudas/5.3/src/eudas.verwaltung.11
new file mode 100644
index 0000000..9fc1393
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.verwaltung.11
@@ -0,0 +1,2047 @@
+PACKET datenverwaltung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Verwaltung der aktuellen EUDAS-Dateien                            *)
+(*                                                                       *)
+(*     Version 11                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 04.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  oeffne,
+  kopple,
+  kette,
+  zugriff,
+  sichere,
+  dateien loeschen,
+  auf koppeldatei,
+
+  anzahl koppeldateien,
+  anzahl dateien,
+  aendern erlaubt,
+  inhalt veraendert,
+  eudas dateiname,
+  folgedatei,
+  herkunft,
+
+  dateiversion,
+
+  anzahl felder,
+  feldnamen lesen,
+  feldnamen bearbeiten,
+  feldnummer,
+  feldinfo,
+  notizen lesen,
+  notizen aendern,
+
+  feld lesen,
+  feld bearbeiten,
+  feld aendern,
+
+  satznummer,
+  satzkombination,
+  dateiende,
+  weiter,
+  zurueck,
+  auf satz,
+
+  satz einfuegen,
+  satz loeschen,
+  aenderungen eintragen,
+
+  suchbedingung,
+  suchbedingung lesen,
+  suchbedingung loeschen,
+  suchversion,
+  satz ausgewaehlt,
+  markierung aendern,
+  satz markiert,
+  markierungen loeschen,
+  markierte saetze :
+
+
+LET
+  INTVEC = TEXT,
+
+  DATEI = STRUCT
+    (TEXT name,
+     SATZ feldnamen,
+     INTVEC koppelfelder,
+     INT anz koppelfelder,
+     INT naechste datei,
+     INT alte koppelposition,
+     TASK ursprung,
+     DATASPACE ds,
+     EUDAT eudat,
+     SATZ satzpuffer,
+     BOOL gepuffert,
+     BOOL veraendert, datei veraendert, koppelfeld veraendert,
+     TEXT muster,
+     INTVEC marksaetze,
+     INT markzeiger),
+
+  VERWEIS = STRUCT (INT datei, feld);
+ 
+LET
+  niltext = "",
+  empty intvec =  "";
+
+LET
+  maxint = 32767,
+  maxdateien = 10,
+  maxfelder = 256,
+  maxkoppeln = 32;
+
+ROW maxdateien DATEI VAR daten;
+
+INT VAR
+  anz dateien := 0,
+  anz koppeldateien := 0,
+  hauptdatei,
+  erste koppeldatei := 0,
+  felderzahl der ersten datei,
+  anz felder := 0,
+  satznummer offset,
+  kombination,
+  markierungen,
+  laufzaehler := 0;
+
+BOOL VAR
+  ende der datei := TRUE,
+  aenderungserlaubnis,
+  globales muster vorhanden;
+
+TEXT VAR globales muster;
+
+ROW maxfelder VERWEIS VAR verweis;
+
+ROW maxkoppeln VERWEIS VAR koppeln;
+
+INT VAR koppeleintraege;
+
+LET
+  zuviel dateien =  #301#
+    "Zuviel Dateien geoeffnet",
+  datei existiert nicht =  #302#
+    "Datei existiert nicht",
+  nicht im umgeschalteten zustand =  #303#
+    "Nicht moeglich, wenn auf Koppeldatei geschaltet",
+  zu viele felder =  #304#
+    "Zu viele Felder",
+  zu viele koppelfelder =  #305#
+    "Zu viele Koppelfelder",
+  keine koppelfelder =  #306#
+    "keine Koppelfelder vorhanden",
+  kein zugriff bei ketten oder koppeln =  #307#
+    "kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",
+  keine datei geoeffnet =  #308#
+    "keine Datei geoeffnet",
+  datei nicht gesichert =  #309#
+    "Datei nicht gesichert",
+  suchmuster zu umfangreich =  #310#
+    "Suchmuster zu umfangreich";
+
+TEXT VAR feldpuffer;
+
+
+(***************************** INTVEC ************************************)
+
+TEXT VAR raum fuer ein int := "  ";
+
+INTVEC VAR puffer;
+
+OP CAT (INTVEC VAR text, INT CONST wert) :
+
+  replace (raum fuer ein int, 1, wert);
+  text CAT raum fuer ein int
+
+END OP CAT;
+
+PROC insert (INTVEC VAR vector, INT CONST stelle, wert) :
+
+  INT CONST trennung := stelle + stelle - 2;
+  puffer := subtext (vector, trennung + 1);
+  vector := subtext (vector, 1, trennung);
+  vector CAT wert;
+  vector CAT puffer
+
+END PROC insert;
+
+PROC delete (INTVEC VAR vector, INT CONST stelle) :
+
+  INT CONST trennung := stelle + stelle - 2;
+  puffer := subtext (vector, trennung + 3);
+  vector := subtext (vector, 1, trennung);
+  vector CAT puffer
+
+END PROC delete;
+
+PROC inkrement (INTVEC VAR vector, INT CONST ab, um) :
+
+  INT VAR i;
+  FOR i FROM ab UPTO length (vector) DIV 2 - 1 REP
+    replace (vector, i, (vector ISUB i) + um)
+  END REP
+
+END PROC inkrement;
+
+
+(***************************** Dateien eintragen *************************)
+
+EUDAT VAR eudas datei;
+
+SATZ VAR namen;
+
+PROC datei testen (TEXT CONST dateiname) :
+
+  IF anz dateien = maxdateien THEN
+    errorstop (zuviel dateien)
+  END IF;
+  IF NOT exists (dateiname) THEN
+    errorstop (datei existiert nicht)
+  END IF;
+  IF umgeschaltet THEN
+    errorstop (nicht im umgeschalteten zustand)
+  END IF;
+  oeffne (eudas datei, dateiname)
+
+END PROC datei testen;
+
+PROC datei eintragen (DATEI VAR datei, TEXT CONST dateiname,
+                      TASK CONST manager) :
+
+  IF aenderungserlaubnis OR NOT is niltask (manager) THEN
+    datei. ds := old (dateiname);
+    oeffne (datei. eudat, datei. ds);
+    IF NOT aenderungserlaubnis THEN forget (dateiname, quiet) END IF
+  ELSE
+    oeffne (datei. eudat, dateiname)
+  END IF;
+  datei. ursprung := manager;
+  datei. naechste datei := 0;
+  datei. veraendert := FALSE;
+  datei. datei veraendert := FALSE;
+  datei. name := dateiname;
+  mark loeschen (datei)
+
+END PROC datei eintragen;
+
+PROC in dateikette (INT CONST anfang) :
+
+  INT VAR dateiindex := anfang;
+  WHILE daten (dateiindex). naechste datei <> 0 REP
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  daten (dateiindex). naechste datei := anz dateien
+
+END PROC in dateikette;
+
+PROC anfangsposition einnehmen :
+
+  IF dateiende (daten (1). eudat) THEN
+    auf satz (1)
+  ELSE
+    auf satz (satznr (daten (1). eudat))
+  END IF
+
+END PROC anfangsposition einnehmen;
+
+PROC felder anlegen :
+
+  felderzahl der ersten datei := felderzahl (daten (1). eudat);
+  anz felder := felderzahl der ersten datei;
+  feldnamen lesen (daten (1). eudat, daten (1). feldnamen);
+  koppeleintraege := 0;
+  INT VAR i;
+  FOR i FROM 1 UPTO anz felder REP
+    verweis (i). datei := 0
+  END REP
+
+END PROC felder anlegen;
+
+PROC laufzaehler erhoehen :
+
+  laufzaehler INCR 1;
+  IF laufzaehler > 32000 THEN
+    laufzaehler := - 32000
+  END IF
+
+END PROC laufzaehler erhoehen;
+
+PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern) :
+
+  oeffne (dateiname, auch aendern, niltask)
+
+END PROC oeffne;
+
+PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern,
+             TASK CONST manager) :
+
+  enable stop;
+  dateien loeschen (FALSE);
+  suchbedingung loeschen;
+  datei testen (dateiname);
+  aenderungserlaubnis := auch aendern;
+  status setzen;
+  datei eintragen (daten (anz dateien), dateiname, manager);
+  anfangsposition einnehmen;
+  felder anlegen .
+
+status setzen :
+  anz dateien := 1;
+  laufzaehler erhoehen;
+  markierungen := 0 .
+
+END PROC oeffne;
+
+PROC kopple (TEXT CONST dateiname) :
+
+  kopple (dateiname, niltask)
+
+END PROC kopple;
+
+PROC kopple (TEXT CONST dateiname, TASK CONST manager) :
+
+  enable stop;
+  IF anz dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  datei testen (dateiname);
+  koppelfelder bestimmen;
+  platz in feldtabellen belegen;
+  in kette der koppeldateien einfuegen;
+  datei eintragen (daten (anz dateien), dateiname, manager);
+  koppelstatus setzen .
+
+koppelfelder bestimmen :
+  feldnamen lesen (eudas datei, namen);
+  INT VAR koppelfelder := 0;
+  INTVEC VAR koppelfeldnr := empty intvec;
+  WHILE koppelfelder < felderzahl (eudas datei) REP
+    feld lesen (namen, koppelfelder + 1, feldpuffer);
+    INT CONST index := feldindex (daten (1). feldnamen, feldpuffer);
+    IF index > 0 THEN
+      koppelfelder INCR 1;
+      koppelfeldnr CAT index
+    END IF
+  UNTIL index = 0 END REP .
+
+platz in feldtabellen belegen :
+  IF anz felder + felderzahl (eudas datei) - koppelfelder > maxfelder THEN
+    errorstop (zu viele felder)
+  ELIF koppeleintraege + koppelfelder > maxkoppeln THEN
+    errorstop (zu viele koppelfelder)
+  ELIF koppelfelder = 0 THEN
+    errorstop (keine koppelfelder)
+  END IF;
+  anz dateien INCR 1;
+  daten (anz dateien). feldnamen := namen;
+  daten (anz dateien). koppelfelder := koppelfeldnr;
+  daten (anz dateien). anz koppelfelder := koppelfelder;
+  INT VAR feldnr := koppelfelder;
+  WHILE feldnr < felderzahl (eudas datei) REP
+    anz felder INCR 1; feldnr INCR 1;
+    verweis (anz felder). datei := anz dateien;
+    verweis (anz felder). feld := feldnr
+  END REP;
+  FOR feldnr FROM 1 UPTO koppelfelder REP
+    koppelfeld eintragen
+  END REP .
+
+koppelfeld eintragen :
+  INT CONST koppelfeld := koppelfeldnr ISUB feldnr;
+  IF verweis (koppelfeld). datei = 0 THEN
+    neues koppelfeld eintragen
+  ELSE
+    alten eintrag erweitern
+  END IF .
+
+neues koppelfeld eintragen :
+  koppeleintraege INCR 1;
+  koppeln (koppeleintraege). datei := anz dateien;
+  koppeln (koppeleintraege). feld := feldnr;
+  verweis (koppelfeld). datei := koppeleintraege;
+  verweis (koppelfeld). feld := 1 .
+
+alten eintrag erweitern :
+  INT CONST eintragposition :=
+    verweis (koppelfeld). datei + verweis (koppelfeld). feld;
+  folgende eintraege hochschieben;
+  verweis (koppelfeld). feld INCR 1;
+  koppeln (eintragposition). datei := anz dateien;
+  koppeln (eintragposition). feld := feldnr .
+
+folgende eintraege hochschieben :
+  INT VAR eintrag;
+  FOR eintrag FROM koppeleintraege DOWNTO eintragposition REP
+    koppeln (eintrag + 1) := koppeln (eintrag)
+  END REP;
+  koppeleintraege INCR 1;
+  FOR eintrag FROM 1 UPTO felderzahl der ersten datei REP
+    IF verweis (eintrag). datei >= eintragposition THEN
+      verweis (eintrag). datei INCR 1
+    END IF
+  END REP .
+
+in kette der koppeldateien einfuegen :
+  anz koppeldateien INCR 1;
+  IF erste koppeldatei = 0 THEN
+    erste koppeldatei := anz dateien
+  ELSE
+    in dateikette (erste koppeldatei)
+  END IF .
+
+koppelstatus setzen :
+  laufzaehler erhoehen;
+  daten (anz dateien). gepuffert := FALSE;
+  daten (anz dateien). koppelfeld veraendert := FALSE;
+  daten (anz dateien). alte koppelposition := satznr (eudas datei);
+  koppeldatei aktualisieren (daten (anz dateien)) .
+
+END PROC kopple;
+
+PROC kette (TEXT CONST dateiname) :
+
+  kette (dateiname, niltask)
+
+END PROC kette;
+
+PROC kette (TEXT CONST dateiname, TASK CONST manager) :
+
+  enable stop;
+  IF anz dateien = 0 THEN
+    errorstop (keine datei geoeffnet)
+  END IF;
+  datei testen (dateiname);
+  anz dateien INCR 1;
+  datei eintragen (daten (anz dateien), dateiname, manager);
+  in dateikette (1);
+  IF ende der datei THEN auf satz (satznummer) END IF
+
+END PROC kette;
+
+PROC zugriff (PROC (EUDAT VAR) bearbeitung) :
+
+  IF anz dateien > 1 OR umgeschaltet THEN
+    errorstop (kein zugriff bei ketten oder koppeln)
+  ELSE
+    aenderungen eintragen;
+    bearbeitung (daten (1). eudat);
+    laufzaehler erhoehen;
+    anfangsposition einnehmen;
+    felder anlegen;
+    daten (1). datei veraendert := TRUE
+  ENDIF
+
+END PROC zugriff;
+
+PROC sichere (INT CONST dateinummer, TEXT CONST dateiname) :
+
+  aenderungen eintragen;
+  notizen aendern (daten (dateinummer). eudat, 2, date);
+  IF aenderungserlaubnis THEN
+    forget (dateiname, quiet);
+    copy (daten (dateinummer). ds, dateiname)
+  END IF;
+  daten (dateinummer). datei veraendert := FALSE
+
+END PROC sichere;
+
+PROC dateien loeschen (BOOL CONST auch geaenderte) :
+
+  aenderungen eintragen;
+  IF umgeschaltet THEN auf koppeldatei (0) END IF;
+  kontrollvariablen loeschen;
+  dateien einzeln loeschen .
+
+kontrollvariablen loeschen :
+  anz koppeldateien := 0;
+  erste koppeldatei := 0;
+  daten (1). naechste datei := 0;
+  anz felder := 0;
+  ende der datei := TRUE .
+
+dateien einzeln loeschen :
+  WHILE anz dateien > 0 REP
+    IF wirklich veraendert AND NOT auch geaenderte THEN
+      errorstop (datei nicht gesichert);
+      LEAVE dateien loeschen
+    END IF;
+    forget (daten (anz dateien). ds);
+    anz dateien DECR 1
+  END REP .
+
+wirklich veraendert :
+  aenderungserlaubnis AND daten (anz dateien). datei veraendert .
+
+END PROC dateien loeschen;
+
+
+(*********************** Umschalten Koppeldatei **************************)
+
+INT VAR
+  save hauptdatei,
+  save felderzahl der ersten datei,
+  save anz felder,
+  save satznummer offset,
+  save kombination,
+  save markierungen,
+  save erste koppeldatei,
+  save naechste koppeldatei;
+
+BOOL VAR
+  save globales muster vorhanden;
+
+INTVEC VAR
+  save oder anfang;
+
+SATZ VAR
+  save muster gespeichert;
+
+
+BOOL VAR
+  umgeschaltet := FALSE;
+
+INT VAR
+  anzahl hauptmuster := 0,
+  feldnamendatei := 1;
+
+
+BOOL PROC auf koppeldatei :
+
+  umgeschaltet
+
+END PROC auf koppeldatei;
+
+PROC auf koppeldatei (INT CONST nr) :
+
+  disable stop;
+  laufzaehler erhoehen;
+  IF umgeschaltet THEN
+    alte variablen wiederherstellen;
+    umgeschaltet := FALSE;
+    ggf koppelfelder uebernehmen;
+    fuer korrekten zustand sorgen
+  ELSE
+    alte variablen sichern;
+    umgeschaltet := TRUE;
+    neuen zustand herstellen
+  END IF .
+
+alte variablen wiederherstellen :
+  hauptdatei := save hauptdatei;
+  felderzahl der ersten datei := save felderzahl der ersten datei;
+  anz felder := save anz felder;
+  satznummer offset := save satznummer offset;
+  markierungen := save markierungen;
+  erste koppeldatei := save erste koppeldatei;
+  daten (feldnamendatei). naechste datei := save naechste koppeldatei;
+  anzahl muster := anzahl hauptmuster;
+  globales muster vorhanden := save globales muster vorhanden;
+  oder anfang := save oder anfang;
+  muster gespeichert := save muster gespeichert;
+  IF anzahl muster > 0 THEN
+    erster musterindex := 1
+  ELSE
+    erster musterindex := -1
+  END IF .
+
+fuer korrekten zustand sorgen :
+  anzahl hauptmuster := 0;
+  feldnamendatei := 1;
+  enable stop;
+  auf satz (satznummer);
+  WHILE kombination <> save kombination REP
+    weiter (1)
+  END REP .
+
+ggf koppelfelder uebernehmen :
+  daten (feldnamendatei). alte koppelposition :=
+    satznr (daten (feldnamendatei). eudat);
+  IF nr = 1 AND NOT dateiende (daten (hauptdatei). eudat) THEN
+    alle koppelfelder in hauptdatei uebernehmen
+  END IF .
+
+alle koppelfelder in hauptdatei uebernehmen :
+  INT VAR koppel nr;
+  FOR koppel nr FROM 1 UPTO daten (feldnamendatei). anz koppelfelder REP
+    feld aendern (daten (hauptdatei). eudat, feld nr koppelfeld,
+                  feldinhalt koppelfeld)
+  END REP;
+  save kombination := 1 .
+
+feld nr koppelfeld :
+  daten (feldnamendatei). koppelfelder ISUB koppel nr .
+
+feldinhalt koppelfeld :
+  feld lesen (daten (feldnamendatei). eudat, koppel nr, feldpuffer);
+  feldpuffer .
+
+alte variablen sichern :
+  save hauptdatei := hauptdatei;
+  save felderzahl der ersten datei := felderzahl der ersten datei;
+  save anz felder := anz felder;
+  save satznummer offset := satznummer offset;
+  save kombination := kombination;
+  save markierungen := markierungen;
+  save erste koppeldatei := erste koppeldatei;
+  save naechste koppeldatei := daten (nr). naechste datei;
+  save globales muster vorhanden := globales muster vorhanden;
+  save oder anfang := oder anfang;
+  save muster gespeichert := muster gespeichert .
+
+neuen zustand herstellen :
+  hauptdatei := nr;
+  anzahl hauptmuster := anzahl muster;
+  feldnamendatei := nr;
+  felderzahl der ersten datei := felderzahl (daten (nr). eudat);
+  anz felder := felderzahl der ersten datei;
+  satznummer offset := 0;
+  markierungen := (length (daten (nr). marksaetze) - 1) DIV 2;
+  erste koppeldatei := 0;
+  daten (nr). naechste datei := 0;
+  suchbedingung loeschen;
+  auf satz (daten (nr). alte koppelposition) .
+
+END PROC auf koppeldatei;
+
+
+(************************** Dateiabfragen ********************************)
+
+INT PROC anzahl koppeldateien :
+
+  anz koppeldateien
+
+END PROC anzahl koppeldateien;
+
+INT PROC anzahl dateien :
+
+  anz dateien
+
+END PROC anzahl dateien;
+
+BOOL PROC aendern erlaubt :
+
+  aenderungserlaubnis
+
+END PROC aendern erlaubt;
+
+BOOL PROC inhalt veraendert (INT CONST dateinr) :
+
+  aenderungen eintragen;
+  daten (dateinr). datei veraendert
+
+END PROC inhalt veraendert;
+
+TEXT PROC eudas dateiname (INT CONST dateinr) :
+
+  daten (dateinr). name
+
+END PROC eudas dateiname;
+
+INT PROC folgedatei (INT CONST dateinr) :
+
+  IF dateinr = 0 THEN
+    erste koppeldatei
+  ELSE
+    daten (dateinr). naechste datei
+  END IF
+
+END PROC folgedatei;
+
+TASK PROC herkunft (INT CONST dateinr) :
+
+  daten (dateinr). ursprung
+
+END PROC herkunft;
+
+
+(*************************** Dateiversion ********************************)
+
+(* Die Dateiversion wird bei jedem neuen 'oeffne' hochgezaehlt. Sie      *)
+(* dient dazu, ein neues 'oeffne' festzustellen, um eventuell als        *)
+(* Optimierung gespeicherte Daten als ungueltig zu kennzeichnen.         *)
+
+INT PROC dateiversion :
+
+  laufzaehler
+
+END PROC dateiversion;
+
+
+(******************************* Felder **********************************)
+
+INT PROC anzahl felder :
+
+  anz felder
+
+END PROC anzahl felder;
+
+PROC feldnamen lesen (INT CONST feldnr, TEXT VAR name) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld lesen (daten (feldnamendatei). feldnamen, feldnr, name)
+  ELSE
+    feld lesen (dateiverweis, feldverweis, name)
+  END IF .
+
+dateiverweis :
+  daten (verweis (feldnr). datei). feldnamen .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldnamen lesen;
+
+PROC feldnamen bearbeiten (INT CONST feldnr,
+     PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld bearbeiten (daten (feldnamendatei). feldnamen, feldnr,
+              PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    feld bearbeiten (dateiverweis, feldverweis,
+              PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  END IF .
+
+dateiverweis :
+  daten (verweis (feldnr). datei). feldnamen .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldnamen bearbeiten;
+
+INT PROC feldnummer (TEXT CONST feldname) :
+
+  INT VAR 
+    offset := felderzahl der ersten datei,
+    nr := feldindex (daten (feldnamendatei). feldnamen, feldname),
+    dateiindex := erste koppeldatei;
+  WHILE nr = 0 AND dateiindex <> 0 REP
+    nr := feldindex (daten (dateiindex). feldnamen, feldname);
+    offset oder nr erhoehen;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  nr .
+
+offset oder nr erhoehen :
+  INT CONST zahl der koppelfelder := daten (dateiindex). anz koppelfelder;
+  IF nr = 0 THEN
+    offset INCR felderzahl (daten (dateiindex). eudat);
+    offset DECR zahl der koppelfelder
+  ELSE
+    nr INCR offset;
+    nr DECR zahl der koppelfelder
+  END IF .
+
+END PROC feldnummer;
+
+INT PROC feldinfo (INT CONST feldnr) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feldinfo (daten (feldnamendatei). eudat, feldnr)
+  ELSE
+    feldinfo (daten (dateiverweis). eudat, feldverweis)
+  END IF .
+
+dateiverweis :
+  verweis (feldnr). datei .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feldinfo;
+
+PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) :
+
+  notizen lesen (daten (feldnamendatei). eudat, nr, inhalt)
+
+END PROC notizen lesen;
+
+PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) :
+
+  notizen aendern (daten (feldnamendatei). eudat, nr, inhalt);
+  daten (feldnamendatei). datei veraendert := TRUE
+
+END PROC notizen aendern;
+
+
+(*************************** Feldzugriffe ********************************)
+
+PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld lesen (daten (hauptdatei). eudat, feldnr, inhalt)
+  ELSE
+    in koppeldatei lesen
+  END IF .
+
+in koppeldatei lesen :
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF daten (dateiverweis). gepuffert THEN
+    feld lesen (daten (dateiverweis). satzpuffer, feldverweis, inhalt)
+  ELSE
+    feld lesen (daten (dateiverweis). eudat, feldverweis, inhalt)
+  END IF .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feld lesen;
+
+PROC feld bearbeiten (INT CONST feldnr,
+          PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) :
+
+  IF feldnr <= felderzahl der ersten datei THEN
+    feld bearbeiten (daten (hauptdatei). eudat, feldnr,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    in koppeldatei bearbeiten
+  END IF .
+
+in koppeldatei bearbeiten :
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF daten (dateiverweis). gepuffert THEN
+    feld bearbeiten (daten (dateiverweis). satzpuffer, feldverweis,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  ELSE
+    feld bearbeiten (daten (dateiverweis). eudat, feldverweis,
+         PROC (TEXT CONST, INT CONST, INT CONST) bearbeite)
+  END IF .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+END PROC feld bearbeiten;
+
+PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) :
+
+  INT CONST dateiverweis := verweis (feldnr). datei;
+  IF feldnr <= felderzahl der ersten datei THEN
+    in hauptdatei aendern
+  ELSE
+    in koppeldatei aendern
+  END IF .
+
+in hauptdatei aendern :
+  daten (hauptdatei). datei veraendert := TRUE;
+  IF ist koppelfeld CAND wirklich veraenderung THEN
+    weitere dateien aktualisieren
+  END IF;
+  feld aendern (daten (hauptdatei). eudat, feldnr, inhalt) .
+
+ist koppelfeld :
+  NOT umgeschaltet CAND dateiverweis > 0 .
+
+wirklich veraenderung :
+  feld lesen (daten (hauptdatei). eudat, feldnr, feldpuffer);
+  feldpuffer <> inhalt .
+
+weitere dateien aktualisieren :
+  INT VAR
+    koppelzaehler := feldverweis,
+    koppelverweis := dateiverweis;
+  REP 
+    satzpuffer aktualisieren (daten (koppeldatei));
+    daten (koppeldatei). koppelfeld veraendert := TRUE;
+    feld aendern (daten (koppeldatei). satzpuffer, koppelfeld, inhalt);
+    koppelverweis INCR 1;
+    koppelzaehler DECR 1
+  UNTIL koppelzaehler = 0 END REP .
+
+in koppeldatei aendern :
+  satzpuffer aktualisieren (daten (dateiverweis));
+  IF koppeldatei wirklich veraendert THEN
+    daten (dateiverweis). veraendert := TRUE;
+    feld aendern (daten (dateiverweis). satzpuffer, feldverweis, inhalt)
+  END IF .
+
+koppeldatei wirklich veraendert :
+  feld lesen (daten (dateiverweis). satzpuffer, feldverweis, feldpuffer);
+  feldpuffer <> inhalt .
+
+feldverweis :
+  verweis (feldnr). feld .
+
+koppeldatei :
+  koppeln (koppelverweis). datei .
+
+koppelfeld :
+  koppeln (koppelverweis). feld .
+
+END PROC feld aendern;
+
+PROC satzpuffer aktualisieren (DATEI VAR datei) :
+
+  IF NOT datei. gepuffert THEN
+    datei. gepuffert := TRUE;
+    satzpuffer lesen
+  END IF .
+
+satzpuffer lesen :
+  IF dateiende (datei. eudat) THEN
+    satz initialisieren (datei. satzpuffer, datei. anz koppelfelder);
+    koppelfelder in satzpuffer schreiben
+  ELSE
+    satz lesen (datei. eudat, datei. satzpuffer)
+  END IF .
+
+koppelfelder in satzpuffer schreiben :
+  INT VAR i;
+  FOR i FROM 1 UPTO datei. anz koppelfelder REP
+    feld lesen (datei. koppelfelder ISUB i, feldpuffer);
+    feld aendern (datei. satzpuffer, i, feldpuffer)
+  END REP .
+
+END PROC satzpuffer aktualisieren;
+
+PROC koppeldatei aktualisieren (DATEI VAR datei) :
+
+  muster lesen;
+  koppeldatei positionieren .
+
+muster lesen :
+  feld lesen (daten (hauptdatei). eudat, musterfeld, muster) .
+
+musterfeld :
+  datei. koppelfelder ISUB 1 .
+
+muster :
+  datei. muster .
+
+koppeldatei positionieren :
+  auf satz (datei. eudat, muster);
+  WHILE NOT koppelfelder gleich (datei) REP
+    weiter (datei. eudat, muster)
+  END REP;
+  IF dateiende (datei. eudat) THEN
+    satzpuffer aktualisieren (datei)
+  ELSE
+    datei. gepuffert := FALSE
+  END IF .
+
+END PROC koppeldatei aktualisieren;
+
+PROC koppeldateien aktualisieren :
+
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    koppeldatei aktualisieren (daten (dateiindex));
+    dateiindex := daten (dateiindex). naechste datei
+  END REP;
+  kombination := 1
+
+END PROC koppeldateien aktualisieren;
+
+BOOL PROC koppelfelder gleich (DATEI CONST datei) :
+
+  IF NOT dateiende (datei. eudat) THEN
+    koppelfelder vergleichen
+  END IF;
+  TRUE .
+
+koppelfelder vergleichen :
+  INT VAR koppelindex;
+  FOR koppelindex FROM 2 UPTO datei. anz koppelfelder REP
+    feld lesen (daten (hauptdatei). eudat, koppelfelder ISUB koppelindex,
+                feldpuffer);
+    feld bearbeiten (datei. eudat, koppelindex,
+         PROC (TEXT CONST, INT CONST, INT CONST) feld vergleichen);
+    IF NOT vergleich erfolgreich THEN
+      LEAVE koppelfelder gleich WITH FALSE
+    END IF
+  END REP .
+
+koppelfelder :
+  datei. koppelfelder .
+
+END PROC koppelfelder gleich;
+
+BOOL VAR vergleich erfolgreich;
+
+PROC feld vergleichen (TEXT CONST satz, INT CONST anfang, ende) :
+
+  vergleich erfolgreich := length (feldpuffer) + anfang = ende + 1 CAND
+            pos (satz, feldpuffer, anfang, ende + 1) = anfang
+
+END PROC feld vergleichen;
+
+
+(**************************** Anhalten ***********************************)
+
+LET
+  halt error = 22101,
+  halt zeichen = "h",
+  esc = ""27"";
+
+BOOL VAR esc zustand;
+
+
+PROC halt abfrage starten :
+
+  TEXT VAR z;
+  esc zustand := FALSE;
+  REP
+    z := incharety; type (z)
+  UNTIL z = niltext END REP
+
+END PROC halt abfrage starten;
+
+PROC halt abfrage beenden :
+
+  IF esc zustand THEN
+    type (esc)
+  END IF
+
+END PROC halt abfrage beenden;
+
+BOOL PROC angehalten :
+
+  TEXT VAR z;
+  REP
+    z := incharety;
+    IF z = niltext THEN
+      LEAVE angehalten WITH FALSE
+    ELSE
+      zeichen behandeln
+    END IF
+  END REP;
+  FALSE .
+
+zeichen behandeln :
+  IF esc zustand THEN
+    esc zustand := FALSE;
+    auf halt zeichen testen
+  ELSE
+    auf esc testen
+  END IF .
+
+auf halt zeichen testen :
+  IF z = halt zeichen THEN
+    tastenpuffer loeschen;
+    errorstop (halt error, niltext);
+    LEAVE angehalten WITH TRUE
+  ELSE
+    type (esc); type (z)
+  END IF .
+
+auf esc testen :
+  IF z = esc THEN
+    esc zustand := TRUE
+  ELSE
+    type (z)
+  END IF .
+
+tastenpuffer loeschen :
+  REP UNTIL getcharety = niltext END REP .
+
+END PROC angehalten;
+
+
+(************************** Positionieren ********************************)
+
+PROC weiter (INT CONST modus) :
+
+  IF NOT ende der datei THEN
+    aenderungen eintragen;
+    nach modus weiter gehen
+  END IF .
+
+nach modus weitergehen :
+  SELECT modus OF
+  CASE 1 : einen satz weiter
+  CASE 2 : weiter bis ausgewaehlt
+  CASE 3 : weiter bis markiert
+  END SELECT .
+
+einen satz weiter :
+  weiter gehen (FALSE) .
+
+weiter bis ausgewaehlt :
+  halt abfrage starten;
+  REP
+    weiter gehen (globales muster vorhanden);
+    cout (satznummer)
+  UNTIL satz ausgewaehlt OR ende der datei OR angehalten END REP;
+  halt abfrage beenden .
+
+weiter bis markiert :
+  INT VAR satzpos := satznr (daten (hauptdatei). eudat);
+  WHILE kein markierter satz mehr AND naechste datei <> 0 REP
+    eine datei weiter;
+    satzpos := 1
+  END REP;
+  auf satz (daten (hauptdatei). eudat, naechster markierter satz);
+  cout (satznummer);
+  koppeldateien aktualisieren;
+  ende der datei := dateiende (daten (hauptdatei). eudat);
+  suchbedingung auswerten .
+
+kein markierter satz mehr :
+  mark stelle (daten (hauptdatei), satzpos + 1);
+  INT CONST naechster markierter satz :=
+    daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger;
+  naechster markierter satz = maxint .
+
+naechste datei :
+  daten (hauptdatei). naechste datei .
+
+END PROC weiter;
+
+PROC zurueck (INT CONST modus) :
+
+  IF satznummer > 1 THEN
+    aenderungen eintragen;
+    nach modus zurueckgehen
+  END IF .
+
+nach modus zurueckgehen :
+  SELECT modus OF
+  CASE 1 : einen satz zurueck
+  CASE 2 : zurueck bis ausgewaehlt
+  CASE 3 : zurueck bis markiert
+  END SELECT .
+
+einen satz zurueck :
+  zurueck gehen (FALSE) .
+
+zurueck bis ausgewaehlt :
+  halt abfrage starten;
+  REP
+    zurueck gehen (globales muster vorhanden);
+    cout (satznummer)
+  UNTIL satz ausgewaehlt OR satznummer = 1 OR angehalten END REP;
+  halt abfrage beenden .
+
+zurueck bis markiert :
+  INT VAR satzpos := satznr (daten (hauptdatei). eudat);
+  WHILE kein markierter satz mehr AND hauptdatei <> 1 REP
+    eine datei zurueck;
+    satzpos := maxint - 1
+  END REP;
+  auf satz (daten (hauptdatei). eudat, neuer satz);
+  cout (satznummer);
+  koppeldateien aktualisieren;
+  ende der datei := FALSE;
+  suchbedingung auswerten .
+
+kein markierter satz mehr :
+  INT VAR neuer satz;
+  mark stelle (daten (hauptdatei), satzpos);
+  IF daten (hauptdatei). markzeiger = 1 THEN
+    neuer satz := 1;
+    TRUE
+  ELSE
+    neuer satz := daten (hauptdatei). marksaetze ISUB
+                  (daten (hauptdatei). markzeiger - 1);
+    FALSE
+  END IF .
+
+END PROC zurueck;
+
+PROC weiter gehen (BOOL CONST muster vorgegeben) :
+
+  neue kombination suchen;
+  IF keine kombination mehr THEN
+    einen satz weiter;
+    koppeldateien aktualisieren
+  ELSE
+    kombination INCR 1
+  END IF;
+  suchbedingung auswerten .
+
+neue kombination suchen :
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex > 0 REP
+    in koppeldatei weitergehen;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+in koppeldatei weitergehen :
+  BOOL VAR match gefunden;
+  kombination suchen (daten (dateiindex), match gefunden);
+  IF match gefunden THEN
+    LEAVE neue kombination suchen
+  END IF .
+
+keine kombination mehr :
+  dateiindex = 0 .
+
+einen satz weiter :
+  IF muster vorgegeben THEN
+    weiter (daten (hauptdatei). eudat, globales muster)
+  ELSE
+    weiter (daten (hauptdatei). eudat)
+  END IF;
+  WHILE dateiende (daten (hauptdatei). eudat) REP
+    auf naechste datei
+  UNTIL ende der datei END REP .
+
+auf naechste datei :
+  IF daten (hauptdatei). naechste datei <> 0 THEN
+    eine datei weiter;
+    auf ersten satz der naechsten datei
+  ELSE
+    ende der datei := TRUE
+  END IF .
+
+auf ersten satz der naechsten datei :
+  auf satz (daten (hauptdatei). eudat, 1) .
+
+END PROC weiter gehen;
+
+PROC kombination suchen (DATEI VAR datei, BOOL VAR match gefunden) :
+
+  IF dateiende (datei. eudat) THEN
+    match gefunden := FALSE
+  ELSE
+    in datei weitergehen
+  END IF .
+
+in datei weitergehen :
+  match gefunden := TRUE;
+  REP
+    weiter (datei. eudat, datei. muster);
+    IF dateiende (datei. eudat) THEN
+      match gefunden := FALSE;
+      auf satz (datei. eudat, datei. muster)
+    END IF
+  UNTIL koppelfelder gleich (datei) END REP .
+
+END PROC kombination suchen;
+
+PROC zurueck gehen (BOOL CONST muster vorgegeben) :
+
+  WHILE satznr (daten (hauptdatei). eudat) = 1 CAND satznummer > 1 REP
+    eine datei zurueck;
+    auf dateiende (daten (hauptdatei). eudat)
+  END REP;
+  IF muster vorgegeben THEN
+    zurueck (daten (hauptdatei). eudat, globales muster)
+  ELSE
+    zurueck (daten (hauptdatei). eudat)
+  END IF;
+  ende der datei := FALSE;
+  koppeldateien aktualisieren;
+  suchbedingung auswerten
+
+END PROC zurueck gehen;
+
+PROC eine datei weiter :
+
+  satznummer offset INCR saetze (daten (hauptdatei). eudat);
+  hauptdatei := daten (hauptdatei). naechste datei
+
+END PROC eine datei weiter;
+
+PROC eine datei zurueck :
+
+  INT VAR neuer index := 1;
+  WHILE daten (neuer index). naechste datei <> hauptdatei REP
+    neuer index := daten (neuer index). naechste datei
+  END REP;
+  satznummer offset DECR saetze (daten (neuer index). eudat);
+  hauptdatei := neuer index
+
+END PROC eine datei zurueck;
+
+PROC aenderungen eintragen :
+
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    koppeldatei betrachten;
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+koppeldatei betrachten :
+  IF daten (dateiindex). gepuffert THEN
+    datei aktualisieren (daten (dateiindex))
+  END IF .
+
+END PROC aenderungen eintragen;
+
+PROC datei aktualisieren (DATEI VAR datei) :
+
+  IF alter satz geaendert AND NOT koppelfelder veraendert THEN
+    satz in koppeldatei aendern
+  ELIF nicht nur koppelfelder belegt AND irgendwas veraendert THEN
+    neuen satz in koppeldatei einfuegen
+  ELIF koppelfelder veraendert THEN
+    koppeldatei aktualisieren (datei)
+  END IF;
+  puffer deaktivieren;
+  veraendert := FALSE;
+  koppelfelder veraendert := FALSE .
+
+alter satz geaendert :
+  NOT dateiende (datei. eudat) AND veraendert .
+
+nicht nur koppelfelder belegt :
+  felderzahl (satzpuffer) > datei. anz koppelfelder .
+
+irgendwas veraendert :
+  koppelfelder veraendert OR veraendert .
+
+neuen satz in koppeldatei einfuegen :
+  datei veraendert := TRUE;
+  feld lesen (satzpuffer, 1, datei. muster);
+  satz einfuegen (datei. eudat, satzpuffer) .
+
+puffer deaktivieren :
+  datei. gepuffert := FALSE .
+
+satz in koppeldatei aendern :
+  datei veraendert := TRUE;
+  satz aendern (datei. eudat, satzpuffer) .
+
+veraendert :
+  datei. veraendert .
+
+koppelfelder veraendert :
+  datei. koppelfeld veraendert .
+
+satzpuffer :
+  datei. satzpuffer .
+
+datei veraendert :
+  datei. datei veraendert .
+
+END PROC datei aktualisieren;
+
+PROC auf dateiende (EUDAT VAR eudat) :
+
+  auf satz (eudat, saetze (eudat) + 1)
+
+END PROC auf dateiende;
+
+PROC auf satz (INT CONST satznr) :
+
+  aenderungen eintragen;
+  hauptdatei := feldnamendatei;
+  satznummer offset := 0;
+  WHILE ueber datei hinaus AND noch weitere datei REP
+    eine datei weiter
+  END REP;
+  auf satz (daten (hauptdatei). eudat, satznr - satznummer offset);
+  koppeldateien aktualisieren;
+  ende der datei := dateiende (daten (hauptdatei). eudat);
+  suchbedingung auswerten .
+
+ueber datei hinaus :
+  satznr - satznummer offset > saetze (daten (hauptdatei). eudat) .
+
+noch weitere datei :
+  daten (hauptdatei). naechste datei <> 0 .
+
+END PROC auf satz;
+
+PROC auf satz (TEXT CONST schluesseltext) :
+
+  aenderungen eintragen;
+  auf satz intern (schluesseltext, ende der datei);
+  koppeldateien aktualisieren;
+  suchbedingung auswerten
+
+END PROC auf satz;
+
+PROC auf satz intern (TEXT CONST schluesseltext, BOOL CONST am ende) :
+
+  IF am ende THEN auf satz (1) END IF;
+  REP
+    auf satz (daten (hauptdatei). eudat, schluesseltext);
+    IF NOT dateiende (daten (hauptdatei). eudat) THEN
+      ende der datei := FALSE;
+      LEAVE auf satz intern
+    ELIF daten (hauptdatei). naechste datei = 0 THEN
+      ende der datei := TRUE;
+      IF NOT am ende THEN auf satz intern (schluesseltext, TRUE) END IF;
+      LEAVE auf satz intern
+    END IF;
+    eine datei weiter
+  END REP
+
+END PROC auf satz intern;
+
+INT PROC satznummer :
+
+  satznummer offset + satznr (daten (hauptdatei). eudat)
+
+END PROC satznummer;
+
+INT PROC satzkombination :
+
+  kombination
+
+END PROC satzkombination;
+
+BOOL PROC dateiende :
+
+  ende der datei
+
+END PROC dateiende;
+
+
+(*************************** Satzverwaltung ******************************)
+
+SATZ VAR leersatz;
+satz initialisieren (leersatz);
+
+PROC satz einfuegen :
+
+  aenderungen eintragen;
+  mark satz einfuegen;
+  satz einfuegen (daten (hauptdatei). eudat, leersatz);
+  daten (hauptdatei). datei veraendert := TRUE;
+  alle koppeldateien ans ende;
+  ende der datei := FALSE;
+  suchbedingung auswerten .
+
+mark satz einfuegen :
+  mark stelle (daten (hauptdatei), satznr (daten (hauptdatei). eudat));
+  inkrement (daten (hauptdatei). marksaetze,
+             daten (hauptdatei). markzeiger, 1) .
+
+alle koppeldateien ans ende :
+  kombination := 1;
+  INT VAR dateiindex := erste koppeldatei;
+  WHILE dateiindex <> 0 REP
+    auf dateiende (daten (dateiindex). eudat);
+    dateiindex := daten (dateiindex). naechste datei
+  END REP .
+
+END PROC satz einfuegen;
+
+PROC satz loeschen :
+
+  IF NOT ende der datei THEN
+    aenderungen eintragen;
+    mark satz loeschen;
+    satz loeschen (daten (hauptdatei). eudat);
+    daten (hauptdatei). datei veraendert := TRUE;
+    auf satz (satznummer)
+  END IF .
+
+mark satz loeschen :
+  IF satz markiert THEN
+    delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger);
+    markierungen DECR 1
+  END IF;
+  inkrement (daten (hauptdatei). marksaetze,
+             daten (hauptdatei). markzeiger, -1) .
+
+END PROC satz loeschen;
+
+
+(*************************** Suchmuster **********************************)
+
+LET
+  maxmuster = 100;
+
+ROW maxmuster STRUCT (INT feld, relator, true exit, false exit,
+                      TEXT muster)
+              VAR bedingung;
+
+SATZ VAR muster gespeichert;
+
+INT VAR
+  anzahl muster,
+  erster musterindex,
+  versionszaehler := 1;
+
+BOOL VAR
+  bereits ausgewertet,
+  erfuellt;
+
+suchbedingung loeschen;
+
+INT VAR
+  muster index;
+
+LET
+  gleich test = 1,
+  beginn test = 2,
+  endet test = 3,
+  enthalten test = 4,
+  kleiner test = 5,
+  groesser test = 6,
+  nicht leer test = 7,
+  markiert test = 8,
+  true test = 9;
+
+
+PROC suchbedingung auswerten :
+
+  IF ende der datei THEN
+    erfuellt := FALSE
+  ELSE
+    kette verfolgen;
+    erfuellt := in true exit
+  END IF .
+
+kette verfolgen :
+  musterindex := erster musterindex;
+  WHILE muster index > 0 REP
+    gegenfeld bearbeiten;
+    feld bearbeiten (suchfeld, 
+         PROC (TEXT CONST, INT CONST, INT CONST) bedingung ueberpruefen)
+  END REP .
+
+gegenfeld bearbeiten :
+  INT VAR verwendeter relator := bedingung (musterindex). relator;
+  IF verwendeter relator >= 256 THEN
+    gegenfeld lesen;
+    bei datum umdrehen
+  END IF .
+
+gegenfeld lesen :
+  feld lesen ((verwendeter relator AND 255) + 1, feldpuffer) .
+
+bei datum umdrehen :
+  IF jeweiliges feldinfo = 2 THEN
+    feldpuffer drehen
+  END IF;
+  bedingung (musterindex). muster := feldpuffer .
+
+suchfeld :
+  bedingung (musterindex). feld .
+
+in true exit :
+  musterindex < 0 .
+
+END PROC suchbedingung auswerten;
+
+PROC bedingung ueberpruefen (TEXT CONST satz, INT CONST von, bis) :
+
+  INT VAR verwendeter relator := bedingung (musterindex). relator;
+  IF verwendeter relator >= 256 THEN
+    verwendeter relator := verwendeter relator DIV 256
+  END IF;
+  IF bedingung trifft zu THEN
+    musterindex := bedingung (musterindex). true exit
+  ELSE
+    musterindex := bedingung (musterindex). false exit
+  END IF .
+
+bedingung trifft zu :
+  SELECT verwendeter relator OF
+    CASE gleich test     :  ist gleich
+    CASE beginn test     :  beginnt mit
+    CASE endet test      :  endet mit
+    CASE enthalten test  :  ist enthalten
+    CASE kleiner test    :  ist kleiner
+    CASE groesser test   :  ist groesser
+    CASE nicht leer test :  ist nicht leer
+    CASE markiert test   :  ist markiert
+    CASE true test       :  ist true
+    OTHERWISE FALSE
+  END SELECT .
+
+ist gleich :
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : feldpuffer als subtext; feldpuffer LEXEQUAL muster
+  CASE 1 : feldpuffer als subtext; feldwert = musterwert
+  OTHERWISE length (muster) = bis - von + 1 AND text gleich
+  END SELECT .
+
+text gleich :
+  von > bis COR beginnt mit .
+
+beginnt mit :
+  pos (satz, muster, von, bis) = von .
+
+endet mit :
+  pos (satz, muster, bis + 1 - length (muster), bis) > 0 .
+
+ist enthalten :
+  pos (satz, muster, von, bis) > 0 .
+
+ist kleiner :
+  feldpuffer als subtext;
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : muster LEXGREATER feldpuffer
+  CASE 1 : feldwert < musterwert
+  CASE 2 : feldpuffer drehen; feldpuffer < muster
+  OTHERWISE feldpuffer < muster
+  END SELECT .
+
+ist groesser :
+  feldpuffer als subtext;
+  SELECT jeweiliges feldinfo OF
+  CASE 0 : feldpuffer LEXGREATEREQUAL muster
+  CASE 1 : feldwert >= musterwert
+  CASE 2 : feldpuffer drehen; feldpuffer >= muster
+  OTHERWISE feldpuffer >= muster
+  END SELECT .
+
+ist nicht leer :
+  von <= bis .
+
+ist markiert :
+  satz markiert .
+
+ist true :
+  TRUE .
+
+feldpuffer als subtext :
+  feldpuffer := subtext (satz, von, bis) .
+
+END PROC bedingung ueberpruefen;
+
+TEXT PROC muster :
+
+  bedingung (musterindex). muster
+
+END PROC muster;
+
+PROC feldpuffer drehen :
+
+  IF length (feldpuffer) = 8 THEN
+    TEXT CONST jahr := subtext (feldpuffer, 7, 8);
+    replace (feldpuffer, 7, subtext (feldpuffer, 1, 2));
+    replace (feldpuffer, 1, jahr)
+  ELSE
+    feldpuffer := niltext
+  END IF
+
+END PROC feldpuffer drehen;
+
+INT PROC jeweiliges feldinfo :
+  feldinfo (bedingung (musterindex). feld)
+END PROC jeweiliges feldinfo;
+
+REAL PROC feldwert :
+
+  REAL VAR r;
+  wert berechnen (feldpuffer, r);
+  r
+
+END PROC feldwert;
+
+REAL PROC musterwert :
+
+  REAL VAR r;
+  wert berechnen (muster, r);
+  r
+
+END PROC musterwert;
+
+
+LET
+  grosses oder = ";",
+  kleines oder = ",",
+  intervall symbol = "..",
+  markierungssymbol = "++",
+  negation = "--",
+  stern = "*";
+
+BOOL VAR
+  neue alternative,
+  neue disjunktion,
+  verneinung;
+
+INT VAR
+  erstes feldmuster,
+  oder index,
+  naechster oder anfang,
+  anfang der disjunktion,
+  bearbeitetes feld;
+
+INTVEC VAR oder anfang;
+
+
+PROC suchbedingung (INT CONST feldnr, TEXT CONST bedingung) :
+
+  INT VAR
+    anfang := 1,
+    semi pos := 0;
+  INT CONST
+    bedingung ende := length (bedingung) + 1;
+  oder index := 0;
+  bearbeitetes feld := feldnr;
+  erstes feldmuster := anzahl muster + 1;
+  WHILE anfang < bedingung ende REP
+    feldende feststellen;
+    bedingung eintragen;
+    anfang := ende + 2
+  END REP;
+  feld aendern (muster gespeichert, feldnr, bedingung) .
+
+feldende feststellen :
+  INT VAR
+    oder pos := pos (bedingung, kleines oder, anfang);
+  IF oder pos = 0 THEN oder pos := bedingung ende END IF;
+  IF semi pos < anfang THEN
+    neue alternative beginnen
+  END IF;
+  INT CONST ende := min (oder pos, semi pos) - 1 .
+
+neue alternative beginnen :
+  oder index INCR 1;
+  neue alternative := TRUE;
+  IF oder index > 1 THEN globales muster vorhanden := FALSE END IF;
+  semi pos := pos (bedingung, grosses oder, anfang);
+  IF semi pos = 0 THEN semi pos := bedingung ende END IF .
+
+bedingung eintragen :
+  verneinung testen;
+  neue disjunktion := TRUE;
+  INT CONST
+    intervall pos := pos (bedingung, intervall symbol, anfang, ende + 1);
+  IF leere bedingung THEN
+    eintragen (niltext, true test, - oder index)
+  ELIF intervall pos = 0 THEN
+    textvergleich
+  ELSE
+    groessenvergleich
+  END IF .
+
+verneinung testen :
+  IF subtext (bedingung, anfang, anfang + 1) = negation THEN
+    anfang INCR 2; verneinung := TRUE
+  ELSE
+    verneinung := FALSE
+  END IF .
+
+leere bedingung :
+  anfang > ende .
+
+text vergleich :
+  IF test auf markierung THEN
+    test auf markierung eintragen
+  ELSE
+    sterne suchen
+  END IF .
+
+test auf markierung :
+  anfang + 1 = ende CAND 
+    subtext (bedingung, anfang, ende) = markierungssymbol .
+
+test auf markierung eintragen :
+  eintragen (niltext, markiert test, - oder index) .
+
+sterne suchen :
+  INT VAR stern pos := pos (bedingung, stern, anfang, ende + 1);
+  IF stern pos = 0 THEN
+    teste ob feld gleich
+  ELIF anfang = ende THEN
+    test auf nichtleeres feld
+  ELSE
+    relator bestimmen;
+    REP
+      teste auf enthalten sein
+    END REP
+  END IF .
+
+teste ob feld gleich :
+  IF globales muster moeglich THEN
+    globales muster vorhanden := TRUE;
+    globales muster := bedingung
+  END IF;
+  eintragen (subtext (bedingung, anfang, ende), gleich test, - oder index) .
+
+globales muster moeglich :
+  feldnr = 1 AND anfang = 1 AND ende = bedingung ende - 1 AND
+  noch keine globalen alternativen AND NOT umgeschaltet AND
+  (bedingung SUB 1) <> "&" .
+
+noch keine globalen alternativen :
+  length (oder anfang) <= 2 .
+
+test auf nichtleeres feld :
+  eintragen (niltext, nichtleer test, - oder index) .
+
+relator bestimmen :
+  INT VAR relator;
+  IF stern pos = anfang THEN
+    relator := gleich test
+  ELSE
+    relator := beginn test
+  END IF .
+
+teste auf enthalten sein :
+  IF relator <> gleich test THEN
+    teilmuster eintragen
+  END IF;
+  anfang := stern pos + 1;
+  stern pos := pos (bedingung, stern, anfang, ende + 1);
+  IF stern pos = 0 THEN
+    stern pos := ende + 1;
+    relator := endet test
+  ELSE
+    relator := enthalten test
+  END IF .
+
+teilmuster eintragen :
+  TEXT CONST muster := subtext (bedingung, anfang, stern pos - 1);
+  IF verneinung OR letztes feld THEN
+    IF verneinung THEN neue disjunktion := TRUE END IF;
+    eintragen (muster, relator, - oder index);
+    IF letztes feld THEN LEAVE sterne suchen END IF
+  ELSE
+    eintragen (muster, relator, anzahl muster + 2)
+  END IF .
+
+letztes feld :
+  stern pos >= ende .
+
+groessenvergleich :
+  TEXT CONST
+    muster 1 := subtext (bedingung, anfang, intervall pos - 1),
+    muster 2 := subtext (bedingung, intervall pos + 2, ende);
+  IF intervall pos = anfang THEN
+    eintragen (muster 2, kleiner test, - oder index)
+  ELIF intervall pos = ende - 1 THEN
+    eintragen (muster 1, groesser test, - oder index)
+  ELSE
+    intervall eintragen
+  END IF .
+
+intervall eintragen :
+  IF verneinung THEN
+    eintragen (muster 1, groesser test, - oder index);
+    neue disjunktion := TRUE
+  ELSE
+    eintragen (muster 1, groesser test, anzahl muster + 2)
+  END IF;
+  eintragen (muster 2, kleiner test, - oder index) .
+
+END PROC suchbedingung;
+
+PROC eintragen (TEXT CONST textmuster, INT CONST relator, true exit) :
+
+  musterstatus verwalten;
+  musterplatz belegen;
+  IF neue alternative THEN
+    alte false exits auf neuen anfang setzen;
+    alte true exits auf diesen platz setzen;
+    anfang der disjunktion := anzahl muster
+  ELIF neue disjunktion THEN
+    false exits der letzten disjunktion anketten
+  END IF;
+  vergleichsdaten eintragen;
+  textmuster eintragen .
+
+musterstatus verwalten :
+  bereits ausgewertet := FALSE;
+  IF anzahl muster = anzahl hauptmuster THEN
+    versionszaehler INCR 1;
+    IF versionszaehler > 32000 THEN versionszaehler := 1 END IF
+  END IF .
+
+musterplatz belegen :
+  IF anzahl muster = maxmuster THEN
+    suchbedingung loeschen;
+    errorstop (suchmuster zu umfangreich)
+  ELSE
+    anzahl muster INCR 1;
+    erster musterindex := anzahl hauptmuster + 1
+  END IF .
+
+alte false exits auf neuen anfang setzen :
+  IF oder index > length (oder anfang) DIV 2 THEN
+    oder anfang CAT anzahl muster;
+    setze verkettung (erster musterindex, 0, anzahl muster)
+  END IF;
+  IF oder index = length (oder anfang) DIV 2 THEN
+    naechster oder anfang := 0
+  ELSE
+    naechster oder anfang := oder anfang ISUB (oder index + 1)
+  END IF .
+
+alte true exits auf diesen platz setzen :
+  setze verkettung (erster musterindex, - oder index, anzahl muster);
+  neue alternative := FALSE;
+  neue disjunktion := FALSE .
+
+false exits der letzten disjunktion anketten :
+  setze verkettung (anfang der disjunktion, naechster oder anfang,
+                    anzahl muster);
+  anfang der disjunktion := anzahl muster;
+  neue disjunktion := FALSE .
+
+vergleichsdaten eintragen :
+  bedingung (anzahl muster). relator := relator;
+  bedingung (anzahl muster). feld := bearbeitetes feld;
+  IF verneinung THEN
+    bedingung (anzahl muster). true exit := naechster oder anfang;
+    bedingung (anzahl muster). false exit := true exit
+  ELSE
+    bedingung (anzahl muster). true exit := true exit;
+    bedingung (anzahl muster). false exit := naechster oder anfang
+  END IF .
+
+textmuster eintragen :
+  IF textmuster ist gegenfeld THEN
+    feldnummer des gegenfelds eintragen
+  ELSE
+    textmuster original eintragen
+  END IF .
+
+textmuster ist gegenfeld :
+  (textmuster SUB 1) = "&" CAND gueltiges feld .
+
+gueltiges feld :
+  INT CONST nr gegenfeld := feldnummer (subtext (textmuster, 2));
+  nr gegenfeld > 0 .
+
+feldnummer des gegenfelds eintragen :
+  bedingung (anzahl muster). relator := nr gegenfeld - 1 + 256 * relator .
+
+textmuster original eintragen :
+  INT CONST info := feldinfo (bearbeitetes feld);
+  IF info = 2 AND (relator = kleiner test OR relator = groesser test) THEN
+    feldpuffer := textmuster;
+    feldpuffer drehen;
+    bedingung (anzahl muster). muster := feldpuffer
+  ELSE
+    bedingung (anzahl muster). muster := textmuster
+  END IF .
+
+END PROC eintragen;
+
+PROC setze verkettung (INT CONST von, wert, durch) :
+
+  INT VAR i;
+  FOR i FROM von UPTO anzahl muster - 1 REP
+    IF bedingung (i). true exit = wert THEN
+      bedingung (i). true exit := durch
+    ELIF bedingung (i). false exit = wert THEN
+      bedingung (i). false exit := durch
+    END IF
+  END REP
+
+END PROC setze verkettung;
+
+PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) :
+
+  feld lesen (muster gespeichert, feldnr, bedingung)
+
+END PROC suchbedingung lesen;
+
+PROC suchbedingung loeschen :
+
+  disable stop;
+  IF umgeschaltet THEN
+    anzahl muster := anzahl hauptmuster
+  ELSE
+    anzahl hauptmuster := 0;
+    anzahl muster := 0
+  END IF;
+  erster musterindex := -1;
+  oder anfang := empty intvec;
+  satz initialisieren (muster gespeichert);
+  globales muster vorhanden := FALSE;
+  bereits ausgewertet := TRUE;
+  erfuellt := NOT ende der datei
+
+END PROC suchbedingung loeschen;
+
+BOOL PROC satz ausgewaehlt :
+
+  IF NOT bereits ausgewertet THEN
+    suchbedingung auswerten;
+    bereits ausgewertet := TRUE
+  END IF;
+  erfuellt
+
+END PROC satz ausgewaehlt;
+
+INT PROC suchversion :
+
+  IF anzahl muster = anzahl hauptmuster THEN
+    0
+  ELSE
+    versionszaehler
+  END IF
+
+END PROC suchversion;
+
+
+(*************************** Markierung **********************************)
+
+PROC mark stelle (DATEI VAR datei, INT CONST satz) :
+
+  IF (datei. marksaetze ISUB datei. markzeiger) < satz THEN
+    vorwaerts gehen
+  ELSE
+    rueckwaerts gehen
+  END IF .
+
+vorwaerts gehen :
+  REP
+    datei. markzeiger INCR 1
+  UNTIL (datei. marksaetze ISUB datei. markzeiger) >= satz END REP .
+
+rueckwaerts gehen :
+  WHILE datei. markzeiger > 1 CAND
+      (datei. marksaetze ISUB (datei. markzeiger - 1)) >= satz REP
+    datei. markzeiger DECR 1
+  END REP .
+
+END PROC mark stelle;
+
+PROC markierung aendern :
+
+  disable stop;
+  IF satz markiert THEN
+    delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger);
+    markierungen DECR 1
+  ELSE
+    insert (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger,
+            satznr (daten (hauptdatei). eudat));
+    markierungen INCR 1
+  END IF
+
+END PROC markierung aendern;
+
+BOOL PROC satz markiert :
+
+  INT CONST satz := satznr (daten (hauptdatei). eudat);
+  mark stelle (daten (hauptdatei), satz);
+  satz =
+    (daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger) 
+
+END PROC satz markiert;
+
+INT PROC markierte saetze :
+
+  markierungen
+
+END PROC markierte saetze;
+
+PROC markierungen loeschen :
+
+  disable stop;
+  IF umgeschaltet THEN
+    mark loeschen (daten (hauptdatei))
+  ELSE
+    in allen geketteten dateien loeschen
+  END IF;
+  markierungen := 0 .
+
+in allen geketteten dateien loeschen :
+  INT VAR dateiindex := 1;
+  REP
+    mark loeschen (daten (dateiindex));
+    dateiindex := daten (dateiindex). naechste datei
+  UNTIL dateiindex = 0 END REP .
+
+END PROC markierungen loeschen;
+
+PROC mark loeschen (DATEI VAR datei) :
+
+  datei. marksaetze := niltext;
+  datei. marksaetze CAT maxint;
+  datei. markzeiger := 1
+
+END PROC mark loeschen;
+
+
+END PACKET datenverwaltung;
+
diff --git a/app/eudas/5.3/src/isub.replace b/app/eudas/5.3/src/isub.replace
new file mode 100644
index 0000000..3c48009
--- /dev/null
+++ b/app/eudas/5.3/src/isub.replace
@@ -0,0 +1,19 @@
+PACKET isub replace DEFINES ISUB, replace : 
+ 
+INT OP ISUB (TEXT CONST t, INT CONST i) : 
+ 
+  INT CONST ii := i + i; 
+  code (t SUB ii - 1) + 256 * code (t SUB ii) 
+ 
+END OP ISUB; 
+ 
+PROC replace (TEXT VAR t, INT CONST i, wert) : 
+ 
+  INT CONST ii := i + i; 
+  replace (t, ii - 1, code (wert MOD 256)); 
+  replace (t, ii,  code (wert DIV 256 MOD 256)) 
+ 
+END PROC replace 
+ 
+END PACKET isub replace; 
+
diff --git a/app/eudas/5.3/src/menues.1 b/app/eudas/5.3/src/menues.1
new file mode 100644
index 0000000..58b0769
--- /dev/null
+++ b/app/eudas/5.3/src/menues.1
@@ -0,0 +1,75 @@
+PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0=
+#101#" ist keine Feldnummer";
+TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0.w0:p0+p0<(j0ISUB1)-1.END 
+PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1-s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1REPreplace(j0,y0,w1+v1)
+END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)<t1REPy0INCR1END REP.z1:(CONCR(j0)ISUBy0)=t1.a2:(CONCR(j0)ISUB(y0+1))=t1+length(x1).END PROCfeldindex;END PACKETeudassatzzugriffe;
+PACKETfensterDEFINES FENSTER,fensterinitialisieren,fenstergroessesetzen,fenstergroesse,fensterveraendert,fensterzugriff,bildschirmneu:TYPE FENSTER=STRUCT(INTb0,c0);LETd0=16,BITVEKTOR=INT,GROESSE=STRUCT(INTe0,f0,g0,h0);ROWd0STRUCT(INTi0,j0,BITVEKTORk0,GROESSEl0)VARm0;INT VARn0:=1;BITVEKTOR VARo0;INT VARp0;FORp0FROM2UPTOd0REPm0(p0).i0:=0END REP;m0(1).i0:=1;m0(1).j0:=0;m0(1).k0:=0;m0(1).l0:=GROESSE:(1,1,79,24);PROCfensterinitialisieren(FENSTER VARf):f.b0:=1;m0(1).i0INCR1;q0(f.c0)END PROCfensterinitialisieren;PROCq0(INT VARc0):c0:=n0;n0INCR1;IFn0>=32000THENn0:=-32000END IF END PROCq0;PROCfenstergroessesetzen(FENSTER VARr0,FENSTER CONSTs0):q0(r0.c0);m0(r0.b0).i0DECR1;r0.b0:=s0.b0;m0(s0.b0).i0INCR1END PROCfenstergroessesetzen;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARt0;u0;IFt0>d0THENv0;w0;x0END IF;y0.u0:t0:=1;WHILEt0<=d0REP IFz0THEN LEAVEu0END IF;t0INCR1END REP.z0:a1.e0=e0ANDa1.f0=f0ANDa1.g0=g0ANDa1.h0=h0.a1:m0(t0).l0.v0:t0:=1;WHILEt0<=d0REP IFm0(t0).i0=0THEN LEAVE
+v0END IF;t0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.w0:m0(t0).i0:=0;m0(t0).j0:=0;m0(t0).l0:=GROESSE:(e0,f0,g0,h0);m0(t0).k0:=0.x0:INT VARb1;FORb1FROM1UPTOd0REP IFm0(b1).i0>0THENc1END IF END REP.c1:IFd1(e1,f1)THENsetbit(m0(t0).k0,b1);setbit(m0(b1).k0,t0)ELSEresetbit(m0(b1).k0,t0)END IF.e1:m0(t0).l0.f1:m0(b1).l0.y0:m0(f.b0).i0DECR1;f.b0:=t0;m0(t0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCd1(GROESSE CONSTa,g1):h1ANDi1.h1:IFa.e0<=g1.e0THENg1.e0<a.e0+a.g0ELSEa.e0<g1.e0+g1.g0END IF.i1:IFa.f0<=g1.f0THENg1.f0<a.f0+a.h0ELSEa.f0<g1.f0+g1.h0END IF.END PROCd1;PROCfenstergroesse(FENSTER CONSTf,INT VARe0,f0,g0,h0):e0:=a1.e0;f0:=a1.f0;g0:=a1.g0;h0:=a1.h0.a1:m0(f.b0).l0.END PROCfenstergroesse;PROCfensterveraendert(FENSTER CONSTf):m0(f.b0).j0:=0;o0:=o0ORj1.j1:m0(f.b0).k0.END PROCfensterveraendert;PROCfensterzugriff(FENSTER CONSTf,BOOL VARk1):k1:=bit(o0,f.b0);IFm0(f.b0).j0<>f.c0THENm0(f.b0).j0:=f.c0;k1:=TRUE END IF;o0:=o0ORj1;resetbit(o0,f.b0).j1:m0(f.b0).k0.END 
+PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARl1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1ORl1(t0)END PROCsetbit;PROCresetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1AND(-1-l1(t0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTm1,INT CONSTt0):(m1ANDl1(t0))<>0END PROCbit;END PACKETfenster;
+PACKETeudasmenuesDEFINESglobalmanager,menuemanager,lock,free,menuedateneinlesen,menuenamen,menueloeschen,boxzeichen,waehlbar,fusszeile,fussteil,ausfuehrtaste,menueanbieten,zeilenmenueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,vielhilfe,statusanzeigen,statuszeile,dialogfenster,dialogfensterloeschen,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW7TEXT VARb0:=ROW7TEXT:("MENUE","BILD","FELD","ENDE","AUSWAHL","HILFE","SEITE");LETc0=1,d0=2,e0=3,f0=4,g0=5,h0=6,i0=7;LETj0=2,integer=3,k0=4,l0=7;LETm0=
+#701#"FEHLER in Zeile ";
+FILE VARn0;TEXT VARo0,p0;PROCq0:IFeof(n0)THENo0:="%DUMMY"ELSEreadrecord(n0,o0);IFo0=r0THENo0:=s0END IF;cout(lineno(n0));down(n0)END IF END PROCq0;BOOL PROCt0:IF(o0SUB1)=u0THENv0ELSE FALSE END IF.v0:INT VARw0;replace(o0,1,s0);scan(o0);replace(o0,1,u0);nextsymbol(p0,w0);IFw0<>j0THENx0(y0);FALSE ELSE TRUE END IF.END PROCt0;BOOL PROCz0(INT CONSTa1):b0(a1)=p0END PROCz0;INT PROCb1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=integerTHENint(c1)ELSE IFw0<>l0THENx0(d1)END IF;-1END IF END PROCb1;TEXT PROCe1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=k0THENc1ELSE IFw0<>l0THENx0(f1)END IF;r0END IF END PROCe1;PROCx0(TEXT CONSTg1):note(m0);note(lineno(n0)-1);noteline;note(g1);noteline;line;putline(g1)END PROCx0;INT VARh1,i1,j1,k1;PROCl1(INT CONSTm1,n1):cursor(j1+m1-1,k1+n1-1)END PROCl1;TEXT VARo1,p1,q1,r1,s1,t1,u1,v1,w1,x1,y1;TEXT VARz1:=120*" ",a2,b2;boxzeichen("-:..`'::-",""15""14"","X ");PROCboxzeichen(TEXT CONSTc2,d2,e2):x1:=d2;y1:=e2;IF LENGTHc2=9THENv1:=c2SUB1;u1:=c2SUB2;o1:=c2SUB3;p1:=c2SUB4;
+q1:=c2SUB5;r1:=c2SUB6;s1:=c2SUB7;t1:=c2SUB8;w1:=c2SUB9END IF;a2:=120*v1;b2:=120*w1END PROCboxzeichen;PROCf2(INT CONSTg2):out(o1);outsubtext(a2,1,g2-2);out(p1)END PROCf2;PROCf2(INT CONSTg2,TEXT CONSTh2):out(o1);outsubtext(a2,1,g2-3-length(h2));out(h2);out(v1);out(p1)END PROCf2;PROCi2(INT CONSTg2):out(s1);outsubtext(b2,1,g2-2);out(t1)END PROCi2;PROCj2(INT CONSTg2):out(q1);outsubtext(a2,1,g2-2);out(r1)END PROCj2;PROCk2(INT CONSTm1,g2):IFm1+g2>=xsizeTHENout(l2)ELSEoutsubtext(z1,1,g2)END IF END PROCk2;LETm2=
+#702#"Zeile ist ohne Zusammenhang",n2=
+#703#"K Menuedaten im Speicher";
+PROCmenuedateneinlesen(TEXT CONSTo2):p2;n0:=sequentialfile(input,o2);modify(n0);toline(n0,1);WHILE NOTeof(n0)REPq0;IFt0THENq2ELIF NOTanythingnotedTHENx0(m2)END IF END REP;r2;IFanythingnotedTHENnoteedit(n0)END IF.q2:IFz0(c0)THENs2ELIFz0(g0)THENt2ELIFz0(h0)THENu2ELIF NOTanythingnotedTHENx0(m2)END IF.r2:IFonlineTHENline;put(v2);putline(n2)END IF.v2:storage(w2(1))+storage(w2(2))+storage(w2(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZx2,y2,z2,TEXTa3,b3);BOUND ROW200MENUE VARc3;TEXT VARd3,e3;SATZ VARf3,g3;LETr0="",s0=" ",h3=" ",i3=2,u0="%",j3=""7"",k3=""27"",l2=""5"";LETl3=
+#704#"% BILD erwartet",m3=
+#705#"Feldnummer beim %FELD-Kommando fehlt",n3=
+#706#"% ENDE erwartet",o3=
+#707#"Name fehlt",y0=
+#708#"Kommandozeile enthaelt kein Kommando",d1=
+#709#"Parameter soll eine Zahl sein",f1=
+#710#"Parameter soll ein TEXT sein";
+PROCs2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex;p3;s2(c3(index))END IF.p3:index:=link(q3(2),name);IFindex=0THENinsert(q3(2),name,index)END IF.END PROCs2;PROCs2(MENUE VARr3):s3;t3;u3;v3;w3.s3:satzinitialisieren(r3.x2);satzinitialisieren(f3);satzinitialisieren(g3);e3:=r0;d3:=r0.t3:x3;INT VARy3:=1;REPq0;IFt0THEN LEAVEt3ELSEz3;y3INCR1END IF END REP.x3:q0;IF NOT(t0CANDz0(d0))THENx0(l3)END IF.z3:IFpos(o0,h3)>0THENd3CATcode(y3+1);IF(o0SUBi3)=h3THENreplace(o0,i3,s0)END IF END IF;feldaendern(r3.x2,y3,o0).u3:WHILEz0(e0)REPa4END REP.a4:INT VARb4:=b1;IFb4=-1THENx0(m3);b4:=100END IF;c4;d4;e4.c4:feldaendern(f3,b4,e1).d4:TEXT CONSTf4:=e1;INT VARg4;FORg4FROM1UPTOlength(f4)REPe3CATcode(b4);e3CAT(f4SUBg4)END REP.e4:TEXT VARh4:=r0;q0;WHILE NOTt0REPh4CATo0;q0END REP;feldaendern(g3,b4,h4).v3:IF NOTz0(f0)THENx0(n3)END IF.w3:r3.y2:=f3;r3.z2:=g3;r3.a3:=e3;r3.b3:=d3.END PROCs2;LETi4=
+#711#"Kommando wird ausgeführt ..",j4=
+#712#""15"Gib Kommando: ",k4=
+#713#"falsche Ausfuehrtaste",l4=
+#714#" existiert nicht.";
+LETm4="                                                  ",n4=""15"",o4=""14"",p4="?"8"",q4="*"8"";INT VARr4,s4;BOOL VARt4:=FALSE,u4,v4;TEXT VARw4:=r0,x4,y4:=" "1""2""3""8""10""13""27"",z4,a5:=r0;ROW6TEXT VARb5:=ROW6TEXT:("","","","","",""),c5:=b5;FENSTER VARd5,e5;fensterinitialisieren(d5);fensterinitialisieren(e5);PROCwaehlbar(INT CONSTf5,g5,BOOL CONSTh5):IFh5THENi5ELSEj5END IF;u4:=TRUE.i5:IFlength(b5(f5))>=g5THENreplace(b5(f5),g5," ")END IF.j5:WHILElength(b5(f5))<g5REPb5(f5)CAT" "END REP;replace(b5(f5),g5,"-").END PROCwaehlbar;PROCausfuehrtaste(TEXT CONSTk5):IFlength(k5)<>1CORl5THENerrorstop(k4)ELSEreplace(y4,1,k5)END IF.l5:k5<>""13""ANDpos(y4,k5,2)>0.END PROCausfuehrtaste;PROCfusszeile(TEXT CONSTm5,TEXT CONSTn5,INT CONSTo5,TEXT CONSTp5,INT CONSTq5):c5(1):=code(1)+m5;c5(4):=r0;c5(2):=code(o5)+n5;c5(5):=r0;c5(3):=code(q5)+p5;c5(6):=r0;fensterveraendert(e5)END PROCfusszeile;PROCfussteil(INT CONSTindex,TEXT CONSTr5,s5):t5;c5(index):=(c5(index)SUB1)+r5;cursor(code(c5(index)SUB1),ysize);
+outsubtext(c5(index),2);fussteil(index,s5)END PROCfussteil;PROCfussteil(INT CONSTindex,TEXT CONSTs5):INT VARu5;IFindex=3THENu5:=xsizeELSEu5:=code(c5(index+1)SUB1)END IF;INT CONSTv5:=code(c5(index)SUB1)+length(c5(index))-1;u5DECRv5;c5(index+3):=subtext(s5,1,u5);t5;cursor(v5,ysize);outsubtext(s5,1,u5);outsubtext(z1,1,u5-length(c5(index+3)))END PROCfussteil;PROCt5:BOOL VARw5;fensterzugriff(e5,w5);IFw5CANDc5(1)<>r0THENx5END IF.x5:INT VARy5;cursor(1,ysize);out(l2);FORy5FROM1UPTO3REPcursor(code(c5(y5)SUB1),ysize);outsubtext(c5(y5),2);out(c5(y5+3))END REP.END PROCt5;PROCmenueanbieten(ROW6TEXT CONSTmenuenamen,FENSTER CONSTf,BOOL CONSTz5,PROC(INT CONST,INT CONST)a6):ROW6INT VARb6,c6,d6;INT VARe6,f6:=0,g6:=1,h6:=0,i6;TEXT VARj6;ROW6TEXT VARk6,l6;BOOL VARm6;p2;n6;disablestop;REPo6;p6;q6END REP.n6:r6;s6;t6;u6.r6:fenstergroessesetzen(d5,1,1,xsize-1,1);fenstergroessesetzen(e5,1,ysize,xsize-1,1).s6:m6:=t4;t4:=FALSE;j6:=w4;k6:=b5;l6:=c5.t6:w4:=""6""0""0"";v6;w6;w4CATl2.v6:INT VARx6:=pos(menuenamen(1),
+".");IFx6>0THENw4CATsubtext(menuenamen(1),1,x6-1)END IF;w4CAT":   ".w6:i6:=0;WHILEi6<6CANDy6REPi6INCR1;z6;d6(i6):=1END REP.y6:menuenamen(i6+1)<>r0.z6:b6(i6):=length(w4);x6:=pos(menuenamen(i6),".");IFx6=0THENw4CATmenuenamen(i6)ELSEw4CATsubtext(menuenamen(i6),x6+1)END IF;w4CAT"   ";c6(i6):=length(w4)-1.u6:INT VARy5;FORy5FROM1UPTO6REPb5(y5):=r0;c5(y5):=r0END REP;u4:=TRUE;a6(0,0).o6:IFg6>0THENa7;b7;f6:=g6;g6:=0;c7END IF.a7:IFf6>0THENreplace(w4,b6(f6)," ");replace(w4,c6(f6)," ");IFv4THENa6(f6,-1)END IF END IF.b7:replace(w4,b6(g6),n4);replace(w4,c6(g6),o4);fensterveraendert(d5);d7.c7:e6:=link(q3(2),menuenamen(f6));IFe6=0THENe7(menuenamen(f6));LEAVEmenueanbietenEND IF;v4:=FALSE;fensterveraendert(f).p6:h6:=f6;f7(c3(e6),f,h6,d6(f6),PROC(INT CONST,INT CONST)a6).q6:SELECTh6OF CASE0:g7CASE1:h7CASE2:i7CASE3:j7CASE4:k7OTHERWISEl7END SELECT.i7:IFf6<i6THENg6:=f6+1ELSEg6:=1END IF.j7:IFf6>1THENg6:=f6-1ELSEg6:=i6END IF.l7:h6:=h6-10;IFh6<=i6THENg6:=h6END IF.h7:IFz5THEN BOOL VARm7:=FALSE;REPn7;o7UNTILp7END
+ REP;IFm7THENbildschirmneu;dialogfensterloeschen;t5;a6(f6,-2)END IF END IF.o7:IFq7THENm7:=TRUE;statusanzeigen(i4);cursor(1,2);out(r7);do(z4)END IF.q7:pos(z4,"!","�",1)>0.p7:NOTiserror.g7:IFv4THENa6(f6,-1)END IF;fensterveraendert(f);s7;LEAVEmenueanbieten.s7:t4:=m6;w4:=j6;fensterveraendert(d5);b5:=k6;u4:=TRUE;c5:=l6;fensterveraendert(e5).k7:IFd6(f6)>0THENa6(f6,d6(f6))ELSEd6(f6):=-d6(f6)END IF;t5.END PROCmenueanbieten;PROCd7:BOOL VARw5;fensterzugriff(d5,w5);IFw5THENout(w4)END IF END PROCd7;PROCf7(MENUE CONSTr3,FENSTER CONSTf,INT VARt7,wahl,PROC(INT CONST,INT CONST)a6):INT VARu7:=0;v7;w7(f);IFs4=0THENr4:=0END IF;neuerdialog;x7;REPd7;y7;z7END REP.v7:IFwahl>length(r3.b3)THENwahl:=r4;ELIFiserrorTHENfehlerausgeben;a6(t7,-2);END IF.x7:IFu4THENa8(t7,r3);b8;u4:=FALSE END IF.b8:INT VARc8;FORc8FROM1UPTOlength(r3.b3)REP INT CONSTd8:=code(r3.b3SUBc8);IFd8>s4THEN LEAVEb8END IF;e8(r3.x2,d8)END REP.y7:REPf8;IFiserrorTHENg8ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;BOOL VARi8:=FALSE;WHILEs4<h1REPh8:=
+getcharety;j8END REP;k8;l8(r3,wahl);m8(h8).j8:IFh8=r0THENn8;s4INCR1;o8ELSE LEAVEf8END IF.n8:IF NOTv4ANDs4=0THENa6(t7,0);a8(t7,r3);v4:=TRUE END IF.o8:IFs4=code(r3.b3SUBwahl)THENp8(r3.x2,s4,TRUE);r4:=wahlELSEp8(r3.x2,s4,FALSE)END IF;IFs4=h1THENi8:=TRUE END IF.k8:IFi8AND NOTiserrorTHENt5;a6(t7,-2);IFiserrorTHENclearerrorEND IF END IF.g8:fehlerausgeben;d7;s4:=0.z7:INT VARq8;SELECTu7OF CASE0:r8CASE1:s8CASE2:t8END SELECT.r8:SELECTpos(y4,h8)OF CASE1:u8CASE2:u7:=1CASE3:v8CASE4:w8CASE5:x8CASE6:y8CASE7:z8CASE8:u7:=2OTHERWISEa9END SELECT.s8:SELECTpos(""1""3""10"",h8)OF CASE1:b9CASE2:c9CASE3:d9OTHERWISEout(j3)END SELECT;u7:=0.t8:SELECTpos(""1""27"?qh",h8)OF CASE1:eschopausfuehrenCASE2:e9CASE3:f9CASE4,5:g9OTHERWISEh9END SELECT;u7:=0.v8:h6:=2;LEAVEf7.w8:IFwahl>1THENwahlDECR1ELSEwahl:=length(r3.b3)END IF.x8:h6:=3;LEAVEf7.y8:IFwahl<length(r3.b3)THENwahlINCR1ELSEwahl:=1END IF.z8:y8.a9:IFi9THENj9ELIFk9THENl9ELIFh8<=" "THENpush(k3+h8)END IF.i9:pos("123456",h8)>0.j9:h6:=code(h8)-38;LEAVEf7.k9:q8:=0;REPq8
+:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0END REP;q8>0ANDm9.m9:code(r3.a3SUBq8-1)<=length(r3.b3).l9:wahl:=code(r3.a3SUBq8-1);l8(r3,wahl);IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.b9:wahl:=1.c9:wahl:=1.d9:wahl:=length(r3.b3).h9:IFo9THENwahl:=code(r3.a3SUBq8-1);h6:=4;LEAVEf7ELSEpush(lernsequenzauftaste(h8))END IF.o9:q8:=0;REPq8:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0CAND(q8=0CORp9)END REP;q8>0.p9:code(r3.a3SUBq8-1)>length(r3.b3).e9:h6:=1;LEAVEf7.f9:TEXT VARq9;r9(r3,wahl,p4);feldlesen(r3.y2,wahl,q9);hilfeanbieten(q9,s9);IFiserrorTHENfehlerausgebenEND IF;a6(t7,-2);w7(f).g9:h6:=0;LEAVEf7.u8:IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.h6:t7.END PROCf7;PROCw7(FENSTER CONSTf):BOOL VARw5;fensterzugriff(f,w5);fenstergroesse(f,j1,k1,i1,h1);IFw5THENs4:=0;l1(1,1)END IF END PROCw7;PROCa8(INT CONSTt7,MENUE CONSTr3):x4:=m4;INT VARy5;FORy5FROM1UPTOlength(b5(t7))REPreplace(x4,code(r3.b3SUBy5),b5(t7)SUBy5)END REP END PROCa8;PROCl8(MENUE CONSTr3,INT CONSTwahl):INT CONSTt9:=code(r3.b3SUB
+wahl);IFr4>0ANDr4<>wahlTHEN INT CONSTu9:=code(r3.b3SUBr4);p8(r3.x2,u9,FALSE)END IF;p8(r3.x2,t9,TRUE);r4:=wahl;l1(2,t9)END PROCl8;PROCm8(TEXT VARv9):enablestop;getchar(v9)END PROCm8;PROCn9(MENUE CONSTr3,INT VARwahl):r9(r3,wahl,q4);TEXT VARh4;feldlesen(r3.z2,wahl,h4);IFh4<>r0ANDh4<>s0THENdo(h4);bildschirmneu;wahl:=-wahlEND IF.END PROCn9;PROCr9(MENUE CONSTr3,INT CONSTwahl,TEXT CONSTw9):INT CONSTk1:=code(r3.b3SUBwahl);IFs4>=k1THENp8(r3.x2,k1,FALSE);l1(2,k1);out(w9)END IF.END PROCr9;PROCeschopausfuehren:TEXT VARx9:=""0"",y9;lernsequenzauftastelegen(""0"",r0);push(""27""1""0""0"");editget(x9,1,1,""0"","",y9);out(""8"");x9:=lernsequenzauftaste(""0"");IFx9<>r0THENz9ELSEa10END IF.z9:REPgetchar(y9)UNTILpos(""1""2""8""11""12"",y9)=0END REP;lernsequenzauftastelegen(y9,x9).a10:getchar(y9).END PROCeschopausfuehren;BOOL VARb10;INT VARc10,d10,e10;PROCe8(SATZ CONSTx2,INT CONSTf10):l1(2,f10);IF(x4SUBf10)<>s0THENout(x4SUBf10)ELSEfeldbearbeiten(x2,f10-1,PROC(TEXT CONST,INT CONST,INT CONST)g10)END IF END 
+PROCe8;PROCg10(TEXT CONSTh10,INT CONSTc10,d10):out(h10SUBc10+d10-d10)END PROCg10;PROCp8(SATZ CONSTx2,INT CONSTy3,BOOL CONSTi10):enablestop;l1(1,y3);IFi10THENb10:=FALSE;out(u1);e8(x2,y3);out(n4);c10:=3;e10:=1;j10(x2,y3-1)ELIFy3=1THENf2(i1)ELIFy3=h1THENj2(i1)ELIFy3=felderzahl(x2)+2THENi2(i1)ELSEk10;IF(x4SUBy3)="-"THENout("-");c10:=2ELSEc10:=1END IF;e10:=0;j10(x2,y3-1)END IF.k10:feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10).END PROCp8;PROCl10(TEXT CONSTh10,INT CONSTm10,n10):b10:=(h10SUBm10+n10-n10)="-";IF NOTb10THENout(u1)END IF END PROCl10;PROCp8(SATZ CONSTx2,INT CONSTy3):feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10);c10:=1;e10:=0;j10(x2,y3-1)END PROCp8;PROCj10(SATZ CONSTx2,INT CONSTy3):IFb10THENi2(i1)ELSEo10END IF.o10:feldbearbeiten(x2,y3,PROC(TEXT CONST,INT CONST,INT CONST)p10);q10.q10:outsubtext(z1,1,i1-d10-e10-2);r10;s10.r10:IFe10>0THENout(o4)END IF.s10:out(u1).END PROCj10;PROCp10(TEXT CONSTt10,INT CONSTm10,n10):INT CONSTu10:=m10-1;c10INCRu10;d10:=
+min(n10,i1+u10-e10-2);outsubtext(t10,c10,d10);d10DECRu10END PROCp10;PROCn7:LETv10=""27"k";TEXT VARw10;fensterveraendert(d5);x10;y10;REPz10UNTILw10<>v10END REP;IFpos(z4,"!","�",1)>0THENa5:=z4END IF.x10:IFiserrorTHENfehlerausgeben;z4:=a5ELSEz4:=r0END IF.y10:cursor(1,1);out(j4);outsubtext(z1,1,i1-15);out(o4).z10:cursor(16,1);editget(z4,32000,62,"","kh",w10);IFiserrorTHENclearerrorELIFw10=v10THENz4:=a5ELIFw10=a11THENz4:=r0END IF.END PROCn7;PROCe7(TEXT CONSTo2):errorstop(""""+o2+""""+l4)END PROCe7;TYPE AUSWAHL=STRUCT(SATZh2);BOUND ROW200AUSWAHL VARb11;PROCt2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex:=link(q3(3),name);IFindex=0THENinsert(q3(3),name,index)END IF;t2(b11(index))END IF END PROCt2;PROCt2(AUSWAHL VARa):s3;c11;d11.s3:satzinitialisieren(a.h2).c11:INT VARy3:=1;REPq0;IFt0THEN LEAVEc11ELSEe11;y3INCR1END IF END REP.e11:feldaendern(a.h2,y3,o0).d11:IF NOTz0(f0)THENx0(n3)END IF.END PROCt2;LETf11=""10"",g11="+"27"q";LETh11=
+#715#"Fenster zu klein",i11=
+#716#"AUSWAHL:  Ankreuzen: 'x'  Durchstreichen: 'o'  Beenden: ESC q  Hilfe: ESC ?";
+INT VARj11,k11,l11,m11,n11,o11;BOOL VARp11;LET INTVEC=TEXT;INTVEC VARq11;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,1024,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,s11,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,t11,PROC(TEXT VAR,INT CONST)s5):p2;INT CONSTindex:=link(q3(3),name);IFindex=0THENe7(name)ELSEu11;f7(b11(index),f,r11,s11,PROC(TEXT VAR,INT CONST)s5)END IF.u11:INT VARy5;q11:=r0;FORy5FROM1UPTOlength(t11)REPq11CATcode(t11SUBy5)END REP.END PROCauswahlanbieten;PROCf7(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONSTr11,INT CONSTs11,PROC(TEXT VAR,INT CONST)s5):INT VARs4:=0,u7:=0;enablestop;v11;statusanzeigen(i11);w11;x11;y11;REPy7;z11END REP.v11:BOOL VARdummy;fensterzugriff(f,dummy);
+fenstergroesse(f,j1,k1,i1,h1).w11:INT VARa12:=1024;l11:=a12;REPa12:=a12DIV2;s5(o0,l11);IFo0=r0THENl11DECRa12ELSEl11INCRa12END IF UNTILa12=1END REP;s5(o0,l11);IFo0=r0THENl11DECR1END IF.x11:m11:=felderzahl(a.h2)+2;o11:=0;b12;IFm11>=h1THENerrorstop(h11)END IF.y11:INT VARc12:=m11+1,d12,e12:=1;p11:=s11>1.y7:REPf8;IFiserrorTHENclearerror;s4:=0ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;WHILEs4<h1REPh8:=getcharety;j8END REP;l8;m8(h8).j8:IFh8=r0THEN IFs4=m11THENd12:=999;n11:=10END IF;s4INCR1;f12ELSE LEAVEf8END IF.f12:l1(1,s4);IFs4<=m11THENg12ELSEh12END IF.g12:IFs4=1THENf2(i1)ELIFs4=m11THENi2(i1)ELSEp8(a.h2,s4)END IF.h12:INT CONSTi12:=s4+o11-m11;IFs4=h1THENj2(i1)ELIFi12<=l11THENj12(i12,k12,FALSE,PROC(TEXT VAR,INT CONST)s5);n11:=max(n11,length(o0))ELIFi12=l11+1THENi2(i1)ELSEout(u1);outsubtext(z1,1,i1-2);out(u1)END IF.k12:s4>=j11ANDs4<=k11.l8:IFc12<>d12THEN IFd12<=s4THENl12END IF;m12END IF;cursor(1,1).l12:l1(5,d12);j12(d12+o11-m11,FALSE,PROC(TEXT VAR,INT CONST)s5).m12:l1(5,c12);j12(e12,TRUE,PROC(
+TEXT VAR,INT CONST)s5);d12:=c12.z11:SELECTu7OF CASE0:r8CASE1:s8CASE2:t8END SELECT.r8:SELECTpos(""1""3""10""13""27" +x-o",h8)OF CASE1:u7:=1CASE2:w8CASE3:y8CASE4:z8CASE5:u7:=2CASE6:n12CASE7,8:o12CASE9,10:p12OTHERWISEa9END SELECT.s8:SELECTpos(""3""10"+x-o",h8)OF CASE1:c9CASE2:d9CASE3,4:q12CASE5,6:r12OTHERWISEout(j3)END SELECT;u7:=0.t8:SELECTpos(""1"19?qh",h8)OF CASE1:eschopausfuehrenCASE2:s12CASE3:t12CASE4:f9CASE5:g9CASE6:errorstop(r0)OTHERWISEh9END SELECT;u7:=0.w8:IFe12>1THENc12DECR1;e12DECR1;IFc12<=m11THENc12INCR1;o11DECR1;b12;s4:=min(s4,m11)END IF END IF.y8:IFe12<l11THENc12INCR1;e12INCR1;IFc12>=h1THENc12DECR1;o11INCR1;b12;s4:=min(s4,m11)END IF END IF.z8:push(f11).n12:push(g11).o12:IFu12(e12)=0ANDe12<=l11THENv12;w12END IF.v12:BOOL CONSTx12:=abs(s11)<=length(q11)DIV2;IFx12THENq11:=subtext(q11,3)END IF;q11CATe12.w12:IFx12THENy12ELIFc12<=s4THENz12(c12,length(q11)DIV2)END IF.p12:INT CONSTa13:=u12(e12);IFa13>0THENb13;y12END IF.b13:change(q11,2*a13-1,2*a13,r0).a9:IFh8<s0THENpush(
+lernsequenzauftaste(h8))ELSEout(j3)END IF.c9:IFc12=m11+1THENc13ELSEd13END IF.c13:INT VARe13:=min(h1-m11-1,o11);o11DECRe13;e12DECRe13;IFe13>0THENb12;s4:=min(s4,m11)END IF.d13:e13:=c12-m11-1;c12DECRe13;e12DECRe13.d9:IFc12=h1-1THENf13ELSEg13END IF.f13:e13:=min(h1-m11-1,l11-e12);o11INCRe13;e12INCRe13;IFe13>0THENb12;s4:=min(s4,m11)END IF.g13:e13:=min(l11-e12,h1-c12-1);c12INCRe13;e12INCRe13.q12:IFl11>abs(s11)THENout(j3);LEAVEq12END IF;INT VARh13;FORh13FROM1UPTOl11REP IFu12(h13)=0THENq11CATh13END IF END REP;y12.r12:q11:=r0;y12.f9:hilfeanbieten(r11,f);statusanzeigen(i11);s4:=0.g9:LEAVEf7.h9:push(lernsequenzauftaste(h8)).s12:c12:=m11+1;e12:=1;o11:=0;b12;s4:=min(s4,m11).t12:INT CONSTi13:=m11+l11;IFi13<h1THENc12:=i13;o11:=0ELSEc12:=h1-1;o11:=i13-h1+1;s4:=min(s4,m11)END IF;b12;e12:=l11.END PROCf7;PROCy12:INT VARv9,h13;h13:=j13;FORv9FROMk13UPTOl13REPz12(v9,u12(h13));h13INCR1END REP.j13:o11+1.k13:m11+1.l13:min(h1-1,m11+l11).END PROCy12;PROCb12:INT CONSTm13:=h1-m11-1;IFo11=0THENj11:=1ELSEj11:=max(1,
+o11*m13DIVl11)+1END IF;IFl11<=m13THENk11:=l11ELIFl11-o11=m13THENk11:=m13ELSEk11:=min(j11+m13*m13DIVl11,m13-1)END IF;j11INCRm11;k11INCRm11END PROCb12;TEXT VARn13:="xx";INT PROCu12(INT CONSTo13):replace(n13,1,o13);INT VARg4:=0;REPg4:=pos(q11,n13,g4+1)UNTILg4=0ORg4MOD2=1END REP;(g4+1)DIV2END PROCu12;OP CAT(INTVEC VARp13,INT CONSTwert):replace(n13,1,wert);p13CATn13END OP CAT;PROCj12(INT CONSTq13,BOOL CONSTr13,i10,PROC(TEXT VAR,INT CONST)s5):out(u1);s13;j12(q13,i10,PROC(TEXT VAR,INT CONST)s5);t13;out(u1).s13:INT CONSTu13:=u12(q13);IFu13=0THENout("   ")ELIFp11THENout(text(u13,3));ELSEout(" x ")END IF.t13:IFr13THENout(x1)ELSEout(y1)END IF.END PROCj12;PROCj12(INT CONSTq13,BOOL CONSTi10,PROC(TEXT VAR,INT CONST)s5):s5(o0,q13);INT VARv13:=min(i1-8,length(o0));IFi10THENv13:=min(v13,i1-9);out(""15"")ELSEout(" ")END IF;outsubtext(o0,1,v13);w13.w13:IFi10THENoutsubtext(z1,1,n11-v13+1);out(""14"");outsubtext(z1,1,i1-n11-10)ELSEoutsubtext(z1,1,i1-v13-8)END IF.END PROCj12;PROCz12(INT CONSTo0,wert):l1(2,
+o0);IFwert=0THENout("   ")ELIFp11THENout(text(wert,3))ELSEout(" x ")END IF END PROCz12;INT PROCwahl(INT CONSTx13):IFx13+x13<=length(q11)THENq11ISUBx13ELSE0END IF END PROCwahl;LETy13=200,z13=5000;LET HILFE=STRUCT(INTa14,ROWy13THESAURUSb14,ROWy13SATZc14,ROWz13SATZd14);BOUND HILFE VARe14;INT VARf14,g14,h14,i14;BOOL VARj14:=FALSE;TEXT VARk14;LETl14=
+#717#"Das Hilfsgebiet existiert bereits",m14=
+#718#"Diese Seite ist in der anderen Hilfe nicht vorhanden";
+PROCu2:TEXT VARname:=e1;BOOL VARn14;IFname=r0THENx0(o3)ELSEo14;p14;q14END IF.o14:INT CONSTr14:=pos(name,"/");TEXT VARs14;IFr14=0THENs14:=nameELSEs14:=subtext(name,1,r14-1)END IF;t14;u14.t14:INT VARv14:=link(q3(1),s14);n14:=FALSE;IFv14=0THENinsert(q3(1),s14,v14);e14.b14(v14):=emptythesaurus;satzinitialisieren(e14.c14(v14));ELIFr14=0THENx0(l14);LEAVEu2ELIFj14THENn14:=TRUE END IF.u14:INT VARw14;TEXT VARx14:=subtext(name,r14+1);IFr14=0THENw14:=1ELSEw14:=link(e14.b14(v14),x14);IFw14=0AND NOTn14THENinsert(e14.b14(v14),x14,w14)END IF END IF.p14:INT VARy14:=e14.a14;IFy14<0THENy14:=0END IF;TEXT VARz14:=r0;q0;WHILEt0CANDz0(i0)REPa15END REP.a15:INT CONSTb15:=b1;TEXT CONSTc15:=e1;IFc15<>r0THENd15;q0ELSEe15END IF.d15:TEXT VARf15;g15(c15,f15);IFb15+b15<=length(f15)THENz14CAT(f15ISUBb15)ELIF NOT(anythingnotedORn14)THENx0(m14)END IF.e15:INT VARy3:=1;IF NOTn14THENy14INCR1;z14CATy14;satzinitialisieren(e14.d14(y14))END IF;k14:=r0;REPq0;IFt0THEN LEAVEe15ELIF NOTn14THENh15END IF END REP.h15:k14CATo0;
+feldaendern(e14.d14(y14),y3,k14);IFi15THENy3INCR1;k14:=r0ELSEk14CATs0END IF.i15:(k14SUB LENGTHk14)=s0.q14:IF NOTz0(f0)THENx0(n3)END IF;IF NOT(anythingnotedORn14)THENfeldaendern(e14.c14(v14),w14,z14);e14.a14:=y14END IF.END PROCu2;PROCg15(TEXT CONSTname,TEXT VARz14):INT CONSTr14:=pos(name,"/");INT VARs14,w14:=0;IFr14=0THENs14:=link(q3(1),name)ELSEs14:=link(q3(1),subtext(name,1,r14-1));j15END IF;IFw14=0THENw14:=1END IF;IFs14=0THENerrorstop(k15)ELSEfeldlesen(e14.c14(s14),w14,z14)END IF.j15:IFs14>0THENw14:=link(e14.b14(s14),subtext(name,r14+1))END IF.END PROCg15;LETk15=
+#719#"Hilfe existiert nicht",l15=
+#720#"Hilfe ist leer",m15=
+#721#" Seite ",n15=
+#722#" von ",o15=
+#723#"HILFE:  Beenden: ESC q  Seite weiter: ESC UNTEN  Seite zurueck: ESC OBEN";
+TEXT VARp15;INT VARq15,r15,s15;BOOL VARt15:=TRUE;PROCvielhilfe(BOOL CONSTu15):t15:=u15END PROCvielhilfe;BOOL PROCvielhilfe:t15END PROCvielhilfe;PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;p2;TEXT VARz14;v15;g15(name,z14);IFz14=r0THENerrorstop(l15)ELSEw15END IF.v15:fensterveraendert(f);fenstergroesse(f,f14,g14,h14,i14).w15:INT CONSTx15:=length(z14)DIV2;y15;statusanzeigen(o15);INT VARc14:=1;REPz15;a16END REP.z15:INT CONSTb16:=z14ISUBc14;p15:=m15+text(c14)+n15;p15CATtext(x15);p15CAT" ";IFlength(p15)+2>h14THENp15:=r0END IF;c16(e14.d14(b16)).a16:TEXT VARh8;REPgetchar(h8);IFh8=k3THENgetchar(h8);o7;LEAVEa16ELSEout(j3)END IF END REP.o7:SELECTpos("q"10""3"?"1"",h8)OF CASE1:LEAVEhilfeanbietenCASE2:d16CASE3:e16CASE4:f16CASE5:eschopausfuehrenOTHERWISEout(j3)END SELECT.d16:IFc14<x15THENc14INCR1END IF.e16:IFc14>1THENc14DECR1END IF.f16:c14:=1.END PROChilfeanbieten;PROCc16(SATZ CONSTg16):INT VARy3;r15:=1;s15:=0;g12;q15:=0;FORy3FROM1UPTOi14-2REPcursor(f14,g14+y3);feldbearbeiten(g16,r15,
+PROC(TEXT CONST,INT CONST,INT CONST)x5)END REP;h16.g12:cursor(f14,g14);f2(h14,p15).h16:cursor(f14,g14+i14-1);j2(h14);cursor(1,1).END PROCc16;PROCx5(TEXT CONSTx2,INT CONSTm10,n10):d10:=min(s15+m10+h14-3-q15,n10);IFm10<=n10CAND(x2SUBm10)="-"THENi2(h14);r15INCR1;q15:=0ELSEi16;j16;k16END IF.i16:IFd10<n10THEN IFl16CANDm16THENn16END IF END IF.l16:(x2SUBd10+1)<>" "AND(x2SUBd10)<>" ".m16:pos(x2," ",s15+m10,d10)>0.n16:WHILE(x2SUBd10)<>" "REPd10DECR1END REP.j16:out(u1);outsubtext(z1,1,q15);outsubtext(x2,m10+s15,d10);outsubtext(z1,1,h14+m10+s15-q15-d10-3);out(u1).k16:IFd10<n10THENo16;s15:=d10-m10+1;d10INCR1;WHILE(x2SUBd10)=" "REPs15INCR1;d10INCR1END REP ELSEs15:=0;r15INCR1;q15:=0END IF.o16:IFq15=0CANDs15=0THENq15:=pos(x2,"  ",m10,d10);IFq15>0THENp16END IF END IF.p16:WHILE(x2SUBq15)=" "REPq15INCR1END REP;q15DECRm10.END PROCx5;BOOL VARq16:=TRUE;PROCstatuszeile(BOOL CONSTr16):q16:=r16END PROCstatuszeile;BOOL PROCstatuszeile:q16END PROCstatuszeile;PROCstatusanzeigen(TEXT CONSTstatus):IFq16THENcursor(
+1,1);out(" ");out(status);out(l2);fensterveraendert(d5)END IF END PROCstatusanzeigen;LETs16=20;ROWs16INT VARt16;INT VARu16,v16,w16,x16,y16,z16;TEXT VARr5;PROCa17(MENUE CONSTr3,INT CONSTb17,INT VARwahl):enablestop;BOOL VARc17:=FALSE;REP IF NOTc17THENd17END IF;e17;o7END REP.d17:INT VARy5;cursor(b17,w16);u16:=b17;t16(1):=u16;FORy5FROM1UPTOfelderzahl(r3.x2)REPout(" ");u16INCR1;feldbearbeiten(r3.x2,y5,PROC(TEXT CONST,INT CONST,INT CONST)f17);out(" ");u16INCR1;t16(y5+1):=u16;END REP;v16:=u16;c17:=TRUE;g17(r3.x2,wahl).e17:TEXT VARh17;getchar(h17).o7:SELECTpos(""2""8""13" "1""27"",h17)OF CASE1:i17(r3.x2,wahl,wahl+1)CASE2:i17(r3.x2,wahl,wahl-1)CASE3,4:j17(r3.x2,wahl);LEAVEa17CASE5:k17CASE6:l17OTHERWISEm17END SELECT.m17:INT VARn17:=0;REPn17:=pos(r3.a3,h17,n17+1)UNTIL(n17MOD2)=0END REP;IFn17=0THEN IFh17<" "THENpush(""27""+h17)ELSEout(""7"")END IF ELSEi17(r3.x2,wahl,code(r3.a3SUBn17-1));j17(r3.x2,wahl);LEAVEa17END IF.l17:TEXT VARo17;getchar(o17);SELECTpos(""1"qh?"27"",o17)OF CASE1:eschopausfuehren
+CASE2:wahl:=0;LEAVEa17CASE3:errorstop("")CASE4:j17(r3.x2,wahl);wahl:=-wahl;LEAVEa17CASE5:wahl:=-32000;LEAVEa17OTHERWISEpush(lernsequenzauftaste(o17))END SELECT.k17:getchar(o17);SELECTpos(""8""2"",o17)OF CASE1:i17(r3.x2,wahl,1)CASE2:i17(r3.x2,wahl,felderzahl(r3.x2))OTHERWISEout(""7"")END SELECT.END PROCa17;PROCp17(SATZ CONSTx2,INT CONSTwahl):IFx16>0THENcursor(1,x16);out(""15"");out(r5);u16:=length(r5)+1;feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)q17);out(" "14"")END IF END PROCp17;PROCg17(SATZ CONSTx2,INT CONSTwahl):p17(x2,wahl);cursor(t16(wahl),w16);out(""15"");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out(" "14"");cursor(y16,z16)END PROCg17;PROCi17(SATZ CONSTx2,INT VARwahl,INT CONSTs17):t17;wahl:=s17;IFwahl<1THENwahl:=felderzahl(x2)ELIFwahl>felderzahl(x2)THENwahl:=1END IF;g17(x2,wahl).t17:cursor(t16(wahl),w16);out(" ");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out("  ").END PROCi17;PROCj17(SATZ CONSTx2,INT CONSTwahl):cursor(
+t16(1),w16);t16(wahl)-t16(1)+1TIMESOUT" ";feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);v16-t16(wahl+1)+2TIMESOUT" "END PROCj17;PROCf17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17);u16INCRu17-m10+1END PROCf17;PROCr17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17)END PROCr17;PROCq17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)+1;IFu17<2THENu17:=n10+1END IF;xsize-5-u16-n10+u17TIMESOUT" ";outsubtext(h10,u17,n10)END PROCq17;PROCzeilenmenueanbieten(TEXT CONSTv17,BOOL CONSTz5,PROC(INT CONST)z2):BOOL VARm6:=t4;INT VARw17:=link(q3(2),v17);IFw17=0THENe7(v17);LEAVEzeilenmenueanbietenEND IF;w16:=ysize;x16:=ysize-1;getcursor(y16,z16);r5:=v17;disablestop;t4:=TRUE;x17;o7;t4:=m6.x17:INT VARwahl:=1;REPa17(c3(w17),1,wahl);IFwahl>=0THEN LEAVEx17ELIFwahl=-32000THEN IFz5THEN LEAVEx17END IF ELSEwahl:=-wahl;TEXT VARy17;feldlesen(c3(w17).y2,
+wahl,y17);hilfeanbieten(y17,s9)END IF UNTILiserrorEND REP.o7:IFwahl>0THENz17(wahl,PROC(INT CONST)z2)ELIFwahl=-32000THENa18END IF.a18:cursor(1,ysize-1);out(""4"");out(j4);out(""14"");TEXT VARdummy:="";editget(dummy);IFdummy<>""THENdo(dummy)END IF.END PROCzeilenmenueanbieten;PROCz17(INT CONSTwahl,PROC(INT CONST)z2):enablestop;z2(wahl)END PROCz17;LETr7=""4"",b18=""27"?",c18=""27"q",a11=""27"h";LETd18=
+#726#" ?",e18=
+#727#"WAHL:  Wählen: <-, ->  Bestätigen: RETURN  Abbruch: ESC h  Hilfe: ESC ?",f18=
+#728#"FRAGE:  Bejahen: j,J    Verneinen: n,N    Abbrechen: ESC h    Hilfe: ESC ?",g18=
+#729#"EINGABE:  Bestätigen: RETURN    Abbrechen: ESC h    Hilfe: ESC ?",h18=
+#730#"EINGABE:  Bestätigen: RETURN   Zeigen: ESC z   Abbruch: ESC h  Hilfe: ESC ?",i18=
+#731#""15"!!! FEHLER !!! "14"     Quittieren: ESC q     Hilfe zur Meldung: ESC ?";
+FENSTER VARs9;fensterinitialisieren(s9);INT VARj18,k18,l18,m18,n18;PROCdialogfenster(FENSTER CONSTo18):fenstergroesse(o18,k18,l18,m18,n18);fenstergroessesetzen(s9,o18)END PROCdialogfenster;FENSTER PROCdialogfenster:s9END PROCdialogfenster;PROCneuerdialog:j18:=n18END PROCneuerdialog;PROCp18:BOOL VARw5;fensterzugriff(s9,w5);j18INCR3;IFj18+3>n18ORw5THENq18;j18:=1END IF;r18;cursor(k18+1,l18+j18).r18:cursor(k18,l18+j18-1);f2(m18);cursor(k18,l18+j18);s18;cursor(k18,l18+j18+1);s18;cursor(k18,l18+j18+2);j2(m18).END PROCp18;PROCs18:out(u1);outsubtext(z1,1,m18-2);out(u1)END PROCs18;PROCdialog(TEXT CONSTt18):p18;outsubtext(t18,1,m18-2);cursor(k18+1,l18+j18+1)END PROCdialog;PROCdialogfensterloeschen:fensterveraendert(s9);q18END PROCdialogfensterloeschen;PROCq18:BOOL CONSTu18:=k18+m18>=xsize;j18:=0;REPcursor(k18,l18+j18);IFu18THENout(l2)ELSEoutsubtext(z1,1,m18)END IF;j18INCR1UNTILj18>=n18END REP END PROCq18;PROCauswahlanbieten(TEXT CONSTv17,r5,r11,INT VARv18):INT VARw18:=link(q3(2),v17);IFw18=0THEN
+e7(v17);LEAVEauswahlanbietenEND IF;REPstatusanzeigen(e18);p18;outsubtext(r5,1,m18-2);x17END REP.x17:INT CONSTx18:=v18;w16:=l18+j18+1;x16:=0;y16:=1;z16:=1;a17(c3(w18),k18+1,v18);IFv18>=0THEN IFv18=0THENv18:=x18END IF;LEAVEauswahlanbietenELIFv18=-32000THENv18:=1ELSEhilfeanbieten(r11,s9);neuerdialog;v18:=-v18END IF.END PROCauswahlanbieten;BOOL PROCja(TEXT CONSTy18,r11):ja(y18,r11,TRUE)END PROCja;BOOL PROCja(TEXT CONSTy18,r11,BOOL CONSTz18):INT VARwahl;IFz18THENwahl:=1ELSEwahl:=2END IF;REPstatusanzeigen(f18);IFt4THENcursor(1,ysize);INT CONSTa19:=min(length(y18),xsize-16);outsubtext(y18,1,a19);out(""5"")ELSEp18;outsubtext(y18,1,m18-4);END IF;out(d18);y15;b19END REP;FALSE.b19:c19;a17(d19,e19,wahl);IFwahl=1THEN LEAVEjaWITH TRUE ELIFwahl=2THEN LEAVEjaWITH FALSE ELIFwahl=-32000THENwahl:=1ELIFwahl=0THENerrorstop("")ELSEhilfeanbieten(r11,s9);neuerdialog;wahl:=-wahlEND IF.c19:INT VARe19;IFt4THENw16:=ysize;x16:=0;e19:=a19+4ELSEw16:=l18+j18+1;x16:=0;y16:=1;z16:=1;e19:=k18+1END IF.d19:c3(link(q3(2),
+"WAHL.Ja")).END PROCja;PROCeditget(TEXT CONSTr5,TEXT VARh8,TEXT CONSTf19,r11):TEXT VARw10;g19;IFt4THENcursor(1,ysize);out(""5"");put(r5);ELSEdialog(r5);cursor(k18+1,l18+j18+1)END IF;editget(h8,1000,h19,"","?hq"+f19,w10);cursor(1,1);IFw10=b18THENhilfeanbieten(r11,s9);neuerdialog;editget(r5,h8,f19,r11)ELIFw10=a11ORw10=c18THENerrorstop(r0)ELIFlength(w10)=2THENh8:=w10+h8END IF.g19:IFpos(f19,"z")>0THENstatusanzeigen(h18)ELSEstatusanzeigen(g18)END IF.h19:IFt4THENxsize-length(r5)-2ELSEm18-4END IF.END PROCeditget;PROCfehlerausgeben:TEXT CONSTg1:=errormessage;IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;y15;IFg1<>r0THENstatusanzeigen(i18);i19;j19;neuerdialogEND IF.i19:p18;out(j3);out(">>> ");cursor(k18+1,l18+j18+1);outsubtext(errormessage,1,m18-2).j19:TEXT VARh8;cursor(1,1);getchar(h8);IFh8=k3THENk19END IF.k19:getchar(h8);IFh8="?"THENhilfeanbieten("FEHLER/"+text(errorcode),s9)ELIFh8=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCy15:WHILEgetcharety<>r0REP END REP END PROCy15
+;LETl19=3,m19=12,n19=14,o19=1070,p19=1068,q19=1069,r19=0,s19=2;ROWl19DATASPACE VARw2;ROWl19THESAURUS VARq3;BOOL VARt19:=FALSE;INITFLAG VARu19;PROCp2:IF NOTinitialized(u19)THENv19END IF.v19:BOOL VARp7:=t19;w19;IFp7THENx19ELSEmenueloeschen(FALSE)END IF.w19:INT VARy19;FORy19FROM1UPTOl19WHILEp7REPz19END REP.z19:INT VARa20,b20;FORb20FROM1UPTO10REPforget(w2(y19));w2(y19):=nilspace;pingpong(father,o19+y19,w2(y19),a20);IFa20=r19THEN LEAVEz19ELIFa20<>s19THENpause(15)END IF UNTILa20=s19END REP;forget(w2(y19));w2(y19):=nilspace;p7:=FALSE.END PROCp2;THESAURUS PROCmenuenamen(INT CONSTy19):p2;IFy19<0THENe14.b14(-y19)ELSEq3(y19)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTy19):p2;IFy19<0THENc20(name,e14.b14(-y19))ELSEc20(name,q3(y19))END IF END PROCmenueloeschen;PROCc20(TEXT CONSTname,THESAURUS VARt10):INT CONSTindex:=link(t10,name);IFindex>0THENdelete(t10,index)END IF END PROCc20;PROCmenueloeschen(BOOL CONSTd20):INT VARy19;u19:=TRUE;j14:=d20;FORy19FROM1UPTOl19REPforget(w2(y19)
+);w2(y19):=nilspace;q3(y19):=emptythesaurusEND REP;x19END PROCmenueloeschen;PROCx19:e14:=w2(1);c3:=w2(2);b11:=w2(3)END PROCx19;LETe20=
+#732#"Datei wird von anderer Task geaendert.",f20=
+#733#"Auftrag nur fuer Soehne erlaubt";
+THESAURUS VARg20:=emptythesaurus;ROW200TASK VARh20;TEXT VARi20;BOUND STRUCT(TEXTname,j20,k20)VARl20;PROCmenuemanager(DATASPACE VARm20,INT CONSTn20,o20,TASK CONSTp20):enablestop;t19:=TRUE;IFn20>=p19ANDn20<=o19+l19THENq20ELSE IFn20=m19ORn20=n19THENr20END IF;freemanager(m20,n20,o20,p20)END IF.q20:IFn20=p19THENs20ELIFn20=q19THENt20ELSEu20END IF.s20:l20:=m20;v20(l20.name,p20);send(p20,r19,m20).t20:l20:=m20;w20(l20.name);send(p20,r19,m20).r20:IFo20=1THENx20ELIFn20=n19THENw20(i20)END IF.x20:l20:=m20;i20:=l20.name;IFy20THENerrorstop(e20)END IF.y20:INT VARx13:=link(g20,i20);x13>0CAND NOT(h20(x13)=p20).u20:IFp20<myselfTHENp2;forget(m20);m20:=w2(n20-o19);send(p20,r19,m20)ELSEerrorstop(f20)END IF.END PROCmenuemanager;PROCv20(TEXT CONSTo2,TASK CONSTz20):INT VARy5:=link(g20,o2);IFy5=0THENinsert(g20,o2,y5);a21;h20(y5):=z20ELIFexists(h20(y5))THEN IF NOT(h20(y5)=z20)THENerrorstop(e20)END IF ELSEh20(y5):=z20END IF.a21:IFy5=0THENb21;insert(g20,o2,y5)END IF.b21:TEXT VARc21;y5:=0;REPget(g20,c21,y5);IFy5=0
+THEN LEAVEb21END IF;IF NOTexists(c21)OR NOTexists(h20(y5))THENdelete(g20,y5)END IF END REP.END PROCv20;PROCw20(TEXT CONSTo2):INT VARy5;delete(g20,o2,y5)END PROCw20;PROCglobalmanager:globalmanager(PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)menuemanager)END PROCglobalmanager;PROClock(TEXT CONSTo2,TASK CONSTd21):call(p19,o2,d21)END PROClock;PROCfree(TEXT CONSTo2,TASK CONSTd21):call(q19,o2,d21)END PROCfree;END PACKETeudasmenues;
+
diff --git a/app/eudas/5.3/src/pos.173 b/app/eudas/5.3/src/pos.173
new file mode 100644
index 0000000..a9706a3
--- /dev/null
+++ b/app/eudas/5.3/src/pos.173
@@ -0,0 +1,19 @@
+PACKET xpos DEFINES x pos : 
+INT PROC x pos (TEXT CONST a, b, INT CONST c, d) : 
+  pos (a, b, c, d) 
+END PROC x pos; 
+END PACKET x pos; 
+PACKET pos 173 DEFINES pos: 
+INT PROC pos (TEXT CONST a, b, INT CONST c, d) : 
+  x pos (a, b, c, d+1) 
+END PROC pos; 
+END PACKET pos 173; 
+PACKET add 173 DEFINES split line, reserve : 
+PROC split line (FILE VAR f, INT CONST spalte, BOOL CONST dummy) : 
+  split line (f, spalte) 
+END PROC split line; 
+PROC reserve (TEXT CONST modus, TASK CONST task) : 
+  call (19, modus, task) 
+END PROC reserve; 
+END PACKET add 173; 
+
diff --git a/app/eumelbase/2.2.1-schulis/source-disk b/app/eumelbase/2.2.1-schulis/source-disk
new file mode 100644
index 0000000..377f161
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/source-disk
@@ -0,0 +1 @@
+schulis-grundpaket-schulverwaltung-2.2.1/01_eumelbase-quellen.img
diff --git a/app/eumelbase/2.2.1-schulis/src/ACCESS.files b/app/eumelbase/2.2.1-schulis/src/ACCESS.files
new file mode 100644
index 0000000..521f1a1
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/ACCESS.files
@@ -0,0 +1,7 @@
+db ref.sc 
+db sel.sc 
+db q.sc 
+db memory.sc 
+db access.sc 
+db ersatz.sc
+
diff --git a/app/eumelbase/2.2.1-schulis/src/DIALOG.files b/app/eumelbase/2.2.1-schulis/src/DIALOG.files
new file mode 100644
index 0000000..2cad586
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/DIALOG.files
@@ -0,0 +1,8 @@
+isp edit.sc 
+screen manager.sc 
+window manager packets.sc 
+dialog.sc 
+db sel auswertung.sc 
+db dialog.sc
+
+
diff --git a/app/eumelbase/2.2.1-schulis/src/MM BAISY.files b/app/eumelbase/2.2.1-schulis/src/MM BAISY.files
new file mode 100644
index 0000000..6fb77a7
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/MM BAISY.files
@@ -0,0 +1,3 @@
+db manager.sc 
+
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db access.sc b/app/eumelbase/2.2.1-schulis/src/db access.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db access.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/eumelbase/2.2.1-schulis/src/db archive.sc b/app/eumelbase/2.2.1-schulis/src/db archive.sc
new file mode 100644
index 0000000..e68c5ce
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db archive.sc
@@ -0,0 +1,7 @@
+ PACKETdbarchive DEFINESdbtoarchive,dbfromarchive: TEXT VARuuuuuv:=""; PROCdbtoarchive( TEXT CONSTuuuuux):enablestop;logonarchive;fetchdb(uuuuux);uuuuuz;savetoarchive
+(db);uuuuvu;logoffarchive. ENDPROCdbtoarchive; PROCdbfromarchive( TEXT CONSTuuuuux):dbfromarchive(uuuuux,"") ENDPROCdbfromarchive; PROCdbfromarchive( TEXT CONSTuuuuux
+, TEXT CONSTuuuuwx):enablestop;logonarchive;uuuuuv:=postfix;postfix(uuuuwx);fetchfromarchive;uuuuuz; IF NOTtaskda(uuuuux) THEN IFyes("Server anlegen") CANDuuuuxw THEN
+restoredb(uuuuux);uuuuvu FI ELSErestoredb(uuuuux);uuuuvu FI;uuuuyv.uuuuyv:postfix("");fetchdd(uuuuux); BOOL VARuuuuyy:=dbopen(uuuuux);postfix(uuuuuv);logoffarchive
+.uuuuxw: IF NOTexists(uuuuux) THENcopy(uuuuux+uuuuwx,uuuuux) FI;createdb(uuuuux). ENDPROCdbfromarchive; PROCuuuuuz: IFonline THENline; FI ENDPROCuuuuuz; PROCuuuuvu
+:commanddialogue( FALSE);forget(db);commanddialogue( TRUE) ENDPROCuuuuvu; ENDPACKETdbarchive;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db ddinfo.sc b/app/eumelbase/2.2.1-schulis/src/db ddinfo.sc
new file mode 100644
index 0000000..3993705
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db ddinfo.sc
@@ -0,0 +1,24 @@
+ PACKETddinfopacket DEFINESddinfo: REAL PROCuuuuuv( INT CONSTuuuuuw):records(uuuuuw) ENDPROCuuuuuv; PROCddinfo( TEXT CONSTuuuuvu):ddinfo(uuuuvu,"") ENDPROCddinfo;
+ PROCddinfo( TEXT CONSTuuuuvu,uuuuwu): INT VARuuuuwv,uuuuww:=1,uuuuwx; TEXT VARuuuuwy; IFuuuuvu="" ORuuuuvu="screen" THENpage ELSEforget(uuuuvu+".dd",quiet);sysout
+(uuuuvu+".dd"); IFuuuuvu="printer" THENputline("#type("""+uuuuwu+""")#") FI FI;uuuuxz;putline(" Datenbank:  <"+name(1)+">");putline("     Anzahl Dateien    erster Index   Max DatID  1. Freier Eintrag"
+);putline("              "+text(anzdateien)+"            "+text(firstindex)+"              "+text(maxdatid)+"              "+text(firstfree));uuuuyu;uuuuwv:=2; WHILE
+uuuuwv<firstfree REP IFwas(uuuuwv)=dateieintrag THENuuuuyy ELIFwas(uuuuwv)=indexeintrag THENuuuuzu ELSEuuuuwv INCR1 FI END REP;uuuuzw;uuuuzx;uuuuzy;uuuuzz; IFuuuuvu
+="" ORuuuuvu="screen" THENout("<RETURN>");pause;page ELSEsysout(""); IFuuuuvu="printer" THENprint(uuuuvu+".dd");forget(uuuuvu+".dd",quiet); FI FI.uuuuyy:uuuuxz;putline
+(" Datei:  "+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");uuuuwy:=compress(text(uuuuuv(uuuuwv),15,0));uuuuwy:=subtext(uuuuwy,1,length(uuuuwy)-1);putline("     Anzahl Schlüsselfelder: "
++text(anzkey(uuuuwv))+"   Befugnis: "+text(befugnis(uuuuwv))+"   Datensätze: "+uuuuwy);putline("         Feld                   Typ Länge XN YN XF YF Befug 1234567890123456"
+);uuuuwv INCR1;uuuuwx:=1; WHILEuuuuwv<firstfree CANDistfeld(was(uuuuwv)) REPuuuuxz;uuuvxz; IFlength(name(uuuuwv))>23 THENwrite(text(name(uuuuwv),23)+"<") ELSEwrite
+(text(name(uuuuwv),23)+" ") FI;write(code(feldtyp(uuuuwv))+"  "); IFfeldtyp(uuuuwv)=realfeld THENuuuuwy:=text(einglaenge(uuuuwv))+"."+text(nachkomma(uuuuwv));write
+(text("",5-length(uuuuwy)));write(uuuuwy+" ") ELSEwrite(text(einglaenge(uuuuwv),5)+" ") FI;write(text(posxname(uuuuwv),2)+" ");write(text(posyname(uuuuwv),2)+" ")
+;write(text(posxfeld(uuuuwv),2)+" ");write(text(posyfeld(uuuuwv),2)+" ");write(text(befugnis(uuuuwv),5)+" ");uuuwuy;line;uuuuwv INCR1; END REP;uuuuyu.uuuwvv:3*" "
+.uuuuzw:uuuuyu;line;write("INITIALISIERUNGEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFinitialisierung(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv
++"zu Feld "+text(text(uuuuwv),4)+": "+initialisierung(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuuzx:uuuuyu;line;write("PLAUSIBILITÄTEN");line;line;uuuuwv:=3; WHILE
+uuuuwv<firstfree REP IFplausi(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+plausi(uuuuwv),76)) FI;uuuuwv INCR1 PER;
+line.uuuuzy:uuuuyu;line;write("HILFSTEXTNUMMERN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFhilfstextnr(uuuuwv)>0 THENputline(uuuwvv+"zu Feld "+text(text(uuuuwv
+),4)+": "+text(hilfstextnr(uuuuwv))) FI;uuuuwv INCR1 PER;line.uuuuzz:uuuuyu;line;write("STANDARD-AKTIONEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFstandardaktion
+(uuuuwv) CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+zugriff(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuwuy: INT VARuuuxwx; FORuuuxwx
+ FROM1 UPTO16 REP IFswitch(uuuuwv,uuuxwx) THENwrite("*") ELSEwrite("-") FI PER.uuuuzu: TEXT VARuuuxxw:=""; WHILEuuuuwv<firstfree REPuuuuxz; IFphonetic(uuuuwv) THEN
+uuuxxw:=" Phon-Index: " ELSEuuuxxw:=" Index     : " FI;putline(uuuxxw+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");putline("     zu Datei   : "+name(dateinr(
+primdatid(uuuuwv))));putline("     über Felder: "+text(zugriff(uuuuwv),25));uuuuwv INCR1; PER.uuuuxz: TEXT VARindex:=text(uuuuww);write((3-length(index))*" ");write
+(index+")");uuuuww INCR1.uuuvxz:index:=text(uuuuwx);write((3-length(index))*" ");write(index+". ");uuuuwx INCR1.uuuuyu:write(6*"-------------");line. END PROCddinfo
+; BOOL PROCuuuwwv( INT CONSTuuuyuz):uuuyuz<>1 CANDwas(uuuyuz)<>dateieintrag CANDwas(uuuyuz)<>indexeintrag ENDPROCuuuwwv; ENDPACKETddinfopacket;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db ersatz.sc b/app/eumelbase/2.2.1-schulis/src/db ersatz.sc
new file mode 100644
index 0000000..bb8121d
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db ersatz.sc
@@ -0,0 +1,9 @@
+ PACKETdbersatz DEFINESinitsavedupdateposition,getsavedupdateposition,saveupdateposition,restoreupdateposition,changeindex,createdb,destroydb,updatedb,fetchdb,fetchdd
+,restoredb,postfix,db,definedserverstation: INT PROCdefinedserverstation:station(myself) ENDPROCdefinedserverstation; PROCfetchdb( TEXT CONSTuuuuuy): ENDPROCfetchdb
+; PROCfetchdd( TEXT CONSTuuuuuy): ENDPROCfetchdd; PROCrestoredb( TEXT CONSTuuuuuy): ENDPROCrestoredb; TEXT VARuuuuwu:=".archive"; TEXT PROCpostfix:uuuuwu ENDPROCpostfix
+; PROCpostfix( TEXT CONSTuuuuuy):uuuuwu:=uuuuuy ENDPROCpostfix; THESAURUS PROCdb:emptythesaurus ENDPROCdb; PROCinitsavedupdateposition( INT CONSTuuuuyu):putplausi
+(uuuuyu,"") ENDPROCinitsavedupdateposition; PROCgetsavedupdateposition( INT CONSTuuuuyu):puttupel(plausi(uuuuyu)); ENDPROCgetsavedupdateposition; PROCrestoreupdateposition
+( INT CONSTuuuuyu):puttupel(plausi(uuuuyu));putplausi(uuuuyu,"") ENDPROCrestoreupdateposition; PROCsaveupdateposition( INT CONSTuuuuyu):putplausi(uuuuyu,gettupel)
+ ENDPROCsaveupdateposition; BOOL PROCcreatedb( TEXT CONSTuuuvuz): TRUE ENDPROCcreatedb; BOOL PROCupdatedb( TEXT CONSTuuuvuz): TRUE ENDPROCupdatedb; BOOL PROCdestroydb
+( TEXT CONSTuuuvuz):cleardb(uuuvuz); TRUE ENDPROCdestroydb; PROCchangeindex: ENDPROCchangeindex; ENDPACKETdbersatz;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db kernel.sc b/app/eumelbase/2.2.1-schulis/src/db kernel.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db kernel.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/eumelbase/2.2.1-schulis/src/db manager.sc b/app/eumelbase/2.2.1-schulis/src/db manager.sc
new file mode 100644
index 0000000..edba990
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db manager.sc
@@ -0,0 +1,18 @@
+ PACKETdbmanager DEFINESgeneratedbmanager: LETuuuuuv=0,uuuuuw=1,uuuuux=2,#uuuuuy=3,uuuuuz=4,#uuuuvu=5,uuuuvv=12,uuuuvw=30,uuuuvx=31,uuuuvy=32,uuuuvz=33,uuuuwu=100
+; DATASPACE VARuuuuwv:=nilspace,uuuuww:=nilspace; TASK VARuuuuwx:=niltask,uuuuwy:=niltask; INT VARuuuuwz,uuuuxu:=0,uuuuxv; BOOL VARuuuuxw:= FALSE; BOUND TEXT VARuuuuxx
+; BOUND STRUCT( TEXTname,uuuuxy,uuuuxz) VARuuuuyu; TEXT VARuuuuyv:=""; PROCuuuuyw: IFiserror THENforget(uuuuwv);uuuuwv:=nilspace;uuuuxx:=uuuuwv; CONCR(uuuuxx):=errormessage
+;clearerror;send(uuuuwx,uuuuux,uuuuwv) FI ENDPROCuuuuyw; PROCgeneratedbmanager:break;setautonom;disablestop; REPwait(uuuuwv,uuuuwz,uuuuwx);#continue(2);write("Order :"
++text(uuuuwz)+" O-Task :"+name(uuuuwx));pause;break;# IFuuuuxw CANDuuuuwx<>uuuuwy THENuuuvvx ELSEcontrol FI;uuuvvy PER.uuuvvy: IFheapsize>uuuuxu+2 THENcollectheapgarbage
+;uuuuxu:=heapsize FI. ENDPROCgeneratedbmanager; PROCcontrol:commanddialogue( FALSE);#enablestop;# SELECTuuuuwz OF CASEuuuuvw:uuuvwz CASEuuuuvx:uuuvxv CASEuuuuvz:uuuvxx
+ CASEuuuuvy:uuuvxz CASEuuuuvu,uuuuvv:uuuvyw OTHERWISE: IFuuuuwz>=uuuuwu ANDuuuuwx=supervisor THENforget(uuuuwv);uuuvzv ELSEerrorstop("Falscher Auftrag fuer EUMELbase-Manager-Task ""MM""!"
+);uuuuyw FI; END SELECT.uuuvxz:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THENerrorstop("Datenbank-Server bereits vorhanden");uuuuyw ELSEuuuwux;uuuuxw:= TRUE
+;uuuwuz FI.uuuvxv:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THENend(uuuwuv) FI;uuuwuz.uuuvwz:uuuuxw:= FALSE;send(uuuwuv,uuuuuv,uuuuww,uuuuxv); IFuuuuxv<>uuuuuv
+ THENforget(uuuuww) FI.uuuvyw: IF NOTuuuuxw THENuuuuyu:=uuuuwv;uuuuyv:=uuuuyu.name; IFexists(uuuuyv) THENforget(uuuuyv,quiet) FI;uuuuwy:=uuuuwx;send(uuuuwx,uuuuvu
+,uuuuwv);uuuuxw:= TRUE ELSEuuuuxw:= FALSE;copy(uuuuwv,uuuuyv);uuuwuz FI.uuuvxx:uuuuww:=uuuuwv;forget(uuuuwv); IFuuuwuv<>niltask THEN REPsend(uuuwuv,uuuuvz,uuuuww,
+uuuuxv) UNTILuuuuxv=uuuuuv PER; ELSEuuuvxz FI;uuuwuz. END PROCcontrol; TASK PROCuuuwuv: TASK VARuuuxxu;disablestop;clearerror;uuuxxu:=task(uuuxxw); IFiserror THEN
+uuuxxu:=niltask FI;clearerror;enablestop;uuuxxu ENDPROCuuuwuv; TEXT PROCuuuxxw:forget("X",quiet);copy(uuuuww,"X"); IFdbopen("X") THENname(1) ELSE"???" FI ENDPROCuuuxxw
+; PROCuuuwux:begin(uuuxxw, PROCautonomserver,uuuuwy) END PROCuuuwux; PROCuuuwuz:forget(uuuuwv);uuuuwv:=nilspace;send(uuuuwx,uuuuuv,uuuuwv) END PROCuuuwuz; PROCuuuvvx
+:forget(uuuuwv);uuuuwv:=nilspace;send(uuuuwx,uuuuuw,uuuuwv) END PROCuuuvvx; TEXT VARuuuyvx:=""; PROCuuuvzv:enablestop;continue(uuuuwz-uuuuwu);disablestop; REPcommanddialogue
+( TRUE);getcommand("Gib DB-Kommando (NUR AUTHORISIERTES PERSONAL !):",uuuyvx);do(uuuyvx) UNTIL NOTonline PER;commanddialogue( FALSE);break(quiet);setautonom END PROC
+uuuvzv; BOOL OP<>( TASK CONSTuuuywy,uuuywz): NOT(uuuywy=uuuywz) ENDOP<>; ENDPACKETdbmanager;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db memory.sc b/app/eumelbase/2.2.1-schulis/src/db memory.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db memory.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/eumelbase/2.2.1-schulis/src/db q.sc b/app/eumelbase/2.2.1-schulis/src/db q.sc
new file mode 100644
index 0000000..c1e1d4f
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db q.sc
@@ -0,0 +1,100 @@
+#$ IFmitinternerquery THEN# PACKETqueryparser DEFINES QUERY,query,getscanbedingung,getdnr,getinr,getanzahlverbunde,getselpointer,getstopbedpointer,getquery,putquery
+,setzeschluessel,getanzahltupel,getswanzfld,getswnachfld,getswvonfld,getswallefelder,getswfwert,getsohnverb,getbruderverb,geterstestupel,puterstestupel,selektionerfuellt
+,initquery,:=,baumdurchlauf,listeschluessel,putletzterverbund,getletzterverbund,puttid,gettid,getbruder,putbruder,tidfeld,updatefnr,updateausdruck,queryart,anzupdatefelder
+: TYPE UPDSTACK= STRUCT( INTuuuuuv, TEXTuuuuuw); BOUND ROW100 UPDSTACK VARuuuuux; TYPE VERBELEMENT= STRUCT( TEXTuuuuuy,uuuuuz, BOOLuuuuvu, INTuuuuvv,uuuuvw,uuuuvx
+,uuuuvy,uuuuvz,uuuuwu); TYPE VERBUND= ROWuuuuwv VERBELEMENT; TYPE QUERY= STRUCT( INTuuuuww,uuuuwx,uuuuwy, TEXTuuuuwz,uuuuxu, SELEKTIONuuuuxv, VERBUNDuuuuxw, SCHLUESSEL
+uuuuxx); TYPE SWERT= STRUCT( INTuuuuxy,uuuuxz, TEXTwert); TYPE SCHLUESSELWERTE= STRUCT( BOOLuuuuyu, INTuuuuyv, ROWuuuuyw SWERTuuuuyx); TYPE SCHLUESSEL= ROWuuuuwv SCHLUESSELWERTE
+; LETuuuuyz=0,uuuuzu=1,uuuuzv=2,uuuuzw=3,uuuuzx=6,uuuuzy=5,uuuuzz=7,uuuvuu=7,uuuvuv=4,uuuvuw="BY",uuuvux="UPDATE",uuuvuy="DELETE",uuuvuz=".query",uuuvvu=";",uuuvvv
+="(",uuuvvw=")",#uuuvvx=",",uuuvvy="=",uuuvvz=">=",uuuvwu="<=",#uuuvwv="/",uuuvww="""",uuuvwx=".",uuuvwy=":",uuuvwz=" ",uuuvxu=":=",uuuvxv="<",uuuuwv=10,uuuvxx=20
+,uuuuyw=10,uuuvxz=80,uuuvyu=1,uuuvyv=2,uuuvyw=3; INT VARuuuvyx:=-5,uuuvyy:=-33,uuuvyz; DATASPACE VARuuuvzu:=nilspace; INT VARuuuvzv:=0; INT PROCtidfeld:uuuvyy ENDPROC
+tidfeld; FILE VARuuuvzz; TEXT VARuuuwuu:="",uuuwuv:="",uuuwuw:="",uuuwux:=""; INT VARuuuwuy,uuuwuz,uuuwvu; BOOL VARuuuwvv,uuuwvw; INT VARuuuwvx:=0,uuuwvy,uuuwvz; ROW
+uuuvxx TEXT VARuuuwwv; OP:=( QUERY VARuuuwww, QUERY CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( VERBELEMENT VARuuuwww, VERBELEMENT CONSTuuuwwx): CONCR
+(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( VERBUND VARuuuwww, VERBUND CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; INT PROCupdatefnr( INT CONSTuuuwyx):uuuuux
+[uuuwyx].uuuuuv ENDPROCupdatefnr; TEXT PROCupdateausdruck( INT CONSTuuuwyx):uuuuux[uuuwyx].uuuuuw ENDPROCupdateausdruck; INT PROCqueryart:uuuvzv ENDPROCqueryart; PROC
+queryart( INT CONSTuuuxvu):uuuvzv:=uuuxvu ENDPROCqueryart; INT PROCanzupdatefelder:uuuvyz ENDPROCanzupdatefelder; PROCinitquery( QUERY VARuuuxww):uuuxwx;uuuxww.uuuuww
+:=0;uuuxww.uuuuwx:=0;uuuxww.uuuuwz:="";uuuxww.uuuuxu:="";initselektionen(uuuxww.uuuuxv);uuuxyw(uuuxww.uuuuxw);uuuxyz(uuuxww.uuuuxx) ENDPROCinitquery; PROCuuuxwx:forget
+(uuuvzu);uuuvzu:=nilspace;uuuuux:=uuuvzu ENDPROCuuuxwx;initquery(uuuyuy); PROCuuuxyw( VERBUND VARuuuyvu): FORuuuwvy FROM1 UPTOuuuuwv REPuuuyvx(uuuyvu[uuuwvy]) PER
+ ENDPROCuuuxyw; PROCuuuyvx( VERBELEMENT VARuuuyww):uuuyww.uuuuuy:="";uuuyww.uuuuuz:="" ENDPROCuuuyvx;# BOUND QUERY VARuuuyuy;# QUERY VARuuuyuy; PROCgetquery( QUERY
+ VARuuuxww): CONCR(uuuxww):= CONCR(uuuyuy) ENDPROCgetquery; PROCputquery( QUERY CONSTuuuxww): CONCR(uuuyuy):= CONCR(uuuxww) ENDPROCputquery; PROCquery:query(lastparam
+) ENDPROCquery; PROCuuuyzz( TEXT CONSTuuuzuu): TEXT VARuuuzuv:="",uuuzuw:="",uuuzux:="",uuuwuv:=""; INT VARuuuzuz;uuuxwx;uuuzvv;nextsymbol;queryparser(uuuzvx);uuuzvy
+;uuuzvz;uuuzwu;uuuzwv;baumdurchlauf;.uuuzvy:nextsymbol; WHILEuuuwuy<>uuuuzz REPuuuzxu;nextsymbol PER.uuuzxu:uuuzuw:=""; IFuuuwuy<>uuuuzu THENuuuzxz("Refinementname erwartet: "
++uuuwuu) ELSEuuuzuv:=uuuwuu;nextsymbol; IFuuuwuu<>uuuvwy THENuuuzxz(uuuvww+uuuvwy+uuuvww+" erwartet: "+uuuwuu) ELSEuuuzzy;putref(uuuzuv,uuuzuw) FI FI.uuuzzy:nextsymbol
+; WHILEuuuwuy<>uuuuzz CANDuuuwuu<>uuuvwx REPuuuzuw:=uuuzuw+uuvuvw;nextsymbol PER; IFuuuwuy=uuuuzz THENuuuzxz("Refinement nicht mit ""."" abgeschlossen") FI.uuuzvv
+:enablestop;uuuvzz:=sequentialfile(input,uuuzuu); IFexists(uuuzuu+uuuvuz) THENforget(uuuzuu+uuuvuz,quiet) FI;#uuuyuy:=new(uuuzuu+uuuvuz);#lastparam(uuuzuu);uuvuxz
+(0);uuuwvx:=0;clearrefs;scan(uuuvzz);.uuuzwu: FORuuuzuz FROM1 UPTOuuuwvx REPuuuzux:="";uuuwuv:=uuvuzv(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy); WHILEuuuwuy<>
+uuuuzz REP IFuuuwuy=uuuuzu THENuuuzux:=uuuzux+getreftext(uuuwuu) ELSEuuuzux:=uuuzux+uuvuvw FI;nextsymbol(uuuwuu,uuuwuy) PER;uuvvwu(uuuzux,uuuzuz) PER.uuuzwv: INT VAR
+uuvvwy;initsel(uuuyuy.uuuuxv); FORuuuzuz FROM1 UPTOgetanzahlverbunde REPuuvvxx;uuvvxy PER.uuvvxx:uuvvwy:=getstopbedpointer(uuuzuz); IFuuvvwy>uuuuyz THENuuuwuv:=uuvuzv
+(uuvvwy);uuvvzw(baueselektionauf(uuuyuy.uuuuxv,uuuwuv),uuuzuz) FI.uuvvxy:uuvvwy:=getselpointer(uuuzuz); IFuuvvwy>uuuuyz THENuuuwuv:=uuvuzv(uuvvwy);uuvwvy(baueselektionauf
+(uuuyuy.uuuuxv,uuuwuv),uuuzuz) FI. ENDPROCuuuyzz; PROCuuuzvz: INT VARuuuzuz:=1; BOOL VARuuvwxu:= FALSE; TEXT VARuuuzux:=""; WHILEuuuzuz<=getanzahlverbunde REPuuuzux
+:="";uuuwuv:=getscanbedingung(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy); WHILEuuuwuy<>uuuuzz REP IFuuuwuy=uuuuzu THENuuuzux:=uuuzux+getreftext(uuuwuu) ELSEuuuzux
+:=uuuzux+uuvuvw FI;nextsymbol(uuuwuu,uuuwuy) PER; IFgetdnr(uuuzuz)=uuuvyx THENqueryparser(uuuzux,uuuzuz);uuvwxu:= TRUE ELSEuuvxwu(uuuzux,uuuzuz) FI;uuuzuz INCR1 PER
+; IFuuvwxu THENuuuzvz FI ENDPROCuuuzvz; PROCqueryparser( TEXT CONSTuuuwuv, INT CONSTuuvxxx): INT VARuuvxxy;scan(uuuwuv);nextsymbol;uuvxyu;queryparser(uuvxxx);uuvxyx
+.uuvxyu:uuvxxy:=getbruderverb(uuvxxx);.uuvxyx:uuvxzx(uuvxxy,uuvxxx). ENDPROCqueryparser; PROCqueryparser( INT CONSTuuvxxx): TEXT VARuuvyux:=""; BOOL VARuuvyuy:= FALSE
+;uuuvzv:=0; REPuuvyvu; UNTILuuvyuy PER;uuvyvw;uuvyvx;uuvyvy;uuvyvz; SELECTuuuvzv OF CASEuuuvyv,uuuvyu:uuvywx; IFuuvxxx=1 THENuuvywz FI CASEuuuvyw:uuvyxv ENDSELECT
+.uuvyvu: IFuuuwuy=uuuvuv THENuuvyxz(dateinr(uuuwuu),uuvxxx); IFuuuvzv<1 THENuuuvzv:=uuuvyu FI;uuvyuy:= TRUE ELSE IFuuuwuy=uuuuzv THEN IFuuuwuu=uuuvux THENnextsymbol
+;uuuvzv:=uuuvyw ELIFuuuwuu=uuuvuy THENnextsymbol;uuuvzv:=uuuvyv ELSEuuuzxz("Dateiname nicht gefunden: "+uuuwuu) FI FI FI.uuvyvw:nextsymbol; IFuuuwuy=uuuuzv CANDuuuwuu
+=uuuvuw THENuuvzvz;uuvzwu ELSE IFuuuwuy=uuuuzx CANDuuuwuu=uuuvvv THENuuvzwz(#getdnr(uuvxxx)#0,uuvxxx) ELSEuuuzxz("Indexname bzw. ""("" fehlt") FI FI.uuvzvz:nextsymbol
+; IFuuuwuy=uuuvuv THENuuvzwz(indexnr(uuuwuu),uuvxxx) ELSEuuuzxz("Indexname nicht gefunden: "+uuuwuu) FI.uuvzwu:nextsymbol; IF NOT(uuuwuy=uuuuzx CANDuuuwuu=uuuvvv)
+ THENuuuzxz(uuuvww+uuuvvv+uuuvww+" erwartet") FI.uuvyvx:uuwuuy(uuuwuv);uuvxwu(uuuwuv,uuvxxx);.uuvyvy: BOOL VARstop:= TRUE;uuwuvy.uuvyvz:stop:= FALSE;uuwuvy.uuwuvy
+: INT VARuuvvwy;uuuwuw:=""; IF NOTuuuwvv THENuuwuuy(uuuwuw); IFuuuwuw="" THEN IFstop THENuuvvzw(uuuuyz,uuvxxx) ELSEuuvwvy(uuuuyz,uuvxxx) FI ELSEuuvvwy:=uuwuyx; IF
+stop THENuuvvzw(uuvvwy,uuvxxx) ELSEuuvwvy(uuvvwy,uuvxxx) FI;uuvvwu(uuuwuw,uuvvwy) FI ELSEuuvwvy(uuuuyz,uuvxxx) FI.uuvywx: INT VARuuwvuz; IF NOTuuuwvv THENuuwvvv(uuvxxx
+,uuwvuz);uuwvvy(uuwvuz,uuvxxx);uuvxzx(uuuuyz,uuvxxx) FI.uuvywz:nextsymbol; IFuuuwuy=uuuuzx ORuuuwuy=uuuuzz ORuuuwuy=uuuuzy THEN IFuuuwuu<>uuuvwv THENuuwvyv FI;uuuuwx
+;uuwvyx ELSEuuuzxz(uuuvww+uuuvwv+uuuvww+" bzw. "+uuuvww+uuuvvu+uuuvww+uuuvwv+uuuvww+uuuvwx+uuuvww+" erwartet") FI.uuwvyv: IFuuuwuu=uuuvvu ORuuuwuu=uuuvwx ORuuuwuy
+=uuuuzz THENuuwwvy(0); LEAVEuuvywz ELSEuuuzxz("Falscher Tupelzahl-Operator: "+uuuwuu) FI.uuuuwx:nextsymbol; IFuuuwuy=uuuuzw THENuuwwvy(int(uuuwuu)); ELSEuuuzxz("Keine Zahlenangabe: "
++uuuwuu) FI.uuwvyx:nextsymbol; IFuuuwuy<>uuuuzz CAND( NOT(uuuwuu=uuuvvu CORuuuwuu=uuuvwx)) THENuuuzxz("""."" oder "";"" erwartet") FI.uuvyxv:uuuvyz:=0;nextsymbol;
+ WHILE NOTuuuwvv REPuuuvyz INCR1;uuwwzx;uuwwzy;uuwwzz; PER.uuwwzx: IFuuuwuy=uuuuzu THENuuwxux ELSEuuwxuy FI.uuwxux:uuuzxz("Zur Zeit keine Refinements in Update-Liste erlaubt!"
+).uuwxuy:uuuuux[uuuvyz].uuuuuv:=feldnr(uuuwuu); IFuuuuux[uuuvyz].uuuuuv<3 THENuuuzxz("Falscher Feldname: "+uuuwuu) FI;nextsymbol.uuwwzy: IF NOT(uuuwuy=uuuuzy CAND
+uuuwuu=uuuvxu) THENuuuzxz("Keine Zuweisung: "+uuuwuu) FI.uuwwzz:uuwxyv(uuvyux);uuuuux[uuuvyz].uuuuuw:=uuvyux;nextsymbol. ENDPROCqueryparser; PROCuuwxyv( TEXT VARuuwxzx
+): INT VARuuwxzy:=0,uuwxzz:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0; REPuuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbol UNTILuuwyvw PER.uuwyvw: IF(uuuwuy=uuuuzx CAND(uuuwuu
+=uuuvvu COR(uuuwuu=uuuvvw CANDuuwxzz=0))) THENuuuwvv:=uuuwuu=uuuvvw; TRUE ELSE IFuuuwuy=uuuuzz THENuuuzxz("Vorzeitiges END OF FILE!"); FALSE ELSE IFuuuwuy=uuuuzx THEN
+ IFuuuwuu=uuuvvv THENuuwxzz INCR1 FI; IFuuuwuu=uuuvvw THENuuwxzz DECR1 FI; FI; FALSE FI FI. ENDPROCuuwxyv; PROCuuwvvv( INT CONSTuuvxxx, INT VARuuwvuz): INT VARuuwyzz
+:=uuuuyz;uuwvuz:=uuuuyz;nextsymbol; IFuuuwuy=uuuuzx CANDuuuwuu=uuuvvw THENuuuwvv:= TRUE; LEAVEuuwvvv ELIFuuuwuy=uuuuzu THENuuwvuz:=uuuzvx;uuvxwu(uuuwuu,uuwvuz);uuvwvy
+(uuuuyz,uuwvuz);uuvyxz(uuuvyx,uuwvuz);uuwvvv(uuwvuz,uuwyzz);uuvxzx(uuwyzz,uuwvuz) ELIFuuuwuy=uuuvuv THENuuwvuz:=uuuzvx;queryparser(uuwvuz);uuuwvv:= FALSE;uuwvvv(uuwvuz
+,uuwyzz);uuvxzx(uuwyzz,uuwvuz) ELIF(uuuwuy=uuuuzx CANDuuuwuu=uuuvvu) THENuuwvvv(uuvxxx,uuwvuz) ELSEuuuzxz("Verbund-Fehler bei : "+uuuwuu) FI ENDPROCuuwvvv; PROCuuwuuy
+( TEXT VARuuwxzx): INT VARuuwxzy:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0;uuuwvv:= FALSE; REPuuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbol UNTILuuxuyx PER.uuxuyx: IF(
+uuuwuy=uuuuzy CANDuuuwuu=uuuvwv) THEN TRUE ELSE IFuuuwuy=uuuuzz THENuuuzxz(uuuvww+uuuvwv+uuuvww+" fehlt"); FALSE ELSE FALSE FI FI. ENDPROCuuwuuy; TEXT PROCuuvuvw:
+ IFuuuwuy=uuuvuv THENuuuvww+uuuwuu+uuuvww ELIFuuuwuy=uuuuzv THENuuuvwz+uuuwuu+uuuvwz ELSEuuuwuu FI ENDPROCuuvuvw; PROCnextsymbol:nextsymbol(uuuvzz,uuuwuu,uuuwuy);
+ ENDPROCnextsymbol; PROCuuuzxz( TEXT CONSTuuxvxx):errorstop("Zeile "+text(lineno(uuuvzz))+" : "+uuxvxx) ENDPROCuuuzxz; PROCputerstestupel( TEXT CONSTuuxvyw):uuuyuy
+.uuuuwz:=uuxvyw ENDPROCputerstestupel; TEXT PROCgeterstestupel:uuuyuy.uuuuwz ENDPROCgeterstestupel; PROCuuxvzz( TEXT CONSTuuxvyw):uuuyuy.uuuuxu:=uuxvyw ENDPROCuuxvzz
+; TEXT PROCuuxwuz:uuuyuy.uuuuxu ENDPROCuuxwuz; PROCuuwwvy( INT CONSTuuxwvy):uuuyuy.uuuuwx:=uuxwvy ENDPROCuuwwvy; INT PROCgetanzahltupel:uuuyuy.uuuuwx ENDPROCgetanzahltupel
+; PROCputletzterverbund( INT CONSTuuxwxw):uuuyuy.uuuuwy:=uuxwxw ENDPROCputletzterverbund; INT PROCgetletzterverbund:uuuyuy.uuuuwy ENDPROCgetletzterverbund; PROCputtid
+( INT CONSTuuxwzu, TEXT CONSTuuxwzv):uuuyuy.uuuuxw[uuxwzu].uuuuuz:=uuxwzv ENDPROCputtid; TEXT PROCgettid( INT CONSTuuxwzu):uuuyuy.uuuuxw[uuxwzu].uuuuuz ENDPROCgettid
+; PROCputbruder( INT CONSTuuxwzu, BOOL CONSTuuxxvz):uuuyuy.uuuuxw[uuxwzu].uuuuvu:=uuxxvz ENDPROCputbruder; BOOL PROCgetbruder( INT CONSTuuxwzu):uuuyuy.uuuuxw[uuxwzu
+].uuuuvu ENDPROCgetbruder; PROCuuvxwu( TEXT CONSTuuxxyw, INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuy:=uuxxyw ENDPROCuuvxwu; TEXT PROCgetscanbedingung( INT CONST
+uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuy ENDPROCgetscanbedingung; PROCuuvyxz( INT CONSTuuxyvu,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv:=uuxyvu ENDPROCuuvyxz; PROCuuvzwz( INT
+ CONSTuuxywx,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw:=uuxywx ENDPROCuuvzwz; INT PROCgetdnr( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv ENDPROCgetdnr; INT PROCgetinr
+( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw ENDPROCgetinr; PROCuuvwvy( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx:=uuxzuw ENDPROCuuvwvy; INT PROCgetselpointer
+( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx ENDPROCgetselpointer; PROCuuvvzw( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvy:=uuxzuw ENDPROCuuvvzw; INT PROC
+getstopbedpointer( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvy ENDPROCgetstopbedpointer; PROCuuvxzx( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz:=uuxzuw
+ ENDPROCuuvxzx; INT PROCgetbruderverb( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz ENDPROCgetbruderverb; PROCuuwvvy( INT CONSTuuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz
+].uuuuwu:=uuxzuw ENDPROCuuwvvy; INT PROCgetsohnverb( INT CONSTuuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuwu ENDPROCgetsohnverb; PROCuuvuxz( INT CONSTuuyuzu):uuuyuy.uuuuww:=
+uuyuzu ENDPROCuuvuxz; INT PROCgetanzahlverbunde:uuuyuy.uuuuww ENDPROCgetanzahlverbunde; INT PROCuuuzvx: INT VARuuyuzu:=getanzahlverbunde+1;uuvuxz(uuyuzu);uuvxzx(uuuuyz
+,uuyuzu);uuwvvy(uuuuyz,uuyuzu);uuvxwu("",uuyuzu);uuyuzu ENDPROCuuuzvx; INT PROCuuwuyx:uuuwvx INCR1;uuuwvx ENDPROCuuwuyx; PROCuuvvwu( TEXT CONSTuuuwuw, INT CONSTuuvvwy
+):uuuwwv[uuvvwy]:=uuuwuw ENDPROCuuvvwu; TEXT PROCuuvuzv( INT CONSTuuvvwy):uuuwwv[uuvvwy] ENDPROCuuvuzv; PROCbaumdurchlauf: IFmittestausgaben THENuuyvzz FI.uuyvzz:
+ INT VARuuywuv; FORuuywuv FROM1 UPTOgetanzahlverbunde REPnote("Verbund  : "+text(uuywuv));noteline;note("   Datei : "+text(getdnr(uuywuv)));noteline;note("   Index : "
++text(getinr(uuywuv)));noteline;note("   Scan  : "+getscanbedingung(uuywuv));noteline;note("   Bruder: "+text(getbruderverb(uuywuv)));noteline;note("   Sohn  : "+
+text(getsohnverb(uuywuv)));noteline;note("   SelPoi: "+text(getselpointer(uuywuv)));noteline;noteline; PER;checkselektion(uuuyuy.uuuuxv). ENDPROCbaumdurchlauf; PROC
+setzeschluessel( INT CONSTuuxwzu): TEXT VARuuywxy:=getscanbedingung(uuxwzu);scan(uuywxy);nextsymbol;uuywyw;uuywyx;uuywyy;uuywyz; WHILEuuuwuy<>uuuvuu REP IFuuuwuu=
+uuuvxv THENnextsymbol;uuywzy(uuxwzu,uuyxuu,uuuwuu);uuyxuw(uuxwzu,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,0); ELIFuuuwuy=uuuvuv THENuuywzy(uuxwzu,uuyxuu,"");uuyxuw(uuxwzu
+,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,feldnr(uuuwuu)); ELIFuuuwuu=uuuvvu THENuuyxyu FI;nextsymbol PER;uuyxyv.uuywyx: IFuuuwuy=uuuvuv CANDfeldtyp(feldnr(uuuwuu))=uuuvxz
+ THENuuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1,tidfeld);uuyxvu(uuxwzu,1,feldnr(uuuwuu));uuyyux(uuxwzu, TRUE);uuyyuz(uuxwzu,1); LEAVEsetzeschluessel FI;.uuywyz:uuywzy(uuxwzu
+,1,"");uuyxuw(uuxwzu,1,0);uuyxvu(uuxwzu,1,0).uuyxyu: IFuuuwvw THENuuyxuz INCR1 ELSEuuuwuz:=uuuwvu+1;uuuwvu:=pos(uuuwux,uuuvvu,uuuwuz);uuyxuz:=uuxyvu+int(subtext(uuuwux
+,uuuwuz,uuuwvu-1)) FI;uuyxuu INCR1.uuywyw: INT VARuuyyzv:=getinr(uuxwzu),uuxyvu:=getdnr(uuxwzu),uuyxuz; IFuuyyzv=0 THENuuuwvw:= TRUE;uuyxuz:=uuxyvu+1 ELSEuuuwux:=
+zugriff(uuyyzv);uuuwvu:=pos(uuuwux,uuuvvu);uuyxuz:=int(subtext(uuuwux,1,uuuwvu-1))+uuxyvu;uuuwvw:= FALSE FI.uuyzwy: IFuuuwvw THEN(uuyxuz-uuxyvu)=anzkey(uuxyvu) ELSE
+uuuwvu=length(uuuwux) FI.uuywyy: INT VARuuyxuu:=1; IFuuuwuy=uuuvuu THENuuyxuu:=0 FI.uuyxyv:uuyyux(uuxwzu,uuyzwy CAND(uuyxuu>0));uuyyuz(uuxwzu,uuyxuu). ENDPROCsetzeschluessel
+; PROCuuyxvu( INT CONSTuuxwzu,uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy:=uuyxuz ENDPROCuuyxvu; PROCuuyxuw( INT CONSTuuxwzu,uuzuux,uuyxuz):uuuyuy.
+uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxz:=uuyxuz ENDPROCuuyxuw; INT PROCgetswvonfld( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy ENDPROCgetswvonfld
+; INT PROCgetswnachfld( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxz ENDPROCgetswnachfld; PROCuuywzy( INT CONSTuuxwzu,uuzuux, TEXT CONSTuuzvwu
+):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert:=uuzvwu ENDPROCuuywzy; TEXT PROCgetswfwert( INT CONSTuuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert ENDPROCgetswfwert
+; PROCuuyyux( INT CONSTuuxwzu, BOOL CONSTuuzvzv):uuuyuy.uuuuxx[uuxwzu].uuuuyu:=uuzvzv ENDPROCuuyyux; BOOL PROCgetswallefelder( INT CONSTuuxwzu):uuuyuy.uuuuxx[uuxwzu
+].uuuuyu ENDPROCgetswallefelder; PROCuuyyuz( INT CONSTuuxwzu,uuzwvz):uuuyuy.uuuuxx[uuxwzu].uuuuyv:=uuzwvz ENDPROCuuyyuz; INT PROCgetswanzfld( INT CONSTuuxwzu):uuuyuy
+.uuuuxx[uuxwzu].uuuuyv ENDPROCgetswanzfld; PROCquery( TEXT CONSTuuzwyw): INT VARuuuzuz;uuuyzz(uuzwyw); FORuuuzuz FROM1 UPTOgetanzahlverbunde REPsetzeschluessel(uuuzuz
+) PER;listeschluessel ENDPROCquery; OP:=( SCHLUESSELWERTE VARuuuwww, SCHLUESSELWERTE CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( SWERT VARuuuwww, SWERT
+ CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; OP:=( SCHLUESSEL VARuuuwww, SCHLUESSEL CONSTuuuwwx): CONCR(uuuwww):= CONCR(uuuwwx) ENDOP:=; PROClisteschluessel
+: IF NOTmittestausgaben THEN LEAVElisteschluessel FI; INT VARuuuzuz,uuywuv; FORuuuzuz FROM1 UPTOgetanzahlverbunde REPnoteline;note("Verbund : "+text(uuuzuz));noteline
+;note("=============");noteline;noteline;note("ANZAHL FLD: "+text(getswanzfld(uuuzuz)));noteline;note("ALLE      : "+uuzxxx);noteline;noteline; FORuuywuv FROM1 UPTO
+getswanzfld(uuuzuz) REPnote("   VON : "+text(getswvonfld(uuuzuz,uuywuv)));noteline;note("   NACH: "+text(getswnachfld(uuuzuz,uuywuv)));noteline;note("   WERT: "+getswfwert
+(uuuzuz,uuywuv));noteline; PER PER.uuzxxx: IFgetswallefelder(uuuzuz) THEN"vollständiger Schlüssel" ELSE"unvollständiger Schlüssel" FI. ENDPROClisteschluessel; BOOL
+ PROCselektionerfuellt( INT CONSTuuzyux):werteselektionaus(uuuyuy.uuuuxv,uuzyux) ENDPROCselektionerfuellt; PROCuuuxyz( SCHLUESSEL VARuuzyvx): FORuuuwvy FROM1 UPTO
+uuuuwv REP FORuuuwvz FROM1 UPTOuuuuyw REPuuzyvx[uuuwvy].uuuuyx[uuuwvz].wert:="" PER PER ENDPROCuuuxyz; ENDPACKETqueryparser;#$ FI#
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db ref.sc b/app/eumelbase/2.2.1-schulis/src/db ref.sc
new file mode 100644
index 0000000..1b38c98
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db ref.sc
@@ -0,0 +1,10 @@
+#$ IFmitinternerquery THEN# PACKETqueryref DEFINESputref,getreftext,anzahlrefs,listerefs,clearrefs: LETuuuuuv=50,uuuuuw=1,uuuuux=2; LET REFELEMENT= ROW2 TEXT; TYPE
+ REFINEMENT= STRUCT( INTuuuuuy, ROWuuuuuv REFELEMENTuuuuvu); REFINEMENT VARuuuuvv; PROCputref( TEXT CONSTuuuuvw,uuuuvx): INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv
+.uuuuuy REP IFuuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvw THENuuuuvv.uuuuvu[uuuuvy][uuuuuw]:=uuuuvx; LEAVEputref FI PER; IFuuuuvv.uuuuuy=uuuuuv THENerrorstop("Zuviele Refinements!"
+) FI;uuuuvv.uuuuuy INCR1;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuuw]:=uuuuvw;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuux]:=uuuuvx ENDPROCputref; TEXT PROCgetreftext( TEXT CONSTuuuuvw
+): INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv.uuuuuy REP IFuuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvw THEN LEAVEgetreftext WITHuuuuvv.uuuuvu[uuuuvy][uuuuux] FI PER;uuuuvw
+ ENDPROCgetreftext; PROCclearrefs: INT VARuuuuvy; FORuuuuvy FROM1 UPTOuuuuvv.uuuuuy REPuuuuvv.uuuuvu[uuuuvy][uuuuuw]:="";uuuuvv.uuuuvu[uuuuvy][uuuuux]:="" PER;uuuuvv
+.uuuuuy:=0 ENDPROCclearrefs; INT PROCanzahlrefs:uuuuvv.uuuuuy ENDPROCanzahlrefs; PROClisterefs: INT VARuuuwuu;note("Liste der Refinements :");noteline;note("======================="
+);noteline;noteline; FORuuuwuu FROM1 UPTOanzahlrefs REPnote(text(uuuuvv.uuuuvu[uuuwuu][uuuuuw],30)+":"+uuuuvv.uuuuvu[uuuwuu][uuuuux]);noteline PER ENDPROClisterefs
+; ENDPACKETqueryref;#$ FI#
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db sel.sc b/app/eumelbase/2.2.1-schulis/src/db sel.sc
new file mode 100644
index 0000000..285e84e
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db sel.sc
@@ -0,0 +1,58 @@
+ PACKETqueryselektion DEFINES SELEKTION,#putoptyp,putrechts,putlinks,putselwert,#optyp,rechts,links,selwert,fnrlinks,fnrrechts,#allocselelement,#:=,checkselektion
+,baueselektionauf,werteselektionaus,mittestausgaben,initselektionen,initsel,initialisiereselektion,lex,lexon,lexoff: LETuuuuuv=0,uuuuuw=1,uuuuux=2,uuuuuy=6,uuuuuz
+=7,uuuuvu=8,uuuuvv=9,#uuuuvw=1,uuuuvx=3,#uuuuvy=2,uuuuvz=4,uuuuwu=5,uuuuwv=10,uuuuww=11,uuuuwx=12,uuuuwy=13,uuuuwz=14,uuuuxu=15,uuuuxv=16,uuuuxw=17,uuuuxx=18,uuuuxy
+=19,uuuuxz=20,uuuuyu=30,uuuuyv=73,uuuuyw=82,uuuuyx=68,uuuuyy=84; TYPE NODE= STRUCT( INTuuuuyz,uuuuzu,uuuuzv, TEXTselwert); TYPE SELEKTION= STRUCT( INTuuuuzx, ROWuuuuyu
+ NODEexp); INT VARuuuuzz,uuuvuu,uuuvuv; REAL VARuuuvuw,uuuvux; TEXT VARuuuvuy,uuuvuz; INT VARuuuvvu; TEXT VARuuuvvv:=""; BOOL VARuuuvvw:= FALSE,lexsort:= FALSE; BOOL
+ PROClex:lexsort ENDPROClex; PROClexon:lexsort:= TRUE ENDPROClexon; PROClexoff:lexsort:= FALSE ENDPROClexoff; PROCmittestausgaben( BOOL CONSTuuuvwy):uuuvvw:=uuuvwy
+ ENDPROCmittestausgaben; BOOL PROCmittestausgaben:uuuvvw ENDPROCmittestausgaben; OP:=( NODE VARuuuvxz, NODE CONSTuuuvyu): CONCR(uuuvxz):= CONCR(uuuvyu) ENDOP:=; OP
+:=( SELEKTION VARuuuvxz, SELEKTION CONSTuuuvyu): CONCR(uuuvxz):= CONCR(uuuvyu) ENDOP:=; PROCinitsel( SELEKTION VARuuuvzw):uuuvzw.uuuuzx:=0 ENDPROCinitsel; PROCinitselektionen
+( SELEKTION VARuuuwuv): INT VARuuuwuw; FORuuuwuw FROM1 UPTOuuuuyu REPuuuwuv.exp[uuuwuw].selwert:="" PER ENDPROCinitselektionen; PROCinitialisiereselektion( SELEKTION
+ VARuuuvzw):initsel(uuuvzw);initselektionen(uuuvzw) ENDPROCinitialisiereselektion; PROCuuuwwy( SELEKTION VARuuuvzw, INT CONSTuuuwxu):uuuvzw.exp[uuuwxu].uuuuyz:=uuuuxy
+;uuuvzw.exp[uuuwxu].uuuuzv:=0;uuuvzw.exp[uuuwxu].uuuuzu:=0;uuuvzw.exp[uuuwxu].selwert:="" ENDPROCuuuwwy; INT PROCallocselelement( SELEKTION VARuuuvzw):uuuvzw.uuuuzx
+ INCR1;uuuwwy(uuuvzw,uuuvzw.uuuuzx);uuuvzw.uuuuzx ENDPROCallocselelement; PROCputoptyp( SELEKTION VARuuuvzw, INT CONSTuuuxvy,optyp):uuuvzw.exp[uuuxvy].uuuuyz:=optyp
+ ENDPROCputoptyp; PROCuuuxwz( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxxw ENDPROCuuuxwz; PROCputrechts( SELEKTION VARuuuvzw, INT
+ CONSTuuuxvy,uuuxyz):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxyz ENDPROCputrechts; PROCuuuxzz( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuxxw
+ ENDPROCuuuxzz; PROCputlinks( SELEKTION VARuuuvzw, INT CONSTuuuxvy,uuuwuw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuwuw ENDPROCputlinks; PROCputselwert( SELEKTION VARuuuvzw,
+ INT CONSTuuuxvy, TEXT CONSTuuuyxw):uuuvzw.exp[uuuxvy].selwert:=uuuyxw ENDPROCputselwert; INT PROCoptyp( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].
+uuuuyz ENDPROCoptyp; INT PROCfnrrechts( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzv ENDPROCfnrrechts; INT PROCfnrlinks( SELEKTION VARuuuvzw, INT
+ CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzu ENDPROCfnrlinks; INT PROCrechts( SELEKTION CONSTuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzv ENDPROCrechts; INT PROC
+links( SELEKTION CONSTuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].uuuuzu ENDPROClinks; TEXT PROCselwert( SELEKTION VARuuuvzw, INT CONSTuuuxvy):uuuvzw.exp[uuuxvy].
+selwert ENDPROCselwert; INT PROCbaueselektionauf( SELEKTION VARuuuzzx, TEXT CONSTuuuzzy): IFcompress(uuuzzy)<>"" THENscan(uuuzzy);uuvuuv(uuuzzx) ELSE0 FI ENDPROCbaueselektionauf
+; INT PROCuuvuuv( SELEKTION VARuuuzzx): INT VARuuuwuw,uuvuvv;uuuwuw:=uuvuvx(uuuzzx);nextsymbol; IFuuvuvz=uuuuxx ORuuvuvz=uuuuxv THENuuvuvv:=allocselelement(uuuzzx
+);putoptyp(uuuzzx,uuvuvv,uuvuvz);putlinks(uuuzzx,uuvuvv,uuuwuw);putrechts(uuuzzx,uuvuvv,uuvuuv(uuuzzx));uuvuvv ELSEuuuwuw FI ENDPROCuuvuuv; INT PROCuuvuvx( SELEKTION
+ VARuuuzzx): INT VARuuvvuu;nextsymbol; SELECTuuvuvz OF CASEuuuuuw:uuvvuu:=uuvuuv(uuuzzx);#nextsymbol;# IFuuvuvz<>uuuuux THENerrorstop("Klammer zu fehlt! Gefunden: "
++uuuvvv) FI; CASEuuuuxw:uuvvuu:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvvuu,uuvuvz);putlinks(uuuzzx,uuvvuu,uuvuvx(uuuzzx)); CASEuuuuuy: CASEuuuuvu:uuvvuu:=allocselelement
+(uuuzzx);uuvvyx;uuvvyy;nextsymbol;uuvvyz CASEuuuuvv:uuvvuu:=allocselelement(uuuzzx);uuvvzy;uuvvzz;uuvwuu CASEuuuuuz: OTHERWISE:errorstop("Falsches Symbol: "+uuuvvv
++text(uuuvvu)) ENDSELECT;uuvvuu.uuvvyx:nextsymbol; IFuuuvvu<>uuuuvz THENuuvwvw("Falsche Wertangabe") ELSEputselwert(uuuzzx,uuvvuu,uuuvvv);nextsymbol; IFuuuvvu<>uuuuwu
+ CANDuuuvvv<>">" THENuuvwvw(""">"" bei Wertangabe fehlt!") FI FI.uuvvzz:nextsymbol; IFuuuvvu<>uuuuwu THENuuvwvw("Falscher Operator: "+uuuvvv) FI;putoptyp(uuuzzx,uuvvuu
+,uuvwyv).uuvvyy:nextsymbol; IF(uuuvvu=uuuuwu) COR(uuuvvu=uuuuvy CANDuuuvvv="IN") THENputoptyp(uuuzzx,uuvvuu,uuvwyv) ELSEuuvwvw("Falscher Operator: "+uuuvvv) FI;.uuvvyz
+:uuuxwz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvvzy:uuuxzz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvwuu:nextsymbol; IFuuvuvz=uuuuvu THENuuvvyx ELSEuuvvyz FI. ENDPROCuuvuvx; INT PROC
+uuvwyv: IFuuuvvv=">" THENuuuuwz ELIFuuuvvv="<" THENuuuuxu ELIFuuuvvv="=" THENuuuuwv ELIFuuuvvv=">=" THENuuuuwy ELIFuuuvvv="<=" THENuuuuwx ELIFuuuvvv="<>" THENuuuuww
+ ELIFuuuvvv="IN" THENuuuuxz ELSEuuuuxy FI ENDPROCuuvwyv; PROCnextsymbol:nextsymbol(uuuvvv,uuuvvu) ENDPROCnextsymbol; INT PROCuuvuvz: IFuuuvvv="(" THENuuuuuw ELIFuuuvvv
+=")" THENuuuuux ELIFuuuvvv="NOT" ORuuuvvv="NICHT" THENuuuuxw ELIFuuuvvv="AND" ORuuuvvv="UND" THENuuuuxv ELIFuuuvvv="OR" ORuuuvvv="ODER" THENuuuuxx ELIFuuuvvu=13 THEN
+uuuuuy ELIFuuuvvu=uuuuwu CANDuuuvvv="<" THENuuuuvu ELIFuuuvvu=uuuuvz THENuuuuvv ELIFuuuvvu=7 THENuuuuuz ELSEuuuuuv FI ENDPROCuuvuvz; PROCuuvwvw( TEXT CONSTuuvyyz)
+:errorstop("FEHLERHAFTER AUSDRUCK: "+uuvyyz) ENDPROCuuvwvw; PROCcheckselektion( SELEKTION CONSTuuuzzx): INT VARuuvyzy,uuvyzz:=uuuzzx.uuuuzx;note("Anzahl Knoten: "
++text(text(uuvyzz),5));noteline;noteline;noteline; FORuuvyzy FROM1 UPTOuuvyzz REPnote("Knoten: "+text(uuvyzy));noteline;note("     Operat: "+uuvzvu(uuuzzx.exp[uuvyzy
+]));noteline;note("     links : "+text(links(uuuzzx,uuvyzy)));noteline;note("     rechts: "+text(rechts(uuuzzx,uuvyzy)));noteline;note("     Wert  : "+">"+uuuzzx.
+exp[uuvyzy].selwert+"<");noteline PER ENDPROCcheckselektion; TEXT PROCuuvzvu( NODE CONSTuuuvzw): SELECTuuuvzw.uuuuyz OF CASEuuuuwv:"=" CASEuuuuww:"<>" CASEuuuuwx:
+"<=" CASEuuuuwy:">=" CASEuuuuwz:">" CASEuuuuxu:"<" CASEuuuuxw:"NOT" CASEuuuuxv:"AND" CASEuuuuxx:"OR" CASEuuuuxz:"IN" OTHERWISE:"UNDEFINED OPERATOR" ENDSELECT ENDPROC
+uuvzvu; BOOL PROCwerteselektionaus( SELEKTION VARuuuvzw, INT CONSTuuvyzy): IFuuvyzy=0 THEN LEAVEwerteselektionaus WITH TRUE FI;uuwuux; SELECTuuwuuy OF CASEuuuuxx:
+uuwuvu ORuuwuvv CASEuuuuxv:uuwuvu ANDuuwuvv CASEuuuuxw: NOTuuwuvu CASEuuuuwx:uuwuww CASEuuuuwy:uuwuwy CASEuuuuww:uuwuxu CASEuuuuwv:uuwuxw CASEuuuuxu:uuwuxy CASEuuuuwz
+:uuwuyu CASEuuuuxz:uuwuyw OTHERWISE: FALSE ENDSELECT.uuwuvu:werteselektionaus(uuuvzw,links(uuuvzw,uuvyzy)).uuwuvv:werteselektionaus(uuuvzw,rechts(uuuvzw,uuvyzy)).
+uuwuux: IFuuwuuy=uuuuxx CORuuwuuy=uuuuxv CORuuwuuy=uuuuxw THEN LEAVEuuwuux ELSEuuwvvz;uuwvwu FI.uuwvvz: IFfnrlinks(uuuvzw,uuvyzy)=0 THEN SELECTuuwvwz OF CASEuuuuyv
+:uuuvuu:=int(selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyv CASEuuuuyw:uuuvuw:=real(selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyw CASEuuuuyx:uuuvuw:=date(selwert(uuuvzw,uuvyzy))
+;uuuuzz:=uuuuyw OTHERWISE:uuuvuy:=selwert(uuuvzw,uuvyzy);uuuuzz:=uuuuyy ENDSELECT ELSE SELECTfeldtyp(fnrlinks(uuuvzw,uuvyzy)) OF CASEuuuuyv:uuuvuu:=intwert(fnrlinks
+(uuuvzw,uuvyzy));uuuuzz:=uuuuyv CASEuuuuyw:uuuvuw:=realwert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyw CASEuuuuyx:uuuvuw:=date(datumwert(fnrlinks(uuuvzw,uuvyzy)));uuuuzz
+:=uuuuyw OTHERWISE:uuuvuy:=wert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyy ENDSELECT FI.uuwvwu: IFfnrrechts(uuuvzw,uuvyzy)=0 THEN SELECTuuwxvv OF CASEuuuuyv:uuuvuv:=
+int(selwert(uuuvzw,uuvyzy)) CASEuuuuyw:uuuvux:=real(selwert(uuuvzw,uuvyzy)) CASEuuuuyx:uuuvux:=date(selwert(uuuvzw,uuvyzy)) OTHERWISE:uuuvuz:=selwert(uuuvzw,uuvyzy
+) ENDSELECT ELSE SELECTfeldtyp(fnrrechts(uuuvzw,uuvyzy)) OF CASEuuuuyv:uuuvuv:=intwert(fnrrechts(uuuvzw,uuvyzy)) CASEuuuuyw:uuuvux:=realwert(fnrrechts(uuuvzw,uuvyzy
+)) CASEuuuuyx:uuuvux:=date(datumwert(fnrrechts(uuuvzw,uuvyzy))) OTHERWISE:uuuvuz:=wert(fnrrechts(uuuvzw,uuvyzy)) ENDSELECT FI.uuwxvv: IFfnrlinks(uuuvzw,uuvyzy)=0 THEN
+uuuuyy ELSEfeldtyp(fnrlinks(uuuvzw,uuvyzy)) FI.uuwvwz: IFfnrrechts(uuuvzw,uuvyzy)=0 THENuuuuyy ELSEfeldtyp(fnrrechts(uuuvzw,uuvyzy)) FI.uuwuuy:optyp(uuuvzw,uuvyzy
+). ENDPROCwerteselektionaus; BOOL PROCuuwuww: SELECTuuuuzz OF CASEuuuuyv:uuuvuu<=uuuvuv CASEuuuuyw:uuuvuw<=uuuvux OTHERWISE:uuuvuy<=uuuvuz ENDSELECT ENDPROCuuwuww
+; BOOL PROCuuwuwy: SELECTuuuuzz OF CASEuuuuyv:uuuvuu>=uuuvuv CASEuuuuyw:uuuvuw>=uuuvux OTHERWISE:uuuvuy>=uuuvuz ENDSELECT ENDPROCuuwuwy; BOOL PROCuuwuxy: SELECTuuuuzz
+ OF CASEuuuuyv:uuuvuu<uuuvuv CASEuuuuyw:uuuvuw<uuuvux OTHERWISE: IFlexsort THEN NOT(uuuvuy LEXGREATEREQUALuuuvuz) ELSEuuuvuy<uuuvuz FI ENDSELECT ENDPROCuuwuxy; BOOL
+ PROCuuwuyu: SELECTuuuuzz OF CASEuuuuyv:uuuvuu>uuuvuv CASEuuuuyw:uuuvuw>uuuvux OTHERWISE: IFlexsort THENuuuvuy LEXGREATERuuuvuz ELSEuuuvuy>uuuvuz FI ENDSELECT ENDPROC
+uuwuyu; BOOL PROCuuwuxw: SELECTuuuuzz OF CASEuuuuyv:uuuvuu=uuuvuv CASEuuuuyw:uuuvuw=uuuvux OTHERWISE: IFlexsort THENuuuvuy LEXEQUALuuuvuz ELSEuuuvuy=uuuvuz FI ENDSELECT
+ ENDPROCuuwuxw; BOOL PROCuuwuxu: SELECTuuuuzz OF CASEuuuuyv:uuuvuu<>uuuvuv CASEuuuuyw:uuuvuw<>uuuvux OTHERWISE: IFlexsort THEN NOT(uuuvuy LEXEQUALuuuvuz) ELSEuuuvuy
+<>uuuvuz FI ENDSELECT ENDPROCuuwuxu; BOOL PROCuuwuyw: IFuuuuzz=uuuuyy THENpos(uuuvuz,uuuvuy)>0 ELSE FALSE FI ENDPROCuuwuyw; ENDPACKETqueryselektion;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db snd query.sc b/app/eumelbase/2.2.1-schulis/src/db snd query.sc
new file mode 100644
index 0000000..2d14756
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db snd query.sc
@@ -0,0 +1,18 @@
+#$ IFmitinternerquery THEN# PACKETdbsndquery DEFINESauswertung,auswertungfortsetzen,qsucc,endofscan,ordernewstack,puttiefennr,gettiefennr,endqueryserver: LETuuuuuv
+=25,uuuuuw=0,uuuuux=1,uuuuuy=2,uuuuuz=2,uuuuvu=37,uuuuvv=10,uuuuvw=39,uuuuvx=40,uuuuvy=41,uuuuvz=1; INT CONSTendofscan:=8,ordernewstack:=9; INT VARuuuuwu,uuuuwv; DATASPACE
+ VARuuuuww; BOUND QUERY VARuuuuwx; BOUND TEXT VARuuuuwy; ROWuuuuvv INT VARuuuuxu; TYPE TUPEL= STRUCT( INTuuuuxv,uuuuxw,uuuuxx, TEXTuuuuxy); TYPE QUERYSTACK= STRUCT
+( INTuuuuxz, TASKuuuuyu, ROWuuuuuv TUPELuuuuyw); INT VARuuuuyx:=getanzahltupel,uuuuyy; TEXT VARuuuuyz:="",uuuuzu:=""; PROCendqueryserver:forget(uuuuww);uuuuww:=nilspace
+;send(uuuuzy,uuuuvx,uuuuww) ENDPROCendqueryserver; TASK VARuuuuzy; BOUND QUERYSTACK VARuuuvux; OP:=( TUPEL VARuuuvuy, TUPEL CONSTuuuvuz): CONCR(uuuvuy):= CONCR(uuuvuz
+) ENDOP:=; OP:=( QUERYSTACK VARuuuvuy, QUERYSTACK CONSTuuuvuz): CONCR(uuuvuy):= CONCR(uuuvuz) ENDOP:=; INT PROCgettiefennr( INT CONSTuuuvwv): IFuuuvwv=0 THEN0 ELSE
+uuuuxu[uuuvwv] FI ENDPROCgettiefennr; PROCputtiefennr( INT CONSTuuuvwv,uuuvxw):uuuuxu[uuuvwv]:=uuuvxw ENDPROCputtiefennr; PROCauswertung( TEXT CONSTuuuvyv):uuuuyy
+:=0;query(uuuvyv); IFqueryart=uuuuvz THENuuuvyz ELSEuuuvzu FI.uuuvyz:uuuvzw;forget(uuuuww);uuuuww:=nilspace;uuuuwx:=uuuuww;getquery(uuuuwx);call(/name(1),uuuuvu,uuuuww
+,uuuuwu);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu.uuuvzu:forget(uuuuww);uuuuww:=old(uuuvyv);call(/name(1),uuuuvy,uuuuww,uuuuwu);uuuwuz. ENDPROCauswertung; PROC
+uuuvzw:uuuuwv:=0;uuuwxx(1) ENDPROCuuuvzw; PROCuuuwxx( INT CONSTuuuwyu):uuuuwv INCR1;puttiefennr(uuuwyu,uuuuwv); IFgetsohnverb(uuuwyu)<>uuuuuw THENuuuwxx(getsohnverb
+(uuuwyu)) FI; IFgetbruderverb(uuuwyu)<>uuuuuw THENuuuwxx(getbruderverb(uuuwyu)) FI ENDPROCuuuwxx; PROCauswertung( QUERY VARuuuvyv):queryart(uuuuvz);uuuvzw;uuuuyy:=
+0;forget(uuuuww);uuuuww:=nilspace;uuuuwx:=uuuuww;uuuuwx:=uuuvyv;call(/name(1),uuuuvu,uuuuww,uuuuwu);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu ENDPROCauswertung;
+ PROCauswertungfortsetzen:uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;call(uuuuzy,uuuuvw,uuuuww,uuuuwu);uuuwuz;uuuvux:=uuuuww ENDPROCauswertungfortsetzen; PROCuuuwuz
+: IFuuuuwu=uuuuuz THENdbstatus(dberror);uuuuwy:=uuuuww;forget(uuuuww);errorstop(uuuuwy) ELSEdbstatus(uuuuwu) FI ENDPROCuuuwuz; PROCqsucc( INT VARuuuwyu,uuuyuz):uuuuyy
+ INCR1; IFuuuuyy>uuuvux.uuuuxz THENuuuwyu:=0;uuuyuz:=0;dbstatus(endoffile) ELSEuuuyuz:=uuuvux.uuuuyw[uuuuyy].uuuuxw;#uuuywz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuux]);
+uuuyxz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuuy]);#parsetupel(uuuyuz,uuuyzu); IFuuuyzv THENdbstatus(endofscan) ELSEdbstatus(ok) FI FI.uuuyzu:uuuvux.uuuuyw[uuuuyy].uuuuxy
+.uuuyzv:uuuwyu:=uuuvux.uuuuyw[uuuuyy].uuuuxv; IFuuuwyu<0 THENuuuwyu:=abs(uuuwyu); TRUE ELSE FALSE FI. ENDPROCqsucc; ENDPACKETdbsndquery;#$ FI#
+
diff --git a/app/eumelbase/2.2.1-schulis/src/db utils.sc b/app/eumelbase/2.2.1-schulis/src/db utils.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/db utils.sc
@@ -0,0 +1,60 @@
+
+ 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+
+ 
+
+ 
+ 
+
+ 
+
+
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+
+
+���� 
+���� 
+���� 
+���� 
+���� 
+���� 
+
+
+
+���� 
+���� 
+���� 
+
+
+�
+#����#
diff --git a/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc b/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc
new file mode 100644
index 0000000..0a70651
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/isp archive manager.sc
@@ -0,0 +1,79 @@
+ PACKETisparchivemanager DEFINESisparchivemanager,archivechannel: LETuuuuuv=128,uuuuuw=100,uuuuux=1,uuuuuy=2,uuuuuz=200,uuuuvu=100,uuuuvv=12,uuuuvw=0,#uuuuvx=1,uuuuvy
+=2,#uuuuvz=5,uuuuwu=25,uuuuwv=26,#uuuuww=28,uuuuwx=19,uuuuwy=20,#uuuuwz=34,uuuuxu=35,uuuuxv=36,uuuuxw=37,uuuuxx=39,uuuuxy=40,uuuuxz=41,uuuuyu=42,uuuuyv=43,uuuuyw=
+44,uuuuyx=45,uuuuyy=46,uuuuyz=47,uuuuzu=48,uuuuzv=10,uuuuzw=5,uuuuzx=7; LET ARCHIVECONTROL= STRUCT( INTuuuuzy, BOOLuuuuzz); BOUND ARCHIVECONTROL VARuuuvuu; TYPE HEADER
+= STRUCT( TEXTname,date, INTtype, TEXTuuuvuv, INTuuuvuw,uuuvux,uuuvuy,uuuvuz); TYPE DSNAMEN= STRUCT( INTuuuvvu, ROWuuuuuz TEXTuuuvvw); ROWuuuuuz DATASPACE VARuuuvvy
+;uuuvvz( TRUE); BOUND DSNAMEN VARuuuvwu; TYPE FILEHEADER= STRUCT( TEXTuuuvwv, INTuuuvww,uuuvwx,uuuvwy, ROWuuuuuv INTuuuvxu); BOUND FILEHEADER VARuuuvxv; BOUND TEXT
+ VARuuuvxw; BOUND INT VARuuuvxx; BOUND HEADER VARuuuvxy; DATASPACE VARuuuvxz:=nilspace,uuuvyu:=nilspace,uuuvyv:=nilspace,uuuvyw:=nilspace,uuuvyx:=nilspace,uuuvyy:=
+nilspace;uuuvyz; INT VARuuuvzu,uuuvzv,uuuvzw,uuuvzx,uuuvzy,uuuvzz,uuuwuu,uuuwuv,uuuwuw,uuuwux,uuuwuy,uuuwuz,uuuwvu,uuuwvv:=1; BOOL VARuuuwvw:= TRUE,uuuwvx:= FALSE
+,uuuwvy:= FALSE; INT VARuuuwvz,uuuwwu,uuuwwv,uuuwww,uuuwwx,uuuwwy; TASK VARuuuwwz,uuuwxu:=niltask; BOUND STRUCT( TEXTname,uuuwxv,uuuwxw) VARuuuwxx; FILE VARuuuwxy
+; TEXT VARuuuwxz:="",uuuwyu:="",uuuwyv:=""; REAL VARuuuwyw:=clock(1); INT VARuuuwyx:=31; INT PROCarchivechannel:uuuwyx ENDPROCarchivechannel; PROCarchivechannel( INT
+ CONSTuuuwzw):uuuwyx:=uuuwzw ENDPROCarchivechannel; PROCuuuvyz:forget(uuuvxz);forget(uuuvyu);forget(uuuvyv);forget(uuuvyw);forget(uuuvyx);forget(uuuvyy); ENDPROCuuuvyz
+; PROCuuuvvz( BOOL CONSTuuuxvx): INT VARuuuwvz; FORuuuwvz FROM1 UPTOuuuuuz REP IFuuuxvx THENuuuvvy[uuuwvz]:=nilspace FI;forget(uuuvvy[uuuwvz]) PER ENDPROCuuuvvz; PROC
+uuuxxv( DATASPACE VARuuuvyw, INT CONSTpage, INT CONSTuuuwuv): INT VARuuuxxy:=0,uuuxxz:=0,uuuxyu; REPblockin(uuuvyw,page,0,uuuwuv,uuuxxy); IFuuuxxy<>0 THENuuuxxz INCR
+1;uuuxzu FI UNTILuuuxxy<>2 ORuuuxxz=uuuuzv PER;uuuxzy(uuuxxy,uuuwuv).uuuxzu: IFuuuxxz=uuuuzw THENblockin(uuuvyw,page,0,0,uuuxxy);uuuxxy:=2 FI;. ENDPROCuuuxxv; PROC
+uuuyvw( DATASPACE VARuuuvyw, INT CONSTpage, INT CONSTuuuwuv): INT VARuuuxxy:=0,uuuxxz:=0,uuuxyu; REP FORuuuwvz FROM1 UPTOuuuwvv REPblockout(uuuvyw,page,0,uuuwuv,uuuxxy
+); UNTILuuuxxy<>0 PER; IFuuuwvy CANDuuuxxy=0 THENblockin(uuuvyw,page,0,uuuwuv,uuuxxy); FI; IFuuuxxy<>0 THENuuuxxz INCR1;uuuxzu FI UNTILuuuxxy<>2 ORuuuxxz=uuuuzv PER
+;uuuxzy(uuuxxy,uuuwuv).uuuxzu: IFuuuxxz=uuuuzw THENdisablestop;uuuvyy:=nilspace;blockin(uuuvyy,2,0,0,uuuxxy);forget(uuuvyy);clearerror;enablestop;uuuxxy:=2 FI;. ENDPROC
+uuuyvw; PROCuuuxzy( INT CONSTuuuxxy,uuuzvx): SELECTuuuxxy OF CASE0: CASE1:errorstop("Schreiben/Lesen des Archives unmöglich") CASE2:errorstop("Schreib/Lese-Fehler:"
++text(uuuzvx)) CASE3:errorstop("Archive-Overflow") OTHERWISE:errorstop("Unbekannter Archive-Fehler:"+text(uuuxxy)+"/"+text(uuuzvx)) ENDSELECT ENDPROCuuuxzy; PROCuuuzwx
+: INT VARuuuwvz:=1,uuuxxy;forget(uuuvyy);uuuvyy:=nilspace;uuuzxw( TRUE);uuuzxx(text(uuuwvz)); FORuuuwvz FROM1 UPTOarchiveblocks-1 REP IF(uuuwvz MOD50)=0 THENuuuzxx
+(text(uuuwvz)); FI;blockin(uuuvyy,1,0,uuuwvz,uuuxxy);uuuxzy(uuuxxy,uuuwvz) PER;uuuzxx(text(uuuwvz));forget(uuuvyy) ENDPROCuuuzwx; PROCuuvuuv:uuuzxw( TRUE);forget(
+uuuvxy.name,quiet);uuuwxy:=sequentialfile(output,uuuvxy.name); IFuuuwvw THENuuvuvv ELSEuuvuvw FI;forget(uuuvyw);forget(uuuvyu);uuuvyu:=old(uuuvxy.name);uuuvyw:=uuuvyu
+;forget(uuuvyu);forget(uuuvxy.name,quiet);.uuvuvv:uuvuvw; REPuuvuxv;putline(uuuwxy,"! "+text(uuuvxv.uuuvwv,27)+"!     "+text(text(uuuvxv.uuuvww),10)+"!   "+text(text
+(uuuwuw),7)+"!     "+text(text(uuuvxv.uuuvwx),11)+"!");uuvuyy;uuuwuw:=uuuwuw+uuuwuz+1;uuuwuv:=uuuwuw+1 UNTILuuvuzy PER.uuvuvw:uuvvuu;putline(uuuwxy,"");putline(uuuwxy
+,"     ARCHIVE: "+text(uuuvxy.name,20)+"erstellt am : "+text(uuuvxy.date,10));putline(uuuwxy,"");putline(uuuwxy,10*" "+" Disketten-Nr. : "+uuvvvv);putline(uuuwxy,
+10*" "+" vorige Diskette der Sicherung : "+uuvvvx);putline(uuuwxy,10*" "+" nächste Diskette der Sicherung: "+uuvvvz);putline(uuuwxy,"");putline(uuuwxy,10*" "+" Blöcke insgesamt : "
++text(archiveblocks-1));putline(uuuwxy,10*" "+" Erster freier Block: "+text(uuuvxy.uuuvuw));putline(uuuwxy,"");putline(uuuwxy,"");uuvvxv.uuvvxv:putline(uuuwxy,"! Filename                   ! Anzahl Blöcke ! ab Block ! erste DS-Seite !"
+);putline(uuuwxy,"+----------------------------+---------------+----------+----------------+");uuvuyy.uuvuyy:putline(uuuwxy,"!                            !               !          !                !"
+);.uuvvvv:text(uuuvxy.uuuvuz).uuvvvz:text(uuuvxy.uuuvuy).uuvvvx:text(uuuvxy.uuuvux).uuvuzy:uuuwuv>=uuuvxy.uuuvuw.uuvuxv:uuvwuy;. ENDPROCuuvuuv; PROCuuvwuy:forget(
+uuuvxz);uuuvxz:=nilspace;uuuxxv(uuuvxz,1,uuuwuw);uuuvxv:=uuuvxz;uuuwuz:=uuuvxv.uuuvww;uuuwvu:=uuuvxv.uuuvwx ENDPROCuuvwuy; PROCuuvwxx( TEXT CONSTuuvwxy):forget(uuuvyv
+);uuuvyv:=nilspace;uuuvxy:=uuuvyv;uuuvxy.name:=uuvwxy;uuuvxy.uuuvuz:=0;uuuvxy.uuuvuy:=0;uuuvxy.uuuvux:=0;uuuvxy.uuuvuw:=-1;uuuvxy.date:=date;uuvxuw ENDPROCuuvwxx;
+ PROCuuvxuy:uuvvuu;uuuvxy.uuuvuz:=0;uuuvxy.uuuvuy:=0;uuuvxy.uuuvux:=0;uuuvxy.uuuvuw:=-1;uuuvxy.date:=date;uuvxuw ENDPROCuuvxuy; PROCuuuzxw( BOOL CONSTuuvxxu):uuuwvw
+:= TRUE;uuvvuu;uuvxxx.uuvxxx: IFuuuvxy.uuuvuw<=0 THENuuuwvw:= FALSE;uuuvxy.uuuvuw:=uuuuuy FI; IFuuvxxu THENuuuwuw:=uuuuuy;uuuvxy.date:=date ELSEuuuwuw:=uuuvxy.uuuvuw
+ FI;uuuwuv:=uuuwuw+1#;note("Erster freier Block : "+text(uuuvxy.uuuvuw));noteline;note("Startblock : "+text(uuuwuw));noteline;#. ENDPROCuuuzxw; PROCuuvvuu:forget(
+uuuvyv);uuuvyv:=nilspace;uuuxxv(uuuvyv,1,uuuuux);uuuvxy:=uuuvyv ENDPROCuuvvuu; PROCuuvxuw:uuuyvw(uuuvyv,nextdspage(uuuvyv,-1),uuuuux) ENDPROCuuvxuw; PROCuuvyxx:uuuwxz
+:=uuuuuw*code(0);uuvyyu(1) ENDPROCuuvyxx; PROCuuvyyw:uuuwyu:=uuuuuw*code(0) ENDPROCuuvyyw; PROCuuvyzu( INT CONSTuuvyzv):uuvyzw(uuuwyu,uuvyzv) ENDPROCuuvyzu; INT PROC
+uuvzuu( INT CONSTuuvyzv):uuvyzv MOD8 ENDPROCuuvzuu; INT PROCuuvzuy( INT CONSTuuvyzv):(uuvyzv DIV8)+1 ENDPROCuuvzuy; PROCuuvyyu( INT CONSTuuvyzv):uuvyzw(uuuwxz,uuvyzv
+) ENDPROCuuvyyu; BOOL PROCuuvzww:uuuwyu=uuuwxz ENDPROCuuvzww; PROCuuvyzw( TEXT VARuuvzxv, INT CONSTuuvyzv): INT VARuuvzxx,bit,uuvzxy;uuvzxx:=uuvzuy(uuvyzv);bit:=uuvzuu
+(uuvyzv);uuvzxy:=code(uuvzxv SUBuuvzxx);setbit(uuvzxy,bit);change(uuvzxv,uuvzxx,uuvzxx,code(uuvzxy)) ENDPROCuuvyzw; PROCuuwuuv: IFuuwuuw THENuuwuux ELSEuuwuuy FI.
+uuwuuw:uuuwwx=uuuuwz.uuwuux:#uuuwux:=1;#uuuvuu:=uuuvyw;uuuwvv:=uuuvuu.uuuuzy;uuuwvy:=uuuvuu.uuuuzz;uuuwwy:=archiveblocks-1;uuuwwu:=0;uuuwww:=0;uuuwwv:=nextdspage(
+uuuvyu,-1);uuwuxz; IFuuuwuv>uuuwwu THENerrorstop("Archive voll!") FI;uuwuyw.uuwuuy:uuuwwy:=archiveblocks-1;uuwuxz;uuwuzu;uuwuzv;uuwuyw.uuwuyw: WHILEuuuwwv>=0 REPuuwuzz
+;uuwuzv PER;uuwvuv;uuwvuw;uuvxuw;forget(uuuvyu);uuwvuz.uuwuzz: IFuuuwuv>uuuwwu THENuuwvvx FI;uuwuzu.uuwuzu:#uuuzxx("Block "+text(uuuwuv)+" wird geschrieben !");#uuuyvw
+(uuuvyu,uuuwwv,uuuwuv);uuuwww INCR1;uuuvxy.uuuvuw INCR1;uuwvxx;uuuwuv INCR1.uuwvxx:uuwvyu;uuwvyv.uuwvyu:uuuvzu:=uuuwwv-uuuvxv.uuuvwx+1;uuuvzw:=(uuuvzu DIV16)+1;uuuvzv
+:=(uuuvzu) MOD16#;note("Seite : "+text(uuuwwv));noteline;note("    rel. Seite : "+text(uuuvzu));noteline;note("    Zeichen    : "+text(uuuvzw));noteline;note("    Bit        : "
++text(uuuvzv));noteline;#.uuwvyv:setbit(uuuvxv.uuuvxu[uuuvzw],uuuvzv).uuwuzv:uuuwwv:=nextdspage(uuuvyu,uuuwwv).uuwvuw:uuuwwv:=nextdspage(uuuvxz,-1);uuwwwx.uuwwwx:
+uuuyvw(uuuvxz,1#uuuwwv#,uuuwuw);uuuvxy.uuuvuw INCR1.uuwwxz:forget(uuuvxz);uuuvxz:=nilspace;uuuvxv:=uuuvxz;uuuvxv.uuuvwy:=type(uuuvyu);uuuvxv.uuuvwx:=uuuwwv;uuuwww
+:=0;#note("Erste Seite : "+text(uuuwwv));# FORuuuwvz FROM1 UPTOuuuuuv REPuuuvxv.uuuvxu[uuuwvz]:=0 PER.uuwvuv:uuuvxv.uuuvwv:=uuuwyv;#uuuzxx(uuuwyv+" wird archiviert !"
+);#uuuvxv.uuuvww:=uuuwww;#note("Weggeschr. Seiten : "+text(uuuwww));noteline#.uuwvvx:uuwxwy;uuwxwz;#uuwuxz#.uuwxwz:uuwxxw; LEAVEuuwuuv.uuwxwy:uuwvuv;uuwwwx;uuuwux
+ INCR1;uuuvxy.uuuvuy:=uuuwux;uuvxuw.uuwuxz:uuuzxw( FALSE); IFuuwuuw THENuuwxzx FI;uuuvxy.uuuvuz:=uuuwux;uuuvxy.uuuvux:=uuuwux-1;uuuvxy.uuuvuy:=0;uuuwwu:=archiveblocks
+-1;uuwwxz;.uuwxzx: IFuuuvxy.uuuvuz<=0 THENuuuwux:=1 ELSEuuuwux:=uuuvxy.uuuvuz FI. ENDPROCuuwuuv; PROCuuwywy( INT CONSTuuwywz): IFuuwywz=1 THENuuwyxv ELSEuuwyxw FI
+.uuwyxv:uuuwxx:=uuuvyw;uuuwyv:=uuuwxx.name;uuwyyw.uuwyxw:forget(uuuwyv,quiet);forget(uuuvyu);uuuvyu:=uuuvyw;uuwyzw. ENDPROCuuwywy; PROCuuwyzy: INT VARuuwyzz,uuwzuu
+; SELECTuuuwwx OF CASEuuuuxz:uuwzux CASEuuuuyu:uuwzuz CASEuuuuyv:uuwzvv ENDSELECT.#uuwuuw:uuuwwx=uuuuxz.#uuwzux:uuuwwy:=archiveblocks-1;uuuvzx:=1;uuuvzy:=-1;uuuvzz
+:=0;forget(uuuvyx);uuuvyx:=nilspace;uuuvwu:=uuuvyx;uuuwuu:=0;uuvyxx;uuvyyw;uuwuyw.uuwzuz:uuuwwy:=archiveblocks-1;uuwuyw.uuwuyw:uuuzxw( TRUE);uuwzyz; REP REPuuvuxv
+;uuwzzv; FORuuuwvz FROM1 UPTOuuuwuz REPuuwzzy PER;uuuwuw:=uuuwuv;uuuwuv:=uuuwuw+1 UNTILuuxuux PER; UNTILuuxuuy PER;uuxuuz;uuxuvu;uuwvuz.uuxuvu:uuuvwu.uuuvvu:=uuuvzz
+;forget(uuuvyw);uuuvyw:=uuuvyx;forget(uuuvyx).uuwzvv:uuuvxx:=uuuvyw;uuuwuy:=uuuvxx;forget(uuuvyw);uuuvyw:=uuuvvy[uuuwuy];forget(uuuvvy[uuuwuy]);uuwvuz.uuxuuy: IF NOT
+uuvzww THENuuwxwz; FALSE ELSE TRUE FI.uuwxwz:uuwxxw; LEAVEuuwyzy.uuxuux:uuuwuv>=uuuvxy.uuuvuw.uuwzzy:uuuxxv(uuuvvy[uuuwuu],uuxvvu,uuuwuv);uuuwuv INCR1.uuxvvu: REP
+ FORuuwyzz FROMuuuvzy+1 UPTO15 REP IFbit(uuuvxv.uuuvxu[uuuvzx],uuwyzz) THENuuuvzy:=uuwyzz;#;note("gelesene Seite : "+text(uuxvxu)+"Bit : "+text(uuwyzz));note("    akt. Zeichen    : "
++text(uuuvzx));noteline;note("    akt. Bit        : "+text(uuuvzy));noteline;# LEAVEuuxvvu WITHuuxvxu FI PER;uuuvzy:=-1;uuuvzx INCR1 UNTILuuuvzx>=uuuuuv PER;-1.uuxvxu
+:((uuuvzx-1)*16+uuuvzy)+(uuuwvu-1).uuvuxv:uuvwuy;uuxvzy;uuuvwu.uuuvvw[uuuwuu]:=uuuvxv.uuuvwv;uuuzxx(""""+uuuvxv.uuuvwv+""" wird gelesen!").uuwzzv:type(uuuvvy[uuuwuu
+],uuuvxv.uuuvwy);uuuvzx:=1;uuuvzy:=-1.uuxvzy: FORuuwzuu FROM1 UPTOuuuvzz REP IFuuuvxv.uuuvwv=uuuvwu.uuuvvw[uuwzuu] THENuuuwuu:=uuwzuu; LEAVEuuxvzy FI PER;uuuvzz INCR
+1;uuuvvy[uuuvzz]:=nilspace;uuuwuu:=uuuvzz.uuwzyz:uuvyzu(uuuvxy.uuuvuz); IFuuuvxy.uuuvux>0 THENuuvyyu(uuuvxy.uuuvux) FI; IFuuuvxy.uuuvuy>0 THENuuvyyu(uuuvxy.uuuvuy
+) FI. ENDPROCuuwyzy; PROCuuwyzw:send(uuuwwz,uuuuvw,uuuvyw);forget(uuuvyw) ENDPROCuuwyzw; PROCuuwyyw:send(uuuwwz,uuuuvz,uuuvyw);forget(uuuvyw) ENDPROCuuwyyw; PROCuuwvuz
+:forget(uuuvyv);forget(uuuvxz);send(uuuwwz,uuuuxx,uuuvyw);forget(uuuvyw) ENDPROCuuwvuz; PROCuuwxxw:send(uuuwwz,uuuuxv,uuuvyw);forget(uuuvyw) ENDPROCuuwxxw; PROCuuuzxx
+( TEXT CONSTuuxyuu): DATASPACE VARuuxyuv:=nilspace;uuuvxw:=uuxyuv;uuuvxw:=uuxyuu;send(uuuwwz,uuuuxw,uuxyuv);forget(uuxyuv);pause(5) ENDPROCuuuzxx; PROCuuxyvz: IFchannel
+(myself)<>archivechannel THENarchive("");release(archive);continue(archivechannel) FI ENDPROCuuxyvz; PROCisparchivemanager:globalmanager( PROC( DATASPACE VAR, INT
+ CONST, INT CONST, TASK CONST)isparchivemanager) ENDPROCisparchivemanager; PROCisparchivemanager( DATASPACE VARuuxyxv, INT CONSTuuxyxw,uuxyxx, TASK CONSTuuxyxy): IF
+uuxyxw>=uuuuvu THENforget(uuxyxv);uuxyyw(uuxyxw) ELSEclearerror;enablestop;uuxyyy;forget(uuuvyy);forget(uuuvyw);uuuvyw:=uuxyxv;forget(uuxyxv);uuuwwx:=uuxyxw;uuuwwz
+:=uuxyxy; SELECTuuuwwx OF CASEuuuuwu:uuvxuy;uuwvuz CASEuuuuyz:uuuvxw:=uuuvyw;uuvwxx(uuuvxw);uuwvuz CASEuuuuzu:uuuzwx;uuwvuz CASEuuuuwv:uuvuuv;uuwvuz CASEuuuuvv:uuwywy
+(uuxyxx) CASEuuuuwz,uuuuxu:uuwuuv CASEuuuuxz,uuuuyu,uuuuyv:uuwyzy CASEuuuuxy:uuxzyz;uuxzzu;uuwvuz CASEuuuuyw:uuuvvz( FALSE);forget(uuuvyw);break(quiet) CASEuuuuyx
+:uuuvvz( FALSE);uuxyvz;uuuwxu:=uuuwwz;uuwvuz CASEuuuuyy:uuuvvz( FALSE);uuuwxu:=niltask;break(quiet);uuwvuz OTHERWISE:errorstop("Falscher Auftrag!") ENDSELECT;uuuwyw
+:=clock(1) FI.uuxzzu:break(quiet);archive(uuyuvz);commanddialogue( FALSE);disablestop; SELECTuuyuwu OF CASE0:format(archive) CASE1:format(uuyuwu,archive) CASE2:format
+(uuyuwu,archive) CASE3:format(uuyuwu,archive) OTHERWISE:errorstop("Falscher Formatcode: "+text(uuyuwu)) ENDSELECT;uuuwvx:=iserror;clearerror;commanddialogue( TRUE
+);release(archive);uuxyvz; IFuuuwvx THENerrorstop(errormessage) FI;enablestop;uuvwxx(uuyuvz).uuyuvz:subtext(uuuvxw,2,length(uuuvxw)).uuyuwu:code(uuuvxw SUB1).uuxzyz
+:uuuvxw:=uuuvyw.uuxyyy:uuyuzv;uuyuzw;uuuwyw:=clock(1).uuyuzw: IF NOT(uuuwxu=uuxyxy) CANDuuxyxw<>uuuuyx CANDuuxyxw<>uuuuyy CANDuuxyxw<>uuuuyw THENerrorstop("Archive nicht angemeldet"
+) FI.uuyuzv: IF NOTuuyvvw THENerrorstop("EUMELbase-Archive wird von Task "+name(uuuwxu)+" benutzt") FI.uuyvvw:uuxyxy=uuuwxu ORuuuwxu=niltask OR NOTexists(uuuwxu) OR
+uuyvwx.uuyvwx:abs(uuuwyw-clock(1))>600.0. ENDPROCisparchivemanager; PROCuuxyyw( INT CONSTuuuwwx): TEXT VARuuyvxx:="";enablestop;break(quiet);continue(uuuwwx-uuuuvu
+);disablestop; REPcommanddialogue( TRUE);getcommand("Gib ISP-ARCHIVE-Kommando:",uuyvxx);do(uuyvxx) UNTIL NOTonline PER;commanddialogue( FALSE);break(quiet);setautonom
+ END PROCuuxyyw; PROCuuyvyx( TEXT CONSTtext):break(quiet);continue(1);out(text);continue(archivechannel) ENDPROCuuyvyx; PROCuuxuuz:forget(uuuvyw);uuuvyw:=nilspace
+ ENDPROCuuxuuz; ENDPACKETisparchivemanager;
+
diff --git a/app/eumelbase/2.2.1-schulis/src/isp archive.sc b/app/eumelbase/2.2.1-schulis/src/isp archive.sc
new file mode 100644
index 0000000..f608a95
--- /dev/null
+++ b/app/eumelbase/2.2.1-schulis/src/isp archive.sc
@@ -0,0 +1,35 @@
+ PACKETisparchive DEFINESarchivefiles,archivesize,savetoarchive,fetchfromarchive,initarchive,cleararchive,cleararchivetask,checkarchive,listarchive,formatarchive,
+channelfree,logonarchive,logoffarchive,cleareacharchive,writefactor,readafterwrite,kf: LETuuuuuv=1,uuuuuw=2,uuuuux=34,uuuuuy=35,uuuuuz=25,uuuuvu=26,uuuuvv=36,uuuuvw
+=37,uuuuvx=39,uuuuvy=40,uuuuvz=41,uuuuwu=42,uuuuwv=43,uuuuww=44,uuuuwx=45,uuuuwy=46,uuuuwz=47,uuuuxu=48,uuuuxv=200,uuuuxw="�",fehlertext="ARCHIVE-Fehler: "; LET ARCHIVECONTROL
+= STRUCT( INTuuuuxx, BOOLuuuuxy); BOUND ARCHIVECONTROL VARuuuuxz; INT VARuuuuyu,uuuuyv,uuuuyw,uuuuyx:=1; THESAURUS VARuuuuyy; TEXT VARuuuuyz:=""; BOOL VARuuuuzu:=
+ FALSE,uuuuzv:= FALSE,uuuuzw:= FALSE; BOUND STRUCT( INTuuuuzx, ROWuuuuxv TEXTuuuuzz) VARuuuvuu; DATASPACE VARuuuvuv; PROCkf( BOOL CONSTuuuvux):uuuuzw:=uuuvux ENDPROC
+kf; PROCreadafterwrite( BOOL CONSTuuuuxy):uuuuzv:=uuuuxy ENDPROCreadafterwrite; BOOL PROCreadafterwrite:uuuuzv ENDPROCreadafterwrite; PROCwritefactor( INT CONSTuuuuxy
+):uuuuyx:=uuuuxy ENDPROCwritefactor; INT PROCwritefactor:uuuuyx ENDPROCwritefactor; BOOL PROCcleareacharchive:uuuuzu ENDPROCcleareacharchive; PROCcleareacharchive
+( BOOL CONSTuuuvyx):uuuuzu:=uuuvyx ENDPROCcleareacharchive; PROCcleararchivetask:logoffarchive;logonarchive ENDPROCcleararchivetask; THESAURUS PROCarchivefiles:uuuuyy
+ ENDPROCarchivefiles; INT PROCarchivesize:archivesize( SOMEmyself) ENDPROCarchivesize; INT PROCarchivesize( THESAURUS CONSTuuuwvu):uuuuyy:=uuuwvu;uuuuyu:=0;uuuuyv
+:=1;uuuuyw:=0;get(uuuuyy,uuuuyz,uuuuyu); WHILEuuuuyu>0 REPuuuuyw INCRstorage(old(uuuuyz));uuuuyv INCR1;get(uuuuyy,uuuuyz,uuuuyu) PER;uuuuyw ENDPROCarchivesize; TASK
+ PROCuuuwyu:/"isp.archive" ENDPROCuuuwyu; BOUND TEXT VARuuuwyw; BOUND INT VARuuuwyx; DATASPACE VARuuuwyy; INT VARuuuwyz; TASK VARuuuwzu:=niltask; PROCformatarchive
+( TEXT CONSTuuuwzw):formatarchive(0,uuuwzw) ENDPROCformatarchive; PROCformatarchive( INT CONSTuuuxuv, TEXT CONSTuuuwzw): IFpos("0123",text(uuuxuv))>0 THENuuuxuy(uuuuvy
+,code(uuuxuv)+uuuwzw, TRUE) FI ENDPROCformatarchive; PROCsavetoarchive( THESAURUS CONSTuuuwvu): IFuuuuzu THENcleararchive; FI;do( PROC( TEXT CONST)uuuxwv,uuuwvu);
+ ENDPROCsavetoarchive; PROCfetchfromarchive:uuuxwz;uuuxxu;uuuxxv.uuuxwz:uuuxxx;call(uuuwyu,uuuuvz,uuuwyy,uuuwyz).uuuxxu: INT VARuuuxyx:=uuuuvz; WHILEuuuwyz<>uuuuvx
+ REPuuuxzv; IFuuuwyz=uuuuvw THENuuuxzy ELSEuuuxxx;call(uuuwyu,uuuxyx,uuuwyy,uuuwyz) FI PER.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop(
+fehlertext+uuuwyw) CASEuuuuvw: IFcommanddialogue THENuuuyvz;uuuwyw:=uuuwyy;out(uuuwyw) FI CASEuuuuvv:uuuyvz; IFuuuywz THENerrorstop("Archivieren inkonsistent abgebrochen"
+) FI;uuuxyx:=uuuuwu ENDSELECT.uuuxxv: INT VARuuuyxx;forget(uuuvuv);uuuvuv:=uuuwyy;uuuvuu:=uuuvuv; FORuuuyxx FROM1 UPTOuuuvuu.uuuuzx REP#out("<"+uuuvuu.uuuuzz[uuuyxx
+]+">");uuuyvz;#uuuyzy PER;forget(uuuvuv).uuuyzy:uuuxxx;uuuwyx:=uuuwyy;uuuwyx:=uuuyxx;call(uuuwyu,uuuuwv,uuuwyy,uuuwyz);forget(uuuvuu.uuuuzz[uuuyxx],quiet);copy(uuuwyy
+,uuuvuu.uuuuzz[uuuyxx]). ENDPROCfetchfromarchive; BOOL PROCuuuywz: REPuuuyvz; IFonline THENout(2*uuuuxw) FI; IFyes("Nachfolgende Archive-Diskette eingelegt") THEN
+ LEAVEuuuywz WITH FALSE FI UNTILuuuuzw COR( NOTuuuuzw CANDyes("Sicherung wirklich abbrechen")) PER; TRUE ENDPROCuuuywz; PROCuuuxwv( TEXT CONSTuuuzyw#, BOOL PROCuuuzyx
+#):save(uuuzyw,uuuwyu); IFcommanddialogue THENuuuyvz;out(""""+uuuzyw+""" wird gesichert!");#uuuyvz# FI;uuuzzx;uuuzzy.uuuzzx:uuuxxx;uuuuxz:=uuuwyy;uuuuxz.uuuuxx:=uuuuyx
+;uuuuxz.uuuuxy:=uuuuzv;call(uuuwyu,uuuuux,uuuwyy,uuuwyz);uuvuwv.uuvuwv: WHILEuuuwyz<>uuuuvv REPuuuxzv;uuuxzy PER.uuuzzy: REP IFuuuwyz=uuuuvv THENuuuyvz; IFuuuywz THEN
+errorstop("Sichern eventuell inkonsistent abgebrochen!"); LEAVEuuuxwv ELSE IFuuuuzu THENcleararchive; FI;out(""""+uuuzyw+""" wird gesichert!"); FI ELSEuuuxzv FI;uuuxxx
+; IF NOTuuvuzu THENcall(uuuwyu,uuuuuy,uuuwyy,uuuwyz) ELSEuuuxzy FI; PER.uuvuzu:uuuwyz=uuuuvw.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop
+(fehlertext+uuuwyw) CASEuuuuvx: LEAVEuuuxwv CASEuuuuvw: IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz;out(uuuwyw); FI ENDSELECT. ENDPROCuuuxwv; PROCinitarchive( TEXT
+ CONSTuuvvxu):uuuxuy(uuuuwz,uuvvxu, TRUE) ENDPROCinitarchive; PROCcheckarchive:uuuxuy(uuuuxu) ENDPROCcheckarchive; PROCcleararchive:uuuxuy(uuuuuz) ENDPROCcleararchive
+; PROClistarchive:uuuxuy(uuuuvu);forget("ISP-Archive",quiet);type(uuuwyy,1003);copy(uuuwyy,"ISP-Archive");show("ISP-Archive");forget("ISP-Archive",quiet) ENDPROClistarchive
+; PROClogonarchive:uuuxuy(uuuuwx,"", FALSE) ENDPROClogonarchive; PROClogoffarchive:uuuxuy(uuuuwy,"", FALSE) ENDPROClogoffarchive; PROCuuuxuy( INT CONSTuuvwvy):uuuxuy
+(uuvwvy,"", FALSE) ENDPROCuuuxuy; PROCuuuxuy( INT CONSTuuvwvy, TEXT CONSTuuvwwy, BOOL CONSTuuvwwz):uuvwxu; WHILEuuvwxv REPuuvwxw;uuuxzy PER.uuvwxv:uuuwyz<>uuuuvx.
+uuvwxu:uuuxxx; IFuuvwwz THENuuuwyw:=uuuwyy;uuuwyw:=uuvwwy FI;call(uuuwyu,uuvwvy,uuuwyy,uuuwyz).uuvwxw: IFuuuwyz=uuuuvw THEN IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz
+;out(uuuwyw) FI ELIFuuuwyz=uuuuuw THENuuuwyw:=uuuwyy;enablestop;errorstop(fehlertext+uuuwyw) FI. ENDPROCuuuxuy; PROCuuuxzy: REPforget(uuuwyy);wait(uuuwyy,uuuwyz,uuuwzu
+); IF NOT(uuuwzu=uuuwyu) THEN#note("IN WARTE: "+text(uuuwyz)+"/"+name(uuuwzu));noteline;#uuvxxy FI UNTILuuuwzu=uuuwyu PER ENDPROCuuuxzy; PROCuuvxxy:send(uuuwzu,uuuuuv
+,uuuwyy) ENDPROCuuvxxy; PROCchannelfree: DATASPACE VARuuvxzw:=nilspace;send(uuuwyu,uuuuww,uuvxzw);forget(uuvxzw) ENDPROCchannelfree; PROCuuuxxx:forget(uuuwyy);uuuwyy
+:=nilspace ENDPROCuuuxxx; PROCuuuyvz: IFonline THENline; FI ENDPROCuuuyvz; ENDPACKETisparchive;
+
diff --git a/app/flint/0.4/doc/Zusammenstellung b/app/flint/0.4/doc/Zusammenstellung
new file mode 100644
index 0000000..cad83c0
--- /dev/null
+++ b/app/flint/0.4/doc/Zusammenstellung
@@ -0,0 +1,62 @@
+Task "MENUE" unter "UR" 
+----------------------- 
+ 
+"menues.1"             = "eudas.satzzugriffe" 
+                         "eudas.fenster" 
+                         "eudas.menues" 
+"offline.1"            = "offline.manager" 
+IF ibm grafik THEN run ("boxzeichen") END IF 
+global manager 
+ 
+ 
+Task "OPMENUE" unter "SYSUR" 
+---------------------------- 
+ 
+"menues.1" 
+"offline.1" 
+"operator.1"           = "operator.spoolcmd" 
+                         "operator.manager" 
+                         "operator" 
+menuedaten einlesen ("operator.init") 
+IF ibm grafik THEN run ("boxzeichen") END IF 
+global manager 
+ 
+ 
+Task "OP" unter "OPMENUE" 
+------------------------- 
+ 
+ 
+Task "EUDAS" unter "MENUE" (oder auch in "FLINT") 
+------------------------------------------------- 
+ 
+"eudas.1"              = "eudas.dateistruktur" 
+                         "eudas.datenverwaltung" 
+"eudas.2"              = "eudas.verarbeitung" 
+                         "eudas.drucken" 
+"eudas.3"              = "eudas.satzanzeige" 
+                         "eudas.uebersicht" 
+"eudas.4"              = "eudas.dialoghilfen" 
+                         "eudas.steuerung" 
+menuedaten einlesen ("eudas.init") 
+global manager 
+ 
+ 
+Task "FLINT" unter "EUDAS" 
+-------------------------- 
+ 
+"flint.1"              = "klartextbelegung" 
+                         "editormenue" 
+                         "eudas.manager" 
+                         "flint.manager" 
+                         "flint" 
+menuedaten einlesen ("flint.init") 
+global manager 
+ 
+ 
+ 
+Hinweise für L3: 
+ 
+- Vor "menues.1" muß jeweils "isub.replace" insertiert werden. 
+- In "offline.1" ist das Vorkommen von "PROCA" zu entfernen. 
+- Vor "operator.1" muß eine Dummy-Prozedur 'configurate' insertiert werden. 
+
diff --git a/app/flint/0.4/doc/flint.kurzanleitung b/app/flint/0.4/doc/flint.kurzanleitung
new file mode 100644
index 0000000..25608c3
--- /dev/null
+++ b/app/flint/0.4/doc/flint.kurzanleitung
@@ -0,0 +1,141 @@
+Hinweise zur FLINT-Testversion 0.4 
+---------------------------------- 
+ 
+1. Installation 
+ 
+Die Installation läuft in folgenden Schritten ab: 
+ 
+- Task "OPMENUE" als Sohn von "SYSUR" einrichten. 
+  Dort "OPMENUE.gen" vom Archiv holen und starten. 
+  Warten bis zur Tapete. 
+ 
+- Task "MENUE" als Sohn von "UR" einrichten. 
+  Dort "MENUE.gen" vom Archiv holen und starten. 
+  Warten bis zur Tapete. 
+ 
+ 
+2. Kurzanleitung 
+ 
+Arbeitstasks unter "FLINT" einrichten. Beim Einrichten vom Supervisor aus
+koppelt sich die neue Task sofort ab und muß mit 'continue' wieder ange­
+koppelt werden. Es erscheint das FLINT-Hauptmenue. 
+ 
+Zur Bedienung der Menüs s. EUDAS-Handbuch. Hilfestellungen zu jeder
+Funktion mit ESC '?'. 
+ 
+Die Punkte im ersten Menü führen jeweils in Unterapplikationen. Der Punkt
+'Systemsteuerung' koppelt automatisch die Task "OP" an und zeigt dort das
+Operatormenü. Bei ESC 'q' erfolgt Rückkehr in die eigene Task. 
+ 
+Wechsel in eine andere Task (mit Einrichten bei Bedarf) geschieht mit dem
+Menüpunkt 'Wechsel' im dritten Menü. Dies funktioniert aber nur mit Nach­
+fahren von FLINT. Falls niltext als Name angegeben wird, kann man die Task
+abkoppeln. 
+ 
+Im Operatormenü führt 'Beenden' zu einem Shutup mit anschließender Rückkehr
+in die aufrufende Task. Einige Funktionen sind derzeit noch nicht implemen­
+tiert. 
+ 
+ 
+3. Textverarbeitung 
+ 
+Unter dem Hauptmenüpunkt 'Textverarbeitung' wird ein Menü aufgerufen, das
+die Kommandos der EUMEL-Textverarbeitung als Menüpunkte aufführt. Welche
+Kommandos jeweils gemeint sind, ist durch ESC '?' zu erfragen bzw. auszu­
+probieren (eine genauere Beschreibung liegt aus Zeitmangel noch nicht vor). 
+ 
+ 
+4. Menüs im Editor 
+ 
+Zur Unterstützung der Arbeit im Editor kann man auch dort Menüs aufrufen,
+und zwar über ESC 'm' (Edit-Menü) und ESC 't' (Text-Menü). Bei den Menüs
+handelt es sich um Zeilenmenüs, die am unteren Bildrand autauchen, um die
+Sicht auf die Datei möglichst wenig einzuengen. Eine Funktion kann mit den
+Cursortasten ausgewählt und mit Leertaste (oder RETURN) ausgeführt werden.
+Alternativ Aufruf über Anfangsbuchstaben. Das Menü kann mit ESC 'q' ohne
+Wirkung verlassen werden. 
+ 
+ 
+5. Edit-Menü 
+ 
+Hier stehen Funktionen zur Verfügung, die normalerweise nach ESC ESC als
+Kommandos formuliert werden. Die Funktionen zum Suchen und Ersetzen werden
+nach Ausführung auf 'f' gelegt, so daß sie mit ESC 'f' wiederholt werden
+können. 
+ 
+Als Zusatz steht eine Funktion zur Verfügung, mit der Lernsequenzen im
+Klartext editiert werden können. Die Funktionstasten werden dabei durch
+Namen in spitzen Klammern geschrieben (erlaubt sind u.a. <links> <rechts>
+<oben> <unten> <tab> <return> <rubin> <rubout> <mark> <hop> <esc> <blank>).
+Leerzeichen werden beachtet, aber Zeilenübergänge ignoriert. 
+ 
+Ebenfalls neu sind Funktionen zum Markieren von Wörten und Sätzen (von Wort
+bis Satzende), die für die folgende Einstellung von Modifikationen verwen­
+det werden können. 
+ 
+'Kopiere' ruft entweder PUT oder GET auf, je nachdem, ob ein Block markiert
+ist oder nicht. Die Funktion kann mit ESC 'h' abgebrochen werden. 
+ 
+Mit 'Fenster' kann ein zweites Editorfenster in der unteren Hälfte eröffnet
+werden (geplant ist später, daß die Unterteilung des Schirms sowohl hori­
+zontal als auch vertikal erfolgen kann). 
+ 
+ 
+6. Text-Menü 
+ 
+Dieses Menü hilft bei der Formulierung von Textkosmetik-Anweisungen. Die
+entsprechenden Anweisungen werden an der Cursorposition oder, falls notwen­
+dig, am Zeilenanfang eingefügt. 
+ 
+Die Funktion zum Einstellen von Modifikationen hat zwei verschiedene Mög­
+lichkeiten: Falls kein Text markiert ist, werden die angekreuzten Modifi­
+kationen ein- oder ausgeschaltet (je nachdem, ob "Aus" angekreuzt ist).
+Falls ein Text markiert ist, werden alle Modifikationsanweisungen am Anfang
+und Ende des Bereichs entfernt und die angekreuzten Modifikationen für
+diesen Bereich eingestellt, wenn nicht "Aus" angekreuzt ist. 
+ 
+Die globalen Einstellungen für eine Datei werden an den Anfang geschrieben,
+wobei die vorherigen Einstellungen ggf. entfernt werden können. 
+ 
+Der markierte Ausschnitt einer Datei kann mit 'lineform' bearbeitet und
+auch mit vorheriger Formatierung gedruckt werden. 
+ 
+ 
+7. Literatur 
+ 
+Kann als Zusatzmodul insertiert werden. Dazu "litmenue" insertieren und
+anschließend 'menuedaten einlesen ("litmenue.init")' aufrufen. Das Menü
+steht dann durch Aufruf von 'literatur' im Editor zur Verfügung (kann und
+sollte auf eine Funktionstaste gelegt werden). 
+ 
+Die zu verwendenden Literaturdateien müssen vorher in EUDAS eingerichtet und
+gewartet werden. Einzige Bedingung zur Verwendung ist, daß das erste Feld
+als Signatur für einen bestimmten Titel verwendet werden kann. Der Inhalt
+dieses Feldes sollte zur Zeit aus technischen Gründen keine
+Suchmuster-Steuerzeichen (,;*--++..) enthalten. Diese Einschränkung wird
+später aufgehoben. 
+ 
+Die Funktion 'Literatur' dient dazu, eine bestimmte EUDAS-Datei als
+Literaturdatei einzustellen. Geänderte EUDAS-Dateien beliebiger Art müssen
+vor Aufruf des Literaturmenüs gesichert werden! 
+ 
+Durch 'Zeigen' wird in der unteren Bildschirmhälfte eine Übersicht
+angeboten, in der geblättert werden kann. Durch 'Direkt' kann ein bestimmter
+Satz nach Signatur angesteuert werden. 
+ 
+Die Funktion 'Referenzen' dient dazu, die in der editierten Datei
+vorkommenden Literaturreferenzen in der Literaturdatei zu markieren. Dazu
+müssen die Referenzen als Macro \#lit ("Signatur")\# in der Datei angegeben
+werden. Als Option beim Sammeln der Referenzen können diese durch ein
+anderes Macro und den Inhalt eines beliebigen Feldes der EUDAS-Datei ersetzt
+werden. Diese beiden Angaben werden erfragt. Referenzen, die in der
+Literaturdatei nicht vorkommen, werden als Dummy-Einträge an das Ende der
+Literaturdatei geschrieben, so daß sie später in EUDAS ausgefüllt werden
+können. 
+ 
+Mit der Funktion 'Verzeichnis' können dann die markierten Sätze
+(zwischendurch keine neue Datei öffnen!) als Literaturverzeichnis an das
+Ende der Datei gebracht werden. Dazu muß ein vorher erstelltes Druckmuster
+angegeben werden, das die Form der Literatureinträge angibt. 
+
+
diff --git a/app/flint/0.4/source-disk b/app/flint/0.4/source-disk
new file mode 100644
index 0000000..3c86110
--- /dev/null
+++ b/app/flint/0.4/source-disk
@@ -0,0 +1 @@
+eudas/flint-0.4.img
diff --git a/app/flint/0.4/src/MENUE.gen b/app/flint/0.4/src/MENUE.gen
new file mode 100644
index 0000000..327438c
--- /dev/null
+++ b/app/flint/0.4/src/MENUE.gen
@@ -0,0 +1,93 @@
+page;
+putline ("Generierung MENUE 0.5");
+BOOL CONST box := yes ("Mit IBM Grafikzeichen");
+BOOL CONST l3 := maxint DIV 2 > 17000;
+TASK VAR dummy, ar;
+IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF;
+INT VAR kanal := channel;
+fetch ("eudas.satzzugriffe", ar);
+fetch ("eudas.fenster", ar);
+fetch ("eudas.menues", ar);
+fetch ("offline.1", ar);
+fetch ("eudas.1", ar);
+fetch ("eudas.2", ar);
+fetch ("eudas.3", ar);
+fetch ("eudas.dialoghilfen", ar);
+fetch ("flint.init", ar);
+IF yes ("Ggf zweites Archiv eingelegt") THEN END IF;
+fetch ("eudas.steuerung", ar);
+fetch ("eudas.init", ar);
+fetch ("klartextbelegung", ar);
+fetch ("editormenue", ar);
+fetch ("eudas.manager", ar);
+fetch ("flint.manager", ar);
+fetch ("flint", ar);
+IF l3 THEN fetch ("isub.replace", ar) END IF;
+IF box THEN fetch ("boxzeichen", ar) END IF;
+release (ar);
+check off;
+IF l3 THEN do (PROC (TEXT CONST) reorganize, all) END IF;
+IF l3 THEN insert ("isub.replace"); forget ("isub.replace", quiet) END IF;
+insert ("eudas.satzzugriffe"); forget ("eudas.satzzugriffe", quiet);
+insert ("eudas.fenster"); forget ("eudas.fenster", quiet);
+insert ("eudas.menues"); forget ("eudas.menues", quiet);
+IF l3 THEN
+  TEXT VAR zeile; FILE VAR f;
+  f := sequential file (modify, "offline.1");
+  to line (f, 1);
+  read record (f, zeile);
+  INT CONST pp := pos (zeile, ",PROCA");
+  change (zeile, pp, pp + 7, "");
+  write record (f, zeile)
+END IF;
+insert ("offline.1"); forget ("offline.1", quiet);
+IF box THEN run ("boxzeichen"); forget ("boxzeichen", quiet) END IF;
+do ("ausfuehrtaste (""""13"""")");
+begin ("FLINT", PROC flint init, dummy);
+do ("global manager");
+
+PROC flint init :
+
+  disable stop;
+  fetch ("eudas.init");
+  fetch ("flint.init");
+  continue (kanal);
+  command dialogue (FALSE);
+  page;
+  i ("eudas.1");
+  i ("eudas.2");
+  i ("eudas.3");
+  i ("eudas.dialoghilfen");
+  i ("eudas.steuerung");
+  i ("klartextbelegung");
+  i ("editormenue");
+  i ("eudas.manager");
+  i ("flint.manager");
+  i ("flint");
+  do ("menue loeschen (FALSE)");
+  do ("menuedaten einlesen (""eudas.init"")");
+  forget ("eudas.init", quiet);
+  erase ("eudas.init");
+  do ("menuedaten einlesen (""flint.init"")");
+  forget ("flint.init", quiet);
+  erase ("flint.init");
+  erase ("MENUE.gen");
+  command dialogue (TRUE);
+  check on;
+  do ("begin (""OP"", ""OPMENUE"")");
+  do ("global manager")
+
+END PROC flint init;
+
+PROC i (TEXT CONST name) :
+
+  fetch (name);
+  insert (name);
+  IF is error THEN
+    put error; clear error; pause (1000); do ("global manager")
+  END IF;
+  forget (name);
+  erase (name)
+
+END PROC i;
+
diff --git a/app/flint/0.4/src/OPMENUE.gen b/app/flint/0.4/src/OPMENUE.gen
new file mode 100644
index 0000000..28304a6
--- /dev/null
+++ b/app/flint/0.4/src/OPMENUE.gen
@@ -0,0 +1,42 @@
+page;
+putline ("Generierung OPMENUE 0.5");
+BOOL CONST box := yes ("Mit IBM-Grafikzeichen");
+BOOL CONST l3 := maxint DIV 2 > 17000;
+TASK VAR ar;
+IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF;
+IF l3 THEN fetch ("isub.replace", ar) END IF;
+fetch ("eudas.satzzugriffe", ar);
+fetch ("eudas.fenster", ar);
+fetch ("eudas.menues", ar);
+fetch ("offline.1", ar);
+IF l3 THEN fetch ("dummy.configurate", ar) END IF;
+fetch ("operator.1", ar);
+fetch ("operator.init", ar);
+IF box THEN fetch ("boxzeichen", ar) END IF;
+release (ar);
+IF l3 THEN do (PROC (TEXT CONST) reorganize, all) END IF;
+IF l3 THEN insert ("isub.replace"); forget ("isub.replace", quiet) END IF;
+insert ("eudas.satzzugriffe"); forget ("eudas.satzzugriffe", quiet);
+insert ("eudas.fenster"); forget ("eudas.fenster", quiet);
+insert ("eudas.menues"); forget ("eudas.menues", quiet);
+do ("ausfuehrtaste (""""13"""")");
+IF l3 THEN
+  TEXT VAR zeile; FILE VAR f;
+  f := sequential file (modify, "offline.1");
+  to line (f, 1);
+  read record (f, zeile);
+  INT CONST pp := pos (zeile, ",PROCA");
+  change (zeile, pp, pp + 7, "");
+  write record (f, zeile)
+END IF;
+insert ("offline.1"); forget ("offline.1", quiet);
+IF l3 THEN
+  insert ("dummy.configurate"); forget ("dummy.configurate", quiet)
+END IF;
+insert ("operator.1"); forget ("operator.1", quiet);
+do ("menuedaten einlesen (""operator.init"")");
+forget ("operator.init", quiet);
+IF box THEN run ("boxzeichen"); forget ("boxzeichen", quiet) END IF;
+forget ("OPMENUE.gen", quiet);
+do ("global manager");
+
diff --git a/app/flint/0.4/src/boxzeichen b/app/flint/0.4/src/boxzeichen
new file mode 100644
index 0000000..12c3bb8
--- /dev/null
+++ b/app/flint/0.4/src/boxzeichen
@@ -0,0 +1,3 @@
+box zeichen (""205""186""201""187""200""188""199""182""196"", 
+             ""15""14"", ""178" ")
+
diff --git a/app/flint/0.4/src/dummy.configurate b/app/flint/0.4/src/dummy.configurate
new file mode 100644
index 0000000..2834684
--- /dev/null
+++ b/app/flint/0.4/src/dummy.configurate
@@ -0,0 +1,6 @@
+PACKET dummy configurate DEFINES configurate : 
+PROC configurate : 
+  errorstop ("Für L3 nicht implementiert") 
+END PROC configurate; 
+END PACKET dummy configurate; 
+
diff --git a/app/flint/0.4/src/editormenue b/app/flint/0.4/src/editormenue
new file mode 100644
index 0000000..5ab94f1
--- /dev/null
+++ b/app/flint/0.4/src/editormenue
@@ -0,0 +1,1008 @@
+PACKET edit menue                                 (* Autor: Thomas Berlage *)
+                                                  (* Stand: 16.10.88       *)
+  DEFINES
+
+  edit,
+  edit status anzeigen,
+  zeilenmenue anbieten,
+  editfile setzen,
+  edit menue,
+  element markieren,
+  text menue,
+  ausschnitt drucken,
+  gewaehlte schriftarten einstellen :
+
+
+(************************* Zeilenmenue *************************************)
+
+LET
+  menue status =
+"MENUE:   Wählen: <-,->   Ausführen: LEER,RET   Abbruch: ESC h   Hilfe: ESC ?";
+
+
+PROC zeilenmenue anbieten (TEXT CONST menuename,
+                           PROC (INT CONST) kommandos) :
+
+  bild vorbereiten;
+  zeilenmenue anbieten (menuename, TRUE, PROC (INT CONST) kommandos);
+  bild nachbereiten .
+
+bild vorbereiten :
+  INT VAR x, y;
+  get cursor (x, y);
+  cursor (1, y size); out (""5"");
+  status anzeigen (menue status);
+  cursor (x, y);
+  IF aktueller editor > 0 THEN
+    get editcursor (x, y);
+    y := line no (editfile) + y size - y;
+    abschnitt neu (y - 1, y)
+  END IF .
+
+bild nachbereiten :
+  IF aktueller editor > 0 THEN
+    IF mark (editfile) THEN
+      bild neu
+    ELSE
+      abschnitt neu (y - 1, y)
+    END IF
+  END IF;
+  cursor (1, y size - 1); out (""4"") .
+
+END PROC zeilenmenue anbieten;
+
+PROC eget (TEXT CONST prompt, TEXT VAR inhalt) :
+
+  editget (prompt, inhalt, "", "GET/Allgemein")
+
+END PROC eget;
+
+BOOL PROC eja (TEXT CONST frage) :
+
+  ja (frage, "JA/Allgemein", TRUE)
+
+END PROC eja;
+
+
+(*   EDIT MENUE          *)
+
+TEXT VAR
+  param,
+  fensterdatei := "";
+
+FENSTER VAR zweitfenster;
+fenster initialisieren (zweitfenster);
+
+PROC edit menue :
+
+  zeilenmenue anbieten ("EDIT MENUE:",
+                        PROC (INT CONST) edit menue kommandos)
+
+END PROC edit menue;
+
+PROC edit menue kommandos (INT CONST wahl) :
+
+  SELECT wahl OF
+  CASE 1 : springen auf zeile
+  CASE 2 : suchen nach text
+  CASE 3 : suchen und ersetzen
+  CASE 4, 5 : markieren
+  CASE 6 : kopieren oder lesen
+  CASE 7 : fenster editieren
+  CASE 8 : limit einstellen
+  CASE 9 : tastenbelegung
+  END SELECT .
+
+springen auf zeile :
+  TEXT VAR z := "";
+  eget ("Zeilennummer:", z);
+  IF z <> "" THEN
+    INT CONST auf zeile := int (z);
+    IF last conversion ok THEN
+      edit file setzen; T auf zeile
+    ELSE
+      errorstop ("Zeilennummer ist keine Zahl")
+    END IF
+  END IF .
+
+suchen nach text :
+  param := "";
+  eget ("Text:", param);
+  IF param = "" THEN
+  ELIF eja ("Vorwärts") THEN
+    ek ("D" + textdarstellung (param))
+  ELSE
+    ek ("U" + textdarstellung (param))
+  END IF .
+
+suchen und ersetzen :
+  param := "";
+  eget ("Suchtext:", param);
+  IF param <> "" THEN
+    z := ""; eget ("Ersetzen durch:", z);
+    IF z <> "" THEN
+      IF eja ("Nur einmal") THEN
+        ek (textdarstellung (param) + "C" + textdarstellung (z))
+      ELSE
+        editfile setzen;
+        param CA z
+      END IF
+    END IF
+  END IF .
+
+markieren :
+  element markieren (wahl = 5) .
+
+kopieren oder lesen :
+  param := "";
+  editfile setzen;
+  IF mark THEN
+    eget ("Zieldatei (RET = Speicher):", param);
+    PUT param
+  ELSE
+    eget ("Quelldatei (RET = Speicher):", param);
+    GET param
+  END IF .
+
+fenster editieren :
+  INT VAR xa, ya, xl, yl;
+  get window (xa, ya, xl, yl);
+  IF groesster editor >= 2 THEN
+    errorstop ("Nur zwei Fenster")
+  ELSE
+    fenstergroesse setzen (zweitfenster,
+                           xa, ya + yl DIV 2, xl, yl - yl DIV 2);
+    eget ("Name der Datei:", fensterdatei);
+    IF NOT exists (fensterdatei) CAND
+       NOT eja ("""" + fensterdatei + """ neu einrichten") THEN
+      errorstop ("")
+    END IF;
+    FILE VAR eff := sequential file (modify, fensterdatei);
+    edit (eff, zweitfenster, "EDIT/Allgemein")
+  END IF .
+
+limit einstellen :
+  z := text (limit);
+  REP
+    eget ("Zeilenbreite bis Umbruch (limit) in Zeichen:", z);
+    INT CONST l := int (z);
+  UNTIL last conversion ok OR z = "" PER;
+  IF z <> "" THEN limit (l) END IF .
+
+tastenbelegung :
+  TEXT VAR taste;
+  status anzeigen ("");
+  cursor (1, 24);
+  put ("Gewünschte Taste drücken (ESC = Abbruch):"5"");
+  getchar (taste);
+  IF taste <> ""27"" THEN
+    put (""13"Sequenz ggf editieren, dann ESC q"5"");
+    lernsequenz editieren (taste)
+  END IF .
+
+END PROC edit menue kommandos;
+
+PROC ek (TEXT CONST kom) :
+
+  kommando auf taste legen ("f", kom);
+  std kommando interpreter ("f")
+
+END PROC ek;
+
+PROC editfile setzen :
+
+  kommando auf taste legen (""27"", "");
+  std kommando interpreter (""27"")
+
+END PROC editfile setzen;
+
+DATASPACE VAR ds;
+
+PROC lernsequenz editieren (TEXT CONST taste) :
+
+  disable stop;
+  ds := nilspace;
+  editieren (taste);
+  forget (ds)
+
+END PROC lernsequenz editieren;
+
+PROC element markieren (BOOL CONST bis satzende) :
+
+  FILE VAR edfile := editfile;
+  INT VAR spalte := col (edfile);
+  IF NOT mark (edfile) THEN
+    zeile lesen;
+    cursor zuruecksetzen;
+    mark (edfile, line no (edfile), spalte)
+  ELSE
+    zeile lesen
+  END IF;
+  IF bis satzende THEN
+    position auf satzende
+  ELSE
+    position auf wortende
+  END IF .
+
+zeile lesen :
+  read record (edfile, param) .
+
+cursor zuruecksetzen :
+  WHILE spalte > 1 CAND (param SUB spalte - 1) <> " " REP
+    spalte DECR 1
+  END REP .
+
+position auf satzende :
+  WHILE pos (param, ".", spalte) = 0 CAND kein absatz REP
+    down (edfile);
+    zeile lesen;
+    spalte := 1
+  END REP;
+  spalte := pos (param, ".", spalte);
+  IF spalte = 0 THEN spalte := length (param) ELSE spalte INCR 1 END IF;
+  col (edfile, spalte) .
+
+kein absatz :
+  (spalte = LENGTH param OR (param SUB LENGTH param) <> " ")
+    AND NOT eof (edfile) .
+
+position auf wortende :
+  spalte DECR 1;
+  REP
+    spalte INCR 1;
+    spalte := pos (param, ""33"", ""255"", spalte);
+    IF spalte = 0 THEN
+      IF eof (edfile) THEN
+        spalte := length (param)
+      ELSE
+        down (edfile);
+        zeile lesen
+      END IF
+    END IF
+  UNTIL spalte > 0 END REP;
+  spalte := pos (param, " ", spalte);
+  IF spalte = 0 THEN spalte := length (param) END IF;
+  col (edfile, spalte) .
+
+END PROC element markieren;
+
+TEXT VAR sequenz, aenderung;
+
+PROC editieren (TEXT CONST taste) :
+
+  enable stop;
+  FILE VAR f := sequential file (output, ds);
+  maxlinelength (f, 37);
+  sequenz := lernsequenz auf taste (taste);
+  klartext in file (f, sequenz);
+  alles neu;
+  abgrenzung zeichnen;
+  editstatus anzeigen;
+  edit (f, 42, 2, x size - 42, y size - 3);
+  klartext aus file (f, aenderung);
+  IF aenderung <> sequenz CAND wirklich aendern THEN
+    lernsequenz auf taste legen (taste, aenderung)
+  END IF .
+
+abgrenzung zeichnen :
+  cursor (40, 1);
+  y size - 3 TIMESOUT ""10""15""14""8""8"" .
+
+wirklich aendern :
+  eja ("Lernsequenz aendern") .
+
+END PROC editieren;
+
+
+(*   TEXT MENUE         *)
+
+PROC text menue :
+
+  zeilenmenue anbieten ("TEXT MENUE:",
+                        PROC (INT CONST) text menue kommandos)
+
+END PROC text menue;
+
+FENSTER VAR fontfenster, modfenster;
+fenster initialisieren (fontfenster);
+fenster initialisieren (modfenster);
+fenstergroesse setzen (fontfenster, 40, 2, 40, 21);
+fenstergroesse setzen (modfenster, 55, 13, 25, 10);
+
+TEXT VAR
+  ezeile,
+  format macro := "";
+
+
+PROC text menue kommandos (INT CONST mwahl) :
+
+  SELECT mwahl OF
+  CASE 1 : schrifttyp einstellen
+  CASE 2 : schriftart einstellen
+  CASE 3 : neue seite beginnen
+  CASE 4 : zwischenraum freilassen
+  CASE 5 : globaleinstellung
+  CASE 6 : zeilenweise formatieren
+  CASE 7 : ausschnitt drucken
+  END SELECT .
+
+schrifttyp einstellen :
+  TEXT VAR typname;
+  schrifttyp auswaehlen (typname);
+  IF typname <> "" THEN
+    textanweisung einfuegen ("type", schriftname, FALSE)
+  END IF .
+
+schriftname :
+  textdarstellung (typname) .
+
+schriftart einstellen :
+  schriftart auswaehlen;
+  gewaehlte schriftarten einstellen (gewaehlte modifikationen) .
+
+schriftart auswaehlen :
+  alles neu;
+  auswahl anbieten ("TEXT.Modwahl", modfenster, -10, "AUSWAHL/Allgemein",
+                    PROC (TEXT VAR, INT CONST) modname) .
+
+neue seite beginnen :
+  param := "";
+  eget ("Nummer der nächsten Seite (RET = +1):", param);
+  IF param = "" THEN
+    textanweisung einfuegen ("page", "", TRUE)
+  ELSE
+    INT CONST seitennr := int (param);
+    IF last conversion ok THEN
+      textanweisung einfuegen ("page", text (seitennr), TRUE)
+    ELSE
+      errorstop ("Seitennummer keine Zahl")
+    END IF
+  END IF .
+
+zwischenraum freilassen :
+  param := "";
+  eget ("Zwischenraum in cm:", param);
+  IF param <> "" THEN
+    change all (param, ",", ".");
+    REAL CONST wert := real (param);
+    IF last conversion ok THEN
+      textanweisung einfuegen ("free", text (wert), TRUE)
+    ELSE
+      errorstop ("kein Zahlenwert")
+    END IF
+  END IF .
+
+zeilenweise formatieren :
+  editfile setzen;
+  lineform; ueberschrift neu .
+
+globaleinstellung :
+  einstellung erfragen;
+  einstellung eintragen .
+
+END PROC text menue kommandos;
+
+LET zwischendatei = "&&Druckabschnitt";
+
+PROC ausschnitt drucken :
+
+  LET ende der seite = "Ende der Seite ";
+  FILE VAR ef := editfile;
+  INT VAR pageform anfang;
+  auf pageform datei testen;
+  IF pageform anfang > 0 THEN
+    editfile setzen;
+    IF mark (ef) THEN
+      markierten pageform abschnitt drucken
+    ELSE
+      nach seiten fragen und drucken
+    END IF;
+    print (zwischendatei);
+    forget (zwischendatei, quiet)
+  ELIF mark (ef) THEN
+    abschnitt formatieren und drucken
+  ELSE
+    errorstop ("kein Abschnitt markiert")
+  END IF;
+  alte position einnehmen .
+
+auf pageform datei testen :
+  INT VAR
+    zeile := line no (ef),
+    spalte := col (ef);
+  to line (ef, 1); col (ef, 1);
+  pageform anfang := 0;
+  WHILE NOT eof (ef) CAND kommando in zeile REP
+    IF pos (ef, ende der seite, 8) > 0 THEN
+      pageform anfang := line no (ef);
+    END IF;
+    down (ef)
+  UNTIL pageform anfang > 0 END REP;
+  to line (ef, zeile); col (ef, spalte) .
+
+kommando in zeile :
+  pos (ef, "#", 1) = 1 .
+
+markierten pageform abschnitt drucken :
+  markierten abschnitt kopieren;
+  pageform anfang kopieren (ef, pageform anfang) .
+
+nach seiten fragen und drucken :
+  anfang erfragen;
+  ende erfragen;
+  markierten abschnitt kopieren;
+  pageform anfang kopieren (ef, pageform anfang);
+  mark (ef, 0, 0) .
+
+anfang erfragen :
+  TEXT VAR seitennr := "";
+  eget ("Erste Seite:", seitennr);
+  IF seitennr = "" THEN
+    mark (ef, pageform anfang + 1, 1)
+  ELSE
+    to line (ef, 1);
+    down (ef, ende der seite + text (int (seitennr) - 1));
+    IF eof (ef) THEN
+      mark (ef, pageform anfang + 1, 1)
+    ELSE
+      down (ef);
+      mark (ef, line no (ef), 1)
+    END IF
+  END IF .
+
+ende erfragen :
+  eget ("Letzte Seite:", seitennr);
+  IF seitennr <> "" THEN
+    to line (ef, mark line no (ef));
+    down (ef, ende der seite + seitennr);
+    IF NOT eof (ef) THEN down (ef) END IF
+  ELSE
+    to eof (ef)
+  END IF;
+  col (ef, 1) .
+
+abschnitt formatieren und drucken :
+  macro einfuegen;
+  editfile setzen;
+  ueberschrift neu;
+  IF eja ("Zeilenweise formatieren") THEN
+    lineform; page; ueberschrift zeigen; bild zeigen;
+    markierte schlusszeile
+  END IF;
+  markierten abschnitt kopieren;
+  IF eja ("Seitenweise formatieren") THEN
+    pageform (zwischendatei);
+    alles neu;
+    print (zwischendatei + ".p");
+    forget (zwischendatei + ".p", quiet)
+  ELSE
+    print (zwischendatei)
+  END IF;
+  forget (zwischendatei, quiet);
+  macro entfernen .
+
+markierte schlusszeile :
+  cursor (1, y size - 1);
+  out (""15""); x size - 5 TIMESOUT " "; out (""14""4"") .
+
+macro einfuegen :
+  eget ("Format-Makro:", format macro);
+  IF format macro <> "" THEN
+    to line (ef, mark line no (ef));
+    read record (ef, ezeile);
+    change (ezeile, mark col (ef), mark col (ef) - 1,
+            "#" + format macro + "#");
+    write record (ef, ezeile);
+    to line (ef, zeile); col (ef, spalte)
+  END IF .
+
+macro entfernen :
+  IF format macro <> "" THEN
+    zeile := line no (ef); spalte := col (ef);
+    to line (ef, mark line no (ef));
+    read record (ef, ezeile);
+    change (ezeile, mark col (ef), mark col (ef) + length (format macro) + 1,
+            "");
+    write record (ef, ezeile)
+  END IF;
+  alte position einnehmen .
+
+alte position einnehmen :
+  to line (ef, zeile); col (ef, spalte) .
+
+END PROC ausschnitt drucken;
+
+PROC markierten abschnitt kopieren :
+
+  IF exists (zwischendatei) THEN
+    IF eja ("""" + zwischendatei + """ löschen") THEN
+      forget (zwischendatei, quiet)
+    ELSE
+      errorstop ("")
+    END IF
+  END IF;
+  bitte warten;
+  PUT zwischendatei
+
+END PROC markierten abschnitt kopieren;
+
+PROC pageform anfang kopieren (FILE VAR ef, INT CONST zeilen) :
+
+  FILE VAR zwischen := sequential file (modify, zwischendatei);
+  INT VAR i;
+  to line (zwischen, 1);
+  to line (ef, 1);
+  FOR i FROM 1 UPTO zeilen REP
+    read record (ef, ezeile);
+    insert record (zwischen);
+    write record (zwischen, ezeile);
+    down (ef); down (zwischen)
+  END REP
+
+END PROC pageform anfang kopieren;
+
+PROC schrifttyp auswaehlen (TEXT VAR typname) :
+
+  alles neu;
+  auswahl anbieten ("TEXT.Fontwahl", fontfenster, 1, "AUSWAHL/Allgemein",
+                    PROC (TEXT VAR, INT CONST) aus fonttab);
+  IF wahl (1) <> 0 THEN
+    typname := font (wahl (1))
+  ELSE
+    typname := ""
+  END IF
+
+END PROC schrifttyp auswaehlen;
+
+PROC aus fonttab (TEXT VAR name, INT CONST stelle) :
+
+  IF stelle > 49 THEN
+    name := ""
+  ELSE
+    name := font (stelle)
+  END IF
+
+END PROC aus fonttab;
+
+PROC gewaehlte schriftarten einstellen (TEXT CONST mod) :
+
+  INT VAR
+    zeile := line no (editfile),
+    spalte := col (editfile);
+  FILE VAR edfile := editfile;
+  read record (edfile, ezeile);
+  IF mark (edfile) THEN
+    modifikationen nachher behandeln;
+    modifikationen vorher behandeln
+  ELSE
+    gewaehlte modifikationen einstellen
+  END IF .
+
+modifikationen nachher behandeln :
+  BOOL VAR geloescht;
+  ueber blanks zuruecksetzen;
+  ueber zeilenanfang zuruecksetzen;
+  modifikationen am ende beseitigen;
+  modifikationen am ende einfuegen .
+
+ueber blanks zuruecksetzen :
+  WHILE spalte > 1 CAND (ezeile SUB (spalte - 1)) = " " REP
+    spalte DECR 1
+  END REP .
+
+ueber zeilenanfang zuruecksetzen :
+  INT VAR stelle;
+  IF spalte = 1 CAND zeile > 1 THEN
+    up (edfile);
+    read record (edfile, ezeile);
+    stelle := length (ezeile);
+    IF (ezeile SUB stelle) = " " THEN stelle DECR 1 END IF
+  ELSE
+    stelle := max (spalte - 1, 1)
+  END IF .
+
+modifikationen am ende beseitigen :
+  WHILE (ezeile SUB stelle) = "#" REP
+    ggf anweisung entfernen
+  END REP .
+
+ggf anweisung entfernen :
+  INT VAR anw anf := stelle - 1;
+  WHILE anw anf > 1 CAND (ezeile SUB anw anf) <> "#" REP
+    anw anf DECR 1
+  END REP;
+  anweisung entfernen ("off", anw anf, stelle, geloescht);
+  IF geloescht THEN
+    spalte DECR (stelle - anw anf + 1)
+  END IF;
+  stelle := anw anf - 1 .
+
+modifikationen am ende einfuegen :
+  IF pos (mod, "a") = 0 THEN
+    neue modifikationen nachher
+  END IF;
+  write record (edfile, ezeile) .
+
+neue modifikationen nachher :
+  FOR i FROM length (mod) DOWNTO 1 REP
+    change (ezeile, spalte, spalte - 1, mod param off);
+    spalte INCR mod param laenge
+  END REP .
+
+modifikationen vorher behandeln :
+  to line (edfile, mark line no (edfile));
+  col (edfile, mark col (edfile));
+  read record (edfile, ezeile);
+  stelle := col (edfile);
+  WHILE (ezeile SUB stelle) = "#" REP
+    ggf anfangsanweisung entfernen
+  END REP;
+  neue modifikationen am anfang einfuegen;
+  write record (edfile, ezeile);
+  to line (edfile, zeile);
+  col (edfile, spalte);
+  abschnitt neu (mark line no (edfile), zeile);
+  mark (edfile, 0, 0) .
+
+ggf anfangsanweisung entfernen :
+  INT VAR anw ende := pos (ezeile, "#", stelle + 1);
+  anweisung entfernen ("on", stelle, anw ende, geloescht);
+  IF geloescht THEN
+    IF line no (edfile) = zeile THEN
+      spalte DECR (anw ende - stelle + 1)
+    END IF
+  ELSE
+    stelle := anw ende + 1
+  END IF .
+
+neue modifikationen am anfang einfuegen :
+  IF pos (mod, "a") = 0 THEN
+    neue modifikationen vorher
+  END IF .
+
+neue modifikationen vorher :
+  FOR i FROM length (mod) DOWNTO 1 REP
+    change (ezeile, stelle, stelle - 1, mod param on);
+    IF line no (edfile) = zeile THEN
+      spalte INCR mod param laenge
+    END IF
+  END REP .
+
+gewaehlte modifikationen einstellen :
+  INT VAR i;
+  BOOL VAR mod aus;
+  mod aus := pos (mod, "a") > 0;
+  FOR i FROM length (mod) DOWNTO 1 REP
+    IF (mod SUB i) = "a" THEN
+    ELIF mod aus THEN
+      change (ezeile, spalte, spalte - 1, mod param off)
+    ELSE
+      change (ezeile, spalte, spalte - 1, mod param on)
+    END IF
+  END REP;
+  write record (edfile, ezeile);
+  abschnitt neu (zeile, zeile) .
+
+mod param on :
+  TEXT VAR
+    mod zeichen := mod SUB i,
+    mod text;
+  IF mod zeichen = "h" THEN
+    mod text := "#u#"
+  ELIF mod zeichen = "t" THEN
+    mod text := "#d#"
+  ELSE
+    mod text := "#on(""" + mod zeichen + """)#"
+  END IF;
+  mod text .
+
+mod param off :
+  mod zeichen := mod SUB i;
+  IF mod zeichen = "h" OR mod zeichen = "t" THEN
+    mod text := "#e#"
+  ELSE
+    mod text := "#off(""" + mod zeichen + """)#"
+  END IF;
+  mod text .
+
+mod param laenge :
+  length (mod text) .
+
+END PROC gewaehlte schriftarten einstellen;
+
+PROC modname (TEXT VAR name, INT CONST stelle) :
+
+  SELECT stelle OF
+  CASE 1 : name := "Fett"
+  CASE 2 : name := "Kursiv"
+  CASE 3 : name := "Unterstrichen"
+  CASE 4 : name := "Hoch"
+  CASE 5 : name := "Tief"
+  CASE 6 : name := "Aus"
+  OTHERWISE name := ""
+  END SELECT
+
+END PROC modname;
+
+TEXT PROC gewaehlte modifikationen :
+
+  TEXT VAR ergebnis := "";
+  INT VAR stelle := 1;
+  WHILE wahl (stelle) > 0 REP
+    wahl merken;
+    stelle INCR 1
+  END REP;
+  ergebnis .
+
+wahl merken :
+  SELECT wahl (stelle) OF
+  CASE 1 : ergebnis CAT "b"
+  CASE 2 : ergebnis CAT "i"
+  CASE 3 : ergebnis CAT "u"
+  CASE 4 : ergebnis CAT "h"
+  CASE 5 : ergebnis CAT "t"
+  CASE 6 : ergebnis CAT "a"
+  END SELECT .
+
+END PROC gewaehlte modifikationen;
+
+PROC anweisung entfernen (TEXT CONST anw name, INT CONST beginn, ende,
+                          BOOL VAR geloescht) :
+
+  geloescht := FALSE;
+  IF beginn > 0 AND ende > 0
+     CAND (ezeile SUB beginn) = "#" CAND (ezeile SUB ende) = "#" THEN
+    INT CONST vorkommen := pos (ezeile, anw name, beginn, ende);
+    IF vorkommen > 0 AND vorkommen < beginn + 4
+      OR up down anweisung THEN
+      change (ezeile, beginn, ende, "");
+      geloescht := TRUE
+    END IF
+  END IF .
+
+up down anweisung :
+  IF ende = beginn + 2 THEN
+    TEXT CONST alte anweisung := ezeile SUB beginn + 1;
+    IF anw name = "on" THEN
+      alte anweisung = "u" OR alte anweisung = "d"
+    ELSE
+      alte anweisung = "e"
+    END IF
+  ELSE
+    FALSE
+  END IF .
+
+END PROC anweisung entfernen;
+
+PROC textanweisung einfuegen (TEXT CONST anweisung, param,
+                              BOOL CONST ab anfang) :
+
+  FILE VAR edfile := editfile;
+  IF ab anfang THEN col (edfile, 1) END IF;
+  INT CONST ce := col (edfile);
+  read record (edfile, ezeile);
+  IF (ezeile SUB ce) = "#" CAND gleiche anweisung THEN
+    anweisung ersetzen
+  ELIF ce = 1 THEN
+    neue zeile einfuegen
+  ELSE
+    an stelle einfuegen
+  END IF .
+
+gleiche anweisung :
+  INT CONST apos := pos (ezeile, anweisung, ce);
+  apos > 0 AND pos (ezeile, "#", ce + 1) > a pos AND
+    (param = "" OR pos (ezeile, "(", ce) > a pos) .
+
+anweisung ersetzen :
+  IF param <> "" THEN
+    INT CONST anf := pos (ezeile, "(", ce),
+              end := pos (ezeile, ")", anf);
+    IF anf > 0 AND end > 0 AND anf < end THEN
+      change (ezeile, anf + 1, end - 1, param);
+      write record (edfile, ezeile);
+      abschnitt neu (line no (edfile), line no(edfile))
+    END IF
+  END IF .
+
+neue zeile einfuegen :
+  insert record (edfile);
+  IF param <> "" THEN
+    write record (edfile, "#" + anweisung + "(" + param + ")# ")
+  ELSE
+    write record (edfile, "#" + anweisung + "# ")
+  END IF;
+  abschnitt neu (line no (edfile), 9999) .
+
+an stelle einfuegen :
+  IF param <> "" THEN
+    change (ezeile, ce, ce - 1, "#" + anweisung + "(" + param + ")#")
+  ELSE
+    change (ezeile, ce, ce - 1, "#" + anweisung + "#")
+  END IF;
+  write record (edfile, ezeile);
+  abschnitt neu (line no (edfile), line no (edfile)) .
+
+END PROC textanweisung einfuegen;
+
+LET
+  global anfang =
+    "#- Globale Einstellungen, nicht verschieben -# ",
+  global ende =
+    "#- Ende der globalen Einstellungen ----------# ";
+
+TEXT VAR
+  e type := "",
+  e limit := "16.0",
+  e x start := "2.5",
+  e y start := "2.25",
+  e pagelength := "25.0",
+  e linefeed := "1.0";
+
+PROC einstellung erfragen :
+
+  REP
+    schrifttyp auswaehlen (e type);
+    IF e type = "" CAND
+      eja ("Typ muß gewaehlt werden, Funktion abbrechen") THEN
+      errorstop ("")
+    END IF
+  UNTIL e type <> "" END REP;
+  eget ("Breite des Schreibfelds in cm:", e limit);
+  eget ("Länge des Schreibfelds in cm:", e pagelength);
+  eget ("Oberer Rand in cm:", e y start);
+  eget ("Linker Rand in cm:", e x start);
+  eget ("Zeilenabstand als relativer Faktor:", e linefeed)
+
+END PROC einstellung erfragen;
+
+PROC einstellung eintragen :
+
+  FILE VAR edfile := editfile;
+  INT VAR
+    zeile := line no (edfile),
+    spalte := col (edfile);
+  col (edfile, 1);
+  to line (edfile, 1);
+  read record (edfile, ezeile);
+  IF pos (ezeile, "type") > 0 THEN
+    down (edfile);
+    read record (edfile, ezeile);
+    alte einstellung suchen
+  END IF;
+  ab hier einfuegen;
+  an alte stelle .
+
+alte einstellung suchen :
+  IF ezeile = global anfang THEN
+    down (edfile, global ende);
+    IF eof (edfile) THEN
+      to line (edfile, 2)
+    ELSE
+      down (edfile)
+    END IF
+  END IF .
+
+ab hier einfuegen :
+  IF line no (edfile) > 1 CAND eja ("Alte Einstellung loeschen") THEN
+    INT CONST zu loeschen := line no (edfile) - 1;
+    to line (edfile, 1);
+    INT VAR i;
+    FOR i FROM 1 UPTO zu loeschen REP
+      delete record (edfile)
+    END REP;
+    zeile DECR zu loeschen
+  END IF;
+  typ und limit einfuegen;
+  global anfang einfuegen;
+  seitenlaenge einfuegen;
+  start einfuegen;
+  linefeed einfuegen;
+  global ende einfuegen .
+
+typ und limit einfuegen :
+  insert record (edfile);
+  write record (edfile,
+    "#type (""" + etype + """)##limit (" + e limit + ")# ");
+  down (edfile) .
+
+global anfang einfuegen :
+  insert record (edfile);
+  write record (edfile, global anfang);
+  down (edfile) .
+
+seitenlaenge einfuegen :
+  insert record (edfile);
+  write record (edfile, "#pagelength (" + e pagelength + ")# ");
+  down (edfile) .
+
+start einfuegen :
+  insert record (edfile);
+  write record (edfile,
+    "#start (" + e x start + ", " + e y start + ")# ");
+  down (edfile) .
+
+linefeed einfuegen :
+  insert record (edfile);
+  write record (edfile, "#linefeed (" + e linefeed + ")# ");
+  down (edfile) .
+
+global ende einfuegen :
+  insert record (edfile);
+  write record (edfile, global ende);
+  zeile INCR 6 .
+
+an alte stelle :
+  to line (edfile, zeile);
+  col (edfile, spalte) .
+
+END PROC einstellung eintragen;
+
+
+(* Editor im EUDAS-Fenster     *)
+
+INT VAR return code;
+
+LET
+  edit status =  #1003#
+"EDIT:  Menü: ESC m, ESC t   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?";
+ 
+BOOL VAR status frei;
+
+
+PROC edit status anzeigen :
+  status anzeigen (edit status)
+END PROC edit status anzeigen;
+
+PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe) : 
+
+  INT VAR x, y, x l, y l;
+  fenstergroesse (fenster, x, y, x l, y l);
+  fenster veraendert (fenster);
+  enable stop;
+  fenster datei := "";
+  IF groesster editor = 0 THEN status frei := y > 1 END IF;
+  REP
+    IF status frei THEN status anzeigen (edit status) END IF; 
+    open editor (groesster editor + 1, f, TRUE, x, y, x l, y l);
+    edit (groesster editor, "eqvw19dpgn"9"?hFmt", PROC (TEXT CONST) kdo);
+    return code behandeln
+  END REP .
+
+return code behandeln :
+  SELECT return code OF
+  CASE 0 : LEAVE edit
+  CASE 1 : hilfe anbieten (hilfe, fenster) 
+  CASE 2 : errorstop ("")
+  END SELECT .
+ 
+END PROC edit;
+ 
+PROC kdo (TEXT CONST zeichen) :
+
+  return code := pos ("q?h", zeichen);
+  IF return code > 0 THEN
+    return code DECR 1;
+    quit
+  ELIF zeichen = "m" THEN
+    edit menue;
+    IF status frei THEN status anzeigen (edit status) END IF; 
+  ELIF zeichen = "t" THEN
+    text menue;
+    IF status frei THEN status anzeigen (edit status) END IF; 
+  ELSE
+    std kommando interpreter (zeichen);
+    IF status frei THEN status anzeigen (edit status) END IF; 
+  END IF
+
+END PROC kdo;
+
+
+END PACKET edit menue;
+(*
+FENSTER VAR fe; fenster initialisieren (fe);
+fenstergroesse setzen (fe, 1, 2, 79, 23);
+FILE VAR f := sequential file (modify, "testdatei");
+edit (f, fe, "EDIT/Allgemein")
+*)
+
diff --git a/app/flint/0.4/src/eudas.manager b/app/flint/0.4/src/eudas.manager
new file mode 100644
index 0000000..802a507
--- /dev/null
+++ b/app/flint/0.4/src/eudas.manager
@@ -0,0 +1,216 @@
+PACKET eudas manager                         (* Autor: Thomas Berlage *)
+                                             (* Stand: 20.01.88       *)
+  DEFINES
+
+  eudas manager,
+  setze partner,
+  abhaengige task,
+  end partner :
+
+
+LET
+  code dateien        = 190,
+  code felder         = 191,
+  code positioniere   = 192,
+  code satz           = 193,
+  end myself code     = 197,
+  set controlled code = 198,
+  ask partner code    = 200;
+
+LET
+  ack   = 0;
+
+LET
+  COM = STRUCT (INT int info,
+                BOOL bool info,
+                TEXT text info,
+                SATZ satz info);
+
+BOUND COM VAR p;
+
+ROW 4 TEXT VAR partner vater;
+  partner vater (1) := "";
+  partner vater (2) := "";
+  partner vater (3) := "";
+  partner vater (4) := "";
+
+TEXT VAR puffer;
+
+LET
+  kein partner =
+    "Kein Partner";
+
+
+PROC setze partner (INT CONST nr, TEXT CONST name des vaters) :
+
+  partner vater (nr) := name des vaters
+
+END PROC setze partner;
+
+PROC eudas manager (DATASPACE VAR ds, INT CONST order, phase,
+                    TASK CONST order task) :
+
+  enable stop;
+  SELECT order OF
+  CASE code dateien      : code dateien ausfuehren
+  CASE code felder       : code felder ausfuehren
+  CASE code positioniere : code positioniere ausfuehren
+  CASE code satz         : code satz ausfuehren
+  OTHERWISE andere codes
+  END SELECT .
+
+andere codes :
+  IF order > ask partner code AND order < ask partner code + 4 THEN
+    ask partner code ausfuehren
+  ELSE
+    menue manager (ds, order, phase, order task)
+  END IF .
+
+code dateien ausfuehren :
+  p := ds;
+  p. int info := dateiversion;
+  dateinamen anlegen;
+  send (order task, ack, ds) .
+
+dateinamen anlegen :
+  satz initialisieren (p. satz info);
+  FOR i FROM 1 UPTO anzahl dateien REP
+    feld aendern (p. satz info, i, eudas dateiname (i))
+  END REP .
+
+code felder ausfuehren :
+  p := ds;
+  feldinfo anlegen;
+  feldnamen anlegen;
+  send (order task, ack, ds) .
+
+feldinfo anlegen :
+  INT VAR i;
+  TEXT VAR rep := "  ";
+  p. text info := "";
+  FOR i FROM 1 UPTO anzahl felder REP
+    replace (rep, 1, feldinfo (i));
+    p. text info CAT rep
+  END REP .
+
+feldnamen anlegen :
+  satz initialisieren (p. satz info, anzahl felder);
+  FOR i FROM 1 UPTO anzahl felder REP
+    feldnamen lesen (i, puffer);
+    feld aendern (p. satz info, i, puffer)
+  END REP .
+
+code positioniere ausfuehren :
+  p := ds;
+  positionieren;
+  ergebnis ablegen;
+  send (order task, ack, ds) .
+
+positionieren :
+  IF p. bool info THEN
+    relativ positionieren
+  ELSE
+    auf satz (p. int info)
+  END IF .
+
+relativ positionieren :
+  IF p. int info > 0 THEN
+    weiter (p. int info)
+  ELIF p. int info < 0 THEN
+    zurueck (- p. int info)
+  END IF .
+
+ergebnis ablegen :
+  p. int info := satznummer;
+  p. bool info := dateiende .
+
+code satz ausfuehren :
+  p := ds;
+  p. int info := satzkombination;
+  p. bool info := satz ausgewaehlt;
+  satz aufbauen;
+  send (order task, ack, ds) .
+
+satz aufbauen :
+  satz initialisieren (p. satz info, anzahl felder);
+  FOR i FROM 1 UPTO anzahl felder REP
+    feld lesen (i, puffer);
+    feld aendern (p. satz info, i, puffer)
+  END REP .
+
+ask partner code ausfuehren :
+  INT VAR p nr := order - ask partner code;
+  forget (ds); ds := nilspace;
+  BOUND TASK VAR c task := ds;
+  CONCR (c task) := partner mit einrichten (p nr, task index);
+  send (order task, ack, ds) .
+
+task index :
+  FOR i FROM 2 UPTO 4 REP
+    IF partner task (i) = order task THEN
+      LEAVE task index WITH i
+    END IF
+  END REP;
+  errorstop (kein partner);
+  1 .
+
+END PROC eudas manager;
+
+TASK PROC abhaengige task (INT CONST p nr) :
+
+  partner mit einrichten (p nr, 1)
+
+END PROC abhaengige task;
+
+TASK PROC partner mit einrichten (INT CONST p nr, p von) :
+
+  enable stop;
+  IF NOT exists (partner task (p nr)) THEN
+    partner einrichten
+  END IF;
+  partner task (p nr) .
+
+partner einrichten :
+  TEXT CONST neuer name := name (myself) + "-p" + text (p nr - 1);
+  begin (neuer name, partner vater (p nr));
+  partner task (p nr, task (neuer name));
+  abhaengig setzen .
+
+abhaengig setzen :
+  DATASPACE VAR send ds := nilspace;
+  BOUND STRUCT (INT von, TASK pt) VAR m := send ds;
+  m. von := p von;
+  m. pt := partner task (p von);
+  INT VAR i, reply;
+  FOR i FROM 1 UPTO 5 REP
+    pingpong (partner task (p nr), set controlled code, send ds, reply);
+    IF reply = -2 THEN pause (5) END IF
+  UNTIL reply <> -2 END REP;
+  forget (send ds) .
+
+END PROC partner mit einrichten;
+
+PROC end partner (INT CONST p nr) :
+
+  IF exists (partner task (p nr)) THEN
+    end code senden
+  END IF .
+
+end code senden :
+  DATASPACE VAR send ds := nilspace;
+  INT VAR i, reply;
+  FOR i FROM 1 UPTO 10 REP
+    send (partner task (p nr), end myself code, send ds, reply);
+    IF reply = ack THEN
+      LEAVE end code senden
+    END IF;
+    pause (3)
+  END REP;
+  forget (send ds);
+  errorstop ("END nicht angenommen") .
+
+END PROC end partner;
+
+
+END PACKET eudas manager;
+
diff --git a/app/flint/0.4/src/flint b/app/flint/0.4/src/flint
new file mode 100644
index 0000000..14e0fe1
--- /dev/null
+++ b/app/flint/0.4/src/flint
@@ -0,0 +1,808 @@
+PACKET flint
+
+(*************************************************************************)
+(*                                                                       *)
+(*     EUMEL Menue-Monitor                                               *)
+(*                                                                       *)
+(*     Version 05                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 16.10.88                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  flint :
+
+
+TEXT CONST flint vater := name (myself);
+
+setze partner (2, "KAKTUS");
+setze partner (3, "CHART");
+
+
+PROC flint :
+
+  page;
+  fenstergroessen bestimmen;
+  disable stop;
+  REP
+    menue anbieten (ROW 6 TEXT :
+        ("FLINT.Standard", "FLINT.Eigene", "FLINT.System",
+         "EUDAS.Dateien", "EUDAS.Archiv", ""),
+        fenster links, TRUE,
+        PROC (INT CONST, INT CONST) flint inter);
+    bereich wechseln
+  END REP
+
+END PROC flint;
+
+PROC fusszeile aktualisieren :
+
+  arbeitsbereich bestimmen;
+  fussteil (2, "", "")
+
+END PROC fusszeile aktualisieren;
+
+
+(*************************** FLINT Interpreter *****************************)
+
+LET
+  t datum =  #1300#
+    ""15"Datum "14"",
+  kb von =  #1301#
+    " KB von ",
+  sind belegt =  #1302#
+    " KB sind belegt.",
+  p taskname =  #1303#
+    "Name des Arbeitsbereichs:",
+  existiert nicht als task =  #1304#
+    " ist kein Name eines Bereiches",
+  t loeschen =  #1305#
+    " verlassen und löschen",
+  t speicher =  #1306#
+    "Speicher:",
+  t cpu zeit =  #1307#
+    " KB      CPU-Zeit : ",
+  t zustand =  #1308#
+    "Zustand :  ",
+  t prio =  #1309#
+    "      Priorität: ",
+  t kanal =  #1310#
+    "      Kanal: ",
+  t busy =  #1311#
+    "Arbeit",
+  t io =  #1312#
+    "EinAus",
+  t wait =  #1313#
+    "Warten",
+  t busy blocked =  #1314#
+    "B(Arb)",
+  t io blocked =  #1315#
+    "B(E/A)",
+  t wait blocked =  #1316#
+    "B(Wrt)",
+  t dead =  #1317#
+    ">>TOT<",
+  bereich neu einrichten =  #1318#
+    "Bereich existiert nicht. Neu einrichten",
+  p name vater =  #1319#
+    "Unter welchem Vaterbereich (RET -> FLINT):",
+  weitermachen in =  #1320#
+    "Weitermachen in Bereich:",
+  task ganz abkoppeln =  #1321#
+    "Eigenen Bereich ganz abkoppeln";
+
+TEXT VAR
+  wechsel taskname := "";
+
+SATZ VAR sammel;
+
+
+PROC flint inter (INT CONST menuenr, f nr) :
+
+  SELECT menuenr OF
+  CASE 0: sperren setzen
+  CASE 1: standard interpreter
+  CASE 2: eigene interpreter
+  CASE 3: system interpreter
+  CASE 4: dateiverwaltung (f nr)
+  CASE 5: archivverwaltung (menuenr, f nr)
+  END SELECT .
+
+sperren setzen :
+  fusszeile ("", "", 35, t datum, 64);
+  fussteil (3, date) .
+
+standard interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : textverarbeitung
+  CASE 2 : eudas
+  CASE 3 : kaktus
+  CASE 4 : dgs superchart
+  CASE 5 : programme
+  CASE 6 : systemsteuerung
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+kaktus :
+  continue (abhaengige task (2));
+  page; bildschirm neu .
+
+dgs superchart :
+  continue (abhaengige task (3));
+  page; bildschirm neu .
+
+systemsteuerung :
+  continue (task ("OP"));
+  page; bildschirm neu .
+
+ggf dialogfenster loeschen :
+  IF f nr = -1 THEN dialogfenster loeschen END IF .
+
+eigene interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+system interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : bereich wechseln
+  CASE 2 : bereichsuebersicht
+  CASE 3 : speicherbelegung
+  CASE 4 : eigener status
+  CASE 5 : fremder taskstatus
+  CASE 6 : task info (3); bildschirm neu; dialogfenster loeschen
+  CASE 7 : task loeschen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+bereichsuebersicht :
+  disable stop;
+  bitte warten;
+  DATASPACE VAR list ds := nilspace;
+  FILE VAR f := sequential file (output, list ds);
+  task info (1, f);
+  IF NOT is error THEN
+    edit (f, fenster rechts, "SHOW/Taskinfo", FALSE)
+  END IF;
+  forget (list ds);
+  enable stop .
+
+speicherbelegung :
+  INT VAR size, used;
+  storage (size, used);
+  size := int (real (size + 24) * 64.0 / 63.0);
+  IF l3 THEN
+    size := size DIV 1024;
+    used := used DIV 1024
+  END IF;
+  dialog (text (used) + kb von + text (size) + sind belegt) .
+
+eigener status :
+  task zustand (myself) .
+
+fremder taskstatus :
+  TEXT VAR taskname := "";
+  editget (p taskname, taskname, "GET/Taskname", "");
+  TASK VAR status task := task (task name);
+  IF exists (status task) THEN
+    task zustand (status task)
+  ELSE
+    errorstop (textdarstellung (taskname) + existiert nicht als task)
+  END IF .
+
+task loeschen :
+  IF ja (textdarstellung (name (myself)) + t loeschen,
+         "JA/Task loeschen", FALSE) THEN
+    end partner (2); end partner (3);
+    deferred end;
+    bereich wechseln
+  END IF .
+
+END PROC flint inter;
+
+PROC bereich wechseln :
+
+  enable stop;
+  editget (weitermachen in, wechsel taskname, "z", "GET/wtaskname");
+  IF subtext (wechsel taskname, 1, 2) = ""27"z" THEN
+    bereich auswaehlen
+  ELIF wechsel taskname <> "" THEN
+    ggf task einrichten
+  ELIF ganz abkoppeln THEN
+    continue (niltask)
+  END IF;
+  fenstergroessen bestimmen;
+  page;
+  bildschirm neu .
+
+bereich auswaehlen :
+  bitte warten;
+  alle tasknamen sammeln;
+  auswahl anbieten ("FLINT.Taskauswahl", fenster rechts, 1,
+      "AUSWAHL/Tasks", PROC (TEXT VAR, INT CONST) aus sammel);
+  IF wahl (1) <> 0 THEN
+    feld lesen (sammel, wahl (1), wechsel taskname);
+    continue (task (wechsel taskname))
+  END IF .
+
+alle tasknamen sammeln :
+  access catalogue;
+  satz initialisieren (sammel);
+  wechsel taskname := subtext (wechsel taskname, 3);
+  pattern feststellen;
+  IF exists task (flint vater) THEN
+    sammel tasks (task (flint vater), pattern)
+  ELSE
+    sammel tasks (father, pattern)
+  END IF .
+
+pattern feststellen :
+  TEXT VAR pattern;
+  IF pos (wechsel taskname, "*") = 0 THEN
+    pattern := ""
+  ELSE
+    pattern := wechsel taskname
+  END IF .
+
+ggf task einrichten :
+  IF NOT exists task (wechsel taskname) THEN
+    IF ja (bereich neu einrichten, "JA/task einrichten") THEN
+      vater erfragen;
+      begin (wechsel taskname, name vater);
+      continue (task (wechsel taskname))
+    END IF
+  ELSE
+    continue (task (wechsel taskname))
+  END IF .
+
+vater erfragen :
+  TEXT VAR name vater := "";
+  editget (p name vater, name vater, "", "GET/Vatertask");
+  IF name vater = "" THEN
+    name vater := flint vater
+  END IF .
+
+ganz abkoppeln :
+  ja (task ganz abkoppeln, "JA/abkoppeln") .
+
+END PROC bereich wechseln;
+
+PROC aus sammel (TEXT VAR inhalt, INT CONST pos) :
+
+  IF pos > 200 THEN
+    inhalt := ""
+  ELSE
+    feld lesen (sammel, pos, inhalt)
+  END IF
+
+END PROC aus sammel;
+
+PROC sammel tasks (TASK CONST vater, TEXT CONST pattern) :
+
+  TASK VAR naechste := son (vater);
+  WHILE NOT is niltask (naechste) REP
+    ggf task sammeln;
+    sammel tasks (naechste, pattern);
+    naechste := brother (naechste)
+  END REP .
+
+ggf task sammeln :
+  IF naechste = myself THEN
+  ELIF pattern = "" COR (name (naechste) LIKE pattern) THEN
+    feld aendern (sammel, felderzahl (sammel) + 1, name (naechste))
+  END IF .
+
+END PROC sammel tasks;
+
+PROC task zustand (TASK CONST status task) :
+
+  dialog (t speicher + speicher + t cpu zeit + cpu zeit);
+  out (t zustand); out status; out (t prio); out prio;
+  out (t kanal); out kanal .
+
+speicher :
+  text (storage (status task), 5) .
+
+cpu zeit :
+  disable stop;
+  TEXT VAR result := subtext (time (clock (status task), 12), 1, 10);
+  IF is error THEN
+    clear error; result := "**********"
+  END IF;
+  result .
+
+out status :
+  SELECT status (status task) OF
+  CASE 0 : out (t busy)
+  CASE 1 : out (t io)
+  CASE 2 : out (t wait)
+  CASE 4 : out (t busy blocked)
+  CASE 5 : out (t io blocked)
+  CASE 6 : out (t wait blocked)
+  OTHERWISE out (t dead)
+  END SELECT .
+
+out prio :
+  out (text (pcb (status task, 6))) .
+
+out kanal :
+  IF channel (status task) = 0 THEN
+    out (" -")
+  ELSE
+    out (text (channel (status task), 2))
+  END IF .
+
+END PROC task zustand;
+
+
+(**************************** Textverarbeitung ****************************)
+
+LET
+  t ausnahmen =  #1400#
+    "Ausnahmen",
+  t druckertask =  #1401#
+    "Name Druckertask: ",
+  task existiert nicht =  #1402#
+    "Task existiert nicht",
+  t stationsnummer =  #1403#
+    "Stationsnummer der Druckertask: ",
+  falsche stationsnummer =  #1404#
+    "Falsche Stationsnummer",
+  t trennfaktor =  #1405#
+    "Trennfaktor (4 bis 20): ",
+  t ersten kopf unterdruecken =  #1406#
+    "Ersten Kopfteil unterdrücken",
+  t letzten fuss unterdruecken =  #1407#
+    "Letzten Fußteil unterdrücken",
+  t fussabstand =  #1408#
+    "Anzahl Leerzeilen vor Fußnoten (0 bis 9): ",
+  lineform manuell =  #1409#
+    "Trennungen manuell bestimmen",
+  pageform manuell =  #1410#
+    "Seitenaufteilung manuell bestimmen",
+  falscher trennfaktor =  #1411#
+    "Falscher Trennfaktor (nur 4 bis 20)",
+  name fonttabelle =  #1412#
+    "Name der Fonttabelle: ",
+  t neu einrichten =  #1413#
+    " neu einrichten",
+  name der datei =  #1414#
+    "Name der Datei: ";
+
+LET
+  font file typ = 3009;
+
+INT VAR
+  file typ := 1003;
+
+IF l3 THEN file typ := 1004 END IF .
+
+l3 : maxint DIV 2 > 17000 .
+;
+
+BOOL VAR
+  zeilen manuell := TRUE,
+  seiten manuell := TRUE;
+
+TEXT VAR
+  druckertask := "PRINTER";
+
+INT VAR
+  druckerstation := station (myself);
+
+
+PROC textverarbeitung :
+
+  page; bildschirm neu;
+  BOOL CONST alter umbruch := word wrap;
+  word wrap (TRUE);
+  menue anbieten (ROW 6 TEXT :
+      ("TEXTE.Erstellen", "TEXTE.Bearbeiten", "TEXTE.Einstellungen",
+       "EUDAS.Dateien", "EUDAS.Archiv", ""),
+      fenster links, TRUE,
+      PROC (INT CONST, INT CONST) text inter);
+  word wrap (alter umbruch);
+  page; bildschirm neu
+
+END PROC textverarbeitung;
+
+PROC text inter (INT CONST menuenr, f nr) :
+
+  SELECT menuenr OF
+  CASE 0: sperren setzen
+  CASE 1: erstellen interpreter
+  CASE 2: bearbeiten interpreter
+  CASE 3: einstellungen interpreter
+  CASE 4: dateiverwaltung (f nr)
+  CASE 5: archivverwaltung (menuenr, f nr)
+  END SELECT .
+
+sperren setzen :
+  fusszeile ("", "", 35, t datum, 64);
+  fussteil (3, date) .
+
+erstellen interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : editieren
+  CASE 2 : drucken
+  CASE 3 : zeilen formatieren
+  CASE 4 : seiten formatieren
+  CASE 5 : automatik
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+editieren :
+  ausfuehrung (PROC (TEXT CONST) editiere);
+  dialogfenster loeschen .
+
+drucken :
+  ausfuehrung (PROC (TEXT CONST) drucke) .
+
+zeilen formatieren :
+  bildschirm neu;
+  IF zeilen manuell THEN
+    ausfuehrung (PROC (TEXT CONST) lineform)
+  ELSE
+    ausfuehrung (PROC (TEXT CONST) autoform)
+  END IF;
+  dialogfenster loeschen .
+
+seiten formatieren :
+  bildschirm neu;
+  IF seiten manuell THEN
+    ausfuehrung (PROC (TEXT CONST) pageform)
+  ELSE
+    ausfuehrung (PROC (TEXT CONST) autopageform)
+  END IF;
+  dialogfenster loeschen .
+
+automatik :
+  zeilen manuell := ja (lineform manuell,
+                        "JA/lineform manuell", zeilen manuell);
+  seiten manuell := ja (pageform manuell,
+                        "JA/pageform manuell", seiten manuell) .
+
+ggf dialogfenster loeschen :
+  IF f nr = -1 THEN dialogfenster loeschen END IF .
+
+bearbeiten interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : index anlegen
+  CASE 2 : outline anlegen
+  CASE 3 : file sortieren
+  CASE 4 : macros laden
+  CASE 5 : macros anzeigen
+  CASE 6 : ausnahmen erweitern
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+index anlegen :
+  ausfuehrung (PROC (TEXT CONST) index);
+  bildschirm neu; dialogfenster loeschen .
+
+outline anlegen :
+  ausfuehrung (PROC (TEXT CONST) outline);
+  bildschirm neu; dialogfenster loeschen .
+
+file sortieren :
+  bitte warten;
+  ausfuehrung (PROC (TEXT CONST) sort) .
+
+macros laden :
+  page;
+  einzelausfuehrung (PROC (TEXT CONST) load macros);
+  bildschirm neu; dialogfenster loeschen .
+
+macros anzeigen :
+  bitte warten;
+  list macros;
+  bildschirm neu; dialogfenster loeschen .
+
+ausnahmen erweitern :
+  TEXT VAR zwischendatei := t ausnahmen;
+  WHILE exists (zwischendatei) REP zwischendatei CAT " " END REP;
+  create (zwischendatei);
+  bitte warten;
+  entlade ausnahmen (zwischendatei);
+  edit (zwischendatei);
+  bitte warten;
+  lade ausnahmen (zwischendatei);
+  forget (zwischendatei, quiet) .
+
+einstellungen interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : fonttabelle laden
+  CASE 2 : fonts anzeigen
+  CASE 3 : druckertask verstellen
+  CASE 4 : trennfaktor einstellen
+  CASE 5 : briefmodus einstellen
+  CASE 6 : abstand fussnoten einstellen
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+fonttabelle laden :
+  TASK VAR fonttask;
+  IF exists task ("configurator") THEN
+    fonttask := task ("configurator")
+  ELSE
+    fonttask := niltask
+  END IF;
+  ausfuehrung (name fonttabelle, TRUE, font file typ, fonttask,
+               PROC (TEXT CONST) font table) .
+
+fonts anzeigen :
+  bitte warten;
+  list fonts;
+  bildschirm neu; dialogfenster loeschen .
+
+druckertask verstellen :
+  editget (t druckertask, druckertask, "GET/Druckertask", "");
+  IF NOT exists task (druckertask) THEN
+    errorstop (task existiert nicht)
+  ELIF station (myself) <> 0 THEN
+    erfrage station
+  ELSE
+    druckerstation := station (myself)
+  END IF .
+
+erfrage station :
+  TEXT VAR st := text (druckerstation);
+  editget (t stationsnummer, st, "GET/Druckstation", "");
+  IF int (st) >= 0 AND last conversion ok THEN
+    druckerstation := int (st)
+  ELSE
+    errorstop (falsche stationsnummer)
+  END IF .
+
+trennfaktor einstellen :
+  TEXT VAR faktor := "";
+  editget (t trennfaktor, faktor, "GET/Trennfaktor", "");
+  IF faktor <> "" THEN
+    INT CONST fa := int (faktor);
+    IF fa < 4 OR fa > 20 THEN
+      errorstop (falscher trennfaktor);
+    ELSE
+      hyphenation width (fa)
+    END IF
+  END IF .
+
+briefmodus einstellen :
+  first head (NOT ja (t ersten kopf unterdruecken, "JA/firsthead", FALSE));
+  last bottom (NOT ja (t letzten fuss unterdruecken, "JA/lastbottom", FALSE)) .
+
+abstand fussnoten einstellen :
+  TEXT VAR anzahl := "";
+  editget (t fussabstand, anzahl, "GET/Fussabstand", "");
+  IF anzahl <> "" THEN
+    number empty lines before foot (int (anzahl))
+  END IF .
+
+END PROC text inter;
+
+PROC drucke (TEXT CONST dateiname) :
+
+  save (dateiname, druckerstation / druckertask)
+
+END PROC drucke;
+
+PROC editiere (TEXT CONST dateiname) :
+
+  IF exists (dateiname) COR neu einrichten THEN
+    IF NOT exists (dateiname) THEN vorher einrichten END IF;
+    FILE VAR f := sequential file (modify, dateiname);
+    edit (f, fenster ganz, "EDIT/Text")
+  END IF .
+
+neu einrichten :
+  ja (textdarstellung (dateiname) + t neu einrichten,
+      "JA/einrichten") .
+
+vorher einrichten :
+  FILE VAR dummy := sequential file (modify, dateiname) .
+
+END PROC editiere;
+
+PROC ausfuehrung (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, FALSE, file typ, PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+PROC einzelausfuehrung (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, TRUE, file typ, PROC (TEXT CONST) operation)
+
+END PROC einzelausfuehrung;
+
+
+(*************************** Programme ***********************************)
+
+LET
+  p name prozedur =  #1500#
+    "Name der Prozedur:",
+  p name paket =  #1501#
+    "Name des Pakets:",
+  t weiter mit taste =  #1502#
+    "*** Weiter mit Taste ***";
+
+
+PROC programme :
+
+  page; bildschirm neu;
+  BOOL CONST alter umbruch := word wrap;
+  word wrap (FALSE);
+  menue anbieten (ROW 6 TEXT : ("ELAN.Erstellen", "ELAN.Permanent",
+                  "EUDAS.Dateien", "EUDAS.Archiv", "", ""),
+                  fenster links, TRUE,
+                  PROC (INT CONST, INT CONST) prog interpreter);
+  word wrap (alter umbruch);
+  page; bildschirm neu
+
+END PROC programme;
+
+PROC prog interpreter (INT CONST menuenr, f nr) :
+
+  SELECT menuenr OF
+  CASE 0 : sperren setzen
+  CASE 1 : erstellen interpreter
+  CASE 2 : permanent interpreter
+  CASE 3 : dateiverwaltung (f nr)
+  CASE 4 : archivverwaltung (menuenr, f nr)
+  END SELECT .
+
+sperren setzen :
+  fusszeile ("", "", 35, t datum, 64);
+  fussteil (3, date) .
+
+erstellen interpreter :
+  enable stop;
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : editieren
+  CASE 2 : ausfuehren
+  CASE 3 : wiederholen
+  CASE 4 : drucken
+  CASE 5 : testinstallation
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+ggf dialogfenster loeschen :
+  IF f nr = -1 THEN dialogfenster loeschen END IF .
+
+editieren :
+  ausfuehrung (PROC (TEXT CONST) editiere);
+  dialogfenster loeschen .
+
+drucken :
+  ausfuehrung (PROC (TEXT CONST) drucke) .
+
+ausfuehren :
+  ausfuehrung (PROC (TEXT CONST) page and run);
+  dialogfenster loeschen .
+
+wiederholen :
+  page;
+  bildschirm neu;
+  runagain;
+  warten auf antwort;
+  dialogfenster loeschen .
+
+testinstallation :
+  ausfuehrung (PROC (TEXT CONST) page check on insert);
+  dialogfenster loeschen .
+
+permanent interpreter :
+  SELECT f nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : installieren
+  CASE 2 : prozedurhilfe
+  CASE 3 : pakethilfe
+  CASE 4 : alle pakete
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT .
+
+installieren :
+  ausfuehrung (PROC (TEXT CONST) page check off insert);
+  dialogfenster loeschen .
+
+prozedurhilfe :
+  TEXT VAR prozedurname := "";
+  editget (p name prozedur, prozedurname, "", "GET/prozedurname");
+  IF prozedurname <> "" THEN
+    bildschirm neu;
+    bitte warten;
+    help (prozedurname);
+    dialogfenster loeschen
+  END IF .
+
+pakethilfe :
+  prozedurname := "";
+  editget (p name paket, prozedurname, "", "GET/paketname");
+  IF prozedurname <> "" THEN
+    bildschirm neu;
+    bitte warten;
+    bulletin (prozedurname);
+    dialogfenster loeschen
+  END IF .
+
+alle pakete :
+  bildschirm neu;
+  bitte warten;
+  packets;
+  dialogfenster loeschen .
+
+END PROC prog interpreter;
+
+PROC warten auf antwort :
+
+  TEXT VAR taste;
+  line; put (t weiter mit taste);
+  inchar (taste);
+  line
+
+END PROC warten auf antwort;
+
+PROC page and run (TEXT CONST dateiname) :
+
+  bildschirm neu;
+  page; bitte warten;
+  check on;
+  run (dateiname);
+  warten auf antwort
+
+END PROC page and run;
+
+PROC page check on insert (TEXT CONST dateiname) :
+
+  bildschirm neu;
+  page; bitte warten;
+  check on;
+  insert (dateiname);
+  warten auf antwort
+
+END PROC page check on insert;
+
+PROC page check off insert (TEXT CONST dateiname) :
+
+  bildschirm neu;
+  page; bitte warten;
+  check off;
+  insert (dateiname);
+  warten auf antwort
+
+END PROC page check off insert;
+
+
+END PACKET flint;
+
+PACKET flint monitor DEFINES
+
+  monitor :
+
+
+PROC monitor :
+
+  disable stop;
+  partner task (1, myself);
+  continue (niltask);
+  flint
+
+END PROC monitor;
+
+END PACKET flint monitor;
+
diff --git a/app/flint/0.4/src/flint.init b/app/flint/0.4/src/flint.init
new file mode 100644
index 0000000..a743f52
--- /dev/null
+++ b/app/flint/0.4/src/flint.init
@@ -0,0 +1,603 @@
+% MENUE "FLINT.Standard" 
+% BILD 
+Untermenüs
+Version 0.5
+- 
+  Textverarb. 
+- 
+  Datenbank 
+- 
+  Kalkulation 
+- 
+  Grafiken 
+- 
+  ELAN
+- 
+  Steuerung 
+% FELD 1 "FLINT/1T" "tT" 
+% FELD 2 "FLINT/1D" "dD" 
+% FELD 3 "FLINT/1K" "kK" 
+% FELD 4 "FLINT/1G" "gG" 
+% FELD 5 "FLINT/1P" "eE" 
+% FELD 6 "FLINT/1S" "sS" 
+% ENDE 
+% MENUE "FLINT.Eigene" 
+% BILD 
+Eigene Fkt. 
+   
+ 
+   
+ 
+   
+ 
+   
+ 
+% FELD 1 "" "aA" 
+% FELD 2 "" "bB" 
+% FELD 3 "" "cC" 
+% FELD 4 "" "dD" 
+% ENDE 
+% MENUE "FLINT.System" 
+% BILD 
+Arbeitsbereich 
+  Wechseln 
+- 
+Übersicht 
+  Bereiche 
+  Speicher 
+- 
+Taskzustand 
+  Eigene 
+  Fremde 
+  Alle 
+- 
+Eigene Task 
+  Löschen 
+% FELD 1 "FLINT/3W" "wW" 
+% FELD 2 "FLINT/3B" "bB" 
+% FELD 3 "FLINT/3S" "sS" 
+% FELD 4 "FLINT/3E" "eE" 
+% FELD 5 "FLINT/3F" "fF" 
+% FELD 6 "FLINT/3A" "aA" 
+% FELD 7 "FLINT/3L" "lL" 
+% ENDE 
+% MENUE "TEXTE.Erstellen" 
+% BILD 
+Textdatei 
+  Eingeben 
+  Drucken 
+- 
+Formatieren 
+  Zeilenweise 
+  Seitenweise 
+  Automatik 
+% FELD 1 "TEXTE/1E" "eE" 
+% FELD 2 "TEXTE/1D" "dD" 
+% FELD 3 "TEXTE/1Z" "zZ" 
+% FELD 4 "TEXTE/1S" "sS" 
+% FELD 5 "TEXTE/1A" "aA" 
+% ENDE 
+% MENUE "TEXTE.Bearbeiten" 
+% BILD 
+Extrahieren 
+  Index 
+  Gliederung 
+- 
+Textdatei 
+  Sortieren 
+- 
+Makros 
+  Laden 
+  Anzeigen 
+- 
+Ausnahmen 
+  Erweitern 
+% FELD 1 "TEXTE/2I" "iI" 
+% FELD 2 "TEXTE/2G" "gG" 
+% FELD 3 "TEXTE/2S" "sS" 
+% FELD 4 "TEXTE/2L" "lL" 
+% FELD 5 "TEXTE/2A" "aA" 
+% FELD 6 "TEXTE/2E" "eE" 
+% ENDE 
+% MENUE "TEXTE.Einstellungen" 
+% BILD 
+Schrifttypen 
+  Typtabelle 
+  Zeige Typen 
+- 
+  Drucker 
+- 
+Silbentrennung 
+  Faktor 
+- 
+Kopf/Fuß 
+  Briefmodus 
+- 
+Fußnoten 
+  Abstand 
+% FELD 1 "TEXTE/3T" "tT" 
+% FELD 2 "TEXTE/3Z" "zZ" 
+% FELD 3 "TEXTE/3D" "dD" 
+% FELD 4 "TEXTE/3F" "fF" 
+% FELD 5 "TEXTE/3B" "bB" 
+% FELD 6 "TEXTE/3A" "aA" 
+% ENDE 
+% MENUE "ELAN.Erstellen" 
+% BILD 
+ELAN-Programm 
+  Editieren 
+  Ausführen 
+  Wiederholen 
+  Drucken 
+  Installiern
+    testweise
+% FELD 1 "PROG/1E" "eE" 
+% FELD 2 "PROG/1A" "aA" 
+% FELD 3 "PROG/1W" "wW" 
+% FELD 4 "PROG/1D" "dD" 
+% FELD 5 "PROG/1T" "iI" 
+% ENDE 
+% MENUE "ELAN.Permanent" 
+% BILD 
+Programm 
+  Installiern 
+- 
+Auskunft 
+  Einzelproz.
+  GanzesPaket
+  Paketnamen 
+% FELD 1 "PROG/2I" "iI" 
+% FELD 2 "PROG/2P" "eE" 
+% FELD 3 "PROG/2A" "gG" 
+% FELD 4 "PROG/2N" "pP" 
+% ENDE 
+% MENUE "EDIT MENUE:" 
+% BILD 
+Zeile Springen auf Zeile nach Nummer 
+Such Suchen nach Text 
+Ersetze Text suchen und ersetzen 
+WortMark Aktuelles Wort markieren 
+MarkSatz Aktuellen Satz bis Ende markieren 
+Kopiere Block kopieren oder einfügen (PUT, GET) 
+Fenster Datei in Teilfenster eröffnen 
+Breite Maximale Zeilenbreite (limit) einstellen 
+Taste Tastenbelegung abfragen und ändern 
+% FELD 1 "" "zZ" 
+% FELD 2 "" "sS" 
+% FELD 3 "" "eE" 
+% FELD 4 "" "wW" 
+% FELD 5 "" "mM" 
+% FELD 6 "" "kK" 
+% FELD 7 "" "fF" 
+% FELD 8 "" "bB" 
+% FELD 9 "" "tT" 
+% ENDE 
+% MENUE "TEXT MENUE:" 
+% BILD 
+Typ Schrifttyp einstellen (type) 
+Modifikation Schriftart für markierten Bereich festlegen (on, off) 
+Seite Neue Seite beginnen (page) 
+Raum Zwischenraum freilassen (free) 
+Einstellung Format für diese Datei einstellen 
+Formatiere Markierten Abschnitt zeilenweise formatieren 
+Drucke Markierten Abschnitt formatieren und drucken 
+% FELD 1 "" "tT" 
+% FELD 2 "" "mM" 
+% FELD 3 "" "sS" 
+% FELD 4 "" "rR" 
+% FELD 5 "" "eE" 
+% FELD 6 "" "fF" 
+% FELD 7 "" "dD" 
+% ENDE 
+% AUSWAHL "FLINT.Taskauswahl" 
+Bitte kreuzen Sie den gewünschten Bereich an. 
+% ENDE 
+% AUSWAHL "TEXT.Fontwahl" 
+Bitte Typ auswählen und ankreuzen: 
+% ENDE 
+% AUSWAHL "TEXT.Modwahl" 
+Art(en) ankreuzen: 
+% ENDE 
+% HILFE "FLINT/Allgemein" 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "FLINT1/T" 
+% SEITE 1 
+Textverarbeitung 
+- 
+Aufruf der EUMEL-Textverarbeitung mit Menü. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/1D" 
+% SEITE 1 
+EUDAS 
+- 
+Aufruf des Datenverwaltungssystems EUDAS. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/1K" 
+% SEITE 1 
+KAKTUS 
+- 
+Aufruf der Tabellenkalkulation KAKTUS. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/1G" 
+% SEITE 1 
+dgs-CHART 
+- 
+Aufruf des Geschäftsgrafikprogramms dgs-Superchart. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/1P" 
+% SEITE 1 
+Programmerstellung 
+- 
+Aufruf eines Menüs zur Programmierung in ELAN. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/1S" 
+% SEITE 1 
+Systemsteuerung 
+- 
+Aufruf eines Menüs zur Systemsteuerung (Abschalten,
+Druckersteuerung, Konfiguration usw.). 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/3B" 
+% SEITE 1 
+Übersicht Arbeitsbereiche 
+- 
+Verlassen der Übersicht mit ESC 'q'. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/3S" 
+% SEITE 1 
+Speicherbelegung 
+- 
+Anzeige des belegten Hintergrundspeichers. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/3E" 
+% SEITE 1 
+Eigener Taskzustand 
+- 
+Ausgabe des Zustands des eigenen Arbeitsbereichs. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/3F" 
+% SEITE 1 
+Fremder Taskzustand 
+- 
+Ausgabe des Zustandes eines anderen Arbeitsbereichs. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "FLINT/3A" 
+% SEITE 1 
+Taskzustand aller Bereiche 
+- 
+Verlassen mit ESC 'q'. 
+% SEITE 1 "FLINT/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/Allgemein" 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/1E" 
+% SEITE 1 
+Textdatei eingeben 
+- 
+Aufruf des Editors. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/1D" 
+% SEITE 1 
+Textdatei drucken 
+- 
+Erstellte Datei ausdrucken lassen. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/1Z" 
+% SEITE 1 
+Zeilenweise formatieren 
+- 
+Aufruf von 'lineform' oder 'autoform', je nach Einstellung. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/1S" 
+% SEITE 1 
+Seitenweise formatieren 
+- 
+Aufruf von 'pageform' oder 'autopageform', je nach
+Einstellung. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/1A" 
+% SEITE 1 
+Einstellen automatische Formatierung 
+- 
+Abfrage, ob Zeilen- bzw. Seitenformatierung automatisch oder
+interaktiv erfolgen sollen. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2I" 
+% SEITE 1 
+Index extrahieren 
+- 
+Aufruf von 'index' 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2G" 
+% SEITE 1 
+Gliederung extrahieren 
+- 
+Aufruf von 'outline' 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2S" 
+% SEITE 1 
+Textdatei sortieren 
+- 
+Aufruf von 'sort' bzw. 'lexsort'. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2L" 
+% SEITE 1 
+Makros laden 
+- 
+Aufruf von 'load macros'. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2A" 
+% SEITE 1 
+Makros anzeigen 
+- 
+Aufruf von 'list macros' 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/2E" 
+% SEITE 1 
+Ausnahmen erweitern 
+- 
+Anzeigen des Ausnahmelexikons für die Silbentrennung und
+Erfassung neuer Ausnahmen 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3T" 
+% SEITE 1 
+Schrifttypentabelle einstellen 
+- 
+Einstellen der Schrifttyptabelle für den Drucker, mit dem
+der Text ausgedruckt werden soll. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3Z" 
+% SEITE 1 
+Schrifttypen zeigen 
+- 
+Anzeige der zur Verfügung stehenden Schriften. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3D" 
+% SEITE 1 
+Drucker einstellen 
+- 
+Einstellen der Druckertask, auf der ausgedruckt werden soll. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3F" 
+% SEITE 1 
+Trennfaktor Silbentrennung 
+- 
+Setzt 'hyphenation width'. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3B" 
+% SEITE 1 
+Briefmodus Kopf/Fußzeilen 
+- 
+Erfragt ob der erste Kopf und der letzte Fuß wie in einem
+Brief unterdrückt werden sollen. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "TEXTE/3A" 
+% SEITE 1 
+Abstand Fußnoten 
+- 
+Setzt Anzahl Zeilen zwischen Text und Fußnoten. 
+% SEITE 1 "TEXTE/Allgemein" 
+% ENDE 
+% HILFE "PROG/Allgemein" 
+% SEITE 1 "EUDAS/Allgemein" 
+% ENDE 
+% HILFE "PROG/1E" 
+% SEITE 1 
+Programm editieren 
+- 
+Erstellen und Ändern im Editor. 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/1A" 
+% SEITE 1 
+Programm ausführen 
+- 
+'run' 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/1W" 
+% SEITE 1 
+Programmausführeung wiederholen 
+- 
+'runagain' 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/1D" 
+% SEITE 1 
+Programm drucken 
+- 
+'print' 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/1T" 
+% SEITE 1 
+Testinstallation 
+- 
+'insert' mit check on. 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/2I" 
+% SEITE 1 
+Programm installieren 
+- 
+'insert' mit check off 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/2P" 
+% SEITE 1 
+Übersicht Prozeduren 
+- 
+'help (TEXT)' 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/2A" 
+% SEITE 1 
+Übersicht Paket 
+- 
+'bulletin (TEXT)' 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "PROG/2N" 
+% SEITE 1 
+Übersicht Paketnamen 
+- 
+packets 
+% SEITE 1 "PROG/Allgemein" 
+% ENDE 
+% HILFE "AUSWAHL/Tasks" 
+% SEITE 1 
+Auswahl der Arbeitsbereiche 
+- 
+Den Bereich ankreuzen, in dem forgefahren werden soll. 
+% SEITE 1 "AUSWAHL/Allgemein" 
+% ENDE 
+% HILFE "GET/Taskname" 
+% SEITE 1 
+Name des Bereichs: 
+- 
+Namen des Bereichs eingeben, dessen Status abgefragt werden
+soll. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/wtaskname" 
+% SEITE 1 
+Name des Bereichs, in dem weitergemacht werden soll: 
+- 
+Existiert der Bereich noch nicht, wird er nach Anfrage
+eingerichtet. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Vatertask" 
+% SEITE 1 
+Name des Vaterbereichs: 
+- 
+Jeder Bereich muß einen Vaterbereich haben, der angibt,
+welche Programme zur Verfügung stehen. Geben Sie keinen
+Namen an, wird FLINT als der allgemeine Vater genommen. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Druckertask" 
+% SEITE 1 
+Name der Druckertask: 
+- 
+Ist normalerweise PRINTER. Die Station bei Netzbetrieb kann
+später eingegeben werden. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Druckstation" 
+% SEITE 1 
+Stationsnummer der Druckertask: 
+- 
+Bei Netzbetrieb zum Drucken auf einem anderen Rechner. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Trennfaktor" 
+% SEITE 1 
+Trennfaktor: 
+- 
+s. 'hyphenation width' 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Fussabstand" 
+% SEITE 1 
+Leerzeilen vor Fuß: 
+- 
+s. 'no empty lines before foot' 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/prozedurname" 
+% SEITE 1 
+Name der Prozedur: 
+- 
+kann auch '*' enthalten. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/paketname" 
+% SEITE 1 
+Name des Paketes: 
+- 
+Angabe des Namens eines insertierten Pakets. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "JA/Task loeschen" 
+% SEITE 1 
+Bereich verlassen und löschen ? 
+- 
+Bei Bejahen wird ein neuer Bereich erfragt und der jetzige
+Bereich nach dem Verlassen mit allen Dateien und Söhnen
+gelöscht. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/task einrichten" 
+% SEITE 1 
+Bereich neu einrichten ? 
+- 
+Bei Tippfehler oder Irrtum verneinen. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/abkoppeln" 
+% SEITE 1 
+Ganz abkoppeln ? 
+- 
+Bei Tippfehler oder Irrtum verneinen. Ansonsten weiter mit
+SV. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/lineform manuell" 
+% SEITE 1 
+Zeilen manuell formatieren ? 
+- 
+Bei Bejahen muß jede Trennung von Hand bestätigt werden. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/pageform manuell" 
+% SEITE 1 
+Seiten manuell formatieren ? 
+- 
+Bei Bejahen muß jede Seitentrennung von Hand bestätigt
+werden. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/firsthead" 
+% SEITE 1 
+Ersten Kopf unterdrücken ? 
+- 
+s. 'firsthead' 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/lastbottom" 
+% SEITE 1 
+Letzten Fuß unterdrücken ? 
+- 
+s. 'last bottom' 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+
diff --git a/app/flint/0.4/src/flint.manager b/app/flint/0.4/src/flint.manager
new file mode 100644
index 0000000..610d70f
--- /dev/null
+++ b/app/flint/0.4/src/flint.manager
@@ -0,0 +1,16 @@
+PACKET flint manager                        (* Autor: Thomas Berlage *)
+                                            (* Stand: 15.01.88       *) 
+  DEFINES
+
+  continue :
+
+
+PROC continue (TASK CONST t) :
+
+  continue (t,
+    PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) eudas manager)
+
+END PROC continue;
+
+END PACKET flint manager;
+
diff --git a/app/flint/0.4/src/isub.replace b/app/flint/0.4/src/isub.replace
new file mode 100644
index 0000000..3c48009
--- /dev/null
+++ b/app/flint/0.4/src/isub.replace
@@ -0,0 +1,19 @@
+PACKET isub replace DEFINES ISUB, replace : 
+ 
+INT OP ISUB (TEXT CONST t, INT CONST i) : 
+ 
+  INT CONST ii := i + i; 
+  code (t SUB ii - 1) + 256 * code (t SUB ii) 
+ 
+END OP ISUB; 
+ 
+PROC replace (TEXT VAR t, INT CONST i, wert) : 
+ 
+  INT CONST ii := i + i; 
+  replace (t, ii - 1, code (wert MOD 256)); 
+  replace (t, ii,  code (wert DIV 256 MOD 256)) 
+ 
+END PROC replace 
+ 
+END PACKET isub replace; 
+
diff --git a/app/flint/0.4/src/klartextbelegung b/app/flint/0.4/src/klartextbelegung
new file mode 100644
index 0000000..efe4b08
--- /dev/null
+++ b/app/flint/0.4/src/klartextbelegung
@@ -0,0 +1,304 @@
+(*************************************************************************)
+(*                                                                        *)
+(*       K L A R T E X T                                                  *)
+(*       ===============                                                  *)
+(*                                                                        *)
+(*       Tastenbelegungen im Klartext fuer Steuertasten                   *)
+(*                                                                        *)
+(*       Autor: Thomas Berlage                                            *)
+(*       Stand: 27.04.88                                                  *)
+(*       Version 1.0                                                      *)
+(*                                                                        *)
+(*       Zweck: Lernsequenzen koennen editiert werden, wobei fuer         *)
+(*              die Steuertasten symbolische Namen in spitzen             *)
+(*              Klammern verwendet werden. Folgende Namen sind            *)
+(*              zulaessig:                                                *)
+(*                                                                        *)
+(*              <hop> <links> <rechts> <oben> <unten> <tab>               *)
+(*              <rubin> <rubout> <mark> <esc>                             *)
+(*                                                                        *)
+(*       Aufruf:                                                          *)
+(*              PROC lernsequenz editieren (TEXT CONST taste)             *)
+(*                                                                        *)
+(**************************************************************************)
+PACKET case conversion                                 (* Stand: 07.02.88 *)
+
+  DEFINES
+
+  to lowercase,
+  to uppercase :
+
+
+PROC to uppercase (TEXT VAR line) :
+
+  INT VAR p := 0;
+  REP
+    p := pos (line, "a", "z", p + 1);
+    IF p = 0 THEN LEAVE to uppercase END IF;
+    replace (line, p, code (code (line SUB p) - 32))
+  END REP
+
+END PROC to uppercase;
+
+PROC to lowercase (TEXT VAR line) :
+
+  INT VAR p := 0;
+  REP
+    p := pos (line, "A", "Z", p + 1);
+    IF p = 0 THEN LEAVE to lowercase END IF;
+    replace (line, p, code (code (line SUB p) + 32))
+  END REP
+
+END PROC to lowercase;
+
+END PACKET case conversion;
+
+PACKET klartextbelegung 
+ 
+  DEFINES 
+ 
+  sieben bit modus, 
+  klartext, 
+  kodierung : 
+ 
+ 
+BOOL VAR sieben bit := TRUE; 
+ 
+ROW 33 TEXT CONST tasten := ROW 33 TEXT : ( 
+  "nul", "hop", "rechts", "oben", "-(4)", "fkt1", "fkt2", "-(7)", "links",
+  "tab", "unten", "rubin", "rubout", "return", "fkt3", "fkt4", "mark",
+  "-(17)", "-(18)", "-(19)", "-(20)", "fkt5", "fkt6", "-(23)", "fkt7",
+  "fkt8", "fkt9", "esc", "fkt10", "fkt11", "fkt12", "fkt13", "blank");
+
+LET
+  separator anfang = "<",
+  separator ende = ">";
+
+TEXT VAR ergebnis;
+
+
+BOOL PROC sieben bit modus :
+
+  sieben bit
+
+END PROC sieben bit modus;
+
+PROC sieben bit modus (BOOL CONST modus) :
+
+  sieben bit := modus
+
+END PROC sieben bit modus;
+
+TEXT PROC klartext (TEXT CONST t) :
+
+  INT VAR i;
+  ergebnis := "";
+  FOR i FROM 1 UPTO length (t) REP
+    klartext eines zeichens bestimmen
+  END REP;
+  ergebnis .
+
+klartext eines zeichens bestimmen :
+  INT CONST c := code (t SUB i);
+  IF c < 33 THEN
+    ergebnis CAT separator anfang + tasten (c + 1) + separator ende
+  ELIF c >= 127 CAND sieben bit CAND kein umlaut THEN
+    ergebnis CAT separator anfang + text (c) + separator ende
+  ELSE
+    ergebnis CAT code (c)
+  END IF .
+
+kein umlaut :
+  pos (eumel sonderzeichen, code (c)) = 0 .
+
+eumel sonderzeichen :
+  ""214""215""216""217""218""219""220""221""222""223""251""252"" .
+
+END PROC klartext;
+
+TEXT PROC kodierung (TEXT CONST t) :
+
+  INT VAR
+    sep pos := pos (t, separator anfang),
+    sep ende := 0;
+
+  enable stop;
+  ergebnis := "";
+  WHILE sep pos > 0 REP
+    text vor separator uebernehmen;
+    separiertes zeichen behandeln;
+    sep pos := pos (t, separator anfang, sep ende)
+  END REP;
+  restliche zeichen uebernehmen;
+  ergebnis .
+
+text vor separator uebernehmen :
+  ergebnis CAT subtext (t, sep ende + 1, sep pos - 1) .
+
+separiertes zeichen behandeln :
+  sep ende := pos (t, separator ende, sep pos);
+  IF sep ende = 0 THEN
+    errorstop ("""" + separator ende + """ fehlt.")
+  ELSE
+    separiertes zeichen kodieren
+  END IF .
+
+separiertes zeichen kodieren :
+  TEXT VAR bezeichnung := subtext (t, sep pos + 1, sep ende - 1);
+  change all (bezeichnung, " ", "");
+  to lowercase (bezeichnung);
+  INT VAR c := int (bezeichnung);
+  IF keine zahl THEN
+    mit tabelle vergleichen
+  END IF;
+  ergebnis CAT code (c) .
+
+keine zahl :
+  NOT last conversion ok .
+
+mit tabelle vergleichen :
+  INT VAR i;
+  FOR i FROM 1 UPTO 33 REP
+    IF bezeichnung = tasten (i) THEN
+      c := i - 1;
+      LEAVE mit tabelle vergleichen
+    END IF
+  END REP;
+  errorstop ("unbekannte Tastenbezeichnung: """ + bezeichnung + """") .
+
+restliche zeichen uebernehmen :
+  ergebnis CAT subtext (t, sep ende + 1) .
+
+END PROC kodierung;
+
+END PACKET klartextbelegung;
+
+PACKET klartext anwendung
+
+  DEFINES
+
+  klartext auf taste,
+  klartext auf taste legen,
+  klartext aus file,
+  klartext in file,
+  lernsequenz editieren :
+
+
+LET
+  separator anfang = "<",
+  separator ende = ">";
+
+TEXT VAR
+  zeile,
+  sequenz,
+  aenderung;
+
+DATASPACE VAR
+  ds;
+
+
+TEXT PROC klartext auf taste (TEXT CONST taste) :
+
+  klartext (lernsequenz auf taste (kodierung (taste)))
+
+END PROC klartext auf taste;
+
+PROC klartext auf taste legen (TEXT CONST taste, belegung) :
+
+  lernsequenz auf taste legen (kodierung (taste), kodierung (belegung))
+
+END PROC klartext auf taste legen;
+
+PROC klartext in file (FILE VAR f, TEXT CONST belegung) :
+
+  INT VAR
+    ende,
+    anfang := 1;
+
+  output (f);
+  zeile := klartext (belegung);
+  REP
+    ende der zeile bestimmen;
+    putline (f, subtext (zeile, anfang, ende - 1));
+    anfang := ende
+  UNTIL anfang > length (zeile) END REP .
+
+ende der zeile bestimmen :
+  TEXT CONST zeichen := subtext (zeile, anfang, anfang + 4);
+  IF zeichen = "<hop>" OR zeichen = "<esc>" THEN
+    ende := pos (zeile, separator anfang, anfang + 6)
+  ELSE
+    ende := pos (zeile, separator anfang, anfang + 1)
+  END IF;
+  IF ende = 0 THEN ende := length (zeile) + 1 END IF;
+  ende := min (anfang + maxlinelength (f), ende) .
+(*
+  IF (ende - anfang) > maxlinelength (f) THEN
+    ende := anfang + maxlinelength (f)
+  ELIF ende > 5 THEN
+    letzten separator bestimmen
+  END IF .
+
+letzten separator bestimmen :
+  TEXT CONST zeichen := subtext (zeile, ende - 4, ende - 2);
+  IF zeichen = "esc" OR zeichen = "hop" THEN
+    ende verschieben
+  ELSE
+    ende := pos (zeile, separator ende, ende)
+  END IF .
+
+ende verschieben :
+  IF (zeile SUB ende + 5) = separator anfang THEN
+    ende := pos (zeile, separator ende, ende + 5);
+    IF ende = 0 THEN ende := length (zeile) END IF
+  ELSE
+    ende := ende + 5
+  END IF .
+ *)
+END PROC klartext in file;
+
+PROC klartext aus file (FILE VAR f, TEXT VAR belegung) :
+
+  input (f);
+  belegung := "";
+  WHILE NOT eof (f) REP
+    getline (f, zeile);
+    IF (zeile SUB LENGTH zeile) = " " THEN
+      zeile := subtext (zeile, 1, length (zeile) - 1)
+    END IF;
+    belegung CAT kodierung (zeile)
+  END REP .
+
+END PROC klartext aus file;
+
+PROC lernsequenz editieren (TEXT CONST taste) :
+
+  disable stop;
+  ds := nilspace;
+  editieren (taste);
+  forget (ds)
+
+END PROC lernsequenz editieren;
+
+PROC editieren (TEXT CONST taste) :
+
+  enable stop;
+  FILE VAR f := sequential file (output, ds);
+  sequenz := lernsequenz auf taste (taste);
+  klartext in file (f, sequenz);
+  headline (f, "Tastenbelegung");
+  edit (f);
+  klartext aus file (f, aenderung);
+  IF aenderung <> sequenz CAND wirklich aendern THEN
+    lernsequenz auf taste legen (taste, aenderung)
+  END IF .
+
+wirklich aendern :
+  yes ("Lernsequenz aendern") .
+
+END PROC editieren;
+
+END PACKET klartext anwendung;
+
+
+
diff --git a/app/flint/0.4/src/offline.1 b/app/flint/0.4/src/offline.1
new file mode 100644
index 0000000..0e3e097
--- /dev/null
+++ b/app/flint/0.4/src/offline.1
@@ -0,0 +1,5 @@
+PACKETofflinemanagerDEFINESbegin,deferredend,owntaskpassword,continuedfrom,continue,partnertask:LETb0=0,c0=1,d0=2,e0=5,f0=6,g0=4,h0=9,i0=100,j0=199;LETk0="Taskname ungültig",l0="Vater antwortet nicht",m0="Zieltask kann nicht direkt angekoppelt werden",n0="Passwort:",o0="Falsches Passwort",p0="Ankoppeln nur für Partnertasks",q0="Nur Partner können angekoppelt werden";BOOL VARr0:=FALSE,s0:=FALSE;TEXT VARt0:="";DATASPACE VARu0:=nilspace;INT VARv0,w0,x0,y0,z0;BOUND TEXT VARa1;BOUND STRUCT(TEXTb1,c1,TASKtask,PROCAd1)VARe1;TASK VARf1,g1:=niltask;ROW4TASK VARh1;INITFLAG VARi1;PROCbegin(TEXT CONSTj1,k1):enablestop;l1;IFj1="-"THENerrorstop(k0)END IF;m1;IFv0=h0THENe1:=u0;n1;call(task(k1),g0,u0,v0)END IF;IFv0=b0THEN TASK CONSTo1:=task(j1);forget(u0);p1ELIFv0=d0THENa1:=u0;disablestop;errorstop(CONCR(a1));forget(u0)ELSEforget(u0)END IF.m1:INT VARq1;forget(u0);u0:=nilspace;e1:=u0;CONCR(e1).b1:=j1;CONCR(e1).c1:="";FORq1FROM1UPTO5REPpingpong(task(k1),g0,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END 
+REP;IFv0=-2THENerrorstop(l0)END IF.n1:dialog(n0);getsecretline(CONCR(e1).c1);covertracks.p1:WHILEstatus(o1)<>2REPpause(10)END REP.END PROCbegin;PROCdeferredend:s0:=TRUE END PROCdeferredend;PROCowntaskpassword(TEXT CONSTword):t0:=length(t0)*" ";t0:=word;covertracksEND PROCowntaskpassword;TASK PROCcontinuedfrom:g1END PROCcontinuedfrom;PROCr1(TASK CONSTs1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1):enablestop;IFisniltask(s1)THENbreak;disablestopELSEu1END IF;v1;WHILE NOTonlineREPw1;x1;y1END REP;z1.u1:INT CONSTa2:=channel;b2;break(quiet);c2.b2:INT VARq1;forget(u0);u0:=nilspace;FORq1FROM1UPTO5REPpingpong(s1,j0,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END REP;d2;IFv0=f0THENe2ELIFv0=b0THENf2ELSEerrorstop(m0)END IF.d2:forget(u0);u0:=nilspace;a1:=u0.e2:dialog(n0);getsecretline(CONCR(a1));covertracks.f2:CONCR(a1):="".c2:FORq1FROM1UPTO5REPpingpong(s1,i0+a2,u0,v0);IFv0=-2THENpause(5)END IF UNTILv0<>-2END REP;disablestop;forget(u0);IFv0<>b0THENcontinue(a2)END IF.v1:IFs0OR(r0CAND NOT
+exists(h1(1)))THENend(myself)END IF.w1:TEXT VARg2;IFiserrorTHENg2:=errormessage;clearerrorELSEg2:=""END IF.x1:setautonom;commanddialogue(FALSE);INT VARh2:=heapsize;g1:=niltask.y1:DATASPACE VARi2:=nilspace;REPwait(i2,w0,f1);IFw0<>e0THENj2;k2ELIFf1=g1THENl2;t1(i2,w0,z0,f1)ELSEm2END IF;n2;o2END REP.j2:z0:=1;y0:=w0;g1:=f1.l2:z0INCR1;w0:=y0.m2:forget(i2);i2:=nilspace;send(f1,c0,i2).n2:IFiserrorTHENforget(i2);i2:=nilspace;a1:=i2;CONCR(a1):=errormessage;clearerror;send(f1,d0,i2)END IF.o2:IFheapsize>h2+8THENcollectheapgarbage;h2:=heapsizeEND IF.k2:IFw0=j0THENp2ELIFw0>i0ANDw0<i0+16THENq2ELSEt1(i2,w0,z0,f1)END IF.p2:IFr2THENsend(f1,f0,i2)ELSEsend(f1,b0,i2)END IF.r2:t0<>"".q2:s2;t2;call(supervisor,w0,i2,v0);IF NOT(f1=supervisor)THENsend(f1,v0,i2)END IF;IFv0=b0THENforget(i2);LEAVEy1END IF.s2:IFr0CAND NOTu2(f1)ORx0>0CANDw0-i0<>x0THENerrorstop(p0);LEAVEq2END IF.t2:IF NOT(f1=supervisor)THENa1:=i2;IF CONCR(a1)<>t0THENerrorstop(o0);LEAVEq2END IF END IF.z1:IFg2<>""THENerrorstop(g2)END IF;commanddialogue
+(TRUE).END PROCr1;PROCcontinue(TASK CONSTs1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1):enablestop;l1;x0:=0;IFs1=myselfTHEN ELIFr0THEN IF NOTu2(s1)THENerrorstop(q0)END IF ELIFu2(s1)THENx0:=channelEND IF;r1(s1,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)t1)END PROCcontinue;BOOL PROCu2(TASK CONSTs1):NOTisniltask(s1)CAND(s1=h1(1)ORs1=h1(2)ORs1=h1(3)ORs1=h1(4))END PROCu2;TASK PROCpartnertask(INT CONSTindex):l1;h1(index)END PROCpartnertask;PROCpartnertask(INT CONSTindex,TASK CONSTs1):l1;h1(index):=s1;IFindex=1CAND NOT(s1=myself)THENr0:=TRUE END IF END PROCpartnertask;PROCl1:IF NOTinitialized(i1)THENv2END IF.v2:h1(1):=niltask;h1(2):=niltask;h1(3):=niltask;h1(4):=niltask.END PROCl1;END PACKETofflinemanager;
+
diff --git a/app/flint/0.4/src/offline.manager b/app/flint/0.4/src/offline.manager
new file mode 100644
index 0000000..7f97421
--- /dev/null
+++ b/app/flint/0.4/src/offline.manager
@@ -0,0 +1,383 @@
+PACKET offline manager                        (* Autor: Thomas Berlage *)
+                                              (* Stand: 20.01.88       *)
+  DEFINES
+
+  begin,
+  deferred end,
+  own task password,
+  continued from,
+  continue,
+  partner task :
+
+
+LET
+  ack               = 0,
+  nak               = 1,
+  error nak         = 2,
+  second phase ack  = 5,
+  password ack      = 6,
+
+  begin code        = 4,
+  password code     = 9,
+
+  continue code         = 100,
+  ask for password code = 199;
+
+LET
+  taskname invalid =
+    "Taskname ungültig",
+  task not ready =
+    "Vater antwortet nicht",
+  direct continue impossible =
+    "Zieltask kann nicht direkt angekoppelt werden",
+  t password =
+    "Passwort:",
+  t wrong password =
+    "Falsches Passwort",
+  order task no partner =
+    "Ankoppeln nur für Partnertasks",
+  continue not partner =
+    "Nur Partner können angekoppelt werden";
+
+
+BOOL VAR
+  controlled mode := FALSE,
+  end myself := FALSE;
+
+TEXT VAR
+  own password := "";
+
+DATASPACE VAR ds := nilspace;
+
+INT VAR
+  reply,
+  order,
+  control channel,
+  last order,
+  phase number;
+
+BOUND TEXT VAR reply message;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg;
+
+TASK VAR
+  order task,
+  last order task := niltask;
+
+ROW 4 TASK VAR pt;
+
+INITFLAG VAR pt init;
+
+
+
+PROC begin (TEXT CONST task name, father name) :
+
+  enable stop;
+  init partner;
+  IF task name = "-" THEN
+    errorstop (taskname invalid)
+  END IF;
+  call begin code;
+  IF reply = password code THEN
+    sv msg := ds;
+    get password;
+    call (task (father name), begin code, ds, reply)
+  END IF;
+  IF reply = ack THEN
+    TASK CONST new task := task (task name);
+    forget (ds);
+    wait for init
+  ELIF reply = error nak THEN
+    reply message := ds;
+    disable stop;
+    errorstop (CONCR (reply message));
+    forget (ds)
+  ELSE
+    forget (ds)
+  END IF .
+
+call begin code :
+  INT VAR i;
+  forget (ds); ds := nilspace;
+  sv msg := ds;
+  CONCR (sv msg). tname := task name;
+  CONCR (sv msg). tpass := "";
+  FOR i FROM 1 UPTO 5 REP
+    pingpong (task (father name), begin code, ds, reply);
+    IF reply = -2 THEN pause (5) END IF
+  UNTIL reply <> -2 END REP;
+  IF reply = -2 THEN
+    errorstop (task not ready)
+  END IF .
+
+get password :
+  dialog (t password);
+  get secret line (CONCR (sv msg). tpass);
+  cover tracks .
+
+wait for init :
+  WHILE status (new task) <> 2 REP pause (10) END REP .
+
+END PROC begin;
+
+PROC deferred end :
+
+  end myself := TRUE
+
+END PROC deferred end;
+
+PROC own task password (TEXT CONST word) :
+
+  own password := length (own password) * " ";
+  own password := word;
+  cover tracks
+
+END PROC own task password;
+
+TASK PROC continued from :
+
+  last order task
+
+END PROC continued from;
+
+PROC i continue (TASK CONST t,
+     PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager) :
+
+  enable stop;
+  IF is niltask (t) THEN
+    break;
+    disable stop
+  ELSE
+    ask for continue
+  END IF;
+  end if required;
+  WHILE NOT online REP
+    remember error message;
+    prepare manager;
+    wait for order
+  END REP;
+  repeat error message .
+
+ask for continue :
+  INT CONST my channel := channel;
+  ask if password required;
+  break (quiet);
+  send continue request .
+
+ask if password required :
+  INT VAR i;
+  forget (ds); ds := nilspace;
+  FOR i FROM 1 UPTO 5 REP
+    pingpong (t, ask for password code, ds, reply);
+    IF reply = -2 THEN pause (5) END IF
+  UNTIL reply <> -2 END REP;
+  init password ds;
+  IF reply = password ack THEN
+    get password from user
+  ELIF reply = ack THEN
+    set password empty
+  ELSE
+    errorstop (direct continue impossible)
+  END IF .
+
+init password ds :
+  forget (ds);
+  ds := nilspace;
+  reply message := ds .
+
+get password from user :
+  dialog (t password);
+  get secret line (CONCR (reply message));
+  cover tracks .
+
+set password empty :
+  CONCR (reply message) := "" .
+
+send continue request :
+  FOR i FROM 1 UPTO 5 REP
+    pingpong (t, continue code + my channel, ds, reply);
+    IF reply = -2 THEN pause (5) END IF
+  UNTIL reply <> -2 END REP;
+  disable stop;
+  forget (ds);
+  IF reply <> ack THEN
+    continue (my channel)
+  END IF .
+
+end if required :
+  IF end myself OR (controlled mode CAND NOT exists (pt (1))) THEN
+    end (myself)
+  END IF .
+
+remember error message :
+  TEXT VAR stored error;
+  IF is error THEN
+    stored error := error message;
+    clear error
+  ELSE
+    stored error := ""
+  END IF .
+
+prepare manager :
+  set autonom;
+  command dialogue (FALSE);
+  INT VAR old heap size := heap size;
+  last order task := niltask .
+
+wait for order :
+  DATASPACE VAR local ds := nilspace;
+  REP
+    wait (local ds, order, order task);
+    IF order <> second phase ack THEN
+      prepare first phase;
+      manager with end check
+    ELIF order task = last order task THEN
+      prepare second phase;
+      manager (local ds, order, phase number, order task)
+    ELSE
+      send nak
+    END IF;
+    send error if necessary;
+    collect heap garbage if necessary
+  END REP .
+
+prepare first phase :
+  phase number := 1;
+  last order := order;
+  last order task := order task .
+
+prepare second phase :
+  phase number INCR 1;
+  order := last order .
+
+send nak :
+  forget (local ds);
+  local ds := nilspace;
+  send (order task, nak, local ds) .
+
+send error if necessary :
+  IF is error THEN
+    forget (local ds);
+    local ds := nilspace;
+    reply message := local ds;
+    CONCR (reply message) := error message;
+    clear error;
+    send (order task, error nak, local ds)
+  END IF .
+
+collect heap garbage if necessary :
+  IF heap size > old heap size + 8 THEN
+    collect heap garbage;
+    old heap size := heap size
+  END IF .
+
+manager with end check :
+  IF order = ask for password code THEN
+    answer if password required
+  ELIF order > continue code AND order < continue code + 16 THEN
+    try continue channel
+  ELSE
+    manager (local ds, order, phase number, order task)
+  END IF .
+
+answer if password required :
+  IF password required THEN
+    send (order task, password ack, local ds)
+  ELSE
+    send (order task, ack, local ds)
+  END IF .
+
+password required :
+  own password <> "" .
+
+try continue channel :
+  check control;
+  check password;
+  call (supervisor, order, local ds, reply);
+  IF NOT (order task = supervisor) THEN
+    send (order task, reply, local ds)
+  END IF;
+  IF reply = ack THEN
+    forget (local ds);
+    LEAVE wait for order
+  END IF .
+
+check control :
+  IF controlled mode CAND NOT is partner (order task) OR
+       control channel > 0 CAND order - continue code <> control channel THEN
+    errorstop (order task no partner);
+    LEAVE try continue channel
+  END IF .
+
+check password :
+  IF NOT (order task = supervisor) THEN
+    reply message := local ds;
+    IF CONCR (reply message) <> own password THEN
+      errorstop (t wrong password);
+      LEAVE try continue channel
+    END IF
+  END IF .
+
+repeat error message :
+  IF stored error <> "" THEN errorstop (stored error) END IF;
+  command dialogue (TRUE) .
+
+END PROC i continue;
+
+PROC continue (TASK CONST t,
+     PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager) :
+
+  enable stop;
+  init partner;
+  control channel := 0;
+  IF t = myself THEN
+    (* do nothing *)
+  ELIF controlled mode THEN
+    IF NOT is partner (t) THEN errorstop (continue not partner) END IF
+  ELIF is partner (t) THEN
+    control channel := channel
+  END IF;
+  i continue (t,
+      PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) manager)
+
+END PROC continue;
+
+BOOL PROC is partner (TASK CONST t) :
+
+  NOT is niltask (t) CAND
+    (t = pt (1) OR t = pt (2) OR t = pt (3) OR t = pt (4))
+
+END PROC is partner;
+
+TASK PROC partner task (INT CONST index) :
+
+  init partner;
+  pt (index)
+
+END PROC partner task;
+
+PROC partner task (INT CONST index, TASK CONST t) :
+
+  init partner;
+  pt (index) := t;
+  IF index = 1 CAND NOT (t = myself) THEN
+    controlled mode := TRUE
+  END IF
+
+END PROC partner task;
+
+PROC init partner :
+
+  IF NOT initialized (pt init) THEN
+    do init
+  END IF .
+
+do init :
+  pt (1) := niltask; pt (2) := niltask;
+  pt (3) := niltask; pt (4) := niltask .
+
+END PROC init partner;
+
+
+END PACKET offline manager;
+
diff --git a/app/flint/0.4/src/operator b/app/flint/0.4/src/operator
new file mode 100644
index 0000000..029b32c
--- /dev/null
+++ b/app/flint/0.4/src/operator
@@ -0,0 +1,381 @@
+PACKET operator DEFINES                       (* Autor: Thomas Berlage *)
+                                              (* Stand: 15.01.88       *)
+  operator : 
+ 
+ 
+ 
+LET
+  p neuer taskname =  #2001#
+    "Weitermachen in Bereich:",
+  p name vater =  #2002#
+    "Unter welchem Vater:",
+  t bereich =  #2003#
+    ""15"Bereich "14"",
+  t datum =  #2004#
+    ""15"Datum "14"",
+  f ganz abkoppeln =  #2005#
+    "Arbeitsbereich ganz abkoppeln",
+  f arbeitsbereich neu einrichten =  #2006#
+    "Arbeitsbereich existiert nicht. Neu einrichten",
+  f trotzdem abschalten =  #2007#
+    "Nicht auf Terminal 1. Trotzdem abschalten",
+  kb von =  #2008#
+    " KB von ",
+  sind belegt =  #2009#
+    " KB sind belegt.",
+  p taskname =  #2010#
+    "Name des Arbeitsbereichs:",
+  existiert nicht als task =  #2011#
+    " ist kein Name eines Bereiches",
+  t loeschen =  #2012#
+    " löschen",
+  t speicher =  #2013#
+    "Speicher:",
+  t cpu zeit =  #2014#
+    " KB      CPU-Zeit : ",
+  t zustand =  #2015#
+    "Zustand :  ",
+  t prio =  #2016#
+    "      Priorität: ",
+  t kanal =  #2017#
+    "      Kanal: ",
+  t busy =  #2018#
+    "Arbeit",
+  t io =  #2019#
+    "EinAus",
+  t wait =  #2020#
+    "Warten",
+  t busy blocked =  #2021#
+    "B(Arb)",
+  t io blocked =  #2022#
+    "B(E/A)",
+  t wait blocked =  #2023#
+    "B(Wrt)",
+  t dead =  #2024#
+    ">>TOT<",
+  t gestoppt =  #2025#
+    "Druckertreiber gestoppt.",
+  t gestartet =  #2026#
+    "Druckertreiber gestartet.",
+  t angehalten =  #2027#
+    "Druckertreiber angehalten.",
+  f auf anhalten warten =  #2028#
+    "Auf Anhalten des Treibers warten",
+  t drucker =  #2029#
+    ""15"Drucker "14"",
+  p neuer printer =  #2030#
+    "Welche Druckertask soll eingestellt werden:",
+  t bitte warten =  #2031#
+    "Bitte warten .. ";
+
+
+FENSTER VAR links, rechts;
+fenster initialisieren (links);;
+fenstergroesse setzen (links, 1, 2, 16, 22);
+fenster initialisieren (rechts);
+fenstergroesse setzen (rechts, 17, 2, 63, 22);
+dialogfenster (rechts);
+
+TEXT VAR
+  druckertask := "PRINTER";
+
+
+PROC operator : 
+ 
+  TASK VAR letzte task;
+  TEXT VAR neuer name := "";
+  continue (niltask); 
+  REP 
+    letzte task := continued from;
+    page; bildschirm neu;
+    disable stop;
+    operatormenue; 
+    umschalten auf letzte task
+  END REP .
+
+operatormenue :
+  menue anbieten (ROW 6 TEXT :
+    ("OPERATOR.Abschalten", "OPERATOR.Systemzustand", "OPERATOR.Drucker",
+     "OPERATOR.Netz", "OPERATOR.Konfiguration", ""),
+     links, TRUE, PROC (INT CONST, INT CONST) op interpreter) .
+
+umschalten auf letzte task :
+  BOOL VAR first try;
+  IF exists (letzte task) CAND NOT (letzte task = supervisor) THEN
+    first try := TRUE;
+    continue (letzte task)
+  ELSE
+    first try := FALSE
+  END IF;
+  IF is error OR NOT first try THEN
+    REP
+      IF is error THEN fehler ausgeben END IF;
+      nach neuer task fragen;
+      zurueck in task
+    UNTIL NOT is error END REP
+  END IF .
+
+nach neuer task fragen :
+  REP
+    editget (p neuer taskname, neuer name, "", "GET/neuer taskname");
+  UNTIL taskname akzeptiert END REP .
+
+taskname akzeptiert :
+  IF neuer name = "" THEN
+    ganz abkoppeln
+  ELSE
+    exists task (neuer name) COR neu einrichten
+  END IF .
+
+zurueck in task :
+  IF neuer name = "" THEN
+    continue (niltask)
+  ELIF exists task (neuer name) THEN
+    continue (task (neuer name))
+  ELSE
+    TEXT VAR vater := "";
+    editget (p name vater, vater, "", "GET/name vatertask");
+    begin (neuer name, vater);
+    continue (task (neuer name))
+  END IF .
+
+ganz abkoppeln :
+  ja (f ganz abkoppeln, "JA/ganz") .
+
+neu einrichten :
+  ja (f arbeitsbereich neu einrichten, "JA/task einrichten") .
+
+END PROC operator;
+
+PROC op interpreter (INT CONST menue nr, f nr) :
+
+  enable stop;
+  SELECT menuenr OF
+  CASE 0 : sperren setzen
+  CASE 1 : abschalten inter
+  CASE 2 : systemzustand inter
+  CASE 3 : drucker inter
+  CASE 4 : netz inter
+  CASE 5 : konfiguration inter
+  END SELECT;
+  IF f nr = -1 THEN dialogfenster loeschen END IF .
+
+sperren setzen :
+  fusszeile (t bereich, "", 35, t datum, 64);
+  fussteil (1, name (myself));
+  fussteil (3, date) .
+
+abschalten inter :
+  SELECT f nr OF
+  CASE 1 : abschalten
+  CASE 2 : (* nach DOS *) ni
+  CASE 3 : page; bildschirm neu; set date; dialogfenster loeschen
+  CASE 4 : page; bildschirm neu; save system
+  END SELECT .
+
+abschalten :
+  IF channel = 1 COR trotzdem abschalten THEN
+    page;
+    cursor (20, 11); out (t bitte warten);
+    cursor (20, 13);
+    shutup;
+    fenster veraendert (links);
+    push (""27"q")
+  END IF .
+
+trotzdem abschalten :
+  ja (f trotzdem abschalten, "JA/trotz shutup") .
+
+systemzustand inter :
+  SELECT f nr OF
+  CASE 1 : bereichsuebersicht
+  CASE 2 : speicherbelegung
+  CASE 3 : fremder taskstatus
+  CASE 4 : zustandsuebersicht
+  CASE 5 : task loeschen
+  END SELECT .
+
+bereichsuebersicht :
+  bitte warten;
+  disable stop;
+  DATASPACE VAR list ds := nilspace;
+  FILE VAR f := sequential file (output, list ds);
+  task info (1, f);
+  IF NOT is error THEN
+    show (f); bildschirm neu
+  END IF;
+  forget (list ds);
+  enable stop;
+  dialogfenster loeschen .
+
+speicherbelegung :
+  INT VAR size, used;
+  storage (size, used);
+  size := int (real (size + 24) * 64.0 / 63.0);
+  dialog (text (used) + kb von + text (size) + sind belegt) .
+
+fremder taskstatus :
+  TEXT VAR taskname := "";
+  editget (p taskname, taskname, "GET/Taskname", "");
+  TASK VAR status task := task (task name);
+  IF exists (status task) THEN
+    task zustand (status task)
+  ELSE
+    errorstop ("""" + taskname + """" + existiert nicht als task)
+  END IF .
+
+zustandsuebersicht :
+  bitte warten; task info (3); bildschirm neu; dialogfenster loeschen .
+
+task loeschen :
+  taskname := "";
+  editget (p taskname, taskname, "GET/Taskname", "");
+  IF ja ("""" + taskname + """" + t loeschen,
+         "JA/Task loeschen", FALSE) THEN
+    end (task (taskname))
+  END IF . 
+ 
+drucker inter :
+  SELECT f nr OF
+  CASE 0 : druckertask in fuss
+  CASE 1 : start (task (druckertask)); dialog (t gestartet)
+  CASE 2 : stop (task (druckertask)); dialog (t gestoppt)
+  CASE 3 : halt kommando
+  CASE 4 : list (task (druckertask)); bildschirm neu; dialogfenster loeschen
+  CASE 5 : first (task (druckertask))
+  CASE 6 : killer (task (druckertask))
+  CASE 7 : druckertask setzen
+  OTHERWISE ggf druckertask aus fuss
+  END SELECT .
+
+druckertask in fuss :
+  fussteil (2, t drucker, druckertask) .
+
+halt kommando :
+  IF ja (f auf anhalten warten, "JA/halt warten", FALSE) THEN
+    wait for halt (task (druckertask))
+  ELSE
+    halt (task (druckertask))
+  END IF;
+  dialog (t angehalten) .
+
+druckertask setzen :
+  TEXT VAR neuer printer := druckertask;
+  editget (p neuer printer, neuer printer, "", "GET/neuer printer");
+  TASK CONST dummy := task (neuer printer);
+  druckertask := neuer printer;
+  fussteil (2, druckertask) .
+
+ggf druckertask aus fuss :
+  IF f nr = -1 THEN
+    fussteil (2, "", "")
+  END IF .
+
+netz inter :
+  SELECT f nr OF
+  CASE 1 : (* start *) ni
+  CASE 2 : (* stop *) ni
+  CASE 3 : (* zustand *) ni
+  CASE 4 : (* list (net.io) *) ni
+  END SELECT .
+
+konfiguration inter :
+  SELECT f nr OF
+  CASE 1 : konfigurieren
+  CASE 2 : (* drucker installieren *) ni
+  CASE 3 : (* netz installieren *) ni
+  CASE 4 : (* anwendung installieren *) ni
+  CASE 5 : (* systemprogramm installieren *) ni
+  END SELECT .
+
+konfigurieren :
+  THESAURUS VAR conf := ALL /"configurator";
+  page; bildschirm neu;
+  forget quiet (conf);
+  fetch (conf, /"configurator");
+  configurate;
+  line;
+  save ("configuration", /"configurator");
+  forget quiet (conf);
+  dialogfenster loeschen .
+
+END PROC op interpreter;
+
+PROC task zustand (TASK CONST status task) :
+
+  dialog (t speicher + speicher + t cpu zeit + cpu zeit);
+  out (t zustand); out status; out (t prio); out prio;
+  out (t kanal); out kanal .
+
+speicher :
+  text (storage (status task), 5) .
+
+cpu zeit :
+  disable stop;
+  TEXT VAR result := subtext (time (clock (status task), 12), 1, 10);
+  IF is error THEN
+    clear error; result := "**********"
+  END IF;
+  result .
+
+out status :
+  SELECT status (status task) OF
+  CASE 0 : out (t busy)
+  CASE 1 : out (t io)
+  CASE 2 : out (t wait)
+  CASE 4 : out (t busy blocked)
+  CASE 5 : out (t io blocked)
+  CASE 6 : out (t wait blocked)
+  OTHERWISE out (t dead)
+  END SELECT .
+
+out prio :
+  out (text (pcb (status task, 6))) .
+
+out kanal :
+  IF channel (status task) = 0 THEN
+    out (" -")
+  ELSE
+    out (text (channel (status task), 2))
+  END IF .
+
+END PROC task zustand;
+
+PROC forget quiet (TEXT CONST datei) :
+  forget (datei, quiet)
+END PROC forget quiet;
+
+PROC forget quiet (THESAURUS CONST t) :
+  do (PROC (TEXT CONST) forget quiet, t)
+END PROC forget quiet;
+
+PROC bitte warten :
+
+  cursor (1, 1);
+  out (t bitte warten);
+  out (""5"")
+
+END PROC bitte warten;
+
+PROC ni :
+
+  dialog ("Zur Zeit nicht implementiert.")
+
+END PROC ni;
+
+END PACKET operator;
+
+PACKET operator monitor
+
+  DEFINES
+
+  monitor :
+
+
+PROC monitor :
+  disable stop;
+  operator
+END PROC monitor;
+
+END PACKET operator monitor;
+
diff --git a/app/flint/0.4/src/operator.1 b/app/flint/0.4/src/operator.1
new file mode 100644
index 0000000..b2235b2
--- /dev/null
+++ b/app/flint/0.4/src/operator.1
@@ -0,0 +1,39 @@
+PACKEToperatormanagerDEFINESoperatormanager,continue:LETb0="Nur für Systemtasks zugelassen";PROCoperatormanager(DATASPACE VARc0,INT CONSTd0,e0,TASK CONSTf0):enablestop;IFf0=supervisorORf0<supervisorTHENmenuemanager(c0,d0,e0,f0)ELSEerrorstop(b0)END IF END PROCoperatormanager;PROCcontinue(TASK CONSTg0):continue(g0,PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)operatormanager)END PROCcontinue;END PACKEToperatormanager;
+PACKETspoolcmdDEFINESkiller,first,start,stop,halt,waitforhalt:LETb0=2,c0=23,d0=24,e0=25,f0=26,g0=27,h0=28,i0=29;DATASPACE VARj0;BOUND STRUCT(TEXTk0,INTindex)VARl0;BOUND TEXT VARm0;INT VARn0;INITFLAG VARo0:=FALSE;PROCp0(TASK CONSTq0,INT CONSTr0,TEXT CONSTs0,BOOL CONSTt0):enablestop;u0;WHILEv0REP IFw0THENx0FI PER;.u0:IF NOTinitialized(o0)THENj0:=nilspaceFI;forget(j0);j0:=nilspace;l0:=j0;l0.k0:="";l0.index:=0;.v0:call(q0,c0,j0,n0);IFn0=b0THENm0:=j0;errorstop(m0);FI;l0.index<>0.w0:ja(l0.k0+s0,"JA/spool control",t0).x0:call(q0,r0,j0,n0);IFn0=b0THENm0:=j0;errorstop(m0);FI;IFt0THEN LEAVEp0FI;END PROCp0;PROCkiller(TASK CONSTq0):p0(q0,d0," loeschen",FALSE)END PROCkiller;PROCfirst(TASK CONSTq0):p0(q0,e0," als erstes",TRUE)END PROCfirst;PROCstart(TASK CONSTq0):call(g0,"",q0);call(f0,"",q0);END PROCstart;PROCstop(TASK CONSTq0):call(g0,"",q0);END PROCstop;PROChalt(TASK CONSTq0):call(h0,"",q0);END PROChalt;PROCwaitforhalt(TASK CONSTq0):call(i0,"",q0);END PROCwaitforhalt;END PACKETspoolcmd;
+PACKEToperatorDEFINESoperator:LETb0=
+#2001#"Weitermachen in Bereich:",c0=
+#2002#"Unter welchem Vater:",d0=
+#2003#""15"Bereich "14"",e0=
+#2004#""15"Datum "14"",f0=
+#2005#"Arbeitsbereich ganz abkoppeln",g0=
+#2006#"Arbeitsbereich existiert nicht. Neu einrichten",h0=
+#2007#"Nicht auf Terminal 1. Trotzdem abschalten",i0=
+#2008#" KB von ",j0=
+#2009#" KB sind belegt.",k0=
+#2010#"Name des Arbeitsbereichs:",l0=
+#2011#" ist kein Name eines Bereiches",m0=
+#2012#" löschen",n0=
+#2013#"Speicher:",o0=
+#2014#" KB      CPU-Zeit : ",p0=
+#2015#"Zustand :  ",q0=
+#2016#"      Priorität: ",r0=
+#2017#"      Kanal: ",s0=
+#2018#"Arbeit",t0=
+#2019#"EinAus",u0=
+#2020#"Warten",v0=
+#2021#"B(Arb)",w0=
+#2022#"B(E/A)",x0=
+#2023#"B(Wrt)",y0=
+#2024#">>TOT<",z0=
+#2025#"Druckertreiber gestoppt.",a1=
+#2026#"Druckertreiber gestartet.",b1=
+#2027#"Druckertreiber angehalten.",c1=
+#2028#"Auf Anhalten des Treibers warten",d1=
+#2029#""15"Drucker "14"",e1=
+#2030#"Welche Druckertask soll eingestellt werden:",f1=
+#2031#"Bitte warten .. ";
+FENSTER VARg1,h1;fensterinitialisieren(g1);;fenstergroessesetzen(g1,1,2,16,22);fensterinitialisieren(h1);fenstergroessesetzen(h1,17,2,63,22);dialogfenster(h1);TEXT VARi1:="PRINTER";PROCoperator:TASK VARj1;TEXT VARk1:="";continue(niltask);REPj1:=continuedfrom;page;bildschirmneu;disablestop;l1;m1END REP.l1:menueanbieten(ROW6TEXT:("OPERATOR.Abschalten","OPERATOR.Systemzustand","OPERATOR.Drucker","OPERATOR.Netz","OPERATOR.Konfiguration",""),g1,TRUE,PROC(INT CONST,INT CONST)n1).m1:BOOL VARo1;IFexists(j1)CAND NOT(j1=supervisor)THENo1:=TRUE;continue(j1)ELSEo1:=FALSE END IF;IFiserrorOR NOTo1THEN REP IFiserrorTHENfehlerausgebenEND IF;p1;q1UNTIL NOTiserrorEND REP END IF.p1:REPeditget(b0,k1,"","GET/neuer taskname");UNTILr1END REP.r1:IFk1=""THENs1ELSEexiststask(k1)CORt1END IF.q1:IFk1=""THENcontinue(niltask)ELIFexiststask(k1)THENcontinue(task(k1))ELSE TEXT VARu1:="";editget(c0,u1,"","GET/name vatertask");begin(k1,u1);continue(task(k1))END IF.s1:ja(f0,"JA/ganz").t1:ja(g0,"JA/task einrichten").END 
+PROCoperator;PROCn1(INT CONSTv1,w1):enablestop;SELECTv1OF CASE0:x1CASE1:y1CASE2:z1CASE3:a2CASE4:b2CASE5:c2END SELECT;IFw1=-1THENdialogfensterloeschenEND IF.x1:fusszeile(d0,"",35,e0,64);fussteil(1,name(myself));fussteil(3,date).y1:SELECTw1OF CASE1:d2CASE2:e2CASE3:page;bildschirmneu;setdate;dialogfensterloeschenCASE4:page;bildschirmneu;savesystemEND SELECT.d2:IFchannel=1CORf2THENpage;cursor(20,11);out(f1);cursor(20,13);shutup;fensterveraendert(g1);push(""27"q")END IF.f2:ja(h0,"JA/trotz shutup").z1:SELECTw1OF CASE1:g2CASE2:h2CASE3:i2CASE4:j2CASE5:k2END SELECT.g2:bittewarten;disablestop;DATASPACE VARl2:=nilspace;FILE VARf:=sequentialfile(output,l2);taskinfo(1,f);IF NOTiserrorTHENshow(f);bildschirmneuEND IF;forget(l2);enablestop;dialogfensterloeschen.h2:INT VARm2,n2;storage(m2,n2);m2:=int(real(m2+24)*64.0/63.0);dialog(text(n2)+i0+text(m2)+j0).i2:TEXT VARo2:="";editget(k0,o2,"GET/Taskname","");TASK VARp2:=task(o2);IFexists(p2)THENq2(p2)ELSEerrorstop(""""+o2+""""+l0)END IF.j2:bittewarten;
+taskinfo(3);bildschirmneu;dialogfensterloeschen.k2:o2:="";editget(k0,o2,"GET/Taskname","");IFja(""""+o2+""""+m0,"JA/Task loeschen",FALSE)THENend(task(o2))END IF.a2:SELECTw1OF CASE0:r2CASE1:start(task(i1));dialog(a1)CASE2:stop(task(i1));dialog(z0)CASE3:s2CASE4:list(task(i1));bildschirmneu;dialogfensterloeschenCASE5:first(task(i1))CASE6:killer(task(i1))CASE7:t2OTHERWISEu2END SELECT.r2:fussteil(2,d1,i1).s2:IFja(c1,"JA/halt warten",FALSE)THENwaitforhalt(task(i1))ELSEhalt(task(i1))END IF;dialog(b1).t2:TEXT VARv2:=i1;editget(e1,v2,"","GET/neuer printer");TASK CONSTdummy:=task(v2);i1:=v2;fussteil(2,i1).u2:IFw1=-1THENfussteil(2,"","")END IF.b2:SELECTw1OF CASE1:e2CASE2:e2CASE3:e2CASE4:e2END SELECT.c2:SELECTw1OF CASE1:w2CASE2:e2CASE3:e2CASE4:e2CASE5:e2END SELECT.w2:THESAURUS VARx2:=ALL/"configurator";page;bildschirmneu;y2(x2);fetch(x2,/"configurator");configurate;line;save("configuration",/"configurator");y2(x2);dialogfensterloeschen.END PROCn1;PROCq2(TASK CONSTp2):dialog(n0+z2+o0+a3);out(p0);b3
+;out(q0);c3;out(r0);d3.z2:text(storage(p2),5).a3:disablestop;TEXT VARe3:=subtext(time(clock(p2),12),1,10);IFiserrorTHENclearerror;e3:="**********"END IF;e3.b3:SELECTstatus(p2)OF CASE0:out(s0)CASE1:out(t0)CASE2:out(u0)CASE4:out(v0)CASE5:out(w0)CASE6:out(x0)OTHERWISEout(y0)END SELECT.c3:out(text(pcb(p2,6))).d3:IFchannel(p2)=0THENout(" -")ELSEout(text(channel(p2),2))END IF.END PROCq2;PROCy2(TEXT CONSTf3):forget(f3,quiet)END PROCy2;PROCy2(THESAURUS CONSTg3):do(PROC(TEXT CONST)y2,g3)END PROCy2;PROCbittewarten:cursor(1,1);out(f1);out(""5"")END PROCbittewarten;PROCe2:dialog("Zur Zeit nicht implementiert.")END PROCe2;END PACKEToperator;PACKEToperatormonitorDEFINESmonitor:PROCmonitor:disablestop;operatorEND PROCmonitor;END PACKEToperatormonitor;
+
diff --git a/app/flint/0.4/src/operator.init b/app/flint/0.4/src/operator.init
new file mode 100644
index 0000000..99d7c08
--- /dev/null
+++ b/app/flint/0.4/src/operator.init
@@ -0,0 +1,390 @@
+% MENUE "OPERATOR.Abschalten" 
+% BILD 
+Arbeit 
+  Beenden 
+- 
+Umschalten 
+  Neustart 
+- 
+Zeit/Datum 
+  Einstellen 
+- 
+Systemzustand 
+  Sichern auf 
+    Diskette 
+% FELD 1 "OP/1B" "bB" 
+% FELD 2 "OP/1D" "nN" 
+% FELD 3 "OP/1E" "eE" 
+% FELD 4 "OP/1S" "sS" 
+% ENDE 
+% MENUE "OPERATOR.Systemzustand" 
+% BILD 
+Übersicht 
+  Bereiche 
+  Speicher 
+- 
+Taskzustand 
+  Ein Bereich 
+  Alle Tasks 
+- 
+Arbeitsbereich 
+  Löschen 
+% FELD 1 "OP/2B" "bB" 
+% FELD 2 "OP/2S" "sS" 
+% FELD 3 "OP/2E" "eE" 
+% FELD 4 "OP/2A" "aA" 
+% FELD 5 "OP/2L" "lL" 
+% ENDE 
+% MENUE "OPERATOR.Drucker" 
+% BILD 
+Druckertreiber 
+  Starten 
+  Abbrechen 
+  Halten 
+- 
+Aufträge 
+  Übersicht 
+  Vorziehen 
+  Löschen 
+- 
+Zieltreiber 
+  Einstellen 
+% FELD 1 "OP/3S" "sS" 
+% FELD 2 "OP/3A" "aA" 
+% FELD 3 "OP/3H" "hH" 
+% FELD 4 "OP/3U" "uUüÜ" 
+% FELD 5 "OP/3V" "vV" 
+% FELD 6 "OP/3L" "lL" 
+% FELD 7 "OP/3E" "eE" 
+% ENDE 
+% MENUE "OPERATOR.Netz" 
+% BILD 
+Netztreiber 
+  Starten 
+  Abbrechen 
+  Zustand 
+- 
+Übertragungen 
+  Übersicht 
+% FELD 1 "OP/4S" "sS" 
+% FELD 2 "OP/4A" "aA" 
+% FELD 3 "OP/4Z" "zZ" 
+% FELD 4 "OP/4U" "uUüÜ" 
+% ENDE 
+% MENUE "OPERATOR.Konfiguration" 
+% BILD 
+Konfigurieren 
+  Kanäle 
+- 
+Installieren 
+  Drucker 
+  Netz 
+  Anwendung 
+  Systemprog 
+% FELD 1 "OP/5K" "kK" 
+% FELD 2 "OP/5D" "dD" 
+% FELD 3 "OP/5N" "nN" 
+% FELD 4 "OP/5A" "aA" 
+% FELD 5 "OP/5S" "sS" 
+% ENDE 
+% HILFE "OP/Allgemein" 
+% SEITE 1 
+MENÜBEDIENUNG 
+- 
+Das Menü dient zur Auswahl von Funktionen. Die Funktionen
+sind durch einen vorangestellten Buchstaben gekennzeichnet.
+Mit den Pfeiltasten können Sie die Markierung zu einer be­
+liebigen Position auf und ab bewegen. Diese Funktion können
+Sie dann durch Drücken der Leertaste ausführen. Durch ESC '?'
+(nachein-ander gedrückt) erhalten Sie Informationen zur
+gerade markierten Funktion. 
+Funktionen, die im momentanen Zustand nicht ausgeführt werden
+können, sind durch ein Minuszeichen gekennzeichnet. 
+In der obersten Bildschirmzeile sind weitere Menüs aufge­
+führt, die Sie aufrufen können. Das aktuelle Menü ist invers
+markiert. Ein anderes Menü wählen Sie durch Drücken der
+Pfeiltasten RECHTS oder LINKS. Wollen Sie das Programm wieder
+verlassen, drücken Sie die ESC-Taste und 'q' hintereinander. 
+% ENDE 
+% HILFE "GET/Allgemein" 
+% SEITE 1 
+EINGABE: 
+- 
+Die Eingabe erwartet von Ihnen eine bestimmte Information,
+die Sie eingeben sollen. Die Art der Information wird durch
+den Anforderungstext angegeben. Wenn Sie sich beim Eintippen
+verschrieben haben, können Sie mit den Pfeiltasten zurück­
+gehen und den Text korrigieren. Eine bereits dastehende
+Information können Sie überschreiben. RUBOUT löscht ein
+Zeichen, RUBIN schaltet in den Einfügemodus (Zeichen werden
+nicht mehr überschrieben). Beenden Sie die Eingabe mit
+RETURN. ESC 'h' bricht die Eingabe und die folgende Funktion
+ab. Wenn in der Statuszeile angegeben, können Sie mit ESC 'z'
+eine Auswahl verfügbarer Namen abrufen, die Sie dann Ankreu­
+zen können. 
+% ENDE 
+% HILFE "FEHLER/Allgemein" 
+% SEITE 1 
+FEHLERMELDUNGEN: 
+- 
+Fehlermeldungen werden von einem Programm abgesetzt, wenn es
+seine Funktion nicht durchführen kann. Der Text der Meldung
+identifiziert die Ursache des Problems. Zur Zeit liegen noch
+keine meldungsspezifischen Informationen vor, schauen Sie
+ggf. in das Benutzerhandbuch. 
+% ENDE 
+% HILFE "JA/Allgemein" 
+% SEITE 1 
+FRAGEN: 
+- 
+Das Programm stellt Ihnen eine Frage, die Sie bejahen oder
+verneinen können. Sie bejahen die Frage, indem Sie 'j' drük­
+ken und verneinen Sie mit 'n' (beides groß oder klein). Mit
+ESC 'h' können Sie die Funktion abbrechen. 
+% ENDE 
+% HILFE "OP/1B" 
+% SEITE 1 
+Arbeit Beenden 
+- 
+Führt 'shutup' aus. Nach dem Neustart wird das Operatormenü
+automatisch verlassen und die Arbeit im letzten Bereich
+wieder aufgenommen. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/1D" 
+% SEITE 1 
+Umschalten nach DOS 
+- 
+Macht 'shutup' mit gleichzeitigem Neustart einer
+DOS-Partition. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/1E" 
+% SEITE 1 
+Zeit/Datum einstellen 
+- 
+Aufruf von 'set date'. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/1S" 
+% SEITE 1 
+Sichern auf Diskette 
+- 
+Aufruf von 'save system'. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/2B" 
+% SEITE 1 
+Übersicht Bereiche 
+- 
+Aufruf von 'task info'. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/2S" 
+% SEITE 1 
+Übersicht Speicher 
+- 
+wie 'storage info'. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/2E" 
+% SEITE 1 
+Taskzustand einer Task 
+- 
+'task status' einer Task. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/2A" 
+% SEITE 1 
+Taskzustand aller Tasks 
+- 
+'task info (3)'. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/2L" 
+% SEITE 1 
+Arbeitsbereich löschen 
+- 
+'end' 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3S" 
+% SEITE 1 
+Druckertreiber starten 
+- 
+'start' für die angezeigte Druckertask. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3A" 
+% SEITE 1 
+Druckertreiber abbrechen 
+- 
+'stop' für die angezeigte Druckertask 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3H" 
+% SEITE 1 
+Druckertreiber anhalten 
+- 
+'halt' bzw. 'wait for halt' für die angezeigte Druckertask. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3U" 
+% SEITE 1 
+Aufträge Übersicht 
+- 
+Übersicht über die Warteschlange der angezeigten
+Druckertask. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3V" 
+% SEITE 1 
+Auftrag Vorziehen 
+- 
+'first' 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3L" 
+% SEITE 1 
+Auftrag Löschen 
+- 
+'killer' 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/3E" 
+% SEITE 1 
+Zieltreiber einstellen 
+- 
+Angabe der Spooltask, die mit den Kommandos dieses Menüs
+gesteuert werden soll. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/4S" 
+% SEITE 1 
+Netztreiber starten 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/4A" 
+% SEITE 1 
+Netztreiber Abbrechen 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/4Z" 
+% SEITE 1 
+Zustand des Netztreibers 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/4U" 
+% SEITE 1 
+Übersicht der laufenden Übertragungen 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/5K" 
+% SEITE 1 
+Kanäle Konfigurieren 
+- 
+'configurate', ohne "configurator" zu betreten. 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/5D" 
+% SEITE 1 
+Drucker Installieren 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/5N" 
+% SEITE 1 
+Netz Installieren 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/5A" 
+% SEITE 1 
+Anwendungsprogramm Installieren 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "OP/5S" 
+% SEITE 1 
+Systemprogramm Installieren 
+- 
+% SEITE 1 "OP/Allgemein" 
+% ENDE 
+% HILFE "GET/neuer taskname" 
+% SEITE 1 
+Name des gewünschten Arbeitsbereichs 
+- 
+Geben Sie den Namen des Arbeitsbereichs an, in dem Sie
+arbeiten wollen. Falls der Bereich noch nicht existiert,
+kann er eingerichtet werden. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/name vatertask" 
+% SEITE 1 
+Name des Vaterbereichs 
+- 
+Ein neuer Arbeitsbereich muß unterhalb eines existierenden
+Bereichs eingerichtet werden, der die zur Verfügung
+stehenden Programme festlegt. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/Taskname" 
+% SEITE 1 
+Name des Arbeitsbereichs 
+- 
+Geben Sie den Namen des Arbeitsbereichs ein, dessen Status
+Sie erfahren wollen. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "GET/neuer printer" 
+% SEITE 1 
+Name der Druckertask 
+- 
+Geben Sie den Namen des Bereichs an, der durch die Befehle
+dieses menüs gesteuert werden kann. 
+% SEITE 1 "GET/Allgemein" 
+% ENDE 
+% HILFE "JA/ganz" 
+% SEITE 1 
+Ganz abkoppeln ? 
+- 
+Wenn Sie keinen neuen Arbeitsbereich wollen oder spezielle
+Arbeitsbereiche betreten wollen, können Sie sich jetzt
+abkoppeln. Sie müssen dann mit SV fortfahren. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/task einrichten" 
+% SEITE 1 
+Arbeitsbereich existiert nicht. Neu einrichten ? 
+- 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE  "JA/trotz shutup" 
+% SEITE 1 
+Nicht auf Kanal 1. 
+- 
+Wenn Sie nicht auf Kanal 1 abschalten, meldet sich das
+System später auch wieder auf dem jetzigen Kanal. Das kann
+Sie dann irritieren. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/Task loeschen" 
+% SEITE 1 
+Arbeitsbereich wirklich löschen 
+- 
+Zur Kontrolle. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+% HILFE "JA/halt warten" 
+% SEITE 1 
+Auf Anhalten warten ? 
+- 
+Wenn Sie die Frage bejahen, wartet das Programm bis zur
+Abarbeitung des aktuellen Druckauftrags. 
+% SEITE 1 "JA/Allgemein" 
+% ENDE 
+
diff --git a/app/flint/0.4/src/operator.manager b/app/flint/0.4/src/operator.manager
new file mode 100644
index 0000000..fc9c31a
--- /dev/null
+++ b/app/flint/0.4/src/operator.manager
@@ -0,0 +1,34 @@
+PACKET operator manager                          (* Autor: Thomas Berlage *)
+                                                 (* Stand: 14.01.88       *)
+  DEFINES
+
+  operator manager,
+  continue :
+
+
+LET
+  only privileged =
+    "Nur für Systemtasks zugelassen";
+
+
+PROC operator manager (DATASPACE VAR ds, INT CONST order, phase,
+                       TASK CONST order task) :
+
+  enable stop;
+  IF order task = supervisor OR order task < supervisor THEN
+    menue manager (ds, order, phase, order task)
+  ELSE
+    errorstop (only privileged)
+  END IF
+
+END PROC operator manager;
+
+PROC continue (TASK CONST t) :
+
+  continue (t,
+    PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) operator manager)
+
+END PROC continue;
+
+END PACKET operator manager;
+
diff --git a/app/flint/0.4/src/operator.spoolcmd b/app/flint/0.4/src/operator.spoolcmd
new file mode 100644
index 0000000..921f1e3
--- /dev/null
+++ b/app/flint/0.4/src/operator.spoolcmd
@@ -0,0 +1,113 @@
+PACKET spool cmd                                    (* Autor: R. Ruland  *)
+                                                    (* Stand: 01.04.86   *)
+       DEFINES killer,                              (* Be     14.01.88   *)
+               first,                               (* Umstellung Menue  *)
+               start,
+               stop,
+               halt,
+               wait for halt :
+ 
+LET error nak          = 2 ,
+
+    entry line code    = 23 ,
+    killer code        = 24 , 
+    first code         = 25 ,
+    start code         = 26 , 
+    stop code          = 27 ,
+    halt code          = 28 ,
+    wait for halt code = 29 ;
+ 
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
+BOUND TEXT VAR error msg ;
+ 
+INT VAR reply;
+ 
+INITFLAG VAR in this task := FALSE;
+ 
+ 
+PROC control spool (TASK CONST spool, INT CONST control code,
+                    TEXT CONST question, BOOL CONST leave) :
+ 
+  enable stop;
+  initialize control msg;
+  WHILE valid spool entry
+    REP IF control question THEN control spool entry FI PER;
+ 
+  . initialize control msg :
+      IF NOT initialized (in this task) THEN ds := nilspace FI;
+      forget (ds); ds := nilspace; control msg := ds;
+      control msg. entry line := "";
+      control msg. index      := 0;
+  (*  say (""13""10"");*)
+ 
+  . valid spool entry :
+      call (spool, entry line code, ds, reply);
+      IF reply = error nak
+         THEN error msg := ds;
+              errorstop (error msg);
+      FI;
+      control msg. index <> 0
+ 
+   . control question :
+  (*   say (control msg. entry line);
+       yes (question) *)
+       ja (control msg. entry line + question, "JA/spool control", leave)
+ 
+  . control spool entry :
+      call (spool, control code, ds, reply);
+      IF reply = error nak
+         THEN error msg := ds;
+              errorstop (error msg);
+      FI;
+      IF leave THEN LEAVE control spool FI;
+ 
+END PROC control spool;
+ 
+ 
+PROC killer (TASK CONST spool) :
+ 
+  control spool (spool, killer code, " loeschen", FALSE)
+ 
+END PROC killer;
+ 
+ 
+PROC first (TASK CONST spool) :
+ 
+  control spool (spool, first code, " als erstes", TRUE)
+ 
+END PROC first;
+
+ 
+PROC start (TASK CONST spool) :
+ 
+  call (stop  code, "", spool);
+  call (start code, "", spool);
+ 
+END PROC start;
+ 
+ 
+PROC stop (TASK CONST spool) :
+ 
+  call (stop code, "", spool);
+ 
+END PROC stop;
+ 
+ 
+PROC halt (TASK CONST spool) :
+ 
+  call (halt code, "", spool);
+ 
+END PROC halt;
+ 
+ 
+PROC wait for halt (TASK CONST spool) :
+ 
+  call (wait for halt code, "", spool);
+ 
+END PROC wait for halt;
+ 
+ 
+END PACKET spool cmd;
+
diff --git a/doc/dialog/gs-dialog handbuch.impressum b/app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum
index b470fe4..b470fe4 100644
--- a/doc/dialog/gs-dialog handbuch.impressum
+++ b/app/gs.dialog/1.2/doc/gs-dialog handbuch.impressum
diff --git a/doc/dialog/gs-dialog-1 b/app/gs.dialog/1.2/doc/gs-dialog-1
index 59b98c3..59b98c3 100644
--- a/doc/dialog/gs-dialog-1
+++ b/app/gs.dialog/1.2/doc/gs-dialog-1
diff --git a/doc/dialog/gs-dialog-2 b/app/gs.dialog/1.2/doc/gs-dialog-2
index a25d35d..a25d35d 100644
--- a/doc/dialog/gs-dialog-2
+++ b/app/gs.dialog/1.2/doc/gs-dialog-2
diff --git a/doc/dialog/gs-dialog-3 b/app/gs.dialog/1.2/doc/gs-dialog-3
index 044720b..044720b 100644
--- a/doc/dialog/gs-dialog-3
+++ b/app/gs.dialog/1.2/doc/gs-dialog-3
diff --git a/doc/dialog/gs-dialog-4 b/app/gs.dialog/1.2/doc/gs-dialog-4
index 03d8dc4..03d8dc4 100644
--- a/doc/dialog/gs-dialog-4
+++ b/app/gs.dialog/1.2/doc/gs-dialog-4
diff --git a/doc/dialog/gs-dialog-5 b/app/gs.dialog/1.2/doc/gs-dialog-5
index f2b17cf..f2b17cf 100644
--- a/doc/dialog/gs-dialog-5
+++ b/app/gs.dialog/1.2/doc/gs-dialog-5
diff --git a/doc/dialog/gs-dialog-Inhaltsverzeichnis b/app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis
index 741744f..741744f 100644
--- a/doc/dialog/gs-dialog-Inhaltsverzeichnis
+++ b/app/gs.dialog/1.2/doc/gs-dialog-Inhaltsverzeichnis
diff --git a/app/gs.dialog/1.2/source-disk b/app/gs.dialog/1.2/source-disk
new file mode 100644
index 0000000..daf7d81
--- /dev/null
+++ b/app/gs.dialog/1.2/source-disk
@@ -0,0 +1 @@
+informatikpaket/05_gs.dialog.img
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 1 b/app/gs.dialog/1.2/src/ls-DIALOG 1
new file mode 100644
index 0000000..974bcda
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 1
@@ -0,0 +1,60 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 1                     ** 
+          **                                                     ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+PACKET ls dialog 1  DEFINES                  
+       ecke oben  links,  balken oben,{}       ecke oben  rechts, balken rechts,{}       ecke unten links,  balken links,{}       ecke unten rechts, balken unten,{}       waagerecht, senkrecht, kreuz,{}       cursor on, cursor off,{}       clear buffer, clear buffer and count,{}       center, invers, page, page up,{}       out frame, out menuframe, erase frame,{}       std graphic char, ft20 graphic char,{}       ibm graphic char, AREA, :=, fill,{}       areax, areay, areaxsize, areaysize,{}       cursor, get cursor, out, out invers,{}
+       out with beam, out invers with beam,{}       erase, erase invers, erase with beam:{}TYPE AREA = STRUCT (INT x, y, xsize, ysize);{}LET blank     =     " ",{}    mark ein  =  ""15"",{}    mark aus  =  ""14"",{}    cleol     =   ""5"";{}TEXT CONST fehlermeldung :: "Unzulässige Größen!";{}TEXT VAR eol  := "+", eor  := "+", eul  := "+", eur  := "+",{}         bo   := "+", br   := "+", bl   := "+", bu   := "+",{}         waa  := "-", sen  := "|", kr   := "+",{}         cursor sichtbar     :=  "", cursor unsichtbar   :=  "";{}
+TEXT PROC ecke oben  links : eol END PROC ecke oben  links  ;{}TEXT PROC ecke oben  rechts: eor END PROC ecke oben  rechts ;{}TEXT PROC ecke unten links : eul END PROC ecke unten links  ;{}TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;{}TEXT PROC balken oben      : bo  END PROC balken oben       ;{}TEXT PROC balken links     : bl  END PROC balken links      ;{}TEXT PROC balken rechts    : br  END PROC balken rechts     ;{}TEXT PROC balken unten     : bu  END PROC balken unten      ;{}
+TEXT PROC waagerecht       : waa END PROC waagerecht        ;{}TEXT PROC senkrecht        : sen END PROC senkrecht         ;{}TEXT PROC kreuz            : kr  END PROC kreuz             ;{}PROC ecke oben  links  (TEXT CONST t): eol := t END PROC ecke oben  links  ;{}PROC ecke oben  rechts (TEXT CONST t): eor := t END PROC ecke oben  rechts ;{}PROC ecke unten links  (TEXT CONST t): eul := t END PROC ecke unten links  ;{}PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;{}
+PROC balken oben       (TEXT CONST t): bo  := t END PROC balken oben       ;{}PROC balken links      (TEXT CONST t): bl  := t END PROC balken links      ;{}PROC balken rechts     (TEXT CONST t): br  := t END PROC balken rechts     ;{}PROC balken unten      (TEXT CONST t): bu  := t END PROC balken unten      ;{}PROC waagerecht        (TEXT CONST t): waa := t END PROC waagerecht        ;{}PROC senkrecht         (TEXT CONST t): sen := t END PROC senkrecht         ;{}PROC kreuz             (TEXT CONST t): kr  := t END PROC kreuz             ;{}
+PROC std graphic char:{}  ecke oben  links  ("+"); ecke oben  rechts ("+");{}  ecke unten links  ("+"); ecke unten rechts ("+");{}  balken oben       ("+"); balken rechts     ("+");{}  balken links      ("+"); balken unten      ("+");{}  waagerecht        ("-"); senkrecht         ("|");{}  kreuz             ("+");{}  cursor sichtbar   := ""; cursor unsichtbar := ""{}END PROC std graphic char;{}PROC ft20 graphic char:{}  ecke oben  links (""27"R�"27"S"); ecke oben  rechts (""27"RD"27"S");{}  ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");{}
+  balken oben      (""27"RP"27"S"); balken rechts     (""27"RT"27"S");{}  balken links     (""27"RX"27"S"); balken unten      (""27"R\"27"S");{}  waagerecht       (""27"R`"27"S"); senkrecht         (""27"Rd"27"S");{}  kreuz            (""27"Rh"27"S");{}  cursor sichtbar  := ""27"-1"    ; cursor unsichtbar := ""27"-0"    ;{}  ft20 statuszeilen aus{}END PROC ft20 graphic char;{}PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;{}PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;{}
+PROC ibm graphic char:{}  ecke oben  links (""201"");  ecke oben  rechts (""187"");{}  ecke unten links (""200"");  ecke unten rechts (""188"");{}  balken oben      (""203"");  balken rechts     (""185"");{}  balken links     (""204"");  balken unten      (""202"");{}  waagerecht       (""205"");  senkrecht         (""186"");{}  kreuz            (""206"");{}  cursor sichtbar  := ""    ;  cursor unsichtbar := ""{}END PROC ibm graphic char;{}PROC cursor on                : out (cursor sichtbar  ) END PROC cursor on ;{}
+PROC cursor off               : out (cursor unsichtbar) END PROC cursor off;{}PROC cursor on  (TEXT CONST t): cursor sichtbar   := t  END PROC cursor on ;{}PROC cursor off (TEXT CONST t): cursor unsichtbar := t  END PROC cursor off;{}PROC clear buffer:{}  REP UNTIL incharety = "" PER{}END PROC clear buffer;{}INT PROC clear buffer and count (TEXT CONST zeichen):{}  INT  VAR zaehler :: 0;{}  TEXT VAR zeichenkette :: "", ch;{}  IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;{}
+  ermittle die zeichenkette;{}  untersuche auf vorhandene zeichen;{}  zaehler.{}  ermittle die zeichenkette:{}    REP{}      ch := incharety (1);{}      zeichenkette CAT ch{}    UNTIL ch = "" PER.{}  untersuche auf vorhandene zeichen:{}    INT VAR i;{}    FOR i FROM 1 UPTO length (zeichenkette) REP{}      IF pos (subtext (zeichenkette, i), zeichen) = 1{}         THEN zaehler INCR 1{}      FI{}    PER.{}END PROC clear buffer and count;{}TEXT PROC center (INT CONST xsize, TEXT CONST t):{}  TEXT VAR zeile :: compress (t);{}
+  zeile := ((xsize  - length (zeile)) DIV 2) * blank + zeile;{}  zeile CAT (xsize - length (zeile)) * blank;{}  zeile{}END PROC center;{}TEXT PROC center (TEXT CONST t):{}  center (79, t){}END PROC center;{}TEXT PROC invers (TEXT CONST t):{}  TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;{}  neu{}END PROC invers;{}PROC page (INT CONST x, y, xsize, ysize):{}    INT VAR zeiger;{}    IF x + xsize = 80{}       THEN in einem streich{}       ELSE putze vorsichtig{}    FI;{}    cursor (x, y).{}
+    in einem streich:{}      FOR zeiger FROM y UPTO y + ysize - 1 REP{}        cursor (x, zeiger); out (cleol){}      PER.{}    putze vorsichtig:{}      FOR zeiger FROM y UPTO y + ysize - 1  REP{}        cursor (x, zeiger); xsize TIMESOUT blank{}      PER.{}END PROC page;{}PROC page (AREA CONST a):{}  page (a.x, a.y, a.xsize, a.ysize){}END PROC page;{}PROC page up (INT CONST x, y, xsize, ysize):{}    INT VAR zeiger;{}    IF x + xsize = 80{}       THEN in einem streich{}       ELSE putze vorsichtig{}
+    FI.{}    in einem streich:{}      FOR zeiger FROM y + ysize - 1 DOWNTO y REP{}        cursor (x, zeiger); out (cleol){}      PER.{}    putze vorsichtig:{}      FOR zeiger FROM y + ysize - 1  DOWNTO y REP{}        cursor (x, zeiger); xsize TIMESOUT blank{}      PER.{}END PROC page up;{}PROC page up (AREA CONST a):{}  page up (a.x, a.y, a.xsize, a.ysize){}END PROC page up;{}PROC out frame (INT CONST x, y, xsize, ysize):{}  INT VAR zeiger;{}  IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR{}     x + xsize > 80  COR y + ysize > 25{}
+     THEN LEAVE out frame{}  FI;{}  male oben;{}  male seiten;{}  male unten.{}  male oben:{}    cursor (x, y);{}    out (ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke oben rechts).{}  male seiten:{}    FOR zeiger FROM 1 UPTO ysize - 2 REP{}      cursor (x,             y + zeiger); out (senkrecht);{}      cursor (x + xsize - 1, y + zeiger); out (senkrecht){}    PER.{}  male unten:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}
+    out (ecke unten rechts){}END PROC out frame;{}PROC out frame (AREA CONST a):{}  IF    a.x - 1     <  1  OR a.y - 1     <  1{}     OR a.xsize + 2 > 79 OR a.ysize + 2 > 24{}     OR a.x + a.xsize + 1 > 80{}     OR a.y + a.ysize + 1 > 25{}     THEN LEAVE out frame{}  FI;{}  out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out frame;{}PROC out menuframe (INT CONST x, y, xsize, ysize):{}  INT VAR i;{}  untersuche angaben;{}  schreibe rahmen.{}  untersuche angaben:{}    IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26{}
+       THEN LEAVE out menuframe{}    FI.{}  schreibe rahmen:{}    IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26{}       THEN zeichne reduzierten rahmen{}       ELSE zeichne vollen rahmen{}    FI.{}  zeichne reduzierten rahmen:{}    zeichne oberlinie;{}    zeichne unterlinie.{}  zeichne oberlinie:{}    cursor (1, 2);{}    79 TIMESOUT waagerecht.{}  zeichne unterlinie:{}    cursor (1, 23);{}    79 TIMESOUT waagerecht.{}  zeichne vollen rahmen:{}    schreibe kopf; schreibe rumpf; schreibe fuss;{}
+    schreibe kopfleiste; schreibe fussleiste.{}  schreibe kopf:{}    cursor (x, y);{}    out (ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke oben rechts).{}  schreibe rumpf:{}    FOR i FROM y + 1 UPTO y + ysize - 2 REP{}      cursor (x,             i); out (senkrecht);{}      cursor (x + xsize - 1, i); out (senkrecht){}    PER.{}  schreibe fuss:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}
+  schreibe kopfleiste:{}    cursor (x, y + 2        ); schreibe balkenlinie.{}  schreibe fussleiste:{}    cursor (x, y + ysize - 3); schreibe balkenlinie.{}  schreibe balkenlinie:{}    out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).{}END PROC out menuframe;{}PROC out menuframe (AREA CONST a):{} out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out menuframe;{}PROC erase frame (INT CONST x, y, xsize, ysize):{}  INT VAR zeiger;{}  loesche oben; loesche seiten; loesche unten.{}
+  loesche oben:{}    cursor (x, y); xsize TIMESOUT blank.{}  loesche seiten:{}    FOR zeiger FROM 1 UPTO ysize - 2 REP{}      cursor (x, y + zeiger); out (blank);{}      cursor (x + xsize - 1, y + zeiger); out (blank){}    PER.{}  loesche unten:{}    cursor (x, y + ysize - 1); xsize TIMESOUT blank.{}END PROC erase frame;{}OP := (AREA VAR ziel, AREA CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC fill (AREA VAR ziel, INT CONST a, b, c, d):{}  IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3{}
+     COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25{}     THEN errorstop (fehlermeldung){}  FI;{}  ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d{}END PROC fill;{}INT PROC areax     (AREA CONST a): a.x      END PROC areax;{}INT PROC areay     (AREA CONST a): a.y      END PROC areay;{}INT PROC areaxsize (AREA CONST a): a.xsize  END PROC areaxsize;{}INT PROC areaysize (AREA CONST a): a.ysize  END PROC areaysize;{}PROC out (TEXT CONST t, INT CONST breite):{}  outtext (t, 1, breite){}
+END PROC out;{}PROC erase (INT CONST breite):{}  breite TIMESOUT blank{}END PROC erase;{}PROC cursor (AREA CONST a, INT CONST spa, zei):{}  cursor (a.x + spa - 1, a.y + zei - 1){}END PROC cursor;{}PROC get cursor (AREA CONST a, INT VAR spalte, zeile):{}  INT VAR x, y;{}  get cursor (x, y);{}  spalte := x - a.x + 1; zeile  := y - a.y + 1{}END PROC get cursor;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}
+     ELSE out (t){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE out{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    outsubtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}
+     THEN verkuerzte ausgabe{}     ELSE outtext (t, 1, laenge){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE out{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    outtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}
+  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE erase{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    erase (a.xsize - spa + 1){}END PROC erase;{}PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}
+  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (mark ein); out (t); out (blank); out (mark aus){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1{}       THEN LEAVE out invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{}    out (blank); out (mark aus){}END PROC out invers;{}
+PROC out invers (AREA CONST a, INT CONST spa, zei,{}                 TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{}       THEN LEAVE out invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}
+  laenge ist zu gross:{}    laenge > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{}    out (blank); out (mark aus){}END PROC out invers;{}PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge + 3){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{}
+       THEN LEAVE erase invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    erase ( a.xsize - spa + 2).{}END PROC erase invers;{}PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (blank);{}          out (t);{}          out (blank); out (blank); out (senkrecht){}
+  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (blank);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC out with beam (AREA CONST a, INT CONST spa, zei,{}
+                    TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (blank);{}          outtext (t, 1,laenge);{}          out (blank); out (blank); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}
+  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (blank);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge + 6){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
+       THEN LEAVE erase with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    erase (a.xsize - spa + 4).{}END PROC erase with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (mark ein);{}          out (t);{}
+          out (blank); out (mark aus); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out invers with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (mark ein);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (mark aus); out (senkrecht){}
+END PROC out invers with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei,{}                           TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (mark ein);{}          outtext (t, 1, laenge);{}          out (blank); out (mark aus); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
+       THEN LEAVE out invers with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (mark ein);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (mark aus); out (senkrecht){}END PROC out invers with beam;{}END PACKET ls dialog 1;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 2 b/app/gs.dialog/1.2/src/ls-DIALOG 2
new file mode 100644
index 0000000..1750162
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 2
@@ -0,0 +1,77 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 2                     ** 
+          **                                                     ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+PACKET ls dialog 2  DEFINES                  
+       some,{}       one,{}       infix namen,{}       ohne praefix,{}       not empty:{}LET maxentries           = 200;{}LET zeichenstring                           =  ""1""27""3""10""13""12"xo?",{}    oben unten return rubout kreuz kringel  =  ""3""10""13""12"xo",{}    q eins neun h                           =  "q19h";{}LET zurueck    =   ""8"",{}    piep       =   ""7"";{}LET hop        =  1,{}    esc        =  2,{}    oben       =  3,{}    unten      =  4,{}    return     =  5,{}    rubout     =  6,{}
+    kreuz      =  7,{}    kringel    =  8,{}    frage      =  9;{}LET punkt      =  ".",{}    gleich     =  "=",{}    blank      =  " ";{}INT  VAR x,{}         y,{}         xsize,{}         ysize,{}         maxeintraege,{}         anzahl,{}         erste auswahlzeile,{}         virtueller cursor,{}         reeller cursor;{}TEXT VAR kennzeile 1,{}         kennzeile 2,{}         registrierkette :: "";{}BOOL VAR abbruch,{}         auswahlende;{}BOUND ROW max entries TEXT VAR eintrag;{}ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : ({}
+  "Unzulässige Cursorwerte bei der Auswahl",{}  "Fenster für Auswahl zu klein (x < 56 / y < 15)");{}ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : ({}  " Bitte warten... Ich sortiere und räume auf!",{}  " Info: <?>  Fertig: <ESC><q>  Abbrechen: <ESC><h>",{}  " Zum Weitermachen bitte irgendeine Taste tippen!",{}  "Weitere Dateien!",{}  "INFORMATIONEN: Auswahl  mehrerer  Dateien",{}  "INFORMATIONEN: Auswahl  einer Datei",{}  "                       "15"Positionierungen: "14"",{}  "  hoch               : zum vorausgehenden Namen",{}
+  "  runter             : zum folgenden   Namen",{}  "  HOP hoch           : auf den ersten  Namen der Seite",  (***********){}  "  HOP runter         : auf den letzten Namen der Seite",  (*  bitte  *){}  "  ESC 1              : auf den ersten  Namen der Liste",  (*  diese  *){}  "  ESC 9              : auf den letzten Namen der Liste",  (*  Länge  *){}  "                       "15"Auswahl treffen: "14"",        (*  nicht  *){}  "  RETURN     / x     : diesen Namen ankreuzen ",          (*  über-  *){}
+  "  RUBOUT     / o     : Kreuz vor dem Namen loeschen",     (*  schrei-*){}  "  HOP RETURN / HOP x : alle folgende Namen ankreuzen",    (*  ten!   *){}  "  HOP RUBOUT / HOP o : alle folgende Kreuze loeschen",    (***********){}  "                       "15"Auswahl verlassen: "14"",{}  "  ESC q              : Auswahl verlassen",{}  "  ESC h              : Auswahl abbrechen",{}  "  Auswahl   m e h r e r e r   Dateien durch Ankreuzen",{}  "  Auswahl   e i n e r   Datei durch Ankreuzen",{}  " Bitte warten... Ich breche die Auswahl ab!"{}
+  );{}THESAURUS PROC auswahl (THESAURUS CONST t,{}                        BOOL CONST mehrere moeglich,{}                        TEXT CONST t1, t2):{}  werte initialisieren;{}  namen besorgen;{}  bildschirm aufbauen;{}  auswaehlen lassen;{}  abgang vorbereiten.{}  werte initialisieren:{}    THESAURUS VAR ausgabe :: empty thesaurus;{}    DATASPACE VAR ds      := nilspace;{}    eintrag               := ds;{}    kennzeile 1           := t1;{}    kennzeile 2           := t2;{}    abbruch               := FALSE;{}
+    erste auswahlzeile    := y + 7;{}    anzahl                := 0;{}    maxeintraege          := ysize - 11;{}    virtueller cursor     := 1;{}    reeller cursor        := 1.{}  namen besorgen:{}    fische die namen aus dem thesaurus;{}    IF kein eintrag vorhanden{}       THEN LEAVE auswahl WITH ausgabe{}    FI.{}  bildschirm aufbauen:{}    schreibe kopfzeile;{}    gib hinweis aus (kennzeile 1, kennzeile 2);{}    gib erklaerungszeile aus (mehrere moeglich);{}    baue bildschirm auf (1);{}    footnote (x, y, xsize, ysize, hinweis [2]);{}
+    schreibe fusszeile;{}    reellen cursor setzen .{}  schreibe kopfzeile:{}    cursor (x, y);{}    out(ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out(ecke oben rechts).{}  schreibe fusszeile:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}  auswaehlen lassen:{}    kreuze an (mehrere moeglich).{}  abgang vorbereiten:{}    IF abbruch{}       THEN change footnote (x, y, xsize, ysize, hinweis [24]){}
+       ELSE change footnote (x, y, xsize, ysize, hinweis [ 1]){}    FI;{}    cursor (x + 1, y + ysize - 1);{}    ausgabe erzeugen;{}    forget (ds);{}    ausgabe.{}  fische die namen aus dem thesaurus:{}    INT VAR zeiger;{}    FOR zeiger FROM 1 UPTO highest entry (t) REP{}      IF name (t, zeiger) <> ""{}         THEN anzahl INCR 1;{}              eintrag [anzahl] := name (t, zeiger){}      FI{}    PER.{}  kein eintrag vorhanden:{}    anzahl = 0.{}  ausgabe erzeugen:{}    TEXT VAR nummer;{}    WHILE registrierkette <> "" REP{}
+      nummer          := subtext (registrierkette, 1, 3);{}      registrierkette := subtext (registrierkette, 5);{}      insert (ausgabe, eintrag [ int (nummer)]){}    PER.{}END PROC auswahl;{}PROC reellen cursor setzen:{}  cursor (x + 1, erste auswahlzeile + reeller cursor - 1);{}  out (marke (virtueller cursor, TRUE) + (8 * zurueck)){}END PROC reellen cursor setzen;{}PROC baue bildschirm auf (INT CONST anfang):{}  gib kopfzeile aus;{}  gib namenstabelle aus;{}  gib fusszeile aus;{}  loesche ggf restbereich.{}
+  gib kopfzeile aus:{}    cursor (x, erste auswahlzeile - 1); out (senkrecht);{}    IF reeller cursor = virtueller cursor{}       THEN (xsize - 2) TIMESOUT punkt{}       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{}            out (invers (hinweis [4])){}    FI;{}    out (senkrecht);{}    line.{}  gib namenstabelle aus:{}    INT VAR zeiger, zaehler :: -1;{}    FOR zeiger FROM anfang UPTO grenze REP{}      zaehler INCR 1;{}      cursor (x, erste auswahlzeile + zaehler);{}      out (senkrecht); out (marke (zeiger, FALSE));{}
+      outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);{}      out (senkrecht);{}    PER.{}  gib fusszeile aus:{}    cursor (x, erste auswahlzeile + zaehler + 1);{}    out (senkrecht);{}    IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl){}       THEN (xsize - 2) TIMESOUT punkt{}       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;{}            out (invers (hinweis [4])){}    FI;{}    out (senkrecht).{}  loesche ggf restbereich:{}    IF zaehler + 1 < maxeintraege{}
+       THEN loesche bildschirmrest{}    FI.{}  loesche bildschirmrest:{}    FOR zeiger FROM restanfang UPTO restende REP{}      cursor (x, zeiger); out (senkrecht);{}                          (xsize - 2) TIMESOUT blank;{}                          out (senkrecht){}    PER.{}  restanfang:{}    erste auswahlzeile + zaehler + 2.{}  restende:{}    erste auswahlzeile + maxeintraege.{}  grenze:{}    min (anzahl, anfang + max eintraege - 1).{}END PROC baue bildschirm auf;{}TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):{}
+  INT VAR platz := nr (zeiger);{}  IF platz = 0{}     THEN leer{}     ELSE mit zahl{}  FI.{}  mit zahl:{}    IF mit cursor{}       THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "{}       ELSE "   " + (3 - length (text (platz))) * blank + text (platz) + "x "{}    FI.{}  leer:{}    IF mit cursor{}       THEN "==>   o "{}       ELSE "      o "{}    FI.{}END PROC marke;{}INT PROC nr (INT CONST zeiger):{}  IF pos (registrierkette, textstring (zeiger)) = 0{}     THEN 0{}     ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1{}
+  FI{}END PROC nr;{}TEXT PROC textstring (INT CONST nr):{}  text (nr, 3) + "!"{}END PROC textstring;{}PROC info (BOOL CONST mehrere):{}  notiere hinweisueberschrift;{}  notiere positionierhinweise;{}  IF noch platz vorhanden{}     THEN  notiere auswahlmoeglichkeiten auf alter seite{}     ELSE  wechsle auf naechste seite;{}           notiere hinweisueberschrift;{}           notiere auswahlmoeglichtkeiten auf neuer seite{}  FI;{}  stelle alten bildschirmzustand wieder her.{}  notiere hinweisueberschrift:{}
+    cursor (x + 1, y +  1);{}    IF mehrere{}       THEN out (center(xsize - 2, invers (hinweis [5]))){}       ELSE out (center(xsize - 2, invers (hinweis [6]))){}    FI;{}    cursor (x + 1, y +  2); out ("", xsize - 2).{}  notiere positionierhinweise:{}    cursor (x + 1, y +  3); out (hinweis [ 7], xsize - 2);{}    cursor (x + 1, y +  4); out (hinweis [ 8], xsize - 2);{}    cursor (x + 1, y +  5); out (hinweis [ 9], xsize - 2);{}    cursor (x + 1, y +  6); out (hinweis [10], xsize - 2);{}    cursor (x + 1, y +  7); out (hinweis [11], xsize - 2);{}
+    cursor (x + 1, y +  8); out (hinweis [12], xsize - 2);{}    cursor (x + 1, y +  9); out (hinweis [13], xsize - 2).{}  notiere auswahlmoeglichkeiten auf alter seite:{}    cursor (x + 1, y + 10); out ("", xsize - 2);{}    cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);{}    cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);{}    IF mehrere{}       THEN  gib alle auswahlmoeglichkeiten auf der alten seite an{}       ELSE  gib eine auswahlmoeglichkeit   auf der alten seite an{}    FI;{}
+    notiere verlassmoeglichkeiten auf der alten seite;{}    loesche die restlichen zeilen;{}    change footnote (x, y, xsize, ysize, hinweis [3]);{}    cursor in ruhestellung;{}    clear buffer.{}  gib alle auswahlmoeglichkeiten auf der alten seite an:{}    cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);{}    cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);{}    cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).{}  gib eine auswahlmoeglichkeit auf der alten seite an:{}    cursor (x + 1, y + 13); out ("", xsize - 2);{}
+    cursor (x + 1, y + 14); out ("", xsize - 2);{}    cursor (x + 1, y + 15); out ("", xsize - 2).{}  notiere verlassmoeglichkeiten auf der alten seite:{}    cursor (x + 1, y + 16); out ("", xsize - 2);{}    cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);{}    cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);{}    cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).{}  loesche die restlichen zeilen:{}    IF ysize = 24{}       THEN cursor (x + 1, y + 20); out ("", xsize - 2){}    FI.{}
+  wechsle auf naechste seite:{}    loesche seitenrest;{}    change footnote (x, y, xsize, ysize, hinweis [3]);{}    cursor in ruhestellung;{}    clear buffer;{}    pause.{}  loesche seitenrest:{}    INT VAR zaehler;{}    FOR zaehler FROM 10 UPTO ysize - 4 REP{}      cursor (x + 1, y + zaehler); out ("", xsize - 2){}    PER.{}  notiere auswahlmoeglichtkeiten auf neuer seite:{}    cursor (x + 1, y +  3); out (hinweis [14], xsize - 2);{}    cursor (x + 1, y +  4); out (hinweis [15], xsize - 2);{}    IF mehrere{}
+       THEN  gib alle auswahlmoeglichkeiten auf der neuen seite an{}       ELSE  gib eine auswahlmoeglichkeit   auf der neuen seite an{}    FI;{}    notiere verlassmoeglichkeiten auf der neuen seite.{}  gib alle auswahlmoeglichkeiten auf der neuen seite an:{}    cursor (x + 1, y +  5); out (hinweis [16], xsize - 2);{}    cursor (x + 1, y +  6); out (hinweis [17], xsize - 2);{}    cursor (x + 1, y +  7); out (hinweis [18], xsize - 2).{}  gib eine auswahlmoeglichkeit auf der neuen seite an:{}    cursor (x + 1, y +  5); out ("", xsize - 2);{}
+    cursor (x + 1, y +  6); out ("", xsize - 2);{}    cursor (x + 1, y +  7); out ("", xsize - 2).{}  notiere verlassmoeglichkeiten auf der neuen seite:{}    cursor (x + 1, y +  8); out ("", xsize - 2);{}    cursor (x + 1, y +  9); out (hinweis [19], xsize - 2);{}    cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);{}    cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);{}    cursor in ruhestellung.{}  cursor in ruhestellung:{}    cursor (x + 1, y + ysize - 2).{}  stelle alten bildschirmzustand wieder her:{}
+    clear buffer;{}    pause;{}    gib hinweis aus (kennzeile 1, kennzeile 2);{}    gib erklaerungszeile aus (mehrere);{}    virtueller cursor := 1;{}    reeller    cursor := 1;{}    baue bildschirm auf (1);{}    change footnote (x, y, xsize, ysize, hinweis [2]);{}    reellen cursor setzen.{}  noch platz vorhanden:{}    (ysize - 4) > 18.{}END PROC info;{}PROC kreuze an (BOOL CONST mehrere):{}  auswahlende := FALSE;{}  REP{}    zeichen lesen; zeichen interpretieren{}  UNTIL auswahlende PER.{}  zeichen lesen:{}
+    TEXT VAR zeichen;{}    getchar (zeichen).{}  zeichen interpretieren:{}    SELECT pos (zeichenstring, zeichen) OF{}      CASE hop      : hop kommando verarbeiten (mehrere){}      CASE esc      : esc kommando verarbeiten{}      CASE oben     : nach oben{}      CASE unten    : nach unten{}      CASE kreuz    : ankreuzen; evtl aufhoeren{}      CASE return   : ankreuzen weiter; evtl aufhoeren{}      CASE rubout   : auskreuzen weiter{}      CASE kringel  : auskreuzen{}      CASE frage    : info (mehrere){}
+      OTHERWISE       out (piep){}    END SELECT.{}  evtl aufhoeren:{}    IF NOT mehrere{}      THEN LEAVE kreuze an{}    FI.{}END PROC kreuze an;{}PROC hop kommando verarbeiten (BOOL CONST mehrere):{}  zweites zeichen lesen;{}  zeichen interpretieren.{}  zweites zeichen lesen:{}    TEXT VAR zweites zeichen;{}    getchar(zweites zeichen).{}  zeichen interpretieren:{}    SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF{}      CASE 1    : hop nach oben{}      CASE 2    : hop nach unten{}
+      CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI{}      CASE 4, 6 : IF mehrere THEN alle darunter loeschen  FI{}      OTHERWISE   out (piep){}    END SELECT.{}  alle darunter ankreuzen:{}    INT VAR i;{}    FOR i FROM virtueller cursor UPTO anzahl REP{}      IF nr (i) = 0{}         THEN ankreuzen{}      FI{}    PER;{}    bild aktualisieren ;{}    reellen cursor setzen .{}  ankreuzen:{}    registrierkette CAT textstring (i).{}  alle darunter loeschen:{}    INT VAR j, position;{}    FOR j FROM virtueller cursor UPTO anzahl REP{}
+      position := nr (j);{}      IF position > 0{}         THEN rausschmeissen;{}      FI{}    PER;{}    bild aktualisieren;{}    reellen cursor setzen.{}  rausschmeissen:{}   registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +{}                      subtext (registrierkette, (4 * position) + 1).{}  hop nach oben:{}    IF   ganz oben{}         THEN out (piep){}    ELIF oben auf der seite{}         THEN raufblaettern{}         ELSE top of page{}    FI.{}  ganz oben:{}    virtueller cursor = 1.{}
+  oben auf der seite:{}    reeller cursor = 1.{}  raufblaettern:{}    virtueller cursor DECR max eintraege;{}    virtueller cursor := max (virtueller cursor, 1);{}    baue bildschirm auf (virtueller cursor);{}    reellen cursor setzen.{}  top of page:{}    loesche marke;{}    virtueller cursor DECR (reeller cursor - 1);{}    reeller cursor := 1;{}    reellen cursor setzen.{}  hop nach unten:{}    IF   ganz unten{}         THEN out (piep){}    ELIF unten auf der seite{}         THEN runterblaettern{}
+         ELSE bottom of page{}    FI.{}  ganz unten:{}    virtueller cursor = anzahl.{}  unten auf der seite:{}    reeller cursor > max eintraege - 1.{}  runterblaettern:{}    INT VAR alter virtueller cursor :: virtueller cursor;{}    virtueller cursor INCR max eintraege;{}    virtueller cursor := min (virtueller cursor, anzahl);{}    reeller cursor    := virtueller cursor - alter virtueller cursor;{}    baue bildschirm auf (alter virtueller cursor + 1);{}    reellen cursor setzen.{}  bottom of page:{}
+    loesche marke;{}    alter virtueller cursor := virtueller cursor;{}    virtueller cursor INCR (max eintraege - reeller cursor);{}    virtueller cursor := min (anzahl, virtueller cursor);{}    reeller cursor INCR (virtueller cursor - alter virtueller cursor);{}    reellen cursor setzen.{}END PROC hop kommando verarbeiten;{}PROC esc kommando verarbeiten:{}  TEXT VAR zweites zeichen;{}  getchar (zweites zeichen);{}  SELECT pos (q eins neun h, zweites zeichen) OF{}    CASE 1 :  auswahlende     := TRUE{}
+    CASE 2 :  zeige anfang{}    CASE 3 :  zeige ende{}    CASE 4 :  abbruch         := TRUE;{}              auswahlende     := TRUE;{}              registrierkette := ""{}    OTHERWISE out (piep){}  END SELECT.{}  zeige anfang:{}    IF   virtueller cursor = 1{}         THEN out (piep){}    ELIF virtueller cursor = reeller cursor{}         THEN loesche marke;{}              virtueller cursor := 1;{}              reeller cursor    := 1;{}              reellen cursor setzen{}         ELSE virtueller cursor := 1;{}
+              reeller cursor    := 1;{}              baue bildschirm auf (1);{}              reellen cursor setzen{}    FI.{}  zeige ende:{}    IF   virtueller cursor = anzahl{}         THEN out (piep){}    ELIF ende auf bildschirm{}         THEN loesche marke;{}              reeller cursor INCR (anzahl - virtueller cursor);{}              virtueller cursor := anzahl;{}              reellen cursor setzen{}         ELSE virtueller cursor := anzahl;{}              reeller cursor    := max eintraege;{}
+              baue bildschirm auf (anzahl - (max eintraege - 1));{}              reellen cursor setzen{}    FI.{}  ende auf bildschirm:{}    (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.{}END PROC esc kommando verarbeiten;{}PROC ankreuzen:{}  INT VAR platz :: nr (virtueller cursor);{}  IF platz <> 0{}     THEN out (piep);{}          LEAVE ankreuzen{}  FI;{}  registrierkette CAT textstring (virtueller cursor);{}  reellen cursor setzen{}END PROC ankreuzen;{}PROC ankreuzen weiter:{}
+  INT VAR platz :: nr (virtueller cursor);{}  IF platz <> 0{}     THEN out (piep);{}          LEAVE ankreuzen weiter{}  FI;{}  registrierkette CAT textstring (virtueller cursor);{}  IF virtueller cursor < anzahl{}     THEN nach unten{}  FI;{}  IF virtueller cursor = anzahl{}    THEN reellen cursor setzen{}  FI{}END PROC ankreuzen weiter;{}PROC auskreuzen weiter:{}  INT VAR position :: nr (virtueller cursor);{}  IF position = 0{}    THEN out (piep);{}         LEAVE auskreuzen weiter{}  FI;{}  rausschmeissen;{}
+  IF virtueller cursor < anzahl{}     THEN nach unten{}     ELSE loesche marke{}  FI;{}  bild aktualisieren;{}  reellen cursor setzen.{}  rausschmeissen:{}    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{}                       subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen weiter;{}PROC auskreuzen:{}  INT VAR position :: nr (virtueller cursor);{}  IF position = 0{}    THEN out (piep);{}         LEAVE auskreuzen{}  FI;{}  rausschmeissen;{}  loesche marke;{}
+  bild aktualisieren;{}  reellen cursor setzen.{}  rausschmeissen:{}    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +{}                       subtext (registrierkette, 4 * position + 1).{}END PROC auskreuzen;{}PROC bild aktualisieren:{}  INT VAR ob, un, i, zaehler :: -1;{}  ob := virtueller cursor - reeller cursor + 1;{}  un := min (ob + max eintraege - 1, anzahl);{}  FOR i FROM ob UPTO un REP{}  zaehler INCR 1;{}  cursor (x + 1, erste auswahlzeile + zaehler);{}  out (marke (i,FALSE)) PER{}
+END PROC bild aktualisieren;{}PROC nach oben:{}  IF noch nicht oben       (*virtuell*){}     THEN gehe nach oben{}     ELSE out (piep){}  FI.{}  noch nicht oben:{}    virtueller cursor > 1.{}  gehe nach oben:{}    IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.{}  scroll down:{}    virtueller cursor DECR 1;{}    baue bildschirm auf (virtueller cursor);{}    reellen cursor setzen.{}  cursor up:{}    loesche marke;{}    virtueller cursor DECR 1;{}    reeller cursor DECR 1;{}    reellen cursor setzen{}
+END PROC nach oben;{}PROC nach unten:{}  IF noch nicht unten      (*virtuell*){}     THEN gehe nach unten{}     ELSE out (piep){}  FI.{}  noch nicht unten:{}    virtueller cursor < anzahl.{}  gehe nach unten:{}    IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.{}  scroll up:{}    virtueller cursor INCR 1;{}    baue bildschirm auf (virtueller cursor - (max eintraege - 1));{}    reellen cursor setzen.{}  cursor down:{}    loesche marke;{}    virtueller cursor INCR 1;{}    reeller cursor INCR 1;{}
+    reellen cursor setzen{}END PROC nach unten;{}PROC loesche marke:{}  out (marke (virtueller cursor, FALSE)){}END PROC loesche marke;{}PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{}  cursor (x, y + ysize - 3);{}  out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);{}  change footnote (x, y, xsize, ysize, text){}END PROC footnote;{}PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):{}  cursor (x, y + ysize - 2);{}  out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht){}
+END PROC change footnote;{}PROC gib hinweis aus (TEXT CONST t1, t2):{}  cursor (x, y + 1); out (senkrecht);{}                     out (center (xsize - 2, invers (t1)));{}                     out (senkrecht);{}  cursor (x, y + 2); out (senkrecht);{}                     out ("", xsize - 2);{}                     out (senkrecht);{}  cursor (x, y + 3); out (senkrecht);{}                     out (center (xsize - 2, t2));{}                     out (senkrecht){}END PROC gib hinweis aus;{}PROC gib erklaerungszeile aus (BOOL CONST mehrere):{}
+  cursor (x, y + 4); out (senkrecht);{}                     out ((xsize - 2) * gleich);{}                     out (senkrecht);{}  cursor (x, y + 5); out (senkrecht);{}                     IF mehrere{}                        THEN out (erklaerungszeile mehrere){}                        ELSE out (erklaerungszeile eine){}                     FI;{}                     out (senkrecht).{}  erklaerungszeile mehrere:{}    invers (text 1 + (rest1 * blank)).{}  erklaerungszeile eine:{}    invers (text 2 + (rest2 * blank)).{}
+  text1:{}    hinweis [22].{}  text2:{}    hinweis [23].{}  rest1:                                  (***************************){}    xsize - length (text1) - 5.           (* durch 'invers' wird ein *){}                                          (* Blank angehängt und zu- *){}  rest2:                                  (* sätzlich noch durch     *){}    xsize - length (text2) - 5.           (* 'relativcenter' - außer-*){}END PROC gib erklaerungszeile aus;        (* dem nimmt die Markierung*){}                                          (* selbst eine Position ein*){}
+                                          (***************************){}THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):{}  THESAURUS VAR tt :: empty thesaurus;{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}    TEXT VAR eintrag :: name (t,i);{}    IF eintrag enthaelt infix{}       THEN insert (tt, eintrag){}    FI{}  PER;{}  tt.{}  eintrag enthaelt infix:{}    pos (eintrag, infix) <> 0{}END PROC infix namen;{}THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):{}
+  THESAURUS VAR tt :: empty thesaurus;{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}    TEXT VAR eintrag :: name (t,i);{}    IF eintrag enthaelt infix{}       THEN insert (tt, eintrag){}    FI{}  PER;{}  tt.{}  eintrag enthaelt infix:{}    type (old (eintrag)) = dateityp.{}END PROC infix namen;{}THESAURUS PROC  infix namen (THESAURUS CONST t,{}                             TEXT CONST infix 1, INT CONST dateityp):{}  THESAURUS VAR tt :: empty thesaurus;{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}
+    TEXT VAR eintrag :: name (t,i);{}    IF eintrag enthaelt infix{}       THEN insert (tt, eintrag){}    FI{}  PER;{}  tt.{}  eintrag enthaelt infix:{}   (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).{}END PROC infix namen;{}THESAURUS PROC  infix namen (THESAURUS CONST t,{}                             TEXT CONST infix 1, infix 2):{}  THESAURUS VAR tt :: empty thesaurus;{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}    TEXT VAR eintrag :: name (t,i);{}    IF eintrag enthaelt infix{}
+       THEN insert (tt, eintrag){}    FI{}  PER;{}  tt.{}  eintrag enthaelt infix:{}   (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix):{}  infix namen (ALL myself, infix){}END PROC infix namen;{}THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):{}  infix namen (ALL myself, infix 1, infix 2){}END PROC infix namen;{}THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):{}  THESAURUS VAR t :: empty thesaurus;{}
+  INT VAR zaehler;{}  FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP{}    IF name (thesaurus, zaehler) <> ""{}       AND pos (name (thesaurus, zaehler), praefix) = 1{}       THEN insert (t, subtext (name (thesaurus, zaehler),{}                                  length (praefix) + 1)){}    FI;{}  PER;{}  t{}END PROC ohne praefix;{}BOOL PROC not empty (THESAURUS CONST t):{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}    IF name (t, i) <> ""{}       THEN LEAVE not empty WITH TRUE{}
+    FI{}  PER;{}  FALSE{}END PROC not empty;{}PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):{}  IF   unzulaessige cursorwerte{}       THEN errorstop (fehlermeldung [1]){}  ELIF fenster ist zu klein{}       THEN errorstop (fehlermeldung [2]){}  FI.{}  unzulaessige cursorwerte:{}    (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1{}    COR xsize > 79 COR ysize > 24.{}  fenster ist zu klein:{}   (xsize) < 56 COR (ysize) < 15{}   COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).{}
+END PROC untersuche bildschirmmasszahlen;{}TEXT PROC ggf gekuerzter text (TEXT CONST text):{}   IF length (text) > (xsize - 5){}      THEN subtext (text, 1, xsize - 7) + ".."{}      ELSE text{}   FI{}END PROC ggf gekuerzter text;{}THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,{}                     THESAURUS CONST t,{}                     TEXT CONST t1, t2):{}  TEXT VAR text 1, text 2;{}  x := spa;{}  y := zei;{}  xsize := breite;{}  ysize := hoehe;{}  text 1 := ggf gekuerzter text (t1);{}
+  text 2 := ggf gekuerzter text (t2);{}  untersuche bildschirmmasszahlen (text 1, text 2);{}  auswahl (t, TRUE, text 1, text 2){}END PROC some;{}THESAURUS PROC some (INT CONST spa, zei,{}                     THESAURUS CONST t,{}                     TEXT CONST t1, t2):{}  some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){}END PROC some;{}THESAURUS PROC some (THESAURUS CONST t,{}                     TEXT CONST t1, t2):{}  some (1, 1, 79, 24, t, t1, t2){}END PROC some;{}TEXT PROC one (INT CONST spa, zei, breite, hoehe,{}
+               THESAURUS CONST t,{}               TEXT CONST t1, t2):{}  TEXT VAR text 1, text 2;{}  x := spa;{}  y := zei;{}  xsize := breite;{}  ysize := hoehe;{}  text 1 := ggf gekuerzter text (t1);{}  text 2 := ggf gekuerzter text (t2);{}  untersuche bildschirmmasszahlen (text 1, text 2);{}  name (auswahl (t, FALSE, text 1, text 2), 1){}END PROC one;{}TEXT PROC one (INT CONST spa, zei,{}               THESAURUS CONST t,{}               TEXT CONST t1, t2):{}  one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2){}
+END PROC one;{}TEXT PROC one  (THESAURUS CONST t, TEXT CONST t1, t2):{}  one (1, 1, 79, 24, t, t1, t2){}END PROC one;{}END PACKET ls dialog 2;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 3 b/app/gs.dialog/1.2/src/ls-DIALOG 3
new file mode 100644
index 0000000..dce6507
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 3
@@ -0,0 +1,48 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 3                     ** 
+          **                                                     ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls dialog 3  DEFINES{}       WINDOW, :=, window,{}       show, page, erase,{}       line, remaining lines,{}       cursor, get cursor,{}       out frame, out menuframe,{}       out, put, putline, editget,{}       get, getline, yes, no,{}       edit, center, stop,{}       area, areax, areay,{}       areaxsize, areaysize:{}LET piep          =      ""7"",{}    cr            =     ""13"";{}LET janeinkette   =   "jJyYnN",{}    blank         =        " ",{}    niltext       =         "";{}TYPE WINDOW = STRUCT (AREA fenster,{}
+                      INT cspalte, czeile, belegbare zeilen,{}                      BOOL fensterende erreicht);{}ROW 3 TEXT CONST aussage :: ROW 3 TEXT : ({}  " 'Window' ungültig!",{}  " (j/n) ?",{}  " Zum Weitermachen bitte irgendeine Taste tippen!"{}  );{}TEXT VAR number word, exit char;{}OP := (WINDOW VAR links, WINDOW CONST rechts):{}  CONCR (links) := CONCR (rechts){}END OP :=;{}WINDOW PROC window (INT CONST x, y, xsize, ysize):{}  WINDOW VAR w;{}  fill (w.fenster, x, y, xsize, ysize);{}  IF fenster ungueltig (w){}
+     THEN errorstop (aussage [1]){}  FI;{}  initialize (w);{}  w{}END PROC window;{}PROC initialize (WINDOW VAR w):{}  w.czeile               := 1;{}  w.cspalte              := 1;{}  w.fensterende erreicht := FALSE;{}  w.belegbare zeilen     := areaysize (w.fenster){}END PROC initialize;{}BOOL PROC fenster ungueltig (WINDOW CONST w):{}  IF     areax     (w.fenster) <  1  COR areax     (w.fenster) > 79{}     COR areay     (w.fenster) <  1  COR areay     (w.fenster) > 24{}     COR areaxsize (w.fenster) <  6  COR areaysize (w.fenster) <  3{}
+     COR areax (w.fenster) + areaxsize (w.fenster) > 80{}     COR areay (w.fenster) + areaysize (w.fenster) > 25{}     THEN TRUE{}     ELSE FALSE{}  FI.{}END PROC fenster ungueltig;{}PROC show (WINDOW VAR w):{}  zeige rahmen;{}  fenster putzen.{}  zeige rahmen:{}    out frame (w.fenster).{}  fenster putzen:{}    page (w).{}END PROC show;{}PROC page (WINDOW VAR w):{}  initialize (w);{}  page (w, FALSE){}END PROC page;{}PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):{}  IF areax     (w) = 1  AND areay     (w) =  1 AND{}
+     areaxsize (w) = 79 AND areaysize (w) = 24{}     THEN page;{}     ELSE loesche bereich{}  FI.{}  loesche bereich:{}    IF mit rahmen{}       THEN page (areax     (w) - 1, areay     (w) - 1,{}                  areaxsize (w) + 2, areaysize (w) + 2){}       ELSE page (area (w)){}    FI{}END PROC page;{}PROC erase (WINDOW VAR w):{}  page (w, TRUE){}END PROC erase;{}PROC line (WINDOW VAR w):{}  w.cspalte := 1;{}  IF w.czeile < w.belegbare zeilen{}     THEN w.czeile INCR 1;{}     ELSE w.czeile  :=  1;{}
+          w.fensterende erreicht := TRUE{}  FI;{}  cursor (w, w.cspalte, w.czeile){}END PROC line;{}PROC line (WINDOW VAR w, INT CONST anzahl):{}  INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER{}END PROC line;{}INT PROC remaining lines (WINDOW CONST w):{}  INT VAR spalte, zeile;{}  get cursor (w, spalte, zeile);{}  IF spalte = 0 OR zeile = 0{}     THEN 0{}     ELSE w.belegbare zeilen - w.czeile{}  FI{}END PROC remaining lines;{}PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):{}  IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w){}
+     THEN page (w);{}     ELSE w.cspalte := spalte; w.czeile  := zeile;{}  FI;{}  cursor (w.fenster, w.cspalte, w.czeile){}END PROC cursor;{}PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):{}  IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster)){}                          OR{}     (w.czeile  < 1) OR (w.czeile  > areaysize (w.fenster)){}     THEN spalte := 0;         zeile := 0{}     ELSE spalte := w.cspalte; zeile := w.czeile{}  FI{}END PROC get cursor;{}PROC out (WINDOW VAR w, TEXT CONST text):{}
+  INT VAR restlaenge;{}  IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster)){}                           AND{}     (w.czeile  >= 1) AND (w.czeile  <= w.belegbare zeilen){}     THEN putze ggf fenster;{}          cursor (w.fenster, w.cspalte, w.czeile);{}          outtext (text, 1, textende);{}          setze fenstercursor neu;{}          setze ausgabe ggf in naechster zeile fort{}  FI.{}  putze ggf fenster:{}    IF w.fensterende erreicht{}       THEN page (w);{}            w.fensterende erreicht := FALSE{}
+    FI.{}  textende:{}    restlaenge := areaxsize (w.fenster) - w.cspalte + 1;{}    min (length (text), restlaenge).{}  setze fenstercursor neu:{}    IF length (text) >= restlaenge{}       THEN w.cspalte  := 1;{}            w.czeile INCR 1;{}            schlage ggf neue seite auf{}       ELSE w.cspalte INCR length (text){}    FI.{}  schlage ggf neue seite auf:{}    IF w.czeile > w.belegbare zeilen{}       THEN page (w);{}            w.czeile := 1{}    FI.{}  setze ausgabe ggf in naechster zeile fort:{}
+    IF length (text) > restlaenge{}       THEN out (w, subtext (text, restlaenge + 1)){}    FI.{}END PROC out;{}PROC out frame (WINDOW VAR w):{}  out frame (area (w)){}END PROC out frame;{}PROC out menuframe (WINDOW VAR w):{}  out menu frame (area (w)){}END PROC out menuframe;{}PROC put (WINDOW VAR w, TEXT CONST word):{}  out (w, word); out (w, blank){}END PROC put;{}PROC put (WINDOW VAR w, INT CONST number):{}  put (w, text (number)){}END PROC put;{}PROC put (WINDOW VAR w, REAL VAR number):{}  put (w, text (number)){}
+END PROC put;{}PROC putline (WINDOW VAR w, TEXT CONST textline):{}  out (w, textline); line (w){}END PROC putline;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe,{}              INT CONST max laenge, scroll,{}              TEXT CONST sep, res, TEXT VAR exit char):{}  INT VAR spalte, zeile;{}  ggf zur naechsten zeile;{}  get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);{}  editget (ausgabe, max laenge, min (scroll, restlaenge),{}           sep, res, exitchar);{}  get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).{}
+  ggf zur naechsten zeile:{}    IF restlaenge < 5 THEN line (w) FI.{}  restlaenge:{}    areaxsize (w.fenster) - w.cspalte - 1.{}END PROC editget;{}PROC editget (WINDOW VAR w, TEXT VAR ausgabe):{}   TEXT VAR dummy;{}   editget (w, ausgabe, 79, 79, "", "", dummy){}END PROC editget;{}PROC get (WINDOW VAR w, TEXT VAR word):{}  INT VAR spa, zei;{}  ggf zur naechsten zeile;{}  get cursor (spa, zei); cursor on; cursor (spa, zei);{}  REP{}    word := "";{}    editget (word, maxtextlength, restlaenge, " ", "", exit char);{}
+    out (w, subtext (word, 1, restlaenge));{}    IF compress (word) <> ""{}       THEN echoe exit char (w){}    FI{}  UNTIL word <> niltext AND word <> blank PER;{}  get cursor (spa, zei); cursor off; cursor (spa, zei);{}  delete leading blanks.{}  ggf zur naechsten zeile:{}    IF restlaenge < 5 THEN line (w) FI.{}  restlaenge:{}    areaxsize (w.fenster) - w.cspalte - 1.{}  delete leading blanks:{}    WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.{}END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):{}
+  INT VAR spa, zei;{}  ggf zur naechsten zeile;{}  get cursor (spa, zei); cursor on; cursor (spa, zei);{}  REP{}    word := "";{}    editget (word, maxtextlength, restlaenge, separator, "", exit char);{}    out (w, subtext (word, 1, restlaenge));{}    echoe exit char (w);{}  UNTIL word <> niltext AND word <> blank PER;{}  get cursor (spa, zei); cursor off; cursor (spa, zei).{}  ggf zur naechsten zeile:{}    IF restlaenge < 5 THEN line (w) FI.{}  restlaenge:{}    areaxsize (w.fenster) - w.cspalte - 1.{}
+END PROC get;{}PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):{}  INT VAR spa, zei;{}  ggf zur naechsten zeile;{}  get cursor (spa, zei); cursor on; cursor (spa, zei);{}  REP{}    word := "";{}    editget (word, maxtextlength, laenge, "", "", exit char);{}    out (w, subtext (word, 1, laenge));{}    echoe exit char (w){}  UNTIL word <> niltext AND word <> blank PER;{}  get cursor (spa, zei); cursor off; cursor (spa, zei).{}  ggf zur naechsten zeile:{}    IF restlaenge < 5 THEN line (w) FI.{}
+  restlaenge:{}    areaxsize (w.fenster) - w.cspalte - 1.{}  laenge:{}    min (length, restlaenge).{}END PROC get;{}PROC get (WINDOW VAR w, INT VAR number):{}  get (w, number word);{}  number := int (number word){}END PROC get;{}PROC get (WINDOW VAR w, REAL VAR number):{}  get  (w, number word);{}  number := real (number word){}END PROC get;{}PROC getline (WINDOW VAR w, TEXT VAR textline):{}  INT VAR spa, zei;{}  ggf zur naechsten zeile;{}  get cursor (spa, zei); cursor on; cursor (spa, zei);{}  REP{}
+    textline := "";{}    editget (textline, maxtextlength, restlaenge, "", "", exit char);{}    out (w, subtext (word, 1, restlaenge));{}    echoe exit char (w);{}  UNTIL textline <> niltext AND textline <> blank PER;{}  get cursor (spa, zei); cursor off; cursor (spa, zei).{}  ggf zur naechsten zeile:{}    IF restlaenge < 5 THEN line (w) FI.{}  restlaenge:{}    areaxsize (w.fenster) - w.cspalte - 1.{}END PROC getline;{}PROC echoe exit char (WINDOW VAR fenster):{}  IF exit char = cr{}     THEN line (fenster){}
+     ELSE out (fenster, exit char){}  FI{}END PROC echoe exit char;{}TEXT PROC center (WINDOW CONST w, TEXT CONST text):{}  IF length (text) >= areaxsize (w.fenster){}     THEN subtext (text, 1, areaxsize (w.fenster)){}     ELSE center  (areaxsize (w.fenster), text){}  FI{}END PROC center;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):{}  TEXT VAR   zeichen, interne frage :: frage;{}  interne frage CAT aussage [2];{}  wechsel ggf auf neue seite;{}  out (w, interne frage);{}  hole eingabezeichen;{}
+  werte zeichen aus.{}  wechsel ggf auf neue seite:{}    IF remaining lines (w) < 1{}       THEN page (w){}    FI.{}  hole eingabezeichen:{}    cursor on; clear buffer;{}    REP{}      inchar (zeichen);{}      piepse ggf{}    UNTIL pos (janeinkette, zeichen) > 0 PER;{}    out (w, blank + zeichen);{}    cursor off; line (w).{}  piepse ggf:{}    IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.{}  werte zeichen aus:{}    IF pos (janeinkette, zeichen) < 5{}       THEN TRUE{}       ELSE FALSE{}    FI.{}
+END PROC yes;{}PROC edit (WINDOW VAR w, FILE VAR f):{}  out frame (w.fenster);{}  loesche rechte spalten (w);{}  cursor on;{}  edit (f, areax     (w.fenster),     areay     (w.fenster),{}           areaxsize (w.fenster) - 1, areaysize (w.fenster));{}  cursor off{}END PROC edit;{}PROC edit (WINDOW VAR w, TEXT CONST dateiname):{}  FILE VAR f :: sequential file (modify, dateiname);{}  to line (f, 1);{}  edit (w, f){}END PROC edit;{}PROC show (WINDOW VAR w, FILE VAR f):{}  out frame (w.fenster);{}  loesche rechte spalten (w);{}
+  open editor (groesster editor + 1, f, FALSE,{}               areax     (w.fenster),     areay     (w.fenster),{}               areaxsize (w.fenster) - 1, areaysize (w.fenster));{}  cursor on;{}  edit (groesster editor, "eqvw19dpgn"9"",{}                          PROC (TEXT CONST) std kommando interpreter);{}  cursor off{}END PROC show;{}PROC show (WINDOW VAR w, TEXT CONST dateiname):{}  FILE VAR f :: sequential file (modify, dateiname);{}  to line (f, 1);{}  show (w, f){}END PROC show;{}PROC loesche rechte spalten (WINDOW VAR w):{}
+  INT VAR i;{}  FOR i FROM 1 UPTO areaysize (w.fenster) REP{}    cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank){}  PER{}END PROC loesche rechte spalten;{}BOOL PROC no (WINDOW VAR w, TEXT CONST frage):{}  NOT yes (w, frage){}END PROC no;{}PROC stop (WINDOW VAR w):{}  stop (w, 2){}END PROC stop;{}PROC stop (WINDOW VAR w, INT CONST zeilenzahl):{}  INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;{}  out (w, aussage [3]);{}  pause{}END PROC stop;{}AREA PROC area (WINDOW CONST w):{}
+  w.fenster{}END PROC area;{}INT PROC areax (WINDOW CONST w):{}  areax (w.fenster){}END PROC areax;{}INT PROC areay (WINDOW CONST w):{}  areay (w.fenster){}END PROC areay;{}INT PROC areaxsize (WINDOW CONST w):{}  areaxsize (w.fenster){}END PROC areaxsize;{}INT PROC areaysize (WINDOW CONST w):{}  areaysize (w.fenster){}END PROC areaysize;{}END PACKET ls dialog 3;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 4 b/app/gs.dialog/1.2/src/ls-DIALOG 4
new file mode 100644
index 0000000..7c9d9c4
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 4
@@ -0,0 +1,71 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 4                     ** 
+          **                                                     ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET  ls dialog 4  DEFINES{}       boxinfo,{}       boxnotice,{}       boxalternative,{}       boxyes,{}       boxno,{}       boxanswer,{}       boxone,{}       boxanswerone,{}       boxsome,{}       boxanswersome,{}       out footnote,{}       erase footnote:{}LET mark ein                 =           ""15"",{}    mark aus                 =           ""14"",{}    delimiter                =           ""13"",{}    piep                     =            ""7"",{}    rechts links esc  return = ""2""8""27""13"",{}
+    rechts links null return = ""2""8""0""13"" ,{}    blank                    =              " ",{}    niltext                  =               "",{}    janeintasten             =         "jJyYnN";{}ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ({}" Zum Weitermachen bitte irgendeine Taste tippen!",{}" Ändern: <Pfeile>  Bestätigen: <RETURN>  Abbruch: <ESC> <h>",{}" Ändern: <Pfeile>  Bestätigen: <RETURN>  Ja: <j>  Nein: <n>",{}" Ändern: <Pfeile>  Bestätigen: <RETURN>",{}" Fertig: <RETURN>  Zeigen: <ESC><z>  Abbruch: <ESC><h>",{}
+" Fertig: <RETURN>  Abbruch: <ESC><h>",{}"Ja"13"Nein",{}" Eingabe: "{});{}PROC boxinfo (WINDOW VAR w, TEXT CONST t,{}              INT CONST position, timelimit,{}              INT VAR x, y, xsize, ysize):{}  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{}  cursor (w, spa, zei);{}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,{}                            timelimit, BOOL CONST trennlinie weg):{}  INT VAR x, y, xsize, ysize, spa, zei;{}
+  get cursor (w, spa, zei);{}  schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{}  page up (x, y, xsize, ysize);{}  IF trennlinie weg{}     THEN erase footnote (w, TRUE){}     ELSE erase footnote (w, FALSE){}  FI;{}  cursor (w, spa, zei){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):{}  boxinfo (w, t, position, timelimit, TRUE){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t):{}  boxinfo (w, t, 5, maxint, TRUE){}END PROC boxinfo;{}
+PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,{}                              INT VAR x, y, xsize, ysize):{}  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  schreibe notiz (w, t, position, x, y, xsize, ysize);{}  cursor (w, spa, zei){}END PROC boxnotice;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{}                         auswahlliste, zusatztasten,{}                         INT CONST position, BOOL CONST mit abbruch,{}                         INT VAR x, y, xsize, ysize):{}
+  INT VAR ergebnis, spa, zei;{}  get cursor (w, spa, zei);{}  schreibe alternativen (w, t, auswahlliste, zusatztasten, position,{}                         mit abbruch, x, y, xsize, ysize, ergebnis);{}  cursor (w, spa, zei);{}  ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,{}                         zusatztasten, INT CONST position,{}                         BOOL CONST mit abbruch, trennlinie weg):{}  INT VAR x, y, xsize, ysize, ergebnis, spa, zei;{}
+  get cursor (w, spa, zei);{}  ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,{}                                 mit abbruch, x, y, xsize, ysize);{}  page up (x, y, xsize, ysize);{}  IF trennlinie weg{}     THEN erase footnote (w, TRUE){}     ELSE erase footnote (w, FALSE){}  FI;{}  cursor (w, spa, zei);{}  ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{}                         auswahlliste, zusatztasten,{}                         INT CONST position, BOOL CONST mit abbruch):{}
+  boxalternative (w, t, auswahlliste, zusatztasten,{}                        position, mit abbruch, TRUE){}END PROC boxalternative;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,{}                                INT VAR x, y, xsize, ysize):{}   INT VAR spa, zei;{}   get cursor (w, spa, zei);{}   BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);{}   cursor (w, spa, zei);{}   wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,{}                  INT CONST position, BOOL CONST trennlinie weg):{}
+  INT VAR x, y, xsize, ysize, spa, zei;{}  get cursor (w, spa, zei);{}  BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);{}  page up (x, y, xsize, ysize);{}  IF trennlinie weg{}     THEN erase footnote (w, TRUE){}     ELSE erase footnote (w, FALSE);{}  FI;{}  cursor (w, spa, zei);{}  wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):{}  boxyes (w, t, position, TRUE){}END PROC boxyes;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,{}
+                               INT VAR x, y, xsize, ysize):{}   NOT boxyes (w, t, position, x, y, xsize, ysize){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,{}                 INT CONST position, BOOL CONST trennlinie weg):{}  NOT boxyes (w, t, position, trennlinie weg){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):{}  boxno (w, t, position){}END PROC boxno;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{}                     INT CONST position, INT VAR x, y, xsize, ysize):{}
+  INT VAR spa, zei;{}  TEXT VAR wert;{}  get cursor (w, spa, zei);{}  wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);{}  cursor (spa, zei);{}  wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{}                     INT CONST position, BOOL CONST trennlinie weg):{}  INT VAR x, y, xsize, ysize, spa, zei;{}  get cursor (w, spa, zei);{}  TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,{}                                 x, y, xsize, ysize);{}
+  page up (x, y, xsize, ysize);{}  IF trennlinie weg{}     THEN erase footnote (w, TRUE){}     ELSE erase footnote (w, FALSE){}  FI;{}  cursor (w, spa, zei);{}  wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{}                                   INT CONST position):{}  boxanswer (w, t, vorgabe, position, TRUE){}END PROC boxanswer;{}TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,{}                  TEXT CONST text1, text2, BOOL CONST mit reinigung):{}
+  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  TEXT VAR wert :: one (areax     (w) + 2, areay     (w) + 2,{}                        areaxsize (w) - 4, areaysize (w) - 2,{}                        thesaurus, text1, text2);{}  IF mit reinigung{}     THEN page up (areax     (w) + 2, areay     (w) + 2,{}                   areaxsize (w) - 4, areaysize (w) - 2);{}          erase footnote (w){}  FI;{}  cursor (w, spa, zei);{}  wert{}END PROC boxone;{}TEXT PROC boxanswerone  (WINDOW VAR w, TEXT CONST text, vorgabe,{}
+                         THESAURUS CONST thesaurus, TEXT CONST t1, t2,{}                         BOOL CONST mit reinigung, trennlinie weg):{}  INT VAR x,y, xsize, ysize, spa, zei;{}  get cursor (w, spa, zei);{}  TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{}                                 x, y, xsize, ysize);{}  IF wert = ""27"z"{}     THEN lasse auswaehlen{}     ELSE uebernimm den wert{}  FI;{}  cursor (w, spa, zei);{}  wert.{}  lasse auswaehlen:{}    IF mit reinigung{}       THEN wert := boxone (w, thesaurus, t1, t2, TRUE ){}
+       ELSE wert := boxone (w, thesaurus, t1, t2, FALSE){}    FI.{}  uebernimm den wert:{}    IF mit reinigung{}       THEN page up (x, y, xsize, ysize);{}            entferne ggf die trennlinie{}    FI.{}  entferne ggf die trennlinie:{}    IF trennlinie weg{}       THEN erase footnote (w, TRUE){}       ELSE erase footnote (w, FALSE){}    FI.{}END PROC boxanswer one;{}TEXT PROC boxanswerone  (WINDOW VAR w, TEXT CONST text, vorgabe,{}                         THESAURUS CONST thesaurus, TEXT CONST t1, t2,{}
+                         BOOL CONST mit reinigung):{}  boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswer one;{}THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,{}                        TEXT CONST text1, text2,{}                        BOOL CONST mit reinigung):{}  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  THESAURUS VAR wert :: some (areax     (w) + 2, areay     (w) + 2,{}                              areaxsize (w) - 4, areaysize (w) - 2,{}
+                              thesaurus, text1, text2);{}  IF mit reinigung{}     THEN page up (areax     (w) + 2, areay     (w) + 2,{}                   areaxsize (w) - 4, areaysize (w) - 2);{}          erase footnote (w){}  FI;{}  cursor (w, spa, zei);{}  wert{}END PROC boxsome;{}THESAURUS PROC boxanswersome  (WINDOW VAR w, TEXT CONST text, vorgabe,{}                               THESAURUS CONST thesaurus,{}                               TEXT CONST t1, t2,{}                               BOOL CONST mit reinigung, trennlinie weg):{}
+  THESAURUS VAR ergebnis :: empty thesaurus;{}  INT VAR x, y, xsize, ysize, spa, zei;{}  get cursor (w, spa, zei);{}  TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{}                                 x, y, xsize, ysize);{}  IF wert = ""27"z"{}     THEN lasse auswaehlen{}     ELSE uebernimm den wert{}  FI;{}  cursor (w, spa, zei);{}  ergebnis.{}  lasse auswaehlen:{}    IF mit reinigung{}       THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ){}       ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE){}
+    FI.{}  uebernimm den wert:{}    IF wert <> niltext{}       THEN insert (ergebnis, wert){}    FI;{}    IF mit reinigung{}       THEN page up (x, y, xsize, ysize);{}            entferne ggf die trennlinie{}    FI.{}  entferne ggf die trennlinie:{}    IF trennlinie weg{}       THEN erase footnote (w, TRUE){}       ELSE erase footnote (w, FALSE){}    FI.{}END PROC boxanswer some;{}THESAURUS PROC boxanswersome  (WINDOW VAR w, TEXT CONST text, vorgabe,{}                               THESAURUS CONST thesaurus,{}
+                               TEXT CONST t1, t2,{}                               BOOL CONST mit reinigung):{}  boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswersome;{}PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):{}  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  IF mit trennlinie{}     THEN cursor (w, 1,  areaysize (w) - 1);{}          areaxsize (w) TIMESOUT waagerecht{}  FI;{}  cursor (w, 1,  areaysize (w));{}  outtext (text, 1, areaxsize (w));{}
+  cursor (w, spa, zei){}END PROC out footnote;{}PROC out footnote (WINDOW VAR w, TEXT CONST t):{}  out footnote (w, TRUE, t){}END PROC out footnote;{}PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):{}  INT VAR spa, zei;{}  get cursor (w, spa, zei);{}  IF auch trennlinie{}     THEN cursor (w, 1, areaysize (w) - 1);{}          outtext ("", 1, areaxsize (w)){}  FI;{}  cursor (w, 1, areaysize (w));{}  outtext ("", 1, areaxsize (w));{}  cursor (w, spa, zei){}END PROC erase footnote;{}PROC erase footnote (WINDOW VAR w):{}
+  erase footnote (w, TRUE){}END PROC erase footnote;{}PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,{}                       INT CONST position, zusatzlaenge,{}                                 mindestbreite, mindesthoehe,{}                       INT VAR x, y, xsize, ysize):{}  ermittle boxbreite und boxhoehe;{}  ermittle rahmenwerte;{}  schreibe boxkopf;{}  schreibe boxrumpf.{}  ermittle boxbreite und boxhoehe:{}    TEXT VAR intern :: t + delimiter;{}    entferne fuehrende delimiter;{}    INT VAR  anfang :: 1,{}
+             ende   :: pos (intern, delimiter, anfang) - 1;{}    xsize := 0;{}    ysize := 0;{}    WHILE ende > 0 REP{}      ysize INCR 1;{}      lege ggf boxbreite fest;{}      bestimme neue positionen{}    PER.{}  entferne fuehrende delimiter:{}    WHILE (intern SUB 1) = delimiter REP{}      intern := subtext (intern, 2){}    PER.{}  lege ggf boxbreite fest:{}    IF length (subtext (intern, anfang, ende)) > xsize{}       THEN xsize := length (subtext (intern, anfang, ende)){}    FI.{}  bestimme neue positionen:{}
+    anfang := ende + 2;{}    ende   := pos (intern, delimiter, anfang) - 1.{}  ermittle rahmenwerte:{}    schlage notwendige groessen auf;{}    kill ueberlaengen;{}    lege bildschirmpositionen fest.{}  schlage notwendige groessen auf:{}    IF xsize < mindestbreite{}       THEN xsize := mindestbreite{}    FI;{}    IF ysize < mindesthoehe{}       THEN ysize := mindesthoehe{}    FI;{}    ysize INCR zusatzlaenge;{}    ysize INCR 2;  (* Für den Rahmen *){}    xsize INCR 2.  (* Für den Rahmen *){}  kill ueberlaengen:{}
+    IF ysize > (areaysize (w) - 4){}       THEN ysize := areaysize (w) - 4{}    FI;{}    IF xsize > (areaxsize (w) - 4){}       THEN xsize := areaxsize (w) - 4{}    FI.{}  lege bildschirmpositionen fest:{}    SELECT position OF{}      CASE 1: plazierung links  oben{}      CASE 2: plazierung rechts oben{}      CASE 3: plazierung links  unten{}      CASE 4: plazierung rechts unten{}      OTHERWISE plazierung im zentrum{}    END SELECT.{}  plazierung links oben:{}    x := areax (w) + 2;{}    y := areay (w) + 2.{}
+  plazierung rechts oben:{}    x := areax (w) + areaxsize (w) - xsize - 2;{}    y := areay (w) + 2.{}  plazierung links unten:{}    x := areax (w) + 2;{}    y := areay (w) + areaysize (w) - ysize - 2.{}  plazierung rechts unten:{}    x := areax (w) + areaxsize (w) - xsize - 2;{}    y := areay (w) + areaysize (w) - ysize - 2.{}  plazierung im zentrum:{}    x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;{}    y := areay (w) + ((areaysize (w) - ysize)       DIV 2).{}  schreibe boxkopf:{}
+    cursor (x, y);{}    out (ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke oben rechts).{}  schreibe boxrumpf:{}    INT VAR i;{}    intern := t + delimiter;{}    entferne fuehrende delimiter;{}    anfang := 1;{}    ende   := pos (intern, delimiter, anfang) - 1;{}    FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP{}      cursor (x, i);{}      out (senkrecht);{}      outtext (subtext (intern, anfang, ende), 1, xsize - 2);{}      out (senkrecht);{}      anfang := ende + 2;{}
+      ende   := pos (intern, delimiter, anfang) - 1{}    PER{}END PROC schreibe boxtext;{}PROC schreibe boxfuss (WINDOW VAR w,{}                       INT CONST x, y, xsize, ysize, limit):{}  schreibe abschlusszeile;{}  out footnote (w, aussage [1]);{}  cursor in position und warten.{}  schreibe abschlusszeile:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten  rechts).{}  cursor in position und warten:{}    cursor parken (w);{}
+    clear buffer;{}    pause (limit){}END PROC schreibe boxfuss;{}PROC cursor parken (WINDOW VAR w):{}  cursor (w, 1, 2){}END PROC cursor parken;{}PROC schreibe box (WINDOW VAR w, TEXT CONST t,{}                   INT CONST position, timelimit,{}                   INT VAR x, y, xsize, ysize):{}  schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{}  schreibe boxfuss (w, x, y, xsize, ysize, timelimit){}END PROC schreibe box;{}PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):{}
+  schreibe abschlusszeile;{}  cursor parken (w).{}  schreibe abschlusszeile:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}END PROC schreibe notizfuss;{}PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,{}                     INT VAR x, y, xsize, ysize):{}  schreibe boxtext   (w, t, position, 0, 0, 0, x, y, xsize, ysize);{}  schreibe notizfuss (w, x, y, xsize, ysize){}END PROC schreibe notiz;{}PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,{}
+                            INT CONST position, BOOL CONST mit abbruch,{}                            INT VAR x, y, xsize, ysize, ergebnis):{}  ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;{}  normiere alternativen;{}  untersuche alternativen;{}  schreibe boxtext (w, textintern, position, 2, altbreite,{}                    0, x, y, xsize, ysize);{}  schreibe alternativenfuss;{}  lasse auswaehlen;{}  liefere ergebnis.{}  textintern:{}    IF sonst = janeintasten{}       THEN TEXT VAR zwischen;{}
+            zwischen := t;{}            kuerze um folgende blanks;{}            zwischen + "? "{}       ELSE t{}    FI.{}  kuerze um folgende blanks:{}    WHILE (zwischen SUB (length (zwischen))) = blank REP{}      zwischen := subtext (zwischen , 1, length (zwischen) - 1){}    PER.{}  normiere alternativen:{}    TEXT VAR altintern :: altzeile;{}    altintern CAT delimiter.{}  untersuche alternativen:{}    INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,{}            ende :: pos (altintern, delimiter, anfang) - 1;{}
+    WHILE ende > 0 AND altanzahl <= 10 REP{}      trage alternative ein;{}      trage alternativenanfang ein;{}      trage alternativenlaenge ein;{}      setze neue positionen fest{}    PER;{}    ermittle gesamtalternativenbreite.{}  trage alternative ein:{}    altliste [altanzahl].alternat :={}                               compress (subtext (altintern, anfang, ende)).{}  trage alternativenanfang ein:{}    first INCR 3;{}    altliste [altanzahl].anfang   := first.{}  trage alternativenlaenge ein:{}
+    altliste [altanzahl].laenge   := length (altliste [altanzahl].alternat);{}    first INCR altliste [altanzahl].laenge.{}  setze neue positionen fest:{}    anfang := ende + 2;{}    ende   := pos (altintern, delimiter, anfang) - 1;{}    altanzahl INCR 1.{}  ermittle gesamtalternativenbreite:{}    altanzahl DECR 1;{}    altbreite :=    altliste [altanzahl].anfang;{}    altbreite INCR (altliste [altanzahl].laenge + 3);{}    IF altbreite > areaxsize (w) - 6{}       THEN LEAVE schreibe alternativen{}
+    FI.{}  schreibe alternativenfuss:{}    schreibe leerzeile;{}    schreibe antwortmoeglichkeiten;{}    schreibe abschlusszeile;{}    IF mit abbruch{}       THEN out footnote (w, aussage [2]){}       ELSE beruecksichtige ja nein hinweis{}    FI.{}  schreibe leerzeile:{}    cursor (x, y + ysize - 3);{}    out (senkrecht);{}    (xsize - 2) TIMESOUT blank;{}    out (senkrecht).{}  schreibe antwortmoeglichkeiten:{}    cursor (x, y + ysize - 2);{}    out (senkrecht);{}    einrueckbreite TIMESOUT blank;{}
+    out (antwortleiste);{}    rest TIMESOUT blank;{}    out (senkrecht).{}  einrueckbreite:{}    (xsize - 2 - length (antwortleiste)) DIV 2.{}  antwortleiste:{}    INT VAR zeiger; TEXT VAR ausgabe :: "";{}    FOR zeiger FROM 1 UPTO altanzahl REP{}      ausgabe CAT altliste [zeiger].alternat;{}      ausgabe CAT "   "{}    PER;{}    compress (ausgabe).{}  rest:{}    xsize - 2 - einrueckbreite - length (antwortleiste).{}  schreibe abschlusszeile:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}
+    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}  beruecksichtige ja nein hinweis:{}     IF sonst = janeintasten{}        THEN out footnote (w, aussage [3]){}        ELSE out footnote (w, aussage [4]){}     FI.{}  lasse auswaehlen:{}    INT VAR altzeiger :: 1;{}    stelle erste alternative invers dar;{}    REP{}      hole eingabe;{}      werte eingabe aus und reagiere{}    UNTIL alternative gefunden PER.{}  stelle erste alternative invers dar:{}    cursor (x + einrueckbreite, y + ysize - 2);{}
+    out (mark ein);{}    out (altliste [altzeiger].alternat); out (blank);{}    out (mark aus);{}    cursor (x + einrueckbreite, y + ysize - 2).{}  hole eingabe:{}    TEXT VAR moegliche, eingabe;{}    IF mit abbruch{}       THEN moegliche := rechts links esc  return + sonst{}       ELSE moegliche := rechts links null return + sonst{}    FI;{}    clear buffer;{}    REP{}      inchar (eingabe);{}      piepse bei unzulaessiger eingabe{}    UNTIL pos (moegliche, eingabe) > 0 PER.{}  piepse bei unzulaessiger eingabe:{}
+    IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.{}  werte eingabe aus und reagiere:{}    SELECT pos (moegliche, eingabe) OF{}      CASE 1: zur naechsten alternative{}      CASE 2: zur vorausgehenden alternative{}      CASE 3: esc kommando verarbeiten{}    END SELECT.{}  zur naechsten alternative:{}    loesche aktuelle alternative;{}    ermittle rechte alternative;{}    stelle neue alternative invers dar.{}  zur vorausgehenden alternative:{}    loesche aktuelle alternative;{}    ermittle linke alternative;{}
+    stelle neue alternative invers dar.{}  loesche aktuelle alternative:{}    cursor (alternativenanfang - 1, y + ysize - 2);{}    out (blank);{}    out (altliste [altzeiger].alternat);{}    out (2 * blank).{}  alternativenanfang:{}    x + einrueckbreite + altliste [altzeiger].anfang.{}  ermittle rechte alternative:{}    IF altzeiger = altanzahl{}       THEN altzeiger :=   1{}       ELSE altzeiger INCR 1{}    FI.{}  ermittle linke alternative:{}    IF altzeiger = 1{}       THEN altzeiger := altanzahl{}
+       ELSE altzeiger DECR 1{}    FI.{}  stelle neue alternative invers dar:{}    cursor (alternativenanfang - 1, y + ysize - 2);{}    out (mark ein);{}    out (altliste [altzeiger].alternat); out (blank);{}    out (mark aus);{}    cursor (alternativenanfang - 1, y + ysize - 2).{}  esc kommando verarbeiten:{}    inchar (eingabe);{}    IF eingabe = "h"{}       THEN ergebnis := 0;{}            LEAVE schreibe alternativen{}       ELSE out (piep); eingabe := ""{}    FI.{}  alternative gefunden:{}    pos (moegliche, eingabe) > 3.{}
+  liefere ergebnis:{}    IF pos (moegliche, eingabe) = 4{}       THEN ergebnis := altzeiger{}       ELSE ergebnis := 100 + pos (sonst, eingabe){}    FI.{}END PROC schreibe alternativen;{}BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,{}               INT VAR x, y, xsize, ysize):{}  INT VAR ergebnis;{}  schreibe alternativen (w, t, aussage [7], janeintasten, position,{}                         FALSE, x, y, xsize, ysize, ergebnis);{}  SELECT ergebnis OF{}    CASE 2, 105, 106: FALSE{}    OTHERWISE TRUE{}
+  END SELECT.{}END PROC ja;{}TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,{}                        INT CONST position, BOOL CONST mit auswahl,{}                        INT VAR x, y, xsize, ysize):{}  TEXT VAR eingabe :: compress (vorgabe);{}  schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,{}                    x, y, xsize, ysize);{}  schreibe antwortfuss;{}  clear buffer;{}  REP{}    IF eingabe = "break"{}       THEN eingabe := ""{}    FI;{}    lasse eintragen{}
+  UNTIL eingabe <> "break" PER;{}  liefere ergebnis.{}  schreibe antwortfuss:{}    schreibe leerzeile;{}    schreibe eingabezeile;{}    schreibe abschlusszeile;{}    IF mit auswahl{}       THEN out footnote (w, aussage [5]){}       ELSE out footnote (w, aussage [6]){}    FI.{}  schreibe leerzeile:{}    cursor (x, y + ysize - 3);{}    out (senkrecht);{}    (xsize - 2) TIMESOUT blank;{}    out (senkrecht).{}  schreibe eingabezeile:{}    cursor (x, y + ysize - 2);{}    out (senkrecht);{}    out (aussage [8]);{}
+    (xsize - 2 - length (aussage [8])) TIMESOUT blank;{}    out (senkrecht).{}  schreibe abschlusszeile:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}  lasse eintragen:{}    TEXT VAR exit :: "";{}    cursor on;{}    cursor (x + length (aussage [8]) + 1, y + ysize - 2);{}    IF mit auswahl{}       THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit){}       ELSE editget (eingabe, maxtextlength, textlaenge, "", "h",  exit){}
+    FI;{}    cursor off;{}    IF exit = ""27"h"{}       THEN eingabe := ""{}    ELIF mit auswahl AND (exit = ""27"z"){}       THEN eingabe := ""27"z"{}    ELSE eingabe := compress (eingabe){}    FI.{}  textlaenge:{}    xsize - 2 - length (aussage [8]).{}  liefere ergebnis:{}    eingabe.{}END PROC hole antwort;{}END PACKET ls dialog 4;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 5 b/app/gs.dialog/1.2/src/ls-DIALOG 5
new file mode 100644
index 0000000..1772b99
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 5
@@ -0,0 +1,118 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 5                     ** 
+          **                                                     ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET  ls dialog 5 DEFINES{}       menufootnote, old menufootnote,{}       menuinfo,menualternative,{}       menuyes, menuno, menuone,{}       menusome,menuanswer,{}       menuanswerone, menuanswersome,{}       install menu, handle menu,{}       refresh submenu, deactivate,{}       regenerate menuscreen, activate,{}       write menunotice, erase menunotice,{}       menubasistext, anwendungstext,{}       show menuwindow, menuwindowpage,{}       menuwindowout, menuwindowget,{}       menuwindoweditget, menuwindowedit,{}
+       menuwindowshow, menuwindowline,{}       menuwindowyes, menuwindowno,{}       menuwindowcursor, get menuwindowcursor,{}       remaining menuwindowlines,{}       menuwindowcenter, menuwindowstop,{}       editorinformationen,stdinfoedit,{}       menukartenname, current menuwindow,{}       reset dialog, only intern, ausstieg,{}       direktstart:{}LET systemkuerzel         =  "ls-DIALOG",{}    menutafeltaskname     =  "ls-MENUKARTEN",{}    menutafeltype         =   1954,{}    menutafelpraefix      =  "ls-MENUKARTE:",{}
+    stdmenukartenname     =  "ls-MENUKARTE:Archiv",{}    versionsnummer        =  "1.1",{}    copyright1            =  " (C) 1987/88 Eva Latta-Weber",{}    copyright2            =  " (C) 1988 ERGOS GmbH";{}LET maxmenus              =      6,{}    maxmenutexte          =    300,{}    maxinfotexte          =   2000,{}    maxhauptmenupunkte    =     10,{}    maxuntermenupunkte    =     15,{}    erste untermenuzeile  =      3;{}LET blank                 =    " ",{}    piep                  =  ""7"",{}
+    cleol                 =  ""5"",{}    cleop                 =  ""4"",{}    trennzeilensymbol     =  "###",{}    bleibt leer symbol    =  "***",{}    hauptmenuluecke       =   "  ";{}LET auswahlstring1        =  ""8""2""10""3""13""27"?";{}TYPE MENUPUNKT   = STRUCT (TEXT punktkuerzel,{}                                punktname,{}                                procname,{}                                boxtext,{}                           BOOL aktiv,{}                                angewaehlt),{}
+     EINZELMENU  = STRUCT (INT  belegt,{}                           TEXT ueberschrift,{}                           INT  anfangsposition,{}                                maxlaenge,{}                           ROW  maxuntermenupunkte MENUPUNKT menupunkt,{}                           INT  aktueller untermenupunkt,{}                           TEXT startprozedurname,{}                                leaveprozedurname),{}     MENU        = STRUCT (TEXT menuname,{}                           INT  anzahl hauptmenupunkte,{}
+                           ROW  maxhauptmenupunkte EINZELMENU einzelmenu,{}                           TEXT menueingangsprozedur,{}                                menuausgangsprozedur,{}                                menuinfo,{}                                lizenznummer,{}                                versionsnummer,{}                           INT  hauptmenuzeiger,{}                                untermenuanfang,{}                                untermenuzeiger),{}     INFOTEXT    = STRUCT (INT anzahl infotexte,{}
+                           ROW maxinfotexte TEXT stelle),{}     MENUTEXT    = STRUCT (INT anzahl menutexte,{}                           ROW maxmenutexte TEXT platz),{}     MENULEISTE  = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{}                           ROW maxmenus MENU menu,{}                           MENUTEXT   menutext,{}                           INFOTEXT   infotext);{}BOUND MENULEISTE VAR menuleiste;{}DATASPACE VAR ds;{}WINDOW VAR menuwindow, schreibfenster, editorinfofenster;{}
+INITFLAG VAR in this task       ::         FALSE;{}INT VAR anzahl offener menus    ::             0;{}INT VAR menunotizx, menunotizxsize,{}        menunotizy, menunotizysize,{}        menunotizposition;{}TEXT VAR angekoppelte menutafel ::            "",{}         permanent footnote     ::            "",{}         menunotiztext;{}BOOL VAR menunotiz ist gesetzt  ::         FALSE,{}         nur interne verwendung ::         FALSE,{}         mit ausstieg          ::          FALSE;{}REAL VAR zeitpunkt              ::     clock (1);{}
+ROW 13 TEXT CONST fehlermeldung  :: ROW 13 TEXT : ({}"Die Task '" + menutafeltaskname + "' existiert nicht!",{}"Die Menukarte '",{}"' existiert nicht in der Task '" + menutafeltaskname + "'!",{}"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",{}"Das Menu '",{}"' ist nicht in der angekoppelten Menukarte!",{}"Zu viele geoeffnete Menus ( > 2 )!",{}"Kein Menu geoeffnet!",{}"Menu enthaelt keine Menupunkte!",{}"Menupunkt ist nicht im Menu enthalten!",{}"Kein Text vorhanden!",{}"Zugriff unmöglich!",{}
+"Einschränkung unzulässig!"{});{}ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : ({}"gibt es nicht"{});{}ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : ({}"Info:<ESC><?>/<?>  Wahl:<Pfeile>  Ausführen:<RETURN>  Verlassen:<ESC><q>",{}" Zum Weitermachen bitte irgendeine Taste tippen!",{}"Bitte warten ...  Ich räume auf!"{});{}ROW 3 TEXT CONST infotext :: ROW 3 TEXT : ({}" Für diesen Menupunkt ist (noch) keine "13""13"        Funktion eingetragen!",{}" Möchten Sie dieses Menu tatsächlich verlassen",{}" Leider ist zu diesem Menupunkt "13""13"  kein Info - Text eingetragen!"{}
+ );{}PROC install menu (TEXT CONST menutafelname):{}  installmenu (menutafelname, TRUE){}END PROC install menu;{}PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):{}  TEXT VAR letzter parameter;{}  IF mit kennung{}     THEN zeige menukennung{}  FI;{}  initialisiere menu ggf;{}  IF menutafel noch nicht angekoppelt{}     THEN letzter parameter := std;{}          hole menutafel;{}          kopple menutafel an;{}          last param (letzter parameter){}  FI.{}  initialisiere menu ggf:{}
+    IF NOT initialized (in this task){}       THEN angekoppelte menutafel :=    "";{}            anzahl offener menus   :=     0;{}            menunotiz ist gesetzt  := FALSE;{}            nur interne verwendung := FALSE{}    FI.{}  menutafel noch nicht angekoppelt:{}    menutafelname <> angekoppelte menutafel.{}  hole menutafel:{}    IF NOT exists task (menutafeltaskname){}       THEN bereinige situation; cursor on;{}            errorstop (fehlermeldung [1]){}    FI;{}    disable stop;{}    fetch (menutafelname, /menutafeltaskname);{}
+    IF   is error AND pos (errormessage, vergleichstext [1]) > 0{}         THEN clear error; enable stop;{}              bereinige situation; cursor on;{}              errorstop (fehlermeldung [2] + menutafelname +{}                         fehlermeldung [3]){}    ELIF is error{}         THEN clear error; enable stop;{}              bereinige situation; cursor on;{}              errorstop (errormessage){}   ELSE enable stop{}    FI.{}  kopple menutafel an:{}    IF type (old (menutafelname)) = menutafeltype{}
+       AND pos (menutafelname,menutafelpraefix) = 1{}       THEN forget (ds);{}            ds                     := old (menutafelname);{}            menuleiste             := ds;{}            angekoppelte menutafel := menutafelname;{}            forget (menutafelname, quiet){}       ELSE bereinige situation; cursor on;{}            errorstop ("'" + menutafelname + fehlermeldung [4]){}    FI.{}END PROC install menu;{}PROC only intern (BOOL CONST wert):{}  nur interne verwendung := wert{}END PROC only intern;{}
+PROC ausstieg (BOOL CONST wert):{}  mit ausstieg := wert{}END PROC ausstieg;{}TEXT PROC menukartenname:{}  IF NOT initialized (in this task){}     THEN   angekoppelte menutafel :=    "";{}            anzahl offener menus   :=     0;{}            menunotiz ist gesetzt  := FALSE;{}  FI;{}  angekoppelte menutafel{}END PROC menukartenname;{}PROC handle menu (TEXT CONST menuname):{}  nur interne verwendung := FALSE;{}  mit ausstieg           :=  TRUE;{}  handle menu (menuname, ""){}END PROC handle menu;{}
+PROC handle menu (TEXT CONST menuname, ausstiegsproc):{}  cursor off;{}  IF nur interne verwendung{}     THEN oeffne menu (menuname){}     ELSE biete menu an{}  FI;{}  lasse menupunkte auswaehlen;{}  IF nur interne verwendung{}     THEN do (ausstiegsproc);{}          anzahl offener menus DECR 1;{}          IF anzahl offener menus < 1 THEN erase menunotice FI;{}          menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{}          menuwindow := window (1,1,79, 24);{}          nur interne verwendung := FALSE;{}
+          mit ausstieg           := TRUE;{}          cursor on{}     ELSE schliesse menu;{}          leere ggf den bildschirm{}  FI.{}  biete menu an:{}    REAL VAR zwischenzeit :: clock (1) - zeitpunkt;{}    IF zwischenzeit < 2.0{}       THEN pause (20 - int (10.0 * zwischenzeit)){}    FI;{}    oeffne menu (menuname).{}  leere ggf den bildschirm:{}    IF anzahl offener menus < 1{}       THEN erase menunotice;{}            page; cursor on{}    FI.{}  lasse menupunkte auswaehlen:{}    TEXT VAR kuerzelkette :: "";{}
+    starte aktuelle untermenuoperationen;{}    REP{}      cursor in warteposition;{}      ermittle aktuelle kuerzelkette;{}      nimm zeichen auf;{}      interpretiere zeichen;{}    UNTIL menu verlassen gewuenscht PER.{}  nimm zeichen auf:{}    TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;{}    TEXT VAR eingabezeichen;{}    INT  VAR zeichenposition;{}    REP{}      inchar (eingabezeichen);{}      zeichenposition := pos (erlaubte zeichen, eingabezeichen);{}      piepse ggf{}    UNTIL zeichenposition > 0 PER.{}
+  piepse ggf:{}    IF zeichenposition = 0 THEN out (piep) FI.{}  menu verlassen gewuenscht:{}    zeichenposition = 6 AND (zweites zeichen = "q").{}  interpretiere zeichen:{}    SELECT zeichenposition OF{}      CASE 1: gehe einen hauptmenupunkt nach links{}      CASE 2: gehe einen hauptmenupunkt nach rechts{}      CASE 3: gehe einen untermenupunkt nach unten{}      CASE 4: gehe einen untermenupunkt nach oben{}      CASE 5: fuehre aktuellen menupunkt aus{}      CASE 6: hole esc sequenz{}      CASE 7: zeige erklaerungstext im menu an{}
+      OTHERWISE werte kuerzeleingabe aus{}    END SELECT.{}  gehe einen hauptmenupunkt nach links:{}    INT VAR anzahl schritte :: 1;{}    beende aktuelle untermenuoperationen;{}    loesche aktuelles untermenu auf bildschirm;{}    loesche alte hauptmenumarkierung;{}    anzahl schritte INCR clear buffer and count (""8"");{}    ermittle linke menuposition;{}    stelle aktuellen hauptmenupunkt invers dar;{}    starte aktuelle untermenuoperationen;{}    schreibe aktuelles untermenu auf bildschirm.{}  gehe einen hauptmenupunkt nach rechts:{}
+    anzahl schritte := 1;{}    beende aktuelle untermenuoperationen;{}    loesche aktuelles untermenu auf bildschirm;{}    loesche alte hauptmenumarkierung;{}    anzahl schritte INCR clear buffer and count (""2"");{}    ermittle rechte menuposition;{}    stelle aktuellen hauptmenupunkt invers dar;{}    starte aktuelle untermenuoperationen;{}    schreibe aktuelles untermenu auf bildschirm.{}  loesche alte hauptmenumarkierung:{}    erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);{}
+    out          (area (menuwindow), startpos, 1, ueberschrifttext).{}  startpos:{}    aktuelles untermenu.anfangsposition.{}  ueberschriftlaenge:{}    length (ueberschrifttext).{}  ueberschrifttext:{}    aktuelles untermenu.ueberschrift.{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  ermittle linke menuposition:{}    INT VAR positionszaehler;{}    FOR positionszaehler FROM 1 UPTO anzahl schritte REP{}
+      drehe die menuposition um einen wert runter{}    PER.{}  ermittle rechte menuposition:{}    FOR positionszaehler FROM 1 UPTO anzahl schritte REP{}      drehe die menuposition um einen wert hoch{}    PER.{}  drehe die menuposition um einen wert runter:{}    IF aktuelles menu.hauptmenuzeiger > 1{}       THEN aktuelles menu.hauptmenuzeiger DECR 1{}       ELSE aktuelles menu.hauptmenuzeiger{}                     := aktuelles menu.anzahl hauptmenupunkte{}    FI.{}  drehe die menuposition um einen wert hoch:{}
+    IF aktuelles menu.hauptmenuzeiger{}         < aktuelles menu.anzahl hauptmenupunkte{}       THEN aktuelles menu.hauptmenuzeiger INCR 1{}       ELSE aktuelles menu.hauptmenuzeiger := 1{}    FI.{}  gehe einen untermenupunkt nach unten:{}    INT VAR naechster aktiver := folgender aktiver untermenupunkt;{}    nimm ummarkierung vor.{}  gehe einen untermenupunkt nach oben:{}    naechster aktiver := vorausgehender aktiver untermenupunkt;{}    nimm ummarkierung vor.{}  nimm ummarkierung vor:{}    IF ueberhaupt aktive menupunkte vorhanden{}
+       THEN demarkiere aktuellen untermenupunkt;{}            gehe zum folgenden untermenupunkt;{}            markiere aktuellen untermenupunkt{}    FI.{}  ueberhaupt aktive menupunkte vorhanden:{}    (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).{}  gehe zum folgenden untermenupunkt:{}    aktuelles menu.untermenuzeiger := naechster aktiver.{}  stelle aktuellen hauptmenupunkt invers dar:{}    out invers (area (menuwindow), startpos, 1, ueberschrifttext).{}  fuehre aktuellen menupunkt aus:{}
+    IF nur interne verwendung AND mit ausstieg{}       THEN kennzeichne als angetickt;{}            disable stop;{}            do (ausstiegsproc);{}            do (menuanweisung);{}            aktueller menupunkt.angewaehlt := FALSE;{}            IF is error THEN put error; clear error FI;{}            enable stop;{}            anzahl offener menus DECR 1;{}            menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{}            menuwindow := window (1,1,79, 24);{}            nur interne verwendung := FALSE;{}
+            cursor on;{}            LEAVE handle menu{}       ELSE kennzeichne als angetickt;{}            fuehre operation aus (menuanweisung);{}            nimm kennzeichnung zurueck{}    FI.{}  kennzeichne als angetickt:{}    aktueller menupunkt.angewaehlt := TRUE;{}    markiere aktuellen untermenupunkt.{}  nimm kennzeichnung zurueck:{}    aktueller menupunkt.angewaehlt := FALSE;{}    markiere aktuellen untermenupunkt.{}  menuanweisung:{}   compress (aktueller menupunkt.procname).{}  aktueller menupunkt:{}
+    aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].{}  hole esc sequenz:{}    TEXT VAR zweites zeichen;{}    inchar (zweites zeichen);{}    SELECT pos ("q?$", zweites zeichen) OF{}      CASE 1: erfrage abbruch{}      CASE 2: zeige menubedienhinweise{}      CASE 3: gib info aus{}      OTHERWISE out (piep){}    END SELECT.{}  erfrage abbruch:{}    IF menuno (infotext [2], 5){}       THEN zweites zeichen := "n"  (* gleichgültig, nur nicht 'q'  *){}    FI.{}  zeige menubedienhinweise:{}
+    INT VAR gewaehlt;{}    REP{}      gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);{}      erfuelle den wunsch{}    UNTIL ausstieg aus bedienhinweisen gewuenscht PER.{}  alttext:{}    menuleiste.menutext.platz [1].{}  altwahl:{}    menuleiste.menutext.platz [2].{}  altzusatz:{}    menuleiste.menutext.platz [3].{}  erfuelle den wunsch:{}    SELECT gewaehlt OF{}      CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint){}      CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint){}
+      CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint){}      CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint){}    END SELECT.{}  ausstieg aus bedienhinweisen gewuenscht:{}    gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.{}  gib info aus:{}    menuinfo (menuleiste.menutext.platz [20]).{}  zeige erklaerungstext im menu an:{}    IF compress (erklaerungstext) = ""{}       THEN menuinfo (infotext [3]){}       ELSE menuinfo (erklaerungstext){}    FI.{}  erklaerungstext:{}
+    aktueller menupunkt.boxtext.{}  werte kuerzeleingabe aus:{}    naechster aktiver := pos (kuerzelkette, eingabezeichen);{}    nimm ummarkierung vor;{}    fuehre aktuellen menupunkt aus.{}  starte aktuelle untermenuoperationen:{}    ermittle aktuelle kuerzelkette;{}    IF startoperation <> ""{}       THEN fuehre operation aus (startoperation){}    FI.{}  startoperation:{}    compress (aktuelles untermenu.startprozedurname).{}  ermittle aktuelle kuerzelkette:{}    kuerzelkette := "";{}    INT VAR kuerzelzeiger;{}
+    FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP{}      IF compress (aktuelles punktkuerzel) = ""{}         THEN kuerzelkette CAT ""0""  { beliebiger Code der Länge 1 }{}         ELSE haenge ggf kuerzel an{}      FI{}    PER.{}  aktuelles punktkuerzel:{}    aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.{}  haenge ggf kuerzel an:{}    IF betrachteter punkt ist aktiv{}       THEN kuerzelkette CAT aktuelles punktkuerzel{}       ELSE kuerzelkette CAT ""0""{}    FI.{}  betrachteter punkt ist aktiv:{}
+    aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.{}  beende aktuelle untermenuoperationen:{}    kuerzelkette := "".{}END PROC handle menu;{}PROC oeffne menu (TEXT CONST menuname):{}  cursor off;{}  suche eingestelltes menu;{}  IF menu existiert nicht{}     THEN cursor on;{}          page;{}          errorstop (fehlermeldung [5] + menuname + fehlermeldung [6]){}  FI;{}  anzahl offener menus INCR 1;{}  ggf neue seite aufschlagen;{}  ueberpruefe anzahl offener menus;{}  lege ggf aktuelles menu auf eis;{}
+  initialisiere den menubildschirm;{}  IF NOT nur interne verwendung{}     THEN aktuelles menu.hauptmenuzeiger     := 1;{}          aktuelles menu.untermenuzeiger     := 0;{}          aktuelles menu.untermenuanfang     := 0;{}  FI;{}  show menu;{}  fuehre ggf menueingangsprozedur aus;{}  zeige ggf menukenndaten an.{}  suche eingestelltes menu:{}    INT VAR i, suchzeiger;{}    BOOL VAR gefunden :: FALSE;{}    FOR i FROM 1 UPTO menuleiste.belegt REP{}      IF menuleiste.menu [i].menuname = menuname{}
+         THEN gefunden   := TRUE;{}              suchzeiger := i;{}      FI{}    UNTIL menuleiste.menu [i].menuname = menuname PER.{}  menu existiert nicht:{}    NOT gefunden.{}  ueberpruefe anzahl offener menus:{}    IF anzahl offener menus > 2{}       THEN anzahl offener menus := 0; cursor on;{}            errorstop (fehlermeldung [7]){}    FI.{}  lege ggf aktuelles menu auf eis:{}    IF anzahl offener menus = 2{}       THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell{}    FI;{}    menuleiste.zeigeraktuell := suchzeiger.{}
+  initialisiere den menubildschirm:{}    IF anzahl offener menus = 2{}       THEN menuwindow := window (6, 4, 73, 20){}       ELSE menuwindow := window (1, 1, 79, 24);{}    FI.{}  fuehre ggf menueingangsprozedur aus:{}    IF aktuelles menu.menueingangsprozedur <> ""{}       THEN fuehre operation aus (aktuelles menu.menueingangsprozedur){}    FI.{}  ggf neue seite aufschlagen:{}    IF anzahl offener menus = 1 THEN page FI.{}  zeige ggf menukenndaten an:{}    IF anzahl offener menus = 1  AND aktuelles menu.menuinfo <> bleibt leer symbol{}
+       THEN write menunotice (vollstaendiger infotext, 4);{}            pause (100);{}            erase menunotice{}    FI.{}  vollstaendiger infotext:{}    aktuelles menu.menuinfo +{}    aktuelles menu.lizenznummer +{}    aktuelles menu.versionsnummer.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}END PROC oeffne menu;{}PROC show menu:{}  ueberpruefe menudaten;{}  stelle hauptmenuleiste zusammen;{}  zeige hauptmenu an;{}  stelle aktuellen hauptmenupunkt invers dar;{}  schreibe aktuelles untermenu auf bildschirm;{}
+  zeige informationszeile an.{}  ueberpruefe menudaten:{}    IF   anzahl offener menus = 0{}         THEN errorstop (fehlermeldung [8]){}    ELIF aktuelles menu.anzahl hauptmenupunkte < 1{}         THEN errorstop (fehlermeldung [9]){}    FI.{}  stelle hauptmenuleiste zusammen:{}    TEXT VAR hauptmenuzeile :: "";{}    INT VAR zeiger;{}    hauptmenuzeile CAT aktuelles menu.menuname;{}    hauptmenuzeile CAT ":";{}    FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{}      haenge hauptmenupunkt an{}
+    PER.{}  haenge hauptmenupunkt an:{}    hauptmenuzeile CAT hauptmenuluecke;{}    hauptmenuzeile CAT hauptmenupunktname.{}  hauptmenupunktname:{}    aktuelles menu.einzelmenu [zeiger].ueberschrift.{}  zeige hauptmenu an:{}    page (menuwindow, TRUE);{}    out menuframe (area (menuwindow));{}    cursor (menuwindow, 1, 1);{}    out (menuwindow, hauptmenuzeile).{}  stelle aktuellen hauptmenupunkt invers dar:{}    cursor (menuwindow, startposition, 1);{}    out (menuwindow, invers (ueberschrifttext)).{}
+  startposition:{}    aktuelles untermenu.anfangsposition - 1.{}  ueberschrifttext:{}    aktuelles untermenu.ueberschrift.{}  zeige informationszeile an:{}    write permanent footnote (hinweis [1]).{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC show menu;{}PROC schreibe aktuelles untermenu auf bildschirm:{}  ermittle linke obere ecke des untermenukastens;{}  wirf untermenu aus;{}
+  show menunotice;{}  cursor in warteposition.{}  ermittle linke obere ecke des untermenukastens:{}    aktuelles menu.untermenuanfang := menumitte - halbe menubreite;{}    achte auf randextrema.{}  menumitte:{}    startposition + (length (ueberschrifttext) DIV 2) - 1.{}  startposition:{}    aktuelles untermenu.anfangsposition.{}  ueberschrifttext:{}    aktuelles untermenu.ueberschrift.{}  halbe menubreite:{}    aktuelles untermenu.maxlaenge DIV 2.{}  achte auf randextrema:{}    gleiche ggf linken  rand aus;{}
+    gleiche ggf rechten rand aus.{}  gleiche ggf linken rand aus:{}    IF aktuelles menu.untermenuanfang < 4{}       THEN aktuelles menu.untermenuanfang := 4{}    FI.{}  gleiche ggf rechten rand aus:{}    IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >{}       (areaxsize (menuwindow) - 3){}       THEN aktuelles menu.untermenuanfang{}               := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3{}    FI.{} wirf untermenu aus:{}    IF aktuelles menu.untermenuzeiger = 0{}
+       THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{}    FI;{}    wirf untermenukopfzeile aus;{}    wirf untermenurumpf aus;{}    wirf untermenufusszeile aus;{}    markiere aktuellen untermenupunkt.{}  wirf untermenukopfzeile aus:{}    cursor (menuwindow, spalte, anfangszeile);{}    out (balken oben); striche; out (balken oben).{}  wirf untermenufusszeile aus:{}    cursor (menuwindow, spalte, endezeile);{}    out (ecke unten links); striche; out (ecke unten rechts).{}  spalte:{}
+    aktuelles menu.untermenuanfang - 3.{}  anfangszeile:{}    erste untermenuzeile - 1.{}  endezeile:{}    erste untermenuzeile + aktuelles untermenu.belegt.{}  striche:{}    (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.{}  wirf untermenurumpf aus:{}    INT VAR laufvar;{}    INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;{}    FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP{}      wirf eine einzelne menuzeile aus{}    PER.{}  wirf eine einzelne menuzeile aus:{}
+    out with beam (area (menuwindow), menuspalte, menuzeile,{}                   aktueller punktname, laenge).{}  menuspalte:{}    aktuelles menu.untermenuanfang.{}  menuzeile:{}    erste untermenuzeile + laufvar - 1.{}  aktueller punktname:{}    untermenubezeichnung (laufvar).{}  laenge:{}    aktuelle punktlaenge.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC schreibe aktuelles untermenu auf bildschirm;{}
+PROC loesche aktuelles untermenu auf bildschirm:{}  beende aktuelle untermenuoperationen;{}  loesche untermenu auf bildschirm;{}  schreibe balken wieder hin;{}  aktuelles menu.untermenuzeiger := 1.{}  beende aktuelle untermenuoperationen:{}    IF leaveoperation <> ""{}       THEN fuehre operation aus (leaveoperation){}    FI.{}  leaveoperation:{}    compress (aktuelles untermenu.leaveprozedurname).{}  loesche untermenu auf bildschirm:{}    INT VAR laufvar;{}    FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP{}
+      loesche eine einzelne menuzeile{}    PER.{}  loesche eine einzelne menuzeile:{}    erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).{}  menuspalte:{}    aktuelles menu.untermenuanfang.{}  menuzeile:{}    erste untermenuzeile + laufvar - 1.{}  laenge:{}    aktuelles untermenu.maxlaenge + 1.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}  schreibe balken wieder hin:{}
+    cursor (menuwindow, spalte, anfangszeile);{}    (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.{}  spalte:{}    aktuelles menu.untermenuanfang - 3.{}  anfangszeile:{}    erste untermenuzeile - 1.{}END PROC loesche aktuelles untermenu auf bildschirm;{}PROC markiere aktuellen untermenupunkt:{}  IF aktuelles menu.untermenuzeiger <> 0{}     THEN laufe ggf zum naechsten aktiven menupunkt;{}          out invers with beam (area (menuwindow), menuspalte, menuzeile,{}                                aktueller punktname, laenge){}
+  FI.{}  laufe ggf zum naechsten aktiven menupunkt:{}    IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv{}       THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt{}    FI.{}  menuspalte:{}    aktuelles menu.untermenuanfang.{}  menuzeile:{}    erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{}  aktueller punktname:{}    untermenubezeichnung (aktuelles menu.untermenuzeiger).{}  laenge:{}    aktuelles untermenu.maxlaenge + 1.{}  aktuelles menu:{}
+    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC markiere aktuellen untermenupunkt;{}PROC demarkiere aktuellen untermenupunkt:{}  IF aktuelles menu.untermenuzeiger <> 0{}     THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);{}          out (area (menuwindow), menuspalte, menuzeile,{}                                  aktueller punktname, laenge){}  FI.{}  menuspalte:{}    aktuelles menu.untermenuanfang.{}
+  menuzeile:{}    erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.{}  aktueller punktname:{}    untermenubezeichnung (aktuelles menu.untermenuzeiger).{}  laenge:{}    aktuelles untermenu.maxlaenge + 1.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC demarkiere aktuellen untermenupunkt;{}INT PROC folgender aktiver untermenupunkt:{}  INT VAR anzahl aktiver menupunkte :: 0;{}
+  untersuche anzahl aktiver menupunkte;{}  IF   kein aktiver menupunkt vorhanden{}       THEN 0{}  ELIF nur ein aktiver menupunkt vorhanden{}       THEN liefere einzigen aktiven menupunkt{}  ELSE liefere naechsten aktiven menupunkt{}  FI.{}  untersuche anzahl aktiver menupunkte:{}    INT VAR zaehler, position;{}    FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{}      IF aktuelles untermenu.menupunkt [zaehler].aktiv{}         THEN anzahl aktiver menupunkte INCR 1;{}              position := zaehler{}
+      FI{}    UNTIL anzahl aktiver menupunkte > 1 PER.{}  kein aktiver menupunkt vorhanden:{}    anzahl aktiver menupunkte = 0.{}  nur ein aktiver menupunkt vorhanden:{}    anzahl aktiver menupunkte = 1.{}  liefere einzigen aktiven menupunkt:{}    position.{}  liefere naechsten aktiven menupunkt:{}    INT VAR interner zeiger;{}    stelle internen zeiger auf den naechsten menupunkt;{}    WHILE NOT punkt ist aktiv REP{}      untersuche naechsten menupunkt{}    PER;{}    ergebnis.{}    stelle internen zeiger auf den naechsten menupunkt:{}
+      IF aktuelles menu.untermenuzeiger = letzter untermenupunkt{}         THEN interner zeiger := 1{}         ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1{}      FI.{}    letzter untermenupunkt:{}      aktuelles untermenu.belegt.{}    punkt ist aktiv:{}      aktuelles untermenu.menupunkt [interner zeiger].aktiv.{}    untersuche naechsten menupunkt:{}      IF interner zeiger = letzter untermenupunkt{}         THEN interner zeiger := 1{}         ELSE interner zeiger INCR 1{}      FI.{}
+    ergebnis:{}      interner zeiger.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC folgender aktiver untermenupunkt;{}INT PROC vorausgehender aktiver untermenupunkt:{}  INT VAR anzahl aktiver menupunkte :: 0;{}  untersuche anzahl aktiver menupunkte;{}  IF   kein aktiver menupunkt vorhanden{}       THEN 0{}  ELIF nur ein aktiver menupunkt vorhanden{}       THEN liefere einzigen aktiven menupunkt{}
+  ELSE liefere vorausgehenden aktiven menupunkt{}  FI.{}  untersuche anzahl aktiver menupunkte:{}    INT VAR zaehler, position;{}    FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP{}      IF aktuelles untermenu.menupunkt [zaehler].aktiv{}         THEN anzahl aktiver menupunkte INCR 1;{}              position := zaehler{}      FI{}    UNTIL anzahl aktiver menupunkte > 1 PER.{}  kein aktiver menupunkt vorhanden:{}    anzahl aktiver menupunkte = 0.{}  nur ein aktiver menupunkt vorhanden:{}    anzahl aktiver menupunkte = 1.{}
+  liefere einzigen aktiven menupunkt:{}    position.{}  liefere vorausgehenden aktiven menupunkt:{}    INT VAR interner zeiger;{}    stelle internen zeiger auf vorausgehenden menupunkt;{}    WHILE NOT punkt ist aktiv REP{}      untersuche vorausgehenden menupunkt{}    PER;{}    ergebnis.{}  stelle internen zeiger auf vorausgehenden menupunkt:{}    IF aktuelles menu.untermenuzeiger <= 1{}       THEN interner zeiger := letzter untermenupunkt{}       ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1{}
+    FI.{}  letzter untermenupunkt:{}    aktuelles untermenu.belegt.{}  punkt ist aktiv:{}    aktuelles untermenu.menupunkt [interner zeiger].aktiv.{}  untersuche vorausgehenden menupunkt:{}    IF interner zeiger = 1{}       THEN interner zeiger := letzter untermenupunkt{}       ELSE interner zeiger DECR 1{}    FI.{}  ergebnis:{}    interner zeiger.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}
+END PROC vorausgehender aktiver untermenupunkt;{}PROC cursor in warteposition:{}  cursor (areax (menuwindow), areay (menuwindow) + 1){}END PROC cursor in warteposition;{}TEXT PROC untermenubezeichnung (INT CONST position):{}  TEXT VAR bezeichnung :: "";{}  bezeichnung CAT kennzeichnung;{}  bezeichnung CAT punktkennung;{}  bezeichnung.{}  kennzeichnung:{}    IF        aktueller menupunkt.aktiv{}         AND  aktueller menupunkt.angewaehlt{}              THEN "*"{}    ELIF      aktueller menupunkt.aktiv{}
+         AND  aktueller menupunkt.punktkuerzel <> ""{}              THEN aktueller menupunkt.punktkuerzel{}    ELIF      aktueller menupunkt.aktiv{}         AND  aktueller menupunkt.punktkuerzel = ""{}              THEN blank{}    ELSE      "-"{}    FI.{}    punktkennung:{}      IF menupunkt ist trennzeile{}         THEN strichellinie{}         ELSE aktueller menupunkt.punktname{}      FI.{}    menupunkt ist trennzeile:{}      aktueller menupunkt.punktname = (blank + trennzeilensymbol).{}    strichellinie:{}
+      (aktuelles untermenu.maxlaenge + 1) * "-".{}    aktueller menupunkt:{}      aktuelles untermenu.menupunkt [position].{}    aktuelles menu:{}      menuleiste.menu [menuleiste.zeigeraktuell].{}    aktuelles untermenu:{}      aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC untermenubezeichnung;{}PROC fuehre operation aus (TEXT CONST operation):{}  disable stop;{}  IF operation = ""{}     THEN menuinfo (infotext [1]);{}          LEAVE fuehre operation aus{}  FI;{}  do (operation);{}
+  IF is error{}     THEN menuinfo (errormessage, 5);{}          clear error{}  FI;{}  old menufootnote;{}  enable stop;{}  cursor off{}END PROC fuehre operation aus;{}PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):{}  INT VAR unterpunktposition :: 0, zeiger;{}  suche unterpunkt;{}  aendere aktivierung.{}  suche unterpunkt:{}    FOR zeiger FROM 1 UPTO untermenuende REP{}      IF untermenupunkt = blank + compress (unterpunkt){}         THEN unterpunktposition := zeiger;{}              LEAVE suche unterpunkt{}
+      FI{}    PER;{}    LEAVE veraendere aktivierung.{}  untermenuende:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{}  untermenupunkt:{}    aktuelles untermenu.menupunkt [zeiger].punktname.{}  aendere aktivierung:{}    aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}
+PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):{}  IF punktnummer >= 1 AND punktnummer <= untermenuende{}     THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag{}  FI.{}  untermenuende:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere aktivierung;{}PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):{}
+  INT VAR unterpunktposition :: 0, zeiger;{}  suche unterpunkt;{}  aendere anwahl.{}  suche unterpunkt:{}    FOR zeiger FROM 1 UPTO untermenuende REP{}      IF untermenupunkt = blank + compress (unterpunkt){}         THEN unterpunktposition := zeiger;{}              LEAVE suche unterpunkt{}      FI{}    PER;{}    enable stop;{}    errorstop (fehlermeldung [10]).{}  untermenuende:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.{}  untermenupunkt:{}    aktuelles untermenu.menupunkt [zeiger].punktname.{}
+  aendere anwahl:{}    aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].{}END PROC veraendere anwahl;{}PROC activate (TEXT CONST unterpunkt):{}  enable stop;{}  veraendere aktivierung (unterpunkt, TRUE){}END PROC activate;{}PROC activate (INT CONST punktnummer):{}  enable stop;{}  veraendere aktivierung (punktnummer, TRUE){}
+END PROC activate;{}PROC deactivate (TEXT CONST unterpunkt):{}  enable stop;{}  veraendere aktivierung (unterpunkt, FALSE){}END PROC deactivate;{}PROC deactivate (INT CONST punktnummer):{}  enable stop;{}  veraendere aktivierung (punktnummer, FALSE){}END PROC deactivate;{}PROC select (TEXT CONST unterpunkt):{}  enable stop;{}  veraendere anwahl (unterpunkt, TRUE){}END PROC select;{}PROC deselect (TEXT CONST unterpunkt):{}  enable stop;{}  veraendere anwahl (unterpunkt, FALSE){}END PROC deselect;{}
+PROC schliesse menu:{}  IF aktuelles menu.menuausgangsprozedur <> ""{}     THEN menufootnote (hinweis [3]);{}          fuehre operation aus (aktuelles menu.menuausgangsprozedur){}  FI;{}  anzahl offener menus DECR 1;{}  IF anzahl offener menus = 1{}     THEN aktiviere das auf eis gelegte menu{}  FI.{}  aktiviere das auf eis gelegte menu:{}    menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{}    menuwindow := window (1, 1, 79, 24);{}    show menu.{}  aktuelles menu:{}    menuleiste.menu [menuleiste.zeigeraktuell].{}
+END PROC schliesse menu;{}PROC refresh submenu:{}  schreibe aktuelles untermenu auf bildschirm;{}  show menunotice;{}END PROC refresh submenu;{}PROC regenerate menuscreen:{}  IF   anzahl offener menus = 0{}       THEN errorstop (fehlermeldung [8]){}  ELIF anzahl offener menus = 1{}       THEN page;{}            show menu;{}            show menunotice{}  ELSE zeige erstes menu an;{}       zeige zweites menu an;{}       show menunotice{}  FI.{}  zeige erstes menu an:{}    INT VAR menuzeiger :: menuleiste.zeigeraktuell;{}
+    menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;{}    menuwindow := window (1, 1, 79, 24);{}    anzahl offener menus := 1;{}    show menu.{}  zeige zweites menu an:{}    menuleiste.zeigeraktuell := menuzeiger;{}    menuwindow := window (6, 4, 73, 20);{}    anzahl offener menus := 2;{}    show menu.{}END PROC regenerate menuscreen;{}PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):{}  boxinfo (menuwindow, t, position, timelimit, FALSE);{}  schreibe aktuelles untermenu auf bildschirm;{}
+  old menufootnote{}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t, INT CONST position):{}  menuinfo (t, position, maxint){}END PROC menuinfo;{}PROC menuinfo (TEXT CONST t):{}  menuinfo (t, 5, maxint){}END PROC menuinfo;{}INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,{}                          INT CONST position, BOOL CONST mit abbruch):{}  INT VAR ergebnis :=  boxalternative (menuwindow, t, auswahlliste,{}                       zusatztasten, position, mit abbruch, FALSE);{}
+  schreibe aktuelles untermenu auf bildschirm;{}  old menufootnote;{}  ergebnis{}END PROC menualternative;{}BOOL PROC menuyes (TEXT CONST frage, INT CONST position):{}  BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);{}  schreibe aktuelles untermenu auf bildschirm;{}  old menufootnote;{}  wert{}END PROC menuyes;{}BOOL PROC menuno (TEXT CONST frage, INT CONST position):{}  NOT menuyes (frage, position){}END PROC menuno;{}TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,{}                   BOOL CONST mit reinigung):{}
+  TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);{}  IF mit reinigung{}     THEN schreibe aktuelles untermenu auf bildschirm;{}          old menufootnote{}  FI;{}  wert{}END PROC menuone;{}THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,{}                         BOOL CONST mit reinigung):{}  THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,{}                                        mit reinigung);{}  IF mit reinigung{}     THEN schreibe aktuelles untermenu auf bildschirm;{}
+          old menufootnote{}  FI;{}  thesaurus{}END PROC menusome;{}TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):{}  TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);{}  schreibe aktuelles untermenu auf bildschirm;{}  old menufootnote;{}  wert{}END PROC menuanswer;{}TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,{}                          TEXT CONST t1, t2, BOOL CONST mit reinigung):{}  TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,{}
+                                             mit reinigung, FALSE){}  IF mit reinigung{}     THEN schreibe aktuelles untermenu auf bildschirm;{}          old menufootnote{}  FI;{}  wert{}END PROC menuanswer one;{}THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,{}                               TEXT CONST t1, t2, BOOL CONST mit reinigung):{}  THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,{}                                       thes, t1, t2, mit reinigung, FALSE){}
+  IF mit reinigung{}     THEN schreibe aktuelles untermenu auf bildschirm;{}          old menufootnote{}  FI;{}  wert{}END PROC menuanswersome;{}PROC menufootnote (TEXT CONST t):{}  cursor (menuwindow, 1, areaysize (menuwindow) - 1);{}  areaxsize (menuwindow) TIMESOUT waagerecht;{}  cursor (menuwindow, 1, areaysize (menuwindow));{}  outtext (t, 1, areaxsize (menuwindow)){}END PROC menufootnote;{}PROC old menufootnote:{}  menufootnote (permanent footnote){}END PROC old menufootnote;{}TEXT PROC menubasistext (INT CONST nummer):{}
+  IF   nummer <= 20{}       THEN fehlermeldung [12]{}  ELIF nummer > menuleiste.menutext.anzahl menutexte{}       THEN fehlermeldung [11]{}  ELSE menuleiste.menutext.platz [nummer]{}  FI{}END PROC menubasistext;{}TEXT PROC anwendungstext (INT CONST nummer):{}  IF nummer > menuleiste.infotext.anzahl infotexte{}     THEN fehlermeldung [11]{}     ELSE menuleiste.infotext.stelle [nummer]{}  FI{}END PROC anwendungstext;{}PROC zeige menukennung:{}  IF anzahl offener menus = 0{}     THEN zeige angaben und emblem;{}
+  FI.{}  zeige angaben und emblem:{}    ROW 5 WINDOW VAR w;{}    w [ 1] := window (40,  3, 30, 9);{}    w [ 2] := window (36,  5, 30, 9);{}    w [ 3] := window (30,  7, 30, 9);{}    w [ 4] := window (22,  9, 30, 9);{}    w [ 5] := window (12, 11, 30, 9);{}    page;{}    show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));{}    show (w [2]); out (w [2], " Version " + versionsnummer);{}    show (w [3]); out (w [3], copyright1);{}    show (w [4]); out (w [4], copyright2);{}    show (w [5]);{}
+    cursor (w [5], 1, 2);out (w [5], "    lll        sssssssss  ");{}    cursor (w [5], 1, 3);out (w [5], "    lll       sss     sss ");{}    cursor (w [5], 1, 4);out (w [5], "    lll       sss         ");{}    cursor (w [5], 1, 5);out (w [5], "    lll        sssssssss  ");{}    cursor (w [5], 1, 6);out (w [5], "    lll               sss ");{}    cursor (w [5], 1, 7);out (w [5], "    lll latta soft    sss ");{}    cursor (w [5], 1, 8);out (w [5], "     lllllllll sssssssss  ");{}    cursor (79, 24);{}
+    zeitpunkt := clock (1);{}END PROC zeige menukennung;{}PROC reset dialog:{} angekoppelte menutafel := "";{} anzahl offener menus   :=  0{}END PROC reset dialog;{}PROC write permanent footnote (TEXT CONST t):{}  permanent footnote := t;{}  cursor (menuwindow, 1, areaysize (menuwindow));{}  outtext (t, 1, areaxsize (menuwindow)){}END PROC write permanent footnote;{}PROC write menunotice (TEXT CONST t, INT CONST position):{}  erase menunotice;{}  boxnotice (menuwindow, t, position, menunotizx,     menunotizy,{}
+                                      menunotizxsize, menunotizysize);{}  menunotiztext         := t;{}  menunotizposition     := position;{}  menunotiz ist gesetzt := TRUE{}END PROC write menunotice;{}PROC show menunotice:{}  IF menunotiz ist gesetzt{}     THEN boxnotice (menuwindow, menunotiztext, menunotizposition,{}                     menunotizx, menunotizy, menunotizxsize, menunotizysize);{}  FI{}END PROC show menunotice;{}PROC erase menunotice:{}  INT VAR spa, zei;{}  get cursor (spa, zei);{}
+  IF menunotiz ist gesetzt{}     THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);{}          menunotiz ist gesetzt := FALSE;{}          cursor (spa, zei){}  FI{}END PROC erase menunotice;{}PROC initialize menuwindow:{}  schreibfenster := window (areax     (menuwindow) + 1,{}                            areay     (menuwindow) + 3,{}                            areaxsize (menuwindow) - 2,{}                            areaysize (menuwindow) - 4){}END PROC initialize menuwindow;{}
+PROC show menuwindow:{}  initialize menuwindow;{}  show (schreibfenster);{}END PROC show menuwindow;{}PROC menuwindow page:{}  initialize menuwindow;{}  page (schreibfenster){}END PROC menuwindow page;{}PROC menuwindowout (TEXT CONST text):{}  out (schreibfenster, text){}END PROC menuwindow out;{}PROC menuwindowget (TEXT VAR text):{}  get (schreibfenster, text){}END PROC menuwindowget;{}PROC menuwindoweditget (TEXT VAR text):{}  editget (schreibfenster, text){}END PROC menuwindoweditget;{}PROC menuwindowedit (TEXT CONST dateiname):{}
+  initialize menuwindow;{}  edit (schreibfenster, dateiname){}END PROC menuwindowedit;{}PROC menuwindowedit (FILE VAR f):{}  initialize menuwindow;{}  edit (schreibfenster, f){}END PROC menuwindowedit;{}PROC menuwindowshow (TEXT CONST dateiname):{}  initialize menuwindow;{}  show (schreibfenster, dateiname){}END PROC menuwindowshow;{}PROC menuwindowshow (FILE VAR f):{}  initialize menuwindow;{}  show (schreibfenster, f){}END PROC menuwindowshow;{}BOOL PROC menuwindowyes (TEXT CONST frage):{}  yes (schreibfenster, frage){}
+END PROC menuwindowyes;{}BOOL PROC menuwindowno (TEXT CONST frage):{}  no (schreibfenster, frage){}END PROC menuwindowno;{}PROC menuwindowline:{}  menuwindowline (1){}END PROC menuwindowline;{}PROC menuwindowline (INT CONST anzahl):{}  line (schreibfenster, anzahl){}END PROC menuwindowline;{}PROC menuwindowcursor (INT CONST spa, zei):{}  cursor (schreibfenster, spa, zei){}END PROC menuwindowcursor;{}PROC get menuwindowcursor (INT VAR spa, zei):{}  get cursor (schreibfenster, spa, zei){}END PROC get menuwindowcursor;{}
+INT PROC remaining menuwindowlines:{}  remaining lines (schreibfenster){}END PROC remaining menuwindowlines;{}TEXT PROC menuwindowcenter (TEXT CONST t):{}  center (schreibfenster, t){}END PROC menuwindowcenter;{}PROC menuwindowstop:{}  menuwindowstop (2){}END PROC menuwindowstop;{}PROC menuwindowstop (INT CONST anzahl):{}  stop (schreibfenster, anzahl){}END PROC menuwindowstop;{}WINDOW PROC current menuwindow:{}  initialize menuwindow;{}  schreibfenster{}END PROC current menuwindow;{}PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):{}
+  IF oberste zeile < 1 OR oberste zeile > 3{}     THEN errorstop (fehlermeldung [13]);{}  FI;{}  garantiere menukarte;{}  cursor (1, oberste zeile); out (cleop);{}  cursor (1, 23); out(79 * waagerecht);{}  cursor (1, 24); outtext (menubasistext (141), 1, 79);{}  editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);{}  kommando auf taste legen ("?", "editorinformationen");{}  command dialogue (FALSE);{}  cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);{}  command dialogue (TRUE);{}
+  kommando auf taste legen ("?", "").{}  garantiere menukarte:{}    TEXT VAR name := compress (menukartenname);{}    IF name = ""{}       THEN install menu (stdmenukartenname, FALSE){}    FI.{}END PROC stdinfoedit;{}PROC stdinfoedit (FILE VAR f):{}  stdinfoedit (f, 1){}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):{}  FILE VAR f :: sequential file (modify, dateiname);{}  stdinfoedit (f, oberste zeile);{}END PROC stdinfoedit;{}PROC stdinfoedit (TEXT CONST dateiname):{}
+  stdinfoedit (dateiname, 1){}END PROC stdinfoedit;{}PROC editorinformationen:{}  BOOL VAR ende gewuenscht :: FALSE; INT VAR z;{}  FOR z FROM startwert UPTO 22 REP{}    cursor (1, z); out (cleol);{}  PER;{}  REP{}    INT VAR erg := boxalternative (editorinfofenster,{}                                   menubasistext (149),{}                                   menubasistext (150),{}                                   menubasistext (151),{}                                   5, FALSE, FALSE);{}    erfuelle den wunsch{}
+  UNTIL ende gewuenscht PER;{}  cursor (2, 23); 77 TIMESOUT waagerecht;{}  cursor (1, 24); outtext (menubasistext (141), 1, 79).{}  startwert:{}    areay (editorinfofenster) + 1.{}  erfuelle den wunsch:{}    SELECT erg OF{}      CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE){}      CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE){}      CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE){}      CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE){}
+      CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE){}      CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE){}      CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE){}      CASE 8, 108, 116: ende gewuenscht := TRUE{}      OTHERWISE   (*tue nichts*){}    END SELECT{}END PROC editorinformationen;{}PROC bereinige situation:{}  page;{}  forget (ds);{}  reset dialog{}END PROC bereinige situation;{}
+PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):{}  TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;{}  kopple archivmenukarte an;{}  schreibe programm;{}  insertiere programm;{}  abkoppeln.{}  kopple archivmenukarte an:{}    install menu (stdmenukartenname, FALSE).{}  schreibe programm:{}    forget (datname, quiet);{}    FILE VAR f :: sequential file (output, datname);{}    putline (f, menubasistext (191));{}    putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");{}
+    putline (f, menubasistext (192));{}    IF autoloeschen{}       THEN putline (f, menubasistext (193)){}       ELSE putline (f, menubasistext (194)){}    FI;{}    putline (f, menubasistext (195));{}    putline (f, menubasistext (196)).{}  insertiere programm:{}     TEXT VAR t := "insert (""" + datname + """)"; do (t).{}  abkoppeln:{}    forget (datname, quiet); last param (letzter);{}    reset dialog;{}    global manager.{}END PROC direktstart;{}END PACKET ls dialog 5;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 6 b/app/gs.dialog/1.2/src/ls-DIALOG 6
new file mode 100644
index 0000000..b27eae2
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 6
@@ -0,0 +1,102 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 6                     ** 
+          **                 Archiv-/Taskhandling                ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET  ls dialog 6  DEFINES{}       menu archiv notizort setzen,{}       menu archiv grundeinstellung,{}       menu archiv zieltask einstellen,{}       menu archiv zieltask aendern,{}       menu archiv reservieren,{}       menu archiv neue diskette,{}       menu archiv schreiben,{}       menu archiv checken,{}       menu archiv schreibcheck,{}       menu archiv holen,{}       menu archiv loeschen,{}       menu archiv verzeichnis,{}       menu archiv verzeichnis drucken,{}       menu archiv initialisieren,{}
+       menu archiv reservierung aufgeben,{}       archiv:{}LET menukartenname  =  "ls-MENUKARTE:Archiv";{}LET ack             =   0,{}    schreiben       =   1,{}    checken         =   2,{}    schreibcheck    =   3,{}    holen           =   4,{}    loeschen        =   5,{}    list code       =  15,{}    reserve code    =  19;{}BOOL VAR zieltask ist archivmanager   :: TRUE,{}         archiv gehoert mir           :: FALSE,{}         fehlerfall                   :: FALSE,{}         kontakt mit zieltask erfolgt :: FALSE;{}
+TEXT VAR zieltaskname                 :: "ARCHIVE",{}         aktueller archivname         :: "";{}INT VAR stationsnummer                :: station (myself),{}        letzte funktion               :: 11,{}        notizort                      :: 3;{}PROC archiv:{}  install menu (menukartenname, FALSE);{}  handle  menu ("ARCHIV"){}END PROC archiv;{}PROC melde zieltaskerror (TEXT CONST meldung):{}  IF   meldung = menubasistext (47){}       THEN menuinfo (menubasistext (123)){}  ELIF meldung = menubasistext (46){}
+       THEN menuinfo (menubasistext (124)){}  ELIF pos (meldung, "inkonsistent") > 0{}       THEN menuinfo (menubasistext (125)){}  ELIF     pos (meldung, "Lesen unmoeglich") > 0{}       COR pos (meldung, "Schreiben unmoeglich") > 0{}       THEN menuinfo (menubasistext (126)){}  ELIF pos (meldung, "Archiv heisst") > 0 AND pos (meldung, "?????") > 0{}       THEN menuinfo (menubasistext (127)){}  ELIF pos (meldung, "Archiv heisst") > 0{}       THEN menuinfo (menubasistext (128)){}  ELIF pos (meldung, "Schreibfehler") > 0 CAND pos (meldung, "Archiv") > 0{}
+       THEN menuinfo (menubasistext (129)){}  ELIF pos (meldung, "Lesefehler") > 0{}       THEN menuinfo (menubasistext (130)){}  ELIF pos (meldung, "Kommando") > 0 AND pos (meldung, "unbekannt") > 0{}       THEN menuinfo (menubasistext (131)){}  ELIF pos (meldung, "falscher Auftrag fuer Task") > 0{}       THEN menuinfo (menubasistext (132)){}  ELIF meldung = menubasistext (41){}       THEN menuinfo (menubasistext (133)){}  ELIF meldung = menubasistext (42){}       THEN menuinfo (menubasistext (134)){}
+  ELIF pos (meldung, "Collector") > 0 AND pos(meldung, "fehlt") > 0{}       THEN menuinfo (menubasistext (135)){}  ELIF pos (meldung, "kein Zugriffsrecht auf Task") > 0{}       THEN menuinfo (menubasistext (132)){}  ELIF pos (meldung, "nicht initialisiert") > 0{}       THEN menuinfo (menubasistext (136)){}  ELIF pos (meldung, "ungueltiger Format-Code") > 0{}       THEN menuinfo (menubasistext (137)){}  ELSE menuinfo (invers (meldung)){}  FI{}END PROC melde zieltaskerror;{}PROC menu archiv notizort setzen (INT CONST wert):{}
+   SELECT wert OF{}     CASE 1,2,3,4,5 : notizort := wert{}     OTHERWISE        notizort := 3{}   END SELECT{}END PROC menu archiv notizort setzen;{}PROC menu archiv grundeinstellung (INT CONST ort):{}  menu archiv zieltask aendern ("ARCHIVE", station (myself), TRUE);{}  menu archiv notizort setzen (ort);{}  zieltask anzeigen{}END PROC menu archiv grundeinstellung;{}PROC menu archiv zieltask einstellen:{}  TEXT VAR taskname :: "";{}  INT  VAR stationsnr, auswahl;{}  BOOL VAR ist amanager;{}  erfrage daten;{}
+  kontrolliere daten;{}  menu archiv zieltask aendern (taskname, stationsnr, ist amanager);{}  refresh submenu;{}  zieltask anzeigen.{}  erfrage daten:{}    auswahl := menualternative (menubasistext (51), menubasistext (52),{}                                menubasistext (53), 5, TRUE);{}    SELECT auswahl OF{}      CASE 1, 101 : menu archiv zieltask aendern{}                    ("ARCHIVE",     station (myself), TRUE );{}                    ausstieg{}      CASE 2, 102 : menu archiv zieltask aendern{}
+                    (name (father), station (myself), FALSE);{}                    ausstieg{}      CASE 3, 103 : menu archiv zieltask aendern{}                    ("PUBLIC",      station (myself), FALSE);{}                    ausstieg{}      CASE 4, 104 : handeinstellung{}      OTHERWISE ausstieg{}    END SELECT.{}  ausstieg:{}    refresh submenu;{}    zieltask anzeigen;{}    LEAVE menu archiv zieltask einstellen.{}  handeinstellung:{}    taskname     := menuanswer (menubasistext (81), zieltaskname, 5);{}
+    stationsnr   := int (menuanswer (menubasistext (82),{}                         text (station (myself)), 5));{}    ist amanager := menuyes (menubasistext (83), 5).{}  kontrolliere daten:{}    IF   compress (taskname) = ""{}      OR compress (taskname) = "-"{}      OR taskname = name (myself){}       THEN menuinfo (menubasistext (64));{}            LEAVE menu archiv zieltask einstellen{}    FI.{}END PROC menu archiv zieltask einstellen;{}PROC menu archiv zieltask aendern (TEXT CONST taskname,{}
+                                   INT  CONST stationsnr,{}                                   BOOL CONST ist archivmanager):{}  menufootnote (menubasistext (21) + menubasistext (23));{}  gib ggf archiv frei;{}  IF ist archivmanager{}     THEN archivmanager einstellen{}     ELSE sonstige task einstellen{}  FI;{}  aktiviere gueltige archivmenupunkte.{}  gib ggf archiv frei:{}    IF archiv gehoert mir{}       THEN archivreservierung aufgeben{}    FI.{}  archivmanager einstellen:{}    zieltask ist archivmanager   := TRUE;{}
+    zieltaskname                 := taskname;{}    stationsnummer               := stationsnr;{}    kontakt mit zieltask erfolgt := FALSE;{}    aktueller archivname         := "";{}    archiv gehoert mir           := FALSE;{}    letzte funktion              := 11.{}  sonstige task einstellen:{}    zieltask ist archivmanager := FALSE;{}    zieltaskname               := taskname;{}    stationsnummer             := stationsnr;{}    aktueller archivname       := "";{}    archiv gehoert mir         := FALSE;{}
+    letzte funktion            := 6.{}END PROC menu archiv zieltask aendern;{}PROC menu archiv reservieren:{}  TEXT VAR archivname :: "", meldung :: "";{}  kontrolliere einstellung;{}  menufootnote (menubasistext (21) + menubasistext (24));{}  versuche archiv zu reservieren (meldung);{}  werte meldung aus;{}  archiv anmelden (archivname, meldung, TRUE);{}  IF archivname = ""{}     THEN behandle archivfehler{}     ELSE aktueller archivname := archivname{}  FI;{}  aktiviere gueltige archivmenupunkte;{}
+  refresh submenu;{}  zieltask anzeigen.{}  kontrolliere einstellung:{}    IF   NOT zieltask ist archivmanager{}         THEN aktiviere gueltige archivmenupunkte;{}              refresh submenu;{}              LEAVE menu archiv reservieren{}    ELIF NOT kontakt mit zieltask erfolgt{}         THEN versuche kontakt herzustellen{}    FI.{}  versuche kontakt herzustellen:{}    TEXT VAR fehler :: "";{}    IF NOT task ist kommunikativ (fehler){}       THEN melde zieltaskerror (fehler);{}            melde rigoros ab;{}
+            LEAVE menu archiv reservieren{}       ELSE kontakt mit zieltask erfolgt := TRUE{}    FI.{}  werte meldung aus:{}    IF meldung <> ""{}       THEN melde zieltaskerror (meldung);{}            melde rigoros ab;{}            LEAVE menu archiv reservieren{}    FI.{}  behandle archivfehler:{}    melde zieltaskerror (meldung);{}    archivreservierung aufgeben;{}    melde rigoros ab{}END PROC menu archiv reservieren;{}PROC melde rigoros ab:{}  aktueller archivname         := "";{}  archiv gehoert mir           := FALSE;{}
+  kontakt mit zieltask erfolgt := FALSE{}END PROC melde rigoros ab;{}PROC versuche archiv zu reservieren (TEXT VAR fehler):{}  IF NOT kontakt mit zieltask erfolgt{}     THEN fehler := menubasistext (44);{}          archiv gehoert mir := FALSE;{}          LEAVE versuche archiv zu reservieren{}  FI;{}  disable stop;{}  IF eigene station{}     THEN reserve ("beknackter archivename",/zieltaskname ){}     ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname){}  FI;{}  IF is error{}     THEN fehler := errormessage;{}
+          melde rigoros ab;{}          clear error{}     ELSE archiv gehoert mir := TRUE;{}          fehler             := "";{}  FI;{}  enable stop{}END PROC versuche archiv zu reservieren;{}PROC archiv anmelden (TEXT VAR archivname, fehler, BOOL CONST mit anfrage):{}  ueberpruefe archivbesitz;{}  fuehre archivanmeldung aus.{}  ueberpruefe archivbesitz:{}    IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{}       THEN fehler := menubasistext (45);{}            melde rigoros ab;{}            LEAVE archiv anmelden{}
+    FI.{}  fuehre archivanmeldung aus:{}    IF mit anfrage{}       THEN frage nach eingelegter diskette und melde an{}       ELSE melde archiv unter richtigem namen an{}    FI.{}  frage nach eingelegter diskette und melde an:{}    IF menuyes (menubasistext (84), 5){}       THEN menufootnote (menubasistext (21) + menubasistext (25));{}            melde archiv unter richtigem namen an{}       ELSE fehler := menubasistext (46);{}            aktueller archivname := "";{}            LEAVE archiv anmelden{}
+    FI.{}  melde archiv unter richtigem namen an:{}    disable stop;{}    IF eigene station{}       THEN reserve ("beknackter archivename",/zieltaskname);{}            list (/zieltaskname);{}       ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname);{}            list (stationsnummer/zieltaskname){}    FI;{}    IF is error{}       THEN fehler := errormessage;{}            behandle die fehlermeldung{}       ELSE archivname := "beknackter archivename";{}            fehler     := "";{}            enable stop{}
+   FI.{} behandle die fehlermeldung:{}   IF   subtext (fehler, 1, 14) = menubasistext (61){}          CAND subtext (fehler, 16, 20) <> menubasistext (62){}        THEN clear error; enable stop;{}             archivname := subtext (fehler, 16, length (fehler) - 1);{}             melde archiv nun wirklich richtig an;{}             fehler := "";{}             enable stop{}   ELIF subtext (fehler, 1, 14) = menubasistext (61){}          CAND subtext (fehler, 16, 20) = menubasistext (62){}        THEN clear error; enable stop;{}
+             archivname := "";{}             fehler     := menubasistext (62){}   ELSE clear error; enable stop;{}        archivname := ""{}   FI.{}  melde archiv nun wirklich richtig an:{}    IF eigene station{}       THEN reserve (archivname,/zieltaskname);{}       ELSE reserve (archivname, stationsnummer/zieltaskname){}    FI.{}END PROC archiv anmelden;{}PROC menu archiv neue diskette:{}  ueberpruefe reservierung;{}  melde neue diskette an.{}  ueberpruefe reservierung:{}    IF NOT (archiv gehoert mir AND kontakt mit zieltask erfolgt){}
+       THEN melde zieltaskerror (menubasistext (47));{}            LEAVE menu archiv neue diskette{}    FI.{}  melde neue diskette an:{}    TEXT VAR archivname :: "", meldung :: "";{}    menufootnote (menubasistext (21) + menubasistext (26));{}    archiv anmelden (archivname, meldung, FALSE);{}    IF archivname = ""{}       THEN behandle archivfehler{}       ELSE aktueller archivname := archivname{}    FI;{}    zieltask anzeigen.{}  behandle archivfehler:{}    melde zieltaskerror (meldung);{}    aktueller archivname := "".{}
+END PROC menu archiv neue diskette;{}PROC menu archiv schreiben:{}  dateioperation  mit zieltask (schreiben);{}  regenerate menuscreen{}END PROC menu archiv schreiben;{}PROC menu archiv checken:{}  dateioperation mit zieltask (checken);{}  regenerate menuscreen{}END PROC menu archiv checken;{}PROC menu archiv schreibcheck:{}  dateioperation mit zieltask (schreibcheck);{}  regenerate menuscreen{}END PROC menu archiv schreibcheck;{}PROC menu archiv holen:{}  dateioperation mit zieltask (holen);{}  regenerate menuscreen{}
+END PROC menu archiv holen;{}PROC menu archiv loeschen:{}  dateioperation mit zieltask (loeschen);{}  regenerate menuscreen{}END PROC menu archiv loeschen;{}PROC dateioperation mit zieltask (INT CONST wahl):{}  ueberpruefe kommunikationsbasis und sinnhaftigkeit;{}  lasse dateien auswaehlen;{}  operiere mit ausgewaehlten dateien.{}  ueberpruefe kommunikationsbasis und sinnhaftigkeit:{}    IF   unzulaessiger zieltaskname{}         THEN LEAVE dateioperation mit zieltask{}    ELIF zieltaskname = name (myself){}
+         THEN melde zieltaskerror (menubasistext (48));{}              LEAVE dateioperation mit zieltask{}    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{}         THEN melde zieltaskerror (menubasistext (47));{}              LEAVE dateioperation mit zieltask{}    ELIF NOT zieltask ist archivmanager{}         AND (wahl = checken OR wahl = schreibcheck){}         THEN gib hinweis auf unmoeglich;{}              LEAVE dateioperation mit zieltask{}    ELIF NOT zieltask ist archivmanager{}
+         THEN stelle kontakt mit zieltask her{}    ELIF wahl < schreiben OR wahl > loeschen{}         THEN LEAVE dateioperation mit zieltask{}    FI.{}  stelle kontakt mit zieltask her:{}    TEXT VAR fehler :: "";{}    IF task ist kommunikativ (fehler){}       THEN kontakt mit zieltask erfolgt := TRUE{}       ELSE melde zieltaskerror (fehler);{}            LEAVE dateioperation mit zieltask{}    FI.{}  gib hinweis auf unmoeglich:{}    menuinfo (menubasistext (121) + taskname + menubasistext (122)).{}
+  taskname:{}    IF eigene station{}       THEN zieltaskname{}       ELSE text (stationsnummer) + "/" + zieltaskname{}    FI.{}  lasse dateien auswaehlen:{}    THESAURUS VAR angekreuzte;{}    disable stop;{}    IF wahl = schreiben  OR wahl = schreibcheck{}       THEN angekreuzte := menusome (ALL myself, operationshinweis,{}                                     ankreuzhinweis, FALSE){}       ELSE angekreuzte := menusome (zieltaskthesaurus, operationshinweis,{}                                     ankreuzhinweis, FALSE){}
+    FI;{}    fehlerbehandlung.{}  zieltaskthesaurus:{}    IF eigene station{}       THEN ALL /zieltaskname{}       ELSE ALL (stationsnummer/zieltaskname){}    FI.{}  ankreuzhinweis:{}    menubasistext (91) + operationskennzeichnung (wahl) + menubasistext (92).{}  operationshinweis:{}    operationsbezeichnung (wahl) + zieltaskhinweis.{}  operiere mit ausgewaehlten dateien:{}    bereite bildschirm vor;{}    steige ggf bei leerem thesaurus aus;{}    IF wahl = schreiben OR wahl = schreibcheck{}       THEN zuerst loeschen{}
+    FI;{}    IF wahl = schreibcheck{}       THEN fehlerfall := FALSE;{}            dateioperation ausfuehren (angekreuzte, schreiben, FALSE);{}            IF NOT fehlerfall{}               THEN dateioperation ausfuehren (angekreuzte, checken, TRUE){}            FI{}       ELSE dateioperation ausfuehren (angekreuzte, wahl, TRUE){}    FI.{}  bereite bildschirm vor:{}    show menuwindow.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (angekreuzte){}       THEN menuwindowline (2);{}            menuwindowout (menubasistext (94));{}
+            menuwindowstop;{}            LEAVE dateioperation mit zieltask{}    FI.{}  zuerst loeschen:{}    menuwindowout (menuwindowcenter (menubasistext (21) + menubasistext (31)));{}    menuwindowline;{}    IF not empty (angekreuzte){}       THEN disable stop;{}            THESAURUS CONST zu loeschende ::{}                            angekreuzte / zieltaskthesaurus;{}            fehlerbehandlung;{}            biete ggf dateien zum loeschen an{}       ELSE menuwindowpage{}    FI.{}  biete ggf dateien zum loeschen an:{}
+    IF not empty (zu loeschende){}       THEN menuwindowout (menuwindowcenter (invers (menubasistext (108))));{}            menuwindowline;{}            menuwindowout (menuwindowcenter (menubasistext (109)));{}            menuwindowline (2);{}            dateien rausschmeissen{}       ELSE menuwindowpage{}    FI.{}  dateien rausschmeissen:{}    command dialogue (FALSE);{}    biete dateien einzeln zum loeschen an;{}    menuwindowpage;{}    command dialogue (TRUE).{}  biete dateien einzeln zum loeschen an:{}
+    INT VAR z, index;{}    FOR z FROM 1 UPTO highest entry (zu loeschende) REP{}      disable stop;{}      IF name (zu loeschende, z) <> ""{}         THEN stelle frage und fuehre aus{}      FI;{}      fehlerbehandlung{}    PER.{}  stelle frage und fuehre aus:{}    IF menuwindowyes ("'" + name (zu loeschende, z) + "' "{}                          + menubasistext (111)){}       THEN erase (name (zu loeschende, z), task (zieltaskname)){}       ELSE menuwindowout (menubasistext (110));{}            menuwindowline;{}
+            delete (angekreuzte, name (zu loeschende, z), index);{}            pause (20){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            melde zieltaskerror (errormessage);{}            clear error; enable stop;{}            LEAVE dateioperation mit zieltask{}    FI.{}END PROC dateioperation mit zieltask;{}PROC dateioperation ausfuehren (THESAURUS CONST angekreuzte,{}                                INT CONST wahl,{}                                BOOL CONST mit schlussbemerkung):{}
+  INT VAR spalte :: 1, zeile :: 3, k, anzahl :: 0;{}  menuwindowout (menuwindowcenter (invers (operationsbezeichnung (wahl){}                                        + zieltaskhinweis)));{}  command dialogue (FALSE);{}  fuehre einzelne operationen aus;{}  command dialogue (TRUE);{}  IF mit schlussbemerkung{}     THEN schreibe schlussbemerkung{}     ELSE menuwindowpage{}  FI.{}  fuehre einzelne operationen aus:{}    FOR k FROM 1 UPTO highest entry (angekreuzte) REP{}      IF name (angekreuzte, k) <> ""{}
+         THEN disable stop;{}              bildschirmausgabe;{}              operation ausfuehren;{}              anzahl INCR 1;{}              fehlerbehandlung{}      FI{}    PER.{}  bildschirmausgabe:{}    spalte := 1;{}    IF remaining menuwindowlines < 2{}       THEN menuwindowpage; zeile := 1{}       ELSE zeile INCR 1{}    FI;{}    menuwindowcursor (spalte, zeile);{}    ergaenzter dateiname.{}  ergaenzter dateiname:{}    INT VAR windowcolumn, windowrow;{}    SELECT wahl OF{}      CASE schreiben : menuwindowout (menubasistext (105) + dateiname){}
+      CASE checken   : get menuwindowcursor (windowcolumn, windowrow);{}                       menuwindowout (dateiname + menubasistext (106));{}                       menuwindowcursor (windowcolumn, windowrow);{}      CASE holen     : menuwindowout (menubasistext (107) + dateiname){}    END SELECT.{}  dateiname:{}    " """ + name (angekreuzte, k) + """ ".{}  operation ausfuehren:{}    IF eigene station{}       THEN fuehre eigenstationoperation aus{}       ELSE fuehre fremdstationoperation aus{}    FI.{}
+  fuehre eigenstationoperation aus:{}    SELECT wahl OF{}      CASE schreiben : save  (name (angekreuzte, k), /zieltaskname){}      CASE checken   : check (name (angekreuzte, k), /zieltaskname);{}                       bestaetige{}      CASE holen     : ueberschreiben erfragen eigene station{}      CASE loeschen  : loeschen erfragen eigene station{}    END SELECT.{}  ueberschreiben erfragen eigene station:{}    IF exists (name (angekreuzte, k)){}       THEN menuwindowline;{}            IF menuwindowyes (dateiname + menubasistext (112)){}
+               THEN zeile INCR 2;{}                    menuwindowline;{}                    forget (name (angekreuzte, k), quiet);{}                    fetch  (name (angekreuzte, k), /zieltaskname){}            FI{}       ELSE fetch (name (angekreuzte, k), /zieltaskname){}    FI.{}  loeschen erfragen eigene station:{}    IF menuwindowyes (dateiname + menubasistext (111)){}       THEN erase (name (angekreuzte, k), /zieltaskname){}    FI.{}  fuehre fremdstationoperation aus:{}    SELECT wahl OF{}      CASE schreiben : save  (name (angekreuzte, k), ziel){}
+      CASE checken   : check (name (angekreuzte, k), ziel); bestaetige{}      CASE holen     : ueberschreiben erfragen fremde station{}      CASE loeschen  : loeschen erfragen fremde station{}    END SELECT.{}  ueberschreiben erfragen fremde station:{}    IF exists (name (angekreuzte, k)){}       THEN menuwindowline;{}            IF menuwindowyes (dateiname + menubasistext (112)){}               THEN zeile INCR 2;{}                    menuwindowline;{}                    forget (name (angekreuzte, k), quiet);{}
+                    fetch  (name (angekreuzte, k), ziel){}            FI{}       ELSE fetch (name (angekreuzte, k), ziel){}    FI.{}  loeschen erfragen fremde station:{}    IF menuwindowyes (dateiname + menubasistext (111)){}       THEN erase (name (angekreuzte, k), ziel){}    FI.{}  ziel:{}    stationsnummer/zieltaskname.{}  bestaetige:{}    IF NOT is error{}       THEN menuwindowout (dateiname + menubasistext (114)){}    FI.{}  schreibe schlussbemerkung:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}
+       ELSE menuwindowline (2){}    FI;{}    IF anzahl > 0{}       THEN menuwindowout (menubasistext (93) +{}                           operationskennzeichnung (wahl)){}       ELSE menuwindowout (menubasistext (94)){}    FI;{}    menuwindowstop.{}  fehlerbehandlung:{}    IF is error{}       THEN fehlerfall := TRUE;{}            regenerate menuscreen;{}            melde zieltaskerror (errormessage);{}            clear error; enable stop;{}            LEAVE dateioperation ausfuehren{}    FI.{}END PROC dateioperation ausfuehren;{}
+TEXT PROC operationsbezeichnung (INT CONST nr):{}  SELECT nr OF{}    CASE schreiben    : menubasistext (95){}    CASE checken      : menubasistext (97){}    CASE schreibcheck : menubasistext (99){}    CASE holen        : menubasistext (101){}    CASE loeschen     : menubasistext (103){}    OTHERWISE ""{}  END SELECT{}END PROC operationsbezeichnung;{}TEXT PROC operationskennzeichnung (INT CONST nr):{}  SELECT nr OF{}    CASE schreiben    : menubasistext (96){}    CASE checken      : menubasistext (98){}
+    CASE schreibcheck : menubasistext (100){}    CASE holen        : menubasistext (102){}    CASE loeschen     : menubasistext (104){}    OTHERWISE ""{}  END SELECT{}END PROC operationskennzeichnung;{}BOOL PROC not empty (THESAURUS CONST t):{}  INT VAR i;{}  FOR i FROM 1 UPTO highest entry (t) REP{}    IF name (t, i) <> ""{}       THEN LEAVE not empty WITH TRUE{}    FI{}  PER;{}  FALSE{}END PROC not empty;{}TEXT PROC zieltaskhinweis:{}  IF   zieltaskname = "ARCHIVE"{}       THEN "(" + menubasistext (78) + ")"{}
+  ELIF zieltaskname = name (father){}       THEN "(" + menubasistext (79) + ")"{}  ELSE menubasistext (80) + zieltaskname + ")"{}  FI{}END PROC zieltaskhinweis;{}PROC menu archiv verzeichnis:{}  forget("Interne Dateiliste bei Archivoperation", quiet);{}  ueberpruefe kommunikationsbasis;{}  liste dateien der zieltask auf;{}  regenerate menuscreen.{}  ueberpruefe kommunikationsbasis:{}    IF   unzulaessiger zieltaskname{}         THEN LEAVE menu archiv verzeichnis{}    ELIF zieltaskname = name (myself){}
+         THEN LEAVE ueberpruefe kommunikationsbasis{}    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{}         THEN melde zieltaskerror (menubasistext (47));{}             LEAVE menu archiv verzeichnis{}    ELIF NOT zieltask ist archivmanager{}         THEN stelle kontakt mit zieltask her{}    FI.{}  stelle kontakt mit zieltask her:{}    TEXT VAR fehler :: "";{}    IF task ist kommunikativ (fehler){}       THEN kontakt mit zieltask erfolgt := TRUE{}       ELSE melde zieltaskerror (fehler);{}
+            LEAVE menu archiv verzeichnis{}    FI.{}  liste dateien der zieltask auf:{}    erstelle liste;{}    gib liste aus;{}    forget ("Interne Dateiliste bei Archivoperation", quiet).{}  erstelle liste:{}    menufootnote (menubasistext (21) + menubasistext (28));{}    FILE VAR f :: sequential file (output, "Interne Dateiliste bei Archivoperation");{}    disable stop;{}    IF eigene station{}       THEN list (f, /zieltaskname){}       ELSE list (f, stationsnummer/zieltaskname){}    FI;{}    IF is error{}
+       THEN melde zieltaskerror (errormessage);{}            forget ("Interne Dateiliste bei Archivoperation", quiet);{}            clear error; enable stop;{}            LEAVE menu archiv verzeichnis{}    FI;{}    enable stop.{}  gib liste aus:{}    modify (f);{}    IF NOT (zieltaskname = name (myself)){}       THEN to line (f, 1);{}            insert record (f);{}            notiere kopfzeile;{}            headline (f, menubasistext (43));{}       ELSE entferne eigenen namen aus der liste{}    FI;{}
+    to line (f, 1);{}    cursor on; menuwindowshow (f); cursor off.{}  notiere kopfzeile:{}    IF zieltask ist archivmanager{}       THEN write record (f, headline (f));{}       ELSE write record (f, zieltaskbezeichnung){}    FI.{}  entferne eigenen namen aus der liste:{}    TEXT VAR zeile :: ""; INT VAR i;{}    FOR i FROM lines (f) DOWNTO 1 REP{}      to line (f, i);{}      read record (f, zeile);{}      IF pos (zeile, "Interne Dateiliste bei Archivoperation") > 0{}         THEN delete record (f);{}
+              LEAVE entferne eigenen namen aus der liste{}      FI{}    PER{}END PROC menu archiv verzeichnis;{}PROC menu archiv verzeichnis drucken:{}  forget ("Interne Dateiliste bei Archivoperation", quiet);{}  ueberpruefe kommunikationsbasis;{}  erstelle listing;{}  drucke listing aus.{}  ueberpruefe kommunikationsbasis:{}    IF   unzulaessiger zieltaskname{}         THEN LEAVE menu archiv verzeichnis drucken{}    ELIF zieltaskname = name (myself){}         THEN LEAVE ueberpruefe kommunikationsbasis{}
+    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir{}         THEN melde zieltaskerror (menubasistext (47));{}             LEAVE menu archiv verzeichnis drucken{}    ELIF NOT zieltask ist archivmanager{}         THEN stelle kontakt mit zieltask her{}    FI.{}  stelle kontakt mit zieltask her:{}    TEXT VAR fehler :: "";{}    IF task ist kommunikativ (fehler){}       THEN kontakt mit zieltask erfolgt := TRUE{}       ELSE melde zieltaskerror (fehler);{}            LEAVE menu archiv verzeichnis drucken{}
+    FI.{}  erstelle listing:{}    LET dummy name pos = 18;{}    FILE VAR listfile; INT VAR i; TEXT VAR record :: "";{}    TEXT CONST head :: 70 * "=", end :: 70 * "-";{}    IF menuno (menubasistext (90), 5){}       THEN LEAVE menu archiv verzeichnis drucken{}    FI;{}    menufootnote (menubasistext (21) + menubasistext (29));{}    disable stop;{}    listfile := sequential file (output, "Interne Dateiliste bei Archivoperation");{}    IF eigene station{}       THEN list (listfile, /zieltaskname){}       ELSE list (listfile, stationsnummer/zieltaskname){}
+    FI;{}    IF is error{}       THEN melde zieltaskerror (errormessage);{}            forget ("Interne Dateiliste bei Archivoperation", quiet);{}            clear error; enable stop;{}            LEAVE menu archiv verzeichnis drucken{}    FI;{}    enable stop.{}  drucke listing aus:{}    schreibe dateikopf;{}    loesche dummy names;{}    schreibe fuss;{}    drucke und loesche listing.{}  schreibe dateikopf:{}    modify (listfile);{}    to line (listfile, 1);{}    FOR i FROM 1 UPTO 6 REP insert record (listfile) PER;{}
+    to line (listfile, 1);{}    write record (listfile, "#type (""elanlist"")#"); down (listfile);{}    write record (listfile, "#start (2.5,0.0)##limit (20,5)#"{}                            + "#pagelength (26.0)#"); down (listfile);{}    write record (listfile, head); down (listfile);{}    schreibe erkennungszeile; down (listfile);{}    write record (listfile, "        Listing vom " + date + ",  "{}                            + time of day + " Uhr"); down (listfile);{}    write record (listfile, head).{}
+  schreibe erkennungszeile:{}    IF zieltask ist archivmanager{}       THEN write record (listfile, "Archiv: " + headline (listfile)){}       ELSE write record (listfile, "Task  : " + taskbezeichnung){}    FI.{}  taskbezeichnung:{}    IF eigene station{}       THEN zieltaskname{}       ELSE text (stationsnummer) + "/" + zieltaskname{}    FI.{}  loesche dummy names:{}    to line (listfile, 8);{}    WHILE NOT eof (listfile) REP{}      read record (listfile, record);{}      IF (record SUB dummy name pos) = "-"{}
+         OR pos (record, "Interne Dateiliste bei Archivoperation") > 0{}         THEN delete record (listfile){}         ELSE down (listfile){}      FI{}    PER.{}  schreibe fuss:{}    output (listfile);{}    putline (listfile, end).{}  drucke und loesche listing:{}    menufootnote (menubasistext (21) + menubasistext (30));{}    disable stop;{}    print ("Interne Dateiliste bei Archivoperation");{}    IF is error{}       THEN melde zieltaskerror (errormessage);{}            clear error; enable stop;{}
+            forget ("Interne Dateiliste bei Archivoperation", quiet);{}            LEAVE menu archiv verzeichnis drucken{}    FI;{}    enable stop;{}    forget ("Interne Dateiliste bei Archivoperation", quiet){}END PROC menu archiv verzeichnis drucken;{}TEXT PROC zieltaskbezeichnung:{}  IF eigene station{}     THEN menubasistext (77) + taskbezeichnung{}     ELSE menubasistext (76) + text (stationsnummer) + "   " +{}          menubasistext (77) + zieltaskname{}  FI.{}  taskbezeichnung:{}    IF   zieltaskname = "ARCHIVE"{}
+         THEN menubasistext (78){}    ELIF zieltaskname = name (father){}         THEN menubasistext (79) + " (" + zieltaskname + ")"{}         ELSE zieltaskname{}    FI{}END PROC zieltaskbezeichnung;{}BOOL PROC unzulaessiger zieltaskname:{}  IF compress (zieltaskname) = "" OR compress (zieltaskname) = "-"{}     THEN TRUE{}     ELSE FALSE{}  FI{}END PROC unzulaessiger zieltaskname;{}PROC menu archiv initialisieren:{}  TEXT VAR archivname :: "", meldung :: "";{}  klaere zieltaskart;{}  formatiere ggf;{}
+  initialisiere ggf.{}  klaere zieltaskart:{}    IF NOT zieltask ist archivmanager{}       THEN menuinfo (menubasistext (121) + zieltaskname +{}                      menubasistext (122));{}            LEAVE menu archiv initialisieren{}    FI.{}  formatiere ggf:{}    IF menuyes (menubasistext (85), 5){}       THEN nimm archiv in beschlag;{}            fuehre formatierung aus{}    FI.{}  nimm archiv in beschlag:{}    stelle archivbesitz sicher;{}    IF aktueller archivname <> ""{}       THEN archivname := aktueller archivname{}
+       ELSE archivname := menubasistext (75){}    FI;{}    IF eigene station{}       THEN reserve (archivname,/zieltaskname){}       ELSE reserve (archivname, stationsnummer/zieltaskname){}    FI;{}    aktueller archivname := archivname;{}    archiv gehoert mir   := TRUE;{}    zieltask anzeigen.{}  stelle archivbesitz sicher:{}    IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt{}           THEN versuche kommunikation;{}                versuche archiv zu reservieren (meldung);{}                werte meldung aus{}
+    FI.{}  versuche kommunikation:{}    TEXT VAR fehler :: "";{}    IF NOT task ist kommunikativ (fehler){}       THEN melde zieltaskerror (fehler);{}            melde rigoros ab;{}            LEAVE menu archiv initialisieren{}       ELSE kontakt mit zieltask erfolgt := TRUE{}    FI.{}  werte meldung aus:{}    IF meldung <> ""{}       THEN melde zieltaskerror (meldung);{}            aktueller archivname := "";{}            zieltask anzeigen;{}            LEAVE menu archiv initialisieren{}    FI.{}
+  fuehre formatierung aus:{}    INT VAR auswahl :: menualternative (menubasistext (54),{}                                        menubasistext (55),{}                                        menubasistext (56), 5, TRUE);{}    IF auswahl = 0{}       THEN LEAVE fuehre formatierung aus{}    FI;{}    IF auswahl > 100{}       THEN auswahl DECR 100{}    FI;{}    command dialogue (FALSE);{}    disable stop;{}    menufootnote (menubasistext (21) + menubasistext (27));{}    IF eigene station{}       THEN formatiere auf eigener station{}
+       ELSE formatiere auf fremder station{}    FI;{}    IF is error{}       THEN melde zieltaskerror (errormessage);{}            clear error; enable stop;{}            command dialogue (TRUE);{}            LEAVE formatiere ggf{}       ELSE enable stop;{}            command dialogue (TRUE);{}            aktiviere gueltige archivmenupunkte;{}            refresh submenu;{}            zieltask anzeigen{}    FI.{}  formatiere auf eigener station:{}    IF auswahl < 5{}       THEN format (auswahl, /zieltaskname){}
+       ELSE format (/zieltaskname){}    FI.{}  formatiere auf fremder station:{}     IF auswahl < 5{}       THEN format (auswahl, stationsnummer/zieltaskname){}       ELSE format (stationsnummer/zieltaskname){}    FI.{}  initialisiere ggf:{}    stelle archivbesitz sicher;{}    archiv anmelden (archivname, meldung, FALSE);{}    IF   archivname <> ""{}         THEN aktueller archivname := archivname;{}              archiv gehoert mir   := TRUE;{}              aktiviere gueltige archivmenupunkte;{}              refresh submenu;{}
+              zieltask anzeigen;{}              frage nach ueberschreiben{}    ELIF meldung = menubasistext (63) OR meldung = menubasistext (62){}         THEN frage nach initialisieren{}    ELSE melde zieltaskerror (meldung);{}         aktueller archivname := "";{}         zieltask anzeigen;{}         LEAVE menu archiv initialisieren{}    FI.{}  frage nach ueberschreiben:{}    IF menuyes (menubasistext (86) + archivname + menubasistext (87), 5){}       THEN erfrage neuen namen und initialisiere{}
+       ELSE LEAVE menu archiv initialisieren{}    FI.{}  frage nach initialisieren:{}    IF menuyes (menubasistext (88), 5){}       THEN erfrage neuen namen und initialisiere{}       ELSE LEAVE menu archiv initialisieren{}    FI.{}  erfrage neuen namen und initialisiere:{}    TEXT VAR neuer name := compress(menuanswer (menubasistext (89),{}                                                aktueller archivname, 5));{}    IF   neuer name <> ""{}         THEN archivname := neuer name{}    ELIF neuer name = "" AND archivname = ""{}
+         THEN archivname := menubasistext (75){}    FI;{}    command dialogue (FALSE);{}    disable stop;{}    IF eigene station{}       THEN reserve (archivname, /zieltaskname);{}            clear (/zieltaskname){}       ELSE reserve (archivname, stationsnummer/zieltaskname);{}            clear (stationsnummer/zieltaskname){}    FI;{}    IF is error{}       THEN melde zieltaskerror (errormessage);{}            clear error; enable stop;{}            command dialogue (TRUE);{}            melde rigoros ab;{}
+            archivreservierung aufgeben;{}            aktiviere gueltige archivmenupunkte;{}            refresh submenu;{}            zieltask anzeigen;{}            LEAVE menu archiv initialisieren{}       ELSE enable stop; command dialogue (TRUE);{}            aktueller archivname := archivname;{}            archiv gehoert mir   := TRUE;{}            aktiviere gueltige archivmenupunkte;{}            refresh submenu;{}            zieltask anzeigen{}    FI{}END PROC menu archiv initialisieren;{}PROC archive (TEXT CONST archive name,task, INT CONST station):{}
+  call (reserve code, archive name, station/task){}END PROC archive;{}PROC menu archiv reservierung aufgeben:{}  IF archiv gehoert mir{}     THEN menufootnote (menubasistext (21) + menubasistext (22));{}          archivreservierung aufgeben;{}  FI;{}  erase menunotice;{}  old menufootnote{}END PROC menu archiv reservierung aufgeben;{}PROC archivreservierung aufgeben:{}  command dialogue (FALSE);{}  disable stop;{}  IF eigene station{}     THEN release (/zieltaskname){}     ELSE release (stationsnummer/zieltaskname);{}
+  FI;{}  IF is error{}     THEN clear error{}  FI;{}  enable stop;{}  command dialogue (TRUE);{}  archiv gehoert mir   := FALSE;{}  aktueller archivname := ""{}END PROC archivreservierung aufgeben;{}BOOL PROC eigene station:{}  IF stationsnummer = 0 OR stationsnummer = station (myself){}     THEN TRUE{}     ELSE FALSE{}  FI{}END PROC eigene station;{}PROC aktiviere gueltige archivmenupunkte:{}  IF   zieltask ist archivmanager AND NOT archiv gehoert mir{}       THEN aktiviere nur grundfunktionen{}
+  ELSE aktiviere alle momentan gueltigen punkte{}  FI.{}  aktiviere alle momentan gueltigen punkte:{}    IF letzte funktion = 11{}       THEN activate (1); activate (2);{}            activate (4); activate (5); activate (6); activate (7); activate (8);{}            activate (10); activate (11);{}            activate (13); activate (14);{}    ELIF letzte funktion = 6{}       THEN deactivate (1); deactivate (2);{}            activate (4); deactivate (5); deactivate (6); activate (7); activate (8);{}
+            activate (10); activate (11);{}            deactivate (13); activate (14);{}    FI.{}  aktiviere nur grundfunktionen:{}     activate (1); deactivate (2);{}     deactivate (4); deactivate (5); deactivate (6); deactivate (7); deactivate (8);{}     deactivate (10); deactivate (11);{}     activate (13); activate (14).{}END PROC aktiviere gueltige archivmenupunkte;{}PROC zieltask anzeigen:{}  IF zieltask ist archivmanager{}     THEN schreibe taskname und archivname{}     ELSE schreibe taskname{}
+  FI.{}  schreibe taskname:{}    write menunotice (menubasistext (59) + ""13"" + name der task, notizort).{}  schreibe taskname und archivname:{}    write menunotice (menubasistext (59) + ""13"" + name der task +{}                      ""13"" + menubasistext (60) + ""13"" + archivname,{}                      notizort).{}  name der task:{}    IF   zieltaskname = "ARCHIVE" AND eigene station{}         THEN " " + menubasistext (71){}    ELIF zieltaskname = "PUBLIC"  AND eigene station{}         THEN " " + menubasistext (72){}
+    ELIF zieltaskname = name (father){}         THEN " " + menubasistext (73){}    ELSE " " + ggf gekuerzter zieltaskname{}    FI.{}  ggf gekuerzter zieltaskname:{}    TEXT VAR interner name;{}    IF eigene station{}       THEN interner name := zieltaskname;{}       ELSE interner name := text (stationsnummer) + "/" + zieltaskname{}    FI;{}    IF length (interner name) < 20{}       THEN ""15"" + interner name + " "14""{}       ELSE ""15"" + subtext (interner name, 1 , 18) + ".." + " "14""{}    FI.{}
+  archivname:{}    IF NOT archiv gehoert mir OR aktueller archivname = ""{}       THEN " " + menubasistext (74){}       ELSE " "15"" + ggf gekuerzter archivname + " "14""{}    FI.{}  ggf gekuerzter archivname:{}    IF   eigene station AND length (aktueller archivname) > 20{}         THEN subtext (aktueller archivname, 1, 18) + ".."{}    ELIF NOT eigene station AND length (aktueller archivname) > 17{}         THEN subtext (aktueller archivname, 1, 15) + ".."{}    ELSE aktueller archivname{}    FI.{}
+END PROC zieltask anzeigen;{}BOOL PROC task ist kommunikativ (TEXT VAR  fehler):{}  INT VAR antwort;{}  DATASPACE VAR dummy space := nilspace;{}    IF zieltask ist archivmanager{}       THEN schicke reservierungscode{}       ELSE schicke listcode{}    FI.{}  schicke reservierungscode:{}    disable stop;{}    IF eigene station{}       THEN pingpong (/zieltaskname, reserve code, dummy space, antwort);{}       ELSE pingpong (stationsnummer/zieltaskname, reserve code,{}                      dummy space, antwort){}
+    FI;{}    werte antwort aus.{}  schicke listcode:{}    disable stop;{}    IF eigene station{}       THEN pingpong (/zieltaskname, list code, dummy space, antwort);{}       ELSE pingpong (stationsnummer/zieltaskname, list code,{}                      dummy space, antwort){}    FI;{}    werte antwort aus.{}  werte antwort aus:{}    IF is error{}       THEN clear error{}    FI;{}    BOUND TEXT VAR inhalt := dummy space;{}    enable stop;{}    IF   antwort  =   0 THEN fehler := ""{}    ELIF antwort  =  -1 THEN fehler := menubasistext (41){}
+    ELIF antwort  =  -2 THEN fehler := menubasistext (42){}    ELSE fehler  := inhalt{}    FI;{}    forget (dummy space);{}    IF antwort = ack{}       THEN kontakt mit zieltask erfolgt := TRUE;  TRUE{}       ELSE kontakt mit zieltask erfolgt := FALSE; FALSE{}    FI{}END PROC task ist kommunikativ;{}END PACKET ls dialog 6;{}
+
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG 7 b/app/gs.dialog/1.2/src/ls-DIALOG 7
new file mode 100644
index 0000000..467f531
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG 7
@@ -0,0 +1,54 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                     ls-DIALOG 7                     ** 
+          **                    Dateihandling                    ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET  ls dialog 7  DEFINES{}        menu dateien verzeichnis,{}        menu dateien loeschen,{}        menu dateien drucken,{}        menu dateien kopieren,{}        menu dateien umbenennen,{}        menu dateien speicherplatz,{}        menu dateien aufraeumen:{}LET filetype  = 1003,{}    maxlaenge =   60,{}    breite    =   40,{}    niltext   =   "";{}TEXT CONST dateibez :: "Dateiliste bei internen Operationen";{}PROC menu dateien verzeichnis:{}  forget (dateibez, quiet);{}  liste dateien auf;{}
+  regenerate menuscreen.{}  liste dateien auf:{}    erstelle liste;{}    gib liste aus;{}    forget (dateibez, quiet).{}  erstelle liste:{}    menufootnote (menubasistext (21) + menubasistext (28));{}    FILE VAR f :: sequential file (output, dateibez);{}    list (f); modify (f);{}    headline (f, menubasistext (43));{}    to line (f, 1); insert record (f);{}    write record (f, menubasistext (161));{}    entferne eigenen namen aus der liste.{}  entferne eigenen namen aus der liste:{}    TEXT VAR zeile :: ""; INT VAR i;{}
+    FOR i FROM lines (f) DOWNTO 1 REP{}      to line (f, i); read record (f, zeile);{}      IF pos (zeile, dateibez) > 0{}         THEN delete record (f);{}              LEAVE entferne eigenen namen aus der liste{}      FI{}    PER.{}  gib liste aus:{}    to line (f, 1); cursor on; menuwindowshow (f); cursor off{}END PROC menu dateien verzeichnis;{}PROC menu dateien loeschen:{}  lasse dateien auswaehlen;{}  loesche ausgewaehlte dateien;{}  regenerate menuscreen.{}  lasse dateien auswaehlen:{}    IF NOT not empty (ALL myself){}
+       THEN noch keine datei;{}            LEAVE menu dateien loeschen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    THESAURUS VAR angekreuzte :={}    menuanswersome ( center (breite, invers (menubasistext(162))) +{}                     menubasistext (163), "", ALL myself,{}                     menubasistext (162), menubasistext (91) +{}                     menubasistext (104) + menubasistext (92), FALSE).{}  loesche ausgewaehlte dateien:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}
+    menuwindowout (menuwindowcenter (invers (menubasistext (162))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operation aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (menubasistext (93) + menubasistext (104));{}    menuwindowstop.{}  fuehre einzelne operation aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (angekreuzte) REP{}      IF   name (angekreuzte, k) = niltext{}           THEN LEAVE fuehre einzelne operation aus{}
+      ELIF NOT exists (name (angekreuzte, k)){}           THEN menuwindowout (" """ + name (angekreuzte, k) + """");{}                menuwindowline;{}                menuwindowout (menubasistext (188)); menuwindowline;{}                LEAVE fuehre einzelne operation aus{}      ELSE disable stop;{}           IF menuwindowyes (" """ + name (angekreuzte, k) + """ "{}                                   + menubasistext (111)){}              THEN forget (name (angekreuzte, k), quiet){}           FI;{}
+           fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (angekreuzte){}       THEN menuwindowline (2);{}            menuwindowout (menubasistext (94));{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE menu dateien loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}
+       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}            LEAVE menu dateien loeschen{}    FI{}END PROC menu dateien loeschen;{}PROC menu dateien drucken:{}  lasse programme auswaehlen;{}  drucke programme;{}  regenerate menuscreen.{}  lasse programme auswaehlen:{}    IF NOT not empty (ALL myself){}       THEN noch keine datei;{}            LEAVE menu dateien drucken{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}
+    THESAURUS VAR angekreuzte :={}    menuanswersome ( center (breite, invers (menubasistext(164))) +{}                     menubasistext (163), "", ALL myself,{}                     menubasistext (164), menubasistext (91) +{}                     menubasistext (165) + menubasistext (92), FALSE).{}  drucke programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (menubasistext (164))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}
+    fuehre einzelne operation aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (menubasistext (93) + menubasistext (165));{}    menuwindowstop.{}  fuehre einzelne operation aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (angekreuzte) REP{}      IF   name (angekreuzte, k) = niltext{}           THEN LEAVE fuehre einzelne operation aus{}      ELIF NOT exists (name (angekreuzte, k)){}           THEN menuwindowout (" """ + name (angekreuzte, k) + """");{}
+                menuwindowline;{}                menuwindowout (menubasistext (188)); menuwindowline;{}                LEAVE fuehre einzelne operation aus{}      ELSE disable stop;{}           menuwindowout ( " """ + name (angekreuzte, k) + """ "{}                                 + menubasistext (166));{}           menuwindowline;{}           print (name (angekreuzte, k));{}           fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (angekreuzte){}
+       THEN menuwindowline (2);{}            menuwindowout (menubasistext (94));{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE menu dateien drucken{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}
+            LEAVE menu dateien drucken{}    FI.{}END PROC menu dateien drucken;{}PROC menu dateien kopieren:{}  ermittle alten dateinamen;{}  erfrage neuen dateinamen;{}  kopiere ggf die datei.{}  ermittle alten dateinamen:{}    IF NOT not empty (ALL myself){}       THEN noch keine datei;{}            LEAVE menu dateien kopieren{}       ELSE hole den namen{}    FI.{}  hole den namen:{}    TEXT VAR alter name :={}    menuanswerone ( center (breite, invers (menubasistext(167))) +{}                    menubasistext (163), "", ALL myself,{}
+                    menubasistext (167), menubasistext (168) +{}                    menubasistext (169) + menubasistext (170), TRUE);{}    IF   alter name = niltext{}         THEN LEAVE menu dateien kopieren{}    ELIF NOT exists (alter name){}         THEN menuinfo (menubasistext (188));{}              LEAVE menu dateien kopieren{}    FI.{}  erfrage neuen dateinamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + menubasistext (171) + bisheriger name{}
+                  + menubasistext (172).{}  ueberschrift:{}    center (maxlaenge, invers (menubasistext (167))) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  kopiere ggf die datei:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (menubasistext (173)));{}              LEAVE menu dateien kopieren{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE menu dateien kopieren{}       ELSE copy (alter name, neuer name){}
+    FI.{}  mache vorwurf:{}    menuinfo (menubasistext (174)).{}END PROC menu dateien kopieren;{}PROC menu dateien umbenennen:{}  ermittle alten dateinamen;{}  erfrage neuen dateinamen;{}  benenne ggf die datei um.{}  ermittle alten dateinamen:{}    IF NOT not empty (ALL myself){}       THEN noch keine datei;{}            LEAVE menu dateien umbenennen{}       ELSE hole den namen{}    FI.{}  hole den namen:{}    TEXT VAR alter name :={}    menuanswerone ( center (breite, invers (menubasistext(175))) +{}
+                    menubasistext (163), "", ALL myself,{}                    menubasistext (175), menubasistext (168) +{}                    menubasistext (176) + menubasistext (170), TRUE);{}    IF   alter name = niltext{}         THEN LEAVE menu dateien umbenennen{}    ELIF NOT exists (alter name){}         THEN menuinfo (menubasistext (188));{}              LEAVE menu dateien umbenennen{}    FI.{}  erfrage neuen dateinamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}
+     ueberschrift + menubasistext (171) + bisheriger name{}                  + menubasistext (177).{}  ueberschrift:{}    center (maxlaenge, invers (menubasistext (175))) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  benenne ggf die datei um:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (menubasistext (173)));{}              LEAVE menu dateien umbenennen{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE menu dateien umbenennen{}
+       ELSE rename (alter name, neuer name){}    FI.{}  mache vorwurf:{}    menuinfo (menubasistext (174)).{}END PROC menu dateien umbenennen;{}PROC menu dateien speicherplatz:{}  lasse dateinamen auswaehlen;{}  ermittle den speicherplatz;{}  regenerate menuscreen.{}  lasse dateinamen auswaehlen:{}    IF NOT not empty (ALL myself){}       THEN noch keine datei;{}            LEAVE menu dateien speicherplatz{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    THESAURUS VAR angekreuzte :={}
+    menuanswersome ( center (breite, invers (menubasistext(178))) +{}                     menubasistext (163), "", ALL myself,{}                     menubasistext (178), menubasistext (179), FALSE).{}  ermittle den speicherplatz:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (menubasistext (178))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operation aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}
+    menuwindowout (menubasistext (180));{}    menuwindowstop.{}  fuehre einzelne operation aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (angekreuzte) REP{}      IF   name (angekreuzte, k) = niltext{}           THEN LEAVE fuehre einzelne operation aus{}      ELIF NOT exists (name (angekreuzte, k)){}           THEN menuwindowout (" """ + name (angekreuzte, k) + """");{}                menuwindowline;{}                menuwindowout (menubasistext (188)); menuwindowline;{}                LEAVE fuehre einzelne operation aus{}
+      ELSE disable stop;{}           menuwindowout ( " """ + name (angekreuzte, k) + """ "{}                                 + menubasistext (181){}                                 + speicherplatz (name (angekreuzte, k)));{}           menuwindowline;{}           fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (angekreuzte){}       THEN menuwindowline (2);{}            menuwindowout (menubasistext (94));{}            menuwindowstop;{}            regenerate menuscreen;{}
+            LEAVE menu dateien speicherplatz{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}            LEAVE menu dateien speicherplatz{}    FI.{}END PROC menu dateien speicherplatz;{}TEXT PROC speicherplatz (TEXT CONST dateiname):{}
+  DATASPACE VAR ds :: old (dateiname);{}  INT CONST platz    :: storage (ds);{}  forget (ds);{}  " " + text (platz) + menubasistext (182){}END PROC speicherplatz;{}PROC menu dateien aufraeumen:{}  lasse dateinamen auswaehlen;{}  raeume die dateien auf;{}  regenerate menuscreen.{}  lasse dateinamen auswaehlen:{}    IF NOT not empty (ALL myself){}       THEN noch keine datei;{}            LEAVE menu dateien aufraeumen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    THESAURUS VAR angekreuzte :={}
+    menuanswersome ( center (breite, invers (menubasistext(183))) +{}                     menubasistext (163), "", ALL myself,{}                     menubasistext (183), menubasistext (91) +{}                     menubasistext (184) + menubasistext (92), FALSE).{}  raeume die dateien auf:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (menubasistext (183))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operation aus;{}
+    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (menubasistext (93) + menubasistext (184));{}    menuwindowstop.{}  fuehre einzelne operation aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (angekreuzte) REP{}      IF   name (angekreuzte, k) = niltext{}           THEN LEAVE fuehre einzelne operation aus{}      ELIF NOT exists (name (angekreuzte, k)){}           THEN menuwindowout (" """ + name (angekreuzte, k) + """");{}                menuwindowline;{}                menuwindowout (menubasistext (188)); menuwindowline;{}
+                LEAVE fuehre einzelne operation aus{}      ELIF dateityp ist ok{}           THEN disable stop;{}                menuwindowline;{}                menuwindowout ( " """ + name (angekreuzte, k) + """ "{}                                      + menubasistext (185) );{}                menuwindowline; menuwindowout ("   ");{}                reorganize (name (angekreuzte, k));{}                fehlerbehandlung{}      ELSE menuwindowout ( " """ + name (angekreuzte, k) + """ "{}                                 + menubasistext (186)){}
+      FI{}    PER.{}  dateityp ist ok:{}   type (old (name (angekreuzte, k))) = filetype.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (angekreuzte){}       THEN menuwindowline (2);{}            menuwindowout (menubasistext (94));{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE menu dateien aufraeumen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}
+    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}            LEAVE menu dateien aufraeumen{}    FI.{}END PROC menu dateien aufraeumen;{}PROC noch keine datei:{}  menuinfo (menubasistext ( 187)){}END PROC noch keine datei;{}END PACKET ls dialog 7;{}
+
diff --git a/dialog/ls-DIALOG MENUKARTEN MANAGER b/app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER
index a6fcb1f..67799ea 100644
--- a/dialog/ls-DIALOG MENUKARTEN MANAGER
+++ b/app/gs.dialog/1.2/src/ls-DIALOG MENUKARTEN MANAGER
@@ -22,45 +22,7 @@
  
                                                                            *) 
  
-PACKET  ls dialog manager DEFINES
-     ls dialog manager:
-LET  fetch    code  =  11,
-     save     code  =  12,
-     exists   code  =  13,
-     list     code  =  15,
-     continue code  = 100;
-LET mm taskname   = "ls-MENUKARTEN",
-    gibt es schon  = "Die Task 'ls-MENUKARTEN' existiert schon!",
-    verweis        = "Unzulässiger Zugriff auf die Task 'ls-MENUKARTEN'!";
-PROC ls dialog manager:
-  stelle richtigen tasknamen ein;
-  global manager
-  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) ls dialog manager)
-
-END PROC ls dialog manager;
-PROC stelle richtigen tasknamen ein:
-  IF name (myself) <> mm taskname
-     THEN nimm umbenennung vor
-  FI.
-  nimm umbenennung vor:
-    IF NOT exists task (mm taskname)
-       THEN rename myself (mm taskname)
-       ELSE errorstop (gibt es schon)
-    FI.
-END PROC stelle richtigen tasknamen ein;
-PROC ls dialog manager (DATASPACE VAR ds, INT CONST order, phase,
-                        TASK CONST order task):
-  IF   order task = supervisor
-    OR order      = fetch    code
-
-    OR order      = save     code
-    OR order      = exists   code
-    OR order      = list     code
-    OR order      = continue code
-    THEN free manager (ds, order, phase, order task)
-    ELSE errorstop (verweis)
-  FI
-END PROC ls dialog manager;
-END PACKET ls dialog manager;
-
+PACKET  ls dialog manager DEFINES{}     ls dialog manager:{}LET  fetch    code  =  11,{}     save     code  =  12,{}     exists   code  =  13,{}     list     code  =  15,{}     continue code  = 100;{}LET mm taskname   = "ls-MENUKARTEN",{}    gibt es schon  = "Die Task 'ls-MENUKARTEN' existiert schon!",{}    verweis        = "Unzulässiger Zugriff auf die Task 'ls-MENUKARTEN'!";{}PROC ls dialog manager:{}  stelle richtigen tasknamen ein;{}  global manager{}  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) ls dialog manager){}
+END PROC ls dialog manager;{}PROC stelle richtigen tasknamen ein:{}  IF name (myself) <> mm taskname{}     THEN nimm umbenennung vor{}  FI.{}  nimm umbenennung vor:{}    IF NOT exists task (mm taskname){}       THEN rename myself (mm taskname){}       ELSE errorstop (gibt es schon){}    FI.{}END PROC stelle richtigen tasknamen ein;{}PROC ls dialog manager (DATASPACE VAR ds, INT CONST order, phase,{}                        TASK CONST order task):{}  IF   order task = supervisor{}    OR order      = fetch    code{}
+    OR order      = save     code{}    OR order      = exists   code{}    OR order      = list     code{}    OR order      = continue code{}    THEN free manager (ds, order, phase, order task){}    ELSE errorstop (verweis){}  FI{}END PROC ls dialog manager;{}END PACKET ls dialog manager;{}
 
diff --git a/dialog/ls-DIALOG MM-gen b/app/gs.dialog/1.2/src/ls-DIALOG MM-gen
index 213a826..ef05853 100644
--- a/dialog/ls-DIALOG MM-gen
+++ b/app/gs.dialog/1.2/src/ls-DIALOG MM-gen
@@ -22,29 +22,6 @@
  
                                                                            *) 
  
-LET dateiname  = "ls-DIALOG MENUKARTEN MANAGER",
-    archivname = "gs-dialog";
-gib bildschirmhinweis;
-hole generatordatei vom archiv;
-insertiere die datei;
-do ("ls dialog manager").
-gib bildschirmhinweis:
-  page;
-  putline ("              "15"ls-DIALOG MENUKARTEN MANAGER - Generierung "14"").
-hole generatordatei vom archiv:
-  IF NOT exists (dateiname)
-     THEN cursor (1, 5); out (""4"");
-          putline ("Bitte warten... Ich hole eine Datei von der Diskette!");
-          archive (archivname);
-
-          fetch (dateiname, archive);
-          release (archive)
-  FI.
-insertiere die datei:
-  cursor (1, 5); out (""4"");
-  putline ("Bitte warten... Ich insertiere!");
-  check off; insert (dateiname); check on;
-  forget ("ls-DIALOG MM/gen", quiet);
-  forget (dateiname, quiet).
-
+LET dateiname  = "ls-DIALOG MENUKARTEN MANAGER",{}    archivname = "gs-dialog";{}gib bildschirmhinweis;{}hole generatordatei vom archiv;{}insertiere die datei;{}do ("ls dialog manager").{}gib bildschirmhinweis:{}  page;{}  putline ("              "15"ls-DIALOG MENUKARTEN MANAGER - Generierung "14"").{}hole generatordatei vom archiv:{}  IF NOT exists (dateiname){}     THEN cursor (1, 5); out (""4"");{}          putline ("Bitte warten... Ich hole eine Datei von der Diskette!");{}          archive (archivname);{}
+          fetch (dateiname, archive);{}          release (archive){}  FI.{}insertiere die datei:{}  cursor (1, 5); out (""4"");{}  putline ("Bitte warten... Ich insertiere!");{}  check off; insert (dateiname); check on;{}  forget ("ls-DIALOG MM/gen", quiet);{}  forget (dateiname, quiet).{}
 
diff --git a/dialog/ls-DIALOG decompress b/app/gs.dialog/1.2/src/ls-DIALOG decompress
index fdda0d6..96d9340 100644
--- a/dialog/ls-DIALOG decompress
+++ b/app/gs.dialog/1.2/src/ls-DIALOG decompress
@@ -69,8 +69,7 @@ PROC komprimiere (TEXT CONST dateiname):
  
   haenge zeilentrenner an: 
     IF zwischenzeile <> "" 
-       THEN zwischenzeile CAT "
-" 
+       THEN zwischenzeile CAT "{}" 
     FI. 
  
   haenge zwischenzeile an ausgabezeile: 
@@ -139,15 +138,13 @@ PROC dekomprimiere (TEXT CONST dateiname):
     PER. 
  
   nimm das erste stueck und schreibe es weg: 
-    ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, "
-") - 1); 
+    ausgabezeile := subtext (eingabezeile, 1, pos (eingabezeile, "{}") - 1); 
     putline (aus, ausgabezeile); 
     zaehler INCR 1; 
     cout (zaehler). 
  
   entferne den zeilentrenner: 
-    eingabezeile := subtext (eingabezeile, pos (eingabezeile, "
-") + 2). 
+    eingabezeile := subtext (eingabezeile, pos (eingabezeile, "{}") + 2). 
 END PROC dekomprimiere; 
 END PACKET ls dialog decompress; 
 
diff --git a/app/gs.dialog/1.2/src/ls-DIALOG-gen b/app/gs.dialog/1.2/src/ls-DIALOG-gen
new file mode 100644
index 0000000..e085616
--- /dev/null
+++ b/app/gs.dialog/1.2/src/ls-DIALOG-gen
@@ -0,0 +1,34 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                      ls-DIALOG                      ** 
+          **                  GENERATORPROGRAMM                  ** 
+          **                     Version 1.2                     ** 
+          **                                                     ** 
+          **                  (Stand: 04.11.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+LET mm taskname = "ls-MENUKARTEN",{}    datei 1     = "ls-DIALOG 1",{}    datei 2     = "ls-DIALOG 2",{}    datei 3     = "ls-DIALOG 3",{}    datei 4     = "ls-DIALOG 4",{}    datei 5     = "ls-DIALOG 5",{}    datei 6     = "ls-DIALOG 6",{}    datei 7     = "ls-DIALOG 7",{}    menukarte   = "ls-MENUKARTE:Archiv";{}PROC stelle existenz des mm sicher:{}  cursor (1, 5); out (""4"");{}  IF NOT exists (task (mm taskname)){}     THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{}  FI{}
+END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{}  cursor (1,5); out (""4"");{}  out ("  """); out (datei); putline (""" wird geholt.");{}  fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{}  IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{}  hole (datei);{}  cursor (1, 5); out (""4"");{}  out ("  """); out (datei); out (""" wird übersetzt: ");{}  insert (datei);{}  forget (datei, quiet);{}END PROC in;{}
+PROC schicke (TEXT CONST datei):{}  cursor (1, 5); out (""4"");{}  out ("  """); out(datei);{}  out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}  command dialogue (FALSE);{}  save (datei, task (mm taskname));{}  command dialogue (TRUE);{}  forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-DIALOG/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}
+mache global manager aus der task.{}wirf kopfzeile aus:{}  page;{}  putline ("                      "15"ls-DIALOG - Automatische Generierung "14"").{}hole die dateien:{}  IF     NOT exists (datei 1) COR NOT exists (datei 2){}     COR NOT exists (datei 3) COR NOT exists (datei 4){}     COR NOT exists (datei 5) COR NOT exists (datei 6){}     COR NOT exists (datei 7) COR NOT exists (menukarte){}     THEN hole dateien vom archiv{}  FI.{}hole dateien vom archiv:{}  cursor (1,3);{}  IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt"){}
+     THEN lese ein{}     ELSE line (2);{}          errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){}  FI.{}lese ein:{}  cursor (1, 3); out (""4"");{}  out ("                      "15"Bitte die Diskette eingelegt lassen! "14"");{}  IF NOT einzeln{}     THEN hole (datei 1);{}          hole (datei 2);{}          hole (datei 3);{}          hole (datei 4);{}          hole (datei 5);{}          hole (datei 6);{}          hole (datei 7);{}          hole (menukarte);{}          cursor (1, 3); out(""4"");{}
+          out ("                     "15"Die Diskette wird nicht mehr benötigt! "14"");{}          release (archive){}  FI.{}insertiere die dateien:{}  check off;{}  in (datei 1);{}  in (datei 2);{}  in (datei 3);{}  in (datei 4);{}  in (datei 5);{}  in (datei 6);{}  in (datei 7);{}  schicke (menukarte);{}  IF einzeln THEN release (archive) FI;{}  check on.{}mache global manager aus der task:{}  global manager.{}
+
+
+
+
diff --git a/dialog/ls-MENUKARTE:Archiv b/app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv
index c859d22..c859d22 100644
--- a/dialog/ls-MENUKARTE:Archiv
+++ b/app/gs.dialog/1.2/src/ls-MENUKARTE:Archiv
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis
index 5726636..5726636 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Inhaltsverzeichnis
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 1 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1
index 73c95f9..73c95f9 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 1
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 1
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 2 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2
index 52526d6..52526d6 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 2
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 2
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 3 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3
index c34b752..c34b752 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 3
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 3
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 4 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4
index 4f2d79a..4f2d79a 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 4
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 4
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 5 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5
index bb4a67b..bb4a67b 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 5
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 5
diff --git a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 6 b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6
index 0aeeff0..0aeeff0 100644
--- a/doc/hamster/A5 - Doku: gs-Herbert und Robbi - Kapitel 6
+++ b/app/gs.hamster/1.1/doc/A5 - Doku: gs-Herbert und Robbi - Kapitel 6
diff --git a/doc/hamster/gs-Herbert und Robbi handbuch.impressum b/app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum
index 4c8e79d..4c8e79d 100644
--- a/doc/hamster/gs-Herbert und Robbi handbuch.impressum
+++ b/app/gs.hamster/1.1/doc/gs-Herbert und Robbi handbuch.impressum
diff --git a/app/gs.hamster/1.1/source-disk b/app/gs.hamster/1.1/source-disk
new file mode 100644
index 0000000..bd6ad37
--- /dev/null
+++ b/app/gs.hamster/1.1/source-disk
@@ -0,0 +1 @@
+informatikpaket/03_gs.hamster.img
diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1
new file mode 100644
index 0000000..ed19e98
--- /dev/null
+++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 1
@@ -0,0 +1,84 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                ls-Herbert und Robbi 1               ** 
+          **                                                     ** 
+          **                     Version 1.1                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls herbert und robbi 1  DEFINES{}       sei ein hamster, ist hamster,{}       sei ein roboter, ist roboter,{}       landschaft, arbeitsfeld,{}       vor, links um, nimm, gib,{}       korn da, werkstueck da,{}       backen leer, behaelter leer,{}       vorn frei, lauf,{}       hamsterinter, roboterinter,{}       geschwindigkeit, taste,{}       befehlssatz erweitern,{}       befehlssatz ist erweitert,{}       drucke landschaft,{}       hamster druckerstart einstellen,{}       hamster drucker xstart,{}
+       hamster drucker ystart,{}       hamster landschaftsschrifttyp einstellen,{}       hamster landschaftsschrifttyp,{}       druckereinstellung fuer flaechenausdruck,{}       landschaftsauskunftstext,{}       testauskunftstext 1, testauskunftstext 2,{}       befehlsauskunftstext, laufauskunftstext,{}       kommandomodus, hamstermodus,{}       zeige landschaft, lege landschaft ab:{}TYPE LOCATION          = STRUCT (INT x, y);{}LET  menukarte         =  "ls-MENUKARTE:Herbert und Robbi",{}     richtung          =  ""3""8""10""2"",{}
+     erscheinungsform  =           "A<V>",{}     praefix           =       "Flaeche:",{}     flaechentype      =             1007,{}     neutral           =                0,{}     erzeuge           =                1,{}     hamsterlauf       =                2,{}     interaktiv        =                3,{}     kommandostufe     =               99,{}     west              =            ""8"",{}     ost               =            ""2"",{}     cleol             =            ""5"",{}     piep              =            ""7"",{}
+     mark ein          =           ""15"",{}     mark aus          =           ""14"",{}     escape            =           ""27"",{}     blank             =              " ",{}     niltext           =               "",{}     hindernis         =              "#",{}     korn              =              "o",{}     hinderniskachel   =             "##",{}     blankkachel       =             " .",{}     kornkachel        =             " o",{}     protokollname     =      "PROTOKOLL";{}LET    max x           =               40,{}
+       max y           =               23;{}LET    FLAECHE         =  ROW max x ROW max y INT;{}LET    LANDSCHAFT      =  STRUCT (INT xpos, ypos, blickrichtung,{}                                      anzahl koerner, FLAECHE flaeche);{}LET    HAMSTER         =  STRUCT (LOCATION stelle, INT koerner, form);{}BOUND LANDSCHAFT VAR aktuelle landschaft;{}FLAECHE VAR land;{}HAMSTER VAR hamster;{}FILE VAR protokoll;{}INT  CONST besetzt                 ::             -1,{}           frei                    ::              0;{}
+TEXT CONST kornsymbole             ::{}  "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";{}INT CONST maxkornzahl              ::   LENGTH kornsymbole;{}BOOL VAR   hamster eingestellt     ::           TRUE,{}           befehlssatz erweitert   ::          FALSE;{}TEXT VAR   eingabezeichen          ::        niltext,{}           archivlandschaftsname   ::        niltext,{}           hinderniszeichen        ::           "\#\#",{}           schrifttyp              ::        niltext;{}INT  VAR   verzoegerungsfaktor     ::              5,{}
+           modus                   ::  kommandostufe,{}           a, b, c, d;{}REAL VAR   xstart                  ::            0.0,{}           ystart                  ::            0.0;{}WINDOW VAR fenster                 ::  window (1, 1, 79, 24);{}INITFLAG VAR in this task          ::  FALSE;{}OP := (LOCATION VAR l, LOCATION CONST r):{}   l.x := r.x; l.y := r.y{}END OP :=;{}PROC initialize hamstersystem:{}  IF NOT initialized (in this task){}     THEN install menu (menukarte);{}  FI{}END PROC initialize hamstersystem;{}
+PROC sei ein hamster:{}  hamster eingestellt := TRUE{}END PROC sei ein hamster;{}BOOL PROC ist hamster:{}   hamster eingestellt{}END PROC ist hamster;{}PROC sei ein roboter:{}  hamster eingestellt := FALSE{}END PROC sei ein roboter;{}BOOL PROC ist roboter:{}   NOT hamster eingestellt{}END PROC ist roboter;{}PROC hole landschaft (TEXT CONST name):{}   aktuelle landschaft := old (praefix + name);{}   land                := aktuelle landschaft.flaeche;{}   hamster.form        := aktuelle landschaft.blickrichtung;{}
+   hamster.stelle.x    := aktuelle landschaft.xpos;{}   hamster.stelle.y    := aktuelle landschaft.ypos;{}   hamster.koerner     := aktuelle landschaft.anzahl koerner{}END PROC hole landschaft;{}PROC lege landschaft ab (TEXT CONST name):{}   IF exists (praefix + name){}      THEN forget (praefix + name, quiet){}   FI;{}   aktuelle landschaft                := new (praefix + name);{}   aktuelle landschaft.flaeche        := land;{}   aktuelle landschaft.blickrichtung  := hamster.form;{}   aktuelle landschaft.xpos           := hamster.stelle.x;{}
+   aktuelle landschaft.ypos           := hamster.stelle.y;{}   aktuelle landschaft.anzahl koerner := hamster.koerner;{}   type( old(praefix + name), flaechentype){}END PROC lege landschaft ab;{}PROC hamstermodus:{}   modus := neutral{}END PROC hamstermodus;{}PROC kommandomodus:{}   modus := kommandostufe{}END PROC kommandomodus;{}PROC erzeugemodus:{}   modus := erzeuge{}END PROC erzeugemodus;{}PROC intermodus:{}   modus := interaktiv{}END PROC intermodus;{}PROC laufmodus:{}   modus := hamsterlauf{}
+END PROC laufmodus;{}BOOL PROC vorn frei:{}  kontrolliere modus;{}  LOCATION VAR hier :: hamster.stelle;{}  SELECT hamster.form OF{}    CASE 1: IF hamster.stelle.y < 2       THEN protestiere FI;{}            hier.y DECR 1{}    CASE 2: IF hamster.stelle.x < 2       THEN protestiere FI;{}            hier.x DECR 1{}    CASE 3: IF hamster.stelle.y >= max y  THEN protestiere FI;{}            hier.y INCR 1{}    CASE 4: IF hamster.stelle.x >= max x  THEN protestiere FI;{}            hier.x INCR 1{}    OTHERWISE modus := kommandostufe;{}
+              IF ist hamster{}                 THEN errorstop(nachricht( 7)){}                 ELSE errorstop(nachricht(14)){}              FI{}  END SELECT;{}  IF modus = erzeuge{}     THEN TRUE{}     ELSE land[hier.x] [hier.y] <> besetzt{}  FI{}END PROC vorn frei;{}BOOL PROC korn da:{}  kontrolliere modus;{}  kornzahl > 0{}END PROC korn da;{}INT PROC kornzahl:{}  land [hamster.stelle.x] [hamster.stelle.y]{}END PROC kornzahl;{}BOOL PROC werkstueck da:{}  korn da{}END PROC werkstueck da;{}BOOL PROC backen leer:{}
+  kontrolliere modus;{}  hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv){}END PROC backen leer;{}BOOL PROC behaelter leer:{}  backen leer{}END PROC behaelter leer;{}PROC protestiere:{}  IF modus = erzeuge{}     THEN out(piep); eins zurueck{}     ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;{}          kommandomodus;{}          IF ist hamster{}             THEN errorstop(nachricht( 6)){}             ELSE errorstop(nachricht(13)){}          FI;{}  FI.{}  eins zurueck:{}
+    SELECT hamster.form OF{}      CASE 1:   hamster.stelle.y INCR 1{}      CASE 2:   hamster.stelle.x INCR 1{}      CASE 3:   hamster.stelle.y DECR 1{}      CASE 4:   hamster.stelle.x DECR 1{}      OTHERWISE kommandomodus;{}                IF ist hamster{}                   THEN errorstop(nachricht( 7)){}                   ELSE errorstop(nachricht(14)){}                FI;{}     END SELECT.{}  verzoegere 10 mal:{}    INT VAR j;{}    FOR j FROM 1 UPTO 10 REP{}      verzoegere{}    PER{}END PROC protestiere;{}
+PROC verzoegere:{}  IF modus <> hamsterlauf{}     THEN LEAVE verzoegere{}  FI;{}  eingabezeichen := incharety (verzoegerungsfaktor);{}  IF   eingabezeichen = escape{}       THEN kommandomodus;{}            IF ist hamster{}               THEN errorstop(nachricht( 4)){}               ELSE errorstop(nachricht(11)){}            FI{}  ELIF eingabezeichen = "-" THEN verlangsame{}  ELIF eingabezeichen = "+" THEN beschleunige{}  ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,{}                                                   5, maxint, a, b, c, d);{}
+                                 cursor on; zeige landschaft{}  ELIF pos ("0123456789", eingabezeichen) > 0{}        THEN geschwindigkeit (int (eingabezeichen)){}  FI.{}  verlangsame:{}    IF   verzoegerungsfaktor > 31 THEN  (* lass es dabei *){}    ELIF verzoegerungsfaktor < 1{}         THEN verzoegerungsfaktor INCR 1{}         ELSE verzoegerungsfaktor INCR verzoegerungsfaktor{}    FI.{}  beschleunige:{}    IF verzoegerungsfaktor < 1{}       THEN verzoegerungsfaktor := -1{}       ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2{}
+    FI{}END PROC verzoegere;{}PROC geschwindigkeit (INT CONST faktor):{}  SELECT faktor OF{}    CASE 0 :  verzoegerungsfaktor := 20000;{}    CASE 1 :  verzoegerungsfaktor :=    50;{}    CASE 2 :  verzoegerungsfaktor :=    20;{}    CASE 3 :  verzoegerungsfaktor :=    10;{}    CASE 4 :  verzoegerungsfaktor :=     8;{}    CASE 5 :  verzoegerungsfaktor :=     5;{}    CASE 6 :  verzoegerungsfaktor :=     2;{}    CASE 7 :  verzoegerungsfaktor :=     1;{}    CASE 8 :  verzoegerungsfaktor :=     0;{}    CASE 9 :  verzoegerungsfaktor :=    -1;{}
+    OTHERWISE (*belasse es dabei*){}  END SELECT{}END PROC geschwindigkeit;{}PROC vor:{}  kontrolliere modus;{}  IF vorn frei{}     THEN zeige(kachel);{}          bilde neue hamsterkoordinaten;{}          zeige(erscheinungsform SUB hamster.form);{}          verzoegere{}     ELSE modus := kommandostufe;{}          zeige("X");{}          IF ist hamster{}             THEN errorstop(nachricht(1)){}             ELSE errorstop(nachricht(8)){}          FI{}  FI.{}  kachel:{}    INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];{}
+    IF   z = besetzt THEN hinderniskachel{}    ELIF z = frei    THEN blankkachel{}                     ELSE kornkachel{}    FI.{}  bilde neue hamsterkoordinaten:{}    SELECT hamster.form OF{}      CASE 1    :hamster.stelle.y DECR 1{}      CASE 2    :hamster.stelle.x DECR 1{}      CASE 3    :hamster.stelle.y INCR 1{}      CASE 4    :hamster.stelle.x INCR 1{}      OTHERWISE  modus:=kommandostufe;{}                 IF ist hamster{}                    THEN errorstop(nachricht( 7)){}                    ELSE errorstop(nachricht(14)){}
+                 FI{}    END SELECT.{}END PROC vor;{}PROC nimm:{}  kontrolliere modus;{}  IF korn da{}     THEN variiere kornzahl (-1);{}          IF kornzahl < 1 THEN zeige (ost + blank) FI{}     ELSE modus := kommandostufe;{}          zeige("X");{}          IF ist hamster{}             THEN errorstop(nachricht(2)){}             ELSE errorstop(nachricht(9)){}          FI{}  FI;{}  verzoegere{}END PROC nimm;{}PROC gib:{}  kontrolliere modus;{}  IF backen leer{}     THEN modus := kommandostufe;{}          zeige ("X");{}
+          IF ist hamster{}             THEN errorstop(nachricht( 3)){}             ELSE errorstop(nachricht(10)){}          FI{}     ELSE variiere kornzahl (+1);{}          zeige(ost + korn){}  FI;{}  verzoegere{}END PROC gib;{}PROC links um:{}  kontrolliere modus;{}  hamster.form := hamster.form MOD 4 + 1;{}  (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *){}  zeige (subjekt);{}  verzoegere.{}  subjekt:{}    erscheinungsform SUB hamster.form.{}END PROC links um;{}PROC variiere kornzahl (INT CONST delta):{}
+  IF delta * delta <> 1{}     THEN LEAVE variiere kornzahl{}  FI;   (* als delta kommen nur +1 und -1 vor *){}  INT VAR k;{}  IF kornzahl = -1 AND delta = 1{}     THEN k := 1{}     ELSE k := kornzahl + delta{}  FI;{}  IF k <= 0{}     THEN land [hamster.stelle.x] [hamster.stelle.y] := frei{}     ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl){}  FI;{}  IF modus = hamsterlauf OR modus = interaktiv{}     THEN hamster.koerner DECR delta{}  FI{}END PROC variiere kornzahl;{}PROC kontrolliere modus:{}
+  initialize hamstersystem;{}  SELECT modus OF{}    CASE neutral    : erzeugemodus;{}                      landschaft;{}                      laufmodus{}    CASE erzeuge,{}         interaktiv,{}         hamsterlauf: (* nichts *){}    OTHERWISE         kommandomodus;{}                      line;{}                      IF ist hamster{}                         THEN sage(anwendungstext (21));pause(20);{}                              errorstop(nachricht( 5)){}                         ELSE sage(anwendungstext (22));pause(20);{}
+                              errorstop(nachricht(12)){}                      FI{}  END SELECT{}END PROC kontrolliere modus;{}PROC zeige (TEXT CONST was):{}   cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);{}   IF hamster.stelle.x >= max x  AND hamster.stelle.y > max y{}      THEN out ((was SUB 1)); out(west){}      ELSE out(was); (LENGTH was) TIMESOUT west{}   FI.{}END PROC zeige;{}PROC sage (TEXT CONST aussage):{}   cursor(1,24); out(aussage + cleol){}END PROC sage;{}TEXT PROC nachricht (INT CONST nummer):{}
+   inv (text (anwendungstext (nummer), 65)) + piep{}END PROC nachricht;{}TEXT PROC inv (TEXT CONST text):{}  TEXT VAR aus :: mark ein + text + blank + mark aus;{}  aus{}END PROC inv;{}PROC zeige landschaft:{}  initialize hamstersystem;{}  INT VAR y;{}  FOR y FROM 1 UPTO max y REP{}     setze zeile zusammen;{}     cursor (1,y); out (zeile){}  PER;{}  cursor(1,24); out(cleol);{}  IF modus = interaktiv{}     THEN gib befehlszeile aus{}  FI;{}  zeige hamster; cursor on.{}  setze zeile zusammen:{}    TEXT VAR zeile :: niltext;{}
+    INT VAR x;{}    FOR x FROM 1 UPTO max x REP{}       zeile CAT kachel{}    PER.{}  kachel:{}    INT CONST z :: land [x] [y];{}    IF   z = besetzt THEN hinderniskachel{}    ELIF z = frei    THEN blankkachel{}                     ELSE kornkachel{}    FI.{}   gib befehlszeile aus:{}     cursor(1,1); write(cleol); write (anwendungstext (62)){}END PROC zeige landschaft;{}PROC zeige hamster:{}   zeige (erscheinungsform SUB hamster.form){}END PROC zeige hamster;{}PROC landschaft (TEXT CONST kandidat):{}
+  initialize hamstersystem;{}  archivlandschaftsname := kandidat;{}  IF   exists (praefix + kandidat){}         CAND type (old (praefix + kandidat)) = flaechentype{}       THEN behandle existierende landschaft{}  ELIF exists (praefix + kandidat){}       THEN forget (praefix + kandidat, quiet);{}            behandle neue landschaft{}  ELSE behandle neue landschaft{}  FI.{}  behandle existierende landschaft:{}    hole landschaft (kandidat);{}    SELECT modus OF{}      CASE hamsterlauf,{}           interaktiv,{}
+           neutral       : zeige landschaft;{}                           laufmodus{}      CASE erzeuge       : modifiziere eventuell{}      CASE kommandostufe : modifiziere landschaft{}      OTHERWISE            errorstop (anwendungstext (15)){}    END SELECT.{}  behandle neue landschaft:{}    SELECT modus OF{}      CASE hamsterlauf,{}           interaktiv,{}           neutral,{}           erzeuge       : erschaffe landschaft;{}                           modifiziere landschaft;{}                           zeige landschaft;{}
+                           laufmodus{}      CASE kommandostufe : erschaffe landschaft;{}                           modifiziere landschaft;{}      OTHERWISE            errorstop (anwendungstext (15)){}    END SELECT.{}  modifiziere eventuell:{}    IF ist hamster{}       THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d){}               THEN cursor on; modifiziere landschaft{}            FI{}       ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d){}               THEN cursor on; modifiziere landschaft{}
+            FI{}    FI;{}    zeige landschaft.{}  erschaffe landschaft:{}    INT VAR j;{}    FOR j FROM 1 UPTO max y REP{}      INT VAR k;{}      FOR k FROM 1 UPTO max x REP{}        land [k] [j] := frei{}      PER{}    PER;{}    hamster.form     :=   4;{}    hamster.stelle.x :=  20;{}    hamster.stelle.y :=  12;{}    hamster.koerner  :=   0.{}END PROC landschaft;{}PROC landschaft:{}  initialize hamstersystem;{}  IF ist hamster{}     THEN landschaft (erfragter landschaftsname (anwendungstext (36))){}
+     ELSE landschaft (erfragter landschaftsname (anwendungstext (37))){}  FI{}END PROC landschaft;{}TEXT PROC erfragter landschaftsname (TEXT CONST satz):{}  TEXT VAR landschaftsname :: archivlandschaftsname;{}  REP{}    page; line (3); out (satz + cleol); line (2);{}    editget (landschaftsname);{}    landschaftsname := compress (landschaftsname);{}    IF landschaftsname = niltext{}       THEN line (2); out (anwendungstext (18) + piep);{}            line (2); out (anwendungstext (38)); pause{}    FI{}
+  UNTIL landschaftsname <> niltext PER;{}  landschaftsname{}END PROC erfragter landschaftsname;{}PROC arbeitsfeld (TEXT CONST kandidat):{}  landschaft (kandidat){}END PROC arbeitsfeld;{}PROC arbeitsfeld:{}  landschaft{}END PROC arbeitsfeld;{}PROC modifiziere landschaft:{}  INT CONST modalibi :: modus;{}  erzeugemodus;{}  zeige landschaft;{}  informiere;{}  zeige hamster;{}  nimm ein eingabezeichen;{}  WHILE nicht endewunsch REP{}    erfuelle fortschreibungswunsch;{}    nimm ein eingabezeichen{}  PER;{}
+  erfrage koernerzahl;{}  lege landschaft ab (archivlandschaftsname);{}  modus := modalibi.{}  nimm ein eingabezeichen:{}    inchar (eingabezeichen).{}  nicht endewunsch:{}    pos ("hH", eingabezeichen) = 0.{}  erfuelle fortschreibungswunsch:{}    INT CONST r :: pos (richtung, eingabezeichen){}    IF   r > 0{}         THEN IF hamster.form = r{}                 THEN vor{}                 ELSE hamster.form := r;{}                      zeige hamster{}              FI{}    ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,{}
+                                                     5, maxint, a, b, c, d);{}                                   cursor on; zeige landschaft; informiere{}    ELIF eingabezeichen = "k" THEN kopiere landschaft;{}                                   zeige landschaft; informiere{}    ELIF eingabezeichen = "g" THEN gib{}    ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI{}    ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2)){}    ELIF eingabezeichen = hindernis{}         THEN  land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor{}
+    ELIF eingabezeichen = blank{}         THEN  land [hamster.stelle.x] [hamster.stelle.y] := frei;    vor{}    ELSE out (piep){}    FI.{}    kopiere landschaft:{}      TEXT VAR kopie;{}      IF NOT not empty (alle landschaften){}         THEN IF ist hamster{}                 THEN boxinfo (fenster, anwendungstext (196), 5, maxint){}                 ELSE boxinfo (fenster, anwendungstext (197), 5, maxint){}              FI{}         ELSE lasse original auswaehlen{}      FI.{}    lasse original auswaehlen:{}
+      IF ist hamster{}         THEN kopie := boxone (fenster, alle landschaften,{}                               anwendungstext (23), anwendungstext (24),{}                               FALSE){}         ELSE kopie := boxone (fenster, alle landschaften,{}                               anwendungstext (25), anwendungstext (26),{}                               FALSE){}      FI;{}      cursor on; hole landschaft (kopie).{}    alle landschaften:{}      ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{}
+    erfrage koernerzahl:{}      TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;{}      cursor (1,23); 79 TIMESOUT waagerecht;{}      REP{}        ist ok := TRUE;{}        IF ist hamster{}           THEN eingabe := boxanswer (fenster, anwendungstext (43),{}                                               text (hamster.koerner),{}                                               5, a, b, c, d){}           ELSE eingabe := boxanswer (fenster, anwendungstext (44),{}                                               text (hamster.koerner),{}
+                                               5, a, b, c, d){}        FI;{}        disable stop;{}        IF eingabe = "" THEN eingabe := "0" FI;{}        zahl := int (eingabe);{}        IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;{}        IF is error THEN ist ok := FALSE; clear error FI;{}        enable stop;{}      UNTIL last conversion ok AND ist ok PER;{}      cursor on;{}      hamster.koerner := zahl.{}    informiere:{}      cursor (1,1);{}      IF ist hamster{}         THEN out (anwendungstext (27)){}
+         ELSE out (anwendungstext (28)){}      FI{}END PROC modifiziere landschaft;{}PROC lauf (TEXT CONST dateiname):{}  initialize hamstersystem;{}  IF NOT exists (dateiname){}     THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17)){}  FI;{}  hamstermodus;{}  disable stop;{}  run (dateiname);{}  kommandomodus;{}  cursor (1, 24);{}  IF is error{}     THEN IF length (errormessage) > 1{}             THEN sage (errormessage); pause;{}          FI{}     ELSE sage (anwendungstext (29)); pause; konserviere landschaft{}
+  FI;{}  clear error;{}  enable stop{}END PROC lauf;{}PROC lauf:{}  lauf (last param){}END PROC lauf;{}PROC konserviere landschaft:{}  TEXT VAR neuer landschaftsname;{}  IF ist hamster{}     THEN stelle landschaftsfrage{}     ELSE stelle arbeitsfeldfrage{}  FI; cursor on.{}  stelle landschaftsfrage:{}    IF boxyes (fenster, anwendungstext (45), 5){}       THEN bewahre landschaft auf{}    FI.{}  stelle arbeitsfeldfrage:{}    IF boxyes (fenster, anwendungstext (46), 5){}       THEN bewahre landschaft auf{}
+    FI.{}  bewahre landschaft auf:{}    neuer landschaftsname := archivlandschaftsname + ".x";{}    lege landschaft ab (neuer landschaftsname);{}    gib hinweis auf neuen namen.{}  gib hinweis auf neuen namen:{}    IF ist hamster{}       THEN boxinfo (fenster, anwendungstext (30){}                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d){}       ELSE boxinfo (fenster, anwendungstext (31){}                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d){}    FI{}END PROC konserviere landschaft;{}
+PROC hamsterinter (TEXT CONST landschaftsname):{}  initialize hamstersystem;{}  sei ein hamster;{}  steuere interaktiv (landschaftsname);{}  cursor on{}END PROC hamsterinter;{}PROC hamsterinter:{}  initialize hamstersystem;{}  hamsterinter (erfragter landschaftsname (anwendungstext (39))){}END PROC hamsterinter;{}PROC roboterinter (TEXT CONST landschaftsname):{}  initialize hamstersystem;{}  sei ein roboter;{}  steuere interaktiv (landschaftsname);{}  cursor on{}END PROC roboterinter;{}PROC roboterinter:{}
+  initialize hamstersystem;{}  roboterinter (erfragter landschaftsname (anwendungstext (40))){}END PROC roboterinter;{}PROC steuere interaktiv (TEXT CONST landschaftsname):{}  forget (protokollname, quiet);{}  protokoll := sequential file (output, protokollname);{}  intermodus;{}  landschaft (landschaftsname);{}  TEXT VAR befehl :: niltext, letzter befehl :: niltext;{}  REP{}    arbeiten{}  PER.{}  arbeiten:{}    intermodus;{}    hole befehl;{}    fuehre befehl aus.{}  hole befehl:{}    TEXT VAR befehlszeichen;{}
+    TEXT CONST befehlskette :: "vlngpeVLNGPE";{}    INT VAR befehlsposition;{}    zeige (hamsterform);{}    cursor (1,24);{}    IF ist hamster{}       THEN out (cleol + anwendungstext (32) + letzter befehl){}       ELSE out (cleol + anwendungstext (33) + letzter befehl){}    FI;{}    cursor(24,24);{}    inchar (befehlszeichen);{}    befehlsposition := pos(befehlskette,befehlszeichen);{}    IF befehlsposition = 0{}       THEN out(piep);{}            LEAVE arbeiten{}    FI;{}    SELECT befehlsposition OF{}
+      CASE 1, 7: befehl := "vor";{}                           out("vor");{}                           letzter befehl := "vor"{}      CASE 2, 8: befehl := "links um";{}                           out("links um");{}                           letzter befehl := "links um"{}      CASE 3, 9: befehl := "nimm";{}                           out("nimm");{}                           letzter befehl := "nimm"{}      CASE 4,10: befehl := "gib";{}                           out("gib");{}                           letzter befehl := "gib"{}
+      CASE 5,11: out("protokoll");{}                 letzter befehl := "protokoll";{}                 FILE VAR p :: sequential file (modify,protokollname);{}                 headline(p, protokollname + "  (Verlassen: <ESC><q>)");{}                 cursor on; show(p); cursor off;{}                 zeige landschaft; befehl := "";{}                 output(protokoll);{}                 LEAVE arbeiten{}      CASE 6,12: out("ende"); kommandomodus; befehl := "";{}                 LEAVE steuere interaktiv{}
+    END SELECT.{}   hamsterform:{}     erscheinungsform SUB hamster.form.{}   fuehre befehl aus:{}     BOOL VAR korrekt;{}     disable stop;{}     do (befehl);{}     cursor (1,24);{}     korrekt := NOT is error;{}     IF is error{}        THEN IF errormessage > ""{}                THEN out (inv (text (errormessage, 65)) + piep);{}                     pause(30);{}             FI;{}             clear error{}     FI;{}     IF korrekt AND befehl <> ""{}        THEN protokolliere (befehl){}     FI;{}     enable stop;{}
+END PROC steuere interaktiv;{}PROC protokolliere (TEXT CONST befehl):{}  putline (protokoll, befehl + ";"){}END PROC protokolliere;{}PROC drucke landschaft (TEXT CONST landschaftsname):{}  initialize hamstersystem;{}  ROW max y TEXT VAR drucklandschaft;{}  BOUND LANDSCHAFT VAR al;{}  INT VAR i, hamsterx, hamstery;{}  TEXT VAR hamsterzeichen;{}  landschaftsdatei holen;{}  drucklandschaft erzeugen;{}  hamster in drucklandschaft einsetzen;{}  druckdatei erzeugen;{}  disable stop;{}  TEXT VAR datname := std;{}
+  do ("print (""druckdatei"")");{}  IF is error{}      THEN menuinfo (inv (errormessage));{}           clear error;{}  FI;{}  last param (datname);{}  enable stop;{}  druckdatei loeschen;{}  cursor on.{}  landschaftsdatei holen:{}    IF exists (praefix + landschaftsname) AND{}       (type (old (praefix + landschaftsname)) = flaechentype){}       THEN hole landschaft;{}       ELSE LEAVE drucke landschaft{}    FI.{}  hole landschaft:{}    al             := old (praefix + landschaftsname);{}    hamsterx       := al.xpos;{}
+    hamstery       := al.ypos;{}    hamsterzeichen := erscheinungsform SUB al.blickrichtung.{}  drucklandschaft erzeugen:{}    TEXT VAR zeile; INT VAR  x;{}    FOR i FROM 1 UPTO max y REP{}        zeile := "";{}        FOR x FROM 1 UPTO maxx REP{}            zeile erzeugen{}        PER;{}        drucklandschaft[i] :=  zeile{}    PER.{}  zeile erzeugen:{}    INT CONST zeichen :: al.flaeche [x] [i];{}    IF   zeichen = besetzt THEN zeile CAT hinderniszeichen{}    ELIF zeichen = frei    THEN zeile CAT " ."{}
+                           ELSE zeile CAT " o"{}    FI.{}  hamster in drucklandschaft einsetzen:{}    change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,{}            hamsterzeichen).{}  druckdatei erzeugen:{}    FILE VAR p::sequential file(output, "druckdatei");{}    INT VAR blankzahl;{}    line(p);{}    putline(p,"#type (""" + schrifttyp + """)#");{}    putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");{}    putline(p,"#limit(20.8)#");{}    blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;{}
+    putline(p, blankzahl * " " + praefix + landschaftsname + " ");{}    putline(p, "  ");{}    FOR i FROM 1 UPTO maxy REP{}      putline(p, drucklandschaft[i] + " "){}    PER.{}  druckdatei loeschen:{}    forget("druckdatei", quiet){}END PROC drucke landschaft;{}PROC drucke landschaft:{}  initialize hamstersystem;{}  IF ist hamster{}     THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36))){}     ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37))){}  FI;{}  cursor on{}
+END PROC drucke landschaft;{}PROC druckereinstellung fuer flaechenausdruck:{}  initialize hamstersystem;{}  page;{}  IF ist hamster{}     THEN putline (center (invers (anwendungstext (71)))){}     ELSE putline (center (invers (anwendungstext (72)))){}  FI;{}  line (3);{}  put (anwendungstext (73));{}  editget (schrifttyp);{}  line (2);{}  schrifttyp := compress (schrifttyp);{}  putline (anwendungstext (74));{}  putline (anwendungstext (75)); line (2);{}  putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +{}
+           anwendungstext (77)); line;{}  put (anwendungstext (78)); get (xstart); line;{}  put (anwendungstext (79)); get (ystart); line (2);{}  IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81)){}     THEN line;{}          put (anwendungstext (82)); inchar (hinderniszeichen); line (2);{}          hinderniszeichen CAT hinderniszeichen;{}          IF hinderniszeichen = "##"{}             THEN hinderniszeichen := "\#\#"{}          FI{}  FI;{}  line;{}  put (anwendungstext (83)){}END PROC druckereinstellung fuer flaechenausdruck;{}
+PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):{}  xstart := xpos; ystart := ypos{}END PROC hamster druckerstart einstellen;{}REAL PROC hamster drucker xstart:{}  xstart{}END PROC hamster drucker xstart;{}REAL PROC hamster drucker ystart:{}  ystart{}END PROC hamster drucker ystart;{}PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):{}  schrifttyp := typ{}END PROC hamster landschaftsschrifttyp einstellen;{}TEXT PROC hamster landschaftsschrifttyp:{}  schrifttyp{}END PROC hamster landschaftsschrifttyp;{}
+PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):{}  drucke landschaft (arbeitsfeldname){}END PROC drucke arbeitsfeld;{}PROC drucke arbeitsfeld:{}  drucke landschaft{}END PROC drucke arbeitsfeld;{}TEXT PROC taste:{}  eingabezeichen{}END PROC taste;{}TEXT PROC landschaftsauskunftstext:{}  initialize hamstersystem;{}  IF ist hamster{}     THEN anwendungstext (52){}     ELSE anwendungstext (53){}  FI{}END PROC landschaftsauskunftstext;{}TEXT PROC laufauskunftstext:{}  initialize hamstersystem;{}
+  anwendungstext (51){}END PROC  laufauskunftstext;{}TEXT PROC befehlsauskunftstext:{}  initialize hamstersystem;{}  IF ist hamster{}     THEN anwendungstext (54){}     ELSE anwendungstext (55){}  FI{}END PROC befehlsauskunftstext;{}TEXT PROC testauskunftstext 1:{}  initialize hamstersystem;{}  IF befehlssatz erweitert{}     THEN langer testauskunftstext{}     ELSE kurzer testauskunftstext{}  FI.{}  kurzer testauskunftstext:{}    IF ist hamster{}       THEN anwendungstext (56){}       ELSE anwendungstext (57){}
+    FI.{}  langer testauskunftstext:{}    IF ist hamster{}       THEN anwendungstext (58){}       ELSE anwendungstext (60){}    FI.{}END PROC testauskunftstext 1;{}TEXT PROC testauskunftstext 2:{}  initialize hamstersystem;{}  IF befehlssatz erweitert{}     THEN eintragung{}     ELSE niltext{}  FI.{}  eintragung:{}    IF ist hamster{}       THEN anwendungstext (59){}       ELSE anwendungstext (61){}    FI{}END PROC testauskunftstext 2;{}PROC befehlssatz erweitern (BOOL CONST status):{}  befehlssatz erweitert := status{}
+END PROC befehlssatz erweitern;{}BOOL PROC befehlssatz ist erweitert:{}  befehlssatz erweitert{}END PROC befehlssatz ist erweitert;{}END PACKET ls herbert und robbi 1;{}
+
diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2
new file mode 100644
index 0000000..7394932
--- /dev/null
+++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 2
@@ -0,0 +1,31 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **               ls-Herbert und Robbi 2                ** 
+          **                                                     ** 
+          **                     Version 1.1                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls herbert und robbi 2  DEFINES{}       rechts frei,{}       links frei,{}       hinten frei,{}       korn vorn,    werkstueck vorn,{}       korn links,   werkstueck links,{}       korn rechts,  werkstueck rechts,{}       korn hinten,  werkstueck hinten:{}BOOL PROC rechts frei:{}  rechts um;{}  IF vorn frei{}     THEN links um; TRUE{}     ELSE links um; FALSE{}  FI{}END PROC rechts frei;{}BOOL PROC links frei:{}  links um;{}  IF vorn frei{}     THEN rechts um; TRUE{}     ELSE rechts um; FALSE{}
+  FI{}END PROC links frei;{}BOOL PROC hinten frei:{}  kehrt;{}  IF vorn frei{}     THEN kehrt; TRUE{}     ELSE kehrt; FALSE{}  FI{}END PROC hinten frei;{}BOOL PROC korn vorn:{}  IF vorn frei{}     THEN untersuche feld vor dir{}     ELSE FALSE{}  FI.{}  untersuche feld vor dir:{}    vor;{}    IF korn da{}       THEN mache vorwaertsgehen rueckgaengig; TRUE{}       ELSE mache vorwaertsgehen rueckgaengig; FALSE{}    FI.{}  mache vorwaertsgehen rueckgaengig:{}    kehrt; vor; kehrt{}END PROC korn vorn;{}
+BOOL PROC korn links:{}  links um;{}  IF vorn frei{}     THEN untersuche feld links{}     ELSE rechts um; FALSE{}  FI.{}  untersuche feld links:{}    vor;{}    IF korn da{}       THEN mache linkswende rueckgaengig; TRUE{}       ELSE mache linkswende rueckgaengig; FALSE{}    FI.{}  mache linkswende rueckgaengig:{}    kehrt; vor; links um{}END PROC korn links;{}BOOL PROC korn rechts:{}  rechts um;{}  IF vorn frei{}     THEN untersuche feld rechts{}     ELSE links um; FALSE{}  FI.{}  untersuche feld rechts:{}
+    vor;{}    IF korn da{}       THEN mache rechtswende rueckgaengig; TRUE{}       ELSE mache rechtswende rueckgaengig; FALSE{}    FI.{}  mache rechtswende rueckgaengig:{}    kehrt; vor; rechts um{}END PROC korn rechts;{}BOOL PROC korn hinten:{}  kehrt;{}  IF vorn frei{}     THEN untersuche feld hinter dir{}     ELSE kehrt; FALSE{}  FI.{}  untersuche feld hinter dir:{}    vor;{}    IF korn da{}       THEN mache kehrtwende rueckgaengig; TRUE{}       ELSE mache kehrtwende rueckgaengig; FALSE{}    FI.{}
+  mache kehrtwende rueckgaengig:{}    kehrt; vor{}END PROC korn hinten;{}PROC kehrt:{}  links um; links um{}END PROC kehrt;{}PROC rechts um:{}  links um; links um; links um{}END PROC rechts um;{}BOOL PROC werkstueck vorn:{}  korn vorn{}END PROC werkstueck vorn;{}BOOL PROC werkstueck links:{}  korn links{}END PROC werkstueck links;{}BOOL PROC werkstueck rechts:{}  korn rechts{}END PROC werkstueck rechts;{}BOOL PROC werkstueck hinten:{}  korn hinten{}END PROC werkstueck hinten;{}END PACKET ls herbert und robbi 2;{}
+befehlssatz erweitern (TRUE){}
+
diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3 b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3
new file mode 100644
index 0000000..e5db408
--- /dev/null
+++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi 3
@@ -0,0 +1,84 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **               ls-Herbert und Robbi 3                ** 
+          **                                                     ** 
+          **                     Version 1.1                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls herbert und robbi 3  DEFINES{}  hamsterbefehlsauskunft,{}  hamsterlaufauskunft,{}  hamsterlandschaftsauskunft,{}  hamsterlandschaft verzeichnis,{}  hamsterlandschaft neu erstellen,{}  hamsterlandschaft ansehen,{}  hamsterlandschaft drucken,{}  hamsterlandschaft kopieren,{}  hamsterlandschaft umbenennen,{}  hamsterlandschaft loeschen,{}  hamsterprogramm verzeichnis,{}  hamsterprogramm neu erstellen,{}  hamsterprogramm ansehen,{}  hamsterprogramm kopieren,{}  hamsterprogramm umbenennen,{}
+  hamsterprogramm loeschen,{}  hamsterprogramm drucken,{}  hamster laufen lassen,{}  hamsterinteraktiv laufen lassen,{}  hamster, roboter:{}LET  menukarte       = "ls-MENUKARTE:Herbert und Robbi",{}     praefix         = "Flaeche:",{}     flaechentype    =       1007,{}     niltext         =         "",{}     maxlaenge       =         60,{}     maxnamenslaenge =         50;{}TEXT VAR flaechenname :: "",{}         programmname :: "";{}INITFLAG VAR in this task :: FALSE;{}PROC initialize hamster:{}
+  IF NOT initialized (in this task){}     THEN flaechenname := "";{}          programmname := ""{}  FI{}END PROC initialize hamster;{}PROC hamster:{}  sei ein hamster;{}  initialize hamster;{}  install menu (menukarte);{}  handle  menu ("HAMSTER"){}END PROC hamster;{}PROC roboter:{}  sei ein roboter;{}  initialize  hamster;{}  install menu (menukarte);{}  handle  menu ("ROBOTER");{}END PROC roboter;{}PROC hamsterlaufauskunft:{}  menuinfo (laufauskunftstext){}END PROC hamsterlaufauskunft;{}PROC hamsterlandschaftsauskunft:{}
+  menuinfo (landschaftsauskunftstext){}END PROC hamsterlandschaftsauskunft;{}PROC hamsterbefehlsauskunft:{}  menuinfo (befehlsauskunftstext);{}  menuinfo (testauskunftstext 1);{}  IF testauskunftstext 2 <> ""{}     THEN menuinfo (testauskunftstext 2){}  FI{}END PROC hamsterbefehlsauskunft;{}PROC hamsterlandschaft verzeichnis:{}  THESAURUS VAR landschaften ::{}  ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}  forget ("Interne Thesaurusdateiliste", quiet);{}  FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{}
+  f FILLBY landschaften;{}  headline (f, anwendungstext (204)); modify (f);{}  to line (f, 1); insert record (f); write record (f, kenntext);{}  to line (f, 2); insert record (f);{}  to line (f, 1); menuwindowshow (f);{}  forget ("Interne Thesaurusdateiliste", quiet);{}  regenerate menuscreen.{}  kenntext:{}    IF ist hamster THEN anwendungstext (121) ELSE anwendungstext (151) FI.{}END PROC hamsterlandschaft verzeichnis;{}PROC hamsterprogramm verzeichnis:{}  THESAURUS VAR programme :: ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
+  forget ("Interne Thesaurusdateiliste", quiet);{}  FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");{}  f FILLBY programme;{}  headline (f, anwendungstext (204)); modify (f);{}  to line (f, 1); insert record (f); write record (f, anwendungstext (181));{}  to line (f, 2); insert record (f);{}  to line (f, 1); menuwindowshow (f);{}  forget ("Interne Thesaurusdateiliste", quiet);{}  regenerate menuscreen{}END PROC hamsterprogramm verzeichnis;{}PROC hamsterlandschaft neu erstellen:{}
+  hole flaechenname;{}  kontrolliere den flaechennamen;{}  kommandomodus;{}  landschaft (flaechenname);{}  regenerate menuscreen.{}  hole flaechenname:{}    IF ist hamster{}       THEN flaechenname := menuanswer (anwendungstext (101) +{}                                        anwendungstext (102), "", 5){}       ELSE flaechenname := menuanswer (anwendungstext (131) +{}                                        anwendungstext (132), "", 5){}    FI.{}  kontrolliere den flaechennamen:{}    IF   flaechenname = niltext{}
+         THEN LEAVE hamsterlandschaft neu erstellen{}    ELIF length (flaechenname) > maxnamenslaenge{}         THEN meckere zu langen namen an;{}              flaechenname := niltext;{}              LEAVE hamsterlandschaft neu erstellen{}    ELIF exists (praefix + flaechenname){}         THEN meckere existierende flaeche an;{}              LEAVE hamsterlandschaft neu erstellen{}    FI{}END PROC hamsterlandschaft neu erstellen;{}PROC hamsterprogramm neu erstellen:{}  hole programmname;{}  kontrolliere den programmnamen;{}
+  command dialogue (FALSE);{}  cursor on;{}  stdinfoedit (programmname);{}  cursor off;{}  command dialogue (TRUE);{}  regenerate menuscreen.{}  hole programmname:{}    programmname := menuanswer (anwendungstext (161) +{}                                anwendungstext (162), "", 5).{}  kontrolliere den programmnamen:{}    IF   programmname = niltext{}         THEN LEAVE hamsterprogramm neu erstellen{}    ELIF length (programmname) > maxnamenslaenge{}         THEN meckere zu langen namen an;{}              programmname := niltext;{}
+              LEAVE hamsterprogramm neu erstellen{}    ELIF exists (programmname){}         THEN meckere existierendes programm an;{}              LEAVE hamsterprogramm neu erstellen{}    FI{}END PROC hamsterprogramm neu erstellen;{}PROC hamsterlandschaft ansehen:{}  IF flaechenname <> niltext CAND exists (praefix + flaechenname){}     THEN frage nach dieser flaeche{}     ELSE lasse flaeche auswaehlen{}  FI;{}  kommandomodus;{}  landschaft (flaechenname);{}  regenerate menuscreen.{}  frage nach dieser flaeche:{}
+    IF menuno (ueberschrift + text 1 + name + text 2, 5){}       THEN lasse flaeche auswaehlen{}    FI.{}  ueberschrift:{}    IF ist hamster{}       THEN center (maxlaenge, invers (anwendungstext (105))) + ""13""13""{}       ELSE center (maxlaenge, invers (anwendungstext (135))) + ""13""13""{}   FI.{}  text 1:{}    IF ist hamster THEN anwendungstext (103) ELSE anwendungstext (133) FI.{}  name:{}    ""13""13" " + invers (flaechenname) + ""13""13"".{}  text 2:{}    IF ist hamster THEN anwendungstext (104) ELSE anwendungstext (134) FI.{}
+  lasse flaeche auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}    IF NOT not empty (verfuegbare){}       THEN noch keine flaeche;{}            LEAVE hamsterlandschaft ansehen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    IF ist hamster{}       THEN flaechenname := menuone (verfuegbare, anwendungstext (105),{}                                     anwendungstext (106), FALSE){}       ELSE flaechenname := menuone (verfuegbare, anwendungstext (135),{}
+                                     anwendungstext (136), FALSE){}    FI;{}    IF flaechenname = niltext{}       THEN regenerate menuscreen;{}            LEAVE hamsterlandschaft ansehen{}    FI.{}END PROC hamsterlandschaft ansehen;{}PROC hamsterprogramm ansehen:{}  IF programmname <> niltext CAND exists (programmname){}     THEN frage nach diesem programm{}     ELSE lasse programm auswaehlen{}  FI;{}  cursor on;{}  stdinfoedit (programmname);{}  cursor off;{}  regenerate menuscreen.{}  frage nach diesem programm:{}
+    IF menuno (ueberschrift + anwendungstext (163) + name{}                            + anwendungstext (164), 5){}       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    center (maxlaenge, invers (anwendungstext (165))) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare  := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}
+            LEAVE hamsterprogramm ansehen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    programmname := menuone (verfuegbare, anwendungstext (165),{}                             anwendungstext (166), FALSE);{}    IF programmname = niltext{}       THEN regenerate menuscreen;{}            LEAVE hamsterprogramm ansehen{}    FI.{}END PROC hamsterprogramm ansehen;{}PROC hamsterlandschaft drucken:{}  lasse flaechen auswaehlen;{}  drucke flaechen;{}  regenerate menuscreen.{}  lasse flaechen auswaehlen:{}
+    THESAURUS VAR verfuegbare;{}    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}    IF NOT not empty (verfuegbare){}       THEN noch keine flaeche;{}            LEAVE hamsterlandschaft drucken{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    IF ist hamster{}       THEN verfuegbare := menusome (verfuegbare, anwendungstext (107),{}                                     anwendungstext (108), FALSE){}       ELSE verfuegbare := menusome (verfuegbare, anwendungstext (137),{}
+                                     anwendungstext (138), FALSE){}    FI.{}  drucke flaechen:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (bezeichnung)));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (schlussbemerkung);{}    menuwindowstop.{}  bezeichnung:{}    IF ist hamster THEN anwendungstext (107) ELSE anwendungstext (137) FI.{}
+  schlussbemerkung:{}    IF ist hamster THEN anwendungstext (110) ELSE anwendungstext (140) FI.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              menuwindowout ( " """ + name (verfuegbare, k) + """ "{}                                    + anwendungstext (201));{}              menuwindowline;{}              drucke landschaft (name (verfuegbare, k));{}              fehlerbehandlung{}
+      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            IF ist hamster{}               THEN menuwindowout (anwendungstext (109)){}               ELSE menuwindowout (anwendungstext (139)){}            FI;{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE hamsterlandschaft drucken{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}
+       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}            LEAVE hamsterlandschaft drucken{}    FI.{}END PROC hamsterlandschaft drucken;{}PROC hamsterprogramm drucken:{}  lasse programme auswaehlen;{}  drucke programme;{}  regenerate menuscreen.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
+    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE hamsterprogramm drucken{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, anwendungstext (167),{}                             anwendungstext (168), FALSE).{}  drucke programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (anwendungstext (167))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}
+    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (anwendungstext (170));{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              menuwindowout ( " """ + name (verfuegbare, k) + """ "{}                                    + anwendungstext (201));{}              menuwindowline;{}
+              print (name (verfuegbare, k));{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (anwendungstext (169));{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE hamsterprogramm drucken{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}
+    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}            LEAVE hamsterprogramm drucken{}    FI.{}END PROC hamsterprogramm drucken;{}PROC hamsterlandschaft kopieren:{}  ermittle alten flaechennamen;{}  erfrage neuen flaechennamen;{}  kopiere ggf die flaeche.{}  ermittle alten flaechennamen:{}    IF NOT not empty (bestand){}       THEN noch keine flaeche;{}            LEAVE hamsterlandschaft kopieren{}
+       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{}    IF alter name = niltext{}       THEN LEAVE hamsterlandschaft kopieren{}    FI.{}  bestand:{}    ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{}  text1:{}    IF ist hamster THEN anwendungstext (111) ELSE anwendungstext (141) FI.{}  text2:{}    IF ist hamster THEN anwendungstext (112) ELSE anwendungstext (142) FI.{}  erfrage neuen flaechennamen:{}
+    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{}  ueberschrift:{}    IF ist hamster{}       THEN center (maxlaenge, invers (anwendungstext (111))) + ""13""13""{}       ELSE center (maxlaenge, invers (anwendungstext (141))) + ""13""13""{}    FI.{}  hinweis auf alt:{}    IF ist hamster THEN anwendungstext (113) ELSE anwendungstext (143) FI.{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}
+  aufforderung:{}    anwendungstext (202).{}  kopiere ggf die flaeche:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (anwendungstext (192)));{}              LEAVE hamsterlandschaft kopieren{}    ELIF exists (praefix + neuer name){}         THEN mache vorwurf;{}              LEAVE hamsterlandschaft kopieren{}       ELSE copy (praefix + alter name, praefix + neuer name){}    FI.{}  mache vorwurf:{}    IF ist hamster{}       THEN menuinfo (anwendungstext (193)){}       ELSE menuinfo (anwendungstext (194)){}
+    FI.{}END PROC hamsterlandschaft kopieren;{}PROC hamsterprogramm kopieren:{}  ermittle alten programmnamen;{}  erfrage neuen programmnamen;{}  kopiere ggf das programm.{}  ermittle alten programmnamen:{}    IF NOT not empty (bestand){}       THEN noch kein programm;{}            LEAVE hamsterprogramm kopieren{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, anwendungstext (171),{}                                     anwendungstext (172), TRUE);{}
+    IF alter name = niltext{}       THEN LEAVE hamsterprogramm kopieren{}    FI.{}  bestand:{}    ALL myself - infix namen (ALL myself, praefix, flaechentype).{}  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + anwendungstext (173) + bisheriger name{}                  + anwendungstext (202).{}  ueberschrift:{}    center (maxlaenge, invers (anwendungstext (171))) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}
+  kopiere ggf das programm:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (anwendungstext (192)));{}              LEAVE hamsterprogramm kopieren{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE hamsterprogramm kopieren{}       ELSE copy (alter name, neuer name){}    FI.{}  mache vorwurf:{}    menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm kopieren;{}PROC hamsterlandschaft umbenennen:{}  ermittle alten flaechennamen;{}  erfrage neuen flaechennamen;{}
+  benenne ggf die flaeche um.{}  ermittle alten flaechennamen:{}    IF NOT not empty (bestand){}       THEN noch keine flaeche;{}            LEAVE hamsterlandschaft umbenennen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);{}    IF alter name = niltext{}       THEN LEAVE hamsterlandschaft umbenennen{}    FI.{}  bestand:{}    ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).{}  text1:{}    IF ist hamster THEN anwendungstext (114) ELSE anwendungstext (144) FI.{}
+  text2:{}    IF ist hamster THEN anwendungstext (115) ELSE anwendungstext (145) FI.{}  erfrage neuen flaechennamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{}  ueberschrift:{}    IF ist hamster{}       THEN center (maxlaenge, invers (anwendungstext (114))) + ""13""13""{}       ELSE center (maxlaenge, invers (anwendungstext (144))) + ""13""13""{}    FI.{}  hinweis auf alt:{}    IF ist hamster THEN anwendungstext (116) ELSE anwendungstext (146) FI.{}
+  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  aufforderung:{}    IF ist hamster THEN anwendungstext (117) ELSE anwendungstext (147) FI.{}  benenne ggf die flaeche um:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (anwendungstext (192)));{}              LEAVE hamsterlandschaft umbenennen{}    ELIF exists (praefix + neuer name){}         THEN mache vorwurf;{}              LEAVE hamsterlandschaft umbenennen{}    ELSE rename (praefix + alter name, praefix + neuer name);{}
+         flaechenname := neuer name{}    FI.{}  mache vorwurf:{}    IF ist hamster{}       THEN menuinfo (anwendungstext (193)){}       ELSE menuinfo (anwendungstext (194)){}    FI.{}END PROC hamsterlandschaft umbenennen;{}PROC hamsterprogramm umbenennen:{}  ermittle alten programmnamen;{}  erfrage neuen programmnamen;{}  benenne ggf das programm um.{}  ermittle alten programmnamen:{}    IF NOT not empty (bestand){}       THEN noch kein programm;{}            LEAVE hamsterprogramm umbenennen{}       ELSE biete auswahl an{}
+    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, anwendungstext (174),{}                                     anwendungstext (175), TRUE);{}    IF alter name = niltext{}       THEN LEAVE hamsterprogramm umbenennen{}    FI.{}  bestand:{}    ALL myself - infix namen (ALL myself, praefix, flaechentype).{}  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + anwendungstext (176) + bisheriger name{}                  + anwendungstext (177).{}
+  ueberschrift:{}    center (maxlaenge, invers (anwendungstext (174))) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  benenne ggf das programm um:{}    IF   neuer name = niltext{}         THEN menuinfo (invers (anwendungstext (192)));{}              LEAVE hamsterprogramm umbenennen{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE hamsterprogramm umbenennen{}       ELSE rename (alter name, neuer name);{}            programmname := neuer name{}
+    FI.{}  mache vorwurf:{}    menuinfo (anwendungstext (195)).{}END PROC hamsterprogramm umbenennen;{}PROC hamsterlandschaft loeschen:{}  lasse flaechen auswaehlen;{}  loesche flaechen;{}  regenerate menuscreen.{}  lasse flaechen auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}    IF NOT not empty (verfuegbare){}       THEN noch keine flaeche;{}            LEAVE hamsterlandschaft loeschen{}       ELSE biete auswahl an{}
+    FI.{}  biete auswahl an:{}    IF ist hamster{}       THEN verfuegbare := menusome (verfuegbare, anwendungstext (118),{}                                     anwendungstext (119), FALSE){}       ELSE verfuegbare := menusome (verfuegbare, anwendungstext (148),{}                                     anwendungstext (149), FALSE){}    FI.{}  loesche flaechen:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (bezeichnung)));{}    menuwindowline (2);{}
+    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (schlussbemerkung);{}    menuwindowstop.{}  bezeichnung:{}    IF ist hamster THEN anwendungstext (118) ELSE anwendungstext (148) FI.{}  schlussbemerkung:{}    IF ist hamster THEN anwendungstext (120) ELSE anwendungstext (150) FI.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}
+         THEN disable stop;{}              IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{}                                      + anwendungstext (203)){}                 THEN forget (praefix + name (verfuegbare, k), quiet){}              FI;{}              fehlerbehandlung{}      FI{}    PER;{}    flaechenname := "".{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            IF ist hamster{}               THEN menuwindowout (anwendungstext (109)){}
+               ELSE menuwindowout (anwendungstext (139)){}            FI;{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE hamsterlandschaft loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}            clear error; enable stop;{}
+            LEAVE hamsterlandschaft loeschen{}    FI.{}END PROC hamsterlandschaft loeschen;{}PROC hamsterprogramm loeschen:{}  lasse programme auswaehlen;{}  loesche programme;{}  regenerate menuscreen.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE hamsterprogramm loeschen{}       ELSE biete auswahl an{}    FI.{}
+  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, anwendungstext (178),{}                             anwendungstext (179), FALSE).{}  loesche programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (anwendungstext (178))));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (anwendungstext (180));{}
+    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              IF menuwindowyes (" """ + name (verfuegbare, k) + """ "{}                                      + anwendungstext (203)){}                 THEN forget (name (verfuegbare, k), quiet){}              FI;{}              fehlerbehandlung{}      FI{}    PER;{}    programmname := "".{}  steige ggf bei leerem thesaurus aus:{}
+    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (anwendungstext (169));{}            menuwindowstop;{}            regenerate menuscreen;{}            LEAVE hamsterprogramm loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (invers (errormessage));{}
+            clear error; enable stop;{}            LEAVE hamsterprogramm loeschen{}    FI.{}END PROC hamsterprogramm loeschen;{}PROC hamsterinteraktiv laufen lassen:{}  frage nach neuer flaeche;{}  cursor on;{}  IF ist hamster{}     THEN hamsterinter (flaechenname){}     ELSE roboterinter (flaechenname){}  FI;{}  programmname := "PROTOKOLL";{}  cursor off;{}  regenerate menuscreen.{}  frage nach neuer flaeche:{}    IF menuyes (ueberschrift + fragetext, 5){}       THEN lasse flaeche auswaehlen{}       ELSE weise auf landschaftsgestaltung hin;{}
+            LEAVE hamsterinteraktiv laufen lassen{}    FI.{}  ueberschrift:{}    IF ist hamster{}       THEN center (laenge, invers (anwendungstext (122))) + ""13""13""{}       ELSE center (laenge, invers (anwendungstext (152))) + ""13""13""{}    FI.{}  fragetext:{}    IF ist hamster{}       THEN center (laenge, anwendungstext (123)){}       ELSE center (laenge, anwendungstext (153)){}    FI.{}  laenge:{}    IF ist hamster{}       THEN max (length (anwendungstext (122)),{}                 length (anwendungstext (123))) + 5{}
+       ELSE max (length (anwendungstext (152)),{}                 length (anwendungstext (153))) + 5{}    FI.{}  lasse flaeche auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}    IF ist hamster{}       THEN flaechenname := menuone (verfuegbare, anwendungstext (122),{}                                     anwendungstext (106), FALSE){}       ELSE flaechenname := menuone (verfuegbare, anwendungstext (152),{}                                     anwendungstext (136), FALSE){}
+    FI;{}    IF flaechenname = niltext{}       THEN weise auf landschaftsgestaltung hin;{}            regenerate menuscreen;{}            LEAVE hamsterinteraktiv laufen lassen{}    FI.{}  weise auf landschaftsgestaltung hin:{}    WINDOW VAR mfenster := current menuwindow;{}    IF ist hamster{}       THEN boxinfo (mfenster, anwendungstext (124), 5, maxint){}       ELSE boxinfo (mfenster, anwendungstext (154), 5, maxint){}    FI.{}END PROC hamsterinteraktiv laufen lassen;{}PROC hamster laufen lassen:{}
+  programmname ermitteln;{}  BOOL VAR namen eingesetzt :: FALSE;{}  untersuche programmdatei auf flaechennamen;{}  page;{}  geschwindigkeit (5);{}  cursor on;{}  lauf (programmname);{}  cursor off;{}  IF namen eingesetzt{}     THEN entferne flaechennamen aus programmdatei{}  FI;{}  regenerate menuscreen.{}  programmname ermitteln:{}    IF programmname <> niltext CAND exists (programmname){}       THEN frage nach diesem programm{}       ELSE lasse programm auswaehlen{}    FI.{}  frage nach diesem programm:{}
+    IF menuno (ueberschrift + anwendungstext (163) + name + anwendungstext (164), 5){}       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    IF ist hamster{}       THEN center (maxlaenge, invers (anwendungstext (125))) + ""13""13""{}       ELSE center (maxlaenge, invers (anwendungstext (155))) + ""13""13""{}    FI.{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare  := ALL myself - infix namen (ALL myself, praefix, flaechentype);{}
+    IF ist hamster{}       THEN programmname := menuone (verfuegbare, anwendungstext (125),{}                                     anwendungstext (166), TRUE){}       ELSE programmname := menuone (verfuegbare, anwendungstext (155),{}                                     anwendungstext (166), TRUE){}    FI;{}    IF programmname = niltext{}       THEN LEAVE hamster laufen lassen{}    FI.{}  untersuche programmdatei auf flaechennamen:{}    FILE VAR a :: sequential file (modify, programmname);{}    TEXT VAR zeile;{}
+    to line (a, 1);{}    REP{}      read record (a, zeile);{}      zeile := compress (zeile);{}      IF NOT eof (a) THEN down (a) FI{}    UNTIL zeile <> "" OR eof (a) PER;{}    IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{}       THEN ermittle flaechennamen;{}            setze flaechennamen in datei ein{}    FI.{}  ermittle flaechennamen:{}    IF flaechenname <> ""{}       THEN frage nach altem flaechennamen{}       ELSE lasse flaeche auswaehlen{}    FI.{}  frage nach altem flaechennamen:{}
+    IF ist hamster{}       THEN frage nach alter landschaft{}       ELSE frage nach altem arbeitsfeld{}    FI.{}  frage nach alter landschaft:{}    IF menuno (ueberschrift + anwendungstext (103){}                    + fname + anwendungstext (104), 5){}       THEN lasse flaeche auswaehlen{}    FI.{}  frage nach altem arbeitsfeld:{}    IF menuno (ueberschrift + anwendungstext (133){}                    + fname + anwendungstext (134), 5){}       THEN lasse flaeche auswaehlen{}    FI.{}  fname:{}    ""13""13" " + invers (flaechenname) + ""13""13"".{}
+  lasse flaeche auswaehlen:{}    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);{}    IF ist hamster{}       THEN flaechenname := menuone (verfuegbare, anwendungstext (125),{}                                     anwendungstext (106), FALSE){}       ELSE flaechenname := menuone (verfuegbare, anwendungstext (155),{}                                     anwendungstext (136), FALSE){}    FI;{}    IF flaechenname = niltext{}       THEN regenerate menuscreen;{}            landschaftsfehler anzeigen;{}
+            LEAVE hamster laufen lassen{}    FI.{}  landschaftsfehler anzeigen:{}    IF ist hamster{}       THEN menuinfo (anwendungstext (124)){}       ELSE menuinfo (anwendungstext (154)){}    FI.{}  setze flaechennamen in datei ein:{}    to line (a, 1);{}    zeile := "landschaft (""" + flaechenname + """);";{}    insert record (a);{}    write record (a, zeile);{}    namen eingesetzt := TRUE.{}  entferne flaechennamen aus programmdatei:{}    FILE VAR b :: sequential file (modify, programmname);{}
+    to line (b, 1);{}    REP{}      read record (b, zeile);{}      IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0{}         THEN IF NOT eof (b) THEN down (b) FI{}      FI{}    UNTIL zeile <> "" OR eof (b) PER;{}    IF pos (zeile, "landschaft") > 0 OR pos (zeile, "arbeitsfeld") > 0{}       THEN delete record (b){}    FI{}END PROC hamster laufen lassen;{}PROC meckere zu langen namen an:{}  menuinfo (anwendungstext (191)){}END PROC meckere zu langen namen an;{}PROC meckere existierende flaeche an:{}
+  IF ist hamster{}     THEN menuinfo (anwendungstext (193)){}     ELSE menuinfo (anwendungstext (194)){}  FI{}END PROC meckere existierende flaeche an;{}PROC meckere existierendes programm an:{}  menuinfo (anwendungstext (195)){}END PROC meckere existierendes programm an;{}PROC noch keine flaeche:{}  IF ist hamster{}     THEN menuinfo (anwendungstext (196)){}     ELSE menuinfo (anwendungstext (197)){}  FI{}END PROC noch keine flaeche;{}PROC noch kein programm:{}  menuinfo (anwendungstext (198)){}
+END PROC noch kein programm;{}END PACKET ls herbert und robbi 3;{}
+
diff --git a/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen b/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen
new file mode 100644
index 0000000..ae21ddb
--- /dev/null
+++ b/app/gs.hamster/1.1/src/ls-Herbert und Robbi-gen
@@ -0,0 +1,33 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                 ls-Herbert und Robbi                ** 
+          **                  GENERATORPROGRAMM                  ** 
+          **                     Version 1.1                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                          *) 
+ 
+LET mm taskname = "ls-MENUKARTEN",{}    datei1      = "ls-Herbert und Robbi 1",{}    datei2      = "ls-Herbert und Robbi 2",{}    datei3      = "ls-Herbert und Robbi 3",{}    menukarte   = "ls-MENUKARTE:Herbert und Robbi";{}PROC stelle existenz des mm sicher:{}  cursor (1, 5); out (""4"");{}  IF NOT exists (task (mm taskname)){}     THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!");{}  FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{}  cursor (1,5); out (""4"");{}
+  out ("  """); out (datei); putline (""" wird geholt.");{}  fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{}  IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{}  hole (datei);{}  cursor (1, 5); out (""4"");{}  out ("  """); out (datei); out (""" wird übersetzt: ");{}  insert (datei);{}  forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{}  cursor (1, 5); out (""4"");{}  out ("  """); out(datei);{}  out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
+  command dialogue (FALSE);{}  save (datei, task (mm taskname));{}  command dialogue (TRUE);{}  forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln, mit erweiterung :: FALSE;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Herbert und Robbi/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{}  page;{}  putline ("              "15"ls-Herbert und Robbi - Automatische Generierung "14"");{}
+  line (2);{}  putline ("  Bitte beantworten Sie noch die folgende Frage:");{}  line;{}  put("  Sollen neben den 'Standardtests' auch die folgenden 'Tests':");{}  line (2);{}  putline("          Für den Hamster:                   Für den Roboter:");{}  putline("           links frei                         links frei");{}  putline("           rechts frei                        rechts frei");{}  putline("           hinten frei                        hinten frei");{}  putline("           korn vorn                          werkstueck vorn");{}
+  putline("           korn links                         werkstueck links");{}  putline("           korn rechts                        werkstueck rechts");{}  putline("           korn hinten                        werkstueck hinten");{}  line;{}  IF yes("  zur Verfügung gestellt werden"){}     THEN mit erweiterung := TRUE{}  FI.{}hole die dateien:{}  IF     NOT exists (datei 1){}     COR NOT exists (datei 3){}     COR NOT exists (menukarte){}     THEN hole dateien vom archiv; LEAVE hole die dateien{}
+  FI;{}  IF mit erweiterung AND NOT exists (datei 2){}     THEN hole dateien vom archiv{}  FI.{}hole dateien vom archiv:{}  cursor (1,3); out (""4"");{}  IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt"){}     THEN lese ein{}     ELSE line (2);{}          errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){}  FI.{}lese ein:{}  cursor (1, 3); out (""4"");{}  out ("                   "15"Bitte die Diskette eingelegt lassen! "14"");{}  IF NOT einzeln{}     THEN  hole (datei 1);{}
+           hole (datei 3);{}           hole (menukarte);{}           IF mit erweiterung{}              THEN hole (datei 2){}           FI;{}           cursor (1, 3); out(""4"");{}           out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");{}           release (archive){}  FI.{}insertiere die dateien:{}  check off;{}  cursor (1, 3); out(""4"");{}  out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");{}  in (datei 1);{}  IF mit erweiterung{}     THEN in (datei 2){}
+  FI;{}  in (datei 3);{}  schicke (menukarte);{}  IF einzeln THEN release (archive) FI;{}  check on.{}mache global manager aus der task:{}  global manager.{}
+
diff --git a/hamster/ls-MENUKARTE:Herbert und Robbi b/app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi
index 2e9629c..2e9629c 100644
--- a/hamster/ls-MENUKARTE:Herbert und Robbi
+++ b/app/gs.hamster/1.1/src/ls-MENUKARTE:Herbert und Robbi
diff --git a/doc/menugenerator/menu-generator handbuch.1 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.1
index c190c0a..c190c0a 100644
--- a/doc/menugenerator/menu-generator handbuch.1
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.1
diff --git a/doc/menugenerator/menu-generator handbuch.2 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.2
index 696ed28..696ed28 100644
--- a/doc/menugenerator/menu-generator handbuch.2
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.2
diff --git a/doc/menugenerator/menu-generator handbuch.3 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.3
index e982988..e982988 100644
--- a/doc/menugenerator/menu-generator handbuch.3
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.3
diff --git a/doc/menugenerator/menu-generator handbuch.4 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.4
index 97e7491..97e7491 100644
--- a/doc/menugenerator/menu-generator handbuch.4
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.4
diff --git a/doc/menugenerator/menu-generator handbuch.5 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.5
index c002f1a..c002f1a 100644
--- a/doc/menugenerator/menu-generator handbuch.5
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.5
diff --git a/doc/menugenerator/menu-generator handbuch.6 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.6
index a0dd3b5..a0dd3b5 100644
--- a/doc/menugenerator/menu-generator handbuch.6
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.6
diff --git a/doc/menugenerator/menu-generator handbuch.7 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.7
index 2e6f0ba..2e6f0ba 100644
--- a/doc/menugenerator/menu-generator handbuch.7
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.7
diff --git a/doc/menugenerator/menu-generator handbuch.8 b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.8
index 66eb6cf..66eb6cf 100644
--- a/doc/menugenerator/menu-generator handbuch.8
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.8
diff --git a/doc/menugenerator/menu-generator handbuch.impressum b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum
index 404826d..404826d 100644
--- a/doc/menugenerator/menu-generator handbuch.impressum
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.impressum
diff --git a/doc/menugenerator/menu-generator handbuch.index b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.index
index 0aacd97..0aacd97 100644
--- a/doc/menugenerator/menu-generator handbuch.index
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.index
diff --git a/doc/menugenerator/menu-generator handbuch.inhalt b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt
index 8b1aef4..8b1aef4 100644
--- a/doc/menugenerator/menu-generator handbuch.inhalt
+++ b/app/gs.menugenerator/1.0/doc/menu-generator handbuch.inhalt
diff --git a/app/gs.menugenerator/1.0/source-disk b/app/gs.menugenerator/1.0/source-disk
new file mode 100644
index 0000000..f02e499
--- /dev/null
+++ b/app/gs.menugenerator/1.0/source-disk
@@ -0,0 +1 @@
+informatikpaket/06_gs.menugenerator.img
diff --git a/menugenerator/Generatordatei: Archivmenu b/app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu
index 76393fc..76393fc 100644
--- a/menugenerator/Generatordatei: Archivmenu
+++ b/app/gs.menugenerator/1.0/src/Generatordatei: Archivmenu
diff --git a/menugenerator/fonttab.ls-Menu-Generator b/app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator
index a5fd613..a5fd613 100644
--- a/menugenerator/fonttab.ls-Menu-Generator
+++ b/app/gs.menugenerator/1.0/src/fonttab.ls-Menu-Generator
diff --git a/menugenerator/ls-MENUBASISTEXTE b/app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE
index 48ef277..48ef277 100644
--- a/menugenerator/ls-MENUBASISTEXTE
+++ b/app/gs.menugenerator/1.0/src/ls-MENUBASISTEXTE
diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1 b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1
new file mode 100644
index 0000000..b9dfd73
--- /dev/null
+++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 1
@@ -0,0 +1,47 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                 ls-Menu-Generator 1                 ** 
+          **                                                     ** 
+          **                     Version 1.0                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls menu generator 1 DEFINES{}       textprozedur,{}       textzeile:{}LET maxzeilenzahl     =   14,{}    maxzeichenzahl    =   65,{}    zentrierkennung   =  "%",{}    beginmarkkennung  =  "$",{}    endmarkkennung    =  "&",{}    unblockkennung    =  "�",{}    blank             =  " ",{}    dateikennung      = ".a";{}LET dateieintrag      = "#type (""10"")##limit (16.5)#",{}    stdfonttabelle    = "fonttab.ls-Menu-Generator";{}ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : ({}"existiert nicht!",{}
+""15"Text ist zu lang - bitte kürzen! "14"",{}""15"Zeilenformatierung mit <ESC> abgebrochen! "14""{});{}ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : ({}"Bitte warten ...",{}"Zulässige    Zeilenzahl: ",{}"Tatsächliche Zeilenzahl: ",{}"Textlänge ist in Ordnung!",{}"Textprozedur ist erstellt!",{}"Textzeile ist erstellt!"{});{}PROC textprozedur (TEXT CONST dateiname, prozedurname):{}  BOOL VAR mit fehler;{}  formatiere (dateiname, mit fehler);{}  IF mit fehler{}     THEN errorstop (fehlermeldung [3]){}  FI;{}
+  bereite den text auf (dateiname);{}  erzeuge textprozedur (dateiname, prozedurname);{}  out (""7""); out (hinweis [5]);{}  last param (dateiname + dateikennung){}END PROC textprozedur;{}PROC textzeile (TEXT CONST dateiname):{}  BOOL VAR mit fehler;{}  formatiere (dateiname, mit fehler);{}  IF mit fehler{}     THEN errorstop (fehlermeldung [3]){}  FI;{}  bereite den text auf (dateiname);{}  erzeuge textzeile    (dateiname);{}  out (""7""); out (hinweis [6]);{}  last param (dateiname + dateikennung){}
+END PROC textzeile;{}PROC gib wartehinweis:{}  page;{}  out (hinweis [1]){}END PROC gib wartehinweis;{}PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):{}  TEXT VAR fonttabelle, zeileninhalt;{}  kontrolliere existenz;{}  stelle fonttabelle ein;{}  schreibe font in die datei;{}  zeilenformatierung;{}  entferne ggf font aus der datei;{}  stelle fonttabelle zurueck;{}  streiche restleerzeilen weg;{}  untersuche ggf datei auf korrektheit.{}  kontrolliere existenz:{}    IF NOT exists (dateiname){}
+       THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1]){}    FI.{}  stelle fonttabelle ein:{}    gib wartehinweis;{}    fonttabelle := fonttable;{}    fonttable (stdfonttabelle).{}  schreibe font in die datei:{}    FILE VAR datei :: sequential file (modify, dateiname);{}    to line (datei, 1);{}    insert record (datei);{}    write record (datei, dateieintrag + blank).{}  zeilenformatierung:{}    disable stop;{}    lineform (dateiname);{}    IF is error{}       THEN clear error;{}
+            mit fehler := TRUE{}       ELSE mit fehler := FALSE{}    FI;{}    enable stop.{}  entferne ggf font aus der datei:{}    to line (datei, 1);{}    read record (datei, zeileninhalt);{}    IF pos (zeileninhalt, dateieintrag) > 0{}       THEN delete record (datei){}    FI.{}  stelle fonttabelle zurueck:{}    fonttable (fonttabelle).{}  streiche restleerzeilen weg:{}    REP{}      streiche ggf letzte zeile{}    UNTIL zeile ist nicht leer PER.{}  streiche ggf letzte zeile:{}    to line (datei, lines (datei));{}
+    read record (datei, zeileninhalt);{}    IF compress (zeileninhalt) = ""{}       THEN delete record (datei){}    FI.{}  zeile ist nicht leer:{}    compress (zeileninhalt) <> "".{}  untersuche ggf datei auf korrektheit:{}    IF NOT mit fehler{}       THEN untersuche zeilenzahl{}    FI.{}  untersuche zeilenzahl:{}    IF lines (datei) > maxzeilenzahl{}       THEN page;{}            out (hinweis [2] + text (maxzeilenzahl)); line;{}            out (hinweis [3] + text (lines (datei))); line (2);{}            errorstop (fehlermeldung [2]){}
+       ELSE page;{}            out (hinweis [4]){}    FI.{}END PROC formatiere;{}PROC bereite den text auf (TEXT CONST dateiname):{}  INT  VAR zaehler;{}  TEXT VAR zeileninhalt;{}  FILE VAR f :: sequential file (modify, dateiname);{}  gib wartehinweis;{}  vernichte ggf aufbereitete datei;{}  richte datei neu ein;{}  uebertrage die zeilen.{}  vernichte ggf aufbereitete datei:{}    IF exists (dateiname + dateikennung){}       THEN forget (dateiname + dateikennung, quiet){}    FI.{}  richte datei neu ein:{}
+    FILE VAR aus :: sequential file (output, dateiname + dateikennung).{}  uebertrage die zeilen:{}    FOR zaehler FROM 1 UPTO lines (f) REP{}      bereite eine zeile auf{}    PER.{}  bereite eine zeile auf:{}    to line (f, zaehler);{}    read record (f, zeileninhalt);{}    ersetze alle gaensefuesschen;{}    haenge ggf absatzmarke an;{}    behandle zeile;{}    putline (aus, zeileninhalt).{}  ersetze alle gaensefuesschen:{}    change all (zeileninhalt, """", "'").{}  haenge ggf absatzmarke an:{}    IF (zeileninhalt SUB (length (zeileninhalt))) = blank{}
+       THEN IF (zeileninhalt SUB 1) <> zentrierkennung{}               THEN zeileninhalt CAT unblockkennung{}            FI{}    FI.{}  behandle zeile:{}    IF   zeile soll zentriert werden{}         THEN zentriere zeile{}    ELIF zeile ist leerzeile{}         THEN kennzeichne leerzeile{}    ELSE blocke zeile auf stdlaenge{}    FI.{}  zeile soll zentriert werden:{}    (zeileninhalt SUB 1) = zentrierkennung.{}  zeile ist leerzeile:{}    compress (zeileninhalt) = "".{}  zentriere zeile:{}    zeileninhalt := subtext (zeileninhalt, 2);{}
+    zeileninhalt := anfangsblanks + zeileninhalt;{}    zeilenabschluss.{}  anfangsblanks:{}    ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.{}  zeilenabschluss:{}    ersetze markierungszeichen;{}    setze 13.{}  ersetze markierungszeichen:{}    change all (zeileninhalt, beginmarkkennung, """15""");{}    change all (zeileninhalt, endmarkkennung,    """14""").{}  setze 13:{}    zeileninhalt CAT " ""13""".{}  kennzeichne leerzeile:{}    zeileninhalt := """13""".{}  blocke zeile auf stdlaenge:{}
+    IF zeile darf nicht geblockt werden{}       THEN ersetze endezeichen{}       ELSE fuehre blockung aus{}    FI.{}  zeile darf nicht geblockt werden:{}    (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.{}  ersetze endezeichen:{}    zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);{}    ersetze markierungszeichen;{}    setze 13.{}  fuehre blockung aus:{}    ROW maxzeichenzahl INT VAR leerzeichen;{}    INT VAR gezaehlte blanks, zu verteilende blanks;{}    ordne anfangswerte zu;{}
+    verteile blanks gleichmaessig;{}    verteile blanks zufaellig;{}    baue zeile zusammen;{}    ersetze markierungszeichen;{}    setze 13.{}  ordne anfangswerte zu:{}    bestimme blankanzahl in der zeile;{}    bestimme zu verteilende blanks;{}    initialisiere die reihung.{}  bestimme blankanzahl in der zeile:{}    gezaehlte blanks := 0;{}    INT VAR zeiger;{}    FOR zeiger FROM 1 UPTO length (zeileninhalt) REP{}      IF (zeileninhalt SUB zeiger) = blank{}         THEN gezaehlte blanks INCR 1{}
+      FI{}    PER.{}  bestimme zu verteilende blanks:{}    zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).{}  initialisiere die reihung:{}    FOR zeiger FROM 1 UPTO gezaehlte blanks REP{}      leerzeichen [zeiger] := 1{}    PER.{}  verteile blanks gleichmaessig:{}    WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP{}      schlag je ein blank auf;{}      zu verteilende blanks DECR gezaehlte blanks{}    PER.{}  schlag je ein blank auf:{}    FOR zeiger FROM 1 UPTO gezaehlte blanks REP{}
+      leerzeichen [zeiger] INCR 1{}    PER.{}  verteile blanks zufaellig:{}    FOR zeiger FROM 1 UPTO zu verteilende blanks REP{}      leerzeichen [random (1, gezaehlte blanks)] INCR 1{}    PER.{}  baue zeile zusammen:{}    TEXT VAR zwischen        := zeileninhalt;{}    INT  VAR aktuelles blank := 0;{}    zeileninhalt             := "";{}    FOR zeiger FROM 1 UPTO length (zwischen) REP{}      TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);{}      IF aktuelles zeichen = blank{}         THEN aktuelles blank INCR 1;{}
+              zeileninhalt CAT (leerzeichen [aktuelles blank] * blank){}         ELSE zeileninhalt CAT aktuelles zeichen{}      FI{}    PER{}END PROC bereite den text auf;{}PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):{}  mache aus den zeilen einzeltexte;{}  entferne ueberfluessige restzeilen;{}  erstelle eine textprozedur.{}  mache aus den zeilen einzeltexte:{}    INT  VAR zeiger;{}    FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{}    FOR zeiger FROM 1 UPTO lines (ausdatei) REP{}
+      bearbeite eine zeile{}    PER.{}  bearbeite eine zeile:{}    TEXT VAR zeileninhalt;{}    to line (ausdatei, zeiger);{}    read record (ausdatei, zeileninhalt);{}    zeileninhalt := """ " + zeileninhalt + """ +";{}    change all (zeileninhalt, "­", "-");{}    write record (ausdatei, zeileninhalt).{}  entferne ueberfluessige restzeilen:{}    REP{}      entferne ggf eine zeile{}    UNTIL zeileninhalt <> """   ""13"""" +" PER;{}    entferne return aus letzter zeile.{}  entferne ggf eine zeile:{}
+    IF compress (zeileninhalt) = """   ""13"""" +"{}       THEN delete record (ausdatei){}    FI.{}  entferne return aus letzter zeile:{}    to line (ausdatei, lines (ausdatei));{}    read record (ausdatei, zeileninhalt);{}    zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);{}    write record (ausdatei, zeileninhalt).{}  erstelle eine textprozedur:{}    schreibe procanfang;{}    schreibe procende.{}  schreibe procanfang:{}    to line (ausdatei, 1);{}    insert record (ausdatei);{}
+    write record (ausdatei, "TEXT PROC " + prozedurname + ":").{}  schreibe procende:{}    to line (ausdatei, lines (ausdatei) + 1);{}    insert record (ausdatei);{}    write record (ausdatei, "END PROC " + prozedurname + ";").{}END PROC erzeuge textprozedur;{}PROC erzeuge textzeile (TEXT CONST dateiname):{}  entferne ueberfluessige restzeilen;{}  entferne return aus letzter zeile;{}  erstelle eine textzeile.{}  entferne ueberfluessige restzeilen:{}    TEXT VAR zeileninhalt;{}    INT VAR zeiger;{}
+    FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);{}    REP{}      entferne ggf eine zeile{}    UNTIL compress (zeileninhalt) <> """13""" PER.{}  entferne ggf eine zeile:{}    to line (ausdatei, lines (ausdatei));{}    read record (ausdatei, zeileninhalt);{}    IF compress (zeileninhalt) = """13"""{}       THEN delete record (ausdatei){}    FI.{}  entferne return aus letzter zeile:{}    to line (ausdatei, lines (ausdatei));{}    read record (ausdatei, zeileninhalt);{}    change all (zeileninhalt, """13""", "");{}
+    write record (ausdatei, zeileninhalt).{}  erstelle eine textzeile:{}    haenge die zeilen aneinander;{}    fasse zeile in gaensefuesschen;{}    schreibe einzelzeile in ausgabedatei.{}  haenge die zeilen aneinander:{}    TEXT VAR zeile :: "";{}    FOR zeiger FROM 1 UPTO lines (ausdatei) REP{}      to line (ausdatei, zeiger);{}      read record (ausdatei, zeileninhalt);{}      zeile CAT (" " + zeileninhalt){}    PER.{}  fasse zeile in gaensefuesschen:{}    zeile := """" + zeile + """";{}    change all (zeile, "­","-").{}
+  schreibe einzelzeile in ausgabedatei:{}    forget (dateiname + dateikennung, quiet);{}    FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);{}    to line (fertig, 1);{}    insert record (fertig);{}    write record (fertig, zeile){}END PROC erzeuge textzeile;{}END PACKET ls menu generator 1;{}
+
diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2 b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2
new file mode 100644
index 0000000..608f680
--- /dev/null
+++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator 2
@@ -0,0 +1,72 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                 ls-Menu-Generator 2                 ** 
+          **                                                     ** 
+          **                     Version 1.0                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+PACKET ls menu generator 2 DEFINES{}            oeffne menukarte,{}            oeffne menu,{}            oberbegriff,{}            menufunktion,{}            trennlinie,{}            schliesse menu,{}            schliesse menukarte,{}            testinstallation:{}LET menutafeltype         = 1954,{}    kennung               = "ls - Menu - Generator",{}    mm taskname           = "ls-MENUKARTEN",{}    menutafelpraefix      = "ls-MENUKARTE:",{}    menu grundtext        = "ls-MENUBASISTEXTE",{}    zwischenablagename    = "MENU-ZWISCHENABLAGEDATEI INTERN";{}
+LET maxmenus              =    6,{}    maxmenutexte          =  300,{}    maxinfotexte          = 2000,{}    maxhauptmenupunkte    =   10,{}    maxuntermenupunkte    =   15,{}    maxmenubreite         =   71;   (* Breite der Hauptmenüzeile - 2 *){}LET blank                 =    " ",{}    cleop                 =  ""4"",{}    piep                  =  ""7"",{}    trennzeilensymbol     =  "###",{}    bleibt leer symbol    =  "***",{}    hauptmenuluecke       =  "  ";{}LET dummyname             =  "Dummy für Anwendertexte",{}
+    install finished      =  "Installation abgeschlossen!",{}    card finished         =  "Menukartengenerierung abgeschlossen!",{}    filetype              =  1003;{}TYPE MENUPUNKT   = STRUCT (TEXT punktkuerzel,{}                                punktname,{}                                procname,{}                                boxtext,{}                           BOOL aktiv,{}                                angewaehlt),{}     EINZELMENU  = STRUCT (INT  belegt,{}                           TEXT ueberschrift,{}
+                           INT  anfangsposition,{}                                maxlaenge,{}                           ROW  maxuntermenupunkte MENUPUNKT menupunkt,{}                           INT  aktueller untermenupunkt,{}                           TEXT startprozedurname,{}                                leaveprozedurname),{}     MENU        = STRUCT (TEXT menuname,{}                           INT  anzahl hauptmenupunkte,{}                           ROW  maxhauptmenupunkte EINZELMENU einzelmenu,{}
+                           TEXT menueingangsprozedur,{}                                menuausgangsprozedur,{}                                menuinfo,{}                                lizenznummer,{}                                versionsnummer,{}                           INT  hauptmenuzeiger,{}                                untermenuanfang,{}                                untermenuzeiger),{}     INFOTEXT    = STRUCT (INT anzahl infotexte,{}                           ROW maxinfotexte TEXT stelle),{}
+     MENUTEXT    = STRUCT (INT anzahl menutexte,{}                           ROW maxmenutexte TEXT platz),{}     MENULEISTE  = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,{}                           ROW maxmenus MENU menu,{}                           MENUTEXT   menutext,{}                           INFOTEXT   infotext);{}ROW 14 TEXT CONST aussage :: ROW 14 TEXT : ({}"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",{}"Kann die bereits existierende Menukarte gelöscht werden",{}
+"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",{}"Zum Weitermachen bitte irgendeine Taste tippen!",{}"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",{}"Auswahl der Datei, in der die Anwendungstexte stehen.",{}"Bitte die gewünschte Datei ankreuzen!",{}"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",{}"",{}"Einlesen von Texten aus Datei : ",{}"Bearbeitet  wird Menu         : ",{}"Eingetragen wird Oberbegriff  : ",{}
+"Eingetragen wird Menufunktion : "{});{}ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : ({}"Ohne die Datei '",{}"' "13""10""10"         ist die Menuerstellung "15"unmöglich "14"!!",{}"Hier muß unbedingt eine Datei angekreuzt werden!",{}"Ausgewählte Datei hat falschen Typ (<> 1003) )",{}"Zu viele Anwendungstexte in der Datei ",{}"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",{}"Anführungszeichen fehlt irgendwo in Zeile ",{}"Die angegebene Datei existiert nicht!",{}"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",{}
+"Vorausgehendes Menu nicht geschlossen! ",{}"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",{}"Menuname ist mehrfach vorhanden!",{}"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",{}"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",{}"Die Kopfzeile ist zu lang (> " + text (maxmenubreite)  + ")!",{}"Menupunkt-Kürzel ist länger als ein Zeichen!",{}"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",{}"Menupunkt-Bezeichnung ist zu lang!",{}"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",{}
+"Menukarte '",{}"' gibt es nicht in dieser Task!",{}"' hat falsche(n) Typ/Bezeichnung"{});{}TEXT VAR menuinfotextdateiname,{}         aktueller menudateiname;{}BOOL VAR menuleiste ist bereit :: FALSE,{}         menu ist geoeffnet    :: FALSE;{}BOUND MENULEISTE VAR menuleiste;{}BOUND MENUTEXT   VAR basistexte;{}BOUND MENU       VAR aktuelles menu;{}DATASPACE VAR ds;{}OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):{}  INT VAR z;{}  ziel.anzahl menutexte := quelle.anzahl menutexte;{}  FOR z FROM 1 UPTO quelle.anzahl menutexte REP{}
+    ziel.platz [z] := quelle.platz [z]{}  PER{}END OP :=;{}OP := (MENU VAR ziel, MENU CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC oeffne menukarte (TEXT CONST menukartenname):{}  gib bildschirmhinweis aus;{}  ueberpruefe voraussetzungen;{}  erfrage den namen der datei mit den anwendertexten;{}
+  erstelle neue menuleiste.{}  gib bildschirmhinweis aus:{}    page; out (center (invers (kennung))).{}  ueberpruefe voraussetzungen:{}    ueberpruefe ob basistexte vorhanden sind;{}    ueberpruefe ob menukarte schon vorhanden ist.{}  ueberpruefe ob basistexte vorhanden sind:{}    IF NOT exists (menu grundtext){}       THEN gib hinweis und brich ab{}    FI.{}  gib hinweis und brich ab:{}    disable stop;{}    fetch (menu grundtext, /mm taskname);{}    IF is error{}       THEN clear error;{}            enable stop;{}
+            cursor (1, 4); out (cleop);{}            errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2]){}       ELSE clear error;{}            enable stop{}    FI.{}  ueberpruefe ob menukarte schon vorhanden ist:{}    IF exists (menukarte){}       THEN gib hinweis auf vorhandene menukarte;{}            frage ob die alte karte geloescht werden darf{}    FI.{}  menukarte:{}    menutafelpraefix + menukartenname.{}  gib hinweis auf vorhandene menukarte:{}    cursor (1, 4); out (cleop);{}
+    cursor (1, 4); out (center (menukarte));{}    cursor (1, 6); out (center (invers (aussage [1]))).{}  frage ob die alte karte geloescht werden darf:{}    cursor (2, 9);{}    IF yes (aussage [2]){}       THEN forget (menukarte, quiet){}       ELSE weiterarbeit ist unmoeglich{}    FI.{}  weiterarbeit ist unmoeglich:{}    cursor (1, 12); out (center (invers (aussage [3])));{}    cursor (2, 15); out (aussage [4]);{}    cursor (2, 16); pause; page;{}    errorstop ("").{}  erfrage den namen der datei mit den anwendertexten:{}
+    cursor (1, 4); out (cleop);{}    IF yes (aussage [5]){}       THEN biete dateiauswahl an{}       ELSE erzeuge dateidummy{}    FI.{}  biete dateiauswahl an:{}    menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,{}                                  aussage [6], aussage [7]);{}    ueberpruefe den dateinamen;{}    ueberpruefe den dateityp.{}  ueberpruefe den dateinamen:{}    IF compress (menuinfotextdateiname) = ""{}       THEN page; errorstop (fehlermeldung [3]){}    FI.{}  ueberpruefe den dateityp:{}
+    IF datei hat falschen typ{}       THEN page; errorstop (fehlermeldung [4]){}    FI.{}  datei hat falschen typ:{}    ds := old (menuinfotextdateiname);{}    IF type (ds) <> filetype{}       THEN forget (ds); TRUE{}       ELSE forget (ds); FALSE{}    FI.{}  erzeuge dateidummy:{}    forget (dummyname, quiet);{}    FILE VAR datei :: sequential file (modify, dummyname);{}    to line (datei, 1);{}    menuinfotextdateiname := dummyname.{}  erstelle neue menuleiste:{}    INT  VAR zeiger;{}    TEXT VAR zeileninhalt;{}
+    initialisiere werte;{}    aktueller menudateiname  := menukarte;{}    menuleiste               := new (aktueller menudateiname);{}    type (old (aktueller menudateiname), menutafeltype);{}    menuleiste.belegt        := 0;{}    menuleiste ist bereit    := TRUE;{}    trage menubasistexte ein;{}    trage anwendungstexte ein.{}  initialisiere werte:{}    menuleiste ist bereit  := FALSE;{}    menu ist geoeffnet     := FALSE.{}  trage menubasistexte ein:{}    basistexte             := old (menu grundtext);{}
+    menuleiste.menutext    := basistexte.{}  trage anwendungstexte ein:{}    konvertiere (menuinfotextdateiname, zwischenablagename,{}                 menuleiste.infotext.anzahl infotexte);{}    ueberpruefe anwendungstextanzahl;{}    trage anwendungstexte in die menuleiste.{}  ueberpruefe anwendungstextanzahl:{}    IF menuleiste.infotext.anzahl infotexte > maxinfotexte{}       THEN forget (zwischenablagename,      quiet);{}            forget (aktueller menudateiname, quiet);{}            errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'"){}
+    FI.{}  trage anwendungstexte in die menuleiste:{}    gib hinweis auf anwendungstexteintrag;{}    FILE VAR ein :: sequential file (input, zwischenablagename);{}    FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP{}      getline (ein, zeileninhalt);{}      menuleiste.infotext.stelle [zeiger] := zeileninhalt;{}      cout (zeiger){}    PER;{}    forget (zwischenablagename, quiet);{}    forget (dummyname         , quiet).{}  gib hinweis auf anwendungstexteintrag:{}    cursor (1, 7); out (aussage [9]).{}
+END PROC oeffne menukarte;{}PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,{}                  INT  VAR   anzahl konvertierter saetze):{}  loesche ausgabedatei;{}  untersuche eingabedatei;{}  konvertiere saetze.{}  loesche ausgabedatei:{}    IF exists (ausgabedatei){}       THEN forget (ausgabedatei, quiet){}    FI.{}  untersuche eingabedatei:{}    IF NOT exists (eingabedatei){}       THEN errorstop (fehlermeldung [8]){}    FI.{}  konvertiere saetze:{}    gib hinweis;{}    konvertiere satzweise.{}
+  gib hinweis:{}    cursor (1, 4); out (cleop);{}    cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");{}    cursor (1, 6); out (aussage [ 8]);{}    anzahl konvertierter saetze := 0.{}  konvertiere satzweise:{}    TEXT VAR zeileninhalt :: "";{}    FILE VAR eingabe :: sequential file (input, eingabedatei);{}    WHILE NOT eof (eingabe) REP{}      behandle eine dateizeile{}    PER;{}    optimiere ausgabedatei.{}  behandle eine dateizeile:{}    getline (eingabe, zeileninhalt);{}    anzahl konvertierter saetze INCR 1;{}
+    cout (anzahl konvertierter saetze);{}    untersuche zeile;{}    wandle die zeile um;{}    FILE VAR aus :: sequential file (output, ausgabedatei);{}    write (aus, textausgabe).{}  untersuche zeile:{}    zeileninhalt := compress (zeileninhalt);{}    IF zeileninhalt = ""{}       THEN zeileninhalt := """"""{}    FI;{}    IF    (zeileninhalt SUB 1)                     <> """"{}       OR (zeileninhalt SUB length (zeileninhalt)) <> """"{}       THEN bereite abgang vor;{}            errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze)){}
+    FI.{}  wandle die zeile um:{}    TEXT VAR textausgabe :: "", codekette;{}    zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);{}    WHILE gaensefuesschenposition > 0 REP{}        textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);{}        zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);{}        codekette    := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));{}        IF   codekette =  """7"""{}             THEN textausgabe CAT  ""7""{}
+        ELIF codekette =  """5"""{}             THEN textausgabe CAT  ""5""{}        ELIF codekette =  """4"""{}             THEN textausgabe CAT  ""4""{}        ELIF codekette =  """10"""{}             THEN textausgabe CAT ""10""{}        ELIF codekette = """13"""{}             THEN textausgabe CAT ""13""{}        ELIF codekette = """14"""{}             THEN textausgabe CAT ""14""{}        ELIF codekette = """15"""{}             THEN textausgabe CAT ""15""{}        ELIF codekette = """"""{}             THEN textausgabe CAT """"{}
+        ELSE errorstop (fehlermeldung [7] +{}                        text (anzahl konvertierter saetze)){}        FI;{}        zeileninhalt := subtext (zeileninhalt, 1 + length (codekette)){}      PER;{}      textausgabe CAT zeileninhalt.{}    gaensefuesschenposition:{}      pos (zeileninhalt, """").{}    bereite abgang vor:{}      forget (ausgabedatei, quiet);{}      line (2).{}  optimiere ausgabedatei:{}    FILE VAR ausgabe :: sequential file (modify, ausgabedatei);{}    WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP{}
+      to line (ausgabe, lines (ausgabe));{}      delete record (ausgabe);{}      anzahl konvertierter saetze DECR 1;{}      cout (anzahl konvertierter saetze ){}    PER.{}  letzter satz ist leer:{}   TEXT VAR satz;{}   to line (ausgabe,lines (ausgabe));{}   read record (ausgabe, satz);{}   IF compress (satz) = "" OR compress (satz) = ""13""{}      THEN TRUE{}      ELSE FALSE{}   FI.{}END PROC konvertiere;{}PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,{}                             itext, ltext, vtext):{}
+  gib hinweis auf geoeffnetes menu;{}  ueberpruefe auf ungereimtheiten;{}  nimm eintragungen in datenraum vor.{}  gib hinweis auf geoeffnetes menu:{}    cursor (1, 4); out (cleop);{}    out (aussage [12]); out (invers (name));{}    cursor (1, 6).{}  ueberpruefe auf ungereimtheiten:{}    pruefe auf bereits geoeffnete menuliste;{}    pruefe auf noch geoeffnetes menu;{}    pruefe auf noch freie menuplaetze;{}    pruefe auf schon vorhandenen menunamen.{}  pruefe auf bereits geoeffnete menuliste:{}    IF NOT menuleiste ist bereit{}
+       THEN bereinige eintragungen (9){}    FI.{}  pruefe auf noch geoeffnetes menu:{}    IF menu ist geoeffnet{}       THEN bereinige eintragungen (10){}    FI.{}  pruefe auf noch freie menuplaetze:{}    IF menuleiste.belegt = maxmenus{}       THEN bereinige eintragungen (11){}    FI.{}  pruefe auf schon vorhandenen menunamen:{}    IF menuname schon vorhanden{}       THEN bereinige eintragungen (12){}    FI.{}  menuname schon vorhanden:{}    INT VAR i;{}    FOR i FROM 1 UPTO menuleiste.belegt REP{}
+      untersuche einzelnen menunamen{}    PER;{}    FALSE.{}  untersuche einzelnen menunamen:{}    IF menuleiste.menu [i].menuname = compress (name){}       THEN LEAVE menuname schon vorhanden WITH TRUE{}    FI.{}  nimm eintragungen in datenraum vor:{}    forget (ds);{}    ds                                  := nilspace;{}    aktuelles menu                      := ds;{}    init (aktuelles menu);{}    aktuelles menu.menuname             := compress (name);{}    aktuelles menu.menueingangsprozedur := compress (einstiegsproc);{}
+    aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);{}    IF itext <> ""{}        THEN aktuelles menu.menuinfo          := itext;{}             aktuelles menu.lizenznummer      := ltext;{}             aktuelles menu.versionsnummer    := vtext{}        ELSE aktuelles menu.menuinfo          := bleibt leer symbol;{}             aktuelles menu.lizenznummer      := "";{}             aktuelles menu.versionsnummer    := ""{}    FI;{}    menu ist geoeffnet      := TRUE.{}END PROC oeffne menu;{}
+PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):{}  oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", ""){}END PROC oeffne menu;{}PROC oeffne menu (TEXT CONST name):{}  oeffne menu (name, "", "", "", "", ""){}END PROC oeffne menu;{}PROC bereinige eintragungen (INT CONST nummer):{}  forget (ds);{}  forget (aktueller menudateiname, quiet);{}  menuleiste ist bereit := FALSE;{}  menu ist geoeffnet    := FALSE;{}  errorstop (fehlermeldung [nummer]){}END PROC bereinige eintragungen;{}
+PROC init (MENU VAR m):{}  m.menuname                         := "";{}  m.hauptmenuzeiger                  := 1;{}  m.untermenuanfang                  := 0;{}  m.untermenuzeiger                  := 0;{}  m.menueingangsprozedur             := "";{}  m.menuausgangsprozedur             := "";{}  m.menuinfo                         := "";{}  m.versionsnummer                   := "";{}  m.anzahl hauptmenupunkte           := 0;{}  belege hauptmenupunkte.{}  belege hauptmenupunkte:{}    INT VAR i;{}    FOR i FROM 1 UPTO maxhauptmenupunkte REP{}
+      aktuelles einzelmenu.belegt                     :=   0;{}      aktuelles einzelmenu.ueberschrift               :=  "";{}      aktuelles einzelmenu.anfangsposition            :=   0;{}      aktuelles einzelmenu.maxlaenge                  :=   0;{}      aktuelles einzelmenu.aktueller untermenupunkt   :=   1;{}      aktuelles einzelmenu.startprozedurname          :=  "";{}      aktuelles einzelmenu.leaveprozedurname          :=  "";{}      belege untermenuepunkte{}    PER.{}   belege untermenuepunkte:{}
+     INT VAR j;{}     FOR j FROM 1 UPTO maxuntermenupunkte REP{}       aktueller menupunkt.punktkuerzel := "";{}       aktueller menupunkt.punktname    := "";{}       aktueller menupunkt.procname     := "";{}       aktueller menupunkt.boxtext      := "";{}       aktueller menupunkt.aktiv        := TRUE;{}       aktueller menupunkt.angewaehlt   := FALSE{}     PER.{}   aktuelles einzelmenu: m.einzelmenu [i].{}   aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].{}END PROC init;{}PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):{}
+  gib hinweis auf oberbegriff;{}  untersuche ob menu geoeffnet und bereit ist;{}  untersuche oberbegriffe;{}  trage neuen oberbegriff ein;{}  notiere die anfangsposition;{}  notiere start und leaveprozedur;{}  erhoehe die anzahl der oberbegriffe.{}  gib hinweis auf oberbegriff:{}    cursor (1, 6); out (cleop);{}    cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.{}  untersuche ob menu geoeffnet und bereit ist:{}    IF NOT menuleiste ist bereit{}       THEN bereinige eintragungen ( 9){}
+    FI;{}    IF NOT menu ist geoeffnet{}       THEN bereinige eintragungen (13){}    FI.{}  untersuche oberbegriffe:{}    IF zu viele oberbegriffe{}       THEN bereinige eintragungen (14){}    FI;{}    IF gesamtlaenge > maxmenubreite{}       THEN bereinige eintragungen (15){}    FI.{}  zu viele oberbegriffe:{}    aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.{}  gesamtlaenge:{}    gesamtlaenge ohne letzten punkt + length (compress (punktname)).{}  gesamtlaenge ohne letzten punkt:{}    length (hauptmenuzeile).{}
+  hauptmenuzeile:{}    INT VAR zaehler;{}    TEXT VAR zeile :: "";{}    schreibe menunamen;{}    schreibe oberbegriffe;{}    zeile.{}  schreibe menunamen:{}    IF aktuelles menu. menuname <> ""{}       THEN zeile CAT aktuelles menu.menuname;{}            zeile CAT ":"{}    FI.{}  schreibe oberbegriffe:{}    FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP{}      zeile CAT hauptmenuluecke;{}      zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift{}    PER;{}    zeile CAT hauptmenuluecke.{}
+  trage neuen oberbegriff ein:{}    neuer menupunkt.ueberschrift     := compress (punktname).{}  notiere die anfangsposition:{}    neuer menupunkt.anfangsposition  := gesamtlaenge ohne letzten punkt + 1.{}  notiere start und leaveprozedur:{}    neuer menupunkt.startprozedurname := compress (startprocname);{}    neuer menupunkt.leaveprozedurname := compress (leaveprocname).{}  neuer menupunkt:{}    aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].{}  erhoehe die anzahl der oberbegriffe:{}
+    aktuelles menu.anzahl hauptmenupunkte INCR 1.{}END PROC oberbegriff;{}PROC oberbegriff (TEXT CONST punktname):{}  oberbegriff (punktname, "", ""){}END PROC oberbegriff;{}PROC menufunktionseintrag (TEXT CONST kuerzel,{}                                      punktbezeichnung,{}                                      prozedurname,{}                                      infotext,{}                           BOOL CONST ist aktiv):{}  gib hinweis auf menufunktionseintrag;{}  trage menupunkt ein;{}  organisiere menu neu.{}
+  gib hinweis auf menufunktionseintrag:{}    line;{}    out (aussage [14]);{}    out ("'" + kuerzelzeichen  + "' - " + punktname).{}  kuerzelzeichen:{}    IF kuerzel = "" THEN " " ELSE kuerzel FI.{}  punktname:{}    IF punktbezeichnung = trennzeilensymbol{}       THEN "----------"{}       ELSE punktbezeichnung{}    FI.{}  trage menupunkt ein:{}    ueberpruefe das kuerzel;{}    ueberpruefe die punktbreite;{}    ueberpruefe die eintragsnummer;{}    aktuelles menu.einzelmenu [stelle].belegt INCR 1;{}
+    aktueller menupunkt.punktkuerzel  := compress (kuerzel);{}    aktueller menupunkt.punktname     := normierter menupunkt;{}    aktueller menupunkt.procname      := compress (prozedurname);{}    aktueller menupunkt.boxtext       := infotext;{}    aktueller menupunkt.aktiv         := ist aktiv;{}    aktueller menupunkt.angewaehlt    := FALSE.{}  aktueller menupunkt:{}    aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].{}  aktuelles untermenu:{}    aktuelles menu.einzelmenu [stelle].{}
+  stelle:{}    aktuelles menu.anzahl hauptmenupunkte.{}  normierter menupunkt:{}    blank + compress (punktbezeichnung).{}  ueberpruefe das kuerzel:{}    TEXT VAR kurz :: compress (kuerzel);{}    IF   kuerzel ist zu lang{}         THEN bereinige eintragungen (16){}    ELIF kuerzel ist schon vorhanden{}         THEN bereinige eintragungen (17){}    FI.{}  kuerzel ist zu lang:{}    length (kurz) > 1.{}  kuerzel ist schon vorhanden:{}    (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).{}
+  vorhandene kuerzel:{}    TEXT VAR liste :: "";{}    INT VAR zeiger;{}    FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP{}      liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel{}    PER;{}    liste.{}  ueberpruefe die punktbreite:{}    IF length (compress (punktbezeichnung)) > maxmenubreite - 10{}       THEN bereinige eintragungen (18){}    FI.{}  ueberpruefe die eintragsnummer:{}    IF aktuelles untermenu.belegt = maxuntermenupunkte{}       THEN bereinige eintragungen (19){}
+    FI.{}  organisiere menu neu:{}    IF neue punktlaenge > aktuelles untermenu.maxlaenge{}       THEN aktuelles untermenu.maxlaenge := neue punktlaenge{}    FI.{}  neue punktlaenge:{}    length (aktueller menupunkt.punktname).{}END PROC menufunktionseintrag;{}PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,{}                              prozedurname, infotext):{}  menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,{}                        TRUE){}END PROC menufunktion;{}
+PROC trennlinie:{}  menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE){}END PROC trennlinie;{}PROC schliesse menu:{}  menuleiste. belegt INCR 1;{}  menuleiste.menu [menuleiste.belegt] := aktuelles menu;{}  menu ist geoeffnet                  := FALSE{}END PROC schliesse menu;{}PROC schliesse menukarte:{}  forget (ds);{}  page; out (piep); put (card finished){}END PROC schliesse menukarte;{}PROC testinstallation (TEXT CONST kartenname):{}  ueberpruefe menukarte;{}  nimm installation vor.{}
+  ueberpruefe menukarte:{}    IF   NOT exists (kartenname){}         THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21]){}    ELIF    (pos (kartenname, menutafelpraefix) <> 1){}         OR (type (old (kartenname)) <> menutafeltype){}         THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22]){}    FI.{}  nimm installation vor:{}    TEXT CONST neuer kartenname{}                    :: kartenname + "  von Task '" + name (myself) + "'";{}    command dialogue (FALSE);{}
+    rename (kartenname, neuer kartenname);{}    save (neuer kartenname,task (mmtaskname));{}    forget (neuer kartenname, quiet);{}    reset dialog;{}    install menu (neuer kartenname, FALSE);{}    fetch (neuer kartenname, task (mmtaskname));{}    rename (neuer kartenname, kartenname);{}    command dialogue (TRUE);{}    page; out (piep); put (install finished){}END PROC testinstallation;{}END PACKET ls menu generator 2;{}
+
diff --git a/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen b/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen
new file mode 100644
index 0000000..9a4c3fc
--- /dev/null
+++ b/app/gs.menugenerator/1.0/src/ls-Menu-Generator-gen
@@ -0,0 +1,30 @@
+(* 
+        
+          ********************************************************* 
+          ********************************************************* 
+          **                                                     ** 
+          **                  ls-Menu-Generator                  ** 
+          **                  GENERATORPROGRAMM                  ** 
+          **                     Version 1.0                     ** 
+          **                                                     ** 
+          **                  (Stand: 30.03.88)                  ** 
+          **                                                     ** 
+          **                                                     ** 
+          **         Autor: Wolfgang Weber, Bielefeld            ** 
+          **                                                     ** 
+          **                                                     ** 
+          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
+          **                                                     ** 
+          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
+          **                                                     ** 
+          ********************************************************* 
+          ********************************************************* 
+ 
+                                                                           *) 
+ 
+LET mm taskname =  "ls-MENUKARTEN",{}    datei 1     =  "Generatordatei: Archivmenu",{}    datei 2     =  "ls-MENUBASISTEXTE",{}    datei 3     =  "ls-Menu-Generator 1",{}    datei 4     =  "ls-Menu-Generator 2";{}PROC stelle existenz des mm sicher:{}  cursor (1, 5); out (""4"");{}  IF NOT exists (task (mm taskname)){}     THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");{}  FI{}END PROC stelle existenz des mm sicher;{}PROC vom archiv (TEXT CONST datei):{}  cursor (1,5); out (""4"");{}
+  out ("  """); out (datei); putline (""" wird geholt.");{}  fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{}  IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{}  hole (datei);{}  cursor (1, 5); out (""4"");{}  out ("  """); out (datei); out (""" wird übersetzt: ");{}  insert (datei);{}  forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{}  cursor (1, 5); out (""4"");{}  out ("  """); out(datei);{}  out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
+  command dialogue (FALSE);{}  save (datei, task (mm taskname));{}  command dialogue (TRUE);{}  forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget ("ls-Menu-Generator/gen", quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{}  page;{}  putline ("                  "15"ls-Menu-Generator - Automatische Generierung "14"").{}
+hole die dateien:{}  IF     NOT exists (datei 1) COR NOT exists (datei 2){}     COR NOT exists (datei 3) COR NOT exists (datei 4){}     THEN hole dateien vom archiv{}  FI.{}hole dateien vom archiv:{}  cursor (1,3);{}  say ("Ist das Archiv angemeldet und die "); line;{}  IF yes ("'ls-Menu-Generator'-Diskette eingelegt"){}     THEN lese ein{}     ELSE line (2);{}          errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){}  FI.{}lese ein:{}  cursor (1, 3); out (""4"");{}  out ("                      "15"Bitte die Diskette eingelegt lassen! "14"");{}
+  IF NOT einzeln{}     THEN hole (datei 1);{}          hole (datei 2);{}          hole (datei 3);{}          hole (datei 4);{}          cursor (1, 3); out(""4"");{}          out ("                     "15"Die Diskette wird nicht mehr benötigt! "14"");{}          release (archive){}  FI.{}insertiere die dateien:{}  check off;{}  schicke (datei 2);{}  in (datei 3);{}  in (datei 4);{}  IF einzeln THEN release (archive) FI;{}  check on.{}mache global manager aus der task:{}  global manager.{}
+
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis
index 9507802..9507802 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Inhaltsverzeichnis
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 1 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1
index e418764..e418764 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 1
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 1
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 2 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2
index b063ea3..b063ea3 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 2
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 2
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 3 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3
index f589a93..f589a93 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 3
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 3
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 4 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4
index 6236d91..6236d91 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 4
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 4
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 5 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5
index d08e4a7..d08e4a7 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 5
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 5
diff --git a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 6 b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6
index 7d485d7..7d485d7 100644
--- a/doc/mp-bap/A5 - Doku: gs-MP BAP - Kapitel 6
+++ b/app/gs.mp-bap/1.1/doc/A5 - Doku: gs-MP BAP - Kapitel 6
diff --git a/doc/mp-bap/gs-MP BAP handbuch.impressum b/app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum
index 91c6ce0..91c6ce0 100644
--- a/doc/mp-bap/gs-MP BAP handbuch.impressum
+++ b/app/gs.mp-bap/1.1/doc/gs-MP BAP handbuch.impressum
diff --git a/app/gs.mp-bap/1.1/source-disk b/app/gs.mp-bap/1.1/source-disk
new file mode 100644
index 0000000..1732e99
--- /dev/null
+++ b/app/gs.mp-bap/1.1/source-disk
@@ -0,0 +1 @@
+informatikpaket/07_gs.mp-bap.img
diff --git a/mp-bap/ls-MENUKARTE:MP-BAP b/app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP
index 564b07c..564b07c 100644
--- a/mp-bap/ls-MENUKARTE:MP-BAP
+++ b/app/gs.mp-bap/1.1/src/ls-MENUKARTE:MP-BAP
diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP 1 b/app/gs.mp-bap/1.1/src/ls-MP BAP 1
new file mode 100644
index 0000000..be7e3d2
--- /dev/null
+++ b/app/gs.mp-bap/1.1/src/ls-MP BAP 1
@@ -0,0 +1,119 @@
+PACKET ls mp bap 1  DEFINES                (*******************************) 
+                                           (*                             *) 
+       stdvoreinstellung der parameter,    (*         ls-MP BAP 1         *) 
+       werkstueckdefinition,               (*         Version 1.1         *) 
+       tastendefinition,                   (*                             *) 
+       phasendefinition,                   (*   (c) 1987, 1988            *) 
+       bewertungsschluessel,               (*       by Eva Latta-Weber    *) 
+       werkstueckaufhaenger,               (*          Bielefeld          *) 
+       tastenbezeichnung,                  (*                             *) 
+       piepse,                             (*******************************) 
+                                            
+       mp bap einstellung anzeigen,         
+       mp bap standardwerte,                
+       mp bap breite des werkstuecks, 
+       mp bap hoehe  des werkstuecks, 
+       mp bap invers normal, 
+       mp bap zeichensatz, 
+       mp bap fehlerzeichen, 
+       mp bap tastenbelegung, 
+       mp bap anzahl arbeitsphasen, 
+       mp bap dauer einer arbeitsphase, 
+       mp bap pausendauer, 
+       mp bap wertungsschluessel: 
+ 
+LET maxspalten         =            70,{}    maxzeilen          =            14,{}    kleinster wert     =             1,{}    oben unten return  = ""3""10""13"",{}    punkt              =           "+",{}    punkt und zurueck  =        "+"8"",{}    piep               =         ""7"",{}    blank              =           " ";{}INT  VAR aktuelle werkstueckbreite,{}         aktuelle werkstueckhoehe,{}         kleinster aktueller zeichencode,{}         groesster aktueller zeichencode,{}         aktuelle anzahl der arbeitsphasen,{}
+         aktuelle arbeitsphasendauer in minuten,{}         aktuelle pausendauer in minuten;{}TEXT VAR aktuelles fehlerzeichen,{}         nach rechts,{}         nach links,{}         nach oben,{}         nach unten,{}         ausbesserung,{}         naechstes;{}BOOL VAR inversdarstellung;{}ROW 11 REAL VAR bewertung;{}WINDOW VAR w1, w2, w3, w4;{}PROC stdvoreinstellung der parameter:{}  aktuelle werkstueckbreite               :=     15;{}  aktuelle werkstueckhoehe                :=     12;{}  kleinster aktueller zeichencode         :=     65;{}
+  groesster aktueller zeichencode         :=     90;{}  aktuelle anzahl der arbeitsphasen       :=      3;{}  aktuelle arbeitsphasendauer in minuten  :=     10;{}  aktuelle pausendauer in minuten         :=      2;{}  aktuelles fehlerzeichen                 :=    "F";{}  nach rechts                             :=  ""2"";{}  nach links                              :=  ""8"";{}  nach oben                               :=  ""3"";{}  nach unten                              := ""10"";{}  ausbesserung                            :=  ""1"";{}
+  naechstes                               := ""27"";{}  inversdarstellung                       :=  FALSE;{}  bewertung := ROW 11 REAL : (0.0, 0.1, 0.2, 0.3, 0.4, 0.5,{}                                   0.6, 0.7, 0.8, 0.9, 1.0){}END PROC stdvoreinstellung der parameter;{}PROC werkstueckdefinition (INT VAR breite, hoehe, kleinster, groesster,{}                           TEXT VAR fzeichen, BOOL VAR invers):{}  breite        := aktuelle werkstueckbreite;{}  hoehe         := aktuelle werkstueckhoehe;{}
+  kleinster     := kleinster aktueller zeichencode;{}  groesster     := groesster aktueller zeichencode;{}  fzeichen      := aktuelles fehlerzeichen;{}  invers        := inversdarstellung{}END PROC werkstueckdefinition;{}PROC tastendefinition (TEXT VAR rechts, links, hoch, runter, aus, nach):{}  rechts        := nach rechts;{}  links         := nach links;{}  hoch          := nach oben;{}  runter        := nach unten;{}  aus           := ausbesserung;{}  nach          := naechstes{}END PROC tastendefinition;{}
+PROC phasendefinition (INT VAR aphasenzahl, aphasendauer, pausendauer):{}  aphasenzahl   := aktuelle anzahl der arbeitsphasen;{}  aphasendauer  := aktuelle arbeitsphasendauer in minuten;{}  pausendauer   := aktuelle pausendauer in minuten{}END PROC phasendefinition;{}PROC bewertungsschluessel (ROW 11 REAL VAR schluessel):{}  INT VAR zeiger;{}  FOR zeiger FROM 1 UPTO 11 REP{}    schluessel [zeiger] := bewertung [zeiger]{}  PER{}END PROC bewertungsschluessel;{}PROC mp bap einstellung anzeigen:{}  aktuellen parameterzustand anzeigen;{}
+  regenerate menuscreen{}END PROC mp bap einstellung anzeigen;{}PROC mp bap standardwerte:{}  standardwerte einstellen;{}  regenerate menuscreen{}END PROC mp bap standardwerte;{}PROC mp bap breite des werkstuecks:{}  breite des werkstuecks einstellen;{}  regenerate menuscreen{}END PROC mp bap breite des werkstuecks;{}PROC mp bap hoehe des werkstuecks:{}  hoehe des werkstuecks einstellen;{}  regenerate menuscreen{}END PROC mp bap hoehe des werkstuecks;{}PROC mp bap invers normal:{}  werkstueckdarstellung einstellen;{}
+  regenerate menuscreen{}END PROC mp bap invers normal;{}PROC mp bap zeichensatz:{}  zeichensatz einstellen;{}  regenerate menuscreen{}END PROC mp bap zeichensatz;{}PROC mp bap fehlerzeichen:{}  fehlerzeichen veraendern;{}  regenerate menuscreen{}END PROC mp bap fehlerzeichen;{}PROC mp bap tastenbelegung:{}  tastaturbelegung einstellen;{}  regenerate menuscreen{}END PROC mp bap tastenbelegung;{}PROC mp bap anzahl arbeitsphasen:{}  anzahl der arbeitsphasen festlegen;{}  regenerate menuscreen{}END PROC mp bap anzahl arbeitsphasen;{}
+PROC mp bap dauer einer arbeitsphase:{}  dauer einer arbeitsphase festlegen;{}  regenerate menuscreen{}END PROC mp bap dauer einer arbeitsphase;{}PROC mp bap pausendauer:{}  pausendauer festlegen;{}  regenerate menuscreen{}END PROC mp bap pausendauer;{}PROC mp bap wertungsschluessel:{}  wertungsschluessel veraendern;{}  regenerate menuscreen{}END PROC mp bap wertungsschluessel;{}PROC aktuellen parameterzustand anzeigen:{}  zeige die fenster;{}  fuelle die fenster mit inhalt;{}  gib hinweis aus.{}
+  zeige die fenster:{}    w1 := window ( 2,  2, 37, 20);{}    w2 := window (41,  2, 38, 20);{}    w3 := window ( 1,  1, 79, 24);{}    page; show (w1); show (w2).{}  fuelle die fenster mit inhalt:{}    zeige inhalt fenster 1;{}    zeige inhalt fenster 2.{}  zeige inhalt fenster 1:{}    zeige eingestellte parameter an (w1).{}  zeige inhalt fenster 2:{}    gib bewertungsschluessel aus (w2).{}  gib hinweis aus:{}    out footnote (w3, anwendungstext (2)); pause.{}END PROC aktuellen parameterzustand anzeigen;{}
+PROC zeige eingestellte parameter an (WINDOW VAR w):{}  zeige ueberschrift;{}  zeige werkstueckdefinition;{}  zeige tastenbelegung;{}  zeige simulationszeiten.{}  zeige ueberschrift:{}    cursor (w, 1,  1); out (w, center (w, invers (anwendungstext ( 1)))).{}  zeige werkstueckdefinition:{}    cursor (w, 2,  3); out (w, anwendungstext ( 6));{}                       out (w, text (aktuelle werkstueckbreite, 3));{}                       out (w, anwendungstext (28));{}    cursor (w, 2,  4); out (w, anwendungstext ( 7));{}
+                       out (w, text (aktuelle werkstueckhoehe,  3));{}                       out (w, anwendungstext (28));{}    cursor (w, 2,  5); out (w, anwendungstext ( 8));{}                        IF inversdarstellung{}                           THEN out (w, anwendungstext (29)){}                           ELSE out (w, anwendungstext (30)){}                        FI;{}    cursor (w, 2,  6); out (w, anwendungstext ( 9));{}                       out (w, zeichensatz);{}    cursor (w, 2,  7); out (w, anwendungstext (10));{}
+                       out (blank + aktuelles fehlerzeichen).{}  zeige tastenbelegung:{}    cursor (w, 2,  9); out (w, anwendungstext (11));{}                       out (w, tastenbezeichnung (nach rechts));{}    cursor (w, 2, 10); out (w, anwendungstext (12));{}                       out (w, tastenbezeichnung (nach links));{}    cursor (w, 2, 11); out (w, anwendungstext (13));{}                       out (w, tastenbezeichnung (nach oben));{}    cursor (w, 2, 12); out (w, anwendungstext (14));{}                       out (w, tastenbezeichnung (nach unten));{}
+    cursor (w, 2, 13); out (w, anwendungstext (15));{}                       out (w, tastenbezeichnung (ausbesserung));{}    cursor (w, 2, 14); out (w, anwendungstext (16));{}                       out (w, tastenbezeichnung (naechstes)).{}  zeige simulationszeiten:{}    cursor (w, 2, 16); out (w, anwendungstext (17));{}                       out (w, text (aktuelle anzahl der arbeitsphasen, 4));{}    cursor (w, 2, 17); out (w, anwendungstext (18));{}                       out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{}
+                       out (w, anwendungstext (51));{}    cursor (w, 2, 18); out (w, anwendungstext (19));{}                       out (w, text (aktuelle pausendauer in minuten, 4));{}                       out (w, anwendungstext (51));{}    cursor (w, 2, 20); out (w, anwendungstext ( 5));{}                       out (w, gesamtdauerangabe).{}  zeichensatz:{}    blank + code (kleinster aktueller zeichencode) + "..." +{}            code (groesster aktueller zeichencode) + " ("  +{}            text (groesster aktueller zeichencode{}
+                   - kleinster aktueller zeichencode + 1, 2) +{}            anwendungstext (28) + ")".{}  gesamtdauerangabe:{}    text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{}  arbeitsdauer:{}      aktuelle anzahl der arbeitsphasen{}    * aktuelle arbeitsphasendauer in minuten.{}  pausendauer:{}      (aktuelle anzahl der arbeitsphasen - 1){}    * aktuelle pausendauer in minuten.{}END PROC zeige eingestellte parameter an;{}PROC gib bewertungsschluessel aus (WINDOW VAR w):{}  zeichne koordinatenkreuz;{}
+  trage messwerte ein.{}  zeichne koordinatenkreuz:{}    cursor (w, 1,  1); out (w, center (w, invers (anwendungstext ( 4))));{}    cursor (w, 2,  3); out (w, anwendungstext (20));{}    cursor (w, 2,  4); out (w, anwendungstext (21));{}    cursor (w, 2,  6); out (w, anwendungstext (23));{}    cursor (w, 2,  7); out (w, anwendungstext (22));{}    cursor (w, 2,  8); out (w, anwendungstext (22));{}    cursor (w, 2,  9); out (w, anwendungstext (22));{}    cursor (w, 2, 10); out (w, anwendungstext (22));{}
+    cursor (w, 2, 11); out (w, anwendungstext (24));{}    cursor (w, 2, 12); out (w, anwendungstext (22));{}    cursor (w, 2, 13); out (w, anwendungstext (22));{}    cursor (w, 2, 14); out (w, anwendungstext (22));{}    cursor (w, 2, 15); out (w, anwendungstext (22));{}    cursor (w, 2, 16); out (w, anwendungstext (25));{}    cursor (w, 2, 17); out (w, anwendungstext (26));{}    cursor (w, 2, 19); out (w, anwendungstext (27)).{}  trage messwerte ein:{}    INT CONST abszisse :: 16, ordinate :: 2;{}
+    INT VAR nr;{}    FOR nr FROM 1 UPTO 11 REP{}      zeichne einen punkt{}    PER.{}  zeichne einen punkt:{}    cursor (w, ordinate + 3 * nr, abszisse - nachkommastelle); out (punkt).{}  nachkommastelle:{}    int(bewertung [nr] * 10.0).{}END PROC gib bewertungsschluessel aus;{}PROC standardwerte einstellen:{}  zeige fenster;{}  zeige eingestellte parameter an (w1);{}  gib information aus;{}  hole bestaetigung ein.{}  zeige fenster:{}    w1 := window ( 2,  2, 37, 20);{}    w2 := window (41, 10, 37, 12);{}
+    w3 := window (41,  2, 37,  6);{}    page; show (w1); show (w2); show (w3).{}  gib information aus:{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3); out (w2, anwendungstext (67));{}    cursor (w2, 2, 4); out (w2, anwendungstext (68));{}    cursor (w2, 2, 7); out (w2, anwendungstext (69));{}    cursor (w2, 2, 9); out (w2, anwendungstext (70));{}    cursor (w2, 2,10); out (w2, anwendungstext (71));{}    cursor (w2, 2,11); out (w2, anwendungstext (72));{}
+    cursor (w2, 2,12); out (w2, anwendungstext (73)).{}  hole bestaetigung ein:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (66))));{}    cursor (w3, 2, 3);{}    IF yes (w3, anwendungstext (66)){}       THEN stdvoreinstellung der parameter;{}            gib positive rueckmeldung{}    FI.{}  gib positive rueckmeldung:{}    page (w1);{}    zeige eingestellte parameter an (w1);{}    cleop  (w3, 2, 3); out (anwendungstext (221));{}    cursor (w3, 2, 5); out (anwendungstext (  3));{}
+    pause.{}END PROC standardwerte einstellen;{}PROC breite des werkstuecks einstellen:{}  zeige die fenster;{}  hinweise an den benutzer ausgeben;{}  werkstueck zeigen (w3);{}  erfrage veraenderung;{}  REP{}    neuen wert vom bildschirm holen{}  UNTIL benutzer ist einverstanden PER.{}  zeige die fenster:{}    w1 := window ( 2, 2, 26, 6);{}    w2 := window (30, 2, 48, 6);{}    w3 := window (2, 9, 77, 16);{}    page; show (w1); show (w2).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}
+    cursor (w1, 2, 3); out (w1, anwendungstext (53));{}                       out (w1, text (kleinster wert, 3));{}    cursor (w1, 2, 4); out (w1, anwendungstext (54));{}                       out (w1, text (maxspalten,     3));{}    cursor (w1, 2, 6); out (w1, anwendungstext (55));{}                       out (w1, text (aktuelle werkstueckbreite, 3)).{}  erfrage veraenderung:{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (57))));{}    cursor (w2, 2, 3);{}    IF no (anwendungstext (216)){}
+       THEN LEAVE breite des werkstuecks einstellen{}    FI.{}  neuen wert vom bildschirm holen:{}    cleop  (w2, 2, 3); out (w2, anwendungstext (58));{}    cursor (w2, 2, 4); out (w2, anwendungstext (59));{}    cursor (w2, 2, 6); out (w2, anwendungstext (60));{}    aktuelle werkstueckbreite := ermittelter wert (1, maxspalten,{}                                                aktuelle werkstueckbreite).{}  benutzer ist einverstanden :{}    gib aktuelle infos aus;{}    hole bestaetigung.{}  gib aktuelle infos aus:{}
+    hinweise an den benutzer ausgeben;{}    werkstueck zeigen (w3);{}    cleop (w2, 1, 3).{}  hole bestaetigung:{}    cursor (w2, 2, 3);{}    IF yes (w2, anwendungstext (62)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC breite des werkstuecks einstellen;{}PROC hoehe des werkstuecks einstellen:{}  fenster zeigen;{}  hinweise an den benutzer ausgeben;{}  werkstueck zeigen (w3);{}  erfrage veraenderung;{}  REP{}    neuen wert vom bildschirm holen{}  UNTIL benutzer ist einverstanden PER.{}
+  fenster zeigen:{}    w1 := window ( 2, 2, 26, 6);{}    w2 := window (30, 2, 48, 6);{}    w3 := window (2, 9, 77, 16);{}    page; show (w1); show (w2).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}    cursor (w1, 2, 3); out (w1, anwendungstext (53));{}                       out (w1, text (kleinster wert, 3));{}    cursor (w1, 2, 4); out (w1, anwendungstext (54));{}                       out (w1, text (maxzeilen,      3));{}    cursor (w1, 2, 6); out (w1, anwendungstext (55));{}
+                       out (w1, text (aktuelle werkstueckhoehe, 3)).{}  erfrage veraenderung:{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (63))));{}    cursor (w2, 2, 3);{}    IF no (anwendungstext (217)){}       THEN LEAVE hoehe des werkstuecks einstellen{}    FI.{}  neuen wert vom bildschirm holen:{}    cleop  (w2, 2, 3); out (w2, anwendungstext (58));{}    cursor (w2, 2, 4); out (w2, anwendungstext (59));{}    cursor (w2, 2, 6); out (w2, anwendungstext (64));{}    aktuelle werkstueckhoehe := ermittelter wert (1, maxzeilen,{}
+                                                  aktuelle werkstueckhoehe).{}  benutzer ist einverstanden :{}    gib aktuelle infos aus;{}    hole bestaetigung.{}  gib aktuelle infos aus:{}    hinweise an den benutzer ausgeben;{}    werkstueck zeigen (w3);{}    cleop (w2, 1, 3).{}  hole bestaetigung:{}    cursor (w2, 2, 3);{}    IF yes (w2, anwendungstext (65)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC hoehe des werkstuecks einstellen;{}PROC werkstueckdarstellung einstellen:{}  fenster zeigen;{}
+  hinweise an den benutzer ausgeben;{}  werkstueck zeigen (w3);{}  REP{}    bestaetigung einholen;{}    hinweise an den benutzer ausgeben;{}    werkstueck zeigen (w3){}  UNTIL benutzer ist einverstanden PER.{}  fenster zeigen:{}    w1 := window ( 2,  2, 28,  6);{}    w2 := window (32,  2, 46,  6);{}    w3 := window ( 2,  9, 77, 16);{}    page; show (w1); show (w2).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}    cursor (w1, 2, 3); out (w1, anwendungstext (74));{}
+                       out (w1, anwendungstext (76));{}    cursor (w1, 2, 4); out (w1, anwendungstext (74));{}                       out (w1, anwendungstext (77));{}    cursor (w1, 2, 6); out (w1, anwendungstext (75));{}                       IF inversdarstellung{}                          THEN out (w1, anwendungstext (77)){}                          ELSE out (w1, anwendungstext (76)){}                       FI.{}  bestaetigung einholen:{}    page (w2);{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (89))));{}
+    cursor (w2, 2, 3);{}    IF yes (w2, anwendungstext (78)){}       THEN veraendere darstellungsart{}       ELSE LEAVE werkstueckdarstellung einstellen{}    FI.{}  veraendere darstellungsart:{}    IF inversdarstellung{}       THEN inversdarstellung := FALSE{}       ELSE inversdarstellung := TRUE{}    FI.{}  benutzer ist einverstanden:{}    cleop (w2, 1, 3);{}    cursor (w2, 2, 3);{}    IF yes (w2, anwendungstext (99)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC werkstueckdarstellung einstellen;{}
+PROC zeichensatz einstellen:{}  zeige fenster;{}  gib eingestellten zeichensatz an;{}  gib bedienhinweise aus;{}  erfrage neueinstellung;{}  REP{}    erfrage das neue fehlerzeichen;{}    ermittle das kleinste zeichen;{}    ermittle das groesste zeichen;{}    page (w1);{}    gib eingestellten zeichensatz an{}  UNTIL benutzer ist einverstanden PER.{}  zeige fenster:{}    w1 := window ( 2,  2, 28, 22);{}    w2 := window (32, 10, 46, 14);{}    w3 := window (32,  2, 46,  6);{}    page; show (w1); show (w2); show (w3).{}
+  gib eingestellten zeichensatz an:{}    cursor (w1, 1, 1);{}    out (w1, center (w1, invers (anwendungstext (79))));{}    gib zeichenkette aus (w1, kleinster aktueller zeichencode,{}                              groesster aktueller zeichencode,{}                              code (aktuelles fehlerzeichen)).{}  gib bedienhinweise aus:{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3); out (w2, anwendungstext (80));{}    cursor (w2, 2, 4); out (w2, anwendungstext (81));{}
+    cursor (w2, 2, 5); out (w2, anwendungstext (82));{}    cursor (w2, 2, 6); out (w2, anwendungstext (83));{}    cursor (w2, 2, 8); out (w2, anwendungstext (84));{}    cursor (w2, 2, 9); out (w2, anwendungstext (85));{}    cursor (w2, 2,10); out (w2, anwendungstext (86));{}    cursor (w2, 2,12); out (w2, anwendungstext (87));{}    cursor (w2, 2,13); out (w2, anwendungstext (88)).{}  erfrage neueinstellung:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (90))));{}    cursor (w3, 2, 3);{}
+    IF no (w3, anwendungstext (91)){}       THEN LEAVE zeichensatz einstellen{}    FI.{}  erfrage das neue fehlerzeichen:{}    gib vollstaendigen zeichensatz aus;{}    gib fehlerzeicheninformationen aus;{}    REP{}      lasse fehlerzeichen eingeben{}    UNTIL fehlerzeichen ist ok PER.{}  gib vollstaendigen zeichensatz aus:{}    page (w1); page (w2); page (w3);{}    cursor (w1, 1, 1);{}    out (w1, center (w1, invers (anwendungstext (92))));{}    gib zeichenkette aus (w1, 33, 126, 0).{}  gib fehlerzeicheninformationen aus:{}
+    cursor (w2, 1, 1);{}    out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3);  out (w2, anwendungstext (95));{}    cursor (w2, 2, 4);  out (w2, anwendungstext (96));{}    cursor (w2, 2, 6);  out (w2, anwendungstext (97)).{}  lasse fehlerzeichen eingeben:{}    cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (100))));{}    cursor (w3, 2, 3);{}    out (w3, anwendungstext (101));{}    cursor on; inchar (aktuelles fehlerzeichen); cursor off;{}    IF fehlerzeichen ist ok{}
+       THEN out (w3, aktuelles fehlerzeichen);{}            markiere das fehlerzeichen im ersten fenster;{}       ELSE lege beschwerde ein{}    FI.{}  fehlerzeichen ist ok:{}        code (aktuelles fehlerzeichen) >=  33{}    AND code (aktuelles fehlerzeichen) <= 126.{}  markiere das fehlerzeichen im ersten fenster:{}    positioniere cursor in zeichenkette (w1, 33, code (aktuelles fehlerzeichen));{}    out (w1, invers (aktuelles fehlerzeichen)).{}  lege beschwerde ein:{}    piepse;{}    cursor (w2, 2, 8); out (w2, anwendungstext (102));{}
+    cursor (w2, 2,10); out (w2, anwendungstext (103));{}    cursor (w2, 2,11); out (w2, anwendungstext (104));{}    cursor (w2, 2,12); out (w2, anwendungstext (105));{}    cursor (w2, 2,13); out (w2, anwendungstext (106));{}    cursor (w2, 2,14); out (w2, anwendungstext (107)).{}  ermittle das kleinste zeichen:{}    page (w2); page (w3);{}    gib kleinste zeichencode informationen aus;{}    lasse den vorbereich festlegen.{}  ermittle das groesste zeichen:{}    lasse den nachbereich festlegen.{}  gib kleinste zeichencode informationen aus:{}
+    cursor (w2, 1, 1);{}    out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3); out (w2, anwendungstext (111));{}    cursor (w2, 2, 4); out (w2, anwendungstext (112));{}    cursor (w2, 2, 5); out (w2, anwendungstext (113));{}    cursor (w2, 2, 6); out (w2, anwendungstext (114));{}    cursor (w2, 2, 8); out (w2, anwendungstext (115));{}    cursor (w2, 2, 9); out (w2, anwendungstext (116));{}    cursor (w2, 2,10); out (w2, anwendungstext (117));{}    cursor (w2, 2,11); out (w2, anwendungstext (118));{}
+    cursor (w2, 2,13); out (w2, anwendungstext (119));{}    cursor (w2, 2,14); out (w2, anwendungstext (120)).{}  lasse den vorbereich festlegen:{}    INT VAR s, z; page (w3); cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (121))));{}    cursor (w3, 2, 3); out (w3, anwendungstext (122));{}    cursor (w3, 2, 4); out (w3, anwendungstext (123));{}    cursor (w3, 2, 5); out (w3, anwendungstext (125));{}    get cursor (s, z); cursor on;{}    kleinster aktueller zeichencode := code (aktuelles fehlerzeichen);{}
+    groesster aktueller zeichencode := code (aktuelles fehlerzeichen);{}    kleinster aktueller zeichencode := eingabe mit intervallanzeige ( w1, 33,{}                                       code (aktuelles fehlerzeichen),{}                                       kleinster aktueller zeichencode, s, z);{}    cursor off.{}  lasse den nachbereich festlegen:{}    cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (121))));{}    cursor (w3, 2, 3); out (w3, anwendungstext (122));{}    cursor (w3, 2, 4); out (w3, anwendungstext (124));{}
+    cursor (w3, 2, 5); out (w3, anwendungstext (125));{}    get cursor (s, z); cursor on;{}    groesster aktueller zeichencode := eingabe mit intervallanzeige ( w1,{}                                       code (aktuelles fehlerzeichen), 126,{}                                       groesster aktueller zeichencode, s, z);{}    cursor off.{}  benutzer ist einverstanden:{}    page (w3); cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (90))));{}    cursor (w3, 2, 3);{}    IF yes (w3, anwendungstext (126)){}
+       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC zeichensatz einstellen;{}PROC fehlerzeichen veraendern:{}  fenster zeigen;{}  gib eingestellten zeichensatz an;{}  gib bedienhinweise aus;{}  erfrage neueinstellung;{}  REP{}    lasse fehlerzeichen einstellen{}  UNTIL benutzer ist einverstanden PER.{}  fenster zeigen:{}    w1 := window ( 2,  2, 28, 22);{}    w2 := window (32, 10, 46, 14);{}    w3 := window (32,  2, 46,  6);{}    page; show (w1); show (w2); show (w3).{}  gib eingestellten zeichensatz an:{}
+    cursor (w1, 1, 1);{}    out (w1, center (w1, invers (anwendungstext (79))));{}    gib zeichenkette aus (w1, kleinster aktueller zeichencode,{}                              groesster aktueller zeichencode,{}                              code (aktuelles fehlerzeichen)).{}  gib bedienhinweise aus:{}    cursor (w2, 1, 1);{}    out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3); out (w2, anwendungstext (131));{}    cursor (w2, 2, 4); out (w2, anwendungstext (132));{}    cursor (w2, 2, 5); out (w2, anwendungstext (133));{}
+    cursor (w2, 2, 7); out (w2, anwendungstext (134));{}    cursor (w2, 2, 8); out (w2, anwendungstext (135));{}    cursor (w2, 2, 9); out (w2, anwendungstext (136)).{}  erfrage neueinstellung:{}    cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (130))));{}    cursor (w3, 2, 3);{}    IF no (w3, anwendungstext (137)){}       THEN LEAVE fehlerzeichen veraendern{}    FI.{}  lasse fehlerzeichen einstellen:{}    INT VAR s, z, fehlercode :: code (aktuelles fehlerzeichen);{}    page (w3); cursor (w3, 1, 1);{}
+    out (w3, center (w3, invers (anwendungstext (138))));{}    cursor (w3, 2, 3); out (w3, anwendungstext (139));{}    cursor (w3, 2, 4); out (w3, anwendungstext (140));{}    cursor (w3, 2, 5); out (w3, anwendungstext (141));{}    get cursor (s, z); cursor on;{}    fehlercode := eingabe mit elementanzeige (w1,{}                                              kleinster aktueller zeichencode,{}                                              groesster aktueller zeichencode,{}                                              fehlercode, s, z);{}
+    cursor off;{}    aktuelles fehlerzeichen := code (fehlercode).{}  benutzer ist einverstanden:{}    page (w3); cursor (w3, 1, 1);{}    out (w3, center (w3, invers (anwendungstext (130))));{}    cursor (w3, 2, 3);{}    IF yes (w3, anwendungstext (142)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC fehlerzeichen veraendern;{}PROC tastaturbelegung einstellen:{}  ROW 6 TEXT VAR tastenname, taste;{}  fenster zeigen;{}  REP{}    tastaturneubelegung vornehmen{}  UNTIL benutzer ist einverstanden PER.{}
+  fenster zeigen:{}    w1 := window ( 2,  2, 28, 10);{}    w2 := window ( 2, 14, 28, 10);{}    w3 := window (32, 10, 46, 14);{}    w4 := window (32,  2, 46,  6);{}    page; show (w1); show (w2); show (w3); show (w4).{}  tastaturneubelegung vornehmen:{}    alte tastenbelegung einlesen;{}    tastenbelegung anzeigen;{}    bedienhinweise ausgeben;{}    veraenderung erfragen;{}    neue tastenbelegung erfragen;{}    hinweis zur bewertung und stand ausgeben.{}  alte tastenbelegung einlesen:{}    INT VAR z1;{}
+    FOR z1 FROM 1 UPTO 6 REP{}      tastenname [z1] := anwendungstext (z1 + 10){}    PER;{}    taste [1] := nach rechts;{}    taste [2] := nach links;{}    taste [3] := nach oben;{}    taste [4] := nach unten;{}    taste [5] := ausbesserung;{}    taste [6] := naechstes;{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (151)))).{}  tastenbelegung anzeigen:{}    INT VAR cspa, czei;{}    cursor (w1, 2, 3); out (w1, tastenname [1]);{}                       out (w1, tastenbezeichnung (taste [1]));{}
+                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{}    cursor (w1, 2, 4); out (w1, tastenname [2]);{}                       out (w1, tastenbezeichnung (taste [2]));{}                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{}    cursor (w1, 2, 5); out (w1, tastenname [3]);{}                       out (w1, tastenbezeichnung (taste [3]));{}                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{}    cursor (w1, 2, 6); out (w1, tastenname [4]);{}
+                       out (w1, tastenbezeichnung (taste [4]));{}                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{}    cursor (w1, 2, 8); out (w1, tastenname [5]);{}                       out (w1, tastenbezeichnung (taste [5]));{}                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);{}    cursor (w1, 2,10); out (w1, tastenname [6]);{}                       out (w1, tastenbezeichnung (taste [6]));{}                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei).{}
+  bedienhinweise ausgeben:{}    cursor (w2, 1, 1); out (center (w2, invers (anwendungstext (152))));{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (52))));{}    cursor (w3, 2, 3); out (w3, anwendungstext (153));{}    cursor (w3, 2, 4); out (w3, anwendungstext (154));{}    cursor (w3, 2, 6); out (w3, anwendungstext (155));{}    cursor (w3, 2, 7); out (w3, anwendungstext (156));{}    cursor (w3, 2, 8); out (w3, anwendungstext (157));{}    cursor (w3, 2, 9); out (w3, anwendungstext (158));{}
+    cursor (w3, 2,11); out (w3, anwendungstext (159));{}    cursor (w3, 2,12); out (w3, anwendungstext (160));{}    cursor (w3, 2,13); out (w3, anwendungstext (161));{}    cursor (w3, 2,14); out (w3, anwendungstext (162)).{}  veraenderung erfragen:{}    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{}    cursor (w4, 2, 3);{}    IF no (w4, anwendungstext (164)){}       THEN LEAVE tastaturbelegung einstellen{}    FI.{}  neue tastenbelegung erfragen:{}    INT VAR z2; page (w4);{}
+    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{}    cursor (w4, 2, 3); out (w4, anwendungstext (165));{}    FOR z2 FROM 1 UPTO 6 REP{}      gib tastenhinweis;{}      hole tastatureingabe;{}      tastenbelegung anzeigen{}    PER.{}  gib tastenhinweis:{}    cleol (w4, 2, 5); out (w4, tastenname [z2]).{}  hole tastatureingabe:{}    INT VAR s, z; get cursor (w4, s, z);{}    cursor on; inchar (taste [z2]); cursor off;{}    cursor (w4, s, z); out (w4, tastenbezeichnung (taste [z2])).{}
+  hinweis zur bewertung und stand ausgeben:{}    IF neue tastenbelegung ist ok{}       THEN akzeptiere{}       ELSE akzeptiere nicht{}    FI.{}  neue tastenbelegung ist ok:{}    INT VAR zeiger; TEXT VAR tastenkette :: "";{}    FOR zeiger FROM 1 UPTO 6 REP{}      IF pos (tastenkette, taste [zeiger]) > 0{}         THEN LEAVE neue tastenbelegung ist ok WITH FALSE{}         ELSE tastenkette CAT taste [zeiger]{}      FI{}    PER;{}    TRUE.{}  akzeptiere:{}    cursor (w2, 3, 4);{}    out (w2, anwendungstext (166));{}
+    cursor (w2, 7, 6);{}    out (w2, anwendungstext (167)).{}  akzeptiere nicht:{}    cursor (w2, 3, 3); out (w2, anwendungstext (168));{}    cursor (w2, 3, 4); out (w2, anwendungstext (169));{}    cursor (w2, 3, 6); out (w2, anwendungstext (170));{}    cursor (w2, 3, 7); out (w2, anwendungstext (171));{}    cursor (w2, 3, 9); out (w2, anwendungstext (172));{}    cursor (w2, 5,10); out (w2, anwendungstext (173)).{}  benutzer ist einverstanden:{}    page (w4);{}    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));{}
+    IF neue tastenbelegung ist ok{}       THEN gib hinweis auf abspeicherung{}       ELSE frage nach neueingabe{}    FI.{}  gib hinweis auf abspeicherung:{}    cursor (w4, 3, 3); out (w4, anwendungstext (174));{}    neue tastenbelegung festschreiben;{}    cursor (w4, 3, 5); out (w4, anwendungstext (  2));{}    cursor on; pause; cursor off;{}    TRUE.{}  neue tastenbelegung festschreiben:{}    nach rechts   := taste [1];{}    nach links    := taste [2];{}    nach oben     := taste [3];{}    nach unten    := taste [4];{}
+    ausbesserung  := taste [5];{}    naechstes     := taste [6].{}  frage nach neueingabe:{}    cursor (w4, 2, 3);{}    IF yes (w4, anwendungstext (175)){}       THEN cleop (w2, 1, 3); FALSE{}       ELSE alte tastenbelegung einlesen;{}            tastenbelegung anzeigen;{}            cleop  (w4, 2, 3); out (w4, anwendungstext (176));{}            cursor (w4, 3, 5); out (w4, anwendungstext (  2));{}            cursor on; pause; cursor off;{}            TRUE{}    FI.{}END PROC tastaturbelegung einstellen;{}
+PROC simulationszeiten anzeigen (WINDOW VAR w):{}  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (181))));{}  cursor (w, 2, 3); out (w, anwendungstext (17));{}                    out (w, text (aktuelle anzahl der arbeitsphasen, 4));{}  cursor (w, 2, 4); out (w, anwendungstext (18));{}                    out (w, text (aktuelle arbeitsphasendauer in minuten, 4));{}                    out (w, anwendungstext (51));{}  cursor (w, 2, 5); out (w, anwendungstext (19));{}                    out (w, text (aktuelle pausendauer in minuten, 4));{}
+                    out (w, anwendungstext (51));{}  cursor (w, 2, 7); out (w, anwendungstext ( 5));{}                       out (w, gesamtdauerangabe).{}  gesamtdauerangabe:{}    text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).{}  arbeitsdauer:{}      aktuelle anzahl der arbeitsphasen{}    * aktuelle arbeitsphasendauer in minuten.{}  pausendauer:{}      (aktuelle anzahl der arbeitsphasen - 1){}    * aktuelle pausendauer in minuten.{}END PROC simulationszeiten anzeigen;{}PROC anzahl der arbeitsphasen festlegen:{}
+  INT CONST minwert :: 2, maxwert :: 20;{}  zeige fenster;{}    hinweise an den benutzer ausgeben;{}    simulationszeiten anzeigen (w2);{}    erfrage veraenderung;{}  REP{}    neuen wert vom bildschirm holen{}  UNTIL benutzer ist einverstanden PER.{}  zeige fenster:{}    w1 := window ( 2,  2, 28,  6);{}    w2 := window (22, 12, 37,  7);{}    w3 := window (32,  2, 47,  6);{}    page; show (w1); show (w2); show (w3).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}
+    cursor (w1, 2, 3); out (w1, anwendungstext (53));{}                       out (w1, text (minwert, 2));{}    cursor (w1, 2, 4); out (w1, anwendungstext (54));{}                       out (w1, text (maxwert, 2));{}    cursor (w1, 2, 6); out (w1, anwendungstext (55));{}                       out (w1, text (aktuelle anzahl der arbeitsphasen, 2)).{}  erfrage veraenderung:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (182))));{}    cursor (w3, 2, 3);{}    IF no (anwendungstext (218)){}
+       THEN LEAVE anzahl der arbeitsphasen festlegen{}    FI.{}  neuen wert vom bildschirm holen:{}    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));{}    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{}    cursor (w3, 2, 6); out (w3, anwendungstext (183));{}    aktuelle anzahl der arbeitsphasen := ermittelter wert (minwert, maxwert,{}                                         aktuelle anzahl der arbeitsphasen).{}  benutzer ist einverstanden:{}    hinweise an den benutzer ausgeben;{}    simulationszeiten anzeigen (w2);{}
+    cleop (w3, 2, 3);{}    IF yes (w3, anwendungstext (184)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC anzahl der arbeitsphasen festlegen;{}PROC dauer einer arbeitsphase festlegen:{}  INT CONST minwert :: 1, maxwert :: 60;{}  zeige fenster;{}  hinweise an den benutzer ausgeben;{}  simulationszeiten anzeigen (w2);{}  erfrage veraenderung;{}  REP{}    neuen wert vom bildschirm holen{}  UNTIL benutzer ist einverstanden PER.{}  zeige fenster:{}    w1 := window ( 2,  2, 28,  6);{}    w2 := window (22, 12, 37,  7);{}
+    w3 := window (32,  2, 47,  6);{}    page; show (w1); show (w2); show (w3).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}    cursor (w1, 2, 3); out (w1, anwendungstext (53));{}                       out (w1, text (minwert, 2));{}                       out (w1, anwendungstext (51));{}    cursor (w1, 2, 4); out (w1, anwendungstext (54));{}                       out (w1, text (maxwert, 2));{}                       out (w1, anwendungstext (51));{}
+    cursor (w1, 2, 6); out (w1, anwendungstext (55));{}                       out (w1, text (aktuelle arbeitsphasendauer in minuten, 2));{}                       out (w1, anwendungstext (51)).{}  erfrage veraenderung:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (187))));{}    cursor (w3, 2, 3);{}    IF no (anwendungstext (219)){}       THEN LEAVE dauer einer arbeitsphase festlegen{}    FI.{}  neuen wert vom bildschirm holen:{}    INT VAR spa, zei;{}    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));{}
+    cursor (w3, 2, 3); out (w3, anwendungstext ( 58));{}    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{}    cursor (w3, 2, 6); out (w3, anwendungstext (188));{}    get cursor (w3, spa, zei);{}    cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{}    cursor (w3, spa, zei);{}    aktuelle arbeitsphasendauer in minuten{}                               := ermittelter wert (minwert, maxwert,{}                                  aktuelle arbeitsphasendauer in minuten).{}  benutzer ist einverstanden:{}
+    hinweise an den benutzer ausgeben;{}    simulationszeiten anzeigen (w2);{}    cleop (w3, 2, 3);{}    IF yes (w3, anwendungstext (189)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC dauer einer arbeitsphase festlegen;{}PROC pausendauer festlegen:{}  INT CONST minwert :: 1, maxwert :: 30;{}  zeige fenster;{}  hinweise an den benutzer ausgeben;{}  simulationszeiten anzeigen (w2);{}  erfrage veraenderung;{}  REP{}    neuen wert vom bildschirm holen{}  UNTIL benutzer ist einverstanden PER.{}
+  zeige fenster:{}    w1 := window ( 2,  2, 28,  6);{}    w2 := window (22, 12, 37,  7);{}    w3 := window (32,  2, 47,  6);{}    page; show (w1); show (w2); show (w3).{}  hinweise an den benutzer ausgeben:{}    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));{}    cursor (w1, 2, 3); out (w1, anwendungstext (53));{}                       out (w1, text (minwert, 2));{}                       out (w1, anwendungstext (51));{}    cursor (w1, 2, 4); out (w1, anwendungstext (54));{}
+                       out (w1, text (maxwert, 2));{}                       out (w1, anwendungstext (51));{}    cursor (w1, 2, 6); out (w1, anwendungstext (55));{}                       out (w1, text (aktuelle pausendauer in minuten, 2));{}                       out (w1, anwendungstext (51)).{}  erfrage veraenderung:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (191))));{}    cursor (w3, 2, 3);{}    IF no (anwendungstext (220)){}       THEN LEAVE pausendauer festlegen{}    FI.{}
+  neuen wert vom bildschirm holen:{}    INT VAR spa, zei;{}    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));{}    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));{}    cursor (w3, 2, 6); out (w3, anwendungstext (192));{}    get cursor (w3, spa, zei);{}    cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));{}    cursor (w3, spa, zei);{}    aktuelle pausendauer in minuten{}                               := ermittelter wert (minwert, maxwert,{}                                          aktuelle pausendauer in minuten).{}
+  benutzer ist einverstanden:{}    hinweise an den benutzer ausgeben;{}    simulationszeiten anzeigen (w2);{}    cleop (w3, 2, 3);{}    IF yes (w3, anwendungstext (193)){}       THEN TRUE{}       ELSE FALSE{}    FI.{}END PROC pausendauer festlegen;{}PROC wertungsschluessel veraendern:{}  INT CONST abszisse :: 16, ordinate :: 2;{}  zeige fenster;{}  gib bewertungsschluessel aus (w1);{}  gib informationen aus;{}  stelle frage nach veraenderung;{}  REP{}    neueinstellung{}  UNTIL benutzer ist einverstanden PER.{}
+  zeige fenster:{}    w1 := window ( 2,  2, 38, 22);{}    w2 := window (42, 10, 37, 14);{}    w3 := window (42,  2, 37,  6);{}    page; show (w1); show (w2); show (w3).{}  gib informationen aus:{}    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));{}    cursor (w2, 2, 3); out (w2, anwendungstext (195));{}    cursor (w2, 2, 4); out (w2, anwendungstext (196));{}    cursor (w2, 2, 6); out (w2, anwendungstext (197));{}    cursor (w2, 2, 7); out (w2, anwendungstext (198));{}    cursor (w2, 2, 8); out (w2, anwendungstext (199));{}
+    cursor (w2, 2,11); out (w2, anwendungstext (200));{}    cursor (w2, 2,12); out (w2, anwendungstext (201));{}    cursor (w2, 2,13); out (w2, anwendungstext (202)).{}  stelle frage nach veraenderung:{}    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (205))));{}    cursor (w3, 2, 3);{}    IF no (anwendungstext (206)){}       THEN LEAVE wertungsschluessel veraendern{}       ELSE gib hinweis auf linkes fenster{}    FI.{}  gib hinweis auf linkes fenster:{}    cleop  (w3, 2, 3); out (w3, anwendungstext (211));{}
+    cursor (w3, 2, 4); out (w3, anwendungstext (212));{}    cursor (w3, 2, 5); out (w3, anwendungstext (213)).{}  neueinstellung:{}    INT VAR zeiger;{}    cursor an;{}    FOR zeiger FROM 1 UPTO 11 REP{}      gehe auf aktuelle punktposition;{}      lasse verschieben{}    PER;{}    cursor aus.{}  gehe auf aktuelle punktposition:{}    cursor (w1, ordinate + 3 * zeiger, abszisse - nachkommastelle).{}  nachkommastelle:{}    int (bewertung [zeiger] * 10.0).{}  lasse verschieben:{}    TEXT VAR eingabezeichen; INT VAR position;{}
+    REP{}      inchar (eingabezeichen);{}      position := pos (oben unten return, eingabezeichen);{}      fuehre angemessene reaktion aus{}    UNTIL position = 3 PER.{}  fuehre angemessene reaktion aus:{}    SELECT position OF{}      CASE 1: steige auf{}      CASE 2: steige ab{}      CASE 3: (* tue nichts *){}      OTHERWISE piepse{}    END SELECT.{}  steige auf:{}    IF bewertung [zeiger] < 1.0{}       THEN loesche alten punkt;{}            bewertung [zeiger] INCR 0.1;{}            schreibe neuen punkt{}
+       ELSE piepse{}    FI.{}  steige ab:{}    IF bewertung [zeiger] > 0.0{}       THEN loesche alten punkt;{}            bewertung [zeiger] DECR 0.1;{}            schreibe neuen punkt{}       ELSE piepse{}    FI.{}  loesche alten punkt:{}    INT VAR tabspalte, tabzeile;{}    gehe auf aktuelle punktposition;{}    get cursor (w1, tabspalte, tabzeile);{}    IF tabspalte = ordinate + 3 OR tabzeile = abszisse{}       THEN out (w1, "|"){}       ELSE out (w1, blank){}    FI.{}  schreibe neuen punkt:{}    gehe auf aktuelle punktposition;{}
+    out (w1, punkt und zurueck).{}  benutzer ist einverstanden:{}    cleop (w3, 2, 3);{}    IF yes (w3, anwendungstext (207)){}       THEN TRUE{}       ELSE gib hinweis auf linkes fenster;{}            FALSE{}    FI.{}END PROC wertungsschluessel veraendern;{}PROC cleol (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{}  cursor (w, cursorspalte, cursorzeile);{}  IF remaining lines (w) > 1{}     THEN out (w, (areaxsize (w) - cursorspalte + 1) * blank){}     ELSE out (w, (areaxsize (w) - cursorspalte) * blank){}
+  FI;{}  cursor (w, cursorspalte, cursorzeile){}END PROC cleol;{}PROC cleop (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):{}  cleol (w, cursorspalte, cursorzeile);{}  INT VAR i;{}  FOR i FROM 1 UPTO remaining lines (w) REP{}    cleol (w, 1, cursorzeile + i){}  PER;{}  cursor  (w, cursorspalte, cursorzeile){}END PROC cleop;{}PROC cursor an:{}  INT VAR spalte, zeile;{}  get cursor (spalte, zeile); cursor on; cursor (spalte, zeile){}END PROC cursor an;{}PROC cursor aus:{}  INT VAR spalte, zeile;{}
+  get cursor (spalte, zeile); cursor off; cursor (spalte, zeile){}END PROC cursor aus;{}INT PROC eingabe mit intervallanzeige (WINDOW VAR w, INT CONST minwert,{}                                       maxwert, anfangswert, cursorspalte,{}                                       cursorzeile):{}  BOOL VAR ist aufsteigend :: minwert = anfangswert;{}  INT  VAR aktueller wert  :: anfangswert, alter wert, eingelesener wert;{}  REP{}    hole position aus vorgabe (oben unten return, eingelesener wert);{}    SELECT eingelesener wert OF{}
+      CASE 1: erniedrige aktuellen wert wenn moeglich{}      CASE 2: erhoehe aktuellen wert wenn moeglich{}    END SELECT{}  UNTIL eingelesener wert = 3 PER;{}  aktueller wert.{}  erniedrige aktuellen wert wenn moeglich:{}    IF aktueller wert > minwert{}       THEN alter wert := aktueller wert;{}            aktueller wert DECR 1;{}            IF ist aufsteigend{}               THEN loesche alte markierung{}               ELSE markiere neues zeichen{}            FI{}       ELSE piepse{}    FI.{}  erhoehe aktuellen wert wenn moeglich:{}
+    IF aktueller wert < maxwert{}       THEN alter wert := aktueller wert;{}            aktueller wert INCR 1;{}            IF ist aufsteigend{}               THEN markiere neues zeichen{}               ELSE loesche alte markierung{}            FI{}       ELSE piepse{}    FI.{}  loesche alte markierung:{}    positioniere cursor in zeichenkette (w, 33, alter wert);{}    out (w, code (alter wert) + "  ");{}    cursor (cursorspalte, cursorzeile).{}  markiere neues zeichen:{}    positioniere cursor in zeichenkette (w, 33, aktueller wert);{}
+    out (w, invers (code (aktueller wert)));{}    cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit intervallanzeige;{}INT PROC eingabe mit elementanzeige (WINDOW VAR w, INT CONST minwert,{}                                     maxwert, anfangswert,{}                                     cursorspalte, cursorzeile):{}  INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;{}  REP{}    hole position aus vorgabe (oben unten return, eingelesener wert);{}    SELECT eingelesener wert OF{}
+      CASE 1: erniedrige aktuellen wert wenn moeglich{}      CASE 2: erhoehe aktuellen wert wenn moeglich{}    END SELECT{}  UNTIL eingelesener wert = 3 PER;{}  aktueller wert.{}  erniedrige aktuellen wert wenn moeglich:{}    IF aktueller wert > minwert{}       THEN alter wert := aktueller wert;{}            aktueller wert DECR 1;{}            loesche alte markierung;{}            markiere neues zeichen{}       ELSE piepse{}    FI.{}  erhoehe aktuellen wert wenn moeglich:{}    IF aktueller wert < maxwert{}
+       THEN alter wert := aktueller wert;{}            aktueller wert INCR 1;{}            loesche alte markierung;{}            markiere neues zeichen{}       ELSE piepse{}    FI.{}  loesche alte markierung:{}    positioniere cursor in zeichenkette (w, minwert, alter wert);{}    out (w, code (alter wert) + "  ");{}    cursor (cursorspalte, cursorzeile).{}  markiere neues zeichen:{}    positioniere cursor in zeichenkette (w, minwert, aktueller wert);{}    out (w, invers (code (aktueller wert)));{}
+    cursor (cursorspalte, cursorzeile).{}END PROC eingabe mit elementanzeige;{}PROC werkstueck zeigen (WINDOW VAR w):{}  INT VAR zaehler, spalte, zeile;{}  page (w);{}  werkstueckaufhaenger (spalte, zeile);{}  schreibe werkstueck zeilenweise.{}  schreibe werkstueck zeilenweise:{}    FOR zaehler FROM 1 UPTO aktuelle werkstueckhoehe REP{}      positioniere den cursor;{}      bastle eine zeile;{}      gib eine zeile aus{}    PER.{}  positioniere den cursor:{}    cursor (w, spalte,  zeile + zaehler - 1).{}
+  bastle eine zeile:{}    TEXT VAR zeileninhalt := "";{}    INT VAR z;{}    FOR z FROM 1 UPTO aktuelle werkstueckbreite REP{}      zeileninhalt CAT code (random (kleinster aktueller zeichencode,{}                                     groesster aktueller zeichencode)){}    PER.{}  gib eine zeile aus:{}    IF inversdarstellung{}       THEN out (w, invers (zeileninhalt)){}       ELSE out (w, zeileninhalt){}    FI.{}END PROC werkstueck zeigen;{}PROC werkstueckaufhaenger (INT VAR spalte, zeile):{}  spalte := ((maxspalten - aktuelle werkstueckbreite) DIV 2) + 3;{}
+  zeile  := ((maxzeilen  - aktuelle werkstueckhoehe ) DIV 2) + 2;{}  IF inversdarstellung THEN spalte DECR 1 FI{}END PROC werkstueckaufhaenger;{}PROC gib zeichenkette aus (WINDOW VAR w,{}                           INT CONST kleinster, groesster, markiertes):{}  INT VAR zaehler;{}  FOR zaehler FROM kleinster UPTO groesster REP{}    positioniere cursor in zeichenkette (w, kleinster, zaehler);{}    IF zaehler = markiertes{}       THEN out (w, invers (code (zaehler))){}       ELSE out (w, code (zaehler)){}
+    FI{}  PER{}END PROC gib zeichenkette aus;{}PROC positioniere cursor in zeichenkette (WINDOW VAR w,{}                                          INT CONST mincode, position):{}  cursor (w, 4 + ((position - mincode) DIV 19) * 5,{}             3 + ((position - mincode) MOD 19)){}END PROC positioniere cursor in zeichenkette;{}TEXT PROC tastenbezeichnung (TEXT CONST zeichen):{}  IF code (zeichen) >= 33 AND code (zeichen) <= 126{}     THEN "<" + zeichen + ">"{}     ELSE umgesetzter code{}  FI.{}  umgesetzter code:{}
+    SELECT code (zeichen) OF{}      CASE   1: anwendungstext (31){}      CASE   2: anwendungstext (32){}      CASE   3: anwendungstext (33){}      CASE   8: anwendungstext (34){}      CASE   9: anwendungstext (35){}      CASE  10: anwendungstext (36){}      CASE  11: anwendungstext (37){}      CASE  12: anwendungstext (38){}      CASE  13: anwendungstext (39){}      CASE  16: anwendungstext (40){}      CASE  27: anwendungstext (41){}      CASE  32: anwendungstext (42){}      CASE 214: anwendungstext (43){}
+      CASE 215: anwendungstext (44){}      CASE 216: anwendungstext (45){}      CASE 217: anwendungstext (46){}      CASE 218: anwendungstext (47){}      CASE 219: anwendungstext (48){}      CASE 251: anwendungstext (49){}      OTHERWISE anwendungstext (50){}  END SELECT{}END PROC tastenbezeichnung;{}INT PROC ermittelter wert (INT CONST minimum, maximum, startwert):{}  INT VAR aktueller wert, eingelesener wert;{}  cursor an;{}  aktueller wert := startwert;{}  REP{}    gib dreistellig aus und positioniere zurueck (aktueller wert, FALSE);{}
+    hole position aus vorgabe (oben unten return, eingelesener wert);{}    SELECT eingelesener wert OF{}      CASE 1: erhoehe aktuellen wert wenn moeglich{}      CASE 2: erniedrige aktuellen wert wenn moeglich{}    END SELECT{}  UNTIL eingelesener wert = 3 PER;{}  cursor aus;{}  aktueller wert.{}  erhoehe aktuellen wert wenn moeglich:{}    IF aktueller wert < maximum{}       THEN aktueller wert INCR 1{}       ELSE piepse{}    FI.{}  erniedrige aktuellen wert wenn moeglich:{}    IF aktueller wert > minimum{}
+       THEN aktueller wert DECR 1{}       ELSE piepse{}    FI.{}END PROC ermittelter wert;{}PROC gib dreistellig aus und positioniere zurueck (INT CONST wert,{}                                                   BOOL CONST mit wertwandel):{}  INT VAR spalte, zeile; get cursor (spalte, zeile);{}  IF mit wertwandel{}     THEN out ("'" + code (wert) + "'"){}     ELSE out (text (wert, 3)){}  FI;{}  cursor (spalte, zeile);{}END PROC gib dreistellig aus und positioniere zurueck;{}PROC hole position aus vorgabe (TEXT CONST vorgabe, INT VAR position):{}
+  TEXT VAR eingabezeichen; INT VAR spa, zei;{}  REP{}    get cursor (spa, zei); inchar (eingabezeichen); cursor (spa, zei);{}    position := pos (vorgabe, eingabezeichen);{}    IF position = 0 THEN piepse; cursor (spa, zei) FI{}  UNTIL position > 0 PER{}END PROC hole position aus vorgabe;{}PROC piepse:{}  INT VAR spa, zei; get cursor (spa, zei); out (piep); cursor (spa, zei){}END PROC piepse;{}END PACKET ls mp bap 1;{}stdvoreinstellung der parameter{}
+
diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP 2 b/app/gs.mp-bap/1.1/src/ls-MP BAP 2
new file mode 100644
index 0000000..0cd66ff
--- /dev/null
+++ b/app/gs.mp-bap/1.1/src/ls-MP BAP 2
@@ -0,0 +1,126 @@
+PACKET ls mp bap 2  DEFINES                (*******************************) 
+                                           (*                             *) 
+  materialpruefung, mp,                    (*         ls-MP BAP 2         *) 
+  bildschirmarbeitsplatz, bap,             (*         Version 1.1         *) 
+                                           (*                             *) 
+  mp bap simulation ausfuehren,            (*   (c) 1987, 1988            *) 
+  mp bap auswertung auf bildschirm,        (*       by Eva Latta-Weber    *) 
+  mp bap drucken von auswertungen,         (*          Bielefeld          *) 
+                                           (*                             *) 
+  mp bap protokollumfang festlegen,        (*******************************) 
+  mp bap kurzauswertung, 
+ 
+  druckereinstellung fuer protokolldatei, 
+  stddruckereinstellung fuer protokolldatei: 
+ 
+ 
+ 
+LET maxeintraege             =                    800, 
+    protokolldateipraefix    =       "ls-Protokoll: ", 
+    menukarte                =  "ls-MENUKARTE:MP-BAP", 
+    menubezeichnung          =                  "BAP", 
+    auswertdateipostfix      =        " - Auswertung", 
+    protokolldateityp        =                   1955, 
+    maxspalten               =                     70, 
+    maxzeilen                =                     14,{}    blank                    =                    " ",{}    trenn                    =                    "|",{}    werkstueckendekennung    =                      1,{}    pausenendekennung        =                      2,{}    simulationsendekennung   =                      3,{}    markierung ein           =                 ""15"",{}    markierung aus           =                " "14"",{}    stdschrifttyp            =                     "",{}
+    stdxstart                =                    0.0,{}    stdystart                =                    0.0,{}    stdfeldbreite            =                   21.0,{}    stdfeldlaenge            =                   29.5;{}LET  KONTROLLTABELLE = STRUCT (INT  letzter eintrag,{}                                    breite, hoehe,{}                                    kleinster code, groesster code,{}                                    anzahl aphasen, aphasendauer,{}                                    pausendauer,{}
+                               TEXT datum, uhrzeit, fehlerzeichen,{}                                    nach rechts, nach links,{}                                    nach oben, nach unten,{}                                    ausbesserung, naechstes,{}                               BOOL inversdarstellung,{}                               ROW  11 REAL bewertung,{}                               ROW maxeintraege KONTROLLE tabelle),{}     KONTROLLE       = STRUCT (INT  eintragskennung,{}                                    produktionsfehler,{}
+                                    anzahl korrekturen,{}                                    anzahl bedienfehler,{}                               REAL anfang, ende, differenz),{}     WERKSTUECK      = ROW maxspalten ROW maxzeilen INT;{}INT  VAR breite, hoehe, kleinster code, groesster code,{}         anzahl aphasen, aphasendauer, pausendauer,{}         eckspalte, eckzeile, x, y, xsize, ysize;{}TEXT VAR fehlerzeichen, nach rechts, nach links, nach oben, nach unten,{}         ausbesserung, naechstes, datum, uhrzeit;{}
+TEXT VAR protokollschrifttyp :: stdschrifttyp;{}REAL VAR xstart              :: stdxstart,{}         ystart              :: stdystart,{}         schreibfeldbreite   :: stdfeldbreite,{}         schreibfeldlaenge   :: stdfeldlaenge;{}ROW 11 REAL VAR bewertung;{}BOOL VAR inversdarstellung,{}         kontrolldatei zur vatertask ::  TRUE,{}         mit kurzprotokoll           ::  TRUE,{}         mit anmerkungen             ::  TRUE,{}         auswertung geht zum drucker :: FALSE;{}WERKSTUECK VAR werkstueck;{}
+PROC bildschirmarbeitsplatz:{}  kontrolldatei zur vatertask := FALSE;{}  install menu (menukarte);{}  handle menu  (menubezeichnung);{}END PROC bildschirmarbeitsplatz;{}PROC bap:{}  bildschirmarbeitsplatz{}END PROC bap;{}PROC materialpruefung:{}  TEXT VAR benutzerkennung :: "", protokollname, alter dateiname :: std;{}  install menu (menukarte, FALSE);{}  kontrolldatei zur vatertask := TRUE;{}  ermittle eingestellte parameter;{}  bereite den bildschirm vor;{}  ermittle die benutzerkennung;{}  gib benutzerhinweise aus;{}
+  arbeitsplatzsimulation ausfuehren (benutzerkennung, protokollname);{}  forget (protokollname, quiet);{}  last param (alter dateiname).{}  bereite den bildschirm vor:{}    WINDOW VAR w :: window ( 2, 10, 77, 14);{}    page;{}    show (w);{}    out (w, center (w, anwendungstext (400))).{}  ermittle die benutzerkennung:{}    benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{}    IF benutzerkennung = ""{}       THEN cursor on; page;{}            LEAVE materialpruefung{}    FI.{}
+  gib benutzerhinweise aus:{}    boxinfo (w, anwendungstext (402));{}    boxinfo (w, anwendungstext (403));{}    boxinfo (w, anwendungstext (404));{}    gib bedieninformationen aus (2);{}    boxinfo (w, anwendungstext (405));{}    boxinfo (w, anwendungstext (406));{}    boxinfo (w, anwendungstext (407));{}    boxinfo (w, anwendungstext (408)).{}END PROC materialpruefung;{}PROC mp:{}  materialpruefung{}END PROC mp;{}PROC mp bap simulation ausfuehren:{}  TEXT VAR benutzerkennung :: "", dateiname;{}
+  kontrolldatei zur vatertask := FALSE;{}  ermittle eingestellte parameter;{}  bereite den bildschirm vor;{}  ermittle die benutzerkennung;{}  arbeitsplatzsimulation ausfuehren (benutzerkennung, dateiname);{}  regenerate menuscreen.{}  bereite den bildschirm vor:{}    WINDOW VAR w :: window (2,2,77,22);{}    page;{}    out (w, center (w, anwendungstext (399))).{}  ermittle die benutzerkennung:{}    benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));{}    IF benutzerkennung = ""{}
+       THEN regenerate menuscreen;{}            LEAVE mp bap simulation ausfuehren{}    FI.{}END PROC mp bap simulation ausfuehren;{}PROC mp bap auswertung auf bildschirm:{}  auswertung geht zum drucker := FALSE;{}  lasse protokolldateien auswaehlen;{}  werte protokolldateien aus;{}  regenerate menuscreen.{}  lasse protokolldateien auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := infix namen (ALL myself, protokolldateipraefix,{}                                            protokolldateityp);{}
+    IF NOT not empty (verfuegbare){}       THEN noch kein protokoll{}       ELSE biete auswahl an{}    FI.{}  noch kein protokoll:{}    regenerate menuscreen;{}    menuinfo (anwendungstext (424));{}    LEAVE mp bap auswertung auf bildschirm.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, anwendungstext (421),{}                             anwendungstext (422), FALSE).{}  werte protokolldateien aus:{}    INT VAR k;{}    steige ggf bei leerem thesaurus aus;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}
+      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              gib hinweis auf auswertung;{}              simulationsauswertung (name (verfuegbare, k), TRUE);{}              forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN regenerate menuscreen;{}            menuinfo (anwendungstext (423));{}            LEAVE mp bap auswertung auf bildschirm{}
+    FI.{}  gib hinweis auf auswertung:{}    page;{}    WINDOW VAR fenster :: window ( 2, 2, 77, 22);{}    show (fenster);{}    cursor (fenster, 1,  9); out (fenster, center (fenster, name (verfuegbare, k)));{}    cursor (fenster, 1, 12); out (fenster, center (anwendungstext (274))).{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo (invers (errormessage));{}            clear error; enable stop;{}            LEAVE mp bap auswertung auf bildschirm{}    FI.{}
+END PROC mp bap auswertung auf bildschirm;{}PROC mp bap drucken von auswertungen:{}  auswertung geht zum drucker := TRUE;{}  lasse protokolldateien auswaehlen;{}  werte protokolldateien aus;{}  regenerate menuscreen.{}  lasse protokolldateien auswaehlen:{}    THESAURUS VAR verfuegbare;{}    verfuegbare := infix namen (ALL myself, protokolldateipraefix,{}                                            protokolldateityp);{}    IF NOT not empty (verfuegbare){}       THEN noch kein protokoll{}       ELSE biete auswahl an{}
+    FI.{}  noch kein protokoll:{}    regenerate menuscreen;{}    menuinfo (anwendungstext (424));{}    LEAVE mp bap drucken von auswertungen.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, anwendungstext (425),{}                             anwendungstext (422), FALSE).{}  werte protokolldateien aus:{}    INT VAR k;{}    steige ggf bei leerem thesaurus aus;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              gib hinweis auf auswertung;{}
+              simulationsauswertung (name (verfuegbare, k), FALSE);{}              print (name (verfuegbare, k) + auswertdateipostfix);{}              forget (name (verfuegbare, k) + auswertdateipostfix, quiet);{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN regenerate menuscreen;{}            menuinfo (anwendungstext (423));{}            LEAVE mp bap drucken von auswertungen{}    FI.{}  gib hinweis auf auswertung:{}
+    page;{}    WINDOW VAR fenster :: window ( 2, 2, 77, 22);{}    show (fenster);{}    cursor (fenster, 1,  9); out (fenster, center (fenster, name (verfuegbare, k)));{}    cursor (fenster, 1, 12); out (fenster, center (anwendungstext (270))).{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo (invers (errormessage));{}            clear error; enable stop;{}            LEAVE mp bap drucken von auswertungen{}    FI.{}END PROC mp bap drucken von auswertungen;{}
+PROC mp bap protokollumfang festlegen:{}  page;{}  zeige aktuellen protokollumfang an;{}  gib erlaeuterungen zum protokollumfang;{}  frage nach umfangsaenderung;{}  regenerate menuscreen{}END PROC mp bap protokollumfang festlegen;{}PROC mp bap kurzauswertung:{}  page;{}  zeige aktuelle kurzauswertungseinstellung an;{}  gib erlaeuterungen zur kurzauswertung;{}  frage nach kurzauswertungsaenderung;{}  regenerate menuscreen{}END PROC mp bap kurzauswertung;{}PROC druckereinstellung fuer protokolldatei (TEXT CONST schrifttyp,{}
+                                             REAL CONST linker rand,{}                                                        oberer rand,{}                                                        feldbreite,{}                                                        feldlaenge):{}  protokollschrifttyp := schrifttyp;{}  xstart              := linker rand;{}  ystart              := oberer rand;{}  schreibfeldbreite   := feldbreite;{}  schreibfeldlaenge   := feldlaenge;{}END PROC druckereinstellung fuer protokolldatei;{}
+PROC stddruckereinstellung fuer protokolldatei:{}  protokollschrifttyp := stdschrifttyp;{}  xstart              := stdxstart;{}  ystart              := stdystart;{}  schreibfeldbreite   := stdfeldbreite;{}  schreibfeldlaenge   := stdfeldlaenge{}END PROC stddruckereinstellung fuer protokolldatei;{}                 (********************************){}PROC arbeitsplatzsimulation ausfuehren (TEXT CONST kennung,{}                                        TEXT VAR   dateiname):{}  ermittle eingestellte parameter;{}
+  lege datei mit kennung an (kennung, dateiname);{}  cursor on;{}  fuehre simulation durch (dateiname);{}  schicke ggf protokolldatei zur vatertask;{}  gib ggf kurzprotokoll aus.{}  schicke ggf protokolldatei zur vatertask:{}    IF kontrolldatei zur vatertask{}       THEN command dialogue (FALSE);{}            save (dateiname);{}            command dialogue (TRUE){}    FI.{}  gib ggf kurzprotokoll aus:{}    IF mit kurzprotokoll{}       THEN kurzauswertung auf bildschirm (dateiname){}       ELSE page; put (anwendungstext (271)){}
+    FI.{}END PROC arbeitsplatzsimulation ausfuehren;{}PROC ermittle eingestellte parameter:{}  werkstueckdefinition (breite, hoehe, kleinster code, groesster code,{}                        fehlerzeichen, inversdarstellung);{}  tastendefinition     (nach rechts, nach links, nach oben, nach unten,{}                        ausbesserung, naechstes);{}  phasendefinition     (anzahl aphasen, aphasendauer, pausendauer);{}  bewertungsschluessel (bewertung);{}END PROC ermittle eingestellte parameter;{}PROC lege datei mit kennung an (TEXT CONST kennung, TEXT VAR datname):{}
+  BOUND KONTROLLTABELLE VAR tab;{}  TEXT VAR interner name :: protokolldateipraefix;{}  interner name CAT kennung;{}  lege neue datei an;{}  type (old (datname), protokolldateityp).{}  lege neue datei an:{}    INT VAR i :: 0; TEXT VAR bezeichnung;{}    REP{}      i INCR 1;{}      bezeichnung := interner name + " /" + text (i){}    UNTIL NOT exists (bezeichnung) PER;{}    tab := new (bezeichnung);{}    initialisiere tabelle;{}    datname := bezeichnung.{}  initialisiere tabelle:{}    tab.letzter eintrag := 0.{}
+END PROC lege datei mit kennung an;{}PROC fuehre simulation durch (TEXT CONST dateiname):{}  BOUND KONTROLLTABELLE VAR tab :: old (dateiname);{}  TEXT CONST moegliche eingabezeichen :: nach rechts  + nach links +{}                                         nach oben    + nach unten +{}                                         ausbesserung + naechstes;{}  treffe vorbereitungen;{}  trage grunddaten in tabelle;{}  simuliere.{}  treffe vorbereitungen:{}     initialisierungen;{}     WINDOW VAR fenster :: window (  1,  9, 79, 16);{}
+     page;{}     gib bedieninformationen aus (2);{}     werkstueckaufhaenger (eckspalte, eckzeile);{}     weise auf arbeitsbeginn hin;{}     beginn der arbeitsphase      :=               clock (1);{}     beginn der bearbeitung       := beginn der arbeitsphase;{}     arbeitsphasenlaenge          := real (aphasendauer * 60).{}  initialisierungen:{}    INT  VAR eintragzaehler        :: 0,{}             arbeitsphasenzaehler  :: 1,{}             werkstueckzaehler     :: 0,{}             bedienfehlerzaehler   :: 0,{}
+             korrekturzaehler      :: 0,{}             produktionsfehler,{}             cursorspalte relativ,{}             cursorzeile  relativ;{}    REAL VAR beginn der arbeitsphase,{}             beginn der bearbeitung,{}             arbeitsphasenlaenge,{}             arbeitsphasenueberziehung,{}             pausenueberziehung.{}  weise auf arbeitsbeginn hin:{}    page (fenster);{}    boxinfo (fenster, anwendungstext (252), 5, maxint);{}    clear buffer.{}  trage grunddaten in tabelle:{}    tab.datum               := date;{}
+    tab.uhrzeit             := time of day;{}    tab.breite              := breite;{}    tab.hoehe               := hoehe;{}    tab.kleinster code      := kleinster code;{}    tab.groesster code      := groesster code;{}    tab.anzahl aphasen      := anzahl aphasen;{}    tab.aphasendauer        := aphasendauer;{}    tab.pausendauer         := pausendauer;{}    tab.fehlerzeichen       := fehlerzeichen;{}    tab.nach rechts         := nach rechts;{}    tab.nach links          := nach links;{}    tab.nach oben           := nach oben;{}
+    tab.nach unten          := nach unten;{}    tab.ausbesserung        := ausbesserung;{}    tab.naechstes           := naechstes;{}    tab.inversdarstellung   := inversdarstellung;{}    tab.bewertung           := bewertung;{}    eintragzaehler          := 1.{}  simuliere:{}    REP{}      gib holehinweis;{}      hole werkstueck  (werkstueck, produktionsfehler);{}      zeige werkstueck (werkstueck, fenster);{}      lasse werkstueck bearbeiten{}    UNTIL simulationsende erreicht PER.{}  gib holehinweis:{}
+    page (fenster);{}    cursor (fenster, 2, 3); out (fenster, anwendungstext (253)).{}  lasse werkstueck bearbeiten:{}    initialisiere den relativcursor;{}    setze cursor;{}    clear buffer;{}    bearbeite das werkstueck.{}  initialisiere den relativcursor:{}    cursorspalte relativ := 1;{}    cursorzeile relativ  := 1.{}  setze cursor:{}    IF inversdarstellung{}       THEN cursor (fenster, eckspalte + cursorspalte relativ,{}                             eckzeile  + cursorzeile  relativ - 1);{}
+       ELSE cursor (fenster, eckspalte + cursorspalte relativ - 1,{}                             eckzeile  + cursorzeile  relativ - 1);{}    FI.{}  bearbeite das werkstueck:{}    BOOL VAR werkstueck voll bearbeitet :: FALSE;{}    REP{}      hole eingabe und werte aus{}    UNTIL werkstueck voll bearbeitet PER.{}  hole eingabe und werte aus:{}    TEXT VAR eingabezeichen := incharety (100);{}    SELECT eingabezeichenposition OF{}      CASE 1: wenn moeglich nach rechts{}      CASE 2: wenn moeglich nach links{}
+      CASE 3: wenn moeglich nach oben{}      CASE 4: wenn moeglich nach unten{}      CASE 5: wenn moeglich ausbessern{}      CASE 6: beende werkstueckbearbeitung{}      OTHERWISE entscheide ob gepiepst wird{}    END SELECT.{}  eingabezeichenposition:{}    pos (moegliche eingabezeichen, eingabezeichen).{}  wenn moeglich nach rechts:{}    IF cursorspalte relativ < breite{}       THEN cursorspalte relativ INCR 1;{}            setze cursor{}       ELSE registriere bedienfehler{}    FI.{}  wenn moeglich nach links:{}
+    IF cursorspalte relativ > 1{}       THEN cursorspalte relativ DECR 1;{}            setze cursor{}       ELSE registriere bedienfehler{}    FI.{}  wenn moeglich nach oben:{}    IF cursorzeile relativ > 1{}       THEN cursorzeile relativ DECR 1;{}            setze cursor{}       ELSE registriere bedienfehler{}    FI.{}  wenn moeglich nach unten:{}    IF cursorzeile relativ < hoehe{}       THEN cursorzeile relativ INCR 1;{}            setze cursor{}       ELSE registriere bedienfehler{}    FI.{}
+  wenn moeglich ausbessern:{}    IF werkstueck [cursorspalte relativ][cursorzeile relativ] = code (fehlerzeichen){}       THEN werkstueck [cursorspalte relativ][cursorzeile relativ] := code (blank);{}            korrekturzaehler INCR 1;{}            get cursor (fenster, x, y);{}            out (fenster, blank);{}            cursor (fenster, x, y);{}       ELSE registriere bedienfehler{}    FI.{}  registriere bedienfehler:{}    piepse; bedienfehlerzaehler INCR 1.{}  entscheide ob gepiepst wird:{}    IF eingabezeichen <> "" THEN piepse FI.{}
+  beende werkstueckbearbeitung:{}    IF   simulationsende erreicht{}         THEN trage simulationsende in tabelle ein{}    ELIF arbeitsphasenende erreicht{}         THEN trage werkstueckdaten in tabelle ein;{}              ermittle ueberziehung der arbeitsphase;{}              lege eine pause ein{}    ELSE trage werkstueckdaten in tabelle ein{}    FI;{}    werkstueck voll bearbeitet := TRUE.{}  lege eine pause ein:{}    nimm pausendaten;{}    weise auf pausenanfang hin;{}    pausiere;{}    weise auf pausenende hin;{}
+    registriere pausenueberziehung.{}  nimm pausendaten:{}    REAL VAR pausenanfang :: clock (1),{}             pausenende   :: pausenanfang + real (pausendauer * 60);.{}  weise auf pausenanfang hin:{}    page (fenster);{}    boxnotice (fenster, anwendungstext (255), 5, x, y, xsize, ysize).{}  pausiere:{}    REP{}      pause (int ((pausenende - clock (1)) * 10.0)){}    UNTIL clock (1) >= pausenende PER.{}  weise auf pausenende hin:{}    page (fenster);{}    pausenanfang := clock (1);{}    piepse;{}
+    clear buffer;{}    boxinfo (fenster, anwendungstext (256), 5, maxint);{}    pausenende   := clock (1).{}  registriere pausenueberziehung:{}    pausenueberziehung := pausenende - pausenanfang;{}    trage pausenueberziehung in tabelle ein.{}  trage werkstueckdaten in tabelle ein:{}    REAL VAR bearbeitungsende :: clock (1);{}    tab.tabelle [eintragzaehler].eintragskennung    := werkstueckendekennung;{}    tab.tabelle [eintragzaehler].produktionsfehler  := produktionsfehler;{}    tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{}
+    tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{}    tab.tabelle [eintragzaehler].anfang             := beginn der bearbeitung;{}    tab.tabelle [eintragzaehler].ende               := bearbeitungsende;{}    tab.tabelle [eintragzaehler].differenz          := bearbeitungszeit;{}    erhoehe eintragzaehler;{}    beginn der bearbeitung := clock (1);{}    werkstueckzaehler INCR 1;{}    bedienfehlerzaehler := 0;{}    korrekturzaehler    := 0.{}  trage pausenueberziehung in tabelle ein:{}
+    tab.tabelle [eintragzaehler].eintragskennung    := pausenendekennung;{}    tab.tabelle [eintragzaehler].produktionsfehler  := 0;{}    tab.tabelle [eintragzaehler].anzahl korrekturen := 0;{}    tab.tabelle [eintragzaehler].anzahl bedienfehler:= 0;{}    tab.tabelle [eintragzaehler].anfang             := pausenanfang;{}    tab.tabelle [eintragzaehler].ende               := pausenende;{}    tab.tabelle [eintragzaehler].differenz          := pausenueberziehung;{}    erhoehe eintragzaehler;{}    arbeitsphasenzaehler    INCR 1;{}
+    beginn der bearbeitung  := clock (1);{}    beginn der arbeitsphase := clock (1);{}    bearbeitungslaenge bestimmen.{}  trage simulationsende in tabelle ein:{}    bearbeitungsende := clock (1);{}    tab.tabelle [eintragzaehler].eintragskennung    := simulationsendekennung;{}    tab.tabelle [eintragzaehler].produktionsfehler  := produktionsfehler;{}    tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;{}    tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;{}
+    tab.tabelle [eintragzaehler].anfang             := beginn der bearbeitung;{}    tab.tabelle [eintragzaehler].ende               := bearbeitungsende;{}    tab.tabelle [eintragzaehler].differenz          := bearbeitungszeit;{}    tab.letzter eintrag                             := eintragzaehler.{}  bearbeitungszeit:{}    bearbeitungsende - beginn der bearbeitung.{}  erhoehe eintragzaehler:{}    IF eintragzaehler < maxeintraege{}       THEN eintragzaehler INCR 1{}       ELSE trage simulationsende in tabelle ein;{}
+            errorstop (anwendungstext (254)){}    FI.{}  ermittle ueberziehung der arbeitsphase:{}    arbeitsphasenueberziehung := clock (1) - beginn der arbeitsphase{}                                           - arbeitsphasenlaenge.{}  bearbeitungslaenge bestimmen:{}    arbeitsphasenlaenge := real (aphasendauer * 60){}                                - arbeitsphasenueberziehung{}                                - pausenueberziehung.{}  arbeitsphasenende erreicht:{}    clock (1) - beginn der arbeitsphase >= arbeitsphasenlaenge.{}
+  simulationsende erreicht:{}    arbeitsphasenzaehler = anzahl aphasen AND arbeitsphasenende erreicht.{}END PROC fuehre simulation durch;{}PROC gib bedieninformationen aus (INT CONST zeile):{}  WINDOW VAR f1 :: window ( 2, zeile, 35, 6),{}             f2 :: window (40, zeile, 39, 6);{}  show (f1); show (f2);{}  cursor (f1, 2, 1); out (f1, anwendungstext (11));{}                     out (f1, tastenbezeichnung ( nach rechts));{}  cursor (f1, 2, 2); out (f1, anwendungstext (12));{}                     out (f1, tastenbezeichnung ( nach links));{}
+  cursor (f1, 2, 3); out (f1, anwendungstext (13));{}                     out (f1, tastenbezeichnung ( nach oben));{}  cursor (f1, 2, 4); out (f1, anwendungstext (14));{}                     out (f1, tastenbezeichnung ( nach unten));{}  cursor (f1, 2, 5); out (f1, anwendungstext (15));{}                     out (f1, tastenbezeichnung ( ausbesserung));{}  cursor (f1, 2, 6); out (f1, anwendungstext (16));{}                     out (f1, tastenbezeichnung ( naechstes));{}  cursor (f2, 2, 1); out (f2, anwendungstext (17));{}
+                     out (f2, text (anzahl aphasen, 4));{}  cursor (f2, 2, 2); out (f2, anwendungstext (18));{}                     out (f2, text (aphasendauer,   4));{}                     out (f2, anwendungstext (51));{}  cursor (f2, 2, 3); out (f2, anwendungstext (19));{}                     out (f2, text (pausendauer,    4));{}                     out (f2, anwendungstext (51));{}  cursor (f2, 2, 4); out (f2, anwendungstext ( 5));{}                     out (f2, text (gesamtzeit,      4));{}                     out (f2, anwendungstext (51));{}
+  cursor (f2, 2, 6); out (f2, anwendungstext (251));{}                     out (f2, 3 * blank);{}                     out (f2, fehlerzeichen).{}END PROC gib bedieninformationen aus;{}INT PROC gesamtzeit:{}  anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer{}END PROC gesamtzeit;{}PROC hole werkstueck (WERKSTUECK VAR w, INT VAR anzahl fehler):{}  INT VAR spaltenzaehler, zeilenzaehler;{}  anzahl fehler := 0;{}  FOR zeilenzaehler FROM 1 UPTO hoehe REP{}    ermittle eine zeile{}  PER.{}
+  ermittle eine zeile:{}    FOR spaltenzaehler FROM 1 UPTO breite REP{}      ermittle eine position;{}      ggf fehler registrieren{}    PER.{}  ermittle eine position:{}    w [spaltenzaehler][zeilenzaehler] := zufallscode.{}  zufallscode:{}    random (kleinster code, groesster code).{}  ggf fehler registrieren:{}    IF w [spaltenzaehler][zeilenzaehler] = code (fehlerzeichen){}       THEN anzahl fehler INCR 1{}    FI.{}END PROC hole werkstueck;{}PROC zeige werkstueck (WERKSTUECK CONST w, WINDOW VAR f):{}
+  INT VAR spaltenzaehler, zeilenzaehler;{}  page (f);{}  FOR zeilenzaehler FROM 1 UPTO hoehe REP{}    zeige eine zeile{}  PER.{}  zeige eine zeile:{}    cursor (f, eckspalte, eckzeile + zeilenzaehler - 1);{}    ggf invers einschalten;{}    FOR spaltenzaehler FROM 1 UPTO breite REP{}      out (f, code (w [spaltenzaehler][zeilenzaehler])){}    PER;{}    ggf invers ausschalten.{}  ggf invers einschalten:{}    IF inversdarstellung THEN out (f, markierung ein) FI.{}  ggf invers ausschalten:{}    IF inversdarstellung THEN out (f, markierung aus) FI.{}
+END PROC zeige werkstueck;{}PROC kurzauswertung auf bildschirm (TEXT CONST dateiname):{}  WINDOW VAR fenster :: window (  2, 10, 77, 13);{}  show (fenster);{}  clear buffer;{}  notiere ueberschrift;{}  notiere ergebnis.{}  notiere ueberschrift:{}    cursor (fenster, 1, 1);{}    out (fenster, center (fenster, anwendungstext (275)));{}    cursor (fenster, 1, 2);{}    out (fenster, center (fenster, anwendungstext (276))).{}  notiere ergebnis:{}    BOUND KONTROLLTABELLE CONST k := old (dateiname);{}    ermittle die simulationsdaten;{}
+    notiere gesamtzahl werkstuecke;{}    notiere zeichengesamtzahl;{}    notiere bedienfehler;{}    notiere benoetigte zeit;{}    notiere gesamtausbesserungsrate;{}    notiere gesamtbewertungsfaktor;{}    notiere gesamtbewertungszahl mit pausenueberziehung;{}    cursor (1, 24); out (anwendungstext (2));{}    pause.{}  ermittle die simulationsdaten:{}    INT  VAR z, anzahl zeichen pro werkstueck,{}             anzahl werkstuecke        ::   0,{}             anzahl bedienfehler       ::   0,{}             anzahl produktionsfehler  ::   0,{}
+             anzahl korrekturen        ::   0;{}    REAL VAR gesamtzahl zeichen, anteil korrekturen,{}             gesamtzeit                :: 0.0,{}             pausenueberzug            :: 0.0;{}    FOR z FROM 1 UPTO k.letzter eintrag REP{}      IF   k.tabelle [z].eintragskennung = werkstueckendekennung{}           THEN anzahl werkstuecke       INCR 1;{}                anzahl bedienfehler      INCR k.tabelle [z].anzahl bedienfehler;{}                anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{}
+                anzahl korrekturen       INCR k.tabelle [z].anzahl korrekturen;{}                gesamtzeit               INCR k.tabelle [z].differenz;{}      ELIF k.tabelle [z].eintragskennung = pausenendekennung{}           THEN pausenueberzug           INCR k.tabelle [z].differenz;{}      FI{}    PER;{}    anzahl zeichen pro werkstueck := k.breite * k.hoehe;{}    gesamtzahl zeichen            :=   real (anzahl werkstuecke){}                                     * real (anzahl zeichen pro werkstueck);{}
+    IF anzahl produktionsfehler = 0{}       THEN anteil korrekturen    := 1.0{}       ELSE anteil korrekturen    :=   real (anzahl korrekturen){}                                     / real (anzahl produktionsfehler){}    FI.{}  notiere gesamtzahl werkstuecke:{}    cursor (fenster, 12, 4); out (fenster, anwendungstext (277));{}                             out (fenster, text (anzahl werkstuecke, 8)).{}  notiere zeichengesamtzahl:{}    cursor (fenster, 12, 5); out (fenster, anwendungstext (278));{}                             out (fenster, zahl aus zeichenkette).{}
+  zahl aus zeichenkette:{}    subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{}  notiere bedienfehler:{}    cursor (fenster, 12, 6); out (fenster, anwendungstext (279));{}                             out (fenster, text (anzahl bedienfehler, 8)).{}  notiere benoetigte zeit:{}    cursor (fenster, 12, 7); out (fenster, anwendungstext (280));{}                             out (fenster, text (gesamtzeit,         8, 2)).{}  notiere gesamtausbesserungsrate:{}    cursor (fenster, 12, 9); out (fenster, anwendungstext (281));{}
+                             out (fenster, text (anteil korrekturen, 8, 2)).{}  notiere gesamtbewertungsfaktor:{}    cursor (fenster, 12,10); out (fenster, anwendungstext (282));{}                             out (fenster, text (bewertungsfaktor, 8, 2)).{}  bewertungsfaktor:{}    bewertungsmasszahl (anteil korrekturen).{}  notiere gesamtbewertungszahl mit pausenueberziehung:{}    cursor (fenster, 12, 12); out (fenster, (anwendungstext (283)));{}                              out (fenster, text (gesamtwertung,   8, 2));{}
+    cursor (fenster, 12, 13); out (fenster, (anwendungstext (284)));{}                              out (fenster, 8 * "=").{}  gesamtwertung:{}    IF gesamtzeit = 0.0{}       THEN 0.0{}       ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){}                               * bewertungsfaktor{}    FI.{}END PROC kurzauswertung auf bildschirm;{}PROC simulationsauswertung (TEXT CONST dateiname, BOOL CONST mit zeigen):{}  TEXT CONST auswertdatei :: dateiname + auswertdateipostfix;{}  ermittle die kenndaten aus der protokolldatei (dateiname);{}
+  notiere ueberschrift 1               (auswertdatei);{}  notiere die kenndaten der simulation (auswertdatei);{}  notiere die werkstueckkenndaten      (auswertdatei);{}  notiere ein beispielwerkstueck       (auswertdatei);{}  notiere ueberschrift 2               (auswertdatei);{}  notiere gesamtergebnisse             (auswertdatei, dateiname);{}  notiere ueberschrift 3               (auswertdatei);{}  notiere tabellenkopf                 (auswertdatei);{}  notiere einzelne werkstueckdaten     (auswertdatei, dateiname);{}
+  notiere ggf die anmerkungen;{}  zeige ggf auswertung auf bildschirm.{}  notiere ggf die anmerkungen:{}    IF mit anmerkungen{}       THEN notiere anmerkungen        (auswertdatei);{}    FI.{}  zeige ggf auswertung auf bildschirm:{}    IF mit zeigen{}       THEN cursor on; show (auswertdatei); cursor off{}    FI.{}END PROC simulationsauswertung;{}PROC ermittle die kenndaten aus der protokolldatei (TEXT CONST dateiname):{}  BOUND KONTROLLTABELLE CONST k := old (dateiname);{}  breite                    := k.breite;{}
+  hoehe                     := k.hoehe;{}  kleinster code            := k.kleinster code;{}  groesster code            := k.groesster code;{}  fehlerzeichen             := k.fehlerzeichen;{}  inversdarstellung         := k.inversdarstellung;{}  nach rechts               := k.nach rechts;{}  nach links                := k.nach links;{}  nach oben                 := k.nach oben;{}  nach unten                := k.nach unten;{}  ausbesserung              := k.ausbesserung;{}  naechstes                 := k.naechstes;{}
+  anzahl aphasen            := k.anzahl aphasen;{}  aphasendauer              := k.aphasendauer;{}  pausendauer               := k.pausendauer;{}  datum                     := k.datum;{}  uhrzeit                   := k.uhrzeit;{}  bewertung                 := k.bewertung;{}END PROC ermittle die kenndaten aus der protokolldatei;{}PROC notiere ueberschrift 1 (TEXT CONST auswertdatei):{}  IF exists (auswertdatei){}     THEN forget (auswertdatei, quiet){}  FI;{}  FILE VAR f :: sequential file (output, auswertdatei);{}
+  IF auswertung geht zum drucker{}     THEN schreibe druckeranweisungen{}  FI;{}  putline (f, center (auswertdatei));{}  putline (f, center (length (auswertdatei) * "="));{}  put (f, anwendungstext (272)); put (f, datum); put (f, 26 * blank);{}  put (f, anwendungstext (273)); putline (f, uhrzeit);{}  line (f);{}  putline (f, center (anwendungstext (291)));{}  putline (f, center (length (anwendungstext (291)) * "=")).{}  schreibe druckeranweisungen:{}    write (f, "#type (""");{}    write (f, protokollschrifttyp);{}
+    write (f, """)##limit (");{}    write (f, text (schreibfeldbreite));{}    write (f, ")##pagelength (");{}    write (f, text (schreibfeldlaenge));{}    write (f, ")##start (");{}    write (f, text (xstart));{}    write (f, ",");{}    write (f, text (ystart));{}    write (f, ")#"); line (f).{}END PROC notiere ueberschrift 1;{}PROC notiere ueberschrift 2 (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}  putline (f, center (anwendungstext (285)));{}  putline (f, center (length (anwendungstext (285)) * "=")){}
+END PROC notiere ueberschrift 2;{}PROC notiere ueberschrift 3 (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}  line (f, 2);{}  putline (f, center (anwendungstext (311)));{}  putline (f, center (length (anwendungstext (311)) * "="));{}  line (f){}END PROC notiere ueberschrift 3;{}PROC notiere die kenndaten der simulation (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}  ROW 6 TEXT VAR ausgabe;{}  bestuecke ausgabezeilen;{}  schreibe ausgabezeilen.{}
+  bestuecke ausgabezeilen:{}    ausgabe [1] :=   anwendungstext (11){}                   + gleichlang (tastenbezeichnung (nach rechts ), 23){}                   + anwendungstext (17){}                   + text (anzahl aphasen,   4);{}    ausgabe [2] :=   anwendungstext (12){}                   + gleichlang (tastenbezeichnung (nach links  ), 23){}                   + anwendungstext (18){}                   + text (aphasendauer,     4) + anwendungstext (51);{}    ausgabe [3] :=   anwendungstext (13){}
+                   + gleichlang (tastenbezeichnung (nach oben   ), 23){}                   + anwendungstext (19){}                   + text (pausendauer,      4) + anwendungstext (51);{}    ausgabe [4] :=   anwendungstext (14){}                   + gleichlang (tastenbezeichnung (nach unten  ), 23){}                   + anwendungstext ( 5){}                   + text (simulationsdauer, 4) + anwendungstext (51);{}    ausgabe [5] :=   anwendungstext (15){}                   + gleichlang (tastenbezeichnung (ausbesserung), 23);{}
+    ausgabe [6] :=   anwendungstext (16){}                   + gleichlang (tastenbezeichnung (naechstes   ), 23){}                   + anwendungstext (251){}                   + (3 * blank) + fehlerzeichen.{}  simulationsdauer:{}    anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer.{}  schreibe ausgabezeilen:{}    INT VAR i;{}    FOR i FROM 1 UPTO 6 REP{}      putline (f, ausgabe [i]){}    PER;{}    line (f).{}END PROC notiere die kenndaten der simulation;{}PROC notiere die werkstueckkenndaten (TEXT CONST auswertdatei):{}
+  FILE VAR f :: sequential file (output, auswertdatei);{}  ROW 4 TEXT VAR ausgabe;{}  bestuecke ausgabezeilen;{}  schreibe ausgabezeilen.{}  bestuecke ausgabezeilen:{}    ausgabe [1] :=  anwendungstext (292) + text (breite,        4) +{}                    anwendungstext (296);{}    ausgabe [2] :=  anwendungstext (293) + text (hoehe,          4) +{}                    anwendungstext (296);{}    ausgabe [3] :=  anwendungstext (294) + text (breite * hoehe, 4) +{}                    anwendungstext (296);{}
+    ausgabe [4] :=  anwendungstext (295) + zeichenumfang.{}  zeichenumfang:{}    " " + code (kleinster code) + " ... " + code (groesster code) +{}    " (" + text (groesster code - kleinster code + 1, 3) +{}    anwendungstext (296) + ")".{}  schreibe ausgabezeilen:{}    INT VAR i;{}    FOR i FROM 1 UPTO 4 REP putline (f, ausgabe [i]) PER;{}    line (f).{}END PROC notiere die werkstueckkenndaten;{}PROC notiere ein beispielwerkstueck (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}
+  WERKSTUECK VAR beispiel;{}  INT VAR beispielfehler;{}  hole werkstueck (beispiel, beispielfehler);{}  notiere ueberschrift;{}  notiere werkstueckzeilen;{}  notiere werkstueckleerzeilen.{}  notiere ueberschrift:{}    putline (f, center (anwendungstext (297)));{}    putline (f, center (length (anwendungstext (297)) * "-")).{}  notiere werkstueckzeilen:{}    INT VAR bs, bz;{}    FOR bz FROM 1 UPTO hoehe REP{}      notiere eine zeile{}    PER.{}  notiere eine zeile:{}    TEXT VAR beispielzeile :: "";{}
+    konstruiere beispielzeile;{}    gib beispielzeile aus.{}  konstruiere beispielzeile:{}    beispielzeile CAT (((80 - breite) DIV 2) * blank);{}    FOR bs FROM 1 UPTO breite REP{}      beispielzeile CAT code (beispiel [bs][bz]){}    PER.{}  gib beispielzeile aus:{}    putline (f, beispielzeile).{}  notiere werkstueckleerzeilen:{}    line (f, maxzeilen - hoehe + 1).{}END PROC notiere ein beispielwerkstueck;{}PROC notiere gesamtergebnisse (TEXT CONST auswertdatei, protokolldatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}
+  BOUND KONTROLLTABELLE CONST k :: old (protokolldatei);{}  ermittle die simulationsdaten;{}    notiere gesamtzahl werkstuecke;{}    notiere anzahl zeichen pro werkstueck;{}    notiere zeichengesamtzahl;{}    notiere bedienfehler;{}    notiere produktionsfehlerzahl;{}    notiere fehlerkorrekturen;{}    notiere gesamtzeit mit pausenueberziehung;{}    notiere zeichenzahl pro sekunde mit;{}    notiere gesamtausbesserungsrate;{}    notiere gesamtbewertungsfaktor  mit;{}    notiere gesamtbewertungszahl    mit;{}
+    notiere gesamtzeit ohne pausenueberziehung;{}    notiere zeichenzahl pro sekunde ohne;{}    notiere gesamtbewertungszahl    ohne.{}  ermittle die simulationsdaten:{}    INT  VAR z, anzahl zeichen pro werkstueck,{}             anzahl werkstuecke        ::   0,{}             anzahl bedienfehler       ::   0,{}             anzahl produktionsfehler  ::   0,{}             anzahl korrekturen        ::   0;{}    REAL VAR gesamtzahl zeichen, anteil korrekturen,{}             gesamtzeit                :: 0.0,{}
+             pausenueberzug            :: 0.0;{}    FOR z FROM 1 UPTO k.letzter eintrag REP{}      IF   k.tabelle [z].eintragskennung = werkstueckendekennung{}           THEN anzahl werkstuecke       INCR 1;{}                anzahl bedienfehler      INCR k.tabelle [z].anzahl bedienfehler;{}                anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;{}                anzahl korrekturen       INCR k.tabelle [z].anzahl korrekturen;{}                gesamtzeit               INCR k.tabelle [z].differenz;{}
+      ELIF k.tabelle [z].eintragskennung = pausenendekennung{}           THEN pausenueberzug           INCR k.tabelle [z].differenz;{}      FI{}    PER;{}    anzahl zeichen pro werkstueck := k.breite * k.hoehe;{}    gesamtzahl zeichen            :=   real (anzahl werkstuecke){}                                     * real (anzahl zeichen pro werkstueck);{}    IF anzahl produktionsfehler = 0{}       THEN anteil korrekturen    := 1.0{}       ELSE anteil korrekturen    :=   real (anzahl korrekturen){}
+                                     / real (anzahl produktionsfehler){}    FI.{}  notiere gesamtzahl werkstuecke:{}    put (f, anwendungstext (277)); putline (f, text (anzahl werkstuecke, 8)).{}  notiere anzahl zeichen pro werkstueck:{}    put (f, anwendungstext (286)); putline (f, text (breite * hoehe,     8)).{}  notiere zeichengesamtzahl:{}    put (f, anwendungstext (278)); putline (f, zahl aus zeichenkette);{}    line (f).{}  zahl aus zeichenkette:{}    subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).{}
+  notiere produktionsfehlerzahl:{}    put (f, anwendungstext (287)); putline (f, text (anzahl produktionsfehler, 8)).{}  notiere fehlerkorrekturen:{}    put (f, anwendungstext (288)); putline (f, text (anzahl korrekturen, 8)).{}  notiere bedienfehler:{}    put (f, anwendungstext (279)); putline (f, text (anzahl bedienfehler,8));{}    line (f).{}  notiere gesamtzeit mit pausenueberziehung:{}    put (f, anwendungstext (301)); put (f, text (gesamtzeit mit, 8, 1));{}    putline (f, anwendungstext (300)).{}
+  gesamtzeit mit:{}    gesamtzeit + pausenueberzug.{}  notiere zeichenzahl pro sekunde mit:{}    put (f, anwendungstext (302));{}    putline (f, text (zeichenpro sec mit, 8, 1));{}    line (f).{}  zeichen pro sec mit:{}    IF gesamtzeit + pausenueberzug > 0.0{}       THEN gesamtzahl zeichen / (gesamtzeit + pausenueberzug){}       ELSE 0.0{}    FI.{}  notiere gesamtausbesserungsrate:{}    put (f, anwendungstext (281)); putline (f, text (anteil korrekturen, 8, 1)).{}  notiere gesamtbewertungsfaktor mit:{}
+    put (f, anwendungstext (282)); putline (f, text (bewertungsfaktor, 8, 1));{}    line (f).{}  bewertungsfaktor:{}    bewertungsmasszahl (anteil korrekturen).{}  notiere gesamtbewertungszahl mit:{}    put (f, (anwendungstext (283))); putline (f, text (gesamtwertung mit,   8, 1));{}    put (f, (anwendungstext (284))); putline (f, 8 * "=").{}  gesamtwertung mit:{}    IF gesamtzeit = 0.0{}       THEN 0.0{}       ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug){}                               * bewertungsfaktor{}
+    FI.{}  notiere gesamtzeit ohne pausenueberziehung:{}    put (f, anwendungstext (303)); put (f, text (gesamtzeit, 8, 1));{}    putline (f, anwendungstext (300)).{}  notiere zeichenzahl pro sekunde ohne:{}    put (f, anwendungstext (302));{}    putline (f, text (zeichenpro sec ohne, 8, 1)).{}  zeichen pro sec ohne:{}    IF gesamtzeit > 0.0{}       THEN gesamtzahl zeichen / gesamtzeit{}       ELSE 0.0{}    FI.{}  notiere gesamtbewertungszahl ohne:{}    put (f, (anwendungstext (304))); putline (f, text (gesamtwertung ohne,   8, 1));{}
+    put (f, (anwendungstext (284))); putline (f, 8 * "=").{}  gesamtwertung ohne:{}    IF gesamtzeit = 0.0{}       THEN 0.0{}       ELSE gesamtzahl zeichen / gesamtzeit * bewertungsfaktor{}    FI.{}END PROC notiere gesamtergebnisse;{}PROC notiere tabellenkopf (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}  putline (f, anwendungstext (312));{}  putline (f, anwendungstext (313));{}  putline (f, anwendungstext (314));{}  putline (f, anwendungstext (315));{}  putline (f, anwendungstext (316));{}
+  putline (f, anwendungstext (317));{}  putline (f, anwendungstext (318));{}END PROC notiere tabellenkopf;{}PROC notiere einzelne werkstueckdaten (TEXT CONST auswertdatei, dateiname):{}  BOUND KONTROLLTABELLE CONST k :: old (dateiname);{}  FILE VAR f :: sequential file (output, auswertdatei);{}  INT  VAR zeiger, werkstuecknummer :: 0;{}  TEXT VAR ausgabezeile :: "";{}  FOR zeiger FROM 1 UPTO k.letzter eintrag REP{}   notiere bearbeitungszeile{}  PER.{}  notiere bearbeitungszeile:{}    IF   k.tabelle [zeiger].eintragskennung = werkstueckendekennung{}
+         THEN werkstuecknummer INCR 1;{}              schreibe werkstueckzeile{}    ELIF k.tabelle [zeiger].eintragskennung = pausenendekennung{}         THEN schreibe pausenzeile{}    ELIF k.tabelle [zeiger].eintragskennung = simulationsendekennung{}         THEN werkstuecknummer INCR 1;{}              schreibe abschluss{}    ELSE putline (f, 75 * "?"){}    FI.{}  schreibe werkstueckzeile:{}    konstruiere ausgabezeile;{}    putline (f, ausgabezeile).{}  konstruiere ausgabezeile:{}    ausgabezeile := "";{}
+    ausgabezeile CAT text (werkstuecknummer, 5);{}    ausgabezeile CAT 2 * blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (k.tabelle [zeiger].anzahl bedienfehler, 5);{}    ausgabezeile CAT 3 * blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (k.tabelle [zeiger].produktionsfehler,   6);{}    ausgabezeile CAT 2 * blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (k.tabelle [zeiger].anzahl korrekturen,  6);{}    ausgabezeile CAT 2 * blank;{}    ausgabezeile CAT trenn;{}
+    ausgabezeile CAT text (k.tabelle [zeiger].differenz,  6, 1);{}    ausgabezeile CAT blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (zeichen pro zeiteinheit,  6, 1);{}    ausgabezeile CAT blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (einzelausbesserungsrate,  6, 1);{}    ausgabezeile CAT blank;{}    ausgabezeile CAT trenn;{}    ausgabezeile CAT text (bewertungsmasszahl (einzelausbesserungsrate), 6, 1);{}    ausgabezeile CAT blank;{}    ausgabezeile CAT trenn;{}
+    ausgabezeile CAT text (endbewertungszahl, 6, 1);{}    ausgabezeile CAT blank.{}  zeichen pro zeiteinheit:{}    real (breite * hoehe) / k.tabelle [zeiger].differenz.{}  einzelausbesserungsrate:{}    IF k.tabelle [zeiger].produktionsfehler = 0{}       THEN 0.0{}       ELSE   real (k.tabelle [zeiger].anzahl korrekturen){}            / real (k.tabelle [zeiger].produktionsfehler ){}    FI.{}  endbewertungszahl:{}    real (breite * hoehe) / k.tabelle [zeiger].differenz{}                          * bewertungsmasszahl (einzelausbesserungsrate).{}
+  schreibe pausenzeile:{}    line (f);{}    put     (f, anwendungstext (320));{}    put     (f, text (k.tabelle [zeiger].differenz, 6, 1));{}    putline (f, anwendungstext (300));{}    line (f).{}  schreibe abschluss:{}    putline (f, anwendungstext (318));{}    putline (f, anwendungstext (319));{}    line (f);{}    konstruiere ausgabezeile;{}    ausgabezeile := "(" +{}                    subtext (ausgabezeile, 2, length (ausgabezeile) - 1) +{}                    ")";{}    putline (f, ausgabezeile).{}
+END PROC notiere einzelne werkstueckdaten;{}PROC notiere anmerkungen (TEXT CONST auswertdatei):{}  FILE VAR f :: sequential file (output, auswertdatei);{}  line (f);{}  schreibe kopf;{}  schreibe hinweis auf letztes werkstueck;{}  schreibe hinweis auf bedienfehler;{}  erlaeutere bewertungsschluessel;{}  stelle bewertungsschluessel graphisch dar;{}  schreibe rest.{}  schreibe kopf:{}    putline (f, center (anwendungstext (325)));{}    putline (f, center (length (anwendungstext (325)) * "="));{}    line (f).{}
+  schreibe hinweis auf letztes werkstueck:{}    INT VAR i;{}    FOR i FROM 326 UPTO 337 REP{}      putline (f, anwendungstext (i)){}    PER;{}    line (f).{}  schreibe hinweis auf bedienfehler:{}    FOR i FROM 339 UPTO 341 REP{}      putline (f, anwendungstext (i)){}    PER;{}    line (f).{}  erlaeutere bewertungsschluessel:{}    FOR i FROM 343 UPTO 372 REP{}      putline (f, anwendungstext (i)){}    PER.{}  stelle bewertungsschluessel graphisch dar:{}    putline (f, anwendungstext (374));{}    putline (f, anwendungstext (375));{}
+    ermittle die startposition;{}    zeichne diagramm;{}    trage werte ein.{}  ermittle die startposition:{}    modify (f);{}    INT VAR zeilenpos :: lines (f) + 2, spaltenpos :: 18.{}  zeichne diagramm:{}    cursor (f, spaltenpos, zeilenpos     , anwendungstext (20));{}    cursor (f, spaltenpos, zeilenpos +  1, anwendungstext (21));{}    cursor (f, spaltenpos, zeilenpos +  3, anwendungstext (23));{}    cursor (f, spaltenpos, zeilenpos +  4, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos +  5, anwendungstext (22));{}
+    cursor (f, spaltenpos, zeilenpos +  6, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos +  7, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos +  8, anwendungstext (24));{}    cursor (f, spaltenpos, zeilenpos +  9, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos + 10, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos + 11, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos + 12, anwendungstext (22));{}    cursor (f, spaltenpos, zeilenpos + 13, anwendungstext (25));{}
+    cursor (f, spaltenpos, zeilenpos + 14, anwendungstext (26));{}    cursor (f, spaltenpos, zeilenpos + 15, anwendungstext (27)).{}  trage werte ein:{}    zeilenpos INCR 13;{}    INT VAR bwzeiger;{}    FOR bwzeiger FROM 1 UPTO 11 REP{}      cursor (f, spaltenpos + 3 * bwzeiger, zeilenpos - konkreter wert, "+"){}    PER.{}  konkreter wert:{}    int (bewertung [bwzeiger] * 10.0).{}  schreibe rest:{}    output (f);{}    line (f, 2);{}    FOR i FROM 377 UPTO 387 REP{}      putline (f, anwendungstext (i)){}
+    PER;{}    haenge an jede zeile ein blank an.{}  haenge an jede zeile ein blank an:{}    TEXT VAR inhalt;{}    INT  VAR zeilenzeiger;{}    modify (f);{}    FOR zeilenzeiger FROM 1 UPTO lines (f) REP{}      to line (f, zeilenzeiger);{}      read record (f, inhalt);{}      inhalt CAT blank;{}      write record (f, inhalt){}    PER;{}    to line (f,1).{}END PROC notiere anmerkungen;{}PROC cursor (FILE VAR f, INT CONST spa, zei, TEXT CONST text):{}  positioniere an zeile;{}  positioniere an spalte;{}
+  gib text an position aus.{}  positioniere an zeile:{}    IF zeile noch nicht vorhanden{}       THEN schaffe zeile und gehe dorthin{}       ELSE to line (f,zei){}    FI.{}  zeile noch nicht vorhanden:{}    zei > lines (f).{}  schaffe zeile und gehe dorthin:{}    INT VAR zaehler 1;{}    IF lines (f) = 0{}       THEN to line (f,lines (f));{}            insert record (f);{}    FI;{}    FOR zaehler 1 FROM lines (f)  UPTO zei REP{}      to line (f,lines (f));{}      down (f);insert record (f){}    PER;{}
+    to line(f,zei).{}  positioniere an spalte:{}    TEXT VAR alter satz :: "", neuer satz :: "", restsatz ::"";{}    INT VAR satzlaenge;{}    read record (f,alter satz);{}    satzlaenge := length (alter satz);{}    IF satzlaenge = 0{}       THEN neuer satz CAT (spa -1) * " "{}    ELIF satzlaenge >= spa{}       THEN neuer satz := subtext(alter satz,1,spa-1);{}            restsatz   := subtext(alter satz, spa + length (text));{}       ELSE neuer satz := alter satz;{}            neuer satz CAT (spa - satzlaenge - 1) * " "{}
+    FI.{}  gib text an position aus:{}   neuer satz CAT text;{}   IF restsatz <> ""{}      THEN neuer satz CAT restsatz{}   FI;{}   write record(f,neuer satz).{} END PROC cursor;{}TEXT PROC gleichlang (TEXT CONST text, INT CONST laenge):{}  TEXT VAR intern :: compress (text);{}  INT  VAR anzahl :: laenge - length (intern);{}  IF anzahl < 0{}     THEN subtext (intern, 1, laenge){}     ELSE intern + (anzahl * blank){}  FI{}END PROC gleichlang;{}REAL PROC bewertungsmasszahl (REAL CONST wert):{}  REAL VAR interner wert := round (wert, 1);{}
+  IF interner wert > wert{}     THEN interner wert DECR 0.1{}  FI;{}  interpoliere.{}  interpoliere:{}    REAL VAR unterer wert, oberer wert;{}    unterer wert := interner wert;{}    IF unterer wert = 1.0{}       THEN oberer wert := 1.0{}       ELSE oberer  wert := unterer wert + 0.1{}    FI;{}    unterer wert := bewertung (int (unterer wert * 10.0) + 1);{}    oberer  wert := bewertung (int (oberer  wert * 10.0) + 1);{}    unterer wert + (oberer wert - unterer wert) * faktor.{}  faktor:{}    frac (wert * 10.0).{}
+END PROC bewertungsmasszahl;{}PROC zeige aktuellen protokollumfang an:{}  WINDOW VAR w :: window (2, 2, 34,  5);{}  show (w);{}  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{}  IF mit anmerkungen{}     THEN cursor (w, 2, 4); out (w, anwendungstext (432)){}     ELSE cursor (w, 2, 4); out (w, anwendungstext (433));{}  FI.{}END PROC zeige aktuellen protokollumfang an;{}PROC gib erlaeuterungen zum protokollumfang:{}  WINDOW VAR f :: window ( 2, 9, 77, 15);{}  show (f);{}  cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (434))));{}
+  cursor (f, 5, 3); out (f, anwendungstext (435));{}  cursor (f, 5, 4); out (f, anwendungstext (436));{}  cursor (f, 5, 5); out (f, anwendungstext (437));{}  cursor (f, 5, 6); out (f, anwendungstext (438));{}  cursor (f, 5, 8); out (f, anwendungstext (439));{}  cursor (f, 5, 9); out (f, anwendungstext (440));{}  cursor (f, 5,10); out (f, anwendungstext (441));{}  cursor (f, 5,11); out (f, anwendungstext (442));{}  cursor (f, 5,13); out (f, anwendungstext (443));{}  cursor (f, 5,14); out (f, anwendungstext (444));{}
+END PROC gib erlaeuterungen zum protokollumfang;{}PROC frage nach umfangsaenderung:{}  WINDOW VAR fenster :: window (38, 2, 41, 5);{}  show (fenster);{}  cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (451))));{}  cursor (fenster, 4, 3); out (fenster, anwendungstext (452));{}  cursor (fenster, 4, 4);{}  IF yes (fenster, anwendungstext (453)){}     THEN  mit anmerkungen := NOT mit anmerkungen{}  FI.{}END PROC frage nach umfangsaenderung;{}PROC zeige aktuelle kurzauswertungseinstellung an:{}
+  WINDOW VAR w :: window ( 2, 2, 34,  5);{}  show (w);{}  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));{}  IF mit kurzprotokoll{}     THEN cursor (w, 7, 4); out (w, anwendungstext (461));{}     ELSE cursor (w, 7, 4); out (w, anwendungstext (462));{}  FI.{}END PROC zeige aktuelle kurzauswertungseinstellung an;{}PROC gib erlaeuterungen zur kurzauswertung:{}  WINDOW VAR f :: window ( 2, 9, 77, 15);{}  show (f);{}  cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (463))));{}
+  cursor (f, 5, 3); out (f, anwendungstext (464));{}  cursor (f, 5, 4); out (f, anwendungstext (465));{}  cursor (f, 5, 5); out (f, anwendungstext (466));{}  cursor (f, 5, 6); out (f, anwendungstext (467));{}  cursor (f, 5, 8); out (f, anwendungstext (468));{}  cursor (f, 5, 9); out (f, anwendungstext (469));{}  cursor (f, 5,10); out (f, anwendungstext (470));{}  cursor (f, 5,11); out (f, anwendungstext (471));{}  cursor (f, 5,13); out (f, anwendungstext (472));{}  cursor (f, 5,14); out (f, anwendungstext (473));{}
+END PROC gib erlaeuterungen zur kurzauswertung;{}PROC frage nach kurzauswertungsaenderung:{}  WINDOW VAR fenster :: window (38, 2, 41, 5);{}  show (fenster);{}  cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (481))));{}  cursor (fenster, 5, 3); out (fenster, anwendungstext (482));{}  cursor (fenster, 5, 4);{}  IF yes (fenster, anwendungstext (483)){}     THEN  mit kurzprotokoll := NOT mit kurzprotokoll{}  FI.{}END PROC frage nach kurzauswertungsaenderung;{}END PACKET ls mp bap 2;{}
+
diff --git a/app/gs.mp-bap/1.1/src/ls-MP BAP-gen b/app/gs.mp-bap/1.1/src/ls-MP BAP-gen
new file mode 100644
index 0000000..26a84c3
--- /dev/null
+++ b/app/gs.mp-bap/1.1/src/ls-MP BAP-gen
@@ -0,0 +1,30 @@
+                                             (*****************************) 
+                                             (*                           *) 
+                                             (*         ls-MP BAP         *) 
+                                             (*     GENERATORPROGRAMM     *) 
+                                             (*                           *) 
+                                             (* (c) 1987  (01.09.87)      *) 
+                                             (*     by Eva Latta          *) 
+                                             (*        Bielefeld          *) 
+                                             (*****************************) 
+LET mm taskname   = "ls-MENUKARTEN", 
+    eigener name  = "ls-MP BAP/gen", 
+    datei1        = "ls-MP BAP 1", 
+    datei2        = "ls-MP BAP 2", 
+    menukarte     = "ls-MENUKARTE:MP-BAP"; 
+ 
+PROC stelle existenz des mm sicher: 
+  cursor (1, 5); out (""4""); 
+  IF NOT exists (task (mm taskname)) 
+     THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!"); 
+  FI 
+END PROC stelle existenz des mm sicher; 
+ 
+PROC vom archiv (TEXT CONST datei): 
+  cursor (1,5); out (""4""); 
+  out ("  """); out (datei); putline (""" wird geholt.");{}  fetch (datei, archive){}END PROC vom archiv;{}PROC hole (TEXT CONST datei):{}  IF NOT exists (datei) THEN vom archiv (datei) FI{}END PROC hole;{}PROC in (TEXT CONST datei):{}  hole (datei);{}  cursor (1, 5); out (""4"");{}  out ("  """); out (datei); out (""" wird übersetzt: ");{}  insert (datei);{}  forget (datei, quiet);{}END PROC in;{}PROC schicke (TEXT CONST datei):{}  cursor (1, 5); out (""4"");{}  out ("  """); out(datei);{}  out (""" wird zum MENUKARTEN-MANAGER geschickt!");{}
+  command dialogue (FALSE);{}  save (datei, task (mm taskname));{}  command dialogue (TRUE);{}  forget (datei, quiet){}END PROC schicke;{}INT VAR size, used;{}BOOL VAR einzeln;{}storage (size, used);{}einzeln := size - used < 500;{}forget (eigener name, quiet);{}wirf kopfzeile aus;{}stelle existenz des mm sicher;{}hole die dateien;{}insertiere die dateien;{}mache global manager aus der task.{}wirf kopfzeile aus:{}  page;{}  putline ("                  "15"ls-MP BAP  -  Automatische Generierung "14"").{}
+hole die dateien:{}  IF     NOT exists (datei 1){}     COR NOT exists (datei 2){}     COR NOT exists (menukarte){}     THEN hole dateien vom archiv; LEAVE hole die dateien{}  FI.{}hole dateien vom archiv:{}  cursor (1,3); out (""4"");{}  IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt"){}     THEN lese ein{}     ELSE line (2);{}          errorstop ("Ohne die Diskette kann ich das System nicht generieren!"){}  FI.{}lese ein:{}  cursor (1, 3); out (""4"");{}  out ("                   "15"Bitte die Diskette eingelegt lassen! "14"");{}
+  IF NOT einzeln{}     THEN  hole (datei 1);{}           hole (datei 2);{}           hole (menukarte);{}           cursor (1, 3); out(""4"");{}           out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");{}           release (archive){}  FI.{}insertiere die dateien:{}  check off;{}  cursor (1, 3); out(""4"");{}  out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");{}  in (datei 1);{}  in (datei 2);{}  schicke (menukarte);{}  IF einzeln THEN release (archive) FI;{}
+  check on.{}mache global manager aus der task:{}  global manager.{}
+
diff --git a/doc/prozess/Anhang Prozess b/app/gs.process/1.02/doc/Anhang Prozess
index 8415268..8415268 100644
--- a/doc/prozess/Anhang Prozess
+++ b/app/gs.process/1.02/doc/Anhang Prozess
diff --git a/doc/prozess/Inhalt Prozess b/app/gs.process/1.02/doc/Inhalt Prozess
index ab9616a..ab9616a 100644
--- a/doc/prozess/Inhalt Prozess
+++ b/app/gs.process/1.02/doc/Inhalt Prozess
diff --git a/doc/prozess/gs-Prozess handbuch.impressum b/app/gs.process/1.02/doc/gs-Prozess handbuch.impressum
index ca22b10..ca22b10 100644
--- a/doc/prozess/gs-Prozess handbuch.impressum
+++ b/app/gs.process/1.02/doc/gs-Prozess handbuch.impressum
diff --git a/doc/prozess/gs-Prozess-2 b/app/gs.process/1.02/doc/gs-Prozess-2
index 376143e..376143e 100644
--- a/doc/prozess/gs-Prozess-2
+++ b/app/gs.process/1.02/doc/gs-Prozess-2
diff --git a/doc/prozess/gs-Prozess-3 b/app/gs.process/1.02/doc/gs-Prozess-3
index 3fae1bd..3fae1bd 100644
--- a/doc/prozess/gs-Prozess-3
+++ b/app/gs.process/1.02/doc/gs-Prozess-3
diff --git a/doc/prozess/gs-Prozess-4 b/app/gs.process/1.02/doc/gs-Prozess-4
index e106df1..e106df1 100644
--- a/doc/prozess/gs-Prozess-4
+++ b/app/gs.process/1.02/doc/gs-Prozess-4
diff --git a/doc/prozess/gs-prozess-1 b/app/gs.process/1.02/doc/gs-prozess-1
index f6a3696..f6a3696 100644
--- a/doc/prozess/gs-prozess-1
+++ b/app/gs.process/1.02/doc/gs-prozess-1
diff --git a/doc/prozess/gs-prozess-5 b/app/gs.process/1.02/doc/gs-prozess-5
index 5c44f29..5c44f29 100644
--- a/doc/prozess/gs-prozess-5
+++ b/app/gs.process/1.02/doc/gs-prozess-5
diff --git a/doc/prozess/gs-prozess-6 b/app/gs.process/1.02/doc/gs-prozess-6
index a3835cd..a3835cd 100644
--- a/doc/prozess/gs-prozess-6
+++ b/app/gs.process/1.02/doc/gs-prozess-6
diff --git a/doc/prozess/gs-prozess-7 b/app/gs.process/1.02/doc/gs-prozess-7
index db3b9d1..db3b9d1 100644
--- a/doc/prozess/gs-prozess-7
+++ b/app/gs.process/1.02/doc/gs-prozess-7
diff --git a/doc/prozess/gs-prozess-8 b/app/gs.process/1.02/doc/gs-prozess-8
index c36ccc9..c36ccc9 100644
--- a/doc/prozess/gs-prozess-8
+++ b/app/gs.process/1.02/doc/gs-prozess-8
diff --git a/doc/prozess/gs-prozess-9 b/app/gs.process/1.02/doc/gs-prozess-9
index 6551b01..6551b01 100644
--- a/doc/prozess/gs-prozess-9
+++ b/app/gs.process/1.02/doc/gs-prozess-9
diff --git a/app/gs.process/1.02/source-disk b/app/gs.process/1.02/source-disk
new file mode 100644
index 0000000..df52516
--- /dev/null
+++ b/app/gs.process/1.02/source-disk
@@ -0,0 +1 @@
+informatikpaket/04_gs.propess.img
diff --git a/prozess/ls-MENUKARTE:Prozess b/app/gs.process/1.02/src/ls-MENUKARTE:Prozess
index 9a2e009..9a2e009 100644
--- a/prozess/ls-MENUKARTE:Prozess
+++ b/app/gs.process/1.02/src/ls-MENUKARTE:Prozess
diff --git a/app/gs.process/1.02/src/ls-Prozess 1 für AKTRONIC-Adapter b/app/gs.process/1.02/src/ls-Prozess 1 für AKTRONIC-Adapter
new file mode 100644
index 0000000..c42cfa5
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 1 für AKTRONIC-Adapter
@@ -0,0 +1,57 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 1                     ** 
+         **                                                      ** 
+         **            Anpassung für AKTRONIC-Adapter            ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 26.01.90)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls prozess 1 DEFINES                   
+       run pdv,{}       run pdv again,{}       initialisiere interface,{}       schalte alles aus,{}       ausgeben,{}       eingabe,{}       warte,{}       abbruch gewuenscht,{}       tue nichts,{}       trage kanaldaten ein,{}       beende kanaldaten eintragen,{}       hole spannungsbereich,{}       letzte ausgabe,{}       pruefe kanal,{}       pruefe abbruch,{}       teste interface,{}       oeffne interface,{}       schliesse interface,{}       nicht belegt,{}       digital aus,{}       analog aus,{}
+       digital ein,{}       analog ein,{}       kanalbreite,{}       ganzzahl obergrenze,{}       adapterart,{}    (* ------------------------- *){}       kanalkoppler,{}       interface kanal,{}       oeffne interface direkt,{}       schliesse interface direkt,{}       initialisiere interface direkt,{}       direkt ausgeben,{}       direkt eingabe:{}(******** A N P A S S U N G  A N  A K T R O N I C - A D A P T E R ********){}LET interface test  code = ""240"",{}    interface open  code = ""176"",{}
+    interface close code = ""176"",{}    adresse 0 code       = ""176"",{}    interface write code =    64  ,{}    interface read  code =   192  ;{}TEXT CONST adapterart :: "AKTRONIC-Adapter";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{}  IF   es ist ein ausgabekanal{}       THEN code (interface write code + device + faktor * steuerungscode){}  ELIF es ist ein eingabekanal{}       THEN lesecode in abhaengigkeit von der taktzahl{}       ELSE ""{}  FI.{}  es ist ein ausgabekanal:{}
+    kanal [kanalnummer].betriebsart < 0.{}  es ist ein eingabekanal:{}    kanal [kanalnummer].betriebsart > 0.{}  device:{}    IF steckplatznummer < 3{}       THEN 16{}       ELSE 32{}    FI.{}  faktor:{}    IF steckplatznummer MOD 2 = 0{}       THEN 4{}       ELSE 1{}    FI.{}  steckplatznummer:{}    IF kanalnummer < 10{}       THEN 1{}       ELSE kanalnummer DIV 10{}    FI.{}  lesecode in abhaengigkeit von der taktzahl:{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1: code fuer digital oder analog eingang{}
+      CASE 2: code fuer kombi e1{}      CASE 3: code fuer kombi e2{}    OTHERWISE "" END SELECT.{}  code fuer digital oder analog eingang:{}    IF kanal [kanalnummer].betriebsart = analog ein{}       THEN kanal [kanalnummer].taktzahl := 2;  (* ad wandler muss hier *){}            lesecode + lesecode                 (* 2x gelesen werden!   *){}       ELSE lesecode{}    FI.{}  lesecode  :  code (interface read code + device + faktor * steuerungscode).{}  code fuer kombi e1:{}    kanal [kanalnummer].taktzahl INCR 1; (* bei Analogport1 der Kombikarte *){}
+    adresse 0 code + (3 * lesecode).     (* sind hier 3 Takte     noetig ! *){}  code fuer kombi e2:{}    kanal [kanalnummer].taktzahl DECR 1;     (* hier nur 2 Takte noetig ! *){}    adresse 0 code + lesecode + lesecode.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************){}LET       max kanalanzahl          =   49,{}          initcode                 =   50,{}          endcode                  =   51,{}          alles aus code           =   52,{}
+          endezeichen              =  "q",{}          abbruchzeichen           =  "h",{}          esc                      =  ""27"";{}INT CONST analog aus               ::  -2,            (* Betriebsarten *){}          digital aus              ::  -1,{}          nicht belegt             ::   0,{}          digital ein              ::   1,{}          analog  ein              ::   2,{}          kanalbreite              ::   8,{}          ganzzahl obergrenze      ::   2 ** kanalbreite,{}          configuration error code ::  -1,{}
+          kanal besetzt code       ::  -3,{}          interface error code     ::  -4,{}          not init code            ::  -5;{}INT VAR   interfacechannel         ::   2,{}          dummy;{}TEXT VAR  meldung                  ::  "";{}BOOL VAR  kanaldaten sind eingetragen :: FALSE,{}          endezeichen gegeben         :: FALSE,{}          programm mit pdv gestartet  :: FALSE,{}          fehler zu melden            :: FALSE;{}TASK VAR  interface task              :: niltask;{}DATASPACE VAR  ds :: nilspace;{}
+TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),{}     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT      VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL    VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{}  ("Interface ist noch nicht konfiguriert!",{}   "Interface-Task ist besetzt!",{}   "Interface-Kanal ist belegt!",{}   "Interface meldet sich nicht!",{}   "Interface kann nicht geöffnet werden!");{}
+PROC run pdv:{}  run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{}  enable stop;{}  last param (programmname);{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run (programmname);{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}     THEN errorstop (meldung){}  FI{}END PROC run pdv;{}PROC run pdv again:{}
+  enable stop;{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run again;{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}     THEN errorstop (meldung){}  FI{}END PROC run pdv again;{}PROC melde programmende:{}  page;{}  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{}  pause;{}  schalte alles aus{}END PROC melde programmende;{}
+PROC initialisiere interface:{}  enable stop;{}  pruefe abbruch;{}  IF programm mit pdv gestartet{}     THEN schalte alles aus{}     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){}  FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{}  INT VAR k;{}  FOR k FROM 1 UPTO max kanalanzahl REP{}    vorherige ausgabe [k] := 0{}  PER;{}  forget (ds); ds := nilspace;{}  call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{}
+  merke wert;{}  gib wert aus.{}  merke wert:{}    vorherige ausgabe [kanalnummer] := wert.{}  gib wert aus:{}    call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{}  INT VAR eingabewert;{}  call (interface task, kanalnummer, ds, eingabewert);{}  eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (int (sekunden * 10.0 + 0.5));{}  IF eingabe = esc{}
+     THEN untersuche naechstes zeichen{}  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (sekunden * 10);{}  IF eingabe = esc{}     THEN untersuche naechstes zeichen{}
+  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{}  pruefe abbruch;{}  BOOL VAR entscheidung :: endezeichen gegeben;{}  endezeichen gegeben := FALSE;{}  entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{}
+  pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST  kanalnummer,{}                           ROW 2 REAL CONST spannungsbereich,{}                           ROW 3 INT  CONST kanalparameter):{}   spannung [kanalnummer].minimalwert := spannungsbereich [1];{}   spannung [kanalnummer].maximalwert := spannungsbereich [2];{}   kanal [kanalnummer].betriebsart    := kanalparameter   [1];{}   kanal [kanalnummer].taktzahl       := kanalparameter   [2];{}   kanal [kanalnummer].steuercode     := interface anpassung{}
+                                         (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{}  loesche interface task;{}  begin (PROC kanal koppler, interface task);{}  kanaldaten sind eingetragen := TRUE.{}  loesche interface task:{}    disable stop;{}    end (interface task);{}    IF is error{}       THEN clear error{}    FI;{}    enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):{}
+  u min := spannung [kanalnummer].minimalwert;{}  u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{}  vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{}  pruefe abbruch;{}  pruefe kanalnummer;{}  pruefe betriebsart.{}  pruefe kanalnummer:{}    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{}       THEN errorstop ("Kanalnummer " + text (kanalnummer) +{}
+                        " ist unzulaessig !"){}    FI.{}  pruefe betriebsart:{}    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{}       THEN errorstop ("An Kanal " + text (kanalnummer) +{}                          " keine " +  wunsch + " moeglich!"){}    FI.{}  wunsch:{}    IF   gewuenschte betriebsart = analog aus{}         THEN "Analog-Ausgabe"{}    ELIF gewuenschte betriebsart = digital aus{}         THEN "Digital-Ausgabe"{}    ELIF gewuenschte betriebsart = digital ein{}         THEN "Digital-Eingabe"{}
+    ELIF gewuenschte betriebsart = analog ein{}         THEN "Analog-Eingabe"{}         ELSE "Ein- oder Ausgabe"{}    FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{}  IF incharety = esc{}     THEN pruefe weiter{}  FI.{}  pruefe weiter:{}    TEXT CONST zeichen :: incharety (30);{}    IF   zeichen = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF zeichen = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}
+    FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{}  enable stop;{}  forget (ds); ds := nilspace;{}  IF kanaldaten sind eingetragen{}     THEN pingpong (interfacetask, initcode, ds, status){}     ELSE status := configuration error code{}  FI;{}  IF status > 0 THEN status DECR maxint FI;{}  forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{}  enable stop;{}  forget (ds); ds := nilspace;{}  pingpong (interface task, end code, ds, dummy);{}  forget (ds); ds := nilspace{}
+END PROC schliesse interface;{}PROC teste interface:{}  INT VAR test;{}  oeffne interface (test);{}  IF test < 0{}     THEN errorstop (fehlermeldung [min (5, abs (test))]){}     ELSE fehler zu melden           := FALSE;{}          endezeichen gegeben        := FALSE{}  FI{}END PROC teste interface;{}PROC fehlerbehandlung:{}  meldung := errormessage;{}  IF meldung <> ""{}     THEN meldung CAT fehlerzeile;{}          fehler zu melden := TRUE{}  FI;{}  clear error;{}  initialisiere interface.{}  fehlerzeile:{}
+    IF errorline = 0{}       THEN ""{}       ELSE " (bei Zeile " + text (errorline) + ")"{}    FI.{}END PROC fehlerbehandlung;{}(********************  EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{}  IF name (myself) <> "-"{}     THEN errorstop ("Unzulässiges Kommando!"){}     ELSE warte auf anrufe{}  FI.{}  warte auf anrufe:{}    TASK      VAR absender;{}    TEXT      VAR dummy;{}    INT       VAR codenummer, antwort;{}    disable stop;{}    REP forget (ds);{}        wait (ds, codenummer, absender);{}
+        IF codenummer = initcode{}           THEN kopple an interface kanal;{}                IF interface ist betriebsbereit{}                   THEN bearbeite weitere auftraege{}                   ELSE gib negative rueckmeldung{}                FI;{}                gib kanal frei{}           ELSE antwort := not init code;{}                gib negative rueckmeldung{}        FI{}    PER.{} kopple an interface kanal:{}  continue (interface channel);{}  IF is error{}     THEN clear error;{}          antwort := kanal besetzt code{}
+     ELSE oeffne interface direkt (antwort){}  FI.{} interface ist betriebsbereit:  antwort = 0.{} gib negative rueckmeldung:     send (absender, antwort, ds).{} gib kanal frei:{}   break (quiet);{}   send  (absender, 0, ds, antwort);{}   collect heap garbage.{} bearbeite weitere auftraege:{}   REP   call (absender, antwort, ds, codenummer);{}         IF   codenummer > 255{}              THEN sende wert an interface{}         ELIF codenummer <  50{}              THEN hole wert von interface{}         ELIF codenummer = alles aus code{}
+              THEN initialisiere interface direkt{}         FI{}   UNTIL codenummer = endcode PER;{}   IF is error THEN clear error FI;{}   schliesse interface direkt.{}  sende wert an interface:{}    out (kanal [codenummer DIV 256].steuercode);{}    out (code (codenummer)).{}  hole wert von interface:{}    out (kanal [codenummer].steuercode);{}    SELECT kanal [codenummer].taktzahl OF{}      CASE 1 :  antwort := erstes  zeichen{}      CASE 2 :  antwort := zweites zeichen{}      CASE 3 :  antwort := drittes zeichen{}
+      OTHERWISE antwort := -1{}    END SELECT.{}    erstes zeichen:{}      code (incharety (1)).{}    zweites zeichen:{}      dummy := incharety (1);{}      code (incharety (1)).{}    drittes zeichen:{}      dummy := incharety (1);{}      dummy := incharety (1);{}      code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{}  enable stop;{}  IF kanalnummer < 1 OR kanalnummer > 24{}     THEN errorstop ("Unzulaessige Kanalnummer"){}     ELSE interface channel := kanalnummer{}
+  FI{}END PROC interface kanal;{}INT PROC interface kanal:{}  interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{}  leere puffer;{}  out (interface test code);{}  IF antwort <> ""{}     THEN status := 0;{}          out (interface open code){}     ELSE status := interface error code{}  FI.{}  leere puffer:{}    REP  UNTIL incharety = "" PER.{}  antwort: incharety (1).{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{}  out (interface close code){}
+END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{}  schalte alles aus.{}  schalte alles aus:{}    INT VAR kanalnummer, kanalbetriebsart;{}    FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}        kanalbetriebsart := kanal [kanalnummer].betriebsart;{}        IF   kanalbetriebsart = digital aus{}             THEN direkt ausgeben (kanalnummer, 0){}        ELIF kanalbetriebsart = analog aus{}             THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){}        FI{}
+    PER.{}  gewandelte nullspannung:{}    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{}    u max :  spannung [kanalnummer].maximalwert.{}    u min :  spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{}INT PROC direkt eingabe (INT CONST kanalnummer):{}  gib lesecode aus;{}  erhaltene antwort.{}  gib lesecode aus:{}
+    out (kanal [kanalnummer].steuercode).{}  erhaltene antwort:{}    TEXT VAR dummy;{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1 :  erstes  zeichen{}      CASE 2 :  zweites zeichen{}      CASE 3 :  drittes zeichen{}      OTHERWISE -1{}    END SELECT.{}    erstes zeichen:{}      code (incharety (1)).{}    zweites zeichen:{}      dummy := incharety (1);{}      code (incharety (1)).{}    drittes zeichen:{}      dummy := incharety (1);{}      dummy := incharety (1);{}      code (incharety (1)).{}
+END PROC direkt eingabe;{}PROC initialisiere die kanaele:{}  INT VAR kanalnummer;{}  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{}      vorherige ausgabe [kanalnummer] := 0{}  PER.{}  keine spannung:{}    ROW 2 REAL : (0.0, 0.0).{}  leere karte:{}    ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele;{}END PACKET ls prozess 1{}
+
diff --git a/app/gs.process/1.02/src/ls-Prozess 1 für MUFI als Endgerät b/app/gs.process/1.02/src/ls-Prozess 1 für MUFI als Endgerät
new file mode 100644
index 0000000..4d2a5f4
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 1 für MUFI als Endgerät
@@ -0,0 +1,57 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 1                     ** 
+         **                                                      ** 
+         **           Anpassung für  MUFI als Endgerät           ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 26.01.90)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls prozess 1 DEFINES 
+       run pdv,{}       run pdv again,{}       initialisiere interface,{}       schalte alles aus,{}       ausgeben,{}       eingabe,{}       warte,{}       abbruch gewuenscht,{}       tue nichts,{}       trage kanaldaten ein,{}       beende kanaldaten eintragen,{}       hole spannungsbereich,{}       letzte ausgabe,{}       pruefe kanal,{}       pruefe abbruch,{}       teste interface,{}       oeffne interface,{}       schliesse interface,{}       nicht belegt,{}       digital aus,{}       analog aus,{}
+       digital ein,{}       analog ein,{}       kanalbreite,{}       ganzzahl obergrenze,{}       adapterart,{}    (* ------------------------- *){}       kanalkoppler,{}       interface kanal,{}       oeffne interface direkt,{}       schliesse interface direkt,{}       initialisiere interface direkt,{}       direkt ausgeben,{}       direkt eingabe:{}(******************** A N P A S S U N G  A N  M U F I ********************){}LET interface test  code = ""27""27"10",{}    interface okay  code = ""27""27"00",{}
+    interface open  code = ""27""27"1A18",{}    interface close code = ""25""27""27"13",{}    adresse 0 code       = ""61"",{}    leertakt  code       = ""62"",{}    interface write code =   80  ,{}    interface read  code =   64  ,{}    erwartete zeichen    =    4  ;{}TEXT CONST adapterart   :: "MUFI als Endgerät";{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{}  IF   es ist ein ausgabekanal{}       THEN code (interface write code + device + 4 * steuerungscode){}  ELIF es ist ein eingabekanal{}
+       THEN lesecode in abhaengigkeit von der taktzahl{}       ELSE ""{}  FI.{}  es ist ein ausgabekanal:{}    kanal [kanalnummer].betriebsart < 0.{}  es ist ein eingabekanal:{}    kanal [kanalnummer].betriebsart > 0.{}  device:{}    IF kanalnummer < 10{}       THEN 0{}       ELSE kanalnummer DIV 10  -  1{}    FI.{}  lesecode in abhaengigkeit von der taktzahl:{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1: lesecode{}      CASE 2: adresse 0 code + lesecode + lesecode{}      CASE 3: adresse 0 code + lesecode + zwei weitere takte{}
+    OTHERWISE "" END SELECT.{}  lesecode  :  code (interface read code + device + 4 * steuerungscode).{}  zwei weitere takte:{}    IF leertakt code = ""{}       THEN lesecode + lesecode{}       ELSE kanal [kanalnummer].taktzahl DECR 1;{}            leertakt code + lesecode{}    FI.{}END PROC interface anpassung;{}(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************){}LET       max kanalanzahl          =   49,{}          initcode                 =   50,{}          endcode                  =   51,{}
+          alles aus code           =   52,{}          endezeichen              =  "q",{}          abbruchzeichen           =  "h",{}          esc                      =  ""27"";{}INT CONST analog aus               ::  -2,            (* Betriebsarten *){}          digital aus              ::  -1,{}          nicht belegt             ::   0,{}          digital ein              ::   1,{}          analog  ein              ::   2,{}          kanalbreite              ::   8,{}          ganzzahl obergrenze      ::   2 ** kanalbreite,{}
+          configuration error code ::  -1,{}          kanal besetzt code       ::  -3,{}          interface error code     ::  -4,{}          not init code            ::  -5;{}INT VAR   interfacechannel         ::   2,{}          dummy;{}TEXT VAR  meldung                  ::  "";{}BOOL VAR  kanaldaten sind eingetragen :: FALSE,{}          endezeichen gegeben         :: FALSE,{}          programm mit pdv gestartet  :: FALSE,{}          fehler zu melden            :: FALSE;{}TASK VAR  interface task              :: niltask;{}
+DATASPACE VAR  ds :: nilspace;{}TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),{}     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT      VAR vorherige ausgabe;{}ROW max kanalanzahl KANAL    VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :{}  ("Interface ist noch nicht konfiguriert!",{}   "Interface-Task ist besetzt!",{}   "Interface-Kanal ist belegt!",{}   "Interface meldet sich nicht!",{}   "Interface kann nicht geöffnet werden!");{}
+PROC run pdv:{}  run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{}  enable stop;{}  last param (programmname);{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run (programmname);{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}     THEN errorstop (meldung){}  FI{}END PROC run pdv;{}PROC run pdv again:{}
+  enable stop;{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run again;{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}     THEN errorstop (meldung){}  FI{}END PROC run pdv again;{}PROC melde programmende:{}  page;{}  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{}  pause;{}  schalte alles aus{}END PROC melde programmende;{}
+PROC initialisiere interface:{}  enable stop;{}  pruefe abbruch;{}  IF programm mit pdv gestartet{}     THEN schalte alles aus{}     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){}  FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{}  INT VAR k;{}  FOR k FROM 1 UPTO max kanalanzahl REP{}    vorherige ausgabe [k] := 0{}  PER;{}  forget (ds); ds := nilspace;{}  call (interface task, alles aus code, ds, dummy){}END PROC schalte alles aus;{}PROC ausgeben (INT CONST kanalnummer, wert):{}
+  merke wert;{}  gib wert aus.{}  merke wert:{}    vorherige ausgabe [kanalnummer] := wert.{}  gib wert aus:{}    call (interface task, 256 * kanalnummer + wert, ds, dummy).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{}  INT VAR eingabewert;{}  call (interface task, kanalnummer, ds, eingabewert);{}  eingabewert{}END PROC eingabe;{}PROC warte (REAL CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (int (sekunden * 10.0 + 0.5));{}  IF eingabe = esc{}
+     THEN untersuche naechstes zeichen{}  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (sekunden * 10);{}  IF eingabe = esc{}     THEN untersuche naechstes zeichen{}
+  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}BOOL PROC abbruch gewuenscht:{}  pruefe abbruch;{}  BOOL VAR entscheidung :: endezeichen gegeben;{}  endezeichen gegeben := FALSE;{}  entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{}
+  pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST  kanalnummer,{}                           ROW 2 REAL CONST spannungsbereich,{}                           ROW 3 INT  CONST kanalparameter):{}   spannung [kanalnummer].minimalwert := spannungsbereich [1];{}   spannung [kanalnummer].maximalwert := spannungsbereich [2];{}   kanal [kanalnummer].betriebsart    := kanalparameter   [1];{}   kanal [kanalnummer].taktzahl       := kanalparameter   [2];{}   kanal [kanalnummer].steuercode     := interface anpassung{}
+                                         (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{}  loesche interface task;{}  begin (PROC kanal koppler, interface task);{}  kanaldaten sind eingetragen := TRUE.{}  loesche interface task:{}    disable stop;{}    end (interface task);{}    IF is error{}       THEN clear error{}    FI;{}    enable stop.{}END PROC beende kanaldaten eintragen;{}PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):{}
+  u min := spannung [kanalnummer].minimalwert;{}  u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{}  vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{}  pruefe abbruch;{}  pruefe kanalnummer;{}  pruefe betriebsart.{}  pruefe kanalnummer:{}    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{}       THEN errorstop ("Kanalnummer " + text (kanalnummer) +{}
+                        " ist unzulaessig !"){}    FI.{}  pruefe betriebsart:{}    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{}       THEN errorstop ("An Kanal " + text (kanalnummer) +{}                          " keine " +  wunsch + " moeglich!"){}    FI.{}  wunsch:{}    IF   gewuenschte betriebsart = analog aus{}         THEN "Analog-Ausgabe"{}    ELIF gewuenschte betriebsart = digital aus{}         THEN "Digital-Ausgabe"{}    ELIF gewuenschte betriebsart = digital ein{}         THEN "Digital-Eingabe"{}
+    ELIF gewuenschte betriebsart = analog ein{}         THEN "Analog-Eingabe"{}         ELSE "Ein- oder Ausgabe"{}    FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{}  IF incharety = esc{}     THEN pruefe weiter{}  FI.{}  pruefe weiter:{}    TEXT CONST zeichen :: incharety (30);{}    IF   zeichen = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF zeichen = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}
+    FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{}  enable stop;{}  forget (ds); ds := nilspace;{}  IF kanaldaten sind eingetragen{}     THEN pingpong (interfacetask, initcode, ds, status){}     ELSE status := configuration error code{}  FI;{}  IF status > 0 THEN status DECR maxint FI;{}  forget (ds); ds := nilspace{}END PROC oeffne interface;{}PROC schliesse interface:{}  enable stop;{}  forget (ds); ds := nilspace;{}  pingpong (interface task, end code, ds, dummy);{}  forget (ds); ds := nilspace{}
+END PROC schliesse interface;{}PROC teste interface:{}  INT VAR test;{}  oeffne interface (test);{}  IF test < 0{}     THEN errorstop (fehlermeldung [min (5, abs (test))]){}     ELSE fehler zu melden           := FALSE;{}          endezeichen gegeben        := FALSE{}  FI{}END PROC teste interface;{}PROC fehlerbehandlung:{}  meldung := errormessage;{}  IF meldung <> ""{}     THEN meldung CAT fehlerzeile;{}          fehler zu melden := TRUE{}  FI;{}  clear error;{}  initialisiere interface.{}  fehlerzeile:{}
+    IF errorline = 0{}       THEN ""{}       ELSE " (bei Zeile " + text (errorline) + ")"{}    FI.{}END PROC fehlerbehandlung;{}(********************  EIN-/AUSGABE AM INTERFACE-KANAL ********************){}PROC kanalkoppler:{}  IF name (myself) <> "-"{}     THEN errorstop ("Unzulässiges Kommando!"){}     ELSE warte auf anrufe{}  FI.{}  warte auf anrufe:{}    TASK      VAR absender;{}    TEXT      VAR dummy;{}    INT       VAR codenummer, antwort;{}    disable stop;{}    REP forget (ds);{}        wait (ds, codenummer, absender);{}
+        IF codenummer = initcode{}           THEN kopple an interface kanal;{}                IF interface ist betriebsbereit{}                   THEN bearbeite weitere auftraege{}                   ELSE gib negative rueckmeldung{}                FI;{}                gib kanal frei{}           ELSE antwort := not init code;{}                gib negative rueckmeldung{}        FI{}    PER.{} kopple an interface kanal:{}  continue (interface channel);{}  IF is error{}     THEN clear error;{}          antwort := kanal besetzt code{}
+     ELSE oeffne interface direkt (antwort){}  FI.{} interface ist betriebsbereit:  antwort = 0.{} gib negative rueckmeldung:     send (absender, antwort, ds).{} gib kanal frei:{}   break (quiet);{}   send  (absender, 0, ds, antwort);{}   collect heap garbage.{} bearbeite weitere auftraege:{}   REP   call (absender, antwort, ds, codenummer);{}         IF   codenummer > 255{}              THEN sende wert an interface{}         ELIF codenummer <  50{}              THEN hole wert von interface{}         ELIF codenummer = alles aus code{}
+              THEN initialisiere interface direkt{}         FI{}   UNTIL codenummer = endcode PER;{}   IF is error THEN clear error FI;{}   schliesse interface direkt.{}  sende wert an interface:{}    out (kanal [codenummer DIV 256].steuercode);{}    out (code (codenummer)).{}  hole wert von interface:{}    out (kanal [codenummer].steuercode);{}    SELECT kanal [codenummer].taktzahl OF{}      CASE 1 :  antwort := erstes  zeichen{}      CASE 2 :  antwort := zweites zeichen{}      CASE 3 :  antwort := drittes zeichen{}
+      OTHERWISE antwort := -1{}    END SELECT.{}    erstes zeichen:{}      code (incharety (1)).{}    zweites zeichen:{}      dummy := incharety (1);{}      code (incharety (1)).{}    drittes zeichen:{}      dummy := incharety (1);{}      dummy := incharety (1);{}      code (incharety (1)).{}END PROC kanalkoppler;{}PROC interface kanal (INT CONST kanalnummer):{}  enable stop;{}  IF kanalnummer < 1 OR kanalnummer > 24{}     THEN errorstop ("Unzulaessige Kanalnummer"){}     ELSE interface channel := kanalnummer{}
+  FI{}END PROC interface kanal;{}INT PROC interface kanal:{}  interface channel{}END PROC interface kanal;{}PROC oeffne interface direkt (INT VAR status):{}  leere puffer;{}  out (interface test code);{}  fange antwort;{}  IF antwort = interface okay code{}     THEN status := 0;{}          out (interface open code){}     ELSE status := interface error code{}  FI.{}  leere puffer:{}    REP  UNTIL incharety = "" PER.{}  fange antwort:{}    INT  VAR zaehler;{}    TEXT VAR antwort :: "";{}    FOR zaehler FROM 1 UPTO erwartete zeichen REP{}
+      antwort CAT incharety (1){}    PER.{}END PROC oeffne interface direkt;{}PROC schliesse interface direkt:{}  out (interface close code){}END PROC schliesse interface direkt;{}PROC initialisiere interface direkt:{}  schalte alles aus.{}  schalte alles aus:{}    INT VAR kanalnummer, kanalbetriebsart;{}    FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}        kanalbetriebsart := kanal [kanalnummer].betriebsart;{}        IF   kanalbetriebsart = digital aus{}             THEN direkt ausgeben (kanalnummer, 0){}
+        ELIF kanalbetriebsart = analog aus{}             THEN direkt ausgeben (kanalnummer, gewandelte nullspannung){}        FI{}    PER.{}  gewandelte nullspannung:{}    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{}    u max :  spannung [kanalnummer].maximalwert.{}    u min :  spannung [kanalnummer].minimalwert.{}END PROC initialisiere interface direkt;{}PROC direkt ausgeben (INT CONST kanalnummer, wert):{} out (kanal [kanalnummer].steuercode);{} out (code (wert)){}END PROC direkt ausgeben;{}
+INT PROC direkt eingabe (INT CONST kanalnummer):{}  gib lesecode aus;{}  erhaltene antwort.{}  gib lesecode aus:{}    out (kanal [kanalnummer].steuercode).{}  erhaltene antwort:{}    TEXT VAR dummy;{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1 :  erstes  zeichen{}      CASE 2 :  zweites zeichen{}      CASE 3 :  drittes zeichen{}      OTHERWISE -1{}    END SELECT.{}    erstes zeichen:{}      code (incharety (1)).{}    zweites zeichen:{}      dummy := incharety (1);{}      code (incharety (1)).{}
+    drittes zeichen:{}      dummy := incharety (1);{}      dummy := incharety (1);{}      code (incharety (1)).{}END PROC direkt eingabe;{}PROC initialisiere die kanaele:{}  INT VAR kanalnummer;{}  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{}      vorherige ausgabe [kanalnummer] := 0{}  PER.{}  keine spannung:{}    ROW 2 REAL : (0.0, 0.0).{}  leere karte:{}    ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}
+initialisiere die kanaele;{}END PACKET ls prozess 1{}
+
diff --git a/app/gs.process/1.02/src/ls-Prozess 1 für MUFI im Terminalkanal b/app/gs.process/1.02/src/ls-Prozess 1 für MUFI im Terminalkanal
new file mode 100644
index 0000000..d1edbc1
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 1 für MUFI im Terminalkanal
@@ -0,0 +1,55 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 1                     ** 
+         **                                                      ** 
+         **         Anpassung für  MUFI im Terminalkanal         ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 26.01.90)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET altes incharety DEFINES old incharety: 
+TEXT PROC old incharety:{}  incharety{}END PROC old incharety;{}TEXT PROC old incharety (INT CONST timelimit):{}  incharety (timelimit){}END PROC old incharety;{}END PACKET altes incharety;{}PACKET ls prozess 1 DEFINES{}       run pdv,{}       run pdv again,{}       initialisiere interface,{}       ausgeben,{}       eingabe,{}       warte,{}       abbruch gewuenscht,{}       tue nichts,{}       trage kanaldaten ein,{}       beende kanaldaten eintragen,{}       hole spannungsbereich,{}       letzte ausgabe,{}
+       pruefe kanal,{}       pruefe abbruch,{}       teste interface,{}      schalte alles aus,{}       oeffne interface,{}       schliesse interface,{}       nicht belegt,{}       digital aus,{}       analog aus,{}       digital ein,{}       analog ein,{}       kanalbreite,{}       ganzzahl obergrenze,{}       adapterart,{}       incharety,{}       inchar,{}       pause:{}(******************** A N P A S S U N G  A N  M U F I ********************){}LET mufikennung       = ""31""31"",{}    erwartete zeichen =        4  ;{}
+TEXT CONST adapterart           :: "MUFI im Terminalkanal",{}           interface test  code :: ""27""27"10",{}           interface okay  code :: ""27""27"00",{}           interface open  code :: ""27""27"1C" + hex (mufikennung),{}           interface close code :: mufikennung  + "1C" + hex (""27""27""),{}           adresse 0 code       :: mufikennung + "3D",{}           leertakt  code       :: mufikennung + "3E",{}           interface write code :: mufikennung + "5" ,{}           interface read  code :: mufikennung + "4" ;{}
+TEXT VAR   puffer :: "";{}ROW 256 TEXT CONST hexcode :: ROW 256 TEXT : ({}"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F",{}"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F",{}"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F",{}"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F",{}"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F",{}"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F",{}
+"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F",{}"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F",{}"80","81","82","83","84","85","86","87","88","89","8A","8B","8C","8D","8E","8F",{}"90","91","92","93","94","95","96","97","98","99","9A","9B","9C","9D","9E","9F",{}"A0","A1","A2","A3","A4","A5","A6","A7","A8","A9","AA","AB","AC","AD","AE","AF",{}"B0","B1","B2","B3","B4","B5","B6","B7","B8","B9","BA","BB","BC","BD","BE","BF",{}"C0","C1","C2","C3","C4","C5","C6","C7","C8","C9","CA","CB","CC","CD","CE","CF",{}
+"D0","D1","D2","D3","D4","D5","D6","D7","D8","D9","DA","DB","DC","DD","DE","DF",{}"E0","E1","E2","E3","E4","E5","E6","E7","E8","E9","EA","EB","EC","ED","EE","EF",{}"F0","F1","F2","F3","F4","F5","F6","F7","F8","F9","FA","FB","FC","FD","FE","FF");{}TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):{}  LET  hexzeichen = "0123456789ABCDEF";{}  IF   es ist ein ausgabekanal{}       THEN interface write code{}            + (hexzeichen SUB (device + 4 * steuerungscode)){}  ELIF es ist ein eingabekanal{}
+       THEN lesecode in abhaengigkeit von der taktzahl{}       ELSE ""{}  FI.{}  es ist ein ausgabekanal:{}    kanal [kanalnummer].betriebsart < 0.{}  es ist ein eingabekanal:{}    kanal [kanalnummer].betriebsart > 0.{}  device:{}    IF kanalnummer < 10{}       THEN 1{}       ELSE kanalnummer DIV 10{}    FI.{}  lesecode in abhaengigkeit von der taktzahl:{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1: lesecode{}      CASE 2: adresse 0 code + lesecode + lesecode{}      CASE 3: adresse 0 code + lesecode + zwei weitere takte{}
+    OTHERWISE "" END SELECT.{}  lesecode:{}    interface read code + (hexzeichen SUB (device + 4 * steuerungscode)).{}  zwei weitere takte:{}    IF leertakt code = ""{}       THEN lesecode + lesecode{}       ELSE kanal [kanalnummer].taktzahl DECR 1;{}            leertakt code + lesecode{}    FI.{}END PROC interface anpassung;{}PROC ausgeben (INT CONST kanalnummer, wert):{}  merke wert;{}  gib wert aus.{}  merke wert:{}   vorherige ausgabe [kanalnummer] := wert.{}  gib wert aus:{}    out (kanal [kanalnummer].steuercode);{}
+    out (hexcode [wert + 1]).{}END PROC ausgeben;{}INT PROC eingabe (INT CONST kanalnummer):{}  gib lesecode aus;{}  erhaltene antwort.{}  gib lesecode aus:{}    out (kanal [kanalnummer].steuercode).{}  erhaltene antwort:{}    TEXT VAR dummy;{}    SELECT kanal [kanalnummer].taktzahl OF{}      CASE 1 :  erste  sendung{}      CASE 2 :  zweite sendung{}      CASE 3 :  dritte sendung{}      OTHERWISE -1{}    END SELECT.{}    erste sendung:{}      fange mufikennung;{}      dezimalwert (old incharety (1), old incharety (1)).{}
+    zweite sendung:{}      fange mufikennung;{}      dummy := old incharety (1);{}      dummy := old incharety (1);{}      erste sendung.{}    dritte sendung:{}      fange mufikennung;{}      dummy := old incharety (1);{}      dummy := old incharety (1);{}      zweite sendung.{}    fange mufikennung:{}      puffer CAT old incharety;{}      REP puffer CAT old incharety{}      UNTIL pos (puffer, mufikennung) > 0 PER;{}      puffer := subtext (puffer, 1, length (puffer) - 2).{}END PROC eingabe;{}(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************){}
+LET       max kanalanzahl          =   49,{}          endezeichen              =  "q",{}          abbruchzeichen           =  "h",{}          esc                      =  ""27"";{}INT CONST analog aus               ::  -2,            (* Betriebsarten *){}          digital aus              ::  -1,{}          nicht belegt             ::   0,{}          digital ein              ::   1,{}          analog  ein              ::   2,{}          kanalbreite              ::   8,{}          ganzzahl obergrenze      ::   2 ** kanalbreite,{}
+          configuration error code ::  -1,{}          interface error code     ::  -4;{}TEXT VAR  meldung                  ::  "";{}BOOL VAR  kanaldaten sind eingetragen :: FALSE,{}          endezeichen gegeben         :: FALSE,{}          programm mit pdv gestartet  :: FALSE,{}          fehler zu melden            :: FALSE;{}TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),{}     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);{}ROW max kanalanzahl INT      VAR vorherige ausgabe;{}
+ROW max kanalanzahl KANAL    VAR kanal;{}ROW max kanalanzahl SPANNUNG VAR spannung;{}PROC run pdv:{}  run pdv (last param){}END PROC run pdv;{}PROC run pdv (TEXT CONST programmname):{}  enable stop;{}  last param (programmname);{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run (programmname);{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}
+     THEN errorstop (meldung){}  FI{}END PROC run pdv;{}PROC run pdv again:{}  enable stop;{}  programm mit pdv gestartet := TRUE;{}  teste interface;{}  disable stop;{}  run again;{}  IF is error{}     THEN fehlerbehandlung{}     ELSE melde programmende{}  FI;{}  schliesse interface;{}  programm mit pdv gestartet := FALSE;{}  enable stop;{}  IF fehler zu melden{}     THEN errorstop (meldung){}  FI{}END PROC run pdv again;{}PROC melde programmende:{}  page;{}  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");{}
+  pause;{}  schalte alles aus{}END PROC melde programmende;{}PROC initialisiere interface:{}  enable stop;{}  pruefe abbruch;{}  IF programm mit pdv gestartet{}     THEN schalte alles aus{}     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!"){}  FI{}END PROC initialisiere interface;{}PROC schalte alles aus:{}  INT VAR kanalnummer, kanalbetriebsart;{}  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}      kanalbetriebsart := kanal [kanalnummer].betriebsart;{}      IF   kanalbetriebsart = digital aus{}
+           THEN ausgeben (kanalnummer, 0){}      ELIF kanalbetriebsart = analog aus{}           THEN ausgeben (kanalnummer, gewandelte nullspannung){}      FI{}  PER.{}  gewandelte nullspannung:{}    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).{}    u max :  spannung [kanalnummer].maximalwert.{}    u min :  spannung [kanalnummer].minimalwert.{}END PROC schalte alles aus;{}PROC warte (REAL CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (int (sekunden * 10.0 + 0.5));{}
+  IF eingabe = esc{}     THEN untersuche naechstes zeichen{}  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}PROC warte (INT CONST sekunden):{}  TEXT VAR eingabe;{}  pruefe abbruch;{}  eingabe := incharety (sekunden * 10);{}  IF eingabe = esc{}
+     THEN untersuche naechstes zeichen{}  FI.{}  untersuche naechstes zeichen:{}    eingabe := incharety (30);{}    IF   eingabe = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF eingabe = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}                             + abbruchzeichen + ">!"){}    FI.{}END PROC warte;{}TEXT PROC incharety:{}  IF puffer = ""{}     THEN old incharety{}     ELSE erstes zeichen von puffer{}  FI.{}  erstes zeichen von puffer:{}    TEXT CONST zeichen :: puffer SUB 1;{}
+    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC incharety;{}TEXT PROC incharety (INT CONST timelimit):{}  IF puffer = ""{}     THEN old incharety (timelimit){}     ELSE erstes zeichen von puffer{}  FI.{}  erstes zeichen von puffer:{}    TEXT CONST zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC incharety;{}PROC inchar (TEXT VAR character):{}  REP character := incharety{}  UNTIL character <> "" PER{}END PROC inchar;{}PROC pause:{}  TEXT VAR dummy;{}  inchar (dummy){}
+END PROC pause;{}PROC pause (INT CONST timelimit):{}  TEXT VAR dummy := incharety (timelimit){}END PROC pause;{}BOOL PROC abbruch gewuenscht:{}  pruefe abbruch;{}  BOOL VAR entscheidung :: endezeichen gegeben;{}  endezeichen gegeben := FALSE;{}  entscheidung{}END PROC abbruch gewuenscht;{}PROC tue nichts:{}  pruefe abbruch{}END PROC tue nichts;{}PROC trage kanaldaten ein (INT CONST  kanalnummer,{}                           ROW 2 REAL CONST spannungsbereich,{}                           ROW 3 INT  CONST kanalparameter):{}
+   spannung [kanalnummer].minimalwert := spannungsbereich [1];{}   spannung [kanalnummer].maximalwert := spannungsbereich [2];{}   kanal [kanalnummer].betriebsart    := kanalparameter   [1];{}   kanal [kanalnummer].taktzahl       := kanalparameter   [2];{}   kanal [kanalnummer].steuercode     := interface anpassung{}                                         (kanalnummer, kanalparameter [3]){}END PROC trage kanaldaten ein;{}PROC beende kanaldaten eintragen:{}  kanaldaten sind eingetragen := TRUE{}END PROC beende kanaldaten eintragen;{}
+PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):{}  u min := spannung [kanalnummer].minimalwert;{}  u max := spannung [kanalnummer].maximalwert{}END PROC hole spannungsbereich;{}INT PROC letzte ausgabe (INT CONST kanalnummer):{}  vorherige ausgabe [kanalnummer]{}END PROC letzte ausgabe;{}PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):{}  pruefe abbruch;{}  pruefe kanalnummer;{}  pruefe betriebsart.{}  pruefe kanalnummer:{}    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl{}
+       THEN errorstop ("Kanalnummer " + text (kanalnummer) +{}                        " ist unzulaessig !"){}    FI.{}  pruefe betriebsart:{}    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart{}       THEN errorstop ("An Kanal " + text (kanalnummer) +{}                          " keine " +  wunsch + " moeglich!"){}    FI.{}  wunsch:{}    IF   gewuenschte betriebsart = analog aus{}         THEN "Analog-Ausgabe"{}    ELIF gewuenschte betriebsart = digital aus{}         THEN "Digital-Ausgabe"{}
+    ELIF gewuenschte betriebsart = digital ein{}         THEN "Digital-Eingabe"{}    ELIF gewuenschte betriebsart = analog ein{}         THEN "Analog-Eingabe"{}         ELSE "Ein- oder Ausgabe"{}    FI.{}END PROC pruefe kanal;{}PROC pruefe abbruch:{}  TEXT VAR zeichen :: incharety;{}  IF zeichen = esc{}     THEN pruefe weiter{}  FI.{}  pruefe weiter:{}    zeichen := incharety (30);{}    IF   zeichen = endezeichen{}         THEN endezeichen gegeben := TRUE{}    ELIF zeichen = abbruchzeichen{}         THEN errorstop ("Programm-Abbruch durch <ESC><"{}
+                             + abbruchzeichen + ">!"){}    FI.{}END PROC pruefe abbruch;{}PROC oeffne interface (INT VAR status):{}  enable stop;{}  IF kanaldaten sind eingetragen{}     THEN teste interface funktion{}     ELSE status := configuration error code{}  FI.{}  teste interface funktion:{}    leere puffer;{}    out (interface test code);{}    fange antwort;{}    IF antwort = interface okay code{}       THEN status := 0;{}            out (interface open code){}       ELSE status := interface error code{}
+    FI.{}  leere puffer:{}    puffer := "";{}    REP  UNTIL old incharety = "" PER.{}  fange antwort:{}    INT  VAR zaehler;{}    TEXT VAR antwort :: "";{}    FOR zaehler FROM 1 UPTO erwartete zeichen REP{}      antwort CAT old incharety (1){}    PER.{}END PROC oeffne interface;{}PROC schliesse interface:{}  enable stop;{}  out (interface close code){}END PROC schliesse interface;{}(*********************  H I L F S P R O Z E D U R E N *********************){}PROC teste interface:{}  INT VAR test;{}
+  warte etwas;{}  oeffne interface (test);{}  IF test < 0{}     THEN errorstop (fehlermeldung){}     ELSE endezeichen gegeben        := FALSE;{}          fehler zu melden           := FALSE{}  FI.{}  warte etwas:{}    pause (1); pause (1); pause (1); pause (1); pause (1).{}  fehlermeldung:{}    IF   test = configuration error code{}         THEN "Interface ist noch nicht konfiguriert!"{}    ELIF test = interface error code{}         THEN "Interface meldet sich nicht!"{}         ELSE "Interface kann nicht geöffnet werden!"{}
+    FI.{}END PROC teste interface;{}PROC fehlerbehandlung:{}  meldung := errormessage;{}  IF meldung <> ""{}     THEN meldung CAT fehlerzeile;{}          fehler zu melden := TRUE{}  FI;{}  clear error;{}  initialisiere interface.{}  fehlerzeile:{}    IF errorline = 0{}       THEN ""{}       ELSE " (bei Zeile " + text (errorline) + ")"{}    FI.{}END PROC fehlerbehandlung;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{}  16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{}  hexzeichen: "123456789ABCDEF".{}
+END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{}  hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{}  (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{}  hexzeichen: "0123456789ABCDEF".{}END PROC hex;{}PROC initialisiere die kanaele:{}  INT VAR kanalnummer;{}  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP{}      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);{}      vorherige ausgabe [kanalnummer] := 0{}
+  PER.{}  keine spannung:{}    ROW 2 REAL : (0.0, 0.0).{}  leere karte:{}    ROW 3 INT : (nicht belegt, 0, 0).{}END PROC initialisiere die kanaele;{}initialisiere die kanaele{}END PACKET ls prozess 1{}
+
diff --git a/app/gs.process/1.02/src/ls-Prozess 2 b/app/gs.process/1.02/src/ls-Prozess 2
new file mode 100644
index 0000000..11cb4e7
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 2
@@ -0,0 +1,39 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 2                     ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 06.06.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls prozess 2 DEFINES                   
+       wert an analogausgang ausgeben,{}       spannungswert ausgeben,{}       bitsymbol ausgeben,{}       bitmuster ausgeben,{}       dezimalwert ausgeben,{}       bitmuster gleich,{}       bit ist gesetzt,{}       wert von analogeingang,{}       spannungswert,{}       bitsymbol,{}       bitmuster,{}       dezimalwert:{}LET    eins   = "I",{}       null   = "O",{}       invers = "T",{}       egal   = "X";{}REAL CONST maximalwert :: real (ganzzahl obergrenze - 1);{}(********************* A U S G A B E - B E F E H L E *********************){}
+PROC wert an analogausgang ausgeben (INT CONST kanal, wert):{}  pruefe kanal (kanal, analog aus);{}  ausgeben (kanal, wert MOD ganzzahlobergrenze){}END PROC wert an analogausgang ausgeben;{}PROC spannungswert ausgeben (INT  CONST kanal, REAL CONST wert):{}  pruefe kanal (kanal, analog aus);{}  pruefe spannungswert;{}  ausgeben (kanal, gewandelte spannung).{}  pruefe spannungswert:{}    REAL VAR u min, u max;{}    hole spannungsbereich (kanal, u min, u max);{}    IF wert < u min OR wert > u max{}       THEN errorstop ("Der Spannungswert " + text (wert) +{}
+                       " ist nicht zulaessig!"){}    FI.{}  gewandelte spannung:{}    int (((wert - u min) * maximalwert) / (u max - u min) + 0.5).{}END PROC spannungswert ausgeben;{}PROC bitsymbol ausgeben (INT  CONST kanal, bitnummer, TEXT CONST zeichen):{}  pruefe kanal (kanal, digital aus);{}  pruefe bitnummer (bitnummer);{}  ausgeben (kanal, relativer dezimalwert (zeichen, bitnummer, kanal)){}END PROC bitsymbol ausgeben;{}PROC bitmuster ausgeben (INT  CONST kanal, TEXT CONST zeichenkette):{}
+  pruefe kanal (kanal, digital aus);{}  ausgeben (kanal, relativer dezimalwert (zeichenkette, kanal)){}END PROC bitmuster ausgeben;{}PROC dezimalwert ausgeben (INT CONST kanal, wert):{}  pruefe kanal (kanal, digital aus);{}  ausgeben (kanal, wert MOD ganzzahl obergrenze){}END PROC dezimalwert ausgeben;{}(********************* E I N G A B E - B E F E H L E *********************){}BOOL PROC bitmuster gleich (INT CONST kanal, TEXT CONST zeichenkette):{}  INT CONST eingabewert :: dezimalwert (kanal);{}
+  pruefe zeichenkette;{}  eingabe passt zur zeichenkette.{}  pruefe zeichenkette:{}    IF length (zeichenkette) <> kanalbreite{}       THEN errorstop ("Das Bitmuster '" + zeichenkette +{}                       "' hat eine unzulaessige Laenge!"){}    FI.{}  eingabe passt zur zeichenkette:{}   INT VAR stelle;{}   BOOL VAR abweichung gefunden :: FALSE;{}   FOR stelle FROM 1 UPTO kanalbreite REP{}     teste bit an dieser stelle{}   UNTIL abweichung gefunden PER;{}   NOT abweichung gefunden.{} teste bit an dieser stelle:{}
+   TEXT CONST einzelbit :: zeichenkette SUB stelle;{}   IF   einzelbit = eins{}        THEN teste eingabebit auf eins{}   ELIF einzelbit = null{}        THEN teste eingabebit auf null{}   ELIF einzelbit = egal{}        THEN eingabebit ist beliebig{}   ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{}                   "Bitsymbol in '" + zeichenkette + "'!"){}   FI.{} teste eingabebit auf eins:{}   IF NOT bit (eingabewert, kanalbreite - stelle){}      THEN abweichung gefunden := TRUE{}   FI.{}
+ teste eingabebit auf null:{}   IF bit (eingabewert, kanalbreite - stelle){}      THEN abweichung gefunden := TRUE{}   FI.{} eingabebit ist beliebig:{}   .{}END PROC bitmuster gleich;{}BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer):{}  pruefe kanal (kanal, digital ein);{}  pruefe bitnummer (bitnummer);{}  IF bit (eingabe (kanal), bitnummer){}     THEN TRUE{}     ELSE FALSE{}  FI{}END PROC bit ist gesetzt;{}INT PROC wert von analogeingang (INT CONST kanal):{}  pruefe kanal (kanal, analog ein);{}
+  eingabe (kanal){}END PROC wert von analogeingang;{}REAL PROC spannungswert (INT CONST kanal):{}  INT CONST dezimalwert :: wert von analogeingang (kanal);{}  REAL  VAR u min, u max;{}  hole spannungsbereich (kanal, u min, u max);{}  round (real (dezimalwert) * (u max - u min) / maximalwert + u min, 3){}END PROC spannungswert;{}TEXT PROC bitsymbol (INT CONST kanal, bitnummer):{}  pruefe kanal (kanal, digital ein);{}  pruefe bitnummer (bitnummer);{}  IF bit (eingabe (kanal), bitnummer){}     THEN eins{}
+     ELSE null{}  FI{}END PROC bitsymbol;{}TEXT PROC bitmuster (INT CONST kanal):{}  TEXT VAR   zeichenkette :: "";{}  INT  CONST wert         :: dezimalwert (kanal);{}  wandle wert;{}  zeichenkette.{}  wandle wert:{}    INT VAR zeiger;{}    FOR zeiger FROM kanalbreite - 1 DOWNTO 0 REP{}      IF bit (wert, zeiger){}         THEN zeichenkette CAT eins{}         ELSE zeichenkette CAT null{}      FI{}    PER.{}END PROC bitmuster;{}INT PROC dezimalwert (INT CONST kanal):{}  pruefe kanal (kanal, digital ein);{}
+  eingabe (kanal){}END PROC dezimalwert;{}(******************** H I L F S - P R O Z E D U R E N ********************){}INT PROC relativer dezimalwert (TEXT CONST zeichenkette, INT CONST kanal):{}   INT VAR wert := letzte ausgabe (kanal);{}   pruefe zeichenkette auf korrekte laenge;{}   veraendere alten wert;{}   wert.{}   pruefe zeichenkette auf korrekte laenge:{}     IF length (zeichenkette) <> kanalbreite{}        THEN errorstop ("Bitmuster '" + zeichenkette + "' hat "{}                                      + "unzulaessige Laenge!"){}
+     FI.{}   veraendere alten wert:{}     INT VAR zeiger;{}     FOR zeiger FROM 1 UPTO kanalbreite REP{}       veraendere dieses bit{}     PER.{}   veraendere dieses bit:{}     TEXT CONST einzelbit :: zeichenkette SUB zeiger;{}     IF   einzelbit = eins   THEN setze bit{}     ELIF einzelbit = null   THEN loesche bit{}     ELIF einzelbit = invers THEN invertiere bit{}     ELIF einzelbit = egal   THEN lasse bit{}     ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +{}                     "Bitsymbol in '" + zeichenkette + "'!"){}
+     FI.{}   setze bit:{}     set bit (wert, kanalbreite - zeiger).{}   loesche bit:{}     reset bit (wert, kanalbreite - zeiger).{}   invertiere bit:{}     IF bit (wert, kanalbreite - zeiger){}        THEN loesche bit{}        ELSE setze bit{}     FI.{}   lasse bit:{}     .{}  END PROC relativer dezimalwert;{}INT PROC relativer dezimalwert (TEXT CONST bitzeichen,{}                                INT  CONST bitnummer, kanal):{}    INT VAR wert :: letzte ausgabe (kanal);{}    IF   bitzeichen = eins   THEN setze bit{}
+    ELIF bitzeichen = null   THEN loesche bit{}    ELIF bitzeichen = invers THEN invertiere bit{}    ELIF bitzeichen = egal   THEN lasse bit{}    ELSE errorstop ("'" + bitzeichen + "' ist ein unzulaessiges " +{}                                       "Bitsymbol!"){}    FI;{}    wert.{}   setze bit:{}     set bit (wert, bitnummer).{}   loesche bit:{}     reset bit (wert, bitnummer).{}   invertiere bit:{}     IF bit (wert, bitnummer){}        THEN loesche bit{}        ELSE setze bit{}     FI.{}   lasse bit:{}
+     .{}END PROC relativer dezimalwert;{}PROC pruefe bitnummer (INT CONST bitnummer):{}  IF bitnummer < 0  OR  bitnummer > kanalbreite - 1{}     THEN errorstop ("Bitnummer " + text (bitnummer) +{}                     " ist nicht zulaessig!"){}  FI{}END PROC pruefe bitnummer{}END PACKET ls prozess 2{}
+
diff --git a/prozess/ls-Prozess 3 b/app/gs.process/1.02/src/ls-Prozess 3
index b66cbe6..28ef825 100644
--- a/prozess/ls-Prozess 3
+++ b/app/gs.process/1.02/src/ls-Prozess 3
@@ -22,12 +22,5 @@
  
                                                                            *) 
 PACKET ls prozess 3 DEFINES                    
-       temperatur:
-LET thermometerkonstante = 50.0,
-    minimaltemperatur    = 10.0;
-REAL PROC temperatur (REAL CONST spannungswert):
-  spannungswert * thermometerkonstante - minimaltemperatur
-END PROC temperatur
-END PACKET ls prozess 3
-
+       temperatur:{}LET thermometerkonstante = 50.0,{}    minimaltemperatur    = 10.0;{}REAL PROC temperatur (REAL CONST spannungswert):{}  spannungswert * thermometerkonstante - minimaltemperatur{}END PROC temperatur{}END PACKET ls prozess 3{}
 
diff --git a/app/gs.process/1.02/src/ls-Prozess 4 b/app/gs.process/1.02/src/ls-Prozess 4
new file mode 100644
index 0000000..158b548
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 4
@@ -0,0 +1,61 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 4                     ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 26.01.90)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls prozess 4 DEFINES 
+           pdv befehlsuebersicht anzeigen,{}           pdv ausgabebefehle anzeigen,{}           pdv eingabebefehle anzeigen,{}           pdv testbefehle anzeigen,{}           pdv weitere befehle anzeigen,{}           pdv bitmuster erlaeutern,{}           pdv symbole erlaeutern,{}           pdv digital analog werte,{}           pdv programm neu erstellen,{}           pdv programm ansehen,{}           pdv programm starten,{}           pdv programm wiederholen,{}           pdv dateien verzeichnis,{}
+           pdv datei kopieren,{}           pdv datei umbenennen,{}           pdv dateien loeschen,{}           pdv dateien drucken,{}           init pdv,{}           pdv:{}LET  menukarte       = "ls-MENUKARTE:Prozess",{}     niltext         =         "",{}     maxlaenge       =         45,{}     maxnamenslaenge =         35;{}WINDOW VAR w :: window (1, 3, 79, 19);{}TEXT   VAR programmname :: "";{}BOOL   VAR noch kein programm gelaufen :: TRUE;{}PROC pdv:{}  init pdv;{}  install menu (menukarte, FALSE);{}
+  handle menu  ("PDV"){}END PROC pdv;{}PROC init pdv:{}  programmname := "";{}  noch kein programm gelaufen := TRUE;{}  cursor off;{}END PROC init pdv;{}PROC pdv befehlsuebersicht anzeigen:{}  menuinfo (anwendungstext (20)){}END PROC pdv befehlsuebersicht anzeigen;{}PROC pdv ausgabebefehle anzeigen:{}  INT VAR i;{}  REP{}    i := menualternative (anwendungstext (1), anwendungstext (3),{}                          anwendungstext (4), 5, TRUE);{}    SELECT i OF{}      CASE 1, 101: menuinfo (anwendungstext (21)){}
+      CASE 2, 102: menuinfo (anwendungstext (22)){}      CASE 3, 103: menuinfo (anwendungstext (23)){}      CASE 4, 104: menuinfo (anwendungstext (24)){}      CASE 5, 105: menuinfo (anwendungstext (25)){}    END SELECT{}  UNTIL i = 6 OR i = 106 PER;{}END PROC pdv ausgabebefehle anzeigen;{}PROC pdv eingabebefehle anzeigen:{}  INT VAR i;{}  REP{}    i := menualternative (anwendungstext (2), anwendungstext (3),{}                          anwendungstext (4), 5, TRUE);{}    SELECT i OF{}      CASE 1, 101: menuinfo (anwendungstext (31)){}
+      CASE 2, 102: menuinfo (anwendungstext (32)){}      CASE 3, 103: menuinfo (anwendungstext (33)){}      CASE 4, 104: menuinfo (anwendungstext (34)){}      CASE 5, 105: menuinfo (anwendungstext (35)){}    END SELECT{}  UNTIL i = 6 OR i = 106 PER;{}END PROC pdv eingabebefehle anzeigen;{}PROC pdv testbefehle anzeigen:{}  INT VAR i;{}  REP{}    i := menualternative (anwendungstext (5), anwendungstext (7),{}                          anwendungstext (8), 5, TRUE);{}    SELECT i OF{}      CASE 1, 101: menuinfo (anwendungstext (41)){}
+      CASE 2, 102: menuinfo (anwendungstext (42)){}    END SELECT{}  UNTIL i = 3 OR i = 103 PER;{}END PROC pdv testbefehle anzeigen;{}PROC pdv weitere befehle anzeigen:{}  INT VAR i;{}  REP{}    i := menualternative (anwendungstext (6), anwendungstext (7),{}                          anwendungstext (8), 5, TRUE);{}    SELECT i OF{}      CASE 1, 101: menuinfo (anwendungstext (43)){}      CASE 2, 102: menuinfo (anwendungstext (44)){}    END SELECT{}  UNTIL i = 3 OR i = 103 PER;{}END PROC pdv weitere befehle anzeigen;{}
+PROC pdv bitmuster erlaeutern:{}  menuinfo (anwendungstext (46)){}END PROC pdv bitmuster erlaeutern;{}PROC pdv symbole erlaeutern:{}  menuinfo (anwendungstext (47)){}END PROC pdv symbole erlaeutern;{}PROC pdv digital analog werte:{}  menuinfo (anwendungstext (48)){}END PROC pdv digital analog werte;{}PROC pdvdateien verzeichnis:{}  disable stop;{}  forget ("Verzeichnis der Dateien", quiet);{}  THESAURUS VAR programme :: ALL myself;{}  FILE VAR f ::{}  sequential file (output, "Verzeichnis der Dateien");{}
+  f FILLBY programme;{}  modify (f);{}  to line (f, 1); insert record (f);{}  menufootnote ("Verlassen: <ESC> <q>");{}  cursor on;{}  show (w, f);{}  cursor off;{}  forget ("Verzeichnis der Dateien", quiet);{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop{}END PROC pdvdateien verzeichnis;{}PROC pdvprogramm neu erstellen:{}  hole programmname;{}
+  kontrolliere den programmnamen;{}  command dialogue (FALSE);{}  cursor on;{}  disable stop;{}  stdinfoedit (programmname, 3);{}  cursor off;{}  command dialogue (TRUE);{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers (errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop.{}  hole programmname:{}    programmname := "";{}    programmname := menuanswer (ausgabe, programmname, 5).{}  ausgabe:{}    center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{}
+                 + " Bitte den Namen für das Programm "13""13"".{}  kontrolliere den programmnamen:{}    IF   programmname = niltext{}         THEN LEAVE pdvprogramm neu erstellen{}    ELIF length (programmname) > maxnamenslaenge{}         THEN meckere zu langen namen an;{}              programmname := niltext;{}              LEAVE pdvprogramm neu erstellen{}    ELIF exists (programmname){}         THEN meckere existierendes programm an;{}              LEAVE pdvprogramm neu erstellen{}    FI.{}END PROC pdvprogramm neu erstellen;{}
+PROC pdvprogramm ansehen:{}  IF programmname <> niltext CAND exists (programmname){}     THEN frage nach diesem programm{}     ELSE lasse programm auswaehlen{}  FI;{}  cursor on;{}  disable stop;{}  stdinfoedit (programmname, 3);{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop.{}  frage nach diesem programm:{}    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{}
+              + " Soll mit diesem Programm gearbeitet werden", 5){}       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare :: ALL myself;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE pdvprogramm ansehen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}
+    programmname := menuone (verfuegbare, "Programm ansehen/ändern",{}                             "Bitte das gewünschte Programm ankreuzen!",{}                              FALSE);{}    IF programmname = niltext{}       THEN menu bildschirm;{}            LEAVE pdvprogramm ansehen{}    FI.{}END PROC pdvprogramm ansehen;{}PROC pdvdateien drucken:{}  lasse programme auswaehlen;{}  drucke programme;{}  menu bildschirm.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare :: ALL myself;{}    IF NOT not empty (verfuegbare){}
+       THEN noch kein programm;{}            LEAVE pdvdateien drucken{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, "Dateien drucken",{}                   "Bitte die Dateien ankreuzen, die gedruckt werden sollen!",{}                    FALSE).{}  drucke programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers ("Dateien drucken")));{}    menuwindowline (2);{}    command dialogue (FALSE);{}
+    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (" Alle ausgewählten Dateien wurden gedruckt!");{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              menuwindowout ( " """ + name (verfuegbare, k) +{}                              """ wird gedruckt!");{}              menuwindowline;{}
+              print (name (verfuegbare, k));{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (" Es wurde keine Datei ausgewählt!");{}            menuwindowstop;{}            menu bildschirm;{}            LEAVE pdvdateien drucken{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}
+    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen; out (""7"");{}            menuinfo  (" " + invers (errormessage));{}            clear error; enable stop;{}            LEAVE pdvdateien drucken{}       ELSE enable stop{}    FI.{}END PROC pdvdateien drucken;{}PROC pdvdatei kopieren:{}  ermittle alten programmnamen;{}  erfrage neuen programmnamen;{}  kopiere ggf das programm.{}  ermittle alten programmnamen:{}    IF NOT not empty (ALL myself){}       THEN noch kein programm;{}
+            LEAVE pdvdatei kopieren{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone (ALL myself, "Datei kopieren",{}            "Bitte die Datei ankreuzen, das kopiert werden soll!",FALSE);{}    menu bildschirm;{}    IF alter name = niltext{}       THEN LEAVE pdvdatei kopieren{}    FI.{}  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + " Name der 'alten' Datei: " + bisheriger name{}
+                  + " Bitte den Namen für die Kopie: ".{}  ueberschrift:{}    center (maxlaenge, invers ("Datei kopieren")) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  kopiere ggf das programm:{}    IF   neuer name = niltext{}         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{}              LEAVE pdvdatei kopieren{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE pdvdatei kopieren{}       ELSE copy (alter name, neuer name){}
+    FI.{}  mache vorwurf:{}    menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{}END PROC pdvdatei kopieren;{}PROC pdvdatei umbenennen:{}  ermittle alten programmnamen;{}  erfrage neuen programmnamen;{}  benenne ggf das programm um.{}  ermittle alten programmnamen:{}    IF NOT not empty (ALL myself){}       THEN noch kein programm;{}            LEAVE pdvdatei umbenennen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( ALL myself, "Datei umbenennen",{}
+        "Bitte die Datei ankreuzen, die umbenannt werden soll!", FALSE);{}    menu bildschirm;{}    IF alter name = niltext{}       THEN LEAVE pdvdatei umbenennen{}    FI.{}  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + " Bisheriger  Dateiname: " + bisheriger name{}                  + " Zukünftiger Dateiname: ".{}  ueberschrift:{}    center (maxlaenge, invers ("Datei umbenennen")) + ""13""13"".{}  bisheriger name:{}
+    ""13""13" " + invers (alter name) + ""13""13"".{}  benenne ggf das programm um:{}    IF   neuer name = niltext{}         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{}              LEAVE pdvdatei umbenennen{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE pdvdatei umbenennen{}       ELSE rename (alter name, neuer name);{}            programmname := neuer name{}    FI.{}  mache vorwurf:{}    menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).{}
+END PROC pdvdatei umbenennen;{}PROC pdvdateien loeschen:{}  lasse programme auswaehlen;{}  loesche programme;{}  menu bildschirm.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare :: ALL myself;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE pdvdateien loeschen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, "Dateien löschen",{}    "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{}
+  loesche programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers ("Dateien löschen")));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}
+      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen"){}                 THEN forget (name (verfuegbare, k), quiet){}              FI;{}              fehlerbehandlung{}      FI{}    PER;{}    programmname := "".{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (" Es wurde keine Datei ausgewählt!");{}            menuwindowstop;{}
+            menu bildschirm;{}            LEAVE pdvdateien loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen; out (""7"");{}            menuinfo  (" " + invers (errormessage));{}            clear error; enable stop;{}            LEAVE pdvdateien loeschen{}       ELSE enable stop{}    FI.{}END PROC pdvdateien loeschen;{}
+PROC pdvprogramm starten:{}  programmname ermitteln;{}  bildschirm vorbereiten;{}  cursor on;{}  disable stop;{}  warnings off;{}  check on;{}  run pdv (programmname);{}  noch kein programm gelaufen := FALSE;{}  cursor off;{}  IF is error{}     THEN fehler ggf melden;{}          clear error{}     ELSE regenerate menuscreen{}  FI;{}  enable stop.{}  bildschirm vorbereiten:{}    cursor (17, 2); out (waagerecht);{}    cursor (38, 2); out (waagerecht);{}    cursor ( 1, 3); out (""4"");{}    menufootnote ("Programmabbruch: <ESC><h>");{}
+    cursor (1, 5);{}    out ("Das Programm wird übersetzt.  Zeilen-Nr.: ").{}  fehler ggf melden:{}    IF errormessage <> ""{}       THEN fehler melden{}    FI.{}  fehler melden:{}    IF   pos (errormessage, "'halt' vom Terminal") > 0{}       THEN regenerate menuscreen;{}            out (""7""); menuinfo (" "15"'halt' vom Terminal "14""){}    ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0{}       THEN regenerate menuscreen;{}            out (""7""); menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14""){}
+    ELIF pos (errormessage, "(bei Zeile") > 0 AND exists (programmname){}       THEN programm mit fehler im notebook zeigen;{}            regenerate menuscreen{}       ELSE regenerate menuscreen;{}            out (""7""); menuinfo  (" " + invers ("FEHLER: "{}                                        + subtext (errormessage, 1, 61))){}    FI.{}  programm mit fehler im notebook zeigen:{}    noteline;{}    note ("FEHLER: " + errormessage);{}    INT VAR n; FOR n FROM 1 UPTO 9 REP noteline PER;{}    note (""15"Verlassen: <ESC><q> "14"");{}
+    FILE VAR p :: sequential file (modify, programmname);{}    to line (p, max (1, fehlerzeile));{}    col (1);{}    clear error;{}    out (""7"");{}    cursor on;{}    noteedit (p);{}    cursor off.{}  fehlerzeile:{}    int (subtext (errormessage, zahlposition)).{}    zahlposition: pos (errormessage, "(bei Zeile") + 10.{}  programmname ermitteln:{}    IF programmname <> niltext CAND exists (programmname){}       THEN frage nach diesem programm{}       ELSE lasse programm auswaehlen{}    FI.{}  frage nach diesem programm:{}
+    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{}               name + " Soll mit diesem Programm gearbeitet werden", 5){}       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    center (maxlaenge, invers ("Programm starten")) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare :: ALL myself;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE pdvprogramm starten{}
+       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    programmname := menuone (verfuegbare, "Programm starten",{}                    "Bitte das gewünschte Programm ankreuzen!", FALSE);{}    IF programmname = niltext{}       THEN menubildschirm;{}            LEAVE pdv programm starten{}    FI.{}END PROC pdvprogramm starten;{}PROC pdv programm wiederholen:{}  bildschirm vorbereiten;{}  cursor on;{}  disable stop;{}  IF noch kein programm gelaufen{}     THEN errorstop ("Eine Wiederholung ist nicht moeglich!"){}
+     ELSE run pdv again{}  FI;{}  cursor off;{}  regenerate menuscreen;{}  IF is error{}     THEN zeige fehler;{}          clear error{}  FI;{}  enable stop.{}  bildschirm vorbereiten:{}    cursor (17, 2); out (waagerecht);{}    cursor (38, 2); out (waagerecht);{}    cursor ( 1, 3); out (""4"");{}    menufootnote ("Programmabbruch: <ESC><h>");{}    cursor (1,3).{}  zeige fehler:{}    out (""7"");{}    IF errormessage = "'run again' nicht moeglich"{}       THEN menuinfo (" "15"Eine Wiederholung ist nicht moeglich! "14""){}
+    ELIF pos (errormessage, "'halt' vom Terminal") > 0{}       THEN menuinfo (" "15"'halt' vom Terminal "14""){}    ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0{}       THEN menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14""){}       ELSE menuinfo (" " + invers ("FEHLER: "{}                          + subtext (errormessage, 1, 61))){}    FI.{}END PROC pdv programm wiederholen;{}PROC meckere zu langen namen an:{}  menuinfo (" " + invers ("Hier dürfen Namen höchstens "{}                + text (max namenslaenge){}
+                + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierendes programm an:{}  menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch kein programm:{}  menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{}  cursor (1, 2);{}  out (5 * waagerecht);{}  cursor (1, 3);{}  out (""4"");{}  cursor (1,23);{}  out (79 * waagerecht);{}
+  refresh submenu{}END PROC menu bildschirm{}END PACKET ls prozess 4{}
+
diff --git a/app/gs.process/1.02/src/ls-Prozess 5 b/app/gs.process/1.02/src/ls-Prozess 5
new file mode 100644
index 0000000..66bdf94
--- /dev/null
+++ b/app/gs.process/1.02/src/ls-Prozess 5
@@ -0,0 +1,84 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                     ls-Prozess 5                     ** 
+         **                                                      ** 
+         **                     Version 1.02                     ** 
+         **                                                      ** 
+         **                  (Stand : 26.01.90)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **         Autoren: Bruno Pollok, Bielefeld             ** 
+         **                  Wolfgang Weber, Bielefeld           ** 
+         **                                                      ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls prozess 5 DEFINES 
+       pdv konfiguration zugelassen,{}       pdv konfiguration evtl aktivieren,{}       pdv konfiguration zeigen,{}       pdv kanal konfigurieren,{}       pdv interfaceausgabe testen,{}       pdv interfaceeingabe testen:{}LET max steckplaetze     =  4,{}    max portanzahl       =  4,{}    anzahl kartensorten  =  5,{}    betriebsart          =  1,{}    keine karte          =  1,{}    ea karte             =  2,{}    kombi                =  3,{}    da karte             =  4,{}    ad karte             =  5,{}
+    compact              =  6,{}    einzel               =  7,{}    mehrfach             =  8;{}LET testfenster x        = 11,{}    testfenster y        =  5,{}    testfenster xsize    = 59,{}    testfenster ysize    = 15;{}WINDOW VAR testfenster   :: window (testfenster x,     testfenster y,{}                                    testfenster xsize, testfenster ysize);{}INT    VAR steckplatzart :: 0;{}BOOL   VAR mit konfigurationsmoeglichkeit :: TRUE;{}TASK   VAR konfigurationsmanager          :: niltask;{}
+ROW max steckplaetze INT VAR kartenart :: ROW max steckplaetze INT :{}                                          (keine karte, keine karte,{}                                           keine karte, keine karte);{}LET SPANNUNG = ROW 2 REAL,{}    PORT     = ROW 3 INT,{}    KARTE    = ROW max portanzahl PORT;{}ROW anzahl kartensorten KARTE CONST karte :: ROW anzahl kartensorten KARTE :{}(* ---------------------------------------------------------------------- *){}(   KARTE : ({}(* ---------------------------------------------------------------------- *){}
+(*         *)       PORT : (nicht belegt, 0, 0),        (*     Port 1     *){}(*  leere  *)       PORT : (nicht belegt, 0, 0),        (*     Port 2     *){}(*  Karte  *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *){}(*         *)       PORT : (nicht belegt, 0, 0)),       (*     Port 4     *){}(*----------------------------------------------------------------------- *){}    KARTE : ({}(* ---------------------------------------------------------------------- *){}(*         *)       PORT : (digital ein,  1, 3),        (*     Port 1     *){}
+(*   E/A   *)       PORT : (digital aus,  1, 1),        (*     Port 2     *){}(*  Karte  *)       PORT : (digital ein,  1, 3),        (*     Port 3     *){}(*         *)       PORT : (digital aus,  1, 1)),       (*     Port 4     *){}(*----------------------------------------------------------------------- *){}    KARTE : ({}(* ---------------------------------------------------------------------- *){}(*         *)       PORT : (analog  ein,  2, 2),        (*     Port 1     *){}(*  Kombi  *)       PORT : (analog  ein,  3, 2),        (*     Port 2     *){}
+(*  Karte  *)       PORT : (digital ein,  1, 3),        (*     Port 3     *){}(*         *)       PORT : (digital aus,  1, 1 )),      (*     Port 4     *){}(*----------------------------------------------------------------------- *){}    KARTE : ({}(* ---------------------------------------------------------------------- *){}(*         *)       PORT : (analog  aus,  1, 1),        (*     Port 1     *){}(*   D/A   *)       PORT : (analog  aus,  1, 3),        (*     Port 2     *){}(* Wandler *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *){}
+(*         *)       PORT : (nicht belegt, 0, 0)),       (*     Port 4     *){}(*----------------------------------------------------------------------- *){}    KARTE : ({}(* ---------------------------------------------------------------------- *){}(*         *)       PORT : (analog  ein,  1, 1),        (*     Port 1     *){}(*   A/D   *)       PORT : (analog  ein,  1, 3),        (*     Port 2     *){}(* Wandler *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *){}(*         *)       PORT : (nicht belegt, 0, 0))        (*     Port 4     *){}
+(*----------------------------------------------------------------------- *){}                                                                           );{}PROC pdv konfiguration zugelassen (BOOL CONST wahrheitswert):{}  teste berechtigung;{}  mit konfigurationsmoeglichkeit := wahrheitswert;{}  IF mit konfigurationsmoeglichkeit{}     THEN konfigurationsmanager := niltask{}     ELSE konfigurationsmanager := myself{}  FI.{}  teste berechtigung:{}    enable stop;{}    IF NOT (konfigurationsmanager = niltask  OR{}
+            konfigurationsmanager = myself){}       THEN errorstop ("Befehl ist nur in Task '" +{}                        name (konfigurationsmanager) + "' zugelassen!"){}    FI.{}END PROC pdv konfiguration zugelassen;{}PROC pdv konfiguration evtl aktivieren:{}  IF mit konfigurationsmoeglichkeit{}     THEN activate (3){}     ELSE deactivate (3){}  FI{}END PROC pdv konfiguration evtl aktivieren;{}PROC pdv kanal konfigurieren:{}  TEXT CONST info   ::  "  "15"Auswahl der Steckplatzart "14" "13""13""{}
+                      + "     c  Compactbox             "13""{}                      + "     e  Einzelsteckplatz       "13""{}                      + "     m  Mehrfachsteckplatz     ",{}             liste  :: "Compact"13"Einzel"13"Mehrfach",{}             tasten :: "cemCEM";{}   INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{}   SELECT auswahl OF{}     CASE 1, 101, 104 :  trage compactbox ein;{}                         zeige kanalbelegung (0){}     CASE 2, 102, 105 :  trage einzelplatzbelegung ein;{}
+                         zeige kanalbelegung (0){}     CASE 3, 103, 106 :  bearbeite die steckplaetze einzeln{}   END SELECT;{}   beende kanaldaten eintragen.{}   trage compactbox ein:{}     steckplatzart := compact;{}     trage steckplatzbelegung ein (1, kombi);{}     trage steckplatzbelegung ein (2, keine karte);{}     trage steckplatzbelegung ein (3, keine karte);{}     trage steckplatzbelegung ein (4, keine karte).{}   trage einzelplatzbelegung ein:{}     steckplatzart := einzel;{}     trage steckplatzbelegung ein (1, ermittelte kartenart (0));{}
+     trage steckplatzbelegung ein (2, keine karte);{}     trage steckplatzbelegung ein (3, keine karte);{}     trage steckplatzbelegung ein (4, keine karte).{}   bearbeite die steckplaetze einzeln:{}     INT VAR platz;{}     steckplatzart := mehrfach;{}     FOR platz FROM 1 UPTO max steckplaetze REP{}       trage steckplatzbelegung ein (platz, ermittelte kartenart (platz));{}       zeige kanalbelegung (platz * 10){}     PER.{}END PROC pdv kanal konfigurieren;{}PROC pdv konfiguration zeigen:{}  SELECT steckplatzart OF{}
+    CASE compact  : zeige kanalbelegung (0){}    CASE einzel   : zeige kanalbelegung (0){}    CASE mehrfach : zeige belegung einzelner steckplaetze{}    OTHERWISE       noch nicht konfiguriert{}  END SELECT.{}  noch nicht konfiguriert:{}    menuinfo ("                  "15"Warnung: "14"           "13""13""13""{}            + " Das Interface wurde noch nicht konfiguriert! "13""13""{}            + "  In diesem Zustand sind weder Eingaben noch  "13""{}            + "     Ausgaben über das Interface möglich.     "13"").{}
+  zeige belegung einzelner steckplaetze:{}    TEXT CONST info   ::{}                      "   "15"Eingestellt: Mehrfachsteckplatz "14" "13""13""{}                    + "         1   Info Steckplatz 1         "13""{}                    + "         2   Info Steckplatz 2         "13""{}                    + "         3   Info Steckplatz 3         "13""{}                    + "         4   Info Steckplatz 4         "13""13""{}                    + "         z   Zurück ins Hauptmenü      ",{}               liste  :: "1"13"2"13"3"13"4"13"z",{}
+               tasten :: "1234zZ";{}   INT VAR auswahl;{}   REP auswahl := menualternative (info, liste, tasten, 5, FALSE);{}     SELECT auswahl OF{}       CASE 1, 101 :  zeige kanalbelegung (10){}       CASE 2, 102 :  zeige kanalbelegung (20){}       CASE 3, 103 :  zeige kanalbelegung (30){}       CASE 4, 104 :  zeige kanalbelegung (40){}     END SELECT{}   UNTIL (auswahl = 5) OR (auswahl > 104) PER{}END PROC pdv konfiguration zeigen;{}PROC pdv interfaceausgabe testen:{}  gestalte testfenster ("Ausgabetest");{}
+  disable stop;{}  teste interface;{}  IF NOT is error{}     THEN teste interface ausgabe{}  FI;{}  IF is error{}     THEN fehlerbehandlung{}     ELSE schliesse interface;{}          enable stop;{}          beseitige testfenster;{}          refresh submenu{}  FI.{}  fehlerbehandlung:{}    TEXT VAR meldung :: errormessage;{}    clear error;{}    schalte alles aus;{}    schliesse interface;{}    enable stop;{}    cursor off;{}    regenerate menuscreen;{}    menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceausgabe testen;{}
+PROC pdv interfaceeingabe testen:{}  gestalte testfenster ("Eingabetest");{}  disable stop;{}  teste interface;{}  IF NOT is error{}     THEN teste interface eingabe{}  FI;{}  IF is error{}     THEN fehlerbehandlung{}     ELSE schliesse interface;{}          enable stop;{}          beseitige testfenster;{}          refresh submenu{}  FI.{}  fehlerbehandlung:{}    TEXT VAR meldung :: errormessage;{}    clear error;{}    schalte alles aus;{}    schliesse interface;{}    enable stop;{}    cursor off;{}
+    regenerate menuscreen;{}    menuinfo (" " + invers (meldung)).{}END PROC pdv interfaceeingabe testen;{}PROC beseitige testfenster:{}  INT VAR z;{}  FOR z FROM testfenster y + testfenster ysize DOWNTO testfenster y - 1 REP{}    cursor (testfenster x - 1, z);{}    out (""5""){}  PER{}END PROC beseitige testfenster;{}PROC gestalte testfenster (TEXT CONST funktionsart):{}  show (testfenster);{}  cursor (testfenster x - 1, testfenster y + testfenster ysize - 2);{}  out (balken links + (testfenster xsize * waagerecht) + balken rechts);{}
+  cursor (testfenster, 1, 2);{}  out (testfenster, center (testfenster, invers (funktionsart))){}END PROC gestalte testfenster;{}PROC testfensterfussnote (TEXT CONST meldung):{}  cursor (testfenster, 2, testfenster ysize);{}  out (testfenster, meldung){}END PROC testfensterfussnote;{}PROC teste interfaceausgabe:{}  INT  VAR kanalnummer, steckplatz, port;{}  TEXT VAR nummer :: "";{}  enable stop;{}  REP hole kanalnummer;{}      teste ausgabe an kanal{}  PER.{}  hole kanalnummer:{}    SELECT steckplatzart OF{}
+      CASE compact  :  kanalnummer := 4; steckplatz := 1; port := 4{}      CASE einzel   :  kanalnummer muss evtl erfragt werden{}      CASE mehrfach :  kanalnummer muss erfragt werden{}    OTHERWISE errorstop ("Interface ist noch nicht konfiguriert!"){}    END SELECT;{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Ausgabe an Kanal " + text (kanalnummer) + klammer +{}                       kanalbeschreibung (steckplatz, port));{}    IF steckplatzart = mehrfach{}       THEN cursor (testfenster, 25, 6);{}
+            out (testfenster, "in Steckplatz " + text (steckplatz)){}    FI;{}    out (testfenster, ")").{}    klammer:{}      IF kanalnummer < 10{}         THEN "  (= "{}         ELSE " (= "{}      FI.{}  kanalnummer muss evtl erfragt werden:{}    SELECT kartenart [1] OF{}      CASE kombi   :  kanalnummer := 4; steckplatz := 1; port := 4{}      CASE eakarte :  kanalnummer := 2; steckplatz := 1; port := 2{}      CASE dakarte :  frage nach kanalnummer auf da karte;{}                      steckplatz  := 1; port := kanalnummer{}
+    OTHERWISE errorstop ("Keine Ausgabe an " + kartenname + " möglich!"){}    END SELECT.{}  kartenname:{}    IF kartenart [1] = ad karte{}       THEN "A/D-Karte"{}       ELSE "leeren Steckplatz"{}    FI.{}  frage nach kanalnummer auf da karte:{}    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{}    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Ausgabe - Kanal (1 oder 2): ");{}    cursor on;{}    REP inchar (nummer){}    UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{}
+    cursor off;{}    IF nummer = ""27""{}       THEN LEAVE teste interface ausgabe{}       ELSE kanalnummer := int (nummer){}    FI.{}    esc q gedrueckt:{}      (nummer = ""27"") AND (incharety (20) = "q").{}  kanalnummer muss erfragt werden:{}    TEXT VAR exit char;{}    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{}    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Ausgabe - Kanal:");{}    cursor on;{}    REP cursor (testfenster, 19, 5);{}
+        editget (testfenster, nummer, 4, 4, "", "q", exit char){}    UNTIL (exit char = ""27"q") OR ausgabekanal eingegeben PER;{}    cursor off;{}    IF exit char = ""27"q"{}       THEN LEAVE teste interface ausgabe{}    FI.{}  ausgabekanal eingegeben:{}    kanalnummer := abs (int (nummer));{}    steckplatz  := kanalnummer DIV 10;{}    port        := kanalnummer MOD 10;{}    IF steckplatz = 0 THEN steckplatz := 1 FI;{}    cursor (testfenster, 2, 7);{}    IF   (kanalnummer < 1) OR (kanalnummer > 49){}
+         THEN out (testfenster, "Unzulässige Kanalnummer!          "); FALSE{}    ELIF (port = 0) OR (port > max portanzahl) OR kein ausgabeport{}         THEN out (testfenster, "Dies ist kein Ausgabe-Kanal!      "); FALSE{}         ELSE out (testfenster, "                                  "); TRUE{}    FI.{}    kein ausgabeport:{}      (port betriebsart <> digital aus) AND (port betriebsart <> analog aus).{}      port betriebsart: karte [sorte][port][betriebsart].{}      sorte           : kartenart [steckplatz].{}
+  teste ausgabe an kanal:{}    TEXT VAR wert;{}    cursor (testfenster, 1, 8);{}    out (testfenster, testfenster xsize * "-");{}    cursor (testfenster, 2, 11);{}    out (testfenster, "Ausgabewert: ");{}    testfenster fussnote ("Bitte einen Wert zwischen 0 und 255 eingeben!");{}    menufootnote ("'Werte ausgeben' beenden: <ESC><q>");{}    cursor on;{}    REP cursor (testfenster, 15, 11);{}        wert := "0";{}        editget (testfenster, wert, 4, 4, "", "qh", exit char);{}        IF exit char = return{}
+           THEN ausgeben (kanalnummer, int (wert) MOD ganzzahlobergrenze){}        ELIF exit char = ""27"h"{}           THEN errorstop ("Programm-Abbruch durch <ESC><h>!"){}        FI{}    UNTIL exitchar = ""27"q" PER;{}    cursor off;{}    IF (steckplatzart = mehrfach) OR (kartenart [1] = da karte){}       THEN cursor (testfenster, 1, 5);{}            out (testfenster, (2 * testfenster xsize) * " ");{}            cursor (testfenster, 2, 11);{}            out (testfenster, "                       ");{}
+            testfenster fussnote ((testfenster xsize - 2) * " "){}       ELSE LEAVE teste interfaceausgabe{}    FI.{}    return: ""13"".{}END PROC teste interfaceausgabe;{}PROC teste interfaceeingabe:{}  INT  VAR kanalnummer, steckplatz, port;{}  TEXT VAR nummer :: "";{}  enable stop;{}  REP hole kanalnummer;{}      teste eingabe vom kanal{}  PER.{}  hole kanalnummer:{}    IF   steckplatzart = 0{}         THEN errorstop ("Interface ist noch nicht konfiguriert!"){}         ELSE kanalnummer erfragen{}
+    FI;{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Eingabe von Kanal " + text (kanalnummer) + klammer +{}                       kanalbeschreibung (steckplatz, port));{}    IF steckplatzart = mehrfach{}       THEN cursor (testfenster, 26, 6);{}            out (testfenster, "in Steckplatz " + text (steckplatz)){}    FI;{}    out (testfenster, ")").{}    klammer:{}      IF kanalnummer < 10{}         THEN "  (= "{}         ELSE " (= "{}      FI.{}  kanalnummer erfragen:{}    SELECT steckplatzart OF{}
+      CASE compact  : drei kanaele anbieten;{}                      steckplatz := 1; port := kanalnummer{}      CASE einzel   : zwei oder drei kanaele anbieten;{}                      steckplatz := 1; port := kanalnummer{}      CASE mehrfach : alle kanaele moeglich{}    END SELECT.{}  drei kanaele anbieten:{}    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{}    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Eingabe - Kanal (1, 2 oder 3): ");{}
+    cursor on;{}    REP inchar (nummer){}    UNTIL (pos ("123", nummer) > 0) OR esc q gedrueckt PER;{}    cursor off;{}    IF nummer = ""27""{}       THEN LEAVE teste interface eingabe{}       ELSE kanalnummer := int (nummer){}    FI.{}    esc q gedrueckt:{}      (nummer = ""27"") AND (incharety (20) = "q").{}  zwei oder drei kanaele anbieten:{}    SELECT kartenart [1] OF{}      CASE kombi    : drei kanaele anbieten{}      CASE ad karte : zwei kanaele anbieten{}      CASE ea karte : kanalnummer := 1{}
+    OTHERWISE errorstop ("Eingabe bei " + kartenname + " nicht möglich!"){}    END SELECT.{}    kartenname:{}      IF kartenart [1] = da karte{}         THEN "D/A-Karte"{}         ELSE "leerem Steckplatz"{}      FI.{}  zwei kanaele anbieten:{}    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{}    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Eingabe - Kanal (1 oder 2): ");{}    cursor on;{}    REP inchar (nummer){}    UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;{}
+    cursor off;{}    IF nummer = ""27""{}       THEN LEAVE teste interface eingabe{}       ELSE kanalnummer := int (nummer){}    FI.{}  alle kanaele moeglich:{}    TEXT VAR exit char;{}    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");{}    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");{}    cursor (testfenster, 2, 5);{}    out (testfenster, "Eingabe - Kanal:");{}    cursor on;{}    REP cursor (testfenster, 19, 5);{}        editget (testfenster, nummer, 4, 4, "", "q", exit char){}    UNTIL (exit char = ""27"q") OR eingabekanal eingegeben PER;{}
+    cursor off;{}    IF exit char = ""27"q"{}       THEN LEAVE teste interface eingabe{}    FI.{}  eingabekanal eingegeben:{}    kanalnummer := abs (int (nummer));{}    steckplatz  := kanalnummer DIV 10;{}    port        := kanalnummer MOD 10;{}    IF steckplatz = 0 THEN steckplatz := 1 FI;{}    cursor (testfenster, 2, 7);{}    IF   (kanalnummer < 1) OR (kanalnummer > 49){}         THEN out (testfenster, "Unzulässige Kanalnummer!          "); FALSE{}    ELIF (port = 0) OR (port > max portanzahl) OR kein eingabeport{}
+         THEN out (testfenster, "Dies ist kein Eingabe-Kanal!      "); FALSE{}         ELSE out (testfenster, "                                  "); TRUE{}    FI.{}    kein eingabeport:{}      (port betriebsart <> digital ein) AND (port betriebsart <> analog ein).{}      port betriebsart: karte [sorte][port][betriebsart].{}      sorte           : kartenart [steckplatz].{}  teste eingabe vom kanal:{}    cursor (testfenster, 1, 8);{}    out (testfenster, testfenster xsize * "-");{}    cursor (testfenster, 2, 11);{}
+    out (testfenster, "Eingelesener Wert: ");{}    testfenster fussnote ("                                             ");{}    menufootnote ("'Werte einlesen' beenden: <ESC><q>");{}    REP cursor (testfenster, 21, 11);{}        out (text (eingabe (kanalnummer), 3));{}        warte (0.1){}    UNTIL abbruch gewuenscht PER;{}    IF (steckplatzart = einzel) AND (kartenart [1] = ea karte){}       THEN LEAVE teste interfaceeingabe{}       ELSE cursor (testfenster, 1, 5);{}            out (testfenster, (2 * testfenster xsize) * " ");{}
+            cursor (testfenster, 2, 11);{}            out (testfenster, "                       "){}    FI.{}END PROC teste interfaceeingabe;{}TEXT PROC kanalbeschreibung (INT CONST steckplatz, port):{}  IF steckplatzart = compact{}     THEN port auf compactbox{}     ELSE port auf steckkarte{}  FI.{}  port auf compactbox:{}    portbeschreibung + " der Compact-Box".{}  port auf steckkarte:{}    SELECT kartenart [steckplatz] OF{}      CASE kombi    : portbeschreibung + " der Kombi-Karte"{}      CASE ea karte : portbeschreibung + " der E/A-Karte"{}
+      CASE da karte : portbeschreibung + " der D/A-Karte"{}      CASE ad karte : portbeschreibung + " der A/D-Karte"{}    OTHERWISE ""{}    END SELECT.{}  portbeschreibung:{}    SELECT 2 + karte [kartenart [steckplatz]][port][betriebsart] OF{}      CASE 1 : "Digitalausgang"{}      CASE 3 : "Digitaleingang"{}      CASE 0 : "Analogausgang " + text (port){}      CASE 4 : "Analogeingang " + text (port){}    OTHERWISE ""{}    END SELECT.{}END PROC kanalbeschreibung;{}PROC trage steckplatzbelegung ein (INT CONST steckplatz, art):{}
+  INT VAR port;{}  kartenart [steckplatz] := art;{}  klaere spannungsbereiche;{}  FOR port FROM 1 UPTO max portanzahl REP{}    trage kanaldaten ein (kanalnummer, spannungsbereich, portdaten);{}    IF steckplatz = 1{}       THEN trage kanaldaten ein (port, spannungsbereich, portdaten){}    FI{}  PER.{}  kanalnummer:  port  +  10 * steckplatz.{}  portdaten  :  karte [kartenart [steckplatz]][port].{}  spannungsbereich:{}    IF   port = 1{}         THEN bereich von e1{}    ELIF port = 2{}         THEN bereich von e2{}
+         ELSE SPANNUNG : (0.0, 0.0){}    FI.{}  klaere spannungsbereiche:{}    SPANNUNG VAR bereich von e1, bereich von e2;{}    SELECT kartenart [steckplatz] OF{}      CASE kombi    : spannungsbereich 0 bis 5 volt{}      CASE da karte : setze spannungsbereiche{}      CASE ad karte : erfrage adkarte schalterstellungen{}    OTHERWISE alles auf 0 setzen{}    END SELECT.{}  spannungsbereich 0 bis 5 volt:{}    bereich von e1 := SPANNUNG : (0.0, 5.0);{}    bereich von e2 := SPANNUNG : (0.0, 5.0).{}  setze spannungsbereiche:{}
+    bereich von e1 := SPANNUNG : (-5.0, 5.0);{}    bereich von e2 := SPANNUNG : ( 0.0, 5.0).{}  alles auf 0 setzen:{}    bereich von e1 := SPANNUNG : (0.0, 0.0);{}    bereich von e2 := SPANNUNG : (0.0, 0.0).{}erfrage adkarte schalterstellungen:{}  REP{}   hole schalterstellung{}  UNTIL schalterstellung sinnvoll PER;{}  bestimme spannungsbereiche (schalterzustand, bereich von e1, bereich von e2).{}  hole schalterstellung:{}    TEXT VAR schalterzustand := menuanswer (infotext, "00000000", 5).{}  infotext:{}
+    ueberschrift{}    + "  Bitte die aktuelle Schalterstellung eintragen: "13""13""{}    + "  Es bedeutet :  1  -  Schalterstellung 'on'     "13""{}    + "                 0  -  Schalterstellung 'off'    "13""13""{}    + " Nummer : 12345678 "13""{}    + "          |||||||| ".{} ueberschrift:{}   IF steckplatzart = mehrfach{}      THEN " "15"Angabe der Schalterstellungen auf der A/D-Karte "14""13""{}         + " "15"                in Steckplatz "{}         + text (steckplatz) + ":                "14""13""13""{}
+      ELSE " "15"Angabe der Schalterstellungen auf der A/D-Karte: "14""13""13""{}   FI.{} schalterstellung sinnvoll:{}   (length (schalterzustand) = 8) AND nur nullen und einsen.{} nur nullen und einsen:{}   BOOL VAR ok := TRUE; INT VAR m;{}   FOR m FROM 1 UPTO 8 REP{}     IF NOT ((schalterzustand SUB m) = "1" OR (schalterzustand SUB m ) = "0"){}        THEN ok := FALSE{}     FI{}   PER;{}   ok.{}END PROC trage steckplatzbelegung ein;{}INT PROC ermittelte kartenart (INT CONST steckplatz):{}  TEXT CONST info e ::  "     "15"Angabe der Interfacekarte: "14"    "13""13""{}
+                      + "     k   Kombikarte              "13""{}                      + "     e   E / A - Karte           "13""{}                      + "     d   D / A - Wandler - Karte "13""{}                      + "     a   A / D - Wandler - Karte "13""{}                      + "     0   Keine Steckkarte        ",{}             info m ::  "  "15"Angabe der Interfacekarte für Steckplatz "{}                      + text (steckplatz) + ": "14" "13""13""{}                      + "             k   Kombikarte              "13""{}
+                      + "             e   E / A - Karte           "13""{}                      + "             d   D / A - Wandler - Karte "13""{}                      + "             a   A / D - Wandler - Karte "13""{}                      + "             0   Keine Steckkarte        ",{}             liste  :: "Kombi"13"E/A"13"D/A"13"A/D"13"Keine",{}             tasten :: "keda0KEDA";{}   INT VAR auswahl := menualternative (infotext, liste, tasten, 5, FALSE);{}   SELECT auswahl OF{}     CASE 1, 101, 106 :  kombi{}
+     CASE 2, 102, 107 :  eakarte{}     CASE 3, 103, 108 :  dakarte{}     CASE 4, 104, 109 :  adkarte{}     OTHERWISE           keine karte{}   END SELECT.{}   infotext:{}     IF steckplatz = 0{}        THEN info e{}        ELSE info m{}     FI.{}END PROC ermittelte kartenart;{}PROC zeige kanalbelegung (INT  CONST steckplatz):{}   ROW 4 TEXT VAR kanalnummer;{}   kanalnummer [1] := text (steckplatz + 1, 2);{}   kanalnummer [2] := text (steckplatz + 2, 2);{}   kanalnummer [3] := text (steckplatz + 3, 2);{}
+   kanalnummer [4] := text (steckplatz + 4, 2);{}   IF steckplatzart = compact{}      THEN zeige compactboxbelegung{}      ELSE zeige steckplatz mit karte{}   FI.{}  zeige steckplatz mit karte:{}    SELECT kartenart [steckplatznummer] OF{}      CASE kombi  : zeige steckplatz mit kombi{}      CASE eakarte: zeige steckplatz mit eakarte{}      CASE dakarte: zeige steckplatz mit dakarte{}      CASE adkarte: zeige steckplatz mit adkarte{}      OTHERWISE     zeige steckplatz ohne karte{}    END SELECT.{}
+  steckplatznummer:{}    IF steckplatz = 0{}       THEN 1{}       ELSE steckplatz DIV 10{}    FI.{}  zeige compactboxbelegung:{}    menuinfo ({}      "              "15"Eingestellt: Compactbox "14"         "13""13""{}    + "                 Belegung der Kanäle:               "13""13""13""{}    + kanalnummeranzeige kombikarte).{}  zeige steckplatz mit kombi:{}    menuinfo (ueberschrift + " mit Kombikarte: "14"    "13""13""{}    + "                Belegung der Kanäle:               "13""13""13""{}    + kanalnummeranzeige kombikarte).{}
+  zeige steckplatz mit eakarte:{}    menuinfo (ueberschrift + " mit E / A - Karte: "14"    "13""13""{}    + "                Belegung der Kanäle:               "13""13""13""{}    + kanalnummeranzeige eakarte).{}  zeige steckplatz mit dakarte:{}    menuinfo (ueberschrift + " mit D / A - Karte: "14"    "13""13""{}    + "                Belegung der Kanäle:               "13""13""{}    + kanalnummeranzeige dakarte).{}  zeige steckplatz mit adkarte:{}    hole spannungsbereiche;{}    menuinfo ("     " + ueberschrift + " mit A / D - Karte: "14""13""13""{}
+    + "           Zwei analoge Eingänge stehen zur Verfügung:   "13""13""{}    + kanalnummeranzeige adkarte).{}  hole spannungsbereiche:{}    SPANNUNG VAR e1 bereich, e2 bereich;{}    hole spannungsbereich (steckplatz + 1, e1 bereich [1], e1 bereich [2]);{}    hole spannungsbereich (steckplatz + 2, e2 bereich [1], e2 bereich [2]).{}  zeige steckplatz ohne karte:{}    IF steckplatz = 0{}       THEN menuinfo ({}            "    "15"Einzelsteckplatz ohne Steckkarte: "14"   "13""13""13""{}          + " Es sind weder Ein- noch Ausgaben möglich! "13""){}
+       ELSE menuinfo ({}            "        "15"Steckplatz "{}          + text (steckplatz DIV 10) + " ohne Steckkarte: "14""13""13""13""{}          + " Es sind hier weder Ein- noch Ausgaben möglich! "13""){}    FI.{}  ueberschrift:{}    IF steckplatz = 0{}       THEN "         "15"Einzelsteckplatz"{}       ELSE "           "15"Steckplatz " + text (steckplatz DIV 10){}    FI.{}  kanalnummeranzeige kombikarte:{}      "     "15"Kanal " + kanalnummer [1]{}                             + ": "14"  Analogeingang 1 (E1) "13""13""{}
+    + "     "15"Kanal " + kanalnummer [2]{}                             + ": "14"  Analogeingang 2 (E2) "13""13""{}    + "     "15"Kanal " + kanalnummer [3]{}                             + ": "14"  Digitaleingang       "13""13""{}    + "     "15"Kanal " + kanalnummer [4]{}                             + ": "14"  Digitalausgang       "13"".{}  kanalnummeranzeige eakarte:{}    "     "15"Kanal " + kanalnummer [1]{}    + ": "14"  Digitaleingang "13""13""{}    + "     "15"Kanal " + kanalnummer [2]{}    + ": "14"  Digitalausgang "13""13""{}
+    + "   ( "15"Kanal " + kanalnummer [3]{}    + ": "14"  Digitaleingang (= Kanal " + kanalnummer [1] + ") )"13""13""{}    + "   ( "15"Kanal " + kanalnummer [4]{}    + ": "14"  Digitalausgang (= Kanal " + kanalnummer [2] + ") )"13"".{}  kanalnummeranzeige adkarte:{}      "  "15"Kanal " + kanalnummer [1]{}                     + ": "14" (E1)  Spannungsbereich  " + bereich1 + ""13""13""{}    + "  "15"Kanal " + kanalnummer [2]{}                     + ": "14" (E2)  Spannungsbereich  " + bereich2 + ""13"".{}
+  bereich1:{}    IF e1 bereich [1] = 0.0{}       THEN "  0.000 V  -  +" + text (e1 bereich [2], 6, 3) + " V  "{}       ELSE text (e1 bereich [1], 7, 3) + " V  -  +" + text (e1 bereich [2], 6, 3) + " V  "{}    FI.{}  bereich2:{}    IF e2 bereich [1] = 0.0{}       THEN "  0.000 V  -  +" + text (e2 bereich [2], 6, 3) + " V"{}       ELSE text (e2 bereich [1], 7, 3) + " V  -  +" + text (e2 bereich [2], 6, 3) + " V"{}    FI.{}  kanalnummeranzeige dakarte:{}      "  Die Karte stellt einen Analogausgang zur Verfügung, "13""{}
+    + "  der auf zwei Arten angesprochen werden kann:        "13""13""13""{}    + "     "15"Kanal " + kanalnummer [1]{}                               + ": "14"  Spannungsbereich  -5 V  -  +5 V "13""13""{}    + "     "15"Kanal " + kanalnummer [2]{}                               + ": "14"  Spannungsbereich   0 V  -  +5 V "13"".{}END PROC zeige kanalbelegung;{}PROC bestimme spannungsbereiche (TEXT CONST schalterstellung,{}                                 SPANNUNG VAR bereich von e1,{}                                 SPANNUNG VAR bereich von e2):{}
+  bestimme bereich von e1;{}  bestimme bereich von e2.{}  bestimme bereich von e1:{}    IF   schalter 3 geschlossen{}         THEN umax1 :=  0.25{}    ELIF schalter 2 geschlossen{}         THEN umax1 :=  2.5{}    ELIF schalter 1 geschlossen{}         THEN umax1 := 25.0{}         ELSE umax1 :=  0.0{}    FI;{}    IF schalter 8 geschlossen{}       THEN symmetrische spannungsmessung ueber e1{}       ELSE asymmetrische spannungsmessung ueber e1{}    FI.{}    schalter 1 geschlossen:  (schalterstellung SUB 1) = on.{}
+    schalter 2 geschlossen:  (schalterstellung SUB 2) = on.{}    schalter 3 geschlossen:  (schalterstellung SUB 3) = on.{}    schalter 8 geschlossen:  (schalterstellung SUB 8) = on.{}    umin1:  bereich von e1 [1].{}    umax1:  bereich von e1 [2].{}  symmetrische spannungsmessung ueber e1:{}    umax1 := umax1 / 2.0;{}    umin1 := - umax1.{}  asymmetrische spannungsmessung ueber e1:{}    umin1 := 0.0.{}  bestimme bereich von e2:{}    IF   schalter 6 geschlossen{}         THEN umax2 :=  0.25{}    ELIF schalter 5 geschlossen{}
+         THEN umax2 :=  2.5{}    ELIF schalter 4 geschlossen{}         THEN umax2 := 25.0{}         ELSE umax2 :=  0.0{}    FI;{}    IF schalter 7 geschlossen{}       THEN symmetrische spannungsmessung ueber e2{}       ELSE asymmetrische spannungsmessung ueber e2{}    FI.{}    schalter 4 geschlossen:  (schalterstellung SUB 4) = on.{}    schalter 5 geschlossen:  (schalterstellung SUB 5) = on.{}    schalter 6 geschlossen:  (schalterstellung SUB 6) = on.{}    schalter 7 geschlossen:  (schalterstellung SUB 7) = on.{}
+    umin2:  bereich von e2 [1].{}    umax2:  bereich von e2 [2].{}  symmetrische spannungsmessung ueber e2:{}    umax2 := umax2 / 2.0;{}    umin2 := - umax2.{}  asymmetrische spannungsmessung ueber e2:{}    umin2 := 0.0.{}  on:  "1".{}END PROC bestimme spannungsbereiche{}END PACKET ls prozess 5{}
+
diff --git a/prozess/ls-Prozess-gen b/app/gs.process/1.02/src/ls-Prozess-gen
index b93e4b9..b93e4b9 100644
--- a/prozess/ls-Prozess-gen
+++ b/app/gs.process/1.02/src/ls-Prozess-gen
diff --git a/doc/warenhaus/Anhang Warenhaus b/app/gs.warenhaus/1.01/doc/Anhang Warenhaus
index 9388ceb..9388ceb 100644
--- a/doc/warenhaus/Anhang Warenhaus
+++ b/app/gs.warenhaus/1.01/doc/Anhang Warenhaus
diff --git a/doc/warenhaus/Inhalt Warenhaus b/app/gs.warenhaus/1.01/doc/Inhalt Warenhaus
index a9b720d..a9b720d 100644
--- a/doc/warenhaus/Inhalt Warenhaus
+++ b/app/gs.warenhaus/1.01/doc/Inhalt Warenhaus
diff --git a/doc/warenhaus/gs-Warenhaus handbuch.impressum b/app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum
index 3fbb371..3fbb371 100644
--- a/doc/warenhaus/gs-Warenhaus handbuch.impressum
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus handbuch.impressum
diff --git a/doc/warenhaus/gs-Warenhaus-1 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-1
index ca79094..ca79094 100644
--- a/doc/warenhaus/gs-Warenhaus-1
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-1
diff --git a/doc/warenhaus/gs-Warenhaus-2 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-2
index f3f1284..f3f1284 100644
--- a/doc/warenhaus/gs-Warenhaus-2
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-2
diff --git a/doc/warenhaus/gs-Warenhaus-3 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-3
index ffef881..ffef881 100644
--- a/doc/warenhaus/gs-Warenhaus-3
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-3
diff --git a/doc/warenhaus/gs-Warenhaus-4 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-4
index 2c5d7dc..2c5d7dc 100644
--- a/doc/warenhaus/gs-Warenhaus-4
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-4
diff --git a/doc/warenhaus/gs-Warenhaus-5 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-5
index c1164ad..c1164ad 100644
--- a/doc/warenhaus/gs-Warenhaus-5
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-5
diff --git a/doc/warenhaus/gs-Warenhaus-6 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-6
index 3edf312..3edf312 100644
--- a/doc/warenhaus/gs-Warenhaus-6
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-6
diff --git a/doc/warenhaus/gs-Warenhaus-7 b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-7
index 3a55dfe..3a55dfe 100644
--- a/doc/warenhaus/gs-Warenhaus-7
+++ b/app/gs.warenhaus/1.01/doc/gs-Warenhaus-7
diff --git a/app/gs.warenhaus/1.01/source-disk b/app/gs.warenhaus/1.01/source-disk
new file mode 100644
index 0000000..74c6338
--- /dev/null
+++ b/app/gs.warenhaus/1.01/source-disk
@@ -0,0 +1 @@
+informatikpaket/08_gs.warenhaus.img
diff --git a/warenhaus/ls-MENUKARTE:Warenhaus b/app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus
index 414470a..414470a 100644
--- a/warenhaus/ls-MENUKARTE:Warenhaus
+++ b/app/gs.warenhaus/1.01/src/ls-MENUKARTE:Warenhaus
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
new file mode 100644
index 0000000..36de5ef
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
@@ -0,0 +1,36 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 0                    ** 
+         **                                                      ** 
+         **    Anpassung für Kartenleser an  AKTRONIC-Adapter    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 0  DEFINES                       
+       interface anpassung,{}       oeffne interface,{}       schliesse interface,{}       wert von interface,{}       pressed key,{}(* --------------------------- *){}       kanalkoppler,{}       interfacechannel,{}       init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";{}LET  max channel = 24,{}     initcode    = 26,{}     endcode     = 27,{}     read code   = 28;{}INT CONST  nicht initialisiert code :: -3,{}           interface error code     :: -4,{}
+           kanal besetzt code       :: -5;{}INT  VAR  interfacekanal  :: 0;{}TEXT VAR  puffer          :: "";{}TASK VAR  hardwaremanager :: niltask,{}          interface task  :: niltask,{}          absender;{}DATASPACE VAR  ds :: nilspace;{}INT PROC interfacechannel:{}  interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{}  puffer := "";{}  forget (ds); ds := nilspace;{}  pingpong (interfacetask, init code, ds, status);{}  IF status > 0 THEN status DECR maxint FI;{}
+  forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{}  INT VAR wert;{}  puffer CAT incharety (1);{}  call (interface task, read code, ds, wert);{}  wert.{}END PROC wert von interface;{}PROC schliesse interface:{}  forget (ds); ds := nilspace;{}  send (interface task, end code, ds);{}  forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{}  IF puffer = ""{}     THEN incharety{}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}
+    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{}  IF puffer = ""{}     THEN incharety (warten){}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{}  enable stop;{}  IF name (myself) <> "-"{}
+     THEN errorstop ("Unzulässiges Kommando!"){}     ELSE warte auf anrufe{}  FI.{}  warte auf anrufe:{}    INT VAR codenummer, antwort;{}    disable stop;{}    REP wait (ds, codenummer, absender);{}        reagiere auf anruf;{}        loesche ggf fehlerzustand{}    PER.{}  reagiere auf anruf:{}    IF codenummer = initcode{}       THEN kopple an interface;{}            IF interface ist betriebsbereit{}               THEN bearbeite weitere auftraege{}               ELSE gib negative rueckmeldung{}
+            FI;{}            gib kanal frei{}       ELSE send (absender, nicht initialisiert code, ds){}    FI.{}  loesche ggf fehlerzustand:{}    IF is error{}       THEN clear error{}    FI.{} kopple an interface:{}  IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{}     THEN antwort := kanal besetzt code;{}     ELSE continue (interfacekanal);{}          teste interface{}  FI.{} teste interface:{}  leere puffer;{}  out (""240"");{}  IF incharety (1) <> ""{}     THEN antwort := 0;{}
+          out (""176""){}     ELSE antwort := interface error code{}  FI.{}  leere puffer:{}    REP  UNTIL incharety = "" PER.{} interface ist betriebsbereit:  antwort = 0.{} gib negative rueckmeldung:     send (absender, antwort, ds).{} gib kanal frei:                break (quiet).{} ende:                          out (""176"").{} bearbeite weitere auftraege:{}   REP   pingpong (absender, antwort, ds, codenummer);{}         IF   codenummer = read code{}              THEN hole wert von interface{}
+         ELIF codenummer < 0{}              THEN send (absender, codenummer, ds);{}                   codenummer := endcode{}              ELSE antwort := 0{}         FI{}   UNTIL codenummer = endcode PER;{}   ende.{} hole wert von interface:{}    out (""211"");{}    antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{}  teste auf zulaessigkeit;{}  loesche interfacetask;{}  erfrage interface kanal;{}  generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{}
+  enable stop;{}  IF hardwaremanager <> niltask AND hardwaremanager <> myself{}     THEN errorstop ("Dieses Kommando kann nur von der Task '" +{}                      name (hardwaremanager) + "' aus gegeben werden!"){}     ELSE hardwaremanager := myself{}  FI.{} loesche interfacetask:{}  disable stop;{}  end (interfacetask);{}  IF is error THEN clear error FI;{}  enable stop.{} generiere ggf neue interfacetask:{}  IF interface kanal = 0{}     THEN interface task  := niltask;{}          hardwaremanager := niltask{}
+     ELSE begin (PROC kanalkoppler, interface task);{}          hardwaremanager := myself{}  FI.{} erfrage interfacekanal:{}   INT VAR kanalnummer;{}   put ("Gib Interface - Kanal:");{}   get (kanalnummer);{}   set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{}  IF channel number < 0 OR channel number > max channel{}     THEN errorstop ("Unzulässige Kanalnummer"){}     ELSE interfacekanal := channel number{}  FI{}END PROC set interface channel;{}
+BOOL OP <> (TASK CONST t1, t2):{}  NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
new file mode 100644
index 0000000..f108f7b
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
@@ -0,0 +1,36 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 0                    ** 
+         **                                                      ** 
+         **    Anpassung für Kartenleser an MUFI als Endgerät    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 0  DEFINES                       
+       interface anpassung,{}       oeffne interface,{}       schliesse interface,{}       wert von interface,{}       pressed key,{}(* --------------------------- *){}       kanalkoppler,{}       interfacechannel,{}       init interfacechannel:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";{}LET  mufikennung = ""27""27"",{}     max channel = 24,{}     initcode    = 26,{}     endcode     = 27,{}     read code   = 28;{}INT CONST  nicht initialisiert code :: -3,{}           interface error code     :: -4,{}
+           kanal besetzt code       :: -5;{}INT  VAR  interfacekanal  :: 2;{}TEXT VAR  puffer          :: "";{}TASK VAR  hardwaremanager :: niltask,{}          interface task  :: niltask,{}          absender;{}DATASPACE VAR  ds :: nilspace;{}INT PROC interfacechannel:{}  interfacekanal{}END PROC interfacechannel;{}PROC oeffne interface (INT VAR status):{}  puffer := "";{}  forget (ds); ds := nilspace;{}  pingpong (interfacetask, init code, ds, status);{}  IF status > 0 THEN status DECR maxint FI;{}
+  forget (ds); ds := nilspace{}END PROC oeffne interface;{}INT PROC wert von interface:{}  INT VAR wert;{}  puffer CAT incharety (1);{}  call (interface task, read code, ds, wert);{}  wert.{}END PROC wert von interface;{}PROC schliesse interface:{}  forget (ds); ds := nilspace;{}  send (interface task, end code, ds);{}  forget (ds); ds := nilspace{}END PROC schliesse interface;{}TEXT PROC pressed key:{}  IF puffer = ""{}     THEN incharety{}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}
+    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{}  IF puffer = ""{}     THEN incharety (warten){}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}(*************************************************************************){}PROC kanalkoppler:{}  enable stop;{}  IF name (myself) <> "-"{}
+     THEN errorstop ("Unzulässiges Kommando!"){}     ELSE warte auf anrufe{}  FI.{}  warte auf anrufe:{}    INT VAR codenummer, antwort;{}    disable stop;{}    REP wait (ds, codenummer, absender);{}        reagiere auf anruf;{}        loesche ggf fehlerzustand{}    PER.{}  reagiere auf anruf:{}    IF codenummer = initcode{}       THEN kopple an interface;{}            IF interface ist betriebsbereit{}               THEN bearbeite weitere auftraege{}               ELSE gib negative rueckmeldung{}
+            FI;{}            gib kanal frei{}       ELSE send (absender, nicht initialisiert code, ds){}    FI.{}  loesche ggf fehlerzustand:{}    IF is error{}       THEN clear error{}    FI.{} kopple an interface:{}  IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself{}     THEN antwort := kanal besetzt code;{}     ELSE continue (interfacekanal);{}          teste interface{}  FI.{} teste interface:{}  leere puffer;{}  out (mufikennung + "10");{}  fange status;{}  IF status = mufikennung + "00"{}
+     THEN antwort := 0;{}          out (mufikennung + "1A18"22""){}     ELSE antwort := interface error code{}  FI.{}  leere puffer:{}    REP  UNTIL incharety = "" PER.{}  fange status:{}    INT  VAR zaehler;{}    TEXT VAR status :: "";{}    FOR zaehler FROM 1 UPTO 4 REP{}      status CAT incharety (1){}    PER.{} interface ist betriebsbereit:  antwort = 0.{} gib negative rueckmeldung:     send (absender, antwort, ds).{} gib kanal frei:                break (quiet).{} ende:                          out (""25"").{}
+ bearbeite weitere auftraege:{}   REP   pingpong (absender, antwort, ds, codenummer);{}         IF   codenummer = read code{}              THEN hole wert von interface{}         ELIF codenummer < 0{}              THEN send (absender, codenummer, ds);{}                   codenummer := endcode{}              ELSE antwort := 0{}         FI{}   UNTIL codenummer = endcode PER;{}   ende.{} hole wert von interface:{}    out (""76"");{}    antwort := code (incharety (1)).{}END PROC kanalkoppler;{}PROC init interfacechannel:{}
+  teste auf zulaessigkeit;{}  loesche interfacetask;{}  erfrage interface kanal;{}  generiere ggf neue interfacetask.{} teste auf zulaessigkeit:{}  enable stop;{}  IF hardwaremanager <> niltask AND hardwaremanager <> myself{}     THEN errorstop ("Dieses Kommando kann nur von der Task '" +{}                      name (hardwaremanager) + "' aus gegeben werden!"){}  FI.{} loesche interfacetask:{}  disable stop;{}  end (interfacetask);{}  IF is error THEN clear error FI;{}  enable stop.{} generiere ggf neue interfacetask:{}
+  IF interface kanal = 0{}     THEN interface task  := niltask;{}          hardwaremanager := niltask{}     ELSE begin (PROC kanalkoppler, interface task);{}          hardwaremanager := myself{}  FI.{} erfrage interfacekanal:{}   INT VAR kanalnummer;{}   put ("Gib Interface - Kanal:");{}   get (kanalnummer);{}   set interfacechannel (kanalnummer).{}END PROC init interfacechannel;{}PROC set interface channel (INT CONST channel number):{}  IF channel number < 0 OR channel number > max channel{}     THEN errorstop ("Unzulässige Kanalnummer!"){}
+     ELSE interface kanal := channel number{}  FI{}END PROC set interface channel;{}BOOL OP <> (TASK CONST t1, t2):{}  NOT (t1 = t2){}END OP <>;{}init interfacechannel{}END PACKET ls warenhaus 0{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
new file mode 100644
index 0000000..30c69da
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
@@ -0,0 +1,30 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 0                    ** 
+         **                                                      ** 
+         **  Anpassung für Kartenleser an MUFI im Terminalkanal  ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 0  DEFINES                     
+       interface anpassung,{}       oeffne interface,{}       schliesse interface,{}       wert von interface,{}       pressed key:{}TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";{}LET  mufikennung = ""31""31"";{}INT  CONST interface error code :: -4;{}TEXT CONST readcode :: mufikennung + "4C";{}TEXT VAR   puffer   :: "";{}PROC oeffne interface (INT VAR status):{}  cursor (2,24);{}  warte etwas;{}  leere eingangspuffer;{}  out (""27""27"10");{}  fange antwort;{}  IF antwort = ""27""27"00"{}
+     THEN status := 0;{}          out (""27""27"1C" + hex (mufikennung)){}     ELSE status := interface error code{}  FI.{}  warte etwas:{}    pause (1); pause (1); pause (1); pause (1); pause (1).{}  leere eingangspuffer:{}    puffer := "";{}    REP UNTIL incharety = "" PER.{}  fange antwort:{}    TEXT VAR antwort :: incharety (1);{}    INT VAR i;{}    FOR i FROM 1 UPTO 3 REP{}      antwort CAT incharety (1){}    PER.{}END PROC oeffne interface;{}INT PROC wert von interface:{}  puffer CAT incharety (1);{}
+  out (readcode);{}  fange mufikennung;{}  dezimalwert (incharety (1), incharety (1)).{}  fange mufikennung:{}    REP puffer CAT incharety{}    UNTIL pos (puffer, mufikennung) > 0 PER;{}    change (puffer, mufikennung, "").{}END PROC wert von interface;{}PROC schliesse interface:{}  cursor (2,24);{}  out (mufikennung + "1C" + hex (""27""27"")){}END PROC schliesse interface;{}TEXT PROC pressed key:{}  IF puffer = ""{}     THEN incharety{}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}
+    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{}  IF puffer = ""{}     THEN incharety (warten){}     ELSE erstes pufferzeichen{}  FI.{}  erstes pufferzeichen:{}    TEXT VAR zeichen :: puffer SUB 1;{}    puffer := subtext (puffer, 2);{}    zeichen.{}END PROC pressed key;{}INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):{}  16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).{}
+  hexzeichen: "123456789ABCDEF".{}END PROC dezimalwert;{}TEXT PROC hex (TEXT CONST zwei zeichen):{}  hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2)){}END PROC hex;{}TEXT PROC hex (INT CONST wert):{}  (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).{}  hexzeichen: "0123456789ABCDEF".{}END PROC hex{}END PACKET ls warenhaus 0{}
+
diff --git a/warenhaus/ls-Warenhaus 0: ohne Kartenleser b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser
index 96af5c1..4912d64 100644
--- a/warenhaus/ls-Warenhaus 0: ohne Kartenleser
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 0: ohne Kartenleser
@@ -22,28 +22,6 @@
  
                                                                            *) 
 PACKET ls warenhaus 0 DEFINES                    
-       interface anpassung,
-       oeffne interface,
-       schliesse interface,
-       wert von interface,
-       pressed key:
-TEXT CONST interface anpassung :: "ohne Kartenleser";
-PROC oeffne interface (INT VAR test):
-  test := -6
-END PROC oeffne interface;
-PROC schliesse interface:
-END PROC schliesse interface;
-INT PROC wert von interface:
-  INT VAR wert :: 0;
-  wert
-END PROC wert von interface;
-TEXT PROC pressed key:
-  incharety
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
-
-  incharety (warten)
-END PROC pressed key;
-END PACKET ls warenhaus 0
-
+       interface anpassung,{}       oeffne interface,{}       schliesse interface,{}       wert von interface,{}       pressed key:{}TEXT CONST interface anpassung :: "ohne Kartenleser";{}PROC oeffne interface (INT VAR test):{}  test := -6{}END PROC oeffne interface;{}PROC schliesse interface:{}END PROC schliesse interface;{}INT PROC wert von interface:{}  INT VAR wert :: 0;{}  wert{}END PROC wert von interface;{}TEXT PROC pressed key:{}  incharety{}END PROC pressed key;{}TEXT PROC pressed key (INT CONST warten):{}
+  incharety (warten){}END PROC pressed key;{}END PACKET ls warenhaus 0{}
 
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 1 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 1
new file mode 100644
index 0000000..81fd8ee
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 1
@@ -0,0 +1,37 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 1                    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET monitor alt DEFINES original monitor:          
+  PROC original monitor:{}    monitor{}  END PROC originalmonitor{}END PACKET monitor alt;{}PACKET ls warenhaus 1 DEFINES{}       zentrale,{}       monitor,{}       warenhaus direktstart,{}       warenhaus hauptstelle,{}       hauptstellenname:{}LET  max kundenzahl             =  31,{}     min kundennummer           = 129,{}     kundendatei holen code     = 100,{}     kundendatei ergaenzen code = 200;{}TYPE KUNDENDATEN   = STRUCT (TEXT nachname, vorname, geschlecht),{}     KUNDENDATEI   = ROW max kundenzahl KUNDENDATEN;{}{}
+BOUND KUNDENDATEN VAR kundendaten;{}BOUND KUNDENDATEI VAR bound kundendatei;{}KUNDENDATEI VAR kundendatei;{}DATASPACE   VAR ds;{}TASK        VAR absender,{}                zentraltask        :: niltask,{}                hauptstelle        :: niltask,{}                direktstartmanager :: niltask;{}BOOL        VAR mit direktstart    :: FALSE,{}                mit loeschen       :: FALSE;{}INT         VAR codenummer;{}PROC zentrale:{}  enable stop;{}  IF pos (name (myself), ".Zentrale") = 0{}     THEN errorstop ("Unzulaessiger Befehl!"){}{}
+  FI;{}  disable stop;{}  REP wait (ds, codenummer, absender);{}      bearbeite auftrag;{}      send (absender, codenummer, ds);{}      IF is error THEN clear error FI{}  PER.{}  bearbeite auftrag:{}    IF   codenummer = kundendatei holen code{}         THEN hole kundendatei{}    ELIF codenummer = kundendatei ergaenzen code{}         THEN ergaenze kundendatei{}    ELIF codenummer >= min kundennummer{}         THEN lies kundendaten{}         ELSE speichere kundendaten{}    FI.{}END PROC zentrale;{}{}
+PROC hole kundendatei:{}  bound kundendatei := ds;{}  bound kundendatei := kundendatei{}END PROC hole kundendatei;{}PROC ergaenze kundendatei:{}  INT VAR kundennummer;{}  bound kundendatei := ds;{}  FOR kundennummer FROM 1 UPTO max kundenzahl REP{}    IF kundendatei [kundennummer].nachname = ""{}       THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]{}    FI{}  PER;{}  init ds{}END PROC ergaenze kundendatei;{}PROC lies kundendaten:{}  kundendaten := ds;{}  kundendaten := kundendatei [platznummer].{}{}
+  platznummer: codenummer - min kundennummer + 1.{}END PROC lies kundendaten;{}PROC speichere kundendaten:{}  kundendaten := ds;{}  kundendatei [codenummer] := kundendaten;{}  init ds{}END PROC speichere kundendaten;{}PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):{}  enable stop;{}  IF task soll hauptstelle sein{}     THEN mache task zur hauptstelle{}     ELSE mache hauptstellenstatus rueckgaengig{}  FI.{}  mache task zur hauptstelle:{}    sei eine hauptstelle;{}    line (2);{}{}
+    IF NOT mit direktstart CAND yes ("Mit Direktstart"){}       THEN warenhaus direktstart (TRUE){}       ELSE global manager{}    FI{}END PROC warenhaus hauptstelle;{}PROC sei eine hauptstelle:{}  IF NOT (hauptstelle = niltask OR hauptstelle = myself){}     THEN errorstop ("Hauptstelle ist bereits die Task '" +{}                      name (hauptstelle) + "'!"){}  FI;{}  disable stop;{}  end (zentraltask);{}  IF is error THEN clear error FI;{}  enable stop;{}  hauptstelle := niltask;{}  begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);{}{}
+  hauptstelle := myself{}END PROC sei eine hauptstelle;{}PROC mache hauptstellenstatus rueckgaengig:{}  IF NOT (hauptstelle = niltask OR hauptstelle = myself){}     THEN errorstop ("Dieses Kommando darf nur in der Task '" +{}                      name (hauptstelle) + " gegeben werden!"){}  FI;{}  disable stop;{}  end (zentraltask);{}  IF is error THEN clear error FI;{}  enable stop;{}  hauptstelle := niltask;{}  warenhaus direktstart (FALSE){}END PROC mache hauptstellenstatus rueckgaengig;{}PROC warenhaus direktstart (BOOL CONST wahl):{}{}
+  pruefe zulaessigkeit;{}  mit direktstart := wahl;{}  IF mit direktstart{}     THEN direktstartmanager := myself;{}          mit loeschen := yes ("Mit automatischem Löschen"){}     ELSE direktstartmanager := niltask{}  FI;{}  global manager.{}  pruefe zulaessigkeit:{}    enable stop;{}    IF NOT (direktstartmanager = niltask OR direktstartmanager = myself){}       THEN errorstop ("Der Direktstart kann nur aus der Task '" +{}                        name (direktstartmanager) + "'geaendert werden!"){}{}
+    FI.{}END PROC warenhaus direktstart;{}TEXT PROC hauptstellenname:{}  name (hauptstelle){}END PROC hauptstellenname;{}PROC monitor:{}  IF mit direktstart{}     THEN warenhaus monitor{}     ELSE original  monitor{}  FI{}END PROC monitor;{}PROC warenhausmonitor:{}  disable stop;{}  INT VAR previous heapsize := heap size;{}  REP command dialogue (TRUE);{}      sysin (""); sysout ("");{}      cry if not enough storage;{}      reset dialog; erase menunotice;{}      do ("warenhaus");{}      IF is error{}{}
+         THEN clear error{}         ELSE sitzungsende{}      FI{}  PER.{}  sitzungsende:{}    collect heap garbage if necessary;{}    page;{}    IF mit loeschen{}       THEN break; end (myself){}       ELSE end; break{}    FI.{}  collect heap garbage if necessary:{}    IF heap size > previous heapsize + 10{}       THEN collect heap garbage;{}            previous heapsize := heap size{}    FI.{}  cry if not enough storage:{}    INT VAR size, used;{}    storage (size, used);{}    IF used > size{}       THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10""){}{}
+    FI.{}END PROC warenhausmonitor;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{}   CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):{}   CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC init ds:{}  forget (ds); ds := nilspace{}END PROC init ds;{}PROC initialisiere kundendatei:{}  KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");{}  INT VAR nr;{}  FOR nr FROM 1 UPTO max kundenzahl REP{}      kundendatei [nr] := leer{}  PER{}END PROC initialisiere kundendatei;{}{}
+initialisiere kundendatei{}END PACKET ls warenhaus 1{}{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 2 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 2
new file mode 100644
index 0000000..7048aff
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 2
@@ -0,0 +1,112 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 2                    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 2 DEFINES                        
+       max artikelzahl,{}       max kundenzahl,{}       min kundennummer,{}       max kundennummer,{}       min artikelnummer,{}       max artikelnummer,{}       filialverwaltung,{}       initialisiere verwaltung,{}       hole artikeldaten,{}       speichere artikeldaten,{}       registriere verkauf,{}       hole kundendaten,{}       speichere kundendaten,{}       sichere filialdaten,{}       lade filialdaten,{}       hole bestelliste,{}       hole auskunft ein:{}LET  max filialen  =  10,{}     max artikel   =  15,{}
+     max kunden    =  31,{}     min kundennr  = 129,{}     max kundennr  = 159,{}     min artikelnr =   1,{}     max artikelnr =  15;{}LET  zentrale kundendatei holen code     = 100,{}     zentrale kundendatei ergaenzen code = 200,{}     filialdaten holen code              = 201,{}     filialdaten ergaenzen code          = 202;{}INT CONST max artikelzahl   :: max artikel,{}          max kundenzahl    :: max kunden,{}          min kundennummer  :: min kundennr,{}          max kundennummer  :: max kundennr,{}
+          min artikelnummer :: min artikelnr,{}          max artikelnummer :: max artikelnr;{}TYPE ARTIKELDATEN  = STRUCT (TEXT artikelname, REAL preis,{}                             INT  mindestbestand, bestand),{}     KUNDENDATEN   = STRUCT (TEXT nachname, vorname, geschlecht),{}     WARENDATEI    = ROW max artikel ARTIKELDATEN,{}     KUNDENDATEI   = ROW max kunden  KUNDENDATEN,{}     EINKAUFSDATEI = ROW max kunden  ROW max artikel INT,{}     VERKAUFSDATEI = ROW max artikel INT,{}     FILIALDATEN   = STRUCT (WARENDATEI waren, KUNDENDATEI kunden,{}
+                             EINKAUFSDATEI einkaeufe,{}                             VERKAUFSDATEI hitliste);{}KUNDENDATEI   VAR kunde;{}WARENDATEI    VAR artikel;{}EINKAUFSDATEI VAR einkaufsdatei;{}VERKAUFSDATEI VAR verkaufszahl;{}DATASPACE     VAR ds;{}INT           VAR codenummer, reply code;{}TASK          VAR zentrale, verwaltung, absender;{}TEXT          VAR hauptstelle  :: "",{}                  filialnummer :: "0",{}                  filialverwaltungsname :: "";{}PROC filialverwaltung:{}  enable stop;{}
+  IF pos (name (myself), ".Filialverwaltung") = 0{}     THEN errorstop ("Unzulaessiger Befehl!"){}  FI;{}  disable stop;{}  REP wait (ds, codenummer, absender);{}      bearbeite auftrag;{}      send (absender, 0, ds);{}      IF is error THEN clear error FI{}  PER.{}  bearbeite auftrag:{}    IF   codenummer <= max artikel{}         THEN artikeldaten speichern{}    ELIF codenummer <= max kundennr{}         THEN kauf registrieren{}    ELIF codenummer <= max kundennr + max kunden{}         THEN kundendaten speichern{}
+    ELIF codenummer = filialdaten holen code{}         THEN filialdaten holen{}    ELIF codenummer = filialdaten ergaenzen code{}         THEN filialdaten ergaenzen; init ds{}    ELIF codenummer = 256{}         THEN sperre task{}    FI.{}    sperre task:{}      call (absender, 256, ds, codenummer).{}END PROC filialverwaltung;{}PROC artikeldaten speichern:{}  BOUND ARTIKELDATEN VAR artikeldaten :: ds;{}  artikel [codenummer] := artikeldaten;{}  init ds{}END PROC artikeldaten speichern;{}PROC kauf registrieren:{}
+  artikelnummer aus ds lesen;{}  artikel [artikelnummer].bestand DECR 1;{}  verkaufszahl [artikelnummer] INCR 1;{}  IF kundennummer > 0{}     THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1{}  FI.{}  artikelnummer aus ds lesen:{}    BOUND INT VAR nummer    :: ds;{}    INT CONST artikelnummer :: nummer,{}              kundennummer  :: codenummer - min kundennr + 1;{}    init ds{}END PROC kauf registrieren;{}PROC kundendaten speichern:{}  BOUND KUNDENDATEN VAR kundendaten :: ds;{}  kunde [codenummer - min kundennr - max kunden + 1] := kundendaten{}
+END PROC kundendaten speichern;{}PROC filialdaten holen:{}  init ds;{}  BOUND FILIALDATEN VAR filialdaten :: ds;{}  CONCR (filialdaten.waren)     := CONCR (artikel);{}  CONCR (filialdaten.kunden)    := CONCR (kunde);{}  CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei);{}  CONCR (filialdaten.hitliste)  := CONCR (verkaufszahl){}END PROC filialdaten holen;{}PROC filialdaten ergaenzen:{}  BOUND FILIALDATEN VAR neue daten :: ds;{}  INT VAR kundennummer, artikelnummer;{}  ergaenze artikeldatei und verkaufszahlen;{}
+  ergaenze kundendatei;{}  ergaenze einkaufsdatei.{}  ergaenze artikeldatei und verkaufszahlen:{}    FOR artikelnummer FROM 1 UPTO max artikel REP{}      verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer];{}      IF artikel [artikelnummer].artikelname = ""{}         THEN artikel [artikelnummer] := neue daten.waren [artikelnummer]{}      FI{}    PER.{}  ergaenze kundendatei:{}    FOR kundennummer FROM 1 UPTO max kunden REP{}        IF kunde [kundennummer].nachname = ""{}           THEN kunde [kundennummer] := neue daten.kunden [kundennummer]{}
+        FI{}    PER.{}  ergaenze einkaufsdatei:{}    FOR kundennummer FROM 1 UPTO max kunden REP{}      FOR artikelnummer FROM 1 UPTO max artikel REP{}        einkaufsdatei [kundennummer][artikelnummer]{}          INCR neue daten.einkaeufe [kundennummer][artikelnummer]{}      PER{}    PER.{}END PROC filialdaten ergaenzen;{}OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}
+END OP :=;{}PROC init ds:{}  forget (ds); ds := nilspace{}END PROC init ds;{}(************************************************************************){}PROC initialisiere verwaltung:{}  hauptstelle := hauptstellenname;{}  zentrale := task (hauptstelle + ".Zentrale");{}  filialnummer := text (channel (myself));{}  filialverwaltungsname := hauptstellenname + ".Filialverwaltung ";{}  begin (filialverwaltungsname + filialnummer,{}         PROC filialverwaltung, verwaltung){}END PROC initialisiere verwaltung;{}
+PROC hole artikeldaten (INT  CONST artikelnummer,{}                        TEXT VAR name,  REAL VAR preis,{}                        INT  VAR mindestbestand, bestand):{}  enable stop;{}  pruefe artikelnummer;{}  hole daten.{}  pruefe artikelnummer:{}    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{}    IF artikelindex < 1  OR  artikelindex > max artikel{}       THEN errorstop ("Unzulässige Artikelnummer!"){}    FI.{}  hole daten:{}    name           := artikel [artikelindex].artikelname;{}
+    preis          := artikel [artikelindex].preis;{}    mindestbestand := artikel [artikelindex].mindestbestand;{}    bestand        := artikel [artikelindex].bestand.{}END PROC hole artikeldaten;{}PROC speichere artikeldaten (INT  CONST artikelnummer,{}                             TEXT CONST name, REAL CONST preis,{}                             INT  CONST mindestbestand, bestand):{}  enable stop;{}  pruefe artikelnummer;{}  speichere daten;{}  schicke kopie an verwaltung.{}  pruefe artikelnummer:{}
+    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{}    IF artikelindex < 1  OR  artikelindex > max artikel{}       THEN errorstop ("Unzulässige Artikelnummer!"){}    FI.{}  speichere daten:{}    artikel [artikelindex].artikelname   := name;{}    artikel [artikelindex].preis         := preis;{}    artikel [artikelindex].mindestbestand:= mindestbestand;{}    artikel [artikelindex].bestand       := bestand.{}  schicke kopie an verwaltung:{}    init ds;{}    BOUND ARTIKELDATEN VAR artikeldaten :: ds;{}
+    artikeldaten := artikel [artikelindex];{}    call (verwaltung, artikelindex, ds, reply code).{}END PROC speichere artikeldaten;{}PROC registriere verkauf (INT CONST kundennummer, artikelnummer):{}  enable stop;{}  pruefe daten;{}  speichere daten;{}  schicke kopie zur verwaltung.{}  pruefe daten:{}    INT VAR kundenindex  :: kundennummer  - min kundennr  + 1,{}            artikelindex :: artikelnummer - min artikelnr + 1;{}    IF   kundenindex < 0  OR  kundenindex > max kunden{}         THEN errorstop ("Unzulässige Kundennummer!"){}
+    ELIF artikelindex < 1  OR  artikelindex > max artikel{}         THEN errorstop ("Unzulässige Artikelnummer!"){}    FI.{}  speichere daten:{}    IF artikel [artikelindex].bestand > 0{}       THEN artikel [artikelindex].bestand DECR 1;{}            verkaufszahl [artikelindex] INCR 1;{}            IF kundenindex > 0{}               THEN trage evtl in einkaufsdatei ein{}    FI      FI.{}  trage evtl in einkaufsdatei ein:{}    IF kunde [kundenindex].nachname = ""{}       THEN kundenindex := 0{}       ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1{}
+    FI.{}  schicke kopie zur verwaltung:{}    init ds;{}    BOUND INT VAR nummer :: ds;{}    nummer := artikelindex;{}    call (verwaltung, kundenindex + min kundennr - 1, ds, reply code).{}END PROC registriere verkauf;{}PROC hole kundendaten (INT  CONST kundennummer,{}                       TEXT VAR   nachname, vorname, geschlecht):{}  enable stop;{}  pruefe kundennummer;{}  rufe zentrale an;{}  uebergib die zentraldaten;{}  IF aenderungen vorhanden{}     THEN aktualisiere filialdaten{}  FI;{}  forget (ds).{}
+  pruefe kundennummer:{}    INT CONST index :: kundennummer - min kundennr + 1;{}    IF index < 1  OR  index > max kunden{}       THEN errorstop ("Unzulässige Kundennummer!"){}    FI.{}  rufe zentrale an:{}    init ds;{}    call (zentrale, kundennummer, ds, reply code).{}  aenderungen vorhanden:{}    (kunde [index].nachname   <> nachname  ) OR{}    (kunde [index].vorname    <> vorname   ) OR{}    (kunde [index].geschlecht <> geschlecht).{}  aktualisiere filialdaten:{}    kunde [index] := daten von zentrale;{}
+    call (verwaltung, kundennummer + max kunden, ds, reply code).{}  uebergib die zentraldaten:{}    BOUND KUNDENDATEN VAR daten von zentrale :: ds;{}    nachname    := daten von zentrale.nachname;{}    vorname     := daten von zentrale.vorname;{}    geschlecht  := daten von zentrale.geschlecht.{}END PROC hole kundendaten;{}PROC speichere kundendaten(INT  CONST kundennummer,{}                           TEXT CONST nachname, vorname, geschlecht):{}  enable stop;{}  pruefe kundennummer;{}  IF kundendaten geaendert{}
+     THEN speichere daten;{}          schicke kopie an verwaltung und zentrale{}  FI.{}  pruefe kundennummer:{}    IF kundennummer < min kundennr  OR  kundennummer > max kundennr{}       THEN errorstop ("Unzulässige Kundennummer!"){}    FI.{}  kundendaten geaendert:{}    INT CONST index :: kundennummer - min kundennr + 1;{}    nachname    <> kunde [index].nachname    OR{}    vorname     <> kunde [index].vorname     OR{}    geschlecht  <> kunde [index].geschlecht.{}  speichere daten:{}    kunde [index].nachname    := nachname;{}
+    kunde [index].vorname     := vorname;{}    kunde [index].geschlecht  := geschlecht.{}  schicke kopie an verwaltung und zentrale:{}    init ds;{}    BOUND KUNDENDATEN VAR kundendaten :: ds;{}    kundendaten := kunde [index];{}    call (verwaltung, kundennummer + max kunden, ds, reply code);{}    call (zentrale, kundennummer - min kundennr + 1, ds, reply code);{}    forget (ds).{}END PROC speichere kundendaten;{}PROC sichere filialdaten (TEXT CONST name):{}  enable stop;{}  filialdaten holen;{}
+  type (ds, 1951);{}  forget (name, quiet);{}  copy (ds, name);{}  forget (ds){}END PROC sichere filialdaten;{}PROC lade filialdaten (TEXT CONST name):{}  enable stop;{}  forget (ds);{}  ds := old (name);{}  IF type (ds) = 1951{}     THEN filialdaten ergaenzen;{}          kopie an verwaltung schicken;{}          kopie der kundendatei an zentrale schicken{}     ELSE errorstop ("'" + name + "' enthält keine Filialdaten!"){}  FI.{}  kopie an verwaltung schicken:{}    call (verwaltung, filialdaten ergaenzen code, ds, reply code).{}
+  kopie der kundendatei an zentrale schicken:{}    BOUND KUNDENDATEI VAR kundendatei :: ds;{}    CONCR (CONCR (kundendatei)) := CONCR (kunde);{}    call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code).{}END PROC lade filialdaten;{}PROC hole bestelliste (FILE VAR f):{}  bereite datei vor;{}  schreibe daten in datei.{}  bereite datei vor:{}    forget("Nachbestellung",quiet);{}    f := sequential file (output, "Nachbestellung");{}    line  (f);{}    write (f, "        Nachbestellungen für " +{}
+                       invers ("Filiale " + filialnummer)+":");{}    line;{}    write (f, "        ==================================================");{}    line  (f, 2);{}    write (f, "        |  Art.Nr. | Artikelname             |   Anzahl  |");{}    line  (f);{}    write (f, "        +----------+-------------------------+-----------+");{}    line  (f).{}  schreibe daten in datei:{}    INT VAR artikelnummer;{}    FOR artikelnummer FROM 1 UPTO max artikel REP{}        IF artikel[artikelnummer].bestand{}
+           < artikel[artikelnummer].mindestbestand{}           THEN bestelle artikel nach{}        FI{}    PER;{}    write (f, "        +----------+-------------------------+-----------+");{}    line  (f).{}   bestelle artikel nach:{}    write (f, "        |  " + wirkliche artikelnummer + "   | "{}              + text (artikel [artikelnummer].artikelname, 23) + " |  "{}              + text (nachzubestellende anzahl, 6) + "   |");{}    line  (f);{}    artikel [artikelnummer].bestand{}                           := 2 * artikel [artikelnummer].mindestbestand.{}
+    wirkliche artikelnummer:{}      text (artikelnummer + min artikelnr - 1, 5).{}    nachzubestellende anzahl:{}      2 * artikel [artikelnummer].mindestbestand{}                                  - artikel [artikelnummer].bestand.{}END PROC hole bestelliste;{}PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer,{}                        FILE  VAR f):{}  enable stop;{}  hauptstelle := hauptstellenname;{}  SELECT codenummer OF CASE 66 : hitliste von zentrale (f){}                       CASE 67 : hitliste von filiale (f){}
+                       CASE 68 : hitlisten aller filialen (f){}                    (* --------------------------------------------- *){}                       CASE 73 : artikelkaeuferliste von zentrale{}                                   (artikel oder kundennummer, f){}                       CASE 74 : artikelkaeuferliste von filiale{}                                   (artikel oder kundennummer, f){}                       CASE 75 : artikelkaeuferlisten aller filialen{}                                   (artikel oder kundennummer, f){}
+                    (* --------------------------------------------- *){}                       CASE 77 : kundenliste von zentrale (f){}                       CASE 78 : kundenliste von filiale (f){}                       CASE 79 : kundenlisten aller filialen (f){}                    (* --------------------------------------------- *){}                       CASE 84 : kundeneinkaufsliste von zentrale{}                                   (artikel oder kundennummer, f){}                       CASE 85 : kundeneinkaufsliste von filiale{}
+                                   (artikel oder kundennummer, f){}                       CASE 86 : kundeneinkaufslisten aller filialen{}                                   (artikel oder kundennummer, f){}                    (* --------------------------------------------- *){}                       CASE 89 : lageruebersicht von zentrale (f){}                       CASE 90 : lageruebersicht von filiale (f){}                       CASE 91 : lageruebersichten aller filialen (f){}                    (* --------------------------------------------- *){}
+  OTHERWISE  errorstop ("Unzulässige Code - Nummer bei Auskunft!"){}  END SELECT{}END PROC hole auskunft ein;{}PROC hitliste von zentrale (FILE VAR f):{}  INT VAR filialnr;{}  beginne mit eigener filiale;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF filialnr <> int (filialnummer) CAND{}       exists task (aktuelle verwaltung){}       THEN hole daten dieser filiale;{}            schreibe daten in zentralliste{}
+    FI{}  PER;{}  werte zentralliste aus.{}  beginne mit eigener filiale:{}    WARENDATEI VAR zentrale warendatei;{}    CONCR (zentrale warendatei) := CONCR (artikel);{}    VERKAUFSDATEI VAR zentrale verkaufsdatei;{}    CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl).{}   hole daten dieser filiale:{}     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}     BOUND FILIALDATEN VAR aktuelle daten :: ds.{}   schreibe daten in zentralliste:{}     INT VAR i;{}
+     FOR i FROM 1 UPTO max artikel REP{}       IF zentrale warendatei [i].artikelname = ""{}          THEN zentrale warendatei [i] := aktuelle daten.waren [i]{}       FI;{}       zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i]{}     PER.{}  werte zentralliste aus:{}    forget (ds);{}    forget ("Auskunft: Zentrale", quiet);{}    f := sequential file (output, "Auskunft: Zentrale");{}    line  (f);{}    write (f, "   Zentrale Warenliste, geordnet nach Verkaufszahlen:");{}    sortiere (zentrale warendatei, zentrale verkaufsdatei);{}
+    fuelle (f, zentrale warendatei, zentrale verkaufsdatei).{}END PROC hitliste von zentrale;{}PROC hitliste von filiale (FILE VAR f):{}  bereite auskunftsdatei vor;{}  kopiere artikeldatei und verkaufsdatei;{}  sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen);{}  fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen).{}  kopiere artikeldatei und verkaufsdatei:{}    WARENDATEI VAR hilfsdatei artikel;{}    CONCR (hilfsdatei artikel) := CONCR (artikel);{}    VERKAUFSDATEI VAR hilfsdatei verkaufszahlen;{}
+    CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl).{}  bereite auskunftsdatei vor:{}    forget ("Auskunft: Filiale " + filialnummer, quiet);{}    f := sequential file (output, "Auskunft: Filiale " + filialnummer);{}    line  (f);{}    write (f, "   Warenliste, geordnet nach Verkaufszahlen:").{}END PROC hitliste von filiale;{}PROC hitlisten aller filialen (FILE VAR f):{}  WARENDATEI    VAR aktuelle warendatei;{}  VERKAUFSDATEI VAR aktuelle verkaufsdatei;{}  INT           VAR filialnr;{}
+  bereite auskunftsdatei vor;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF   filialnr = int (filialnummer){}         THEN nimm eigene daten{}    ELIF exists task (aktuelle verwaltung){}    THEN hole daten dieser filiale;{}         arbeite mit diesen daten{}    FI{}  PER;{}  forget (ds).{}  bereite auskunftsdatei vor:{}    forget ("Auskunft: Alle Filialen", quiet);{}    f := sequential file (output, "Auskunft: Alle Filialen");{}
+    line  (f).{}  nimm eigene daten:{}    CONCR (aktuelle warendatei) := CONCR (artikel);{}    CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl);{}    sortiere und fuelle.{}  sortiere und fuelle:{}    write (f, "   Warenliste von " + invers ("Filiale " + text (filialnr)){}            + ", geordnet nach Verkaufszahlen:");{}    sortiere (aktuelle warendatei, aktuelle verkaufsdatei);{}    fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei).{}   hole daten dieser filiale:{}     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}
+     BOUND FILIALDATEN VAR aktuelle daten :: ds.{}   arbeite mit diesen daten:{}    CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren);{}    CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste);{}    sortiere und fuelle.{}END PROC hitlisten aller filialen;{}PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl):{}  INT VAR i,j;{}  FOR i FROM 1 UPTO max artikel - 1 REP{}    FOR j FROM i + 1 UPTO max artikel REP{}      IF stueckzahl [i] < stueckzahl [j]{}         THEN vertausche{}
+      FI{}  PER PER.{}  vertausche:{}    INT CONST hilfsint :: stueckzahl [i];{}    ARTIKELDATEN CONST hilfsartikel :: warendatei [i];{}    stueckzahl [i] := stueckzahl [j];{}    warendatei [i] := warendatei [j];{}    stueckzahl [j] := hilfsint;{}    warendatei [j] := hilfsartikel.{}END PROC sortiere;{}PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl):{}  INT VAR nummer, platz :: 0;{}  bereite datei vor;{}  schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f,"   ============================================================");{}
+ line (f,2);{} write(f,"   | Platz | Verk.Anzahl | Artikelname            |   Preis   |");{} line (f);{} write(f,"   +-------+-------------+------------------------+-----------+");{} line (f).{}schreibe daten in datei:{} FOR nummer FROM 1 UPTO max artikel REP{}     IF warendat [nummer].artikelname <> ""{}        THEN schreibe in datei; line (f){}     FI{} PER;{} write(f,"   +-------+-------------+------------------------+-----------+");{} line (f,3).{}schreibe in datei:{}  platz INCR 1;{}  write (f, "   |" + text (platz, 5) + "  |"{}
+                   + text (anzahl [nummer], 9) + "    | "{}                   + text (warendat [nummer].artikelname, 22) + " | "{}                   + text (warendat [nummer].preis,8,2) + "  |").{}END PROC fuelle;{}PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f):{}  INT VAR filialnr;{}  pruefe artikelnummer;{}  beginne mit eigener filiale;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}
+    IF filialnr <> int (filialnummer) CAND{}       exists task (aktuelle verwaltung){}       THEN hole daten dieser filiale;{}            schreibe daten in zentralliste{}    FI{}  PER;{}  werte zentralliste aus.{}  pruefe artikelnummer:{}    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{}    IF artikelindex < 1  OR  artikelindex > max artikel{}       THEN errorstop ("Unzulässige Artikelnummer!"){}    FI.{}  beginne mit eigener filiale:{}    TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname;{}
+    KUNDENDATEI VAR hilfsdatei;{}    CONCR (hilfsdatei) := CONCR (kunde);{}    ROW max kunden INT VAR kaeufe;{}    INT VAR i;{}    FOR i FROM 1 UPTO max kunden REP{}        kaeufe [i] := einkaufsdatei [i][artikelindex]{}    PER.{}   hole daten dieser filiale:{}     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{}   schreibe daten in zentralliste:{}     BOUND FILIALDATEN VAR aktuelle daten :: ds;{}     IF aktueller artikelname = ""{}        THEN aktueller artikelname{}
+             := aktuelle daten.waren [artikelindex].artikelname{}     FI;{}     FOR i FROM 1 UPTO max kunden REP{}       kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex];{}       IF hilfsdatei [i].nachname = ""{}          THEN hilfsdatei [i] := aktuelle daten.kunden [i]{}       FI{}     PER.{}  werte zentralliste aus:{}    forget (ds);{}    forget ("Auskunft: Zentrale", quiet);{}    f := sequential file (output, "Auskunft: Zentrale");{}    line (f);{}    IF aktueller artikelname = ""{}       THEN write (f, "   Der Artikel Nr. " + text (artikelindex){}
+                      +  " wird in keiner Filiale geführt.");{}            line (f);{}            write(f,{}        "   ============================================================");{}            line (f,3);{}       ELSE write (f, "   Gesamtkäuferliste des Artikels "{}                       +  invers (aktueller artikelname) + ":");{}            fuelle (f, hilfsdatei, kaeufe){}    FI.{}END PROC artikelkaeuferliste von zentrale;{}PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f):{}
+  pruefe artikelnummer;{}  kopiere einkaufszahlen in hilfsliste;{}  erstelle filialliste.{}  pruefe artikelnummer:{}    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{}    IF artikelindex < 1  OR  artikelindex > max artikel{}       THEN errorstop ("Unzulässige Artikelnummer!"){}    FI.{}  kopiere einkaufszahlen in hilfsliste:{}    ROW max kunden INT VAR kaeufe;{}    INT VAR i;{}    FOR i FROM 1 UPTO max kunden REP{}        kaeufe [i] := einkaufsdatei [i][artikelindex]{}    PER.{}  erstelle filialliste:{}
+    forget ("Auskunft: Filiale " + filialnummer, quiet);{}    f := sequential file (output, "Auskunft: Filiale " + filialnummer);{}    line (f);{}    IF artikel [artikelindex].artikelname = ""{}       THEN write (f, "   Der Artikel Nr. " + text (artikelindex){}                   +  " wird in dieser Filiale nicht geführt.");{}            line (f);{}            write(f,{}        "   ============================================================");{}            line (f,3);{}       ELSE write (f, "   Käufer des Artikels "{}
+                   +  invers (artikel [artikelindex].artikelname){}                   +  ":");{}            fuelle (f, kunde, kaeufe){}    FI.{}END PROC artikelkaeuferliste von filiale;{}PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f):{}  INT VAR i, filialnr;{}  ROW max kunden INT VAR kaeufe;{}  pruefe artikelnummer;{}  bereite datei vor;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}
+    IF   filialnr = int (filialnummer){}         THEN kopiere eigene einkaufszahlen in hilfsliste;{}              schreibe eigene daten in auskunftsdatei{}    ELIF exists task (aktuelle verwaltung){}         THEN hole daten dieser filiale;{}              schreibe daten in auskunftsdatei{}    FI{}  PER;{}  forget (ds).{}  pruefe artikelnummer:{}    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;{}    IF artikelindex < 1  OR  artikelindex > max artikel{}       THEN errorstop ("Unzulässige Artikelnummer!"){}
+    FI.{}  bereite datei vor:{}    forget ("Auskunft: Alle Filialen", quiet);{}    f := sequential file (output, "Auskunft: Alle Filialen");{}    line (f).{}  kopiere eigene einkaufszahlen in hilfsliste:{}    FOR i FROM 1 UPTO max kunden REP{}        kaeufe [i] := einkaufsdatei [i][artikelindex]{}    PER.{}  schreibe eigene daten in auskunftsdatei:{}    IF artikel [artikelindex].artikelname = ""{}       THEN write (f, "   Der Artikel Nr. " + text (artikelindex){}                   +  " wird in "{}
+                   +    invers ("Filiale " + filialnummer){}                   +  " nicht geführt.");{}            line (f);{}            write(f,{}        "   ============================================================");{}            line (f,3){}       ELSE write (f, "   Käufer des Artikels '"{}                   +  artikel [artikelindex].artikelname{}                   +  "' in " + invers ("Filiale " + filialnummer) + ":");{}            fuelle(f, kunde, kaeufe){}    FI.{}   hole daten dieser filiale:{}
+     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}     BOUND FILIALDATEN VAR aktuelle daten :: ds;{}     TEXT CONST aktueller artikelname{}                := aktuelle daten.waren [artikelindex].artikelname{}     FOR i FROM 1 UPTO max kunden REP{}       kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex];{}     PER.{}  schreibe daten in auskunftsdatei:{}    IF aktueller artikelname = ""{}       THEN write (f, "   Der Artikel Nr. " + text (artikelindex){}
+                   +  " wird in "{}                   +    invers ("Filiale " + text (filialnr)){}                   +  " nicht geführt.");{}            line (f);{}            write(f,{}        "   ============================================================");{}            line (f,3){}       ELSE write (f, "   Käufer des Artikels '"{}                   +  aktueller artikelname{}                   +  "' in " + invers ("Filiale " + text(filialnr)) + ":");{}            fuelle(f, aktuelle daten.kunden, kaeufe){}
+    FI.{}END PROC artikelkaeuferlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI CONST  kundenliste,{}                         ROW max kunden INT CONST einkaufszahlen):{}  INT VAR kundennummer;{}  bereite datei vor;{}  schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f,"   ============================================================");{} line (f, 2);{} write(f,"   | Anzahl | Nachname,         Vorname          | Geschlecht |");{} line (f);{} write(f,"   +--------+------------------------------------+------------+");{}
+ line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{}     IF  einkaufszahlen [kundennummer] > 0{}         THEN schreibe in  datei; line (f);{}     FI{} PER;{} write(f,"   +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{} write(f,"   |" + text(einkaufszahlen [kundennummer], 5) + "   | "{}                + text(kundenliste [kundennummer].nachname + ",", 17) + " "{}                + text(kundenliste [kundennummer].vorname, 16) + " | ");{}
+ IF   kundenliste [kundennummer].geschlecht = "m"{}      THEN write (f, " männlich  |"){} ELIF kundenliste [kundennummer].geschlecht = "w"{}      THEN write (f, " weiblich  |"){}      ELSE write (f, "           |"){} FI.{}END PROC fuelle;{}PROC kundenliste von zentrale (FILE VAR f):{}  hole kundenliste von zentrale;{}  bereite datei vor;{}  schreibe daten in datei.{}  hole kundenliste von zentrale:{}    init ds;{}    call (zentrale, zentrale kundendatei holen code, ds, reply code);{}    BOUND KUNDENDATEI VAR zentrale kundenliste :: ds.{}
+  bereite datei vor:{}   forget ("Auskunft: Zentrale", quiet);{}   f := sequential file (output, "Auskunft: Zentrale");{}   line  (f);{}   write (f, "   Zentrale Kundenliste:").{}  schreibe daten in datei:{}    fuelle (f, zentrale kundenliste);{}    forget (ds).{}END PROC kundenliste von zentrale;{}PROC kundenliste von filiale (FILE VAR f):{}  bereite datei vor;{}  schreibe daten in datei.{}  bereite datei vor:{}    forget ("Auskunft: Filiale " + filialnummer, quiet);{}    f := sequential file (output, "Auskunft: Filiale " + filialnummer);{}
+    line  (f);{}    write (f,"   Kundenliste:").{}  schreibe daten in datei:{}    fuelle (f, kunde).{}END PROC kundenliste von filiale;{}PROC kundenlisten aller filialen (FILE VAR f):{}  INT VAR filialnr;{}  bereite datei vor;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF   filialnr = int (filialnummer){}         THEN schreibe eigene daten in auskunftsdatei{}    ELIF exists task (aktuelle verwaltung){}
+         THEN hole daten dieser filiale;{}              schreibe daten dieser filiale in auskunftsdatei{}    FI{}  PER.{}  bereite datei vor:{}    forget ("Auskunft: Alle Filialen", quiet);{}    f := sequential file (output, "Auskunft: Alle Filialen");{}    line (f).{}  schreibe eigene daten in auskunftsdatei:{}    schreibe ueberschrift;{}    fuelle (f, kunde).{}  hole daten dieser filiale:{}    init ds;{}    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}    BOUND FILIALDATEN VAR aktuelle filialdaten :: ds.{}
+  schreibe daten dieser filiale in auskunftsdatei:{}    schreibe ueberschrift;{}    fuelle (f, aktuelle filialdaten.kunden).{}  schreibe ueberschrift:{}   write (f, "   Kundenliste für " +{}                 invers ("Filiale " + text (filialnr)) + ":").{}END PROC kundenlisten aller filialen;{}PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei):{}  INT VAR kundennummer;{}  bereite datei vor;{}  schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f,"   ============================================================");{}
+ line (f,2);{} write(f,"   | Kun.Nr.| Nachname,         Vorname          | Geschlecht |");{} line (f);{} write(f,"   +--------+------------------------------------+------------+");{} line (f).{}schreibe daten in datei:{} FOR kundennummer FROM 1 UPTO max kunden REP{}     IF kundendatei [kundennummer].nachname <> ""{}        THEN schreibe in datei; line (f){}     FI{} PER;{} write(f,"   +--------+------------------------------------+------------+");{} line (f, 3).{}schreibe in datei:{}  write (f, "   |" + text (kundennummer + min kundennummer - 1, 6) + "  | "{}
+            + text (kundendatei [kundennummer].nachname + ",", 17) + " "{}            + text (kundendatei [kundennummer].vorname, 16) + " | ");{}    IF   kundendatei [kundennummer].geschlecht = "m"{}         THEN write (f, " männlich  |"){}    ELIF kundendatei [kundennummer].geschlecht = "w"{}         THEN write (f, " weiblich  |"){}         ELSE write (f, "           |"){}    FI.{}END PROC fuelle;{}PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f):{}  INT VAR filialnr;{}
+  pruefe kundennummer;{}  beginne mit eigener filiale;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF filialnr <> int (filialnummer) CAND{}       exists task (aktuelle verwaltung){}       THEN hole daten dieser filiale;{}            schreibe daten in zentralliste{}    FI{}  PER;{}  werte zentralliste aus.{}  pruefe kundennummer:{}    INT CONST kundenindex :: kundennummer - min kundennr + 1;{}
+    IF kundenindex < 1  OR  kundenindex > max kunden{}       THEN errorstop ("Unzulässige Kundennummer!"){}    FI.{}  beginne mit eigener filiale:{}    KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex];{}    WARENDATEI VAR hilfsdatei;{}    CONCR (hilfsdatei) := CONCR (artikel);{}    ROW max artikel INT VAR kaeufe;{}    INT VAR i;{}    FOR i FROM 1 UPTO max artikel REP{}        kaeufe [i] := einkaufsdatei [kundenindex][i]{}    PER.{}   hole daten dieser filiale:{}     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{}
+   schreibe daten in zentralliste:{}     BOUND FILIALDATEN VAR aktuelle daten :: ds;{}     IF aktueller kunde.nachname = ""{}        THEN aktueller kunde := aktuelle daten.kunden [kundenindex]{}     FI;{}     FOR i FROM 1 UPTO max artikel REP{}       kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i];{}       IF hilfsdatei [i].artikelname = ""{}          THEN hilfsdatei [i] := aktuelle daten.waren [i]{}       FI{}     PER.{}  werte zentralliste aus:{}    forget (ds);{}    forget ("Auskunft: Zentrale", quiet);{}
+    f := sequential file (output, "Auskunft: Zentrale");{}    line (f);{}    IF aktueller kunde.nachname = ""{}       THEN write (f, "   Ein Kunde mit Nr. " + text (kundenindex){}                   +  " ist in keiner Filiale bekannt.");{}            line (f);{}            write(f,{}        "   ============================================================");{}            line (f,3);{}       ELSE write (f, "   Gesamteinkaufsliste " + anrede{}                       +  invers (aktueller kundenname) + ":");{}
+            fuelle (f, hilfsdatei, kaeufe){}    FI.{}  anrede:{}    IF   aktueller kunde.geschlecht = "m"{}         THEN "des Kunden "{}    ELIF aktueller kunde.geschlecht = "w"{}         THEN "der Kundin "{}         ELSE "von "{}    FI.{}  aktueller kundenname:{}    (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname.{}END PROC kundeneinkaufsliste von zentrale;{}PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f):{}  pruefe kundennummer;{}  erstelle filialliste.{}
+  pruefe kundennummer:{}    INT CONST kundenindex :: kundennummer - min kundennr + 1;{}    IF kundenindex < 1  OR  kundenindex > max kunden{}       THEN errorstop ("Unzulässige Kundennummer!"){}    FI.{}  erstelle filialliste:{}    forget ("Auskunft: Filiale " + filialnummer, quiet);{}    f := sequential file (output, "Auskunft: Filiale " + filialnummer);{}    line (f);{}    IF kunde [kundenindex].nachname = ""{}       THEN schicke leere liste zurueck{}       ELSE schreibe dateikopf;{}            fuelle (f, artikel, einkaufsdatei [kundenindex]){}
+    FI.{}  schicke leere liste zurueck:{}    write (f,"   Ein Kunde mit Nr. " + text (kundennummer) + " ist in "{}           +  "dieser Filiale nicht bekannt.");{}    line  (f);{}    write (f,{}      "   ============================================================");{}    line (f,3).{}  schreibe dateikopf:{}   write (f, "   Einkaufsliste " + anrede +{}                 invers ((kunde [kundenindex].vorname  SUB 1) + ". " +{}                  kunde [kundenindex].nachname) + ":").{}  anrede:{}    IF   kunde [kundenindex].geschlecht = "m"{}
+         THEN "des Kunden "{}    ELIF kunde [kundenindex].geschlecht = "w"{}         THEN "der Kundin "{}         ELSE "von "{}    FI.{}END PROC kundeneinkaufsliste von filiale;{}PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f):{}  INT VAR filialnr;{}  pruefe kundennummer;{}  bereite datei vor;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF   filialnr = int (filialnummer){}
+         THEN schreibe eigene daten in auskunftsdatei{}    ELIF exists task (aktuelle verwaltung){}         THEN hole daten dieser filiale;{}              schreibe daten in auskunftsdatei{}    FI{}  PER;{}  forget (ds).{}  pruefe kundennummer:{}    INT CONST kundenindex :: kundennummer - min kundennr + 1;{}    IF kundenindex < 1  OR  kundenindex > max kunden{}       THEN errorstop ("Unzulässige Kundennummer!"){}    FI.{}  bereite datei vor:{}    forget ("Auskunft: Alle Filialen", quiet);{}    f := sequential file (output, "Auskunft: Alle Filialen");{}
+    line (f).{}  schreibe eigene daten in auskunftsdatei:{}    IF kunde [kundenindex].nachname = ""{}       THEN write (f,"   Ein Kunde mit Nr. " + text (kundennummer){}                   + " ist in " + invers ("Filiale " + filialnummer){}                   + " nicht bekannt.");{}            line  (f);{}            write(f,{}        "   ============================================================");{}            line (f,3){}       ELSE write (f, "   Einkaufsliste " + anrede hier +{}                  (kunde [kundenindex].vorname  SUB 1) + ". " +{}
+                   kunde [kundenindex].nachname +{}                  " in " + invers ("Filiale " + filialnummer) + ":");{}            fuelle (f, artikel, einkaufsdatei [kundenindex]){}    FI.{}  anrede hier:{}    IF   kunde [kundenindex].geschlecht = "m"{}         THEN "des Kunden "{}    ELIF kunde [kundenindex].geschlecht = "w"{}         THEN "der Kundin "{}         ELSE "von "{}    FI.{}  hole daten dieser filiale:{}    init ds;{}    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}
+    BOUND FILIALDATEN VAR aktuelle daten :: ds;{}    KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex].{}  schreibe daten in auskunftsdatei:{}    IF aktueller kunde.nachname = ""{}       THEN write (f,"   Ein Kunde mit Nr. " + text (kundennummer){}                   + " ist in " + invers ("Filiale " + text (filialnr)){}                   + " nicht bekannt.");{}            line  (f);{}            write(f,{}        "   ============================================================");{}
+            line (f,3){}       ELSE write (f, "   Einkaufsliste " + anrede +{}                  (aktueller kunde.vorname  SUB 1) + ". " +{}                   aktueller kunde.nachname +{}                  " in " + invers ("Filiale " + text (filialnr)) + ":");{}            fuelle (f, aktuelle daten.waren,{}                       aktuelle daten.einkaeufe [kundenindex]){}     FI.{}  anrede:{}    IF   aktueller kunde.geschlecht = "m"{}         THEN "des Kunden "{}    ELIF aktueller kunde.geschlecht = "w"{}
+         THEN "der Kundin "{}         ELSE "von "{}    FI.{}END PROC kundeneinkaufslisten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei,{}             ROW max artikel INT CONST einkaufszahlen):{}  INT VAR  artikelnummer;{}  REAL VAR gesamtpreis, summe :: 0.0;{}  bereite datei vor;{}  schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f,"   ============================================================");{} line (f,2);{} write(f,"   | Art.Nr.| Artikelname       | Anzahl |  Preis  |  Gesamt  |");{}
+ line (f);{} write(f,"   +--------+-------------------+--------+---------+----------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{}     IF einkaufszahlen [artikelnummer] > 0{}        THEN schreibe in datei; line (f){}     FI{} PER;{} write(f,"   +--------+-------------------+--------+---------+----------+");{} line (f);{} write(f,"                                           Summe:   " +{}                                                     text (summe,8,2));{}
+ line (f, 3).{}schreibe in datei:{}  gesamtpreis := real (einkaufszahlen [artikelnummer]) *{}                       warendatei [artikelnummer].preis;{}  summe INCR gesamtpreis;{}  write (f,"   |" + text(artikelnummer,5) + "   | "{}                  + text(warendatei [artikelnummer].artikelname,17) + " |  "{}                  + text(einkaufszahlen [artikelnummer],4) + "  |"{}                  + text(warendatei [artikelnummer].preis,7,2) + "  |"{}                  + text(gesamtpreis,8,2) + "  |").{}
+END PROC fuelle;{}PROC lageruebersicht von zentrale (FILE VAR f):{}  INT VAR filialnr;{}  beginne mit eigener filiale;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF filialnr <> int (filialnummer) CAND{}       exists task (aktuelle verwaltung){}       THEN hole daten dieser filiale;{}            schreibe daten in zentralliste{}    FI{}  PER;{}  werte zentralliste aus.{}  beginne mit eigener filiale:{}
+    WARENDATEI VAR hilfsdatei;{}    CONCR (hilfsdatei) := CONCR (artikel).{}   hole daten dieser filiale:{}     init ds;{}     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).{}   schreibe daten in zentralliste:{}     BOUND FILIALDATEN VAR aktuelle daten :: ds;{}     INT VAR i;{}     FOR i FROM 1 UPTO max artikel REP{}       IF hilfsdatei [i].artikelname = ""{}          THEN hilfsdatei [i] := aktuelle daten.waren [i]{}          ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand;{}
+               hilfsdatei [i].bestand INCR aktuell.bestand{}       FI{}     PER.{}  aktuell: aktuelle daten.waren [i].{}  werte zentralliste aus:{}    forget (ds);{}    forget ("Auskunft: Zentrale", quiet);{}    f := sequential file (output, "Auskunft: Zentrale");{}    line  (f);{}    write (f, "   Zentrale Lagerübersicht:");{}    fuelle (f, hilfsdatei).{}END PROC lageruebersicht von zentrale;{}PROC lageruebersicht von filiale (FILE VAR f):{}  forget ("Auskunft: Filiale " + filialnummer, quiet);{}
+  f := sequential file (output, "Auskunft: Filiale " + filialnummer);{}  schreibe dateikopf;{}  fuelle (f, artikel).{}  schreibe dateikopf:{}   line  (f);{}   write (f, "   Lagerübersicht:").{}END PROC lageruebersicht von filiale;{}PROC lageruebersichten aller filialen (FILE VAR f):{}  INT VAR filialnr;{}  bereite datei vor;{}  FOR filialnr FROM 1 UPTO max filialen REP{}    TEXT CONST aktuelle verwaltung ::{}               hauptstelle + ".Filialverwaltung " + text (filialnr);{}    IF   filialnr = int (filialnummer){}
+         THEN schreibe eigene daten in auskunftsdatei{}    ELIF exists task (aktuelle verwaltung){}         THEN hole daten dieser filiale;{}              schreibe daten in auskunftsdatei{}    FI{}  PER;{}  forget (ds).{}  bereite datei vor:{}    forget ("Auskunft: Alle Filialen", quiet);{}    f := sequential file (output, "Auskunft: Alle Filialen").{}  schreibe eigene daten in auskunftsdatei:{}    line   (f);{}    write  (f, "   Lagerübersicht für " +{}                   invers ("Filiale " + filialnummer) + ":");{}
+    fuelle (f, artikel).{}  hole daten dieser filiale:{}    init ds;{}    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);{}    BOUND FILIALDATEN VAR aktuelle daten :: ds.{}  schreibe daten in auskunftsdatei:{}    line   (f);{}    write  (f, "   Lagerübersicht für " +{}                  invers ("Filiale " + text (filialnr)) + ":");{}    fuelle (f, aktuelle daten.waren).{}END PROC lageruebersichten aller filialen;{}PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei):{}  INT VAR artikelnummer;{}
+  bereite datei vor;{}  schreibe daten in datei.{}bereite datei vor:{} line (f);{} write(f,"   ============================================================");{} line (f,2);{} write(f,"   | Art.Nr.| Artikelname       |  Preis | Min.Best.| Bestand |");{} line (f);{} write(f,"   +--------+-------------------+--------+----------+---------+");{} line (f).{}schreibe daten in datei:{} FOR artikelnummer FROM 1 UPTO max artikel REP{}     IF warendatei[artikelnummer].artikelname <> ""{}        THEN schreibe in datei; line (f){}
+     FI{} PER;{} write(f,"   +--------+-------------------+--------+----------+---------+");{} line (f, 3).{}schreibe in datei:{}  write (f, "   |" + text(artikelnummer,5) + "   | "{}                   + text(warendatei[artikelnummer].artikelname,17) + " |"{}                   + text(warendatei[artikelnummer].preis,7,2) + " | "{}                   + text(warendatei[artikelnummer].mindestbestand,6)+"   | "{}                   + text(warendatei[artikelnummer].bestand,6) + "  |").{}END PROC fuelle;{}
+PROC initialisiere dateien:{}  INT VAR kundennummer, artikelnummer;{}  FOR kundennummer FROM 1 UPTO max kunden REP{}      kunde [kundennummer].nachname    := "";{}      kunde [kundennummer].vorname     := "";{}      kunde [kundennummer].geschlecht  := ""{}  PER;{}  FOR artikelnummer FROM 1 UPTO max artikel REP{}      verkaufszahl [artikelnummer]                   :=   0;{}      artikel      [artikelnummer].mindestbestand    :=   0;{}      artikel      [artikelnummer].bestand           :=   0;{}      artikel      [artikelnummer].artikelname       :=  "";{}
+      artikel      [artikelnummer].preis             := 0.0;{}      FOR kundennummer FROM 1 UPTO max kunden REP{}          einkaufsdatei[kundennummer][artikelnummer] :=   0{}      PER;{}  PER{}END PROC initialisiere dateien;{}initialisiere dateien{}END PACKET ls warenhaus 2{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 3 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 3
new file mode 100644
index 0000000..3473e0f
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 3
@@ -0,0 +1,82 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 3                    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 3 DEFINES                        
+       artikelnummer lesen,{}       artikeldaten eingeben,{}       kundennummer lesen,{}       kundendaten eingeben,{}       neues blatt,{}       rechnungskopf,{}       artikel kaufen,{}       abrechnung,{}       nachbestellen,{}       auskunft,{}       stoptaste gedrueckt,{}       stoptaste gedrückt,{}       dezimalwert lesen,{}       bitmuster lesen,{}       bildschirm neu,{}(* ------------------------------ *){}       tastatureingabe,{}       eingabesicherheit,{}       eingabe mit codekartenleser,{}
+       cursor w3 1 1:{}LET esc            = ""27"",{}    stopzeichen    = "q",{}    abbruchzeichen = "h";{}WINDOW VAR w1  :: window (43,  3, 36, 16),{}           w2  :: window (43, 20, 36,  3),{}           w3k :: window ( 2,  4, 40,  3),{}           w3  :: window ( 2,  7, 40, 16),{}           w4  :: window ( 8,  4, 66, 18);{}BOOL VAR ende gewuenscht              := FALSE,{}         artikelnummer ist eingelesen := FALSE,{}         kundennummer  ist eingelesen := FALSE,{}         codekartenleser aktiviert    := FALSE,{}
+         auf neuem blatt              := TRUE;{}INT  VAR artikelnummer  ::  0,{}         mindestbestand ::  0,{}         bestand        ::  0,{}         kundennummer   ::  0,{}         sicherheit     ::  5;{}TEXT VAR artikelname    :: "",{}         nachname       :: "",{}         vorname        :: "",{}         geschlecht     :: "",{}         ueberschrift   :: "    RECHNUNG",{}         hilfstext, exit char;{}REAL VAR preis          :: 0.0,{}         summe          :: 0.0;{}PROC eingabesicherheit (INT CONST wert):{}
+  sicherheit := abs (wert){}END PROC eingabesicherheit;{}PROC cursor w3 1 1:{}  cursor (w1,  1, 1);{}  cursor (w2,  1, 1);{}  cursor (w3,  1, 1);{}  cursor (w3k, 1, 1);{}  forget ("WARENHAUS:Rechnung", quiet);{}  setze variable in anfangszustand{}END PROC cursor w3 1 1;{}PROC setze variable in anfangszustand:{}  ende gewuenscht              := FALSE;{}  artikelnummer ist eingelesen := FALSE;{}  kundennummer  ist eingelesen := FALSE;{}  artikelnummer  := 0;{}  mindestbestand := 0;{}  bestand        := 0;{}
+  kundennummer   := 0;{}  artikelname    := "";{}  nachname       := "";{}  vorname        := "";{}  geschlecht     := "";{}  ueberschrift   := "    RECHNUNG";{}  preis          := 0.0;{}  summe          := 0.0{}END PROC setze variable in anfangszustand;{}PROC bildschirm neu:{}     cursor off;{}     pruefe abbruch;{}     cursor (w1, 1, 1);{}     cursor (w2, 1, 1);{}     cursor (w3, 1, 1);{}     cursor (w3k,1, 1);{}     auf neuem blatt := TRUE;{}     page;{}     out ("WARENHAUS:  Info  Eingabeart  Kommandos "15"Programme "14" " +{}
+          "Filialdaten  Archiv"); line;{}     out (ecke oben links + (40 * waagerecht) + balken oben{}                          + (36 * waagerecht) + ecke oben rechts);{}     INT VAR zeile;{}     FOR zeile FROM 3 UPTO 22 REP{}         cursor ( 1, zeile); out (senkrecht);{}         cursor (42, zeile); out (senkrecht);{}         cursor (79, zeile); out (senkrecht){}     PER;{}     cursor (1, 23);{}     out (ecke unten links + (40 * waagerecht) + balken unten{}                           + (36 * waagerecht) + ecke unten rechts);{}
+     cursor (42, 19);{}     out (balken links + (36 * waagerecht) + balken rechts);{}     cursor (2, 24);{}     out ("Programmabbruch: <ESC><" + abbruchzeichen + ">");{}     cursor on{}END PROC bildschirm neu;{}PROC pruefe abbruch:{}     IF pressed key = esc{}        THEN pruefe weiter{}     FI.{}     pruefe weiter:{}       TEXT VAR naechstes zeichen :: pressed key (20);{}       IF naechstes zeichen = stopzeichen{}          THEN ende gewuenscht := TRUE{}       ELIF naechstes zeichen = abbruch zeichen{}
+          THEN setze variable in anfangszustand;{}               cursor off;{}               errorstop (1951, "Programm - Abbruch durch <ESC><"{}                               + abbruchzeichen + ">"){}     FI{}END PROC pruefe abbruch;{}PROC regeneriere w2:{}     cursor (42, 19);{}     out (ecke oben links + (36 * waagerecht));{}     INT VAR zeile;{}     FOR zeile FROM 20 UPTO 22 REP{}         cursor (42, zeile); out (senkrecht);{}     PER;{}     cursor (42, 23); out (balken unten);{}     page (w2){}
+END PROC regeneriere w2;{}PROC fenster putzen:{}     page (w1);{}     page (w2){}END PROC fenster putzen;{}PROC lies nummer ein (INT VAR nummer):{}   line (w2, 2);{}   out  (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{}   hilfstext := text (nummer);{}   REP cursor  (w1, 19, 2);{}       editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,{}                                                       exit char);{}       pruefe exit char;{}       change all (hilfstext, " ", ""){}   UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;{}
+   nummer := int (hilfstext).{}   pruefe exit char:{}     IF exit char = esc + stopzeichen{}        THEN ende gewuenscht := TRUE;{}             cursor off; fenster putzen; cursor on;{}             nummer := 0;{}             LEAVE lies nummer ein{}     ELIF exit char = esc + abbruchzeichen{}        THEN setze variable in anfangszustand;{}             errorstop (1951, "Progamm - Abbruch durch <ESC><"{}                               + abbruchzeichen + ">"){}        ELSE ende gewuenscht := FALSE{}     FI.{}
+END PROC lies nummer ein;{}PROC lies artikelnummer ein:{}     page (w2);{}     cursor (w1, 2, 2);{}     out  (w1, "Artikelnummer  :           ");{}     IF codekartenleser aktiviert{}        THEN artikelnummer := gesicherter wert von interface{}                 (min artikelnummer , max artikelnummer, "Warenkarte"){}        ELSE artikelnummer von tastatur lesen{}     FI;{}     IF ende gewuenscht{}        THEN artikelnummer ist eingelesen := FALSE{}        ELSE artikelnummer ist eingelesen := TRUE{}
+     FI.{}   artikelnummer von tastatur lesen:{}     cursor on;{}     REP out  (w2, " Artikelnummer eingeben");{}         lies nummer ein (artikelnummer);{}     UNTIL ende gewuenscht COR artikelnummer zulaessig PER.{}     artikelnummer zulaessig:{}       IF  (artikelnummer < min artikelnummer OR{}            artikelnummer > max artikelnummer){}           THEN page (w2); out (""7"");{}                out  (w2, " Unzulässige Artikelnummer!");{}                line (w2, 2);{}                out  (w2, " Bitte irgendeine Taste tippen!");{}
+                pause; page (w2);{}                FALSE{}           ELSE TRUE{}       FI.{}END PROC lies artikelnummer ein;{}PROC artikelnummer lesen:{}  pruefe abbruch;{}  lies artikelnummer ein;{}  IF artikelnummer ist eingelesen{}     THEN hole artikeldaten (artikelnummer, artikelname, preis,{}                             mindestbestand, bestand){}  FI{}END PROC artikelnummer lesen;{}PROC kundennummer lesen:{}  pruefe abbruch;{}  lies kundennummer ein;{}  IF kundennummer ist eingelesen{}     THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht){}
+  FI{}END PROC kundennummer lesen;{}PROC lies kundennummer ein:{}  page (w2);{}  cursor (w1, 2, 2);{}  out  (w1, "Kundennummer   :           ");{}  IF codekartenleser aktiviert{}     THEN kundennummer := gesicherter wert von interface{}                       (min kundennummer , max kundennummer, "Kundenkarte"){}     ELSE kundennummer von tastatur lesen{}  FI;{}  IF ende gewuenscht{}     THEN kundennummer ist eingelesen := FALSE{}     ELSE kundennummer ist eingelesen := TRUE{}  FI.{}  kundennummer von tastatur lesen:{}
+    cursor on;{}    REP out  (w2, " Kundennummer eingeben");{}        lies nummer ein (kundennummer){}    UNTIL ende gewuenscht COR kundennummer zulaessig PER.{}  kundennummer zulaessig:{}    IF  (kundennummer < min kundennummer OR{}         kundennummer > max kundennummer){}        THEN page (w2); out (""7"");{}             out  (w2, " Unzulässige Kundennummer!");{}             line (w2, 2);{}             out  (w2, " Bitte irgendeine Taste tippen!");{}             pause; page (w2);{}             FALSE{}
+        ELSE TRUE{}    FI.{}END PROC lies kundennummer ein;{}PROC zeige artikeldaten:{}     cursor (w1, 2, 6);{}     out    (w1, "Artikelname    : " + text (artikelname, 16));{}     cursor (w1, 2, 8);{}     out    (w1, "Preis          : " + text preis + "        ");{}     cursor (w1, 2, 10);{}     out    (w1, "Mindestbestand : " + text (mindestbestand) + "    ");{}     cursor (w1, 2, 12);{}     out    (w1, "Bestand        : " + text (bestand) + "    ").{}     text preis:{}       TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);{}
+       change (hilfe, " ", "0");{}       hilfe.{}END PROC zeige artikeldaten;{}PROC zeige kundendaten:{}     cursor (w1, 2, 6);{}     out    (w1, "Nachname       : " + text (nachname, 16));{}     cursor (w1, 2, 8);{}     out    (w1, "Vorname        : " + text (vorname , 16));{}     cursor (w1, 2, 10);{}     out    (w1, "Geschlecht     : " + geschlecht + "          ");{}END PROC zeige kundendaten;{}PROC artikeldaten speichern:{}  pruefe abbruch;{}  page (w2); line (w2);{}  out (w2, " Artikeldaten werden gespeichert") ;{}
+  speichere artikeldaten (artikelnummer, artikelname, preis,{}                          mindestbestand, bestand);{}  pause (10);{}  IF codekartenleser aktiviert{}     THEN lasse karte entfernen (FALSE){}  FI{}END PROC artikeldaten speichern;{}PROC kundendaten speichern:{}  pruefe abbruch;{}  page (w2); line (w2);{}  out (w2, " Kundendaten werden gespeichert") ;{}  speichere kundendaten (kundennummer, nachname,vorname, geschlecht);{}  pause (10);{}  IF codekartenleser aktiviert{}     THEN lasse karte entfernen (FALSE){}
+  FI{}END PROC kundendaten speichern;{}BOOL PROC stoptaste gedrueckt:{}  pruefe abbruch;{}  ende gewuenscht{}END PROC stoptaste gedrueckt;{}BOOL PROC stoptaste gedrückt:{}  stoptaste gedrueckt{}END PROC stoptaste gedrückt;{}PROC neues blatt:{}  pruefe abbruch;{}  page (w3k);{}  page (w3);{}  auf neuem blatt := TRUE;{}  forget ("WARENHAUS:Rechnung", quiet){}END PROC neues blatt;{}PROC nachbestellen:{}  pruefe abbruch;{}  FILE VAR f;{}  warten in w2;{}  hole bestelliste (f);{}  pruefe abbruch;{}  cursor (2,24);{}
+  out ("Weiter mit <ESC><q>;  Cursor bewegen: <Pfeile>");{}  cursor on;{}  show (w4, f);{}  cursor off;{}  cursor (1, 24); out (""5"");{}  WINDOW VAR  w :: window(45,18,25,3);{}  outframe (w);{}  IF yes (w, "Bestelliste drucken", FALSE){}     THEN drucke (headline (f)){}  FI;{}  cursor on;{}  forget (headline (f), quiet){}END PROC nachbestellen;{}PROC warten in w2:{}  cursor off;{}  page (w2);{}  line (w2);{}  out (w2, " Bitte warten!");{}  cursor on{}END PROC warten in w2;{}PROC codenummer von tastatur lesen (INT VAR codenummer):{}
+     codenummer := 0;{}     out  (w2, " Codenummer eingeben");{}     cursor on;{}     lies nummer ein (codenummer){}END PROC codenummer von tastatur lesen;{}PROC auskunft:{}  pruefe abbruch;{}  FILE VAR f;{}  INT VAR codenummer :: 0;{}  cursor (w1, 2, 2);{}  out  (w1, "Codenummer     :            ");{}  page (w2);{}  IF codekartenleser aktiviert{}     THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");{}          lasse karte entfernen (FALSE){}     ELSE codenummer von tastatur lesen (codenummer){}
+  FI;{}  IF ende gewuenscht THEN LEAVE auskunft FI;{}  SELECT codenummer OF CASE 66, 67, 68 : hitliste{}                       CASE 73, 74, 75 : kaeuferliste{}                       CASE 77, 78, 79 : kundenliste{}                       CASE 84, 85, 86 : einkaufsliste{}                       CASE 89, 90, 91 : lageruebersicht{}  OTHERWISE teste auf artikel oder kundennummer{}  END SELECT;{}  IF codekartenleser aktiviert CAND wert von interface <> 255{}     THEN karte entfernen{}  FI.{}  karte entfernen:{}
+    SELECT codenummer OF{}      CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,{}           91:  lasse karte entfernen (TRUE){}      OTHERWISE lasse karte entfernen (FALSE){}    END SELECT.{}  teste auf artikel oder kundennummer:{}    IF   codenummer >= min artikelnummer AND codenummer <= max artikelnummer{}         THEN gib auskunft ueber artikeldaten{}    ELIF codenummer >= min kundennummer  AND codenummer <= max kundennummer{}         THEN gib auskunft ueber kundendaten{}    ELSE unzulaessige codenummer{}
+    FI.{}  unzulaessige codenummer:{}    out (10 * ""7"");{}    page (w2);{}    out  (w2, " Unzulässige Codenummer !!!");{}    line (w2, 2);{}    out  (w2, " Bitte irgendeine Taste tippen!");{}    pause;{}    page (w2).{}  gib auskunft ueber artikeldaten:{}    hole artikeldaten (codenummer, artikelname, preis,{}                       mindestbestand, bestand);{}    zeige artikeldaten;{}    artikelnummer ist eingelesen := FALSE;{}    stop w2;{}    page (w1).{}  gib auskunft ueber kundendaten:{}    hole kundendaten (codenummer, nachname, vorname, geschlecht);{}
+    zeige kundendaten;{}    kundennummer ist eingelesen := FALSE;{}    stop w2;{}    page (w1).{}  hitliste:{}    warten in w2;{}    hole auskunft ein (codenummer, 0, f);{}    zeige f.{}  kundenliste:{}    warten in w2;{}    hole auskunft ein (codenummer, 0, f);{}    zeige f.{}  zeige f:{}    pruefe abbruch;{}    cursor (2, 24);{}    out ("Weiter mit <ESC><q>;  Cursor bewegen: <Pfeile>");{}    show (w4, f);{}    cursor (1, 24); out (""5"");{}    evtl drucken.{} lageruebersicht:{}   warten in w2;{}
+   hole auskunft ein (codenummer, 0, f);{}   zeige f.{} kaeuferliste:{}   lies artikelnummer ein;{}   IF artikelnummer ist eingelesen{}      THEN artikelnummer ist eingelesen := FALSE;{}           warten in w2;{}           hole auskunft ein (codenummer, artikelnummer, f);{}           zeige f{}   FI.{} einkaufsliste:{}   lies kundennummer ein;{}   IF kundennummer ist eingelesen{}      THEN kundennummer ist eingelesen := FALSE;{}           warten in w2;{}           hole auskunft ein (codenummer, kundennummer, f);{}
+           zeige f{}   FI.{} evtl drucken:{}   WINDOW VAR  w :: window(46,18,22,3);{}   cursor off;{}   outframe (w);{}   IF yes (w, "Auskunft drucken", FALSE){}      THEN drucke (headline (f)){}   FI;{}   cursor on;{}   forget (headline (f), quiet).{}END PROC auskunft;{}PROC rechnungskopf:{}  pruefe abbruch;{}  IF kundennummer ist eingelesen AND nachname <> ""{}     THEN ueberschrift := "    RECHNUNG für " + anrede + (vorname SUB 1) +{}                          ". " + text (nachname, 10){}     ELSE ueberschrift := "    RECHNUNG"{}
+  FI;{}  summe := 0.0;{}  schreibe ueberschrift auf bildschirm;{}  schreibe in rechnungsdatei;{}  IF codekartenleser aktiviert{}     THEN lasse karte entfernen (FALSE){}  FI.{}  schreibe in rechnungsdatei:{}    sysout ("WARENHAUS:Rechnung");{}    line;{}    put (ueberschrift);{}    line;{}    put ("   ==================================");{}    line (2);{}    sysout ("").{}  anrede:{}    IF   geschlecht = "m"{}         THEN "Herrn "{}    ELIF geschlecht = "w"{}         THEN "Frau "{}         ELSE ""{}
+    FI.{}END PROC rechnungskopf;{}PROC schreibe ueberschrift auf bildschirm:{}  INT VAR spalte, zeile;{}  get cursor (w3, spalte, zeile);{}  IF zeile = 1{}     THEN auf neuem blatt := TRUE;{}          schreibe in w3k{}     ELSE auf neuem blatt := FALSE;{}          schreibe in w3{}  FI.{}  schreibe in w3:{}    IF remaining lines (w3) < 7{}       THEN page (w3);{}            page (w3k);{}            auf neuem blatt := TRUE;{}            schreibe in w3k{}       ELSE line (w3);{}            out  (w3, ueberschrift);{}
+            line (w3);{}            out  (w3, "   ==================================");{}            line (w3, 2){}    FI.{}  schreibe in w3k:{}            out  (w3k, ueberschrift);{}            line (w3k);{}            out  (w3k, "   ==================================").{}END PROC schreibe ueberschrift auf bildschirm;{}PROC artikel kaufen:{}  pruefe abbruch;{}  IF artikelnummer ist eingelesen{}     THEN kauf registrieren{}     ELSE setze variable in anfangszustand;{}          errorstop ("Es ist keine Artikelnummer eingelesen worden!"){}
+  FI;{}  IF codekartenleser aktiviert{}     THEN lasse karte entfernen (FALSE){}  FI.{}  kauf registrieren:{}    artikelnummer ist eingelesen := FALSE;{}    IF bestand > 0{}       THEN artikel auf rechnung setzen;{}            registrieren{}       ELSE page (w2); out (""7"");{}            IF artikelname = ""{}               THEN out (w2, " Artikel hier nicht erhältlich!"){}               ELSE out (w2, " Der Artikel ist ausverkauft!"){}            FI;{}            line (w2, 2);{}            out (w2, " Weiter durch Tippen einer Taste");{}
+            pause{}    FI.{}  registrieren:{}    IF kundennummer ist eingelesen{}       THEN registriere verkauf (kundennummer, artikelnummer){}       ELSE registriere verkauf (min kundennummer - 1, artikelnummer){}    FI.{}    artikel auf rechnung setzen:{}      summe INCR preis;{}      IF remaining lines (w3) < 3{}         THEN beginne wieder oben{}      FI;{}      out  (w3, "    " + text (artikelname, 15) + text (preis, 12, 2));{}      line (w3);{}      sysout ("WARENHAUS:Rechnung");{}      put  ("    " + text (artikelname, 15) + text preis);{}
+      line;{}      sysout ("").{}      beginne wieder oben:{}        IF auf neuem blatt{}           THEN page (w3){}           ELSE schreibe ueberschrift auf bildschirm{}       FI.{}      text preis:{}        TEXT VAR hilfe     :: text (preis, 12, 2);{}        INT  VAR vor punkt :: pos  (hilfe, ".") - 1;{}        IF (hilfe SUB vor punkt) = " "{}           THEN change (hilfe, vor punkt, vor punkt, "0"){}        FI;{}        hilfe.{}END PROC artikel kaufen;{}PROC abrechnung:{}  pruefe abbruch;{}  schreibe summe auf bildschirm;{}
+  schreibe summe in rechnungsdatei;{}  setze variable zurueck;{}  frage ob drucken;{}  IF codekartenleser aktiviert{}     THEN lasse karte entfernen (FALSE){}  FI.{}  schreibe summe auf bildschirm:{}    IF remaining lines (w3) < 2{}       THEN beginne wieder oben{}    FI;{}    put  (w3, "                   -------------");{}    line (w3);{}    put  (w3, "    Summe          " + text (summe, 12, 2));{}    line (w3).{}  beginne wieder oben:{}    IF auf neuem blatt{}       THEN page (w3){}       ELSE schreibe ueberschrift auf bildschirm{}
+    FI.{}  schreibe summe in rechnungsdatei:{}    sysout ("WARENHAUS:Rechnung");{}    put ("                   -------------");{}    line;{}    put ("    Summe          " + text (summe, 12, 2));{}    line;{}    sysout ("").{}  setze variable zurueck:{}    BOOL VAR alter wert :: ende gewuenscht;{}    setze variable in anfangszustand;{}    ende gewuenscht := alter wert.{}  frage ob drucken:{}    IF yes (w2, "Rechnung drucken", FALSE){}       THEN cursor (3, 22);{}            disable stop;{}            print ("WARENHAUS:Rechnung");{}
+            IF is error THEN clear error FI;{}            enable stop{}    FI.{}END PROC abrechnung;{}PROC artikeldaten eingeben:{}  pruefe abbruch;{}  IF artikelnummer ist eingelesen{}     THEN lies artikeldaten ein;{}          artikeldaten speichern{}     ELSE setze variable in anfangszustand;{}          errorstop ("Es ist keine Artikelnummer eingelesen worden!"){}  FI.{}  lies artikeldaten ein:{}    zeige artikeldaten;{}    IF artikelname <> ""{}       THEN vielleicht schon fertig{}       ELSE page (w2){}
+    FI;{}    REP line (w2);{}        put  (w2, " Artikeldaten eingeben");{}        eingabe{}    UNTIL yes (w2, "Alles richtig", TRUE){}    PER;{}    artikelnummer ist eingelesen := FALSE.{}  vielleicht schon fertig:{}    IF yes (w2, "Alles richtig", TRUE){}       THEN  artikelnummer ist eingelesen := FALSE;{}             IF codekartenleser aktiviert{}                THEN lasse karte entfernen (FALSE){}             FI;{}             LEAVE artikeldaten eingeben{}    FI.{}  eingabe:{}    name holen;{}
+    preis holen;{}    mindestbestand holen;{}    bestand holen.{}  name holen:{}    REP cursor  (w1, 19, 6);{}        editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,{}                                              exit char);{}        teste auf abbruch{}    UNTIL artikelname <> "" PER.{}  preis holen:{}    hilfstext := text (preis, pos(text(preis),".") + 2, 2);{}    change (hilfstext, " ", "0");{}    REP cursor  (w1, 19, 8);{}        editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,{}
+                                          exit char);{}        change (hilfstext, ",", ".");{}        preis := round (real (hilfstext), 2);{}        teste auf abbruch{}    UNTIL preis >= 0.0 PER.{}  mindestbestand holen:{}    hilfstext := text (mindestbestand);{}    REP cursor  (w1, 19, 10);{}        editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{}                                          exit char);{}        mindestbestand := int (hilfstext);{}        teste auf abbruch{}    UNTIL mindestbestand >= 0 PER.{}
+  bestand holen:{}    hilfstext := text (bestand);{}    REP cursor  (w1, 19, 12);{}        editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{}                                          exit char);{}        bestand := int (hilfstext);{}        teste auf abbruch{}    UNTIL bestand >= 0 PER.{}  teste auf abbruch:{}    IF   exit char = esc + stopzeichen{}         THEN ende gewuenscht := TRUE{}    ELIF exit char = esc + abbruchzeichen{}         THEN setze variable in anfangszustand;{}              errorstop (1951, "Programm - Abbruch durch <ESC><"{}
+                                + abbruchzeichen + ">"){}    FI.{}END PROC artikeldaten eingeben;{}PROC kundendaten eingeben:{}  IF kundennummer ist eingelesen{}     THEN lies kundendaten ein;{}          kundendaten speichern{}  ELSE setze variable in anfangszustand;{}       errorstop ("Es ist keine Kundennummer eingelesen worden!"){}  FI.{}  lies kundendaten ein:{}    zeige kundendaten;{}    IF nachname <> ""{}       THEN vielleicht schon fertig{}       ELSE page (w2){}    FI;{}    REP line (w2);{}
+        put  (w2, " Kundendaten eingeben");{}        eingabe{}    UNTIL  yes (w2, "Alles richtig", TRUE) PER;{}    kundennummer ist eingelesen := FALSE.{}  vielleicht schon fertig:{}    IF yes (w2, "Alles richtig", TRUE){}       THEN  kundennummer ist eingelesen := FALSE;{}             IF codekartenleser aktiviert{}                THEN lasse karte entfernen (FALSE){}             FI;{}             LEAVE kundendaten eingeben{}    FI.{}  eingabe:{}    nachname holen;{}    vorname holen;{}    geschlecht holen.{}
+  nachname holen:{}    REP cursor  (w1, 19, 6);{}        editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,{}                                           exit char);{}        teste auf abbruch{}    UNTIL nachname <> "" PER.{}  vorname holen:{}    REP cursor  (w1, 19, 8);{}        editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,{}                                          exit char);{}        teste auf abbruch{}    UNTIL vorname <> "" PER.{}  geschlecht holen:{}    REP cursor  (w1, 19, 10);{}
+        editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,{}                                           exit char);{}        geschlecht  := geschlecht SUB 1;{}        teste auf abbruch{}    UNTIL geschlecht = "m" OR geschlecht = "w" PER.{}  teste auf abbruch:{}    IF   exit char = esc + stopzeichen{}         THEN ende gewuenscht := TRUE{}    ELIF exit char = esc + abbruchzeichen{}         THEN setze variable in anfangszustand;{}              errorstop (1951, "Programm - Abbruch durch <ESC><"{}
+                                + abbruchzeichen + ">"){}    FI.{}END PROC kundendaten eingeben;{}PROC drucke (TEXT CONST name):{}  TEXT VAR zeile;{}  FILE VAR f :: sequential file (modify, name);{}  to line (f, 1);{}  insert record (f);{}  write  record (f, "#center#" + name);{}  down (f);{}  insert record (f);{}  down (f);{}  WHILE NOT eof (f) REP{}    read record (f, zeile);{}    IF pos (zeile, ""15"") > 0{}       THEN change (zeile, ""15"", "#on(""r"")#");{}            change (zeile, ""14"", "#off(""r"")#");{}
+            write record (f, zeile){}    FI;{}    down (f){}  PER;{}  cursor (3, 22);{}  print (name){}END PROC drucke;{}PROC stop w2:{}  cursor off;{}  page (w2);{}  out (w2," Zum Weitermachen bitte");line(w2);{}  out (w2," irgendeine Taste tippen!");{}  pause;{}  page (w2);{}  cursor on{}END PROC stop w2;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):{}  BOOL VAR antwort :: default;{}  TEXT VAR taste;{}  INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;{}  cursor off;{}  cursor (42,24); out ("Ändern: <Pfeile>  Bestätigen: <RETURN>");{}
+  page (w);{}  out (w, center (w, frage + " ?"));{}  cursor (w, ja pos, 3);{}  IF default{}     THEN  out (w, ""15"Ja "14" Nein ");{}           cursor (w, ja pos, 3){}     ELSE  out (w, " Ja  "15"Nein "14"");{}           cursor (w, ja pos + 5, 3){}  FI;{}  tastendruck auswerten;{}  page (w);{}  cursor (42,24); out (""5"");{}  cursor on;{}  antwort.{}  tastendruck auswerten:{}    REP inchar (taste);{}        SELECT code (taste) OF CASE  2,   8 : position aendern{}                               CASE      13 : LEAVE tastendruck auswerten{}
+                               CASE 74, 106 : antwort := TRUE;  (*Jj*){}                                              LEAVE tastendruck auswerten{}                               CASE 78, 110 : antwort := FALSE; (*Nn*){}                                              LEAVE tastendruck auswerten{}        OTHERWISE out (""7"")  END SELECT{}    PER.{}    position aendern:{}      IF antwort THEN antwort := FALSE;{}                      cursor (w, ja pos, 3);{}                      out (w, " Ja  "15"Nein "14"");{}
+                      cursor (w, ja pos + 5, 3){}                 ELSE antwort := TRUE;{}                      cursor (w, ja pos, 3);{}                      out (w, ""15"Ja "14" Nein ");{}                      cursor (w, ja pos, 3){}      FI.{}END PROC yes;{}PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):{}  IF erwuenscht{}     THEN rueckmeldung := 0;{}          codekartenleser aktiviert := FALSE;{}          schliesse interface{}     ELSE oeffne interface (rueckmeldung);{}          IF rueckmeldung >= 0{}
+             THEN codekartenleser aktiviert := TRUE{}             ELSE codekartenleser aktiviert := FALSE{}          FI{}  FI{}END PROC tastatureingabe;{}BOOL PROC eingabe mit codekartenleser:{}  codekartenleser aktiviert{}END PROC eingabe mit codekartenleser;{}PROC dezimalwert lesen:{}  pruefe abbruch;{}  IF codekartenleser aktiviert{}     THEN interfacewerte zeigen{}     ELSE setze variable in anfangszustand;{}          errorstop ("Eingabeart ist auf Tastatur eingestellt!"){}  FI.{}  interfacewerte zeigen:{}
+    cursor off;{}    fenster putzen;{}    line (w1, 4); line (w2);{}    out (w1, " Dezimalwert :");{}    out (w2, " Lesen beenden mit <ESC><q>");{}    ende gewuenscht := FALSE;{}    REP pruefe abbruch;{}        cursor (w1, 17, 5);{}        out (w1, text (wert von interface, 3)){}    UNTIL ende gewuenscht PER;{}    page (w2); cursor (w1, 1, 5); out ("                         ");{}    cursor on.{}END PROC dezimalwert lesen;{}PROC bitmuster lesen:{}  pruefe abbruch;{}  IF codekartenleser aktiviert{}
+     THEN interfacewerte zeigen{}     ELSE setze variable in anfangszustand;{}          errorstop ("Eingabeart ist auf Tastatur eingestellt!"){}  FI.{}  interfacewerte zeigen:{}    cursor off;{}    fenster putzen;{}    line (w1, 4); line (w2);{}    out (w1, " Bitmuster :");{}    out (w2, " Lesen beenden mit <ESC><q>");{}    ende gewuenscht := FALSE;{}    REP pruefe abbruch;{}        cursor (w1, 16, 5);{}        out (w1, bitmuster (wert von interface)){}    UNTIL ende gewuenscht PER;{}    page (w2); cursor (w1, 1, 5); out ("                         ");{}
+    cursor on.{}END PROC bitmuster lesen;{}TEXT PROC bitmuster (INT CONST wert):{}  INT VAR bitnr;{}  TEXT VAR muster :: "";{}  FOR bitnr FROM 7 DOWNTO 0 REP{}    IF bit (wert, bitnr){}       THEN muster CAT "I"{}       ELSE muster CAT "O"{}    FI{}  PER;{}  muster{}END PROC bitmuster;{}PROC lasse karte entfernen (BOOL CONST mit rahmen):{}  IF wert von interface <> 255{}     THEN cursor off;{}          IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;{}          line (w2);{}          out (w2, " Bitte Karte entfernen");{}
+          REP pruefe abbruch{}          UNTIL (wert von interface = 255) OR ende gewuenscht PER;{}          cursor on{}  FI{}END PROC lasse karte entfernen;{}INT PROC gesicherter wert von interface (INT  CONST von, bis,{}                                         TEXT CONST kartenart):{}  INT VAR wert, zaehler;{}  ende gewuenscht := FALSE;{}  cursor off;{}  REP out (w2, " Bitte " + kartenart + " einschieben");{}      line (w2, 2);{}      out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{}      cursor (79, 24);{}
+      gesicherten wert einlesen;{}      cursor (w1, 19, 2);{}      out (w1, text (wert, 3));{}      IF wert < von  OR  wert > bis{}         THEN warnung{}      FI{}  UNTIL wert >= von  AND  wert <= bis PER;{}  cursor on;{}  wert.{}  gesicherten wert einlesen:{}    REP zaehler := 0;{}        warte auf karte;{}        wert := wert von interface;{}        lies wert{}    UNTIL wert gesichert AND wert <> 255 PER.{}  warte auf karte:{}    REP beachte esc q{}    UNTIL wert von interface <> 255 PER.{}  beachte esc q:{}
+    pruefe abbruch;{}    IF ende gewuenscht{}       THEN cursor on;{}            LEAVE gesicherter wert von interface WITH 0{}    FI.{}  lies wert:{}    REP beachte esc q;{}        IF wert = wert von interface{}           THEN zaehler INCR 1{}           ELSE LEAVE lies wert{}        FI{}    UNTIL wert gesichert PER.{}    wert gesichert: zaehler = sicherheit.{}  warnung:{}    page (w2); out (""7"");{}    out (w2, " Dies ist keine " + kartenart + "!");{}    line (w2, 2);{}    out (w2, " Bitte Karte entfernen");{}
+    REP beachte esc q{}    UNTIL wert von interface = 255 PER;{}    page (w2).{}END PROC gesicherter wert von interface{}END PACKET ls warenhaus 3{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 4 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 4
new file mode 100644
index 0000000..a19a6d6
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 4
@@ -0,0 +1,48 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 4                    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 4 DEFINES                        
+       uebersetze:{}TYPE VOKABEL    = STRUCT (TEXT grin, elan),{}     REFINEMENT = STRUCT (TEXT name, INT aufruf);{}LET  befehlsanzahl         = 10,{}     max refinements       = 20,{}     max offene strukturen = 10,{}     schleife              =  1,{}     abfrage               =  2;{}ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :{}    (VOKABEL : ("Artikelnummerlesen",   "artikelnummer lesen"),{}     VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),{}     VOKABEL : ("Kundennummerlesen",    "kundennummer lesen"),{}{}
+     VOKABEL : ("Kundendateneingeben",  "kundendaten eingeben"),{}     VOKABEL : ("Rechnungskopf",        "rechnungskopf"),{}     VOKABEL : ("Artikelkaufen",        "artikel kaufen"),{}     VOKABEL : ("Abrechnung",           "abrechnung"),{}     VOKABEL : ("Auskunft",             "auskunft"),{}     VOKABEL : ("neuesBlatt",           "neues blatt"),{}     VOKABEL : ("Bildschirmneu",        "bildschirm neu"));{}ROW max refinements REFINEMENT VAR refinement;{}ROW max offene strukturen  INT VAR offene struktur;{}{}
+INT VAR zeilennummer, erster fehler;{}OP := (VOKABEL VAR links, VOKABEL CONST rechts):{}   CONCR (links) := CONCR (rechts){}END OP :=;{}PROC uebersetze (TEXT CONST dateiname):{}forget ("elanprogramm", quiet);{}FILE VAR quelle :: sequential file (input, dateiname),{}         ziel   :: sequential file (output, "elanprogramm");{}suche programmanfang;{}WHILE NOT (eof (quelle) OR anything noted) REP{}  bearbeite zeile{}PER;{}IF NOT anything noted{}   THEN abschlusspruefung{}FI;{}IF anything noted{}   THEN quelle := sequential file (modify, dateiname);{}{}
+        to line (quelle, erster fehler);{}        col (1);{}        noteedit (quelle);{}        errorstop (""){}FI.{}abschlusspruefung:{}  IF anzahl refinements > 0{}     THEN pruefe refinementliste{}     ELSE pruefe programmende{}  FI.{}pruefe programmende:{}  IF programmende fehlt{}     THEN zeilennummer INCR 1;{}          fehler (16){}  FI.{}pruefe refinementliste:{}  zeilennummer INCR 1;{}  pruefe auf offene schleife oder abfrage;{}  put (ziel, "END PROC refinement " + text (letztes refinement));{}{}
+  FOR index FROM 1 UPTO anzahl refinements REP{}    IF refinement [index].aufruf > 0{}       THEN zeilennummer := refinement [index].aufruf;{}            fehler (25){}    ELIF refinement [index].aufruf < 0{}       THEN zeilennummer := - refinement [index].aufruf;{}            fehler (26){}    FI{}  PER.{}suche programmanfang:{}  TEXT VAR restzeile, zeile :: "";{}  BOOL VAR programmende fehlt := FALSE,{}           refinement muss folgen := FALSE;{}  INT VAR anzahl refinements := 0,{}          letztes refinement := 0,{}{}
+          letzte geoeffnete  := 0,{}          index;{}  zeilennummer       := 0;{}  erster fehler      := 0;{}  WHILE NOT eof (quelle) AND zeile = "" REP{}    getline (quelle, zeile);{}    zeile := compress (zeile);{}    zeilennummer INCR 1;{}    cout (zeilennummer);{}    IF zeile = "" THEN line (ziel) FI;{}  PER;{}  put (ziel, "bildschirm neu;");{}  IF zeile = "" THEN LEAVE uebersetze{}  ELIF pos (zeile, "PROGRAMM") = 1{}       THEN programmende fehlt := TRUE{}       ELSE fehler (1){}  FI.{}bearbeite zeile:{}{}
+  zeilennummer INCR 1;{}  cout (zeilennummer);{}  getline (quelle, zeile);{}  zeile := compress (zeile);{}  change all (zeile, " ", "");{}  IF zeile = ""{}     THEN line (ziel){}     ELSE analysiere und uebersetze{}  FI.{}analysiere und uebersetze:{}  IF refinement muss folgen{}     THEN erstes refinement{}     ELSE pruefe zunaechst auf schluesselworte;{}          durchsuche befehlsliste{}  FI.{}erstes refinement:{}  IF pos (zeile, ":") = 0{}     THEN fehler (19){}  ELIF pos (zeile, ":") < length (zeile){}{}
+     THEN fehler (20){}  ELIF (pos (zeile, "PROGRAMM")   = 1) OR{}       (pos (zeile, "ENDE")       = 1) OR{}       (pos (zeile, "WIEDERHOLE") = 1) OR{}       (pos (zeile, "BIS")        = 1) OR{}       (pos (zeile, "WENN")       = 1){}     THEN fehler (21){}  ELIF (zeile = "Stoptastegedrückt:") OR{}       (zeile = "nichtStoptastegedrückt:") OR{}       (zeile = "Stoptastegedrueckt:") OR{}       (zeile = "nichtStoptastegedrueckt:"){}     THEN fehler (22){}     ELSE refinement muss folgen := FALSE;{}{}
+          line (ziel);{}          trage befehlsdefinition ein{}  FI.{}trage befehlsdefinition ein:{}   change (zeile, ":", "");{}   FOR index FROM 1 UPTO anzahl refinements REP{}     IF refinement [index].name = zeile{}        THEN pruefe aufruf; LEAVE trage befehlsdefinition ein{}     FI{}   PER;{}   anzahl refinements INCR 1;{}   IF anzahl refinements > max refinements{}      THEN fehler (24){}   ELSE refinement [anzahl refinements].name := zeile;{}        refinement [anzahl refinements].aufruf := - zeilennummer;{}{}
+        letztes refinement := anzahl refinements;{}        line (ziel);{}        put (ziel, "PROC refinement " + text (anzahl refinements) + ":"){}   FI.{}pruefe aufruf:{}  IF refinement [index].aufruf > 0{}     THEN refinement [index].aufruf := 0;{}          line (ziel);{}          put (ziel, "PROC refinement " + text (index) + ":");{}          letztes refinement := index{}     ELSE fehler (23){}  FI.{}pruefe zunaechst auf schluesselworte:{}  IF   pos (zeile, "WIEDERHOLE") = 1{}       THEN oeffne schleife; LEAVE analysiere und uebersetze{}{}
+  ELIF pos (zeile, "WENN") = 1{}       THEN oeffne if; LEAVE analysiere und uebersetze{}  ELIF pos (zeile, "BIS")  = 1{}       THEN schliesse mit until; LEAVE analysiere und uebersetze{}  ELIF pos (zeile, "ENDE") = 1{}       THEN schliesse; LEAVE analysiere und uebersetze{}  ELIF pos (zeile, "PROGRAMM") = 1{}       THEN fehler (18); LEAVE analysiere und uebersetze{}  FI.{}oeffne schleife:{}  IF letzte geoeffnete = max offene strukturen{}     THEN fehler (2){}     ELSE letzte geoeffnete INCR 1;{}          offene struktur [letzte geoeffnete] := schleife;{}{}
+          analysiere schleifenart{}  FI.{}analysiere schleifenart:{}  IF zeile = "WIEDERHOLE"{}     THEN line (ziel); put (ziel, "REPEAT"){}     ELSE es muss eine zaehlschleife sein{}  FI.{}es muss eine zaehlschleife sein:{}  restzeile := subtext (zeile, 11);{}  INT  VAR malpos := pos (restzeile, "MAL");{}  IF malpos > 0{}     THEN zaehlschleife{}     ELSE fehler (3){}  FI.{}zaehlschleife:{}  IF length (restzeile) > malpos + 2{}     THEN fehler (4){}     ELSE bestimme anzahl der wiederholungen{}  FI.{}{}
+bestimme anzahl der wiederholungen:{}  INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));{}  IF last conversion ok{}     THEN line (ziel);{}          put (ziel, "INT VAR index" + text (zeilennummer) +{}                     "; FOR index" + text (zeilennummer) +{}                     " FROM 1 UPTO " + text (wdh) + " REPEAT"){}     ELSE fehler (5){}  FI.{}oeffne if:{}  IF letzte geoeffnete = max offene strukturen{}     THEN fehler (6){}     ELSE letzte geoeffnete INCR 1;{}          offene struktur [letzte geoeffnete] := abfrage;{}{}
+          uebersetze abfrage{}  FI.{}uebersetze abfrage:{}  restzeile := subtext (zeile, 5);{}  IF   (restzeile = "Stoptastegedrückt") OR{}       (restzeile = "Stoptastegedrueckt"){}       THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN"){}  ELIF (restzeile = "nichtStoptastegedrückt") OR{}       (restzeile = "nichtStoptastegedrueckt"){}       THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN"){}  ELIF restzeile = ""{}       THEN fehler (7){}       ELSE fehler (8){}  FI.{}schliesse mit until:{}{}
+  teste ob als letztes schleife offen;{}  letzte geoeffnete DECR 1;{}  restzeile := subtext (zeile, 4);{}  IF   (restzeile = "Stoptastegedrückt") OR{}       (restzeile = "Stoptastegedrueckt"){}       THEN line (ziel);{}            put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");{}  ELIF (restzeile = "nichtStoptastegedrückt") OR{}       (restzeile = "nichtStoptastegedrueckt"){}       THEN line (ziel);{}            put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");{}  ELIF restzeile = ""{}{}
+       THEN fehler (9){}       ELSE fehler (8){}  FI.{}schliesse:{}  restzeile := subtext (zeile, 5);{}  IF restzeile = "WIEDERHOLE"{}     THEN schliesse schleife{}  ELIF restzeile = "WENN"{}     THEN schliesse if{}  ELIF restzeile = "PROGRAMM"{}     THEN programmende{}     ELSE fehler (10){}  FI.{}schliesse schleife:{}  teste ob als letztes schleife offen;{}  letzte geoeffnete DECR 1;{}  line (ziel); put (ziel, "END REPEAT;").{}teste ob als letztes schleife offen:{}  IF letzte geoeffnete = 0{}     THEN fehler (11);{}{}
+          LEAVE bearbeite zeile{}  ELIF offene struktur [letzte geoeffnete] = abfrage{}     THEN fehler (12){}  FI.{}schliesse if:{}  teste ob als letztes abfrage offen;{}  line (ziel); put (ziel, "END IF;");{}  letzte geoeffnete DECR 1.{}teste ob als letztes abfrage offen:{}  IF letzte geoeffnete = 0{}     THEN fehler (13);{}          LEAVE bearbeite zeile{}  ELIF offene struktur [letzte geoeffnete] = schleife{}     THEN fehler (14){}  FI.{}programmende:{}  IF programmende fehlt{}     THEN programmende fehlt     := FALSE;{}{}
+          refinement muss folgen := TRUE{}     ELSE fehler (17);{}          LEAVE programmende{}  FI;{}  pruefe auf offene schleife oder abfrage.{}pruefe auf offene schleife oder abfrage:{}  IF letzte geoeffnete = 0{}     THEN alles okay{}  ELIF offene struktur [letzte geoeffnete] = schleife{}     THEN fehler (14){}     ELSE fehler (12){}  FI.{}  alles okay: .{}durchsuche befehlsliste:{}  IF pos (zeile, ":") > 0{}     THEN auf refinementdefinition pruefen{}     ELSE befehl suchen{}  FI.{}befehl suchen:{}{}
+  BOOL VAR gefunden := FALSE;{}  INT VAR i;{}  verhindere bedingung;{}  FOR i FROM 1 UPTO befehlsanzahl REP{}    IF befehl [i].grin = zeile{}       THEN gefunden := TRUE;{}            line (ziel);{}            put (ziel, befehl [i].elan + ";"){}    FI{}  UNTIL gefunden PER;{}  IF NOT gefunden{}     THEN trage in refinementliste ein{}  FI.{}auf refinementdefinition pruefen:{}  IF pos (zeile, ":") < length (zeile){}     THEN fehler (20){}  ELIF programmende fehlt{}     THEN fehler (16){}  ELIF (zeile = "Stoptastegedrückt:") OR{}{}
+       (zeile = "nichtStoptastegedrückt:") OR{}       (zeile = "Stoptastegedrueckt:") OR{}       (zeile = "nichtStoptastegedrueckt:"){}     THEN fehler (22){}     ELSE pruefe auf offene schleife oder abfrage;{}          put (ziel, "END PROC refinement " + text (letztes refinement){}                                             + ";");{}          trage befehlsdefinition ein{}  FI.{}trage in refinementliste ein:{}  FOR index FROM 1 UPTO anzahl refinements REP{}    IF refinement [index].name = zeile{}{}
+       THEN trage evtl aufruf ein;{}            LEAVE trage in refinementliste ein{}    FI{}  PER;{}  anzahl refinements INCR 1;{}  IF anzahl refinements > max refinements{}     THEN fehler (24){}     ELSE refinement [anzahl refinements].name := zeile;{}          refinement [anzahl refinements].aufruf := zeilennummer;{}          line (ziel);{}          put (ziel, "refinement " + text (anzahl refinements) + ";"){}  FI.{}trage evtl aufruf ein:{}  line (ziel);{}  put (ziel, "refinement " + text (index) + ";");{}{}
+  IF refinement [index].aufruf < 0{}     THEN refinement [index].aufruf := 0{}  FI.{}verhindere bedingung:{}  IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR{}     (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt"){}     THEN fehler (15);{}          LEAVE bearbeite zeile{}  FI.{}END PROC uebersetze;{}PROC fehler (INT CONST fehlernr):{}  noteline;{}  note ("FEHLER in Zeile " + text (zeilennummer) + ": ");{}  noteline;{}  note ("       " + anwendungstext (fehlernr + 20));{}{}
+  noteline;{}  IF erster fehler = 0{}     THEN erster fehler := zeilennummer{}  FI{}END PROC fehler{}END PACKET ls warenhaus 4{}{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus 5 b/app/gs.warenhaus/1.01/src/ls-Warenhaus 5
new file mode 100644
index 0000000..6b05bad
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus 5
@@ -0,0 +1,103 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                    ls-Warenhaus 5                    ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+PACKET ls warenhaus 5 DEFINES                        
+       warenhaus,{}       grin,{}       direktbefehl 1,{}       direktbefehl 2,{}       direktbefehl 3,{}       direktbefehl 4,{}       direktbefehl 5,{}       direktbefehl 6,{}       direktbefehl 7,{}       warenhausbefehle zeigen,{}       eingabe grundeinstellung,{}       tastatur einstellen,{}       kartenleser einstellen,{}       evtl d und b sperren,{}       loesche zwischenraum,{}       eingabeart anzeigen,{}       filialdaten zusammenstellen,{}       filialdaten eintragen,{}       filialdaten verzeichnis,{}
+       filialdaten umbenennen,{}       filialdaten loeschen,{}       warenhausprogramme verzeichnis,{}       warenhausprogramm neu erstellen,{}       warenhausprogramm ansehen,{}       warenhausprogramm kopieren,{}       warenhausprogramm umbenennen,{}       warenhausprogramme loeschen,{}       warenhausprogramme drucken,{}       warenhausprogramm starten,{}       warenhausprogramm wiederholen:{}LET  menukarte       = "ls-MENUKARTE:Warenhaus",{}     praefix         = "Filialdaten:",{}     filialdatentyp  =       1951,{}
+     niltext         =         "",{}     maxlaenge       =         45,{}     maxnamenslaenge =         35;{}TEXT VAR  filialdatenname :: "",{}          programmname    :: "";{}INT  VAR  fehlerzeile     :: 0;{}BOOL VAR  grin version    :: FALSE,{}          noch kein programm gelaufen :: TRUE,{}          bildschirm neu eingesetzt   :: FALSE;{}WINDOW VAR w :: window (1, 3, 79, 19);{}INITFLAG VAR in this task :: FALSE;{}PROC warenhausbefehle zeigen:{}  TEXT VAR info, liste, tasten;{}  INT  VAR grinoffset;{}
+  IF grin version{}     THEN grinbefehle{}     ELSE elanbefehle{}  FI;{}  REP{}   INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{}   SELECT auswahl OF{}     CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)){}     CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)){}     CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)){}   END SELECT{}  UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.{}  grinbefehle:{}    grinoffset := 13;{}    info := "       "15"Info zu den Programmierbefehlen "14""13""13""{}
+          + "          d  Datei - Bearbeitung           "13""{}          + "          e  Einkaufen und Auskunft        "13""{}          + "          k  Kontroll - Strukturen         "13""13""{}          + "          z  Zurück zum Hauptmenü          ";{}  liste  := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";{}  tasten := "dekzDEKZ".{}  elanbefehle:{}    grinoffset := 0;{}    info := "       "15"Info zu den Programmierbefehlen "14""13""13""{}          + "          d  Datei - Bearbeitung           "13""{}
+          + "          e  Einkaufen und Auskunft        "13""{}          + "          s  Sonstige Befehle              "13""13""{}          + "          z  Zurück zum Hauptmenü          ";{}  liste  := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";{}  tasten := "deszDESZ".{}END PROC warenhausbefehle zeigen;{}PROC eingabe grundeinstellung:{}  INT VAR dummy;{}  IF eingabe mit codekartenleser{}     THEN tastatureingabe (TRUE, dummy){}  FI{}END PROC eingabe grundeinstellung;{}PROC tastatur einstellen:{}
+  eingabe grundeinstellung;{}  menuinfo (anwendungstext (6), 4){}END PROC tastatur einstellen;{}PROC kartenleser einstellen:{}  INT VAR ergebnis;{}  IF eingabe mit codekartenleser{}     THEN tastatureingabe (TRUE, ergebnis){}  FI;{}  pause (10);{}  tastatureingabe (FALSE, ergebnis);{}  IF ergebnis < 0{}     THEN menuinfo (anwendungstext (7 - ergebnis), 5){}     ELSE menuinfo (anwendungstext (7), 4){}  FI{}END PROC kartenleser einstellen;{}PROC loesche zwischenraum:{}  INT VAR zeile;{}  cursor (1, 2); out (79 * waagerecht + " ");{}
+  FOR zeile FROM 3 UPTO 22 REP{}    cursor (1, zeile); out (""5"");{}  PER;{}  cursor (1, 23); out (79 * waagerecht + " ");{}  cursor (1, 24); out (""5"");{}END PROC loesche zwischenraum;{}PROC ergaenze bildschirm:{}  cursor ( 1, 2); out (ecke oben links);{}  cursor (42, 2); out (balken oben);{}  cursor (80, 2); out (ecke oben rechts);{}  INT VAR zeile;{}  FOR zeile FROM 3 UPTO 22 REP{}    cursor ( 1, zeile); out (senkrecht);{}    cursor (42, zeile); out (senkrecht);{}    cursor (80, zeile); out (senkrecht){}
+  PER;{}  cursor ( 1, 23); out (ecke unten links);{}  cursor (42, 23); out (balken unten);{}  cursor (80, 23); out (ecke unten rechts);{}  cursor (42, 19);{}  out (balken links + (37 * waagerecht) + balken rechts);{}  cursor w3 1 1{}END PROC ergaenze bildschirm;{}PROC zweite zeile:{}  cursor (1, 2); out (79 * waagerecht + " "){}END PROC zweite zeile;{}PROC evtl d und b sperren:{}  IF eingabe mit codekartenleser{}     THEN activate ( 9);{}          activate (10){}     ELSE deactivate ( 9);{}          deactivate (10){}
+  FI{}END PROC evtl d und b sperren;{}PROC direktbefehl 1:{}  disable stop;{}  warendatei bearbeiten;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 1;{}PROC warendatei bearbeiten:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Warendatei bearbeiten"));{}  REP artikelnummer lesen;{}
+      IF NOT stoptaste gedrueckt{}         THEN artikeldaten eingeben{}      FI{}  UNTIL stoptaste gedrueckt PER{}END PROC warendatei bearbeiten;{}PROC direktbefehl 2:{}  disable stop;{}  kundendatei bearbeiten;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 2;{}PROC kundendatei bearbeiten:{}  enable stop;{}  loesche zwischenraum;{}
+  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Kundendatei bearbeiten"));{}  REP kundennummer lesen;{}      IF NOT stoptaste gedrueckt{}         THEN kundendaten eingeben{}      FI{}  UNTIL stoptaste gedrueckt PER{}END PROC kundendatei bearbeiten;{}PROC direktbefehl 3:{}  disable stop;{}  einkaufen gehen;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}
+  FI;{}  enable stop{}END PROC direktbefehl 3;{}PROC einkaufen gehen:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Einkaufen"));{}  forget ("WARENHAUS:Rechnung", quiet);{}  kundennummer lesen;{}  rechnungskopf;{}  REP   einkaufen{}  UNTIL stoptaste gedrueckt PER;{}  abrechnung;{}  forget ("WARENHAUS:Rechnung", quiet).{}  einkaufen:{}    artikelnummer lesen;{}    IF NOT stoptaste gedrueckt{}       THEN artikel kaufen{}    FI.{}END PROC einkaufen gehen;{}
+PROC direktbefehl 4:{}  disable stop;{}  auskunft einholen;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 4;{}PROC auskunft einholen:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Auskunft"));{}  auskunft{}END PROC auskunft einholen;{}PROC direktbefehl 5:{}  disable stop;{}
+  ware nachbestellen;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 5;{}PROC ware nachbestellen:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Nachbestellen"));{}  nachbestellen{}END PROC ware nachbestellen;{}PROC direktbefehl 6:{}  disable stop;{}  dezimalwerte von interface lesen;{}
+  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 6;{}PROC dezimalwerte von interface lesen:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Dezimalwert lesen"));{}  dezimalwert lesen{}END PROC dezimalwerte von interface lesen;{}PROC direktbefehl 7:{}  disable stop;{}
+  bitmuster von interface lesen;{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          menuinfo (" " + invers (errormessage));{}          clear error{}     ELSE zweite zeile;{}          menu bildschirm{}  FI;{}  enable stop{}END PROC direktbefehl 7;{}PROC bitmuster von interface lesen:{}  enable stop;{}  loesche zwischenraum;{}  ergaenze bildschirm;{}  cursor (2, 24); out (invers ("Bitmuster lesen"));{}  bitmuster lesen{}END PROC bitmuster von interface lesen;{}PROC eingabeart anzeigen:{}
+  IF eingabe mit codekartenleser{}     THEN menuinfo (anwendungstext (7), 4){}     ELSE menuinfo (anwendungstext (6), 4){}  FI{}END PROC eingabeart anzeigen;{}PROC warenhaus:{}  BOOL VAR am ende loeschen :: TRUE;{}  pruefe zulaessigkeit;{}  installiere menukarte mit anfangsbild;{}  initialisiere warenhaus;{}  handle menu ("WARENHAUS");{}  IF am ende loeschen{}     THEN sperre verwaltungstask;{}          end (task (verwaltung)){}  FI.{}  installiere menukarte mit anfangsbild:{}    install menu (menukarte, TRUE);{}
+    cursor off;{}    cursor (17, 20);{}    out (" W A R E N H A U S ");{}    cursor (21, 22);{}    out (invers("Filiale " + text (channel (myself))));{}    cursor (79, 24);{}    pause (10).{}  sperre verwaltungstask:{}    DATASPACE VAR ds;{}    INT VAR dummy;{}    forget (ds); ds := nilspace;{}    call (task (verwaltung), 256, ds, dummy).{}  pruefe zulaessigkeit:{}    IF   hauptstellenname = ""{}         THEN line;{}         putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");{}              end; LEAVE warenhaus{}
+    ELIF name (myself) = hauptstellenname{}         THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "{}                       + "Task aus gegeben werden!");{}              LEAVE warenhaus{}    FI.{} initialisiere warenhaus:{}  TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "{}                                            + text (channel (myself));{}  IF NOT exists task (verwaltung){}     THEN initialisiere verwaltung{}     ELSE biete evtl loeschen an{}  FI;{}  IF NOT initialized (in this task){}
+     THEN filialdatenname := "";{}          programmname    := ""{}  FI;{}  noch kein programm gelaufen := TRUE.{}  biete evtl loeschen an:{}    access catalogue;{}    IF NOT (father (task (verwaltung)) = myself){}       THEN fehlermeldung;{}            line;{}            end;{}            am ende loeschen := FALSE{}    FI.{}    fehlermeldung:{}      cursor (1, 22);{}      putline ("Filiale " + text (channel (myself)) +{}               " ist bereits besetzt durch TASK '"{}               + name (father (task (verwaltung))) + "'!");{}
+      putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").{}END PROC warenhaus;{}PROC grin (BOOL CONST entscheidung):{}  enable stop;{}  IF hauptstellenname = "" OR hauptstellenname = name (myself){}     THEN grin version := entscheidung{}     ELSE errorstop ("Dieser Befehl darf nur von der Task '" +{}                      hauptstellenname + "' aus gegeben werden!"){}  FI;{}  bildschirm neu eingesetzt := FALSE{}END PROC grin;{}PROC filialdaten verzeichnis:{}  disable stop;{}  THESAURUS VAR filialdaten ::{}
+  ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{}  forget ("Verzeichnis der Filialdaten-Dateien", quiet);{}  FILE VAR f ::{}  sequential file (output, "Verzeichnis der Filialdaten-Dateien");{}  f FILLBY filialdaten;{}  modify (f);{}  to line (f, 1); insert record (f);{}  menufootnote ("Verlassen: <ESC> <q>");{}  cursor on;{}  show (w, f);{}  cursor off;{}  forget ("Verzeichnis der Filialdaten-Dateien", quiet);{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}
+          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop{}END PROC filialdaten verzeichnis;{}PROC warenhausprogramme verzeichnis:{}  disable stop;{}  forget ("Verzeichnis der Programme", quiet);{}  THESAURUS VAR programme ::{}  ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}  IF exists ("WARENHAUS:Rechnung"){}     THEN programme := programme - "WARENHAUS:Rechnung"{}  FI;{}  FILE VAR f ::{}  sequential file (output, "Verzeichnis der Programme");{}
+  f FILLBY programme;{}  modify (f);{}  to line (f, 1); insert record (f);{}  menufootnote ("Verlassen: <ESC> <q>");{}  cursor on;{}  show (w, f);{}  cursor off;{}  forget ("Verzeichnis der Programme", quiet);{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop{}END PROC warenhausprogramme verzeichnis;{}PROC filialdaten zusammenstellen:{}  hole filialdatenname;{}
+  kontrolliere den filialdatennamen;{}  disable stop;{}  sichere filialdaten (praefix + filialdatenname);{}  IF is error{}     THEN out (""7"");{}          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE bestaetige{}  FI;{}  enable stop.{}  hole filialdatenname:{}    filialdatenname :=  menuanswer (ausgabe, filialdatenname, 5).{}  ausgabe:{}    center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""{}                   + " Bitte den Namen für die Filialdaten "13""13"".{}
+  kontrolliere den filialdatennamen:{}    IF   filialdatenname = niltext{}         THEN enable stop; LEAVE filialdaten zusammenstellen{}    ELIF length (filialdatenname) > maxnamenslaenge{}         THEN meckere zu langen namen an;{}              filialdatenname := niltext;{}              enable stop; LEAVE filialdaten zusammenstellen{}    ELIF exists (praefix + filialdatenname){}         THEN meckere existierenden filialdatennamen an;{}              enable stop; LEAVE filialdaten zusammenstellen{}
+    FI.{}    bestaetige:{}      menuinfo ("           "15"Bestätigung "14" "13""13"" +{}                "  Die  Filialdaten  wurden von der  "13"" +{}                "  Verwaltung unter dem gewünschten  "13"" +{}                "  Namen zusammengestellt.           "13"" , 3).{}END PROC filialdaten zusammenstellen;{}PROC warenhausprogramm neu erstellen:{}  hole programmname;{}  kontrolliere den programmnamen;{}  command dialogue (FALSE);{}  cursor on;{}  disable stop;{}  stdinfoedit (programmname, 3);{}
+  cursor off;{}  command dialogue (TRUE);{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers (errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop.{}  hole programmname:{}    programmname := "";{}    programmname :=  menuanswer (ausgabe, programmname, 5).{}  ausgabe:{}    center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{}                 + " Bitte den Namen für das Programm "13""13"".{}  kontrolliere den programmnamen:{}
+    IF   programmname = niltext{}         THEN LEAVE warenhausprogramm neu erstellen{}    ELIF length (programmname) > maxnamenslaenge{}         THEN meckere zu langen namen an;{}              programmname := niltext;{}              LEAVE warenhausprogramm neu erstellen{}    ELIF exists (programmname){}         THEN meckere existierendes programm an;{}              LEAVE warenhausprogramm neu erstellen{}    FI.{}END PROC warenhausprogramm neu erstellen;{}PROC warenhausprogramm ansehen:{}  IF programmname <> niltext CAND exists (programmname){}
+     THEN frage nach diesem programm{}     ELSE lasse programm auswaehlen{}  FI;{}  cursor on;{}  disable stop;{}  stdinfoedit (programmname, 3);{}  cursor off;{}  IF is error{}     THEN regenerate menuscreen;{}          out (""7"");{}          menuinfo  (" " + invers ("FEHLER: " + errormessage));{}          clear error{}     ELSE menu bildschirm{}  FI;{}  enable stop.{}  frage nach diesem programm:{}    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{}              + " Soll mit diesem Programm gearbeitet werden", 5){}
+       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare ::{}    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}    IF exists ("WARENHAUS:Rechnung"){}       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{}    FI;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}
+            LEAVE warenhausprogramm ansehen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    programmname := menuone (verfuegbare, "Programm ansehen/ändern",{}                             "Bitte das gewünschte Programm ankreuzen!",{}                              FALSE);{}    IF programmname = niltext{}       THEN menu bildschirm;{}            LEAVE warenhausprogramm ansehen{}    FI.{}END PROC warenhausprogramm ansehen;{}PROC filialdaten eintragen:{}  lasse filialdaten auswaehlen;{}
+  trage filialdaten ein;{}  menu bildschirm.{}  lasse filialdaten auswaehlen:{}    THESAURUS VAR verfuegbare ::{}    ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);{}    IF NOT not empty (verfuegbare){}       THEN noch keine filialdaten;{}            LEAVE filialdaten eintragen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, bezeichnung,{}    "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).{}  trage filialdaten ein:{}
+    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers (bezeichnung)));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (schlussbemerkung);{}    menuwindowstop.{}  bezeichnung:{}    "Filialdaten eintragen/ergänzen".{}  schlussbemerkung:{}    " Alle ausgewählten Filialdaten wurden eingetragen!".{}  fuehre einzelne operationen aus:{}
+    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              menuwindowout ( " Filialdaten """ + name (verfuegbare, k){}                                    + """ werden eingetragen!");{}              menuwindowline;{}              lade filialdaten (praefix + name (verfuegbare, k));{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}
+       THEN menuwindowline (2);{}            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{}            menuwindowstop;{}            menu bildschirm;{}            LEAVE filialdaten eintragen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen; out (""7"");{}            menuinfo  (" " + invers (errormessage));{}
+            clear error; enable stop;{}            LEAVE filialdaten eintragen{}       ELSE enable stop{}    FI.{}END PROC filialdaten eintragen;{}PROC warenhausprogramme drucken:{}  lasse programme auswaehlen;{}  drucke programme;{}  menu bildschirm.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare ::{}    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}    IF exists ("WARENHAUS:Rechnung"){}       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{}    FI;{}    IF NOT not empty (verfuegbare){}
+       THEN noch kein programm;{}            LEAVE warenhausprogramme drucken{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, "Programme drucken",{}                   "Bitte die Programme ankreuzen, die gedruckt werden sollen!",{}                    FALSE).{}  drucke programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers ("Programme drucken")));{}    menuwindowline (2);{}    command dialogue (FALSE);{}
+    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              menuwindowout ( " """ + name (verfuegbare, k) +{}                              """ wird gedruckt!");{}              menuwindowline;{}
+              print (name (verfuegbare, k));{}              fehlerbehandlung{}      FI{}    PER.{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (" Es wurde kein Programm ausgewählt!");{}            menuwindowstop;{}            menu bildschirm;{}            LEAVE warenhausprogramme drucken{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}
+       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen; out (""7"");{}            menuinfo  (" " + invers (errormessage));{}            clear error; enable stop;{}            LEAVE warenhausprogramme drucken{}       ELSE enable stop{}    FI.{}END PROC warenhausprogramme drucken;{}PROC warenhausprogramm kopieren:{}  ermittle alten programmnamen;{}  erfrage neuen programmnamen;{}  kopiere ggf das programm.{}  ermittle alten programmnamen:{}    IF NOT not empty (bestand){}
+       THEN noch kein programm;{}            LEAVE warenhausprogramm kopieren{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, "Programm kopieren",{}            "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);{}    menu bildschirm;{}    IF alter name = niltext{}       THEN LEAVE warenhausprogramm kopieren{}    FI.{}  bestand:{}    ALL myself - infix namen (ALL myself, praefix, filialdatentyp){}               - "WARENHAUS:Rechnung".{}
+  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + " Name des 'alten' Programms: " + bisheriger name{}                  + " Bitte den Namen für die Kopie: ".{}  ueberschrift:{}    center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  kopiere ggf das programm:{}    IF   neuer name = niltext{}         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{}
+              LEAVE warenhausprogramm kopieren{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE warenhausprogramm kopieren{}       ELSE copy (alter name, neuer name){}    FI.{}  mache vorwurf:{}    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm kopieren;{}PROC filialdaten umbenennen:{}  ermittle alten filialdatennamen;{}  erfrage neuen filialdatennamen;{}  benenne ggf die filialdaten um.{}  ermittle alten filialdatennamen:{}
+    IF NOT not empty (bestand){}       THEN noch keine filialdaten;{}            LEAVE filialdaten umbenennen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);{}    menu bildschirm;{}    IF alter name = niltext{}       THEN LEAVE filialdaten umbenennen{}    FI.{}  bestand:{}    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).{}  text1: "Filialdaten umbenennen".{}  text2:{}    "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .{}
+  erfrage neuen filialdatennamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{}  ueberschrift:{}    center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".{}  hinweis auf alt:{}    " Bisheriger  Filialdaten-Name: ".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}  aufforderung:{}    " Zukünftiger Filialdaten-Name: ".{}  benenne ggf die filialdaten um:{}    IF   neuer name = niltext{}
+         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{}              LEAVE filialdaten umbenennen{}    ELIF exists (praefix + neuer name){}         THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));{}              LEAVE filialdaten umbenennen{}    ELSE rename (praefix + alter name, praefix + neuer name);{}         filialdatenname := neuer name{}    FI.{}END PROC filialdaten umbenennen;{}PROC warenhausprogramm umbenennen:{}  ermittle alten programmnamen;{}
+  erfrage neuen programmnamen;{}  benenne ggf das programm um.{}  ermittle alten programmnamen:{}    IF NOT not empty (bestand){}       THEN noch kein programm;{}            LEAVE warenhausprogramm umbenennen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",{}        "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);{}    menu bildschirm;{}    IF alter name = niltext{}       THEN LEAVE warenhausprogramm umbenennen{}
+    FI.{}  bestand:{}    ALL myself - infix namen (ALL myself, praefix, filialdatentyp){}               - "WARENHAUS:Rechnung".{}  erfrage neuen programmnamen:{}    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{}  ausgabe:{}     ueberschrift + " Bisheriger  Programmname: " + bisheriger name{}                  + " Zukünftiger Programmname: ".{}  ueberschrift:{}    center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".{}  bisheriger name:{}    ""13""13" " + invers (alter name) + ""13""13"".{}
+  benenne ggf das programm um:{}    IF   neuer name = niltext{}         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{}              LEAVE warenhausprogramm umbenennen{}    ELIF exists (neuer name){}         THEN mache vorwurf;{}              LEAVE warenhausprogramm umbenennen{}       ELSE rename (alter name, neuer name);{}            programmname := neuer name{}    FI.{}  mache vorwurf:{}    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm umbenennen;{}
+PROC filialdaten loeschen:{}  lasse filialdaten auswaehlen;{}  loesche filialdaten;{}  menu bildschirm.{}  lasse filialdaten auswaehlen:{}    THESAURUS VAR verfuegbare ::{}    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{}    IF NOT not empty (verfuegbare){}       THEN noch keine filialdaten;{}            LEAVE filialdaten loeschen{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",{}    "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{}
+  loesche filialdaten:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}    menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}
+      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              IF menuwindowyes (" """ + name (verfuegbare, k){}                                      + """ löschen"){}                 THEN forget (praefix + name (verfuegbare, k), quiet){}              FI;{}              fehlerbehandlung{}      FI{}    PER;{}    filialdatenname := "".{}  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{}
+            menuwindowstop;{}            menu bildschirm;{}            LEAVE filialdaten loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            menuinfo  (" " + invers (errormessage));{}            clear error; enable stop;{}            LEAVE filialdaten loeschen{}       ELSE enable stop{}    FI.{}
+END PROC filialdaten loeschen;{}PROC warenhausprogramme loeschen:{}  lasse programme auswaehlen;{}  loesche programme;{}  menu bildschirm.{}  lasse programme auswaehlen:{}    THESAURUS VAR verfuegbare ::{}              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}    IF exists ("WARENHAUS:Rechnung"){}       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{}    FI;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE warenhausprogramme loeschen{}
+       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    verfuegbare := menusome (verfuegbare, "Programm löschen",{}    "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).{}  loesche programme:{}    show menuwindow;{}    steige ggf bei leerem thesaurus aus;{}    menuwindowout (menuwindowcenter (invers ("Programme löschen")));{}    menuwindowline (2);{}    command dialogue (FALSE);{}    fuehre einzelne operationen aus;{}    command dialogue (TRUE);{}    schlage ggf neue seite auf;{}
+    menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");{}    menuwindowstop.{}  fuehre einzelne operationen aus:{}    INT VAR k;{}    FOR k FROM 1 UPTO highest entry (verfuegbare) REP{}      IF name (verfuegbare, k) <> ""{}         THEN disable stop;{}              IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen"){}                 THEN forget (name (verfuegbare, k), quiet){}              FI;{}              fehlerbehandlung{}      FI{}    PER;{}    programmname := "".{}
+  steige ggf bei leerem thesaurus aus:{}    IF NOT not empty (verfuegbare){}       THEN menuwindowline (2);{}            menuwindowout (" Es wurde kein Programm ausgewählt!");{}            menuwindowstop;{}            menu bildschirm;{}            LEAVE warenhausprogramme loeschen{}    FI.{}  schlage ggf neue seite auf:{}    IF remaining menuwindowlines < 7{}       THEN menuwindowpage; menuwindowline{}       ELSE menuwindowline (2){}    FI.{}  fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen; out (""7"");{}
+            menuinfo  (" " + invers (errormessage));{}            clear error; enable stop;{}            LEAVE warenhausprogramme loeschen{}       ELSE enable stop{}    FI.{}END PROC warenhausprogramme loeschen;{}PROC warenhausprogramm starten:{}  IF grin version{}     THEN warenhausprogramm uebersetzen und starten{}     ELSE warenhausprogramm direkt starten{}  FI{}END PROC warenhausprogramm starten;{}PROC warenhausprogramm direkt starten:{}  programmname ermitteln;{}  bildschirm neu eingesetzt := FALSE;{}
+  untersuche programmdatei auf bildschirm neu;{}  cursor w3 1 1;{}  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");{}  cursor on;{}  check on;{}  warnings off;{}  disable stop;{}  run (programmname);{}  noch kein programm gelaufen := FALSE;{}  IF bildschirm neu eingesetzt{}     THEN entferne befehl aus programmdatei{}  FI;{}  cursor off;{}  fehlerbehandlung;{}  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{}  cursor (2,24);{}  out ("Das Programm ist beendet. " +{}
+       "Zum Weitermachen bitte irgendeine Taste tippen!");{}  pause;{}  regenerate menuscreen.{}  fehlerbehandlung:{}    IF is error{}       THEN fehler ggf melden{}       ELSE enable stop{}    FI.{}  fehler ggf melden:{}    IF errormessage = ""{}       THEN regenerate menuscreen{}       ELSE fehler melden{}    FI;{}    clear error; enable stop;{}    LEAVE warenhausprogramm direkt starten.{}  fehler melden:{}    out (""7"");{}    IF errorcode = 1  OR  errorcode = 1951{}       THEN regenerate menuscreen;{}
+            menuinfo  (" " + invers (errormessage)){}       ELSE programm mit fehler zeigen;{}            regenerate menuscreen{}    FI.{}  programmname ermitteln:{}    IF programmname <> niltext CAND exists (programmname){}       THEN frage nach diesem programm{}       ELSE lasse programm auswaehlen{}    FI.{}  frage nach diesem programm:{}    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{}               name + " Soll mit diesem Programm gearbeitet werden", 5){}       THEN lasse programm auswaehlen{}
+    FI.{}  ueberschrift:{}    center (maxlaenge, invers ("Programm starten")) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare ::{}              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}    IF exists ("WARENHAUS:Rechnung"){}       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{}    FI;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE warenhausprogramm direkt starten{}
+       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    programmname := menuone (verfuegbare, "Programm starten",{}                    "Bitte das gewünschte Programm ankreuzen!", FALSE);{}    menubildschirm;{}    menufootnote ("");{}    IF programmname = niltext{}       THEN LEAVE warenhaus programm direkt starten{}    FI.{}  untersuche programmdatei auf bildschirm neu:{}    FILE VAR a :: sequential file (modify, programmname);{}    TEXT VAR zeile;{}    to line (a, 1);{}    REP{}      read record (a, zeile);{}
+      IF NOT eof (a) THEN down (a) FI{}    UNTIL zeile <> "" OR eof (a) PER;{}    change all (zeile, " ", "");{}    IF pos (zeile, "bildschirmneu") = 0{}       THEN setze befehl in datei ein{}    FI.{}  setze befehl in datei ein:{}    to line (a, 1);{}    zeile := "bildschirm neu; (* ergänzt *)";{}    insert record (a);{}    write record (a, zeile);{}    bildschirm neu eingesetzt := TRUE.{}  entferne befehl aus programmdatei:{}    FILE VAR b :: sequential file (modify, programmname);{}    to line (b, 1);{}
+    REP{}      read record (b, zeile);{}      IF NOT eof (b) THEN down (b) FI{}    UNTIL zeile <> "" OR eof (b) PER;{}    change all (zeile, " ", "");{}    IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0{}       THEN up (b); delete record (b){}    FI.{}END PROC warenhausprogramm direkt starten;{}PROC warenhausprogramm uebersetzen und starten:{}  programmname ermitteln;{}  cursor w3 1 1;{}  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");{}  cursor on;{}  disable stop;{}  uebersetze (programmname);{}
+  IF NOT is error{}     THEN check on;{}          warnings off;{}          run ("elanprogramm");{}          noch kein programm gelaufen := FALSE{}  FI;{}  forget ("elanprogramm", quiet);{}  cursor off;{}  fehlerbehandlung;{}  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{}  cursor (2,24);{}  out ("Das Programm ist beendet. " +{}       "Zum Weitermachen bitte irgendeine Taste tippen!");{}  pause;{}  regenerate menuscreen.{}  fehlerbehandlung:{}    IF is error{}       THEN fehler ggf melden{}
+       ELSE enable stop{}    FI.{}  fehler ggf melden:{}    IF errormessage = ""{}       THEN regenerate menuscreen{}       ELSE fehler melden{}    FI;{}    clear error; enable stop;{}    LEAVE warenhausprogramm uebersetzen und starten.{}  fehler melden:{}    out (""7"");{}    IF errorcode = 1  OR  errorcode = 1951{}       THEN regenerate menuscreen;{}            menuinfo  (" " + invers (errormessage)){}       ELSE programm mit fehler zeigen ;{}            regenerate menuscreen{}    FI.{} programmname ermitteln:{}
+    IF programmname <> niltext CAND exists (programmname){}       THEN frage nach diesem programm{}       ELSE lasse programm auswaehlen{}    FI.{}  frage nach diesem programm:{}    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{}               name + " Soll mit diesem Programm gearbeitet werden", 5){}       THEN lasse programm auswaehlen{}    FI.{}  ueberschrift:{}    center (maxlaenge, invers ("Programm starten")) + ""13""13"".{}  name:{}    ""13""13" " + invers (programmname) + ""13""13"".{}
+  lasse programm auswaehlen:{}    THESAURUS VAR verfuegbare ::{}              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{}    IF exists ("WARENHAUS:Rechnung"){}       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{}    FI;{}    IF NOT not empty (verfuegbare){}       THEN noch kein programm;{}            LEAVE warenhausprogramm uebersetzen und starten{}       ELSE biete auswahl an{}    FI.{}  biete auswahl an:{}    programmname := menuone (verfuegbare, "Programm starten",{}
+                    "Bitte das gewünschte Programm ankreuzen!", FALSE);{}    menubildschirm;{}    menufootnote ("");{}    IF programmname = niltext{}       THEN LEAVE warenhaus programm uebersetzen und starten{}    FI.{}END PROC warenhausprogramm uebersetzen und starten;{}PROC programm mit fehler zeigen:{}  IF exists (programmname){}    THEN noteline;{}         note (fehlermeldung mit zeilennummer);{}         INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;{}         note (invers ("Verlassen: <ESC><q>"));{}
+         FILE VAR f :: sequential file (modify, programmname);{}         to line (f, max (1, fehlerzeile));{}         col (1);{}         clear error;{}         cursor on;{}         noteedit (f);{}        cursor off{}    ELSE menuinfo (invers (fehlermeldung mit zeilennummer)){}  FI{}END PROC programm mit fehler zeigen;{}PROC warenhausprogramm wiederholen:{}  cursor on;{}  disable stop;{}  IF noch kein programm gelaufen{}     THEN errorstop ("'run again' nicht moeglich"){}     ELSE runagain{}  FI;{}
+  cursor off;{}  fehlerbehandlung;{}  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{}  cursor (2,24);{}  out ("Das Programm ist beendet. " +{}       "Zum Weitermachen bitte irgendeine Taste tippen!");{}  pause;{}  regenerate menuscreen.{}fehlerbehandlung:{}    IF is error{}       THEN regenerate menuscreen;{}            fehler melden;{}            clear error; enable stop;{}            LEAVE warenhausprogramm wiederholen{}       ELSE enable stop{}    FI.{}  fehler melden:{}
+    out (""7"");{}    IF errorcode = 1  OR  errorcode = 1951{}       THEN menuinfo  (" " + invers (errormessage)){}    ELIF errormessage = "'run again' nicht moeglich"{}       THEN menuinfo  (" " + invers ("Wiederholung nicht möglich!")){}       ELSE menuinfo  (" " + invers (fehlermeldung mit zeilennummer)){}    FI{}END PROC warenhausprogramm wiederholen;{}TEXT PROC fehlermeldung mit zeilennummer:{}  TEXT VAR meldung :: "FEHLER: " + errormessage;{}  fuege ggf fehlerzeile an;{}  IF length (meldung) < 70{}
+     THEN meldung{}     ELSE subtext (meldung, 1, 69){}  FI.{}  fuege ggf fehlerzeile an:{}    fehlerzeile := errorline;{}    IF errorline < 1{}       THEN LEAVE fuege ggf fehlerzeile an{}    ELIF bildschirm neu eingesetzt{}       THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"{}       ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"{}    FI.{}END PROC fehlermeldung mit zeilennummer;{}PROC meckere zu langen namen an:{}  menuinfo (" " + invers ("Hier dürfen Namen höchstens "{}
+                + text (max namenslaenge){}                + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierenden filialdatennamen an:{}  menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")){}END PROC meckere existierenden filialdatennamen an;{}PROC meckere existierendes programm an:{}  menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch keine filialdaten:{}  menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")){}
+END PROC noch keine filialdaten;{}PROC noch kein programm:{}  menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{}  cursor (1, 2);{}  out (5 * waagerecht);{}  cursor (1, 3);{}  out (""4"");{}  cursor (1, 23);{}  out (79 * waagerecht);{}  refresh submenu{}END PROC menu bildschirm{}END PACKET ls warenhaus 5{}
+
diff --git a/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen b/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen
new file mode 100644
index 0000000..f4bd77f
--- /dev/null
+++ b/app/gs.warenhaus/1.01/src/ls-Warenhaus-gen
@@ -0,0 +1,29 @@
+(* 
+        
+         ********************************************************** 
+         ********************************************************** 
+         **                                                      ** 
+         **                   ls-Warenhaus/gen                   ** 
+         **                                                      ** 
+         **                     Version 1.01                     ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                  (Stand:  30.08.89)                  ** 
+         **                                                      ** 
+         **                                                      ** 
+         **                                                      ** 
+         **           Autor: Bruno Pollok, Bielefeld             ** 
+         **                                                      ** 
+         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
+         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
+         **                                                      ** 
+         ********************************************************** 
+         ********************************************************** 
+ 
+                                                                           *) 
+LET kartenleserkennung = "ls-Warenhaus 0: mit Kartenleser";
+baue bildschirm auf;{}schicke menukarte ab;{}erfrage anpassung;{}check off;{}warnings off;{}insertiere (anpassung);{}loesche alle anpassungen;{}insertiere ("ls-Warenhaus 1");{}insertiere ("ls-Warenhaus 2");{}insertiere ("ls-Warenhaus 3");{}insertiere ("ls-Warenhaus 4");{}insertiere ("ls-Warenhaus 5");{}check on;{}frage nach grin;{}frage nach hauptstelle.{}baue bildschirm auf:{}  page;{}  cursor (18, 1);{}  out (invers ("ls-Warenhaus :  Automatische Generierung"));{}  line (3).{}erfrage anpassung:{}
+  WINDOW VAR w :: window (1, 1, 79, 24);{}  TEXT VAR anpassung :: boxone (w, alle kartenleser,{}           "Auswahl einer Interface - Anpassung für den Codekartenleser",{}           "Wenn kein Kartenleser benutzt wird, <ESC><q> tippen!", FALSE);{}  IF anpassung = ""{}     THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser"{}  FI;{}  baue bildschirm auf.{}alle kartenleser:{}  infix namen (ALL myself, kartenleserkennung).{}loesche alle anpassungen:{}  command dialogue (FALSE);{}  forget (infixnamen (ALL myself, "ls-Warenhaus 0"));{}
+  forget ("--------------------------------------------------------",quiet);{}  command dialogue (TRUE).{}schicke menukarte ab:{}  command dialogue (FALSE);{}  save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN");{}  command dialogue (TRUE);{}  forget ("ls-MENUKARTE:Warenhaus", quiet);{}  forget ("ls-Warenhaus/gen", quiet).{}frage nach grin:{}  line;{}  IF yes ("Version für GRIN"){}     THEN do ("grin (TRUE)"){}     ELSE do ("grin (FALSE)"){}  FI.{}frage nach hauptstelle:{}  line (2);{}  IF yes ("Soll diese Task Warenhaus - Hauptstelle sein"){}
+     THEN do ("warenhaus hauptstelle (TRUE)"){}     ELSE global manager{}  FI.{};{}PROC insertiere (TEXT CONST dateiname):{}  INT VAR s, z;{}  out ("'" + dateiname + "'");{}  get cursor (s, z);{}  out (" wird insertiert.  ");{}  insert (dateiname);{}  forget (dateiname, quiet);{}  cursor (s, z);{}  out (""4"") ;{}  line{}END PROC insertiere{}
+
diff --git a/app/misc-games/unknown/src/LINDWURM.ELA b/app/misc-games/unknown/src/LINDWURM.ELA
new file mode 100644
index 0000000..daf38cc
--- /dev/null
+++ b/app/misc-games/unknown/src/LINDWURM.ELA
@@ -0,0 +1,337 @@
+PACKET lind wurm DEFINES lindwurm:

+deklaration; 

+LET max = 500,zeilen = 23,spalten = 77;

+ 

+PROC kriech :

+  speicher := stelle;

+  REP

+   putline(""1"Punkte:"+text(punkte + bonus) + ""6""0""30"Zeit:" + zeit);

+   IF punkte <> 0 

+      THEN ende INCR 1;

+           IF ende > max THEN ende := 1 FI;

+           laenge := laenge + 1 - zaehler;

+           IF laenge > max THEN laenge := 1 FI;

+           wurm(ende) := speicher;

+           IF zaehler = 0 AND wurm(laenge) >= basis AND wurm(laenge) < (basis+(spalten*zeilen)) 

+              THEN poke(wurm(laenge),leerzeichen) 

+           FI;

+           IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN 

+              poke(speicher,char1)

+           FI

+      ELSE IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) 

+              THEN poke (speicher,leerzeichen)

+           FI;

+   FI;

+   zaehler := 0;

+   speicher INCR richtung;

+   IF peek(speicher) <> leerzeichen THEN nahrung oder gift FI; 

+   IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN poke(speicher,char2) FI;

+   tastaturabfrage;

+   IF punkte > begrenzung THEN x := int(zeit); index := 1 FI;

+   IF zeit > stopzeit THEN index := 2 FI;

+  UNTIL index <> 0 PER

+ENDPROC kriech;

+

+PROC nahrung oder gift :

+     IF peek(speicher) <> char 3 THEN index := 3 

+       ELSE punkte INCR 10; zaehler := 1

+     FI;

+ENDPROC nahrung oder gift;

+

+PROC tastaturabfrage :

+    taste := incharety(9 DIV geschwindigkeit);

+    feuer := taste = ""13"";

+    IF feuer THEN richtung := 0

+    ELIF taste = ""10"" THEN richtung INCR spalten

+    ELIF taste = ""8""  THEN richtung DECR 1 

+    ELIF taste = ""2""  THEN richtung INCR 1

+    ELIF taste = ""3""  THEN richtung DECR spalten

+    FI

+ENDPROC tastatur abfrage;

+

+PROC bonus erreicht :

+     x := (int(stopzeit)-x) * schwierigkeit;

+     cspalte := 10;

+     czeile  := 10;

+     cursorpositionieren;

+     putline("B O N U S ! ! !");

+     line;

+     putline(""15"          "+text(x)+" Punkte !!!"14"");

+     bonus := bonus + punkte + x;

+ENDPROC bonus erreicht;

+

+PROC poke (INT CONST stelle,wert) :

+     INT VAR x pos := 1 + ((stelle - basis) MOD spalten),

+             y pos := 1 + ((stelle - basis) DIV spalten); 

+     cursor(x pos,y pos);

+     IF wert = 126 THEN out(""15""8""14"") ELSE

+        out(code(wert));

+     FI;

+     bildschirm (x pos)(y pos) := wert;

+ENDPROC poke;

+

+INT PROC peek (INT CONST stelle) :

+    INT VAR x pos := 1 + ((stelle - basis) MOD spalten),

+            y pos := 1 + ((stelle - basis) DIV spalten);

+    bildschirm (x pos)(y pos)

+ENDPROC peek;

+

+PROC cursorpositionieren :

+     bildschirm zeile := basis + spalten*czeile;

+     cursor(cspalte+1,czeile+1);

+ENDPROC cursor positionieren;

+

+PROC highscore und platznummer :

+     punkte := punkte + bonus;

+     bonus := 0;

+     IF punkte > highscore THEN highscore := punkte FI;

+     player counter INCR 1;

+     q := player counter + 1;

+     spieler punkte(playercounter) := punkte;

+     FOR i FROM 1 UPTO playercounter REP

+         IF punkte > spielerpunkte (i) THEN q DECR 1 FI;

+     PER;

+     c spalte :=10;

+     czeile := 10;

+     cursorpositionieren;

+     putline("Hoechstpunktzahl "+text(highscore));line;

+     putline("           Punkte :"+text(punkte));

+     putline("           Platznr.:"+text(q-1));

+     IF q-1 >= 10 THEN inchar(hilf)

+        ELSE put("Name des Gewinners:");

+        getline(hilf);

+        disablestop;

+        FOR i FROM playercounter DOWNTO q REP

+            spielername(i+1) := spielername(i);

+            IF iserror THEN clearerror; spielername(i+1) := "" FI;

+        PER;

+        enablestop;

+        spielername(q-1) := "(" +text(punkte) + " Punkte: " + hilf+")";

+     FI;

+     page;

+     putline("Die ersten 10 Gewinner :");

+     disablestop;

+     FOR i FROM 1 UPTO min(playercounter,10) REP

+         putline(text(i)+"."+spielername(i));

+         IF iserror THEN clearerror;spielername(i) := "" FI

+     PER;

+     enablestop;

+     putline("Druecken Sie eine Taste");

+     inchar(hilf);

+ENDPROC highscore und platznummer;

+

+PROC explosion :

+   out(""7"");

+   FOR i FROM ende DOWNTO laenge +1REP

+       IF wurm (i) >= basis AND wurm(i) < (basis+spalten*zeilen) THEN poke(wurm(i),leerzeichen);

+       FI;

+   PER;

+   highscore und platznummer

+ENDPROC explosion;

+

+PROC lindwurm :

+   bonus := 0;

+

+   REP

+    clearscreen;

+    out(""14""1""4"");

+    IF bonus = 0 THEN neues spiel FI;

+    IF bonus > 0 THEN bonusspiel FI;

+    page;

+    rahmen;

+    lebensraum generieren;

+    lindwurm kopf setzen;

+    reset time;

+    kriech;

+    SELECT index OF 

+       CASE 1 : bonus erreicht

+       CASE 2 : highscore und platznummer

+       CASE 3 : explosion

+    ENDSELECT

+  UNTIL bonus<= 0 COR no(""1""4""10""10"Noch ein Spiel") PER

+

+ENDPROC lindwurm;

+

+PROC neues spiel :

+     basis := 0;

+     stelle := basis + spalten*zeilen DIV 2;

+     schwierigkeit := 4;

+     geschwindigkeit :=9;

+     char 1:= 126;

+     char 2:= 79;

+     char 3:= 42;

+     char 4:= 124;

+     leerzeichen := 32;

+     index := 0;

+     ende := 0;

+     laenge := 0;

+     richtung := 0;

+     zaehler := 0;

+     bonus := 0;

+     punkte := 0;

+     stopzeit :="3:00";

+     vorwahl;

+     begrenzung := 120 * schwierigkeit;

+ENDPROC neues spiel;

+

+PROC liste aller spieler :

+     page;

+     FOR i FROM 1 UPTO playercounter REP

+        putline(text(i)+"."+spielername(i));

+        IF i > 24 THEN pause(20) FI;

+     PER;

+     putline("ENDE");

+     inchar(hilf);

+     page;

+ENDPROC liste aller spieler;

+

+

+PROC vorwahl :

+     spielregeln;

+     page;

+     REP

+       out(""1"");

+       putline(""142"                                    Lindwurm                               "143"");

+       czeile :=12;

+       cspalte:=3;

+       cursorpositionieren;

+       putline("Schwierigkeitsgrad (1/2) "+ text(schwierigkeit,3));

+       czeile :=14;

+       cspalte:=3;

+       cursorpositionieren;

+       putline("Geschwindigkeit    (3/4) "+ text(geschwindigkeit,3));

+       czeile :=16;

+       cspalte:=3;

+       cursorpositionieren;

+       putline("Liste aller Spieler (5)  ");

+       czeile :=18;

+       cspalte:=3;

+       cursorpositionieren;

+       putline("Start mit RETURN");

+       x := 0;

+       inchar(hilf);

+       IF hilf = ""13""THEN LEAVE vorwahl

+       ELIF hilf = "1" THEN schwierigkeit INCR 1

+       ELIF hilf = "2" THEN schwierigkeit DECR 1

+       ELIF hilf = "3" THEN geschwindigkeit INCR 1

+       ELIF hilf = "4" THEN geschwindigkeit DECR 1

+       ELIF hilf = "5" THEN liste aller spieler 

+       ELSE out(""7"") 

+       FI;

+       IF schwierigkeit > 26 THEN schwierigkeit := 1 

+       ELIF schwierigkeit < 1 THEN schwierigkeit := 26 FI; 

+       IF geschwindigkeit > 9 THEN geschwindigkeit := 1 

+       ELIF geschwindigkeit < 1 THEN geschwindigkeit := 9 FI; 

+     PER

+

+ENDPROC vorwahl;

+

+PROC spielregeln :

+     putline(code(char1)+" = Rahmen (Mauer)");

+     line;

+     putline(code(char2)+" = Lindwurmkopf");

+     line;

+     putline(code(char3)+" = Nahrung");

+     line;

+     putline(""15""8""14" = Lindwurm"); 

+     line;

+     putline(". = Gift");

+     line;

+     putline ("Ziel des Spiels ist es, den Wurm mit Nahrung zu versorgen. Gift ist tödlich.");

+     line;

+     putline ("Der Wurm kann mit den Pfeiltasten gesteuert werden. Wird eine Taste mehrmals");

+     line;

+     putline ("gedrückt, wird der Wurm schneller. Vorsicht: Der Wurm darf nicht auf eine");

+     line;

+     putline ("Mauer treffen. Mit jedem gefressenen Nahrungsteilchen wird der Wurm etwas");

+     line;

+     putline ("länger. Du hast 3 Minuten Zeit, den Wurm zu füttern.");

+     line;

+     putline ("Viel Erfolg. Bitte drücke jetzt eine Taste.");

+     pause(6000);

+ENDPROC spielregeln;

+

+PROC bonusspiel :

+    stelle := basis+zeilen*spaltenDIV2;

+    index := 0;

+    punkte := 0;

+    richtung := 0;

+    zaehler := 0;

+    ende := 0;

+    laenge := 0;

+    schwierigkeit INCR 1;

+    IF schwierigkeit > 26 THEN schwierigkeit := 26 FI;

+    begrenzung := 120 * schwierigkeit 

+

+ENDPROC bonusspiel;

+

+PROC lebensraum generieren :

+    FOR i FROM 1 UPTO 16 * schwierigkeit REP

+        REP

+           x := int(random * real((zeilen-2)*spalten) + real(spalten));

+        UNTIL peek(basis+x) = leerzeichen PER;

+        poke(basis+x,char3)

+    PER;

+    FOR i FROM 1 UPTO schwierigkeit REP

+        REP

+           x := int(random * real((zeilen-2)*spalten) + real(spalten));

+        UNTIL peek(basis+x) = leerzeichen PER;

+        poke(basis+x,46)

+    PER;

+ENDPROC lebensraum generieren;

+

+PROC lindwurmkopf setzen :

+    WHILE peek(stelle) <> leerzeichen REP stelle INCR 1 PER;

+    poke(stelle,char2);

+    out(""7"");

+

+ENDPROC lindwurmkopf setzen;

+

+PROC rahmen :

+   FOR i FROM basis UPTO basis + spalten-1 REP

+       poke(i,char4);

+       poke(i+(zeilen-1)*spalten,char4);

+   PER;

+   i := basis + spalten;

+   REP poke(i ,char4); 

+       poke(i+spalten-1,char4);

+       i INCR spalten

+   UNTIL i >( basis + (zeilen-1)*spalten )PER

+

+ENDPROC rahmen;

+

+PROC clearscreen :

+   INT VAR x,y;

+       putline ("Nun markiert der Wurm sein Revier.");

+       line ;

+       put("Es ist");put(spalten);put("qm gross.");line;

+       FOR x FROM 1 UPTO spalten REP

+           cout(x);

+           FOR y FROM 1 UPTO zeilen REP

+               bildschirm(x)(y) := leerzeichen

+           PER

+       PER

+ENDPROC clearscreen;

+

+TEXT PROC zeit :

+     subtext(time(clock(1)-uhr),5,8)

+ENDPROC zeit;

+

+PROC reset time :

+     uhr := clock(1)

+ENDPROC reset time;.

+

+deklaration :

+   ROW spalten ROW zeilen INT VAR bildschirm;

+   ROW 300 INT VAR spielerpunkte;

+   ROW 300 TEXT VAR spielername;

+   ROW max INT VAR wurm;

+   TEXT VAR hilf,taste,stopzeit;

+   INT VAR basis:=0,playercounter:=0,highscore:=0,q:=0,i:=0,x:=0,y:=0,stelle:=1000,richtung,

+           punkte:=0,bonus:=0,index:=0,cspalte,czeile,bildschirmzeile,zaehler:=0,ende:=0,

+           laenge:=0,speicher:=1,leerzeichen:=32,begrenzung:=480,schwierigkeit:=4,

+           geschwindigkeit:=9,c:=90,char1:=90,char2:=90,char3:=90,char4:=90;

+

+   REAL VAR uhr;

+   BOOL VAR feuer;

+ENDPACKET lindwurm

diff --git a/app/misc-games/unknown/src/SCHIFFEV.ELA b/app/misc-games/unknown/src/SCHIFFEV.ELA
new file mode 100644
index 0000000..2979a2c
--- /dev/null
+++ b/app/misc-games/unknown/src/SCHIFFEV.ELA
@@ -0,0 +1,424 @@
+                                                (* M.Staubermann,15.03.83 *)

+ 

+PACKET schiffe versenken DEFINES schiffe versenken :

+ 

+

+(* D E K L A R A T I O N S T E I L *)

+

+

+TEXT VAR eingabe, mitteilung := "";

+INT VAR x pos, y pos, reply;

+BOOL VAR spieler 1, dran;

+ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0);

+DATASPACE VAR ds;

+forget(ds);

+ds := nilspace;

+BOUND TEXT VAR msg := ds;

+CONCR(msg) := "";

+TASK VAR gegner,source;

+forget(ds);

+ds:=nilspace;

+BOUND STRUCT (INT x , y) VAR schuss := ds;

+forget(ds);

+CONCR(schuss).x:= 1;

+CONCR(schuss).y := 1;

+ROW 11 ROW 17 TEXT VAR spielfeld;

+LET mark begin = ""15"",

+    mark end   = ""14"",

+    return     = ""13"",

+    down       = ""10"",

+    back       = ""8"",

+    bell       = ""7"",

+    up         = ""3"",

+    vor        = ""2"",

+    blank      = " ",

+    nil        = "", 

+    schiffstypen= "5:F4:K3:S2:V1:P";

+

+(* Ende des Deklarationsteils *)

+

+

+

+PROC schiffe versenken :

+     command dialogue(TRUE);

+     REP

+        IF no("Sind die Spielregeln bekannt") THEN page;

+           gib die spielregeln aus;

+           pause(200);

+        FI;

+        page;

+        line(6);

+        putline("  ABCDEFGH");

+        putline(" +--------+");

+        putline("1|        |");

+        putline("2|        |");

+        putline("3|        |");

+        putline("4|        |");

+        putline("5|        |");

+        putline("6|        |");

+        putline("7|        |");

+        putline("8|        |");

+        putline(" +--------+");

+        putline("  Spielfeld");

+        cursor(20,1);

+        putline("S c h i f f e   v e r s e n k e n : ");

+        spiel ausfuehren;page

+     UNTIL no("Noch ein Spiel") PER

+END PROC schiffe versenken;

+

+

+

+PROC gib die spielregeln aus:

+   cursor(15,2);

+   putline("DIE SPIELREGELN :");

+   cursor(15,3);

+   putline("Es gibt fuenf Schiffstypen mit verschieden Laengen, die beim");

+   cursor(15,4);

+   putline("""Gegner"" versenkt werden muessen.Er versenkt sie hier.Dazu");

+   cursor(15,5);

+   putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel -");

+   cursor(15,6);

+   putline("feld und gibt zuerst die Position der Schiffe(waagerecht und ");

+   cursor(15,7);

+   putline("senkrecht) ein und waehrend des Spiels die Position, an der ");

+   cursor(15,8);

+   putline("ein gegnerisches Schiff vermutet wird. Ein Signal ertoent, ");

+   cursor(15,9);

+   putline("wenn man getroffen hat.Von jedem Schiffstyp ist nur ein Schiff");

+   cursor(15,10);

+   putline("erlaubt.Beenden des Spiels mit 'E'. Schiessen mit <RETURN>.");

+   cursor(3,9);

+END PROC gib die spielregeln aus;

+

+

+

+

+PROC botschaft (TEXT CONST message , TEXT CONST darstellen):

+     forget(ds);

+     ds := nilspace;

+     msg := ds;

+     CONCR(msg) := message;

+     REP send(gegner,0,ds,reply) UNTIL reply = 0 PER;

+     IF NOT (darstellen = "") THEN cursor(1,21);

+                                 putline(darstellen);

+                                 pause(100);

+                                 cursor(1,21);

+                                 leerzeile;

+                                 cursor(3,9) 

+     FI

+END PROC botschaft;

+

+

+

+PROC empfang (TEXT VAR message , BOOL CONST darstellen) :

+     forget(ds);

+     ds := nilspace;

+     REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner)

+     PER;

+     msg := ds;

+     message := CONCR(msg);

+     forget(ds);

+     IF darstellen THEN cursor(1,21);

+                        putline(message);

+                        pause(100);

+                        cursor(1,21);

+                        leerzeile;

+                        cursor(3,9) 

+     FI

+END PROC empfang;

+

+

+

+PROC darstellen (TEXT CONST message) :

+     cursor(1,21);

+     putline(message);

+     pause(100);

+     cursor(1,21);

+     leerzeile;

+     cursor(3,9);

+END PROC darstellen;

+

+

+

+PROC spiel ausfuehren :

+     forget(ds); 

+     ds := nilspace;

+     msg := ds; 

+     forget(ds); 

+     ds := nilspace; 

+     schuss := ds; 

+     forget(ds); 

+     cursor(1,20);

+     putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank +

+             mark end);

+     cursor(1,21);

+     put("Task - Name des Mitspielers : ");

+     getline(eingabe);

+     IF exists(task(eingabe)) AND NOT (task (eingabe) 

+        = myself) AND NOT (channel(task(eingabe)) < 0)

+     THEN gegner := task(eingabe);

+          putline("Er sitzt an Terminal " + text (channel(gegner)));

+          pause(100);

+          cursor(1,22);

+          leerzeile;

+          cursor(1,21);

+          leerzeile;

+     ELSE putline("Unerlaubter Task - Name !");

+          pause(100); 

+          LEAVE spiel ausfuehren

+     FI;

+     darstellen("Mit dem Partner vereinbaren , wer beginnt.");

+     cursor(1,21);

+     spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt");

+     cursor(1,21);

+     pause(10);

+     leerzeile;

+     IF spieler 1 THEN botschaft (name(myself) + " faengt an !","");

+                  ELSE empfang(mitteilung, TRUE)

+     FI; 

+     dran := spieler 1;

+     cursor(15,14);

+     putline("Schiffstypen sind :");

+     cursor(15,15);

+     putline("Flugzeugtraeger : FFFFF");

+     cursor(15,16);

+     putline("Kreuzer         : KKKK");

+     cursor(15,17);

+     putline("Schnellboote    : SSS");

+     cursor(15,18);

+     putline("Versorger       : VV");

+     cursor(15,19);

+     putline("Paddelboote     : P");

+     cursor(3,9);

+     eingabe der schiffe;

+     spiele eine runde;

+END PROC spiel ausfuehren;

+

+

+

+PROC eingabe der schiffe :

+     count := ROW 5 INT : (0,0,0,0,0);

+     FOR y pos FROM 8 UPTO 17 REP

+         FOR x pos FROM 2 UPTO 11 REP

+             spielfeld[ x pos] [y pos] := ""

+         PER

+     PER;

+     darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); 

+     darstellen("Spielfeldes und druecken Sie (mit <SHIFT>) die Buchstaben , so dass alle");

+     darstellen("Schiffe auf dem Spielfeld sind.");

+     REP

+        inchar(eingabe);

+        getcursor(x pos , y pos);

+        IF NOT randbegrenzung ueberschritten THEN

+           IF eingabe = "E" THEN IF spieler 1 THEN

+                        botschaft(name(myself) + "hoert auf","Spiel beendet"); 

+                            ELSE darstellen("Spiel beendet.") 

+                              FI;

+           LEAVE eingabe der schiffe

+           ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") 

+           ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") 

+           ELIF eingabe = "S" THEN wenn moeglich vergroessere("S")

+           ELIF eingabe = "V" THEN wenn moeglich vergroessere("V")

+           ELIF eingabe = "P" THEN wenn moeglich vergroessere("P")

+           ELIF eingabe = " " THEN loesche position

+           ELIF eingabe = "?" THEN gib die spielregeln aus

+           ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = down)

+                                 OR (eingabe = up)  THEN out(eingabe)

+           ELSE out(bell)

+           FI

+        ELSE out(bell)

+        FI

+     UNTIL alle schiffe eingegeben PER.

+

+

+     loesche position :

+       out(" ");out(""8"");

+       IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen

+              SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1

+       FI;

+       spielfeld [x pos] [y pos] := "".

+

+

+

+

+     alle schiffe eingegeben :

+       (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND

+       (count [2] = 2) CAND (count [1] = 1).

+

+

+END PROC eingabe der schiffe;

+

+

+

+ BOOL PROC randbegrenzung ueberschritten :

+     ((eingabe = back) CAND (x pos <= 3)) COR ((eingabe = vor) CAND (x pos >=

+      10)) COR ((eingabe = down) CAND (y pos >= 16)) COR ((eingabe = up) CAND

+      (y pos <= 9))

+

+END PROC randbegrenzung ueberschritten;

+

+

+

+PROC wenn moeglich vergroessere (TEXT CONST schiff) :

+     IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND

+        (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR

+        ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND

+        (count [1] = 0))

+     THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar

+          OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0)

+          AND noch kein schiff da

+          THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]

+               INCR 1;

+               out(schiff + ""8"");

+               spielfeld [x pos] [y pos] :=schiff

+          FI

+     FI.

+

+ 

+

+     waagerechter oder senkrechter nachbar :

+     ((spielfeld [sub x(x pos - 1)] [y pos] = schiff)  OR

+      (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR

+     ((spielfeld [x pos] [sub y(y pos - 1)] = schiff)  OR

+      (spielfeld [x pos] [sub y(y pos + 1)] = schiff)).

+

+

+

+     diagonaler nachbar :

+     (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR

+     (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR

+     (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR

+     (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) .

+

+

+

+     noch kein schiff da :

+     IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI.

+

+END PROC wenn moeglich vergroessere;

+

+ 

+

+INT PROC sub x(INT CONST subscription):

+    IF subscription > 11 THEN 11

+    ELIF subscription < 2 THEN 2

+    ELSE subscription

+    FI

+

+END PROC sub x;

+ 

+ 

+ 

+INT PROC sub y(INT CONST subscription):

+    IF subscription > 17 THEN 17

+    ELIF subscription < 8 THEN 8

+    ELSE subscription

+    FI

+

+END PROC sub y;

+ 

+

+

+PROC spiele eine runde :

+     IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben."

+                       , "Eingabe der Schiffe beendet.")

+                  ELSE empfang(mitteilung , TRUE) 

+     FI;

+     REP

+        IF dran THEN darstellen("Jetzt schiessen !");

+                     abschiessen

+                ELSE rufe gegner

+        FI;

+        dran := NOT dran;

+     UNTIL kein schiff mehr da PER;

+     gegner hat verloren .

+

+

+

+     kein schiff mehr da :

+        (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND

+        (count [2] = 0) CAND (count [1] = 0).

+

+

+

+     abschiessen :

+       REP 

+           inchar(eingabe);

+           getcursor(x pos, y pos);

+           IF NOT randbegrenzung ueberschritten THEN

+              IF eingabe = "E" THEN IF spieler 1 THEN 

+                          botschaft(name(myself)+" hoert auf.","Spiel beendet.");

+                          ELSE darstellen ("Spiel beendet.") FI;

+                                    LEAVE spiele eine runde

+              ELIF eingabe =  return THEN schuss gegner;

+                                          forget(ds);

+                                          ds := nilspace;

+                                          CONCR(schuss).x := x pos;

+                                          CONCR(schuss).y := y pos;

+                                          schuss := ds;

+                                          REP send (gegner,0,ds,reply)

+                                          UNTIL reply = 0 PER;

+                                          empfang(mitteilung,TRUE);

+              ELIF eingabe = "?"     THEN gib die spielregeln aus

+              ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = up)

+                   OR (eingabe = down) THEN out(eingabe)

+              ELSE out(bell)

+              FI

+           ELSE out(bell)

+           FI

+         UNTIL eingabe = return PER.

+

+

+

+         elem :

+         spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)].

+

+

+

+         gegner hat verloren :

+         botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). 

+

+

+         schuss gegner :

+         botschaft("gegner schiesst","").

+

+

+

+        rufe gegner :

+        empfang(mitteilung,FALSE);

+        IF mitteilung = "gegner schiesst" THEN forget(ds);

+                                               ds := nilspace;

+                                               REP wait(ds,reply,source)

+                                               UNTIL (reply = 0) AND (source 

+                                                      = gegner) PER;

+                                               schuss := ds;

+                                               IF elem <> "" THEN

+                                                   count[int(schiffstypen SUB 

+                                                   (pos(schiffstypen,elem)- 2 

+                                                   ))] DECR 1;

+                                                   cursor(CONCR(schuss).x,

+                                                   CONCR(schuss).y);

+                                                   out(" ");

+                                      IF count[int(schiffstypen SUB (pos(schiff

+                                         stypen,elem) - 2))] = 0

+                                      THEN botschaft(elem + " versenkt" +

+                                           bell, "")

+                                      ELSE botschaft(elem + " getroffen" +

+                                           bell,"")

+                                      FI;

+                                      elem := ""

+                                  ELSE botschaft("nicht getroffen","")

+                                  FI;forget(ds)

+                            ELIF mitteilung = "gegner hat verloren" THEN

+                                 botschaft("Spiel beendet",

+                                 "Sie haben verloren.Tut mir leid.");

+                                 LEAVE spiele eine runde

+                            ELSE darstellen(mitteilung)

+                            FI

+END PROC spiele eine runde.

+

+

+leerzeile :

+  77 TIMESOUT blank

+

+END PACKET schiffe versenken

diff --git a/app/misc-games/unknown/src/SCHIFFEV2.ELA b/app/misc-games/unknown/src/SCHIFFEV2.ELA
new file mode 100644
index 0000000..91002b5
--- /dev/null
+++ b/app/misc-games/unknown/src/SCHIFFEV2.ELA
@@ -0,0 +1,409 @@
+                                                (* M.Staubermann,15.03.83 *)

+                                                (* Korr. 24.05.87         *)

+PACKET schiffe versenken DEFINES schiffe versenken :

+ 

+

+(* D E K L A R A T I O N S T E I L *)

+

+

+TEXT VAR eingabe, mitteilung := "";

+INT VAR x pos, y pos, reply;

+BOOL VAR spieler 1, dran;

+ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0);

+DATASPACE VAR ds;

+forget(ds);

+ds := nilspace;

+BOUND TEXT VAR msg := ds;

+CONCR(msg) := "";

+TASK VAR gegner,source;

+forget(ds);

+ds:=nilspace;

+BOUND STRUCT (INT x , y) VAR schuss := ds;

+forget(ds);

+CONCR(schuss).x:= 1;

+CONCR(schuss).y := 1;

+ROW 11 ROW 17 TEXT VAR spielfeld;

+LET mark begin = ""15"",

+    mark end   = ""14"",

+    return     = ""13"",

+    down       = ""10"",

+    back       = ""8"",

+    bell       = ""7"",

+    up         = ""3"",

+    vor        = ""2"",

+    blank      = " ",

+    schiffstypen= "5:F4:K3:S2:V1:P";

+

+(* Ende des Deklarationsteils *)

+

+

+

+PROC schiffe versenken :

+     command dialogue(TRUE);

+     REP

+        IF no("Sind die Spielregeln bekannt") THEN page;

+           gib die spielregeln aus;

+           pause(200);

+        FI;

+        page;

+        line(6);

+        putline("  ABCDEFGH");

+        putline(" +--------+");

+        putline("1|        |");

+        putline("2|        |");

+        putline("3|        |");

+        putline("4|        |");

+        putline("5|        |");

+        putline("6|        |");

+        putline("7|        |");

+        putline("8|        |");

+        putline(" +--------+");

+        putline("  Spielfeld");

+        cursor(20,1);

+        putline("S c h i f f e   v e r s e n k e n : ");

+        spiel ausfuehren;page

+     UNTIL no("Noch ein Spiel") PER

+END PROC schiffe versenken;

+

+

+

+PROC gib die spielregeln aus:

+   cursor(15,2);

+   putline("DIE SPIELREGELN :");

+   cursor(15,3);

+   putline("Es gibt fünf Schiffstypen mit verschieden Längen, die beim");

+   cursor(15,4);

+   putline("""Gegner"" versenkt werden müssen. Er versenkt sie hier. Dazu");

+   cursor(15,5);

+   putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel-");

+   cursor(15,6);

+   putline("feld und gibt zuerst die Position der Schiffe (waagerecht und");

+   cursor(15,7);

+   putline("senkrecht) ein und während des Spiels die Position an der ");

+   cursor(15,8);

+   putline("ein gegnerisches Schiff vermutet wird. Ein Signal ertönt,");

+   cursor(15,9);

+   putline("wenn man getroffen hat. Von jedem Schiffstyp ist nur ein Schiff");

+   cursor(15,10);

+   putline("erlaubt. Beenden des Spiels mit 'E'. Schießen mit <RETURN>.");

+   cursor(3,9);

+END PROC gib die spielregeln aus;

+

+

+

+

+PROC botschaft (TEXT CONST message , TEXT CONST darstellen):

+     forget(ds);

+     ds := nilspace;

+     msg := ds;

+     CONCR(msg) := message;

+     REP send(gegner,0,ds,reply) UNTIL reply = 0 PER;

+     IF NOT (darstellen = "") THEN cursor(1,21);

+                                 putline(darstellen);

+                                 pause(100);

+                                 cursor(1,21);

+                                 leerzeile;

+                                 cursor(3,9) 

+     FI

+END PROC botschaft;

+

+

+

+PROC empfang (TEXT VAR message , BOOL CONST darstellen) :

+     forget(ds);

+     ds := nilspace;

+     REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner)

+     PER;

+     msg := ds;

+     message := CONCR(msg);

+     forget(ds);

+     IF darstellen THEN cursor(1,21);

+                        putline(message);

+                        pause(100);

+                        cursor(1,21);

+                        leerzeile;

+                        cursor(3,9) 

+     FI

+END PROC empfang;

+

+

+

+PROC darstellen (TEXT CONST message) :

+     cursor(1,21);

+     leerzeile ;

+     putline(message);

+     pause(50);

+     cursor(3,9);

+END PROC darstellen;

+

+

+

+PROC spiel ausfuehren :

+     forget(ds); 

+     ds := nilspace;

+     msg := ds; 

+     forget(ds); 

+     ds := nilspace; 

+     schuss := ds; 

+     forget(ds); 

+     cursor(1,20);

+     putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank +

+             mark end);

+     cursor(1,21);

+     put("Task - Name des Mitspielers : ");

+     getline(eingabe);

+     IF exists task(eingabe) AND NOT (task (eingabe) 

+        = myself) AND NOT (channel(task(eingabe)) <= 0)

+     THEN gegner := task(eingabe);

+          putline("Er sitzt an Terminal " + text (channel(gegner)));

+          pause(100);

+          cursor(1,22);

+          leerzeile;

+          cursor(1,21);

+          leerzeile;

+     ELSE putline("Unerlaubter Task - Name !");

+          pause(100); 

+          LEAVE spiel ausfuehren

+     FI;

+     darstellen("Mit dem Partner vereinbaren, wer beginnt.");

+     cursor(1,21);

+     spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt");

+     cursor(1,21);

+     pause(10);

+     leerzeile;

+     IF spieler 1 THEN botschaft (name(myself) + " faengt an !","");

+                  ELSE empfang(mitteilung, TRUE)

+     FI; 

+     dran := spieler 1;

+     cursor(15,14);

+     putline("Schiffstypen sind :");

+     cursor(15,15);

+     putline("Flugzeugtraeger : FFFFF");

+     cursor(15,16);

+     putline("Kreuzer         : KKKK");

+     cursor(15,17);

+     putline("Schnellboote    : SSS");

+     cursor(15,18);

+     putline("Versorger       : VV");

+     cursor(15,19);

+     putline("Paddelboote     : P");

+     cursor(3,9);

+     eingabe der schiffe;

+     spiele eine runde;

+END PROC spiel ausfuehren;

+

+

+

+PROC eingabe der schiffe :

+     count := ROW 5 INT : (0,0,0,0,0);

+     FOR y pos FROM 8 UPTO 17 REP

+         FOR x pos FROM 2 UPTO 11 REP

+             spielfeld[ x pos] [y pos] := ""

+         PER

+     PER;

+     darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); 

+     darstellen("Spielfeldes und drücken Sie (mit <SHIFT>) die Buchstaben, so daß alle");

+     darstellen("Schiffe auf dem Spielfeld sind.");

+     REP

+        inchar(eingabe);

+        getcursor(x pos , y pos);

+           IF eingabe = "E" THEN IF spieler 1 THEN

+                        botschaft(name(myself) + "hoert auf","Spiel beendet"); 

+                            ELSE darstellen("Spiel beendet.") 

+                              FI;

+           LEAVE eingabe der schiffe

+           ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") 

+           ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") 

+           ELIF eingabe = "S" THEN wenn moeglich vergroessere("S")

+           ELIF eingabe = "V" THEN wenn moeglich vergroessere("V")

+           ELIF eingabe = "P" THEN wenn moeglich vergroessere("P")

+           ELIF eingabe = " " THEN loesche position

+           ELIF eingabe = "?" THEN gib die spielregeln aus

+           ELIF (eingabe = back) AND x pos > 3 THEN out (back) 

+           ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) 

+           ELIF (eingabe = down) AND y pos < 16 THEN out (down) 

+           ELIF (eingabe = up) AND y pos > 9 THEN out(up)

+           FI

+     UNTIL alle schiffe eingegeben PER.

+

+

+     loesche position :

+       out(" ");out(""8"");

+       IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen

+              SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1

+       FI;

+       spielfeld [x pos] [y pos] := "".

+

+

+

+

+     alle schiffe eingegeben :

+       (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND

+       (count [2] = 2) CAND (count [1] = 1).

+

+

+END PROC eingabe der schiffe;

+

+

+

+PROC wenn moeglich vergroessere (TEXT CONST schiff) :

+     IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND

+        (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR

+        ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND

+        (count [1] = 0))

+     THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar

+          OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0)

+          AND noch kein schiff da

+          THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]

+               INCR 1;

+               out(schiff + ""8"");

+               spielfeld [x pos] [y pos] :=schiff

+          FI

+     FI.

+

+ 

+

+     waagerechter oder senkrechter nachbar :

+     ((spielfeld [sub x(x pos - 1)] [y pos] = schiff)  OR

+      (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR

+     ((spielfeld [x pos] [sub y(y pos - 1)] = schiff)  OR

+      (spielfeld [x pos] [sub y(y pos + 1)] = schiff)).

+

+

+

+     diagonaler nachbar :

+     (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR

+     (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR

+     (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR

+     (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) .

+

+

+

+     noch kein schiff da :

+     IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI.

+

+END PROC wenn moeglich vergroessere;

+

+ 

+

+INT PROC sub x(INT CONST subscription):

+    IF subscription > 11 THEN 11

+    ELIF subscription < 2 THEN 2

+    ELSE subscription

+    FI

+

+END PROC sub x;

+ 

+ 

+ 

+INT PROC sub y(INT CONST subscription):

+    IF subscription > 17 THEN 17

+    ELIF subscription < 8 THEN 8

+    ELSE subscription

+    FI

+

+END PROC sub y;

+ 

+

+

+PROC spiele eine runde :

+     IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben."

+                       , "Eingabe der Schiffe beendet.")

+                  ELSE empfang(mitteilung , TRUE) 

+     FI;

+     REP

+        IF dran THEN darstellen("Jetzt schiessen !");

+                     abschiessen

+                ELSE rufe gegner

+        FI;

+        dran := NOT dran;

+     UNTIL kein schiff mehr da PER;

+     gegner hat verloren .

+

+

+

+     kein schiff mehr da :

+        (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND

+        (count [2] = 0) CAND (count [1] = 0).

+

+

+

+     abschiessen :

+       REP 

+           inchar(eingabe);

+           getcursor(x pos, y pos);

+              IF eingabe = "E" THEN IF spieler 1 THEN 

+                          botschaft(name(myself)+" hoert auf.","Spiel beendet.");

+                          ELSE darstellen ("Spiel beendet.") FI;

+                                    LEAVE spiele eine runde

+              ELIF eingabe =  return THEN schuss gegner;

+                                          forget(ds);

+                                          ds := nilspace;

+                                          CONCR(schuss).x := x pos;

+                                          CONCR(schuss).y := y pos;

+                                          schuss := ds;

+                                          REP send (gegner,0,ds,reply)

+                                          UNTIL reply = 0 PER;

+                                          empfang(mitteilung,TRUE);

+              ELIF eingabe = "?"     THEN gib die spielregeln aus

+           ELIF (eingabe = back) AND x pos > 3 THEN out (back) 

+           ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) 

+           ELIF (eingabe = down) AND y pos < 16 THEN out (down) 

+           ELIF (eingabe = up) AND y pos > 9 THEN out(up)

+              FI

+         UNTIL eingabe = return PER.

+

+

+

+         elem :

+         spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)].

+

+

+

+         gegner hat verloren :

+         botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). 

+

+

+         schuss gegner :

+         botschaft("gegner schiesst","").

+

+

+

+        rufe gegner :

+        empfang(mitteilung,FALSE);

+        IF mitteilung = "gegner schiesst" THEN forget(ds);

+                                               ds := nilspace;

+                                               REP wait(ds,reply,source)

+                                               UNTIL (reply = 0) AND (source 

+                                                      = gegner) PER;

+                                               schuss := ds;

+                                               IF elem <> "" THEN

+                                                   count[int(schiffstypen SUB 

+                                                   (pos(schiffstypen,elem)- 2 

+                                                   ))] DECR 1;

+                                                   cursor(CONCR(schuss).x,

+                                                   CONCR(schuss).y);

+                                                   out(" ");

+                                      IF count[int(schiffstypen SUB (pos(schiff

+                                         stypen,elem) - 2))] = 0

+                                      THEN botschaft(elem + " versenkt" +

+                                           bell, "")

+                                      ELSE botschaft(elem + " getroffen" +

+                                           bell,"")

+                                      FI;

+                                      elem := ""

+                                  ELSE botschaft("nicht getroffen","")

+                                  FI;forget(ds)

+                            ELIF mitteilung = "gegner hat verloren" THEN

+                                 botschaft("Spiel beendet",

+                                 "Sie haben verloren. Tut mir leid.");

+                                 LEAVE spiele eine runde

+                            ELSE darstellen(mitteilung)

+                            FI

+END PROC spiele eine runde ; 

+

+

+.leerzeile :

+  out (""5"")

+

+END PACKET schiffe versenken

diff --git a/app/mpg/1987/doc/GDOKKURZ.ELA b/app/mpg/1987/doc/GDOKKURZ.ELA
new file mode 100644
index 0000000..83ad3d2
--- /dev/null
+++ b/app/mpg/1987/doc/GDOKKURZ.ELA
@@ -0,0 +1,119 @@
+#type ("hs")##limit (16.0)# 

+#type ("prop3.3-24")# #center#*** MPG-GRAPHIK *** #block# 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Einleitung:#off ("u")# 

+#type ("prop10-12")# 

+ 

+                 Das MPG-Graphik-System ist eine Sammlung von aufein-

+                 ander aufbauenden Umgebungs- und Applikationspaketen, in

+                 die auch die bisherige EUMEL-Graphik vollständig integriert

+                 ist. 

+ 

+                 Folgende Leistungsmerkmale zeichnen die MPG-Graphik aus: 

+                 - verbesserter und nun auch in der Paket-Hierarchie voll-

+                   ständig Endgerätunabhängiger EUMEL-Graphik-Kern. 

+                 - umfassende Dokumentation der EUMEL-Graphik und des

+                   MPG-Graphik-Systems. 

+                 - taskunabhängige und mehrbenutzerfähige Ansteuerung der

+                   Endgeräte. 

+                 - normierte Ansteuerung der Endgeräte auf unterster

+                   Ebene. 

+                 - indirekte Graphik-Ausgabe. 

+                 - komfortable Steuerung der Graphik-Ausgabe. 

+                 - Vollständige Unterstützung aller von der EUMEL-Graphik

+                   vorgesehenen Leistungen: 

+                   - beliebig breite Linien 

+                   - frei definierbare Linientypen mit Erhalt des Musters

+                     bei verketteten Linien 

+                   - Ansatzfreie verkettete Linien durch abrundung der

+                     Enden. 

+                   - frei definierbare vektorielle Zeichensätze in beliebiger

+                     Größe und Rotation. 

+                   - schnelles Clipping an den Kanten der Zeichenfläche. 

+ 

+                   Desweiteren: 

+                   - frei definierbare Farben in normierter RGB-Codierung. 

+                   - automatische Einstellung der EUMEL-Farben auf den

+                     Endgeräten (abschaltbar). 

+                   - Automatische Pause nach Abschluß der Ausgabe

+                     (abschaltbar, also auch unterbrechungslose Ausgabe

+                     möglich). 

+                   - Übereinanderzeichnen mehrerer Zeichnungen möglich. 

+                 - leichte Anpassung und Integration neuer Endgeräte bzw.

+                   Endgerät-Typen. 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Applikationen:#off ("u")# 

+#type ("prop10-12")# 

+

+                 - der komfortable menügesteuerte Funktionenplotter 'FKT'. 

+ 

+                 - die einfach zu programmierende 'TURTLE'-Graphik. 

+ 

+                 - der vollintegrierte dynamische Multispool-Manager 'PLOT'. 

+ 

+                 - das 'EUCLID'-System zur umfassenden graphischen

+                   Funktions- und Kurvendiskussion (in Vorbereitung). 

+ 

+                 - der objektorientierte 2D-Graphik-Editor 'GED', auch zur

+                   Zeichensatz-Erstellung (in PLanung). 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Zur EUMEL-Graphik:#off ("u")# 

+#type ("prop10-12")# 

+                 - Es wurde die vorletzte Version der EUMEL-Graphik

+                   (PICFILE-Typ: 1102) verwendet, da diese einen um-

+                   fassenderen Objektumfang (neue Version: keine Hidden-

+                   Lines und kein Zeichen in Weltkoordinaten) bietet. 

+                   Neuere PICFILEs (Typ: 1103) können mittels

+                   'GRAPHIK.Convert' in diesen Typ knvertiert werden. 

+ 

+                 - Fehler dieser Version (die auch in der neuen Version

+                   auftreten) wurden weitgehend beseitigt bzw. in der teil-

+                   weise neuerstellten Dokumentation vermerkt. 

+ 

+                 - Die Ausgabe von PICTUREs und PICFILEs wurde von den

+                   Verwaltungspaketen ('picture' bzw. 'picfile') abgespalten,

+                   so daß die Erzeugung von Graphiken auch in der

+                   Paket-Hierarchie Endgerät-unabhängig möglich ist. 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Zum Graphik-Tasksystem:#off ("u")# 

+#type ("prop10-12")# 

+                 - Jede Task im 'GRAPHIK'-Zweig kann auf jedes Endgerät

+                   direkt zugreifen, und aufgrund der normierten An-

+                   steuerung der Endgeräte können auch die (schnelleren)

+                   Zeichnungs-Primitiva (Gerade ziehen, positionieren usw.)

+                   bei Beachtung der Auflösung endgerätunabhängig

+                   verwendet werden. 

+ 

+                 - Die indirekte Ausgabe von PICFILEs ist über die Task

+                   'PLOT' möglich, dabei kann über das Netz auch auf

+                   Endgeräte anderer Stationen zugegriffen werden. 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Zur Ansteuerung der Endgeräte:#off ("u")# 

+#type ("prop10-12")# 

+                 Vor der Ausgabe ist mit 'select plotter' das Endgerät

+                 einzustellen, auf das ausgegeben werden soll. 

+                 Die vom Graphik-System verwendeten Konstanten

+                 ('drawing area' usw.) beziehen sich nunmehr auf das

+                 eingestellte Endgerät. 

+                 Bei Verwendung der Zeichnungs-Primitiva ist zu beachten,

+                 das diese nur am Endgerät-Kanal sinnvoll sind (die Über-

+                 einstimmung von Endgerät- und Task-Kanal wird aus Zeit-

+                 gründen jedoch nicht überprüft). 

+                 Die Ausgabe von PICFILEs erfolgt automatisch richtig, d.h.

+                 am Endgerät-Kanal direkt, ansonsten indirekt über die

+                 'PLOT', die zur Ausgabe dynamische Kanal-Server erzeugt. 

+ 

+#type ("prop7.5-16")# 

+#on ("u")#Zur Mehrbenutzerfähigkeit:#off ("u")# 

+#type ("prop10-12")# 

+                 Da die Task 'PLOT' für alle Endgeräte auch als Spooler

+                 arbeitet, können Graphiken als PICFILEs von beliebig vielen

+                 Benutzern von jeder Task im Graphik-Zweig aus erstellt

+                 und ausgegeben werden (Soweit der Endgerät-Kanal nicht

+                 direkt genutzt wird), 'PLOT' sorgt dann für die sequentielle

+                 Ausgabe auf dem jeweils zugeordneten Endgerät.

diff --git a/app/mpg/1987/doc/GRAPHIK.doc.e b/app/mpg/1987/doc/GRAPHIK.doc.e
new file mode 100644
index 0000000..c945413
--- /dev/null
+++ b/app/mpg/1987/doc/GRAPHIK.doc.e
@@ -0,0 +1,2234 @@
+#type ("prop.lq")##limit (16.0)# 

+#free(10.0)# 

+#headoff##bottomoff# 

+ 

+#type("prop.breit.lq")##center##on("u")#Dokumentation des MPG-Graphik-Systems#off("u")#

+ 

+#free(1.0)#

+#type("prop")##center#Version 2.1 vom 10.09.87 

+ 

+#free(0.5)#

+#center#(c) 1987 Beat Jegerlehner & Carsten Weinholz

+ 

+#page# 

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Inhaltsverzeichnis

+#type("pica.lq")##free(1.0)#

+#type("prop")##limit(16.0)##linefeed(01.0)# 

+#type("pica")##on("u")#Inhaltsverzeichnis#off("u")##type("prop.lq")# 

+#free(0.5)#

+#type ("prop.lq")##limit (16.0)# 

+      Teil  1: Komponenten des Graphik-Systems ...................  1 

+                1.0 GRAPHIK.Basis ................................  1 

+                2.0 GRAPHIK.Configuration/GRAPHIK.Configurator ...  1 

+                3.0 GRAPHIK.Plot .................................  1 

+      Teil  1.1: Generierung der Graphik .........................  2 

+      Teil  1.2: Tasks des Graphik-Systems .......................  3 

+                1.0 Task: 'GRAPHIK' ..............................  3 

+                2.0 Task: 'PLOT' .................................  3 

+                3.0 Task: 'FKT' ..................................  4 

+      Teil  2: Operationen der Basisgraphik ......................  5 

+                1.0 Paket: 'transformation' ......................  5 

+                2.0 Paket: picture ...............................  8 

+                3.0 Paket: 'picfile' .............................  13 

+                4.0 Paket: 'devices' .............................  17 

+      Teil  2.1: Operationen des 'device interface' ..............  19 

+                1.0 Paket: 'device interface' ....................  19 

+      Teil  2.2: Operationen zur Graphik-Ausgabe .................  23 

+                2.0 Paket: 'basisplot' ...........................  23 

+                3.0 Paket: 'plot interface' ......................  27 

+                4.0 Paket: 'plot' ................................  29 

+      Teil  3: Konfigurierung der Graphik ........................  30 

+      Teil  3.1: Der Graphik-Konfigurator ........................  30 

+      Teil  3.2: Erstellung der Konfigurationsdateien ............  31 

+                1.0 Pseudo-Schlüsselworte ........................  32 

+                2.0 Pseudo-Prozeduren ............................  34 

+      Teil  4: Graphik-Applikationen .............................  37 

+      Teil  4.1: Der Funktionenplotter 'FKT' .....................  37 

+                1.0 Allgemeines über FKT .........................  37 

+                2.0 Das FKT-Menue ................................  37 

+                3.0 FKT-Menuepunkte ..............................  38 

+      Teil  4.2: Die TURTLE-Graphik ..............................  44 

+                1.0 Paket: 'turtlegraphics' ......................  44 

+      Stichwortverzeichnis .......................................  XX

+#page(1)# 

+#head on##bottom on# 

+#bottom#

+#right#Seite %

+#end#

+#head#

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Teil 1: Komponenten des Graphik-Systems

+#type("pica.lq")##free(1.0)#

+#end#

+#type("pica")##on("u")##ib(1)#Teil 1: Komponenten des Graphik-Systems#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+ 

+   Das MPG-Graphik-System besteht aus folgenden Komponenten: 

+ 

+   #ib(1)#1.0 GRAPHIK.Basis#ie(1)# 

+ 

+      1.1 #ib(2," (1.1)")#PACKET transformation#ie(2,"")# 

+            - Transformations- und Umrechnungsprozeduren zur Endgerät-

+              unabhängigen Abbildung von PICTURES bzw. PICFILES. 

+ 

+      1.2 #ib(2," (1.2)")#PACKET picture#ie(2,"")# 

+            - Verwaltung des Datentyps PICTURE, der eine Bildebene objekt-

+              orientiert beschreibt. 

+ 

+      1.3 #ib(2," (1.3)")#PACKET picfile#ie(2,"")# 

+            - Verwaltung des Datentyps PICFILE, der ein aus verschiedenen Bild-

+              ebenen (PICTURES) bestehendes Bild und seine (allgemeine) Abbildung

+              auf den Endgeräten beschreibt. 

+ 

+      1.4 #ib(2," (1.4)")#PACKET devices#ie(2,"")# 

+            - Allgemeine Verwaltung der verschiedenen Endgeräte. 

+ 

+ 

+   #ib(1)#2.0 GRAPHIK.Configuration/GRAPHIK.Configurator#ie(1)# 

+ 

+      2.1 #ib(2," (2.1)")#PACKET deviceinterface#ie(2,"")# 

+            - Bereitstellung der allgemeinen graphischen Basisoperationen, die

+              für jedes Endgerat gleichartig vorhanden sind. 

+            - Das 'deviceinterface' wird vom 'GRAPHIK.Configurator' bei Bedarf

+              durch geeignetes Zusammenbinden veschiedener Endgerät-

+              Konfigurationsdateien automatisch erzeugt. 

+ 

+ 

+   #ib(1)#3.0 GRAPHIK.Plot#ie(1)# 

+ 

+      3.1 #ib(2," (3.1)")#PACKET basisplot#ie(2,"")# 

+            - Bereitstellung der von der EUMEL-Graphik benötigten

+              Basisoperationen. 

+ 

+      3.2 #ib(2," (3.2)")#PACKET plotinterface#ie(2,"")# 

+            - Paket zur Ansteuerung und Kontrolle der Endgeräte. 

+ 

+      3.3 #ib(2," (3.3)")#PACKET plot#ie(2,"")# 

+            - Ausgabeprozeduren für PICTURES bzw. PICFILES für alle Endgeräte. 

+#page# 

+#type("pica")##on("u")##ib(1)#Teil 1.1: Generierung der Graphik#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+   Es wird zunächst eine Task 'GRAPHIK' (o.ä.) eingerichtet. 

+   Das MPG-Graphik-Sytem befindet sich auf der Diskette 'GRAPHIK 2.1': 

+ 

+      - archive  ("GRAPHIK 2.1") 

+      - fetch    ("GRAPHIK.Install",archive) 

+      - run      ("GRAPHIK.Install") 

+ 

+   'GRAPHIK.Install' enthält ein Generierungsprogramm, das die weitere Generierung

+   des Graphik-Systems vornimmt. 

+   Existiert auf dem Archiv eine Datei 'GRAPHIK.Configuration', so wird nachge-

+   fragt, ob das Graphiksystem hinsichtlich der anzusteuernden Endgeräte neu-

+   konfiguriert('GRAPHIK.Configuration' also in Abhängigkeit von den ebenfalls

+   auf der Diskette vorhandenen Endgerät-Konfigurationsdateien neu erstellt

+   werden soll). Fehlt 'GRAPHIK.Configuration', so wird es zwangsläufig neu er-

+   stellt (siehe 'Neukonfiguration des Graphik-Systems', S. #to page ("newconf")#). 

+   Mit der im Hintergrund ablaufenden Installation des Plotmanagers in der

+   (Sohn-)Task 'PLOT' (siehe 'Funktion von PLOT', S.#to page ("plotmanager")#) steht dann die Graphik allen

+   Sohntasks von 'GRAPHIK' zur Verfügung: 

+ 

+                                  . 

+                                  . 

+                               GRAPHIK 

+                                  PLOT 

+                                  FKT 

+                                  EUCLID 

+                                  user 

+                                  usw. 

+                                  . 

+                                  . 

+#page# 

+#type("pica")##on("u")##ib(1)#Teil 1.2: Tasks des Graphik-Systems#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+ 

+   #ib(1)#1.0 Task: 'GRAPHIK'#ie(1)# 

+ 

+      'GRAPHIK' ist die Ausgangstask des Graphik-Systems; in ihr werden (s.o) die

+      einzelnen Graphikpakete insertiert, und stehen den Sohntasks zur Verfügung

+      (siehe 'Operationen der Basisgraphik', S. #topage("gfuncts")#). Zusätzlich kann sie den Plot-

+      manager in der Task 'PLOT' kontrollieren 

+ 

+   #ib(1)#2.0 Task: 'PLOT'#ie(1)##goalpage("plotmanager")# 

+ 

+      'PLOT' enthält den Multispool-Manager des Graphik-Systems, der die indirekte

+      Ausgabe von PICFILES auf jedem Endgerät der Station ermöglicht. Der Manager

+      verwaltet im Gegensatz zum 'PRINTER' aber nicht nur eine Warteschlange bzw.

+      Server sondern mehrere (die Anzahl ist durch die Konstante 'max spools' in

+      'GRAPHIK.Manager' festgelegt). 

+      (Achtung !, eine Task kann nicht mehr als 255 Datenräume, also Einträge in

+      Warteschlangen verwalten !). 

+      Sollte PLOT neben PRINTER zur graphischen Ausgabe auf dem Drucker arbei-

+      ten, so ist in PRINTER 'spool control task (/"PLOT")' einzustellen. 

+      Der Plotmanager besitzt eine Kommandoebene, die wie folgt arbeitet: 

+         Nach 'continue' erscheint der Prompt 'All-Plotter', der anzeigt, daß nach-

+         folgende Kommandos gleichermassen auf alle Spools/Server wirken; sollen

+         die Kommandos auf nur einen Spool/Server wirken, so ist dieser mit 'select

+         plotter' einzustellen, was durch eine Änderung des Prompts auf den

+         Plotternamen angezeigt wird. 

+ 

+            - 2.1 #ib(2," (2.1)")#listspool#ie(2,"")# 

+                 Gibt Auskunft über die Inhalte und Aktivitäten aller bzw. des

+                 gewählten Spools. 

+ 

+            - 2.2 #ib(2," (2.2)")#clearspool#ie(2,"")# 

+                 Initialisiert nach Rückfrage alle bzw. den gewählten Spool;

+                 sämtliche Einträge werden gelöscht, evtl. laufende Ausgaben

+                 abgebrochen (der Server beendet). 

+ 

+            - 2.3 #ib(2," (2.3)")#spool control#ie(2,"")# 

+                 (TEXT CONST control task) 

+                 Stellt die Task mit dem Namen 'control task' und alle ihre Söhne

+                 als privilegiert ein, d.h. Kommandos wie 'start', 'stop' usw. werden

+                 von diesen Tasks wie auch von Systemstasks und von 'GRAPHIK'

+                 aus zugelassen. 

+ 

+            - 2.4 #ib(2," (2.4)")#stop#ie(2,"")# 

+                 Unterbricht eine evtl. laufende Ausgabe und unterbindet die

+                 weitere Ausgabe von Einträgen aller bzw. des gewählten Spools;

+                 wobei nach Rückfrage die abgebrochene Ausgabe als erster

+                 Eintrag erneut eingetragen wird. 

+ 

+            - 2.5 #ib(2," (2.5)")#start#ie(2,"")# 

+                 Nimmt die Ausgabe des gewählten bzw. aller Spools wieder auf. 

+ 

+            - 2.6 #ib(2," (2.6)")#halt#ie(2,"")# 

+                 Unterbindet die weitere Ausgabe von Einträgen aller bzw. des

+                 gewählten Spools; evtl. laufende Ausgaben werden jedoch nicht

+                 abgebrochen. 

+ 

+            - 2.7 #ib(2," (2.7)")#select plotter#ie(2,"")# 

+                 Bietet als Auswahl die Endgeräte der Station an; die obenge-

+                 nannten Operationen wirken danach nur auf den gewählten Spool,

+                 was durch die Änderung des Prompts auf den Namen des gewählten

+                 Endgerätes angezeigt wird. 

+                 Der Abbruch der Auswahloperation führt dementsprechend wieder

+                 zur Einstellung 'All-Plotter'. 

+                 Das aktuell zu kontrollierende Endgerät kann jedoch auch mit

+                 den Standard-Auswahloperationen gewählt werden; diese lassen

+                 aber auch die Wahl von Plottern anderer Stationen zu, was im

+                 Plotmanager als 'All-Plotter' gewertet wird. 

+ 

+         Folgende Funktionen können nur auf einzelne Spools; also nicht auf

+         'All-Plotter' angewendet werden: 

+ 

+            - 2.8 #ib(2," (2.8)")#killer#ie(2,"")# 

+                 Bietet im Dialog alle im Spool enthaltenen Einträge zum Löschen

+                 an. 

+ 

+            - 2.9 #ib(2," (2.9)")#first#ie(2,"")# 

+                 Bietet im Dialog alle dem ersten Eintrag nachfolgenden Einträge

+                 zum Vorziehen an. 

+ 

+   #ib(1)#3.0 Task: 'FKT'#ie(1)# 

+ 

+      Die Task 'FKT' stellt den Funktionenplotter FKT, bzw. dessen menuegesteuerten

+      Monitor als Taskmonitor zur Verfügung. 

+      Wird die Task mit dem Menuepunkt 

+                  'q' - in die Kommandoebene zurueck 

+      verlassen, so werden alle enthaltenen PICFILES gelöscht. 

+      Der Funktionenplotter wird in 'FKT' mit dem Kommando 'fktmanager' instal-

+      liert; er ist jedoch auch in jeder anderen Task mit dem Kommando 'fktplot'

+      erreichbar. 

+ 

+#page# 

+#bottom#

+#right#Seite %

+#end#

+#head#

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Teil 2: Operationen der Basisgraphik

+#type("pica.lq")##free(1.0)#

+#end#

+#type("pica")##on("u")##ib(1)#Teil 2: Operationen der Basisgraphik#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+#goalpage("gfuncts")# 

+   Die Pakete der Basisgraphik sind in der Datei 'GRAPHIK.Basis' enthalten, und

+   realisieren folgende Aufgaben: 

+         - Vektorielle Abbildung virtueller Koordinaten unter Verwendung einer

+           Transformationsmatrix auf die konkrete Endgerät-Zeichenfläche unter

+           Berücksichtigung des eingestellten Teils der Zeichenfläche ('viewport')

+           und des Fensters ('window'). 

+         - Bereitstellung des Datentyps PICTURE, der die gemeinsame Manipulation

+           von Objekten ermöglicht. 

+         - Bereitstellung des Datentyps PICFILE, der die gemeinsame Manipulation

+           von PICTURES hinsichtlich ihrer Ausgabe ermöglicht. 

+         - Bereitstellung des Datentyps PLOTTER, der die freie Auswahl von End-

+           geräten ermöglicht, und Informationen über sie liefert. 

+ 

+   Zu den mit '*' gekennzeichneten Beschreibungen vgl. die Beschreibung im

+   Programmierhandbuch. 

+ 

+      #ib(1)#1.0 Paket: 'transformation'#ie(1)# 

+ 

+         1.1 BOOL PROC #ib(2," (1.1)")#clippedline#ie(2," (PROC)")# 

+              (REAL VAR x0, y0, x1, y1) 

+              - Intern verwendete Prozedur, welche die in den Variablen über-

+                gebenen Anfangs- und Endkoordinaten einer Geraden auf die

+                Ausmaße der aktuellen Endgerät-Zeichenfläche begrenzt. 

+                Es wird zurückgeliefert, ob Teile der übergebenen Geraden inner-

+                halb der Zeichenfläche liegen, also gezeichnet werden müssen. 

+ 

+         1.2 PROC #ib(2," (1.2)")#drawingarea *#ie(2," (PROC)")# 

+              (REAL VAR x cm, REAL VAR y cm, REAL VAR xp, REAL yp) 

+              - Trägt in die übergebenen Variablen die Ausmaße der aktuellen

+                Endgerät-Zeichenfläche in cm und Pixel ein. 

+ 

+         1.3 PROC #ib(2," (1.3)")#getvalues#ie(2," (PROC)")# 

+              (ROW 3 ROW 2 REAL VAR, ROW 2 ROW 2 REAL VAR, 

+               ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) 

+              - Intern verwendete Prozedur, die in die übergebenen Felder die

+                aktuellen Werte der Transformationsmatrix einträgt. 

+ 

+         1.4 BOOL PROC #ib(2," (1.4)")#newvalues#ie(2," (PROC)")# 

+              - Intern verwendete Prozedur, die anzeigt, ob die Transformations-

+                matrix verändert wurde. 

+ 

+         1.5 PROC #ib(2," (1.5)")#oblique *#ie(2," (PROC)")# 

+              (REAL CONST a, b) 

+              - Stellt für o.g. Abbildungsfunktion die Projektionsart

+               'schiefwinklig' ein; 'a;b' ist der Punkt in der X-Y-Ebene, auf den der

+               Einheitsvektor in Z-Richtung abgebildet werden soll. 

+ 

+         1.6 PROC #ib(2," (1.6)")#orthographic *#ie(2," (PROC)")# 

+              - Stellt die Projektionsart 'Paralellprojektion' ein (s.o.). 

+ 

+         1.7 PROC #ib(2," (1.7)")#perspective *#ie(2," (PROC)")# 

+              (REAL CONST x,y,z) 

+              - Stellt die Abbildungsart 'perspektivisch' ein; 'x;y;z' gibt den

+                Fluchtpunkt der Zentralperspektive an. 

+ 

+         1.8 PROC #ib(2," (1.8)")#setdrawingarea#ie(2," (PROC)")# 

+              (REAL CONST x cm, y cm, x p, y p) 

+              - Intern verwendete Prozedur, die vorm Beginn des Zeichnens dem

+                Transformationspaket die Ausmaße der Endgerät-Zeichenfläche

+                übergibt. 

+ 

+         1.9 PROC #ib(2," (1.9)")#setvalues#ie(2," (PROC)")# 

+              (ROW 3 ROW 2 REAL CONST, ROW 2 ROW 2 REAL CONST, 

+               ROW 4 REAL CONST, ROW 2 REAL CONST, ROW 3 REAL CONST) 

+              - Intern verwendete Prozedur, welche die Transformationsmatrix mit

+                den Werten der übergebenen Felder füllt. 

+ 

+         1.10 PROC #ib(2," (1.10)")#transform#ie(2," (PROC)")# 

+              (REAL CONST x, y, z, xp, yp) 

+              - Intern verwendete Prozedur zur Abbildung eines drei-

+                dimensionalen Vektors in virtuellen Koordinaten auf

+                (zweidimensionale) Bildschirmkoordinaten. 

+ 

+         1.11 PROC #ib(2," (1.11)")#view *#ie(2," (PROC)")# 

+              (REAL CONST alpha, phi, theta) 

+              - Stellt für o.g. Abbildungsfunktion zusätzlich die Drehwinkel der

+                Abbildung in Polarkoordinaten ein. 

+                In der derzeitigen Version fehlerhaft ! 

+ 

+         1.12 PROC #ib(2," (1.12)")#view *#ie(2," (PROC)")# 

+              (REAL CONST alpha, phi) 

+              - s.o.; ebenfalls fehlerhaft ! 

+ 

+         1.13 PROC #ib(2," (1.13)")#view *#ie(2," (PROC)")# 

+              (REAL CONST alpha) 

+              - Dreht die Abbildung um den Mittelpunkt der Zeichenfläche um

+                'alpha' Grad ! 

+ 

+         1.14 PROC #ib(2," (1.14)")#viewport *#ie(2," (PROC)")##goalpage("viewport")# 

+              (REAL CONST hormin, hormax, vertmin, vertmax) 

+              - Definiert den verwendeten Teil der Endgerät-Zeichenfläche in

+                Welt- oder Gerätekoordinaten, bei Verwendung dieser Prozedur ist

+                vorangehend 'window (TRUE)' aufzurufen; damit die neuen Werte

+                auch Berücksichtigung finden. 

+ 

+                1. Angabe in Weltkoordinaten (cm): 

+                   'hor min;vert min' - Position der unteren linken Ecke der ver-

+                                        wendeten Zeichenfläche in cm. 

+                   'hor max;vert max' - Position der oberen rechten Ecke der ver-

+                                        wendeten Zeichenfläche in cm. 

+ 

+                2. Angabe in Gerätekoordinaten: 

+                   Es wird eine Angabe in Gerätekoordinaten angenommen, wenn 

+                          hor max < 2.0 und vert max < 2.0 gilt. 

+                   Die Werte werden als Bruchteile der Größe der gesamten Zei-

+                   chenfläche aufgefaßt, wobei für die horizontalen Werte zu-

+                   sätzlich das Verhältnis 'Horizontale/Vertikale' (i.d. Regel > 1)

+                   berücksichtigt wird. 

+                   Das bedeutet für 'vert max' = 'hor max' = 1, 

+                   daß der obere Rand der spezifizierten Zeichenfläche an der

+                   Oberkante der Gesamt-Zeichenfläche, und der rechte Rand an

+                   der rechten Kante des durch die Gesamthöhe der Zeichenfläche

+                   gegebenen Quadrates liegt (unverzerrt). 

+                   Soll die gesamte Zeichenfläche genutzt werden, so ist 'hor min'

+                   = 'vert min' = 0 und 'vert max' = 1 zu setzen; 

+                   'hor max' dagegen auf das Verhältnis 'Horizontale/Vertikale' !.

+                   Die halbe horizontale Verwendung der Zeichenfläche ist durch

+                   Halbierung des Seitenverhältnisses zu erreichen. 

+ 

+         1.15 PROC #ib(2," (1.15)")#window *#ie(2," (PROC)")# 

+              (REAL CONST xmin, xmax, ymin, ymax, zmin, zmax) 

+              - Stellt die Fenstergröße der virtuellen Zeichenfläche, zu der die

+                virtuellen Koordinaten in Bezug gesetzt werden sollen, mittels

+                der gegenüberliegenden Ecken 'min' und 'max' ein. 

+ 

+         1.16 PROC #ib(2," (1.16)")#window *#ie(2," (PROC)")# 

+              (REAL CONST xmin, xmax, ymin, ymax) 

+              - s.o., jedoch für zweidimensionale Darstellungen. 

+ 

+         1.17 PROC #ib(2," (1.17)")#window *#ie(2," (PROC)")# 

+              (BOOL CONST update) 

+              - Die Übergabe von TRUE verursacht die interne Neuberechnung der

+                Transformationsmatrix beim nächsten 'set values'; die immer dann

+                notwendig wird, wenn die Zeichenfläche oder das mit 'viewport'

+                eingestellte virtuelle Fenster verändert werden soll. 

+#page# 

+      #ib(1)#2.0 Paket: picture#ie(1)# 

+ 

+         2.1 #ib(2," (2.1)")#TYPE PICTURE *#ie(2,"")# 

+              - Datentyp zur Verwaltung eines einfarbigen Bildes; das aus entwe-

+                der zwei- oder dreidimensionalen Objekten besteht. 

+ 

+         2.2 OP #ib(2," (2.2)")#:= *#ie(2," (OP)")# 

+              (PICTURE VAR dest, PICTURE CONST source) 

+              - Zuweisungsoperator für den Datentyp PICTURE. 

+ 

+         2.3 PROC #ib(2," (2.3)")#bar *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST width, height, pattern) 

+              - Zeichnet in 'pic' an der aktuellen Position ein Rechteck 

+                'width/height' mit dem Muster 'pattern', wobei zu beachten ist, daß

+                die aktuelle X-Position die horizontale Position der vertikalen

+                Symmetrieachse des Rechtecks angibt. 

+                Als 'pattern' z.Zt. implementiert: 

+                                 0 - nicht gefüllt 

+                                 1 - halb gefüllt (zeitaufwendig!) 

+                                 2 - gefüllt 

+                                 3 - horizontal schraffiert 

+                                 4 - vertikal schraffiert 

+                                 5 - horizontal und vertikal schraffiert 

+                                 6 - diagonal rechts schraffiert 

+                                 7 - diagonal links schraffiert 

+                                 8 - diagonal rechts und links schraffiert 

+ 

+         2.4 OP #ib(2," (2.4)")#CAT *#ie(2," (OP)")# 

+              (PICTURE VAR dest, PICTURE CONST add) 

+              - Fügt die Bilder 'dest' und 'add' in 'dest' zusammen. 

+ 

+         2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x, y, rad, INT CONST pattern) 

+              - Zeichnet in 'pic' an der Position 'x;y' mit dem Radius 'rad' und dem

+                Muster 'pattern' gefüllt ('pattern' z.Zt. wirkungslos) 

+ 

+         2.6 INT PROC #ib(2," (2.6)")#dim *#ie(2," (PROC)")# 

+              (PICTURE CONST pic) 

+              - Liefert die für 'pic' eingestellte Dimensionalität 

+                (2 - zweidimensional; 3 - dreidimensional); wobei die Dimensionali-

+                tät mit der ersten Zeichenoperation eingestellt wird. 

+ 

+         2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x, y, z) 

+              - Zeichnet in 'pic' von der aktuellen Position einen Gerade zur

+                Position 'x;y'. 

+ 

+         2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x, y, z) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height, width) 

+              - Zeichnet in 'pic' an der aktuellen Position 'text' in der Größe

+                'height/width' unter dem Winkel 'angle'. 

+ 

+         2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, TEXT CONST text) 

+              - Zeichnet in 'pic' an der aktuellen Position 'text' in Standardgröße

+                und normaler Ausrichtung. 

+ 

+         2.11 PROC #ib(2," (2.11)")#draw cm *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x cm, y cm) 

+              - Zeichnet in 'pic' eine Gerade zur cm-Position 'x;y', d.h., die Projek-

+                tionseinstellung wird nicht beachtet. 

+ 

+         2.12 PROC #ib(2," (2.12)")#draw cm r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx cm, dy cm) 

+              - Zeichnet in 'pic' eine Gerade zur um 'dx cm;dy cm' verschobenen

+                Zeichenposition, d.h, die Projektionseinstellung wird nicht beach-

+                tet. 

+ 

+         2.13 PROC #ib(2," (2.13)")#draw r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 

+              - Zeichnet in 'pic' eine Gerade der Länge 'dx;dy;dz' relativ zur

+                aktuellen Position. 

+ 

+         2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.15 PROC #ib(2," (2.15)")#extrema *#ie(2," (PROC)")# 

+              (PICTURE CONST pic, REAL VAR x min, x max, y min, y max, z min, z max) 

+              - Trägt in die übergebenen Variablen die grössten und kleinsten

+                Koordinaten aller Objekte in 'pic' ein. 

+ 

+         2.16 PROC #ib(2," (2.16)")#extrema *#ie(2," (PROC)")# 

+              (PICTURE CONST pic, REAL VAR x min, x max, y min, y max) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.17 INT PROC #ib(2," (2.17)")#length *#ie(2," (PROC)")# 

+              (PICTURE CONST pic) 

+              - Liefert die Länge des Objekt-Verwaltungstextes von 'pic'. 

+ 

+         2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x, y, z) 

+              - Fährt den Zeichenstift auf 'pic' an die Position 'x;y;z'. 

+ 

+         2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x, y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.20 PROC #ib(2," (2.20)")#move cm *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST x cm, y cm) 

+              - Die aktuelle Zeichenposition wird auf 'x cm;y cm' verschoben, wobei

+                die Darstellungsart unberücksichtigt bleibt. 

+ 

+         2.21 PROC #ib(2," (2.21)")#move cm r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST d xcm, d ycm) 

+              - Die aktuelle Zeichenposition wird um 'd xcm;d ycm' verschoben,

+                wobei die Darstellungsart unberücksichtigt bleibt. 

+ 

+         2.22 PROC #ib(2," (2.22)")#move r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 

+              - Verschiebt die aktuelle Zeichenposition in 'pic' um 'dx;dy;dz'. 

+ 

+         2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.24 PICTURE PROC #ib(2," (2.24)")#nilpicture *#ie(2," (PROC)")# 

+              - Initialisierungsfunktion; liefert 'leeres Bild'. 

+ 

+         2.25 INT PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# 

+              (PICTURE CONST pic) 

+              - Liefert den für 'pic' eingestellten Stift (Nummer 1 - 16). 

+ 

+         2.26 PROC #ib(2," (2.26)")#pen *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, INT CONST no) 

+              - Stellt den Stift 'no' für 'pic' ein, wobei 'no' die Werte 1 - 16 an-

+                nehmen darf. 

+ 

+         2.27 PICTURE PROC #ib(2," (2.27)")#picture *#ie(2," (PROC)")# 

+              (TEXT CONST objects) 

+              - Die Objektbeschreibung aller Objekte eines Bildes wird in einem

+                Text verwaltet; mit dieser Prozedur wird ein TEXT im entsprechen-

+                den Format in ein PICTURE verwandelt. 

+                Das Format des TEXTes:   <INT>  Dimension : 2- oder 3-D 

+                                         <INT>  Zeichenstift-Nummer 

+                                         <...>  Objekteinträge 

+ 

+                Die Objekteinträge haben folgendes Format: 

+                   <INT> Objektcode <...> Parameter. 

+ 

+                Objektcodes für:    >  Die Parameter entsprechen der 

+                   -  draw       1     Parameterfolge der Prozeduren. 

+                   -  move       2 

+                   -  text       3  >  Vor dem Text wird als <INT> die 

+                   -  move r     4     Textlänge gehalten. 

+                   -  draw r     5 

+                   -  move cm    6 

+                   -  draw cm    7 

+                   -  move cm r  8 

+                   -  draw cm r  9 

+                   -  bar       10 

+                   -  circle    11 

+ 

+         2.28 PROC #ib(2," (2.28)")#rotate *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST alpha, beta, gamma) 

+              - Die Objekte von 'pic' werden gemäß den Winkeln 'alpha;beta;gamma'

+                im positiven Sinne um die X-,Y-,Z-Achse gedreht; wobei nur ein

+                Winkel <> 0.0 sein darf. 

+ 

+         2.29 PROC #ib(2," (2.29)")#rotate *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST alpha) 

+              - Die Objekte von 'pic' werden gemäß dem Winkel 'alpha' im positiven

+                Sinne um die X-Achse gedreht. 

+ 

+         2.30 PROC #ib(2," (2.30)")#stretch *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST xc, yc, zc) 

+              - 'pic' wird um die Faktoren 'xc;yc;zc' gestreckt oder gestaucht:

+                               Faktor > 1 -> Streckung 

+                               Faktor < 1 -> Stauchung 

+                               Faktor < 0 -> zusätzlich Achsenspiegelung 

+ 

+         2.31 PROC #ib(2," (2.31)")#stretch *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST xc, yc) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.32 TEXT PROC #ib(2," (2.32)")#text *#ie(2," (PROC)")# 

+              (PICTURE CONST pic) 

+              - Liefert den Objekt-Verwaltungstext von 'pic'(vergleiche 

+                'picture'). 

+ 

+         2.33 PROC #ib(2," (2.33)")#translate *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 

+              - 'pic' wird um 'dx;dy;dz' verschoben. 

+ 

+         2.34 PROC #ib(2," (2.34)")#translate *#ie(2," (PROC)")# 

+              (PICTURE VAR pic, REAL CONST dx, dy) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.35 PROC #ib(2," (2.35)")#where *#ie(2," (PROC)")# 

+              (PICTURE CONST pic, REAL VAR x, y, z) 

+              - Trägt die aktuelle Zeichenposition in 'pic' in die übergebenen

+                Variablen 'x;y;z' ein. 

+ 

+         2.36 PROC #ib(2," (2.36)")#where *#ie(2," (PROC)")# 

+              (PICTURE CONST pic, REAL VAR x, y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+#page# 

+      #ib(1)#3.0 Paket: 'picfile'#ie(1)# 

+ 

+         3.1 #ib(2," (3.1)")#TYPE PICFILE#ie(2,"")# 

+              - Datentyp zur Verwaltung mehrerer Bilder (PICTUREs) und der

+                Darstellungsparameter.(Aktuelle Typnummer: 1102 !). 

+ 

+         3.2 OP #ib(2," (3.2)")#:= *#ie(2," (OP)")# 

+              (PICFILE VAR dest, DATASPACE CONST source) 

+              - Assoziiert das PICFILE 'dest' mit dem DATASPACE 'source'. 

+ 

+         3.3 OP #ib(2," (3.3)")#:= *#ie(2," (OP)")# 

+              (PICFILE VAR dest, PICFILE CONST source): 

+              - Assoziiert das PICFILE 'dest' mit 'source'; wie bei Files entsteht

+                keine Kopie! 

+ 

+         3.4 INT PROC #ib(2," (3.4)")#background *#ie(2," (PROC)")# 

+              (PICFILE CONST pf) 

+              - Liefert die auf 'pf' eingestellte Hintergrundfarbe. 

+ 

+         3.5 PROC #ib(2," (3.5)")#background *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST no) 

+              - Stellt die Farbe 'no' als Hintergrundfarbe für 'pf' ein: 

+ 

+         3.6 PROC #ib(2," (3.6)")#delete picture *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Löscht das aktuelle Bild in 'pf'. 

+ 

+         3.7 PROC #ib(2," (3.7)")#down *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Positioniert in 'pf' ein Bild weiter. 

+ 

+         3.8 PROC #ib(2," (3.8)")#down *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST step) 

+              - Positioniert in 'pf' 'step'-Bilder weiter. 

+ 

+         3.9 BOOL PROC #ib(2," (3.9)")#eof *#ie(2," (PROC)")# 

+              (PICFILE CONST) 

+              - Liefert zurück, ob das aktuelle Bild auch das letzte des PICFILES

+                ist. 

+ 

+         3.10 PROC #ib(2," (3.10)")#extrema *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL VAR x min, x max, y min, y max, z min, z max) 

+              - Trägt in die übergebenen Variablen die kleinsten bzw. größten

+                Koordinaten aller Bilder in 'pf' ein. 

+ 

+         3.11 PROC #ib(2," (3.11)")#extrema *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL VAR x min, x max, y min, y max) 

+              - s.o., jedoch für zweidimensionale PICFILEs. 

+ 

+         3.12 PROC #ib(2," (3.12)")#get *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, FILE VAR source) 

+              - Liest die in 'source' enthaltenen Informationen über Bilder nach

+                'pf' ein. 

+ 

+         3.13 PROC #ib(2," (3.13)")#get values *#ie(2," (PROC)")# 

+              (PICFILE CONST pf,  ROW 3 ROW 2 REAL VAR,ROW 2 ROW 2 REAL VAR, 

+                                  ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) 

+              - Trägt die Werte der Transformationsmatrix von 'pf' in die über-

+                gebenen Variablenfelder ein. 

+ 

+         3.14 PROC #ib(2," (3.14)")#insert picture *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Fügt vor das aktuelle Bild von 'pf' ein leeres Bild ein. 

+ 

+         3.15 BOOL PROC #ib(2," (3.15)")#is first picture *#ie(2," (PROC)")# 

+              (PICFILE CONST pf) 

+              - Liefert zurück, ob das aktuelle auch das erste Bild von 'pf' ist. 

+ 

+         3.16 PROC #ib(2," (3.16)")#oblique *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST a, b) 

+              - Stellt für 'pf' die Projektionsart 'schiefwinklig' ein; 'a;b' ist der

+                Punkt in der X-Y-Ebene, auf den der Einheitsvektor in Z-Richtung

+                abgebildet werden soll. 

+ 

+         3.17 PROC #ib(2," (3.17)")#perspective *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST x, y, z) 

+              - Stellt für 'pf' die Projektionsart 'perspektivisch' ein; 'x;y;z' gibt

+                den Fluchtpunkt der Zentralperspektive an. 

+ 

+         3.18 INT PROC #ib(2," (3.18)")#picture no *#ie(2," (PROC)")# 

+              (PICFILE CONST pf) 

+              - Liefert die Nummer des aktuellen Bildes von 'pf' zurück. 

+ 

+         3.19 INT PROC #ib(2," (3.19)")#pictures *#ie(2," (PROC)")# 

+              (PICFILE CONST pf) 

+              - Liefert die Anzahl der in 'pf' enthaltenen Bilder zurück. 

+ 

+         3.20 PROC #ib(2," (3.20)")#put *#ie(2," (PROC)")# 

+              (FILE VAR dest, PICFILE CONST pf) 

+              - Liest 'pf' nach 'dest' aus. 

+ 

+         3.21 PROC #ib(2," (3.21)")#put picture *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, PICTURE CONST ins) 

+              - Fügt das Bild 'ins' vor das aktuelle Bild von 'pf' ein. 

+ 

+         3.22 PROC #ib(2," (3.22)")#read picture *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, PICTURE VAR pic) 

+              - Trägt das aktuelle Bild von 'pf' in 'pic' ein. 

+ 

+         3.23 PROC #ib(2," (3.23)")#selected pen *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST no, INT VAR color, thickness, linetype,

+               BOOL VAR visible) 

+              - Trägt in die übergebenen Variablen die für den Stift 'no' aktuell

+                eingestellten Werte ein, wobei 'no' die Werte 1 - 16 annehmen darf. 

+ 

+         3.24 PROC #ib(2," (3.24)")#select pen *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST no, INT CONST color, thickness, linetype,

+               BOOL CONST visible) 

+              - Stellt für den Stift 'no' von 'pf' die übergebenen Werte für Farbe,

+                Stiftbreite, Art des Linenzuges ein, wobei 'no' die Werte 1 - 16

+                annehmen darf. 

+                'visible' = FALSE bedeutet, das die mit diesem Stift gezogenen

+                Linien innerhalb bereits durch das Zeichnen entstandener Flächen

+                nicht gezeichnet werden, die Flächen sie also 'verdecken'. 

+                Vordefiniert sind: 

+                             - color: 

+                                     <0 - nicht standardisierte XOR-Modi 

+                                      0 - Löschstift 

+                                      1 - Standardfarbe d. Endgerätes (s/w) 

+                                      2 - rot 

+                                      3 - blau 

+                                      4 - grün 

+                                      5 - schwarz 

+                                      6 - weiss 

+                                      n - Sonderfarben 

+                             - thickness: 

+                                      0 - Standardstrichstärke d. Endgerätes 

+                                      n - Strichstärke in 1/10 mm 

+                             - linetype: 

+                                      0 - keine Linie 

+                                      1 - durchgängige Linie 

+                                      2 - gepunktete Linie 

+                                      3 - kurz gesrichelte Linie 

+                                      4 - lang gestrichelte Linie 

+                                      5 - Strichpunktlinie 

+                               (Standard-Definitionen, die Linetypes können

+                                über 'basisplot' auch verändert werden.) 

+ 

+         3.25 PROC #ib(2," (3.25)")#set values *#ie(2," (PROC)")# 

+              (PICFILE VAR pf,  ROW 3 ROW 2 REAL CONST, 

+                                ROW 2 ROW 2 REAL CONST, 

+                                ROW 4 REAL CONST, 

+                                ROW 2 REAL CONST, ROW 3 REAL CONST) 

+              - Die übergebenen Felder werden in die Transformationsmatrix von

+                'pf' übernommen. 

+ 

+         3.26 PROC #ib(2," (3.26)")#to eof *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Positioniert auf das letzte Bild von 'pf'. 

+ 

+         3.27 PROC #ib(2," (3.27)")#to first pic *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Positioniert auf das erste Bild von 'pf'. 

+ 

+         3.28 PROC #ib(2," (3.28)")#to pic *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST n) 

+              - Positioniert auf das 'n'-te Bild von 'pf'. 

+ 

+         3.29 PROC #ib(2," (3.29)")#up *#ie(2," (PROC)")# 

+              (PICFILE VAR pf) 

+              - Positioniert in 'pf' ein Bild zurück. 

+ 

+         3.30 PROC #ib(2," (3.30)")#up *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, INT CONST step) 

+              - Positioniert in 'pf' 'step'-Bilder zurück. 

+ 

+         3.31 PROC #ib(2," (3.31)")#view *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST alpha, phi, theta) 

+              - Stellt für die Abbildung von 'pf' zusätzlich die Drehwinkel der

+                Abbildung in Polarkoordinaten ein. 

+                In der derzeitigen Version fehlerhaft ! 

+ 

+         3.32 PROC #ib(2," (3.32)")#view *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST alpha, phi) 

+              - s.o.; in der derzeitigen Version fehlerhaft ! 

+ 

+         3.33 PROC #ib(2," (3.33)")#view *#ie(2," (PROC)")# 

+              (REAL CONST alpha) 

+              - Dreht das Bild um den Mittelpunkt der Zeichenfläche um 'alpha'

+                Grad ! 

+ 

+         3.34 PROC #ib(2," (3.34)")#viewport *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST hor min, hor max, vert min, vert max) 

+              - Spezifiziert die Zeichenfläche, auf die 'pf' abgebildet werden soll.

+                Siehe dazu auch 'viewport' im 'transformation'-Paket (S. #topage("viewport")#). 

+ 

+         3.35 PROC #ib(2," (3.35)")#window *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST x min, x max, y min, y max, z min, z max) 

+              - Definiert die virtuelle Zeichenfläche von 'pf'. 

+ 

+         3.36 PROC #ib(2," (3.36)")#window *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, REAL CONST x min, x max, y min, y max) 

+              - s.o., jedoch für zweidimensionale PICFILEs. 

+ 

+         3.37 PROC #ib(2," (3.37)")#write picture *#ie(2," (PROC)")# 

+              (PICFILE VAR pf, PICTURE CONST new) 

+              - Überschreibt das aktuelle Bild von 'pf' mit 'new'. 

+#page# 

+      #ib(1)#4.0 Paket: 'devices'#ie(1)# 

+ 

+         4.1 #ib(2," (4.1)")#TYPE PLOTTER#ie(2,"")# 

+              - Verwaltungstyp zur Repräsentation eines Endgerätes hinsichtlich

+                seiner Station, seines Kanals, seines Namens sowie seiner Zeichen-

+                fläche. Dabei ist zu beachten, daß der gültige Endgerät-

+                Descriptor, der zur Selektion verwendet wird, aus Station, Kanal

+                und Namen besteht; die Namen also nicht eindeutig vergeben

+                werden müssen. 

+ 

+         4.2 OP #ib(2," (4.2)")#:=#ie(2," (OP)")# 

+              (PLOTTER VAR dest, PLOTTER CONST source) 

+              - Zuweisungsoperator für den Datentyp 'PLOTTER'. 

+ 

+         4.3 BOOL OP #ib(2," (4.3)")#=#ie(2," (OP)")# 

+              (PLOTTER CONST left, right) 

+              - Vergleichsoperator für den Datentyp 'PLOTTER'. 

+ 

+         4.4 INT PROC #ib(2," (4.4)")#actual plotter#ie(2," (PROC)")# 

+              - Liefert die interne Verwaltungsnummer des eingestellten End-

+                gerätes (Kein Endgerät eingestellt -> 0). 

+ 

+         4.5 INT PROC #ib(2," (4.5)")#channel#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Liefert den Kanal von 'plotter'. 

+ 

+         4.6 PROC #ib(2," (4.6)")#drawingarea#ie(2," (PROC)")# 

+              (REAL VAR x cm, y cm, INT VAR x p, y p) 

+              - Trägt in die übergebenen Variablen die Maße der 

+                Zeichenfläche des eingestellten Endgerätes ein. 

+ 

+         4.7 PROC #ib(2," (4.7)")#drawingarea#ie(2," (PROC)")# 

+              (REAL VAR x cm, y cm, INT VAR x p, y p, PLOTTER CONST plotter) 

+              - Trägt in die übergebenen Variablen die Maße der Zeichenfläche

+                von 'plotter' ein. 

+ 

+         4.8 PROC #ib(2," (4.8)")#install plotter#ie(2," (PROC)")# 

+              (TARGET VAR new descriptors) 

+              - Übergibt dem Verwaltungspacket den zu verwaltenden Satz End-

+                geräte. Wird intern vom 'device interface' verwendet, kann aber

+                auch im nachhinein zur Installation von Endgeräten anderer

+                Stationen oder zum Ausblenden von Endgeräten dienen. Nachdem

+                die Graphik installiert wurde, können jedoch keine neuen sta-

+                tionseigenen Endgeräte erzeugt werden (oder nur verwaltungs-

+                seitig, d.h. die Ansteuerung fehlt). 

+ 

+         4.9 TEXT PROC #ib(2," (4.9)")#name#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Liefert den Namen von 'plotter' 

+ 

+         4.10 PLOTTER PROC #ib(2," (4.10)")#no plotter#ie(2," (PROC)")# 

+              - Liefert den Endgerät-Descriptor 'kein Plotter'. 

+ 

+         4.11 PLOTTER PROC #ib(2," (4.11)")#plotter#ie(2," (PROC)")# 

+              - Liefert den Endgerät-Descriptor des eingestellten Endgerätes. 

+ 

+         4.12 PLOTTER PROC #ib(2," (4.12)")#plotter#ie(2," (PROC)")# 

+              (TEXT CONST descriptor) 

+              - Liefert den Endgerät-Descriptor des durch 'descriptor' beschrie-

+                benen Endgerätes. 

+                'descriptor' hat folgendes Format: 

+                    <Stationsnummer>/<Kanalnummer>/Endgerätname, 

+                wobei nicht vorhandene Endgeräte abgelehnt werden. 

+ 

+         4.13 TEXT PROC #ib(2," (4.13)")#plotterinfo#ie(2," (PROC)")# 

+              (TEXT CONST descriptor, INT CONST length) 

+              - Liefert einen auf die Länge 'length' eingerichteten TEXT, der

+                'descriptor' in aufbereiteter Form wiedergibt. 

+                Format von 'descriptor' s.o. 

+ 

+        4.14 THESAURUS PROC #ib(2," (4.14)")#plotters#ie(2," (PROC)")# 

+              - Liefert alle vorhandenen Endgeräte in Form o.g. Descriptoren. 

+ 

+         4.15 PROC #ib(2," (4.15)")#select plotter#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Stellt 'plotter' als aktuelles Endgerät ein. 

+ 

+         4.16 PROC #ib(2," (4.16)")#select plotter#ie(2," (PROC)")# 

+              (TEXT CONST descriptor) 

+              - Stellt das durch 'descriptor' beschriebene Endgerät als aktuelles

+                Endgerät ein. 

+ 

+         4.17 PROC #ib(2," (4.17)")#select plotter#ie(2," (PROC)")# 

+              - Bietet eine Auswahl aller Endgeräte an, und stellt das gewählte

+                als aktuelles Endgerät ein. 

+ 

+         4.18 INT PROC #ib(2," (4.18)")#station#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Liefert die Stationsnummer von 'plotter' zurück. 

+#page# 

+#type("pica")##on("u")##ib(1)#Teil 2.1: Operationen des 'device interface'#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+ 

+      Das automatisch vom 'GRAPHIK.Configurator' anhand von Konfigurationsda-

+      teien erstellte Paket 'device interface' realisiert die normierte, jedoch von

+      der Zeichenfläche des Endgeräts abhängige Ansteuerung der verschiedenen

+      Endgeräte. Es entspricht dabei dem Paket 'Endgerät.Basis' der EUMEL-Graphik,

+      geht aber teilweise über dessen Leistungen hinaus.Hinweis: Falls diese Lei-

+      stung nicht bereits endgerätseitig implementiert ist, wird nicht geclipped;

+      die Überschreitung der Zeichengrenzen hat also Undefiniertes zur Folge. 

+      Zudem ist die Mehrheit der Prozeduren ausschließlich nach 'initplot' funk-

+      tionsfähig. 

+ 

+      #ib(1)#1.0 Paket: 'device interface'#ie(1)# 

+ 

+         1.1 INT PROC #ib(2," (1.1)")#background#ie(2," (PROC)")# 

+              - Liefert die Nummer der aktuell für den Hintergrund eingestellten

+                Farbe zurück. 

+ 

+         1.2 PROC #ib(2," (1.2)")#background#ie(2," (PROC)")# 

+              (INT CONST color no) 

+              - Stellt die Farbe 'color no' als Hintergrundfarbe ein. 

+ 

+         1.3 PROC #ib(2," (1.3)")#box#ie(2," (PROC)")# 

+              (INT CONST x1, y1, x2, y2, pattern) 

+              - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken 'x1;y1'

+                und 'x2;y2', das mit dem Muster 'pattern' gefüllt wird, wobei

+                'pattern' endgerätspezifisch ist. 

+ 

+         1.4 PROC #ib(2," (1.4)")#circle#ie(2," (PROC)")# 

+              (INT CONST x, y, rad, from, to) 

+              - Zeichnet an der Stelle 'x;y' einen Kreis (bzw. Kreissegment) des

+                Radius 'rad' mit dem Anfangswinkel 'from' und dem Endwinkel 'to'. 

+ 

+         1.5 PROC #ib(2," (1.5)")#clear#ie(2," (PROC)")# 

+              - Initialisiert die Zeichenfläche des aktuellen Endgerätes, wobei

+                die Zeichenposition auf '0;0' und die Standardfarben 

+                gesetzt werden. 

+ 

+         1.6 PROC #ib(2," (1.6)")#clear#ie(2," (PROC)")# 

+              (BOOL CONST onoff) 

+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe

+                von 'clear' wirkungslos sind; mit TRUE werden sie entsprechend

+                wieder aktiviert. 

+ 

+         1.7 INT PROC #ib(2," (1.7)")#color#ie(2," (PROC)")# 

+              (INT CONST color no) 

+              - Liefert den für die Farbe 'color no' eingestellten Farbwert im

+                normierten RGB-Code von 0-999. 

+ 

+         1.8 INT PROC #ib(2," (1.8)")#colors#ie(2," (PROC)")# 

+              - Liefert die Anzahl möglicher Farben für das aktuelle Endgerät. 

+ 

+         1.9 PROC #ib(2," (1.9)")#draw to#ie(2," (PROC)")# 

+              (INT CONST x, y) 

+              - Zieht von der aktuellen Zeichenposition eine Gerade zur Position

+                'x;y'. 

+ 

+         1.10 PROC #ib(2," (1.10)")#endplot#ie(2," (PROC)")# 

+              - Wartet auf eine Eingabe des Benutzers und beendet dann die

+                graphische Ausgabe; ggf. durch Umschalten in den Text-Modus. 

+                Falls möglich, sollte die ausgegebene Graphik jedoch auf dem

+                Bildschirm erhalten bleiben. 

+ 

+         1.11 PROC #ib(2," (1.11)")#end plot#ie(2," (PROC)")# 

+              (BOOL CONST onoff) 

+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe

+                von 'endplot' wirkungslos sind; mit TRUE werden sie entsprechend

+                wieder aktiviert. 

+ 

+         1.12 PROC #ib(2," (1.12)")#fill#ie(2," (PROC)")# 

+              (INT CONST x, y, INT CONST pattern) 

+              - Die Umgebung von 'x;y' wird mit dem Muster 'pattern' gefüllt, wobei

+                sowohl 'pattern' als auch die genauen Füll-Bedingungen (Art der

+                Umrahmung usw.) endgerätspezifisch sind. 

+ 

+         1.13 INT PROC #ib(2," (1.13)")#foreground#ie(2," (PROC)")# 

+              - Liefert die Nummer der aktuell für den Vordergrund eingestellten

+                Farbe zurück. 

+ 

+         1.14 PROC #ib(2," (1.14)")#foreground#ie(2," (PROC)")# 

+              (INT CONST color no) 

+              - Stellt die Farbe 'color no' als Vordergrundfarbe ein. 

+ 

+         1.15 PROC #ib(2," (1.15)")#get cursor#ie(2," (PROC)")# 

+              (INT VAR x, y, TEXT VAR exit char) 

+              - Nach Aufruf dieser Prozedur sollte das Endgerät die Eingabe

+                einer Position mittels eines graphischen Cursors (i.d.R.

+                Fadenkreuz) ermöglichen. Dieser Modus soll bleibt solange auf-

+                rechterhalten bis eine Taste gedrückt wird; in 'x;y' findet sich

+                dann die Position des Cursors, und in 'exit char' die gedrückte

+                Taste. 

+                Diese Prozedur ist jedoch nicht für das Ein bzw. Ausschalten des

+                graphischen Cursors zuständig, d.h der eingeschaltete Cursor ist

+                ständig sichtbar; bei ausgeschaltetem Cursor kehrt die Prozedur

+                sofort mit 'exit char' = ""0"" zurück. 

+ 

+         1.16 BOOL PROC #ib(2," (1.16)")#graphik cursor#ie(2," (PROC)")# 

+              - Diese Prozedur gibt an, ob graphische Eingabeoperationen und 

+                die dazugehörigen Operationen auf dem aktuellen Endgerät ver-

+                fügbar sind. 

+ 

+         1.17 PROC #ib(2," (1.17)")#graphik cursor#ie(2," (PROC)")# 

+              (INT CONST x, y, BOOL CONST onoff) 

+              - Diese Prozedur schaltet den graphischen Cursor an bzw. aus oder

+                positioniert ihn. Nach dem Einschalten sollte der Cursor perma-

+                nent sichtbar sein. Ein erneutes Einschalten hat die

+                Neupositionierung des Cursors zur Folge. 

+ 

+         1.18 PROC #ib(2," (1.18)")#home#ie(2," (PROC)")# 

+              - Positioniert die aktuelle Zeichenposition auf den Punkt '0;0'; bei

+                eingeschaltetem graphischen Cursor diesen auf die Mitte der

+                Zeichenfläche. 

+ 

+         1.19 PROC #ib(2," (1.19)")#init plot#ie(2," (PROC)")# 

+              - Initialisiert das aktuelle Endgerät zur graphischen Ausgabe,

+                (schaltet ggf. in den Graphik-Modus), wobei der Bildschirm jedoch

+                möglichst nicht gelöscht werden sollte. 

+ 

+         1.20 PROC #ib(2," (1.20)")#move to#ie(2," (PROC)")# 

+              (INT CONST xp, yp) 

+              - Die Position 'xp;yp' wird neue Stiftposition; die Wirkung ist unde-

+                finiert bei Überschreitung der Bildschrimgrenzen. 

+ 

+         1.21 PROC #ib(2," (1.21)")#prepare#ie(2," (PROC)")# 

+              - Bereitet die Ausgabe auf einem Endgerät vor; d.h. die Task wird an

+                den entsprechenden Kanal angekoppelt, und andere Tasks am An-

+                koppeln gehindert (z.B. 'stop' des PRINTER-Servers). Dabei wird die

+                Prozedur erst dann verlassen, wenn die Aktion erfolgreich been-

+                det ist. (z.B. bis zur Freigabe des Kanals). 

+ 

+ 

+         1.22 PROC #ib(2," (1.22)")#set color#ie(2," (PROC)")# 

+              (INT CONST no, rgb) 

+              - Setzt die Farbe von 'no' auf die normierte RGB-Farbkombination

+                'rgb' (0 - 999). 

+ 

+         1.23 PROC #ib(2," (1.23)")#setmarker#ie(2," (PROC)")# 

+              (INT CONST xp, yp, type) 

+              - Zeichnet an der Position 'xp;yp' eine Markierung; wobei die Wir-

+                kung bei Überschreitung der Bildschirmgrenzen undefiniert ist.

+                Als 'type' sollten vorhanden sein: 

+                         0  - Kreuz '+' 

+                         1  - Kreuz diagonal 'x' 

+                            - weitere beliebig 

+ 

+         1.24 PROC #ib(2," (1.24)")#setpalette#ie(2," (PROC)")# 

+              - Initialisiert die Farben des Endgerätes gemäß den im Paket ge-

+                setzten Farben. 

+ 

+         1.25 PROC #ib(2," (1.25)")#setpixel#ie(2," (PROC)")# 

+              (INT CONST xp, yp) 

+              - Setzt das Pixel 'xp;yp' in der aktuellen Schreibfarbe. 

+ 

+         1.26 PROC #ib(2," (1.26)")#stdcolors#ie(2," (PROC)")# 

+              - Initialisiert die Paket-Intern verwendete Farbtabelle auf die

+                standardmäßig für das Endgerät definierten Farben; 

+                wobei die Farben jedoch nicht auf dem Endgerät eingestellt

+                werden. 

+ 

+         1.27 PROC #ib(2," (1.27)")#stdcolors#ie(2," (PROC)")# 

+              (BOOL CONST onoff) 

+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe

+                von 'stdcolors' wirkungslos sind; mit TRUE werden sie entspre-

+                chend wieder aktiviert. 

+#page# 

+#type("pica")##on("u")##ib(1)#Teil 2.2: Operationen zur Graphik-Ausgabe#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+       Die Pakete zur Ausgabe von Graphiken (PICFILES) sind in der Datei

+       'GRAPHIK.Basis' enthalten, und realisieren folgende Leistungen: 

+         - Im Datentyp PICTURE bzw. PICFILE in Codierter Form verwendete Ausgabe-

+           prozeduren auf einzelne Objekte unter Berücksichtigung der Abbil-

+           dungsparameter und Zeichenfläche. 

+         - Kommunikations- und Kontrolloperationen auf die Task 'PLOT' zur

+           indirekten Ausgabe von PICFILES. 

+         - Ausgabeoperationen auf den Datentyp PICTURE bzw. PICFILE unter Be-

+           rücksichtung des eingestellten Endgerätes. 

+      Wird für die Angabe von Koordinaten der Typ REAL verwendet, so handelt es

+      sich um virtuelle Koordinaten, d.h. die Ausgabe-Parameter wie 'viewport' und

+      'window' werden berücksichtigt; bei Verwendung von INT ist die Ausgabe end-

+      gerätspezifisch. 

+ 

+      #ib(1)#2.0 Paket: 'basisplot'#ie(1)# 

+ 

+         2.1 PROC #ib(2," (2.1)")#bar *#ie(2," (PROC)")# 

+              (INT CONST x, y, height, width, pattern) 

+              - Zeichnet an der Position 'x;y' ein Rechteck der Länge/Breite

+                'width/height' mit dem Muster 'pattern', wobei 'x;y' die untere linke

+                Ecke des Rechtecks angibt. 

+                Als 'pattern' z.Zt. implementiert: 

+                                 0 - nicht gefüllt 

+                                 1 - halb gefüllt 

+                                 2 - gefüllt 

+                                 3 - horizontal schraffiert 

+                                 4 - vertikal schraffiert 

+                                 5 - horizontal und vertikal schraffiert 

+                                 6 - diagonal rechts schraffiert 

+                                 7 - diagonal links schraffiert 

+                                 8 - diagonal rechts und links schraffiert 

+ 

+         2.2 PROC #ib(2," (2.2)")#bar *#ie(2," (PROC)")# 

+              (REAL CONST height, width, INT CONST pattern) 

+              - siehe oben, jedoch mit Ausgangspunkt an der aktuellen Zeichen-

+                position, wobei zu beachten ist, daß die x-Koordinate die horizon-

+                tale Position der vertikalen Symmetrieachse des Rechtecks angibt. 

+ 

+         2.3 PROC #ib(2," (2.3)")#beginplot#ie(2," (PROC)")# 

+              - Leitet die graphische Ausgabe ein, wobei das Endgerät in seinen

+                Startzustand versetzt wird, und dem Transformationspaket die

+                Abmessungen der Zeichenfläche mitgeteilt werden. 

+ 

+         2.4 PROC #ib(2," (2.4)")#box *#ie(2," (PROC)")# 

+              - Zeichnet eine Umrahmung der gesamten Zeichenfläche (Nicht nur

+                des verwendeten Teiles). 

+ 

+         2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# 

+              (REAL CONST rad, from, to, INT CONST pattern) 

+              - Zeichnet an aktuellen Position einen Kreis od. ein Kreissegment

+                des Radius 'rad'; beginnend bei 'from' bis zum Endwinkel 'to' und

+                gefüllt mit dem Muster 'pattern' ('pattern' z.Zt. nicht

+                implementiert). 

+ 

+         2.6 PROC #ib(2," (2.6)")#draw *#ie(2," (PROC)")# 

+              (INT CONST x, y) 

+              - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. 

+ 

+         2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# 

+              (INT CONST x0, y0, x1, y1) 

+              - Zieht eine Gerade von der Position 'x0;y0' bis zur Position 'x1;y1'. 

+ 

+         2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# 

+              (REAL CONST x, y, z) 

+              - Zieht von der aktuellen Zeichenposition eine Gerade zur

+                (transformierten) 3-D Position 'x;y;z'. 

+ 

+         2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# 

+              (REAL CONST x, y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# 

+              (TEXT CONST text, REAL CONST angle, height, width) 

+              - Zeichnet den TEXT 'text' ab der aktuellen Zeichenposition unter

+                dem Winkel 'angle' und in der Höhe/Breite 'height;width'. 

+ 

+         2.11 PROC #ib(2," (2.11)")#draw *#ie(2," (PROC)")# 

+              - s.o., jedoch in Standard-Ausrichtung (0 Grad) und

+                Standard-Höhe/Breite (0.5/0.5). 

+ 

+         2.12 PROC #ib(2," (2.12)")#draw cm *#ie(2," (PROC)")# 

+              (REAL CONST x cm, y cm) 

+              - Zeichnet von der aktuellen Position eine Gerade zur cm-Position

+                'x cm;y cm'. 

+ 

+         2.13 PROC #ib(2," (2.13)")#draw cm r *#ie(2," (PROC)")# 

+              (REAL CONST x cm, REAL CONST y cm) 

+              - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'x cm;

+                y cm' verschobenen Zielposition. 

+ 

+         2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# 

+              (REAL CONST dx, dy) 

+              - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'dx;dy'

+                Einheiten verschobenen Zielposition. 

+ 

+         2.15 PROC #ib(2," (2.15)")#draw r *#ie(2," (PROC)")# 

+              (REAL CONST dx, dy, dz) 

+              - Zeichnet von der aktuellen Zeichenposition eine Gerade zur um

+                'dx;dy;dz' Einheiten verschobenen und transformierten 3-D Ziel-

+                position. 

+ 

+         2.16 PROC #ib(2," (2.16)")#hidden lines *#ie(2," (PROC)")# 

+              (BOOL CONST visible) 

+              - Schaltet die vektorisierte Speicherung aller zukünftigen Aus-

+                gabe ein (FALSE) bzw. aus.Ist dieser Modus eingeschaltet, so werden

+                alle durch vorheriges Zeichnen entstandenen Flächen beim Zeichen

+                berücksichtigt, also nicht übermalt; sie 'verdecken' die weiteren

+                Linien. 

+ 

+         2.17 PROC #ib(2," (2.17)")#linetype#ie(2," (PROC)")# 

+              (INT CONST line no, TEXT CONST bitpattern) 

+              - Stellt für den Linientyp 'line no' das Bitmuster 'bitpattern' ein;

+                wobei der 'bitpattern'-TEXT ausschließlich aus den Zeichen '0' und

+                '1' bestehen sollte. 

+ 

+         2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# 

+              (INT CONST x,y) 

+              - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. 

+ 

+         2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# 

+              (REAL CONST x, y, z) 

+              - Zeichnet von der aktuellen Position eine Gerade zur trans-

+                formierten 3-D-Position 'x;y;z' 

+ 

+         2.20 PROC #ib(2," (2.20)")#move *#ie(2," (PROC)")# 

+              (REAL CONST x, y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.21 PROC #ib(2," (2.21)")#move cm#ie(2," (PROC)")# 

+              (REAL CONST x cm, y cm) 

+              - Setzt die aktuelle Zeichenposition auf die cm-Position 'x cm,;y cm'. 

+ 

+         2.22 PROC #ib(2," (2.22)")#move cm r *#ie(2," (PROC)")# 

+              (REAL CONST d x cm, d y cm) 

+              - Zeichnet von der aktuellen Position eine Gerade zur um

+                'd x cm;d y cm' verschobenen Zielposition. 

+ 

+         2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# 

+              (REAL CONST d x, d y, d z) 

+              - Zeichnet von der aktuellen Position eine Gerade zur um 'd x;d y;d z'

+                Einheiten verschobenen und transformierten Zielposition. 

+ 

+         2.24 PROC #ib(2," (2.24)")#move r *#ie(2," (PROC)")# 

+              (REAL CONST d x, d y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.25 PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# 

+              (INT CONST background, foreground, thickness, linetype) 

+              - Aktiviert für alle folgenden Ausgaben mit virtuellen Koordi-

+                naten den Hintergrund 'background'; die Schreibfarbe

+                'foreground'; die Zeichenstärke 'thickness' in 1/10 mm und den

+                Linientyp 'linetype' (i.d.R. 1-6). Vergleiche 'select pen'. 

+ 

+         2.26 PROC #ib(2," (2.26)")#reset *#ie(2," (PROC)")# 

+              - Die mit 'hidden lines (FALSE)' vektorisiert abgespeicherte

+                Ausgabe wird gelöscht. 

+ 

+         2.27 PROC #ib(2," (2.27)")#reset linetypes *#ie(2," (PROC)")# 

+              - Setzt die Linientypen 1-6 auf Standard-Linientypen: 1 - durch-

+                          gängige Linie 

+                          2 - gepunktete Linie 

+                          3 - kurz gestrichelte Linie 

+                          4 - lang gestrichelte Linie 

+                          5 - Strichpunktlinie 

+ 

+         2.28 PROC #ib(2," (2.28)")#reset zeichensatz *#ie(2," (PROC)")# 

+              - Setzt den Zeichensatz auf den Standard-Zeichensatz 'ZEICHENSATZ'. 

+ 

+         2.29 PROC #ib(2," (2.29)")#where *#ie(2," (PROC)")# 

+              (REAL VAR x, y, z) 

+              - Trägt die aktuelle Zeichenposition als (retransformierte) 3-D

+                Position in die übergeben Variablen ein. 

+ 

+         2.30 PROC #ib(2," (2.30)")#where *#ie(2," (PROC)")# 

+              (REAL VAR x, y) 

+              - s.o., jedoch für zweidimensionale Bilder. 

+ 

+         2.31 PROC #ib(2," (2.31)")#zeichensatz *#ie(2," (PROC)")# 

+              (TEXT CONST zeichenname) 

+              - Lädt den Zeichensatz 'zeichenname' zur Verwendung bei Beschrif-

+                tungen. 

+#page# 

+      #ib(1)#3.0 Paket: 'plot interface'#ie(1)# 

+ 

+         3.1 THESAURUS OP #ib(2," (3.1)")#ALL#ie(2," (OP)")# 

+              (PLOTTER CONST plotter) 

+              - Liefert die Namen der z.Zt. im Spool 'plotter' zur indirekten

+                Graphik-Ausgabe gespoolten task-eigenen PICFILES. 

+                Bei Aufruf aus 'GRAPHIK' werden die Namen aller zur Ausgabe

+                gespoolten PICFILES geliefert. 

+ 

+         3.2 PROC #ib(2," (3.2)")#erase#ie(2," (PROC)")# 

+              (TEXT CONST picname, PLOTTER CONST plotter) 

+              - Löscht nach Rückfrage das im Spool 'plotter' zur indirekten

+                Graphik-Ausgabe gespoolte task-eigene PICFILE 'picname'. 

+                Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe

+                gespoolter PICFILES möglich. 

+ 

+         3.3 PROC #ib(2," (3.3)")#erase#ie(2," (PROC)")# 

+              (THESAURUS CONST piclist, PLOTTER CONST plotter) 

+              - Löscht im Dialog alle in 'piclist' und im Spool 'plotter' zur in-

+                direkten Graphik-Ausgabe gespoolten task-eigenen PICFILES. 

+                Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe

+                gespoolter PICFILES möglich. 

+ 

+         3.4 BOOL PROC #ib(2," (3.4)")#exists#ie(2," (PROC)")# 

+              (TEXT CONST picname, PLOTTER CONST plotter) 

+              - Liefert zurück, ob z.Zt. im Spool 'plotter' ein task-eigenes PICFILE

+                'picname' zur indirekten Graphik-Ausgabe gespoolt wird. 

+                Bei Aufruf aus 'GRAPHIK' kann auch die Existenz fremder zur Aus-

+                gabe gespoolter PICFILES erfragt werden. 

+ 

+         3.5 PROC #ib(2," (3.5)")#first#ie(2," (PROC)")# 

+              (TEXT CONST picname, PLOTTER CONST plotter) 

+              - Zieht das im Spool 'plotter' zur indirekten Ausgabe gespoolte

+                PICFILE 'picname' an die erste Stelle der Warteschlange. Der Auf-

+                ruf ist nur aus 'GRAPHIK' zulässig. 

+ 

+         3.6 PROC #ib(2," (3.6)")#generate plotmanager#ie(2," (PROC)")# 

+              - Erzeugt die Task 'PLOT', in der dann im Hintergrund der Plot-

+                manager insertiert wird. Dabei darf 'PLOT' zuvor nicht existieren,

+                und in der Task muß die Datei 'GRAPHIK.Manager' vorhanden sein. 

+ 

+         3.7 PROC #ib(2," (3.7)")#halt#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Unterbindet die weitere indirekte Graphik-Ausgabe aus dem Spool

+                'plotter'; eine aktuell laufende Ausgabe wird jedoch nicht ab-

+                gebrochen. Der Aufruf ist nur aus 'GRAPHIK' zulässig. 

+ 

+         3.8 PROC #ib(2," (3.8)")#list#ie(2," (PROC)")# 

+              (FILE VAR list file, PLOTTER CONST plotter) 

+              - Erzeugt in 'list file' eine Inhalts/Aktivitätsübersicht des Spools

+                'plotter'. 

+ 

+         3.9 PROC #ib(2," (3.9)")#list#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Zeigt eine Inhalts/Aktivitätsübersicht des Spools 'plotter'. 

+ 

+         3.10 THESAURUS PROC #ib(2," (3.10)")#picfiles#ie(2," (PROC)")# 

+              - Liefert eine Liste der Namen aller in der Task enthaltenen

+                PICFILES. 

+ 

+         3.11 PROC #ib(2," (3.11)")#save#ie(2," (PROC)")# 

+              (TEXT CONST picname, PLOTTER CONST plotter) 

+              - Sendet das PICFILE 'picname' zwecks indirekter Graphik-Ausgabe

+                zum Spool 'plotter'. 

+ 

+         3.12 PROC #ib(2," (3.12)")#save#ie(2," (PROC)")# 

+              (THESAURUS CONST piclist, PLOTTER CONST plotter) 

+              - Sendet alle in 'piclist' namentlich enthaltenen PICFILES zwecks

+                indirekter Graphik-Ausgabe zum Spool 'plotter'. 

+ 

+          3.13 PROC #ib(2," (3.13)")#start#ie(2," (PROC)")# 

+               (PLOTTER CONST plotter) 

+               - Nimmt die zuvor mit 'halt','wait for halt','stop' oder spoolseitig

+                 unterbrochene indirekte Graphik-Ausgabe des Spools 'plotter'

+                 wieder auf. Der Aufruf ist nur aus 'GRAPHIK' zulässig. 

+ 

+         3.14 PROC #ib(2," (3.14)")#stop#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Unterbricht sofort die aktuell laufende Ausgabe des Spools

+                'plotter', und unterbindet weitere Ausgaben. Nach Rückfrage wird

+                das PICFILE, das aktuell ausgegeben wurde, erneut an erster

+                Steller der Warteschlange eingetragen. 

+ 

+         3.15 PROC #ib(2," (3.15)")#wait for halt#ie(2," (PROC)")# 

+              (PLOTTER CONST plotter) 

+              - Unterbindet die weitere Ausgabe der

+                gespoolten PICFILES, und wartet bis die aktuell laufende Ausgabe

+                beendet ist. 

+#page# 

+      #ib(1)#4.0 Paket: 'plot'#ie(1)# 

+ 

+         4.1 PROC #ib(2," (4.1)")#plot *#ie(2," (PROC)")# 

+              (PICTURE CONST picture) 

+              - Ausgabe der Objektebene 'picture', unter Verwendung des in

+                'picture' angegebenen Stiftes gemäß seiner aktuellen Einstellung

+                im 'basisplot'.Nur für Direkt-Ausgaben verwendbar. 

+ 

+         4.2 PROC #ib(2," (4.2)")#plot *#ie(2," (PROC)")# 

+              (PICFILE CONST pf) 

+              - Ausgabe des Bildes 'pf' unter vollständiger Berücksichtung der in

+                'pf' mit 'select pen';'window';'viewport' usw. eingestellten

+                Ausgabeparameter. Nur für Direkt-Ausgaben verwendbar. 

+ 

+         4.3 PROC #ib(2," (4.3)")#plot *#ie(2," (PROC)")# 

+              (TEXT CONST picfile name) 

+              - Direkte oder indirekte Ausgabe des Bildes 'picfile name'. 

+                Bei direkter Ausgabe wird obiges 'plot' verwendet; bei indirekter

+                Ausgabe wird das PICFILE an den aktuell eingestellten Spool zur

+                graphischen Ausgabe gesendet. 

+#page# 

+#bottom#

+#right#Seite %

+#end#

+#head#

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Teil 3: Konfigurierung der Graphik

+#type("pica.lq")##free(1.0)#

+#end#

+#type("pica")##on("u")##ib(1)#Teil 3: Konfigurierung der Graphik#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+ 

+#type("pica")##on("u")##ib(1)#Teil 3.1: Der Graphik-Konfigurator#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+#goalpage("newconf")# 

+       Die MPG-EUMEL-Graphik besitzt eine normierte Schnittstelle zu allen graphischen

+       Endgeräten. Diese wird vom Programm 'GRAPHIK.Configurator' aus verschiede-

+       nen Dateien, die einer gewissen Syntax zu genügen haben, zu einem Paket

+       namens 'device interface' zusammengefügt. Diese Dateien enthalten verschie-

+       dene Informationen und endgerätspezifische ELAN-Prozeduren, die zur

+       Erzeugung graphischer Primitiva wie Gerade, Kreis, Rechteck und zur Be-

+       rechnung der konkreten Abbildung graphischer Objekte sowie zur Realisa-

+       tion von Eingaben benötigt werden. Das Konfigurationsprogramm erkennt

+       diese Dateien an der Namensendung '.GCONF', und bietet diese zu

+       Programmbeginn zur Auswahl an. 

+       Dann werden die gewählten Dateien inhaltlich untersucht und die relevan-

+       ten Informationen, Rümpfe der benötigten Prozeduren sowie alle vom Benut-

+       zer zusätzlich eingetragenen globalen Objekte (globale Variablen,

+       LET-Objekte, zusätzlich benötigte Prozeduren usw.) vom Programm extrahiert

+       und zwischengespeichert. 

+       Im letzten Schritt erstellt das Programm schließlich das Paket 'device

+       interface' in der Datei 'GRAPHIK.Configuration', indem die zwischengespei-

+       cherten Texte sinnvoll zusammengefügt werden. 

+       Die benötigten Konfigurationsdateien sind relativ einfach zu erstellen, da

+       sich der Programmierer ausschließlich mit der Realisation der geforderten

+       Leistungen auf einem Endgerät-Typ befassen kann, da die programmseitige

+       Einbindung ins Graphiksystem vom Konfigurationsprogramm vorgenommen

+       wird. 

+#page# 

+#type("pica")##on("u")##ib(1)#Teil 3.2: Erstellung der Konfigurationsdateien#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+      Namensgebung: "<Endgerätname><Kanalangaben>.GCONF" 

+         Konfigurationsdateien zur Anbindung eines Endgerät-Types auf der

+         eigenen Station enthalten die benötigten ELAN-Quelltexte zur Realisa-

+         tion der geforderten Leistungen und weitere Verwaltungs- und Berech-

+         nungsoperationen. 

+         Das Konfigurationsprogramm erkennt die relevanten Daten bzw. Quelltexte

+         dieser Dateien an verschiedenen Pseudo-Schlüsselworten bzw. Pseudo-

+         Prozedurdeklarationen, wobei die Namensgebung hinsichtlich des Pro-

+         zedurnamens, der Parameter sowie ihrer Namen vollständig festgelegt ist. 

+         Daher ist es unzulässig, Parameternamen zu ändern oder Delimiter

+         (Semikolon, Doppelpunkt) fortzulassen. 

+         Derartige Fehler werden jedoch i.d.R. vom Konfigurationsprogramm

+         erkannt und gemeldet, wohingegen Fehler in den Prozedurrümpfen, den

+         zusätzlichen Prozeduren bzw. das Fehlen zusätzlich benötigter Pro-

+         zeduren nicht erkannt, sondern erst beim Compilieren des Gesamt-Paketes

+         vom ELAN-Compiler gemeldet werden. 

+         (Die Korrektur im Gesamt-Paket sollte unterlassen werden, vielmehr ist

+         der Fehler in der entsprechenden Konfigurationsdatei zu beheben, falls

+         nicht einfach die Einbindung eines zusätzlichen Paketes vergessen

+         wurde.) 

+         Zudem ist zu beachten, daß die benötigten Prozedurrümpfe vom Kon-

+         figurationsprogramm in Refinements umgewandelt werden, und zusätz-

+         liche Objekte (Prozeduren, LET-Objekte, Variablen) einfach mit ein-

+         gebunden werden, so daß: 

+          - Globale und lokale Variablen eindeutig für alle! Konfigurations-

+            dateien benannt werden müssen. 

+            (Zweckmässig: ... VAR endgerätname variablenname) 

+          - Zusätzliche Prozeduren und LET-Objekte ebenso eindeutig benannt

+            werden müssen. 

+          - Überflüssige Delimiter, die aber vom ELAN-Compiler nicht bemängelt

+            werden (z.B. Punkt am Ende des Prozedurrumpfes) nicht vorkommen

+            dürfen. 

+          - Nicht realisierbare Pseudo-Prozeduren mit leerem Rumpf enthalten

+            sein müssen (z.B. Vordergrund/Hintergrund od. Farben bei

+            Monochrom-Endgeräten) 

+          - Prozedur-Köpfe bzw. -Enden allein in einer Zeile und an ihrem Anfang

+            stehen müssen. 

+ 

+      Namensgebung: "ENVIRONMENT.GCONF" 

+         Dient zur verwaltungsseitigen Einbindung von Endgeräten anderer

+         Stationen, da für diese Endgeräte nur die Verwaltungsinformationen

+         benötigt werden, weil die konkrete Anpassung auf der anderen Station

+         erfolgt. 

+         Die in 'ENVIRONMENT.GCONF' zeilenweise enthaltenen Informationen werden

+         dem Benutzer bei der Auswahl der Konfigurationsdateien mit angeboten; er

+         kann sie aber auch 'von Hand' in die THESAURUS-Auswahl einfügen. 

+ 

+      Namensgebung: "Dateizweck" (also beliebig) 

+         Darüberhinaus existieren weitere Dateien, die globale Prozeduren und

+         weitere Objekte enthalten, die für verschiedene Endgerät-Anpassungen

+         nützlich sein können, wie z.B. unten beschriebene Dateien: 

+          - 'std primitives' 

+            Enthält Prozeduren zur softwareseitigen Emulation von zwar gefor-

+            derten, hardwareseitig aber eventuell nicht bereitgestellten

+            Leistungen wie 'circle' und 'box'. 

+          - 'matrix printer' 

+            Enthält Prozeduren zur Erzeugung von Geraden und Füllmustern auf

+            einer Bitmatrix, die zur graphischen Ausgabe auf Druckern benötigt

+            wird. 

+          - 'terminal plot' 

+            Enthält grundlegende Prozeduren zur (behelfsmäßigen) Ausgabe von

+            Graphiken auf Ascii-Terminals (Zeichenorientiert, nicht graphikfähig) 

+ 

+      Folgende Pseudo-Schlüsselworte bzw. Pseudo-Prozeduren werden vom

+      Konfigurationsprogramm erkannt und behandelt: 

+ 

+      #ib(1)#1.0 Pseudo-Schlüsselworte#ie(1)# 

+ 

+         1.1 #ib(2," (1.1)")#COLORS#ie(2,"")# 

+              Syntax: COLORS "RGB-Kombinationen"; 

+              - Dient der Definition der Standard-Farben. 

+                - "RGB-Kombinationen":  (TEXT)  Pro Farbe 3-ziffrige RGB-

+                                                (Rot-Grün-Blau)-

+                                                 Kombinationen in normierter

+                                                 Notation 

+                                                (jeder Farbanteil wird durch

+                                                die Ziffern 0-9 dargestellt;

+                                                sollte das Endgerät dieser

+                                                Notation nicht genügen, so ist

+                                                eine anteilige Umrechnung

+                                                vorzunehmen). 

+                                                Die erste RGB-Kombination

+                                                wird für die Hintergrundfarbe

+                                                verwendet (i.d.R. 000), bei

+                                                monochromen Endgeräten ist

+                                                also "000999" einzusetzen. 

+ 

+         1.2 #ib(2," (1.2)")#EDITOR#ie(2,"")# 

+              Syntax: EDITOR; 

+              - Schlüsselwort, das dem Konfigurationsprogramm anzeigt, daß

+                folgende Eingabeprozeduren vorhanden sind: 

+                - 'graphik cursor' 

+                - 'get cursor' 

+                - 'set marker' 

+                Fehlt das Schlüsselwort, so können o.g. Pseudo-Prozeduren weg-

+                gelasssen werden, brauchen also nicht mit leerer Leistung

+                implementiert werden. 

+ 

+         1.3 #ib(2," (1.3)")#INCLUDE#ie(2,"")# 

+              Syntax: INCLUDE "Name der Includedatei"; 

+              - Schlüsselwort, mit dem weitere Dateien in die Konfigurationsdatei

+                textuell eingebunden werden können (s.o). 

+ 

+         1.4 #ib(2," (1.4)")#LINK#ie(2,"")# 

+              Syntax: LINK <Station>/<Kanal>, .... ; 

+              - Dient zur Anbindung mehrerer Endgeräte an einen Endgerät-Typ,

+                die hier genannten Kanäle werden eigenständig verwaltet, aber

+                wie das bei 'PLOTTER' definierte Endgerät angesteuert; wobei für

+                alle Endgeräte der gleiche Name gilt, sie also durch die Kanal-

+                nummer unterschieden werden. 

+                Durch Kommata getrennt, können mit dieser Anweisung beliebig

+                viele Endgeräte zusätzlich angebunden werden. 

+                - <Station>     :  (INT)  Stationsnummer des Endgerätes

+                                          (eigene Station) 

+                - <Kanal>       :  (INT)  Kanalnummer des Endgerätes 

+ 

+         1.5 #ib(2," (1.5)")#PLOTTER#ie(2,"")# 

+              Syntax: PLOTTER "Endgerätname",<Station>,<Kanal>, 

+                              <Xpixel>,<Ypixel>,<Xcm>,<Ycm>; 

+              - Dient zur Erkennung als Endgerät-Konfigurationsdatei, und zur

+                Übergabe der verwaltungsseitig benötigten

+                Endgerät-Spezifikationen: 

+                - "Endgerätname":  (TEXT)  Name des Endgerätes 

+                - <Station>     :  (INT)   Stationsnummer des Endgerätes

+                                           (eigene Station) 

+                - <Kanal>       :  (INT)   Kanalnummer des Endgerätes 

+                Jedes Endgerät wird über diese drei Werte eindeutig identifiziert,

+                der Endgerätname kann also mehrfach verwendet werden. 

+                - <Xpixel>      :  (INT)   X-Rasterkoordinate des letzten

+                                           Pixels in X-Richtung (i.d.R

+                                           adressierbare Pixel - 1) 

+                - <Ypixel>      :  (INT)   Y-Rasterkoordinate des letzten

+                                           Pixels in Y-Richtung (s.o.) 

+                - <Xcm>         :  (REAL)  Breite der Zeichenfläche in cm. 

+                - <Ycm>         :  (REAL)  Höhe der Zeiuchenfläche in cm. 

+                (Möglichst genau ausmessen od. berechnen, um Verzerrungen zu

+                vermeiden) 

+                'PLOTTER' muß als erstes in der Konfigurationsdatei stehen! 

+ 

+      #ib(1)#2.0 Pseudo-Prozeduren#ie(1)# 

+ 

+         2.1 PROC #ib(2," (2.1)")#background#ie(2," (PROC)")# 

+              Syntax: PROC background (INT VAR type): 

+              - Stellt die Hintergrundfarbe 'type' ein. Ist bei monochromen End-

+                geräten mit leerer Leistung zu implementieren.In 'type' ist die

+                tatsächlich eingestellte Hintergrundfarbe angegeben, womit die

+                erbrachte Leistung kontrolliert werden kann. 

+ 

+         2.2 PROC #ib(2," (2.2)")#box#ie(2," (PROC)")# 

+              Syntax: PROC box (INT CONST x1, y1, x2, y2, pattern): 

+              - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken

+                'x1;y1/x2;y2'. Sollte das Endgerät diese Leistung nicht erbringen,

+                so muß 'std box' aus 'std.GCONF' mit gleichen Parametern aufge-

+                rufen werden. 

+                'pattern' als Füllmuster kann endgerätspezifisch implementiert

+                werden, wobei von System nur 'pattern' = 0 verwendet wird, was ein

+                ungefülltes Rechteck anfordert. 

+ 

+         2.3 PROC #ib(2," (2.3)")#circle#ie(2," (PROC)")# 

+              Syntax: PROC circle (INT CONST x, y, rad, from, to): 

+              - Zeichnet einen Kreis oder ein Kreissegment an den Raster-

+                Koordinaten 'x;y', die auch neue Zeichenposition werden. 'rad' gibt

+                den Radius und 'from,to' den Start bzw. Endwinkel im mathematisch

+                positivem Sinne an. 

+                Sollte das Endgerät diese Leistung nicht erbringen, so muß 'std

+                circle' aus 'std.GCONF' mit gleichen Parametern aufgerufen werden. 

+ 

+         2.4 PROC #ib(2," (2.4)")#clear#ie(2," (PROC)")# 

+              Syntax: PROC clear: 

+              - Löscht den Bildschirm bzw. initialisiert das Ausgabe-Raster. 

+                Die Zeichenposition wird '0;0' und die Standardfarben werden

+                eingestellt. 

+ 

+         2.5 PROC #ib(2," (2.5)")#drawto#ie(2," (PROC)")# 

+              Syntax: PROC drawto (INT CONST x, y): 

+              - Zieht von der aktuellen Zeichenposition eine Gerade zu den Ko-

+                ordinaten 'x;y', die Zeichenposition wird entsprechend geändert. 

+ 

+         2.6 PROC #ib(2," (2.6)")#endplot#ie(2," (PROC)")# 

+              Syntax: PROC endplot: 

+              - Schließt die Graphik-Ausgabe auf einem Endgerät ab; evtl. Wechsel

+                in den Text-Modus, ggf. Cursor einschalten. 

+                Bei Terminals sollte der Bildschirm nicht gelöscht werden. 

+ 

+         2.7 PROC #ib(2," (2.7)")#fill#ie(2," (PROC)")# 

+              Syntax: PROC fill (INT CONST x, y, pattern): 

+              - Zusätzliche vom System nicht verwendete Leistung zum Füllen von

+                Polygonen (rundum geschlossen), wobei die genau erbrachte Lei-

+                stung und die Bedingungen endgerätspezifisch sind. 

+ 

+         2.8 PROC #ib(2," (2.8)")#foreground#ie(2," (PROC)")# 

+              Syntax: PROC foreground (INT VAR type): 

+              - Stellt die Vordergrundfarbe 'type' ein. Ist bei monochromen

+                Endgeräten mit leerer Leistung zu implementieren.In 'type' ist die

+                tatsächlich eingestellte Hintergrundfarbe angegeben, womit die

+                erbrachte Leistung kontrolliert werden kann. 

+ 

+         2.9 PROC #ib(2," (2.9)")#get cursor#ie(2," (PROC)")# 

+              Syntax: PROC get cursor (INT VAR x, y, TEXT VAR exit char): 

+              - Wartet auf eine Eingabe vom Endgerät, wobei der Cursor beweglich

+                bleiben muß. Wird eine Taste gedrückt, so wird deren Code in 'exit

+                char' und die aktuelle Position des Cursors in 'x;y' eingetragen. 

+                Der Cursor sollte nur innerhalb dieser Prozedur beweglich sein,

+                aber immer sichtbar bleiben (falls er eingeschaltet ist). 

+ 

+         2.10 PROC #ib(2," (2.10)")#graphik cursor#ie(2," (PROC)")# 

+              Syntax: PROC graphik cursor (INT CONST x, y, BOOL CONST on): 

+              - Schaltet einen endgerätseitig vorhandenen graphischen Cursor

+                (i.d.R Fadenkreuz) ein oder aus bzw. setzt ihn auf eine bestimmte

+                Position. 

+                Mit 'on' = TRUE wird der Cursor dauerhaft! eingeschaltet bzw. neu

+                positioniert, falls er bereits eingeschaltet war. 

+                Mit 'on' = FALSE wird er grundsätzlich abgeschaltet. 

+                Durch Einschalten des Cursors wird die Wirkung von 'home'

+                verändert: 

+                           normal - 'home' positioniert die Zeichenposition auf

+                                     '0;0' 

+                           cursor - 'home' positioniert die Zeichenposition und

+                                    den graphischen Cursor auf die Mitte der

+                                    Zeichenfläche. 

+ 

+         2.11 PROC #ib(2," (2.11)")#home#ie(2," (PROC)")# 

+              Syntax: PROC home: 

+              - Die Zeichenposition wird auf '0;0' eingestellt; ist ein graphischer

+                Cursor eingeschaltet, so sollte dieser, sowie die Zeichenposition,

+                jedoch auf den Mittelpunkt der Zeichenfläche gesetzt werden. 

+ 

+         2.12 PROC #ib(2," (2.12)")#initplot#ie(2," (PROC)")# 

+              Syntax: PROC initplot: 

+              - Bereitet die Graphik-Ausgabe auf einem Endgerät vor; evtl.

+                Wechsel in den Graphik-Modus, ggf. Cursor abschalten. 

+                Bei Terminals sollte der Bildschirm nicht gelöscht werden. 

+ 

+         2.13 PROC #ib(2," (2.13)")#moveto#ie(2," (PROC)")# 

+              Syntax: PROC moveto (INT CONST x, y): 

+              - Die Zeichenposition wird auf die Koordinaten 'x;y' gesetzt, bei

+                Überschreitung der Zeichenfläche ist die Wirkung undefiniert. 

+ 

+         2.14 PROC #ib(2," (2.14)")#prepare#ie(2," (PROC)")# 

+              Syntax: PROC prepare: 

+              - Bereitet die Ausgabe auf einem Kanal vor. 

+                Die eigene Task sollte an den Kanal angekoppelt, und andere Tasks

+                ggf. am Ankoppeln gehindert bzw. abgekoppelt werden (z.B. der

+                PRINTER-Server bei Drucker-Graphik). Es darf erst nach erfolg-

+                reichem Abschluß der Aktion zurückgekehrt werden. 

+ 

+         2.15 PROC #ib(2," (2.15)")#set marker#ie(2," (PROC)")# 

+              Syntax: PROC set marker (INT CONST x, y, type): 

+              - Zeichnet an der Position 'x;y', die auch neue Zeichenposition wird,

+                eine Markierung. Folgende Markierungsarten können systemseitig

+                verwendet werden: 

+                                 0 - Kreuz '+' 

+                                 1 - Kreuz diagonal 'x' 

+                Weitere Typen können endgerätspezifisch implementiert werden. 

+ 

+         2.16 PROC #ib(2," (2.16)")#setpalette#ie(2," (PROC)")# 

+              Syntax: PROC setpalette: 

+              - Stellt die aktuell eingestellten RGB-Kombinationen auf dem End-

+                gerät ein. Dazu sind die vom Konfigurationsprogramm

+                hinzugefügten Prozeduren 'colors' und 'color' zu verwenden: 

+                   INT PROC colors 

+                   - Liefert die Anzahl der für das Endgerät möglichen Farben

+                     (abgeleitet aus den mit 'COLOR' angebenen

+                     Standard-Kombinationen). 

+                   INT PROC color (INT CONST no) 

+                   - Liefert die normierte RGB-Kombination der für 'no' ein-

+                     gestellten Farbe (0 - 999). Die Rückgabe von 'maxint' (32767)

+                     bedeutet: Farbe nicht initialisiert oder existiert nicht. 

+ 

+         2.17 PROC #ib(2," (2.17)")#setpixel#ie(2," (PROC)")# 

+              Syntax: PROC setpixel (INT CONST x, y): 

+              - Setzt ein Pixel an den Raster-Koordinaten 'x;y'. 

+#page# 

+#bottom#

+#right#Seite %

+#end#

+#head#

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Teil 4: Graphik-Applikationen

+#type("pica.lq")##free(1.0)#

+#end#

+#type("pica")##on("u")##ib(1)#Teil 4: Graphik-Applikationen#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+ 

+#type("pica")##on("u")##ib(1)#Teil 4.1: Der Funktionenplotter 'FKT'#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+      Mit diesem Programmpaket kann man für beliebige reelle und reellwertige

+      Funktionen Graphen erstellen. Diese Graphen werden im System gespeichert. 

+ 

+      Zur Ausgabe der erstellten Graphen stehen alle graphikfähigen Endgeräte

+      zur Verfügung. 

+ 

+      #ib(1)#1.0 Allgemeines über FKT#ie(1)# 

+           Zu einer Zeichnung, wie sie mit 'FKT' erstellt werden kann, gehören

+           folgende Eigenschaften: 

+              - Der Name der Zeichnung (zum Wiederfinden) 

+              - Das Format 

+              - Der Graph mit den Achsen bzw. dem Rahmen. 

+ 

+           Es können beliebig viele Zeichnungen angelegt und aufbewahrt werden,

+           wobei der Name aller Zeichnungen mit "PICFILE." beginnt. 

+ 

+           Es wird von FKT zwischen den Definitions- und Wertebereich einerseits

+           und dem Format anderseits unterschieden: 

+              - Der Definitionsbereich wird vom Benutzer gewählt. Er gibt das

+                Intervall an, über dem der Graph gezeichnet wird. Der

+                Wertebereich wird vom Rechner automatisch ermittelt. 

+              - Das Format besteht aus der Angabe von vier Werten, die Auskunft

+                geben über die maximale Ausdehnung der Koordinatenachsen, wobei

+                die Zeichnung auf den Endgeräten stets so abgebildet wird, daß sie

+                unverzerrt in maximaler Größe (also im größtmöglichen Quadrat)

+                gezeichnet wird. 

+ 

+           Der Funktionenplotter FKT ist in allen Sohntasks von 'GRAPHIK' verfüg-

+           bar, zusätzlich existiert die Task 'FKT', in der das FKT-Menue als

+           Kommandoebene verwendet wird. 

+ 

+      #ib(1)#2.0 Das FKT-Menue#ie(1)# 

+           Das Menue des Funktionenplotters ist wie folgt aufgebaut: 

+           - in der obersten Zeile wird der eingegebene Funktionsterm angezeigt 

+           - die nachfolgende Zeile zeigt in eckigen Klammern den Definitions-

+             bereich und die Schachtelung des Intervalles, über dem der Graph

+             gezeichnet wird. 

+           - dann folgt ebenfalls in eckigen Klammern der von FKT selbst zu

+             ermittelnde Wertebereich der Funktion innerhalb des zuvor

+             definierten Intervalles. 

+           Wird kein Funktionsterm angezeigt, oder erscheinen in den eckigen

+           Klammern Sternchen, so wurde noch kein Funktionsterm bzw.

+           Definitionsbereich eingegeben, oder der Wertebereich noch nicht

+           ermittelt. 

+           - Der Bereich zwischen o.g Anzeige und der Auflistung der Menuepunkte

+             ist der Dialogbereich, in dem weitere Anfragen an den Benutzer oder

+             auch Fehlermeldungen erscheinen. 

+           - Unterhalb der Bildschirmmitte werden die unten beschriebenen

+             Menuepunkte zur Auswahl aufgeführt. 

+           - Dann folgt der Endgerät-Auswahlbereich, das Endgerät, auf dem eine

+             Zeichnung ausgegeben werden soll, kann mit den Tasten 'Links' bzw.

+             'Rechts' eingestellt werden, wobei der Name des aktuell eingestellten

+             Endgerätes invertiert erscheint. 

+           - Als unterste Zeile der FKT-Tapete folgt der Eingabebereich, hier wird

+             der Benutzer zur Eingabe eines bei den Menuepunkten genannten

+             Buchstabens aufgefordert, und dieser bei einem zulässigen

+             Tastendruck dort angezeigt. 

+ 

+      #ib(1)#3.0 FKT-Menuepunkte#ie(1)# 

+ 

+         Jede Eingabe oder Operation kann durch Drücken der Taste 'ESC'

+         abgebrochen werden, die Eingabe wird dann ignoriert, und im Dialog-

+         bereich erscheint die Fehlermeldung 'F E H L E R : Abgebrochen'. 

+ 

+         3.1 #ib(2," (3.1)")#(f) Funktionsterm eingeben#ie(2,"")# 

+             Im Dialogbereich wird die Eingabe des Funktionsterms erwartet, wobei

+             als Variable im Term 'x' verwendet werden muß. 

+             Es stehen alle mathematischen Funktionen des EUMEL-Systems zur

+             Verfügung, sofern sie reelle Werte (REAL) zurückliefern. 

+             Beispiele von Funktionstermen (alternative Möglichkeiten in eckigen,

+             Erklärungen in runden Klammern): 

+ 

+               2*x 

+               [2x] 

+               2x*x + 3x - 5 

+               [2.0*x*x + 3.0*x - 5.0] 

+               0.7 * sqrt (x)                   (sqrt  : Quadratwurzel aus) 

+               log10 (x)                        (log10 : 10-er Logar.) 

+               ln (3x)                          (ln    : Nat. Logar.) 

+               2**x                             (**    : Potenzieren) 

+               exp (1/x) 

+               [e**(1/x)]                       (exp   : Expon.Fktn) 

+               arctan (pi*x)                    (arctan: arkus tangens ) 

+               sin (x)                          (sin   : Sinus in Radiant ) 

+               sind (x)                         (sind  : Sinus in Altgrad ) 

+               1/(x*x+1) 

+ 

+            Die Klammern dürfen dabei NICHT weggelassen werden, es sind nur

+            runde Klammern zulässig, auch geschachtelt, wie z.B. in: 

+ 

+               log10 (abs (sin (x) + 5))        (abs   : Absolutbetrag ) 

+ 

+            Ein Dezimalkomma gibt es nicht, sondern nur den Dezimalpunkt. 

+ 

+            Beispiele von abschnittsweise definierten Funktionen: 

+ 

+               IF x < 5 THEN x*x ELSE sqrt (x - 5) END IF 

+               IF x = 0 THEN 0 ELSE 1/x END IF 

+               IF x < 0 THEN x ELIF x = 0 THEN 1 ELSE x*x END IF 

+ 

+            Die sog. Schlüsselworte "IF" "THEN" "ELIF" "ELSE" "END IF" müssen

+            dabei immer in der angegebenen Form (alle, in der angegebenen Reihen-

+            folge, vollständig aus Großbuchstaben) auftauchen. 

+ 

+               IF --+--> THEN --+--> ELSE --> END IF 

+                    |           | 

+                    |           | 

+                    +--- ELIF --+ 

+ 

+ 

+            Es können bei IF auch mehrere Bedingungen mit logischem OR oder AND

+            verknüpft werden: 

+ 

+               IF x <= 0  OR  x > 100 THEN 0 ELSE x*x END IF 

+ 

+            Hat die Funktion eine Definitionslücke an einer bereits bekannten

+            Stelle, so kann dies im Term auf folgende Art berücksichtigt werden,

+            z.B.: 

+ 

+               IF x = 0 THEN luecke ELSE 1/x END IF 

+               IF x < -0.05 THEN -1/x ELIF x > 0.05 THEN 1/x ELSE luecke END IF 

+ 

+            Taucht eine unvorhergesehene Definitionslücke auf, so wird beim

+            Erstellen des Wertebereichs eine entspr. Fehlermeldung ausgegeben.

+            Dann muß entweder der Funktionsterm durch Fallunterscheidung (s.o.)

+            angepaßt, oder der Definitionsbereich geändert werden. 

+ 

+            Graphen mit Definitionslücken können auch in zwei oder mehr Teilen

+            erstellt werden, nämlich jeweils über den zusammenhängenden

+            Definitionsintervallen, die keine Lücke enthalten. Dazu muß jeweils

+            die Zeichnung ergänzt (siehe '(z) Zeichnung anfertigen') werden. 

+ 

+    Fehlerquelle: Der Funktionsterm ist fehlerhaft. 

+                  Es tauchen z.B. dem Rechner unbekannte Operationen auf,

+                  Multiplikationszeichen fehlen, andere Symbole als 'x' wurden

+                  für die Variable benutzt, 'END IF' fehlt o.ä. 

+ 

+         3.2 #ib(2," (3.2)")#(d) Definitionsbereich waehlen#ie(2,"")# 

+            Im Dialogbereich wird die Eingabe von Unter- und Obergrenze erwartet,

+            wobei Untergrenze < Obergrenze gilt, ansonsten wird die Eingabe der

+            Obergrenze nochmals gefordert. 

+            Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte

+            Genauigkeit zu groß und sollte umgewählt werden. 

+ 

+            Fehlerquelle: Der Funktionsterm ist noch nicht vorhanden. 

+ 

+         3.3 #ib(2," (3.3)")#(w) Wertebereich ermitteln lassen#ie(2,"")# 

+             Es werden automatisch der größte und kleinste Funktionswert

+             ermittelt, also die tatsächlichen Grenzen des Wertebereichs. 

+             Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte

+             Genauigkeit zu groß und sollte umgewählt werden. 

+ 

+         3.4 #ib(2," (3.4)")#(z) Zeichnung anfertigen#ie(2,"")# 

+             Eine Zeichnung kann auf allen zur Verfügung stehenden Geräten

+             ausgegeben werden, wenn sie erzeugt ist. 

+             Mit diesem Menuepunkt werden die Zeichnungen nur erstellt, d.h. der

+             Graph erscheint noch nicht auf einem Ausgabegerät. 

+             Diese Zeichnungen werden dann im System aufbewahrt und können

+             somit mehrfach ausgegeben werden. 

+ 

+             Im Dialogbereich wird zunächst der Name der Zeichnung angefordert,

+             dieser beginnt grundsätzlich mit dem Prefix 'PICFILE.', das nicht

+             verändert werden kann. 

+             Dabei wird als Ergänzung des Namens der Funktionsterm angeboten, so

+             daß die Zeichnung z.B. 'PICFILE.sin(x)' heißt. 

+             Dieser Teil des Namens kann aber frei verändert werden. 

+             Existiert bereits eine Zeichnung gleichen Namens, so erscheint im

+             Dialogbereich eine Anfrage, wie verfahren werden soll, wobei

+             folgende Möglichkeiten genannt werden: 

+ 

+             - <l> :  Die alte Zeichnung wird gelöscht. 

+             - <n> :  Der Name wird erneut zur Änderung angeboten. 

+             - <e> :  Die neue Zeichnung, welche hiernach erstellt wird, wird an die

+                      schon existierende Zeichnung angahängt. Dies ist vorteil-

+                      haft, wenn mehrere od. abschnittsweise definierte Graphen

+                      auf in eine Zeichnung kommen sollen. 

+             Die Eingabe anderer Buchstaben wird ignoriert. 

+ 

+             Ansonsten wird eine Zeichnung erstellt, die unter dem eingegebenen

+             Namen abgelegt wird. 

+ 

+             Danach wird im Dialogbereich erfragt, ob und wie das Format der

+             Zeichnung geändert werden soll. 

+             Nachdem die Zeichnung erstellt wurde, was durch den

+             Stützpunkt-Zähler angezeigt wird, muß noch die Farbe, in der der

+             Graph gezeichnet werden soll eingegeben werden. 

+ 

+             Fehlerquelle: Wertebereich ist noch nicht bestimmt (siehe 4). 

+                           Unzuläessiges Format:  ymax ist kleiner oder gleich

+                                                  ymin, bzw. xmax ist kleiner

+                                                  oder gleich xmin. 

+ 

+         3.5 #ib(2," (3.5)")#(a) Ausgabe der Zeichnung auf Endgerät#ie(2,"")# 

+             Im Dialogbereich wird der Name der auszugebenden Zeichnung erfragt,

+             wobei die zuletzt bearbeitete Zeichnung angeboten wird. 

+             Die Wahl von '?' als Namen der Zeichnung ('PICFILE.?') führt zu einer

+             Auswahl aller vorhanden Bilder, von denen eines zur Ausgabe

+             ausgewählt werden kann. 

+             Danach kann wie oben nochmals das Format variiert werden. 

+             Dann wird im Dialogbereich die Überschrift der Zeichnung erfragt,

+             wobei der Funktionsterm angeboten wird. Die Überschrift erscheint

+             zentriert am oberen Rand. 

+             Je nach Lage des Ursprungs (innerhalb od. außerhalb der Zeichnung)

+             kann die Ausgabe mit Koordinatensystem od. mit Rahmen gewählt

+             werden, liegt der Ursprung nicht innerhalb der Zeichnung, so wird

+             grundsätzlich der Rahmen verwendet. 

+             Zum Abschluß wird dann die Farbgebung von Koordinatensystem bzw.

+             Rahmen sowie der Überschrift erfragt, dann wird die Zeichnung auf

+             dem im unteren Teil eingestelltem Endgerät ausgegeben. 

+ 

+         3.6 #ib(2," (3.6)")#(t) Wertetafel erstellen lassen#ie(2,"")# 

+             In dem gewählten Definitionsbereich kann eine Wertetafel erstellt

+             werden, die in einer von Ihnen gewünschten Schrittweite ermittelte

+             Funktionswerte zeigt. 

+             Zunächst wird die Schrittweite erfragt, dann die von FKT formatiert

+             erstellte Wertetafel gezeigt. 

+             Diese befindet sich in einer Datei, die den Namen des zugehörigen

+             Funktionsterms trägt, existiert diese bereits, so wird die Wertetafel

+             ergänzt. 

+             Enthält diese Tafel Sterne, so müssen Sie die Genauigkeit umwählen

+             und die Tafel neu erstellen lassen. 

+             Nach Verlassen der Anzeige wird noch gefragt, ob die Wertetafel

+             gedruckt, und ob sie aufbewahrt werden soll. 

+ 

+             Fehlerquelle: Definitionsbereich bzw. Funktionsterm ist noch nicht

+                           gewählt. 

+                           Die Schrittweite wurde zu klein gewählt. Sie muß so

+                           groß sein, daß nicht mehr als 512 Werte zu berechnen

+                           sind. 

+ 

+         3.7 #ib(2," (3.7)")#(l) Zeichnungen auflisten#ie(2,"")# 

+             Es wird eine Namesliste aller vorhandenen Zeichnungen gezeigt. 

+ 

+         3.8 #ib(2," (3.8)")#(?) Hilfestellung#ie(2,"")# 

+             Es wird eine Kurzanleitung gezeigt. 

+ 

+         3.9 #ib(2," (3.9)")#(q) in die Kommandoebene zurück#ie(2,"")# 

+             Die Arbeit mit dem Funktionsplotter wird beendet, in normalen Tasks

+             erscheint die Ebene, aus der 'FKT' mit 'fktplot' aufgerufen wurde. 

+             Wird die Task 'FKT' mit 'q' verlassen, so wird dagegen die Task

+             abgekoppelt und alle in ihr enthaltenen Zeichnungen gelöscht! 

+ 

+         3.10 #ib(2," (3.10)")#(s) Anzahl der Stützpunkte waehlen#ie(2,"")# 

+             Bei der Ermittlung des Wertebereiches und beim Erstellen des Funk-

+             tionsgraphen ist es wegen der Endlichkeit des Computers nicht mög-

+             lich, alle Punkte des Definitionsbereiches zu benutzen. Deshalb wird

+             der Definitionsbereich diskretisiert, d.h. es wird eine endliche An-

+             zahl von Stützpunkten ausgesucht. Diese Stützpunkte liegen gleich-

+             verteilt über dem Definitionsbereich. Die Mindestanzahl ist 2, d.h. als

+             Stützpunkte werden nur die beiden Randwerte zugelassen. Aus

+             technischen Gründen ist die Höchstgrenze 512. 

+ 

+             Fehlerquelle: Zahl der Stützpunkte ist fehlerhaft. 

+                           Nur ganze Zahlen aus dem Intervall [2;512] zulässig. 

+ 

+         3.11 #ib(2," (3.11)")#(n) Nachkommastellenzahl wählen#ie(2,"")# 

+             Hier kann die Zahl der angezeigten Nachkommastellen eingestellt

+             werden (intern wird immer höchstmögliche Genauigkeit verwendet). 

+             Maximal sind neun Nachkommastellen zulässigt, jedoch kann die

+             Genauigkeit zu groß für das Anzeigeformat werden; dann erscheinen

+             in der Anzeige Sterne (*************). 

+             Es gilt grundsätzlich: 

+                  Anzahl Vorkommastellen + Anz. Nachkommastellen = 12. 

+ 

+         3.12 #ib(2," (3.12)")#(e) Arbeit beenden#ie(2,"")# 

+             Die Arbeit mit 'FKT' wird abgeschlossen, die Task vom Terminal

+             abgekoppelt. Für jede Task bleibt dabei FKT das laufende Programm,

+             d.h. nach erneutem Ankoppeln erscheint wieder die FKT-Tapete. In der

+             Task FKT bleiben die Zeichnungen bei Verlassen mit 'e' erhalten (im

+             Gegensatz zum Verlassen mit 'q'). 

+ 

+         3.13 #ib(2," (3.13)")#(L) Zeichnungen loeschen#ie(2,"")# 

+             Es erscheint eine Namensliste aller in der Task enthaltenen

+             Zeichnungen. Die dann ausgewählten Zeichnungen werden nach noch-

+             maliger Rückfrage gelöscht. 

+ 

+         3.14 #ib(2," (3.14)")#(A) Zeichnungen archivieren#ie(2,"")# 

+             Nach Aufruf dieses Menuepunktes können Zeichnungen zu anderen

+             Tasks geschickt, oder auch auf Diskette geschrieben werden. 

+             Dazu wird der MPG-Dateimanager 'dm' verwendet. 

+ 

+         3.15 #ib(2," (3.15)")#(b) Zeichnungen beschriften#ie(2,"")# 

+             Mit diesem Menuepunkt können Zeichnungen frei beschriftet werden. 

+             Zunächst wird im Dialogbereich erfragt, wie mit bereits bestehenden

+             Beschriftungen verfahren werden soll: 

+ 

+             - <e> :  Die nachfolgenden Texte werden zusätzlich zu den schon

+                      vorhandenen Beschriftungen angefügt. 

+             - <l> :  Die vorhandenen Beschriftungen werden gelöscht, und es wird

+                      zum Menue zurückgekehrt. 

+             - <a> :  Die Operation wird abgebrochen. 

+ 

+            Nun wird die Farbgebung aller Beschriftungen erfragt, 

+            danach wird das aktuelle Format der Zeichnung gezeigt, was bei der

+            Positionierung hilfreich sein kann. 

+            Nach der nun geforderten Eingabe des Beschriftungstextes wird die

+            Positionierung der Beschriftung in zwei Weisen angeboten: 

+            - in cm  :  Die nachfolgend einzugebenden Werte werden als

+                        cm-Angabe relativ zur unteren linken Ecke der Zeichnung

+                        aufgefaßt. 

+            - in REAL:  Die nachfolgend einzugebenden Werte werden als

+                        Koordinatenangabe im Koordinatensystem der erstellten

+                        Zeichnung aufgefaßt ('0;0' demnach im Ursprung) Nach

+            Eingabe o.g. Werte wird noch die Texthöhe und Breite erfragt, wobei die

+            eingegebenen Werte als mm-Angaben aufgefäßt werden (Standard: 5 * 5

+            mm). 

+            Anschließend wird erfragt, ob noch weitere Beschriftungen

+            vorgenommen werden sollen. 

+ 

+            Fehlerquelle: Zeichnung existiert nicht. 

+#page# 

+ 

+#type("pica")##on("u")##ib(1)#Teil 4.2: Die TURTLE-Graphik#ie(1)##off("u")##type("prop.lq")#

+#free(0.5)#

+ 

+      Die TURTLE-Graphik bietet die Möglichkeit, sehr einfach zweidimensionale

+      Zeichnungen zu erstellen. Sie basiert auf dem in LOGO verwendeten Modell, in

+      dem eine Zeichenposition in jeweils eine bestimmte Richtung vorwärts bzw.

+      rückwärts bewegt werden kann, und die Zeichenrichtung verändert werden

+      kann.Bei den Bewegungen, die vornehmlich relativ zur alten Position bzw.

+      Zeichenrichtung ausgeführt werden, kann dann eine Linie hinterlassen

+      werden. Diese Art der Graphik eignet sich insbesondere für Programm-

+      gesteuerte Zeichnungen, wie z.B. die rekursiven 'Sierpinski' - bzw. 'Hilbert'-

+      "Funktionen". 

+ 

+     Die Koordinaten bewegen sich im Intervall von [-500.0,500.0]. 

+     (0,0) liegt dabei in der Bildschirmmitte und ist auch die Anfangsposition.

+     Der Anfangswinkel ist 0. Winkel werden in Grad angegeben. 

+ 

+     #ib(1)#1.0 Paket: 'turtlegraphics'#ie(1)# 

+ 

+         1.1 REAL PROC #ib(2," (1.1)")#angle#ie(2," (PROC)")# 

+              - liefert den momentanen Winkel zwischen Zeichenrichtung und

+                X-Achse. 

+ 

+         1.2 PROC #ib(2," (1.2)")#turnto#ie(2," (PROC)")# 

+              (REAL CONST w) 

+              - Die Zeichenrichtung wird absolut auf den Winkel 'w' als Winkel

+                zwischen Zeichenrichtung und X-Achse eingestellt. 

+ 

+         1.3 PROC #ib(2," (1.3)")#forward#ie(2," (PROC)")# 

+              (REAL CONST s) 

+              - Die Zeichenposition wird in Zeichenrichtung um die Strecke 's'

+                verschoben, wobei ggf. gezeichnet wird. 

+ 

+         1.4 PROC #ib(2," (1.4)")#penup#ie(2," (PROC)")# 

+              - Der Zeichenstift wird abgehoben, Bewegungen erzeugen keine

+                Linien mehr. 

+ 

+         1.5 PROC #ib(2," (1.5)")#forward to#ie(2," (PROC)")# 

+              (REAL CONST x,y) 

+              - Die Zeichenposition wird absolut auf die Position 'x;y' gesetzt, die

+                Zeichenrichtung wird nicht verändert. 

+ 

+         1.6 PROC #ib(2," (1.6)")#endturtle#ie(2," (PROC)")# 

+              - Wurde die Graphik im Direktmodus ('begin turtle' ohne Parameter),

+                also auch sofort sichtbar erzeugt, so wird die Graphikausgabe in

+                üblicher Weise beendet, sonst nunmehr das erzeugte PICFILE

+                ausgegeben. 

+ 

+         1.7 PROC #ib(2," (1.7)")#pendown#ie(2," (PROC)")# 

+              - Der Zeichenstift wird gesenkt, Bewegungen erzeugen Linien. 

+ 

+         1.8 PROC #ib(2," (1.8)")#beginturtle#ie(2," (PROC)")# 

+              (TEXT CONST picfile name) 

+              - öffnet ein PICFILE 'picfile name', in das alle Aktionen eingetragen

+                werden. Auf dem Bildschirm geschieht nichts. Ist das Picfile schon

+                vorhanden, werden die Aktionen hinzugefügt. 

+ 

+         1.9 PROC #ib(2," (1.9)")#beginturtle#ie(2," (PROC)")# 

+              - Leitet die direkte graphische Ausgabe einer TURTLE-Graphik ein,

+                alle Aktionen werden sofort auf dem Bildschirm sichtbar. 

+ 

+         1.10 PROC #ib(2," (1.10)")#turn#ie(2," (PROC)")# 

+              (REAL CONST w) 

+              - Dreht die Zeichenposition um 'w'-Grad im mathematisch positiven

+                Sinne. 

+ 

+         1.11 BOOL PROC #ib(2," (1.11)")#pen#ie(2," (PROC)")# 

+              - Liefert zurück, ob der Zeichenstift oben (FALSE) oder unten (TRUE)

+                ist, also ob Bewegungen Linien hervorrufen oder nicht. 

+ 

+         1.12 PROC #ib(2," (1.12)")#getturtle#ie(2," (PROC)")# 

+              - In die übergebenen Variablen wird die aktuelle Zeichenposition

+                absolut eingetragen. 

+#page# 

+      Diese Dokumentation und die einzelnen Programme wurden mit größtmöglicher

+      Sorgfalt erstellt bzw. weiterentwickelt. 

+      Dennoch kann keine Fehlerfreiheit garantiert oder die Haftung für evtl. aus

+      Fehlern resultierende Folgen übernommen werden. 

+      Für Hinweise auf Fehler sind die Autoren stets dankbar. 

+#page# 

+#bottom off#

+#head#

+#type("prop")##center#Dokumentation des MPG-Graphik-Systems

+#type("8.5.klein")##center#Stichwortverzeichnis

+#type("pica.lq")##free(1.0)#

+#end#

+#type("pica")##on("u")##ib(1)#Stichwortverzeichnis#ie(1)##off("u")##type("prop.lq")# 

+#free(0.5)#

+(a) Ausgabe der Zeichnung auf Endgerät ...........  41 (3.5) 

+actual plotter (PROC) ............................  17 (4.4) 

+ALL (OP) .........................................  27 (3.1) 

+angle (PROC) .....................................  44 (1.1) 

+(A) Zeichnungen archivieren ......................  42 (3.14) 

+background * (PROC) ..............................  13 (3.4), 13 (3.5), 19 (1.1),

+                                                    19 (1.2), 34 (2.1) 

+bar * (PROC) .....................................  8 (2.3), 23 (2.1), 23 (2.2) 

+beginplot (PROC) .................................  23 (2.3) 

+beginturtle (PROC) ...............................  45 (1.9), 45 (1.8) 

+box (PROC) .......................................  19 (1.3), 23 (2.4), 34 (2.2) 

+(b) Zeichnungen beschriften ......................  42 (3.15) 

+CAT * (OP) .......................................  8 (2.4) 

+channel (PROC) ...................................  17 (4.5) 

+circle (PROC) ....................................  8 (2.5), 19 (1.4), 24 (2.5),

+                                                    34 (2.3) 

+clear (PROC) .....................................  19 (1.5), 19 (1.6), 34 (2.4) 

+clearspool .......................................  3 (2.2) 

+clippedline (PROC) ...............................  5 (1.1) 

+color (PROC) .....................................  19 (1.7) 

+COLORS ...........................................  32 (1.1) 

+colors (PROC) ....................................  20 (1.8) 

+(d) Definitionsbereich waehlen ...................  39 (3.2) 

+delete picture * (PROC) ..........................  13 (3.6) 

+dim * (PROC) .....................................  8 (2.6) 

+down * (PROC) ....................................  13 (3.7), 13 (3.8) 

+draw cm * (PROC) .................................  9 (2.11), 24 (2.12) 

+draw cm r * (PROC) ...............................  9 (2.12), 24 (2.13) 

+drawingarea * (PROC) .............................  5 (1.2), 17 (4.6), 17 (4.7) 

+draw * (PROC) ....................................  8 (2.8), 8 (2.7), 9 (2.10),

+                                                    9 (2.9), 24 (2.6), 24 (2.9),

+                                                    24 (2.8), 24 (2.7), 24 (2.11),

+                                                    24 (2.10) 

+draw r * (PROC) ..................................  9 (2.13), 9 (2.14), 24 (2.14),

+                                                    25 (2.15) 

+drawto (PROC) ....................................  20 (1.9), 34 (2.5) 

+(e) Arbeit beenden ...............................  42 (3.12) 

+EDITOR ...........................................  33 (1.2) 

+end plot (PROC) ..................................  20 (1.10), 20 (1.11), 34 (2.6) 

+endturtle (PROC) .................................  44 (1.6) 

+eof * (PROC) .....................................  13 (3.9) 

+erase (PROC) .....................................  27 (3.3), 27 (3.2) 

+exists (PROC) ....................................  27 (3.4) 

+extrema * (PROC) .................................  9 (2.16), 9 (2.15), 13 (3.11),

+                                                    13 (3.10) 

+(f) Funktionsterm eingeben .......................  38 (3.1) 

+fill (PROC) ......................................  20 (1.12), 34 (2.7) 

+first ............................................  4 (2.9) 

+first (PROC) .....................................  27 (3.5) 

+foreground (PROC) ................................  20 (1.14), 20 (1.13), 35 (2.8) 

+forward (PROC) ...................................  44 (1.3) 

+forward to (PROC) ................................  44 (1.5) 

+generate plotmanager (PROC) ......................  27 (3.6) 

+get cursor (PROC) ................................  20 (1.15), 35 (2.9) 

+get * (PROC) .....................................  14 (3.12) 

+getturtle (PROC) .................................  45 (1.12) 

+getvalues (PROC) .................................  5 (1.3), 14 (3.13) 

+graphik cursor (PROC) ............................  20 (1.16), 21 (1.17), 35 (2.10) 

+halt .............................................  4 (2.6) 

+halt (PROC) ......................................  27 (3.7) 

+hidden lines * (PROC) ............................  25 (2.16) 

+(?) Hilfestellung ................................  41 (3.8) 

+home (PROC) ......................................  21 (1.18), 35 (2.11) 

+INCLUDE ..........................................  33 (1.3) 

+init plot (PROC) .................................  21 (1.19), 35 (2.12) 

+insert picture * (PROC) ..........................  14 (3.14) 

+install plotter (PROC) ...........................  17 (4.8) 

+is first picture * (PROC) ........................  14 (3.15) 

+killer ...........................................  4 (2.8) 

+length * (PROC) ..................................  9 (2.17) 

+linetype (PROC) ..................................  25 (2.17) 

+LINK .............................................  33 (1.4) 

+list (PROC) ......................................  27 (3.8), 28 (3.9) 

+listspool ........................................  3 (2.1) 

+(l) Zeichnungen auflisten ........................  41 (3.7) 

+(L) Zeichnungen loeschen .........................  42 (3.13) 

+move cm (PROC) ...................................  10 (2.20), 25 (2.21) 

+move cm r * (PROC) ...............................  10 (2.21), 25 (2.22) 

+move * (PROC) ....................................  9 (2.19), 9 (2.18), 25 (2.18),

+                                                    25 (2.19), 25 (2.20) 

+move r * (PROC) ..................................  10 (2.23), 10 (2.22),

+                                                    25 (2.23), 25 (2.24) 

+move to (PROC) ...................................  21 (1.20), 35 (2.13) 

+name (PROC) ......................................  17 (4.9) 

+newvalues (PROC) .................................  5 (1.4) 

+nilpicture * (PROC) ..............................  10 (2.24) 

+(n) Nachkommastellenzahl wählen ..................  42 (3.11) 

+no plotter (PROC) ................................  17 (4.10) 

+oblique * (PROC) .................................  5 (1.5), 14 (3.16) 

+:= (OP) ..........................................  8 (2.2), 13 (3.2), 13 (3.3),

+                                                    17 (4.3), 17 (4.2) 

+orthographic * (PROC) ............................  5 (1.6) 

+PACKET basisplot .................................  1 (3.1) 

+PACKET deviceinterface ...........................  1 (2.1) 

+PACKET devices ...................................  1 (1.4) 

+PACKET picfile ...................................  1 (1.3) 

+PACKET picture ...................................  1 (1.2) 

+PACKET plot ......................................  1 (3.3) 

+PACKET plotinterface .............................  1 (3.2) 

+PACKET transformation ............................  1 (1.1) 

+pendown (PROC) ...................................  44 (1.7) 

+pen * (PROC) .....................................  10 (2.25), 10 (2.26),

+                                                    26 (2.25), 45 (1.11) 

+penup (PROC) .....................................  44 (1.4) 

+perspective * (PROC) .............................  6 (1.7), 14 (3.17) 

+picfiles (PROC) ..................................  28 (3.10) 

+picture no * (PROC) ..............................  14 (3.18) 

+picture * (PROC) .................................  11 (2.27) 

+pictures * (PROC) ................................  14 (3.19) 

+plot * (PROC) ....................................  29 (4.3), 29 (4.2), 29 (4.1) 

+PLOTTER ..........................................  33 (1.5) 

+plotterinfo (PROC) ...............................  18 (4.13) 

+plotter (PROC) ...................................  18 (4.11), 18 (4.12) 

+plotters (PROC) ..................................  18 (4.14) 

+prepare (PROC) ...................................  21 (1.21), 36 (2.14) 

+put picture * (PROC) .............................  14 (3.21) 

+put * (PROC) .....................................  14 (3.20) 

+(q) in die Kommandoebene zurück ..................  41 (3.9) 

+read picture * (PROC) ............................  14 (3.22) 

+reset linetypes * (PROC) .........................  26 (2.27) 

+reset * (PROC) ...................................  26 (2.26) 

+reset zeichensatz * (PROC) .......................  26 (2.28) 

+rotate * (PROC) ..................................  11 (2.28), 11 (2.29) 

+(s) Anzahl der Stützpunkte waehlen ...............  42 (3.10) 

+save (PROC) ......................................  28 (3.12), 28 (3.11) 

+selected pen * (PROC) ............................  15 (3.23) 

+select pen * (PROC) ..............................  15 (3.24) 

+select plotter ...................................  4 (2.7) 

+select plotter (PROC) ............................  18 (4.16), 18 (4.15), 18 (4.17) 

+set color (PROC) .................................  21 (1.22) 

+setdrawingarea (PROC) ............................  6 (1.8) 

+set marker (PROC) ................................  21 (1.23), 36 (2.15) 

+setpalette (PROC) ................................  21 (1.24), 36 (2.16) 

+setpixel (PROC) ..................................  21 (1.25), 36 (2.17) 

+setvalues (PROC) .................................  6 (1.9), 15 (3.25) 

+spool control ....................................  3 (2.3) 

+start ............................................  4 (2.5) 

+start (PROC) .....................................  28 (3.13) 

+station (PROC) ...................................  18 (4.18) 

+stdcolors (PROC) .................................  22 (1.26), 22 (1.27) 

+stop .............................................  3 (2.4) 

+stop (PROC) ......................................  28 (3.14) 

+stretch * (PROC) .................................  11 (2.31), 11 (2.30) 

+text * (PROC) ....................................  11 (2.32) 

+to eof * (PROC) ..................................  15 (3.26) 

+to first pic * (PROC) ............................  16 (3.27) 

+to pic * (PROC) ..................................  16 (3.28) 

+transform (PROC) .................................  6 (1.10) 

+translate * (PROC) ...............................  12 (2.33), 12 (2.34) 

+turn (PROC) ......................................  45 (1.10) 

+turnto (PROC) ....................................  44 (1.2) 

+(t) Wertetafel erstellen lassen ..................  41 (3.6) 

+TYPE PICFILE .....................................  13 (3.1) 

+TYPE PICTURE * ...................................  8 (2.1) 

+TYPE PLOTTER .....................................  17 (4.1) 

+up * (PROC) ......................................  16 (3.30), 16 (3.29) 

+viewport * (PROC) ................................  7 (1.14), 16 (3.34) 

+view * (PROC) ....................................  6 (1.13), 6 (1.12), 6 (1.11),

+                                                    16 (3.32), 16 (3.31), 16 (3.33) 

+wait for halt (PROC) .............................  28 (3.15) 

+where * (PROC) ...................................  12 (2.35), 12 (2.36),

+                                                    26 (2.30), 26 (2.29) 

+window * (PROC) ..................................  7 (1.15), 7 (1.16), 7 (1.17),

+                                                    16 (3.35), 16 (3.36) 

+write picture * (PROC) ...........................  16 (3.37) 

+(w) Wertebereich ermitteln lassen ................  40 (3.3) 

+zeichensatz * (PROC) .............................  26 (2.31) 

+(z) Zeichnung anfertigen .........................  40 (3.4) 

+

diff --git a/app/mpg/1987/doc/PLOTBOOK.ELA b/app/mpg/1987/doc/PLOTBOOK.ELA
new file mode 100644
index 0000000..57f3437
--- /dev/null
+++ b/app/mpg/1987/doc/PLOTBOOK.ELA
@@ -0,0 +1,660 @@
+#type ("basker12")##limit (16.0)##block# 

+ 

+#head# 

+#type ("triumb18")# 

+#center#EUMEL-Grafik-System 

+#type ("basker12")# 

+#end# 

+                                               #on("italics")#gescheit, gescheiter, 

+                                               gescheitert#off("italics")# 

+ 

+#type ("basker14")# 

+#on("bold")#Beschreibung der Graphik-Prozeduren#off("bold")# 

+#type ("basker12")# 

+ 

+      #on("italics")#Zweidimensionale PICTURE brauchen weniger Speicherplatz als dreidimen-

+      sionale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen

+      angegeben.#off("italics")# 

+ 

+#on("underline")#Picture-Prozeduren#off("underline")# 

+PICTURE 

+ 

+ 

+:= 

+   OP := (PICTURE VAR l, PICTURE CONST r) 

+   Zweck: Zuweisung 

+ 

+CAT 

+   OP CAT (PICTURE VAR l, PICTURE CONST r) 

+   Zweck: Aneinanderfügen von zwei PICTURE. 

+   Fehlerfälle: 

+       * left dimension <> right dimension 

+         Es können nur PICTURE mit gleicher Dimension angefügt werden. 

+       * Picture overflow 

+         Die beiden PICTURE überschreiten die maximale Größe eines

+         PICTURE. 

+ 

+nilpicture 

+   PICTURE PROC nilpicture 

+   Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung. 

+ 

+draw 

+   PROC draw (PICTURE VAR p, TEXT CONST text) 

+   Zweck: Der angegebene Text wird gezeichnet. Der Anfang ist dabei die aktuelle

+          Stiftposition, die nicht verändert wird. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Der Text paßt nicht mehr in das PICTURE. 

+ 

+  PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle,

+  height, bright) 

+   Zweck: Der angegebene Text wird unter dem Winkel #on("italics")#angle#off("italics")# gegenüber der

+          Waagerechten mit der Zeichenhöhe #on("italics")#hight#off("italics")# und der Breite #on("italics")#bright#off("italics")# gezeich-

+          net. Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert

+          wird. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Der Text paßt nicht mehr in das PICTURE. 

+ 

+   PROC draw (PICTURE VAR p, REAL CONST x, y, z) 

+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is two dimensional 

+ 

+   PROC draw (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y). 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+ 

+draw r PROC draw r (PICTURE VAR p, REAL CONST x, y, z) 

+   Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is two dimensional 

+ 

+   PROC draw r (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+ 

+draw cm 

+  PROC draw cm (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y) cm.

+          Dabei werden die angegebenen Projektionsparameter nicht beachtet,

+          sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+ 

+draw cm r 

+   PROC draw cm r (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Zeichnen einer Linie der Länge (x, y) cm relativ zur aktuellen Position.

+          Dabei werden die angegebenen Projektionsparameter nicht beachtet,

+          sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+ 

+move 

+   PROC move (PICTURE VAR p, REAL CONST x, y, z) 

+   Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is two dimensional 

+ 

+   PROC move (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Die aktuelle Position wird auf (x, y) gesetzt. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+ 

+move r 

+   PROC move r (PICTURE VAR p, REAL CONST x, y, z) 

+   Zweck: Die aktuelle Position wird um (x, y, z) erhöht. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is two dimensional 

+ 

+   PROC move r (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Die aktuelle Position wird um (x, y) erhöht. 

+          Position. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+ 

+move cm 

+  PROC move cm (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Die aktuelle Position wird auf (x, y) cm gesetzt. Dabei werden die an-

+          gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#

+          Zentimeter#off("bold")# berechnet. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+ 

+move cm r 

+   PROC move cm r (PICTURE VAR p, REAL CONST x, y) 

+   Zweck: Die aktuelle Position wird um (x, y) cm erhöht. Dabei werden die an-

+          gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#

+          Zentimeter#off("bold")# berechnet. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+ 

+bar 

+   PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST

+   pattern): 

+   Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem

+              Muster #on("italics")#pattern#off("italics")#: 0  =  Leerer Balken 

+              1  =  Gepunkteter Balken 

+              2  =  Gefüllter Balken 

+              3  =  Horizontale Linien 

+              4  =  Vertikale Linien 

+              5  =  Gekreuzte Linien 

+              6  =  Diagonale Linien von Links nach Rechts 

+              7  =  Diagonale Linien von Rechts nach Links 

+              8  =  Gekreuzte diagonale Linien. 

+          Die aktuelle Stiftposition wird dabei nicht verändert. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+       * Unknown pattern 

+         Das angegebene Muster liegt nicht im Bereich 0-8 

+ 

+circle 

+   PROC circle (PICTURE VAR p, REAL CONST from, to, INT CONST

+   pattern) 

+   Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom

+          Winkel #on("italics")#from#off("italics")# bis #on("italics")#to#off("italics")# (im Gradmaß) mit dem Muster #on("italics")#pattern#off("italics")# (s.o.). Die

+          aktuelle Stiftposition wird dabei nicht verändert. 

+   Fehlerfälle: 

+       * Picture overflow 

+         Zu viele Befehle in einem PICTURE 

+       * Picture is three dimensional 

+       * Unknown pattern 

+         Das angegebene Muster liegt nicht im Bereich 0-8 

+ 

+dim 

+   INT PROC dim (PICTURE CONST pic) 

+   Zweck: Liefert die Dimension eines PICTURE. 

+ 

+pen 

+   INT PROC pen (PICTURE CONST p) 

+   Zweck: Liefert den virtuellen Stift des PICTURE 

+ 

+   PROC pen (PICTURE VAR p, INT CONST pen) 

+   Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. Bei pen=0 wird das

+          Picture nicht gezeichnet. 

+   Fehlerfälle: 

+       * pen out of range 

+         Der gewünschte Stift ist kleiner als 0 oder größer als 16. 

+ 

+extrema 

+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y

+   max) 

+   Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 

+   Fehlerfälle: 

+       * Picture is three dimensional 

+ 

+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y

+                                           max, z min, z max) 

+   Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 

+   Fehlerfälle: 

+       * Picture is two dimensional 

+ 

+where 

+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 

+   Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden

+          dabei nicht berücksichtigt). 

+   Fehlerfälle: 

+       * Picture is two dimensional 

+ 

+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 

+   Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden

+          dabei nicht berücksichtigt). 

+   Fehlerfälle: 

+       * Picture is three dimensional 

+ 

+rotate: 

+   PROC rotate (PICTURE VAR p, REAL CONST angle) 

+   Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("italics")#angle#off("italics")# (im

+          Gradmaß) im mathematisch positiven Sinn gedreht. 

+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#

+          verändert. 

+ 

+   PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda ) :

+   PICTURE 1-397 

+   Zweck: Das PICTURE wird um den Winkel #on("italics")#lambda#off("italics")# um die Drehachse #on("italics")#(phi,

+          theta)#off("italics")# gedreht. 

+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#

+          verändert. 

+ 

+stretch 

+   PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) 

+   Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("italics")#sx#off("italics")#, in Y-Rich-

+          tung um den Faktor #on("italics")#sy#off("italics")# gestreckt (bzw. gestaucht). Dabei bewirkt der

+          Faktor 

+              s > 1    eine Streckung 

+          0 < s < 1    eine Stauchung 

+              s < 0    zusätzlich eine Achsenspiegelung. 

+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#

+          verändert. 

+   Fehlerfälle: 

+       * Picture is three dimensional 

+ 

+   PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) 

+   Zweck: s. o. 

+   Fehlerfälle: 

+       * Picture is two dimensional 

+ 

+translate 

+   PROC translate (PICTURE VAR p, REAL CONST dx, dy) 

+   Zweck: Das PICTURE wird um #on("italics")#dx#off("italics")# und #on("italics")#dy#off("italics")# verschoben. 

+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#

+          verändert. 

+   Fehlerfälle: 

+       * Picture is three dimensional 

+ 

+   PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) 

+   Zweck: s. o. 

+   Fehlerfälle: 

+       * Picture is two dimensional 

+ 

+plot PROC plot (PICTURE CONST p) 

+   Zweck: Das Picfile wird gezeichnet. 

+          Achtung: Es wird kein #on("italics")#begin plot#off("italics")# oder #on("italics")#end plot#off("italics")# durchgeführt. Es wird

+                   auch kein Stift gsetzt und die Projektionsparameter bleiben

+                   unverändert. 

+ 

+ 

+#on("underline")#Graphische PICFILE-Prozeduren#off("underline")# 

+plot 

+  PROC plot (TEXT CONST name) 

+  Zweck: Der PICFILE mit dem Namen #on("italics")#name#off("italics")# wird entsprechend der angegebenen

+         Darstellungsart gezeichnet. Diese Parameter (#on("italics")#perspective, orthographic,

+         oblique, view, window etc.#off("italics")#) müssen vorher eingestellt werden. 

+  Fehlerfälle: 

+      * PICFILE does not exist 

+        Es existiert kein PICFILE mit dem Namen #on("italics")#name#off("underline")# 

+ 

+  PROC plot (PICFILE VAR p) 

+  Zweck: Der PICFILE #on("italics")#p#off("italics")# wird entsprechend der angegebenen Darstellungsart ge-

+         zeichnet. Diese Parameter müssen vorher eingestellt werden: 

+ 

+         #on("bold")#zweidimensional:#off("bold")# 

+         obligat:        #on("italics")#window#off("italics")#            (zweidimensional) 

+         optional:       #on("italics")#view#off("italics")#              (zweidimensional) 

+                         #on("italics")#viewport#off("italics")# 

+                         #on("italics")#select pen#off("italics")# 

+ 

+         #on("bold")#dreidimensional:#off("bold")# 

+         obligat:        #on("italics")#window#off("italics")#            (dreidimensional) 

+         optional:       #on("italics")#view#off("italics")#              (dreidimensional) 

+                         #on("italics")#orthographic | perspective | oblique#off("italics")# 

+                         #on("italics")#viewport#off("italics")# 

+                         #on("italics")#select pen#off("italics")# 

+ 

+ 

+select pen 

+  PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line

+  type, 

+                                  BOOL VAR hidden lines) Zweck: Für die

+         Darstellung des Bildes #on("italics")#p#off("italics")# soll dem #on("italics")#virtuellen#off("italics")# Stift #on("italics")#pen#off("italics")# ein realer Stift

+         zugeordnet werden, der möglichst die Farbe #on("italics")#colour#off("italics")# und die Dicke #on("italics")#thick-

+         ness#off("italics")# hat und dabei Linien mit dem Typ #on("italics")#line type#off("italics")# zeichnet. Es wird die

+         beste Annäherung für das Ausgabegerät genommen. 

+         Wenn #on("italics")#hidden lines#off("italics")# auf TRUE gesetzt wird, werden bei dreidimensionalen

+         Zeichnungen die verdeckten Linien mitgezeichnet, ansonsten werden sie

+         unterdrückt. Um sicherzustellen, das der Algorithmus auch funktioniert,

+         müssen die Linien allerdings von vorn nach hinten gezeichnet werden. Es

+         ist also nicht möglich, das Bild so zu drehen, das die hinteren Linien

+         zuerst gezeichnet werden. 

+         Dabei gelten folgende Vereinbarungen: 

+ 

+         #on("bold")#Farbe:#off("bold")# Negative Farben werden XOR gezeichnet (dunkel wird hell und

+                hell wird dunkel), Farbe 0 ist der Löschstift und positive Farben

+                überschreiben (ersetzen) den alten Punkt mit folgenden Werten: 

+ 

+                1      Standardfarbe des Endgerätes 

+                2      rot 

+                3      blau 

+                4      grün 

+                5      schwarz 

+                6      weiß 

+                > 6    nicht normierte Sonderfarben 

+ 

+ 

+         #on("bold")#Dicke:#off("bold")# 0 Standardstrichstärke des Endgerätes, ansonsten Strichstärke in

+                1/10 mm. 

+ 

+ 

+         #on("bold")#Linientyp:#off("bold")# 

+                0      keine sichtbare Linie 

+                1      durchgängige Linie 

+                2      gepunktete Linie 

+                3      kurz gestrichelte Linie 

+                4      lang gestrichelte Linie 

+                5      Strichpunktlinie 

+                > 5    nicht normierte Linie 

+ 

+         #on("bold")#Verdeckte Linien:#off("bold")# 

+                TRUE   Verdeckte Linien werden mitgezeichnet 

+                FALSE  Verdeckte Linien werden unterdrückt (nur bei drei-

+                       dimensionalen PICTURE) 

+ 

+         Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen

+         Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt

+         jeweils die bestmögliche Annäherung. 

+ 

+  Fehlerfälle: 

+      * pen out of range 

+        #on("italics")#pen#off("italics")# muss im Bereich 1-16 sein. 

+ 

+background 

+  PROC background (PICFILE VAR p, INT CONST colour) 

+  Zweck: Der Hintergrund wird auf die Farbe #on("italics")#colour#off("italics")# (s.o.) gesetzt wenn möglich. 

+ 

+  INT PROC background (PICFILE CONST p): 

+  Zweck: Liefert die eingestellte Hintergrundfarbe. 

+ 

+view 

+  PROC view (PICFILE VAR p, REAL CONST alpha) 

+  Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("italics")#alpha#off("italics")# Grad, falls

+         diese nicht senkrecht zur Betrachtungsebene steht. 

+ 

+  PROC view (PICFILE VAR p, REAL CONST phi, theta) 

+  Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt,

+         sondern für die Betrachtung gedreht. Mit der Prozedur #on("italics")#view#off("italics")# kann die

+         Betrachtungsrichtung durch die Polarwinkel #on("italics")#phi#off("italics")# und #on("italics")#theta#off("italics")# (im Gradmass)

+         angegeben werden. Voreingestellt ist #on("italics")#phi#off("italics")# = 0 und #on("italics")#theta#off("bold")# = 0, d.h. senk-

+         recht von oben. 

+ 

+         Im Gegensatz zu #on("italics")#rotate#off("italics")# hat #on("italics")#view#off("italics")# keine Wirkung auf das eigentliche Bild

+         (PICFILE), sondern nur auf die gewählte Darstellung. So addieren sich

+         zwar aufeinanderfolgende #on("italics")#Rotationen#off("italics")#, #on("italics")#view#off("italics")# aber geht immer von der

+         Nullstellung aus. Auch kann das Bild durch eine #on("italics")#Rotation#off("italics")# ganz oder

+         teilweise aus oder in das Darstellungsfenster (#on("italics")#window#off("italics")# gedreht werden. Bei

+         #on("italics")#view#off("italics")# verändern sich die Koordinaten der Punkte nicht, d. h. das Fenster

+         wird mitgedreht. 

+ 

+  PROC view (PICFILE VAR p, REAL CONST x, y, z) 

+  Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben,

+         sondern es wird die Blickrichtung als Vektor in Karthesischen Koordina-

+         ten angegeben. (Die Länge darf ungleich 1 sein). 

+ 

+viewport 

+  PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin,

+  vertmax) : 1-709 

+  Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden

+         soll, wird spezifiziert. Dabei wird sowohl die Größe als auch die relative

+         Lage der Zeichenfläche definiert. Der linke untere Eckpunkt der physi-

+         kalischen Zeichenfläche des Gerätes hat die Koordinaten (0, 0). Die

+         definierte Zeichenfläche erstreckt sich 

+ 

+                #on("italics")#hormin   -  hormax#off("italics")#        in der Horizontalen, 

+                #on("italics")#vertmin  -  vertmax#off("italics")#       in der Vertikalen. 

+ 

+         So liegt der linke untere Eckpunkt dann bei (#on("italics")#hormin, hormax#off("italics")#), der rechte

+         obere Eckpunkt bei (#on("italics")#hormax, vertmax#off("italics")#). 

+ 

+         Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen

+         möglich sind, können die Koordinaten in zwei Arten spezifiziert werden: 

+         a)  #on("bold")#Gerätekoordinaten#off("bold")# 

+             Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei

+             hat die kürzere Seite der physikalischen Zeichenfläche definitionsge-

+             mäß die Länge 1.0. 

+         b)  #on("bold")#Absolute Koordinaten#off("bold")# 

+             Die Werte werden in #on("italics")#cm#off("italics")# angegeben. Dabei müssen die Maximal-

+             werte aber größer als 2.0 sein, da sonst Fall a) angenommen wird. 

+ 

+         Voreingestellt ist 

+ 

+                viewport (0.0, 1.0, 0.0, 1.0) 

+ 

+         d.h. das größtmögliche Quadrat, beginnend mit der linken unteren Ecke

+         der physikalischen Zeichenfläche. In vielen Fällen wird diese Einstellung

+         ausreichen, so daß der Anwender kein eigenes #on("italics")#viewport#off("italics")# definieren muss. 

+ 

+         Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("italics")#viewport#off("italics")# und

+         #on("italics")#window#off("italics")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß

+         winkeltreue Darstellung nur bei gleichen X- und Y-Maßstab möglich

+         ist. Da man oft quadratische Fenster (#on("italics")#window#off("italics")#) verwendet, wurde als

+         Standardeinstellung auch ein quadratisches #on("italics")#viewport#off("italics")# gewählt. 

+ 

+  Hinweis: Mit der Prozedur #on("italics")#check limit#off("italics")# aus dem PACKET #on("italics")#basis plot#off("italics")# kann die

+           Überprüfung der Grenzen des eingestellten #on("italics")#viewport#off("italics")#-Bereiches ein-

+           bzw. ausgeschaltet werden. Bei eingeschateter Überprüfung, werden

+           Linien, die den Bereich überschreiten, am Rand abgetrennt. 

+ 

+ 

+window 

+  PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) 

+  Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustel-

+         lende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im In-

+         tervall [#on("italics")#x min, x max#off("italics")#] und deren Y-Koordinaten im Bereich [#on("italics")#y min, y

+         max#off("italics")#] liegen, gehören zum definierten Fenster.Vektoren, die außerhalb

+         dieses Fensters liegen, gehen über die durch #on("italics")#viewport#off("italics")# Fläche hinaus

+         (s.dort). 

+ 

+         Der Darstellungsmaßstab ergibt sich als 

+ 

+         #ub#               x max - x min               #ue# 

+          horizontale Seitenlänge der Zeichenfläche 

+ 

+ 

+         #ub#               y max - y min               #ue# 

+           vertikale Seitenlänge der Zeichenfläche 

+ 

+  PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,

+                                                       z min, z max) 

+ 

+  Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende

+         Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("italics")#x

+         min, x max#off("italics")#], deren Y-Koordinaten im Bereich [#on("italics")#y min, y max#off("italics")#] und

+         deren Z-Koordinaten im Bereich [#on("italics")#z min, z max#off("italics")#] liegen, gehören zum

+         definierten Fenster. Dieses dreidimensionale Fenster (#on("italics")#Quader#off("italics")#) wird ent-

+         sprechend der eingestellten Projektionsart (orthographisch, perspektivisch

+         oder schiefwinklig) und den Betrachtungswinkeln (s. #on("italics")#view#off("italics")#) auf die spezi-

+         fizierte Zeichenfläche abgebildet. 

+         Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe

+         nicht mehr nur durch das Zusammenspiel von #on("italics")#window#off("italics")# und #on("italics")#viewport#off("italics")# zu

+         beschreiben. Hier spielen auch die Projektionsart und Darstellungswinkel

+         herein. 

+ 

+oblique: 

+  PROC oblique (PICFILE VAR p, REAL CONST a, b) 

+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#schiefwinklig#off("underline")# als gewünschte

+         Projektionsart eingestellt. Dabei ist (#on("italics")#a, b#off("italics")#) der Punkt auf der X-Y-

+         Ebene, auf den der Einheitsvektor der Z-Richtung abgebildet werden

+         soll. 

+ 

+orthographic 

+  PROC orthographic (PICFILE VAR p) 

+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#orthographisch#off("underline")# als gewünschte

+         Projektionsart eingestellt. Bei der orthographischen Projektion wird ein

+         dreidimensionaler Körper mit parallelen Strahlen senkrecht auf der Pro-

+         jektionsebene dabgebildet. 

+ 

+perpective 

+  PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) 

+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#perspectivisch#off("underline")# als gewünschte

+         Projektionsart eingestellt. Der Punkt (#on("italics")#cx, 1/cy, cz#off("underline")#) ist der Fluchtpunkt der

+         Projektion, d. h. alle Parallen zur Z-Achse schneiden sich in diesem

+         Punkt. 

+ 

+extrema 

+  PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) 

+  Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 

+ 

+  PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z

+  min,z max) : 1-651 

+  Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 

+ 

+ 

+#on("underline")#Prozeduren zur Manipulation von PICFILE#off("underline")# 

+:= 

+  OP := (PICFILE VAR p, DATASPACE CONST d) 

+  Zweck: Assoziert die PICFILE Variable #on("italics")#p#off("italics")# mit dem Datenraum #on("italics")#d#off("italics")# und initialisiert

+         die Variable, wenn nötig. 

+  Fehlerfälle: 

+      * dataspace is no PICFILE 

+        Der anzukoppelnde Datenraum hat einen unzulässigen Typ 

+ 

+picture file 

+  DATASPACE PROC picture file (TEXT CONST name) 

+  Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). 

+ 

+put 

+  PROC put (FILE VAR f, PICFILE VAR p) 

+  Zweck: Schreibt den Inhalt eines PICFILE in ein FILE. Die Informationen

+         werden im internen Format abgelegt. 

+ 

+get 

+  PROC get (PICFILE VAR p, FILE VAR f) 

+  Zweck: Liest den Inhalt eines PICFILE aus einem FILE. Die Informationen

+         müssen mit #on("italics")#put#off("italics")# geschrieben worden sein. 

+  Fehlerfall: 

+      *  Picfile overflow 

+         Es können nur maximal 1024 Picture (Sätze) in einem PICFILE abgelegt

+         werden. 

+ 

+to first pic 

+  PROC to first pic (PICFILE VAR p) 

+  Zweck: Positioniert auf das erste PICTURE. 

+ 

+to eof 

+  PROC to last pic (PICFILE VAR p) 

+  Zweck: Positioniert hinter das letzte PICTURE. 

+ 

+to pic 

+  PROC to pic (PICFILE VAR p, INT CONST pos) 

+  Zweck: Positioniert auf das PICTURE Nummer #on("italics")#pos#off("italics")#. 

+  Fehlerfälle: 

+      *  Position underflow 

+         Es wurde eine Position kleiner Null angegeben. *  Position after

+         eof Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 

+ 

+up 

+  PROC up (PICFILE VAR p) 

+  Zweck: Positioniert genau ein PICTURE zurück. 

+  Fehlerfall: 

+      *  Position underflow 

+         Es wurde versucht, vor das erste PICTURE zu positionieren 

+ 

+  PROC up (PICFILE VAR p, INT CONST n) 

+  Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture zurück. 

+  Fehlerfall: 

+      *  Position underflow 

+         Es wurde versucht, vor das erste PICTURE zu positionieren 

+ 

+down 

+  PROC down (PICFILE VAR p) 

+  Zweck: Positioniert genau ein PICTURE vorwärts. 

+  Fehlerfall: 

+      *  Position after eof 

+         Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 

+ 

+  PROC down (PICFILE VAR p, INT CONST n) 

+  Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture vorwärts. 

+  Fehlerfall: 

+      *  Position after eof 

+         Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 

+ 

+is first picture 

+  BOOL PROC is first picture (PICFILE CONST p) 

+  Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das erste PICTURE erreicht ist. 

+ 

+eof 

+  BOOL PROC eof (PICFILE CONST p) 

+  Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das Ende eines PICFILE erreicht ist. 

+ 

+picture no 

+  INT PROC picture no (PICFILE CONST p) 

+  Zweck: Liefert die Nummer des aktuellen PICTURE. 

+ 

+pictures 

+  INT PROC pictures (PICFILE CONST p) 

+  Zweck: Liefert die Anzahl PICTURE eines PICFILE. 

+ 

+delete picture 

+  PROC delete picture (PICFILE VAR p) 

+  Zweck: Löscht das aktuelle PICTURE 

+ 

+insert picture 

+  PROC insert picture (PICFILE VAR p) 

+  Zweck: Fügt ein PICTURE #on("underline")#vor#off("underline")# der aktuellen Position ein. 

+ 

+read picture 

+  PROC read picture (PICFILE CONST p, PICTURE VAR pic) 

+  Zweck: Liest das aktuelle PICTURE. 

+ 

+write picture 

+  PROC write picture (PICFILE VAR p, PICTURE CONST pic) 

+  Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# auf der aktuellen Position. 

+ 

+put picture 

+  PROC write picture (PICFILE VAR p, PICTURE CONST pic) 

+  Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# hinter das letzte PICTURE des PICFILE.

+         Die aktuelle Position wird nicht verändert. 

+ 

+#page# 

+                                    #on("italics")#Wo wir sind, da klappt nichts, 

+                                    aber wir können nicht überall sein !#off("italics")# 

+ 

+#type ("basker14")# 

+#on("bold")#Kurzbeschreibung des Graphik-Editors#off("bold")# 

+#type ("basker12")# 

+ 

+In der Kommondozeile werden folgende Informationen angezeigt: 

+ 

+#on("revers")#LEN nnnnn                <...Name...>      DIM n  PEN nn    Picture nnnn

+#off("revers")# 

+ 

+ 

+Folgende Kommandos stehen zur Verfügung: 

+ 

+  PICTURE PROC pic neu 

+  PICFILE PROC picfile neu 

+  PROC neu zeichnen 

+ 

+  OP UP n         (n PICTURE up) 

+  OP DOWN n       (n PICTURE down) 

+  OP T n          (to PICTURE n) 

+ 

+  PROC oblique (REAL CONST a, b) 

+  PROC orthographic 

+  PROC perspective (REAL CONST cx, cy, cz) 

+  PROC window (BOOL CONST dev) 

+  PROC window (REAL CONST x min, x max, y min, y max) 

+  PROC window (REAL CONST x min, x max, y min, y max, z min, z max) 

+  PROC viewport (REAL CONST h min, h max, v min, v max) 

+  PROC view (REAL CONST alpha) 

+  PROC view (REAL CONST phi, theta) 

+  PROC view (REAL CONST x, y, z) 

+ 

+  PROC pen (INT CONST n) 

+  PROC select pen (INT CONST pen, colour, thickness, line type, BOOL CONST

+  hidden) 

+  PROC background (INT CONST colour) 

+ 

+  PROC extrema pic 

+  PROC extrema picfile 

+  PROC selected pen 

+ 

+  PROC rotate (REAL CONST angle) 

+  PROC rotate (REAL CONST phi, theta, lambda ) 

+  PROC stretch (REAL CONST sx, sy) 

+  PROC stretch (REAL CONST sx, sy, sz) 

+  PROC translate (REAL CONST dx, dy) 

+  PROC translate (REAL CONST dx, dy, dz) 

diff --git a/app/mpg/1987/src/ATPLOT.ELA b/app/mpg/1987/src/ATPLOT.ELA
new file mode 100644
index 0000000..4799ab0
--- /dev/null
+++ b/app/mpg/1987/src/ATPLOT.ELA
@@ -0,0 +1,438 @@
+PACKET at plot DEFINES                            (* at plot              *)

+                                                  (* Datum    : 14:05:86  *) 

+                  begin plot,                     (* Geaendert: 30.05:86  *) 

+                  end plot,                       (* Autoren  : BJ & CW   *) 

+                  clear,                          (* MPG Bielefeld        *) 

+ 

+                  pen, 

+                  background, 

+                  foreground, 

+                  thickness, 

+                  linetype, 

+ 

+                  move, 

+                  draw, 

+                  bar, circle,

+                  drawing area, 

+                  range, set range:

+ 

+LET     max x   = 719, 

+        max y   = 347, 

+        x pixel = 720, 

+        y pixel = 348, 

+        x cm    = 24.5, 

+        y cm    = 18.5; 

+ 

+INT VAR thick :: 0,  (* Normale Linien *) 

+        ltype :: 1,

+        x max :: max x, (* Zeichenfenster *) 

+        y max :: max y,

+        x min :: 0, 

+        y min :: 0,

+        old x :: 0, 

+        old y :: 0; 

+ 

+ROW 5 ROW 4 INT CONST nibble :: ROW 5 ROW 4 INT: (* Bitmuster fuer Linien*) 

+   (ROW 4 INT : ( 4369, 4369, 4369, 4369),       (* durchgezogen  *) 

+    ROW 4 INT : (   17,   17,   17,   17),       (* gepunktet     *) 

+    ROW 4 INT : ( 4369,    0, 4369,    0),       (* kurz gestrichelt *) 

+    ROW 4 INT : ( 4369, 4369,    0,    0),       (* lang gestrichelt *) 

+    ROW 4 INT : ( 4369, 4369, 4096,    1));      (* gestrichpunktet  *) 

+ 

+PROC begin plot: 

+  INT VAR return; 

+  REP                              (* Fehler? Ab und zu versagt der *)

+    control (-5,512+0,0,return);   (* Graphik-Aufruf !!!!!!         *)

+  UNTIL return <> -1 PER;

+  IF return <> 0 

+    THEN errorstop ("Graphik nicht ansprechbar") 

+  FI 

+END PROC begin plot; 

+ 

+PROC end plot: 

+  INT VAR return; 

+  pause;

+  control (-5,2,0,return); 

+END PROC end plot;

+

+PROC clear: 

+  begin plot 

+END PROC clear; 

+ 

+PROC pen (INT CONST backgr, foregr, thickn, linety): 

+  INT VAR dummy; 

+  background (backgr, dummy); 

+  thickness  (thickn, dummy); 

+  linetype   (linety, dummy);

+  foreground (foregr, dummy)

+END PROC pen; 

+ 

+PROC background (INT CONST desired, INT VAR realized): 

+  realized := 0 

+END PROC background; 

+ 

+PROC foreground (INT CONST desired, INT VAR realized): 

+  IF desired < 2 OR desired = 5  (* 0 = loeschen, 1 = setzen, 5 = schwarz *)

+    THEN realized := desired 

+    ELSE realized := 1 

+  FI; 

+  IF realized = 0

+    THEN INT VAR return;

+                 control ( -9,0,0,return); 

+                 control (-10,0,0,return) 

+    ELSE linetype (ltype,return)           (* Alten Typ wiederherstellen *) 

+  FI

+END PROC foreground; 

+ 

+PROC linetype (INT CONST desired, INT VAR realized): 

+  IF desired > 5 

+    THEN realized := 1 

+    ELSE realized := desired 

+  FI; 

+  INT VAR return;

+  ltype := realized;

+  control ( -9,nibble [realized][2], nibble [realized][1], return); 

+  control (-10,nibble [realized][4], nibble [realized][3], return); 

+  IF realized = 1

+    THEN control (-11,0,0,return) 

+    ELSE control (-11,1,0,return)

+  FI

+END PROC linetype; 

+ 

+PROC thickness (INT CONST desired, INT VAR realized): 

+  thick := int ( real (desired) / 200.0 *    (* Angabe in 1/10 mm *)

+                 real (x pixel) / x cm);     (* Unrechnung in X Punkte *)

+  realized := thick * 2 + 1                  (* Rueckgabe in Punkten *)

+END PROC thickness; 

+ 

+PROC move (INT CONST x,y): 

+  old x := x;                 (* Kein direktes move, da clipping ! *)

+  old y := y 

+END PROC move;

+

+PROC draw (INT CONST x,y): 

+  draw (old x,old y,x,y); 

+END PROC draw; 

+ 

+PROC draw (INT CONST x0,y0,x1,y1): 

+  IF thick = 0 

+    THEN line (x0,y0,x1,y1) 

+    ELSE draw thick line (x0,y0,x1,y1) 

+  FI; 

+  move (x1,y1) 

+END PROC draw; 

+ 

+PROC draw thick line (INT CONST x1,y1,x2,y2): 

+  INT VAR x0 :: x1,

+          y0 :: y1,

+          x  :: x2,

+          y  :: y2;

+  swap if neccessary;

+  REAL VAR xr0 :: real(x0),                            (* Unwandlung in *)

+           yr0 :: real(y0) / (x cm * real(y pixel)) *  (* 1:1-Koordinaten*)

+                             (y cm * real(x pixel)),  

+           xr1 :: real(x), 

+           yr1 :: real(y) / (x cm * real(y pixel)) * 

+                             (y cm * real(x pixel)); 

+  INT VAR  line counter;

+  control(-11,1,0,line counter);

+  IF is vertical line

+    THEN draw vertical line 

+    ELSE draw line 

+  FI;

+  move(x1,y1).

+ 

+  swap if neccessary: 

+    IF x < x0 OR (x = x0 AND y < y0) 

+      THEN INT VAR dummy :: x0; 

+           x0 := x; 

+           x := dummy; 

+           dummy := y0; 

+           y0 := y; 

+           y := dummy 

+    FI.

+

+  is vertical line: 

+    x = x0.

+ 

+  draw vertical line: 

+    INT VAR i;

+    FOR i FROM - thick UPTO thick REP 

+      INT VAR return;

+      control(-11, 1,line counter,return);  (* Einheitliches Muster ! *)

+      line (xr0+real(i),yr0-real(thick),xr0+real(i),yr1+real(thick)) 

+    PER. 

+

+  draw line: 

+    REAL VAR m :: (yr1 - yr0) / (xr1 - xr0),

+             dx :: real(thick)/sqrt(1.0+m**2), 

+             dy :: m * dx,

+             xn, 

+             yn, 

+             diff,

+             dsx :: dy,

+             dsy :: -dx,

+             x incr :: -real(sign(dsx)), 

+             y incr :: -real(sign(dsy)); 

+  xr0 INCR -dx; 

+  yr0 INCR -dy; 

+  xr1 INCR  dx; 

+  yr1 INCR  dy;

+  xn := xr0 + dsx; 

+  yn := yr0 + dsy; 

+  REP

+    control (-11, 1,line counter,return);

+    line(xn,yn,xr1 - xr0 + xn,yr1 - yr0 + yn); 

+    diff := (2.0*dsy *(xn - (xr0 - dy)) - 2.0 * dsx * (yn - (yr0 + dx))) 

+             * real(sign(m));

+    IF diff < 0.0

+      THEN xn INCR x incr 

+    ELIF diff > 0.0

+      THEN yn INCR y incr 

+      ELSE xn INCR x incr; 

+           yn INCR y incr 

+    FI 

+  UNTIL int(xn - xr0 + dy) = 0 AND int(yn - yr0 - dx) = 0 PER

+

+END PROC draw thick line; 

+

+PROC line (REAL CONST x0,y0,x1,y1):   (* 1:1-Koordinaten -> Geraetek. *)

+  line (int(x0),int(y0 * (x cm * real(y pixel)) / (y cm * real(x pixel))),

+        int(x1),int(y1 * (x cm * real(y pixel)) / (y cm * real(x pixel))))

+END PROC line ;

+ 

+PROC line (INT CONST x0,y0,x1,y1):      (* Normale Linie mit clipping *)

+  REAL VAR dx :: real(xmax - xmin) / 2.0, 

+           dy :: real(ymax - ymin) / 2.0, 

+           rx0 :: real(x0-x min) - dx, 

+           ry0 :: real(y0-y min) - dy, 

+           rx1 :: real(x1-x min) - dx, 

+           ry1 :: real(y1-y min) - dy; 

+  INT VAR  cx0, 

+           cy0, 

+           cx1, 

+           cy1; 

+  calculate cells; 

+  IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1)

+    THEN                                  (* Linie ausserhalb *)

+    ELSE do clipping           

+  FI.

+ 

+  do clipping: 

+    IF cx0 <> 0 

+      THEN REAL VAR next x :: real(cx0) * dx; 

+           ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0;

+           rx0 := next x 

+    FI; 

+    calculate cells; 

+    IF cy0 <> 0 

+      THEN REAL VAR next y :: real(cy0) * dy; 

+           rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; 

+           ry0 := next y 

+    FI; 

+    IF cx1 <> 0 

+      THEN next x := real(cx1) * dx; 

+           ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1;

+           rx1 := next x 

+    FI; 

+    calculate cells; 

+    IF cy1 <> 0 

+      THEN next y := real(cy1) * dy; 

+           rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; 

+           ry1 := next y 

+    FI; 

+    IF (rx1 = rx0) AND (ry1 = ry0) 

+      THEN LEAVE line 

+    FI; 

+    draw std line (int (rx0+dx) + x min,int (ry0+dy) + y min, 

+                   int (rx1+dx) + x min,int (ry1+dy) + y min).

+     

+    calculate cells: 

+      cx0 := 0; 

+      cy0 := 0; 

+      cx1 := 0; 

+      cy1 := 0; 

+      IF abs(rx0) > dx 

+        THEN cx0 := sign(rx0) 

+      FI;

+      IF abs(rx1) > dx 

+        THEN cx1 := sign(rx1) 

+      FI;

+      IF abs(ry0) > dy 

+        THEN cy0 := sign(ry0) 

+      FI;

+      IF abs(ry1) > dy 

+        THEN cy1 := sign(ry1) 

+      FI 

+  

+END PROC line; 

+ 

+PROC draw std line (INT CONST x0,y0,x1,y1):   (* Terminallinie ziehen *) 

+  INT VAR return; 

+  control(-7,x0,max y - y0,return);  (* move *) 

+  control(-6,x1,max y - y1,return)   (* draw *)

+END PROC draw std line; 

+ 

+PROC drawing area (REAL VAR x c, y c, INT VAR x pix, y pix):

+  x pix := x pixel; 

+  y pix := y pixel; 

+  x c   := x cm; 

+  y c   := y cm 

+END PROC drawing area; 

+ 

+PROC range (INT CONST hmin,hmax,vmin,vmax):    (* Zeichenflaeche setzen *)

+  x min := max (0, min (max x,h min)); 

+  x max := max (0, min (max x,h max)); 

+  y min := max (0, min (max y,v min)); 

+  y max := max (0, min (max y,v max)) 

+END PROC range;

+ 

+PROC set range ( INT CONST hmin, hmax, vmin, vmax): 

+    range( hmin, hmax, vmin, vmax ) 

+ENDPROC set range; 

+

+(* Textausgabe von C. Indenbirken *)

+(* Erweitert um stufenlose Rotierbarkeit der Zeichen *)

+ 

+LET ZEICHENSATZ = ROW 255 TEXT;

+ZEICHENSATZ VAR zeichen;

+INT CONST char x :: 6, char y :: 10;

+

+zeichensatz ("ZEICHENSATZ");

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);

+       zeichen := new zeichen;

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST x size, 

+                y size, direction):

+  TEXT CONST character :: zeichen [char no];

+  INT VAR n :: 1, x0, y0, x1, y1;

+  INT CONST len :: length (character);

+  REAL CONST sindir :: sind(direction),

+             cosdir :: cosd(direction);

+  WHILE n < len

+  REP value (character, n, x0, y0, x1, y1);

+  REAL VAR xr0 :: real(x0),

+           yr0 :: real(y0),

+           xr1 :: real(x1), 

+           yr1 :: real(y1);

+      transform (xr0, yr0, x, y, x size, y size, sindir,cosdir);

+      transform (xr1, yr1, x, y, x size, y size, sindir,cosdir);

+      draw (int(xr0),int(yr0 * (x cm * real(y pixel)) / 

+                     (y cm * real(x pixel))),

+            int(xr1),int(yr1 * (x cm * real(y pixel)) / 

+                     (y cm * real(x pixel))));

+       n INCR 4 

+  PER  .

+

+END PROC draw char;

+

+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):

+  x0 := val (code (char SUB n));    y0 := val (code (char SUB n+1));

+  x1 := val (code (char SUB n+2));  y1 := val (code (char SUB n+3));

+END PROC value;

+

+INT PROC val (INT CONST n):

+  IF n > 127

+  THEN -256 OR n

+  ELSE n FI

+END PROC val;

+

+PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, 

+                sindir,cosdir):

+  REAL CONST old x :: x, old y :: y;

+  REAL CONST dx :: x size / real(char x) * old x * cosdir - 

+                   y size / real(char y) * old y * sindir, 

+             dy :: y size / real(char y) * old y * cosdir + 

+                   x size / real(char x) * old x * sindir;

+

+  x := x0 + dx; 

+  y := y0 + dy

+END PROC transform; 

+

+PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, 

+                REAL CONST height, width): 

+  INT VAR i;

+  REAL VAR x :: x pos, y :: y pos,

+           x step :: cosd (angle)*width,

+           y step :: sind (angle)*width;

+  FOR i FROM 1 UPTO length (msg)

+  REP IF control char

+      THEN execute control char

+      ELSE execute normal char FI

+  PER  .

+

+control char:

+  akt char < ""32""  .

+

+execute control char:

+  SELECT code (akt char) OF

+  CASE  1: home

+  CASE  2: right

+  CASE  3: up

+  CASE  7: out (""7"")

+  CASE  8: left

+  CASE 10: down

+  CASE 13: return

+  ENDSELECT  .

+

+home:

+  x := x pos;

+  y := y pos  .

+

+right:

+  x INCR x step;  y INCR y step  . 

+

+up:

+  x INCR y step;  y INCR x step  . 

+

+left:

+  x DECR x step;  y DECR y step  .

+

+down:

+  x DECR y step;  y DECR x step  . 

+

+return:

+  x := x pos  .

+

+execute normal char:

+  draw char (code (akt char), x, y, height, width,

+             angle);

+  x INCR x step;

+  y INCR y step  .

+

+akt char:

+  msg SUB i  .

+

+END PROC draw text; 

+ 

+PROC draw (TEXT CONST msg):

+   draw (msg,0.0,5.0,5.0)

+END PROC draw;

+ 

+PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width):

+    REAL CONST  xr :: real(old x), 

+                yr :: real(old y) / (x cm * real(y pixel)) * 

+                                    (y cm * real(x pixel)); 

+    draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, 

+                               width  * real(x pixel) / x cm / 10.0)

+                                    (* heigth  mm --> x punkte *)

+END PROC draw; 

+ 

+PROC draw (TEXT CONST msg , REAL CONST winkel, INT CONST hoehe, breite): 

+      draw ( msg, winkel, real(hoehe), real(breite) )

+ENDPROC draw; 

+ 

+PROC bar ( INT CONST xmin, ymin, xmax, ymax, pattern ) : 

+     (* zur Zeit leer *) 

+ENDPROC bar; 

+ 

+PROC circle ( INT CONST x,y, rad, REAL CONST from, to, INT CONST pattern):

+     (* zur Zeit leer *) 

+ENDPROC circle; 

+ 

+END PACKET at plot

diff --git a/app/mpg/1987/src/B108PLOT.ELA b/app/mpg/1987/src/B108PLOT.ELA
new file mode 100644
index 0000000..7eb1d4c
--- /dev/null
+++ b/app/mpg/1987/src/B108PLOT.ELA
@@ -0,0 +1,642 @@
+PACKET basis108 plot DEFINES                  (* M. Staubermann, 22.06.86 *)

+                     drawing area,            (* 1.8.0: 09.11.86   *)

+                     begin plot,              (* SHard 8: 07.02.87 *)

+                     end plot, 

+                     clear, 

+                     pen,

+                     move, 

+                     draw, 

+                     get cursor ,

+

+                     testbit, fill, trans,

+                     full screen,(* FALSE:Mit Text in den letzten 4 Zeilen *)

+                     visible page, work page,

+                     ctrl word,  (* Zugriff auf control word *)

+                     zeichensatz ,

+                     get screen ,

+                     put screen :

+ 

+LET max x        = 279 ,

+    max y        = 191 ,

+

+    hor faktor   = 11.2 ,     { xpixel/cm }

+    vert faktor  = 11.29412 , { ypixel/cm }

+

+

+    delete = 0 ,

+    std    = 1 ,

+    black  = 5 ,

+    white  = 6 ,

+    yellow = 7 ,

+{   lilac  = 8 ,  }

+

+    durchgehend      = 1 ,

+    gepunktet        = 2 ,

+    kurz gestrichelt = 3 ,

+    lang gestrichelt = 4 ,

+    strichpunkt      = 5 ,

+

+    onoff bit        = 0 , 

+    visible page bit = 1 ,

+    work page bit    = 2 ,

+    and bit          = 3 ,

+    xor bit          = 4 , 

+    size bit         = 5 ,

+    pattern bit      = 6 ,

+    color bit        = 7 ;

+

+

+LET PEN         = STRUCT (INT back, fore, thick, line) ,

+    POS         = STRUCT (INT x, y) ,

+    ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height) ,

+    BLOCK       = ROW 256 INT ;

+

+INT CONST ctrl clr  :: -3 ,

+          ctrl fill :: -4 ,

+          ctrl move :: -5 ,

+          ctrl draw :: -6 ,

+          ctrl test :: -7 ,

+          ctrl ctrl :: -8 ,

+          ctrl trans:: -9 ;

+

+ZEICHENSATZ VAR zeichen; (* 4KB *)

+

+PEN VAR stift ;

+POS VAR pos ;

+INT VAR r, i, n, work page nr, visible page nr,

+        line pattern, control word := 0 ;

+ 

+visible page (0) ;

+work page (0) ;

+

+clear ;

+zeichensatz ("ZEICHEN 6*10") ;

+

+PROC zeichensatz (TEXT CONST name) :

+

+  IF exists (name)

+     THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name) ;

+          zeichen := new zeichen

+     ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht")

+  FI

+

+END PROC zeichensatz;

+

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+

+   x cm := 25.0 ;

+   y cm := 17.0 ;

+   x pixel := max x ;

+   y pixel := max y

+

+END PROC drawing area;

+

+

+PROC begin plot : 

+ setbit (control word, onoff bit) ;

+ graphic control

+ENDPROC begin plot ;

+ 

+

+PROC end plot : 

+ resetbit (control word, onoff bit) ;

+ graphic control

+ENDPROC end plot ;

+

+

+PROC ctrl word (INT CONST word) :

+ control word := word ;

+ graphic control

+ENDPROC ctrl word ;

+

+

+INT PROC ctrl word :

+ control word

+ENDPROC ctrl word ;

+

+

+PROC full screen (BOOL CONST true) :

+

+ IF true

+    THEN resetbit (control word, size bit)

+    ELSE setbit (control word, size bit)

+ FI ;

+ graphic control

+

+ENDPROC full screen ;

+

+

+PROC fill (INT CONST muster) :

+(********************************************************************)

+(*                                                                  *)

+(*    FILL (muster nummer)                                          *)

+(*         Füllt eine beliebig (sichtbar) umrandete Fläche mit      *)

+(*         dem angegebenen Muster.                                  *)

+(*                                                                  *)

+(*    Das Muster ist eine 8 x 8 Matrix, die sich auf allen pos MOD 8*)

+(*    -Adressen wiederholt.                                         *)

+(*    Im NAND-Modus wird mit dem inversen Muster gefüllt, die Fläche*)

+(*    muß dann aber mit unsichtbaren Pixels begrenzt werden.        *)

+(*                                                                  *)

+(*    Folgende Muster sind möglich:                                 *)

+(*    0 = 'solid' (alles gefüllt)                                   *)

+(*    1 = 'lrs2'  (jeder zweite Punkt, Zeilenweise versetzt)        *)

+(*    2 = 'row4'  (jede 4. Zeile wird gefüllt)                      *)

+(*    3 = 'row2'  (jede 2. Zeile wird gefüllt)                      *)

+(*    4 = 'col4'  (jede 4. Spalte wird gefüllt)                     *)

+(*    5 = 'col2'  (jede 2. Spalte wird gefüllt)                     *)

+(*    6 = 'grid4' (jede 4. Spalte/Zeile wird gefüllt)               *)

+(*    7 = 'grid2' (jede 2. Spalte/Zeile wird gefüllt)               *)

+(*    8 = 'ls4'   (Schraffur links unten --> rechts oben, jede 4.)  *)

+(*    9 = 'rs4'   (Schraffur rechts unten --> links oben, jede 4.)  *)

+(*   10 = 'lrs4'  (Schräges Gitter wie 8 und 9 zusammen)            *)

+(*   11 = 'point2'(In jeder 2. Zeile jeder 2. Punkt)                *)

+(*   12 = 'wall4' (Mauer, ein Ziegelstein 4 Pixel hoch)             *)

+(*   13 = 'basket'(Korb/Netz)                                       *)

+(*   14 = 'wave4' (Wellenlinie 4 Pixel hoch)                        *)

+(*   15 = 'wave8' (Wellenlinie 8 Pixel hoch)                        *)

+(*                                                                  *)

+(*   Falls die zu füllende Fläche zu komplex wird, kann es vorkommen,*)

+(*   daß der interne Stack überläuft. In diesem Fall wird nicht die *)

+(*   gesamte Fläche gefüllt wird.                                   *)

+(*                                                                  *)

+(********************************************************************)

+ control (ctrl fill, muster, 0, r)

+

+ENDPROC fill ;

+

+

+PROC trans (INT CONST from, to) :

+(********************************************************************)

+(*                                                                  *)

+(*    TRANS (from page, to page)                                    *)

+(*          Kopiert den Inhalt der Graphikseite 'from page' in die  *)

+(*          Seite 'to page'. Folgende Seitennummern sind möglich:   *)

+(*                                                                  *)

+(*    0 : Seite 0 kann mit 'visible page (0)' angezeigt werden      *)

+(*    1 : Seite 1 kann mit 'visible page (1)' angezeigt werden      *)

+(*    2 : Seite 2 kann nicht sichtbar werden (Hilfsspeicher-Seite)  *)

+(*    3 : Ähnlich Seite 2, wird aber bei 'FILL' noch als Arbeits-   *)

+(*        seite benutzt (wird dann überschrieben!)                  *)

+(*                                                                  *)

+(********************************************************************)

+

+ control (ctrl trans, from, to, r)

+ENDPROC trans ;

+

+

+BOOL PROC testbit (INT CONST x, y) :

+(********************************************************************)

+(*                                                                  *)

+(*    TEST (x pos, y pos) --> Byte                                  *)

+(*          Testet den Status eines bestimmten Pixels.              *)

+(*                                                                  *)

+(*    Die Pixelposition wird mit xpos/ypos beschrieben.             *)

+(*    Als Result wird zurückgeliefert:                              *)

+(*        255, falls xpos/ypos außerhalb des sichtbaren Fensters    *)

+(*        liegt.                                                    *)

+(*        Bit 0 = 1: Pixel sichtbar                                 *)

+(*        Bit 0 = 0: Pixel unsichtbar                               *)

+(*        Bit 7 = 1: Pixelfarbe ist hell (gelb)                     *)

+(*        Bit 7 = 0: Pixelfarbe ist dunkel (violett)                *)

+(*                                                                  *)

+(********************************************************************)

+

+ control (ctrl test, x, y, r) ;

+ bit (r, 0)

+ENDPROC testbit ;

+

+

+PROC clear :

+(********************************************************************)

+(*                                                                  *)

+(*    CLR (seite, muster)                                           *)

+(*        Füllt die angegebene Seite mit dem angegebenen Muster     *)

+(*                                                                  *)

+(*    Bit 7 des Musters bestimmt die Farbe (0 = dunkel, 1 = hell)   *)

+(*    Die anderen 7 Bits werden Spalten- und Zeilenweise wiederholt.*)

+(*    (128 löscht die Seite mit unsichtbaren Punkten)               *)

+(*                                                                  *)

+(********************************************************************)

+

+  pos   := POS : (0, 0) ;

+  stift := PEN : (std, std, std, durchgehend) ;

+  pen (std, std, std, durchgehend) ; (* Standard pen *)

+  control (ctrl clr, work page nr, control word AND 128, r) ;

+

+END PROC clear;

+

+

+PROC pen (INT CONST background, foreground, thickness, linetype) :

+(********************************************************************)

+(*                                                                  *)

+(*    CTRL (flags, linienmuster)                                    *)

+(*         Setzt verschiedene Graphikmodi.                          *)

+(*                                                                  *)

+(*    Die Bits im ersten Parameter sind folgendermaßen zugeordnet.  *)

+(*                                                                  *)

+(*    Bit 0 :                                                       *)

+(*     0 = Textmodus einschalten, Graphikmodus ausschalten          *)

+(*     1 = Graphikmodus einschalten, Textmodus ausschalten          *)

+(*    Bit 1 :                                                       *)

+(*     0 = Seite 0 als sichtbare Seite wählen                       *)

+(*     1 = Seite 1 als sichtbare Seite wählen                       *)

+(*    Bit 2 :                                                       *)

+(*     0 = Seite 0 als bearbeitete Seite wählen                     *)

+(*     1 = Seite 1 als bearbeitete Seite wählen                     *)

+(*    Bit 3, 4 : Verknüpfung Patternbit: 0           1              *)

+(*        0           OR              setzen     unverändert        *)

+(*        1         NAND             löschen     unverändert        *)

+(*        2          XOR         invertieren     unverändert        *)

+(*        3         COPY             löschen     setzen             *)

+(*    Bit 5 :                                                       *)

+(*     0 = Der gesmate Bildschirm zeigt die Graphikseite ('full')   *)

+(*     1 = In den letzten 32 Graphikzeilen erscheint die Textseite  *)

+(*    Bit 6 :                                                       *)

+(*     0 = Das im zweiten Parameter übergebene Wort wird als 16-Bit *)

+(*         Linienmuster eingestellt. Modus siehe Bit 3/4.           *)

+(*     1 = Das alte (bzw. voreingestellte) Linienmuster wird benutzt*)

+(*    Bit 7 :                                                       *)

+(*     0 = Als Punkthelligkeit wird 'dunkel' (bzw. Violett) eingest.*)

+(*     1 = Als Punkthelligkeit word 'hell' (bzw. Gelb) eingestellt  *)

+(*    Bit 8..11 :                                                   *)

+(*     0 = Default-Strichdicke (1)                                  *)

+(*     1..15 = Strichdicke (Es werden 2*s-1 Linien parallel ge-     *)

+(*             zeichnet.)                                           *)

+(*                                                                  *)

+(*    Der zweite Parameter enthält das 16-Bit Linienmuster. Dieses  *)

+(*    wird beim zeichnen einer Linie zyklisch Bitweise abgetastet.  *)

+(*    Je nach Status des Bits im Linienmuster wird eine Punkt-      *)

+(*    aktion ausgeführt, deren Wirkung im 1. Parameter mit den Bits *)

+(*    3 und 4 spezifiziert wird.                                    *)

+(*                                                                  *)

+(********************************************************************)

+

+  INT CONST farbe := abs (foreground) ;

+  set thickness ;

+  set linetype ;

+  set colour ;

+  graphic control ;

+  stift := PEN : (background, foreground, abs (thickness), linetype) .

+

+set colour :

+ IF farbe = std OR farbe = yellow OR farbe = white

+    THEN set bit (control word, color bit)

+    ELSE reset bit (control word, color bit)

+ FI ;

+ IF farbe = delete OR farbe = black

+    THEN set   bit (control word, and bit) ; (* RESET *)

+         reset bit (control word, xor bit)

+ ELIF foreground < 0 AND thickness >= 0

+    THEN set   bit (control word, xor bit) ; (* XOR *)

+         reset bit (control word, and bit)

+ ELIF foreground < 0 (* AND thickness < 0 *)

+    THEN set   bit (control word, xor bit) ; (* COPY *)

+         set   bit (control word, and bit) 

+    ELSE reset bit (control word, xor bit) ; (* SET *)

+         reset bit (control word, and bit)

+ FI .

+

+set thickness :

+ control word := (control word AND 255) + 256 * abs (thickness) .

+

+set linetype:

+  reset bit (control word, pattern bit) ;    (* Pattern neu definieren *)

+  SELECT linetype OF

+   CASE durchgehend      : line pattern := -1

+   CASE gepunktet        : line pattern := 21845

+   CASE kurz gestrichelt : line pattern := 3855

+   CASE lang gestrichelt : line pattern := 255

+   CASE strichpunkt      : line pattern := 4351

+   OTHERWISE             : line pattern := line type

+  END SELECT .

+

+END PROC pen;

+

+

+PROC move (INT CONST x, y) :

+(********************************************************************)

+(*                                                                  *)

+(*    MOVE (x pos, y pos)                                           *)

+(*         Setzt den (unsichtbaren) Graphikcursor auf xpos/ypos.    *)

+(*                                                                  *)

+(*    Der nächste 'draw' zeichnet eine Linie beginnend bei xpos/ypos*)

+(*                                                                  *)

+(********************************************************************)

+

+  control (ctrl move, x, y, r) ;

+  pos := POS:(x, y) 

+

+END PROC move;

+

+ 

+PROC draw (INT CONST x, y) :

+(********************************************************************)

+(*                                                                  *)

+(*    DRAW (x pos, y pos)                                           *)

+(*         Zeichnet eine Linie zur angegebeben Position xpos/ypos.  *)

+(*                                                                  *)

+(*    Die eingestellten Parameter Helligkeit, Linientyp, Bitver-    *)

+(*    knüpfung und Dicke werden beachtet.                           *)

+(*    Der nächste 'draw' zeichnet eine Linie beginnend bei xpos/ypos*)

+(*                                                                  *)

+(********************************************************************)

+

+  control (ctrl draw, x, y, r) ;

+  pos := POS : (x, y) .

+

+END PROC draw;

+

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+{  x fak  =  width *  hor faktor / max  width

+   y fak  = heigth * vert faktor / max height

+   x'     = x fak * ( x * cos phi + y * sin phi) + x pos

+   y'     = y fak * (-x * sin phi + y * cos phi) + y pos

+   x step = x fak * max  width * cos phi

+   y step =-y fak * max height * sin phi }

+

+  REAL CONST sin a :: sind (angle) ,

+             cos a :: cosd (angle) ,

+             x fak :: character width ,

+             y fak :: character height ;

+  INT CONST  xstep :: character x step ,

+             ystep :: character y step ;

+

+  REAL VAR x off r, y off r ;

+  INT VAR x pos := pos.x ,

+          y pos := pos.y ,

+          x off, y off, i ;

+

+  POS VAR old pos := pos;

+  FOR i FROM 1 UPTO length (record) REP

+    draw character i

+  PER ;

+  pos := old pos .

+

+character width:

+  IF width = 0.0

+     THEN 1.0

+     ELSE hor faktor * width / real (zeichen.width)

+  FI .

+

+character x step:

+  int (hor faktor * width * cos a + 0.5) .

+

+character height:

+  IF height = 0.0

+    THEN 1.0

+    ELSE vert faktor * height / real (zeichen.height)

+  FI .

+

+character y step:

+  int (- vert faktor * height * sin a + 0.5) .

+

+draw character i:

+  IF code (record SUB i) < 32

+     THEN steuerzeichen

+     ELSE normale zeichen

+  FI .

+ 

+steuerzeichen:

+  SELECT code (record SUB i) OF

+    CASE  2 : x pos INCR x step ; y pos INCR y step

+    CASE  3 : x pos DECR x step

+    CASE  7 : out (""7"")

+    CASE  8 : x pos DECR x step ; y pos DECR y step

+    CASE 10 : y pos INCR y step

+    CASE 13: x pos := pos.x ;  y pos := pos.y

+  END SELECT  .

+

+normale zeichen:

+  TEXT CONST char :: zeichen.char [code (record SUB i)] ;

+  INT CONST char len :: LENGTH char DIV 2 ;

+  IF char len < 2

+     THEN LEAVE normale zeichen

+  FI ;

+  x off r := real ((char ISUB 1) AND 15) ;

+  y off r := real ((char ISUB 2) AND 15) ;

+  move (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos,

+        int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos) ;

+

+  n := 3 ;

+  WHILE n <= char len REP

+    x off := char ISUB n ;

+    n INCR 1 ;

+    y off := char ISUB n+1 ;

+    n INCR 1 ;

+    BOOL CONST to draw := ((x off OR y off) AND 16384) = 0 ;

+    x off r := real (x off AND 15) ;

+    y off r := real (y off AND 15) ;

+    IF to draw

+      THEN

+      draw (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos,

+            int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos)

+      ELSE

+      move (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos,

+            int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos)

+    FI

+  PER ;

+

+  x pos INCR x step ;

+  y pos INCR y step .

+

+END PROC draw ;

+

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+

+

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  get cursor (t, x, y, -1, -1, -1, -1)

+END PROC get cursor;

+

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1) :

+ get cursor (t, x, y, x0, y0, x1, y1, FALSE)

+ENDPROC get cursor ;

+

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1,

+                 BOOL CONST only one key):

+  BOOL VAR hop key := FALSE ;

+  t := "" ;

+  check;

+  init cursor;

+  REP set cursor;

+      get step;

+      set cursor;

+      move cursor

+  UNTIL only one key PER ;

+  graphic control .

+

+init cursor:

+  control (ctrl ctrl, 17 + (control word AND 134), -1, r) ;

+  INT VAR delta := 1 ;

+  x := pos.x ;

+  y := pos.y .

+

+set cursor:

+  IF x0 >= 0 AND y0 >= 0

+  THEN control (ctrl move, x0, y0, r);

+       control (ctrl draw, x, y, r)

+  FI;

+  IF x1 >= 0 AND y1 >= 0

+  THEN control (ctrl move, x1, y1, r);

+       control (ctrl draw, x, y, r)

+  FI;

+  control (ctrl move, x - 4, y, r);

+  control (ctrl draw, x + 4, y, r);

+  control (ctrl move, x, y + 4, r);

+  control (ctrl draw, x, y - 4, r)  .

+

+get step:

+  hop key := t = ""1"" ;

+  t := incharety (1);

+  IF t <> ""

+  THEN delta INCR 1

+  ELSE delta := 1 ;

+       inchar (t)

+  FI .

+

+move cursor:

+  IF hop key

+     THEN hop mode

+     ELSE single key

+  FI ;

+  check .

+

+single key :

+  SELECT code (t) OF

+  CASE 1 : 

+  CASE 2, 54 : x INCR delta (* right, '6' *)

+  CASE 3, 56 : y INCR delta (* up,    '8' *) 

+  CASE 8, 52 : x DECR delta (* left,  '4' *)

+  CASE 10, 50 : y DECR delta(* down,  '2' *)

+  CASE 55 : x DECR delta ; y INCR delta (* '7' *)

+  CASE 57 : x INCR delta ; y INCR delta (* '9' *)

+  CASE 49 : x DECR delta ; y DECR delta (* '1' *)

+  CASE 51 : x INCR delta ; y DECR delta (* '3' *)

+  OTHERWISE leave get cursor ENDSELECT .

+

+hop mode :

+ SELECT code (t) OF

+  CASE 1 : t := "" ; x := 0 ; y := max y ;

+  CASE 2, 54 : x := max x

+  CASE 3, 56 : y := max y

+  CASE 8, 52 : x := 0 

+  CASE 10, 50 : y := 0

+  CASE 55 : x := 0 ; y := max y 

+  CASE 57 : x := max x ; y := max y

+  CASE 49 : x := 0 ; y := 0

+  CASE 51 : x := max x ; y := 0

+  OTHERWISE t := ""1"" + t ; leave get cursor ENDSELECT .

+

+leave get cursor:

+  control (ctrl move, pos.x, pos.y, r);

+  graphic control ;

+  LEAVE get cursor  .

+

+check :

+  IF x < 0

+  THEN x := 0 ; out (""7"")

+  ELIF x > max x

+  THEN x := max x ; out (""7"") FI ; 

+

+  IF y < 0

+  THEN y := 0 ; out (""7"")

+  ELIF y > max y

+  THEN y := max y ; out (""7"") FI .

+

+END PROC get cursor;

+

+

+.graphic control :

+ control (ctrl ctrl, control word, line pattern, r) .

+

+

+PROC get screen (TEXT CONST name, INT CONST screen nr):

+  IF exists (name)

+     THEN get screen (old (name), screen nr)

+     ELSE get screen (new (name), screen nr)

+  FI ;

+END PROC get screen;

+

+

+PROC get screen (DATASPACE CONST to ds, INT CONST screen nr) :

+(********************************************************************)

+(*                                                                  *)

+(*    BLOCKIN/BLOCKOUT (0, seiten nummer * 16 + block)              *)

+(*         512 Bytes in/aus dem Graphikspeicher transportieren.     *)

+(*                                                                  *)

+(*    Der zweite Parameter sollte zwischen 0..63 liegen. Als Seiten *)

+(*    sind also sowohl die 'displayable' 0 und 1, sowie 'temporary' *)

+(*    2 und 3 erlaubt.                                              *)

+(*                                                                  *)

+(********************************************************************)

+

+  INT CONST page :: screen nr * 16 ; 

+  BOUND ROW 16 BLOCK VAR screen := to ds ;

+  FOR i FROM 0 UPTO 15 REP

+   blockin (screen (i+1), 0, page + i, r)

+  PER

+

+END PROC get screen;

+

+

+PROC put screen (TEXT CONST name, INT CONST screen nr):

+  IF exists (name)

+  THEN put screen (old (name), screen nr)

+  ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI

+END PROC put screen;

+

+

+PROC put screen (DATASPACE CONST from ds, INT CONST screen nr) :

+

+  BOUND ROW 16 BLOCK VAR screen :: from ds ;

+  INT CONST page :: screen nr * 16 ;

+  FOR i FROM 0 UPTO 15 REP

+   block out (screen (i+1), 0, page + i, r)

+  PER 

+

+END PROC put screen;

+

+

+PROC work page (INT CONST nr) :

+

+ work page nr := nr ;

+ IF bit (nr, 0)

+    THEN setbit (control word, work page bit)

+    ELSE reset bit (control word, work page bit)

+ FI ;

+ graphic control

+

+ENDPROC work page ;

+

+

+PROC visible page (INT CONST nr) :

+

+ visible page nr := nr ;

+ IF bit (nr, 0)

+    THEN setbit (control word, visible page bit)

+    ELSE reset bit (control word, visible page bit)

+ FI ;

+ graphic control

+

+ENDPROC visible page ;

+

+

+INT PROC visible page :

+ visible page nr

+ENDPROC visible page ;

+

+

+INT PROC work page :

+ work page nr

+ENDPROC work page ;

+

+

+END PACKET basis108 plot ;

diff --git a/app/mpg/1987/src/BASISPLT.ELA b/app/mpg/1987/src/BASISPLT.ELA
new file mode 100644
index 0000000..0232485
--- /dev/null
+++ b/app/mpg/1987/src/BASISPLT.ELA
@@ -0,0 +1,781 @@
+PACKET basis plot DEFINES                       (* Autor: H. Indenbirken *)

+                                                (* Stand: 30.12.84       *)

+(**********************  Hardwareunabhängiger Teil  *************************

+*                                                                           * 

+*                                                                           * 

+*        Im Harwareunabhängigen Paket 'transformation' werden folgende      *

+*        Prozeduren definiert:                                              * 

+*        Procedure       :  Bedeutung                                       * 

+*        -------------------------------------------------------------------* 

+*        transform     :  Sie Prozedur projeziert einen dreidimensionalen * 

+*                           Vektor (x,y,z) auf einen zweidimensionalen (h,v)* 

+*        set values    :  Mit dieser Prozedur werden die Projektionspara- * 

+*                           meter gesetzt.                                  * 

+*                           size:    Weltkoordinatenbereich                 *

+*                                    ((xmin,xmax),(ymin,ymax),(zmin,zmax))  *

+*                           limits:  Zeichenfläche                          *

+*                                    ((h min, h max), (v min, v max))       *

+*                                    Bei Werten < 2.0 werden die Werte als  *

+*                                    Prozente interpretiert, ansonsten als  *

+*                                    cm-Grössen.                            *

+*        get values    :  Übergibt die aktuellen Werte                    *

+*        new values    :  Vermerkt neue Werte                             *

+*                                                                           *

+*                                                                           *

+*        drawing area  :  Übergibt die aktuelle Zeichengröße in Pixel.    *

+*                                                                           *

+*        angles        :  a) alpha:      Winkel der Y-Achse in Grad       *

+*                           b) (x, y, z):  karth. Projektionswinkel         *

+*        oblique       :  Schiefwinklige Projektion mit dem               *

+*                           Normalenvektor (a, b).                          *

+*        perspective   :  Perspektive mit dem Betrachtungsstandort        *

+*                           (x, y, z).                                      *

+*        window        :  siehe set values, size                          *

+*        viewport      :  siehe set values, limit                         *

+*        view          :  siehe set values, angle                         *

+*        oblique       :  Schiefwinklige Projektion                       *

+*        orthographic  :  Orthografische Projektion                       *

+*        perspective   :  Perspektivische Projektion                      *

+*                                                                           *

+*                                                                           *

+*        box           :  Rahmen um die aktuelle Zeichenfläche            *

+*        reset         :  Löscht alte verdeckte Linien                    *

+*        hidden lines  :  Unterdrückt verdeckte Linien                    *

+*                                                                           *

+*        move          :  Positioniert auf (x, y, [z]) in Weltkoordinaten *

+*        draw          :  Zeichnet eine Linie bis zum Punkt (x, y, [z]).  *

+*        move r        :  Positioniert (x, y, [z]) weiter                 *

+*        draw r        :  Zeichnet (x, y, [z]) weiter                     *

+*        move cm       :  Positioniert auf (x cm, y cm).                  *

+*        draw cm       :  Zeichnet eine Linie bis (x cm, y cm)            *

+*        move cm r     :  Positioniert (x cm, y cm) weiter                *

+*        draw cm r     :  Zeichnet (x cm, y cm) weiter                    *

+*                                                                           *

+*        bar           :  Balken mit (hight, width, pattern)              *

+*        circle        :  Kreis(segment) mit (radius, from, to, pattern)  *

+*                                                                           *

+*        where         :  Gibt die aktuelle Stiftposition (x, y, [z])     *

+*                                                                           *

+*        get cursor    :  Graphische Eingabe                              *

+*                                                                           *

+*                                                                           *

+****************************************************************************)

+

+       transform, 

+       set values,

+       get values,

+       new values,

+       drawing area,

+

+       window, 

+       viewport,

+       view, 

+       oblique, 

+       orthographic, 

+       perspective,

+

+       box,

+       reset,

+       hidden lines,

+

+       move, 

+       draw, 

+       move r, 

+       draw r, 

+       move cm, 

+       draw cm, 

+       move cm r, 

+       draw cm r, 

+       bar,

+       circle,

+

+       where:

+

+BOOL VAR new limits :: TRUE, values new :: TRUE,

+         perspective projektion :: FALSE;

+INT VAR pixel hor, pixel vert;

+REAL VAR display hor, display vert,           (* Anzahl der Pixel        *)

+         size hor, size vert;                 (* Groesse des Bildschirms *)

+drawing area (size hor, size vert, pixel hor, pixel vert);

+display hor := real (pixel hor);  display vert := real (pixel vert);

+

+REAL VAR h min limit :: 0.0, h max limit :: display hor,

+         v min limit :: 0.0, v max limit :: display vert,

+         h min :: 0.0, h max :: size hor,

+         v min :: 0.0, v max :: size vert,

+         hor relation :: display hor/size hor,

+         vert relation :: display vert/size vert,

+         relation :: size hor/size vert;

+ 

+ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :

+                          (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

+

+ROW 3 ROW 2 REAL VAR size d :: ROW 3 ROW 2 REAL :

+                              (ROW 2 REAL : (0.0, 1.0),

+                               ROW 2 REAL : (0.0, 1.0),

+                               ROW 2 REAL : (0.0, 1.0)),

+                     last size :: size d;

+ROW 2 ROW 2 REAL VAR limits d :: ROW 2 ROW 2 REAL :

+                                (ROW 2 REAL : (0.0, relation),

+                                 ROW 2 REAL : (0.0, 1.0));

+ROW 4 REAL VAR angles d :: ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);

+ROW 2 REAL VAR oblique d :: ROW 2 REAL : (0.0, 0.0);

+ROW 3 REAL VAR perspective d :: ROW 3 REAL : (0.0, 0.0, 0.0);

+REAL VAR size hor d := size hor, size vert d := size vert;

+INT VAR pixel hor d := pixel hor, pixel vert d := pixel vert;

+

+INT VAR i, j, k;

+

+BOOL OP = (ROW 3 ROW 2 REAL CONST l, r):

+  FOR i FROM 1 UPTO 3

+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]

+      THEN LEAVE = WITH FALSE FI

+  PER;

+  TRUE

+END OP =;

+

+BOOL OP = (ROW 2 ROW 2 REAL CONST l, r):

+  FOR i FROM 1 UPTO 2

+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]

+      THEN LEAVE = WITH FALSE FI

+  PER;

+  TRUE

+END OP =;

+

+BOOL OP = (ROW 2 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2]

+END OP =;

+

+BOOL OP = (ROW 3 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3]

+END OP =;

+

+BOOL OP = (ROW 4 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] 

+END OP =;

+

+PROC oblique (REAL CONST a, b) :

+  set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) 

+END PROC oblique;

+

+PROC orthographic :

+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))

+END PROC orthographic;

+

+PROC perspective (REAL CONST cx, cy, cz) :

+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz))

+END PROC perspective;

+

+PROC window (BOOL CONST dev) :

+  new limits := dev

+END PROC window;

+

+PROC window (REAL CONST x min, x max, y min, y max) :

+  window (x min, x max, y min, y max, 0.0, 1.0)

+END PROC window;

+

+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :

+  set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),

+                                  ROW 2 REAL : (y min, y max),

+                                  ROW 2 REAL : (z min, z max)),

+              limits d, angles d, oblique d, perspective d)

+END PROC window;

+

+PROC viewport (REAL CONST h min, h max, v min, v max) :

+  set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), 

+                                          ROW 2 REAL : (v min, v max)),

+              angles d, oblique d, perspective d)

+END PROC view port;

+

+PROC view (REAL CONST alpha) :

+  set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)),

+              oblique d, perspective d)

+END PROC view;

+

+PROC view (REAL CONST phi, theta) :

+  set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi),

+                                              sind (theta) * sind (phi), cosd (theta)),

+              oblique d, perspective d)

+END PROC view;

+

+PROC view (REAL CONST x, y, z) :

+  set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d)

+END PROC view;

+

+set values (size d, limits d, angles d, oblique d, perspective d);

+

+PROC drawing area (REAL VAR min h, max h, min v, max v):

+  min h := h min limit;  max h := h max limit;

+  min v := v min limit;  max v := v max limit

+END PROC drawing area;

+ 

+BOOL PROC new values:

+  IF values new

+  THEN values new := FALSE;

+       TRUE

+  ELSE FALSE FI

+END PROC new values;

+

+PROC get values (ROW 3 ROW 2 REAL VAR size, 

+                 ROW 2 ROW 2 REAL VAR limits,

+                 ROW 4 REAL VAR angles,

+                 ROW 2 REAL VAR oblique,

+                 ROW 3 REAL VAR perspective) : 

+  size        := size d;

+  limits      := limits d;

+  angles      := angles d;

+  oblique     := oblique d;

+  perspective := perspective d;

+

+END PROC get values;

+

+PROC set values (ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 4 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) : 

+   drawing area (size hor, size vert, pixel hor, pixel vert);

+   display hor := real (pixel hor);  display vert := real (pixel vert);

+   IF NOT same values

+   THEN values new := TRUE;

+        copy values;

+        set views;

+        check perspective projektion; 

+        calc limits;

+        change projektion

+   FI  .

+

+same values:

+  size hor d  = size hor  AND size vert d  = size vert AND

+  pixel hor d = pixel hor AND pixel vert d = pixel vert AND

+  size d = size AND limits d = limits AND angles d = angles AND

+  oblique d = oblique AND perspective d = perspective  . 

+

+copy values :

+  size hor d := size hor;

+  size vert d := size vert;

+  pixel hor d := pixel hor;

+  pixel vert d := pixel vert;

+  size d := size;

+  limits d := limits;

+  angles d := angles;

+  oblique d := oblique;

+  perspective d := perspective  .

+

+set views :

+  REAL VAR diagonale := sqrt (angles [2] * angles [2] +

+                              angles [3] * angles [3] +

+                              angles [4] * angles [4]),

+           projektion := sqrt (angles [2] * angles [2] +

+                               angles [4] * angles [4]),

+           sin p, cos p, sin t, cos t, sin a, cos a;

+

+           IF diagonale = 0.0

+           THEN sin p :=  0.0;  cos p :=  1.0;

+                sin t :=  0.0;  cos t :=  1.0

+           ELIF projektion = 0.0

+           THEN sin p :=  angles [3] / diagonale;

+                cos p :=  projektion / diagonale;

+                sin t :=  0.0;  cos t :=  1.0

+           ELSE sin p :=  angles [3] / diagonale;

+                cos p :=  projektion / diagonale;

+                sin t :=  angles [2] / projektion;

+                cos t :=  angles [4] / projektion

+           FI;

+

+  REAL VAR   sin p sin t := sin p * sin t,

+             sin p cos t := sin p * cos t,

+             cos p sin t := cos p * sin t,

+             cos p cos t := cos p * cos t,

+

+             dx          := size [1][2] - size [1][1],

+             dy          := size [2][2] - size [2][1],

+             dz          := size [3][2] - size [3][1],

+             norm az     := oblique [1] ,

+             norm bz     := oblique [2] ,

+             norm cx     := perspective [1] / dx,

+             norm cy     := perspective [2] / dy,

+             norm cz     := perspective [3] / dz,

+             xx          := - size [1][1] / dx * cos p sin t -

+                              size [2][1] / dy * sin p + 

+                              size [3][1] / dz * cos p cos t;

+

+p :=  ROW 5 ROW 5 REAL :

+      (ROW 5 REAL : (  cos t       / dx - cos p sin t / dx * norm az ,

+                     - sin p sin t / dx - cos p sin t / dx * norm bz,

+                       0.0,

+                                        - cos p sin t / dx * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (                   - sin p       / dy * norm az,

+                       cos p       / dy - sin p       / dy * norm bz,

+                       0.0, 

+                                        - sin p       / dy * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (  sin t       / dz + cos p cos t / dz * norm az,

+                     + sin p cos t / dz + cos p cos t / dz * norm bz,

+                       0.0,

+                                        cos p cos t / dz * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),

+       ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

+

+  IF angles (1) = 0.0

+  THEN set alpha as y vertical

+  ELSE sin a := sind (angles (1));

+       cos a := cosd (angles (1))

+  FI;

+ 

+  FOR j FROM 1 UPTO 5

+  REP REAL CONST p  j 1 := p (j)(1);

+      p (j)(1) :=  p  j  1  * cos a - p (j)(2) * sin a;

+      p (j)(2) :=  p  j  1  * sin a + p (j)(2) * cos a 

+  PER  .

+

+set alpha as y vertical :

+  REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);

+  IF r = 0.0

+  THEN sin a := 0.0;

+       cos a := 1.0

+  ELSE sin a :=-p(2)(1)/r;

+       cos a := p(2)(2)/r

+  FI  .

+

+check perspective projektion:

+  perspective projektion := perspective [3] <> 0.0  .

+

+calc limits :

+  IF new limits

+  THEN calc two dim extrema;

+       IF all limits smaller than 2

+       THEN prozente

+       ELSE zentimeter FI

+  FI  .

+

+calc two dim extrema :

+  h min := max real;  h max :=-max real;

+  v min := max real;  v max :=-max real;

+ 

+  extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); 

+  extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);

+  extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); 

+  extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);

+  extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); 

+  extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);

+  extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); 

+  extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max)  .

+

+all limits smaller than 2 :

+  limits (1)(2) < 2.0 AND limits (2)(2) < 2.0  .

+

+prozente :

+  h min limit := display hor * limits (1)(1)/relation;

+  h max limit := display hor * limits (1)(2)/relation;

+ 

+  v min limit := limits (2)(1) * display vert;

+  v max limit := limits (2)(2) * display vert  .

+ 

+zentimeter : 

+  h min limit := display hor * (limits (1)(1)/size hor);

+  h max limit := display hor * (limits (1)(2)/size hor);

+ 

+  v min limit := display vert * (limits (2)(1)/size vert);

+  v max limit := display vert * (limits (2)(2)/size vert)  .

+

+change projektion :

+  REAL VAR sh := (h max limit - h min limit) / (h max - h min),

+           sv := (v max limit - v min limit) / (v max - v min),

+           dh := h min limit - h min*sh,

+           dv := v min limit - v min*sv;

+

+  FOR j FROM 1 UPTO 5

+  REP

+     p (j)(1) := p (j)(1) * sh;

+     p (j)(2) := p (j)(2) * sv

+  PER;

+  p (5)(1) := dh;

+  p (5)(2) := dv.

+END PROC set values;

+ 

+PROC transform (REAL CONST x, y, z, INT VAR h, v) :

+  disable stop;

+  IF perspective projektion

+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);

+       h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));

+       v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))

+  ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));

+       v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));

+  FI;

+  IF is error

+  THEN h := -1;

+       v := -1;

+       clear error

+  FI

+END PROC transform;

+

+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):

+  REAL VAR h, v;

+  IF perspective projektion

+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);

+       h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;

+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w

+  ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));

+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))

+  FI;

+ 

+ IF h < h min

+ THEN h min := h

+ ELIF h > h max

+ THEN h max := h FI;

+

+ IF v < v min

+ THEN v min := v

+ ELIF v > v max

+ THEN v max := v FI

+

+END PROC extrema;

+

+(**************************** Plot Prozeduren ****************************)

+LET empty              = 0,             {Punktmuster} 

+    half               = 1,

+    full               = 2,

+    horizontal         = 3,

+    vertical           = 4,

+    cross              = 5,

+    diagonal right     = 6,

+    diagonal left      = 7,

+    diagonal both      = 8;

+

+LET POS = STRUCT (REAL x, y, z);

+POS VAR pos :: POS : (0.0, 0.0, 0.0);

+INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0;

+BOOL VAR hidden :: FALSE;

+DATASPACE VAR ds :: nilspace;

+BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds;

+

+

+PROC box :

+  move (int (h min limit+0.5), int (v min limit+0.5));

+  draw (int (h max limit+0.5), int (v min limit+0.5));

+  draw (int (h max limit+0.5), int (v max limit+0.5));

+  draw (int (h min limit+0.5), int (v max limit+0.5));

+  draw (int (h min limit+0.5), int (v min limit+0.5))

+END PROC box;

+ 

+PROC reset:

+  forget (ds);

+  ds := nilspace;

+  maxima := ds

+END PROC reset;

+

+PROC move (REAL CONST x, y) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (x, y, 0.0, h, v);

+  move (h, v);

+  pos := POS : (x, y, 0.0)

+END PROC move;

+

+PROC move (REAL CONST x, y, z) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (x, y, z, h, v);

+  move (h, v);

+  pos := POS : (x, y, z)

+END PROC move;

+

+PROC draw (REAL CONST x, y) :

+  IF hidden

+  THEN transform (x, y, 0.0, new h, new v);

+       vector (new h-h, new v-v)

+  ELSE transform (x, y, 0.0, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (x, y, 0.0)

+END PROC draw;

+

+PROC draw (REAL CONST x, y, z) :

+  IF hidden

+  THEN transform (x, y, z, new h, new v);

+       vector (new h-h, new v-v)

+  ELSE transform (x, y, z, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (x, y, z) 

+END PROC draw;

+

+PROC move r (REAL CONST x, y) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (pos.x+x, pos.y+y, pos.z, h, v);

+  move (h, v);

+  pos := POS : (pos.x+x, pos.y+y, pos.z)

+END PROC move r;

+

+PROC move r (REAL CONST x, y, z) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);

+  move (h, v);

+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)

+END PROC move r;

+

+PROC draw r (REAL CONST x, y) :

+  IF hidden

+  THEN transform (pos.x+x, pos.y+y, pos.z, h, v); 

+       vector (new h-h, new v-v)

+  ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); 

+       draw (h, v)

+  FI;

+  pos := POS : (pos.x+x, pos.y+y, pos.z)

+END PROC draw r;

+

+PROC draw r (REAL CONST x, y, z) :

+  IF hidden

+  THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); 

+       vector (new h-h, new v-v)

+  ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)

+END PROC draw r;

+

+PROC move cm (REAL CONST x cm, y cm) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  h := int (x cm*hor relation+0.5);

+  v := int (y cm*vert relation+0.5);

+  move (h, v)

+END PROC move cm;

+

+PROC draw cm (REAL CONST x cm, y cm) :

+  IF hidden

+  THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v)

+  ELSE h := int (x cm*hor relation+0.5);

+       v := int (y cm*vert relation+0.5);

+       draw (h, v)

+  FI

+END PROC draw cm;

+

+PROC move cm r (REAL CONST x cm, y cm) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  h INCR int (x cm*hor relation+0.5);

+  v INCR int (y cm*vert relation+0.5);

+  move (h, v)

+END PROC move cm r;

+

+PROC draw cm r (REAL CONST x cm, y cm) :

+  IF hidden

+  THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5))

+  ELSE h INCR int (x cm*hor relation+0.5);

+       v INCR int (y cm*vert relation+0.5);

+       draw (h, v)

+  FI

+END PROC draw cm r;

+

+PROC hidden lines (BOOL CONST dev):

+  hidden := NOT dev;

+END PROC hidden lines;

+

+PROC vector (INT CONST dx, dy):

+  IF dx >= 0

+  THEN IF   dy >  dx THEN vector (v, h, dy, dx,  1, 1)

+       ELIF dy >   0 THEN vector (h, v, dx, dy,  1, 1)

+ 

+       ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1)

+       ELSE               vector (v, h, -dy, dx,-1, 1) FI

+

+  ELSE IF   dy > -dx THEN vector (v, h, dy, -dx, 1,-1)

+       ELIF dy >   0 THEN vector (h, v, -dx, dy,-1, 1)

+ 

+       ELIF dy >  dx THEN vector (h, v, -dx, -dy,-1,-1)

+       ELSE               vector (v, h, -dy, -dx,-1,-1) FI

+  FI  .

+ 

+ENDPROC vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :

+  INT VAR i;

+  prepare first step ;

+  draw point;

+  FOR i FROM 1 UPTO dx

+  REP do one step PER;

+

+  IF was visible

+  THEN draw (h, v) FI  .

+

+

+prepare first step :

+  INT VAR up right error := dy - dx,

+          right error := dy,

+          old error := 0,

+          last h :: h, last v :: v;

+  BOOL VAR was visible :: visible  .

+

+

+do one step:

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error)  .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  draw point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  draw point ;

+  old error INCR right error .

+ 

+draw point :

+  IF was visible

+  THEN IF NOT visible

+       THEN draw (last h, last v);

+            was visible := FALSE

+       FI;

+       last h := h;

+       last v := v

+  ELSE IF visible

+       THEN move (h, v);

+            was visible := TRUE;

+            last h := h;

+            last v := v 

+       FI

+ FI  .

+

+visible:

+  IF h < 1 OR h > pixel hor

+  THEN FALSE

+  ELSE IF maxima.akt [h] < v 

+       THEN maxima.akt [h] := v FI; 

+       v > maxima.last [h]

+  FI

+END PROC vector;

+ 

+PROC where (REAL VAR x, y) :

+  x := pos.x;  y := pos.y

+END PROC where;

+

+PROC where (REAL VAR x, y, z) :

+  x := pos.x;  y := pos.y;  z := pos.z

+END PROC where;

+

+PROC bar (REAL CONST hight, width, INT CONST pattern):

+  INT VAR zero x, zero y, end x, end y;

+  transform (0.0, 0.0, 0.0, zero x, zero y);

+  transform (width, hight, 0.0, end x, end y);

+  bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern)

+END PROC bar;

+

+PROC bar (INT CONST from x, from y, width, hight, pattern):

+  INT CONST to x :: from x+width, to y :: from y+hight;

+  INT VAR x, y;

+  draw frame;

+  SELECT pattern OF

+  CASE empty: (* nothing to do *)

+  CASE half:           half bar

+  CASE full:           full bar

+  CASE horizontal:     horizontal bar

+  CASE vertical:       vertical bar

+  CASE cross:          horizontal bar;

+                       vertical bar

+  CASE diagonal right: diagonal right bar

+  CASE diagonal left:  diagonal left bar

+  CASE diagonal both:  diagonal both bar

+  OTHERWISE errorstop ("Unknown pattern") ENDSELECT  .

+

+draw frame:

+  move (from x, from y);

+  draw (from x, to y);

+  draw (to x, to y);

+  draw (to x, from y)  .

+

+full bar:

+  FOR y FROM from y UPTO to y

+  REP move (from x, y);

+      draw (to x, y) 

+  PER  .

+

+half bar:

+  FOR y FROM from y UPTO to y

+  REP x := from x + 1 + (y AND 1);

+      WHILE x < to x 

+      REP move (x, y);

+          draw (x, y);

+          x INCR 2

+      PER

+  PER  .

+

+horizontal bar:

+  y := from y;

+  WHILE y < to y

+  REP move (from x, y);

+      draw (to x, y);

+      y INCR 5

+  PER  .

+

+vertical bar:

+  x := from x + 5;

+  WHILE x < to x

+  REP move (x, from y);

+      draw (x, to y);

+      x INCR 5

+  PER  .

+

+diagonal right bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (max (from x, to x-y-width+from y), max (from y, y));

+      draw (min (to x, from x+to y-y), min (to y, y+width));

+      y INCR 5

+  PER  .

+

+diagonal left bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (min (to x, to x-from y+y),  max (from y, y));

+      draw (max (from x, from x+y+width-to y), min (to y, y+width)); 

+      y INCR 5

+  PER  .

+

+diagonal both bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (max (from x, to x-y-width+from y), max (from y, y));

+      draw (min (to x, from x+to y-y), min (to y, y+width)); 

+      move (min (to x, to x-from y+y),  max (from y, y));

+      draw (max (from x, from x+y+width-to y), min (to y, y+width));

+      y INCR 5

+  PER  .

+

+END PROC bar;

+

+PROC circle (REAL CONST r, from, to, INT CONST pattern):

+  REAL VAR t :: from;

+  WHILE t < to

+  REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v);

+      draw (h, v);

+      t INCR 1.0

+  PER;

+  transform (pos.x, pos.y, 0.0, h, v);

+  draw (h, v)  .

+

+END PROC circle;

+

+ENDPACKET basis plot;

diff --git a/app/mpg/1987/src/DIPCHIPS.DS b/app/mpg/1987/src/DIPCHIPS.DS
new file mode 100644
index 0000000..2cdd8e9
--- /dev/null
+++ b/app/mpg/1987/src/DIPCHIPS.DS
diff --git a/app/mpg/1987/src/FUPLOT.ELA b/app/mpg/1987/src/FUPLOT.ELA
new file mode 100644
index 0000000..1d0d247
--- /dev/null
+++ b/app/mpg/1987/src/FUPLOT.ELA
@@ -0,0 +1,319 @@
+PACKET fuplot DEFINES axis,                      (*Autor : H.Indenbirken *)

+                      plot,                      (*Stand : 23.02.85      *)

+                      cube:

+

+PICTURE VAR pic;

+TEXT VAR value text;

+

+PICTURE PROC cube (REAL CONST x min, x max, INT CONST no x,

+                   REAL CONST y min, y max, INT CONST no y,

+                   REAL CONST z min, z max, INT CONST no z):

+  cube (x min, x max, (x max-x min)/real (no x),

+        y min, y max, (y max-y min)/real (no y),

+        z min, z max, (z min-z max)/real (no z))

+END PROC cube;

+

+PICTURE PROC cube (REAL CONST x min, x max, dx, y min, y max, dy, z min, z max, dz):

+  pic := cube (x min, x max, y min, y max, z min, z max);

+  move (pic, x max, y min, z min); draw (pic, text (x max)); 

+  move (pic, x min, y max, z min); draw (pic, text (y max)); 

+  move (pic, x min, y min, z max); draw (pic, text (z max));

+ 

+  draw tabs (pic, x min, y min, z min, x max, y min, z min, dx, 0.0, 0.0);

+  draw tabs (pic, x min, y min, z min, x min, y max, z min, 0.0, dy, 0.0);

+  draw tabs (pic, x min, y min, z min, x min, y min, z max, 0.0, 0.0, dx);

+  pic

+END PROC cube;

+

+PICTURE PROC cube (REAL CONST x min, x max, y min, y max, z min, z max):

+  pic := nilpicture;

+  move (pic, x min, y min, z min);

+  draw (pic, x max, y min, z min);

+  draw (pic, x max, y max, z min);

+  draw (pic, x min, y max, z min);

+  draw (pic, x min, y min, z min);

+

+  move (pic, x min, y min, z max);

+  draw (pic, x max, y min, z max);

+  draw (pic, x max, y max, z max);

+  draw (pic, x min, y max, z max);

+  draw (pic, x min, y min, z max);

+

+  move (pic, x min, y min, z min);

+  draw (pic, x min, y min, z max);

+

+  move (pic, x max, y min, z min);

+  draw (pic, x max, y min, z max);

+

+  move (pic, x max, y max, z min);

+  draw (pic, x max, y max, z max);

+

+  move (pic, x min, y max, z min);

+  draw (pic, x min, y max, z max);

+  pic

+

+END PROC cube;

+

+PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x,

+                   REAL CONST y min, y max, INT CONST no y) :

+  axis (x min, x max, (x max-x min) / real (no x - 1),

+        y min, y max, (y max-y min) / real (no y - 1))

+END PROC axis;

+

+PICTURE PROC axis (REAL CONST x min, x max, dx, y min, y max, dy) :

+  REAL CONST x diff :: x max - x min,

+             y diff :: y max - y min;

+  pic := nilpicture;

+  calc axis pos;

+  IF dx > 0.0

+  THEN x axis FI;

+  IF dy > 0.0

+  THEN y axis FI;

+  pic  .

+

+calc axis pos :

+  REAL VAR x0, y0;

+  IF x min < 0.0 AND x max < 0.0

+  THEN y0 := y max

+  ELIF x min > 0.0 AND x max > 0.0

+  THEN y0 := y max

+  ELSE y0 := 0.0 FI;

+

+  IF y min < 0.0 AND y max < 0.0

+  THEN x0 := x max

+  ELIF y min > 0.0 AND y max > 0.0

+  THEN x0 := x max

+  ELSE x0 := 0.0 FI  .

+

+x axis :

+  move (pic, x max, y0);

+  move cm r (pic, 0.1, -0.3);

+  draw (pic, "X");

+

+  draw tabs (pic, x0,y0, x max,y0, dx,0.0); 

+  value text := text (x max);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text);

+

+  draw tabs (pic, x0,y0, x min,y0,-dx,0.0);

+  value text := text (x min);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text)  .

+

+y axis :

+  move (pic, x0, y max);

+  move cm r (pic, -0.18, 0.1);

+  draw (pic, "Y");

+

+  draw tabs (pic, x0,y0, x0,y max, 0.0, dy); 

+  value text := text (y max);

+  draw (pic, length (value text) * ""8"" + value text);

+

+  draw tabs (pic, x0,y0, x0,y min, 0.0,-dy);

+  value text := text (y min);

+  draw (pic, length (value text) * ""8"" + value text)  .

+

+END PROC axis;

+

+PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0, x1,y1, dx,dy) :

+  move (pic, x0, y0);

+  draw (pic, x1, y1);

+

+  REAL VAR x :: x0, y :: y0;

+  INT VAR i :: 0;

+  WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1)

+  REP move (pic, x, y);

+      IF dx <> 0.0

+      THEN draw cm r (pic, 0.0, size)

+      ELIF dy <> 0.0

+      THEN draw cm r (pic, size, 0.0) FI;

+      i INCR 1;

+      x INCR dx; y INCR dy

+  PER  .

+

+size:

+  IF i MOD 10 = 0

+  THEN -0.75

+  ELIF i MOD 5 = 0

+  THEN -0.5

+  ELSE -0.3 FI  .

+

+END PROC draw tabs;

+

+PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x,

+                   REAL CONST y min, y max, INT CONST no y,

+                   REAL CONST z min, z max, INT CONST no z) :

+  axis (x min, x max, (x max-x min) / real (no x - 1),

+        y min, y max, (y max-y min) / real (no y - 1),

+        z min, z max, (z max-z min) / real (no z - 1))

+END PROC axis;

+

+PICTURE PROC axis (REAL CONST x min, x max, dx,

+                              y min, y max, dy,

+                              z min, z max, dz) :

+  REAL CONST x diff :: x max - x min,

+             y diff :: y max - y min,

+             z diff :: z max - z min;

+  pic := nilpicture;

+  calc axis pos;

+  IF dx > 0.0

+  THEN x axis FI;

+  IF dy > 0.0

+  THEN y axis FI;

+  IF dz > 0.0

+  THEN z axis FI;

+  pic  .

+

+calc axis pos :

+  REAL VAR x0, y0, z0;

+  IF x min < 0.0 AND x max < 0.0

+  THEN y0 := y max

+  ELIF x min > 0.0 AND x max > 0.0

+  THEN y0 := y max

+  ELSE y0 := 0.0 FI;

+

+  IF y min < 0.0 AND y max < 0.0

+  THEN x0 := x max

+  ELIF y min > 0.0 AND y max > 0.0

+  THEN x0 := x max

+  ELSE x0 := 0.0 FI;

+

+  IF z min < 0.0 AND z max < 0.0

+  THEN z0 := z max

+  ELIF z min > 0.0 AND z max > 0.0

+  THEN z0 := z max

+  ELSE z0 := 0.0 FI  .

+

+x axis :

+  move (pic, x max, y0, z0);

+  move cm r (pic, 0.1, -0.3);

+  draw (pic, "X");

+

+  draw tabs (pic, x0,y0,z0, x max,y0,z0, dx,0.0,0.0); 

+  value text := text (x max);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); 

+

+  draw tabs (pic, x0,y0,z0, x min,y0,z0,-dx,0.0,0.0);

+  value text := text (x min);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text)  .

+

+y axis :

+  move (pic, x0, y max, z0);

+  move cm r (pic, -0.18, -0.1);

+  draw (pic, "Y");

+

+  draw tabs (pic, x0,y0,z0, x0,y max,z0, 0.0, dy,0.0); 

+  value text := text (y max);

+  draw (pic, length (value text) * ""8"" + value text); 

+

+  draw tabs (pic, x0,y0,z0, x0,y min,z0, 0.0,-dy,0.0);

+  value text := text (y min);

+  draw (pic, length (value text) * ""8"" + value text)  .

+

+z axis :

+  move (pic, x0, y0, z max);

+  move cm r (pic, 0.1, -0.3);

+  draw (pic, "Z");

+

+  draw tabs (pic, x0,y0,z0, x0,y0,z max, 0.0,0.0, dz); 

+  value text := text (z max);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); 

+

+  draw tabs (pic, x0,y0,z0, x0,y0,z min, 0.0,0.0,-dz);

+  value text := text (z min);

+  draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text)  .

+

+END PROC axis;

+

+PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0,z0, x1,y1,z1, dx,dy,dz) :

+  move (pic, x0, y0, z0);

+  draw (pic, x1, y1, z1);

+

+  REAL VAR x :: x0, y :: y0, z :: z0;

+  INT VAR i :: 0;

+  WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1) AND abs (z) <= abs (z1) 

+  REP move (pic, x, y, z);

+      IF dx <> 0.0

+      THEN draw cm r (pic, 0.0, size);

+      ELIF dy <> 0.0

+      THEN draw cm r (pic, size, 0.0);

+      ELIF dz <> 0.0

+      THEN draw cm r (pic, 0.0, size) FI;

+      i INCR 1;

+      x INCR dx; y INCR dy; z INCR dz 

+  PER  .

+

+size:

+  IF i MOD 10 = 0

+  THEN -0.75

+  ELIF i MOD 5 = 0

+  THEN -0.5

+  ELSE -0.3 FI  .

+

+END PROC draw tabs;

+

+PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f,

+           REAL CONST x min, x max, INT CONST pixel x,

+           REAL CONST z min, z max, INT CONST pixel z) :

+  plot (p, PROC f, 1, x min, x max, (x max-x min) / real (pixel x),

+                      z min, z max, (z max-z min) / real (pixel z))

+END PROC plot;

+

+PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST pen,

+           REAL CONST x min, x max, INT CONST pixel x,

+           REAL CONST z min, z max, INT CONST pixel z) :

+  plot (p, PROC f, pen, x min, x max, (x max-x min) / real (pixel x),

+                        z min, z max, (z max-z min) / real (pixel z))

+END PROC plot;

+

+PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f,

+           REAL CONST x min, x max, dx,

+           REAL CONST z min, z max, dz) : 

+  plot (p, PROC f, 1, x min, x max, dx, z min, z max, dz)

+END PROC plot;

+

+PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST n,

+           REAL CONST x min, x max, dx,

+           REAL CONST z min, z max, dz) :

+  REAL VAR z := z min;

+  line;

+  WHILE z <= z max

+  REP out (""13""5"Ebene: " + text (z));

+      pic := plot (PROC f, x min, x max, dx, z);

+      pen (pic, n);

+      put picture (p, pic);

+      z INCR dz

+  PER  .

+

+END PROC plot;

+

+PICTURE PROC plot (REAL PROC (REAL CONST, REAL CONST) f, 

+                   REAL CONST x min, x max, dx, z):

+  pic := nilpicture;

+  REAL VAR x := x min;

+  move (pic, x, f (x, z), z);

+  WHILE x < x max

+  REP x INCR dx;

+      draw (pic, x, f (x, z), z);

+  PER;

+  draw (pic, x, f (x, z), z);

+  pic  .

+

+END PROC plot;

+

+PICTURE PROC plot (REAL PROC (REAL CONST) f,

+                   REAL CONST x min, x max, INT CONST pixel) :

+  plot (PROC f, x min, x max, (x max-x min) / real (pixel))

+END PROC plot;

+

+PICTURE PROC plot (REAL PROC (REAL CONST) f, REAL CONST x min, x max, dx) :

+  PICTURE VAR pic :: nilpicture;

+  REAL VAR x := x min;

+  move (pic, x, f (x));

+  WHILE x < x max

+  REP x INCR dx;

+      draw (pic, x, f (x));

+  PER;

+  draw (pic, x, f (x));

+  pic

+END PROC plot;

+

+END PACKET fuplot

diff --git a/app/mpg/1987/src/GRAPHIK.Basis b/app/mpg/1987/src/GRAPHIK.Basis
new file mode 100644
index 0000000..62cb790
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Basis
@@ -0,0 +1,1573 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.2 vom 23.09.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*         "Graphik-Basis" geschrieben von C.Weinholz/EUMEL-Std           *) 

+(*                                                                        *)

+(**************************************************************************) 

+(*                                                                        *) 

+(*           Paket I: Endgeraet-unabhaengige Graphikroutinen              *) 

+(*                                                                        *)

+(*                 1. Transformation (Umsetzung 3D -> 2D),                *) 

+(*                    Clipping und Normierung                             *) 

+(*                 2. PICTURE - Verwaltung                                *) 

+(*                    (geanderte Standard-Version)                        *) 

+(*                 3. PICFILE - Verwaltung                                *) 

+(*                    (geanderte Standard-Version)                        *) 

+(*                 4. Endgeraet - Verwaltung                              *) 

+(*                                                                        *)

+(**************************************************************************)

+(*   Urversion  : 10.09.87                                                *) 

+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 

+(*                OP := (PICFILE VAR, PICFILE CONST) hinzugefuegt         *) 

+(*                TEXT PROC text (PICTURE CONST)                          *) 

+(*                wg. Heapueberlauf geaendert                             *) 

+(*                                                                        *) 

+(**************************************************************************)

+

+(****************************** transformation ****************************)

+

+PACKET transformation DEFINES

+       transform, 

+       set values,

+       get values,

+       new values,

+       drawing area,

+       set drawing area,

+

+       window, 

+       viewport,

+       view, 

+       oblique, 

+       orthographic, 

+       perspective,

+

+       clipped line:

+

+BOOL VAR new limits :: TRUE,

+         values new :: TRUE,

+         perspective projektion :: FALSE;

+

+REAL VAR display hor, display vert,           (*  Anzahl der Pixel         *)

+         size hor, size vert,                 (*  Groesse des Bildschirms  *)

+         size hor d, size vert d,

+         h min limit, h max limit,

+         v min limit, v max limit,

+         h min, h max,

+         v min, v max,

+         relation;

+ 

+ROW 5 ROW 5 REAL VAR p ;

+ROW 3 ROW 2 REAL VAR size d ;

+ROW 2 ROW 2 REAL VAR limits d ;

+ROW 4 REAL VAR angles d ;

+ROW 2 REAL VAR oblique d ;

+ROW 3 REAL VAR perspective d ;

+

+INT VAR i, j;

+

+PROC init transformation rows:

+  size d    := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),

+                                   ROW 2 REAL : (0.0, 1.0),

+                                   ROW 2 REAL : (0.0, 1.0));

+

+  limits d  := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, relation),

+                                   ROW 2 REAL : (0.0, 1.0));

+

+  angles d  := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);

+

+  oblique d := ROW 2 REAL : (0.0, 0.0);

+

+  perspective d := ROW 3 REAL : (0.0, 0.0, 0.0);

+  set values (size d, limits d, angles d, oblique d, perspective d);

+END PROC init transformation rows;

+

+BOOL OP = (ROW 3 ROW 2 REAL CONST l, r):

+  FOR i FROM 1 UPTO 3

+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]

+      THEN LEAVE = WITH FALSE FI

+  PER;

+  TRUE

+END OP =;

+

+BOOL OP = (ROW 2 ROW 2 REAL CONST l, r):

+  FOR i FROM 1 UPTO 2

+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]

+      THEN LEAVE = WITH FALSE FI

+  PER;

+  TRUE

+END OP =;

+

+BOOL OP = (ROW 2 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2]

+END OP =;

+

+BOOL OP = (ROW 3 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3]

+END OP =;

+

+BOOL OP = (ROW 4 REAL CONST l, r):

+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] 

+END OP =;

+

+PROC oblique (REAL CONST a, b) :

+  set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) 

+END PROC oblique;

+

+PROC orthographic :

+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))

+END PROC orthographic;

+

+PROC perspective (REAL CONST cx, cy, cz) :

+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy,-cz))

+END PROC perspective;

+

+PROC window (BOOL CONST dev) :

+  new limits := dev

+END PROC window;

+

+PROC window (REAL CONST x min, x max, y min, y max) :

+  window (x min, x max, y min, y max, 0.0, 1.0)

+END PROC window;

+

+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :

+  set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),

+                                  ROW 2 REAL : (y min, y max),

+                                  ROW 2 REAL : (z min, z max)),

+              limits d, angles d, oblique d, perspective d)

+END PROC window;

+

+PROC viewport (REAL CONST h min, h max, v min, v max) :

+  set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), 

+                                          ROW 2 REAL : (v min, v max)),

+              angles d, oblique d, perspective d)

+END PROC view port;

+

+PROC view (REAL CONST alpha) :

+  set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)),

+              oblique d, perspective d)

+END PROC view;

+

+PROC view (REAL CONST phi, theta) :

+  set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi),

+                                              sind (theta) * sind (phi), cosd (theta)),

+              oblique d, perspective d)

+END PROC view;

+

+PROC view (REAL CONST x, y, z) :

+  set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d)

+END PROC view;

+

+PROC drawing area (REAL VAR min h, max h, min v, max v):

+  min h := h min limit;  max h := h max limit;

+  min v := v min limit;  max v := v max limit

+END PROC drawing area;

+ 

+PROC set drawing area (REAL CONST new size hor,new size vert, 

+                                  new display hor,new display vert): 

+  size hor := new size hor; 

+  size vert:= new size vert; 

+  display hor := new display hor; 

+  display vert:= new display vert; 

+  relation := size hor/size vert; 

+  new limits := TRUE; 

+  init transformation rows

+END PROC set drawing area; 

+ 

+BOOL PROC new values:

+  IF values new

+  THEN values new := FALSE;

+       TRUE

+  ELSE FALSE FI

+END PROC new values;

+

+PROC get values (ROW 3 ROW 2 REAL VAR size, 

+                 ROW 2 ROW 2 REAL VAR limits,

+                 ROW 4 REAL VAR angles,

+                 ROW 2 REAL VAR oblique,

+                 ROW 3 REAL VAR perspective) : 

+  size        := size d;

+  limits      := limits d;

+  angles      := angles d;

+  oblique     := oblique d;

+  perspective := perspective d;

+

+END PROC get values;

+

+PROC set values (ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 4 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) : 

+   IF NOT same values

+   THEN values new := TRUE;

+        copy values;

+        set views;

+        check perspective projektion; 

+        calc limits;

+        change projektion

+   FI  .

+

+same values:

+  size hor d  = size hor  AND size vert d  = size vert AND

+  size d = size AND limits d = limits AND angles d = angles AND

+  oblique d = oblique AND perspective d = perspective  . 

+

+copy values :

+  size hor d := size hor;

+  size vert d := size vert;

+  size d := size;

+  limits d := limits;

+  angles d := angles;

+  oblique d := oblique;

+  perspective d := perspective  .

+

+set views :

+  REAL VAR diagonale := sqrt (angles [2] * angles [2] +

+                              angles [3] * angles [3] +

+                              angles [4] * angles [4]),

+           projektion := sqrt (angles [2] * angles [2] +

+                               angles [4] * angles [4]),

+           sin p, cos p, sin t, cos t, sin a, cos a;

+

+           IF diagonale = 0.0

+           THEN sin p :=  0.0;  cos p :=  1.0;

+                sin t :=  0.0;  cos t :=  1.0

+           ELIF projektion = 0.0

+           THEN sin p :=  angles [3] / diagonale;

+                cos p :=  projektion / diagonale;

+                sin t :=  0.0;  cos t :=  1.0

+           ELSE sin p :=  angles [3] / diagonale;

+                cos p :=  projektion / diagonale;

+                sin t :=  angles [2] / projektion;

+                cos t :=  angles [4] / projektion

+           FI;

+

+  REAL VAR   sin p sin t := sin p * sin t,

+             sin p cos t := sin p * cos t,

+             cos p sin t := cos p * sin t,

+             cos p cos t := cos p * cos t,

+

+             dx          := size [1][2] - size [1][1],

+             dy          := size [2][2] - size [2][1],

+             dz          := size [3][2] - size [3][1],

+             norm az     := oblique [1] ,

+             norm bz     := oblique [2] ,

+             norm cx     := perspective [1] / dx,

+             norm cy     := perspective [2] / dy,

+             norm cz     := perspective [3] / dz;

+            

+p :=  ROW 5 ROW 5 REAL :

+      (ROW 5 REAL : (  cos t       / dx - cos p sin t / dx * norm az ,

+                     - sin p sin t / dx - cos p sin t / dx * norm bz,

+                       0.0,

+                                        - cos p sin t / dx * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (                   - sin p       / dy * norm az,

+                       cos p       / dy - sin p       / dy * norm bz,

+                       0.0, 

+                                        - sin p       / dy * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (  sin t       / dz + cos p cos t / dz * norm az,

+                     + sin p cos t / dz + cos p cos t / dz * norm bz,

+                       0.0,

+                                        cos p cos t / dz * norm cz,

+                       0.0 ),

+       ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),

+       ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

+

+  IF angles (1) = 0.0

+  THEN set alpha as y vertical

+  ELSE sin a := sind (angles (1));

+       cos a := cosd (angles (1))

+  FI;

+ 

+  FOR j FROM 1 UPTO 5

+  REP REAL CONST p  j 1 := p (j)(1);

+      p (j)(1) :=  p  j  1  * cos a - p (j)(2) * sin a;

+      p (j)(2) :=  p  j  1  * sin a + p (j)(2) * cos a 

+  PER  .

+

+set alpha as y vertical :

+  REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);

+  IF r = 0.0

+  THEN sin a := 0.0;

+       cos a := 1.0

+  ELSE sin a :=-p(2)(1)/r;

+       cos a := p(2)(2)/r

+  FI  .

+

+check perspective projektion:

+  perspective projektion := perspective [3] <> 0.0  .

+

+calc limits :

+  IF new limits

+  THEN calc two dim extrema;

+       IF all limits smaller than 2

+       THEN prozente

+       ELSE zentimeter FI

+  FI  .

+

+calc two dim extrema :

+  h min := max real;  h max :=-max real;

+  v min := max real;  v max :=-max real;

+ 

+  extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); 

+  extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);

+  extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); 

+  extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);

+  extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); 

+  extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);

+  extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); 

+  extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max)  .

+

+all limits smaller than 2 :

+  limits (1)(2) < 2.0 AND limits (2)(2) < 2.0  .

+

+prozente :

+  h min limit := display hor * limits (1)(1)/relation;

+  h max limit := display hor * limits (1)(2)/relation;

+ 

+  v min limit := limits (2)(1) * display vert;

+  v max limit := limits (2)(2) * display vert  .

+ 

+zentimeter : 

+  h min limit := display hor * (limits (1)(1)/size hor);

+  h max limit := display hor * (limits (1)(2)/size hor);

+ 

+  v min limit := display vert * (limits (2)(1)/size vert);

+  v max limit := display vert * (limits (2)(2)/size vert)  .

+

+change projektion :

+  REAL VAR sh := (h max limit - h min limit) / (h max - h min),

+           sv := (v max limit - v min limit) / (v max - v min),

+           dh := h min limit - h min*sh,

+           dv := v min limit - v min*sv;

+

+  FOR j FROM 1 UPTO 5

+  REP

+     p (j)(1) := p (j)(1) * sh;

+     p (j)(2) := p (j)(2) * sv

+  PER;

+  p (5)(1) := dh;

+  p (5)(2) := dv.

+END PROC set values;

+ 

+PROC transform (REAL CONST x, y, z, INT VAR h, v) :

+  disable stop;

+  IF perspective projektion

+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);

+       h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));

+       v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))

+  ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));

+       v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));

+  FI;

+  IF is error

+  THEN h := -1;

+       v := -1;

+       clear error

+  FI

+END PROC transform;

+

+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):

+  REAL VAR h, v;

+  IF perspective projektion

+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);

+       h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;

+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w

+  ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));

+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))

+  FI;

+ 

+ IF h < h min

+ THEN h min := h

+ ELIF h > h max

+ THEN h max := h FI;

+

+ IF v < v min

+ THEN v min := v

+ ELIF v > v max

+ THEN v max := v FI

+

+END PROC extrema;

+ 

+BOOL PROC clipped line (REAL VAR x0,y0,x1,y1): 

+  REAL VAR dx  :: (display hor - 1.0) / 2.0, 

+           dy  :: (display vert- 1.0) / 2.0, 

+           rx0 :: x0 - dx, 

+           ry0 :: y0 - dy, 

+           rx1 :: x1 - dx, 

+           ry1 :: y1 - dy; 

+  INT VAR  cx0, 

+           cy0, 

+           cx1, 

+           cy1; 

+  calculate cells; 

+  IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1)

+    THEN FALSE

+  ELIF (x0 = x1) AND (y0 = y1)

+    THEN cx0 = 0 AND cy0 = 0

+    ELSE do clipping 

+  FI.

+ 

+  do clipping: 

+    IF cx0 <> 0 

+      THEN REAL VAR next x :: real(cx0) * dx; 

+           ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0;

+           rx0 := next x 

+    FI; 

+    calculate cells; 

+    IF cy0 <> 0 

+      THEN REAL VAR next y :: real(cy0) * dy; 

+           rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; 

+           ry0 := next y 

+    FI; 

+    IF cx1 <> 0 

+      THEN next x := real(cx1) * dx; 

+           ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1;

+           rx1 := next x 

+    FI; 

+    calculate cells; 

+    IF cy1 <> 0 

+      THEN next y := real(cy1) * dy; 

+           rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; 

+           ry1 := next y 

+    FI; 

+    IF (rx1 = rx0) AND (ry1 = ry0) 

+      THEN FALSE 

+      ELSE x0 := rx0+dx; 

+           y0 := ry0+dy; 

+           x1 := rx1+dx; 

+           y1 := ry1+dy; 

+           TRUE 

+    FI. 

+ 

+    calculate cells: 

+      cx0 := 0; 

+      cy0 := 0; 

+      cx1 := 0; 

+      cy1 := 0; 

+      IF abs(rx0) > dx 

+        THEN cx0 := sign(rx0) 

+      FI;

+      IF abs(rx1) > dx 

+        THEN cx1 := sign(rx1) 

+      FI;

+      IF abs(ry0) > dy 

+        THEN cy0 := sign(ry0) 

+      FI;

+      IF abs(ry1) > dy 

+        THEN cy1 := sign(ry1) 

+      FI. 

+ 

+END PROC clipped line; 

+

+END PACKET transformation; 

+ 

+(******************************** picture ********************************)

+

+PACKET picture DEFINES                            (* Autor: H.Indenbirken  *)

+               PICTURE,                           (* Stand: 23.02.1985     *)

+               :=, CAT, nilpicture,

+               draw, draw r, draw cm, draw cm r,

+               move, move r, move cm, move cm r, 

+               bar, circle,

+               length, dim, pen, where,

+               extrema, rotate, stretch, translate,

+               text, picture:

+

+LET draw key      = 1,

+    move key      = 2,

+    text key      = 3,

+    move r key    = 4,

+    draw r key    = 5,

+    move cm key   = 6, 

+    draw cm key   = 7,

+    move cm r key = 8,

+    draw cm r key = 9,

+    bar key       = 10,

+    circle key    = 11,

+    max 2 dim     = 31983,

+    max 3 dim     = 31975,

+    max text      = 31974,

+    max bar       = 31982,

+    max circle    = 31974,

+    max length    = 32000;

+

+

+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);

+

+

+INT VAR read pos;

+REAL VAR x, y, z;

+TEXT VAR r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0"";

+

+OP := (PICTURE VAR l, PICTURE CONST r) :

+  CONCR (l) := CONCR (r)

+END OP :=;

+

+OP CAT (PICTURE VAR l, PICTURE CONST r) :

+  IF l.dim <> r.dim

+  THEN errorstop ("OP CAT : left dimension <> right dimension")

+  ELIF length (l.points) > max length - length (r.points)

+  THEN errorstop ("OP CAT : Picture overflow") FI;

+

+  l.points CAT r.points

+END OP CAT;

+

+PICTURE PROC nilpicture :

+  PICTURE : (0, 1, "")

+END PROC nilpicture;

+

+PROC draw (PICTURE VAR p, TEXT CONST text) :

+  draw (p, text, 0.0, 0.0, 0.0)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):

+  write (p, text, angle, height, bright, text key)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, draw key)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, draw key)

+END PROC draw;

+

+PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, draw r key)

+END PROC draw r;

+

+PROC draw r (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, draw r key)

+END PROC draw r;

+

+PROC draw cm (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, draw cm key)

+END PROC draw cm;

+

+PROC draw cm r (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, draw cm r key)

+END PROC draw cm r;

+

+PROC move (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, move key)

+END PROC move;

+

+PROC move (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, move key)

+END PROC move;

+

+PROC move r (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, move r key)

+END PROC move r;

+

+PROC move r (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, move r key)

+END PROC move r;

+

+PROC move cm (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, move cm key)

+END PROC move cm;

+

+PROC move cm r (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, move cm r key)

+END PROC move cm r;

+

+PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):

+  write (p, width, height, pattern, bar key)

+END PROC bar;

+

+PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):

+  write (p, radius, from, to, pattern, circle key)

+END PROC circle;

+

+

+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) :

+  IF length (p.points) < max 3 dim

+  THEN p.points CAT code (key); 

+       replace (r3, 1, x);

+       replace (r3, 2, y);

+       replace (r3, 3, z);

+       p.points CAT r3

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) :

+  IF length (p.points) < max 2 dim

+  THEN p.points CAT code (key); 

+       replace (r2, 1, x);

+       replace (r2, 2, y);

+       p.points CAT r2

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) :

+  IF length (p.points) < max bar

+  THEN p.points CAT code (key); 

+       replace (r2, 1, x);

+       replace (r2, 2, y);

+       p.points CAT r2;

+       replace (i1, 1, n);

+       p.points CAT i1

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) :

+  IF length (p.points) < max circle 

+  THEN p.points CAT code (key); 

+       replace (r3, 1, x);

+       replace (r3, 2, y);

+       replace (r3, 3, z);

+       p.points CAT r3;

+       replace (i1, 1, n);

+       p.points CAT i1 

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright,

+            INT CONST key) :

+  IF max text - length (p.points) >= length (t)

+  THEN p.points CAT code (key);

+       replace (i1, 1, length (t));

+       p.points CAT i1;

+       p.points CAT t;

+       replace (r3, 1, angle);

+       replace (r3, 2, height);

+       replace (r3, 3, bright);

+       p.points CAT r3

+  FI;

+END PROC write;

+

+PROC check dim (PICTURE VAR p, INT CONST dim):

+  IF p.dim = 0

+  THEN p.dim := dim

+  ELIF p.dim <> dim

+  THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI

+END PROC check dim;

+

+INT PROC length (PICTURE CONST p):

+  length (p.points)

+END PROC length;

+

+INT PROC dim (PICTURE CONST pic) :

+  pic.dim

+END PROC dim;

+

+PROC pen (PICTURE VAR p, INT CONST pen) :

+  IF pen < 0 OR pen > 16

+  THEN errorstop ("pen out of range [0-16]") FI;

+  p.pen := pen

+END PROC pen;

+

+INT PROC pen (PICTURE CONST p) :

+  p.pen

+END PROC pen;

+

+PROC where (PICTURE CONST p, REAL VAR x, y) :

+  IF p.dim = 0

+  THEN x := 0.0;  y := 0.0

+  ELIF p.dim = 3

+  THEN errorstop ("Picture is 3 dimensional")

+  ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;

+       y := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1

+  FI

+END PROC where;

+

+PROC where (PICTURE CONST p, REAL VAR x, y, z) :

+  IF p.dim = 0

+  THEN x := 0.0;  y := 0.0;  z := 0.0

+  ELIF p.dim = 2

+  THEN errorstop ("Picture is 2 dimensional")

+  ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;

+       y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;

+       z := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1;

+  FI

+END PROC where;

+

+

+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :

+  x min := max real;  x max :=-max real;

+  y min := max real;  y max :=-max real;

+  z min := max real;  z max :=-max real;

+  read pos := 0; 

+  INT CONST pic length := length (p.points);

+  WHILE read pos < pic length

+  REP check position PER  .

+

+check position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : calc extrema

+  CASE move key : calc extrema

+  CASE move r key : calc rel extrema

+  CASE draw r key : calc rel extrema

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+calc extrema :

+  x := next real;  y := next real;  z := next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y);

+  z min := min (z min, z);  z max := max (z max, z)  .

+

+calc rel extrema :

+  x INCR next real;  y INCR next real;  z INCR next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y);

+  z min := min (z min, z);  z max := max (z max, z)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC extrema;

+

+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):

+  x min := max real;  x max :=-max real;

+  y min := max real;  y max :=-max real;

+  read pos := 0; 

+  INT CONST pic length := length (p.points);

+  WHILE read pos < pic length

+  REP check position PER  .

+

+check position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : calc extrema

+  CASE move key : calc extrema

+  CASE move r key : calc rel extrema

+  CASE draw r key : calc rel extrema

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+calc extrema :

+  x := next real;  y := next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y)  .

+

+calc rel extrema :

+  x INCR next real;  y INCR next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC extrema;

+

+PROC rotate (PICTURE VAR p, REAL CONST angle) :   (* X-Rotation *)

+  REAL CONST s :: sind( angle ), c := cosd( angle );

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : ( 1.0,  0.0,  0.0 ),

+                ROW 3 REAL : ( 0.0,   c ,   s  ),

+                ROW 3 REAL : ( 0.0,  -s ,   c  ),

+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))

+END PROC rotate; 

+ 

+PROC yrotate (PICTURE VAR p, REAL CONST angle):  (* Y-Rotation *) 

+  REAL CONST s :: sind (angle), c :: cosd (angle); 

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : (  c ,  0.0,  -s  ), 

+                ROW 3 REAL : ( 0.0,  1.0,  0.0 ), 

+                ROW 3 REAL : (  s ,  0.0,   c  ), 

+                ROW 3 REAL : ( 0.0,  0.0,  0.0 ))) 

+END PROC yrotate; 

+ 

+PROC zrotate (PICTURE VAR p, REAL CONST angle):  (* Z-Rotation *) 

+  REAL CONST s :: sind (angle), c :: cosd (angle); 

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : (  c ,   s ,  0.0 ), 

+                ROW 3 REAL : ( -s ,   c ,  0.0 ), 

+                ROW 3 REAL : ( 0.0,  0.0,  1.0 ), 

+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))

+END PROC zrotate; 

+ 

+PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :

+   IF phi <> 0.0 

+      THEN rotate (p, phi) FI;

+   IF theta <> 0.0 

+      THEN yrotate (p, theta) FI; 

+   IF lambda <> 0.0

+      THEN zrotate (p, lambda)

+   FI

+END PROC rotate; 

+ 

+PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : 

+  stretch (pic, sx, sy, 1.0) 

+END PROC stretch;

+

+PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : ( sx, 0.0, 0.0),

+                ROW 3 REAL : (0.0,  sy, 0.0),

+                ROW 3 REAL : (0.0, 0.0,  sz),

+                ROW 3 REAL : (0.0, 0.0, 0.0)))

+END PROC stretch;

+

+PROC translate (PICTURE VAR p, REAL CONST dx, dy) : 

+  translate (p, dx, dy, 0.0) 

+END PROC translate;

+

+PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : (1.0, 0.0, 0.0),

+                ROW 3 REAL : (0.0, 1.0, 0.0),

+                ROW 3 REAL : (0.0, 0.0, 1.0),

+                ROW 3 REAL : ( dx,  dy,  dz)))

+END PROC translate;

+

+PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :

+  INT CONST pic length := length (p.points);

+  INT VAR begin pos;

+  read pos := 0; 

+  x := 0.0; y := 0.0; z := 0.0;

+  IF p.dim = 2

+  THEN transform 2 dim pic

+  ELSE transform 3 dim pic FI  .

+ 

+transform 2 dim pic:

+  WHILE read pos < pic length

+  REP transform 2 dim position PER  .

+

+transform 2 dim position:

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : transform 2 dim point 

+  CASE move key : transform 2 dim point 

+  CASE move r key : transform 2 dim point 

+  CASE draw r key : transform 2 dim point 

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+transform 2 dim point:

+  begin pos := read pos+1;

+  x := next real;  y := next real;

+  transform (a, x, y, z); 

+  replace (r2, 1, x);

+  replace (r2, 2, y);

+  replace (p.points, begin pos, r2)  .

+

+transform 3 dim pic:

+  WHILE read pos < pic length

+  REP transform 3 dim position PER  .

+

+transform 3 dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : transform 3 dim point 

+  CASE move key : transform 3 dim point 

+  CASE move r key : transform 3 dim point 

+  CASE draw r key : transform 3 dim point 

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+transform 3 dim point:

+  begin pos := read pos+1;

+  x := next real;  y := next real; z := next real;

+  transform (a, x, y, z); 

+  replace (r3, 1, x);

+  replace (r3, 2, y);

+  replace (r3, 3, z);

+  replace (p.points, begin pos, r3)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC transform;

+

+PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :

+  REAL CONST ox :: x, oy :: y, oz :: z;

+  x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);

+  y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);

+  z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)

+END PROC transform;

+

+TEXT PROC text (PICTURE CONST pic):

+  TEXT VAR result :: ""0""0""0""0"";       (* 23.09.87 -cw- *)

+  replace (result, 1, pic.dim);            (* wegen Heap-Ueberlauf *)

+  replace (result, 2, pic.pen);

+  result CAT pic.points;

+  result

+END PROC text;

+

+PICTURE PROC picture (TEXT CONST text):

+  PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5))

+END PROC picture;

+

+END PACKET picture;

+

+(******************************** picfile *********************************) 

+

+PACKET picfile DEFINES                            (* Autor: H.Indenbirken  *)

+                                                  (* Stand: 23.02.1985     *)

+               PICFILE, :=, picture file,

+               select pen, selected pen, background, 

+               set values, get values,

+               view, viewport, window, oblique, orthographic, perspective,

+               extrema,

+

+               put, get,

+               to first pic, to eof, to pic, up, down,

+               is first picture, eof, picture no, pictures,

+               delete picture, insert picture, read picture,

+               write picture, put picture:

+

+

+LET max pics = 1024,

+    pic dataspace = 1102;

+

+

+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,

+                             ROW 16 ROW 3 INT pens,

+                             ROW 16 BOOL hidden,

+                             ROW 3 ROW 2 REAL sizes,

+                             ROW 2 ROW 2 REAL limits,

+                             ROW 4 REAL angles,

+                             ROW 2 REAL obliques,

+                             ROW 3 REAL perspectives,

+                             ROW max pics PICTURE pic);

+

+TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0"";

+INT VAR i;

+

+OP := (PICFILE VAR dest, PICFILE CONST source):

+   EXTERNAL 260

+END OP := ;

+

+OP := (PICFILE VAR p, DATASPACE CONST d) :

+  IF type (d) = pic dataspace

+    THEN CONCR (p) := d

+  ELIF type (d) < 0

+    THEN type (d, pic dataspace) ;

+         CONCR (p) := d ;

+         init picfile dataspace ;

+  ELSE errorstop ("dataspace is no PICFILE") FI .

+ 

+init picfile dataspace :

+  r.size := 0;

+  r.pos  := 0;

+  r.background := 0;

+  r.sizes  [1][1] := 0.0;

+  r.sizes  [1][2] := 1.0;

+  r.sizes  [2][1] := 0.0;

+  r.sizes  [2][2] := 1.0;

+  r.sizes  [3][1] := 0.0;

+  r.sizes  [3][2] := 1.0;

+  r.limits [1][1] := 0.0;

+  r.limits [1][2] := 1.0;

+  r.limits [2][1] := 0.0;

+  r.limits [2][2] := 1.0;

+  r.angles [1]    := 0.0;

+  r.angles [2]    := 0.0;

+  r.angles [3]    := 0.0;

+  r.angles [4]    := 0.0;

+  r.obliques [1]  := 0.0;

+  r.obliques [2]  := 0.0;

+  r.perspectives [1] := 0.0;

+  r.perspectives [2] := 0.0;

+  r.perspectives [3] := 0.0;

+  FOR i FROM 1 UPTO 16

+  REP r.pens [i][1] := 1;

+      r.pens [i][2] := 0;

+      r.pens [i][3] := 1;

+      r.hidden [i] := TRUE

+  PER.

+  

+r : CONCR (CONCR (p)).

+

+END OP :=;

+ 

+DATASPACE PROC picture file (TEXT CONST name) :

+  IF exists (name)

+  THEN old (name)

+  ELSE new (name) FI 

+END PROC picture file;

+

+PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type,

+                                BOOL CONST hidden):

+  IF pen < 1 OR pen > 16

+  THEN errorstop ("pen out of range") FI;

+  p.pens   [pen][1] := colour;

+  p.pens   [pen][2] := thickness;

+  p.pens   [pen][3] := line type;

+  p.hidden [pen] := hidden

+END PROC select pen;

+

+PROC selected pen (PICFILE CONST p, INT CONST pen,

+                                    INT VAR colour, thickness, line type,

+                                    BOOL VAR hidden):

+  IF pen < 1 OR pen > 16

+  THEN errorstop ("pen out of range") FI;

+  colour    := p.pens [pen][1];

+  thickness := p.pens [pen][2];

+  line type := p.pens [pen][3];

+  hidden    := p.hidden [pen]

+END PROC selected pen;

+

+INT PROC background (PICFILE CONST p):

+  p.background

+END PROC background;

+

+PROC background (PICFILE VAR p, INT CONST colour):

+  p.background := colour

+END PROC background;

+

+PROC get values (PICFILE CONST p,

+                 ROW 3 ROW 2 REAL VAR size, 

+                 ROW 2 ROW 2 REAL VAR limits,

+                 ROW 4 REAL VAR angles,

+                 ROW 2 REAL VAR oblique,

+                 ROW 3 REAL VAR perspective) : 

+  size        := p.sizes;

+  limits      := p.limits;

+  angles      := p.angles;

+  oblique     := p.obliques;

+  perspective := p.perspectives;

+

+END PROC get values;

+ 

+PROC set values (PICFILE VAR p,

+                 ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 4 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) : 

+  p.sizes        := size;

+  p.limits       := limits;

+  p.angles       := angles;

+  p.obliques     := oblique;

+  p.perspectives := perspective;

+

+END PROC set values;

+ 

+PROC view (PICFILE VAR p, REAL CONST alpha):

+  p.angles [1] := alpha

+END PROC view;

+

+PROC view (PICFILE VAR p, REAL CONST phi, theta):

+  p.angles [2] := sind (theta) * cosd (phi);

+  p.angles [3] := sind (theta) * sind (phi);

+  p.angles [4] := cosd (theta);

+END PROC view;

+

+PROC view (PICFILE VAR p, REAL CONST x, y, z):

+  p.angles [2] := x;

+  p.angles [3] := y;

+  p.angles [4] := z

+END PROC view;

+

+PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :

+  p.limits [1][1] := hor min;

+  p.limits [1][2] := hor max;

+  p.limits [2][1] := vert min;

+  p.limits [2][2] := vert max;

+END PROC viewport;

+

+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :

+  window (p, x min, x max, y min, y max, 0.0, 1.0)

+END PROC window;

+

+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :

+  p.sizes [1][1] := x min;

+  p.sizes [1][2] := x max;

+  p.sizes [2][1] := y min;

+  p.sizes [2][2] := y max;

+  p.sizes [3][1] := z min;

+  p.sizes [3][2] := z max;

+END PROC window;

+

+PROC oblique (PICFILE VAR p, REAL CONST a, b) :

+  p.obliques [1] := a;

+  p.obliques [2] := b;

+  p.perspectives [1] := 0.0;

+  p.perspectives [2] := 0.0;

+  p.perspectives [3] := 0.0

+END PROC oblique;

+

+PROC orthographic (PICFILE VAR p) :

+  p.obliques [1] := 0.0;

+  p.obliques [2] := 0.0;

+  p.perspectives [1] := 0.0;

+  p.perspectives [2] := 0.0;

+  p.perspectives [3] := 0.0

+END PROC orthographic;

+ 

+PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :

+  p.obliques [1] := 0.0;

+  p.obliques [2] := 0.0;

+  p.perspectives [1] := cx;

+  p.perspectives [2] := cy;

+  p.perspectives [3] := cz

+END PROC perspective;

+ 

+PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :

+  REAL VAR dummy;

+  extrema (p, x min, x max, y min, y max, dummy, dummy)

+END PROC extrema;

+

+PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :

+  REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;

+  x min := max real;  x max := - max real;

+  y min := max real;  y max := - max real;

+  z min := max real;  z max := - max real;

+  FOR i FROM 1 UPTO p.size

+  REP IF dim (p.pic [i]) = 2

+      THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) 

+      ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,

+                               new z min, new z max)

+      FI;

+      x min := min (x min, new x min); x max := max (x max, new x max); 

+      y min := min (y min, new y min); y max := max (y max, new y max); 

+      z min := min (z min, new z min); z max := max (z max, new z max); 

+  PER

+END PROC extrema;

+

+PROC put (FILE VAR f, PICFILE CONST p):

+  put line (f, parameter);

+  FOR i FROM 1 UPTO p.size

+  REP put line (f, text (p.pic [i])) PER  .

+

+parameter:

+  intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) +

+  intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) +

+  intern (p.obliques) + intern (p.perspectives)  .

+

+END PROC put;

+

+PROC get (PICFILE VAR p, FILE VAR f):

+  TEXT VAR record;

+  get line (f, record);

+  convert parameter;

+  FOR i FROM 1 UPTO p.size

+  REP get line (f, record);

+      p.pic [i] := picture (record)

+  PER  .

+

+convert parameter:

+  convert (record, p.size);        convert (record, p.pos);

+  convert (record, p.background);  convert (record, p.pens);

+  convert (record, p.hidden);      convert (record, p.sizes);

+  convert (record, p.limits);      convert (record, p.angles);

+  convert (record, p.obliques);    convert (record, p.perspectives)  .

+

+END PROC get;

+

+PROC to first pic (PICFILE VAR p):

+  p.pos := 1

+END PROC to first pic;

+

+PROC to eof (PICFILE VAR p):

+ p.pos := p.size+1

+END PROC to eof;

+

+PROC to pic (PICFILE VAR p, INT CONST n):

+  IF n < 1

+  THEN errorstop ("Position underflow")

+  ELIF n > p.size

+  THEN errorstop ("Position after end of PICFILE")

+  ELSE p.pos := n FI

+END PROC to pic;

+

+PROC up (PICFILE VAR p):

+  to pic (p, p.pos-1)

+END PROC up;

+

+PROC up (PICFILE VAR p, INT CONST n):

+  to pic (p, p.pos-n)

+END PROC up;

+

+PROC down (PICFILE VAR p):

+  to pic (p, p.pos+1)

+END PROC down;

+

+PROC down (PICFILE VAR p, INT CONST n):

+  to pic (p, p.pos+n)

+END PROC down;

+

+BOOL PROC is first picture (PICFILE CONST p):

+  p.pos = 1

+END PROC is first picture;

+

+BOOL PROC eof (PICFILE CONST p):

+  p.pos >= p.size

+END PROC eof;

+

+INT PROC picture no (PICFILE CONST p):

+  p.pos

+END PROC picture no;

+

+INT PROC pictures (PICFILE CONST p):

+  p.size

+END PROC pictures;

+

+PROC delete picture (PICFILE VAR p) :

+  INT VAR i;

+  FOR i FROM p.pos+1 UPTO p.size

+  REP p.pic [i-1] := p.pic [i] PER;

+

+  p.pic [p.size] := nilpicture;

+  IF p.size > 1

+  THEN p.size DECR 1 FI

+END PROC delete picture;

+

+PROC insert picture (PICFILE VAR p) :

+  INT VAR i;

+  IF p.size >= max pics

+  THEN errorstop ("PICFILE overflow")

+  ELSE p.size INCR 1;

+       FOR i FROM p.size DOWNTO p.pos+1

+       REP p.pic [i] := p.pic [i-1] PER;

+

+       p.pic [p.pos] := nilpicture;

+  FI

+END PROC insert picture;

+

+PROC read picture (PICFILE VAR p, PICTURE VAR pic) :

+  pic := p.pic (p.pos)  .

+END PROC read picture;

+ 

+PROC write picture (PICFILE VAR p, PICTURE CONST pic) :

+  p.pic (p.pos) := pic  .

+END PROC write picture;

+

+PROC put picture (PICFILE VAR p, PICTURE CONST pic) :

+  IF p.size >= max pics

+  THEN errorstop ("PICFILE overflow")

+  ELSE p.size INCR 1;

+       p.pic [p.size] := pic;

+  FI 

+END PROC put picture;

+

+TEXT PROC intern (INT CONST n):

+  replace (i text, 1, n);

+  i text

+END PROC intern;

+

+TEXT PROC intern (ROW 16 ROW 3 INT CONST n):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 16

+  REP FOR j FROM 1 UPTO 3

+      REP result CAT intern (n [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 16 BOOL CONST n):

+  INT VAR i, result :: 0;

+  FOR i FROM 1 UPTO 16

+  REP IF n [i]

+      THEN set bit (result, i-1) FI

+  PER;

+  intern (result)

+END PROC intern;

+

+TEXT PROC intern (REAL CONST r):

+  replace (r text, 1, r);

+  r text

+END PROC intern;

+

+TEXT PROC intern (ROW 3 ROW 2 REAL CONST r):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 3

+  REP FOR j FROM 1 UPTO 2

+      REP result CAT intern (r [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 2 ROW 2 REAL CONST r):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 2

+  REP FOR j FROM 1 UPTO 2

+      REP result CAT intern (r [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 4 REAL CONST r):

+  intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) 

+END PROC intern;

+

+TEXT PROC intern (ROW 3 REAL CONST r):

+  intern (r [1]) + intern (r [2]) + intern (r [3])

+END PROC intern;

+

+TEXT PROC intern (ROW 2 REAL CONST r):

+  intern (r [1]) + intern (r [2])

+END PROC intern;

+

+PROC convert (TEXT VAR record, INT VAR n):

+  n := record ISUB 1;

+  record := subtext (record, 3)

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 16

+  REP FOR j FROM 1 UPTO 3

+      REP convert (record, n [i][j]) PER

+  PER

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 16 BOOL VAR n):

+  INT VAR i, result;

+  convert (record, result);

+  FOR i FROM 1 UPTO 16

+  REP n [i] := bit (i-1, result) PER

+END PROC convert;

+

+PROC convert (TEXT VAR record, REAL VAR r):

+  r := record RSUB 1;

+  record := subtext (record, 9)

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 3

+  REP FOR j FROM 1 UPTO 2

+      REP convert (record, r [i][j]) PER

+  PER;

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 2

+  REP FOR j FROM 1 UPTO 2

+      REP convert (record, r [i][j]) PER

+  PER;

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 4 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2]);

+  convert (record, r [3]); convert (record, r [4]) 

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 3 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2]); convert (record, r [3])

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 2 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2])

+END PROC convert;

+

+END PACKET picfile;

+

+(********************************* devices ********************************)

+

+PACKET devices DEFINES PLOTTER, 

+                       select plotter, 

+                       install plotter, 

+                       plotters,

+                       plotter,

+                       no plotter,

+                       name, 

+                       channel, 

+                       station,

+                       actual plotter,

+                       drawing area, 

+                       plotter info,

+                       :=,

+                       = :

+ 

+LET trenn = "/";

+

+TYPE PLOTTER = STRUCT (INT station, channel, TEXT name);

+PLOTTER CONST noplotter :: PLOTTER : (0,0,""); 

+PLOTTER VAR plotter id  :: no plotter;

+TARGET   VAR devices; 

+TEXT VAR plotter set;

+INT VAR act plotter;

+ 

+OP := (PLOTTER VAR dest, PLOTTER CONST source): 

+   CONCR (dest) := CONCR (source)

+END OP := ;

+

+BOOL OP = (PLOTTER CONST a, b): 

+   (a.station = b.station) AND 

+   (a.channel = b.channel) AND 

+   (a.name    = b.name   ) 

+END OP =; 

+ 

+PLOTTER PROC plotter: 

+   plotter id 

+END PROC plotter;

+ 

+PLOTTER PROC plotter (TEXT CONST def plotter): 

+   select target (devices, def plotter, plotter set);

+   IF plotter set = ""

+      THEN IF def plotter = ""

+              THEN act plotter := 0; 

+                   no plotter

+              ELSE errorstop ("Unbekannter Plot-Id : " + def plotter);

+                   no plotter

+           FI 

+      ELSE select;plotter id

+   FI. 

+ 

+   select: 

+      INT VAR tp;

+      PLOTTER VAR plotter id;

+      plotter id.station := int(def plotter); 

+      tp      := pos (def plotter, trenn) + 1;

+      plotter id.channel := int(subtext (def plotter,tp)); 

+      plotter id.name    := subtext (def plotter, pos (def plotter,trenn,tp)+1); 

+END PROC plotter; 

+ 

+PROC select plotter: 

+   THESAURUS VAR plotter list :: empty thesaurus; 

+   TEXT VAR plotter name; 

+   INT VAR index :: 0; 

+   get (plotters, plotter name, index); 

+   WHILE index > 0 REP 

+      insert (plotter list,plotter info (plotter name,60));

+      get (plotters, plotter name, index)

+   PER; 

+   select plotter (name (plotters, link (plotter list, one(plotter list))))

+END PROC select plotter; 

+ 

+PROC select plotter (PLOTTER CONST plotter):

+   select plotter (text (plotter.station) + trenn + text (plotter.channel) +

+                   trenn + plotter.name) 

+END PROC select plotter;

+

+PROC select plotter (TEXT CONST def plotter): 

+   select target (devices, def plotter, plotter set);

+   IF plotter set = ""

+      THEN IF def plotter = ""

+              THEN act plotter := 0; 

+                   plotter id := no plotter

+              ELSE errorstop ("Unbekannter Plot-Id : " + def plotter)

+           FI 

+      ELSE select 

+   FI. 

+ 

+   select: 

+      INT VAR xp, yp, tp; REAL VAR xc, yc; 

+      act plotter := link (plotters, def plotter);

+      plotter id.station := int(def plotter); 

+      tp      := pos (def plotter, trenn) + 1;

+      plotter id.channel := int(subtext (def plotter,tp)); 

+      plotter id.name    := subtext (def plotter, pos (def plotter,trenn,tp)+1); 

+      drawing area (xc, yc, xp, yp); 

+      set drawing area (xc, yc, real (xp), real (yp));

+END PROC select plotter; 

+

+PROC install plotter (TARGET VAR new plotset): 

+   THESAURUS VAR new plotter :: target names (new plotset);

+   INT VAR index :: 0; 

+   TEXT VAR name,set;

+   initialize target (devices);

+   get (new plotter,name,index);

+   WHILE index > 0 REP

+      select target (new plotset, name, set);

+      complete target (devices, name, set);

+      get (new plotter, name, index)

+   PER

+END PROC install plotter; 

+ 

+INT PROC actual plotter:

+   act plotter

+END PROC actual plotter;

+

+THESAURUS PROC plotters: 

+   target names (devices) 

+END PROC plotters; 

+ 

+TEXT PROC name (PLOTTER CONST plotter): 

+   plotter.name

+END PROC name; 

+ 

+INT PROC channel (PLOTTER CONST plotter): 

+   plotter.channel 

+END PROC channel; 

+ 

+INT PROC station (PLOTTER CONST plotter):

+   plotter.station

+END PROC station;

+

+PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp): 

+   IF plotter set <> "" 

+      THEN INT VAR cp; 

+           xp  := int(plotter set); 

+           cp  := pos (plotter set,",")+1; 

+           yp  := int (subtext (plotter set,cp)); 

+           cp  := pos (plotter set,",",cp)+1;

+           xcm := real (subtext (plotter set,cp)); 

+           cp  := pos (plotter set,",",cp)+1; 

+           ycm := real (subtext (plotter set,cp))

+   FI 

+END PROC drawing area;

+ 

+PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp,PLOTTER CONST pl):

+   PLOTTER CONST keep :: plotter;

+   select plotter (pl);

+   drawing area (xcm, ycm, xp, yp); 

+   select plotter (keep) 

+END PROC drawing area; 

+ 

+TEXT PROC plotter info (TEXT CONST plotter id,INT CONST len): 

+   INT VAR tp            :: pos (plotter id, trenn)+1; 

+   TEXT VAR plotter name :: plotter id,

+            station      :: "/Station" + text (int(plotter name),2),

+            kanal        :: " Kanal" + text (int (subtext (plottername,tp)),3); 

+   plotter name := subtext (plotter name, pos (plotter name, trenn,tp)+1) + " "; 

+   INT VAR  llen         :: length (plotter name + kanal   + station);

+   plotter name + (max(len-llen,0) * ".") + kanal + station

+END PROC plotter info; 

+

+END PACKET devices

diff --git a/app/mpg/1987/src/GRAPHIK.Configurator b/app/mpg/1987/src/GRAPHIK.Configurator
new file mode 100644
index 0000000..7bfdbb9
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Configurator
@@ -0,0 +1,945 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.2 vom 11.11.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*          "Graphik-Konfiguration" geschrieben von C.Weinholz            *) 

+(*                                                                        *) 

+(**************************************************************************) 

+(*                                                                        *) 

+(*                          Graphik-Konfiguration                         *) 

+(*                                                                        *) 

+(*              Erstellung eines fuer alle Engeraete gueltigen            *) 

+(*                Basisgraphik-Paketes durch zusammenfuegen               *) 

+(*                           von '.GCONF'-Dateien                         *) 

+(*                                                                        *) 

+(*            Aufruf durch 'configurate graphik', wenn insertiert         *) 

+(*                      (normalerweise nicht notwendig)                   *) 

+(*             Bei 'run' muss 'configurate graphik' ans Dateiende         *) 

+(*                            geschrieben werden.                         *) 

+(*                                                                        *) 

+(**************************************************************************) 

+PACKET graphik configuration DEFINES configurate graphik: 

+ 

+LET PLOTTERCONF = STRUCT (TEXT name, station, channel, area, prep, init, end, 

+                               clear, home, move, draw, pixel, foreground, 

+                               background, palette, std colors, circle, box, 

+                               fill, cursor, get cursor, set marker, linked,

+                               BOOL editor, 

+                               BOOL no plotter); 

+LET max conf      = 15,

+    dquote        = ""34""34"",

+    interface     = "GRAPHIK.Configuration", 

+    env conf file = "ENVIRONMENT.GCONF",

+    packet header = "PACKET device interface DEFINES prepare, init plot, endplot, clear, home, moveto, drawto, setpixel, foreground, background, set color, stdcolors, color, colors, set palette, circle, box,fill,graphik cursor, get cursor, set marker:",

+    packet end    = "END PACKET device interface", 

+    target        = "TARGET VAR  plotter; initialize target ( plotter);", 

+    install target= "install plotter ( plotter);", 

+    init set      = "PROC initplot: IF  wsc THEN  palette :=  std palette 

+                     ELSE  palette :=  empty palette FI;  initplot; set palette 

+                     END PROC initplot;", 

+    end set       = "BOOL VAR  we::TRUE; 

+                     PROCendplot(BOOL CONSTs): we:=s 

+                     END PROCendplot; 

+                     PROCendplot: IF weTHEN endplotFI 

+                     END PROCendplot;", 

+    clear set     = "BOOL VAR  wc::TRUE; PROCclear(BOOL CONSTs): wc:=s  

+                     END PROC clear; PROC clear:IF wcTHEN clearFI END PROC clear;", 

+    color set     = "BOOL VAR  wsc::TRUE; TEXT VAR  palette; PROC setcolor (INT CONST no,rgb):

+                     IF (no+1) <= colors THEN replace( palette,no+1,rgb)

+                     FI END PROC set color;", 

+    color set2    = "INT PROC colors : length ( palette) DIV 2 END PROC colors; 

+                     INT PROC color (INT CONST no): IF no >= 0  AND (no+1) <= colors 

+                     THEN  palette ISUB (no+1) ELSE maxint FI END PROC color;", 

+    std colors    = "PROCstdcolors(BOOL CONSTs):  wsc:=s END PROCstdcolors; 

+                     PROC stdcolors:IF wscTHEN palette :=  std palette;set palette FI END PROCstdcolors;", 

+    foreground    = "INT VAR af::1; INT PROCforeground: af END PROCforeground; 

+                     PROCforeground(INT CONSTm):  af:=m; foreground( af) END PROCforeground;",  

+    background    = "INT VAR  ab::0; INT PROCbackground: ab END PROCbackground; 

+                     PROCbackground(INT CONSTm):  ab:=m; background( ab) END PROCbackground;"; 

+

+ROW max conf PLOTTERCONF VAR plotter; 

+ROW max conf DATASPACE VAR global data; 

+ 

+TEXT CONST spaces :: 20 * " ";

+INT VAR inst plotter, targets, error line :: 0;

+TEXT VAR errorm1, errorm2, procvalue :: "", env conf, error source :: "";

+BOOL VAR errors :: FALSE; 

+FILE VAR f; 

+DATASPACE VAR conf ds; 

+THESAURUS VAR plotconfs; 

+ 

+PROC configurate graphik: 

+   FOR inst plotter FROM 1 UPTO max conf REP 

+       act plotter.name := ""; 

+       act plotter.area := ""; 

+       act plotter.prep := "";

+       act plotter.init := ""; 

+       act plotter.end  := ""; 

+       act plotter.clear:= ""; 

+       act plotter.home := ""; 

+       act plotter.move := ""; 

+       act plotter.draw := ""; 

+       act plotter.pixel:= ""; 

+       act plotter.foreground := ""; 

+       act plotter.background := ""; 

+       act plotter.palette    := ""; 

+       act plotter.circle     := ""; 

+       act plotter.box        := "";  

+       act plotter.fill       := ""; 

+       act plotter.cursor     := ""; 

+       act plotter.get cursor := ""; 

+       act plotter.set marker := ""; 

+       act plotter.linked     := "";

+       act plotter.editor     := FALSE; 

+    PER; 

+    env conf := "";

+    inst plotter := 0; 

+    plotconfs := empty thesaurus; 

+    IF exists (env conf file) 

+       THEN plotconfs := ALL env conf file 

+    FI; 

+    plotconfs := SOME (plotconfs + (all LIKE "*.GCONF") - env conf file);  

+    INT VAR id :: 0; TEXT VAR conf file; 

+    get (plotconfs, conf file, id); 

+    WHILE id > 0 REP 

+       IF exists (conf file) 

+          THEN extract conf data (conf file)  

+          ELSE get environment plotter

+       FI;

+       get (plotconfs, conf file, id); 

+    PER; 

+    IF inst plotter > 0 

+       THEN generate interface

+       ELSE errorstop ("Kein Interface erzeugt") 

+    FI;

+    last param (interface). 

+ 

+    get environment plotter: 

+       check sequence (conf file, "PLOTTER *,*,*,*,*,*,*;", 

+                             "2|4,3,3,3,3,3,3;", 

+                             "PLOTTER erwartet,"+ 

+                             "Name erwartet,,"+ 

+                             "Station erwartet,,"+ 

+                             "Kanal erwartet,,"+ 

+                             "XPixel erwartet,,"+ 

+                             "YPixel erwartet,,"+ 

+                             "Xcm erwartet,,"+ 

+                             "Ycm erwartet,,"+ 

+                             "Plotterkommando fehlerhaft"); 

+       IF errors  

+          THEN errorstop (errorm2) 

+          ELSE TEXT VAR one int :: ""0""0"", one real :: 8 * ""0"";

+               replace (one int,1,length(get var (1))); 

+               env conf CAT one int;

+               env conf CAT get var (1);

+               replace (one int, 1, int (get var (2)));

+               env conf CAT one int;

+               replace (one int, 1, int (get var (3)));

+               env conf CAT one int; 

+               replace (one int, 1, int (get var (4)));

+               env conf CAT one int; 

+               replace (one int, 1, int (get var (5)));

+               env conf CAT one int; 

+               replace (one real, 1, real (get var (6)));

+               env conf CAT one real; 

+               replace (one real, 1, real (get var (7))); 

+               env conf CAT one real;

+       FI 

+END PROC configurate graphik; 

+ 

+PROC extract conf data (TEXT CONST conf file): 

+   TEXT VAR line;

+   inst plotter INCR 1; 

+   IF inst plotter > max conf 

+      THEN putline ("Warnung: Es koennen nicht mehr als " + text(max conf) + 

+                    " Geraete konfiguriert werden"); 

+           inst plotter DECR 1 

+      ELSE error source := conf file; 

+           conf ds := old (conf file); 

+           f := sequential file (modify, conf ds); 

+           set line numbers;

+           IF is plotter configuration 

+              THEN get name and area (line, act plotter.name, 

+                                            act plotter.station, 

+                                            act plotter.channel, 

+                                            act plotter.area);

+                   get linked    (act plotter.linked);

+                   get includes;

+                   putline ("""" + act plotter.name + """ wird eingelesen"); 

+                   get paramless ("initplot",act plotter.init); 

+                   get paramless ("endplot" ,act plotter.end); 

+                   get paramless ("clear"   ,act plotter.clear); 

+                   get paramless ("home"    ,act plotter.home); 

+                   get paramless ("prepare" ,act plotter.prep);

+                   get koord     ("moveto"  ,act plotter.move); 

+                   get koord     ("drawto"  ,act plotter.draw); 

+                   get koord     ("setpixel",act plotter.pixel); 

+                   get var param ("foreground",act plotter.foreground); 

+                   get var param ("background",act plotter.background); 

+                   get paramless ("setpalette",act plotter.palette); 

+                   get std colors(act plotter.std colors); 

+                   get circle    (act plotter.circle); 

+                   get box       (act plotter.box); 

+                   get fill      (act plotter.fill); 

+                   IF editor available 

+                      THEN get graphik cursor (act plotter.cursor); 

+                           get get cursor     (act plotter.get cursor); 

+                           get set marker     (act plotter.set marker) 

+                   FI;

+                   push error; 

+                   IF anything noted 

+                      THEN f := sequential file (modify,conf file); 

+                           out (""7"");note edit (f);errorstop("") 

+                   FI 

+              FI;  

+              global data [inst plotter] := conf ds; 

+              forget (conf ds) 

+   FI. 

+ 

+   is plotter configuration: 

+      plotter [inst plotter].no plotter := NOT sequence found ("PLOTTER", 

+                                                               line, 1,TRUE);

+      NOT plotter [inst plotter].no plotter. 

+ 

+   editor available: 

+      plotter [inst plotter].editor := sequence found ("EDITOR", line, 1,TRUE); 

+      IF plotter [inst plotter].editor

+         THEN delete record (f); 

+              check sequence (line, "EDITOR;", "2;",  

+                            "EDITOR erwartet,"+ 

+                            "Semikolon erwartet," + 

+                            "Editorkommando fehlerhaft") 

+      FI; 

+      plotter [inst plotter].editor. 

+ 

+   set line numbers: 

+      INT VAR  line number;

+      to line (f,1); 

+      FOR line number FROM 1 UPTO lines (f)-1 REP 

+          cout (line number);

+          insert line number;           

+          down (f)

+      PER; 

+      insert line number. 

+ 

+   insert line number: 

+      TEXT VAR new line;

+      read record (f, new line); 

+      insert char (new line, " ", 1); 

+      insert char (new line, " ", 1); 

+      replace (new line, 1, line number); 

+      write record (f, new line). 

+          

+   get includes: 

+      BOOL VAR include found :: sequence found ("INCLUDE",line, 1, TRUE); 

+      WHILE include found REP 

+         push error;

+         include found := sequence found ("INCLUDE",line, line no (f), TRUE); 

+         IF include found 

+            THEN add to plotconfs 

+         FI 

+      PER. 

+ 

+      add to plotconfs: 

+         check sequence (line, "INCLUDE *;","2|4;", 

+                               "INCLUDE erwartet,Dateiname erwartet," +

+                               "Includekommando fehlerhaft");

+         IF NOT errors CAND exists (get var (1))

+            THEN IF NOT (plotconfs CONTAINS get var (1)) 

+                    THEN insert (plotconfs,get var (1))

+                 FI;

+         ELIF NOT errors

+            THEN error ("""" + get var (1) + """ existiert nicht")

+         FI;

+         delete record (f)

+END PROC extract conf data; 

+ 

+PROC generate interface: 

+   INT VAR act conf; 

+   conf ds := nilspace; 

+   forget (interface,quiet); 

+   proc value := ""; 

+   FILE VAR f :: sequential file (output, conf ds); 

+   putline (f,packet header); 

+   putline (f,target); 

+   generate target;

+   putline (f,install target); 

+   putline (f,init set);

+   putline (f,end set); 

+   putline (f,clear set); 

+   putline (f,color set); 

+   putline (f,color set 2);

+   putline (f, std colors);

+   putline (f,foreground); 

+   putline (f,background); 

+   FOR act conf FROM 1 UPTO inst plotter REP 

+      FILE VAR source := sequential file (modify,global data [act conf]); 

+      copy lines (f,source) 

+   PER; 

+   generate proc (""," initplot", TEXT PROC (INT CONST) initplotbody); 

+   generate proc (""," endplot",  TEXT PROC (INT CONST) endplotbody); 

+   generate proc (""," clear",    TEXT PROC (INT CONST) clearbody); 

+   generate proc ("","prepare",   TEXT PROC (INT CONST) prepbody);

+   proc value := " TEXT";

+   generate proc (""," std palette", TEXT PROC (INT CONST) std palette body); 

+   generate proc (""," empty palette", TEXT PROC (INT CONST) empty palette body);

+   proc value := "";

+   generate proc ("","home",     TEXT PROC (INT CONST) homebody); 

+   generate proc ("INT CONST x,y","moveto", TEXT PROC (INT CONST) movebody); 

+   generate proc ("INT CONST x,y","drawto", TEXT PROC (INT CONST) drawbody); 

+   generate proc ("INT CONST x,y","set pixel", TEXT PROC (INT CONST) pixelbody); 

+   generate proc ("INT VAR type"," foreground", TEXT PROC (INT CONST) foregroundbody); 

+   generate proc ("INT VAR type"," background", TEXT PROC (INT CONST) backgroundbody); 

+   generate proc ("","set palette", TEXT PROC (INT CONST) set palette body); 

+   generate proc ("INT CONST x,y,rad,from,to","circle", TEXT PROC (INT CONST) circlebody); 

+   generate proc ("INT CONST x1,y1,x2,y2,pattern", "box", TEXT PROC (INT CONST) box body); 

+   generate proc ("INT CONST x,y,pattern","fill", TEXT PROC (INT CONST) fill body); 

+   generate proc ("INT CONST x,y, BOOL CONST on","graphik cursor",TEXT PROC (INT CONST) graphik cursor body); 

+   generate proc ("INT VAR x,y, TEXT VAR exit char","get cursor",TEXT PROC (INT CONST) get cursor body); 

+   generate proc ("INT CONST x,y, type","set marker",TEXT PROC (INT CONST) set marker body); 

+   proc value := "BOOL "; 

+   generate proc ("","graphik cursor",TEXT PROC (INT CONST) editor available); 

+   generate device link;

+   putline (f,packet end); 

+   copy (conf ds,interface);

+   IF yes ("""" + interface + """ insertieren")

+      THEN insert (interface)

+   FI.

+ 

+   generate target:

+      INT VAR devices :: 0; 

+      targets := 0;

+      FOR act conf FROM 1 UPTO inst plotter REP 

+         TEXT VAR linked :: plotter[act conf].linked,

+                  one int:: ""0""0"";

+         plotter [act conf].linked := "";

+         IF NOT plotter [act conf].no plotter 

+             THEN putline (f,"complete target ( plotter,""" + 

+                  plotter [act conf].station + "/" + 

+                  plotter [act conf].channel + "/" + 

+                  plotter [act conf].name + 

+                  """,""" + plotter [act conf].area + """);"); 

+                  devices INCR 1; 

+                  targets INCR 1;

+                  replace (one int, 1, devices);

+                  plotter [act conf].linked CAT one int; 

+                  replace (one int, 1, targets);

+                  plotter [act conf].linked CAT one int;

+                  IF linked > "" 

+                     THEN INT VAR x :: 1; 

+                          WHILE x <=  length (linked) DIV 2 REP 

+                             putline (f,"complete target ( plotter, """ + 

+                             text(linked ISUB x) + "/" + 

+                             text(linked ISUB (x+1)) + "/" + 

+                             plotter[act conf].name + """,""" + 

+                             plotter[act conf].area + """);"); 

+                             targets INCR 1; 

+                             replace (one int, 1, targets);

+                             plotter [act conf].linked CAT one int; 

+                             x INCR 2 

+                          PER

+                  FI

+          FI 

+      PER; 

+      WHILE env conf <> "" REP 

+         generate env target (env conf) 

+      PER 

+END PROC generate interface; 

+ 

+PROC generate env target (TEXT VAR conf):

+   INT VAR nlen  :: conf ISUB 1; 

+   TEXT VAR tnam :: subtext (conf, 3, 2+nlen); 

+   conf := subtext (conf, nlen + 3);

+   putline (f,"complete target ( plotter, """ + text (conf ISUB 1) + "/" + 

+              text (conf ISUB 2) + "/" + tnam + """,""" + 

+              text (conf ISUB 3) + "," + text (conf ISUB 4) + "," + 

+              first real + "," + text (conf RSUB 2) + """);");

+   conf := subtext (conf, 17). 

+ 

+   first real: 

+      conf := subtext (conf, 9); 

+      text (conf RSUB 1)

+END PROC generate env target; 

+ 

+TEXT PROC initplotbody (INT CONST no): 

+   plotter [no].init 

+END PROC initplotbody; 

+ 

+TEXT PROC endplotbody (INT CONST no): 

+   plotter [no].end 

+END PROC endplotbody; 

+ 

+TEXT PROC clearbody (INT CONST no): 

+   plotter [no].clear 

+END PROC clearbody; 

+ 

+TEXT PROC prepbody (INT CONST no): 

+   plotter [no].prep 

+END PROC prepbody; 

+ 

+TEXT PROC homebody (INT CONST no): 

+   plotter [no].home 

+END PROC homebody; 

+ 

+TEXT PROC movebody (INT CONST no): 

+   plotter [no].move 

+END PROC movebody; 

+ 

+TEXT PROC drawbody (INT CONST no): 

+   plotter [no].draw 

+END PROC drawbody; 

+ 

+TEXT PROC pixelbody (INT CONST no): 

+   plotter [no].pixel  

+END PROC pixelbody; 

+ 

+TEXT PROC std palette body (INT CONST no): 

+   TEXT CONST rgb codes :: plotter [no].std colors;

+   TEXT VAR body :: dquote; 

+   INT VAR x; 

+   FOR x FROM 1 UPTO length (rgb codes) DIV 3 REP 

+      INT VAR color :: int (subtext(rgb codes, (x-1)*3+1, x*3)); 

+      body CAT (text (color AND 255) + dquote);

+      body CAT (text (color DIV 256) + dquote);

+   PER;

+   body 

+END PROC std palette body;

+ 

+TEXT PROC empty palette body (INT CONST no):

+   text (length (plotter[no].std colors) DIV 3) + "*" + dquote +

+   "255" + dquote + "127" + dquote

+END PROC empty palette body;

+

+TEXT PROC set palette body (INT CONST no): 

+   plotter[no].palette 

+END PROC set palette body; 

+ 

+TEXT PROC foregroundbody (INT CONST no): 

+   plotter [no].foreground 

+END PROC foregroundbody; 

+ 

+TEXT PROC backgroundbody (INT CONST no): 

+   plotter [no].background 

+END PROC backgroundbody; 

+ 

+TEXT PROC circle body (INT CONST no): 

+   plotter [no].circle 

+END PROC circle body; 

+ 

+TEXT PROC box body (INT CONST no): 

+   plotter [no].box  

+END PROC box body; 

+ 

+TEXT PROC fill body (INT CONST no): 

+   plotter [no].fill 

+END PROC fill body; 

+ 

+TEXT PROC graphik cursor body (INT CONST no): 

+   plotter [no].cursor 

+END PROC graphik cursor body; 

+ 

+TEXT PROC get cursor body (INT CONST no): 

+   plotter [no].get cursor 

+END PROC get cursor body; 

+ 

+TEXT PROC set marker body (INT CONST no): 

+   plotter [no].set marker 

+END PROC set marker body; 

+ 

+TEXT PROC editor available (INT CONST no): 

+   IF plotter [no].editor 

+      THEN "TRUE" 

+      ELSE "FALSE" 

+   FI 

+END PROC editor available; 

+

+PROC generate device link:

+   INT VAR actconf;

+   putline (f, "INT PROC  act device :");

+   putline (f, "SELECT actual plotter OF");

+   FOR act conf FROM 1 UPTO inst plotter REP

+      IF NOT plotter [act conf].no plotter

+         THEN putline (f,"CASE " + text (plotter[act conf].linked ISUB 2) + ":");

+              put (f,text (plotter[act conf].linked ISUB 1));

+              IF length (plotter[act conf].linked) > 2 

+                 THEN generate table 

+              FI

+      FI 

+   PER;

+   putline (f,"OTHERWISE errorstop (""Kein Endgeraet angekoppelt"");0"); 

+   putline (f,"END SELECT END PROC  act device;").

+

+   generate table: 

+      INT VAR x; 

+      FOR x FROM 3 UPTO length (plotter[act conf].linked) DIV 2 REP 

+         put (f,"CASE"); 

+         put (f,text (plotter[act conf].linked ISUB x)); 

+         put (f,":"); 

+         put (f, text (plotter[act conf].linked ISUB 1))

+      PER 

+END PROC generate device link; 

+

+PROC generate proc (TEXT CONST params,procname,TEXT PROC (INT CONST)procbody): 

+   INT VAR actconf, no plotter :: 0; 

+   IF params = "" 

+      THEN putline (f,procvalue + " PROC " + procname + ":") 

+      ELSE putline (f,procvalue + " PROC " + procname + "(" + params + "):") 

+   FI; 

+   IF procvalue <> "" 

+      THEN putline (f,procvalue + " VAR  d;") 

+   FI; 

+   putline (f,"SELECT  act device OF");  

+   FOR act conf FROM 1 UPTO inst plotter REP 

+       IF NOT plotter [act conf].no plotter 

+          THEN putline (f, "CASE " + text (act conf-no plotter) + ":" + 

+                           lowercase(plotter[act conf].name) + 

+                           plotter [act conf].channel + procname) 

+          ELSE no plotter INCR 1 

+       FI 

+   PER; 

+   IF procvalue <> "" 

+      THEN putline (f," OTHERWISE  d END SELECT")

+      ELSE putline (f," END SELECT") 

+   FI; 

+   FOR act conf FROM 1 UPTO inst plotter REP                                 

+       IF NOT plotter [act conf].no plotter 

+          THEN putline (f,"."); 

+               putline (f,lowercase(plotter[act conf].name)+ 

+                          plotter[act conf].channel + procname + ":"); 

+                          putline (f,procbody (act conf)) 

+       FI 

+   PER; 

+   putline (f,"END PROC "+ procname +";") 

+END PROC generate proc;      

+ 

+PROC get name and area (TEXT CONST line, TEXT VAR name, station, channel, area): 

+   push error; 

+   check sequence (line, "PLOTTER *,*,*,*,*,*,*;", 

+                         "2|4,3,3,3,3,3,3;", 

+                         "PLOTTER erwartet,"+ 

+                         "Name erwartet,,"+ 

+                         "Station erwartet,,"+ 

+                         "Kanal erwartet,,"+ 

+                         "XPixel erwartet,,"+ 

+                         "YPixel erwartet,,"+ 

+                         "Xcm erwartet,,"+ 

+                         "Ycm erwartet,,"+ 

+                         "Plotterkommando fehlerhaft"); 

+   name    := get var (1); 

+   station := get var (2); 

+   channel := get var (3); 

+   area := ""; 

+   area CAT (get var (4) + ","); 

+   area CAT (get var (5) + ","); 

+   area CAT (get var (6) + ","); 

+   area CAT (get var (7) + ","); 

+   delete record (f)

+END PROC get name and area; 

+ 

+PROC get linked (TEXT VAR keep):

+   TEXT VAR line;

+   IF sequence found ("LINK", line, 1, TRUE)

+      THEN extract data;

+           delete record (f)

+   FI.  

+ 

+   extract data: 

+      TEXT VAR symbol, one int :: ""0""0"";

+      INT VAR ltyp :: 2,type :: 0;(* 0 = ',' 1 = '/' 2 = Station 3 = Kanal*) 

+      push error;                 (* 4 = Ende erwartet ! *)

+      keep := "";

+      errorm1 := line; 

+      scan (line);

+      next symbol (symbol);

+      IF symbol <> "LINK"

+         THEN error ("LINK erwartet")

+      FI;

+      WHILE type < 7 AND NOT errors REP 

+         next symbol (symbol, type); 

+         IF ltyp = 0 

+            THEN IF symbol = "," 

+                    THEN ltyp := 2 

+                 ELIF symbol = ";" 

+                    THEN ltyp := 4 

+                    ELSE error ("Semikolon oder Komma erwartet") 

+                 FI

+         ELIF ltyp = 1 

+            THEN IF symbol = "/" 

+                    THEN ltyp := 3 

+                    ELSE error ("'/' erwartet")

+                 FI

+         ELIF ltyp = 4 

+            THEN IF type = 8 

+                    THEN error ("Kommentarende fehlt") 

+                 ELIF type = 9 

+                    THEN error ("Text unzulaessig (Textende fehlt)") 

+                 ELIF type <> 7 

+                    THEN error ("Zeilenende nach Semikolon erwartet") 

+                 FI 

+         ELIF type = 3  

+            THEN replace (one int, 1, int (symbol)); 

+                 keep CAT one int; 

+                 ltyp DECR 1;

+                 IF ltyp = 2 

+                    THEN ltyp := 0 

+                 FI 

+      FI

+   PER

+END PROC get linked; 

+ 

+PROC get graphik cursor (TEXT VAR keep): 

+   get proc ("graphik cursor","(INT CONST x,y, BOOL CONST on)", 

+             "(2|2 x,y,2|2 on)","INT erwartet, CONST erwartet,"+ 

+             "Formaler Parameter muss x heissen,"+ 

+             "Formaler Parameter muss y heissen,"+ 

+             "BOOL erwartet, CONST erwartet,"+ 

+             "Formaler Parameter muss on heissen", 

+             keep); 

+END PROC get graphik cursor; 

+ 

+PROC get get cursor (TEXT VAR keep): 

+   get proc ("get cursor","(INT VAR x,y, TEXT VAR exit char)", 

+             "(2|2 x,y,2|2 exit char)","INT erwartet, VAR erwartet,"+ 

+             "Formaler Parameter muss x heissen,"+ 

+             "Formaler Parameter muss y heissen,"+ 

+             "TEXT erwartet, VAR erwartet,"+ 

+             "Formaler Parameter muss exit char heissen", 

+             keep); 

+END PROC get get cursor; 

+ 

+PROC get set marker (TEXT VAR keep): 

+   get proc ("set marker","(INT CONST x,y,type)","(2|2 x,y,type)", 

+             "INT erwartet, CONST erwartet,"+ 

+             "Formaler Parameter muss x heissen,"+ 

+             "Formaler Parameter muss y heissen,"+ 

+             "Formaler Parameter muss type heissen", 

+             keep); 

+END PROC get set marker; 

+ 

+PROC get std colors (TEXT VAR keep): 

+   TEXT VAR line;

+   push error; 

+   IF sequence found ("COLORS", line, 1, TRUE)

+      THEN extract data 

+      ELSE error ("COLORS fehlt") 

+   FI.  

+ 

+   extract data: 

+      check sequence (line, "COLORS *;","2|4;", 

+                            "COLORS erwartet,"+ 

+                            "Rgbcodes erwartet,Semikolon fehlt"); 

+      keep := get var (1); 

+      delete record (f); 

+END PROC get std colors; 

+ 

+PROC get paramless (TEXT CONST procname, TEXT VAR keep): 

+   get proc (procname, "", "", "", keep) 

+END PROC get paramless; 

+ 

+PROC get var param (TEXT CONST procname, TEXT VAR keep): 

+   get proc (procname, "(INT VAR type)","(2|2 type)", 

+             "INT erwartet, VAR erwartet, Formaler Parameter muss type heissen", 

+             keep); 

+END PROC get var param; 

+ 

+PROC get koord (TEXT CONST procname, TEXT VAR keep): 

+   get proc (procname, "(INT CONST x,y)","(2|2 x,y)", 

+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ 

+             "Formaler Parameter muss y heissen",keep) 

+END PROC get koord; 

+ 

+PROC get circle (TEXT VAR keep): 

+   get proc ("circle","(INT CONST x,y,rad,from,to)","(2|2 x,y,rad,from,to)", 

+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ 

+             "Formaler Parameter muss y heissen,Formaler Parameter muss rad heissen,"+ 

+             "Formaler Parameter muss from heissen,Formaler Parameter muss to heissen", 

+             keep); 

+END PROC get circle; 

+ 

+PROC get box (TEXT VAR keep): 

+   get proc ("box","(INT CONST x1,y1,x2,y2,pattern)","(2|2 x1,y1,x2,y2,pattern)", 

+             "INT erwartet,CONST erwartet,Formaler Parameter muss x1 heissen,"+ 

+             "Formaler Parameter muss y1 heissen,Formaler Parameter muss x2 heissen,"+ 

+             "Formaler Parameter muss y2 heissen,Formaler Parameter muss pattern heissen", 

+             keep); 

+END PROC get box; 

+ 

+PROC get fill (TEXT VAR keep): 

+   get proc ("fill","(INT CONST x,y,pattern)","(2|2 x,y,pattern)", 

+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen"+ 

+             "Formaler Parameter muss y heissen,Formaler Parameter muss pattern heissen", 

+             keep); 

+END PROC get fill; 

+ 

+PROC get proc (TEXT CONST procname, psym, ptyp, perr, 

+               TEXT VAR   keep): 

+   TEXT VAR line;

+   push error; 

+   IF sequence found ("PROC"+procname, line, 1, TRUE) 

+      THEN errors := FALSE;

+           get body (line,procname,psym,ptyp,perr,keep)

+      ELSE error (procname + " nicht gefunden") 

+   FI

+END PROC get proc; 

+ 

+PROC get body (TEXT CONST header,procname,psyms,ptypes ,perrs, TEXT VAR keep body): 

+   INT VAR start, ende; 

+   start := line no(f); 

+   keep body := ""; 

+   check sequence (header, "PROC " + procname + psyms + ":", 

+                         "2|1"+ ptypes + ":", 

+                         "PROC erwartet,"      + 

+                          procname + " erwartet,,"+ 

+                          perrs+ 

+                         ",Fehler in " + procname + "-Header"); 

+   IF NOT errors

+      THEN get to end of proc

+   FI.

+

+   get to end of proc:

+      TEXT VAR last;

+      errors := FALSE; 

+      IF sequence found ("END PROC " + procname,  last, line no(f),FALSE)

+         THEN ende := line no (f); 

+              check sequence (last, "END PROC " + procname + ";", 

+                                    "2|2|1;", 

+                                    "END erwartet,"+ 

+                                    "PROC erwartet,"+ 

+                                    "PROC heisst " + procname + 

+                                    ",Semikolon fehlt"); 

+              IF NOT errors 

+                 THEN to line (f,start); 

+                      delete record (f); 

+                      INT VAR lc; 

+                      FOR lc FROM start UPTO ende-2 REP 

+                          TEXT VAR scratch; 

+                          read record (f,scratch); 

+                          scratch := subtext (scratch, 3);

+                          keep body CAT (" " + scratch); 

+                          delete record (f); 

+                      PER; 

+                      delete record (f)

+              FI 

+         ELSE error ("END PROC " + procname + " nicht gefunden") 

+      FI 

+END PROC get body; 

+ 

+BOOL PROC sequence found (TEXT CONST sequence text, 

+                          TEXT VAR   sequence line, INT CONST from line,

+                          BOOL CONST evtl at): 

+   BOOL VAR found :: FALSE, at char :: evtl at;

+   to line (f,from line);

+   col (f,1);

+   WHILE NOT (found OR eof (f)) REP 

+      cout (line no (f));

+      to first char; 

+      IF found 

+         THEN read record (f, sequence line);

+              error line := sequence line ISUB 1;

+              sequence line := subtext (sequence line, 3); 

+              scan sequence

+      FI

+   PER; 

+   IF NOT found 

+      THEN read record (f, sequence line);

+           IF pos (first char, sequence line) > 0 

+              THEN scan sequence 

+           FI

+   FI;

+   found.

+ 

+   to first char: 

+      IF at char

+         THEN downety (f, first char)

+         ELSE down (f, first char)

+      FI; 

+      at char := FALSE;

+      found := pattern found. 

+ 

+   scan sequence: 

+      TEXT VAR source symbols,symbols;

+      scan (sequence text); 

+      get symbols;

+      source symbols := symbols;

+      scan (sequence line); 

+      get symbols; 

+      found := pos (symbols,source symbols) = 1.

+

+   get symbols: 

+      TEXT VAR symbol;

+      INT VAR type;

+      symbols := "";

+      REP 

+          next symbol (symbol, type); 

+          symbols CAT symbol

+      UNTIL type > 6 PER. 

+ 

+   first char: 

+      sequence text SUB 1 

+END PROC sequence found; 

+ 

+PROC error (TEXT CONST emsg): 

+   IF NOT eof (f) 

+      THEN read record (f,errorm1); 

+           errorm1 := """" + error source + """, Zeile " + 

+                      text (error line) + ":"

+      ELSE errorm1 := """" + error source + """, Fileende:" 

+   FI; 

+   errorm2 := spaces + emsg; 

+   errors  := TRUE  

+END PROC error; 

+ 

+PROC push error: 

+  IF errors 

+     THEN note (errorm1);note line; 

+          note (10* " " + errorm2); note line; 

+          errors := FALSE 

+  FI 

+END PROC push error; 

+ 

+ (* Hinweis: bei Fehlermeldungen statt Blank ' ' (geschuetzt) verwenden. 

+             Bei verschiedenen Typen ohne trennenden Delimiter zur 

+             Abgrenzung in 'seq typ' '|' verwenden. 

+             '*' wird in 'seq sym' als Wildcard verwendet (Itemweise) 

+             Bei Delimitern wird der 'allgemeine Fehler' (letzter i.d Liste) 

+             verwendet. Jedoch muss auch fuer Delimiter ein Eintrag 

+             in der Liste freigehalten werden (...,,... oder ...,dummy,...). 

+*) 

+ 

+ROW 100 STRUCT (TEXT sym, INT typ, BOOL var) VAR seqlist; 

+INT VAR scanpos; 

+ 

+TEXT PROC get var (INT CONST no): 

+   INT VAR count :: 0, checkpos :: 1; 

+   WHILE checkpos <= scanpos REP 

+      IF seqlist[checkpos].var 

+         THEN count INCR 1; 

+              IF count >= no 

+                 THEN LEAVE get var WITH seqlist[checkpos].sym 

+              FI 

+      FI; 

+      checkpos INCR 1  

+   PER;"" 

+END PROC get var; 

+ 

+PROC check sequence (TEXT CONST seq, seq sym, seq typ, seq err): 

+   ROW 100 TEXT VAR err; 

+   INT VAR checkpos,erpos, typ, error1 :: 0,error2 :: 0; 

+   TEXT VAR sym; 

+   scan (seq err); 

+   next symbol (sym, typ); 

+   erpos := 1; 

+   err[erpos] := ""; 

+   REP 

+       SELECT typ OF 

+         CASE 5: err[erpos] CAT " " 

+         CASE 6: erpos INCR 1; 

+                 err [erpos] := "" 

+       OTHERWISE err[erpos] CAT sym 

+       END SELECT; 

+       next symbol (sym, typ) 

+    UNTIL typ >= 7 PER; 

+    scan (seq); 

+    FOR scanpos FROM 1 UPTO 100 REP 

+       next symbol (seqlist[scanpos].sym,seqlist[scanpos].typ); 

+    UNTIL seqlist[scanpos].typ >= 7 PER; 

+    SELECT seqlist[scanpos].typ OF 

+      CASE 8: error ("Kommentarende fehlt") 

+      CASE 9: error ("Textende fehlt") 

+      OTHERWISE IF scanpos = 100 

+                   THEN error ("Kommando zu schwierig") 

+                FI 

+    END SELECT; 

+    scan (seq sym); 

+    FOR checkpos FROM 1 UPTO scanpos REP 

+       next symbol (sym, typ); 

+       IF sym = "*" 

+          THEN seqlist[checkpos].var := TRUE 

+          ELSE seqlist[checkpos].var := FALSE 

+       FI 

+    PER; 

+    scan (seq typ); 

+    next symbol (sym,typ); 

+    FOR checkpos FROM 1 UPTO scanpos REP 

+       WHILE sym = "|" REP 

+         next symbol (sym, typ) 

+       PER; 

+       BOOL VAR std err :: typ <> 3;  

+       IF NOT std err 

+          THEN typ := int(sym); 

+               IF seqlist[checkpos].typ <> typ 

+                  THEN error1 := checkpos 

+               FI; 

+       ELIF seqlist[checkpos].sym <> sym 

+          THEN error1 := erpos 

+       FI; 

+       next symbol (sym, typ) 

+    UNTIL error1 > 0 OR typ >= 7 PER; 

+    scan (seq sym); 

+    next symbol (sym,typ); 

+    FOR checkpos FROM 1 UPTO scanpos-1 REP 

+       std err := typ = 6; 

+       IF (seqlist[checkpos].sym <> sym) AND (sym <> "*") 

+          THEN IF std err 

+                  THEN error2 := erpos 

+                  ELSE error2 := checkpos 

+               FI 

+       FI; 

+       next symbol (sym, typ) 

+    UNTIL error2 > 0 PER; 

+    IF error1 = 0 

+       THEN error1 := error2 

+    ELIF error1 = erpos 

+       THEN IF (error2 <> 0) AND (error2 <> erpos) 

+               THEN error1 := error2 

+            FI 

+    FI;  

+    IF error1 > 0 

+       THEN error (err [error1]) 

+    FI 

+END PROC check sequence; 

+ 

+INT PROC lower pair (INT CONST upper pair): 

+   INT VAR lower :: upper pair; 

+   set bit (lower,5); 

+   set bit (lower,13); 

+   lower 

+END PROC lower pair; 

+ 

+TEXT PROC lower case (TEXT CONST uppercase): 

+   TEXT VAR lower :: uppercase; 

+   INT VAR x; 

+   IF length(lower) MOD 2 <> 0 

+      THEN lower CAT ""0"" 

+   FI ; 

+   FOR x FROM 1 UPTO length(lower)DIV2 REP 

+      replace (lower,x,lower pair (lower ISUB x)) 

+   PER; 

+   lower  

+END PROC lower case; 

+ 

+PROC copy lines (FILE VAR dest, source): 

+   INT VAR l; 

+   input(source); 

+   output(dest); 

+   FOR l FROM 1 UPTO lines (source) REP 

+      TEXT VAR scratch,test; 

+      getline (source,scratch); 

+      scratch := subtext (scratch,3);

+      test := scratch; 

+      change all (test," ",""); 

+      IF test <> "" 

+         THEN putline (dest, scratch) 

+      FI 

+   PER 

+END PROC copy lines;

+

+.act plotter:

+   plotter[inst plotter]

+ 

+END PACKET graphik configuration; 

+configurate graphik

diff --git a/app/mpg/1987/src/GRAPHIK.Fkt b/app/mpg/1987/src/GRAPHIK.Fkt
new file mode 100644
index 0000000..b48141c
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Fkt
@@ -0,0 +1,1378 @@
+(***************************************************************************)

+(*                                                                         *)

+(*                       FKT - Funktionenplotter                           *)

+(*                                                                         *)

+(* Grundversion : MPG, KB, KN, LP      23.05.84     | 7756 Byte Code       *)

+(* Version 6.20 : MPG, Rainer Kottmann 23.09.85     | 7196 Byte Paketdaten *)

+(* Angepasst an MPG-Turtle-Standard :  07.03.85     | 1374 Zeilen          *)

+(* Version 8.21 : MPG,Beat Jegerlehner 18.09.87     |                      *)

+(* Angepasst an MPG EUMELGRAPHIK/EUMEL Version 1.8.1|                      *)

+(*                                                                         *)

+(***************************************************************************)

+PACKET funktionen DEFINES fkt plot,   (*************************************)

+                          y grenzen,  (* Interaktives Programm             *)

+                          wertetafel, (* Einzelprozeduren fuer "do"        *)

+                          ~,          (* BOOL OP "ungefaehr gleich"        *)

+                          luecke :    (* Dummykonstante fuer "undefiniert" *)

+                                      (*************************************)

+                                      (* Autoren:    Klaus Bovermann       *)

+                                      (*             Kai Nikisch           *)

+                                      (*             Lutz Prechelt         *)

+                                      (*             Rainer Kottmann       *)

+                                      (*             Beat Jegerlehner      *)

+                                      (*************************************) 

+ 

+LET fkpos          =  1,           (* Diese LETs sind Bildschirmpositionen *)

+    inpos          =  2,

+    wpos           =  3,

+    fehlerpos      =  5,

+    eingpos        =  7,

+    textpos        = 11,

+    wahlpos        = 24,

+    xupos          = 16,

+    yupos          = 16,

+    xopos          = 32,

+    yopos          = 32,

+    stuetzpktpos   = 48,

+    endgeraetepos  = 20;

+

+LET punkte         = 512,            (* maximale Anzahl der Stuetzpunkte *) 

+    ug1            = 0.15051,        (* Hilfswerte fuer 'gauss'          *)

+    ug2            = 0.5, 

+    ug3            = 0.84948,

+    din a 4 hoehe  = 5.0,            (* Hoehe der Beschriftung  *)

+    din a 4 breite = 5.0,            (* in mm                   *)

+    ziffern        = 12,             (* Genauigkeitsangabe      *)

+    gross          = 8.888888e88,

+    epsilon        = 1.0e-11;

+

+LET wahlstring              = ""8""2"fdwsazntlLAqeb~?",

+    farbstr                 = "<CR>Standard <r>ot <b>lau <g>ruen <s>chwarz",

+    farbchars               = ""13"rbgs",

+    graphikvater            = "GRAPHIK",

+    helpfile                = "FKT.help";

+

+ROW punkte REAL VAR graph;

+

+TEXT VAR term            :: "",

+         rohterm         :: "",

+         picfilename     :: "",

+         prefix          :: "PICFILE.",

+         postfix         :: "",

+         fehlernachricht :: "",

+         proc,

+         inline;

+

+REAL VAR x min ::  -gross,  x max ::  gross,

+         y min ::  maxreal, y max :: -maxreal,

+         xstep;

+

+INT  VAR nachkomma :: 2,

+         stuetzen  :: punkte,

+         endgeraet :: 1,

+         endgeraete :: highest entry(plotters);

+

+BOOL VAR intervall definiert   :: FALSE,

+         wertebereich bestimmt :: FALSE,

+         wertetafel vorhanden  :: FALSE,

+         fehlerzustand         :: FALSE;

+

+REAL CONST luecke :: gross;

+

+PICTURE VAR dummy picture :: nilpicture;

+move (dummy picture,0.0,0.0);

+

+(***************************************************************************)

+(* Alte Prozeduren (Graphik-unabhaengig)                                   *)

+(***************************************************************************)

+

+PROC get (TEXT VAR text):    (* moeglichkeit, ueberall abzubrechen! *)

+  text := "";

+  TEXT VAR exit char;

+  editget (text,""27"","",exit char);

+  IF exit char = ""27""

+    THEN errorstop("Abgebrochen")

+  FI

+END PROC get;

+

+PROC get (INT VAR nr):

+  TEXT VAR t;

+  get(t);

+  line;

+  nr := int(t)

+END PROC get;

+

+PROC get (REAL VAR nr):

+  TEXT VAR t;

+  get(t);

+  line;

+  nr := real(t)

+END PROC get;

+

+PROC editget (TEXT VAR t):

+  TEXT VAR t2 :: t,exit char;

+  editget(t2,""27"","",exit char);

+  IF exit char = ""27""

+    THEN errorstop("Abgebrochen")

+  FI;

+  t := t2

+END PROC editget;

+

+PROC inchar (TEXT VAR a,TEXT CONST b):

+  REP

+    inchar (a)

+  UNTIL pos(b,a) <> 0 OR a = ""27"" PER;

+  IF a = ""27""

+    THEN errorstop("Abgebrochen")

+  FI

+END PROC inchar;

+

+BOOL OP ~ (REAL CONST left , right) :

+     abs (left - right) <= xstep

+END OP ~;

+

+(*******************     MAIN PROGRAMM        *****************************)

+

+PROC fkt plot:

+  auswahlbild;

+  select plotter(name(plotters,endgeraet));

+  REP

+    bild;

+    auswahl (inline)

+  UNTIL inline = "q" PER

+

+END PROC fkt plot;

+

+(******************        LAY OUT            *****************************)

+

+PROC auswahlbild:

+  page;

+  cursor (1,textpos);

+  put     ("(f)  Funktionsterm eingeben             ");

+  putline ("(?)  Hilfestellung                    ");

+  put     ("(d)  Definitionsbereich waehlen         ");

+  putline ("(q)  in die Kommandoebene zurueck     ");

+  put     ("(w)  Wertebereich ermitteln lassen      ");

+  putline ("(s)  Anzahl der Stuetzpunkte waehlen  ");

+  put     ("(z)  Zeichnung anfertigen               ");

+  putline ("(n)  Nachkommastellenzahl waehlen     ");

+  put     ("(a)  Ausgabe der Zeichnung auf Endgeraet");

+  putline ("(e)  Arbeit beenden                   ");

+  put     ("(t)  Wertetafel erstellen lassen        ");

+  putline ("(L)  Zeichnungen loeschen             "); 

+  put     ("(l)  Zeichnungen auflisten              ");

+  putline ("(A)  Zeichnungen archivieren          ");

+  put     ("                                        "); 

+  putline ("(b)  Zeichnung beschriften            ");

+  cursor (1,wahlpos);

+  put ("Ihre Wahl:")

+END PROC auswahlbild;

+

+PROC bild:

+  cursor (1,fkpos);

+  put ("f(x) = " + rohterm);

+  out (""5"");

+  cursor (1,inpos);

+  put ("Def.Bereich:  [              /               ]");

+  cursor (xupos,inpos);

+  put (text (x min,ziffern,nachkomma));

+  cursor (xopos,inpos);

+  put (text (x max,ziffern,nachkomma));

+  cursor (1,wpos);

+  put ("Wertebereich: [              /               ]");

+  cursor (yupos,wpos);

+  put (text (y min,ziffern,nachkomma));

+  cursor (yopos,wpos);

+  put (text (y max,ziffern,nachkomma));

+  cursor (1,endgeraetepos);

+  put endgeraetestring;

+  cursor (stuetzpktpos,inpos);

+  put ("Anzahl der Stuetzpunkte: " + text (stuetzen,3));

+  drei zeilen ab eingpos loeschen.

+END PROC bild;

+

+(******************       MONITOR             *****************************)

+

+PROC auswahl 1 (TEXT VAR wahl):

+  enable stop;

+  SELECT code (wahl) OF

+    CASE    8 : endgeraet := max(endgeraet-1,1);

+                select plotter(name(plotters,endgeraet))

+    CASE    2 : endgeraet := min(endgeraet+1,endgeraete);

+                select plotter(name(plotters,endgeraet))

+    CASE  102 : fkt lesen                 (*  f  *)

+    CASE  100 : defbereich waehlen        (*  d  *)

+    CASE  119 : wertebereich erstellen    (*  w  *)

+    CASE  116 : wertetafel erstellen      (*  t  *)

+    CASE  113 : LEAVE auswahl 1           (*  q  *)

+    CASE  122 : graph erstellen           (*  z  *)

+    CASE   97 : graph zeigen              (*  a  *)

+    CASE  110 : genauigkeitsangabe        (*  n  *)

+    CASE   65 : dm;                       (*  A  *)

+                auswahlbild

+    CASE  108 : dateien listen            (*  l  *)

+    CASE   76 : dateien aus task raeumen  (*  L  *)

+    CASE  101 : unterbrechung             (*  e  *)

+    CASE  126 : spezialeingabe            (* TIL *)

+    CASE   63 : hilfe                     (*  ?  *)

+    CASE  115 : stuetzpunkte setzen       (*  s  *)

+    CASE   98 : zeichnung beschriften     (*  b  *)

+  END SELECT;

+END PROC auswahl 1;

+

+PROC auswahl (TEXT VAR wahl):       (* Faengerebene *)

+  cursor (12,24);

+  out (""5"");

+  inchar (wahl,wahlstring);

+  fehlerloeschen;

+  disable stop;

+  auswahl 1 (wahl);

+  IF is error

+     THEN fehlersetzen (error message);

+          clear error

+  FI;

+  enable stop;

+  IF fehlerzustand

+     THEN fehleraus (fehlernachricht)

+  FI

+END PROC auswahl;

+

+PROC put endgeraetestring:

+  TEXT VAR s :: "Endgeraet: ";

+  INT VAR i;

+  THESAURUS CONST t :: plotters;

+  FOR i FROM 1 UPTO endgeraete REP

+    IF length(s)+length(name(t,i))+4 > 79

+      THEN putline(s+""5"");

+           s := "           "

+    FI;

+    IF i = endgeraet

+      THEN s CAT ""15"" + name(t,i) + " "14" "

+      ELSE s CAT " "+name(t,i) + "   "

+    FI

+  PER;

+  putline(s+""5"")

+

+END PROC put endgeraetestring;

+

+

+(**************************** f *******************************************)

+

+PROC fkt lesen:

+  reset wertebereich;

+  cursor (1,eingpos);

+  put ("f(x) =");

+  out (""5"");

+  cursor (1,eingpos + 1);

+  out(""5"");

+  cursor (8,eingpos);

+  editget (rohterm);

+  change int to real (rohterm,term);

+  change all (term,"X","x");

+  change all (term,"=","~");                         (* Ueberdeckung von = *)

+  change all (term,"<~","<=");                       (* ruecksetzen von <= *)

+  change all (term,">~",">=");                       (*       "         >= *)

+  term testen;

+  wertetafel vorhanden := FALSE.

+

+term testen:

+  disable stop;

+  proc := "REAL PROC f (REAL CONST x):";

+  proc CAT term;

+  proc CAT " END PROC f";

+  do ("do ("""+proc+""")");      (* komischer do-Fehler *)

+  IF is error

+     THEN fehlersetzen ("Term fehlerhaft");

+          clear error;

+          LEAVE fkt lesen

+  FI

+END PROC fkt lesen;

+

+(**************************** d *******************************************)

+

+PROC defbereich waehlen:

+  cursor (1,eingpos);

+  put ("Untergrenze  :");

+  out (""5"");

+  get (x min);

+  obergrenze lesen;

+  intervall definiert := TRUE;

+  reset wertebereich.

+

+obergrenze lesen:

+  REP

+    put ("Obergrenze   :");

+    out (""5"");

+    get (x max);

+    IF x max <= x min

+       THEN out (""7""13""3""5"")

+    FI

+  UNTIL x max > x min PER

+END PROC defbereich waehlen;

+

+(**************************** w *******************************************)

+

+PROC wertebereich erstellen:

+  IF rohterm = ""

+     THEN fehlersetzen ("Erst Fkts.Term eingeben! (f)");

+          LEAVE wertebereich erstellen

+  ELIF NOT intervall definiert

+     THEN fehlersetzen ("Erst Def.Bereich waehlen (d)");

+          LEAVE wertebereich erstellen

+  ELIF wertebereich bestimmt

+     THEN fehlersetzen ("Wertebereich ist bereits bestimmt");

+          LEAVE wertebereich erstellen

+  FI;

+  proc := "REAL PROC f (REAL CONST x):"+ term;

+  proc CAT " END PROC f; ygrenzen (PROC f)";

+  do (proc)

+END PROC wertebereich erstellen;

+

+PROC ygrenzen (REAL PROC (REAL CONST) f):

+  REAL VAR x, f von x;

+  INT  VAR i :: 1;

+  

+  disable stop;

+  xstep := (x max - x min) / real (stuetzen - 1);

+  x := x min;

+  y min :=  maxreal;

+  y max := -maxreal;

+  cursor (1,eingpos);

+  putline ("Wertebereich wird ermittelt");

+  out (""5"");

+  out ("bei Stuetzpunkt Nr.: ");

+  wertegrenzen berechnen;

+  IF is error

+     THEN fehler setzen (error message);

+          reset wertebereich;

+          LEAVE ygrenzen

+  ELIF fehlerzustand

+     THEN reset wertebereich;

+          LEAVE ygrenzen

+     ELSE wertebereich bestimmt := TRUE

+  FI;

+  IF y min = y max

+     THEN y min DECR 1.0;

+          y max INCR 1.0

+  FI.

+

+wertegrenzen berechnen:

+  FOR i FROM 1 UPTO stuetzen REP

+    x := real (i-1) * xstep + x min;

+    cout (i);

+    f von x := f (x);

+    graph [i] := f von x;

+    IF f von x <> luecke

+       THEN y min := min (y min, f von x);

+            y max := max (y max, f von x)

+    FI

+  UNTIL is error OR interrupt PER .

+

+interrupt:

+  IF incharety = ""27""

+     THEN fehlersetzen ("Abgebrochen");

+          TRUE

+     ELSE FALSE

+  FI

+END PROC ygrenzen;

+

+(**************************** t *******************************************)

+

+PROC wertetafel erstellen:

+  IF rohterm = ""

+     THEN fehleraus ("Erst Fkts.Term eingeben (f)");

+          LEAVE wertetafel erstellen

+  ELIF NOT intervall definiert

+     THEN fehleraus ("Erst Def.Bereich waehlen (d)");

+          LEAVE wertetafel erstellen

+  FI;

+  proc := "REAL PROC f (REAL CONST x):"+ term;

+  proc CAT " END PROC f; wertetafel (PROC f)";

+  do (proc)

+END PROC wertetafel erstellen;

+

+PROC wertetafel (REAL PROC (REAL CONST ) f):

+  FILE VAR g :: sequential file (output,rohterm);

+  REAL VAR x, f von x;

+  INT  VAR i :: 0;

+  

+  REP

+    schrittweite einlesen

+  UNTIL (xstep > 0.0) CAND ((x max-x min) / xstep < real (punkte)) PER;

+  x := x min;

+  evtl ueberschrift;

+  disable stop;

+  REP

+    datei erstellen

+  UNTIL x > x max OR is error PER;

+  fehleraus in tafel;

+  enable stop;

+  modify  (g);

+  edit (g);

+  line;

+  IF yes("Tafel drucken")

+     THEN print (rohterm)

+  FI;

+  line (2);

+  IF yes("Tafel loeschen")

+     THEN forget(rohterm,quiet);

+          wertetafel vorhanden := FALSE

+     ELSE wertetafel vorhanden := TRUE

+  FI;

+  auswahlbild.

+

+evtl ueberschrift:

+  IF NOT wertetafel vorhanden

+     THEN putline (g, "       W E R T E T A F E L");

+          line (g);

+          putline (g, "      x         !     " + rohterm);

+          putline (g, "----------------!----------------")

+  FI.

+

+fehleraus in tafel:

+  IF is error

+     THEN fehlernachricht := errormessage;

+          clearerror;

+          line (g,2);

+          putline (g,fehlernachricht);

+          fehlernachricht := ""

+  FI.

+

+datei erstellen:

+  i INCR 1;

+  cout (i);

+  put (g, text (x,ziffern,nachkomma));

+  put (g, "   !");

+  f von x := f (x);

+  IF f von x <> luecke

+    THEN put (g, text (f von x,ziffern,nachkomma))

+    ELSE put (g, "Definitionsluecke")

+  FI;

+  line (g);

+  x INCR xstep.

+

+schrittweite einlesen:

+  cursor (1,eingpos);

+  put ("Schrittweite:");

+  out (""5"");

+  cursor (1,eingpos + 1);

+  out (""5"");

+  cursor (15,eingpos);

+  get (xstep);

+  put ("Zwischenpunkt :");

+  IF (xstep <= 0.0) COR ((x max-x min) / xstep > real (punkte))

+     THEN fehleraus ("Schrittweite zu klein");

+          LEAVE wertetafel

+  FI

+END PROC wertetafel;

+

+(*********************************** n *************************************)

+

+PROC genauigkeitsangabe:

+  cursor (1,eingpos);

+  put ("Anzahl der Nachkommastellen : ");

+  get (nachkomma);

+  disable stop;

+  nachkomma := min (nachkomma, ziffern - 3);

+  nachkomma := max (nachkomma, 0);

+  IF is error

+     THEN fehlersetzen ("Falscher Wert");

+          clear error;

+          nachkomma := 2

+  FI

+END PROC genauigkeitsangabe;

+

+(********************************l ****************************************)

+

+PROC dateien listen:

+  th(all LIKE (prefix+"*"));

+  auswahlbild

+END PROC dateien listen;

+

+(********************************L ****************************************)

+

+PROC dateien aus task raeumen:

+  forget(some(all LIKE (prefix+"*")));

+  auswahlbild

+END PROC dateien aus task raeumen;

+

+(**************************** s *******************************************)

+

+PROC stuetzpunkte setzen:

+  cursor (1,eingpos);

+  put ("Anzahl der Stuetzpunkte :");

+  get (stuetzen);

+  disable stop;

+  IF stuetzen <= 1  OR stuetzen > punkte

+     THEN fehler setzen ("Achtung Stuetzpunkte fehlerhaft")

+  FI;

+  stuetzen := max (stuetzen, 2)  ;

+  stuetzen := min (stuetzen, punkte);

+  IF is error

+     THEN fehlersetzen ("Falscher Wert");

+          clear error;

+          stuetzen := punkte

+  FI;

+  reset wertebereich

+END PROC stuetzpunkte setzen;

+(**************************** e *******************************************)

+

+PROC unterbrechung:

+  break;

+  auswahlbild

+END PROC unterbrechung;

+

+(****************************** ? ******************************************)

+

+PROC hilfe:

+  IF NOT exists(helpfile)

+    THEN fetch(helpfile,task (graphikvater))

+  FI;

+  FILE VAR f :: sequential file(input,helpfile);

+  headline(f,"Verlassen mit <ESC> <q>");

+  open editor(f,FALSE);

+  edit (groesster editor,"q",PROC (TEXT CONST) dummy ed);

+  auswahlbild

+END PROC hilfe;

+

+PROC dummy ed (TEXT CONST t):

+  IF t = "q"

+    THEN quit

+    ELSE out(""7"")

+  FI

+END PROC dummy ed;

+

+(**************************** TILDE ****************************************)

+ 

+PROC spezialeingabe:

+  TEXT CONST termeingabename :: "Bitte Funktionsrumpf eingeben";

+  TEXT VAR t;

+  FILE VAR f :: sequential file (modify, termeingabename);

+ 

+  edit (f);

+  lese den term aus;

+  teste den term;

+  rohterm := "spezial";

+  reset wertebereich;

+  auswahlbild.

+

+lese den term aus:

+  term := "";

+  input (f);

+  WHILE NOT eof (f) REP

+    getline (f,t);

+    term CAT t;

+    term CAT " "

+  PER.

+

+teste den term:

+  disable stop;

+  proc := "REAL PROC f (REAL CONST x):";

+  proc CAT term;

+  proc CAT " END PROC f";

+  do (proc);

+  IF is error

+     THEN fehlersetzen ("Funktionsrumpf fehlerhaft");

+          clear error;

+          term := "";

+          rohterm := "";

+          reset wertebereich;

+          auswahlbild;

+          LEAVE spezialeingabe

+  FI

+END PROC spezialeingabe;

+

+(***************************************************************************)

+(*********                 Ab hier Hilfsprozeduren                 *********)

+(***************************************************************************)

+

+PROC fehleraus (TEXT CONST t):

+   cursor (1,fehlerpos);

+   out (""7"F E H L E R : ", t);

+   fehlerzustand := FALSE

+END PROC fehleraus;

+

+PROC fehlerloeschen:

+  cursor (1,fehlerpos);

+  out (""5"");

+  fehlernachricht := "";

+  fehlerzustand   := FALSE

+END PROC fehlerloeschen;

+

+PROC fehler setzen (TEXT CONST message):

+  fehlernachricht := message;

+  fehlerzustand   := TRUE;

+  clear error

+END PROC fehler setzen;

+

+REAL PROC gauss (REAL CONST z):

+  IF is integer (z)

+     THEN round (z,0)

+  ELIF sign (z) = -1

+     THEN floor (z) - 1.0

+     ELSE floor (z)

+  FI

+END PROC gauss;

+

+BOOL PROC is integer (REAL CONST x):

+  abs (x - floor (x)) < epsilon

+END PROC is integer;

+

+PROC berechnung (REAL CONST min, max,

+                 REAL VAR   sweite,

+                 INT VAR    styp):

+

+  sweite := faktor * round (10.0 ** expo,11).

+

+faktor: 

+  IF nachkomma < ug1

+       THEN styp := 1;

+            1.0

+  ELIF nachkomma < ug2

+       THEN  styp := 2;

+             2.0

+  ELIF nachkomma < ug3

+       THEN styp := 5;

+            5.0

+       ELSE styp := 1;

+            10.0

+  FI.

+

+nachkomma:

+  IF frac (logwert) < -epsilon

+     THEN 1.0 + frac (logwert)

+  ELIF frac (logwert) > epsilon

+     THEN frac (logwert)

+     ELSE 0.0

+  FI.

+

+differenz:

+  max - min.

+

+expo:

+  gauss (logwert) - 1.0.

+

+logwert:

+  round (log10 (differenz),8)

+END PROC berechnung;

+

+REAL PROC runde ab (REAL CONST was, auf):

+  auf * gauss (was / auf)

+END PROC runde ab;

+

+REAL PROC runde auf (REAL CONST was, auf):

+  REAL VAR hilf :: runde ab (was,auf);

+ 

+  IF abs (hilf - was) < epsilon

+     THEN was

+     ELSE hilf + auf 

+  FI

+END PROC runde auf;

+

+PROC loesche zeile (INT CONST zeile):

+  cursor (1,zeile);

+  out (""5"")

+END PROC loesche zeile;

+

+PROC drei zeilen ab eingpos loeschen:

+  loesche zeile (eingpos);

+  loesche zeile (eingpos + 1);

+  loesche zeile (eingpos + 2);

+END PROC drei zeilen ab eingpos loeschen;

+

+PROC change int to real (TEXT CONST term alt,TEXT VAR term neu):

+  TEXT VAR symbol :: "", presymbol :: "";

+  INT  VAR type :: 0, pretype :: 0, position;

+  LET number      = 3,

+      tag         = 1,

+      end of scan = 7,

+      pot         = "**";

+

+  term neu := "";

+  scan (term alt);

+  WHILE type <> end of scan REP

+    presymbol :=  symbol;

+    pretype   :=  type;

+    next symbol (symbol,type);

+    IF type <> number OR presymbol = pot

+       THEN term neu CAT evtl mal und symbol

+       ELSE term neu CAT changed symbol

+    FI

+  PER.

+

+evtl mal und symbol:

+  IF pretype = number AND type = tag

+     THEN "*" + symbol

+     ELSE symbol

+  FI.

+

+changed symbol:

+  position := pos (symbol,"e"); 

+  IF position <> 0 

+     THEN text (symbol,position - 1) + ".0" +

+          subtext (symbol,position,length (symbol)) 

+  ELIF pos (symbol,".") = 0

+     THEN symbol CAT ".0";

+          symbol

+     ELSE symbol

+  FI

+END PROC change int to real;

+

+PROC reset wertebereich:

+  y min := -maxreal;

+  y max :=  maxreal;

+  wertebereich bestimmt := FALSE

+END PROC reset wertebereich;

+

+TEXT PROC textreal (REAL CONST z):

+  TEXT VAR t :: text (z);

+

+  IF (t SUB length (t)) = "."

+     THEN subtext (t,1,length (t) - 1)

+  ELIF (t SUB 1) = "." 

+     THEN "0" + t

+  ELIF (t SUB 2) = "." AND sign (z) = -1

+     THEN "-0" + subtext (t,2)

+  ELIF t = "0.0" 

+     THEN "0"

+     ELSE t

+  FI

+END PROC textreal;

+

+INT PROC length (REAL CONST z):

+  length (text (z))

+END PROC length;

+

+PROC put format(INT CONST wo, REAL CONST xxmi,xxma,yymi,yyma):

+  cursor (1,wo);

+  put ("Aktuelles Format:       xmin           xmax" +

+       "           ymin           ymax");

+  cursor (19,wo + 1);

+  put (text (xx mi,ziffern,nachkomma));

+  cursor (34,wo + 1);

+  put (text (xx ma,ziffern,nachkomma));

+  cursor (49,wo + 1);

+  put (text (yy mi,ziffern,nachkomma));

+  cursor (64,wo + 1);

+  put (text (yy ma,ziffern,nachkomma))

+END PROC put format;

+ 

+PROC out (TEXT CONST a, b) :

+  out (a); out (b)

+END PROC out;

+

+(***************************************************************************)

+(* Neue Prozeduren                                                         *)

+(***************************************************************************)

+

+PROC graph erstellen:

+  PICFILE VAR funktionen;

+  PICTURE VAR funktionsgraph :: nilpicture,

+              formatpic      :: nilpicture;

+  REAL VAR xx min :: x min,

+           xx max :: x max,

+           yy min :: y min,

+           yy max :: y max;

+

+  IF rohterm = ""

+     THEN fehlersetzen ("Erst Funktionsterm waehlen (f)");

+          LEAVE graph erstellen

+  ELIF NOT wertebereich bestimmt

+     THEN fehlersetzen ("Erst Wertebereich bestimmen lassen (w)");

+          LEAVE graph erstellen

+  FI;

+

+  hole filenamen;

+  funktionen := picture file (picfilename);

+  initialisiere stifte;

+  waehle format;

+  zeichne graphen;

+  pictures ins picfile.

+

+hole filenamen:

+  TEXT VAR t :: "";

+  REP 

+    namen lesen

+  UNTIL t = "l" OR t = "e" PER. 

+

+namen lesen:

+  cursor (1,eingpos);

+  out ("Welchen Namen soll die Zeichnung haben: "+ prefix);

+  postfix:= rohterm;

+  editget (postfix);

+  line;

+  IF (postfix SUB 1) = "?"

+    THEN picfilename := one(all LIKE (prefix+"*"));

+         auswahlbild;

+         bild;

+         cursor(1,eingpos)

+    ELSE picfilename := prefix + postfix;

+         picfilename := compress (picfilename)

+  FI;

+  IF NOT exists (picfilename)

+    THEN LEAVE hole filenamen

+  FI;

+  putline ("Zeichnung gibt es schon!");

+  put ("loeschen (l), Namen neuwaehlen (n), " +

+       "alte Zeichnung ergaenzen (e):");

+  inchar (t,"lne");

+  IF t = "l"

+     THEN forget (picfilename,quiet)

+  ELIF t = "n"

+     THEN drei zeilen ab eingpos loeschen

+  FI.

+

+initialisiere stifte:

+  select pen (funktionen, 1, 1, 0, 1, TRUE); (* Standardfarbe *)

+  select pen (funktionen, 2, 2, 0, 1, TRUE); (* Rot           *)

+  select pen (funktionen, 3, 3, 0, 1, TRUE); (* Blau          *)

+  select pen (funktionen, 4, 4, 0, 1, TRUE); (* Gruen         *)

+  select pen (funktionen, 5, 5, 0, 1, TRUE). (* Schwarz       *)

+

+waehle format:

+  IF altes picfile

+    THEN ergaenze wertebereich

+  FI;

+  drei zeilen ab eingpos loeschen;

+  REAL VAR step;

+  INT VAR i dummy;

+  berechnung (yy min, yy max, step, idummy);

+  yy min := runde ab (yy min, step);

+  yy max := runde auf (yy max, step);

+  put format(eingpos, xx min, xx max, yy min, yy max);

+  pause ;

+  drei zeilen ab eingpos loeschen;

+  cursor(1,eingpos);

+  IF yes("Format aendern")

+    THEN interactive change of format (xx min,xx max,yy min,yy max)

+  FI;

+  drei zeilen ab eingpos loeschen.

+

+ergaenze wertebereich:

+  to pic (funktionen,3);             (* Formatpicture *)

+  read picture (funktionen,formatpic);

+  move (formatpic, xx min, yy min);

+  move (formatpic, xx max, yy max);

+  extrema (formatpic, xx min, xx max, yy min, yy max).

+

+altes picfile:

+  t = "e".

+

+zeichne graphen:

+  REAL VAR x              :: x min,

+           x schrittweite :: (x max - x min) / real (stuetzen - 1);

+  INT  VAR i;

+

+  cursor (1,eingpos);

+  put ("Graph bei Stuetzpunkt Nr. ");

+  FOR i FROM 1 UPTO stuetzen REP

+     cout (i);

+     IF graph[i] <> luecke

+       THEN IF zuletzt luecke

+              THEN move (funktionsgraph, x, graph[i])

+              ELSE draw (funktionsgraph, x, graph[i])

+            FI

+     FI;

+     x INCR x schrittweite

+  UNTIL abbruch PER;

+  drei zeilen ab eingpos loeschen.

+

+  abbruch:

+    IF incharety = ""27""

+      THEN errorstop("Abgebrochen");

+           TRUE

+      ELSE FALSE

+    FI.

+

+  zuletzt luecke:

+   i = 1 COR graph[i-1] = luecke.

+

+pictures ins picfile:

+  setze graphenfarbe;

+  to first pic(funktionen);

+  IF altes picfile

+    THEN down (funktionen);        (* Skip *)

+         down (funktionen)

+    ELSE put picture (funktionen, dummy picture); (* Zusaetzliche Beschr.*)

+         put picture (funktionen, dummy picture)

+  FI;

+  formatpic := nilpicture;

+  move (formatpic, xx min, yy min);

+  move (formatpic, xx max, yy max);

+  IF altes picfile

+    THEN write picture (funktionen, formatpic)

+    ELSE put picture (funktionen, formatpic)

+  FI;

+  put picture (funktionen, funktionsgraph).

+

+setze graphenfarbe:

+  cursor (1,eingpos);

+  put("Farbe des Graphen :");

+  pen (funktionsgraph, farbe).

+

+farbe :

+  TEXT VAR ff;

+  put(farbstr);

+  inchar (ff,farbchars);

+  out(ff);

+  pos (farbchars,ff).

+

+END PROC graph erstellen;

+

+PROC interactive change of format (REAL VAR x mi,x ma,y mi,y ma):

+  TEXT VAR tt;

+  REP

+    cursor (1,eingpos + 2);

+    put ("Geben Sie die neuen Koordinaten ein");

+    out (""5"");

+    pause (20);

+    loesche zeile (eingpos + 2);

+    cursor (1,eingpos + 2);

+    put ("xmin:");

+    tt := text (xmi);

+    editget (tt); 

+    xmi := real (tt);

+    cursor (1,eingpos + 2);

+    put ("xmax:"); 

+    out (""5"");

+    tt := text (xma);

+    editget (tt);

+    xma := real (tt);

+    cursor (1,eingpos + 2);

+    put ("ymin:");

+    out (""5"");

+    tt := text (ymi);

+    editget (tt);

+    ymi := real (tt);

+    cursor (1,eingpos + 2);

+    put ("ymax:");

+    out (""5"");

+    tt := text (yma);

+    editget (tt);

+    yma := real (tt);

+  UNTIL format ok PER.

+

+  format ok:

+    IF xma <= xmi OR yma <= ymi

+      THEN fehlersetzen ("Format falsch");

+           FALSE

+      ELSE TRUE

+    FI

+END PROC interactive change of format;

+

+PROC geraet waehlen:

+END PROC geraet waehlen;

+

+PROC zeichnung beschriften:

+  namen holen;

+  PICFILE VAR funktionen :: picture file(picfilename);

+  PICTURE VAR beschr;

+  to pic(funktionen,2);

+  read picture(funktionen,beschr);

+  cursor(1,eingpos);

+  put("Beschriftung (e) rgaenzen , (l) oeschen oder (a) bbruch");

+  TEXT VAR t;

+  inchar(t,"ela");

+  IF t = "l"

+    THEN to pic(funktionen,2);

+         beschr := nilpicture;

+         write picture(funktionen,beschr)

+  ELIF t = "e"

+    THEN beschrifte

+  FI;

+  cursor(1,eingpos);

+  drei zeilen ab eingpos loeschen.

+

+  beschrifte:

+    farbe holen;

+    REAL VAR rx,ry,hx,bx;

+    to pic(funktionen,3);

+    PICTURE VAR format;

+    read picture(funktionen,format);

+    extrema(format,rx,ry,hx,bx);

+    drei zeilen ab eingpos loeschen;

+    put format (eingpos,rx,ry,hx,bx);

+    pause;

+    REP

+      drei zeilen ab eingpos loeschen;

+      cursor(1,eingpos);

+      put("Text :");

+      TEXT VAR btext;

+      getline(btext);

+      put("Koordinaten in (c)m oder in (r)eal ");

+      inchar(t,"cra");

+      drei zeilen ab eingpos loeschen;

+      cursor(1,eingpos);

+      put("X-Koordinate:");

+      get(rx);

+      put("Y-Koordinate:");

+      get(ry);

+      IF t = "c"

+        THEN move cm(beschr,rx,ry)

+        ELSE move   (beschr,rx,ry)

+      FI;

+      drei zeilen ab eingpos loeschen;

+      cursor(1,eingpos);

+      put("Hoehe der Zeichen in mm :");

+      get(hx);

+      put("Breite der Zeichen in mm:");

+      get(bx);

+      draw(beschr,btext,0.0,hx,bx);

+      drei zeilen ab eingpos loeschen;

+      cursor(1,eingpos)

+    UNTIL no("Weitere Beschriftungen") PER;

+    to pic(funktionen,2);

+    write picture(funktionen,beschr).

+

+  farbe holen:

+    drei zeilen ab eingpos loeschen;

+    cursor(1,eingpos);

+    put("Farbe der Beschriftungen: ");

+    TEXT VAR ff;

+    put(farbstr);

+    inchar (ff,farbchars);

+    out(ff);

+    pen(beschr,pos (farbchars,ff)).

+

+  namen holen:

+    cursor(1,eingpos);

+    put("Wie heisst die Zeichnung:");

+    out(prefix);

+    editget(postfix);

+    picfilename := prefix + postfix;

+    IF (postfix SUB 1) = "?"

+      THEN picfilename := one(all LIKE (prefix + "*"));

+           auswahlbild;

+           bild

+    FI;

+    IF NOT exists(picfilename)

+      THEN fehlersetzen("Zeichnung gibt es nicht");

+           LEAVE zeichnung beschriften

+    FI

+

+END PROC zeichnung beschriften;

+

+PROC graph zeigen:

+  REAL VAR xx max,xx min,yy max,yy min;

+

+  cursor (1,eingpos);

+  put ("Wie heisst die Zeichnung :");

+  out(prefix);

+  editget(postfix);

+  picfilename := prefix+postfix;

+  IF (postfix SUB 1) = "?"

+    THEN picfilename := one(all LIKE (prefix+"*"));

+         postfix := subtext(picfilename,length(prefix)+1);

+         auswahlbild;

+         bild

+  ELIF NOT exists (picfilename)

+    THEN fehlersetzen ("Zeichnung gibt es nicht");

+         LEAVE graph zeigen

+  FI;

+  drei zeilen ab eingpos loeschen;

+  PICFILE VAR funktionen :: picture file (picfilename);

+  PICTURE VAR rahmen :: nilpicture;

+  hole ausschnitt;

+  hole headline;

+  erzeuge rahmen;

+  gib bild aus.

+

+  gib bild aus:

+    REAL VAR x cm,y cm; INT VAR i,j;

+    drawing area (x cm,y cm,i,j);

+    viewport (funktionen, 0.0, x cm/y cm, 0.0, 1.0);

+    erweitere bereich;  (* Rundungsfehler beim clippen vermeiden !!! *)

+    window (funktionen, xx min, xx max, yy min, yy max);

+    plot (picfilename);

+    auswahlbild.

+

+  erweitere bereich:

+    xx max := xx max + (xx max - xx min) / real(i).

+

+ erzeuge rahmen:

+   to pic (funktionen,1);

+   waehle achsenart;

+   IF achsenart = "r"

+     THEN rahmen := frame (xx min,xx max,yy min,yy max)

+     ELSE rahmen := axis  (xx min,xx max,yy min,yy max)

+   FI;

+   rahmen CAT beschriftung (xx min,xx max,yy min,yy max,headline,

+                            achsenart = "r");

+   cursor (1,eingpos);

+   put ("Farbe des");

+   IF achsenart = "k"

+     THEN put("Koordinatensystems :")

+     ELSE put("Rahmens :")

+   FI;

+   pen (rahmen,farbe);

+   drei zeilen ab eingpos loeschen;

+   write picture (funktionen,rahmen).

+

+  farbe :

+    TEXT VAR ff;

+    put(farbstr);

+    inchar (ff,farbchars);

+    out(ff);

+    pos (farbchars,ff).

+

+  waehle achsenart:

+    TEXT VAR achsenart :: "r";

+    IF koord moeglich

+      THEN frage nach achsenart

+    FI.

+

+  frage nach achsenart:

+    cursor (1,eingpos);

+    put("<k>oordinatensystem oder <r>ahmen zeichnen ?");

+    inchar (achsenart,"kr");

+    putline(achsenart);

+    drei zeilen ab eingpos loeschen.

+

+  koord moeglich:

+    NOT (xmin >= 0.0 OR xx max <= 0.0 OR yy min >= 0.0 OR yy max <= 0.0).

+

+  hole ausschnitt:

+    PICTURE VAR format;

+    to pic (funktionen,3);

+    read picture (funktionen,format);

+    extrema (format, xx min, xx max, yy min, yy max);

+    cursor (1,eingpos);

+    put format (eingpos, xx min, xx max, yy min, yy max);

+    pause;

+    drei zeilen ab eingpos loeschen;

+    cursor (1,eingpos);

+    IF yes ("Wollen Sie den Ausschnitt veraendern")

+      THEN interactive change of format (xx min,xx max,yy min,yy max)

+    FI;

+    drei zeilen ab eingpos loeschen.

+

+  hole headline:

+    cursor (1,eingpos);

+    TEXT VAR headline :: rohterm;

+    put ("Ueberschrift :");

+    editget (headline);

+    drei zeilen ab eingpos loeschen

+END PROC graph zeigen;

+

+PICTURE PROC frame (REAL CONST xx min,xx max,yy min,yy max):

+

+   PICTURE VAR rahmen :: nilpicture;

+   zeichne achsen;

+   zeichne restrahmen;

+   rahmen.

+

+  zeichne restrahmen:

+   move (rahmen,xx min,yy max);

+   draw (rahmen,xx max,yy max);

+   draw (rahmen,xx max,yy min).

+

+  zeichne achsen:

+    rahmen := axis (xx min,xx max,yy min,(yy max - yy min) / 90.0,0,0);

+    rahmen CAT axis (yy min,yy max,xx min,(xx max - xx min) / 90.0,1,0)

+

+END PROC frame;

+

+PICTURE PROC axis (REAL VAR xx min,xx max,yy min,yy max):

+  PICTURE VAR rahmen :: nilpicture;

+  rahmen := axis (xx min,xx max,0.0,(yy max - yy min) / 180.0,0,1);

+  rahmen CAT axis (yy min,yy max,0.0,(xx max - xx min) / 180.0,1,1);

+  rahmen

+END PROC axis;

+

+PICTURE PROC axis (REAL CONST min, max, pos,strich,

+                   INT CONST  dir,mode):

+  PICTURE VAR achse ::  nilpicture;

+  REAL VAR step,

+           feinstep,

+           wert;

+  INT VAR type;

+  berechnung (min,max,step,type);

+  feinstep := step / real(zwischenstriche);

+  IF min MOD feinstep <> 0.0

+    THEN wert := runde auf (min,feinstep);

+    ELSE wert := min

+  FI;

+  INT VAR zaehler :: int( wert MOD step / feinstep + 0.5);

+  WHILE wert <= max REP

+    IF wert = 0.0

+      THEN ziehe nullstrich

+    ELIF zaehler MOD zwischenstriche = 0

+      THEN ziehe normstrich

+      ELSE ziehe feinstrich

+    FI;

+    wert INCR feinstep;

+    zaehler INCR 1

+  PER;

+  zeichne achse;

+  achse.

+

+  zwischenstriche:

+    IF type = 2

+      THEN 4

+      ELSE 5

+    FI.

+

+  ziehe nullstrich:

+    REAL VAR p0 :: pos + real (mode) * strich * 3.0,

+             p1 :: pos - strich * 3.0;

+    ziehe linie.

+

+  ziehe normstrich:

+    p0 := pos + real (mode) * strich * 2.0;

+    p1 := pos - strich * 2.0;

+    ziehe linie.

+

+  ziehe feinstrich:

+    p0 := pos + real (mode) * strich;

+    p1 := pos - strich;

+    ziehe linie.

+

+  zeichne achse:

+    IF dir = 0

+      THEN move (achse,min,pos);

+           draw (achse,max,pos)

+      ELSE move (achse,pos,min);

+           draw (achse,pos,max)

+    FI.

+

+  ziehe linie:

+    IF dir = 0

+      THEN move (achse,wert,p0);

+           draw (achse,wert,p1)

+      ELSE move (achse,p0,wert);

+           draw (achse,p1,wert)

+    FI

+END PROC axis;

+

+PICTURE PROC beschriftung (REAL VAR xx min,xx max,yy min,yy max,

+                           TEXT CONST ueberschrift,

+                           BOOL CONST mode):

+ PICTURE VAR rahmen :: nilpicture;

+ beschrifte;

+ rahmen.

+

+ beschrifte :

+    REAL VAR x cm,y cm;

+    INT VAR dummy;

+    drawing area (x cm,y cm,dummy,dummy);

+    erweitere;

+    zeichne x achse;

+    zeichne y achse;

+    zeichne ueberschrift;

+    xx max := xn max;

+    xx min := xn min;

+    yy max := yn max;

+    yy min := yn min.

+

+  erweitere:

+    REAL VAR hoehe  :: din a4 hoehe  / 23.5 * y cm,   { der Zeichen }

+             breite :: din a4 breite / 30.5 * x cm;

+    INT CONST anzahl y stellen :: max (stellen (yy min),stellen (yy max)),

+              anzahl x stellen :: max (stellen (xx min),stellen (xx max));

+    REAL VAR xn min :: xx min,

+             xn max :: xx max,

+             yn min :: yy min;

+    IF mode                                      { rahmen wg clipping }

+      THEN xn min DECR (xx max - xx min) / 30.0;

+           yn min DECR (yy max - yy min) / 30.0

+    FI;

+    REAL VAR xx dif :: xx max - xn min,

+             yy dif :: yy max - yn min,

+             yn dif :: y cm / (y cm - 2.0 * hoehe / 10.0 - 0.4) * yy dif,

+             xn dif :: x cm / (x cm - x erweiterung) * xx dif,

+             y 1 mm :: yn dif / y cm / 10.0,

+             r hoch :: hoehe / y cm / 10.0 * yn dif,

+             r breit:: breite / x cm / 10.0 * xn dif,

+             yn max :: yy max + r hoch + 3.0 * y 1 mm;

+    yn min := yn min - r hoch - 2.0 * y 1 mm;

+    IF mode

+      THEN xn min := xn min - real(anzahl y stellen) * r breit

+    FI.

+

+    x erweiterung:

+      IF mode

+        THEN real(anzahl y stellen) * breite / 10.0

+        ELSE 0.0

+      FI.

+

+    zeichne x achse:

+      TEXT VAR zahl :: text (xx min, anzahl x stellen, nachkomma);

+      ersetze zahl;

+      move (rahmen, max(xn min, xx min - real(length(zahl)) * r breit / 2.0),

+                    yn min);

+      draw (rahmen, zahl, 0.0, breite, hoehe);

+      zahl := text (xx max, anzahl x stellen, nachkomma);

+      ersetze zahl;

+      move (rahmen, xx max - real(length(zahl)) * r breit, yn min);

+      draw (rahmen, zahl, 0.0, breite, hoehe).

+

+    zeichne y achse:

+      zahl := text (yy min, anzahl y stellen, nachkomma);

+      ersetze zahl;

+      move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit -

+                         (xx max - xx min) / 30.0),yy min - r hoch / 2.0);

+      draw (rahmen, zahl, 0.0, breite, hoehe);

+      zahl := text (yy max,anzahl y stellen,nachkomma);

+      ersetze zahl;

+      move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit -

+                          (xx max - xx min) / 30.0),yy max - r hoch / 2.0);

+      draw (rahmen, zahl, 0.0, breite, hoehe).

+

+    zeichne ueberschrift:

+      move (rahmen, (xx max + xx min - real(length(ueberschrift)) * r breit)

+                    / 2.0, yy max + y 1 mm);

+      draw (rahmen, ueberschrift, 0.0, breite, hoehe).

+

+    ersetze zahl:

+      change all (zahl, ".", ",")

+

+END PROC beschriftung;

+

+INT PROC stellen (REAL CONST r):

+  IF r = 0.0

+    THEN nachkomma + 2

+    ELSE nachkomma + 3 + max (0, int ( round(log10 (abs(r)),nachkomma)))

+  FI

+END PROC stellen

+

+END PACKET funktionen;

+

+PACKET fkt manager DEFINES fkt manager:

+ 

+LET continue code = 100, 

+    ack           = 0,

+    nack          = 1; 

+ 

+DATASPACE VAR dummy space;

+INT VAR order;

+TASK VAR order task;

+

+PROC fkt manager:

+   set autonom;

+   disable stop;

+   break (quiet);

+   REP

+      forget (dummy space);

+      wait (dummy space, order, order task);

+      IF order >= continue code AND order task = supervisor

+         THEN call (supervisor, order, dummy space, order);

+              IF order = ack

+                 THEN fkt online

+              FI;

+              set autonom;

+              command dialogue (FALSE);

+              forget (ALL myself)

+         ELSE send (order task, nack, dummy space)

+      FI

+   PER.

+

+   fkt online:

+      command dialogue (TRUE);

+      fktplot;

+      IF online

+         THEN eumel must advertise;

+              break (quiet)

+      FI

+END PROC fktmanager

+

+END PACKET fktmanager

diff --git a/app/mpg/1987/src/GRAPHIK.Install b/app/mpg/1987/src/GRAPHIK.Install
new file mode 100644
index 0000000..1058c2e
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Install
@@ -0,0 +1,82 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.1 vom 10.09.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*          "Graphik-Installation" geschrieben von C.Weinholz             *) 

+(*                                                                        *) 

+(**************************************************************************) 

+(*                                                                        *) 

+(*            Dieses Programm wird in eine neueingerichtete Task          *) 

+(*             GRAPHIK vom Archiv geladen, und sorgt nach 'run'           *) 

+(*          fuer die volstaendige Installation des Graphik-Systems        *) 

+(*                                                                        *) 

+(**************************************************************************) 

+(*   Urversion  : 10.09.87                                                *) 

+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 

+(*                global manager aequivalent ersetzt                      *) 

+(*                'family password' wird nun erfragt und gesetzt          *) 

+(*                                                                        *) 

+(**************************************************************************) 

+LET packet 1  = "GRAPHIK.Basis",

+    packet 2  = "GRAPHIK.Plot",

+    config    = "GRAPHIK.Configurator",

+    install   = "GRAPHIK.Configuration",

+    fkt       = "GRAPHIK.Fkt",

+    fkthelp   = "FKT.help",

+    turtle    = "GRAPHIK.Turtle";

+

+FILE VAR f; 

+TEXT VAR l; 

+INT VAR x;

+ 

+check off;

+warnings off;

+archiv;

+fetch (ALLarchive- all,archive);

+BOOL VAR new conf :: NOT exists (install);

+IF new conf

+   THEN mess ("GRAPHIK muss neu konfiguriert werden")

+   ELSE new conf := yes ("GRAPHIK neu konfigurieren")

+FI; 

+release;

+ins (packet 1);

+IF new conf

+   THEN run (config) 

+   ELSE ins (install) 

+FI;

+ins (packet 2);

+ins (fkt);

+ins (turtle);

+do ("generate plot manager");

+mess (""15"  Fertig  "14""); 

+IF yes ("Alles loeschen")

+   THEN command dialogue (FALSE);

+        forget (all-fkthelp); 

+        command dialogue (TRUE)

+FI; 

+TEXT VAR geheim;

+put ("GRAPHIK-Password: ");

+get secret line (geheim);

+family password (geheim);

+global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager); 

+ 

+PROC ins (TEXT CONST name): 

+   page; 

+   f := sequential file (input, name); 

+   FOR x FROM 1 UPTO 11 REP 

+       getline (f,l); 

+       putline (l);

+   PER; 

+   mess ("""" + name + """ wird insertiert"13""10""); 

+   insert (name) 

+END PROC ins; 

+ 

+PROC mess (TEXT CONST msg): 

+   line; 

+   putline (msg); 

+END PROC mess;

+

diff --git a/app/mpg/1987/src/GRAPHIK.Manager b/app/mpg/1987/src/GRAPHIK.Manager
new file mode 100644
index 0000000..b186e32
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Manager
@@ -0,0 +1,900 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.2 vom 23.09.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*           "Graphik-Plotmanager" geschrieben von C.Weinholz             *) 

+(*                                                                        *) 

+(**************************************************************************) 

+(*                                                                        *)

+(*            Dieses Paket stellt den Multispool-Ausgabemanager           *)

+(*                            zur Verfuegung.                             *)

+(*                 Er wird in der Regel durch Aufruf von                  *)

+(*        'generate plot manager' in GRAPHIK in einer neuerzeugten        *)

+(*                      Sohntask 'PLOT' installiert.                      *)

+(*                                                                        *)

+(**************************************************************************)

+(*   Urversion  : 10.09.87                                                *)

+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *)

+(*                Kommando 'spool control ("TEXT")' im Plot-Monitor       *)

+(*                Anzeige von 'order tasks' anderer Stationen             *)

+(*   Fehler     : 'Zu viele DATASPACEs', selten, Ursache ungeklaert       *)

+(**************************************************************************)

+PACKET plot manager DEFINES plot manager ,

+                            plot server  :

+

+LET max spools  = 12,         (* BJ 15.10.87 (wg P9) *)

+    max entries = 20,         (* Hinweis: max spools * max entries < 250 *)

+ 

+    ack                 = 0,

+    second phase ack    = 5,

+    false code          = 6,

+    fetch code          = 11,

+    save  code          = 12,

+    existscode          = 13,

+    erase code          = 14,

+    list  code          = 15,

+    all   code          = 17,

+    first code          = 25,

+    start code          = 26,

+    stop  code          = 27,

+    halt code           = 28,

+    wait for halt  code = 29,

+    continue code       = 100,

+    picfiletype = 1102,

+

+    trenn       = "/",

+

+    MSG         = STRUCT (TEXT ds name, dev name, passwd, INT dev no),

+

+    JOB         = STRUCT (DATASPACE ds, TEXT ds name, TASK order task),

+ 

+    ENTRY       = STRUCT (JOB job, INT link), 

+ 

+    CHAIN       = STRUCT (ROW max entries ENTRY entry, INT first, last, empty), 

+ 

+    SERVER      = STRUCT (TASK task, wait for halt, REAL time,

+                          JOB current job, BOOL stopped, INT link);

+ 

+ROW max spools STRUCT (SERVER server, CHAIN chain) VAR device; 

+

+MSG VAR msg;

+

+INT VAR entry to erase, last created server, reply, current plotter;

+FILE VAR chain info;

+THESAURUS VAR managed plotter;

+BOUND THESAURUS VAR thesaurus msg;

+DATASPACE VAR reply ds;

+TASK VAR control task;

+

+(********************************* SPOOL ***********************************)

+

+PROC plot manager :

+   INT VAR act dev;

+   managed plotter := plotters LIKE (text (station (myself)) + any);

+   FOR act dev FROM 1 UPTO max devices REP

+      init device (act dev)

+   PER;

+   control task := niltask;

+   end global manager (FALSE);

+   global manager (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST)plot manager)

+END PROC plot manager;

+

+PROC plot manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task):

+   INT VAR act dev;

+   SELECT order OF 

+     CASE fetch code : y fetch 

+     CASE save code  : y save 

+     CASE exists code: y exists

+     CASE erase code : y erase 

+     CASE list code  : y list 

+     CASE all code   : y all 

+     OTHERWISE IF order >= continue code AND order task = supervisor

+                  THEN forget (ds);

+                       continue (order - continue code);

+                       spool monitor

+                  ELIF priv control op

+                       THEN SELECT order OF

+                              CASE first code : y first

+                              CASE start code : y start

+                              CASE stop code  : y stop

+                              CASE halt code  : y halt

+                              CASE wait for halt code : y halt

+                              OTHERWISE order error

+                            ENDSELECT

+                       ELSE order error

+               FI;

+   END SELECT;

+   BOOL VAR test;

+   FOR act dev FROM 1 UPTO max devices REP

+      test := server is active (act dev)

+   PER.

+

+   priv control op:

+      (order task = father) OR (order task < supervisor) OR

+      spool control task.

+

+  spool control task:

+     NOT (order task = niltask) CAND

+     ((order task = control task) OR (order task < control task)).

+

+  y fetch: 

+     FOR act dev FROM 1 UPTO max devices REP 

+     UNTIL act server.task = order task  PER;

+     IF act dev > max devices

+        THEN order error 

+     ELIF chain is empty (act dev) OR act server.stopped

+        THEN end server (act dev);

+             IF exists (act server.wait for halt)

+                THEN send (act server.wait for halt, ack);

+                     act server.wait for halt := niltask

+             FI

+        ELSE transfer next job (act dev); 

+             send current job (act dev) 

+     FI.

+

+  y save: 

+     IF phase = 1 

+        THEN y save pre 

+        ELSE y save post 

+     FI. 

+ 

+     y save pre: 

+        link dev;

+        IF act dev = 0 

+           THEN device error

+        ELIF chain is full (act dev)

+           THEN errorstop ("SPOOL ist voll")

+           ELSE send (order task, second phase ack) 

+        FI. 

+ 

+     y save post: 

+        act dev := msg.dev no;

+        IF type (ds) <> picfile type 

+           THEN forget (ds);

+                errorstop ("Datenraum hat falschen Typ") 

+           ELSE entry into chain (act dev, new job);

+                forget (ds);

+                IF NOT (server is active (act dev) OR act server.stopped)

+                   THEN create server (act dev)

+                FI;

+                send ack

+        FI.

+ 

+        new job: 

+           JOB : (ds, msg.ds name, order task).

+ 

+  y exists:

+     link dev;

+     IF find entry (msg.ds name,act dev,order task, priv control op) = 0

+        THEN send (order task, false code, ds)

+        ELSE send ack

+     FI.

+

+  y erase:

+     IF phase = 1

+        THEN link dev;

+             IF act dev > 0

+                THEN y erase pre

+                ELSE device error

+             FI

+        ELSE erase entry (act dev, entry to erase);

+             send ack

+     FI.

+

+     y erase pre: 

+        entry to erase := find entry (msg.ds name,act dev, order task, priv control op);

+        IF order not from job order task AND NOT priv control op

+           THEN errorstop ("Kein Zugriffsrecht auf Auftrag """ + msg.ds name + """")

+        ELIF entry to erase = 0

+           THEN manager message ("""" + msg.ds name + """ existiert nicht")

+           ELSE manager question (erase msg)

+        FI.

+

+        erase msg:

+           TASK VAR owner ::act chain.entry [entry to erase].job.order task;

+           owner id (owner) + "/ """ + msg.ds name +

+           """ in Spool """ + name (managed plotter, act dev) +

+           """ loeschen".

+

+        order not from job order task:

+           NOT (act chain.entry [entry to erase].job.order task = order task).

+

+  y list:

+     link dev;

+     create chain list (act dev);

+     send (order task, ack, reply ds).

+

+  y all:

+     link dev;

+     forget (reply ds);

+     reply ds := nilspace;

+     thesaurus msg := reply ds;

+     thesaurus msg := chain thesaurus (act dev, owner or priv task, FALSE);

+     send (order task, ack, reply ds).

+

+     owner or priv task:

+        IF priv control op

+           THEN niltask

+           ELSE order task

+        FI.

+

+  y start:

+     link dev;

+     IF act dev = 0

+        THEN FOR act dev FROM 1 UPTO max devices REP

+                 start (act dev)

+             PER

+        ELSE start (act dev)

+     FI;

+     send ack.

+     

+  y stop:

+     IF phase = 1

+        THEN y stop pre

+        ELSE y stop post

+     FI.

+

+  y stop pre:

+     link dev;

+     IF act dev > 0

+        THEN stop (act dev);

+             IF NOT is no job (act server.current job)

+                THEN manager question ("""" + act server.current job.ds name

+                     + """ neu eintragen")

+                ELSE send ack

+             FI

+        ELSE FOR act dev FROM 1 UPTO max devices REP

+                  stop (act dev)

+             PER;

+             send ack

+     FI.

+

+  y stop post:

+     act dev := msg.dev no;

+     entry into chain (act dev, act server.current job);

+     IF act chain.last > 1

+        THEN make new first (act dev, act chain.last)

+     FI;

+     send ack.

+

+  y halt:

+     link dev;

+     IF act dev = 0

+        THEN IF order <> halt code

+                THEN device error

+                ELSE FOR act dev FROM 1 UPTO max devices REP

+                         halt (act dev)

+                     PER;

+                     send ack

+             FI

+        ELSE halt (act dev);

+             IF order = halt code

+                THEN send ack;

+                     act server.wait for halt := niltask

+                ELSE act server.wait for halt := order task

+             FI

+     FI.

+

+  y first:

+     link dev;

+     IF act dev = 0

+        THEN device error

+        ELSE INT VAR new first entry :: find entry (msg.ds name,act dev,order task,TRUE);

+             IF new first entry = 0

+                THEN manager message ("""" + msg.ds name + """ existiert nicht")

+                ELSE make new first (act dev,new first entry);

+                     send ack

+             FI

+     FI.

+

+   act server:

+      device [act dev].server.

+

+   act chain:

+      device [act dev].chain.

+

+   send ack:

+      send (order task, ack).

+

+   link dev:

+      msg := ds;

+      act dev := msg.dev no.

+

+  order error:

+     errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """").

+

+  device error:

+     IF plotter (msg.dev name) = no plotter

+        THEN clear error;   (* 'plotter(TEXT)' liefert evtl. bereits error *)

+             errorstop ("Kein Endgeraet eingestellt")

+        ELSE clear error;

+             errorstop ("Unbekanntes Endgeraet: """ + msg.dev name + """")

+     FI.

+END PROC plot manager;

+

+(****************************** Spool Monitor ******************************)

+

+INT VAR command index , params ;

+TEXT VAR command line, param 1, param 2 ;

+ 

+LET spool command list =

+"break:1.0start:2.0stop:3.0halt:4.0first:5.0killer:6.0listspool:7.0

+ clearspool:8.0selectplotter:9.0spoolcontrol:10.1";

+ 

+PROC spool monitor:

+  disable stop ;

+  current plotter := 0;

+  select plotter ("");

+  REP command dialogue (TRUE) ;

+      get command (gib kommando, command line);

+      analyze command (spool command list, command line, 3, command index,

+                       params, param1, param2);

+      execute command;

+  UNTIL NOT online PER;

+  command dialogue (FALSE);

+  break (quiet);

+  set autonom.

+

+  gib kommando:

+     IF actual plotter > 0

+        THEN plotter info (name(plotters,actual plotter),50)

+        ELSE "ALL-Plotter: "

+     FI

+END PROC spool monitor;

+

+PROC execute command:

+ enable stop;

+ SELECT command index OF 

+   CASE 1  :  break

+   CASE 2  :  start cmd

+   CASE 3  :  stop  cmd

+   CASE 4  :  halt  cmd

+   CASE 5  :  first cmd

+   CASE 6  :  killer cmd

+   CASE 7  :  show spool list

+   CASE 8  :  clear spool

+   CASE 9  :  select plotter cmd

+   CASE 10 :  set spool control

+   OTHERWISE  do (command line);

+              set current plotter

+ END SELECT.

+ 

+ set current plotter:

+   current plotter := link(managed plotter, name (plotters,actual plotter));

+   IF actual plotter > 0 AND current plotter = 0

+      THEN select plotter ("");

+           current plotter := 0;

+           errorstop ("Auf dieser Station unbekannt: """+name(plotter)+"""")

+   FI.

+

+   start cmd:

+    FOR act dev FROM curr dev UPTO top dev REP

+       start (act dev)

+    PER.

+

+ stop cmd:

+    FOR act dev FROM curr dev UPTO top dev REP

+       IF device [act dev].server.current job.ds name <> "" CAND

+          yes ("""" + device [act dev].server.current job.ds name +

+                """ neu eintragen")

+          THEN entry into chain (act dev, device [act dev].server.current job);

+               IF device [act dev].chain.last > 1

+                  THEN make new first (act dev, device [act dev].chain.last)

+               FI

+       FI;

+       stop (act dev)

+    PER.

+

+ halt cmd:

+    FOR act dev FROM curr dev UPTO top dev REP

+       halt (act dev)

+    PER.

+

+ first cmd:

+    IF current plotter = 0

+       THEN device error

+    FI;

+    TEXT VAR make to first :: one (chain thesaurus (current plotter,niltask,TRUE)

+                                   -first chain entry)

+   IF make to first <> ""

+       THEN INT VAR new first entry :: find entry (make to first,

+                                            current plotter, niltask, FALSE);

+            IF new first entry > 1

+               THEN make new first (current plotter, new first entry)

+            FI

+    FI.

+

+    first chain entry:

+       INT VAR first entry id :: device [current plotter].chain.first;

+       IF first entry id > 0

+          THEN device [current plotter].chain.entry[first entry id].job.ds name

+          ELSE ""

+       FI.

+

+ killer cmd:

+    IF current plotter = 0

+       THEN device error

+    FI;

+    THESAURUS VAR to erase :: chain thesaurus (current plotter,niltask,FALSE);

+    INT VAR index, act dev;

+    TEXT VAR name to erase;

+    FOR act dev FROM curr dev UPTO top dev REP

+       index := 0;

+       get (to erase, name to erase, index);

+       WHILE index > 0 REP

+          INT VAR entry to erase := find entry (name to erase, current plotter, niltask, TRUE);

+          IF (entry to erase > 0) CAND

+             yes ("""" + name to erase + """ loeschen")

+             THEN erase entry (current plotter, entry to erase)

+          FI;

+          get (to erase, name to erase, index)

+       PER

+    PER.

+

+ show spool list :

+    create chain list (current plotter);

+    show (chain info);

+    forget (reply ds).

+

+ clear spool:

+    FOR act dev FROM curr dev UPTO top dev REP

+        IF yes ("Spool """ + name (managed plotter, act dev) + """ initialisieren")

+           THEN BOOL VAR stopped :: device [act dev].server.stopped;

+                stop (act dev);

+                init device (act dev);

+                IF stopped

+                   THEN device [act dev].server.stopped := TRUE

+                   ELSE start (act dev)

+                FI

+        FI

+    PER.

+

+  set spool control:

+     control task := task (param 1).

+

+  select plotter cmd:

+    THESAURUS VAR plotter list :: empty thesaurus;

+    TEXT VAR plotter name;

+    get (managed plotter, plotter name, index);

+    WHILE index > 0 REP

+       insert (plotter list, plotter info (plotter name, 60));

+       get (managed plotter, plotter name, index)

+    PER;

+    select plotter (name (managed plotter,

+                    link (plotter list,one (plotter list))));

+    set current plotter.

+

+ curr dev:

+    IF current plotter = 0

+       THEN 1

+       ELSE current plotter

+    FI.

+

+ top dev:

+    IF current plotter = 0

+       THEN max devices

+       ELSE current plotter

+    FI.

+

+  device error:

+     errorstop ("Kein Endgeraet eingestellt")

+

+ENDPROC execute command ;

+

+(************************** SPOOL - Verwaltung *****************************)

+

+PROC entry into chain (INT CONST dev no, JOB CONST new job): 

+   INT VAR act entry := act chain.empty; 

+   act chain.empty := act chain.entry [act entry].link;

+   IF act chain.last > 0 

+      THEN act chain.entry [act chain.last].link := act entry 

+   FI; 

+   act chain.last := act entry; 

+   IF act chain.first = 0 

+      THEN act chain.first := act entry 

+   FI; 

+   act chain.entry [act entry] := ENTRY : (new job,0). 

+ 

+   act chain : 

+      device [dev no].chain 

+END PROC entry into chain; 

+ 

+PROC erase entry (INT CONST dev no, to erase): 

+   INT VAR act entry;

+   to forward entry; 

+   IF act entry > 0 

+      THEN act chain.entry [act entry].link := act chain.entry [to erase].link 

+   FI; 

+   IF act chain.last = to erase 

+      THEN act chain.last := act entry 

+   FI; 

+   IF act chain.first = to erase 

+      THEN act chain.first := act chain.entry [to erase].link 

+   FI; 

+   init job (act chain.entry [to erase].job);

+   act chain.entry [to erase].link := act chain.empty; 

+   act chain.empty := to erase. 

+ 

+   to forward entry: 

+      FOR act entry FROM 1 UPTO max entries REP 

+      UNTIL act chain.entry [act entry].link = to erase PER; 

+      IF act entry > max entries 

+         THEN act entry := 0 

+     FI. 

+ 

+   act chain: 

+      device [dev no].chain 

+END PROC erase entry; 

+ 

+INT PROC find entry (TEXT CONST ds name, INT CONST dev, TASK CONST order task,BOOL CONST priviledged):

+   INT VAR act dev :: dev,act entry,last found :: 0;

+   IF act dev = 0

+      THEN FOR act dev FROM 1 UPTO max devices REP

+               find entry of order task

+           UNTIL act entry > 0 PER

+      ELSE find entry of order task

+    FI;

+    IF act entry = 0

+       THEN last found

+       ELSE act entry

+    FI.

+

+   find entry of order task:

+      BOOL VAR entry found;

+      act entry := act chain.first;

+      WHILE act entry > 0 REP

+         entry found := (act chain.entry [act entry].job.ds name = ds name);

+         IF entry found

+            THEN last found := act entry;

+                 entry found := (index (act chain.entry [act entry].job.order task) =

+                                 index (order task)) OR priviledged

+         FI;

+         IF NOT entry found

+            THEN act entry := act chain.entry [act entry].link

+         FI

+      UNTIL entry found PER.

+

+   act chain:

+      device [act dev].chain

+

+END PROC find entry;

+

+PROC make new first (INT CONST dev no, new first):

+   JOB VAR new first job :: act chain.entry [new first].job;

+   erase entry (dev no, new first);

+   INT VAR act entry := act chain.empty;

+   act chain.empty := act chain.entry [act entry].link;

+   act chain.entry [act entry] := ENTRY : (new first job, act chain.first);

+   act chain.first := act entry;

+   IF act chain.last = 0

+      THEN act chain.last := act entry

+   FI.

+

+   act chain:

+     device [dev no].chain

+

+END PROC make new first;

+

+THESAURUS PROC chain thesaurus (INT CONST dev no, TASK CONST order task,

+                                BOOL CONST double):

+   THESAURUS VAR list :: empty thesaurus;

+   INT VAR act dev := dev no,act entry;

+   IF act dev = 0 

+      THEN FOR act dev FROM 1 UPTO max devices REP 

+               list chain 

+           PER 

+      ELSE list chain 

+   FI; 

+   list.

+       

+   list chain: 

+      act entry := act chain.first; 

+      WHILE act entry > 0 REP 

+         IF (order task = niltask) OR

+            (act chain.entry [act entry].job.order task = order task)

+            THEN insert job name

+         FI;

+         act entry := act chain.entry [act entry].link 

+      PER.

+

+   insert job name:

+      TEXT VAR this job :: act chain.entry [act entry].job.ds name

+      IF double OR (NOT (list CONTAINS this job))

+         THEN insert (list, this job)

+      FI.

+

+   act chain: 

+      device [act dev].chain 

+ 

+END PROC chain thesaurus; 

+ 

+

+PROC create chain list (INT CONST dev no):

+   INT VAR act dev :: dev no, act entry; 

+   init chain info; 

+   IF act dev = 0

+      THEN FOR act dev FROM 1 UPTO max devices REP 

+             list chain 

+           PER 

+      ELSE list chain

+   FI.

+      

+   init chain info: 

+      forget (reply ds);

+      reply ds := nilspace;

+      chain info := sequential file (output, reply ds); 

+      headline (chain info,"GRAPHIK - Ausgabe um "+ time of day (clock (1)) + " Uhr :").

+

+ 

+   list chain: 

+      server head;

+      IF NOT server is active (act dev) OR is no job (act server.current job)

+         THEN put (chain info, "- Kein Auftrag in Bearbeitung") ;

+              IF act server.stopped

+                 THEN put (chain info, "  ( SERVER deaktiviert )")

+              FI;

+              line (chain info)

+         ELSE put (chain info, "- In Bearbeitung seit "+time of day (act server.time)+" Uhr :");

+              IF act server.stopped

+                 THEN put (chain info, " ( SERVER wird deaktiviert !)")

+              FI;

+              line (chain info, 2);

+              putline (chain info, job note (act server.current job))

+      FI; 

+      line (chain info);  

+      IF act chain.last = 0 

+         THEN putline (chain info, "- Keine Auftraege im SPOOL")

+         ELSE putline (chain info, "- Weitere Auftraege im SPOOL :"); 

+              line    (chain info); 

+              act entry := act chain.first; 

+              WHILE act entry > 0 REP 

+                    putline (chain info, job note (act chain.entry [act entry].job)); 

+                    act entry := act chain.entry [act entry].link 

+              PER 

+      FI; 

+      line (chain info, 2). 

+ 

+   server head:

+      TEXT VAR plotter name :: name (managed plotter,act dev);

+      INT VAR station :: int (plottername),

+              tp      :: pos (plottername,trenn)+1,

+              channel :: int (subtext (plottername,tp));

+      plotter name := subtext (plotter name, pos (plotter name, trenn, tp)+1);

+      putline (chain info, 77 * "-");

+      putline (chain info,

+               center (plotter name + (30-length(plotter name))*"." +

+                      "Kanal " + text (channel) +

+                      "/Station " + text (station)));

+      putline (chain info, 77 * "-");

+      line (chain info).

+

+   act chain: 

+      device [act dev].chain. 

+ 

+   act server: 

+      device [act dev].server 

+ 

+END PROC create chain list; 

+

+BOOL PROC chain is empty (INT CONST dev no):

+   device [dev no].chain.first = 0 OR device [dev no].chain.last = 0

+END PROC chain is empty;

+

+BOOL PROC chain is full (INT CONST dev no):

+   device [dev no].chain.empty = 0

+END PROC chain is full;

+

+PROC transfer next job (INT CONST dev no): 

+   INT VAR next chain entry := device [dev no].chain.first;

+   next server job (dev no, device [dev no].chain.entry [next chain entry].job); 

+   erase entry (dev no,next chain entry) 

+END PROC transfer next job; 

+ 

+(*************************** SERVER - Verwaltung ***************************)

+

+PROC next server job (INT CONST dev no,JOB CONST next job): 

+   act server.time := clock (1); 

+   act server.current job := next job. 

+ 

+   act server: 

+      device [dev no].server 

+END PROC next server job; 

+ 

+BOOL PROC server is active (INT CONST dev no):

+   exists (act server.task) CAND server alive or restarted.

+

+   server alive or restarted:

+      SELECT status (act server.task) OF

+        CASE 0 (* busy *) ,

+             4 (* busy-blocked *),

+             2 (* wait *),

+             6 (* wait-blocked *) : TRUE

+        CASE 1 (* i/o *),

+             5 (* i/o -blocked *): IF channel (act server.task) = 0

+                                     THEN restart

+                                     ELSE TRUE

+                                   FI

+        OTHERWISE restart

+      END SELECT.

+

+   restart:

+     end server (dev no);

+     IF NOT act server.stopped AND NOT chain is empty (dev no)

+        THEN create server (dev no)

+     FI;

+     NOT is niltask (act server.task).

+

+   act server:

+      device [dev no].server

+

+END PROC server is active;

+

+PROC create server (INT CONST dev no): 

+   init job (act server.current job);

+   act server.wait for halt := niltask;

+   act server.time := 0.0;

+   act server.stopped := FALSE;

+   last created server := dev no;

+   begin (PROC plot server, device [dev no].server.task).

+

+   act server:

+      device [dev no].server

+END PROC create server; 

+ 

+PROC end server (INT CONST dev no): 

+   end (act server.task);

+   act server.task := niltask.

+

+   act server:

+     device [dev no].server

+

+END PROC end server; 

+ 

+PROC start (INT CONST dev no):

+   IF server is active (dev no)

+      THEN end server (dev no)

+   FI;

+   IF NOT chain is empty (dev no)

+      THEN create server (dev no)

+   FI;

+   device [dev no].server.stopped := FALSE

+END PROC start;

+

+PROC stop (INT CONST dev no):

+   device [dev no].server.stopped := TRUE;

+   IF exists (device [dev no].server.wait for halt)

+      THEN send (device [dev no].server.wait for halt,ack)

+   FI;

+   device [dev no].server.wait for halt := niltask;

+   IF server is active (dev no)

+      THEN end server (dev no)

+   FI

+END PROC stop;

+

+PROC halt (INT CONST dev no):

+   device [dev no].server.stopped := TRUE

+END PROC halt;

+

+PROC send current job (INT CONST dev no):

+   forget (reply ds);

+   reply ds := device [dev no].server.current job.ds;

+   send (device [dev no].server.task, ack,reply ds);

+END PROC send current job;

+

+(****************************** Hilfsprozeduren ****************************)

+

+PROC init device (INT CONST dev no): 

+   INT VAR act entry;

+   act server.task        := niltask; 

+   act server.time        := 0.0; 

+   init job (act server.current job); 

+   act server.stopped     := FALSE;

+   act chain.first        := 0; 

+   act chain.last         := 0; 

+   act chain.empty        := 1;

+   FOR act entry FROM 1 UPTO max entries-1 REP

+      init job (act chain.entry [act entry].job);

+      act chain.entry [act entry].link := act entry + 1

+   PER;

+   init job (act chain.entry [act entry].job);

+   act chain.entry [act entry].link := 0.

+

+   act server : 

+      device [dev no].server. 

+ 

+   act chain : 

+      device [dev no].chain 

+ 

+END PROC init device; 

+

+INT PROC max devices:

+   highest entry (managed plotter)

+END PROC max devices;

+

+OP := (MSG VAR dest, DATASPACE VAR source):

+   TEXT VAR ds name :: "", dev name :: "";

+   BOUND STRUCT (TEXT ds name, dev name, passwd) VAR msg in := source;

+   divide names;

+   dest := MSG : (ds name, dev name, msg in .passwd,

+                  link (managed plotter,dev name));

+   forget (source).

+

+   divide names:

+      INT VAR pps :: pos (msg in.ds name, ""0"");

+      WHILE pos (msg in.ds name, ""0"", pps+1) > 0 REP

+         pps := pos (msg in.ds name,""0"", pps+1)

+      PER;

+      IF pps > 0

+         THEN ds name  := subtext (msg in.ds name, 1, pps-1);

+      FI;

+      dev name := subtext (msg in.ds name, pps+1).

+

+END OP :=;

+

+TEXT PROC job note (JOB CONST job): 

+   "  - " + owner id (job.order task) + " : " + qrline (job.ds name, 20) +

+   " (" + text (storage (job.ds)) + " K)".

+END PROC job note; 

+

+TEXT PROC owner id (TASK CONST owner):

+    TEXT VAR test :: name (owner);

+    IF test <> ""

+       THEN text (station (owner)) + "/" + qrline (test,15)

+       ELSE "?????"

+    FI

+END PROC owner id;

+

+PROC init job (JOB VAR to initialize):

+   forget (to initialize.ds);

+   to initialize.ds name := "";

+   to initialize.order task := niltask

+END PROC init job;

+

+TEXT PROC qrline (TEXT CONST t,INT CONST len): 

+   IF length (t) > len-2 

+      THEN """" + text (t, len-5) + "...""" 

+      ELSE text ("""" + t + """", len) 

+   FI 

+END PROC qrline; 

+ 

+TEXT PROC center (TEXT CONST chars,INT CONST len):

+   len DIV 2 * " " + chars

+END PROC center;

+

+BOOL PROC is no job (JOB CONST job):

+   job.ds name = ""

+END PROC is no job;

+

+PROC send (TASK CONST task, INT CONST code):

+   DATASPACE VAR ds :: nilspace;

+   send (task, code, ds);

+   forget (ds)

+END PROC send;

+

+(**************************** Plot - Server ********************************)

+

+PROC plot server:

+   disable stop;

+   select plotter (name (managed plotter,last created server));

+   prepare;

+   REP

+      TEXT VAR dummy;

+      catinput (dummy, dummy);  (* evtl. Zeichen im Tastaturpuffer *)

+      PICFILE VAR pic :: next server job;

+      plot (pic);

+   PER.

+

+   next server job:

+     forget (reply ds);

+     reply ds := nilspace;

+     REP

+       call (father, fetch code, reply ds, reply)

+     UNTIL reply = ack PER;

+     reply ds

+END PROC plot server;

+

+END PACKET plot manager

diff --git a/app/mpg/1987/src/GRAPHIK.Plot b/app/mpg/1987/src/GRAPHIK.Plot
new file mode 100644
index 0000000..00911a8
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Plot
@@ -0,0 +1,1156 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.2 vom 23.09.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*              "Graphik-Plot" geschrieben von C.Weinholz                 *)

+(*                                                                        *) 

+(**************************************************************************) 

+(*                                                                        *) 

+(*           Paket II: Endgeraet-abhaengige Graphikroutinen               *) 

+(*        (koennen erst nach 'Interface.Conf' insertiert werden)          *) 

+(*                                                                        *) 

+(*                  1. Plot (Grundlegende Graphik-Operationen             *)

+(*                                                                        *) 

+(*                  2. Plot Input/Output (Routinen zum                    *)

+(*                           Ansprechen des PLOT-Spoolers                 *) 

+(*                           zur indirekten Graphik-Ausgabe)              *) 

+(*                                                                        *) 

+(*                  3. Plot Picture/Picfile                               *)

+(*                          (Ausgabe von PICTURES/ PICFILES)              *)

+(*                                                                        *)

+(**************************************************************************) 

+(*   Urversion  : 10.09.87                                                *) 

+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 

+(*                PROC save (PICFILE CONST, TEXT CONST, PLOTTER CONST)    *) 

+(*                hinzugefuegt                                            *) 

+(*                PROC plot (PICFILE CONST) auch indirekt                 *) 

+(*                Fehlermeldung bei indirektem 'plot (PICTURE)'           *) 

+(*                20.11.87, Beat Jegerlehner                              *)

+(*                Clipping bei move eingefuehrt. Gibt sonst bei Watanabe  *)

+(*                Probleme                                                *)

+(*                Textgenerator korrigiert                                *)

+(*                                                                        *) 

+(**************************************************************************)

+ 

+(************************************ Plot ********************************)

+

+PACKET basis plot DEFINES

+

+      beginplot,

+      pen      ,

+

+      move     ,

+      move r   ,

+      move cm  ,

+      move cm r,

+

+      draw     ,

+      draw r   ,

+      draw cm  ,

+      draw cm r,

+

+      hidden lines,

+      reset    ,

+

+      zeichensatz,

+      reset zeichensatz,

+

+      linetype,

+      reset linetypes,

+

+      where,

+      bar,

+      circle,

+      box:

+

+LET empty              = 0,             (* Punktmuster *)

+    half               = 1,

+    full               = 2,

+    horizontal         = 3,

+    vertical           = 4,

+    cross              = 5,

+    diagonal right     = 6,

+    diagonal left      = 7,

+    diagonal both      = 8,

+    std zeichenname    = "ZEICHENSATZ";

+ 

+INT VAR  ltype    :: 1, 

+         thick    :: 0, 

+         xpixel   :: 0, 

+         ypixel   :: 0, 

+         old x    :: 0, 

+         old y    :: 0,

+         real old x :: 0,

+         real old y :: 0;

+

+REAL VAR x cm, ycm,hor relation, vert relation,x to y,y to x;

+

+ROW 5 TEXT VAR linetypes; 

+

+INT  VAR cnt :: 0;

+TEXT VAR muster :: "0";

+INT  VAR lentxt :: length(muster);

+ 

+LET POS = STRUCT (REAL x, y, z);

+POS VAR pos :: POS : (0.0, 0.0, 0.0);

+

+LET ZEICHENSATZ = ROW 255 TEXT;

+ZEICHENSATZ VAR zeichen;

+REAL CONST char x :: 6.0, char y :: 6.0,y base :: 2.0;

+ 

+BOUND ZEICHENSATZ VAR std zeichen :: old (std zeichenname);

+reset zeichensatz;

+reset linetypes;

+

+INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0;

+

+BOOL VAR hidden :: FALSE;

+

+DATASPACE VAR ds :: nilspace;

+BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds;

+

+(*************************** Initialisierung *******************************)

+

+PROC beginplot: 

+   init plot; 

+   drawing area (x cm, y cm, x pixel, y pixel);

+   hor relation := real (x pixel)/x cm;

+   vert relation:= real (y pixel)/y cm;

+   x to y := x cm / real(x pixel) / (y cm / real (y pixel)); (*umrechnung:*)

+   y to x := 1.0 / x to y;             (* x pixel in y pixel u andersherum*)

+END PROC beginplot; 

+

+PROC pen (INT CONST backgr,colour,thickn,linetype):

+  background(backgr); 

+  foreground(colour); 

+  thick := int(real(thickn) / 200.0 * real(x pixel) / x cm);

+  ltype := selected linetype; 

+  IF ltype > 1 

+     THEN muster := linetypes[ltype];

+          lentxt := length (muster);

+          cnt    := 0 

+  FI. 

+ 

+  selected linetype: 

+     IF linetype < 0 OR linetype > 5 

+        THEN 1 

+        ELSE linetype 

+     FI 

+END PROC pen; 

+

+(************************** MOVE - Prozeduren ******************************)

+

+PROC move (INT CONST x,y): 

+  old x := x; 

+  old y := y 

+END PROC move; 

+

+PROC do move (INT CONST x,y):

+  IF x <> real old x OR 

+     y <> real old y

+    THEN real old x := x;

+         real old y := y;

+         move to (x,y)

+  FI;

+  old x := x;

+  old y := y

+END PROC do move;

+ 

+PROC move (REAL CONST x, y) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (x, y, 0.0, h, v);

+  move (h, v);

+  pos := POS : (x, y, 0.0)

+END PROC move;

+

+PROC move (REAL CONST x, y, z) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (x, y, z, h, v);

+  move (h, v);

+  pos := POS : (x, y, z)

+END PROC move;

+

+PROC move r (REAL CONST x, y) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (pos.x+x, pos.y+y, pos.z, h, v);

+  move (h, v);

+  pos := POS : (pos.x+x, pos.y+y, pos.z)

+END PROC move r;

+

+PROC move r (REAL CONST x, y, z) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);

+  move (h, v);

+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)

+END PROC move r;

+

+PROC move cm (REAL CONST x cm, y cm) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  h := int (x cm*hor relation+0.5);

+  v := int (y cm*vert relation+0.5);

+  move (h, v)

+END PROC move cm;

+

+PROC move cm r (REAL CONST x cm, y cm) :

+  IF hidden 

+  THEN maxima.last := maxima.akt FI;

+

+  h INCR int (x cm*hor relation+0.5);

+  v INCR int (y cm*vert relation+0.5);

+  move (h, v)

+END PROC move cm r;

+

+(************************** DRAW - Prozeduren ******************************)

+

+PROC draw (INT CONST x,y): 

+  draw (old x,old y,x,y) 

+END PROC draw; 

+ 

+PROC draw (INT CONST x0,y0,x1,y1): 

+  IF thick = 0

+    THEN line (x0, y0,x1,y1) 

+    ELSE old x := x0; 

+         old y := y0; 

+         draw thick line (x1,y1) 

+  FI; 

+  old x := x1; 

+  old y := y1 

+END PROC draw;  

+

+PROC draw (REAL CONST x, y) :

+  IF hidden

+  THEN transform (x, y, 0.0, new h, new v);

+       vector (new h-h, new v-v)

+  ELSE transform (x, y, 0.0, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (x, y, 0.0)

+END PROC draw;

+

+PROC draw (REAL CONST x, y, z) :

+  IF hidden

+  THEN transform (x, y, z, new h, new v);

+       vector (new h-h, new v-v)

+  ELSE transform (x, y, z, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (x, y, z) 

+END PROC draw;

+

+PROC draw r (REAL CONST x, y) :

+  IF hidden

+  THEN transform (pos.x+x, pos.y+y, pos.z, h, v); 

+       vector (new h-h, new v-v)

+  ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); 

+       draw (h, v)

+  FI;

+  pos := POS : (pos.x+x, pos.y+y, pos.z)

+END PROC draw r;

+

+PROC draw r (REAL CONST x, y, z) :

+  IF hidden

+  THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); 

+       vector (new h-h, new v-v)

+  ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v);

+       draw (h, v)

+  FI;

+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)

+END PROC draw r;

+

+PROC draw cm (REAL CONST x cm, y cm) :

+  IF hidden

+  THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v)

+  ELSE h := int (x cm*hor relation+0.5);

+       v := int (y cm*vert relation+0.5);

+       draw (h, v)

+  FI

+END PROC draw cm;

+

+PROC draw cm r (REAL CONST x cm, y cm) :

+  IF hidden

+  THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5))

+  ELSE h INCR int (x cm*hor relation+0.5);

+       v INCR int (y cm*vert relation+0.5);

+       draw (h, v)

+  FI

+END PROC draw cm r;

+

+(*************************** LINIEN zeichnen *******************************)

+

+PROC line (INT CONST x0,y0,x1,y1): 

+  REAL VAR x0r :: real (x0), 

+           y0r :: real (y0), 

+           x1r :: real (x1), 

+           y1r :: real (y1); 

+  IF clipped line (x0r,y0r,x1r,y1r) 

+     THEN IF ltype > 1 

+             THEN draw special line(int(x0r),int(y0r),int(x1r),int(y1r)) 

+          ELIF ltype = 1 

+             THEN do move (int(x0r),int(y0r)); 

+                  draw std line (int(x1r),int(y1r)) 

+          FI 

+  FI

+END PROC line; 

+

+PROC draw std line (INT CONST x,y): 

+  old x := x; 

+  old y := y;

+  real old x := x;

+  real old y := y;

+  draw to (x,y) 

+END PROC draw std line; 

+ 

+PROC draw special line (INT CONST x0,y0,x1,y1): 

+  IF x0 = x1 

+    THEN vertical line 

+  ELIF y0 = y1 

+    THEN horizontal line

+  ELIF abs(x1-x0) > abs(y1 - y0) 

+    THEN steile linie 

+    ELSE flache linie 

+  FI. 

+ 

+  vertical line: 

+    INT VAR steps :: abs(y1 - y0), 

+            sig   :: sign(y1-y0),

+            i;

+    FOR i FROM 0 UPTO steps REP 

+      IF next pixel

+         THEN set pixel(x0,y0+i*sig)

+      FI

+    PER. 

+ 

+  horizontal line: 

+    steps := abs(x1 - x0); 

+    sig :=   sign(x1 - x0); 

+    FOR i FROM 0 UPTO steps REP 

+      IF next pixel

+         THEN set pixel(x0+i*sig,y0)

+      FI

+    PER. 

+ 

+  steile linie: 

+    steps := abs(x1 - x0); 

+    sig := sign(x1 - x0); 

+    REAL VAR m :: real(y1 - y0) / real(x1 - x0); 

+    FOR i FROM 0 UPTO steps REP 

+      IF next pixel

+         THEN set pixel(x0+sig*i,y0+int(m*real(sig*i) + 0.5))

+      FI

+    PER. 

+ 

+  flache linie: 

+    steps := abs(y1 - y0); 

+    sig := sign(y1 - y0); 

+    m := real(x1 - x0) / real(y1 - y0); 

+    FOR i FROM 0 UPTO steps REP 

+      IF next pixel

+         THEN set pixel(x0+int(m*real(sig*i) + 0.5),y0+sig*i)

+      FI

+    PER.

+

+    next pixel:

+      BOOL VAR is set :: (muster SUB cnt) <> "0";

+      cnt INCR 1;

+      IF cnt > lentxt THEN cnt := 1 FI;

+      is set

+END PROC drawspecialline;

+

+PROC draw thick line (INT CONST x1,y1):

+  INT VAR x0 :: old x,

+          y0 :: old y,

+          x  :: x1,

+          y  :: y1;

+  swap if neccessary;

+  REAL VAR xr0 :: real(x0), 

+           yr0 :: real(y0) / (x cm * real(y pixel)) * 

+                             (y cm * real(x pixel)), 

+           xr1 :: real(x), 

+           yr1 :: real(y) / (x cm * real(y pixel)) * 

+                             (y cm * real(x pixel)); 

+  IF is vertical line

+    THEN draw vertical line 

+    ELSE draw line 

+  FI;

+  move(x1,y1).

+ 

+  swap if neccessary: 

+    IF x < x0 OR (x = x0 AND y < y0) 

+      THEN INT VAR dummy :: x0; 

+           x0 := x; 

+           x := dummy; 

+           dummy := y0; 

+           y0 := y; 

+           y := dummy 

+    FI.

+

+  is vertical line: 

+    x = x0.

+ 

+  draw vertical line: 

+    INT VAR i;

+    FOR i FROM - thick UPTO thick REP 

+      cnt := 0;

+      line (xr0+real(i),yr0-real(thick),xr0+real(i),yr1+real(thick)) 

+    PER. 

+

+  draw line: 

+    REAL VAR m :: (yr1 - yr0) / (xr1 - xr0),

+             dx :: real(thick)/sqrt(1.0+m**2), 

+             dy :: m * dx,

+             xn, 

+             yn, 

+             diff,

+             dsx :: dy,

+             dsy :: -dx,

+             x incr :: -real(sign(dsx)), 

+             y incr :: -real(sign(dsy)); 

+  xr0 INCR -dx; 

+  yr0 INCR -dy; 

+  xr1 INCR  dx; 

+  yr1 INCR  dy;

+  xn := xr0 + dsx; 

+  yn := yr0 + dsy; 

+  REP

+    line(xn,yn,xr1 - xr0 + xn,yr1 - yr0 + yn); 

+    diff := (2.0*dsy *(xn - (xr0 - dy)) - 2.0 * dsx * (yn - (yr0 + dx))) 

+             * real(sign(m));

+    IF diff < 0.0

+      THEN xn INCR x incr 

+    ELIF diff > 0.0

+      THEN yn INCR y incr 

+      ELSE xn INCR x incr; 

+           yn INCR y incr 

+    FI 

+  UNTIL int(xn - xr0 + dy) = 0 AND int(yn - yr0 - dx) = 0 PER

+

+END PROC draw thick line; 

+ 

+PROC line (REAL CONST x0,y0,x1,y1): 

+  line (int(x0),int(y0 * (x cm * real(y pixel)) / (y cm * real(x pixel))),

+        int(x1),int(y1 * (x cm * real(y pixel)) / (y cm * real(x pixel))))

+END PROC line ;

+  

+(*************************** HIDDEN LINES **********************************)

+

+PROC hidden lines (BOOL CONST dev):

+  hidden := NOT dev;

+END PROC hidden lines;

+

+PROC vector (INT CONST dx, dy):

+  IF dx >= 0

+  THEN IF   dy >  dx THEN vector (v, h, dy, dx,  1, 1)

+       ELIF dy >   0 THEN vector (h, v, dx, dy,  1, 1)

+ 

+       ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1)

+       ELSE               vector (v, h, -dy, dx,-1, 1) FI

+

+  ELSE IF   dy > -dx THEN vector (v, h, dy, -dx, 1,-1)

+       ELIF dy >   0 THEN vector (h, v, -dx, dy,-1, 1)

+ 

+       ELIF dy >  dx THEN vector (h, v, -dx, -dy,-1,-1)

+       ELSE               vector (v, h, -dy, -dx,-1,-1) FI

+  FI  .

+ 

+ENDPROC vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :

+  INT VAR i;

+  prepare first step ;

+  draw point;

+  FOR i FROM 1 UPTO dx

+  REP do one step PER;

+

+  IF was visible

+  THEN draw (h, v) FI  .

+

+

+prepare first step :

+  INT VAR up right error := dy - dx,

+          right error := dy,

+          old error := 0,

+          last h :: h, last v :: v;

+  BOOL VAR was visible :: visible  .

+

+

+do one step:

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error)  .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  draw point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  draw point ;

+  old error INCR right error .

+ 

+draw point :

+  IF was visible

+  THEN IF NOT visible

+       THEN draw (last h, last v);

+            was visible := FALSE

+       FI;

+       last h := h;

+       last v := v

+  ELSE IF visible

+       THEN move (h, v);

+            was visible := TRUE;

+            last h := h;

+            last v := v 

+       FI

+ FI  .

+

+visible:

+  IF h < 1 OR h > x pixel

+  THEN FALSE

+  ELSE IF maxima.akt [h] < v 

+       THEN maxima.akt [h] := v FI; 

+       v > maxima.last [h]

+  FI

+END PROC vector;

+

+PROC reset:

+  forget (ds);

+  ds := nilspace;

+  maxima := ds

+END PROC reset;

+

+(**************************** TEXT - Ausgabe *******************************)

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);

+       zeichen := new zeichen;

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC reset zeichensatz: 

+   zeichen := std zeichen 

+END PROC reset zeichensatz; 

+ 

+PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST y size, 

+                x size, direction):

+  TEXT CONST character :: zeichen [char no];

+  INT VAR n :: 1, x0, y0, x1, y1;

+  INT CONST len :: length (character);

+  REAL CONST sindir :: sind(direction),

+             cosdir :: cosd(direction);

+  WHILE n < len

+  REP value (character, n, x0, y0, x1, y1);

+  REAL VAR xr0 :: real(x0),

+           yr0 :: real(y0),

+           xr1 :: real(x1), 

+           yr1 :: real(y1);

+      transform (xr0, yr0, x, y, x size, y size, sindir,cosdir);

+      transform (xr1, yr1, x, y, x size, y size, sindir,cosdir);

+      draw (int(xr0), int (yr0 * x to y),

+            int(xr1),int(yr1 * x to y));

+       n INCR 4 

+  PER  .

+

+END PROC draw char;

+

+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):

+  x0 := val (code (char SUB n));    y0 := val (code (char SUB n+1));

+  x1 := val (code (char SUB n+2));  y1 := val (code (char SUB n+3));

+END PROC value;

+

+INT PROC val (INT CONST n):

+  IF n > 127

+  THEN -256 OR n

+  ELSE n FI

+END PROC val;

+

+PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, 

+                sindir,cosdir):

+  REAL CONST old x :: x, old y :: y;

+  REAL CONST dx :: x size / char x * old x * cosdir - 

+                   (y size-y base) / char y * old y * sindir, 

+             dy :: (y size-y base) / char y * old y * cosdir + 

+                   x size / char x * old x * sindir;

+  x := x0 + dx; 

+  y := y0 + dy

+END PROC transform; 

+

+PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, 

+                REAL CONST height, width): 

+  INT VAR i;

+  REAL VAR x :: x pos, y :: y pos,

+           x step :: cosd (angle)*width,

+           y step :: sind (angle)*width;

+  FOR i FROM 1 UPTO length (msg)

+  REP IF control char

+      THEN execute control char

+      ELSE execute normal char FI

+  PER  .

+

+control char:

+  akt char < ""32""  .

+

+execute control char:

+  SELECT code (akt char) OF

+  CASE  1: home

+  CASE  2: right

+  CASE  3: up

+  CASE  7: out (""7"")

+  CASE  8: left

+  CASE 10: down

+  CASE 13: return

+  ENDSELECT  .

+

+home:

+  x := x pos;

+  y := y pos  .

+

+right:

+  x INCR x step;  y INCR y step  . 

+

+up:

+  x INCR y step;  y INCR x step  . 

+

+left:

+  x DECR x step;  y DECR y step  .

+

+down:

+  x DECR y step;  y DECR x step  . 

+

+return:

+  x := x pos  .

+

+execute normal char:

+  draw char (code (akt char), x, y, height, width,

+             angle);

+  x INCR x step;

+  y INCR y step .

+

+akt char:

+  msg SUB i  .

+

+END PROC draw text; 

+ 

+PROC draw (TEXT CONST msg):

+   draw (msg,0.0,5.0,5.0)

+END PROC draw;

+ 

+PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width):

+    REAL CONST  xr :: real(old x), 

+                yr :: real(old y) * y to x;

+    draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, 

+                               width  * real(x pixel) / x cm / 10.0)

+                                    (* heigth  mm --> x punkte *)

+END PROC draw; 

+ 

+(***************************** LINETYPES ***********************************)

+

+PROC linetype (INT CONST nummer,TEXT CONST lt): 

+   IF nummer > 5 OR nummer < 2 

+      THEN errorstop ("number out of range") 

+      ELSE linetypes [nummer] := lt 

+   FI 

+END PROC linetype ; 

+ 

+PROC reset linetypes : 

+   linetype (2,"1100"); 

+   linetype (3,"11110000"); 

+   linetype (4,"1111111100000000"); 

+   linetype (5,"1111111100011000"); 

+END PROC reset linetypes ; 

+

+(***************************** UTILIES *************************************)

+

+PROC where (REAL VAR x, y) :

+  x := pos.x;  y := pos.y

+END PROC where;

+

+PROC where (REAL VAR x, y, z) :

+  x := pos.x;  y := pos.y;  z := pos.z

+END PROC where;

+

+PROC bar (REAL CONST hight, width, INT CONST pattern):

+  INT VAR zero x, zero y, end x, end y;

+  transform (0.0, 0.0, 0.0, zero x, zero y);

+  transform (width, hight, 0.0, end x, end y);

+  bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern)

+END PROC bar;

+

+PROC bar (INT CONST from x, from y, width, hight, pattern):

+  INT CONST to x :: from x+width, to y :: from y+hight;

+  INT VAR x, y;

+  draw frame;

+  SELECT pattern OF

+  CASE empty: (* nothing to do *)

+  CASE half:           half bar

+  CASE full:           full bar

+  CASE horizontal:     horizontal bar

+  CASE vertical:       vertical bar

+  CASE cross:          horizontal bar;

+                       vertical bar

+  CASE diagonal right: diagonal right bar

+  CASE diagonal left:  diagonal left bar

+  CASE diagonal both:  diagonal both bar

+  OTHERWISE errorstop ("Unknown pattern") ENDSELECT  .

+

+draw frame:

+  move (from x, from y);

+  draw (from x, to y);

+  draw (to x, to y);

+  draw (to x, from y);

+  draw (from x, from y).

+

+full bar:

+  FOR y FROM from y UPTO to y

+  REP move (from x, y);

+      draw (to x, y) 

+  PER  .

+

+half bar:

+  FOR y FROM from y UPTO to y

+  REP x := from x + 1 + (y AND 1);

+      WHILE x < to x 

+      REP move (x, y);

+          draw (x, y);

+          x INCR 2

+      PER

+  PER  .

+

+horizontal bar:

+  y := from y;

+  WHILE y < to y

+  REP move (from x, y);

+      draw (to x, y);

+      y INCR 5

+  PER  .

+

+vertical bar:

+  x := from x + 5;

+  WHILE x < to x

+  REP move (x, from y);

+      draw (x, to y);

+      x INCR 5

+  PER  .

+

+diagonal right bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (max (from x, to x-y-width+from y), max (from y, y));

+      draw (min (to x, from x+to y-y), min (to y, y+width));

+      y INCR 5

+  PER  .

+

+diagonal left bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (min (to x, to x-from y+y),  max (from y, y));

+      draw (max (from x, from x+y+width-to y), min (to y, y+width)); 

+      y INCR 5

+  PER  .

+

+diagonal both bar:

+  y := from y-width+5;

+  WHILE y < to y

+  REP move (max (from x, to x-y-width+from y), max (from y, y));

+      draw (min (to x, from x+to y-y), min (to y, y+width)); 

+      move (min (to x, to x-from y+y),  max (from y, y));

+      draw (max (from x, from x+y+width-to y), min (to y, y+width));

+      y INCR 5

+  PER  .

+

+END PROC bar;

+

+PROC circle (REAL CONST r, from, to, INT CONST pattern):

+  REAL VAR t :: from;   INT VAR i; i := pattern; (* sonst WARNUNG *)

+  WHILE t < to

+  REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v);

+      draw (h, v);

+      t INCR 1.0

+  PER;

+  transform (pos.x, pos.y, 0.0, h, v);

+  draw (h, v)  .

+

+END PROC circle;

+

+PROC box :

+  move (0,0);

+  draw (0,y pixel-1);

+  draw (x pixel-1, y pixel-1);

+  draw (x pixel-1, 0);

+  draw (0,0)

+END PROC box;

+

+END PACKET basis plot;

+

+(************************* Plot Spool Input/ Output ***********************)

+

+PACKET plot interface   DEFINES                       (* Carsten Weinholz *)

+                                                      (* V 1.1  02.07.87  *) 

+                                save                 , 

+                                exists               , 

+                                erase                , 

+                                ALL                  ,

+                                first                , 

+                                start                , 

+                                stop                 , 

+                                halt                 , 

+                                wait for halt        , 

+                                list                 , 

+                                picfiles             ,

+                                generate plot manager:

+ 

+LET initfile         = "GRAPHIK.Manager", 

+    plot manager name= "PLOT"   , 

+

+    picfiletype      = 1102,

+ 

+    ack              = 0, 

+    false code       = 6,

+    fetch code       = 11,

+    save code        = 12,

+    exists code      = 13, 

+    erase code       = 14, 

+    list code        = 15,

+    all code         = 17, 

+    first code       = 25,

+    start code       = 26,

+    stop  code       = 27,

+    halt code        = 28,

+    wait for halt  code = 29;

+ 

+BOUND STRUCT (TEXT tname,user id,pass) VAR msg; 

+ 

+DATASPACE VAR ds; 

+

+INT VAR reply;

+THESAURUS VAR all myself picfiles; 

+ 

+PROC first (TEXT CONST ds name, PLOTTER CONST plotter id): 

+   call (first code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) 

+END PROC first; 

+ 

+PROC start (PLOTTER CONST plotter id):

+   call (start code, id name (plotter id), plot id (plotter id)) 

+END PROC start;

+ 

+PROC stop (PLOTTER CONST plotter id): 

+   call (stop code, id name (plotter id), plot id (plotter id)) 

+END PROC stop;

+ 

+PROC halt (PLOTTER CONST plotter id): 

+   call (halt code, id name (plotter id), plot id (plotter id)) 

+END PROC halt; 

+ 

+PROC wait for halt (PLOTTER CONST plotter id): 

+   call (wait for halt code, id name (plotter id), plot id (plotter id)) 

+END PROC wait for halt; 

+ 

+PROC save (TEXT CONST ds name, PLOTTER CONST plotter id):

+   enable stop;

+   last param (ds name);

+   call (save code, ds name + ""0"" + id name (plotter id), 

+                                 old (ds name), plot id (plotter id))

+END PROC save; 

+ 

+PROC save (PICFILE CONST p, TEXT CONST pname, PLOTTER CONST plotter id): 

+   enable stop;

+   DATASPACE VAR ds; 

+   ds BECOMES p; 

+   call (save code, pname + ""0"" + id name (plotter id), ds, 

+         plot id (plotter id)); 

+END PROC save; 

+ 

+OP BECOMES (DATASPACE VAR ds, PICFILE CONST p):

+   EXTERNAL 260

+END OP BECOMES;

+ 

+PROC save (THESAURUS CONST nameset, PLOTTER CONST plotter id): 

+   TEXT VAR name; 

+   INT VAR i :: 0; 

+   get (nameset, name, i); 

+   WHILE i > 0 REP 

+      save (name, plotter id); 

+      cout (i); 

+      get (nameset, name, i) 

+   PER

+END PROC save;

+

+BOOL PROC exists (TEXT CONST ds name, PLOTTER CONST plotter id): 

+   INT VAR reply;

+   DATASPACE VAR ds :: nilspace; 

+   BOUND TEXT VAR qname :: ds; 

+   qname := ds name + ""0"" + id name (plotter id); 

+   REP 

+      call (plot id (plotter id), exists code, ds, reply) 

+   UNTIL reply = false code OR reply = ack PER;

+   forget (ds); 

+   reply = ack 

+END PROC exists; 

+

+PROC erase (TEXT CONST ds name,PLOTTER CONST plotter id): 

+   call (erase code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) 

+END PROC erase;

+ 

+PROC erase (THESAURUS CONST nameset, PLOTTER CONST plotter id): 

+   TEXT VAR name; 

+   INT VAR i :: 0; 

+   get (nameset, name, i); 

+   WHILE i > 0 REP 

+      erase (name, plotter id); 

+      cout (i); 

+      get (nameset, name, i) 

+   PER

+END PROC erase; 

+ 

+THESAURUS OP ALL (PLOTTER CONST plotter id): 

+   REP

+      forget (ds);

+      ds := nilspace;

+      msg := ds;

+      msg.tname   := id name (plotter id);

+      msg.user id := "";

+      msg.pass    := "";

+      call (plot id (plotter id), all code, ds, reply)

+   UNTIL reply = ack PER;

+   BOUND THESAURUS VAR result ds :: ds;

+   THESAURUS VAR result :: result ds;

+   forget (ds);

+   result 

+END OP ALL;

+

+PROC list (FILE VAR f,PLOTTER CONST plotter id): 

+      REP

+         forget (ds); 

+         ds := nilspace; 

+         msg := ds;

+         msg.tname   := id name (plotter id); 

+         msg.user id := "";

+         msg.pass    := "";

+         call (plot id (plotter id), list code, ds, reply) 

+      UNTIL reply = ack PER; 

+      f := sequential file (modify, ds)

+END PROC list; 

+

+PROC list (PLOTTER CONST plotter id): 

+   FILE VAR list file; 

+   list (list file, plotter id); 

+   show (list file) 

+END PROC list;

+ 

+THESAURUS PROC picfiles: 

+   all myself picfiles := empty thesaurus; 

+   do (PROC (TEXT CONST) insert if picfile,ALL myself); 

+   all myself picfiles 

+END PROC picfiles; 

+ 

+PROC insert if picfile (TEXT CONST filename): 

+   IF type (old (filename)) = picfiletype 

+      THEN insert (all myself picfiles,filename) 

+   FI 

+END PROC insert if picfile; 

+ 

+PROC generate plot manager: 

+   TASK VAR plot manager; 

+   IF exists (initfile) 

+      THEN generate in background 

+      ELSE errorstop ("""" + init file + """ existiert nicht") 

+   FI. 

+ 

+   generate in background: 

+      begin (plot manager name,PROC init plot manager, plot manager); 

+      INT VAR manager call; 

+      DATASPACE VAR initspace; 

+      TASK VAR order task; 

+      REP 

+         wait (initspace, manager call, order task) 

+      UNTIL order task = plot manager PER; 

+      initspace := old (initfile); 

+      send (plot manager, ack, initspace); 

+      say ("Plot-Manager wird generiert"13""10"");

+      say ("Bitte etwas Geduld..."13""10"");

+      REP

+         wait (initspace, manager call, order task)

+      UNTIL order task = plot manager PER;

+      forget (initspace);

+      say ("Plotmanager generiert !"13""10"") 

+END PROC generate plot manager; 

+ 

+PROC init plot manager: 

+   DATASPACE VAR initspace :: nilspace; 

+   INT VAR dummy; 

+   call (father, fetch code, initspace, dummy); 

+   copy (init space,init file);

+   insert (init file); 

+   send (father,ack,initspace);

+   do ("plot manager");

+END PROC init plot manager;

+ 

+TASK PROC plot id (PLOTTER CONST plotter id):

+   IF plotter id = no plotter

+      THEN task (plot manager name) 

+      ELSE station (plotter id)/plot manager name

+   FI

+END PROC plot id;

+ 

+TEXT PROC id name (PLOTTER CONST plotter id):

+   text (station (plotter id)) + "/" + text (channel (plotter id)) + "/" + 

+   name (plotter id)

+END PROC id name;

+

+END PACKET plot interface; 

+

+(************************* Plot Picture / Picfile *************************)

+

+PACKET plot DEFINES plot : 

+

+LET draw key      = 1,

+    move key      = 2,

+    text key      = 3,

+    move r key    = 4,

+    draw r key    = 5,

+    move cm key   = 6, 

+    draw cm key   = 7,

+    move cm r key = 8,

+    draw cm r key = 9,

+    bar key       = 10,

+    circle key    = 11;

+

+LET postfix = ".PICFILE"

+

+INT VAR read pos; 

+ 

+PROC plot (TEXT CONST name) :

+  PICFILE VAR p :: old (name);

+  IF channel <> channel (plotter) OR station (myself) <> station (plotter)

+     THEN save (name, plotter) 

+     ELSE plot (p)

+  FI

+END PROC plot;

+

+PROC plot (PICFILE VAR p) :

+  IF channel <> channel (plotter) OR station(myself) <> station(plotter)

+     THEN save (p, name (myself) + "." + text (highest entry (ALL plotter))

+                   + postfix, plotter)

+     ELSE direct plot

+  FI. 

+ 

+  direct plot: 

+    ROW 3 ROW 2 REAL VAR sizes; 

+    ROW 2 ROW 2 REAL VAR limits; 

+    ROW 4 REAL VAR angles; 

+    ROW 2 REAL VAR obliques; 

+    ROW 3 REAL VAR perspectives; 

+    get values (p,sizes,limits,angles,obliques,perspectives); 

+    set values (sizes,limits,angles,obliques,perspectives);

+    begin plot;

+    clear;

+    INT VAR i;

+    FOR i FROM 1 UPTO pictures (p)

+    REP PICTURE VAR act pic :: nilpicture;

+        to pic (p,i);

+        read picture (p,act pic);

+        IF pen (act pic) <> 0

+           THEN plot pic FI

+    PER;

+    end plot  .

+ 

+  plot pic:

+    INT VAR colour, thickness, linetype; 

+    BOOL VAR  hidden; 

+    selected pen (p,pen (act pic),colour,thickness,linetype,hidden); 

+    pen (background (p),colour,thickness,linetype); 

+    hidden lines (hidden);

+    plot (act pic).

+ 

+END PROC plot;

+

+PROC plot (PICTURE CONST p) :

+  IF channel <> channel (plotter) OR station (myself) <> station (plotter)

+     THEN errorstop ("PICTURES koennen nur direkt ausgegeben werden")

+     ELSE plot pic

+  FI.

+

+plot pic:

+  INT CONST pic length :: length (p);

+  TEXT CONST points :: subtext (text(p),5); 

+  read pos := 0;

+  IF dim (p) = 2

+  THEN plot two dim pic

+  ELSE plot three dim pic FI  .

+

+plot two dim pic:

+  WHILE read pos < pic length

+  REP plot two dim position PER  .

+

+plot two dim position :

+  read pos INCR 1;

+  SELECT code (points SUB read pos) OF

+  CASE draw key : draw (next real, next real)

+  CASE move key : move (next real, next real)

+  CASE move r key : move r (next real, next real)

+  CASE draw r key : draw r (next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+plot three dim pic:

+  WHILE read pos < pic length

+  REP plot three dim position PER  .

+

+plot three dim position :

+  read pos INCR 1;

+  SELECT code (points SUB read pos) OF

+  CASE draw key : draw (next real, next real, next real)

+  CASE move key : move (next real, next real, next real)

+  CASE move r key : move r (next real, next real, next real)

+  CASE draw r key : draw r (next real, next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+next real :

+  read pos INCR 8;

+  subtext (points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (points, read pos-1, read pos) ISUB 1  .

+

+next text :

+  INT CONST text length :: next int;

+  read pos INCR text length;

+  subtext (points, read pos-text length+1, read pos)  .

+ 

+END PROC plot;

+

+END PACKET plot

diff --git a/app/mpg/1987/src/GRAPHIK.Turtle b/app/mpg/1987/src/GRAPHIK.Turtle
new file mode 100644
index 0000000..7dcfff1
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.Turtle
@@ -0,0 +1,138 @@
+(**************************************************************************) 

+(*                                                                        *) 

+(*                        MPG - Graphik - System                          *) 

+(*                                                                        *) 

+(*                      Version 2.1 vom 10.09.1987                        *) 

+(*                                                                        *) 

+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 

+(*                unter Verwendung der Standard-Graphik                   *) 

+(*            "Turtle-Graphik" geschrieben von B.Jegerlehner              *) 

+(*                                                                        *) 

+(**************************************************************************) 

+(*                                                                        *) 

+(*               Dieses Paket stellt eine LOGO-aehnliche                  *)

+(*                'Schildkroetengraphik' zur Verfuegung                   *)

+(*                                                                        *) 

+(**************************************************************************) 

+PACKET turtle graphics DEFINES begin turtle, 

+                               end   turtle, 

+                               forward     ,

+                               forward to  , 

+                               turn        , 

+                               turn to     , 

+                               pen up      , 

+                               pen down    ,

+                               pen         ,

+                               angle       ,

+                               get turtle  :

+ 

+REAL VAR x pos, 

+         y pos, 

+         winkel; 

+ 

+PICFILE VAR bild; 

+PICTURE VAR pic; 

+ 

+BOOL VAR direct, 

+         pen status;

+ 

+PROC begin turtle: 

+  direct := TRUE; 

+  x pos  := 0.0; 

+  y pos  := 0.0; 

+  winkel  := 0.0; 

+  begin plot;

+  clear;

+  viewport (0.0, 1.0, 0.0, 1.0);

+  window (-500.0, 500.0, -500.0, 500.0); 

+  pen up; 

+  forward to (0.0, 0.0) 

+END PROC begin turtle; 

+ 

+PROC begin turtle (TEXT CONST picfile): 

+  direct := FALSE; 

+  bild := picture file (picfile); 

+  pic  := nilpicture; 

+  x pos := 0.0; 

+  y pos := 0.0; 

+  winkel := 0.0; 

+  pen up; 

+  forward to (0.0,0.0) 

+END PROC begin turtle; 

+ 

+PROC end turtle: 

+  IF direct 

+    THEN end plot 

+    ELSE ausgabe 

+  FI. 

+ 

+  ausgabe: 

+    REAL VAR x cm,y cm; 

+    INT VAR dummy; 

+    put picture (bild,pic); 

+    drawing area (x cm,y cm,dummy,dummy); 

+    viewport (bild, 0.0, 1.0, 0.0, 1.0); 

+    window (bild, -500.0,500.0,-500.0,500.0); 

+    plot(bild) 

+END PROC end turtle; 

+ 

+PROC turn (REAL CONST w): 

+  winkel := (winkel + w) MOD 360.0 

+END PROC turn; 

+ 

+PROC turn to (REAL CONST w): 

+  winkel := w MOD 360.0

+END PROC turn to; 

+ 

+REAL PROC angle: 

+  winkel 

+END PROC angle; 

+

+PROC forward (REAL CONST len): 

+  forward to (x pos + cosd (winkel) * len, 

+      y pos + sind (winkel) * len) 

+END PROC forward; 

+ 

+PROC pen up: 

+  pen status := FALSE 

+END PROC pen up; 

+ 

+PROC pen down: 

+  pen status := TRUE 

+END PROC pen down; 

+ 

+BOOL PROC pen:

+  pen status 

+END PROC pen; 

+

+PROC forward to (REAL CONST x,y): 

+  IF direct 

+    THEN dir plot 

+    ELSE pic plot 

+  FI; 

+  x pos := x; 

+  y pos := y. 

+ 

+  dir plot: 

+    IF pen status

+      THEN draw (x,y) 

+      ELSE move (x,y) 

+    FI. 

+ 

+  pic plot: 

+    IF length (pic) > 1923 

+      THEN put picture (bild,pic); 

+           pic := nilpicture 

+    FI; 

+    IF pen status

+      THEN draw (pic,x,y) 

+      ELSE move (pic,x,y) 

+    FI 

+END PROC forward to;

+

+PROC get turtle (REAL VAR x,y): 

+  x := x pos;

+  y := y pos

+END PROC get turtle

+ 

+END PACKET turtle graphics

diff --git a/app/mpg/1987/src/GRAPHIK.list b/app/mpg/1987/src/GRAPHIK.list
new file mode 100644
index 0000000..0ee6612
--- /dev/null
+++ b/app/mpg/1987/src/GRAPHIK.list
@@ -0,0 +1,22 @@
+GRAPHIK.list 

+GRAPHIK.Install 

+GRAPHIK.Basis 

+GRAPHIK.Configurator 

+GRAPHIK.Plot 

+GRAPHIK.Manager 

+GRAPHIK.Fkt 

+GRAPHIK.Turtle 

+ZEICHENSATZ 

+FKT.help 

+Muster 

+std primitives 

+matrix printer 

+terminal plot

+DATAGRAPH 3.GCONF 

+VIDEOSTAR 7.GCONF 

+AMPEX 1-2/4-6.GCONF 

+NEC P-3 15.GCONF 

+WATANABE 9.GCONF 

+VC 404 8.GCONF 

+NEC P-9 HD.GCONF 

+NEC P-9 MD.GCONF

diff --git a/app/mpg/1987/src/HRZPLOT.ELA b/app/mpg/1987/src/HRZPLOT.ELA
new file mode 100644
index 0000000..b788187
--- /dev/null
+++ b/app/mpg/1987/src/HRZPLOT.ELA
@@ -0,0 +1,150 @@
+PACKET hrz plot DEFINES drawing area,               {Autor: H. Indenbirken}

+                        begin plot,                 {Stand: 16.01.85      }

+                        end plot, 

+                        clear, 

+                        pen,

+                        move, 

+                        draw:

+ 

+LET delete = 0,                         {Farbcodes}

+    std    = 1,

+    red    = 2,

+    green  = 3,

+    blue   = 4,

+    black  = 5,

+    white  = 6,

+

+    nothing          = 0;               {Linientypen}

+

+LET POS = STRUCT (INT x, y);

+

+FILE VAR tr;

+TEXT VAR dummy;

+INT VAR act thick :: 0, i;

+POS VAR pos :: POS : (0, 0);

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 39.1;    y cm    := 27.6; 

+   x pixel := 3910;    y pixel := 2760

+END PROC drawing area;

+

+PROC begin plot : 

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+ENDPROC end plot ;

+

+PROC clear :

+  IF exists ("Plotter")

+  THEN put line (tr, "NEXT 1;")

+  ELSE init tr file FI;

+

+  pos := POS : (0, 0);

+  act thick := 0  .

+

+init tr file:

+  tr := sequential file (output, "Plotter");

+  put line (tr, "#XBA,BEN=7800017 0029 UHRZS012 Graphik#.");

+  put line (tr, "ECCO  ");

+  put line (tr, "#ANFANG,GRAFIK");

+  put line (tr, "#ZEICHNE,PL(1,9),MOD.=ZCH123,DINAF.=3.2,AUSS.=0'0'4200'2970,STIFTE=1'2'3'4'5'6,DATEI=/");

+  put line (tr, "CLEAR;BOX;")  .

+

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  set foreground;

+  set thickness  .

+

+set foreground:

+  put line (tr, "PEN " + text (foreground) + ";")  .

+ 

+set thickness:

+  act thick := thickness * 2  .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  put (tr, text (x) + "!" + text (y) + ";"); 

+  pos := POS  : (x, y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF act thick <> 0

+  THEN IF horizontal line

+       THEN thick y

+       ELSE thick x FI;

+       x MOVE y

+  ELSE put (tr, text (x) + "&" + text (y) + ";") FI;

+  pos := POS : (x, y)   .

+

+horizontal line:

+  abs (pos.x-x) > abs (pos.y-y)  .

+

+thick y:

+  INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;

+  old x MOVE pos.y;

+  new x DRAW     y;

+  FOR dy FROM 1 UPTO act thick

+  REP old x MOVE pos.y+dy;

+      new x DRAW     y+dy;

+      old x MOVE pos.y-dy;

+      new x DRAW y-dy;

+  PER  . 

+

+x ausgleich:

+  IF pos.x <= x

+  THEN  act thick

+  ELSE -act thick FI  .

+

+thick x:

+  INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;

+  pos.x MOVE old y;

+      x DRAW new y; 

+  FOR dx FROM 1 UPTO act thick

+  REP pos.x+dx MOVE old y;

+          x+dx DRAW new y;

+      pos.x-dx MOVE old y;

+          x-dx DRAW new y;

+  PER  . 

+

+y ausgleich:

+  IF pos.y <= y

+  THEN  act thick

+  ELSE -act thick FI  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+  put (tr, height symbol + angle symbol + " SYMB """ + double record + """;")  .

+

+height symbol:

+  IF height = 0.0

+  THEN ""

+  ELSE "H" + text (height) FI  .

+

+angle symbol:

+  IF angle = 0.0

+  THEN ""

+  ELSE "A" + text (angle) FI  .

+

+double record:

+  dummy := record;

+  change all (dummy, """", """""");

+  dummy  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+OP MOVE (INT CONST x, y):

+  put (tr, text (x) + "!" + text (y) + ";") 

+END OP MOVE;

+

+OP DRAW (INT CONST x, y):

+  put (tr, text (x) + "&" + text (y) + ";")

+END OP DRAW;

+

+END PACKET hrz plot

diff --git a/app/mpg/1987/src/INCRPLOT.ELA b/app/mpg/1987/src/INCRPLOT.ELA
new file mode 100644
index 0000000..72d46dc
--- /dev/null
+++ b/app/mpg/1987/src/INCRPLOT.ELA
@@ -0,0 +1,405 @@
+PACKET incremental plot DEFINES drawing area,       { Autor: H. Indenbirken }

+                                begin plot,         { Stand: 07.09.84       }

+                                end plot, 

+                                clear, 

+                                pen,

+                                move, 

+                                draw, 

+                                get cursor,

+

+                                zeichensatz,

+                                reset:

+ 

+LET max x        = 511,             {***** Bildschirm : 0-511 x 0-255*****}

+    max x plus 1 = 512,

+    max y        = 255,

+ 

+    hor faktor   = 22.21739,        {***** x pixel / x cm *****}

+    vert faktor  = 18.61314,        {***** y pixel / y cm *****}

+

+

+    delete = 0,                         {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    nothing          = 0,               {Linientypen}

+    durchgehend      = 1, 

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5,

+

+    pen up           = "U",

+    pen down         = "D",

+    up               = "8",                 {Richtungen}

+    up right         = "9",

+    right            = "6",

+    down right       = "3",

+    down             = "2",

+    down left        = "1",

+    left             = "4",

+    up left          = "7";

+

+LET PEN = STRUCT (INT back, fore, thick, line, BOOL hidden);

+LET POS = STRUCT (INT x, y);

+LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height);

+

+ROW max x plus 1 INT VAR akt maxima, last maxima;

+ZEICHENSATZ VAR zeichen;

+PEN VAR stift :: PEN : (black, white, 0, durchgehend, FALSE);

+POS VAR pos :: POS : (0, 0), start, end;

+TEXT VAR point :: "";

+INT VAR i, n, diff, up right error, right error, old error, from, to,

+        pattern pos :: 0, line pattern :: -1;

+BOOL VAR bit set :: TRUE;

+

+reset;

+zeichensatz ("STD Zeichensatz");

+

+PROC reset:

+  FOR i FROM 1 UPTO 512

+  REP last maxima [i] := -1;

+      akt maxima [i] := -1

+  PER

+END PROC reset;

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);

+       zeichen := new zeichen;

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm := 23.0;    y cm := 13.7;   {***** Horizontale und vertikale *****}

+                                    {***** Größe in Zentimetern.     *****}

+   x pixel := 511;  y pixel := 255  {***** Koordinaten des rechten   *****}

+                                    {***** oberen Punktes.           *****}

+END PROC drawing area;

+

+PROC begin plot : 

+  {***** Graphikmodus einschalten *****} 

+  out (""16"")

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+  {***** Graphikmodus ausschalten *****} 

+  out (""0"")

+ENDPROC end plot ;

+

+PROC clear :

+  stift := PEN : (black, white, 0, durchgehend, FALSE); 

+  pos := POS : (0, 0);

+  line pattern := -1;

+  pattern pos := 0;

+  point := "";

+ 

+  reset;

+  {***** neue Zeichenfläche *****}

+  out ("P")

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  set background;

+  set foreground;

+  set thickness;

+  set linetype;

+  stift := PEN:(background, foreground, thickness, linetype, thickness<0)  .

+

+set background:

+  {***** Hintergrundfarbe setzen *****}  .

+

+set foreground:

+  {***** Stift auswählen *****}  .

+ 

+set thickness:

+  {***** Es wird ein breiterer Sift simuliert, indem jeder Punkt    *****}

+  {***** dicker gezeichet wird. Mit 'stift.thick' wird angegeben,   *****}

+  {***** aus wieviel Pixeln ein Punkt bestehen soll. In 'point'     *****};

+  {***** stehen die Befehle, um einen dicken Punkt zu zeichnen.     *****}

+  point := "";

+  i := 2;

+  WHILE i <= thickness

+  REP point CAT down left;

+      point CAT (i * right);

+      point CAT (i * up);

+      point CAT (i * left);

+      point CAT (i * down);

+      i INCR 2

+  PER;

+  point CAT (thickness DIV 2) * up right  .

+

+set linetype:

+  {***** Falls das Endgerät hardwaremäßig verschieden Linientypen   *****}

+  {***** besitzt, können diese hier angesteuert werden. Ansonsten   *****}

+  {***** werden sie softwaremäßig simuliert.                        *****}

+  pattern pos := 0;

+  SELECT linetype OF

+  CASE durchgehend      : line pattern := -1

+  CASE gepunktet        : line pattern := 21845

+  CASE kurz gestrichelt : line pattern := 3855

+  CASE lang gestrichelt : line pattern := 255

+  CASE strichpunkt      : line pattern := 4351

+  OTHERWISE line pattern := linetype END SELECT  .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  IF stift.hidden

+  THEN last maxima := akt maxima FI;

+

+  {***** Der Stift muss gehoben und ein Vektor zur Position (x,y)   *****}

+  {***** gezeichnet werden.                                         *****} 

+  out (pen up);

+  IF right to left

+  THEN (x-pos.x) TIMESOUT right;

+       IF down to up

+       THEN (y-pos.y) TIMESOUT up

+       ELSE (pos.y-y) TIMESOUT down FI

+  ELSE (pos.x-x) TIMESOUT left;

+       IF down to up

+       THEN (y-pos.y) TIMESOUT up

+       ELSE (pos.y-y) TIMESOUT down FI 

+  FI;

+

+  pos := POS  : (x, y)  .

+

+right to left: x > pos.x  .

+down to up: y > pos.y  .

+

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  {***** Der Stift muss gehoben und ein Vektor zur Position (x,y)   *****}

+  {***** gezeichnet werden.                                         *****}

+  vector (x-pos.x, y-pos.y);

+  pos := POS : (x, y)   .

+

+END PROC draw;

+ 

+PROC vector (INT CONST dx , dy) :

+  IF dx >= 0

+  THEN IF   dy >  dx THEN vector (pos.y, pos.x, dy, dx, 1, 1, up, up right)

+       ELIF dy >   0 THEN vector (pos.x, pos.y, dx, dy, 1, 1, right, up right)

+ 

+       ELIF dy > -dx THEN vector (pos.x, pos.y, dx,-dy, 1,-1, right, down right)

+       ELSE               vector (pos.y, pos.x,-dy, dx,-1, 1, down, down right) FI

+

+  ELSE IF   dy > -dx THEN vector (pos.y, pos.x, dy,-dx, 1,-1, up, up left)

+       ELIF dy >   0 THEN vector (pos.x, pos.y,-dx, dy,-1, 1, left, up left)

+ 

+       ELIF dy >  dx THEN vector (pos.x, pos.y,-dx,-dy,-1,-1, left, down left)

+       ELSE               vector (pos.y, pos.x,-dy,-dx,-1,-1, down, down left) FI

+  FI .

+ 

+ENDPROC vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, x step, y step,

+             TEXT CONST step right, step up) :

+  prepare first step ;

+  FOR i FROM 1 UPTO dx

+  REP do one step PER  .

+

+prepare first step :

+  up right error := dy - dx;

+  right error := dy;

+  old error := 0;

+  IF visible (pos)

+  THEN out (pen down);

+       out (point)

+  ELSE out (pen up) FI  .

+

+do one step:

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error)  .

+ 

+do upright step :

+  x pos INCR x step;

+  y pos INCR y step;

+  check point;

+  out (step up);

+  out (point);

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR x step;

+  check point;

+  out (step right);

+  out (point);

+  old error INCR right error .

+ 

+check point :

+  { In Abhängigkeit vom Ergebnis der Prozedur 'visible' wird der    *****}

+  { Stift gehoben oder gesenkt.                                     *****}

+

+  IF visible (pos)

+  THEN out (pen down)

+  ELSE out (pen up) FI  .

+

+END PROC vector;

+ 

+BOOL PROC visible (POS CONST pos) :

+  IF pos.x < 0 OR pos.x > max x OR pos.y < 0 OR pos.y > max y

+  THEN FALSE

+  ELSE pattern AND hidden FI  .

+

+pattern:

+  bit set := bit (line pattern, pattern pos);

+  pattern pos := (pattern pos+1) AND 15;

+  bit set  .

+

+hidden:

+  IF akt maxima [pos.x+1] < pos.y 

+  THEN akt maxima [pos.x+1] := pos.y FI; 

+

+  pos.y > last maxima [pos.x+1]  .

+

+END PROC visible;

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+{**** Hier werden Texte mit dem Winkel 'angle',der Höhe 'height' und *****}

+{**** der Breite 'width' gezeichnet. Falls die Hardware dieses       *****}

+{**** bereits ermöglicht, so müssen die Variable 'zeichen' und die   *****}

+{**** Prozedur Zeichensatz gelöscht werden. Der Datenraum            *****}

+{**** 'STD Zeichensatz' wird in diesem Fall nicht benötigt.          *****}

+  BOOL CONST horizontal :: NOT (abs (angle) MOD 180.0 > 45.0 AND abs (angle) MOD 180.0 < 135.0);

+  INT CONST x fak :: character width, x step :: character x step,

+            y fak :: character height, y step :: character y step;

+  INT VAR x pos :: pos.x, y pos :: pos.y, i;

+  from := pos;

+ 

+  FOR i FROM 1 UPTO length (record)

+  REP draw character i PER;

+  move (from) .

+

+character width:

+  IF width <> 0.0

+  THEN int (hor faktor * width+0.5)

+  ELSE zeichen.width FI  .

+

+character x step:

+  IF horizontal

+  THEN IF width <> 0.0

+       THEN int (cosd (angle) * hor faktor * width+0.5)

+       ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI

+  ELSE IF width <> 0.0

+       THEN int (cosd (angle) * vert faktor * width+0.5)

+       ELSE int (cosd (angle) * real (zeichen.height)+0.5) FI 

+  FI  .

+

+character height:

+  IF height <> 0.0

+  THEN int (vert faktor * height+0.5)

+  ELSE zeichen.height FI  .

+

+character y step:

+  IF horizontal

+  THEN IF height <> 0.0

+       THEN int (sind (angle) * vert faktor * height+0.5)

+       ELSE int (sind (angle) * real (zeichen.height)+0.5) FI 

+  ELSE IF height <> 0.0

+       THEN int (sind (angle) * hor faktor * height+0.5)

+       ELSE int (sind (angle) * real (zeichen.width)+0.5) FI 

+  FI  .

+

+draw character i:

+  IF code (record SUB i) < 32

+  THEN steuerzeichen

+  ELSE normale zeichen FI  .

+

+steuerzeichen:

+  SELECT code (record SUB i) OF

+  CASE  7: out (""0""7""16"")

+  CASE 13: x pos := pos.x;  y pos := pos.y

+  END SELECT  .

+

+normale zeichen:

+  TEXT CONST char :: zeichen.char [code (record SUB i)];

+  IF horizontal

+  THEN draw horizontal

+  ELSE draw vertical FI  .

+

+draw vertical:

+  n := 3;

+  IF char <> ""

+  THEN move (((char ISUB 2)*y fak) DIV zeichen.height + x pos,

+            -((char ISUB 1)*x fak) DIV zeichen.width + y pos)

+  FI;

+  WHILE n <= length (char) DIV 2

+  REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0

+      THEN move (((char ISUB n+1)*y fak) DIV zeichen.height + x pos,

+                -((char ISUB n  )*x fak) DIV zeichen.width + y pos) 

+      ELSE draw (-((char ISUB n+1)*y fak) DIV zeichen.height + x pos,

+                  ((char ISUB n  )*x fak) DIV zeichen.width + y pos)

+      FI;

+      n INCR 2

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+draw horizontal:

+  n := 3;

+  IF char <> ""

+  THEN move (-((char ISUB 1)*x fak) DIV zeichen.width + x pos,

+             -((char ISUB 2)*y fak) DIV zeichen.height + y pos)

+  FI;

+  WHILE n <= length (char) DIV 2

+  REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0

+      THEN move (-((char ISUB n  )*x fak) DIV  zeichen.width + x pos,

+                 -((char ISUB n+1)*y fak) DIV zeichen.height + y pos)

+      ELSE draw (((char ISUB n  )*x fak) DIV zeichen.width + x pos,

+                 ((char ISUB n+1)*y fak) DIV zeichen.height + y pos)

+      FI;

+      n INCR 2

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  x := pos.x;

+  y := pos.y;

+  cursor on;

+  REP inchar (t);

+      SELECT code (t) OF

+      CASE 54: x INCR 1;            out (right)      {normaler Zehnerblock} 

+      CASE 57: x INCR 1; y INCR 1;  out (up right)

+      CASE 56: y INCR 1;            out (up)

+      CASE 55: x DECR 1; y INCR 1;  out (up left)

+      CASE 52: x DECR 1;            out (left)

+      CASE 49: x DECR 1; y DECR 1;  out (down left)

+      CASE 50: y DECR 1;            out (down)

+      CASE 51: x INCR 1; y DECR 1;  out (down right)

+      OTHERWISE leave get cursor ENDSELECT;

+  PER  .

+

+cursor on:

+  {***** Der Graphische Cursor muss eingeschaltet werden *****};

+  out ("C")  .

+

+cursor off:

+  {***** Der Graphische Cursor muss eingeschaltet werden *****};

+  out ("c")  .

+

+leave get cursor:

+  cursor off;

+  out (pen up);

+  (x-pos.x) TIMESOUT left;

+  (y-pos.y) TIMESOUT right;

+

+  LEAVE get cursor  .

+

+END PROC get cursor;

+

+END PACKET incremental plot;

diff --git a/app/mpg/1987/src/M20PLOT.ELA b/app/mpg/1987/src/M20PLOT.ELA
new file mode 100644
index 0000000..7eb4a81
--- /dev/null
+++ b/app/mpg/1987/src/M20PLOT.ELA
@@ -0,0 +1,419 @@
+PACKET m20 plot DEFINES drawing area,             (*Autor: H. Indenbirken*)

+                        begin plot,               (*Stand: 18.11.84      *)

+                        end plot, 

+                        clear, 

+                        pen,

+                        move, 

+                        draw, 

+

+                        cursor on, cursor off,

+                        get cursor,

+

+                        zeichensatz,

+                        get screen, put screen: 

+ 

+LET hor faktor   = 22.21739,                 (****** x pixel / x cm ******)

+    vert faktor  = 18.61314,                 (****** y pixel / y cm ******)

+

+    delete = 0,                                              (*Farbcodes *)

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    nothing          = 0,                                  (*Linientypen *)

+    durchgehend      = 1, 

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5,

+

+    bit 14           = 16384;

+

+TYPE SCREEN = ROW 32 ROW 256 INT;

+LET POS = STRUCT (INT x, y);

+LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height);

+

+ZEICHENSATZ VAR zeichen;

+BOOL VAR character defined :: FALSE;

+TEXT VAR act pen :: "P"1"L"255""255"",

+         cursor pos  :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"M"0""0""0""0""0"D"0""0""0""0"", 

+         cursor line :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"D"0""0""0""0"";

+INT VAR act thick :: 0, i;

+POS VAR pos :: POS : (0, 0);

+out (""16"" + act pen + ""9"");

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)                                     (* Höhe:   0.64 cm*)

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);(* Breite: 0.40 cm*)

+       zeichen := new zeichen;

+       character defined := TRUE

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 22.0;    y cm    := 13.7; 

+   x pixel := 511;     y pixel := 255 

+END PROC drawing area;

+

+PROC begin plot : 

+  out (""9""16"");

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+  out (""9"");

+ENDPROC end plot ;

+

+PROC clear :

+  pos := POS : (0, 0);

+  act thick := 0;

+  act pen := "P"1"L"255""255"";

+  out ("CP"1"L"255""255"M"0""0""0""0"")

+

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  set foreground;

+  set thickness;

+  set linetype;

+  out (act pen)  .

+

+set foreground:

+  IF foreground = delete

+  THEN act pen := "P"0""

+  ELIF foreground < 0

+  THEN act pen := "P"2""

+  ELSE act pen := "P"1"" FI  .

+ 

+set thickness:

+  act thick := thickness  .

+

+set linetype:

+  SELECT linetype OF

+  CASE nothing          : act pen CAT "L"0""0""

+  CASE durchgehend      : act pen CAT "L"255""255""

+  CASE gepunktet        : act pen CAT "L"85""85""

+  CASE kurz gestrichelt : act pen CAT "L"15""15""

+  CASE lang gestrichelt : act pen CAT "L"255""0""

+  CASE strichpunkt      : act pen CAT "L"255""16""

+  OTHERWISE act pen CAT "L" + intern (linetype) END SELECT  .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  replace (vektor, 1, x);

+  replace (vektor, 2, y);

+

+  out ("M");

+  out (vektor); 

+  pos := POS  : (x, y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF act thick <> 0

+  THEN IF horizontal line

+       THEN thick y

+       ELSE thick x FI;

+       x MOVE y

+  ELSE replace (vektor, 1, x);

+       replace (vektor, 2, y);

+       out ("D");

+       out (vektor)

+  FI;

+  pos := POS : (x, y)   .

+

+horizontal line:

+  abs (pos.x-x) > abs (pos.y-y)  .

+

+thick y:

+  INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;

+  old x MOVE pos.y;

+  new x DRAW     y;

+  FOR dy FROM 1 UPTO act thick

+  REP old x MOVE pos.y+dy;

+      new x DRAW     y+dy;

+      old x MOVE pos.y-dy;

+      new x DRAW y-dy;

+  PER  . 

+

+x ausgleich:

+  IF pos.x <= x

+  THEN  act thick

+  ELSE -act thick FI  .

+

+thick x:

+  INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;

+  pos.x MOVE old y;

+      x DRAW new y; 

+  FOR dx FROM 1 UPTO act thick

+  REP pos.x+dx MOVE old y;

+          x+dx DRAW new y;

+      pos.x-dx MOVE old y;

+          x-dx DRAW new y;

+  PER  . 

+

+y ausgleich:

+  IF pos.y <= y

+  THEN  act thick

+  ELSE -act thick FI  .

+

+END PROC draw;

+

+INT VAR x fak :: zeichen.width,

+        y fak :: zeichen.height;

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+  IF act pen = "L"0""0""

+  THEN

+  ELIF character defined

+  THEN draw graphic character

+  ELSE out (""9"");

+       pos cursor (pos.x, pos.y);

+       get cursor (x pos, y pos);

+       outsubtext (record, 1, 79-y pos); 

+       out (""16"")

+  FI  .

+

+draw graphic character:

+(**** Hier werden Texte mit dem Winkel 'angle',der Höhe 'height' und ****)

+(**** der Breite 'width' gezeichnet. Die Form der Zeichen ist in der ****)

+(**** Datei 'STD Zeichensatz' enthalten.                             ****)

+  INT CONST x step :: character x step, y step :: character y step;

+  INT VAR x pos :: pos.x, y pos :: pos.y, i, n, x, y;

+  BOOL VAR move order;

+ 

+  set character height and width;

+  out ("L"255""255"");

+

+  FOR i FROM 1 UPTO length (record)

+  REP draw character i PER;

+  out (act pen);

+  pos.x MOVE pos.y .

+

+set character height and width:

+  IF width = 0.0 AND height = 0.0

+  THEN x fak := zeichen.width;

+       y fak := zeichen.height

+  ELSE x fak := int (hor faktor * width+0.5);

+       y fak := int (vert faktor * height+0.5)

+  FI  .

+

+character x step:

+  IF width <> 0.0

+  THEN int (cosd (angle) * hor faktor * width+0.5)

+  ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI  .

+

+character y step:

+  IF height <> 0.0

+  THEN int (sind (angle) * vert faktor * height+0.5)

+  ELSE int (sind (angle) * real (zeichen.height)+0.5) FI  .

+

+draw character i:

+  IF code (record SUB i) < 32

+  THEN steuerzeichen

+  ELSE normale zeichen FI  .

+

+steuerzeichen:

+  SELECT code (record SUB i) OF

+  CASE  1: x pos := 0;

+           y pos := 255-y fak

+  CASE  2: x pos INCR x fak 

+  CASE  3: y pos INCR y fak 

+  CASE  4: out (""9""); pos cursor (x pos, y pos); out (""4""16"")

+  CASE  5: out (""9""); pos cursor (x pos, y pos); out (""5""16"")

+  CASE  7: out (""9""7""16"")

+  CASE  8: x pos DECR x fak 

+  CASE 10: y pos DECR y fak 

+  CASE 13: x pos := pos.x

+  END SELECT  .

+

+normale zeichen:

+  TEXT CONST char :: zeichen.char [code (record SUB i)];

+  FOR n FROM 1 UPTO length (char) DIV 4

+  REP value (char, n, x, y, move order);

+      IF move order

+      THEN x pos+x MOVE y pos+y

+      ELSE x pos+x DRAW y pos+y FI

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC value (TEXT CONST char, INT CONST n, INT VAR x, y, BOOL VAR move):

+  x := char ISUB n+n-1;

+  y := char ISUB n+n;

+  IF x < 0

+  THEN IF (x AND bit 14) <> 0

+       THEN move := FALSE

+       ELSE move := TRUE;

+            x := x XOR bit 14

+       FI

+  ELSE IF (x AND bit 14) <> 0

+       THEN move := TRUE;

+            x := x XOR bit 14

+       ELSE move := FALSE FI

+  FI;

+  x := (x*x fak) DIV zeichen.width;

+  y := (y*y fak) DIV zeichen.height

+

+END PROC value;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  get cursor (t, x, y, -1, -1, -1, -1)

+END PROC get cursor;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1):

+  init cursor;

+  out ("P"2""); 

+  REP set cursor;

+      get step;

+      out (cursor pos);

+      out (cursor line);

+      move cursor

+  PER  .

+

+init cursor:

+  INT VAR delta :: 1;

+  x := pos.x;

+  y := pos.y;

+

+  IF x0 >= 0 AND x0 <= 511 AND y0 >= 0 AND y0 <= 255

+  THEN replace (cursor line, 2, "M");

+       replace (cursor line, 2, x0);

+       replace (cursor line, 3, y0);

+       replace (cursor line, 8, "D")

+  ELSE replace (cursor line, 2, ""0""0""0""0""0""0"M") FI; 

+

+  IF x1 >= 0 AND x1 <= 511 AND y1 >= 0 AND y1 <= 255

+  THEN replace (cursor line,14, "D");

+       replace (cursor line, 8, x1);

+       replace (cursor line, 9, y1);

+  ELSE replace (cursor line,14, ""0""0""0""0""0"") FI  .

+

+get step:

+  t := incharety (1);

+  IF t <> ""

+  THEN IF delta < 10

+       THEN delta INCR delta

+       ELSE delta INCR 1 FI

+  ELSE delta := 1;

+       inchar (t)

+  FI  .

+

+move cursor:

+  SELECT code (t) OF

+  CASE 2 : x INCR delta                            (*normaler Zehnerblock*) 

+  CASE 19: x INCR delta; y INCR delta

+  CASE 3 : y INCR delta

+  CASE 18: x DECR delta; y INCR delta

+  CASE 8 : x DECR delta

+  CASE 14: x DECR delta; y DECR delta

+  CASE 10: y DECR delta

+  CASE 15: x INCR delta; y DECR delta

+  OTHERWISE leave get cursor ENDSELECT;

+  check  .

+

+set cursor:

+  replace (cursor pos, 2, x-4); replace (cursor pos, 3, y);

+  replace (cursor pos, 5, x+4); replace (cursor pos, 6, y);

+  replace (cursor pos, 8, x);   replace (cursor pos, 9, y-4);

+  replace (cursor pos,11, x);   replace (cursor pos,12, y+4);

+  out (cursor pos);

+

+  replace (cursor line, 5, x);  replace (cursor line, 6, y);

+  out (cursor line)  .

+

+leave get cursor:

+  out (act pen);

+  pos.x MOVE pos.y;

+

+  LEAVE get cursor  .

+

+check :

+  IF x < 0

+  THEN x := 0;

+       out (""9""7""16"")

+  ELIF x > 511

+  THEN x := 511;

+       out (""9""7""16"")

+  FI; 

+  IF y < 0

+  THEN y := 0;

+       out (""9""7""16"")

+  ELIF y > 255

+  THEN y := 255;

+       out (""9""7""16"")

+  FI  .

+

+END PROC get cursor;

+

+PROC cursor on (INT CONST x, y):

+  out ("P"2""); 

+  replace (cursor pos, 2, x-4); replace (cursor pos, 3, y);

+  replace (cursor pos, 5, x+4); replace (cursor pos, 6, y);

+  replace (cursor pos, 8, x);   replace (cursor pos, 9, y-4);

+  replace (cursor pos,11, x);   replace (cursor pos,12, y+4);

+  out (cursor pos)

+

+END PROC cursor on;

+

+PROC cursor off:

+  out ("P"2"");

+  out (cursor pos);

+  out (act pen);

+  pos.x MOVE pos.y

+END PROC cursor off;

+

+(* Bildwiederholspeicheraufbau der M20:                                  *)

+(* 32 Blöcke (0...31) enthalten jeweils 8 Microzeilen. Die Bitbelegung   *)

+(* eines Blocks von 256 INT ist 7654321FEDCBA98.                         *)

+

+PROC get screen (DATASPACE VAR ds, INT CONST page):

+  INT VAR i, n, begin :: 32*page;

+  FOR i FROM 0 UPTO 31

+  REP block in (ds, begin+i, -1, i, n) PER

+END PROC get screen;

+

+PROC put screen (DATASPACE CONST ds, INT CONST page):

+  INT VAR i, n, begin :: 32*page;

+  FOR i FROM 0 UPTO 31

+  REP block out (ds, begin+i, -1, i, n) PER

+END PROC put screen;

+

+TEXT VAR conv :: ""0""0"";

+TEXT PROC intern (INT CONST n):

+   replace (conv, 1, n);

+   conv

+END PROC intern;

+

+TEXT VAR vektor :: ""0""0""0""0"";

+OP MOVE (INT CONST x, y):

+  replace (vektor, 1, x);

+  replace (vektor, 2, y);

+

+  out ("M");

+  out (vektor)

+END OP MOVE;

+

+OP DRAW (INT CONST x, y):

+  replace (vektor, 1, x);

+  replace (vektor, 2, y);

+

+  out ("D");

+  out (vektor)

+END OP DRAW;

+

+PROC pos cursor (INT CONST x, y):

+  cursor ((x-10) DIV 6, (237-y) DIV 10)

+END PROC pos cursor;

+

+END PACKET m20 plot

+

+IF exists ("ZEICHEN 6*10")

+THEN zeichensatz ("ZEICHEN 6*10")

+ELIF exists ("ZEICHEN 9*12")

+THEN zeichensatz ("ZEICHEN 9*12")

+ELSE put line ("Warnung: Zeichensatz fehlt") FI

diff --git a/app/mpg/1987/src/MTRXPLOT.ELA b/app/mpg/1987/src/MTRXPLOT.ELA
new file mode 100644
index 0000000..d7bf6f9
--- /dev/null
+++ b/app/mpg/1987/src/MTRXPLOT.ELA
@@ -0,0 +1,416 @@
+PACKET matrix plot DEFINES drawing area, 

+                        begin plot, 

+                        end plot, 

+                        clear, 

+                        pen,

+                        move, 

+                        draw, 

+                        get cursor,

+

+                        zeichensatz,

+                        reset,

+                        SCREEN, :=, 

+                        get screen, put screen:

+ 

+LET max x        = 511,                 {Bildschirm : 1-512 x 1-256}

+    max x plus 1 = 512,

+    max y        = 255,

+

+    hor faktor   = 22.21739,            {***** x pixel / x cm *****}

+    vert faktor  = 18.61314,            {***** y pixel / y cm *****}

+

+

+    delete = 0,                         {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    durchgehend      = 1,               {Linientypen}

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5;

+

+

+LET PEN = STRUCT (INT back, fore, thick, line, BOOL hidden, action);

+LET POS = STRUCT (INT x, y);

+TYPE SCREEN = ROW 32 ROW 256 INT;

+LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height);

+

+ROW max x plus 1 INT VAR akt maxima, last maxima;

+ZEICHENSATZ VAR zeichen;

+SCREEN VAR screen;

+PEN VAR stift :: PEN : (black, white, 0, durchgehend, FALSE, TRUE);

+POS VAR pos :: POS : (0, 0), start, delta;

+INT VAR i, n, diff, up right error, right error, old error,

+        pattern pos :: 0, line pattern :: -1;

+BOOL VAR bit set :: TRUE;

+ 

+reset;

+zeichensatz ("STD Zeichensatz");

+clear (screen);

+

+PROC reset:

+  FOR i FROM 1 UPTO 512

+  REP last maxima [i] := -1;

+      akt maxima [i] := -1

+  PER

+END PROC reset;

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);

+       zeichen := new zeichen

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm := 23.0;    y cm := 13.7;   {***** Horizontale und vertikale *****}

+                                    {***** Größe in Zentimetern.     *****}

+   x pixel := 511;  y pixel := 255  {***** Koordinaten des rechten   *****}

+                                    {***** oberen Punktes.           *****}

+END PROC drawing area;

+

+PROC begin plot : 

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+ENDPROC end plot ;

+

+PROC clear :

+  stift := PEN : (black, white, 0, durchgehend, FALSE, TRUE);

+  pos := POS : (0, 0);

+

+(*    Löschen der Hiddenmaxima      *);

+  reset;

+

+(*    Ausgabe der Bildmatrix auf dem Endgerät      *);

+  put screen;

+

+(*    Löschen der Bildmatrix       *);

+  clear (screen)

+

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  set linetype;

+  stift := PEN : (background, foreground,thickness, linetype,

+                  linetype <> 0, thickness < 0)  .

+

+set linetype:

+  pattern pos := 0;

+  SELECT linetype OF

+  CASE durchgehend      : stift.line := -1

+  CASE gepunktet        : stift.line := 21845

+  CASE kurz gestrichelt : stift.line := 3855

+  CASE lang gestrichelt : stift.line := 255

+  CASE strichpunkt      : stift.line := 4351

+  OTHERWISE stift.line := linetype END SELECT;

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  pattern pos := 0;

+  IF stift.hidden

+  THEN last maxima := akt maxima FI;

+ 

+  pos := POS  : (x, y) 

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF stift.action

+  THEN IF stift.thick > 1

+       THEN draw thick vektor

+       ELSE vector (x-pos.x, y-pos.y) FI

+  FI;

+  pos := POS : (x, y)   .

+

+draw thick vektor:

+  INT CONST old pattern pos := pattern pos; 

+  check direction;

+  FOR diff FROM -stift.thick UPTO stift.thick

+  REP draw single vektor PER  .

+

+check direction :

+  BOOL CONST x direction := abs (x-pos.x) > abs (y-pos.y);

+  IF x direction

+  THEN start := POS : (pos.x+stift.thick * sign (pos.x-x), pos.y); 

+       delta := POS : (x+stift.thick * sign (x-pos.x)-pos.x, y-pos.y)

+  ELSE start := POS : (pos.x, pos.y+stift.thick * sign (pos.y-y)); 

+       delta := POS : (x-pos.x, y+stift.thick * sign (y-pos.y)-pos.y); 

+  FI  .

+

+draw single vektor :

+  pattern pos := old pattern pos;

+  IF x direction

+  THEN pos := POS : (start.x, start.y+diff);

+       vector (delta.x, delta.y+diff)

+  ELSE pos := POS : (start.x+diff, start.y+diff);

+       vector (delta.x+diff, delta.y)

+  FI .

+ 

+END PROC draw;

+ 

+PROC vector (INT CONST dx , dy) :

+  IF dx >= 0

+  THEN IF   dy >  dx THEN vector (pos.y, pos.x, dy, dx, 1, 1)

+       ELIF dy >   0 THEN vector (pos.x, pos.y, dx, dy, 1, 1)

+ 

+       ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1)

+       ELSE               vector (pos.y, pos.x, -dy, dx,-1, 1) FI

+

+  ELSE IF   dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1)

+       ELIF dy >   0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1)

+ 

+       ELIF dy >  dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1)

+       ELSE               vector (pos.y, pos.x, -dy, -dx,-1,-1) FI

+  FI .

+ 

+ENDPROC vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :

+  prepare first step ;

+  point;

+  FOR i FROM 1 UPTO dx

+  REP do one step PER  .

+

+prepare first step :

+  up right error := dy - dx;

+  right error := dy;

+  old error := 0  .

+

+do one step:

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error)  .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+point :

+  IF visible (pos) 

+  THEN SELECT (pos.x+1) MOD 16 OF

+       CASE  0: set bit (block [byte],  8)

+       CASE  1: set bit (block [byte],  7)

+       CASE  2: set bit (block [byte],  6)

+       CASE  3: set bit (block [byte],  5)

+       CASE  4: set bit (block [byte],  4)

+       CASE  5: set bit (block [byte],  3)

+       CASE  6: set bit (block [byte],  2)

+       CASE  7: set bit (block [byte],  1)

+       CASE  8: set bit (block [byte],  0)

+       CASE  9: set bit (block [byte], 15)

+       CASE 10: set bit (block [byte], 14)

+       CASE 11: set bit (block [byte], 13)

+       CASE 12: set bit (block [byte], 12)

+       CASE 13: set bit (block [byte], 11)

+       CASE 14: set bit (block [byte], 10)

+       CASE 15: set bit (block [byte],  9)

+       END SELECT;

+  FI  .

+

+block:

+  screen [(255-pos.y) DIV 8 + 1]  .

+

+byte:

+  pos.x DIV 16 + ((255-pos.y) AND 7) * 32 + 1  .

+

+END PROC vector;

+ 

+BOOL PROC visible (POS CONST pos) :

+  IF pos.x < 0 OR pos.x > max x OR pos.y < 0 OR pos.y > max y

+  THEN FALSE

+  ELSE pattern AND hidden FI  .

+

+pattern:

+  bit set := bit (line pattern, pattern pos);

+  pattern pos := (pattern pos+1) AND 15;

+  bit set  .

+

+hidden:

+  IF akt maxima [pos.x+1] < pos.y 

+  THEN akt maxima [pos.x+1] := pos.y FI; 

+

+  pos.y > last maxima [pos.x+1]  .

+

+END PROC visible;

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+{**** Hier werden Texte mit dem Winkel 'angle',der Höhe 'height' und *****}

+{**** der Breite 'width' gezeichnet. Falls die Hardware dieses       *****}

+{**** bereits ermöglicht, so müssen die Variable 'zeichen' und die   *****}

+{**** Prozedur Zeichensatz gelöscht werden. Der Datenraum            *****}

+{**** 'STD Zeichensatz' wird in diesem Fall nicht benötigt.          *****}

+  BOOL CONST horizontal :: NOT (abs (angle) MOD 180.0 > 45.0 AND abs (angle) MOD 180.0 < 135.0);

+  INT CONST x fak :: character width, x step :: character x step,

+            y fak :: character height, y step :: character y step;

+  INT VAR x pos :: pos.x, y pos :: pos.y, i;

+  POS VAR old pos := pos;

+ 

+  FOR i FROM 1 UPTO length (record)

+  REP draw character i PER;

+  pos := old pos  .

+

+character width:

+  IF width <> 0.0

+  THEN int (hor faktor * width+0.5)

+  ELSE zeichen.width FI  .

+

+character x step:

+  IF horizontal

+  THEN IF width <> 0.0

+       THEN int (cosd (angle) * hor faktor * width+0.5)

+       ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI

+  ELSE IF width <> 0.0

+       THEN int (cosd (angle) * vert faktor * width+0.5)

+       ELSE int (cosd (angle) * real (zeichen.height)+0.5) FI 

+  FI  .

+

+character height:

+  IF height <> 0.0

+  THEN int (vert faktor * height+0.5)

+  ELSE zeichen.height FI  .

+

+character y step:

+  IF horizontal

+  THEN IF height <> 0.0

+       THEN int (sind (angle) * vert faktor * height+0.5)

+       ELSE int (sind (angle) * real (zeichen.height)+0.5) FI 

+  ELSE IF height <> 0.0

+       THEN int (sind (angle) * hor faktor * height+0.5)

+       ELSE int (sind (angle) * real (zeichen.width)+0.5) FI 

+  FI  .

+

+draw character i:

+  IF code (record SUB i) < 32

+  THEN steuerzeichen

+  ELSE normale zeichen FI  .

+

+steuerzeichen:

+  SELECT code (record SUB i) OF

+  CASE  7: out (""0""7""16"")

+  CASE 13: x pos := pos.x;  y pos := pos.y

+  END SELECT  .

+

+normale zeichen:

+  TEXT CONST char :: zeichen.char [code (record SUB i)];

+  IF horizontal

+  THEN draw horizontal

+  ELSE draw vertical FI  .

+

+draw vertical:

+  n := 3;

+  IF char <> ""

+  THEN pos := POS : (((char ISUB 2)*y fak) DIV zeichen.height + x pos,

+                    -((char ISUB 1)*x fak) DIV zeichen.width + y pos)

+  FI;

+  WHILE n <= length (char) DIV 2

+  REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0

+      THEN pos := POS : (((char ISUB n+1)*y fak) DIV zeichen.height + x pos,

+                        -((char ISUB n  )*x fak) DIV zeichen.width + y pos) 

+      ELSE vector (-((char ISUB n+1)*y fak) DIV zeichen.height + x pos-pos.x,

+                    ((char ISUB n  )*x fak) DIV zeichen.width + y pos-pos.y)

+      FI;

+      n INCR 2

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+draw horizontal:

+  n := 3;

+  IF char <> ""

+  THEN pos := POS : (-((char ISUB 1)*x fak) DIV zeichen.width + x pos,

+                     -((char ISUB 2)*y fak) DIV zeichen.height + y pos)

+  FI;

+  WHILE n <= length (char) DIV 2

+  REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0

+      THEN pos := POS : (-((char ISUB n  )*x fak) DIV  zeichen.width + x pos,

+                         -((char ISUB n+1)*y fak) DIV zeichen.height + y pos)

+      ELSE vector (((char ISUB n  )*x fak) DIV zeichen.width + x pos-pos.x,

+                   ((char ISUB n+1)*y fak) DIV zeichen.height + y pos-pos.y)

+      FI;

+      n INCR 2

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  t := "";

+  x := 0;

+  y := 0

+END PROC get cursor;

+

+OP := (SCREEN VAR l, SCREEN CONST r):

+  CONCR (l) := CONCR (r)

+END OP :=;

+

+PROC get screen (TEXT CONST name):

+  IF exists (name)

+  THEN get screen (old (name))

+  ELSE get screen (new (name)) FI;

+END PROC get screen;

+

+PROC get screen (DATASPACE CONST ds):

+  BOUND SCREEN VAR ds screen :: ds;

+  ds screen := screen

+END PROC get screen;

+

+PROC get screen (SCREEN VAR ds screen):

+  ds screen := screen

+END PROC get screen;

+

+PROC get screen:

+  FOR i FROM 1 UPTO 32

+  REP block in (screen [i], -1, i-1, n) PER

+END PROC get screen;

+

+PROC put screen (TEXT CONST name):

+  IF exists (name)

+  THEN put screen (old (name))

+  ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI

+END PROC put screen;

+

+PROC put screen (DATASPACE CONST ds):

+  BOUND SCREEN VAR ds screen :: ds;

+  screen := ds screen;

+  put screen

+END PROC put screen;

+

+PROC put screen (SCREEN VAR ds screen):

+  screen := ds screen;

+  put screen

+END PROC put screen;

+

+PROC put screen:

+  FOR i FROM 1 UPTO 32

+  REP block out (screen [i], -1, i-1, n) PER

+END PROC put screen;

+

+PROC clear (SCREEN VAR screen):

+  FOR i FROM 1 UPTO 256

+  REP screen [1] [i] := 0 PER;

+  FOR i FROM 2 UPTO 32

+  REP screen [i] := screen [1] PER

+END PROC clear;

+

+END PACKET matrix plot;

+

+

diff --git a/app/mpg/1987/src/Muster b/app/mpg/1987/src/Muster
new file mode 100644
index 0000000..336e2ef
--- /dev/null
+++ b/app/mpg/1987/src/Muster
@@ -0,0 +1,73 @@
+INCLUDE "Name der Include-Datei"; 

+ 

+PLOTTER "Plottername",<Station>,<Kanal>,<Xpixel>,<Ypixel>,<Xcm>,<Ycm>; 

+ 

+LINK <Station>/<Kanal>,<Station>/<Kanal>....; 

+ 

+COLORS "<RGB-Kombinationen als 3-Byte Codefolge>";

+ 

+  . 

+  . 

+  . 

+<Hier koennen Endgeraetspezifische Prozeduren/Variablen (globalebene) 

+ eingefuegt werden. Achtung! um Namenskonflikte mit globalobjekten 

+ anderer Endgeraete zu vermeiden sollten die Namen dieser Objekte 

+ auch stets den Endgeraet-Namen enthalten 

+ (z.B. 'TEXT PROC videostar koordinaten (INT CONST x,y)') 

+> 

+ 

+PROC initplot: 

+   Warnung: Da der Configurator den Prozedur-Rumpf in ein Refinement

+            verwandelt, muessen Namenskonflikte vermieden wrden !

+END PROC initplot;

+ 

+PROC endplot: 

+END PROC endplot; 

+

+PROC prepare: 

+END PROC prepare; 

+ 

+PROC clear: 

+END PROC clear; 

+ 

+PROC home: 

+END PROC home;

+

+PROC moveto (INT CONST x,y): 

+END PROC moveto;

+ 

+PROC drawto (INT CONST x,y): 

+END PROC drawto;

+

+PROC setpixel (INT CONST x,y): 

+END PROC setpixel;

+

+PROC foreground (INT CONST type): 

+END PROC foreground;

+

+PROC background (INT CONST type):

+END PROC background; 

+        

+PROC setpalette: 

+END PROC setpalette:

+

+PROC circle (INT CONST x,y,rad,from,to): 

+END PROC circle; 

+ 

+PROC box (INT CONST x1,y1,x2,y2,pattern): 

+END PROC box; 

+ 

+PROC fill (INT CONST x,y,pattern): 

+END PROC fill;

+ 

+EDITOR; (* Durch EDITOR wird das optionale Vorhandensein nachfolgender 

+           Editor-Befehle angezeigt *) 

+ 

+PROC get cursor (INT VAR x,y,TEXT VAR exit char): 

+END PROC get cursor; 

+ 

+PROC graphik cursor (INT CONST x,y,BOOL CONST on): 

+END PROC graphik cursor; 

+ 

+PROC set marker (INT CONST x,y,type): 

+END PROC set marker;

diff --git a/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF b/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF
new file mode 100644
index 0000000..0058f48
--- /dev/null
+++ b/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF
@@ -0,0 +1,219 @@
+INCLUDE "std primitives"; 

+INCLUDE "matrix printer"; 

+ 

+PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644;

+ 

+COLORS "000999";

+

+(* Version vom 21.10.87 BJ *) 

+ 

+(* Globale Daten fuer NEC P9 *) 

+ 

+LET md p9 graf  = ""27"*"39"",    (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) 

+    md p9 feed  = ""28"3",        (* Zeilenabstand in 360 Pixel/Zoll setzen *) 

+    md p9 nlq   = ""27"x"1"",     (* NLQ Modus waehlen *) 

+    md p9 pos   = ""27"\";        (* in 1/180 Zoll-Schritten rel Positionieren *) 

+

+LET md p9 x max   = 2339, 

+    md p9 y max   = 1979, 

+    md p9 y lines = 124,         (* y pixel / 16 (Punkte pro INT) *) 

+    md p9 x per ds= 780,         (* Maximale x pixel pro Dataspace ( Darf *) 

+                                 (* Nicht mehr als 256 K sein !!!     *) 

+                                 (* x per ds = 256 * 1024 / p9 y lines / 4 *)

+    md p9 x lines = 3;           (* x pixel / hd p9 x per ds *) 

+ 

+LET MDPYLINE = ROW md p9 x per ds INT, 

+    MDPSMAP  = ROW md p9 y lines MDPYLINE, 

+    MDPMAP   = ROW md p9 x lines BOUND MDPSMAP; 

+ 

+MDPMAP VAR md p9 map; 

+

+ROW md p9 x lines DATASPACE VAR md p9 ds;

+

+INT VAR md p9 x pos, md p9 y pos;

+ 

+(* Globale Daten Ende *) 

+

+PROC prepare: 

+  REP 

+   call (29, "", printer); (* wait for halt *) 

+   IF task(channel(plotter)) = niltask   (* Es koennte der HD worker dran sein *) 

+     THEN continue (channel (plotter))   (* der startet den PRINTER wieder ! *) 

+     ELSE pause(300)                     (* folge : Kanal belegt -> dead *)

+   FI

+ UNTIL channel(myself) = channel(plotter) PER

+END PROC prepare;

+ 

+PROC initplot: 

+  INT VAR md p9 i; 

+  FOR md p9 i FROM 1 UPTO md p9 x lines REP 

+    md p9 ds[md p9 i] := nilspace; 

+    md p9 map[md p9 i] := md p9 ds[md p9 i]

+  PER

+END PROC initplot; 

+ 

+PROC endplot: 

+  md p9 put map;

+  break(quiet);

+  call (26, "", printer);  (* start spool *)

+  enable stop

+END PROC endplot; 

+ 

+PROC md p9 put map: 

+  open graf; 

+  put map; 

+  close graf;

+  forget dataspaces.

+ 

+  open graf: 

+    out(md p9 feed + ""32"");  (* LF auf 16/180 Zoll setzen *)

+    out(md p9 nlq).   (* NLQ Modus waehlen, damit Positionierung in 1/180 *) 

+                      (* Schritten geht (sonst 1/120) *) 

+  close graf: 

+    out(""12"").      (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) 

+                      (* eingestellt sein (EUMEL-DR macht kein FF) *) 

+ 

+  forget dataspaces: 

+    INT VAR i;

+    FOR i FROM 1 UPTO md p9 x lines REP 

+      forget(md p9 ds[i]) 

+    PER. 

+ 

+  put map: 

+    INT VAR j; 

+    FOR j FROM 1 UPTO md p9 y lines REP 

+      put line; 

+    PER. 

+ 

+  put line: 

+    INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*)

+            last pos;

+    WHILE actual pos <= md p9 x max REP 

+      put blank cols; 

+      put nonblank cols 

+    PER;

+    line.

+ 

+  put blank cols: 

+    last pos := actual pos; 

+    WHILE actual pos <= md p9 x max CAND actual col is blank REP 

+      actual pos INCR 1 

+    PER; 

+    IF actual pos > last pos AND actual pos <= md p9 x max

+      THEN out blank cols 

+    FI. 

+ 

+  put nonblank cols: 

+    last pos := actual pos; 

+    WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP 

+      actual pos INCR 1 

+    PER; 

+    IF actual pos > last pos

+      THEN out nonblank cols 

+    FI. 

+ 

+  out blank cols: 

+    TEXT VAR t :: "  "; 

+    replace(t, 1, actual pos - last pos); 

+    out (md p9 pos + t).

+ 

+  out nonblank cols: 

+    t := "  "; 

+    replace (t,1, actual pos - last pos); 

+    out(md p9 graf + t); 

+    INT VAR k;

+    FOR k FROM last pos UPTO actual pos - 1 REP

+      INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] 

+                                [(k MOD md p9 x per ds) + 1], 

+              first byte :: word; 

+      rotate (word, 8);

+      out (code (word));

+      out (code (first byte));

+      out (""0"")

+    PER.

+ 

+  actual col is blank: 

+    md p9  map [(actual pos DIV md p9 x per ds) + 1][j]

+               [(actual pos MOD md p9 x per ds) + 1] = 0 

+ 

+END PROC md p9 put map; 

+ 

+PROC clear: 

+  md p9 clear

+END PROC clear;

+

+PROC md p9 clear: 

+  create initline;

+  initialize all lines.

+

+  create initline: 

+    MDPYLINE VAR initline; 

+    INT VAR i; 

+    FOR i FROM 1 UPTO md p9 x per ds REP 

+      initline[i] := 0 

+    PER. 

+ 

+  initialize all lines: 

+    INT VAR k; 

+    FOR i FROM 1 UPTO md p9 x lines REP

+      FOR k FROM 1 UPTO md p9 y lines REP 

+        md p9 map[i][k] := initline 

+     PER

+   PER

+END PROC md p9 clear; 

+ 

+PROC home: 

+  move to (0,0)

+END PROC home;

+

+PROC moveto (INT CONST x,y): 

+  md p9 x pos := x;

+  md p9 y pos := y

+END PROC moveto;

+ 

+PROC drawto (INT CONST x,y): 

+  printer line (md p9 x pos,md p9 y max - md p9 y pos,

+                x, md p9 y max - y,

+                PROC (INT CONST, INT CONST) md p9 set pixel);

+  md p9 x pos := x;

+  md p9 y pos := y

+END PROC drawto;

+

+PROC setpixel (INT CONST x,y): 

+  md p9 set pixel (x, md p9 y max - x)

+END PROC setpixel;

+

+PROC md p9 set pixel (INT CONST x,y):

+  setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 

+                    [(x MOD md p9 x per ds) + 1],15 - (y AND 15))

+END PROC md p9 set pixel;

+

+BOOL PROC md p9 is pixel (INT CONST x,y):

+  bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 

+                 [(x MOD md p9 x per ds) + 1],15 - (y AND 15))

+END PROC md p9 is pixel;

+

+PROC foreground (INT VAR type): 

+  type := 1

+END PROC foreground;

+

+PROC background (INT VAR type):

+  type := 0

+END PROC background; 

+        

+PROC setpalette: 

+END PROC setpalette;

+

+PROC circle (INT CONST x,y,rad,from,to): 

+  std circle (x,y,rad,from,to) 

+END PROC circle; 

+ 

+PROC box (INT CONST x1,y1,x2,y2,pattern): 

+  std box (x1, y1, x2, y2, pattern)

+END PROC box; 

+

+PROC fill (INT CONST x,y,pattern): 

+  printer fill (x,x,md p9 y max - y,1, 

+                BOOL PROC (INT CONST, INT CONST) md p9 is pixel, 

+                PROC (INT CONST, INT CONST) md p9 set pixel) 

+END PROC fill;

diff --git a/app/mpg/1987/src/PCPLOT.ELA b/app/mpg/1987/src/PCPLOT.ELA
new file mode 100644
index 0000000..fd980ab
--- /dev/null
+++ b/app/mpg/1987/src/PCPLOT.ELA
@@ -0,0 +1,276 @@
+PACKET pc plot DEFINES drawing area,                {Autor: H. Indenbirken}

+                       begin plot,                  {Stand: 08.02.85      }

+                       end plot, 

+                       clear, 

+                       colour palette,

+                       pen,

+                       move, 

+                       draw, 

+

+                       get cursor,

+                       zeichensatz:

+ 

+LET hor faktor   = 22.21739,        {***** x pixel / x cm *****}

+    vert faktor  = 18.61314,        {***** y pixel / y cm *****}

+

+    delete = 0,                         {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    nothing          = 0,               {Linientypen}

+    durchgehend      = 1, 

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5,

+

+    bit 14           = 16384;

+

+LET POS = STRUCT (INT x, y);

+LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height);

+

+ZEICHENSATZ VAR zeichen;

+BOOL VAR character defined :: FALSE; 

+TEXT VAR cursor pos  :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"M"0""0""0""0""0"D"0""0""0""0"", 

+         cursor line :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"D"0""0""0""0"";

+INT VAR act thick :: 0, i, dummy, resolution :: 6, colour code :: 256;

+POS VAR pos :: POS : (0, 0);

+

+PROC zeichensatz (TEXT CONST name):

+  IF exists (name)                                      { Höhe:   0.64 cm }

+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); { Breite: 0.40 cm }

+       zeichen := new zeichen;

+       character defined := TRUE

+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI

+END PROC zeichensatz;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 22.0;    y cm    := 13.7; 

+   IF resolution = 6

+   THEN x pixel := 639;     y pixel := 199 

+   ELSE x pixel := 319;     y pixel := 199 FI

+END PROC drawing area;

+

+ 

+PROC colour palette (INT CONST colour):

+  SELECT colour OF

+  CASE 0: resolution := 6

+  CASE 1: resolution := 4;

+          colour code:= 256

+  CASE 2: resolution := 4;

+          colour code:= 257

+  OTHERWISE errorstop ("colour palette nicht vorhanden") ENDSELECT

+

+END PROC colour palette;

+

+PROC begin plot : 

+  control (-5, resolution, 0, dummy);

+  control (-4, 0, colour code, dummy) 

+ENDPROC begin plot ;

+

+PROC end plot : 

+  control (-5, 3, 0, dummy)

+ENDPROC end plot ;

+

+PROC clear :

+  control (-5, resolution, 0, dummy);

+  control (-4, 0, colour code, dummy); 

+  act thick := 0;

+

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  act thick := thickness;

+  control (-8, linetype code, foreground code, dummy)  .

+

+linetype code:

+  SELECT linetype OF

+  CASE nothing          : 0

+  CASE durchgehend      : -1

+  CASE gepunktet        : 21845

+  CASE kurz gestrichelt : 3855

+  CASE lang gestrichelt : 255

+  CASE strichpunkt      : 4351

+  OTHERWISE linetype END SELECT  .

+

+foreground code:

+  IF foreground = delete

+  THEN 0

+  ELIF foreground < 0

+  THEN 128

+  ELSE foreground FI  .

+ 

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  control (-7, x, 200-y, dummy);

+  pos := POS  : (x, y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF act thick <> 0

+  THEN IF horizontal line

+       THEN thick y

+       ELSE thick x FI;

+       x MOVE y

+  ELSE control (-6, x, 200-y, dummy) FI;

+  pos := POS : (x, y)   .

+

+horizontal line:

+  abs (pos.x-x) > abs (pos.y-y)  .

+

+thick y:

+  INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;

+  old x MOVE pos.y;

+  new x DRAW     y;

+  FOR dy FROM 1 UPTO act thick

+  REP old x MOVE pos.y+dy;

+      new x DRAW     y+dy;

+      old x MOVE pos.y-dy;

+      new x DRAW y-dy;

+  PER  . 

+

+x ausgleich:

+  IF pos.x <= x

+  THEN  act thick

+  ELSE -act thick FI  .

+

+thick x:

+  INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;

+  pos.x MOVE old y;

+      x DRAW new y; 

+  FOR dx FROM 1 UPTO act thick

+  REP pos.x+dx MOVE old y;

+          x+dx DRAW new y;

+      pos.x-dx MOVE old y;

+          x-dx DRAW new y;

+  PER  . 

+

+y ausgleich:

+  IF pos.y <= y

+  THEN  act thick

+  ELSE -act thick FI  .

+

+END PROC draw;

+

+INT VAR x fak :: zeichen.width,

+        y fak :: zeichen.height;

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+  IF character defined

+  THEN draw graphic character

+  ELSE pos cursor (pos.x, pos.y);

+       get cursor (x pos, y pos);

+       outsubtext (record, 1, 79-y pos); 

+  FI  .

+

+draw graphic character:

+{**** Hier werden Texte mit dem Winkel 'angle',der Höhe 'height' und *****}

+{**** der Breite 'width' gezeichnet. Die Form der Zeichen ist in der *****}

+{**** Datei 'STD Zeichensatz' enthalten.                             *****}

+  INT CONST x step :: character x step, y step :: character y step;

+  INT VAR x pos :: pos.x, y pos :: pos.y, i, n, x, y;

+  BOOL VAR move order;

+ 

+  set character height and width;

+

+  FOR i FROM 1 UPTO length (record)

+  REP draw character i PER;

+  pos.x MOVE pos.y .

+

+set character height and width:

+  IF width = 0.0 AND height = 0.0

+  THEN x fak := zeichen.width;

+       y fak := zeichen.height

+  ELSE x fak := int (hor faktor * width+0.5);

+       y fak := int (vert faktor * height+0.5)

+  FI  .

+

+character x step:

+  IF width <> 0.0

+  THEN int (cosd (angle) * hor faktor * width+0.5)

+  ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI  .

+

+character y step:

+  IF height <> 0.0

+  THEN int (sind (angle) * vert faktor * height+0.5)

+  ELSE int (sind (angle) * real (zeichen.height)+0.5) FI  .

+

+draw character i:

+  IF code (record SUB i) < 32

+  THEN steuerzeichen

+  ELSE normale zeichen FI  .

+

+steuerzeichen:

+  SELECT code (record SUB i) OF

+  CASE  1: x pos := 0;

+           y pos := 255-y fak

+  CASE  2: x pos INCR x fak 

+  CASE  3: y pos INCR y fak 

+  CASE  4: pos cursor (x pos, y pos);

+  CASE  5: pos cursor (x pos, y pos);

+  CASE  7: out (""7"")

+  CASE  8: x pos DECR x fak 

+  CASE 10: y pos DECR y fak 

+  CASE 13: x pos := pos.x

+  END SELECT  .

+

+normale zeichen:

+  TEXT CONST char :: zeichen.char [code (record SUB i)];

+  FOR n FROM 1 UPTO length (char) DIV 4

+  REP value (char, n, x, y, move order);

+      IF move order

+      THEN x pos+x MOVE y pos+y

+      ELSE x pos+x DRAW y pos+y FI

+  PER;

+  x pos INCR x step;

+  y pos INCR y step  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC value (TEXT CONST char, INT CONST n, INT VAR x, y, BOOL VAR move):

+  x := char ISUB n+n-1;

+  y := char ISUB n+n;

+  IF x < 0

+  THEN IF (x AND bit 14) <> 0

+       THEN move := FALSE

+       ELSE move := TRUE;

+            x := x XOR bit 14

+       FI

+  ELSE IF (x AND bit 14) <> 0

+       THEN move := TRUE;

+            x := x XOR bit 14

+       ELSE move := FALSE FI

+  FI;

+  x := (x*x fak) DIV zeichen.width;

+  y := (y*y fak) DIV zeichen.height

+

+END PROC value;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+END PROC get cursor;

+

+OP MOVE (INT CONST x, y):

+  control (-7, x, 200-y, dummy)

+END OP MOVE;

+

+OP DRAW (INT CONST x, y):

+  control (-6, x, 200-y, dummy)

+END OP DRAW;

+

+PROC pos cursor (INT CONST x, y):

+  cursor ((x-10) DIV 6, (237-y) DIV 10)

+END PROC pos cursor;

+

+END PACKET pc plot

+

+IF exists ("ZEICHEN 6*10")

+THEN zeichensatz ("ZEICHEN 6*10")

+ELIF exists ("ZEICHEN 9*12")

+THEN zeichensatz ("ZEICHEN 9*12")

+ELSE put line ("Warnung: Zeichensatz fehlt") FI

+

diff --git a/app/mpg/1987/src/PICFILE.ELA b/app/mpg/1987/src/PICFILE.ELA
new file mode 100644
index 0000000..8cd4945
--- /dev/null
+++ b/app/mpg/1987/src/PICFILE.ELA
@@ -0,0 +1,446 @@
+PACKET picfile DEFINES                            (*Autor: H.Indenbirken *)

+                                                  (*Stand: 23.02.1985    *)

+               PICFILE, :=, picture file, plot,

+               select pen, selected pen, background, 

+               set values, get values,

+               view, viewport, window, oblique, orthographic, perspective,

+               extrema,

+

+               put, get,

+               to first pic, to eof, to pic, up, down,

+               is first picture, eof, picture no, pictures,

+               delete picture, insert picture, read picture,

+               write picture, put picture:

+

+

+LET max pics = 1024,

+    pic dataspace = 1102;

+

+

+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,

+                             ROW 16 ROW 3 INT pens,

+                             ROW 16 BOOL hidden,

+                             ROW 3 ROW 2 REAL sizes,

+                             ROW 2 ROW 2 REAL limits,

+                             ROW 4 REAL angles,

+                             ROW 2 REAL obliques,

+                             ROW 3 REAL perspectives

+                             ROW max pics PICTURE pic);

+

+TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0"";

+INT VAR i;

+

+OP := (PICFILE VAR p, DATASPACE CONST d) :

+  IF type (d) = pic dataspace

+    THEN CONCR (p) := d

+  ELIF type (d) < 0

+    THEN type (d, pic dataspace) ;

+         CONCR (p) := d ;

+         init picfile dataspace ;

+  ELSE errorstop ("dataspace is no PICFILE") FI .

+ 

+init picfile dataspace :

+  r.size := 0;

+  r.pos  := 0;

+  r.background := 0;

+  r.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),

+                                 ROW 2 REAL : (0.0, 1.0),

+                                 ROW 2 REAL : (0.0, 1.0));

+  r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),

+                                  ROW 2 REAL : (0.0, 1.0));

+  r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);

+  r.obliques := ROW 2 REAL : (0.0, 0.0);

+  r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0);

+  FOR i FROM 1 UPTO 16

+  REP r.pens [i] := ROW 3 INT : (1, 0, 1);

+      r.hidden [i] := TRUE

+  PER  .

+

+r : CONCR (CONCR (p)).

+END OP :=;

+ 

+DATASPACE PROC picture file (TEXT CONST name) :

+  IF exists (name)

+  THEN old (name)

+  ELSE new (name) FI 

+END PROC picture file;

+

+PROC plot (TEXT CONST name) :

+  PICFILE VAR p :: old (name);

+  plot (p);

+END PROC plot;

+

+PROC plot (PICFILE VAR p) :

+  set values (p.sizes, p.limits, p.angles, p.obliques,

+              p.perspectives);

+  begin plot;

+  clear;

+  FOR i FROM 1 UPTO p.size

+  REP IF pen (p.pic [i]) <> 0

+      THEN plot pic FI

+  PER;

+  end plot  .

+

+plot pic:

+  pen (p.background, p.pens (pen (p.pic (i)))(1),

+       p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3));

+  hidden lines (p.hidden [pen (p.pic [i])]);

+  plot (p.pic (i))  .

+

+END PROC plot;

+

+PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type,

+                                BOOL CONST hidden):

+  IF pen < 1 OR pen > 16

+  THEN errorstop ("pen out of range") FI;

+  p.pens   [pen] := ROW 3 INT : (colour, thickness, line type);

+  p.hidden [pen] := hidden

+END PROC select pen;

+

+PROC selected pen (PICFILE CONST p, INT CONST pen,

+                                    INT VAR colour, thickness, line type,

+                                    BOOL VAR hidden):

+  IF pen < 1 OR pen > 16

+  THEN errorstop ("pen out of range") FI;

+  colour    := p.pens [pen][1];

+  thickness := p.pens [pen][2];

+  line type := p.pens [pen][3];

+  hidden    := p.hidden [pen]

+END PROC selected pen;

+

+INT PROC background (PICFILE CONST p):

+  p.background

+END PROC background;

+

+PROC background (PICFILE VAR p, INT CONST colour):

+  p.background := colour

+END PROC background;

+

+PROC get values (PICFILE CONST p,

+                 ROW 3 ROW 2 REAL VAR size, 

+                 ROW 2 ROW 2 REAL VAR limits,

+                 ROW 4 REAL VAR angles,

+                 ROW 2 REAL VAR oblique,

+                 ROW 3 REAL VAR perspective) : 

+  size        := p.sizes;

+  limits      := p.limits;

+  angles      := p.angles;

+  oblique     := p.obliques;

+  perspective := p.perspectives;

+

+END PROC get values;

+ 

+PROC set values (PICFILE VAR p,

+                 ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 4 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) : 

+  p.sizes        := size;

+  p.limits       := limits;

+  p.angles       := angles;

+  p.obliques     := oblique;

+  p.perspectives := perspective;

+

+END PROC set values;

+ 

+PROC view (PICFILE VAR p, REAL CONST alpha):

+  p.angles [1] := alpha

+END PROC view;

+

+PROC view (PICFILE VAR p, REAL CONST phi, theta):

+  p.angles [2] := sind (theta) * cosd (phi);

+  p.angles [3] := sind (theta) * sind (phi);

+  p.angles [4] := cosd (theta);

+END PROC view;

+

+PROC view (PICFILE VAR p, REAL CONST x, y, z):

+  p.angles [2] := x;

+  p.angles [3] := y;

+  p.angles [4] := z

+END PROC view;

+

+PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :

+  p.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max),

+                                  ROW 2 REAL : (vert min, vert max))

+END PROC viewport;

+

+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :

+  window (p, x min, x max, y min, y max, 0.0, 1.0)

+END PROC window;

+

+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :

+  p.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),

+                                 ROW 2 REAL : (y min, y max),

+                                 ROW 2 REAL : (z min, z max))

+END PROC window;

+

+PROC oblique (PICFILE VAR p, REAL CONST a, b) :

+  p.obliques := ROW 2 REAL : (a, b);

+  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)

+END PROC oblique;

+

+PROC orthographic (PICFILE VAR p) :

+  p.obliques := ROW 2 REAL : (0.0, 0.0);

+  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)

+END PROC orthographic;

+ 

+PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :

+  p.obliques := ROW 2 REAL : (0.0, 0.0);

+  p.perspectives := ROW 3 REAL : (cx, cy, cz)

+END PROC perspective;

+ 

+PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :

+  REAL VAR dummy;

+  extrema (p, x min, x max, y min, y max, dummy, dummy)

+END PROC extrema;

+

+PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :

+  REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;

+  x min := max real;  x max := - max real;

+  y min := max real;  y max := - max real;

+  z min := max real;  z max := - max real;

+  FOR i FROM 1 UPTO p.size

+  REP IF dim (p.pic [i]) = 2

+      THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) 

+      ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,

+                               new z min, new z max)

+      FI;

+      x min := min (x min, new x min); x max := max (x max, new x max); 

+      y min := min (y min, new y min); y max := max (y max, new y max); 

+      z min := min (z min, new z min); z max := max (z max, new z max); 

+  PER

+END PROC extrema;

+

+PROC put (FILE VAR f, PICFILE CONST p):

+  put line (f, parameter);

+  FOR i FROM 1 UPTO p.size

+  REP put line (f, text (p.pic [i])) PER  .

+

+parameter:

+  intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) +

+  intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) +

+  intern (p.obliques) + intern (p.perspectives)  .

+

+END PROC put;

+

+PROC get (PICFILE VAR p, FILE VAR f):

+  TEXT VAR record;

+  get line (f, record);

+  convert parameter;

+  FOR i FROM 1 UPTO p.size

+  REP get line (f, record);

+      p.pic [i] := picture (record)

+  PER  .

+

+convert parameter:

+  convert (record, p.size);        convert (record, p.pos);

+  convert (record, p.background);  convert (record, p.pens);

+  convert (record, p.hidden);      convert (record, p.sizes);

+  convert (record, p.limits);      convert (record, p.angles);

+  convert (record, p.obliques);    convert (record, p.perspectives)  .

+

+END PROC get;

+

+PROC to first pic (PICFILE VAR p):

+  p.pos := 1

+END PROC to first pic;

+

+PROC to eof (PICFILE VAR p):

+ p.pos := p.size+1

+END PROC to eof;

+

+PROC to pic (PICFILE VAR p, INT CONST n):

+  IF n < 1

+  THEN errorstop ("Position underflow")

+  ELIF n > p.size

+  THEN errorstop ("Position after end of PICFILE")

+  ELSE p.pos := n FI

+END PROC to pic;

+

+PROC up (PICFILE VAR p):

+  to pic (p, p.pos-1)

+END PROC up;

+

+PROC up (PICFILE VAR p, INT CONST n):

+  to pic (p, p.pos-n)

+END PROC up;

+

+PROC down (PICFILE VAR p):

+  to pic (p, p.pos+1)

+END PROC down;

+

+PROC down (PICFILE VAR p, INT CONST n):

+  to pic (p, p.pos+n)

+END PROC down;

+

+BOOL PROC is first picture (PICFILE CONST p):

+  p.pos = 1

+END PROC is first picture;

+

+BOOL PROC eof (PICFILE CONST p):

+  p.pos >= p.size

+END PROC eof;

+

+INT PROC picture no (PICFILE CONST p):

+  p.pos

+END PROC picture no;

+

+INT PROC pictures (PICFILE CONST p):

+  p.size

+END PROC pictures;

+

+PROC delete picture (PICFILE VAR p) :

+  INT VAR i;

+  FOR i FROM p.pos+1 UPTO p.size

+  REP p.pic [i-1] := p.pic [i] PER;

+

+  p.pic [p.size] := nilpicture;

+  IF p.size > 1

+  THEN p.size DECR 1 FI

+END PROC delete picture;

+

+PROC insert picture (PICFILE VAR p) :

+  INT VAR i;

+  IF p.size >= max pics

+  THEN errorstop ("PICFILE overflow")

+  ELSE p.size INCR 1;

+       FOR i FROM p.size DOWNTO p.pos+1

+       REP p.pic [i] := p.pic [i-1] PER;

+

+       p.pic [p.pos] := nilpicture;

+  FI

+END PROC insert picture;

+

+PROC read picture (PICFILE VAR p, PICTURE VAR pic) :

+  pic := p.pic (p.pos)  .

+END PROC read picture;

+ 

+PROC write picture (PICFILE VAR p, PICTURE CONST pic) :

+  p.pic (p.pos) := pic  .

+END PROC write picture;

+

+PROC put picture (PICFILE VAR p, PICTURE CONST pic) :

+  IF p.size >= max pics

+  THEN errorstop ("PICFILE overflow")

+  ELSE p.size INCR 1;

+       p.pic [p.size] := pic;

+  FI 

+END PROC put picture;

+

+TEXT PROC intern (INT CONST n):

+  replace (i text, 1, n);

+  i text

+END PROC intern;

+

+TEXT PROC intern (ROW 16 ROW 3 INT CONST n):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 16

+  REP FOR j FROM 1 UPTO 3

+      REP result CAT intern (n [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 16 BOOL CONST n):

+  INT VAR i, result :: 0;

+  FOR i FROM 1 UPTO 16

+  REP IF n [i]

+      THEN set bit (result, i-1) FI

+  PER;

+  intern (result)

+END PROC intern;

+

+TEXT PROC intern (REAL CONST r):

+  replace (r text, 1, r);

+  r text

+END PROC intern;

+

+TEXT PROC intern (ROW 3 ROW 2 REAL CONST r):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 3

+  REP FOR j FROM 1 UPTO 2

+      REP result CAT intern (r [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 2 ROW 2 REAL CONST r):

+  INT VAR i, j;

+  TEXT VAR result :: "";

+  FOR i FROM 1 UPTO 2

+  REP FOR j FROM 1 UPTO 2

+      REP result CAT intern (r [i][j]) PER

+  PER;

+  result

+END PROC intern;

+

+TEXT PROC intern (ROW 4 REAL CONST r):

+  intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) 

+END PROC intern;

+

+TEXT PROC intern (ROW 3 REAL CONST r):

+  intern (r [1]) + intern (r [2]) + intern (r [3])

+END PROC intern;

+

+TEXT PROC intern (ROW 2 REAL CONST r):

+  intern (r [1]) + intern (r [2])

+END PROC intern;

+

+PROC convert (TEXT VAR record, INT VAR n):

+  n := record ISUB 1;

+  record := subtext (record, 3)

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 16

+  REP FOR j FROM 1 UPTO 3

+      REP convert (record, n [i][j]) PER

+  PER

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 16 BOOL VAR n):

+  INT VAR i, result;

+  convert (record, result);

+  FOR i FROM 1 UPTO 16

+  REP n [i] := bit (i-1, result) PER

+END PROC convert;

+

+PROC convert (TEXT VAR record, REAL VAR r):

+  r := record RSUB 1;

+  record := subtext (record, 9)

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 3

+  REP FOR j FROM 1 UPTO 2

+      REP convert (record, r [i][j]) PER

+  PER;

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r):

+  INT VAR i, j;

+  FOR i FROM 1 UPTO 2

+  REP FOR j FROM 1 UPTO 2

+      REP convert (record, r [i][j]) PER

+  PER;

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 4 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2]);

+  convert (record, r [3]); convert (record, r [4]) 

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 3 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2]); convert (record, r [3])

+END PROC convert;

+

+PROC convert (TEXT VAR record, ROW 2 REAL VAR r):

+  convert (record, r [1]); convert (record, r [2])

+END PROC convert;

+

+END PACKET picfile

diff --git a/app/mpg/1987/src/PICPLOT.ELA b/app/mpg/1987/src/PICPLOT.ELA
new file mode 100644
index 0000000..af92390
--- /dev/null
+++ b/app/mpg/1987/src/PICPLOT.ELA
@@ -0,0 +1,241 @@
+PACKET pic plot DEFINES drawing area,               {Autor: H. Indenbirken}

+                        begin plot,                 {Stand: 13.02.85      }

+                        end plot, 

+                        clear, 

+                        pen,

+                        move, 

+                        draw, 

+                        get cursor,

+

+                        get screen, put screen: 

+ 

+LET hor faktor   = 22.21739,                   {***** x pixel / x cm *****}

+    vert faktor  = 18.61314,                   {***** y pixel / y cm *****}

+

+    h max  = 639,

+    v max  = 287,

+

+    delete = 0,                                {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+ 

+    nothing          = 0,                      {Linientypen}

+    durchgehend      = 1, 

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5;

+

+INT CONST move code :: -255,                   {Controlcodes}

+          draw code :: -254,

+          plot code :: -253,

+          norm code :: -252,

+          del  code :: -251,

+          xor  code :: -250,

+          line code :: -249;

+

+LET POS = STRUCT (INT x, y);

+

+INT VAR pen thick :: 0, pen code :: draw code, ack;

+POS VAR pos :: POS : (0, 0);

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 23.0;      y cm    := 13.7; 

+   x pixel := h max;     y pixel := v max

+END PROC drawing area;

+

+PROC begin plot : 

+  control (plot code, 0, 0, ack);

+  out (""15"")

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+  out (""14"");

+  control (norm code, 0, 0, ack)

+ENDPROC end plot ;

+

+PROC clear :

+  pos := POS : (0, 0);

+  pen (0, 1, 0, 1);

+  page

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  pen code := foreground colour;

+  pen thick := thickness;

+  control (line code, 0, 0, ack)  .

+

+foreground colour:

+  IF linetype = nothing

+  THEN move code

+  ELIF foreground = delete OR foreground = black

+  THEN del code

+  ELIF foreground < 0

+  THEN xor code

+  ELSE draw code FI  .

+ 

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  control (move code, x, y);

+  pos := POS  : (x, y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  control (pen code, x, y);

+  IF thick line

+  THEN IF horizontal line

+       THEN thick y

+       ELSE thick x FI;

+       control (move code, x, y)

+  FI;

+  pos := POS : (x, y)   .

+

+thick line:

+  pen thick > 0 AND pen code <> move code  .

+

+horizontal line:

+  abs (pos.x-x) > abs (pos.y-y)  .

+

+thick y:

+  INT VAR dy;

+  FOR dy FROM 1 UPTO pen thick

+  REP control (move code, pos.x, pos.y+dy);

+      control (pen code,      x,     y+dy); 

+      control (move code, pos.x, pos.y-dy);

+      control (pen code,      x,     y-dy)

+  PER  . 

+

+thick x:

+  INT VAR dx;

+  FOR dx FROM 1 UPTO pen thick

+  REP control (move code, pos.x+dx, pos.y);

+      control (pen code,      x+dx,     y); 

+      control (move code, pos.x-dx, pos.y);

+      control (pen code,      x-dx,     y)

+  PER  . 

+

+END PROC draw;

+ 

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+  IF pen code = draw code

+  THEN cursor (x position, y position);

+       out (record)

+  FI  .

+

+x position:

+  (pos.x-1) DIV 8 + 1  .

+

+y position:

+  (pos.y-1) DIV 12 + 1  .

+

+END PROC draw;

+

+PROC control (INT CONST code, x, y):

+  control (code, x check, y check, ack)  .

+

+x check:

+  IF x < 0

+  THEN 0

+  ELIF x > h max

+  THEN h max

+  ELSE x FI  . 

+

+y check:

+  IF y =< 0

+  THEN v max

+  ELIF y >= v max

+  THEN 0

+  ELSE v max-y FI  .

+

+END PROC control;

+ 

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  get cursor (t, x, y, -1, -1, -1, -1)

+END PROC get cursor;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1):

+  check;

+  init cursor;

+  REP set cursor;

+      get step;

+      set cursor;

+      move cursor

+  PER  .

+

+init cursor:

+  INT VAR delta := 1;

+  x := pos.x;

+  y := pos.y  .

+

+set cursor:

+  IF x0 > 0 AND y0 > 0

+  THEN control (move code, x0, v max-y0, ack);

+       control (xor  code, x, v max-y, ack)

+  FI;

+  IF x1 > 0 AND y1 > 0

+  THEN control (move code, x1, v max-y1, ack);

+       control (xor  code, x, v max-y, ack)

+  FI;

+  control (move code, x-4, v max-y, ack);

+  control (xor  code, x+5, v max-y, ack);

+  control (move code, x, v max-y-4, ack);

+  control (xor  code, x, v max-y-4, ack)  .

+

+get step:

+  t := incharety (1);

+  IF t <> ""

+  THEN IF delta < 10

+       THEN delta INCR delta

+       ELSE delta INCR 1 FI

+  ELSE delta := 1;

+       inchar (t)

+  FI  .

+

+move cursor:

+  SELECT code (t) OF

+  CASE 2 : x INCR delta

+  CASE 3 : y INCR delta

+  CASE 8 : x DECR delta

+  CASE 10: y DECR delta

+  OTHERWISE leave get cursor ENDSELECT;

+  check  .

+

+leave get cursor:

+  control (move code, pos.x, pos.y);

+  LEAVE get cursor  .

+

+check :

+  IF x < 0

+  THEN x := 0; out (""7"")

+  ELIF x > h max

+  THEN x := h max; out (""7"") FI; 

+

+  IF y < 0

+  THEN y := 0; out (""7"")

+  ELIF y > v max

+  THEN y := v max; out (""7"") FI  .

+

+END PROC get cursor;

+

+(* Bildwiederholspeicheraufbau des Pic 400:                              *)

+(* 45 Blöcke (0...44) enthalten den Bildwiederholspeicher.               *)

+

+PROC get screen (DATASPACE VAR ds, INT CONST page):

+  INT VAR i, n, begin :: 45*page;

+  FOR i FROM 0 UPTO 44

+  REP block in (ds, begin+i, -1, i, n) PER

+END PROC get screen;

+

+PROC put screen (DATASPACE CONST ds, INT CONST page):

+  INT VAR i, n, begin :: 45*page;

+  FOR i FROM 0 UPTO 44

+  REP block out (ds, begin+i, -1, i, n) PER

+END PROC put screen;

+

+END PACKET pic plot;

diff --git a/app/mpg/1987/src/PICTURE.ELA b/app/mpg/1987/src/PICTURE.ELA
new file mode 100644
index 0000000..d5e00fa
--- /dev/null
+++ b/app/mpg/1987/src/PICTURE.ELA
@@ -0,0 +1,521 @@
+PACKET picture DEFINES                            (*Autor: H.Indenbirken *)

+               PICTURE,                           (*Stand: 23.02.1985    *)

+               :=, CAT, nilpicture,

+               draw, draw r, draw cm, draw cm r,

+               move, move r, move cm, move cm r, 

+               bar, circle,

+               length, dim, pen, where,

+               extrema, rotate, stretch, translate,

+               text, picture, plot:

+

+LET draw key      = 1,

+    move key      = 2,

+    text key      = 3,

+    move r key    = 4,

+    draw r key    = 5,

+    move cm key   = 6, 

+    draw cm key   = 7,

+    move cm r key = 8,

+    draw cm r key = 9,

+    bar key       = 10,

+    circle key    = 11,

+    max 2 dim     = 31983,

+    max 3 dim     = 31975,

+    max text      = 31974,

+    max bar       = 31982,

+    max circle    = 31974,

+    max length    = 32000;

+

+

+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);

+

+

+INT VAR i, read pos, key;

+REAL VAR x, y, z;

+TEXT VAR t, r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0"", i2 :: ""0""0""0""0"";

+

+OP := (PICTURE VAR l, PICTURE CONST r) :

+  CONCR (l) := CONCR (r)

+END OP :=;

+

+OP CAT (PICTURE VAR l, PICTURE CONST r) :

+  IF l.dim <> r.dim

+  THEN errorstop ("OP CAT : left dimension <> right dimension")

+  ELIF length (l.points) > max length - length (r.points)

+  THEN errorstop ("OP CAT : Picture overflow") FI;

+

+  l.points CAT r.points

+END OP CAT;

+

+PICTURE PROC nilpicture :

+  PICTURE : (0, 1, "")

+END PROC nilpicture;

+

+PROC draw (PICTURE VAR p, TEXT CONST text) :

+  draw (p, text, 0.0, 0.0, 0.0)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):

+  write (p, text, angle, height, bright, text key)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, draw key)

+END PROC draw;

+

+PROC draw (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, draw key)

+END PROC draw;

+

+PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, draw r key)

+END PROC draw r;

+

+PROC draw r (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, draw r key)

+END PROC draw r;

+

+PROC draw cm (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, draw cm key)

+END PROC draw cm;

+

+PROC draw cm r (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, draw cm r key)

+END PROC draw cm r;

+

+PROC move (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, move key)

+END PROC move;

+

+PROC move (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, move key)

+END PROC move;

+

+PROC move r (PICTURE VAR p, REAL CONST x, y, z) :

+  check dim (p, 3);

+  write (p, x, y, z, move r key)

+END PROC move r;

+

+PROC move r (PICTURE VAR p, REAL CONST x, y) :

+  check dim (p, 2);

+  write (p, x, y, move r key)

+END PROC move r;

+

+PROC move cm (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, move cm key)

+END PROC move cm;

+

+PROC move cm r (PICTURE VAR p, REAL CONST x, y) :

+  write (p, x, y, move cm r key)

+END PROC move cm r;

+

+PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):

+  write (p, width, height, pattern, bar key)

+END PROC bar;

+

+PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):

+  write (p, radius, from, to, pattern, circle key)

+END PROC circle;

+

+

+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) :

+  IF length (p.points) < max 3 dim

+  THEN p.points CAT code (key); 

+       replace (r3, 1, x);

+       replace (r3, 2, y);

+       replace (r3, 3, z);

+       p.points CAT r3

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) :

+  IF length (p.points) < max 2 dim

+  THEN p.points CAT code (key); 

+       replace (r2, 1, x);

+       replace (r2, 2, y);

+       p.points CAT r2

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) :

+  IF length (p.points) < max bar

+  THEN p.points CAT code (key); 

+       replace (r2, 1, x);

+       replace (r2, 2, y);

+       p.points CAT r2;

+       replace (i1, 1, n);

+       p.points CAT i1

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) :

+  IF length (p.points) < max circle 

+  THEN p.points CAT code (key); 

+       replace (r3, 1, x);

+       replace (r3, 2, y);

+       replace (r3, 3, z);

+       p.points CAT r3;

+       replace (i1, 1, n);

+       p.points CAT i1 

+  ELSE errorstop ("Picture overflow") FI

+END PROC write;

+

+PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright,

+            INT CONST key) :

+  IF max text - length (p.points) >= length (t)

+  THEN p.points CAT code (key);

+       replace (i1, 1, length (t));

+       p.points CAT i1;

+       p.points CAT t;

+       replace (r3, 1, angle);

+       replace (r3, 2, height);

+       replace (r3, 3, bright);

+       p.points CAT r3

+  FI;

+END PROC write;

+

+PROC check dim (PICTURE VAR p, INT CONST dim):

+  IF p.dim = 0

+  THEN p.dim := dim

+  ELIF p.dim <> dim

+  THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI

+END PROC check dim;

+

+INT PROC length (PICTURE CONST p):

+  length (p.points)

+END PROC length;

+

+INT PROC dim (PICTURE CONST pic) :

+  pic.dim

+END PROC dim;

+

+PROC pen (PICTURE VAR p, INT CONST pen) :

+  IF pen < 0 OR pen > 16

+  THEN errorstop ("pen out of range [0-16]") FI;

+  p.pen := pen

+END PROC pen;

+

+INT PROC pen (PICTURE CONST p) :

+  p.pen

+END PROC pen;

+

+PROC where (PICTURE CONST p, REAL VAR x, y) :

+  IF p.dim = 0

+  THEN x := 0.0;  y := 0.0

+  ELIF p.dim = 3

+  THEN errorstop ("Picture is 3 dimensional")

+  ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;

+       y := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1

+  FI

+END PROC where;

+

+PROC where (PICTURE CONST p, REAL VAR x, y, z) :

+  IF p.dim = 0

+  THEN x := 0.0;  y := 0.0;  z := 0.0

+  ELIF p.dim = 2

+  THEN errorstop ("Picture is 2 dimensional")

+  ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;

+       y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;

+       z := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1;

+  FI

+END PROC where;

+

+

+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :

+  x min := max real;  x max :=-max real;

+  y min := max real;  y max :=-max real;

+  z min := max real;  z max :=-max real;

+  read pos := 0; 

+  INT CONST pic length := length (p.points);

+  WHILE read pos < pic length

+  REP check position PER  .

+

+check position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : calc extrema

+  CASE move key : calc extrema

+  CASE move r key : calc rel extrema

+  CASE draw r key : calc rel extrema

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+calc extrema :

+  x := next real;  y := next real;  z := next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y);

+  z min := min (z min, z);  z max := max (z max, z)  .

+

+calc rel extrema :

+  x INCR next real;  y INCR next real;  z INCR next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y);

+  z min := min (z min, z);  z max := max (z max, z)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC extrema;

+

+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):

+  x min := max real;  x max :=-max real;

+  y min := max real;  y max :=-max real;

+  read pos := 0; 

+  INT CONST pic length := length (p.points);

+  WHILE read pos < pic length

+  REP check position PER  .

+

+check position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : calc extrema

+  CASE move key : calc extrema

+  CASE move r key : calc rel extrema

+  CASE draw r key : calc rel extrema

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+calc extrema :

+  x := next real;  y := next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y)  .

+

+calc rel extrema :

+  x INCR next real;  y INCR next real;

+  x min := min (x min, x);  x max := max (x max, x);

+  y min := min (y min, y);  y max := max (y max, y)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC extrema;

+

+PROC rotate (PICTURE VAR p, REAL CONST angle) :

+  REAL CONST s :: sind( angle ), c := cosd( angle );

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : ( 1.0,  0.0,  0.0 ),

+                ROW 3 REAL : ( 0.0,   c ,   s  ),

+                ROW 3 REAL : ( 0.0,  -s ,   c  ),

+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))

+END PROC rotate;

+

+PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :

+  REAL CONST s   :: sind ( theta ), c   :: cosd ( theta ),

+             s p :: sind (  phi  ), s l :: sind ( lambda ),

+             ga  :: cosd (  phi  ), c l :: cosd ( lambda ),

+             be  :: s p * s l,      al  :: s p * c l, c1 :: 1.0 - c;

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ),

+                ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ),

+                ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c  ),

+                ROW 3 REAL : (      0.0     ,      0.0     ,      0.0    )))

+END PROC rotate; 

+ 

+PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : 

+  stretch (pic, sx, sy, 1.0) 

+END PROC stretch;

+

+PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : ( sx, 0.0, 0.0),

+                ROW 3 REAL : (0.0,  sy, 0.0),

+                ROW 3 REAL : (0.0, 0.0,  sz),

+                ROW 3 REAL : (0.0, 0.0, 0.0)))

+END PROC stretch;

+

+PROC translate (PICTURE VAR p, REAL CONST dx, dy) : 

+  translate (p, dx, dy, 0.0) 

+END PROC translate;

+

+PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :

+  transform (p, ROW 4 ROW 3 REAL : 

+               (ROW 3 REAL : (1.0, 0.0, 0.0),

+                ROW 3 REAL : (0.0, 1.0, 0.0),

+                ROW 3 REAL : (0.0, 0.0, 1.0),

+                ROW 3 REAL : ( dx,  dy,  dz)))

+END PROC translate;

+

+PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :

+  INT CONST pic length := length (p.points);

+  INT VAR begin pos;

+  read pos := 0; 

+  x := 0.0; y := 0.0; z := 0.0;

+  IF p.dim = 2

+  THEN transform 2 dim pic

+  ELSE transform 3 dim pic FI  .

+ 

+transform 2 dim pic:

+  WHILE read pos < pic length

+  REP transform 2 dim position PER  .

+

+transform 2 dim position:

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : transform 2 dim point 

+  CASE move key : transform 2 dim point 

+  CASE move r key : transform 2 dim point 

+  CASE draw r key : transform 2 dim point 

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+transform 2 dim point:

+  begin pos := read pos+1;

+  x := next real;  y := next real;

+  transform (a, x, y, z); 

+  replace (r2, 1, x);

+  replace (r2, 2, y);

+  replace (p.points, begin pos, r2)  .

+

+transform 3 dim pic:

+  WHILE read pos < pic length

+  REP transform 3 dim position PER  .

+

+transform 3 dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : transform 3 dim point 

+  CASE move key : transform 3 dim point 

+  CASE move r key : transform 3 dim point 

+  CASE draw r key : transform 3 dim point 

+  CASE move cm key : read pos INCR 16

+  CASE draw cm key : read pos INCR 16

+  CASE move cm r key : read pos INCR 16

+  CASE draw cm r key : read pos INCR 16

+  CASE text key : read pos INCR next int + 24

+  CASE bar key : read pos INCR 18

+  CASE circle key : read pos INCR 26

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+transform 3 dim point:

+  begin pos := read pos+1;

+  x := next real;  y := next real; z := next real;

+  transform (a, x, y, z); 

+  replace (r3, 1, x);

+  replace (r3, 2, y);

+  replace (r3, 3, z);

+  replace (p.points, begin pos, r3)  .

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+END PROC transform;

+

+PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :

+  REAL CONST ox :: x, oy :: y, oz :: z;

+  x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);

+  y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);

+  z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)

+END PROC transform;

+

+TEXT PROC text (PICTURE CONST pic):

+  replace (i2, 1, pic.dim);

+  replace (i2, 2, pic.pen);

+  i2 + pic.points

+END PROC text;

+

+PICTURE PROC picture (TEXT CONST text):

+  PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5))

+END PROC picture;

+

+PROC plot (PICTURE CONST p) :

+  INT CONST pic length := length (p.points);

+  read pos := 0;

+  IF p.dim = 2

+  THEN plot two dim pic

+  ELSE plot three dim pic FI  .

+

+plot two dim pic:

+  WHILE read pos < pic length

+  REP plot two dim position PER  .

+

+plot two dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : draw (next real, next real)

+  CASE move key : move (next real, next real)

+  CASE move r key : move r (next real, next real)

+  CASE draw r key : draw r (next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+plot three dim pic:

+  WHILE read pos < pic length

+  REP plot three dim position PER  .

+

+plot three dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : draw (next real, next real, next real)

+  CASE move key : move (next real, next real, next real)

+  CASE move r key : move r (next real, next real, next real)

+  CASE draw r key : draw r (next real, next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+next text :

+  INT CONST text length :: next int;

+  read pos INCR text length;

+  subtext (p.points, read pos-text length+1, read pos)  .

+ 

+END PROC plot;

+

+END PACKET picture

diff --git a/app/mpg/1987/src/PLOTSPOL.ELA b/app/mpg/1987/src/PLOTSPOL.ELA
new file mode 100644
index 0000000..f15b13c
--- /dev/null
+++ b/app/mpg/1987/src/PLOTSPOL.ELA
@@ -0,0 +1,129 @@
+PACKET plotten spool DEFINES plot:                  #Autor: H.Indenbirken #

+                                                    #Stand: 10.02.1985    #

+LET draw key      = 1,

+    move key      = 2,

+    text key      = 3,

+    move r key    = 4,

+    draw r key    = 5,

+    move cm key   = 6, 

+    draw cm key   = 7,

+    move cm r key = 8,

+    draw cm r key = 9,

+    bar key       = 10,

+    circle key    = 11,

+    max length    = 32000;

+

+

+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);

+

+

+INT VAR i, read pos, key;

+REAL VAR x, y, z;

+TEXT VAR t;

+

+

+PROC plot (PICTURE CONST p) :

+  INT CONST pic length := length (p.points);

+  read pos := 0;

+  IF p.dim = 2

+  THEN plot two dim pic

+  ELSE plot three dim pic FI  .

+

+plot two dim pic:

+  WHILE read pos < pic length

+  REP plot two dim position PER  .

+

+plot two dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : draw (next real, next real)

+  CASE move key : move (next real, next real)

+  CASE move r key : move r (next real, next real)

+  CASE draw r key : draw r (next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+plot three dim pic:

+  WHILE read pos < pic length

+  REP plot three dim position PER  .

+

+plot three dim position :

+  read pos INCR 1;

+  SELECT code (p.points SUB read pos) OF

+  CASE draw key : draw (next real, next real, next real)

+  CASE move key : move (next real, next real, next real)

+  CASE move r key : move r (next real, next real, next real)

+  CASE draw r key : draw r (next real, next real, next real)

+  CASE move cm key : move cm (next real, next real)

+  CASE draw cm key : draw cm (next real, next real)

+  CASE move cm r key : move cm r (next real, next real)

+  CASE draw cm r key : draw cm r (next real, next real)

+  CASE text key : draw (next text, next real, next real, next real)

+  CASE bar key : bar (next real, next real, next int) 

+  CASE circle key : circle (next real, next real, next real, next int) 

+  OTHERWISE errorstop ("wrong key code") END SELECT  . 

+

+next real :

+  read pos INCR 8;

+  subtext (p.points, read pos-7, read pos) RSUB 1  .

+

+next int :

+  read pos INCR 2;

+  subtext (p.points, read pos-1, read pos) ISUB 1  .

+

+next text :

+  INT CONST text length :: next int;

+  read pos INCR text length;

+  subtext (p.points, read pos-text length+1, read pos)  .

+ 

+END PROC plot;

+

+LET max pics = 1024,

+    pic dataspace = 1102;

+

+

+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,

+                             ROW 16 ROW 3 INT pens,

+                             ROW 16 BOOL hidden,

+                             ROW 3 ROW 2 REAL sizes,

+                             ROW 2 ROW 2 REAL limits,

+                             ROW 4 REAL angles,

+                             ROW 2 REAL obliques,

+                             ROW 3 REAL perspectives

+                             ROW max pics PICTURE pic);

+

+PICFILE VAR p;

+

+PROC plot (DATASPACE VAR ds):

+  IF type (ds) = pic dataspace

+  THEN CONCR (p) :: old (ds);

+       plot (p)

+  ELSE errorstop ("Dataspace is no PICFILE") FI;

+END PROC plot;

+

+PROC plot (PICFILE VAR p) :

+  set values (p.sizes, p.limits, p.angles, p.obliques,

+              p.perspectives);

+  begin plot;

+  clear;

+  FOR i FROM 1 UPTO p.size

+  REP IF pen (p.pic [i]) <> 0

+      THEN plot pic FI

+  PER;

+  end plot  .

+

+plot pic:

+  pen (p.background, p.pens (pen (p.pic (i)))(1),

+       p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3));

+  hidden lines (p.hidden [pen (p.pic [i])]);

+  plot (p.pic (i))  .

+

+END PROC plot;

+

+END PACKET plotten spool 

diff --git a/app/mpg/1987/src/PUBINSPK.ELA b/app/mpg/1987/src/PUBINSPK.ELA
new file mode 100644
index 0000000..0650c20
--- /dev/null
+++ b/app/mpg/1987/src/PUBINSPK.ELA
@@ -0,0 +1,654 @@
+PACKETmpgtestelanprogramsDEFINESelantest:LETs17=0,s30="",s31="***  ELAN TEST VOR

+ZEITIG ABGEBROCHEN ***",s33=1000,s34=1,s35="line exceeding screen",s37="comment 

+exceeding line",s38="text denoter too long (",s39=" characters)",s40="text denot

+er exceeding source line",s43=" ""("" open",s44=" ""["" open",s46=";",s47=".",

+s48="(",s49=")",s50="[",s51="]",s53=" ""("" open at end of unit",s54=" ""["" ope

+n at end of unit",s57=77,s58="=",s59="EUMEL - Datei     :  ",s60=" Zeilen ,  ",

+s61="Elan  - Quelltext :  ",s62=" Units  ,  ",s63=" Scanner - Operationen durchg

+efuehrt.",s66="dito   ",s67="dito",s68="EOLN ",s69="  ",s74=10,s75="00",s76=100,

+s77="0",s78=" Byte";LETs1=7,s2=8,s3=9,s4=2,s5=4,s6=6,s7=77,s8=255,s9="ENDIFIENDS

+ELECTENDREPEATPERENDPROCEDURENDPACKETENDOP",s10="WARNING: ",s11="ERROR  : ";INT

+ VARs12;FILE VARs13;TEXT VARs14;PROCelantest:elantest(lastparam)ENDPROCelantest;

+PROCelantest(TEXT CONSTs15):INT VARs16:=s17,s18:=s17,s19:=s17,s20:=s17,s21:=s17,

+s22:=s17,s23,s24:=s17,s25:=s17,s26:=s17;TEXT VARs27,s28;FILE VARs29:=

+sequentialfile(input,s15);s13:=notefile;s12:=s17;s14:=s30;scan(s30);nextsymbol(

+s27);WHILE NOTeof(s29)REPs32;s36;s27:=incharetyUNTILs27<>s30PER;IFs27<>s30THEN

+putline(s13,s31)FI;s14:=s30;s56;modify(s29);noteedit(s29);line.s32:getline(s29,

+s27);continuescan(s27);s16INCR LENGTHs27;s18INCRs16DIVs33;s16:=s16MODs33;s12INCR

+s34;cout(s12);IF LENGTHs27>s7THENs64(s10+s35)FI.s36:REPEATnextsymbol(s28,s23);

+s24INCRs34;s41UNTILs23>=s1PER;IFs23=s2THENs64(s10+s37)FI;IFs23=s3THENs21INCR

+ LENGTHs28;IFs21>s8THENs64(s11+s38+text(s21)+s39)ELSEs64(s10+s40)FI ELSEs21:=s17

+FI;s20INCRs19DIVs33;s19:=s19MODs33.s41:IFs23=s1THENs42ELIFs23=s6THENs45ELIFs23=

+s5THENs21INCR LENGTHs28;IFs21>s8THENs64(s11+s38+text(s21)+s39)FI ELIFs23=s4CAND

+pos(s9,s28)<>s17THENs52FI;s19INCR LENGTHs28.s42:IFs25<>s17THENs64(s10+text(s25)+

+s43)FI;IFs26<>s17THENs64(s10+text(s26)+s44)FI.s45:IFs28=s46OR(s28=s47ANDs55)THEN

+s52ELIFs28=s48THENs25INCRs34ELIFs28=s49THENs25DECRs34ELIFs28=s50THENs26INCRs34

+ELIFs28=s51THENs26DECRs34FI.s52:s22INCRs34;IFs25<>s17THENs64(s11+text(s25)+s53);

+s25:=s17FI;IFs26<>s17THENs64(s11+text(s26)+s54);s26:=s17FI.s55:FALSE.s56:line(

+s13);putline(s13,s57*s58);putline(s13,s59+text(s12)+s60+s70(s18,s16));putline(

+s13,s61+text(s22)+s62+s70(s20,s19));putline(s13,text(s24)+s63);putline(s13,s57*

+s58).ENDPROCelantest;PROCs64(TEXT CONSTs65):IFs65=s14THENputline(s13,s66+text(

+s12));IFonlineTHENput(s12);putline(s67)FI;LEAVEs64FI;s14:=s65;putline(s13,s68+

+text(s12)+s69+s65);IFonlineTHENput(s12);putline(s65)FI ENDPROCs64;TEXT PROCs70(

+INT CONSTs71,s72):TEXT VARs73:=text(s71);IFs72<s74THENs73CATs75ELIFs72<s76THEN

+s73CATs77FI;s73CATtext(s72);s73CATs78;s73ENDPROCs70ENDPACKETmpgtestelanprograms;

+PACKETmpgarchivesystemDEFINESreserve,archive,release,archiv,archivname,

+archiverror,archivangemeldet,from,to,pla:LETs90="",s98="Unbekannte Laufwerksnumm

+er",s99="Gefundenes Archiv: """,s100="""",s101=""13""10"",s103="Archiv nicht ang

+emeldet",s105=1,s106=13,s107="Archiv heisst",s108=16,s116=70,s117="=",s119="_",

+s121="Archiv eingelegt",s123="PLA",s125=5,s126="ARCHIVNAME: ",s127="  ",s128=" "

+,s129="Date      Store  Contents",s131=6,s132="-",s135=3,s136="Archivlisting dru

+cken";LETs79=90,s80=91,s81=0,s82=1,s83=2,s84=1,s85=20,s86=19,s87="configurator";

+BOOL VARs88;TEXT VARs89:=s90;PROCreserve(TASK CONSTs91):reserve(s90,s91)ENDPROC

+reserve;PROCreserve(TEXT CONSTs92,TASK CONSTs91):IFs91=archiveTHENs88:=TRUE FI;

+call(s86,s92,s91)ENDPROCreserve;PROCarchive(TEXT CONSTs93):reserve(s93,archive)

+ENDPROCarchive;PROCarchive(TEXT CONSTs93,INT CONSTs94):reserve(s93,s94/archive)

+ENDPROCarchive;PROCarchive(TEXT CONSTs93,TASK CONSTs91):reserve(s93,s91)ENDPROC

+archive;PROCrelease(TASK CONSTs91):call(s85,s90,s91);IFs91=archiveTHENs88:=FALSE

+ FI ENDPROCrelease;PROCrelease:release(archive);ENDPROCrelease;PROCarchiv(INT

+ CONSTs95):SELECTs95OF CASEs81,s82:s96CASEs83:archivOTHERWISEs97ENDSELECT.s96:IF

+station(myself)<>s84THENs97ELSEreserve(archive);SELECTs95OF CASEs81:call(s79,s90

+,task(s87))CASEs82:call(s80,s90,task(s87))ENDSELECT;archivFI.s97:errorstop(s98)

+ENDPROCarchiv;PROCarchiv:s88:=TRUE;TEXT CONSTs93:=archivname;IFs89=s90THEN

+display(s99+s93+s100);ELSEerrorstop(s89)FI;display(s101).ENDPROCarchiv;BOOL PROC

+archivangemeldet:s88ENDPROCarchivangemeldet;TEXT PROCarchivname:TEXT VARs93:=s90

+;THESAURUS VARs102;IF NOTs88THENerrorstop(s103);s90ELSEs88:=FALSE;s89:=s90;

+disablestop;archive(s90);IFiserrorTHENs89:=errormessage;LEAVEarchivnameWITHs90FI

+;s102:=ALLarchive;s104;clearerror;enablestop;archive(s93);s88:=TRUE;s93FI.s104:

+IFsubtext(errormessage,s105,s106)=s107THENs93:=subtext(errormessage,s108,LENGTH

+errormessage-s105)ELSEs89:=errormessageFI ENDPROCarchivname;TEXT PROCarchiverror

+:s89ENDPROCarchiverror;PROCfrom(TEXT CONSTs93):fetch(s93,archive)ENDPROCfrom;

+PROCto(TEXT CONSTs93):BOOL CONSTs109:=commanddialogue;commanddialogue(FALSE);

+save(s93,archive);commanddialogue(s109)ENDPROCto;PROCto:to(lastparam)ENDPROCto;

+PROCfrom(THESAURUS CONSTs110):fetch(s110,archive)ENDPROCfrom;PROCto(THESAURUS

+ CONSTs110):BOOL CONSTs109:=commanddialogue;commanddialogue(FALSE);save(s110,

+archive);commanddialogue(s109)ENDPROCto;PROCpla:pla(TRUE)ENDPROCpla;PROCpla(BOOL

+ CONSTs111):LETs112=18;FILE VARs113;INT VARs114;TEXT CONSTs115:=s116*s117,s118:=

+s116*s119;TEXT VARs120;WHILEyes(s121)REPs122UNTIL NOTs111PER;release.s122:archiv

+;s113:=sequentialfile(output,s123);list(s113,archive);s124;s130;s133;s134.s124:

+modify(s113);toline(s113,s105);FORs114FROMs105UPTOs125REPinsertrecord(s113)PER;

+toline(s113,s105);writerecord(s113,s115);down(s113);writerecord(s113,s126+

+headline(s113)+s127+timeofday+s127+date);down(s113);writerecord(s113,s115);down(

+s113);writerecord(s113,s128);down(s113);writerecord(s113,s129).s130:toline(s113,

+s131);WHILE NOTeof(s113)REPreadrecord(s113,s120);IF(s120SUBs112)=s132THEN

+deleterecord(s113)ELSEdown(s113)FI PER.s133:output(s113);putline(s113,s118).s134

+:modify(s113);edit(s113);line(s135);IFyes(s136)THENprint(s123)FI;forget(s123,

+quiet)ENDPROCplaENDPACKETmpgarchivesystem;PACKETmpgsomeDEFINESsome,SOME,one,

+inchar,center,invers,editsome,editone,reorganize:LETs139=" ",s140=1,s144=2,s145=

+0,s148=""7"",s162=04,s163="-",s164="> "15"weitere  Eintraege "14"",s165=52,s200=

+"",s203="Fenster zu klein",s206=""5"",s209=3,s210=5,s212=6,s213=""8"",s219="-> "

+,s220=" > ",s222="----> ",s225="""",s226=""5""13""10"",s228=79,s235=40,s245=4,

+s261=7,s262=8,s263=9,s267="Bitte warten !",s283="-> """,s284=""11"",s285=""2"",

+s306="!",s310=" INFO : Auswahl mehrerer Dateien ",s311=" INFO : Auswahl einer Da

+tei ",s312="q19",s320="zum Editieren",s324="Datei ",s325=30,s326=" wird reorgani

+siert :",s327="      ",s328=" ist keine Datei.",s330=""15"   Mit den angekreuzte

+n Namen wird die gewaehlte Operation ausgefuehrt     "14"",s331="        "15"   

+Positionierungen: "14" ",s332="              Oben         : zum vorausgehenden N

+amen",s333="              Unten        : zum folgenden Namen    ",s334="        

+      HOP Oben     : zum ersten  Namen der (vorigen) Seite",s335="              

+HOP Unten    : zum letzten Namen der (vorigen) Seite",s336="              HOP RE

+TURN   : aktuelle Zeile wird erste Zeile",s337="              ESC 1        : zum

+ ersten  Namen der Liste",s338="              ESC 9        : zum letzten Namen d

+er Liste",s339="              ESC s        : Liste nach Nummern ordnen",s340="  

+      "15"   Auswahl treffen: "14" ",s341="              ( Folgende Befehle sind

+ nur bei einer )",s342="              ( Auswahl von mehreren Namen M"218"glich. 

+)",s343="              RETURN bzw. x: diesen Namen ankreuzen     ",s344="       

+       RUBOUT bzw. o: Kreuz vor dem Namen loeschen",s345="              HOP x   

+     : alle Namen ankreuzen      ",s346="              HOP o        : alle Kreuz

+e loeschen     ",s347="              ESC x        : alle folgenden Namen ankreuz

+en",s348="              ESC o        : alle folgenden Kreuze loeschen",s349="   

+           RUBIN        : einen neuen Namen eintragen",s350="              ( Nur

+ dieser Befehl kann benutzt werden , wenn )",s351="              ( die Auswahl e

+ines ! Namens m"218"glich ist.      )",s352="              RETURN bzw. x: diesen

+ Namen auswaehlen",s353="         "15"  Auswahl verlassen: "14"",s354="         

+       ESC q        : Auswaehlen beenden     ",s355="                ESC a      

+  : Auswahl abbrechen (ohne Kreuze !)",s356=""15"             Zum Verlassen des 

+Infos bitte 'ESC q' tippen!                 "14"";LETs137=80;TEXT PROCcenter(

+TEXT CONSTs138):center(s138,s139,s137-s140)ENDPROCcenter;TEXT PROCcenter(TEXT

+ CONSTs138,s141,INT CONSTs142):TEXT VARs143:=((s142-length(s138))DIVs144)*s141;

+s143CAT(s138+s143);IF(LENGTHs143)-s142=s145THENs143ELSEs143+s141FI ENDPROCcenter

+;TEXT PROCinvers(TEXT CONSTs138):s157+s138+s139+s158ENDPROCinvers;PROCinchar(

+TEXT VARs146,TEXT CONSTs147):REPgetchar(s146);IFpos(s147,s146)=s145THENout(s148)

+FI UNTILpos(s147,s146)<>s145PER ENDPROCinchar;LETs149=3,s150=24,s151=200;LETs152

+=""222"",s153=""1""27""3""10""13"x"12"o?"11"",s154=""3""10""12"o"13"x",s155="q19

+a"13"x"12"os";LETs156=""13""10"",s157=""15"",s158=""14"";LETs159="Auswahl einer 

+Datei      ( Bei Unklarheiten bitte <?> )",s160="Auswahl mehrerer Dateien ( Bei 

+Unklarheiten bitte <?> )";TEXT CONSTs161:=s162*s163+s164+s165*s163;LETs166=1,

+s167=2,s168=3,s169=4,s170=5,s171=6,s172=7,s173=8,s174=9,s175=10;LETs176=1003;INT

+ VARs177,s178,s179,s180,s181,s182,s183;TEXT VARs184,s185,s186,s187;BOOL VARs188,

+s189;ROWs151TEXT VARs190;THESAURUS VARs191;FILE VARs192;DATASPACE VARs193;

+INITFLAG VARs194;THESAURUS PROCs195(THESAURUS CONSTs146,BOOL CONSTs196,TEXT

+ CONSTs197,INT CONSTs198,s199):IF NOTinitialized(s194)THENs329FI;s178:=s198;s180

+:=s199;s186:=s197;s184:=s200;s179:=s145;s185:=s200;s231;IFgroesstereditor>s145

+THEN INT VARs201,s202;geteditcursor(s201,s202);IFs150-s179-s149<s202THENs178:=

+s140ELSEs178:=s202;s181:=s180-s178-s149-s179+s140FI FI;IF(s199-s198-s179)<s149OR

+s198<s145ORs199>s150THENerrorstop(s203)FI;THESAURUS VARs204:=emptythesaurus;s191

+:=s146;INT VARs205;s177:=s145;FORs205FROMs140UPTOhighestentry(s146)REP IFname(

+s146,s205)<>s200THENs177INCRs140;s190[s177]:=name(s146,s205)FI PER;IFs177=s145

+THEN LEAVEs195WITHs204FI;s236;s189:=FALSE;s237(s196);IFs189THEN LEAVEs195WITH

+s204FI;cursor(s140,s180);out(s206);s207;s204.s207:TEXT VARs208;WHILEs184<>s200

+REPs208:=subtext(s184,s140,s209);s184:=subtext(s184,s210);insert(s204,s190[int(

+s208)])PER ENDPROCs195;PROCs211:cursor(s140,s179+s182+s178);out(s214(s183,TRUE)+

+s212*s213)ENDPROCs211;TEXT PROCs214(INT CONSTs215,BOOL CONSTs216):INT VARs217:=

+s307(s215);IFs217=s145THENs221ELSEs218FI.s218:IFs216THEN(s209-length(text(s217))

+)*s163+text(s217)+s219ELSEtext(s217,s209)+s220FI.s221:IFs216THENs222ELSEs212*

+s139FI ENDPROCs214;PROCs223(INT CONSTs224):cursor(s140,s179+s178);INT VARs205;

+s227;FORs205FROMs224UPTOs230REPout(s214(s205,FALSE));putline(s225+s190[s205]+

+s225+s206)PER;s229;IFs230<s224+s181THENout((s224+s181-s177)*s226);out(s206)FI.

+s227:IFs182=s183THENout(s228*s163)ELSEout(s161)FI;line.s229:IF NOT((s183+s181-

+s182)<=s177)ORs230=s177THENout(s228*s163)ELSEout(s161)FI.s230:min(s177,s224+s181

+)ENDPROCs223;PROCs231:IFpos(s186,s152)>s145THENs232ELIFs186<>s200ANDlength(s186)

+<s137THENs185CATs186;s185CATs156;s179:=s140ELIFs186<>s200THENs232FI;IFs179>s180-

+s178-s149THENs179:=s180-s178-s149FI;s181:=s180-s178-s149-s179+s140.s232:s187:=

+s186;REPs179INCRs140;s233;s185CATsubtext(s187,s140,pos(s187,s152)-s140);s185CAT

+s156;s187:=subtext(s187,pos(s187,s152)+s140);UNTILpos(s187,s152)=s145PER;IFs187

+<>s200THENs185CATs187;s185CATs156;s179INCRs140FI.s233:IF(pos(s187,s152)>s137OR

+pos(s187,s152)=s145)ANDlength(s187)>s137THENs234FI.s234:INT VARs205;FORs205FROM

+s137DOWNTOs235REP UNTIL(s187SUBs205)=s139PER;s187:=subtext(s187,s140,s205)+s152+

+subtext(s187,s205+s140)+s152ENDPROCs231;PROCs236:cursor(s140,s178);out(s185);

+s183:=s140;s182:=s140;s223(s140);s211ENDPROCs236;PROCs237(BOOL CONSTs196):s188:=

+FALSE;REPs238;s240UNTILs188PER.s238:TEXT VARs239;inchar(s239,s153).s240:SELECT

+pos(s153,s239)OF CASEs166:s242(s196)CASEs167:s260(s196)CASEs168:s293CASEs169:

+s298CASEs170:s276(s196,FALSE);s241CASEs171:s276(s196,TRUE);s241CASEs172:s279CASE

+s173:s279CASEs174:s308(s196)CASEs175:s280;IFs190[s183]<>s200THENs241FI ENDSELECT

+.s241:IF NOTs196THEN LEAVEs237FI ENDPROCs237;PROCs242(BOOL CONSTs196):s243;s240.

+s243:TEXT VARs244;getchar(s244).s240:SELECTpos(s154,s244)OF CASEs145:out(s148)

+CASEs140:s249CASEs144:s254CASEs209,s245:s248CASEs210:s246CASEs212:IFs196THENs247

+ELSEout(s148)FI ENDSELECT.s246:s182:=s140;s223(s183);s211.s247:INT VARs205;FOR

+s205FROMs140UPTOs177REP IFs307(s205)=s145THENs184CATs304(s205)FI PER;s290;s211.

+s248:s184:=s200;s290;s211.s249:IFs250THENout(s148)ELIFs251THENs252ELSEs253FI.

+s250:s183=s140.s251:s182=s140.s252:s183DECR(s181+s140);s183:=max(s183,s140);s223

+(s183);s211.s253:s303;s183DECR(s182-s140);s182:=s140;s211.s254:IFs255THENout(

+s148)ELIFs256THENs257ELSEs259FI.s255:s183=s177.s256:s182>s181.s257:INT VARs258:=

+s183;s183INCR(s181+s140);s183:=min(s183,s177);s182:=s183-s258;s223(s258+s140);

+s211.s259:s303;s258:=s183;s183INCR(s181+s140-s182);s183:=min(s177,s183);s182INCR

+(s183-s258);s211ENDPROCs242;PROCs260(BOOL CONSTs196):TEXT VARs244;getchar(s244);

+SELECTpos(s155,s244)OF CASEs145:out(s148)CASEs140:s188:=TRUE CASEs144:s273CASE

+s209:s274CASEs245:s189:=TRUE;s188:=TRUE CASEs210,s212:IFs196THENs272ELSEout(s148

+)FI CASEs261,s262:IFs196THENs268ELSEout(s148)FI CASEs263:s264ENDSELECT.s264:

+THESAURUS VARs265:=emptythesaurus;TEXT VARs208,s266:=s200;cursor(s140,s180);out(

+center(invers(s267),s163,s137-s140));s205:=s145;WHILEs184<>s200REPs205INCRs140;

+s208:=subtext(s184,s140,s209);s184:=subtext(s184,s210);insert(s265,s190[int(s208

+)]);s266CATs304(s205)PER;s177:=s145;s184:=s266;s191:=s265+s191;FORs205FROMs140

+UPTOhighestentry(s191)REP IFname(s191,s205)<>s200THENs177INCRs140;s190[s177]:=

+name(s191,s205)FI PER;cursor(s140,s180);out(s206);s236.s268:INT VARs269;FORs269

+FROMs183UPTOs177REP INT VARs270:=s307(s269);IFs270<>s145THENs271FI PER;s290;s211

+.s271:s184:=subtext(s184,s140,s245*s270-s245)+subtext(s184,s245*s270+s140).s272:

+INT VARs205;FORs205FROMs183UPTOs177REP IFs307(s205)=s145THENs184CATs304(s205)FI

+ PER;s290;s211.s273:IFs183=s140THENout(s148)ELIFs183=s182THENs303;s183:=s140;

+s182:=s140;s211ELSEs183:=s140;s182:=s140;s223(s140);s211FI.s274:IFs183=s177THEN

+out(s148)ELIFs275THENs303;s182INCR(s177-s183);s183:=s177;s211ELSEs183:=s177;s182

+:=s181+s140;s223(s177-s181);s211FI.s275:(s182+s177-s183)<s181+s140ENDPROCs260;

+PROCs276(BOOL CONSTs196,s277):INT VARs217:=s307(s183);IFs217<>s145THENout(s148);

+s278;LEAVEs276FI;s184CATs304(s183);IFs196THENs278FI.s278:IFs277THENs211ELSE IF

+s183<s177THENs298FI;IFs183=s177THENs211FI FI ENDPROCs276;PROCs279:INT VARs270:=

+s307(s183);IFs270=s145THENout(s148);LEAVEs279FI;s271;s303;s290;s211.s271:s184:=

+subtext(s184,s140,s245*s270-s245)+subtext(s184,s245*s270+s140)ENDPROCs279;PROC

+s280:IFs177=s151THENout(s148);LEAVEs280FI;s281;s282;s289.s281:INT VARs205;FOR

+s205FROMs177DOWNTOs183REPs190[s205+s140]:=s190[s205]PER;s190[s183]:=s225;s177

+INCRs140;s288;s184CATs304(s183);s289.s282:INT VARs217:=s307(s183);cursor(s140,

+s179+s182+s178);out(s206+(s209-length(text(s217)))*s163+text(s217)+s283);push(

+s284);editget(s190[s183]);IF(s286SUBlength(s286))=s225THENs286:=subtext(s286,

+s140,length(s286)-s140)FI;IFs190[s183]=s200THENs279;s287ELSEcursor(s140,s179+

+s182+s178);putline(s212*s285+s225+s190[s183]+s225)FI.s286:s190[s183].s287:FOR

+s205FROMs183UPTOs177-s140REPs190[s205]:=s190[s205+s140];change(s184,s304(s205+

+s140),s304(s205))PER;s177DECRs140.s288:FORs205FROMs177-s140DOWNTOs183REPchange(

+s184,s304(s205),s304(s205+s140))PER.s289:s223(s183-(s182-s140));s290;s211ENDPROC

+s280;PROCs290:INT VARs291,s292,s205;s291:=s183-s182+s140;s292:=min(s291+s181,

+s177);cursor(s140,s179+s140+s178);FORs205FROMs291UPTOs292REPout(s214(s205,FALSE)

+);linePER ENDPROCs290;PROCs293:IFs294THENs295ELSEout(s148)FI.s294:s183>s140.s295

+:IFs182=s140THENs296ELSEs297FI.s296:s183DECRs140;s223(s183);s211.s297:s303;s183

+DECRs140;s182DECRs140;s211ENDPROCs293;PROCs298:IFs299THENs300ELSEout(s148)FI.

+s299:s183<s177.s300:IFs182>s181THENs301ELSEs302FI.s301:s183INCRs140;s223(s183-

+s181);s211.s302:s303;s183INCRs140;s182INCRs140;s211ENDPROCs298;PROCs303:out(s214

+(s183,FALSE))ENDPROCs303;TEXT PROCs304(INT CONSTs305):text(s305,s209)+s306

+ENDPROCs304;INT PROCs307(INT CONSTs215):IFpos(s184,s304(s215))=s145THENs145ELSE(

+pos(s184,s304(s215))DIVs245)+s140FI ENDPROCs307;PROCs308(BOOL CONSTs309):modify(

+s192);IFs309THENheadline(s192,s310);ELSEheadline(s192,s311);FI;toline(s192,s140)

+;openeditor(groesstereditor+s140,s192,FALSE,s140,s178,s228,s180-s178+s140);edit(

+groesstereditor,s312,PROC(TEXT CONST)stdkommandointerpreter);s236ENDPROCs308;

+THESAURUS PROCsome(THESAURUS CONSTs146,TEXT CONSTs313,INT CONSTs198,s199):s195(

+s146,TRUE,s313,s198,s199)ENDPROCsome;THESAURUS PROCsome(THESAURUS CONSTs146):

+some(s146,center(invers(s160)),s140,s150)ENDPROCsome;THESAURUS PROCsome:s195(all

+,TRUE,center(invers(s160)),s140,s150)ENDPROCsome;THESAURUS PROCsome(TEXT CONST

+s314):some(ALLs314)ENDPROCsome;THESAURUS PROCsome(TASK CONSTs315):some(ALLs315)

+ENDPROCsome;THESAURUS OP SOME(THESAURUS CONSTs316):some(s316)ENDOP SOME;

+THESAURUS OP SOME(TASK CONSTs317):some(ALLs317)ENDOP SOME;THESAURUS OP SOME(TEXT

+ CONSTs314):some(ALLs314)ENDOP SOME;TEXT PROCone(THESAURUS CONSTs146,TEXT CONST

+s318,INT CONSTs198,s199):name(s195(s146,FALSE,s318,s198,s199),s140)ENDPROCone;

+TEXT PROCone(THESAURUS CONSTs146):one(s146,center(invers(s159)),s140,s150)

+ENDPROCone;TEXT PROCone(TASK CONSTs315):one(ALLs315)ENDPROCone;TEXT PROCone:one(

+all)ENDPROCone;TEXT PROCone(TEXT CONSTs314):one(ALLs314)ENDPROCone;PROCeditone:

+TEXT CONSTs319:=one(all,center(invers(s159))+s152+center(invers(s320)),s140,s150

+);IFs319<>s200CAND(NOTexists(s319)CORtype(old(s319))=s176)THENedit(s319)FI

+ ENDPROCeditone;PROCeditsome:THESAURUS CONSTs321:=some(all,center(invers(s160))+

+s152+center(invers(s320)),s140,s150);INT VARs205;FORs205FROMs140UPTOhighestentry

+(s321)REP TEXT VARs319:=name(s321,s205);IFs319<>s200CAND(NOTexists(s319)CORtype(

+old(s319))=s176)THENedit(s319)FI PER ENDPROCeditsome;PROCreorganize(THESAURUS

+ CONSTs146):page;do(PROC(TEXT CONST)s322,s146)ENDPROCreorganize;PROCs322(TEXT

+ CONSTs323):IFtype(old(s323))=s176THENput(s324+center(invers(s225+s323+s225),

+s139,s325)+s326);reorganize(s323)ELSEput(s327+center(invers(s225+s323+s225),s139

+,s325)+s328)FI;lineENDPROCs322;PROCs329:s193:=nilspace;s192:=sequentialfile(

+output,s193);putline(s192,s330);line(s192);putline(s192,s331);line(s192);putline

+(s192,s332);putline(s192,s333);putline(s192,s334);putline(s192,s335);putline(

+s192,s336);putline(s192,s337);putline(s192,s338);putline(s192,s339);line(s192);

+putline(s192,s340);line(s192);putline(s192,s341);putline(s192,s342);line(s192);

+putline(s192,s343);putline(s192,s344);putline(s192,s345);putline(s192,s346);

+putline(s192,s347);putline(s192,s348);putline(s192,s349);line(s192);putline(s192

+,s350);putline(s192,s351);line(s192);putline(s192,s352);line(s192);putline(s192,

+s353);line(s192);putline(s192,s354);putline(s192,s355);line(s192);putline(s192,

+s356);ENDPROCs329;ENDPACKETmpgsome;PACKETmpgdmDEFINESdm:LETs364="PUBLIC",s374="k

+",s375="q",s377="",s379=27,s380=" ",s381="V O R M O N I T O R ",s382=4,s383="t",

+s384="Task einstellen, mit der  kommuniziert werden soll",s385="p",s386="Es soll

+ mit 'PUBLIC'      kommuniziert werden",s387="v",s388="Es soll mit der Vatertask

+ kommuniziert werden",s389="a",s390="Es soll mit dem Archiv    kommuniziert werd

+en",s391="Programm beenden",s393="Bitte Eingabe :",s394="tvapq",s395=0,s397="tva

+p",s399="ARCHIVE",s402=1,s403=20,s404=""7""15"FEHLER: ",s405=""14"",s407=14,s408

+="Neue Task:",s409="Mit der eigenen Task kann nicht kommuniziert werden.",s416=2

+,s417="Task ist nicht im Wartezustand",s420=15,s423="ARCHIVE ist nicht im Wartez

+ustand",s428=5,s429=" Erst Diskette einlegen !",s430=100,s432=24,s433="D A T E I

+ M O N I T O R ",s434=3,s435="Auflisten aller Dateien in dieser Task",s436="l",

+s437="Loeschen    von Dateien in dieser Task",s438="Archiv: ",s439="Task  : ",

+s440=40,s441="'",s442=" ...",s443="""",s447="des Archivs",s448="zum Archiv",s449

+="vom Archiv",s450="in  ",s451="zu  ",s452="von ",s453="u",s454="Uebersicht uebe

+r alle Dateien ",s455="s",s456="Senden von Dateien            ",s457="h",s458="H

+olen von Dateien             ",s459="c",s460="'Checken' von Dateien         ",

+s461="Vernichten von Dateien        ",s462="d",s463="Drucken einer Liste der Dat

+eien des Archivs",s464="f",s465="Formatieren einer Diskette",s466="i",s467="Init

+ialisieren/vollstaendiges Loeschen des Archivs",s468="n",s469="Neue Diskette anm

+elden",s470="Zurueck zum Vormonitor",s472="   Bitte warten...",s473=6,s474=7,

+s475=8,s476=9,s477=10,s478=11,s479=12,s482=""15"",s483=" "14"",s484=" ... ",s486

+="Formatieren einer Diskette.",s487="===========================",s488=""15"Acht

+ung: Alle Disketten-Informationen werden gel"218"scht!"14"",s489="Dies sind die 

+moeglichen Formate:",s490="o",s491="... Ohne Format-Angabe",s492="0",s493="... S

+tandard-Format",s494="1",s495="... 40 Spur -  360 KB",s496="2",s497="... 80 Spur

+ -  720 KB",s498="3",s499="... IBM Std - 1200 KB",s500="... Es wird nicht format

+iert.",s502="Ihre Wahl:",s503="o01234q",s504="zuk"219"nftiger Name des Archives 

+:",s508="Liste der eigenen Task",s510="Loeschen von Dateien ",s511="  Info mit <

+?>",s512="Bitte alle zu loeschenden Dateien ankreuzen",s513="(Ankreuzen mit <RET

+URN> )",s516="Bitte warten...",s521="nicht reserviert",s522="Haben Sie die Diske

+tte eingelegt und das Laufwerk geschlossen",s524=""15"Sie muessen unbedingt erst

+ das Archiv reservieren, "14"",s525=""15"sonst kann ich nicht darauf zugreifen! 

+"14"",s527="Dateiliste",s533=""15"'Checken' von Dateien  (auf dem Archiv) "14"",

+s534="Bitte alle zu 'checkenden' Dateien ankreuzen",s537=""15"Schreiben von Date

+ien "14" Info mit <?>",s538="Bitte alle zu schreibenden Dateien ankreuzen.",s542

+=" <--- """,s544="Bitte Warten",s545="-",s546=80,s548="Zuerst Dateien auf der Di

+skette loeschen?",s553=""15"Holen von Dateien "14"  Info mit <?>",s554="Bitte al

+le zu holenden Dateien ankreuzen.",s555=" --> """,s558=""15"Vernichten (Loeschen

+) von Dateien "14" Info mit <?>",s559="Bitte alle zu loeschenden Dateien ankreuz

+en.",s562=""15"Vollstaendiges Loeschen des Archivs "14"",s563="Eingestellter Arc

+hivname: ",s564="Moechten Sie einen anderen Namen fuer das Archiv",s566="Bitte d

+en Namen fuer das Archiv (maximal 30 Buchstaben):",s567="Der neue Archivname ist

+ zu lang!",s569="Bitte Fehler beseitigen und Vorgang wiederholen!",s576="keine d

+iskette",s577=""15"Ich mache die Reservierung rueckgaengig! "14"",s578="inkonsis

+tent",s579=""15"Diskette ist nicht formatiert / initialisiert "14"",s580="Lesen 

+unmoeglich",s581="Schreiben unmoeglich",s582=""15"Die Diskette ist falsch eingel

+egt "14"",s583=""15"oder das Laufwerk ist nicht geschlossen "14"",s584=""15"oder

+ die Diskette ist nicht formatiert !"14"",s585="Archiv heisst",s586="?????",s587

+=""15"Diskette nicht lesbar ! (Name: '?????') "14"",s588=""15"Moeglicherweise is

+t die Diskette defekt ! "14"",s589=""15"Diskette wurde mit anderem Namen angemel

+det!"14"",s590="Bitte neu reservieren!",s592="Bitte den Fehler beseitigen und da

+s Archiv neu reservieren !",s594="Zum Weitermachen bitte irgendeine Taste tippen

+!";LETs357=""15"",s358=""14"",s359=""222"",s360=24,s361="alnfqushcvdi",s362="al 

+ qush v";TASK CONSTs363:=task(s364);TASK VARs365;BOOL VARs366:=archivangemeldet,

+s367,s368:=FALSE;TEXT VARs369,s370,s371;PROCdm:TEXT VARs372,s373:=

+lernsequenzauftaste(s374);REPs376UNTILs372=s375PER;lernsequenzauftastelegen(s374

+,s373).s376:s365:=s363;s392;IFs372<>s375ANDs370<>s377THENs424FI.s378:s370:=name(

+s365);page;write(s379*s380);write(s357);write(s381);write(s358);line(s382);s480(

+s383,s384);s480(s385,s386);s480(s387,s388);s480(s389,s390);s480(s375,s391).s392:

+IFisincharety(s377)THENs378FI;line;write(s393);inchar(s372,s394);out(s372);line;

+IFpos(s389,s372)=s395CANDs365=archiveTHENs574FI;s396.s396:IFpos(s397,s372)<>s395

+THENs398FI.s398:s370:=s377;IFs372=s389THENs370:=s399ELIFs372=s385THENs370:=s364

+ELIFs372=s387THENs370:=name(father)ELSEs406FI;TEXT VARs400;BOOL VARs401:=s370=

+s377CORs370=s364CORs410(s370,s400);IF NOTs401THENcursor(s402,s403);putline(s404+

+s400+s405);pause;s370:=s377;FI;IFs370=s377THENs365:=s363ELIFs370=s399THENs365:=

+archiveELSEs365:=task(s370)FI.s406:REPcursor(s402,s407);put(s408);editget(s370);

+line;IFs370=name(myself)THENputline(s409)FI;UNTILs370<>name(myself)PER;

+lernsequenzauftastelegen(s374,s370).ENDPROCdm;BOOL PROCs410(TEXT CONSTs411,TEXT

+ VARs412):disablestop;TASK VARs413:=task(s411);IFiserrorTHENs412:=errormessage;

+clearerror;enablestop;FALSE ELSEs414FI.s414:IFs411<>s399THENs415ELSEs422FI.s415:

+IFstatus(s413)<>s416THENs412:=s417;enablestop;FALSE ELSEs418FI.s418:INT CONST

+s419:=s420;DATASPACE VARs421:=nilspace;call(s419,s377,s421,s413);forget(s421);IF

+iserrorTHENs412:=errormessage;clearerror;enablestop;FALSE ELSEs412:=s377;

+enablestop;TRUE FI.s422:IFstatus(archive)<>s416THENs412:=s423;LEAVEs422WITH

+ FALSE FI;archive(s377);IFiserrorTHENs412:=errormessage;clearerror;enablestop;

+FALSE ELSEenablestop;s366:=TRUE;s368:=FALSE;s412:=s377;TRUE FI ENDPROCs410;PROC

+s424:s367:=(s365=archive);TEXT VARs425;IFs367THENs425:=s361ELSEs425:=s362FI;TEXT

+ VARs426;INT VARs427;s368:=FALSE;IFs367THENs514FI;REP IFisincharety(s377)THEN

+s431FI;line;write(s393);inchar(s426,s425);s427:=pos(s361,s426);IFs427>s428AND

+ NOTs368ANDs367THENline;putline(s429);pause(s430)ELIFs426<>s380THENs471FI UNTIL

+s426=s375PER;IFarchivangemeldetTHENs574FI.s431:page;write(s432*s380);write(s357)

+;write(s433);write(s358);line(s434);s480(s389,s435);s480(s436,s437);line(s416);

+write(s420*s380);IFs367THENwrite(s438)ELSEwrite(s439)FI;IFs367THEN IFs368THEN IF

+length(s369)>s440THENwrite(s441+subtext(s369,s402,s440)+s442)ELSEwrite(invers(

+s443+s369+s443))FI FI ELSEwrite(invers(s443+s370+s443))FI;line(s416);TEXT VAR

+s444,s445,s446;IFs367THENs444:=s447;s445:=s448;s446:=s449ELSEs444:=s450+s370;

+s445:=s451+s370;s446:=s452+s370FI;s480(s453,s454+s444);s480(s455,s456+s445);s480

+(s457,s458+s446);IFs367THENs480(s459,s460+s444)FI;s480(s387,s461+s444);IFs367

+THENs480(s462,s463);s480(s464,s465);s480(s466,s467);s480(s468,s469);FI;line(s402

+);s480(s375,s470).s471:out(s380+s426+s472);SELECTs427OF CASEs402:s505CASEs416:

+s509CASEs434:s572CASEs382:s485CASEs428:CASEs473:s526CASEs474:s535CASEs475:s551

+CASEs476:s531CASEs477:s556CASEs478:s570CASEs479:s560ENDSELECT ENDPROCs424;PROC

+s480(TEXT CONSTs413,s481):putline(s475*s380+s482+s413+s483+s484+s481)ENDPROCs480

+;PROCs485:page;putline(s486);putline(s487);putline(s488);line;putline(s489);s480

+(s490,s491);s480(s492,s493);s480(s494,s495);s480(s496,s497);s480(s498,s499);s480

+(s375,s500);TEXT VARs501;put(s502);inchar(s501,s503);IFs501=s375THEN LEAVEs485FI

+;out(s501);line;put(s504);editget(s369);line;archive(s369);s368:=TRUE;

+disablestop;IFs501=s490THENformat(archive)ELSEformat(int(s501),archive)FI;IF

+iserrorTHENs595(errormessage);clearerror;s368:=FALSE ELSEs369:=archivnameFI;

+enablestopENDPROCs485;PROCs505:DATASPACE VARs506:=nilspace;FILE VARs507:=

+sequentialfile(output,s506);list(s507);headline(s507,s508);modify(s507);toline(

+s507,s402);show(s507);forget(s506)ENDPROCs505;PROCs509:s371:=center(invers(s510)

++s511)+s359+center(s512)+s359+center(invers(s513));forget(some(all,s371,s402,

+s360))ENDPROCs509;PROCs514:TEXT VARs515;page;cursor(s402,s402);write(s516);line(

+s416);s517(s515);IFs515<>s377THENpage;line(s477);write(s482+s515+s483);s593;s368

+:=FALSE;s366:=FALSE;LEAVEs514FI;s519(s369,s515);IFs515<>s377THENs575(s515)FI.

+ENDPROCs514;PROCs517(TEXT VARs518):s518:=s377;IFs366THEN LEAVEs517FI;disablestop

+;archive(s377);IFiserrorTHENs518:=errormessage;s366:=FALSE;clearerror;enablestop

+;ELSEs366:=TRUE;s518:=s377;enablestopFI ENDPROCs517;PROCs519(TEXT VARs520,s518):

+page;line(s434);s518:=s377;IF NOTs366THENs520:=s377;s368:=FALSE;s518:=s521;LEAVE

+s519FI;IFyes(s522)THENline;write(s516);s520:=archivname;IFarchiverror<>s377THEN

+s518:=archiverror;s368:=FALSE ELSEs368:=TRUE FI ELSEs368:=FALSE;s520:=s377FI

+ ENDPROCs519;PROCs523:page;line(s474);write(s524);line(s416);write(s525);line(

+s416);s593ENDPROCs523;PROCs526:forget(s527,quiet);s528;s529;s530;forget(s527,

+quiet).s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs526FI.s529:FILE VARs507:=

+sequentialfile(output,s527);disablestop;list(s507,s365);IFiserrorTHENpage;IFs367

+THENs575(errormessage)FI;clearerror;enablestop;LEAVEs526;ELSEenablestopFI.s530:

+show(s507)ENDPROCs526;PROCs531:s528;s532.s528:IFs367ANDs368AND NOTs366THENs523;

+LEAVEs531FI.s532:s371:=center(s533)+s359+center(s534);disablestop;check(some(ALL

+s365,s371,s402,s360),s365);s593;IFiserrorTHEN IFs367THENs575(errormessage)FI;

+clearerror;enablestop;LEAVEs531ELSEenablestop;FI ENDPROCs531;PROCs535:s528;s536.

+s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs535FI.s536:s371:=center(s537)+s359+

+center(s538)+s359+center(invers(s513));THESAURUS VARs539:=some(ALLmyself,s371,

+s402,s360);s543;INT VARs540;TEXT VARs541;page;FORs540FROMs402UPTOhighestentry(

+s539)REPs541:=name(s539,s540);disablestop;IFs541<>s377THENputline(s370+s542+s541

++s443);save(s541,s365)FI;IFiserrorTHEN IFs367THENs575(errormessage)FI;clearerror

+;enablestop;LEAVEs535FI;enablestopPER.s543:IFs367CAND(s549(s539))THENout(center(

+invers(s544),s545,s546));THESAURUS CONSTs547:=s539/ALLs365;IFs549(s547)THENpage;

+putline(s548);erase(s547,s365)FI FI ENDPROCs535;BOOL PROCs549(THESAURUS CONST

+s413):INT VARs550;FORs550FROMs402UPTOhighestentry(s413)REP IFname(s413,s550)<>

+s377THEN LEAVEs549WITH TRUE FI PER;FALSE ENDPROCs549;PROCs551:s528;s552.s528:IF

+s367ANDs368AND NOTs366THENs523;LEAVEs551FI.s552:s371:=center(s553)+s359+center(

+s554);THESAURUS VARs539:=some(ALLs365,s371,s402,s360);INT VARs540;TEXT VARs541;

+page;FORs540FROMs402UPTOhighestentry(s539)REPs541:=name(s539,s540);disablestop;

+IFs541<>s377THENputline(s370+s555+s541+s443);fetch(s541,s365)FI;IFiserrorTHEN IF

+s367THENs575(errormessage)FI;clearerror;enablestop;LEAVEs551ELSEenablestopFI PER

+ ENDPROCs551;PROCs556:s528;s557.s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs556

+FI.s557:s371:=center(s558)+s359+center(s559);disablestop;erase(some(ALLs365,s371

+,s402,s360),s365);IFiserrorTHEN IFs367THENs575(errormessage)FI;clearerror;

+enablestop;LEAVEs556ELSEenablestop;FI ENDPROCs556;PROCs560:TEXT VARs561;page;

+line(s416);write(center(s562));line(s416);IFs366ANDs368THENwrite(s563+invers(

+s443+s369+s443));line(s416);IFyes(s564)THENline(s416);s565ELSEs561:=s369FI ELSE

+s565FI;s568.s565:write(s566);line;getline(s561);s561:=compress(s561);IFlength(

+s561)>s440THENline(s416);write(s567);s593;LEAVEs560FI.s568:disablestop;s369:=

+s561;archive(s561);IFiserrorTHENs595(errormessage);line;write(s569);clearerror;

+enablestop;s593;s368:=FALSE;s366:=FALSE;LEAVEs560ELSEclear(archive);IFiserror

+THENpage;line(s416);s575(errormessage);clearerror;enablestop;s593;s368:=FALSE;

+LEAVEs560ELSEs369:=archivname;s368:=archiverror=s377FI FI ENDPROCs560;PROCs570:

+s528;s571;s593.s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs570FI.s571:pla(FALSE)

+.ENDPROCs570;PROCs572:s528;s573.s528:IF NOTs366THENs514;LEAVEs572FI.s573:TEXT

+ VARs515;page;cursor(s402,s402);write(s516);line(s416);s519(s369,s515);IFs515<>

+s377THENs575(s515)FI.ENDPROCs572;PROCs574:s366:=FALSE;s368:=FALSE;

+commanddialogue(FALSE);release(archive);commanddialogue(TRUE)ENDPROCs574;PROC

+s575(TEXT CONSTs515):line(s416);IFs515=s521THENs523;ELIFs515=s576THENwrite(s577)

+;s591ELIFpos(s515,s578)>s395THENwrite(s579);s591;ELIFpos(s515,s580)>s395CORpos(

+s515,s581)>s395THENwrite(s582);line(s416);write(s583);line(s416);write(s584);

+s591;ELIFpos(s515,s585)>s395ANDpos(s515,s586)>s395THENwrite(s587);line(s416);

+write(s588);s591;ELIFpos(s515,s585)>s395THENwrite(invers(s515));line(s416);write

+(s589);line(s416);write(s590);s593ELSEwrite(invers(s515));s591FI ENDPROCs575;

+PROCs591:line(s416);write(s592);s593;s368:=FALSE ENDPROCs591;PROCs593:line(s416)

+;write(s594);pauseENDPROCs593;PROCs595(TEXT CONSTs515):page;line(s477);write(

+invers(s515));s593ENDPROCs595ENDPACKETmpgdm;PACKETmpgtoolsDEFINESput,th,gen:LET

+s596="E",s597=""27""2""27"p"27"qedit ("27"g)"13"",s599="TRUE",s600="FALSE",s606=

+"***",s607="-->",s608=""13""10"",s610=77,s611="=",s612=" wird insertiert"13""10"

+",s619="gen.",s622=0,s623="GENERIERUNG VON ",s624=16,s626=1,s627=2,s628="Bitte e

+ntfernen Sie Ihre Diskette aus dem Laufwerk!",s630="global manager";

+lernsequenzauftastelegen(s596,s597);PROCput(BOOL CONSTs598):IFs598THENput(s599)

+ELSEput(s600)FI ENDPROCput;PROCth(THESAURUS CONSTs601):THESAURUS VARs602:=SOME

+s601;s602:=emptythesaurusENDPROCth;BOOL VARs603:=FALSE;PROCs604(TEXT CONSTs605):

+IFexists(s605)THENdisplay(s606)ELSE IF NOTs603THENarchiv;s603:=TRUE FI;display(

+s607);from(s605)FI;display(s605+s608)ENDPROCs604;PROCs609(TEXT CONSTs605):line;

+out(s610*s611+s608);out(s605+s612);insert(s605);forget(s605,quiet)ENDPROCs609;

+LETs613=20;ROWs613TEXT VARs614;INT VARs615,s616;PROCgen:TEXT CONSTs617:=name(

+myself),s618:=s619+s617;TEXT VARs620;BOOL VARs621:=TRUE;s603:=FALSE;s615:=s622;

+s616:=s622;page;putline(s623+s617);putline((s624+length(s617))*s611);s604(s618);

+FILE VARs625:=sequentialfile(input,s618);WHILE NOTeof(s625)ANDs616<s613REP

+getline(s625,s620);s620:=compress(s620);IFs620=s618THENs621:=FALSE FI;IFs621THEN

+s615INCRs626FI;s616INCRs626;s604(s620);s614[s616]:=s620PER;forget(s618,quiet);IF

+s603THENrelease;line(s627);put(s628);lineFI;INT VARs629;FORs629FROMs626UPTOs615

+REPs609(s614[s629])PER;IFyes(s630)THENdo(s630)FI.ENDPROCgenENDPACKETmpgtools;

+PACKETtargethandlingDEFINES TARGET,initializetarget,completetarget,

+deleteintarget,selecttarget,actualtargetname,actualtargetset,targetnames:LETs638

+="Bezeichner bereits vorhanden",s640=0,s641="";TYPE TARGET=STRUCT(INTs631,

+THESAURUSs632,s633);LETs634=0;PROCinitializetarget(TARGET VARs635):s635.s633:=

+emptythesaurus;s635.s632:=emptythesaurus;s635.s631:=s634ENDPROCinitializetarget;

+PROCcompletetarget(TARGET VARs635,TEXT CONSTs636,s637):IF NOT(s635.s632CONTAINS

+s636)THENinsert(s635.s632,s636);insert(s635.s633,s637)ELSEerrorstop(s638)FI

+ ENDPROCcompletetarget;PROCdeleteintarget(TARGET VARs635,TEXT CONSTs636):INT

+ CONSTs639:=link(s635.s632,s636);delete(s635.s632,s639);delete(s635.s633,s639);

+s635.s631:=s634ENDPROCdeleteintarget;PROCselecttarget(TARGET VARs635,TEXT CONST

+s636,TEXT VARs637):INT VARs639:=link(s635.s632,s636);IFs639<>s640THENs637:=name(

+s635.s633,s639);s635.s631:=s639ELSEs637:=s641FI ENDPROCselecttarget;TEXT PROC

+actualtargetname(TARGET CONSTs635):IFs635.s631=s634THENs641ELSEname(s635.s632,

+s635.s631)FI ENDPROCactualtargetname;TEXT PROCactualtargetset(TARGET CONSTs635):

+IFs635.s631=s634THENs641ELSEname(s635.s633,s635.s631)FI ENDPROCactualtargetset;

+THESAURUS PROCtargetnames(TARGET CONSTs635):s635.s632ENDPROCtargetnamesENDPACKET

+targethandling;PACKETmpgprintcmdDEFINESprint,selectprinter,installprinters,

+listprinters,printer,printers:LETs650="",s654=1,s656=24,s660=0;TARGET VARs642;

+LETs643="PRINTER",s644="PRINTER AUSWAHL";LETs645=""222"";TARGET PROCprinters:

+s642ENDPROCprinters;PROCinstallprinters(FILE VARs646):initializetarget(s642);

+TEXT VARs647,s648;TEXT VARs649:=s650,s651:=s650;WHILE NOTeof(s646)REP TEXT VAR

+s652;getline(s646,s652);IFs652<>s650THEN INT CONSTs653:=pos(s652,s645);s647:=

+subtext(s652,s654,s653-s654);s648:=subtext(s652,s653+s654);completetarget(s642,

+s647,s648);IFint(s647)=station(myself)THENs649:=s647;s651:=s648FI FI PER;

+selecttarget(s642,s649,s651);IFs651<>s650THENfonttable(s651)FI ENDPROC

+installprinters;PROCselectprinter:TEXT VARs655;selecttarget(s642,one(targetnames

+(s642),s644,s654,s656),s655);IFs655<>s650THENfonttable(s655)FI ENDPROC

+selectprinter;PROClistprinters:th(targetnames(s642))ENDPROClistprinters;PROC

+print:print(lastparam)ENDPROCprint;PROCprint(TEXT CONSTs657):save(s657,printer)

+ENDPROCprint;PROCprint(THESAURUS CONSTs658):save(s658,printer)ENDPROCprint;TASK

+ PROCprinter:INT VARs659:=int(actualtargetname(s642));IFs659=s660THENniltaskELSE

+s659/s643FI ENDPROCprinterENDPACKETmpgprintcmd;PACKETeditmonitorDEFINES

+editmonitor,close,F,table:LETs670="quitmonitor:1.0edit:2.1run:3.1insert:4.1",

+s671="forget:5.1rename:6.2copy:7.2fetch:8.1",s672="save:9.1close:10.1fileinfo:11

+.0reorganize:12.1",s684=0,s689="",s698="Q",s702=""1""8""1""12"quitmonitor"13"",

+s703=1,s704="Editmonitor overflow: Bereits ",s705="Monitore geoeffnet",s708="

+"10"",s711=22,s715=""3"",s716="      ",s717=""13""10"      ",s718="fk",s719="

+"27"k",s720=""13""5"",s721="f",s722=7,s725=50,s728=4,s730=""1"",s731=2,s732=" : 

+",s733="""",s734=""5""10""13"",s735=""5"",s737=5,s738=" ",s739=11,s740="=",s741=

+16,s742="  ",s745=3,s746=6,s747=8,s748=9,s749=10,s750=12,s754=""7"",s765="Maxima

+l 10 Parallel-Editoren",s774=79,s775=25,s776=24,s778="Undefinierter Index [1;15]

+",s780=""5"? ",s781=""13""10"",s782=""2"",s783="Datei neu einrichten",s795=120;

+LETs661=18,s662=15,s663=1003,s664=24,s665=3,s666=4711,s667="Gib Edit-Monitor ",

+s668=" Kommando :";TEXT CONSTs669:=s670+s671+s672;LET SGHD=ROWs662STRUCT(

+THESAURUSs674,TEXTs675,FILEs676);LETs677=0,s678=1,s679=2;INT VARs680,s681,s682,

+s683:=s684,s685;TEXT VARs686,s687,s688:=s689,s690:=s689;BOOL VARs691,s692:=FALSE

+,s693:=FALSE;INITFLAG VARs694;SGHD VARs695;PROCeditmonitor:TEXT VARs696,s697:=

+lernsequenzauftaste(s698);INT VARs699,s700:=heapsize;disablestop;s701;s756;REP

+s706;s712;s743;s727UNTILs693PER;lernsequenzauftastelegen(s698,s697);s726.s701:

+lernsequenzauftastelegen(s698,s702);s693:=FALSE;s683INCRs703;IFs683>s662THENs683

+DECRs703;errorstop(s704+text(s662)+s705)ELSE IF NOTinitialized(s694)THEN FORs699

+FROMs703UPTOs662REPs695[s699].s674:=emptythesaurus;s695[s699].s675:=s689PER FI;

+FORs699FROMs703UPTOs662REPs695[s699].s675:=name(s695[s683].s674,s699)PER FI.s706

+:s707;s729.s707:out(s708);INT VARs709,s710;getcursor(s709,s710);FORs709FROMs703

+UPTOs710-s711REPout(s708)PER;s685:=max(s661,min(s710+s703,s711)).s712:BOOL VAR

+s713:=FALSE,s714:=FALSE;IFiserrorTHENs690:=s688;out(s715);puterror;clearerror;

+s714:=TRUE ELSEs690:=s689FI;out(s716);out(s798);out(s717);IF NOTs714THENs723FI;

+IFs713THENs680:=s666;LEAVEs712FI;editget(s690,s689,s718,s696);IFs696=s719THENout

+(s720);s690:=s688;out(s716);editget(s690,s689,s721,s696)FI;line;s688:=s690;s680

+:=s796(s690);paramposition(LENGTHs690+s722);IF(s680>s684ANDs680<=s662)ANDs682>

+s684THENs691:=TRUE ELSEs691:=FALSE;analyzecommand(s669,s690,s665,s680,s681,s686,

+s687)FI.s723:BOOL VARs724;s696:=getcharety;IFs696<>s689THENpush(s696);LEAVEs723

+FI;s696:=incharety(s725);IFs696<>s689THENtype(s696);LEAVEs723FI;FORs699FROMs703

+UPTOs662REPreorganize(s695[s699].s675,s713,s724,s699);UNTILs724ORs713PER.s726:

+s683DECRs703;s680:=s684;s693:=s683=s684;IFs683>s684THEN FORs699FROMs703UPTOs662

+REPs695[s699].s675:=name(s695[s683].s674,s699)PER;ELSEs686:=s689;s687:=s689;s690

+:=s689;s688:=s689FI.s727:IFheapsize>s700+s728THENcollectheapgarbage;s700:=

+heapsizeFI ENDPROCeditmonitor;PROCs729:INT VARs699;out(s730);FORs699FROMs703UPTO

+s662WHILE NOTisincharetyREPout(text(s699,s731));out(s732);IFs692THENs736FI;IF

+s695[s699].s675<>s689THENout(s733+s695[s699].s675+s733)FI;out(s734)PER;out(s735)

+;cursor(s703,s685).s736:IFexists(s695[s699].s675)THEN IFtype(old(s695[s699].s675

+))=s663THENout(text(lines(s695[s699].s676),s737));out(s738);out(text(segments(

+s695[s699].s676),s728));out(s738)ELSEout(s739*s740)FI;out(text(storage(old(s695[

+s699].s675)),s737))ELIFs695[s699].s675<>s689THENout(s741*s740)FI;out(s742).

+ENDPROCs729;PROCs743:enablestop;IFs680=s666THEN LEAVEs743FI;IFs691THENs761(s680)

+ELSEs744FI.s744:SELECTs680OF CASEs703:s693:=TRUE CASEs731:edit(s785(s686))CASE

+s745:run(s785(s686))CASEs728:insert(s785(s686))CASEs737:forget(s785(s686));close

+(int(s686))CASEs746:rename(s785(s686),s785(s687))CASEs722:copy(s785(s686),s785(

+s687))CASEs747:fetch(s785(s686))CASEs748:save(s785(s686))CASEs749:close(int(s686

+))CASEs739:s692:=NOTs692CASEs750:reorganize(s785(s686))OTHERWISEdo(s690)

+ENDSELECT ENDPROCs743;PROCclose(INT CONSTs751):IF(s751>s684ANDs751<=s662)CAND

+s695[s751].s675<>s689THEN IFexists(s695[s751].s675)CANDtype(old(s695[s751].s675)

+)=s663THENclose(s695[s751].s676)FI;INT VARs752;delete(s695[s683].s674,s695[s751]

+.s675,s752);s695[s751].s675:=s689FI ENDPROCclose;TEXT OP F(INT CONSTs753):IFs753

+>s684ANDs753<=s662THENs695[s753].s675ELSEout(s754);s689FI ENDOP F;OP F(INT CONST

+s753,TEXT CONSTs755):IFs753>s684ANDs753<=s662THENs695[s753].s675:=s755;insert(

+s695[s683].s674,s755);IFexists(s755)CANDtype(old(s755))=s663THENs695[s753].s676

+:=sequentialfile(modify,s755)FI ELSEout(s754)FI ENDOP F;PROCs756:table(some(all+

+s695[s683].s674+s757)).s757:IFs683=s703THENemptythesaurusELSEs695[s683-s703].

+s674FI ENDPROCs756;THESAURUS PROCtable:THESAURUS VARs758:=emptythesaurus;INT VAR

+s699;FORs699FROMs703UPTOs662REP IFexists(s695[s699].s675)AND NOT(s758CONTAINS

+s695[s699].s675)THENinsert(s758,s695[s699].s675)FI PER;s758ENDPROCtable;PROC

+table(THESAURUS CONSTs759):INT VARs699,s753:=s703,s709;TEXT VARs760;s695[s683].

+s674:=emptythesaurus;FORs699FROMs703UPTOs662REPs695[s699].s675:=s689PER;FORs699

+FROMs703UPTOhighestentry(s759)REPget(s759,s760,s709);IFs760<>s689THENs753Fs760;

+s753INCRs703FI UNTILs753>s662PER ENDPROCtable;PROCs761(INT CONSTs762):enablestop

+;IFs682=s703THENs763ELSEs764FI.s763:SELECTs777(s762)OF CASEs678:lastparam(s695[

+s762].s675);edit(s695[s762].s676);pageCASEs679:do(s695[s762].s675)ENDSELECT.s764

+:IFs682<=s749THENs766;IFgroesstereditor>s684THENedit(s703);WHILEgroesstereditor>

+s684REPquitPER;pageFI ELSEerrorstop(s765)FI.s766:TEXT VARs767,s768:=s689;INT VAR

+s769:=s703,s770:=s762,s771;WHILEgroesstereditor>s684REPquitPER;FORs771FROMs703

+UPTOs731REP IFs771=s731THENs690:=s768FI;scan(s690);nextsymbol(s767);REP INT VAR

+s772:=s777(s770);IFs771=s703THEN SELECTs772OF CASEs677:s682DECRs703CASEs678:s768

+CAT(s767+s738)CASEs679:s768CAT(s767+s738);s682DECRs703ENDSELECT ELSE SELECTs772

+OF CASEs678:s773CASEs679:do(s695[s770].s675);IFgroesstereditor>s684THEN

+bildzeigen;ueberschriftzeigenFI ENDSELECT FI;nextsymbol(s767);s770:=int(s767)

+UNTILs767=s689PER;s770:=s762;PER.s773:openeditor(groesstereditor+s703,s695[s770]

+.s676,TRUE,s703,s769,s774,s775-s769);s769INCR(s776DIVs682)ENDPROCs761;INT PROC

+s777(INT CONSTs762):IFs762>s684ANDs762<=s662THEN IFs695[s762].s675=s689THENs779;

+IFs695[s762].s675<>s689THEN IFexists(s695[s762].s675)THEN IFtype(old(s695[s762].

+s675))=s663THENs678ELSEs677FI ELSEs679FI ELSEs677FI ELIF NOTexists(s695[s762].

+s675)THENs679ELIFtype(old(s695[s762].s675))<>s663THENs677ELSEmodify(s695[s762].

+s676);s678FI ELSEerrorstop(s778);s677FI.s779:cursor(s728,s762);out(s780);editget

+(s695[s762].s675);IFs695[s762].s675<>s689THENs762Fs695[s762].s675;IF NOTexists(

+s695[s762].s675)THENout(s781);IFno(s737*s782+s783)THEN LEAVEs777WITHs677ELSEs784

+FI ELIFtype(old(s695[s762].s675))=s663THENs784FI FI.s784:s695[s762].s676:=

+sequentialfile(output,s695[s762].s675).ENDPROCs777;BOOL PROCisincharety:TEXT VAR

+s696:=getcharety;IFs696=s689THEN FALSE ELSEpush(s696);TRUE FI ENDPROCisincharety

+;TEXT PROCs785(TEXT CONSTs786):INT VARs699:=int(s786);IF(s699>s684ANDs699<=s662)

+THENs695[s699].s675ELSEs786FI.ENDPROCs785;PROCreorganize(TEXT CONSTs755,BOOL VAR

+s787,s788,INT CONSTs789):DATASPACE VARs790;FILE VARs791,s792;TEXT VARs760;INT

+ VARs793,s699,s794,s710;getcursor(s794,s710);s788:=FALSE;IF NOTexists(s755)COR

+type(old(s755))<>s663THEN LEAVEreorganizeFI;s791:=sequentialfile(modify,s755);

+s793:=lineno(s791);input(s791);IF(lines(s791)<s795CANDsegments(s791)<s746)COR

+lines(s791)DIVsegments(s791)>=s664THENmodify(s791);toline(s791,s793);LEAVE

+reorganizeFI;disablestop;s790:=nilspace;s792:=sequentialfile(output,s790);IFs692

+THEN FORs699FROMs703UPTOlines(s791)REPcursor(s728,s789);put(s699);getline(s791,

+s760);putline(s792,s760);IFiserrorCORisincharetyTHENs724FI PER ELSE FORs699FROM

+s703UPTOlines(s791)REPgetline(s791,s760);putline(s792,s760);IFiserrorCOR

+isincharetyTHENs724FI PER FI;copyattributes(s791,s792);modify(s792);toline(s792,

+s793);forget(s755,quiet);copy(s790,s755);forget(s790);s787:=TRUE.s724:cursor(

+s728,lines(s791));forget(s790);s788:=TRUE;cursor(s794,s710);enablestop;LEAVE

+reorganize.ENDPROCreorganize;INT PROCs796(TEXT CONSTs690):INT VARs797,s758:=s684

+;TEXT VARs767;s682:=s684;scan(s690);REPnextsymbol(s767,s797);IFs797=s745THEN IF

+s682=s684THENs758:=int(s767)FI;s682INCRs703ELIFs797<>s722THENs682:=s684FI UNTIL

+s797=s722ORs682=s684PER;s758ENDPROCs796;TEXT PROCs798:s667+text(s683)+s668

+ENDPROCs798;ENDPACKETeditmonitor;PACKETmpgglobalmanagerDEFINESmonitor,break,

+endglobalmanager,begin,beginpassword,managermessage,managerquestion,freemanager,

+stdmanager,mpgmanager,freeglobalmanager,globalmanager:LETs832="",s840="checkoff;

+endglobalmanager(TRUE);",s841="warnings off;sysout("""");sysin("""");",s842="mon

+itor",s847="Task-Passwort  :",s848="Beginn-Passwort:",s854=2,s856=1,s860="Kein Z

+ugriffsrecht auf Task """,s861="""",s867="Falscher Auftrag fuer Task """,s875="-

+",s876="Passwort falsch",s881=""" existiert nicht",s882=""" loeschen",s885=""" u

+eberschreiben",s888=" ",s899="break:1.0end:2.0monitor:3.0stdbeginproc:4.1",s900=

+"Gib ",s901="-Kommando :",s902=0,s903=3,s904=4,s916=""3""13""5"",s920=6,s932="gi

+b kommando :",s936=""7"Speicher Engpass! Dateien loeschen!"13""10"",s938=5,s939=

+7,s940=8,s941=9,s942=10,s943=11,s944=12,s945=13,s946=14,s947=15,s948=16,s949=17,

+s950=18,s951=19;LETs799=0,s800=1,s801=2,s802=3,s803=4,s804=5,s805=6,s806=4,s807=

+9,s808=11,s809=12,s810=13,s811=14,s812=15,s813=17,s814=24,s815=100,s816=""7""13"

+"10""5"Fehler : ",s817=""13""10"";DATASPACE VARs818:=nilspace;BOUND STRUCT(TEXT

+s819,s820,s821)VARs822;BOUND TEXT VARs823;TASK VARs824,s825;FILE VARs826;INT VAR

+s827,s828,s829,s830;TEXT VARs831:=s832,s833,s834,s835:=s832,s836,s837,s838;TEXT

+ VARs839:=s840+s841+s842;BOOL VARs843,s844;PROCmpgmanager(PROC(DATASPACE VAR,INT

+ CONST,INT CONST,TASK CONST)s845):IFonlineTHEN TEXT VARs846;put(s847);

+getsecretline(s846);IFs846<>s832THENtaskpassword(s846)FI;put(s848);getsecretline

+(s846);IFs846<>s832THENbeginpassword(s846)FI FI;s844:=FALSE;globalmanager(PROC(

+DATASPACE VAR,INT CONST,INT CONST,TASK CONST)s845)ENDPROCmpgmanager;PROC

+globalmanager:mpgmanager(PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)

+stdmanager)ENDPROCglobalmanager;PROCglobalmanager(PROC(DATASPACE VAR,INT CONST,

+INT CONST,TASK CONST)s845):s843:=TRUE;s849(PROC(DATASPACE VAR,INT CONST,INT

+ CONST,TASK CONST)s845)ENDPROCglobalmanager;PROCs849(PROC(DATASPACE VAR,INT

+ CONST,INT CONST,TASK CONST)s845):s919;setautonom;disablestop;commanddialogue(

+FALSE);s825:=niltask;s851;REPwait(s818,s828,s824);IFs828<>s804THENs855;s845(s818

+,s828,s830,s824)ELIFs824=s825THENs857;s845(s818,s828,s830,s824)ELSEs858FI;s850;

+s853UNTIL(NOTs843)AND(NOTs844)PER;commanddialogue(TRUE);resetautonom.s850:IF

+iserrorTHENforget(s818);s818:=nilspace;s823:=s818;CONCR(s823):=errormessage;

+clearerror;send(s824,s801,s818)FI.s851:INT VARs852:=heapsize.s853:IFheapsize>

+s852+s854THENcollectheapgarbage;s852:=heapsizeFI.s855:s830:=s856;s829:=s828;s825

+:=s824.s857:s830INCRs856;s828:=s829.s858:forget(s818);s818:=nilspace;send(s824,

+s800,s818)ENDPROCs849;PROCfreeglobalmanager:mpgmanager(PROC(DATASPACE VAR,INT

+ CONST,INT CONST,TASK CONST)freemanager)ENDPROCfreeglobalmanager;PROCstdmanager(

+DATASPACE VARs818,INT CONSTs828,s859,TASK CONSTs824):IF(s828=s806ANDs862)CORs863

+THENfreemanager(s818,s828,s859,s824)ELSEerrorstop(s860+name(myself)+s861)FI.s862

+:(s864ORs865)ANDs843.s863:s864ORs865.s864:s824<supervisorORs824=supervisor.s865:

+s824<myselfENDPROCstdmanager;PROCfreemanager(DATASPACE VARs818,INT CONSTs828,

+s859,TASK CONSTs824):enablestop;IFs828>s815ANDs824=supervisorTHENs893ELIFs828=

+s806ANDs843THENs869ELSEs866FI.s866:s868;SELECTs828OF CASEs808:s879CASEs809:s883

+CASEs810:s889CASEs811:s880CASEs812:s890CASEs813:s891CASEs814:s907OTHERWISE

+errorstop(s867+name(myself)+s861)ENDSELECT.s868:IFs828>=s808ANDs828<=s811ANDs859

+=s856THENs822:=s818;s834:=s822.s819FI.s869:BOUND STRUCT(TEXTs870,s871,TASKs872,

+PROCAs873)VARs874:=s818;IFs835=s874.s871ANDs835<>s875THENs877ELIFs874.s871=s832

+THENs878ELSEerrorstop(s876)FI.s877:begin(s818,PROCs912,s827);send(s824,s827,s818

+).s878:send(s824,s807,s818).s879:IFreadpermission(s834,s822.s821)CORs824<

+supervisorTHENforget(s818);s818:=old(s834);send(s824,s799,s818)ELSEerrorstop(

+s876)FI.s880:s822:=s818;s834:=s822.s819;IF NOTexists(s834)THENmanagermessage(

+s861+s834+s881,s824)ELIFs830=s856THENmanagerquestion(s861+s834+s882,s824)ELIF

+writepermission(s834,s822.s820)CORs824<supervisorTHENforget(s834,quiet);send(

+s824,s799,s818)ELSEerrorstop(s876)FI.s883:IFs830=s856THENs884ELSEs886FI.s884:IF

+writepermission(s834,s822.s820)CORs824<supervisorTHENs838:=s834;s836:=s822.s820;

+s837:=s822.s821;IFexists(s834)THENmanagerquestion(s861+s834+s885,s824)ELSEsend(

+s824,s804,s818)FI;ELSEerrorstop(s876)FI.s886:forget(s838,quiet);copy(s818,s838);

+enterpassword(s838,s836,s837);forget(s818);s818:=nilspace;send(s824,s799,s818);

+s887.s887:replace(s836,s856,LENGTHs836*s888);replace(s837,s856,LENGTHs837*s888).

+s889:IFexists(s834)THENsend(s824,s799,s818)ELSEsend(s824,s805,s818)FI.s890:

+forget(s818);s818:=nilspace;s826:=sequentialfile(output,s818);list(s826);send(

+s824,s799,s818).s891:BOUND THESAURUS VARs892:=s818;s892:=all;send(s824,s799,s818

+).s893:TEXT VARs894,s895;INT VARs896,s897;TEXT CONSTs898:=s899;disablestop;call(

+supervisor,s828,s818,s827);forget(s818);IFs827=s799THEN IFs844THEN

+endglobalmanager(TRUE);LEAVEs893FI;s905;REPcommanddialogue(TRUE);getcommand(s900

++name(myself)+s901);analyzecommand(s898,s902,s896,s897,s894,s895);SELECTs896OF

+ CASEs856:s919CASEs854,s903:s843:=FALSE;s844:=FALSE;LEAVEs893CASEs904:s839:=s894

+OTHERWISEdocommandENDSELECT UNTIL NOTonlinePER;commanddialogue(FALSE);s919;

+setautonom;s906FI;enablestop.s905:IFs831<>s832THENout(s816);out(s831);out(s817);

+s831:=s832FI.s906:IFiserrorTHENs831:=errormessage;clearerrorFI.s907:FILE VARs908

+:=sequentialfile(input,s818);WHILE NOTeof(s908)REPgetline(s908,s833);IFexists(

+s833)THENforget(s833,quiet)FI PER;send(s824,s799,s818).ENDPROCfreemanager;PROC

+managerquestion(TEXT CONSTs909):forget(s818);s818:=nilspace;s823:=s818;s823:=

+s909;send(s824,s803,s818)ENDPROCmanagerquestion;PROCmanagerquestion(TEXT CONST

+s909,TASK CONSTs910):forget(s818);s818:=nilspace;s823:=s818;s823:=s909;send(s910

+,s803,s818)ENDPROCmanagerquestion;PROCmanagermessage(TEXT CONSTs911):forget(s818

+);s818:=nilspace;s823:=s818;s823:=s911;send(s824,s802,s818)ENDPROCmanagermessage

+;PROCmanagermessage(TEXT CONSTs911,TASK CONSTs910):forget(s818);s818:=nilspace;

+s823:=s818;s823:=s911;send(s910,s802,s818)ENDPROCmanagermessage;PROCs912:do(s839

+)ENDPROCs912;PROCbegin(TEXT CONSTs913):TASK VARs914;begin(s913,PROCmonitor,s914)

+ENDPROCbegin;PROCbeginpassword(TEXT CONSTs915):s917;s835:=s915;display(s916);

+covertracks.s917:replace(s835,s856,LENGTHs835*s888)ENDPROCbeginpassword;PROC

+endglobalmanager(BOOL CONSTs918):s843:=NOTs918;s844:=NOTs918ENDPROC

+endglobalmanager;PROCs919:eumelmustadvertise;s921(s920)ENDPROCs919;PROCbreak:IF

+s843THENs919;LEAVEbreakFI;s844:=TRUE;s843:=FALSE;s849(PROC(DATASPACE VAR,INT

+ CONST,INT CONST,TASK CONST)stdmanager)ENDPROCbreak;PROCs921(INT CONSTs922):

+DATASPACE VARs923:=nilspace;INT VARs924;call(supervisor,s922,s923,s924);IFs924=

+s801THEN BOUND TEXT VARs925:=s923;forget(s923);errorstop(s925)FI;forget(s923)

+ENDPROCs921;LETs926="edit:1.01end:3.0run:4.01runagain:6.0insert:7.01forget:9.01r

+ename:11.2copy:12.2list:13.0storageinfo:14.0taskinfo:15.0fetch:16.1save:17.01sav

+eall:19.0";INT VARs927,s928,s929;TEXT VARs930,s931;PROCmonitor:disablestop;s929

+:=heapsize;REPcommanddialogue(TRUE);sysin(s832);sysout(s832);s933;getcommand(

+s932);analyzecommand(s926,s904,s927,s928,s930,s931);s937;s853PER.s853:IFheapsize

+>s929+s904THENcollectheapgarbage;s929:=heapsizeFI.s933:INT VARs934,s935;storage(

+s934,s935);IFs935>s934THENout(s936)FI.ENDPROCmonitor;PROCs937:enablestop;SELECT

+s927OF CASEs856:editCASEs854:edit(s930)CASEs903:endCASEs904:runCASEs938:run(s930

+)CASEs920:runagainCASEs939:insertCASEs940:insert(s930)CASEs941:forgetCASEs942:

+forget(s930)CASEs943:rename(s930,s931)CASEs944:copy(s930,s931)CASEs945:listCASE

+s946:storageinfoCASEs947:taskinfoCASEs948:fetch(s930)CASEs949:saveCASEs950:save(

+s930)CASEs951:saveallOTHERWISEdocommandENDSELECT.ENDPROCs937;ENDPACKET

+mpgglobalmanager

diff --git a/app/mpg/1987/src/RUCTEPLT.ELA b/app/mpg/1987/src/RUCTEPLT.ELA
new file mode 100644
index 0000000..ebd9a2b
--- /dev/null
+++ b/app/mpg/1987/src/RUCTEPLT.ELA
@@ -0,0 +1,326 @@
+PACKET ructerm plot  DEFINES                  (* M. Staubermann, 23.11.86 *)

+                     drawing area,

+                     begin plot,

+                     end plot, 

+                     clear, 

+                     pen,

+                     move, 

+                     draw, 

+                     get cursor ,

+

+                     testbit, where,

+                     pages ,

+                     circle, ellipse, fill, box, filled box,

+                     get screen ,

+                     put screen :

+ 

+LET max x        = 279 ,                {Abmessungen : 280 x 192}

+    max y        = 191 ,

+

+    hor faktor   = 11.2 ,               {***** x pixel / x cm *****}

+    vert faktor  = 11.29412 ,           {***** y pixel / y cm *****}

+

+

+    delete = 0 ,                        {Farbcodes}

+    std    = 1 ,

+    black  = 5 ,

+    white  = 6 ,

+    yellow = 7 ;

+(*  lilac  = 8 ,

+

+    durchgehend      = 1 ,              {Linientypen}

+    gepunktet        = 2 ,

+    kurz gestrichelt = 3 ,

+    lang gestrichelt = 4 ,

+    strichpunkt      = 5 ,

+    strichpunktpunkt = 6 ;*)

+

+LET POS = STRUCT (INT x, y) ;

+

+POS VAR pos ;

+INT VAR i ;

+ 

+clear ;

+

+TEXT PROC text word (INT CONST i) :

+ TEXT VAR t := "  " ;

+ replace (t, 1, i) ;

+ t

+ENDPROC text word ;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm := 25.0;    y cm := 17.0;   {***** Horizontale und vertikale *****}

+                                    {***** Größe in Zentimetern.     *****}

+   x pixel := maxx;  y pixel := maxy{***** Koordinaten des rechten   *****}

+                                    {***** oberen Punktes.           *****}

+END PROC drawing area;

+

+PROC begin plot : 

+ out (""27"$")

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+ out (""27"%")

+ENDPROC end plot ;

+

+PROC where (INT VAR x, y) :

+ REP UNTIL incharety = "" PER ;

+ out (""27";") ;

+ x := (incharety (1000) + incharety (1000)) ISUB 1 ;

+ y := (incharety (1000) + incharety (1000)) ISUB 1

+ENDPROC where ;

+

+BOOL PROC testbit :

+ TEXT VAR t ;

+ REP UNTIL incharety = "" PER ;

+ out (""27"-") ;

+ inchar (t) ;

+ bit (code (t), 0)

+ENDPROC testbit ;

+

+PROC clear :

+  pos   := POS:(0, 0) ;

+  out (""27"O0"27"y") ; (* Clear und Cursor (0,0) *)

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  INT CONST farbe := abs (foreground) ;

+  set linetype ;

+  set colour ;

+  set thickness .

+

+set colour :

+ IF farbe = std OR farbe = yellow OR farbe = white

+    THEN out (""27"O21")

+    ELSE out (""27"O20")

+ FI ;

+ IF   farbe = delete OR  farbe = black  THEN out (""27"O41") (* AND *)

+ ELIF foreground < 0 AND thickness >= 0 THEN out (""27"O42") (* XOR *)

+ ELIF foreground < 0{AND thickness < 0} THEN out (""27"O43") (* COPY *)

+                                        ELSE out (""27"O40") (* SET *)

+ FI .

+

+set thickness :

+ IF thickness > 0 AND thickness < 16

+    THEN out (""27"O1" + code (thickness + 32))

+ FI .

+

+set linetype:

+  IF linetype < 7 AND linetype > 0

+     THEN out (""27"O3" + code (line type + 32))

+     ELSE out (""27"O6" + text word (line type) + ""27"O37") ;

+  FI .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+ TEXT VAR cmd := ""27"v" ;

+ cmd CAT text (x) ;

+ cmd CAT "," ;

+ cmd CAT text (y) ;

+ cmd CAT ";" ;

+ out (cmd) ;

+ pos := POS:(x,y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+ TEXT VAR cmd := ""27"w" ;

+ cmd CAT text (x) ;

+ cmd CAT "," ;

+ cmd CAT text (y) ;

+ cmd CAT ";" ;

+ out (cmd) ;

+ pos := POS : (x, y)

+

+END PROC draw;

+ 

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+ TEXT VAR cmd := ""27"&"27"N" ;

+ cmd CAT code (72 + int (angle / 5.0) MOD 72) ;

+ cmd CAT code (int (hor faktor * width + 0.5)) ;

+ cmd CAT code (int (vert faktor * height + 0.5)) ;

+ out (cmd) ;

+ out (record) ;

+ out (""27"N"0""0""0"") ;

+ move (pos.x, pos.y) .

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  get cursor (t, x, y, -1, -1, -1, -1)

+END PROC get cursor;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1) :

+ get cursor (t, x, y, x0, y0, x1, y1, FALSE)

+ENDPROC get cursor ;

+

+PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1,

+                 BOOL CONST only one key):

+  BOOL VAR hop key := FALSE ;

+  t := "" ;

+  check;

+  init cursor;

+  REP set cursor;

+      get step;

+      set cursor;

+      move cursor

+  UNTIL only one key PER .

+

+init cursor:

+  POS CONST old pos :: pos ;

+  REP UNTIL incharety = "" PER ;

+  out (""27"5") ;

+  TEXT VAR old params ;

+  inchar (old params) ;

+  out (""27"O5a") ; (* Strichdicke 1, XOR, Gelb *)

+  INT VAR delta := 1 ;

+  x := pos.x ;

+  y := pos.y .

+

+set cursor:

+  IF x0 >= 0 AND y0 >= 0

+  THEN move (x0, y0) ;

+       draw (x, y)

+  FI;

+  IF x1 >= 0 AND y1 >= 0

+  THEN move (x1, y1) ;

+       draw (x, y)

+  FI;

+  out (""24"") . (* Fadenkreuz an/aus *)

+

+get step:

+  hop key := t = ""1"" ;

+  t := incharety (1);

+  IF t <> ""

+  THEN delta INCR 1

+  ELSE delta := 1 ;

+       inchar (t)

+  FI .

+

+move cursor:

+  IF hop key

+     THEN hop mode

+     ELSE single key

+  FI ;

+  check .

+

+single key :

+ SELECT code (t) OF

+  CASE 1 : 

+  CASE 2, 54 : x INCR delta (* right, '6' *)

+  CASE 3, 56 : y INCR delta (* up,    '8' *) 

+  CASE 8, 52 : x DECR delta (* left,  '4' *)

+  CASE 10, 50 : y DECR delta(* down,  '2' *)

+  CASE 55 : x DECR delta ; y INCR delta (* '7' *)

+  CASE 57 : x INCR delta ; y INCR delta (* '9' *)

+  CASE 49 : x DECR delta ; y DECR delta (* '1' *)

+  CASE 51 : x INCR delta ; y DECR delta (* '3' *)

+  OTHERWISE leave get cursor

+ ENDSELECT .

+

+hop mode :

+ SELECT code (t) OF

+  CASE 1 : t := "" ; x := 0 ; y := max y ;

+  CASE 2, 54 : x := max x

+  CASE 3, 56 : y := max y

+  CASE 8, 52 : x := 0 

+  CASE 10, 50 : y := 0

+  CASE 55 : x := 0 ; y := max y 

+  CASE 57 : x := max x ; y := max y

+  CASE 49 : x := 0 ; y := 0

+  CASE 51 : x := max x ; y := 0

+  OTHERWISE t := ""1"" + t ; leave get cursor

+ ENDSELECT .

+

+leave get cursor:

+  out (""27"O5" + old params) ;

+  move (old pos.x, old pos.y);

+  LEAVE get cursor  .

+

+check :

+  IF x < 0

+  THEN x := 0 ; out (""7"")

+  ELIF x > max x

+  THEN x := max x ; out (""7"") FI ; 

+

+  IF y < 0

+  THEN y := 0 ; out (""7"")

+  ELIF y > max y

+  THEN y := max y ; out (""7"") FI .

+

+END PROC get cursor;

+

+PROC get screen (TEXT CONST name):

+  IF exists (name)

+     THEN get screen (old (name))

+     ELSE get screen (new (name))

+  FI ;

+END PROC get screen;

+

+PROC get screen (DATASPACE CONST to ds) :

+  BOUND ROW 16 ROW 256 INT VAR screen := to ds ;

+  INT VAR i, j ;

+  REP UNTIL incharety = "" PER ;

+  FOR i FROM 0 UPTO 16 REP

+   out (""27"\"0""2""0"" + code (i * 2)) ;

+   FOR j FROM 1 UPTO 256 REP

+    screen (i)(j) := (incharety (1000) + incharety (1000)) ISUB 1

+   PER ;

+  PER

+END PROC get screen;

+

+PROC put screen (TEXT CONST name):

+  IF exists (name)

+  THEN put screen (old (name))

+  ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI

+END PROC put screen;

+

+PROC put screen (DATASPACE CONST from ds) :

+  BOUND ROW 4096 INT VAR screen :: from ds ;

+  out (""27"/"0""32""0""0"") ;

+  FOR i FROM 1 UPTO 4096 REP

+   out (textword (screen (i)))

+  PER 

+END PROC put screen;

+

+PROC pages (INT CONST bits) :

+ out (""27"O7" + code (bits + 32))

+ENDPROC pages ;

+

+INT PROC pages :

+ TEXT VAR t ;

+ REP UNTIL incharety = "" PER ;

+ out (""27"4") ;

+ inchar (t) ;

+ code (t) AND 7

+ENDPROC pages ;

+

+PROC circle (INT CONST radius) :

+ IF radius > 0

+    THEN out (""27"K" + text (radius) + ",0;") ;

+ FI

+ENDPROC circle ;

+

+PROC ellipse (INT CONST x rad, y rad, REAL CONST from, to) :

+ out (""27"s" + text (x rad) + "," + text (yrad) + "," +

+                text (72 + int (from / 5.0) MOD 72) + "," +

+                text (72 + int (to / 5.0) MOD 72) + ";")

+ENDPROC ellipse ;

+

+PROC box (INT CONST width, height) :

+ out (""27"J" + text (width) + "," + text (height) + ";")

+ENDPROC box ;

+

+PROC filled box (INT CONST width, height) : (* Width max. 255 *)

+ out (""27"N" + code (width) + code (height)) ; (* Großes inverses Blank *)

+ put (""0""27"&"27"O41"27"G0 "27"N"0""0""0"")   (* ausgeben *)

+ENDPROC filled box ;

+

+PROC fill (INT CONST pattern) :

+ out (""27"|" + code (pattern + 32))

+ENDPROC fill ;

+

+END PACKET ructerm plot ;

diff --git a/app/mpg/1987/src/STDPLOT.ELA b/app/mpg/1987/src/STDPLOT.ELA
new file mode 100644
index 0000000..3281516
--- /dev/null
+++ b/app/mpg/1987/src/STDPLOT.ELA
@@ -0,0 +1,234 @@
+PACKET std plot DEFINES drawing area, 

+                        begin plot, 

+                        end plot, 

+                        clear, 

+                        pen,

+                        move, 

+                        draw, 

+                        get cursor:

+ 

+LET delete = 0,                         {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    durchgehend      = 1,               {Linientypen}

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5,

+

+    empty            = 0,               {Punktsymbole}

+    high             = 1,

+    low              = 2, 

+    both             = 3; 

+

+LET POS = STRUCT (INT x, y);

+

+ROW 79 ROW 24 INT VAR screen;

+BOOL VAR colour :: TRUE, action :: TRUE;

+POS VAR pos :: POS : (0, 0);

+ 

+clear;

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm := 25.0;    y cm := 17.0;   {***** Horizontale und vertikale *****}

+                                    {***** Größe in Zentimetern.     *****}

+   x pixel := 79;   y pixel := 48   {***** Koordinaten des rechten   *****}

+                                    {***** oberen Punktes.           *****}

+END PROC drawing area;

+

+PROC begin plot : 

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+ENDPROC end plot ;

+

+PROC clear :

+  INT VAR i, j;

+  colour := TRUE;

+  action := TRUE;

+  pos := POS : (0, 0);

+

+  FOR i FROM 1 UPTO 24

+  REP screen [1] [i] := 0 PER;

+  FOR i FROM 2 UPTO 79

+  REP screen [i] := screen [1] PER;

+  page;

+  out (""6""23""0"")  .

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  colour := foreground > 0;

+  action := linetype <> 0  .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  out (""6""+ code (23-y DIV 2) + code (x)); 

+  pos := POS  : (x, y) 

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF action

+  THEN vector (x-pos.x, y-pos.y) FI;

+  pos := POS : (x, y)   .

+

+END PROC draw;

+ 

+PROC vector (INT CONST dx , dy) :

+  IF dx >= 0

+  THEN IF   dy >  dx THEN vector (pos.y, pos.x, dy, dx, 1, 1)

+       ELIF dy >   0 THEN vector (pos.x, pos.y, dx, dy, 1, 1)

+ 

+       ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1)

+       ELSE               vector (pos.y, pos.x, -dy, dx,-1, 1) FI

+

+  ELSE IF   dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1)

+       ELIF dy >   0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1)

+ 

+       ELIF dy >  dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1)

+       ELSE               vector (pos.y, pos.x, -dy, -dx,-1,-1) FI

+  FI .

+ 

+ENDPROC vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :

+  INT VAR i;

+  prepare first step ;

+  point;

+  FOR i FROM 1 UPTO dx

+  REP do one step PER  .

+

+prepare first step :

+  INT VAR up right error := dy - dx,

+          right error := dy,

+          old error := 0  .

+

+do one step:

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error)  .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+point :

+  IF (pos.y AND 1) = 0

+  THEN lower point

+  ELSE upper point FI  .

+

+lower point :

+  out (""6""+ code (23-pos.y DIV 2) + code (pos.x));

+  IF colour

+  THEN set lower point

+  ELSE reset lower point FI  .

+

+set lower point:

+  SELECT screen [pos.x+1] [pos.y DIV 2+1] OF

+  CASE empty : out (","8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := low

+  CASE high  : out ("|"8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := both

+  ENDSELECT  .

+

+reset lower point: 

+  SELECT screen [pos.x+1] [pos.y DIV 2+1] OF

+  CASE low   : out (" "8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := empty

+  CASE both  : out ("'"8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := high

+  ENDSELECT  .

+

+upper point :

+  out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); 

+  IF colour

+  THEN set upper point

+  ELSE reset upper point FI  .

+

+set upper point:

+  SELECT screen [pos.x+1] [pos.y DIV 2+1] OF

+  CASE empty : out ("'"8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := high

+  CASE low   : out ("|"8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := both

+  ENDSELECT  .

+ 

+reset upper point:

+  SELECT screen [pos.x+1] [pos.y DIV 2+1] OF

+  CASE high  : out (" "8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := empty

+  CASE both  : out (","8"");

+               screen [pos.x+1] [pos.y DIV 2+1] := low

+  ENDSELECT  .

+

+END PROC vector;

+ 

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+   out (subtext (record, 1, 79-pos.x));

+   out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); 

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+  x := pos.x;

+  y := pos.y;

+  REP out (""6""+ code (23-y DIV 2) + code (x)); 

+      inchar (t);

+      SELECT code (t) OF

+      CASE 2 : x INCR 1

+      CASE 3 : y INCR 1

+      CASE 8 : x DECR 1

+      CASE 10: y DECR 1

+      CASE 1 : out (""0""1"" + text (x, 3) + "," + text (y, 3) + "  "13""16"")

+      OTHERWISE leave get cursor ENDSELECT;

+      check

+  PER  .

+

+leave get cursor:

+  out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); 

+  LEAVE get cursor  .

+

+check :

+  IF x < 0

+  THEN x := 0;

+       out (""7"")

+  ELIF x > 47

+  THEN x := 47;

+       out (""7"")

+  FI; 

+  IF y < 0

+  THEN y := 0;

+       out (""7"")

+  ELIF y > 78

+  THEN y := 78;

+       out (""7"")

+  FI  .

+

+END PROC get cursor;

+

+PROC test (INT CONST x, y, TEXT CONST t):

+  out (""27";(" + text (x) + "," + text (y) + ")  " + t + ""29"");

+  IF incharety (10000) = ""27""

+  THEN stop FI

+END PROC test;

+

+

+END PACKET std plot;

+

+

diff --git a/app/mpg/1987/src/TELEVPLT.ELA b/app/mpg/1987/src/TELEVPLT.ELA
new file mode 100644
index 0000000..155eb02
--- /dev/null
+++ b/app/mpg/1987/src/TELEVPLT.ELA
@@ -0,0 +1,176 @@
+PACKET televideo plot DEFINES drawing area,         { Autor: H. Indenbirken }

+                              begin plot,           { Stand: 31.01.85       }

+                              end plot, 

+                              clear, 

+                              pen,

+                              move, 

+                              draw, 

+                              get cursor,

+                              cursor:

+

+ 

+LET delete = 0,                         {Farbcodes}

+    std    = 1,

+    black  = 5,

+    white  = 6,

+

+    nothing          = 0,               {Linientypen}

+    durchgehend      = 1, 

+    gepunktet        = 2,

+    kurz gestrichelt = 3,

+    lang gestrichelt = 4,

+    strichpunkt      = 5,

+    mittel gestrichelt = 6,

+    punkt punkt strich = 7;

+

+INT VAR act thick :: 0;

+LET POS = STRUCT (INT x, y);

+

+POS VAR pos :: POS : (0, 0);

+

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 23.0;    y cm    := 13.7; 

+   x pixel := 639;     y pixel := 239 

+END PROC drawing area;

+

+PROC begin plot : 

+  page;

+  out (""27".0")

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+  out (""27".1")

+ENDPROC end plot ;

+

+PROC clear :

+  act thick := 0;

+  pos := POS : (0, 0);

+  out (""27"mCGD")

+END PROC clear;

+

+PROC pen (INT CONST background, foreground, thickness, linetype):

+  out (""27"m");

+  set background;

+  set foreground;

+  set thickness;

+  set linetype;

+  out ("D")  .

+

+set background:

+  IF background = white

+  THEN out (""27"n1")

+  ELSE out (""27"n0") FI  .

+

+set foreground:

+  IF foreground = delete

+  THEN out ("U0W1")

+  ELIF foreground < 0

+  THEN out ("U1W4")

+  ELSE out ("U1W1") FI  .

+ 

+set thickness:

+  act thick := thickness  .

+

+set linetype:

+  SELECT linetype OF

+  CASE durchgehend      : out ("T1")

+  CASE gepunktet        : out ("T3")

+  CASE kurz gestrichelt : out ("T6")

+  CASE lang gestrichelt : out ("T5")

+  CASE strichpunkt      : out ("T4")

+  CASE mittel gestrichelt : out ("T2")

+  CASE punkt punkt strich : out ("T7")

+  END SELECT  .

+

+END PROC pen;

+

+PROC move (INT CONST x, y) :

+  out (""27"mM" + text (x, y) + ";D");

+  pos := POS  : (x, y)

+END PROC move;

+ 

+PROC draw (INT CONST x, y) :

+  IF act thick <> 0

+  THEN IF horizontal line

+       THEN thick y

+       ELSE thick x FI;

+       x MOVE y

+  ELSE out (""27"mL" + text (x, y) + ";D") FI;

+  pos := POS : (x, y)   .

+

+horizontal line:

+  abs (pos.x-x) > abs (pos.y-y)  .

+

+thick y:

+  INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;

+  FOR dy FROM 1 UPTO act thick

+  REP old x MOVE pos.y+dy;

+      new x DRAW     y+dy;

+      old x MOVE pos.y-dy;

+      new x DRAW y-dy;

+  PER  . 

+

+x ausgleich:

+  IF pos.x <= x

+  THEN  act thick

+  ELSE -act thick FI  .

+

+thick x:

+  INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;

+  FOR dx FROM 1 UPTO act thick

+  REP pos.x+dx MOVE old y;

+          x+dx DRAW new y;

+      pos.x-dx MOVE old y;

+          x-dx DRAW new y;

+  PER  . 

+

+y ausgleich:

+  IF pos.y <= y

+  THEN  act thick

+  ELSE -act thick FI  .

+

+END PROC draw;

+

+PROC draw (TEXT CONST record, REAL CONST angle, height, width):

+  out (""27"m""" + record + """D")

+END PROC draw;

+

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+PROC get cursor (TEXT VAR t, INT VAR x, y) :

+END PROC get cursor;

+

+OP MOVE (INT CONST x, y):

+  out (""27"mM" + text (x, y) + ";D") 

+END OP MOVE;

+

+OP DRAW (INT CONST x, y):

+  out (""27"mL" + text (x, y) + ";D") 

+END OP DRAW;

+

+PROC cursor (INT CONST no,x,y):

+  out (""27"m|" + text (no) + "~0H" + text (x, y) + ";D")

+END PROC cursor;

+

+TEXT PROC text (INT CONST x,y):

+  x text + "," + y text  .

+

+x text:

+  IF x < 0

+  THEN "0"

+  ELIF x > 639

+  THEN "639"

+  ELSE text (x) FI  .

+

+y text:

+  IF y < 0

+  THEN "0"

+  ELIF y > 639

+  THEN "639"

+  ELSE text (y) FI  .

+

+END PROC text;

+

+END PACKET televideo plot

diff --git a/app/mpg/1987/src/VIDEOPLO.ELA b/app/mpg/1987/src/VIDEOPLO.ELA
new file mode 100644
index 0000000..38b44ea
--- /dev/null
+++ b/app/mpg/1987/src/VIDEOPLO.ELA
@@ -0,0 +1,382 @@
+#   Stand : 26.Juni 1985  #

+PACKET videostar plot DEFINES drawing area, 

+                         begin plot, 

+                         end plot, 

+                         clear, 

+ 

+                         background,

+                         foreground,

+                         thickness,

+                         linetype,

+

+                         move, 

+                         draw, 

+                         marker, 

+ 

+                         range,

+                         clipping:

+ 

+LET begin vector = ""16"";

+LET max x        =   679,

+    max y        =   479;               (* Direkt-Adressierung *)

+LET POS = STRUCT (INT x, y); 

+POS VAR pos :: POS : (0, 0);

+ 

+INT VAR akt pen :: 1, akt pen line type :: 1; 

+BOOL VAR check :: TRUE;

+INT VAR thick :: 0, i, x min :: 0, x max :: 679, y min :: 0, y max :: 479;

+TEXT VAR old pos :: "";

+ 

+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 

+   x cm    := 27.0 ;   y cm    := 20.00; 

+   x pixel := 679;     y pixel  :=  479

+END PROC drawing area;

+

+PROC range (INT CONST h min, h max, v min, v max):

+  x min := h min;  x max := h max;

+  y min := v min;  y max := v max

+END PROC range;

+

+PROC clipping (BOOL CONST flag):

+  check := flag

+END PROC clipping;

+

+BOOL PROC clipping:

+  check

+END PROC clipping;

+

+PROC begin plot : 

+ENDPROC begin plot ;

+ 

+PROC end plot : 

+  out (""27"0@")

+ENDPROC end plot ;

+

+PROC clear :

+write (""29""27""140""27"/0d"24"")

+END PROC clear;

+ 

+PROC background (INT CONST desired, INT VAR realized):

+  realized := 0                      (*Nur schwarzer Hintergrund möglich *)

+END PROC background;

+

+PROC foreground (INT CONST desired, INT VAR realized):

+  akt pen := desired;

+  realized := sign (desired)  .  (*Nur weißer Sift möglich, aber         *)

+                                 (*löschend, ändernd oder überschreibend *)

+END PROC foreground;

+

+PROC thickness (INT CONST desired, INT VAR realized):

+  thick     := desired DIV 10;

+  realized  := thick*2+1                   (*Breite des Stiftes in Pixel *)

+END PROC thickness;

+

+PROC linetype (INT CONST desired, INT VAR realized):

+ IF desired <> akt pen linetype 

+ THEN write (""29"") ; # Graphicmode on # 

+      akt pen line type := desired; 

+      write (type cmd);

+      write (""27"x"24"") 

+  FI;

+  IF desired >= 0 AND desired <= 5 

+  THEN realized := desired 

+  ELSE realized := 0 FI  .

+

+type cmd:

+   SELECT desired OF 

+    CASE 1 : ""27"/a"                  # durchgängige Linie # 

+    CASE 2 : ""27"/1;1a"               # gepunktet # 

+    CASE 3 : ""27"/3;3a"               # kurz gestrichelt # 

+    CASE 4 : ""27"/6;6a"               # lang gestrichelt # 

+    CASE 5 : ""27"/6;3;1;3a"            # Strichpunkt # 

+  OTHERWISE ""27"/a" END SELECT

+END PROC linetype;

+ 

+ 

+PROC move (INT CONST x, y) :

+  x MOVE y;

+  pos := POS:(x, y)  . 

+END PROC move;

+ 

+PROC draw (INT CONST x, y):

+  IF std thickness

+  THEN draw (pos.x, pos.y, x, y)

+  ELIF is point

+  THEN point (x, y, thick);

+       x MOVE y;

+  ELIF is horizontal line 

+  THEN horizontal line (pos.x, pos.y, x, y, thick);

+       x MOVE y;

+  ELSE vertical line (pos.x, pos.y, x, y, thick);

+       x MOVE y

+  FI; 

+  pos := POS:(x, y)  . 

+

+std thickness:

+  thick = 0  .

+

+is point:

+  pos.x = x AND pos.y = y  .

+

+is horizontal line:

+  abs (pos.x-x) >= abs (pos.y-y)  .

+

+END PROC draw;

+

+PROC point (INT CONST x, y, thick):

+  INT VAR i;

+  FOR i FROM -thick UPTO thick

+  REP line (x-thick, y+i, x+thick, y+i) PER

+

+END PROC point;

+

+PROC horizontal line (INT CONST from x, from y, to x, to y, thick):

+  IF from x > to x

+  THEN horizontal line (to x, to y, from x, from y, thick)

+  ELSE draw line FI  .

+

+draw line:

+  INT VAR i;

+  calculate increase;

+  calculate limit points;

+  FOR i FROM -thick UPTO thick

+  REP calculate delta x;

+      line (x start+delta x, y start+i, x end+delta x, y end+i)

+  PER  .

+

+calculate increase:

+  REAL VAR increase :: -dy / dx  .

+

+calculate limit points:

+  INT CONST x start :: from x - thick,

+            x end   :: to x   + thick,

+            y start :: from y + int (increase * real (thick)), 

+            y end   :: to y   - int (increase * real (thick))  .

+

+calculate delta x:

+  INT CONST delta x :: int (increase*real (i))  .

+

+dx: real (to x-from x)  .

+dy: real (to y-from y)  .

+

+END PROC horizontal line;

+

+PROC vertical line (INT CONST from x, from y, to x, to y, thick):

+  IF from y > to y

+  THEN vertical line (to x, to y, from x, from y, thick)

+  ELSE draw line FI  .

+

+draw line:

+  INT VAR i;

+  calculate increase;

+  calculate limit points;

+  FOR i FROM -thick UPTO thick

+  REP calculate delta y;

+      line (x start+i, y start+delta y, x end+i, y end+delta y)

+  PER  .

+

+calculate increase:

+  REAL VAR increase :: -dx / dy  .

+

+calculate limit points:

+  INT CONST x start :: from x + int (increase * real (thick)), 

+            x end   :: to x   - int (increase * real (thick)),

+            y start :: from y - thick,

+            y end   :: to y   + thick  .

+

+calculate delta y:

+  INT CONST delta y :: int (increase*real (i))  .

+

+dx: real (to x-from x)  .

+dy: real (to y-from y)  .

+

+END PROC vertical line;

+ 

+PROC marker (INT CONST x, y, no, size):

+  IF no = 0

+  THEN draw cursor FI; 

+  pos.x MOVE pos.y  .

+

+draw cursor:

+  write(""29""27"/f"27""26"")  .

+

+END PROC marker; 

+ 

+PROC line (INT CONST from x, from y, to x, to y):

+  from x MOVE from y;

+  draw (from x, from y, to x, to y)

+END PROC line;

+

+PROC draw (INT CONST from x, from y, to x, to y):

+  IF check

+  THEN draw with clipping

+  ELSE to x DRAW to y FI  .

+

+draw with clipping:

+  INT VAR x, y;

+  calculate parts of line;

+  IF both points inside

+  THEN to x DRAW to y

+  ELIF both points outside

+  THEN 

+  ELIF first point outside

+  THEN intersection (to x, to y, to part, from x, from y, from part, x, y);

+       x    MOVE y;

+       to x DRAW to y

+  ELIF second point outside

+  THEN intersection (from x, from y, from part, to x, to y, to part, x, y);

+       x DRAW y

+  ELSE check intersection FI  .

+

+calculate parts of line:

+  INT CONST from part :: part (from x, from y),

+            to part   :: part (to x, to y)  .

+

+both points inside:

+  from part = 0 AND to part = 0  .

+

+both points outside:

+  (from part AND to part) <> 0  .

+

+first point outside:

+  from part <> 0 AND to part = 0  .

+

+second point outside:

+  to part <> 0 AND from part = 0  .

+

+check intersection:

+  intersection (to x, to y, to part, from x, from y, from part, x, y);

+  x MOVE y;

+  draw (x, y, to x, to y)  .

+

+END PROC draw;

+

+INT PROC part (INT CONST x, y):

+  INT VAR index :: 0;

+  IF x > x max

+  THEN set bit (index, 0)

+  ELIF x < x min

+  THEN set bit (index, 1) FI;

+

+  IF y > y max

+  THEN set bit (index, 2)

+  ELIF y < y min

+  THEN set bit (index, 3) FI;

+

+  index

+

+END PROC part;

+

+PROC intersection (INT CONST from x, from y, from part, to x, to y, to part,

+                   INT VAR x, y):

+  SELECT to part OF

+  CASE  1: right side

+  CASE  2: left side 

+  CASE  4: up side 

+  CASE  5: upright side 

+  CASE  6: upleft side 

+  CASE  8: down side 

+  CASE  9: downright side 

+  CASE 10: downleft side

+  OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT  .

+

+right side:

+  y := from y + int (real (x max-from x)*(dy/dx));

+  x := x max  .

+

+left side:

+  y := from y + int (real (x min-from x)*(dy/dx));

+  x := x min  .

+

+up side:

+  x := from x + int (real (y max-from y)*(dx/dy));

+  y := y max  .

+

+down side:

+  x := from x + int (real (y min-from y)*(dx/dy));

+  y := y min  .

+

+upright side:

+  right side;

+  IF y > y max

+  THEN up side FI  .

+

+downright side:

+  right side;

+  IF y < y min

+  THEN down side FI  . 

+

+upleft side:

+  left side;

+  IF y > y max

+  THEN up side FI  .

+

+downleft side:

+  left side;

+  IF y < y min

+  THEN down side FI  .

+

+dx: real (to x-from x)  .

+dy: real (to y-from y)  .

+

+END PROC intersection;

+

+PROC draw (TEXT CONST text, REAL CONST angle, height, thick) :

+INT CONST hoehe :: int(height);

+  IF akt pen linetype <> 0

+  THEN write (""29""); 

+       write (old pos);

+       write (""31"");

+       write (size);

+       write (text);

+       write(""24"")

+  FI  .

+

+size:

+  SELECT hoehe OF 

+   CASE 1 : ""27"4" 

+   CASE 2 : ""27"5"

+   CASE 3 : ""27"0"

+   CASE 4 : ""27"1"

+   CASE 5 : ""27"2"

+   CASE 6 : ""27"3"

+  OTHERWISE ""27"0" END SELECT  .  # Größe 3 für undefinierte Werte #

+

+END PROC draw;

+ 

+PROC draw (TEXT CONST record) :

+  draw (record, 0.0, 0.0, 0.0)

+END PROC draw;

+ 

+OP MOVE (INT CONST x, y) :

+ write (""29"");

+ old pos := koordinaten (x,y);

+ write (old pos);

+ write (""24"");

+END OP MOVE;

+ 

+OP DRAW (INT CONST x, y) :

+  IF akt pen line type = 0

+  THEN x MOVE y

+  ELSE write (""29""); (* plot ein *)

+       write (colour cmd);

+       write (old pos);

+       old pos := koordinaten (x,y);

+       write (old pos);

+       write (""24""); (* plot aus *)

+  FI  .

+

+colour cmd:

+  IF   akt pen = 0 THEN ""27"/1d"    # löschend #

+  ELIF akt pen < 0 THEN ""27"/2d"    # XOR #

+                   ELSE ""27"/0"     # normal # 

+  FI  .

+

+END OP DRAW;

+

+TEXT PROC koordinaten (INT CONST x,y):

+  code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) +

+  code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32))

+END PROC koordinaten;

+ 

+END PACKET videostar plot

diff --git a/app/mpg/1987/src/ZEICH610.DS b/app/mpg/1987/src/ZEICH610.DS
new file mode 100644
index 0000000..c06b5eb
--- /dev/null
+++ b/app/mpg/1987/src/ZEICH610.DS
diff --git a/app/mpg/1987/src/ZEICH912.DS b/app/mpg/1987/src/ZEICH912.DS
new file mode 100644
index 0000000..fc55473
--- /dev/null
+++ b/app/mpg/1987/src/ZEICH912.DS
diff --git a/app/mpg/1987/src/ZEICHEN.DS b/app/mpg/1987/src/ZEICHEN.DS
new file mode 100644
index 0000000..0c4927d
--- /dev/null
+++ b/app/mpg/1987/src/ZEICHEN.DS
diff --git a/app/mpg/1987/src/matrix printer b/app/mpg/1987/src/matrix printer
new file mode 100644
index 0000000..e5821ff
--- /dev/null
+++ b/app/mpg/1987/src/matrix printer
@@ -0,0 +1,129 @@
+(* Version vom 21.10.87 BJ *) 

+(* Standardoperationen *) 

+(*   printer line - Linienalgorithmus *) 

+(*   printer fill - Fuellalgorithmus *) 

+ 

+PROC printer line (INT CONST x1,y1,x2,y2,

+                   PROC (INT CONST, INT CONST) p set pixel): 

+  INT VAR x,y,z,             

+          a,b,d, 

+          dx :: abs(x2-x1), 

+          dy :: abs(y2-y1), 

+          dp,dq; 

+  IF dx <> 0 AND dy <> 0 

+    THEN IF dy <= dx 

+           THEN draw line 1 

+           ELSE draw line 2 

+         FI 

+    ELSE IF dx = 0 AND dy <> 0 

+            THEN draw vertical line 

+            ELSE draw horizontal line 

+         FI 

+  FI. 

+ 

+  draw line 1: 

+    x := x1;

+    y := y1; 

+    z := x2; 

+    a := sign(x2-x1); 

+    b := sign(y2-y1);

+    dp := dy * 2; 

+    d := dp - dx; 

+    dq := dp - 2 * dx; 

+    setpoint; 

+    WHILE x <> z REP 

+      x := x + a;

+      IF d < 0 

+        THEN d := d + dp 

+        ELSE y := y + b; 

+             d := d + dq

+      FI; 

+      setpoint 

+    PER. 

+ 

+  draw line 2: 

+    x := x1;

+    y := y1; 

+    z := y2; 

+    b := sign(x2-x1); 

+    a := sign(y2-y1);

+    dp := dx * 2; 

+    d := dp - dy; 

+    dq := dp - 2 * dy; 

+    setpoint; 

+    WHILE y <> z REP 

+      y := y + a;

+      IF d < 0 

+        THEN d := d + dp 

+        ELSE x := x + b; 

+             d := d + dq

+      FI; 

+      setpoint 

+    PER. 

+

+  draw vertical line: 

+    a := sign(y2-y1); 

+    x := x1; 

+    y := y1; 

+    z := y2; 

+    setpoint; 

+    WHILE y <> z REP 

+      y := y + a; 

+      setpoint 

+    PER. 

+ 

+  draw horizontal line: 

+    a := sign(x2-x1); 

+    x := x1; 

+    y := y1; 

+    z := x2; 

+    setpoint; 

+    WHILE x <> z REP 

+      x := x + a; 

+      setpoint 

+    PER. 

+ 

+  setpoint: 

+    p set pixel (x,y) 

+END PROC printer line; 

+ 

+PROC printer fill (INT CONST xl, xr, y, dir,

+                   BOOL PROC (INT CONST, INT CONST) point,

+                   PROC (INT CONST, INT CONST) pset):

+  INT VAR xl1 :: xl; 

+  WHILE point(xl1,y) REP 

+    xl1 INCR 1;

+    IF xl1 >= xr

+      THEN LEAVE printer fill

+    FI

+  PER;

+  INT VAR xrn :: xl1+1, 

+          xln :: xl1; 

+  WHILE NOT point(xrn,y) REP 

+    pset(xrn,y); 

+    xrn INCR 1 

+  PER;

+  WHILE NOT point(xln,y) REP 

+    pset(xln,y); 

+    xln DECR 1 

+  PER; 

+  IF xrn > xr 

+    THEN printer fill (xr, xrn-1,y-dir,-dir, 

+                       BOOL PROC (INT CONST, INT CONST) point,

+                       PROC (INT CONST, INT CONST) pset)

+    ELSE printer fill (xrn, xr, y, dir, 

+                       BOOL PROC (INT CONST, INT CONST) point,

+                       PROC (INT CONST, INT CONST) pset)

+  FI; 

+  IF xln < xl 

+    THEN printer fill (xln+1,xl, y-dir,-dir, 

+                       BOOL PROC (INT CONST, INT CONST) point,

+                       PROC (INT CONST, INT CONST) pset)

+    ELSE printer fill (xl,xln, y, dir, 

+                       BOOL PROC (INT CONST, INT CONST) point,

+                       PROC (INT CONST, INT CONST) pset)

+  FI; 

+  printer fill(xln+1, xrn-1, y+dir, dir, 

+               BOOL PROC (INT CONST, INT CONST) point,

+               PROC (INT CONST, INT CONST) pset)

+END PROC printer fill;

diff --git a/app/mpg/1987/src/std primitives b/app/mpg/1987/src/std primitives
new file mode 100644
index 0000000..dca20bd
--- /dev/null
+++ b/app/mpg/1987/src/std primitives
@@ -0,0 +1,79 @@
+PROC std circle (INT CONST xp,yp,r,from,to): 

+   moveto (xp,yp);

+   REAL VAR ang :: real (from MOD 360),

+            rad :: real(r),

+            max :: endwinkel,

+            cx  :: real (xp),

+            cy  :: real (yp),

+            ax0 :: cx,

+            ay0 :: cy,

+            ax1, ay1;

+

+   BOOL VAR fullcircle :: ang = 0.0 AND max = 360.0;

+   IF fullcircle

+      THEN move to (int (cx + rad * cosd (ang)+0.5), 

+                    int (cy + rad * -sind (ang)+0.5));

+           ang INCR 1.0

+   FI;

+   WHILE ang <= max REP 

+     ax1 := cx + rad * cosd (ang);

+     ay1 := cy + rad * -sind (ang); 

+     draw arc;

+     ang INCR 1.0 

+   PER; 

+   IF  NOT fullcircle

+      THEN  ax0 := cx;

+            ay0 := cy;

+            draw arc;

+            draw to (xp,yp)

+      ELSE  move to (xp,yp)

+   FI. 

+

+   draw arc: 

+      IF clipped line (ax0,ay0,ax1,ay1) 

+         THEN draw to (int (ax1+0.5), int (ay1+0.5)) 

+      FI; 

+      ax0 := ax1; 

+      ay0 := ay1. 

+ 

+   endwinkel: 

+      IF (to MOD 360) = 0 

+         THEN 360.0 

+         ELSE real (to MOD 360) 

+      FI 

+END PROC std circle; 

+ 

+PROC std box (INT CONST x0, y0, x1, y1, pattern): 

+      REAL VAR xx0 :: real (x0), 

+               yy0 :: real (y0), 

+               xx1 :: real (x0), 

+               yy1 :: real (y1); 

+      IF clipped line (xx0,yy0,xx1,yy1)

+         THEN moveto (int (xx0), int (yy0)); 

+              drawto (int (xx1), int (yy1)) 

+      FI; 

+      xx0 := real (x0); 

+      yy0 := real (y1); 

+      xx1 := real (x1); 

+      yy1 := real (y1); 

+      IF clipped line (xx0,yy0,xx1,yy1) 

+         THEN moveto (int (xx0), int (yy0)); 

+              drawto (int (xx1), int (yy1)) 

+      FI; 

+      xx0 := real (x1); 

+      yy0 := real (y1); 

+      xx1 := real (x1); 

+      yy1 := real (y0); 

+      IF clipped line (xx0,yy0,xx1,yy1) 

+         THEN moveto (int (xx0), int (yy0)); 

+              drawto (int (xx1), int (yy1)) 

+      FI; 

+      xx0 := real (x1); 

+      yy0 := real (y0); 

+      xx1 := real (x0); 

+      yy1 := real (y0); 

+      IF clipped line (xx0,yy0,xx1,yy1) 

+         THEN moveto (int (xx0), int (yy0)); 

+              drawto (int (xx1), int (yy1)) 

+      FI

+END PROC std box;

diff --git a/app/mpg/1987/src/terminal plot b/app/mpg/1987/src/terminal plot
new file mode 100644
index 0000000..d4eccbd
--- /dev/null
+++ b/app/mpg/1987/src/terminal plot
@@ -0,0 +1,113 @@
+(* Prozeduren zur Ausgabe auf ASCII-Terminals *)

+INT CONST up         :=  1 ,

+          right      :=  1 ,

+          down       := -1 ,

+          left       := -1 ;

+ 

+INT VAR x pos := 0 ,

+        y pos := 0 ,

+        new x pos ,

+        new y pos ;

+ 

+BOOL VAR plot := FALSE;

+TEXT CONST empty line :: 79 * " ";

+ROW 24 TEXT VAR display;

+ 

+ 

+PROC plot vector (INT CONST dx , dy) :

+ 

+  IF dx >= 0

+    THEN IF   dy >  dx THEN vector (y pos, x pos, dy, dx, up, right)

+         ELIF dy >   0 THEN vector (x pos, y pos, dx, dy, right, up)

+ 

+         ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down)

+         ELSE               vector (y pos, x pos, -dy, dx, down, right)

+         FI

+    ELSE IF   dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left)

+         ELIF dy >   0 THEN vector (x pos, y pos, -dx, dy, left, up)

+ 

+         ELIF dy >  dx THEN vector (x pos, y pos, -dx, -dy, left, down)

+         ELSE               vector (y pos, x pos, -dy, -dx, down, left)

+         FI

+  FI .

+ 

+ENDPROC plot vector ;

+ 

+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :

+

+  prepare first step ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO dx REP

+    do one step

+  PER .

+ 

+prepare first step :

+  point;

+  INT VAR old error := 0 ,

+          up right error := dy - dx ,

+          right error    := dy .

+ 

+do one step :

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error) .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+ENDPROC vector ;

+ 

+ 

+PROC point :

+  IF x pos < 1

+  THEN x pos := 1

+  ELIF x pos > 78

+  THEN x pos := 78 FI;

+

+  IF y pos < 1

+  THEN y pos := 1

+  ELIF y pos > 47

+  THEN y pos := 47 FI;

+

+  INT CONST line :: y pos DIV 2;

+  BOOL CONST above :: (y pos MOD 2) = 1;

+  TEXT CONST point :: display [line+1] SUB (x pos+1),

+             new point :: calculated point;

+ 

+  replace (display [line+1], x pos+1, new point);

+  cursor (x pos, 24-line);

+  out (new point) .

+ 

+calculated point :

+  IF above

+  THEN IF point = "," OR point = "|"

+       THEN "|"

+       ELSE "'" FI

+  ELSE IF point = "'" OR point = "|"

+       THEN "|"

+       ELSE "," FI

+  FI

+ 

+END PROC point;

+ 

+REAL CONST real max int := real (max int);

+INT PROC round (REAL CONST x) :

+  IF x > real max int

+  THEN max int

+  ELIF x < 0.0

+  THEN 0

+  ELSE int (x + 0.5) FI

+

+END PROC round;

diff --git a/app/mpg/2.2/doc/GRAPHIK.dok.e b/app/mpg/2.2/doc/GRAPHIK.dok.e
new file mode 100644
index 0000000..7e61cd4
--- /dev/null
+++ b/app/mpg/2.2/doc/GRAPHIK.dok.e
@@ -0,0 +1,2235 @@
+#type ("prop.lq")##limit (16.0)# 
+#free(10.0)# 
+#headoff##bottomoff# 
+ 
+#type("prop.breit.lq")##center##on("u")#Dokumentation des MPG-Graphik-Systems#off("u")#
+ 
+#free(1.0)#
+#type("prop")##center#Version 2.1 vom 10.09.87 
+ 
+#free(0.5)#
+#center#(c) 1987 Beat Jegerlehner & Carsten Weinholz
+ 
+#page# 
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Inhaltsverzeichnis
+#type("pica.lq")##free(1.0)#
+#type("prop")##limit(16.0)##linefeed(01.0)# 
+#type("pica")##on("u")#Inhaltsverzeichnis#off("u")##type("prop.lq")# 
+#free(0.5)#
+#type ("prop.lq")##limit (16.0)# 
+      Teil  1: Komponenten des Graphik-Systems ...................  1 
+                1.0 GRAPHIK.Basis ................................  1 
+                2.0 GRAPHIK.Configuration/GRAPHIK.Configurator ...  1 
+                3.0 GRAPHIK.Plot .................................  1 
+      Teil  1.1: Generierung der Graphik .........................  2 
+      Teil  1.2: Tasks des Graphik-Systems .......................  3 
+                1.0 Task: 'GRAPHIK' ..............................  3 
+                2.0 Task: 'PLOT' .................................  3 
+                3.0 Task: 'FKT' ..................................  4 
+      Teil  2: Operationen der Basisgraphik ......................  5 
+                1.0 Paket: 'transformation' ......................  5 
+                2.0 Paket: picture ...............................  8 
+                3.0 Paket: 'picfile' .............................  13 
+                4.0 Paket: 'devices' .............................  17 
+      Teil  2.1: Operationen des 'device interface' ..............  19 
+                1.0 Paket: 'device interface' ....................  19 
+      Teil  2.2: Operationen zur Graphik-Ausgabe .................  23 
+                2.0 Paket: 'basisplot' ...........................  23 
+                3.0 Paket: 'plot interface' ......................  27 
+                4.0 Paket: 'plot' ................................  29 
+      Teil  3: Konfigurierung der Graphik ........................  30 
+      Teil  3.1: Der Graphik-Konfigurator ........................  30 
+      Teil  3.2: Erstellung der Konfigurationsdateien ............  31 
+                1.0 Pseudo-Schlüsselworte ........................  32 
+                2.0 Pseudo-Prozeduren ............................  34 
+      Teil  4: Graphik-Applikationen .............................  37 
+      Teil  4.1: Der Funktionenplotter 'FKT' .....................  37 
+                1.0 Allgemeines über FKT .........................  37 
+                2.0 Das FKT-Menue ................................  37 
+                3.0 FKT-Menuepunkte ..............................  38 
+      Teil  4.2: Die TURTLE-Graphik ..............................  44 
+                1.0 Paket: 'turtlegraphics' ......................  44 
+      Stichwortverzeichnis .......................................  XX
+#page(1)# 
+#head on##bottom on# 
+#bottom#
+#right#Seite %
+#end#
+#head#
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Teil 1: Komponenten des Graphik-Systems
+#type("pica.lq")##free(1.0)#
+#end#
+#type("pica")##on("u")##ib(1)#Teil 1: Komponenten des Graphik-Systems#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+ 
+   Das MPG-Graphik-System besteht aus folgenden Komponenten: 
+ 
+   #ib(1)#1.0 GRAPHIK.Basis#ie(1)# 
+ 
+      1.1 #ib(2," (1.1)")#PACKET transformation#ie(2,"")# 
+            - Transformations- und Umrechnungsprozeduren zur Endgerät­
+              unabhängigen Abbildung von PICTURES bzw. PICFILES. 
+ 
+      1.2 #ib(2," (1.2)")#PACKET picture#ie(2,"")# 
+            - Verwaltung des Datentyps PICTURE, der eine Bildebene objekt­
+              orientiert beschreibt. 
+ 
+      1.3 #ib(2," (1.3)")#PACKET picfile#ie(2,"")# 
+            - Verwaltung des Datentyps PICFILE, der ein aus verschiedenen Bild­
+              ebenen (PICTURES) bestehendes Bild und seine (allgemeine) Abbildung
+              auf den Endgeräten beschreibt. 
+ 
+      1.4 #ib(2," (1.4)")#PACKET devices#ie(2,"")# 
+            - Allgemeine Verwaltung der verschiedenen Endgeräte. 
+ 
+ 
+   #ib(1)#2.0 GRAPHIK.Configuration/GRAPHIK.Configurator#ie(1)# 
+ 
+      2.1 #ib(2," (2.1)")#PACKET deviceinterface#ie(2,"")# 
+            - Bereitstellung der allgemeinen graphischen Basisoperationen, die
+              für jedes Endgerat gleichartig vorhanden sind. 
+            - Das 'deviceinterface' wird vom 'GRAPHIK.Configurator' bei Bedarf
+              durch geeignetes Zusammenbinden veschiedener Endgerät-
+              Konfigurationsdateien automatisch erzeugt. 
+ 
+ 
+   #ib(1)#3.0 GRAPHIK.Plot#ie(1)# 
+ 
+      3.1 #ib(2," (3.1)")#PACKET basisplot#ie(2,"")# 
+            - Bereitstellung der von der EUMEL-Graphik benötigten
+              Basisoperationen. 
+ 
+      3.2 #ib(2," (3.2)")#PACKET plotinterface#ie(2,"")# 
+            - Paket zur Ansteuerung und Kontrolle der Endgeräte. 
+ 
+      3.3 #ib(2," (3.3)")#PACKET plot#ie(2,"")# 
+            - Ausgabeprozeduren für PICTURES bzw. PICFILES für alle Endgeräte. 
+#page# 
+#type("pica")##on("u")##ib(1)#Teil 1.1: Generierung der Graphik#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+   Es wird zunächst eine Task 'GRAPHIK' (o.ä.) eingerichtet. 
+   Das MPG-Graphik-Sytem befindet sich auf der Diskette 'GRAPHIK 2.1': 
+ 
+      - archive  ("GRAPHIK 2.1") 
+      - fetch    ("GRAPHIK.Install",archive) 
+      - run      ("GRAPHIK.Install") 
+ 
+   'GRAPHIK.Install' enthält ein Generierungsprogramm, das die weitere Generierung
+   des Graphik-Systems vornimmt. 
+   Existiert auf dem Archiv eine Datei 'GRAPHIK.Configuration', so wird nachge­
+   fragt, ob das Graphiksystem hinsichtlich der anzusteuernden Endgeräte neu­
+   konfiguriert('GRAPHIK.Configuration' also in Abhängigkeit von den ebenfalls
+   auf der Diskette vorhandenen Endgerät-Konfigurationsdateien neu erstellt
+   werden soll). Fehlt 'GRAPHIK.Configuration', so wird es zwangsläufig neu er­
+   stellt (siehe 'Neukonfiguration des Graphik-Systems', S. #to page ("newconf")#). 
+   Mit der im Hintergrund ablaufenden Installation des Plotmanagers in der
+   (Sohn-)Task 'PLOT' (siehe 'Funktion von PLOT', S.#to page ("plotmanager")#) steht dann die Graphik allen
+   Sohntasks von 'GRAPHIK' zur Verfügung: 
+ 
+                                  . 
+                                  . 
+                               GRAPHIK 
+                                  PLOT 
+                                  FKT 
+                                  EUCLID 
+                                  user 
+                                  usw. 
+                                  . 
+                                  . 
+#page# 
+#type("pica")##on("u")##ib(1)#Teil 1.2: Tasks des Graphik-Systems#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+ 
+   #ib(1)#1.0 Task: 'GRAPHIK'#ie(1)# 
+ 
+      'GRAPHIK' ist die Ausgangstask des Graphik-Systems; in ihr werden (s.o) die
+      einzelnen Graphikpakete insertiert, und stehen den Sohntasks zur Verfügung
+      (siehe 'Operationen der Basisgraphik', S. #topage("gfuncts")#). Zusätzlich kann sie den Plot­
+      manager in der Task 'PLOT' kontrollieren 
+ 
+   #ib(1)#2.0 Task: 'PLOT'#ie(1)##goalpage("plotmanager")# 
+ 
+      'PLOT' enthält den Multispool-Manager des Graphik-Systems, der die indirekte
+      Ausgabe von PICFILES auf jedem Endgerät der Station ermöglicht. Der Manager
+      verwaltet im Gegensatz zum 'PRINTER' aber nicht nur eine Warteschlange bzw.
+      Server sondern mehrere (die Anzahl ist durch die Konstante 'max spools' in
+      'GRAPHIK.Manager' festgelegt). 
+      (Achtung !, eine Task kann nicht mehr als 255 Datenräume, also Einträge in
+      Warteschlangen verwalten !). 
+      Sollte PLOT neben PRINTER zur graphischen Ausgabe auf dem Drucker arbei­
+      ten, so ist in PRINTER 'spool control task (/"PLOT")' einzustellen. 
+      Der Plotmanager besitzt eine Kommandoebene, die wie folgt arbeitet: 
+         Nach 'continue' erscheint der Prompt 'All-Plotter', der anzeigt, daß nach­
+         folgende Kommandos gleichermassen auf alle Spools/Server wirken; sollen
+         die Kommandos auf nur einen Spool/Server wirken, so ist dieser mit 'select
+         plotter' einzustellen, was durch eine Änderung des Prompts auf den
+         Plotternamen angezeigt wird. 
+ 
+            - 2.1 #ib(2," (2.1)")#listspool#ie(2,"")# 
+                 Gibt Auskunft über die Inhalte und Aktivitäten aller bzw. des
+                 gewählten Spools. 
+ 
+            - 2.2 #ib(2," (2.2)")#clearspool#ie(2,"")# 
+                 Initialisiert nach Rückfrage alle bzw. den gewählten Spool;
+                 sämtliche Einträge werden gelöscht, evtl. laufende Ausgaben
+                 abgebrochen (der Server beendet). 
+ 
+            - 2.3 #ib(2," (2.3)")#spool control#ie(2,"")# 
+                 (TEXT CONST control task) 
+                 Stellt die Task mit dem Namen 'control task' und alle ihre Söhne
+                 als privilegiert ein, d.h. Kommandos wie 'start', 'stop' usw. werden
+                 von diesen Tasks wie auch von Systemstasks und von 'GRAPHIK'
+                 aus zugelassen. 
+ 
+            - 2.4 #ib(2," (2.4)")#stop#ie(2,"")# 
+                 Unterbricht eine evtl. laufende Ausgabe und unterbindet die
+                 weitere Ausgabe von Einträgen aller bzw. des gewählten Spools;
+                 wobei nach Rückfrage die abgebrochene Ausgabe als erster
+                 Eintrag erneut eingetragen wird. 
+ 
+            - 2.5 #ib(2," (2.5)")#start#ie(2,"")# 
+                 Nimmt die Ausgabe des gewählten bzw. aller Spools wieder auf. 
+ 
+            - 2.6 #ib(2," (2.6)")#halt#ie(2,"")# 
+                 Unterbindet die weitere Ausgabe von Einträgen aller bzw. des
+                 gewählten Spools; evtl. laufende Ausgaben werden jedoch nicht
+                 abgebrochen. 
+ 
+            - 2.7 #ib(2," (2.7)")#select plotter#ie(2,"")# 
+                 Bietet als Auswahl die Endgeräte der Station an; die obenge­
+                 nannten Operationen wirken danach nur auf den gewählten Spool,
+                 was durch die Änderung des Prompts auf den Namen des gewählten
+                 Endgerätes angezeigt wird. 
+                 Der Abbruch der Auswahloperation führt dementsprechend wieder
+                 zur Einstellung 'All-Plotter'. 
+                 Das aktuell zu kontrollierende Endgerät kann jedoch auch mit
+                 den Standard-Auswahloperationen gewählt werden; diese lassen
+                 aber auch die Wahl von Plottern anderer Stationen zu, was im
+                 Plotmanager als 'All-Plotter' gewertet wird. 
+ 
+         Folgende Funktionen können nur auf einzelne Spools; also nicht auf
+         'All-Plotter' angewendet werden: 
+ 
+            - 2.8 #ib(2," (2.8)")#killer#ie(2,"")# 
+                 Bietet im Dialog alle im Spool enthaltenen Einträge zum Löschen
+                 an. 
+ 
+            - 2.9 #ib(2," (2.9)")#first#ie(2,"")# 
+                 Bietet im Dialog alle dem ersten Eintrag nachfolgenden Einträge
+                 zum Vorziehen an. 
+ 
+   #ib(1)#3.0 Task: 'FKT'#ie(1)# 
+ 
+      Die Task 'FKT' stellt den Funktionenplotter FKT, bzw. dessen menuegesteuerten
+      Monitor als Taskmonitor zur Verfügung. 
+      Wird die Task mit dem Menuepunkt 
+                  'q' - in die Kommandoebene zurueck 
+      verlassen, so werden alle enthaltenen PICFILES gelöscht. 
+      Der Funktionenplotter wird in 'FKT' mit dem Kommando 'fktmanager' instal­
+      liert; er ist jedoch auch in jeder anderen Task mit dem Kommando 'fktplot'
+      erreichbar. 
+ 
+#page# 
+#bottom#
+#right#Seite %
+#end#
+#head#
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Teil 2: Operationen der Basisgraphik
+#type("pica.lq")##free(1.0)#
+#end#
+#type("pica")##on("u")##ib(1)#Teil 2: Operationen der Basisgraphik#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+#goalpage("gfuncts")# 
+   Die Pakete der Basisgraphik sind in der Datei 'GRAPHIK.Basis' enthalten, und
+   realisieren folgende Aufgaben: 
+         - Vektorielle Abbildung virtueller Koordinaten unter Verwendung einer
+           Transformationsmatrix auf die konkrete Endgerät-Zeichenfläche unter
+           Berücksichtigung des eingestellten Teils der Zeichenfläche ('viewport')
+           und des Fensters ('window'). 
+         - Bereitstellung des Datentyps PICTURE, der die gemeinsame Manipulation
+           von Objekten ermöglicht. 
+         - Bereitstellung des Datentyps PICFILE, der die gemeinsame Manipulation
+           von PICTURES hinsichtlich ihrer Ausgabe ermöglicht. 
+         - Bereitstellung des Datentyps PLOTTER, der die freie Auswahl von End­
+           geräten ermöglicht, und Informationen über sie liefert. 
+ 
+   Zu den mit '*' gekennzeichneten Beschreibungen vgl. die Beschreibung im
+   Programmierhandbuch. 
+ 
+      #ib(1)#1.0 Paket: 'transformation'#ie(1)# 
+ 
+         1.1 BOOL PROC #ib(2," (1.1)")#clippedline#ie(2," (PROC)")# 
+              (REAL VAR x0, y0, x1, y1) 
+              - Intern verwendete Prozedur, welche die in den Variablen über­
+                gebenen Anfangs- und Endkoordinaten einer Geraden auf die
+                Ausmaße der aktuellen Endgerät-Zeichenfläche begrenzt. 
+                Es wird zurückgeliefert, ob Teile der übergebenen Geraden inner­
+                halb der Zeichenfläche liegen, also gezeichnet werden müssen. 
+ 
+         1.2 PROC #ib(2," (1.2)")#drawingarea *#ie(2," (PROC)")# 
+              (REAL VAR x cm, REAL VAR y cm, REAL VAR xp, REAL yp) 
+              - Trägt in die übergebenen Variablen die Ausmaße der aktuellen
+                Endgerät-Zeichenfläche in cm und Pixel ein. 
+ 
+         1.3 PROC #ib(2," (1.3)")#getvalues#ie(2," (PROC)")# 
+              (ROW 3 ROW 2 REAL VAR, ROW 2 ROW 2 REAL VAR, 
+               ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) 
+              - Intern verwendete Prozedur, die in die übergebenen Felder die
+                aktuellen Werte der Transformationsmatrix einträgt. 
+ 
+         1.4 BOOL PROC #ib(2," (1.4)")#newvalues#ie(2," (PROC)")# 
+              - Intern verwendete Prozedur, die anzeigt, ob die Transformations­
+                matrix verändert wurde. 
+ 
+         1.5 PROC #ib(2," (1.5)")#oblique *#ie(2," (PROC)")# 
+              (REAL CONST a, b) 
+              - Stellt für o.g. Abbildungsfunktion die Projektionsart
+               'schiefwinklig' ein; 'a;b' ist der Punkt in der X-Y-Ebene, auf den der
+               Einheitsvektor in Z-Richtung abgebildet werden soll. 
+ 
+         1.6 PROC #ib(2," (1.6)")#orthographic *#ie(2," (PROC)")# 
+              - Stellt die Projektionsart 'Paralellprojektion' ein (s.o.). 
+ 
+         1.7 PROC #ib(2," (1.7)")#perspective *#ie(2," (PROC)")# 
+              (REAL CONST x,y,z) 
+              - Stellt die Abbildungsart 'perspektivisch' ein; 'x;y;z' gibt den
+                Fluchtpunkt der Zentralperspektive an. 
+ 
+         1.8 PROC #ib(2," (1.8)")#setdrawingarea#ie(2," (PROC)")# 
+              (REAL CONST x cm, y cm, x p, y p) 
+              - Intern verwendete Prozedur, die vorm Beginn des Zeichnens dem
+                Transformationspaket die Ausmaße der Endgerät-Zeichenfläche
+                übergibt. 
+ 
+         1.9 PROC #ib(2," (1.9)")#setvalues#ie(2," (PROC)")# 
+              (ROW 3 ROW 2 REAL CONST, ROW 2 ROW 2 REAL CONST, 
+               ROW 4 REAL CONST, ROW 2 REAL CONST, ROW 3 REAL CONST) 
+              - Intern verwendete Prozedur, welche die Transformationsmatrix mit
+                den Werten der übergebenen Felder füllt. 
+ 
+         1.10 PROC #ib(2," (1.10)")#transform#ie(2," (PROC)")# 
+              (REAL CONST x, y, z, xp, yp) 
+              - Intern verwendete Prozedur zur Abbildung eines drei­
+                dimensionalen Vektors in virtuellen Koordinaten auf
+                (zweidimensionale) Bildschirmkoordinaten. 
+ 
+         1.11 PROC #ib(2," (1.11)")#view *#ie(2," (PROC)")# 
+              (REAL CONST alpha, phi, theta) 
+              - Stellt für o.g. Abbildungsfunktion zusätzlich die Drehwinkel der
+                Abbildung in Polarkoordinaten ein. 
+                In der derzeitigen Version fehlerhaft ! 
+ 
+         1.12 PROC #ib(2," (1.12)")#view *#ie(2," (PROC)")# 
+              (REAL CONST alpha, phi) 
+              - s.o.; ebenfalls fehlerhaft ! 
+ 
+         1.13 PROC #ib(2," (1.13)")#view *#ie(2," (PROC)")# 
+              (REAL CONST alpha) 
+              - Dreht die Abbildung um den Mittelpunkt der Zeichenfläche um
+                'alpha' Grad ! 
+ 
+         1.14 PROC #ib(2," (1.14)")#viewport *#ie(2," (PROC)")##goalpage("viewport")# 
+              (REAL CONST hormin, hormax, vertmin, vertmax) 
+              - Definiert den verwendeten Teil der Endgerät-Zeichenfläche in
+                Welt- oder Gerätekoordinaten, bei Verwendung dieser Prozedur ist
+                vorangehend 'window (TRUE)' aufzurufen; damit die neuen Werte
+                auch Berücksichtigung finden. 
+ 
+                1. Angabe in Weltkoordinaten (cm): 
+                   'hor min;vert min' - Position der unteren linken Ecke der ver­
+                                        wendeten Zeichenfläche in cm. 
+                   'hor max;vert max' - Position der oberen rechten Ecke der ver­
+                                        wendeten Zeichenfläche in cm. 
+ 
+                2. Angabe in Gerätekoordinaten: 
+                   Es wird eine Angabe in Gerätekoordinaten angenommen, wenn 
+                          hor max < 2.0 und vert max < 2.0 gilt. 
+                   Die Werte werden als Bruchteile der Größe der gesamten Zei­
+                   chenfläche aufgefaßt, wobei für die horizontalen Werte zu­
+                   sätzlich das Verhältnis 'Horizontale/Vertikale' (i.d. Regel > 1)
+                   berücksichtigt wird. 
+                   Das bedeutet für 'vert max' = 'hor max' = 1, 
+                   daß der obere Rand der spezifizierten Zeichenfläche an der
+                   Oberkante der Gesamt-Zeichenfläche, und der rechte Rand an
+                   der rechten Kante des durch die Gesamthöhe der Zeichenfläche
+                   gegebenen Quadrates liegt (unverzerrt). 
+                   Soll die gesamte Zeichenfläche genutzt werden, so ist 'hor min'
+                   = 'vert min' = 0 und 'vert max' = 1 zu setzen; 
+                   'hor max' dagegen auf das Verhältnis 'Horizontale/Vertikale' !.
+                   Die halbe horizontale Verwendung der Zeichenfläche ist durch
+                   Halbierung des Seitenverhältnisses zu erreichen. 
+ 
+         1.15 PROC #ib(2," (1.15)")#window *#ie(2," (PROC)")# 
+              (REAL CONST xmin, xmax, ymin, ymax, zmin, zmax) 
+              - Stellt die Fenstergröße der virtuellen Zeichenfläche, zu der die
+                virtuellen Koordinaten in Bezug gesetzt werden sollen, mittels
+                der gegenüberliegenden Ecken 'min' und 'max' ein. 
+ 
+         1.16 PROC #ib(2," (1.16)")#window *#ie(2," (PROC)")# 
+              (REAL CONST xmin, xmax, ymin, ymax) 
+              - s.o., jedoch für zweidimensionale Darstellungen. 
+ 
+         1.17 PROC #ib(2," (1.17)")#window *#ie(2," (PROC)")# 
+              (BOOL CONST update) 
+              - Die Übergabe von TRUE verursacht die interne Neuberechnung der
+                Transformationsmatrix beim nächsten 'set values'; die immer dann
+                notwendig wird, wenn die Zeichenfläche oder das mit 'viewport'
+                eingestellte virtuelle Fenster verändert werden soll. 
+#page# 
+      #ib(1)#2.0 Paket: picture#ie(1)# 
+ 
+         2.1 #ib(2," (2.1)")#TYPE PICTURE *#ie(2,"")# 
+              - Datentyp zur Verwaltung eines einfarbigen Bildes; das aus entwe­
+                der zwei- oder dreidimensionalen Objekten besteht. 
+ 
+         2.2 OP #ib(2," (2.2)")#:= *#ie(2," (OP)")# 
+              (PICTURE VAR dest, PICTURE CONST source) 
+              - Zuweisungsoperator für den Datentyp PICTURE. 
+ 
+         2.3 PROC #ib(2," (2.3)")#bar *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST width, height, pattern) 
+              - Zeichnet in 'pic' an der aktuellen Position ein Rechteck 
+                'width/height' mit dem Muster 'pattern', wobei zu beachten ist, daß
+                die aktuelle X-Position die horizontale Position der vertikalen
+                Symmetrieachse des Rechtecks angibt. 
+                Als 'pattern' z.Zt. implementiert: 
+                                 0 - nicht gefüllt 
+                                 1 - halb gefüllt (zeitaufwendig!) 
+                                 2 - gefüllt 
+                                 3 - horizontal schraffiert 
+                                 4 - vertikal schraffiert 
+                                 5 - horizontal und vertikal schraffiert 
+                                 6 - diagonal rechts schraffiert 
+                                 7 - diagonal links schraffiert 
+                                 8 - diagonal rechts und links schraffiert 
+ 
+         2.4 OP #ib(2," (2.4)")#CAT *#ie(2," (OP)")# 
+              (PICTURE VAR dest, PICTURE CONST add) 
+              - Fügt die Bilder 'dest' und 'add' in 'dest' zusammen. 
+ 
+         2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x, y, rad, INT CONST pattern) 
+              - Zeichnet in 'pic' an der Position 'x;y' mit dem Radius 'rad' und dem
+                Muster 'pattern' gefüllt ('pattern' z.Zt. wirkungslos) 
+ 
+         2.6 INT PROC #ib(2," (2.6)")#dim *#ie(2," (PROC)")# 
+              (PICTURE CONST pic) 
+              - Liefert die für 'pic' eingestellte Dimensionalität 
+                (2 - zweidimensional; 3 - dreidimensional); wobei die Dimensionali­
+                tät mit der ersten Zeichenoperation eingestellt wird. 
+ 
+         2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x, y, z) 
+              - Zeichnet in 'pic' von der aktuellen Position einen Gerade zur
+                Position 'x;y'. 
+ 
+         2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x, y, z) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height, width) 
+              - Zeichnet in 'pic' an der aktuellen Position 'text' in der Größe
+                'height/width' unter dem Winkel 'angle'. 
+ 
+         2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, TEXT CONST text) 
+              - Zeichnet in 'pic' an der aktuellen Position 'text' in Standardgröße
+                und normaler Ausrichtung. 
+ 
+         2.11 PROC #ib(2," (2.11)")#draw cm *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x cm, y cm) 
+              - Zeichnet in 'pic' eine Gerade zur cm-Position 'x;y', d.h., die Projek­
+                tionseinstellung wird nicht beachtet. 
+ 
+         2.12 PROC #ib(2," (2.12)")#draw cm r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx cm, dy cm) 
+              - Zeichnet in 'pic' eine Gerade zur um 'dx cm;dy cm' verschobenen
+                Zeichenposition, d.h, die Projektionseinstellung wird nicht beach­
+                tet. 
+ 
+         2.13 PROC #ib(2," (2.13)")#draw r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 
+              - Zeichnet in 'pic' eine Gerade der Länge 'dx;dy;dz' relativ zur
+                aktuellen Position. 
+ 
+         2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.15 PROC #ib(2," (2.15)")#extrema *#ie(2," (PROC)")# 
+              (PICTURE CONST pic, REAL VAR x min, x max, y min, y max, z min, z max) 
+              - Trägt in die übergebenen Variablen die grössten und kleinsten
+                Koordinaten aller Objekte in 'pic' ein. 
+ 
+         2.16 PROC #ib(2," (2.16)")#extrema *#ie(2," (PROC)")# 
+              (PICTURE CONST pic, REAL VAR x min, x max, y min, y max) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.17 INT PROC #ib(2," (2.17)")#length *#ie(2," (PROC)")# 
+              (PICTURE CONST pic) 
+              - Liefert die Länge des Objekt-Verwaltungstextes von 'pic'. 
+ 
+         2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x, y, z) 
+              - Fährt den Zeichenstift auf 'pic' an die Position 'x;y;z'. 
+ 
+         2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x, y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.20 PROC #ib(2," (2.20)")#move cm *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST x cm, y cm) 
+              - Die aktuelle Zeichenposition wird auf 'x cm;y cm' verschoben, wobei
+                die Darstellungsart unberücksichtigt bleibt. 
+ 
+         2.21 PROC #ib(2," (2.21)")#move cm r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST d xcm, d ycm) 
+              - Die aktuelle Zeichenposition wird um 'd xcm;d ycm' verschoben,
+                wobei die Darstellungsart unberücksichtigt bleibt. 
+ 
+         2.22 PROC #ib(2," (2.22)")#move r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 
+              - Verschiebt die aktuelle Zeichenposition in 'pic' um 'dx;dy;dz'. 
+ 
+         2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.24 PICTURE PROC #ib(2," (2.24)")#nilpicture *#ie(2," (PROC)")# 
+              - Initialisierungsfunktion; liefert 'leeres Bild'. 
+ 
+         2.25 INT PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# 
+              (PICTURE CONST pic) 
+              - Liefert den für 'pic' eingestellten Stift (Nummer 1 - 16). 
+ 
+         2.26 PROC #ib(2," (2.26)")#pen *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, INT CONST no) 
+              - Stellt den Stift 'no' für 'pic' ein, wobei 'no' die Werte 1 - 16 an­
+                nehmen darf. 
+ 
+         2.27 PICTURE PROC #ib(2," (2.27)")#picture *#ie(2," (PROC)")# 
+              (TEXT CONST objects) 
+              - Die Objektbeschreibung aller Objekte eines Bildes wird in einem
+                Text verwaltet; mit dieser Prozedur wird ein TEXT im entsprechen­
+                den Format in ein PICTURE verwandelt. 
+                Das Format des TEXTes:   <INT>  Dimension : 2- oder 3-D 
+                                         <INT>  Zeichenstift-Nummer 
+                                         <...>  Objekteinträge 
+ 
+                Die Objekteinträge haben folgendes Format: 
+                   <INT> Objektcode <...> Parameter. 
+ 
+                Objektcodes für:    >  Die Parameter entsprechen der 
+                   -  draw       1     Parameterfolge der Prozeduren. 
+                   -  move       2 
+                   -  text       3  >  Vor dem Text wird als <INT> die 
+                   -  move r     4     Textlänge gehalten. 
+                   -  draw r     5 
+                   -  move cm    6 
+                   -  draw cm    7 
+                   -  move cm r  8 
+                   -  draw cm r  9 
+                   -  bar       10 
+                   -  circle    11 
+ 
+         2.28 PROC #ib(2," (2.28)")#rotate *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST alpha, beta, gamma) 
+              - Die Objekte von 'pic' werden gemäß den Winkeln 'alpha;beta;gamma'
+                im positiven Sinne um die X-,Y-,Z-Achse gedreht; wobei nur ein
+                Winkel <> 0.0 sein darf. 
+ 
+         2.29 PROC #ib(2," (2.29)")#rotate *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST alpha) 
+              - Die Objekte von 'pic' werden gemäß dem Winkel 'alpha' im positiven
+                Sinne um die X-Achse gedreht. 
+ 
+         2.30 PROC #ib(2," (2.30)")#stretch *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST xc, yc, zc) 
+              - 'pic' wird um die Faktoren 'xc;yc;zc' gestreckt oder gestaucht:
+                               Faktor > 1 -> Streckung 
+                               Faktor < 1 -> Stauchung 
+                               Faktor < 0 -> zusätzlich Achsenspiegelung 
+ 
+         2.31 PROC #ib(2," (2.31)")#stretch *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST xc, yc) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.32 TEXT PROC #ib(2," (2.32)")#text *#ie(2," (PROC)")# 
+              (PICTURE CONST pic) 
+              - Liefert den Objekt-Verwaltungstext von 'pic'(vergleiche 
+                'picture'). 
+ 
+         2.33 PROC #ib(2," (2.33)")#translate *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy, dz) 
+              - 'pic' wird um 'dx;dy;dz' verschoben. 
+ 
+         2.34 PROC #ib(2," (2.34)")#translate *#ie(2," (PROC)")# 
+              (PICTURE VAR pic, REAL CONST dx, dy) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.35 PROC #ib(2," (2.35)")#where *#ie(2," (PROC)")# 
+              (PICTURE CONST pic, REAL VAR x, y, z) 
+              - Trägt die aktuelle Zeichenposition in 'pic' in die übergebenen
+                Variablen 'x;y;z' ein. 
+ 
+         2.36 PROC #ib(2," (2.36)")#where *#ie(2," (PROC)")# 
+              (PICTURE CONST pic, REAL VAR x, y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+#page# 
+      #ib(1)#3.0 Paket: 'picfile'#ie(1)# 
+ 
+         3.1 #ib(2," (3.1)")#TYPE PICFILE#ie(2,"")# 
+              - Datentyp zur Verwaltung mehrerer Bilder (PICTUREs) und der
+                Darstellungsparameter.(Aktuelle Typnummer: 1102 !). 
+ 
+         3.2 OP #ib(2," (3.2)")#:= *#ie(2," (OP)")# 
+              (PICFILE VAR dest, DATASPACE CONST source) 
+              - Assoziiert das PICFILE 'dest' mit dem DATASPACE 'source'. 
+ 
+         3.3 OP #ib(2," (3.3)")#:= *#ie(2," (OP)")# 
+              (PICFILE VAR dest, PICFILE CONST source): 
+              - Assoziiert das PICFILE 'dest' mit 'source'; wie bei Files entsteht
+                keine Kopie! 
+ 
+         3.4 INT PROC #ib(2," (3.4)")#background *#ie(2," (PROC)")# 
+              (PICFILE CONST pf) 
+              - Liefert die auf 'pf' eingestellte Hintergrundfarbe. 
+ 
+         3.5 PROC #ib(2," (3.5)")#background *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST no) 
+              - Stellt die Farbe 'no' als Hintergrundfarbe für 'pf' ein: 
+ 
+         3.6 PROC #ib(2," (3.6)")#delete picture *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Löscht das aktuelle Bild in 'pf'. 
+ 
+         3.7 PROC #ib(2," (3.7)")#down *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Positioniert in 'pf' ein Bild weiter. 
+ 
+         3.8 PROC #ib(2," (3.8)")#down *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST step) 
+              - Positioniert in 'pf' 'step'-Bilder weiter. 
+ 
+         3.9 BOOL PROC #ib(2," (3.9)")#eof *#ie(2," (PROC)")# 
+              (PICFILE CONST) 
+              - Liefert zurück, ob das aktuelle Bild auch das letzte des PICFILES
+                ist. 
+ 
+         3.10 PROC #ib(2," (3.10)")#extrema *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL VAR x min, x max, y min, y max, z min, z max) 
+              - Trägt in die übergebenen Variablen die kleinsten bzw. größten
+                Koordinaten aller Bilder in 'pf' ein. 
+ 
+         3.11 PROC #ib(2," (3.11)")#extrema *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL VAR x min, x max, y min, y max) 
+              - s.o., jedoch für zweidimensionale PICFILEs. 
+ 
+         3.12 PROC #ib(2," (3.12)")#get *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, FILE VAR source) 
+              - Liest die in 'source' enthaltenen Informationen über Bilder nach
+                'pf' ein. 
+ 
+         3.13 PROC #ib(2," (3.13)")#get values *#ie(2," (PROC)")# 
+              (PICFILE CONST pf,  ROW 3 ROW 2 REAL VAR,ROW 2 ROW 2 REAL VAR, 
+                                  ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) 
+              - Trägt die Werte der Transformationsmatrix von 'pf' in die über­
+                gebenen Variablenfelder ein. 
+ 
+         3.14 PROC #ib(2," (3.14)")#insert picture *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Fügt vor das aktuelle Bild von 'pf' ein leeres Bild ein. 
+ 
+         3.15 BOOL PROC #ib(2," (3.15)")#is first picture *#ie(2," (PROC)")# 
+              (PICFILE CONST pf) 
+              - Liefert zurück, ob das aktuelle auch das erste Bild von 'pf' ist. 
+ 
+         3.16 PROC #ib(2," (3.16)")#oblique *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST a, b) 
+              - Stellt für 'pf' die Projektionsart 'schiefwinklig' ein; 'a;b' ist der
+                Punkt in der X-Y-Ebene, auf den der Einheitsvektor in Z-Richtung
+                abgebildet werden soll. 
+ 
+         3.17 PROC #ib(2," (3.17)")#perspective *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST x, y, z) 
+              - Stellt für 'pf' die Projektionsart 'perspektivisch' ein; 'x;y;z' gibt
+                den Fluchtpunkt der Zentralperspektive an. 
+ 
+         3.18 INT PROC #ib(2," (3.18)")#picture no *#ie(2," (PROC)")# 
+              (PICFILE CONST pf) 
+              - Liefert die Nummer des aktuellen Bildes von 'pf' zurück. 
+ 
+         3.19 INT PROC #ib(2," (3.19)")#pictures *#ie(2," (PROC)")# 
+              (PICFILE CONST pf) 
+              - Liefert die Anzahl der in 'pf' enthaltenen Bilder zurück. 
+ 
+         3.20 PROC #ib(2," (3.20)")#put *#ie(2," (PROC)")# 
+              (FILE VAR dest, PICFILE CONST pf) 
+              - Liest 'pf' nach 'dest' aus. 
+ 
+         3.21 PROC #ib(2," (3.21)")#put picture *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, PICTURE CONST ins) 
+              - Fügt das Bild 'ins' vor das aktuelle Bild von 'pf' ein. 
+ 
+         3.22 PROC #ib(2," (3.22)")#read picture *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, PICTURE VAR pic) 
+              - Trägt das aktuelle Bild von 'pf' in 'pic' ein. 
+ 
+         3.23 PROC #ib(2," (3.23)")#selected pen *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST no, INT VAR color, thickness, linetype,
+               BOOL VAR visible) 
+              - Trägt in die übergebenen Variablen die für den Stift 'no' aktuell
+                eingestellten Werte ein, wobei 'no' die Werte 1 - 16 annehmen darf. 
+ 
+         3.24 PROC #ib(2," (3.24)")#select pen *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST no, INT CONST color, thickness, linetype,
+               BOOL CONST visible) 
+              - Stellt für den Stift 'no' von 'pf' die übergebenen Werte für Farbe,
+                Stiftbreite, Art des Linenzuges ein, wobei 'no' die Werte 1 - 16
+                annehmen darf. 
+                'visible' = FALSE bedeutet, das die mit diesem Stift gezogenen
+                Linien innerhalb bereits durch das Zeichnen entstandener Flächen
+                nicht gezeichnet werden, die Flächen sie also 'verdecken'. 
+                Vordefiniert sind: 
+                             - color: 
+                                     <0 - nicht standardisierte XOR-Modi 
+                                      0 - Löschstift 
+                                      1 - Standardfarbe d. Endgerätes (s/w) 
+                                      2 - rot 
+                                      3 - blau 
+                                      4 - grün 
+                                      5 - schwarz 
+                                      6 - weiss 
+                                      n - Sonderfarben 
+                             - thickness: 
+                                      0 - Standardstrichstärke d. Endgerätes 
+                                      n - Strichstärke in 1/10 mm 
+                             - linetype: 
+                                      0 - keine Linie 
+                                      1 - durchgängige Linie 
+                                      2 - gepunktete Linie 
+                                      3 - kurz gesrichelte Linie 
+                                      4 - lang gestrichelte Linie 
+                                      5 - Strichpunktlinie 
+                               (Standard-Definitionen, die Linetypes können
+                                über 'basisplot' auch verändert werden.) 
+ 
+         3.25 PROC #ib(2," (3.25)")#set values *#ie(2," (PROC)")# 
+              (PICFILE VAR pf,  ROW 3 ROW 2 REAL CONST, 
+                                ROW 2 ROW 2 REAL CONST, 
+                                ROW 4 REAL CONST, 
+                                ROW 2 REAL CONST, ROW 3 REAL CONST) 
+              - Die übergebenen Felder werden in die Transformationsmatrix von
+                'pf' übernommen. 
+ 
+         3.26 PROC #ib(2," (3.26)")#to eof *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Positioniert auf das letzte Bild von 'pf'. 
+ 
+         3.27 PROC #ib(2," (3.27)")#to first pic *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Positioniert auf das erste Bild von 'pf'. 
+ 
+         3.28 PROC #ib(2," (3.28)")#to pic *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST n) 
+              - Positioniert auf das 'n'-te Bild von 'pf'. 
+ 
+         3.29 PROC #ib(2," (3.29)")#up *#ie(2," (PROC)")# 
+              (PICFILE VAR pf) 
+              - Positioniert in 'pf' ein Bild zurück. 
+ 
+         3.30 PROC #ib(2," (3.30)")#up *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, INT CONST step) 
+              - Positioniert in 'pf' 'step'-Bilder zurück. 
+ 
+         3.31 PROC #ib(2," (3.31)")#view *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST alpha, phi, theta) 
+              - Stellt für die Abbildung von 'pf' zusätzlich die Drehwinkel der
+                Abbildung in Polarkoordinaten ein. 
+                In der derzeitigen Version fehlerhaft ! 
+ 
+         3.32 PROC #ib(2," (3.32)")#view *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST alpha, phi) 
+              - s.o.; in der derzeitigen Version fehlerhaft ! 
+ 
+         3.33 PROC #ib(2," (3.33)")#view *#ie(2," (PROC)")# 
+              (REAL CONST alpha) 
+              - Dreht das Bild um den Mittelpunkt der Zeichenfläche um 'alpha'
+                Grad ! 
+ 
+         3.34 PROC #ib(2," (3.34)")#viewport *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST hor min, hor max, vert min, vert max) 
+              - Spezifiziert die Zeichenfläche, auf die 'pf' abgebildet werden soll.
+                Siehe dazu auch 'viewport' im 'transformation'-Paket (S. #topage("viewport")#). 
+ 
+         3.35 PROC #ib(2," (3.35)")#window *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST x min, x max, y min, y max, z min, z max) 
+              - Definiert die virtuelle Zeichenfläche von 'pf'. 
+ 
+         3.36 PROC #ib(2," (3.36)")#window *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, REAL CONST x min, x max, y min, y max) 
+              - s.o., jedoch für zweidimensionale PICFILEs. 
+ 
+         3.37 PROC #ib(2," (3.37)")#write picture *#ie(2," (PROC)")# 
+              (PICFILE VAR pf, PICTURE CONST new) 
+              - Überschreibt das aktuelle Bild von 'pf' mit 'new'. 
+#page# 
+      #ib(1)#4.0 Paket: 'devices'#ie(1)# 
+ 
+         4.1 #ib(2," (4.1)")#TYPE PLOTTER#ie(2,"")# 
+              - Verwaltungstyp zur Repräsentation eines Endgerätes hinsichtlich
+                seiner Station, seines Kanals, seines Namens sowie seiner Zeichen­
+                fläche. Dabei ist zu beachten, daß der gültige Endgerät-
+                Descriptor, der zur Selektion verwendet wird, aus Station, Kanal
+                und Namen besteht; die Namen also nicht eindeutig vergeben
+                werden müssen. 
+ 
+         4.2 OP #ib(2," (4.2)")#:=#ie(2," (OP)")# 
+              (PLOTTER VAR dest, PLOTTER CONST source) 
+              - Zuweisungsoperator für den Datentyp 'PLOTTER'. 
+ 
+         4.3 BOOL OP #ib(2," (4.3)")#=#ie(2," (OP)")# 
+              (PLOTTER CONST left, right) 
+              - Vergleichsoperator für den Datentyp 'PLOTTER'. 
+ 
+         4.4 INT PROC #ib(2," (4.4)")#actual plotter#ie(2," (PROC)")# 
+              - Liefert die interne Verwaltungsnummer des eingestellten End­
+                gerätes (Kein Endgerät eingestellt -> 0). 
+ 
+         4.5 INT PROC #ib(2," (4.5)")#channel#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Liefert den Kanal von 'plotter'. 
+ 
+         4.6 PROC #ib(2," (4.6)")#drawingarea#ie(2," (PROC)")# 
+              (REAL VAR x cm, y cm, INT VAR x p, y p) 
+              - Trägt in die übergebenen Variablen die Maße der 
+                Zeichenfläche des eingestellten Endgerätes ein. 
+ 
+         4.7 PROC #ib(2," (4.7)")#drawingarea#ie(2," (PROC)")# 
+              (REAL VAR x cm, y cm, INT VAR x p, y p, PLOTTER CONST plotter) 
+              - Trägt in die übergebenen Variablen die Maße der Zeichenfläche
+                von 'plotter' ein. 
+ 
+         4.8 PROC #ib(2," (4.8)")#install plotter#ie(2," (PROC)")# 
+              (TARGET VAR new descriptors) 
+              - Übergibt dem Verwaltungspacket den zu verwaltenden Satz End­
+                geräte. Wird intern vom 'device interface' verwendet, kann aber
+                auch im nachhinein zur Installation von Endgeräten anderer
+                Stationen oder zum Ausblenden von Endgeräten dienen. Nachdem
+                die Graphik installiert wurde, können jedoch keine neuen sta­
+                tionseigenen Endgeräte erzeugt werden (oder nur verwaltungs­
+                seitig, d.h. die Ansteuerung fehlt). 
+ 
+         4.9 TEXT PROC #ib(2," (4.9)")#name#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Liefert den Namen von 'plotter' 
+ 
+         4.10 PLOTTER PROC #ib(2," (4.10)")#no plotter#ie(2," (PROC)")# 
+              - Liefert den Endgerät-Descriptor 'kein Plotter'. 
+ 
+         4.11 PLOTTER PROC #ib(2," (4.11)")#plotter#ie(2," (PROC)")# 
+              - Liefert den Endgerät-Descriptor des eingestellten Endgerätes. 
+ 
+         4.12 PLOTTER PROC #ib(2," (4.12)")#plotter#ie(2," (PROC)")# 
+              (TEXT CONST descriptor) 
+              - Liefert den Endgerät-Descriptor des durch 'descriptor' beschrie­
+                benen Endgerätes. 
+                'descriptor' hat folgendes Format: 
+                    <Stationsnummer>/<Kanalnummer>/Endgerätname, 
+                wobei nicht vorhandene Endgeräte abgelehnt werden. 
+ 
+         4.13 TEXT PROC #ib(2," (4.13)")#plotterinfo#ie(2," (PROC)")# 
+              (TEXT CONST descriptor, INT CONST length) 
+              - Liefert einen auf die Länge 'length' eingerichteten TEXT, der
+                'descriptor' in aufbereiteter Form wiedergibt. 
+                Format von 'descriptor' s.o. 
+ 
+        4.14 THESAURUS PROC #ib(2," (4.14)")#plotters#ie(2," (PROC)")# 
+              - Liefert alle vorhandenen Endgeräte in Form o.g. Descriptoren. 
+ 
+         4.15 PROC #ib(2," (4.15)")#select plotter#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Stellt 'plotter' als aktuelles Endgerät ein. 
+ 
+         4.16 PROC #ib(2," (4.16)")#select plotter#ie(2," (PROC)")# 
+              (TEXT CONST descriptor) 
+              - Stellt das durch 'descriptor' beschriebene Endgerät als aktuelles
+                Endgerät ein. 
+ 
+         4.17 PROC #ib(2," (4.17)")#select plotter#ie(2," (PROC)")# 
+              - Bietet eine Auswahl aller Endgeräte an, und stellt das gewählte
+                als aktuelles Endgerät ein. 
+ 
+         4.18 INT PROC #ib(2," (4.18)")#station#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Liefert die Stationsnummer von 'plotter' zurück. 
+#page# 
+#type("pica")##on("u")##ib(1)#Teil 2.1: Operationen des 'device interface'#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+ 
+      Das automatisch vom 'GRAPHIK.Configurator' anhand von Konfigurationsda­
+      teien erstellte Paket 'device interface' realisiert die normierte, jedoch von
+      der Zeichenfläche des Endgeräts abhängige Ansteuerung der verschiedenen
+      Endgeräte. Es entspricht dabei dem Paket 'Endgerät.Basis' der EUMEL-Graphik,
+      geht aber teilweise über dessen Leistungen hinaus.Hinweis: Falls diese Lei­
+      stung nicht bereits endgerätseitig implementiert ist, wird nicht geclipped;
+      die Überschreitung der Zeichengrenzen hat also Undefiniertes zur Folge. 
+      Zudem ist die Mehrheit der Prozeduren ausschließlich nach 'initplot' funk­
+      tionsfähig. 
+ 
+      #ib(1)#1.0 Paket: 'device interface'#ie(1)# 
+ 
+         1.1 INT PROC #ib(2," (1.1)")#background#ie(2," (PROC)")# 
+              - Liefert die Nummer der aktuell für den Hintergrund eingestellten
+                Farbe zurück. 
+ 
+         1.2 PROC #ib(2," (1.2)")#background#ie(2," (PROC)")# 
+              (INT CONST color no) 
+              - Stellt die Farbe 'color no' als Hintergrundfarbe ein. 
+ 
+         1.3 PROC #ib(2," (1.3)")#box#ie(2," (PROC)")# 
+              (INT CONST x1, y1, x2, y2, pattern) 
+              - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken 'x1;y1'
+                und 'x2;y2', das mit dem Muster 'pattern' gefüllt wird, wobei
+                'pattern' endgerätspezifisch ist. 
+ 
+         1.4 PROC #ib(2," (1.4)")#circle#ie(2," (PROC)")# 
+              (INT CONST x, y, rad, from, to) 
+              - Zeichnet an der Stelle 'x;y' einen Kreis (bzw. Kreissegment) des
+                Radius 'rad' mit dem Anfangswinkel 'from' und dem Endwinkel 'to'. 
+ 
+         1.5 PROC #ib(2," (1.5)")#clear#ie(2," (PROC)")# 
+              - Initialisiert die Zeichenfläche des aktuellen Endgerätes, wobei
+                die Zeichenposition auf '0;0' und die Standardfarben 
+                gesetzt werden. 
+ 
+         1.6 PROC #ib(2," (1.6)")#clear#ie(2," (PROC)")# 
+              (BOOL CONST onoff) 
+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe
+                von 'clear' wirkungslos sind; mit TRUE werden sie entsprechend
+                wieder aktiviert. 
+ 
+         1.7 INT PROC #ib(2," (1.7)")#color#ie(2," (PROC)")# 
+              (INT CONST color no) 
+              - Liefert den für die Farbe 'color no' eingestellten Farbwert im
+                normierten RGB-Code von 0-999. 
+ 
+         1.8 INT PROC #ib(2," (1.8)")#colors#ie(2," (PROC)")# 
+              - Liefert die Anzahl möglicher Farben für das aktuelle Endgerät. 
+ 
+         1.9 PROC #ib(2," (1.9)")#draw to#ie(2," (PROC)")# 
+              (INT CONST x, y) 
+              - Zieht von der aktuellen Zeichenposition eine Gerade zur Position
+                'x;y'. 
+ 
+         1.10 PROC #ib(2," (1.10)")#endplot#ie(2," (PROC)")# 
+              - Wartet auf eine Eingabe des Benutzers und beendet dann die
+                graphische Ausgabe; ggf. durch Umschalten in den Text-Modus. 
+                Falls möglich, sollte die ausgegebene Graphik jedoch auf dem
+                Bildschirm erhalten bleiben. 
+ 
+         1.11 PROC #ib(2," (1.11)")#end plot#ie(2," (PROC)")# 
+              (BOOL CONST onoff) 
+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe
+                von 'endplot' wirkungslos sind; mit TRUE werden sie entsprechend
+                wieder aktiviert. 
+ 
+         1.12 PROC #ib(2," (1.12)")#fill#ie(2," (PROC)")# 
+              (INT CONST x, y, INT CONST pattern) 
+              - Die Umgebung von 'x;y' wird mit dem Muster 'pattern' gefüllt, wobei
+                sowohl 'pattern' als auch die genauen Füll-Bedingungen (Art der
+                Umrahmung usw.) endgerätspezifisch sind. 
+ 
+         1.13 INT PROC #ib(2," (1.13)")#foreground#ie(2," (PROC)")# 
+              - Liefert die Nummer der aktuell für den Vordergrund eingestellten
+                Farbe zurück. 
+ 
+         1.14 PROC #ib(2," (1.14)")#foreground#ie(2," (PROC)")# 
+              (INT CONST color no) 
+              - Stellt die Farbe 'color no' als Vordergrundfarbe ein. 
+ 
+         1.15 PROC #ib(2," (1.15)")#get cursor#ie(2," (PROC)")# 
+              (INT VAR x, y, TEXT VAR exit char) 
+              - Nach Aufruf dieser Prozedur sollte das Endgerät die Eingabe
+                einer Position mittels eines graphischen Cursors (i.d.R.
+                Fadenkreuz) ermöglichen. Dieser Modus soll bleibt solange auf­
+                rechterhalten bis eine Taste gedrückt wird; in 'x;y' findet sich
+                dann die Position des Cursors, und in 'exit char' die gedrückte
+                Taste. 
+                Diese Prozedur ist jedoch nicht für das Ein bzw. Ausschalten des
+                graphischen Cursors zuständig, d.h der eingeschaltete Cursor ist
+                ständig sichtbar; bei ausgeschaltetem Cursor kehrt die Prozedur
+                sofort mit 'exit char' = ""0"" zurück. 
+ 
+         1.16 BOOL PROC #ib(2," (1.16)")#graphik cursor#ie(2," (PROC)")# 
+              - Diese Prozedur gibt an, ob graphische Eingabeoperationen und 
+                die dazugehörigen Operationen auf dem aktuellen Endgerät ver­
+                fügbar sind. 
+ 
+         1.17 PROC #ib(2," (1.17)")#graphik cursor#ie(2," (PROC)")# 
+              (INT CONST x, y, BOOL CONST onoff) 
+              - Diese Prozedur schaltet den graphischen Cursor an bzw. aus oder
+                positioniert ihn. Nach dem Einschalten sollte der Cursor perma­
+                nent sichtbar sein. Ein erneutes Einschalten hat die
+                Neupositionierung des Cursors zur Folge. 
+ 
+         1.18 PROC #ib(2," (1.18)")#home#ie(2," (PROC)")# 
+              - Positioniert die aktuelle Zeichenposition auf den Punkt '0;0'; bei
+                eingeschaltetem graphischen Cursor diesen auf die Mitte der
+                Zeichenfläche. 
+ 
+         1.19 PROC #ib(2," (1.19)")#init plot#ie(2," (PROC)")# 
+              - Initialisiert das aktuelle Endgerät zur graphischen Ausgabe,
+                (schaltet ggf. in den Graphik-Modus), wobei der Bildschirm jedoch
+                möglichst nicht gelöscht werden sollte. 
+ 
+         1.20 PROC #ib(2," (1.20)")#move to#ie(2," (PROC)")# 
+              (INT CONST xp, yp) 
+              - Die Position 'xp;yp' wird neue Stiftposition; die Wirkung ist unde­
+                finiert bei Überschreitung der Bildschrimgrenzen. 
+ 
+         1.21 PROC #ib(2," (1.21)")#prepare#ie(2," (PROC)")# 
+              - Bereitet die Ausgabe auf einem Endgerät vor; d.h. die Task wird an
+                den entsprechenden Kanal angekoppelt, und andere Tasks am An­
+                koppeln gehindert (z.B. 'stop' des PRINTER-Servers). Dabei wird die
+                Prozedur erst dann verlassen, wenn die Aktion erfolgreich been­
+                det ist. (z.B. bis zur Freigabe des Kanals). 
+ 
+ 
+         1.22 PROC #ib(2," (1.22)")#set color#ie(2," (PROC)")# 
+              (INT CONST no, rgb) 
+              - Setzt die Farbe von 'no' auf die normierte RGB-Farbkombination
+                'rgb' (0 - 999). 
+ 
+         1.23 PROC #ib(2," (1.23)")#setmarker#ie(2," (PROC)")# 
+              (INT CONST xp, yp, type) 
+              - Zeichnet an der Position 'xp;yp' eine Markierung; wobei die Wir­
+                kung bei Überschreitung der Bildschirmgrenzen undefiniert ist.
+                Als 'type' sollten vorhanden sein: 
+                         0  - Kreuz '+' 
+                         1  - Kreuz diagonal 'x' 
+                            - weitere beliebig 
+ 
+         1.24 PROC #ib(2," (1.24)")#setpalette#ie(2," (PROC)")# 
+              - Initialisiert die Farben des Endgerätes gemäß den im Paket ge­
+                setzten Farben. 
+ 
+         1.25 PROC #ib(2," (1.25)")#setpixel#ie(2," (PROC)")# 
+              (INT CONST xp, yp) 
+              - Setzt das Pixel 'xp;yp' in der aktuellen Schreibfarbe. 
+ 
+         1.26 PROC #ib(2," (1.26)")#stdcolors#ie(2," (PROC)")# 
+              - Initialisiert die Paket-Intern verwendete Farbtabelle auf die
+                standardmäßig für das Endgerät definierten Farben; 
+                wobei die Farben jedoch nicht auf dem Endgerät eingestellt
+                werden. 
+ 
+         1.27 PROC #ib(2," (1.27)")#stdcolors#ie(2," (PROC)")# 
+              (BOOL CONST onoff) 
+              - Die Übergabe von FALSE bewirkt, daß alle nachfolgenden Aufrufe
+                von 'stdcolors' wirkungslos sind; mit TRUE werden sie entspre­
+                chend wieder aktiviert. 
+#page# 
+#type("pica")##on("u")##ib(1)#Teil 2.2: Operationen zur Graphik-Ausgabe#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+       Die Pakete zur Ausgabe von Graphiken (PICFILES) sind in der Datei
+       'GRAPHIK.Basis' enthalten, und realisieren folgende Leistungen: 
+         - Im Datentyp PICTURE bzw. PICFILE in Codierter Form verwendete Ausgabe­
+           prozeduren auf einzelne Objekte unter Berücksichtigung der Abbil­
+           dungsparameter und Zeichenfläche. 
+         - Kommunikations- und Kontrolloperationen auf die Task 'PLOT' zur
+           indirekten Ausgabe von PICFILES. 
+         - Ausgabeoperationen auf den Datentyp PICTURE bzw. PICFILE unter Be­
+           rücksichtung des eingestellten Endgerätes. 
+      Wird für die Angabe von Koordinaten der Typ REAL verwendet, so handelt es
+      sich um virtuelle Koordinaten, d.h. die Ausgabe-Parameter wie 'viewport' und
+      'window' werden berücksichtigt; bei Verwendung von INT ist die Ausgabe end­
+      gerätspezifisch. 
+ 
+      #ib(1)#2.0 Paket: 'basisplot'#ie(1)# 
+ 
+         2.1 PROC #ib(2," (2.1)")#bar *#ie(2," (PROC)")# 
+              (INT CONST x, y, height, width, pattern) 
+              - Zeichnet an der Position 'x;y' ein Rechteck der Länge/Breite
+                'width/height' mit dem Muster 'pattern', wobei 'x;y' die untere linke
+                Ecke des Rechtecks angibt. 
+                Als 'pattern' z.Zt. implementiert: 
+                                 0 - nicht gefüllt 
+                                 1 - halb gefüllt 
+                                 2 - gefüllt 
+                                 3 - horizontal schraffiert 
+                                 4 - vertikal schraffiert 
+                                 5 - horizontal und vertikal schraffiert 
+                                 6 - diagonal rechts schraffiert 
+                                 7 - diagonal links schraffiert 
+                                 8 - diagonal rechts und links schraffiert 
+ 
+         2.2 PROC #ib(2," (2.2)")#bar *#ie(2," (PROC)")# 
+              (REAL CONST height, width, INT CONST pattern) 
+              - siehe oben, jedoch mit Ausgangspunkt an der aktuellen Zeichen­
+                position, wobei zu beachten ist, daß die x-Koordinate die horizon­
+                tale Position der vertikalen Symmetrieachse des Rechtecks angibt. 
+ 
+         2.3 PROC #ib(2," (2.3)")#beginplot#ie(2," (PROC)")# 
+              - Leitet die graphische Ausgabe ein, wobei das Endgerät in seinen
+                Startzustand versetzt wird, und dem Transformationspaket die
+                Abmessungen der Zeichenfläche mitgeteilt werden. 
+ 
+         2.4 PROC #ib(2," (2.4)")#box *#ie(2," (PROC)")# 
+              - Zeichnet eine Umrahmung der gesamten Zeichenfläche (Nicht nur
+                des verwendeten Teiles). 
+ 
+         2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# 
+              (REAL CONST rad, from, to, INT CONST pattern) 
+              - Zeichnet an aktuellen Position einen Kreis od. ein Kreissegment
+                des Radius 'rad'; beginnend bei 'from' bis zum Endwinkel 'to' und
+                gefüllt mit dem Muster 'pattern' ('pattern' z.Zt. nicht
+                implementiert). 
+ 
+         2.6 PROC #ib(2," (2.6)")#draw *#ie(2," (PROC)")# 
+              (INT CONST x, y) 
+              - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. 
+ 
+         2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# 
+              (INT CONST x0, y0, x1, y1) 
+              - Zieht eine Gerade von der Position 'x0;y0' bis zur Position 'x1;y1'. 
+ 
+         2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# 
+              (REAL CONST x, y, z) 
+              - Zieht von der aktuellen Zeichenposition eine Gerade zur
+                (transformierten) 3-D Position 'x;y;z'. 
+ 
+         2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# 
+              (REAL CONST x, y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# 
+              (TEXT CONST text, REAL CONST angle, height, width) 
+              - Zeichnet den TEXT 'text' ab der aktuellen Zeichenposition unter
+                dem Winkel 'angle' und in der Höhe/Breite 'height;width'. 
+ 
+         2.11 PROC #ib(2," (2.11)")#draw *#ie(2," (PROC)")# 
+              - s.o., jedoch in Standard-Ausrichtung (0 Grad) und
+                Standard-Höhe/Breite (0.5/0.5). 
+ 
+         2.12 PROC #ib(2," (2.12)")#draw cm *#ie(2," (PROC)")# 
+              (REAL CONST x cm, y cm) 
+              - Zeichnet von der aktuellen Position eine Gerade zur cm-Position
+                'x cm;y cm'. 
+ 
+         2.13 PROC #ib(2," (2.13)")#draw cm r *#ie(2," (PROC)")# 
+              (REAL CONST x cm, REAL CONST y cm) 
+              - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'x cm;
+                y cm' verschobenen Zielposition. 
+ 
+         2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# 
+              (REAL CONST dx, dy) 
+              - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'dx;dy'
+                Einheiten verschobenen Zielposition. 
+ 
+         2.15 PROC #ib(2," (2.15)")#draw r *#ie(2," (PROC)")# 
+              (REAL CONST dx, dy, dz) 
+              - Zeichnet von der aktuellen Zeichenposition eine Gerade zur um
+                'dx;dy;dz' Einheiten verschobenen und transformierten 3-D Ziel­
+                position. 
+ 
+         2.16 PROC #ib(2," (2.16)")#hidden lines *#ie(2," (PROC)")# 
+              (BOOL CONST visible) 
+              - Schaltet die vektorisierte Speicherung aller zukünftigen Aus­
+                gabe ein (FALSE) bzw. aus.Ist dieser Modus eingeschaltet, so werden
+                alle durch vorheriges Zeichnen entstandenen Flächen beim Zeichen
+                berücksichtigt, also nicht übermalt; sie 'verdecken' die weiteren
+                Linien. 
+ 
+         2.17 PROC #ib(2," (2.17)")#linetype#ie(2," (PROC)")# 
+              (INT CONST line no, TEXT CONST bitpattern) 
+              - Stellt für den Linientyp 'line no' das Bitmuster 'bitpattern' ein;
+                wobei der 'bitpattern'-TEXT ausschließlich aus den Zeichen '0' und
+                '1' bestehen sollte. 
+ 
+         2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# 
+              (INT CONST x,y) 
+              - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. 
+ 
+         2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# 
+              (REAL CONST x, y, z) 
+              - Zeichnet von der aktuellen Position eine Gerade zur trans­
+                formierten 3-D-Position 'x;y;z' 
+ 
+         2.20 PROC #ib(2," (2.20)")#move *#ie(2," (PROC)")# 
+              (REAL CONST x, y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.21 PROC #ib(2," (2.21)")#move cm#ie(2," (PROC)")# 
+              (REAL CONST x cm, y cm) 
+              - Setzt die aktuelle Zeichenposition auf die cm-Position 'x cm,;y cm'. 
+ 
+         2.22 PROC #ib(2," (2.22)")#move cm r *#ie(2," (PROC)")# 
+              (REAL CONST d x cm, d y cm) 
+              - Zeichnet von der aktuellen Position eine Gerade zur um
+                'd x cm;d y cm' verschobenen Zielposition. 
+ 
+         2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# 
+              (REAL CONST d x, d y, d z) 
+              - Zeichnet von der aktuellen Position eine Gerade zur um 'd x;d y;d z'
+                Einheiten verschobenen und transformierten Zielposition. 
+ 
+         2.24 PROC #ib(2," (2.24)")#move r *#ie(2," (PROC)")# 
+              (REAL CONST d x, d y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.25 PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# 
+              (INT CONST background, foreground, thickness, linetype) 
+              - Aktiviert für alle folgenden Ausgaben mit virtuellen Koordi­
+                naten den Hintergrund 'background'; die Schreibfarbe
+                'foreground'; die Zeichenstärke 'thickness' in 1/10 mm und den
+                Linientyp 'linetype' (i.d.R. 1-6). Vergleiche 'select pen'. 
+ 
+         2.26 PROC #ib(2," (2.26)")#reset *#ie(2," (PROC)")# 
+              - Die mit 'hidden lines (FALSE)' vektorisiert abgespeicherte
+                Ausgabe wird gelöscht. 
+ 
+         2.27 PROC #ib(2," (2.27)")#reset linetypes *#ie(2," (PROC)")# 
+              - Setzt die Linientypen 1-6 auf Standard-Linientypen: 1 - durch­
+                          gängige Linie 
+                          2 - gepunktete Linie 
+                          3 - kurz gestrichelte Linie 
+                          4 - lang gestrichelte Linie 
+                          5 - Strichpunktlinie 
+ 
+         2.28 PROC #ib(2," (2.28)")#reset zeichensatz *#ie(2," (PROC)")# 
+              - Setzt den Zeichensatz auf den Standard-Zeichensatz 'ZEICHENSATZ'. 
+ 
+         2.29 PROC #ib(2," (2.29)")#where *#ie(2," (PROC)")# 
+              (REAL VAR x, y, z) 
+              - Trägt die aktuelle Zeichenposition als (retransformierte) 3-D
+                Position in die übergeben Variablen ein. 
+ 
+         2.30 PROC #ib(2," (2.30)")#where *#ie(2," (PROC)")# 
+              (REAL VAR x, y) 
+              - s.o., jedoch für zweidimensionale Bilder. 
+ 
+         2.31 PROC #ib(2," (2.31)")#zeichensatz *#ie(2," (PROC)")# 
+              (TEXT CONST zeichenname) 
+              - Lädt den Zeichensatz 'zeichenname' zur Verwendung bei Beschrif­
+                tungen. 
+#page# 
+      #ib(1)#3.0 Paket: 'plot interface'#ie(1)# 
+ 
+         3.1 THESAURUS OP #ib(2," (3.1)")#ALL#ie(2," (OP)")# 
+              (PLOTTER CONST plotter) 
+              - Liefert die Namen der z.Zt. im Spool 'plotter' zur indirekten
+                Graphik-Ausgabe gespoolten task-eigenen PICFILES. 
+                Bei Aufruf aus 'GRAPHIK' werden die Namen aller zur Ausgabe
+                gespoolten PICFILES geliefert. 
+ 
+         3.2 PROC #ib(2," (3.2)")#erase#ie(2," (PROC)")# 
+              (TEXT CONST picname, PLOTTER CONST plotter) 
+              - Löscht nach Rückfrage das im Spool 'plotter' zur indirekten
+                Graphik-Ausgabe gespoolte task-eigene PICFILE 'picname'. 
+                Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe
+                gespoolter PICFILES möglich. 
+ 
+         3.3 PROC #ib(2," (3.3)")#erase#ie(2," (PROC)")# 
+              (THESAURUS CONST piclist, PLOTTER CONST plotter) 
+              - Löscht im Dialog alle in 'piclist' und im Spool 'plotter' zur in­
+                direkten Graphik-Ausgabe gespoolten task-eigenen PICFILES. 
+                Bei Aufruf aus 'GRAPHIK' ist auch das Löschen fremder zur Ausgabe
+                gespoolter PICFILES möglich. 
+ 
+         3.4 BOOL PROC #ib(2," (3.4)")#exists#ie(2," (PROC)")# 
+              (TEXT CONST picname, PLOTTER CONST plotter) 
+              - Liefert zurück, ob z.Zt. im Spool 'plotter' ein task-eigenes PICFILE
+                'picname' zur indirekten Graphik-Ausgabe gespoolt wird. 
+                Bei Aufruf aus 'GRAPHIK' kann auch die Existenz fremder zur Aus­
+                gabe gespoolter PICFILES erfragt werden. 
+ 
+         3.5 PROC #ib(2," (3.5)")#first#ie(2," (PROC)")# 
+              (TEXT CONST picname, PLOTTER CONST plotter) 
+              - Zieht das im Spool 'plotter' zur indirekten Ausgabe gespoolte
+                PICFILE 'picname' an die erste Stelle der Warteschlange. Der Auf­
+                ruf ist nur aus 'GRAPHIK' zulässig. 
+ 
+         3.6 PROC #ib(2," (3.6)")#generate plotmanager#ie(2," (PROC)")# 
+              - Erzeugt die Task 'PLOT', in der dann im Hintergrund der Plot­
+                manager insertiert wird. Dabei darf 'PLOT' zuvor nicht existieren,
+                und in der Task muß die Datei 'GRAPHIK.Manager' vorhanden sein. 
+ 
+         3.7 PROC #ib(2," (3.7)")#halt#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Unterbindet die weitere indirekte Graphik-Ausgabe aus dem Spool
+                'plotter'; eine aktuell laufende Ausgabe wird jedoch nicht ab­
+                gebrochen. Der Aufruf ist nur aus 'GRAPHIK' zulässig. 
+ 
+         3.8 PROC #ib(2," (3.8)")#list#ie(2," (PROC)")# 
+              (FILE VAR list file, PLOTTER CONST plotter) 
+              - Erzeugt in 'list file' eine Inhalts/Aktivitätsübersicht des Spools
+                'plotter'. 
+ 
+         3.9 PROC #ib(2," (3.9)")#list#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Zeigt eine Inhalts/Aktivitätsübersicht des Spools 'plotter'. 
+ 
+         3.10 THESAURUS PROC #ib(2," (3.10)")#picfiles#ie(2," (PROC)")# 
+              - Liefert eine Liste der Namen aller in der Task enthaltenen
+                PICFILES. 
+ 
+         3.11 PROC #ib(2," (3.11)")#save#ie(2," (PROC)")# 
+              (TEXT CONST picname, PLOTTER CONST plotter) 
+              - Sendet das PICFILE 'picname' zwecks indirekter Graphik-Ausgabe
+                zum Spool 'plotter'. 
+ 
+         3.12 PROC #ib(2," (3.12)")#save#ie(2," (PROC)")# 
+              (THESAURUS CONST piclist, PLOTTER CONST plotter) 
+              - Sendet alle in 'piclist' namentlich enthaltenen PICFILES zwecks
+                indirekter Graphik-Ausgabe zum Spool 'plotter'. 
+ 
+          3.13 PROC #ib(2," (3.13)")#start#ie(2," (PROC)")# 
+               (PLOTTER CONST plotter) 
+               - Nimmt die zuvor mit 'halt','wait for halt','stop' oder spoolseitig
+                 unterbrochene indirekte Graphik-Ausgabe des Spools 'plotter'
+                 wieder auf. Der Aufruf ist nur aus 'GRAPHIK' zulässig. 
+ 
+         3.14 PROC #ib(2," (3.14)")#stop#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Unterbricht sofort die aktuell laufende Ausgabe des Spools
+                'plotter', und unterbindet weitere Ausgaben. Nach Rückfrage wird
+                das PICFILE, das aktuell ausgegeben wurde, erneut an erster
+                Steller der Warteschlange eingetragen. 
+ 
+         3.15 PROC #ib(2," (3.15)")#wait for halt#ie(2," (PROC)")# 
+              (PLOTTER CONST plotter) 
+              - Unterbindet die weitere Ausgabe der
+                gespoolten PICFILES, und wartet bis die aktuell laufende Ausgabe
+                beendet ist. 
+#page# 
+      #ib(1)#4.0 Paket: 'plot'#ie(1)# 
+ 
+         4.1 PROC #ib(2," (4.1)")#plot *#ie(2," (PROC)")# 
+              (PICTURE CONST picture) 
+              - Ausgabe der Objektebene 'picture', unter Verwendung des in
+                'picture' angegebenen Stiftes gemäß seiner aktuellen Einstellung
+                im 'basisplot'.Nur für Direkt-Ausgaben verwendbar. 
+ 
+         4.2 PROC #ib(2," (4.2)")#plot *#ie(2," (PROC)")# 
+              (PICFILE CONST pf) 
+              - Ausgabe des Bildes 'pf' unter vollständiger Berücksichtung der in
+                'pf' mit 'select pen';'window';'viewport' usw. eingestellten
+                Ausgabeparameter. Nur für Direkt-Ausgaben verwendbar. 
+ 
+         4.3 PROC #ib(2," (4.3)")#plot *#ie(2," (PROC)")# 
+              (TEXT CONST picfile name) 
+              - Direkte oder indirekte Ausgabe des Bildes 'picfile name'. 
+                Bei direkter Ausgabe wird obiges 'plot' verwendet; bei indirekter
+                Ausgabe wird das PICFILE an den aktuell eingestellten Spool zur
+                graphischen Ausgabe gesendet. 
+#page# 
+#bottom#
+#right#Seite %
+#end#
+#head#
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Teil 3: Konfigurierung der Graphik
+#type("pica.lq")##free(1.0)#
+#end#
+#type("pica")##on("u")##ib(1)#Teil 3: Konfigurierung der Graphik#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+ 
+#type("pica")##on("u")##ib(1)#Teil 3.1: Der Graphik-Konfigurator#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+#goalpage("newconf")# 
+       Die MPG-EUMEL-Graphik besitzt eine normierte Schnittstelle zu allen graphischen
+       Endgeräten. Diese wird vom Programm 'GRAPHIK.Configurator' aus verschiede­
+       nen Dateien, die einer gewissen Syntax zu genügen haben, zu einem Paket
+       namens 'device interface' zusammengefügt. Diese Dateien enthalten verschie­
+       dene Informationen und endgerätspezifische ELAN-Prozeduren, die zur
+       Erzeugung graphischer Primitiva wie Gerade, Kreis, Rechteck und zur Be­
+       rechnung der konkreten Abbildung graphischer Objekte sowie zur Realisa­
+       tion von Eingaben benötigt werden. Das Konfigurationsprogramm erkennt
+       diese Dateien an der Namensendung '.GCONF', und bietet diese zu
+       Programmbeginn zur Auswahl an. 
+       Dann werden die gewählten Dateien inhaltlich untersucht und die relevan­
+       ten Informationen, Rümpfe der benötigten Prozeduren sowie alle vom Benut­
+       zer zusätzlich eingetragenen globalen Objekte (globale Variablen,
+       LET-Objekte, zusätzlich benötigte Prozeduren usw.) vom Programm extrahiert
+       und zwischengespeichert. 
+       Im letzten Schritt erstellt das Programm schließlich das Paket 'device
+       interface' in der Datei 'GRAPHIK.Configuration', indem die zwischengespei­
+       cherten Texte sinnvoll zusammengefügt werden. 
+       Die benötigten Konfigurationsdateien sind relativ einfach zu erstellen, da
+       sich der Programmierer ausschließlich mit der Realisation der geforderten
+       Leistungen auf einem Endgerät-Typ befassen kann, da die programmseitige
+       Einbindung ins Graphiksystem vom Konfigurationsprogramm vorgenommen
+       wird. 
+#page# 
+#type("pica")##on("u")##ib(1)#Teil 3.2: Erstellung der Konfigurationsdateien#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+      Namensgebung: "<Endgerätname><Kanalangaben>.GCONF" 
+         Konfigurationsdateien zur Anbindung eines Endgerät-Types auf der
+         eigenen Station enthalten die benötigten ELAN-Quelltexte zur Realisa­
+         tion der geforderten Leistungen und weitere Verwaltungs- und Berech­
+         nungsoperationen. 
+         Das Konfigurationsprogramm erkennt die relevanten Daten bzw. Quelltexte
+         dieser Dateien an verschiedenen Pseudo-Schlüsselworten bzw. Pseudo-
+         Prozedurdeklarationen, wobei die Namensgebung hinsichtlich des Pro­
+         zedurnamens, der Parameter sowie ihrer Namen vollständig festgelegt ist. 
+         Daher ist es unzulässig, Parameternamen zu ändern oder Delimiter
+         (Semikolon, Doppelpunkt) fortzulassen. 
+         Derartige Fehler werden jedoch i.d.R. vom Konfigurationsprogramm
+         erkannt und gemeldet, wohingegen Fehler in den Prozedurrümpfen, den
+         zusätzlichen Prozeduren bzw. das Fehlen zusätzlich benötigter Pro­
+         zeduren nicht erkannt, sondern erst beim Compilieren des Gesamt-Paketes
+         vom ELAN-Compiler gemeldet werden. 
+         (Die Korrektur im Gesamt-Paket sollte unterlassen werden, vielmehr ist
+         der Fehler in der entsprechenden Konfigurationsdatei zu beheben, falls
+         nicht einfach die Einbindung eines zusätzlichen Paketes vergessen
+         wurde.) 
+         Zudem ist zu beachten, daß die benötigten Prozedurrümpfe vom Kon­
+         figurationsprogramm in Refinements umgewandelt werden, und zusätz­
+         liche Objekte (Prozeduren, LET-Objekte, Variablen) einfach mit ein­
+         gebunden werden, so daß: 
+          - Globale und lokale Variablen eindeutig für alle! Konfigurations­
+            dateien benannt werden müssen. 
+            (Zweckmässig: ... VAR endgerätname variablenname) 
+          - Zusätzliche Prozeduren und LET-Objekte ebenso eindeutig benannt
+            werden müssen. 
+          - Überflüssige Delimiter, die aber vom ELAN-Compiler nicht bemängelt
+            werden (z.B. Punkt am Ende des Prozedurrumpfes) nicht vorkommen
+            dürfen. 
+          - Nicht realisierbare Pseudo-Prozeduren mit leerem Rumpf enthalten
+            sein müssen (z.B. Vordergrund/Hintergrund od. Farben bei
+            Monochrom-Endgeräten) 
+          - Prozedur-Köpfe bzw. -Enden allein in einer Zeile und an ihrem Anfang
+            stehen müssen. 
+ 
+      Namensgebung: "ENVIRONMENT.GCONF" 
+         Dient zur verwaltungsseitigen Einbindung von Endgeräten anderer
+         Stationen, da für diese Endgeräte nur die Verwaltungsinformationen
+         benötigt werden, weil die konkrete Anpassung auf der anderen Station
+         erfolgt. 
+         Die in 'ENVIRONMENT.GCONF' zeilenweise enthaltenen Informationen werden
+         dem Benutzer bei der Auswahl der Konfigurationsdateien mit angeboten; er
+         kann sie aber auch 'von Hand' in die THESAURUS-Auswahl einfügen. 
+ 
+      Namensgebung: "Dateizweck" (also beliebig) 
+         Darüberhinaus existieren weitere Dateien, die globale Prozeduren und
+         weitere Objekte enthalten, die für verschiedene Endgerät-Anpassungen
+         nützlich sein können, wie z.B. unten beschriebene Dateien: 
+          - 'std primitives' 
+            Enthält Prozeduren zur softwareseitigen Emulation von zwar gefor­
+            derten, hardwareseitig aber eventuell nicht bereitgestellten
+            Leistungen wie 'circle' und 'box'. 
+          - 'matrix printer' 
+            Enthält Prozeduren zur Erzeugung von Geraden und Füllmustern auf
+            einer Bitmatrix, die zur graphischen Ausgabe auf Druckern benötigt
+            wird. 
+          - 'terminal plot' 
+            Enthält grundlegende Prozeduren zur (behelfsmäßigen) Ausgabe von
+            Graphiken auf Ascii-Terminals (Zeichenorientiert, nicht graphikfähig) 
+ 
+      Folgende Pseudo-Schlüsselworte bzw. Pseudo-Prozeduren werden vom
+      Konfigurationsprogramm erkannt und behandelt: 
+ 
+      #ib(1)#1.0 Pseudo-Schlüsselworte#ie(1)# 
+ 
+         1.1 #ib(2," (1.1)")#COLORS#ie(2,"")# 
+              Syntax: COLORS "RGB-Kombinationen"; 
+              - Dient der Definition der Standard-Farben. 
+                - "RGB-Kombinationen":  (TEXT)  Pro Farbe 3-ziffrige RGB-
+                                                (Rot-Grün-Blau)-
+                                                 Kombinationen in normierter
+                                                 Notation 
+                                                (jeder Farbanteil wird durch
+                                                die Ziffern 0-9 dargestellt;
+                                                sollte das Endgerät dieser
+                                                Notation nicht genügen, so ist
+                                                eine anteilige Umrechnung
+                                                vorzunehmen). 
+                                                Die erste RGB-Kombination
+                                                wird für die Hintergrundfarbe
+                                                verwendet (i.d.R. 000), bei
+                                                monochromen Endgeräten ist
+                                                also "000999" einzusetzen. 
+ 
+         1.2 #ib(2," (1.2)")#EDITOR#ie(2,"")# 
+              Syntax: EDITOR; 
+              - Schlüsselwort, das dem Konfigurationsprogramm anzeigt, daß
+                folgende Eingabeprozeduren vorhanden sind: 
+                - 'graphik cursor' 
+                - 'get cursor' 
+                - 'set marker' 
+                Fehlt das Schlüsselwort, so können o.g. Pseudo-Prozeduren weg­
+                gelasssen werden, brauchen also nicht mit leerer Leistung
+                implementiert werden. 
+ 
+         1.3 #ib(2," (1.3)")#INCLUDE#ie(2,"")# 
+              Syntax: INCLUDE "Name der Includedatei"; 
+              - Schlüsselwort, mit dem weitere Dateien in die Konfigurationsdatei
+                textuell eingebunden werden können (s.o). 
+ 
+         1.4 #ib(2," (1.4)")#LINK#ie(2,"")# 
+              Syntax: LINK <Station>/<Kanal>, .... ; 
+              - Dient zur Anbindung mehrerer Endgeräte an einen Endgerät-Typ,
+                die hier genannten Kanäle werden eigenständig verwaltet, aber
+                wie das bei 'PLOTTER' definierte Endgerät angesteuert; wobei für
+                alle Endgeräte der gleiche Name gilt, sie also durch die Kanal­
+                nummer unterschieden werden. 
+                Durch Kommata getrennt, können mit dieser Anweisung beliebig
+                viele Endgeräte zusätzlich angebunden werden. 
+                - <Station>     :  (INT)  Stationsnummer des Endgerätes
+                                          (eigene Station) 
+                - <Kanal>       :  (INT)  Kanalnummer des Endgerätes 
+ 
+         1.5 #ib(2," (1.5)")#PLOTTER#ie(2,"")# 
+              Syntax: PLOTTER "Endgerätname",<Station>,<Kanal>, 
+                              <Xpixel>,<Ypixel>,<Xcm>,<Ycm>; 
+              - Dient zur Erkennung als Endgerät-Konfigurationsdatei, und zur
+                Übergabe der verwaltungsseitig benötigten
+                Endgerät-Spezifikationen: 
+                - "Endgerätname":  (TEXT)  Name des Endgerätes 
+                - <Station>     :  (INT)   Stationsnummer des Endgerätes
+                                           (eigene Station) 
+                - <Kanal>       :  (INT)   Kanalnummer des Endgerätes 
+                Jedes Endgerät wird über diese drei Werte eindeutig identifiziert,
+                der Endgerätname kann also mehrfach verwendet werden. 
+                - <Xpixel>      :  (INT)   X-Rasterkoordinate des letzten
+                                           Pixels in X-Richtung (i.d.R
+                                           adressierbare Pixel - 1) 
+                - <Ypixel>      :  (INT)   Y-Rasterkoordinate des letzten
+                                           Pixels in Y-Richtung (s.o.) 
+                - <Xcm>         :  (REAL)  Breite der Zeichenfläche in cm. 
+                - <Ycm>         :  (REAL)  Höhe der Zeiuchenfläche in cm. 
+                (Möglichst genau ausmessen od. berechnen, um Verzerrungen zu
+                vermeiden) 
+                'PLOTTER' muß als erstes in der Konfigurationsdatei stehen! 
+ 
+      #ib(1)#2.0 Pseudo-Prozeduren#ie(1)# 
+ 
+         2.1 PROC #ib(2," (2.1)")#background#ie(2," (PROC)")# 
+              Syntax: PROC background (INT VAR type): 
+              - Stellt die Hintergrundfarbe 'type' ein. Ist bei monochromen End­
+                geräten mit leerer Leistung zu implementieren.In 'type' ist die
+                tatsächlich eingestellte Hintergrundfarbe angegeben, womit die
+                erbrachte Leistung kontrolliert werden kann. 
+ 
+         2.2 PROC #ib(2," (2.2)")#box#ie(2," (PROC)")# 
+              Syntax: PROC box (INT CONST x1, y1, x2, y2, pattern): 
+              - Zeichnet ein Rechteck mit den gegenüberliegenden Ecken
+                'x1;y1/x2;y2'. Sollte das Endgerät diese Leistung nicht erbringen,
+                so muß 'std box' aus 'std.GCONF' mit gleichen Parametern aufge­
+                rufen werden. 
+                'pattern' als Füllmuster kann endgerätspezifisch implementiert
+                werden, wobei von System nur 'pattern' = 0 verwendet wird, was ein
+                ungefülltes Rechteck anfordert. 
+ 
+         2.3 PROC #ib(2," (2.3)")#circle#ie(2," (PROC)")# 
+              Syntax: PROC circle (INT CONST x, y, rad, from, to): 
+              - Zeichnet einen Kreis oder ein Kreissegment an den Raster-
+                Koordinaten 'x;y', die auch neue Zeichenposition werden. 'rad' gibt
+                den Radius und 'from,to' den Start bzw. Endwinkel im mathematisch
+                positivem Sinne an. 
+                Sollte das Endgerät diese Leistung nicht erbringen, so muß 'std
+                circle' aus 'std.GCONF' mit gleichen Parametern aufgerufen werden. 
+ 
+         2.4 PROC #ib(2," (2.4)")#clear#ie(2," (PROC)")# 
+              Syntax: PROC clear: 
+              - Löscht den Bildschirm bzw. initialisiert das Ausgabe-Raster. 
+                Die Zeichenposition wird '0;0' und die Standardfarben werden
+                eingestellt. 
+ 
+         2.5 PROC #ib(2," (2.5)")#drawto#ie(2," (PROC)")# 
+              Syntax: PROC drawto (INT CONST x, y): 
+              - Zieht von der aktuellen Zeichenposition eine Gerade zu den Ko­
+                ordinaten 'x;y', die Zeichenposition wird entsprechend geändert. 
+ 
+         2.6 PROC #ib(2," (2.6)")#endplot#ie(2," (PROC)")# 
+              Syntax: PROC endplot: 
+              - Schließt die Graphik-Ausgabe auf einem Endgerät ab; evtl. Wechsel
+                in den Text-Modus, ggf. Cursor einschalten. 
+                Bei Terminals sollte der Bildschirm nicht gelöscht werden. 
+ 
+         2.7 PROC #ib(2," (2.7)")#fill#ie(2," (PROC)")# 
+              Syntax: PROC fill (INT CONST x, y, pattern): 
+              - Zusätzliche vom System nicht verwendete Leistung zum Füllen von
+                Polygonen (rundum geschlossen), wobei die genau erbrachte Lei­
+                stung und die Bedingungen endgerätspezifisch sind. 
+ 
+         2.8 PROC #ib(2," (2.8)")#foreground#ie(2," (PROC)")# 
+              Syntax: PROC foreground (INT VAR type): 
+              - Stellt die Vordergrundfarbe 'type' ein. Ist bei monochromen
+                Endgeräten mit leerer Leistung zu implementieren.In 'type' ist die
+                tatsächlich eingestellte Hintergrundfarbe angegeben, womit die
+                erbrachte Leistung kontrolliert werden kann. 
+ 
+         2.9 PROC #ib(2," (2.9)")#get cursor#ie(2," (PROC)")# 
+              Syntax: PROC get cursor (INT VAR x, y, TEXT VAR exit char): 
+              - Wartet auf eine Eingabe vom Endgerät, wobei der Cursor beweglich
+                bleiben muß. Wird eine Taste gedrückt, so wird deren Code in 'exit
+                char' und die aktuelle Position des Cursors in 'x;y' eingetragen. 
+                Der Cursor sollte nur innerhalb dieser Prozedur beweglich sein,
+                aber immer sichtbar bleiben (falls er eingeschaltet ist). 
+ 
+         2.10 PROC #ib(2," (2.10)")#graphik cursor#ie(2," (PROC)")# 
+              Syntax: PROC graphik cursor (INT CONST x, y, BOOL CONST on): 
+              - Schaltet einen endgerätseitig vorhandenen graphischen Cursor
+                (i.d.R Fadenkreuz) ein oder aus bzw. setzt ihn auf eine bestimmte
+                Position. 
+                Mit 'on' = TRUE wird der Cursor dauerhaft! eingeschaltet bzw. neu
+                positioniert, falls er bereits eingeschaltet war. 
+                Mit 'on' = FALSE wird er grundsätzlich abgeschaltet. 
+                Durch Einschalten des Cursors wird die Wirkung von 'home'
+                verändert: 
+                           normal - 'home' positioniert die Zeichenposition auf
+                                     '0;0' 
+                           cursor - 'home' positioniert die Zeichenposition und
+                                    den graphischen Cursor auf die Mitte der
+                                    Zeichenfläche. 
+ 
+         2.11 PROC #ib(2," (2.11)")#home#ie(2," (PROC)")# 
+              Syntax: PROC home: 
+              - Die Zeichenposition wird auf '0;0' eingestellt; ist ein graphischer
+                Cursor eingeschaltet, so sollte dieser, sowie die Zeichenposition,
+                jedoch auf den Mittelpunkt der Zeichenfläche gesetzt werden. 
+ 
+         2.12 PROC #ib(2," (2.12)")#initplot#ie(2," (PROC)")# 
+              Syntax: PROC initplot: 
+              - Bereitet die Graphik-Ausgabe auf einem Endgerät vor; evtl.
+                Wechsel in den Graphik-Modus, ggf. Cursor abschalten. 
+                Bei Terminals sollte der Bildschirm nicht gelöscht werden. 
+ 
+         2.13 PROC #ib(2," (2.13)")#moveto#ie(2," (PROC)")# 
+              Syntax: PROC moveto (INT CONST x, y): 
+              - Die Zeichenposition wird auf die Koordinaten 'x;y' gesetzt, bei
+                Überschreitung der Zeichenfläche ist die Wirkung undefiniert. 
+ 
+         2.14 PROC #ib(2," (2.14)")#prepare#ie(2," (PROC)")# 
+              Syntax: PROC prepare: 
+              - Bereitet die Ausgabe auf einem Kanal vor. 
+                Die eigene Task sollte an den Kanal angekoppelt, und andere Tasks
+                ggf. am Ankoppeln gehindert bzw. abgekoppelt werden (z.B. der
+                PRINTER-Server bei Drucker-Graphik). Es darf erst nach erfolg­
+                reichem Abschluß der Aktion zurückgekehrt werden. 
+ 
+         2.15 PROC #ib(2," (2.15)")#set marker#ie(2," (PROC)")# 
+              Syntax: PROC set marker (INT CONST x, y, type): 
+              - Zeichnet an der Position 'x;y', die auch neue Zeichenposition wird,
+                eine Markierung. Folgende Markierungsarten können systemseitig
+                verwendet werden: 
+                                 0 - Kreuz '+' 
+                                 1 - Kreuz diagonal 'x' 
+                Weitere Typen können endgerätspezifisch implementiert werden. 
+ 
+         2.16 PROC #ib(2," (2.16)")#setpalette#ie(2," (PROC)")# 
+              Syntax: PROC setpalette: 
+              - Stellt die aktuell eingestellten RGB-Kombinationen auf dem End­
+                gerät ein. Dazu sind die vom Konfigurationsprogramm
+                hinzugefügten Prozeduren 'colors' und 'color' zu verwenden: 
+                   INT PROC colors 
+                   - Liefert die Anzahl der für das Endgerät möglichen Farben
+                     (abgeleitet aus den mit 'COLOR' angebenen
+                     Standard-Kombinationen). 
+                   INT PROC color (INT CONST no) 
+                   - Liefert die normierte RGB-Kombination der für 'no' ein­
+                     gestellten Farbe (0 - 999). Die Rückgabe von 'maxint' (32767)
+                     bedeutet: Farbe nicht initialisiert oder existiert nicht. 
+ 
+         2.17 PROC #ib(2," (2.17)")#setpixel#ie(2," (PROC)")# 
+              Syntax: PROC setpixel (INT CONST x, y): 
+              - Setzt ein Pixel an den Raster-Koordinaten 'x;y'. 
+#page# 
+#bottom#
+#right#Seite %
+#end#
+#head#
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Teil 4: Graphik-Applikationen
+#type("pica.lq")##free(1.0)#
+#end#
+#type("pica")##on("u")##ib(1)#Teil 4: Graphik-Applikationen#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+ 
+#type("pica")##on("u")##ib(1)#Teil 4.1: Der Funktionenplotter 'FKT'#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+      Mit diesem Programmpaket kann man für beliebige reelle und reellwertige
+      Funktionen Graphen erstellen. Diese Graphen werden im System gespeichert. 
+ 
+      Zur Ausgabe der erstellten Graphen stehen alle graphikfähigen Endgeräte
+      zur Verfügung. 
+ 
+      #ib(1)#1.0 Allgemeines über FKT#ie(1)# 
+           Zu einer Zeichnung, wie sie mit 'FKT' erstellt werden kann, gehören
+           folgende Eigenschaften: 
+              - Der Name der Zeichnung (zum Wiederfinden) 
+              - Das Format 
+              - Der Graph mit den Achsen bzw. dem Rahmen. 
+ 
+           Es können beliebig viele Zeichnungen angelegt und aufbewahrt werden,
+           wobei der Name aller Zeichnungen mit "PICFILE." beginnt. 
+ 
+           Es wird von FKT zwischen den Definitions- und Wertebereich einerseits
+           und dem Format anderseits unterschieden: 
+              - Der Definitionsbereich wird vom Benutzer gewählt. Er gibt das
+                Intervall an, über dem der Graph gezeichnet wird. Der
+                Wertebereich wird vom Rechner automatisch ermittelt. 
+              - Das Format besteht aus der Angabe von vier Werten, die Auskunft
+                geben über die maximale Ausdehnung der Koordinatenachsen, wobei
+                die Zeichnung auf den Endgeräten stets so abgebildet wird, daß sie
+                unverzerrt in maximaler Größe (also im größtmöglichen Quadrat)
+                gezeichnet wird. 
+ 
+           Der Funktionenplotter FKT ist in allen Sohntasks von 'GRAPHIK' verfüg­
+           bar, zusätzlich existiert die Task 'FKT', in der das FKT-Menue als
+           Kommandoebene verwendet wird. 
+ 
+      #ib(1)#2.0 Das FKT-Menue#ie(1)# 
+           Das Menue des Funktionenplotters ist wie folgt aufgebaut: 
+           - in der obersten Zeile wird der eingegebene Funktionsterm angezeigt 
+           - die nachfolgende Zeile zeigt in eckigen Klammern den Definitions­
+             bereich und die Schachtelung des Intervalles, über dem der Graph
+             gezeichnet wird. 
+           - dann folgt ebenfalls in eckigen Klammern der von FKT selbst zu
+             ermittelnde Wertebereich der Funktion innerhalb des zuvor
+             definierten Intervalles. 
+           Wird kein Funktionsterm angezeigt, oder erscheinen in den eckigen
+           Klammern Sternchen, so wurde noch kein Funktionsterm bzw.
+           Definitionsbereich eingegeben, oder der Wertebereich noch nicht
+           ermittelt. 
+           - Der Bereich zwischen o.g Anzeige und der Auflistung der Menuepunkte
+             ist der Dialogbereich, in dem weitere Anfragen an den Benutzer oder
+             auch Fehlermeldungen erscheinen. 
+           - Unterhalb der Bildschirmmitte werden die unten beschriebenen
+             Menuepunkte zur Auswahl aufgeführt. 
+           - Dann folgt der Endgerät-Auswahlbereich, das Endgerät, auf dem eine
+             Zeichnung ausgegeben werden soll, kann mit den Tasten 'Links' bzw.
+             'Rechts' eingestellt werden, wobei der Name des aktuell eingestellten
+             Endgerätes invertiert erscheint. 
+           - Als unterste Zeile der FKT-Tapete folgt der Eingabebereich, hier wird
+             der Benutzer zur Eingabe eines bei den Menuepunkten genannten
+             Buchstabens aufgefordert, und dieser bei einem zulässigen
+             Tastendruck dort angezeigt. 
+ 
+      #ib(1)#3.0 FKT-Menuepunkte#ie(1)# 
+ 
+         Jede Eingabe oder Operation kann durch Drücken der Taste 'ESC'
+         abgebrochen werden, die Eingabe wird dann ignoriert, und im Dialog­
+         bereich erscheint die Fehlermeldung 'F E H L E R : Abgebrochen'. 
+ 
+         3.1 #ib(2," (3.1)")#(f) Funktionsterm eingeben#ie(2,"")# 
+             Im Dialogbereich wird die Eingabe des Funktionsterms erwartet, wobei
+             als Variable im Term 'x' verwendet werden muß. 
+             Es stehen alle mathematischen Funktionen des EUMEL-Systems zur
+             Verfügung, sofern sie reelle Werte (REAL) zurückliefern. 
+             Beispiele von Funktionstermen (alternative Möglichkeiten in eckigen,
+             Erklärungen in runden Klammern): 
+ 
+               2*x 
+               [2x] 
+               2x*x + 3x ­ 5 
+               [2.0*x*x + 3.0*x ­ 5.0] 
+               0.7 * sqrt (x)                   (sqrt  : Quadratwurzel aus) 
+               log10 (x)                        (log10 : 10­er Logar.) 
+               ln (3x)                          (ln    : Nat. Logar.) 
+               2**x                             (**    : Potenzieren) 
+               exp (1/x) 
+               [e**(1/x)]                       (exp   : Expon.Fktn) 
+               arctan (pi*x)                    (arctan: arkus tangens ) 
+               sin (x)                          (sin   : Sinus in Radiant ) 
+               sind (x)                         (sind  : Sinus in Altgrad ) 
+               1/(x*x+1) 
+ 
+            Die Klammern dürfen dabei NICHT weggelassen werden, es sind nur
+            runde Klammern zulässig, auch geschachtelt, wie z.B. in: 
+ 
+               log10 (abs (sin (x) + 5))        (abs   : Absolutbetrag ) 
+ 
+            Ein Dezimalkomma gibt es nicht, sondern nur den Dezimalpunkt. 
+ 
+            Beispiele von abschnittsweise definierten Funktionen: 
+ 
+               IF x < 5 THEN x*x ELSE sqrt (x ­ 5) END IF 
+               IF x = 0 THEN 0 ELSE 1/x END IF 
+               IF x < 0 THEN x ELIF x = 0 THEN 1 ELSE x*x END IF 
+ 
+            Die sog. Schlüsselworte "IF" "THEN" "ELIF" "ELSE" "END IF" müssen
+            dabei immer in der angegebenen Form (alle, in der angegebenen Reihen­
+            folge, vollständig aus Großbuchstaben) auftauchen. 
+ 
+               IF --+--> THEN --+--> ELSE --> END IF 
+                    |           | 
+                    |           | 
+                    +--- ELIF --+ 
+ 
+ 
+            Es können bei IF auch mehrere Bedingungen mit logischem OR oder AND
+            verknüpft werden: 
+ 
+               IF x <= 0  OR  x > 100 THEN 0 ELSE x*x END IF 
+ 
+            Hat die Funktion eine Definitionslücke an einer bereits bekannten
+            Stelle, so kann dies im Term auf folgende Art berücksichtigt werden,
+            z.B.: 
+ 
+               IF x = 0 THEN luecke ELSE 1/x END IF 
+               IF x < ­0.05 THEN ­1/x ELIF x > 0.05 THEN 1/x ELSE luecke END IF 
+ 
+            Taucht eine unvorhergesehene Definitionslücke auf, so wird beim
+            Erstellen des Wertebereichs eine entspr. Fehlermeldung ausgegeben.
+            Dann muß entweder der Funktionsterm durch Fallunterscheidung (s.o.)
+            angepaßt, oder der Definitionsbereich geändert werden. 
+ 
+            Graphen mit Definitionslücken können auch in zwei oder mehr Teilen
+            erstellt werden, nämlich jeweils über den zusammenhängenden
+            Definitionsintervallen, die keine Lücke enthalten. Dazu muß jeweils
+            die Zeichnung ergänzt (siehe '(z) Zeichnung anfertigen') werden. 
+ 
+    Fehlerquelle: Der Funktionsterm ist fehlerhaft. 
+                  Es tauchen z.B. dem Rechner unbekannte Operationen auf,
+                  Multiplikationszeichen fehlen, andere Symbole als 'x' wurden
+                  für die Variable benutzt, 'END IF' fehlt o.ä. 
+ 
+         3.2 #ib(2," (3.2)")#(d) Definitionsbereich waehlen#ie(2,"")# 
+            Im Dialogbereich wird die Eingabe von Unter- und Obergrenze erwartet,
+            wobei Untergrenze < Obergrenze gilt, ansonsten wird die Eingabe der
+            Obergrenze nochmals gefordert. 
+            Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte
+            Genauigkeit zu groß und sollte umgewählt werden. 
+ 
+            Fehlerquelle: Der Funktionsterm ist noch nicht vorhanden. 
+ 
+         3.3 #ib(2," (3.3)")#(w) Wertebereich ermitteln lassen#ie(2,"")# 
+             Es werden automatisch der größte und kleinste Funktionswert
+             ermittelt, also die tatsächlichen Grenzen des Wertebereichs. 
+             Erscheinen in der zug. Informationszeile Sterne, so ist die gewählte
+             Genauigkeit zu groß und sollte umgewählt werden. 
+ 
+         3.4 #ib(2," (3.4)")#(z) Zeichnung anfertigen#ie(2,"")# 
+             Eine Zeichnung kann auf allen zur Verfügung stehenden Geräten
+             ausgegeben werden, wenn sie erzeugt ist. 
+             Mit diesem Menuepunkt werden die Zeichnungen nur erstellt, d.h. der
+             Graph erscheint noch nicht auf einem Ausgabegerät. 
+             Diese Zeichnungen werden dann im System aufbewahrt und können
+             somit mehrfach ausgegeben werden. 
+ 
+             Im Dialogbereich wird zunächst der Name der Zeichnung angefordert,
+             dieser beginnt grundsätzlich mit dem Prefix 'PICFILE.', das nicht
+             verändert werden kann. 
+             Dabei wird als Ergänzung des Namens der Funktionsterm angeboten, so
+             daß die Zeichnung z.B. 'PICFILE.sin(x)' heißt. 
+             Dieser Teil des Namens kann aber frei verändert werden. 
+             Existiert bereits eine Zeichnung gleichen Namens, so erscheint im
+             Dialogbereich eine Anfrage, wie verfahren werden soll, wobei
+             folgende Möglichkeiten genannt werden: 
+ 
+             - <l> :  Die alte Zeichnung wird gelöscht. 
+             - <n> :  Der Name wird erneut zur Änderung angeboten. 
+             - <e> :  Die neue Zeichnung, welche hiernach erstellt wird, wird an die
+                      schon existierende Zeichnung angahängt. Dies ist vorteil­
+                      haft, wenn mehrere od. abschnittsweise definierte Graphen
+                      auf in eine Zeichnung kommen sollen. 
+             Die Eingabe anderer Buchstaben wird ignoriert. 
+ 
+             Ansonsten wird eine Zeichnung erstellt, die unter dem eingegebenen
+             Namen abgelegt wird. 
+ 
+             Danach wird im Dialogbereich erfragt, ob und wie das Format der
+             Zeichnung geändert werden soll. 
+             Nachdem die Zeichnung erstellt wurde, was durch den
+             Stützpunkt-Zähler angezeigt wird, muß noch die Farbe, in der der
+             Graph gezeichnet werden soll eingegeben werden. 
+ 
+             Fehlerquelle: Wertebereich ist noch nicht bestimmt (siehe 4). 
+                           Unzuläessiges Format:  ymax ist kleiner oder gleich
+                                                  ymin, bzw. xmax ist kleiner
+                                                  oder gleich xmin. 
+ 
+         3.5 #ib(2," (3.5)")#(a) Ausgabe der Zeichnung auf Endgerät#ie(2,"")# 
+             Im Dialogbereich wird der Name der auszugebenden Zeichnung erfragt,
+             wobei die zuletzt bearbeitete Zeichnung angeboten wird. 
+             Die Wahl von '?' als Namen der Zeichnung ('PICFILE.?') führt zu einer
+             Auswahl aller vorhanden Bilder, von denen eines zur Ausgabe
+             ausgewählt werden kann. 
+             Danach kann wie oben nochmals das Format variiert werden. 
+             Dann wird im Dialogbereich die Überschrift der Zeichnung erfragt,
+             wobei der Funktionsterm angeboten wird. Die Überschrift erscheint
+             zentriert am oberen Rand. 
+             Je nach Lage des Ursprungs (innerhalb od. außerhalb der Zeichnung)
+             kann die Ausgabe mit Koordinatensystem od. mit Rahmen gewählt
+             werden, liegt der Ursprung nicht innerhalb der Zeichnung, so wird
+             grundsätzlich der Rahmen verwendet. 
+             Zum Abschluß wird dann die Farbgebung von Koordinatensystem bzw.
+             Rahmen sowie der Überschrift erfragt, dann wird die Zeichnung auf
+             dem im unteren Teil eingestelltem Endgerät ausgegeben. 
+ 
+         3.6 #ib(2," (3.6)")#(t) Wertetafel erstellen lassen#ie(2,"")# 
+             In dem gewählten Definitionsbereich kann eine Wertetafel erstellt
+             werden, die in einer von Ihnen gewünschten Schrittweite ermittelte
+             Funktionswerte zeigt. 
+             Zunächst wird die Schrittweite erfragt, dann die von FKT formatiert
+             erstellte Wertetafel gezeigt. 
+             Diese befindet sich in einer Datei, die den Namen des zugehörigen
+             Funktionsterms trägt, existiert diese bereits, so wird die Wertetafel
+             ergänzt. 
+             Enthält diese Tafel Sterne, so müssen Sie die Genauigkeit umwählen
+             und die Tafel neu erstellen lassen. 
+             Nach Verlassen der Anzeige wird noch gefragt, ob die Wertetafel
+             gedruckt, und ob sie aufbewahrt werden soll. 
+ 
+             Fehlerquelle: Definitionsbereich bzw. Funktionsterm ist noch nicht
+                           gewählt. 
+                           Die Schrittweite wurde zu klein gewählt. Sie muß so
+                           groß sein, daß nicht mehr als 512 Werte zu berechnen
+                           sind. 
+ 
+         3.7 #ib(2," (3.7)")#(l) Zeichnungen auflisten#ie(2,"")# 
+             Es wird eine Namesliste aller vorhandenen Zeichnungen gezeigt. 
+ 
+         3.8 #ib(2," (3.8)")#(?) Hilfestellung#ie(2,"")# 
+             Es wird eine Kurzanleitung gezeigt. 
+ 
+         3.9 #ib(2," (3.9)")#(q) in die Kommandoebene zurück#ie(2,"")# 
+             Die Arbeit mit dem Funktionsplotter wird beendet, in normalen Tasks
+             erscheint die Ebene, aus der 'FKT' mit 'fktplot' aufgerufen wurde. 
+             Wird die Task 'FKT' mit 'q' verlassen, so wird dagegen die Task
+             abgekoppelt und alle in ihr enthaltenen Zeichnungen gelöscht! 
+ 
+         3.10 #ib(2," (3.10)")#(s) Anzahl der Stützpunkte waehlen#ie(2,"")# 
+             Bei der Ermittlung des Wertebereiches und beim Erstellen des Funk­
+             tionsgraphen ist es wegen der Endlichkeit des Computers nicht mög­
+             lich, alle Punkte des Definitionsbereiches zu benutzen. Deshalb wird
+             der Definitionsbereich diskretisiert, d.h. es wird eine endliche An­
+             zahl von Stützpunkten ausgesucht. Diese Stützpunkte liegen gleich­
+             verteilt über dem Definitionsbereich. Die Mindestanzahl ist 2, d.h. als
+             Stützpunkte werden nur die beiden Randwerte zugelassen. Aus
+             technischen Gründen ist die Höchstgrenze 512. 
+ 
+             Fehlerquelle: Zahl der Stützpunkte ist fehlerhaft. 
+                           Nur ganze Zahlen aus dem Intervall [2;512] zulässig. 
+ 
+         3.11 #ib(2," (3.11)")#(n) Nachkommastellenzahl wählen#ie(2,"")# 
+             Hier kann die Zahl der angezeigten Nachkommastellen eingestellt
+             werden (intern wird immer höchstmögliche Genauigkeit verwendet). 
+             Maximal sind neun Nachkommastellen zulässigt, jedoch kann die
+             Genauigkeit zu groß für das Anzeigeformat werden; dann erscheinen
+             in der Anzeige Sterne (*************). 
+             Es gilt grundsätzlich: 
+                  Anzahl Vorkommastellen + Anz. Nachkommastellen = 12. 
+ 
+         3.12 #ib(2," (3.12)")#(e) Arbeit beenden#ie(2,"")# 
+             Die Arbeit mit 'FKT' wird abgeschlossen, die Task vom Terminal
+             abgekoppelt. Für jede Task bleibt dabei FKT das laufende Programm,
+             d.h. nach erneutem Ankoppeln erscheint wieder die FKT-Tapete. In der
+             Task FKT bleiben die Zeichnungen bei Verlassen mit 'e' erhalten (im
+             Gegensatz zum Verlassen mit 'q'). 
+ 
+         3.13 #ib(2," (3.13)")#(L) Zeichnungen loeschen#ie(2,"")# 
+             Es erscheint eine Namensliste aller in der Task enthaltenen
+             Zeichnungen. Die dann ausgewählten Zeichnungen werden nach noch­
+             maliger Rückfrage gelöscht. 
+ 
+         3.14 #ib(2," (3.14)")#(A) Zeichnungen archivieren#ie(2,"")# 
+             Nach Aufruf dieses Menuepunktes können Zeichnungen zu anderen
+             Tasks geschickt, oder auch auf Diskette geschrieben werden. 
+             Dazu wird der MPG-Dateimanager 'dm' verwendet. 
+ 
+         3.15 #ib(2," (3.15)")#(b) Zeichnungen beschriften#ie(2,"")# 
+             Mit diesem Menuepunkt können Zeichnungen frei beschriftet werden. 
+             Zunächst wird im Dialogbereich erfragt, wie mit bereits bestehenden
+             Beschriftungen verfahren werden soll: 
+ 
+             ­ <e> :  Die nachfolgenden Texte werden zusätzlich zu den schon
+                      vorhandenen Beschriftungen angefügt. 
+             ­ <l> :  Die vorhandenen Beschriftungen werden gelöscht, und es wird
+                      zum Menue zurückgekehrt. 
+             ­ <a> :  Die Operation wird abgebrochen. 
+ 
+            Nun wird die Farbgebung aller Beschriftungen erfragt, 
+            danach wird das aktuelle Format der Zeichnung gezeigt, was bei der
+            Positionierung hilfreich sein kann. 
+            Nach der nun geforderten Eingabe des Beschriftungstextes wird die
+            Positionierung der Beschriftung in zwei Weisen angeboten: 
+            - in cm  :  Die nachfolgend einzugebenden Werte werden als
+                        cm-Angabe relativ zur unteren linken Ecke der Zeichnung
+                        aufgefaßt. 
+            - in REAL:  Die nachfolgend einzugebenden Werte werden als
+                        Koordinatenangabe im Koordinatensystem der erstellten
+                        Zeichnung aufgefaßt ('0;0' demnach im Ursprung) Nach
+            Eingabe o.g. Werte wird noch die Texthöhe und Breite erfragt, wobei die
+            eingegebenen Werte als mm-Angaben aufgefäßt werden (Standard: 5 * 5
+            mm). 
+            Anschließend wird erfragt, ob noch weitere Beschriftungen
+            vorgenommen werden sollen. 
+ 
+            Fehlerquelle: Zeichnung existiert nicht. 
+#page# 
+ 
+#type("pica")##on("u")##ib(1)#Teil 4.2: Die TURTLE-Graphik#ie(1)##off("u")##type("prop.lq")#
+#free(0.5)#
+ 
+      Die TURTLE-Graphik bietet die Möglichkeit, sehr einfach zweidimensionale
+      Zeichnungen zu erstellen. Sie basiert auf dem in LOGO verwendeten Modell, in
+      dem eine Zeichenposition in jeweils eine bestimmte Richtung vorwärts bzw.
+      rückwärts bewegt werden kann, und die Zeichenrichtung verändert werden
+      kann.Bei den Bewegungen, die vornehmlich relativ zur alten Position bzw.
+      Zeichenrichtung ausgeführt werden, kann dann eine Linie hinterlassen
+      werden. Diese Art der Graphik eignet sich insbesondere für Programm­
+      gesteuerte Zeichnungen, wie z.B. die rekursiven 'Sierpinski' - bzw. 'Hilbert'-
+      "Funktionen". 
+ 
+     Die Koordinaten bewegen sich im Intervall von [-500.0,500.0]. 
+     (0,0) liegt dabei in der Bildschirmmitte und ist auch die Anfangsposition.
+     Der Anfangswinkel ist 0. Winkel werden in Grad angegeben. 
+ 
+     #ib(1)#1.0 Paket: 'turtlegraphics'#ie(1)# 
+ 
+         1.1 REAL PROC #ib(2," (1.1)")#angle#ie(2," (PROC)")# 
+              - liefert den momentanen Winkel zwischen Zeichenrichtung und
+                X-Achse. 
+ 
+         1.2 PROC #ib(2," (1.2)")#turnto#ie(2," (PROC)")# 
+              (REAL CONST w) 
+              - Die Zeichenrichtung wird absolut auf den Winkel 'w' als Winkel
+                zwischen Zeichenrichtung und X-Achse eingestellt. 
+ 
+         1.3 PROC #ib(2," (1.3)")#forward#ie(2," (PROC)")# 
+              (REAL CONST s) 
+              - Die Zeichenposition wird in Zeichenrichtung um die Strecke 's'
+                verschoben, wobei ggf. gezeichnet wird. 
+ 
+         1.4 PROC #ib(2," (1.4)")#penup#ie(2," (PROC)")# 
+              - Der Zeichenstift wird abgehoben, Bewegungen erzeugen keine
+                Linien mehr. 
+ 
+         1.5 PROC #ib(2," (1.5)")#forward to#ie(2," (PROC)")# 
+              (REAL CONST x,y) 
+              - Die Zeichenposition wird absolut auf die Position 'x;y' gesetzt, die
+                Zeichenrichtung wird nicht verändert. 
+ 
+         1.6 PROC #ib(2," (1.6)")#endturtle#ie(2," (PROC)")# 
+              - Wurde die Graphik im Direktmodus ('begin turtle' ohne Parameter),
+                also auch sofort sichtbar erzeugt, so wird die Graphikausgabe in
+                üblicher Weise beendet, sonst nunmehr das erzeugte PICFILE
+                ausgegeben. 
+ 
+         1.7 PROC #ib(2," (1.7)")#pendown#ie(2," (PROC)")# 
+              - Der Zeichenstift wird gesenkt, Bewegungen erzeugen Linien. 
+ 
+         1.8 PROC #ib(2," (1.8)")#beginturtle#ie(2," (PROC)")# 
+              (TEXT CONST picfile name) 
+              - öffnet ein PICFILE 'picfile name', in das alle Aktionen eingetragen
+                werden. Auf dem Bildschirm geschieht nichts. Ist das Picfile schon
+                vorhanden, werden die Aktionen hinzugefügt. 
+ 
+         1.9 PROC #ib(2," (1.9)")#beginturtle#ie(2," (PROC)")# 
+              - Leitet die direkte graphische Ausgabe einer TURTLE-Graphik ein,
+                alle Aktionen werden sofort auf dem Bildschirm sichtbar. 
+ 
+         1.10 PROC #ib(2," (1.10)")#turn#ie(2," (PROC)")# 
+              (REAL CONST w) 
+              - Dreht die Zeichenposition um 'w'-Grad im mathematisch positiven
+                Sinne. 
+ 
+         1.11 BOOL PROC #ib(2," (1.11)")#pen#ie(2," (PROC)")# 
+              - Liefert zurück, ob der Zeichenstift oben (FALSE) oder unten (TRUE)
+                ist, also ob Bewegungen Linien hervorrufen oder nicht. 
+ 
+         1.12 PROC #ib(2," (1.12)")#getturtle#ie(2," (PROC)")# 
+              - In die übergebenen Variablen wird die aktuelle Zeichenposition
+                absolut eingetragen. 
+#page# 
+      Diese Dokumentation und die einzelnen Programme wurden mit größtmöglicher
+      Sorgfalt erstellt bzw. weiterentwickelt. 
+      Dennoch kann keine Fehlerfreiheit garantiert oder die Haftung für evtl. aus
+      Fehlern resultierende Folgen übernommen werden. 
+      Für Hinweise auf Fehler sind die Autoren stets dankbar. 
+#page# 
+#bottom off#
+#head#
+#type("prop")##center#Dokumentation des MPG-Graphik-Systems
+#type("8.5.klein")##center#Stichwortverzeichnis
+#type("pica.lq")##free(1.0)#
+#end#
+#type("pica")##on("u")##ib(1)#Stichwortverzeichnis#ie(1)##off("u")##type("prop.lq")# 
+#free(0.5)#
+(a) Ausgabe der Zeichnung auf Endgerät ...........  41 (3.5) 
+actual plotter (PROC) ............................  17 (4.4) 
+ALL (OP) .........................................  27 (3.1) 
+angle (PROC) .....................................  44 (1.1) 
+(A) Zeichnungen archivieren ......................  42 (3.14) 
+background * (PROC) ..............................  13 (3.4), 13 (3.5), 19 (1.1),
+                                                    19 (1.2), 34 (2.1) 
+bar * (PROC) .....................................  8 (2.3), 23 (2.1), 23 (2.2) 
+beginplot (PROC) .................................  23 (2.3) 
+beginturtle (PROC) ...............................  45 (1.9), 45 (1.8) 
+box (PROC) .......................................  19 (1.3), 23 (2.4), 34 (2.2) 
+(b) Zeichnungen beschriften ......................  42 (3.15) 
+CAT * (OP) .......................................  8 (2.4) 
+channel (PROC) ...................................  17 (4.5) 
+circle (PROC) ....................................  8 (2.5), 19 (1.4), 24 (2.5),
+                                                    34 (2.3) 
+clear (PROC) .....................................  19 (1.5), 19 (1.6), 34 (2.4) 
+clearspool .......................................  3 (2.2) 
+clippedline (PROC) ...............................  5 (1.1) 
+color (PROC) .....................................  19 (1.7) 
+COLORS ...........................................  32 (1.1) 
+colors (PROC) ....................................  20 (1.8) 
+(d) Definitionsbereich waehlen ...................  39 (3.2) 
+delete picture * (PROC) ..........................  13 (3.6) 
+dim * (PROC) .....................................  8 (2.6) 
+down * (PROC) ....................................  13 (3.7), 13 (3.8) 
+draw cm * (PROC) .................................  9 (2.11), 24 (2.12) 
+draw cm r * (PROC) ...............................  9 (2.12), 24 (2.13) 
+drawingarea * (PROC) .............................  5 (1.2), 17 (4.6), 17 (4.7) 
+draw * (PROC) ....................................  8 (2.8), 8 (2.7), 9 (2.10),
+                                                    9 (2.9), 24 (2.6), 24 (2.9),
+                                                    24 (2.8), 24 (2.7), 24 (2.11),
+                                                    24 (2.10) 
+draw r * (PROC) ..................................  9 (2.13), 9 (2.14), 24 (2.14),
+                                                    25 (2.15) 
+drawto (PROC) ....................................  20 (1.9), 34 (2.5) 
+(e) Arbeit beenden ...............................  42 (3.12) 
+EDITOR ...........................................  33 (1.2) 
+end plot (PROC) ..................................  20 (1.10), 20 (1.11), 34 (2.6) 
+endturtle (PROC) .................................  44 (1.6) 
+eof * (PROC) .....................................  13 (3.9) 
+erase (PROC) .....................................  27 (3.3), 27 (3.2) 
+exists (PROC) ....................................  27 (3.4) 
+extrema * (PROC) .................................  9 (2.16), 9 (2.15), 13 (3.11),
+                                                    13 (3.10) 
+(f) Funktionsterm eingeben .......................  38 (3.1) 
+fill (PROC) ......................................  20 (1.12), 34 (2.7) 
+first ............................................  4 (2.9) 
+first (PROC) .....................................  27 (3.5) 
+foreground (PROC) ................................  20 (1.14), 20 (1.13), 35 (2.8) 
+forward (PROC) ...................................  44 (1.3) 
+forward to (PROC) ................................  44 (1.5) 
+generate plotmanager (PROC) ......................  27 (3.6) 
+get cursor (PROC) ................................  20 (1.15), 35 (2.9) 
+get * (PROC) .....................................  14 (3.12) 
+getturtle (PROC) .................................  45 (1.12) 
+getvalues (PROC) .................................  5 (1.3), 14 (3.13) 
+graphik cursor (PROC) ............................  20 (1.16), 21 (1.17), 35 (2.10) 
+halt .............................................  4 (2.6) 
+halt (PROC) ......................................  27 (3.7) 
+hidden lines * (PROC) ............................  25 (2.16) 
+(?) Hilfestellung ................................  41 (3.8) 
+home (PROC) ......................................  21 (1.18), 35 (2.11) 
+INCLUDE ..........................................  33 (1.3) 
+init plot (PROC) .................................  21 (1.19), 35 (2.12) 
+insert picture * (PROC) ..........................  14 (3.14) 
+install plotter (PROC) ...........................  17 (4.8) 
+is first picture * (PROC) ........................  14 (3.15) 
+killer ...........................................  4 (2.8) 
+length * (PROC) ..................................  9 (2.17) 
+linetype (PROC) ..................................  25 (2.17) 
+LINK .............................................  33 (1.4) 
+list (PROC) ......................................  27 (3.8), 28 (3.9) 
+listspool ........................................  3 (2.1) 
+(l) Zeichnungen auflisten ........................  41 (3.7) 
+(L) Zeichnungen loeschen .........................  42 (3.13) 
+move cm (PROC) ...................................  10 (2.20), 25 (2.21) 
+move cm r * (PROC) ...............................  10 (2.21), 25 (2.22) 
+move * (PROC) ....................................  9 (2.19), 9 (2.18), 25 (2.18),
+                                                    25 (2.19), 25 (2.20) 
+move r * (PROC) ..................................  10 (2.23), 10 (2.22),
+                                                    25 (2.23), 25 (2.24) 
+move to (PROC) ...................................  21 (1.20), 35 (2.13) 
+name (PROC) ......................................  17 (4.9) 
+newvalues (PROC) .................................  5 (1.4) 
+nilpicture * (PROC) ..............................  10 (2.24) 
+(n) Nachkommastellenzahl wählen ..................  42 (3.11) 
+no plotter (PROC) ................................  17 (4.10) 
+oblique * (PROC) .................................  5 (1.5), 14 (3.16) 
+:= (OP) ..........................................  8 (2.2), 13 (3.2), 13 (3.3),
+                                                    17 (4.3), 17 (4.2) 
+orthographic * (PROC) ............................  5 (1.6) 
+PACKET basisplot .................................  1 (3.1) 
+PACKET deviceinterface ...........................  1 (2.1) 
+PACKET devices ...................................  1 (1.4) 
+PACKET picfile ...................................  1 (1.3) 
+PACKET picture ...................................  1 (1.2) 
+PACKET plot ......................................  1 (3.3) 
+PACKET plotinterface .............................  1 (3.2) 
+PACKET transformation ............................  1 (1.1) 
+pendown (PROC) ...................................  44 (1.7) 
+pen * (PROC) .....................................  10 (2.25), 10 (2.26),
+                                                    26 (2.25), 45 (1.11) 
+penup (PROC) .....................................  44 (1.4) 
+perspective * (PROC) .............................  6 (1.7), 14 (3.17) 
+picfiles (PROC) ..................................  28 (3.10) 
+picture no * (PROC) ..............................  14 (3.18) 
+picture * (PROC) .................................  11 (2.27) 
+pictures * (PROC) ................................  14 (3.19) 
+plot * (PROC) ....................................  29 (4.3), 29 (4.2), 29 (4.1) 
+PLOTTER ..........................................  33 (1.5) 
+plotterinfo (PROC) ...............................  18 (4.13) 
+plotter (PROC) ...................................  18 (4.11), 18 (4.12) 
+plotters (PROC) ..................................  18 (4.14) 
+prepare (PROC) ...................................  21 (1.21), 36 (2.14) 
+put picture * (PROC) .............................  14 (3.21) 
+put * (PROC) .....................................  14 (3.20) 
+(q) in die Kommandoebene zurück ..................  41 (3.9) 
+read picture * (PROC) ............................  14 (3.22) 
+reset linetypes * (PROC) .........................  26 (2.27) 
+reset * (PROC) ...................................  26 (2.26) 
+reset zeichensatz * (PROC) .......................  26 (2.28) 
+rotate * (PROC) ..................................  11 (2.28), 11 (2.29) 
+(s) Anzahl der Stützpunkte waehlen ...............  42 (3.10) 
+save (PROC) ......................................  28 (3.12), 28 (3.11) 
+selected pen * (PROC) ............................  15 (3.23) 
+select pen * (PROC) ..............................  15 (3.24) 
+select plotter ...................................  4 (2.7) 
+select plotter (PROC) ............................  18 (4.16), 18 (4.15), 18 (4.17) 
+set color (PROC) .................................  21 (1.22) 
+setdrawingarea (PROC) ............................  6 (1.8) 
+set marker (PROC) ................................  21 (1.23), 36 (2.15) 
+setpalette (PROC) ................................  21 (1.24), 36 (2.16) 
+setpixel (PROC) ..................................  21 (1.25), 36 (2.17) 
+setvalues (PROC) .................................  6 (1.9), 15 (3.25) 
+spool control ....................................  3 (2.3) 
+start ............................................  4 (2.5) 
+start (PROC) .....................................  28 (3.13) 
+station (PROC) ...................................  18 (4.18) 
+stdcolors (PROC) .................................  22 (1.26), 22 (1.27) 
+stop .............................................  3 (2.4) 
+stop (PROC) ......................................  28 (3.14) 
+stretch * (PROC) .................................  11 (2.31), 11 (2.30) 
+text * (PROC) ....................................  11 (2.32) 
+to eof * (PROC) ..................................  15 (3.26) 
+to first pic * (PROC) ............................  16 (3.27) 
+to pic * (PROC) ..................................  16 (3.28) 
+transform (PROC) .................................  6 (1.10) 
+translate * (PROC) ...............................  12 (2.33), 12 (2.34) 
+turn (PROC) ......................................  45 (1.10) 
+turnto (PROC) ....................................  44 (1.2) 
+(t) Wertetafel erstellen lassen ..................  41 (3.6) 
+TYPE PICFILE .....................................  13 (3.1) 
+TYPE PICTURE * ...................................  8 (2.1) 
+TYPE PLOTTER .....................................  17 (4.1) 
+up * (PROC) ......................................  16 (3.30), 16 (3.29) 
+viewport * (PROC) ................................  7 (1.14), 16 (3.34) 
+view * (PROC) ....................................  6 (1.13), 6 (1.12), 6 (1.11),
+                                                    16 (3.32), 16 (3.31), 16 (3.33) 
+wait for halt (PROC) .............................  28 (3.15) 
+where * (PROC) ...................................  12 (2.35), 12 (2.36),
+                                                    26 (2.30), 26 (2.29) 
+window * (PROC) ..................................  7 (1.15), 7 (1.16), 7 (1.17),
+                                                    16 (3.35), 16 (3.36) 
+write picture * (PROC) ...........................  16 (3.37) 
+(w) Wertebereich ermitteln lassen ................  40 (3.3) 
+zeichensatz * (PROC) .............................  26 (2.31) 
+(z) Zeichnung anfertigen .........................  40 (3.4) 
+
+
diff --git a/app/mpg/2.2/source-disk b/app/mpg/2.2/source-disk
new file mode 100644
index 0000000..f00ec02
--- /dev/null
+++ b/app/mpg/2.2/source-disk
@@ -0,0 +1,4 @@
+mpg/mpg-graphik-system-2.1_1987-09-10.1.img
+mpg/mpg-graphik-system-2.1_1987-09-10.2.img
+mpg/mpg-graphik-system-2.1_1987-09-10.3.img
+mpg/mpg-graphik-system-2.1_1987-09-10.4.img
diff --git a/app/mpg/2.2/src/AMPEX 2-1-6.GCONF b/app/mpg/2.2/src/AMPEX 2-1-6.GCONF
new file mode 100644
index 0000000..030efd4
--- /dev/null
+++ b/app/mpg/2.2/src/AMPEX 2-1-6.GCONF
@@ -0,0 +1,84 @@
+INCLUDE "terminal plot"; 
+INCLUDE "std primitives"; 
+ 
+PLOTTER "AMPEX",2,1,78,47,21.5,16.0; 
+ 
+LINK 2/2,2/3,2/4,2/5,2/6; 
+ 
+COLORS "000999";
+
+PROC clear: 
+  IF plot
+  THEN INT VAR i;
+       FOR i FROM 1 UPTO 24
+       REP display [i] := empty line PER;
+       page
+  ELSE errorstop ("PROC clear : clear without plotmodus") FI
+END PROC clear; 
+ 
+PROC prepare:
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare;
+
+PROC initplot: 
+  plot := TRUE;
+  cursor (x pos + 1,  24 - (y pos) DIV 2)
+END PROC initplot;
+ 
+PROC endplot: 
+  pause;
+  plot := FALSE
+END PROC endplot; 
+ 
+PROC home: 
+   move to (0,0)
+END PROC home;
+ 
+PROC moveto (INT CONST x,y): 
+  x pos := x ;
+  y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  new x pos := x;
+  new y pos := y;
+  plot vector (new x pos - x pos, new y pos - y pos) ;
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+   move to (x,y);
+   point
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+   type := 0
+END PROC background; 
+        
+PROC setpalette:
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1,y1,x2,y2,pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/AMPEX 3-1-4.GCONF b/app/mpg/2.2/src/AMPEX 3-1-4.GCONF
new file mode 100644
index 0000000..cc3a7ad
--- /dev/null
+++ b/app/mpg/2.2/src/AMPEX 3-1-4.GCONF
@@ -0,0 +1,84 @@
+INCLUDE "terminal plot"; 
+INCLUDE "std primitives"; 
+ 
+PLOTTER "AMPEX",3,1,78,47,21.5,16.0; 
+ 
+LINK 3/2,3/3,3/4; 
+ 
+COLORS "000999";
+
+PROC clear: 
+  IF plot
+  THEN INT VAR i;
+       FOR i FROM 1 UPTO 24
+       REP display [i] := empty line PER;
+       page
+  ELSE errorstop ("PROC clear : clear without plotmodus") FI
+END PROC clear; 
+ 
+PROC prepare:
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare;
+
+PROC initplot: 
+  plot := TRUE;
+  cursor (x pos + 1,  24 - (y pos) DIV 2)
+END PROC initplot;
+ 
+PROC endplot: 
+  pause;
+  plot := FALSE
+END PROC endplot; 
+ 
+PROC home: 
+   move to (0,0)
+END PROC home;
+ 
+PROC moveto (INT CONST x,y): 
+  x pos := x ;
+  y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  new x pos := x;
+  new y pos := y;
+  plot vector (new x pos - x pos, new y pos - y pos) ;
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+   move to (x,y);
+   point
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+   type := 0
+END PROC background; 
+        
+PROC setpalette:
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1,y1,x2,y2,pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/Atari 3-9.GCONF b/app/mpg/2.2/src/Atari 3-9.GCONF
new file mode 100644
index 0000000..82b4826
--- /dev/null
+++ b/app/mpg/2.2/src/Atari 3-9.GCONF
@@ -0,0 +1,119 @@
+INCLUDE "std primitives"; 
+ 
+PLOTTER "ATARI",3,9,640,400,21.0,13.0; 
+ 
+COLORS "000999";
+ 
+TEXT VAR atari kommando; 
+TEXT VAR atari puffer 2 := "12", 
+         atari puffer 4 := "1234";
+ 
+PROC atari g c (TEXT CONST kommando kennung):
+  LET esc g = ""27"g";
+  atari kommando := esc g;
+  atari kommando CAT kommando kennung
+   
+END PROC atari g c; 
+ 
+PROC atari g w (INT CONST unsigned integer):
+  replace (atari puffer 2, 1, unsigned integer);
+  atari kommando CAT atari puffer 2
+ 
+END PROC atari g w; 
+ 
+PROC atari g k (INT CONST x, y):
+  replace (atari puffer 4, 1, x);
+  replace (atari puffer 4, 2, y);
+  atari kommando CAT atari puffer 4
+ 
+END PROC atari g k; 
+ 
+PROC atari g e: 
+  out (atari kommando)
+ 
+END PROC atari g e; 
+ 
+PROC initplot: 
+  INT VAR atari d;
+  control (11, channel, 255, atari d);
+  atari g c ("B");
+  atari g e 
+END PROC initplot;
+ 
+PROC endplot: 
+  pause;
+  INT VAR atari d;
+  atari g c ("E");
+  atari g e;
+  control (11, channel, 25, atari d) 
+END PROC endplot; 
+ 
+PROC prepare: 
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare; 
+ 
+PROC clear: 
+  atari g c("C");
+  atari g e
+END PROC clear; 
+ 
+PROC home: 
+  move to(0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+  atari g c("M");
+  atari g k(x,y);
+  atari g e
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  atari g c ("D");
+  atari g k(x,y);
+  atari g e
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+  atari g c(".");
+  atari g k(x,y);
+  atari g e
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+  type := 1 
+END PROC foreground;
+ 
+PROC background (INT VAR type):
+ type := 0
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+  atari g c("K");
+  atari g k(x,y);
+  atari g w(rad);
+  atari g w(from);
+  atari g w(to);
+  atari g e
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+  std box (x1,y1,x2,y2,pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+ 
+
+
diff --git a/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF b/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF
new file mode 100644
index 0000000..6ed887d
--- /dev/null
+++ b/app/mpg/2.2/src/DATAGRAPH 3-7.GCONF
@@ -0,0 +1,119 @@
+PLOTTER "DATAGRAPH",3,7,511,241,25.0,16.5; 
+ 
+COLORS "000999900029490000990751";
+ 
+LET csi = ""27"[?"; 
+ 
+PROC datagraph palette: 
+   INT VAR coln, rgb; 
+   REAL VAR anteil; 
+   FOR coln FROM 0 UPTO colors - 1 REP
+      rgb := color (coln);
+      IF rgb <> maxint
+         THEN out (csi + text (coln) + ";"); 
+              anteil := real (rgb DIV 100) / 9.0; 
+              out (text (int (7.0 * anteil + 0.5)) + ";"); 
+              anteil := real ((rgb MOD 100) DIV 10) / 9.0; 
+              out (text (int (7.0 * anteil + 0.5)) + ";"); 
+              anteil := real (rgb MOD 10) / 9.0; 
+              out (text (int (3.0 * anteil + 0.5)) + "m"); 
+      FI
+   PER 
+END PROC datagraph palette; 
+
+PROC prepare:
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare;
+ 
+PROC clear: 
+   out (csi + "2D"); 
+   foreground (1)
+END PROC clear; 
+
+PROC initplot: 
+   out (csi + "1a"); 
+   out (csi + "0j");
+   out (csi + "3j"); 
+   out (csi + "4j") 
+END PROC initplot; 
+ 
+PROC endplot: 
+   pause; 
+   out (csi + "0a");
+   out (csi + "3;7;5;1m"); 
+   out (csi + "0;0;0;0m");
+   out (""27"[33m") 
+END PROC endplot;
+
+PROC home: 
+   move to (0,0); 
+END PROC home; 
+ 
+PROC moveto (INT CONST x,y): 
+   out (csi + "1;"+text(y)+";"+text(x)+"C") 
+END PROC moveto; 
+ 
+PROC drawto (INT CONST x,y): 
+   out (csi + "0V"); 
+   out (csi + "1V"); 
+   out (csi + "3;"+text(y)+";"+text(x)+"V") 
+END PROC drawto; 
+ 
+PROC setpixel (INT CONST x,y): 
+   out (""27"[?0;"+text(y)+";"+text(x)+"P") 
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   IF type >= 0 AND type <= 7
+      THEN out (csi + text (type) + ";f") 
+      ELSE type := 1;out (csi + "1;f")
+   FI
+END PROC foreground;
+
+PROC background (INT VAR type):
+   IF color (type) <> maxint
+      THEN set color (0,color (type))
+      ELSE type := 0;set color (0,000) 
+   FI;
+   set palette
+END PROC back ground; 
+ 
+PROC set palette: 
+   datagraph palette 
+END PROC set palette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+   move to (x, y);
+   IF from = 0 AND to = 360 
+      THEN out (csi + "0;" + text(y) + ";" + text (x) + ";" + 
+                text (y) + ";" + text (x+rad) + "K") 
+      ELSE out (csi + "2;" + text (y) + ";" + text (x+rad) +"C"); 
+           out (csi + "2;" + text (to-from) + "S") 
+   FI 
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern):                      
+   move to (x1, y1); 
+   out (csi + text (pattern + 3 * sign(pattern)) + ";" + 
+              text (y1) + ";" + text (x1) + ";" + 
+              text (y2) + ";" + text (x2) + "R") 
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+    move to (x,y); 
+    IF pattern > 6 OR pattern = 0
+       THEN out (csi + "0I") 
+       ELSE out (csi + text (pattern+3) + "I") 
+    FI 
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/ENVIRONMENT2.GCONF b/app/mpg/2.2/src/ENVIRONMENT2.GCONF
new file mode 100644
index 0000000..da04554
--- /dev/null
+++ b/app/mpg/2.2/src/ENVIRONMENT2.GCONF
@@ -0,0 +1,5 @@
+PLOTTER "VC 404",2,7,78,47,21.5,16.0; 
+PLOTTER "NEC P9 HD",2,15,2880,2880,20.32,20.32; 
+PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644;
+
+
diff --git a/app/mpg/2.2/src/ENVIRONMENT3.GCONF b/app/mpg/2.2/src/ENVIRONMENT3.GCONF
new file mode 100644
index 0000000..27a4412
--- /dev/null
+++ b/app/mpg/2.2/src/ENVIRONMENT3.GCONF
@@ -0,0 +1,7 @@
+PLOTTER "DATAGRAPH",3,7,511,241,25.0,16.5; 
+PLOTTER "WATANABE",3,8,3449,2599,34.5,26.0; 
+PLOTTER "VIDEOSTAR",3,6,640,480,27.0,19.5; 
+PLOTTER "NEC P3",3,15,1024,1024,21.68,21.68; 
+PLOTTER "ATARI",3,9,640,400,21.0,13.0; 
+
+
diff --git a/app/mpg/2.2/src/FKT.help b/app/mpg/2.2/src/FKT.help
new file mode 100644
index 0000000..05e82dc
--- /dev/null
+++ b/app/mpg/2.2/src/FKT.help
@@ -0,0 +1,24 @@
+* <f>     :    Funktionsterm waehlen bzw. umwaehlen                         *
+* <d>     :    Definitionsbereich setzen                                    *
+*              ACHTUNG : Untergrenze < Obergrenze                         *
+* <s>     :    Anzahl der Stuetzpunkte waehlen; 2 <= s <= 512               *
+* <w>     :    Wertebereich wird ermittelt                                  *
+*              ACHTUNG : Anzahl der Stuetzpunkte                          *
+* <t>     :    Wertetafel wird erstellt                                     *
+*              ACHTUNG : Nicht mehr als 512 Werte koennen ermittelt werden*
+* <z>     :    Zeichnung wird erstellt                                      *
+*              ACHTUNG : Erst Funktionsterm einegeben                     *
+*              ACHTUNG : Erst Wertebereich ermitteln lassen               *
+* <a>     :    Erstellte Zeichnung zeigen lassen                            *
+*              ACHTUNG : Auf Endgeraet achten                             *
+* <l>     :    Liste aller bereits erstellten Zeichnungen wird gezeigt      *
+* <n>     :    Nachkommastellen setzen                                      *
+* <e>     :    Sitzung beenden                                              *
+* <q>     :    Auf Kommandoebene zurueck (nicht in der Task FKT)            *
+* <?>     :    Diese Anleitung wird gezeigt                                 *
+* <A>     :    Zeichnungen koennen auf Diskette geschrieben werden          *
+* <b>     :    Zeichnungen koennen mit beliebigen Texten versehen werden    *
+* <L>     :    Es werden alle Zeichnungen zum Loeschen angeboten            *
+* <<- ->> :    Das Endgeraet umwaehlen.                                     *
+*****************VERLASSEN DIESER ANLEITUNG MIT <ESC><q>*******************
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Basis b/app/mpg/2.2/src/GRAPHIK.Basis
new file mode 100644
index 0000000..733297d
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Basis
@@ -0,0 +1,1574 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.2 vom 23.09.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*         "Graphik-Basis" geschrieben von C.Weinholz/EUMEL-Std           *) 
+(*                                                                        *)
+(**************************************************************************) 
+(*                                                                        *) 
+(*           Paket I: Endgeraet-unabhaengige Graphikroutinen              *) 
+(*                                                                        *)
+(*                 1. Transformation (Umsetzung 3D -> 2D),                *) 
+(*                    Clipping und Normierung                             *) 
+(*                 2. PICTURE - Verwaltung                                *) 
+(*                    (geanderte Standard-Version)                        *) 
+(*                 3. PICFILE - Verwaltung                                *) 
+(*                    (geanderte Standard-Version)                        *) 
+(*                 4. Endgeraet - Verwaltung                              *) 
+(*                                                                        *)
+(**************************************************************************)
+(*   Urversion  : 10.09.87                                                *) 
+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 
+(*                OP := (PICFILE VAR, PICFILE CONST) hinzugefuegt         *) 
+(*                TEXT PROC text (PICTURE CONST)                          *) 
+(*                wg. Heapueberlauf geaendert                             *) 
+(*                                                                        *) 
+(**************************************************************************)
+
+(****************************** transformation ****************************)
+
+PACKET transformation DEFINES
+       transform, 
+       set values,
+       get values,
+       new values,
+       drawing area,
+       set drawing area,
+
+       window, 
+       viewport,
+       view, 
+       oblique, 
+       orthographic, 
+       perspective,
+
+       clipped line:
+
+BOOL VAR new limits :: TRUE,
+         values new :: TRUE,
+         perspective projektion :: FALSE;
+
+REAL VAR display hor, display vert,           (*  Anzahl der Pixel         *)
+         size hor, size vert,                 (*  Groesse des Bildschirms  *)
+         size hor d, size vert d,
+         h min limit, h max limit,
+         v min limit, v max limit,
+         h min, h max,
+         v min, v max,
+         relation;
+ 
+ROW 5 ROW 5 REAL VAR p ;
+ROW 3 ROW 2 REAL VAR size d ;
+ROW 2 ROW 2 REAL VAR limits d ;
+ROW 4 REAL VAR angles d ;
+ROW 2 REAL VAR oblique d ;
+ROW 3 REAL VAR perspective d ;
+
+INT VAR i, j;
+
+PROC init transformation rows:
+  size d    := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),
+                                   ROW 2 REAL : (0.0, 1.0),
+                                   ROW 2 REAL : (0.0, 1.0));
+
+  limits d  := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, relation),
+                                   ROW 2 REAL : (0.0, 1.0));
+
+  angles d  := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
+
+  oblique d := ROW 2 REAL : (0.0, 0.0);
+
+  perspective d := ROW 3 REAL : (0.0, 0.0, 0.0);
+  set values (size d, limits d, angles d, oblique d, perspective d);
+END PROC init transformation rows;
+
+BOOL OP = (ROW 3 ROW 2 REAL CONST l, r):
+  FOR i FROM 1 UPTO 3
+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
+      THEN LEAVE = WITH FALSE FI
+  PER;
+  TRUE
+END OP =;
+
+BOOL OP = (ROW 2 ROW 2 REAL CONST l, r):
+  FOR i FROM 1 UPTO 2
+  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
+      THEN LEAVE = WITH FALSE FI
+  PER;
+  TRUE
+END OP =;
+
+BOOL OP = (ROW 2 REAL CONST l, r):
+  l [1] = r [1] AND l [2] = r [2]
+END OP =;
+
+BOOL OP = (ROW 3 REAL CONST l, r):
+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3]
+END OP =;
+
+BOOL OP = (ROW 4 REAL CONST l, r):
+  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] 
+END OP =;
+
+PROC oblique (REAL CONST a, b) :
+  set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) 
+END PROC oblique;
+
+PROC orthographic :
+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC orthographic;
+
+PROC perspective (REAL CONST cx, cy, cz) :
+  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy,-cz))
+END PROC perspective;
+
+PROC window (BOOL CONST dev) :
+  new limits := dev
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max) :
+  window (x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :
+  set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+                                  ROW 2 REAL : (y min, y max),
+                                  ROW 2 REAL : (z min, z max)),
+              limits d, angles d, oblique d, perspective d)
+END PROC window;
+
+PROC viewport (REAL CONST h min, h max, v min, v max) :
+  set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), 
+                                          ROW 2 REAL : (v min, v max)),
+              angles d, oblique d, perspective d)
+END PROC view port;
+
+PROC view (REAL CONST alpha) :
+  set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)),
+              oblique d, perspective d)
+END PROC view;
+
+PROC view (REAL CONST phi, theta) :
+  set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi),
+                                              sind (theta) * sind (phi), cosd (theta)),
+              oblique d, perspective d)
+END PROC view;
+
+PROC view (REAL CONST x, y, z) :
+  set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d)
+END PROC view;
+
+PROC drawing area (REAL VAR min h, max h, min v, max v):
+  min h := h min limit;  max h := h max limit;
+  min v := v min limit;  max v := v max limit
+END PROC drawing area;
+ 
+PROC set drawing area (REAL CONST new size hor,new size vert, 
+                                  new display hor,new display vert): 
+  size hor := new size hor; 
+  size vert:= new size vert; 
+  display hor := new display hor; 
+  display vert:= new display vert; 
+  relation := size hor/size vert; 
+  new limits := TRUE; 
+  init transformation rows
+END PROC set drawing area; 
+ 
+BOOL PROC new values:
+  IF values new
+  THEN values new := FALSE;
+       TRUE
+  ELSE FALSE FI
+END PROC new values;
+
+PROC get values (ROW 3 ROW 2 REAL VAR size, 
+                 ROW 2 ROW 2 REAL VAR limits,
+                 ROW 4 REAL VAR angles,
+                 ROW 2 REAL VAR oblique,
+                 ROW 3 REAL VAR perspective) : 
+  size        := size d;
+  limits      := limits d;
+  angles      := angles d;
+  oblique     := oblique d;
+  perspective := perspective d;
+
+END PROC get values;
+
+PROC set values (ROW 3 ROW 2 REAL CONST size, 
+                 ROW 2 ROW 2 REAL CONST limits,
+                 ROW 4 REAL CONST angles,
+                 ROW 2 REAL CONST oblique,
+                 ROW 3 REAL CONST perspective) : 
+   IF NOT same values
+   THEN values new := TRUE;
+        copy values;
+        set views;
+        check perspective projektion; 
+        calc limits;
+        change projektion
+   FI  .
+
+same values:
+  size hor d  = size hor  AND size vert d  = size vert AND
+  size d = size AND limits d = limits AND angles d = angles AND
+  oblique d = oblique AND perspective d = perspective  . 
+
+copy values :
+  size hor d := size hor;
+  size vert d := size vert;
+  size d := size;
+  limits d := limits;
+  angles d := angles;
+  oblique d := oblique;
+  perspective d := perspective  .
+
+set views :
+  REAL VAR diagonale := sqrt (angles [2] * angles [2] +
+                              angles [3] * angles [3] +
+                              angles [4] * angles [4]),
+           projektion := sqrt (angles [2] * angles [2] +
+                               angles [4] * angles [4]),
+           sin p, cos p, sin t, cos t, sin a, cos a;
+
+           IF diagonale = 0.0
+           THEN sin p :=  0.0;  cos p :=  1.0;
+                sin t :=  0.0;  cos t :=  1.0
+           ELIF projektion = 0.0
+           THEN sin p :=  angles [3] / diagonale;
+                cos p :=  projektion / diagonale;
+                sin t :=  0.0;  cos t :=  1.0
+           ELSE sin p :=  angles [3] / diagonale;
+                cos p :=  projektion / diagonale;
+                sin t :=  angles [2] / projektion;
+                cos t :=  angles [4] / projektion
+           FI;
+
+  REAL VAR   sin p sin t := sin p * sin t,
+             sin p cos t := sin p * cos t,
+             cos p sin t := cos p * sin t,
+             cos p cos t := cos p * cos t,
+
+             dx          := size [1][2] - size [1][1],
+             dy          := size [2][2] - size [2][1],
+             dz          := size [3][2] - size [3][1],
+             norm az     := oblique [1] ,
+             norm bz     := oblique [2] ,
+             norm cx     := perspective [1] / dx,
+             norm cy     := perspective [2] / dy,
+             norm cz     := perspective [3] / dz;
+            
+p :=  ROW 5 ROW 5 REAL :
+      (ROW 5 REAL : (  cos t       / dx - cos p sin t / dx * norm az ,
+                     - sin p sin t / dx - cos p sin t / dx * norm bz,
+                       0.0,
+                                        - cos p sin t / dx * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (                   - sin p       / dy * norm az,
+                       cos p       / dy - sin p       / dy * norm bz,
+                       0.0, 
+                                        - sin p       / dy * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (  sin t       / dz + cos p cos t / dz * norm az,
+                     + sin p cos t / dz + cos p cos t / dz * norm bz,
+                       0.0,
+                                        cos p cos t / dz * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),
+       ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));
+
+  IF angles (1) = 0.0
+  THEN set alpha as y vertical
+  ELSE sin a := sind (angles (1));
+       cos a := cosd (angles (1))
+  FI;
+ 
+  FOR j FROM 1 UPTO 5
+  REP REAL CONST p  j 1 := p (j)(1);
+      p (j)(1) :=  p  j  1  * cos a - p (j)(2) * sin a;
+      p (j)(2) :=  p  j  1  * sin a + p (j)(2) * cos a 
+  PER  .
+
+set alpha as y vertical :
+  REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);
+  IF r = 0.0
+  THEN sin a := 0.0;
+       cos a := 1.0
+  ELSE sin a :=-p(2)(1)/r;
+       cos a := p(2)(2)/r
+  FI  .
+
+check perspective projektion:
+  perspective projektion := perspective [3] <> 0.0  .
+
+calc limits :
+  IF new limits
+  THEN calc two dim extrema;
+       IF all limits smaller than 2
+       THEN prozente
+       ELSE zentimeter FI
+  FI  .
+
+calc two dim extrema :
+  h min := max real;  h max :=-max real;
+  v min := max real;  v max :=-max real;
+ 
+  extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); 
+  extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);
+  extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); 
+  extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);
+  extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); 
+  extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);
+  extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); 
+  extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max)  .
+
+all limits smaller than 2 :
+  limits (1)(2) < 2.0 AND limits (2)(2) < 2.0  .
+
+prozente :
+  h min limit := display hor * limits (1)(1)/relation;
+  h max limit := display hor * limits (1)(2)/relation;
+ 
+  v min limit := limits (2)(1) * display vert;
+  v max limit := limits (2)(2) * display vert  .
+ 
+zentimeter : 
+  h min limit := display hor * (limits (1)(1)/size hor);
+  h max limit := display hor * (limits (1)(2)/size hor);
+ 
+  v min limit := display vert * (limits (2)(1)/size vert);
+  v max limit := display vert * (limits (2)(2)/size vert)  .
+
+change projektion :
+  REAL VAR sh := (h max limit - h min limit) / (h max - h min),
+           sv := (v max limit - v min limit) / (v max - v min),
+           dh := h min limit - h min*sh,
+           dv := v min limit - v min*sv;
+
+  FOR j FROM 1 UPTO 5
+  REP
+     p (j)(1) := p (j)(1) * sh;
+     p (j)(2) := p (j)(2) * sv
+  PER;
+  p (5)(1) := dh;
+  p (5)(2) := dv.
+END PROC set values;
+ 
+PROC transform (REAL CONST x, y, z, INT VAR h, v) :
+  disable stop;
+  IF perspective projektion
+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+       h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));
+       v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))
+  ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));
+       v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));
+  FI;
+  IF is error
+  THEN h := -1;
+       v := -1;
+       clear error
+  FI
+END PROC transform;
+
+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):
+  REAL VAR h, v;
+  IF perspective projektion
+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+       h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;
+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w
+  ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));
+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))
+  FI;
+ 
+ IF h < h min
+ THEN h min := h
+ ELIF h > h max
+ THEN h max := h FI;
+
+ IF v < v min
+ THEN v min := v
+ ELIF v > v max
+ THEN v max := v FI
+
+END PROC extrema;
+ 
+BOOL PROC clipped line (REAL VAR x0,y0,x1,y1): 
+  REAL VAR dx  :: (display hor - 1.0) / 2.0, 
+           dy  :: (display vert- 1.0) / 2.0, 
+           rx0 :: x0 - dx, 
+           ry0 :: y0 - dy, 
+           rx1 :: x1 - dx, 
+           ry1 :: y1 - dy; 
+  INT VAR  cx0, 
+           cy0, 
+           cx1, 
+           cy1; 
+  calculate cells; 
+  IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1)
+    THEN FALSE
+  ELIF (x0 = x1) AND (y0 = y1)
+    THEN cx0 = 0 AND cy0 = 0
+    ELSE do clipping 
+  FI.
+ 
+  do clipping: 
+    IF cx0 <> 0 
+      THEN REAL VAR next x :: real(cx0) * dx; 
+           ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0;
+           rx0 := next x 
+    FI; 
+    calculate cells; 
+    IF cy0 <> 0 
+      THEN REAL VAR next y :: real(cy0) * dy; 
+           rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; 
+           ry0 := next y 
+    FI; 
+    IF cx1 <> 0 
+      THEN next x := real(cx1) * dx; 
+           ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1;
+           rx1 := next x 
+    FI; 
+    calculate cells; 
+    IF cy1 <> 0 
+      THEN next y := real(cy1) * dy; 
+           rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; 
+           ry1 := next y 
+    FI; 
+    IF (rx1 = rx0) AND (ry1 = ry0) 
+      THEN FALSE 
+      ELSE x0 := rx0+dx; 
+           y0 := ry0+dy; 
+           x1 := rx1+dx; 
+           y1 := ry1+dy; 
+           TRUE 
+    FI. 
+ 
+    calculate cells: 
+      cx0 := 0; 
+      cy0 := 0; 
+      cx1 := 0; 
+      cy1 := 0; 
+      IF abs(rx0) > dx 
+        THEN cx0 := sign(rx0) 
+      FI;
+      IF abs(rx1) > dx 
+        THEN cx1 := sign(rx1) 
+      FI;
+      IF abs(ry0) > dy 
+        THEN cy0 := sign(ry0) 
+      FI;
+      IF abs(ry1) > dy 
+        THEN cy1 := sign(ry1) 
+      FI. 
+ 
+END PROC clipped line; 
+
+END PACKET transformation; 
+ 
+(******************************** picture ********************************)
+
+PACKET picture DEFINES                            (* Autor: H.Indenbirken  *)
+               PICTURE,                           (* Stand: 23.02.1985     *)
+               :=, CAT, nilpicture,
+               draw, draw r, draw cm, draw cm r,
+               move, move r, move cm, move cm r, 
+               bar, circle,
+               length, dim, pen, where,
+               extrema, rotate, stretch, translate,
+               text, picture:
+
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    move cm key   = 6, 
+    draw cm key   = 7,
+    move cm r key = 8,
+    draw cm r key = 9,
+    bar key       = 10,
+    circle key    = 11,
+    max 2 dim     = 31983,
+    max 3 dim     = 31975,
+    max text      = 31974,
+    max bar       = 31982,
+    max circle    = 31974,
+    max length    = 32000;
+
+
+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);
+
+
+INT VAR read pos;
+REAL VAR x, y, z;
+TEXT VAR r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0"";
+
+OP := (PICTURE VAR l, PICTURE CONST r) :
+  CONCR (l) := CONCR (r)
+END OP :=;
+
+OP CAT (PICTURE VAR l, PICTURE CONST r) :
+  IF l.dim <> r.dim
+  THEN errorstop ("OP CAT : left dimension <> right dimension")
+  ELIF length (l.points) > max length - length (r.points)
+  THEN errorstop ("OP CAT : Picture overflow") FI;
+
+  l.points CAT r.points
+END OP CAT;
+
+PICTURE PROC nilpicture :
+  PICTURE : (0, 1, "")
+END PROC nilpicture;
+
+PROC draw (PICTURE VAR p, TEXT CONST text) :
+  draw (p, text, 0.0, 0.0, 0.0)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):
+  write (p, text, angle, height, bright, text key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p, x, y, z, draw key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p, x, y, draw key)
+END PROC draw;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p, x, y, z, draw r key)
+END PROC draw r;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p, x, y, draw r key)
+END PROC draw r;
+
+PROC draw cm (PICTURE VAR p, REAL CONST x, y) :
+  write (p, x, y, draw cm key)
+END PROC draw cm;
+
+PROC draw cm r (PICTURE VAR p, REAL CONST x, y) :
+  write (p, x, y, draw cm r key)
+END PROC draw cm r;
+
+PROC move (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p, x, y, z, move key)
+END PROC move;
+
+PROC move (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p, x, y, move key)
+END PROC move;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p, x, y, z, move r key)
+END PROC move r;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p, x, y, move r key)
+END PROC move r;
+
+PROC move cm (PICTURE VAR p, REAL CONST x, y) :
+  write (p, x, y, move cm key)
+END PROC move cm;
+
+PROC move cm r (PICTURE VAR p, REAL CONST x, y) :
+  write (p, x, y, move cm r key)
+END PROC move cm r;
+
+PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):
+  write (p, width, height, pattern, bar key)
+END PROC bar;
+
+PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):
+  write (p, radius, from, to, pattern, circle key)
+END PROC circle;
+
+
+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) :
+  IF length (p.points) < max 3 dim
+  THEN p.points CAT code (key); 
+       replace (r3, 1, x);
+       replace (r3, 2, y);
+       replace (r3, 3, z);
+       p.points CAT r3
+  ELSE errorstop ("Picture overflow") FI
+END PROC write;
+
+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) :
+  IF length (p.points) < max 2 dim
+  THEN p.points CAT code (key); 
+       replace (r2, 1, x);
+       replace (r2, 2, y);
+       p.points CAT r2
+  ELSE errorstop ("Picture overflow") FI
+END PROC write;
+
+PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) :
+  IF length (p.points) < max bar
+  THEN p.points CAT code (key); 
+       replace (r2, 1, x);
+       replace (r2, 2, y);
+       p.points CAT r2;
+       replace (i1, 1, n);
+       p.points CAT i1
+  ELSE errorstop ("Picture overflow") FI
+END PROC write;
+
+PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) :
+  IF length (p.points) < max circle 
+  THEN p.points CAT code (key); 
+       replace (r3, 1, x);
+       replace (r3, 2, y);
+       replace (r3, 3, z);
+       p.points CAT r3;
+       replace (i1, 1, n);
+       p.points CAT i1 
+  ELSE errorstop ("Picture overflow") FI
+END PROC write;
+
+PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright,
+            INT CONST key) :
+  IF max text - length (p.points) >= length (t)
+  THEN p.points CAT code (key);
+       replace (i1, 1, length (t));
+       p.points CAT i1;
+       p.points CAT t;
+       replace (r3, 1, angle);
+       replace (r3, 2, height);
+       replace (r3, 3, bright);
+       p.points CAT r3
+  FI;
+END PROC write;
+
+PROC check dim (PICTURE VAR p, INT CONST dim):
+  IF p.dim = 0
+  THEN p.dim := dim
+  ELIF p.dim <> dim
+  THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI
+END PROC check dim;
+
+INT PROC length (PICTURE CONST p):
+  length (p.points)
+END PROC length;
+
+INT PROC dim (PICTURE CONST pic) :
+  pic.dim
+END PROC dim;
+
+PROC pen (PICTURE VAR p, INT CONST pen) :
+  IF pen < 0 OR pen > 16
+  THEN errorstop ("pen out of range [0-16]") FI;
+  p.pen := pen
+END PROC pen;
+
+INT PROC pen (PICTURE CONST p) :
+  p.pen
+END PROC pen;
+
+PROC where (PICTURE CONST p, REAL VAR x, y) :
+  IF p.dim = 0
+  THEN x := 0.0;  y := 0.0
+  ELIF p.dim = 3
+  THEN errorstop ("Picture is 3 dimensional")
+  ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+       y := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1
+  FI
+END PROC where;
+
+PROC where (PICTURE CONST p, REAL VAR x, y, z) :
+  IF p.dim = 0
+  THEN x := 0.0;  y := 0.0;  z := 0.0
+  ELIF p.dim = 2
+  THEN errorstop ("Picture is 2 dimensional")
+  ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;
+       y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+       z := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1;
+  FI
+END PROC where;
+
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :
+  x min := max real;  x max :=-max real;
+  y min := max real;  y max :=-max real;
+  z min := max real;  z max :=-max real;
+  read pos := 0; 
+  INT CONST pic length := length (p.points);
+  WHILE read pos < pic length
+  REP check position PER  .
+
+check position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : calc extrema
+  CASE move key : calc extrema
+  CASE move r key : calc rel extrema
+  CASE draw r key : calc rel extrema
+  CASE move cm key : read pos INCR 16
+  CASE draw cm key : read pos INCR 16
+  CASE move cm r key : read pos INCR 16
+  CASE draw cm r key : read pos INCR 16
+  CASE text key : read pos INCR next int + 24
+  CASE bar key : read pos INCR 18
+  CASE circle key : read pos INCR 26
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+calc extrema :
+  x := next real;  y := next real;  z := next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y);
+  z min := min (z min, z);  z max := max (z max, z)  .
+
+calc rel extrema :
+  x INCR next real;  y INCR next real;  z INCR next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y);
+  z min := min (z min, z);  z max := max (z max, z)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC extrema;
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):
+  x min := max real;  x max :=-max real;
+  y min := max real;  y max :=-max real;
+  read pos := 0; 
+  INT CONST pic length := length (p.points);
+  WHILE read pos < pic length
+  REP check position PER  .
+
+check position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : calc extrema
+  CASE move key : calc extrema
+  CASE move r key : calc rel extrema
+  CASE draw r key : calc rel extrema
+  CASE move cm key : read pos INCR 16
+  CASE draw cm key : read pos INCR 16
+  CASE move cm r key : read pos INCR 16
+  CASE draw cm r key : read pos INCR 16
+  CASE text key : read pos INCR next int + 24
+  CASE bar key : read pos INCR 18
+  CASE circle key : read pos INCR 26
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+calc extrema :
+  x := next real;  y := next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y)  .
+
+calc rel extrema :
+  x INCR next real;  y INCR next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC extrema;
+
+PROC rotate (PICTURE VAR p, REAL CONST angle) :   (* X-Rotation *)
+  REAL CONST s :: sind( angle ), c := cosd( angle );
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : ( 1.0,  0.0,  0.0 ),
+                ROW 3 REAL : ( 0.0,   c ,   s  ),
+                ROW 3 REAL : ( 0.0,  -s ,   c  ),
+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))
+END PROC rotate; 
+ 
+PROC yrotate (PICTURE VAR p, REAL CONST angle):  (* Y-Rotation *) 
+  REAL CONST s :: sind (angle), c :: cosd (angle); 
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : (  c ,  0.0,  -s  ), 
+                ROW 3 REAL : ( 0.0,  1.0,  0.0 ), 
+                ROW 3 REAL : (  s ,  0.0,   c  ), 
+                ROW 3 REAL : ( 0.0,  0.0,  0.0 ))) 
+END PROC yrotate; 
+ 
+PROC zrotate (PICTURE VAR p, REAL CONST angle):  (* Z-Rotation *) 
+  REAL CONST s :: sind (angle), c :: cosd (angle); 
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : (  c ,   s ,  0.0 ), 
+                ROW 3 REAL : ( -s ,   c ,  0.0 ), 
+                ROW 3 REAL : ( 0.0,  0.0,  1.0 ), 
+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))
+END PROC zrotate; 
+ 
+PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :
+   IF phi <> 0.0 
+      THEN rotate (p, phi) FI;
+   IF theta <> 0.0 
+      THEN yrotate (p, theta) FI; 
+   IF lambda <> 0.0
+      THEN zrotate (p, lambda)
+   FI
+END PROC rotate; 
+ 
+PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : 
+  stretch (pic, sx, sy, 1.0) 
+END PROC stretch;
+
+PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : ( sx, 0.0, 0.0),
+                ROW 3 REAL : (0.0,  sy, 0.0),
+                ROW 3 REAL : (0.0, 0.0,  sz),
+                ROW 3 REAL : (0.0, 0.0, 0.0)))
+END PROC stretch;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy) : 
+  translate (p, dx, dy, 0.0) 
+END PROC translate;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : (1.0, 0.0, 0.0),
+                ROW 3 REAL : (0.0, 1.0, 0.0),
+                ROW 3 REAL : (0.0, 0.0, 1.0),
+                ROW 3 REAL : ( dx,  dy,  dz)))
+END PROC translate;
+
+PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :
+  INT CONST pic length := length (p.points);
+  INT VAR begin pos;
+  read pos := 0; 
+  x := 0.0; y := 0.0; z := 0.0;
+  IF p.dim = 2
+  THEN transform 2 dim pic
+  ELSE transform 3 dim pic FI  .
+ 
+transform 2 dim pic:
+  WHILE read pos < pic length
+  REP transform 2 dim position PER  .
+
+transform 2 dim position:
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : transform 2 dim point 
+  CASE move key : transform 2 dim point 
+  CASE move r key : transform 2 dim point 
+  CASE draw r key : transform 2 dim point 
+  CASE move cm key : read pos INCR 16
+  CASE draw cm key : read pos INCR 16
+  CASE move cm r key : read pos INCR 16
+  CASE draw cm r key : read pos INCR 16
+  CASE text key : read pos INCR next int + 24
+  CASE bar key : read pos INCR 18
+  CASE circle key : read pos INCR 26
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+transform 2 dim point:
+  begin pos := read pos+1;
+  x := next real;  y := next real;
+  transform (a, x, y, z); 
+  replace (r2, 1, x);
+  replace (r2, 2, y);
+  replace (p.points, begin pos, r2)  .
+
+transform 3 dim pic:
+  WHILE read pos < pic length
+  REP transform 3 dim position PER  .
+
+transform 3 dim position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : transform 3 dim point 
+  CASE move key : transform 3 dim point 
+  CASE move r key : transform 3 dim point 
+  CASE draw r key : transform 3 dim point 
+  CASE move cm key : read pos INCR 16
+  CASE draw cm key : read pos INCR 16
+  CASE move cm r key : read pos INCR 16
+  CASE draw cm r key : read pos INCR 16
+  CASE text key : read pos INCR next int + 24
+  CASE bar key : read pos INCR 18
+  CASE circle key : read pos INCR 26
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+transform 3 dim point:
+  begin pos := read pos+1;
+  x := next real;  y := next real; z := next real;
+  transform (a, x, y, z); 
+  replace (r3, 1, x);
+  replace (r3, 2, y);
+  replace (r3, 3, z);
+  replace (p.points, begin pos, r3)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC transform;
+
+PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :
+  REAL CONST ox :: x, oy :: y, oz :: z;
+  x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);
+  y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);
+  z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)
+END PROC transform;
+
+TEXT PROC text (PICTURE CONST pic):
+  TEXT VAR result :: ""0""0""0""0"";       (* 23.09.87 -cw- *)
+  replace (result, 1, pic.dim);            (* wegen Heap-Ueberlauf *)
+  replace (result, 2, pic.pen);
+  result CAT pic.points;
+  result
+END PROC text;
+
+PICTURE PROC picture (TEXT CONST text):
+  PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5))
+END PROC picture;
+
+END PACKET picture;
+
+(******************************** picfile *********************************) 
+
+PACKET picfile DEFINES                            (* Autor: H.Indenbirken  *)
+                                                  (* Stand: 23.02.1985     *)
+               PICFILE, :=, picture file,
+               select pen, selected pen, background, 
+               set values, get values,
+               view, viewport, window, oblique, orthographic, perspective,
+               extrema,
+
+               put, get,
+               to first pic, to eof, to pic, up, down,
+               is first picture, eof, picture no, pictures,
+               delete picture, insert picture, read picture,
+               write picture, put picture:
+
+
+LET max pics = 1024,
+    pic dataspace = 1102;
+
+
+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
+                             ROW 16 ROW 3 INT pens,
+                             ROW 16 BOOL hidden,
+                             ROW 3 ROW 2 REAL sizes,
+                             ROW 2 ROW 2 REAL limits,
+                             ROW 4 REAL angles,
+                             ROW 2 REAL obliques,
+                             ROW 3 REAL perspectives,
+                             ROW max pics PICTURE pic);
+
+TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0"";
+INT VAR i;
+
+OP := (PICFILE VAR dest, PICFILE CONST source):
+   EXTERNAL 260
+END OP := ;
+
+OP := (PICFILE VAR p, DATASPACE CONST d) :
+  IF type (d) = pic dataspace
+    THEN CONCR (p) := d
+  ELIF type (d) < 0
+    THEN type (d, pic dataspace) ;
+         CONCR (p) := d ;
+         init picfile dataspace ;
+  ELSE errorstop ("dataspace is no PICFILE") FI .
+ 
+init picfile dataspace :
+  r.size := 0;
+  r.pos  := 0;
+  r.background := 0;
+  r.sizes  [1][1] := 0.0;
+  r.sizes  [1][2] := 1.0;
+  r.sizes  [2][1] := 0.0;
+  r.sizes  [2][2] := 1.0;
+  r.sizes  [3][1] := 0.0;
+  r.sizes  [3][2] := 1.0;
+  r.limits [1][1] := 0.0;
+  r.limits [1][2] := 1.0;
+  r.limits [2][1] := 0.0;
+  r.limits [2][2] := 1.0;
+  r.angles [1]    := 0.0;
+  r.angles [2]    := 0.0;
+  r.angles [3]    := 0.0;
+  r.angles [4]    := 0.0;
+  r.obliques [1]  := 0.0;
+  r.obliques [2]  := 0.0;
+  r.perspectives [1] := 0.0;
+  r.perspectives [2] := 0.0;
+  r.perspectives [3] := 0.0;
+  FOR i FROM 1 UPTO 16
+  REP r.pens [i][1] := 1;
+      r.pens [i][2] := 0;
+      r.pens [i][3] := 1;
+      r.hidden [i] := TRUE
+  PER.
+  
+r : CONCR (CONCR (p)).
+
+END OP :=;
+ 
+DATASPACE PROC picture file (TEXT CONST name) :
+  IF exists (name)
+  THEN old (name)
+  ELSE new (name) FI 
+END PROC picture file;
+
+PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type,
+                                BOOL CONST hidden):
+  IF pen < 1 OR pen > 16
+  THEN errorstop ("pen out of range") FI;
+  p.pens   [pen][1] := colour;
+  p.pens   [pen][2] := thickness;
+  p.pens   [pen][3] := line type;
+  p.hidden [pen] := hidden
+END PROC select pen;
+
+PROC selected pen (PICFILE CONST p, INT CONST pen,
+                                    INT VAR colour, thickness, line type,
+                                    BOOL VAR hidden):
+  IF pen < 1 OR pen > 16
+  THEN errorstop ("pen out of range") FI;
+  colour    := p.pens [pen][1];
+  thickness := p.pens [pen][2];
+  line type := p.pens [pen][3];
+  hidden    := p.hidden [pen]
+END PROC selected pen;
+
+INT PROC background (PICFILE CONST p):
+  p.background
+END PROC background;
+
+PROC background (PICFILE VAR p, INT CONST colour):
+  p.background := colour
+END PROC background;
+
+PROC get values (PICFILE CONST p,
+                 ROW 3 ROW 2 REAL VAR size, 
+                 ROW 2 ROW 2 REAL VAR limits,
+                 ROW 4 REAL VAR angles,
+                 ROW 2 REAL VAR oblique,
+                 ROW 3 REAL VAR perspective) : 
+  size        := p.sizes;
+  limits      := p.limits;
+  angles      := p.angles;
+  oblique     := p.obliques;
+  perspective := p.perspectives;
+
+END PROC get values;
+ 
+PROC set values (PICFILE VAR p,
+                 ROW 3 ROW 2 REAL CONST size, 
+                 ROW 2 ROW 2 REAL CONST limits,
+                 ROW 4 REAL CONST angles,
+                 ROW 2 REAL CONST oblique,
+                 ROW 3 REAL CONST perspective) : 
+  p.sizes        := size;
+  p.limits       := limits;
+  p.angles       := angles;
+  p.obliques     := oblique;
+  p.perspectives := perspective;
+
+END PROC set values;
+ 
+PROC view (PICFILE VAR p, REAL CONST alpha):
+  p.angles [1] := alpha
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST phi, theta):
+  p.angles [2] := sind (theta) * cosd (phi);
+  p.angles [3] := sind (theta) * sind (phi);
+  p.angles [4] := cosd (theta);
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST x, y, z):
+  p.angles [2] := x;
+  p.angles [3] := y;
+  p.angles [4] := z
+END PROC view;
+
+PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :
+  p.limits [1][1] := hor min;
+  p.limits [1][2] := hor max;
+  p.limits [2][1] := vert min;
+  p.limits [2][2] := vert max;
+END PROC viewport;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :
+  window (p, x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :
+  p.sizes [1][1] := x min;
+  p.sizes [1][2] := x max;
+  p.sizes [2][1] := y min;
+  p.sizes [2][2] := y max;
+  p.sizes [3][1] := z min;
+  p.sizes [3][2] := z max;
+END PROC window;
+
+PROC oblique (PICFILE VAR p, REAL CONST a, b) :
+  p.obliques [1] := a;
+  p.obliques [2] := b;
+  p.perspectives [1] := 0.0;
+  p.perspectives [2] := 0.0;
+  p.perspectives [3] := 0.0
+END PROC oblique;
+
+PROC orthographic (PICFILE VAR p) :
+  p.obliques [1] := 0.0;
+  p.obliques [2] := 0.0;
+  p.perspectives [1] := 0.0;
+  p.perspectives [2] := 0.0;
+  p.perspectives [3] := 0.0
+END PROC orthographic;
+ 
+PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :
+  p.obliques [1] := 0.0;
+  p.obliques [2] := 0.0;
+  p.perspectives [1] := cx;
+  p.perspectives [2] := cy;
+  p.perspectives [3] := cz
+END PROC perspective;
+ 
+PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :
+  REAL VAR dummy;
+  extrema (p, x min, x max, y min, y max, dummy, dummy)
+END PROC extrema;
+
+PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :
+  REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;
+  x min := max real;  x max := - max real;
+  y min := max real;  y max := - max real;
+  z min := max real;  z max := - max real;
+  FOR i FROM 1 UPTO p.size
+  REP IF dim (p.pic [i]) = 2
+      THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) 
+      ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,
+                               new z min, new z max)
+      FI;
+      x min := min (x min, new x min); x max := max (x max, new x max); 
+      y min := min (y min, new y min); y max := max (y max, new y max); 
+      z min := min (z min, new z min); z max := max (z max, new z max); 
+  PER
+END PROC extrema;
+
+PROC put (FILE VAR f, PICFILE CONST p):
+  put line (f, parameter);
+  FOR i FROM 1 UPTO p.size
+  REP put line (f, text (p.pic [i])) PER  .
+
+parameter:
+  intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) +
+  intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) +
+  intern (p.obliques) + intern (p.perspectives)  .
+
+END PROC put;
+
+PROC get (PICFILE VAR p, FILE VAR f):
+  TEXT VAR record;
+  get line (f, record);
+  convert parameter;
+  FOR i FROM 1 UPTO p.size
+  REP get line (f, record);
+      p.pic [i] := picture (record)
+  PER  .
+
+convert parameter:
+  convert (record, p.size);        convert (record, p.pos);
+  convert (record, p.background);  convert (record, p.pens);
+  convert (record, p.hidden);      convert (record, p.sizes);
+  convert (record, p.limits);      convert (record, p.angles);
+  convert (record, p.obliques);    convert (record, p.perspectives)  .
+
+END PROC get;
+
+PROC to first pic (PICFILE VAR p):
+  p.pos := 1
+END PROC to first pic;
+
+PROC to eof (PICFILE VAR p):
+ p.pos := p.size+1
+END PROC to eof;
+
+PROC to pic (PICFILE VAR p, INT CONST n):
+  IF n < 1
+  THEN errorstop ("Position underflow")
+  ELIF n > p.size
+  THEN errorstop ("Position after end of PICFILE")
+  ELSE p.pos := n FI
+END PROC to pic;
+
+PROC up (PICFILE VAR p):
+  to pic (p, p.pos-1)
+END PROC up;
+
+PROC up (PICFILE VAR p, INT CONST n):
+  to pic (p, p.pos-n)
+END PROC up;
+
+PROC down (PICFILE VAR p):
+  to pic (p, p.pos+1)
+END PROC down;
+
+PROC down (PICFILE VAR p, INT CONST n):
+  to pic (p, p.pos+n)
+END PROC down;
+
+BOOL PROC is first picture (PICFILE CONST p):
+  p.pos = 1
+END PROC is first picture;
+
+BOOL PROC eof (PICFILE CONST p):
+  p.pos >= p.size
+END PROC eof;
+
+INT PROC picture no (PICFILE CONST p):
+  p.pos
+END PROC picture no;
+
+INT PROC pictures (PICFILE CONST p):
+  p.size
+END PROC pictures;
+
+PROC delete picture (PICFILE VAR p) :
+  INT VAR i;
+  FOR i FROM p.pos+1 UPTO p.size
+  REP p.pic [i-1] := p.pic [i] PER;
+
+  p.pic [p.size] := nilpicture;
+  IF p.size > 1
+  THEN p.size DECR 1 FI
+END PROC delete picture;
+
+PROC insert picture (PICFILE VAR p) :
+  INT VAR i;
+  IF p.size >= max pics
+  THEN errorstop ("PICFILE overflow")
+  ELSE p.size INCR 1;
+       FOR i FROM p.size DOWNTO p.pos+1
+       REP p.pic [i] := p.pic [i-1] PER;
+
+       p.pic [p.pos] := nilpicture;
+  FI
+END PROC insert picture;
+
+PROC read picture (PICFILE VAR p, PICTURE VAR pic) :
+  pic := p.pic (p.pos)  .
+END PROC read picture;
+ 
+PROC write picture (PICFILE VAR p, PICTURE CONST pic) :
+  p.pic (p.pos) := pic  .
+END PROC write picture;
+
+PROC put picture (PICFILE VAR p, PICTURE CONST pic) :
+  IF p.size >= max pics
+  THEN errorstop ("PICFILE overflow")
+  ELSE p.size INCR 1;
+       p.pic [p.size] := pic;
+  FI 
+END PROC put picture;
+
+TEXT PROC intern (INT CONST n):
+  replace (i text, 1, n);
+  i text
+END PROC intern;
+
+TEXT PROC intern (ROW 16 ROW 3 INT CONST n):
+  INT VAR i, j;
+  TEXT VAR result :: "";
+  FOR i FROM 1 UPTO 16
+  REP FOR j FROM 1 UPTO 3
+      REP result CAT intern (n [i][j]) PER
+  PER;
+  result
+END PROC intern;
+
+TEXT PROC intern (ROW 16 BOOL CONST n):
+  INT VAR i, result :: 0;
+  FOR i FROM 1 UPTO 16
+  REP IF n [i]
+      THEN set bit (result, i-1) FI
+  PER;
+  intern (result)
+END PROC intern;
+
+TEXT PROC intern (REAL CONST r):
+  replace (r text, 1, r);
+  r text
+END PROC intern;
+
+TEXT PROC intern (ROW 3 ROW 2 REAL CONST r):
+  INT VAR i, j;
+  TEXT VAR result :: "";
+  FOR i FROM 1 UPTO 3
+  REP FOR j FROM 1 UPTO 2
+      REP result CAT intern (r [i][j]) PER
+  PER;
+  result
+END PROC intern;
+
+TEXT PROC intern (ROW 2 ROW 2 REAL CONST r):
+  INT VAR i, j;
+  TEXT VAR result :: "";
+  FOR i FROM 1 UPTO 2
+  REP FOR j FROM 1 UPTO 2
+      REP result CAT intern (r [i][j]) PER
+  PER;
+  result
+END PROC intern;
+
+TEXT PROC intern (ROW 4 REAL CONST r):
+  intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) 
+END PROC intern;
+
+TEXT PROC intern (ROW 3 REAL CONST r):
+  intern (r [1]) + intern (r [2]) + intern (r [3])
+END PROC intern;
+
+TEXT PROC intern (ROW 2 REAL CONST r):
+  intern (r [1]) + intern (r [2])
+END PROC intern;
+
+PROC convert (TEXT VAR record, INT VAR n):
+  n := record ISUB 1;
+  record := subtext (record, 3)
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n):
+  INT VAR i, j;
+  FOR i FROM 1 UPTO 16
+  REP FOR j FROM 1 UPTO 3
+      REP convert (record, n [i][j]) PER
+  PER
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 16 BOOL VAR n):
+  INT VAR i, result;
+  convert (record, result);
+  FOR i FROM 1 UPTO 16
+  REP n [i] := bit (i-1, result) PER
+END PROC convert;
+
+PROC convert (TEXT VAR record, REAL VAR r):
+  r := record RSUB 1;
+  record := subtext (record, 9)
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r):
+  INT VAR i, j;
+  FOR i FROM 1 UPTO 3
+  REP FOR j FROM 1 UPTO 2
+      REP convert (record, r [i][j]) PER
+  PER;
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r):
+  INT VAR i, j;
+  FOR i FROM 1 UPTO 2
+  REP FOR j FROM 1 UPTO 2
+      REP convert (record, r [i][j]) PER
+  PER;
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 4 REAL VAR r):
+  convert (record, r [1]); convert (record, r [2]);
+  convert (record, r [3]); convert (record, r [4]) 
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 3 REAL VAR r):
+  convert (record, r [1]); convert (record, r [2]); convert (record, r [3])
+END PROC convert;
+
+PROC convert (TEXT VAR record, ROW 2 REAL VAR r):
+  convert (record, r [1]); convert (record, r [2])
+END PROC convert;
+
+END PACKET picfile;
+
+(********************************* devices ********************************)
+
+PACKET devices DEFINES PLOTTER, 
+                       select plotter, 
+                       install plotter, 
+                       plotters,
+                       plotter,
+                       no plotter,
+                       name, 
+                       channel, 
+                       station,
+                       actual plotter,
+                       drawing area, 
+                       plotter info,
+                       :=,
+                       = :
+ 
+LET trenn = "/";
+
+TYPE PLOTTER = STRUCT (INT station, channel, TEXT name);
+PLOTTER CONST noplotter :: PLOTTER : (0,0,""); 
+PLOTTER VAR plotter id  :: no plotter;
+TARGET   VAR devices; 
+TEXT VAR plotter set;
+INT VAR act plotter;
+ 
+OP := (PLOTTER VAR dest, PLOTTER CONST source): 
+   CONCR (dest) := CONCR (source)
+END OP := ;
+
+BOOL OP = (PLOTTER CONST a, b): 
+   (a.station = b.station) AND 
+   (a.channel = b.channel) AND 
+   (a.name    = b.name   ) 
+END OP =; 
+ 
+PLOTTER PROC plotter: 
+   plotter id 
+END PROC plotter;
+ 
+PLOTTER PROC plotter (TEXT CONST def plotter): 
+   select target (devices, def plotter, plotter set);
+   IF plotter set = ""
+      THEN IF def plotter = ""
+              THEN act plotter := 0; 
+                   no plotter
+              ELSE errorstop ("Unbekannter Plot-Id : " + def plotter);
+                   no plotter
+           FI 
+      ELSE select;plotter id
+   FI. 
+ 
+   select: 
+      INT VAR tp;
+      PLOTTER VAR plotter id;
+      plotter id.station := int(def plotter); 
+      tp      := pos (def plotter, trenn) + 1;
+      plotter id.channel := int(subtext (def plotter,tp)); 
+      plotter id.name    := subtext (def plotter, pos (def plotter,trenn,tp)+1); 
+END PROC plotter; 
+ 
+PROC select plotter: 
+   THESAURUS VAR plotter list :: empty thesaurus; 
+   TEXT VAR plotter name; 
+   INT VAR index :: 0; 
+   get (plotters, plotter name, index); 
+   WHILE index > 0 REP 
+      insert (plotter list,plotter info (plotter name,60));
+      get (plotters, plotter name, index)
+   PER; 
+   select plotter (name (plotters, link (plotter list, one(plotter list))))
+END PROC select plotter; 
+ 
+PROC select plotter (PLOTTER CONST plotter):
+   select plotter (text (plotter.station) + trenn + text (plotter.channel) +
+                   trenn + plotter.name) 
+END PROC select plotter;
+
+PROC select plotter (TEXT CONST def plotter): 
+   select target (devices, def plotter, plotter set);
+   IF plotter set = ""
+      THEN IF def plotter = ""
+              THEN act plotter := 0; 
+                   plotter id := no plotter
+              ELSE errorstop ("Unbekannter Plot-Id : " + def plotter)
+           FI 
+      ELSE select 
+   FI. 
+ 
+   select: 
+      INT VAR xp, yp, tp; REAL VAR xc, yc; 
+      act plotter := link (plotters, def plotter);
+      plotter id.station := int(def plotter); 
+      tp      := pos (def plotter, trenn) + 1;
+      plotter id.channel := int(subtext (def plotter,tp)); 
+      plotter id.name    := subtext (def plotter, pos (def plotter,trenn,tp)+1); 
+      drawing area (xc, yc, xp, yp); 
+      set drawing area (xc, yc, real (xp), real (yp));
+END PROC select plotter; 
+
+PROC install plotter (TARGET VAR new plotset): 
+   THESAURUS VAR new plotter :: target names (new plotset);
+   INT VAR index :: 0; 
+   TEXT VAR name,set;
+   initialize target (devices);
+   get (new plotter,name,index);
+   WHILE index > 0 REP
+      select target (new plotset, name, set);
+      complete target (devices, name, set);
+      get (new plotter, name, index)
+   PER
+END PROC install plotter; 
+ 
+INT PROC actual plotter:
+   act plotter
+END PROC actual plotter;
+
+THESAURUS PROC plotters: 
+   target names (devices) 
+END PROC plotters; 
+ 
+TEXT PROC name (PLOTTER CONST plotter): 
+   plotter.name
+END PROC name; 
+ 
+INT PROC channel (PLOTTER CONST plotter): 
+   plotter.channel 
+END PROC channel; 
+ 
+INT PROC station (PLOTTER CONST plotter):
+   plotter.station
+END PROC station;
+
+PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp): 
+   IF plotter set <> "" 
+      THEN INT VAR cp; 
+           xp  := int(plotter set); 
+           cp  := pos (plotter set,",")+1; 
+           yp  := int (subtext (plotter set,cp)); 
+           cp  := pos (plotter set,",",cp)+1;
+           xcm := real (subtext (plotter set,cp)); 
+           cp  := pos (plotter set,",",cp)+1; 
+           ycm := real (subtext (plotter set,cp))
+   FI 
+END PROC drawing area;
+ 
+PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp,PLOTTER CONST pl):
+   PLOTTER CONST keep :: plotter;
+   select plotter (pl);
+   drawing area (xcm, ycm, xp, yp); 
+   select plotter (keep) 
+END PROC drawing area; 
+ 
+TEXT PROC plotter info (TEXT CONST plotter id,INT CONST len): 
+   INT VAR tp            :: pos (plotter id, trenn)+1; 
+   TEXT VAR plotter name :: plotter id,
+            station      :: "/Station" + text (int(plotter name),2),
+            kanal        :: " Kanal" + text (int (subtext (plottername,tp)),3); 
+   plotter name := subtext (plotter name, pos (plotter name, trenn,tp)+1) + " "; 
+   INT VAR  llen         :: length (plotter name + kanal   + station);
+   plotter name + (max(len-llen,0) * ".") + kanal + station
+END PROC plotter info; 
+
+END PACKET devices
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Configurator b/app/mpg/2.2/src/GRAPHIK.Configurator
new file mode 100644
index 0000000..68bf070
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Configurator
@@ -0,0 +1,946 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.2 vom 11.11.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*          "Graphik-Konfiguration" geschrieben von C.Weinholz            *) 
+(*                                                                        *) 
+(**************************************************************************) 
+(*                                                                        *) 
+(*                          Graphik-Konfiguration                         *) 
+(*                                                                        *) 
+(*              Erstellung eines fuer alle Engeraete gueltigen            *) 
+(*                Basisgraphik-Paketes durch zusammenfuegen               *) 
+(*                           von '.GCONF'-Dateien                         *) 
+(*                                                                        *) 
+(*            Aufruf durch 'configurate graphik', wenn insertiert         *) 
+(*                      (normalerweise nicht notwendig)                   *) 
+(*             Bei 'run' muss 'configurate graphik' ans Dateiende         *) 
+(*                            geschrieben werden.                         *) 
+(*                                                                        *) 
+(**************************************************************************) 
+PACKET graphik configuration DEFINES configurate graphik: 
+ 
+LET PLOTTERCONF = STRUCT (TEXT name, station, channel, area, prep, init, end, 
+                               clear, home, move, draw, pixel, foreground, 
+                               background, palette, std colors, circle, box, 
+                               fill, cursor, get cursor, set marker, linked,
+                               BOOL editor, 
+                               BOOL no plotter); 
+LET max conf      = 15,
+    dquote        = ""34""34"",
+    interface     = "GRAPHIK.Configuration", 
+    env conf file = "ENVIRONMENT.GCONF",
+    packet header = "PACKET device interface DEFINES prepare, init plot, endplot, clear, home, moveto, drawto, setpixel, foreground, background, set color, stdcolors, color, colors, set palette, circle, box,fill,graphik cursor, get cursor, set marker:",
+    packet end    = "END PACKET device interface", 
+    target        = "TARGET VAR  plotter; initialize target ( plotter);", 
+    install target= "install plotter ( plotter);", 
+    init set      = "PROC initplot: IF  wsc THEN  palette :=  std palette 
+                     ELSE  palette :=  empty palette FI;  initplot; set palette 
+                     END PROC initplot;", 
+    end set       = "BOOL VAR  we::TRUE; 
+                     PROCendplot(BOOL CONSTs): we:=s 
+                     END PROCendplot; 
+                     PROCendplot: IF weTHEN endplotFI 
+                     END PROCendplot;", 
+    clear set     = "BOOL VAR  wc::TRUE; PROCclear(BOOL CONSTs): wc:=s  
+                     END PROC clear; PROC clear:IF wcTHEN clearFI END PROC clear;", 
+    color set     = "BOOL VAR  wsc::TRUE; TEXT VAR  palette; PROC setcolor (INT CONST no,rgb):
+                     IF (no+1) <= colors THEN replace( palette,no+1,rgb)
+                     FI END PROC set color;", 
+    color set2    = "INT PROC colors : length ( palette) DIV 2 END PROC colors; 
+                     INT PROC color (INT CONST no): IF no >= 0  AND (no+1) <= colors 
+                     THEN  palette ISUB (no+1) ELSE maxint FI END PROC color;", 
+    std colors    = "PROCstdcolors(BOOL CONSTs):  wsc:=s END PROCstdcolors; 
+                     PROC stdcolors:IF wscTHEN palette :=  std palette;set palette FI END PROCstdcolors;", 
+    foreground    = "INT VAR af::1; INT PROCforeground: af END PROCforeground; 
+                     PROCforeground(INT CONSTm):  af:=m; foreground( af) END PROCforeground;",  
+    background    = "INT VAR  ab::0; INT PROCbackground: ab END PROCbackground; 
+                     PROCbackground(INT CONSTm):  ab:=m; background( ab) END PROCbackground;"; 
+
+ROW max conf PLOTTERCONF VAR plotter; 
+ROW max conf DATASPACE VAR global data; 
+ 
+TEXT CONST spaces :: 20 * " ";
+INT VAR inst plotter, targets, error line :: 0;
+TEXT VAR errorm1, errorm2, procvalue :: "", env conf, error source :: "";
+BOOL VAR errors :: FALSE; 
+FILE VAR f; 
+DATASPACE VAR conf ds; 
+THESAURUS VAR plotconfs; 
+ 
+PROC configurate graphik: 
+   FOR inst plotter FROM 1 UPTO max conf REP 
+       act plotter.name := ""; 
+       act plotter.area := ""; 
+       act plotter.prep := "";
+       act plotter.init := ""; 
+       act plotter.end  := ""; 
+       act plotter.clear:= ""; 
+       act plotter.home := ""; 
+       act plotter.move := ""; 
+       act plotter.draw := ""; 
+       act plotter.pixel:= ""; 
+       act plotter.foreground := ""; 
+       act plotter.background := ""; 
+       act plotter.palette    := ""; 
+       act plotter.circle     := ""; 
+       act plotter.box        := "";  
+       act plotter.fill       := ""; 
+       act plotter.cursor     := ""; 
+       act plotter.get cursor := ""; 
+       act plotter.set marker := ""; 
+       act plotter.linked     := "";
+       act plotter.editor     := FALSE; 
+    PER; 
+    env conf := "";
+    inst plotter := 0; 
+    plotconfs := empty thesaurus; 
+    IF exists (env conf file) 
+       THEN plotconfs := ALL env conf file 
+    FI; 
+    plotconfs := SOME (plotconfs + (all LIKE "*.GCONF") - env conf file);  
+    INT VAR id :: 0; TEXT VAR conf file; 
+    get (plotconfs, conf file, id); 
+    WHILE id > 0 REP 
+       IF exists (conf file) 
+          THEN extract conf data (conf file)  
+          ELSE get environment plotter
+       FI;
+       get (plotconfs, conf file, id); 
+    PER; 
+    IF inst plotter > 0 
+       THEN generate interface
+       ELSE errorstop ("Kein Interface erzeugt") 
+    FI;
+    last param (interface). 
+ 
+    get environment plotter: 
+       check sequence (conf file, "PLOTTER *,*,*,*,*,*,*;", 
+                             "2|4,3,3,3,3,3,3;", 
+                             "PLOTTER erwartet,"+ 
+                             "Name erwartet,,"+ 
+                             "Station erwartet,,"+ 
+                             "Kanal erwartet,,"+ 
+                             "XPixel erwartet,,"+ 
+                             "YPixel erwartet,,"+ 
+                             "Xcm erwartet,,"+ 
+                             "Ycm erwartet,,"+ 
+                             "Plotterkommando fehlerhaft"); 
+       IF errors  
+          THEN errorstop (errorm2) 
+          ELSE TEXT VAR one int :: ""0""0"", one real :: 8 * ""0"";
+               replace (one int,1,length(get var (1))); 
+               env conf CAT one int;
+               env conf CAT get var (1);
+               replace (one int, 1, int (get var (2)));
+               env conf CAT one int;
+               replace (one int, 1, int (get var (3)));
+               env conf CAT one int; 
+               replace (one int, 1, int (get var (4)));
+               env conf CAT one int; 
+               replace (one int, 1, int (get var (5)));
+               env conf CAT one int; 
+               replace (one real, 1, real (get var (6)));
+               env conf CAT one real; 
+               replace (one real, 1, real (get var (7))); 
+               env conf CAT one real;
+       FI 
+END PROC configurate graphik; 
+ 
+PROC extract conf data (TEXT CONST conf file): 
+   TEXT VAR line;
+   inst plotter INCR 1; 
+   IF inst plotter > max conf 
+      THEN putline ("Warnung: Es koennen nicht mehr als " + text(max conf) + 
+                    " Geraete konfiguriert werden"); 
+           inst plotter DECR 1 
+      ELSE error source := conf file; 
+           conf ds := old (conf file); 
+           f := sequential file (modify, conf ds); 
+           set line numbers;
+           IF is plotter configuration 
+              THEN get name and area (line, act plotter.name, 
+                                            act plotter.station, 
+                                            act plotter.channel, 
+                                            act plotter.area);
+                   get linked    (act plotter.linked);
+                   get includes;
+                   putline ("""" + act plotter.name + """ wird eingelesen"); 
+                   get paramless ("initplot",act plotter.init); 
+                   get paramless ("endplot" ,act plotter.end); 
+                   get paramless ("clear"   ,act plotter.clear); 
+                   get paramless ("home"    ,act plotter.home); 
+                   get paramless ("prepare" ,act plotter.prep);
+                   get koord     ("moveto"  ,act plotter.move); 
+                   get koord     ("drawto"  ,act plotter.draw); 
+                   get koord     ("setpixel",act plotter.pixel); 
+                   get var param ("foreground",act plotter.foreground); 
+                   get var param ("background",act plotter.background); 
+                   get paramless ("setpalette",act plotter.palette); 
+                   get std colors(act plotter.std colors); 
+                   get circle    (act plotter.circle); 
+                   get box       (act plotter.box); 
+                   get fill      (act plotter.fill); 
+                   IF editor available 
+                      THEN get graphik cursor (act plotter.cursor); 
+                           get get cursor     (act plotter.get cursor); 
+                           get set marker     (act plotter.set marker) 
+                   FI;
+                   push error; 
+                   IF anything noted 
+                      THEN f := sequential file (modify,conf file); 
+                           out (""7"");note edit (f);errorstop("") 
+                   FI 
+              FI;  
+              global data [inst plotter] := conf ds; 
+              forget (conf ds) 
+   FI. 
+ 
+   is plotter configuration: 
+      plotter [inst plotter].no plotter := NOT sequence found ("PLOTTER", 
+                                                               line, 1,TRUE);
+      NOT plotter [inst plotter].no plotter. 
+ 
+   editor available: 
+      plotter [inst plotter].editor := sequence found ("EDITOR", line, 1,TRUE); 
+      IF plotter [inst plotter].editor
+         THEN delete record (f); 
+              check sequence (line, "EDITOR;", "2;",  
+                            "EDITOR erwartet,"+ 
+                            "Semikolon erwartet," + 
+                            "Editorkommando fehlerhaft") 
+      FI; 
+      plotter [inst plotter].editor. 
+ 
+   set line numbers: 
+      INT VAR  line number;
+      to line (f,1); 
+      FOR line number FROM 1 UPTO lines (f)-1 REP 
+          cout (line number);
+          insert line number;           
+          down (f)
+      PER; 
+      insert line number. 
+ 
+   insert line number: 
+      TEXT VAR new line;
+      read record (f, new line); 
+      insert char (new line, " ", 1); 
+      insert char (new line, " ", 1); 
+      replace (new line, 1, line number); 
+      write record (f, new line). 
+          
+   get includes: 
+      BOOL VAR include found :: sequence found ("INCLUDE",line, 1, TRUE); 
+      WHILE include found REP 
+         push error;
+         include found := sequence found ("INCLUDE",line, line no (f), TRUE); 
+         IF include found 
+            THEN add to plotconfs 
+         FI 
+      PER. 
+ 
+      add to plotconfs: 
+         check sequence (line, "INCLUDE *;","2|4;", 
+                               "INCLUDE erwartet,Dateiname erwartet," +
+                               "Includekommando fehlerhaft");
+         IF NOT errors CAND exists (get var (1))
+            THEN IF NOT (plotconfs CONTAINS get var (1)) 
+                    THEN insert (plotconfs,get var (1))
+                 FI;
+         ELIF NOT errors
+            THEN error ("""" + get var (1) + """ existiert nicht")
+         FI;
+         delete record (f)
+END PROC extract conf data; 
+ 
+PROC generate interface: 
+   INT VAR act conf; 
+   conf ds := nilspace; 
+   forget (interface,quiet); 
+   proc value := ""; 
+   FILE VAR f :: sequential file (output, conf ds); 
+   putline (f,packet header); 
+   putline (f,target); 
+   generate target;
+   putline (f,install target); 
+   putline (f,init set);
+   putline (f,end set); 
+   putline (f,clear set); 
+   putline (f,color set); 
+   putline (f,color set 2);
+   putline (f, std colors);
+   putline (f,foreground); 
+   putline (f,background); 
+   FOR act conf FROM 1 UPTO inst plotter REP 
+      FILE VAR source := sequential file (modify,global data [act conf]); 
+      copy lines (f,source) 
+   PER; 
+   generate proc (""," initplot", TEXT PROC (INT CONST) initplotbody); 
+   generate proc (""," endplot",  TEXT PROC (INT CONST) endplotbody); 
+   generate proc (""," clear",    TEXT PROC (INT CONST) clearbody); 
+   generate proc ("","prepare",   TEXT PROC (INT CONST) prepbody);
+   proc value := " TEXT";
+   generate proc (""," std palette", TEXT PROC (INT CONST) std palette body); 
+   generate proc (""," empty palette", TEXT PROC (INT CONST) empty palette body);
+   proc value := "";
+   generate proc ("","home",     TEXT PROC (INT CONST) homebody); 
+   generate proc ("INT CONST x,y","moveto", TEXT PROC (INT CONST) movebody); 
+   generate proc ("INT CONST x,y","drawto", TEXT PROC (INT CONST) drawbody); 
+   generate proc ("INT CONST x,y","set pixel", TEXT PROC (INT CONST) pixelbody); 
+   generate proc ("INT VAR type"," foreground", TEXT PROC (INT CONST) foregroundbody); 
+   generate proc ("INT VAR type"," background", TEXT PROC (INT CONST) backgroundbody); 
+   generate proc ("","set palette", TEXT PROC (INT CONST) set palette body); 
+   generate proc ("INT CONST x,y,rad,from,to","circle", TEXT PROC (INT CONST) circlebody); 
+   generate proc ("INT CONST x1,y1,x2,y2,pattern", "box", TEXT PROC (INT CONST) box body); 
+   generate proc ("INT CONST x,y,pattern","fill", TEXT PROC (INT CONST) fill body); 
+   generate proc ("INT CONST x,y, BOOL CONST on","graphik cursor",TEXT PROC (INT CONST) graphik cursor body); 
+   generate proc ("INT VAR x,y, TEXT VAR exit char","get cursor",TEXT PROC (INT CONST) get cursor body); 
+   generate proc ("INT CONST x,y, type","set marker",TEXT PROC (INT CONST) set marker body); 
+   proc value := "BOOL "; 
+   generate proc ("","graphik cursor",TEXT PROC (INT CONST) editor available); 
+   generate device link;
+   putline (f,packet end); 
+   copy (conf ds,interface);
+   IF yes ("""" + interface + """ insertieren")
+      THEN insert (interface)
+   FI.
+ 
+   generate target:
+      INT VAR devices :: 0; 
+      targets := 0;
+      FOR act conf FROM 1 UPTO inst plotter REP 
+         TEXT VAR linked :: plotter[act conf].linked,
+                  one int:: ""0""0"";
+         plotter [act conf].linked := "";
+         IF NOT plotter [act conf].no plotter 
+             THEN putline (f,"complete target ( plotter,""" + 
+                  plotter [act conf].station + "/" + 
+                  plotter [act conf].channel + "/" + 
+                  plotter [act conf].name + 
+                  """,""" + plotter [act conf].area + """);"); 
+                  devices INCR 1; 
+                  targets INCR 1;
+                  replace (one int, 1, devices);
+                  plotter [act conf].linked CAT one int; 
+                  replace (one int, 1, targets);
+                  plotter [act conf].linked CAT one int;
+                  IF linked > "" 
+                     THEN INT VAR x :: 1; 
+                          WHILE x <=  length (linked) DIV 2 REP 
+                             putline (f,"complete target ( plotter, """ + 
+                             text(linked ISUB x) + "/" + 
+                             text(linked ISUB (x+1)) + "/" + 
+                             plotter[act conf].name + """,""" + 
+                             plotter[act conf].area + """);"); 
+                             targets INCR 1; 
+                             replace (one int, 1, targets);
+                             plotter [act conf].linked CAT one int; 
+                             x INCR 2 
+                          PER
+                  FI
+          FI 
+      PER; 
+      WHILE env conf <> "" REP 
+         generate env target (env conf) 
+      PER 
+END PROC generate interface; 
+ 
+PROC generate env target (TEXT VAR conf):
+   INT VAR nlen  :: conf ISUB 1; 
+   TEXT VAR tnam :: subtext (conf, 3, 2+nlen); 
+   conf := subtext (conf, nlen + 3);
+   putline (f,"complete target ( plotter, """ + text (conf ISUB 1) + "/" + 
+              text (conf ISUB 2) + "/" + tnam + """,""" + 
+              text (conf ISUB 3) + "," + text (conf ISUB 4) + "," + 
+              first real + "," + text (conf RSUB 2) + """);");
+   conf := subtext (conf, 17). 
+ 
+   first real: 
+      conf := subtext (conf, 9); 
+      text (conf RSUB 1)
+END PROC generate env target; 
+ 
+TEXT PROC initplotbody (INT CONST no): 
+   plotter [no].init 
+END PROC initplotbody; 
+ 
+TEXT PROC endplotbody (INT CONST no): 
+   plotter [no].end 
+END PROC endplotbody; 
+ 
+TEXT PROC clearbody (INT CONST no): 
+   plotter [no].clear 
+END PROC clearbody; 
+ 
+TEXT PROC prepbody (INT CONST no): 
+   plotter [no].prep 
+END PROC prepbody; 
+ 
+TEXT PROC homebody (INT CONST no): 
+   plotter [no].home 
+END PROC homebody; 
+ 
+TEXT PROC movebody (INT CONST no): 
+   plotter [no].move 
+END PROC movebody; 
+ 
+TEXT PROC drawbody (INT CONST no): 
+   plotter [no].draw 
+END PROC drawbody; 
+ 
+TEXT PROC pixelbody (INT CONST no): 
+   plotter [no].pixel  
+END PROC pixelbody; 
+ 
+TEXT PROC std palette body (INT CONST no): 
+   TEXT CONST rgb codes :: plotter [no].std colors;
+   TEXT VAR body :: dquote; 
+   INT VAR x; 
+   FOR x FROM 1 UPTO length (rgb codes) DIV 3 REP 
+      INT VAR color :: int (subtext(rgb codes, (x-1)*3+1, x*3)); 
+      body CAT (text (color AND 255) + dquote);
+      body CAT (text (color DIV 256) + dquote);
+   PER;
+   body 
+END PROC std palette body;
+ 
+TEXT PROC empty palette body (INT CONST no):
+   text (length (plotter[no].std colors) DIV 3) + "*" + dquote +
+   "255" + dquote + "127" + dquote
+END PROC empty palette body;
+
+TEXT PROC set palette body (INT CONST no): 
+   plotter[no].palette 
+END PROC set palette body; 
+ 
+TEXT PROC foregroundbody (INT CONST no): 
+   plotter [no].foreground 
+END PROC foregroundbody; 
+ 
+TEXT PROC backgroundbody (INT CONST no): 
+   plotter [no].background 
+END PROC backgroundbody; 
+ 
+TEXT PROC circle body (INT CONST no): 
+   plotter [no].circle 
+END PROC circle body; 
+ 
+TEXT PROC box body (INT CONST no): 
+   plotter [no].box  
+END PROC box body; 
+ 
+TEXT PROC fill body (INT CONST no): 
+   plotter [no].fill 
+END PROC fill body; 
+ 
+TEXT PROC graphik cursor body (INT CONST no): 
+   plotter [no].cursor 
+END PROC graphik cursor body; 
+ 
+TEXT PROC get cursor body (INT CONST no): 
+   plotter [no].get cursor 
+END PROC get cursor body; 
+ 
+TEXT PROC set marker body (INT CONST no): 
+   plotter [no].set marker 
+END PROC set marker body; 
+ 
+TEXT PROC editor available (INT CONST no): 
+   IF plotter [no].editor 
+      THEN "TRUE" 
+      ELSE "FALSE" 
+   FI 
+END PROC editor available; 
+
+PROC generate device link:
+   INT VAR actconf;
+   putline (f, "INT PROC  act device :");
+   putline (f, "SELECT actual plotter OF");
+   FOR act conf FROM 1 UPTO inst plotter REP
+      IF NOT plotter [act conf].no plotter
+         THEN putline (f,"CASE " + text (plotter[act conf].linked ISUB 2) + ":");
+              put (f,text (plotter[act conf].linked ISUB 1));
+              IF length (plotter[act conf].linked) > 2 
+                 THEN generate table 
+              FI
+      FI 
+   PER;
+   putline (f,"OTHERWISE errorstop (""Kein Endgeraet angekoppelt"");0"); 
+   putline (f,"END SELECT END PROC  act device;").
+
+   generate table: 
+      INT VAR x; 
+      FOR x FROM 3 UPTO length (plotter[act conf].linked) DIV 2 REP 
+         put (f,"CASE"); 
+         put (f,text (plotter[act conf].linked ISUB x)); 
+         put (f,":"); 
+         put (f, text (plotter[act conf].linked ISUB 1))
+      PER 
+END PROC generate device link; 
+
+PROC generate proc (TEXT CONST params,procname,TEXT PROC (INT CONST)procbody): 
+   INT VAR actconf, no plotter :: 0; 
+   IF params = "" 
+      THEN putline (f,procvalue + " PROC " + procname + ":") 
+      ELSE putline (f,procvalue + " PROC " + procname + "(" + params + "):") 
+   FI; 
+   IF procvalue <> "" 
+      THEN putline (f,procvalue + " VAR  d;") 
+   FI; 
+   putline (f,"SELECT  act device OF");  
+   FOR act conf FROM 1 UPTO inst plotter REP 
+       IF NOT plotter [act conf].no plotter 
+          THEN putline (f, "CASE " + text (act conf-no plotter) + ":" + 
+                           lowercase(plotter[act conf].name) + 
+                           plotter [act conf].channel + procname) 
+          ELSE no plotter INCR 1 
+       FI 
+   PER; 
+   IF procvalue <> "" 
+      THEN putline (f," OTHERWISE  d END SELECT")
+      ELSE putline (f," END SELECT") 
+   FI; 
+   FOR act conf FROM 1 UPTO inst plotter REP                                 
+       IF NOT plotter [act conf].no plotter 
+          THEN putline (f,"."); 
+               putline (f,lowercase(plotter[act conf].name)+ 
+                          plotter[act conf].channel + procname + ":"); 
+                          putline (f,procbody (act conf)) 
+       FI 
+   PER; 
+   putline (f,"END PROC "+ procname +";") 
+END PROC generate proc;      
+ 
+PROC get name and area (TEXT CONST line, TEXT VAR name, station, channel, area): 
+   push error; 
+   check sequence (line, "PLOTTER *,*,*,*,*,*,*;", 
+                         "2|4,3,3,3,3,3,3;", 
+                         "PLOTTER erwartet,"+ 
+                         "Name erwartet,,"+ 
+                         "Station erwartet,,"+ 
+                         "Kanal erwartet,,"+ 
+                         "XPixel erwartet,,"+ 
+                         "YPixel erwartet,,"+ 
+                         "Xcm erwartet,,"+ 
+                         "Ycm erwartet,,"+ 
+                         "Plotterkommando fehlerhaft"); 
+   name    := get var (1); 
+   station := get var (2); 
+   channel := get var (3); 
+   area := ""; 
+   area CAT (get var (4) + ","); 
+   area CAT (get var (5) + ","); 
+   area CAT (get var (6) + ","); 
+   area CAT (get var (7) + ","); 
+   delete record (f)
+END PROC get name and area; 
+ 
+PROC get linked (TEXT VAR keep):
+   TEXT VAR line;
+   IF sequence found ("LINK", line, 1, TRUE)
+      THEN extract data;
+           delete record (f)
+   FI.  
+ 
+   extract data: 
+      TEXT VAR symbol, one int :: ""0""0"";
+      INT VAR ltyp :: 2,type :: 0;(* 0 = ',' 1 = '/' 2 = Station 3 = Kanal*) 
+      push error;                 (* 4 = Ende erwartet ! *)
+      keep := "";
+      errorm1 := line; 
+      scan (line);
+      next symbol (symbol);
+      IF symbol <> "LINK"
+         THEN error ("LINK erwartet")
+      FI;
+      WHILE type < 7 AND NOT errors REP 
+         next symbol (symbol, type); 
+         IF ltyp = 0 
+            THEN IF symbol = "," 
+                    THEN ltyp := 2 
+                 ELIF symbol = ";" 
+                    THEN ltyp := 4 
+                    ELSE error ("Semikolon oder Komma erwartet") 
+                 FI
+         ELIF ltyp = 1 
+            THEN IF symbol = "/" 
+                    THEN ltyp := 3 
+                    ELSE error ("'/' erwartet")
+                 FI
+         ELIF ltyp = 4 
+            THEN IF type = 8 
+                    THEN error ("Kommentarende fehlt") 
+                 ELIF type = 9 
+                    THEN error ("Text unzulaessig (Textende fehlt)") 
+                 ELIF type <> 7 
+                    THEN error ("Zeilenende nach Semikolon erwartet") 
+                 FI 
+         ELIF type = 3  
+            THEN replace (one int, 1, int (symbol)); 
+                 keep CAT one int; 
+                 ltyp DECR 1;
+                 IF ltyp = 2 
+                    THEN ltyp := 0 
+                 FI 
+      FI
+   PER
+END PROC get linked; 
+ 
+PROC get graphik cursor (TEXT VAR keep): 
+   get proc ("graphik cursor","(INT CONST x,y, BOOL CONST on)", 
+             "(2|2 x,y,2|2 on)","INT erwartet, CONST erwartet,"+ 
+             "Formaler Parameter muss x heissen,"+ 
+             "Formaler Parameter muss y heissen,"+ 
+             "BOOL erwartet, CONST erwartet,"+ 
+             "Formaler Parameter muss on heissen", 
+             keep); 
+END PROC get graphik cursor; 
+ 
+PROC get get cursor (TEXT VAR keep): 
+   get proc ("get cursor","(INT VAR x,y, TEXT VAR exit char)", 
+             "(2|2 x,y,2|2 exit char)","INT erwartet, VAR erwartet,"+ 
+             "Formaler Parameter muss x heissen,"+ 
+             "Formaler Parameter muss y heissen,"+ 
+             "TEXT erwartet, VAR erwartet,"+ 
+             "Formaler Parameter muss exit char heissen", 
+             keep); 
+END PROC get get cursor; 
+ 
+PROC get set marker (TEXT VAR keep): 
+   get proc ("set marker","(INT CONST x,y,type)","(2|2 x,y,type)", 
+             "INT erwartet, CONST erwartet,"+ 
+             "Formaler Parameter muss x heissen,"+ 
+             "Formaler Parameter muss y heissen,"+ 
+             "Formaler Parameter muss type heissen", 
+             keep); 
+END PROC get set marker; 
+ 
+PROC get std colors (TEXT VAR keep): 
+   TEXT VAR line;
+   push error; 
+   IF sequence found ("COLORS", line, 1, TRUE)
+      THEN extract data 
+      ELSE error ("COLORS fehlt") 
+   FI.  
+ 
+   extract data: 
+      check sequence (line, "COLORS *;","2|4;", 
+                            "COLORS erwartet,"+ 
+                            "Rgbcodes erwartet,Semikolon fehlt"); 
+      keep := get var (1); 
+      delete record (f); 
+END PROC get std colors; 
+ 
+PROC get paramless (TEXT CONST procname, TEXT VAR keep): 
+   get proc (procname, "", "", "", keep) 
+END PROC get paramless; 
+ 
+PROC get var param (TEXT CONST procname, TEXT VAR keep): 
+   get proc (procname, "(INT VAR type)","(2|2 type)", 
+             "INT erwartet, VAR erwartet, Formaler Parameter muss type heissen", 
+             keep); 
+END PROC get var param; 
+ 
+PROC get koord (TEXT CONST procname, TEXT VAR keep): 
+   get proc (procname, "(INT CONST x,y)","(2|2 x,y)", 
+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ 
+             "Formaler Parameter muss y heissen",keep) 
+END PROC get koord; 
+ 
+PROC get circle (TEXT VAR keep): 
+   get proc ("circle","(INT CONST x,y,rad,from,to)","(2|2 x,y,rad,from,to)", 
+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ 
+             "Formaler Parameter muss y heissen,Formaler Parameter muss rad heissen,"+ 
+             "Formaler Parameter muss from heissen,Formaler Parameter muss to heissen", 
+             keep); 
+END PROC get circle; 
+ 
+PROC get box (TEXT VAR keep): 
+   get proc ("box","(INT CONST x1,y1,x2,y2,pattern)","(2|2 x1,y1,x2,y2,pattern)", 
+             "INT erwartet,CONST erwartet,Formaler Parameter muss x1 heissen,"+ 
+             "Formaler Parameter muss y1 heissen,Formaler Parameter muss x2 heissen,"+ 
+             "Formaler Parameter muss y2 heissen,Formaler Parameter muss pattern heissen", 
+             keep); 
+END PROC get box; 
+ 
+PROC get fill (TEXT VAR keep): 
+   get proc ("fill","(INT CONST x,y,pattern)","(2|2 x,y,pattern)", 
+             "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen"+ 
+             "Formaler Parameter muss y heissen,Formaler Parameter muss pattern heissen", 
+             keep); 
+END PROC get fill; 
+ 
+PROC get proc (TEXT CONST procname, psym, ptyp, perr, 
+               TEXT VAR   keep): 
+   TEXT VAR line;
+   push error; 
+   IF sequence found ("PROC"+procname, line, 1, TRUE) 
+      THEN errors := FALSE;
+           get body (line,procname,psym,ptyp,perr,keep)
+      ELSE error (procname + " nicht gefunden") 
+   FI
+END PROC get proc; 
+ 
+PROC get body (TEXT CONST header,procname,psyms,ptypes ,perrs, TEXT VAR keep body): 
+   INT VAR start, ende; 
+   start := line no(f); 
+   keep body := ""; 
+   check sequence (header, "PROC " + procname + psyms + ":", 
+                         "2|1"+ ptypes + ":", 
+                         "PROC erwartet,"      + 
+                          procname + " erwartet,,"+ 
+                          perrs+ 
+                         ",Fehler in " + procname + "-Header"); 
+   IF NOT errors
+      THEN get to end of proc
+   FI.
+
+   get to end of proc:
+      TEXT VAR last;
+      errors := FALSE; 
+      IF sequence found ("END PROC " + procname,  last, line no(f),FALSE)
+         THEN ende := line no (f); 
+              check sequence (last, "END PROC " + procname + ";", 
+                                    "2|2|1;", 
+                                    "END erwartet,"+ 
+                                    "PROC erwartet,"+ 
+                                    "PROC heisst " + procname + 
+                                    ",Semikolon fehlt"); 
+              IF NOT errors 
+                 THEN to line (f,start); 
+                      delete record (f); 
+                      INT VAR lc; 
+                      FOR lc FROM start UPTO ende-2 REP 
+                          TEXT VAR scratch; 
+                          read record (f,scratch); 
+                          scratch := subtext (scratch, 3);
+                          keep body CAT (" " + scratch); 
+                          delete record (f); 
+                      PER; 
+                      delete record (f)
+              FI 
+         ELSE error ("END PROC " + procname + " nicht gefunden") 
+      FI 
+END PROC get body; 
+ 
+BOOL PROC sequence found (TEXT CONST sequence text, 
+                          TEXT VAR   sequence line, INT CONST from line,
+                          BOOL CONST evtl at): 
+   BOOL VAR found :: FALSE, at char :: evtl at;
+   to line (f,from line);
+   col (f,1);
+   WHILE NOT (found OR eof (f)) REP 
+      cout (line no (f));
+      to first char; 
+      IF found 
+         THEN read record (f, sequence line);
+              error line := sequence line ISUB 1;
+              sequence line := subtext (sequence line, 3); 
+              scan sequence
+      FI
+   PER; 
+   IF NOT found 
+      THEN read record (f, sequence line);
+           IF pos (first char, sequence line) > 0 
+              THEN scan sequence 
+           FI
+   FI;
+   found.
+ 
+   to first char: 
+      IF at char
+         THEN downety (f, first char)
+         ELSE down (f, first char)
+      FI; 
+      at char := FALSE;
+      found := pattern found. 
+ 
+   scan sequence: 
+      TEXT VAR source symbols,symbols;
+      scan (sequence text); 
+      get symbols;
+      source symbols := symbols;
+      scan (sequence line); 
+      get symbols; 
+      found := pos (symbols,source symbols) = 1.
+
+   get symbols: 
+      TEXT VAR symbol;
+      INT VAR type;
+      symbols := "";
+      REP 
+          next symbol (symbol, type); 
+          symbols CAT symbol
+      UNTIL type > 6 PER. 
+ 
+   first char: 
+      sequence text SUB 1 
+END PROC sequence found; 
+ 
+PROC error (TEXT CONST emsg): 
+   IF NOT eof (f) 
+      THEN read record (f,errorm1); 
+           errorm1 := """" + error source + """, Zeile " + 
+                      text (error line) + ":"
+      ELSE errorm1 := """" + error source + """, Fileende:" 
+   FI; 
+   errorm2 := spaces + emsg; 
+   errors  := TRUE  
+END PROC error; 
+ 
+PROC push error: 
+  IF errors 
+     THEN note (errorm1);note line; 
+          note (10* " " + errorm2); note line; 
+          errors := FALSE 
+  FI 
+END PROC push error; 
+ 
+ (* Hinweis: bei Fehlermeldungen statt Blank ' ' (geschuetzt) verwenden. 
+             Bei verschiedenen Typen ohne trennenden Delimiter zur 
+             Abgrenzung in 'seq typ' '|' verwenden. 
+             '*' wird in 'seq sym' als Wildcard verwendet (Itemweise) 
+             Bei Delimitern wird der 'allgemeine Fehler' (letzter i.d Liste) 
+             verwendet. Jedoch muss auch fuer Delimiter ein Eintrag 
+             in der Liste freigehalten werden (...,,... oder ...,dummy,...). 
+*) 
+ 
+ROW 100 STRUCT (TEXT sym, INT typ, BOOL var) VAR seqlist; 
+INT VAR scanpos; 
+ 
+TEXT PROC get var (INT CONST no): 
+   INT VAR count :: 0, checkpos :: 1; 
+   WHILE checkpos <= scanpos REP 
+      IF seqlist[checkpos].var 
+         THEN count INCR 1; 
+              IF count >= no 
+                 THEN LEAVE get var WITH seqlist[checkpos].sym 
+              FI 
+      FI; 
+      checkpos INCR 1  
+   PER;"" 
+END PROC get var; 
+ 
+PROC check sequence (TEXT CONST seq, seq sym, seq typ, seq err): 
+   ROW 100 TEXT VAR err; 
+   INT VAR checkpos,erpos, typ, error1 :: 0,error2 :: 0; 
+   TEXT VAR sym; 
+   scan (seq err); 
+   next symbol (sym, typ); 
+   erpos := 1; 
+   err[erpos] := ""; 
+   REP 
+       SELECT typ OF 
+         CASE 5: err[erpos] CAT " " 
+         CASE 6: erpos INCR 1; 
+                 err [erpos] := "" 
+       OTHERWISE err[erpos] CAT sym 
+       END SELECT; 
+       next symbol (sym, typ) 
+    UNTIL typ >= 7 PER; 
+    scan (seq); 
+    FOR scanpos FROM 1 UPTO 100 REP 
+       next symbol (seqlist[scanpos].sym,seqlist[scanpos].typ); 
+    UNTIL seqlist[scanpos].typ >= 7 PER; 
+    SELECT seqlist[scanpos].typ OF 
+      CASE 8: error ("Kommentarende fehlt") 
+      CASE 9: error ("Textende fehlt") 
+      OTHERWISE IF scanpos = 100 
+                   THEN error ("Kommando zu schwierig") 
+                FI 
+    END SELECT; 
+    scan (seq sym); 
+    FOR checkpos FROM 1 UPTO scanpos REP 
+       next symbol (sym, typ); 
+       IF sym = "*" 
+          THEN seqlist[checkpos].var := TRUE 
+          ELSE seqlist[checkpos].var := FALSE 
+       FI 
+    PER; 
+    scan (seq typ); 
+    next symbol (sym,typ); 
+    FOR checkpos FROM 1 UPTO scanpos REP 
+       WHILE sym = "|" REP 
+         next symbol (sym, typ) 
+       PER; 
+       BOOL VAR std err :: typ <> 3;  
+       IF NOT std err 
+          THEN typ := int(sym); 
+               IF seqlist[checkpos].typ <> typ 
+                  THEN error1 := checkpos 
+               FI; 
+       ELIF seqlist[checkpos].sym <> sym 
+          THEN error1 := erpos 
+       FI; 
+       next symbol (sym, typ) 
+    UNTIL error1 > 0 OR typ >= 7 PER; 
+    scan (seq sym); 
+    next symbol (sym,typ); 
+    FOR checkpos FROM 1 UPTO scanpos-1 REP 
+       std err := typ = 6; 
+       IF (seqlist[checkpos].sym <> sym) AND (sym <> "*") 
+          THEN IF std err 
+                  THEN error2 := erpos 
+                  ELSE error2 := checkpos 
+               FI 
+       FI; 
+       next symbol (sym, typ) 
+    UNTIL error2 > 0 PER; 
+    IF error1 = 0 
+       THEN error1 := error2 
+    ELIF error1 = erpos 
+       THEN IF (error2 <> 0) AND (error2 <> erpos) 
+               THEN error1 := error2 
+            FI 
+    FI;  
+    IF error1 > 0 
+       THEN error (err [error1]) 
+    FI 
+END PROC check sequence; 
+ 
+INT PROC lower pair (INT CONST upper pair): 
+   INT VAR lower :: upper pair; 
+   set bit (lower,5); 
+   set bit (lower,13); 
+   lower 
+END PROC lower pair; 
+ 
+TEXT PROC lower case (TEXT CONST uppercase): 
+   TEXT VAR lower :: uppercase; 
+   INT VAR x; 
+   IF length(lower) MOD 2 <> 0 
+      THEN lower CAT ""0"" 
+   FI ; 
+   FOR x FROM 1 UPTO length(lower)DIV2 REP 
+      replace (lower,x,lower pair (lower ISUB x)) 
+   PER; 
+   lower  
+END PROC lower case; 
+ 
+PROC copy lines (FILE VAR dest, source): 
+   INT VAR l; 
+   input(source); 
+   output(dest); 
+   FOR l FROM 1 UPTO lines (source) REP 
+      TEXT VAR scratch,test; 
+      getline (source,scratch); 
+      scratch := subtext (scratch,3);
+      test := scratch; 
+      change all (test," ",""); 
+      IF test <> "" 
+         THEN putline (dest, scratch) 
+      FI 
+   PER 
+END PROC copy lines;
+
+.act plotter:
+   plotter[inst plotter]
+ 
+END PACKET graphik configuration; 
+configurate graphik
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Fkt b/app/mpg/2.2/src/GRAPHIK.Fkt
new file mode 100644
index 0000000..6e42af4
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Fkt
@@ -0,0 +1,1379 @@
+(***************************************************************************)
+(*                                                                         *)
+(*                       FKT - Funktionenplotter                           *)
+(*                                                                         *)
+(* Grundversion : MPG, KB, KN, LP      23.05.84     | 7756 Byte Code       *)
+(* Version 6.20 : MPG, Rainer Kottmann 23.09.85     | 7196 Byte Paketdaten *)
+(* Angepasst an MPG-Turtle-Standard :  07.03.85     | 1374 Zeilen          *)
+(* Version 8.21 : MPG,Beat Jegerlehner 18.09.87     |                      *)
+(* Angepasst an MPG EUMELGRAPHIK/EUMEL Version 1.8.1|                      *)
+(*                                                                         *)
+(***************************************************************************)
+PACKET funktionen DEFINES fkt plot,   (*************************************)
+                          y grenzen,  (* Interaktives Programm             *)
+                          wertetafel, (* Einzelprozeduren fuer "do"        *)
+                          ~,          (* BOOL OP "ungefaehr gleich"        *)
+                          luecke :    (* Dummykonstante fuer "undefiniert" *)
+                                      (*************************************)
+                                      (* Autoren:    Klaus Bovermann       *)
+                                      (*             Kai Nikisch           *)
+                                      (*             Lutz Prechelt         *)
+                                      (*             Rainer Kottmann       *)
+                                      (*             Beat Jegerlehner      *)
+                                      (*************************************) 
+ 
+LET fkpos          =  1,           (* Diese LETs sind Bildschirmpositionen *)
+    inpos          =  2,
+    wpos           =  3,
+    fehlerpos      =  5,
+    eingpos        =  7,
+    textpos        = 11,
+    wahlpos        = 24,
+    xupos          = 16,
+    yupos          = 16,
+    xopos          = 32,
+    yopos          = 32,
+    stuetzpktpos   = 48,
+    endgeraetepos  = 20;
+
+LET punkte         = 512,            (* maximale Anzahl der Stuetzpunkte *) 
+    ug1            = 0.15051,        (* Hilfswerte fuer 'gauss'          *)
+    ug2            = 0.5, 
+    ug3            = 0.84948,
+    din a 4 hoehe  = 5.0,            (* Hoehe der Beschriftung  *)
+    din a 4 breite = 5.0,            (* in mm                   *)
+    ziffern        = 12,             (* Genauigkeitsangabe      *)
+    gross          = 8.888888e88,
+    epsilon        = 1.0e-11;
+
+LET wahlstring              = ""8""2"fdwsazntlLAqeb~?",
+    farbstr                 = "<CR>Standard <r>ot <b>lau <g>ruen <s>chwarz",
+    farbchars               = ""13"rbgs",
+    graphikvater            = "GRAPHIK",
+    helpfile                = "FKT.help";
+
+ROW punkte REAL VAR graph;
+
+TEXT VAR term            :: "",
+         rohterm         :: "",
+         picfilename     :: "",
+         prefix          :: "PICFILE.",
+         postfix         :: "",
+         fehlernachricht :: "",
+         proc,
+         inline;
+
+REAL VAR x min ::  -gross,  x max ::  gross,
+         y min ::  maxreal, y max :: -maxreal,
+         xstep;
+
+INT  VAR nachkomma :: 2,
+         stuetzen  :: punkte,
+         endgeraet :: 1,
+         endgeraete :: highest entry(plotters);
+
+BOOL VAR intervall definiert   :: FALSE,
+         wertebereich bestimmt :: FALSE,
+         wertetafel vorhanden  :: FALSE,
+         fehlerzustand         :: FALSE;
+
+REAL CONST luecke :: gross;
+
+PICTURE VAR dummy picture :: nilpicture;
+move (dummy picture,0.0,0.0);
+
+(***************************************************************************)
+(* Alte Prozeduren (Graphik-unabhaengig)                                   *)
+(***************************************************************************)
+
+PROC get (TEXT VAR text):    (* moeglichkeit, ueberall abzubrechen! *)
+  text := "";
+  TEXT VAR exit char;
+  editget (text,""27"","",exit char);
+  IF exit char = ""27""
+    THEN errorstop("Abgebrochen")
+  FI
+END PROC get;
+
+PROC get (INT VAR nr):
+  TEXT VAR t;
+  get(t);
+  line;
+  nr := int(t)
+END PROC get;
+
+PROC get (REAL VAR nr):
+  TEXT VAR t;
+  get(t);
+  line;
+  nr := real(t)
+END PROC get;
+
+PROC editget (TEXT VAR t):
+  TEXT VAR t2 :: t,exit char;
+  editget(t2,""27"","",exit char);
+  IF exit char = ""27""
+    THEN errorstop("Abgebrochen")
+  FI;
+  t := t2
+END PROC editget;
+
+PROC inchar (TEXT VAR a,TEXT CONST b):
+  REP
+    inchar (a)
+  UNTIL pos(b,a) <> 0 OR a = ""27"" PER;
+  IF a = ""27""
+    THEN errorstop("Abgebrochen")
+  FI
+END PROC inchar;
+
+BOOL OP ~ (REAL CONST left , right) :
+     abs (left - right) <= xstep
+END OP ~;
+
+(*******************     MAIN PROGRAMM        *****************************)
+
+PROC fkt plot:
+  auswahlbild;
+  select plotter(name(plotters,endgeraet));
+  REP
+    bild;
+    auswahl (inline)
+  UNTIL inline = "q" PER
+
+END PROC fkt plot;
+
+(******************        LAY OUT            *****************************)
+
+PROC auswahlbild:
+  page;
+  cursor (1,textpos);
+  put     ("(f)  Funktionsterm eingeben             ");
+  putline ("(?)  Hilfestellung                    ");
+  put     ("(d)  Definitionsbereich waehlen         ");
+  putline ("(q)  in die Kommandoebene zurueck     ");
+  put     ("(w)  Wertebereich ermitteln lassen      ");
+  putline ("(s)  Anzahl der Stuetzpunkte waehlen  ");
+  put     ("(z)  Zeichnung anfertigen               ");
+  putline ("(n)  Nachkommastellenzahl waehlen     ");
+  put     ("(a)  Ausgabe der Zeichnung auf Endgeraet");
+  putline ("(e)  Arbeit beenden                   ");
+  put     ("(t)  Wertetafel erstellen lassen        ");
+  putline ("(L)  Zeichnungen loeschen             "); 
+  put     ("(l)  Zeichnungen auflisten              ");
+  putline ("(A)  Zeichnungen archivieren          ");
+  put     ("                                        "); 
+  putline ("(b)  Zeichnung beschriften            ");
+  cursor (1,wahlpos);
+  put ("Ihre Wahl:")
+END PROC auswahlbild;
+
+PROC bild:
+  cursor (1,fkpos);
+  put ("f(x) = " + rohterm);
+  out (""5"");
+  cursor (1,inpos);
+  put ("Def.Bereich:  [              /               ]");
+  cursor (xupos,inpos);
+  put (text (x min,ziffern,nachkomma));
+  cursor (xopos,inpos);
+  put (text (x max,ziffern,nachkomma));
+  cursor (1,wpos);
+  put ("Wertebereich: [              /               ]");
+  cursor (yupos,wpos);
+  put (text (y min,ziffern,nachkomma));
+  cursor (yopos,wpos);
+  put (text (y max,ziffern,nachkomma));
+  cursor (1,endgeraetepos);
+  put endgeraetestring;
+  cursor (stuetzpktpos,inpos);
+  put ("Anzahl der Stuetzpunkte: " + text (stuetzen,3));
+  drei zeilen ab eingpos loeschen.
+END PROC bild;
+
+(******************       MONITOR             *****************************)
+
+PROC auswahl 1 (TEXT VAR wahl):
+  enable stop;
+  SELECT code (wahl) OF
+    CASE    8 : endgeraet := max(endgeraet-1,1);
+                select plotter(name(plotters,endgeraet))
+    CASE    2 : endgeraet := min(endgeraet+1,endgeraete);
+                select plotter(name(plotters,endgeraet))
+    CASE  102 : fkt lesen                 (*  f  *)
+    CASE  100 : defbereich waehlen        (*  d  *)
+    CASE  119 : wertebereich erstellen    (*  w  *)
+    CASE  116 : wertetafel erstellen      (*  t  *)
+    CASE  113 : LEAVE auswahl 1           (*  q  *)
+    CASE  122 : graph erstellen           (*  z  *)
+    CASE   97 : graph zeigen              (*  a  *)
+    CASE  110 : genauigkeitsangabe        (*  n  *)
+    CASE   65 : dm;                       (*  A  *)
+                auswahlbild
+    CASE  108 : dateien listen            (*  l  *)
+    CASE   76 : dateien aus task raeumen  (*  L  *)
+    CASE  101 : unterbrechung             (*  e  *)
+    CASE  126 : spezialeingabe            (* TIL *)
+    CASE   63 : hilfe                     (*  ?  *)
+    CASE  115 : stuetzpunkte setzen       (*  s  *)
+    CASE   98 : zeichnung beschriften     (*  b  *)
+  END SELECT;
+END PROC auswahl 1;
+
+PROC auswahl (TEXT VAR wahl):       (* Faengerebene *)
+  cursor (12,24);
+  out (""5"");
+  inchar (wahl,wahlstring);
+  fehlerloeschen;
+  disable stop;
+  auswahl 1 (wahl);
+  IF is error
+     THEN fehlersetzen (error message);
+          clear error
+  FI;
+  enable stop;
+  IF fehlerzustand
+     THEN fehleraus (fehlernachricht)
+  FI
+END PROC auswahl;
+
+PROC put endgeraetestring:
+  TEXT VAR s :: "Endgeraet: ";
+  INT VAR i;
+  THESAURUS CONST t :: plotters;
+  FOR i FROM 1 UPTO endgeraete REP
+    IF length(s)+length(name(t,i))+4 > 79
+      THEN putline(s+""5"");
+           s := "           "
+    FI;
+    IF i = endgeraet
+      THEN s CAT ""15"" + name(t,i) + " "14" "
+      ELSE s CAT " "+name(t,i) + "   "
+    FI
+  PER;
+  putline(s+""5"")
+
+END PROC put endgeraetestring;
+
+
+(**************************** f *******************************************)
+
+PROC fkt lesen:
+  reset wertebereich;
+  cursor (1,eingpos);
+  put ("f(x) =");
+  out (""5"");
+  cursor (1,eingpos + 1);
+  out(""5"");
+  cursor (8,eingpos);
+  editget (rohterm);
+  change int to real (rohterm,term);
+  change all (term,"X","x");
+  change all (term,"=","~");                         (* Ueberdeckung von = *)
+  change all (term,"<~","<=");                       (* ruecksetzen von <= *)
+  change all (term,">~",">=");                       (*       "         >= *)
+  term testen;
+  wertetafel vorhanden := FALSE.
+
+term testen:
+  disable stop;
+  proc := "REAL PROC f (REAL CONST x):";
+  proc CAT term;
+  proc CAT " END PROC f";
+  do ("do ("""+proc+""")");      (* komischer do-Fehler *)
+  IF is error
+     THEN fehlersetzen ("Term fehlerhaft");
+          clear error;
+          LEAVE fkt lesen
+  FI
+END PROC fkt lesen;
+
+(**************************** d *******************************************)
+
+PROC defbereich waehlen:
+  cursor (1,eingpos);
+  put ("Untergrenze  :");
+  out (""5"");
+  get (x min);
+  obergrenze lesen;
+  intervall definiert := TRUE;
+  reset wertebereich.
+
+obergrenze lesen:
+  REP
+    put ("Obergrenze   :");
+    out (""5"");
+    get (x max);
+    IF x max <= x min
+       THEN out (""7""13""3""5"")
+    FI
+  UNTIL x max > x min PER
+END PROC defbereich waehlen;
+
+(**************************** w *******************************************)
+
+PROC wertebereich erstellen:
+  IF rohterm = ""
+     THEN fehlersetzen ("Erst Fkts.Term eingeben! (f)");
+          LEAVE wertebereich erstellen
+  ELIF NOT intervall definiert
+     THEN fehlersetzen ("Erst Def.Bereich waehlen (d)");
+          LEAVE wertebereich erstellen
+  ELIF wertebereich bestimmt
+     THEN fehlersetzen ("Wertebereich ist bereits bestimmt");
+          LEAVE wertebereich erstellen
+  FI;
+  proc := "REAL PROC f (REAL CONST x):"+ term;
+  proc CAT " END PROC f; ygrenzen (PROC f)";
+  do (proc)
+END PROC wertebereich erstellen;
+
+PROC ygrenzen (REAL PROC (REAL CONST) f):
+  REAL VAR x, f von x;
+  INT  VAR i :: 1;
+  
+  disable stop;
+  xstep := (x max - x min) / real (stuetzen - 1);
+  x := x min;
+  y min :=  maxreal;
+  y max := -maxreal;
+  cursor (1,eingpos);
+  putline ("Wertebereich wird ermittelt");
+  out (""5"");
+  out ("bei Stuetzpunkt Nr.: ");
+  wertegrenzen berechnen;
+  IF is error
+     THEN fehler setzen (error message);
+          reset wertebereich;
+          LEAVE ygrenzen
+  ELIF fehlerzustand
+     THEN reset wertebereich;
+          LEAVE ygrenzen
+     ELSE wertebereich bestimmt := TRUE
+  FI;
+  IF y min = y max
+     THEN y min DECR 1.0;
+          y max INCR 1.0
+  FI.
+
+wertegrenzen berechnen:
+  FOR i FROM 1 UPTO stuetzen REP
+    x := real (i-1) * xstep + x min;
+    cout (i);
+    f von x := f (x);
+    graph [i] := f von x;
+    IF f von x <> luecke
+       THEN y min := min (y min, f von x);
+            y max := max (y max, f von x)
+    FI
+  UNTIL is error OR interrupt PER .
+
+interrupt:
+  IF incharety = ""27""
+     THEN fehlersetzen ("Abgebrochen");
+          TRUE
+     ELSE FALSE
+  FI
+END PROC ygrenzen;
+
+(**************************** t *******************************************)
+
+PROC wertetafel erstellen:
+  IF rohterm = ""
+     THEN fehleraus ("Erst Fkts.Term eingeben (f)");
+          LEAVE wertetafel erstellen
+  ELIF NOT intervall definiert
+     THEN fehleraus ("Erst Def.Bereich waehlen (d)");
+          LEAVE wertetafel erstellen
+  FI;
+  proc := "REAL PROC f (REAL CONST x):"+ term;
+  proc CAT " END PROC f; wertetafel (PROC f)";
+  do (proc)
+END PROC wertetafel erstellen;
+
+PROC wertetafel (REAL PROC (REAL CONST ) f):
+  FILE VAR g :: sequential file (output,rohterm);
+  REAL VAR x, f von x;
+  INT  VAR i :: 0;
+  
+  REP
+    schrittweite einlesen
+  UNTIL (xstep > 0.0) CAND ((x max-x min) / xstep < real (punkte)) PER;
+  x := x min;
+  evtl ueberschrift;
+  disable stop;
+  REP
+    datei erstellen
+  UNTIL x > x max OR is error PER;
+  fehleraus in tafel;
+  enable stop;
+  modify  (g);
+  edit (g);
+  line;
+  IF yes("Tafel drucken")
+     THEN print (rohterm)
+  FI;
+  line (2);
+  IF yes("Tafel loeschen")
+     THEN forget(rohterm,quiet);
+          wertetafel vorhanden := FALSE
+     ELSE wertetafel vorhanden := TRUE
+  FI;
+  auswahlbild.
+
+evtl ueberschrift:
+  IF NOT wertetafel vorhanden
+     THEN putline (g, "       W E R T E T A F E L");
+          line (g);
+          putline (g, "      x         !     " + rohterm);
+          putline (g, "----------------!----------------")
+  FI.
+
+fehleraus in tafel:
+  IF is error
+     THEN fehlernachricht := errormessage;
+          clearerror;
+          line (g,2);
+          putline (g,fehlernachricht);
+          fehlernachricht := ""
+  FI.
+
+datei erstellen:
+  i INCR 1;
+  cout (i);
+  put (g, text (x,ziffern,nachkomma));
+  put (g, "   !");
+  f von x := f (x);
+  IF f von x <> luecke
+    THEN put (g, text (f von x,ziffern,nachkomma))
+    ELSE put (g, "Definitionsluecke")
+  FI;
+  line (g);
+  x INCR xstep.
+
+schrittweite einlesen:
+  cursor (1,eingpos);
+  put ("Schrittweite:");
+  out (""5"");
+  cursor (1,eingpos + 1);
+  out (""5"");
+  cursor (15,eingpos);
+  get (xstep);
+  put ("Zwischenpunkt :");
+  IF (xstep <= 0.0) COR ((x max-x min) / xstep > real (punkte))
+     THEN fehleraus ("Schrittweite zu klein");
+          LEAVE wertetafel
+  FI
+END PROC wertetafel;
+
+(*********************************** n *************************************)
+
+PROC genauigkeitsangabe:
+  cursor (1,eingpos);
+  put ("Anzahl der Nachkommastellen : ");
+  get (nachkomma);
+  disable stop;
+  nachkomma := min (nachkomma, ziffern - 3);
+  nachkomma := max (nachkomma, 0);
+  IF is error
+     THEN fehlersetzen ("Falscher Wert");
+          clear error;
+          nachkomma := 2
+  FI
+END PROC genauigkeitsangabe;
+
+(********************************l ****************************************)
+
+PROC dateien listen:
+  th(all LIKE (prefix+"*"));
+  auswahlbild
+END PROC dateien listen;
+
+(********************************L ****************************************)
+
+PROC dateien aus task raeumen:
+  forget(some(all LIKE (prefix+"*")));
+  auswahlbild
+END PROC dateien aus task raeumen;
+
+(**************************** s *******************************************)
+
+PROC stuetzpunkte setzen:
+  cursor (1,eingpos);
+  put ("Anzahl der Stuetzpunkte :");
+  get (stuetzen);
+  disable stop;
+  IF stuetzen <= 1  OR stuetzen > punkte
+     THEN fehler setzen ("Achtung Stuetzpunkte fehlerhaft")
+  FI;
+  stuetzen := max (stuetzen, 2)  ;
+  stuetzen := min (stuetzen, punkte);
+  IF is error
+     THEN fehlersetzen ("Falscher Wert");
+          clear error;
+          stuetzen := punkte
+  FI;
+  reset wertebereich
+END PROC stuetzpunkte setzen;
+(**************************** e *******************************************)
+
+PROC unterbrechung:
+  break;
+  auswahlbild
+END PROC unterbrechung;
+
+(****************************** ? ******************************************)
+
+PROC hilfe:
+  IF NOT exists(helpfile)
+    THEN fetch(helpfile,task (graphikvater))
+  FI;
+  FILE VAR f :: sequential file(input,helpfile);
+  headline(f,"Verlassen mit <ESC> <q>");
+  open editor(f,FALSE);
+  edit (groesster editor,"q",PROC (TEXT CONST) dummy ed);
+  auswahlbild
+END PROC hilfe;
+
+PROC dummy ed (TEXT CONST t):
+  IF t = "q"
+    THEN quit
+    ELSE out(""7"")
+  FI
+END PROC dummy ed;
+
+(**************************** TILDE ****************************************)
+ 
+PROC spezialeingabe:
+  TEXT CONST termeingabename :: "Bitte Funktionsrumpf eingeben";
+  TEXT VAR t;
+  FILE VAR f :: sequential file (modify, termeingabename);
+ 
+  edit (f);
+  lese den term aus;
+  teste den term;
+  rohterm := "spezial";
+  reset wertebereich;
+  auswahlbild.
+
+lese den term aus:
+  term := "";
+  input (f);
+  WHILE NOT eof (f) REP
+    getline (f,t);
+    term CAT t;
+    term CAT " "
+  PER.
+
+teste den term:
+  disable stop;
+  proc := "REAL PROC f (REAL CONST x):";
+  proc CAT term;
+  proc CAT " END PROC f";
+  do (proc);
+  IF is error
+     THEN fehlersetzen ("Funktionsrumpf fehlerhaft");
+          clear error;
+          term := "";
+          rohterm := "";
+          reset wertebereich;
+          auswahlbild;
+          LEAVE spezialeingabe
+  FI
+END PROC spezialeingabe;
+
+(***************************************************************************)
+(*********                 Ab hier Hilfsprozeduren                 *********)
+(***************************************************************************)
+
+PROC fehleraus (TEXT CONST t):
+   cursor (1,fehlerpos);
+   out (""7"F E H L E R : ", t);
+   fehlerzustand := FALSE
+END PROC fehleraus;
+
+PROC fehlerloeschen:
+  cursor (1,fehlerpos);
+  out (""5"");
+  fehlernachricht := "";
+  fehlerzustand   := FALSE
+END PROC fehlerloeschen;
+
+PROC fehler setzen (TEXT CONST message):
+  fehlernachricht := message;
+  fehlerzustand   := TRUE;
+  clear error
+END PROC fehler setzen;
+
+REAL PROC gauss (REAL CONST z):
+  IF is integer (z)
+     THEN round (z,0)
+  ELIF sign (z) = -1
+     THEN floor (z) - 1.0
+     ELSE floor (z)
+  FI
+END PROC gauss;
+
+BOOL PROC is integer (REAL CONST x):
+  abs (x - floor (x)) < epsilon
+END PROC is integer;
+
+PROC berechnung (REAL CONST min, max,
+                 REAL VAR   sweite,
+                 INT VAR    styp):
+
+  sweite := faktor * round (10.0 ** expo,11).
+
+faktor: 
+  IF nachkomma < ug1
+       THEN styp := 1;
+            1.0
+  ELIF nachkomma < ug2
+       THEN  styp := 2;
+             2.0
+  ELIF nachkomma < ug3
+       THEN styp := 5;
+            5.0
+       ELSE styp := 1;
+            10.0
+  FI.
+
+nachkomma:
+  IF frac (logwert) < -epsilon
+     THEN 1.0 + frac (logwert)
+  ELIF frac (logwert) > epsilon
+     THEN frac (logwert)
+     ELSE 0.0
+  FI.
+
+differenz:
+  max - min.
+
+expo:
+  gauss (logwert) - 1.0.
+
+logwert:
+  round (log10 (differenz),8)
+END PROC berechnung;
+
+REAL PROC runde ab (REAL CONST was, auf):
+  auf * gauss (was / auf)
+END PROC runde ab;
+
+REAL PROC runde auf (REAL CONST was, auf):
+  REAL VAR hilf :: runde ab (was,auf);
+ 
+  IF abs (hilf - was) < epsilon
+     THEN was
+     ELSE hilf + auf 
+  FI
+END PROC runde auf;
+
+PROC loesche zeile (INT CONST zeile):
+  cursor (1,zeile);
+  out (""5"")
+END PROC loesche zeile;
+
+PROC drei zeilen ab eingpos loeschen:
+  loesche zeile (eingpos);
+  loesche zeile (eingpos + 1);
+  loesche zeile (eingpos + 2);
+END PROC drei zeilen ab eingpos loeschen;
+
+PROC change int to real (TEXT CONST term alt,TEXT VAR term neu):
+  TEXT VAR symbol :: "", presymbol :: "";
+  INT  VAR type :: 0, pretype :: 0, position;
+  LET number      = 3,
+      tag         = 1,
+      end of scan = 7,
+      pot         = "**";
+
+  term neu := "";
+  scan (term alt);
+  WHILE type <> end of scan REP
+    presymbol :=  symbol;
+    pretype   :=  type;
+    next symbol (symbol,type);
+    IF type <> number OR presymbol = pot
+       THEN term neu CAT evtl mal und symbol
+       ELSE term neu CAT changed symbol
+    FI
+  PER.
+
+evtl mal und symbol:
+  IF pretype = number AND type = tag
+     THEN "*" + symbol
+     ELSE symbol
+  FI.
+
+changed symbol:
+  position := pos (symbol,"e"); 
+  IF position <> 0 
+     THEN text (symbol,position - 1) + ".0" +
+          subtext (symbol,position,length (symbol)) 
+  ELIF pos (symbol,".") = 0
+     THEN symbol CAT ".0";
+          symbol
+     ELSE symbol
+  FI
+END PROC change int to real;
+
+PROC reset wertebereich:
+  y min := -maxreal;
+  y max :=  maxreal;
+  wertebereich bestimmt := FALSE
+END PROC reset wertebereich;
+
+TEXT PROC textreal (REAL CONST z):
+  TEXT VAR t :: text (z);
+
+  IF (t SUB length (t)) = "."
+     THEN subtext (t,1,length (t) - 1)
+  ELIF (t SUB 1) = "." 
+     THEN "0" + t
+  ELIF (t SUB 2) = "." AND sign (z) = -1
+     THEN "-0" + subtext (t,2)
+  ELIF t = "0.0" 
+     THEN "0"
+     ELSE t
+  FI
+END PROC textreal;
+
+INT PROC length (REAL CONST z):
+  length (text (z))
+END PROC length;
+
+PROC put format(INT CONST wo, REAL CONST xxmi,xxma,yymi,yyma):
+  cursor (1,wo);
+  put ("Aktuelles Format:       xmin           xmax" +
+       "           ymin           ymax");
+  cursor (19,wo + 1);
+  put (text (xx mi,ziffern,nachkomma));
+  cursor (34,wo + 1);
+  put (text (xx ma,ziffern,nachkomma));
+  cursor (49,wo + 1);
+  put (text (yy mi,ziffern,nachkomma));
+  cursor (64,wo + 1);
+  put (text (yy ma,ziffern,nachkomma))
+END PROC put format;
+ 
+PROC out (TEXT CONST a, b) :
+  out (a); out (b)
+END PROC out;
+
+(***************************************************************************)
+(* Neue Prozeduren                                                         *)
+(***************************************************************************)
+
+PROC graph erstellen:
+  PICFILE VAR funktionen;
+  PICTURE VAR funktionsgraph :: nilpicture,
+              formatpic      :: nilpicture;
+  REAL VAR xx min :: x min,
+           xx max :: x max,
+           yy min :: y min,
+           yy max :: y max;
+
+  IF rohterm = ""
+     THEN fehlersetzen ("Erst Funktionsterm waehlen (f)");
+          LEAVE graph erstellen
+  ELIF NOT wertebereich bestimmt
+     THEN fehlersetzen ("Erst Wertebereich bestimmen lassen (w)");
+          LEAVE graph erstellen
+  FI;
+
+  hole filenamen;
+  funktionen := picture file (picfilename);
+  initialisiere stifte;
+  waehle format;
+  zeichne graphen;
+  pictures ins picfile.
+
+hole filenamen:
+  TEXT VAR t :: "";
+  REP 
+    namen lesen
+  UNTIL t = "l" OR t = "e" PER. 
+
+namen lesen:
+  cursor (1,eingpos);
+  out ("Welchen Namen soll die Zeichnung haben: "+ prefix);
+  postfix:= rohterm;
+  editget (postfix);
+  line;
+  IF (postfix SUB 1) = "?"
+    THEN picfilename := one(all LIKE (prefix+"*"));
+         auswahlbild;
+         bild;
+         cursor(1,eingpos)
+    ELSE picfilename := prefix + postfix;
+         picfilename := compress (picfilename)
+  FI;
+  IF NOT exists (picfilename)
+    THEN LEAVE hole filenamen
+  FI;
+  putline ("Zeichnung gibt es schon!");
+  put ("loeschen (l), Namen neuwaehlen (n), " +
+       "alte Zeichnung ergaenzen (e):");
+  inchar (t,"lne");
+  IF t = "l"
+     THEN forget (picfilename,quiet)
+  ELIF t = "n"
+     THEN drei zeilen ab eingpos loeschen
+  FI.
+
+initialisiere stifte:
+  select pen (funktionen, 1, 1, 0, 1, TRUE); (* Standardfarbe *)
+  select pen (funktionen, 2, 2, 0, 1, TRUE); (* Rot           *)
+  select pen (funktionen, 3, 3, 0, 1, TRUE); (* Blau          *)
+  select pen (funktionen, 4, 4, 0, 1, TRUE); (* Gruen         *)
+  select pen (funktionen, 5, 5, 0, 1, TRUE). (* Schwarz       *)
+
+waehle format:
+  IF altes picfile
+    THEN ergaenze wertebereich
+  FI;
+  drei zeilen ab eingpos loeschen;
+  REAL VAR step;
+  INT VAR i dummy;
+  berechnung (yy min, yy max, step, idummy);
+  yy min := runde ab (yy min, step);
+  yy max := runde auf (yy max, step);
+  put format(eingpos, xx min, xx max, yy min, yy max);
+  pause ;
+  drei zeilen ab eingpos loeschen;
+  cursor(1,eingpos);
+  IF yes("Format aendern")
+    THEN interactive change of format (xx min,xx max,yy min,yy max)
+  FI;
+  drei zeilen ab eingpos loeschen.
+
+ergaenze wertebereich:
+  to pic (funktionen,3);             (* Formatpicture *)
+  read picture (funktionen,formatpic);
+  move (formatpic, xx min, yy min);
+  move (formatpic, xx max, yy max);
+  extrema (formatpic, xx min, xx max, yy min, yy max).
+
+altes picfile:
+  t = "e".
+
+zeichne graphen:
+  REAL VAR x              :: x min,
+           x schrittweite :: (x max - x min) / real (stuetzen - 1);
+  INT  VAR i;
+
+  cursor (1,eingpos);
+  put ("Graph bei Stuetzpunkt Nr. ");
+  FOR i FROM 1 UPTO stuetzen REP
+     cout (i);
+     IF graph[i] <> luecke
+       THEN IF zuletzt luecke
+              THEN move (funktionsgraph, x, graph[i])
+              ELSE draw (funktionsgraph, x, graph[i])
+            FI
+     FI;
+     x INCR x schrittweite
+  UNTIL abbruch PER;
+  drei zeilen ab eingpos loeschen.
+
+  abbruch:
+    IF incharety = ""27""
+      THEN errorstop("Abgebrochen");
+           TRUE
+      ELSE FALSE
+    FI.
+
+  zuletzt luecke:
+   i = 1 COR graph[i-1] = luecke.
+
+pictures ins picfile:
+  setze graphenfarbe;
+  to first pic(funktionen);
+  IF altes picfile
+    THEN down (funktionen);        (* Skip *)
+         down (funktionen)
+    ELSE put picture (funktionen, dummy picture); (* Zusaetzliche Beschr.*)
+         put picture (funktionen, dummy picture)
+  FI;
+  formatpic := nilpicture;
+  move (formatpic, xx min, yy min);
+  move (formatpic, xx max, yy max);
+  IF altes picfile
+    THEN write picture (funktionen, formatpic)
+    ELSE put picture (funktionen, formatpic)
+  FI;
+  put picture (funktionen, funktionsgraph).
+
+setze graphenfarbe:
+  cursor (1,eingpos);
+  put("Farbe des Graphen :");
+  pen (funktionsgraph, farbe).
+
+farbe :
+  TEXT VAR ff;
+  put(farbstr);
+  inchar (ff,farbchars);
+  out(ff);
+  pos (farbchars,ff).
+
+END PROC graph erstellen;
+
+PROC interactive change of format (REAL VAR x mi,x ma,y mi,y ma):
+  TEXT VAR tt;
+  REP
+    cursor (1,eingpos + 2);
+    put ("Geben Sie die neuen Koordinaten ein");
+    out (""5"");
+    pause (20);
+    loesche zeile (eingpos + 2);
+    cursor (1,eingpos + 2);
+    put ("xmin:");
+    tt := text (xmi);
+    editget (tt); 
+    xmi := real (tt);
+    cursor (1,eingpos + 2);
+    put ("xmax:"); 
+    out (""5"");
+    tt := text (xma);
+    editget (tt);
+    xma := real (tt);
+    cursor (1,eingpos + 2);
+    put ("ymin:");
+    out (""5"");
+    tt := text (ymi);
+    editget (tt);
+    ymi := real (tt);
+    cursor (1,eingpos + 2);
+    put ("ymax:");
+    out (""5"");
+    tt := text (yma);
+    editget (tt);
+    yma := real (tt);
+  UNTIL format ok PER.
+
+  format ok:
+    IF xma <= xmi OR yma <= ymi
+      THEN fehlersetzen ("Format falsch");
+           FALSE
+      ELSE TRUE
+    FI
+END PROC interactive change of format;
+
+PROC geraet waehlen:
+END PROC geraet waehlen;
+
+PROC zeichnung beschriften:
+  namen holen;
+  PICFILE VAR funktionen :: picture file(picfilename);
+  PICTURE VAR beschr;
+  to pic(funktionen,2);
+  read picture(funktionen,beschr);
+  cursor(1,eingpos);
+  put("Beschriftung (e) rgaenzen , (l) oeschen oder (a) bbruch");
+  TEXT VAR t;
+  inchar(t,"ela");
+  IF t = "l"
+    THEN to pic(funktionen,2);
+         beschr := nilpicture;
+         write picture(funktionen,beschr)
+  ELIF t = "e"
+    THEN beschrifte
+  FI;
+  cursor(1,eingpos);
+  drei zeilen ab eingpos loeschen.
+
+  beschrifte:
+    farbe holen;
+    REAL VAR rx,ry,hx,bx;
+    to pic(funktionen,3);
+    PICTURE VAR format;
+    read picture(funktionen,format);
+    extrema(format,rx,ry,hx,bx);
+    drei zeilen ab eingpos loeschen;
+    put format (eingpos,rx,ry,hx,bx);
+    pause;
+    REP
+      drei zeilen ab eingpos loeschen;
+      cursor(1,eingpos);
+      put("Text :");
+      TEXT VAR btext;
+      getline(btext);
+      put("Koordinaten in (c)m oder in (r)eal ");
+      inchar(t,"cra");
+      drei zeilen ab eingpos loeschen;
+      cursor(1,eingpos);
+      put("X-Koordinate:");
+      get(rx);
+      put("Y-Koordinate:");
+      get(ry);
+      IF t = "c"
+        THEN move cm(beschr,rx,ry)
+        ELSE move   (beschr,rx,ry)
+      FI;
+      drei zeilen ab eingpos loeschen;
+      cursor(1,eingpos);
+      put("Hoehe der Zeichen in mm :");
+      get(hx);
+      put("Breite der Zeichen in mm:");
+      get(bx);
+      draw(beschr,btext,0.0,hx,bx);
+      drei zeilen ab eingpos loeschen;
+      cursor(1,eingpos)
+    UNTIL no("Weitere Beschriftungen") PER;
+    to pic(funktionen,2);
+    write picture(funktionen,beschr).
+
+  farbe holen:
+    drei zeilen ab eingpos loeschen;
+    cursor(1,eingpos);
+    put("Farbe der Beschriftungen: ");
+    TEXT VAR ff;
+    put(farbstr);
+    inchar (ff,farbchars);
+    out(ff);
+    pen(beschr,pos (farbchars,ff)).
+
+  namen holen:
+    cursor(1,eingpos);
+    put("Wie heisst die Zeichnung:");
+    out(prefix);
+    editget(postfix);
+    picfilename := prefix + postfix;
+    IF (postfix SUB 1) = "?"
+      THEN picfilename := one(all LIKE (prefix + "*"));
+           auswahlbild;
+           bild
+    FI;
+    IF NOT exists(picfilename)
+      THEN fehlersetzen("Zeichnung gibt es nicht");
+           LEAVE zeichnung beschriften
+    FI
+
+END PROC zeichnung beschriften;
+
+PROC graph zeigen:
+  REAL VAR xx max,xx min,yy max,yy min;
+
+  cursor (1,eingpos);
+  put ("Wie heisst die Zeichnung :");
+  out(prefix);
+  editget(postfix);
+  picfilename := prefix+postfix;
+  IF (postfix SUB 1) = "?"
+    THEN picfilename := one(all LIKE (prefix+"*"));
+         postfix := subtext(picfilename,length(prefix)+1);
+         auswahlbild;
+         bild
+  ELIF NOT exists (picfilename)
+    THEN fehlersetzen ("Zeichnung gibt es nicht");
+         LEAVE graph zeigen
+  FI;
+  drei zeilen ab eingpos loeschen;
+  PICFILE VAR funktionen :: picture file (picfilename);
+  PICTURE VAR rahmen :: nilpicture;
+  hole ausschnitt;
+  hole headline;
+  erzeuge rahmen;
+  gib bild aus.
+
+  gib bild aus:
+    REAL VAR x cm,y cm; INT VAR i,j;
+    drawing area (x cm,y cm,i,j);
+    viewport (funktionen, 0.0, x cm/y cm, 0.0, 1.0);
+    erweitere bereich;  (* Rundungsfehler beim clippen vermeiden !!! *)
+    window (funktionen, xx min, xx max, yy min, yy max);
+    plot (picfilename);
+    auswahlbild.
+
+  erweitere bereich:
+    xx max := xx max + (xx max - xx min) / real(i).
+
+ erzeuge rahmen:
+   to pic (funktionen,1);
+   waehle achsenart;
+   IF achsenart = "r"
+     THEN rahmen := frame (xx min,xx max,yy min,yy max)
+     ELSE rahmen := axis  (xx min,xx max,yy min,yy max)
+   FI;
+   rahmen CAT beschriftung (xx min,xx max,yy min,yy max,headline,
+                            achsenart = "r");
+   cursor (1,eingpos);
+   put ("Farbe des");
+   IF achsenart = "k"
+     THEN put("Koordinatensystems :")
+     ELSE put("Rahmens :")
+   FI;
+   pen (rahmen,farbe);
+   drei zeilen ab eingpos loeschen;
+   write picture (funktionen,rahmen).
+
+  farbe :
+    TEXT VAR ff;
+    put(farbstr);
+    inchar (ff,farbchars);
+    out(ff);
+    pos (farbchars,ff).
+
+  waehle achsenart:
+    TEXT VAR achsenart :: "r";
+    IF koord moeglich
+      THEN frage nach achsenart
+    FI.
+
+  frage nach achsenart:
+    cursor (1,eingpos);
+    put("<k>oordinatensystem oder <r>ahmen zeichnen ?");
+    inchar (achsenart,"kr");
+    putline(achsenart);
+    drei zeilen ab eingpos loeschen.
+
+  koord moeglich:
+    NOT (xmin >= 0.0 OR xx max <= 0.0 OR yy min >= 0.0 OR yy max <= 0.0).
+
+  hole ausschnitt:
+    PICTURE VAR format;
+    to pic (funktionen,3);
+    read picture (funktionen,format);
+    extrema (format, xx min, xx max, yy min, yy max);
+    cursor (1,eingpos);
+    put format (eingpos, xx min, xx max, yy min, yy max);
+    pause;
+    drei zeilen ab eingpos loeschen;
+    cursor (1,eingpos);
+    IF yes ("Wollen Sie den Ausschnitt veraendern")
+      THEN interactive change of format (xx min,xx max,yy min,yy max)
+    FI;
+    drei zeilen ab eingpos loeschen.
+
+  hole headline:
+    cursor (1,eingpos);
+    TEXT VAR headline :: rohterm;
+    put ("Ueberschrift :");
+    editget (headline);
+    drei zeilen ab eingpos loeschen
+END PROC graph zeigen;
+
+PICTURE PROC frame (REAL CONST xx min,xx max,yy min,yy max):
+
+   PICTURE VAR rahmen :: nilpicture;
+   zeichne achsen;
+   zeichne restrahmen;
+   rahmen.
+
+  zeichne restrahmen:
+   move (rahmen,xx min,yy max);
+   draw (rahmen,xx max,yy max);
+   draw (rahmen,xx max,yy min).
+
+  zeichne achsen:
+    rahmen := axis (xx min,xx max,yy min,(yy max - yy min) / 90.0,0,0);
+    rahmen CAT axis (yy min,yy max,xx min,(xx max - xx min) / 90.0,1,0)
+
+END PROC frame;
+
+PICTURE PROC axis (REAL VAR xx min,xx max,yy min,yy max):
+  PICTURE VAR rahmen :: nilpicture;
+  rahmen := axis (xx min,xx max,0.0,(yy max - yy min) / 180.0,0,1);
+  rahmen CAT axis (yy min,yy max,0.0,(xx max - xx min) / 180.0,1,1);
+  rahmen
+END PROC axis;
+
+PICTURE PROC axis (REAL CONST min, max, pos,strich,
+                   INT CONST  dir,mode):
+  PICTURE VAR achse ::  nilpicture;
+  REAL VAR step,
+           feinstep,
+           wert;
+  INT VAR type;
+  berechnung (min,max,step,type);
+  feinstep := step / real(zwischenstriche);
+  IF min MOD feinstep <> 0.0
+    THEN wert := runde auf (min,feinstep);
+    ELSE wert := min
+  FI;
+  INT VAR zaehler :: int( wert MOD step / feinstep + 0.5);
+  WHILE wert <= max REP
+    IF wert = 0.0
+      THEN ziehe nullstrich
+    ELIF zaehler MOD zwischenstriche = 0
+      THEN ziehe normstrich
+      ELSE ziehe feinstrich
+    FI;
+    wert INCR feinstep;
+    zaehler INCR 1
+  PER;
+  zeichne achse;
+  achse.
+
+  zwischenstriche:
+    IF type = 2
+      THEN 4
+      ELSE 5
+    FI.
+
+  ziehe nullstrich:
+    REAL VAR p0 :: pos + real (mode) * strich * 3.0,
+             p1 :: pos - strich * 3.0;
+    ziehe linie.
+
+  ziehe normstrich:
+    p0 := pos + real (mode) * strich * 2.0;
+    p1 := pos - strich * 2.0;
+    ziehe linie.
+
+  ziehe feinstrich:
+    p0 := pos + real (mode) * strich;
+    p1 := pos - strich;
+    ziehe linie.
+
+  zeichne achse:
+    IF dir = 0
+      THEN move (achse,min,pos);
+           draw (achse,max,pos)
+      ELSE move (achse,pos,min);
+           draw (achse,pos,max)
+    FI.
+
+  ziehe linie:
+    IF dir = 0
+      THEN move (achse,wert,p0);
+           draw (achse,wert,p1)
+      ELSE move (achse,p0,wert);
+           draw (achse,p1,wert)
+    FI
+END PROC axis;
+
+PICTURE PROC beschriftung (REAL VAR xx min,xx max,yy min,yy max,
+                           TEXT CONST ueberschrift,
+                           BOOL CONST mode):
+ PICTURE VAR rahmen :: nilpicture;
+ beschrifte;
+ rahmen.
+
+ beschrifte :
+    REAL VAR x cm,y cm;
+    INT VAR dummy;
+    drawing area (x cm,y cm,dummy,dummy);
+    erweitere;
+    zeichne x achse;
+    zeichne y achse;
+    zeichne ueberschrift;
+    xx max := xn max;
+    xx min := xn min;
+    yy max := yn max;
+    yy min := yn min.
+
+  erweitere:
+    REAL VAR hoehe  :: din a4 hoehe  / 23.5 * y cm,   { der Zeichen }
+             breite :: din a4 breite / 30.5 * x cm;
+    INT CONST anzahl y stellen :: max (stellen (yy min),stellen (yy max)),
+              anzahl x stellen :: max (stellen (xx min),stellen (xx max));
+    REAL VAR xn min :: xx min,
+             xn max :: xx max,
+             yn min :: yy min;
+    IF mode                                      { rahmen wg clipping }
+      THEN xn min DECR (xx max - xx min) / 30.0;
+           yn min DECR (yy max - yy min) / 30.0
+    FI;
+    REAL VAR xx dif :: xx max - xn min,
+             yy dif :: yy max - yn min,
+             yn dif :: y cm / (y cm - 2.0 * hoehe / 10.0 - 0.4) * yy dif,
+             xn dif :: x cm / (x cm - x erweiterung) * xx dif,
+             y 1 mm :: yn dif / y cm / 10.0,
+             r hoch :: hoehe / y cm / 10.0 * yn dif,
+             r breit:: breite / x cm / 10.0 * xn dif,
+             yn max :: yy max + r hoch + 3.0 * y 1 mm;
+    yn min := yn min - r hoch - 2.0 * y 1 mm;
+    IF mode
+      THEN xn min := xn min - real(anzahl y stellen) * r breit
+    FI.
+
+    x erweiterung:
+      IF mode
+        THEN real(anzahl y stellen) * breite / 10.0
+        ELSE 0.0
+      FI.
+
+    zeichne x achse:
+      TEXT VAR zahl :: text (xx min, anzahl x stellen, nachkomma);
+      ersetze zahl;
+      move (rahmen, max(xn min, xx min - real(length(zahl)) * r breit / 2.0),
+                    yn min);
+      draw (rahmen, zahl, 0.0, breite, hoehe);
+      zahl := text (xx max, anzahl x stellen, nachkomma);
+      ersetze zahl;
+      move (rahmen, xx max - real(length(zahl)) * r breit, yn min);
+      draw (rahmen, zahl, 0.0, breite, hoehe).
+
+    zeichne y achse:
+      zahl := text (yy min, anzahl y stellen, nachkomma);
+      ersetze zahl;
+      move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit -
+                         (xx max - xx min) / 30.0),yy min - r hoch / 2.0);
+      draw (rahmen, zahl, 0.0, breite, hoehe);
+      zahl := text (yy max,anzahl y stellen,nachkomma);
+      ersetze zahl;
+      move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit -
+                          (xx max - xx min) / 30.0),yy max - r hoch / 2.0);
+      draw (rahmen, zahl, 0.0, breite, hoehe).
+
+    zeichne ueberschrift:
+      move (rahmen, (xx max + xx min - real(length(ueberschrift)) * r breit)
+                    / 2.0, yy max + y 1 mm);
+      draw (rahmen, ueberschrift, 0.0, breite, hoehe).
+
+    ersetze zahl:
+      change all (zahl, ".", ",")
+
+END PROC beschriftung;
+
+INT PROC stellen (REAL CONST r):
+  IF r = 0.0
+    THEN nachkomma + 2
+    ELSE nachkomma + 3 + max (0, int ( round(log10 (abs(r)),nachkomma)))
+  FI
+END PROC stellen
+
+END PACKET funktionen;
+
+PACKET fkt manager DEFINES fkt manager:
+ 
+LET continue code = 100, 
+    ack           = 0,
+    nack          = 1; 
+ 
+DATASPACE VAR dummy space;
+INT VAR order;
+TASK VAR order task;
+
+PROC fkt manager:
+   set autonom;
+   disable stop;
+   break (quiet);
+   REP
+      forget (dummy space);
+      wait (dummy space, order, order task);
+      IF order >= continue code AND order task = supervisor
+         THEN call (supervisor, order, dummy space, order);
+              IF order = ack
+                 THEN fkt online
+              FI;
+              set autonom;
+              command dialogue (FALSE);
+              forget (ALL myself)
+         ELSE send (order task, nack, dummy space)
+      FI
+   PER.
+
+   fkt online:
+      command dialogue (TRUE);
+      fktplot;
+      IF online
+         THEN eumel must advertise;
+              break (quiet)
+      FI
+END PROC fktmanager
+
+END PACKET fktmanager
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Install b/app/mpg/2.2/src/GRAPHIK.Install
new file mode 100644
index 0000000..acd1d38
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Install
@@ -0,0 +1,84 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.1 vom 10.09.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*          "Graphik-Installation" geschrieben von C.Weinholz             *) 
+(*                                                                        *) 
+(**************************************************************************) 
+(*                                                                        *) 
+(*            Dieses Programm wird in eine neueingerichtete Task          *) 
+(*             GRAPHIK vom Archiv geladen, und sorgt nach 'run'           *) 
+(*          fuer die volstaendige Installation des Graphik-Systems        *) 
+(*                                                                        *) 
+(**************************************************************************) 
+(*   Urversion  : 10.09.87                                                *) 
+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 
+(*                global manager aequivalent ersetzt                      *) 
+(*                'family password' wird nun erfragt und gesetzt          *) 
+(*                                                                        *) 
+(**************************************************************************) 
+LET packet 1  = "GRAPHIK.Basis",
+    packet 2  = "GRAPHIK.Plot",
+    config    = "GRAPHIK.Configurator",
+    install   = "GRAPHIK.Configuration",
+    fkt       = "GRAPHIK.Fkt",
+    fkthelp   = "FKT.help",
+    turtle    = "GRAPHIK.Turtle";
+
+FILE VAR f; 
+TEXT VAR l; 
+INT VAR x;
+ 
+check off;
+warnings off;
+archiv;
+fetch (ALLarchive- all,archive);
+BOOL VAR new conf :: NOT exists (install);
+IF new conf
+   THEN mess ("GRAPHIK muss neu konfiguriert werden")
+   ELSE new conf := yes ("GRAPHIK neu konfigurieren")
+FI; 
+release;
+ins (packet 1);
+IF new conf
+   THEN run (config) 
+   ELSE ins (install) 
+FI;
+ins (packet 2);
+ins (fkt);
+ins (turtle);
+do ("generate plot manager");
+mess (""15"  Fertig  "14""); 
+IF yes ("Alles loeschen")
+   THEN command dialogue (FALSE);
+        forget (all-fkthelp); 
+        command dialogue (TRUE)
+FI; 
+TEXT VAR geheim;
+put ("GRAPHIK-Password: ");
+get secret line (geheim);
+family password (geheim);
+global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager); 
+ 
+PROC ins (TEXT CONST name): 
+   page; 
+   f := sequential file (input, name); 
+   FOR x FROM 1 UPTO 11 REP 
+       getline (f,l); 
+       putline (l);
+   PER; 
+   mess ("""" + name + """ wird insertiert"13""10""); 
+   insert (name) 
+END PROC ins; 
+ 
+PROC mess (TEXT CONST msg): 
+   line; 
+   putline (msg); 
+END PROC mess;
+
+
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Manager b/app/mpg/2.2/src/GRAPHIK.Manager
new file mode 100644
index 0000000..df9df6b
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Manager
@@ -0,0 +1,925 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.2 vom 23.09.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*           "Graphik-Plotmanager" geschrieben von C.Weinholz             *) 
+(*                                                                        *) 
+(**************************************************************************) 
+(*                                                                        *)
+(*            Dieses Paket stellt den Multispool-Ausgabemanager           *)
+(*                            zur Verfuegung.                             *)
+(*                 Er wird in der Regel durch Aufruf von                  *)
+(*        'generate plot manager' in GRAPHIK in einer neuerzeugten        *)
+(*                      Sohntask 'PLOT' installiert.                      *)
+(*                                                                        *)
+(**************************************************************************)
+(*   Urversion  : 10.09.87                                                *)
+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *)
+(*                Kommando 'spool control ("TEXT")' im Plot-Monitor       *)
+(*                Anzeige von 'order tasks' anderer Stationen             *)
+(*                11.1.88, Thomas Clermont                                *)
+(*                Fehler 'Zu viele DATASPACEs' und                        *)
+(*                Spooling von zwei gleichnamigen JOBs behoben.           *)
+(*   Fehler     : Keine bekannt.                                          *)
+(**************************************************************************)
+PACKET plot manager DEFINES plot manager ,
+                            plot server  :
+
+LET max spools  = 14,         (* Hinweis: max spools + dataspaces +      *)
+    max entries = 14,         (*          max spools * max entries < 250 *)
+ 
+    ack                 = 0,
+    second phase ack    = 5,
+    false code          = 6,
+    fetch code          = 11,
+    save  code          = 12,
+    existscode          = 13,
+    erase code          = 14,
+    list  code          = 15,
+    all   code          = 17,
+    first code          = 25,
+    start code          = 26,
+    stop  code          = 27,
+    halt code           = 28,
+    wait for halt  code = 29,
+    continue code       = 100,
+    picfiletype = 1102,
+
+    trenn       = "/",
+
+    MSG         = STRUCT (TEXT ds name, dev name, passwd, INT dev no),
+
+    JOB         = STRUCT (DATASPACE ds, TEXT ds name, TASK order task),
+ 
+    ENTRY       = STRUCT (JOB job, INT link), 
+ 
+    CHAIN       = STRUCT (ROW max entries ENTRY entry, INT first, last, empty), 
+ 
+    SERVER      = STRUCT (TASK task, wait for halt, REAL time,
+                          JOB current job, BOOL stopped, INT link);
+ 
+ROW max spools STRUCT (SERVER server, CHAIN chain) VAR device; 
+
+MSG VAR msg;
+
+INT VAR entry to erase, last created server, reply, current plotter;
+FILE VAR chain info;
+THESAURUS VAR managed plotter;
+BOUND THESAURUS VAR thesaurus msg;
+DATASPACE VAR reply ds;
+TASK VAR control task;
+
+(********************************* SPOOL ***********************************)
+
+PROC plot manager :
+   INT VAR act dev;
+   managed plotter := plotters LIKE (text (station (myself)) + any);
+   FOR act dev FROM 1 UPTO max devices REP
+      init device (act dev)
+   PER;
+   control task := niltask;
+   end global manager (FALSE);
+   global manager (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST)plot manager)
+END PROC plot manager;
+
+PROC plot manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task):
+   enable stop;
+   INT VAR act dev;
+   SELECT order OF 
+     CASE fetch code : y fetch 
+     CASE save code  : y save 
+     CASE exists code: y exists
+     CASE erase code : y erase 
+     CASE list code  : y list 
+     CASE all code   : y all 
+     OTHERWISE IF order >= continue code AND order task = supervisor
+                  THEN forget (ds);
+                       continue (order - continue code);
+                       spool monitor
+                  ELIF priv control op
+                       THEN SELECT order OF
+                              CASE first code : y first
+                              CASE start code : y start
+                              CASE stop code  : y stop
+                              CASE halt code  : y halt
+                              CASE wait for halt code : y halt
+                              OTHERWISE order error
+                            ENDSELECT
+                       ELSE order error
+               FI;
+   END SELECT;
+   BOOL VAR test;
+   FOR act dev FROM 1 UPTO max devices REP
+      test := server is active (act dev)
+   PER;
+   forget (ds).
+
+   priv control op:
+      (order task = father) OR (order task < supervisor) OR
+      spool control task.
+
+  spool control task:
+     NOT (order task = niltask) CAND
+     ((order task = control task) OR (order task < control task)).
+
+  y fetch: 
+     FOR act dev FROM 1 UPTO max devices REP 
+     UNTIL act server.task = order task  PER;
+     IF act dev > max devices
+        THEN order error 
+     ELIF chain is empty (act dev) OR act server.stopped
+        THEN end server (act dev);
+             IF exists (act server.wait for halt)
+                THEN send (act server.wait for halt, ack);
+                     act server.wait for halt := niltask
+             FI
+        ELSE transfer next job (act dev); 
+             send current job (act dev) 
+     FI.
+
+  y save: 
+     IF phase = 1 
+        THEN y save pre 
+        ELSE y save post 
+     FI. 
+ 
+     y save pre: 
+        link dev;
+        IF act dev = 0 
+           THEN device error
+        ELIF chain is full (act dev)
+           THEN errorstop ("SPOOL ist voll")
+           ELSE send (order task, second phase ack) 
+        FI. 
+ 
+     y save post: 
+        act dev := msg.dev no;
+        IF type (ds) <> picfile type 
+           THEN errorstop ("Datenraum hat falschen Typ") 
+           ELSE entry into chain (act dev, new job);
+                forget (ds);
+                IF NOT (server is active (act dev) OR act server.stopped)
+                   THEN create server (act dev)
+                FI;
+                send ack
+        FI.
+ 
+        new job: 
+           JOB : (ds, msg.ds name, order task).
+ 
+  y exists:
+     link dev;
+     IF find entry (msg.ds name,act dev,order task, priv control op) = 0
+        THEN send (order task, false code, ds)
+        ELSE send ack
+     FI.
+
+  y erase:
+     IF phase = 1
+        THEN link dev;
+             IF act dev > 0
+                THEN y erase pre
+                ELSE device error
+             FI
+        ELSE erase entry (act dev, entry to erase);
+             send ack
+     FI.
+
+     y erase pre: 
+        entry to erase := find entry (msg.ds name,act dev, order task, priv control op);
+        IF order not from job order task AND NOT priv control op
+           THEN errorstop ("Kein Zugriffsrecht auf Auftrag """ + msg.ds name + """")
+        ELIF entry to erase = 0
+           THEN manager message ("""" + msg.ds name + """ existiert nicht")
+           ELSE manager question (erase msg)
+        FI.
+
+        erase msg:
+           TASK VAR owner ::act chain.entry [entry to erase].job.order task;
+           owner id (owner) + "/ """ + msg.ds name +
+           """ in Spool """ + name (managed plotter, act dev) +
+           """ loeschen".
+
+        order not from job order task:
+           NOT (act chain.entry [entry to erase].job.order task = order task).
+
+  y list:
+     link dev;
+     create chain list (act dev);
+     send (order task, ack, reply ds).
+
+  y all:
+     link dev;
+     forget (reply ds);
+     reply ds := nilspace;
+     thesaurus msg := reply ds;
+     thesaurus msg := chain thesaurus (act dev, owner or priv task, FALSE);
+     send (order task, ack, reply ds).
+
+     owner or priv task:
+        IF priv control op
+           THEN niltask
+           ELSE order task
+        FI.
+
+  y start:
+     link dev;
+     IF act dev = 0
+        THEN FOR act dev FROM 1 UPTO max devices REP
+                 start (act dev)
+             PER
+        ELSE start (act dev)
+     FI;
+     send ack.
+     
+  y stop:
+     IF phase = 1
+        THEN y stop pre
+        ELSE y stop post
+     FI.
+
+  y stop pre:
+     link dev;
+     IF act dev > 0
+        THEN stop (act dev);
+             IF NOT is no job (act server.current job)
+                THEN manager question ("""" + act server.current job.ds name
+                     + """ neu eintragen")
+                ELSE send ack
+             FI
+        ELSE FOR act dev FROM 1 UPTO max devices REP
+                  stop (act dev)
+             PER;
+             send ack
+     FI.
+
+  y stop post:
+     act dev := msg.dev no;
+     entry into chain (act dev, act server.current job);
+     IF act chain.last > 1
+        THEN make new first (act dev, act chain.last)
+     FI;
+     send ack.
+
+  y halt:
+     link dev;
+     IF act dev = 0
+        THEN IF order <> halt code
+                THEN device error
+                ELSE FOR act dev FROM 1 UPTO max devices REP
+                         halt (act dev)
+                     PER;
+                     send ack
+             FI
+        ELSE halt (act dev);
+             IF order = halt code
+                THEN send ack;
+                     act server.wait for halt := niltask
+                ELSE act server.wait for halt := order task
+             FI
+     FI.
+
+  y first:
+     link dev;
+     IF act dev = 0
+        THEN device error
+        ELSE INT VAR new first entry :: find entry (msg.ds name,act dev,order task,TRUE);
+             IF new first entry = 0
+                THEN manager message ("""" + msg.ds name + """ existiert nicht")
+                ELSE make new first (act dev,new first entry);
+                     send ack
+             FI
+     FI.
+
+   act server:
+      device [act dev].server.
+
+   act chain:
+      device [act dev].chain.
+
+   send ack:
+      send (order task, ack).
+
+   link dev:
+      msg := ds;
+      act dev := msg.dev no.
+
+  order error:
+     errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """").
+
+  device error:
+   disable stop;
+   IF plotter (msg.dev name) = no plotter
+     THEN clear error;   (* 'plotter(TEXT)' liefert evtl. bereits error *)
+          errorstop ("Kein Endgeraet eingestellt")
+     ELSE clear error;
+          errorstop ("Unbekanntes Endgeraet: """ + msg.dev name + """")
+   FI;
+   enable stop.
+END PROC plot manager;
+
+(****************************** Spool Monitor ******************************)
+
+INT VAR command index , params ;
+TEXT VAR command line, param 1, param 2 ;
+BOOL VAR is break;
+ 
+LET spool command list =
+"break:1.0start:2.0stop:3.0halt:4.0first:5.0killer:6.0listspool:7.0
+ clearspool:8.0selectplotter:9.0spoolcontrol:10.1";
+ 
+PROC spool monitor:
+  disable stop ;
+  current plotter := 0;
+  is break := FALSE;
+  select plotter ("");
+  REP command dialogue (TRUE) ;
+      get command (gib kommando, command line);
+      analyze command (spool command list, command line, 3, command index,
+                       params, param1, param2);
+      execute command;
+  UNTIL is break PER;
+  command dialogue (FALSE);
+  eumel must advertise;
+  break (quiet);
+  set autonom.
+
+  gib kommando:
+     IF actual plotter > 0
+        THEN plotter info (name(plotters,actual plotter),50)
+        ELSE "ALL-Plotter: "
+     FI
+END PROC spool monitor;
+
+PROC execute command:
+ enable stop;
+ SELECT command index OF 
+   CASE 1  :  is break := TRUE
+   CASE 2  :  start cmd
+   CASE 3  :  stop  cmd
+   CASE 4  :  halt  cmd
+   CASE 5  :  first cmd
+   CASE 6  :  killer cmd
+   CASE 7  :  show spool list
+   CASE 8  :  clear spool
+   CASE 9  :  select plotter cmd
+   CASE 10 :  set spool control
+   OTHERWISE  do (command line);
+              set current plotter
+ END SELECT.
+ 
+ set current plotter:
+   current plotter := link(managed plotter, name (plotters,actual plotter));
+   IF actual plotter > 0 AND current plotter = 0
+      THEN select plotter ("");
+           current plotter := 0;
+           errorstop ("Auf dieser Station unbekannt: """+name(plotter)+"""")
+   FI.
+
+   start cmd:
+    FOR act dev FROM curr dev UPTO top dev REP
+       start (act dev)
+    PER.
+
+ stop cmd:
+    FOR act dev FROM curr dev UPTO top dev REP
+       IF device [act dev].server.current job.ds name <> "" CAND
+          yes ("""" + device [act dev].server.current job.ds name +
+                """ neu eintragen")
+          THEN entry into chain (act dev, device [act dev].server.current job);
+               IF device [act dev].chain.last > 1
+                  THEN make new first (act dev, device [act dev].chain.last)
+               FI
+       FI;
+       stop (act dev)
+    PER.
+
+ halt cmd:
+    FOR act dev FROM curr dev UPTO top dev REP
+       halt (act dev)
+    PER.
+
+ first cmd:
+    IF current plotter = 0
+       THEN device error
+    FI;
+    TEXT VAR make to first :: one (chain thesaurus (current plotter,niltask,TRUE)
+                                   -first chain entry)
+   IF make to first <> ""
+       THEN INT VAR new first entry :: find entry (make to first,
+                                            current plotter, niltask, FALSE);
+            IF new first entry > 1
+               THEN make new first (current plotter, new first entry)
+            FI
+    FI.
+
+    first chain entry:
+       INT VAR first entry id :: device [current plotter].chain.first;
+       IF first entry id > 0
+          THEN device [current plotter].chain.entry[first entry id].job.ds name
+          ELSE ""
+       FI.
+
+ killer cmd:
+    IF current plotter = 0
+       THEN device error
+    FI;
+    THESAURUS VAR to erase :: chain thesaurus (current plotter,niltask,FALSE);
+    INT VAR index, act dev;
+    TEXT VAR name to erase;
+    FOR act dev FROM curr dev UPTO top dev REP
+       index := 0;
+       get (to erase, name to erase, index);
+       WHILE index > 0 REP
+          INT VAR entry to erase := find entry (name to erase, current plotter, niltask, TRUE);
+          IF (entry to erase > 0) CAND
+             yes ("""" + name to erase + """ loeschen")
+             THEN erase entry (current plotter, entry to erase)
+          FI;
+          get (to erase, name to erase, index)
+       PER
+    PER.
+
+ show spool list :
+    create chain list (current plotter);
+    show (chain info);
+    forget (reply ds).
+
+ clear spool:
+    FOR act dev FROM curr dev UPTO top dev REP
+        IF yes ("Spool """ + name (managed plotter, act dev) + """ initialisieren")
+           THEN BOOL VAR stopped :: device [act dev].server.stopped;
+                stop (act dev);
+                init device (act dev);
+                IF stopped
+                   THEN device [act dev].server.stopped := TRUE
+                   ELSE start (act dev)
+                FI
+        FI
+    PER.
+
+  set spool control:
+     control task := task (param 1).
+
+  select plotter cmd:
+    THESAURUS VAR plotter list :: empty thesaurus;
+    TEXT VAR plotter name;
+    get (managed plotter, plotter name, index);
+    WHILE index > 0 REP
+       insert (plotter list, plotter info (plotter name, 60));
+       get (managed plotter, plotter name, index)
+    PER;
+    select plotter (name (managed plotter,
+                    link (plotter list,one (plotter list))));
+    set current plotter.
+
+ curr dev:
+    IF current plotter = 0
+       THEN 1
+       ELSE current plotter
+    FI.
+
+ top dev:
+    IF current plotter = 0
+       THEN max devices
+       ELSE current plotter
+    FI.
+
+  device error:
+     errorstop ("Kein Endgeraet eingestellt")
+
+ENDPROC execute command ;
+
+(************************** SPOOL - Verwaltung *****************************)
+
+PROC entry into chain (INT CONST dev no, JOB CONST new job): 
+   INT VAR act entry := act chain.empty; 
+   act chain.empty := act chain.entry [act entry].link;
+   IF act chain.last > 0 
+      THEN act chain.entry [act chain.last].link := act entry 
+   FI; 
+   act chain.last := act entry; 
+   IF act chain.first = 0 
+      THEN act chain.first := act entry 
+   FI; 
+   init job (act chain.entry [act  entry].job);
+   act chain.entry [act entry] := ENTRY : (new job,0);
+   forget (new job.ds).
+ 
+   act chain : 
+      device [dev no].chain 
+END PROC entry into chain; 
+ 
+PROC erase entry (INT CONST dev no, to erase): 
+   INT VAR act entry;
+   to forward entry; 
+   IF act entry > 0 
+      THEN act chain.entry [act entry].link := act chain.entry [to erase].link 
+   FI; 
+   IF act chain.last = to erase 
+      THEN act chain.last := act entry 
+   FI; 
+   IF act chain.first = to erase 
+      THEN act chain.first := act chain.entry [to erase].link 
+   FI; 
+   init job (act chain.entry [to erase].job);
+   act chain.entry [to erase].link := act chain.empty; 
+   act chain.empty := to erase. 
+ 
+   to forward entry: 
+      FOR act entry FROM 1 UPTO max entries REP 
+      UNTIL act chain.entry [act entry].link = to erase PER; 
+      IF act entry > max entries 
+         THEN act entry := 0 
+     FI. 
+ 
+   act chain: 
+      device [dev no].chain 
+END PROC erase entry; 
+ 
+INT PROC find entry (TEXT CONST ds name, INT CONST dev, TASK CONST order task,BOOL CONST priviledged):
+   INT VAR act dev :: dev,act entry,last found :: 0;
+   IF act dev = 0
+      THEN FOR act dev FROM 1 UPTO max devices REP
+               find entry of order task
+           UNTIL act entry > 0 PER
+      ELSE find entry of order task
+    FI;
+    IF act entry = 0
+       THEN last found
+       ELSE act entry
+    FI.
+
+   find entry of order task:
+      BOOL VAR entry found;
+      act entry := act chain.first;
+      WHILE act entry > 0 REP
+         entry found := (act chain.entry [act entry].job.ds name = ds name);
+         IF entry found
+            THEN last found := act entry;
+                 entry found := (index (act chain.entry [act entry].job.order task) =
+                                 index (order task)) OR priviledged
+         FI;
+         IF NOT entry found
+            THEN act entry := act chain.entry [act entry].link
+         FI
+      UNTIL entry found PER.
+
+   act chain:
+      device [act dev].chain
+
+END PROC find entry;
+
+PROC make new first (INT CONST dev no, new first):
+   JOB VAR new first job :: act chain.entry [new first].job;
+   erase entry (dev no, new first);
+   INT VAR act entry := act chain.empty;
+   act chain.empty := act chain.entry [act entry].link;
+   act chain.entry [act entry] := ENTRY : (new first job, act chain.first);
+   init job (new first job);
+   act chain.first := act entry;
+   IF act chain.last = 0
+      THEN act chain.last := act entry
+   FI.
+
+   act chain:
+     device [dev no].chain
+
+END PROC make new first;
+
+THESAURUS PROC chain thesaurus (INT CONST dev no, TASK CONST order task,
+                                BOOL CONST double):
+   THESAURUS VAR list :: empty thesaurus;
+   INT VAR act dev := dev no,act entry;
+   IF act dev = 0 
+      THEN FOR act dev FROM 1 UPTO max devices REP 
+               list chain 
+           PER 
+      ELSE list chain 
+   FI; 
+   list.
+       
+   list chain: 
+      act entry := act chain.first; 
+      WHILE act entry > 0 REP 
+         IF (order task = niltask) OR
+            (act chain.entry [act entry].job.order task = order task)
+            THEN insert job name
+         FI;
+         act entry := act chain.entry [act entry].link 
+      PER.
+
+   insert job name:
+      TEXT VAR this job :: act chain.entry [act entry].job.ds name
+      IF double OR (NOT (list CONTAINS this job))
+         THEN insert (list, this job)
+      FI.
+
+   act chain: 
+      device [act dev].chain 
+ 
+END PROC chain thesaurus; 
+ 
+
+PROC create chain list (INT CONST dev no):
+   INT VAR act dev :: dev no, act entry; 
+   init chain info; 
+   IF act dev = 0
+      THEN FOR act dev FROM 1 UPTO max devices REP 
+             list chain 
+           PER 
+      ELSE list chain
+   FI.
+      
+   init chain info: 
+      forget (reply ds);
+      reply ds := nilspace;
+      chain info := sequential file (output, reply ds); 
+      headline (chain info,"GRAPHIK - Ausgabe um "+ time of day (clock (1)) + " Uhr :").
+
+ 
+   list chain: 
+      server head;
+      IF NOT server is active (act dev) OR is no job (act server.current job)
+         THEN put (chain info, "- Kein Auftrag in Bearbeitung") ;
+              IF act server.stopped
+                 THEN put (chain info, "  ( SERVER deaktiviert )")
+              FI;
+              line (chain info)
+         ELSE put (chain info, "- In Bearbeitung seit "+time of day (act server.time)+" Uhr :");
+              IF act server.stopped
+                 THEN put (chain info, " ( SERVER wird deaktiviert !)")
+              FI;
+              line (chain info, 2);
+              putline (chain info, job note (act server.current job))
+      FI; 
+      line (chain info);  
+      IF act chain.last = 0 
+         THEN putline (chain info, "- Keine Auftraege im SPOOL")
+         ELSE putline (chain info, "- Weitere Auftraege im SPOOL :"); 
+              line    (chain info); 
+              act entry := act chain.first; 
+              WHILE act entry > 0 REP 
+                    putline (chain info, job note (act chain.entry [act entry].job)); 
+                    act entry := act chain.entry [act entry].link 
+              PER 
+      FI; 
+      line (chain info, 2). 
+ 
+   server head:
+      TEXT VAR plotter name :: name (managed plotter,act dev);
+      INT VAR station :: int (plottername),
+              tp      :: pos (plottername,trenn)+1,
+              channel :: int (subtext (plottername,tp));
+      plotter name := subtext (plotter name, pos (plotter name, trenn, tp)+1);
+      putline (chain info, 77 * "-");
+      putline (chain info,
+               center (plotter name + (30-length(plotter name))*"." +
+                      "Kanal " + text (channel) +
+                      "/Station " + text (station)));
+      putline (chain info, 77 * "-");
+      line (chain info).
+
+   act chain: 
+      device [act dev].chain. 
+ 
+   act server: 
+      device [act dev].server 
+ 
+END PROC create chain list; 
+
+BOOL PROC chain is empty (INT CONST dev no):
+   device [dev no].chain.first = 0 OR device [dev no].chain.last = 0
+END PROC chain is empty;
+
+BOOL PROC chain is full (INT CONST dev no):
+   device [dev no].chain.empty = 0
+END PROC chain is full;
+
+PROC transfer next job (INT CONST dev no): 
+   INT VAR next chain entry := device [dev no].chain.first;
+   next server job (dev no, device [dev no].chain.entry [next chain entry].job); 
+   erase entry (dev no,next chain entry) 
+END PROC transfer next job; 
+ 
+(*************************** SERVER - Verwaltung ***************************)
+
+PROC next server job (INT CONST dev no,JOB CONST next job): 
+   act server.time := clock (1); 
+   init job (act server.current job);
+   act server.current job := next job. 
+ 
+   act server: 
+      device [dev no].server 
+END PROC next server job; 
+ 
+BOOL PROC server is active (INT CONST dev no):
+   exists (act server.task) CAND server alive or restarted.
+
+   server alive or restarted:
+      SELECT status (act server.task) OF
+        CASE 0 (* busy *) ,
+             4 (* busy-blocked *),
+             2 (* wait *),
+             6 (* wait-blocked *) : TRUE
+        CASE 1 (* i/o *),
+             5 (* i/o -blocked *): IF channel (act server.task) = 0
+                                     THEN restart
+                                     ELSE TRUE
+                                   FI
+        OTHERWISE restart
+      END SELECT.
+
+   restart:
+     end server (dev no);
+     IF NOT act server.stopped AND NOT chain is empty (dev no)
+        THEN create server (dev no)
+     FI;
+     NOT is niltask (act server.task).
+
+   act server:
+      device [dev no].server
+
+END PROC server is active;
+
+PROC create server (INT CONST dev no): 
+   init job (act server.current job);
+   act server.wait for halt := niltask;
+   act server.time := 0.0;
+   act server.stopped := FALSE;
+   last created server := dev no;
+   begin (PROC plot server, act server.task).
+
+   act server:
+      device [dev no].server
+END PROC create server; 
+ 
+PROC end server (INT CONST dev no): 
+   end (act server.task);
+   init job (act server.current job);
+   act server.task := niltask.
+
+   act server:
+     device [dev no].server
+
+END PROC end server; 
+ 
+PROC start (INT CONST dev no):
+   IF server is active (dev no)
+      THEN end server (dev no)
+   FI;
+   IF NOT chain is empty (dev no)
+      THEN create server (dev no)
+   FI;
+   device [dev no].server.stopped := FALSE
+END PROC start;
+
+PROC stop (INT CONST dev no):
+   device [dev no].server.stopped := TRUE;
+   IF exists (device [dev no].server.wait for halt)
+      THEN send (device [dev no].server.wait for halt,ack)
+   FI;
+   device [dev no].server.wait for halt := niltask;
+   IF server is active (dev no)
+      THEN end server (dev no)
+   FI
+END PROC stop;
+
+PROC halt (INT CONST dev no):
+   device [dev no].server.stopped := TRUE
+END PROC halt;
+
+PROC send current job (INT CONST dev no):
+   forget (reply ds);
+   reply ds := device [dev no].server.current job.ds;
+   send (device [dev no].server.task, ack,reply ds);
+END PROC send current job;
+
+(****************************** Hilfsprozeduren ****************************)
+
+PROC init device (INT CONST dev no): 
+   INT VAR act entry;
+   act server.task        := niltask; 
+   act server.time        := 0.0; 
+   init job (act server.current job); 
+   act server.stopped     := FALSE;
+   act chain.first        := 0; 
+   act chain.last         := 0; 
+   act chain.empty        := 1;
+   FOR act entry FROM 1 UPTO max entries-1 REP
+      init job (act chain.entry [act entry].job);
+      act chain.entry [act entry].link := act entry + 1
+   PER;
+   init job (act chain.entry [act entry].job);
+   act chain.entry [act entry].link := 0.
+
+   act server : 
+      device [dev no].server. 
+ 
+   act chain : 
+      device [dev no].chain 
+ 
+END PROC init device; 
+
+INT PROC max devices:
+   highest entry (managed plotter)
+END PROC max devices;
+
+OP := (MSG VAR dest, DATASPACE VAR source):
+   TEXT VAR ds name :: "", dev name :: "";
+   BOUND STRUCT (TEXT ds name, dev name, passwd) VAR msg in := source;
+   divide names;
+   dest := MSG : (ds name, dev name, msg in .passwd,
+                  link (managed plotter,dev name));
+   forget (source).
+
+   divide names:
+      INT VAR pps :: pos (msg in.ds name, ""0"");
+      WHILE pos (msg in.ds name, ""0"", pps+1) > 0 REP
+         pps := pos (msg in.ds name,""0"", pps+1)
+      PER;
+      IF pps > 0
+         THEN ds name  := subtext (msg in.ds name, 1, pps-1);
+      FI;
+      dev name := subtext (msg in.ds name, pps+1).
+
+END OP :=;
+
+TEXT PROC job note (JOB CONST job): 
+   "  - " + owner id (job.order task) + " : " + qrline (job.ds name, 30) +
+   " (" + text (storage (job.ds)) + " K)".
+END PROC job note; 
+
+TEXT PROC owner id (TASK CONST owner):
+    TEXT VAR test :: name (owner);
+    IF test <> ""
+       THEN text (station (owner)) + "/" + qrline (test,15)
+       ELSE "?????"
+    FI
+END PROC owner id;
+
+PROC init job (JOB VAR to initialize):
+   forget (to initialize.ds);
+   to initialize.ds name := "";
+   to initialize.order task := niltask
+END PROC init job;
+
+TEXT PROC qrline (TEXT CONST t,INT CONST len): 
+   IF length (t) > len-2 
+      THEN """" + text (t, len-5) + "...""" 
+      ELSE text ("""" + t + """", len) 
+   FI 
+END PROC qrline; 
+ 
+TEXT PROC center (TEXT CONST chars,INT CONST len):
+   len DIV 2 * " " + chars
+END PROC center;
+
+BOOL PROC is no job (JOB CONST job):
+   job.ds name = ""
+END PROC is no job;
+
+PROC send (TASK CONST task, INT CONST code):
+   DATASPACE VAR ds :: nilspace;
+   send (task, code, ds);
+   forget (ds)
+END PROC send;
+
+(**************************** Plot - Server ********************************)
+
+PROC plot server:
+   disable stop;
+   select plotter (name (managed plotter,last created server));
+   REP
+      error handling;
+      TEXT VAR dummy;
+      catinput (dummy, dummy);  (* evtl. Zeichen im Tastaturpuffer *)
+      PICFILE VAR pic :: next server job;
+      prepare;
+      plot (pic);
+   PER.
+
+   next server job:
+     forget (reply ds);
+     reply ds := nilspace;
+     REP
+       error handling;
+       call (father, fetch code, reply ds, reply)
+     UNTIL reply = ack PER;
+     reply ds.
+
+   error handling:
+    IF is error
+      THEN rename myself (error message);
+           clear error;
+           pause
+    FI.
+
+END PROC plot server;
+
+END PACKET plot manager
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Plot b/app/mpg/2.2/src/GRAPHIK.Plot
new file mode 100644
index 0000000..0479d75
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Plot
@@ -0,0 +1,1237 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.2 vom 23.09.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*              "Graphik-Plot" geschrieben von C.Weinholz                 *)
+(*                                                                        *) 
+(**************************************************************************) 
+(*                                                                        *) 
+(*           Paket II: Endgeraet-abhaengige Graphikroutinen               *) 
+(*        (koennen erst nach 'Interface.Conf' insertiert werden)          *) 
+(*                                                                        *) 
+(*                  1. Plot (Grundlegende Graphik-Operationen             *)
+(*                                                                        *) 
+(*                  2. Plot Input/Output (Routinen zum                    *)
+(*                           Ansprechen des PLOT-Spoolers                 *) 
+(*                           zur indirekten Graphik-Ausgabe)              *) 
+(*                                                                        *) 
+(*                  3. Plot Picture/Picfile                               *)
+(*                          (Ausgabe von PICTURES/ PICFILES)              *)
+(*                                                                        *)
+(**************************************************************************) 
+(*   Urversion  : 10.09.87                                                *) 
+(*   Aenderungen: 23.09.87, Carsten Weinholz                              *) 
+(*                PROC save (PICFILE CONST, TEXT CONST, PLOTTER CONST)    *) 
+(*                hinzugefuegt                                            *) 
+(*                PROC plot (PICFILE CONST) auch indirekt                 *) 
+(*                Fehlermeldung bei indirektem 'plot (PICTURE)'           *) 
+(*                20.11.87, Beat Jegerlehner                              *)
+(*                Clipping bei move eingefuehrt. Gibt sonst bei Watanabe  *)
+(*                Probleme                                                *)
+(*                Textgenerator korrigiert                                *)
+(*                                                                        *) 
+(**************************************************************************)
+ 
+(************************************ Plot ********************************)
+
+PACKET basis plot DEFINES
+
+      beginplot,
+      pen      ,
+
+      move     ,
+      move r   ,
+      move cm  ,
+      move cm r,
+
+      draw     ,
+      draw r   ,
+      draw cm  ,
+      draw cm r,
+
+      hidden lines,
+      reset    ,
+
+      zeichensatz,
+      reset zeichensatz,
+
+      linetype,
+      reset linetypes,
+
+      where,
+      bar,
+      circle,
+      box:
+
+LET empty              = 0,             (* Punktmuster *)
+    half               = 1,
+    full               = 2,
+    horizontal         = 3,
+    vertical           = 4,
+    cross              = 5,
+    diagonal right     = 6,
+    diagonal left      = 7,
+    diagonal both      = 8,
+    std zeichenname    = "ZEICHENSATZ";
+ 
+INT VAR  ltype    :: 1, 
+         thick    :: 0, 
+         xpixel   :: 0, 
+         ypixel   :: 0, 
+         old x    :: 0, 
+         old y    :: 0,
+         real old x :: 0,
+         real old y :: 0;
+
+REAL VAR x cm, ycm,hor relation, vert relation,x to y,y to x;
+
+ROW 5 TEXT VAR linetypes; 
+
+INT  VAR cnt :: 0;
+TEXT VAR muster :: "0";
+INT  VAR lentxt :: length(muster);
+ 
+LET POS = STRUCT (REAL x, y, z);
+POS VAR pos :: POS : (0.0, 0.0, 0.0);
+
+LET ZEICHENSATZ = ROW 255 TEXT;
+ZEICHENSATZ VAR zeichen;
+REAL CONST char x :: 6.0, char y :: 6.0,y base :: 2.0;
+ 
+BOUND ZEICHENSATZ VAR std zeichen :: old (std zeichenname);
+reset zeichensatz;
+reset linetypes;
+
+INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0;
+
+BOOL VAR hidden :: FALSE;
+
+DATASPACE VAR ds :: nilspace;
+BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds;
+
+(*************************** Initialisierung *******************************)
+
+PROC beginplot: 
+   init plot; 
+   drawing area (x cm, y cm, x pixel, y pixel);
+   hor relation := real (x pixel)/x cm;
+   vert relation:= real (y pixel)/y cm;
+   x to y := x cm / real(x pixel) / (y cm / real (y pixel)); (*umrechnung:*)
+   y to x := 1.0 / x to y;             (* x pixel in y pixel u andersherum*)
+END PROC beginplot; 
+
+PROC pen (INT CONST backgr,colour,thickn,linetype):
+  background(backgr); 
+  foreground(colour); 
+  thick := thickn;
+  ltype := selected linetype; 
+  IF ltype > 1 
+     THEN muster := linetypes[ltype];
+          lentxt := length (muster);
+          cnt    := 0 
+  FI. 
+ 
+  selected linetype: 
+     IF linetype < 0 OR linetype > 5 
+        THEN 1 
+        ELSE linetype 
+     FI 
+END PROC pen; 
+
+(************************** MOVE - Prozeduren ******************************)
+
+PROC move (INT CONST x,y): 
+  old x := x; 
+  old y := y 
+END PROC move; 
+
+PROC do move (INT CONST x,y):
+  IF x <> real old x OR 
+     y <> real old y
+    THEN real old x := x;
+         real old y := y;
+         move to (x,y)
+  FI;
+  old x := x;
+  old y := y
+END PROC do move;
+ 
+PROC move (REAL CONST x, y) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  transform (x, y, 0.0, h, v);
+  move (h, v);
+  pos := POS : (x, y, 0.0)
+END PROC move;
+
+PROC move (REAL CONST x, y, z) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  transform (x, y, z, h, v);
+  move (h, v);
+  pos := POS : (x, y, z)
+END PROC move;
+
+PROC move r (REAL CONST x, y) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  transform (pos.x+x, pos.y+y, pos.z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC move r;
+
+PROC move r (REAL CONST x, y, z) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC move r;
+
+PROC move cm (REAL CONST x cm, y cm) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  h := int (x cm*hor relation+0.5);
+  v := int (y cm*vert relation+0.5);
+  move (h, v)
+END PROC move cm;
+
+PROC move cm r (REAL CONST x cm, y cm) :
+  IF hidden 
+  THEN maxima.last := maxima.akt FI;
+
+  h INCR int (x cm*hor relation+0.5);
+  v INCR int (y cm*vert relation+0.5);
+  move (h, v)
+END PROC move cm r;
+
+(************************** DRAW - Prozeduren ******************************)
+
+PROC draw (INT CONST x,y): 
+  draw (old x,old y,x,y) 
+END PROC draw; 
+ 
+PROC draw (INT CONST x0,y0,x1,y1): 
+  IF thick = 0
+    THEN line (x0, y0,x1,y1) 
+    ELSE old x := x0; 
+         old y := y0; 
+         draw thick line (x1,y1) 
+  FI; 
+  old x := x1; 
+  old y := y1 
+END PROC draw;  
+
+PROC draw (REAL CONST x, y) :
+  IF hidden
+  THEN transform (x, y, 0.0, new h, new v);
+       vector (new h-h, new v-v)
+  ELSE transform (x, y, 0.0, h, v);
+       draw (h, v)
+  FI;
+  pos := POS : (x, y, 0.0)
+END PROC draw;
+
+PROC draw (REAL CONST x, y, z) :
+  IF hidden
+  THEN transform (x, y, z, new h, new v);
+       vector (new h-h, new v-v)
+  ELSE transform (x, y, z, h, v);
+       draw (h, v)
+  FI;
+  pos := POS : (x, y, z) 
+END PROC draw;
+
+PROC draw r (REAL CONST x, y) :
+  IF hidden
+  THEN transform (pos.x+x, pos.y+y, pos.z, h, v); 
+       vector (new h-h, new v-v)
+  ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); 
+       draw (h, v)
+  FI;
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC draw r;
+
+PROC draw r (REAL CONST x, y, z) :
+  IF hidden
+  THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); 
+       vector (new h-h, new v-v)
+  ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+       draw (h, v)
+  FI;
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC draw r;
+
+PROC draw cm (REAL CONST x cm, y cm) :
+  IF hidden
+  THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v)
+  ELSE h := int (x cm*hor relation+0.5);
+       v := int (y cm*vert relation+0.5);
+       draw (h, v)
+  FI
+END PROC draw cm;
+
+PROC draw cm r (REAL CONST x cm, y cm) :
+  IF hidden
+  THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5))
+  ELSE h INCR int (x cm*hor relation+0.5);
+       v INCR int (y cm*vert relation+0.5);
+       draw (h, v)
+  FI
+END PROC draw cm r;
+
+(*************************** LINIEN zeichnen *******************************)
+
+PROC line (INT CONST x0,y0,x1,y1): 
+  REAL VAR x0r :: real (x0), 
+           y0r :: real (y0), 
+           x1r :: real (x1), 
+           y1r :: real (y1); 
+  IF clipped line (x0r,y0r,x1r,y1r) 
+     THEN IF ltype > 1 
+             THEN draw special line(int(x0r),int(y0r),int(x1r),int(y1r)) 
+          ELIF ltype = 1 
+             THEN do move (int(x0r),int(y0r)); 
+                  draw std line (int(x1r),int(y1r)) 
+          FI 
+  FI
+END PROC line; 
+
+PROC draw std line (INT CONST x,y): 
+  old x := x; 
+  old y := y;
+  real old x := x;
+  real old y := y;
+  draw to (x,y) 
+END PROC draw std line; 
+ 
+PROC draw special line (INT CONST x0,y0,x1,y1): 
+  IF x0 = x1 
+    THEN vertical line 
+  ELIF y0 = y1 
+    THEN horizontal line
+  ELIF abs(x1-x0) > abs(y1 - y0) 
+    THEN steile linie 
+    ELSE flache linie 
+  FI. 
+ 
+  vertical line: 
+    INT VAR steps :: abs(y1 - y0), 
+            sig   :: sign(y1-y0),
+            i;
+    FOR i FROM 0 UPTO steps REP 
+      IF next pixel
+         THEN set pixel(x0,y0+i*sig)
+      FI
+    PER. 
+ 
+  horizontal line: 
+    steps := abs(x1 - x0); 
+    sig :=   sign(x1 - x0); 
+    FOR i FROM 0 UPTO steps REP 
+      IF next pixel
+         THEN set pixel(x0+i*sig,y0)
+      FI
+    PER. 
+ 
+  steile linie: 
+    steps := abs(x1 - x0); 
+    sig := sign(x1 - x0); 
+    REAL VAR m :: real(y1 - y0) / real(x1 - x0); 
+    FOR i FROM 0 UPTO steps REP 
+      IF next pixel
+         THEN set pixel(x0+sig*i,y0+int(m*real(sig*i) + 0.5))
+      FI
+    PER. 
+ 
+  flache linie: 
+    steps := abs(y1 - y0); 
+    sig := sign(y1 - y0); 
+    m := real(x1 - x0) / real(y1 - y0); 
+    FOR i FROM 0 UPTO steps REP 
+      IF next pixel
+         THEN set pixel(x0+int(m*real(sig*i) + 0.5),y0+sig*i)
+      FI
+    PER.
+
+    next pixel:
+      BOOL VAR is set :: (muster SUB cnt) <> "0";
+      cnt INCR 1;
+      IF cnt > lentxt THEN cnt := 1 FI;
+      is set
+END PROC drawspecialline;
+
+PROC draw thick line (INT CONST xe,ye):
+ 
+  INT VAR x0 :: old x,
+          y0 :: old y,
+          x1 :: xe,
+          y1 :: ye;
+ 
+  IF x0 = x1 AND y0 = y1
+    THEN draw point (x0,y0) 
+  ELIF abs(x0-x1) >= abs(y0-y1) 
+    THEN IF x0 > x1 
+           THEN draw thick2(x1,y1,x0,y0) 
+           ELSE draw thick2(x0,y0,x1,y1) 
+         FI 
+    ELSE IF y0 > y1 
+           THEN draw thick1(x1,y1,x0,y0) 
+           ELSE draw thick1(x0,y0,x1,y1) 
+         FI 
+  FI 
+END PROC draw thick line;
+
+PROC draw point (INT CONST x,y): 
+  INT VAR i,k,d :: int(0.5 + real(thick) / (x cm / real(x pixel)) / 10.0 /
+  2.0); 
+  FOR i FROM 0 UPTO d REP 
+    k := int (0.5 + sqrt(real(d)**2 - real(i)**2)* x to y); 
+    line (x+i, y-k, x+i, y+k); 
+    line (x-i, y-k, x-i, y+k) 
+  PER 
+END PROC draw point; 
+ 
+PROC draw thick 1 (INT CONST x0,y0,x1,y1): 
+  REAL VAR dxx :: real(x1 - x0), 
+           dyx :: real(y1 - y0) * y to x, 
+           d3 :: real(thick) / (x cm / real(x pixel)) / 10.0, 
+           d1 :: sqrt (d3**2 + (d3 * dxx / dyx)**2), 
+           d2 :: d3 * dxx / dyx, 
+           dh :: (d3**2 - d2**2 + d1**2) / 2.0 / d1, 
+           d4 :: sqrt(max(0.0,d3 ** 2 - dh ** 2)) * x to y; 
+  INT VAR l :: int (0.5 + d1 / 2.0), 
+          dy :: abs(y0 - y1), 
+          dx :: abs(x0 - x1), 
+          x :: x0 - int(0.5 + d3 / 2.0 * dxx / dyx), 
+          y :: y0 - int(d3 / 2.0 * x to y), 
+          z :: y1 + int (d3 / 2.0 * x to y), 
+          dp :: dx + dx, 
+          d :: dp - dy, 
+          dq :: dp - dy - dy, 
+          a :: sign (y1 - y0),
+          b :: sign (x1 - x0); 
+  do line; 
+  WHILE y <> z REP 
+    y INCR a; 
+    IF d < 0 
+      THEN d INCR dp 
+      ELSE x INCR b; 
+           d INCR dq 
+    FI; 
+    do line 
+  PER. 
+ 
+  do line: 
+    INT VAR s1 :: l, 
+            s2 :: l, 
+            s3 :: x,
+            sh;
+    IF y < y0 - int (0.5 + d4 / 2.0) 
+      THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y - y0) * y to
+      x)**2)); 
+           s2 := s1; 
+           s3 := x0 
+    ELIF y < y0 + int (0.5 + d4 / 2.0) 
+      THEN sh := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y-y0) * y to
+      x)**2));
+           IF x0 > x1 
+             THEN s2 := sh + x0 - x 
+             ELSE s1 := sh + x - x0 
+           FI; 
+           s3 := x 
+    ELIF y > y1 + int (0.5 + d4/2.0) 
+      THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(y-y1)*y to x)**2)); 
+           s2 := s1; 
+           s3 := x1 
+    ELIF y > y1 - int(0.5 + d4 / 2.0) 
+      THEN sh := int(0.5 + sqrt(d3**2/4.0 - (real(y-y1)*y to x)**2));
+           IF x0 > x1 
+             THEN s1 := sh + x - x1 
+             ELSE s2 := sh + x1 - x 
+           FI; 
+           s3 := x 
+    FI; 
+    line (s3 - s1,y,s3 + s2, y) 
+END PROC draw thick 1; 
+ 
+PROC draw thick 2 (INT CONST x0,y0,x1,y1): 
+  REAL VAR dxx :: real(x1 - x0) * x to y, 
+           dyx :: real(y1 - y0),
+           d3 :: real(thick) / (y cm / real(y pixel)) / 10.0, 
+           d1 :: sqrt (d3**2 + (d3 * dyx / dxx)**2), 
+           d2 :: d3 * dyx / dxx, 
+           dh :: (d3**2 - d2**2 + d1**2) / 2.0 / d1, 
+           d4 :: sqrt(max(0.0,d3 ** 2 - dh ** 2)) * y to x; 
+  INT VAR l :: int (0.5 + d1 / 2.0), 
+          dy :: abs(y0 - y1), 
+          dx :: abs(x0 - x1), 
+          y :: y0 - int(0.5 + d3 / 2.0 * dyx / dxx), 
+          x :: x0 - int(d3 / 2.0 * y to x), 
+          z :: x1 + int (d3 / 2.0 * y to x), 
+          dp :: dy + dy, 
+          d :: dp - dx, 
+          dq :: dp - dx - dx, 
+          a :: sign (x1 - x0),
+          b :: sign (y1 - y0); 
+  do line; 
+  WHILE x <> z REP 
+    x INCR a; 
+    IF d < 0 
+      THEN d INCR dp 
+      ELSE y INCR b; 
+           d INCR dq 
+    FI; 
+    do line 
+  PER. 
+ 
+  do line: 
+    INT VAR s1 :: l, 
+            s2 :: l, 
+            s3 :: y,
+            sh;
+    IF x < x0 - int (0.5 + d4 / 2.0) 
+      THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x - x0) * x to y)**2)); 
+           s2 := s1; 
+           s3 := y0 
+    ELIF x < x0 + int (0.5 + d4 / 2.0) 
+      THEN sh := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x-x0) * x to y)**2));
+           IF y0 > y1 
+             THEN s2 := sh + y0 - y 
+             ELSE s1 := sh + y - y0 
+           FI; 
+           s3 := y 
+    ELIF x > x1 + int (0.5 + d4/2.0) 
+      THEN s1 := int (0.5 + sqrt (d3 ** 2 / 4.0 - (real(x-x1)*x to y)**2)); 
+           s2 := s1; 
+           s3 := y1 
+    ELIF x > x1 - int(0.5 + d4 / 2.0) 
+      THEN sh := int(0.5 + sqrt(d3**2/4.0 - (real(x-x1)*x to y)**2));
+           IF y0 > y1 
+             THEN s1 := sh + y - y1 
+             ELSE s2 := sh + y1 - y 
+           FI; 
+           s3 := y 
+    FI; 
+    line (x, s3-s1, x, s3+s2) 
+END PROC draw thick 2; 
+
+(*************************** HIDDEN LINES **********************************)
+
+PROC hidden lines (BOOL CONST dev):
+  hidden := NOT dev;
+END PROC hidden lines;
+
+PROC vector (INT CONST dx, dy):
+  IF dx >= 0
+  THEN IF   dy >  dx THEN vector (v, h, dy, dx,  1, 1)
+       ELIF dy >   0 THEN vector (h, v, dx, dy,  1, 1)
+ 
+       ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1)
+       ELSE               vector (v, h, -dy, dx,-1, 1) FI
+
+  ELSE IF   dy > -dx THEN vector (v, h, dy, -dx, 1,-1)
+       ELIF dy >   0 THEN vector (h, v, -dx, dy,-1, 1)
+ 
+       ELIF dy >  dx THEN vector (h, v, -dx, -dy,-1,-1)
+       ELSE               vector (v, h, -dy, -dx,-1,-1) FI
+  FI  .
+ 
+ENDPROC vector ;
+ 
+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :
+  INT VAR i;
+  prepare first step ;
+  draw point;
+  FOR i FROM 1 UPTO dx
+  REP do one step PER;
+
+  IF was visible
+  THEN draw (h, v) FI  .
+
+
+prepare first step :
+  INT VAR up right error := dy - dx,
+          right error := dy,
+          old error := 0,
+          last h :: h, last v :: v;
+  BOOL VAR was visible :: visible  .
+
+
+do one step:
+  IF right is better
+    THEN do right step
+    ELSE do up right step
+  FI .
+ 
+right is better :
+  abs (old error + right error) < abs (old error + up right error)  .
+ 
+do upright step :
+  x pos INCR right ;
+  y pos INCR up ;
+  draw point ;
+  old error INCR upright error .
+ 
+do right step :
+  x pos INCR right ;
+  draw point ;
+  old error INCR right error .
+ 
+draw point :
+  IF was visible
+  THEN IF NOT visible
+       THEN draw (last h, last v);
+            was visible := FALSE
+       FI;
+       last h := h;
+       last v := v
+  ELSE IF visible
+       THEN move (h, v);
+            was visible := TRUE;
+            last h := h;
+            last v := v 
+       FI
+ FI  .
+
+visible:
+  IF h < 1 OR h > x pixel
+  THEN FALSE
+  ELSE IF maxima.akt [h] < v 
+       THEN maxima.akt [h] := v FI; 
+       v > maxima.last [h]
+  FI
+END PROC vector;
+
+PROC reset:
+  forget (ds);
+  ds := nilspace;
+  maxima := ds
+END PROC reset;
+
+(**************************** TEXT - Ausgabe *******************************)
+
+PROC zeichensatz (TEXT CONST name):
+  IF exists (name)
+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
+       zeichen := new zeichen;
+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
+END PROC zeichensatz;
+
+PROC reset zeichensatz: 
+   zeichen := std zeichen 
+END PROC reset zeichensatz; 
+ 
+PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST y size, 
+                x size, direction):
+  TEXT CONST character :: zeichen [char no];
+  INT VAR n :: 1, x0, y0, x1, y1;
+  INT CONST len :: length (character);
+  REAL CONST sindir :: sind(direction),
+             cosdir :: cosd(direction);
+  WHILE n < len
+  REP value (character, n, x0, y0, x1, y1);
+  REAL VAR xr0 :: real(x0),
+           yr0 :: real(y0),
+           xr1 :: real(x1), 
+           yr1 :: real(y1);
+      transform (xr0, yr0, x, y, x size, y size, sindir,cosdir);
+      transform (xr1, yr1, x, y, x size, y size, sindir,cosdir);
+      draw (int(xr0), int (yr0 * x to y),
+            int(xr1),int(yr1 * x to y));
+       n INCR 4 
+  PER  .
+
+END PROC draw char;
+
+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):
+  x0 := val (code (char SUB n));    y0 := val (code (char SUB n+1));
+  x1 := val (code (char SUB n+2));  y1 := val (code (char SUB n+3));
+END PROC value;
+
+INT PROC val (INT CONST n):
+  IF n > 127
+  THEN -256 OR n
+  ELSE n FI
+END PROC val;
+
+PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, 
+                sindir,cosdir):
+  REAL CONST old x :: x, old y :: y;
+  REAL CONST dx :: x size / char x * old x * cosdir - 
+                   (y size-y base) / char y * old y * sindir, 
+             dy :: (y size-y base) / char y * old y * cosdir + 
+                   x size / char x * old x * sindir;
+  x := x0 + dx; 
+  y := y0 + dy
+END PROC transform; 
+
+PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, 
+                REAL CONST height, width): 
+  INT VAR i;
+  REAL VAR x :: x pos, y :: y pos,
+           x step :: cosd (angle)*width,
+           y step :: sind (angle)*width;
+  FOR i FROM 1 UPTO length (msg)
+  REP IF control char
+      THEN execute control char
+      ELSE execute normal char FI
+  PER  .
+
+control char:
+  akt char < ""32""  .
+
+execute control char:
+  SELECT code (akt char) OF
+  CASE  1: home
+  CASE  2: right
+  CASE  3: up
+  CASE  7: out (""7"")
+  CASE  8: left
+  CASE 10: down
+  CASE 13: return
+  ENDSELECT  .
+
+home:
+  x := x pos;
+  y := y pos  .
+
+right:
+  x INCR x step;  y INCR y step  . 
+
+up:
+  x INCR y step;  y INCR x step  . 
+
+left:
+  x DECR x step;  y DECR y step  .
+
+down:
+  x DECR y step;  y DECR x step  . 
+
+return:
+  x := x pos  .
+
+execute normal char:
+  draw char (code (akt char), x, y, height, width,
+             angle);
+  x INCR x step;
+  y INCR y step .
+
+akt char:
+  msg SUB i  .
+
+END PROC draw text; 
+ 
+PROC draw (TEXT CONST msg):
+   draw (msg,0.0,5.0,5.0)
+END PROC draw;
+ 
+PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width):
+    REAL CONST  xr :: real(old x), 
+                yr :: real(old y) * y to x;
+    draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, 
+                               width  * real(x pixel) / x cm / 10.0)
+                                    (* heigth  mm --> x punkte *)
+END PROC draw; 
+ 
+(***************************** LINETYPES ***********************************)
+
+PROC linetype (INT CONST nummer,TEXT CONST lt): 
+   IF nummer > 5 OR nummer < 2 
+      THEN errorstop ("number out of range") 
+      ELSE linetypes [nummer] := lt 
+   FI 
+END PROC linetype ; 
+ 
+PROC reset linetypes : 
+   linetype (2,"1100"); 
+   linetype (3,"11110000"); 
+   linetype (4,"1111111100000000"); 
+   linetype (5,"1111111100011000"); 
+END PROC reset linetypes ; 
+
+(***************************** UTILIES *************************************)
+
+PROC where (REAL VAR x, y) :
+  x := pos.x;  y := pos.y
+END PROC where;
+
+PROC where (REAL VAR x, y, z) :
+  x := pos.x;  y := pos.y;  z := pos.z
+END PROC where;
+
+PROC bar (REAL CONST hight, width, INT CONST pattern):
+  INT VAR zero x, zero y, end x, end y;
+  transform (0.0, 0.0, 0.0, zero x, zero y);
+  transform (width, hight, 0.0, end x, end y);
+  bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern)
+END PROC bar;
+
+PROC bar (INT CONST from x, from y, width, hight, pattern):
+  INT CONST to x :: from x+width, to y :: from y+hight;
+  INT VAR x, y;
+  draw frame;
+  SELECT pattern OF
+  CASE empty: (* nothing to do *)
+  CASE half:           half bar
+  CASE full:           full bar
+  CASE horizontal:     horizontal bar
+  CASE vertical:       vertical bar
+  CASE cross:          horizontal bar;
+                       vertical bar
+  CASE diagonal right: diagonal right bar
+  CASE diagonal left:  diagonal left bar
+  CASE diagonal both:  diagonal both bar
+  OTHERWISE errorstop ("Unknown pattern") ENDSELECT  .
+
+draw frame:
+  move (from x, from y);
+  draw (from x, to y);
+  draw (to x, to y);
+  draw (to x, from y);
+  draw (from x, from y).
+
+full bar:
+  FOR y FROM from y UPTO to y
+  REP move (from x, y);
+      draw (to x, y) 
+  PER  .
+
+half bar:
+  FOR y FROM from y UPTO to y
+  REP x := from x + 1 + (y AND 1);
+      WHILE x < to x 
+      REP move (x, y);
+          draw (x, y);
+          x INCR 2
+      PER
+  PER  .
+
+horizontal bar:
+  y := from y;
+  WHILE y < to y
+  REP move (from x, y);
+      draw (to x, y);
+      y INCR 5
+  PER  .
+
+vertical bar:
+  x := from x + 5;
+  WHILE x < to x
+  REP move (x, from y);
+      draw (x, to y);
+      x INCR 5
+  PER  .
+
+diagonal right bar:
+  y := from y-width+5;
+  WHILE y < to y
+  REP move (max (from x, to x-y-width+from y), max (from y, y));
+      draw (min (to x, from x+to y-y), min (to y, y+width));
+      y INCR 5
+  PER  .
+
+diagonal left bar:
+  y := from y-width+5;
+  WHILE y < to y
+  REP move (min (to x, to x-from y+y),  max (from y, y));
+      draw (max (from x, from x+y+width-to y), min (to y, y+width)); 
+      y INCR 5
+  PER  .
+
+diagonal both bar:
+  y := from y-width+5;
+  WHILE y < to y
+  REP move (max (from x, to x-y-width+from y), max (from y, y));
+      draw (min (to x, from x+to y-y), min (to y, y+width)); 
+      move (min (to x, to x-from y+y),  max (from y, y));
+      draw (max (from x, from x+y+width-to y), min (to y, y+width));
+      y INCR 5
+  PER  .
+
+END PROC bar;
+
+PROC circle (REAL CONST r, from, to, INT CONST pattern):
+  REAL VAR t :: from;   INT VAR i; i := pattern; (* sonst WARNUNG *)
+  WHILE t < to
+  REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v);
+      draw (h, v);
+      t INCR 1.0
+  PER;
+  transform (pos.x, pos.y, 0.0, h, v);
+  draw (h, v)  .
+
+END PROC circle;
+
+PROC box :
+  move (0,0);
+  draw (0,y pixel-1);
+  draw (x pixel-1, y pixel-1);
+  draw (x pixel-1, 0);
+  draw (0,0)
+END PROC box;
+
+END PACKET basis plot;
+
+(************************* Plot Spool Input/ Output ***********************)
+
+PACKET plot interface   DEFINES                       (* Carsten Weinholz *)
+                                                      (* V 1.1  02.07.87  *) 
+                                save                 , 
+                                exists               , 
+                                erase                , 
+                                ALL                  ,
+                                first                , 
+                                start                , 
+                                stop                 , 
+                                halt                 , 
+                                wait for halt        , 
+                                list                 , 
+                                picfiles             ,
+                                generate plot manager:
+ 
+LET initfile         = "GRAPHIK.Manager", 
+    plot manager name= "PLOT"   , 
+
+    picfiletype      = 1102,
+ 
+    ack              = 0, 
+    false code       = 6,
+    fetch code       = 11,
+    save code        = 12,
+    exists code      = 13, 
+    erase code       = 14, 
+    list code        = 15,
+    all code         = 17, 
+    first code       = 25,
+    start code       = 26,
+    stop  code       = 27,
+    halt code        = 28,
+    wait for halt  code = 29;
+ 
+BOUND STRUCT (TEXT tname,user id,pass) VAR msg; 
+ 
+DATASPACE VAR ds; 
+
+INT VAR reply;
+THESAURUS VAR all myself picfiles; 
+ 
+PROC first (TEXT CONST ds name, PLOTTER CONST plotter id): 
+   call (first code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) 
+END PROC first; 
+ 
+PROC start (PLOTTER CONST plotter id):
+   call (start code, id name (plotter id), plot id (plotter id)) 
+END PROC start;
+ 
+PROC stop (PLOTTER CONST plotter id): 
+   call (stop code, id name (plotter id), plot id (plotter id)) 
+END PROC stop;
+ 
+PROC halt (PLOTTER CONST plotter id): 
+   call (halt code, id name (plotter id), plot id (plotter id)) 
+END PROC halt; 
+ 
+PROC wait for halt (PLOTTER CONST plotter id): 
+   call (wait for halt code, id name (plotter id), plot id (plotter id)) 
+END PROC wait for halt; 
+ 
+PROC save (TEXT CONST ds name, PLOTTER CONST plotter id):
+   enable stop;
+   last param (ds name);
+   call (save code, ds name + ""0"" + id name (plotter id), 
+                                 old (ds name), plot id (plotter id))
+END PROC save; 
+ 
+PROC save (PICFILE CONST p, TEXT CONST pname, PLOTTER CONST plotter id): 
+   enable stop;
+   DATASPACE VAR ds; 
+   ds BECOMES p; 
+   call (save code, pname + ""0"" + id name (plotter id), ds, 
+         plot id (plotter id)); 
+END PROC save; 
+ 
+OP BECOMES (DATASPACE VAR ds, PICFILE CONST p):
+   EXTERNAL 260
+END OP BECOMES;
+ 
+PROC save (THESAURUS CONST nameset, PLOTTER CONST plotter id): 
+   TEXT VAR name; 
+   INT VAR i :: 0; 
+   get (nameset, name, i); 
+   WHILE i > 0 REP 
+      save (name, plotter id); 
+      cout (i); 
+      get (nameset, name, i) 
+   PER
+END PROC save;
+
+BOOL PROC exists (TEXT CONST ds name, PLOTTER CONST plotter id): 
+   INT VAR reply;
+   DATASPACE VAR ds :: nilspace; 
+   BOUND TEXT VAR qname :: ds; 
+   qname := ds name + ""0"" + id name (plotter id); 
+   REP 
+      call (plot id (plotter id), exists code, ds, reply) 
+   UNTIL reply = false code OR reply = ack PER;
+   forget (ds); 
+   reply = ack 
+END PROC exists; 
+
+PROC erase (TEXT CONST ds name,PLOTTER CONST plotter id): 
+   call (erase code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) 
+END PROC erase;
+ 
+PROC erase (THESAURUS CONST nameset, PLOTTER CONST plotter id): 
+   TEXT VAR name; 
+   INT VAR i :: 0; 
+   get (nameset, name, i); 
+   WHILE i > 0 REP 
+      erase (name, plotter id); 
+      cout (i); 
+      get (nameset, name, i) 
+   PER
+END PROC erase; 
+ 
+THESAURUS OP ALL (PLOTTER CONST plotter id): 
+   REP
+      forget (ds);
+      ds := nilspace;
+      msg := ds;
+      msg.tname   := id name (plotter id);
+      msg.user id := "";
+      msg.pass    := "";
+      call (plot id (plotter id), all code, ds, reply)
+   UNTIL reply = ack PER;
+   BOUND THESAURUS VAR result ds :: ds;
+   THESAURUS VAR result :: result ds;
+   forget (ds);
+   result 
+END OP ALL;
+
+PROC list (FILE VAR f,PLOTTER CONST plotter id): 
+      REP
+         forget (ds); 
+         ds := nilspace; 
+         msg := ds;
+         msg.tname   := id name (plotter id); 
+         msg.user id := "";
+         msg.pass    := "";
+         call (plot id (plotter id), list code, ds, reply) 
+      UNTIL reply = ack PER; 
+      f := sequential file (modify, ds)
+END PROC list; 
+
+PROC list (PLOTTER CONST plotter id): 
+   FILE VAR list file; 
+   list (list file, plotter id); 
+   show (list file) 
+END PROC list;
+ 
+THESAURUS PROC picfiles: 
+   all myself picfiles := empty thesaurus; 
+   do (PROC (TEXT CONST) insert if picfile,ALL myself); 
+   all myself picfiles 
+END PROC picfiles; 
+ 
+PROC insert if picfile (TEXT CONST filename): 
+   IF type (old (filename)) = picfiletype 
+      THEN insert (all myself picfiles,filename) 
+   FI 
+END PROC insert if picfile; 
+ 
+PROC generate plot manager: 
+   TASK VAR plot manager; 
+   IF exists (initfile) 
+      THEN generate in background 
+      ELSE errorstop ("""" + init file + """ existiert nicht") 
+   FI. 
+ 
+   generate in background: 
+      begin (plot manager name,PROC init plot manager, plot manager); 
+      INT VAR manager call; 
+      DATASPACE VAR initspace; 
+      TASK VAR order task; 
+      REP 
+         wait (initspace, manager call, order task) 
+      UNTIL order task = plot manager PER; 
+      initspace := old (initfile); 
+      send (plot manager, ack, initspace); 
+      say ("Plot-Manager wird generiert"13""10"");
+      say ("Bitte etwas Geduld..."13""10"");
+      REP
+         wait (initspace, manager call, order task)
+      UNTIL order task = plot manager PER;
+      forget (initspace);
+      say ("Plotmanager generiert !"13""10"") 
+END PROC generate plot manager; 
+ 
+PROC init plot manager: 
+   DATASPACE VAR initspace :: nilspace; 
+   INT VAR dummy; 
+   call (father, fetch code, initspace, dummy); 
+   copy (init space,init file);
+   insert (init file); 
+   send (father,ack,initspace);
+   do ("plot manager");
+END PROC init plot manager;
+ 
+TASK PROC plot id (PLOTTER CONST plotter id):
+   IF plotter id = no plotter
+      THEN task (plot manager name) 
+      ELSE station (plotter id)/plot manager name
+   FI
+END PROC plot id;
+ 
+TEXT PROC id name (PLOTTER CONST plotter id):
+   text (station (plotter id)) + "/" + text (channel (plotter id)) + "/" + 
+   name (plotter id)
+END PROC id name;
+
+END PACKET plot interface; 
+
+(************************* Plot Picture / Picfile *************************)
+
+PACKET plot DEFINES plot : 
+
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    move cm key   = 6, 
+    draw cm key   = 7,
+    move cm r key = 8,
+    draw cm r key = 9,
+    bar key       = 10,
+    circle key    = 11;
+
+LET postfix = ".PICFILE"
+
+INT VAR read pos; 
+ 
+PROC plot (TEXT CONST name) :
+  PICFILE VAR p :: old (name);
+  IF channel <> channel (plotter) OR station (myself) <> station (plotter)
+     THEN save (name, plotter) 
+     ELSE plot (p)
+  FI
+END PROC plot;
+
+PROC plot (PICFILE VAR p) :
+  IF channel <> channel (plotter) OR station(myself) <> station(plotter)
+     THEN save (p, name (myself) + "." + text (highest entry (ALL plotter))
+                   + postfix, plotter)
+     ELSE direct plot
+  FI. 
+ 
+  direct plot: 
+    ROW 3 ROW 2 REAL VAR sizes; 
+    ROW 2 ROW 2 REAL VAR limits; 
+    ROW 4 REAL VAR angles; 
+    ROW 2 REAL VAR obliques; 
+    ROW 3 REAL VAR perspectives; 
+    get values (p,sizes,limits,angles,obliques,perspectives); 
+    set values (sizes,limits,angles,obliques,perspectives);
+    begin plot;
+    clear;
+    INT VAR i;
+    FOR i FROM 1 UPTO pictures (p)
+    REP PICTURE VAR act pic :: nilpicture;
+        to pic (p,i);
+        read picture (p,act pic);
+        IF pen (act pic) <> 0
+           THEN plot pic FI
+    PER;
+    end plot  .
+ 
+  plot pic:
+    INT VAR colour, thickness, linetype; 
+    BOOL VAR  hidden; 
+    selected pen (p,pen (act pic),colour,thickness,linetype,hidden); 
+    pen (background (p),colour,thickness,linetype); 
+    hidden lines (hidden);
+    plot (act pic).
+ 
+END PROC plot;
+
+PROC plot (PICTURE CONST p) :
+  IF channel <> channel (plotter) OR station (myself) <> station (plotter)
+     THEN errorstop ("PICTURES koennen nur direkt ausgegeben werden")
+     ELSE plot pic
+  FI.
+
+plot pic:
+  INT CONST pic length :: length (p);
+  TEXT CONST points :: subtext (text(p),5); 
+  read pos := 0;
+  IF dim (p) = 2
+  THEN plot two dim pic
+  ELSE plot three dim pic FI  .
+
+plot two dim pic:
+  WHILE read pos < pic length
+  REP plot two dim position PER  .
+
+plot two dim position :
+  read pos INCR 1;
+  SELECT code (points SUB read pos) OF
+  CASE draw key : draw (next real, next real)
+  CASE move key : move (next real, next real)
+  CASE move r key : move r (next real, next real)
+  CASE draw r key : draw r (next real, next real)
+  CASE move cm key : move cm (next real, next real)
+  CASE draw cm key : draw cm (next real, next real)
+  CASE move cm r key : move cm r (next real, next real)
+  CASE draw cm r key : draw cm r (next real, next real)
+  CASE text key : draw (next text, next real, next real, next real)
+  CASE bar key : bar (next real, next real, next int) 
+  CASE circle key : circle (next real, next real, next real, next int) 
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+plot three dim pic:
+  WHILE read pos < pic length
+  REP plot three dim position PER  .
+
+plot three dim position :
+  read pos INCR 1;
+  SELECT code (points SUB read pos) OF
+  CASE draw key : draw (next real, next real, next real)
+  CASE move key : move (next real, next real, next real)
+  CASE move r key : move r (next real, next real, next real)
+  CASE draw r key : draw r (next real, next real, next real)
+  CASE move cm key : move cm (next real, next real)
+  CASE draw cm key : draw cm (next real, next real)
+  CASE move cm r key : move cm r (next real, next real)
+  CASE draw cm r key : draw cm r (next real, next real)
+  CASE text key : draw (next text, next real, next real, next real)
+  CASE bar key : bar (next real, next real, next int) 
+  CASE circle key : circle (next real, next real, next real, next int) 
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+next real :
+  read pos INCR 8;
+  subtext (points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (points, read pos-1, read pos) ISUB 1  .
+
+next text :
+  INT CONST text length :: next int;
+  read pos INCR text length;
+  subtext (points, read pos-text length+1, read pos)  .
+ 
+END PROC plot;
+
+END PACKET plot
+
diff --git a/app/mpg/2.2/src/GRAPHIK.Turtle b/app/mpg/2.2/src/GRAPHIK.Turtle
new file mode 100644
index 0000000..efdacc7
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.Turtle
@@ -0,0 +1,139 @@
+(**************************************************************************) 
+(*                                                                        *) 
+(*                        MPG - Graphik - System                          *) 
+(*                                                                        *) 
+(*                      Version 2.1 vom 10.09.1987                        *) 
+(*                                                                        *) 
+(*            (c) 1987 Beat Jegerlehner & Carsten Weinholz                *) 
+(*                unter Verwendung der Standard-Graphik                   *) 
+(*            "Turtle-Graphik" geschrieben von B.Jegerlehner              *) 
+(*                                                                        *) 
+(**************************************************************************) 
+(*                                                                        *) 
+(*               Dieses Paket stellt eine LOGO-aehnliche                  *)
+(*                'Schildkroetengraphik' zur Verfuegung                   *)
+(*                                                                        *) 
+(**************************************************************************) 
+PACKET turtle graphics DEFINES begin turtle, 
+                               end   turtle, 
+                               forward     ,
+                               forward to  , 
+                               turn        , 
+                               turn to     , 
+                               pen up      , 
+                               pen down    ,
+                               pen         ,
+                               angle       ,
+                               get turtle  :
+ 
+REAL VAR x pos, 
+         y pos, 
+         winkel; 
+ 
+PICFILE VAR bild; 
+PICTURE VAR pic; 
+ 
+BOOL VAR direct, 
+         pen status;
+ 
+PROC begin turtle: 
+  direct := TRUE; 
+  x pos  := 0.0; 
+  y pos  := 0.0; 
+  winkel  := 0.0; 
+  begin plot;
+  clear;
+  viewport (0.0, 1.0, 0.0, 1.0);
+  window (-500.0, 500.0, -500.0, 500.0); 
+  pen up; 
+  forward to (0.0, 0.0) 
+END PROC begin turtle; 
+ 
+PROC begin turtle (TEXT CONST picfile): 
+  direct := FALSE; 
+  bild := picture file (picfile); 
+  pic  := nilpicture; 
+  x pos := 0.0; 
+  y pos := 0.0; 
+  winkel := 0.0; 
+  pen up; 
+  forward to (0.0,0.0) 
+END PROC begin turtle; 
+ 
+PROC end turtle: 
+  IF direct 
+    THEN end plot 
+    ELSE ausgabe 
+  FI. 
+ 
+  ausgabe: 
+    REAL VAR x cm,y cm; 
+    INT VAR dummy; 
+    put picture (bild,pic); 
+    drawing area (x cm,y cm,dummy,dummy); 
+    viewport (bild, 0.0, 1.0, 0.0, 1.0); 
+    window (bild, -500.0,500.0,-500.0,500.0); 
+    plot(bild) 
+END PROC end turtle; 
+ 
+PROC turn (REAL CONST w): 
+  winkel := (winkel + w) MOD 360.0 
+END PROC turn; 
+ 
+PROC turn to (REAL CONST w): 
+  winkel := w MOD 360.0
+END PROC turn to; 
+ 
+REAL PROC angle: 
+  winkel 
+END PROC angle; 
+
+PROC forward (REAL CONST len): 
+  forward to (x pos + cosd (winkel) * len, 
+      y pos + sind (winkel) * len) 
+END PROC forward; 
+ 
+PROC pen up: 
+  pen status := FALSE 
+END PROC pen up; 
+ 
+PROC pen down: 
+  pen status := TRUE 
+END PROC pen down; 
+ 
+BOOL PROC pen:
+  pen status 
+END PROC pen; 
+
+PROC forward to (REAL CONST x,y): 
+  IF direct 
+    THEN dir plot 
+    ELSE pic plot 
+  FI; 
+  x pos := x; 
+  y pos := y. 
+ 
+  dir plot: 
+    IF pen status
+      THEN draw (x,y) 
+      ELSE move (x,y) 
+    FI. 
+ 
+  pic plot: 
+    IF length (pic) > 1923 
+      THEN put picture (bild,pic); 
+           pic := nilpicture 
+    FI; 
+    IF pen status
+      THEN draw (pic,x,y) 
+      ELSE move (pic,x,y) 
+    FI 
+END PROC forward to;
+
+PROC get turtle (REAL VAR x,y): 
+  x := x pos;
+  y := y pos
+END PROC get turtle
+ 
+END PACKET turtle graphics
+
diff --git a/app/mpg/2.2/src/GRAPHIK.list b/app/mpg/2.2/src/GRAPHIK.list
new file mode 100644
index 0000000..09f6002
--- /dev/null
+++ b/app/mpg/2.2/src/GRAPHIK.list
@@ -0,0 +1,28 @@
+GRAPHIK.list 
+GRAPHIK.Install 
+GRAPHIK.Basis 
+GRAPHIK.Configurator 
+GRAPHIK.Plot 
+GRAPHIK.Manager 
+GRAPHIK.Fkt 
+GRAPHIK.Turtle 
+ZEICHENSATZ 
+FKT.help 
+Muster 
+std primitives 
+matrix printer 
+terminal plot 
+DATAGRAPH 3/7.GCONF 
+VIDEOSTAR 3/6.GCONF 
+AMPEX 2/1-6.GCONF 
+NEC P-3 3/15.GCONF 
+WATANABE 3/8.GCONF 
+VC 404 2/7.GCONF 
+NEC P-9 2/15.HD.GCONF 
+NEC P-9 2/15.MD.GCONF 
+Atari 3/9.GCONF 
+AMPEX 3/1-4.GCONF 
+ENVIRONMENT2.GCONF 
+ENVIRONMENT3.GCONF 
+
+
diff --git a/app/mpg/2.2/src/HERCULES XT.GCONF b/app/mpg/2.2/src/HERCULES XT.GCONF
new file mode 100644
index 0000000..a77a50e
--- /dev/null
+++ b/app/mpg/2.2/src/HERCULES XT.GCONF
@@ -0,0 +1,105 @@
+INCLUDE "std primitives"; 
+INCLUDE "terminal plot" ; 
+ 
+PLOTTER "HERCULES XT",1,1,720,348,24.5,18.5; 
+ 
+COLORS "000999"; 
+ 
+PROC clear: 
+  INT VAR return;
+  REP 
+     control(-5,512+0,0,return); 
+  UNTIL return <> -1 
+  PER; 
+  IF return <> 0 
+    THEN errorstop("Graphik nicht ansprechbar!") 
+  FI; 
+END PROC clear; 
+ 
+PROC prepare: 
+  break(quiet); 
+  REP disable stop; 
+      continue (channel(plotter)); 
+      clear error; 
+      enable stop; 
+      IF NOT online 
+        THEN pause(100) 
+      FI 
+  UNTIL online PER; 
+END PROC prepare; 
+ 
+PROC initplot: 
+END PROC initplot; 
+ 
+PROC endplot: 
+  INT VAR dummy; 
+  pause; 
+  control (-5,2,0, dummy); 
+END PROC endplot; 
+ 
+PROC home: 
+  moveto(0,347); 
+END PROC home; 
+ 
+PROC moveto(INT CONST x,y): 
+  INT VAR dummy; 
+  control (-7,x,(347-y),dummy);            (* move nach SHARD-AT *) 
+END PROC moveto; 
+ 
+PROC set pixel(INT CONST x,y): 
+  moveto(x,(347-y)); 
+  point; 
+END PROC set pixel; 
+ 
+PROC drawto(INT CONST x,y): 
+  INT VAR dummy; 
+  control(-6,x,(347-y),dummy);             (* draw nach SHARD-AT *) 
+END PROC drawto; 
+ 
+PROC foreground (INT VAR type): 
+  ROW 5 ROW 4 INT CONST nibble :: ROW 5 ROW 4 INT: 
+    (ROW 4 INT : ( 4369, 4369, 4369, 4369),     (* durhgezogene Linie *)
+     ROW 4 INT : (   17,   17,   17,   17),     (* gepunktete Linie   *) 
+     ROW 4 INT : ( 4369,    0, 4369,    0),     (* kurz gestrichelt   *) 
+     ROW 4 INT : ( 4369, 4369,    0,    0),     (* lang gestrichelt   *) 
+     ROW 4 INT : ( 4369, 4369, 4369,    0));    (* gestrichpunktet    *); 
+  INT VAR dummy; 
+  IF type > 5 OR type < 0 
+    THEN type := 0 
+  FI; 
+  IF type = 0 
+    THEN control( -9, 0, 0, dummy); 
+         control(-10, 0, 0, dummy);      (* loeschen *) 
+    ELSE control( -9, nibble[type][2], nibble[type][1], dummy); 
+         control(-10, nibble[type][4], nibble[type][3], dummy) 
+  FI; 
+END PROC foreground; 
+ 
+PROC background(INT VAR type): 
+  type := 0 
+END PROC background; 
+ 
+PROC setpalette:
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1,y1,x2,y2,pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+ 
+
+
+
+
+
+
+
+
+
+
diff --git a/app/mpg/2.2/src/Muster b/app/mpg/2.2/src/Muster
new file mode 100644
index 0000000..cebb35c
--- /dev/null
+++ b/app/mpg/2.2/src/Muster
@@ -0,0 +1,75 @@
+INCLUDE "Name der Include-Datei"; 
+ 
+PLOTTER "Plottername",<Station>,<Kanal>,<Xpixel>,<Ypixel>,<Xcm>,<Ycm>; 
+ 
+LINK <Station>/<Kanal>,<Station>/<Kanal>....; 
+ 
+COLORS "<RGB-Kombinationen als 3-Byte Codefolge>";
+ 
+  . 
+  . 
+  . 
+<Hier koennen Endgeraetspezifische Prozeduren/Variablen (globalebene) 
+ eingefuegt werden. Achtung! um Namenskonflikte mit globalobjekten 
+ anderer Endgeraete zu vermeiden sollten die Namen dieser Objekte 
+ auch stets den Endgeraet-Namen enthalten 
+ (z.B. 'TEXT PROC videostar koordinaten (INT CONST x,y)') 
+> 
+ 
+PROC initplot: 
+   Warnung: Da der Configurator den Prozedur-Rumpf in ein Refinement
+            verwandelt, muessen Namenskonflikte vermieden wrden !
+END PROC initplot;
+ 
+PROC endplot: 
+END PROC endplot; 
+
+PROC prepare: 
+END PROC prepare; 
+ 
+PROC clear: 
+END PROC clear; 
+ 
+PROC home: 
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+END PROC setpixel;
+
+PROC foreground (INT CONST type): 
+END PROC foreground;
+
+PROC background (INT CONST type):
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette:
+
+PROC circle (INT CONST x,y,rad,from,to): 
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+ 
+EDITOR; (* Durch EDITOR wird das optionale Vorhandensein nachfolgender 
+           Editor-Befehle angezeigt *) 
+ 
+PROC get cursor (INT VAR x,y,TEXT VAR exit char): 
+END PROC get cursor; 
+ 
+PROC graphik cursor (INT CONST x,y,BOOL CONST on): 
+END PROC graphik cursor; 
+ 
+PROC set marker (INT CONST x,y,type): 
+END PROC set marker;
+
+
diff --git a/app/mpg/2.2/src/NEC P-3 3-15.GCONF b/app/mpg/2.2/src/NEC P-3 3-15.GCONF
new file mode 100644
index 0000000..ecf052c
--- /dev/null
+++ b/app/mpg/2.2/src/NEC P-3 3-15.GCONF
@@ -0,0 +1,126 @@
+INCLUDE "std primitives"; 
+INCLUDE "matrix printer"; 
+ 
+PLOTTER "NEC P3",3,15,1024,1024,21.68,21.68;
+ 
+COLORS "000999";
+
+(*   Version vom 21.10.87 BJ  *)
+
+(******** Hilfsvariablen fuer nec-plot ***************)
+LET nec x pixel = 1024,nec y pixel d 16 = 64; 
+LET nec y max = 1023;
+LET BITLINE = ROW nec x pixel INT; 
+BOUND ROW nec y pixeld16 BITLINE VAR nec map; 
+BITLINE VAR nec nilline; 
+DATASPACE VAR nec ds;
+INT VAR nec x,nec y;
+(*****************************************************)
+ 
+PROC prepare: 
+   call (29, "", printer); (* wait for halt *) 
+   continue (channel (plotter))
+END PROC prepare;
+
+PROC initplot:
+     INT VAR nec i; 
+     FOR nec i FROM 1 UPTO nec x pixel REP 
+       nec nilline[nec i] := 0 
+     PER; 
+     forget(nec ds);
+     nec ds := nilspace;
+     nec map := nec ds;
+     disable stop
+END PROC initplot; 
+ 
+PROC endplot: 
+   out(""27"T16"); 
+   INT VAR nec i; 
+   FOR nec i FROM 1 UPTO necypixeld16 REP 
+       nec out line (nec i)
+   PER;
+   out(""12"");
+   break(quiet);
+   call (26,"",printer);  (* start spool *)
+   enable stop 
+END PROC endplot; 
+ 
+PROC nec out line (INT CONST i):
+   INT VAR c,j :: 1,d; 
+   WHILE j <= nec x pixel REP 
+      c := nec map[i][j]; 
+      d := 0;
+      WHILE j <= nec x pixel CAND nec map[i][j] = c REP 
+         j INCR 1;
+         d INCR 1
+      PER; 
+      IF j <= nec x pixel OR c <> 0 
+        THEN TEXT VAR t :: text(d,4);
+             change all(t," ","0");
+             INT VAR kk :: c;rotate(kk,8);
+             out(""27"W"+t+code(c AND 255) + code(kk AND 255)) 
+      FI
+   PER; 
+   out(""13""10"")
+END PROC nec out line; 
+ 
+PROC clear:
+   INT VAR nec i; 
+   FOR nec i FROM 1 UPTO nec y pixeld16 REP 
+       nec map[nec i] := nec nilline 
+   PER 
+END PROC clear; 
+ 
+PROC home:
+   move to (0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+      nec x := x;
+      nec y := y
+END PROC moveto; 
+ 
+PROC drawto (INT CONST x,y): 
+  printer line (nec x+1, nec y max - nec y,x+1,nec y max - y,
+                PROC (INT CONST, INT CONST) nec p3 set pixel); 
+   nec x:=x;nec y:=y
+END PROC drawto; 
+ 
+PROC setpixel (INT CONST x,y): 
+    setbit(nec map[(nec y max-y) DIV 16 + 1][x+1],(nec y max-y) AND 15) 
+END PROC setpixel;
+
+PROC nec p3 set pixel (INT CONST x,y):
+    set bit(nec map[y DIV 16 + 1][x],y AND 15)
+END PROC nec p3 set pixel;
+
+BOOL PROC nec p3 is pixel (INT CONST x,y):
+  bit (nec map[y DIV 16 + 1][x],y AND 15) 
+END PROC nec p3 is pixel;
+
+PROC foreground (INT VAR type): 
+   type := 1;    (* Nur Schwarz auf Weiss-Druck moeglich *)
+END PROC foreground;
+
+PROC background (INT VAR type):
+   type := 0;
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1, y1, x2, y2, pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+  printer fill (x,x,nec y max - y,1,
+                BOOL PROC (INT CONST, INT CONST) nec p3 is pixel,
+                PROC (INT CONST, INT CONST) nec p3 set pixel)
+END PROC fill;
+ 
+
diff --git a/app/mpg/2.2/src/NEC P-6 MD.GCONF b/app/mpg/2.2/src/NEC P-6 MD.GCONF
new file mode 100644
index 0000000..627ec31
--- /dev/null
+++ b/app/mpg/2.2/src/NEC P-6 MD.GCONF
@@ -0,0 +1,221 @@
+INCLUDE "std primitives"; 
+INCLUDE "matrix printer"; 
+ 
+PLOTTER "NEC P6 MD",1,15,1416,1760,20.00,25.00;
+ 
+COLORS "000999";
+ 
+(* Version vom 21.10.87 BJ/26.11.SvA *) 
+ 
+(* Globale Daten fuer NEC P6 *) 
+ 
+LET md p9 graf  = ""27"*"39"",    (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) 
+    md p9 feed  = ""28"3",        (* Zeilenabstand in 360 Pixel/Zoll setzen *) 
+    md p9 nlq   = ""27"x"1"",     (* NLQ Modus waehlen *) 
+    md p9 pos   = ""27"\";        (* in 1/180 Zoll-Schritten rel Positionieren *) 
+ 
+LET md p9 x max   = 1416, 
+    md p9 y max   = 1760, 
+    md p9 y lines = 110,         (* y pixel / 16 (Punkte pro INT) *) 
+    md p9 x per ds= 596,         (* Maximale x pixel pro Dataspace ( Darf *) 
+                                 (* Nicht mehr als 256 K sein !!!     *) 
+                                 (* x per ds = 256 * 1024 / p9 y lines / 4 *)
+    md p9 x lines = 3;           (* x pixel / hd p9 x per ds *) 
+ 
+LET MDPYLINE = ROW md p9 x per ds INT, 
+    MDPSMAP  = ROW md p9 y lines MDPYLINE, 
+    MDPMAP   = ROW md p9 x lines BOUND MDPSMAP; 
+ 
+MDPMAP VAR md p9 map; 
+
+ROW md p9 x lines DATASPACE VAR md p9 ds;
+
+INT VAR md p9 x pos, md p9 y pos;
+ 
+(* Globale Daten Ende *) 
+
+PROC prepare: 
+  REP 
+   call (29, "", printer); (* wait for halt *) 
+   IF task(channel(plotter)) = niltask   (* Es koennte der HD worker dran sein *) 
+     THEN continue (channel (plotter))   (* der startet den PRINTER wieder ! *) 
+     ELSE pause(300)                     (* folge : Kanal belegt -> dead *)
+   FI
+ UNTIL channel(myself) = channel(plotter) PER
+END PROC prepare;
+ 
+PROC initplot: 
+  INT VAR md p9 i; 
+  FOR md p9 i FROM 1 UPTO md p9 x lines REP 
+    md p9 ds[md p9 i] := nilspace; 
+    md p9 map[md p9 i] := md p9 ds[md p9 i]
+  PER
+END PROC initplot; 
+ 
+PROC endplot: 
+  md p9 put map;
+  break(quiet);
+  call (26, "", printer);  (* start spool *)
+  enable stop
+END PROC endplot; 
+ 
+PROC md p9 put map: 
+  open graf; 
+  put map; 
+  close graf;
+  forget dataspaces.
+ 
+  open graf: 
+    out(md p9 feed + ""32"");  (* LF auf 16/180 Zoll setzen *)
+    out(md p9 nlq).   (* NLQ Modus waehlen, damit Positionierung in 1/180 *) 
+                      (* Schritten geht (sonst 1/120) *) 
+  close graf: 
+    out(""12"").      (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) 
+                      (* eingestellt sein (EUMEL-DR macht kein FF) *) 
+ 
+  forget dataspaces: 
+    INT VAR i;
+    FOR i FROM 1 UPTO md p9 x lines REP 
+      forget(md p9 ds[i]) 
+    PER. 
+ 
+  put map: 
+    INT VAR j; 
+    FOR j FROM 1 UPTO md p9 y lines REP 
+      put line; 
+    PER. 
+ 
+  put line: 
+    INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*)
+            last pos;
+    WHILE actual pos <= md p9 x max REP 
+      put blank cols; 
+      put nonblank cols 
+    PER;
+    line.
+ 
+  put blank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= md p9 x max CAND actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos AND actual pos <= md p9 x max
+      THEN out blank cols 
+    FI. 
+ 
+  put nonblank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos
+      THEN out nonblank cols 
+    FI. 
+ 
+  out blank cols: 
+    TEXT VAR t :: "  "; 
+    replace(t, 1, actual pos - last pos); 
+    out (md p9 pos + t).
+ 
+  out nonblank cols: 
+    t := "  "; 
+    replace (t,1, actual pos - last pos); 
+    out(md p9 graf + t); 
+    INT VAR k;
+    FOR k FROM last pos UPTO actual pos - 1 REP
+      INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] 
+                                [(k MOD md p9 x per ds) + 1], 
+              first byte :: word; 
+      rotate (word, 8);
+      out (code (word));
+      out (code (first byte));
+      out (""0"")
+    PER.
+ 
+  actual col is blank: 
+    md p9  map [(actual pos DIV md p9 x per ds) + 1][j]
+               [(actual pos MOD md p9 x per ds) + 1] = 0 
+ 
+END PROC md p9 put map; 
+ 
+PROC clear: 
+  md p9 clear
+END PROC clear;
+
+PROC md p9 clear: 
+  create initline;
+  initialize all lines.
+
+  create initline: 
+    MDPYLINE VAR initline; 
+    INT VAR i; 
+    FOR i FROM 1 UPTO md p9 x per ds REP 
+      initline[i] := 0 
+    PER. 
+ 
+  initialize all lines: 
+    INT VAR k; 
+    FOR i FROM 1 UPTO md p9 x lines REP
+      FOR k FROM 1 UPTO md p9 y lines REP 
+        md p9 map[i][k] := initline 
+     PER
+   PER
+END PROC md p9 clear; 
+ 
+PROC home: 
+  move to (0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+  md p9 x pos := x;
+  md p9 y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  printer line (md p9 x pos,md p9 y max - md p9 y pos,
+                x, md p9 y max - y,
+                PROC (INT CONST, INT CONST) md p9 set pixel);
+  md p9 x pos := x;
+  md p9 y pos := y
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+  md p9 set pixel (x, md p9 y max - x)
+END PROC setpixel;
+
+PROC md p9 set pixel (INT CONST x,y):
+  setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 
+                    [(x MOD md p9 x per ds) + 1],15 - (y AND 15))
+END PROC md p9 set pixel;
+
+BOOL PROC md p9 is pixel (INT CONST x,y):
+  bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 
+                 [(x MOD md p9 x per ds) + 1],15 - (y AND 15))
+END PROC md p9 is pixel;
+
+PROC foreground (INT VAR type): 
+  type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+  type := 0
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+  std circle (x,y,rad,from,to) 
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+  std box (x1, y1, x2, y2, pattern)
+END PROC box; 
+
+PROC fill (INT CONST x,y,pattern): 
+  printer fill (x,x,md p9 y max - y,1, 
+                BOOL PROC (INT CONST, INT CONST) md p9 is pixel, 
+                PROC (INT CONST, INT CONST) md p9 set pixel) 
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF b/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF
new file mode 100644
index 0000000..552e298
--- /dev/null
+++ b/app/mpg/2.2/src/NEC P-9 2-15.HD.GCONF
@@ -0,0 +1,244 @@
+INCLUDE "std primitives"; 
+INCLUDE "matrix printer"; 
+ 
+PLOTTER "NEC P9 HD",2,15,2880,2880,20.32,20.32; 
+ 
+COLORS "000999";
+ 
+(* Version vom 21.10.87 BJ *)
+
+(* Globale Daten fuer NEC P9 *) 
+ 
+LET hd p9 graf  = ""27"*"40"",    (* Nec P9 in 24-Nadel 360 Pixel/zoll Modus *) 
+    hd p9 feed  = ""28"3",        (* Zeilenabstand in 360 Pixel/Zoll setzen *) 
+    hd p9 nlq   = ""27"x"1"",     (* NLQ Modus waehlen *) 
+    hd p9 pos   = ""27"\";        (* in 1/180 Zoll-Schritten rel Positionieren *) 
+
+LET hd p9 x max   = 2879, 
+    hd p9 y max   = 2879, 
+    hd p9 y lines = 90,          (* y pixel / 16 (Punkte pro INT) / 2 (Maps) *) 
+    hd p9 x per ds= 1440,        (* Maximale x pixel pro Dataspace ( Darf *) 
+                                 (* Nicht mehr als 256 K sein !!!     *) 
+                                 (* x per ds = 256 * 1024 / p9 y lines / 4 *)
+    hd p9 x lines = 2;           (* x pixel / hd p9 x per ds *) 
+ 
+LET HDPYLINE = ROW hd p9 x per ds INT, 
+    HDPSMAP  = ROW hd p9 y lines HDPYLINE, 
+    HDPMAP   = ROW hd p9 x lines ROW 2 BOUND HDPSMAP; 
+ 
+HDPMAP VAR hd p9 map; 
+
+ROW hd p9 x lines ROW 2 DATASPACE VAR hd p9 ds;
+
+INT VAR hd p9 x pos, hd p9 y pos;
+ 
+(* Globale Daten Ende *) 
+
+PROC prepare: 
+  REP 
+   call (29, "", printer); (* wait for halt *) 
+   IF task(channel(plotter)) = niltask   (* Es koennte der MD worker dran sein *) 
+     THEN continue (channel (plotter))   (* Der startet den PRINTER wieder ! *) 
+     ELSE pause(300)                     (* folge : Kanal belegt -> dead *)
+   FI
+ UNTIL channel(myself) = channel(plotter) PER
+END PROC prepare;
+ 
+PROC initplot: 
+  INT VAR hd p9 i,hd p9 j; 
+  FOR hd p9 i FROM 1 UPTO hd p9 x lines REP 
+    FOR hd p9 j FROM 1 UPTO 2 REP 
+      hd p9 ds[hd p9 i][hd p9 j] := nilspace; 
+      hd p9 map[hd p9 i][hd p9 j] := hd p9 ds[hd p9 i][hd p9 j]
+    PER
+  PER
+END PROC initplot; 
+ 
+PROC endplot: 
+  hd p9 put map;
+  break(quiet);
+  call (26, "", printer);  (* start spool *)
+  enable stop
+END PROC endplot; 
+ 
+PROC hd p9 put map: 
+  open graf; 
+  put map; 
+  close graf;
+  forget dataspaces.
+ 
+  open graf: 
+    out(hd p9 nlq).   (* NLQ Modus waehlen, damit Positionierung in 1/180 *) 
+                      (* Schritten geht (sonst 1/120) *) 
+  close graf: 
+    out(""12"").      (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) 
+                      (* eingestellt sein (EUMEL-DR macht kein FF) *) 
+ 
+  forget dataspaces: 
+    INT VAR i;
+    FOR i FROM 1 UPTO hd p9 x lines REP 
+      FOR j FROM 1 UPTO 2 REP 
+        forget(hd p9 ds[i][j]) 
+      PER 
+    PER. 
+ 
+  put map: 
+    INT VAR j,half; 
+    FOR j FROM 1 UPTO hd p9 y lines REP 
+      FOR half FROM 1 UPTO 2 REP 
+        open line; 
+        put half line; 
+        close line 
+      PER 
+    PER. 
+ 
+  open line: 
+    INT VAR actual pos :: 0, (* aktuelle x-pos 0..x max *)
+            last pos. 
+ 
+  close line: 
+    out(hd p9 feed); 
+    IF half = 1 
+      THEN out (""1"")           (* LF 1/360 Zoll *) 
+      ELSE out (""31"") 
+    FI; 
+    line. 
+ 
+  put half line: 
+    WHILE actual pos <= hd p9 x max REP 
+      put blank cols; 
+      put nonblank cols 
+    PER. 
+ 
+  put blank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= hd p9 x max CAND actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos AND actual pos <= hd p9 x max
+      THEN out blank cols 
+    FI. 
+ 
+  put nonblank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= hd p9 x max CAND NOT actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos
+      THEN out nonblank cols 
+    FI. 
+ 
+  out blank cols: 
+    IF actual pos - last pos > 1 
+      THEN TEXT VAR t :: "  "; 
+           replace(t, 1, (actual pos - last pos) DIV 2); 
+           out (hd p9 pos + t) 
+    FI; 
+    IF (actual pos - last pos) MOD 2 = 1 
+      THEN out (hd p9 graf + ""1""0"" + 3 * ""0"") 
+    FI. 
+ 
+  out nonblank cols: 
+    t := "  "; 
+    replace (t,1, actual pos - last pos); 
+    out(hd p9 graf + t); 
+    INT VAR k;
+    FOR k FROM last pos UPTO actual pos - 1 REP
+      INT VAR word :: hd p9 map [(k DIV hd p9 x per ds) + 1][half][j] 
+                                [(k MOD hd p9 x per ds) + 1], 
+              first byte :: word; 
+      rotate (word, 8);
+      out (code (word));
+      out (code (first byte));
+      out (""0"")
+    PER.
+ 
+  actual col is blank: 
+    hd p9  map [(actual pos DIV hd p9 x per ds) + 1][half][j]
+               [(actual pos MOD hd p9 x per ds) + 1] = 0 
+ 
+END PROC hd p9 put map; 
+ 
+PROC clear: 
+  hd p9 clear
+END PROC clear;
+
+PROC hd p9 clear: 
+  create initline;
+  initialize all lines.
+
+  create initline: 
+    HDPYLINE VAR initline; 
+    INT VAR i; 
+    FOR i FROM 1 UPTO hd p9 x per ds REP 
+      initline[i] := 0 
+    PER. 
+ 
+  initialize all lines: 
+    INT VAR j,k; 
+    FOR i FROM 1 UPTO hd p9 x lines REP
+      FOR j FROM 1 UPTO 2 REP 
+        FOR k FROM 1 UPTO hd p9 y lines REP 
+          hd p9 map[i][j][k] := initline 
+       PER 
+     PER
+   PER
+END PROC hd p9 clear; 
+ 
+PROC home: 
+  move to (0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+  hd p9 x pos := x;
+  hd p9 y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  printer line (hd p9 x pos,hd p9 y max - hd p9 y pos,
+                x, hd p9 y max - y,
+                PROC (INT CONST, INT CONST) hd p9 set pixel);
+  hd p9 x pos := x;
+  hd p9 y pos := y
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+  hd p9 set pixel (x, hd p9 y max - x)
+END PROC setpixel;
+
+PROC hd p9 set pixel (INT CONST x,y):
+  setbit (hd p9 map [(x DIV hd p9 x per ds) + 1][(y AND 1) + 1][(y DIV 32) + 1] 
+                    [(x MOD hd p9 x per ds) + 1],15 - ((y DIV 2) AND 15))
+END PROC hd p9 set pixel;
+
+BOOL PROC hd p9 is pixel (INT CONST x,y):
+  bit (hd p9 map [(x DIV hd p9 x per ds) + 1][(y AND 1) + 1][(y DIV 32) + 1] 
+                 [(x MOD hd p9 x per ds) + 1],15 - ((y DIV 2) AND 15))
+END PROC hd p9 is pixel;
+
+PROC foreground (INT VAR type): 
+  type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+  type := 0
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+  std circle (x,y,rad,from,to) 
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+  std box (x1, y1, x2, y2, pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+  printer fill (x,x, hd p9 y max - y, 1, 
+                BOOL PROC (INT CONST, INT CONST) hd p9 is pixel, 
+                PROC (INT CONST, INT CONST) hd p9 set pixel) 
+END PROC fill; 
+ 
+
diff --git a/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF b/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF
new file mode 100644
index 0000000..5a5fa03
--- /dev/null
+++ b/app/mpg/2.2/src/NEC P-9 2-15.MD.GCONF
@@ -0,0 +1,221 @@
+INCLUDE "std primitives"; 
+INCLUDE "matrix printer"; 
+ 
+PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644;
+ 
+COLORS "000999";
+
+(* Version vom 21.10.87 BJ *) 
+ 
+(* Globale Daten fuer NEC P9 *) 
+ 
+LET md p9 graf  = ""27"*"39"",    (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) 
+    md p9 feed  = ""28"3",        (* Zeilenabstand in 360 Pixel/Zoll setzen *) 
+    md p9 nlq   = ""27"x"1"",     (* NLQ Modus waehlen *) 
+    md p9 pos   = ""27"\";        (* in 1/180 Zoll-Schritten rel Positionieren *) 
+
+LET md p9 x max   = 2339, 
+    md p9 y max   = 1979, 
+    md p9 y lines = 124,         (* y pixel / 16 (Punkte pro INT) *) 
+    md p9 x per ds= 780,         (* Maximale x pixel pro Dataspace ( Darf *) 
+                                 (* Nicht mehr als 256 K sein !!!     *) 
+                                 (* x per ds = 256 * 1024 / p9 y lines / 4 *)
+    md p9 x lines = 3;           (* x pixel / hd p9 x per ds *) 
+ 
+LET MDPYLINE = ROW md p9 x per ds INT, 
+    MDPSMAP  = ROW md p9 y lines MDPYLINE, 
+    MDPMAP   = ROW md p9 x lines BOUND MDPSMAP; 
+ 
+MDPMAP VAR md p9 map; 
+
+ROW md p9 x lines DATASPACE VAR md p9 ds;
+
+INT VAR md p9 x pos, md p9 y pos;
+ 
+(* Globale Daten Ende *) 
+
+PROC prepare: 
+  REP 
+   call (29, "", printer); (* wait for halt *) 
+   IF task(channel(plotter)) = niltask   (* Es koennte der HD worker dran sein *) 
+     THEN continue (channel (plotter))   (* der startet den PRINTER wieder ! *) 
+     ELSE pause(300)                     (* folge : Kanal belegt -> dead *)
+   FI
+ UNTIL channel(myself) = channel(plotter) PER
+END PROC prepare;
+ 
+PROC initplot: 
+  INT VAR md p9 i; 
+  FOR md p9 i FROM 1 UPTO md p9 x lines REP 
+    md p9 ds[md p9 i] := nilspace; 
+    md p9 map[md p9 i] := md p9 ds[md p9 i]
+  PER
+END PROC initplot; 
+ 
+PROC endplot: 
+  md p9 put map;
+  break(quiet);
+  call (26, "", printer);  (* start spool *)
+  enable stop
+END PROC endplot; 
+ 
+PROC md p9 put map: 
+  open graf; 
+  put map; 
+  close graf;
+  forget dataspaces.
+ 
+  open graf: 
+    out(md p9 feed + ""32"");  (* LF auf 16/180 Zoll setzen *)
+    out(md p9 nlq).   (* NLQ Modus waehlen, damit Positionierung in 1/180 *) 
+                      (* Schritten geht (sonst 1/120) *) 
+  close graf: 
+    out(""12"").      (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) 
+                      (* eingestellt sein (EUMEL-DR macht kein FF) *) 
+ 
+  forget dataspaces: 
+    INT VAR i;
+    FOR i FROM 1 UPTO md p9 x lines REP 
+      forget(md p9 ds[i]) 
+    PER. 
+ 
+  put map: 
+    INT VAR j; 
+    FOR j FROM 1 UPTO md p9 y lines REP 
+      put line; 
+    PER. 
+ 
+  put line: 
+    INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*)
+            last pos;
+    WHILE actual pos <= md p9 x max REP 
+      put blank cols; 
+      put nonblank cols 
+    PER;
+    line.
+ 
+  put blank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= md p9 x max CAND actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos AND actual pos <= md p9 x max
+      THEN out blank cols 
+    FI. 
+ 
+  put nonblank cols: 
+    last pos := actual pos; 
+    WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP 
+      actual pos INCR 1 
+    PER; 
+    IF actual pos > last pos
+      THEN out nonblank cols 
+    FI. 
+ 
+  out blank cols: 
+    TEXT VAR t :: "  "; 
+    replace(t, 1, actual pos - last pos); 
+    out (md p9 pos + t).
+ 
+  out nonblank cols: 
+    t := "  "; 
+    replace (t,1, actual pos - last pos); 
+    out(md p9 graf + t); 
+    INT VAR k;
+    FOR k FROM last pos UPTO actual pos - 1 REP
+      INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] 
+                                [(k MOD md p9 x per ds) + 1], 
+              first byte :: word; 
+      rotate (word, 8);
+      out (code (word));
+      out (code (first byte));
+      out (""0"")
+    PER.
+ 
+  actual col is blank: 
+    md p9  map [(actual pos DIV md p9 x per ds) + 1][j]
+               [(actual pos MOD md p9 x per ds) + 1] = 0 
+ 
+END PROC md p9 put map; 
+ 
+PROC clear: 
+  md p9 clear
+END PROC clear;
+
+PROC md p9 clear: 
+  create initline;
+  initialize all lines.
+
+  create initline: 
+    MDPYLINE VAR initline; 
+    INT VAR i; 
+    FOR i FROM 1 UPTO md p9 x per ds REP 
+      initline[i] := 0 
+    PER. 
+ 
+  initialize all lines: 
+    INT VAR k; 
+    FOR i FROM 1 UPTO md p9 x lines REP
+      FOR k FROM 1 UPTO md p9 y lines REP 
+        md p9 map[i][k] := initline 
+     PER
+   PER
+END PROC md p9 clear; 
+ 
+PROC home: 
+  move to (0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+  md p9 x pos := x;
+  md p9 y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  printer line (md p9 x pos,md p9 y max - md p9 y pos,
+                x, md p9 y max - y,
+                PROC (INT CONST, INT CONST) md p9 set pixel);
+  md p9 x pos := x;
+  md p9 y pos := y
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+  md p9 set pixel (x, md p9 y max - x)
+END PROC setpixel;
+
+PROC md p9 set pixel (INT CONST x,y):
+  setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 
+                    [(x MOD md p9 x per ds) + 1],15 - (y AND 15))
+END PROC md p9 set pixel;
+
+BOOL PROC md p9 is pixel (INT CONST x,y):
+  bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] 
+                 [(x MOD md p9 x per ds) + 1],15 - (y AND 15))
+END PROC md p9 is pixel;
+
+PROC foreground (INT VAR type): 
+  type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+  type := 0
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+  std circle (x,y,rad,from,to) 
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+  std box (x1, y1, x2, y2, pattern)
+END PROC box; 
+
+PROC fill (INT CONST x,y,pattern): 
+  printer fill (x,x,md p9 y max - y,1, 
+                BOOL PROC (INT CONST, INT CONST) md p9 is pixel, 
+                PROC (INT CONST, INT CONST) md p9 set pixel) 
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/PUBLIC.insert b/app/mpg/2.2/src/PUBLIC.insert
new file mode 100644
index 0000000..9fb98a6
--- /dev/null
+++ b/app/mpg/2.2/src/PUBLIC.insert
@@ -0,0 +1,3412 @@
+(* Rainer Kottmann  *) 
+(* Klaus Bovermann  *) 
+(* Lutz Prechelt    *) 
+(* Carsten Weinholz *)
+(* 19.06.87         *) 
+ 
+(* Pakete :   1. mpg test elan programs 
+              2. mpg archive system    <---  **************************
+              3. mpg some              <---  Sind für seperaten Hamster 
+              4. mpg dm                <---  notwendig.
+              5. mpg tools             <---  **************************
+              6. mpg target handling 
+              7. mpg print cmd 
+              8. edit monitor 
+              9. mpg global manager *) 
+ 
+(************************* ELAN TEST ****************************) 
+ 
+PACKET mpg test elan programs DEFINES elan test :
+
+LET  scan end           = 7,
+     in comment         = 8,
+     in text            = 9,
+     bold               = 2,
+     char               = 4,
+     delimiter          = 6,
+     limit              = 77,
+     max denoter length = 255,
+     end bolds     = "ENDIFIENDSELECTENDREPEATPERENDPROCEDURENDPACKETENDOP",
+     w                  = "WARNING: ",
+     e                  = "ERROR  : ";
+
+INT  VAR zeile;
+FILE VAR err;
+TEXT VAR last error;
+
+
+PROC elan test :
+  elan test (last param)
+END PROC elan test;
+
+PROC elan test (TEXT CONST datei) :
+  INT  VAR byte :: 0, kbyte :: 0, (* Byte/Kilobyte der EUMEL Datei      *)
+           sbyte:: 0, skbyte:: 0, (* Byte/Kilobyte des Elan Quelltextes *)
+           denoter length :: 0, units :: 0, typ, scan operations :: 0,
+           round brackets :: 0, square brackets :: 0; (* Klammerzaehler *) 
+  TEXT VAR in, symbol;
+  FILE VAR inputfile :: sequential file (input , datei);
+  err := note file;
+  zeile := 0;
+  last error := "";
+  scan (""); next symbol (in);
+  WHILE NOT eof (inputfile) REP
+    naechste zeile;
+    analyse;
+    in := incharety
+  UNTIL in <> "" PER;
+  IF in <> ""
+  THEN putline (err, "***  ELAN TEST VORZEITIG ABGEBROCHEN ***")  FI;
+  last error := "";
+  ausgabe der enddaten;
+  modify (inputfile);
+  note edit (inputfile);
+  line.
+
+naechste zeile :
+  getline (inputfile , in);
+  continue scan (in);
+  byte  INCR LENGTH in;
+  kbyte INCR byte DIV 1000;
+  byte  := byte MOD 1000;
+  zeile INCR 1; cout (zeile);
+  IF LENGTH in > limit
+  THEN error (w + "line exceeding screen")
+  FI.
+
+analyse :
+  REPEAT
+    next symbol (symbol, typ);
+    scan operations INCR 1;
+    analysiere symbol
+  UNTIL typ >= scan end
+  PER;
+  IF typ = in comment
+  THEN error (w + "comment exceeding line")
+  FI;
+  IF typ = in text
+  THEN denoter length INCR LENGTH symbol;
+       IF denoter length > max denoter length
+       THEN error (e + "text denoter too long (" + text (denoter length) +
+                       " characters)")
+       ELSE error (w + "text denoter exceeding source line")
+       FI
+  ELSE denoter length := 0
+  FI;
+  skbyte INCR sbyte DIV 1000;
+  sbyte  := sbyte MOD 1000.
+
+analysiere symbol :
+  IF   typ = scan end    THEN test brackets
+  ELIF typ = delimiter   THEN delimiters
+  ELIF typ = char
+  THEN denoter length INCR LENGTH symbol;
+       IF denoter length > max denoter length
+       THEN error (e + "text denoter too long (" + text (denoter length) +
+                       " characters)")
+       FI
+  ELIF typ = bold CAND pos (endbolds, symbol) <> 0 
+  THEN unitend
+  FI;
+  sbyte INCR LENGTH symbol.
+
+test brackets :
+  IF round brackets <> 0
+  THEN error (w + text (round brackets) + " ""("" open")
+  FI;
+  IF square brackets <> 0
+  THEN error (w + text (square brackets) + " ""["" open")
+  FI.
+
+delimiters :
+  IF   symbol = ";" OR (symbol = "." AND is refinement)
+  THEN unitend
+  ELIF symbol = "(" THEN round  brackets INCR 1
+  ELIF symbol = ")" THEN round  brackets DECR 1
+  ELIF symbol = "[" THEN square brackets INCR 1
+  ELIF symbol = "]" THEN square brackets DECR 1
+  FI.
+
+unitend :
+  units INCR 1;
+  IF round brackets <> 0
+  THEN error (e + text (round brackets) + " ""("" open at end of unit");
+    round brackets := 0
+  FI;
+  IF square brackets <> 0
+  THEN error (e + text (square brackets) + " ""["" open at end of unit");
+    square brackets := 0
+  FI.
+
+is refinement :   FALSE.    (* vorlaeufig *)
+
+ausgabe der enddaten :
+  line (err);
+  putline (err, 77 * "=");
+  putline (err, "EUMEL - Datei     :  " + text (zeile) + " Zeilen ,  " +
+                bytes (kbyte, byte));
+  putline (err, "Elan  - Quelltext :  " + text (units) + " Units  ,  " + 
+                bytes (skbyte, sbyte));
+  putline (err, text (scan operations) +
+                " Scanner - Operationen durchgefuehrt.");
+  putline (err, 77 * "=").
+END PROC elan test;
+ 
+PROC error (TEXT CONST error message) :
+  IF error message = last error
+  THEN putline (err, "dito   " + text (zeile));
+       IF online THEN put (zeile); putline ("dito")  FI;
+       LEAVE error  FI;
+  last error := error message;
+  putline (err, "EOLN " + text (zeile) + "  " + error message);
+  IF online THEN put (zeile); putline (error message)  FI
+END PROC error;
+
+TEXT PROC bytes (INT CONST kilobytes, bytes) :
+  TEXT VAR t :: text (kilobytes);
+  IF   bytes < 10  THEN t CAT "00"
+  ELIF bytes < 100 THEN t CAT "0"
+  FI;
+  t CAT text (bytes);
+  t CAT " Byte";
+  t
+END PROC bytes
+
+END PACKET mpg test elan programs;
+
+(************************* ARCHIV **********************************)
+ 
+PACKET mpg archive system DEFINES reserve, archive, release, 
+                                  archiv, archiv name,archiv error,
+                                  archiv angemeldet,
+                                  from, to,
+                                  pla : 
+ 
+ 
+LET archive 0 code      = 90,
+    archive 1 code      = 91,
+    altos archive 0     =  0,
+    altos archive 1     =  1,
+    bicos archive 0     =  2, 
+    altos station       =  1, 
+    free code           = 20,
+    reserve code        = 19, 
+    type                = "#type (""micron"")#",
+    configurator        = "configurator";
+
+BOOL VAR angemeldet;
+TEXT VAR err :: "";
+
+(************************ Standard - Prozeduren ****************************)
+(* Erlaubt jedoch nur eine ARCHIVE-Task                                    *)
+ 
+PROC reserve (TASK CONST task): 
+  reserve ("", task) 
+END PROC reserve; 
+ 
+PROC reserve (TEXT CONST msg, TASK CONST task): 
+   IF task = archive 
+      THEN angemeldet := TRUE 
+   FI; 
+   call (reserve code, msg, task) 
+END PROC reserve; 
+ 
+PROC archive (TEXT CONST name): 
+   reserve (name, archive) 
+END PROC archive; 
+ 
+PROC archive (TEXT CONST name, INT CONST station): 
+   reserve (name,station/archive) 
+END PROC archive; 
+ 
+PROC archive (TEXT CONST name, TASK CONST task): 
+   reserve (name, task) 
+END PROC archive; 
+
+PROC release (TASK CONST task): 
+   call (free code, "", task); 
+   IF task = archive 
+      THEN angemeldet := FALSE 
+   FI 
+END PROC release; 
+ 
+PROC release : 
+  release (archive);
+END PROC release; 
+
+PROC archiv (INT CONST nr): 
+   SELECT nr OF 
+     CASE altos archive 0, altos archive 1: altos anmelden 
+     CASE bicos archive 0                 : archiv
+     OTHERWISE unbekannte laufwerksnummer 
+   END SELECT. 
+ 
+   altos anmelden: 
+     IF station (myself) <> altos station 
+        THEN unbekannte laufwerksnummer
+     ELSE reserve (archive); 
+          SELECT nr OF 
+            CASE altos archive 0: call (archive 0 code, "",task(configurator)) 
+            CASE altos archive 1: call (archive 1 code, "",task(configurator)) 
+          END SELECT; 
+          archiv
+     FI. 
+
+   unbekannte laufwerksnummer:
+     errorstop ("Unbekannte Laufwerksnummer") 
+END PROC archiv;
+
+PROC archiv :
+  angemeldet := TRUE;
+  TEXT CONST name :: archiv name;
+  IF err = ""
+    THEN display ("Gefundenes Archiv: """ + name + """");
+    ELSE errorstop (err)
+  FI;
+  display (""13""10"").
+ 
+END PROC archiv;
+ 
+BOOL PROC archiv angemeldet: 
+   angemeldet 
+END PROC archiv angemeldet; 
+ 
+TEXT PROC archiv name: 
+  TEXT VAR name :: ""; 
+  THESAURUS VAR th;
+  IF NOT angemeldet 
+   THEN errorstop ("Archiv nicht angemeldet");"" 
+   ELSE angemeldet := FALSE;
+        err := "";
+        disable stop;
+        archive ("");
+        IF is error 
+         THEN err := errormessage; 
+              LEAVE archiv name WITH "" 
+        FI;
+        th := ALL archive; 
+        richtigen namen suchen;
+        clear error;
+        enable stop;
+        archive (name); 
+        angemeldet := TRUE;
+        name
+  FI.
+ 
+richtigen namen suchen:
+  IF subtext (error message, 1, 13) = "Archiv heisst"
+    THEN name := subtext (error message, 16, LENGTH error message - 1)
+    ELSE err  := error message
+  FI
+END PROC archiv name; 
+ 
+TEXT PROC archiv error: 
+  err 
+END PROC archiv error;
+ 
+PROC from (TEXT CONST name) :
+  fetch (name, archive)
+END PROC from; 
+ 
+PROC to (TEXT CONST name) : 
+  BOOL CONST cd :: command dialogue;
+  command dialogue (FALSE);
+  save (name, archive);
+  command dialogue (cd)
+END PROC to;
+
+PROC to : 
+  to (last param) 
+END PROC to;
+
+PROC from (THESAURUS CONST nameset): 
+  fetch (nameset, archive) 
+END PROC from; 
+ 
+PROC to (THESAURUS CONST nameset): 
+  BOOL CONST cd :: command dialogue;
+  command dialogue (FALSE);
+  save (nameset, archive);
+  command dialogue (cd)
+END PROC to; 
+ 
+PROC pla:
+  LET dummy name pos = 18;
+
+  FILE VAR listfile;
+  INT  VAR i;
+  TEXT CONST head :: 70 * "=",
+             end  :: 70 * "_";
+  TEXT VAR   record;
+  WHILE yes ("Archiv eingelegt") REP
+    print archive listing
+  PER;
+  release.
+
+print archive listing:
+  archiv;
+  listfile := sequential file (output , "PLA");
+  list (listfile, archive);
+  print head;
+  erase dummy names;
+  print bottom;
+  print and erase listing.
+
+print head :
+  modify (listfile);
+  to line (listfile, 1);
+  FOR i FROM 1 UPTO 6 REP
+    insert record (listfile)
+  PER;
+  to line (listfile, 1);
+  write record (listfile, type); down (listfile);
+  write record (listfile, head); down (listfile);
+  write record (listfile, "ARCHIVNAME: "+headline (listfile) + "  " +
+                time of day  +"  " + date ); down (listfile);
+  write record (listfile, head); down (listfile);
+  write record (listfile, " "); down (listfile);
+  write record (listfile, "Date      Store  Contents").
+
+erase dummy names :
+  to line (listfile, 6);
+  WHILE NOT eof (listfile) REP
+    read record (listfile, record);
+    IF (record SUB dummy name pos) = "-"
+      THEN delete record (listfile)
+      ELSE down (listfile) 
+    FI 
+  PER.
+
+print bottom :
+   output (listfile);
+   putline (listfile, end).
+
+print and erase listing :
+  modify (listfile);
+  edit (listfile);
+  line (3);
+  IF yes ("Archivlisting drucken")
+    THEN print ("PLA")
+  FI;
+  forget ("PLA", quiet)
+END PROC pla
+
+END PACKET mpg archive system;
+ 
+(************************ MPG SOME TOOLS *********************) 
+
+PACKET mpg some                      (*************************) 
+                                     (* Klaus Bovermann       *) 
+                                     (* Andreas Dieckmann     *) 
+                                     (* Thomas Clermont       *) 
+                                     (* Version 3.2           *) 
+                                     (* EUMEL   1.8.1         *) 
+                                     (* Datum:  21.10.87      *) 
+                                     (*************************) 
+  
+DEFINES some, SOME,                  (* in mehreren Versionen *) 
+        one,                         (* in mehreren Versionen *) 
+        inchar,                      (*                       *) 
+        center,                      (* Hilfsroutinen         *) 
+        invers ,                     (*                       *) 
+        edit some,                   (* fuer Anfaenger        *) 
+        edit one,                    (* fuer Anfaenger        *) 
+
+        reorganize:                  (* auf Thesaurus         *)
+ 
+LET max bild laenge = 80; 
+ 
+TEXT PROC center (TEXT CONST n): 
+  center (n," ",max bild laenge - 1) 
+END PROC center; 
+ 
+TEXT PROC center (TEXT CONST n,fuell zeichen,INT CONST max text laenge): 
+  TEXT VAR fuell text :: 
+       ((max text laenge - length (n)) DIV 2) * fuell zeichen; 
+  fuelltext CAT (n + fuelltext); 
+  IF (LENGTH fuelltext) - max text laenge = 0 
+   THEN fuelltext 
+   ELSE fuelltext + fuellzeichen 
+  FI 
+END PROC center; 
+ 
+TEXT PROC invers (TEXT CONST n): 
+  mark ein + n + " " + mark aus 
+END PROC invers; 
+ 
+PROC inchar (TEXT VAR t, TEXT CONST allowed chars): 
+  enable stop;
+  REP getchar (t);                 (* Auslesen nur aus virtuellem Puffer *) 
+      IF pos (allowed chars,t) = 0 
+         THEN out (""7"") 
+      FI 
+  UNTIL pos (allowed chars,t) <> 0 PER
+END PROC inchar; 
+ 
+(*********************************************************************) 
+ 
+LET min zeilen          =   3,
+    bildschirm          =  24, 
+    min x size          =  30,
+    max entries         = 200; 
+ 
+LET trennzeichen                      = ""222"",   (* ESC # *) 
+    zeichenstring                     = ""1""27""3""10""13"x"12"o?"11"", 
+    oben unten rubout o return x      = ""3""10""12"o"13"x", 
+    q eins neun a return x rubout o s = "q19a"13"x"12"os"; 
+ 
+LET mark ein          = ""15"", 
+    mark aus          = ""14""; 
+  
+LET stdtext1 = "Auswahl einer Datei ",
+    stdtext2 = "Auswahl mehrerer Dateien ",
+    stdhelp  = "( Bei Unklarheiten bitte <?> )";
+ 
+LET hop   = 1, 
+    esc   = 2, 
+    obe   = 3, 
+    unt   = 4, 
+    ank   = 5, 
+    ank 1 = 6, 
+    aus   = 7, 
+    aus 1 = 8, 
+    fra   = 9, 
+    ins   = 10; 
+ 
+LET filetype = 1003; 
+ 
+INT  VAR anzahl,               begin x,begin y,
+         kopf zeilen ,         size  x,size y,
+         max eintraege,        
+         realc, 
+         virtc; 
+ 
+TEXT VAR string, 
+         weitertext,
+         niltext,
+         kopfzeilen text, 
+         kz1,  
+         kz2;  
+ 
+BOOL VAR raender, 
+         auswahlende, 
+         abbruch; 
+ 
+ROW max entries TEXT VAR eintrag; 
+ 
+THESAURUS VAR gesamt liste; 
+FILE VAR tools info; 
+DATASPACE VAR tools info ds; 
+ 
+INITFLAG VAR init tools info; 
+ 
+(******************* Grundlegende Prozedur *************************) 
+ 
+THESAURUS PROC einzelne (THESAURUS CONST t, BOOL CONST viele, 
+                         TEXT CONST k1,
+                         INT CONST x begin,y begin, 
+                                   x size ,y size): 
+   begin x    := x begin; 
+   begin y    := y begin; 
+   size x     := x size;
+   size y     := y size;
+   kz1        := k1; 
+   string     := ""; 
+   raender    := FALSE;
+   gen kopf zeilen; 
+   IF groesster editor > 0 
+      THEN INT VAR x,y; 
+           get edit cursor (x,y) ; 
+           IF bildschirm - kopfzeilen - min zeilen + 1 < y 
+              THEN begin y       := 1; 
+                   size y        := 24;
+                   begin x       := 1;
+                   size x        := 79
+              ELSE begin y       := y; 
+                   size y        := bildschirm - y + 1;
+                   max eintraege := size y - min zeilen - kopfzeilen;
+                   IF (80 - x) < min x size OR col = 1
+                     THEN begin x        := 1; 
+                          size x         := 79
+                     ELSE raender        := TRUE; 
+                          begin x        := x;
+                          size x         := 80 - x - 2
+                   FI
+           FI;
+           gen kopfzeilen
+   FI; 
+   IF (size y - kopf zeilen) < min zeilen OR 
+                     begin y < 0          OR 
+      (begin y + size y - 1) > bildschirm OR
+      (begin x + size x - 1) > 79
+      THEN errorstop ("Fenster zu klein") 
+   FI; 
+   init weitertext;
+   init niltext;
+   THESAURUS VAR ausgabe :: empty thesaurus; 
+   gesamt liste := t; 
+   INT VAR i; 
+   anzahl := 0; 
+   FOR i FROM 1 UPTO highest entry (t) REP 
+     IF name (t,i) <> "" 
+        THEN anzahl INCR 1; 
+             eintrag [anzahl] := name (t,i) 
+     FI 
+   PER; 
+   IF anzahl = 0 THEN LEAVE einzelne WITH ausgabe FI; 
+   bild aufbauen; 
+   abbruch := FALSE; 
+   kreuze an (viele); 
+   IF abbruch 
+      THEN LEAVE einzelne WITH ausgabe 
+   FI; 
+   cursor (begin x,begin y + size y - 1); 
+   out (niltext); (* Folgende Ausgaben werden sonst unleserlich *) 
+   ausgabe erzeugen; 
+   ausgabe. 
+  
+ausgabe erzeugen: 
+  TEXT VAR nam; 
+  WHILE string <> "" REP 
+        nam := subtext (string,1,3); 
+        string := subtext (string,5); 
+        insert (ausgabe, eintrag [int (nam)]) 
+  PER 
+END PROC einzelne; 
+ 
+PROC realcursor setzen: 
+  cursor (begin x,kopf zeilen + realc + begin y); 
+  IF raender
+   THEN out ("|")
+  FI;
+  out (marke (virtc, TRUE) + 6 * ""8"") 
+END PROC real cursor setzen; 
+ 
+TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor): 
+  INT VAR pl :: nr (zeiger); 
+  IF pl = 0 
+     THEN leer 
+     ELSE mit zahl 
+  FI. 
+ 
+mit zahl: 
+  IF mit cursor 
+     THEN (3-length(text(pl))) * "-" + text (pl) + "-> " 
+     ELSE text (pl,3) + " > " 
+  FI. 
+ 
+leer: 
+  IF mit cursor 
+     THEN "----> " 
+     ELSE 6 * " " 
+  FI 
+END PROC marke; 
+ 
+PROC init weitertext: 
+  weitertext := "----> " + mark ein + "weitere  Eintraege " + mark aus  
+                         + ((size x - 27) * "-") 
+END PROC init weitertext; 
+ 
+PROC init niltext: 
+  IF size x > 78 
+    THEN niltext := ""5"" 
+    ELSE IF raender 
+           THEN niltext := ((size x + 2) * " " + (size x + 2) * ""8"")
+           ELSE niltext := (size x * " " + size x * ""8"")
+         FI
+  FI
+END PROC init niltext; 
+ 
+PROC bild (INT CONST anfang): 
+  INT VAR i; 
+  gib oberlinie aus; 
+  FOR i FROM anfang UPTO grenze REP 
+     cursor (begin x,kopfzeilen + begin y + i - anfang + 1);
+     rand;
+     out (marke (i, FALSE)); 
+     IF LENGTH ("""" + eintrag [i] + """") <= (size x - 6) 
+       THEN out (text ("""" + eintrag [i] + """",size x - 6)) 
+       ELSE out (text ("""" + eintrag [i],size x - 10) + " ...")
+     FI;
+     rand
+  PER; 
+  gib unterlinie aus; 
+  IF grenze < (anfang + max eintraege)
+     THEN FOR i FROM 0 UPTO (anfang + max eintraege - anzahl - 1) REP
+           cursor (begin x,begin y + kopfzeilen + i +
+                           grenze - anfang + min zeilen);
+           out (niltext) 
+          PER
+  FI. 
+  
+gib oberlinie aus: 
+  cursor (begin x,kopfzeilen + begin y); 
+  rand;
+  IF realc = virtc 
+     THEN out (size x * "-") 
+     ELSE out (weitertext) 
+  FI;
+  rand.
+  
+gib unterlinie aus: 
+  cursor (begin x,begin y + grenze - anfang + kopfzeilen + min zeilen - 1);
+  rand;
+  IF anzahl <= (anfang + max eintraege)
+     THEN out (size x * "-") 
+     ELSE out (weitertext) 
+  FI;
+  rand.
+ 
+grenze: 
+  min (anzahl,anfang + max eintraege).
+ 
+END PROC bild; 
+ 
+PROC gen kopfzeilen: 
+  kopfzeilen := 0; 
+  kopfzeilen text := ""; 
+  kopfzeilen text CAT code (0);
+  IF   pos (kz1,trenn zeichen) > 0 
+       THEN analysiere kopfzeile 
+  ELIF kz1 <> "" AND length (kz1) <= size x
+       THEN kopfzeilen text := kz1 + code (1);
+            kopf zeilen := 1 
+  ELIF kz1 <> "" 
+       THEN analysiere kopfzeile 
+  FI; 
+  IF kopfzeilen > size y - min zeilen 
+     THEN kopfzeilen := size y - min zeilen 
+  FI; 
+  max eintraege := size y - kopfzeilen - min zeilen.
+ 
+analysiere kopfzeile: 
+   kz2 := compress (kz1); 
+   BOOL VAR mark is on :: FALSE;
+   TEXT VAR einschub;
+   REP kopf zeilen INCR 1; 
+       kontrolliere pos; 
+       einschub := subtext(kz2,1,pos (kz2,trennzeichen)-1);
+       kontrolliere auf markiert;
+       kopfzeilen text CAT einschub;
+       kopfzeilen text CAT code (kopf zeilen);
+       kz2 := compress (subtext(kz2,pos (kz2,trennzeichen) + 1));
+   UNTIL NOT (length (kz2) > size x OR pos (kz2,trennzeichen) > 0 )PER; 
+   IF kz2 <> "" 
+      THEN einschub := kz2; 
+           kontrolliere auf markiert; 
+           kopfzeilen text CAT einschub;
+           kopf zeilen INCR 1 
+   FI; 
+   kopfzeilentext CAT code (kopfzeilen).
+ 
+muss noch getrennt werden: 
+ (pos (kz2,trennzeichen) > size x OR  pos (kz2,trennzeichen) = 0)
+                                  AND length (kz2) > size x. 
+
+kontrolliere pos: 
+  IF muss noch getrennt werden
+     THEN trenne kopfzeile
+  FI. 
+ 
+trenne kopfzeile: 
+  INT VAR i; 
+  FOR i FROM size x DOWNTO (size x DIV 2) REP
+  UNTIL (kz2 SUB i) = " " PER; 
+  kz2 := subtext (kz2,1,i) + trennzeichen + subtext (kz2,i+1).
+ 
+kontrolliere auf markiert: 
+  IF mark is on 
+    THEN kopfzeilen text CAT mark ein;
+         IF pos (einschub,mark aus) > 0 AND pos (einschub,mark ein) = 0
+           THEN mark is on := FALSE 
+         FI 
+    ELSE IF pos (einschub,mark ein) > 0 
+           THEN IF pos (einschub,mark aus) = 0 
+                  THEN einschub CAT mark aus; 
+                       mark is on := TRUE 
+                FI
+         FI 
+  FI. 
+ 
+END PROC gen kopfzeilen; 
+ 
+PROC zeige kopfzeilen:
+ INT VAR i; 
+ FOR i FROM 1 UPTO kopfzeilen REP 
+  cursor (begin x,begin y + i - 1); 
+  rand;
+  out (niltext);
+  out (center (subtext (kopfzeilen text,pre code + 1,post code - 1) 
+               ," ",size x));
+  rand
+ PER. 
+ 
+ post code: 
+  pos (kopfzeilen text,code (i)). 
+ 
+ pre code: 
+  pos (kopfzeilen text,code (i - 1)). 
+ 
+END PROC zeige kopfzeilen; 
+ 
+PROC  bild aufbauen: 
+  zeige kopfzeilen;
+  virtc := 1; 
+  realc := 1; 
+  bild (1);
+  realcursor setzen 
+END PROC bild aufbauen; 
+ 
+PROC kreuze an (BOOL CONST viele): 
+  auswahlende := FALSE; 
+  REP zeichen lesen; 
+      zeichen interpretieren 
+  UNTIL auswahlende 
+  PER. 
+ 
+zeichen lesen: 
+  TEXT VAR zeichen; 
+  inchar (zeichen, zeichenstring). 
+ 
+zeichen interpretieren: 
+  SELECT pos (zeichenstring, zeichen) OF 
+    CASE hop   : hoppen (viele) 
+    CASE esc   : esc kommandos (viele) 
+    CASE obe   : nach oben 
+    CASE unt   : nach unten 
+    CASE ank   : ankreuzen (viele,FALSE); evtl aufhoeren 
+    CASE ank 1 : ankreuzen (viele,TRUE ); evtl aufhoeren 
+    CASE aus   : auskreuzen 
+    CASE aus 1 : auskreuzen       
+    CASE fra   : info (viele) 
+    CASE ins   : eintrag einfuegen; 
+                 IF string <> ""
+                    THEN evtl aufhoeren 
+                 FI
+  END SELECT. 
+ 
+evtl aufhoeren: 
+  IF NOT viele 
+     THEN LEAVE kreuze an 
+  FI 
+END PROC kreuze an; 
+ 
+PROC hoppen (BOOL CONST viele): 
+  zweites zeichen lesen; 
+  zeichen interpretieren. 
+ 
+zweites zeichen lesen: 
+  TEXT VAR zz; 
+  getchar (zz). 
+ 
+zeichen interpretieren: 
+  SELECT pos (oben unten rubout o return x , zz) OF 
+    CASE 0   : out (""7"") 
+    CASE 1   : hop nach oben 
+    CASE 2   : hop nach unten 
+    CASE 3,4 : alles loeschen  
+    CASE 5   : bild nach oben 
+    CASE 6   : IF viele THEN rest ankreuzen ELSE out (""7"") FI 
+  END SELECT.  
+  
+bild nach oben: 
+  realc := 1; 
+  bild (virtc); 
+  realcursor setzen. 
+ 
+rest ankreuzen: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO anzahl REP 
+    IF nr (i) = 0 
+       THEN string CAT textstr (i) 
+    FI 
+  PER; 
+  bild aktualisieren;  
+  realcursor setzen.  
+ 
+alles loeschen: 
+  string := ""; 
+  bild aktualisieren; 
+  realcursor setzen. 
+ 
+hop nach oben: 
+  IF   ganz oben 
+       THEN out (""7"") 
+  ELIF oben auf der seite 
+       THEN raufblaettern 
+       ELSE top of page 
+  FI. 
+ 
+ganz oben: 
+  virtc = 1. 
+ 
+oben auf der seite: 
+  realc = 1. 
+ 
+raufblaettern: 
+  virtc DECR (max eintraege + 1); 
+  virtc := max (virtc, 1); 
+  bild (virtc); 
+  realcursor setzen. 
+ 
+top of page: 
+  loesche marke; 
+  virtc DECR (realc - 1); 
+  realc := 1; 
+  realcursor setzen. 
+ 
+hop nach unten: 
+  IF   ganz unten 
+       THEN out (""7"") 
+  ELIF unten auf der seite 
+       THEN runterblaettern 
+       ELSE bottom of page 
+  FI. 
+ 
+ganz unten: 
+  virtc = anzahl. 
+ 
+unten auf der seite: 
+  realc > maxeintraege . 
+ 
+runterblaettern: 
+  INT VAR alter virtc :: virtc; 
+  virtc INCR (max eintraege + 1); 
+  virtc := min (virtc, anzahl); 
+  realc := virtc - alter virtc; 
+  bild (alter virtc + 1); 
+  realcursor setzen. 
+ 
+bottom of page: 
+  loesche marke; 
+  alter virtc := virtc; 
+  virtc INCR (max eintraege + 1 - realc); 
+  virtc := min (anzahl, virtc); 
+  realc INCR (virtc - alter virtc); 
+  realcursor setzen 
+END PROC hoppen; 
+ 
+PROC esc kommandos (BOOL CONST viele): 
+  TEXT VAR zz; 
+  getchar (zz);  
+  SELECT pos(q eins neun a return x rubout o s, zz) OF 
+    CASE 0   : out (""7"") 
+    CASE 1   : auswahlende := TRUE 
+    CASE 2   : zeige anfang 
+    CASE 3   : zeige ende 
+    CASE 4   : abbruch := TRUE; auswahlende := TRUE 
+    CASE 5,6 : IF viele 
+                  THEN ankreuzen bis ende 
+                  ELSE out (""7"") 
+               FI 
+    CASE 7,8 : IF viele 
+                  THEN loeschen bis ende 
+                  ELSE out (""7"") 
+               FI 
+    CASE 9   : liste nach nummern ordnen 
+  END SELECT. 
+  
+liste nach nummern ordnen : 
+   THESAURUS VAR dummy thesaurus :: empty thesaurus; 
+   TEXT VAR nam,dummy string :: ""; 
+   cursor (begin x,begin y + screen ende + kopfzeilen + minzeilen - 1);
+   rand;
+   out (center(invers("Bitte warten !"),"-",size x)); 
+   rand;
+   i := 0; 
+   WHILE string <> "" REP 
+       i INCR 1; 
+       nam := subtext (string,1,3); 
+       string := subtext (string,5); 
+       insert (dummy thesaurus, eintrag [int (nam)]); 
+       dummy string CAT textstr (i) 
+   PER; 
+   anzahl := 0; 
+   string := dummy string; 
+   gesamt liste := dummy thesaurus + gesamt liste; 
+   FOR i FROM 1 UPTO highest entry (gesamt liste) REP 
+      IF name (gesamt liste,i) <> "" 
+         THEN anzahl INCR 1; 
+              eintrag [anzahl] := name (gesamt liste,i) 
+      FI 
+   PER; 
+   bild aufbauen. 
+ 
+loeschen bis ende: 
+  INT VAR j; 
+  FOR j FROM virtc UPTO anzahl REP 
+    INT VAR posi :: nr (j); 
+    IF posi <> 0 
+       THEN rausschmeissen 
+    FI 
+  PER; 
+  bild aktualisieren; 
+  realcursor setzen. 
+ 
+rausschmeissen: 
+  string := subtext (string,1, 4*posi-4) + subtext (string,4*posi+1). 
+ 
+ankreuzen bis ende: 
+  INT VAR i; 
+  FOR i FROM virtc UPTO anzahl REP 
+    IF nr (i) = 0 
+       THEN string CAT textstr (i) 
+    FI 
+  PER; 
+  bild aktualisieren;  
+  realcursor setzen.  
+ 
+zeige anfang:  
+  IF virtc = 1 
+     THEN out (""7"") 
+     ELIF virtc = realc 
+     THEN loesche marke; 
+          virtc := 1; 
+          realc := 1; 
+          realcursor setzen 
+     ELSE virtc := 1; 
+          realc := 1; 
+          bild (1); 
+          realcursor setzen 
+  FI. 
+ 
+zeige ende: 
+  IF   virtc = anzahl 
+       THEN out (""7"") 
+  ELIF ende auf screen 
+       THEN loesche marke;  
+            realc INCR (anzahl - virtc);  
+            virtc := anzahl; 
+            realcursor setzen 
+       ELSE virtc := anzahl;        
+          realc := max eintraege + 1;                                
+          bild (anzahl - maxeintraege); 
+          realcursor setzen 
+  FI. 
+  
+ende auf screen: 
+  (realc + anzahl - virtc) < maxeintraege + 1. 
+ 
+screen ende:
+  min (realc + anzahl - virtc - 1,max eintraege).
+
+END PROC esc kommandos; 
+ 
+PROC ankreuzen (BOOL CONST viele,xo): 
+  INT VAR pl :: nr (virtc); 
+  IF pl <> 0 
+     THEN out (""7""); 
+          cursor setzen; 
+          LEAVE ankreuzen 
+  FI; 
+  string CAT textstr (virtc); 
+  IF viele 
+     THEN cursor setzen 
+  FI. 
+ 
+ cursor setzen: 
+  IF xo 
+   THEN realcursor setzen 
+   ELSE IF virtc < anzahl 
+         THEN nach unten 
+        FI; 
+        IF virtc = anzahl 
+         THEN realcursor setzen 
+        FI 
+  FI 
+END PROC ankreuzen; 
+ 
+PROC auskreuzen : 
+  INT VAR posi :: nr (virtc); 
+  IF posi = 0 
+     THEN out (""7""); LEAVE auskreuzen 
+  FI; 
+  rausschmeissen; 
+  loesche marke; 
+  bild aktualisieren; 
+  realcursor setzen. 
+ 
+rausschmeissen: 
+  string := subtext (string,1, 4*posi-4) + subtext (string,4*posi+1)  
+END PROC auskreuzen; 
+ 
+PROC eintrag einfuegen : 
+  IF anzahl = max entries 
+     THEN out (""7""); 
+          LEAVE eintrag einfuegen 
+  FI; 
+  mache platz frei; 
+  trage ein; 
+  baue richtiges bild auf. 
+ 
+mache platz frei: 
+  INT VAR i; 
+  FOR i FROM anzahl DOWNTO virtc REP 
+     eintrag [i+1] := eintrag [i] 
+  PER; 
+  eintrag [virtc] := """"; 
+  ruecke kreuze einen weiter; 
+  anzahl INCR 1; 
+  string CAT textstr (virtc); 
+  baue richtiges bild auf. 
+ 
+trage ein: 
+  TEXT VAR exit char;
+  realcursor setzen;
+  out (marke (virtc,TRUE));
+  out ("""");
+  push (""11""); 
+  editget (ein,max text length,size x - 7,"","",exit char);
+  IF (ein SUB length (ein)) = """"
+     THEN ein := subtext (ein,1,length (ein) - 1) 
+  FI; 
+  IF ein = "" 
+     THEN auskreuzen; 
+          setze eintraege zurueck 
+     ELSE realcursor setzen;
+          out (6 * ""2"" + text ("""" + ein + """",size x - 7))
+  FI.            
+ 
+ein: 
+  eintrag [virtc]. 
+ 
+setze eintraege zurueck: 
+  FOR i FROM virtc UPTO anzahl-1 REP 
+      eintrag [i] := eintrag [i+1]; 
+      change (string,textstr (i+1),textstr (i)) 
+  PER; 
+  anzahl DECR 1. 
+ 
+ruecke kreuze einen weiter: 
+  FOR i FROM anzahl DOWNTO virtc REP 
+      change (string,textstr (i),textstr (i+1)) 
+  PER. 
+ 
+baue richtiges bild auf: 
+   bild (virtc - (realc - 1)); 
+   realcursor setzen 
+END PROC eintrag einfuegen; 
+ 
+PROC bild aktualisieren: 
+  INT VAR ob, un, i; 
+  ob := virtc - (realc - 1); 
+  un := min (ob + max eintraege, anzahl); 
+  FOR i FROM ob UPTO un REP 
+     cursor (begin x,kopfzeilen + begin y + i - ob + 1);
+     rand;
+     out (marke (i, FALSE))
+  PER 
+END PROC bild aktualisieren; 
+ 
+PROC nach oben: 
+  IF noch nicht oben   (* virtuell *) 
+     THEN gehe nach oben 
+     ELSE out (""7"") 
+  FI. 
+ 
+noch nicht oben: 
+  virtc > 1. 
+ 
+gehe nach oben: 
+  IF realc = 1 
+     THEN scroll down 
+     ELSE cursor up 
+  FI. 
+ 
+scroll down: 
+  virtc DECR 1; 
+  bild (virtc); 
+  realcursor setzen. 
+ 
+cursor up: 
+  loesche marke; 
+  virtc DECR 1; 
+  realc DECR 1; 
+  realcursor setzen 
+END PROC nach oben; 
+ 
+PROC nach unten: 
+  IF noch nicht unten  (* virtuell *)  
+     THEN gehe nach unten 
+     ELSE out (""7"") 
+  FI. 
+ 
+noch nicht unten: 
+  virtc < anzahl. 
+ 
+gehe nach unten: 
+  IF realc > maxeintraege 
+     THEN scroll up 
+     ELSE cursor down 
+  FI. 
+ 
+scroll up: 
+  virtc INCR 1; 
+  bild (virtc - maxeintraege); 
+  realcursor setzen. 
+ 
+cursor down: 
+  loesche marke; 
+  virtc INCR 1; 
+  realc INCR 1; 
+  realcursor setzen 
+END PROC nach unten; 
+ 
+PROC loesche marke: 
+  cursor (begin x,kopf zeilen + realc + begin y); 
+  rand;
+  out (marke (virtc, FALSE)) 
+END PROC loesche marke; 
+ 
+TEXT PROC textstr (INT CONST nr): 
+  text (nr,3) + "!" 
+END PROC textstr; 
+ 
+INT PROC nr (INT CONST zeiger): 
+  IF pos (string, textstr (zeiger)) = 0 
+     THEN 0 
+     ELSE (pos (string,textstr (zeiger)) DIV 4) + 1 
+  FI  
+END PROC nr; 
+ 
+PROC rand: 
+ IF raender 
+   THEN out ("|") 
+ FI 
+END PROC rand; 
+ 
+PROC info (BOOL CONST mehrere moeglich): 
+   IF NOT initialized (init tools info) 
+      THEN initialisiere tools info 
+   FI; 
+   modify (tools info); 
+   IF mehrere moeglich 
+      THEN head line (tools info," INFO : Auswahl mehrerer Dateien "); 
+      ELSE head line (tools info," INFO : Auswahl einer Datei "); 
+   FI; 
+   to line (tools info,1); 
+   col (tools info,1);
+   IF raender 
+     THEN open editor (groesster editor + 1,tools info,FALSE, 
+                                     begin x,begin y,size x + 2,size y) 
+     ELSE open editor (groesster editor + 1,tools info,FALSE, 
+                                     begin x,begin y,size x,size y)
+   FI;
+   edit (groesster editor,"q19",PROC (TEXT CONST) std kommando interpreter); 
+   zeige kopfzeilen;
+   bild (virtc - (realc - 1));
+   realcursor setzen
+END PROC info;  
+ 
+(******************** Herausgereichte, abgeleitete Prozeduren ***********) 
+ 
+THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile, 
+                     INT CONST start x,start y,x size,y size): 
+  einzelne (t,TRUE,kopf zeile,start x,start y,x size,y size) 
+END PROC some; 
+
+THESAURUS PROC some (THESAURUS CONST t,
+                     INT CONST start x,start y,x size,y size): 
+  some  (t,invers (std text 2 + std help),start x,start y,x size,y size) 
+END PROC some; 
+ 
+THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile, 
+                     INT CONST start y,ende y): 
+   einzelne (t,TRUE,kopf zeile,1,start y,79,ende y - start y + 1)
+END PROC some; 
+ 
+THESAURUS PROC some (THESAURUS CONST t,INT CONST start y,ende y): 
+   some (t,invers(stdtext 2 + std help),1,start y,79,ende y - start y + 1)
+END PROC some; 
+
+THESAURUS PROC some (THESAURUS CONST t,TEXT CONST kopf zeile): 
+   some (t,kopf zeile,1,bildschirm) 
+END PROC some; 
+ 
+THESAURUS PROC some (THESAURUS CONST t): 
+  some (t,invers(stdtext 2 + std help),1,bildschirm) 
+END PROC some; 
+  
+THESAURUS PROC some: 
+  some (all,invers(stdtext 2 + std help),1,bildschirm) 
+END PROC some; 
+ 
+THESAURUS PROC some (TEXT CONST te): 
+  some (ALL te) 
+END PROC some; 
+ 
+THESAURUS PROC some (TASK CONST quelle): 
+  some (ALL quelle) 
+END PROC some; 
+ 
+THESAURUS OP SOME (THESAURUS CONST th): 
+  some (th) 
+END OP SOME; 
+ 
+THESAURUS OP SOME (TASK CONST ta): 
+  some (ALL ta) 
+END OP SOME; 
+ 
+THESAURUS OP SOME (TEXT CONST te): 
+  some (ALL te) 
+END OP SOME; 
+ 
+TEXT PROC one (THESAURUS CONST t,TEXT CONST kopf zeile, 
+                     INT CONST start x,start y,x size,y size): 
+  name(einzelne (t,FALSE,kopf zeile,start x,start y,x size,y size),1) 
+END PROC one; 
+
+TEXT PROC one (THESAURUS CONST t,
+               INT CONST start x,start y,x size,y size): 
+  one (t,invers (std text 1 + std help),start x,start y,x size,y size) 
+END PROC one; 
+
+TEXT PROC one (THESAURUS CONST t, TEXT CONST t1, 
+               INT CONST start y,ende y): 
+  name (einzelne (t,FALSE, t1,1,start y,79,ende y - start y + 1), 1) 
+END PROC one; 
+ 
+TEXT PROC one (THESAURUS CONST t, 
+               INT CONST start y,ende y): 
+  one (t,invers (std text 1+ std help),1,start y,79,ende y - start y + 1) 
+END PROC one; 
+
+TEXT PROC one (THESAURUS CONST t,TEXT CONST kopf zeile): 
+   one (t,kopf zeile,1,bildschirm) 
+END PROC one;
+
+TEXT PROC one (THESAURUS CONST t): 
+  one (t,invers(stdtext 1 + std help),1,bildschirm) 
+END PROC one; 
+  
+TEXT PROC one (TASK CONST quelle): 
+  one (ALL quelle) 
+END PROC one; 
+ 
+TEXT PROC one: 
+  one (all) 
+END PROC one; 
+ 
+TEXT PROC one (TEXT CONST te): 
+  one (ALL te) 
+END PROC one; 
+   
+PROC edit one :
+  TEXT CONST datei :: one (all,invers(stdtext 1 + "zum Editieren") 
+                               + trennzeichen + stdhelp,
+                               1,bildschirm); 
+  IF datei <> "" CAND (NOT exists (datei) 
+                       COR type (old (datei)) = filetype) 
+     THEN IF groesster editor > 0 
+              THEN ueberschrift neu; 
+                   bild neu
+          FI;
+          edit (datei) 
+  FI  
+END PROC edit one; 
+ 
+PROC edit some:
+  THESAURUS CONST tt :: some (all,invers(stdtext 2 + "zum Editieren") 
+                                  + trennzeichen + stdhelp, 
+                                  1,bildschirm); INT VAR i; 
+  FOR i FROM 1 UPTO highest entry (tt) REP 
+    TEXT VAR datei :: name (tt,i); 
+    IF datei <> "" CAND (NOT exists (datei) 
+                         COR type (old (datei)) = filetype) 
+       THEN IF groesster editor > 0 
+              THEN ueberschrift neu; 
+                   bild neu                   
+            FI; 
+            edit (datei) 
+    FI 
+ PER 
+END PROC edit some; 
+
+PROC reorganize (THESAURUS CONST t): 
+  page; 
+  do (PROC (TEXT CONST) do reorganize,t) 
+END PROC reorganize; 
+ 
+PROC do reorganize (TEXT CONST name): 
+ IF type (old(name)) = file type 
+  THEN put ("Datei " + center (invers("""" + name + """")," ",30) 
+                     + " wird reorganisiert :"); 
+       FILE VAR file :: sequential file (modify,name);
+       IF segments (file) = 1
+         THEN put (lines (file))
+         ELSE reorganize (name) 
+       FI
+  ELSE put ("      " + center (invers("""" + name + """")," ",30) 
+                     + " ist keine Datei.") 
+ FI; 
+ line 
+END PROC do reorganize ; 
+ 
+PROC initialisiere tools info : 
+   tools info ds := nilspace; 
+   tools info := sequential file (output, tools info ds); 
+   putline (tools info,""15"   Mit den angekreuzten Namen wird die gewaehlte Operation ausgefuehrt     "14"");
+      line (tools info); 
+   putline (tools info,"        "15"   Positionierungen: "14" "); 
+      line (tools info); 
+   putline (tools info,"              Oben         : zum vorausgehenden Namen");
+   putline (tools info,"              Unten        : zum folgenden Namen    ");
+   putline (tools info,"              HOP Oben     : zum ersten  Namen der (vorigen) Seite");
+   putline (tools info,"              HOP Unten    : zum letzten Namen der (vorigen) Seite");
+   putline (tools info,"              HOP RETURN   : aktuelle Zeile wird erste Zeile");
+   putline (tools info,"              ESC 1        : zum ersten  Namen der Liste");
+   putline (tools info,"              ESC 9        : zum letzten Namen der Liste");
+   putline (tools info,"              ESC s        : Liste nach Nummern ordnen");
+      line (tools info); 
+   putline (tools info,"        "15"   Auswahl treffen: "14" "); 
+      line (tools info); 
+   putline (tools info,"              ( Folgende Befehle sind nur bei einer )");
+   putline (tools info,"              ( Auswahl von mehreren Namen Möglich. )");
+      line (tools info); 
+   putline (tools info,"              RETURN bzw. x: diesen Namen ankreuzen     ");
+   putline (tools info,"              RUBOUT bzw. o: Kreuz vor dem Namen loeschen");
+   putline (tools info,"              HOP x        : alle Namen ankreuzen      ");
+   putline (tools info,"              HOP o        : alle Kreuze loeschen     ");
+   putline (tools info,"              ESC x        : alle folgenden Namen ankreuzen");
+   putline (tools info,"              ESC o        : alle folgenden Kreuze loeschen");
+   putline (tools info,"              RUBIN        : einen neuen Namen eintragen");
+      line (tools info); 
+   putline (tools info,"              ( Nur dieser Befehl kann benutzt werden , wenn )");
+   putline (tools info,"              ( die Auswahl eines ! Namens möglich ist.      )");
+      line (tools info); 
+   putline (tools info,"              RETURN bzw. x: diesen Namen auswaehlen");
+      line (tools info); 
+   putline (tools info,"         "15"  Auswahl verlassen: "14""); 
+      line (tools info); 
+   putline (tools info,"                ESC q        : Auswaehlen beenden     ");
+   putline (tools info,"                ESC a        : Auswahl abbrechen (ohne Kreuze !)");
+      line (tools info); 
+   putline (tools info,""15"             Zum Verlassen des Infos bitte 'ESC q' tippen!                 "14"");
+END PROC initialisiere tools info; 
+ 
+END PACKET mpg some;
+
+(****************** DATEI MONITOR ********************************) 
+
+PACKET mpg dm DEFINES dm:                (* Klaus Bovermann   *)  
+                                         (* Andreas Dieckmann *) 
+                                         (* Thomas Clermont   *) 
+                                         (* Version 2.1       *) 
+                                         (* EUMEL   1.7.5     *) 
+                                         (* Datum   06.05.87  *) 
+LET mark ein            = ""15"",
+    mark aus            = ""14"",
+    trennzeichen        = ""222"",
+    type                = "#type (""micron"")#",
+    dummy name pos      = 18,
+    disk zeichenfolge   = "alnfiqushcvd", 
+    mana zeichenfolge   = "al   qush v"; 
+ 
+TASK CONST std manager :: task ("PUBLIC"); 
+TASK VAR manager; 
+ 
+BOOL VAR archive ist meins :: archiv angemeldet,
+         disk ,
+         diskette im schacht :: FALSE; 
+
+TEXT VAR aktueller archivename,
+         manager name, 
+         t1;
+
+PROC dm: 
+  TEXT VAR zeichen, alte lernsequenz :: lernsequenz auf taste ("k");
+  REP  aktion 
+  UNTIL zeichen = "q" PER; 
+  lernsequenz auf taste legen ("k",alte lernsequenz).
+  
+aktion: 
+  manager := std manager; 
+  vormonitor; 
+  IF zeichen <> "q" AND managername <> "" 
+     THEN hauptmonitor 
+  FI. 
+  
+zeige vormonitor: 
+      managername := name (manager); 
+      page; 
+      write(27 * " "); write(mark ein); 
+      write("V O R M O N I T O R "); write(mark aus); 
+      line(4); 
+      zeile ("t","Task einstellen, mit der  kommuniziert werden soll"); 
+      zeile ("p","Es soll mit 'PUBLIC'      kommuniziert werden"); 
+      zeile ("v","Es soll mit der Vatertask kommuniziert werden"); 
+      zeile ("a","Es soll mit dem Archiv    kommuniziert werden"); 
+      zeile ("q","Programm beenden").
+
+vormonitor:
+  IF NOT eingabe von erlaubtem zeichen ("tvapq")
+    THEN zeige vormonitor
+  FI; 
+  line; 
+  write ("Bitte Eingabe : "); 
+  inchar (zeichen, "tvapq"); 
+  out (zeichen); line;
+  IF pos ("a",zeichen) = 0 CAND manager = archive 
+    THEN automatische freigabe des archives 
+  FI; 
+  ausfuehren der vorwahl. 
+  
+ausfuehren der vorwahl: 
+  IF pos ("tvap", zeichen) <> 0 
+     THEN neue task einstellen  
+  FI. 
+  
+neue task einstellen: 
+  managername := ""; 
+  IF   zeichen = "a" THEN managername := "ARCHIVE" 
+  ELIF zeichen = "p" THEN managername := "PUBLIC" 
+  ELIF zeichen = "v" THEN managername := name (father) 
+                     ELSE namen holen 
+  FI; 
+  TEXT VAR mess; 
+  BOOL VAR ok :: managername = ""        COR 
+                 managername = "PUBLIC"  COR 
+                 task ist kommunikativ (managername, mess); 
+  IF NOT ok  
+     THEN cursor (1,20); putline (""7""15"FEHLER: " + mess + ""14""); 
+          pause; 
+          managername := ""; 
+  FI; 
+  IF   managername = ""        THEN manager := std manager 
+  ELIF managername = "ARCHIVE" THEN manager := archive 
+                               ELSE manager := task (managername) 
+  FI. 
+  
+namen holen: 
+  REP
+   cursor (1,14); 
+   put ("Neue Task:"); 
+   editget (managername); line; 
+   IF managername = name (myself)
+    THEN putline ("Mit der eigenen Task kann nicht kommuniziert werden.")
+   FI;
+  UNTIL managername <> name (myself) PER;
+   lernsequenz auf taste legen ("k",managername).
+
+END PROC dm;  
+                        
+BOOL PROC task ist kommunikativ (TEXT CONST taskname, TEXT VAR message): 
+  disable stop; 
+  TASK VAR t :: task (taskname); 
+  IF is error 
+     THEN message := errormessage; 
+          clear error; 
+          enable stop; 
+          FALSE 
+     ELSE task behandlung 
+  FI. 
+  
+  task behandlung: 
+    IF taskname <> "ARCHIVE" 
+       THEN task kommunikation 
+       ELSE archive behandlung 
+    FI. 
+  
+  task kommunikation: 
+    IF status (t) <> 2 
+       THEN message := "Task ist nicht im Wartezustand"; 
+            enable stop; 
+            FALSE 
+       ELSE versuchen zuzugreifen 
+    FI. 
+  
+  versuchen zuzugreifen: 
+    INT CONST listcode :: 15; 
+    DATASPACE VAR dummy :: nilspace; 
+    call (listcode, "", dummy, t); 
+    forget (dummy); 
+    IF is error  
+       THEN message := errormessage; 
+            clear error; 
+            enable stop; 
+            FALSE 
+       ELSE message := ""; 
+            enable stop; 
+            TRUE 
+    FI. 
+  
+  archive behandlung: 
+    IF status (archive) <> 2 
+       THEN message := "ARCHIVE ist nicht im Wartezustand"; 
+            LEAVE archive behandlung WITH FALSE
+    FI; 
+    archive (""); 
+    IF is error 
+       THEN message := errormessage; 
+            clear error; 
+            enable stop; 
+            FALSE  
+       ELSE enable stop; 
+            archive ist meins := TRUE; 
+            diskette im schacht := FALSE;
+            message := ""; 
+            TRUE 
+    FI 
+END PROC task ist kommunikativ; 
+ 
+PROC hauptmonitor:  
+  disk := (manager = archive); 
+  TEXT VAR zeichenfolge; 
+  IF disk 
+     THEN zeichenfolge := disk zeichenfolge 
+     ELSE zeichenfolge := mana zeichenfolge 
+  FI; 
+  TEXT VAR   taste; 
+  INT VAR    stelle; 
+  diskette im schacht   := FALSE; 
+  IF disk 
+     THEN reservieren des archives 
+  FI; 
+  disable stop;
+  REP 
+    IF NOT eingabe von erlaubtem zeichen (zeichenfolge)
+      THEN zeige menue 
+    FI; 
+    line;  
+    write ("Bitte Eingabe : "); 
+    inchar (taste,zeichenfolge);
+    out (taste + "   Bitte warten..."); 
+    stelle := pos (disk zeichenfolge, taste); (*!! ACHTUNG !!*) 
+    IF         stelle > 6
+       AND NOT diskette im schacht 
+       AND     disk
+     THEN line; 
+          putline (" Erst Diskette einlegen !");pause (100) 
+     ELIF taste <> " " 
+     THEN menue auswerten (stelle)
+    FI; 
+    IF is error 
+      THEN IF disk 
+             THEN melde archiveerror (errormessage) 
+             ELSE melde error (errormessage)
+           FI;
+           clear error 
+    FI 
+   UNTIL taste = "q" PER; 
+   IF archiv angemeldet
+      THEN automatische freigabe des archives 
+   FI.  
+ 
+  zeige menue: 
+    page; 
+    write(24 * " "); write(mark ein); 
+    write("D A T E I M O N I T O R "); write(mark aus); 
+    line(3); 
+    zeile ("a","Auflisten aller Dateien in dieser Task"); 
+    zeile ("l","Loeschen    von Dateien in dieser Task"); 
+    line(2); 
+    write( 15 * " "); 
+    IF disk 
+       THEN write("Archiv: ")  
+       ELSE write("Task  : ") 
+    FI;  
+    IF disk 
+       THEN IF diskette im schacht 
+             THEN IF length(aktueller archivename) > 40  
+                   THEN write ("'" + subtext (aktueller archivename,1,40) + " ...")
+                   ELSE write (invers(""""+ aktueller archivename + """"))
+                  FI  
+             FI
+       ELSE write (invers("""" + managername + """")) 
+    FI; 
+    line(2);  
+    TEXT VAR zielname 1, zielname 2, zielname 3; 
+    IF disk 
+       THEN zielname 1 := "des Archivs"; 
+            zielname 2 := "zum Archiv"; 
+            zielname 3 := "vom Archiv" 
+       ELSE zielname 1 := "in  " + managername; 
+            zielname 2 := "zu  " + managername; 
+            zielname 3 := "von " + managername 
+    FI; 
+    zeile ("u","Uebersicht ueber alle Dateien " + zielname 1); 
+    zeile ("s","Senden von Dateien            " + zielname 2); 
+    zeile ("h","Holen von Dateien             " + zielname 3); 
+    IF disk 
+       THEN zeile ("c","'Checken' von Dateien         " + zielname 1) 
+    FI; 
+    zeile ("v","Vernichten von Dateien        " + zielname 1); 
+    IF disk THEN 
+       zeile ("d","Drucken einer Liste der Dateien des Archivs"); 
+       zeile ("f","Formatieren einer Diskette"); 
+       zeile ("i","Initialisieren/vollstaendiges Loeschen des Archivs"); 
+       zeile ("n","Neue Diskette anmelden"); 
+    FI;  
+    line(1); 
+    zeile ("q","Zurueck zum Vormonitor").
+
+END PROC hauptmonitor;  
+ 
+PROC menue auswerten (INT CONST stelle):
+    enable stop;
+    SELECT stelle OF  
+       CASE  1 : auflisten der taskdateien 
+       CASE  2 : loeschen von dateien in der task 
+       CASE  3 : neue diskette anmelden 
+       CASE  4 : formatieren einer diskette 
+       CASE  5 : initialisieren des archives 
+       CASE  6 : (* nichts *) 
+       CASE  7 : auflisten der archivedateinamen 
+       CASE  8 : schreiben von dateien aufs archive 
+       CASE  9 : holen von dateien vom archive 
+       CASE 10 : checken von dateien auf dem archive 
+       CASE 11 : loeschen von dateien auf dem archive 
+       CASE 12 : ausdruck archivelisting 
+    END SELECT 
+END PROC menue auswerten;
+
+BOOL PROC eingabe von erlaubtem zeichen (TEXT CONST erlaubte zeichen):
+   TEXT VAR char in; 
+   char in := getcharety;
+   IF pos (erlaubte zeichen,char in) > 0 AND char in <> " "
+     THEN push (char in);TRUE 
+     ELSE FALSE
+   FI. 
+END PROC eingabe von erlaubtem zeichen; 
+ 
+PROC zeile (TEXT CONST t,tt): 
+  putline (8*" " + ""15"" + t + " "14"" + " ... " + tt) 
+END PROC zeile; 
+ 
+PROC formatieren einer diskette: 
+   page; 
+   putline ("Formatieren einer Diskette."); 
+   putline ("==========================="); 
+   putline (""15"Achtung: Alle Disketten-Informationen werden gelöscht!"14""); 
+   line; 
+   putline ("Dies sind die moeglichen Formate:"); 
+   zeile ("o","... Ohne Format-Angabe"); 
+   zeile ("0","... Standard-Format"); 
+   zeile ("1","... 40 Spur -  360 KB"); 
+   zeile ("2","... 80 Spur -  720 KB"); 
+   zeile ("3","... IBM Std - 1200 KB"); 
+   zeile ("q","... Es wird nicht formatiert."); 
+   TEXT VAR art; 
+   put ("Ihre Wahl:"); 
+   inchar (art, "o01234q"); 
+   IF art = "q" 
+      THEN LEAVE formatieren einer diskette 
+   FI; 
+   out (art); line; 
+   put ("zukünftiger Name des Archives :"); 
+   editget (aktueller archivename);line; 
+   archive (aktueller archivename); 
+   diskette im schacht := TRUE;
+   disable stop; 
+   IF art = "o" THEN format (archive) 
+                ELSE format (int (art), archive) 
+   FI; 
+   IF is error 
+      THEN diskette im schacht := FALSE
+      ELSE aktueller archivename := archiv name
+   FI
+END PROC formatieren einer diskette; 
+ 
+PROC auflisten der taskdateien: 
+   DATASPACE VAR dummy ds :: nilspace; 
+   FILE VAR f :: sequential file (output,dummy ds); 
+   list (f); 
+   headline (f,"Liste der eigenen Task"); 
+   modify (f); 
+   to line (f,1); 
+   show (f); 
+   forget (dummy ds) 
+END PROC auflisten der taskdateien; 
+ 
+PROC loeschen von dateien in der task: 
+  t1 := invers ("Loeschen von Dateien ") + "  Info mit <?>" + trennzeichen + 
+        "Bitte alle zu loeschenden Dateien ankreuzen" + trennzeichen + 
+        invers ("(Ankreuzen mit <RETURN> )"); 
+  forget (some (all,t1)) 
+END PROC loeschen von dateien in der task; 
+ 
+PROC reservieren des archives: 
+   TEXT VAR meldung; 
+   page; 
+   cursor(1,1); write("Bitte warten..."); 
+   line (2); 
+   versuche archive zu reservieren (meldung); 
+   IF meldung <> "" 
+      THEN page; 
+           line(10); 
+           write (""15"" + meldung + " "14""); 
+           weitermachen; 
+           diskette im schacht := FALSE;
+           archive ist meins := FALSE;  
+           LEAVE reservieren des archives 
+   FI; 
+   archive anmelden (aktueller archive name, meldung); 
+   IF meldung <> "" 
+    THEN melde archiveerror (meldung)
+   FI. 
+  
+END PROC reservieren des archives;  
+   
+PROC versuche archive zu reservieren (TEXT VAR fehlermeldung): 
+    fehlermeldung := ""; 
+    IF archive ist meins 
+       THEN LEAVE versuche archive zu reservieren 
+    FI; 
+    disable stop;  
+    archive (""); 
+    IF is error  
+       THEN fehlermeldung := errormessage; 
+            archive ist meins := FALSE;
+            clear error; 
+            enable stop; 
+       ELSE archive ist meins := TRUE;  
+            fehlermeldung := "";  
+            enable stop 
+    FI 
+END PROC versuche archive zu reservieren; 
+ 
+PROC archive anmelden (TEXT VAR archivename, fehlermeldung): 
+  page; 
+  line(3); 
+  fehlermeldung := ""; 
+  IF NOT archive ist meins 
+     THEN archivename   := "";  
+          diskette im schacht := FALSE;
+          fehlermeldung := "nicht reserviert"; 
+          LEAVE archive anmelden  
+  FI; 
+  IF yes ("Haben Sie die Diskette eingelegt und das Laufwerk geschlossen") 
+     THEN line; 
+          write ("Bitte warten..."); 
+          archive name := archiv name;
+          IF archiv error <> ""
+           THEN fehlermeldung := archiv error;
+                diskette im schacht := FALSE
+           ELSE diskette im schacht := TRUE
+          FI
+     ELSE diskette im schacht := FALSE; 
+          archivename := ""
+  FI 
+END PROC archive anmelden;
+ 
+PROC verlange reservierung des archives: 
+   page;
+   line(7); 
+   write (""15"Sie muessen unbedingt erst das Archiv reservieren, "14""); 
+   line(2);  
+   write (""15"sonst kann ich nicht darauf zugreifen! "14""); 
+   line(2);  
+   weitermachen 
+END PROC verlange reservierung des archives;  
+  
+PROC auflisten der archivedateinamen: 
+  forget ("Dateiliste", quiet); 
+  ueberpruefe reservierung; 
+  liste dateien des archivs auf; 
+  liste ausgeben; 
+  forget ("Dateiliste", quiet). 
+  
+  ueberpruefe reservierung: 
+    IF disk AND diskette im schacht 
+            AND NOT archive ist meins 
+       THEN verlange reservierung des archives;  
+            LEAVE auflisten der archivedateinamen 
+    FI. 
+ 
+  liste dateien des archivs auf: 
+    FILE VAR f :: sequential file (output,"Dateiliste"); 
+    disable stop; 
+    list(f,manager); 
+    IF is error 
+       THEN LEAVE auflisten der archivedateinamen; 
+       ELSE enable stop 
+    FI. 
+  
+  liste ausgeben: 
+    show (f) 
+END PROC auflisten der archivedateinamen;  
+ 
+PROC checken von dateien auf dem archive:  
+   ueberpruefe reservierung; 
+   lasse dateien auswaehlen und checke.  
+  
+   ueberpruefe reservierung: 
+     IF disk AND diskette im schacht 
+             AND NOT archive ist meins 
+        THEN verlange reservierung des archives; 
+             LEAVE checken von dateien auf dem archive 
+     FI. 
+  
+   lasse dateien auswaehlen und checke: 
+     t1 := invers ("'Checken' von Dateien  (auf dem Archiv) ") 
+           + trennzeichen + "Bitte alle zu 'checkenden' Dateien ankreuzen"; 
+     disable stop; 
+     check (some (ALL manager, t1), manager); 
+     weitermachen; 
+     IF is error 
+        THEN LEAVE checken von dateien auf dem archive 
+        ELSE enable stop; 
+     FI 
+END PROC checken von dateien auf dem archive;  
+  
+PROC schreiben von dateien aufs archive: 
+   ueberpruefe reservierung; 
+   lasse dateien auswaehlen und schreibe aufs archive. 
+    
+ueberpruefe reservierung: 
+  IF disk AND diskette im schacht 
+          AND NOT archive ist meins 
+     THEN verlange reservierung des archives; 
+          LEAVE schreiben von dateien aufs archive 
+  FI. 
+ 
+lasse dateien auswaehlen und schreibe aufs archive: 
+  t1 := invers ("Schreiben von Dateien ") + " Info mit <?>" + trennzeichen + 
+        "Bitte alle zu schreibenden Dateien ankreuzen." + trennzeichen + 
+        invers ("(Ankreuzen mit <RETURN> )"); 
+  THESAURUS VAR angekreuzte :: some (ALL myself, t1); 
+  disable stop;
+  zuerst loeschen; 
+  INT VAR zaehler; 
+  TEXT VAR dname; 
+  page; 
+  FOR zaehler FROM 1 UPTO highest entry (angekreuzte) REP 
+      IF is error 
+         THEN LEAVE schreiben von dateien aufs archive 
+      FI;  
+      dname := name (angekreuzte, zaehler); 
+      IF dname <> "" 
+         THEN putline (managername + " <--- """ + dname + """"); 
+              save (dname, manager) 
+      FI; 
+  PER.
+ 
+  zuerst loeschen:  
+    IF disk CAND (not empty (angekreuzte)) 
+       THEN out (center(invers("Bitte Warten"),"-",80)); 
+            THESAURUS CONST zu loe :: angekreuzte / ALL manager;  
+            IF not empty (zu loe) AND NOT is error
+               THEN page; 
+                    putline ("Zuerst Dateien auf der Diskette loeschen?"); 
+                    erase (zu loe, manager) 
+            FI 
+    FI  
+END PROC schreiben von dateien aufs archive; 
+  
+BOOL PROC not empty (THESAURUS CONST t): 
+  INT VAR i; 
+  FOR i FROM 1 UPTO highest entry (t) REP 
+    IF name (t,i) <> "" 
+       THEN LEAVE not empty WITH TRUE 
+    FI 
+  PER; 
+  FALSE 
+END PROC not empty; 
+ 
+PROC holen von dateien vom archive: 
+   ueberpruefe reservierung; 
+   lasse dateien auswaehlen und hole vom archive. 
+    
+ueberpruefe reservierung: 
+  IF disk AND diskette im schacht 
+          AND NOT archive ist meins 
+     THEN verlange reservierung des archives; 
+          LEAVE holen von dateien vom archive 
+  FI. 
+ 
+lasse dateien auswaehlen und hole vom archive: 
+  t1 := invers ("Holen von Dateien ") + "  Info mit <?>" + 
+        trennzeichen + 
+        "Bitte alle zu holenden Dateien ankreuzen."; 
+  THESAURUS VAR angekreuzte :: some (ALL manager,t1); 
+  INT VAR zaehler; 
+  TEXT VAR dname; 
+  page; 
+  FOR zaehler FROM 1 UPTO highest entry (angekreuzte) REP 
+      dname := name (angekreuzte, zaehler); 
+      disable stop; 
+      IF dname <> "" 
+         THEN putline (managername + " --> """ + dname + """"); 
+              fetch (dname, manager) 
+      FI; 
+      IF is error 
+         THEN LEAVE holen von dateien vom archive 
+         ELSE enable stop  
+      FI   
+  PER 
+END PROC holen von dateien vom archive; 
+ 
+PROC loeschen von dateien auf dem archive: 
+   ueberpruefe reservierung; 
+   lasse dateien auswaehlen und loesche. 
+    
+ ueberpruefe reservierung: 
+   IF disk AND diskette im schacht 
+           AND NOT archive ist meins 
+      THEN verlange reservierung des archives; 
+           LEAVE loeschen von dateien auf dem archive 
+   FI. 
+ 
+lasse dateien auswaehlen und loesche: 
+  t1 := invers ("Vernichten (Loeschen) von Dateien") + " Info mit <?>" + 
+        trennzeichen + "Bitte alle zu loeschenden Dateien ankreuzen."; 
+  disable stop; 
+  erase (some (ALL manager, t1), manager); 
+  IF is error 
+     THEN LEAVE loeschen von dateien auf dem archive 
+     ELSE enable stop; 
+  FI 
+END PROC loeschen von dateien auf dem archive; 
+ 
+PROC initialisieren des archives: 
+     TEXT VAR neuer archivename; 
+     page; 
+     line(2); 
+     write(center (""15"Vollstaendiges Loeschen des Archivs "14"")); 
+     line(2); 
+     IF archive ist meins AND diskette im schacht
+        THEN write("Eingestellter Archivname: " + 
+             invers ("""" + aktueller archivename + """")); 
+             line(2); 
+             IF yes ("Moechten Sie einen anderen Namen fuer das Archiv") 
+                THEN line(2); 
+                     stelle frage nach neuem namen 
+                ELSE neuer archivename := aktueller archivename 
+             FI 
+        ELSE stelle frage nach neuem namen  
+     FI;  
+     fuehre initialisierung durch. 
+  
+     stelle frage nach neuem namen: 
+       write("Bitte den Namen fuer das Archiv (maximal 30 Buchstaben):"); 
+       line; 
+       getline(neuer archivename); 
+       neuer archivename := compress(neuer archivename); 
+       IF   length (neuer archivename) > 40 
+            THEN line(2); 
+                 write ("Der neue Archivname ist zu lang!"); 
+                 weitermachen; 
+                 LEAVE initialisieren des archives 
+       FI. 
+  
+     fuehre initialisierung durch: 
+       disable stop; 
+       aktueller archivename := neuer archivename; 
+       archive (neuer archivename); 
+       IF is error 
+          THEN diskette im schacht := FALSE;
+               archive ist meins := FALSE;
+               LEAVE initialisieren des archives 
+          ELSE clear(archive); 
+               IF is error 
+                  THEN diskette im schacht := FALSE;
+                       LEAVE initialisieren des archives 
+                  ELSE aktueller archivename := archiv name;
+                       diskette im schacht := archiv error = ""
+               FI
+       FI 
+END PROC initialisieren des archives; 
+   
+PROC ausdruck archivelisting: 
+   ueberpruefe reservierung; 
+   print archive listing; 
+   weitermachen. 
+  
+ueberpruefe reservierung: 
+    IF disk AND diskette im schacht 
+            AND NOT archive ist meins 
+       THEN verlange reservierung des archives;  
+            LEAVE ausdruck archivelisting 
+    FI. 
+   
+print archive listing: 
+  FILE VAR listfile := sequential file (output , "PLA");
+  INT  VAR i;
+  TEXT CONST head :: 70 * "=",
+             end  :: 70 * "_";
+  TEXT VAR   record;
+  disable stop;
+  list (listfile, archive);
+  IF is error 
+    THEN diskette im schacht := FALSE;
+         LEAVE ausdruck archivelisting
+  FI;
+  print head;
+  erase dummy names;
+  print bottom;
+  print and erase listing.
+
+print head :
+  modify (listfile);
+  to line (listfile, 1);
+  FOR i FROM 1 UPTO 6 REP
+    insert record (listfile)
+  PER;
+  to line (listfile, 1);
+  write record (listfile, type); down (listfile);
+  write record (listfile, head); down (listfile);
+  write record (listfile, "ARCHIVNAME: "+headline (listfile) + "  " +
+                time of day  +"  " + date ); down (listfile);
+  write record (listfile, head); down (listfile);
+  write record (listfile, " "); down (listfile);
+  write record (listfile, "Date      Store  Contents").
+
+erase dummy names :
+  to line (listfile, 6);
+  WHILE NOT eof (listfile) REP
+    read record (listfile, record);
+    IF (record SUB dummy name pos) = "-"
+      THEN delete record (listfile)
+      ELSE down (listfile) 
+    FI 
+  PER.
+
+print bottom :
+   output (listfile);
+   putline (listfile, end).
+
+print and erase listing :
+  modify (listfile);
+  edit (listfile);
+  line (3);
+  IF yes ("Archivlisting drucken")
+    THEN print ("PLA")
+  FI;
+  forget ("PLA", quiet).
+ 
+END PROC ausdruck archivelisting;  
+ 
+PROC neue diskette anmelden: 
+   ueberpruefe reservierung; 
+   melde neue diskette an. 
+  
+   ueberpruefe reservierung: 
+     IF NOT archive ist meins 
+       THEN reservieren des archives;  
+             LEAVE neue diskette anmelden 
+     FI.  
+ 
+   melde neue diskette an: 
+     TEXT VAR meldung;  
+     page; 
+     cursor(1,1); write("Bitte warten..."); 
+     line (2); 
+     archive anmelden (aktueller archive name,meldung); 
+     IF meldung <> "" 
+       THEN melde archiveerror (meldung) 
+     FI. 
+  
+END PROC neue diskette anmelden;  
+ 
+PROC automatische freigabe des archives: 
+   archive ist meins := FALSE;  
+   diskette im schacht := FALSE; 
+   command dialogue (FALSE); 
+   release(archive); 
+   command dialogue (TRUE) 
+END PROC automatische freigabe des archives;  
+  
+PROC melde archiveerror (TEXT CONST meldung): 
+   line(2); 
+   IF   meldung = "nicht reserviert" 
+        THEN verlange reservierung des archives; 
+   ELIF meldung = "keine diskette" 
+        THEN write (""15"Ich mache die Reservierung rueckgaengig! "14""); 
+             neu reservieren 
+   ELIF pos (meldung,"inkonsistent") > 0 
+        THEN write(""15"Diskette ist nicht formatiert / initialisiert "14""); 
+             neu reservieren; 
+   ELIF pos(meldung,"Lesen unmoeglich") > 0 
+           COR pos(meldung, "Schreiben unmoeglich") > 0 
+        THEN write(""15"Die Diskette ist falsch eingelegt "14"");line (2); 
+             write(""15"oder das Laufwerk ist nicht geschlossen "14"");line (2); 
+             write(""15"oder die Diskette ist nicht formatiert !"14""); 
+             neu reservieren; 
+   ELIF pos (meldung, "Archiv heisst") > 0 AND pos(meldung, "?????") > 0 
+        THEN write(""15"Diskette nicht lesbar ! (Name: '?????') "14"");line(2); 
+             write(""15"Moeglicherweise ist die Diskette defekt ! "14"");  
+             neu reservieren; 
+   ELIF pos(meldung, "Archiv heisst") > 0 
+        THEN write (invers(meldung)); 
+             line(2); 
+             write (""15"Diskette wurde mit anderem Namen angemeldet!"14"");line(2); 
+             write("Bitte neu reservieren!"); 
+             weitermachen 
+   ELSE write(invers(meldung)); 
+        neu reservieren 
+   FI 
+END PROC melde archiveerror; 
+ 
+PROC neu reservieren: 
+  line (2); 
+  write ("Bitte den Fehler beseitigen und das Archiv neu reservieren !"); 
+  weitermachen; 
+  diskette im schacht := FALSE
+END PROC neu reservieren; 
+ 
+PROC weitermachen: 
+  line (2);
+  write("Zum Weitermachen bitte irgendeine Taste tippen!"); 
+  pause  
+END PROC weitermachen; 
+
+PROC melde error (TEXT CONST meldung): 
+  page; 
+  line(10); 
+  write (invers(meldung)); 
+  weitermachen 
+END PROC melde error 
+  
+END PACKET mpg dm; 
+ 
+(**************************** TOOLS  *******************************)
+
+PACKET mpg tools DEFINES put,
+                         th,
+                         gen :
+ 
+
+lernsequenz auf taste legen ("E", ""27""2""27"p"27"qedit ("27"g)"13""); 
+
+PROC put (BOOL CONST b) :
+  IF b THEN put ("TRUE") ELSE put ("FALSE")  FI
+END PROC put;
+
+PROC th (THESAURUS CONST thes) :
+  THESAURUS VAR help :: SOME thes;help := empty thesaurus
+END PROC th;
+
+(************************ Task - Generierung *******************************)
+
+(* Zum Generieren einer TASK ist folgendes zu beachten:
+
+a) Es muss ein Archiv zur Verfuegung stehen, das einen beliebigen Namen hat.
+b) Auf diesem Archiv muss es eine Datei namens <"gen." + taskname> geben.
+c) Diese Datei muss folgendermassen aufgebaut sein:
+   In jeder Zeile steht genau ein Name einer fuer diese TASK wichtigen Datei.
+   Die ersten Namen sind Namen von zu insertierenden Dateien.
+   Es folgt "gen." + taskname.
+   Alle folgenden Dateinamen werden vom Archiv geholt und bleiben in der
+   TASK erhalten. *)
+
+BOOL VAR archive access :: FALSE;
+
+PROC hole (TEXT CONST dateiname):
+  IF exists (dateiname) 
+     THEN display ("***")
+     ELSE IF NOT archive access
+            THEN archiv;    (* geaendert BV 10.07.86 *)
+                 archive access := TRUE
+          FI;
+          display ("-->");
+          from (dateiname)
+  FI;
+  display (dateiname + ""13""10"")
+END PROC hole;
+
+PROC ins (TEXT CONST dateiname):
+  line; 
+  out (77 * "=" + ""13""10"");
+  out (dateiname + " wird insertiert"13""10"");
+  insert (dateiname);
+  forget (dateiname, quiet)
+END PROC ins;
+
+LET anzahl dateien = 50;
+
+ROW anzahl dateien TEXT VAR datei;
+
+INT VAR anzahl zu insertierender,
+        gesamtzahl;
+
+PROC gen:
+  TEXT CONST taskname :: name (myself),
+             gendateiname :: "gen." + taskname;
+  TEXT VAR   record;
+  BOOL VAR   zu insertieren :: TRUE;
+
+  archive access := FALSE;
+  anzahl zu insertierender := 0;
+  gesamtzahl               := 0;
+  page;
+  putline ("GENERIERUNG VON " + taskname);
+  putline ((16 + length (taskname)) * "=");
+  hole (gendateiname);
+
+  FILE VAR gendatei := sequential file (input, gendateiname);
+  WHILE NOT eof (gendatei) AND gesamtzahl < anzahl dateien REP
+     getline (gendatei, record);
+     record := compress (record);
+     IF record = gendateiname
+        THEN zu insertieren := FALSE
+     FI;
+     IF zu insertieren
+        THEN anzahl zu insertierender INCR 1
+     FI;
+     gesamtzahl INCR 1;
+     hole (record);
+     datei [gesamtzahl] := record
+  PER;
+  forget (gendateiname, quiet);
+  IF archive access
+    THEN release;
+         line (2);
+         put ("Bitte entfernen Sie Ihre Diskette aus dem Laufwerk!"); 
+         line
+  FI;
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl zu insertierender REP
+      ins (datei [i])
+  PER;
+  IF yes ("global manager")
+     THEN do ("global manager")
+  FI.
+END PROC gen
+ 
+END PACKET mpg tools;
+ 
+(********************* MPG TARGET HANDLING *******************) 
+ 
+PACKET target handling DEFINES TARGET, 
+                       initialize target, 
+                       complete target, 
+                       delete in target, 
+                       select target, 
+                       actual target name, 
+                       actual target set, 
+                       target names: 
+ 
+ 
+TYPE TARGET = STRUCT (INT ind, THESAURUS target name, target set); 
+ 
+LET no target = 0; 
+ 
+PROC initialize target (TARGET VAR tar): 
+  tar.target set  := empty thesaurus; 
+  tar.target name := empty thesaurus; 
+  tar.ind         := no target 
+END PROC initialize target; 
+ 
+PROC complete target (TARGET VAR tar, TEXT CONST nam, set): 
+  IF NOT (tar.target name CONTAINS nam) 
+     THEN insert (tar.target name, nam); 
+          insert (tar.target set , set) 
+     ELSE errorstop ("Bezeichner bereits vorhanden") 
+  FI 
+END PROC complete target; 
+ 
+PROC delete in target (TARGET VAR tar, TEXT CONST nam): 
+  INT CONST ind :: link (tar.target name, nam); 
+  delete (tar.target name, ind); 
+  delete (tar.target set , ind); 
+  tar.ind := no target 
+END PROC delete in target; 
+ 
+PROC select target (TARGET VAR tar, TEXT CONST nam, TEXT VAR set): 
+  INT VAR ind :: link (tar.target name, nam); 
+  IF ind <> 0 
+     THEN set     := name (tar.target set , ind); 
+          tar.ind := ind 
+     ELSE set     := "" 
+  FI 
+END PROC select target; 
+ 
+TEXT PROC actual target name (TARGET CONST tar): 
+  IF tar.ind = no target 
+     THEN "" 
+     ELSE name (tar.target name, tar.ind) 
+  FI 
+END PROC actual target name; 
+ 
+TEXT PROC actual target set (TARGET CONST tar): 
+  IF tar.ind = no target 
+     THEN "" 
+     ELSE name (tar.target set, tar.ind) 
+  FI 
+END PROC actual target set; 
+ 
+THESAURUS PROC target names (TARGET CONST tar): 
+  tar.target name 
+END PROC target names 
+ 
+END PACKET target handling;
+
+(*********************** MPG PRINT CMD ***********************)
+
+PACKET mpg print cmd DEFINES print, select printer, 
+                             install printers, 
+                             list printers,
+                             printer, printers: 
+ 
+ 
+TARGET VAR printer list; 
+ 
+LET std printer name = "PRINTER", 
+    titel            = "PRINTER AUSWAHL"; 
+ 
+LET trenner = "\#"; 
+ 
+TARGET PROC printers: 
+   printer list
+END PROC printers;
+
+PROC install printers (FILE VAR f): 
+  initialize target (printer list); 
+  TEXT VAR nam, set; 
+  TEXT VAR std nam :: "", std set :: ""; 
+  WHILE NOT eof (f) REP 
+    TEXT VAR zeile; 
+    getline (f, zeile); 
+    IF zeile <> "" 
+       THEN INT CONST po :: pos (zeile, trenner); 
+            nam := subtext (zeile, 1, po - 1); 
+            set := subtext (zeile, po + 1); 
+            complete target (printer list, nam, set); 
+            IF int (nam) = station (myself) 
+               THEN std nam := nam; 
+                    std set := set 
+            FI 
+    FI
+  PER; 
+  select target (printer list, std nam, std set); 
+  IF std set <> "" 
+     THEN fonttable (std set) 
+  FI 
+END PROC install printers; 
+ 
+PROC select printer: 
+  TEXT VAR font; 
+  select target (printer list, 
+     one (target names (printer list), titel,1,24), font); 
+  IF font <> "" 
+     THEN fonttable (font) 
+  FI 
+END PROC select printer; 
+ 
+PROC list printers: 
+  th (target names (printer list)) 
+END PROC list printers; 
+ 
+PROC print : 
+  print (last param) 
+END PROC print; 
+ 
+PROC print (TEXT CONST file) : 
+  save (file, printer) 
+END PROC print; 
+ 
+PROC print (THESAURUS CONST thes) : 
+  save (thes, printer) 
+END PROC print; 
+ 
+TASK PROC printer: 
+  INT VAR stat :: int (actual target name (printer list)); 
+  IF stat = 0 
+     THEN niltask 
+     ELSE stat/std printer name 
+  FI 
+END PROC printer 
+ 
+END PACKET mpg print cmd;
+ 
+(************************ EDIT MONITOR *************************)
+
+PACKET edit monitor DEFINES  edit monitor,    (* Lutz Prechelt      *)
+                             F,               (* Carsten Weinholz   *) 
+                             table:           (* Thomas Clermont    *) 
+                                              (* EUMEL 1.8          *)
+                                              (* Version 4.4.1      *)
+                                              (* Multimonitor       *)
+                                              (* Alphaeditor        *)
+                                              (* 06.07.1987         *)
+ 
+LET   command handling line  = 18,  (* muss > max file + 1 und < 23 sein *)
+      max file               = 15,  (* max. 20 *)
+      file type              = 1003,
+      min lines per segment  = 24,  (* darunter wird reorganisiert *)
+      integer is allowed     =  3,
+      no command             = 4711,
+      gib kommando 1         = "Gib Edit-Monitor ",
+      gib kommando 2         = " Kommando :";
+ 
+TEXT CONST command list ::"quitmonitor:1.0edit:2.1run:3.1insert:4.1" + 
+                          "forget:5.1rename:6.2copy:7.2fetch:8.1"      + 
+                          "save:9.1close:10.1fileinfo:11.0reorganize:12.1";
+ 
+LET EDITTABLE = ROW max file STRUCT (THESAURUS line table, 
+                                     TEXT      name, 
+                                     FILE      file      );
+ 
+LET nil code = 0, 
+    edit code= 1, 
+    do code  = 2;
+
+INT  VAR command index, number of params, command indices,
+         aufruftiefe :: 0,zeile;
+ 
+TEXT VAR param 1, param 2, old command :: "", command line :: "";
+BOOL VAR short command, info :: FALSE,verlasse monitor :: FALSE;
+INITFLAG VAR this monitor;
+ 
+EDITTABLE VAR etb;
+ 
+PROC edit monitor :
+  TEXT VAR ch, old lernsequenz :: lernsequenz auf taste ("Q");
+  INT  VAR i, previous heap size :: heap size;
+  disable stop;
+  initialize;
+  get new table;
+  REP
+    prepare screen;
+    perhaps reorganize and get command;
+    execute command;
+    collect heap garbage if necessary
+  UNTIL verlasse monitor PER;
+  lernsequenz auf taste legen ("Q",old lernsequenz);
+  close all files if not nested.
+
+initialize :
+  lernsequenz auf taste legen ("Q",""1""8""1""12"quitmonitor"13"");
+  verlasse monitor := FALSE;
+  aufruftiefe INCR 1;
+  IF aufruftiefe > max file
+     THEN aufruftiefe DECR 1; 
+          errorstop ("Editmonitor overflow: Bereits " + text (max file ) + "Monitore geoeffnet") 
+     ELSE IF NOT initialized (this monitor) 
+             THEN FOR i FROM 1 UPTO max file REP 
+                      etb [i].line table := empty thesaurus; 
+                      etb [i].name := ""
+                  PER
+          FI; 
+          FOR i FROM 1 UPTO max file REP 
+            etb [i].name := name (etb [aufruftiefe].line table,i) 
+          PER
+  FI.
+
+prepare screen :
+  calc command handling line; 
+  put file info.
+ 
+calc command handling line: 
+  out (""10""); (* down *)
+  INT VAR dummy, y; 
+  get cursor (dummy, y); 
+  FOR dummy FROM 1 UPTO y-22 REP
+     out (""10"") 
+  PER; 
+  zeile := max (command handling line, min (y + 1, 22)). 
+ 
+perhaps reorganize and get command :
+  BOOL VAR anything reorganized :: FALSE, 
+           was error :: FALSE ;
+  IF is error
+   THEN command line := old command;
+        out (""3""); (* up *)
+        put error; clear error; was error := TRUE
+   ELSE command line := "" 
+  FI;
+  out (        "      ");
+  out (gib kommando);
+  out (""13""10"      ");
+  IF NOT was error THEN perhaps reorganize  FI;
+  IF anything reorganized
+  THEN command index := no command;
+       LEAVE perhaps reorganize and get command
+  FI;
+  editget (command line, "", "fk", ch);
+  IF ch = ""27"k"
+  THEN out (""13""5"");
+       command line := old command;
+       out ("      ");
+       editget (command line, "", "f", ch) 
+  FI;
+  line;
+  old command := command line;
+  command index := cmd index (command line);
+  param position (LENGTH command line + 7);
+  IF (command index > 0 AND command index <= max file) 
+                        AND command indices > 0
+  THEN short command := TRUE
+  ELSE short command := FALSE;
+       analyze command (command list, command line, integer is allowed,
+                        command index, number of params,param 1, param 2)
+  FI.
+
+perhaps reorganize :
+  BOOL VAR interrupt;
+  ch := getcharety;
+  IF ch <> "" 
+   THEN push (ch); LEAVE perhaps reorganize 
+  FI;
+  ch := incharety (50);
+  IF ch <> "" 
+   THEN type (ch); LEAVE perhaps reorganize 
+  FI;
+  FOR i FROM 1 UPTO max file REP
+    reorganize (etb [i].name, anything reorganized, interrupt, i);
+  UNTIL interrupt OR anything reorganized  PER.
+
+close all files if not nested :
+  aufruftiefe DECR 1;
+  command index := 0; (* Um die verschachtelten Aufrufe zu schuetzen *)
+  verlasse monitor := aufruftiefe = 0;
+  IF aufruftiefe > 0 
+     THEN FOR i FROM 1 UPTO max file REP 
+            etb [i].name := name (etb [aufruftiefe].line table,i)
+          PER; 
+     ELSE param 1      := "";
+          param 2      := "";
+          command line := "";
+          old command  := ""
+   FI.
+
+collect heap garbage if necessary :
+  IF heap size > previous heap size + 4
+  THEN collect heap garbage;
+       previous heap size := heap size
+  FI
+ENDPROC edit monitor;
+
+PROC put file info: 
+  INT VAR i;
+    out (""1""); (* home *) 
+  FOR i FROM 1 UPTO max file WHILE NOT is incharety REP
+    out (text (i, 2));
+    out (" : ");
+    IF info 
+     THEN show file info
+    FI;
+    IF etb [i].name <> "" 
+     THEN out ("""" + etb [i].name + """")
+    FI;
+    out (""5""10""13"")
+  PER;
+  out(""5"");
+  cursor (1, zeile).
+ 
+show file info :
+  (* Falls fileinfo an, werden vor den Dateinamen bei FILEs die Anzahl von
+     Zeilen , Segmenten und Speicher angezeigt.                         *)
+  IF exists (etb [i].name) 
+     THEN IF type (old (etb [i].name)) = file type 
+           THEN out (text (lines (etb [i].file), 5));
+                out (" ");
+                out (text (segments (etb [i].file), 4));
+                out (" ")
+           ELSE out ( 11 * "=")
+          FI; 
+          out (text (storage (old (etb [i].name)),5))
+     ELIF etb [i].name <> ""
+     THEN out ( 16 * "=") 
+  FI;
+  out ("  ").
+
+END PROC put file info; 
+ 
+PROC execute command :
+  enable stop;
+  IF command index = no command THEN LEAVE execute command  FI;
+  IF short command  THEN do edit monitor command (command index) 
+                    ELSE case selection  FI.
+
+case selection :
+  SELECT command index OF
+    CASE 1 : (* quit *)  verlasse monitor := TRUE
+    CASE 2 : edit (name from list (param 1))
+    CASE 3 : run (name from list (param 1))
+    CASE 4 : insert (name from list (param 1))
+    CASE 5 : forget (name from list (param 1)); close (int (param1))
+    CASE 6 : rename (name from list (param 1) , name from list (param 2))
+    CASE 7 : copy (name from list (param 1), name from list (param 2))
+    CASE 8 : fetch (name from list (param 1))
+    CASE 9 : save (name from list (param 1))
+    CASE 10: close (int (param 1))
+    CASE 11: info := NOT info
+    CASE 12: reorganize (name from list (param 1))
+    OTHERWISE do (command line) 
+  END SELECT 
+END PROC execute command;
+
+PROC close (INT CONST n) :
+  IF (n > 0  AND n <= max file)  CAND  etb [n].name <> ""
+  THEN IF exists (etb [n].name) CAND type (old (etb [n].name)) = file type
+          THEN close (etb [n].file) 
+       FI;
+       INT VAR id;
+       delete (etb [aufruftiefe].line table,etb [n].name,id); 
+       etb [n].name := ""
+  FI
+END PROC close;
+
+TEXT OP F (INT  CONST nr) :
+     IF nr > 0 AND nr <= max file
+      THEN etb [nr].name
+      ELSE out (""7""); "" 
+     FI
+END OP F;
+
+OP F (INT CONST nr, TEXT CONST datei) :
+    IF nr > 0 AND nr <= max file
+     THEN etb [nr].name := datei;
+          insert (etb [aufruftiefe].line table,datei);
+          IF exists (datei) CAND type (old (datei)) = file type
+           THEN etb [nr].file := sequential file(modify, datei) 
+          FI
+     ELSE out (""7"") 
+    FI
+END OP F;
+
+PROC get new table: 
+ table (some (all + etb [aufruftiefe].line table + vorgaenger)). 
+ 
+ vorgaenger: 
+  IF aufruftiefe = 1 
+   THEN empty thesaurus 
+   ELSE etb [aufruftiefe - 1].line table
+  FI
+END PROC get new table; 
+ 
+THESAURUS PROC table :
+  THESAURUS VAR result :: emptythesaurus;
+  INT VAR i;
+  FOR i FROM 1 UPTO max file REP
+    IF exists (etb [i].name) AND NOT (result CONTAINS etb [i].name)
+     THEN insert (result, etb [i].name) 
+    FI
+  PER;
+  result
+END PROC table;
+
+PROC table (THESAURUS CONST new) :
+  INT VAR i, nr :: 1, dummy;
+  TEXT VAR t;
+  etb [aufruftiefe].line table := empty thesaurus; 
+  FOR i FROM 1 UPTO max file REP
+    etb [i].name := ""
+  PER;
+  FOR i FROM 1 UPTO highest entry (new) REP
+    get (new, t, dummy);
+    IF t <> ""
+     THEN nr F t;nr INCR 1
+    FI
+  UNTIL nr > max file  PER
+END PROC table;
+
+PROC do edit monitor command (INT CONST file nr) :
+  enable stop;
+  IF command indices = 1 
+     THEN try to edit or to execute
+     ELSE try alpha editor 
+  FI.
+
+try to edit or to execute:
+  SELECT prepare edit (file nr) OF
+    CASE edit code: last param (etb [file nr].name);
+                    edit   (etb [file nr].file);
+                    page
+    CASE do code  : do (etb[file nr].name)
+  END SELECT. 
+ 
+try alpha editor: 
+  IF command indices <= 10 
+     THEN open sub editors; 
+          IF groesster editor > 0 
+             THEN edit (1); 
+                  WHILE groesster editor > 0 REP
+                        quit
+                  PER;
+                  page
+          FI
+     ELSE errorstop ("Maximal 10 Parallel-Editoren") 
+  FI. 
+ 
+open sub editors: 
+  TEXT VAR num, edit cmd :: ""; 
+  INT VAR ye :: 1, sub :: file nr, pass;
+  WHILE groesster editor > 0 REP
+        quit
+  PER;
+  FOR pass FROM 1 UPTO 2 REP 
+     IF pass = 2
+        THEN command line := edit cmd
+     FI;
+     scan (command line);
+     next symbol (num);                 (* skip ersten index *)
+     REP
+        INT VAR op code := prepare edit (sub);
+        IF pass = 1
+           THEN SELECT op code OF
+                  CASE nil code : command indices DECR 1
+                  CASE editcode : edit cmd CAT (num + " ")
+                  CASE do code  : edit cmd CAT (num + " ");
+                                  command indices DECR 1 
+                END SELECT
+           ELSE SELECT op code OF
+                  CASE edit code: neuer editor
+                  CASE do   code: do (etb [sub].name); 
+                                  IF groesster editor > 0 
+                                     THEN bild zeigen;     
+                                          ueberschrift zeigen 
+                                  FI 
+                END SELECT
+        FI; 
+        next symbol (num);
+        sub := int (num)
+     UNTIL num = "" PER;
+     sub := file nr;
+  PER.
+
+  neuer editor: 
+    open editor (groesster editor+1,etb [sub].file, TRUE, 1,ye,79,25-ye); 
+    ye INCR (24 DIV command indices)
+
+END PROC do edit monitor command;
+
+INT PROC prepare edit (INT CONST file nr): 
+  IF file nr > 0 AND file nr <= max file
+     THEN IF etb [file nr].name = "" 
+             THEN get file name and open;
+                  IF etb [file nr].name <> "" 
+                     THEN IF exists (etb [file nr].name) 
+                             THEN IF type (old (etb [file nr].name)) = file type
+                                   THEN edit code
+                                   ELSE nil code
+                                  FI 
+                             ELSE do code
+                          FI
+                     ELSE nil code
+                  FI
+          ELIF NOT exists (etb [file nr].name)  
+             THEN do code
+          ELIF type (old (etb [file nr].name)) <> file type
+             THEN nil code
+             ELSE modify (etb [file nr].file);
+                  edit code
+          FI 
+     ELSE errorstop ("Undefinierter Index [1;15]");nil code
+  FI.
+  
+get file name and open :
+  cursor (4, file nr);
+  out (""5"? ");
+  editget (etb [file nr].name);
+  IF etb [file nr].name <> "" 
+     THEN file nr F etb [file nr].name; 
+          IF NOT exists (etb [file nr].name)
+             THEN out (""13""10"");
+                  IF no (5 * ""2"" +"Datei neu einrichten")
+                     THEN LEAVE prepare edit WITH nil code
+                     ELSE kopple file an
+                  FI
+           ELIF type (old (etb [file nr].name)) = file type
+             THEN kopple file an
+          FI
+   FI. 
+ 
+ kopple file an: 
+   etb [file nr].file := sequential file (output, etb [file nr].name). 
+ 
+END PROC prepare edit; 
+ 
+(***************** Hilfsprozeduren *********************************)
+
+BOOL PROC is incharety :
+  TEXT VAR ch :: getcharety; 
+  IF ch = "" 
+   THEN FALSE
+   ELSE push (ch); 
+        TRUE 
+  FI
+END PROC is incharety;
+
+TEXT PROC name from list (TEXT CONST name):
+  INT  VAR i :: int (name);
+  IF (i > 0  AND  i <= max file)
+   THEN etb [i].name
+   ELSE name
+  FI.
+END PROC name from list;
+ 
+PROC reorganize (TEXT CONST datei, BOOL VAR reorganization processed,
+                                            interrupted, 
+                                   INT CONST file nummer): 
+  (* Reorganisiert nur , falls :
+     1. Datei ein FILE ist
+     2. FILE mindestens "min lines to reorganize" Zeilen hat
+     3. FILE nicht im Schnitt "min lines per segment" Zeilen pro Segment hat
+     4. kein Tastendruck erfolgt
+   *)
+  DATASPACE VAR ds;
+  FILE VAR in, out;
+  TEXT VAR t;
+  INT VAR actual line,i,x,y;
+  get cursor (x,y);
+  interrupted := FALSE;
+  IF NOT exists (datei) COR type (old (datei)) <> file type
+   THEN LEAVE reorganize 
+  FI;
+  in := sequential file (modify, datei);
+  actual line := line no (in); 
+  input (in);
+  IF (lines (in) < 120 CAND segments (in) < 6) COR 
+     lines (in) DIV segments (in) >= min lines per segment
+   THEN modify (in);
+        to line (in,actual line); 
+        LEAVE reorganize
+  FI;
+  disable stop;
+  ds := nilspace;
+  out := sequential file (output, ds);
+  IF info 
+     THEN FOR i FROM 1 UPTO lines (in) REP
+              cursor (4, file nummer); 
+              put (i);
+              getline (in, t);
+              putline (out, t);
+              IF is error COR is incharety THEN interrupt  FI
+          PER 
+     ELSE FOR i FROM 1 UPTO lines (in) REP
+              getline (in, t);
+              putline (out, t);
+              IF is error COR is incharety THEN interrupt  FI
+          PER
+  FI; 
+  copy attributes (in,out);
+  modify (out);
+  to line (out,actual line);
+  forget (datei, quiet);
+  copy (ds, datei);
+  forget (ds);
+  reorganization processed := TRUE.
+
+interrupt :
+  cursor (4, lines (in)); 
+  forget (ds);
+  interrupted := TRUE;
+  cursor (x,y);
+  enable stop;
+  LEAVE reorganize.
+
+END PROC reorganize;
+
+INT PROC cmd index (TEXT CONST command line): 
+    INT VAR type, result :: 0; 
+    TEXT VAR num;
+    command indices := 0; 
+    scan (command line); 
+    REP 
+       next symbol (num, type); 
+       IF type = 3                     (* Ziffernfolge *) 
+          THEN IF command indices = 0 
+                  THEN result := int (num) 
+               FI; 
+               command indices INCR 1 
+       ELIF type <> 7 
+          THEN command indices := 0 
+       FI 
+    UNTIL type = 7 OR command indices = 0 PER; 
+    result 
+END PROC cmd index;
+
+TEXT PROC gib kommando: 
+  gib kommando 1 + text (aufruftiefe) + gib kommando 2 
+END PROC gib kommando; 
+ 
+END PACKET edit monitor; 
+ 
+(******************************** MANAGER ******************************)
+ 
+PACKET mpg global manager DEFINES monitor, 
+                                  break, 
+                                  end global manager, 
+                                  begin, 
+                                  begin password,
+                                  manager message,
+                                  manager question,
+                                  free manager,
+                                  std manager,
+                                  mpg manager,
+                                  free global manager,
+                                  global manager :
+
+
+LET ack              = 0,
+    nak              = 1,
+    error nak        = 2,
+    message ack      = 3,
+    question ack     = 4,
+    second phase ack = 5,
+    false code       = 6,
+
+    begin code       = 4,
+    password code    = 9,
+    fetch code       = 11,
+    save code        = 12,
+    exists code      = 13,
+    erase code       = 14,
+    list code        = 15,
+    all code         = 17,
+
+    killer code      = 24, 
+
+    continue code    = 100,
+ 
+    error pre        = ""7""13""10""5"Fehler : ",
+    cr lf            = ""13""10"";
+
+ 
+DATASPACE VAR ds := nilspace;
+ 
+BOUND STRUCT (TEXT fnam, write pass, read pass) VAR msg;
+BOUND TEXT VAR reply msg;
+ 
+TASK VAR order task, last order task;
+ 
+FILE VAR list file;
+INT VAR reply, order, last order, phase no;
+TEXT VAR error message buffer :: "",
+         record,
+         fnam,
+         create son password :: "",
+         save write password,
+         save read password,
+         save file fnam;
+ 
+TEXT VAR std begin proc :: "checkoff;endglobalmanager(TRUE);" +
+                           "warnings off;sysout("""");sysin("""");" +
+                           "monitor";
+BOOL VAR is global manager, is break manager;
+
+PROC mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+                  manager) :
+  IF online
+    THEN TEXT VAR dummy;
+         put ("Task-Passwort  :");
+         getsecretline (dummy);
+         IF dummy <> "" THEN taskpassword (dummy) FI;
+         put ("Beginn-Passwort:");
+         getsecretline (dummy);
+         IF dummy <> "" THEN begin password (dummy) FI
+  FI;
+  is break manager  := FALSE;
+  global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+                  manager)
+END PROC mpg manager;
+
+PROC global manager :
+  mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+               std manager)
+END PROC global manager;
+
+PROC global manager (PROC (DATASPACE VAR, INT CONST, INT CONST,
+                     TASK CONST) manager) :
+   is global manager := TRUE; 
+   internal manager (PROC (DATASPACE VAR,INT CONST,INT CONST, 
+                     TASK CONST) manager) 
+END PROC global manager; 
+ 
+PROC internal manager (PROC (DATASPACE VAR, INT CONST, INT CONST,
+                       TASK CONST) manager) :
+  old break;
+  set autonom;
+  disable stop;
+  command dialogue (FALSE);
+  last order task := niltask;
+  remember heap size;
+  REP
+    wait (ds, order, order task);
+    IF   order <> second phase ack
+      THEN prepare first phase;
+           manager (ds, order, phase no, order task)
+    ELIF order task = last order task
+      THEN prepare second phase;
+           manager (ds, order, phase no, order task)
+      ELSE send nak  FI;
+    send error if necessary;
+    collect heap garbage if necessary
+  UNTIL (NOT is global manager) AND (NOT is break manager)
+  PER;
+  command dialogue (TRUE);
+  reset autonom.
+
+send error if necessary :
+  IF is error
+    THEN forget (ds);
+         ds := nilspace;
+         reply msg := ds;
+         CONCR (reply msg) := error message;
+         clear error;
+         send (order task, error nak, ds)
+  FI .
+ 
+remember heap size :
+  INT VAR old heap size := heap size .
+
+collect heap garbage if necessary :
+  IF heap size > old heap size + 2
+    THEN collect heap garbage;
+         old heap size := heap size
+  FI .
+
+prepare first phase :
+  phase no := 1;
+  last order := order;
+  last order task := order task.
+
+prepare second phase :
+  phase no INCR 1;
+  order := last order.
+
+send nak :
+  forget (ds);
+  ds := nilspace;
+  send (order task, nak, ds)
+END PROC internal manager;
+
+PROC free global manager :
+  mpg manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+               free manager)
+END PROC free global manager;
+
+PROC std manager (DATASPACE VAR ds, INT CONST order, phase, 
+                  TASK CONST order task) :
+  IF (order = begin code AND task darf beginnen) COR
+                             task darf senden
+     THEN free manager (ds, order, phase, order task)
+     ELSE errorstop ("Kein Zugriffsrecht auf Task """ + name (myself) + """")
+  FI.
+
+  task darf beginnen:
+    (task ist systemtask OR task ist sohn) AND is global manager.
+
+  task darf senden:
+    task ist systemtask OR task ist sohn.
+
+  task ist systemtask:
+    ordertask < supervisor OR ordertask = supervisor.
+
+  task ist sohn:
+    order task < myself
+END PROC std manager;
+
+PROC free manager (DATASPACE VAR ds, INT CONST order, phase,
+                   TASK CONST order task) :
+  enable stop;
+  IF   order > continue code   AND
+       order task = supervisor THEN y maintenance
+  ELIF order = begin code AND is global manager
+    THEN y begin
+    ELSE file manager order
+  FI .
+
+file manager order :
+  get message text if there is one;
+  SELECT order OF
+    CASE fetch code       : y fetch
+    CASE save code        : y save
+    CASE exists code      : y exists 
+    CASE erase code       : y erase
+    CASE list code        : y list
+    CASE all code         : y all
+    CASE killer code      : y killer
+    OTHERWISE errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """")
+  ENDSELECT .
+ 
+get message text if there is one :
+  IF order >= fetch code AND order <= erase code AND phase = 1 (* 28.6.'86 *)
+    THEN msg := ds;
+         fnam := msg.fnam
+  FI .
+ 
+y begin :
+  BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg := ds;
+  IF create son password = sv msg.tpass AND create son password <> "-"
+    THEN create son task
+  ELIF sv msg.tpass = ""
+    THEN ask for password
+  ELSE   errorstop ("Passwort falsch")
+  FI .
+
+create son task :
+  begin (ds, PROC std begin, reply);
+  send (order task, reply, ds) .
+
+ask for password :
+  send (order task, password code, ds) .
+
+y fetch :
+  IF read permission (fnam, msg.read pass) COR order task < supervisor
+    THEN forget (ds);
+         ds := old (fnam);
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y erase :
+  msg := ds;
+  fnam := msg.fnam;
+  IF NOT exists (fnam)
+    THEN manager message ("""" + fnam + """ existiert nicht", order task)
+  ELIF phase no = 1
+    THEN manager question ("""" + fnam + """ loeschen", order task)
+  ELIF write permission (fnam, msg.write pass) COR order task < supervisor
+    THEN forget (fnam, quiet);
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")  FI .
+ 
+y save :
+  IF phase no = 1
+    THEN ysave pre
+    ELSE y save post  FI.
+
+y save pre :
+  IF write permission (fnam, msg.write pass) COR order task < supervisor
+    THEN save file fnam := fnam;
+         save write password  := msg.write pass;
+         save read password   := msg.read pass;
+         IF exists (fnam)
+           THEN manager question (""""+fnam+""" ueberschreiben", order task)
+           ELSE send (order task, second phase ack, ds)
+         FI;
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y save post :
+  forget (save file fnam, quiet);
+  copy (ds, save file fnam);
+  enter password (save file fnam,
+                  save write password, save read password);
+  forget (ds);
+  ds := nilspace;
+  send (order task, ack, ds);
+  cover tracks of save passwords.
+
+cover tracks of save passwords :
+  replace (save write password, 1, LENGTH save write password * " ");
+  replace (save read  password, 1, LENGTH save read  password * " ") .
+
+y exists :
+  IF exists (fnam)
+    THEN send (order task, ack, ds)
+    ELSE send (order task, false code, ds)
+  FI.
+
+y list :
+  forget (ds);
+  ds := nilspace;
+  list file := sequential file (output, ds);
+  list (list file);
+  send (order task, ack, ds) .
+ 
+y all :
+  BOUND THESAURUS VAR all fnams := ds;
+  all fnams := all;
+  send (order task, ack, ds) .
+ 
+y maintenance :
+  TEXT VAR  param 1, param 2;
+  INT  VAR  c index, nr of params;
+  TEXT CONST c list :: "break:1.0end:2.0monitor:3.0stdbeginproc:4.1";
+  disable stop;
+  call (supervisor, order, ds, reply);
+  forget (ds);
+  IF reply = ack
+    THEN IF is break manager
+           THEN end global manager (TRUE);
+                LEAVE y maintenance
+         FI;
+         put error message if there is one;
+         REP 
+           command dialogue (TRUE);
+           get command ("Gib " + name (myself) + "-Kommando :");
+           analyze command (c list,0,c index,nr of params,param 1,param 2);
+           SELECT c index OF
+             CASE 1    : old break
+             CASE 2, 3 : is global manager := FALSE;
+                         is break manager  := FALSE;
+                         LEAVE y maintenance
+             CASE 4    : std begin proc := param 1
+             OTHERWISE do command
+           END SELECT
+         UNTIL NOT on line PER;
+         command dialogue (FALSE);
+         old break;
+         set autonom;
+         save error message if there is one
+  FI;
+  enable stop .
+
+put error message if there is one :
+  IF error message buffer <> ""
+    THEN out (error pre);
+         out (error message buffer);
+         out (cr lf);
+         error message buffer := ""
+  FI.
+
+save error message if there is one :
+  IF is error
+    THEN error message buffer := error message;
+         clear error
+  FI.
+
+y killer :
+  FILE VAR f :: sequential file (input, ds);
+  WHILE NOT eof (f) REP
+    getline (f, record);
+    IF exists (record) THEN forget (record, quiet)  FI
+  PER;
+  send (order task, ack, ds).
+ENDPROC free manager;
+ 
+PROC manager question (TEXT CONST question) :
+  forget (ds);
+  ds := nilspace;
+  reply msg := ds;
+  reply msg := question;
+  send (order task, question ack, ds)
+END PROC manager question;
+
+PROC manager question (TEXT CONST question, TASK CONST receiver) :
+  forget (ds);
+  ds := nilspace;
+  reply msg := ds;
+  reply msg := question;
+  send (receiver, question ack, ds)
+END PROC manager question;
+
+PROC manager message (TEXT CONST message) :
+  forget (ds);
+  ds := nilspace;
+  reply msg := ds;
+  reply msg := message;
+  send (order task, message ack, ds)
+END PROC manager message;
+
+PROC manager message (TEXT CONST message, TASK CONST receiver) :
+  forget (ds);
+  ds := nilspace;
+  reply msg := ds;
+  reply msg := message;
+  send (receiver, message ack, ds)
+END PROC manager message;
+
+PROC std begin :
+  do (std begin proc)
+ENDPROC std begin;
+
+PROC begin (TEXT CONST task name) :
+  TASK VAR sohn;
+  begin (task name, PROC monitor, sohn)
+END PROC begin;
+
+PROC begin password (TEXT CONST password) :
+  cover tracks of old create son password;
+  create son password := password;
+  display (""3""13""5"");
+  cover tracks.
+
+cover tracks of old create son password:
+  replace (create son password,1,LENGTH create son password * " ")
+END PROC begin password;
+
+PROC end global manager (BOOL CONST ende) :
+  is global manager := NOT ende;
+  is break manager  := NOT ende
+ENDPROC end global manager;
+
+PROC old break :
+  eumel must advertise;
+  supervisor call (6)
+END PROC old break;
+
+PROC break :
+  IF is global manager 
+    THEN old break; LEAVE break
+  FI;
+  is break manager  := TRUE;
+  is global manager := FALSE; 
+  internal manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 
+                    std manager)
+END PROC break;
+
+PROC supervisor call (INT CONST nr) :
+  DATASPACE VAR sv space :: nilspace;
+  INT VAR answer;
+  call (supervisor, nr, sv space, answer);
+  IF answer = error nak
+    THEN BOUND TEXT VAR err msg :: sv space;
+         forget (sv space); errorstop (err msg)
+  FI;
+  forget (sv space)
+END PROC supervisor call;
+
+ 
+ 
+LET cmd list =
+ 
+"edit:1.01end:3.0run:4.01runagain:6.0insert:7.01forget:9.01rename:11.2copy:12.2
+list:13.0storageinfo:14.0taskinfo:15.0fetch:16.1save:17.01saveall:19.0";
+ 
+ 
+INT VAR cmd index , params , previous heap size ;
+TEXT VAR param1, param2 ;
+ 
+ 
+PROC monitor :
+  disable stop ;
+  previous heap size := heap size ;
+  REP 
+    command dialogue (TRUE); 
+    sysin (""); 
+    sysout (""); 
+    cry if not enough storage; 
+    get command ("gib kommando :"); 
+    analyze command (cmd list, 4, cmd index, params, param1, param2);
+    execute command ;
+    collect heap garbage if necessary
+  PER .
+ 
+collect heap garbage if necessary :
+  IF heap size > previous heap size + 4
+    THEN collect heap garbage ;
+         previous heap size := heap size
+  FI.
+
+cry if not enough storage : 
+  INT VAR size, used; 
+  storage (size, used); 
+  IF used > size 
+    THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"") 
+  FI. 
+ENDPROC monitor ;
+
+PROC execute command :
+  enable stop ;
+  SELECT cmd index OF
+    CASE 1 : edit
+    CASE 2 : edit (param1)
+    CASE 3 : end
+    CASE 4 : run
+    CASE 5 : run (param1)
+    CASE 6 : run again
+    CASE 7 : insert
+    CASE 8 : insert (param1)
+    CASE 9 : forget
+    CASE 10: forget (param1)
+    CASE 11: rename (param1, param2)
+    CASE 12: copy (param1, param2)
+    CASE 13: list
+    CASE 14: storage info
+    CASE 15: task info
+    CASE 16: fetch (param1)
+    CASE 17: save
+    CASE 18: save (param1)
+    CASE 19: save all 
+    OTHERWISE do command
+  ENDSELECT .
+ 
+ENDPROC  execute command ;
+
+END PACKET mpg global manager
+
diff --git a/app/mpg/2.2/src/VC 404 2-7.GCONF b/app/mpg/2.2/src/VC 404 2-7.GCONF
new file mode 100644
index 0000000..b70c9e5
--- /dev/null
+++ b/app/mpg/2.2/src/VC 404 2-7.GCONF
@@ -0,0 +1,93 @@
+INCLUDE "terminal plot"; 
+INCLUDE "std primitives"; 
+ 
+PLOTTER "VC 404",2,7,78,47,21.5,16.0; 
+ 
+COLORS "000999";
+ 
+PROC clear: 
+  IF plot
+  THEN INT VAR vc i;
+       FOR vc i FROM 1 UPTO 24
+       REP display [vc i] := empty line PER;
+       page
+  ELSE errorstop ("PROC clear : clear without plotmodus") FI
+END PROC clear; 
+ 
+PROC prepare:
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare;
+
+PROC initplot: 
+  plot := TRUE;
+  cursor (x pos + 1,  24 - (y pos) DIV 2)
+END PROC initplot;
+ 
+PROC endplot: 
+  pause;
+  plot := FALSE
+END PROC endplot; 
+ 
+PROC home: 
+   move to (0,0)
+END PROC home;
+ 
+PROC moveto (INT CONST x,y): 
+  x pos := x ;
+  y pos := y
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+  new x pos := x;
+  new y pos := y;
+  plot vector (new x pos - x pos, new y pos - y pos) ;
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+   move to (x,y);
+   point
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   type := 1
+END PROC foreground;
+
+PROC background (INT VAR type):
+   type := 0
+END PROC background; 
+        
+PROC setpalette:
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1,y1,x2,y2,pattern)
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill;
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF b/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF
new file mode 100644
index 0000000..9accb3f
--- /dev/null
+++ b/app/mpg/2.2/src/VIDEOSTAR 3-6.GCONF
@@ -0,0 +1,92 @@
+INCLUDE "std primitives"; 
+ 
+PLOTTER "VIDEOSTAR",3,6,640,480,27.0,19.5; 
+ 
+COLORS "000999";
+ 
+TEXT PROC koordinaten (INT CONST x,y):
+  code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) +
+  code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32))
+END PROC koordinaten; 
+ 
+PROC clear: 
+   out (""29""27""140""27"/0d");
+   moveto(0,0)
+END PROC clear; 
+ 
+PROC prepare:
+    break(quiet);
+    REP 
+       disable stop;
+       continue (channel(plotter)); 
+       clear error;
+       enable stop; 
+       IF NOT online 
+          THEN pause (300)
+       FI
+    UNTIL online PER
+END PROC prepare;
+
+PROC initplot: 
+END PROC initplot;
+ 
+PROC endplot: 
+   pause;
+   out(""24"")
+END PROC endplot; 
+
+PROC home: 
+   moveto (0,0)
+END PROC home;
+
+PROC moveto (INT CONST x,y): 
+   out (""29""29"");
+   out (koordinaten (x,y)) 
+END PROC moveto; 
+ 
+PROC drawto (INT CONST x,y): 
+   out (koordinaten(x,y)) 
+END PROC drawto; 
+ 
+PROC setpixel (INT CONST x,y): 
+   out (""28""); 
+   out (koordinaten (x,y)) 
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   IF   type = 0 THEN out (""27"/1d")            (* loeschend *) 
+   ELIF type < 0 THEN out (""27"/2d");type := -1 (* XOR *) 
+                 ELSE out (""27"/0");type  := 1  (* normal *) 
+   FI 
+END PROC foreground;
+
+PROC background (INT VAR type):
+   type := 0 
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+ 
+PROC circle (INT CONST x,y,rad,from,to): 
+   IF full circle inside screen 
+      THEN out (""29"" + koordinaten(x, y) + ""27"C" + 
+           subtext (koordinaten(0,rad),1,3) + ""28""); 
+      ELSE std circle (x,y,rad,from,to) 
+   FI. 
+  
+   full circle inside screen:
+      (from = 0 AND to = 360) AND
+      (x + rad) < 640 AND (x - rad >= 0) AND 
+      (y + rad) < 480 AND (y - rad >= 0)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1, y1, x2, y2, pattern) 
+END PROC box;
+
+PROC fill (INT CONST x,y,pattern): 
+   moveto (x,y);
+   out (""27"F");
+END PROC fill;
+
+
diff --git a/app/mpg/2.2/src/WATANABE 3-8.GCONF b/app/mpg/2.2/src/WATANABE 3-8.GCONF
new file mode 100644
index 0000000..66e4856
--- /dev/null
+++ b/app/mpg/2.2/src/WATANABE 3-8.GCONF
@@ -0,0 +1,94 @@
+INCLUDE "std primitives"; 
+PLOTTER "WATANABE",3,8,3449,2599,34.5,26.0; 
+ 
+COLORS "999000900009090000990"; 
+ 
+LET  terminator = ""13"";
+TEXT VAR watanabe polygon :: ""; 
+ 
+PROC watanabe pen (INT CONST nummer):
+   draw watanabe polygon; 
+   INT VAR pen no := nummer;
+   IF pen no > 6 OR pen no < 0
+      THEN pen no := 1 
+   FI;
+   out ("J" + text(pen no) + terminator) 
+END PROC watanabe pen;
+
+PROC draw watanabe polygon: 
+   IF watanabe polygon <> "" 
+      THEN out ("D" + subtext (watanabe polygon,2) + terminator) 
+   FI; 
+   watanabe polygon := "" 
+END PROC draw watanabe polygon; 
+
+PROC prepare:
+   continue (channel (plotter))
+END PROC prepare; 
+
+PROC initplot: 
+   watanabe polygon := ""; 
+   TEXT VAR watanabe wait; 
+   REP 
+   UNTIL incharety = "" PER; 
+   out("M1500,1500"13"");          (* Signal ! *)
+   inchar(watanabe wait);
+   disable stop 
+END PROC initplot;
+
+PROC endplot: 
+   watanabe pen (0); 
+   home;
+   IF is error 
+      THEN break (quiet) 
+   FI; 
+   enable stop 
+END PROC endplot; 
+ 
+PROC clear: 
+   watanabe pen (1)
+END PROC clear; 
+ 
+PROC home: 
+   draw watanabe polygon; 
+   out ("H" + terminator) 
+END PROC home; 
+ 
+PROC moveto (INT CONST x,y): 
+   draw watanabe polygon; 
+   out ( "M" + text(x) + "," + text(y) + terminator) 
+END PROC moveto;
+ 
+PROC drawto (INT CONST x,y): 
+   watanabe polygon CAT "," + text (x) + "," + text (y) 
+END PROC drawto;
+
+PROC setpixel (INT CONST x,y): 
+   move to (x,y); 
+   out ("N1" + terminator) 
+END PROC setpixel;
+
+PROC foreground (INT VAR type): 
+   type := min (max (type, 0), 6); 
+   watanabe pen (type) 
+END PROC foreground; 
+ 
+PROC background (INT VAR type):
+   type := 0 
+END PROC background; 
+        
+PROC setpalette: 
+END PROC setpalette;
+
+PROC circle (INT CONST x,y,rad,from,to): 
+   std circle (x,y,rad,from,to)
+END PROC circle; 
+ 
+PROC box (INT CONST x1,y1,x2,y2,pattern): 
+   std box (x1,y1,x2,y2,pattern) 
+END PROC box; 
+ 
+PROC fill (INT CONST x,y,pattern): 
+END PROC fill; 
+ 
+
diff --git a/app/mpg/2.2/src/ZEICHENSATZ b/app/mpg/2.2/src/ZEICHENSATZ
new file mode 100644
index 0000000..0414682
--- /dev/null
+++ b/app/mpg/2.2/src/ZEICHENSATZ
diff --git a/app/mpg/2.2/src/matrix printer b/app/mpg/2.2/src/matrix printer
new file mode 100644
index 0000000..66157cf
--- /dev/null
+++ b/app/mpg/2.2/src/matrix printer
@@ -0,0 +1,130 @@
+(* Version vom 21.10.87 BJ *) 
+(* Standardoperationen *) 
+(*   printer line - Linienalgorithmus *) 
+(*   printer fill - Fuellalgorithmus *) 
+ 
+PROC printer line (INT CONST x1,y1,x2,y2,
+                   PROC (INT CONST, INT CONST) p set pixel): 
+  INT VAR x,y,z,             
+          a,b,d, 
+          dx :: abs(x2-x1), 
+          dy :: abs(y2-y1), 
+          dp,dq; 
+  IF dx <> 0 AND dy <> 0 
+    THEN IF dy <= dx 
+           THEN draw line 1 
+           ELSE draw line 2 
+         FI 
+    ELSE IF dx = 0 AND dy <> 0 
+            THEN draw vertical line 
+            ELSE draw horizontal line 
+         FI 
+  FI. 
+ 
+  draw line 1: 
+    x := x1;
+    y := y1; 
+    z := x2; 
+    a := sign(x2-x1); 
+    b := sign(y2-y1);
+    dp := dy * 2; 
+    d := dp - dx; 
+    dq := dp - 2 * dx; 
+    setpoint; 
+    WHILE x <> z REP 
+      x := x + a;
+      IF d < 0 
+        THEN d := d + dp 
+        ELSE y := y + b; 
+             d := d + dq
+      FI; 
+      setpoint 
+    PER. 
+ 
+  draw line 2: 
+    x := x1;
+    y := y1; 
+    z := y2; 
+    b := sign(x2-x1); 
+    a := sign(y2-y1);
+    dp := dx * 2; 
+    d := dp - dy; 
+    dq := dp - 2 * dy; 
+    setpoint; 
+    WHILE y <> z REP 
+      y := y + a;
+      IF d < 0 
+        THEN d := d + dp 
+        ELSE x := x + b; 
+             d := d + dq
+      FI; 
+      setpoint 
+    PER. 
+
+  draw vertical line: 
+    a := sign(y2-y1); 
+    x := x1; 
+    y := y1; 
+    z := y2; 
+    setpoint; 
+    WHILE y <> z REP 
+      y := y + a; 
+      setpoint 
+    PER. 
+ 
+  draw horizontal line: 
+    a := sign(x2-x1); 
+    x := x1; 
+    y := y1; 
+    z := x2; 
+    setpoint; 
+    WHILE x <> z REP 
+      x := x + a; 
+      setpoint 
+    PER. 
+ 
+  setpoint: 
+    p set pixel (x,y) 
+END PROC printer line; 
+ 
+PROC printer fill (INT CONST xl, xr, y, dir,
+                   BOOL PROC (INT CONST, INT CONST) point,
+                   PROC (INT CONST, INT CONST) pset):
+  INT VAR xl1 :: xl; 
+  WHILE point(xl1,y) REP 
+    xl1 INCR 1;
+    IF xl1 >= xr
+      THEN LEAVE printer fill
+    FI
+  PER;
+  INT VAR xrn :: xl1+1, 
+          xln :: xl1; 
+  WHILE NOT point(xrn,y) REP 
+    pset(xrn,y); 
+    xrn INCR 1 
+  PER;
+  WHILE NOT point(xln,y) REP 
+    pset(xln,y); 
+    xln DECR 1 
+  PER; 
+  IF xrn > xr 
+    THEN printer fill (xr, xrn-1,y-dir,-dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+    ELSE printer fill (xrn, xr, y, dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+  FI; 
+  IF xln < xl 
+    THEN printer fill (xln+1,xl, y-dir,-dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+    ELSE printer fill (xl,xln, y, dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+  FI; 
+  printer fill(xln+1, xrn-1, y+dir, dir, 
+               BOOL PROC (INT CONST, INT CONST) point,
+               PROC (INT CONST, INT CONST) pset)
+END PROC printer fill;
+
diff --git a/app/mpg/2.2/src/printer.targets b/app/mpg/2.2/src/printer.targets
new file mode 100644
index 0000000..c4e4e53
--- /dev/null
+++ b/app/mpg/2.2/src/printer.targets
@@ -0,0 +1,3 @@
+2/NEC P 9\#fonttab.nec.p9 
+3/NEC P 3\#fonttab.nec.p3-2 
+
diff --git a/app/mpg/2.2/src/std primitives b/app/mpg/2.2/src/std primitives
new file mode 100644
index 0000000..ab3877c
--- /dev/null
+++ b/app/mpg/2.2/src/std primitives
@@ -0,0 +1,80 @@
+PROC std circle (INT CONST xp,yp,r,from,to): 
+   moveto (xp,yp);
+   REAL VAR ang :: real (from MOD 360),
+            rad :: real(r),
+            max :: endwinkel,
+            cx  :: real (xp),
+            cy  :: real (yp),
+            ax0 :: cx,
+            ay0 :: cy,
+            ax1, ay1;
+
+   BOOL VAR fullcircle :: ang = 0.0 AND max = 360.0;
+   IF fullcircle
+      THEN move to (int (cx + rad * cosd (ang)+0.5), 
+                    int (cy + rad * -sind (ang)+0.5));
+           ang INCR 1.0
+   FI;
+   WHILE ang <= max REP 
+     ax1 := cx + rad * cosd (ang);
+     ay1 := cy + rad * -sind (ang); 
+     draw arc;
+     ang INCR 1.0 
+   PER; 
+   IF  NOT fullcircle
+      THEN  ax0 := cx;
+            ay0 := cy;
+            draw arc;
+            draw to (xp,yp)
+      ELSE  move to (xp,yp)
+   FI. 
+
+   draw arc: 
+      IF clipped line (ax0,ay0,ax1,ay1) 
+         THEN draw to (int (ax1+0.5), int (ay1+0.5)) 
+      FI; 
+      ax0 := ax1; 
+      ay0 := ay1. 
+ 
+   endwinkel: 
+      IF (to MOD 360) = 0 
+         THEN 360.0 
+         ELSE real (to MOD 360) 
+      FI 
+END PROC std circle; 
+ 
+PROC std box (INT CONST x0, y0, x1, y1, pattern): 
+      REAL VAR xx0 :: real (x0), 
+               yy0 :: real (y0), 
+               xx1 :: real (x0), 
+               yy1 :: real (y1); 
+      IF clipped line (xx0,yy0,xx1,yy1)
+         THEN moveto (int (xx0), int (yy0)); 
+              drawto (int (xx1), int (yy1)) 
+      FI; 
+      xx0 := real (x0); 
+      yy0 := real (y1); 
+      xx1 := real (x1); 
+      yy1 := real (y1); 
+      IF clipped line (xx0,yy0,xx1,yy1) 
+         THEN moveto (int (xx0), int (yy0)); 
+              drawto (int (xx1), int (yy1)) 
+      FI; 
+      xx0 := real (x1); 
+      yy0 := real (y1); 
+      xx1 := real (x1); 
+      yy1 := real (y0); 
+      IF clipped line (xx0,yy0,xx1,yy1) 
+         THEN moveto (int (xx0), int (yy0)); 
+              drawto (int (xx1), int (yy1)) 
+      FI; 
+      xx0 := real (x1); 
+      yy0 := real (y0); 
+      xx1 := real (x0); 
+      yy1 := real (y0); 
+      IF clipped line (xx0,yy0,xx1,yy1) 
+         THEN moveto (int (xx0), int (yy0)); 
+              drawto (int (xx1), int (yy1)) 
+      FI
+END PROC std box;
+
diff --git a/app/mpg/2.2/src/terminal plot b/app/mpg/2.2/src/terminal plot
new file mode 100644
index 0000000..21a17ff
--- /dev/null
+++ b/app/mpg/2.2/src/terminal plot
@@ -0,0 +1,114 @@
+(* Prozeduren zur Ausgabe auf ASCII-Terminals *)
+INT CONST up         :=  1 ,
+          right      :=  1 ,
+          down       := -1 ,
+          left       := -1 ;
+ 
+INT VAR x pos := 0 ,
+        y pos := 0 ,
+        new x pos ,
+        new y pos ;
+ 
+BOOL VAR plot := FALSE;
+TEXT CONST empty line :: 79 * " ";
+ROW 24 TEXT VAR display;
+ 
+ 
+PROC plot vector (INT CONST dx , dy) :
+ 
+  IF dx >= 0
+    THEN IF   dy >  dx THEN vector (y pos, x pos, dy, dx, up, right)
+         ELIF dy >   0 THEN vector (x pos, y pos, dx, dy, right, up)
+ 
+         ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down)
+         ELSE               vector (y pos, x pos, -dy, dx, down, right)
+         FI
+    ELSE IF   dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left)
+         ELIF dy >   0 THEN vector (x pos, y pos, -dx, dy, left, up)
+ 
+         ELIF dy >  dx THEN vector (x pos, y pos, -dx, -dy, left, down)
+         ELSE               vector (y pos, x pos, -dy, -dx, down, left)
+         FI
+  FI .
+ 
+ENDPROC plot vector ;
+ 
+PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :
+
+  prepare first step ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO dx REP
+    do one step
+  PER .
+ 
+prepare first step :
+  point;
+  INT VAR old error := 0 ,
+          up right error := dy - dx ,
+          right error    := dy .
+ 
+do one step :
+  IF right is better
+    THEN do right step
+    ELSE do up right step
+  FI .
+ 
+right is better :
+  abs (old error + right error) < abs (old error + up right error) .
+ 
+do upright step :
+  x pos INCR right ;
+  y pos INCR up ;
+  point ;
+  old error INCR upright error .
+ 
+do right step :
+  x pos INCR right ;
+  point ;
+  old error INCR right error .
+ 
+ENDPROC vector ;
+ 
+ 
+PROC point :
+  IF x pos < 1
+  THEN x pos := 1
+  ELIF x pos > 78
+  THEN x pos := 78 FI;
+
+  IF y pos < 1
+  THEN y pos := 1
+  ELIF y pos > 47
+  THEN y pos := 47 FI;
+
+  INT CONST line :: y pos DIV 2;
+  BOOL CONST above :: (y pos MOD 2) = 1;
+  TEXT CONST point :: display [line+1] SUB (x pos+1),
+             new point :: calculated point;
+ 
+  replace (display [line+1], x pos+1, new point);
+  cursor (x pos, 24-line);
+  out (new point) .
+ 
+calculated point :
+  IF above
+  THEN IF point = "," OR point = "|"
+       THEN "|"
+       ELSE "'" FI
+  ELSE IF point = "'" OR point = "|"
+       THEN "|"
+       ELSE "," FI
+  FI
+ 
+END PROC point;
+ 
+REAL CONST real max int := real (max int);
+INT PROC round (REAL CONST x) :
+  IF x > real max int
+  THEN max int
+  ELIF x < 0.0
+  THEN 0
+  ELSE int (x + 0.5) FI
+
+END PROC round;
+
diff --git a/app/schulis-mathematiksystem/1.0/source-disk b/app/schulis-mathematiksystem/1.0/source-disk
new file mode 100644
index 0000000..64e5484
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/source-disk
@@ -0,0 +1 @@
+schulis-mathematiksystem-1.0/04_mathematiksystem.img
diff --git a/app/schulis-mathematiksystem/1.0/src/PAC element row b/app/schulis-mathematiksystem/1.0/src/PAC element row
new file mode 100644
index 0000000..574160c
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/PAC element row
@@ -0,0 +1,3 @@
+PACKETelementrowDEFINES ELEMROW,:=,clear,length,insert,delete,append,remove,define,recall,field,pos,sup,inf,min,max,MIN,MAX,EXC,:LETminelement=1,maxelement=1000;LETminfield=1,maxfield=4;TYPE ELEMROW=STRUCT(INTused,ROWmaxelementROWmaxfieldINTf);OP:=(ELEMROW VARd,ELEMROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCclear(ELEMROW VARt):t.used:=0;END PROCclear;INT PROClength(ELEMROW CONSTt):t.usedEND PROClength;PROCinsert(ELEMROW VARt,INT CONSTk):insert(t,k,0,0,0,0);END PROCinsert;PROCinsert(ELEMROW VARt,INT CONSTk,INT CONSTa,b,c,d):checkelement(k," bei 'insert'");checkfilled(t.used," bei 'insert'");INT VARi:=t.used;WHILEi>=kREPt.f[i+1]:=t.f[i];iDECR1PER;t.usedINCR1;t.f[k][1]:=a;t.f[k][2]:=b;t.f[k][3]:=c;t.f[k][4]:=d;END PROCinsert;PROCdelete(ELEMROW VARt,INT CONSTk):IFk<minelementORk>t.usedTHEN LEAVEdeleteFI;INT VARi:=k;WHILEi<t.usedREPt.f[i]:=t.f[i+1];iINCR1PER;t.usedDECR1;END PROCdelete;PROCdelete(ELEMROW VARt,INT CONSTk,INT VARa,b,c,d):IFk<minelementORk>t.usedTHEN LEAVEdeleteFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];INT VARi:=k;WHILEi<t.usedREPt.f[i]:=t.f[i+1];iINCR1PER;t.usedDECR1;END PROCdelete;PROCappend(ELEMROW VARt):append(t,0,0,0,0);END PROCappend;PROCappend(ELEMROW VARt,INT CONSTa,b,c,d):checkfilled(t.used," bei 'append'");t.usedINCR1;t.f[t.used][1]:=a;t.f[t.used][2]:=b;t.f[t.used][3]:=c;t.f[t.used][4]:=d;END PROCappend;PROCremove(ELEMROW VARt):checkempty(t.used," bei 'remove'");t.usedDECR1;END PROCremove;PROCremove(ELEMROW VARt,INT VARa,b,c,d):checkempty(t.used," bei 'remove'");a:=t.f[t.used][1];b:=t.f[t.used][2];c:=t.f[t.used][3];d:=t.f[t.used][4];t.usedDECR1;END PROCremove;PROCdefine(ELEMROW VARt,INT CONSTk,INT CONSTa,b,c,d):checkelement(k," bei 'define'");WHILEt.used<kREPappend(t)PER;t.f[k][1]:=a;t.f[k][2]:=b;t.f[k][3]:=c;t.f[k][4]:=d;END PROCdefine;PROCrecall(ELEMROW CONSTt,INT CONSTk,INT VARa,b,c,d):IFk<minelementORk>t.usedTHENa:=0;b:=0;c:=0;d:=0;LEAVErecallFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];END PROCrecall;PROCfield(ELEMROW VARt,INT CONSTk,n,INT CONSTv):checkelement(k," bei 'field'");checkfield(n," bei 'field'");WHILEt.used<kREPappend(t)PER;t.f[k][n]:=v;END PROCfield;INT PROCfield(ELEMROW CONSTt,INT CONSTk,n):IFk<minelementORk>t.usedORn<minfieldORn>maxfieldTHEN LEAVEfieldWITH0;FI;t.f[k][n]END PROCfield;PROCcheckempty(INT CONSTu,TEXT CONSTmsg):IFu<minelementTHENerrorstop("Element-Anzahl = "+text(u)+" < "+text(minelement)+msg)FI;END PROCcheckempty;PROCcheckfilled(INT CONSTu,TEXT CONSTmsg):IFu>=maxelementTHENerrorstop("Element-Anzahl = "+text(u)+" >= "+text(maxelement)+msg)FI;END PROCcheckfilled;PROCcheckelement(INT CONSTn,TEXT CONSTmsg):IFn<minelementTHENerrorstop("Element-Nummer = "+text(n)+" < "+text(minelement)+msg)FI;IFn>maxelementTHENerrorstop("Element-Nummer = "+text(n)+" > "+text(maxelement)+msg)FI;END PROCcheckelement;PROCcheckfield(INT CONSTn,TEXT CONSTmsg):IFn<minfieldTHENerrorstop("Feld-Nummer = "+text(n)+" < "+text(minfield)+msg)FI;IFn>maxfieldTHENerrorstop("Feld-Nummer = "+text(n)+" > "+text(maxfield)+msg)FI;END PROCcheckfield;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d):pos(t,a,b,c,d,1)END PROCpos;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]=aANDt.f[p][2]=bANDt.f[p][3]=cANDt.f[p][4]=dTHEN LEAVEposWITHp;FI;pINCR1;PER;0END PROCpos;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp):sup(t,xp,yp,xp,yp,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp,INT CONSTbeg):sup(t,xp,yp,xp,yp,beg)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):sup(t,xb,yb,xe,ye,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt.f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEsupWITHp;FI;pINCR1;PER;0END PROCsup;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):inf(t,xb,yb,xe,ye,t.used)END PROCinf;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTend):INT VARp:=0MAXendMINt.used;WHILEp>=1REP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt.
+f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEinfWITHp;FI;pDECR1;PER;0END PROCinf;PROCmin(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);min(t,q,xb,yb,xe,ye);END PROCmin;PROCmin(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEminFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMAXxb;yb:=ylMAXyb;xe:=xhMINxe;ye:=yhMINye;END PROCmin;PROCmax(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);max(t,q,xb,yb,xe,ye);END PROCmax;PROCmax(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEmaxFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMINxb;yb:=ylMINyb;xe:=xhMAXxe;ye:=yhMAXye;END PROCmax;INT OP MIN(INT CONSTa,b):IFa<bTHENaELSEbFI END OP MIN;INT OP MAX(INT CONSTa,b):IFa>bTHENaELSEbFI END OP MAX;OP EXC(INT VARa,b):INT CONSTd:=a;a:=b;b:=d;END OP EXC;END PACKETelementrow;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer
new file mode 100644
index 0000000..84d90c5
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer
@@ -0,0 +1,9 @@
+PACKETformulaanalyzerDEFINESclearformulaspaces,opindex,regenerateformula,arithnotation,printnotation,formulacomplexity,removeformulaobj,appendformulaobj,insertformulaobj,insertformulapars,createformulaobj,adjoinformulaobj,adjoinformulapars,getformulaposition,formulaposition,getformulanode,formulanode,getformulaterm,defformulaterm,formulaterm,getformulapos,defformulapos,formulabeg,formulaend,formulaindex,getformulaaddress,defformulaaddress,formulaaddress,getformulatree,defformulatree,expand,compress,getformulabox,defformulabox,getformulaobject,defformulaobject,getformulalength,getformula,writeformula,clearformula,outformula,out,:LETnilidx=0;INT VARnillbp,nilrbp;TEXT VARnilari;LETatomidx=1;INT VARatomlbp,atomrbp;TEXT VARatomari;LETtimesidx=2;INT VARtimeslbp,timesrbp;TEXT VARtimesari;LETapplyidx=3;INT VARapplylbp,applyrbp;TEXT VARapplyari;LETifidx=4;INT VARiflbp,ifrbp;TEXT VARifari;LETfiidx=5;INT VARfilbp,firbp;TEXT VARfiari;LETthenidx=6;INT VARthenlbp,thenrbp;TEXT VARthenari;LETelif1idx=7;INT VARelif1lbp,elif1rbp;TEXT VARelif1ari;LETelif2idx=8;INT VARelif2lbp,elif2rbp;TEXT VARelif2ari;LETelif3idx=9;INT VARelif3lbp,elif3rbp;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;INT VARlforcelbp,lforcerbp;TEXT VARlforceari;LETrforceidx=12;INT VARrforcelbp,rforcerbp;TEXT VARrforceari;LETlparidx=15;INT VARlparlbp,lparrbp;LETrparidx=16;INT VARrparlbp,rparrbp;LETinfixnpm=2;LETxmin=1,ymin=1,xmax=400,ymax=400,xsiz=400,ysiz=400;LET MEM=STRUCT(INTnodr,nodc,adrc,sp,ELEMROWstk,TEXTROWtrm,ELEMROWobj,ELEMROWadr,tre,alg,del,box);LET SCR=STRUCT(INTxbeg,ybeg,xend,yend,ROWysizTEXTrec);TEXT VARari:="",prt:="";INT VARanum:=0,alen:=0;BOOL VARariok,prtok,analyzeok;INITFLAG VARspacesok:=FALSE;DATASPACE VARmemds;BOUND MEM VARmem;DATASPACE VARscrds;BOUND SCR VARscr;INT VARdummy;TEXT VARemptyrec:=xsiz*" ";TEXT VARrec;PROCclearformulaspaces:disablestop;IFinitialized(spacesok)THENforget(memds);forget(scrds)FI;spacesok:=FALSE;END PROCclearformulaspaces;PROCinitformulaspaces:disablestop;IFinitialized(spacesok)THEN LEAVEinitformulaspacesFI;spacesok:=FALSE;enablestop;forget(memds);memds:=nilspace;mem:=memds;forget(scrds);scrds:=nilspace;scr:=scrds;ari:="";anum:=0;alen:=0;ariok:=FALSE;prt:="";prtok:=FALSE;mem.trm:=emptytextrow;clear(mem.obj);define(mem.obj,1,1,0,0,0);mem.nodr:=0;mem.nodc:=0;mem.adrc:=0;clear(mem.stk);mem.sp:=0;clear(mem.adr);clear(mem.tre);clear(mem.alg);clear(mem.del);clear(mem.box);scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;analyzeok:=TRUE;spacesok:=TRUE;initops;END PROCinitformulaspaces;PROCgetfixedops:getoppower(nilidx,nillbp,nilrbp);nilari:=oparithsymbol(nilidx);getoppower(atomidx,atomlbp,atomrbp);atomari:=oparithsymbol(atomidx);getoppower(timesidx,timeslbp,timesrbp);timesari:=oparithsymbol(timesidx);getoppower(applyidx,applylbp,applyrbp);applyari:=oparithsymbol(applyidx);getoppower(ifidx,iflbp,ifrbp);ifari:=oparithsymbol(ifidx);getoppower(fiidx,filbp,firbp);fiari:=oparithsymbol(fiidx);getoppower(thenidx,thenlbp,thenrbp);thenari:=oparithsymbol(thenidx);getoppower(elif1idx,elif1lbp,elif1rbp);elif1ari:=oparithsymbol(elif1idx);getoppower(elif2idx,elif2lbp,elif2rbp);elif2ari:=oparithsymbol(elif2idx);getoppower(elif3idx,elif3lbp,elif3rbp);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);getoppower(lforceidx,lforcelbp,lforcerbp);lforceari:=oparithsymbol(lforceidx);getoppower(rforceidx,rforcelbp,rforcerbp);rforceari:=oparithsymbol(rforceidx);getoppower(lparidx,lparlbp,lparrbp);getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;INT PROCopindex(TEXT CONSTamid,BOOL CONSTlft,rgt):INT VARidx:=opindex(amid);WHILEidx>atomidxAND(lftANDrgtANDopparams(idx)<>2OR NOTlftANDrgtANDoplbp(idx)<>lparlbpANDoplbp(idx)<>prefixlbpORlftAND NOTrgtANDoprbp(idx)<>rparrbpANDoprbp(idx)<>postfixrbp)REPidx:=opindex(amid,idx+1);PER;idxEND PROCopindex;PROCregenerateformula(INT VARnodc,adrc):initformulaspaces;mem.nodc:=nodc;mem.adrc:=adrc;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(
+ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;analyzeformula;nodc:=mem.nodc;adrc:=mem.adrc;END PROCregenerateformula;PROCarithnotation(TEXT CONSTnewari):enablestop;initformulaspaces;IFariokANDnewari=ariTHEN LEAVEarithnotationFI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;ari:=newari;alen:=LENGTHari;analyzeformula;END PROCarithnotation;TEXT PROCarithnotation:enablestop;IFariokTHEN LEAVEarithnotationWITHariFI;initformulaspaces;analyzeformula;TEXT CONSToldari:=ari;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;IFari<>oldariTHENprtok:=FALSE;analyzeok:=FALSE FI;ariEND PROCarithnotation;TEXT PROCarithnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARari:="";INT VARanum:=0;alen:=0;IFnod1>0THENcatarith(ari,anum,alen,nod1,FALSE,FALSE)FI;ariEND PROCarithnotation;TEXT PROCprintnotation:enablestop;IFprtokTHEN LEAVEprintnotationWITHprtFI;initformulaspaces;analyzeformula;prtok:=FALSE;prt:="";IFmem.nodr>0THENcatprint(prt,mem.nodr)FI;prtok:=TRUE;prtEND PROCprintnotation;TEXT PROCprintnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARprt:="";IFnod1>0THENcatprint(prt,nod1)FI;prtEND PROCprintnotation;INT PROCformulacomplexity:initformulaspaces;mem.nodrEND PROCformulacomplexity;PROCgetformulaposition(INT CONSTapos,INT VARxpoi,ypoi):INT VARnod1,adr1;INT VARabeg,aend,idx;INT VARxdel,ydel;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHENrecall(mem.del,nod1,xpoi,ypoi,xdel,ydel);xpoiINCRapos-abeg;LEAVEgetformulaposition;FI;PER;END PROCgetformulaposition;INT PROCformulaposition(INT CONSTxpoi,ypoi):INT VARnod1,adr1;INT VARxpos,ypos,xdel,ydel;INT VARabeg,aend,idx;initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);adr1:=field(mem.adr,nod1,3);recall(mem.del,nod1,xpos,ypos,xdel,ydel);recall(mem.obj,adr1,abeg,aend,idx,dummy);abegMAXabeg+xpoi-xposMINaendEND PROCformulaposition;INT PROCformulanode(INT CONSTapos):INT VARnod1,adr1;INT VARabeg,aend,idx;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHEN LEAVEformulanodeWITHnod1;FI;PER;0END PROCformulanode;PROCgetformulanode(INT CONSTapos,INT VARnod1):nod1:=formulanode(apos);END PROCgetformulanode;INT PROCformulanode(INT CONSTxpoi,ypoi):initformulaspaces;sup(mem.box,xpoi,ypoi)END PROCformulanode;PROCgetformulanode(INT CONSTxpoi,ypoi,INT VARnod1):initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);END PROCgetformulanode;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);END PROCdefformulaterm;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);field(mem.obj,adr1,3,idx);END PROCdefformulaterm;TEXT PROCformulaterm(INT CONSTadr1):initformulaspaces;name(mem.trm,adr1)END PROCformulaterm;PROCgetformulaterm(INT CONSTadr1,TEXT VARsym):sym:=formulaterm(adr1);END PROCgetformulaterm;PROCdefformulapos(INT CONSTadr1,INT CONSTabeg,aend,idx,dummy):initformulaspaces;define(mem.obj,adr1,abeg,aend,idx,dummy);END PROCdefformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend,idx,dummy):initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend):INT VARidx;initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;INT PROCformulabeg(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,1)END PROCformulabeg;INT PROCformulaend(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,2)END PROCformulaend;INT PROCformulaindex(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,3)END PROCformulaindex;PROCformulaindex(INT CONSTadr1,idx):initformulaspaces;field(mem.obj,adr1,3,idx)END PROCformulaindex;PROCdefformulaaddress(INT CONSTnod1,INT CONSTnod2,nodx,adr1,adr2):initformulaspaces;define(
+mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCdefformulaaddress;PROCgetformulaaddress(INT CONSTnod1,INT VARnod2,nodx,adr1,adr2):initformulaspaces;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCgetformulaaddress;INT PROCformulaaddress(INT CONSTnod1):initformulaspaces;field(mem.adr,nod1,3)END PROCformulaaddress;PROCdefformulatree(INT CONSTnod1,INT CONSTlnod,rnod,pnod,inod):initformulaspaces;define(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCdefformulatree;PROCgetformulatree(INT CONSTnod1,INT VARlnod,rnod,pnod,inod):initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCgetformulatree;PROCexpand(INT VARlnod,rnod):INT VARnod1;initformulaspaces;REPnod1:=lnod;lnod:=field(mem.tre,nod1,1)UNTILlnod=0PER;lnod:=nod1;REPnod1:=rnod;rnod:=field(mem.tre,nod1,2)UNTILrnod=0PER;rnod:=nod1;END PROCexpand;PROCcompress(INT VARlnod,rnod):expand(rnod,lnod);END PROCcompress;PROCdefformulabox(INT CONSTnod1,INT CONSTxbeg,ybeg,xend,yend):initformulaspaces;define(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCdefformulabox;PROCgetformulabox(INT CONSTnod1,INT VARxbeg,ybeg,xend,yend):initformulaspaces;recall(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCgetformulabox;PROCdefformulaobject(INT CONSTnod1,INT CONSTxobj,yobj,xdel,ydel):initformulaspaces;define(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCdefformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj,xdel,ydel):initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj):INT VARxdel,ydel;initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCcatarith(TEXT VARari,INT VARadrc,alen,INT CONSTnod1,BOOL CONSTforce,forcepending):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARladr,radr;INT VARoidx,rbp,lbp;INT VARlidx,llbp,lrbp;INT VARridx,rlbp,rrbp;TEXT VARlsym,rsym;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);oidx:=field(mem.obj,adr1,3);IFnodx=2THENcatterm2;catarith(ari,adrc,alen,lnod,FALSE,FALSE);catterm1;ELIFnod1<>nod2THENrnod:=field(mem.tre,nod2,1);catterm1;catarith(ari,adrc,alen,rnod,FALSE,FALSE);catterm2;ELSE IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,lforceari);FI;getoppower(oidx,lbp,rbp);IFlnod>0THENcatleftparamFI;catterm1;IFrnod>0THENcatrightparamFI;IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,rforceari);FI;FI;.catterm1:catarith(ari,adrc,alen,name(mem.trm,adr1));IFnod1=mem.nodcTHENmem.adrc:=adrcFI;.catterm2:catarith(ari,adrc,alen,name(mem.trm,adr2));IFnod2=mem.nodcTHENmem.adrc:=adrcFI;.catleftparam:ladr:=field(mem.adr,lnod,4);lidx:=field(mem.obj,ladr,3);lsym:=name(mem.trm,ladr);getoppower(lidx,llbp,lrbp);IFlrbp=postfixrbpTHENlrbp:=llbpFI;IFoplforce(oidx)=0ANDopoforce(lidx)=0THENcatarith(ari,adrc,alen,lnod,FALSE,forcependingORlrbp<lbp);ELIFforcependingORlrbp<lbpTHENcatarith(ari,adrc,alen,lnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,lnod,FALSE,FALSE);FI;.catrightparam:radr:=field(mem.adr,rnod,3);ridx:=field(mem.obj,radr,3);rsym:=name(mem.trm,radr);getoppower(ridx,rlbp,rrbp);IFrlbp=prefixlbpTHENrlbp:=rrbpFI;IFoprforce(oidx)=0ANDopoforce(ridx)=0THENcatarith(ari,adrc,alen,rnod,FALSE,forcependingORrbp>rlbp);ELIFforcependingORrbp>rlbpTHENcatarith(ari,adrc,alen,rnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,rnod,FALSE,FALSE);FI;.END PROCcatarith;PROCcatarith(TEXT VARari,INT VARadrc,alen,TEXT CONSTsym):IFsym=nilariTHEN LEAVEcatarithFI;IFpos(ari,delimiter,alen,alen)<>alenTHENariCATdelimiterFI;ariCATsym;adrcINCR1;alen:=LENGTHari;END PROCcatarith;PROCcatprint(TEXT VARprt,INT CONSTnod1):INT VARlnod,rnod,pnod,inod;INT VARadr1;INT VARoidx;TEXT VARplft,pmid,prgt;IFnod1<=0THEN LEAVEcatprintFI;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);adr1:=field(mem.adr,nod1,3);oidx:=field(mem.obj,adr1,3);IFoidx<=atomidxTHENplft:="";pmid:=name(mem.trm,adr1);prgt:="";ELSEgetopprintsymbols(oidx,plft,pmid,prgt);FI;prtCATplft;IFopparamexc(oidx)=0THENcatprint(prt,lnod);prtCATpmid;catprint(prt,rnod);ELSEcatprint(prt,rnod);prt
+CATpmid;catprint(prt,lnod);FI;prtCATprgt;END PROCcatprint;PROCremoveformulaobj(INT CONSTnod1):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);define(mem.adr,nod1,nod1,1,adr1,adr1);define(mem.adr,nod2,nod2,1,adr2,adr2);rename(mem.trm,adr1,"");IFlnod=0THENsnod:=rnod;ELIFrnod=0THENsnod:=lnod;ELSE LEAVEremoveformulaobj;FI;IFpnod>0THENfield(mem.tre,pnod,inod,snod);FI;IFsnod>0THENfield(mem.tre,snod,3,pnod);field(mem.tre,snod,4,inod);FI;END PROCremoveformulaobj;PROCappendformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTpnod,inod,INT VARnod1):INT VARlnod,rnod;initformulaspaces;SELECTinodOF CASE1:rnod:=0;lnod:=field(mem.tre,pnod,1);CASE2:lnod:=0;rnod:=field(mem.tre,pnod,2);OTHERWISElnod:=0;rnod:=0;END SELECT;insertformulaobj(sym,idx,lnod,rnod,pnod,inod,nod1);END PROCappendformulaobj;PROCinsertformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,pnod,inod,INT VARnod1):initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,pnod,inod);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;IFpnod>0THENfield(mem.tre,pnod,inod,nod1)ELSEmem.nodr:=nod1FI;END PROCinsertformulaobj;PROCinsertformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,pnod,inod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);insertformulaobj(sym1,idx1,0,nod2,pnod,inod,nod1);END PROCinsertformulapars;PROCcreateformulaobj(TEXT CONSTsym,INT CONSTidx,INT VARnod1):adjoinformulaobj(sym,idx,0,0,nod1);END PROCcreateformulaobj;PROCadjoinformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,INT VARnod1):initformulaspaces;analyzeformula;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,0,0);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;END PROCadjoinformulaobj;PROCadjoinformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);adjoinformulaobj(sym1,idx1,0,nod2,nod1);END PROCadjoinformulapars;PROCputobjectontostack(INT VARnod1,INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):INT VARlbp,rbp;getoppower(idx,lbp,rbp);getparamsfromstack(nod1,lbp);INT VARadr2;insert(mem.trm,sym,adr2);INT CONSTapos:=field(mem.obj,adr1,1)-1;define(mem.obj,adr2,apos,apos,idx,0);mem.spINCR1;define(mem.stk,mem.sp,nod1,adr2,idx,rbp);END PROCputobjectontostack;PROCgetparamsfromstack(INT VARnod1,INT CONSTlbp):INT VARstacknod,stackadr,stackidx,stackrbp;WHILEmem.sp>0REPrecall(mem.stk,mem.sp,stacknod,stackadr,stackidx,stackrbp);IFstackrbp<lbpTHEN LEAVEgetparamsfromstackFI;mem.spDECR1;IFstackidx<>lforceidxANDstackidx<>rforceidxTHENnod1INCR1;define(mem.adr,nod1,nod1,1,stackadr,stackadr);IFstackadr=mem.adrcTHENmem.nodc:=nod1FI;FI;PER;END PROCgetparamsfromstack;PROCfindprefixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindprefixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILlbp=prefixlbpPER;END PROCfindprefixop;PROCfindpostfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindpostfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILrbp=postfixrbpPER;END PROCfindpostfixop;PROCfindinfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindinfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILnpm=infixnpmPER;END PROCfindinfixop
+;PROCanalyzeformula:INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARabeg,aend;INT VARstackidx,stackrbp;INT VARlastidx,lastnpm,lastlbp,lastrbp;INT VARnextidx,nextnpm,nextlbp,nextrbp;TEXT VARsym;INT VARtlen;INT VARxfb,yfb,xfe,yfe;INT VARpxp,pyp,pxd,pyd;INT VARoxb,oyb,oxe,oye,oxp,oyp,oxd,oyd;INT VARlxb,lyb,lxe,lye,lxp,lyp,lxa,lya,lxd,lyd;INT VARrxb,ryb,rxe,rye,rxp,ryp,rxa,rya,rxd,ryd;INT VARoxc,oyc;IFanalyzeokTHEN LEAVEanalyzeformulaFI;getfixedops;splitari;computerpn;computetre;computealgdelandbox;computescr;analyzeok:=TRUE;.splitari:mem.trm:=emptytextrow;clear(mem.obj);aend:=0;REPabeg:=aend+1;aend:=pos(ari,delimiter,abeg);IFaend>abegTHENsym:=subtext(ari,abeg,aend-1);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,aend-1,nextidx,0);FI;UNTILaend=0PER;IFabeg<=alenTHENsym:=subtext(ari,abeg,alen);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,alen,nextidx,0);FI;.computerpn:clear(mem.adr);nod1:=0;clear(mem.stk);mem.sp:=0;lastidx:=nilidx;lastnpm:=0;lastlbp:=nillbp;lastrbp:=nilrbp;FORadr1FROM1UPTOlength(mem.obj)REPprocessobject;lastidx:=nextidx;lastnpm:=nextnpm;lastlbp:=nextlbp;lastrbp:=nextrbp;PER;nextidx:=nilidx;getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);mem.nodr:=nod1;.processobject:nextidx:=field(mem.obj,adr1,3);getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);IFnextidx=rforceidxTHEN IFfield(mem.stk,mem.sp,3)=lforceidxTHENfield(mem.stk,mem.sp,4,rforcerbp)FI;ELIFnextlbp=rparlbpTHENnod1INCR1;define(mem.adr,nod1,nod1,1,adr1,adr1);IFadr1=mem.adrcTHENmem.nodc:=nod1FI;IFfield(mem.stk,mem.sp,4)=lparrbpTHENfield(mem.stk,mem.sp,4,rparrbp)FI;ELSEmem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);FI;.insertmissingobject:IFnextidx=fiidxTHEN IFlastnpm=infixnpmORlastlbp=prefixlbpTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif3ari,elif3idx);ELIFlastidx=elif1idxTHEN IFnextidx=elif1idxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif2ari,elif2idx);IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastidx=atomidxORlastrbp=rparrbpORlastidx=rforceidxTHEN IFnextidx=atomidxORnextidx=lforceidxTHENputobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENputobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastrbp=postfixrbpTHEN IFnextidx=atomidxORnextidx=lforceidxTHENinfixlast;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixlast;infixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENinfixlast;putobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastnpm=infixnpmTHEN IFnextnpm=infixnpmTHENprefixnext;postfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=prefixlbpTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpTHENputobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;FI;.prefixnext:findprefixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextlbp=prefixlbpTHENfield(mem.
+obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixnext:findinfixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextnpm=infixnpmTHENfield(mem.obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixlast:findinfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastnpm=infixnpmTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.postfixlast:findpostfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastrbp=postfixrbpTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.computetre:clear(mem.tre);define(mem.tre,mem.nodr,0,0,0,0);clear(mem.stk);mem.sp:=0;FORnod1FROM1UPTOlength(mem.adr)REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);field(mem.adr,nod1,2,1);nextidx:=field(mem.obj,adr1,3);getopparams(nextidx,nextnpm);getoppower(nextidx,nextlbp,nextrbp);WHILEnextnpm>0REPrecall(mem.stk,mem.sp,nod2,adr2,stackidx,stackrbp);mem.spDECR1;IFstackrbp=rparrbpANDnextlbp=lparlbpTHENdefine(mem.adr,nod2,nod1,2,adr2,adr1);define(mem.adr,nod1,nod2,1,adr1,adr2);FI;field(mem.tre,nod2,3,nod1);IFnextnpm>1ORnextlbp=lparlbpORnextlbp=prefixlbpTHENfield(mem.tre,nod1,2,nod2);field(mem.tre,nod2,4,2);ELSEfield(mem.tre,nod1,1,nod2);field(mem.tre,nod2,4,1);FI;nextnpmDECR1;PER;mem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);PER;.computealgdelandbox:clear(mem.alg);define(mem.alg,mem.nodr,0,0,0,0);clear(mem.del);define(mem.del,mem.nodr,0,0,0,0);clear(mem.box);define(mem.box,mem.nodr,0,0,0,0);FORnod1FROM1UPTOmem.nodrREPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);sym:=name(mem.trm,adr1);tlen:=LENGTHsym;recall(mem.obj,adr1,abeg,aend,nextidx,dummy);oxb:=0;oyb:=0;oxe:=0;oye:=0;lxd:=0;lyd:=0;rxd:=0;ryd:=0;getopalignment(nextidx,lxa,lya,rxa,rya);getopposition(nextidx,lxp,lyp,rxp,ryp);IFnextidx<=atomidxTHEN IFtlen>0THENoxe:=tlen;ELSEoxe:=LENGTHopscreensymbol(nextidx);FI;rxp:=oxe+1;getopframe(nextidx,xfb,yfb,xfe,yfe);ELSEoxe:=LENGTHopscreensymbol(nextidx);getopframe(nextidx,xfb,yfb,xfe,yfe);FI;IFlnod>0THENdefine(mem.alg,lnod,lxa,lya,lxp,lyp);recall(mem.box,lnod,lxb,lyb,lxe,lye);align(lxa,lxp,lxb,lxe,lxd);align(lya,lyp,lyb,lye,lyd);define(mem.del,lnod,0,0,lxd,lyd);oxb:=oxbMINlxb;oyb:=oybMINlyb;oxe:=oxeMAXlxe;oye:=oyeMAXlye;FI;IFlnod>0ANDrnod>0THEN IFrxa>=4THEN IFrxp>0THENrxpINCRoxeELIFrxp<0THENrxpINCRoxbFI FI;IFrya>=4THEN IFryp>0THENrypINCRoyeELIFryp<0THENrypINCRoybFI FI;FI;IFrnod>0THENdefine(mem.alg,rnod,rxa,rya,rxp,ryp);recall(mem.box,rnod,rxb,ryb,rxe,rye);align(rxa,rxp,rxb,rxe,rxd);align(rya,ryp,ryb,rye,ryd);define(mem.del,rnod,0,0,rxd,ryd);oxb:=oxbMINrxb;oyb:=oybMINryb;oxe:=oxeMAXrxe;oye:=oyeMAXrye;FI;oxbINCRxfb;oybINCRyfb;oxeINCRxfe;oyeINCRyfe;define(mem.box,nod1,oxb,oyb,oxe,oye);PER;nod1:=mem.nodr;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.box,nod1,oxb,oyb,oxe,oye);align(1,2,oxb,oxe,oxd);align(1,1,oyb,oye,oyd);define(mem.del,nod1,oxd,oyd,oxd,oyd);define(mem.box,nod1,oxb,oyb,oxe,oye);FORnod1FROMmem.nodr-1DOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);pnod:=field(mem.tre,nod1,3);recall(mem.del,pnod,pxp,pyp,pxd,pyd);recall(mem.del,nod1,oxp,oyp,oxd,oyd);oxp:=pxp+oxd;oyp:=pyp+oyd;define(mem.del,nod1,oxp,oyp,oxd,oyd);shiftelement(mem.box,nod1,oxp,oyp);PER;.computescr:scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;FORnod1FROMmem.nodrDOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.obj,adr1,abeg,aend,nextidx,dummy);recall(mem.box,nod1,oxb,oyb,oxe,oye);recall(mem.del,nod1,oxp,oyp,oxd,oyd);IFscr.ybeg>scr.yendTHENscr.ybeg:=oyb;scr.yend:=oyb-1;FI;WHILEscr.ybeg>oybANDscr.ybeg>yminREPscr.ybegDECR1;scr.rec[scr.ybeg]:=emptyrecPER;WHILEscr.yend<oyeANDscr.yend<ymaxREPscr.yendINCR1;scr.rec[scr.yend]:=emptyrecPER;scr.xbeg:=scr.xbegMINoxb;scr.xend:=scr.xendMAXoxe;IFoyb>=yminANDoye<=ymaxTHEN IFnextidx<=atomidxTHENsym:=name(mem.trm,adr1);IFsym=""THENsym:=opscreensymbol(nextidx)FI
+;replace(scr.rec[oyp],oxp,sym);ELSEgetopposition(nextidx,lxp,lyp,rxp,ryp);getopalignment(nextidx,lxa,lya,rxa,rya);sym:=opscreensymbol(nextidx);IFsym=""THEN ELIFlxa=2ANDlya=3ANDrxa=2ANDrya=1THENoxc:=oxb;WHILEoxc<oxeREPreplace(scr.rec[oyp],oxc,symSUB1);oxcINCR1PER;ELIFlxa=3ANDlya=3ANDrxa=1ANDrya=0THENoxc:=oxb;oyc:=oyp;WHILEoxc<oxpREPreplace(scr.rec[oyc],oxc,symSUB1);oxcINCR1PER;oyc:=oye;WHILEoyc>oybREPreplace(scr.rec[oyc],oxc,symSUB2);oycDECR1PER;WHILEoxc<oxeREPreplace(scr.rec[oyc],oxc,symSUB3);oxcINCR1PER;ELIFnod2<>nod1THENoyc:=oyb;WHILEoyc<=oyeREPreplace(scr.rec[oyc],oxp,sym);oycINCR1PER;ELSEreplace(scr.rec[oyp],oxp,sym);FI;FI;FI;PER;.END PROCanalyzeformula;PROCshiftelement(ELEMROW VARlist,INT CONSTnod1,INT CONSTxdel,ydel):INT VARxbeg,ybeg,xend,yend;recall(list,nod1,xbeg,ybeg,xend,yend);xbegINCRxdel;ybegINCRydel;xendINCRxdel;yendINCRydel;define(list,nod1,xbeg,ybeg,xend,yend);END PROCshiftelement;PROCalign(INT CONSTali,pos,INT VARbeg,end,INT VARdel):SELECTaliAND3OF CASE0:del:=0;CASE1:del:=beg;CASE2:del:=beg+end;IFdel<0THENdelDECR1FI;del:=delDIV2;CASE3:del:=end;OTHERWISEerrorstop("unzulässige Alignment-Kennung : "+text(ali));END SELECT;del:=pos-del;begINCRdel;endINCRdel;END PROCalign;PROCgetformulalength(INT VARxbeg,ybeg,xend,yend):initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;END PROCgetformulalength;PROCgetformula(INT VARxbeg,ybeg,xend,yend,ROWymaxTEXT VARrec):INT VARypoi;initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPrec[ypoi]:=subtext(scr.rec[ypoi],xbeg,xend)PER;END PROCgetformula;PROCwriteformula(FILE VARf):INT VARypoi;initformulaspaces;output(f);IFcol(f)<=16000THENline(f)FI;INT VARxbeg,ybeg,xend,yend;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPputline(f,subtext(scr.rec[ypoi],xbeg,xend))PER;END PROCwriteformula;PROCclearformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEclearformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEclearformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPclearformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;clearformula(xbeg,xend,ypoi,xoff,yoff);END PROCclearformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff);END PROCoutformula;PROCclearformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENout(xbeg+xoff,ypoi+yoff,subtext(emptyrec,xbeg,xend));FI;END PROCclearformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENout(xbeg+xoff,ypoi+yoff,subtext(scr.rec[ypoi],xbeg,xend));FI;FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff,TEXT CONSTframe):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;IFybeg<yendTHENoutformula(xbeg,xend,ypoi,xoff,yoff,frame,1);ypoiINCR1;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff,frame,4);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff,frame,7);ELSEoutformula(xbeg,xend,ypoi,xoff,yoff,frame,10);FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,xoff,yoff,TEXT CONSTframe,INT CONSTfp):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENrec:=scr.rec[ypoi];ELSErec:=emptyrec;FI;replace(rec,xbeg,xend," ",frameSUBfp+1);replace(rec,xend,frameSUBfp+2);replace(rec,xbeg,frameSUBfp);out(xbeg+xoff,ypoi+yoff,subtext(rec,xbeg,xend));FI;END PROCoutformula;PROCreplace(TEXT VARrec,INT CONSTb,e,TEXT CONSTold,new):INT CONSTl:=LENGTHold;IFl<>LENGTHnewTHEN LEAVEreplaceFI;INT VARp:=pos(rec,old,b,e);WHILEp>0REPreplace(rec,p,new);p:=pos(rec,old,p+l,e)PER;END PROCreplace;PROCout(INT CONSTxcur,ycur,
+TEXT CONSTrec):cursor(xcur,ycur);out(rec);END PROCout;PROCcatexpr(TEXT VARrec,INT CONSTadrb,adr1,adr2,adre):INT VARadr;initformulaspaces;IFadr1=adr2THENrecCAT"  ";FORadrFROMadrbUPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT"  ";ELSErecCAT" ";FORadrFROMadrbUPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";FI;END PROCcatexpr;END PACKETformulaanalyzer;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung
new file mode 100644
index 0000000..dae28a7
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung
@@ -0,0 +1,12 @@
+PACKETformulaeditorDEFINESresetformulaeditor,outformula,showformula,editformula,defformeditwindow,getformeditwindow,defformeditoffset,getformeditoffset,defformeditshift,getformeditshift,defformeditcursor,getformeditcursor,defformeditpointer,getformeditpointer,moveformeditpointer,defformeditexitkeys,getformeditexitkeys,formeditexitkey,defformeditbuffer,getformeditbuffer,formeditbuffer,defformeditarith,getformeditarith,formeditarith,defformediterror,getformediterror,formediterror,defformeditbeep,getformeditbeep,formeditbeep,defformeditrubin,getformeditrubin,formeditrubin,defformeditlearn,getformeditlearn,formeditlearn,defformeditkeys,getformeditkeys,formeditkeys,defformeditmark,getformeditmark,formeditmark,displayformeditbuffer,clearformeditbuffer,displayformeditarith,clearformeditarith,displayformediterror,clearformediterror,displayformeditrubin,clearformeditrubin,displayformeditlearn,clearformeditlearn,:LETnilidx=0;TEXT VARnilari;LETatomidx=1;TEXT VARatomari,atomscr;LETtimesidx=2;TEXT VARtimesari,timesscr;LETapplyidx=3;TEXT VARapplyari,applyscr;LETifidx=4;TEXT VARifari;LETfiidx=5;TEXT VARfiari;LETthenidx=6;TEXT VARthenari;LETelif1idx=7;TEXT VARelif1ari;LETelif2idx=8;TEXT VARelif2ari;LETelif3idx=9;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;TEXT VARlforceari;LETrforceidx=12;TEXT VARrforceari;LETbegdifidx=13;TEXT VARbegdifari;LETenddifidx=14;TEXT VARenddifari;LETlparidx=15;INT VARlparlbp,lparrbp;TEXT VARlparari;LETrparidx=16;INT VARrparlbp,rparrbp;TEXT VARrparari;INT VARpointermode;INT VARnodc,adrc;INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;INT VARidx;TEXT VARltrm,rtrm;TEXT VARtrm;INT VARtpos,tlen;INT VARapos,abeg,aend;INT VARpbeg,pend;INT VARxobj,yobj,xbeg,ybeg,xend,yend;INT VARxpoi,ypoi,xmin,ymin,xmax,ymax;INT VARxoff,yoff;INT VARxcur,ycur,xlow,ylow,xhig,yhig;INT VARxrel,yrel;INT VARdummy;BOOL VARbufferon;BOOL VARarithon;BOOL VARerroron;BOOL VARbeepon;BOOL VARrubinon;BOOL VARlearnon;BOOL VARkeyson;BOOL VARmarkon;INT VARxbuffer,ybuffer,lbuffer;INT VARxarith,yarith,larith;INT VARxerror,yerror,lerror;INT VARxrubin,yrubin;INT VARxlearn,ylearn;INT VARxkeys,ykeys;INT VARdspxmin,dspymin,dspxmax,dspymax;INT VARdspxbeg,dspybeg,dspxend,dspyend;TEXT VARdspbuffer,clrbuffer;TEXT VARdsparith,clrarith;TEXT VARdsperror,clrerror;TEXT VARdsprubin,clrrubin;TEXT VARdsplearn,clrlearn;TEXT VARdspkeys,clrkeys;TEXT VARdspmark,clrmark;resetformulaeditor;TEXT VARbuffer:="";BOOL VARwriteenabled;BOOL VARquiteditor;BOOL VARnewdisplay,regenerate;BOOL VARlearnmode:=FALSE;BOOL VARrubinmode:=FALSE;INT VARheadpos;TEXT VARlearnedkeys:="";TEXT VARrec;TEXT VARexitkey:="";BOOL VARwashop,wasesc;TEXT VARstdkeys:="",hopkeys:="",esckeys:="";LETkeys="�����
+��
�� bpdg()[]{}|<>=^_/*�BPIWDA;!";LEThopkey=1;LETrightkey=2;LETupkey=3;LETleftkey=4;LETtabkey=5;LETdownkey=6;LETrubinkey=7;LETruboutkey=8;LETreturnkey=9;LETesckey=11;LETbkey=13;LETpkey=14;LETdkey=15;LETgkey=16;LETlparkey=17;LETrparkey=18;LETlbrakey=19;LETrbrakey=20;LETlcmtkey=21;LETrcmtkey=22;LETabskey=23;LETlesskey=24;LETgreaterkey=25;LETequalskey=26;LETcircumflexkey=27;LETunderlinekey=28;LETslashkey=29;LETstarkey=30;LETrootkey=31;LETcapbkey=32;LETcappkey=33;LETcapikey=34;LETcapwkey=35;LETcapdkey=36;LETcapakey=37;LETsemicolonkey=38;LETexclamationkey=39;PROCgetfixedops:nilari:=oparithsymbol(nilidx);atomari:=oparithsymbol(atomidx);atomscr:=opscreensymbol(atomidx);timesari:=oparithsymbol(timesidx);timesscr:=opscreensymbol(timesidx);applyari:=oparithsymbol(applyidx);applyscr:=opscreensymbol(applyidx);ifari:=oparithsymbol(ifidx);fiari:=oparithsymbol(fiidx);thenari:=oparithsymbol(thenidx);elif1ari:=oparithsymbol(elif1idx);elif2ari:=oparithsymbol(elif2idx);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);lforceari:=oparithsymbol(lforceidx);rforceari:=oparithsymbol(rforceidx);begdifari:=oparithsymbol(begdifidx);enddifari:=oparithsymbol(enddifidx);lparari:=oparithsymbol(lparidx);getoppower(lparidx,lparlbp,lparrbp);rparari:=oparithsymbol(rparidx)
+;getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;PROCshowformula:editformula(FALSE);END PROCshowformula;PROCeditformula:editformula(TRUE);END PROCeditformula;PROCeditformula(BOOL CONSTwriteaccess):enablestop;dspxmin:=xlow-xoff;dspymin:=ylow-yoff;dspxmax:=xhig-xoff;dspymax:=yhig-yoff;getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;IFesckeys=""THENclearformula;outformula;LEAVEeditformula;FI;writeenabled:=writeaccess;quiteditor:=esckeys="";newdisplay:=TRUE;pointermode:=pointermodeMAX2;xrel:=0;yrel:=0;getfixedops;REPcomputepointers;displayformeditarith;IFnewdisplayTHENnewdisplay:=FALSE;clearformula;outformula;headpos:=xkeys;displayformeditbuffer;IFrubinmodeTHENdisplayformeditrubinFI;IFlearnmodeTHENdisplayformeditlearnFI;FI;processstdkey;IFregenerateTHENregenerate:=FALSE;out("�");regenerateformula(nodc,adrc);getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;nod1:=nodc;adr1:=adrc;FI;UNTILquiteditorPER;out("�");.computepointers:REP SELECTpointermodeOF CASE4:computenodcfromadrc;CASE3:computepoifromnodc;CASE2:computenod1frompoi;CASE1:computetrefromnod1;OTHERWISE LEAVEcomputepointers;END SELECT;PER;.computenodcfromadrc:FORnodcFROMformulacomplexityDOWNTO1REP UNTILformulaaddress(nodc)=adrcPER;pointermode:=3;.computepoifromnodc:nod1:=nodc;adr1:=adrc;IFnod1>0THENgetformulaobject(nod1,xobj,yobj);xobjINCRxrel;xrel:=0;yobjINCRyrel;yrel:=0;ELIFadr1>0THENxobj:=xmax;yobj:=ymax;ELSExobj:=xmin;yobj:=ymin;FI;defformeditpointer(xobj,yobj);pointermode:=2;.computenod1frompoi:nod1:=formulanode(xpoi,ypoi);pointermode:=1;.computetrefromnod1:getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);getformulapos(adr1,abeg,aend,idx,dummy);getformulaterm(adr1,trm);tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;SELECTnodxOF CASE1:getformulabox(nod1,xbeg,ybeg,xend,yend);aend:=formulaend(adr2);apos:=abegMAXabeg+xpoi-xobjMINaend+1;CASE2:getformulabox(nod2,xbeg,ybeg,xend,yend);abeg:=formulabeg(adr2);apos:=abegMAXaend+xpoi-xobjMINaend+1;OTHERWISExbeg:=0;ybeg:=0;xend:=0;yend:=0;abeg:=0;aend:=0;apos:=0;END SELECT;pbeg:=abeg;pend:=aend;getformulatree(nod1,lnod,rnod,pnod,inod);nodc:=nod1;adrc:=adr1;pointermode:=0;.END PROCeditformula;PROCclearformula:clearformula(dspxminMAXxlow-xoff,dspyminMAXylow-yoff,dspxmaxMINxhig-xoff,dspymaxMINyhig-yoff,xoff,yoff);dspxmin:=xhig-xoff;dspymin:=yhig-yoff;dspxmax:=xlow-xoff;dspymax:=ylow-yoff;END PROCclearformula;PROCoutformula:outformula(xminMAXxlow-xoff,yminMAXylow-yoff,xmaxMINxhig-xoff,ymaxMINyhig-yoff,xoff,yoff);dspxmin:=xmin;dspymin:=ymin;dspxmax:=xmax;dspymax:=ymax;dspxbeg:=0;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,TEXT CONSTframe):outformula(xbegMAXxlow-xoff,ybegMAXylow-yoff,xendMINxhig-xoff,yendMINyhig-yoff,xoff,yoff,frame);END PROCoutformula;PROCgetkey:IFxbeg<>dspxbegORybeg<>dspybegORxend<>dspxendORyend<>dspyendTHEN IFmarkonANDdspxbeg>0THENoutformula(dspxbeg-1,dspybeg,dspxend,dspyend,clrmark);FI;IFmarkonTHENoutformula(xbeg-1,ybeg,xend,yend,dspmark);FI;cursor(80,1);out("");dspxbeg:=xbeg;dspybeg:=ybeg;dspxend:=xend;dspyend:=yend;FI;cursor(xcur,ycur);getchar(exitkey);IFlearnmodeTHENlearnedkeysCATexitkeyFI;END PROCgetkey;PROCprocessstdkey:getkey;displaykey(exitkey);processkey;clearkey(exitkey);.processkey:IFpos(stdkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhopkey;CASEleftkey:processleft;CASErightkey:processright;CASEupkey:processup;CASEdownkey:processdown;CASEtabkey:processtab;CASErubinkey:processrubin;CASEruboutkey:processrubout;CASEesckey:processesckey;OTHERWISE:processother;END SELECT;.processleft:xmove(-1);.processright:xmove(+1);.processup:ymove(-1);.processdown:ymove(+1);.processtab:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processrubin:IFrubinonTHENrubinmode:=NOTrubinmode;IFrubinmodeTHEN
+displayformeditrubinELSEclearformeditrubinFI;FI;.processrubout:deletechar;.processother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocessstdkey;PROCprocesshopkey:washop:=TRUE;displaykey("HOP");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("HOP");exitkey:="�"+exitkey;washop:=FALSE;.processkey:IFpos(hopkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhophop;CASEleftkey:processhopleft;CASErightkey:processhopright;CASEupkey:processhopup;CASEdownkey:processhopdown;CASEruboutkey:processhoprubout;CASEtabkey:CASEreturnkey:CASEesckey:processhopesc;CASElparkey:processhoplpar;CASErparkey:processhoprpar;CASElbrakey:processhoplbra;CASErbrakey:processhoprbra;CASElcmtkey:CASErcmtkey:CASEabskey:CASEcapakey:processhopcapa;CASEcapdkey:processhopcapd;OTHERWISE:processhopother;END SELECT;.processhophop:IFxcur>xlowORycur>ylowTHENxmove(xlow-xcur);ymove(ylow-ycur);ELSExmove(xlow-xhig-1);ymove(ylow-yhig-1);FI;.processhopleft:IFxcur>xlowTHENxmove(xlow-xcur)ELSExmove(xlow-xhig-1)FI;.processhopright:IFxcur<xhigTHENxmove(xhig-xcur)ELSExmove(xhig-xlow+1)FI;.processhopup:IFycur>ylowTHENymove(ylow-ycur)ELSEymove(ylow-yhig-1)FI;.processhopdown:IFycur<yhigTHENymove(yhig-ycur)ELSEymove(yhig-ylow+1)FI;.processhoprubout:IF NOTwriteenabledORnod1<1ORidx>atomidxTHENbeep;LEAVEprocesskeyFI;trm:=subtext(trm,1,tpos-1MINtlen);defformulaterm(adr1,trm);pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;.processhopesc:processesckey;push("�");.processhoplpar:insertpars("(",")",opindex("("),opindex(")"));.processhoprpar:deletepars("(",")");.processhoplbra:insertpars("[","]",opindex("["),opindex("]"));.processhoprbra:deletepars("[","]");.processhopcapa:insertpars(ifari,fiari,ifidx,fiidx);.processhopcapd:insertpars(begdifari,enddifari,begdifidx,enddifidx);.processhopother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocesshopkey;PROCprocessesckey:wasesc:=TRUE;displaykey("ESC");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("ESC");exitkey:="�"+exitkey;wasesc:=FALSE;.processkey:IFpos(esckeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processeschop;CASEleftkey:processescleft;CASErightkey:processescright;CASErubinkey:processescrubin;CASEruboutkey:processescrubout;CASEbkey:CASEpkey:processescp;CASEdkey:processescd;CASEgkey:processescg;CASElparkey:processesclpar;CASErparkey:processescrpar;CASElesskey:CASEequalskey:processescequals;CASEgreaterkey:CASEexclamationkey:CASEupkey:processescup;CASEdownkey:CASEcircumflexkey:CASEunderlinekey:CASEslashkey:CASEstarkey:CASErootkey:CASEcapbkey:CASEcappkey:CASEcapikey:CASEcapwkey:CASEcapdkey:processesccapd;CASEcapakey:processesccapa;CASEsemicolonkey:processescsemicolon;OTHERWISE:processescother;END SELECT;.processeschop:IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;learnmode:=NOTlearnmode;IFlearnmodeTHENdisplayformeditlearn;learnedkeys:="";ELSEregenerate:=TRUE;newdisplay:=TRUE;learnedkeys:=subtext(learnedkeys,1,LENGTHlearnedkeys-2);REPgetkey;IFexitkey="�"ORpos(learnedkeys,exitkey)=0OR(exitkey>=" "ANDpos(learnedkeys,"�"+exitkey)=0)THENlernsequenzauftastelegen(exitkey,learnedkeys);clearformeditlearn;LEAVEprocesseschop;FI;out("�");PER;FI;.processescleft:adrc:=adr1;REPadrcDECR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescright:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;
+LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescup:processesccapp;.processescrubin:processescg;.processescrubout:processescp;.processescp:IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod)FI;buffer:=arithnotation(nod1);displayformeditbuffer;defformulaaddress(nod1,nod1,1,adr1,adr1);defformulatree(nod1,0,0,pnod,inod);defformulaterm(adr1,nilari);nodc:=pnod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescd:IFnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);buffer:=arithnotation(nod1);nod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);ELSEbuffer:=arithnotation(nod1);FI;displayformeditbuffer;.processescg:IF NOTwriteenabledORnod1<1ORidx>atomidxTHENbeep;LEAVEprocesskeyFI;IFtrm=atomariTHENtrm:=nilari;tpos:=1;tlen:=0FI;change(trm,tpos,tpos-1,delimiter+buffer+delimiter);trm:=lforceari+delimiter+trm+delimiter+rforceari;defformulaterm(adr1,trm);nodc:=nod1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesclpar:push("[");.processescrpar:push("]");.processescequals:insertchar("->");.processesccapp:push("^");.processesccapd:createformulaobj("D",atomidx,lnod);nodc:=lnod;createformulaobj("D",atomidx,rnod);adjoinformulaobj("/",opindex("/"),lnod,rnod,snod);insertformulapars(begdifari,enddifari,begdifidx,enddifidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesccapa:createformulaobj(atomari,atomidx,lnod);nodc:=lnod;createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(thenari,thenidx,lnod,rnod,snod);insertformulapars(ifari,fiari,ifidx,fiidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescsemicolon:INT VARanod,bnod,tnod;IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFidx=ifidxTHEN IFtpos<=1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjINCR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILnod1<>snodANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbeforeelif;ELIFidx=fiidxTHEN IFtpos>1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjDECR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILsnod<>nod1ANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbehindelif;ELSEbeep;LEAVEprocesskey;FI;nodc:=anod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.insertelifbeforeelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,nod1,pnod,inod,tnod);.insertelifbehindelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);SELECTidxOF CASEelif2idx:adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,rnod,nod1,2,tnod);CASEelif3idx:defformulaterm(adr1,elif2ari,elif2idx);insertformulaobj(elif1ari,elif1idx,lnod,0,nod1,1,snod);insertformulaobj(elif3ari,elif3idx,tnod,0,nod1,2,snod);END SELECT;.processescother:IFtasteenthaeltkommando(exitkey)THEN IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;disablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;.END PROC
+processesckey;PROCdeletechar:IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEdeletecharFI;IFtpos<1THENbeep;LEAVEdeletecharFI;out("�");IFidx=applyidxORidx=timesidxTHENdeletenilop;ELIFtpos<=tlenTHENdeletecharinobject;ELSEdeletespacebehindobject;FI;regenerate:=TRUE;newdisplay:=TRUE;.deletenilop:adr1:=formulaaddress(lnod);idx:=formulaindex(adr1);WHILEidx=lforceidxORidx=rforceidxREPadr1DECR1;idx:=formulaindex(adr1);PER;adr2:=formulaaddress(rnod);idx:=formulaindex(adr2);WHILEidx=lforceidxORidx=rforceidxREPadr2INCR1;idx:=formulaindex(adr2);PER;trm:=formulaterm(adr1);trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);nodc:=lnod;pointermode:=3;.deletecharinobject:change(trm,tpos,tpos,"");tlen:=LENGTHtrm;IFtlen>0THENdefformulaterm(adr1,trm,atomidxMAXopindex(trm));pointermode:=1;ELIFidx<=atomidxTHENdeleteatom;defformulaterm(adr1,trm,atomidx);pointermode:=3;ELSEdeletenilparams;deleteop;defformulaterm(adr1,trm,atomidx);pointermode:=3;FI;.deleteatom:nodc:=pnod;.deletenilparams:getformulatree(nod1,lnod,rnod,pnod,inod);IFlnod>0ANDformulaterm(formulaaddress(lnod))=atomariTHENlnod:=0;FI;IFrnod>0ANDformulaterm(formulaaddress(rnod))=atomariTHENrnod:=0;FI;defformulatree(nod1,lnod,rnod,pnod,inod);.deleteop:removeformulaobj(nod1);IFrnod>0THENnodc:=rnodELIFlnod>0THENnodc:=lnodELSEnodc:=pnodFI;.deletespacebehindobject:adr2:=adr1;idx:=formulaindex(adr2);IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;REPadr2INCR1;idx:=formulaindex(adr2);UNTILidx<>lforceidxANDidx<>rforceidxPER;IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);pointermode:=1;.END PROCdeletechar;PROCinsertchar(TEXT CONSTsym):INT VARsidx:=opindex(sym)MAXatomidx;INT VARslbp:=oplbp(sidx);INT VARsrbp:=oprbp(sidx);INT VARpidx;IF NOT(writeenabledANDnod1>0AND(washopORypoi=yobj))THENbeep;LEAVEinsertcharFI;out("�");IFidx=timesidxTHENtrm:=timesscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;ELIFidx=applyidxTHENtrm:=applyscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;FI;IFidx=atomidxANDtrm=atomariTHENltrm:=nilari;rtrm:=nilari;ELIFrubinmodeOR(idx>atomidxXORsidx>atomidx)THENltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos);ELSEltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos+1);FI;trm:=ltrm;trmCATsym;trmCATrtrm;IF NOTwashopANDidx>atomidxANDtpos>=1ANDtpos<=tlen+1THENreplaceop;FI;IFltrm=nilariTHENinsertbeforeobject;ELIFrtrm=nilariTHENinsertbehindobject;ELSEinsertintoobject;FI;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.replaceop:IFrubinmodeORtpos=tlen+1THENreplaceopbytrm;ELIFtpos=1THENreplaceopbysym;FI;.replaceopbytrm:IFtrm=lforceariORtrm=rforceariTHEN LEAVEreplaceopbytrmFI;IFopindex(trm,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbytrmFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,trm,opindex(trm,lnod>0,rnod>0));ELSEdefformulaterm(adr1,trm,idx);FI;nodc:=nod1;xrel:=xpoi-xobj+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.replaceopbysym:IFopindex(sym,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbysymFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,sym,opindex(sym,lnod>0,rnod>0));ELSEdefformulaterm(adr1,sym,idx);FI;nodc:=nod1;xrel:=+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.insertbeforeobject:IF NOTwashopANDxpoi>xbegTHENbeep;LEAVEinsertcharFI;pidx:=formulaindex(formulaaddress(pnod));WHILEpidx=enddifidxORpidx=begdifidxORoprforce(sidx)=0ANDinod=1ANDsrbp<oplbp(pidx)ANDoplforce(pidx)=0REPnod1:=pnod;idx:=pidx;getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);pidx:=formulaindex(formulaaddress(pnod));PER;rnod:=nod1;IFrtrm=nilariTHENrtrm:=atomariFI;IFidx<=atomidxTHENinsertbeforeatom;ELIFnodx=2THENinsertbeforerpar;ELIFnod1<>nod2ANDidx<>begdifidxTHENinsertbeforelpar;ELSEinsertbeforeop;FI;.
+insertbeforeatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforerpar:beep;LEAVEinsertchar;.insertbeforelpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(applyari,applyidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforeop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbehindobject:IF NOTwashopANDxpoi<xend-1THENbeep;LEAVEinsertcharFI;IFnodx=2THENnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod)FI;pidx:=formulaindex(formulaaddress(pnod));WHILEpidx=enddifidxORpidx=begdifidxORoplforce(sidx)=0ANDinod=2ANDslbp<oprbp(pidx)ANDoprforce(pidx)=0REPnod1:=pnod;idx:=pidx;getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);pidx:=formulaindex(formulaaddress(pnod));PER;lnod:=nod1;IFidx<=atomidxTHENinsertbehindatom;ELIFnodx=2THENinsertbehindrpar;ELIFnod1<>nod2ANDidx<>begdifidxTHENinsertbehindlpar;ELSEinsertbehindop;FI;.insertbehindatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;
+FI;.insertbehindrpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertbehindlpar:beep;LEAVEinsertchar;.insertbehindop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintoobject:IFidx<=atomidxTHENinsertintoatom;ELIFnodx=2THENinsertintorpar;ELIFnod1<>nod2THENinsertintolpar;ELSEinsertintoop;FI;.insertintoatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintorpar:beep;LEAVEinsertchar;.insertintolpar:beep;LEAVEinsertchar;.insertintoop:beep;LEAVEinsertchar;.END PROCinsertchar;PROCinsertpars(TEXT CONSTlparari,rparari,INT CONSTlparidx,rparidx):IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEinsertparsFI;out("�");snod:=nod1;insertformulapars(lparari,rparari,lparidx,rparidx,snod,pnod,inod,nod1,nod2);nodc:=snod;xrel:=xpoi-xobj;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;END PROCinsertpars;PROCdeletepars(TEXT CONSTlparari,rparari):IF NOTwriteenabledORnod1=nod2ORypoi<>yobjTHENbeep;LEAVEdeleteparsFI;out("�");IFnodx=2THENnod1EXCnod2;adr1EXCadr2FI;IF(formulaterm(adr1)<>lparariORformulaterm(adr2)<>rparari)THENbeep;LEAVEdeleteparsFI;removeformulaobj(nod1);removeformulaobj(nod2);IFlnod>0THENnodc:=lnodELIFrnod>0THENnodc:=rnodELSEnodc:=nod1FI;pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;END PROCdeletepars;PROCdisplayformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(dspbuffer+buffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCdisplayformeditbuffer;PROCclearformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(clrbuffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCclearformeditbuffer;PROCdisplayformeditarith:IFarithonTHENrec:=
+dsparith;recCAT"";INT CONSTxaoff:=LENGTHrec;INT CONSTxabeg:=xarith+xaoff;INT CONSTxasiz:=larith-xaoff;recCATarithnotation;changeall(rec,delimiter," ");cursor(xarith,yarith);outtext(rec,1,larith);IFadr1=0THEN LEAVEdisplayformeditarithFI;IFpbeg-1>=0ANDpbeg-1<xasizTHENcursor(xabeg+pbeg-2,yarith);out(dspmarkSUB10)FI;outsubtext(rec,(1MAXpbeg)+xaoff,(pendMINxasiz-1)+xaoff);IFpend+1>=0ANDpend+1<xasizTHENcursor(xabeg+pend,yarith);out(dspmarkSUB12)FI;IFapos<xasizTHENcursor(xabeg+apos-1,yarith);out(clrmarkSUB12);cursor(xabeg+apos-1,yarith);out(recSUBapos+xaoff);FI;cursor(xarith+larith-1,yarith);out("");FI;END PROCdisplayformeditarith;PROCclearformeditarith:IFarithonTHENrec:=clrarith;cursor(xarith,yarith);outtext(rec,1,larith);FI;END PROCclearformeditarith;PROCdisplayformediterror:TEXT VARpm;IFiserrorANDerrormessage<>""THENbeep;IFerroronTHENpm:=dsperror;pmCATerrormessage;IFerrorline>0THENpmCAT" bei Zeile ";pmCATtext(errorline)FI;pmCAT" ";cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xerror,yerror);pause;cursor(xcur,ycur);FI;FI;END PROCdisplayformediterror;PROCclearformediterror:IFerroronTHEN TEXT VARpm:=clrerror;cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xcur,ycur);FI;END PROCclearformediterror;PROCbeep:IFbeeponTHENout("�");FI;END PROCbeep;PROCdisplayformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(dsprubin);cursor(xcur,ycur);FI;END PROCdisplayformeditrubin;PROCclearformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(clrrubin);cursor(xcur,ycur);FI;END PROCclearformeditrubin;PROCdisplayformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(dsplearn);cursor(xcur,ycur);FI;END PROCdisplayformeditlearn;PROCclearformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(clrlearn);cursor(xcur,ycur);FI;END PROCclearformeditlearn;PROCdisplaykey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENcursor(headpos,ykeys);out("");out(key);out(" ");cursor(xcur,ycur);headposINCR3+LENGTHkey;FI;END PROCdisplaykey;PROCclearkey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENheadposDECR3+LENGTHkey;cursor(headpos,ykeys);out(" ");LENGTHkeyTIMESOUT" ";out("  ");cursor(xcur,ycur);FI;END PROCclearkey;PROCdefformeditbuffer(INT CONSTxp,yp,xl):xbuffer:=xp;ybuffer:=yp;lbuffer:=xl;END PROCdefformeditbuffer;PROCgetformeditbuffer(INT VARxp,yp,xl):xp:=xbuffer;yp:=ybuffer;xl:=lbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(INT CONSTxp,yp,xl):xarith:=xp;yarith:=yp;larith:=xl;END PROCdefformeditarith;PROCgetformeditarith(INT VARxp,yp,xl):xp:=xarith;yp:=yarith;xl:=larith;END PROCgetformeditarith;PROCdefformediterror(INT CONSTxp,yp,xl):xerror:=xp;yerror:=yp;lerror:=xl;END PROCdefformediterror;PROCgetformediterror(INT VARxp,yp,xl):xp:=xerror;yp:=yerror;xl:=lerror;END PROCgetformediterror;PROCdefformeditrubin(INT CONSTxp,yp):xrubin:=xp;yrubin:=yp;END PROCdefformeditrubin;PROCgetformeditrubin(INT VARxp,yp):xp:=xrubin;yp:=yrubin;END PROCgetformeditrubin;PROCdefformeditlearn(INT CONSTxp,yp):xlearn:=xp;ylearn:=yp;END PROCdefformeditlearn;PROCgetformeditlearn(INT VARxp,yp):xp:=xlearn;yp:=ylearn;END PROCgetformeditlearn;PROCdefformeditkeys(INT CONSTxp,yp):xkeys:=xp;ykeys:=yp;END PROCdefformeditkeys;PROCgetformeditkeys(INT VARxp,yp):xp:=xkeys;yp:=ykeys;END PROCgetformeditkeys;PROCdefformeditbuffer(TEXT CONSTdsp,clr):dspbuffer:=dsp;clrbuffer:=clr;END PROCdefformeditbuffer;PROCgetformeditbuffer(TEXT VARdsp,clr):dsp:=dspbuffer;clr:=clrbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(TEXT CONSTdsp,clr):dsparith:=dsp;clrarith:=clr;END PROCdefformeditarith;PROCgetformeditarith(TEXT VARdsp,clr):dsp:=dsparith;clr:=clrarith;END PROCgetformeditarith;PROCdefformediterror(TEXT CONSTdsp,clr):dsperror:=dsp;clrerror:=clr;END PROCdefformediterror;PROCgetformediterror(TEXT VARdsp,clr):dsp:=dsperror;clr:=clrerror;END PROCgetformediterror;PROCdefformeditkeys(TEXT CONSTdsp,clr):dspkeys:=dsp;clrkeys:=clr;END PROCdefformeditkeys;PROCgetformeditkeys(TEXT VARdsp,clr):dsp:=dspkeys;clr:=clrkeys;END PROCgetformeditkeys;PROCdefformeditrubin(TEXT CONSTdsp,clr):dsprubin:=dsp;clrrubin:=clr;END
+ PROCdefformeditrubin;PROCgetformeditrubin(TEXT VARdsp,clr):dsp:=dsprubin;clr:=clrrubin;END PROCgetformeditrubin;PROCdefformeditlearn(TEXT CONSTdsp,clr):dsplearn:=dsp;clrlearn:=clr;END PROCdefformeditlearn;PROCgetformeditlearn(TEXT VARdsp,clr):dsp:=dsplearn;clr:=clrlearn;END PROCgetformeditlearn;PROCdefformeditmark(TEXT CONSTdsp,clr):replace(dspmark,1,dsp);replace(clrmark,1,clr);END PROCdefformeditmark;PROCgetformeditmark(TEXT VARdsp,clr):dsp:=dspmark;clr:=clrmark;END PROCgetformeditmark;PROCdefformeditbuffer(BOOL CONSTon):bufferon:=on;END PROCdefformeditbuffer;PROCgetformeditbuffer(BOOL VARon):on:=bufferon;END PROCgetformeditbuffer;BOOL PROCformeditbuffer:bufferonEND PROCformeditbuffer;PROCdefformeditarith(BOOL CONSTon):arithon:=on;END PROCdefformeditarith;PROCgetformeditarith(BOOL VARon):on:=arithon;END PROCgetformeditarith;BOOL PROCformeditarith:arithonEND PROCformeditarith;PROCdefformediterror(BOOL CONSTon):erroron:=on;END PROCdefformediterror;PROCgetformediterror(BOOL VARon):on:=erroron;END PROCgetformediterror;BOOL PROCformediterror:erroronEND PROCformediterror;PROCdefformeditbeep(BOOL CONSTon):beepon:=on;END PROCdefformeditbeep;PROCgetformeditbeep(BOOL VARon):on:=beepon;END PROCgetformeditbeep;BOOL PROCformeditbeep:beeponEND PROCformeditbeep;PROCdefformeditrubin(BOOL CONSTon):rubinon:=on;END PROCdefformeditrubin;PROCgetformeditrubin(BOOL VARon):on:=rubinon;END PROCgetformeditrubin;BOOL PROCformeditrubin:rubinonEND PROCformeditrubin;PROCdefformeditlearn(BOOL CONSTon):learnon:=on;END PROCdefformeditlearn;PROCgetformeditlearn(BOOL VARon):on:=learnon;END PROCgetformeditlearn;BOOL PROCformeditlearn:learnonEND PROCformeditlearn;PROCdefformeditkeys(BOOL CONSTon):keyson:=on;END PROCdefformeditkeys;PROCgetformeditkeys(BOOL VARon):on:=keyson;END PROCgetformeditkeys;BOOL PROCformeditkeys:keysonEND PROCformeditkeys;PROCdefformeditmark(BOOL CONSTon):markon:=on;END PROCdefformeditmark;PROCgetformeditmark(BOOL VARon):on:=markon;END PROCgetformeditmark;BOOL PROCformeditmark:markonEND PROCformeditmark;PROCresetformulaeditor:disablestop;xcur:=1;ycur:=1;xlow:=1;ylow:=1;xhig:=79;yhig:=24;xoff:=0;yoff:=0;xpoi:=1;ypoi:=1;xmin:=1;ymin:=1;xmax:=1;ymax:=1;pointermode:=2;buffer:="";bufferon:=FALSE;xbuffer:=0;ybuffer:=0;lbuffer:=0;arithon:=FALSE;xarith:=0;yarith:=0;larith:=0;erroron:=TRUE;xerror:=0;yerror:=0;lerror:=0;beepon:=TRUE;rubinon:=TRUE;xrubin:=0;yrubin:=0;learnon:=FALSE;xlearn:=0;ylearn:=0;keyson:=FALSE;xkeys:=0;ykeys:=0;markon:=TRUE;dspbuffer:="Puffer : ";clrbuffer:="           ";dsparith:="Formel : ";clrarith:="           ";dsperror:="FEHLER : ";clrerror:="           ";dsprubin:="RUBIN ";clrrubin:="        ";dsplearn:="LEARN ";clrlearn:="        ";dspkeys:="Tasten : ";clrkeys:="           ";dspmark:="+-+| |+-++ +";clrmark:="            ";END PROCresetformulaeditor;PROCdefformeditexitkeys(TEXT CONSTstd,hop,esc):stdkeys:=std;hopkeys:=hop;esckeys:=esc;END PROCdefformeditexitkeys;PROCgetformeditexitkeys(TEXT VARstd,hop,esc):std:=stdkeys;hop:=hopkeys;esc:=esckeys;END PROCgetformeditexitkeys;TEXT PROCformeditexitkey:exitkeyEND PROCformeditexitkey;PROCdefformeditwindow(INT CONSTxl,yl,xh,yh):disablestop;xcurDECRxlow;ycurDECRylow;xoffDECRxlow;yoffDECRylow;xlow:=xl;ylow:=yl;xhig:=xh;yhig:=yh;xoffINCRxlow;yoffINCRylow;xcurINCRxlow;ycurINCRylow;END PROCdefformeditwindow;PROCgetformeditwindow(INT VARxl,yl,xh,yh):xl:=xlow;yl:=ylow;xh:=xhig;yh:=yhig;END PROCgetformeditwindow;PROCdefformeditoffset(INT CONSTxo,yo):disablestop;xcurDECRxoff;ycurDECRyoff;xoff:=xo;yoff:=yo;xcurINCRxoff;ycurINCRyoff;END PROCdefformeditoffset;PROCgetformeditoffset(INT VARxo,yo):xo:=xoff;yo:=yoff;END PROCgetformeditoffset;PROCdefformeditshift(INT CONSTxs,ys):defformeditoffset(xs+xlow-1,ys+ylow-1);END PROCdefformeditshift;PROCgetformeditshift(INT VARxs,ys):xs:=xoff-xlow+1;ys:=yoff-ylow+1;END PROCgetformeditshift;PROCdefformeditcursor(INT CONSTxc,yc):xmove(xc-xcur);ymove(yc-ycur);END PROCdefformeditcursor;PROCgetformeditcursor(INT VARxc,yc):xc:=xcur;yc:=ycur
+;END PROCgetformeditcursor;PROCdefformeditpointer(INT CONSTxp,yp):xmove(xp-xpoi);ymove(yp-ypoi);END PROCdefformeditpointer;PROCgetformeditpointer(INT VARxp,yp):xp:=xpoi;yp:=ypoi;END PROCgetformeditpointer;PROCmoveformeditpointer(INT CONSTxd,yd):xmove(xd);ymove(yd);END PROCmoveformeditpointer;PROCxmove(INT CONSTxdel):disablestop;IFxdel<0THENmoveleftELIFxdel>0THENmoverightFI;pointermode:=2;.moveleft:IFxpoi<=xminTHENbeep;LEAVEmoveleftFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi<xminTHENxcurINCRxmin-xpoi;xpoi:=xminFI;IFxcur<xlowTHENxoffINCRxlow-xcur;xcur:=xlow;newdisplay:=TRUE FI;.moveright:IFxpoi>=xmaxTHENbeep;LEAVEmoverightFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi>xmaxTHENxcurINCRxmax-xpoi;xpoi:=xmaxFI;IFxcur>xhigTHENxoffINCRxhig-xcur;xcur:=xhig;newdisplay:=TRUE FI;.END PROCxmove;PROCymove(INT CONSTydel):disablestop;IFydel<0THENmoveupELIFydel>0THENmovedownELSE LEAVEymoveFI;pointermode:=2;.moveup:IFypoi<=yminTHENbeep;LEAVEmoveupFI;ycurINCRydel;ypoiINCRydel;IFypoi<yminTHENycurINCRymin-ypoi;ypoi:=yminFI;IFycur<ylowTHENyoffINCRylow-ycur;ycur:=ylow;newdisplay:=TRUE FI;.movedown:IFypoi>=ymaxTHENbeep;LEAVEmovedownFI;ycurINCRydel;ypoiINCRydel;IFypoi>ymaxTHENycurINCRymax-ypoi;ypoi:=ymaxFI;IFycur>yhigTHENyoffINCRyhig-ycur;ycur:=yhig;newdisplay:=TRUE FI;.END PROCymove;END PACKETformulaeditor;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung
new file mode 100644
index 0000000..43ad1db
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung
@@ -0,0 +1,3 @@
+PACKETopstoreDEFINESforgetops,clearops,initops,reorganizeops,loadops,saveops,delimiter,defop,getop,getoppower,oplbp,oprbp,getopforce,oplforce,oprforce,opoforce,oppforce,getopparams,opparams,getopparamexc,opparamexc,getopposition,getopalignment,getopframe,oparithsymbol,opscreensymbol,getopprintsymbols,opindex,definedops,:LETopspacetype=12345;LET OPSTORE=STRUCT(INTused,TEXTdelim,ELEMROWpwr,ELEMROWfrc,ELEMROWpoi,ELEMROWalg,ELEMROWfrm,TEXTROWamid,TEXTROWsmid,TEXTROWplft,pmid,prgt);INITFLAG VARopspaceok:=FALSE;DATASPACE VARopspace;BOUND OPSTORE VARop;INT VARdummy;PROCforgetops:disablestop;IFinitialized(opspaceok)THENforget(opspace)FI;opspaceok:=FALSE;END PROCforgetops;PROCcheckops:disablestop;IFinitialized(opspaceok)THEN LEAVEcheckopsFI;opspaceok:=FALSE;errorstop("Keine Operatoren geladen");END PROCcheckops;PROCclearops:IFinitialized(opspaceok)THENforget(opspace)FI;opspace:=nilspace;op:=opspace;type(opspace,opspacetype);op.used:=0;op.delim:=" ";clear(op.pwr);clear(op.frc);clear(op.poi);clear(op.alg);clear(op.frm);op.amid:=emptytextrow;op.smid:=emptytextrow;op.plft:=emptytextrow;op.pmid:=emptytextrow;op.prgt:=emptytextrow;END PROCclearops;PROCinitops:BOOL VARok;LETstdops="std ops";disablestop;IFinitialized(opspaceok)THEN LEAVEinitopsFI;opspaceok:=FALSE;enablestop;ok:=exists(stdops);IFokTHENloadops(stdops);LEAVEinitops;FI;fetch(stdops,ok);IFokTHENloadops(stdops);forget(stdops,quiet);ELSEclearops;FI;END PROCinitops;PROCfetch(TEXT CONSTdsname,BOOL VARok):accesscatalogue;TASK VARtask:=myself;LETwaitstatus=2,urindex=2;ok:=FALSE;REPtask:=father(task);IFindex(task)<=urindexTHEN LEAVEfetchFI;UNTILstatus(task)=waitstatusCANDexists(dsname,task)PER;fetch(dsname,task);ok:=exists(dsname);END PROCfetch;PROCreorganizeops:enablestop;checkops;disablestop;DATASPACE VARscratchspace:=nilspace;BOUND OPSTORE VARscratch:=scratchspace;scratch:=op;IF NOTiserrorTHENforget(opspace);opspace:=scratchspace;op:=opspace;type(opspace,opspacetype);FI;forget(scratchspace);END PROCreorganizeops;PROCloadops(TEXT CONSTdsname):forgetops;disablestop;opspace:=old(dsname,opspacetype);IFiserrorTHENforgetops;LEAVEloadopsFI;op:=opspace;opspaceok:=TRUE;END PROCloadops;PROCsaveops(TEXT CONSTdsname):enablestop;checkops;disablestop;IFexists(dsname)THENforget(dsname)FI;IF NOTexists(dsname)THENreorganizeops;copy(opspace,dsname)FI;END PROCsaveops;PROCdelimiter(INT CONSTdelim):delimiter(code(delim));END PROCdelimiter;PROCdelimiter(TEXT CONSTdelim):initops;replace(op.delim,1,delim);END PROCdelimiter;TEXT PROCdelimiter:initops;op.delimEND PROCdelimiter;PROCdefop(INT CONSTidx,TEXT CONSTamid,INT CONSTlbp,rbp,npm,exc,lfc,rfc,ofc,pfc,TEXT CONSTsmid,INT CONSTlxp,lyp,rxp,ryp,lxa,lya,rxa,rya,bxf,byf,exf,eyf,TEXT CONSTplft,pmid,prgt):initops;define(op.pwr,idx,lbp,rbp,npm,exc);define(op.frc,idx,lfc,rfc,ofc,pfc);define(op.poi,idx,lxp,lyp,rxp,ryp);define(op.alg,idx,lxa,lya,rxa,rya);define(op.frm,idx,bxf,byf,exf,eyf);WHILEhighestentry(op.amid)<idxREPinsert(op.amid,"")PER;rename(op.amid,idx,amid);WHILEhighestentry(op.smid)<idxREPinsert(op.smid,"")PER;rename(op.smid,idx,smid);WHILEhighestentry(op.plft)<idxREPinsert(op.plft,"")PER;rename(op.plft,idx,plft);WHILEhighestentry(op.pmid)<idxREPinsert(op.pmid,"")PER;rename(op.pmid,idx,pmid);WHILEhighestentry(op.prgt)<idxREPinsert(op.prgt,"")PER;rename(op.prgt,idx,prgt);op.used:=op.usedMAXidx;END PROCdefop;PROCgetop(INT CONSTidx,TEXT VARamid,INT VARlbp,rbp,npm,exc,lfc,rfc,ofc,pfc,TEXT VARsmid,INT VARlxp,lyp,rxp,ryp,lxa,lya,rxa,rya,bxf,byf,exf,eyf,TEXT VARplft,pmid,prgt):checkops;recall(op.pwr,idx,lbp,rbp,npm,exc);recall(op.frc,idx,lfc,rfc,ofc,pfc);recall(op.poi,idx,lxp,lyp,rxp,ryp);recall(op.alg,idx,lxa,lya,rxa,rya);recall(op.frm,idx,bxf,byf,exf,eyf);amid:=name(op.amid,idx);smid:=name(op.smid,idx);plft:=name(op.plft,idx);pmid:=name(op.pmid,idx);prgt:=name(op.prgt,idx);END PROCgetop;PROCgetoppower(INT CONSTidx,INT VARlbp,rbp,npm,exc):checkops;recall(op.pwr,idx,lbp,rbp,npm,exc);END PROCgetoppower;PROCgetoppower(INT CONSTidx,INT VARlbp,rbp):checkops;recall(op.
+pwr,idx,lbp,rbp,dummy,dummy);END PROCgetoppower;INT PROCoplbp(INT CONSTidx):checkops;field(op.pwr,idx,1)END PROCoplbp;INT PROCoprbp(INT CONSTidx):checkops;field(op.pwr,idx,2)END PROCoprbp;PROCgetopparams(INT CONSTidx,INT VARnpm):checkops;npm:=field(op.pwr,idx,3);END PROCgetopparams;INT PROCopparams(INT CONSTidx):checkops;field(op.pwr,idx,3)END PROCopparams;PROCgetopparamexc(INT CONSTidx,INT VARexc):checkops;exc:=field(op.pwr,idx,4);END PROCgetopparamexc;INT PROCopparamexc(INT CONSTidx):checkops;field(op.pwr,idx,4)END PROCopparamexc;PROCgetopforce(INT CONSTidx,INT VARlfc,rfc,ofc,pfc):checkops;recall(op.frc,idx,lfc,rfc,ofc,pfc);END PROCgetopforce;PROCgetopforce(INT CONSTidx,INT VARlfc,rfc):checkops;recall(op.frc,idx,lfc,rfc,dummy,dummy);END PROCgetopforce;INT PROCoplforce(INT CONSTidx):checkops;field(op.frc,idx,1)END PROCoplforce;INT PROCoprforce(INT CONSTidx):checkops;field(op.frc,idx,2)END PROCoprforce;INT PROCopoforce(INT CONSTidx):checkops;field(op.frc,idx,3)END PROCopoforce;INT PROCoppforce(INT CONSTidx):checkops;field(op.frc,idx,4)END PROCoppforce;PROCgetopposition(INT CONSTidx,INT VARlxp,lyp,rxp,ryp):checkops;recall(op.poi,idx,lxp,lyp,rxp,ryp);END PROCgetopposition;PROCgetopalignment(INT CONSTidx,INT VARlxa,lya,rxa,rya):checkops;recall(op.alg,idx,lxa,lya,rxa,rya);END PROCgetopalignment;PROCgetopframe(INT CONSTidx,INT VARbxf,byf,exf,eyf):checkops;recall(op.frm,idx,bxf,byf,exf,eyf);END PROCgetopframe;TEXT PROCoparithsymbol(INT CONSTidx):checkops;name(op.amid,idx)END PROCoparithsymbol;TEXT PROCopscreensymbol(INT CONSTidx):checkops;name(op.smid,idx)END PROCopscreensymbol;PROCgetopprintsymbols(INT CONSTidx,TEXT VARplft,pmid,prgt):checkops;plft:=name(op.plft,idx);pmid:=name(op.pmid,idx);prgt:=name(op.prgt,idx);END PROCgetopprintsymbols;INT PROCopindex(TEXT CONSTamid):opindex(amid,1)END PROCopindex;INT PROCopindex(TEXT CONSTamid,INT CONSTb):checkops;link(op.amid,amid,b)END PROCopindex;INT PROCdefinedops:checkops;op.usedEND PROCdefinedops;END PACKETopstore;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/PAC text row b/app/schulis-mathematiksystem/1.0/src/PAC text row
new file mode 100644
index 0000000..8e6b37a
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/PAC text row
@@ -0,0 +1,3 @@
+PACKETtextrowDEFINES TEXTROW,emptytextrow,:=,highestentry,firstentry,nextentry,CONTAINS,link,name,rename,insert,delete,get,top,pop,leftmatchinglinks,rightmatchinglinks,LIKE,REV,+,-,/,*,<,<>,>,<=,=,>=,textrow,thesaurus,FILLBY,:LEThex00="�";LEThexff="�";LEThex0000="��";LEThex0001="��";LEThexfeff="��";LEThexffff="��";TEXT VARindexpat:="��ii��";replace(indexpat,2,1);TEXT VARentrypat;TYPE TEXTROW=TEXT;TEXTROW CONSTemptytextrow:=TEXTROW:(indexpat);OP:=(TEXTROW VARd,TEXTROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCcatexpanded(TEXT VARt,TEXT CONSTentry):INT CONSTl:=LENGTHentry;INT VARb:=1;INT VARef:=pos(entry,hexff,b);IFef=0THENef:=l+1FI;INT VARe0:=pos(entry,hex00,b);IFe0=0THENe0:=l+1FI;REP IFe0<efTHENtCATsubtext(entry,b,e0-1);tCAThex0001;b:=e0+1;e0:=pos(entry,hex00,b);IFe0=0THENe0:=l+1FI;ELIFef<e0THENtCATsubtext(entry,b,ef-1);tCAThexfeff;b:=ef+1;ef:=pos(entry,hexff,b);IFef=0THENef:=l+1FI;ELSEtCATsubtext(entry,b);LEAVEcatexpanded;FI;PER;END PROCcatexpanded;PROCcatcompressed(TEXT VARt,TEXT CONSTentry):INT CONSTl:=LENGTHentry;INT VARb:=1;INT VARef:=pos(entry,hexfeff,b);IFef=0THENef:=l+1FI;INT VARe0:=pos(entry,hex0001,b);IFe0=0THENe0:=l+1FI;REP IFe0<efTHENtCATsubtext(entry,b,e0-1);tCAThex00;b:=e0+2;e0:=pos(entry,hex0001,b);IFe0=0THENe0:=l+1FI;ELIFef<e0THENtCATsubtext(entry,b,ef-1);tCAThexff;b:=ef+2;ef:=pos(entry,hexfeff,b);IFef=0THENef:=l+1FI;ELSEtCATsubtext(entry,b);LEAVEcatcompressed;FI;PER;END PROCcatcompressed;INT PROChighestentry(TEXTROW CONSTt):INT VARp:=LENGTH CONCR(t)-5;IFp>0THEN(subtext(CONCR(t),p+2,p+3)ISUB1)-1ELSE0FI END PROChighestentry;INT PROCfirstentry(TEXTROW CONSTdir):nextentry(dir,0)END PROCfirstentry;INT PROCnextentry(TEXTROW CONSTdir,INT CONSTstart):INT VARindex:=start;INT CONSTlimit:=highestentry(dir);WHILEindex<=limitREPindexINCR1UNTILname(dir,index)<>""PER;indexEND PROCnextentry;BOOL OP CONTAINS(TEXTROW CONSTt,TEXT CONSTentry):entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;pos(CONCR(t),entrypat,1)>0END OP CONTAINS;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENsubtext(CONCR(t),p-2,p-1)ISUB1ELSE0FI END PROClink;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry,INT CONSTstart):INT VARp,index;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=0;REPp:=pos(CONCR(t),entrypat,p+1);IFp=0THEN LEAVElinkWITH0FI;index:=subtext(CONCR(t),p-2,p-1)ISUB1;UNTILindex>=startPER;indexEND PROClink;TEXT PROCname(TEXTROW CONSTt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);IFb=0THEN LEAVEnameWITH""FI;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe=0THEN LEAVEnameWITH""FI;entrypat:="";catcompressed(entrypat,subtext(CONCR(t),b+6,e-1));entrypatEND PROCname;PROCrename(TEXTROW VARt,TEXT CONSTold,new):INT VARp,len;entrypat:=hexffff;catexpanded(entrypat,old);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENlen:=LENGTHentrypat;entrypat:="";catexpanded(entrypat,new);change(CONCR(t),p+2,p+len-3,entrypat);FI;END PROCrename;PROCrename(TEXTROW VARt,INT CONSTindex,TEXT CONSTnew):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe>0THENchange(CONCR(t),b+6,e-1,new);FI;END PROCrename;PROCinsert(TEXTROW VARt,TEXT CONSTentry,INT VARindex):index:=subtext(CONCR(t),LENGTH CONCR(t)-3)ISUB1;catexpanded(CONCR(t),entry);replace(indexpat,2,index+1);CONCR(t)CATindexpat;END PROCinsert;PROCinsert(TEXTROW VARt,TEXT CONSTentry):INT VARindex;insert(t,entry,index);END PROCinsert;PROCdelete(TEXTROW VARt,TEXT CONSTentry,INT VARindex):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENindex:=subtext(CONCR(t),p-2,p-1)ISUB1;change(CONCR(t),p+2,p+len-3,"");ELSEindex:=0;FI;END PROCdelete;PROCdelete(TEXTROW VARt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1)+6;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b);
+IFe=0THEN LEAVEdeleteFI;IFindex=highestentry(t)THEN CONCR(t):=subtext(CONCR(t),1,b-1);ELSEchange(CONCR(t),b,e-1,"");FI;END PROCdelete;PROCget(TEXTROW CONSTt,TEXT VARentry,INT VARindex):INT VARb,e;indexINCR1;replace(indexpat,2,index);b:=pos(CONCR(t),indexpat,1);entry:="";REPbINCR6;indexINCR1;replace(indexpat,2,index);e:=pos(CONCR(t),indexpat,b);IFe>bTHENindexDECR1;catcompressed(entry,subtext(CONCR(t),b,e-1));LEAVEget;ELIFe=0THENindex:=0;LEAVEget;FI;PER;END PROCget;TEXT PROCtop(TEXTROW CONSTt):name(t,highestentry(t))END PROCtop;TEXT PROCpop(TEXTROW VARt):pop(t,entrypat);entrypatEND PROCpop;PROCpop(TEXTROW VARt,TEXT VARentry):entry:=top(t);delete(t,highestentry(t));END PROCpop;INT PROCleftmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:=hexffff;catexpanded(entrypat,entry);l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCleftmatchinglinks;INT PROCrightmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:="";catexpanded(entrypat,entry);entrypatCAThex0000;l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCrightmatchinglinks;TEXTROW OP LIKE(TEXTROW CONSTa,TEXT CONSTpattern):TEXTROW VARlike:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(like,entry)=0AND(entryLIKEpattern)THENinsert(like,entry)FI;PER;likeEND OP LIKE;TEXTROW OP REV(TEXTROW CONSTa):TEXTROW VARrev:=emptytextrow;INT VARindex;FORindexFROMhighestentry(a)DOWNTO1REPinsert(rev,name(a,index));PER;revEND OP REV;TEXTROW OP-(TEXTROW CONSTa):textrow(all)-aEND OP-;TEXTROW OP+(TEXTROW CONSTa,b):TEXTROW VARunion:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;unionEND OP+;TEXTROW OP-(TEXTROW CONSTa,b):TEXTROW VARdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(diff,entry)=0ANDlink(b,entry)=0THENinsert(diff,entry)FI;PER;diffEND OP-;TEXTROW OP/(TEXTROW CONSTa,b):TEXTROW VARinter:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(inter,entry)=0ANDlink(b,entry)>0THENinsert(inter,entry)FI;PER;interEND OP/;TEXTROW OP*(TEXTROW CONSTa,b):TEXTROW VARsdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(sdiff,entry)=0ANDlink(b,entry)=0THENinsert(sdiff,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(sdiff,entry)=0ANDlink(a,entry)=0THENinsert(sdiff,entry)FI;PER;sdiffEND OP*;BOOL OP<(TEXTROW CONSTa,b):a<=bAND NOT(b<=a)END OP<;BOOL OP<>(TEXTROW CONSTa,b):NOT(a=b)END OP<>;BOOL OP>(TEXTROW CONSTa,b):b<aEND OP>;BOOL OP<=(TEXTROW CONSTa,b):TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(b,entry)=0THEN LEAVE<=WITH FALSE FI;PER;TRUE END OP<=;BOOL OP=(TEXTROW CONSTa,b):a<=bANDb<=aEND OP=;BOOL OP>=(TEXTROW CONSTa,b):b<=aEND OP>=;TEXTROW PROCtextrow(THESAURUS CONSTdir):TEXTROW VARres:=emptytextrow;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCtextrow;THESAURUS PROCthesaurus(TEXTROW CONSTdir):THESAURUS VARres:=emptythesaurus;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCthesaurus;OP FILLBY(FILE VARf,TEXTROW CONSTdir):INT VARindex;output(f);FORindexFROM1UPTOhighestentry(dir)REPputline(f,name(dir,index))PER;END OP FILLBY;OP FILLBY(TEXTROW VARdir,FILE VARf):TEXT VARentry;input(f);WHILE NOTeof(f)REPgetline(f,entry);insert(dir,entry)PER;END OP FILLBY;END PACKETtextrow;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10
new file mode 100644
index 0000000..373245e
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14
new file mode 100644
index 0000000..cdb76cb
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16
new file mode 100644
index 0000000..49b821a
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19
new file mode 100644
index 0000000..caff4ba
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8
new file mode 100644
index 0000000..f37fd1d
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8
diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14
new file mode 100644
index 0000000..46e2f95
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14
diff --git a/app/schulis-mathematiksystem/1.0/src/ibmoperatoren b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren
new file mode 100644
index 0000000..23601d2
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe
new file mode 100644
index 0000000..09a2939
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe
@@ -0,0 +1,4 @@
+PACKETlsdialog1DEFINESwaagerecht,senkrecht,eckeobenlinks,eckeobenrechts,eckeuntenlinks,eckeuntenrechts,balkenunten,balkenoben,balkenlinks,balkenrechts,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t
+);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile)END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONSTspa
+,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT"  ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT"  ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2END PROCoutinverswithbeam;END PACKETlsdialog1;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe
new file mode 100644
index 0000000..73d4c2a
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe
@@ -0,0 +1,7 @@
+PACKETlsdialog2DEFINESsome,one,lsexitkey,resetlsexitkey,infixnamen,ohnepraefix,notempty:LETmaxentries=200;LETzeichenstring="���
+
�xo? ",obenuntenreturnruboutkreuzkringelblank="�
+
�xo ",qeinsneunh="w19m";LETzurueck="�",piep="�";LEThop=1,esc=2,oben=3,unten=4,return=5,rubout=6,kreuz=7,kringel=8,frage=9,leer=10;LETpunkt=".",blank=" ";INT VARx,y,xsize,ysize,maxeintraege,anzahl,ersteauswahlzeile,virtuellercursor,reellercursor;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="";BOOL VARabbruch,auswahlende;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW16TEXT CONSThinweis:=ROW16TEXT:(" Bitte warten...!"," Info: <?>  Weiter: <ESC><w> Menü: <ESC><m>"," Weiter mit beliebiger Taste!","Weitere Einträge!","        INFORMATIONEN ZUR AUSWAHL AUS DER LISTE","  Positionierung der Schreibmarke:","  Pfeil auf/ab      : eine Position nach oben/unten","  HOP Pfeil auf/ab  : auf erste/letzte Pos. der Seite","  ESC 1/ESC 9       : auf erste/letzte Pos. der Liste","  Ankreuzen und Löschen von Kreuzen:","  RETURN/x          : den Eintrag ankreuzen","  RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen","  HOP RETURN/HOP x  : alle folgenden Eintr. ankreuzen","  HOP RUBOUT/HOP o  : alle folgenden Kreuze löschen","         /HOP Leertaste"," Info: <?>  Menü: <ESC><m>");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCresetlsexitkey:exitkey:=""END PROCresetlsexitkey;THESAURUS PROCauswahl(THESAURUS CONSTt,BOOL CONSTmehreremoeglich,TEXT CONSTt1,t2):TEXT VARlinie:=(xsize-2)*waagerecht;werteinitialisieren;namenbesorgen;bildschirmaufbauen;auswaehlenlassen;abgangvorbereiten.werteinitialisieren:THESAURUS VARausgabe:=emptythesaurus;DATASPACE VARds:=nilspace;eintrag:=ds;kennzeile1:=t1;kennzeile2:=t2;abbruch:=FALSE;ersteauswahlzeile:=y+5;anzahl:=0;maxeintraege:=ysize-8;virtuellercursor:=1;reellercursor:=1.namenbesorgen:fischedienamenausdemthesaurus;IFkeineintragvorhandenTHEN LEAVEauswahlWITHausgabeFI.bildschirmaufbauen:schreibekopfzeile;gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1);schreibefusszeile;IFmehreremoeglichTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;reellencursorsetzen.schreibekopfzeile:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreibefusszeile:cursor(x,y+ysize-2);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).auswaehlenlassen:kreuzean(mehreremoeglich).abgangvorbereiten:footnote(hinweis[1]);cursor(x+1,y+ysize-1);ausgabeerzeugen;forget(ds);ausgabe.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.ausgabeerzeugen:TEXT VARnummer;WHILEregistrierkette<>""REPnummer:=subtext(registrierkette,1,3);registrierkette:=subtext(registrierkette,5);insert(ausgabe,eintrag[int(nummer)])PER.END PROCauswahl;PROCreellencursorsetzen:cursor(x+1,ersteauswahlzeile+reellercursor-1);out(marke(virtuellercursor,TRUE)+8*zurueck)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):TEXT VARpunktlinie:=(xsize-2)*punkt,weiterzeile:=(xsize-length(hinweis[4])-5)*punkt+invers(hinweis[4]),beamedleerzeile:=senkrecht+(xsize-2)*blank+senkrecht;gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x,ersteauswahlzeile-1);out(senkrecht);IFreellercursor=virtuellercursorTHENout(punktlinie)ELSEout(weiterzeile)FI;out(senkrecht);line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;TEXT VARhilf;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x,ersteauswahlzeile+zaehler);hilf:=senkrecht;hilfCATmarke(zeiger,FALSE);hilfCATtext(subtext(eintrag[zeiger],1,xsize-10),xsize-10);hilfCATsenkrecht;out(hilf)PER.gibfusszeileaus:cursor(x,ersteauswahlzeile+zaehler+1);out(senkrecht);IF NOT((virtuellercursor+maxeintraege-reellercursor)<anzahl)THENout(punktlinie)ELSEout(weiterzeile)FI;out(
+senkrecht).loescheggfrestbereich:IFzaehler+1<maxeintraegeTHENloeschebildschirmrestFI.loeschebildschirmrest:FORzeigerFROMrestanfangUPTOrestendeREPcursor(x,zeiger);out(beamedleerzeile)PER.restanfang:ersteauswahlzeile+zaehler+2.restende:ersteauswahlzeile+maxeintraege.grenze:min(anzahl,anfang+maxeintraege-1).END PROCbauebildschirmauf;TEXT PROCmarke(INT CONSTzeiger,BOOL CONSTmitcursor):INT VARplatz:=nr(zeiger);IFplatz=0THENleerELSEmitzahlFI.mitzahl:TEXT VARhilf;IFmitcursorTHENhilf:="==>";ELSEhilf:="   "END IF;hilfCAT(3-length(text(platz)))*blank;hilfCATtext(platz);hilfCAT"x ";hilf.leer:IFmitcursorTHEN"==>   o "ELSE"      o "FI.END PROCmarke;INT PROCnr(INT CONSTzeiger):IFpos(registrierkette,textstring(zeiger))=0THEN0ELSE(pos(registrierkette,textstring(zeiger))DIV4)+1FI END PROCnr;TEXT PROCtextstring(INT CONSTnr):text(nr,3)+"!"END PROCtextstring;PROCinfo:INT VARi;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(x+1,y+1);out(center(xsize-2,hinweis[5]));cursor(x+1,y+2);out("",xsize-2).notierepositionierhinweise:cursor(x+1,y+3);out(hinweis[6],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO7REPcursor(x+1,y+i);out(hinweis[i+2],xsize-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(x+1,y+8);out("",xsize-2);cursor(x+1,y+9);out(hinweis[10],xsize-2);cursor(x+1,y+10);out("",xsize-2);FORiFROM11UPTO15REPcursor(x+1,y+i);out(hinweis[i],xsize-2)PER;loeschedierestlichenzeilen;footnote(hinweis[3]);cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMy+16UPTOy+ysize-3REPcursor(x+1,i);out("",xsize-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[3]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(x+1,y+3);out(hinweis[10],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO9REPcursor(x+1,y+i);out(hinweis[i+6],xsize-2)PER;FORzaehlerFROM10UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.cursorinruhestellung:cursor(x+1,y+ysize-2).stellealtenbildschirmzustandwiederher:clearbuffer;pause;gibhinweisaus(kennzeile1,kennzeile2);virtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzen.nochplatzvorhanden:ysize>17.END PROCinfo;PROCkreuzean(BOOL CONSTmehrere):auswahlende:=FALSE;clearbuffer;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;getchar(zeichen).zeicheninterpretieren:SELECTpos(zeichenstring,zeichen)OF CASEhop:hopkommandoverarbeiten(mehrere)CASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEkreuz,return:ankreuzenweiter;evtlaufhoerenCASErubout,kringel,leer:auskreuzenweiterCASEfrage:info;IFmehrereTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;OTHERWISEout(piep)END SELECT.evtlaufhoeren:IF NOTmehrereTHEN LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten(BOOL CONSTmehrere):zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;getchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(obenuntenreturnruboutkreuzkringelblank,zweiteszeichen)OF CASE1:hopnachobenCASE2:hopnachuntenCASE3,5:IFmehrereTHENalledarunterankreuzenFI CASE4,6,7:IFmehrereTHENalledarunterloeschenFI OTHERWISEout(piep)END SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREP IFnr(i)=0THENankreuzenFI PER;bildaktualisieren;reellencursorsetzen.ankreuzen:registrierketteCATtextstring(i).alledarunterloeschen:INT VARj,position;FORjFROMvirtuellercursorUPTOanzahlREPposition:=nr(j);IFposition>0THENrausschmeissen;FI PER;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,(4*position)-4)+subtext(registrierkette,(4*position)+1).hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaettern
+ELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschemarke;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschemarke;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;getchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:auswahlende:=TRUE CASE2:zeigeanfangCASE3:zeigeendeCASE4:abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT;exitkey:=zweiteszeichen.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschemarke;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschemarke;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)<maxeintraege+1.END PROCesckommandoverarbeiten;PROCankreuzen:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;reellencursorsetzenEND PROCankreuzen;PROCankreuzenweiter:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;IFvirtuellercursor<anzahlTHENnachuntenFI;IFvirtuellercursor=anzahlTHENreellencursorsetzenFI END PROCankreuzenweiter;PROCauskreuzenweiter:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissen;END IF;IFvirtuellercursor<anzahlTHENnachuntenELSEloeschemarkeFI;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzenweiter;PROCauskreuzen:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissenEND IF;loeschemarke;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzen;PROCbildaktualisieren:INT VARob,un,i,zaehler:=-1;ob:=virtuellercursor-reellercursor+1;un:=min(ob+maxeintraege-1,anzahl);FORiFROMobUPTOunREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);out(marke(i,FALSE))PER END PROCbildaktualisieren;PROCnachoben:IFnochnichtobenTHENgehenachobenELSEout(piep)FI.nochnichtoben:virtuellercursor>1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschemarke;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursor<anzahl.gehenachunten:IFreellercursor>maxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschemarke;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCloeschemarke:out(marke(virtuellercursor,FALSE))END PROCloeschemarke;PROCgibhinweisaus(TEXT CONSTt1,t2):
+cursor(x,y+1);out(senkrecht);out(center(xsize-2,invers(t1)));out(senkrecht);cursor(x,y+2);out(senkrecht);out("",xsize-2);out(senkrecht);cursor(x,y+3);out(senkrecht);out(center(xsize-2,t2));out(senkrecht)END PROCgibhinweisaus;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROCohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<56COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5).END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-5)THENsubtext(text,1,xsize-7)+".."ELSEtextFI END PROCggfgekuerztertext;THESAURUS PROCsome(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);auswahl(t,TRUE,text1,text2)END PROCsome;THESAURUS PROCsome(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTt,TEXT CONSTt1,t2):some(1,1,79,24,t,t1,t2)END PROCsome;TEXT PROCone(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);name(auswahl(t,FALSE,text1,text2),1)END PROCone;TEXT PROCone(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTt,TEXT CONSTt1,t2):one(1,1,79,24,t,t1,t2)END PROCone;END PACKETlsdialog2;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe
new file mode 100644
index 0000000..3408f21
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe
@@ -0,0 +1,3 @@
+PACKETlsdialog3DEFINES WINDOW,:=,window,show,page,erase,line,remaininglines,cursor,getcursor,outframe,outmenuframe,out,put,putline,get,getline,yes,no,edit,center,stop,area,areax,areay,areaxsize,areaysize:LETpiep="�",cr="
";LETjaneinkette="jJyYnN",blank=" ",niltext="";TYPE WINDOW=STRUCT(AREAfenster,INTcspalte,czeile,belegbarezeilen,BOOLfensterendeerreicht);ROW3TEXT CONSTaussage:=ROW3TEXT:(" 'Window' ungültig!"," (j/n) ?"," Weiter mit beliebiger Taste!");TEXT VARnumberword,exitchar;OP:=(WINDOW VARlinks,WINDOW CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;WINDOW PROCwindow(INT CONSTx,y,xsize,ysize):WINDOW VARw;fill(w.fenster,x,y,xsize,ysize);initialize(w);wEND PROCwindow;PROCinitialize(WINDOW VARw):w.czeile:=1;w.cspalte:=1;w.fensterendeerreicht:=FALSE;w.belegbarezeilen:=areaysize(w.fenster)END PROCinitialize;PROCshow(WINDOW VARw):zeigerahmen;fensterputzen.zeigerahmen:outframe(w.fenster).fensterputzen:page(w).END PROCshow;PROCpage(WINDOW VARw):initialize(w);page(w,FALSE)END PROCpage;PROCpage(WINDOW CONSTw,BOOL CONSTmitrahmen):IFareax(w)=1ANDareay(w)=1ANDareaxsize(w)=79ANDareaysize(w)=24THENpage;ELSEloeschebereichFI.loeschebereich:IFmitrahmenTHENpage(areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2)ELSEpage(area(w))FI END PROCpage;PROCerase(WINDOW VARw):page(w,TRUE)END PROCerase;PROCline(WINDOW VARw):w.cspalte:=1;IFw.czeile<w.belegbarezeilenTHENw.czeileINCR1;ELSEw.czeile:=1;w.fensterendeerreicht:=TRUE FI;cursor(w,w.cspalte,w.czeile)END PROCline;PROCline(WINDOW VARw,INT CONSTanzahl):INT VARi;FORiFROM1UPTOanzahlREPline(w)PER END PROCline;INT PROCremaininglines(WINDOW CONSTw):INT VARspalte,zeile;getcursor(w,spalte,zeile);IFspalte=0ORzeile=0THEN0ELSEw.belegbarezeilen-w.czeileFI END PROCremaininglines;PROCcursor(WINDOW VARw,INT CONSTspalte,zeile):IFspalte<1ORzeile<1ORspalte>areaxsize(w)ORzeile>areaysize(w)THENpage(w);ELSEw.cspalte:=spalte;w.czeile:=zeile;FI;cursor(w.fenster,w.cspalte,w.czeile)END PROCcursor;PROCgetcursor(WINDOW CONSTw,INT VARspalte,zeile):IF(w.cspalte<1)OR(w.cspalte>areaxsize(w.fenster))OR(w.czeile<1)OR(w.czeile>areaysize(w.fenster))THENspalte:=0;zeile:=0ELSEspalte:=w.cspalte;zeile:=w.czeileFI END PROCgetcursor;PROCout(WINDOW VARw,TEXT CONSTtext):INT VARrestlaenge;IF(w.cspalte>=1)AND(w.cspalte<=areaxsize(w.fenster))AND(w.czeile>=1)AND(w.czeile<=w.belegbarezeilen)THENputzeggffenster;cursor(w.fenster,w.cspalte,w.czeile);outtext(text,1,textende);setzefenstercursorneu;setzeausgabeggfinnaechsterzeilefortFI.putzeggffenster:IFw.fensterendeerreichtTHENpage(w);w.fensterendeerreicht:=FALSE FI.textende:restlaenge:=areaxsize(w.fenster)-w.cspalte+1;min(length(text),restlaenge).setzefenstercursorneu:IFlength(text)>=restlaengeTHENw.cspalte:=1;w.czeileINCR1;schlageggfneueseiteaufELSEw.cspalteINCRlength(text)FI.schlageggfneueseiteauf:IFw.czeile>w.belegbarezeilenTHENw.fensterendeerreicht:=TRUE;w.czeile:=1;w.cspalte:=1FI.setzeausgabeggfinnaechsterzeilefort:IFlength(text)>restlaengeTHENout(w,subtext(text,restlaenge+1))FI.END PROCout;PROCoutframe(WINDOW VARw):outframe(area(w))END PROCoutframe;PROCoutmenuframe(WINDOW VARw):outmenuframe(area(w))END PROCoutmenuframe;PROCput(WINDOW VARw,TEXT CONSTword):out(w,word);out(w,blank)END PROCput;PROCput(WINDOW VARw,INT CONSTnumber):put(w,text(number))END PROCput;PROCput(WINDOW VARw,REAL VARnumber):put(w,text(number))END PROCput;PROCputline(WINDOW VARw,TEXT CONSTtextline):out(w,textline);line(w)END PROCputline;PROCprivateget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator,INT CONSTlength):INT VARx,y;INT VARrestlaenge:=areaxsize(w.fenster)-w.cspalte-1;ggfzurnaechstenzeile;getcursor(x,y);cursoron;cursor(x,y);REPword:="";editget(word,laenge,laenge,separator,"",exitchar);out(w,word);echoeexitchar(w)UNTILword<>niltextANDword<>blankPER;cursoroff;deleteleadingblanks.ggfzurnaechstenzeile:IFrestlaenge<5THENline(w);restlaenge:=areaxsize(w.fenster)-2FI.deleteleadingblanks:WHILE(wordSUB1)=blankREPword:=subtext(word,2)PER.laenge:min(length,restlaenge).END PROCprivateget;PROCget(WINDOW VARw,TEXT VARword):
+privateget(w,word," ",maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator):privateget(w,word,separator,maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,INT CONSTlength):privateget(w,word,"",length)END PROCget;PROCget(WINDOW VARw,INT VARnumber):get(w,numberword);number:=int(numberword)END PROCget;PROCget(WINDOW VARw,REAL VARnumber):get(w,numberword);number:=real(numberword)END PROCget;PROCgetline(WINDOW VARw,TEXT VARtextline):privateget(w,textline,"",maxtextlength)END PROCgetline;PROCechoeexitchar(WINDOW VARfenster):IFexitchar=crTHENline(fenster)ELSEout(fenster,exitchar)FI END PROCechoeexitchar;TEXT PROCcenter(WINDOW CONSTw,TEXT CONSTtext):IFlength(text)>=areaxsize(w.fenster)THENsubtext(text,1,areaxsize(w.fenster))ELSEcenter(areaxsize(w.fenster),text)FI END PROCcenter;BOOL PROCyes(WINDOW VARw,TEXT CONSTfrage):TEXT VARzeichen,internefrage:=frage;internefrageCATaussage[2];wechselggfaufneueseite;out(w,internefrage);holeeingabezeichen;wertezeichenaus.wechselggfaufneueseite:IFremaininglines(w)<1THENpage(w)FI.holeeingabezeichen:cursoron;clearbuffer;REPinchar(zeichen);piepseggfUNTILpos(janeinkette,zeichen)>0PER;out(w,blank+zeichen);cursoroff;line(w).piepseggf:IFpos(janeinkette,zeichen)=0THENout(piep)FI.wertezeichenaus:IFpos(janeinkette,zeichen)<5THEN TRUE ELSE FALSE FI.END PROCyes;PROCedit(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);cursoron;edit(f,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoroffEND PROCedit;PROCedit(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);edit(w,f)END PROCedit;PROCshow(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);openeditor(groesstereditor+1,f,FALSE,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoron;edit(groesstereditor,"eqvw19dpgn�",PROC(TEXT CONST)stdkommandointerpreter);cursoroffEND PROCshow;PROCshow(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);show(w,f)END PROCshow;PROCloescherechtespalten(WINDOW VARw):INT VARi;FORiFROM1UPTOareaysize(w.fenster)REPcursor(w,areaxsize(w.fenster)-2,i);out("   ")PER END PROCloescherechtespalten;BOOL PROCno(WINDOW VARw,TEXT CONSTfrage):NOTyes(w,frage)END PROCno;PROCstop(WINDOW VARw):stop(w,2)END PROCstop;PROCstop(WINDOW VARw,INT CONSTzeilenzahl):INT VARi;FORiFROM1UPTOzeilenzahlREPline(w)PER;out(w,aussage[3]);pauseEND PROCstop;AREA PROCarea(WINDOW CONSTw):w.fensterEND PROCarea;INT PROCareax(WINDOW CONSTw):areax(w.fenster)END PROCareax;INT PROCareay(WINDOW CONSTw):areay(w.fenster)END PROCareay;INT PROCareaxsize(WINDOW CONSTw):areaxsize(w.fenster)END PROCareaxsize;INT PROCareaysize(WINDOW CONSTw):areaysize(w.fenster)END PROCareaysize;END PACKETlsdialog3
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe
new file mode 100644
index 0000000..bafd79b
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe
@@ -0,0 +1,6 @@
+PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETdelimiter="
",piep="�",gueltigezeichen="
+�
",esc="�",auswahl="z",abbruch="m",blank=" ",trennliniensymbol="-",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: <Pfeile>  Bestätigen: <RETURN>  Menü: <ESC> <m>"," Wählen: <Pfeile>  Bestätigen: <RETURN>  Ja: <j>  Nein: <n>"," Wählen: <Pfeile>  Bestätigen: <RETURN>"," Bestätigen: <RETURN>  Zeigen: <ESC><z>  Menü: <ESC><m>"," Bestätigen: <RETURN>  Menü: <ESC><m>","Ja
Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w,
+thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnote;FI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize))PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT
+ CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+"  "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI.lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=vorgabe;schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht).
+schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:="";lsexitkey(abbruch)ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahl;lsexitkey(auswahl);ELSElsexitkey("");eingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabeEND PROCholeantwort;END PACKETlsdialog4
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe
new file mode 100644
index 0000000..608cae7
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe
@@ -0,0 +1,9 @@
+PACKETlsdialog5DEFINESwritehead,restorehead,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,menukartenname,currentmenuwindow,resetdialog,ausstieg:LETmenutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",maxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",trennzeilensymbol="###",hauptmenuluecke="  ";LETauswahlstring1="��
+�
�?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:<ESC><?>/<?>  Wählen:<Pfeile>  Bestätigen:<RETURN> Verlassen:<ESC><q>"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine 

        Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt 

  kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname
+);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname):mitausstieg:=TRUE;cursoroff;bietemenuan;lassemenupunkteauswaehlen;schliessemenu;leereggfdenbildschirm.bietemenuan:oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).interpretierezeichen:SELECTzeichenpositionOF CASE1,2:geheeinenhauptmenupunktnachlinksoderrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.pruefeobfehler:IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage)END IF.geheeinenhauptmenupunktnachlinksoderrechts:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;IFzeichenposition=1THENanzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;ELSEanzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;END IF;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger<aktuellesmenu.anzahlhauptmenupunkteTHENaktuellesmenu.hauptmenuzeigerINCR1ELSEaktuellesmenu.hauptmenuzeiger:=1FI.geheeinenuntermenupunktnachunten:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachuntenEND IF;INT VARnaechsteraktiver:=folgenderaktiveruntermenupunkt;nimmummarkierungvor.geheeinenuntermenupunktnachoben:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachobenEND IF;naechsteraktiver:=vorausgehenderaktiveruntermenupunkt;nimmummarkierungvor.nimmummarkierungvor:IFueberhauptaktivemenupunktevorhandenTHENdemarkiereaktuellenuntermenupunkt;gehezumfolgendenuntermenupunkt;markiereaktuellenuntermenupunktFI.ueberhauptaktivemenupunktevorhanden:(aktuellesuntermenu.belegt>0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger<>0THENkennzeichnealsangetickt;fuehreoperationaus(menuanweisung);IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IF
+folgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.beendeaktuelleuntermenuoperationen:kuerzelkette:="".starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelketteCAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;ueberpruefeanzahloffenermenus;aktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=0;aktuellesmenu.untermenuanfang:=0;fuehreggfmenueingangsprozeduraus;showmenu;.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=iFI UNTILgefundenPER;IF NOTgefundenTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1.ueberpruefeanzahloffenermenus:IFanzahloffenermenus=1THENmenuwindow:=window(1,2,79,23)ELIFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuell;menuwindow:=zweitesmenuELSEanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI;menuleiste.zeigeraktuell:=suchzeiger;hochruntererlaubt:=TRUE.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.END PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page;schreibekopfzeile;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm;zeigeinformationszeilean.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:IFaktuellesmenu.kopfzeile<>""THENcursor(1,1);out(invers(text(aktuellesmenu.kopfzeile,77)))END IF.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(1,2);out(hauptmenuzeile);cursor(1,3);out(79*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext:
+aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile,
+aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH1ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IFvoriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT VARbezeichnung:=kennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELSEblankFI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROC
+activate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:page;showmenu;showmenunotice;activationchanged:=FALSE.END PROCregeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit);oldfootnote;schreibeaktuellesuntermenuaufbildschirmEND PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice
+:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;.aktuellesuntermenu:aktmenu.einzelmenu[aktmenu.hauptmenuzeiger].aktmenu:menuleiste.menu[menuleiste.zeigeraktuell].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell]END PACKETlsdialog5;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik
new file mode 100644
index 0000000..d547811
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.abbildung b/app/schulis-mathematiksystem/1.0/src/mat.abbildung
new file mode 100644
index 0000000..0e839e1
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.abbildung
@@ -0,0 +1,13 @@
+PACKETabbildungDEFINES ABBILDUNG,abbildungsterme,abbildungsvariablen,abbildung,neueabbildung,adresse,variablenidentitaet,vergleichsfunktion,aufloesung,ergebnis,ergebnisvektor,result,ableitung,komplexefunktion,:=,+,-,*,/,O,newtonvorschrift,iterationsvorschrift,loeschebenannteabbildung,loeschetemporaereabbildung,loescheabbildung,ableitungsverbot,selektionshaltigetermliste:LETpisymbol="pi",allgemeinespotenzsymbol="**",speziellespotenzsymbol="^",multiplikationssymbol="*",divisionssymbol="/",verkettungssymbol="O",plussymbol="+",minussymbol="-",strichsymbol="'",kleinersymbol="<",kleinergleichsymbol="<=",ungleichsymbol="<>",gleichsymbol="=",groessergleichsymbol=">=",odersymbol="ODER",differenziersymbol="D",esymbol="e",sinussymbol="sin",cosinussymbol="cos",tangenssymbol="tan",cotangenssymbol="cot",arcussinussymbol="arcsin",arcuscosinussymbol="arccos",arcustangenssymbol="arctan",arcuscotangenssymbol="arccot",lnsymbol="ln",log2symbol="log2",log10symbol="log10",exponentialsymbol="exp",signumsymbol="sign",betragssymbol="abs",wurzelsymbol="wurzel",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",defaultfuervariablenindex=1,defaultfuerkomponentenindex=1;TYPE ABBILDUNG=STRUCT(LISTEvariablenliste,termliste);OP:=(ABBILDUNG VARlinks,ABBILDUNG CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;LISTE PROCabbildungsterme(ABBILDUNG CONSTf):f.termlisteEND PROCabbildungsterme;LISTE PROCabbildungsvariablen(ABBILDUNG CONSTf):f.variablenlisteEND PROCabbildungsvariablen;ABBILDUNG PROCabbildung(TERM CONSTterm):IF NOT(termISfunktionsdefinition)THENerrorstop(anwendungstext(1))END IF;funktion(neueliste(LISTENANFANG VARIABLENterm,LISTENENDE VARIABLENterm),neueliste(LISTENANFANG TERMEterm,LISTENENDE TERMEterm))END PROCabbildung;ABBILDUNG PROCabbildung(TEXT CONSTabbildungsname):TERM VAReintrag:=listenposition(eigenefunktionen,abbildungsname);IFeintrag=nilTHENeintrag:=listenposition(standardfunktionen,abbildungsname);IFeintrag=nilTHENerrorstop(anwendungstext(48))END IF;kopiertestandardfunktionELSEabbildung(DEFINITIONeintrag)END IF.kopiertestandardfunktion:TERM VARneuevariable:=newvariable(1,"x"),argument:=newterm(neuevariable),ausdruck:=newterm(newfunktionsauswertung(eintrag,newtermliste(argument,argument,1),defaultfuerkomponentenindex));neueabbildung(neueliste(neuevariable,neuevariable),neueliste(ausdruck,ausdruck))END PROCabbildung;ABBILDUNG PROCneueabbildung(LISTE CONSTvariablenliste,termliste):anhaengenantemporaerefunktionen(newtemporaerefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(variablenliste),listenende(variablenliste),laenge(variablenliste)),newtermliste(listenanfang(termliste),listenende(termliste),laenge(termliste)))));funktion(variablenliste,termliste)END PROCneueabbildung;ABBILDUNG PROCfunktion(LISTE CONSTvariablen,terme):ABBILDUNG VARf;f.variablenliste:=variablen;f.termliste:=terme;fEND PROCfunktion;ABBILDUNG OP+(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,plussymbol)END OP+;ABBILDUNG OP-(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,minussymbol)END OP-;ABBILDUNG PROCadditivezusammenfassung(ABBILDUNG CONSTl,r,TEXT CONSTopsymbol):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste),terme:=neueliste(nil,nil);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste);REPanhaengen(terme,newterm(newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),opsymbol)));linkerterm:=nachfolger(linkerterm);rechterterm:=nachfolger(rechterterm)UNTILrechterterm=nilEND REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,terme)END PROC
+additivezusammenfassung;ABBILDUNG OP*(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste),neuerterm:=newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol);linkerterm:=nachfolger(linkerterm);WHILElinkerterm<>nilREPrechterterm:=nachfolger(rechterterm);neuerterm:=newdyade(neuerterm,newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol),plussymbol);linkerterm:=nachfolger(linkerterm);END REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neuerterm:=newterm(neuerterm);neueabbildung(variablen,neueliste(neuerterm,neuerterm))END OP*;ABBILDUNG OP/(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>1CORlaenge(r.termliste)<>1THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARergebnis:=newterm(newdyade(kopie(AUSDRUCKlistenanfang(l.termliste),variablen),kopie(AUSDRUCKlistenanfang(r.termliste),variablen),divisionssymbol));loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,neueliste(ergebnis,ergebnis))END OP/;ABBILDUNG OP O(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung;loeschetemporaereabbildungenundreicheneueabbildungnachaussen.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IFlaenge(r.termliste)<>laenge(l.variablenliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:initialisieredielistenderneuenabbildung;erzeugealletermederneuenabbildung.initialisieredielistenderneuenabbildung:LISTE VARvariablen:=kopiedervariablenliste(r.variablenliste),terme:=neueliste(nil,nil).erzeugealletermederneuenabbildung:INT VARtermzaehler;TERM VARlinkeadresse:=adresse(l),rechteadresse:=adresse(r);FORtermzaehlerFROM1UPTOlaenge(l.termliste)REPerzeugeeinentermEND REP.erzeugeeinenterm:LISTE VARargumente:=neueliste(nil,nil);erstelleargumentlistederfunktionsauswertung;anhaengen(terme,newterm(newfunktionsauswertung(linkeadresse,newtermliste(listenanfang(argumente),listenende(argumente),laenge(argumente)),termzaehler))).erstelleargumentlistederfunktionsauswertung:INT VARargumentzaehler;LISTE VARliste;IFebene=1THENanhaengen(argumente,newterm(kopie(AUSDRUCKlistenanfang(r.termliste),variablen)));FORargumentzaehlerFROM2UPTOlaenge(variablen)REPanhaengen(argumente,newterm(auswahl(variablen,argumentzaehler)))END REP ELSE FORargumentzaehlerFROM1UPTOlaenge(r.termliste)REPliste:=neueliste(nil,nil);erstelleargumentlistederinnerenfunktion;anhaengen(argumente,newterm(newfunktionsauswertung(rechteadresse,newtermliste(listenanfang(liste),listenende(liste),laenge(liste)),argumentzaehler)))END REP END IF.erstelleargumentlistederinnerenfunktion:INT VARi;FORiFROM1UPTOlaenge(r.variablenliste)REPanhaengen(liste,newterm(auswahl(r.variablenliste,i)))END REP.loeschetemporaereabbildungenundreicheneueabbildungnachaussen:ABBILDUNG VARscratchfunktion:=neueabbildung(variablen,terme),exportfunktion:=aufloesung(scratchfunktion);loescheabbildung(scratchfunktion);loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);exportfunktionEND OP O;ABBILDUNG
+ OP+(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;operandEND OP+;ABBILDUNG OP-(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;bildeneueabbildung.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(operand.variablenliste),terme:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(operand.termliste);REPanhaengen(terme,newterm(newmonade(kopie(AUSDRUCKlaufterm,variablen),minussymbol)));laufterm:=nachfolger(laufterm)UNTILlaufterm=nilEND REP;loeschetemporaereabbildung(operand);neueabbildung(variablen,terme)END OP-;ABBILDUNG PROCnewtonvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildenewtonvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFableitungsverbot(funktionsadresse)THENerrorstop(anwendungstext(56))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildenewtonvorschrift:ABBILDUNG VARtemp1:=aufloesung(f),temp2:=ableitung(temp1,1,varindex);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARneuerterm:=newterm(newdyade(auswahl(neuevariablen,varindex),newdyade(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen),kopie(AUSDRUCKlistenanfang(temp2.termliste),neuevariablen),divisionssymbol),minussymbol));loeschetemporaereabbildung(temp1);loeschetemporaereabbildung(temp2);neueabbildung(neuevariablen,neueliste(neuerterm,neuerterm))END PROCnewtonvorschrift;ABBILDUNG PROCiterationsvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildeiterationsvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildeiterationsvorschrift:ABBILDUNG VARtemp1:=aufloesung(f);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARnt:=newterm(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen));loeschetemporaereabbildung(temp1);neueabbildung(neuevariablen,neueliste(nt,nt))END PROCiterationsvorschrift;VECTOR PROCergebnis(ABBILDUNG CONSTf,VECTOR CONSTvariablenvektor):enablestop;testeexistenz(f);IFlaenge(f.variablenliste)<>length(variablenvektor)THENerrorstop(anwendungstext(45))END IF;ergebnisvektor(f.termliste,variablenvektor)END PROCergebnis;VECTOR PROCergebnisvektor(LISTE CONSTzuberechnendetermliste,VECTOR CONSTvariablenvektor):INT VARanzahlterme:=laenge(zuberechnendetermliste),i;VECTOR VARergebnisse:=vector(anzahlterme);TERM VARterm:=listenanfang(zuberechnendetermliste);FORiFROM1UPTOanzahltermeREPreplace(ergebnisse,i,result(AUSDRUCKterm,variablenvektor));term:=nachfolger(term)END REP;ergebnisseEND PROCergebnisvektor;REAL PROCresult(TERM CONSTterm,VECTOR CONSTvariablenvektor):TEXT VARoperationssymbol;TERM VARobjekt;enablestop;IFtermISvariableTHENvariablenvektorSUB(PLATZterm)ELIFtermISdyadischTHENwertderdyadeELIFtermISmonadischTHENwertdermonadeELIFtermISfunktionsauswertungTHENfunktionswertELIFtermISkonstanteTHEN WERTtermELSEselektierterwertEND IF.wertderdyade:REAL VARlinks:=result(LINKSterm,variablenvektor),rechts:=result(RECHTSterm,variablenvektor);operationssymbol:=OPERATIONterm;IFoperationssymbol=plussymbolTHENlinks+rechtsELIFoperationssymbol=minussymbolTHENlinks-rechtsELIFoperationssymbol=multiplikationssymbolTHENlinks*rechtsELIFoperationssymbol=divisionssymbolTHENlinks/rechtsELSE IFlinks=0.0CANDrechts=0.0THENerrorstop(anwendungstext(101))END IF;IFrechts<=32767.0CANDrechts>=-32768.0CANDreal(int(rechts))=rechtsTHENlinks**int(rechts)ELSElinks**rechtsEND IF END IF.wertdermonade:IF OPERATIONterm=minussymbolTHEN-result(OPERANDterm,variablenvektor)ELSEresult(OPERANDterm,variablenvektor)END IF.funktionswert:objekt:=ABBILDUNGSAUSDRUCKterm;IF NOT((objektISstandardfunktion)COR(objektIS
+eigenefunktion))THENerrorstop(anwendungstext(14))END IF;IFobjektISstandardfunktionTHENwertderstandardfunktionELSEwertderselbstdefiniertenfunktionEND IF.wertderstandardfunktion:REAL VARargumentwert:=result(erstesargument(term),variablenvektor);operationssymbol:=NAMEobjekt;IFoperationssymbol=sinussymbolTHENsin(argumentwert)ELIFoperationssymbol=cosinussymbolTHENcos(argumentwert)ELIFoperationssymbol=tangenssymbolTHENtan(argumentwert)ELIFoperationssymbol=cotangenssymbolTHENcot(argumentwert)ELIFoperationssymbol=arcussinussymbolTHENarcsin(argumentwert)ELIFoperationssymbol=arcuscosinussymbolTHENarccos(argumentwert)ELIFoperationssymbol=arcustangenssymbolTHENarctan(argumentwert)ELIFoperationssymbol=arcuscotangenssymbolTHENarccot(argumentwert)ELIFoperationssymbol=lnsymbolTHENln(argumentwert)ELIFoperationssymbol=log2symbolTHENlog2(argumentwert)ELIFoperationssymbol=log10symbolTHENlog10(argumentwert)ELIFoperationssymbol=exponentialsymbolTHENexp(argumentwert)ELIFoperationssymbol=signumsymbolTHENreal(sign(argumentwert))ELIFoperationssymbol=wurzelsymbolTHENsqrt(argumentwert)ELIFoperationssymbol=gaussklammersymbolTHENgauss(argumentwert)ELIFoperationssymbol=rundsymbolTHENrund(argumentwert)ELIFoperationssymbol=intsymbolTHENganz(argumentwert)ELIFoperationssymbol=fracsymbolTHENfrak(argumentwert)ELSEabs(argumentwert)END IF.wertderselbstdefiniertenfunktion:result(ausgewaehlterfunktionsterm(term),ergebnisvektor(neueliste(LISTENANFANG ARGUMENTEterm,LISTENENDE ARGUMENTEterm),variablenvektor)).selektierterwert:TERM VARhilfsterm:=term;WHILE NOTcondition(BEDINGUNGhilfsterm,variablenvektor)REPhilfsterm:=ALTERNATIVEhilfsterm;IFhilfsterm=nilTHENerrorstop(anwendungstext(106))END IF END REP;result(AKTIONhilfsterm,variablenvektor)END PROCresult;BOOL PROCcondition(TERM CONSTterm,VECTOR CONSTwerte):TEXT VARoperationssymbol;BOOL VARlinks,rechts;REAL VARlinkerwert,rechterwert;IFtermISlogischedyadeTHENlinks:=condition(LINKSterm,werte);rechts:=condition(RECHTSterm,werte);IF OPERATIONterm=odersymbolTHENlinksCORrechtsELSElinksCANDrechtsEND IF ELSEoperationssymbol:=OPERATIONterm;linkerwert:=result(LINKSterm,werte);rechterwert:=result(RECHTSterm,werte);IFoperationssymbol=kleinersymbolTHENlinkerwert<rechterwertELIFoperationssymbol=kleinergleichsymbolTHENlinkerwert<=rechterwertELIFoperationssymbol=gleichsymbolTHENlinkerwert=rechterwertELIFoperationssymbol=ungleichsymbolTHENlinkerwert<>rechterwertELIFoperationssymbol=groessergleichsymbolTHENlinkerwert>=rechterwertELSElinkerwert>rechterwertEND IF END IF END PROCcondition;BOOL PROCkomplexefunktion(ABBILDUNG CONSTf):enablestop;testeexistenz(f);komplexeliste(listenanfang(f.termliste))END PROCkomplexefunktion;BOOL PROCkomplexeliste(TERM CONSTterm):komplexerterm(AUSDRUCKterm)COR((nachfolger(term)<>nil)CANDkomplexeliste(nachfolger(term)))END PROCkomplexeliste;BOOL PROCkomplexerterm(TERM CONSTterm):IF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)THENkomplexerterm(LINKSterm)CORkomplexerterm(RECHTSterm)ELIF(termISmonadisch)THENkomplexerterm(OPERANDterm)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)ISableitungsoperation)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsdyade)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsmonade)CORkomplexeliste(LISTENANFANG ARGUMENTEterm)COR(((ABBILDUNGSAUSDRUCKterm)ISeigenefunktion)CANDkomplexerterm(ausgewaehlterfunktionsterm(term)))ELIFtermISselektionTHENkomplexerterm(BEDINGUNGterm)CORkomplexerterm(AKTIONterm)CORkomplexerterm(ALTERNATIVEterm)ELSE FALSE END IF END PROCkomplexerterm;ABBILDUNG PROCableitung(ABBILDUNG CONSTf):ableitung(f,defaultfuerkomponentenindex,defaultfuervariablenindex)END PROCableitung;ABBILDUNG PROCableitung(ABBILDUNG CONSTf,INT CONSTkompindex,varindex):enablestop;ueberpruefedieaktuellenparameter;erzeugteableitung.ueberpruefedieaktuellenparameter:testeexistenz(f);IFkompindex>laenge(f.termliste)CORkompindex<1THENerrorstop(anwendungstext(42))ELIFvarindex>laenge(f.variablenliste)CORvarindex<1THENerrorstop(anwendungstext(53))END IF.erzeugteableitung:LISTE VARneuevariablen:=
+kopiedervariablenliste(f.variablenliste);TERM VARabgeleiteterterm:=newterm(diff(abzuleitenderterm,varindex,neuevariablen));neueabbildung(neuevariablen,neueliste(abgeleiteterterm,abgeleiteterterm)).abzuleitenderterm:AUSDRUCKauswahl(f.termliste,kompindex)END PROCableitung;TERM PROCdiff(TERM CONSTterm,INT CONSTvariablenindex,LISTE CONSTvariablen):TERM VARzeiger,objekt;TEXT VARoperation;REAL VARwert;IFtermISselektionTHENerrorstop(anwendungstext(57))END IF;IFtermISvariableTHENableitungeinervariablenELIFtermISmonadischTHENabgeleitetermonadeELIFtermISkonstanteTHENableitungeinerkonstantenELIFtermISdyadischTHENabgeleitetedyadeELSEabgeleitetefunktionsauswertungEND IF.ableitungeinervariablen:IF PLATZterm=variablenindexTHENnewkonstante(1.0,"1")ELSEnewkonstante(0.0,"0")END IF.abgeleitetermonade:signreduce(diff(OPERANDterm,variablenindex,variablen),OPERATIONterm).ableitungeinerkonstanten:newkonstante(0.0,"0").abgeleitetedyade:TERM VARlinkeableitung:=diff(LINKSterm,variablenindex,variablen),rechteableitung;operation:=OPERATIONterm;IFoperation<>speziellespotenzsymbolTHENrechteableitung:=diff(RECHTSterm,variablenindex,variablen)END IF;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELIFoperation=allgemeinespotenzsymbolTHENallgemeinepotenzregelELSEspeziellepotenzregelEND IF.additionsregel:reduce(linkeableitung,rechteableitung,operation).multiplikationsregel:reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),plussymbol).divisionsregel:reduce(reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),minussymbol),reduce(rechtekopie,newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).allgemeinepotenzregel:reduce(reduce(newkonstante(e,esymbol),reduce(rechtekopie,argumentterm,multiplikationssymbol),allgemeinespotenzsymbol),reduce(reduce(rechteableitung,argumentterm,multiplikationssymbol),reduce(reduce(rechtekopie,linkeableitung,multiplikationssymbol),linkekopie,divisionssymbol),plussymbol),multiplikationssymbol).argumentterm:IF(LINKStermISkonstante)CAND(NAME LINKSterm=esymbol)THENnewkonstante(1.0,"1")ELSEzeiger:=newterm(linkekopie);newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex)END IF.speziellepotenzregel:IF(RECHTStermISkonstante)THENwert:=WERT RECHTStermELSE IF(OPERATION RECHTSterm=minussymbol)THENwert:=-WERT OPERAND RECHTStermELSEwert:=WERT OPERAND RECHTStermEND IF END IF;reduce(linkeableitung,reduce(newkonstante(wert,text(int(wert))),reduce(linkekopie,newkonstante(wert-1.0,text(int(wert-1.0))),speziellespotenzsymbol),multiplikationssymbol),multiplikationssymbol).linkekopie:kopie(LINKSterm,variablen).rechtekopie:kopie(RECHTSterm,variablen).abgeleitetefunktionsauswertung:INT VARlambda:=1,anzahlderargumente:=LAENGE ARGUMENTEterm;TERM VARkettenregel:=newkonstante(0.0,"0");FORlambdaFROM1UPTOanzahlderargumenteREPkettenregel:=reduce(kettenregel,reduce(aeussereableitung,innereableitung,multiplikationssymbol),plussymbol)END REP;kettenregel.innereableitung:diff(AUSDRUCK((ARGUMENTEterm)ELEMENTlambda),variablenindex,variablen).aeussereableitung:objekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISstandardfunktionTHENstandardableitungELIF(objektISabbildungsdyade)COR(objektISabbildungsmonade)THENnewfunktionsauswertung(difffunktionsoperation(objekt),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)ELSEnewfunktionsauswertung(newableitungsoperation(abbildungskopie(objekt),lambda,KOMPONENTEterm,differenzieroperator),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)END IF.differenzieroperator:IFobjektISableitungsoperationTHEN OPERATIONobjektELIFtermanzahl(objekt)>1CORvariablenanzahl(objekt)>1THENdifferenziersymbolELSEstrichsymbolEND IF.standardableitung:operation:=NAMEobjekt;IFabschnittweisedefiniertefunktion(operation)THENerrorstop(
+anwendungstext(56))END IF;IFoperation=sinussymbolTHENableitungdersinusfunktionELIFoperation=cosinussymbolTHENableitungdercosinusfunktionELIFoperation=tangenssymbolTHENableitungdertangensfunktionELIFoperation=cotangenssymbolTHENableitungdercotangensfunktionELIFoperation=arcussinussymbolTHENableitungderarcussinusfunktionELIFoperation=arcuscosinussymbolTHENableitungderarcuscosinusfunktionELIFoperation=arcustangenssymbolTHENableitungderarcustangensfunktionELIFoperation=arcuscotangenssymbolTHENableitungderarcuscotangensfunktionELIFoperation=lnsymbolTHENableitungderlnfunktionELIFoperation=log2symbolTHENableitungderlog2funktionELIFoperation=log10symbolTHENableitungderlog10funktionELIFoperation=wurzelsymbolTHENableitungderwurzelfunktionELSEableitungderexponentialfunktionEND IF.ableitungdersinusfunktion:newfunktionsauswertung(listenposition(standardfunktionen,cosinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex).ableitungdercosinusfunktion:newmonade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),minussymbol).ableitungdertangensfunktion:newdyade(newdyade(newfunktionsauswertung(listenposition(standardfunktionen,tangenssymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),newkonstante(1.0,"1"),plussymbol).ableitungdercotangensfunktion:newdyade(newkonstante(-1.0,"-1"),newdyade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).ableitungderarcussinusfunktion:reduce(newkonstante(1.0,"1"),reduce(reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),minussymbol),newkonstante(0.5,"0.5"),allgemeinespotenzsymbol),divisionssymbol).ableitungderarcuscosinusfunktion:signreduce(ableitungderarcussinusfunktion,minussymbol).ableitungderarcustangensfunktion:reduce(newkonstante(1.0,"1"),reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),plussymbol),divisionssymbol).ableitungderarcuscotangensfunktion:signreduce(ableitungderarcustangensfunktion,minussymbol).ableitungderlnfunktion:reduce(newkonstante(1.0,"1"),kopie(erstesargument(term),variablen),divisionssymbol).ableitungderlog2funktion:zeiger:=newterm(newkonstante(2.0,"2"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderlog10funktion:zeiger:=newterm(newkonstante(10.0,"10"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderwurzelfunktion:newdyade(newkonstante(1.0,"1"),newdyade(newkonstante(2.0,"2"),newfunktionsauswertung(listenposition(standardfunktionen,wurzelsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderexponentialfunktion:newfunktionsauswertung(listenposition(standardfunktionen,exponentialsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex)END PROCdiff;TERM PROCdifffunktionsoperation(TERM CONSTterm):IFtermISabbildungsdyadeTHENabgeleiteterdyadischertermELIFtermISabbildungsmonadeTHENabgeleitetermonadischertermELSEeinfacheableitungEND IF.abgeleiteterdyadischerterm:TEXT VARoperation:=OPERATIONterm;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELSEkettenregelEND IF.additionsregel:newabbildungsdyade(difffunktionsoperation(LINKSterm),difffunktionsoperation(RECHTSterm),
+operation).multiplikationsregel:newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),plussymbol).divisionsregel:newabbildungsdyade(newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),minussymbol),newabbildungsdyade(abbildungskopie(RECHTSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),divisionssymbol).kettenregel:newabbildungsdyade(aeussereableitung,innereableitung,multiplikationssymbol).aeussereableitung:newabbildungsdyade(newableitungsoperation(abbildungskopie(LINKSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol),abbildungskopie(RECHTSterm),verkettungssymbol).innereableitung:newableitungsoperation(abbildungskopie(RECHTSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).abgeleitetermonadischerterm:IF(OPERATIONterm=minussymbol)THENnewabbildungsmonade(difffunktionsoperation(OPERANDterm),minussymbol)ELSEdifffunktionsoperation(OPERANDterm)END IF.einfacheableitung:IFableitungsverbot(term)THENerrorstop(anwendungstext(56))END IF;newableitungsoperation(abbildungskopie(term),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).END PROCdifffunktionsoperation;TERM PROCreduce(TERM CONSTl,r,TEXT CONSToperator):REAL VARwert;TERM VARlinks:=l,rechts:=r;IFlISdyadischTHENlinks:=reduce(LINKSl,RECHTSl,OPERATIONl);LOESCHElEND IF;IFrISdyadischTHENrechts:=reduce(LINKSr,RECHTSr,OPERATIONr);LOESCHErEND IF;IFoperator=plussymbolTHENvereinfachteadditionELIFoperator=minussymbolTHENvereinfachtesubtraktionELIFoperator=multiplikationssymbolTHENvereinfachtemultiplikationELIFoperator=divisionssymbolTHENvereinfachtedivisionELIFoperator=speziellespotenzsymbolTHENvereinfachtespeziellepotenzELSEvereinfachteallgemeinepotenzEND IF.vereinfachteaddition:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHErechts;newdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOTvordefiniertekonstante(links)CAND NOTvordefiniertekonstante(rechts)THENwert:=WERTlinks+WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;rechtsELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtesubtraktion:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;LOESCHErechts;newkonstante(0.0,"0")ELIF((linksISkonstante)CAND(rechtsISkonstante))CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks-WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtemultiplikation:TERM VARneuerterm;IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;newdyade(newkonstante(2.0,"2"),rechts,speziellespotenzsymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks*WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THENbeseitige(rechts);linksELIFlinksIST1.0THEN LOESCHElinks;rechtsELIFlinksIST-1.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIF(linksIS
+konstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(LINKSrechtsISkonstante)CAND NOTvordefiniertekonstante(LINKSrechts)THENwert:=WERTlinks*WERT LINKSrechts;LOESCHElinks;LOESCHE LINKSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(RECHTSrechtsISkonstante)CAND NOTvordefiniertekonstante(RECHTSrechts)THENwert:=WERTlinks*WERT RECHTSrechts;LOESCHElinks;LOESCHE RECHTSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIFrechtsIST0.0THENbeseitige(links);rechtsELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(LINKSlinksISkonstante)CAND NOTvordefiniertekonstante(LINKSlinks)THENwert:=WERTrechts*WERT LINKSlinks;LOESCHErechts;LOESCHE LINKSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(RECHTSlinksISkonstante)CAND NOTvordefiniertekonstante(RECHTSlinks)THENwert:=WERTrechts*WERT RECHTSlinks;LOESCHErechts;LOESCHE RECHTSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THEN LOESCHElinks;beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);LOESCHErechts;newkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST1.0)THEN IF(OPERATIONlinks=minussymbol)THENbeseitige(links);signreduce(rechts,minussymbol)ELSEbeseitige(links);rechtsEND IF ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewdyade(links,newkonstante(2.0,"2"),speziellespotenzsymbol)ELSEnewdyade(links,rechts,operator)END IF.vereinfachtedivision:IFlinksIST0.0THENbeseitige(rechts);linksELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,divisionssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,divisionssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.vereinfachteallgemeinepotenz:IFrechtsistganzzahlCAND(linksISkonstante)CAND NOTvordefiniertekonstante(links)THENwert:=WERTlinks**WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHElinks;beseitige(rechts);newkonstante(1.0,"1")ELIFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.rechtsistganzzahl:(rechtsIS
+konstante)CAND(floor(WERTrechts)=WERTrechts).vereinfachtespeziellepotenz:IFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISkonstante)CAND(real(int(WERTrechts))=WERTrechts)THENwert:=(WERTlinks)**int(WERTrechts);LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHErechts;linksELIFlinksIST-1.0THEN IFwertvonrechtsistgeradeTHEN LOESCHElinks;LOESCHErechts;newkonstante(1.0,"1")ELSE LOESCHErechts;linksEND IF ELSEnewdyade(links,rechts,operator)END IF.wertvonrechtsistgerade:(rechtsISkonstante)CANDint(WERTrechts)MOD2=0.END PROCreduce;TERM PROCsignreduce(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm;IFoperandISmonadischTHEN IFresultierendertermistnegativTHENneuerterm:=newmonade(OPERANDoperand,minussymbol);ELSEneuerterm:=OPERANDoperandEND IF;LOESCHEoperandELIFoperandIST0.0THENneuerterm:=operandELSEneuerterm:=newmonade(operand,operator)END IF;neuerterm.resultierendertermistnegativ:OPERATIONoperand<>operator.END PROCsignreduce;ABBILDUNG PROCaufloesung(ABBILDUNG CONSTf):enablestop;testeexistenz(f);loeseauf.loeseauf:LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);neueabbildung(neuevariablen,aufgeloestetermliste(listenanfang(f.termliste),neuevariablen))END PROCaufloesung;LISTE PROCaufgeloestetermliste(TERM CONSTtermlistenanfang,LISTE CONSTneuevariablen):LISTE VARneueterme:=neueliste(nil,nil);TERM VARlaufterm:=termlistenanfang;WHILElaufterm<>nilREPanhaengen(neueterme,newterm(aufloesendekopie(AUSDRUCKlaufterm,neuevariablen)));laufterm:=nachfolger(laufterm)END REP;neuetermeEND PROCaufgeloestetermliste;TERM PROCaufloesendekopie(TERM CONSTterm,LISTE CONSTvariablen):IFtermISvariableTHENauswahl(variablen,PLATZterm)ELIFtermISdyadischTHENreduce(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(aufloesendekopie(OPERANDterm,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(aufloesendekopie(BEDINGUNGterm,variablen),aufloesendekopie(AKTIONterm,variablen),aufloesendekopie(ALTERNATIVEterm,variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;LISTE VARargumente:=aufgeloestetermliste(LISTENANFANG ARGUMENTEterm,variablen);IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,argumente,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(listenanfang(argumente),listenende(argumente),1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF END PROCaufloesendekopie;TERM PROCersetzung(TERM CONSTterm,LISTE CONSTargumentliste,variablen):IFtermISvariableTHENkopie(AUSDRUCKauswahl(argumentliste,PLATZterm),variablen)ELIFtermISdyadischTHENreduce(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(ersetzung(OPERANDterm,argumentliste,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(ersetzung(BEDINGUNGterm,argumentliste,variablen),ersetzung(AKTIONterm,argumentliste,variablen),ersetzung(ALTERNATIVEterm,argumentliste,
+variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,ersetzteargumentliste,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:TERM VARargument:=newterm(ersetzung(erstesargument(term),argumentliste,variablen));newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(argument,argument,1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF.ersetzteargumentliste:LISTE VARargumente:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANG ARGUMENTEterm;WHILElaufterm<>nilREPanhaengen(argumente,newterm(ersetzung(AUSDRUCKlaufterm,argumentliste,variablen)));laufterm:=nachfolger(laufterm)END REP;argumenteEND PROCersetzung;PROCloeschebenannteabbildung(TEXT CONSTname):enablestop;IFlistenposition(eigenefunktionen,name)=nilTHENerrorstop(anwendungstext(48))END IF;loescheabbildung(abbildung(name))END PROCloeschebenannteabbildung;PROCloeschetemporaereabbildung(ABBILDUNG CONSTf):enablestop;IFadresse(f)IStemporaerefunktionTHENloescheabbildung(f)END IF END PROCloeschetemporaereabbildung;PROCloescheabbildung(ABBILDUNG CONSTf):enablestop;TERM VARdefinition,eintrag:=adresse(f);IF(eintragISeigenefunktion)COR(eintragIStemporaerefunktion)THENloescheterme(listenanfang(f.termliste));loeschevariablen(listenanfang(f.variablenliste));definition:=DEFINITIONeintrag;LOESCHE VARIABLENdefinition;LOESCHE TERMEdefinition;LOESCHEdefinition;IFeintragIStemporaerefunktionTHENentfernenaustemporaerenfunktionen(eintrag)ELSEentfernenauseigenenfunktionen(eintrag)END IF;LOESCHEeintragELSEerrorstop(anwendungstext(48))END IF END PROCloescheabbildung;PROCloescheterme(TERM CONSTtermlistenanfang):TERM VARloeschelement:=termlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);beseitige(loeschelement);loeschelement:=naechsteselementEND REP END PROCloescheterme;PROCloeschevariablen(TERM CONSTvariablenlistenanfang):TERM VARloeschelement:=variablenlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);LOESCHEloeschelement;loeschelement:=naechsteselementEND REP END PROCloeschevariablen;PROCbeseitige(TERM CONSTterm):IFtermISausdruckTHENbeseitige(AUSDRUCKterm)ELIF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENbeseitige(LINKSterm);beseitige(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENbeseitige(OPERANDterm);ELIFtermISfunktionsauswertungTHENbeseitige(ABBILDUNGSAUSDRUCKterm);loescheterme(LISTENANFANG ARGUMENTEterm);LOESCHE ARGUMENTEtermELIFtermISableitungsoperationTHENbeseitige(ABBILDUNGSAUSDRUCKterm)ELIFtermISselektionTHENbeseitige(BEDINGUNGterm);beseitige(AKTIONterm);IF(ALTERNATIVEterm)<>nilTHENbeseitige(ALTERNATIVEterm)END IF;ELIF NOT(termISkonstante)THEN LEAVEbeseitigeEND IF;LOESCHEtermEND PROCbeseitige;BOOL PROCableitungsverbot(TERM CONSTterm):IF(termISdyadisch)COR(termISabbildungsdyade)THENableitungsverbot(LINKSterm)CORableitungsverbot(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENableitungsverbot(OPERANDterm)ELIFtermISstandardfunktionTHENabschnittweisedefiniertefunktion(NAMEterm)ELIF(termISeigenefunktion)COR(termIStemporaerefunktion)THENgetesteteliste(LISTENANFANG TERME DEFINITIONterm)ELIFtermISfunktionsauswertungTHENableitungsverbot(auswertungsobjekt)CORgetesteteliste(LISTENANFANG ARGUMENTEterm)ELIFtermIS
+ableitungsoperationTHENableitungsverbot(ABBILDUNGSAUSDRUCKterm)ELSEtermISselektionEND IF.auswertungsobjekt:TERM VARobjekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISeigenefunktionTHEN AUSDRUCK((TERME DEFINITIONobjekt)ELEMENT(KOMPONENTEterm))ELSEobjektEND IF END PROCableitungsverbot;BOOL PROCabschnittweisedefiniertefunktion(TEXT CONSTname):name=signumsymbolCORname=betragssymbolCORname=intsymbolCORname=gaussklammersymbolCORname=rundsymbolCORname=fracsymbolEND PROCabschnittweisedefiniertefunktion;BOOL PROCgetesteteliste(TERM CONSTlistenelement):IFlistenelement=nilTHEN FALSE ELSEableitungsverbot(AUSDRUCKlistenelement)CORgetesteteliste(nachfolger(listenelement))END IF END PROCgetesteteliste;BOOL PROCvariablenidentitaet(ABBILDUNG CONSTl,r):variablenidentitaet(l.variablenliste,r.variablenliste)END PROCvariablenidentitaet;ABBILDUNG PROCvergleichsfunktion(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermISabbildungsdyadeTHENvergleichsfunktion(LINKSterm)ELIFtermISabbildungsmonadeTHENvergleichsfunktion(OPERANDterm)ELSEvergleichsfunktion(ABBILDUNGSAUSDRUCKterm)END IF END PROCvergleichsfunktion;TERM PROCadresse(ABBILDUNG CONSTf):TERM VARvergleichsterm:=listenanfang(f.termliste),suchterm:=nil;durchforste(temporaerefunktionen,suchterm,vergleichsterm);IFsuchterm=nilTHENdurchforste(eigenefunktionen,suchterm,vergleichsterm)END IF;suchtermEND PROCadresse;PROCdurchforste(LISTE CONSTsuchliste,TERM VARsuchterm,TERM CONSTvergleichsterm):IFlaenge(suchliste)>0THENsuchterm:=listenanfang(suchliste);WHILE(suchterm<>nil)CAND NOTgefundenREPsuchterm:=nachfolger(suchterm)END REP;END IF.gefunden:vergleichsterm=LISTENANFANG TERME DEFINITIONsuchterm.END PROCdurchforste;PROCtesteexistenz(ABBILDUNG CONSTf):IFadresse(f)=nilTHENerrorstop(anwendungstext(48))END IF END PROCtesteexistenz;LISTE PROCkopiedervariablenliste(LISTE CONSToriginal):LISTE VARkopie:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(original);WHILElaufterm<>nilREPanhaengen(kopie,newvariable(PLATZlaufterm,NAMElaufterm));laufterm:=nachfolger(laufterm)END REP;kopieEND PROCkopiedervariablenliste;ABBILDUNG PROCauswertung(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermIStemporaerefunktionTHENabbildung(DEFINITIONterm)ELIFtermISabbildungsdyadeTHENausgewerteteabbildungsdyadeELIFtermISabbildungsmonadeTHENausgewerteterabbildungsmonadeELSEausgewerteteableitungsoperationEND IF.ausgewerteteabbildungsdyade:IF OPERATIONterm=plussymbolTHENauswertung(LINKSterm)+auswertung(RECHTSterm)ELIF OPERATIONterm=minussymbolTHENauswertung(LINKSterm)-auswertung(RECHTSterm)ELIF OPERATIONterm=multiplikationssymbolTHENauswertung(LINKSterm)*auswertung(RECHTSterm)ELIF OPERATIONterm=divisionssymbolTHENauswertung(LINKSterm)/auswertung(RECHTSterm)ELSEauswertung(LINKSterm)Oauswertung(RECHTSterm)END IF.ausgewerteterabbildungsmonade:IF OPERATIONterm=minussymbolTHEN-auswertung(OPERANDterm)ELSEauswertung(OPERANDterm)END IF.ausgewerteteableitungsoperation:ABBILDUNG VARloeschelement:=auswertung(ABBILDUNGSAUSDRUCKterm),neuefunktion:=ableitung(loeschelement,KOMPONENTEterm,INDEXterm);loeschetemporaereabbildung(loeschelement);neuefunktionEND PROCauswertung;TERM PROCkopie(TERM CONSTterm,LISTE CONSTvariablenliste):IFtermISvariableTHENauswahl(variablenliste,PLATZterm)ELIFtermIStermlisteTHENtermlistenkopie(term,variablenliste)ELIFtermISdyadischTHENnewdyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELIFtermISmonadischTHENnewmonade(kopie(OPERANDterm,variablenliste),OPERATIONterm)ELIFtermISfunktionsauswertungTHENnewfunktionsauswertung(abbildungskopie(ABBILDUNGSAUSDRUCKterm),kopie(ARGUMENTEterm,variablenliste),KOMPONENTEterm)ELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(kopie(BEDINGUNGterm,variablenliste),kopie(AKTIONterm,variablenliste),kopie(ALTERNATIVEterm,variablenliste))ELIFtermISlogischedyadeTHENnewlogischedyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),
+OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELSEtermEND IF END PROCkopie;TERM PROCabbildungskopie(TERM CONSTterm):IFtermISabbildungsdyadeTHENnewabbildungsdyade(abbildungskopie(LINKSterm),abbildungskopie(RECHTSterm),OPERATIONterm)ELIFtermISabbildungsmonadeTHENnewabbildungsmonade(abbildungskopie(OPERANDterm),OPERATIONterm)ELIFtermISableitungsoperationTHENnewableitungsoperation(abbildungskopie(ABBILDUNGSAUSDRUCKterm),INDEXterm,KOMPONENTEterm,OPERATIONterm)ELSEtermEND IF END PROCabbildungskopie;TERM PROCtermlistenkopie(TERM CONSTterm,LISTE CONSTvariablenliste):LISTE VARausdruecke:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANGterm;WHILElaufterm<>nilREPanhaengen(ausdruecke,newterm(kopie(AUSDRUCKlaufterm,variablenliste)));laufterm:=nachfolger(laufterm)END REP;newtermliste(listenanfang(ausdruecke),listenende(ausdruecke),laenge(ausdruecke))END PROCtermlistenkopie;TERM PROCausgewaehlterfunktionsterm(TERM CONSTterm):IF NOT(termISfunktionsauswertung)THENerrorstop(anwendungstext(1))END IF;AUSDRUCK((TERME DEFINITION ABBILDUNGSAUSDRUCKterm)ELEMENT(KOMPONENTEterm))END PROCausgewaehlterfunktionsterm;BOOL PROCidentischevordefiniertekonstanten(TERM CONSTl,r):vordefiniertekonstante(l)CANDvordefiniertekonstante(r)CAND NAMEl=NAMErEND PROCidentischevordefiniertekonstanten;BOOL PROCidentischevariablen(TERM CONSTl,r):(lISvariable)CAND(rISvariable)CAND(PLATZl=PLATZr)END PROCidentischevariablen;BOOL PROCvordefiniertekonstante(TERM CONSTpruefterm):(prueftermISkonstante)CAND((NAMEpruefterm=esymbol)COR(NAMEpruefterm=pisymbol))END PROCvordefiniertekonstante;BOOL PROCselektionshaltigetermliste(TERM CONSTt):IF NOT(tISausdruck)THENerrorstop(anwendungstext(203))END IF;TERM VARlauf:=t;WHILElauf<>nilREP IF(AUSDRUCKlauf)ISselektionTHEN LEAVEselektionshaltigetermlisteWITH TRUE END IF;lauf:=nachfolger(lauf)END REP;FALSE END PROCselektionshaltigetermliste;BOOL OP IST(TERM CONSTpruefterm,REAL CONSTpruefwert):(prueftermISkonstante)CAND(WERTpruefterm=pruefwert)END OP IST;TERM PROCerstesargument(TERM CONSTterm):AUSDRUCK LISTENANFANG ARGUMENTEtermEND PROCerstesargument;END PACKETabbildung
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ausgabe b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe
new file mode 100644
index 0000000..41f9677
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe
@@ -0,0 +1,2 @@
+PACKETausgabeDEFINES:=,plot,endgeraetbreite:LETtypnummer=1055;REAL VARdruckerfaktor:=1.0,horcm,vertcm,width,height;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);width:=horcm;height:=vertcm;REAL VARbuchsthoehe:=stdhoehe,minyabstand:=0.1;REAL VARhoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,oben:=vertcm-hoehe,unten:=hoehe,rahmenoben:=vertcm,rahmenunten:=0.0;TYPE PICROW=BOUND STRUCT(INTeofROW128PICTUREzeichnungROW4REALfenstergroesseREALquellbreite,quellhoehe);OP:=(PICROW VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCplot(THESAURUS CONSTth):do(PROC(TEXT CONST)plot,th)END PROCplot;PROCplot(TEXT CONSTdsname):enablestop;IFexists(dsname)THEN PICROW VARobjekt:=old(dsname);IFtype(old(dsname))<>typnummerTHEN LEAVEplotEND IF ELSE LEAVEplotEND IF;beginplot;setzeabmessungenbezueglichendgeraet;clear;viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(objekt.fenstergroesse(1),objekt.fenstergroesse(2),objekt.fenstergroesse(3),objekt.fenstergroesse(4));pen(0,1,0,1);plottedarstellung;plotend.setzeabmessungenbezueglichendgeraet:IFwidth>horcmTHENwidth:=horcmEND IF;height:=width/objekt.quellbreite*objekt.quellhoehe;IFheight>vertcmTHENheight:=vertcm;width:=height/objekt.quellhoehe*objekt.quellbreiteEND IF;hoehe:=0.0;rechts:=objekt.quellbreite;oben:=objekt.quellhoehe;unten:=hoehe;rahmenoben:=objekt.quellhoehe;rahmenunten:=0.0;druckerfaktor:=width/objekt.quellbreite;cmfaktor(druckerfaktor).plottedarstellung:INT VARi;pen(1,1,1,1);box;FORiFROM1UPTOobjekt.eofREP IFlength(objekt.zeichnung(i))<>0THENpen(1,1,1,pen(objekt.zeichnung(i)));plot(objekt.zeichnung(i))END IF END REP END PROCplot;PROCendgeraetbreite(REAL CONSTbreite):width:=min(breite,horcm)END PROCendgeraetbreite;REAL PROCendgeraetbreite:widthEND PROCendgeraetbreite;END PACKETausgabe;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.basis plot b/app/schulis-mathematiksystem/1.0/src/mat.basis plot
new file mode 100644
index 0000000..3581885
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.basis plot
@@ -0,0 +1,2 @@
+PACKETbasisplotDEFINESviewport,window,windowxmin,windowxmax,windowymin,windowymax,move,draw,where,box,xpixel,ypixel:INT VARxpixelanzahl,ypixelanzahl;REAL VARxpixelprocm,ypixelprocm,xcmgroesse,ycmgroesse,xpos,ypos,viewxmin:=0.0,viewxmax:=1.0,viewymin:=0.0,viewymax:=1.0,winxmin:=0.0,winxmax:=1.0,winymin:=0.0,winymax:=1.0,xkonst,ykonst,xfaktor,yfaktor;initialisierewerte;PROCinitialisierewerte:drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);xpixelprocm:=real(xpixelanzahl)/xcmgroesse;ypixelprocm:=real(ypixelanzahl)/ycmgroesse;viewport(0.0,xcmgroesse,0.0,ycmgroesse);window(0.0,xcmgroesse,0.0,ycmgroesse);homeEND PROCinitialisierewerte;PROCviewport(REAL CONSTxmin,xmax,ymin,ymax):IFxmin<0.0CORxmax>xcmgroesseCORymin<0.0CORymax>ycmgroesseCORxmin=xmaxCORymin=ymaxCORaltewerteTHEN LEAVEviewportEND IF;viewxmin:=xmin;viewxmax:=xmax;viewymin:=ymin;viewymax:=ymax;setvalues.altewerte:viewxmin=xminCANDviewxmax=xmaxCANDviewymin=yminCANDviewymax=ymaxEND PROCviewport;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax):IFxmin>=xmaxCORymin>=ymaxCORaltewerteTHEN LEAVEwindowEND IF;winxmin:=xmin;winxmax:=xmax;winymin:=ymin;winymax:=ymax;setvalues.altewerte:winxmin=xminCANDwinxmax=xmaxCANDwinymin=yminCANDwinymax=ymaxEND PROCwindow;REAL PROCwindowxmin:winxminEND PROCwindowxmin;REAL PROCwindowxmax:winxmaxEND PROCwindowxmax;REAL PROCwindowymin:winyminEND PROCwindowymin;REAL PROCwindowymax:winymaxEND PROCwindowymax;PROCsetvalues:xkonst:=0.5+viewxmin*xpixelprocm;ykonst:=0.5+viewymin*ypixelprocm;xfaktor:=xpixelprocm*(viewxmax-viewxmin)/(winxmax-winxmin);yfaktor:=ypixelprocm*(viewymax-viewymin)/(winymax-winymin)END PROCsetvalues;PROCmove(REAL CONSTx,y):INT VARi,j;IFx>winxmaxCORx<winxminCORy>winymaxCORy<winyminTHEN LEAVEmoveEND IF;xpos:=x;ypos:=y;transform(x,y,i,j);move(i,j)END PROCmove;PROCdraw(REAL CONSTx,y):INT VARi,j;IFx>winxmaxCORx<winxminCORy>winymaxCORy<winyminTHEN LEAVEdrawEND IF;transform(x,y,i,j);xpos:=x;ypos:=y;draw(i,j)END PROCdraw;PROCtransform(REAL CONSTx,y,INT VARi,j):i:=xpixel(x);j:=ypixel(y)END PROCtransform;INT PROCxpixel(REAL CONSTx):int(xkonst+(x-winxmin)*xfaktor)END PROCxpixel;INT PROCypixel(REAL CONSTy):int(ykonst+(y-winymin)*yfaktor)END PROCypixel;PROCbox:move(winxmin,winymax);draw(winxmax,winymax);draw(winxmax,winymin);draw(winxmin,winymin);draw(winxmin,winymax)END PROCbox;PROCwhere(REAL VARx,y):x:=xpos;y:=yposEND PROCwhere;PROChome:xpos:=winxmin;ypos:=winyminEND PROChome;END PACKETbasisplot
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.binder plot b/app/schulis-mathematiksystem/1.0/src/mat.binder plot
new file mode 100644
index 0000000..8a8d227
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.binder plot
@@ -0,0 +1,4 @@
+PACKETbinderplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz,plotterkanal:LEThorpixelmaxdurch16=85,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",unterstreichenaus="Y",fettdruckaus="""",zeilenabstand="T15",druckrichtung=">",druckart="I",schrifttyp="H",formfeed="�",linefeed="
+",cr="
";INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord,anzahldernadelspalten,i,printerchannel:=15;REAL VARhorfaktor,vertfaktor,faktor;horpixel:=1360;verpixel:=900;anzahldernadelspalten:=900;horfaktor:=50.3937;vertfaktor:=47.24409;REAL VARbuchstabenhoehe:=0.762,buchstabenbreite:=0.3373438;BOUND ROWhorpixelmaxdurch16TEXT VARbitmap;INT VARplotterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=26.9875;ycm:=19.05;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1).ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT VARspaltenzaehler;bitmap:=old(namederbitmap);druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+unterstreichenaus);out(esc+fettdruckaus);out(esc+zeilenabstand);out(esc+druckrichtung);out(esc+schrifttyp).seitenvorschub:out(formfeed).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask,plotterchannel).bitmapdrucken:FORspaltenzaehlerFROM(groesstexkoordDIV16)+1DOWNTO1REPbefehlssequenzschickenPER.zeilenbeginn:groessteykoord+1.befehlssequenzschicken:out(esc+druckart+neueanzahldernadelspalten);teilzeileausgeben;out(cr+linefeed).neueanzahldernadelspalten:nullen+text(zeilenbeginn).nullen:(4-LENGTHtext(zeilenbeginn))*"0".teilzeileausgeben:outsubtext(bitmap(spaltenzaehler),vontextpos,bistextpos).vontextpos:2*(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:2*anzahldernadelspaltenEND PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet)END PROCplotend;PROCclear:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);xpos:=0;ypos:=0;pen(0,1,0,1);INT VARj;TEXT VARleerespalte:=(2*verpixel)*"�";FORjFROM1UPTOhorpixelmaxdurch16REPbitmap(j):=leerespaltePER;groesstexkoord:=0;groessteykoord:=0END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSE
+macheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz '"+name+"' existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1ELSEausgewaehlt:=3FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2ELSEausgewaehlt:=3FI;faktor:=matrixfaktor(ausgewaehlt).beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorEND IF PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);setbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCplot;PROCunplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);resetbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETbinderplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.cga plot b/app/schulis-mathematiksystem/1.0/src/mat.cga plot
new file mode 100644
index 0000000..94b7ae7
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.cga plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldout,oldcursor,oldgetcursor:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETcgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,out,cursor,getcursor,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=14.59854,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,anzahlx=640,anzahly=200,maximumx=639,maximumy=199,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.525167,buchstabenbreite:=0.275;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IF(textcopySUB1)>code(31)THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die CGA-Karte (oder eine kompatible");putline("Karte, z.B. EGA-Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"cga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE;ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE;ENDPROCplotend;PROCclear:control(-5,6,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,anzahly-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THEN
+oldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,anzahly-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,anzahly-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>maximumxTHENx:=maximumxELIFx<0THENx:=0END IF;IFy>maximumyTHENy:=maximumyELIFy<0THENy:=0END IF END PROCgrenzkontrolle;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:8END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETcgaplot;zeichensatz("ZEICHEN 8*8")
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen
new file mode 100644
index 0000000..d76be56
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen
@@ -0,0 +1,5 @@
+PACKETdialoghilfenDEFINESscratchfunctionname,scroll,belegeparameter,schreibestatuszeile,schreibearbeitsfunktion,gibmeldung,gibinfofensteraus,warte,strich,definieredruckseitenformat,druckseitenformat,druckspalten,aufbereitetdrucken,druckversuch:LETniltext="",bell="�",carrreturn="
",beginmark="",endmark="",left="�",right="�",runter="
+",hoch="�",hop="�",esc="�",blank=" ",unterstrichzeichen="_",systemname=" s c h u l i s - Mathematiksystem",niveau="Ebene ",seitenvorschub="#page#",stddruckbreite=45,stddrucklaenge=60;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,basiszeile:=beginmark+systemname+44*blank+endmark;TEXT PROCscratchfunctionname:TEXT VARfunctionname:="hilfsfunktion";INT VARi:=1;WHILElistenposition(eigenefunktionen,functionname+text(i))<>nilREPiINCR1END REP;functionname+text(i)END PROCscratchfunctionname;PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARf:=sequentialfile(input,datname);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:INT VARsucher:=xscroll;WHILEsucher<maxspaltenREPsucherINCRhorizontalscrollEND REP;sucher-horizontalscroll.zeigedateiausschnitt:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginn;FORiFROM1UPTOyscroll-1REPtoline(f,i);readrecord(f,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginn+yscroll-1END IF;i:=erstersatz;REPtoline(f,i);readrecord(f,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginn>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENscrollerechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENscrollevorEND IF ELIFch=hopTHENinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENblaettererechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENblaetterevorEND IF ELSEout(bell)END IF ELIFch=escTHENinchar(ausstiegzeichen);IFausstiegzeichen="1"CANDerstersatz>yscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz<letzterzeilenanfangTHENspringeandasendeELIFpos(sonderzeichen,ausstiegzeichen)<>0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVE
+werteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min(erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCbelegeparameter(VECTOR VARv,INT CONSTvarindex,LISTE CONSTvariablenliste,TEXT CONSTescapeausstieg,TEXT VARausstieg):TEXT VAReingabetext,ausstiegszeichen;INT CONSTende:=laenge(variablenliste),eingabelaenge:=40,scrollbeginn:=12;TEXT CONSTseparatoren:=hoch+runter;INT VARxpos,ypos,aktuellerparameterindex:=naechsterparameter(ende,varindex,0);getcursor(xpos,ypos);REPzeigeaktuellenparameter;editieredenaktuellenparameter;werteausstiegscodeausEND REP.zeigeaktuellenparameter:TEXT VARvariablenname:=text(NAMEauswahl(variablenliste,aktuellerparameterindex),8);variablennameCAT" = ";cursor(xpos,ypos);out(variablenname).editieredenaktuellenparameter:eingabetext:=compress(wandle(vSUBaktuellerparameterindex));eingabetextCATkurzerstrich;IFsystemimgraphicmodusTHENgrapheditget(eingabetext,scrollbeginn,escapeausstieg,ausstiegszeichen)ELSEout(beginmark);out(left);editget(eingabetext,eingabelaenge,scrollbeginn,separatoren,escapeausstieg,ausstiegszeichen);out(endmark)END IF.werteausstiegscodeaus:IFausstiegszeichen=niltextCORpos(hoch+runter+carrreturn,ausstiegszeichen)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);REAL VAReingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert);IFausstiegszeichen<>hochTHENaktuellerparameterindex:=naechsterparameter(ende,varindex,aktuellerparameterindex)ELSEaktuellerparameterindex:=letzterparameter(ende,varindex,aktuellerparameterindex)END IF ELSEclearerrorEND IF ELSE IFsystemimgraphicmodusTHENausstieg:=ausstiegszeichenELSEausstieg:=ausstiegszeichenSUB2END IF;IFpos(escapeausstieg,ausstieg)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);eingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert)ELSEclearerrorEND IF;LEAVEbelegeparameterEND IF END IF END PROCbelegeparameter;INT PROCnaechsterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=aktuellerwertMODende+1;IFnaechsterwert=verbotenTHENnaechsterparameter(ende,verboten,aktuellerwert+1)ELSEnaechsterwertEND IF END PROCnaechsterparameter;INT PROCletzterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=(aktuellerwert-2)MODende+1;IFnaechsterwert=verbotenTHENletzterparameter(ende,verboten,aktuellerwert-1)ELSEnaechsterwertEND IF END PROCletzterparameter;PROCschreibestatuszeile(TEXT CONSTverfahrensname):TEXT VARzeile:=basiszeile,teilbereich:=niveau+text(ebene)+"   "+verfahrensname;replace(zeile,78-length(teilbereich),teilbereich);cursor(1,1);out(zeile)END PROCschreibestatuszeile;PROCschreibearbeitsfunktion(ABBILDUNG CONSTfkt):cursor(1,2);out(text(funktionsstring(fkt),80))END PROCschreibearbeitsfunktion;PROCstrich(INT CONSTzeile):cursor(1,zeile);out(79*waagerecht)END PROCstrich;PROCwarte:clearbuffer;footnote(anwendungstext(77));pauseEND PROCwarte;PROCgibmeldung(TEXT CONSTmeldung):WINDOW VARstdmeldungsfenster:=window(2,22,77,1);outframe(stdmeldungsfenster);out(stdmeldungsfenster,text(meldung,77));warte;page(stdmeldungsfenster,TRUE)END PROCgibmeldung;PROCgibinfofensteraus(WINDOW VARw,INT CONSTn):outframe(w);show(formular(n));warte;page(w,TRUE)END PROCgibinfofensteraus;ROW2INT VARdruckbreite:=ROW2INT:(stddruckbreite,stddruckbreite),drucklaenge:=ROW2INT:(stddrucklaenge,stddrucklaenge);PROCdefinieredruckseitenformat(INT CONST
+breite,laenge):druckbreite(ebene):=breite;drucklaenge(ebene):=laengeEND PROCdefinieredruckseitenformat;INT PROCdruckspalten:druckbreite(ebene)END PROCdruckspalten;PROCdruckseitenformat(INT VARspalten,zeilen):spalten:=druckbreite(ebene);zeilen:=drucklaenge(ebene)END PROCdruckseitenformat;PROCaufbereitetdrucken(TEXT CONSTfname,ueberschrift,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=scratchdateiname;TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;druckversuch(neuername);forget(neuername,quiet).testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge(ebene)-zeilenbeginn+1;IFueberschrift<>niltextTHENverfuegbarerplatzDECR2END IF;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite(ebene)-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointer<dateibreiteREPschreibeseiten;spaltenpointerINCRzulaessigebreiteEND REP.schreibeseiten:zeilenpointer:=zeilenbeginn;REPschreibekopfzeilen;schreiberumpfzeilenEND REP.schreibekopfzeilen:putline(fdruck,seitenvorschub);IFueberschrift<>niltextTHENputline(fdruck,ueberschrift);line(fdruck)END IF;FORjFROM1UPTOzeilenbeginn-1REPdruckzeile:=niltext;toline(f,j);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile)END REP.schreiberumpfzeilen:FORiFROM1UPTOverfuegbarerplatzREPdruckzeile:=niltext;toline(f,zeilenpointer);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile);zeilenpointerINCR1;IFzeilenpointer>dateilaengeTHEN LEAVEschreibeseitenEND IF END REP END PROCaufbereitetdrucken;PROCdruckversuch(TEXT CONSTdatname):disablestop;print(datname);IFiserrorTHENgibmeldung(errormessage);clearerror;ELSEgibmeldung(anwendungstext(219))END IF END PROCdruckversuch;END PACKETdialoghilfen;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.druckermenu b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu
new file mode 100644
index 0000000..45b036d
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu
@@ -0,0 +1,2 @@
+PACKETdruckermenuDEFINESdruckeingang,druckezeichnungen,loeschezeichnungen,stellezeichenbreiteein,definieredruckerkanal,stoppedrucker,plottereingestellt:LETdepottaskname="MATHE-PRINTERDEPOT",druckprocindex=1,loeschprocindex=2,untenlinks=3,zentral=5,bell="�",abbruch="!",niltext="",arbeitertaskname="workertask",minimalekanalnr=2,maximalekanalnr=32,text1="Bitte warten bis der letzte Druckauftrag bearbeitet ist.",text2="Drucken von Zeichnungen",text3="Auswahl der Zeichnungen durch ankreuzen",text4="Löschen von Zeichnungen",text5="Sollen die ausgewählten Zeichnungen gelöscht werden",text6="Die Zeichnungen werden gelöscht: ",text7=" Wert zwischen 5.0 cm und ",text8=" cm eingeben! ",text9=" Bitte Zahl zwischen 2 und 32 für Kanalnummer des Druckers eingeben! ",text10="Speicher für Zeichnungen ist nicht eingerichtet.",text11="Ist für die nächste Zeichnung Papier eingelegt",text12="Auswahl einer Zeichnung durch ankreuzen";TEXT VARzeichnungsname;TASK VARarbeitertask,depottask;BOOL VARplotteraktiv:=TRUE;THESAURUS VARauswahl;PROCdruckeingang:IF NOTexiststask(depottaskname)THENerrorstop(text10)END IF;depottask:=/depottaskname;IFhighestentry(ALLdepottask)=0THENdeactivate(druckprocindex);deactivate(loeschprocindex)ELSEactivate(druckprocindex);activate(loeschprocindex)END IF END PROCdruckeingang;PROCdruckezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEdruckezeichnungenEND IF;IF NOTplottereingestelltTHENauswahl:=menusome(ALLdepottask,text2,text3,TRUE);IFnotempty(auswahl)THENbegin(arbeitertaskname,PROCzeichnungendrucken,arbeitertask)END IF ELSEzeichnungsname:=menuone(ALLdepottask,text2,text12,TRUE);IFzeichnungsname<>niltextCANDmenuyes(text11,zentral)THENbegin(arbeitertaskname,PROCdruckeeinezeichnung,arbeitertask)END IF END IF END PROCdruckezeichnungen;PROCzeichnungendrucken:disablestop;fetch(auswahl,depottask);plot(auswahl);end(myself)END PROCzeichnungendrucken;PROCdruckeeinezeichnung:disablestop;fetch(zeichnungsname,depottask);plot(zeichnungsname);end(myself)END PROCdruckeeinezeichnung;PROCloeschezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEloeschezeichnungenEND IF;auswahl:=menusome(ALLdepottask,text4,text3,TRUE);IF NOTnotempty(auswahl)THEN LEAVEloeschezeichnungenEND IF;IFmenuyes(text5,zentral)THENcommanddialogue(FALSE);footnote(text6);cursor(36,24);erase(auswahl,depottask);commanddialogue(TRUE);oldfootnote;druckeingangEND IF END PROCloeschezeichnungen;PROCstellezeichenbreiteein:LETminimum=5.0;REAL VARmaximum,maxlaenge,breite;INT VARxpixel,ypixel;TEXT VAReingabe;drawingarea(maximum,maxlaenge,xpixel,ypixel);maximum:=floor(maximum);IFendgeraetbreite>maximumTHENendgeraetbreite(maximum)END IF;REPeingabe:=menuanswer(text7+text(maximum)+text8,text(endgeraetbreite),zentral);IFcompress(eingabe)=niltextTHEN LEAVEstellezeichenbreiteeinEND IF;breite:=real(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHENendgeraetbreite(breite);LEAVEstellezeichenbreiteeinEND IF;out(bell)END REP END PROCstellezeichenbreiteein;PROCdefinieredruckerkanal:TEXT VAReingabe;INT VARnr;REPeingabe:=menuanswer(text9,text(plotterkanal),zentral);IFcompress(eingabe)=niltextTHEN LEAVEdefinieredruckerkanalEND IF;nr:=int(eingabe);IFlastconversionokCANDnr>=minimalekanalnrCANDnr<=maximalekanalnrTHENplotterkanal(nr);LEAVEdefinieredruckerkanalEND IF;out(bell)END REP END PROCdefinieredruckerkanal;PROCstoppedrucker:IFexiststask(arbeitertaskname)THENend(/arbeitertaskname)END IF END PROCstoppedrucker;PROCplottereingestellt(BOOL CONSTwert):plotteraktiv:=wertEND PROCplottereingestellt;BOOL PROCplottereingestellt:plotteraktivEND PROCplottereingestellt;END PACKETdruckermenu;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ega plot b/app/schulis-mathematiksystem/1.0/src/mat.ega plot
new file mode 100644
index 0000000..5fc377b
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.ega plot
@@ -0,0 +1,4 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,ykonst=349,xkonst=639,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"ega"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xkonst;y:=ykonstEND PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:13CASEkurzgestrichelt:12CASElanggestrichelt:11CASEstrichpunkt:10OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y)END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold.setcharacterheightandwidth:IFwidth=0.0CANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+yPER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ykonst-ywert,
+dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y,anfang:=ykonst-pos.y,ziel;grenzkontrolle(xwert,ywert);ziel:=ykonst-ywert;IFgeradelinienTHENcontrol(-6,pos.x,anfang,dummy);control(-6,xwert,ziel,dummy)ELSEcontrol(-6,xwert,ziel,dummy);control(-6,pos.x,anfang,dummy);control(-7,xwert,ziel,dummy)END IF.geradelinien:xwert=pos.xCORywert=pos.yEND OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xkonstTHENx:=xkonstELIFx<0THENx:=0END IF;IFy>ykonstTHENy:=ykonstELIFy<0THENy:=0FI END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=14;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(14,2,3,4,9,8,7,6,5,13,12,11,10,1);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:12END PROCsekantenstift;INT PROCnormalenstift:12END PROCnormalenstift;INT PROCtangentenstift:12END PROCtangentenstift;INT PROClotstift:10END PROClotstift;INT PROCpunktstift:12END PROCpunktstift;END PACKETegaplot;zeichensatz("ZEICHEN 8*14")
+
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot
new file mode 100644
index 0000000..508b9b2
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot
@@ -0,0 +1,4 @@
+PACKETepsonfxplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",modus="L",schrifttyp="P",formfeed="�",zeilenvorschub="J�",minivorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=2328;verpixel:=905;horfaktor:=85.03937;vertfaktor:=47.24409;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);LET GRUPPE=STRUCT(ROW3TEXTspalte);BOUND ROWhorpixelmaxdurch24GRUPPE VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7662334,buchstabenbreite:=0.3421944;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code(zeilenbeginnMOD256)+code(zeilenbeginnDIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REP FORjFROM3DOWNTO1REPdruckeeinespalteeinergruppe;PER;vorschubPER.druckeeinespalteeinergruppe:out(esc+modus+neueanzahldernadelspalten);teilzeileausgeben;out(esc+minivorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i).spalte(j),vontextpos,bistextpos).vontextpos:(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:anzahldernadelspalten.vorschub:out(esc+zeilenvorschub+cr).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=verpixel*"�";FORiFROM1UPTOhorpixeldurch24REP FORjFROM1UPTO3REPbitmap(i).spalte(j):=leerPER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=
+totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxmod24:=xMOD24,xdiv24:=xDIV24;replace(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,setzebitintext(byte,xmod24DIV3,wert)).byte:subtext(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,verpixel-y).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code(subtext(byte,1,1));IFwertTHENsetbit(
+intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonfxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16")
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot b/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot
new file mode 100644
index 0000000..704f3f7
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot
@@ -0,0 +1,4 @@
+PACKETepsonsqplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",abstand=100,esc="�",modus="*'",schrifttyp="P",unidirektional="U�",formfeed="�",zeilenvorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=1968;verpixel:=1346;horfaktor:=70.86614;vertfaktor:=70.86614;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);BOUND ROWhorpixelmaxdurch24TEXT VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7597422,buchstabenbreite:=0.3471333;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;INT CONSTvontextpos:=3*(anzahldernadelspalten-zeilenbeginn)+1,bistextpos:=3*anzahldernadelspalten;TEXT CONSTrand:=(3*abstand)*"�";bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp);out(esc+unidirektional).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code((abstand+zeilenbeginn)MOD256)+code((abstand+zeilenbeginn)DIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REPdruckeeinespalte;PER.druckeeinespalte:out(esc+modus+neueanzahldernadelspalten);out(rand);teilzeileausgeben;out(esc+zeilenvorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i),vontextpos,bistextpos).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=3*verpixel*"�";FORiFROM1UPTOhorpixeldurch24REPbitmap(i):=leerPER END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0
+UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxdiv24:=xDIV24,xdiv8:=xDIV8;replace(bitmap(1+xdiv24),posnrder3ergruppe+bytenrinnerhalbdernadelspalte,setzebitintext(byte,xMOD8,wert)).posnrder3ergruppe:(verpixel-y-1)*3+1.bytenrinnerhalbdernadelspalte:2-(xMOD24)DIV8.byte:bitmap(1+xdiv24)SUB(posnrder3ergruppe+bytenrinnerhalbdernadelspalte).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code(
+subtext(byte,1,1));IFwertTHENsetbit(intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonsqplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16")
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager b/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager
new file mode 100644
index 0000000..0b722df
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager
@@ -0,0 +1,4 @@
+PACKETformeleditormanagerDEFINESformelmanager:LETniltext="",funktionsauswertungssymbol="A",unsichtbareklammerauf="(:",unsichtbareklammerzu=":)",klammeraufsymbol="(",klammerzusymbol=")",differenziersymbol="D",diffklammeraufsymbol="D:",diffklammerzusymbol=":D",selektionsklammeraufsymbol="{{",selektionsklammerzusymbol="}}",ifsymbol="<",endifsymbol=">",elifsymbol=";",thensymbol=":",selektionsthensymbol="::",selektionselifsymbol=";;",formeleditorundsymbol="&",undsymbol="UND",formeleditorodersymbol="$",odersymbol="ODER",formelindateischreiben=1,zeichensatzumstellen=2,formeleditieren=3,allesok=5,fehler=6,offset=258,erlaubtezeichen="?ilmw",tempdatname="temporaerer datenraum",anzahlzeilen=67,erstefensterzeile=6,fensterzeilen=12,erstefensterspalte=2,verlasszeichen="19wm",auf="�",bell="�",ab="
+",hop="�",esc="�";TEXT VARaktuellearbeitsfkt:=niltext;PROCformelmanager:DATASPACE VARds;TASK VARsourcetask;INT VARnachricht;disablestop;grundeinstellungen;REPwait(ds,nachricht,sourcetask);SELECTnachrichtOF CASEformelindateischreiben:schreibeformelindateiCASEzeichensatzumstellen:stellezeichensatzumCASEformeleditieren:continue(1);cursorgrundeinstellungen;editieredieformel;break(quiet)END SELECT;send(sourcetask,nachricht,ds);forget(ds);forget(tempdatname,quiet)END REP.schreibeformelindatei:BOUND TEXT VARformelstring:=ds;arithnotation(formelstring);IFiserrorTHENclearerror;nachricht:=fehler;LEAVEschreibeformelindateiEND IF;forget(tempdatname,quiet);FILE VARf:=sequentialfile(output,tempdatname);writeformula(f);IFiserrorTHENclearerror;forget(tempdatname,quiet);nachricht:=fehler;LEAVEschreibeformelindateiEND IF;line(f);forget(ds);ds:=old(tempdatname);forget(tempdatname,quiet);nachricht:=allesok.stellezeichensatzum:BOUND TEXT VARanzukoppelnderzeichensatz:=ds;loadops(anzukoppelnderzeichensatz);arithnotation(niltext);nachricht:=allesok.editieredieformel:BOUND TEXT VARzueditierendeformel:=ds;IFzueditierendeformel<>niltextTHENarithnotation(aktuellearbeitsfkt);ELSEaktuellearbeitsfkt:=niltext;arithnotation(niltext)END IF;footnote(anwendungstext(326));REP REP IFiserrorTHENclearerror;out(bell);loescheformelfenster;aktuellearbeitsfkt:=niltextEND IF;editformulaUNTIL NOTiserrorEND REP;TEXT VARausstieg:=formeditexitkeySUB2;SELECTpos(erlaubtezeichen,ausstieg)OF CASE1:gibinformationenzumformeleditorCASE2:schaltemarkierungumCASE3:loescheformelfensterCASE4:arithnotation(niltext);verlasseformeleditorCASE5:verlasseformeleditorEND SELECT END REP.gibinformationenzumformeleditor:footnote(anwendungstext(327));formeleditorinfo(ausstieg);IFausstieg="m"THENarithnotation(niltext);verlasseformeleditorEND IF;footnote(anwendungstext(326)).schaltemarkierungum:defformeditmark(NOTformeditmark).loescheformelfenster:cursorgrundeinstellungen;arithnotation(niltext).verlasseformeleditor:forget(tempdatname,quiet);aktuellearbeitsfkt:=arithnotation;BOUND TEXT VARfstring:=new(tempdatname);fstring:=parserformat(aktuellearbeitsfkt);forget(ds);ds:=old(tempdatname);forget(tempdatname,quiet);nachricht:=allesok;LEAVEeditieredieformelEND PROCformelmanager;PROCgrundeinstellungen:resetformulaeditor;defformeditwindow(2,6,78,18);defformeditexitkeys(niltext,niltext,erlaubtezeichen);defformeditmark("    ","    ");defformeditmark(TRUE);defformeditbeep(FALSE);defformeditlearn(FALSE);defformeditbuffer(0,0,78);defformeditarith(0,0,78);defformediterror(1,21,78);defformeditrubin(2,20);defformeditlearn(0,0);defformeditkeys(0,0);aktuellearbeitsfkt:=niltext;arithnotation(niltext)END PROCgrundeinstellungen;PROCcursorgrundeinstellungen:defformeditoffset(1,5);defformeditcursor(3,5)END PROCcursorgrundeinstellungen;TEXT PROCparserformat(TEXT CONSTstring):TEXT VARstr:=string;IFpos(str,differenziersymbol)<>0THENsonderbehandlungableitungenEND IF;defaultbehandlung;IFpos(str,selektionsklammeraufsymbol)<>0THENsonderbehandlungselektionEND IF;str.sonderbehandlungableitungen:changeall(str,diffklammeraufsymbol,niltext);changeall(str,diffklammerzusymbol,niltext);changeall(str,"(: D ",differenziersymbol);changeall(str,
+":) / D","/ D").defaultbehandlung:changeall(str,funktionsauswertungssymbol,niltext);changeall(str,unsichtbareklammerauf,klammeraufsymbol);changeall(str,unsichtbareklammerzu,klammerzusymbol).sonderbehandlungselektion:changeall(str,selektionsklammeraufsymbol,ifsymbol);changeall(str,selektionsklammerzusymbol,endifsymbol);changeall(str,selektionsthensymbol,thensymbol);changeall(str,selektionselifsymbol,elifsymbol);changeall(str,formeleditorundsymbol,undsymbol);changeall(str,formeleditorodersymbol,odersymbol)END PROCparserformat;PROCformeleditorinfo(TEXT VARausstieg):INT VARersteausgabezeile:=1,maximum:=anzahlzeilen-fensterzeilen;BOOL VARneuausgeben:=TRUE;REP IFneuausgebenTHENgibteiltextausEND IF;werteeingabezeichenausEND REP.gibteiltextaus:INT VARi,zeile:=erstefensterzeile,letzteausgabezeile:=ersteausgabezeile+fensterzeilen;FORiFROMersteausgabezeileUPTOletzteausgabezeileREPcursor(erstefensterspalte,zeile);out(text(anwendungstext(i+offset),77));zeileINCR1END REP.werteeingabezeichenaus:TEXT VARch;inchar(ch);IFch=aufCANDersteausgabezeile>1THENersteausgabezeileDECR1;neuausgeben:=TRUE ELIFch=abCANDersteausgabezeile<maximumTHENersteausgabezeileINCR1;neuausgeben:=TRUE ELIFch=hopTHENinchar(ch);IFch=aufCANDersteausgabezeile<>1THENersteausgabezeileDECRfensterzeilen;ersteausgabezeile:=max(ersteausgabezeile,1);neuausgeben:=TRUE ELIFch=abTHENersteausgabezeileINCRfensterzeilen;ersteausgabezeile:=min(ersteausgabezeile,maximum);neuausgeben:=TRUE ELSEneuausgeben:=FALSE END IF ELIFch=escTHENinchar(ch);SELECTpos(verlasszeichen,ch)OF CASE1:neuausgeben:=ersteausgabezeile<>1;ersteausgabezeile:=1CASE2:neuausgeben:=ersteausgabezeile<>maximum;ersteausgabezeile:=maximumCASE3,4:ausstieg:=ch;LEAVEformeleditorinfoOTHERWISEneuausgeben:=FALSE END SELECT ELSEneuausgeben:=FALSE END IF END PROCformeleditorinfo;END PACKETformeleditormanager;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek
new file mode 100644
index 0000000..0be980c
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek
@@ -0,0 +1,2 @@
+PACKETfunktionsbibliothekDEFINEScot,arcsin,arccos,arccot,gauss,rund,ganz,frak,realzahl,wandle,setzenachkommastellen,gesamtstellen,nachkomma,scratchdateiname:LETpisymbol="pi",esymbol="e",pihalbe=1.570796326794896619231,epsilon=0.000000000000000000001,meldung="Falscher Parameter bei realzahl",multiplikationssymbol="*",divisionssymbol="/",minussymbol="-",plussymbol="+",niltext="",blank=" ",zahlentyp=3;REAL PROCcot(REAL CONSTx):IFabs(tan(x))<epsilonTHENerrorstop(anwendungstext(55))END IF;1.0/tan(x)END PROCcot;REAL PROCarcsin(REAL CONSTx):IFabs(x)>1.0THENerrorstop(anwendungstext(54))END IF;arctan(x/sqrt(1.0-x*x))END PROCarcsin;REAL PROCarccos(REAL CONSTx):pihalbe-arcsin(x)END PROCarccos;REAL PROCarccot(REAL CONSTx):pihalbe-arctan(x)END PROCarccot;REAL PROCgauss(REAL CONSTx):IFx>=0.0CORfloor(x)=xTHENfloor(x)ELSEfloor(x)-1.0END IF END PROCgauss;REAL PROCrund(REAL CONSTx):round(x,0)END PROCrund;REAL PROCganz(REAL CONSTx):floor(x)END PROCganz;REAL PROCfrak(REAL CONSTx):frac(x)END PROCfrak;TEXT VARsym;INT VARtyp;REAL PROCrealzahl(TEXT CONSTt):enablestop;REAL VARzahl:=0.0;scan(t);nextsymbol(sym,typ);IFsym=minussymbolTHENnextsymbol(sym,typ);zahl:=-ueberprueftezahlELIFsym=plussymbolTHENnextsymbol(sym,typ);zahl:=ueberprueftezahlELSEzahl:=ueberprueftezahlEND IF;WHILEsym=multiplikationssymbolCORsym=divisionssymbolREP IFsym=multiplikationssymbolTHENnextsymbol(sym,typ);zahl:=zahl*ueberprueftezahlELIFsym=divisionssymbolTHENnextsymbol(sym,typ);zahl:=zahl/ueberprueftezahlEND IF END REP;IFsym<>niltextTHENerrorstop(meldung)END IF;zahlEND PROCrealzahl;REAL PROCueberprueftezahl:REAL VARwert;IFsym=esymbolTHENwert:=eELIFsym=pisymbolTHENwert:=piELIFtyp=zahlentypTHENwert:=real(sym)ELSEerrorstop(meldung)END IF;nextsymbol(sym,typ);wertEND PROCueberprueftezahl;ROW2INT VARnachk:=ROW2INT:(4,4),gesamtst:=ROW2INT:(18,18),grenze:=ROW2INT:(10,10);PROCsetzenachkommastellen(INT CONSTi):nachk(ebene):=i;gesamtst(ebene):=i+14;grenze(ebene):=gesamtst(ebene)-i-4END PROCsetzenachkommastellen;INT PROCgesamtstellen(INT CONSTi):gesamtst(i)END PROCgesamtstellen;INT PROCnachkomma(INT CONSTi):nachk(i)END PROCnachkomma;TEXT PROCwandle(REAL CONSTx):TEXT VARt;INT VARi;IFwertsehrgrossTHENwissenschaftlichesformatELIFwertsehrkleinTHEN IFwertnochdezimaldarstellbarTHENlangesdezimalesformatELSEwissenschaftlichesformatEND IF ELSEkurzesdezimalesformatEND IF.wertsehrgross:abs(x)>10.0**grenze(ebene).wertsehrklein:(abs(x)<10.0**(-nachk(ebene))CANDx<>0.0).wertnochdezimaldarstellbar:INT VARexponent:=abs(decimalexponent(x));exponent<gesamtst(ebene)-2.wissenschaftlichesformat:t:=text(x);INT VARn:=pos(t,"e")-1;IFn>0THEN WHILE(tSUBn)="0"REP IF(tSUB(n-1))<>"."THENchange(t,n,n,niltext);END IF;nDECR1END REP;END IF;(gesamtst(ebene)-length(t))*blank+t.kurzesdezimalesformat:t:=text(x,gesamtst(ebene),nachk(ebene));i:=gesamtst(ebene);WHILE(tSUBi)="0"REPreplace(t,i,blank);iDECR1END REP;IF(tSUBi)="."THEN IFnachk(ebene)<>0THENreplace(t,i,blank)ELSEt:=blank+text(t,i-1)END IF END IF;t.langesdezimalesformat:t:=text(x,gesamtst(ebene),exponent);i:=gesamtst(ebene);WHILE(tSUBi)="0"REPt:=blank+text(t,i-1)END REP;t.END PROCwandle;TEXT PROCscratchdateiname:TEXT VARname:="MATHEMATIKDATEI "+date+" "+timeofday;IFexists(name)THEN INT VARzaehler:=1;nameCAT":";WHILEexists(name+text(zaehler))REPzaehlerINCR1END REP;nameCATtext(zaehler)END IF;nameEND PROCscratchdateiname;END PACKETfunktionsbibliothek;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren
new file mode 100644
index 0000000..2f073b1
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren
@@ -0,0 +1,14 @@
+PACKETgraphicverfahrenDEFINESerstellegraph,normalgraphzeichnen,setzedefaultgraph,bauegraphbildschirmauf,initkoordinatensystem,berechnekoordinatensystem,nullpunkteinbeziehen,zeichnekoordinatensystem,zeichnefunktionsgraphen,zeichneasymptote,zeichnefusszeile,graphfenstereinstellen,gesamtfenstereinstellen,definitionsmenu,initprotokoll,gibprotokollaus,druckegraph,druckeprotokoll,loescheprotokoll,beendegraphikarbeit,gibgraphicmeldung,koordinatensystemxmin,koordinatensystemxmax,koordinatensystemymin,koordinatensystemymax,automatischerskalierungsmodus,zeichnetexte,loeschetexte:LETsondermenubeginn=0.65,graphrand=0.2,links="�",rechts="�",bell="�",verfahrenverlassen="qm",standardoptionen="wqm",graphicausschalten="üqmv",protokolloptionen="dwüqm",drucken="d",ueberlagerung="ü",weiterarbeit="w",graphicdefinieren="e",protokollzeigen="p",punktmarkierungszeichen="p",sekantenzeichen="s",tangentenzeichen="t",normalenzeichen="n",ableitungszeichen="a",xlotzeichen="x",ylotzeichen="y",druckzeichen="D",wischzeichen="L",parameterwahl="P",bereichswahl="B",achsenbereichzeichen="a",achsenbezeichnungszeichen="b",rasterzeichen="r",xtransformationszeichen="x",ytransformationszeichen="y",linienmoduszeichen="z",punktanzahlzeichen="p",zeichnungabbrechen="!",zeichnunganhalten=":",escapezeichen="�",minimumstuetzpunkte=5,niltext="",blank=" ",unterstrich="_",durchgezogen=TRUE,anzahltestpunkte=20.0,defaultstuetzpunkte=150,korrekturfaktor=0.4,erstemenuzeile=7,erstemenuspalte=55,punkteingabezeile=21,punkteingabelaenge=12,anzahlsondermenupunkte=12,anzahldefinitionspunkte=8,grundstift=1,stdtransformation1="y * cos (x)",stdtransformation2="y * sin (x)",xsymbol="x",ysymbol="y",maximalerachsenbetrag=1000000.0,minimaledifferenz=0.0000001,seitenabstand=8,hoehenabstand=8;TEXT VARxachsenbezeichnung:=niltext,yachsenbezeichnung:=niltext;TEXT CONSTkurzeleerzeile:=(80-erstemenuspalte)*blank,langeleerzeile:=60*blank,kurzerstrich:=12*unterstrich,loeschzeile:=kurzeleerzeile+" ";REAL VARxmin:=0.0,xmax:=1.0,ymin:=0.0,ymax:=1.0,xdistanz:=1.0,ydistanz:=1.0,deltax:=1.0,deltay:=1.0,cmbreite,cmhoehe,graphmaximum,graphminimum,graphbreite;INT VARpixelbreite,pixelhoehe,stuetzpunktanzahl:=defaultstuetzpunkte,imin,imax,i0,j0,jmin,jmax;ROW2ABBILDUNG VARtransformation;ROW2TEXT VARtransformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);ROW2BOOL VARtransformiert:=ROW2BOOL:(FALSE,FALSE);ROWanzahlsondermenupunkteTEXT CONSTsmpunkt:=ROWanzahlsondermenupunkteTEXT:(anwendungstext(191),anwendungstext(192),anwendungstext(193),anwendungstext(194),anwendungstext(195),anwendungstext(196),anwendungstext(197),anwendungstext(198),anwendungstext(199),anwendungstext(200),anwendungstext(201),anwendungstext(202));ROWanzahldefinitionspunkteTEXT CONSTdefpunkt:=ROWanzahldefinitionspunkteTEXT:(anwendungstext(118),anwendungstext(120),anwendungstext(121),anwendungstext(122),anwendungstext(123),anwendungstext(124),anwendungstext(125),anwendungstext(126));ABBILDUNG VARfkt,fktstrich;VECTOR VARfunktionsparameter;INT VARlaufvariablenindex:=1;REAL VARanfangswert:=-5.0,endwert:=5.0;BOOL VARlinienmodus:=durchgezogen,ursprungobligatorisch:=TRUE,automatischeskalierung:=TRUE,graphgerastert:=FALSE,bereichseingabegewuenscht:=TRUE,parametereingabegewuenscht:=TRUE,mitkoordinatensystem:=TRUE,asymptotensichtbar:=TRUE,parameterdarstellung:=FALSE,vorzeitigerabbruch:=FALSE,unterbrechenerlaubt:=TRUE,koordinatensysteminitialisiert:=FALSE,ueberlagern:=FALSE;PICTURE VARkoordinatensystem:=nilpicture;PROCerstellegraph(ABBILDUNG CONSTf):TEXT VARausstieg;disablestop;ueberpruefeverwendbarkeitderfunktion;bauegraphbildschirmauf(f,titel);initialisierediebearbeitung;bearbeitefunktion;beendearbeit.ueberpruefeverwendbarkeitderfunktion:fkt:=f;IFlaenge(abbildungsterme(fkt))>2THENgibmeldung(anwendungstext(88));LEAVEerstellegraphEND IF;IFueberlagernCAND NOT(parameterdarstellungXORlaenge(abbildungsterme(fkt))=1)THENgibmeldung(anwendungstext(177));LEAVEerstellegraphEND IF;parameterdarstellung:=laenge(abbildungsterme(f))=2;IFkomplexefunktion(fkt)
+THENfkt:=aufloesung(fkt)END IF.initialisierediebearbeitung:unterbrechenerlaubt:=TRUE;IFueberlagernTHENgraphfenstereinstellen;plotscreenmemoryELSEinitkoordinatensystemEND IF.titel:IFparameterdarstellungTHEN"Graph - Parameterdarstellung"ELSE"Graph"END IF.bearbeitefunktion:TEXT VARvariablenname:=NAMElistenanfang(abbildungsvariablen(fkt));laufvariablenindex:=1;funktionsparameter:=vector(laenge(abbildungsvariablen(fkt)));cursor(2,3);out("Variable :");cursor(22,3);out("von");cursor(39,3);out("bis");bereichseingabegewuenscht:=TRUE;WHILEbereichseingabegewuenschtREPbestimmelaufvariablenindexundbereich;mitkoordinatensystem:=NOTueberlagern;parametereingabegewuenscht:=TRUE;WHILEparametereingabegewuenschtREPbestimmeggfparameterwerte;zeichnefusszeile(anwendungstext(144));IFmitkoordinatensystemTHENinitkoordinatensystem;bestimmekoordinatenundzeichnekoordinatensystem;mitkoordinatensystem:=FALSE END IF;vorzeitigerabbruch:=FALSE;zeichnediefunktion;graphictools(ausstieg)END REP END REP.bestimmelaufvariablenindexundbereich:initialisierebereichseingabemaske;REPbearbeitebereichseingabemaske;werteausstiegausEND REP.initialisierebereichseingabemaske:LETfeldanzahl=3,yposition=3;INT VARi,feldptr;TEXT VARerlaubteausstiegszeichen:=graphicdefinieren+standardoptionen,verlasszeichen;ROWfeldanzahlTEXT VARfeld:=ROWfeldanzahlTEXT:(variablenname,compress(wandle(anfangswert)),compress(wandle(endwert)));ROWfeldanzahlINT CONSTxposition:=ROWfeldanzahlINT:(13,26,43),feldlaenge:=ROWfeldanzahlINT:(8,12,12);ROWfeldanzahlBOOL CONSTgesperrt:=ROWfeldanzahlBOOL:(ebene=1CORlaenge(abbildungsvariablen(fkt))=1,ueberlagern,ueberlagern);FORfeldptrFROM1UPTOfeldanzahlREP IF NOTgesperrt(feldptr)THENfeld(feldptr)CATkurzerstrichEND IF;cursor(xposition(feldptr),yposition);out(text(feld(feldptr),feldlaenge(feldptr)))END REP;feldptr:=0;bereichseingabegewuenscht:=NOT(gesperrt(1)CANDgesperrt(2)CANDgesperrt(3));IF NOTbereichseingabegewuenschtTHEN LEAVEbestimmelaufvariablenindexundbereichEND IF;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;verlasszeichen:=erlaubteausstiegszeichen+links+rechts.bearbeitebereichseingabemaske:IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(128))END IF;REP IFausstieg=linksTHEN IFfeldptr>1THENfeldptrDECR1END IF ELSEfeldptr:=feldptrMODfeldanzahl+1END IF;IFgesperrt(feldptr)THEN IFfeldptr=1THENfeldptr:=2ELIFfeldptr=2THENfeldptr:=1END IF END IF;cursor(xposition(feldptr),yposition);grapheditget(feld(feldptr),feldlaenge(feldptr),verlasszeichen,ausstieg)UNTILpos(erlaubteausstiegszeichen,ausstieg)<>0END REP.werteausstiegaus:SELECTpos(erlaubteausstiegszeichen,ausstieg)OF CASE1:IF NOTueberlagernTHENdefinitionsmenu(FALSE,ausstieg);IFpos(verfahrenverlassen,ausstieg)<>0THENverfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF END IF;CASE2:IFwertekorrektTHENbereichseingabegewuenscht:=FALSE;LEAVEbestimmelaufvariablenindexundbereichELSE FORiFROM1UPTOfeldanzahlREP IF NOTgesperrt(i)THENfeld(i)CATkurzerstrichEND IF END REP END IF OTHERWISEverfahrensende(ausstieg);ueberlagern:=ausstieg=ueberlagerung;LEAVEbearbeitefunktionEND SELECT.wertekorrekt:FORiFROM1UPTO3REPchangeall(feld(i),unterstrich,niltext)END REP;(gesperrt(1)CORkorrektervariablenname)CAND(gesperrt(2)CORkorrekteranfangswert)CAND(gesperrt(3)CORkorrekterendwert).korrektervariablenname:TERM VARt:=listenposition(abbildungsvariablen(fkt),feld(1));IFt=nilTHENfeldptr:=0;FALSE ELSEvariablenname:=NAMEt;laufvariablenindex:=PLATZt;TRUE END IF.korrekteranfangswert:REAL VARwert:=realzahl(feld(2));IFiserrorTHENbehandlefehler;feldptr:=1;FALSE ELIFabs(wert)>maximalerachsenbetragTHENfeldptr:=1;FALSE ELSEanfangswert:=wert;replace(funktionsparameter,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:wert:=realzahl(feld(3));IFiserrorTHENbehandlefehler;feldptr:=2;FALSE ELIFwert-anfangswert<=minimaledifferenzCORabs(wert)>maximalerachsenbetragTHENfeldptr:=2;FALSE ELSEendwert:=wert;TRUE END IF.bestimmeggfparameterwerte:IFlength(funktionsparameter)=1THENparametereingabegewuenscht
+:=FALSE;LEAVEbestimmeggfparameterwerteEND IF;cursor(2,4);out("Parameter:");IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(100))END IF;erlaubteausstiegszeichen:=standardoptionen;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;cursor(13,4);belegeparameter(funktionsparameter,laufvariablenindex,abbildungsvariablen(fkt),erlaubteausstiegszeichen,ausstieg);IFausstieg=weiterarbeitTHENparametereingabegewuenscht:=FALSE;cursor(2,4);out(langeleerzeile)ELSEueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF.bestimmekoordinatenundzeichnekoordinatensystem:IFautomatischeskalierungTHENberechnekoordinatensystemELIF NOTparameterdarstellungCAND NOTtransformiert(1)THENxmin:=anfangswert;xmax:=endwertEND IF;zeichnekoordinatensystem.zeichnediefunktion:pen(1,1,1,neuerstift);vorzeitigerabbruch:=FALSE;zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEbearbeitefunktionEND IF.beendearbeit:IF NOTueberlagernTHENclearscreenmemoryEND IF;loeschetemporaereabbildung(fkt);loeschetemporaereabbildung(fktstrich);plotendEND PROCerstellegraph;PROCgraphictools(TEXT VARausstieg):TEXT VARch;TEXT CONSTgueltigerausstieg:=verfahrenverlassen+ueberlagerung;REAL VARpx:=0.0,py;BOOL VARvollerfunktionsumfang,ableitunggezeichnet:=FALSE;BOOL CONSTzeichnungerweiterbar:=NOTtransformiert(1)CAND NOTtransformiert(2)CAND NOTparameterdarstellung;IFzeichnungerweiterbarTHENtestefunktionsumfangEND IF;zeichnesondermenu;REPclearbuffer;inchar(ch);IFch=punktmarkierungszeichenCANDzeichnungerweiterbarTHENmarkiereauszuwaehlendenpunktELIFch=sekantenzeichenCANDzeichnungerweiterbarTHENzeichneauszuwaehlendesekanteELIFch=tangentenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendetangenteELIFch=normalenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendenormaleELIFch=xlotzeichenCANDzeichnungerweiterbarTHENzeichnexlotELIFch=ylotzeichenCANDzeichnungerweiterbarTHENzeichneylotELIFch=ableitungszeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangCAND NOTableitunggezeichnetTHENzeichneableitungsfunktionELIFch=wischzeichenTHENerneueregraphicELIFch=druckzeichenTHENdruckegraphELIFch=parameterwahlCANDlaenge(abbildungsvariablen(fkt))<>1THENparametereingabegewuenscht:=TRUE;loeschesondermenu;LEAVEgraphictoolsELIFch=bereichswahlTHENbereichseingabegewuenscht:=TRUE;ueberlagern:=FALSE;loeschesondermenu;graphfenstereinstellen;loeschezeichnung;LEAVEgraphictoolsELIFch=escapezeichenTHENinchar(ausstieg);IFpos(gueltigerausstieg,ausstieg)<>0THENverlassegraphicbildschirmELIFausstieg=protokollzeigenTHENzeigeparameterbelegungELSEout(bell)END IF ELSEout(bell)END IF END REP.testefunktionsumfang:IFadresse(fktstrich)=nilTHENfktstrich:=ableitung(fkt,1,laufvariablenindex);IFiserrorTHENclearerror;vollerfunktionsumfang:=FALSE ELSEvollerfunktionsumfang:=TRUE END IF ELSEvollerfunktionsumfang:=TRUE END IF.zeichnesondermenu:INT VARi,zeile:=erstemenuzeile,anfang:=1;gesamtfenstereinstellen;IF NOTzeichnungerweiterbarTHENanfang:=9END IF;FORiFROManfangUPTOanzahlsondermenupunkteREP IF(laenge(abbildungsvariablen(fkt))<>1CANDi=10)CORi<>10CAND(vollerfunktionsumfangCOR(i<>2CANDi<>4CANDi<>5))THENcursor(erstemenuspalte,zeile);out(smpunkt(i));zeileINCR1END IF END REP;zeichnefusszeile(anwendungstext(178)).markiereauszuwaehlendenpunkt:punkteingabe;IFiserrorTHENbehandlefehlerELSEmarkierepunkt(px,py)END IF.zeichneauszuwaehlendetangente:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnetangente(px,py)END IF.zeichneauszuwaehlendesekante:REAL VARpx1:=px,px2:=0.0,py1,py2;liesdiebeidenpunkteein;zeichnefusszeile(anwendungstext(178));graphfenstereinstellen;zeichnegerade(px1,py1,px2,py2).liesdiebeidenpunkteein:liespunktein("x1 = ",anwendungstext(179),px1,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;replace(funktionsparameter,laufvariablenindex,px1);py1:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF;
+REPliespunktein("x2 = ",niltext,px2,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;IFpx2=px1THENout(bell)END IF UNTILpx2<>px1END REP;replace(funktionsparameter,laufvariablenindex,px2);py2:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF.zeichneauszuwaehlendenormale:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnenormale(px,py)END IF.zeichnexlot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;newpicture(lotstift);pen(1,1,1,lotstift);matmove(px,py);matdraw(px,0.0)END IF.zeichneylot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;pen(1,1,1,lotstift);newpicture(lotstift);matmove(px,py);matdraw(0.0,py)END IF.zeichneableitungsfunktion:asymptotensichtbar:=FALSE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fktstrich);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));asymptotensichtbar:=TRUE;ableitunggezeichnet:=TRUE.erneueregraphic:ueberlagern:=FALSE;graphfenstereinstellen;loeschezeichnungpartiell;initprotokoll;asymptotensichtbar:=TRUE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));initstift;pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));ableitunggezeichnet:=FALSE.zeigeparameterbelegung:gibprotokollaus(anwendungstext(214),protokolloptionen,ausstieg);IFausstieg=weiterarbeitTHENzeichnesondermenuELSEverlassegraphicbildschirmEND IF.verlassegraphicbildschirm:ueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictools.loeschesondermenu:INT VARende:=anzahlsondermenupunkte;IF NOTzeichnungerweiterbarTHENende:=4ELIF NOTvollerfunktionsumfangTHENendeDECR3END IF;IFlaenge(abbildungsvariablen(fkt))=1THENendeDECR1END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1).punkteingabe:liespunktein("x = ",anwendungstext(179),px,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;zeichnefusszeile(anwendungstext(178));replace(funktionsparameter,laufvariablenindex,px);py:=ergebnis(fkt,funktionsparameter)SUB1.testevorzeitigenausstieg:IFausstieg<>niltextTHENueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictoolsEND IF END PROCgraphictools;PROCmarkierepunkt(REAL CONSTx,y):INT VARi,j;INT CONSTstrichlaenge:=4;REAL VARunten,oben,links,rechts;graphfenstereinstellen;IFx<xminCORx>xmaxCORy<yminCORy>ymaxTHEN LEAVEmarkierepunktEND IF;pen(1,1,1,punktstift);i:=xpixel(x);j:=ypixel(y);links:=xweltkoordinate(i-strichlaenge);rechts:=xweltkoordinate(i+strichlaenge);unten:=yweltkoordinate(j-strichlaenge);oben:=yweltkoordinate(j+strichlaenge);newpicture(punktstift);matmove(links,oben);matdraw(rechts,unten);matmove(links,unten);matdraw(rechts,oben)END PROCmarkierepunkt;PROCzeichnetangente(REAL CONSTx,y):REAL VARm;IFx<xminCORx>xmaxTHEN LEAVEzeichnetangenteEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnetangenteEND IF;graphfenstereinstellen;pen(1,1,1,tangentenstift);newpicture(tangentenstift);matmove(xmin,m*(xmin-x)+y);matdraw(xmax,m*(xmax-x)+y)END PROCzeichnetangente;PROCzeichnenormale(REAL CONSTx,y):REAL VARm;IFx<xminCORx>xmaxTHEN LEAVEzeichnenormaleEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnenormaleEND IF;graphfenstereinstellen;pen(1,1,1,normalenstift);newpicture(normalenstift);IFm=0.0THENmatmove(x,ymax);matdraw(x,ymin)ELSEmatmove(xmin,-1.0/m*(xmin-x)+y);matdraw(xmax,-1.0/m*(xmax-x)+y)END IF END PROCzeichnenormale;PROCzeichnegerade(REAL CONSTx1,y1,x2,y2):REAL VARm:=(y2-y1)/(x2-x1);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(xmin,m*(xmin-x1)+y1);matdraw(xmax,m*(xmax-x1)+y1)END PROCzeichnegerade;
+PROCbauegraphbildschirmauf(ABBILDUNG CONSTf,TEXT CONSTueberschrift):initgraphic;zeichnestatuszeile(ueberschrift);zeichnearbeitsfunktion(f);zeichnebildschirmrasterEND PROCbauegraphbildschirmauf;PROCzeichnestatuszeile(TEXT CONSTverfahrensname):TEXT VARgrundlage:=text(anwendungstext(102),78),anhang:="Ebene "+text(ebene)+"     "+verfahrensname;replace(grundlage,77-length(anhang),anhang);cursor(2,1);out(grundlage)END PROCzeichnestatuszeile;PROCzeichnearbeitsfunktion(ABBILDUNG CONSTf):cursor(2,2);out(text(funktionsstring(f),78))END PROCzeichnearbeitsfunktion;PROCzeichnebildschirmraster:pen(1,1,1,grundstift);IFanpassungstyp<>"cga"THENboxEND IF;move(0.0,graphmaximum);draw(cmbreite,graphmaximum);move(graphbreite,graphmaximum);draw(graphbreite,graphminimum);move(0.0,graphminimum);draw(cmbreite,graphminimum)END PROCzeichnebildschirmraster;PROCzeichnefusszeile(TEXT CONSTt):cursor(2,24);out(text(t,78))END PROCzeichnefusszeile;PROCgibgraphicmeldung(TEXT CONSTinhalt):TEXT VARt:=78*waagerecht;cursor(1,21);out(eckeobenlinks+t+eckeobenrechts);cursor(1,22);out(senkrecht+text(inhalt,78)+senkrecht);cursor(1,23);out(eckeuntenlinks+t+eckeuntenrechts);zeichnefusszeile(anwendungstext(77));pauseEND PROCgibgraphicmeldung;PROCsetzedefaultgraph:automatischeskalierung:=TRUE;ursprungobligatorisch:=TRUE;linienmodus:=durchgezogen;xachsenbezeichnung:="A1";yachsenbezeichnung:="A2";stuetzpunktanzahl:=defaultstuetzpunkte;graphgerastert:=FALSE;transformiert:=ROW2BOOL:(FALSE,FALSE);transformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);xmin:=-5.0;xmax:=5.0;ymin:=-5.0;ymax:=5.0;ueberlagern:=FALSE;anfangswert:=-5.0;endwert:=5.0END PROCsetzedefaultgraph;PROCinitkoordinatensystem:koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;initprotokoll;initscreenmemory;initstiftEND PROCinitkoordinatensystem;PROCbeendegraphikarbeit:clearscreenmemory;loescheprotokoll;loescheggftransformation(1);loescheggftransformation(2)END PROCbeendegraphikarbeit;PROCloescheggftransformation(INT CONSTi):IFtransformiert(i)THENloescheabbildung(transformation(i))ENDIF END PROCloescheggftransformation;PROCinitgraphic:beginplot;clear;drawingarea(cmbreite,cmhoehe,pixelbreite,pixelhoehe);move(cmbreite,cmhoehe);gesamtfenstereinstellen;berechnebildschirmaufteilungskonstanten.berechnebildschirmaufteilungskonstanten:graphmaximum:=cmhoehe-4.5*stdhoehe;graphminimum:=cmhoehe-23.0*stdhoehe;graphbreite:=sondermenubeginn*cmbreiteEND PROCinitgraphic;PROCgesamtfenstereinstellen:viewport(0.0,cmbreite,0.0,cmhoehe);window(0.0,cmbreite,0.0,cmhoehe)END PROCgesamtfenstereinstellen;PROCgraphfenstereinstellen:viewport(graphrand,graphbreite-graphrand,graphminimum+graphrand,graphmaximum-graphrand);window(xmin,xmax,ymin,ymax)END PROCgraphfenstereinstellen;PROCberechnekoordinatensystem(ABBILDUNG CONSTabb,REAL CONSTlinks,rechts,VECTOR CONSTparam,INT CONSTvindex):parameterdarstellung:=FALSE;fkt:=abb;IFlinks<rechtsTHENanfangswert:=links;endwert:=rechtsELSEanfangswert:=rechts;endwert:=linksEND IF;anfangswert:=max(anfangswert,-maximalerachsenbetrag);endwert:=min(endwert,maximalerachsenbetrag);IFendwert-anfangswert<=minimaledifferenzTHENanfangswert:=anfangswert-minimaledifferenz;endwert:=anfangswert+minimaledifferenzEND IF;funktionsparameter:=param;laufvariablenindex:=vindex;IFautomatischeskalierungTHENberechnekoordinatensystemEND IF END PROCberechnekoordinatensystem;PROCberechnekoordinatensystem:ROW2BOOL VARdefinierterwertgefunden:=ROW2BOOL:(FALSE,FALSE);BOOL VARxachseaendern:=transformiert(1)CORparameterdarstellung;INT VARi,j;VECTOR VAReingaben:=funktionsparameter;REAL CONSTteststep:=(endwert-anfangswert)/(anzahltestpunkte-1.0);REAL VARx:=anfangswert,ertrag1,ertrag2;TERM VARfktterm1:=listenanfang(abbildungsterme(fkt)),fktterm2;ymin:=maximalerachsenbetrag;ymax:=-ymin;IFxachseaendernTHENxmin:=maximalerachsenbetrag;xmax:=-xmin;ELSExmin:=anfangswert;xmax:=endwertEND IF;IFparameterdarstellungTHENfktterm2:=AUSDRUCKnachfolger(fktterm1)END IF;fktterm1:=AUSDRUCKfktterm1;berechnetransformationsparameter;
+WHILEx<=endwertREPberechne;x:=x+teststepEND REP;IF NOTdefinierterwertgefunden(2)THENymin:=-5.0;ymax:=5.0END IF;IFxachseaendernTHEN IF NOTdefinierterwertgefunden(1)THENxmin:=-5.0;xmax:=5.0END IF;korrigiereachse(xmin,xmax)END IF;korrigiereachse(ymin,ymax);IFursprungobligatorischTHENnullpunkteinbeziehenEND IF.berechnetransformationsparameter:ROW2VECTOR VARvect;ROW2TERM VARterm;FORiFROM1UPTO2REP IFtransformiert(i)THENvect(i):=vector(laenge(abbildungsvariablen(transformation(i))));term(i):=AUSDRUCKlistenanfang(abbildungsterme(transformation(i)))END IF END REP.berechne:replace(eingaben,laufvariablenindex,x);ertrag1:=result(fktterm1,eingaben);IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(2):=NOTparameterdarstellungCAND NOTtransformiert(2);definierterwertgefunden(1):=parameterdarstellungCAND NOTtransformiert(1)END IF;IFparameterdarstellungTHENertrag2:=result(fktterm2,eingaben);IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(2):=NOTtransformiert(2)END IF END IF;transformiere;vergleiche.transformiere:ROW2REAL VARy;ROW2REAL VARp;IFparameterdarstellungTHENy:=ROW2REAL:(ertrag1,ertrag2)ELSEy:=ROW2REAL:(x,ertrag1)END IF;FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTOlength(vect(i))REPreplace(vect(i),j,y(j))END REP;p(i):=result(term(i),vect(i));IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(i):=TRUE END IF ELSEp(i):=y(i)END IF END REP.vergleiche:IFtransformiert(1)CORparameterdarstellungTHENxmax:=min(max(p(1),xmax),maximalerachsenbetrag);xmin:=max(min(p(1),xmin),-maximalerachsenbetrag)END IF;ymax:=min(max(p(2),ymax),maximalerachsenbetrag);ymin:=max(min(p(2),ymin),-maximalerachsenbetrag)END PROCberechnekoordinatensystem;PROCkorrigiereachse(REAL VARminimum,maximum):minimum:=max(minimum-korrekturfaktor*abs(minimum),-maximalerachsenbetrag);maximum:=min(maximum+korrekturfaktor*abs(maximum),maximalerachsenbetrag);IFminimum=maximumTHEN IFminimum=maximalerachsenbetragTHENminimum:=0.9*maximalerachsenbetragELIFminimum=-maximalerachsenbetragTHENmaximum:=0.9*minimumELSEminimum:=minimum-0.5;maximum:=maximum+0.5END IF END IF END PROCkorrigiereachse;PROCnullpunkteinbeziehen:IFxmax<=0.0THENxmax:=-0.15*xminELIFxmin>=0.0THENxmin:=-0.15*xmaxEND IF;IFymax<=0.0THENymax:=-0.15*yminELIFymin>=0.0THENymin:=-0.15*ymaxEND IF END PROCnullpunkteinbeziehen;PROCzeichnekoordinatensystem:graphfenstereinstellen;IF NOTkoordinatensysteminitialisiertTHENstellekoordinatensystemneuzusammenEND IF;gibkoordinatensystemaus.stellekoordinatensystemneuzusammen:ueberpruefesichtbarkeit;bestimmepixelmarkanterpunkte;zeichnedasbild;koordinatensysteminitialisiert:=TRUE;putscreenmemory(koordinatensystem).ueberpruefesichtbarkeit:BOOL CONSTxachsesichtbar:=ymin<=0.0CANDymax>=0.0,yachsesichtbar:=xmin<=0.0CANDxmax>=0.0.bestimmepixelmarkanterpunkte:imin:=xpixel(xmin);imax:=xpixel(xmax);jmin:=ypixel(ymin);jmax:=ypixel(ymax);IFxachsesichtbarTHENj0:=ypixel(0.0)END IF;IFyachsesichtbarTHENi0:=xpixel(0.0)END IF.zeichnedasbild:TEXT VARstring;INT VARtextlaenge,schreibzeile,schreibspalte,verfuegbarerplatz;REAL VARwert,letzterwert,start,anfang,ende,schriftbreite:=stdbreite,schrifthoehe:=stdhoehe;BOOL VARwertausgeben;berechneabstaende;pen(koordinatensystem,grundstift);IFxachsesichtbarTHENzeichnexachse;skalierexachse;beschriftexachseEND IF;IFyachsesichtbarTHENzeichneyachse;skaliereyachse;beschrifteyachseEND IF;IFgraphgerastertTHENlegerasteruebergraphEND IF.berechneabstaende:deltax:=xmax-xmin;deltay:=ymax-ymin;xdistanz:=10.0**decimalexponent(max(abs(xmax),abs(xmin)));ydistanz:=10.0**decimalexponent(max(abs(ymax),abs(ymin)));WHILExdistanz>=0.33*deltaxREPxdistanz:=0.1*xdistanzEND REP;WHILEydistanz>=0.33*deltayREPydistanz:=0.1*ydistanzEND REP.zeichnexachse:move(koordinatensystem,xmin,0.0);draw(koordinatensystem,xmax,0.0).skalierexachse:bestimmelaengederxskalierungsstriche;zeichnediexachsenstriche.bestimmelaengederxskalierungsstriche:REAL CONSTyabstand:=deltay/80.0;anfang:=min(yabstand,ymax);ende:=max(-yabstand,ymin).zeichnediexachsenstriche:start:=xmax-xmax
+MODxdistanz;WHILEstart>=xminREPmove(koordinatensystem,start,anfang);draw(koordinatensystem,start,ende);start:=start-xdistanzEND REP.beschriftexachse:gibxeinheitenaus;gibxachsenbezeichnungaus.gibxeinheitenaus:INT VARrechtegrenze:=imax,linkegrenze:=imin;REAL VARschreibzeilenweltlage;schreibzeile:=j0-zeichenhoehe-hoehenabstand;IFschreibzeile<jminTHEN LEAVEgibxeinheitenausEND IF;wertausgeben:=TRUE;schreibzeilenweltlage:=yweltkoordinate(schreibzeile);IFyachsesichtbarTHENlinkegrenze:=i0+seitenabstandEND IF;letzterwert:=xdistanz;wert:=xmax-xmaxMODxdistanz;WHILEwert>=xminREP IFwertausgebenTHENstring:=compress(wandle(wert));textlaenge:=length(string)*zeichenbreite;schreibspalte:=xpixel(wert)-textlaengeDIV2;IFschreibspalte+textlaenge<=rechtegrenzeCANDschreibspalte>=linkegrenzeTHENmove(koordinatensystem,xweltkoordinate(schreibspalte),schreibzeilenweltlage);draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;rechtegrenze:=schreibspalte-3*zeichenbreiteEND IF ELSEwertausgeben:=TRUE END IF;wert:=wert-xdistanz;IFwert=0.0THENwert:=-letzterwert;rechtegrenze:=i0-seitenabstand;wertausgeben:=TRUE END IF;IFwert<xdistanzTHENlinkegrenze:=iminEND IF END REP.gibxachsenbezeichnungaus:schreibzeile:=j0+hoehenabstand;IFschreibzeile+zeichenhoehe>jmaxTHEN LEAVEgibxachsenbezeichnungausEND IF;IFyachsesichtbarTHENlinkegrenze:=i0+seitenabstandELSElinkegrenze:=iminEND IF;verfuegbarerplatz:=imax-linkegrenze;IFverfuegbarerplatz<zeichenbreiteTHEN LEAVEgibxachsenbezeichnungausEND IF;textlaenge:=length(xachsenbezeichnung);WHILEverfuegbarerplatz<zeichenbreite*textlaengeREPtextlaengeDECR1END REP;move(koordinatensystem,xweltkoordinate(imax-zeichenbreite*textlaenge),yweltkoordinate(schreibzeile));draw(koordinatensystem,text(xachsenbezeichnung,textlaenge),0.0,schrifthoehe,schriftbreite).zeichneyachse:move(koordinatensystem,0.0,ymax);draw(koordinatensystem,0.0,ymin).skaliereyachse:bestimmelaengederyskalierungsstriche;zeichnedieyachsenstriche.bestimmelaengederyskalierungsstriche:REAL CONSTxabstand:=deltax/80.0;anfang:=max(-xabstand,xmin);ende:=min(xabstand,xmax).zeichnedieyachsenstriche:start:=ymax-ymaxMODydistanz;WHILEstart>=yminREPmove(koordinatensystem,anfang,start);draw(koordinatensystem,ende,start);start:=start-ydistanzEND REP.beschrifteyachse:gibyeinheitenaus;gibyachsenbezeichnungaus.gibyeinheitenaus:INT VARoberegrenze:=jmax,unteregrenze:=jmin,zentrierung:=zeichenhoeheDIV2;REAL VARschreibspaltenweltlage;schreibspalte:=i0+seitenabstand;IFschreibspalte>imaxTHEN LEAVEgibyeinheitenausEND IF;schreibspaltenweltlage:=xweltkoordinate(schreibspalte);IFxachsesichtbarTHENunteregrenze:=j0+hoehenabstandEND IF;wertausgeben:=ymax<=2.5*ydistanz;letzterwert:=ydistanz;verfuegbarerplatz:=imax-i0-seitenabstand;wert:=ymax-ymaxMODydistanz;WHILEwert>=yminREP IFwertausgebenTHENschreibzeile:=ypixel(wert)-zentrierung;IFschreibzeile+zeichenhoehe<=oberegrenzeCANDschreibzeile>=unteregrenzeTHENstring:=compress(wandle(wert));IFlength(string)*zeichenbreite<=verfuegbarerplatzTHENmove(koordinatensystem,schreibspaltenweltlage,yweltkoordinate(schreibzeile));draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;oberegrenze:=schreibzeile-zeichenhoeheEND IF END IF ELSEwertausgeben:=TRUE END IF;wert:=wert-ydistanz;IFwert=0.0THENwert:=-letzterwert;oberegrenze:=j0-hoehenabstand;wertausgeben:=TRUE END IF;IFwert<ydistanzTHENunteregrenze:=jminEND IF END REP.gibyachsenbezeichnungaus:schreibzeile:=jmax-zeichenhoehe;IFxachsesichtbarCANDj0+hoehenabstand>schreibzeileTHEN LEAVEgibyachsenbezeichnungausEND IF;verfuegbarerplatz:=i0-imin-seitenabstand;IFverfuegbarerplatz<zeichenbreiteTHEN LEAVEgibyachsenbezeichnungausEND IF;string:=yachsenbezeichnung;WHILEverfuegbarerplatz<zeichenbreite*length(string)REPstring:=subtext(string,2,length(string))END REP;move(koordinatensystem,xweltkoordinate(i0-seitenabstand-length(string)*zeichenbreite),yweltkoordinate(schreibzeile));draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite).
+legerasteruebergraph:ende:=ymax-ymaxMODydistanz;WHILEende>=yminREPanfang:=xmax-xmaxMODxdistanz;WHILEanfang>=xminREPmove(koordinatensystem,anfang,ende);draw(koordinatensystem,anfang,ende);anfang:=anfang-xdistanzEND REP;ende:=ende-ydistanzEND REP.gibkoordinatensystemaus:pen(1,1,1,pen(koordinatensystem));plot(koordinatensystem)END PROCzeichnekoordinatensystem;PROCnormalgraphzeichnen(ABBILDUNG CONSTabb,VECTOR CONSTparam,INT CONSTvindex):initstift;pen(1,1,1,neuerstift);parameterdarstellung:=FALSE;fkt:=abb;anfangswert:=xmin;endwert:=xmax;unterbrechenerlaubt:=FALSE;funktionsparameter:=param;laufvariablenindex:=vindex;zeichnefunktionsgraphen(fkt)END PROCnormalgraphzeichnen;PROCzeichnefunktionsgraphen(ABBILDUNG CONSTf):graphfenstereinstellen;newpicture(aktuellerstift);IFtransformiert(1)CORtransformiert(2)CORparameterdarstellungTHENzeichnefunktiontransformiert(f)ELIFlinienmodusTHENzeichnefunktionmitasymptotenroutine(f)ELSEzeichnefunktioneinfach(f)END IF;protokollierekurve(f,funktionsparameter,laufvariablenindex)END PROCzeichnefunktionsgraphen;PROCzeichnefunktiontransformiert(ABBILDUNG CONSTf):INT VARi,j;TERM VARfktterm1:=listenanfang(abbildungsterme(f)),fktterm2;REAL VARx:=anfangswert,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1);ROW2REAL VARy;VECTOR VARv:=funktionsparameter;BOOL VARfehlerzustand:=TRUE;IFparameterdarstellungTHENfktterm2:=AUSDRUCKnachfolger(fktterm1)END IF;fktterm1:=AUSDRUCKfktterm1;bestimmegegebenenfallstransformationsparameter;WHILEx<endwertREPberechne;befragetastatur;x:=x+stepEND REP.bestimmegegebenenfallstransformationsparameter:ROW2VECTOR VARvect;ROW2TERM VARterm;FORiFROM1UPTO2REP IFtransformiert(i)THENvect(i):=vector(laenge(abbildungsvariablen(transformation(i))));term(i):=AUSDRUCKlistenanfang(abbildungsterme(transformation(i)))END IF END REP.berechne:replace(v,laufvariablenindex,x);y(1):=result(fktterm1,v);IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF;IFparameterdarstellungTHENy(2):=result(fktterm2,v);IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF ELSEy(2):=y(1);y(1):=xEND IF;berechnegegebenenfallstransformation;zeichne.berechnegegebenenfallstransformation:ROW2REAL VARp;FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTOlength(vect(i))REPreplace(vect(i),j,y(j))END REP;p(i):=result(term(i),vect(i));IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF ELSEp(i):=y(i)END IF END REP.zeichne:IF NOTlinienmodusCORfehlerzustandTHENmatmove(p(1),p(2))END IF;matdraw(p(1),p(2));fehlerzustand:=FALSE.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktiontransformiertELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktiontransformiert;PROCzeichnefunktioneinfach(ABBILDUNG CONSTf):graphfenstereinstellen;VECTOR VARv:=funktionsparameter;REAL VARx:=anfangswert,y,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1);TERM CONSTfktterm:=AUSDRUCKlistenanfang(abbildungsterme(f));WHILEx<=endwertREPreplace(v,laufvariablenindex,x);y:=result(fktterm,v);IFiserrorTHENclearerrorELSEmatmove(x,y);matdraw(x,y)END IF;befragetastatur;x:=x+stepEND REP.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktioneinfachELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktioneinfach;PROCzeichnefunktionmitasymptotenroutine(ABBILDUNG CONSTf):BOOL VARwertdirektgefunden,mindestenseindefinierterwert:=FALSE;REAL VARx1:=anfangswert,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1),x2,x3,y1,y2,y3,xundef,xdef,ydef;TERM CONSTfktterm:=AUSDRUCKlistenanfang(abbildungsterme(f));REPuntersuchedreiaufeinanderfolgendewerteEND REP.untersuchedreiaufeinanderfolgendewerte:sucheerstenwert;zeichneerstenwert;suchezweitenwert;REPsuchedrittenwert;untersuchediewerteEND REP.sucheerstenwert:wertdirektgefunden:=TRUE;suchschleife;
+verfeineregegebenenfalls.suchschleife:REPbefragetastatur;replace(funktionsparameter,laufvariablenindex,x1);y1:=result(fktterm,funktionsparameter);IFiserrorTHENclearerror;wertdirektgefunden:=FALSE;x1:=x1+step;IFx1>endwertTHEN IFmindestenseindefinierterwertTHENxundef:=xdef+step;ydef:=verfeinerterwert(fktterm,xdef,xundef);zeichneasymptote(xundef);END IF;LEAVEzeichnefunktionmitasymptotenroutineEND IF ELSExdef:=x1;IFxdef>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;LEAVEsuchschleifeEND IF END REP.verfeineregegebenenfalls:IF NOTwertdirektgefundenTHENxundef:=x1-step;y1:=verfeinerterwert(fktterm,x1,xundef);zeichneasymptote(xundef)END IF.zeichneerstenwert:mindestenseindefinierterwert:=TRUE;matmove(x1,y1);matdraw(x1,y1).suchezweitenwert:x2:=x1+step;replace(funktionsparameter,laufvariablenindex,x2);y2:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x1,x2);x1:=x2;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x2END IF.suchedrittenwert:x3:=x2+step;replace(funktionsparameter,laufvariablenindex,x3);y3:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x2,x3);x1:=x3;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x3END IF.untersuchediewerte:IFsign(y3-y2)<>sign(y2-y1)THENspezialroutineEND IF;befragetastatur;matdraw(x2,y2);IFx2>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;x1:=x2;y1:=y2;x2:=x3;y2:=y3.spezialroutine:REAL VARx11:=x1,y11:=y1,x22:=x2,y22:=y2,x33:=x3,y33:=y3,xm,ym;INT VARcounter:=0;REPxm:=0.5*(x22+x33);replace(funktionsparameter,laufvariablenindex,xm);ym:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x22,xm);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFcounter=20THENmatdraw(xm,ym);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFidentischebildpunkteTHEN LEAVEspezialroutineELIFasymptotenbedingungTHENmatdraw(x22,y22);zeichneasymptote(xm);x1:=x33;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFsign(y22-y11)=sign(ym-y22)THENx11:=x22;y11:=y22;x22:=xm;y22:=ymELSEx33:=xm;y33:=ymEND IF;counterINCR1END REP.asymptotenbedingung:IFautomatischeskalierungTHENabs(y22)>4.0*deltayCANDabs(y33)>4.0*deltayELSEabs(y22)>1000000.0CANDabs(y33)>1000000.0END IF.identischebildpunkte:INT VARp1:=ypixel(y11),p2:=ypixel(y22),p3:=ypixel(ym),p4:=ypixel(y33);IFiserrorTHENclearerror;FALSE ELSEp1=p2CANDp2=p3CANDp3=p4END IF.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktionmitasymptotenroutineELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktionmitasymptotenroutine;PROCfehlerroutine(TERM CONSTfktterm,REAL CONSTx1,x2):REAL VARxdef,ydef,xundef;clearerror;xdef:=x1;xundef:=x2;ydef:=verfeinerterwert(fktterm,xdef,xundef);matdraw(xdef,ydef);zeichneasymptote(xundef)END PROCfehlerroutine;REAL PROCverfeinerterwert(TERM CONSTfktterm,REAL VARxdef,xundef):REAL VARxneu,yneu;INT VARcounter:=0;WHILEweiteresuchesinnvollREPxneu:=0.5*(xundef+xdef);replace(funktionsparameter,laufvariablenindex,xneu);yneu:=result(fktterm,funktionsparameter);IFiserrorTHENclearerror;xundef:=xneuELSExdef:=xneuEND IF;counterINCR1END REP;replace(funktionsparameter,laufvariablenindex,xdef);result(fktterm,funktionsparameter).weiteresuchesinnvoll:counter<40CANDxpixel(xdef)<>xpixel(xundef)END PROCverfeinerterwert;LETdoppelpunkt=":",gleichzeichen="=",graphname="Graph ",ueberschrift1="   Dargestellte Graphen   ",ueberschrift2="   Dargestellter Graph    ",linie="--------------------------";TEXT VARprotokollname:=niltext;FILE VARf;WINDOW VARfenster:=window(54,8,26,14);INT VARgraphzaehler:=1;PROCinitprotokoll:forget(protokollname,quiet);protokollname:=scratchdateiname;f:=sequentialfile(output,protokollname);graphzaehler:=1END PROCinitprotokoll;PROCprotokollierekurve(ABBILDUNG CONSTabb,VECTOR CONSTbetraege,INT CONSTvarindex):IFlines(f)>=4000THEN LEAVEprotokollierekurveEND IF;protokollierefktstring;protokolliereparameter;setzezaehlerweiter.
+protokollierefktstring:output(f);IFgraphzaehler>=2THENputline(f,graphname+text(graphzaehler)+doppelpunkt)END IF;putline(f,funktionsstring(abb));IFgraphzaehler=2THENmodify(f);toline(f,1);insertrecord(f);writerecord(f,graphname+"1")END IF.protokolliereparameter:INT VARi;LISTE CONSTvarliste:=abbildungsvariablen(abb);output(f);FORiFROM1UPTOlaenge(varliste)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(varliste,i),8)+gleichzeichen+compress(wandle(betraegeSUBi)))END IF END REP.setzezaehlerweiter:line(f);graphzaehlerINCR1END PROCprotokollierekurve;PROCergaenzetransformationen:INT VARi;ROW2TEXT CONSTkennung:=ROW2TEXT:("x","y");output(f);FORiFROM1UPTO2REP IFtransformiert(i)THENputline(f,kennung(i)+"-Transformation");putline(f,reststring)END IF;END REP.reststring:TEXT VARt:=funktionsstring(transformation(i));subtext(t,1+pos(t,":"))END PROCergaenzetransformationen;PROCentfernetransformationen:INT VARi,j;modify(f);FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTO2REPtoline(f,lines(f));deleterecord(f)END REP END IF END REP END PROCentfernetransformationen;PROCgibprotokollaus(TEXT CONSTfussnote,zeichen,TEXT VARausstieg):LETverfuegbarezeilenanzahl=14;INT VARspalte:=1,zeile:=1,letzteausgegebenezeile:=6,i;schreibeprotokollueberschrift;ergaenzetransformationen;IFlines(f)>verfuegbarezeilenanzahlTHENzeile:=lines(f)-verfuegbarezeilenanzahl+1END IF;zeichnefusszeile(fussnote);REPscroll(fenster,protokollname,1,1,1,zeile,spalte,zeichen,ausstieg);IFausstieg=druckenTHENdruckeprotokollEND IF UNTILausstieg<>druckenEND REP;letzteausgegebenezeileINCRleerzeilen;IFletzteausgegebenezeile>22THENletzteausgegebenezeile:=22END IF;entfernetransformationen;loeschegegebenenfallsbildschirmausgabe.schreibeprotokollueberschrift:cursor(54,6);out(ausgewaehlteueberschrift);cursor(54,7);out(linie).ausgewaehlteueberschrift:IFgraphzaehler=2THENueberschrift2ELSEueberschrift1END IF.leerzeilen:2+lines(f)-zeile.loeschegegebenenfallsbildschirmausgabe:IFpos(graphicausschalten,ausstieg)=0THEN FORiFROMletzteausgegebenezeileDOWNTO6REPcursor(54,i);out(kurzeleerzeile+blank)END REP END IF END PROCgibprotokollaus;PROCdruckeprotokoll:disablestop;IFprotokollname<>niltextTHENergaenzetransformationen;print(protokollname);entfernetransformationen;IF NOTiserrorTHEN LEAVEdruckeprotokollEND IF;behandlefehlerEND IF;out(bell)END PROCdruckeprotokoll;PROCloescheprotokoll:forget(protokollname,quiet);protokollname:=niltextEND PROCloescheprotokoll;REAL PROCkoordinatensystemxmin:xminEND PROCkoordinatensystemxmin;REAL PROCkoordinatensystemxmax:xmaxEND PROCkoordinatensystemxmax;REAL PROCkoordinatensystemymin:yminEND PROCkoordinatensystemymin;REAL PROCkoordinatensystemymax:ymaxEND PROCkoordinatensystemymax;BOOL PROCautomatischerskalierungsmodus:automatischeskalierungEND PROCautomatischerskalierungsmodus;PROCzeichneasymptote(REAL CONSTx):IFasymptotensichtbarTHEN REAL CONSTschritt:=deltay/20.0;REAL VARlauf:=ymax;WHILElauf>=yminREPmatmove(x,lauf);matdraw(x,lauf-0.5*schritt);lauf:=lauf-schrittEND REP END IF END PROCzeichneasymptote;PROCdefinitionsmenu(BOOL CONSTspezialverfahren,TEXT VARausstieg):INT VARi,eingabezeile:=16;koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;bauemenuauf;verarbeiteeingaben;IFausstieg=weiterarbeitTHENloeschemenuEND IF.bauemenuauf:INT VARausgabezeile:=erstemenuzeile;gesamtfenstereinstellen;FORiFROM1UPTOanzahldefinitionspunkteREPcursor(erstemenuspalte,ausgabezeile);IFzulaessigermenupunktTHENout(defpunkt(i));ausgabezeileINCR1END IF END REP;IFebene=1CORspezialverfahrenTHENeingabezeileDECR2END IF.zulaessigermenupunkt:IFi=4CORi=5THENebene=2CAND NOTspezialverfahrenELSE TRUE END IF.verarbeiteeingaben:TEXT VARch;BOOL VARfusszeileschreiben:=TRUE;REPclearbuffer;IFfusszeileschreibenTHENzeichnefusszeile(anwendungstext(100))END IF;fusszeileschreiben:=TRUE;inchar(ch);IFch=achsenbereichzeichenTHENlegedarstellungsbereichfestELIFch=achsenbezeichnungszeichenTHENlegeachsenbezeichnungfestELIFch=rasterzeichenTHENlegerasterungfestELIFch=linienmoduszeichenTHENlegelinienmodusfestELIFch
+=punktanzahlzeichenTHENlegepunktanzahlfestELIF NOTspezialverfahrenCANDch=xtransformationszeichenCANDebene=2THENlegextransformationfestELIF NOTspezialverfahrenCANDch=ytransformationszeichenCANDebene=2THENlegeytransformationfestELIFch=escapezeichenTHENinchar(ausstieg)ELSEfusszeileschreiben:=FALSE END IF UNTILpos(standardoptionen,ausstieg)<>0END REP.legedarstellungsbereichfest:REAL VARx1:=xmin,x2:=xmax,y1:=ymin,y2:=ymax;automatischeskalierung:=graphyes(anwendungstext(103),eingabezeile);IF NOTautomatischeskalierungTHEN IFspezialverfahrenCORparameterdarstellungCORtransformiert(1)THENliesxminimumein;liesxmaximumein;xmin:=x1;xmax:=x2;IFspezialverfahrenTHENanfangswert:=xmin;endwert:=xmaxEND IF END IF;liesyminimumein;liesymaximumein;ymin:=y1;ymax:=y2;ursprungobligatorisch:=FALSE ELSEursprungobligatorisch:=graphyes(anwendungstext(109),eingabezeile)END IF.liesxminimumein:REPliespunktein(anwendungstext(104),anwendungstext(186),x1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx1>=-maximalerachsenbetragEND REP.liesxmaximumein:REPliespunktein(anwendungstext(105),niltext,x2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx2>x1CANDx2<=maximalerachsenbetragEND REP.liesyminimumein:REPliespunktein(anwendungstext(107),anwendungstext(186),y1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy1>=-maximalerachsenbetragEND REP.liesymaximumein:REPliespunktein(anwendungstext(108),niltext,y2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy2>y1CANDy2<=maximalerachsenbetragEND REP.legeachsenbezeichnungfest:liesxbezeichnungein;liesybezeichnungein.liesxbezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(110));grapheditget(xachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegeachsenbezeichnungfestEND IF.liesybezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(111));grapheditget(yachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHEN LEAVElegeachsenbezeichnungfestEND IF.legerasterungfest:graphgerastert:=graphyes(anwendungstext(112),eingabezeile).legelinienmodusfest:linienmodus:=graphyes(anwendungstext(113),eingabezeile).legepunktanzahlfest:TEXT VAReingabe;INT VARwert;cursor(erstemenuspalte,eingabezeile);out(anwendungstext(129));zeichnefusszeile(anwendungstext(186));REPcursor(68,eingabezeile);eingabe:=text(stuetzpunktanzahl);grapheditget(eingabe,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegepunktanzahlfestEND IF;wert:=int(eingabe);IFiserrorTHENbehandlefehlerELIFwert>=minimumstuetzpunkteTHENradiere(eingabezeile);stuetzpunktanzahl:=wert;LEAVElegepunktanzahlfestELSEbehandlefehlerEND IF END REP.legextransformationfest:BOOL VARachsewartransformiert:=transformiert(1);loescheggftransformation(1);transformiert(1):=graphyes(anwendungstext(131),eingabezeile);IF NOTtransformiert(1)THEN LEAVElegextransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("x-Transformation:");liestransformationsfunktionein(transformation(1),transformationsvorgabe(1),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(1):=FALSE END IF;IFtransformiert(1)CAND NOTachsewartransformiertCAND NOTautomatischeskalierungTHENliesextremafuerxachseeinEND IF.liesextremafuerxachseein:REAL VARxlow:=xmin,xhigh:=xmax;liesxminein;liesxmaxein;xmin:=xlow;xmax:=xhigh.liesxminein:REPliespunktein(anwendungstext(104),anwendungstext(186),xlow,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVEliesextremafuerxachseeinEND IF UNTILxlow>=-maximalerachsenbetragEND REP.liesxmaxein:REPliespunktein(anwendungstext(105),niltext,xhigh,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN
+ LEAVEliesextremafuerxachseeinEND IF UNTILxhigh>xlowCANDxhigh<=maximalerachsenbetragEND REP.legeytransformationfest:loescheggftransformation(2);transformiert(2):=graphyes(anwendungstext(143),eingabezeile);IF NOTtransformiert(2)THEN LEAVElegeytransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("y-Transformation:");liestransformationsfunktionein(transformation(2),transformationsvorgabe(2),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(2):=FALSE END IF.loeschemenu:INT VARende:=anzahldefinitionspunkte;IFebene=1THENendeDECR2END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1)END PROCdefinitionsmenu;PROCliestransformationsfunktionein(ABBILDUNG VARtransfunktion,TEXT VARvorgabetext,TEXT CONSTerlaubteausstiegszeichen,TEXT VARausstieg):initialisiereeingaben;liesformelein.initialisiereeingaben:TEXT CONSTfname:=scratchfunctionname;TEXT VAReingabe:=vorgabetext;ausstieg:=niltext.liesformelein:LETeingabezeile=16;INT VARcursorx,cursory;zeichnefusszeile(anwendungstext(186));cursor(erstemenuspalte,eingabezeile+1);out("x,y -> ");getcursor(cursorx,cursory);REPcursor(cursorx,cursory);grapheditget(eingabe,15,erlaubteausstiegszeichen,ausstieg);IFausstieg<>niltextCANDpos(erlaubteausstiegszeichen,ausstieg)<>0THEN LEAVEliestransformationsfunktioneinEND IF;bildefunktionsstring;bewertefunktionsstringEND REP.bildefunktionsstring:TEXT VARsym,formel;BOOL VARxvorhanden:=FALSE,yvorhanden:=FALSE;scan(eingabe);nextsymbol(sym);WHILEsym<>niltextREPxvorhanden:=xvorhandenCORsym=xsymbol;yvorhanden:=yvorhandenCORsym=ysymbol;nextsymbol(sym)END REP;formel:=fname;IFxvorhandenCAND NOTyvorhandenTHENformelCAT":x->"ELSEformelCAT":x,y->"END IF;formelCATeingabe.bewertefunktionsstring:transfunktion:=neuefunktion(formel);IFiserrorTHENbehandlefehler;eingabe:=vorgabetextELSEtransfunktion:=aufloesung(transfunktion);loeschebenannteabbildung(fname);vorgabetext:=eingabe;radiere(cursory);LEAVEliesformeleinEND IF END PROCliestransformationsfunktionein;PROCbehandlefehler:clearerror;out(bell)END PROCbehandlefehler;PROCradiere(INT CONSTzeile):cursor(erstemenuspalte,zeile);out(kurzeleerzeile)END PROCradiere;PROCradiere(INT CONSTvon,bis):INT VARi;FORiFROMbisDOWNTOvonREPradiere(i)END REP END PROCradiere;BOOL PROCgraphyes(TEXT CONSTfrage,INT CONSTzeile):LETerlaubt="JYjyNn";INT VARi;cursor(erstemenuspalte,zeile);out(frage+" (j/n)?");zeichnefusszeile(anwendungstext(141));clearbuffer;REPi:=pos(erlaubt,incharety);UNTILi<>0END REP;radiere(zeile);i<5END PROCgraphyes;PROCliespunktein(TEXT CONSTcommando,fussnotiz,REAL VARxp,TEXT CONSTescausstieg,TEXT VARexit,INT CONSTzeile):TEXT VARt:=compress(wandle(xp))+kurzerstrich;initialisiereeingabe;gibein;loescheeingabefeld.initialisiereeingabe:gesamtfenstereinstellen;IFfussnotiz<>niltextTHENzeichnefusszeile(fussnotiz)END IF;cursor(erstemenuspalte,zeile);out(commando).gibein:REPgrapheditget(t,punkteingabelaenge,escausstieg,exit);IFexit<>niltextTHEN LEAVEgibeinEND IF;changeall(t,unterstrich,niltext);xp:=realzahl(t);IF NOTiserrorTHEN LEAVEgibeinEND IF;behandlefehler;tCATkurzerstrich;cursor(erstemenuspalte+length(commando),zeile)END REP.loescheeingabefeld:radiere(zeile)END PROCliespunktein;PROCsetzewertezurueck:ueberlagern:=FALSE;asymptotensichtbar:=TRUE;initkoordinatensystemEND PROCsetzewertezurueck;PROCunterbrechezeichnung:INT VARxkoord,ykoord;where(xkoord,ykoord);zeichnefusszeile(anwendungstext(77));clearbuffer;pause;zeichnefusszeile(anwendungstext(144));pen(1,1,1,aktuellerstift);move(xkoord,ykoord);graphfenstereinstellenEND PROCunterbrechezeichnung;REAL PROCxweltkoordinate(INT CONSTxpic):xmin+(xmax-xmin)*real(xpic-imin)/real(imax-imin)END PROCxweltkoordinate;REAL PROCyweltkoordinate(INT CONSTypic):ymin+(ymax-ymin)*real(ypic-jmin)/real(jmax-jmin)END PROCyweltkoordinate;PROCdruckegraph:vervollstaendigeaktuellezeichnung(xmin,xmax,ymin,ymax,graphbreite-2.0*graphrand,graphmaximum-graphminimum-2.0*graphrand);druckeaktuellezeichnungEND PROCdruckegraph;PROCzeichnetexte:zeichnefusszeile(
+anwendungstext(210));cursor(54,10);out(anwendungstext(247));cursor(54,12);out(anwendungstext(248));cursor(54,15);out(anwendungstext(249));cursor(54,18);out(anwendungstext(250));cursor(54,19);out(anwendungstext(251));cursor(54,20);out(anwendungstext(252))END PROCzeichnetexte;PROCloeschetexte:cursor(54,20);out(loeschzeile);cursor(54,19);out(loeschzeile);cursor(54,18);out(loeschzeile);cursor(54,16);out(loeschzeile);cursor(54,15);out(loeschzeile);cursor(54,13);out(loeschzeile);cursor(54,12);out(loeschzeile);cursor(54,10);out(loeschzeile);END PROCloeschetexte;END PACKETgraphicverfahren;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hercules plot b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot
new file mode 100644
index 0000000..e4607b3
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,anpassungstyp,drawingarea,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0)END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy)CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy)CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy)CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy)OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):control(-7,x,347-y,dummy);xalt:=x;yalt:=yEND OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;
+PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an   ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"hercules"END PROCanpassungstyp;PROCwhere(INT VARx,y):x:=xalt;y:=yaltEND PROCwhere;INT PROCzeichenbreite:9END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14")
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot
new file mode 100644
index 0000000..d197007
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot
@@ -0,0 +1,3 @@
+PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=37.0,ycm=27.7,papierx1=1200,papierx2=16000,papiery1=320,papiery2=11400,plotterunitspercm=100.0;TEXT CONSTschlange:=code(126),terminator:=code(125);INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);BOUND TEXT VARpicture;INT VARterminalchannel,plotterchannel:=5;LET POS=STRUCT(INTx,y);POS VARposition:=POS:(0,0);REAL VARbuchstabenhoehe:=1.108,buchstabenbreite:=0.4625;INT VARvelocity:=10;LETbackspace="�",alt="",stand="",pktklein="}",pktgross="{";PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):IFx>0ANDx<37THENvelocity:=xFI END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:TEXT VARhp:="";move(0,0);sendepicture;hpCAT("v"+sbn(0));hpCAT"�"+".)";toplotterchannel;out(hp);toterminalchannel;ENDPROCplotend;PROCclear:terminalchannel:=channel;forget("picture ds",quiet);picture:=new("picture ds");picture:="";TEXT VARhp;hp:="�.(";hpout(hp);hp:="�.M:";hpout(hp);hp:="�.I1000;17;13:";hpout(hp);hp:=schlange;hpCAT"W";hpCATplotput(papierx1,papiery1);hpCATplotput(papierx2,papiery2);hpCATterminator;hpout(hp);hp:=schlange;hpCAT"S";hpCATplotput(xunits,yunits);hpCATterminator;hpout(hp);hpout("vA");hpout(schlange+"Q");hpout(schlange+"V"+sbn(velocity)+terminator);hpout(schlange+"P"+plotput(0,3));END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linetypesenden;verifypen;switchtopen;.verifypen:INT VARpen;pen:=max(0,foreground);pen:=min(4,pen).switchtopen:TEXT VARhp;hp:=("v"+sbn(pen));hpout(hp).linetypesenden:hp:=schlange+"Q";hpCATlinetypecode;hpout(hp).linetypecode:TEXT VARtt;tt:="";IFlinetype=0THENtt:=terminator;ELIFlinetype=1THENtt:=terminator;ELIFlinetype=2THENtt:=sbn(32+0)+sbn(1)+mbn(15)+terminator;ELIFlinetype=3THENtt:=sbn(32+1)+sbn(2)+mbn(15)+terminator;ELIFlinetype=4THENtt:=sbn(32+1)+sbn(2)+mbn(30)+terminator;ELIFlinetype=5THENtt:=sbn(32+1)+sbn(2)+sbn(32+2)+sbn(2)+mbn(28)+terminator;ELSEtt:=terminatorFI;ttEND PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:="";hpCAT"p";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:="";hpCAT"q";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp;INT VARspace:=int(width*plotterunitspercm),size:=int(height*plotterunitspercm*1.5);hp:=schlange+"%";hpCATplotput(space,size);hpout(hp);hp:=schlange+"'";ersetzeumlaute;hpCATumgesetztertext;hpCATcode(3);hpout(hp);move(position.x,position.y).ersetzeumlaute:TEXT VARumgesetztertext:="";INT VARi;FORiFROM1UPTO LENGTHrecordREPbildeneuentextPER.bildeneuentext:IF(pos("äöüÄÖÜß",(recordSUBi)))=0THENumgesetztertextCAT(recordSUBi)ELSEumgesetztertextCATersetzterumlautFI.ersetzterumlaut:IF"ä"=(recordSUBi)THENalt+"a"+pktklein+standELIF"ö"=(recordSUBi)THENalt+"o"+pktklein+standELIF"ü"=(recordSUBi)THENalt+"u"+pktklein+standELIF"Ä"=(recordSUBi)THENalt+"A"+pktgross+standELIF"Ö"=(recordSUBi)THENalt+"O"+pktgross+standELIF"Ü"=(recordSUBi)THENalt+"U"+pktgross+standELIF"ß"=(recordSUBi)THEN"P"+backspace+"p"ELSE""FI.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;TEXT PROCplotput(INT CONSTnx,ny):INT VARn,nx1,nx2,nx3,ny2,ny3,ny4,ny5,nxr,nyr;TEXT VARmbpformat;INT VARnp1,np2,np3,np4,np5;n:=nx;IF NOT(nx>ny)THENn:=ny;FI;IFn<256THEN IFn>31
+THENthreebyteformatELIFn>3THENtwobyteformatELSEonebyteformatFI;ELSE IFn<2048THENfourbyteformatELIFn<16384THENfivebyteformatELSEerrorstop("out of range: "+text(n));FI;FI;mbpformat.onebyteformat:np1:=ny+96+4*nx;mbpformat:=code(np1);.twobyteformat:nx1:=nxDIV2;nx2:=nx-2*nx1;np1:=nx1+96;np2:=ny+32*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;mbpformat:=code(np1)+code(np2);.threebyteformat:nx1:=nxDIV16;nx2:=nx-16*nx1;ny2:=nyDIV64;ny3:=ny-64*ny2;np1:=nx1+96;np2:=ny2+4*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3;IF NOT(np3>31)THENnp3:=np3+64;FI;mbpformat:=code(np1)+code(np2)+code(np3);.fourbyteformat:nx1:=nxDIV128;nxr:=nx-128*nx1;nx2:=nxrDIV2;nx3:=nxr-2*nx2;ny3:=nyDIV64;ny4:=ny-64*ny3;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+32*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4);.fivebyteformat:nx1:=nxDIV1024;nxr:=nx-1024*nx1;nx2:=nxrDIV16;nx3:=nxr-16*nx2;ny3:=nyDIV4096;nyr:=ny-4096*ny3;ny4:=nyrDIV64;ny5:=nyr-64*ny4;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+4*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;np5:=ny5;IF NOT(np5>31)THENnp5:=np5+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4)+code(np5);.END PROCplotput;TEXT PROCmbn(INT CONSTnn):TEXT VARmbnformat;INT VARnp1,np2,np3,nn1,nn2,nn3,nr;IFnn<16THENonebyteformatELIFnn<1024THENtwobyteformatELIFnn<=32767THENthreebyteformatELSEerrorstop("out of range: "+text(nn));FI;mbnformat.onebyteformat:np1:=nn+96;mbnformat:=code(np1).twobyteformat:nn1:=nnDIV64;nn2:=nn-64*nn1;assemble2;mbnformat:=code(np1)+code(np2);.threebyteformat:nn1:=nnDIV4096;nr:=nn-nn1*4096;nn2:=nrDIV64;nn3:=nr-64*nn2;assemble1;assemble2;mbnformat:=code(np1)+code(np2)+code(np3);.assemble1:np3:=nn3;IF NOT(np3>31)THENnp3:=np3+64;FI;.assemble2:np2:=nn2;IF NOT(np2>31)THENnp2:=np2+64;FI;np1:=nn1+96;.END PROCmbn;TEXT PROCsbn(INT CONSTnn):INT VARnp;np:=nn;IF NOT(np>31)THENnp:=np+64;FI;code(np).END PROCsbn;PROChpout(TEXT CONSTplotcommand):pictureCATplotcommand;IFlength(picture)>800THENsendepictureFI END PROChpout;PROCsendepicture:getlen;toplotterchannel;out(text(picture,len));picture:="";getacknowledge.getlen:INT VARlen:=min(1000,length(picture)).getacknowledge:clearinputbuffer;out("�");readhandshakechar.clearinputbuffer:WHILEincharety<>""REP PER.readhandshakechar:TEXT VARchar:="";INT VARsession;WHILEchar<>"
"REPinchar(char)PER;toterminalchannel.END PROCsendepicture;PROCtoplotterchannel:continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKEThpplot;plotterkanal(7)
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot
new file mode 100644
index 0000000..137f6c6
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot
@@ -0,0 +1,3 @@
+PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=40.19,ycm=27.46,plotterunitspercm=402.0,buffersize=1024;LETinitcmd="IN",textcmd="LB",separator=",",terminator=";",outputterminator="
",movecmd="PU",drawcmd="PD",pencmd="SP",charsizecmd="SI",linetypecmd="LT",plotabscmd="PA",askbuffersize="�.B",stdcharpre="�CS33;LB",stdcharpost="�SS;LB",etx="�";ROW22TEXT CONSTnichtasciizeichen:=ROW22TEXT:(stdcharpre+"["+stdcharpost,stdcharpre+"\"+stdcharpost,stdcharpre+"]"+stdcharpost,stdcharpre+"{"+stdcharpost,stdcharpre+"|"+stdcharpost,stdcharpre+"}"+stdcharpost,"k","-","#"," ",stdcharpre+"~"+stdcharpost,"�UC3,0,99,0,16,-99,0,-8,99,-3,0;LB","�UC3,0,99,0,16;LB","�UC3,0,99,0,8,-4,0;LB","�UC0,8,99,3,0,0,8;LB","�UC3,16,99,0,-8,3,0;LB","�UC3,0,99,0,8,3,0;LB","�UC0,8,99,6,0,-99,-3,0,99,0,8;LB","�UC0,8,99,6,0,-99,-3,0,99,0,-8;LB","�UC3,0,99,0,16,-99,0,-8,99,3,0;LB","�UC0,8,99,6,0;LB","�UC0,8,99,6,0,-99,-3,-8,99,0,16;LB");INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=5;INT VARfreebytes;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoehe;END PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breite;END PROCstdbreite;PROCbeginplot:freebytes:=9;toplotterchannel;clear;TEXT VARhp:=pencmd;hpCAT"1";hpCATterminator;sendtoplotter(hp)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:clear;TEXT VARhp:=pencmd;hpCAT"0";hpCATterminator;hpCATinitcmd;hpCATterminator;sendtoplotter(hp);toterminalchannelENDPROCplotend;PROCclear:TEXT VARhp:=initcmd;hpCATterminator;hpCATplotabscmd;hpCATterminator;sendtoplotter(hp);END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):TEXT VARhp:=pencmd;IFforeground>6ORforeground<1THENhpCAT"1"ELSEhpCATtext(foreground)END IF;hpCATterminator;hpCATlinetypecmd;IFlinetype>1ANDlinetype<6THENhpCATtext(linetype-1);hpCATseparator;hpCAT"0.75";END IF;hpCATterminator;sendtoplotter(hp)END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:=movecmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:=drawcmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp:=charsizecmd,konvertiertertext:="";konvertieretext;hpCATtext(width*0.66666667,8,4);hpCATseparator;hpCATtext(height*0.5,8,4);hpCATterminator;hpCATtextcmd;hpCATkonvertiertertext;hpCATetx;sendtoplotter(hp).konvertieretext:INT VARstelle;INT VARzeichen;FORstelleFROM1UPTO LENGTHrecordREPEATzeichen:=code(recordSUBstelle);IFzeichen=251THENkonvertiertertextCATnichtasciizeichen[11]ELIFzeichen>=185ANDzeichen<=188THENkonvertiertertextCATnichtasciizeichen[zeichen-173]ELIFzeichen>=200ANDzeichen<=206THENkonvertiertertextCATnichtasciizeichen[zeichen-184]ELIFzeichen>=214ANDzeichen<=223THENkonvertiertertextCATnichtasciizeichen[zeichen-213]ELSEkonvertiertertextCATcode(zeichen)END IF END REPEAT END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;PROCsendtoplotter(TEXT CONSTstring):INT VARlaenge;laenge:=
+LENGTHstring;IFfreebytes<buffersizeDIV2ORfreebytes-9<laengeTHENwarteaufgenugfreienpufferEND IF;out(string);freebytesDECRlaenge;checkforerror.warteaufgenugfreienpuffer:TEXT VARplotteroutput,char;INT VARdelay:=0;REPplotteroutput:="";pause(delay);REP UNTILincharety=""PER;out(askbuffersize);freebytesDECR3;REPinchar(char);plotteroutputCATcharUNTILchar=outputterminatorPER;plotteroutput:=subtext(plotteroutput,1,LENGTHplotteroutput-1);freebytes:=int(plotteroutput);delay:=1;UNTILfreebytes>buffersizeDIV2ANDfreebytes-9>=laengePER.checkforerror:out("OE;");TEXT VARc,t;inchar(c);inchar(t);IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)FI;out("�.E");inchar(c);inchar(t);IFt<>outputterminatorTHENcCATt;inchar(t);END IF;IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)END IF;freebytesDECR6END PROCsendtoplotter;END PACKEThpplot;plotterkanal(7)
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren
new file mode 100644
index 0000000..a8ae08d
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren
@@ -0,0 +1,7 @@
+PACKETintegrationsverfahrenDEFINESberechneintegral:LETweiter="w",naechste="q",menue="m",graphdefinieren="e",protokoll="p",escdrucken="d",drucken="D",info="?",abbruch="!",blank=" ",del="�",bell="�",esc="�",folgenvariable="n",folgentext=" a(n)",defaultfolge="n",varstellen=8,zahlstellen=12,maxiter=4048,rowlaenge=4049,rombergmaxspalten=13,anzahlnumerischeverfahren=4,anzahlverfahreninsgesamt=6,maxueberschriftlaenge=17,maxfehlermeldunglaenge=46,rechteckverfahren=1,trapezverfahren=2,simpsonverfahren=3,rombergverfahren=4;ROW4TEXT CONSTfehlermeldung:=ROW4TEXT:(anwendungstext(51),anwendungstext(52),"-","-");ROWanzahlnumerischeverfahrenTEXT CONSTueberschrift:=ROWanzahlnumerischeverfahrenTEXT:(anwendungstext(220),anwendungstext(221),anwendungstext(222),anwendungstext(223));ROW2TEXT CONSTunterstrich:=ROW2TEXT:("-----------------","---------------");ROWanzahlverfahreninsgesamtTEXT CONSTverfahrensname:=ROWanzahlverfahreninsgesamtTEXT:(anwendungstext(235),anwendungstext(236),anwendungstext(237),anwendungstext(238),anwendungstext(239),anwendungstext(240));ROW3TEXT CONSTrechteckstuetztext:=ROW3TEXT:(anwendungstext(89),anwendungstext(90),anwendungstext(91));ROWrombergmaxspaltenROWrombergmaxspaltenREAL VARmatrix;THESAURUS VARverfuegbareverfahren;INT VARzaehler,spaltenbreite,nrofinitializedpoints:=0;TEXT VARintegrationsfehler:="",tabellenname;BOUND ROWrowlaengeREAL VARstuetzpunkte;DATASPACE VARds;BOOL VARfirsttime:=TRUE;REAL VARschrittweite;TEXT CONSTloeschzeile:=23*" ";verfuegbareverfahren:=emptythesaurus;FORzaehlerFROM1UPTOanzahlverfahreninsgesamtREPinsert(verfuegbareverfahren,verfahrensname[zaehler])PER PROCinitstuetzpunkte(ABBILDUNG CONSTabb,REAL CONSTuntergrenze,obergrenze,INT CONSTanzahlstuetzpunkte,varnr,VECTOR CONSTparameter,BOOL VARfehler):INT VARi;TERM CONSTt:=AUSDRUCKlistenanfang(abbildungsterme(abb));schrittweite:=(obergrenze-untergrenze)/real(anzahlstuetzpunkte-1);VECTOR VARvec:=parameter;nrofinitializedpoints:=0;forget(ds);ds:=nilspace;stuetzpunkte:=ds;FORiFROM1UPTOanzahlstuetzpunkteREPreplace(vec,varnr,untergrenze+real(i-1)*schrittweite);stuetzpunkte[i]:=result(t,vec);IFiserrorTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[1];LEAVEinitstuetzpunkteEND IF END REP;nrofinitializedpoints:=anzahlstuetzpunkteEND PROCinitstuetzpunkte;BOOL PROCispoweroftwo(INT VARi):INT VARdoppel:=1,log:=0;REPEAT IFdoppel=iTHENi:=log;LEAVEispoweroftwoWITH TRUE END IF;doppelINCRdoppel;logINCR1UNTILdoppel>iCORiserrorPER;clearerror;FALSE END PROCispoweroftwo;REAL PROCtrapezintegration:INT VARi;REAL VARsumme:=0.5*(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints]);FORiFROM2UPTOnrofinitializedpoints-1REPsumme:=summe+stuetzpunkte[i]END REPEAT;summe*schrittweiteEND PROCtrapezintegration;LETlinks=1,mitte=2,rechts=3;INT VARrechteckstuetze:=links;REAL PROCrechtecksintegration:REAL VARsumme;INT VARi;IFrechteckstuetze<rechtsTHENsumme:=stuetzpunkte[1]ELSEsumme:=stuetzpunkte[nrofinitializedpoints]END IF;FORiFROM2UPTOnrofinitializedpoints-1REPsumme:=summe+stuetzpunkte[i]END REPEAT;summe*schrittweiteEND PROCrechtecksintegration;REAL PROCsimpsonintegration:IF(nrofinitializedpointsAND1)=0THENintegrationsfehler:=fehlermeldung[4];LEAVEsimpsonintegrationWITH0.0END IF;REAL VARsumme:=stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints];INT VARi:=2;REP IFiMOD2=0THENsumme:=summe+4.0*stuetzpunkte[i]ELSEsumme:=summe+2.0*stuetzpunkte[i]END IF;iINCR1UNTILi>nrofinitializedpoints-1PER;summe*schrittweite/3.0END PROCsimpsonintegration;REAL PROCrombergintegration:INT VARintervallgroesse,anzahlschachtelungen,i,j;REAL VARnenner:=4.0;berechneanzahlderschachtelungen;berechneintegrale;erzeugerombergschema;ergebnis.berechneanzahlderschachtelungen:anzahlschachtelungen:=nrofinitializedpoints-1;IF NOTispoweroftwo(anzahlschachtelungen)THENintegrationsfehler:=fehlermeldung[3];LEAVErombergintegrationWITH0.0END IF.berechneintegrale:intervallgroesse:=1;FORiFROManzahlschachtelungenDOWNTO0REPmatrix[1][i+1]:=trapezintegralspezial;intervallgroesseINCRintervallgroesseEND REP.
+trapezintegralspezial:REAL VARsumme:=(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints])/2.0;j:=1+intervallgroesse;WHILEj<nrofinitializedpointsREPsumme:=summe+stuetzpunkte[j];jINCRintervallgroessePER;summe*schrittweite*real(intervallgroesse).erzeugerombergschema:FORjFROM1UPTOanzahlschachtelungenREP FORiFROM1UPTOanzahlschachtelungen-j+1REPmatrix[j+1][i]:=matrix[j][i+1]+(matrix[j][i+1]-matrix[j][i])/(nenner-1.0);PER;nenner:=nenner*4.0PER.ergebnis:matrix[anzahlschachtelungen+1][1]END PROCrombergintegration;PROCerzeugenaeherungsfolge(REAL CONSTuntergrenzefkt,obergrenzefkt,INT CONSTuntergrenzefolge,obergrenzefolge,ABBILDUNG CONSTfolge,funktion,INT CONSTvarnr,VECTOR CONSTparameter,ROWanzahlnumerischeverfahrenINT CONSTreihenfolge,INT VARerstersatz,erstespalte):BOOL VARfehler;INT VARntesfolgenglied,i,j;ROWanzahlnumerischeverfahrenTEXT VARnaeherungen;VECTOR VARfolgenvector:=nilvector;TERM VARfolgenterm:=AUSDRUCKlistenanfang(abbildungsterme(folge));BOOL VARmatrixzeigen:=nurrombergverfahrenausgewaehltCANDnureinfolgengliedCANDfolgengliedistzweierpotenz;FILE VARf:=sequentialfile(output,tabellenname);berechnespaltenbreite;schreibetabellenkopf;berechnewerteundschreibeindatei;setzekoordinaten.nurrombergverfahrenausgewaehlt:reihenfolge[1]=rombergverfahrenANDreihenfolge[2]=0.nureinfolgenglied:untergrenzefolge=obergrenzefolge.folgengliedistzweierpotenz:i:=untergrenzefolge;ermittlefolgenglied;INT VARschachtelungen:=ntesfolgenglied;ispoweroftwo(schachtelungen).berechnespaltenbreite:IF NOTmatrixzeigenTHENspaltenbreite:=max(gesamtstellen(ebene),maxueberschriftlaenge)+2;IFlaenge(abbildungsvariablen(funktion))<>1THENspaltenbreite:=max(spaltenbreite,varstellen+zahlstellen+2)END IF;ELSEspaltenbreite:=gesamtstellen(ebene)+1END IF.schreibetabellenkopf:TEXT VARkopfzeile,trennlinie;IFlength(parameter)<=10THENtrageparametereinEND IF;IFmatrixzeigenTHENkopfzeile:=ueberschrift[rombergverfahren]+"    "+folgenvariable+" = "+text(untergrenzefolge)+"    "+folgentext+" = "+text(ntesfolgenglied);trennlinie:=(schachtelungen+1)*spaltenbreite*waagerecht;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))ELSEkopfzeile:="  "+folgenvariable+"  "+senkrecht;kopfzeileCATfolgentext;trennlinie:=5*waagerecht+kreuz+5*waagerecht;FORiFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[i]<>0THENkopfzeileCATsenkrecht+center(spaltenbreite,ueberschrift[reihenfolge[i]]);trennlinieCATkreuz+spaltenbreite*waagerechtEND IF PER;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))END IF;write(f,kopfzeile);line(f);write(f,trennlinie);line(f).trageparameterein:FORiFROM1UPTO LENGTHparameterREP IFi<>varnrTHENwrite(f,text(NAMEauswahl(abbildungsvariablen(funktion),i),varstellen)+"="+(12-varstellen)*blank+wandle(parameterSUBi));line(f)END IF END REPEAT.berechnewerteundschreibeindatei:cursor(36,24);FORiFROMuntergrenzefolgeUPTOobergrenzefolgeREPcout(i);ermittlefolgenglied;IF NOTfehlerTHENinitstuetzpunkte(funktion,untergrenzefkt,obergrenzefkt,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEberechnewerteundschreibeindateiELIFfehlerTHENschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF ELSEschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF;ermittlenaeherungenEND REP.ermittlefolgenglied:replace(folgenvector,1,real(i));ntesfolgenglied:=int(result(folgenterm,folgenvector));IFiserrorORntesfolgenglied<=0ORntesfolgenglied>maxiterTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[2]ELSEfehler:=FALSE END IF.ermittlenaeherungen:FORjFROM1UPTOanzahlnumerischeverfahrenREPnaeherungen[j]:=itesangekreuztesverfahrenPER;IFmatrixzeigenTHENschreiberombergmatrixELSEschreibeergebnisseindateiEND IF.itesangekreuztesverfahren:SELECTreihenfolge[j]OF CASErechteckverfahren:sonderbehandlungrechteckverfahrenCASEtrapezverfahren:berechneundueberpruefefehler(REAL PROCtrapezintegration)CASEsimpsonverfahren:berechneundueberpruefefehler(REAL PROCsimpsonintegration)CASErombergverfahren:berechneundueberpruefefehler(REAL PROC
+rombergintegration)OTHERWISE""END SELECT.sonderbehandlungrechteckverfahren:IFrechteckstuetze<>mitteTHENberechneundueberpruefefehler(REAL PROCrechtecksintegration)ELSE DATASPACE VARstdstuetzpunkte:=ds;REAL VARhalbesintervall:=(obergrenzefkt-untergrenzefkt)/real(ntesfolgenglied)/2.0;TEXT VARzwischenergebnis;initstuetzpunkte(funktion,untergrenzefkt+halbesintervall,obergrenzefkt+halbesintervall,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEermittlenaeherungenEND IF;IFfehlerTHENintegrationsfehlerELSEzwischenergebnis:=berechneundueberpruefefehler(REAL PROCrechtecksintegration);forget(ds);ds:=stdstuetzpunkte;forget(stdstuetzpunkte);zwischenergebnisEND IF END IF.schreibefehlermeldungindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));write(f,senkrecht+blank+integrationsfehler);line(f);fehler:=FALSE.schreibeergebnisseindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));FORjFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[j]<>0THENwrite(f,senkrecht+text(naeherungen[j],spaltenbreite))END IF PER;line(f).schreiberombergmatrix:INT VARzeile,spalte;FORzeileFROM1UPTOschachtelungen+1REP FORspalteFROM1UPTOzeileREPput(f,wandle(matrix[spalte][zeile+1-spalte]))PER;line(f)PER.setzekoordinaten:IFmatrixzeigenTHENerstespalte:=1ELSEerstespalte:=13;END IF;erstersatz:=2+LENGTHparameterEND PROCerzeugenaeherungsfolge;TEXT PROCberechneundueberpruefefehler(REAL PROCverfahren):REAL VARergebnis;TEXT VARzeile;integrationsfehler:="";ergebnis:=verfahren;IFintegrationsfehler=""THENzeile:=wandle(ergebnis)ELSEzeile:=center(spaltenbreite,integrationsfehler)END IF;zeileEND PROCberechneundueberpruefefehler;PROCberechneintegral(ABBILDUNG CONSTeingegebenefunktion):ABBILDUNG VARabb:=eingegebenefunktion,folge;VECTOR VARvec:=vector(laenge(abbildungsvariablen(abb)));TERM VARvarterm;TAG VARt:=formular(20);ROW100TEXT VARtexte;INT VARfeldnummer,varindex,lowerfolge,upperfolge,nrgraphverfahren,i,zeile,spalte;REAL VARlowerfkt,upperfkt;TEXT VARfolgenname,fehlermeldung;BOOL VARnumerisch;ROWanzahlnumerischeverfahrenINT VARreihenfolge;WINDOW VARw:=window(2,7,77,16);FORiFROM1UPTOlength(vec)REPreplace(vec,i,0.0)END REP;disablestop;setzedefaultgraph;firsttime:=TRUE;ueberpruefeeingangsfunktion;schreibearbeitsfunktion(eingegebenefunktion);setzedefaultwerteinmaske;REPfootnote(anwendungstext(115));bearbeiteeinefunktionUNTILausstiegszeichen=naechsteORausstiegszeichen=menueEND REPEAT;forget(ds);verfahrensende(ausstiegszeichen).ueberpruefeeingangsfunktion:IFlaenge(abbildungsterme(abb))<>1THENverfahrensende(naechste);gibmeldung(anwendungstext(155));LEAVEberechneintegralELIFkomplexefunktion(abb)THENabb:=aufloesung(abb)END IF.setzedefaultwerteinmaske:BOOL VARfeld2sperren:=ebene=1CORlaenge(abbildungsvariablen(abb))=1;INT VARersteseingabefeld;feldnummer:=2;IFfeld2sperrenTHENsetfieldinfos(t,2,TRUE,TRUE,FALSE);feldnummer:=3END IF;texte[2]:=NAMElistenanfang(abbildungsvariablen(abb));texte[3]:="0.0";texte[4]:="1.0";texte[5]:=defaultfolge;texte[6]:="1";texte[7]:="10";ersteseingabefeld:=feldnummer.bearbeiteeinefunktion:strich(6);show(t);REPergaenzeunterstriche;putget(t,texte,feldnummer,ausstiegszeichen);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstiegszeichen:=naechsteEND IF UNTILpos(weiter+naechste+menue+info,ausstiegszeichen)>0END REPEAT;ueberpruefeverlasszeichen.ergaenzeunterstriche:FORiFROMersteseingabefeldUPTO7REPtexte[i]CAT((zahlstellen-length(texte[i]))*"_")PER.ueberpruefeverlasszeichen:IFausstiegszeichen=naechsteORausstiegszeichen=menueTHENverfahrensende(ausstiegszeichen);LEAVEberechneintegralELIFausstiegszeichen=infoTHEN IFfeld2sperrenTHENgibinfofensteraus(w,18)ELSEgibinfofensteraus(w,19)END IF ELSEueberpruefeargumente;lasseggfparametereingeben;lasseverfahrenauswaehlen;berechneundzeigeergebnis;loeschetemporaerevariablenEND IF.ueberpruefeargumente:FORiFROM2UPTO7REPchangeall(texte[i],"_","")PER;ueberpruefevariable;ueberpruefefunktionsgrenzen;ueberpruefefolge;ueberpruefefolgengrenzen.ueberpruefevariable:varterm:=listenposition(
+abbildungsvariablen(abb),texte[2]);IFvarterm=nilTHENgibmeldung(anwendungstext(147)+compress(texte[2])+anwendungstext(148));feldnummer:=2;zurueckzumaskeELSEvarindex:=PLATZvartermEND IF.ueberpruefefunktionsgrenzen:lowerfkt:=realzahl(texte[3]);IFiserrorTHENclearerror;feldnummer:=3;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfkt:=realzahl(texte[4]);IFiserrorTHENclearerror;feldnummer:=4;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfkt>upperfktTHENfeldnummer:=4;gibmeldung(anwendungstext(160));zurueckzumaskeEND IF.ueberpruefefolge:folgenname:=scratchfunctionname;folge:=neuefunktion(folgenname+":n->"+texte[5]);IFkomplexefunktion(folge)THEN ABBILDUNG VARzwischen:=folge;folge:=aufloesung(folge);loescheabbildung(zwischen)END IF;IFiserrorTHENclearerror;gibmeldung(errormessage);feldnummer:=5;zurueckzumaskeELIFlaenge(abbildungsvariablen(folge))<>1THENgibmeldung(anwendungstext(151));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeELIFlaenge(abbildungsterme(folge))<>1THENgibmeldung(anwendungstext(162));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeEND IF.ueberpruefefolgengrenzen:lowerfolge:=int(realzahl(texte[6]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=6;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfolge:=int(realzahl(texte[7]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=7;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfolge>upperfolgeTHENfeldnummer:=6;gibmeldung(anwendungstext(161));loescheabbildung(folge);zurueckzumaskeEND IF.zurueckzumaske:ausstiegszeichen:=weiter;LEAVEbearbeiteeinefunktion.lasseggfparametereingeben:IF LENGTHvec<>1THENcursor(1,5);out(anwendungstext(74));REPcursor(12,5);belegeparameter(vec,varindex,abbildungsvariablen(abb),menue+weiter+naechste+info,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfofensteraus(w,8);strich(6);footnote(anwendungstext(115))ELIFausstiegszeichen=menueORausstiegszeichen=naechsteTHENverfahrensende(ausstiegszeichen);loescheabbildung(folge);LEAVEberechneintegralEND IF UNTILausstiegszeichen=weiterEND REPEAT;cursor(1,5);out(del)END IF.lasseverfahrenauswaehlen:THESAURUS VARth:=emptythesaurus;REPth:=some(24,7,56,15,verfuegbareverfahren,anwendungstext(173),anwendungstext(182));IFlsexitkey=menueTHENverfahrensende(menue);loescheabbildung(folge);LEAVEberechneintegralEND IF;IFauswahlgueltig(th,reihenfolge,nrgraphverfahren,fehlermeldung,numerisch)THEN LEAVElasseverfahrenauswaehlenEND IF;gibmeldung(fehlermeldung)END REP.berechneundzeigeergebnis:INT VARerstersatz,erstespalte;TEXT VARausstiegszeichen;IFrechteckverfahrenausgewaehltTHENsonderfunktionenrechteckverfahren;IFrechteckstuetze=0THENloescheabbildung(folge);verfahrensende(menue);LEAVEberechneintegralEND IF END IF;IFnumerischTHENfootnote(anwendungstext(117));tabellenname:=scratchdateiname;erzeugenaeherungsfolge(lowerfkt,upperfkt,lowerfolge,upperfolge,folge,abb,varindex,vec,reihenfolge,erstersatz,erstespalte);zeile:=erstersatz;spalte:=erstespalte;outframe(w);REPfootnote(anwendungstext(115));scroll(w,tabellenname,spalte,zeile,spaltenbreite+1,erstersatz,erstespalte,weiter+naechste+menue+info+escdrucken,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfoaus(9)ELIFausstiegszeichen=escdruckenTHENdruckedietabelleEND IF UNTILausstiegszeichen<>infoCANDausstiegszeichen<>escdruckenEND REPEAT;forget(tabellenname,quiet)ELSEgraphischeveranschaulichung(nrgraphverfahren,texte,eingegebenefunktion,abb,varindex,lowerfkt,upperfkt,vec,folge,lowerfolge,upperfolge,ausstiegszeichen)END IF.druckedietabelle:aufbereitetdrucken(tabellenname,funktionsstring(eingegebenefunktion),spalte,zeile,spaltenbreite+1);outframe(w).loeschetemporaerevariablen:loescheabbildung(folge);feldnummer:=ersteseingabefeld.rechteckverfahrenausgewaehlt:nrgraphverfahren=rechteckverfahrenOR(thCONTAINSverfahrensname[1])END PROCberechneintegral;PROCgibinfoaus(INT CONSTnr):show(formular(nr));warteEND PROCgibinfoaus;BOOL PROCauswahlgueltig(THESAURUS CONSTauswahl,ROWanzahlnumerischeverfahrenINT VARreihenfolge,INT
+ VARnrgraphverfahren,TEXT VARevtlfehlertext,BOOL VARnumerisch):INT VARindex:=0,index2,naechstereintraginreihung:=1,numerischeverfahrenausgewaehlt:=0,graphischeverfahrenausgewaehlt:=0;TEXT VAReintrag;bildelisten;listensindkorrekt.bildelisten:nrgraphverfahren:=0;get(auswahl,eintrag,index);WHILEeintrag<>""REPindex2:=link(verfuegbareverfahren,eintrag);IFindex2=2CORindex2=4THENgraphischeverfahrenausgewaehltINCR1;nrgraphverfahren:=index2DIV2ELSEnumerischeverfahrenausgewaehltINCR1;reihenfolge[naechstereintraginreihung]:=(index2+2)DIV2;naechstereintraginreihungINCR1END IF;get(auswahl,eintrag,index)END REPEAT;FORindexFROMnaechstereintraginreihungUPTOanzahlnumerischeverfahrenREPreihenfolge[index]:=0END REPEAT.listensindkorrekt:numerisch:=numerischeverfahrenausgewaehlt<>0;IFnumerischTHEN IFgraphischeverfahrenausgewaehlt<>0THENevtlfehlertext:=anwendungstext(164);FALSE ELSE TRUE END IF ELSE IFgraphischeverfahrenausgewaehlt=1THEN TRUE ELSE IFgraphischeverfahrenausgewaehlt=0THENevtlfehlertext:=anwendungstext(167)ELSEevtlfehlertext:=anwendungstext(165)END IF;FALSE END IF END IF END PROCauswahlgueltig;PROCgraphischeveranschaulichung(INT CONSTnr,ROW100TEXT VARtexte,ABBILDUNG CONSToriginal,fkt,INT CONSTvarind,REAL CONSTlinkegrenze,rechtegrenze,VECTOR CONSTparameterwerte,ABBILDUNG CONSTfolge,INT CONSTfolgenanfang,folgenende,TEXT VARausstiegszeichen):TEXT VARmessage;BOOL VARzeichnungliegtvor:=FALSE;bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(original,"Integral");cursor(2,3);out(funktionszeile);cursor(2,4);out(folgenzeile);schreibebegleittext(nr).funktionszeile:"Variable "+texte[2]+"   von "+texte[3]+" bis "+texte[4].folgenzeile:"Anzahl der Intervalle a(n) = "+texte[5]+"   für n von "+texte[6]+" bis "+texte[7].fuehregraphischeveranschaulichungdurch:BOOL VARaufbauen;initialisierevariablen;REPaufbauen:=TRUE;gibdasbildderfunktionaus;berechnedasfolgenglied;berechnestuetzpunkte;gibinfos;zeichnevierecke;verarbeiteeingabezeichen;zeichnefusszeile("");IF NOTaufbauenTHENzeichnevierecke;deletelastpictureEND IF PER.initialisierevariablen:BOOL VARfehler:=FALSE;INT VARaktuellesfolgenglied:=folgenanfang,folgenresultat,offset1,offset2;VECTOR VARfolgenvector:=vector(1);TERM VARfolgenterm:=AUSDRUCKlistenanfang(abbildungsterme(folge));REAL VARrand:=0.1*(rechtegrenze-linkegrenze),linkerrand:=linkegrenze-rand,rechterrand:=rechtegrenze+rand;IFnr=2THENoffset1:=1;offset2:=2ELIFrechteckstuetze<rechtsTHENoffset1:=1;offset2:=1ELSEoffset1:=2;offset2:=2END IF.gibdasbildderfunktionaus:IFfirsttimeTHENberechnekoordinatensystem(fkt,linkerrand,rechterrand,parameterwerte,varind);firsttime:=FALSE END IF;IFzeichnungliegtvorTHENplotscreenmemoryELSEzeichnekoordinatensystem;normalgraphzeichnen(fkt,parameterwerte,varind);graphfenstereinstellen;pen(1,1,1,sekantenstift);newpicture(sekantenstift);zeichneasymptote(linkegrenze);zeichneasymptote(rechtegrenze);zeichnungliegtvor:=TRUE END IF.berechnedasfolgenglied:replace(folgenvector,1,real(aktuellesfolgenglied));folgenresultat:=int(round(result(folgenterm,folgenvector),0));IFiserrorCORfolgenresultat<=0CORfolgenresultat>maxiterTHENclearerror;fehler:=TRUE;message:=anwendungstext(212);LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechnestuetzpunkte:IFnr=1CANDrechteckstuetze=mitteTHEN REAL VARhalbesintervall:=(rechtegrenze-linkegrenze)/real(folgenresultat*2);initstuetzpunkte(fkt,linkegrenze+halbesintervall,rechtegrenze+halbesintervall,folgenresultat+1,varind,parameterwerte,fehler)ELSEinitstuetzpunkte(fkt,linkegrenze,rechtegrenze,folgenresultat+1,varind,parameterwerte,fehler)END IF;IFfehlerTHENmessage:=anwendungstext(213);LEAVEfuehregraphischeveranschaulichungdurchEND IF.gibinfos:cursor(56,11);out(text(folgenresultat,4));cursor(56,14);out(text(compress(wandle(wert)),23)).wert:IFnr=1THENrechtecksintegrationELSEtrapezintegrationEND IF.zeichnevierecke:INT VARz;REAL VARxwert1:=linkegrenze,
+streifenbreite:=(rechtegrenze-linkegrenze)/real(folgenresultat);IFaufbauenTHENpen(1,1,1,lotstift)ELSEpen(0,0,0,1)END IF;newpicture(lotstift);FORzFROM0UPTOfolgenresultat-1REPmatmove(xwert1,0.0);matdraw(xwert1,stuetzpunkte[z+offset1]);xwert1:=linkegrenze+real(z+1)*streifenbreite;matdraw(xwert1,stuetzpunkte[z+offset2]);matdraw(xwert1,0.0)END REP;IF NOTaufbauenTHENdeletelastpictureEND IF.verarbeiteeingabezeichen:TEXT VARch;zeichnefusszeile(anwendungstext(206));REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstiegszeichen);SELECTpos(graphdefinieren+weiter+naechste+menue,ausstiegszeichen)OF CASE1:definierebereich;LEAVEverarbeiteeingabezeichenCASE2,3,4:LEAVEfuehregraphischeveranschaulichungdurchOTHERWISEout(bell)END SELECT ELIFmehrerefolgengliederCANDch="+"CANDaktuellesfolgenglied<folgenendeTHENaktuellesfolgengliedINCR1;aufbauen:=FALSE;LEAVEverarbeiteeingabezeichenELIFmehrerefolgengliederCANDch="-"CANDaktuellesfolgenglied>folgenanfangTHENaktuellesfolgengliedDECR1;aufbauen:=FALSE;LEAVEverarbeiteeingabezeichenELIFch=druckenTHENdruckegraphELIFch=protokollTHENzeigeprotokolldesgraphenELSEout(bell)END IF END REP.zeigeprotokolldesgraphen:gibprotokollaus(anwendungstext(99),"dwqm",ausstiegszeichen);IFausstiegszeichen=weiterTHENschreibebegleittext(nr);gibinfos;zeichnefusszeile(anwendungstext(206))ELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.mehrerefolgenglieder:folgenanfang<>folgenende.definierebereich:cursor(56,19);out(loeschzeile);cursor(56,18);out(loeschzeile);cursor(56,17);out(loeschzeile);cursor(56,16);out(loeschzeile);cursor(56,14);out(loeschzeile);cursor(56,13);out(loeschzeile);graphfenstereinstellen;loeschezeichnung;definitionsmenu(TRUE,ausstiegszeichen);IFausstiegszeichen<>weiterTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;initkoordinatensystem;zeichnungliegtvor:=FALSE;firsttime:=TRUE;linkerrand:=koordinatensystemxmin;rechterrand:=koordinatensystemxmax;schreibebegleittext(nr).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(message);fehler:=FALSE END IF;beendegraphikarbeit;endplot;plotend;IFausstiegszeichen=weiterTHENschreibestatuszeile("Integral");schreibearbeitsfunktion(original);IFfehlerTHENgibmeldung(message)END IF END IF END PROCgraphischeveranschaulichung;PROCschreibebegleittext(INT CONSTnr):cursor(56,7);out(ueberschrift[nr]);cursor(56,8);out(unterstrich[nr]);cursor(56,10);out(anwendungstext(241));cursor(56,13);out(anwendungstext(242));cursor(56,16);out(anwendungstext(243));cursor(56,17);out(anwendungstext(244));cursor(56,18);out(anwendungstext(245));cursor(56,19);out(anwendungstext(246))END PROCschreibebegleittext;PROCsonderfunktionenrechteckverfahren:THESAURUS VARth:=emptythesaurus;INT VARi;FORiFROM1UPTO3REPinsert(th,rechteckstuetztext[i])PER;rechteckstuetze:=0;REPrechteckstuetze:=link(th,one(24,7,56,15,th,anwendungstext(79),anwendungstext(80)));IFrechteckstuetze=0ANDlsexitkey<>menueTHENgibmeldung(anwendungstext(167))END IF UNTILrechteckstuetze<>0ORlsexitkey=menuePER END PROCsonderfunktionenrechteckverfahren;END PACKETintegrationsverfahren;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren
new file mode 100644
index 0000000..5c6c90e
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren
@@ -0,0 +1,5 @@
+PACKETiterationsverfahrenDEFINESberechnefixpunkt:LETesc="�",bell="�",unterstrich="_",graphicstandardtasten="wvqm",protokoll="p",protokolldrucken="d",drucken="D",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",graphdefinieren="e",anzahlmoeglicherteilverfahren=2,fixpunktverfahren1="Iterationsverfahren - tabellarisch",fixpunktverfahren2="Iterationsverfahren - graphisch",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;PROCberechnefixpunkt(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1CANDlaenge(abbildungsvariablen(f))<>laenge(abbildungsterme(f))THENgibmeldung(anwendungstext(183));LEAVEberechnefixpunktEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).bestimmeanzuwendendeoperation:WINDOW VARwausgabe:=window(2,7,77,16);TEXT VARverfahrensname;INT VARzeile;schreibestatuszeile("Iteration");IFlaenge(abbildungsterme(f))<>1THENverfahrensname:=fixpunktverfahren1;LEAVEbestimmeanzuwendendeoperationEND IF;REPverfahrensname:=one(24,7,56,15,fixpunktverfahrensnamen,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnefixpunktEND IF END REP.initialisieredienoetigenvariablen:INT VARvariablenindex:=1,anzahlderiterationsschritte:=10;REAL VARstartwert:=0.0;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,variablenindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;setzedefaultgraph.fuehreoperationaus:REP IFlaenge(abbildungsterme(f))=1THENbestimmevorgabenfuereinfacheiterationsfolgeELSE IFverfahrensname=fixpunktverfahren2THENgibmeldung(anwendungstext(88));LEAVEfuehreoperationausEND IF;bestimmevorgabenfuerkomplexeiterationsfolgeEND IF;IFverfahrensname=fixpunktverfahren1THEN TEXT VARdatname:=scratchdateiname;FILE VARsf:=sequentialfile(output,datname);iteration(sf,f,eingabevektor,variablenindex,anzahlderiterationsschritte);zeigeergebnisse;forget(datname,quiet)ELSEzeichnecobwebmusterEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmevorgabenfuereinfacheiterationsfolge:initialisiereeingabemaskefueriterationsfolge;REPeditiereeingabemaske;werteausstiegszeichenausEND REP.initialisiereeingabemaskefueriterationsfolge:TAG VAReingabemaske:=formular(6);PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;IFvariablenindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),variablenindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaske:IF NOTvariablenindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(startwert)+kurzerstrich;raster(4):=text(anzahlderiterationsschritte)+kurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegszeichenaus:INT VARhilf1;REAL VARhilf2;SELECTpos(standardtasten,ausstieg)OF CASE1:IFvariablenindexbestimmtTHENgibinfofensteraus(wausgabe,15)ELSEgibinfofensteraus(wausgabe,14)END IF;CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHENanzahlderiterationsschritte:=hilf1;startwert:=hilf2;IF NOTvariablenvectorbestimmtTHENcursor(1,4);out("Parameter  :");belegediefunktionsparameterEND IF;LEAVEbestimmevorgabenfuereinfacheiterationsfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT.alleeingabenkorrekt:korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:=
+listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvariablenindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);hilf2:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,variablenindex,hilf2);TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);hilf1:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(97));clearerror;FALSE ELIFlastconversionokCANDhilf1>0CANDhilf1<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(14,4);belegeparameter(eingabevektor,variablenindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:outframe(wausgabe);show(formular(8));warte;page(wausgabe,TRUE)CASE2:cursor(1,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT;END REP.bestimmevorgabenfuerkomplexeiterationsfolge:bestimmeschrittanzahl;bestimmestartwerte.bestimmeschrittanzahl:INT VARhilf;cursor(1,3);out(anwendungstext(98));REPfootnote(anwendungstext(184));TEXT VAReingabe:=text(anzahlderiterationsschritte);eingabeCATkurzerstrich;cursor(32,3);enablestop;editget(eingabe,20,5,niltext,standardtasten,ausstieg);disablestop;SELECTpos(standardtasten,ausstiegSUB2)OF CASE1:gibinfofensteraus(wausgabe,21)CASE2:IFeingabekorrektTHENanzahlderiterationsschritte:=hilf;LEAVEbestimmeschrittanzahlELSEgibmeldung(anwendungstext(116))END IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstiegSUB2);LEAVEberechnefixpunktEND SELECT END REP.eingabekorrekt:changeall(eingabe,unterstrich,niltext);hilf:=int(eingabe);IFiserrorTHENclearerror;FALSE ELSElastconversionokCANDhilf>0CANDhilf<4001END IF.bestimmestartwerte:variablenindex:=0;cursor(1,4);out(anwendungstext(119));belegediefunktionsparameter.zeigeergebnisse:INT VARersterauszugebendersatz:=3,ersteauszugebendespalte:=8,scrzeile;IFlaenge(abbildungsterme(f))=1THENersterauszugebendersatzINCR(length(eingabevektor)-1)END IF;scrzeile:=ersterauszugebendersatz;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,scrzeile,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,scrzeile,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT END REP.zeichnecobwebmuster:bereitegraphischeveranschaulichungvor;fuehreveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,"Iteration");cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+"        "+"Anzahl der Iterationsschritte: "+raster[4].fuehreveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARfbild:=f;BOOL VARloeschflag:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvariablenindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f)THENloeschflag:=TRUE;fbild:=aufloesung(f)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(fbild,linkerrand,
+rechterrand,eingabevektor,variablenindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(fbild,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehreveranschaulichungdurchEND IF;gibinfos;graphfenstereinstellen;pen(1,1,1,aktuellerstift);move(folgenwert,folgenwert);matdraw(folgenwert,funktionswert);matdraw(funktionswert,funktionswert).gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)).verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehreveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgenglied<anzahlderiterationsschritteTHENaktuellesfolgengliedINCR1;folgenwert:=funktionswert;replace(eingaben,variablenindex,folgenwert);LEAVEverarbeiteeingabezeichenELIFch=protokollTHENzeigeprotokollELIFch=druckenTHENdruckegraphEND IF;out(bell)END REP.definierebereich:loeschetexte;graphfenstereinstellen;loeschezeichnung;initkoordinatensystem;firsttime:=FALSE;definitionsmenu(TRUE,ausstieg);IFausstieg<>weiterarbeitTHEN LEAVEfuehreveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,variablenindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(fbild,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,variablenindex)END IF;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert).zeigeprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehreveranschaulichungdurchEND IF.beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5)CASE2:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEberechnefixpunktEND SELECT END PROCberechnefixpunkt;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTvariablenindex,REAL CONSTlinkerrand,rechterrand,folgenwert):zeichnekoordinatensystem;normalgraphzeichnen(f,eingabevektor,variablenindex);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(linkerrand,linkerrand);matdraw(rechterrand,rechterrand);pen(1,1,1,neuerstift);newpicture(aktuellerstift);zeichnetexte;graphfenstereinstellen;matmove(folgenwert,0.0)END PROCzeichnegraphenderarbeitsfunktion;THESAURUS PROCfixpunktverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(fixpunktverfahren1,fixpunktverfahren2);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCfixpunktverfahrensnamen;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,VECTOR CONSTeingaben,INT CONSTvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion;BOOL VARloeschflag:=FALSE;IFkomplexefunktion(f1)THENf1:=aufloesung(f1);loeschflag:=TRUE END IF;footnote(anwendungstext(117));cursor(36,24);maxlinelength(f,1000);schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflagTHENloescheabbildung(f1)END IF.schreibetabellenueberschriften:IFlaenge(abbildungsterme(f1))>1THENspeziellestabellentitelformatELSEallgemeinestabellentitelformatEND IF.speziellestabellentitelformat:TEXT VARtitelzeile:="n     ";FORiFROM1UPTOlength(eingaben)REP
+titelzeileCATsenkrecht;titelzeileCATtext(NAMEauswahl(abbildungsvariablen(f1),i),gesamtstellen(ebene))END REP;putline(f,titelzeile);titelzeile:=6*waagerecht;FORiFROM1UPTOlength(eingaben)REPtitelzeileCATkreuz;titelzeileCATgesamtstellen(ebene)*waagerechtEND REP;putline(f,titelzeile).allgemeinestabellentitelformat:FORiFROM1UPTOlength(eingaben)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(abbildungsvariablen(f1),i),8)+" = "+wandle(eingabenSUBi))END IF END REP;putline(f,"n     "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),varindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevector:=eingaben;INT VARi,j;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6));IFlaenge(abbildungsterme(f1))>1THENspeziellestabellenzeilenformatELSEallgemeinestabellenzeilenformatEND IF END REP.speziellestabellenzeilenformat:FORjFROM1UPTOlength(eingaben)REPwrite(f,senkrecht+wandle(eingabevectorSUBj))END REP;line(f);eingabevector:=ergebnis(f1,eingabevector);IFiserrorTHENclearerror;putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF.allgemeinestabellenzeilenformat:REAL VARy:=ergebnis(f1,eingabevector)SUB1;IFiserrorTHENclearerror;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+wandle(y));replace(eingabevector,varindex,y).testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF END PROCiteration;END PACKETiterationsverfahren;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot
new file mode 100644
index 0000000..781c3f9
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot
@@ -0,0 +1,3 @@
+PACKETkyoceraplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz:LETxcm=29.7,ycm=19.7,bit14=16384,plotterunitspercm=118.1102;LETinitcmd="!R! UNIT d; SPO L;";LETleavecmd="SPO P; EXIT;",separator=",",terminator=";",movecmd="MZP ",drawcmd="DZP ";INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=15;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,printerchannel:=15;horpixel:=3507;verpixel:=2330;horfaktor:=300.0/2.54;vertfaktor:=300.0/2.54;INT VARxpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:toplotterchannel;out(initcmd)ENDPROCbeginplot;PROCendplot:plotendENDPROCendplot;PROCplotend:IFchannel=plotterchannelTHENout(leavecmd);toterminalchannelEND IF ENDPROCplotend;PROCclear:END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.movetoxy:xpos:=xx;ypos:=yy;TEXT VARky:=movecmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.drawtoxy:xpos:=xx;ypos:=yy;TEXT VARky:=drawcmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(
+xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:disablestop;continue(terminalchannel);IFiserrorTHENclearerror;break(quiet)END IF;enablestopEND PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETkyoceraplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot
new file mode 100644
index 0000000..d7a888d
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot
@@ -0,0 +1,3 @@
+PACKETlaserjetplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LETesc="�",reset="�E",graphicsresolution="�*t75R",formfeed="�",landscape="�&I1O",horpixel=800,verpixel=560,intsperscanline=50,horfaktor=29.52756,vertfaktor=29.52756,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARxpos,ypos,xfak,yfak,plotterchannel,groesstexkoord,groessteykoord,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.76,buchstabenbreite:=0.3375,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=27.0;ycm:=19.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARspaltenbeginn:=(groesstexkoordDIV16)+1,zeilenbeginn:=groessteykoord+1;TEXT VARdoppelbyte:="xx";druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out(reset);out(landscape);out(graphicsresolution);out("�*r1A").gibdiebitmapaus:INT VARzeilenzaehler;FORzeilenzaehlerFROMzeilenbeginnDOWNTO1REPbefehlssequenzschickenPER.befehlssequenzschicken:out(esc+"*b"+text(neueanzahlderbytes)+"W");gibteilzeileaus.neueanzahlderbytes:(spaltenbeginnDIV8)+1.gibteilzeileaus:INT VARspaltenzaehler;FORspaltenzaehlerFROM1UPTOneueanzahlderbytesDIV2REPreplace(doppelbyte,1,bitmap(zeilenzaehler)(spaltenzaehler));out(doppelbyte)PER.druckedieseite:out("�*rB");out("�E").END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD
+12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETlaserjetplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.masken b/app/schulis-mathematiksystem/1.0/src/mat.masken
new file mode 100644
index 0000000..972f0fc
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.masken
@@ -0,0 +1,4 @@
+PACKETmaskenDEFINES TAG,:=,tagsankoppeln,formular,show,putget,setfieldinfos:LETbeginmark="",endmark="",chome=1,choch=3,cfeldrueck=19,crunter=10,ctab=9,cfeldvor=13,cesc=27,right="�",left="�",taglines=24,maxfields=100;TEXT VARabc:="";INT VARi;FORiFROM33UPTO39REPabcCATcode(i)PER;FORiFROM42UPTO59REPabcCATcode(i)PER;FORiFROM62UPTO90REPabcCATcode(i)PER;FORiFROM97UPTO122REPabcCATcode(i)PER;FORiFROM214UPTO220REPabcCATcode(i)PER;abcCATcode(251);BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;TYPE TAG=STRUCT(TEXTerstel,darst,diainfo,dbnam,ausknam,feld,x,y,len,tab,ROWtaglinesTEXTformblatt,INTxmax,ymax,xs,ys,dbp,ver,durchs,art);OP:=(TAG VARa,TAG CONSTb):CONCR(a):=CONCR(b)END OP:=;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE END IF.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE END IF END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbitEND IF END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32END IF;IFprotectedTHENcdINCR64END IF;IFclosedTHENcdINCR128END IF;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:outsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feldVSUBael)<>afeld.gibrestaus:outsubtext(t,tout+1,tlen);IFtout+al>tlenTHENoutsubtext(grund,ax+tlen-tout,ax+al-1)END IF.gibhintergrundaus:outsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay)END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay)END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0END IF;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeldUNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBaelEND PROClength;PROCshow(TAG CONSTff):INT VARi;FORiFROM1UPTOff.ymaxREPcursor(1,i);out(ff.formblatt(i))END REP END PROCshow;INT VARcharcode:=0,lastx,lasty;INT VARaktbegin,aktfeld,aktel,wo;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;END PROCsetneweditvalues;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEi<nextelREPnextbeginINCR(t.lenVSUBi);iINCR1PER;nextwo:=nextbegin+x-anfangEND IF.sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y),
+nextel+1).keinsmehrda:nextel=0.xposstimmt:erfolg:=anfang<=xANDende>x;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):enablestop;put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)END IF PER END PROCput;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)END IF END IF END PROCput;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldEND IF;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorEND IF END IF;executecommandcode(ff,feld);IFfeld=1THENfeld:=2END IF UNTILcharcode=cescPER;END IF.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste).eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(ff,feld)+30,length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);cursor(lastx+length(ff,feld),lasty);out(endmark);IFankreuzenTHENerrorstop("Ankreuzfelder gibt's bei 'Mathe' nicht!")END IF;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2)END IF END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:END SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldEND IF.tonextfield:REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENtohomefieldEND IF.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=50,dsname="mathe formulare",depottask="ls-MENUKARTEN";BOUND ROWmaxtagsTAG VARmatheformulare;PROCtagsankoppeln:IF NOTexists(dsname)THENfetch("mathe formulare",/depottask)END IF;matheformulare:=old("mathe formulare")END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))END IF;matheformulare(i)END PROCformular;LETnil13byte="�������������",nil4byte="����",nilbyte="�";PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCAT
+nil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt<woREPtCATnilbytePER END PROCstretch;INT OP VSUB(TEXT CONSTstring,INT CONSTpos):code(stringSUBpos)END OP VSUB;END PACKETmasken
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen b/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen
new file mode 100644
index 0000000..a574469
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen
@@ -0,0 +1,7 @@
+PACKETmenufunktionenDEFINESeingang1,eingang2,funktionsverwaltungseingang,ausgang,eingabe,ausgabe,zeigen,beseitigen,sichern,laden,bestimmenachkommastellen,bestimmehalbgraphiczeichen,bestimmeformeleditoreinsatz,bestimmeformeleditorzeichensatz,bestimmedruckseitenformat,verfahren,verfahrensende,formeleditoraktiv,liefereformeleditorformat,raeumeauf:LETzentral=5,mitreinigung=TRUE,ohnereinigung=FALSE,ohneabbruch=FALSE,niltext="",bell="�",del="�",blank=" ",unterstrichzeichen="_",doppelpunkt=":",trennzeichen="!",maxfunktionen=10,maxfelder=100,menupunktende="m",zusatztasten="fsm",eingabeprocname="eingeben",ladeprocname="laden",loeschprocname="löschen",ausgabeprocname="ausgeben",sicherungsprocname="sichern",niveau="Ebene ",fktdatname="Funktionendatei",maximalanzahlfunktionen=200,PARAMETER=ROWmaxfelderTEXT,allesok=5,fetaskname="FORMELEDITOR",formelindateischreiben=1,zeichensatzumstellen=2,formeleditieren=3;ROWmaxfunktionenTEXT VARfkttext;TEXT VARletztesescapezeichen;INT VARletztearbeitsfkt:=2;TEXT CONSTlangerstrich:=100*unterstrichzeichen;BOOL VARausgabeaktiviert:=FALSE,eingabeaktiviert:=FALSE;THESAURUS VARverzeichnisderstandardfunktionen,archivinhalt;TASK VARformeleditor;PROCeingang1:disablestop;lowlevel;initialisierefunktionentextunddeaktiviereggfEND PROCeingang1;PROCeingang2:disablestop;highlevel;initialisierefunktionentextunddeaktiviereggfEND PROCeingang2;PROCinitialisierefunktionentextunddeaktiviereggf:INT VARi;tagsankoppeln;IFexiststask(fetaskname)THENformeleditor:=/fetasknameELSEformeleditor:=niltaskEND IF;ausgabeaktiviert:=laenge(eigenefunktionen)>0;eingabeaktiviert:=laenge(eigenefunktionen)<maximalanzahlfunktionen;IF NOTausgabeaktiviertTHENdeaktiviereELSEaktiviereEND IF;IF NOTeingabeaktiviertTHENdeactivate(eingabeprocname);deactivate(ladeprocname)END IF;verzeichnisderstandardfunktionen:=standardfunktionsthesaurus;FORiFROM1UPTOmaxfunktionenREPfkttext(i):=langerstrichEND REP;letztearbeitsfkt:=2END PROCinitialisierefunktionentextunddeaktiviereggf;PROCfunktionsverwaltungseingang:disablestop;IFausgabeaktiviertTHENaktiviereEND IF;IF NOTeingabeaktiviertTHENdeactivate(eingabeprocname);deactivate(ladeprocname)END IF END PROCfunktionsverwaltungseingang;PROCausgang:disablestop;THESAURUS VARth:=all;TEXT VARdsname;INT VARn:=laenge(temporaerefunktionen),i;FORiFROM1UPTOnREPloescheabbildung(abbildung(DEFINITIONlistenanfang(temporaerefunktionen)));END REP;i:=0;get(th,dsname,i);WHILEi<>0REP IFdsname<>"mathematikobjekte 1"CANDdsname<>"mathematikobjekte 2"CANDdsname<>"mathe formulare"THENforget(dsname,quiet)END IF;get(th,dsname,i)END REP END PROCausgang;PROCeingabe:disablestop;ABBILDUNG VARg;TEXT VARstring:=niltext;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge),ueberschriftfenster;IFeingabeuebereditorTHENueberschriftfenster:=window(2,3,77,1);outframe(ueberschriftfenster);out(ueberschriftfenster,center(ueberschriftfenster,invers("Funktionseingabe")));show(eingabefenster)END IF;REPnimmeingabenentgegen;werteeingabenausEND REP.nimmeingabenentgegen:clearbuffer;IFeingabeuebereditorTHENlasseformeleditorarbeitenELSEstring:=boxanswer(eingabefenster,text(anwendungstext(63),74),string,zentral,x0,y0,xbreite,ylaenge)END IF;IFstring=niltextTHENregeneratemenuscreen;LEAVEeingabeEND IF.lasseformeleditorarbeiten:initialisierevorgabenfuerformeleditor;werteformeleditoreingabeaus.initialisierevorgabenfuerformeleditor:INT VARreplycode,workchannel:=channel;BOUND TEXT VARtextstring:=new("datenbehaelter");textstring:=string;DATASPACE VARds:=old("datenbehaelter");forget("datenbehaelter",quiet);break(quiet);call(formeleditor,formeleditieren,ds,replycode);continue(workchannel).werteformeleditoreingabeaus:textstring:=ds;string:=textstring;forget(ds).werteeingabenaus:g:=neuefunktion(string);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(134));IF NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE ELIFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHEN
+eingabeaktiviert:=FALSE;deactivate(eingabeprocname);deactivate(ladeprocname);regeneratemenuscreen;LEAVEeingabeEND IF;string:=niltextEND IF END PROCeingabe;PROCausgabe:disablestop;THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(64),niltext,ohnereinigung);IFnotempty(wunschliste)THENschreibedieausgewaehltenfunktionenineinedatei;gibdiegewuenschtenfunktionenausEND IF;regeneratemenuscreen.schreibedieausgewaehltenfunktionenineinedatei:ABBILDUNG VARfkt;TEXT CONSTdatname:=scratchdateiname;FILE VARf:=sequentialfile(output,datname);TEXT VARfunktionsname;INT VARi:=0;REPget(wunschliste,funktionsname,i);IFfunktionsname=niltextTHEN LEAVEschreibedieausgewaehltenfunktionenineinedateiEND IF;fkt:=abbildung(funktionsname);IFformeleditoraktivTHENliefereformeleditorformat(f,fkt);line(f)ELSEputline(f,funktionsstring(fkt))END IF END REP.gibdiegewuenschtenfunktionenaus:WINDOW VARu:=window(2,4,77,1),w:=window(2,7,77,16);INT VARersterauszugebendersatz:=1,ersteauszugebendespalte:=1;TEXT CONSTerlaubtezeichen:="?dm";show(u);out(u,center(u,anwendungstext(154)));outframe(w);REPfootnote(anwendungstext(135));scroll(w,datname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,erlaubtezeichen,letztesescapezeichen);werteausstiegausEND REP.werteausstiegaus:SELECTpos(erlaubtezeichen,letztesescapezeichen)OF CASE1:show(formular(13));warteCASE2:druckversuch(datname);outframe(w)CASE3:forget(datname,quiet);LEAVEgibdiegewuenschtenfunktionenausEND SELECT END PROCausgabe;PROCzeigen:disablestop;WINDOW VARw:=window(35,10,40,12);zeigeelementarefunktionsnamen;zeigebenutzerdefiniertefunktionsnamen;warte;page(w,TRUE);oldfootnote.zeigeelementarefunktionsnamen:TEXT VARtheselement,zeile;INT VARi:=0;show(w);cursor(w,1,1);out(w,center(w,anwendungstext(68)));get(verzeichnisderstandardfunktionen,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(verzeichnisderstandardfunktionen,theselement,i)END REP;out(w,center(w,zeile))END REP;line(w).zeigebenutzerdefiniertefunktionsnamen:THESAURUS VARthes:=funktionsnamenthesaurus;i:=0;out(w,center(w,anwendungstext(69)));get(thes,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;IFlength(theselement)>40THENzeileCATtheselement;get(thes,theselement,i);ELSE WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(thes,theselement,i)END REP END IF;out(w,center(w,zeile));IFremaininglines(w)=0THENwarte;page(w)END IF;END REP;out(w,center(w,anwendungstext(70)+text(laenge(eigenefunktionen))))END PROCzeigen;PROCbeseitigen:disablestop;clearbuffer;SELECTmenualternative(anwendungstext(34),anwendungstext(50),zusatztasten,zentral,ohneabbruch)MOD100OF CASE1:waehlediezuloeschendenfunktionenaus;IFnotempty(auswahl)THENzeigeloeschfensterundinitialisierevariablen;IFebene=1THENloeschedieausgewaehltenfunktionenELSEloeschedieausgewaehltenfunktionenvorsichtigEND IF;warte;IFlaenge(eigenefunktionen)=0THENdeaktiviere;ausgabeaktiviert:=FALSE ELIFlaenge(eigenefunktionen)<maximalanzahlfunktionenTHENeingabeaktiviert:=TRUE;activate(eingabeprocname);activate(ladeprocname)END IF END IF;regeneratemenuscreenCASE2:footnote(anwendungstext(61));initialisieren;deaktiviere;ausgabeaktiviert:=FALSE;oldfootnote;refreshsubmenuEND SELECT.waehlediezuloeschendenfunktionenaus:THESAURUS VARauswahl:=menusome(funktionsnamenthesaurus,anwendungstext(73),niltext,ohnereinigung).zeigeloeschfensterundinitialisierevariablen:TEXT VARname,frage;TERM VAReintrag;INT VARi:=0;WINDOW VARw:=window(2,4,77,19);show(w);out(w,center(w,anwendungstext(142)));line(w).loeschedieausgewaehltenfunktionen:get(auswahl,name,i);WHILEname<>niltextREPeintrag:=listenposition(eigenefunktionen,name);frage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;get(auswahl,name,i)END REP.
+loeschedieausgewaehltenfunktionenvorsichtig:THESAURUS VARfunktionenmitloeschverbot:=emptythesaurus;get(auswahl,name,i);WHILEname<>niltextREPeintrag:=listenposition(eigenefunktionen,name);IFreferenziertefunktion(eintrag)THENfunktionenmitloeschverbot:=funktionenmitloeschverbot+nameELSEfrage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;auswahl:=auswahl-name;funktionenmitloeschverbot:=funktionenmitloeschverbot-nameEND IF;get(auswahl,name,i)END REP;IFnotempty(funktionenmitloeschverbot)THENgibhinweisaufreferenziertefunktionenEND IF.gibhinweisaufreferenziertefunktionen:line(w);putline(w,anwendungstext(152));i:=0;get(funktionenmitloeschverbot,name,i);WHILEname<>niltextREPput(w,name);get(funktionenmitloeschverbot,name,i)END REP;line(w);putline(w,anwendungstext(153))END PROCbeseitigen;PROCsichern:disablestop;TEXT VARmeldung:=niltext,dateiname;IFarchivangemeldet(meldung)THENclearbuffer;sichereausgewaehltefunktionenELIFmeldung<>niltextTHENgibmeldung(meldung)END IF;release(archive);oldfootnote.sichereausgewaehltefunktionen:waehlefunktionenaus;IFnotempty(wunschliste)THENwaehlefunktionendateikennung;schreibefunktioneninausgewaehltedatei;sicheredateiaufdasarchiv(dateiname)END IF.waehlefunktionenaus:THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(139),niltext,mitreinigung).waehlefunktionendateikennung:TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);dateiname:=eingegebenerdateiname(fktdateipraefix);IFdateiname=niltextTHEN LEAVEsichereausgewaehltefunktionenEND IF.schreibefunktioneninausgewaehltedatei:TEXT VARfunktionsname;INT VARi:=0;FILE VARf:=sequentialfile(output,dateiname);get(wunschliste,funktionsname,i);WHILEfunktionsname<>niltextREPwrite(f,funktionsstring(abbildung(funktionsname))+trennzeichen);get(wunschliste,funktionsname,i)END REP END PROCsichern;TEXT PROCeingegebenerdateiname(TEXT CONSTpraefix):TEXT VARkurzname:=niltext,langname:=niltext;REPclearbuffer;kurzname:=compress(menuanswer(anwendungstext(65),kurzname,zentral))UNTILkurzname=niltextCORdateinamefreigegebenEND REP;IFkurzname=niltextTHENniltextELSElangnameEND IF.dateinamefreigegeben:langname:=praefix+doppelpunkt+kurzname;NOT(archivinhaltCONTAINSlangname)CORmenuyes(anwendungstext(66),zentral)END PROCeingegebenerdateiname;PROCsicheredateiaufdasarchiv(TEXT CONSTdateiname):footnote(anwendungstext(67));commanddialogue(FALSE);save(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(72))END IF;commanddialogue(TRUE);forget(dateiname,quiet)END PROCsicheredateiaufdasarchiv;PROCladen:disablestop;TEXT VARmeldung:=niltext,dateiname:=niltext;TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);IFarchivangemeldet(meldung)THEN IFnotempty(archivinhaltLIKE(fktdateipraefix+":*"))THENholeausgewaehltefunktionen;release(archive);ueberpruefeaktivierungELSErelease(archive);gibmeldung(anwendungstext(78))END IF ELIFmeldung<>niltextTHENrelease(archive);gibmeldung(meldung)END IF;oldfootnote.holeausgewaehltefunktionen:bestimmedateinamen;IFdateierfolgreicheingelesen(dateiname)THENlesefunktionenein;forget(dateiname,quiet)END IF.bestimmedateinamen:dateiname:=ausgewaehlterdateiname(fktdateipraefix,anwendungstext(81),anwendungstext(82));IFdateiname=niltextTHEN LEAVEholeausgewaehltefunktionenEND IF.lesefunktionenein:ABBILDUNG VARfkt;FILE VARf:=sequentialfile(input,dateiname);TEXT VARfunktionstext;WHILE NOTeof(f)REPget(f,funktionstext,trennzeichen);footnote(anwendungstext(145)+funktionstext+anwendungstext(146));versuchefunktioneinzutragenEND REP.versuchefunktioneinzutragen:REP IFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHENgibmeldung(anwendungstext(205));eingabeaktiviert:=FALSE;LEAVElesefunktioneneinEND IF;fkt:=neuefunktion(funktionstext);IFiserrorTHENclearerror;clearbuffer;funktionstext:=menuanswer(anwendungstext(83),funktionstext,zentral);IFlsexitkey=menupunktendeTHEN LEAVElesefunktionenein
+ELIFfunktionstext=niltextTHEN LEAVEversuchefunktioneinzutragenEND IF ELSE LEAVEversuchefunktioneinzutragenEND IF END REP END PROCladen;TEXT PROCausgewaehlterdateiname(TEXT CONSTpraefix,botschaft,ueberschrift):THESAURUS VARarchivdateien:=archivinhaltLIKE(praefix+":*");IFnotempty(archivdateien)THENmenuone(archivdateien,ueberschrift,niltext,mitreinigung)ELSEgibmeldung(botschaft);niltextEND IF END PROCausgewaehlterdateiname;BOOL PROCdateierfolgreicheingelesen(TEXT CONSTdateiname):forget(dateiname,quiet);footnote(anwendungstext(163));fetch(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE TRUE END IF END PROCdateierfolgreicheingelesen;BOOL PROCarchivangemeldet(TEXT VARmeldung):TEXT CONSTvorlaeufigerarchivname:="Mathematik";IFmenuno(anwendungstext(84),zentral)THEN LEAVEarchivangemeldetWITH FALSE END IF;footnote(anwendungstext(138));archive(vorlaeufigerarchivname);IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENergebnisderzweitenanmeldungELSE TRUE END IF END IF.ergebnisderzweitenanmeldung:meldung:=errormessage;clearerror;IFsubtext(meldung,1,14)="Archiv heisst "CANDsubtext(meldung,16,20)<>"?????"THENarchive(subtext(meldung,16,length(meldung)-1));IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSE TRUE END IF END IF ELSEmeldung:=anwendungstext(85);FALSE END IF END PROCarchivangemeldet;LETmaxnachkommastellen=12;PROCbestimmenachkommastellen:INT VARzahl;REPclearbuffer;TEXT VARanzahlnachkommastellen:=menuanswer(anwendungstext(86),text(nachkomma(ebene)),zentral);IFcompress(anzahlnachkommastellen)=niltextTHEN LEAVEbestimmenachkommastellenEND IF;zahl:=int(anzahlnachkommastellen);IFlastconversionokCANDzahl>-1CANDzahl<=maxnachkommastellenTHENsetzenachkommastellen(zahl);LEAVEbestimmenachkommastellenEND IF;out(bell)END REP END PROCbestimmenachkommastellen;PROCbestimmehalbgraphiczeichen:SELECTmenualternative(anwendungstext(93),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:ibmgraphiccharCASE2:stdgraphiccharOTHERWISE LEAVEbestimmehalbgraphiczeichenEND SELECT;regeneratemenuscreenEND PROCbestimmehalbgraphiczeichen;PROCbestimmeformeleditoreinsatz:SELECTmenualternative(anwendungstext(94),anwendungstext(95),"1234m",zentral,ohneabbruch)MOD100OF CASE1:formeleditoraktiv(TRUE);eingabeuebereditor(TRUE)CASE2:formeleditoraktiv(FALSE);eingabeuebereditor(TRUE)CASE3:formeleditoraktiv(TRUE);eingabeuebereditor(FALSE)CASE4:formeleditoraktiv(FALSE);eingabeuebereditor(FALSE)END SELECT END PROCbestimmeformeleditoreinsatz;PROCbestimmeformeleditorzeichensatz:forget("formelzeichensatz",quiet);BOUND TEXT VARformelzeichensatz:=new("formelzeichensatz");SELECTmenualternative(anwendungstext(207),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:formelzeichensatz:="ibmoperatoren"CASE2:formelzeichensatz:="standardoperatoren"OTHERWISEforget("formelzeichensatz",quiet);LEAVEbestimmeformeleditorzeichensatzEND SELECT;DATASPACE VARds:=old("formelzeichensatz");INT VARreplycode;call(formeleditor,zeichensatzumstellen,ds,replycode);forget(ds);forget("formelzeichensatz",quiet)END PROCbestimmeformeleditorzeichensatz;PROCbestimmedruckseitenformat:LETminimum=20,maximum=200;INT VARspaltenanzahl,zeilenanzahl,breite,laenge;TEXT VAReingabe;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge);druckseitenformat(spaltenanzahl,zeilenanzahl);liesspaltenanzahlein;lieszeilenanzahlein;definieredruckseitenformat(breite,laenge).liesspaltenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(215),74),text(spaltenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;breite:=int(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHEN LEAVEliesspaltenanzahleinEND IF;out(bell)END REP.lieszeilenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(216
+),74),text(zeilenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;laenge:=int(eingabe);IFlastconversionokCANDlaenge>=minimumCANDlaenge<=maximumTHENraeumebildschirmauf;LEAVElieszeilenanzahleinEND IF;out(bell)END REP END PROCbestimmedruckseitenformat;PROCraeumebildschirmauf:INT VARi;FORiFROM9UPTO14REPcursor(1,i);out(del)END REP;refreshsubmenuEND PROCraeumebildschirmauf;ROW2BOOL VARformeleditoreingeschaltet:=ROW2BOOL:(FALSE,FALSE),formeleditoreingabe:=ROW2BOOL:(FALSE,FALSE);PROCformeleditoraktiv(BOOL CONSTschalter):formeleditoreingeschaltet(ebene):=schalterEND PROCformeleditoraktiv;BOOL PROCformeleditoraktiv:formeleditoreingeschaltet(ebene)END PROCformeleditoraktiv;PROCeingabeuebereditor(BOOL CONSTschalter):formeleditoreingabe(ebene):=schalterEND PROCeingabeuebereditor;BOOL PROCeingabeuebereditor:formeleditoreingabe(ebene)END PROCeingabeuebereditor;PROCliefereformeleditorformat(FILE VARf,ABBILDUNG CONSTfkt):forget("temporaerer datenraum",quiet);BOUND TEXT VARtextformat:=new("temporaerer datenraum");textformat:=formel(fkt);DATASPACE VARds:=old("temporaerer datenraum");INT VARreplycode;call(formeleditor,formelindateischreiben,ds,replycode);wertereplycodeaus;forget(ds);forget("temporaerer datenraum",quiet).wertereplycodeaus:TEXT VARzeile,tempdat:=scratchdateiname;IFreplycode=allesokTHENcopy(ds,tempdat);FILE VARf2:=sequentialfile(input,tempdat);output(f);WHILE NOTeof(f2)REPgetline(f2,zeile);putline(f,zeile)END REP;forget(tempdat,quiet)ELSEputline(f,funktionsstring(fkt))END IF END PROCliefereformeleditorformat;PROCverfahren(PROC(ABBILDUNG CONST)auszufuehrendeprozedur,TEXT CONSTprozedurname):disablestop;ABBILDUNG VARarbeitsfunktion;REPeditierearbeitsfunktionen;ergaenzeumunterstriche;IFletztesescapezeichen=menupunktendeTHENregeneratemenuscreen;LEAVEverfahrenEND IF;auszufuehrendeprozedur(arbeitsfunktion);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage)END IF;loeschetemporaereabbildung(arbeitsfunktion)UNTILletztesescapezeichen=menupunktendeEND REP;regeneratemenuscreen.editierearbeitsfunktionen:initialisieredievariablen;schreibestatuszeile(prozedurname);editiere.initialisieredievariablen:PARAMETER VARraster;INT VARi;TAG VAReingabemaske:=formular(1);raster(1):=niltext;FORiFROM1UPTOmaxfunktionenREPraster(i+1):=fkttext(i)END REP.editiere:REPbearbeiteeingabeformular;werteausstiegausEND REP.bearbeiteeingabeformular:footnote(anwendungstext(189));show(eingabemaske);putget(eingabemaske,raster,letztearbeitsfkt,letztesescapezeichen);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage);letztesescapezeichen:=menupunktende;LEAVEeditiereEND IF.werteausstiegaus:SELECTpos("?zwm",letztesescapezeichen)OF CASE1:gibinformationzumformularCASE2:zeigenCASE3:IFkorrekteeingabeTHEN LEAVEeditierearbeitsfunktionenEND IF CASE4:LEAVEeditiereEND SELECT.korrekteeingabe:INT VARdoppelpunktlage:=pos(raster(letztearbeitsfkt),doppelpunkt);TEXT VARfstring:=raster(letztearbeitsfkt);footnote(anwendungstext(114));changeall(fstring,unterstrichzeichen,niltext);IFcompress(fstring)=niltextTHENgibmeldung(anwendungstext(190));FALSE ELSE IFselbstdefiniertefunktionTHEN IF NOTeingabeaktiviertTHENgibmeldung(anwendungstext(205));LEAVEkorrekteeingabeWITH FALSE END IF;arbeitsfunktion:=neuefunktion(fstring)ELSEarbeitsfunktion:=funktionsaufruf(fstring)END IF;IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE IFselbstdefiniertefunktionTHENraster(letztearbeitsfkt):=text(raster(letztearbeitsfkt),doppelpunktlage-1);ausgabeaktiviert:=laenge(eigenefunktionen)>=1;eingabeaktiviert:=laenge(eigenefunktionen)<maximalanzahlfunktionen;END IF;TRUE END IF END IF.selbstdefiniertefunktion:doppelpunktlage<>0.gibinformationzumformular:WINDOW VARw:=window(3,6,75,17);outframe(w);IFebene=1THENshow(formular(4))ELSEshow(formular(23))END IF;warte.ergaenzeumunterstriche:FORiFROM1UPTOmaxfunktionenREPchangeall(raster(i+1),blank,
+unterstrichzeichen);raster(i+1)CAT((100-length(raster(i+1)))*unterstrichzeichen);fkttext(i):=raster(i+1)END REP END PROCverfahren;PROCraeumeauf:schreibeselbstdefiniertefunktionenindatei;initialisieren;trageselbstdefiniertefunktionenein;oldfootnote.schreibeselbstdefiniertefunktionenindatei:TEXT VARbeliebig:=scratchdateiname;FILE VARf:=sequentialfile(output,beliebig);TERM VARt:=listenanfang(eigenefunktionen);WHILEt<>nilREPputline(f,funktionsstring(abbildung(NAMEt)));t:=nachfolger(t)END REP.trageselbstdefiniertefunktionenein:TEXT VARzeile;ABBILDUNG VARabb;f:=sequentialfile(input,beliebig);WHILE NOTeof(f)REPgetline(f,zeile);abb:=neuefunktion(zeile)END REP;forget(beliebig,quiet)END PROCraeumeauf;PROCverfahrensende(TEXT CONSTzeichen):letztesescapezeichen:=zeichenEND PROCverfahrensende;PROCueberpruefeaktivierung:IFlaenge(eigenefunktionen)>0CAND NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE;refreshsubmenuELIFlaenge(eigenefunktionen)=0CANDausgabeaktiviertTHENdeaktiviere;ausgabeaktiviert:=FALSE;refreshsubmenuEND IF END PROCueberpruefeaktivierung;PROCaktiviere:activate(loeschprocname);activate(ausgabeprocname);activate(sicherungsprocname)END PROCaktiviere;PROCdeaktiviere:deactivate(loeschprocname);deactivate(ausgabeprocname);deactivate(sicherungsprocname)END PROCdeaktiviere;END PACKETmenufunktionen;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.nullstellen b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen
new file mode 100644
index 0000000..3900a28
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen
@@ -0,0 +1,6 @@
+PACKETnullstellenDEFINESberechnenullstelle:LETesc="�",bell="�",unterstrich="_",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",graphdefinieren="e",naechste="q",protokoll="p",protokolldrucken="d",drucken="D",graphicstandardtasten="wvqm",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",anzahlmoeglicherteilverfahren=3,nullstellenverfahrensname="Nullstellen",nullstellenverfahren1="Intervallhalbierungsverfahren - tabellarisch",nullstellenverfahren2="Newtonverfahren - tabellarisch",nullstellenverfahren3="Newtonverfahren - graphisch",titelzeile12="Nullstellen: Newtonverfahren",titelzeile3="Nullstellen: Intervallhalbierung",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;THESAURUS CONSTmoeglicheteilverfahren:=nullstellenverfahrensnamen;PROCberechnenullstelle(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1THENgibmeldung(anwendungstext(88));LEAVEberechnenullstelleEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).initialisieredienoetigenvariablen:WINDOW VARwausgabe:=window(2,7,77,16);TAG VAReingabemaske;PARAMETER VARraster;INT VARstartfeld:=2,ersterauszugebendersatz,ersteauszugebendespalte,varindex:=1,anzahlderiterationsschritte:=10,parameingabespalte,endederueberschrift;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);ABBILDUNG VARfbild;BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,varindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;TEXT VARverfahrensname;setzedefaultgraph.bestimmeanzuwendendeoperation:INT VARzeile;schreibestatuszeile(nullstellenverfahrensname);REPverfahrensname:=one(24,7,56,15,moeglicheteilverfahren,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnenullstelleEND IF END REP.fuehreoperationaus:TEXT VARdatname;FILE VARsf;IFverfahrensname=nullstellenverfahren1THENintervallhalbierungsverfahrenELSEbildedienewtonfolgeEND IF.bildedienewtonfolge:REAL VARstartwert:=0.0;anzahlderiterationsschritte:=10;schreibestatuszeile(titelzeile12);IFableitungsverbot(adresse(f))THENgibmeldung(anwendungstext(87));LEAVEbildedienewtonfolgeEND IF;REPbestimmeparameterfuernewtonfolge;bildenewtonvorschrift;IFverfahrensname=nullstellenverfahren2THENermittleergebnisse;zeigeergebnisse;raeumeaufELSEgraphischeveranschaulichungdesnewtonverfahrensEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuernewtonfolge:initialisiereeingabemaskefuernewtonfolge;REPeditiereeingabemaske;werteausstiegausEND REP.initialisiereeingabemaskefuernewtonfolge:eingabemaske:=formular(6);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF;raster(3):=text(startwert);raster(4):=text(anzahlderiterationsschritte).editiereeingabemaske:IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3)CATkurzerstrich;raster(4)CATkurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IF NOTvarindexbestimmtTHENgibinfofensteraus(wausgabe,14)ELSEgibinfofensteraus(wausgabe,15)END IF CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHEN IF NOTvariablenvectorbestimmtTHENparameingabespalte:=1;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuernewtonfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT.alleeingabenkorrekt:
+korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:=listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvarindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvarindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);REAL VARanfangswert:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,varindex,anfangswert);startwert:=anfangswert;TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);anzahlderiterationsschritte:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDanzahlderiterationsschritte>0CANDanzahlderiterationsschritte<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.bildenewtonvorschrift:fbild:=newtonvorschrift(f,varindex);IFiserrorTHENgibmeldung(errormessage);clearerror;LEAVEbildedienewtonfolgeEND IF.ermittleergebnisse:datname:=scratchdateiname;sf:=sequentialfile(output,datname);iteration(sf,f,fbild,eingabevektor,varindex,anzahlderiterationsschritte).zeigeergebnisse:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);raeumeauf;LEAVEfuehreoperationausCASE5,6:raeumeauf;verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.raeumeauf:forget(datname,quiet);loescheabbildung(fbild).graphischeveranschaulichungdesnewtonverfahrens:bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,titelzeile12);cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+"        "+anwendungstext(98)+raster[4].fuehregraphischeveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(f1,eingaben,varindex);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARf1:=f,f2:=fbild;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvarindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(f1,linkerrand,rechterrand,eingabevektor,varindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(f1,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matmove(folgenwert,0.0);matdraw(folgenwert,funktionswert);gibinfos.gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)).
+verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehregraphischeveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgenglied<anzahlderiterationsschritteTHENaktuellesfolgengliedINCR1;berechneundzeichnenaechstesfolgenglied;LEAVEverarbeiteeingabezeichenELIFch=protokollTHENzeigedasprotokollELIFch=druckenTHENdruckegraphELSEout(bell)END IF;END REP.definierebereich:loeschetexte;graphfenstereinstellen;loeschezeichnung;initkoordinatensystem;firsttime:=FALSE;definitionsmenu(TRUE,ausstieg);IFausstieg<>weiterarbeitTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,varindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(f1,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,varindex)END IF;zeichnegraphenderarbeitsfunktion(f1,eingabevektor,varindex).zeigedasprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechneundzeichnenaechstesfolgenglied:graphfenstereinstellen;move(folgenwert,funktionswert);folgenwert:=naechstesfolgenglied(f2,eingaben,varindex);IFiserrorTHENclearerror;fehler:=TRUE;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matdraw(folgenwert,0.0).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:erneuerebildschirmCASE2:erneuerebildschirm;loeschetemporaereabbildung(fbild);LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);loeschetemporaereabbildung(fbild);LEAVEberechnenullstelleEND SELECT.erneuerebildschirm:schreibestatuszeile(titelzeile12);schreibearbeitsfunktion(f);strich(5).intervallhalbierungsverfahren:REAL VARlinkegrenze:=-5.0,rechtegrenze:=5.0;schreibestatuszeile(titelzeile3);REPbestimmeparameterfuerintervallhalbierung;datname:=scratchdateiname;sf:=sequentialfile(output,datname);intervallhalbierung(sf,f,eingabevektor,varindex,anzahlderiterationsschritte,linkegrenze,rechtegrenze);zeigeergebnissederintervallhalbierung;forget(datname,quiet)UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuerintervallhalbierung:initialisiereeingabemaskefuerintervallhalbierung;REPeditiereeingabemaskefuerintervallhalbierung;werteausstiegbeiintervallhalbierungausEND REP.initialisiereeingabemaskefuerintervallhalbierung:eingabemaske:=formular(7);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaskefuerintervallhalbierung:REAL VARhilf1,hilf2;INT VARhilf3,i;IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(linkegrenze);raster(4):=text(rechtegrenze);raster(5):=text(anzahlderiterationsschritte);FORiFROM3UPTO5REPraster(i)CATkurzerstrichEND REP;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstieg:=naechsteEND IF.werteausstiegbeiintervallhalbierungaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IFebene=2CANDlaenge(abbildungsvariablen(f))>1THENgibinfofensteraus(wausgabe,17)ELSEgibinfofensteraus(wausgabe,16)END IF CASE2:footnote(anwendungstext(114));IFallebisektionseingabenkorrektTHENlinkegrenze:=hilf1;rechtegrenze:=hilf2;anzahlderiterationsschritte:=hilf3;IF NOTvariablenvectorbestimmtTHENparameingabespalte:=40;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuerintervallhalbierungEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);
+LEAVEberechnenullstelleEND SELECT.allebisektionseingabenkorrekt:korrektervariablenbezeichnerCANDkorrektelinkegrenzeCANDkorrekterechtegrenzeCANDkorrekteteilungsanzahl.korrektelinkegrenze:changeall(raster(3),unterstrich,niltext);hilf1:=realzahl(raster(3));IF NOTiserrorTHEN TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrekterechtegrenze:changeall(raster(4),unterstrich,niltext);hilf2:=realzahl(raster(4));IF NOTiserrorTHEN IFhilf1>=hilf2THENstartfeld:=4;gibmeldung(anwendungstext(160));FALSE ELSE TRUE END IF ELSEclearerror;startfeld:=4;gibmeldung(anwendungstext(157));FALSE END IF.korrekteteilungsanzahl:changeall(raster(5),unterstrich,niltext);hilf3:=int(raster(5));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDhilf3>0CANDhilf3<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=5;FALSE END IF.zeigeergebnissederintervallhalbierung:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnissederintervallhalbierungCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(parameingabespalte,4);out("Parameter  :");cursor(parameingabespalte+13,4);belegeparameter(eingabevektor,varindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:gibinfofensteraus(wausgabe,8)CASE2:cursor(parameingabespalte,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP END PROCberechnenullstelle;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingaben,INT CONSTvarindex):zeichnekoordinatensystem;normalgraphzeichnen(f,eingaben,varindex);zeichnetexte;pen(1,1,1,neuerstift);newpicture(aktuellerstift)END PROCzeichnegraphenderarbeitsfunktion;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,iterationsfunktion,VECTOR CONSTeingaben,INT CONSTlaufvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion,f2:=iterationsfunktion;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE;footnote(anwendungstext(117));cursor(36,24);IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF.schreibetabellenueberschriften:ergaenzeparameter(f,originalfunktion,eingaben,laufvarindex);putline(f,"n     "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),laufvarindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevektor:=eingaben;INT VARi;REAL VARfolgenglied:=eingabevektorSUBlaufvarindex,funktionswert;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6)+senkrecht);write(f,wandle(folgenglied)+senkrecht);funktionswert:=ergebnis(f1,eingabevektor)SUB1;testefehler;putline(f,wandle(funktionswert));folgenglied:=naechstesfolgenglied(f2,eingabevektor,laufvarindex);testefehlerEND REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF.testefehler:IFiserrorTHENclearerror;
+putline(f,gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF END PROCiteration;REAL PROCnaechstesfolgenglied(ABBILDUNG CONSTbildungsvorschrift,VECTOR VAReingaben,INT CONSTindexfuereingabevektor):REAL VARneuerwert:=ergebnis(bildungsvorschrift,eingaben)SUB1;replace(eingaben,indexfuereingabevektor,neuerwert);neuerwertEND PROCnaechstesfolgenglied;PROCintervallhalbierung(FILE VARf,ABBILDUNG CONSTfunktion,VECTOR VAReingabevektor,INT CONSTvarindex,anzahliterationsschritte,REAL CONSTlinks,rechts):BOOL VARloeschflag:=FALSE;ABBILDUNG VARfkt:=funktion;TERM VARfktterm;INT VARi;erstellegegebenenfallsaufloesungderfunktion;footnote(anwendungstext(117));cursor(36,24);ergaenzeparameter(f,funktion,eingabevektor,varindex);schreibekopfzeileninausgabedatei;berechnemittlerenwert;IFloeschflagTHENloescheabbildung(fkt)END IF.erstellegegebenenfallsaufloesungderfunktion:IFkomplexefunktion(fkt)THENfkt:=aufloesung(fkt);loeschflag:=TRUE END IF;fktterm:=AUSDRUCKlistenanfang(abbildungsterme(fkt)).schreibekopfzeileninausgabedatei:LETanzahlueberschriften=6;ROWanzahlueberschriftenTEXT CONSTueberschrift:=ROWanzahlueberschriftenTEXT:(anwendungstext(253),anwendungstext(254),anwendungstext(255),anwendungstext(256),anwendungstext(257),anwendungstext(258));TEXT VARtitelzeile:="n     ";FORiFROM1UPTOanzahlueberschriftenREPtitelzeileCAT(senkrecht+text(ueberschrift(i),gesamtstellen(ebene)))END REP;maxlinelength(f,2000);putline(f,titelzeile);titelzeile:=6*waagerecht+anzahlueberschriften*(kreuz+(gesamtstellen(ebene)*waagerecht));putline(f,titelzeile).berechnemittlerenwert:REAL VARx1:=links,x2:=rechts,xm,y1,y2,ym;FORiFROM0UPTOanzahliterationsschritteREPcout(i);testetaste;xm:=0.5*(x1+x2);write(f,text(i,6));write(f,senkrecht+wandle(x1));write(f,senkrecht+wandle(xm));write(f,senkrecht+wandle(x2));IFwertdefiniert(f,fktterm,eingabevektor,varindex,x1,y1)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,xm,ym)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,x2,y2)THENvergleiche;line(f)ELSE LEAVEberechnemittlerenwertEND IF END REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEberechnemittlerenwertEND IF.vergleiche:IFym=0.0THEN LEAVEberechnemittlerenwertELIFym*y1<=0.0THENx2:=xmELSEx1:=xmEND IF.END PROCintervallhalbierung;BOOL PROCwertdefiniert(FILE VARf,TERM CONSTfktterm,VECTOR VAReingabevektor,INT CONSTlaufvarindex,REAL CONSTx,REAL VARy):replace(eingabevektor,laufvarindex,x);y:=result(fktterm,eingabevektor);IFiserrorTHENclearerror;write(f,senkrecht+gesamtstellen(ebene)*"-");line(f);write(f,anwendungstext(175));FALSE ELSEwrite(f,senkrecht+wandle(y));TRUE END IF END PROCwertdefiniert;THESAURUS PROCnullstellenverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(nullstellenverfahren1,nullstellenverfahren2,nullstellenverfahren3);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCnullstellenverfahrensnamen;PROCergaenzeparameter(FILE VARsf,ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTlaufvarindex):INT VARi,varlistenlaenge:=laenge(abbildungsvariablen(f));IFvarlistenlaenge>10THEN LEAVEergaenzeparameterEND IF;FORiFROM1UPTOvarlistenlaengeREP IFi<>laufvarindexTHENputline(sf,text(NAMEauswahl(abbildungsvariablen(f),i),8)+"="+wandle(eingabevektorSUBi))END IF END REP END PROCergaenzeparameter;END PACKETnullstellen;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.parser b/app/schulis-mathematiksystem/1.0/src/mat.parser
new file mode 100644
index 0000000..fc53883
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.parser
@@ -0,0 +1,12 @@
+PACKETparserDEFINESneuefunktion,funktionsaufruf,funktionsstring,formel,gibnamen,loescheunreferenzierteabbildung,referenziertefunktion,funktionsnamenthesaurus,standardfunktionsthesaurus:LETniltext="",blank=" ",ifsymbol="<",fuersymbol=":",elifsymbol=";",endifsymbol=">",undsymbol="UND",odersymbol="ODER",zuweisungssymbol="->",kleinersymbol="<",kleinergleichsymbol="<=",groessersymbol=">",groessergleichsymbol=">=",gleichsymbol="=",ungleichsymbol="<>",plussymbol="+",minussymbol="-",divisionssymbol="/",multiplikationssymbol="*",speziellespotenzsymbol="^",allgemeinespotenzsymbol="**",strichsymbol="'",klammeraufsymbol="(",klammerzusymbol=")",doppelpunktsymbol=":",dezimalpunktsymbol=".",esymbol="e",pisymbol="pi",betragssymbol="abs",signumsymbol="sign",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",funktionsklammeraufsymbol="[",funktionsklammerzusymbol="]",punktsymbol=".",kommasymbol=",",verkettungssymbol="O",differenziersymbol="D",selektionssymbol="S",bruchsymbol="/",unsichtbareklammerauf=" (: ",unsichtbareklammerzu=" :) ",selektionsklammeraufsymbol=" {{ ",selektionsklammerzusymbol=" }} ",selektionsfuersymbol=" :: ",selektionselifsymbol=" ;; ",funktionsauswertungssymbol=" A ",diffklammeraufsymbol=" D: ",diffklammerzusymbol=" :D ",bezeichnertyp=1,konstantentyp=3,begrenzertyp=6,defaultfuerkomponentenindex=1,defaultfuervariablenindex=1,defaultstdfktvarname="x";TEXT VARsymbol,symbolspeicher,aktuellerabbildungsname;INT VARsymboltyp,speichertyp;LISTE VARlistedervariablen,listederterme;TERM VARknoten;BOOL VAReliferwartet:=FALSE;ABBILDUNG PROCneuefunktion(TEXT CONSTfunktionsstring):enablestop;TEXT VARfehlzeichen:=niltext;IFfunktionsstring=niltextTHENerrorstop(anwendungstext(58))ELIFfehlerhaftebuchstabenvorhanden(funktionsstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;listedervariablen:=neueliste(nil,nil);listederterme:=neueliste(nil,nil);aktuellerabbildungsname:=niltext;knoten:=nil;IFebene=1THENparseeinfachefunktion(funktionsstring)ELSEsymbolspeicher:=niltext;speichertyp:=0;parsekomplexefunktion(funktionsstring)END IF END PROCneuefunktion;ABBILDUNG PROCparseeinfachefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;verarbeitenderlinkenhaelfte;verarbeitezuweisungssymbol;verarbeitendesfunktionsterms;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nextsymbol(symbol,symboltyp).verarbeitenderlinkenhaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nextsymbol(symbol,symboltyp);testegueltigkeit;anhaengen(listedervariablen,newvariable(1,symbol));nextsymbol(symbol,symboltyp).verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nextsymbol(symbol,symboltyp);IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitendesfunktionsterms:nextsymbol(symbol,symboltyp);IFsymboltyp>6THENerrorstop(anwendungstext(33))ELIFsymbol=ifsymbolTHENeliferwartet:=FALSE;nextsymbol(symbol,symboltyp);abschnittweisedefinierteeinfachefunktion(listederterme)ELSEeinfacherausdruck(listederterme)END IF;IFsymboltyp<7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparseeinfachefunktion;PROCabschnittweisedefinierteeinfachefunktion(LISTE VARtermliste):knoten:=naechsteeinfacheklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;anhaengen(termliste,newterm(knoten));IFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nextsymbol(symbol,symboltyp)END PROCabschnittweisedefinierteeinfachefunktion;TERM PROCnaechsteeinfacheklausel:TERM VARthenzeiger,bedingungszeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nextsymbol(symbol,symboltyp);ELSEeliferwartet:=TRUE END IF;einfacherarithmetischerausdruck;thenzeiger:=knoten;
+IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nextsymbol(symbol,symboltyp);einfachebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechsteeinfacheklausel)END IF END PROCnaechsteeinfacheklausel;PROCeinfachebedingung:TEXT VARoperator;TERM VARlinkszeiger;einfacheslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacheslogischeselement;knoten:=newlogischedyade(linkszeiger,knoten,operator)END REP END PROCeinfachebedingung;PROCeinfacheslogischeselement:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfachebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitevergleich:einfacherarithmetischerausdruck;IF(symbol<>kleinersymbol)CAND(symbol<>kleinergleichsymbol)CAND(symbol<>groessersymbol)CAND(symbol<>groessergleichsymbol)CAND(symbol<>ungleichsymbol)CAND(symbol<>gleichsymbol)THENerrorstop(anwendungstext(40))END IF;operator:=symbol;linkszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;knoten:=newvergleich(linkszeiger,knoten,operator)END PROCeinfacheslogischeselement;PROCeinfacherausdruck(LISTE VARtermliste):einfacherarithmetischerausdruck;anhaengen(termliste,newterm(knoten))END PROCeinfacherausdruck;PROCeinfacherarithmetischerausdruck:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newmonade(knoten,operator)ELSEeinfachertermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherarithmetischerausdruck;PROCeinfacherterm:TEXT VARoperator;TERM VARlinkszeiger;einfacherfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherfaktor;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherterm;PROCeinfacherfaktor:TERM VARbasiszeiger;TEXT VARpotenzsymbol;einfacheselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasiszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacheselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basiszeiger,knoten,potenzsymbol)END REP END PROCeinfacherfaktor;PROCeinfacheselement:TERM VARobjektzeiger;LISTE VARlistederargumente;IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFsymboltyp=bezeichnertypTHENverarbeitebezeichnerELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nextsymbol(symbol,symboltyp).verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitebezeichner:IFsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFelementarefunktionTHENverarbeiteabbildungsausdruckELSEverarbeitevariableEND IF.elementarefunktion:objektzeiger:=listenposition(standardfunktionen,symbol);objektzeiger<>nil.verarbeiteabbildungsausdruck:TEXT VARfunktionsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol=strichsymbolCAND(funktionsname=betragssymbolCORfunktionsname=signumsymbolCORfunktionsname=gaussklammersymbolCORfunktionsname=rundsymbolCORfunktionsname=intsymbolCORfunktionsname=fracsymbol)THENerrorstop(anwendungstext(56))END IF;WHILEsymbol=strichsymbolREPobjektzeiger:=newableitungsoperation(objektzeiger,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nextsymbol(symbol,symboltyp)END REP;knoten:=newfunktionsauswertung(
+objektzeiger,argumentzeiger,defaultfuerkomponentenindex).argumentzeiger:IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;nextsymbol(symbol,symboltyp);listederargumente:=neueliste(nil,nil);einfacherausdruck(listederargumente);IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp);newtermliste(listenanfang(listederargumente),listenende(listederargumente),1).verarbeitevariable:knoten:=listenposition(listedervariablen,symbol);IFknoten=nilTHENknoten:=alphasort(listedervariablen,symbol)END IF;nextsymbol(symbol,symboltyp)END PROCeinfacheselement;ABBILDUNG PROCparsekomplexefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;linkehaelfte;verarbeitezuweisungssymbol;verarbeitenderfunktionsterme;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nimmsymbol.linkehaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nimmsymbol;IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nimmsymbol;variablenliste.verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nimmsymbol;IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitenderfunktionsterme:komplexeausdruecke(listederterme);IFsymboltyp<>7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparsekomplexefunktion;PROCvariablenliste:testegueltigkeit;WHILEsymboltyp=bezeichnertypREPanhaengen(listedervariablen,newvariable(laenge(listedervariablen)+1,symbol));nimmsymbol;IFsymbol=kommasymbolTHENnimmsymbol;testegueltigkeitEND IF END REP END PROCvariablenliste;PROCkomplexeausdruecke(LISTE VARtermliste):REPnimmsymbol;IFsymbol=ifsymbolTHENeliferwartet:=FALSE;nimmsymbol;abschnittweisedefinierterkomplexertermELSEkomplexerarithmetischerausdruckEND IF;anhaengen(termliste,newterm(knoten))UNTILsymbol<>kommasymbolEND REP END PROCkomplexeausdruecke;PROCabschnittweisedefinierterkomplexerterm:knoten:=naechstekomplexeklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)ELIFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nimmsymbolEND PROCabschnittweisedefinierterkomplexerterm;TERM PROCnaechstekomplexeklausel:TERM VARbedingungszeiger,thenzeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEeliferwartet:=TRUE END IF;komplexerarithmetischerausdruck;thenzeiger:=knoten;IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nimmsymbol;komplexebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechstekomplexeklausel)END IF END PROCnaechstekomplexeklausel;PROCkomplexebedingung:TEXT VARoperator;TERM VARlinks;komplexeslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexeslogischeselement;knoten:=newlogischedyade(links,knoten,operator)END REP END PROCkomplexebedingung;PROCkomplexeslogischeselement:IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nimmsymbol;komplexebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.verarbeitevergleich:TERM VARlinks;TEXT VARoperator;komplexerarithmetischerausdruck;IFsymbol<>kleinersymbolCANDsymbol<>kleinergleichsymbolCANDsymbol<>groessersymbolCANDsymbol<>groessergleichsymbolCANDsymbol<>ungleichsymbolCANDsymbol<>gleichsymbolTHENerrorstop(anwendungstext(40))END IF;operator:=symbol;links:=knoten;nimmsymbol;komplexerarithmetischerausdruck;knoten:=newvergleich(links,knoten,operator).END PROCkomplexeslogischeselement;PROCkomplexerarithmetischerausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;komplexerterm;knoten:=newmonade(knoten,operator)ELSEkomplexerterm;END IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;
+komplexerterm;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerarithmetischerausdruck;PROCkomplexerterm:TEXT VARoperator;TERM VARlinks;komplexerfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexerfaktor;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerterm;PROCkomplexerfaktor:TERM VARbasis;TEXT VARpotenzsymbol;komplexeselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasis:=knoten;nimmsymbol;komplexeselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basis,knoten,potenzsymbol)END REP END PROCkomplexerfaktor;PROCkomplexeselement:IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFvariablenbezeichnerTHENverarbeitevariablenbezeichnerELSEverarbeitefunktionsauswertungEND IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nimmsymbol.verarbeitegeklammertenausdruck:nimmsymbol;komplexerarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.variablenbezeichner:symboltyp=bezeichnertypCANDbezeichnerfuervariable.bezeichnerfuervariable:knoten:=listenposition(listedervariablen,symbol);knoten<>nil.verarbeitevariablenbezeichner:nimmsymbol.verarbeitefunktionsauswertung:INT VARtermzahl,variablenzahl,komponentenindex;TERM VARausdruckzeiger;abbildungsobjekt(termzahl,variablenzahl);ausdruckzeiger:=knoten;komponentenindex:=komponente(termzahl);argumentliste(variablenzahl);knoten:=newfunktionsauswertung(ausdruckzeiger,knoten,komponentenindex)END PROCkomplexeselement;BOOL VARelementeinerfunktionsverknuepfunggefunden;TEXT VARerlaubtervariablenname;PROCabbildungsobjekt(INT VARanzahlterme,anzahlvariablen):IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;IFanzahlterme=1CANDanzahlvariablen=1THENeinfachesableitungsformatEND IF ELIFsymbol=funktionsklammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHENverarbeiteallgemeinesableitungsformatELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:IFelementarefunktionCORselbstdefiniertefunktionTHENverarbeiteabbildungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFknoten<>nilCANDselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeiteabbildung:anzahlterme:=termanzahl(knoten);anzahlvariablen:=variablenanzahl(knoten);nimmsymbol.verarbeitegeklammertenausdruck:elementeinerfunktionsverknuepfunggefunden:=FALSE;nimmsymbol;abbildungsausdruck;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(anwendungstext(35))END IF;anzahlterme:=1;anzahlvariablen:=1;nimmsymbol.verarbeiteallgemeinesableitungsformat:allgemeinesableitungsformat(anzahlvariablen);anzahlterme:=1.END PROCabbildungsobjekt;PROCeinfachesableitungsformat:WHILEsymbol=strichsymbolREP IFableitungsverbot(knoten)THENerrorstop(anwendungstext(56))END IF;knoten:=newableitungsoperation(knoten,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nimmsymbolEND REP END PROCeinfachesableitungsformat;PROCallgemeinesableitungsformat(INT VARvariablenzahl):INT VARableitungsgrad,komponentenindex,termzahl;ABBILDUNG VARvergleichsabbildung;bestimmeableitungsgrad;bestimmeobjektderableitungsoperation;überlesebruchsymbol;bestimmevariablenundallokiereableitungspointer.bestimmeableitungsgrad:nimmsymbol;IFsymboltyp=konstantentypTHEN IFpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(47))END IF;ableitungsgrad:=int(symbol);IFableitungsgrad<1THENerrorstop(anwendungstext(47))END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitungsoperation:abbildungsobjekt(termzahl,variablenzahl);IFableitungsverbot(knoten)THEN
+errorstop(anwendungstext(56))END IF;vergleichsabbildung:=vergleichsfunktion(knoten);komponentenindex:=komponente(termzahl).überlesebruchsymbol:IFsymbol<>bruchsymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol.bestimmevariablenundallokiereableitungspointer:INT VARzaehler,variablenindex;FORzaehlerFROM1UPTOableitungsgradREPbestimmeabzuleitendevariable;trageableitungein;nimmsymbolEND REP;loeschetemporaereabbildung(vergleichsabbildung).bestimmeabzuleitendevariable:TERM VARvergleichszeiger;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(44))END IF;nimmsymbol;vergleichszeiger:=listenposition(abbildungsvariablen(vergleichsabbildung),symbol);IFvergleichszeiger=nilTHENerrorstop(hinweisaufungueltigennamen)END IF;variablenindex:=PLATZvergleichszeiger.trageableitungein:TERM VARpruefterm;IFknotenISeigenefunktionTHENpruefterm:=(TERME DEFINITIONknoten)ELEMENTkomponentenindexELSEpruefterm:=knotenEND IF;knoten:=newableitungsoperation(knoten,variablenindex,komponentenindex,differenziersymbol).END PROCallgemeinesableitungsformat;PROCabbildungsausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsmonade(knoten,operator)ELSEabbildungstermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsausdruck;PROCabbildungsterm:TEXT VARoperator;TERM VARlinks;abbildungsverkettung;WHILE(symbol=multiplikationssymbol)COR(symbol=divisionssymbol)REPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsverkettung;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsterm;PROCabbildungsverkettung:TERM VARlinks;abbildungselement;WHILEsymbol=verkettungssymbolREPlinks:=knoten;nimmsymbol;abbildungselement;knoten:=newabbildungsdyade(links,knoten,verkettungssymbol)END REP END PROCabbildungsverkettung;PROCabbildungselement:IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;einfachesableitungsformatELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHEN INT VARanzahlvariablen:=1;allgemeinesableitungsformat(anzahlvariablen)ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:TEXT VARneuervariablenname;IFelementarefunktionTHEN IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=defaultstdfktvarname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFerlaubtervariablenname<>defaultstdfktvarnameTHENerrorstop(anwendungstext(45))END IF ELIFselbstdefiniertefunktionTHEN IF(termanzahl(knoten)<>1)COR(variablenanzahl(knoten)<>1)THENerrorstop(anwendungstext(45))ELIFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;neuervariablenname:=NAMElistenanfang(abbildungsvariablen(abbildung(symbol)));IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=neuervariablenname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFneuervariablenname<>erlaubtervariablennameTHENerrorstop(anwendungstext(45))END IF ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeitegeklammertenausdruck:nimmsymbol;abbildungsausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbolEND PROCabbildungselement;INT PROCkomponente(INT CONSTtermzahl):INT VARkompwert:=defaultfuerkomponentenindex;IFtermzahl>1THEN IFsymbol<>selektionssymbolTHENerrorstop(anwendungstext(42))END IF;nimmsymbol;IFsymboltyp<>konstantentypCORpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(42))END IF;kompwert:=int(symbol);IFkompwert>termzahlCORkompwert<1THENerrorstop(anwendungstext(42))END IF;nimmsymbol
+END IF;kompwertEND PROCkomponente;PROCargumentliste(INT CONSTnotwendigeargumentanzahl):LISTE VARlistederargumente;IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;listederargumente:=neueliste(nil,nil);REPnimmsymbol;komplexerarithmetischerausdruck;anhaengen(listederargumente,newterm(knoten))UNTILsymbol<>kommasymbolEND REP;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))ELIFlaenge(listederargumente)<>notwendigeargumentanzahlTHENerrorstop(anwendungstext(46))END IF;nimmsymbol;knoten:=newtermliste(listenanfang(listederargumente),listenende(listederargumente),laenge(listederargumente))END PROCargumentliste;BOOL PROCganzzahligerexponent:REAL VARhilfswert;IF(knotenISkonstante)COR((knotenISmonadisch)CAND(OPERANDknotenISkonstante))THEN IFknotenISkonstanteTHENhilfswert:=WERTknotenELSEhilfswert:=WERT OPERANDknotenEND IF;IFhilfswert>32767.0CORhilfswert<-32768.0THEN FALSE ELSEhilfswert=floor(hilfswert)END IF ELSE FALSE END IF END PROCganzzahligerexponent;PROCtestegueltigkeit:IFsymboltyp<>bezeichnertypCORlistenposition(standardfunktionen,symbol)<>nilCORsymbol=esymbolCORsymbol=pisymbolCORsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFebene=2CAND(listenposition(listedervariablen,symbol)<>nil)THENerrorstop(anwendungstext(41))END IF END PROCtestegueltigkeit;REAL PROCwert:IFsymbol=esymbolTHENeELIFsymbol=pisymbolTHENpiELSEreal(symbol)END IF END PROCwert;PROCeintragenderfunktion:anhaengenaneigenefunktionen(neweigenefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(listedervariablen),listenende(listedervariablen),laenge(listedervariablen)),newtermliste(listenanfang(listederterme),listenende(listederterme),laenge(listederterme))),aktuellerabbildungsname))END PROCeintragenderfunktion;ABBILDUNG PROCfunktionsaufruf(TEXT CONSTaufrufstring):TEXT VARfehlzeichen:=niltext;ABBILDUNG VARarbeitsobjekt;enablestop;scan(aufrufstring);symbolspeicher:=niltext;nimmsymbol;IFsymbol=niltextTHENerrorstop(anwendungstext(33))ELIFfehlerhaftebuchstabenvorhanden(aufrufstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;arbeitsobjekt:=funktionsterm;IFsymbol<>niltextTHENloeschetemporaereabbildung(arbeitsobjekt);errorstop(hinweisauffehlerhaftessymbol)END IF;arbeitsobjektEND PROCfunktionsaufruf;ABBILDUNG PROCfunktionsterm:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result;IFsymbol=plussymbolTHENnimmsymbol;result:=funktionsfaktorELIFsymbol=minussymbolTHENnimmsymbol;result:=-funktionsfaktorELSEresult:=funktionsfaktorEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=result;operator:=symbol;nimmsymbol;rechts:=funktionsfaktor;IF NOTvariablenidentitaet(links,rechts)CORlaenge(abbildungsterme(links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=plussymbolTHENresult:=links+rechtsELSEresult:=links-rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsterm;ABBILDUNG PROCfunktionsfaktor:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result:=funktionsverkettung;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPoperator:=symbol;links:=result;nimmsymbol;rechts:=funktionsverkettung;IF NOTvariablenidentitaet(links,rechts)COR(laenge(abbildungsterme(rechts))<>laenge(abbildungsterme(links)))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=multiplikationssymbolTHENresult:=links*rechtsELSE IFebene=2CANDlaenge(abbildungsterme(links))<>1THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=links/rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsfaktor;ABBILDUNG PROCfunktionsverkettung:ABBILDUNG VARlinks,rechts,result:=funktionselement;WHILEsymbol=verkettungssymbolREPlinks:=result;nimmsymbol;rechts:=funktionselement;IFlaenge(abbildungsvariablen(
+links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=linksOrechts;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsverkettung;ABBILDUNG PROCfunktionselement:ABBILDUNG VARelement;IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENverarbeitebezeichnerELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFebene=2CANDsymbol=differenziersymbolTHENelement:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;element.verarbeitebezeichner:element:=abbildung(symbol);IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF.verarbeitegeklammertenausdruck:nimmsymbol;element:=funktionsterm;IFsymbol<>klammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF END PROCfunktionselement;ABBILDUNG PROCeinfachefunktionsableitung(ABBILDUNG VARelement):ABBILDUNG VARobjekt;nimmsymbol;WHILEsymbol=strichsymbolREPobjekt:=element;element:=ableitung(objekt,1,1);loeschetemporaereabbildung(objekt);nimmsymbolEND REP;elementEND PROCeinfachefunktionsableitung;ABBILDUNG PROCkomplexefunktionsableitung:ABBILDUNG VARelement,objekt;INT VARableitungsgrad,komponentenindex,variablenindex,i;bestimmeableitungsgrad;bestimmeobjektderableitung;leiteab;element.bestimmeableitungsgrad:nimmsymbol;IFpos(symbol,punktsymbol)<>0THENerrorstop(hinweisauffehlerhaftessymbol)ENDIF;ableitungsgrad:=int(symbol);IFlastconversionokTHEN IFableitungsgrad<1THENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitung:IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENobjekt:=abbildung(symbol);IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=funktionsklammeraufsymbolTHENnimmsymbol;objekt:=funktionsterm;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=differenziersymbolTHENobjekt:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsterme(objekt))>1THEN IFsymbol<>selektionssymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;komponentenindex:=int(symbol);IF NOTlastconversionokTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEkomponentenindex:=1END IF;IFableitungsverbot(adresse(objekt))THENerrorstop(anwendungstext(56))END IF.leiteab:TERM VARsuchterm;INT VARtempkompindex:=komponentenindex;IFsymbol<>bruchsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;FORiFROM1UPTOableitungsgradREP IFi>1THENtempkompindex:=1END IF;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol;suchterm:=listenposition(abbildungsvariablen(objekt),symbol);IFsuchterm=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;variablenindex:=PLATZsuchterm;element:=ableitung(objekt,tempkompindex,variablenindex);loeschetemporaereabbildung(objekt);objekt:=element;nimmsymbolEND REP END PROCkomplexefunktionsableitung;PROCnimmsymbol:TEXT VARsym1,sym2;INT VARtyp1,typ2;besorgedaserstesymbol;besorgegegebenenfallseinzweitessymbol;reichesymbolundtypnachaussen.besorgedaserstesymbol:IFspeichergefuelltTHENverarbeitespeicher;loeschespeicherELSEnextsymbol(sym1,typ1);END IF.
+speichergefuellt:symbolspeicher<>niltext.verarbeitespeicher:sym1:=symbolspeicher;typ1:=speichertyp.loeschespeicher:symbolspeicher:=niltext;speichertyp:=0.besorgegegebenenfallseinzweitessymbol:IFsym1=klammeraufsymbolTHENnextsymbol(sym2,typ2);IFsym2=punktsymbolTHENsym1:=funktionsklammeraufsymbol;typ1:=begrenzertypELSEfuellespeicherEND IF ELIFsym1=punktsymbolTHENnextsymbol(sym2,typ2);IFsym2=klammerzusymbolTHENsym1:=funktionsklammerzusymbol;typ1:=begrenzertypELSEfuellespeicherEND IF END IF.fuellespeicher:symbolspeicher:=sym2;speichertyp:=typ2.reichesymbolundtypnachaussen:symbol:=sym1;symboltyp:=typ1END PROCnimmsymbol;BOOL PROCfehlerhaftebuchstabenvorhanden(TEXT CONSTt,TEXT VARz):LETanzahlfehler=8;ROWanzahlfehlerTEXT CONSTungueltigezeichen:=ROWanzahlfehlerTEXT:("ä","ö","ü","ß","{","}","(*","*)");INT VARi;z:=niltext;FORiFROM1UPTOanzahlfehlerREP IFpos(t,ungueltigezeichen(i))<>0THENzCATungueltigezeichen(i)END IF END REP;z<>niltextEND PROCfehlerhaftebuchstabenvorhanden;TEXT PROChinweisauffehlerhaftessymbol:anwendungstext(36)+strichsymbol+symbol+strichsymbolEND PROChinweisauffehlerhaftessymbol;TEXT PROChinweisaufungueltigennamen:anwendungstext(31)+strichsymbol+symbol+strichsymbolEND PROChinweisaufungueltigennamen;BOOL VARlinear;FILE VARfktdat;TEXT PROCfunktionsstring(ABBILDUNG CONSTfkt):linear:=TRUE;fktstring(fkt)END PROCfunktionsstring;TEXT PROCformel(ABBILDUNG CONSTfkt):linear:=FALSE;fktstring(fkt)END PROCformel;TEXT PROCfktstring(ABBILDUNG CONSTfunktion):enablestop;pruefeparameter;erstellefunktionsstring;reichetextnachaussen.pruefeparameter:TERM VARsuchterm:=adresse(funktion);IFsuchterm=nilTHENerrorstop(anwendungstext(48))END IF.erstellefunktionsstring:sammletextbestandteileindatei;wandledateiintextum.sammletextbestandteileindatei:TEXT CONSTdatname:=scratchdateiname;fktdat:=sequentialfile(output,datname);disablestop;darstellung(suchterm);IFiserrorTHENclearerror;enablestop;forget(datname,quiet);errorstop(anwendungstext(49))END IF;enablestop.wandledateiintextum:TEXT VARstring:=niltext,zeile;input(fktdat);WHILE NOTeof(fktdat)REPgetline(fktdat,zeile);stringCATzeileEND REP;forget(datname,quiet).reichetextnachaussen:stringEND PROCfktstring;PROCdarstellung(TERM CONSTterm):enablestop;IFtermISeigenefunktionTHENgibfunktionsnamenausEND IF;variablenausgabe;gibzuweisungssymbolaus;gibtermlisteaus.gibfunktionsnamenaus:write(fktdat,NAMEterm);write(fktdat,doppelpunktsymbol).variablenausgabe:giberstevariableaus;IFebene=2THENgibweiterevariablenausEND IF.giberstevariableaus:TERM VARlaufterm:=LISTENANFANG VARIABLEN DEFINITIONterm;write(fktdat,NAMElaufterm).gibweiterevariablenaus:laufterm:=nachfolger(laufterm);WHILElaufterm<>nilREPwrite(fktdat,kommasymbol);write(fktdat,NAMElaufterm);laufterm:=nachfolger(laufterm)END REP.gibzuweisungssymbolaus:put(fktdat,blank+zuweisungssymbol).gibtermlisteaus:ausgabederterme(LISTENANFANG TERME DEFINITIONterm)END PROCdarstellung;PROCausgabederterme(TERM CONSTlaufterm):IFlaufterm<>nilTHENausgabe(AUSDRUCKlaufterm);IFnachfolger(laufterm)<>nilTHENput(fktdat,kommasymbol);ausgabederterme(nachfolger(laufterm))END IF END IF END PROCausgabederterme;PROCausgabe(TERM CONSTterm):TEXT VARoperator;TERM VARoperand;BOOL VARunsichtbareklammernnoetig;IF(termISstandardfunktion)COR(termISeigenefunktion)COR(termISvariable)THENgibnamenausELIFtermISkonstanteTHENgibkonstanteausELIFtermISdyadischTHENgibdyadeausELIFtermISmonadischTHENgibmonadeausELIFtermISfunktionsauswertungTHENgibfunktionsauswertungausELIFtermISableitungsoperationTHENgibableitungsoperationausELIFtermISabbildungsdyadeTHENgibabbildungsdyadeausELIFtermISabbildungsmonadeTHENgibabbildungsmonadeausELIFtermISselektionTHENgibselektionausELIFtermISlogischedyadeTHENgiblogischedyadeausELIFtermISvergleichTHENgibvergleichausELSEerrorstop(anwendungstext(49))END IF.gibnamenaus:write(fktdat,NAMEterm).gibkonstanteaus:REAL VARwert:=WERTterm;IF(NAMEterm=esymbol)COR(NAMEterm=pisymbol)THENwrite(fktdat,NAMEterm)ELIFwert=floor(wert)CANDwert<=32767.0CANDwert>=-32768.0THENwrite(fktdat,text(int(wert)))ELSE
+write(fktdat,text(wert))END IF.gibdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCAND(operator=divisionssymbolCORoperator=allgemeinespotenzsymbolCORoperator=speziellespotenzsymbol);IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;IFoperator=allgemeinespotenzsymbolTHENput(fktdat,blank+speziellespotenzsymbol)ELSEput(fktdat,blank+operator)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;operand:=RECHTSterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibfunktionsauswertungaus:operand:=ABBILDUNGSAUSDRUCKterm;IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand)END IF;IF(operandISeigenefunktion)CANDlaenge(abbildungsterme(abbildung(NAMEoperand)))>1THENput(fktdat,selektionssymbol+text(KOMPONENTEterm))END IF;IF NOTlinearTHENwrite(fktdat,funktionsauswertungssymbol)END IF;write(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabederterme(LISTENANFANG ARGUMENTEterm);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol).gibableitungsoperationaus:bestimmeanzahlderableitungen;operator:=OPERATIONterm;IFoperator=strichsymbolTHENgibeinfachesableitungsformatausELSEgibkomplexesableitungsformatausEND IF.bestimmeanzahlderableitungen:INT VARableitungsgrad:=1,komponentenindex:=KOMPONENTEterm;operand:=ABBILDUNGSAUSDRUCKterm;WHILEoperandISableitungsoperationREPkomponentenindex:=KOMPONENTEoperand;operand:=ABBILDUNGSAUSDRUCKoperand;ableitungsgradINCR1END REP.gibeinfachesableitungsformataus:IF(operandISeigenefunktion)COR(operandISstandardfunktion)THENausgabe(operand)ELSEwrite(fktdat,funktionsklammeraufsymbol);ausgabe(operand);write(fktdat,funktionsklammerzusymbol)END IF;write(fktdat,ableitungsgrad*strichsymbol).gibkomplexesableitungsformataus:ABBILDUNG VARvergleichsabbildung;IF NOTlinearTHENwrite(fktdat,unsichtbareklammerauf);write(fktdat,diffklammeraufsymbol)END IF;write(fktdat,differenziersymbol);IFableitungsgrad<>1THENwrite(fktdat,text(ableitungsgrad))END IF;write(fktdat,blank);IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand);IF NOT((operandISstandardfunktion)COR(laenge(abbildungsterme(abbildung(NAMEoperand)))=1))THENwrite(fktdat,selektionssymbol+text(komponentenindex))END IF END IF;IFlinearTHENwrite(fktdat,bruchsymbol);ELSEwrite(fktdat,unsichtbareklammerzu);write(fktdat,bruchsymbol+blank)END IF;vergleichsabbildung:=vergleichsfunktion(operand);ableitungsvariablenausgabe(term,abbildungsvariablen(vergleichsabbildung));IF NOTlinearTHENwrite(fktdat,diffklammerzusymbol)END IF;loeschetemporaereabbildung(vergleichsabbildung).gibabbildungsdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCANDoperator=divisionssymbol;
+IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;put(fktdat,blank+operator);operand:=RECHTSterm;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibabbildungsmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibselektionaus:IFlinearTHENput(fktdat,ifsymbol);ausgabe(AKTIONterm);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPput(fktdat,blank+elifsymbol);ausgabe(AKTIONoperand);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,blank+endifsymbol)ELSEwrite(fktdat,selektionsklammeraufsymbol);ausgabe(AKTIONterm);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPwrite(fktdat,selektionselifsymbol);ausgabe(AKTIONoperand);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,selektionsklammerzusymbol)END IF.giblogischedyadeaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);IF(RECHTSterm)ISlogischedyadeTHENwrite(fktdat,klammeraufsymbol);ausgabe(RECHTSterm);write(fktdat,klammerzusymbol)ELSEausgabe(RECHTSterm)END IF.gibvergleichaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);ausgabe(RECHTSterm)END PROCausgabe;PROCableitungsvariablenausgabe(TERM CONSTterm,LISTE CONSTvglvariablenliste):IF(ABBILDUNGSAUSDRUCKterm)ISableitungsoperationTHENableitungsvariablenausgabe(ABBILDUNGSAUSDRUCKterm,vglvariablenliste)END IF;write(fktdat,differenziersymbol+NAME(auswahl(vglvariablenliste,INDEXterm)))END PROCableitungsvariablenausgabe;BOOL PROClinkeklammernnoetig(TERM CONSToperand,TEXT CONSToperator):IF NOTlinearCANDoperator=divisionssymbolTHEN FALSE ELSEregel1CORregel2END IF.regel1:((operandISdyadisch)COR(operandISabbildungsdyade))CAND(prioritaet(OPERATIONoperand)<prioritaet(operator)).regel2:((operandISmonadisch)COR(operandISabbildungsmonade))CAND(operator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbol)END PROClinkeklammernnoetig;BOOL PROCrechteklammernnoetig(TERM CONSToperand,TEXT CONSToperator):IF NOTlinearCANDoperator=divisionssymbolTHEN FALSE ELIF NOTlinearCAND(operator=allgemeinespotenzsymbolCORoperator=speziellespotenzsymbol)THEN(operandISdyadisch)CAND((OPERATIONoperand=allgemeinespotenzsymbol)COR(OPERATIONoperand=speziellespotenzsymbol))ELSEregel1CORregel2CORregel3END IF.regel1:(operandISmonadisch)COR(operandISabbildungsmonade).regel2:((operandISdyadisch)COR(operandISabbildungsdyade))CAND(fall1CORfall2CORfall3).fall1:prioritaet(OPERATIONoperand)<prioritaet(operator).fall2:prioritaet(OPERATIONoperand)=prioritaet(operator)CAND(operator=minussymbolCORoperator=divisionssymbolCORoperator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbolCORoperator=verkettungssymbol).fall3:TERM VARt:=LINKSoperand;WHILE(tISdyadisch)COR(tISabbildungsdyade)REPt:=LINKStEND REP;(tISmonadisch)COR(tISabbildungsmonade)COR((tISkonstante)CAND(WERTt<0.0)).regel3:(operandISkonstante)CAND(WERToperand<0.0)END PROCrechteklammernnoetig;INT PROCprioritaet(TEXT CONSToperator):IFoperator=undsymbolCORoperator=odersymbolTHEN4ELIFoperator=verkettungssymbolTHEN3
+ELIFoperator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbolTHEN2ELIFoperator=multiplikationssymbolCORoperator=divisionssymbolTHEN1ELSE0END IF END PROCprioritaet;PROCgibnamen(ABBILDUNG CONSTf,TEXT VARname):enablestop;testeparameter;fuehreaktionaus.testeparameter:ueberpruefeexistenzderabbildung;ueberpruefesyntaxdesnamens;ueberpruefegueltigkeitdesnamens.ueberpruefeexistenzderabbildung:TERM VAReintrag:=adresse(f);IF NOT(eintragIStemporaerefunktion)THENerrorstop(anwendungstext(59))END IF.ueberpruefesyntaxdesnamens:TEXT VARsymbol;INT VARsymboltyp;changeall(name,blank,niltext);scan(name);nextsymbol(symbol,symboltyp);IFsymboltyp<>bezeichnertypTHENerrorstop(anwendungstext(31))END IF;nextsymbol(symbol);IFsymbol<>niltextTHENerrorstop(anwendungstext(31))END IF.ueberpruefegueltigkeitdesnamens:TEXT VARzk;IFfehlerhaftebuchstabenvorhanden(name,zk)COR(name=esymbol)COR(name=pisymbol)COR(listenposition(standardfunktionen,name)<>nil)THENerrorstop(anwendungstext(31))ELIFlistenposition(abbildungsvariablen(f),name)<>nilTHENerrorstop(anwendungstext(3))ELIFlistenposition(eigenefunktionen,name)<>nilTHENerrorstop(anwendungstext(60))END IF.fuehreaktionaus:anhaengenaneigenefunktionen(neweigenefunktion(DEFINITIONeintrag,name));entfernenaustemporaerenfunktionen(eintrag);LOESCHEeintragEND PROCgibnamen;PROCloescheunreferenzierteabbildung(TEXT CONSTfunktionsname):enablestop;TERM VAReintrag:=listenposition(eigenefunktionen,funktionsname);IFreferenziertefunktion(eintrag)THENerrorstop(NAMEeintrag+anwendungstext(71))END IF;loeschebenannteabbildung(funktionsname)END PROCloescheunreferenzierteabbildung;BOOL PROCreferenziertefunktion(TERM CONSTeintrag):TERM VARlaufterm:=listenanfang(eigenefunktionen);BOOL VARreferenziert:=FALSE;WHILE(laufterm<>nil)CAND NOTreferenziertREP IFlaufterm<>eintragTHENreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag)END IF;laufterm:=nachfolger(laufterm)END REP;IF NOTreferenziertTHENlaufterm:=listenanfang(temporaerefunktionen);WHILE(laufterm<>nil)CAND NOTreferenziertREPreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag);laufterm:=nachfolger(laufterm);END REP END IF;referenziertEND PROCreferenziertefunktion;BOOL PROCdurchsuchteliste(TERM CONSTterm,eintrag):durchsuchterterm(AUSDRUCKterm,eintrag)COR((nachfolger(term)<>nil)CANDdurchsuchteliste(nachfolger(term),eintrag))END PROCdurchsuchteliste;BOOL PROCdurchsuchterterm(TERM CONSTterm,eintrag):IFtermISeigenefunktionTHENterm=eintragELIF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)COR(termISabbildungsdyade)THENdurchsuchterterm(LINKSterm,eintrag)CORdurchsuchterterm(RECHTSterm,eintrag)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENdurchsuchterterm(OPERANDterm,eintrag)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)=eintrag)CORdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)CORdurchsuchteliste(LISTENANFANG ARGUMENTEterm,eintrag)ELIFtermISableitungsoperationTHENdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)ELIFtermISselektionTHENdurchsuchterterm(BEDINGUNGterm,eintrag)CORdurchsuchterterm(AKTIONterm,eintrag)CORdurchsuchterterm(ALTERNATIVEterm,eintrag)ELSE FALSE END IF END PROCdurchsuchterterm;THESAURUS PROCfunktionsnamenthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(eigenefunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCfunktionsnamenthesaurus;THESAURUS PROCstandardfunktionsthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(standardfunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCstandardfunktionsthesaurus;END PACKETparser
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.picture b/app/schulis-mathematiksystem/1.0/src/mat.picture
new file mode 100644
index 0000000..e6af50f
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.picture
@@ -0,0 +1,2 @@
+PACKETpictureDEFINES PICTURE,:=,nilpicture,move,draw,length,pen,plot,cmfaktor:LETdrawkey=1,movekey=2,textkey=3,max2dim=31983,maxtext=31974;TYPE PICTURE=STRUCT(INTpen,TEXTpoints);INT VARreadpos;REAL VARfak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;PICTURE PROCnilpicture:PICTURE:(1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCdraw(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright):write(p,t,angle,height,bright,textkey)END PROCdraw;PROCwrite(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright,INT CONSTkey):IFmaxtext-length(p.points)>=length(t)THENp.pointsCATcode(key);replace(i1,1,length(t));p.pointsCATi1;p.pointsCATt;replace(r3,1,angle);replace(r3,2,height);replace(r3,3,bright);p.pointsCATr3FI END PROCwrite;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTkey):IFlength(p.points)<max2dimTHENp.pointsCATcode(key);replace(r2,1,x);replace(r2,2,y);p.pointsCATr2ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCpen(PICTURE VARp,INT CONSTpen):IFpen<0ORpen>16THENerrorstop("pen out of range [0-16]")END IF;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;PROCplot(PICTURE CONSTp):INT CONSTpiclength:=length(p.points);readpos:=0;plottwodimpic.plottwodimpic:WHILEreadpos<piclengthREPplottwodimpositionPER.plottwodimposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:draw(nextreal,nextreal)CASEmovekey:move(nextreal,nextreal)CASEtextkey:draw(nexttext,nextreal,fak*nextreal,fak*nextreal)OTHERWISEerrorstop("wrong key code")END SELECT.nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nexttext:INT CONSTtextlength:=nextint;readposINCRtextlength;subtext(p.points,readpos-textlength+1,readpos).nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1END PROCplot;PROCcmfaktor(REAL CONSTn):fak:=nEND PROCcmfaktor;END PACKETpicture
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte b/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte
new file mode 100644
index 0000000..1a12aed
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte
@@ -0,0 +1,8 @@
+PACKETreferenzobjekteDEFINES TERM,LISTE,=,<>,:=,nil,lowlevel,highlevel,ebene,initialisieren,neueliste,anhaengen,nachfolger,listenanfang,listenende,laenge,auswahl,standardfunktionen,eigenefunktionen,temporaerefunktionen,listenposition,termanzahl,variablenanzahl,anhaengenaneigenefunktionen,anhaengenantemporaerefunktionen,entfernenauseigenenfunktionen,entfernenaustemporaerenfunktionen,alphasort,variablenidentitaet,standardfunktion,eigenefunktion,temporaerefunktion,funktionsdefinition,variablenliste,variable,termliste,ausdruck,dyadisch,monadisch,funktionsauswertung,abbildungsdyade,abbildungsmonade,ableitungsoperation,konstante,selektion,logischedyade,vergleich,neweigenefunktion,newtemporaerefunktion,newfunktionsdefinition,newvariablenliste,newvariable,newtermliste,newterm,newdyade,newmonade,newfunktionsauswertung,newabbildungsdyade,newabbildungsmonade,newableitungsoperation,newkonstante,newselektion,newlogischedyade,newvergleich,LOESCHE,IS,LINKS,RECHTS,OPERAND,WERT,OPERATION,NAME,ARGUMENTE,DEFINITION,TERME,VARIABLEN,PLATZ,LISTENANFANG,LISTENENDE,LAENGE,ELEMENT,ABBILDUNGSAUSDRUCK,KOMPONENTE,INDEX,AUSDRUCK,BEDINGUNG,AKTION,ALTERNATIVE:LETtabellengroesse=16000,OBJEKTTABELLE=STRUCT(TERMzeigerauffreientabellenplatz,LISTElistederstandardfunktionen,listeeigenerfunktionen,listetemporaererfunktionen,dummyROWtabellengroesseTEXTzeile);TYPE TERM=INT,LISTE=STRUCT(TERManfang,ende,INTlaenge),ART=INT;TERM CONSTwurzel:=TERM:(tabellengroesse),nil:=TERM:(0);ART CONSTstandardfunktion:=ART:(1),eigenefunktion:=ART:(2),temporaerefunktion:=ART:(3),funktionsdefinition:=ART:(4),variablenliste:=ART:(5),variable:=ART:(6),termliste:=ART:(7),ausdruck:=ART:(8),dyadisch:=ART:(9),monadisch:=ART:(10),funktionsauswertung:=ART:(11),abbildungsdyade:=ART:(12),abbildungsmonade:=ART:(13),ableitungsoperation:=ART:(14),konstante:=ART:(15),selektion:=ART:(16),logischedyade:=ART:(17),vergleich:=ART:(18);BOUND OBJEKTTABELLE VARtabelle;TEXT VARdatenraumname:="mathematikobjekte 1";TEXT CONSTtextvonnil:=textvon(nil);OP:=(TERM VARlinks,TERM CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;BOOL OP=(TERM CONSTlinks,rechts):CONCR(links)=CONCR(rechts)END OP=;BOOL OP<>(TERM CONSTlinks,rechts):CONCR(links)<>CONCR(rechts)END OP<>;OP:=(LISTE VARlinks,LISTE CONSTrechts):links.anfang:=rechts.anfang;links.ende:=rechts.ende;links.laenge:=rechts.laengeEND OP:=;TERM PROClistenanfang(LISTE CONSTliste):liste.anfangEND PROClistenanfang;TERM PROClistenende(LISTE CONSTliste):liste.endeEND PROClistenende;INT PROClaenge(LISTE CONSTliste):liste.laengeEND PROClaenge;LISTE PROCneueliste(TERM CONSTanfang,ende):LISTE VARliste;initialisierediezeiger;bestimmelistenlaenge;liste.initialisierediezeiger:liste.anfang:=anfang;liste.ende:=ende.bestimmelistenlaenge:TERM VARzeiger:=liste.anfang;liste.laenge:=0;WHILEzeiger<>nilREPliste.laengeINCR1;zeiger:=nachfolger(zeiger)END REP END PROCneueliste;PROCanhaengen(LISTE VARliste,TERM CONSTneueselement):IFneueselement=nilTHENerrorstop(anwendungstext(1))END IF;IFleerelisteTHENliste.anfang:=neueselementELSEliste.endeZEIGTAUFneueselementEND IF;liste.ende:=neueselement;neueselementZEIGTAUFnil;liste.laengeINCR1.leereliste:liste.laenge=0END PROCanhaengen;PROCentfernen(LISTE VARliste,TERM CONSTloeschelement):IF(loeschelement=nil)CORleerelisteTHENerrorstop(anwendungstext(1))ELIFloeschelement=liste.anfangTHENliste.anfang:=nachfolger(liste.anfang);IFliste.laenge=1THENliste.ende:=nilEND IF ELIFloeschelement=listenende(liste)THENliste.ende:=vorgaenger(liste,loeschelement);vorgaenger(liste,loeschelement)ZEIGTAUFnilELSEvorgaenger(liste,loeschelement)ZEIGTAUFnachfolger(loeschelement)END IF;loeschelementZEIGTAUFnil;liste.laengeDECR1.leereliste:liste.laenge=0END PROCentfernen;TERM PROCnachfolger(TERM CONSTp):TERM VARnaechster;IF(p=nil)COR(tabelle.zeile(CONCR(p))="")THENerrorstop(anwendungstext(1))END IF;CONCR(naechster):=subtext(tabelle.zeile(CONCR(p)),2)ISUB1;naechsterEND PROCnachfolger;TERM PROCvorgaenger(LISTE CONSTliste,TERM CONSTzeiger):TERM VARlaufterm,merker;IF(zeiger=liste.
+anfang)COR(liste.laenge<=1)THENerrorstop(anwendungstext(4))END IF;laufterm:=liste.anfang;WHILE(laufterm<>zeiger)CAND(laufterm<>nil)REP IFlaufterm<>zeigerTHENmerker:=laufterm;laufterm:=nachfolger(laufterm)END IF END REP;IFlaufterm=nilTHENerrorstop(anwendungstext(4))END IF;merkerEND PROCvorgaenger;OP ZEIGTAUF(TERM CONSTlinks,rechts):IFlinks=nilTHENerrorstop(anwendungstext(1))END IF;replace(tabelle.zeile(CONCR(links)),2,textvon(rechts))END OP ZEIGTAUF;TERM PROCauswahl(LISTE CONSTliste,INT CONSTgewuenschteselement):TERM VARsuchzeiger:=listenanfang(liste);INT VARi;IFlaenge(liste)<gewuenschteselementCORgewuenschteselement<1THENerrorstop(anwendungstext(4))END IF;FORiFROM2UPTOgewuenschteselementREPsuchzeiger:=nachfolger(suchzeiger)END REP;suchzeigerEND PROCauswahl;TERM PROClistenposition(LISTE CONSTobjektliste,TEXT CONSTname):TERM VARsuchzeiger:=listenanfang(objektliste);TEXT VARnameohneblanks:=name;changeall(nameohneblanks," ","");WHILE(suchzeiger<>nil)REP IFnameohneblanks=NAMEsuchzeigerTHEN LEAVElistenpositionWITHsuchzeigerELSEsuchzeiger:=nachfolger(suchzeiger)END IF END REP;suchzeigerEND PROClistenposition;INT PROCtermanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE TERME DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(5));1END IF END PROCtermanzahl;INT PROCvariablenanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE VARIABLEN DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(6));1END IF END PROCvariablenanzahl;LISTE PROCstandardfunktionen:tabelle.listederstandardfunktionenEND PROCstandardfunktionen;LISTE PROCeigenefunktionen:tabelle.listeeigenerfunktionenEND PROCeigenefunktionen;LISTE PROCtemporaerefunktionen:tabelle.listetemporaererfunktionenEND PROCtemporaerefunktionen;PROCanhaengenanstandardfunktionen(TERM CONSTneueselement):anhaengen(tabelle.listederstandardfunktionen,neueselement)END PROCanhaengenanstandardfunktionen;PROCanhaengenaneigenefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listeeigenerfunktionen,neueselement)END PROCanhaengenaneigenefunktionen;PROCanhaengenantemporaerefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listetemporaererfunktionen,neueselement)END PROCanhaengenantemporaerefunktionen;PROCentfernenauseigenenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listeeigenerfunktionen,zeiger)END PROCentfernenauseigenenfunktionen;PROCentfernenaustemporaerenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listetemporaererfunktionen,zeiger)END PROCentfernenaustemporaerenfunktionen;TERM PROCalphasort(LISTE VARliste,TEXT CONSTvariablenname):testeparameter;sortiereein.testeparameter:IF NOT((liste.anfang<>nil)CAND(liste.anfangISvariable))THENerrorstop(anwendungstext(1))END IF.sortiereein:TERM VARvorgaenger:=liste.anfang,lauf:=nachfolger(vorgaenger),neuerterm;INT VARanzahl:=2;WHILE(lauf<>nil)CAND(NAMElauf)<variablennameREPanzahlINCR1;vorgaenger:=lauf;lauf:=nachfolger(lauf)END REP;neuerterm:=newvariable(anzahl,variablenname);neuertermZEIGTAUFlauf;vorgaengerZEIGTAUFneuerterm;IFlauf=nilTHENliste.ende:=neuertermELSE WHILElauf<>nilREPanzahlINCR1;replace(tabelle.zeile(CONCR(lauf)),4,textvon(anzahl));lauf:=nachfolger(lauf)END REP END IF;liste.laenge:=anzahl;neuertermEND PROCalphasort;BOOL PROCvariablenidentitaet(LISTE CONSTlinks,rechts):laenge(links)=laenge(rechts)CANDidentischenamen.identischenamen:TERM VARlauf1:=listenanfang(links),lauf2:=listenanfang(rechts)WHILElauf2<>nilREP IF(NAMElauf1<>NAMElauf2)THEN LEAVEvariablenidentitaetWITH FALSE END IF;lauf1:=nachfolger(lauf1);lauf2:=nachfolger(lauf2)END REP;TRUE END PROCvariablenidentitaet;TERM PROCnewstandardfunktion(TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewstandardfunktion;TERM PROC
+neweigenefunktion(TERM CONSTdefinition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCneweigenefunktion;TERM PROCnewtemporaerefunktion(TERM CONSTdefinition):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);neuertermEND PROCnewtemporaerefunktion;TERM PROCnewfunktionsdefinition(TERM CONSTvariablenliste,termliste):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(variablenliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(termliste);neuertermEND PROCnewfunktionsdefinition;TERM PROCnewvariablenliste(TERM CONSTerstevariable,letztevariable,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(erstevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(letztevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewvariablenliste;TERM PROCnewvariable(INT CONSTposition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(position);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewvariable;TERM PROCnewtermliste(TERM CONSTersterterm,letzterterm,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(ersterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(letzterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewtermliste;TERM PROCnewterm(TERM CONSTarithmetischerausdruck):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(arithmetischerausdruck);neuertermEND PROCnewterm;TERM PROCnewdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewdyade;TERM PROCnewmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="
+";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewmonade;TERM PROCnewfunktionsauswertung(TERM CONSTabbildungsausdruck,argumentliste,INT CONSTkomponente):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(argumentliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);neuertermEND PROCnewfunktionsauswertung;TERM PROCnewabbildungsdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsdyade;TERM PROCnewabbildungsmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="
";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsmonade;TERM PROCnewableitungsoperation(TERM CONST
+abbildungsausdruck,INT CONSTvariable,komponente,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(variable);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewableitungsoperation;TERM PROCnewkonstante(REAL CONSTwert,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(wert);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewkonstante;TERM PROCnewselektion(TERM CONSTbedingung,ausdruck,naechsteselektion):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(bedingung);tabelle.zeile(CONCR(neuerterm))CATtextvon(ausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(naechsteselektion);neuertermEND PROCnewselektion;TERM PROCnewlogischedyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewlogischedyade;TERM PROCnewvergleich(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuerterm.END PROCnewvergleich;TERM PROCallokiereterm:TERM VARfreierterm;bestimmedenallokiertenzeiger;tabelle.zeigerauffreientabellenplatz:=naechsterfreierplatz;freierterm.bestimmedenallokiertenzeiger:IFtabelle.zeigerauffreientabellenplatz=nilTHENerrorstop(anwendungstext(2))END IF;freierterm:=tabelle.zeigerauffreientabellenplatz.naechsterfreierplatz:TERM VARsucher:=freierterm;REP CONCR(sucher)DECR1;IFsucher=nilTHEN CONCR(sucher):=tabellengroesse+1ELIFsucher=freiertermTHEN LEAVEnaechsterfreierplatzWITHnilELIFtabelle.zeile(CONCR(sucher))=""THEN LEAVEnaechsterfreierplatzWITHsucherEND IF END REP;sucherEND PROCallokiereterm;TEXT PROCtextvon(REAL CONSTwert):TEXT VARachtbyte:="        ";replace(achtbyte,1,wert);achtbyteEND PROCtextvon;TEXT PROCtextvon(INT CONSTwert):TEXT VARzweibyte:="  ";replace(zweibyte,1,wert);zweibyteEND PROCtextvon;TEXT PROCtextvon(TERM CONSTzeiger):textvon(CONCR(zeiger))END PROCtextvon;TEXT OP NAME(TERM CONSTterm):IFtermISstandardfunktionTHENsubtext(tabelle.zeile(CONCR(term)),4)ELIF(termISvariable)COR(termISeigenefunktion)THENsubtext(tabelle.zeile(CONCR(term)),6)ELIFtermISkonstanteTHENsubtext(tabelle.zeile(CONCR(term)),12)ELSEerrorstop(anwendungstext(12));""END IF END OP NAME;TERM OP DEFINITION(TERM CONSTterm):TERM VARdefinition;IF(termISeigenefunktion)COR(termIStemporaerefunktion)THEN CONCR(definition):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(16))END IF;definitionEND OP DEFINITION;TERM OP VARIABLEN(TERM CONSTterm):TERM VARvariablen;IFtermISfunktionsdefinitionTHEN CONCR(variablen):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(19))END IF;variablenEND OP VARIABLEN;TERM OP TERME(TERM CONSTterm):TERM VARterme;IF(termISfunktionsdefinition)THEN CONCR(terme):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(17))END IF;termeEND OP TERME;TERM OP LISTENANFANG(TERM CONSTterm):TERM VARanfang;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(anfang):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(21))END IF;anfangEND OP LISTENANFANG;TERM OP LISTENENDE(TERM CONSTterm):TERM VARende;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(ende):=subtext(tabelle.zeile(CONCR(
+term)),6)ISUB1ELSEerrorstop(anwendungstext(22))END IF;endeEND OP LISTENENDE;INT OP LAENGE(TERM CONSTterm):IF NOT((termISvariablenliste)COR(termIStermliste))THENerrorstop(anwendungstext(20))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP LAENGE;TERM OP ELEMENT(TERM CONSTlistenzeiger,INT CONSTnteselement):IF NOT((listenzeigerIStermliste)XOR(listenzeigerISvariablenliste))THENerrorstop(anwendungstext(18))END IF;auswahl(neueliste(LISTENANFANGlistenzeiger,LISTENENDElistenzeiger),nteselement)END OP ELEMENT;INT OP PLATZ(TERM CONSTterm):IF NOT(termISvariable)THENerrorstop(anwendungstext(25))END IF;subtext(tabelle.zeile(CONCR(term)),4)ISUB1END OP PLATZ;TERM OP AUSDRUCK(TERM CONSTterm):TERM VARformel;IF(termISausdruck)THEN CONCR(formel):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(27))END IF;formelEND OP AUSDRUCK;TERM OP LINKS(TERM CONSTterm):TERM VARlinks;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(links):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(7))END IF;linksEND OP LINKS;TERM OP RECHTS(TERM CONSTterm):TERM VARrechts;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(rechts):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(8))END IF;rechtsEND OP RECHTS;TEXT OP OPERATION(TERM CONSTterm):TEXT VARop;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENop:=subtext(tabelle.zeile(CONCR(term)),8)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENop:=subtext(tabelle.zeile(CONCR(term)),6)ELIFtermISableitungsoperationTHENop:=subtext(tabelle.zeile(CONCR(term)),10)ELSEerrorstop(anwendungstext(10))END IF;opEND OP OPERATION;TERM OP OPERAND(TERM CONSTterm):TERM VARoperand;IF(termISmonadisch)COR(termISabbildungsmonade)THEN CONCR(operand):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(9))END IF;operandEND OP OPERAND;TERM OP ABBILDUNGSAUSDRUCK(TERM CONSTterm):TERM VARfunktionsterm;IF(termISfunktionsauswertung)COR(termISableitungsoperation)THEN CONCR(funktionsterm):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(23))END IF;funktionstermEND OP ABBILDUNGSAUSDRUCK;TERM OP ARGUMENTE(TERM CONSTterm):TERM VARargumente;IF(termISfunktionsauswertung)THEN CONCR(argumente):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(13))END IF;argumenteEND OP ARGUMENTE;INT OP KOMPONENTE(TERM CONSTterm):IF NOT((termISfunktionsauswertung)COR(termISableitungsoperation))THENerrorstop(anwendungstext(24))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP KOMPONENTE;INT OP INDEX(TERM CONSTterm):IF NOT(termISableitungsoperation)THENerrorstop(anwendungstext(26))END IF;subtext(tabelle.zeile(CONCR(term)),6)ISUB1END OP INDEX;REAL OP WERT(TERM CONSTterm):IF NOT(termISkonstante)THENerrorstop(anwendungstext(11))END IF;subtext(tabelle.zeile(CONCR(term)),4)RSUB1END OP WERT;TERM OP BEDINGUNG(TERM CONSTterm):TERM VARbedingung;IFtermISselektionTHEN CONCR(bedingung):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(28))END IF;bedingungEND OP BEDINGUNG;TERM OP AKTION(TERM CONSTterm):TERM VARaktion;IFtermISselektionTHEN CONCR(aktion):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(29))END IF;aktionEND OP AKTION;TERM OP ALTERNATIVE(TERM CONSTterm):TERM VARalternative;IFtermISselektionTHEN CONCR(alternative):=subtext(tabelle.zeile(CONCR(term)),8)ISUB1ELSEerrorstop(anwendungstext(30))END IF;alternativeEND OP ALTERNATIVE;PROClowlevel:datenraumname:="mathematikobjekte 1";ankoppelnEND PROClowlevel;PROChighlevel:datenraumname:="mathematikobjekte 2";ankoppelnEND PROChighlevel;INT PROCebene:int(datenraumnameSUB19)END PROCebene;PROCankoppeln:IFexists(datenraumname)THENtabelle:=old(datenraumname);IFdatenraumstrukturokCAND NOTiserrorTHENenablestop;LEAVEankoppelnEND IF;IFiserrorTHENclearerror;enablestopEND IF END IF;initialisieren.datenraumstrukturok:disablestop;(
+listenanfang(standardfunktionen)ISstandardfunktion)AND NAMEnachfolger(listenanfang(standardfunktionen))="cos"END PROCankoppeln;PROCinitialisieren:LETanzahlelementarerfunktionen=19;INT VARi;ROWanzahlelementarerfunktionenTEXT CONSTname:=ROWanzahlelementarerfunktionenTEXT:("sin","cos","tan","cot","arcsin","arccos","arctan","arccot","ln","log2","log10","exp","sign","abs","wurzel","gauss","rund","ganz","frak");disablestop;footnote(anwendungstext(61));koppleeinendatenrauman;initialisieredieobjekttabelle;initialisieredielisten;tragedieelementarenabbildungenein;enablestop.koppleeinendatenrauman:forget(datenraumname,quiet);tabelle:=new(datenraumname).initialisieredieobjekttabelle:FORiFROMtabellengroesseDOWNTO1REPtabelle.zeile(i):=""END REP.initialisieredielisten:tabelle.zeigerauffreientabellenplatz:=wurzel;tabelle.listederstandardfunktionen:=neueliste(nil,nil);tabelle.listeeigenerfunktionen:=neueliste(nil,nil);tabelle.listetemporaererfunktionen:=neueliste(nil,nil);tabelle.dummy:=neueliste(nil,nil).tragedieelementarenabbildungenein:FORiFROM1UPTOanzahlelementarerfunktionenREPanhaengenanstandardfunktionen(newstandardfunktion(name(i)))END REP.END PROCinitialisieren;OP LOESCHE(TERM CONSTp):tabelle.zeile(CONCR(p)):="";IFtabellevoelliggefuelltTHENtabelle.zeigerauffreientabellenplatz:=pEND IF.tabellevoelliggefuellt:tabelle.zeigerauffreientabellenplatz=nil.END OP LOESCHE;BOOL OP IS(TERM CONSTt,ART CONSTtyp):(t<>nil)CAND(tabelle.zeile(CONCR(t))<>"")CANDcode(tabelle.zeile(CONCR(t))SUB1)=CONCR(typ)END OP IS;OP:=(ART VARlinks,ART CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;END PACKETreferenzobjekte;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic
new file mode 100644
index 0000000..2de7226
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic
@@ -0,0 +1,4 @@
+PACKETspezialgraphicDEFINESmatmove,matdraw,grapheditget,initscreenmemory,clearscreenmemory,plotscreenmemory,loeschezeichnung,loeschezeichnungpartiell,putscreenmemory,newpicture,deletelastpicture,vervollstaendigeaktuellezeichnung,druckeaktuellezeichnung:LEThop="�",rechts="�",bell="�",links="�",rubin="�",rubout="�",return="
",escapezeichen="�",rubinmark="^",cursorverschiebung=1,blank=" ",niltext="",bildspeichertyp=1055,maximalanzahl=128,maxzeichnungen=25,printerdepot="MATHE-PRINTERDEPOT";TYPE PICROW=STRUCT(INTeof,ROWmaximalanzahlPICTUREzeichnung,ROW4REALfenstergroesseREALquellbreite,quellhoehe);BOUND PICROW VARscreenmemory;DATASPACE VARds;INT CONSTcursorbreite:=zeichenbreite-1;BOOL VARcursoron:=FALSE;INT VARaltx,alty,xpixelanzahl,ypixelanzahl;REAL VARxcmgroesse,ycmgroesse,startpunktx,startpunkty;PROCmatmove(REAL CONSTx,y):startpunktx:=x;startpunkty:=yEND PROCmatmove;PROCmatdraw(REAL CONSTx,y):BOOL VARunsichtbar;REAL VARendpunktx:=x,endpunkty:=y,letzterendpunktx,letzterendpunkty;clip(startpunktx,startpunkty,endpunktx,endpunkty,unsichtbar);IF NOTunsichtbarTHEN IFlength(screenmemory.zeichnung(screenmemory.eof))>31960THENstretchpictureEND IF;where(letzterendpunktx,letzterendpunkty);IFstartpunktx<>letzterendpunktxCORstartpunkty<>letzterendpunktyTHENmove(startpunktx,startpunkty);move(screenmemory.zeichnung(screenmemory.eof),startpunktx,startpunkty)END IF;IFletzterendpunktx<>endpunktxCORletzterendpunkty<>endpunktyTHENdraw(endpunktx,endpunkty);draw(screenmemory.zeichnung(screenmemory.eof),endpunktx,endpunkty)END IF END IF;matmove(x,y)END PROCmatdraw;PROCclip(REAL VARxbeg,ybeg,xend,yend,BOOL VARnothingvisible):REAL VARdifbeg,difend;REAL CONSTxdif:=xend-xbeg,ydif:=yend-ybeg;BOOL VARcutbeg,cutend;windowlinksclip;windowrechtsclip;windowuntenclip;windowobenclip.windowlinksclip:difbeg:=windowxmin-xbeg;difend:=windowxmin-xend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxminELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxminEND IF.windowrechtsclip:difbeg:=windowxmax-xbeg;difend:=windowxmax-xend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxmaxELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxmaxEND IF.windowuntenclip:difbeg:=windowymin-ybeg;difend:=windowymin-yend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowyminELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowyminEND IF.windowobenclip:difbeg:=windowymax-ybeg;difend:=windowymax-yend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowymaxELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowymaxEND IF END PROCclip;PROCeditgetcursor(INT CONSTi,j):loeschecursor;altx:=(i-1)*zeichenbreite;alty:=ypixelanzahl-(j*zeichenhoehe)-cursorverschiebung;move(altx,alty);draw(altx+cursorbreite,alty);cursoron:=TRUE;cursor(i,j)END PROCeditgetcursor;PROCloeschecursor:IFcursoronTHENpen(0,0,0,1);move(altx,alty);draw(altx+cursorbreite,alty);pen(1,1,1,1);cursoron:=FALSE END IF END PROCloeschecursor;PROCgrapheditget(TEXT VAReingabe,INT CONSTfeldlaenge,TEXT CONSTescausstiegszeichen,TEXT VARausstieg):TEXT VARch;INT VARxanfang,yanfang,cursorpos,textpointer,maxcursorpos,zielpos;BOOL VARrubinmode;initialisiereeditor;REPinchar(ch);IFch=returnTHENausstieg:=niltext;loeschecursor;eingabe:=compress(eingabe);LEAVEgrapheditgetELIFch=escapezeichenTHENinchar(ausstieg);IFpos(escausstiegszeichen,ausstieg)<>0THENloeschecursor;LEAVEgrapheditgetEND IF ELIFch=linksTHENfuehrecursorlinksausELIFch=rechtsTHENfuehrecursorrechtsausELIFch=rubinTHENfuehrerubinausELIFch=ruboutTHENfuehreruboutausELIFch=hopTHENinchar(ch);IFch=linksTHENfuehrehoplinksausELIFch=rechtsTHENfuehrehoprechtsausELIFch=
+ruboutTHENfuehrehopruboutausEND IF ELIFcode(ch)>=32THENfuehrenormaleszeichenausEND IF END REP.initialisiereeditor:clearbuffer;drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);rubinmode:=FALSE;textpointer:=1;getcursor(xanfang,yanfang);cursorpos:=xanfang;maxcursorpos:=xanfang+feldlaenge;out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang).fuehrecursorlinksaus:IFcursorpos>xanfangTHENcursorposDECR1;editgetcursor(cursorpos,yanfang)ELIFtextpointer>1THENtextpointerDECR1;cursor(xanfang,yanfang);out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang)END IF.fuehrecursorrechtsaus:IFcursorpos-xanfang+textpointer<=length(eingabe)THEN IFcursorpos<maxcursorposTHENcursorposINCR1;editgetcursor(cursorpos,yanfang)ELSEtextpointerINCR1;cursor(xanfang,yanfang);out(text(eingabe,feldlaenge,textpointer));editgetcursor(maxcursorpos,yanfang)END IF END IF.fuehrerubinaus:TEXT VARt;rubinmode:=NOTrubinmode;IFrubinmodeTHEN IFcursorpos<maxcursorposTHENout(rubinmark);pause(3);cursor(cursorpos,yanfang);t:=eingabeSUB(cursorpos-xanfang+textpointer);IFt=niltextTHENt:=blankEND IF;out(t);editgetcursor(cursorpos,yanfang)END IF END IF.fuehreruboutaus:zielpos:=cursorpos-xanfang+textpointer;change(eingabe,zielpos,zielpos,niltext);out(text(eingabe,feldlaenge-(cursorpos-xanfang),zielpos));editgetcursor(cursorpos,yanfang).fuehrehoplinksaus:IFtextpointer>1THENcursor(xanfang,yanfang);textpointer:=1;out(text(eingabe,feldlaenge,textpointer))END IF;cursorpos:=xanfang;editgetcursor(cursorpos,yanfang).fuehrehoprechtsaus:IFlength(eingabe)<feldlaengeTHENcursorpos:=length(eingabe)+xanfangELIFcursorpos-xanfang+textpointer<=length(eingabe)THENzielpos:=length(eingabe)+1-feldlaenge;cursor(xanfang,yanfang);textpointer:=zielpos;out(text(eingabe,feldlaenge,zielpos));getcursor(cursorpos,yanfang)END IF;editgetcursor(cursorpos,yanfang).fuehrehopruboutaus:zielpos:=cursorpos-xanfang;eingabe:=subtext(eingabe,1,zielpos+textpointer-1);out((feldlaenge-zielpos)*blank);editgetcursor(cursorpos,yanfang).fuehrenormaleszeichenaus:IFrubinmodeTHENzielpos:=cursorpos-xanfang+textpointer;eingabe:=subtext(eingabe,1,zielpos-1)+ch+subtext(eingabe,zielpos,length(eingabe));IFcursorpos<maxcursorposTHENout(text(eingabe,maxcursorpos-cursorpos,zielpos))ELSEcursor(xanfang,yanfang);textpointerINCR1;out(text(eingabe,feldlaenge,textpointer))END IF ELSEzielpos:=cursorpos-xanfang+textpointer;IFzielpos>length(eingabe)THENeingabeCATblankEND IF;replace(eingabe,zielpos,ch);IFcursorpos<maxcursorposTHENout(ch)ELSEcursor(xanfang,yanfang);textpointerINCR1;out(text(eingabe,feldlaenge,textpointer))END IF END IF;IFcursorpos<maxcursorposTHENcursorposINCR1END IF;editgetcursor(cursorpos,yanfang)END PROCgrapheditget;PROCinitscreenmemory:forget(ds);ds:=nilspace;screenmemory:=ds;screenmemory.eof:=1;screenmemory.zeichnung(screenmemory.eof):=nilpictureEND PROCinitscreenmemory;PROCclearscreenmemory:forget(ds)END PROCclearscreenmemory;PROCplotscreenmemory:INT VARi;FORiFROM1UPTOscreenmemory.eofREP IFlength(screenmemory.zeichnung(i))<>0THENpen(1,1,1,pen(screenmemory.zeichnung(i)));plot(screenmemory.zeichnung(i))END IF END REP END PROCplotscreenmemory;PROCloeschezeichnung:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO1REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP END PROCloeschezeichnung;PROCloeschezeichnungpartiell:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO2REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP;screenmemory.eof:=2;plotscreenmemoryEND PROCloeschezeichnungpartiell;PROCputscreenmemory(PICTURE CONSTp):IFscreenmemory.eof=maximalanzahlTHENscreenmemory.eof:=1END IF;screenmemory.zeichnung(screenmemory.eof):=p;screenmemory.eofINCR1;screenmemory.zeichnung(screenmemory.eof):=nilpictureEND PROCputscreenmemory;PROCvervollstaendigeaktuellezeichnung(REAL CONSTxmin,xmax,ymin,ymax,breite,hoehe):screenmemory.fenstergroesse(1):=xmin;screenmemory.fenstergroesse(2):=xmax;screenmemory.fenstergroesse(3):=
+ymin;screenmemory.fenstergroesse(4):=ymax;screenmemory.quellbreite:=breite;screenmemory.quellhoehe:=hoeheEND PROCvervollstaendigeaktuellezeichnung;INT VARanzahlfolgebilder:=0;PROCstretchpicture:anzahlfolgebilderINCR1;setzeweiter(pen(screenmemory.zeichnung(screenmemory.eof)))END PROCstretchpicture;PROCnewpicture(INT CONSTnr):anzahlfolgebilder:=0;setzeweiter(nr)END PROCnewpicture;PROCsetzeweiter(INT CONSTnr):screenmemory.eofINCR1;IFscreenmemory.eof>maximalanzahlTHENscreenmemory.eof:=2END IF;screenmemory.zeichnung(screenmemory.eof):=nilpicture;pen(screenmemory.zeichnung(screenmemory.eof),nr)END PROCsetzeweiter;PROCdeletelastpicture:IFscreenmemory.eof>1+anzahlfolgebilderTHENscreenmemory.eofDECR(1+anzahlfolgebilder)END IF END PROCdeletelastpicture;PROCdruckeaktuellezeichnung:enablestop;bestimmezieltaskname;benennedatenraum;versendedatenraum.bestimmezieltaskname:IF NOTexiststask(printerdepot)CORinhalt(ALL(/printerdepot))>=maxzeichnungenTHENout(bell);LEAVEdruckeaktuellezeichnungEND IF.benennedatenraum:TEXT VARbilddatenraum:="ZEICHNUNG "+date+" "+timeofday;IFexists(bilddatenraum,/printerdepot)THEN INT VARzaehler:=1;bilddatenraumCAT":";WHILEexists(bilddatenraum+text(zaehler),/printerdepot)REPzaehlerINCR1END REP;bilddatenraumCATtext(zaehler)END IF;type(ds,bildspeichertyp);copy(ds,bilddatenraum).versendedatenraum:IFstatus(/printerdepot)=2THENsave(bilddatenraum,/printerdepot)ELSEout(bell)END IF;forget(bilddatenraum,quiet)END PROCdruckeaktuellezeichnung;INT PROCinhalt(THESAURUS CONSTth):INT VARi:=0,zaehler:=0;TEXT VARname;get(th,name,i);WHILEi<>0REP IFname<>niltextTHENzaehlerINCR1END IF;get(th,name,i);END REP;zaehlerEND PROCinhalt;END PACKETspezialgraphic
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.umformung b/app/schulis-mathematiksystem/1.0/src/mat.umformung
new file mode 100644
index 0000000..001c0ca
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.umformung
@@ -0,0 +1,3 @@
+PACKETumformungDEFINESinitialisiereausgabedatei,formeum,loescheausgabedatei:LETniltext="",bell="�",beginmark="",endmark="",left="�",right="�",del="�",esc="�",blank=" ",arbeitsfunktionstitel="Arbeitsfunktion",titel1="Ableitung",titel2="Auflösung",titel3="aufgelöste Ableitung";FILE VARufdat;TEXT VARufdatname;INT VARausgabezeilennummer;INT VARfktwahl;PROCinitialisiereausgabedatei:ufdatname:=scratchdateiname;ufdat:=sequentialfile(output,ufdatname);ausgabezeilennummer:=1;fktwahl:=1END PROCinitialisiereausgabedatei;PROCformeum(ABBILDUNG CONSTf):WINDOW VARwt:=window(2,4,77,19);INT VARzeilenoffset:=0,ersteauszugebendespalte,ersteauszugebendezeile,alterwert;BOOL VARtemporaerefktexistiert:=FALSE;ABBILDUNG VARtempfkt;TEXT VARzulaessigeeingaben,ausstieg;bereiteprotokolldateivor;bearbeitedasobjekt;bereiteprotokolldateinach.bereiteprotokolldateivor:ersteauszugebendespalte:=1;ersteauszugebendezeile:=ausgabezeilennummer;output(ufdat);putline(ufdat,arbeitsfunktionstitel);IF NOTformeleditoraktivTHENputline(ufdat,funktionsstring(f));zeilenoffsetINCR3ELSEalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,f);line(ufdat);zeilenoffsetINCR(2+lines(ufdat)-alterwert)END IF;outframe(wt).bearbeitedasobjekt:REPzeigeprotokolldatei;bestimmeaktivitaet;fuehreaktivitaetausEND REP.zeigeprotokolldatei:scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bestimmeaktivitaet:TEXT VARchar;ROW3TEXT CONSTkommandozeile:=ROW3TEXT:(anwendungstext(230),anwendungstext(231),anwendungstext(232));REPclearbuffer;cursor(3,2);out(kommandozeile(fktwahl));cursor(78,24);inchar(char);IFchar=leftTHENfktwahl:=(fktwahl-2)MOD3+1ELIFchar=rightTHENfktwahl:=fktwahlMOD3+1ELIFchar=escTHENwerteescapesequenzausEND IF END REP.werteescapesequenzaus:zulaessigeeingaben:="?fnwqmd";inchar(ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(10));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))CASE2:betrachtedieausgabedateiCASE3:IFtemporaerefktexistiertTHENbenennedieletztetemporaerefunktion;outframe(wt);scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))END IF CASE4:LEAVEbestimmeaktivitaetCASE5,6:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektCASE7:druckversuch(ufdatname);outframe(wt);footnote(anwendungstext(132))END SELECT.betrachtedieausgabedatei:zulaessigeeingaben:="?dwqm";INT VARersterauszugebendersatz:=ausgabezeilennummer;cursor(1,2);out(del);REPfootnote(anwendungstext(133));scroll(wt,ufdatname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigeeingaben,ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(12));warteCASE2:druckversuch(ufdatname);outframe(wt)CASE3:LEAVEbetrachtedieausgabedateiCASE4,5:IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT END REP.benennedieletztetemporaerefunktion:TEXT VARvorgesehenername:=niltext;cursor(3,2);out(del);cursor(3,2);out(anwendungstext(172));REPfootnote(anwendungstext(174));cursor(23,2);out(beginmark);out(left);enablestop;editget(vorgesehenername,40,20);disablestop;cursor(43,2);out(endmark);IFvorgesehenername=niltextTHEN LEAVEbenennedieletztetemporaerefunktionEND IF;gibnamen(tempfkt,vorgesehenername);IFiserrorTHENgibmeldung(errormessage+vorgesehenername);clearerrorELSEgibmeldung(anwendungstext(227)+vorgesehenername+anwendungstext(228));temporaerefktexistiert:=FALSE;LEAVEbenennedieletztetemporaerefunktionEND IF END REP.fuehreaktivitaetaus:TEXT VARueberschrift;IFfktwahl<>2THENbestimmeableitungsparameterEND IF;footnote(anwendungstext(166));IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;SELECTfktwahlOF CASE1:ueberschrift:=titel1+ueberschriftrest;tempfkt:=ableitung(f,kompindex,varindex)CASE2:ueberschrift:=titel2;tempfkt:=aufloesung(f)CASE3:ueberschrift:=titel3+
+ueberschriftrest;ABBILDUNG VARtemp:=aufloesung(f);tempfkt:=ableitung(temp,kompindex,varindex);loeschetemporaereabbildung(temp)END SELECT;output(ufdat);putline(ufdat,ueberschrift);IFiserrorTHENclearerror;putline(ufdat,errormessage);zeilenoffsetINCR2ELIFformeleditoraktivTHENalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,tempfkt);line(ufdat);temporaerefktexistiert:=TRUE;zeilenoffsetINCR(1+lines(ufdat)-alterwert)ELSEputline(ufdat,funktionsstring(tempfkt));temporaerefktexistiert:=TRUE;zeilenoffsetINCR2END IF.bestimmeableitungsparameter:INT VARkompindex:=1,varindex:=1;BOOL CONSTtermeingabeerforderlich:=laenge(abbildungsterme(f))>1,variableneingabeerforderlich:=(ebene=2)CANDlaenge(abbildungsvariablen(f))>1;TEXT VARueberschriftrest:=niltext,variablenname:=NAMElistenanfang(abbildungsvariablen(f));IFtermeingabeerforderlichCORvariableneingabeerforderlichTHEN IFtermeingabeerforderlichTHENcursor(51,2);out("des Terms")END IF;IFvariableneingabeerforderlichTHENcursor(64,2);out("nach "+text(variablenname,8))END IF;lieswerteein;IFtermeingabeerforderlichTHENueberschriftrestCAT(" des "+text(kompindex)+". Terms")END IF;IFvariableneingabeerforderlichTHENueberschriftrestCAT(" nach "+variablenname)END IF;cursor(51,2);out(del)END IF.lieswerteein:zulaessigeeingaben:="?wqm";footnote(anwendungstext(209));REP IFtermeingabeerforderlichTHENbestimmeterm;werteausstiegausEND IF;IFvariableneingabeerforderlichTHENbestimmevariable;werteausstiegausEND IF END REP.bestimmeterm:TEXT VARtermziffer:=text(kompindex);BOOL VARgueltigerterm;REPcursor(61,2);out("�");enablestop;editget(termziffer,12,2,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);kompindex:=int(termziffer);gueltigerterm:=NOTiserrorCANDkorrektetermbezeichnung;IFgueltigertermTHENcursor(61,2);out(termziffer);LEAVEbestimmetermEND IF;IFiserrorTHENclearerrorEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektetermbezeichnung:lastconversionokCANDkompindex>0CANDkompindex<=laenge(abbildungsterme(f)).bestimmevariable:BOOL VARgueltigevariable;REPcursor(69,2);out("�");enablestop;editget(variablenname,20,8,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);cursor(69,2);out(text(variablenname,8,1));gueltigevariable:=korrektevariablenbezeichnung;IFgueltigevariableTHENvarindex:=PLATZt;LEAVEbestimmevariableEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektevariablenbezeichnung:changeall(variablenname,blank,niltext);TERM VARt:=listenposition(abbildungsvariablen(f),variablenname);t<>nil.werteausstiegaus:ausstieg:=ausstiegSUB2;SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:gibinformationzurparametereingabeCASE2:IFtermeingabeerforderlichCAND NOTgueltigertermTHEN LEAVEwerteausstiegausEND IF;IFvariableneingabeerforderlichCAND NOTgueltigevariableTHEN LEAVEwerteausstiegausEND IF;LEAVElieswerteeinCASE3,4:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT.gibinformationzurparametereingabe:show(formular(11));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bereiteprotokolldateinach:output(ufdat);line(ufdat);ausgabezeilennummerINCRzeilenoffsetEND PROCformeum;PROCloescheausgabedatei:forget(ufdatname,quiet)END PROCloescheausgabedatei;END PACKETumformung;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vector b/app/schulis-mathematiksystem/1.0/src/mat.vector
new file mode 100644
index 0000000..03439bc
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.vector
@@ -0,0 +1,2 @@
+PACKETvectorDEFINES VECTOR,:=,vector,SUB,LENGTH,length,nilvector,replace,=,<>,+,-,*,/:TYPE VECTOR=STRUCT(INTlng,TEXTelem),INITVECTOR=STRUCT(INTlng,REALvalue);INT VARi;TEXT VARt:="12345678";VECTOR VARv:=nilvector;OP:=(VECTOR VARl,VECTOR CONSTr):l.lng:=r.lng;l.elem:=r.elemEND OP:=;OP:=(VECTOR VARl,INITVECTOR CONSTr):l.lng:=r.lng;replace(t,1,r.value);l.elem:=r.lng*tEND OP:=;INITVECTOR PROCnilvector:vector(1,0.0)END PROCnilvector;INITVECTOR PROCvector(INT CONSTlng,REAL CONSTvalue):IFlng<=0THENerrorstop("PROC vector : lng <= 0")FI;INITVECTOR:(lng,value)END PROCvector;INITVECTOR PROCvector(INT CONSTlng):vector(lng,0.0)END PROCvector;REAL OP SUB(VECTOR CONSTv,INT CONSTi):test("REAL OP SUB : ",v,i);v.elemRSUBiEND OP SUB;INT OP LENGTH(VECTOR CONSTv):v.lngEND OP LENGTH;INT PROClength(VECTOR CONSTv):v.lngEND PROClength;PROCreplace(VECTOR VARv,INT CONSTi,REAL CONSTr):test("PROC replace : ",v,i);replace(v.elem,i,r)END PROCreplace;BOOL OP=(VECTOR CONSTl,r):l.elem=r.elemEND OP=;BOOL OP<>(VECTOR CONSTl,r):l.elem<>r.elemEND OP<>;VECTOR OP+(VECTOR CONSTv):vEND OP+;VECTOR OP+(VECTOR CONSTl,r):test("VECTOR OP + : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)+(r.elemRSUBi))PER;vEND OP+;VECTOR OP-(VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,-(a.elemRSUBi))PER;vEND OP-;VECTOR OP-(VECTOR CONSTl,r):test("VECTOR OP - : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)-(r.elemRSUBi))PER;vEND OP-;REAL OP*(VECTOR CONSTl,r):test("REAL OP * : ",l,r);REAL VARx:=0.0;FORiFROM1UPTOl.lngREPxINCR((l.elemRSUBi)*(r.elemRSUBi))PER;xEND OP*;VECTOR OP*(VECTOR CONSTv,REAL CONSTr):r*vEND OP*;VECTOR OP*(REAL CONSTr,VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,r*(a.elemRSUBi))PER;vEND OP*;VECTOR OP/(VECTOR CONSTa,REAL CONSTr):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(a.elemRSUBi)/r)PER;vEND OP/;TEXT VARerror:="";PROCtest(TEXT CONSTproc,VECTOR CONSTv,INT CONSTi):IFi>v.lngTHENerror:=proc;errorCAT"subscript overflow (LENGTH v=";errorCATtext(v.lng);errorCAT", i=";errorCATtext(i);errorCAT")";errorstop(error)ELIFi<1THENerror:=proc;errorCAT"subscript underflow (i = ";errorCATtext(i);errorCAT")";errorstop(error)FI END PROCtest;PROCtest(TEXT CONSTproc,VECTOR CONSTa,b):IFa.lng<>b.lngTHENerror:=proc;errorCAT"LENGTH a (";IFa.lng<=0THENerrorCAT"undefined"ELSEerrorCATtext(a.lng)FI;errorCAT") <> LENGTH b (";errorCATtext(b.lng);errorCAT")";errorstop(error)FI END PROCtest;END PACKETvector;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.verwaltung b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung
new file mode 100644
index 0000000..c65e789
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung
@@ -0,0 +1,1032 @@
+PACKET mathe verwaltung DEFINES mathe, 
+                                installiere mathesystem: 
+ 
+(**************************************************) 
+(*   G l o b a l e    D e k l a r a t i o n e n   *) 
+(**************************************************) 
+ 
+(* L E T   -  D e n o t e r *) 
+ 
+(* Ausgabetexte *) 
+ 
+LET systemname        = "s c h u l i s - Mathematiksystem    Version 1.0", 
+    titel 1           = "Systemverwaltung", 
+    titel 2           = "Installation", 
+    titel 3           = "Installation: Drucker", 
+    meldung 1         = "Das Mathematiksystem ist noch nicht installiert.", 
+    meldung 2         = "Kein Druckertreiber für Graphiken installiert.", 
+    meldung 3         = "1 ... Mathematiksystem - Ebene 1", 
+    meldung 4         = "2 ... Mathematiksystem - Ebene 2", 
+    meldung 5         = "3 ... Zeichnungen drucken", 
+    meldung 6         = "---------------------------------------", 
+    meldung 7         = "4 ... Neuinstallation: Mathematiksystem", 
+    meldung 8         = "5 ... Neuinstallation: Graphikdrucker", 
+    meldung 9         = "q ... Mathematiksystem verlassen", 
+    meldung 10        = "Gewünschte Funktion:", 
+    meldung 11        = "Bitte wählen Sie unter folgenden Anpassungen eine", 
+    meldung 12        = "für Ihr Terminal und die zugehörige Grafikkarte", 
+    meldung 13        = "angemessene heraus:", 
+    meldung 14        = "                 hercules-Anpassung", 
+    meldung 15        = "                 cga-Anpassung", 
+    meldung 16        = "                 ega-Anpassung", 
+    meldung 17        = "                 vga-Anpassung", 
+    meldung 18        = "Solange vorgeschlagene Anpassung verneinen <n/N>", 
+    meldung 19        = "bis passende genannt wird.", 
+    meldung 20        = "Diese bejahen <j/J/y/Y>.", 
+    meldung 21        = "Installation korrekt beendet", 
+    meldung 22        = "Installation wegen Systemfehler gestoppt", 
+    meldung 23        = "Verfügt das Terminal über den IBM-Zeichensatz", 
+    meldung 24        = "Soll das vorhandene Mathematiksystem gelöscht werden", 
+    meldung 25        = "Soll der vorhandene Druckertreiber gelöscht werden", 
+    meldung 26        = "Weiter mit beliebiger Taste", 
+    meldung 27        = "Geladen wird Datei Nr. ", 
+    meldung 28        = "Die benötigten Dateien sind vollständig geladen.", 
+    meldung 29        = "Sie können die Diskette aus dem Laufwerk nehmen.", 
+    meldung 30        = "Bitte warten - das Mathematiksystem wird installiert.", 
+    meldung 31        = "Installiert wird Datei      von ", 
+    meldung 32        = "Fehler bei der Übersetzung der Programme.", 
+    meldung 33        = "   richtige Anpassung", 
+    meldung 34        = "für Ihren Drucker geeigenete aus:", 
+    meldung 35        = "  DRUCKER          PLOTTER", 
+    meldung 36        = "  xerox 4045       hp 72xx", 
+    meldung 37        = "  epson sq         hp 74xx", 
+    meldung 38        = "  epson fx", 
+    meldung 39        = "  binder 8600", 
+    meldung 40        = "  kyocera", 
+    meldung 41        = "  hp laserjet", 
+    meldung 42        = "Bitte warten - der Druckertreiber wird installiert", 
+    meldung 43        = "Bitte zunächst das Mathematiksystem installieren.", 
+    meldung 44        = 
+         "Zunächst müssen die erforderlichen Dateien geladen werden.", 
+    meldung 45        = "Passwort: ", 
+    meldung 46        = "Soll das System mit einem Passwort geschützt werden", 
+    meldung 47        = 
+         "Fehler: Die Diskette ist ungültig oder nicht korrekt eingelegt!", 
+    meldung 49        = "Installation vorzeitig abgebrochen", 
+    meldung 50        = "Bitte legen sie eine Diskette der Anwendung", 
+    meldung 51        = "in das Laufwerk und schließen es.", 
+    meldung 52        = "Installation fortsetzen: <w>", 
+    meldung 53        = "Installation abbrechen : <ESC>", 
+    meldung 54        = "Bitte legen Sie eine weitere Diskette der Anwendung", 
+    menutasten        = "12345q", 
+    zeilen menu 1     = 10, 
+    zeilen menu 2     = 12, 
+    zeilen menu 3     = 14, 
+ 
+(* d o  - Kommandos *) 
+ 
+    menu ankoppeln    = "install menu (""ls-MENUKARTE:Mathematik"", FALSE)", 
+    ebene 1 handle    = "handle menu (""Ebene 1"")", 
+    ebene 2 handle    = "handle menu (""Ebene 2"")", 
+    druckmenu handle  = "handle menu (""Drucken"")", 
+    ibmsatzzeichen    = "ibmgraphicchar", 
+    stdsatzzeichen    = "stdgraphicchar", 
+    ibmops ankoppeln  = "load ops (""ibmoperatoren"")", 
+    stdops ankoppeln  = "load ops (""standardoperatoren"")", 
+    fe manager        = "formelmanager", 
+    plotter ein       = "plotter eingestellt (TRUE)", 
+    plotter aus       = "plotter eingestellt (FALSE)", 
+ 
+(* Tasknamen *) 
+ 
+    depot taskname    = "mathe depot", 
+    ls mk taskname    = "ls-MENUKARTEN", 
+    ls taskname       = "ls-ANWENDUNG", 
+    fe taskname       = "FORMELEDITOR", 
+    mathe taskname    = "Mathematik", 
+    printer taskname  = "MATHE-PRINTER", 
+    pridepot taskname = "MATHE-PRINTERDEPOT", 
+    umstell taskname  = "DRUCKERANPASSUNGEN", 
+    archivname        = "mathe", 
+ 
+(* Bezeichner für Menükarte, Maskendatenraum und Programmanzahl *) 
+ 
+    menukarte         = "ls-MENUKARTE:Mathematik", 
+    maskenname        = "mathe formulare", 
+    mathe kuerzel     = "mat.", 
+    plot kuerzel      = " plot", 
+    ls kuerzel        = "ls-DIALOG ", 
+    mathe extension   = ".mathe", 
+    operatorendatei 1 = "ibmoperatoren", 
+    operatorendatei 2 = "standardoperatoren", 
+    anzahl gesamt     = 29, 
+    anzahl feprocs    =  6, 
+    anzahl ls procs   =  5, 
+    anzahl matheprocs = 18, 
+    anzahl pri procs  =  6, 
+    anzahl drucker ds = 16, 
+ 
+(* Codes für Task-Kommunikation *) 
+ 
+    ok                = 1111, 
+    fehler            = 9999, 
+    insertieren       = 2525, 
+    drucker erzeugen  = 3260, 
+    drucker1 erzeugen = 3261, 
+    drucker8 erzeugen = 3268, 
+    system starten    = 4444, 
+    ebene 1 behandeln = 4445, 
+    ebene 2 behandeln = 4446, 
+    arbeitskanal      = 1, (* Es wird ohnehin nur das Terminal 1 genutzt!*) 
+ 
+(* Sonstiges *) 
+ 
+    del               = ""5"", 
+    delpage           = ""4"", 
+    bell              = ""7"", 
+    left              = ""8"", 
+    beginmark         = ""15"", 
+    endmark           = ""14"", 
+    weiter            = "w", 
+    abbruch           = ""27"", 
+    niltext           = ""; 
+ 
+(* G l o b a l e   V a r i a b l e n *) 
+ 
+TASK      VAR depot task, ls mk task, fe task, mathe task, ls task, 
+              pridepot task, printer task, order task, umstelltask; 
+THESAURUS VAR archivinhalt; 
+TEXT      VAR graphicart, 
+              installationspassword := niltext; 
+INT       VAR druckerindex; 
+BOOL      VAR ibmsatz; 
+INT       VAR installationszaehler, antwort, order code; 
+DATASPACE VAR message ds; 
+BOOL      VAR mathematiksystem installiert := FALSE, 
+              graphikdrucker installiert   := FALSE; 
+ROW anzahl druckerds TEXT CONST druckerdatei :: 
+ROW anzahl druckerds TEXT : ("ZEICHEN 8*8", 
+                             "ZEICHEN 6*10", 
+                             "ZEICHEN 8*16", 
+                             "spool cmd", 
+                             "mat.xerox4045 plot", 
+                             "mat.epson-sq plot", 
+                             "mat.epson-fx plot", 
+                             "mat.binder plot", 
+                             "mat.kyocera plot", 
+                             "mat.laserjet plot", 
+                             "mat.hp72xx plot", 
+                             "mat.hp74xx plot", 
+                             "mat.basis plot", 
+                             "mat.picture", 
+                             "mat.ausgabe", 
+                             "mat.druckermenu"); 
+ROW zeilen menu 1 TEXT CONST menu 1 :: 
+ROW zeilen menu 1 TEXT : (meldung 3, meldung 4, meldung 5, meldung 6, 
+                          meldung 7, meldung 8, niltext, meldung 9, 
+                          niltext, meldung 10); 
+ROW zeilen menu 2 TEXT CONST menu 2 :: 
+ROW zeilen menu 2 TEXT : (meldung 11, meldung 12, meldung 13, niltext, 
+                          meldung 14, meldung 15, meldung 16, meldung 17, 
+                          niltext, meldung 18, meldung 19, meldung 20); 
+ROW zeilen menu 3 TEXT CONST menu 3 :: 
+ROW zeilen menu 3 TEXT : (meldung 11, meldung 34, niltext, meldung 35, 
+                          meldung 36, meldung 37, meldung 38, meldung 39, 
+                          meldung 40, meldung 41, niltext, meldung 18, 
+                          meldung 19, meldung 20); 
+ 
+(**************************************************************************) 
+(*                          H a u p t m e n ü                             *) 
+(**************************************************************************) 
+(* Die folgende Prozeduren realisieren ein Menü mit 6 Optionen:           *) 
+(*    1, 2: Ausführung des Mathematiksystems - sofern es noch nicht ein-  *) 
+(*          gerichtet ist erfolgt eine Meldung.                           *) 
+(*          Die Ausführung erfolgt durch Übergabe des Bildschirms an die  *) 
+(*          Task 'Mathematik'                                             *) 
+(*    3   : Ausführung eines Menüs in der Druckertask. Die Option setzt   *) 
+(*          voraus, daß eine entsprechende Task eingerichtet ist. Ist dies*) 
+(*          nicht der Fall erfolgt eine Meldung                           *) 
+(*    4   : Installation des Mathematiksystems. Sofern es schon eingerich-*) 
+(*          tet ist, erfolgt die Installation nur bei der Bejahung einer  *) 
+(*          Abfrage, ob das vorhandene System gelöscht werden soll.       *) 
+(*    5   : Installation des Druckertreibers. Sofern er schon eingerichtet*) 
+(*          ist, erfolgt die Installation nur bei der Bejahung einer Ab-  *) 
+(*          frage, ob das vorhandene System gelöscht werden soll.         *) 
+(*          Ferner gilt: Ohne Mathematiksystem kann kein Druckertreiber   *) 
+(*                       eingerichtet werden. Ein Löschen des Mathematik- *) 
+(*                       systems löscht automatisch auch den Druckertrei- *) 
+(*                       ber                                              *) 
+(*    q   : Verlassen des Menüs                                           *) 
+(*                                                                        *) 
+(*  Die exportierte Schnittstelle 'mathe' dient als Fängerebene für die   *) 
+(*  eigentliche Menü-Prozedur 'start system'                              *) 
+(**************************************************************************) 
+  
+PROC mathe: 
+ 
+  disable stop; 
+  zeige kopierhinweis; (* 5.2.1991 *) 
+  start system; 
+  WHILE is error REP 
+    clear error; 
+    command dialogue (FALSE); 
+    forget (all); 
+    commanddialogue (TRUE); 
+    zeige titelzeile (titel 1); 
+    gib meldung (errormessage); 
+    start system 
+  END REP 
+ 
+END PROC mathe; 
+ 
+PROC start system: 
+ 
+  TEXT VAR ch; 
+  INT  VAR rang, zeile, xpos, ypos; 
+  grundeinstellungen; 
+  REP 
+    zeige verwaltungsmenu; 
+    warte auf korrekte eingabe; 
+    werte eingabe aus 
+  END REP. 
+ 
+  grundeinstellungen: 
+    enable stop; 
+    check off; 
+    warnings off. 
+ 
+  zeige verwaltungsmenu: 
+    zeige titelzeile (titel 1); 
+    FOR zeile FROM 7 UPTO 16 REP 
+      cursor (24, zeile); out (menu 1 (zeile - 6)) 
+    END REP; 
+    clear buffer. 
+ 
+  warte auf korrekte eingabe: 
+    get cursor (xpos, ypos); 
+    REP 
+      inchar (ch); 
+      rang := pos (menutasten, ch); 
+      IF rang = 0 THEN 
+        out (bell) 
+      ELSE 
+        cursor (xpos + 1, ypos); out (ch); 
+      END IF 
+    UNTIL rang <> 0 END REP. 
+ 
+  werte eingabe aus: 
+    SELECT rang OF 
+      CASE 1, 2: fuehre mathesystem aus 
+      CASE 3   : fuehre druckermenu aus 
+      CASE 4   : installiere mathesystem 
+      CASE 5   : installiere druckeranpassung 
+      OTHERWISE  LEAVE start system (* = 6 *) 
+    END SELECT. 
+ 
+    fuehre mathesystem aus: 
+      IF NOT mathematiksystem installiert THEN 
+        out (bell); 
+        gib meldung (meldung 1); 
+        LEAVE fuehre mathesystem aus 
+      END IF; 
+      uebergib bildschirm (mathe task, system starten + rang). 
+     
+    fuehre druckermenu aus: 
+      IF NOT graphikdrucker installiert THEN 
+        out (bell); 
+        gib meldung (meldung 2); 
+        LEAVE fuehre druckermenu aus 
+      END IF; 
+      uebergib bildschirm (/printer taskname, system starten). 
+      
+    installiere druckeranpassung: 
+      IF NOT mathematiksystem installiert THEN 
+        out (bell); 
+        gib meldung (meldung 43); 
+        LEAVE installiere druckeranpassung 
+      END IF; 
+      IF graphikdrucker installiert CAND NOT ja (meldung 25) THEN 
+        LEAVE installiere druckeranpassung 
+      END IF; 
+      start printer installation;  
+      IF is error THEN 
+        clear error; 
+        gib meldung (errormessage); 
+      ELSE 
+        zeige installationsergebnis (titel 3, graphikdrucker installiert) 
+      END IF 
+ 
+END PROC start system; 
+ 
+PROC zeige kopierhinweis: (* Eingefügt 5.2.1991 - R.Kraft *) 
+ 
+LET z1 = "schulis - Mathematiksystem", 
+    z2 = "Lizenzfreie Software der", 
+    z3 = "Gesellschaft für Mathematik und Datenverarbeitung mbH", 
+    z4 = "Die Nutzung der Software ist nur im Schul- und Hochschulbereich", 
+    z5 = "für nichtkommerzielle Zwecke gestattet.", 
+    z6 = "Gewährleistung und Haftung werden ausgeschlossen.", 
+    z7 = "Weiter mit beliebiger Taste"; 
+ 
+    page; 
+    cursor (26, 3); out (z1); 
+    cursor (27, 8); out (z2); 
+    cursor (13,10); out (z3); 
+    cursor ( 8,14); out (z4); 
+    cursor (20,15); out (z5); 
+    cursor (16,17); out (z6); 
+    cursor (26,23); out (z7); 
+    pause (50)
+ 
+END PROC zeige kopierhinweis; 
+ 
+(***********************************************************************) 
+(* I n s t a l l a t i o n   d e s   M a t h e m a t i k s y s t e m s *) 
+(***********************************************************************) 
+(* Das folgende Programm installiert das Mathematiksystem.             *) 
+(* Dabei werden ggf existierende Tasks eines alten Mathematiksystems   *) 
+(* gelöscht. Es handelt sich dabei um die ls-Task als Vatertask für    *) 
+(* Druckeranpassung, Formeleditor und Mathematiksystem sowie die       *) 
+(* Depottask (= Zwischenspeicher für die benötigten Quelldateien).     *) 
+(* Die erforderliche Graphik und Halbgraphikanpassung werden im Dialog *) 
+(* bestimmt.                                                           *) 
+(* Die Dateien werden vom Archiv gelesen und in die Zwischenspeicher   *) 
+(* Tasks geschickt. Anschließend erfolgt die Installation folgender    *) 
+(* Taskstruktur:  ls-ANWENDUNG                                         *) 
+(*                     Mathematik                                      *) 
+(*                     FORMELEDITOR                                    *) 
+(*                ls-MENUKARTEN                                        *) 
+(*                DRUCKERANPASSUNGEN                                   *) 
+(* Die Zwischenspeichertask wird abschließend gelöscht.                *) 
+(***********************************************************************) 
+ 
+PROC installiere mathesystem: 
+ 
+  IF NOT korrektes password THEN 
+    LEAVE installiere mathesystem 
+  END IF; 
+  IF mathematiksystem installiert CAND NOT ja (meldung 24) THEN 
+    LEAVE installiere mathesystem 
+  END IF; 
+  start mathe installation; 
+  zeige installationsergebnis (titel 2, mathematiksystem installiert); 
+  IF mathematiksystem installiert THEN 
+    definiere password 
+  END IF; 
+  graphikdrucker installiert := FALSE. 
+ 
+END PROC installiere mathesystem; 
+ 
+PROC start mathe installation: 
+ 
+  INT VAR i; 
+  bestimme graphic und halbgraphic; 
+  IF NOT erforderliche systemdateien eingelesen THEN 
+    errorstop (meldung 49) 
+  END IF; 
+  loesche ggf vorhandene tasks; 
+  richte ggf lsmenukarten ein; 
+  richte sicherungstasks ein;  
+  sichere dateien; 
+  melde installationsbeginn; 
+  richte ls task ein; 
+  richte formeleditor ein; 
+  richte mathetask ein; 
+  loesche depottask. 
+ 
+  bestimme graphic und halbgraphic: 
+    graphicart := graphikkarte; 
+    ibmsatz := ja (meldung 23). 
+ 
+  loesche ggf vorhandene tasks: 
+    IF exists task (depot taskname) THEN end (/depot taskname) END IF; 
+    IF exists task (ls taskname) THEN end (/ls taskname) END IF. 
+ 
+  richte ggf lsmenukarten ein: 
+    IF NOT exists task (ls mk taskname) THEN 
+      begin (ls mk taskname, PROC free global manager, ls mk task) 
+    ELSE 
+      ls mk task := /ls mk taskname 
+    END IF. 
+ 
+  richte sicherungstasks ein: 
+    begin (depot taskname, PROC free global manager, depot task); 
+    IF NOT exists task (umstell taskname) THEN 
+      begin (umstell taskname, PROC free global manager, umstell task) 
+    ELSE 
+      umstell task := /umstell taskname 
+    END IF. 
+ 
+  sichere dateien: 
+    commanddialogue (FALSE); 
+    save (menukarte, ls mk task); 
+    save (maskenname, ls mk task); 
+    save (archivinhalt, depot task); 
+    FOR i FROM 1 UPTO anzahl drucker ds REP 
+      IF NOT exists (druckerdatei (i), umstelltask) THEN 
+        save (druckerdatei (i), umstelltask) 
+      END IF 
+    END REP; 
+    forget (archivinhalt). 
+ 
+  melde installationsbeginn: 
+    zeige titelzeile (titel 2); 
+    cursor (15, 10); out (meldung 30); 
+    cursor (15, 12); out (meldung 31 + text (anzahl gesamt) + " Dateien"); 
+    installationszaehler := 0. 
+ 
+  richte ls task ein: 
+    begin (ls taskname, PROC install ls, ls task); 
+    FOR i FROM 1 UPTO anzahl ls procs REP 
+      insertiere programme (ls task) 
+    END REP. 
+ 
+  richte formeleditor ein: 
+    REP UNTIL exists task (fe taskname) CAND 
+              status (/fe taskname) = 2 END REP; 
+    fe task := /fe taskname; 
+    FOR i FROM 1 UPTO anzahl fe procs REP 
+      insertiere programme (fe task) 
+    END REP. 
+ 
+  richte mathetask ein: 
+    REP UNTIL exists task (mathe taskname) CAND 
+              status (/mathe taskname) = 2 END REP; 
+    mathe task := /mathe taskname; 
+    FOR i FROM 1 UPTO anzahl mathe procs REP 
+      insertiere programme (mathe task) 
+    END REP. 
+ 
+  loesche depottask: 
+    end (depot task) 
+ 
+END PROC start mathe installation; 
+ 
+(* Einlesen der benötigten Dateien *) 
+ 
+BOOL PROC erforderliche systemdateien eingelesen: 
+ 
+  LET dateien       = 53, 
+      nicht geladen = "0", 
+      geladen       = "1"; 
+  ROW dateien TEXT CONST systemdatei :: 
+  ROW dateien TEXT : ("mat.ega plot", "mat.cga plot", 
+                      "mat.hercules plot", "mat.vga plot", 
+                      "ls-DIALOG 1.mathe", "ls-DIALOG 2.mathe", 
+                      "ls-DIALOG 3.mathe", "ls-DIALOG 4.mathe", 
+                      "ls-DIALOG 5.mathe", "PAC text row", 
+                      "PAC element row",   "PAC op store-anpassung", 
+                      "PAC formula analyzer", "PAC formula editor-anpassung", 
+                      "mat.formeleditormanager", "mat.vector", 
+                      "mat.referenzobjekte", "mat.funktionsbibliothek", 
+                      "mat.abbildung", "mat.parser", 
+                      "mat.basis plot", "mat.picture", 
+                      "mat.specialgraphic", "mat.dialoghilfen", 
+                      "mat.masken", "mat.menufunktionen", 
+                      "mat.wertetabelle", "mat.graphicverfahren", 
+                      "mat.integrationsverfahren", "mat.iterationsverfahren", 
+                      "mat.nullstellen", "mat.umformung", 
+                      "mat.xerox4045 plot", "mat.epson-sq plot", 
+                      "mat.epson-fx plot", "mat.binder plot", 
+                      "mat.kyocera plot", "mat.laserjet plot", 
+                      "mat.hp72xx plot", "mat.hp74xx plot", 
+                      "spool cmd", "mat.ausgabe", 
+                      "mat.druckermenu", "ZEICHEN 8*8", 
+                      "ZEICHEN 9*14", "ZEICHEN 8*19", 
+                      "ZEICHEN 8*14", "ZEICHEN 6*10", 
+                      "ZEICHEN 8*16", "mathe formulare", 
+                      "ls-MENUKARTE:Mathematik", "ibmoperatoren", 
+                      "standardoperatoren"); 
+  TEXT      VAR   anweisung   := meldung 50, 
+                  pruefleiste := dateien * nicht geladen; 
+  TEXT      CONST ziel        := dateien * geladen, 
+                  anpassung   := mathe kuerzel + graphicart + plot kuerzel; 
+  INT       VAR   i, zaehler  := 1; 
+  THESAURUS VAR   diskinhalt; 
+  zeige titelzeile (titel 2); 
+  archivinhalt := empty thesaurus; 
+  FOR i FROM 1 UPTO 4 REP 
+    IF systemdatei (i) <> anpassung THEN 
+      replace (pruefleiste, i, geladen) 
+    END IF 
+  END REP; 
+  REP 
+    warte auf eingabe; 
+    FOR i FROM 1 UPTO dateien REP 
+      IF (pruefleiste SUB i) = nicht geladen CAND 
+         (diskinhalt CONTAINS systemdatei (i)) THEN 
+        lade die datei 
+      END IF 
+    END REP; 
+    anweisung := meldung 54 
+  UNTIL pruefleiste = ziel END REP; 
+  abschlussaktivitaeten; 
+  TRUE. 
+ 
+  zeige texte: 
+    cursor (8,  8); out (meldung 44); 
+    cursor (8,  9); out (anweisung); 
+    cursor (8, 10); out (meldung 51); 
+    cursor (8, 12); out (meldung 52); 
+    cursor (8, 13); out (meldung 53). 
+ 
+  warte auf eingabe: 
+    TEXT VAR ch; 
+    REP 
+      zeige texte; 
+      inchar (ch); 
+      IF ch = abbruch THEN 
+        release (archive); 
+        LEAVE erforderliche systemdateien eingelesen WITH FALSE 
+      ELIF ch = weiter THEN 
+        disable stop; 
+        cursor (8, 9); out (del); 
+        cursor (8,10); out (del); 
+        cursor (8,12); out (del); 
+        cursor (8,13); out (del); 
+        cursor (8,15); out (del); 
+        archive (archivname); 
+        diskinhalt := ALL archive; 
+        IF is error THEN 
+          clear error; 
+          cursor (8, 15); out (meldung 47); 
+          enable stop; 
+        ELSE 
+          enable stop; 
+          LEAVE warte auf eingabe 
+        END IF 
+      ELSE 
+        out (bell) 
+      END IF 
+    END REP. 
+ 
+  lade die datei: 
+    cursor (8, 9); out (meldung 27 + text (zaehler) + " von 50 Dateien"); 
+    fetch (systemdatei (i), archive); 
+    replace (pruefleiste, i, geladen); 
+    insert (archivinhalt, systemdatei (i)); 
+    zaehler INCR 1. 
+ 
+  abschlussaktivitaeten: 
+    release (archive); 
+    cursor (8, 8); out (meldung 28 + del); 
+    cursor (8, 9); out (meldung 29 + del); 
+    pause (50) 
+ 
+END PROC erforderliche systemdateien eingelesen; 
+ 
+(* Installation der ls task *) 
+ 
+PROC install ls: 
+ 
+  INT VAR i; 
+  FOR i FROM 1 UPTO anzahl ls procs REP 
+    insertiere (lskuerzel + text (i) + mathe extension, depot task) 
+  END REP; 
+  do (menu ankoppeln); 
+  IF ibmsatz THEN 
+    do (ibmsatzzeichen) 
+  ELSE 
+    do (stdsatzzeichen) 
+  END IF; 
+  begin (fe taskname, PROC install formeleditor, fe task); 
+  begin (mathe taskname, PROC install mathe, mathe task); 
+  disable stop; 
+  REP 
+    REP 
+      warte auf auftrag 
+    UNTIL order code >= drucker1 erzeugen CAND 
+          order code <= drucker8 erzeugen END REP; 
+    druckerindex := order code - drucker erzeugen; 
+    begin (printer taskname, PROC install printer, printer task);    
+    gib antwort (ok)    
+  END REP 
+ 
+END PROC install ls; 
+ 
+(* Installation des Formeleditors *) 
+ 
+PROC install formeleditor: 
+ 
+  ROW anzahl feprocs TEXT CONST feproc :: 
+  ROW anzahl feprocs TEXT : ("PAC text row", 
+                             "PAC element row", 
+                             "PAC op store-anpassung", 
+                             "PAC formula analyzer", 
+                             "PAC formula editor-anpassung", 
+                             "mat.formeleditormanager"); 
+  INT VAR i; 
+  FOR i FROM 1 UPTO anzahl fe procs REP 
+    insertiere (feproc (i), depot task) 
+  END REP; 
+  do (menu ankoppeln); 
+  hole notfalls (operatorendatei 1, depot task); 
+  hole notfalls (operatorendatei 2, depot task); 
+  IF ibmsatz THEN 
+    do (ibmops ankoppeln) 
+  ELSE 
+    do (std ops ankoppeln) 
+  END IF; 
+  do (fe manager) 
+   
+END PROC install formeleditor; 
+ 
+(* Installation des eigentlichen Mathematiksystems *) 
+ 
+PROC install mathe: 
+ 
+  ROW anzahl matheprocs TEXT CONST dname := 
+  ROW anzahl matheprocs TEXT : ("mat.vector", 
+                                "mat.referenzobjekte", 
+                                "mat.funktionsbibliothek", 
+                                "mat.abbildung", 
+                                "mat.parser", 
+                                "mat.masken", 
+                                mathekuerzel + graphicart + plotkuerzel, 
+                                "mat.basis plot", 
+                                "mat.picture", 
+                                "mat.specialgraphic", 
+                                "mat.dialoghilfen", 
+                                "mat.menufunktionen", 
+                                "mat.graphicverfahren", 
+                                "mat.wertetabelle", 
+                                "mat.nullstellen", 
+                                "mat.umformung", 
+                                "mat.integrationsverfahren", 
+                                "mat.iterationsverfahren"); 
+  INT VAR i; 
+  TEXT CONST zugehoerende zeichen := passender zeichensatz; 
+  insertiere mathesystem; 
+  beende installation. 
+ 
+  passenderzeichensatz: 
+    IF graphicart   = "vga" THEN 
+      "ZEICHEN 8*19" 
+    ELIF graphicart = "ega" THEN 
+      "ZEICHEN 8*14" 
+    ELIF graphicart = "cga" THEN 
+      "ZEICHEN 8*8" 
+    ELSE  (* "hercules" *) 
+      "ZEICHEN 9*14" 
+    END IF. 
+ 
+  insertiere mathesystem: 
+    do (menu ankoppeln); 
+    hole notfalls (zugehoerende zeichen, depot task); 
+    FOR i FROM 1 UPTO anzahl matheprocs REP 
+      insertiere (dname (i), depot task) 
+    PER. 
+ 
+  beende installation: 
+    TEXT VAR arbeitsauftrag; 
+    commanddialogue (FALSE); 
+    forget (all - maskenname); 
+    commanddialogue (TRUE); 
+    disable stop; 
+    REP 
+      REP 
+        warte auf auftrag 
+      UNTIL order code = ebene 1 behandeln COR 
+            order code = ebene 2 behandeln END REP; 
+      continue (arbeitskanal); 
+      IF order code = ebene 1 behandeln THEN 
+        arbeitsauftrag := ebene 1 handle 
+      ELSE 
+        arbeitsauftrag := ebene 2 handle 
+      END IF; 
+      do (arbeitsauftrag); 
+      gib bildschirm frei (ok) 
+    END REP 
+ 
+END PROC install mathe; 
+ 
+(*********************************************************************) 
+(*  I n s t a l l a t i o n   d e s   D r u c k e r t r e i b e r s  *) 
+(*********************************************************************) 
+ 
+PROC start printer installation: 
+ 
+  loesche ggf vorhandene task; 
+  bestimme druckeranpassung; 
+  melde installationsbeginn; 
+  richte druckertasks ein. 
+ 
+  loesche ggf vorhandene task: 
+    IF exists task (printer taskname) THEN end (/printer taskname) END IF. 
+ 
+  bestimme druckeranpassung: 
+    druckerindex := druckertreiber. 
+ 
+  melde installationsbeginn: 
+    INT VAR ende := anzahl pri procs; 
+    IF druckerindex > 6 THEN 
+      ende DECR 1 
+    END IF; 
+    zeige titelzeile (titel 2); 
+    cursor (15, 10); out (meldung 42); 
+    cursor (15, 12); out (meldung 31 + text (ende) + " Dateien"); 
+    installationszaehler := 0. 
+ 
+  richte druckertasks ein: 
+    INT VAR i; 
+    IF NOT exists task (pridepot taskname) THEN 
+      begin (pridepot taskname, PROC free global manager, pridepot task) 
+    END IF; 
+    ls task := /ls taskname; 
+    rufe (ls task, drucker erzeugen + druckerindex);   
+    REP UNTIL exists task (printer taskname) CAND 
+              status (/printer taskname) = 2 END REP; 
+    printer task := /printer taskname; 
+    FOR i FROM 1 UPTO ende REP 
+      insertiere programme (printer task) 
+    END REP   
+ 
+END PROC start printer installation; 
+ 
+(* Installation des Druckers *) 
+ 
+PROC install printer: 
+ 
+  LET anzahl zeichensaetze   = 3; 
+  ROW anzahl priprocs TEXT CONST programm :: 
+  ROW anzahl priprocs TEXT : (druckerdatei (4), 
+                              druckerdatei (4 + druckerindex), 
+                              druckerdatei (13), druckerdatei (14), 
+                              druckerdatei (15), druckerdatei (16)); 
+  INT VAR i; 
+  BOOL VAR plotter wird installiert := druckerindex > 6; 
+  do (menu ankoppeln); 
+  IF NOT plotter wird installiert THEN 
+    hole zeichensaetze 
+  END IF; 
+  insertiere die einzelnen programme;  
+  abschlussaktivitaet. 
+ 
+  hole zeichensaetze: 
+    FOR i FROM 1 UPTO anzahl zeichensaetze REP 
+      hole notfalls (druckerdatei (i), /umstell taskname) 
+    PER. 
+ 
+  insertiere die einzelnen programme: 
+    INT VAR anfang := 1; 
+    IF plotter wird installiert THEN 
+      anfang := 2 
+    END IF; 
+    FOR i FROM anfang UPTO anzahl pri procs REP 
+      insertiere (programm (i), /umstell taskname) 
+    END REP. 
+ 
+  abschlussaktivitaet: 
+    IF NOT plotter wird installiert THEN 
+      FOR i FROM 1 UPTO anzahl zeichensaetze REP 
+        forget (druckerdatei (i), quiet) 
+      END REP 
+    END IF;  
+    IF plotter wird installiert THEN 
+      do (plotter ein) 
+    ELSE 
+      do (plotter aus) 
+    END IF; 
+    disable stop; 
+    REP 
+      REP 
+        warte auf auftrag 
+      UNTIL order code = system starten END REP; 
+      continue (arbeitskanal); 
+      do (druckmenu handle); 
+      gib bildschirm frei (ok) 
+    END REP 
+ 
+END PROC install printer; 
+ 
+(*********************************) 
+(*  H i l f s p r o g r a m m e  *) 
+(*********************************) 
+ 
+(* Programme zur Ausführung des 'insert' *) 
+ 
+PROC insertiere programme (TASK VAR zieltask): 
+ 
+  installationszaehler INCR 1; 
+  cursor (40, 12); out (text (installationszaehler)); 
+  rufe (zieltask, insertieren); 
+  IF antwort <> ok THEN 
+    errorstop (meldung 32) 
+  END IF 
+ 
+END PROC insertiere programme; 
+ 
+PROC insertiere (TEXT CONST name, TASK CONST herkunft): 
+ 
+  REP 
+    warte auf auftrag 
+  UNTIL order code = insertieren END REP; 
+  disable stop; 
+  hole notfalls (name, herkunft); 
+  insert (name); 
+  IF is error THEN 
+    clear error; 
+    gib antwort (fehler) 
+  ELSE 
+    gib antwort (ok) 
+  END IF; 
+  forget (name, quiet); 
+  enable stop 
+ 
+END PROC insertiere; 
+ 
+PROC hole notfalls (TEXT CONST name, TASK CONST herkunft): 
+ 
+  IF NOT exists (name) THEN 
+    fetch (name, herkunft) 
+  END IF 
+ 
+END PROC hole notfalls; 
+ 
+(***********************************************) 
+(*    Prozeduren zur Intertaskkommunikation    *) 
+(***********************************************) 
+ 
+(* Die folgenden Prozeduren werden immer da eingesetzt, wo bei 
+   'call', 'send' und 'wait' der übergebene Datenraum ignoriert 
+   werden kann *) 
+ 
+PROC rufe (TASK CONST zieltask, INT CONST auftrag): 
+ 
+  message ds := nilspace; 
+  call (zieltask, auftrag, message ds, antwort); 
+  forget (message ds)     
+ 
+END PROC rufe; 
+ 
+PROC warte auf auftrag: 
+ 
+  wait (message ds, order code, order task); 
+  forget (message ds)    
+ 
+END PROC warte auf auftrag; 
+ 
+PROC gib antwort (INT CONST antwortcode): 
+ 
+  message ds := nilspace; 
+  send (order task, antwortcode, message ds); 
+(*forget (message ds) *) 
+ 
+END PROC gib antwort; 
+ 
+PROC uebergib bildschirm (TASK CONST t, INT CONST auftrag): 
+ 
+   break (quiet); 
+   rufe (t, auftrag); 
+   continue (arbeitskanal) 
+ 
+END PROC uebergib bildschirm; 
+ 
+PROC gib bildschirm frei (INT CONST antwortcode): 
+ 
+  break (quiet); 
+  gib antwort (antwortcode) 
+ 
+END PROC gib bildschirm frei; 
+ 
+(********************************************************) 
+(*         Auswahlmenüs für Endgeräteanpassungen        *) 
+(********************************************************) 
+ 
+TEXT PROC graphikkarte: 
+ 
+  LET anzahl plotprocs = 4; 
+  ROW anzahl plotprocs TEXT CONST plotname := 
+  ROW anzahl plotprocs TEXT : ("hercules","cga","ega","vga"); 
+  INT VAR i := 1, zeile; 
+  commanddialogue (TRUE); 
+  zeige titelzeile (titel 2); 
+  FOR zeile FROM 6 UPTO 17 REP 
+    cursor (16, zeile); out (menu 2 (zeile - 5)) 
+  END REP; 
+  REP 
+    cursor (16, 20); out (invers (text (plotname (i), 11))); 
+    IF yes (meldung 33) THEN 
+      commanddialogue (FALSE); 
+      LEAVE graphikkarte WITH plotname (i) 
+    END IF; 
+    i := i MOD anzahl plotprocs + 1 
+  END REP; 
+  plotname (i) 
+ 
+END PROC graphikkarte; 
+ 
+INT PROC druckertreiber: 
+ 
+  LET anzahl plotterprocs = 8; 
+  ROW anzahl plotterprocs TEXT CONST plotname := 
+  ROW anzahl plotterprocs TEXT : ("xerox4045", "epson-sq", "epson-fx", 
+                                  "binder", "kyocera", "laserjet", 
+                                  "hp72xx", "hp74xx"); 
+  INT VAR i, zeile; 
+  commanddialogue (TRUE); 
+  zeige titelzeile (titel 3); 
+  FOR zeile FROM 3 UPTO 16 REP 
+    cursor (16, zeile); out (menu 3 (zeile - 2)) 
+  END REP; 
+  i := 1; 
+  REP 
+    cursor (16, 20); out (invers (text (plotname (i), 11))); 
+    IF yes (meldung 33) THEN 
+      commanddialogue (FALSE); 
+      LEAVE druckertreiber WITH i 
+    END IF; 
+    i := i MOD anzahl plotterprocs + 1 
+  END REP; 
+  i 
+ 
+END PROC druckertreiber; 
+ 
+(************************************************) 
+(*            Bildschirmausgaben                *) 
+(************************************************) 
+ 
+PROC zeige titelzeile (TEXT CONST fktbezeichner): 
+ 
+  TEXT CONST zeile := text (systemname, 78 - length (fktbezeichner)) + 
+                            fktbezeichner; 
+  page; 
+  cursor (1,1); out (invers (text (zeile, 79))) 
+   
+END PROC zeige titelzeile; 
+ 
+PROC zeige installationsergebnis (TEXT CONST ziel, BOOL VAR erfolg): 
+ 
+  zeige titelzeile (ziel); 
+  IF is error THEN 
+    clear error; 
+    gib meldung (meldung 22); 
+    erfolg := FALSE 
+  ELSE 
+     gib meldung (meldung 21); 
+     erfolg := TRUE 
+   END IF 
+ 
+END PROC zeige installationsergebnis; 
+ 
+PROC gib meldung (TEXT CONST meldungstext): 
+ 
+  cursor (1, 23); out (meldungstext); 
+  cursor (1, 24); out (invers (text (meldung 26, 77))); 
+  clear buffer; pause 
+ 
+END PROC gib meldung; 
+ 
+PROC clear buffer: 
+ 
+  REP UNTIL incharety = niltext PER 
+ 
+END PROC clear buffer; 
+ 
+BOOL PROC ja (TEXT CONST frage): 
+ 
+  BOOL VAR antwort; 
+  commanddialogue (TRUE); 
+  cursor (1, 22); antwort := yes (frage); 
+  cursor (1, 22); out (del); 
+  commanddialogue (FALSE); 
+  antwort 
+ 
+END PROC ja; 
+ 
+TEXT PROC invers (TEXT CONST t): 
+ 
+  beginmark + t + endmark 
+ 
+END PROC invers; 
+ 
+(*************************************************************************) 
+(*                    P a s s w o r t s c h u t z                        *) 
+(*************************************************************************) 
+(* Zur Vermeidung einer irrtümlichen oder 'böswilligen' Neuinstallation  *) 
+(* des Mathesystems kann nach erfolgter Installation ein Passwort verge- *) 
+(* ben werden, das beim Versuch der Neuinstallation abgefragt wird.      *) 
+(*************************************************************************) 
+ 
+BOOL PROC korrektes password: 
+  
+  installationspassword = niltext COR password getroffen. 
+ 
+  password getroffen: 
+  TEXT VAR eingabe; 
+  cursor (24, 18); out (meldung 45 + del);  
+  get secret line (eingabe); 
+  IF eingabe = installationspassword THEN 
+    cursor (24, 18); out (del); 
+    LEAVE password getroffen WITH TRUE 
+  END IF; 
+  out (bell); 
+  FALSE 
+ 
+END PROC korrektes password; 
+ 
+PROC definiere password: 
+ 
+  installationspassword := niltext; 
+  cursor (1, 23); out (delpage); 
+  IF ja (meldung 46) THEN 
+    cursor (1, 23); out (meldung 45 + beginmark + left); 
+    editget (installationspassword, 40, 20); 
+    out (endmark) 
+  END IF 
+ 
+END PROC definiere password; 
+ 
+END PACKET mathe verwaltung; 
+ 
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vga plot b/app/schulis-mathematiksystem/1.0/src/mat.vga plot
new file mode 100644
index 0000000..730434b
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.vga plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETvgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=35.0365,anzahlx=640,anzahly=480,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=480,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die VGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"vga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,17,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,ypixel-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT
+ CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xpixel-1THENx:=xpixel-1ELIFx<0THENx:=0END IF;IFy>ypixel-1THENy:=ypixel-1ELIFy<0THENy:=0END IF END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:19END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19")
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle
new file mode 100644
index 0000000..223d7b8
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle
@@ -0,0 +1,4 @@
+PACKETwertetabelleDEFINESerstellewertetabelle:LETniltext="",del="�",blank=" ",unterstrichzeichen="_",maximalanzahl=4000.0,maxfelder=100,weiterarbeit="w",naechste="q",abbruchzeichen="!",fktbezeichnung="Fktswert",PARAMETER=ROWmaxfelderTEXT;PROCerstellewertetabelle(ABBILDUNG CONSTfunktion):VECTOR VAReingabewerte;REAL VARendwert,schrittweite;INT VARlaufvariablenindex,durchgangsnummer:=1,i;WINDOW VARwt:=window(2,7,77,16);TEXT VARausstieg,zulaessigezeichen;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,wert1:="-5.0"+kurzerstrich,wert2:="5.0"+kurzerstrich,wert3:="1.0"+kurzerstrich,tabellendateiname:=scratchdateiname;FILE VARh:=sequentialfile(modify,tabellendateiname);schreibearbeitsfunktion(funktion);bestimmelaufvariablenwerte;erstellegegebenenfallsaufloesungderfunktion;bearbeitediefunktion;loeschegegebenenfallsaufloesungderfunktion.bestimmelaufvariablenwerte:TAG VAReingabemaske:=formular(2);initialisierelaufvariablenformular;editierelaufvariablenformular.initialisierelaufvariablenformular:PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;raster(2):=NAMElistenanfang(abbildungsvariablen(funktion));raster(3):=wert1;raster(4):=wert2;raster(5):=wert3;IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENsetfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2)CATkurzerstrichEND IF;zulaessigezeichen:="?wqm".editierelaufvariablenformular:REPbearbeitelaufvariablenformular;werteausstiegszeichenausEND REP.bearbeitelaufvariablenformular:footnote(anwendungstext(115));show(eingabemaske);strich(5);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);ausstieg:=naechsteEND IF.werteausstiegszeichenaus:SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:gibinformationenzumlaufvariablenformularCASE2:verarbeiteeingabenCASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleEND SELECT.verarbeiteeingaben:footnote(anwendungstext(114));IFkorrektervariablenindexCANDkorrekteranfangswertCANDkorrekterendwertCANDkorrekteschrittweiteTHEN FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP;LEAVEeditierelaufvariablenformularEND IF;FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP.korrektervariablenindex:TERM VARvaradresse:=listenanfang(abbildungsvariablen(funktion));IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENlaufvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrichzeichen,blank);varadresse:=listenposition(abbildungsvariablen(funktion),raster(2));IFvaradresse=nilTHENgibmeldung(anwendungstext(156));startfeld:=2;FALSE ELSElaufvariablenindex:=PLATZvaradresse;TRUE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrichzeichen,blank);REAL VARanfangswert:=realzahl(raster(3));IFiserrorTHENclearerror;gibmeldung(anwendungstext(157));startfeld:=3;FALSE ELSEeingabewerte:=vector(laenge(abbildungsvariablen(funktion)));replace(eingabewerte,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:changeall(raster(4),unterstrichzeichen,blank);endwert:=realzahl(raster(4));IFiserrorTHENclearerror;gibmeldung(anwendungstext(158));startfeld:=4;FALSE ELIFendwert<anfangswertTHENgibmeldung(anwendungstext(96));startfeld:=4;FALSE ELSE TRUE END IF.korrekteschrittweite:changeall(raster(5),unterstrichzeichen,blank);schrittweite:=realzahl(raster(5));IFiserrorCORanfangswert+maximalanzahl*schrittweite<endwertTHEN IFiserrorTHENclearerrorEND IF;gibmeldung(anwendungstext(159));startfeld:=5;FALSE ELSE TRUE END IF.gibinformationenzumlaufvariablenformular:outframe(wt);show(formular(5));warte.erstellegegebenenfallsaufloesungderfunktion:BOOL VARloeschflag:=komplexefunktion(funktion);ABBILDUNG VARf:=funktion;IFloeschflagTHENf:=aufloesung(f)END IF.bearbeitediefunktion:INT VARersterauszugebendersatz,ersteauszugebendespalte;REPbestimmeparameterwerte;berechnediewertetabelle;zeigewertetabelle;IFlaenge(abbildungsvariablen(f))=1THENforget(
+tabellendateiname,quiet);LEAVEbearbeitediefunktionEND IF;durchgangsnummerINCR1END REP.bestimmeparameterwerte:IFlaenge(abbildungsvariablen(f))=1THEN LEAVEbestimmeparameterwerteEND IF;cursor(1,4);out(anwendungstext(208));REPmacheeingabe;werteausstiegausEND REP.macheeingabe:zulaessigezeichen:="?wqm";footnote(anwendungstext(115));cursor(12,4);belegeparameter(eingabewerte,laufvariablenindex,abbildungsvariablen(f),zulaessigezeichen,ausstieg).werteausstiegaus:SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:gibinformationzurparametereingabeCASE2:cursor(1,4);out(del);LEAVEbestimmeparameterwerteCASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEbearbeitediefunktionEND SELECT.gibinformationzurparametereingabe:outframe(wt);show(formular(8));warte;page(wt,TRUE).berechnediewertetabelle:VECTOR VARparameter:=eingabewerte,y:=vector(laenge(abbildungsterme(f)));REAL VARx;INT VARzeilennummer:=1;INT CONSTyscrollbeginn:=laenge(abbildungsvariablen(f))+2;TEXT VARausgabezeile;TEXT CONSTvariablenname:=NAMEauswahl(abbildungsvariablen(f),laufvariablenindex);IFlaenge(abbildungsvariablen(f))>1CANDlaenge(abbildungsvariablen(f))<10THENtrageparameterbelegunginwertetabelleeinEND IF;schreibediewertetabellenueberschriften;schreibewertetabellenzeilen.trageparameterbelegunginwertetabelleein:INT VARk:=1;WHILEk<=laenge(abbildungsvariablen(f))REP IFk<>laufvariablenindexTHEN IFdurchgangsnummer=1THENergaenzewertetabellendatei(h,zeilennummer,text(NAMEauswahl(abbildungsvariablen(f),k),gesamtstellen(ebene)))END IF;ergaenzewertetabellendatei(h,zeilennummer,senkrecht+text(wandle(eingabewerteSUBk),laenge(abbildungsterme(f))*gesamtstellen(ebene)+laenge(abbildungsterme(f))-1));zeilennummerINCR1END IF;kINCR1END REP.schreibediewertetabellenueberschriften:ergaenzewertetabellendatei(h,zeilennummer,ueberschrift);zeilennummerINCR1;ergaenzewertetabellendatei(h,zeilennummer,unterstrich).ueberschrift:TEXT VARzeile:=niltext;IFdurchgangsnummer=1THENzeileCATtext(variablenname,gesamtstellen(ebene))END IF;IFlaenge(abbildungsterme(f))=1THENzeileCATtext(senkrecht+fktbezeichnung,gesamtstellen(ebene)+1)ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPzeileCATtext(senkrecht+fktbezeichnung+text(i,2),gesamtstellen(ebene)+1)END REP END IF;zeile.unterstrich:TEXT VARus:=niltext;IFdurchgangsnummer=1THENusCAT(gesamtstellen(ebene)*waagerecht);END IF;FORiFROM1UPTOlaenge(abbildungsterme(f))REPusCAT(kreuz+gesamtstellen(ebene)*waagerecht)END REP;us.schreibewertetabellenzeilen:footnote(anwendungstext(117));cursor(36,24);REPbefragetastatur;zeilennummerINCR1;x:=parameterSUBlaufvariablenindex;ausgabezeile:=niltext;IFdurchgangsnummer=1THENausgabezeileCATwandle(x)END IF;y:=ergebnis(f,parameter);IFiserrorTHENclearerror;FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATgesamtstellen(ebene)*"-"END REP ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATwandle(ySUBi)END REP END IF;ergaenzewertetabellendatei(h,zeilennummer,ausgabezeile);cout(zeilennummer-yscrollbeginn+1);IFx=endwertTHEN LEAVEberechnediewertetabelleELIFx+schrittweite>endwertTHENx:=endwertELSEx:=x+schrittweiteEND IF;replace(parameter,laufvariablenindex,x)END REP.befragetastatur:IFincharety=abbruchzeichenTHENforget(tabellendateiname,quiet);LEAVEbearbeitediefunktionEND IF.zeigewertetabelle:TEXT VARfusszeile;zulaessigezeichen:="?dqm";IFlaenge(abbildungsvariablen(f))<>1THENzulaessigezeichenCATweiterarbeit;fusszeile:=anwendungstext(133)ELSEfusszeile:=anwendungstext(171)END IF;ersterauszugebendersatz:=yscrollbeginn;ersteauszugebendespalte:=gesamtstellen(ebene)+2+(durchgangsnummer-1)*laenge(abbildungsterme(f))*(gesamtstellen(ebene)+1);outframe(wt);REPfootnote(fusszeile);scroll(wt,tabellendateiname,gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigezeichen,ausstieg);SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:zeigeinformationstextCASE2:aufbereitetdrucken(tabellendateiname,text(funktionsstring(funktion),
+druckspalten),gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1);outframe(wt)CASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleCASE5:LEAVEzeigewertetabelleEND SELECT END REP.zeigeinformationstext:show(formular(9));warte.loeschegegebenenfallsaufloesungderfunktion:IFloeschflagTHENloescheabbildung(f)END IF END PROCerstellewertetabelle;PROCergaenzewertetabellendatei(FILE VARf,INT CONSTzeile,TEXT CONSTergaenzung):TEXT VARsatz;toline(f,zeile);readrecord(f,satz);IFsatz=niltextTHENinsertrecord(f);END IF;writerecord(f,satz+ergaenzung)END PROCergaenzewertetabellendatei;END PACKETwertetabelle;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot
new file mode 100644
index 0000000..ec5eb2c
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot
@@ -0,0 +1,4 @@
+PACKETxeroxplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LEThorpixel=720,verpixel=532,intsperscanline=45,horfaktor=29.528,vertfaktor=29.528,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARanzahlgleichersixel,altessixel,plotterchannel:=15;INT VARxpos,ypos,xfak,yfak,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.75,buchstabenbreite:=0.305,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=24.4;ycm:=18.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARbitsleft:=0,bits,hilfsvariable,buffer;anzahlgleichersixel:=1;druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterkanal).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out("�+X
�+0XCP12.5iso-L
�0"+"�+P
�m2480,0,0,0,3508
�gw");magnification4;out(";236,312,"+text(horpixel)+","+text(verpixel)+"
");altessixel:=-53.magnification4:out("4").gibdiebitmapaus:INT VARi;FORiFROMverpixelDOWNTO1REPgibeinezeilederbitmapausPER.gibeinezeilederbitmapaus:INT VARj;FORjFROM1UPTOintsperscanlineREPbits:=bitmap(i)(j);gibdie16bitsalssixelausPER.gibdie16bitsalssixelaus:SELECTbitsleftOF CASE0:sendemitshift0CASE2:sendemitshift2CASE4:sendemitshift4END SELECT.sendemitshift0:sixelsend(firstsixbits);sixelsend((bitsAND1008)DIV16);buffer:=((bitsAND15)*4);bitsleft:=4.firstsixbits:hilfsvariable:=bits;rotate(hilfsvariable,6);hilfsvariableAND63.sendemitshift2:sixelsend(buffer+firstfourbits);sixelsend((bitsAND4032)DIV64);sixelsend(bitsAND63);bitsleft:=0.firstfourbits:hilfsvariable:=bits;rotate(hilfsvariable,4);hilfsvariableAND15.sendemitshift4:sixelsend(buffer+firsttwobits);sixelsend((bitsAND16128)DIV256);sixelsend((bitsAND252)DIV4);buffer:=((bitsAND3)*16);bitsleft:=2.firsttwobits:hilfsvariable:=bits;rotate(hilfsvariable,2);hilfsvariableAND3.druckedieseite:sendeletztessixel;out("��+P
").sendeletztessixel:sixelsend(-1).END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;korrigierenextpointnr.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs< 
+totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;PROCsixelsend(INT CONSTneuessixel):IFneuessixel<>altessixelTHENsendealtessixel;altessixel:=neuessixelELIFanzahlgleichersixel<32000THENanzahlgleichersixelINCR1ELSEsendealtessixel;altessixel:=neuessixelFI.sendealtessixel:IFanzahlgleichersixel=1THENout(code(altessixel+63))ELSEout(text(anzahlgleichersixel)+code(altessixel+63));anzahlgleichersixel:=1FI.END PROCsixelsend;INT PROCplotterkanal:plotterchannel
+END PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETxeroxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-mathematiksystem/1.0/src/mathe formulare b/app/schulis-mathematiksystem/1.0/src/mathe formulare
new file mode 100644
index 0000000..8a6400e
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/mathe formulare
diff --git a/app/schulis-mathematiksystem/1.0/src/spool cmd b/app/schulis-mathematiksystem/1.0/src/spool cmd
new file mode 100644
index 0000000..6a78cc1
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/spool cmd
@@ -0,0 +1,3 @@
+PACKETspoolcmdDEFINESspoolcontrolpassword,killspool,firstspool,startspool,stopspool,haltspool,waitforhalt:LETerrornak=2,entrylinecode=23,killercode=24,firstcode=25,startcode=26,stopcode=27,haltcode=28,waitforhaltcode=29;DATASPACE VARds;BOUND STRUCT(TEXTentryline,INTindex,TEXTactualentries,password)VARcontrolmsg;BOUND TEXT VARerrormsg;INT VARreply;INITFLAG VARinthistask:=FALSE;BOOL VARdialogue;TEXT VARcontrolpassword,password;controlpassword:="";PROCspoolcontrolpassword(TEXT CONSTnewpassword):IFonlineTHENsay("�
�")FI;disablestop;do("enter spool control password (""+newpassword+"")");clearerror;nodoagain;covertracks;covertracks(controlpassword);controlpassword:=newpassword;END PROCspoolcontrolpassword;PROCcallspool(INT CONSTopcode,TEXT CONSTname,TASK CONSTspool):dialogue:=commanddialogue;password:=writepassword;passwordCAT"/";passwordCATreadpassword;disablestop;commanddialogue(FALSE);enterpassword(controlpassword);commanddialogue(dialogue);call(opcode,name,spool);commanddialogue(FALSE);enterpassword(password);commanddialogue(dialogue);END PROCcallspool;PROCstartspool(TASK CONSTspool):enablestop;callspool(haltcode,"",spool);callspool(startcode,"",spool);END PROCstartspool;PROCstartspool(TASK CONSTspool,INT CONSTnewchannel):enablestop;callspool(haltcode,"",spool);callspool(startcode,text(newchannel),spool);END PROCstartspool;PROCstopspool(TASK CONSTspool):callspool(stopcode,"",spool);END PROCstopspool;PROCstopspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(stopcode,deactivemsg,spool);END PROCstopspool;PROChaltspool(TASK CONSTspool):callspool(haltcode,"",spool);END PROChaltspool;PROChaltspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(haltcode,deactivemsg,spool);END PROChaltspool;PROCwaitforhalt(TASK CONSTspool):callspool(waitforhaltcode,"",spool);END PROCwaitforhalt;PROCwaitforhalt(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(waitforhaltcode,deactivemsg,spool);END PROCwaitforhalt;PROCcontrolspool(TASK CONSTspool,INT CONSTcontrolcode,TEXT CONSTquestion,BOOL CONSTleave):enablestop;initializecontrolmsg;WHILEvalidspoolentryREP IFcontrolquestionTHENcontrolspoolentryFI PER;.initializecontrolmsg:IF NOTinitialized(inthistask)THENds:=nilspaceFI;forget(ds);ds:=nilspace;controlmsg:=ds;controlmsg.entryline:="";controlmsg.password:=controlpassword;controlmsg.index:=0;say("

+");.validspoolentry:call(spool,entrylinecode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;controlmsg.index<>0.controlquestion:say(controlmsg.entryline);yes(question).controlspoolentry:call(spool,controlcode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;IFleaveTHEN LEAVEcontrolspoolFI;END PROCcontrolspool;PROCkillspool(TASK CONSTspool):controlspool(spool,killercode,"   loeschen",FALSE)END PROCkillspool;PROCfirstspool(TASK CONSTspool):controlspool(spool,firstcode,"   als erstes",TRUE)END PROCfirstspool;END PACKETspoolcmd;
+
diff --git a/app/schulis-mathematiksystem/1.0/src/standardoperatoren b/app/schulis-mathematiksystem/1.0/src/standardoperatoren
new file mode 100644
index 0000000..647611b
--- /dev/null
+++ b/app/schulis-mathematiksystem/1.0/src/standardoperatoren
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie
new file mode 100644
index 0000000..e2ef232
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 code info ds
new file mode 100644
index 0000000..c754ba3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 originalkurve ds
new file mode 100644
index 0000000..ff1a5a1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 vergleichskurve ds
new file mode 100644
index 0000000..1d35616
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    10 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    10 code info ds
new file mode 100644
index 0000000..e542599
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    10 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    11 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    11 code info ds
new file mode 100644
index 0000000..00f3658
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    11 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    12 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    12 code info ds
new file mode 100644
index 0000000..0b56808
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    12 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    13 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    13 code info ds
new file mode 100644
index 0000000..2b7b5c9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    13 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    14 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    14 code info ds
new file mode 100644
index 0000000..18005f1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    14 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 code info ds
new file mode 100644
index 0000000..f9cf1eb
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 originalkurve ds
new file mode 100644
index 0000000..c8a90e9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 vergleichskurve ds
new file mode 100644
index 0000000..6cb6376
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 code info ds
new file mode 100644
index 0000000..ebfbf3d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 originalkurve ds
new file mode 100644
index 0000000..718d2fd
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 vergleichskurve ds
new file mode 100644
index 0000000..a0101f3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 code info ds
new file mode 100644
index 0000000..9fdce06
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 originalkurve ds
new file mode 100644
index 0000000..15e7407
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 vergleichskurve ds
new file mode 100644
index 0000000..165f8d9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 code info ds
new file mode 100644
index 0000000..4870f1a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 originalkurve ds
new file mode 100644
index 0000000..e568313
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 vergleichskurve ds
new file mode 100644
index 0000000..b0487d1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    5 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 code info ds
new file mode 100644
index 0000000..00410ea
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 originalkurve ds
new file mode 100644
index 0000000..c7c0891
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 vergleichskurve ds
new file mode 100644
index 0000000..7924b84
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    6 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 code info ds
new file mode 100644
index 0000000..8bfc365
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 originalkurve ds
new file mode 100644
index 0000000..136a763
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 vergleichskurve ds
new file mode 100644
index 0000000..0360f1e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    7 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    8 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    8 code info ds
new file mode 100644
index 0000000..f489af2
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    9 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    9 code info ds
new file mode 100644
index 0000000..e89f437
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 1: Populationsökologie                    9 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik
new file mode 100644
index 0000000..3e04b6f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 code info ds
new file mode 100644
index 0000000..8b0d00a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 originalkurve ds
new file mode 100644
index 0000000..9dce7dc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 vergleichskurve ds
new file mode 100644
index 0000000..bd49cc8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 code info ds
new file mode 100644
index 0000000..26dd66c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 originalkurve ds
new file mode 100644
index 0000000..1836f9f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 vergleichskurve ds
new file mode 100644
index 0000000..cc48114
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           3 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           3 code info ds
new file mode 100644
index 0000000..c6e9603
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           4 code info ds b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           4 code info ds
new file mode 100644
index 0000000..6a36c07
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/biology/Biologie 2: Enzymkinetik                           4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall
new file mode 100644
index 0000000..5297fb8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 code info ds
new file mode 100644
index 0000000..f6bbe2c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 originalkurve ds
new file mode 100644
index 0000000..1fbd808
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 vergleichskurve ds
new file mode 100644
index 0000000..1090174
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              10 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              10 code info ds
new file mode 100644
index 0000000..1d797c1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              10 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 code info ds
new file mode 100644
index 0000000..dc0df36
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 originalkurve ds
new file mode 100644
index 0000000..9a8dc0d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 vergleichskurve ds
new file mode 100644
index 0000000..8aa32d2
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 code info ds
new file mode 100644
index 0000000..a9d16e8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 originalkurve ds
new file mode 100644
index 0000000..40e4655
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 vergleichskurve ds
new file mode 100644
index 0000000..02d1eff
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 code info ds
new file mode 100644
index 0000000..709b811
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 originalkurve ds
new file mode 100644
index 0000000..828b9d4
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 vergleichskurve ds
new file mode 100644
index 0000000..013aed8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 code info ds
new file mode 100644
index 0000000..4faa893
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 originalkurve ds
new file mode 100644
index 0000000..fc98ea6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 vergleichskurve ds
new file mode 100644
index 0000000..c7f314e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              5 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              6 code info ds
new file mode 100644
index 0000000..e220e44
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              7 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              7 code info ds
new file mode 100644
index 0000000..cf64601
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              8 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              8 code info ds
new file mode 100644
index 0000000..ad5d290
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              9 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              9 code info ds
new file mode 100644
index 0000000..f04cb25
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie - Physik: Radioaktiver Zerfall              9 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I
new file mode 100644
index 0000000..47a1b43
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 code info ds
new file mode 100644
index 0000000..283c544
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 originalkurve ds
new file mode 100644
index 0000000..570d5ba
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 vergleichskurve ds
new file mode 100644
index 0000000..05334a2
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 code info ds
new file mode 100644
index 0000000..da9189a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 originalkurve ds
new file mode 100644
index 0000000..4fed8cf
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 vergleichskurve ds
new file mode 100644
index 0000000..7f60ffe
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 code info ds
new file mode 100644
index 0000000..e74f5e9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 originalkurve ds
new file mode 100644
index 0000000..2addd88
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 vergleichskurve ds
new file mode 100644
index 0000000..29e37d9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       4 code info ds
new file mode 100644
index 0000000..c5b70f6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       5 code info ds
new file mode 100644
index 0000000..8fb5b48
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       6 code info ds
new file mode 100644
index 0000000..58e62c6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 1: Reaktionskinetik I                       6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II
new file mode 100644
index 0000000..5b87476
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 code info ds
new file mode 100644
index 0000000..cb2d987
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 originalkurve ds
new file mode 100644
index 0000000..fc951fe
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 vergleichskurve ds
new file mode 100644
index 0000000..4653751
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      10 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      10 code info ds
new file mode 100644
index 0000000..a97b17f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      10 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      11 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      11 code info ds
new file mode 100644
index 0000000..cbc3b0f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      11 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      12 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      12 code info ds
new file mode 100644
index 0000000..54dfcb7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      12 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      13 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      13 code info ds
new file mode 100644
index 0000000..295d3d7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      13 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      14 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      14 code info ds
new file mode 100644
index 0000000..87c3018
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      14 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 code info ds
new file mode 100644
index 0000000..63d2732
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 originalkurve ds
new file mode 100644
index 0000000..8f55a2b
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 vergleichskurve ds
new file mode 100644
index 0000000..25716cc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 code info ds
new file mode 100644
index 0000000..035b736
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 originalkurve ds
new file mode 100644
index 0000000..06f7413
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 vergleichskurve ds
new file mode 100644
index 0000000..e16c385
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 code info ds
new file mode 100644
index 0000000..d2fc78b
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 originalkurve ds
new file mode 100644
index 0000000..b9a35d7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 vergleichskurve ds
new file mode 100644
index 0000000..e58437e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 code info ds
new file mode 100644
index 0000000..423d615
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 originalkurve ds
new file mode 100644
index 0000000..d181d07
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 vergleichskurve ds
new file mode 100644
index 0000000..3ff5fac
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      5 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 code info ds
new file mode 100644
index 0000000..9253113
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 originalkurve ds
new file mode 100644
index 0000000..66d5c63
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 vergleichskurve ds
new file mode 100644
index 0000000..177253b
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      6 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 code info ds
new file mode 100644
index 0000000..0c946cc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 originalkurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 originalkurve ds
new file mode 100644
index 0000000..0934e00
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 vergleichskurve ds
new file mode 100644
index 0000000..c0119a7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      7 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      8 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      8 code info ds
new file mode 100644
index 0000000..d5ed310
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      9 code info ds b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      9 code info ds
new file mode 100644
index 0000000..c18fb36
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/chemistry/Chemie 2: Reaktionskinetik II                      9 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld
new file mode 100644
index 0000000..e06a384
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 code info ds
new file mode 100644
index 0000000..f629a5a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 originalkurve ds
new file mode 100644
index 0000000..e7b91fb
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 vergleichskurve ds
new file mode 100644
index 0000000..a9137ed
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 code info ds
new file mode 100644
index 0000000..f57e3a3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 originalkurve ds
new file mode 100644
index 0000000..3f9f40b
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 vergleichskurve ds
new file mode 100644
index 0000000..08eec77
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 code info ds
new file mode 100644
index 0000000..0f99938
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 originalkurve ds
new file mode 100644
index 0000000..45d0365
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 vergleichskurve ds
new file mode 100644
index 0000000..09c3d4c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 code info ds
new file mode 100644
index 0000000..dc4c950
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 originalkurve ds
new file mode 100644
index 0000000..657df6d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 vergleichskurve ds
new file mode 100644
index 0000000..b636a09
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           5 code info ds
new file mode 100644
index 0000000..51b2221
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           6 code info ds
new file mode 100644
index 0000000..c245d8f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           7 code info ds
new file mode 100644
index 0000000..a3d59ad
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           8 code info ds
new file mode 100644
index 0000000..c8c84b8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 1: Bewegungen im Gravitationsfeld           8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen
new file mode 100644
index 0000000..217bfdc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 code info ds
new file mode 100644
index 0000000..458a4b8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 originalkurve ds
new file mode 100644
index 0000000..36d0bb8
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 vergleichskurve ds
new file mode 100644
index 0000000..7117015
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 code info ds
new file mode 100644
index 0000000..d8cc452
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 originalkurve ds
new file mode 100644
index 0000000..a719225
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 vergleichskurve ds
new file mode 100644
index 0000000..44b86db
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 code info ds
new file mode 100644
index 0000000..638820a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 originalkurve ds
new file mode 100644
index 0000000..f5f626d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 vergleichskurve ds
new file mode 100644
index 0000000..7f84ec1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 4 code info ds
new file mode 100644
index 0000000..23017d4
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 5 code info ds
new file mode 100644
index 0000000..9c708b1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 6 code info ds
new file mode 100644
index 0000000..2173675
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 2: Mechanische Schwingungen                 6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern
new file mode 100644
index 0000000..b3a005a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 code info ds
new file mode 100644
index 0000000..da668bc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 originalkurve ds
new file mode 100644
index 0000000..ab2524c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 vergleichskurve ds
new file mode 100644
index 0000000..d61fcce
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  10 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  10 code info ds
new file mode 100644
index 0000000..7188064
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  10 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 code info ds
new file mode 100644
index 0000000..10ae13f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 originalkurve ds
new file mode 100644
index 0000000..8cb0350
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 vergleichskurve ds
new file mode 100644
index 0000000..25047b5
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 code info ds
new file mode 100644
index 0000000..bca8bc0
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 originalkurve ds
new file mode 100644
index 0000000..ebfee05
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 vergleichskurve ds
new file mode 100644
index 0000000..bfdc85a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 code info ds
new file mode 100644
index 0000000..7e51cda
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 originalkurve ds
new file mode 100644
index 0000000..6b95da2
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 vergleichskurve ds
new file mode 100644
index 0000000..cf3a9bc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 code info ds
new file mode 100644
index 0000000..5824c74
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 originalkurve ds
new file mode 100644
index 0000000..bec3fdd
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 vergleichskurve ds
new file mode 100644
index 0000000..9afdb18
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  5 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  6 code info ds
new file mode 100644
index 0000000..7c57776
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  7 code info ds
new file mode 100644
index 0000000..f20f4c7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  8 code info ds
new file mode 100644
index 0000000..86f7138
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  9 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  9 code info ds
new file mode 100644
index 0000000..152400e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 3: Ladungen in elektr. und magnet. Feldern  9 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen
new file mode 100644
index 0000000..800d852
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 code info ds
new file mode 100644
index 0000000..dd1bf34
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 originalkurve ds
new file mode 100644
index 0000000..e247d03
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 vergleichskurve ds
new file mode 100644
index 0000000..fd28612
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          10 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          10 code info ds
new file mode 100644
index 0000000..3213b89
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          10 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          11 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          11 code info ds
new file mode 100644
index 0000000..d727472
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          11 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          12 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          12 code info ds
new file mode 100644
index 0000000..d90d730
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          12 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          13 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          13 code info ds
new file mode 100644
index 0000000..2d8e131
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          13 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          14 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          14 code info ds
new file mode 100644
index 0000000..8fc92c9
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          14 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 code info ds
new file mode 100644
index 0000000..5b45740
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 originalkurve ds
new file mode 100644
index 0000000..b95226d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 vergleichskurve ds
new file mode 100644
index 0000000..56add2a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 code info ds
new file mode 100644
index 0000000..17f584c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 originalkurve ds
new file mode 100644
index 0000000..2f9dadf
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 vergleichskurve ds
new file mode 100644
index 0000000..b09599a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 code info ds
new file mode 100644
index 0000000..5042dc5
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 originalkurve ds
new file mode 100644
index 0000000..e7969e2
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 vergleichskurve ds
new file mode 100644
index 0000000..c057670
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          4 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 code info ds
new file mode 100644
index 0000000..6f83eb0
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 originalkurve ds
new file mode 100644
index 0000000..2ae1122
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 vergleichskurve ds
new file mode 100644
index 0000000..a43b502
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          5 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 code info ds
new file mode 100644
index 0000000..38232c1
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 originalkurve ds
new file mode 100644
index 0000000..ea08e21
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 vergleichskurve ds
new file mode 100644
index 0000000..030b66f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          6 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 code info ds
new file mode 100644
index 0000000..9a4739c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 originalkurve ds
new file mode 100644
index 0000000..44d1712
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 vergleichskurve ds
new file mode 100644
index 0000000..813c12d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          7 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          8 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          8 code info ds
new file mode 100644
index 0000000..db2af96
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          8 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          9 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          9 code info ds
new file mode 100644
index 0000000..87ded51
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 4: RLC-Schaltungen                          9 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen
new file mode 100644
index 0000000..770bc44
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 code info ds
new file mode 100644
index 0000000..172cd62
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 originalkurve ds
new file mode 100644
index 0000000..01b19cf
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 vergleichskurve ds
new file mode 100644
index 0000000..25c11d3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               1 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 code info ds
new file mode 100644
index 0000000..1ef5fa5
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 originalkurve ds
new file mode 100644
index 0000000..7b11c58
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 vergleichskurve ds
new file mode 100644
index 0000000..059ddcd
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               2 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 code info ds
new file mode 100644
index 0000000..2b9d6df
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 originalkurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 originalkurve ds
new file mode 100644
index 0000000..ab1c8c5
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 originalkurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 vergleichskurve ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 vergleichskurve ds
new file mode 100644
index 0000000..5132825
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               3 vergleichskurve ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               4 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               4 code info ds
new file mode 100644
index 0000000..0ea6486
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               4 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               5 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               5 code info ds
new file mode 100644
index 0000000..f75da5e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               5 code info ds
diff --git a/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               6 code info ds b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               6 code info ds
new file mode 100644
index 0000000..0af2e7c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/data/physics/Physik 5: Relativistische Bewegungen               6 code info ds
diff --git a/app/schulis-simulationssystem/3.0/source-disk b/app/schulis-simulationssystem/3.0/source-disk
new file mode 100644
index 0000000..cfd911d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/source-disk
@@ -0,0 +1,4 @@
+schulis-simulationssystem-3.0/04_simulationssystem-startdiskette.img
+schulis-simulationssystem-3.0/05_modelldatenbank-biologie.img
+schulis-simulationssystem-3.0/06_modelldatenbank-chemie.img
+schulis-simulationssystem-3.0/07_modelldatenbank-physik.img
diff --git a/app/schulis-simulationssystem/3.0/src/TEXTE deutsch b/app/schulis-simulationssystem/3.0/src/TEXTE deutsch
new file mode 100644
index 0000000..2f6bd23
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/TEXTE deutsch
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10
new file mode 100644
index 0000000..373245e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 6*10
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14
new file mode 100644
index 0000000..cdb76cb
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*14
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16
new file mode 100644
index 0000000..49b821a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*16
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19
new file mode 100644
index 0000000..caff4ba
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*19
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8
new file mode 100644
index 0000000..5a455fa
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 8*8
diff --git a/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14 b/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14
new file mode 100644
index 0000000..46e2f95
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ZEICHEN 9*14
diff --git a/app/schulis-simulationssystem/3.0/src/bs b/app/schulis-simulationssystem/3.0/src/bs
new file mode 100644
index 0000000..8cd5e0a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/bs
@@ -0,0 +1,2 @@
+PACKETbildschirmspeicherDEFINESgibdiagrammausschnitt,newout,lineout,zwischenraumohnebox,inboxspeicher,bsspeicherinit,bsspeicherlesen:LETblank=" ",stdlaenge=80,linealzeile=22;LET BILDSCHIRMSPEICHER=STRUCT(ROW24TEXTboxspeicher,bildspeicher);DATASPACE VARbsds;BOUND BILDSCHIRMSPEICHER VARbs;BOOL VARlinealein:=TRUE;WINDOW VARfenster:=standardfenster;OP:=(BILDSCHIRMSPEICHER VARleft,BILDSCHIRMSPEICHER CONSTright):left:=rightEND OP:=;PROCbsspeicherinit:bsspeicherinit(TRUE)END PROCbsspeicherinit;PROCbsspeicherinit(BOOL CONSTmitbildschirmausgabe):INT VARi;TEXT VARblank:=stdlaenge*" ";forget(bsds);bsds:=nilspace;bs:=bsds;zeileninitialisieren;linealinitialisieren.zeileninitialisieren:FORiFROM1UPTO24REPbs.boxspeicher(i):=blank;bs.bildspeicher(i):=blankPER;bs.bildspeicher(linealzeile):=(stdlaenge-1)*waagerecht.linealinitialisieren:linealausgeben(mitbildschirmausgabe).END PROCbsspeicherinit;PROCbsspeicherlesen(AREA CONSTa):INT VARi,ax,axs;ax:=areax(a);axs:=ax+areaxsize(a)-1;FORiFROMareay(a)UPTOareay(a)+areaysize(a)-1REPcursor(ax,i);outsubtext(bs.bildspeicher(i),ax,axs)PER;END PROCbsspeicherlesen;PROCbsspeicherlesen(WINDOW CONSTw):AREA VARareazuw;fill(areazuw,areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2);bsspeicherlesen(areazuw);END PROCbsspeicherlesen;PROCgibdiagrammausschnitt(FILE VARf):modify(f);insertrecord(f);writerecord(f,blank);bsspeicherinfile;unterkantedesrahmens.zwischenstueck:(stdlaenge-1)*waagerecht.bsspeicherinfile:INT VARi;TEXT VARzeile;FORiFROM2UPTOlinealzeile-1REPzeile:=bs.bildspeicher(i);IF(zeileSUB1)=blankTHENreplace(zeile,1,senkrecht)FI;neuedateizeile(f,zeile)PER.unterkantedesrahmens:neuedateizeile(f,eckeuntenlinks+subtext(bs.bildspeicher(linealzeile),2,stdlaenge)).END PROCgibdiagrammausschnitt;PROCneuedateizeile(FILE VARf,TEXT CONSTt):down(f);insertrecord(f);writerecord(f,compress(t))END PROCneuedateizeile;PROCnewout(WINDOW VARw,INT CONSTi,j,TEXT CONSTt):cursor(w,i,j);out(t);replace(bs.bildspeicher(areay(w)+j-1),areax(w)+i-1,t);replace(bs.boxspeicher(areay(w)+j-1),areax(w)+i-1,t)END PROCnewout;PROClineout(WINDOW VARw,INT CONSTi,j,TEXT CONSTt):INT VARbi,bj;TEXT VARb,char:=t;bi:=areax(w)+i-1;bj:=areay(w)+j-1;b:=(bs.bildspeicher(bj)SUBbi);IF(t=senkrechtANDwaagerechtaufbs)OR(t=waagerechtANDsenkrechtaufbs)THENchar:=kreuzFI;cursor(bi,bj);out(char);replace(bs.bildspeicher(bj),bi,char).waagerechtaufbs:b=waagerechtORb=kreuz.senkrechtaufbs:b=senkrechtORb=kreuz.END PROClineout;BOOL PROCzwischenraumohnebox(INT CONSTzeile,spaltevon,spaltebis):compress(subtext(bs.boxspeicher(zeile),spaltevon,spaltebis))=""END PROCzwischenraumohnebox;TEXT PROCinboxspeicher(INT CONSTzeile,spalte):bs.boxspeicher(zeile)SUBspalteEND PROCinboxspeicher;PROClinealausgeben(BOOL CONSTmitbildschirmausgabe):zeigewaagerechteslineal;zeigesenkrechteslineal.zeigewaagerechteslineal:INT VARi;FORiFROM1UPTOigittersizeREPreplace(bs.bildspeicher(linealzeile),waagerechteposition,zahlinderwaagerechten)PER;IFmitbildschirmausgabeTHENcursor(1,linealzeile);out(bs.bildspeicher(linealzeile))FI.zahlinderwaagerechten:INT VARzahl:=impos(gitterstart)+i-1;anfang+text(zahl).anfang:IFzahleinstelligTHENwaagerechtELSE""FI.zahleinstellig:zahl<10.waagerechteposition:areax(fenster)+iwindowpos(gpos(i,1))+4.zeigesenkrechteslineal:FORiFROM1UPTOjgittersizeREPreplace(bs.bildspeicher(senkrechteposition),1,zahlindersenkrechten);IFmitbildschirmausgabeTHENcursor(1,senkrechteposition);outsubtext(bs.bildspeicher(senkrechteposition),1,2)FI PER.zahlindersenkrechten:zahl:=jmpos(gitterstart)+i-1;text(zahl)+rest.rest:IFzahleinstelligTHENblankELSE""FI.senkrechteposition:areay(fenster)+jwindowpos(gpos(1,i)).END PROClinealausgeben;END PACKETbildschirmspeicher;
+
diff --git a/app/schulis-simulationssystem/3.0/src/dp2 b/app/schulis-simulationssystem/3.0/src/dp2
new file mode 100644
index 0000000..68b919c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/dp2
@@ -0,0 +1,10 @@
+PACKETdiagrammpraesentation2DEFINESwderfassen,erfassenamenundwd,copywd:LETtop1=""84""85""86""87""88""89"",top2=""90""91"",auskunftseite1=""28"",fehlerbeiformel=""78""79"",grenzwerte=""80"",fehlerhaftenamen=""81""82"",fehlerhafterausdruck=""83"",esc=""27"",return=""13"",piep=""7"",blank=" "; 
+LETneuepositionwaehlen=502,zumzielobjekt=505,pfeilbeginnamboxrand=506,pfeilendeamboxrand=504,pfeilamboxrand=590,ausschnittgedruckt=508,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,singularzeit=515,zeitnichtbeinflussen=521,parameternichtbeinflussen=522,auswahlobjekttyp=540,zyklischeverknuepfung=541,ausgangbeiformel=548,ausgangbeiergebnissen=549,zuvielevariablenundergebnisse=552,zuvieleparameter=553,isoliert=562,formelohneausgang=564,syntaxfehler=565,pruefunglaeuft=567,inkonsistenz=568,speichern=572,pruefungsinnlos=579,allesbelegt=581,nichtsbelegt=582,aktionenfuerzeit=587,aktionensonst=585,tastenfuerzeit=588,tastensonst=586,ueberschriftaktionen=589,wdkopfzeile=509,wdfusszeile=501,wdfusszeilenachpruefung=591,aenderungengespeichert=592,cancel=584,hinweisleerername=523,hinweissyntaxfehler=524,hinweisdoppeltername=525,hinweislangername=526,hinweisformalerfehler=527,hinweisfalscheranfang=529,hinweisleererausdruck=539;LETmaxi=20,maxj=10,maxlink=8,maxvar=20,maxpar=20,maxmodellnamelang=30,maxmodellnamekurz=15,stmenuoderweiter=33,fehlertaste=4,fragehierabspeichern=96,fehlerlangname=80,fehlerkurzname=81,fehlerlangnamefehlt=82,fehlerkurznamefehlt=83,fehlermodellnamedoppelt=92,info="i",drucken="d",bildaufbauen="n",abbruch="a",abbruchmenu="m",abbrechen="a",auskunftstaste="i",auskunftsloeschtaste1="z",abspeichern="s",weitertaste="w",simulation="w",eingabe="z",ueberpruefung="p",janein="JjYyNn",ja="JjYy";LETtag=1,delimiter=6;WINDOW VARmenuwindow:=window(1,1,79,24);WINDOW CONSTzeichenflaeche:=window(2,3,77,19);BOOL VARletzteaenderunggespeichert:=TRUE;BOOL CONSTls:=TRUE;PROCallesspeichern(TEXT CONSTlang,INT VARreturncode):TEXT VARtaste;returncode:=0;doublefootnote(anwendungstext(speichern));REPinchar(taste)UNTILpos(janein,taste)>0PER;IFpos(ja,taste)>0THENaenderungenspeichern(dsname);ELSEreturncode:=1FI.dsname:name(wddsnamen,link(wdmodelle,lang)).END PROCallesspeichern;GPOS VARgp;PROCletzteaenderungnochnichtgespeichert:letzteaenderunggespeichert:=FALSE END PROCletzteaenderungnochnichtgespeichert;PROCeditieren(TEXT VARtaste):CELL VARactualcell;OBJEKT VARaktuellesobjekt;gp:=getgcursor;taste:="";REPbewegecursor(gp,taste,PROCgibbildaus);actualcell:=cell(gp);aktuellesobjekt:=objekt(actualcell);IFtaste=returnTHEN IFpositionbesetztTHENaktionenanbietenundausfuehrenELSEneueselementeinfuegenundzeigenFI;olddoublefootnoteELIFtaste=escTHEN ELSEout(piep)FI UNTILtaste=escPER.positionbesetzt:INT VARi:=impos(mpos(gp)),j:=jmpos(mpos(gp));belegt(i,j).neueselementeinfuegenundzeigen:neuesobjekteditieren(mpos(gp));taste:="".aktionenanbietenundausfuehren:doublefootnote("");INT VARaktion:=boxalternative(menuwindow,info,liste,buchstaben,5,FALSE,FALSE,PROC(AREA CONST)bsspeicherlesen)MOD100;aktionausfuehren.info:anwendungstext(ueberschriftaktionen).liste:anwendungstext(aktionen).buchstaben:anwendungstext(tasten).aktionen:IFtyp(aktuellesobjekt)=zeitTHENaktionenfuerzeitELSEaktionensonstFI.tasten:IFtyp(aktuellesobjekt)=zeitTHENtastenfuerzeitELSEtastensonstFI.aktionausfuehren:IFtyp(aktuellesobjekt)=zeitANDaktion>2THENaktionINCR1FI;SELECTaktionOF CASE1:elementwegnehmenCASE2:elementmerken;zielpositionfestlegen;IF NOTabbruchgewuenschtTHENactualcell:=cell(gp);aktuellesobjekt:=objekt(actualcell);IFtaste=returnAND(NOTpositionbesetzt)THENelementanalterpositionloeschen;elementanneuerpositioneintragenELSEout(piep)FI FI CASE3:alteselementeditierenCASE5:verbindungaufbauen(gp)CASE6:verbindungloesen(gp)END SELECT.alteselementeditieren:objekteditieren(mpos(gp));boxohnerahmen(objekt(mpos(gp)),gp);taste:="".elementwegnehmen:verbindungenloesen;deletecell(mpos(gp));letzteaenderungnochnichtgespeichert;IFalteverbindungenvorhandenTHENgibbildausELSEbox(aktuellesobjekt,gp,FALSE)FI.alteverbindungenvorhanden:z>0.verbindungenloesen:INT VARnr,z:=0;FORnrFROM1UPTOmaxlinkREP IF(actualcellAUSGANGnr)OR(actualcellEINGANGnr)THENzINCR1;loeschelink(mpos(gp),nr)FI PER.abbruchgewuenscht:taste=esc.elementmerken:MPOS VARaltmp:=mpos(gp);INT VARialt:=impos(mpos(gp)),jalt:=
+jmpos(mpos(gp)).zielpositionfestlegen:doublefootnote(anwendungstext(neuepositionwaehlen));bewegecursor(gp,taste,PROCgibbildaus).elementanalterpositionloeschen:CELL VARcellalt:=cell(altmp),cellneu;deletecell(altmp);IFimgitter(altmp)THENbox(ialt,jalt)FI.elementanneuerpositioneintragen:newcell(objekt(cellalt),newposition);cellneu:=cellalt;letzteaenderungnochnichtgespeichert;verbindungenaktualisieren;IFalteverbindungenvorhandenTHENgibbildausELSEbox(i,j)FI.verbindungenaktualisieren:z:=0;FORnrFROM1UPTOmaxlinkREP IF NOT((cellneuUEBERnr)=null)THENzINCR1;ggfverweisaufsichselbstaendern;IFcellneuAUSGANGnrTHENlink(newposition,nr,cellneuUEBERnr,cellneuNRnr)ELIFcellneuEINGANGnrTHENlink(cellneuUEBERnr,cellneuNRnr,newposition,nr)FI FI PER.newposition:mpos(gp).ggfverweisaufsichselbstaendern:IF(cellneuAUSGANGnr)AND((cellneuUEBERnr)=altmp)THENlink(newposition,nr,newposition,cellneuNRnr)FI.END PROCeditieren;PROCobjekteditieren(MPOS CONSTmp):OBJEKT CONSTobj:=objekt(mp);BOOL VARgespeichert:=FALSE;fehlercode:=0;fehlermeldung:="";IFtyp(obj)=variableORtyp(obj)=ergebnisTHENvariableeditieren(startcell,gespeichert,fehlercode,fehlermeldung)ELIFtyp(obj)=parameterTHENparametereditieren(startcell,gespeichert,fehlercode,fehlermeldung)ELIFtyp(obj)=formelTHENformeleditieren(startcell,gespeichert,fehlercode,fehlermeldung)FI;IFgespeichertTHENletzteaenderungnochnichtgespeichertFI.startcell:cell(mp).END PROCobjekteditieren;PROCneuesobjekteditieren(MPOS CONSTmp):ROW5INT VARobjekttyp;INT VARi:=0;vorls;erfragetypdesobjektes;IFeingabedestypszulaessigTHENlegecellan;editiereggfobjektFI.erfragetypdesobjektes:doublefootnote("");TEXT VARtasten:="";INT VAReingabedestyps:=boxalternative(menuwindow,info,liste,tasten,position,FALSE,FALSE,PROC(AREA CONST)bsspeicherlesen)MOD100;.eingabedestypszulaessig:eingabedestyps>0ANDeingabedestyps<6.legecellan:newcell(neuesobjekt,mp).neuesobjekt:new(neuertyp).neuertyp:SELECTobjekttyp(eingabedestyps)OF CASE1:variableCASE2:ergebnisCASE3:parameterCASE4:formelCASE5:zeitOTHERWISEnilEND SELECT.editiereggfobjekt:BOOL VARgespeichert:=FALSE;disablestop;fehlercode:=0;fehlermeldung:="";SELECTobjekttyp(eingabedestyps)OF CASE1,2:variableeditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE3:parametereditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE4:formeleditieren(startcell,gespeichert,fehlercode,fehlermeldung)CASE5:gespeichert:=TRUE END SELECT;IFiserrorTHENclearerror;gespeichert:=FALSE FI;enablestop;IFgespeichertTHENletzteaenderungnochnichtgespeichert;box(objekt(startcell),gpos(mp),TRUE)ELSEdeletecell(mp)FI.startcell:cell(mp).info:anwendungstext(auswahlobjekttyp).liste:evtlmodellvariable+evtlparameter+evtlevariable+fktzusammenhang+immerzeit+schluss.evtlmodellvariable:IFanzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)>=maxvarTHEN""ELSEiINCR1;objekttyp(i):=1;tastenCAT"v";anwendungstext(singularmodellgroesse)+returnFI.evtlparameter:IFanzahlmpos(parameterthesaurus)>=maxparTHEN""ELSEiINCR1;objekttyp(i):=3;tastenCAT"p";anwendungstext(singularparameter)+returnFI.evtlevariable:iINCR1;objekttyp(i):=2;IFanzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)>=maxvarTHEN""ELSEtastenCAT"e";anwendungstext(singularergebnis)+returnFI.fktzusammenhang:iINCR1;objekttyp(i):=4;tastenCAT"f";anwendungstext(singularformel)+return.immerzeit:iINCR1;objekttyp(i):=5;tastenCAT"z";anwendungstext(singularzeit)+return.schluss:tastenCAT"-c";blank+return+anwendungstext(cancel).position:4.END PROCneuesobjekteditieren;PROCverbindungaufbauen(GPOS CONSTpos):GPOS VARfrompos:=pos,topos;MPOS VARfrom,to;TEXT VARtaste:="";untersuchesourcecell;bestimmetargetcell;merkeverbindung;letzteaenderungnochnichtgespeichert;zeigeneueverbindung.untersuchesourcecell:from:=mpos(frompos);IFstartobjektergebnisTHENweiseaufungeeignetesobjekthin(ausgangbeiergebnissen);leaveELIFalleverknuepfungspunkteamstartbelegtTHENweiseaufungeeignetesobjekthin(allesbelegt);leaveELSEverarbeitestartobjektFI.startobjektergebnis:typ(objekt(sourcecell))=ergebnis.
+alleverknuepfungspunkteamstartbelegt:TEXT VARfreiepunkte:=freieverknuepfungspunkte(sourcecell);length(freiepunkte)=0.verarbeitestartobjekt:schreibehinweisstartposition;INT VARvon:=bewegecursorauflinkpositionen(frompos,freiepunkte);gcursor(frompos);IFvon=0THENleaveELIF NOTbeginnfreiTHENout(piep);leaveFI;LEAVEuntersuchesourcecell.bestimmetargetcell:REPschreibehinweistargetcell;gcursor(frompos);bewegecursor(topos,taste,PROCgibbildaus);to:=mpos(topos);IFtaste=escTHENleaveELIFtaste=returnANDbelegt(targetcell)THEN IFzielobjektzeitTHENweiseaufungeeignetesobjekthin(zeitnichtbeinflussen)ELIFzielobjektparameterTHENweiseaufungeeignetesobjekthin(parameternichtbeinflussen)ELIFalleverknuepfungspunkteamzielbelegtTHENweiseaufungeeignetesobjekthin(allesbelegt)ELIFzielobjektformelundnureingaengeTHENweiseaufungeeignetesobjekthin(ausgangbeiformel)ELIFzielobjektformelundrekursionTHENweiseaufungeeignetesobjekthin(zyklischeverknuepfung)ELSEverarbeitezielobjektFI ELSEout(piep)FI;PER.alleverknuepfungspunkteamzielbelegt:freiepunkte:=freieverknuepfungspunkte(targetcell);IFfrom=toTHENchange(freiepunkte,text(von,1),"")FI;length(freiepunkte)=0.zielobjektzeit:typ(aktuellesobjekt)=zeit.zielobjektparameter:typ(aktuellesobjekt)=parameter.zielobjektformelundnureingaenge:IF NOT(typ(aktuellesobjekt)=formel)THEN FALSE ELSE INT VARi,anzahleingaenge:=0;FORiFROM1UPTOmaxlinkREP IFtargetcellEINGANGiTHENanzahleingaengeINCR1FI PER;anzahleingaenge=maxlink-1FI.zielobjektformelundrekursion:(typ(aktuellesobjekt)=formelANDto=from)OR(typ(aktuellesobjekt)=formelANDtyp(startobjekt)=formelAND(fromREKURSIVto)).startobjekt:objekt(sourcecell).aktuellesobjekt:objekt(targetcell).verarbeitezielobjekt:schreibehinweisendposition;INT VARzu:=bewegecursorauflinkpositionen(topos,freiepunkte);gcursor(topos);IFzu=0THENleaveELIF(NOTendefrei)ORanfanggleichendeTHENout(piep);leaveFI;LEAVEbestimmetargetcell.beginnfrei:(sourcecellUEBERvon)=null.endefrei:(targetcellUEBERzu)=null.anfanggleichende:from=toANDvon=zu.sourcecell:cell(from).targetcell:cell(to).merkeverbindung:link(from,von,to,zu).zeigeneueverbindung:zeichneverbindung(from,von,to,zu).schreibehinweistargetcell:doublefootnote(anwendungstext(zumzielobjekt)).schreibehinweisstartposition:doublefootnote(anwendungstext(pfeilbeginnamboxrand)).schreibehinweisendposition:doublefootnote(anwendungstext(pfeilendeamboxrand)).leave:LEAVEverbindungaufbauen.END PROCverbindungaufbauen;BOOL OP REKURSIV(MPOS CONSTstart,ziel):pruefetyp;zielZUstart.pruefetyp:IF NOT(typ(objekt(start))=formel)THEN LEAVE REKURSIV WITH FALSE FI.END OP REKURSIV;BOOL OP ZU(MPOS CONSTstart,ziel):INT VARi;CELL CONSTactualcell:=cell(start);FORiFROM1UPTOmaxlinkREP IF(actualcellAUSGANGi)THEN MPOS CONSTnachbarposition:=(actualcellUEBERi);IFtyp(nachbarobjekt)=formelTHENbehandlebenachbarteformelFI FI PER;FALSE.behandlebenachbarteformel:IFnachbarposition=zielTHEN LEAVE ZU WITH TRUE ELIFnachbarpositionZUzielTHEN LEAVE ZU WITH TRUE FI.nachbarobjekt:objekt(nachbarcell).nachbarcell:cell(nachbarposition).END OP ZU;PROCverbindungloesen(GPOS CONSTfrompos):MPOS VARfrommpos;untersuchesourcecell;loescheverbindung;letzteaenderungnochnichtgespeichert;gcursor(frompos);.untersuchesourcecell:frommpos:=mpos(frompos);pruefeundverarbeiteggfdieangeklicktecell.pruefeundverarbeiteggfdieangeklicktecell:IFallesfreiTHENweiseaufungeeignetesobjekthin(nichtsbelegt)ELSEschreibehinweisstartposition;INT VARvon:=bewegecursorauflinkpositionen(frompos,belegtepunkte);gcursor(frompos);IFkeinelinkpositiongewaehltTHENleaveFI;LEAVEuntersuchesourcecellFI.allesfrei:TEXT VARbelegtepunkte:=belegteverknuepfungspunkte(clickedcell);length(belegtepunkte)=0.keinelinkpositiongewaehlt:von=0.loescheverbindung:loeschelink(frommpos,von);gibbildaus.clickedcell:cell(frommpos).schreibehinweisstartposition:doublefootnote(anwendungstext(pfeilamboxrand)).leave:LEAVEverbindungloesen.END PROCverbindungloesen;PROCdiagrammausschnittdrucken:DATASPACE VARds:=nilspace;FILE VARf:=sequentialfile(modify,ds);diagrammausschnitterzeugen;formelnauflisten;
+fileversenden;meldunganbenutzerabsetzen.diagrammausschnitterzeugen:gibdiagrammausschnitt(f).formelnauflisten:INT VARi,j,starti:=impos(gitterstart),endi:=starti+igittersize-1,startj:=jmpos(gitterstart),endj:=startj+jgittersize-1;output(f);line(f,2);FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)ANDtyp(objekt(actualcell))=formelTHENobjekttext(f,newmpos(i,j))FI PER PER.actualcell:cell(i,j).fileversenden:save(ds,"Diagrammausschnitt",printer);forget(ds).meldunganbenutzerabsetzen:doublefootnote(anwendungstext(ausschnittgedruckt));pause(10);olddoublefootnote.END PROCdiagrammausschnittdrucken;INT VARfehlercode:=0;MPOS VARfehlerposition:=null;TEXT VARfehlermeldung:="";PROCpruefung:initialisierungen;IFpruefungsinnvollTHENcellmatrixabarbeitenELSEfehlerposition:=newmpos(1,1);LEAVEpruefungFI;olddoublefootnote.initialisierungen:TEXT VARbezeichnerliste:=listeallerbezeichner(null);doublefootnote(anwendungstext(pruefunglaeuft));fehlercode:=0;fehlerposition:=null;fehlermeldung:="";.pruefungsinnvoll:IF NOT(anzahlmpos(variablenthesaurus)+anzahlmpos(ergebnisthesaurus)=0)ANDboxvorhandenTHEN TRUE ELSEfehlercode:=pruefungsinnlos;FALSE FI.cellmatrixabarbeiten:INT VARi,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFbelegt(cell(i,j))THENpruefecellFI PER PER.pruefecell:CELL CONSTactualcell:=cell(i,j);OBJEKT CONSTaktuellesobjekt:=objekt(actualcell);testeaufisolierung;IFtyp(aktuellesobjekt)=formelTHENtesteformel;zaehleausgaengederformel;sucheimtermunberuecksichtigteeingaenge;FI;.testeaufisolierung:INT VARverbindungszaehler,anzahlverbindungen:=0;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellEINGANGverbindungszaehler)OR(actualcellAUSGANGverbindungszaehler)THENanzahlverbindungenINCR1FI PER;IFobjektisoliertTHENfehlerposition:=mpos(actualcell);fehlercode:=isoliert;LEAVEpruefungFI.objektisoliert:anzahlverbindungen=0.testeformel:IFsyntaktischerfehlerTHENfehlercode:=syntaxfehler;fehlerposition:=mpos(actualcell);LEAVEpruefungFI.syntaktischerfehler:NOTtermistkorrekt(actualcell,ausdruck(aktuellesobjekt),bezeichnerliste,fehlermeldung).sucheimtermunberuecksichtigteeingaenge:THESAURUS VAReingaenge,internenamen,nichtverwendetenamen;eingaenge:=elannamenallereinlaufendenflusslinien;internenamen:=scanneformelundsucheinternenamen;nichtverwendetenamen:=eingaenge-(internenamen/eingaenge);schreibewarnungenfuernichtverwendetenamen.elannamenallereinlaufendenflusslinien:THESAURUS VARt:=emptythesaurus;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellEINGANGverbindungszaehler)THENinsert(t,elanname(objekt(cell(actualcellUEBERverbindungszaehler))))FI PER;t.scanneformelundsucheinternenamen:t:=emptythesaurus;TEXT VARterm:=ausdruck(aktuellesobjekt),symbol;INT VARtype;scan(term);nextsymbol(symbol,type);WHILE NOTendeerreichtREPverarbeitesymbol;nextsymbol(symbol,type)PER;t.endeerreicht:type>delimiter.verarbeitesymbol:IFtype=tagTHENinsert(t,symbol)FI.schreibewarnungenfuernichtverwendetenamen:INT VARzaehler:=0;IFhighestentry(nichtverwendetenamen)>0THENfehlercode:=inkonsistenz;fehlerposition:=mpos(actualcell);get(nichtverwendetenamen,fehlermeldung,zaehler);LEAVEpruefungFI.zaehleausgaengederformel:anzahlverbindungen:=0;FORverbindungszaehlerFROM1UPTOmaxlinkREP IF(actualcellAUSGANGverbindungszaehler)THENanzahlverbindungenINCR1FI PER;IFobjektohneausgangTHENfehlercode:=formelohneausgang;fehlerposition:=mpos(actualcell);LEAVEpruefungFI.objektohneausgang:anzahlverbindungen=0.END PROCpruefung;PROCwderfassen(TEXT CONSTlang,INT VARreturncode):TEXT VARtaste:="";letzteaenderunggespeichert:=TRUE;returncode:=0;bildschirmaufbauen;gcursor(gpos(newmpos(1,1)));wdeditieren;IF NOTletzteaenderunggespeichertTHENallesspeichern(lang,returncode)FI.bildschirmaufbauen:gitterfenster(newmpos(1,1));page;writehead(anwendungstext(wdkopfzeile));writepermanentdoublefootnote(anwendungstext(wdfusszeile));gibbildaus.wdeditieren:REPwdlauffaehig(FALSE);editieren(taste);verarbeiteescsequenzUNTILabbruchgewuenschtPER.verarbeiteescsequenz:inchar(taste);IFtaste=infoTHENwdinfoausgebenELIFtaste=
+ueberpruefungTHEN IF(NOTboxvorhanden)THENdoublefootnote(anwendungstext(pruefungsinnlos));pause(20);olddoublefootnoteELSEwdpruefenFI;ELIFtaste=abspeichernTHEN IF(NOTboxvorhanden)THENdoublefootnote("Keine Eingaben! Speichern sinnlos");pause(20);olddoublefootnoteELSEwdspeichernFI;ELIFtaste=druckenTHENwddruckenELIFtaste=bildaufbauenTHENwdneuausgebenELIFtaste=abbruchTHENletzteaenderunggespeichert:=FALSE;ELSEout(piep)FI.abbruchgewuenscht:taste=abbruch.wdinfoausgeben:infotextauswahl(auskunftzumfehler,compilermeldung,top1,top2);writehead(anwendungstext(wdkopfzeile));writepermanentdoublefootnote(anwendungstext(wdfusszeile));bsspeicherlesen(zeichenflaeche).auskunftzumfehler:IFsyntaktischerfehlerTHENauskunftzumsyntaxfehler(fehlermeldung)ELIFfehlerbeimfunktionalenzusammenhangTHENfehlerbeiformelELIFgrenzenverletztTHENgrenzwerteELIFfehlerbeibenennungTHENfehlerhaftenamenELIFfehlerbeiausdruckTHENfehlerhafterausdruckELSE""FI.syntaktischerfehler:fehlercode=syntaxfehlerORfehlercode=hinweissyntaxfehler.fehlerbeimfunktionalenzusammenhang:fehlercode=zyklischeverknuepfungORfehlercode=ausgangbeiformelORfehlercode=formelohneausgangORfehlercode=inkonsistenz.grenzenverletzt:fehlercode=zuvielevariablenundergebnisseORfehlercode=zuvieleparameterORfehlercode=isoliert.fehlerbeibenennung:fehlercode=hinweisleerernameORfehlercode=hinweisdoppelternameORfehlercode=hinweislangernameORfehlercode=hinweisformalerfehlerORfehlercode=hinweisfalscheranfang.fehlerbeiausdruck:fehlercode=hinweisleererausdruck.compilermeldung:IFsyntaktischerfehlerTHENfehlermeldungELIFfehlergefundenTHENanwendungstext(fehlercode)ELSE""FI.wdpruefen:pruefung;IFfehlergefundenTHENpositioniereauffehlerhaftesobjekt;ELSEweitereverarbeitungFI.fehlergefunden:fehlercode>0.positioniereauffehlerhaftesobjekt:neueposition;doublefootnote(meldung);gcursor(gpos(fehlerposition)).meldung:IFfehlermeldung=""THENanwendungstext(fehlercode)ELSEanwendungstext(fehlercode)+return+fehlermeldungFI.neueposition:IFimgitter(fehlerposition)THENgitterfenster(gitterstart)ELSEgitterfenster(newmpos(i,j));gibbildausFI.i:min(maxi-igittersize+1,impos(fehlerposition)).j:min(maxj-jgittersize+1,jmpos(fehlerposition)).weitereverarbeitung:writepermanentdoublefootnote(anwendungstext(wdfusszeilenachpruefung));wdlauffaehig(TRUE);REP REPbewegecursoraufgitterUNTILtaste=escPER;inchar(taste);IFtaste=simulationTHENwdsimulationELIFtaste=eingabeTHENwritepermanentdoublefootnote(anwendungstext(wdfusszeile));LEAVEweitereverarbeitungELIFtaste=druckenTHENwddruckenELIFtaste=abspeichernTHENwdspeichernELIFtaste=abbrechenTHEN LEAVEwdeditierenELSEout(piep)FI PER.bewegecursoraufgitter:GPOS VARgp:=getgcursor;bewegecursor(gp,taste,PROCgibbildaus).wdsimulation:transformierewirkungsdiagrammundstartesimulation(NOTls,returncode);page;writehead(anwendungstext(wdkopfzeile));olddoublefootnote;bsspeicherlesen(zeichenflaeche).wddrucken:diagrammausschnittdrucken.wdspeichern:aenderungenspeichern(dsname);letzteaenderunggespeichert:=TRUE;doublefootnote(anwendungstext(aenderungengespeichert));pause(10);olddoublefootnote.wdspeichernundverlassen:aenderungenspeichern(dsname);doublefootnote(anwendungstext(aenderungengespeichert));pause(10);returncode:=0;LEAVEwderfassen.dsname:name(wddsnamen,link(wdmodelle,lang)).wdneuausgeben:gibbildaus.END PROCwderfassen;PROCweiseaufungeeignetesobjekthin(INT CONSTnr):out(piep);fehlercode:=nr;doublefootnote(anwendungstext(nr));pause(20)END PROCweiseaufungeeignetesobjekthin;LETauskcompilunbekkomm="\",auskcompilparameter="]",auskcompilsymbole="^",auskfalschertyp="_",auskcompilungueltzw="AB",auskcompilmehrfdekl="C",auskcompilsonstiges="D";LETunbekkommdo="unbekanntes Kommando",undefdyadischop="undefinierter dyadischer",undefmonadop="undefinierter monadischer",paramsindfalsch="Typen der Parameter sind falsch",nurletzteanweisg="nur die letzte Anweisung",anstelledessymb="anstelle des letzten Symbols",unzulselektsymb="unzulaessiges Selektor-Symbol",konstdarfnicht="die Konstante darf nicht veraendert",klammerauffehlt="'(' fehlt",klammerzufehlt=
+"')' fehlt",operatorfehlt="';' oder Operator ('+',",ungueltigzwischen="ungueltig zwischen Anweisungen",istmehrfachdekl="ist mehrfach deklariert",falschertypdesresultats="falscher Typ des Resultats";TEXT PROCauskunftzumsyntaxfehler(TEXT CONSTmessage):IFpos(message,unbekkommdo)<>0THENauskcompilunbekkommELIFpos(message,undefdyadischop)<>0CORpos(message,undefmonadop)<>0CORpos(message,paramsindfalsch)<>0THENauskcompilparameterELIFpos(message,nurletzteanweisg)<>0CORpos(message,anstelledessymb)<>0CORpos(message,unzulselektsymb)<>0CORpos(message,konstdarfnicht)<>0THENauskcompilsymboleELIFpos(message,klammerauffehlt)<>0CORpos(message,klammerzufehlt)<>0CORpos(message,operatorfehlt)<>0CORpos(message,ungueltigzwischen)<>0THENauskcompilungueltzwELIFpos(message,istmehrfachdekl)<>0THENauskcompilmehrfdeklELIFpos(message,falschertypdesresultats)<>0THENauskfalschertypELSEauskcompilsonstigesFI.END PROCauskunftzumsyntaxfehler;DATASPACE VARfeldds;BOUND ROW100TEXT VARfeld;INT CONSTseite1:=18;INT VARcursorfeld;TEXT CONSTleeresfeld:=77*" ";PROCerfassenamenundwd(TEXT CONSTmbname,INT CONSTmodellnr,INT VARreturncode):enablestop;BOOL VARfalscheeingaben;TEXT VARinfotext:="",taste:="",lang:="",kurz:="";returncode:=0;forget(feldds);feldds:=nilspace;feld:=feldds;REPkernvonwderfassungPER.kernvonwderfassung:maskefuernamenausgeben;REPputgetformular1(feld,cursorfeld,taste);IFtaste=abbruchmenuTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF(NOTfalscheeingaben)CANDabspeicherngewuenschtTHEN IFmodellneuTHENwdeinfuegen(mbname,lang,kurz)ELSEwdumbenennen(lang,kurz,modellnr)FI;aenderungenspeichern(dsname);leavewderfassungFI;returncode:=1;leavewderfassungELIFtaste=auskunftstasteTHENinfotext:=auskunftseite1;fehlermeldung:="";auskunftsdienst(infotext,fehlermeldung,auskunftsloeschtaste1);show(formular(seite1));cursorfeld:=2;feld(1):=leeresfeld;footnote(steuerleiste(stmenuoderweiter));ELIFtaste=weitertasteTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHEN IFmodellneuTHENwdeinfuegen(mbname,lang,kurz)ELSEwdumbenennen(lang,kurz,modellnr)FI;wderfassen(lang,returncode);IFreturncode=1THENbeseitigedsundpflegethesauri;FI;leavewderfassung;FI;ELSEfeld(1):=meldungstext(fehlertaste)FI PER.beseitigedsundpflegethesauri:loesche((link(wdmodelle,lang)+20),mbname);.maskefuernamenausgeben:lang:=aktuellermodellname;kurz:=aktuellermodellkurzname;maskezurmodellinitialisierungausgeben(lang,kurz).modellneu:modellnr=0.abspeicherngewuenscht:put(formular(seite1),"",1);cursor(3,20);yes(compress(meldungstext(fragehierabspeichern))).dsname:name(wddsnamen,link(wdmodelle,lang)).leavewderfassung:forget(feldds);LEAVEerfassenamenundwd.END PROCerfassenamenundwd;PROCmaskezurmodellinitialisierungausgeben(TEXT CONSTlang,kurz):show(formular(seite1));footnote(steuerleiste(stmenuoderweiter));cursorfeld:=2;feld(1):=leeresfeld;feld(2):=lang+(maxmodellnamelang-length(lang))*"_";feld(3):=kurz+(maxmodellnamekurz-length(kurz))*"_";feld(4):="";feld(5):="";.END PROCmaskezurmodellinitialisierungausgeben;PROCeingabendeserstenformularspruefen(TEXT VARlang,kurz,INT CONSTmodellinbearbeitung,BOOL VARfalscheeingaben):ROW5TEXT VARhilfsfeld;feld(1):=leeresfeld;put(formular(seite1),feld(1),1);langnamenpruefen;aufnamensgleichheitpruefen;kurznamenpruefen;eingabenablegen;falscheeingaben:=FALSE.verlasseeingabendeserstenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeserstenformularspruefen.langnamenpruefen:hilfsfeld(2):=feld(2);hilfsfeld(2):=komprimiere(hilfsfeld(2));IFlength(hilfsfeld(2))=0THENfeld(1):=meldungstext(fehlerlangnamefehlt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(2))>maxmodellnamelangTHENfeld(1):=meldungstext(fehlerlangname);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.kurznamenpruefen:hilfsfeld(3):=feld(3);hilfsfeld(3):=komprimiere(hilfsfeld(3));IFlength(hilfsfeld(3))=0THENfeld(1):=meldungstext(fehlerkurznamefehlt);cursorfeld:=3;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(3))>
+maxmodellnamekurzTHENfeld(1):=meldungstext(fehlerkurzname);cursorfeld:=3;verlasseeingabendeserstenformularspruefenFI.aufnamensgleichheitpruefen:IFmodellinbearbeitung<>link(wdmodelle,hilfsfeld(2))CAND(wdmodelleCONTAINShilfsfeld(2))THENfeld(1):=meldungstext(fehlermodellnamedoppelt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.eingabenablegen:lang:=hilfsfeld(2);kurz:=hilfsfeld(3).END PROCeingabendeserstenformularspruefen;DATASPACE VARmodellds;PROCcopywd(INT CONSTnr,TEXT CONSTmodellbank,INT VARreturncode):datenraumkopieren;wdkopieeditieren.datenraumkopieren:forget(modellds);modellds:=old(name(wddsnamen,nr)).wdkopieeditieren:diagrammankoppeln(modellds);erfassenamenundwd(modellbank,0,returncode).END PROCcopywd;END PACKETdiagrammpraesentation2;
+
+
diff --git a/app/schulis-simulationssystem/3.0/src/e b/app/schulis-simulationssystem/3.0/src/e
new file mode 100644
index 0000000..f36f65f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/e
@@ -0,0 +1,2 @@
+PACKETergaenzungenzurbenutzerschnittstelleDEFINESvorls,nachls,doublefootnote,olddoublefootnote,writepermanentdoublefootnote:TEXT VARpermanentfootnote:="";PROCvorls:doublefootnote(" ")END PROCvorls;PROCnachls:doublefootnote(" ")END PROCnachls;PROCdoublefootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);ersterteil;zweiterteil;cursor(x,y).ersterteil:INT VARumbruch:=pos(t,"
");cursor(1,23);IFumbruch>0THENout(invers(text(subtext(t,1,umbruch-1),76)))ELSEout(invers(text(t,76)))FI.zweiterteil:cursor(1,24);IFumbruch>0THENout(invers(text(subtext(t,umbruch+1,LENGTHt),76)))ELSEout(invers(76*" "))FI.END PROCdoublefootnote;PROColddoublefootnote:doublefootnote(permanentfootnote)END PROColddoublefootnote;PROCwritepermanentdoublefootnote(TEXT CONSTt):permanentfootnote:=t;doublefootnote(t)END PROCwritepermanentdoublefootnote;END PACKETergaenzungenzurbenutzerschnittstelle;
+
diff --git a/app/schulis-simulationssystem/3.0/src/g b/app/schulis-simulationssystem/3.0/src/g
new file mode 100644
index 0000000..5964efc
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/g
@@ -0,0 +1,4 @@
+PACKETkoordinatenDEFINES GPOS,MPOS,null,:=,=,igpos,jgpos,impos,jmpos,iwindowpos,jwindowpos,gpos,mpos,newmpos,gcursor,getgcursor,bewegecursor,standardfenster,imgitter,igittersize,jgittersize,gitterfenster,gitterstart,:LETmaxlength=9,maxheight=1,habstand=4,vabstand=2,xsize=77,ysize=20,maxi=20,maxj=10;TEXT CONSTcursorbewegungen:="���
+��"+return+rubin+rubout;LETreturn="
",rubin="�",rubout="�",hop="�",piep="�";WINDOW VARfenster:=window(2,2,xsize,ysize);WINDOW PROCstandardfenster:fensterEND PROCstandardfenster;TYPE GITTERFENSTER=STRUCT(MPOSstart,INTisize,jsize);TYPE GPOS=STRUCT(INTi,j);TYPE MPOS=STRUCT(INTi,j);GPOS PROCgpos(INT CONSTi,j):GPOS VARg;g.i:=i;g.j:=j;gENDPROCgpos;OP:=(GPOS VARl,GPOS CONSTr):CONCR(l):=CONCR(r)ENDOP:=;INT PROCigpos(GPOS CONSTg):g.iEND PROCigpos;INT PROCjgpos(GPOS CONSTg):g.jEND PROCjgpos;BOOL OP=(GPOS CONSTl,r):(l.i=r.i)AND(l.j=r.j)END OP=;MPOS PROCnewmpos(INT CONSTi,j):MPOS VARm;m.i:=i;m.j:=j;mEND PROCnewmpos;MPOS PROCnull:MPOS VARm;m.i:=0;m.j:=0;mEND PROCnull;BOOL OP=(MPOS CONSTl,r):(l.i=r.i)AND(l.j=r.j)END OP=;OP:=(MPOS VARl,MPOS CONSTr):CONCR(l):=CONCR(r)ENDOP:=;INT PROCimpos(MPOS CONSTm):m.iEND PROCimpos;INT PROCjmpos(MPOS CONSTm):m.jEND PROCjmpos;MPOS PROCmpos(GPOS CONSTg):newmpos(standardgitter.start.i+g.i-1,standardgitter.start.j+g.j-1)ENDPROCmpos;GPOS PROCgpos(MPOS CONSTm):GPOS VARg;IF NOTimgitter(m)THENg.i:=0;g.j:=0;ELSEg.i:=m.i-standardgitter.start.i+1;g.j:=m.j-standardgitter.start.j+1FI;gENDPROCgpos;INT PROCiwindowpos(GPOS CONSTgitterpos):(gitterpos.i-1)*(maxlength+2+habstand)+3END PROCiwindowpos;INT PROCjwindowpos(GPOS CONSTgitterpos):(gitterpos.j-1)*(maxheight+2+vabstand)+2END PROCjwindowpos;BOOL PROCimgitter(MPOS CONSTmp):standardgitter.start.i<=mp.iANDstandardgitter.start.j<=mp.jANDmp.i-standardgitter.start.i<igittersizeANDmp.j-standardgitter.start.j<jgittersizeEND PROCimgitter;BOOL PROCimgitter(GPOS CONSTgp):1<=igpos(gp)AND1<=jgpos(gp)ANDigpos(gp)<=igittersizeANDjgpos(gp)<=jgittersizeEND PROCimgitter;GITTERFENSTER VARstandardgitter;gitterfenster(newmpos(1,1));INT PROCigittersize:standardgitter.isizeEND PROCigittersize;INT PROCjgittersize:standardgitter.jsizeEND PROCjgittersize;MPOS PROCgitterstart:standardgitter.startEND PROCgitterstart;PROCgitterfenster(MPOS CONSTstart):INT VARxsize:=areaxsize(fenster),ysize:=areaysize(fenster);berechneisizeundjsize;.startpunktunzulaessig:start.i<1ORstart.i>maxiORstart.j<1ORstart.j>maxj.berechneisizeundjsize:standardgitter.start:=start;standardgitter.isize:=(xsize+1)DIVxsizeeinerboxsamtumgebung;standardgitter.jsize:=(ysize+1)DIVysizeeinerboxsamtumgebung.xsizeeinerboxsamtumgebung:(maxlength+habstand+2).ysizeeinerboxsamtumgebung:(maxheight+vabstand+2).END PROCgitterfenster;PROCverschiebegitter(INT CONSThor,vert,PROCkonstruierediagrammimneuengitterfenster):MPOS VARstartmp:=mpos(gpos(1,1));gitterfenster(newmpos(imp,jmp));konstruierediagrammimneuengitterfenster.imp:max(1,min(maxi-igittersize+1,impos(startmp)+hor)).jmp:max(1,min(maxj-jgittersize+1,jmpos(startmp)+vert)).END PROCverschiebegitter;GPOS VARgittercursor;gittercursor.i:=1;gittercursor.j:=1;PROCgcursor(GPOS CONSTg):WINDOW VARw:=fenster;IFimgitter(g)THENgittercursor:=g;cursor(w,iwindowpos(g),jwindowpos(g))FI END PROCgcursor;GPOS PROCgetgcursor:gittercursorEND PROCgetgcursor;PROCbewegecursor(GPOS VARgp,TEXT VARtaste,PROCneuesbild):INT VARsooftwie,schritte;MPOS VARaktuellempos;gcursor(gp);REPgp:=getgcursor;inchar(taste);IFtaste=hopTHENlieshopsequenzELSEsooftwie:=1+clearbufferandcount(taste)FI;SELECTpos(cursorbewegungen,taste)OF CASE1:geheevtlnachrechtsCASE2:geheevtlnachlinksCASE3:geheevtlnachobenCASE4:geheevtlnachuntenOTHERWISEverlasseprozedurENDSELECT PER.geheevtlnachrechts:WHILEsooftwie>0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(impos(aktuellempos)<maxi)THENout(piep);sooftwie:=0ELIFigpos(gp)<igittersizeTHENschritte:=min(igittersize-igpos(gp),sooftwie);gcursor(gpos(igpos(gp)+schritte,jgpos(gp)));sooftwieDECRschritteELSEverschiebegitter(sooftwie,0,PROCneuesbild);gcursor(gp);sooftwie:=0FI PER.
+geheevtlnachlinks:WHILEsooftwie>0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(1<impos(aktuellempos))THENout(piep);sooftwie:=0ELIF1<igpos(gp)THENschritte:=min(igpos(gp)-1,sooftwie);gcursor(gpos(igpos(gp)-schritte,jgpos(gp)));sooftwieDECRschritteELSEverschiebegitter(-sooftwie,0,PROCneuesbild);gcursor(gp);sooftwie:=0FI PER.geheevtlnachoben:WHILEsooftwie>0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(1<jmpos(aktuellempos))THENout(piep);sooftwie:=0ELIF1<jgpos(gp)THENschritte:=min(jgpos(gp)-1,sooftwie);gcursor(gpos(igpos(gp),jgpos(gp)-schritte));sooftwieDECRschritteELSEverschiebegitter(0,-sooftwie,PROCneuesbild);gcursor(gp);sooftwie:=0FI PER.geheevtlnachunten:WHILEsooftwie>0REPgp:=getgcursor;aktuellempos:=mpos(gp);IF NOT(jmpos(aktuellempos)<maxj)THENout(piep);sooftwie:=0ELIFjgpos(gp)<jgittersizeTHENschritte:=min(jgittersize-jgpos(gp),sooftwie);gcursor(gpos(igpos(gp),jgpos(gp)+schritte));sooftwieDECRschritteELSEverschiebegitter(0,+sooftwie,PROCneuesbild);gcursor(gp);sooftwie:=0FI PER.lieshopsequenz:REPinchar(taste);SELECTpos(cursorbewegungen,taste)OF CASE1:hoprechts;LEAVElieshopsequenzCASE2:hoplinks;LEAVElieshopsequenzCASE3:hophoch;LEAVElieshopsequenzCASE4:hoprunter;LEAVElieshopsequenzCASE6,7,8,9:verlasseprozedurOTHERWISEout(piep)END SELECT PER.hoprechts:IFigpos(gp)=igittersizeTHENsooftwie:=igittersizeELSEsooftwie:=igittersize-igpos(gp)FI.hoplinks:IFigpos(gp)=1THENsooftwie:=igittersizeELSEsooftwie:=igpos(gp)-1FI.hophoch:IFjgpos(gp)=1THENsooftwie:=jgittersizeELSEsooftwie:=jgpos(gp)-1FI.hoprunter:IFjgpos(gp)=jgittersizeTHENsooftwie:=jgittersizeELSEsooftwie:=jgittersize-jgpos(gp)FI.verlasseprozedur:LEAVEbewegecursor.END PROCbewegecursor;END PACKETkoordinaten;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls bildschirmeingaben b/app/schulis-simulationssystem/3.0/src/ls bildschirmeingaben
new file mode 100644
index 0000000..f710a8f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls bildschirmeingaben
@@ -0,0 +1,5 @@
+PACKETlseingabenDEFINESeingabemodellgroessen,gibberechnungsstandzeileaus,warteaufesc,tastelesen,forgetlogischemaske:LETdsname="log bs",headvar=62,headpar=63,headzeit=64,headvonbis=65,headdefbereich=66,anfangszeitpunktbezeichner=69,beobachtungsdauerbezeichner=70,auskberechnungsstand=71,blank=" ",cleop="�",cleol="�",beep="�",down="
+",up="�",esc="�",markon="",markoff="",abbrechen="m",escseq="19m";LETistleer=0,istueberschrift=1,istvariable=2,istparameter=3,istzeit=4;LETbuchsteingabespalte=78,spaltevon=1,ueberschriftsoffset=0,namensoffset=2,eingabenoffset=33,linienoffset=43,modellvonoffset=45,modellbisoffset=60,vonbisoffset=50,zeilenlaenge=79;LETanfangszeile=5,anzahlzeilen=19;LETlaenge=10,fracs=4;LETmaxdimension=42;BOUND STRUCT(INTzeilenanzahl,erstevarzeile,ersteparzeile,erstezeitzeile,ROWmaxdimensionTEXTzeile,ROWmaxdimensionINTzustand,ROWmaxdimensionREALmodellwert,modellvon,modellbis)VARbildschirmmaske;INT VARerstezeile,index;TEXT VARhead,foot;PROCforgetlogischemaske:forget(dsname,quiet)END PROCforgetlogischemaske;PROCinitbildschirmmaske(LOESUNG VARloesung):ZUSTAND VARvariable:=STARTWERTloesung;PARAMETER VARparameter:=PARAMETERSATZloesung;REAL VARanfangszeitpunkt:=STARTZEITloesung,beobachtungsdauer:=DAUERloesung;INT VARzaehler,aktzeile:=1;IFexists(dsname)THENbelegemodellwerteneuELSEerzeugeneuemaskeEND IF.belegemodellwerteneu:bildschirmmaske:=old(dsname);aktzeile:=bildschirmmaske.erstevarzeile+1;FORzaehlerFROM1UPTOdimensionREPbildschirmmaske.modellwert[aktzeile]:=variableSUBzaehler;aktzeileINCR1PER;aktzeile:=bildschirmmaske.ersteparzeile+1;FORzaehlerFROM1UPTOparameteranzahlREPbildschirmmaske.modellwert[aktzeile]:=parameterSUBzaehler;aktzeileINCR1PER;aktzeile:=bildschirmmaske.erstezeitzeile+1;bildschirmmaske.modellwert[aktzeile]:=anfangszeitpunkt;bildschirmmaske.modellwert[aktzeile+1]:=beobachtungsdauer;aenderetexte.aenderetexte:FORzaehlerFROM1UPTObildschirmmaske.zeilenanzahlREP IFbildschirmmaske.zustand[zaehler]>=istvariableTHENmodifizieretext;END IF END REP.modifizieretext:replace(bildschirmmaske.zeile[zaehler],eingabenoffset,wandle(bildschirmmaske.modellwert[zaehler],laenge,fracs)).erzeugeneuemaske:ZUSTAND VARvaruntergrenze:=zustandunteregrenze,varobergrenze:=zustandoberegrenze;PARAMETER VARparuntergrenze:=parameterunteregrenze,parobergrenze:=parameteroberegrenze;REAL VARdaueruntergrenze:=minbeobachtungsdauer,dauerobergrenze:=maxbeobachtungsdauer,anfanguntergrenze:=minanfangszeitpunkt,anfangobergrenze:=maxanfangszeitpunkt;aktzeile:=1;bildschirmmaske:=new(dsname);bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headvar),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.erstevarzeile:=aktzeile;aktzeileINCR1;FORzaehlerFROM1UPTOdimensionREPbildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,variablenname(zaehler),variableSUBzaehler,varuntergrenzeSUBzaehler,varobergrenzeSUBzaehler);bildschirmmaske.zustand[aktzeile]:=istvariable;bildschirmmaske.modellwert[aktzeile]:=variableSUBzaehler;bildschirmmaske.modellvon[aktzeile]:=varuntergrenzeSUBzaehler;bildschirmmaske.modellbis[aktzeile]:=varobergrenzeSUBzaehler;aktzeileINCR1PER;bildschirmmaske.zeile[aktzeile]:=(linienoffset-ueberschriftsoffset)*blank+senkrecht+cleol;bildschirmmaske.zustand[aktzeile]:=istleer;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headpar),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.ersteparzeile:=aktzeile;aktzeileINCR1;FORzaehlerFROM1UPTOparameteranzahlREPbildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,parametername(zaehler),parameterSUBzaehler,paruntergrenzeSUBzaehler,parobergrenzeSUBzaehler);bildschirmmaske.zustand[aktzeile]:=istparameter;bildschirmmaske.modellwert[aktzeile]:=parameterSUBzaehler;bildschirmmaske.modellvon[aktzeile]:=paruntergrenzeSUBzaehler;bildschirmmaske.modellbis[aktzeile]:=parobergrenzeSUBzaehler;aktzeileINCR1PER;bildschirmmaske.zeile[aktzeile]:=(linienoffset-ueberschriftsoffset)*blank+senkrecht+
+cleol;bildschirmmaske.zustand[aktzeile]:=istleer;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(TRUE,meldungstext(headzeit),0.0,0.0,0.0);bildschirmmaske.zustand[aktzeile]:=istueberschrift;bildschirmmaske.erstezeitzeile:=aktzeile;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,meldungstext(anfangszeitpunktbezeichner),anfangszeitpunkt,anfanguntergrenze,anfangobergrenze);bildschirmmaske.zustand[aktzeile]:=istzeit;bildschirmmaske.modellwert[aktzeile]:=anfangszeitpunkt;bildschirmmaske.modellvon[aktzeile]:=anfanguntergrenze;bildschirmmaske.modellbis[aktzeile]:=anfangobergrenze;aktzeileINCR1;bildschirmmaske.zeile[aktzeile]:=zeilezusammenstellen(FALSE,meldungstext(beobachtungsdauerbezeichner),beobachtungsdauer,daueruntergrenze,dauerobergrenze);bildschirmmaske.zustand[aktzeile]:=istzeit;bildschirmmaske.modellwert[aktzeile]:=beobachtungsdauer;bildschirmmaske.modellvon[aktzeile]:=daueruntergrenze;bildschirmmaske.modellbis[aktzeile]:=dauerobergrenze;bildschirmmaske.zeilenanzahl:=aktzeileEND PROCinitbildschirmmaske;TEXT PROCzeilezusammenstellen(BOOL CONSTistueberschrift,TEXT CONSTname,REAL CONSTwert,min,max):TEXT VARt;IFistueberschriftTHENt:=ueberschriftsoffset*blank;tCATcompress(name);tCAT(linienoffset-LENGTHt)*blank;tCATsenkrecht+cleolELSEt:=namensoffset*blank;tCATcompress(name);tCAT(eingabenoffset-LENGTHt-1)*blank;tCATwandle(wert,laenge,fracs);tCAT(linienoffset-LENGTHt)*blank;tCATsenkrecht;tCAT(modellvonoffset-linienoffset-1)*blank;tCATwandle(min,laenge,fracs);tCAT(modellbisoffset-modellvonoffset-laenge)*blank;tCATwandle(max,laenge,fracs);tCATcleolEND IF;tEND PROCzeilezusammenstellen;PROCbauebildschirmauf:errechneletztezeile;gibzeilenaus;loeschedenbildschirmrest.errechneletztezeile:INT VARletztezeile;letztezeile:=min(bildschirmmaske.zeilenanzahl,erstezeile+anzahlzeilen-1);WHILEbildschirmmaske.zustand[letztezeile]<istvariableREPletztezeileDECR1PER.gibzeilenaus:INT VARi,zeilenposition:=anfangszeile;FORiFROMerstezeileUPTOletztezeileREPcursor(spaltevon,zeilenposition);out(bildschirmmaske.zeile[i]);zeilenpositionINCR1PER.loeschedenbildschirmrest:FORiFROMzeilenpositionUPTOanfangszeile+anzahlzeilen-1REPcursor(spaltevon,i);out(cleol)PER.END PROCbauebildschirmauf;PROCeingabemodellgroessen(LOESUNG VARloesung,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)fkt,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,TEXT CONSTtextfuerkopfzeile,textfuerfusszeile,TEXT VARtaste,TEXT CONSTzeichenkette,INT VARfehler):initbildschirmmaske(loesung);erstezeile:=1;head:=textfuerkopfzeile;foot:=textfuerfusszeile;gibstdkopfaus;bauebildschirmauf;lasseeingeben(zeichenkette,taste);IFtaste<>abbrechenTHENberechnekurve;END IF;forgetlogischemaske;cursor(1,anfangszeile-3);out(cleop).berechnekurve:gibberechnungsstandzeileaus;speicheremodellwerte(loesung);loesungLOESUNGSABSCHNITTkurve1(PROCfkt,PROCcofkt,STARTWERTloesung,zustandunteregrenze,zustandoberegrenze,STARTZEITloesung,DAUERloesung,PARAMETERSATZloesung,anzahlbeobachtungspunkte,codimension," neue kurve",fehler);loesungDAUER(max(0.0,letztezeit(LOESUNGSABSCHNITTloesung)-(STARTZEITloesung))).END PROCeingabemodellgroessen;PROCgibstdkopfaus:cursor(spaltevon,anfangszeile-3);out(meldungstext(headdefbereich)+cleol);cursor(spaltevon,anfangszeile-2);out((linienoffset-ueberschriftsoffset)*waagerecht+kreuz+(zeilenlaenge-linienoffset-1)*waagerecht);cursor(spaltevon,anfangszeile-1);out((linienoffset-ueberschriftsoffset)*blank+senkrecht+(vonbisoffset-linienoffset-1)*blank+meldungstext(headvonbis)+cleol);footnote(foot)END PROCgibstdkopfaus;PROCcursorup:INT VARi:=index;IFi=2THEN IFerstezeile=1THENout(beep)ELSEerstezeile:=1;bauebildschirmauf;END IF ELSEloeschecursor;REPiDECR1UNTILbildschirmmaske.zustand[i]>=istvariablePER;index:=i;IFi<erstezeileTHENscrollupEND IF;END IF.scrollup:IFbildschirmmaske.zustand[i-1]=istueberschriftTHENerstezeile:=i-1ELSEerstezeile:=iEND IF;bauebildschirmaufEND PROCcursorup;PROCcursordown:INT VARi:=index;IFi=bildschirmmaske.zeilenanzahlTHENout(beep)
+ELSEloeschecursor;REPiINCR1UNTILbildschirmmaske.zustand[i]>=istvariablePER;index:=i;IFi>erstezeile+anzahlzeilen-1THENscrolldownEND IF END IF.scrolldown:INT VARoberstezeile:=i-anzahlzeilen+1;WHILEbildschirmmaske.zustand[oberstezeile]=istleerREPoberstezeileINCR1PER;erstezeile:=oberstezeile;bauebildschirmaufEND PROCcursordown;PROCloeschecursor:cursor(spaltevon+eingabenoffset-2,index-erstezeile+anfangszeile);out(wandle(bildschirmmaske.modellwert[index],laenge+1,fracs))END PROCloeschecursor;PROClasseeingeben(TEXT CONSTzeichenkette,TEXT VARendetaste):BOOL VARendegewuenscht:=FALSE;TEXT VAReingabe,allezeichen:="",endestring:=escseq+zeichenkette,exitchar;initallezeichen;bestimmeersteseingabefeld;REPlassefeldeditierenUNTILendegewuenschtPER.initallezeichen:INT VARi;FORiFROM1UPTO255REPallezeichenCATcode(i)PER.bestimmeersteseingabefeld:index:=1;REPindexINCR1;UNTILbildschirmmaske.zustand[index]>=istvariablePER;.lassefeldeditieren:eingabe:=markon+wandle(bildschirmmaske.modellwert[index],laenge,fracs);cursor(spaltevon+eingabenoffset-marksize-1,index-erstezeile+anfangszeile);editget(eingabe,laenge+1,laenge+1,up+down,allezeichen,exitchar);out(markoff);IFeingabeokTHENinterpretiereexitcharELSEfehlermeldungEND IF.fehlermeldung:footnote("Ungültige Eingabe!  Weiter mit Taste");pause;footnote(foot).eingabeok:eingabespeichern(eingabe).interpretiereexitchar:IF(exitcharSUB1)=escTHENinterpretiereescsequenzELIFexitchar=upTHENcursorupELIF NOT(index=bildschirmmaske.zeilenanzahlANDexitchar<>down)THENcursordownEND IF.interpretiereescsequenz:INT VARstelle:=pos(endestring,exitcharSUB2),alteerstezeile;IFstelle>=3THENendegewuenscht:=TRUE;endetaste:=exitcharSUB2ELIFstelle<>0THENalteerstezeile:=erstezeile;loeschecursor;behandleesc1undesc9;ELSEout(beep)END IF.behandleesc1undesc9:IFstelle=1THENindex:=2;erstezeile:=1ELSEindex:=bildschirmmaske.zeilenanzahl;erstezeile:=max(1,bildschirmmaske.zeilenanzahl-anzahlzeilen+1);WHILEbildschirmmaske.zustand[erstezeile]=istleerREPerstezeileINCR1PER END IF;IFerstezeile<>alteerstezeileTHENbauebildschirmaufEND IF END PROClasseeingeben;BOOL PROCeingabespeichern(TEXT CONSTeingabe):TEXT VARohnesteuerzeichen;REAL VARwert;IF(eingabeSUB1)=markonTHENohnesteuerzeichen:=subtext(eingabe,2)ELSEohnesteuerzeichen:=eingabeEND IF;pruefedefbereich;speicherewertab;TRUE.pruefedefbereich:wert:=real(ohnesteuerzeichen);IF NOTlastconversionokTHEN LEAVEeingabespeichernWITH FALSE END IF;IFwert>bildschirmmaske.modellbis[index]ORwert<bildschirmmaske.modellvon[index]THEN LEAVEeingabespeichernWITH FALSE END IF.speicherewertab:bildschirmmaske.modellwert[index]:=wert;replace(bildschirmmaske.zeile[index],eingabenoffset,wandle(wert,laenge,fracs))END PROCeingabespeichern;PROCspeicheremodellwerte(LOESUNG VARloesung):ZUSTAND VARzustand:=neuerzustand(dimension);PARAMETER VARparam:=neuerparameter(parameteranzahl);REAL VARanfangszeitpunkt,beobachtungsdauer;INT VARi;FORiFROM1UPTOdimensionREPreplace(zustand,i,bildschirmmaske.modellwert[i+bildschirmmaske.erstevarzeile])END REP;FORiFROM1UPTOparameteranzahlREPreplace(param,i,bildschirmmaske.modellwert[i+bildschirmmaske.ersteparzeile])END REP;anfangszeitpunkt:=bildschirmmaske.modellwert[bildschirmmaske.erstezeitzeile+1];beobachtungsdauer:=bildschirmmaske.modellwert[bildschirmmaske.erstezeitzeile+2];loesungSTARTWERTzustand;loesungPARAMETERSATZparam;loesungSTARTZEITanfangszeitpunkt;loesungDAUERbeobachtungsdauerEND PROCspeicheremodellwerte;PROCgibberechnungsstandzeileaus:cursor(1,24);out(invers(compress(auskunftstext(auskberechnungsstand))));cursor(40,24);END PROCgibberechnungsstandzeileaus;PROCtastelesen(TEXT VARtaste):warteaufesc;inchar(taste);END PROCtastelesen;PROCwarteaufesc:TEXT VARt:="";cursor(1,24);inchar(t);WHILE NOTescbeginnREPout(beep);inchar(t)PER;cursor(buchsteingabespalte,24).escbeginn:t=esc.END PROCwarteaufesc;END PACKETlseingaben;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls co routinen und co b/app/schulis-simulationssystem/3.0/src/ls co routinen und co
new file mode 100644
index 0000000..2f03286
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls co routinen und co
@@ -0,0 +1,11 @@
+PACKETcoroutinenundcoDEFINEScoroutinedummy,coroutinezeit,coroutinephase,coroutinehisto,skalierung,kreuzzeitvergleich,kreuzphasevergleich,kreuzhistovergleich,tabelle:LETerstekurve=74,zweitekurve=75,legendentext=73,auskoberbegriff=5,normaleanzahlvonausgegebenenpunkten=21,laengevarkurzform=7,laengebeibeschriftung=8,nachkommastellen=2,vorkomma=5,penanzahl=5,epsilon=0.5,abstand=0.1,achsenabstand=0.05,histogrammkennzeichen="h",zeitdiagrammkennzeichen="z",phasendiagrammkennzeichen="p",gepunktet=2,durchgezogen=1,standarddicke=0,loeschstift=0,standardstift=1;BOOL VARmitskalierung;skalierung(TRUE);REAL CONSTstandardhoehe:=stdhoehe,standardbreite:=stdbreite;LETinitialisieren=0,kreuzerzeugen=1,erstersatz=2,folgendersatz=3,anfpunktloeschen=4,plotten=5,abschluss=6,erstersatzneu=7,hminhisto=0.0,hzwihisto=3.0,hmaxhisto=12.0,maxkurven=20,maxanzvarproloesung=4;PROCskalierung(BOOL CONSTx):mitskalierung:=x;setzerahmen(x)END PROCskalierung;PROCcoroutinedummy(OUTPUT VARseite,INT CONSTfenster,KURVE VARkurve,REAL VARzeit,ZUSTAND VARmuster,ZUSTAND VARzustand,DATASPACE VARds1,INT VARwas,REAL VARxmin,xmax,ymin,ymax,BOOL VARdummy):END PROCcoroutinedummy;PROCcoroutinehisto(OUTPUT VARseite,INT CONSTfenster,KURVE VARkurve,REAL VARzeit,ZUSTAND VARmuster,ZUSTAND VARzustand,DATASPACE VARds1,INT VARwas,REAL VARxmin,xmax,ymin,ymax,BOOL VARdummy):REAL VARabbzeit,hakt,hmin,hzwi;INT VARz1;REAL VARalt,neu;BOUND STRUCT(REALt,dicke,ZUSTANDz,erster,ROWmaxanzvarproloesungINTp,ROW2PICTUREgraph,ROW4REALvpk,ROW5ROW5REALkoord,INTanz,REALnmin,nmax,tmin,tmax)VARl:=ds1;was:=wasMOD10;SELECTwasOF CASEinitialisieren:coroutineinitialisieren;was:=erstersatzCASEkreuzerzeugen:kreuzerzeugenundmalen;was:=erstersatzCASEerstersatz:erstenausgeben;was:=folgendersatzCASEfolgendersatz:folgendenausgebenCASEanfpunktloeschen:anfangspunktloeschen;was:=erstersatzneuCASEplotten:bildschirminhaltplotten;CASEabschluss:CASEerstersatzneu:putparameter(l.koord);erstenneuausgeben;was:=folgendersatzENDSELECT.coroutineinitialisieren:l.dicke:=balkendickebestimmen;l.t:=0.0;l.z:=neuerzustand(dimension+codimension);FORz1FROM1UPTOdimension+codimensionREPreplace(l.z,z1,-maxreal)PER;l.tmin:=xmin;l.tmax:=xmax;l.nmin:=ymin;l.nmax:=ymax;FORz1FROM1UPTOdimension+codimensionREPreplace(l.z,z1,l.nmin-0.1)PER;bestimmevariablenanzahl(l.p,l.anz,muster,dummy);legefensterfest(seite,l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4),fenster).kreuzerzeugenundmalen:nildiagramm(seite,fenster);beginplot;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));bestimmeextrema(histogrammkennzeichen,kurve,l.p,l.anz,l.tmin,l.tmax,l.nmin,l.nmax);window(seite,fenster,l.nmin,l.nmax,hminhisto,hmaxhisto);window(l.nmin,l.nmax,hminhisto,hmaxhisto);setzeundschreibekoordinatenkreuz;hmin:=hminhisto;hzwi:=hzwihisto;beschrifte(histogrammkennzeichen,seite,fenster,l.p,l.anz,l.nmin,l.nmax,hmin,hzwi);endplot.erstenausgeben:viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));window(l.nmin,l.nmax,hminhisto,hmaxhisto);getparameter(l.koord);erstenneuausgeben.folgendenausgeben:beginplot;putparameter(l.koord);move(l.t,hminhisto+1.0);abbzeit:=abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,zeit);IFl.t<abbzeitTHENpen(loeschstift,standardstift,standarddicke,gepunktet)ELSEpen(loeschstift,loeschstift,standarddicke,durchgezogen)FI;draw(abbzeit,hminhisto+1.0);FORz1FROM1UPTOl.anzREPbalkenfortfuehrenPER;endplot;l.t:=abbzeit;l.z:=zustand.anfangspunktloeschen:beginplot;putparameter(l.koord);FORz1FROM1UPTOl.anzREPhakt:=hzwihisto+2.1*real(z1)+0.5*standardhoehe-0.2;alt:=zustandSUBl.p(z1);linksoffenerkasten(l.nmin,min(alt,l.nmax),l.dicke,hakt,loeschstift)PER;endplot.erstenneuausgeben:FORz1FROM1UPTOdimension+codimensionREPreplace(l.z,z1,l.nmin-0.1)PER;beginplot;FORz1FROM1UPTOl.anzREPbalkenfortfuehrenPER;endplot;abbzeit:=abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,zeit);l.t:=abbzeit;l.erster:=zustand;l.z:=zustand.bildschirminhaltplotten:richtepicturesein;ordnepenszu;tragebalkeninpicture1ein;tragezeitinpicture2ein;schreibepictures.balkendickebestimmen:IFfenster=1THEN2.0*standardhoeheELSE
+standardhoeheFI.setzeundschreibekoordinatenkreuz:putkreuz(seite,fenster,kreuzerzeugenundzeichnen(l.tmin,l.tmax,l.nmin,l.nmax,histogrammkennzeichen)).balkenfortfuehren:hakt:=hzwihisto+2.1*real(z1)+0.5*standardhoehe-0.2;alt:=l.zSUBl.p(z1);neu:=zustandSUBl.p(z1);IFalt<neuTHEN IFalt<l.nminTHEN IFneu<l.nminTHEN LEAVEbalkenfortfuehrenELSElinksoffenerkasten(l.nmin,min(neu,l.nmax),l.dicke,hakt,standardstift)FI ELIFalt=l.nminTHENstrichsenkrecht(l.nmin,l.dicke,hakt,loeschstift);zweistriche(l.nmin,min(neu,l.nmax),l.dicke,hakt,standardstift)ELIFalt>l.nminCANDalt<=l.nmaxTHEN IFneu>l.nminCANDneu<=l.nmaxTHENstrichsenkrecht(alt,l.dicke,hakt,loeschstift);linksoffenerkasten(alt,neu,l.dicke,hakt,standardstift)ELIFneu>l.nmaxTHENstrichsenkrecht(alt,l.dicke,hakt,loeschstift);zweistriche(alt,l.nmax,l.dicke,hakt,standardstift)FI ELIFalt>l.nmaxTHEN LEAVEbalkenfortfuehrenFI ELIFalt=neuTHEN LEAVEbalkenfortfuehrenELIFalt>neuTHEN IFalt<l.nminTHEN LEAVEbalkenfortfuehrenELIFalt=l.nminTHENstrichsenkrecht(alt,l.dicke,hakt,loeschstift);ELIFalt>l.nminCANDalt<=l.nmaxTHENlinksoffenerkasten(max(neu,l.nmin),alt,l.dicke,hakt,loeschstift);IFneu>=l.nminCANDneu<l.nmaxTHENstrichsenkrecht(neu,l.dicke,hakt,standardstift)FI ELIFalt>l.nmaxTHEN IFneu<l.nminTHENzweistriche(l.nmin,l.nmax,l.dicke,hakt,loeschstift)ELIFneu>=l.nminCANDneu<l.nmaxTHENzweistriche(neu,l.nmax,l.dicke,hakt,loeschstift);strichsenkrecht(neu,l.dicke,hakt,standardstift)ELIFneu=l.nmaxTHENstrichsenkrecht(neu,l.dicke,hakt,standardstift)ELIFneu>l.nmaxTHEN LEAVEbalkenfortfuehrenFI FI FI.richtepicturesein:l.graph(1):=nilpicture;l.graph(2):=nilpicture.ordnepenszu:pen(l.graph(1),durchgezogen);pen(l.graph(2),gepunktet).tragebalkeninpicture1ein:FORz1FROM1UPTOl.anzREPalt:=l.ersterSUBl.p(z1);neu:=zustandSUBl.p(z1);hakt:=hzwihisto+2.1*real(z1)+0.5*standardhoehe-0.2;IFneu>l.nmaxTHENzweistrichepic(l.nmin,l.nmax,l.dicke,hakt,l.graph(1))ELSElinksoffenerkastenpic(l.nmin,neu,l.dicke,hakt,l.graph(1))FI;IFalt=l.nminTHENstrichsenkrechtpic(l.nmin,l.dicke,hakt,l.graph(1))FI;PER.tragezeitinpicture2ein:move(l.graph(2),abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,l.tmin),hminhisto+1.0);draw(l.graph(2),abbildungtbeihistogramm(l.tmin,l.tmax,l.nmin,l.nmax,zeit),hminhisto+1.0).schreibepictures:putpicture(seite,fenster,l.graph(1));putpicture(seite,fenster,l.graph(2)).END PROCcoroutinehisto;PROCzweistriche(REAL CONSTmin,max,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(min,hoehe-halbedicke);draw(max,hoehe-halbedicke);move(min,hoehe+halbedicke);draw(max,hoehe+halbedicke).END PROCzweistriche;PROCzweistrichepic(REAL CONSTmin,max,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,min,hoehe-halbedicke);draw(graph,max,hoehe-halbedicke);move(graph,min,hoehe+halbedicke);draw(graph,max,hoehe+halbedicke).END PROCzweistrichepic;PROCstrichsenkrecht(REAL CONSTpos,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(pos,hoehe-halbedicke);draw(pos,hoehe+halbedicke).END PROCstrichsenkrecht;PROCstrichsenkrechtpic(REAL CONSTpos,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,pos,hoehe-halbedicke);draw(graph,pos,hoehe+halbedicke).END PROCstrichsenkrechtpic;PROClinksoffenerkasten(REAL CONSTmin,max,dicke,hoehe,INT CONSTstift):REAL VARhalbedicke:=0.5*dicke;pen(loeschstift,stift,standarddicke,durchgezogen);move(min,hoehe-halbedicke);draw(max,hoehe-halbedicke);draw(max,hoehe+halbedicke);draw(min,hoehe+halbedicke).END PROClinksoffenerkasten;PROClinksoffenerkastenpic(REAL CONSTmin,max,dicke,hoehe,PICTURE VARgraph):REAL VARhalbedicke:=0.5*dicke;move(graph,min,hoehe-halbedicke);draw(graph,max,hoehe-halbedicke);draw(graph,max,hoehe+halbedicke);draw(graph,min,hoehe+halbedicke).END PROClinksoffenerkastenpic;PROCcoroutinezeit(OUTPUT VARseite,INT CONSTfenster,KURVE VARkurve,REAL VARzeit,ZUSTAND VARmuster,ZUSTAND VARzustand,DATASPACE VARds1,INT VARwas,REAL VARxmin,xmax,ymin,ymax,BOOL VARdummy):BOUND
+ STRUCT(REALt,dicke,ZUSTANDz,ROWmaxanzvarproloesungINTp,ROWmaxanzvarproloesungPICTUREgraph,ROW4REALvpk,ROW5ROW5REALkoord,INTanz,REALxmin,xmax,ymin,ymax)VARl:=ds1;INT VARz1;was:=wasMOD10;SELECTwasOF CASEinitialisieren:coroutineinitialisieren;was:=erstersatzCASEkreuzerzeugen:kreuzerzeugenundmalen;was:=erstersatzCASEerstersatz:erstenausgeben;was:=folgendersatzCASEfolgendersatz:folgendenausgebenCASEanfpunktloeschen:was:=erstersatzneuCASEplotten:bildschirminhaltplottenCASEabschluss:CASEerstersatzneu:putparameter(l.koord);erstenneuausgeben;was:=folgendersatzENDSELECT.coroutineinitialisieren:l.t:=0.0;l.z:=neuerzustand(dimension+codimension);l.xmin:=xmin;l.xmax:=xmax;l.ymin:=ymin;l.ymax:=ymax;richtepicturesein;bestimmevariablenanzahl(l.p,l.anz,muster,dummy);ordnepenszu;legefensterfest(seite,l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4),fenster).kreuzerzeugenundmalen:nildiagramm(seite,fenster);beginplot;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));bestimmeextrema(zeitdiagrammkennzeichen,kurve,l.p,l.anz,l.xmin,l.xmax,l.ymin,l.ymax);window(seite,fenster,l.xmin,l.xmax,l.ymin,l.ymax);window(l.xmin,l.xmax,l.ymin,l.ymax);setzeundschreibekoordinatenkreuz;beschrifte(zeitdiagrammkennzeichen,seite,fenster,l.p,l.anz,l.xmin,l.xmax,l.ymin,l.ymax);endplot.erstenausgeben:erstenneuausgeben;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));window(l.xmin,l.xmax,l.ymin,l.ymax);getparameter(l.koord).folgendenausgeben:beginplot;putparameter(l.koord);FORz1FROM1UPTOl.anzREPverbindepunkteimzeitdiagramm;PER;endplot;l.t:=zeit;l.z:=zustand.bildschirminhaltplotten:REAL VARstopzeit:=zeit;nildiagrammmitkreuz(seite,fenster);FORz1FROM1UPTOl.anzREPlesekomplettekurvePER;schreibepictures;l.t:=zeit;l.z:=zustand;.erstenneuausgeben:l.t:=zeit;l.z:=zustand.lesekomplettekurve:leseersten(kurve,zeit,zustand);REPleseabschnittmitpunktenausserhalbdessichtbarenbereiches;leseabschnittmitpunkteninnerhalbdessichtbarenbereiches;PER.leseabschnittmitpunktenausserhalbdessichtbarenbereiches:REP IF NOT(zeit<stopzeit)THEN LEAVElesekomplettekurveELIFimausgabefenster(zustand,l.p(z1),l.ymin,l.ymax)THEN LEAVEleseabschnittmitpunktenausserhalbdessichtbarenbereichesFI;lesenaechsten(kurve,zeit,zustand);PER.leseabschnittmitpunkteninnerhalbdessichtbarenbereiches:move(l.graph(z1),zeit,zustandSUBl.p(z1));REPlesenaechsten(kurve,zeit,zustand);IF NOT(zeit<=stopzeit)THEN LEAVElesekomplettekurveELIF NOTimausgabefenster(zustand,l.p(z1),l.ymin,l.ymax)THEN LEAVEleseabschnittmitpunkteninnerhalbdessichtbarenbereichesFI;draw(l.graph(z1),zeit,zustandSUBl.p(z1));IF NOT(zeit<stopzeit)THEN LEAVElesekomplettekurveFI PER.setzeundschreibekoordinatenkreuz:putkreuz(seite,fenster,kreuzerzeugenundzeichnen(l.xmin,l.xmax,l.ymin,l.ymax,zeitdiagrammkennzeichen)).richtepicturesein:FORz1FROM1UPTOmaxanzvarproloesungREPl.graph(z1):=nilpicturePER.ordnepenszu:INT VARstiftenr:=1;FORz1FROM1UPTOl.anzREPordnepenzuPER.ordnepenzu:pen(l.graph(z1),stiftenr);IFstiftenr=penanzahlTHENstiftenr:=1ELSEstiftenrINCR1FI.verbindepunkteimzeitdiagramm:BOOL VARaltimbereich:=imausgabefenster(l.z,l.p(z1),l.ymin,l.ymax),neuimbereich:=imausgabefenster(zustand,l.p(z1),l.ymin,l.ymax);IFneuimbereichCANDaltimbereichTHENmalenbzwloeschennormalFI.malenbzwloeschennormal:IFzeit<l.tTHENpen(loeschstift,loeschstift,standarddicke,durchgezogen);move(zeit,zustandSUBl.p(z1));draw(l.t,l.zSUBl.p(z1))ELSEpen(loeschstift,standardstift,standarddicke,pen(l.graph(z1)));move(l.t,l.zSUBl.p(z1));draw(zeit,zustandSUBl.p(z1))FI.schreibepictures:FORz1FROM1UPTOl.anzREPputpicture(seite,fenster,l.graph(z1))PER.END PROCcoroutinezeit;PROCcoroutinephase(OUTPUT VARseite,INT CONSTfenster,KURVE VARkurve,REAL VARzeit,ZUSTAND VARmuster,ZUSTAND VARzustand,DATASPACE VARds1,INT VARwas,REAL VARxmin,xmax,ymin,ymax,BOOL VARautomatik):LETanzahlloesung=2;BOUND STRUCT(REALt,ZUSTANDz,ROWmaxanzvarproloesungINTp,ROW4REALvpk,ROW5ROW5REALkoord,PICTUREgraph,BOOLaufbildschirm,REALxmin,xmax,ymin,ymax,BOOLanfpunkt)VARl:=ds1;INT VARdummy:=0;REAL VARxwert,ywert;BOOL VARvergleich;vergleich:=was<>(wasMOD10);was:=wasMOD10;SELECTwasOF
+ CASEinitialisieren:coroutineinitialisieren;was:=erstersatzCASEkreuzerzeugen:kreuzerzeugenundmalen;was:=erstersatzCASEerstersatz:erstenausgeben;was:=folgendersatzCASEfolgendersatz:folgendenausgebenCASEanfpunktloeschen:anfangspunktloeschen;was:=erstersatzneuCASEplotten:bildschirminhaltplotten;was:=folgendersatzCASEabschluss:CASEerstersatzneu:putparameter(l.koord);erstenneuausgeben;was:=folgendersatzENDSELECT.coroutineinitialisieren:l.t:=0.0;l.z:=neuerzustand(dimension+codimension);l.aufbildschirm:=TRUE;l.anfpunkt:=FALSE;l.xmin:=xmin;l.xmax:=xmax;l.ymin:=ymin;l.ymax:=ymax;richtepictureein;ordnepenzu;bestimmevariablenanzahl(l.p,dummy,muster,automatik);IFautomatikTHENvertauscheevtlvariablen(muster,l.xmin,l.xmax,l.ymin,l.ymax);bestimmevariablenanzahl(l.p,dummy,muster,automatik);FI;legefensterfest(seite,l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4),fenster).kreuzerzeugenundmalen:nildiagramm(seite,fenster);beginplot;viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));bestimmeextrema(phasendiagrammkennzeichen,kurve,l.p,anzahlloesung,l.xmin,l.xmax,l.ymin,l.ymax);IFautomatikTHENvertauscheevtlvariablen(muster,l.xmin,l.xmax,l.ymin,l.ymax);bestimmevariablenanzahl(l.p,dummy,muster,automatik);FI;window(seite,fenster,l.xmin,l.xmax,l.ymin,l.ymax);window(l.xmin,l.xmax,l.ymin,l.ymax);setzeundschreibekoordinatenkreuz;beschrifte(phasendiagrammkennzeichen,seite,fenster,l.p,0,l.xmin,l.xmax,l.ymin,l.ymax);endplot.erstenausgeben:viewport(l.vpk(1),l.vpk(2),l.vpk(3),l.vpk(4));window(l.xmin,l.xmax,l.ymin,l.ymax);getparameter(l.koord);erstenneuausgeben.folgendenausgeben:putparameter(l.koord);beginplot;pen(loeschstift,standardstift,standarddicke,durchgezogen);verbindepunkteimphasendiagramm;endplot;l.t:=zeit;l.z:=zustand.anfangspunktloeschen:IFl.anfpunktTHENxwert:=zustandSUBl.p(1);ywert:=zustandSUBl.p(2);beginplot;pen(loeschstift,loeschstift,standarddicke,durchgezogen);move(xwert,ywert);zeichnefadenkreuz;endplot;l.anfpunkt:=FALSE FI.bildschirminhaltplotten:REAL VARstopzeit:=zeit;l.aufbildschirm:=FALSE;leseersten(kurve,zeit,zustand);trageanfangspunktein;lesekomplettekurve;schreibepicture;l.t:=zeit;l.z:=zustand;l.aufbildschirm:=TRUE.erstenneuausgeben:beginplot;pen(loeschstift,standardstift,standarddicke,durchgezogen);trageanfangspunktein;l.t:=zeit;l.z:=zustand;endplot.richtepictureein:l.graph:=nilpicture.ordnepenzu:IFvergleichTHENpen(l.graph,gepunktet)ELSEpen(l.graph,durchgezogen)FI.setzeundschreibekoordinatenkreuz:putkreuz(seite,fenster,kreuzerzeugenundzeichnen(l.xmin,l.xmax,l.ymin,l.ymax,phasendiagrammkennzeichen)).trageanfangspunktein:IF(imausgabefenster(zustand,l.p(1),l.xmin,l.xmax)ANDimausgabefenster(zustand,l.p(2),l.ymin,l.ymax))THENxwert:=zustandSUBl.p(1);ywert:=zustandSUBl.p(2);IFl.aufbildschirmTHENmove(xwert,ywert);zeichnefadenkreuz;l.anfpunkt:=TRUE ELSEmove(l.graph,xwert,ywert);zeichnefadenkreuzimpicFI;FI.zeichnefadenkreuz:drawcmr(0.2,0.0);move(xwert,ywert);drawcmr(-0.2,0.0);move(xwert,ywert);drawcmr(0.0,0.2);move(xwert,ywert);drawcmr(0.0,-0.2);move(xwert,ywert).zeichnefadenkreuzimpic:drawcmr(l.graph,0.2,0.0);move(l.graph,xwert,ywert);drawcmr(l.graph,-0.2,0.0);move(l.graph,xwert,ywert);drawcmr(l.graph,0.0,0.2);move(l.graph,xwert,ywert);drawcmr(l.graph,0.0,-0.2);move(l.graph,xwert,ywert).lesekomplettekurve:REPleseabschnittmitpunktenausserhalbdessichtbarenbereiches;leseabschnittmitpunkteninnerhalbdessichtbarenbereiches;PER.leseabschnittmitpunktenausserhalbdessichtbarenbereiches:REP IF NOT(zeit<stopzeit)THEN LEAVElesekomplettekurveELIFimausgabefenster(zustand,l.p(1),l.xmin,l.xmax)ANDimausgabefenster(zustand,l.p(2),l.ymin,l.ymax)THEN LEAVEleseabschnittmitpunktenausserhalbdessichtbarenbereichesFI;lesenaechsten(kurve,zeit,zustand);PER.leseabschnittmitpunkteninnerhalbdessichtbarenbereiches:move(l.graph,zustandSUBl.p(1),zustandSUBl.p(2));REPlesenaechsten(kurve,zeit,zustand);IF NOT(zeit<=stopzeit)THEN LEAVElesekomplettekurveELIF NOT(imausgabefenster(zustand,l.p(1),l.xmin,l.xmax)ANDimausgabefenster(zustand,l.p(2),l.ymin,l.ymax))THEN LEAVE
+leseabschnittmitpunkteninnerhalbdessichtbarenbereichesFI;draw(l.graph,zustandSUBl.p(1),zustandSUBl.p(2));IF(zeit=letztezeit(kurve))THENcircle(l.graph,0.3,0.0,360.0,0)FI;IF NOT(zeit<stopzeit)THEN LEAVElesekomplettekurveFI PER.verbindepunkteimphasendiagramm:BOOL VARaltimbereich:=imausgabefenster(l.z,l.p(1),l.xmin,l.xmax)CANDimausgabefenster(l.z,l.p(2),l.ymin,l.ymax),neuimbereich:=imausgabefenster(zustand,l.p(1),l.xmin,l.xmax)CANDimausgabefenster(zustand,l.p(2),l.ymin,l.ymax);IFneuimbereichCANDaltimbereichTHENmalenbzwloeschenFI.malenbzwloeschen:IFzeit<l.tTHENpen(loeschstift,loeschstift,standarddicke,durchgezogen);IF(l.t=letztezeit(kurve))THENmove(l.zSUBl.p(1),l.zSUBl.p(2));circle(0.3,0.0,360.0,0);FI;move(zustandSUBl.p(1),zustandSUBl.p(2));draw(l.zSUBl.p(1),l.zSUBl.p(2));ELSEpen(loeschstift,standardstift,standarddicke,pen(l.graph));move(l.zSUBl.p(1),l.zSUBl.p(2));draw(zustandSUBl.p(1),zustandSUBl.p(2));IF(zeit=letztezeit(kurve))THENcircle(0.3,0.0,360.0,0);FI;FI;.schreibepicture:putpicture(seite,fenster,l.graph).END PROCcoroutinephase;PROCvertauscheevtlvariablen(ZUSTAND VARmaske,REAL VARxmin,xmax,ymin,ymax):INT VARi;REAL VARpuffer;IFvertauschennotwendigTHENsucheindexinmaskemit1;setze2fuerdiesenindex;vertauschexundyFI.vertauschennotwendig:(xmax-xmin)<(ymax-ymin).sucheindexinmaskemit1:i:=1;WHILE(maskeSUBi)<>1.0CANDi<=dimension+codimensionREPiINCR1PER.setze2fuerdiesenindex:IFi<=dimension+codimensionTHENreplace(maske,i,2.0)FI.vertauschexundy:puffer:=ymin;ymin:=xmin;xmin:=puffer;puffer:=ymax;ymax:=xmax;xmax:=puffer;.END PROCvertauscheevtlvariablen;PROCkreuzzeitvergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARdummy):ROW4REAL VARvpk1,vpk2;REAL VARy1min,y1max;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,dummy);bestimmeextrema(zeitdiagrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(zeitdiagrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamenwertebereich;beginplot;zeichneersteskreuzimzeitvergleich;zeichnezweiteskreuzimzeitvergleich;endplot.bestimmegemeinsamenwertebereich:IFy1min<yminTHENymin:=y1minFI;IFy1max>ymaxTHENymax:=y1maxFI.zeichneersteskreuzimzeitvergleich:nildiagramm(seite,fenster1);legefensterfest(seite,vpk1(1),vpk1(2),vpk1(3),vpk1(4),fenster1);viewport(vpk1(1),vpk1(2),vpk1(3),vpk1(4));window(seite,fenster1,xmin,xmax,ymin,ymax);window(xmin,xmax,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,zeitdiagrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(zeitdiagrammkennzeichen,seite,fenster1,pos,anzahl,xmin,xmax,ymin,ymax).zeichnezweiteskreuzimzeitvergleich:nildiagramm(seite,fenster2);legefensterfest(seite,vpk2(1),vpk2(2),vpk2(3),vpk2(4),fenster2);viewport(vpk2(1),vpk2(2),vpk2(3),vpk2(4));window(seite,fenster2,x1min,x1max,ymin,ymax);window(x1min,x1max,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(x1min,x1max,ymin,ymax,zeitdiagrammkennzeichen);putkreuz(seite,fenster2,kreuz);beschrifte(zeitdiagrammkennzeichen,seite,fenster2,pos,anzahl,x1min,x1max,ymin,ymax).END PROCkreuzzeitvergleich;PROCkreuzphasevergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARautomatik):ROW4REAL VARvpk;REAL VARy1min,y1max;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,automatik);bestimmeextrema(phasendiagrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(phasendiagrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamebereiche;IFautomatikTHENvertauscheevtlvariablen(maske,xmin,xmax,ymin,ymax)FI;x1min:=xmin;x1max:=xmax;beginplot;schreibeundbeschriftekreuz;endplot.bestimmegemeinsamebereiche:IFx1min<xminTHENxmin:=x1minFI;IFx1max>xmaxTHENxmax:=x1maxFI;IFy1min<yminTHENymin:=y1minFI;IFy1max>ymaxTHENymax:=y1maxFI.schreibelegende:REAL VARa,b,abstand;TEXT VARname;INT
+ VARlaenge;PICTURE VARlegende:=nilpicture,linie1:=nilpicture,linie2:=nilpicture;a:=real(laengebeibeschriftung)*standardbreite;b:=2.0*standardhoehe+0.2;abstand:=9.0*standardbreite;move(legende,xmin,ymin);movecmr(legende,-1.0*a,-1.0*b);draw(legende,meldungstext(legendentext),0.0,standardhoehe,standardbreite);movecmr(legende,abstand,0.0);name:=meldungstext(erstekurve);laenge:=length(name);draw(legende,name,0.0,standardhoehe,standardbreite);movecmr(legende,(real(laenge)+0.5)*standardbreite,0.0);pen(linie1,durchgezogen);move(linie1,xmin,ymin);movecmr(linie1,(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie1,real(laenge)*standardbreite,0.0);abstand:=abstand+(real(laenge)+0.5)*standardbreite;pen(loeschstift,standardstift,standarddicke,pen(linie1));plot(linie1);name:=meldungstext(zweitekurve);laenge:=length(name);draw(legende,name,0.0,standardhoehe,standardbreite);pen(linie2,gepunktet);move(linie2,xmin,ymin);movecmr(linie2,(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie2,real(laenge)*standardbreite,0.0);pen(loeschstift,standardstift,standarddicke,pen(linie2));plot(linie2);pen(legende,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(legende));plot(legende);putkreuz(seite,fenster1,legende);putkreuz(seite,fenster1,linie1);putkreuz(seite,fenster1,linie2).schreibeundbeschriftekreuz:nildiagramm(seite,fenster1);legefensterfest(seite,vpk(1),vpk(2),vpk(3),vpk(4),fenster1);viewport(vpk(1),vpk(2),vpk(3),vpk(4));window(seite,fenster1,xmin,xmax,ymin,ymax);window(xmin,xmax,ymin,ymax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,phasendiagrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(phasendiagrammkennzeichen,seite,fenster1,pos,anzahl,xmin,xmax,ymin,ymax);schreibelegende.END PROCkreuzphasevergleich;PROCkreuzhistovergleich(OUTPUT VARseite,KURVE VARk1,k2,ZUSTAND VARmaske,INT CONSTfenster1,fenster2,ROWmaxanzvarproloesungINT VARpos,REAL VARxmin,xmax,x1min,x1max,ymin,ymax,BOOL VARdummy):ROW4REAL VARvpk1,vpk2;REAL VARy1min,y1max,hmin,hzwi,hmax;PICTURE VARkreuz;INT VARanzahl;bestimmevariablenanzahl(pos,anzahl,maske,dummy);bestimmeextrema(histogrammkennzeichen,k1,pos,anzahl,xmin,xmax,ymin,ymax);bestimmeextrema(histogrammkennzeichen,k2,pos,anzahl,x1min,x1max,y1min,y1max);bestimmegemeinsamenwertebereich;beginplot;zeichneersteskreuzimhistogrammvergleich;zeichnezweiteskreuzimhistogrammvergleich;endplot.bestimmegemeinsamenwertebereich:IFy1min<yminTHENymin:=y1minFI;IFy1max>ymaxTHENymax:=y1maxFI.zeichneersteskreuzimhistogrammvergleich:nildiagramm(seite,fenster1);legefensterfest(seite,vpk1(1),vpk1(2),vpk1(3),vpk1(4),fenster1);viewport(vpk1(1),vpk1(2),vpk1(3),vpk1(4));hmin:=hminhisto;hzwi:=hzwihisto;hmax:=hmaxhisto;window(seite,fenster1,ymin,ymax,hmin,hmax);window(ymin,ymax,hmin,hmax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(xmin,xmax,ymin,ymax,histogrammkennzeichen);putkreuz(seite,fenster1,kreuz);beschrifte(histogrammkennzeichen,seite,fenster1,pos,anzahl,ymin,ymax,hmin,hzwi).zeichnezweiteskreuzimhistogrammvergleich:nildiagramm(seite,fenster2);legefensterfest(seite,vpk2(1),vpk2(2),vpk2(3),vpk2(4),fenster2);viewport(vpk2(1),vpk2(2),vpk2(3),vpk2(4));window(seite,fenster2,ymin,ymax,hmin,hmax);window(ymin,ymax,hmin,hmax);kreuz:=nilpicture;kreuz:=kreuzerzeugenundzeichnen(x1min,x1max,ymin,ymax,histogrammkennzeichen);putkreuz(seite,fenster2,kreuz);beschrifte(histogrammkennzeichen,seite,fenster2,pos,anzahl,ymin,ymax,hmin,hzwi).END PROCkreuzhistovergleich;PROCbestimmevariablenanzahl(ROWmaxanzvarproloesungINT VARpos,INT VARanzahl,ZUSTAND CONSTmuster,BOOL VARautomatik):INT VARz1,z2;FORz1FROM1UPTOmaxanzvarproloesungREPpos(z1):=0PER;z2:=0;automatik:=TRUE;FORz1FROM1UPTOdimension+codimensionREP IF(musterSUBz1)<>0.0THENz2INCR1;IF(musterSUBz1)=1.0THENpos(z2):=z1ELSEpos(2):=z1;z2:=0;automatik:=FALSE FI;FI;PER;anzahl:=z2.END PROCbestimmevariablenanzahl;PROCbestimmeextrema(TEXT CONSTwas,KURVE VARkurve,ROWmaxanzvarproloesungINT CONSTpos,INT CONSTanzahl,REAL VARxmin,xmax,ymin,ymax):INT VARi;ZUSTAND VARzustand:=neuerzustand(dimension
++codimension);IFwas=phasendiagrammkennzeichenTHENeinfacherandwertebestimmenELSErandwerteausmehrerenloesungenbestimmenFI;IFxmin>xmaxTHEN REAL VARhelpx:=xmin;xmin:=xmax;xmax:=helpx;ELIFxmax=xminTHENxmax:=xmin+epsilon;xmin:=xmin-epsilon;FI;IFymin>ymaxTHEN REAL VARhelp:=ymin;ymin:=ymax;ymax:=help;ELIFymax=yminTHENymax:=ymin+epsilon;ymin:=ymin-epsilon;FI.einfacherandwertebestimmen:ymin:=max(minimalwerte(kurve)SUBpos(2),randuntenSUBpos(2));ymax:=min(maximalwerte(kurve)SUBpos(2),randobenSUBpos(2));xmin:=max(minimalwerte(kurve)SUBpos(1),randuntenSUBpos(1));xmax:=min(maximalwerte(kurve)SUBpos(1),randobenSUBpos(1));ymin:=ymin-achsenabstand*(ymax-ymin);xmin:=xmin-achsenabstand*(xmax-xmin).randwerteausmehrerenloesungenbestimmen:ymin:=max(minimalwerte(kurve)SUBpos(1),randuntenSUBpos(1));ymax:=min(maximalwerte(kurve)SUBpos(1),randobenSUBpos(1));FORiFROM2UPTOanzahlREP IFmax(minimalwerte(kurve)SUBpos(i),randuntenSUBpos(i))<yminTHENymin:=max(minimalwerte(kurve)SUBpos(i),randuntenSUBpos(i));FI;IFmin(maximalwerte(kurve)SUBpos(i),randobenSUBpos(i))>ymaxTHENymax:=min(maximalwerte(kurve)SUBpos(i),randobenSUBpos(i));FI;PER;IFwas=zeitdiagrammkennzeichenTHENymin:=ymin-achsenabstand*(ymax-ymin)FI;xmax:=letztezeit(kurve);leseersten(kurve,xmin,zustand).END PROCbestimmeextrema;PICTURE PROCkreuzerzeugenundzeichnen(REAL CONSTxmin,xmax,ymin,ymax,TEXT CONSTzeichen):PICTURE VARtransfer;BOUND PICTURE VARkreuz;REAL VARhoehe,stelle;ROW3REAL VARschoenezahl;INT VARpos;BOOL VARzeitachsehisto;IFexists("KREUZ")THENforget("KREUZ",quiet)FI;kreuz:=new("KREUZ");kreuz:=nilpicture;ordnestiftzu;IFzeichen=histogrammkennzeichenTHENzeichnetachse;zeichnenachse;IFmitskalierungTHENtskalierung;nskalierungFI;ELSEzeichnexachse;zeichneyachse;IFmitskalierungTHENxskalierung;yskalierungFI;FI;lieferekreuz.ordnestiftzu:pen(loeschstift,standardstift,standarddicke,durchgezogen);pen(kreuz,durchgezogen).zeichnetachse:move(ymin,hminhisto);draw(ymax,hminhisto);move(kreuz,ymin,hminhisto);draw(kreuz,ymax,hminhisto);zeichnetspitze.zeichnetspitze:move(ymax,hminhisto);drawcmr(-0.2,0.2);move(ymax,hminhisto);drawcmr(-0.2,-0.2);move(kreuz,ymax,hminhisto);drawcmr(kreuz,-0.2,0.2);move(kreuz,ymax,hminhisto);drawcmr(kreuz,-0.2,-0.2).zeichnenachse:move(ymin,hzwihisto);draw(ymax,hzwihisto);move(kreuz,ymin,hzwihisto);draw(kreuz,ymax,hzwihisto);zeichnenspitze.zeichnenspitze:drawcmr(-0.2,0.2);move(ymax,hzwihisto);drawcmr(-0.2,-0.2);drawcmr(kreuz,-0.2,0.2);move(kreuz,ymax,hzwihisto);drawcmr(kreuz,-0.2,-0.2).tskalierung:stelle:=xmin;zahlen(xmin,0.9*(xmax-xmin)+xmin,schoenezahl);zeitachsehisto:=TRUE;hoehe:=hminhisto;histoskalierung.nskalierung:stelle:=ymin;zahlen(ymin,0.9*(ymax-ymin)+ymin,schoenezahl);zeitachsehisto:=FALSE;hoehe:=hzwihisto;histoskalierung.histoskalierung:stelle:=schoenezahl(1);move(abbildungstelle,hoehe);movecmr(0.0,0.2);drawcmr(0.0,-0.3);move(kreuz,abbildungstelle,hoehe);movecmr(kreuz,0.0,0.2);drawcmr(kreuz,0.0,-0.3);beschrifte;FORposFROM2UPTO3REPstelle:=schoenezahl(pos);zeichnehistostrich;zeichnegegenstrich;beschriftePER.zeichnehistostrich:move(abbildungstelle,hoehe);drawcmr(0.0,0.1);move(kreuz,abbildungstelle,hoehe);drawcmr(kreuz,0.0,0.1).zeichnexachse:move(xmin,ymin);draw(xmax,ymin);move(kreuz,xmin,ymin);draw(kreuz,xmax,ymin);zeichnexspitze.zeichnexspitze:drawcmr(-0.2,0.2);move(xmax,ymin);drawcmr(-0.2,-0.2);drawcmr(kreuz,-0.2,0.2);move(kreuz,xmax,ymin);drawcmr(kreuz,-0.2,-0.2).zeichneyachse:move(xmin,ymin);draw(xmin,ymax);move(kreuz,xmin,ymin);draw(kreuz,xmin,ymax);zeichneyspitze.zeichneyspitze:drawcmr(0.0,standardhoehe);drawcmr(0.2,-0.2);move(xmin,ymax);movecmr(0.0,standardhoehe);drawcmr(-0.2,-0.2);drawcmr(kreuz,0.0,standardhoehe);drawcmr(kreuz,0.2,-0.2);move(kreuz,xmin,ymax);movecmr(kreuz,0.0,standardhoehe);drawcmr(kreuz,-0.2,-0.2).xskalierung:stelle:=xmin;zahlen(xmin,0.9*(xmax-xmin)+xmin,schoenezahl);IFzeichen=zeitdiagrammkennzeichenTHENstelle:=schoenezahl(1);beschrifteersten;FI;stelle:=schoenezahl(1);IFzeichen=phasendiagrammkennzeichenTHENmove(stelle,ymin);movecmr(0.0,0.2);drawcmr(0.0,-0.3)
+;move(kreuz,stelle,ymin);movecmr(kreuz,0.0,0.2);drawcmr(kreuz,0.0,-0.3);beschrifte;FI;FORposFROM2UPTO3REPstelle:=schoenezahl(pos);zeichnexstrich;zeichnegegenstrich;beschriftePER.zeichnexstrich:move(stelle,ymin);drawcmr(0.0,0.1);move(kreuz,stelle,ymin);drawcmr(kreuz,0.0,0.1).zeichnegegenstrich:drawcmr(0.0,0.1);drawcmr(0.0,-0.3);drawcmr(kreuz,0.0,0.1);drawcmr(kreuz,0.0,-0.3).beschrifteersten:move(stelle,ymin);movecmr(0.0,-1.0*standardhoehe-abstand);draw(compress(wandle(stelle,laengebeibeschriftung,nachkommastellen)),0.0,standardhoehe,standardbreite);move(kreuz,stelle,ymin);movecmr(kreuz,0.0,-1.0*standardhoehe-abstand);draw(kreuz,compress(wandle(stelle,laengebeibeschriftung,nachkommastellen)),0.0,standardhoehe,standardbreite).beschrifte:IFzeichen=histogrammkennzeichenTHENmove(abbildungstelle,hoehe)ELSEmove(stelle,ymin)FI;movecmr(((-1.0)*real(vorkomma))*standardbreite,-1.0*standardhoehe-abstand);draw(wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite);IFzeichen=histogrammkennzeichenTHENmove(kreuz,abbildungstelle,hoehe)ELSEmove(kreuz,stelle,ymin)FI;movecmr(kreuz,((-1.0)*real(vorkomma))*standardbreite,-1.0*standardhoehe-abstand);draw(kreuz,wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite).yskalierung:zahlen(ymin,0.9*(ymax-ymin)+ymin,schoenezahl);FORposFROM1UPTO3REPstelle:=schoenezahl(pos);zeichneystrich;zeichneygegenstrich;beschrifteyPER.zeichneystrich:move(xmin,stelle);drawcmr(0.1,0.0);move(kreuz,xmin,stelle);drawcmr(kreuz,0.1,0.0).zeichneygegenstrich:drawcmr(0.1,0.0);drawcmr(kreuz,0.1,0.0).beschriftey:move(xmin,stelle);movecmr((-1.0)*(real(laengebeibeschriftung)+0.5)*standardbreite,-0.5*standardhoehe);draw(wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite);move(kreuz,xmin,stelle);movecmr(kreuz,(-1.0)*(real(laengebeibeschriftung)+0.5)*standardbreite,-0.5*standardhoehe);draw(kreuz,wandle(stelle,laengebeibeschriftung,nachkommastellen),0.0,standardhoehe,standardbreite).lieferekreuz:transfer:=kreuz;forget("KREUZ",quiet);transfer.abbildungstelle:IFzeitachsehistoTHENabbildungtbeihistogramm(xmin,xmax,ymin,ymax,stelle)ELSEstelleFI.END PROCkreuzerzeugenundzeichnen;PROCbeschrifte(TEXT CONSTwas,OUTPUT VARseite,INT CONSTfenster,ROWmaxanzvarproloesungINT CONSTpos,INT CONSTanzahl,REAL VARxmin,xmax,ymin,ymax):LETbeschriftungzeitxachse="t";INT VARz1;PICTURE VARbeschriftung:=nilpicture;TEXT VARname,varoberbegriff;IFanzahl=1THEN IFpos(1)<=dimensionTHENvaroberbegriff:=variablenkurzform(pos(1));ELSEvaroberbegriff:=covariablenkurzform(pos(1)-dimension);FI;ELIFlength(compress(variablenoberbegriffkurzform))=0THENvaroberbegriff:=compress(auskunftstext(auskoberbegriff))ELSEvaroberbegriff:=variablenoberbegriffkurzform;FI;IFwas=phasendiagrammkennzeichenTHENbeschriftephaseELIFwas=histogrammkennzeichenTHENbeschriftehistoELSEbeschriftezeitFI.beschriftephase:IFpos(1)<=dimensionTHENname:=variablenkurzform(pos(1));ELSEname:=covariablenkurzform(pos(1)-dimension);FI;move(beschriftung,xmax,ymin);movecmr(beschriftung,real((-1)*laengevarkurzform)*standardbreite,-2.0*standardhoehe-0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite);IFpos(2)<=dimensionTHENname:=variablenkurzform(pos(2));ELSEname:=covariablenkurzform(pos(2)-dimension);FI;move(beschriftung,xmin,ymax);movecmr(beschriftung,real((-1)*laengevarkurzform)*standardbreite-0.1,0.0);draw(beschriftung,name,0.0,standardhoehe,standardbreite);pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));plot(beschriftung);putkreuz(seite,fenster,beschriftung).beschriftehisto:pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));move(xmin,ymin);movecmr(-(real(length(beschriftungzeitxachse))+1.0)*standardbreite,-0.2);draw(beschriftungzeitxachse,0.0,standardhoehe,standardbreite);move(xmin,ymax);movecmr(-(real(length(varoberbegriff))+1.0)*standardbreite,-0.2);draw(varoberbegriff,0.0,standardhoehe,standardbreite);move(beschriftung,xmin,
+ymin);movecmr(beschriftung,-(real(length(beschriftungzeitxachse))+1.0)*standardbreite,-0.2);draw(beschriftung,beschriftungzeitxachse,0.0,standardhoehe,standardbreite);move(beschriftung,xmin,ymax);movecmr(beschriftung,-(real(length(varoberbegriff))+1.0)*standardbreite,-0.2);draw(beschriftung,varoberbegriff,0.0,standardhoehe,standardbreite);FORz1FROM1UPTOanzahlREP IFpos(z1)<=dimensionTHENname:=variablenkurzform(pos(z1));ELSEname:=covariablenkurzform(pos(z1)-dimension);FI;move(xmin,ymax);mover(0.0,2.1*real(z1));movecmr(-(real(length(name))+1.0)*standardbreite,-0.2);draw(name,0.0,standardhoehe,standardbreite);move(beschriftung,xmin,ymax);mover(beschriftung,0.0,2.1*real(z1));movecmr(beschriftung,-(real(length(name))+1.0)*standardbreite,-0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite)PER;putkreuz(seite,fenster,beschriftung).beschriftezeit:REAL VARa,b,abstand;INT VARi,wortlaenge;ROWmaxanzvarproloesungPICTURE VARlinie;FORiFROM1UPTOmaxanzvarproloesungREPlinie(i):=nilpicturePER;INT VARstiftenr:=1;FORiFROM1UPTOanzahlREPpen(linie(i),stiftenr);IFstiftenr=penanzahlTHENstiftenr:=1ELSEstiftenrINCR1FI;PER;a:=real(laengebeibeschriftung)*standardbreite;b:=2.0*standardhoehe+0.2;abstand:=9.0*standardbreite;move(beschriftung,xmin,ymin);movecmr(beschriftung,-1.0*a,-1.0*b);draw(beschriftung,meldungstext(legendentext),0.0,standardhoehe,standardbreite);movecmr(beschriftung,abstand,0.0);FORiFROM1UPTOanzahlREPschreibenamen;unterstreichePER;beschrifteachsen;pen(beschriftung,durchgezogen);pen(loeschstift,standardstift,standarddicke,pen(beschriftung));plot(beschriftung);putkreuz(seite,fenster,beschriftung).schreibenamen:IFpos(i)<=dimensionTHENname:=variablenkurzform(pos(i));ELSEname:=covariablenkurzform(pos(i)-dimension);FI;wortlaenge:=length(name);draw(beschriftung,name,0.0,standardhoehe,standardbreite);movecmr(beschriftung,(real(wortlaenge)+0.5)*standardbreite,0.0).unterstreiche:stiftenr:=pen(linie(i));pen(linie(i),stiftenr);move(linie(i),xmin,ymin);movecmr(linie(i),(-1.0)*a+abstand,((-1.0)*b-0.1));drawcmr(linie(i),real(wortlaenge)*standardbreite,0.0);abstand:=abstand+(real(wortlaenge)+0.5)*standardbreite;pen(loeschstift,standardstift,standarddicke,pen(linie(i)));plot(linie(i));putkreuz(seite,fenster,linie(i)).beschrifteachsen:move(beschriftung,xmin,ymax);movecmr(beschriftung,(-1.0)*real(min(laengevarkurzform,length(varoberbegriff)))*standardbreite-0.1,0.0);draw(beschriftung,varoberbegriff,0.0,standardhoehe,standardbreite);name:=beschriftungzeitxachse;move(beschriftung,xmax,ymin);movecmr(beschriftung,-1.0*standardbreite,0.2);draw(beschriftung,name,0.0,standardhoehe,standardbreite).END PROCbeschrifte;REAL PROCabbildungtbeihistogramm(REAL CONSTtmin,tmax,nmin,nmax,takt):IFtmax=tminTHENnminELSEnmin+((takt-tmin)*(nmax-nmin)/(tmax-tmin))FI.END PROCabbildungtbeihistogramm;REAL PROCberechnetestbeizeitdiagramm(REAL CONSTx1,x2,y1,y2,yzw):IFy1=y2THENx1ELSEx1+((x2-x1)*(yzw-y1))/(y2-y1)FI.END PROCberechnetestbeizeitdiagramm;BOOL PROCimausgabefenster(ZUSTAND CONSTz,INT CONSTi,REAL CONSTmin,max):((zSUBi)<=max)CAND((zSUBi)>=min)END PROCimausgabefenster;FILE PROCtabelle(KURVE VARkurve,ZUSTAND CONSTmuster,BOOL CONSTmusterzeit):LETtabellenname=" tabelle",fracs=4,spaltenbreite=13,laenge=13,zeitbeschr=76,DARSTELLUNG=STRUCT(INTanzahlkurven,ROWmaxkurvenINTindex);REAL VARzeit,zeitdifferenz;ZUSTAND VARz:=neuerzustand(DSUBmuster);INT VARi:=0;ROWmaxkurvenSTRUCT(TEXTzraum,strich)VARspalte;INT VARspaltenanzahl,spaltenzaehler,punktzaehler:=0;TEXT CONSTtrennstrichfuerleerezeit:=(laenge+1)*" "+"!";waehlekurvenaus;richtedateiein;schreibeueberschrift;verarbeiteerstenpunkt;WHILE NOTendedestabspeichers(kurve)REPverarbeitenaechstenpunktPER;WHILE NOTanzahlmoeglicherpunkteerreichtCANDmusterzeitREPverarbeiteleerezeilePER;lieferedatei.waehlekurvenaus:DARSTELLUNG VARtabelle;tabelle.anzahlkurven:=0;FORiFROM1UPTO(DSUBmuster)REP IF(musterSUBi)=1.0THENtabelle.anzahlkurvenINCR1;tabelle.index(tabelle.anzahlkurven):=i;IFtabelle.anzahlkurven=maxkurvenTHEN LEAVEwaehlekurvenausFI FI PER.
+richtedateiein:IFexists(tabellenname)THENforget(tabellenname,quiet)FI;FILE VARtab:=sequentialfile(output,tabellenname).schreibeueberschrift:bestimmespaltenanzahl;schreibeerstezeile;schreibeunterstreichung.bestimmespaltenanzahl:spaltenanzahl:=tabelle.anzahlkurven+1;setzetabelle.setzetabelle:FORiFROM1UPTOspaltenanzahlREPspalte(i).zraum:="";spalte(i).strich:=" |"PER.schreibeerstezeile:spaltenzaehler:=1;schreibeevtlzeit;FORiFROM1UPTOtabelle.anzahlkurvenREPschreibekoordinatenueberschriftPER;schreibezeileindatei;setzetabelle.schreibeevtlzeit:TEXT VARzeittext:=meldungstext(zeitbeschr);IFlength(zeittext)<laengevarkurzformTHENzeittextCAT((laengevarkurzform-length(zeittext))*" ");ELSEzeittext:=subtext(zeittext,1,laengevarkurzform);FI;spalte(spaltenzaehler).zraum:=((spaltenbreite-laengevarkurzform)*" ")+zeittext;spaltenzaehlerINCR1.schreibekoordinatenueberschrift:TEXT VARbezeichnung;INT VARblankanzahl;IFtabelle.index(i)<=dimensionTHENbezeichnung:=variablenkurzform(tabelle.index(i));ELSEbezeichnung:=covariablenkurzform(tabelle.index(i)-dimension);FI;blankanzahl:=spaltenbreite-length(bezeichnung);spalte(spaltenzaehler).zraum:=((blankanzahlDIV2)*" "+bezeichnung)+(((blankanzahlDIV2)+(blankanzahlMOD2))*" ");spaltenzaehlerINCR1.schreibeunterstreichung:TEXT VARzeile:="",textspalte:="";textspalte:=(laenge+1)*"-"+"+";zeile:=(spaltenzaehler-1)*textspalte;putline(tab,zeile).verarbeiteerstenpunkt:REAL VARzahl;punktzaehlerINCR1;leseerstenbeobachtungspunkt(kurve,zeit,z);schreibepunktinspalten;schreibezeileindatei.schreibepunktinspalten:spaltenzaehler:=1;schreibezeitinspalte;FORiFROM1UPTOtabelle.anzahlkurvenREPschreibekoordinateinspaltePER.schreibezeitinspalte:zahl:=zeit;spalte(spaltenzaehler).zraum:=wandle(zahl,laenge,fracs);spaltenzaehlerINCR1.schreibekoordinateinspalte:zahl:=(zSUBtabelle.index(i));IFergebnisganzzahligTHENzahl:=floor(zSUBtabelle.index(i))ELSEzahl:=zSUBtabelle.index(i)FI;spalte(spaltenzaehler).zraum:=wandle(zahl,laenge,fracs);spaltenzaehlerINCR1.schreibezeileindatei:zeile:="";FORiFROM1UPTOspaltenanzahlREPzeileCATspalte(i).zraum;zeileCATspalte(i).strichPER;putline(tab,zeile).verarbeitenaechstenpunkt:lesenaechstenbeobachtungspunkt(kurve,zeit,z);punktzaehlerINCR1;IFpunktzaehler=2THENzeitdifferenz:=zeit;FI;schreibepunktinspalten;schreibezeileindatei.lieferedatei:tab.anzahlmoeglicherpunkteerreicht:punktzaehler>=normaleanzahlvonausgegebenenpunkten.verarbeiteleerezeile:IFzeitdifferenz=0.0THENspalte(1).zraum:=trennstrichfuerleerezeit;ELSEzeit:=real(punktzaehler)*zeitdifferenz;spalte(1).zraum:=wandle(zeit,laenge,fracs);FI;putline(tab,spalte(1).zraum);punktzaehlerINCR1;.ENDPROCtabelle;END PACKETcoroutinenundco;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls dateiscroll b/app/schulis-simulationssystem/3.0/src/ls dateiscroll
new file mode 100644
index 0000000..fa923cf
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls dateiscroll
@@ -0,0 +1,5 @@
+PACKETlsscrollDEFINESscroll,grossesrahmenfenster,tabellenfensteroben,tabellenfensterunten,scrollfenster:LETniltext="",bell="�",left="�",right="�",runter="
+",hoch="�",hop="�",esc="�";PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):FILE VARf:=sequentialfile(input,datname);scroll(w,f,xscroll,yscroll,horizontalscroll,erstersatz,erstespalte,sonderzeichen,ausstiegzeichen)END PROCscroll;PROCscroll(WINDOW VARw,FILE VARf,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;input(f);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:IFhorizontalscroll>1THENmaxspalten-horizontalscroll+2ELSEmaxspalten-ausgabebreiteEND IF.zeigedateiausschnitt:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginn;FORiFROM1UPTOyscroll-1REPtoline(f,i);readrecord(f,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginn+yscroll-1END IF;i:=erstersatz;REPtoline(f,i);readrecord(f,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginn>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENscrollerechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENscrollevorEND IF ELIFch=hopTHENinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENblaettererechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENblaetterevorEND IF ELSEout(bell)END IF ELIFch=escTHENinchar(ausstiegzeichen);IFausstiegzeichen="1"CANDerstersatz>yscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz<letzterzeilenanfangTHENspringeandasendeELIFpos(sonderzeichen,ausstiegzeichen)<>0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min(
+erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCscroll(WINDOW VARwo,wu,TEXT CONSTdatnameo,datnameu,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatzo,erstespalte,erstersatzu,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnittoben;zeigedateiausschnittunten;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARfo:=sequentialfile(input,datnameo),fu:=sequentialfile(input,datnameu);INT VARmaxspalten:=0,maxzeileno:=lines(fo),maxzeilenu:=lines(fu);WHILE NOTeof(fo)REPgetline(fo,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(wo),laenge:=areaysize(wo),xbeginn:=areax(wo),ybeginno:=areay(wo),ybeginnu:=areay(wu),letzterzeilenanfango:=maxzeileno-laenge+yscroll,letzterzeilenanfangu:=maxzeilenu-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(fo);modify(fu);.jenachdem:IFhorizontalscroll>1THENmaxspalten-horizontalscroll+2ELSEmaxspalten-ausgabebreiteEND IF.zeigedateiausschnittoben:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginno;FORiFROM1UPTOyscroll-1REPtoline(fo,i);readrecord(fo,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginno+yscroll-1END IF;i:=erstersatzo;REPtoline(fo,i);readrecord(fo,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginno>laenge-1END REP.zeigedateiausschnittunten:IFveraenderungderkopfzeilenTHENypos:=ybeginnu;FORiFROM1UPTOyscroll-1REPtoline(fu,i);readrecord(fu,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginnu+yscroll-1END IF;i:=erstersatzu;REPtoline(fu,i);readrecord(fu,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginnu>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENscrollerechtsEND IF ELIFch=hochTHEN IFerstersatzo>yscrollCORerstersatzu>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatzo<letzterzeilenanfangoCORerstersatzu<letzterzeilenanfanguTHENscrollevorEND IF ELIFch=hopTHENinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENblaettererechtsEND IF ELIFch=hochTHEN IFerstersatzo>yscrollORerstersatzu>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatzo<letzterzeilenanfangoORerstersatzu<letzterzeilenanfanguTHENblaetterevorEND IF ELSEout(bell)END IF ELIFch=escTHENinchar(ausstiegzeichen);IFausstiegzeichen="1"CAND(erstersatzo>yscrollORerstersatzu>yscroll)THENspringeandenanfangELIFausstiegzeichen="9"CAND(erstersatzo<letzterzeilenanfangoORerstersatzu<letzterzeilenanfangu)THENspringeandasendeELIFpos(sonderzeichen,ausstiegzeichen)<>0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);
+veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:IFerstersatzo>yscrollTHENerstersatzoDECR1;FI;IFerstersatzu>yscrollTHENerstersatzuDECR1;FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:IFerstersatzo<letzterzeilenanfangoTHENerstersatzoINCR1;FI;IFerstersatzu<letzterzeilenanfanguTHENerstersatzuINCR1;FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:IFerstersatzo>yscrollTHENerstersatzoDECRausgabelaenge;erstersatzo:=max(erstersatzo,yscroll);FI;IFerstersatzu>yscrollTHENerstersatzuDECRausgabelaenge;erstersatzu:=max(erstersatzu,yscroll);FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:IFerstersatzo<letzterzeilenanfangoTHENerstersatzoINCRausgabelaenge;erstersatzo:=min(erstersatzo,letzterzeilenanfango);FI;IFerstersatzu<letzterzeilenanfanguTHENerstersatzuINCRausgabelaenge;erstersatzu:=min(erstersatzu,letzterzeilenanfangu);FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:IF(erstersatzo>yscroll)THENerstersatzo:=yscroll;FI;IF(erstersatzu>yscroll)THENerstersatzu:=yscroll;FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:IFerstersatzo<letzterzeilenanfangoTHENerstersatzo:=max(yscroll,letzterzeilenanfango);FI;IFerstersatzu<letzterzeilenanfanguTHENerstersatzu:=max(yscroll,letzterzeilenanfangu);FI;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.END PROCscroll;WINDOW PROCgrossesrahmenfenster:WINDOW VARfsingle:=window(2,5,77,17);fsingle.END PROCgrossesrahmenfenster;WINDOW PROCscrollfenster:WINDOW VARfshow:=window(4,5,74,17);fshow.END PROCscrollfenster;WINDOW PROCtabellenfensteroben:WINDOW VARw1:=window(2,5,76,8);w1.END PROCtabellenfensteroben;WINDOW PROCtabellenfensterunten:WINDOW VARw2:=window(2,15,76,8);w2.END PROCtabellenfensterunten;END PACKETlsscroll;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls demonstration b/app/schulis-simulationssystem/3.0/src/ls demonstration
new file mode 100644
index 0000000..a23b3a6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls demonstration
@@ -0,0 +1,4 @@
+PACKETdemonstrationDEFINESdemonstration:LETfalschetaste=13,auskdiagrammarten=1,auskdiagrammartenohnephasendiagr=3,auskunftzusatzdarst=25,auskletzteseite=27,weiter="w",sendetaste="",blaettern="b",blaetternoben="o",blaetternunten="u",abbrechen="a",stvergleichzeit=2,stinfo=3,stmodellgroessen=7,stkombinationzeitphasen=8,stkombinationzeittabelle=13,stgraphik=20,stvergleichphasen=32,stmitbeliebigertaste=35,zeilenbreite=76,spaltenbreite=0,scrollsp1=1,scrollzeile=1,scrollzeile1tab=3,scrollsp1tab=16,scrollbreitetab=15;TEXT CONSTscrollausstiegohnedrucken:="aw";LEToutputmodellgroessen="output modellgroessen",outputaus="output aus",outputinfo="output info",dateimitinfo="temporaer",dateimodellwerte=" modellwerte",erzeugtetabelle=" tabelle",dateitab=" tabelle.p",dateimitwerten="teiltextname",outputausdiagr="output aus diagr";LETstrukt1fenster=1,strukt2diagramme1text=3,strukt4fenster=4,strukttabelleunten=5,fensterdummy=0,fensterganz=1,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8;LET MODELLAUF=STRUCT(LOESUNGoriginal,fortsetzung,vergleich);KURVE VARhilfskurve;OUTPUT VARausdiagr;WINDOW VARfshow;PROCdemonstration(PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)darst4):TEXT VARtaste:="";TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1;TEXT CONSTausstiegszeichen:=abbrechen+weiter;LOESUNG VARloesung;loesung:=originalwerte;BOOL VARindemo:=TRUE;FILE VARmdlinfo;enablestop;REPkernvondemonstration;PER.kernvondemonstration:initialisieren;zeigemodellgroessen;IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENinformationFI;.leavedemonstration:forgetdemooutput;plotend;LEAVEdemonstration.initialisieren:MODELLAUF VARmodellauf;modellauf.original:=originalwerte;modellauf.vergleich:=vergleichswerte.zeigemodellgroessen:fshow:=window(2,3,76,20);mdlinfo:=modellwerteausgeben(modellauf.original);page;cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(14),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stmodellgroessen));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimodellwerte,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);.information:plotend;fshow:=scrollfenster;cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(15),modellkurzbezeichnung,zeilenbreite)));IFcodimension+dimension>1CANDmitphasendiagrammTHENmdlinfo:=auskunftindatei(auskdiagrammarten);ELSEmdlinfo:=auskunftindatei(auskdiagrammartenohnephasendiagr)FI;footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigezeitdiagrammFI.zeigezeitdiagramm:zeitdiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigehistogrammELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.zeitdiagrammausgeben:ausdiagr:=niloutput(strukt1fenster,outputausdiagr);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,16,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinedummy);.zeigehistogramm:histogrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHEN IFcodimension+dimension>1CANDmitphasendiagrammTHENzeigephasendiagrammELSEzeigetabelleFI ELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.histogrammausgeben:ausdiagr:=niloutput(strukt1fenster,outputausdiagr);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,27,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinehisto,PROCcoroutinedummy).zeigephasendiagramm:phasendiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigetabelleELSEgibmeldungaus(falschetaste)FI PER.phasendiagrammausgeben:ausdiagr:=niloutput(strukt1fenster,
+outputausdiagr);ZUSTAND VARdemomusterphase:=neuerzustand(dimension+codimension);hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;replace(demomusterphase,demoxindex,1.0);IFdemoautomatikTHENreplace(demomusterphase,demoyindex,1.0)ELSEreplace(demomusterphase,demoyindex,2.0)FI;steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomusterphase,neuerzustand(dimension+codimension),fensterganz,fensterdummy,17,stgraphik,sendetaste,weiter+abbrechen,taste,PROCcoroutinephase,PROCcoroutinedummy).zeigetabelle:tabelleausgeben;IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENinformation2FI.tabelleausgeben:WINDOW VARtabwindow:=grossesrahmenfenster;plotend;hilfskurve:=LOESUNGSABSCHNITTmodellauf.original;mdlinfo:=tabelle(hilfskurve,demomuster,TRUE);forget(dateitab,quiet);rename(erzeugtetabelle,dateitab);outframe(tabwindow);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(18),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stmodellgroessen));erstersatz1:=scrollzeile1tab;erstespalte1:=scrollsp1tab;scroll(tabwindow,dateitab,scrollsp1tab,scrollzeile1tab,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegohnedrucken,taste);erase(tabwindow);.information2:plotend;IFcodimension+dimension>1CANDmitphasendiagrammTHENmdlinfo:=auskunftindatei(2)ELSEmdlinfo:=auskunftindatei(4);FI;cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigekombiniertedarstellungFI.zeigekombiniertedarstellung:kombiniertedarstellungausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigevergleichskurveELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.kombiniertedarstellungausgeben:IFcodimension+dimension>1CANDmitphasendiagrammTHENausdiagr:=niloutput(strukt2diagramme1text,outputausdiagr);replace(ausdiagr,fensterrechts,modellwerteausgeben(modellauf.original));steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,demomusterphase,fensterlinksoben,fensterlinksunten,19,stkombinationzeitphasen,sendetaste+blaettern,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinephase)ELSEausdiagr:=niloutput(strukttabelleunten,outputausdiagr);replace(ausdiagr,fensterunten,tabelle(hilfskurve,demomuster,TRUE));replace(ausdiagr,fensterrechtsoben,modellwerteausgeben(modellauf.original));steuerprozessfuereineloesung(ausdiagr,hilfskurve,demomuster,neuerzustand(dimension+codimension),fensterlinksoben,fensterlinksunten,19,stkombinationzeittabelle,sendetaste+blaetternoben+blaetternunten,weiter+abbrechen,taste,PROCcoroutinezeit,PROCcoroutinedummy)FI.zeigevergleichskurve:vergleichskurveausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterCANDmitphasendiagrammCAND(dimension+codimension>1)THENzeigevergleichskurveimphasendiagrammELIFtaste=weiterCANDmitzusatzdarstellungTHENinformation3ELIFtaste=weiterTHENzeigeletzteseiteELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.vergleichskurveausgeben:ausdiagr:=niloutput(strukt4fenster,outputausdiagr);KURVE VARkurve1,kurve2;replace(ausdiagr,fensterrechtsoben,modellwerteausgeben(modellauf.original));replace(ausdiagr,fensterrechtsunten,modellwerteausgeben(modellauf.vergleich));kurve2:=LOESUNGSABSCHNITTmodellauf.vergleich;kurve1:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuerzweiloesungen(ausdiagr,kurve1,kurve2,demomuster,fensterlinksoben,fensterlinksunten,20,stvergleichzeit,sendetaste+blaetternoben+blaetternunten,weiter+abbrechen,taste,PROCcoroutinezeit,PROCkreuzzeitvergleich).zeigevergleichskurveimphasendiagramm:vergleichskurveimphasendiagrammausgeben;REP IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterCANDmitzusatzdarstellungTHENinformation3ELIFtaste=weiterTHENzeigeletzteseiteELSEgibmeldungaus(falschetaste);tastelesen(taste);FI PER.vergleichskurveimphasendiagrammausgeben:ausdiagr:=niloutput(strukt1fenster,
+outputausdiagr);kurve2:=LOESUNGSABSCHNITTmodellauf.vergleich;kurve1:=LOESUNGSABSCHNITTmodellauf.original;steuerprozessfuerzweiloesungen(ausdiagr,kurve1,kurve2,demomusterphase,fensterganz,fensterganz,20,stvergleichphasen,sendetaste,weiter+abbrechen,taste,PROCcoroutinephase,PROCkreuzphasevergleich);.information3:plotend;mdlinfo:=auskunftindatei(auskunftzusatzdarst);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stinfo));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,taste);IFtaste=abbrechenTHENleavedemonstrationELSEzeigezusatzdarstFI.zeigezusatzdarst:darst4(loesung,indemo,taste);IFtaste=abbrechenTHENleavedemonstrationELIFtaste=weiterTHENzeigeletzteseiteFI;.zeigeletzteseite:plotend;mdlinfo:=auskunftindatei(auskletzteseite);cursor(1,1);out(invers(kopfzeilezusammenstellen(kopfzeile(13),modellkurzbezeichnung,zeilenbreite)));footnote(steuerleiste(stmitbeliebigertaste));erstersatz1:=scrollzeile;erstespalte1:=scrollsp1;scroll(fshow,dateimitinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,"",taste);inchar(taste);leavedemonstration.END PROCdemonstration;PROCforgetdemooutput:forget(dateimitwerten,quiet);forget(dateimitinfo,quiet);forget(outputmodellgroessen,quiet);forget(outputaus,quiet);forget(outputinfo,quiet);forget(outputausdiagr,quiet);forget(dateitab,quiet);forget(dateimodellwerte,quiet);forget(erzeugtetabelle,quiet);END PROCforgetdemooutput;END PACKETdemonstration;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls dialoghilfen b/app/schulis-simulationssystem/3.0/src/ls dialoghilfen
new file mode 100644
index 0000000..086d78d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls dialoghilfen
@@ -0,0 +1,9 @@
+PACKETlsdialoghilfenDEFINESreturn,gibmeldungaus,meldungaufbildschirm,zeigeauskunft,auskunftindatei,texteankoppeln,meldungstext,auskunftstext,kopfzeile,steuerleiste,loescheaktuellemeldung,zeigemeldung:LETdatenraumnamed="TEXTE deutsch",maxsize=100,editorfenster=79,eol=""254"",stop=""223"",simseltask="ls-MENUKARTEN",error=1110,sendetexte=1119,umbruch=""223"",untenletztezeile=22,dateiname="temporaer";LETnegmldzeile1mbankdialog=17,negmldzeile1simuldialog=16,posmldzeile1=20,zeilenlaengemld=75,simulationsmenu=1;INITFLAG VARinthistask:=FALSE;LET DIRFILE=STRUCT ( ROWmaxsizeTEXTmeldung,ROWmaxsizeTEXTauskunft,ROWmaxsizeTEXTueberschrift,ROWmaxsizeTEXTleiste,ROWmaxsizeTEXTmenuezeile);BOUND DIRFILE VARtexte;BOOL VARmeldunggezeigt::FALSE;AREA VARallgmld;fill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);PROCtexteankoppeln:IF NOTinitialized(inthistask)THEN TEXT VARtextdatenraum:=sprachversionbestimmen;IF NOTexists(textdatenraum)THEN IF NOTexists(textdatenraum,/simseltask)THENerrorstop("TEXTE fehlen!")ELSEfetch(textdatenraum,/simseltask);kopplean;FI;ELSEkopplean;FI;FI;.sprachversionbestimmen:datenraumnamed.kopplean:DATASPACE VARtextds:=old(textdatenraum);texte:=textds;forget(textdatenraum,quiet);END PROCtexteankoppeln;TEXT PROCmeldungstext(INT CONSTindex):texte.meldung(index)END PROCmeldungstext;TEXT PROCauskunftstext(INT CONSTindex):texte.auskunft(index)END PROCauskunftstext;TEXT PROCsteuerleiste(INT CONSTindex):texte.leiste(index)END PROCsteuerleiste;TEXT PROCkopfzeile(INT CONSTindex):texte.ueberschrift(index)END PROCkopfzeile;TEXT PROCmenuezeile(INT CONSTindex):texte.menuezeile(index)END PROCmenuezeile;PROCgibmeldungaus(INT CONSTmeldungsnr):gibmeldungaus(meldungstext(meldungsnr));END PROCgibmeldungaus;PROCgibmeldungaus(TEXT CONSTmeldungstxt):TEXT VARtxt:=meldungstxt;INT CONSTgrenzelinks:=4,grenzerechts:=79;loeschealtemeldung;IFcompress(meldungstxt)<>""THENschreibemeldungFI.loeschealtemeldung:textout(grenzelinks,untenletztezeile-1,(grenzerechts-grenzelinks+1)*" ");textout(grenzelinks,untenletztezeile,(grenzerechts-grenzelinks+1)*" ");.schreibemeldung:IFeinezeileTHENgibinvorletzterzeileausELSEgibinvorvorletzterzeileausFI;.einezeile:length(txt)<=(grenzerechts-grenzelinks)CANDkeineumbruchstelle.gibinvorletzterzeileaus:textout(grenzelinks,untenletztezeile,txt).gibinvorvorletzterzeileaus:textout(grenzelinks,untenletztezeile-1,subtext(txt,1,pos(txt,umbruch)-1));txt:=subtext(txt,pos(txt,umbruch)+1);textout(grenzelinks,untenletztezeile,subtext(txt,1,grenzerechts-grenzelinks+1)).keineumbruchstelle:pos(txt,umbruch)=0.END PROCgibmeldungaus;PROCmeldungaufbildschirm(BOOL CONSTausgegeben):IFausgegebenTHENmeldunggezeigt:=TRUE ELSEmeldunggezeigt:=FALSE FI;END PROCmeldungaufbildschirm;BOOL PROCmeldungaufbildschirm:meldunggezeigt.END PROCmeldungaufbildschirm;PROCzeigeauskunft(TEXT CONSTatext,INT CONSTvonzeile,biszeile,abspalte):TEXT CONSTleerzeile:=75*" ";INT VARi,i1:=vonzeile,i2:=75;INT CONSTlaenge:=length(atext);WHILEi2<=laengeREPsubstringausgebenUNTILi1>biszeilePER;FORiFROMi1UPTObiszeileREPleerzeileausgebenPER.substringausgeben:textout(abspalte,i1,subtext(atext,i2-75+1,i2));i2INCR75;i1INCR1.leerzeileausgeben:cursor(abspalte,i);out(leerzeile).END PROCzeigeauskunft;FILE PROCauskunftindatei(INT CONSTauskunftsnr):IFexists(dateiname)THENforget(dateiname,quiet)FI;TEXT CONSTte:=auskunftstext(auskunftsnr);FILE VARdat:=sequentialfile(output,dateiname);INT VARbottom:=1,top:=1;TEXT VARzeile,auskunft:=te;INT VARl:=length(auskunft);formatierezeile;REPschreibe;formatierezeile;UNTILzeile=""PER;dat.formatierezeile:zeile:="";IFbottom>=lTHENzeile:=""ELSEtop:=min(bottom+editorfenster-1,l);zeile:=subtext(auskunft,bottom,top,eol,stop,FALSE);topINCR1;bottom:=topFI.schreibe:putline(dat,zeile).END PROCauskunftindatei;TEXT PROCsubtext(TEXT VARauskunft,INT CONSTbottom,INT VARtop,TEXT CONSTloe,TEXT CONSTstp,BOOL CONSTinfenster):LETb=" ";TEXT VARoberster;INT VARlastblank;INT VARi;TEXT
+VARt,vergleich;konstruieret;t.konstruieret:FORiFROMbottomUPTOtopREPvergleich:=subtext(auskunft,i,i);IF vergleich=loeTHEN IF NOTinfensterTHENt:=subtext(auskunft,bottom,i-1);top:=i;LEAVEkonstruieretFI;replace(auskunft,i,b);lastblank:=iELIFvergleich=stpTHENt:=subtext(auskunft,bottom,i-1);IF NOTinfensterTHENt:=t+bFI;top:=i;LEAVEkonstruieretELIFvergleich=bTHENlastblank:=iFI;PER;oberster:=subtext(auskunft,top+1,top+1);IF(lastblank<>top)CAND((oberster<>b)CAND(oberster<>loe)CAND(oberster<>stp))THENtop:=lastblankFI;t:=subtext(auskunft,bottom,top).END PROCsubtext;PROCtextout(INT CONSTsp,z,TEXT CONSTausg):cursor(sp,z);out(ausg);END PROCtextout;TEXT PROCreturn:code(13).END PROCreturn;PROCzeigemeldung(TEXT CONSTmld,BOOL CONSTposmeldung,INT CONSTdialogsituation):TEXT VARt1:="";IFposmeldungTHENfill(allgmld,3,posmldzeile1,zeilenlaengemld,3);ELIFdialogsituation=simulationsmenuTHENfill(allgmld,3,negmldzeile1simuldialog,zeilenlaengemld,3);ELSEfill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);FI;pageup(allgmld);outframe(areax(allgmld),areay(allgmld),areaxsize(allgmld),areaysize(allgmld));t1:=invers(center(areaxsize(allgmld)-5,mld));out(allgmld,2,2,t1);.END PROCzeigemeldung;PROCzeigemeldung(TEXT CONSTmld,BOOL CONSTposmeldung):zeigemeldung(mld,posmeldung,simulationsmenu);END PROCzeigemeldung;PROCloescheaktuellemeldung(INT CONSTdialogsituation):IFdialogsituation=simulationsmenuTHENfill(allgmld,3,negmldzeile1simuldialog,zeilenlaengemld,3);ELSEfill(allgmld,3,negmldzeile1mbankdialog,zeilenlaengemld,3);FI;pageup(allgmld);END PROCloescheaktuellemeldung;PROCloescheaktuellemeldung:pageup(allgmld);END PROCloescheaktuellemeldung;END PACKETlsdialoghilfen;
+
+
+
+
+
+
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls dp1 b/app/schulis-simulationssystem/3.0/src/ls dp1
new file mode 100644
index 0000000..6c82b94
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls dp1
@@ -0,0 +1,4 @@
+PACKETdiagrammpraesentation1DEFINESgibbildaus,transformierewirkungsdiagrammundstartesimulation,modellinfo:LETbitteumgeduld=576,prozedurdeklarationfuerdgl=616,realconst=602,parameter=604,dquotientdeklaration=605,replacefuerzustand=606,dquotientliefern=607,prozedurfussfuerdgl=617,prozedurdeklarationfueregl=618,prozedurfussfueregl=619,prozedurkopfzusatzdarst=620,prozedurfusszusatzdarst=621,evektor=611,replacefuerergebnis=612,evektorliefern=613,startwert=614,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,pluralformel=538,simulationneustarten=10,terminaltaskname="ARBEITSPLATZ";LETnull="0.0",maxlink=8,standardkanal=1;PROCgibbildaus:INT VARi,j,k,starti:=impos(gitterstart),endi:=starti+igittersize-1,startj:=jmpos(gitterstart),endj:=startj+jgittersize-1;initialisierezeichenflaeche;zeichnealleboxen;zeichnealleverbindungen.initialisierezeichenflaeche:page(area(standardfenster));bsspeicherinit.zeichnealleboxen:FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)THENbox(i,j)FI PER PER.zeichnealleverbindungen:FORiFROMstartiUPTOendiREP FORjFROMstartjUPTOendjREP IFbelegt(actualcell)THENbearbeiteausgehendeundankommendelinien;FI PER PER.actualcell:cell(i,j).bearbeiteausgehendeundankommendelinien:FORkFROM1UPTOmaxlinkREP IFactualcellAUSGANGkTHENausgehendelinie;ELIFeineliniekommtanANDliniekommtvonaussenTHENvonaussenankommendelinieFI PER.ausgehendelinie:zeichneverbindung(mpos(actualcell),k,actualcellUEBERk,actualcellNRk).vonaussenankommendelinie:zeichneverbindung(actualcellUEBERk,actualcellNRk,mpos(actualcell),k).eineliniekommtan:actualcellEINGANGk.liniekommtvonaussen:NOTimgitter(actualcellUEBERk).END PROCgibbildaus;PROCmodellinfo(FILE VARf):allevariablen;alleergaenzungsvariablen;alleparameter;alleformeln.allevariablen:IFanzahlmpos(variablenthesaurus)=1THENputline(f,anwendungstext(singularmodellgroesse)+":");line(f);objekttexte(f,variablenthesaurus)ELIFanzahlmpos(variablenthesaurus)>1THENputline(f,anwendungstext(singularmodellgroesse)+"n:");line(f);objekttexte(f,variablenthesaurus)FI.alleergaenzungsvariablen:IFanzahlmpos(ergebnisthesaurus)=1THENputline(f,anwendungstext(singularergebnis)+":");line(f);objekttexte(f,ergebnisthesaurus);line(f)ELIFanzahlmpos(ergebnisthesaurus)>1THENputline(f,anwendungstext(singularergebnis)+"n:");line(f);objekttexte(f,ergebnisthesaurus);line(f)FI.alleparameter:IFanzahlmpos(parameterthesaurus)>0THENputline(f,anwendungstext(singularparameter)+":");line(f);objekttexte(f,parameterthesaurus);line(f)FI.alleformeln:IFanzahlmpos(formelthesaurus)=1THENputline(f,anwendungstext(singularformel)+":");line(f);objekttexte(f,formelthesaurus);line(f)ELIFanzahlmpos(formelthesaurus)>1THENputline(f,anwendungstext(pluralformel)+":");line(f);objekttexte(f,formelthesaurus);line(f)FI.END PROCmodellinfo;PROCobjekttexte(FILE VARf,THESAURUS CONSTt):INT VARi:=0;MPOS VARmp;WHILEi<highestentry(t)REPgetmpos(t,mp,i);objekttext(f,mp)PER END PROCobjekttexte;FILE VARq;MPOS VARmp;INT VARdimensiondesmodells,codimensiondesmodells;PROCtransformierewirkungsdiagrammundstartesimulation(BOOL CONSTls,INT VARreturncode):DATASPACE VARmodellds,codeds;BOUND MODELLDGL VARtemporaeresmodell;INT VARinternerretcode:=0;schreibehinweis;initmodellds;initmodell;fuelletemporaeresmodell;versendemodellundstartesimulation(modellds,codeds,ls,internerretcode);IFiserrorTHENclearerror;returncode:=1ELSEreturncode:=internerretcode;FI.schreibehinweis:IF NOTlsTHENdoublefootnote(anwendungstext(bitteumgeduld))ELSEfootnote(anwendungstext(bitteumgeduld))FI.initmodellds:forget(modellds);modellds:=nilspace;.initmodell:temporaeresmodell:=modellds;nilmodell(temporaeresmodell).fuelletemporaeresmodell:erzeugequelltext(codeds);vthesaurus;ethesaurus;pthesaurus;modellmitdatenfuellen(temporaeresmodell,vnamenlang,vnamenkurz,enamenlang,enamenkurz,pnamen).vthesaurus:THESAURUS VARvnamenlang:=emptythesaurus,vnamenkurz:=emptythesaurus;INT VARi:=0;MPOS VARmp;WHILEi<highestentry(variablenthesaurus)REPgetmpos(variablenthesaurus,mp,i);insert(
+vnamenlang,langname(objekt(mp)));insert(vnamenkurz,kurzname(objekt(mp)))PER.ethesaurus:THESAURUS VARenamenlang:=emptythesaurus,enamenkurz:=emptythesaurus;i:=0;WHILEi<highestentry(ergebnisthesaurus)REPgetmpos(ergebnisthesaurus,mp,i);insert(enamenlang,langname(objekt(mp)));insert(enamenkurz,kurzname(objekt(mp)))PER.pthesaurus:THESAURUS VARpnamen:=emptythesaurus;i:=0;WHILEi<highestentry(parameterthesaurus)REPgetmpos(parameterthesaurus,mp,i);insert(pnamen,langname(objekt(mp)))PER.END PROCtransformierewirkungsdiagrammundstartesimulation;LETbtsimulationnichtmoeglichbittetaste=64,btwartenallgemein=44,btmodell=106;INT CONSTexistiertnicht:=-1,nichtempfangsbereit:=-2;PROCversendemodellundstartesimulation(DATASPACE VARmodellds,codeds,BOOL CONSTls,INT VARretcode):retcode:=0;TEXT VARo:="";DATASPACE VARtransportdsp,infodsp:=nilspace;disablestop;REPmodellbearbeiten;UNTILordnungsgemaessbeendetodertasknichtempfangsbereitPER;IFokTHEN ELSE IF NOTlsTHENpage;doublefootnote(anwendungstext(btsimulationnichtmoeglichbittetaste));clearbuffer;inchar(o);ELSE FI FI;forget(codeds);forget(modellds);.ok:retcode=0.ordnungsgemaessbeendetodertasknichtempfangsbereit:retcode<>simulationneustarten.bereiteinformationstextvor:FILE VARinfofile:=sequentialfile(output,infodsp);putline(infofile,anwendungstext(btmodell)+aktuellermodellname);putline(infofile,length(anwendungstext(btmodell)+aktuellermodellname)*"=");line(infofile);modellinfo(infofile);.modellbearbeiten:IFretcode=simulationneustartenTHENpage;footnote(anwendungstext(btwartenallgemein));FI;bereiteinformationstextvor;retcode:=0;schickemodelldaten;IFokTHENschickemodellinfos;IFokTHENstartesimulationFI;FI;forget(infodsp);continue(standardkanal);.schickemodelldaten:transportdsp:=modellds;schickezumanager(transportdsp,2,retcode);forget(transportdsp);.schickemodellinfos:transportdsp:=infodsp;schickezumanager(transportdsp,7,retcode);forget(transportdsp);.startesimulation:transportdsp:=codeds;break(quiet);schickezumanager(transportdsp,9,retcode);forget(transportdsp);.END PROCversendemodellundstartesimulation;PROCschickezumanager(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARmesscode):INT CONSTeingabevomkanal:=-4;TASK VARmanagertask:=/terminaltaskname,kontrolltask:=/terminaltaskname;enablestop;REPkernvonschickezumanagerPER.kernvonschickezumanager:managertask:=kontrolltask;send(managertask,verarbeitung,datenraum,messcode);forget(datenraum);REP IFmesscode=existiertnichtTHENleaveschickezumanager;ELIFmesscode=nichtempfangsbereitTHENleaveschickezumanager;ELSEwarteaufquittungFI PER.warteaufquittung:managertask:=/terminaltaskname;wait(datenraum,messcode,managertask);forget(datenraum);IFquerschlaegersendungTHEN IFcontinueversuchTHENleaveschickezumanager;ELSE IFmesscode=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(datenraum);FI;FI ELSEleaveschickezumanager;FI.querschlaegersendung:NOT(managertask=kontrolltask).continueversuch:managertask=supervisorAND((task(messcodeMOD100)=niltask)OR(task(messcodeMOD100)=myself)).leaveschickezumanager:LEAVEschickezumanager;END PROCschickezumanager;PROCerzeugequelltext(DATASPACE VARds):ds:=nilspace;q:=sequentialfile(output,ds);erzeugedgl;erzeugeegl;erzeugepseudozusatzdarstellung;END PROCerzeugequelltext;PROCerzeugedgl:dimensiondesmodells:=anzahlvariablen;schreibeprozedurkopffuerdgl;schreibeprozedurrumpffuerdgl;schreibeprozedurfussfuerdgl;.schreibeprozedurkopffuerdgl:putline(q,anwendungstext(prozedurdeklarationfuerdgl)).schreibeprozedurrumpffuerdgl:deklariereundinitialisierestartwerte;deklariereundinitialisiereparameter;berechnedifferentialquotienten;listerefinementsfuerformeln.schreibeprozedurfussfuerdgl:putline(q,anwendungstext(prozedurfussfuerdgl)).berechnedifferentialquotienten:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(dquotientdeklaration)+text(dimensiondesmodells)+");";;putline(q,zeile);WHILEi<highestentry(variablenthesaurus)REPjINCR1;getmpos(variablenthesaurus,mp,i);zeile:=replacestatement+text(j)+","+summedereinlaufendenpfeile+");";putline(q,zeile);PER;putline(q,
+ergebniszeile);.replacestatement:anwendungstext(replacefuerzustand).ergebniszeile:anwendungstext(dquotientliefern).END PROCerzeugedgl;PROCerzeugeegl:codimensiondesmodells:=anzahlergaenzungsvariablen;schreibeprozedurkopffueregl;schreibeprozedurrumpffueregl;schreibeprozedurfussfueregl.schreibeprozedurkopffueregl:putline(q,anwendungstext(prozedurdeklarationfueregl)).schreibeprozedurrumpffueregl:deklariereundinitialisierestartwerte;deklariereundinitialisiereparameter;deklariereundberechneergebnisse;listerefinementsfuerformeln.schreibeprozedurfussfueregl:putline(q,anwendungstext(prozedurfussfueregl)).deklariereundberechneergebnisse:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(evektor)+text(codimensiondesmodells)+");";putline(q,zeile);WHILEi<highestentry(ergebnisthesaurus)REPjINCR1;getmpos(ergebnisthesaurus,mp,i);zeile:=replacestatement+text(j)+","+summedereinlaufendenpfeile+");";putline(q,zeile);PER;putline(q,ergebniszeile);.replacestatement:anwendungstext(replacefuerergebnis).ergebniszeile:anwendungstext(evektorliefern).END PROCerzeugeegl;PROCerzeugepseudozusatzdarstellung:putline(q,anwendungstext(prozedurkopfzusatzdarst));putline(q,anwendungstext(prozedurfusszusatzdarst))END PROCerzeugepseudozusatzdarstellung;PROCdeklariereundinitialisierestartwerte:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(realconst);WHILEi<highestentry(variablenthesaurus)REPjINCR1;getmpos(variablenthesaurus,mp,i);zeileCATelanname(objekt(mp));zeileCAT"::";zeileCAT(anwendungstext(startwert)+"SUB"+text(j)+",")PER;IFvariablenvorhandenTHENreplace(zeile,LENGTHzeile,";");putline(q,zeile)FI.variablenvorhanden:j>0.END PROCdeklariereundinitialisierestartwerte;PROCdeklariereundinitialisiereparameter:INT VARi:=0,j:=0;TEXT VARzeile:=anwendungstext(realconst);WHILEi<highestentry(parameterthesaurus)REPjINCR1;getmpos(parameterthesaurus,mp,i);zeileCATelanname(objekt(mp));zeileCAT"::";zeileCAT(anwendungstext(parameter)+"SUB"+text(j)+",");PER;IFparametervorhandenTHENreplace(zeile,LENGTHzeile,";");putline(q,zeile)FI.parametervorhanden:j>0.END PROCdeklariereundinitialisiereparameter;PROClisterefinementsfuerformeln:INT VARi:=0;WHILEi<highestentry(formelthesaurus)REPgetmpos(formelthesaurus,mp,i);putline(q,elanname(objekt(mp))+":"+ausdruck(objekt(mp))+".")PER END PROClisterefinementsfuerformeln;TEXT PROCsummedereinlaufendenpfeile:INT VARk;TEXT VARsumme:="";FORkFROM1UPTOmaxlinkREP IF(cell(mp)EINGANGk)THENsummeCATelanname(objekt(cell(mp)UEBERk))+"+"FI PER;IFlength(summe)>0THENreplace(summe,length(summe)," ");ELSEsumme:=nullFI;summeEND PROCsummedereinlaufendenpfeile;INT PROCanzahlvariablen:anzahlmpos(variablenthesaurus)END PROCanzahlvariablen;INT PROCanzahlergaenzungsvariablen:anzahlmpos(ergebnisthesaurus)END PROCanzahlergaenzungsvariablen;END PACKETdiagrammpraesentation1;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls kombination b/app/schulis-simulationssystem/3.0/src/ls kombination
new file mode 100644
index 0000000..c2b8162
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls kombination
@@ -0,0 +1,3 @@
+PACKETlskombinationDEFINESzeigekombiniertedarstellung:LETsendetaste="p",abbruchtaste="m",outputkombination=" kombination",blaettern="b",blaetternoben="o",blaetternunten="u",mitzeitdiagramm=1,mitphasen=2,mittabelle=3,mithistogramm=4;LETdruckdateitab=" tabelle.p",erzeugtetabelle=" tabelle",steuerlgraphiktabelle=24,steuerlgraphikgraphik=25,steuerleistetabelle=28,steuerleistewarten=31,scrollsp1=16,scrollzeile1=3,scrollbreitetab=15;TEXT CONSTscrollausstiegohnedrucken:="m"+sendetaste;LETstrukt2diagramme1text=3,strukttabelleunten=5,strukttabelleoben=6,fensterdummy=0,fensteroben=2,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8;TEXT CONSTsendenundblaettern:=sendetaste+blaettern,sendenblaetternobenundunten:=sendetaste+blaetternoben+blaetternunten;INT VARsteuerzeilenschluessel,kopfzeilenschluessel;PROCzeigekombiniertedarstellung(TEXT VARtaste,LOESUNG VARloesung,INT CONSTdarstellung1,INT CONSTdarstellung2,ZUSTAND VARmuster1,muster2):OUTPUT VARbskombination;KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesung;TEXT VARtastenraus:=abbruchtaste;IFdarstellung1=mittabelleTHENzeigekombinationtabelle(taste,loesung,darstellung2,muster1,muster2);ELSEzeigeanderedarstellungenFI;.zeigeanderedarstellungen:IFdarstellung2=mitzeitdiagrammCORdarstellung2=mithistogrammTHENkombinieremitzeitdiagrammoderhistogrammELIF(codimension+dimension>=2)CANDmitphasendiagrammCAND(darstellung2=mitphasen)THENkombinieremitphasendiagrammELIFdarstellung2=mittabelleTHENkombinieremittabelleFI.leavezeigekombiniertedarstellung:forget(outputkombination,quiet);LEAVEzeigekombiniertedarstellung.kombinieremitphasendiagramm:bskombination:=niloutput(strukt2diagramme1text,outputkombination);replace(bskombination,fensterrechts,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphikgraphik;SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinephase)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinephase)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinephase)ENDSELECT.kombinieremittabelle:FILE VARtabaktuell:=tabelle(hilfskurve,muster2,TRUE);bskombination:=niloutput(strukttabelleunten,outputkombination);replace(bskombination,fensterunten,tabaktuell);replace(bskombination,fensterrechtsoben,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,neuerzustand(dimension+codimension),fensterlinksoben,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy)ENDSELECT.kombinieremitzeitdiagrammoderhistogramm:bskombination:=niloutput(strukt2diagramme1text,outputkombination);replace(bskombination,fensterrechts,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphikgraphik;IFdarstellung2=mitzeitdiagrammTHEN SELECTdarstellung1
+OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinezeit)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinezeit)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinezeit)ENDSELECT;ELSE SELECTdarstellung1OF CASE1:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinehisto)CASE2:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinephase,PROCcoroutinehisto)CASE4:steuerprozessfuereineloesung(bskombination,hilfskurve,muster1,muster2,fensterlinksoben,fensterlinksunten,kopfzeilenschluessel,steuerzeilenschluessel,sendenundblaettern,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinehisto)ENDSELECT;FI.END PROCzeigekombiniertedarstellung;PROCzeigekombinationtabelle(TEXT VARtaste,LOESUNG VARloesung,INT CONSTdarstellung2,ZUSTAND VARmuster1,muster2):OUTPUT VARbskombination;KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesung;TEXT CONSTtastenraus:=abbruchtaste;IFdarstellung2=mitzeitdiagrammCORdarstellung2=mithistogrammTHENkombinieremitdiagrammELIF(codimension+dimension>=2)CANDmitphasendiagrammCANDdarstellung2=mitphasenTHENkombinieremitphasendiagrammELIFdarstellung2=mittabelleTHENkombinieremittabelleFI.kombinieremitphasendiagramm:bskombination:=niloutput(strukttabelleoben,outputkombination);replace(bskombination,fensteroben,tabelle(hilfskurve,muster1,TRUE));replace(bskombination,fensterrechtsunten,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;steuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy).kombinieremittabelle:FILE VARtbl:=tabelle(hilfskurve,muster1,TRUE);WINDOW VARtabwindow:=grossesrahmenfenster;INT VARerstersatz1:=3,erstespalte1:=scrollsp1;forget(druckdateitab,quiet);rename(erzeugtetabelle,druckdateitab);outframe(tabwindow);footnote(steuerleiste(steuerleistetabelle));scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegohnedrucken,taste);erase(tabwindow);.kombinieremitdiagramm:bskombination:=niloutput(strukttabelleoben,outputkombination);replace(bskombination,fensteroben,tabelle(hilfskurve,muster1,TRUE));replace(bskombination,fensterrechtsunten,modellwerteausgeben(loesung));kopfzeilenschluessel:=5;steuerzeilenschluessel:=steuerlgraphiktabelle;IFdarstellung2=mitzeitdiagrammTHENsteuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy)ELSEsteuerprozessfuereineloesung(bskombination,hilfskurve,muster2,neuerzustand(dimension+codimension),fensterlinksunten,fensterdummy,kopfzeilenschluessel,steuerzeilenschluessel,sendenblaetternobenundunten,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy)FI.END PROCzeigekombinationtabelle;END PACKETlskombination;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls simsel.masken b/app/schulis-simulationssystem/3.0/src/ls simsel.masken
new file mode 100644
index 0000000..e343284
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls simsel.masken
@@ -0,0 +1,4 @@
+PACKETsimselmaskenDEFINES TAG,:=,nil,tagsankoppeln,formular,show,put,get,putget,leavingcode,fieldexists,cursor,fieldinfos,setfieldinfos:LETbeginmark="",endmark="",chop=1,chome=1,cvor=2,cfeldende=18,crueck=8,cfeldanf=20,choch=3,cfeldrueck=19,crunter=10,ctab=9,csettab=21,ceinf=11,caufbrech=22,causf=12,clearn=26,cfeldvor=13,cloeschende=24,cmark=16,cneu=17,cesc=27,cseiterueck=15,cseitevor=14;LETright="�",left="�",home="�";LETsimseltask="ls-MENUKARTEN",error=1110,sendetags=1120;INITFLAG VARinthistask:=FALSE;TEXT VARabc:="";INT VARi;FORiFROM33UPTO126REPabcCATcode(i);PER;FORiFROM214UPTO222REPabcCATcode(i);PER;abcCATcode(251);LEThoptasten="?aouAOUBb§</>(!)-k'= #",hopcodes="�äöüÄÖÜßßß[\]{|}­k^~ \#";LETtaglines=24,maxfields=100;BOOL VARbeimletztenrausfallen:=FALSE;BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;PROCxoutsubtext(TEXT CONSTwas,INT CONSTvon,bis):out(subtext(was,von,bis))END PROCxoutsubtext;TYPE TAG=STRUCT(TEXTerstel,darst,diainfo,dbnam,ausknam,feld,x,y,len,tab,ROWtaglinesTEXTformblatt,INTxmax,ymax,xs,ys,dbp,ver,durchs,art);OP:=(TAG VARa,TAG CONSTb):CONCR(a):=CONCR(b)END OP:=;PROCnil(TAG VARt):t.formblatt:=ROWtaglinesTEXT:("","","","","","","","","","","","","","","","","","","","","","","","");t.xmax:=0;t.ymax:=0;t.xs:=1;t.ys:=1;t.dbp:=0;t.ver:=1;t.durchs:=0;t.art:=0;t.darst:="";t.erstel:="";t.diainfo:="";t.dbnam:="";t.ausknam:="";t.feld:="";t.x:="";t.y:="";t.tab:="";t.len:="";END PROCnil;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE FI.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE FI.END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE;ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbit;FI END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32FI;IFprotectedTHENcdINCR64FI;IFclosedTHENcdINCR128FI;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputFI;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feldVSUBael)<>afeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IFtout+al>tlenTHENxoutsubtext(grund,ax+tlen-tout,ax+al-1)FI.gibhintergrundaus:xoutsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay).END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay).END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0FI;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeld;UNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBael
+.END PROClength;PROCshow(TAG CONSTff):INT VARi;out(home);out(ff.formblatt(1));FORiFROM2UPTOff.ymaxREPline;out(ff.formblatt(i))PER.END PROCshow;INT VARcharcode:=0,lastx,lasty;PROCtranslatecode:charcode:=code(char);SELECTcharcodeOF CASEchop:charcode:=chomeCASEcvor:charcode:=cfeldendeCASEcrueck:charcode:=cfeldanfCASEchoch:charcode:=cseiterueckCASEcrunter:charcode:=cseitevorCASEctab:charcode:=csettabCASEceinf:charcode:=caufbrechCASEcausf:charcode:=cloeschendeCASEcfeldvor:charcode:=cfeldrueckCASEcmark:charcode:=cneuCASEcesc:charcode:=clearnOTHERWISEcharcode:=pos(hoptasten,char);IFcharcode=0THEN IFischarTHEN FI ELSEchar:=hopcodesSUBcharcode;charcode:=code(char)FI END SELECT END PROCtranslatecode;TEXT VARchar;BOOL PROCischar:inchar(char);charcode:=code(char);IFcharcode>31THEN TRUE ELIFcharcode=chopTHENinchar(char);translatecode;charcode>31ELSE FALSE FI END PROCischar;INT VARaktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo;PROCsetfieldvalues(TAG CONSTta):aktlen:=ta.lenVSUBaktel;aktanf:=ta.xVSUBaktel;aktline:=ta.yVSUBaktelEND PROCsetfieldvalues;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetlasteditvalues:preset:=TRUE END PROCsetlasteditvalues;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROCsetneweditvalues;BOOL VARpreset:=FALSE;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEi<nextelREPnextbeginINCR(t.lenVSUBi);iINCR1PER;nextwo:=nextbegin+x-anfangFI.sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y),nextel+1).keinsmehrda:nextel=0.xposstimmt:erfolg:=anfang<=xANDende>x;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)FI FI END PROCput;INT PROCleavingcode:charcodeEND PROCleavingcode;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)FI PER END PROCput;PROCget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARexittaste):setinfo(ff.diainfo,feld);editieren.editieren:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(eingabe,length(eingabe),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);cursor(lastx,lasty);put(ff,eingabe,feld);IFlength(exittaste)>1THENexittaste:=subtext(exittaste,2,2);FI.END PROCget;PROCputget(TAG CONSTff,TEXT VAReingabe,INT CONSTfeld,TEXT VARtaste):get(ff,eingabe,feld,taste)END PROCputget;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPEATaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldFI;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorFI;FI;executecommandcode(ff,feld);IFfeld=1THENfeld:=2FI;UNTILcharcode=cescPER;FI;.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste);.eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(fieldvalues(feld)),length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);out(endmark);IFankreuzenTHENankreuzfeldbehandlung;
+FI;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2);FI;.ankreuzfeldbehandlung:IFlength(fieldvalues(feld))>0THENfieldvalues(feld):=subtext(fieldvalues(feld),1,1)ELSEfieldvalues(feld):="_"FI;IFpos("_ ",fieldvalues(feld))>0THENfieldvalues(feld):="_"ELSEfieldvalues(feld):="X"FI;.END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:setlasteditvaluesEND SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldFI.tonextfield:INT VARoldfeld:=feld;REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENfeld:=oldfeld;IFbeimletztenrausfallenTHENcharcode:=cesc;beimletztenrausfallen:=FALSE FI FI.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldELSEsetlasteditvaluesFI.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=20,dsname="simsel formulare";BOUND ROWmaxtagsTAG VARsimselformulare;PROCtagsankoppeln:IF NOTinitialized(inthistask)THEN IF NOTexists(dsname)THEN IF NOTexists(dsname,/simseltask)THENerrorstop("TAGs fehlen!")ELSEfetch(dsname,/simseltask);kopplean;FI;ELSEkopplean;FI;FI;.kopplean:DATASPACE VARtagds:=old(dsname);simselformulare:=tagds;forget(dsname,quiet);.END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))FI;simselformulare(i)END PROCformular;END PACKETsimselmasken;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls simselstarter b/app/schulis-simulationssystem/3.0/src/ls simselstarter
new file mode 100644
index 0000000..9a56405
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls simselstarter
@@ -0,0 +1,11 @@
+PACKETlssimselDEFINESmodellnamenderbank,startoperationen,initbankmenu,initmodellmenu,deactivatemodellfkt,bankenauflisten,initialisierebank,ladebanken,sicherebanken,loeschebanken,modelleauflisten,bankzumarbeitenwaehlen,modellwaehlen,modellbearbeiten,modellerzeugen,modellveraendern,wirkungsdiagrammerzeugen,modellkopieren,modellloeschen,modellinformationen:LETstandardkanal=1;WINDOW VARfsingle:=grossesrahmenfenster;WINDOW VARfshow:=scrollfenster;LETsinglesp1=1,zl1=4,singlebr=78,hoe=19,scrollzeile=3;LETmodellbanktyp=1199,typnrwdausfuehrbar=1207,letztemenuwindowzeile=19,erstezeile=3,erstespalte=1,scrollbreite=0,ls=TRUE,negativemld=FALSE,modellbankdialog=2,ok=0,simulationneustarten=10,floppyname="simselmodelle",return="
",abbruch="m",showverlasszeichen="m",nichtdefiniert="",stleistefileverlassen=28,fktbankinitial=1,fktbankladen=2,fktbanksichern=3,fktbankloeschen=4,fktbankinhaltzeigen=7,fktbankwaehlen=1,fktmodellbearbeiten=3,fktmodellerfassen=4,fktwirkdgerfassen=5,fktmodellaendern=6,fktmodellkopieren=7,fktmodellloeschen=8,fktmodelleauflisten=10,fktmodellinfos=12;LETbtueberschriftloeschen=1,btbanknameneingeben=2,btbankengeloescht=4,btkeinebankzumarbeiten=6,btkeinebankenenthalten=7,btkeingueltigerbankname=8,btbankeingerichtet=9,btkeinebankgeloescht=10,btkeinebankgewaehlt=11,btkeinmodellinbank=12,btbankgewaehlt=13,btbittemodellbankdiskette=14,btwartenformatieren=16,btbittedisketteeinlegen=18,btaufdiskueberschreiben=19,btbankenschreiben=20,btdiskettevoll=21,btbankgesichert=22,btsicherungabgebrochen=23,btwartenbeisichern=24,btintaskueberschreiben=25,btnichtueberschriebenladen=26,btwartenbeipruefen=27,btarchivnichtfrei=28,btkannnichtgesichert=29,btbankenladen=30,btwartenbeiladen=31,btmodellveraendertabgelegt=32,btkannnichtgeladen=33,btladenfehlerhaft=34,btbankgeladen=35,btkeinmodellgewaehlt=36,btkeinmodellgeloescht=37,btmodellgeloescht=38,btmodellnichtabgelegt=39,btmodellabgelegt=40,btsimulationbeendet=41,btmodellunveraendertabgelegt=42,btfragemodellloeschen=43,btwartenallgemein=44,btmodellnichtablauffaehig1=45,btmodellnichtablauffaehig2=46,btmodellnichtablauffaehig3=47,btmodellnichtablauffaehig4=48,btmodellnichtablauffaehig5=49,btmodellablauffaehig=105,btmodell=106,btmodellverzeichnis=50,btfrageloeschen=51,btbankexistiert=52,btdateiexistiert=104,btbanknamezulang=53,btmodellbankenverzeichnis=54,btnichtueberschriebensichern=55,btbanknichtgeladen=56,btueberschriftsicherungsaltn=58,btsicherungsalternativen=59,btsimulationunmoeglich=63,bteinrichtenabgebrochen=66,btbitte1bankwaehlen=67,btbittemodellwaehlen=68,btdisketteeinlundweiter=71,btverzeichnisaufarchiv=72,btbittegewuenschtebanken=73,btladevorgangabgebrochen=74,btformatwahlueberschrift=75,btformatwahlbeschreibung=76,btformatwahlbuchstaben=77,btkeinformatgewaehlt=78,btbankevtgeloescht1=79,btbankevtgeloescht2=80,btbankenimsystemwaehlen=81,btbankenankreuzensichern=82,btbankenankreuzenloeschen=83,btbankloeschenabgebrochen=84,btmodellbankvolldgl=85,btmodellbankvollwd=86,maxmodelle=40,maxdglmodelle=20,maxwdmodelle=20,maxnamenlaengeselbsterfasstebank=40,maxmusslaengebankname=50;LETcleararchiv=1,allarchiv=2,schreiben=3,loeschen=4,ladenhauptds=5,laden=6,formatarchiv=7;LETmenuformatieren=2,menuclear=3,menusichern=1,menusichernabbrechen=5;LETmodellcodeds=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds";INT CONSTexistiertnicht:=-1,nichtempfangsbereit:=-2;INT VARi,anzahldermodelle:=0,anzahlbankenintask:=0;THESAURUS VARbankenintask;WINDOW VARaktuelleswindow;BOOL VARsubmenuvorprozedurausfuehren:=FALSE,submenuaufgeklappt:=FALSE;TEXT VARletztebank:="";PROCstartoperationen:texteankoppeln;tagsankoppeln;letztebank:="";submenuaufgeklappt:=FALSE;submenuvorprozedurausfuehren:=TRUE;initmodellmenu;submenuaufgeklappt:=TRUE;submenuvorprozedurausfuehren:=FALSE;END PROCstartoperationen;PROCinitmodellmenu:IFsubmenuvorprozedurausfuehrenTHENloescheaktuellemeldung;taskstatusbzgbanken;letztebank:="";activatemodellfkt;FI;IF NOTbankintaskANDsubmenuaufgeklapptTHENzeigemeldung(
+anwendungstext(btkeinebankzumarbeiten),negativemld,modellbankdialog)FI;submenuvorprozedurausfuehren:=TRUE END PROCinitmodellmenu;PROCinitbankmenu:loescheaktuellemeldung;activatebankfktEND PROCinitbankmenu;PROCactivatemodellfkt:INT VARveraenderbare,ablauffaehige;IFbankintaskTHENactivate(fktbankwaehlen);ELSEdeactivate(fktbankwaehlen);FI;IFletztebank=""THENdeactivatemodellfkt;ELSEactivaterestlichefkt;FI;.activaterestlichefkt:listedermodelle(veraenderbare,ablauffaehige);activate(fktmodelleauflisten);IFmodellbankvolldglTHENdeactivate(fktmodellerfassen)ELSEactivate(fktmodellerfassen);FI;IFmodellbankvollwdTHENdeactivate(fktwirkdgerfassen);ELSEactivate(fktwirkdgerfassen);FI;IFanzahldglmodelle+anzahlwdmodelle>=1THENactivate(fktmodellinfos);ELSEdeactivate(fktmodellinfos);FI;IFablauffaehige>=1THENactivate(fktmodellbearbeiten);ELSEdeactivate(fktmodellbearbeiten);FI;IFveraenderbare>=1THENactivate(fktmodellaendern);activate(fktmodellloeschen);ELSEdeactivate(fktmodellaendern);deactivate(fktmodellloeschen);FI;IFveraenderbare>=1CAND(NOTmodellbankvoll)THENactivate(fktmodellkopieren);ELSEdeactivate(fktmodellkopieren);FI;END PROCactivatemodellfkt;PROCdeactivatemodellfkt:deactivate(fktmodellbearbeiten);deactivate(fktmodellerfassen);deactivate(fktwirkdgerfassen);deactivate(fktmodellaendern);deactivate(fktmodellkopieren);deactivate(fktmodellloeschen);deactivate(fktmodelleauflisten);deactivate(fktmodellinfos);deactivate(fktmodellloeschen);END PROCdeactivatemodellfkt;PROCactivatebankfkt:IFbankintaskTHENactivate(fktbanksichern);activate(fktbankloeschen);activate(fktbankinhaltzeigen);ELSEdeactivate(fktbanksichern);deactivate(fktbankloeschen);deactivate(fktbankinhaltzeigen);FI;activate(fktbankinitial);activate(fktbankladen);END PROCactivatebankfkt;PROCinitialisierebank:TEXT VARbankname:="";BOOL VARnameok:=FALSE;loescheaktuellemeldung;liesneuennamenein;kontrolliereneuennamen;richteggfbankein;.liesneuennamenein:bankname:=menuanswer(anwendungstext(btbanknameneingeben)+((10+maxnamenlaengeselbsterfasstebank-length(anwendungstext(btbanknameneingeben)))*" "),"",5);.kontrolliereneuennamen:IFlsexitkey=abbruchTHENzeigemeldung(anwendungstext(bteinrichtenabgebrochen),negativemld,modellbankdialog);LEAVEinitialisierebankELIFcompress(bankname)=""THENzeigemeldung(anwendungstext(btkeingueltigerbankname),negativemld,modellbankdialog);LEAVEinitialisierebankELIFlength(bankname)>maxnamenlaengeselbsterfasstebankTHENzeigemeldung(anwendungstext(btbanknamezulang),negativemld,modellbankdialog)ELSE IFexists(bankname)THEN IFtype(old(bankname))=modellbanktypTHENzeigemeldung(anwendungstext(btbankexistiert),negativemld,modellbankdialog)ELSEzeigemeldung(anwendungstext(btdateiexistiert),negativemld,modellbankdialog)FI ELSEnameok:=TRUE;FI;FI;.richteggfbankein:IFnameokTHENletztebank:=bankname;neuebank(letztebank);zeigemeldung(anwendungstext(btbankeingerichtet),NOTnegativemld,modellbankdialog);taskstatusbzgbanken;activatebankfktFI.END PROCinitialisierebank;PROCladebanken:THESAURUS VARausgewaehlte,archivliste,inhaltderbank;TEXT VARfehlertext:="",bankname;BOOL VARerfolgreich:=FALSE,ladenok;INT VARbanknr,modellnr,currentx,currenty;loescheaktuellemeldung;erstellelistederbankenaufarchiv;modellbankenwaehlen(ausgewaehlte,anwendungstext(btverzeichnisaufarchiv),anwendungstext(btbittegewuenschtebanken),TRUE);IFnotempty(ausgewaehlte)THENladediegewaehltenELSEzeigemeldung(anwendungstext(btladevorgangabgebrochen),negativemld,modellbankdialog);oldfootnote;refreshsubmenu;FI;.erstellelistederbankenaufarchiv:menuinfo(anwendungstext(btdisketteeinlundweiter),5);archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leaveladebanken;ELSEfootnote(anwendungstext(btwartenbeipruefen));archivoperation(allarchiv,"",archivliste,erfolgreich);IF NOTerfolgreichTHENzeigemeldung(anwendungstext(btbittemodellbankdiskette),negativemld,modellbankdialog);refreshsubmenu;leaveladebanken;ELSEsortierebankenausarchivlisteheraus;FI;FI;.sortierebankenausarchivlisteheraus:
+banknr:=0;ausgewaehlte:=emptythesaurus;get(archivliste,bankname,banknr);WHILEbankname<>""REP IFlength(bankname)<=maxmusslaengebanknameCANDdskeinmodelldatenraum(bankname)THENinsert(ausgewaehlte,bankname);FI;get(archivliste,bankname,banknr)PER.bildschirmleeren:showmenuwindow.ladediegewaehlten:bildschirmleeren;bildeschnittmengetaskarchiv;IFbankendoppeltTHENfragewelcheueberschreibenFI;ladelistebearbeiten.bildeschnittmengetaskarchiv:THESAURUS VARschnittmenge:=bankenintask;schnittmenge:=schnittmenge/ausgewaehlte;.bankendoppelt:notempty(schnittmenge).fragewelcheueberschreiben:menuwindowcursor(2,2);menuwindowout(anwendungstext(btintaskueberschreiben));menuwindowline(2);banknr:=0;get(schnittmenge,bankname,banknr);WHILEbankname<>""REP IFmenuwindowno(" "+code(34)+bankname+code(34)+" ")THENausgewaehlte:=ausgewaehlte-bankname;FI;get(schnittmenge,bankname,banknr);PER;menuwindowline(2);IFkeinezuueberschreibendeTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btnichtueberschriebenladen),negativemld,modellbankdialog);LEAVEladebanken;ELSEmenuwindowpage;FI;.keinezuueberschreibende:NOTnotempty(ausgewaehlte).archivnichtfrei:fehlertext<>"".ladelistebearbeiten:ueberschriftfuergeladenebanken;archivanmelden(fehlertext);IFarchivnichtfreiTHENloescheaktuellesfenster;zeigemeldung(fehlertext,negativemld,modellbankdialog);LEAVEladebanken;ELSEladenok:=TRUE;banknr:=0;get(ausgewaehlte,bankname,banknr);WHILEbankenzuladenCANDladenokREPladenaechstebank;get(ausgewaehlte,bankname,banknr);PER;ladenauswerten;FI;.bankenzuladen:banknr>0.ladenaechstebank:menuwindowout("--> "+bankname);getmenuwindowcursor(currentx,currenty);archivoperation(ladenhauptds,bankname,erfolgreich);IFerfolgreichTHEN IFtype(old(bankname))=modellbanktypTHENstelledatenraeumederbankzusammen;archivoperation(laden,"",inhaltderbank,erfolgreich);IFerfolgreichTHENmeldungeinebankgeladenFI;ELSEforget(bankname,quiet);meldungbanknichtgeladen;FI;FI;ladenok:=erfolgreich;.stelledatenraeumederbankzusammen:kopplean(bankname);inhaltderbank:=emptythesaurus;FORmodellnrFROM1UPTOanzahldglmodelleREPkopplean(modellnr);IFarchivlisteCONTAINSmodelldatenraumTHENinsert(inhaltderbank,modelldatenraum);FI;IFarchivlisteCONTAINSvorgabekurveTHENinsert(inhaltderbank,vorgabekurve);FI;IFarchivlisteCONTAINSvorgabevergleichskurveTHENinsert(inhaltderbank,vorgabevergleichskurve);FI;PER;inhaltderbank:=inhaltderbank+wddsnamen.ladenauswerten:IFladenokTHENloeschewartehinweis;menuwindowcursor(1,currenty);clearbuffer;taskstatusbzgbanken;menuwindowstop;activatebankfkt;loescheaktuellesfenster;ELSEloeschewartehinweis;menuwindowcursor(1,currenty);menuwindowout("    ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btkannnichtgeladen));clearbuffer;menuwindowstop;loescheaktuellesfenster;zeigemeldung(anwendungstext(btladenfehlerhaft),negativemld,modellbankdialog);FI;LEAVEladebanken;.ueberschriftfuergeladenebanken:menuwindowcursor(1,1);menuwindowout(menuwindowcenter(anwendungstext(btbankenladen)));menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeiladen));menuwindowcursor(1,3);.meldungeinebankgeladen:menuwindowcursor(1,currenty);menuwindowout("    ");menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbankgeladen));menuwindowline;.meldungbanknichtgeladen:menuwindowcursor(1,currenty);menuwindowout("    ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbanknichtgeladen));menuwindowline;.loeschewartehinweis:menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(71*" ");.leaveladebanken:oldfootnote;LEAVEladebanken;.END PROCladebanken;PROCloeschebanken:BOOL VARmindestenseinegeloescht:=FALSE;INT VARz;THESAURUS VARauswahlbanken:=bankenintask;loescheaktuellemeldung;modellbankenwaehlen(auswahlbanken,anwendungstext(btbankenimsystemwaehlen),anwendungstext(btbankenankreuzenloeschen),TRUE);IFnotempty(auswahlbanken)THENloeschegewaehltebanken;ELSEzeigemeldung(anwendungstext(btbankloeschenabgebrochen),negativemld,
+modellbankdialog);refreshsubmenu;FI;oldfootnote;.loeschegewaehltebanken:showmenuwindow;menuwindowout(menuwindowcenter(invers(anwendungstext(btueberschriftloeschen))));menuwindowline(2);loeschederreihenach;zeigeabschlusskommentar;.loeschederreihenach:FORzFROM1UPTOhighestentry(auswahlbanken)REP IFname(auswahlbanken,z)<>""ANDexists(name(auswahlbanken,z))ANDmenuwindowyes(" "+code(34)+name(auswahlbanken,z)+code(34)+" "+anwendungstext(btfrageloeschen))THENmindestenseinegeloescht:=TRUE;loesche(name(auswahlbanken,z));FI;PER.zeigeabschlusskommentar:loescheaktuellesfenster;IFmindestenseinegeloeschtTHENtaskstatusbzgbanken;activatebankfkt;zeigemeldung(anwendungstext(btbankengeloescht),NOTnegativemld,modellbankdialog);refreshsubmenu;ELSEzeigemeldung(anwendungstext(btkeinebankgeloescht),negativemld,modellbankdialog);FI.END PROCloeschebanken;PROCsicherebanken:TEXT VARfehlertext:="",bankname;BOOL VARerfolgreich:=FALSE,sichernok;INT VARbanknr,modellnr,format:=0,currentx,currenty;THESAURUS VARausgewaehlte:=bankenintask,archivliste,inhaltderbank;loescheaktuellemeldung;modellbankenwaehlen(ausgewaehlte,anwendungstext(btbankenimsystemwaehlen),anwendungstext(btbankenankreuzensichern),TRUE);IFnotempty(ausgewaehlte)THENsicherediegewaehltenELSErefreshsubmenu;zeigemeldung(anwendungstext(btsicherungabgebrochen),negativemld,modellbankdialog);leavesicherebanken;FI.sicherediegewaehlten:REPkernvonsichernPER.kernvonsichern:WINDOW VARfenster:=window(4,4,75,18);TEXT CONSTinfo:=anwendungstext(btueberschriftsicherungsaltn)+return,liste:=anwendungstext(btsicherungsalternativen),tasten:="   - ";INT VARauswahl;auswahl:=boxalternative(fenster,info,liste,tasten,1,FALSE)MOD100;loescheaktuellemeldung;IFauswahl=menusichernabbrechenTHENrefreshsubmenu;zeigemeldung(anwendungstext(btsicherungabgebrochen),negativemld,modellbankdialog);leavesicherebanken;ELSE IFauswahl=menuformatierenTHENformatierearchiv;ELIFauswahl=menuclearTHENloeschearchiv;FI;startesicherung;FI;.loeschearchiv:footnote(anwendungstext(btwartenallgemein));archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEarchivoperation(cleararchiv,"",erfolgreich);oldfootnote;IF NOTerfolgreichTHENzeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);reentersichern;FI;FI.formatierearchiv:footnote(anwendungstext(btwartenallgemein));archivanmelden(fehlertext);IFarchivnichtfreiTHENzeigemeldung(fehlertext,negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEwaehleformataus;IF NOTformatausgewaehltTHENzeigemeldung(anwendungstext(btkeinformatgewaehlt),negativemld,modellbankdialog);refreshsubmenu;leavesicherebanken;ELSEfootnote(anwendungstext(btwartenformatieren));archivoperation(formatarchiv,text(format),erfolgreich);IF NOTerfolgreichTHENoldfootnote;zeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);reentersichern;FI FI FI.waehleformataus:cursor(1,4);out("�");format:=boxalternative(fenster,anwendungstext(btformatwahlueberschrift),anwendungstext(btformatwahlbeschreibung),anwendungstext(btformatwahlbuchstaben),5,FALSE)MOD100.formatausgewaehlt:format<>5.startesicherung:archivanmelden(fehlertext);IFarchivnichtfreiTHENrefreshsubmenu;zeigemeldung(fehlertext,negativemld,modellbankdialog);leavesicherebanken;ELSElistedesarchivserstellen;IF NOTerfolgreichTHENloescheaktuellesfenster;IFauswahl=menusichernTHENzeigemeldung(anwendungstext(btbittemodellbankdiskette),negativemld,modellbankdialog);ELSEzeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);FI;reentersichern;ELSEerstellesicherungsliste;FI;FI;.listedesarchivserstellen:bildschirmleeren;menuwindowcursor(2,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeipruefen));archivoperation(allarchiv,"",archivliste,erfolgreich);.erstellesicherungsliste:bildeschnittmenge;IFbankendoppeltTHENfragewelcheueberschreiben;FI;sicherungslistebearbeiten;.bildschirmleeren:showmenuwindow;.bildeschnittmenge:
+THESAURUS VARschnittmenge:=archivliste/ausgewaehlte;.bankendoppelt:notempty(schnittmenge).fragewelcheueberschreiben:loeschewartehinweis;menuwindowcursor(2,2);menuwindowout(anwendungstext(btaufdiskueberschreiben));menuwindowline(2);banknr:=0;WHILEbanknr<highestentry(schnittmenge)REPget(schnittmenge,bankname,banknr);IFmenuwindowno(" "+code(34)+bankname+code(34)+" ")THENausgewaehlte:=ausgewaehlte-bankname;FI PER;menuwindowline(2);IFkeinezuueberschreibendeTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btnichtueberschriebensichern),negativemld,modellbankdialog);LEAVEsicherebanken;ELSEmenuwindowpage;FI;.keinezuueberschreibende:NOTnotempty(ausgewaehlte).archivnichtfrei:fehlertext<>"".sicherungslistebearbeiten:ueberschriftfuergesichertebanken;archivanmelden(fehlertext);IFarchivnichtfreiTHENloescheaktuellesfenster;zeigemeldung(fehlertext,negativemld,modellbankdialog);LEAVEsicherebanken;ELSEsichernok:=TRUE;banknr:=0;WHILEbankenzusichernCANDsichernokREPget(ausgewaehlte,bankname,banknr);sicherenaechstebank;PER;sichernauswerten;FI;.bankenzusichern:banknr<highestentry(ausgewaehlte).sicherenaechstebank:stelledatenraeumederbankzusammen;menuwindowout("--> "+bankname);getmenuwindowcursor(currentx,currenty);archivoperation(schreiben,"",inhaltderbank,erfolgreich);IFerfolgreichTHENmeldungeinebankgesichertFI;sichernok:=erfolgreich;.stelledatenraeumederbankzusammen:kopplean(bankname);inhaltderbank:=emptythesaurus;insert(inhaltderbank,bankname);FORmodellnrFROM1UPTOanzahldglmodelleREPkopplean(modellnr);IFexists(modelldatenraum)THENinsert(inhaltderbank,modelldatenraum);FI;IFexists(vorgabekurve)THENinsert(inhaltderbank,vorgabekurve);FI;IFexists(vorgabevergleichskurve)THENinsert(inhaltderbank,vorgabevergleichskurve);FI;PER;inhaltderbank:=inhaltderbank+wddsnamen.sichernauswerten:IFsichernokTHENloeschewartehinweis;menuwindowcursor(1,currenty);clearbuffer;menuwindowstop;loescheaktuellesfenster;ELSEloescheggfdatenraeume;loeschewartehinweis;menuwindowcursor(1,currenty);menuwindowout("    ");currentx:=7;currentyINCR1;menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btkannnichtgesichert));IFbankendoppeltTHENmenuwindowcursor(3,currenty+2);menuwindowout(anwendungstext(btbankevtgeloescht1));menuwindowcursor(3,currenty+3);menuwindowout(anwendungstext(btbankevtgeloescht2));FI;clearbuffer;menuwindowstop;loescheaktuellesfenster;zeigemeldung(anwendungstext(btdiskettevoll),negativemld,modellbankdialog);FI;LEAVEsicherebanken;.ueberschriftfuergesichertebanken:menuwindowcursor(1,1);menuwindowout(menuwindowcenter(anwendungstext(btbankenschreiben)));menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(anwendungstext(btwartenbeisichern));menuwindowcursor(1,3);.meldungeinebankgesichert:menuwindowcursor(1,currenty);menuwindowout("    ");menuwindowcursor(currentx,currenty);menuwindowout(anwendungstext(btbankgesichert));menuwindowline;.loescheggfdatenraeume:inhaltderbank:=(inhaltderbank-remainder)+(remainder/archivliste);IFnotempty(inhaltderbank)THENarchivoperation(loeschen,"",inhaltderbank,erfolgreich);IF NOTerfolgreichTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btbittedisketteeinlegen),negativemld,modellbankdialog);LEAVEsicherebanken;FI;FI;.leavesicherebanken:oldfootnote;LEAVEsicherebanken;.reentersichern:LEAVEkernvonsichern.END PROCsicherebanken;PROCmodellbankenwaehlen(THESAURUS VARgewaehlt,TEXT CONSTt1,t2,BOOL CONSTbildrekonstruieren):waehlebankenaus;.waehlebankenaus:gewaehlt:=some(singlesp1,zl1,singlebr,hoe,gewaehlt,t1,t2);IFbildrekonstruierenTHENerase(fsingle);FI;.END PROCmodellbankenwaehlen;PROCmodellbankwaehlen(TEXT VARgewaehlt):gewaehlt:="";waehlebankaus;koppleggfbankan;.waehlebankaus:gewaehlt:=one(singlesp1,zl1,singlebr,hoe,bankenintask,anwendungstext(btmodellbankenverzeichnis),anwendungstext(btbitte1bankwaehlen));erase(fsingle).koppleggfbankan:IFcompress(gewaehlt)<>""THENkopplean(gewaehlt);letztebank:=gewaehlt;FI.END PROCmodellbankwaehlen;PROCbankenauflisten:FILE VARbankliste;TEXT VARausstieg:="";INT VARerstersatz1:=3,
+erstespalte1:=1;loescheaktuellemeldung;forget(listends);listends:=nilspace;bankliste:=sequentialfile(output,listends);line(bankliste);putline(bankliste,anwendungstext(btmodellbankenverzeichnis));line(bankliste);IFbankintaskTHENbanklisteFILLBYbankenintask;ELSEputline(bankliste,anwendungstext(btkeinebankenenthalten));FI;footnote(steuerleiste(stleistefileverlassen));erase(fsingle);outframe(fsingle);scroll(fshow,bankliste,erstespalte,erstezeile,scrollbreite,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends);loescheaktuellesfenster;.END PROCbankenauflisten;DATASPACE VARlistends;PROCmodelleauflisten(BOOL CONSTmitauswahlderbank):ROWmaxmodelleINT VARmodellnummern;FILE VARmodelliste;TEXT VARbankinbearbeitung;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1;loescheaktuellemeldung;IFmitauswahlderbankTHENmodellbankwaehlen(bankinbearbeitung);ELSEbankinbearbeitung:=letztebank;FI;IFbankinbearbeitung<>""THENletztebank:=bankinbearbeitung;holemodellnamenderbank;zeigemodellnamen;loescheaktuellesfenster;ELSEloescheaktuellesfenster;zeigemeldung(anwendungstext(btkeinebankgewaehlt),NOTnegativemld,modellbankdialog);FI;.holemodellnamenderbank:forget(listends);listends:=nilspace;modelliste:=sequentialfile(output,listends);line(modelliste);putline(modelliste,anwendungstext(btmodellverzeichnis)+evtverkuerzterbankname(letztebank));line(modelliste);modellisteFILLBYmodellnamenderbank(allemodelle,modellnummern,anzahldermodelle);IFanzahldermodelle<=0THENputline(modelliste,anwendungstext(btkeinmodellinbank))FI.zeigemodellnamen:footnote(steuerleiste(stleistefileverlassen));outframe(fsingle);scroll(fshow,modelliste,erstespalte,erstezeile,scrollbreite,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends).END PROCmodelleauflisten;PROCbankzumarbeitenwaehlen:TEXT VARbankinbearbeitung:="";loescheaktuellemeldung;modellbankwaehlen(bankinbearbeitung);IFbankinbearbeitung<>""THENzeigemeldung(anwendungstext(btbankgewaehlt),NOTnegativemld,modellbankdialog);activatemodellfkt;refreshsubmenu;ELSErefreshsubmenu;zeigemeldung(anwendungstext(btkeinebankgewaehlt),negativemld,modellbankdialog);FI;oldfootnote;.END PROCbankzumarbeitenwaehlen;PROCmodellwaehlen(INT VARgewaehlt,KRITERIUM CONSTkriterium):ROWmaxmodelleINT VARmodellnummern;TEXT VARgewaehltesmodell;THESAURUS VARmengedermodelle:=emptythesaurus;holemodellnamenderbank;waehlenamenaus.holemodellnamenderbank:mengedermodelle:=modellnamenderbank(kriterium,modellnummern,anzahldermodelle).waehlenamenaus:gewaehltesmodell:=one(singlesp1,zl1,singlebr,hoe,mengedermodelle,anwendungstext(btmodellverzeichnis)+evtverkuerzterbankname(letztebank),anwendungstext(btbittemodellwaehlen));IFcompress(gewaehltesmodell)<>""THENgewaehlt:=modellnummern(link(mengedermodelle,gewaehltesmodell));ELSEloescheaktuellesfenster;gewaehlt:=0FI.END PROCmodellwaehlen;BOOL PROCbankgewaehlt:NOT(letztebank=nichtdefiniert).END PROCbankgewaehlt;PROCmodellbearbeiten:BOUND MODELLDGL VARaktmodell;DATASPACE VARtransportdsp;INT CONSTursprungstask:=standardkanal;INT VARnr,retcode:=0;loescheaktuellemeldung;modellwaehlen(nr,allelauffaehigen);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);LEAVEmodellbearbeitenELSE IFdglmodellTHENsimulieremitdglmodell;ELSEforget(transportdsp);transportdsp:=old(name(wddsnamen,nr-maxdglmodelle));diagrammankoppeln(transportdsp);transformierewirkungsdiagrammundstartesimulation(ls,retcode);forget(transportdsp)FI;FI;continue(ursprungstask);IFokTHENregeneratemenuscreen;zeigemeldung(anwendungstext(btsimulationbeendet),NOTnegativemld,modellbankdialog);ELSEloescheaktuellesfenster;zeigemeldung(anwendungstext(btsimulationunmoeglich),negativemld,modellbankdialog);FI;.dglmodell:nr<=maxdglmodelle.simulieremitdglmodell:REPversendeundbearbeite;UNTILordnungsgemaessbeendetodertasknichtempfangsbereitPER;.ordnungsgemaessbeendetodertasknichtempfangsbereit:retcode<>simulationneustarten.versendeundbearbeite:continue(ursprungstask);IFretcode=simulationneustartenTHEN
+regeneratemenuscreen;FI;footnote(anwendungstext(btwartenallgemein));kopplean(nr);retcode:=0;schickemodelldaten;IFokTHENschickeoriginalkurve;FI;IFokTHENschickevergleichskurve;FI;IFokTHENschickegleichungen;IFokTHENstartesimulationFI;FI;.ok:retcode=0.schickemodelldaten:transportdsp:=nilspace;aktmodell:=transportdsp;aktmodell:=modellaktuell(nr);schickeanmanagertask(transportdsp,2,retcode);forget(transportdsp);.schickeoriginalkurve:IFexists(vorgabekurve)THENtransportdsp:=old(vorgabekurve);schickeanmanagertask(transportdsp,3,retcode);forget(transportdsp);FI;.schickevergleichskurve:IFexists(vorgabevergleichskurve)THENtransportdsp:=old(vorgabevergleichskurve);schickeanmanagertask(transportdsp,4,retcode);forget(transportdsp);FI;.schickegleichungen:IFexists(modelldatenraum)THENtransportdsp:=old(modelldatenraum);schickeanmanagertask(transportdsp,5,retcode);forget(transportdsp);ELSEretcode:=99;FI.startesimulation:break(quiet);transportdsp:=nilspace;schickeanmanagertask(transportdsp,6,retcode);END PROCmodellbearbeiten;PROCmodellerzeugen:INT VARreturncode;loescheaktuellemeldung;richteneuesmodellein;.richteneuesmodellein:cursoron;fuegeein(aufgeblaehtername(letztebank),returncode);cursoroff;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI;.END PROCmodellerzeugen;PROCwirkungsdiagrammerzeugen:INT VARreturncode;loescheaktuellemeldung;richteneuesmodellein;.richteneuesmodellein:initcellmatrix;cursoron;erfassenamenundwd(aufgeblaehtername(letztebank),0,returncode);cursoroff;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI.END PROCwirkungsdiagrammerzeugen;PROCmodellkopieren:INT VARnr,returncode;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEkopiervorgangFI;.kopiervorgang:IFdglmodellTHEN IFmodellbankvolldglTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btmodellbankvolldgl),negativemld,modellbankdialog);LEAVEmodellkopierenELSEkopplean(nr);cursoron;copy(nr,aufgeblaehtername(letztebank),returncode);cursoroffFI;ELIFwdmodellTHEN IFmodellbankvollwdTHENloescheaktuellesfenster;zeigemeldung(anwendungstext(btmodellbankvollwd),negativemld,modellbankdialog);LEAVEmodellkopierenELSEcursoron;copywd(nr-maxdglmodelle,aufgeblaehtername(letztebank),returncode);cursoroffFI;FI;IF NOT(returncode=ok)THENregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);ELSEactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellabgelegt),NOTnegativemld,modellbankdialog);FI.dglmodell:nr<=maxdglmodelle.wdmodell:nr>maxdglmodelle.END PROCmodellkopieren;PROCmodellloeschen:INT VARnr;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEkopplean(nr);loescheaktuellesfenster;IFmenuyes(modellname+anwendungstext(btfragemodellloeschen),5)THENloesche(nr,aufgeblaehtername(letztebank));zeigemeldung(anwendungstext(btmodellgeloescht),NOTnegativemld,modellbankdialog);activatemodellfkt;ELSEzeigemeldung(anwendungstext(btkeinmodellgeloescht),negativemld,modellbankdialog)FI;FI.modellname:IFdglmodellTHENkopplean(nr);modellbezeichnungELSEname(wdmodelle,nr-maxdglmodelle)FI.dglmodell:nr<=maxdglmodelle.END PROCmodellloeschen;PROCmodellveraendern:DATASPACE VARtransportdsp;BOOL VARerfassenok:=FALSE;INT VARnr,returncode:=0;loescheaktuellemeldung;modellwaehlen(nr,alleaenderbaren);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);ELSEcursoron;IFdglmodellTHENmodellerfassung(nr,aufgeblaehtername(letztebank),
+erfassenok);IF NOTerfassenokTHENloesche(nr,aufgeblaehtername(letztebank))FI;
+ELSEforget(transportdsp);transportdsp:=old(name(wddsnamen,modellindex));diagrammankoppeln(transportdsp);erfassenamenundwd(aufgeblaehtername(letztebank),modellindex,returncode);erfassenok:=(returncode=0);forget(transportdsp)FI;cursoroff;IFerfassenokTHENactivatemodellfkt;regeneratemenuscreen;zeigemeldung(anwendungstext(btmodellveraendertabgelegt),NOTnegativemld,modellbankdialog);ELSEregeneratemenuscreen;zeigemeldung(anwendungstext(btmodellnichtabgelegt),negativemld,modellbankdialog);FI FI.modellindex:nr-maxdglmodelle.dglmodell:nr<=maxdglmodelle.END PROCmodellveraendern;PROCmodellinformationen:DATASPACE VARmodellds;FILE VARmdlinfo;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1,nr;forget(listends);listends:=nilspace;mdlinfo:=sequentialfile(output,listends);loescheaktuellemeldung;modellwaehlen(nr,allemodelle);IFnr=0THENzeigemeldung(anwendungstext(btkeinmodellgewaehlt),negativemld,modellbankdialog);LEAVEmodellinformationenELIFdglmodellTHENkopplean(nr);putline(mdlinfo,anwendungstext(btmodell)+modellbezeichnung);IF NOTexists(modelldatenraum)THENputline(mdlinfo,modellbezeichnung+":");line(mdlinfo,2);putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig5));ELSEforget(listends);informationstext(mdlinfo);IF NOTcompilierbaregleichungenTHENinfofuerfehlerhaftesmodell(mdlinfo)ELSEinfofuerfehlerfreiesmodell(mdlinfo)FI FI ELIFwdmodellTHENforget(modellds);modellds:=old(name(wddsnamen,modellindex));diagrammankoppeln(modellds);putline(mdlinfo,anwendungstext(btmodell)+wdmodellname);putline(mdlinfo,length(anwendungstext(btmodell)+wdmodellname)*"=");line(mdlinfo);IF NOTwdmodelllauffaehigTHENinfofuerfehlerhaftesmodell(mdlinfo)ELSEinfofuerfehlerfreiesmodell(mdlinfo)FI;line(mdlinfo);modellinfo(mdlinfo);forget(modellds)FI;footnote(steuerleiste(stleistefileverlassen));erase(fsingle);outframe(fsingle);scroll(fshow,mdlinfo,1,scrollzeile,1,erstersatz1,erstespalte1,showverlasszeichen,ausstieg);forget(listends);loescheaktuellesfenster.modellindex:nr-maxdglmodelle.dglmodell:nr<=maxdglmodelle.wdmodell:NOTdglmodell.wdmodelllauffaehig:type(old(name(wddsnamen,nr-maxdglmodelle)))=typnrwdausfuehrbar.wdmodellname:name(wdmodelle,nr-maxdglmodelle).END PROCmodellinformationen;PROCinfofuerfehlerhaftesmodell(FILE VARmdlinfo):putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig1));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig2));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig3));putline(mdlinfo,anwendungstext(btmodellnichtablauffaehig4))END PROCinfofuerfehlerhaftesmodell;PROCinfofuerfehlerfreiesmodell(FILE VARmdlinfo):putline(mdlinfo,anwendungstext(btmodellablauffaehig))END PROCinfofuerfehlerfreiesmodell;BOOL PROCbankintask:anzahlbankenintask>0END PROCbankintask;PROCtaskstatusbzgbanken:bankenintask:=infixnamen(all,modellbanktyp);anzahlbankenintask:=highestentry(bankenintask)END PROCtaskstatusbzgbanken;THESAURUS PROCmodellnamenderbank(KRITERIUM CONSTkriterium,ROWmaxmodelleINT VARmodellnummern,INT VARanzahldermodelle):THESAURUS VARbankliste:=emptythesaurus;ROWmaxmodelleTEXT VARmodellnamen;listedermodelle(modellnamen,modellnummern,kriterium,anzahldermodelle);IFanzahldermodelle>0THENschreibenameninverzeichnisFI;bankliste.schreibenameninverzeichnis:FORiFROM1UPTOanzahldermodelleREPinsert(bankliste,modellnamen(i))PER.END PROCmodellnamenderbank;PROCarchivanmelden(TEXT VARarchivfehler):disablestop;archive(floppyname);IFiserrorTHENarchivfehler:=errormessage;clearerror;enablestop;IFlength(archivfehler)<=62THENarchivfehler:=archivfehler;ELSEarchivfehler:=anwendungstext(btarchivnichtfrei);FI;ELSEenablestop;archivfehler:="";FI.END PROCarchivanmelden;PROCarchivoperation(INT CONSToperation,TEXT CONSTdatenraum,BOOL VARmiterfolg):THESAURUS VARarchivinhalt;archivoperation(operation,datenraum,archivinhalt,miterfolg);END PROCarchivoperation;PROCarchivoperation(INT CONSToperation,TEXT CONSTtextparam,THESAURUS VARarchivliste,BOOL VARmiterfolg):disablestop;archive(floppyname);commanddialogue(FALSE);SELECToperationOF CASE1:clear(archive)CASE2:
+archivliste:=ALLarchive;CASE3:menuwindowcursor(length(anwendungstext(btwartenbeisichern))+3,letztemenuwindowzeile);save(archivliste,archive);CASE4:menuwindowcursor(length(anwendungstext(btwartenbeisichern))+3,letztemenuwindowzeile);erase(archivliste,archive);CASE5:menuwindowcursor(length(anwendungstext(btwartenbeiladen))+3,letztemenuwindowzeile);fetch(textparam,archive);CASE6:menuwindowcursor(length(anwendungstext(btwartenbeiladen))+3,letztemenuwindowzeile);fetch(archivliste,archive);CASE7:format(int(textparam),archive)END SELECT;IFiserrorTHENclearerror;enablestop;miterfolg:=FALSE;ELSEenablestop;miterfolg:=TRUE;FI;commanddialogue(TRUE);release(archive);.END PROCarchivoperation;BOOL PROCdskeinmodelldatenraum(TEXT CONSTdataspacename):pos(dataspacename,originalkurve)=0CANDpos(dataspacename,vergleichskurve)=0CANDpos(dataspacename,modellcodeds)=0.END PROCdskeinmodelldatenraum;PROCloeschewartehinweis:menuwindowcursor(1,letztemenuwindowzeile);menuwindowout(71*" ");END PROCloeschewartehinweis;PROCloescheaktuellesfenster:aktuelleswindow:=currentmenuwindow;erase(aktuelleswindow);refreshsubmenu;oldfootnote;END PROCloescheaktuellesfenster;TEXT PROCevtverkuerzterbankname(TEXT CONSTbankname):TEXT CONSTbn:=compress(bankname);IFlength(bn)>maxnamenlaengeselbsterfasstebankTHENverkuerzternameELSEbnFI.verkuerztername:IFpos(bn,":")>0THENsubtext(bn,abdoppelpunkt)ELSEsubtext(bn,1,maxnamenlaengeselbsterfasstebank)FI.abdoppelpunkt:pos(bn,":")+2.END PROCevtverkuerzterbankname;TEXT PROCaufgeblaehtername(TEXT CONSTbankname):text(bankname,maxmusslaengebankname).END PROCaufgeblaehtername;END PACKETlssimsel;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls simulation b/app/schulis-simulationssystem/3.0/src/ls simulation
new file mode 100644
index 0000000..c673fa0
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls simulation
@@ -0,0 +1,5 @@
+PACKETlssimulationDEFINESberechne,berechnefortfuehrung,forgetmodellauf,zeigediagramm,zeigephasendiagramm,zeigevergleichskurve,zeigevergleichfuertabelle,zeigevergleichskurvefuerphasendiagramm:LETabbruch=36,mldruckertaskexistiertnicht=37,mldrucktasknichtempfangsbereit=38,mldruckunmoeglich=39,druckok=0,printertaskname="PRINTER",kurveleer=99,oueberschrift=67,vueberschrift=68,steuerleisteberechnung=26,steuerleistegraphik=27,steuerleistevergleichgraphik=29,steuerleistetabelle=30,steuerleistewarten=31,produktname=21,sendetaste="p",vglbeendenz="z",vglbeendent="t",vglbeendenh="h",lsabbruch="m",lsabbrucheingabe="m",blaetternoben="o",blaetternunten="u",weiter="w",druckdateitab=" tabelle.p",druckdateitab2=" tabelle.p.2",dateimodellwerte=" modellwerte",erzeugtetabelle=" tabelle";LETstrukt1fenster=1,strukt4fenster=4,fensterdummy=0,fensterganz=1,fensterlinksoben=4,fensterrechtsoben=6,fensterrechtsunten=7,fensterlinksunten=5;TEXT CONSTscrollausstiegmitdrucken:="md";INT VARfehlercode:=0,fehlernummer;LETscrollsp1=16,scrollzeile1=3,scrollbreitetab=15;LETniltext="",seitenvorschub="#page#",headanfang="#head#",nummerierung="#right# Seite: ",center="#center#",headende="#end#",druckbreite=78,drucklaenge=60;LETpausendauer=30;TEXT CONSTsendenblaetternuntenundoben:=sendetaste+blaetternunten+blaetternoben;INT VARsteuerzeilennr,kopfzeilennr;PROCberechne(LOESUNG VARergebnis,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,TEXT VARtaste):enablestop;taste:="";forgetlogischemaske;REPkernvonberechne;PER.kernvonberechne:forgetmodellauf;eingabemodellgroessen(ergebnis,PROCf,PROCcof,kopfzeilezusammenstellen(kopfzeile(21),modellkurzbezeichnung,77),steuerleiste(steuerleisteberechnung),taste,zeichenkette,fehlercode);IFfehlercode=abbruchCORfehlercode=kurveleerTHENpausebeifehlern;reenterberechneELSEpausebeifehlernFI;IFtaste=lsabbrucheingabeCORtaste=weiterTHENleaveberechneFI;.zeichenkette:weiter.leaveberechne:LEAVEberechne.reenterberechne:forget("aus",quiet);LEAVEkernvonberechne.END PROCberechne;PROCforgetmodellauf:forget(dateimodellwerte,quiet);forget("aus",quiet);forget("aus diagramm",quiet);forget(" neue kurve",quiet);forget(druckdateitab,quiet);END PROCforgetmodellauf;PROCzeigediagramm(TEXT CONSTart,LOESUNG VARdieloesung,ZUSTAND VARmuster,BOOL CONSTinfortsetzung,TEXT VARtaste):TEXT VARdiagrammart:=art;OUTPUT VARausdiagramm;fehlernummer:=0;gibdiagrammaus(ausdiagramm,muster,dieloesung,infortsetzung,diagrammart,taste);.END PROCzeigediagramm;PROCgibdiagrammaus(OUTPUT VARausdiagramm,ZUSTAND CONSTmuster,LOESUNG VARloesungx,BOOL CONSTinfortsetzung,TEXT CONSTdiagrammart,TEXT VARtaste):KURVE VARhilfskurve:=LOESUNGSABSCHNITTloesungx;TEXT CONSTtastenraus:=lsabbruch;;ausdiagramm:=niloutput(strukt1fenster,"aus diagramm");IFdiagrammart=vglbeendenzTHENgibzeitdiagrammausELIFdiagrammart=vglbeendentTHENgibtabelleausELIFdiagrammart=vglbeendenhTHENgibhistogrammausFI.gibzeitdiagrammaus:IFinfortsetzungTHENkopfzeilennr:=4ELSEkopfzeilennr:=3FI;steuerzeilennr:=steuerleistegraphik;pausebeifehlern;steuerprozessfuereineloesung(ausdiagramm,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinezeit,PROCcoroutinedummy).gibtabelleaus:FILE VARtbl:=tabelle(hilfskurve,muster,TRUE);WINDOW VARtabwindow:=grossesrahmenfenster;INT VARerstersatz1:=3,erstespalte1:=scrollsp1,seitenzaehler:=1;INT VARok:=0;forget(druckdateitab,quiet);rename(erzeugtetabelle,druckdateitab);outframe(tabwindow);footnote(steuerleiste(steuerleistetabelle));scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegmitdrucken,taste);WHILEtaste<>lsabbruchREPdruckeevt;scroll(tabwindow,druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,scrollausstiegmitdrucken,taste);PER;erase(tabwindow);.druckeevt:footnote(steuerleiste(steuerleistewarten));seitenzaehler:=1;druckemodellwerteaus(originalwerte,seitenzaehler
+,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,seitenzaehler,ok);FI;IFok=druckokTHENfootnote(steuerleiste(steuerleistetabelle));ELSEfootnote(meldungstext(ok));pause;footnote(steuerleiste(steuerleistetabelle));FI;.gibhistogrammaus:IFinfortsetzungTHENkopfzeilennr:=29ELSEkopfzeilennr:=28FI;steuerzeilennr:=steuerleistegraphik;pausebeifehlern;steuerprozessfuereineloesung(ausdiagramm,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinehisto,PROCcoroutinedummy).END PROCgibdiagrammaus;PROCpausebeifehlern:IFfehlercode>0THENzeigemeldung(meldungstext(fehlercode),FALSE);pause(pausendauer);fehlercode:=0;loescheaktuellemeldung;FI.END PROCpausebeifehlern;PROCzeigephasendiagramm(LOESUNG VARdieloesung,ZUSTAND VARmuster,BOOL CONSTinfortsetzung,TEXT VARtaste):TEXT CONSTtastenraus:=lsabbruch;gibphasendiagrammaus;.gibphasendiagrammaus:KURVE VARhilfskurve:=LOESUNGSABSCHNITTdieloesung;OUTPUT VARausphasen:=niloutput(strukt1fenster,"aus phasen");kopfzeilennr:=kopf;steuerzeilennr:=steuerleistegraphik;steuerprozessfuereineloesung(ausphasen,hilfskurve,muster,neuerzustand(dimension+codimension),fensterganz,fensterdummy,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinephase,PROCcoroutinedummy).kopf:IFinfortsetzungTHEN9ELSE8FI.END PROCzeigephasendiagramm;PROCzeigevergleichskurve(TEXT VARtaste,LOESUNG VARlsga,lsgb,ZUSTAND CONSTmuster,TEXT CONSTwas):KURVE VARkurvea,kurveb;TEXT VARtastenraus:=lsabbruch;originalundvergleichskurveausgeben.originalundvergleichskurveausgeben:OUTPUT VARausvergl2:=niloutput(strukt4fenster,"ausvergl2");kurvea:=LOESUNGSABSCHNITTlsga;kurveb:=LOESUNGSABSCHNITTlsgb;modellwertefuervergleich(ausvergl2,fensterrechtsoben,lsga,fensterrechtsunten,lsgb);kopfzeilennr:=6;steuerzeilennr:=steuerleistevergleichgraphik;aufrufvergleichhistogrammodervergleichzeit.aufrufvergleichhistogrammodervergleichzeit:IFwas=vglbeendenzTHENsteuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterlinksoben,fensterlinksunten,kopfzeilennr,steuerzeilennr,sendenblaetternuntenundoben,tastenraus,taste,PROCcoroutinezeit,PROCkreuzzeitvergleich)ELSEsteuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterlinksoben,fensterlinksunten,kopfzeilennr,steuerzeilennr,sendenblaetternuntenundoben,tastenraus,taste,PROCcoroutinehisto,PROCkreuzhistovergleich)FI.ENDPROCzeigevergleichskurve;PROCzeigevergleichfuertabelle(TEXT VARtaste,LOESUNG VARla,lb,ZUSTAND CONSTmuster):KURVE VARkurvea:=LOESUNGSABSCHNITTla,kurveb:=LOESUNGSABSCHNITTlb;WINDOW VARtabwindowo:=tabellenfensteroben,tabwindowu:=tabellenfensterunten;INT VARerstersatz1:=3,erstersatz2:=3,erstespalte1:=scrollsp1,seitenzaehler:=1;INT VARok:=0;originalundvergleichausgeben;forget(druckdateitab2,quiet);forget(druckdateitab,quiet);.originalundvergleichausgeben:FILE VARtbl;kopfzeilennr:=6;steuerzeilennr:=steuerleistetabelle;forget(druckdateitab2,quiet);forget(druckdateitab,quiet);tbl:=tabelle(kurvea,muster,TRUE);rename(erzeugtetabelle,druckdateitab);tbl:=tabelle(kurveb,muster,TRUE);rename(erzeugtetabelle,druckdateitab2);footnote(steuerleiste(steuerzeilennr));outframe(tabwindowo);outframe(tabwindowu);scroll(tabwindowo,tabwindowu,druckdateitab,druckdateitab2,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,erstersatz2,scrollausstiegmitdrucken,taste);WHILEtaste<>lsabbruchREPdruckeevt;scroll(tabwindowo,tabwindowu,druckdateitab,druckdateitab2,scrollsp1,scrollzeile1,scrollbreitetab,erstersatz1,erstespalte1,erstersatz2,scrollausstiegmitdrucken,taste);PER;erase(tabwindowo);erase(tabwindowu);.druckeevt:footnote(steuerleiste(steuerleistewarten));seitenzaehler:=1;druckemodellwerteaus(la,seitenzaehler,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab,scrollsp1,scrollzeile1,scrollbreitetab,seitenzaehler,ok);IFok=druckokTHENdruckemodellwerteaus(lb,seitenzaehler,ok);IFok=druckokTHENtabelleaufbereitetdrucken(druckdateitab2,scrollsp1,
+scrollzeile1,scrollbreitetab,seitenzaehler,ok);FI;FI;FI;IFok=druckokTHENfootnote(steuerleiste(steuerleistetabelle));ELSEfootnote(meldungstext(ok));pause;footnote(steuerleiste(steuerleistetabelle));FI;.ENDPROCzeigevergleichfuertabelle;PROCzeigevergleichskurvefuerphasendiagramm(TEXT VARtaste,KURVE CONSTkva,kvb,ZUSTAND VARmuster):TEXT VARtastenraus:=lsabbruch;originalundvergleichskurveausgeben;.originalundvergleichskurveausgeben:OUTPUT VARausvergl2:=niloutput(strukt1fenster,"ausvergl2");KURVE VARkurvea,kurveb;kurvea:=kva;kurveb:=kvb;steuerprozessfuerzweiloesungenaufrufen.steuerprozessfuerzweiloesungenaufrufen:kopfzeilennr:=6;steuerzeilennr:=steuerleistegraphik;steuerprozessfuerzweiloesungen(ausvergl2,kurvea,kurveb,muster,fensterganz,fensterganz,kopfzeilennr,steuerzeilennr,sendetaste,tastenraus,taste,PROCcoroutinephase,PROCkreuzphasevergleich).ENDPROCzeigevergleichskurvefuerphasendiagramm;PROCmodellwertefuervergleich(OUTPUT VARseite,INT CONSToben,LOESUNG CONSToriginal,INT CONSTunten,LOESUNG CONSTvergleich):FILE VARzfile;zfile:=modellwerteausgeben(original);modify(zfile);toline(zfile,1);insertrecord(zfile);writerecord(zfile,meldungstext(oueberschrift));toline(zfile,2);insertrecord(zfile);writerecord(zfile,"         ");replace(seite,oben,zfile);zfile:=modellwerteausgeben(vergleich);modify(zfile);toline(zfile,1);insertrecord(zfile);writerecord(zfile,meldungstext(vueberschrift));toline(zfile,2);insertrecord(zfile);writerecord(zfile,"         ");replace(seite,unten,zfile);END PROCmodellwertefuervergleich;PROCforgetds:forget("groessen vergl",quiet);forget("ausvergl",quiet);forget("ausvergl2",quiet);END PROCforgetds;PROCberechnefortfuehrung(LOESUNG VARoriginal,gesamtloesung,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):ZUSTAND VARstartwert:=neuerzustand(dimension),letzterpunkt:=letzterwert(LOESUNGSABSCHNITTgesamtloesung);INT VARi;FORiFROM1UPTOdimensionREPreplace(startwert,i,(letzterpunktSUBi));PER KURVE VARzkurve1,zkurve2;gibberechnungsstandzeileaus;zkurve1:=kurve1(PROCf,PROCcof,startwert,zustandunteregrenze,zustandoberegrenze,letztezeit(LOESUNGSABSCHNITTgesamtloesung),DAUERoriginal,PARAMETERSATZgesamtloesung,anzahlbeobachtungspunkte,codimension,"fortfuehrung",fehlercode);zkurve2:=LOESUNGSABSCHNITTgesamtloesung;zkurve2CATzkurve1;forget("fortfuehrung",quiet);gesamtloesungLOESUNGSABSCHNITTzkurve2;gesamtloesungDAUER(letztezeit(LOESUNGSABSCHNITTgesamtloesung)-(STARTZEIToriginal));pausebeifehlern;END PROCberechnefortfuehrung;PROCtabelleaufbereitetdrucken(TEXT CONSTfname,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite,INT VARseitenzahl,INT VARret):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=fname+"."+timeofday+text(seitenzahl);TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;ret:=erfolgreicherdruckversuch(neuername);IFret=druckokTHENforget(neuername,quiet);ELSE END IF.testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge-zeilenbeginn+1;verfuegbarerplatzDECR5;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointer<dateibreiteREPschreibeseiten;seitenzahlINCR1;spaltenpointerINCRzulaessigebreiteEND REP.schreibeseiten:zeilenpointer:=zeilenbeginn;REPschreibekopfzeilen;schreiberumpfzeilenEND REP;.schreibekopfzeilen:putline(fdruck,seitenvorschub);putline(fdruck,headanfang);putline(fdruck,auskunftstext(produktname)+nummerierung+text(seitenzahl));line(fdruck);putline(fdruck,center+modellbezeichnung);putline(fdruck,headende);line(fdruck,2);FORjFROM1UPTOzeilenbeginn-1REP
+druckzeile:=niltext;toline(f,j);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite);putline(fdruck,druckzeile)END REP.schreiberumpfzeilen:FORiFROM1UPTOverfuegbarerplatzREPdruckzeile:=niltext;toline(f,zeilenpointer);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite);putline(fdruck,druckzeile);zeilenpointerINCR1;IFzeilenpointer>dateilaengeTHEN LEAVEschreibeseitenEND IF END REP.END PROCtabelleaufbereitetdrucken;PROCdruckemodellwerteaus(LOESUNG CONSTloesungx,INT VARseitenzahl,INT VARret):FILE VARmdw,fdruck;TEXT VARzeilentext,eindeutigerwertname;initialisieredruckdateimitueberschrift;lesemodellwertdateiein;druckemodellwerte;.initialisieredruckdateimitueberschrift:mdw:=modellwerteausgeben(loesungx);eindeutigerwertname:=dateimodellwerte+"."+timeofday+text(seitenzahl);IFexists(eindeutigerwertname)THENforget(eindeutigerwertname,quiet);FI;fdruck:=sequentialfile(output,eindeutigerwertname);putline(fdruck,seitenvorschub);putline(fdruck,headanfang);putline(fdruck,auskunftstext(produktname)+nummerierung+text(seitenzahl));line(fdruck);putline(fdruck,center+modellbezeichnung);putline(fdruck,headende);line(fdruck,2);.lesemodellwertdateiein:input(mdw);WHILE NOTeof(mdw)REPgetline(mdw,zeilentext);putline(fdruck,zeilentext);PER;.druckemodellwerte:seitenzahlINCR1;ret:=erfolgreicherdruckversuch(eindeutigerwertname);IFret=druckokTHENforget(dateimodellwerte,quiet);forget(eindeutigerwertname,quiet);FI;.END PROCdruckemodellwerteaus;INT PROCerfolgreicherdruckversuch(TEXT CONSTdatname):disablestop;IFexiststask(printertaskname)THEN IFstatus(/printertaskname)=2THENsicherezuprinterELSEenablestop;mldrucktasknichtempfangsbereitFI ELSEenablestop;mldruckertaskexistiertnichtFI.sicherezuprinter:commanddialogue(FALSE);save(datname,/printertaskname);commanddialogue(TRUE);IFiserrorTHENclearerror;enablestop;mldruckunmoeglichELSEenablestop;druckokEND IF.END PROCerfolgreicherdruckversuch;END PACKETlssimulation;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung b/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung
new file mode 100644
index 0000000..f8cf9d4
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls starte bearbeitung
@@ -0,0 +1,2 @@
+PACKETlsstartebearbeitungDEFINESwahlderbearbeitung:PROCwahlderbearbeitung(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):enablestop;LETabbruch=0,btbuchstabenmitdemo=57,btauswahlhead=60,btalternmitdemo=61,btalternohnedemo=62,btbuchstabenohnedemo=70;TEXT CONSTreturn:=code(13),info:=" "+modellbezeichnung+return+return;INT VARauswahl;WINDOW VARfenster:=grossesrahmenfenster;page;show(fenster);REPclearbuffer;IFexists(vorgabekurve)ANDexists(vorgabevergleichskurve)THENauswahlmitangebotdemoELSEauswahlohneangebotdemoFI;UNTILauswahl=abbruchPER;.auswahlmitangebotdemo:auswahl:=boxalternative(fenster,info,anwendungstext(btalternmitdemo),anwendungstext(btbuchstabenmitdemo),5,FALSE);SELECTauswahlOF CASE1,101,106:handlemenu("Simulation",PROCf,PROCcof,PROCzusatzdarst);page;show(fenster);CASE2,102,107:demonstration(PROCzusatzdarst);page;show(fenster);CASE3,103,108:infoszummodell;page(fenster);CASE5,105,110:auswahl:=abbruch;OTHERWISE END SELECT;.auswahlohneangebotdemo:auswahl:=boxalternative(fenster,info,anwendungstext(btalternohnedemo),anwendungstext(btbuchstabenohnedemo),5,FALSE);SELECTauswahlOF CASE1,101,105:handlemenu("Simulation",PROCf,PROCcof,PROCzusatzdarst);page;show(fenster);CASE2,102,106:infoszummodell;page(fenster);CASE4,104,108:auswahl:=abbruch;OTHERWISE END SELECT;.END PROCwahlderbearbeitung;END PACKETlsstartebearbeitung;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve b/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve
new file mode 100644
index 0000000..4b16b2a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls zustaende parameter kurve
@@ -0,0 +1,6 @@
+PACKETzustaendeparameterkurveDEFINESneuekurve,neuerzustand,text,neuerparameter,platz,replace,SUB,schreibe,schreibebeobachtungspunkt,minimalwerte,maximalwerte,leseerstenbeobachtungspunkt,lesenaechstenbeobachtungspunkt,leseersten,lesenaechsten,lesevorherigen,naechstezeit,vorherigezeit,KURVE,ZUSTAND,PARAMETER,DSUB,:=,CAT,copy,zustand,parameter,endederloesung,anfangderloesung,endedestabspeichers,letzterwert,letztezeit,PLUS,kurve1,epsilon,imdefbereich:LETmaxdimension=20;LETmaxpunktspeicher=1000,maxbpunktspeicher=1000;LETreallaenge=8;LETtypnrkurve=1088;REAL CONSTdelta:=0.001;REAL CONSTminusdelta:=-0.001;LETstoptaste="a",abbruch=36,kurveleer=99;TYPE ZUSTAND=STRUCT(ROWmaxdimensionREALkoordinate,INTdimension);TYPE PARAMETER=STRUCT(ZUSTANDvektor);LET PUNKT=STRUCT(TEXTvektor,REALzeit);LET PUNKTE=STRUCT(INTzeilen,INTzeilenposition,ROWmaxpunktspeicherPUNKTtupel);LET BEOBACHTUNGSPUNKTE=STRUCT(INTzeilen,INTzeilenposition,ROWmaxbpunktspeicherPUNKTtupel);TYPE KURVE=BOUND STRUCT(INTinternedimension,PUNKTEpunkte,TEXTdsname,BEOBACHTUNGSPUNKTEbpunkte,ZUSTANDminimum,maximum);REAL VAReps:=0.0000000005;LETminh=0.00005;REAL CONSTnull:=1.0/1.0e60;PROCepsilon(REAL CONSTepseingabe):eps:=epseingabeEND PROCepsilon;ZUSTAND OP+(ZUSTAND CONSTa,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;FORiFROM1UPTOa.dimensionREPz.koordinate(i):=a.koordinate(i)+b.koordinate(i)PER;z.dimension:=a.dimension;z.END OP+;ZUSTAND OP PLUS(ZUSTAND CONSTa,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;FORiFROM1UPTOa.dimensionREPz.koordinate(i):=a.koordinate(i)PER;FORiFROMa.dimension+1UPTOa.dimension+b.dimensionREPz.koordinate(i):=b.koordinate(i-a.dimension)PER;z.dimension:=a.dimension+b.dimension;z.END OP PLUS;ZUSTAND OP*(REAL CONSTzahl,ZUSTAND CONSTb):INT VARi;ZUSTAND VARz;z.dimension:=b.dimension;FORiFROM1UPTOb.dimensionREPz.koordinate(i):=zahl*b.koordinate(i)PER;z.END OP*;ZUSTAND OP-(ZUSTAND CONSTa,ZUSTAND CONSTb):a+((-1.0)*b)END OP-;INT OP DSUB(ZUSTAND CONSTz):z.dimensionEND OP DSUB;ZUSTAND PROCneuerzustand(INT CONSTdimension):ZUSTAND VARz;INT VARi;FORiFROM1UPTOdimensionREPz.koordinate(i):=0.0PER;z.dimension:=dimension;zEND PROCneuerzustand;PARAMETER PROCneuerparameter(INT CONSTdimension):PARAMETER VARp;p.vektor:=neuerzustand(dimension);pEND PROCneuerparameter;PROCreplace(ZUSTAND VARzustand,INT CONSTi,REAL CONSTwert):IFdecimalexponent(wert)<-126THENzustand.koordinate(i):=0.0ELSEzustand.koordinate(i):=wertFI END PROCreplace;PROCreplace(PARAMETER VARparameter,INT CONSTindex,REAL CONSTwert):replace(parameter.vektor,index,wert);END PROCreplace;REAL OP SUB(ZUSTAND CONSTzustand,INT CONSTi):zustand.koordinate(i)ENDOP SUB;REAL OP SUB(PARAMETER CONSTparameter,INT CONSTi):parameter.vektorSUBiENDOP SUB;TEXT PROCtext(ZUSTAND CONSTz):INT VARi;TEXT VARt:=(z.dimension*reallaenge)*"�";FORiFROM1UPTOz.dimensionREP IFdecimalexponent(z.koordinate(i))<-126THENreplace(t,i,0.0)ELSEreplace(t,i,z.koordinate(i))FI PER;tEND PROCtext;TEXT PROCtext(PARAMETER CONSTparameter):text(parameter.vektor)END PROCtext;ZUSTAND PROCzustand(TEXT CONSTt):INT VARi;ZUSTAND VARz:=neuerzustand(length(t)DIVreallaenge);FORiFROM1UPTOz.dimensionREPz.koordinate(i):=tRSUBiPER;zEND PROCzustand;PARAMETER PROCparameter(TEXT CONSTt):PARAMETER VARp;p.vektor:=zustand(t);pEND PROCparameter;OP:=(KURVE VARkurve,DATASPACE CONSTspace):CONCR(kurve):=spaceENDOP:=;DATASPACE PROCneuekurve(INT CONSTdimension,TEXT CONSTdsname):KURVE VARkurve;forget(dsname,quiet);kurve:=new(dsname);kurve.dsname:=dsname;kurve.minimum:=neuerzustand(dimension);kurve.maximum:=neuerzustand(dimension);kurve.internedimension:=dimension+1;kurve.punkte.zeilenposition:=1;kurve.punkte.zeilen:=0;kurve.bpunkte.zeilenposition:=1;kurve.bpunkte.zeilen:=0;type(old(dsname),typnrkurve);old(dsname).ENDPROCneuekurve;PROCschreibe(KURVE VARkurve,REAL CONSTzeit,ZUSTAND CONSTz):IFnochplatzda(kurve)THEN IFkurve.punkte.zeilenposition=1THENkurve.minimum:=z;kurve.maximum:=z;ELSEpruefeobkomponentenminimalodermaximalFI;kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor:=text(z);IFdecimalexponent(zeit)<-126
+THENkurve.punkte.tupel(kurve.punkte.zeilenposition).zeit:=0.0ELSEkurve.punkte.tupel(kurve.punkte.zeilenposition).zeit:=zeit;FI;kurve.punkte.zeilenpositionINCR1;kurve.punkte.zeilenINCR1FI.pruefeobkomponentenminimalodermaximal:INT VARi;FORiFROM1UPTOz.dimensionREP IFz.koordinate(i)<kurve.minimum.koordinate(i)THENkurve.minimum.koordinate(i):=z.koordinate(i)ELIFz.koordinate(i)>kurve.maximum.koordinate(i)THENkurve.maximum.koordinate(i):=z.koordinate(i)FI PER.ENDPROCschreibe;PROCschreibebeobachtungspunkt(KURVE VARkurve,REAL CONSTzeit,ZUSTAND CONSTz):IFnochtabplatzda(kurve)CANDnochplatzda(kurve)THENschreibe(kurve,zeit,z);schreibeintabspeicherFI.schreibeintabspeicher:kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor:=text(z);kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit:=zeit;kurve.bpunkte.zeilenpositionINCR1;kurve.bpunkte.zeilenINCR1.ENDPROCschreibebeobachtungspunkt;ZUSTAND PROCminimalwerte(KURVE CONSTkurve):kurve.minimumENDPROCminimalwerte;ZUSTAND PROCmaximalwerte(KURVE CONSTkurve):kurve.maximumENDPROCmaximalwerte;BOOL PROCnochplatzda(KURVE VARkurve):NOT(kurve.punkte.zeilenposition>maxpunktspeicher)END PROCnochplatzda;BOOL PROCnochtabplatzda(KURVE VARkurve):NOT(kurve.bpunkte.zeilenposition>maxbpunktspeicher)END PROCnochtabplatzda;BOOL PROCplatz(KURVE CONSTkurve):NOT(kurve.punkte.zeilenposition>maxpunktspeicher)END PROCplatz;PROCleseersten(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):kurve.punkte.zeilenposition:=1;lieszeit;lieskoordinaten.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROCleseersten;PROClesenaechsten(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTendederloesung(kurve)THENkurve.punkte.zeilenpositionINCR1;lieszeit;lieskoordinaten;ELSEz:=neuerzustand(kurve.internedimension-1)FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROClesenaechsten;PROClesevorherigen(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTanfangderloesung(kurve)THENkurve.punkte.zeilenpositionDECR1;lieszeit;lieskoordinaten;ELSEz:=neuerzustand(kurve.internedimension-1)FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.punkte.tupel(kurve.punkte.zeilenposition).vektor).END PROClesevorherigen;PROCvorherigezeit(KURVE VARkurve,REAL VARzeit):IF NOTanfangderloesung(kurve)THENlieszeit;FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition-1).zeit.END PROCvorherigezeit;PROCnaechstezeit(KURVE VARkurve,REAL VARzeit):IF NOTendederloesung(kurve)THENlieszeit;FI.lieszeit:zeit:=kurve.punkte.tupel(kurve.punkte.zeilenposition+1).zeit.END PROCnaechstezeit;PROCleseerstenbeobachtungspunkt(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):kurve.bpunkte.zeilenposition:=1;lieszeit;lieskoordinaten;kurve.bpunkte.zeilenpositionINCR1.lieszeit:zeit:=kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit.lieskoordinaten:z:=zustand(kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor).END PROCleseerstenbeobachtungspunkt;PROClesenaechstenbeobachtungspunkt(KURVE VARkurve,REAL VARzeit,ZUSTAND VARz):IF NOTendedestabspeichers(kurve)THENzeitlesen;koordinatenlesen;kurve.bpunkte.zeilenpositionINCR1ELSEz:=neuerzustand(kurve.internedimension-1)FI.zeitlesen:zeit:=kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).zeit.koordinatenlesen:z:=zustand(kurve.bpunkte.tupel(kurve.bpunkte.zeilenposition).vektor).END PROClesenaechstenbeobachtungspunkt;BOOL PROCendederloesung(KURVE VARkurve):kurve.punkte.zeilenposition>=kurve.punkte.zeilenEND PROCendederloesung;BOOL PROCanfangderloesung(KURVE VARkurve):kurve.punkte.zeilenposition<=1END PROCanfangderloesung;BOOL PROCendedestabspeichers(KURVE CONSTkurve):kurve.bpunkte.zeilenposition>kurve.bpunkte.zeilenEND PROCendedestabspeichers;OP:=(KURVE VARa,KURVE CONSTb):CONCR(a):=old(b.dsname)END OP:=;PROCcopy(KURVE VARa,TEXT CONSTdsname,KURVE CONSTb):IFexists(dsname)THENforget(dsname,
+quiet)FI;copy(b.dsname,dsname);CONCR(a):=old(dsname);a.dsname:=dsname;ENDPROCcopy;OP:=(ZUSTAND VARa,ZUSTAND CONSTb):a.dimension:=b.dimension;INT VARi;FORiFROM1UPTOb.dimensionREP IFdecimalexponent(b.koordinate(i))<-126THENa.koordinate(i):=0.0ELSEa.koordinate(i):=b.koordinate(i)FI PER END OP:=;OP:=(PARAMETER VARa,PARAMETER CONSTb):a.vektor:=b.vektorEND OP:=;OP CAT(KURVE VARa,b):ersterpunkt;ersterbpunkt;WHILEnochplatzda(a)CAND NOTendederloesung(b)REPfuegenaechstenpunktanPER;WHILEnochtabplatzda(a)CAND NOTendedestabspeichers(b)REPfuegenaechstenbeobachtungspunktanPER.ersterpunkt:REAL VARt;ZUSTAND VARz;leseersten(b,t,z);a.punkte.zeilenposition:=a.punkte.zeilen+1.ersterbpunkt:leseerstenbeobachtungspunkt(b,t,z);a.bpunkte.zeilenposition:=a.bpunkte.zeilen+1.fuegenaechstenpunktan:lesenaechsten(b,t,z);schreibe(a,t,z).fuegenaechstenbeobachtungspunktan:lesenaechstenbeobachtungspunkt(b,t,z);a.bpunkte.tupel(a.bpunkte.zeilenposition).vektor:=text(z);a.bpunkte.tupel(a.bpunkte.zeilenposition).zeit:=t;a.bpunkte.zeilenpositionINCR1;a.bpunkte.zeilenINCR1.END OP CAT;ZUSTAND PROCletzterwert(KURVE CONSTkurve):zustand(kurve.punkte.tupel(kurve.punkte.zeilen).vektor)END PROCletzterwert;REAL PROCletztezeit(KURVE CONSTkurve):IFkurve.punkte.zeilen=0THEN0.0ELSEkurve.punkte.tupel(kurve.punkte.zeilen).zeitFI END PROCletztezeit;REAL CONSTsechzehnneuntel:=16.0/9.0,vierundsechzigneuntel:=64.0/9.0,zweihundertsechsundfuenfzigneuntel:=256.0/9.0,neunviertel:=9.0/4.0;PROCdiffsys(REAL VARx,h0,zwischenzeit,ZUSTAND VARy,s,zwischenzustand,PARAMETER CONSTp,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)funk):REAL VARa,b,b1,c,g,u,v,ta,fc;INT VARi,j,k,kk,jj,l,m,r,sr,n,kplus1,jplus1,jjplus1;ZUSTAND VARya,yl,ym,dy,dz;BOOL VARkonv,bo,bh;ROW7ZUSTAND VARdt;ROW7REAL VARd;ROW8ZUSTAND VARyg,yh;enablestop;initialisierungen;berechneschrittweitefallsnoetig;REPa:=h0+x;fc:=1.5;bo:=FALSE;m:=1;r:=2;sr:=3;jj:=-1;FORjFROM0UPTO9REPabbruchfallsgewuenscht;jplus1:=j+1;IFboTHENd(2):=sechzehnneuntel;d(4):=vierundsechzigneuntel;d(6):=zweihundertsechsundfuenfzigneuntelELSEd(2):=neunviertel;d(4):=9.0;d(6):=36.0FI;konv:=(j>2);IFj>6THENl:=6;d(7):=64.0;fc:=0.6*fcELSEl:=j;d(jplus1):=real(m*m)FI;m:=m+m;g:=h0/real(m);b:=g+g;IFbhCANDj<8THEN FORiFROM1UPTOnREPym.koordinate(i):=yh(jplus1).koordinate(i);yl.koordinate(i):=yg(jplus1).koordinate(i)PER ELSEkk:=(m-2)DIV2;m:=m-1;FORiFROM1UPTOnREPyl.koordinate(i):=ya.koordinate(i);ym.koordinate(i):=ya.koordinate(i)+(g*dz.koordinate(i));PER;FORkFROM1UPTOmREPdy:=funk(x+(real(k)*g),ym,p);FORiFROM1UPTOnREPu:=(yl.koordinate(i))+b*(dy.koordinate(i));yl.koordinate(i):=ym.koordinate(i);ym.koordinate(i):=u;u:=abs(u);IFu>s.koordinate(i)THENs.koordinate(i):=uFI PER;IFk=kkCANDk<>2THENjj:=1+jj;jjplus1:=jj+1;yh(jjplus1).koordinate:=ym.koordinate;zwischenzustand.koordinate:=ym.koordinate;yg(jjplus1).koordinate:=yl.koordinate;zwischenzeit:=x+(real(k+1)*g);FI PER FI;dy:=funk(a,ym,p);FORiFROM1UPTOnREPv:=dt(1).koordinate(i);dt(1).koordinate(i):=(ym.koordinate(i)+yl.koordinate(i)+g*dy.koordinate(i))/2.0;c:=dt(1).koordinate(i);ta:=c;FORkFROM1UPTOlREPkplus1:=k+1;b1:=d(kplus1)*v;b:=b1-c;u:=v;IFabs(b)>0.0THENb:=(c-v)/b;u:=c*b;c:=b1*b;FI;v:=dt(kplus1).koordinate(i);dt(kplus1).koordinate(i):=u;ta:=u+taPER;IFabs(y.koordinate(i)-ta)>eps*s.koordinate(i)THENkonv:=FALSE FI;y.koordinate(i):=taPER;IFkonvTHENendeFI;d(3):=4.0;d(5):=16.0;bo:=NOTbo;m:=r;r:=sr;sr:=m+mPER;bh:=NOTbh;IFdecimalexponent(h0)>-120THENh0:=(h0/2.0);IFkleinstmoeglicheschrittweite(x,h0)>h0THENh0:=h0+h0;endeFI;ELSEendeFI PER.abbruchfallsgewuenscht:IFincharety=stoptasteTHENerrorstop(abbruch,"");FI;.initialisierungen:n:=y.dimension;IFn=0THENzwischenzeit:=x+h0/2.0;x:=x+h0;LEAVEdiffsys;FI;ya.dimension:=n;yl.dimension:=n;ym.dimension:=n;dy.dimension:=n;dz.dimension:=n;FORiFROM1UPTOnREPya.koordinate(i):=0.0;yl.koordinate(i):=0.0;ym.koordinate(i):=0.0;dy.koordinate(i):=0.0;dz.koordinate(i):=0.0;PER;FORiFROM1UPTO7REP FORjFROM1UPTOnREPdt(i).koordinate(j):=0.0PER;d(i):=0.0;dt(i).dimension:=n;PER;FORiFROM1UPTO8REP FORjFROM1UPTOnREPyg(i).
+koordinate(j):=0.0;yh(i).koordinate(j):=0.0PER;yg(i).dimension:=n;yh(i).dimension:=n;PER;dz:=funk(x,y,p);bh:=FALSE;ya.koordinate:=y.koordinate;.berechneschrittweitefallsnoetig:IFkomponentennahe0THENberechneschrittweite(y,dz,x,h0)FI.komponentennahe0:FORiFROM1UPTOnREP IFabs(ySUBi)<minhCORabs(dzSUBi)<minhTHEN LEAVEkomponentennahe0WITH TRUE FI;PER;FALSE.ende:h0:=fc*h0;x:=a;LEAVEdiffsys.ENDPROCdiffsys;PROCberechneschrittweite(ZUSTAND CONSTy,dz,REAL CONSTt,REAL VARh0):INT CONSTn:=y.dimension;INT VARi;REAL CONSTh:=h0;FORiFROM1UPTOnREP IFabs(dzSUBi)>0.0CANDabs(ySUBi)>0.0THENh0:=min(h0,abs((ySUBi)/(dzSUBi)));FI;PER;IFh0=0.0THENh0:=hFI;h0:=max(h0,kleinstmoeglicheschrittweite(t,h0));.END PROCberechneschrittweite;REAL PROCkleinstmoeglicheschrittweite(REAL CONSTt,h0):REAL VARzw:=5.0;INT CONSTexponentvont:=decimalexponent(t);IFt=0.0THENh0ELIF(exponentvont-decimalexponent(h0))>12THENsetexp(exponentvont-12,zw);zwELSEh0FI.END PROCkleinstmoeglicheschrittweite;KURVE PROCkurve1(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)fkt,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,ZUSTAND CONSTanfangswert,ZUSTAND CONSTunteregrenze,oberegrenze,REAL CONSTanfangszeitpunkt,REAL CONSTbeobachtungsdauer,PARAMETER CONSTparameter,INT CONSTbeo,codimension,TEXT CONSTdsname,INT VARfehler):KURVE VARkurve:=neuekurve(codimension+anfangswert.dimension,dsname);bereiteanfangvor;bearbeiteerstenpunkt;bearbeiteallenaechstenpunkte;kurve.bereiteanfangvor:INT VARm,n:=anfangswert.dimension;REAL VARbeobachtungszeitpunkt,beobachtungsabstand:=0.0,t,h0,h,hmax,zwischenzeit;ZUSTAND VARx:=neuerzustand(n),zwischenzustand:=neuerzustand(n),s:=neuerzustand(n);beobachtungsabstand:=beobachtungsdauer/real(beo-1);beobachtungsabstand:=max(kleinstmoeglicheschrittweite(anfangszeitpunkt,beobachtungsabstand),beobachtungsabstand);h0:=beobachtungsabstand;hmax:=h0;x:=anfangswert;t:=anfangszeitpunkt;berechneschrittweitemittest;beobachtungszeitpunkt:=anfangszeitpunkt;fehler:=0.berechneschrittweitemittest:disablestop;berechneschrittweite(x,fkt(t,x,parameter),t,h0);IFerrorda(fehler)CORbeobachtungsdauer=0.0THENfehler:=kurveleer;LEAVEkurve1WITHkurveFI.bearbeiteerstenpunkt:schreibeundtestebeomitcof(PROCcofkt,kurve,anfangszeitpunkt,anfangswert,parameter,fehler);IFaufgetreten(fehler)CORbeobachtungsdauer=0.0THENfehler:=kurveleer;LEAVEkurve1WITHkurveFI.bearbeiteallenaechstenpunkte:INT VARcursx:=0,cursy:=0;getcursor(cursx,cursy);FORmFROM1UPTObeo-1REPcursor(cursx,cursy);out(text(m));beobachtungszeitpunkt:=beobachtungszeitpunkt+beobachtungsabstand;verarbeitenaechstepunkte;IFaufgetreten(fehler)THEN LEAVEbearbeiteallenaechstenpunkteFI;schreibeundtestepunktmitcof(PROCcofkt,kurve,zwischenzeit,zwischenzustand,parameter,fehler);IF NOTaufgetreten(fehler)THENschreibeundtestebeomitcof(PROCcofkt,kurve,t,x,parameter,fehler);FI;IFaufgetreten(fehler)THEN LEAVEkurve1WITHkurveFI;PER.verarbeitenaechstepunkte:REP IFh0>hmaxTHENh0:=hmaxFI;IFt+h0>beobachtungszeitpunktTHENh:=h0;h0:=beobachtungszeitpunkt-t;IFh0>=kleinstmoeglicheschrittweite(t,h0)THENerhaltenaechstenpunkt;ELSE LEAVEverarbeitenaechstepunkteFI;h0:=hELSEerhaltenaechstenpunktFI;IFabs(t-beobachtungszeitpunkt)<nullTHEN LEAVEverarbeitenaechstepunkteELIFt>beobachtungszeitpunktTHEN LEAVEverarbeitenaechstepunkteFI;schreibepunktinkurvePER.erhaltenaechstenpunkt:disablestop;diffsys(t,h0,zwischenzeit,x,s,zwischenzustand,parameter,PROCfkt);IF NOTerrorda(fehler)THENfehler:=imdefbereich(x,unteregrenze,oberegrenze);FI;IFaufgetreten(fehler)THEN LEAVEverarbeitenaechstepunkteFI;.schreibepunktinkurve:schreibeundtestepunktmitcof(PROCcofkt,kurve,zwischenzeit,zwischenzustand,parameter,fehler);IFaufgetreten(fehler)THEN LEAVEkurve1WITHkurveFI.END PROCkurve1;BOOL PROCaufgetreten(INT CONSTfehler):fehler<>0.END PROCaufgetreten;PROCschreibeundtestepunktmitcof(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,KURVE VARkurve,REAL CONSTzwischenzeit,ZUSTAND CONSTzwischenzustand,PARAMETER CONSTparamliste,INT VARfehlernr):ZUSTAND VARhilfsvar;disablestop;hilfsvar:=cofkt(
+zwischenzeit,zwischenzustand,paramliste);IF NOTerrorda(fehlernr)THENschreibe(kurve,zwischenzeit,zwischenzustandPLUShilfsvar);FI;END PROCschreibeundtestepunktmitcof;PROCschreibeundtestebeomitcof(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cofkt,KURVE VARkurve,REAL CONSTzeitpunkt,ZUSTAND CONSTzwischenzustand,PARAMETER CONSTparamliste,INT VARfehlernr):ZUSTAND VARhilfsvar;disablestop;hilfsvar:=cofkt(zeitpunkt,zwischenzustand,paramliste);IF NOTerrorda(fehlernr)THENschreibebeobachtungspunkt(kurve,zeitpunkt,zwischenzustandPLUShilfsvar);FI;.END PROCschreibeundtestebeomitcof;BOOL PROCerrorda(INT VARerrornr):IFiserrorTHENsetzeerrornr;clearerror;enablestop;TRUE ELSEerrornr:=0;FALSE FI.setzeerrornr:IFerrorcode=abbruchTHENerrornr:=abbruchELSEerrornr:=1FI.END PROCerrorda;INT PROCimdefbereich(ZUSTAND CONSTz,zug,zog):INT CONSTn:=z.dimension;INT VARi,fehler:=0;FORiFROM1UPTOnREPpruefekomponentePER;fehler.pruefekomponente:IF(z.koordinate(i)-zug.koordinate(i)<minusdelta)COR(z.koordinate(i)-zog.koordinate(i)>delta)THENfehler:=2FI.END PROCimdefbereich;END PACKETzustaendeparameterkurve;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur
new file mode 100644
index 0000000..7ef9540
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 1.korrektur
@@ -0,0 +1,4 @@
+PACKETlsdialog1DEFINESeckeobenlinks,balkenoben,eckeobenrechts,balkenrechts,eckeuntenlinks,balkenlinks,eckeuntenrechts,balkenunten,waagerecht,senkrecht,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t
+);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile).END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONST
+spa,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT"  ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT"  ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutinverswithbeam;END PACKETlsdialog1;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel
new file mode 100644
index 0000000..b2a5323
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 2.simsel
@@ -0,0 +1,9 @@
+PACKETls dialog 2DEFINES some, one,ls exit key,some with max, some exactly,double some,infix namen,ohne praefix,not empty:LET maxentries=200;LET zeichenstring= ""1""27""3""10""13""12""8""2"o ?",oben untenreturnruboutkringelblank=""3""10""13""12"o ",qeinsneunh="w19m";LETzurueck=""8"",piep=""7"",hop=1,esc=2,oben=3,unten=4,return=5,rubout=6,links=7,rechts=8,kringel=9,leertaste=10,fragezeichen=11,letztes zeichen=11;LET punkt      =  ".",blank      =  " ";LET zwei thesauri = TRUE;
+INT VARx,y,xsize,ysize,maxeintraege,anzahl:=0,ersteauswahlzeile,virtuellercursor,reellercursor,ausgewaehlte,aufbauzaehler,minsel,maxsel;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="",hopmoeglichkeiten,eingabemoeglichkeiten;BOOL VARabbruch,auswahlende,wechsel,linkerth,info,parallelauswahl;THESAURUS VARthes1,thes2;DATASPACE VARds;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW18TEXT CONSThinweis:=ROW18TEXT:(" Bitte warten...!"," Info: <?>  Weiter: <ESC><w>  Menü: <ESC><m>","Weitere Einträge"," Info: <?>                    Menü: <ESC><m>","        INFORMATIONEN ZUR AUSWAHL AUS DER LISTE","  Positionierung der Schreibmarke:","  Pfeil auf/ab      : eine Position nach oben/unten","  HOP Pfeil auf/ab  : auf erste/letzte Pos. der Seite","  ESC 1/ESC 9       : auf erste/letzte Pos. der Liste","  Ankreuzen und Löschen von Kreuzen:","  RETURN/x          : den Eintrag ankreuzen","  RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen","  HOP RETURN/HOP x  : alle folgenden Eintr. ankreuzen","  HOP RUBOUT/HOP o  : alle folgenden Kreuze löschen","         /HOP Leertaste","Die Anzahl der ausgewählten Einträge ist falsch. Weiter mit beliebiger Taste"," Weiter mit beliebiger Taste!","  Pfeil links/rechts: zwischen den beiden Listen wechseln");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCauswahl(THESAURUS CONSTt,TEXT CONSTtext1,text2,TEXT VARmarkers):IFaufbauzaehler>0THENwerteinitialisieren;namenbesorgen;bildschirmaufbauen;wechsel:=TRUE END IF;IFparallelauswahlTHENaufbauzaehlerDECR1ELSEaufbauzaehlerDECR2END IF;IFaufbauzaehler<0THENauswaehlenlassenEND IF.werteinitialisieren:eintrag:=ds;kennzeile1:=text1;kennzeile2:=text2;abbruch:=FALSE;wechsel:=FALSE;virtuellercursor:=1;reellercursor:=1;ersteauswahlzeile:=y+4;anzahl:=0;eingabemoeglichkeiten:=zeichenstring+markers;hopmoeglichkeiten:=obenuntenreturnruboutkringelblank+markers;ausgewaehlte:=0;maxeintraege:=ysize-6.namenbesorgen:fischedienamenausdemthesaurus;registrierkette:=anzahl*"o";IFkeineintragvorhandenTHENabbruch:=TRUE;auswahlende:=TRUE;LEAVEauswahlFI.bildschirmaufbauen:gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1).auswaehlenlassen:kreuzean.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.END PROCauswahl;PROCreellencursorsetzen:INT CONSTmaxlaenge:=min(65,xsize-9);TEXT VARhilf:=marke(virtuellercursor);hilfCATzurueck;hilfCATinvers(subtext(eintrag(virtuellercursor),1,maxlaenge));cursor(x+1,ersteauswahlzeile+reellercursor-1);out(hilf)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x+1,ersteauswahlzeile-1);IFreellercursor=virtuellercursorTHENout((xsize-2)*punkt)ELSEout((xsize-length(hinweis[3])-5)*punkt);out(invers(hinweis[3]))FI;line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);outtext(marke(zeiger)+subtext(eintrag[zeiger],1,65),1,xsize-4);out("  ");PER.gibfusszeileaus:cursor(x+1,ersteauswahlzeile+zaehler+1);IF NOT((virtuellercursor+maxeintraege-reellercursor)<anzahl)THENout((xsize-2)*punkt)ELSEout((xsize-length(hinweis[3])-5)*punkt+invers(hinweis[3]));FI.loescheggfrestbereich:IFzaehler+1<maxeintraegeTHENloeschebildschirmrestFI.loeschebildschirmrest:TEXT VARzeile:=(xsize-2)*blank;FORzeigerFROMrestanfangUPTOrestendeREPcursor(x+1,zeiger);out(zeile)PER.restanfang:ersteauswahlzeile+zaehler+2.restende:ersteauswahlzeile+maxeintraege.grenze:min(anzahl,anfang+maxeintraege-1).END PROCbauebildschirmauf;TEXT PROCmarke(INT CONSTzeiger):"   "+(registrierketteSUBzeiger)+" ".END PROCmarke;BOOL PROCangekreuzt(INT CONSTzeiger):(registrierketteSUBzeiger)<>"o"END PROC
+angekreuzt;PROCkreuzean:auswahlende:=FALSE;wechsel:=FALSE;reellencursorsetzen;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;inchar(zeichen).zeicheninterpretieren:SELECTpos(eingabemoeglichkeiten,zeichen)OF CASEhop:hopkommandoverarbeitenCASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEreturn:ankreuzenweiter;evtlaufhoerenCASErubout:auskreuzenweiterCASEkringel,leertaste:auskreuzen(virtuellercursor,TRUE)CASElinks:nachlinkswennerlaubtCASErechts:nachrechtswennerlaubtCASEfragezeichen:info:=TRUE;auswahlende:=TRUE CASE0:out(piep)OTHERWISEankreuzen(virtuellercursor,zeichen,TRUE);evtlaufhoerenEND SELECT.evtlaufhoeren:IFmaxsel=1THENauswahlende:=TRUE;IFparallelauswahlTHENwechsel:=TRUE END IF;loeschecursor;LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten:zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;inchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(hopmoeglichkeiten,zweiteszeichen)OF CASE0:out(piep)CASE1:hopnachobenCASE2:hopnachuntenCASE3:zweiteszeichen:=eingabemoeglichkeitenSUB(letzteszeichen+1);alledarunterankreuzenCASE4,5,6:alledarunterloeschenOTHERWISEalledarunterankreuzenEND SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREPankreuzen(i,zweiteszeichen,FALSE)PER;bildaktualisieren;reellencursorsetzen.alledarunterloeschen:INT VARj;FORjFROMvirtuellercursorUPTOanzahlREPauskreuzen(j,FALSE)PER;bildaktualisieren;reellencursorsetzen.hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaetternELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschecursor;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschecursor;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:pruefeobausstiegerlaubtCASE2:zeigeanfangCASE3:zeigeendeCASE4:loeschecursor;abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschecursor;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschecursor;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)<maxeintraege+1.pruefeobausstiegerlaubt:IFausgewaehlte>=minselANDausgewaehlte<=maxselTHENloeschecursor;auswahlende:=TRUE ELSEout(piep);footnote(hinweis[16]);pause;IFmaxsel>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF END IF END PROCesckommandoverarbeiten;PROCankreuzen(INT CONSTeintrag,TEXT CONSTzeichen,BOOL CONSTcursorsetzen):IF NOTangekreuzt(eintrag)THENausgewaehlteINCR1END IF;replace(registrierkette,eintrag,zeichen);IFcursorsetzenTHENreellencursorsetzen;END IF END PROCankreuzen;PROCankreuzenweiter:ankreuzen(virtuellercursor,
+eingabemoeglichkeitenSUB(letzteszeichen+1),FALSE);IFvirtuellercursor<anzahlTHENnachuntenFI;IFvirtuellercursor=anzahlTHENreellencursorsetzenFI END PROCankreuzenweiter;PROCauskreuzenweiter:IF NOTangekreuzt(virtuellercursor)THENout(piep);LEAVEauskreuzenweiterFI;auskreuzen(virtuellercursor,FALSE);IFvirtuellercursor<anzahlTHENnachuntenELSEloeschecursorFI;reellencursorsetzen.END PROCauskreuzenweiter;PROCauskreuzen(INT CONSTeintrag,BOOL CONSTcursorsetzen):IFcursorsetzenTHEN IF NOTangekreuzt(eintrag)THENout(piep);LEAVEauskreuzenELSEreplace(registrierkette,eintrag,"o");ausgewaehlteDECR1;reellencursorsetzen;END IF ELSE IFangekreuzt(eintrag)THENausgewaehlteDECR1END IF;replace(registrierkette,eintrag,"o")END IF END PROCauskreuzen;PROCbildaktualisieren:INT VARob,un,i,zaehler:=-1;ob:=virtuellercursor-reellercursor+1;un:=min(ob+maxeintraege-1,anzahl);FORiFROMobUPTOunREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);out(marke(i))PER END PROCbildaktualisieren;PROCnachoben:IFnochnichtobenTHENgehenachobenELSEout(piep)FI.nochnichtoben:virtuellercursor>1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschecursor;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursor<anzahl.gehenachunten:IFreellercursor>maxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschecursor;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCnachlinkswennerlaubt:IFparallelauswahlAND NOTlinkerthTHENwechsel:=TRUE;auswahlende:=TRUE;loeschecursorELSEout(piep)END IF END PROCnachlinkswennerlaubt;PROCnachrechtswennerlaubt:IFparallelauswahlANDlinkerthTHENwechsel:=TRUE;auswahlende:=TRUE;loeschecursorELSEout(piep)END IF END PROCnachrechtswennerlaubt;PROCloeschecursor:cursor(x+1,ersteauswahlzeile+reellercursor-1);outtext(marke(virtuellercursor)+subtext(eintrag(virtuellercursor),1,65),1,xsize-4);out("  ");END PROCloeschecursor;PROCgibhinweisaus(TEXT CONSTt1,t2):cursor(x+1,y+1);out(center(xsize-2,invers(t1)));cursor(x+1,y+2);out(center(xsize-2,t2));END PROCgibhinweisaus;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<39COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5)COR(xsize<39AND NOTparallelauswahl)END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-8)THENsubtext(text,1,xsize-10)+".."ELSEtextFI END PROCggfgekuerztertext;PROCzeigebedieninfo(INT CONSTspalte,zeile,breite,hoehe):INT VARi,extrazeile:=0;IFparallelauswahlTHENextrazeile:=1END IF;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(spalte+1,zeile+1);out(center(breite-2,hinweis[5]));cursor(spalte+1,zeile+2);out("",breite-2).notierepositionierhinweise:cursor(spalte+1,zeile+3);out(hinweis[6],breite-2);cursor(spalte+1,zeile+4);out("",breite-2);IFparallelauswahlTHENcursor(spalte+1,zeile+5);out(hinweis[18],breite-2)END IF;FORiFROM5UPTO7REPcursor(spalte+1,zeile+i+extrazeile);out(hinweis[i+2],breite-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(spalte+1,zeile+8+extrazeile);out("",breite-2);cursor(spalte+1,zeile+9+extrazeile);out(hinweis[10],breite-2);cursor(spalte+1,zeile+10+extrazeile);out("",breite-2);FORiFROM11UPTO15REPcursor(spalte+1,zeile+i+extrazeile);out(hinweis[i],breite-2)PER;loeschedierestlichenzeilen;footnote(hinweis[17]);
+cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMzeile+16+extrazeileUPTOzeile+hoehe-2REPcursor(spalte+1,i);out("",breite-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[17]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8+extrazeileUPTOhoehe-2REPcursor(spalte+1,zeile+zaehler);out("",breite-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(spalte+1,zeile+3);out(hinweis[10],breite-2);cursor(spalte+1,zeile+4);out("",breite-2);FORiFROM5UPTO9REPcursor(spalte+1,zeile+i);out(hinweis[i+6],breite-2)PER;FORzaehlerFROM10UPTOhoehe-2REPcursor(spalte+1,zeile+zaehler);out("",breite-2)PER.cursorinruhestellung:cursor(spalte+1,zeile+hoehe-1).stellealtenbildschirmzustandwiederher:clearbuffer;pause;IFparallelauswahlORmaxsel>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[4])END IF.nochplatzvorhanden:hoehe>16+extrazeileEND PROCzeigebedieninfo;THESAURUS PROCinit(INT CONSTspalte,zeile,breite,hoehe,lminauswahl,lmaxauswahl,rminauswahl,rmaxauswahl,THESAURUS CONSTth1,th2,BOOL CONSTzweith,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):INT VARlx,rx,lxsize,rxsize,lvirtcursor,rvirtcursor,lsel:=0,rsel:=0,lanzahl:=0,ranzahl:=0;TEXT VARlregistrierkette,rregistrierkette,lhopmoeglichkeiten,leingabemoeglichkeiten,rhopmoeglichkeiten,reingabemoeglichkeiten,text1,text2,text3,text4;DATASPACE VARlds,rds;AREA VARa;ueberpruefegroesse;IFzweithTHENsteuerezweithesaurusauswahlenELSEsteuereeinethesaurusauswahlEND IF.ueberpruefegroesse:fill(a,spalte,zeile,breite,hoehe+1).steuerezweithesaurusauswahlen:doppelinit;REPEATbearbeitelinkenthesaurus;wechslevonlinksnachrechts;bearbeiterechtenthesaurus;wechslevonrechtsnachlinks;PER;emptythesaurus.steuereeinethesaurusauswahl:einzelinit;minsel:=lminauswahl;maxsel:=lmaxauswahl;REPauswahl(th1,text1,text2,lmarkers);IFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);info:=FALSE;auswahlende:=FALSE;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF UNTILauswahlendeEND REPEAT;einzelaufraeumen.einzelinit:aufbauzaehler:=1;x:=spalte;y:=zeile;xsize:=breite;ysize:=hoehe;info:=FALSE;auswahlende:=FALSE;parallelauswahl:=FALSE;ds:=nilspace;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);zeichneeinzelkasten;setzestdfussnote.zeichneeinzelkasten:fill(a,x+1,y+1,xsize-2,ysize-2);outframe(a).einzelaufraeumen:footnote(hinweis[1]);thes1:=emptythesaurus;lmarkers:="";IF NOTabbruchTHENthes1:=erzeugeausgabe(registrierkette,lmarkers);END IF;forget(lds);forget(rds);forget(ds);thes1.doppelinit:aufbauzaehler:=2;lx:=spalte;lxsize:=(breite+1)DIV2;rx:=spalte+lxsize-1;rxsize:=lxsize;lvirtcursor:=1;rvirtcursor:=1;lregistrierkette:="";rregistrierkette:="";leingabemoeglichkeiten:="";lhopmoeglichkeiten:="";reingabemoeglichkeiten:="";rhopmoeglichkeiten:="";lanzahl:=1;ranzahl:=1;lds:=nilspace;rds:=nilspace;thes1:=emptythesaurus;thes2:=emptythesaurus;y:=zeile;ysize:=hoehe;x:=lx;xsize:=lxsize;forget(ds);ds:=lds;parallelauswahl:=TRUE;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);text3:=ggfgekuerztertext(t3);text4:=ggfgekuerztertext(t4);untersuchebildschirmmasszahlen(text1,text2);schreibedoppelkasten;footnote(hinweis[2]).bearbeitelinkenthesaurus:linkerth:=TRUE;auswahl(th1,text1,text2,lmarkers);lsel:=ausgewaehlte;IFabbruchTHENbearbeiteabbruchELIFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);schreibemittellinie;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)ELIF NOTwechselTHEN IFrsel>=rminauswahlANDrsel<=rmaxauswahlTHENforget(lds);lds:=ds;lregistrierkette:=registrierkette;lanzahl:=anzahl;abganginordnungELSEauswahlendeungueltigEND IF END IF.wechslevonlinksnachrechts:x:=rx;xsize:=rxsize;wechsel:=FALSE;lanzahl:=anzahl;anzahl:=ranzahl;auswahlende:=FALSE;lvirtcursor:=virtuellercursor-reellercursor+1;virtuellercursor:=rvirtcursor;reellercursor:=1;lregistrierkette:=registrierkette;registrierkette:=rregistrierkette;lhopmoeglichkeiten:=hopmoeglichkeiten;hopmoeglichkeiten:=
+rhopmoeglichkeiten;leingabemoeglichkeiten:=eingabemoeglichkeiten;eingabemoeglichkeiten:=reingabemoeglichkeiten;ausgewaehlte:=rsel;forget(lds);lds:=ds;forget(ds);ds:=rds;forget(rds);minsel:=rminauswahl;maxsel:=rmaxauswahl;linkerth:=FALSE;IFinfoTHENinfo:=FALSE;auswahlende:=FALSE;gibhinweisaus(text3,text4);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF.bearbeiterechtenthesaurus:auswahl(th2,text3,text4,rmarkers);rsel:=ausgewaehlte;IFabbruchTHENbearbeiteabbruchELIFinfoTHENzeigebedieninfo(spalte,zeile,breite,hoehe);schreibemittellinie;gibhinweisaus(text3,text4);bauebildschirmauf(virtuellercursor-reellercursor+1)ELIF NOTwechselTHEN IFlsel>=lminauswahlANDlsel<=lmaxauswahlTHENforget(rds);rds:=ds;rregistrierkette:=registrierkette;ranzahl:=anzahl;abganginordnungELSEauswahlendeungueltigEND IF END IF.wechslevonrechtsnachlinks:x:=lx;xsize:=lxsize;wechsel:=FALSE;auswahlende:=FALSE;rvirtcursor:=virtuellercursor-reellercursor+1;virtuellercursor:=lvirtcursor;reellercursor:=1;rregistrierkette:=registrierkette;registrierkette:=lregistrierkette;rhopmoeglichkeiten:=hopmoeglichkeiten;hopmoeglichkeiten:=lhopmoeglichkeiten;reingabemoeglichkeiten:=eingabemoeglichkeiten;eingabemoeglichkeiten:=leingabemoeglichkeiten;ausgewaehlte:=lsel;forget(rds);rds:=ds;forget(ds);ds:=lds;forget(lds);minsel:=lminauswahl;maxsel:=lmaxauswahl;ranzahl:=anzahl;anzahl:=lanzahl;IFinfoTHENinfo:=FALSE;auswahlende:=FALSE;gibhinweisaus(text1,text2);bauebildschirmauf(virtuellercursor-reellercursor+1)END IF.abganginordnung:footnote(hinweis[1]);eintrag:=lds;anzahl:=lanzahl;thes1:=erzeugeausgabe(lregistrierkette,lmarkers);eintrag:=rds;anzahl:=ranzahl;thes2:=erzeugeausgabe(rregistrierkette,rmarkers);forget(lds);forget(rds);forget(ds);LEAVEinitWITHemptythesaurus.bearbeiteabbruch:footnote(hinweis[1]);lmarkers:="";rmarkers:="";forget(lds);forget(rds);forget(ds);LEAVEinitWITHemptythesaurus.auswahlendeungueltig:out(piep);footnote(hinweis[16]);pause;footnote(hinweis[2]).setzestdfussnote:IFlmaxauswahl>1THENfootnote(hinweis[2])ELSEfootnote(hinweis[4])END IF.schreibedoppelkasten:fill(a,spalte+1,zeile+1,breite-2,hoehe-2);outframe(a);cursor(rx,zeile);out(balkenoben);schreibemittellinie;cursor(rx,zeile+hoehe-1);out(balkenunten).schreibemittellinie:INT VARi;FORiFROMzeile+1UPTOzeile+hoehe-2REPcursor(rx,i);out(senkrecht)PER END PROCinit;THESAURUS PROCerzeugeausgabe(TEXT CONSTkette,TEXT VARmarkers):INT VARi;THESAURUS VARausgabe:=emptythesaurus;markers:="";FORiFROM1UPTOanzahlREPEAT IF(ketteSUBi)<>"o"THENinsert(ausgabe,eintrag[i]);markersCAT(ketteSUBi);END IF PER;ausgabeEND PROCerzeugeausgabe;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROC
+ohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;THESAURUS PROCsome(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";init(spalte,zeile,breite,hoehe,0,maxentries,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return)END PROCsome;THESAURUS PROCsome(INT CONSTspalte,zeile,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spalte,zeile,79-spalte+1,24-zeile,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";init(1,1,79,23,0,maxentries,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return)END PROCsome;TEXT PROCone(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";name(init(spalte,zeile,breite,hoehe,0,1,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return),1)END PROCone;TEXT PROCone(INT CONSTspalte,zeile,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spalte,zeile,79-spalte+1,24-zeile,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTth,TEXT CONSTt1,t2):TEXT VARreturn:="x";name(init(1,1,79,23,0,1,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",return,return),1)END PROCone;PROCdoublesome(INT CONSTzeile,hoehe,leftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4):TEXT VARreturn:="x";th1:=init(1,zeile,79,hoehe,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,return,return);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTleftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4):TEXT VARreturn:="x";th1:=init(1,1,79,23,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,return,return);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTzeile,hoehe,leftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):th1:=init(1,zeile,79,hoehe,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,lmarkers,rmarkers);th1:=thes1;th2:=thes2;END PROCdoublesome;PROCdoublesome(INT CONSTleftmin,leftmax,rightmin,rightmax,THESAURUS VARth1,th2,TEXT CONSTt1,t2,t3,t4,TEXT VARlmarkers,rmarkers):th1:=init(1,1,79,23,leftmin,leftmax,rightmin,rightmax,th1,th2,zweithesauri,t1,t2,t3,t4,lmarkers,rmarkers);th1:=thes1;th2:=thes2;END PROCdoublesome;THESAURUS PROCsomewithmax(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2,TEXT VARmarkers):init(spalte,zeile,breite,hoehe,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomewithmax;THESAURUS PROCsomewithmax(THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2,TEXT VARmarkers):init(1,1,79,23,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomewithmax;THESAURUS PROCsomewithmax(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2):TEXT VARmarker:="x";init(spalte,zeile,breite,hoehe,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",marker,marker)END PROCsomewithmax;THESAURUS PROCsomewithmax(THESAURUS CONSTth,INT CONSTmax,TEXT CONSTt1,t2):TEXT VARmarker:="x";init(1,1,79,23,0,max,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",marker,marker)END PROCsomewithmax;THESAURUS PROCsomeexactly(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2):TEXT VARtx:="x";init(spalte,zeile,breite,hoehe,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",tx,tx)END PROCsomeexactly;THESAURUS PROCsomeexactly(THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2):TEXT VARtx:="x";init(1,1,79,23,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",tx,tx)END PROCsomeexactly;THESAURUS PROC
+someexactly(INT CONSTspalte,zeile,breite,hoehe,THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2,TEXT VARmarkers):init(spalte,zeile,breite,hoehe,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomeexactly;THESAURUS PROCsomeexactly(THESAURUS CONSTth,INT CONSTanzahl,TEXT CONSTt1,t2,TEXT VARmarkers):init(1,1,79,23,anzahl,anzahl,0,0,th,emptythesaurus,NOTzweithesauri,t1,t2,"","",markers,markers)END PROCsomeexactly;END PACKETlsdialog2;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur
new file mode 100644
index 0000000..3408f21
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 3.korrektur
@@ -0,0 +1,3 @@
+PACKETlsdialog3DEFINES WINDOW,:=,window,show,page,erase,line,remaininglines,cursor,getcursor,outframe,outmenuframe,out,put,putline,get,getline,yes,no,edit,center,stop,area,areax,areay,areaxsize,areaysize:LETpiep="�",cr="
";LETjaneinkette="jJyYnN",blank=" ",niltext="";TYPE WINDOW=STRUCT(AREAfenster,INTcspalte,czeile,belegbarezeilen,BOOLfensterendeerreicht);ROW3TEXT CONSTaussage:=ROW3TEXT:(" 'Window' ungültig!"," (j/n) ?"," Weiter mit beliebiger Taste!");TEXT VARnumberword,exitchar;OP:=(WINDOW VARlinks,WINDOW CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;WINDOW PROCwindow(INT CONSTx,y,xsize,ysize):WINDOW VARw;fill(w.fenster,x,y,xsize,ysize);initialize(w);wEND PROCwindow;PROCinitialize(WINDOW VARw):w.czeile:=1;w.cspalte:=1;w.fensterendeerreicht:=FALSE;w.belegbarezeilen:=areaysize(w.fenster)END PROCinitialize;PROCshow(WINDOW VARw):zeigerahmen;fensterputzen.zeigerahmen:outframe(w.fenster).fensterputzen:page(w).END PROCshow;PROCpage(WINDOW VARw):initialize(w);page(w,FALSE)END PROCpage;PROCpage(WINDOW CONSTw,BOOL CONSTmitrahmen):IFareax(w)=1ANDareay(w)=1ANDareaxsize(w)=79ANDareaysize(w)=24THENpage;ELSEloeschebereichFI.loeschebereich:IFmitrahmenTHENpage(areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2)ELSEpage(area(w))FI END PROCpage;PROCerase(WINDOW VARw):page(w,TRUE)END PROCerase;PROCline(WINDOW VARw):w.cspalte:=1;IFw.czeile<w.belegbarezeilenTHENw.czeileINCR1;ELSEw.czeile:=1;w.fensterendeerreicht:=TRUE FI;cursor(w,w.cspalte,w.czeile)END PROCline;PROCline(WINDOW VARw,INT CONSTanzahl):INT VARi;FORiFROM1UPTOanzahlREPline(w)PER END PROCline;INT PROCremaininglines(WINDOW CONSTw):INT VARspalte,zeile;getcursor(w,spalte,zeile);IFspalte=0ORzeile=0THEN0ELSEw.belegbarezeilen-w.czeileFI END PROCremaininglines;PROCcursor(WINDOW VARw,INT CONSTspalte,zeile):IFspalte<1ORzeile<1ORspalte>areaxsize(w)ORzeile>areaysize(w)THENpage(w);ELSEw.cspalte:=spalte;w.czeile:=zeile;FI;cursor(w.fenster,w.cspalte,w.czeile)END PROCcursor;PROCgetcursor(WINDOW CONSTw,INT VARspalte,zeile):IF(w.cspalte<1)OR(w.cspalte>areaxsize(w.fenster))OR(w.czeile<1)OR(w.czeile>areaysize(w.fenster))THENspalte:=0;zeile:=0ELSEspalte:=w.cspalte;zeile:=w.czeileFI END PROCgetcursor;PROCout(WINDOW VARw,TEXT CONSTtext):INT VARrestlaenge;IF(w.cspalte>=1)AND(w.cspalte<=areaxsize(w.fenster))AND(w.czeile>=1)AND(w.czeile<=w.belegbarezeilen)THENputzeggffenster;cursor(w.fenster,w.cspalte,w.czeile);outtext(text,1,textende);setzefenstercursorneu;setzeausgabeggfinnaechsterzeilefortFI.putzeggffenster:IFw.fensterendeerreichtTHENpage(w);w.fensterendeerreicht:=FALSE FI.textende:restlaenge:=areaxsize(w.fenster)-w.cspalte+1;min(length(text),restlaenge).setzefenstercursorneu:IFlength(text)>=restlaengeTHENw.cspalte:=1;w.czeileINCR1;schlageggfneueseiteaufELSEw.cspalteINCRlength(text)FI.schlageggfneueseiteauf:IFw.czeile>w.belegbarezeilenTHENw.fensterendeerreicht:=TRUE;w.czeile:=1;w.cspalte:=1FI.setzeausgabeggfinnaechsterzeilefort:IFlength(text)>restlaengeTHENout(w,subtext(text,restlaenge+1))FI.END PROCout;PROCoutframe(WINDOW VARw):outframe(area(w))END PROCoutframe;PROCoutmenuframe(WINDOW VARw):outmenuframe(area(w))END PROCoutmenuframe;PROCput(WINDOW VARw,TEXT CONSTword):out(w,word);out(w,blank)END PROCput;PROCput(WINDOW VARw,INT CONSTnumber):put(w,text(number))END PROCput;PROCput(WINDOW VARw,REAL VARnumber):put(w,text(number))END PROCput;PROCputline(WINDOW VARw,TEXT CONSTtextline):out(w,textline);line(w)END PROCputline;PROCprivateget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator,INT CONSTlength):INT VARx,y;INT VARrestlaenge:=areaxsize(w.fenster)-w.cspalte-1;ggfzurnaechstenzeile;getcursor(x,y);cursoron;cursor(x,y);REPword:="";editget(word,laenge,laenge,separator,"",exitchar);out(w,word);echoeexitchar(w)UNTILword<>niltextANDword<>blankPER;cursoroff;deleteleadingblanks.ggfzurnaechstenzeile:IFrestlaenge<5THENline(w);restlaenge:=areaxsize(w.fenster)-2FI.deleteleadingblanks:WHILE(wordSUB1)=blankREPword:=subtext(word,2)PER.laenge:min(length,restlaenge).END PROCprivateget;PROCget(WINDOW VARw,TEXT VARword):
+privateget(w,word," ",maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator):privateget(w,word,separator,maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,INT CONSTlength):privateget(w,word,"",length)END PROCget;PROCget(WINDOW VARw,INT VARnumber):get(w,numberword);number:=int(numberword)END PROCget;PROCget(WINDOW VARw,REAL VARnumber):get(w,numberword);number:=real(numberword)END PROCget;PROCgetline(WINDOW VARw,TEXT VARtextline):privateget(w,textline,"",maxtextlength)END PROCgetline;PROCechoeexitchar(WINDOW VARfenster):IFexitchar=crTHENline(fenster)ELSEout(fenster,exitchar)FI END PROCechoeexitchar;TEXT PROCcenter(WINDOW CONSTw,TEXT CONSTtext):IFlength(text)>=areaxsize(w.fenster)THENsubtext(text,1,areaxsize(w.fenster))ELSEcenter(areaxsize(w.fenster),text)FI END PROCcenter;BOOL PROCyes(WINDOW VARw,TEXT CONSTfrage):TEXT VARzeichen,internefrage:=frage;internefrageCATaussage[2];wechselggfaufneueseite;out(w,internefrage);holeeingabezeichen;wertezeichenaus.wechselggfaufneueseite:IFremaininglines(w)<1THENpage(w)FI.holeeingabezeichen:cursoron;clearbuffer;REPinchar(zeichen);piepseggfUNTILpos(janeinkette,zeichen)>0PER;out(w,blank+zeichen);cursoroff;line(w).piepseggf:IFpos(janeinkette,zeichen)=0THENout(piep)FI.wertezeichenaus:IFpos(janeinkette,zeichen)<5THEN TRUE ELSE FALSE FI.END PROCyes;PROCedit(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);cursoron;edit(f,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoroffEND PROCedit;PROCedit(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);edit(w,f)END PROCedit;PROCshow(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);openeditor(groesstereditor+1,f,FALSE,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoron;edit(groesstereditor,"eqvw19dpgn�",PROC(TEXT CONST)stdkommandointerpreter);cursoroffEND PROCshow;PROCshow(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);show(w,f)END PROCshow;PROCloescherechtespalten(WINDOW VARw):INT VARi;FORiFROM1UPTOareaysize(w.fenster)REPcursor(w,areaxsize(w.fenster)-2,i);out("   ")PER END PROCloescherechtespalten;BOOL PROCno(WINDOW VARw,TEXT CONSTfrage):NOTyes(w,frage)END PROCno;PROCstop(WINDOW VARw):stop(w,2)END PROCstop;PROCstop(WINDOW VARw,INT CONSTzeilenzahl):INT VARi;FORiFROM1UPTOzeilenzahlREPline(w)PER;out(w,aussage[3]);pauseEND PROCstop;AREA PROCarea(WINDOW CONSTw):w.fensterEND PROCarea;INT PROCareax(WINDOW CONSTw):areax(w.fenster)END PROCareax;INT PROCareay(WINDOW CONSTw):areay(w.fenster)END PROCareay;INT PROCareaxsize(WINDOW CONSTw):areaxsize(w.fenster)END PROCareaxsize;INT PROCareaysize(WINDOW CONSTw):areaysize(w.fenster)END PROCareaysize;END PACKETlsdialog3
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd
new file mode 100644
index 0000000..a320e06
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 4.wd
@@ -0,0 +1,6 @@
+PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETmarkein=""15"",markaus=""14"",delimiter=""13"",piep=""7"",cleol=""5"",rechtslinksescreturn=""2""8""27""13"",rechtslinksnullreturn=""2""8""0""13"" ,gueltigezeichen=""10""3""13"",esc=""27"",auswahl="z",abbruch="m", 
+trennliniensymbol="-",blank=" ",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: <Pfeile>  Bestätigen: <RETURN>  Menü: <ESC><m>"," Wählen: <Pfeile>  Bestätigen: <RETURN>  Ja: <j>  Nein: <n>"," Wählen: <Pfeile>  Bestätigen: <RETURN>"," Bestätigen: <RETURN>  Zeigen: <ESC><z>  Menü: <ESC><m>"," Bestätigen: <RETURN>  Menü: <ESC><m>","Ja
Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):boxinfo(w,t,position,timelimit,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,PROC(AREA CONST)restore):boxinfo(w,t,5,maxint,TRUE,PROCrestore)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,ergebnis,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,TRUE)END PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):boxyes(w,t,position,TRUE)END PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt
+,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):NOTboxyes(w,t,position,trennlinieweg)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):boxanswer(w,t,vorgabe,position,TRUE)END PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswerone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswerone(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnoteFI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswersome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswersome(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize))
+PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+"  "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI.
+lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=compress(vorgabe);schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:=""ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahlELSEeingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabe.END PROCholeantwort;END PACKETlsdialog4;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur
new file mode 100644
index 0000000..8cee148
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.korrektur
@@ -0,0 +1,12 @@
+PACKETlsdialog5DEFINESwritehead,restorehead,setwindow2,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,menuanswerone,menuanswersome,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowget,menuwindoweditget,menuwindowedit,menuwindowshow,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,editorinformationen,stdinfoedit,menukartenname,currentmenuwindow,resetdialog,onlyintern,ausstieg,direktstart:LETsystemkuerzel="ls-DIALOG",menutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",stdmenukartenname="ls-MENUKARTE:Archiv",versionsnummer="1.1",copyright1=" (C) 1987/88 Eva Latta-Weber",copyright2=" (C) 1988 ERGOS GmbH";LETmaxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",cleol="�",cleop="�",trennzeilensymbol="###",bleibtleersymbol="***",hauptmenuluecke="  ";LETauswahlstring1="��
+�
�?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster,editorinfofenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,nurinterneverwendung:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;REAL VARzeitpunkt:=clock(1);ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:<ESC><?>/<?>  Wählen:<Pfeile>  Bestätigen:<RETURN> Verlassen:<ESC><q>"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine 

        Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt 

  kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;nurinterneverwendung:=FALSE FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(
+fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROConlyintern(BOOL CONSTwert):nurinterneverwendung:=wertEND PROConlyintern;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname):nurinterneverwendung:=FALSE;mitausstieg:=TRUE;handlemenu(menuname,"")END PROChandlemenu;PROChandlemenu(TEXT CONSTmenuname,ausstiegsproc):cursoroff;IFnurinterneverwendungTHENoeffnemenu(menuname)ELSEbietemenuanFI;lassemenupunkteauswaehlen;IFnurinterneverwendungTHENdo(ausstiegsproc);anzahloffenermenusDECR1;IFanzahloffenermenus<1THENerasemenunoticeFI;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;mitausstieg:=TRUE;cursoronELSEschliessemenu;leereggfdenbildschirmFI.bietemenuan:REAL VARzwischenzeit:=clock(1)-zeitpunkt;IFzwischenzeit<2.0THENpause(20-int(10.0*zwischenzeit))FI;oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).interpretierezeichen:SELECTzeichenpositionOF CASE1:geheeinenhauptmenupunktnachlinksCASE2:geheeinenhauptmenupunktnachrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.pruefeobfehler:IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage)END IF.geheeinenhauptmenupunktnachlinks:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.geheeinenhauptmenupunktnachrechts:anzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.
+drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger<aktuellesmenu.anzahlhauptmenupunkteTHENaktuellesmenu.hauptmenuzeigerINCR1ELSEaktuellesmenu.hauptmenuzeiger:=1FI.geheeinenuntermenupunktnachunten:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachuntenEND IF;INT VARnaechsteraktiver:=folgenderaktiveruntermenupunkt;nimmummarkierungvor.geheeinenuntermenupunktnachoben:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachobenEND IF;naechsteraktiver:=vorausgehenderaktiveruntermenupunkt;nimmummarkierungvor.nimmummarkierungvor:IFueberhauptaktivemenupunktevorhandenTHENdemarkiereaktuellenuntermenupunkt;gehezumfolgendenuntermenupunkt;markiereaktuellenuntermenupunktFI.ueberhauptaktivemenupunktevorhanden:(aktuellesuntermenu.belegt>0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger<>0THEN IFnurinterneverwendungANDmitausstiegTHENkennzeichnealsangetickt;disablestop;do(ausstiegsproc);do(menuanweisung);aktuellermenupunkt.angewaehlt:=FALSE;IFiserrorTHENputerror;clearerrorFI;enablestop;anzahloffenermenusDECR1;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;cursoron;LEAVEhandlemenuELSEkennzeichnealsangetickt;fuehreoperationaus(menuanweisung);IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckFI ELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.beendeaktuelleuntermenuoperationen:kuerzelkette:="".starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelketteCAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;IFmenuexistiertnichtTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1;ggfneueseiteaufschlagen;ueberpruefeanzahloffenermenus;legeggfaktuellesmenuaufeis;initialisieredenmenubildschirm;IF NOTnurinterneverwendungTHENaktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=
+0;aktuellesmenu.untermenuanfang:=0;FI;fuehreggfmenueingangsprozeduraus;showmenu;zeigeggfmenukenndatenan.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=i;FI UNTILmenuleiste.menu[i].menuname=menunamePER.menuexistiertnicht:NOTgefunden.ueberpruefeanzahloffenermenus:IFanzahloffenermenus>2THENanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI.legeggfaktuellesmenuaufeis:IFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuellFI;menuleiste.zeigeraktuell:=suchzeiger.initialisieredenmenubildschirm:hochruntererlaubt:=TRUE;IFanzahloffenermenus=2THENmenuwindow:=zweitesmenu;ELSEmenuwindow:=window(1,2,79,23);FI.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.ggfneueseiteaufschlagen:IFanzahloffenermenus=1THENpageFI.zeigeggfmenukenndatenan:IFanzahloffenermenus=1ANDaktuellesmenu.menuinfo<>bleibtleersymbolTHENwritemenunotice(vollstaendigerinfotext,4);pause(100);erasemenunoticeFI.vollstaendigerinfotext:aktuellesmenu.menuinfo+aktuellesmenu.lizenznummer+aktuellesmenu.versionsnummerEND PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page(menuwindow,FALSE);schreibekopfzeile;zeigeinformationszeilean;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:IFaktuellesmenu.kopfzeile<>""THENcursor(1,1);out(invers(text(aktuellesmenu.kopfzeile,77)))END IF.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(menuwindow,1,1);out(menuwindow,hauptmenuzeile);cursor(menuwindow,1,2);out(areaxsize(menuwindow)*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext:aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:
+ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH 1 ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IFvoriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT
+VAR bezeichnung:="";bezeichnungCATkennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELIFaktuellermenupunkt.punktkuerzel=""THENblankELSE"-"FI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROCactivate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFanzahloffenermenus=1THENpage;showmenu;showmenunoticeELSEzeigeerstesmenuan;zeigezweitesmenuan;showmenunoticeFI;activationchanged:=FALSE.zeigeerstesmenuan:INT VARmenuzeiger:=menuleiste.zeigeraktuell;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);anzahloffenermenus:=1;showmenu.zeigezweitesmenuan:menuleiste.zeigeraktuell:=menuzeiger;menuwindow:=zweitesmenu;anzahloffenermenus:=2;showmenu.END PROC
+regeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenuanswerone(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswerone(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswerone;THESAURUS PROCmenuanswersome(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS VARwert:=boxanswersome(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswersome;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:IFanzahloffenermenus=0THENzeigeangabenundemblem;FI.zeigeangabenundemblem:ROW5WINDOW VARw;w[1]:=window(40,4,30,9);w[2]:=window(36,6,30,9);w[3]:=window(30,8,30,9);w[4]:=window(22,10,30,9);w[5]:=window(12,12,30,9);page;show(w[1]);out(w[1],center(w[1],invers(systemkuerzel)));show(w[2]);out(w[2]," Version "+versionsnummer);show(w[3]);out(w[3],copyright1);show(w[4]);out(w[4],copyright2);show(w[5]);cursor(w[5],1,2);out(w[5],"    lll        sssssssss  ");cursor(w[5],1,3);out(w[5],"    lll       sss     sss ");cursor(w[5],1,4);out(w[5],"    lll       sss         ");cursor(w[5],1,5);out(w[5],"    lll        sssssssss  ");cursor(w[5],1,6);out(w[5],"    lll               sss ");cursor(w[5],1,7);out(w[
+5],"    lll latta soft    sss ");cursor(w[5],1,8);out(w[5],"     lllllllll sssssssss  ");cursor(79,24);zeitpunkt:=clock(1);END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;PROCmenuwindowget(TEXT VARtext):get(schreibfenster,text)END PROCmenuwindowget;PROCmenuwindoweditget(TEXT VARtext):edit(schreibfenster,text)END PROCmenuwindoweditget;PROCmenuwindowedit(TEXT CONSTdateiname):initializemenuwindow;edit(schreibfenster,dateiname)END PROCmenuwindowedit;PROCmenuwindowedit(FILE VARf):initializemenuwindow;edit(schreibfenster,f)END PROCmenuwindowedit;PROCmenuwindowshow(TEXT CONSTdateiname):initializemenuwindow;show(schreibfenster,dateiname)END PROCmenuwindowshow;PROCmenuwindowshow(FILE VARf):initializemenuwindow;show(schreibfenster,f)END PROCmenuwindowshow;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCstdinfoedit(FILE VARf,INT CONSToberstezeile):IFoberstezeile<1ORoberstezeile>3THENerrorstop(fehlermeldung[13]);FI;garantieremenukarte;cursor(1,oberstezeile);out(cleop);cursor(1,24);out(invers(text(menubasistext(141),76)));editorinfofenster:=window(1,oberstezeile+2,79,24-oberstezeile);kommandoauftastelegen("?","editorinformationen");commanddialogue(FALSE);cursoron;edit(f,1,oberstezeile+1,79,23-oberstezeile);commanddialogue(TRUE);kommandoauftastelegen("?","").garantieremenukarte:TEXT VARname:=compress(menukartenname);IFname=""THENinstallmenu(stdmenukartenname,FALSE)FI.END PROCstdinfoedit;PROCstdinfoedit(FILE VARf):stdinfoedit(f,1)END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname,INT CONSToberstezeile):FILE VARf:=sequentialfile(modify,dateiname);stdinfoedit(f,oberstezeile);END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname):stdinfoedit(dateiname,1)END PROCstdinfoedit;PROCeditorinformationen:BOOL VARendegewuenscht:=FALSE;INT VARz;FORzFROMstartwertUPTO22REPcursor(1,z);out(cleol);PER;REP INT VARerg:=boxalternative(editorinfofenster,menubasistext(149),menubasistext(150),menubasistext(151),5,FALSE,FALSE);erfuelledenwunschUNTILendegewuenschtPER;cursor(1,24);out(invers(text(menubasistext(
+141),76))).startwert:areay(editorinfofenster)+1.erfuelledenwunsch:IFerg>100THENergDECR100END IF;SELECTergOF CASE1,9:boxinfo(editorinfofenster,menubasistext(142),5,maxint,FALSE)CASE2,10:boxinfo(editorinfofenster,menubasistext(143),5,maxint,FALSE)CASE3,11:boxinfo(editorinfofenster,menubasistext(144),5,maxint,FALSE)CASE4,12:boxinfo(editorinfofenster,menubasistext(145),5,maxint,FALSE)CASE5,13:boxinfo(editorinfofenster,menubasistext(146),5,maxint,FALSE)CASE6,14:boxinfo(editorinfofenster,menubasistext(147),5,maxint,FALSE)CASE7,15:boxinfo(editorinfofenster,menubasistext(148),5,maxint,FALSE)CASE8,16:endegewuenscht:=TRUE END SELECT END PROCeditorinformationen;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCdirektstart(TEXT CONSTprocname,BOOL CONSTautoloeschen):TEXT VARdatname:="Selbststartergenerierungsdatei",letzter:=std;kopplearchivmenukartean;schreibeprogramm;insertiereprogramm;abkoppeln.kopplearchivmenukartean:installmenu(stdmenukartenname,FALSE).schreibeprogramm:forget(datname,quiet);FILE VARf:=sequentialfile(output,datname);putline(f,menubasistext(191));putline(f,"do ("+code(34)+"reset dialog; erase menunotice; "+procname+code(34)+");");putline(f,menubasistext(192));IFautoloeschenTHENputline(f,menubasistext(193))ELSEputline(f,menubasistext(194))FI;putline(f,menubasistext(195));putline(f,menubasistext(196)).insertiereprogramm:TEXT VARt:="insert ("+code(34)+datname+code(34)+")";do(t).abkoppeln:forget(datname,quiet);lastparam(letzter);resetdialog;globalmanager.END PROCdirektstart;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;PROCsetwindow2(INT CONSTx2,y2,xsize2,ysize2):IFy2<2THENerrorstop("Kopfzeile wird überschrieben")END IF;zweitesmenu:=window(x2,y2,xsize2,ysize2);END PROCsetwindow2;.aktuellesuntermenu:aktmenu.einzelmenu[aktmenu.hauptmenuzeiger].aktmenu:menuleiste.menu[menuleiste.zeigeraktuell].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell].;END PACKETlsdialog5;
+
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel
new file mode 100644
index 0000000..c6bed08
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-DIALOG 5.simsel
@@ -0,0 +1,12 @@
+PACKETlsdialog5DEFINESwritehead,restorehead,setwindow2,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,menuanswerone,menuanswersome,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowget,menuwindoweditget,menuwindowedit,menuwindowshow,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,editorinformationen,stdinfoedit,menukartenname,currentmenuwindow,resetdialog,onlyintern,ausstieg,direktstart:LETsystemkuerzel="ls-DIALOG",menutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",stdmenukartenname="ls-MENUKARTE:Archiv",versionsnummer="1.1",copyright1=" (C) 1987/88 Eva Latta-Weber",copyright2=" (C) 1988 ERGOS GmbH";LETmaxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",cleol="�",cleop="�",trennzeilensymbol="###",bleibtleersymbol="***",headzeilenlaenge=77,headproduktname="schulis  Simulationssystem",hauptmenuluecke="  ";LETauswahlstring1="��
+�
�?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster,editorinfofenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,nurinterneverwendung:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;REAL VARzeitpunkt:=clock(1);ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:<ESC><?>/<?>  Wählen:<Pfeile>  Bestätigen:<RETURN> Verlassen:<ESC><q>"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine 

        Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt 

  kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;nurinterneverwendung:=FALSE FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask
+(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROConlyintern(BOOL CONSTwert):nurinterneverwendung:=wertEND PROConlyintern;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):nurinterneverwendung:=FALSE;mitausstieg:=TRUE;handlemenu(menuname,"",PROCf,PROCcof,PROCzusatzdarst)END PROChandlemenu;PROChandlemenu(TEXT CONSTmenuname,ausstiegsproc,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):cursoroff;IFnurinterneverwendungTHENoeffnemenu(menuname)ELSEbietemenuanFI;lassemenupunkteauswaehlen;IFnurinterneverwendungTHENdo(ausstiegsproc);anzahloffenermenusDECR1;IFanzahloffenermenus<1THENerasemenunoticeFI;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;mitausstieg:=TRUE;cursoronELSEschliessemenu;leereggfdenbildschirmFI.bietemenuan:REAL VARzwischenzeit:=clock(1)-zeitpunkt;IFzwischenzeit<2.0THENpause(20-int(10.0*zwischenzeit))FI;oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).pruefeobfehler:IFiserrorTHENregeneratemenuscreen;menuinfo(errormessage);clearerrorEND IF.interpretierezeichen:SELECTzeichenpositionOF CASE1:geheeinenhauptmenupunktnachlinksCASE2:geheeinenhauptmenupunktnachrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.geheeinenhauptmenupunktnachlinks:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.geheeinenhauptmenupunktnachrechts:anzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;anzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).
+startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger<aktuellesmenu.anzahlhauptmenupunkteTHENaktuellesmenu.hauptmenuzeigerINCR1ELSEaktuellesmenu.hauptmenuzeiger:=1FI.geheeinenuntermenupunktnachunten:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachuntenEND IF;INT VARnaechsteraktiver:=folgenderaktiveruntermenupunkt;nimmummarkierungvor.geheeinenuntermenupunktnachoben:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachobenEND IF;naechsteraktiver:=vorausgehenderaktiveruntermenupunkt;nimmummarkierungvor.nimmummarkierungvor:IFueberhauptaktivemenupunktevorhandenTHENdemarkiereaktuellenuntermenupunkt;gehezumfolgendenuntermenupunkt;markiereaktuellenuntermenupunktFI.ueberhauptaktivemenupunktevorhanden:(aktuellesuntermenu.belegt>0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger>0THEN IFnurinterneverwendungANDmitausstiegTHENkennzeichnealsangetickt;disablestop;do(ausstiegsproc);do(menuanweisung);aktuellermenupunkt.angewaehlt:=FALSE;IFiserrorTHENputerror;clearerrorFI;enablestop;anzahloffenermenusDECR1;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);nurinterneverwendung:=FALSE;cursoron;LEAVEhandlemenuELSEkennzeichnealsangetickt;IFmenuanweisung=""THENverteiler(aktuellesmenu.hauptmenuzeiger,aktuellesmenu.untermenuzeiger,PROCf,PROCcof,PROCzusatzdarst);ELSEfuehreoperationaus(menuanweisung);FI;IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckFI ELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).beendeaktuelleuntermenuoperationen:kuerzelkette:="".END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelkette
+CAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;IFmenuexistiertnichtTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1;ggfneueseiteaufschlagen;ueberpruefeanzahloffenermenus;legeggfaktuellesmenuaufeis;initialisieredenmenubildschirm;IF NOTnurinterneverwendungTHENaktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=0;aktuellesmenu.untermenuanfang:=0;FI;fuehreggfmenueingangsprozeduraus;showmenu;zeigeggfmenukenndatenan.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=i;FI UNTILmenuleiste.menu[i].menuname=menunamePER.menuexistiertnicht:NOTgefunden.ueberpruefeanzahloffenermenus:IFanzahloffenermenus>2THENanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI.legeggfaktuellesmenuaufeis:IFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuellFI;menuleiste.zeigeraktuell:=suchzeiger.initialisieredenmenubildschirm:hochruntererlaubt:=TRUE;IFanzahloffenermenus=2THENmenuwindow:=zweitesmenu;ELSEmenuwindow:=window(1,2,79,23);FI.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.ggfneueseiteaufschlagen:IFanzahloffenermenus=1THENpageFI.zeigeggfmenukenndatenan:IFanzahloffenermenus=1ANDaktuellesmenu.menuinfo<>bleibtleersymbolTHENwritemenunotice(vollstaendigerinfotext,4);pause(100);erasemenunoticeFI.vollstaendigerinfotext:aktuellesmenu.menuinfo+aktuellesmenu.lizenznummer+aktuellesmenu.versionsnummerEND PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page(menuwindow,FALSE);schreibekopfzeile;zeigeinformationszeilean;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:zeigekopfbalken;.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(menuwindow,1,1);out(menuwindow,hauptmenuzeile);cursor(menuwindow,1,2);out(areaxsize(menuwindow)*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext:aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=
+folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH1ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT
+VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IF
+voriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT VARbezeichnung:="";bezeichnungCATkennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELIFaktuellermenupunkt.punktkuerzel=""THENblankELSE"-"FI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage,5);activationchanged:=TRUE;FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROCactivate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:IFanzahloffenermenus=0THENerrorstop(
+fehlermeldung[8])ELIFanzahloffenermenus=1THENplotend;showmenu;showmenunoticeELSEzeigeerstesmenuan;zeigezweitesmenuan;showmenunoticeFI;activationchanged:=FALSE.zeigeerstesmenuan:INT VARmenuzeiger:=menuleiste.zeigeraktuell;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);anzahloffenermenus:=1;showmenu.zeigezweitesmenuan:menuleiste.zeigeraktuell:=menuzeiger;menuwindow:=zweitesmenu;anzahloffenermenus:=2;showmenu.END PROCregeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position,FALSE);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenuanswerone(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswerone(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswerone;THESAURUS PROCmenuanswersome(TEXT CONSTt,vorgabe,THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS VARwert:=boxanswersome(w,t,vorgabe,thes,t1,t2,mitreinigung,FALSE)IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuanswersome;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:page;END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,
+menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;PROCmenuwindowget(TEXT VARtext):get(schreibfenster,text)END PROCmenuwindowget;PROCmenuwindoweditget(TEXT VARtext):edit(schreibfenster,text)END PROCmenuwindoweditget;PROCmenuwindowedit(TEXT CONSTdateiname):initializemenuwindow;edit(schreibfenster,dateiname)END PROCmenuwindowedit;PROCmenuwindowedit(FILE VARf):initializemenuwindow;edit(schreibfenster,f)END PROCmenuwindowedit;PROCmenuwindowshow(TEXT CONSTdateiname):initializemenuwindow;show(schreibfenster,dateiname)END PROCmenuwindowshow;PROCmenuwindowshow(FILE VARf):initializemenuwindow;show(schreibfenster,f)END PROCmenuwindowshow;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCstdinfoedit(FILE VARf,INT CONSToberstezeile):IFoberstezeile<1ORoberstezeile>3THENerrorstop(fehlermeldung[13]);FI;garantieremenukarte;cursor(1,oberstezeile);out(cleop);cursor(1,24);out(invers(text(menubasistext(141),76)));editorinfofenster:=window(1,oberstezeile+2,79,24-oberstezeile);kommandoauftastelegen("?","editorinformationen");commanddialogue(FALSE);cursoron;edit(f,1,oberstezeile+1,79,23-oberstezeile);commanddialogue(TRUE);kommandoauftastelegen("?","").garantieremenukarte:TEXT VARname:=compress(menukartenname);IFname=""THENinstallmenu(stdmenukartenname,FALSE)FI.END PROCstdinfoedit;PROCstdinfoedit(FILE VARf):stdinfoedit(f,1)END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname,INT CONSToberstezeile):FILE VARf:=sequentialfile(modify,dateiname);stdinfoedit(f,oberstezeile);END PROCstdinfoedit;PROCstdinfoedit(TEXT CONSTdateiname):stdinfoedit(dateiname,1)END PROCstdinfoedit;PROCeditorinformationen:BOOL VARendegewuenscht:=FALSE;INT VARz;FORzFROMstartwertUPTO22REPcursor(1,z);out(cleol);PER;REP INT VARerg:=boxalternative(editorinfofenster,menubasistext(149),menubasistext(150),menubasistext(151),5,FALSE,FALSE);erfuelledenwunschUNTILendegewuenschtPER;cursor(1,24);out(invers(text(menubasistext(141),76))).startwert:areay(editorinfofenster)+1.erfuelledenwunsch:IFerg>100THENergDECR100END IF;SELECTergOF CASE1,9:boxinfo(editorinfofenster,menubasistext(142),5,maxint,FALSE)CASE2,10:boxinfo(editorinfofenster,menubasistext(143),5,maxint,FALSE)CASE3,11:boxinfo(editorinfofenster,menubasistext(144),5,maxint,FALSE)CASE4,12:boxinfo(editorinfofenster,
+menubasistext(145),5,maxint,FALSE)CASE5,13:boxinfo(editorinfofenster,menubasistext(146),5,maxint,FALSE)CASE6,14:boxinfo(editorinfofenster,menubasistext(147),5,maxint,FALSE)CASE7,15:boxinfo(editorinfofenster,menubasistext(148),5,maxint,FALSE)CASE8,16:endegewuenscht:=TRUE END SELECT END PROCeditorinformationen;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCdirektstart(TEXT CONSTprocname,BOOL CONSTautoloeschen):TEXT VARdatname:="Selbststartergenerierungsdatei",letzter:=std;kopplearchivmenukartean;schreibeprogramm;insertiereprogramm;abkoppeln.kopplearchivmenukartean:installmenu(stdmenukartenname,FALSE).schreibeprogramm:forget(datname,quiet);FILE VARf:=sequentialfile(output,datname);putline(f,menubasistext(191));putline(f,"do ("+code(34)+"reset dialog; erase menunotice; "+procname+code(34)+");");putline(f,menubasistext(192));IFautoloeschenTHENputline(f,menubasistext(193))ELSEputline(f,menubasistext(194))FI;putline(f,menubasistext(195));putline(f,menubasistext(196)).insertiereprogramm:TEXT VARt:="insert ("+code(34)+datname+code(34)+")";do(t).abkoppeln:forget(datname,quiet);lastparam(letzter);resetdialog;globalmanager.END PROCdirektstart;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:INT VARx,y;TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;PROCsetwindow2(INT CONSTx2,y2,xsize2,ysize2):IFy2<2THENerrorstop("Kopfzeile wird überschrieben")END IF;zweitesmenu:=window(x2,y2,xsize2,ysize2);END PROCsetwindow2;PROCverteiler(INT CONSTmenunr,menuzeile,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof,PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarst):IFmenunr=1THEN IFmenuzeile=1THENlsgberechnen(PROCf,PROCcof);ELIFmenuzeile=2THENftsberechnen(PROCf,PROCcof);FI;ELIFmenunr=2THEN IFmenuzeile=5THENdisablestop;ausgabezusatzdarstellung(PROCzusatzdarst);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffFI FI;END PROCverteiler;.aktuellesuntermenu:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell].;END PACKETlsdialog5;
+
diff --git a/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel b/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel
new file mode 100644
index 0000000..3a954c0
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ls-MENUKARTE:Simsel
diff --git a/app/schulis-simulationssystem/3.0/src/ltbearb b/app/schulis-simulationssystem/3.0/src/ltbearb
new file mode 100644
index 0000000..f21741e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/ltbearb
@@ -0,0 +1,8 @@
+PACKETlsbearbeitungsmenuDEFINESzeigekopfbalken,initialisieresimulation,anfangsaktivierungloesungen,lsgberechnen,ftsberechnen,lsgumschalten,wechselezu,anfangsaktivierungdarstellung,ausgabezeitdiagramm,ausgabephasendiagramm,ausgabehistogramm,ausgabetabelle,ausgabezusatzdarstellung,anfangsaktivierungkombination,kombinationzusammenstellen,parameterkombination,anfangsaktivierungvergleich,endprocvergleich,ausgabevergleichzeitdiagramm,ausgabevergleichphasendiagramm,ausgabevergleichhistogramm,ausgabevergleichtabelle,uebergebeinfotextfuerwd,infoszummodell:LETnichtseingegeben="m";LETausknichtgraphikfaehig=72,auskkeinelsgberechnet=73,ausknureinelsgberechnet=74,showverlasszeichen="m",stleistefileverlassen=28,kopfmax4variablen=50,kopfbeliebigvielevar=51,kopfgenaueinexykombin=52,kopfxyeingabe=53,headzeilenlaenge=77,headproduktname="schulis  Simulationssystem",dialogsituationsimulation=1;LETmodellauforiginal="modellauf.original",modellauffortsetzung="modellauf.fortsetzung",anzahlloesungen=2;LET LSG=STRUCT(TEXTname,LOESUNGanfang,BOOLberechnet,LOESUNGgesamt,BOOLftsberechnet);ROWanzahlloesungenLSG VARlsg;INT VARlsgaktuell:=0;LETmax=20,negativemld=FALSE;LETloesungsmenu=1,darstellungsmenu=2,kombmenu=3,vergleichsmenu=4;LETloesungenberechnen=0,einfach=1,komb1=2;LETzeitdg=1,phasdg=2,tabdg=3,histdg=4,zusdg=5;LETzuebers="Zeitdiagramm",puebers="Phasendiagramm",tuebers="Tabelle",huebers="Histogramm";WINDOW VARfsingle:=grossesrahmenfenster;LETsinglesp1=1,zl1=4,singlebr=78,hoe=19,scrollzeile=3;LETbw="";ROW2BOOL VARkombgewaehlt;ROW2TEXT VARdarstname1,darstname2;ROW2INT VARdarstnrkomb1,darstnrkomb2;TEXT VARlsgnrtext1:="",lsgnrtext2:="";INT VARsubmenu1lsgnr:=1;BOOL VARaktivierunggeaendert:=FALSE;ROW4ROW8BOOL VARaktivierung;ROW8BOOL VARaktivaktuell;ROW4BOOL VARerstesaufklappen;DATASPACE VARinfofuerwd:=nilspace;TEXT VARkopfbalken:="";PROCinitialisieresimulation:kopfbalken:=headproduktname+(headzeilenlaenge-length(modellkurzbezeichnung)-length(headproduktname))*" "+modellkurzbezeichnung;zeigekopfbalken;INT VARi,j;FORiFROM1UPTOanzahlloesungenREPlsg(i).berechnet:=FALSE;lsg(i).ftsberechnet:=FALSE;lsg(i).name:="Lösung "+text(i);lsg(i).anfangVONoriginalwerte;lsg(i).gesamtVONoriginalwerte;PER;lsgaktuell:=1;kombgewaehlt(1):=FALSE;kombgewaehlt(2):=FALSE;darstnrkomb1(1):=0;darstnrkomb2(1):=0;darstnrkomb1(2):=0;darstnrkomb2(2):=0;aktivierunggeaendert:=FALSE;submenu1lsgnr:=0;lsgnrtext1:="Voreinstellung auf:";lsgnrtext2:=""+lsg(lsgaktuell).name+" "+code(14);FORiFROM1UPTO4REP FORjFROM1UPTO8REPaktivierung(i)(j):=FALSE;aktivaktuell(j):=FALSE;PER;PER;FORiFROM1UPTO4REPerstesaufklappen(i):=TRUE;PER;do("deactivate (2);");do("deactivate (3);");aktivierung(1)(2):=FALSE;aktivierung(1)(3):=FALSE;END PROCinitialisieresimulation;PROCanfangsaktivierungloesungen:loescheaktuellemeldung(dialogsituationsimulation);IFerstesaufklappen(loesungsmenu)THENdo("activate (1);");do("activate (5);");do("activate (6);");aktivierung(loesungsmenu)(1):=TRUE;aktivierung(loesungsmenu)(5):=TRUE;aktivierung(loesungsmenu)(6):=TRUE;FI;IFlsgaktuell<>submenu1lsgnrTHENaktivaktuell:=aktivierung(loesungsmenu);IFlsg(lsgaktuell).berechnetTHENaktivaktuell(2):=TRUE;ELSEaktivaktuell(2):=FALSE;FI;IFlsg(lsgaktuell).ftsberechnetTHENaktivaktuell(3):=TRUE;ELSEaktivaktuell(3):=FALSE;FI;evtneueaktivierungausgeben(loesungsmenu);IFsubmenu1lsgnr=0THENgiblsgnraus;FI;submenu1lsgnr:=lsgaktuell;FI;END PROCanfangsaktivierungloesungen;PROClsgberechnen(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):INT VARlg:=lsgaktuell;TEXT VARtaste:="";LOESUNG VARergebnis;KURVE VARzkurve;ergebnisVONlsg(lg).anfang;berechne(ergebnis,PROCf,PROCcof,taste);trageergebnisalsneuelsgein;do("regenerate menuscreen;");giblsgnraus;.trageergebnisalsneuelsgein:IFtaste<>nichtseingegebenTHEN IFvorhernichtberechnetTHENaktivierung(loesungsmenu)(2):=TRUE;do("activate(2)");ELIFfortsetzberechnetTHENaktivierung(loesungsmenu)(3):=FALSE;do("deactivate (3)");FI;lsg(lg).anfang:=ergebnis;copy(zkurve,
+modellauforiginal+lsgindex,LOESUNGSABSCHNITTergebnis);lsg(lg).anfangLOESUNGSABSCHNITTzkurve;lsg(lg).gesamt:=ergebnis;copy(zkurve,modellauffortsetzung+lsgindex,LOESUNGSABSCHNITTergebnis);lsg(lg).gesamtLOESUNGSABSCHNITTzkurve;lsg(lg).berechnet:=TRUE;lsg(lg).ftsberechnet:=FALSE;FI;.vorhernichtberechnet:NOTlsg(lg).berechnet.fortsetzberechnet:lsg(lg).ftsberechnet.lsgindex:"."+text(lg).END PROClsgberechnen;PROCftsberechnen(ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)f,ZUSTAND PROC(REAL CONST,ZUSTAND CONST,PARAMETER CONST)cof):INT CONSTlg:=lsgaktuell;berechnefortfuehrung(lsg(lg).anfang,lsg(lg).gesamt,PROCf,PROCcof);IF NOTlsg(lg).ftsberechnetTHENaktivierung(loesungsmenu)(3):=TRUE;do("activate (3);");FI;lsg(lg).ftsberechnet:=TRUE;oldfootnote;.END PROCftsberechnen;PROClsgumschalten:INT CONSTi:=lsgaktuell;KURVE VARzkurve;lsg(i).ftsberechnet:=FALSE;lsg(i).gesamt:=lsg(i).anfang;copy(zkurve,modellauffortsetzung+lsgindex,LOESUNGSABSCHNITTlsg(i).anfang);lsg(i).gesamtLOESUNGSABSCHNITTzkurve;aktivierung(loesungsmenu)(3):=FALSE;do("deactivate (3);");.lsgindex:"."+text(i).END PROClsgumschalten;PROCwechselezu(INT CONSTneuelsgnr,darstellungsform):IFlsgaktuell<>neuelsgnrTHEN IFdarstellungsform=loesungenberechnenTHENlsgaktuell:=neuelsgnr;anfangsaktivierungloesungen;lsgnrtext1:="Momentan aktiv:";lsgnrtext2:=code(15)+lsg(lsgaktuell).name+" "+code(14);ELIFlsg(neuelsgnr).berechnetTHENlsgaktuell:=neuelsgnr;lsgnrtext1:="Momentan aktiv:";lsgnrtext2:=code(15)+lsg(lsgaktuell).name+" "+code(14);IFdarstellungsform=einfachTHENanfangsaktivierungdarstellung;ELIFdarstellungsform=komb1THENaktivierungkombination(TRUE);FI;FI;IF NOTaktivierunggeaendertTHENdo("refresh submenu;");ELSE FI;giblsgnraus;FI;END PROCwechselezu;PROCanfangsaktivierungdarstellung:INT VARi;loescheaktuellemeldung;aktivaktuell:=aktivierung(darstellungsmenu);IF NOTeinelsgberechnetTHENdeaktivieredarstellungen;aktivaktuell(7):=FALSE;aktivaktuell(8):=FALSE;zeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);ELIFlsg(lsgaktuell).berechnetTHENaktivieredarstellungen;aktivierelsgwechsel;ELSEdeaktivieredarstellungen;aktivierelsgwechsel;FI;evtneueaktivierungausgeben(darstellungsmenu);IFaktivierunggeaendertTHENdo("refresh submenu")FI;.aktivieredarstellungen:FORiFROM1UPTO5REPaktivaktuell(i):=darstellungzugelassen(i);PER;.aktivierelsgwechsel:aktivaktuell(7):=lsg(1).berechnet;aktivaktuell(8):=lsg(2).berechnet;.deaktivieredarstellungen:FORiFROM1UPTO5REPaktivaktuell(i):=FALSE;PER;END PROCanfangsaktivierungdarstellung;PROCausgabezeitdiagramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,zeitdg,variablengewaehlt,zuebers);IFvariablengewaehltTHENzeigediagramm("z",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabezeitdiagramm;PROCausgabephasendiagramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,phasdg,variablengewaehlt,puebers);IFvariablengewaehltTHENzeigephasendiagramm(lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabephasendiagramm;PROCausgabehistogramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,histdg,variablengewaehlt,huebers);IFvariablengewaehltTHENzeigediagramm("h",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).ftsberechnet,taste);fehlerbehandlungnachgraphik(TRUE);ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;END PROCausgabehistogramm;PROCausgabetabelle:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,tabdg,variablengewaehlt,tuebers);IFvariablengewaehltTHENzeigediagramm("t",lsg(lsgaktuell).gesamt,variablenmuster,lsg(lsgaktuell).
+ftsberechnet,taste);FI;erase(fsingle);refreshundnrausgabe;oldfootnote;END PROCausgabetabelle;PROCausgabezusatzdarstellung(PROC(LOESUNG VAR,BOOL VAR,TEXT VAR)zusatzdarstellung):BOOL VARnichtindemo:=FALSE;TEXT VARtaste:="";zusatzdarstellung(lsg(lsgaktuell).gesamt,nichtindemo,taste);fehlerbehandlungnachgraphik(TRUE);END PROCausgabezusatzdarstellung;PROCanfangsaktivierungkombination(BOOL CONSTmldloeschen):darstname1(lsgaktuell):="";darstname2(lsgaktuell):="";kombgewaehlt(1):=FALSE;kombgewaehlt(2):=FALSE;aktivierungkombination(mldloeschen);END PROCanfangsaktivierungkombination;PROCaktivierungkombination(BOOL CONSTmldloeschen):INT VARi;IFmldloeschenTHENloescheaktuellemeldung;FI;aktivaktuell:=aktivierung(kombmenu);IFeinelsgberechnetTHENaktivieredarstellungenELSEzeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);deaktivieredarstellungenFI;evtneueaktivierungausgeben(kombmenu);.aktivieredarstellungen:aktivaktuell(1):=lsg(lsgaktuell).berechnet;aktivaktuell(3):=kombgewaehlt(lsgaktuell);aktivaktuell(5):=lsg(1).berechnet;aktivaktuell(6):=lsg(2).berechnet;.deaktivieredarstellungen:FORiFROM1UPTO6REP IFi<>4CANDi<>2THENaktivaktuell(i):=FALSE;FI;PER;.END PROCaktivierungkombination;PROCkombinationzusammenstellen:TEXT VARtaste:="";ZUSTAND VARmusterkomb1,musterkomb2;BOOL VARkombvarblgewaehlt:=FALSE,mldloeschen:=TRUE;musterkomb1:=neuerzustand(dimension+codimension);musterkomb2:=neuerzustand(dimension+codimension);waehledarstellungkombaus;waehlevariablenfuerdarstellungkombaus;gebekombiniertedarstellungaus;.waehledarstellungkombaus:THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus,auswahl2:=emptythesaurus;INT VARi:=0;insert(angebot1,zuebers,i);IFmitphasendiagrammCAND(dimension+codimension>=2)THENinsert(angebot1,puebers,i);FI;insert(angebot1,tuebers,i);insert(angebot1,huebers,i);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,1,1,1,auswahl1,auswahl2,"Darstellung 1",bw,"Darstellung 2",bw);IFnotempty(auswahl1)ANDnotempty(auswahl2)THENkombgewaehlt(lsgaktuell):=TRUE;i:=0;get(auswahl1,darstname1(lsgaktuell),i);darstnrkomb1(lsgaktuell):=darstellungsart(darstname1(lsgaktuell));i:=0;get(auswahl2,darstname2(lsgaktuell),i);darstnrkomb2(lsgaktuell):=darstellungsart(darstname2(lsgaktuell));do("activate (3)");aktivaktuell(3):=TRUE;ELSEleavekombinationzusammenstellen;FI;.waehlevariablenfuerdarstellungkombaus:variableneinstellendouble(musterkomb1,musterkomb2,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),kombvarblgewaehlt,darstname1(lsgaktuell),darstname2(lsgaktuell));IF NOTkombvarblgewaehltTHENleavekombinationzusammenstellen;FI;.gebekombiniertedarstellungaus:zeigekombiniertedarstellung(taste,lsg(lsgaktuell).gesamt,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),musterkomb1,musterkomb2);IFdarstname1(lsgaktuell)=tuebersANDdarstname2(lsgaktuell)=tuebersTHENaktivierungkombination(mldloeschen);oldfootnote;giblsgnraus;ELSEaktivierungkombination(NOTmldloeschen);fehlerbehandlungnachgraphik(TRUE);FI;.leavekombinationzusammenstellen:erase(fsingle);aktivierungkombination(FALSE);refreshundnrausgabe;oldfootnote;LEAVEkombinationzusammenstellen;.END PROCkombinationzusammenstellen;PROCparameterkombination:ZUSTAND VARmusterkomb1,musterkomb2;TEXT VARtaste;BOOL VARkombvarblgewaehlt:=FALSE;musterkomb1:=neuerzustand(dimension+codimension);musterkomb2:=neuerzustand(dimension+codimension);variableneinstellendouble(musterkomb1,musterkomb2,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),kombvarblgewaehlt,darstname1(lsgaktuell),darstname2(lsgaktuell));IFkombvarblgewaehltTHENzeigekombiniertedarstellung(taste,lsg(lsgaktuell).gesamt,darstnrkomb1(lsgaktuell),darstnrkomb2(lsgaktuell),musterkomb1,musterkomb2);IFdarstname1(lsgaktuell)=tuebersANDdarstname2(lsgaktuell)=tuebersTHENoldfootnote;ELSEfehlerbehandlungnachgraphik(TRUE);FI;ELSEerase(fsingle);refreshundnrausgabe;oldfootnote;FI;.END PROCparameterkombination;PROCanfangsaktivierungvergleich:INT VARi;loescheaktuellemeldung;erase(lsgwindow);aktivaktuell:=aktivierung(vergleichsmenu);IF NOTeinelsgberechnet
+THENzeigemeldung(auskunftstext(auskkeinelsgberechnet),negativemld);deaktivieredarstellungenELIF NOTmindzweilsgberechnetTHENzeigemeldung(auskunftstext(ausknureinelsgberechnet),negativemld);deaktivieredarstellungenELSEaktivieredarstellungenFI;evtneueaktivierungausgeben(vergleichsmenu);.aktivieredarstellungen:FORiFROM1UPTO4REPaktivaktuell(i):=darstellungzugelassen(i);PER;.deaktivieredarstellungen:FORiFROM1UPTO4REPaktivaktuell(i):=FALSE;PER;END PROCanfangsaktivierungvergleich;PROCendprocvergleich:giblsgnraus;END PROCendprocvergleich;PROCausgabevergleichzeitdiagramm:ZUSTAND VARvariablenmuster;TEXT VARtaste:="";BOOL VARvariablengewaehlt:=FALSE;variableneinstellensingle(variablenmuster,zeitdg,variablengewaehlt,zuebers);IFvariablengewaehltTHENzeigevergleichskurve(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster,"z");fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichzeitdiagramm;PROCausgabevergleichphasendiagramm:ZUSTAND VARvariablenmuster;TEXT VARtaste:="";BOOL VARvariablengewaehlt:=FALSE;variableneinstellensingle(variablenmuster,phasdg,variablengewaehlt,puebers);IFvariablengewaehltTHENzeigevergleichskurvefuerphasendiagramm(taste,LOESUNGSABSCHNITTlsg(1).gesamt,LOESUNGSABSCHNITTlsg(2).gesamt,variablenmuster);fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichphasendiagramm;PROCausgabevergleichhistogramm:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,histdg,variablengewaehlt,huebers);IFvariablengewaehltTHENzeigevergleichskurve(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster,"h");fehlerbehandlungnachgraphik(FALSE);ELSEerase(fsingle);do("refresh submenu");oldfootnote;FI;END PROCausgabevergleichhistogramm;PROCausgabevergleichtabelle:BOOL VARvariablengewaehlt:=FALSE;ZUSTAND VARvariablenmuster;TEXT VARtaste:="";variableneinstellensingle(variablenmuster,tabdg,variablengewaehlt,tuebers);IFvariablengewaehltTHENzeigevergleichfuertabelle(taste,lsg(1).gesamt,lsg(2).gesamt,variablenmuster);FI;erase(fsingle);do("refresh submenu");oldfootnote;END PROCausgabevergleichtabelle;PROCinfoszummodell:LETdateienname="liste",spaltenbreite=0;WINDOW VARfshow:=scrollfenster;FILE VARmdlinfo;TEXT VARausstieg:="";INT VARerstersatz1:=3,erstespalte1:=1;TEXT CONSTausstiegszeichen:=showverlasszeichen;IFwirkungsdgrTHENmdlinfo:=sequentialfile(output,infofuerwd);zeigeinfo;ELSEforget(dateienname,quiet);mdlinfo:=sequentialfile(output,dateienname);mdlinfo:=informationstext(dateienname);zeigeinfo;forget(dateienname,quiet);FI;.zeigeinfo:footnote(steuerleiste(stleistefileverlassen));scroll(fshow,mdlinfo,1,scrollzeile,spaltenbreite,erstersatz1,erstespalte1,ausstiegszeichen,ausstieg);.END PROCinfoszummodell;BOOL PROCeinelsgberechnet:(lsg(1).berechnet)COR(lsg(2).berechnet).END PROCeinelsgberechnet;BOOL PROCdarstellungzugelassen(INT CONSTdarst):SELECTdarstOF CASEzeitdg:TRUE CASEphasdg:mitphasendiagrammCANDdimension+codimension>=2CASEtabdg:TRUE CASEhistdg:TRUE CASEzusdg:mitzusatzdarstellungOTHERWISE FALSE END SELECT.END PROCdarstellungzugelassen;BOOL PROCmindzweilsgberechnet:(lsg(1).berechnetCANDlsg(2).berechnet).END PROCmindzweilsgberechnet;PROCvariableneinstellensingle(ZUSTAND VARmuster1,INT CONSTart1,BOOL VARgewaehlt,TEXT CONSTueberschr1):TEXT VARkombinationsname:="";ROWmaxTEXT VARkombnamen;INT VARanzahlkombinationen:=0,stelle1,stelle2,knr:=0;BOOL VARautomatik:=FALSE;TEXT VARmarkers1:="";THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus;muster1:=neuerzustand(dimension+codimension);IFart1=phasdgANDmitkombinationenTHENermittlevariablenpkELIFart1=phasdgAND NOTmitkombinationenTHENermittlevariablenpELIFart1=tabdgTHENermittlevariablentELIFwiezeitdiagramm(art1)THENermittlevariablenzFI;.ermittlevariablent:ermittlevariablenliste(angebot1);auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot1,dimension+codimension,ueberschr1,kopfzeile(kopfbeliebigvielevar));gewaehlt:=
+notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);FI;.ermittlevariablenz:ermittlevariablenliste(angebot1);auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot1,max4variablen,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);FI;.ermittlevariablenpk:listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;gewaehlt:=TRUE;ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);kombinationsname:=one(singlesp1,zl1,singlebr,hoe,angebot1,ueberschr1,kopfzeile(kopfgenaueinexykombin));gewaehlt:=kombinationsname<>"";IFgewaehltTHENknr:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);FI;.ermittlevariablenp:markers1:="xy";ermittlevariablenliste(angebot1);auswahl1:=someexactly(singlesp1,zl1,singlebr,hoe,angebot1,2,ueberschr1,kopfzeile(kopfxyeingabe),markers1);gewaehlt:=notempty(auswahl1);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);FI;.max4variablen:min(4,dimension+codimension).END PROCvariableneinstellensingle;PROCvariableneinstellendouble(ZUSTAND VARmuster1,muster2,INT CONSTart1,art2,BOOL VARgewaehlt,TEXT CONSTueberschr1,ueberschr2):TEXT VARkombinationsname:="";ROWmaxTEXT VARkombnamen;INT VARanzahlkombinationen:=0,stelle1,stelle2,knr:=0;BOOL VARautomatik:=FALSE;TEXT VARmarkers1:="",markers2:="";THESAURUS VARangebot1:=emptythesaurus,auswahl1:=emptythesaurus,angebot2:=emptythesaurus,auswahl2:=emptythesaurus;IFart1=phasdgANDwiezeitdiagramm(art2)AND NOTmitkombinationenTHENermittlevariablenpundzELIFwiezeitdiagramm(art1)ANDart2=phasdgAND NOTmitkombinationenTHENermittlevariablenzundpELIFart1=phasdgANDwiezeitdiagramm(art2)ANDmitkombinationenTHENermittlevariablenpkundzELIFwiezeitdiagramm(art1)ANDart2=phasdgANDmitkombinationenTHENermittlevariablenzundpkELIFart1=phasdgANDart2=phasdgANDmitkombinationenTHENermittlevariablenpkundpkELIFart1=phasdgANDart2=phasdgAND NOTmitkombinationenTHENermittlevariablenpundpELIFwiezeitdiagramm(art1)ANDwiezeitdiagramm(art1)THENermittlevariablenzundzFI;.ermittlevariablenpundz:ermittlevariablenliste(angebot1);markers1:="xy";markers2:="x";auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,2,2,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfxyeingabe),ueberschr2,kopfzeile(kopfmax4variablen),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);belegemuster(auswahl2,angebot1,muster2);FI;.ermittlevariablenzundp:ermittlevariablenliste(angebot1);markers1:="x";markers2:="xy";auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,4,2,2,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfxyeingabe),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);belegemuster(auswahl2,angebot1,muster2,markers2);FI;.ermittlevariablenpkundz:ermittlevariablenliste(angebot2);listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;auswahl2:=somewithmax(singlesp1,zl1,singlebr,hoe,angebot2,4,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl2);ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot2;doublesome(zl1,hoe,1,1,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfgenaueinexykombin),ueberschr2,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl1,kombinationsname,knr);knr:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);belegemuster(auswahl2,angebot2,muster2);FI;.ermittlevariablenzundpk:ermittlevariablenliste(angebot1);listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;auswahl1:=somewithmax(singlesp1,zl1,singlebr,hoe,
+angebot1,4,ueberschr1,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1);ELSEangebot2:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot2;doublesome(zl1,hoe,1,4,1,1,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfgenaueinexykombin));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl2,kombinationsname,knr);knr:=link(angebot2,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(auswahl1,angebot1,muster1);belegemuster(muster2,stelle1,stelle2,automatik);FI;.ermittlevariablenpkundpk:INT VARknr2:=0;listekombinationen(kombnamen,anzahlkombinationen);IFanzahlkombinationen=1THENknr:=1;knr2:=1;gewaehlt:=TRUE;ELSEangebot1:=mengederkombinationen(kombnamen,anzahlkombinationen);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,1,1,1,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfgenaueinexykombin),ueberschr2,kopfzeile(kopfgenaueinexykombin));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENknr:=0;get(auswahl1,kombinationsname,knr);knr:=link(angebot1,kombinationsname);knr2:=0;get(auswahl2,kombinationsname,knr2);knr2:=link(angebot1,kombinationsname);FI;FI;IFgewaehltTHENindiceskombinationen(knr,stelle1,stelle2,automatik);belegemuster(muster1,stelle1,stelle2,automatik);indiceskombinationen(knr2,stelle1,stelle2,automatik);belegemuster(muster2,stelle1,stelle2,automatik);FI;.ermittlevariablenpundp:markers1:="xy";markers2:="xy";ermittlevariablenliste(angebot1);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,2,2,2,2,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfxyeingabe),ueberschr2,kopfzeile(kopfxyeingabe),markers1,markers2);gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1,markers1);belegemuster(auswahl2,angebot1,muster2,markers2);FI;.ermittlevariablenzundz:ermittlevariablenliste(angebot1);auswahl1:=angebot1;auswahl2:=angebot1;doublesome(zl1,hoe,1,4,1,4,auswahl1,auswahl2,ueberschr1,kopfzeile(kopfmax4variablen),ueberschr2,kopfzeile(kopfmax4variablen));gewaehlt:=notempty(auswahl1)ANDnotempty(auswahl2);IFgewaehltTHENbelegemuster(auswahl1,angebot1,muster1);belegemuster(auswahl2,angebot1,muster2);FI;.END PROCvariableneinstellendouble;PROCbelegemuster(ZUSTAND VARmuster,INT VARplace1,place2,BOOL CONSTvertauschbar):replace(muster,place1,1.0);IFvertauschbarTHENreplace(muster,place2,1.0)ELSEreplace(muster,place2,2.0)FI;END PROCbelegemuster;PROCbelegemuster(THESAURUS CONSTauswahl,angebot,ZUSTAND VARmuster,TEXT CONSTmarkers):TEXT VARname1:="",name2:="";INT VARplacea:=0,placeb:=1;get(auswahl,name1,placea);get(auswahl,name2,placeb);placea:=link(angebot,name1);placeb:=link(angebot,name2);IF(markersSUB1)=(markersSUB2)THENreplace(muster,placea,1.0);replace(muster,placeb,1.0);ELIF(markersSUB1)="x"THENreplace(muster,placea,1.0);replace(muster,placeb,2.0);ELSEreplace(muster,placeb,1.0);replace(muster,placea,2.0);FI;END PROCbelegemuster;PROCbelegemuster(THESAURUS CONSTauswahl,angebot,ZUSTAND VARmuster):TEXT VARvname;INT VARzeiger;get(auswahl,vname,zeiger);WHILEvname<>""REPreplace(muster,link(angebot,vname),1.0);get(auswahl,vname,zeiger);PER;END PROCbelegemuster;PROCermittlevariablenliste(THESAURUS VARangebot):INT VARi;FORiFROM1UPTOdimensionREPinsert(angebot,variablenname(i));PER;FORiFROM1UPTOcodimensionREPinsert(angebot,covariablenname(i));PER;.END PROCermittlevariablenliste;THESAURUS PROCmengederkombinationen(ROWmaxTEXT CONSTkombnamen,INT CONSTanzahlkombinationen):THESAURUS VARangebot:=emptythesaurus;INT VARi;FORiFROM1UPTOanzahlkombinationenREPinsert(angebot,kombnamen(i));PER;angebot.END PROCmengederkombinationen;BOOL PROCwiezeitdiagramm(INT CONSTart):art=zeitdgORart=histdgORart=tabdg.END PROCwiezeitdiagramm;INT PROCdarstellungsart(TEXT CONSTdarstellungsname):IFdarstellungsname=zuebersTHENzeitdgELIFdarstellungsname=puebersTHENphasdgELIFdarstellungsname=huebersTHENhistdgELIFdarstellungsname=tuebersTHENtabdgELSE0FI.END PROC
+darstellungsart;PROCrefreshundnrausgabe:giblsgnraus;do("refresh submenu");END PROCrefreshundnrausgabe;PROCplotendundregenerate:plotendundregenerate(TRUE);END PROCplotendundregenerate;PROCplotendundregenerate(BOOL CONSTmitlsgnrausgabe):plotend;do("regenerate menuscreen;");IFmitlsgnrausgabeTHENgiblsgnraus;FI;END PROCplotendundregenerate;PROCfehlerbehandlungnachgraphik(BOOL CONSTmitlsgnr):enablestop;IF NOTiserrorTHENplotendundregenerate(mitlsgnr)ELSEzeigekopfbalken;FI;END PROCfehlerbehandlungnachgraphik;LETlsgwindowy=20,lsgwindowx=3,lsgwindowb=30,lsgwindowh=2;WINDOW VARlsgwindow:=window(lsgwindowx,lsgwindowy,lsgwindowb,lsgwindowh);PROCgiblsgnraus:erase(lsgwindow);outframe(lsgwindow);cursor(lsgwindow,1,1);putline(lsgwindow,lsgnrtext1);put(lsgwindow,lsgnrtext2);.END PROCgiblsgnraus;PROCevtneueaktivierungausgeben(INT CONSTsubmenu):INT VARi;aktivierunggeaendert:=FALSE;FORiFROM1UPTO8REP IF(aktivierung(submenu)(i)XORaktivaktuell(i))ORerstesaufklappen(submenu)THENaktivierunggeaendert:=TRUE;aktivierung(submenu)(i):=aktivaktuell(i);IFaktivaktuell(i)THENdo("activate ("+text(i)+")");ELSEdo("deactivate ("+text(i)+")");FI;FI;PER;erstesaufklappen(submenu):=FALSE;.END PROCevtneueaktivierungausgeben;PROCuebergebeinfotextfuerwd(DATASPACE CONSTwdinfo):infofuerwd:=wdinfo;END PROCuebergebeinfotextfuerwd;PROCzeigekopfbalken:cursor(1,1);out(invers(subtext(kopfbalken,1,headzeilenlaenge)));END PROCzeigekopfbalken;END PACKETlsbearbeitungsmenu;
+
diff --git a/app/schulis-simulationssystem/3.0/src/m b/app/schulis-simulationssystem/3.0/src/m
new file mode 100644
index 0000000..5825df6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/m
@@ -0,0 +1,3 @@
+PACKETmatrixDEFINESdiagrammankoppeln,aenderungenspeichern,initcellmatrix,WRITE,NR,AUSGANG,EINGANG,UEBER,CELL,newcell,deletecell,cell,:=,mpos,objekt,typbezeichner,belegt,freieverknuepfungspunkte,belegteverknuepfungspunkte,link,loeschelink,variablenthesaurus,ergebnisthesaurus,formelthesaurus,parameterthesaurus,diagrammnameneintragen,aktuellermodellname,aktuellermodellkurzname,wdlauffaehig,anzahlmpos,getmpos:LETmaxi=20,maxj=10,maxlink=8,matrixtyp1=1107,matrixtyp2=1207,lengthfuerintimtext=2,to=1,from=2;TYPE LINK=STRUCT(INTrichtung,MPOSmpos,INTnr);TYPE CELL=STRUCT(BOOLstatus,MPOSmpos,ROWmaxlinkLINKfromorto,OBJEKTobj);TYPE MATRIX=STRUCT(ROWmaxiROWmaxjCELLmat,THESAURUSvthesaurus,ethesaurus,pthesaurus,fthesaurus,TEXTmodellname,modellkurzname,BOOLlauffaehig);BOUND MATRIX VARmatrix;DATASPACE VARds,nilwd;INITFLAG VARnilwdeingerichtet:=FALSE;PROCdiagrammankoppeln(DATASPACE VARmodellds):forget(ds);ds:=modellds;IFmatrixtyp1=type(ds)CORmatrixtyp2=type(ds)THENmatrix:=dsELSEerrorstop("Datenraum hat falschen Typ!")FI;forget(modellds)END PROCdiagrammankoppeln;PROCdiagrammnameneintragen(TEXT CONSTlangname,kurzname):matrix.modellname:=langname;matrix.modellkurzname:=kurznameEND PROCdiagrammnameneintragen;PROCaenderungenspeichern(TEXT CONSTdsname):IFmatrix.lauffaehigTHENtype(ds,matrixtyp2)ELSEtype(ds,matrixtyp1)FI;forget(dsname,quiet);copy(ds,dsname)END PROCaenderungenspeichern;PROCinitcellmatrix:INT VARi,j,l;forget(ds);IF NOTinitialized(nilwdeingerichtet)THENnilwd:=nilspace;felderinitialisieren;type(nilwd,matrixtyp1)FI;ds:=nilwd;matrix:=ds.felderinitialisieren:matrix:=nilwd;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREPcell.obj:=new(nil);cell.mpos:=newmpos(i,j);cell.status:=FALSE;FORlFROM1UPTOmaxlinkREPcell.fromorto(l).richtung:=0;cell.fromorto(l).mpos:=null;cell.fromorto(l).nr:=0PER PER PER;matrix.vthesaurus:=emptythesaurus;matrix.ethesaurus:=emptythesaurus;matrix.pthesaurus:=emptythesaurus;matrix.fthesaurus:=emptythesaurus;matrix.modellname:="";matrix.modellkurzname:="";matrix.lauffaehig:=FALSE.cell:matrix.mat(i)(j).END PROCinitcellmatrix;OP:=(LINK VARl,LINK CONSTr):l.richtung:=r.richtung;l.mpos:=r.mpos;l.nr:=r.nrEND OP:=;CELL PROCcell(MPOS CONSTmpos):matrix.mat(impos(mpos))(jmpos(mpos))END PROCcell;CELL PROCcell(GPOS CONSTgpos):cell(mpos(gpos))END PROCcell;CELL PROCcell(INT CONSTi,j):matrix.mat(i)(j)END PROCcell;THESAURUS PROCvariablenthesaurus:matrix.vthesaurusEND PROCvariablenthesaurus;THESAURUS PROCergebnisthesaurus:matrix.ethesaurusEND PROCergebnisthesaurus;THESAURUS PROCparameterthesaurus:matrix.pthesaurusEND PROCparameterthesaurus;THESAURUS PROCformelthesaurus:matrix.fthesaurusEND PROCformelthesaurus;TEXT PROCaktuellermodellname:matrix.modellnameEND PROCaktuellermodellname;TEXT PROCaktuellermodellkurzname:matrix.modellkurznameEND PROCaktuellermodellkurzname;BOOL PROCwdlauffaehig:matrix.lauffaehigEND PROCwdlauffaehig;PROCwdlauffaehig(BOOL CONSTwert):matrix.lauffaehig:=wertEND PROCwdlauffaehig;PROCnewcell(OBJEKT CONSTobj,MPOS CONSTpos):initialisieren;verbindungen;inthesauruseinordnen.initialisieren:cell.obj:=obj;cell.mpos:=pos;cell.status:=TRUE;.verbindungen:INT VARi;FORiFROM1UPTOmaxlinkREPcell.fromorto(i).richtung:=0;cell.fromorto(i).mpos:=null;cell.fromorto(i).nr:=0PER.inthesauruseinordnen:i:=0;TEXT VARmposimtext:=text(impos(pos),lengthfuerintimtext)+text(jmpos(pos),lengthfuerintimtext);IFtyp(obj)=variableTHENinsert(matrix.vthesaurus,mposimtext,i)ELIFtyp(obj)=ergebnisTHENinsert(matrix.ethesaurus,mposimtext,i)ELIFtyp(obj)=parameterTHENinsert(matrix.pthesaurus,mposimtext,i)ELIFtyp(obj)=formelTHENinsert(matrix.fthesaurus,mposimtext,i)FI.cell:matrix.mat(impos(pos))(jmpos(pos)).END PROCnewcell;OP:=(CELL VARl,CELL CONSTr):CONCR(l):=CONCR(r)END OP:=;PROCdeletecell(MPOS CONSTm):deletecell(impos(m),jmpos(m))END PROCdeletecell;PROCdeletecell(INT CONSTi,j):matrix.mat(i)(j).status:=FALSE;INT VARd:=0;TEXT VARmposimtext:=text(i,lengthfuerintimtext)+text(j,lengthfuerintimtext);IFtyp(obj)=variableTHENdelete(matrix.vthesaurus,mposimtext,d)ELIFtyp(obj)=ergebnis
+THENdelete(matrix.ethesaurus,mposimtext,d)ELIFtyp(obj)=parameterTHENdelete(matrix.pthesaurus,mposimtext,d)ELIFtyp(obj)=formelTHENdelete(matrix.fthesaurus,mposimtext,d)FI.obj:matrix.mat(i)(j).obj.END PROCdeletecell;BOOL OP AUSGANG(CELL CONSTc,INT CONSTi):c.fromorto(i).richtung=toEND OP AUSGANG;BOOL OP EINGANG(CELL CONSTc,INT CONSTi):c.fromorto(i).richtung=fromEND OP EINGANG;MPOS OP UEBER(CELL CONSTc,INT CONSTi):c.fromorto(i).mposEND OP UEBER;INT OP NR(CELL CONSTc,INT CONSTi):c.fromorto(i).nrEND OP NR;TEXT PROCfreieverknuepfungspunkte(CELL CONSTc):TEXT VARfreiepunkte:="";INT VARi;FORiFROM1UPTOmaxlinkREP IF(c.fromorto(i).mpos=null)THENfreiepunkteCATtext(i,1)FI PER;freiepunkteEND PROCfreieverknuepfungspunkte;TEXT PROCbelegteverknuepfungspunkte(CELL CONSTc):TEXT VARfreiepunkte:="";INT VARi;FORiFROM1UPTOmaxlinkREP IF NOT(c.fromorto(i).mpos=null)THENfreiepunkteCATtext(i,1)FI PER;freiepunkteEND PROCbelegteverknuepfungspunkte;PROClink(MPOS CONSTsourcepos,INT CONSTsourcelinkpos,MPOS CONSTtargetpos,INT CONSTtargetlinkpos):source.fromorto(sourcelinkpos).richtung:=to;source.fromorto(sourcelinkpos).mpos:=targetpos;source.fromorto(sourcelinkpos).nr:=targetlinkpos;target.fromorto(targetlinkpos).richtung:=from;target.fromorto(targetlinkpos).mpos:=sourcepos;target.fromorto(targetlinkpos).nr:=sourcelinkpos.source:matrix.mat(impos(sourcepos))(jmpos(sourcepos)).target:matrix.mat(impos(targetpos))(jmpos(targetpos)).END PROClink;PROCloeschelink(MPOS CONSTactualmpos,INT CONSTnr):IFactualcellissourceTHENtarget.fromorto(targetlinkpos).richtung:=0;target.fromorto(targetlinkpos).mpos:=null;target.fromorto(targetlinkpos).nr:=0;source.fromorto(nr).richtung:=0;source.fromorto(nr).mpos:=null;source.fromorto(nr).nr:=0;ELIFactualcellistargetTHENsource.fromorto(sourcelinkpos).richtung:=0;source.fromorto(sourcelinkpos).mpos:=null;source.fromorto(sourcelinkpos).nr:=0;target.fromorto(nr).richtung:=0;target.fromorto(nr).mpos:=null;target.fromorto(nr).nr:=0FI.actualcell:matrix.mat(impos(actualmpos))(jmpos(actualmpos)).actualcellissource:INT VARsi:=impos(actualmpos),sj:=jmpos(actualmpos),ti:=impos(othermpos),tj:=jmpos(othermpos);actualcell.fromorto(nr).richtung=to.actualcellistarget:ti:=impos(actualmpos);tj:=jmpos(actualmpos);si:=impos(othermpos);sj:=jmpos(othermpos);actualcell.fromorto(nr).richtung=from.othermpos:actualcell.fromorto(nr).mpos.source:matrix.mat(si)(sj).target:matrix.mat(ti)(tj).targetlinkpos:source.fromorto(nr).nr.sourcelinkpos:target.fromorto(nr).nr.END PROCloeschelink;BOOL PROCbelegt(CELL CONSTc):c.statusENDPROCbelegt;BOOL PROCbelegt(MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).statusENDPROCbelegt;BOOL PROCbelegt(INT CONSTi,j):matrix.mat(i)(j).statusENDPROCbelegt;OBJEKT PROCobjekt(CELL CONSTc):c.objEND PROCobjekt;OBJEKT PROCobjekt(MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).objEND PROCobjekt;TEXT PROCtypbezeichner(CELL CONSTc):typbezeichner(objekt(c))END PROCtypbezeichner;OP WRITE(OBJEKT CONSTo,MPOS CONSTm):matrix.mat(impos(m))(jmpos(m)).obj:=oEND OP WRITE;MPOS PROCmpos(CELL CONSTc):c.mposEND PROCmpos;PROCgetmpos(THESAURUS CONSTt,MPOS VARm,INT VARi):TEXT VARmposimtext:="";get(t,mposimtext,i);IFmposimtext<>""THENm:=newmpos(int(subtext(mposimtext,1,lengthfuerintimtext)),int(subtext(mposimtext,1+lengthfuerintimtext,2*lengthfuerintimtext)))FI END PROCgetmpos;INT PROCanzahlmpos(THESAURUS CONSTt):INT VARi:=0,anzahl:=0;TEXT VARmposimtext:="";WHILEi<highestentry(t)REPget(t,mposimtext,i);IFmposimtext<>""THENanzahlINCR1FI PER;anzahlEND PROCanzahlmpos;END PACKETmatrix;
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.binder plot b/app/schulis-simulationssystem/3.0/src/mat.binder plot
new file mode 100644
index 0000000..b5c8b10
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.binder plot
@@ -0,0 +1,5 @@
+PACKETbinderplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz,plotterkanal:LEThorpixelmaxdurch16=85,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc=""27"",unterstreichenaus="Y",fettdruckaus="""",zeilenabstand="T15",druckrichtung=">",druckart="I",schrifttyp="H",formfeed=""12"",linefeed=""10"",cr=""13"";;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord,anzahldernadelspalten,i,printerchannel:=15;REAL VARhorfaktor,vertfaktor,faktor;horpixel:=1360;verpixel:=900;anzahldernadelspalten:=900;horfaktor:=50.3937;vertfaktor:=47.24409;REAL VARbuchstabenhoehe:=0.762,buchstabenbreite:=0.3373438;BOUND ROWhorpixelmaxdurch16TEXT VARbitmap;INT VARplotterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=26.9875;ycm:=19.05;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1).ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT VARspaltenzaehler;bitmap:=old(namederbitmap);druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+unterstreichenaus);out(esc+fettdruckaus);out(esc+zeilenabstand);out(esc+druckrichtung);out(esc+schrifttyp).seitenvorschub:out(formfeed).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask,plotterchannel).bitmapdrucken:FORspaltenzaehlerFROM(groesstexkoordDIV16)+1DOWNTO1REPbefehlssequenzschickenPER.zeilenbeginn:groessteykoord+1.befehlssequenzschicken:out(esc+druckart+neueanzahldernadelspalten);teilzeileausgeben;out(cr+linefeed).neueanzahldernadelspalten:nullen+text(zeilenbeginn).nullen:(4-LENGTHtext(zeilenbeginn))*"0".teilzeileausgeben:outsubtext(bitmap(spaltenzaehler),vontextpos,bistextpos).vontextpos:2*(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:2*anzahldernadelspaltenEND PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet)END PROCplotend;PROCclear:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);xpos:=0;ypos:=0;pen(0,1,0,1);INT VARj;TEXT VARleerespalte:=(2*verpixel)*"�";FORjFROM1UPTOhorpixelmaxdurch16REPbitmap(j):=leerespaltePER;groesstexkoord:=0;groessteykoord:=0END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT
+VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSE
+macheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz '"+name+"' existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1ELSEausgewaehlt:=3FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2ELSEausgewaehlt:=3FI;faktor:=matrixfaktor(ausgewaehlt).beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorEND IF PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);setbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCplot;PROCunplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);resetbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETbinderplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.epson-fx plot b/app/schulis-simulationssystem/3.0/src/mat.epson-fx plot
new file mode 100644
index 0000000..7595ed3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.epson-fx plot
@@ -0,0 +1,4 @@
+PACKETepsonfxplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",modus="L",schrifttyp="P",formfeed="�",zeilenvorschub="J�",minivorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=2328;verpixel:=905;horfaktor:=85.03937;vertfaktor:=47.24409;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);LET GRUPPE=STRUCT(ROW3TEXTspalte);BOUND ROWhorpixelmaxdurch24GRUPPE VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7662334,buchstabenbreite:=0.3421944;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code(zeilenbeginnMOD256)+code(zeilenbeginnDIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REP FORjFROM3DOWNTO1REPdruckeeinespalteeinergruppe;PER;vorschubPER.druckeeinespalteeinergruppe:out(esc+modus+neueanzahldernadelspalten);teilzeileausgeben;out(esc+minivorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i).spalte(j),vontextpos,bistextpos).vontextpos:(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:anzahldernadelspalten.vorschub:out(esc+zeilenvorschub+cr).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=verpixel*"�";FORiFROM1UPTOhorpixeldurch24REP FORjFROM1UPTO3REPbitmap(i).spalte(j):=leerPER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=
+totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxmod24:=xMOD24,xdiv24:=xDIV24;replace(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,setzebitintext(byte,xmod24DIV3,wert)).byte:subtext(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,verpixel-y).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code(subtext(byte,1,1));IFwertTHENsetbit(
+intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonfxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16")
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.epson-sq plot b/app/schulis-simulationssystem/3.0/src/mat.epson-sq plot
new file mode 100644
index 0000000..c591208
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.epson-sq plot
@@ -0,0 +1,4 @@
+PACKETepsonsqplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",abstand=100,esc="�",modus="*'",schrifttyp="P",unidirektional="U�",formfeed="�",zeilenvorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=1968;verpixel:=1346;horfaktor:=70.86614;vertfaktor:=70.86614;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);BOUND ROWhorpixelmaxdurch24TEXT VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7597422,buchstabenbreite:=0.3471333;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;INT CONSTvontextpos:=3*(anzahldernadelspalten-zeilenbeginn)+1,bistextpos:=3*anzahldernadelspalten;TEXT CONSTrand:=(3*abstand)*"�";bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp);out(esc+unidirektional).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code((abstand+zeilenbeginn)MOD256)+code((abstand+zeilenbeginn)DIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REPdruckeeinespalte;PER.druckeeinespalte:out(esc+modus+neueanzahldernadelspalten);out(rand);teilzeileausgeben;out(esc+zeilenvorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i),vontextpos,bistextpos).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=3*verpixel*"�";FORiFROM1UPTOhorpixeldurch24REPbitmap(i):=leerPER END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0
+UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxdiv24:=xDIV24,xdiv8:=xDIV8;replace(bitmap(1+xdiv24),posnrder3ergruppe+bytenrinnerhalbdernadelspalte,setzebitintext(byte,xMOD8,wert)).posnrder3ergruppe:(verpixel-y-1)*3+1.bytenrinnerhalbdernadelspalte:2-(xMOD24)DIV8.byte:bitmap(1+xdiv24)SUB(posnrder3ergruppe+bytenrinnerhalbdernadelspalte).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code(
+subtext(byte,1,1));IFwertTHENsetbit(intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonsqplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16")
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.hp72xx plot b/app/schulis-simulationssystem/3.0/src/mat.hp72xx plot
new file mode 100644
index 0000000..d197007
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.hp72xx plot
@@ -0,0 +1,3 @@
+PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=37.0,ycm=27.7,papierx1=1200,papierx2=16000,papiery1=320,papiery2=11400,plotterunitspercm=100.0;TEXT CONSTschlange:=code(126),terminator:=code(125);INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);BOUND TEXT VARpicture;INT VARterminalchannel,plotterchannel:=5;LET POS=STRUCT(INTx,y);POS VARposition:=POS:(0,0);REAL VARbuchstabenhoehe:=1.108,buchstabenbreite:=0.4625;INT VARvelocity:=10;LETbackspace="�",alt="",stand="",pktklein="}",pktgross="{";PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):IFx>0ANDx<37THENvelocity:=xFI END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:TEXT VARhp:="";move(0,0);sendepicture;hpCAT("v"+sbn(0));hpCAT"�"+".)";toplotterchannel;out(hp);toterminalchannel;ENDPROCplotend;PROCclear:terminalchannel:=channel;forget("picture ds",quiet);picture:=new("picture ds");picture:="";TEXT VARhp;hp:="�.(";hpout(hp);hp:="�.M:";hpout(hp);hp:="�.I1000;17;13:";hpout(hp);hp:=schlange;hpCAT"W";hpCATplotput(papierx1,papiery1);hpCATplotput(papierx2,papiery2);hpCATterminator;hpout(hp);hp:=schlange;hpCAT"S";hpCATplotput(xunits,yunits);hpCATterminator;hpout(hp);hpout("vA");hpout(schlange+"Q");hpout(schlange+"V"+sbn(velocity)+terminator);hpout(schlange+"P"+plotput(0,3));END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linetypesenden;verifypen;switchtopen;.verifypen:INT VARpen;pen:=max(0,foreground);pen:=min(4,pen).switchtopen:TEXT VARhp;hp:=("v"+sbn(pen));hpout(hp).linetypesenden:hp:=schlange+"Q";hpCATlinetypecode;hpout(hp).linetypecode:TEXT VARtt;tt:="";IFlinetype=0THENtt:=terminator;ELIFlinetype=1THENtt:=terminator;ELIFlinetype=2THENtt:=sbn(32+0)+sbn(1)+mbn(15)+terminator;ELIFlinetype=3THENtt:=sbn(32+1)+sbn(2)+mbn(15)+terminator;ELIFlinetype=4THENtt:=sbn(32+1)+sbn(2)+mbn(30)+terminator;ELIFlinetype=5THENtt:=sbn(32+1)+sbn(2)+sbn(32+2)+sbn(2)+mbn(28)+terminator;ELSEtt:=terminatorFI;ttEND PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:="";hpCAT"p";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:="";hpCAT"q";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp;INT VARspace:=int(width*plotterunitspercm),size:=int(height*plotterunitspercm*1.5);hp:=schlange+"%";hpCATplotput(space,size);hpout(hp);hp:=schlange+"'";ersetzeumlaute;hpCATumgesetztertext;hpCATcode(3);hpout(hp);move(position.x,position.y).ersetzeumlaute:TEXT VARumgesetztertext:="";INT VARi;FORiFROM1UPTO LENGTHrecordREPbildeneuentextPER.bildeneuentext:IF(pos("äöüÄÖÜß",(recordSUBi)))=0THENumgesetztertextCAT(recordSUBi)ELSEumgesetztertextCATersetzterumlautFI.ersetzterumlaut:IF"ä"=(recordSUBi)THENalt+"a"+pktklein+standELIF"ö"=(recordSUBi)THENalt+"o"+pktklein+standELIF"ü"=(recordSUBi)THENalt+"u"+pktklein+standELIF"Ä"=(recordSUBi)THENalt+"A"+pktgross+standELIF"Ö"=(recordSUBi)THENalt+"O"+pktgross+standELIF"Ü"=(recordSUBi)THENalt+"U"+pktgross+standELIF"ß"=(recordSUBi)THEN"P"+backspace+"p"ELSE""FI.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;TEXT PROCplotput(INT CONSTnx,ny):INT VARn,nx1,nx2,nx3,ny2,ny3,ny4,ny5,nxr,nyr;TEXT VARmbpformat;INT VARnp1,np2,np3,np4,np5;n:=nx;IF NOT(nx>ny)THENn:=ny;FI;IFn<256THEN IFn>31
+THENthreebyteformatELIFn>3THENtwobyteformatELSEonebyteformatFI;ELSE IFn<2048THENfourbyteformatELIFn<16384THENfivebyteformatELSEerrorstop("out of range: "+text(n));FI;FI;mbpformat.onebyteformat:np1:=ny+96+4*nx;mbpformat:=code(np1);.twobyteformat:nx1:=nxDIV2;nx2:=nx-2*nx1;np1:=nx1+96;np2:=ny+32*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;mbpformat:=code(np1)+code(np2);.threebyteformat:nx1:=nxDIV16;nx2:=nx-16*nx1;ny2:=nyDIV64;ny3:=ny-64*ny2;np1:=nx1+96;np2:=ny2+4*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3;IF NOT(np3>31)THENnp3:=np3+64;FI;mbpformat:=code(np1)+code(np2)+code(np3);.fourbyteformat:nx1:=nxDIV128;nxr:=nx-128*nx1;nx2:=nxrDIV2;nx3:=nxr-2*nx2;ny3:=nyDIV64;ny4:=ny-64*ny3;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+32*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4);.fivebyteformat:nx1:=nxDIV1024;nxr:=nx-1024*nx1;nx2:=nxrDIV16;nx3:=nxr-16*nx2;ny3:=nyDIV4096;nyr:=ny-4096*ny3;ny4:=nyrDIV64;ny5:=nyr-64*ny4;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+4*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;np5:=ny5;IF NOT(np5>31)THENnp5:=np5+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4)+code(np5);.END PROCplotput;TEXT PROCmbn(INT CONSTnn):TEXT VARmbnformat;INT VARnp1,np2,np3,nn1,nn2,nn3,nr;IFnn<16THENonebyteformatELIFnn<1024THENtwobyteformatELIFnn<=32767THENthreebyteformatELSEerrorstop("out of range: "+text(nn));FI;mbnformat.onebyteformat:np1:=nn+96;mbnformat:=code(np1).twobyteformat:nn1:=nnDIV64;nn2:=nn-64*nn1;assemble2;mbnformat:=code(np1)+code(np2);.threebyteformat:nn1:=nnDIV4096;nr:=nn-nn1*4096;nn2:=nrDIV64;nn3:=nr-64*nn2;assemble1;assemble2;mbnformat:=code(np1)+code(np2)+code(np3);.assemble1:np3:=nn3;IF NOT(np3>31)THENnp3:=np3+64;FI;.assemble2:np2:=nn2;IF NOT(np2>31)THENnp2:=np2+64;FI;np1:=nn1+96;.END PROCmbn;TEXT PROCsbn(INT CONSTnn):INT VARnp;np:=nn;IF NOT(np>31)THENnp:=np+64;FI;code(np).END PROCsbn;PROChpout(TEXT CONSTplotcommand):pictureCATplotcommand;IFlength(picture)>800THENsendepictureFI END PROChpout;PROCsendepicture:getlen;toplotterchannel;out(text(picture,len));picture:="";getacknowledge.getlen:INT VARlen:=min(1000,length(picture)).getacknowledge:clearinputbuffer;out("�");readhandshakechar.clearinputbuffer:WHILEincharety<>""REP PER.readhandshakechar:TEXT VARchar:="";INT VARsession;WHILEchar<>"
"REPinchar(char)PER;toterminalchannel.END PROCsendepicture;PROCtoplotterchannel:continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKEThpplot;plotterkanal(7)
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot b/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot
new file mode 100644
index 0000000..137f6c6
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.hp74xx plot
@@ -0,0 +1,3 @@
+PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=40.19,ycm=27.46,plotterunitspercm=402.0,buffersize=1024;LETinitcmd="IN",textcmd="LB",separator=",",terminator=";",outputterminator="
",movecmd="PU",drawcmd="PD",pencmd="SP",charsizecmd="SI",linetypecmd="LT",plotabscmd="PA",askbuffersize="�.B",stdcharpre="�CS33;LB",stdcharpost="�SS;LB",etx="�";ROW22TEXT CONSTnichtasciizeichen:=ROW22TEXT:(stdcharpre+"["+stdcharpost,stdcharpre+"\"+stdcharpost,stdcharpre+"]"+stdcharpost,stdcharpre+"{"+stdcharpost,stdcharpre+"|"+stdcharpost,stdcharpre+"}"+stdcharpost,"k","-","#"," ",stdcharpre+"~"+stdcharpost,"�UC3,0,99,0,16,-99,0,-8,99,-3,0;LB","�UC3,0,99,0,16;LB","�UC3,0,99,0,8,-4,0;LB","�UC0,8,99,3,0,0,8;LB","�UC3,16,99,0,-8,3,0;LB","�UC3,0,99,0,8,3,0;LB","�UC0,8,99,6,0,-99,-3,0,99,0,8;LB","�UC0,8,99,6,0,-99,-3,0,99,0,-8;LB","�UC3,0,99,0,16,-99,0,-8,99,3,0;LB","�UC0,8,99,6,0;LB","�UC0,8,99,6,0,-99,-3,-8,99,0,16;LB");INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=5;INT VARfreebytes;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoehe;END PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breite;END PROCstdbreite;PROCbeginplot:freebytes:=9;toplotterchannel;clear;TEXT VARhp:=pencmd;hpCAT"1";hpCATterminator;sendtoplotter(hp)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:clear;TEXT VARhp:=pencmd;hpCAT"0";hpCATterminator;hpCATinitcmd;hpCATterminator;sendtoplotter(hp);toterminalchannelENDPROCplotend;PROCclear:TEXT VARhp:=initcmd;hpCATterminator;hpCATplotabscmd;hpCATterminator;sendtoplotter(hp);END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):TEXT VARhp:=pencmd;IFforeground>6ORforeground<1THENhpCAT"1"ELSEhpCATtext(foreground)END IF;hpCATterminator;hpCATlinetypecmd;IFlinetype>1ANDlinetype<6THENhpCATtext(linetype-1);hpCATseparator;hpCAT"0.75";END IF;hpCATterminator;sendtoplotter(hp)END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:=movecmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:=drawcmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp:=charsizecmd,konvertiertertext:="";konvertieretext;hpCATtext(width*0.66666667,8,4);hpCATseparator;hpCATtext(height*0.5,8,4);hpCATterminator;hpCATtextcmd;hpCATkonvertiertertext;hpCATetx;sendtoplotter(hp).konvertieretext:INT VARstelle;INT VARzeichen;FORstelleFROM1UPTO LENGTHrecordREPEATzeichen:=code(recordSUBstelle);IFzeichen=251THENkonvertiertertextCATnichtasciizeichen[11]ELIFzeichen>=185ANDzeichen<=188THENkonvertiertertextCATnichtasciizeichen[zeichen-173]ELIFzeichen>=200ANDzeichen<=206THENkonvertiertertextCATnichtasciizeichen[zeichen-184]ELIFzeichen>=214ANDzeichen<=223THENkonvertiertertextCATnichtasciizeichen[zeichen-213]ELSEkonvertiertertextCATcode(zeichen)END IF END REPEAT END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;PROCsendtoplotter(TEXT CONSTstring):INT VARlaenge;laenge:=
+LENGTHstring;IFfreebytes<buffersizeDIV2ORfreebytes-9<laengeTHENwarteaufgenugfreienpufferEND IF;out(string);freebytesDECRlaenge;checkforerror.warteaufgenugfreienpuffer:TEXT VARplotteroutput,char;INT VARdelay:=0;REPplotteroutput:="";pause(delay);REP UNTILincharety=""PER;out(askbuffersize);freebytesDECR3;REPinchar(char);plotteroutputCATcharUNTILchar=outputterminatorPER;plotteroutput:=subtext(plotteroutput,1,LENGTHplotteroutput-1);freebytes:=int(plotteroutput);delay:=1;UNTILfreebytes>buffersizeDIV2ANDfreebytes-9>=laengePER.checkforerror:out("OE;");TEXT VARc,t;inchar(c);inchar(t);IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)FI;out("�.E");inchar(c);inchar(t);IFt<>outputterminatorTHENcCATt;inchar(t);END IF;IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)END IF;freebytesDECR6END PROCsendtoplotter;END PACKEThpplot;plotterkanal(7)
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.kyocera plot b/app/schulis-simulationssystem/3.0/src/mat.kyocera plot
new file mode 100644
index 0000000..6e75223
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.kyocera plot
@@ -0,0 +1,3 @@
+PACKETkyoceraplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz:LETxcm=29.7,ycm=19.7,bit14=16384,plotterunitspercm=118.1102;LETinitcmd="!R! UNIT d; SPO L;";LETleavecmd="SPO P; EXIT;",separator=",",terminator=";",movecmd="MZP ",drawcmd="DZP ";INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=15;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,printerchannel:=15;horpixel:=3507;verpixel:=2330;horfaktor:=300.0/2.54;vertfaktor:=300.0/2.54;INT VARxpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:toplotterchannel;out(initcmd)ENDPROCbeginplot;PROCendplot:plotendENDPROCendplot;PROCplotend:IFchannel=plotterchannelTHENout(leavecmd);toterminalchannelEND IF ENDPROCplotend;PROCclear:END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.movetoxy:xpos:=xx;ypos:=yy;TEXT VARky:=movecmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.drawtoxy:xpos:=xx;ypos:=yy;TEXT VARky:=drawcmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(
+xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:disablestop;continue(terminalchannel);IFiserrorTHENclearerror;break(quiet)END IF;enablestopEND PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETkyoceraplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.laserjet plot b/app/schulis-simulationssystem/3.0/src/mat.laserjet plot
new file mode 100644
index 0000000..0f5360b
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.laserjet plot
@@ -0,0 +1,3 @@
+PACKETlaserjetplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LETesc="�",reset="�E",graphicsresolution="�*t75R",formfeed="�",landscape="�&I1O",horpixel=800,verpixel=560,intsperscanline=50,horfaktor=29.52756,vertfaktor=29.52756,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARxpos,ypos,xfak,yfak,plotterchannel,groesstexkoord,groessteykoord,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.76,buchstabenbreite:=0.3375,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=27.0;ycm:=19.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARspaltenbeginn:=(groesstexkoordDIV16)+1,zeilenbeginn:=groessteykoord+1;TEXT VARdoppelbyte:="xx";druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out(reset);out(landscape);out(graphicsresolution);out("�*r1A").gibdiebitmapaus:INT VARzeilenzaehler;FORzeilenzaehlerFROMzeilenbeginnDOWNTO1REPbefehlssequenzschickenPER.befehlssequenzschicken:out(esc+"*b"+text(neueanzahlderbytes)+"W");gibteilzeileaus.neueanzahlderbytes:(spaltenbeginnDIV8)+1.gibteilzeileaus:INT VARspaltenzaehler;FORspaltenzaehlerFROM1UPTOneueanzahlderbytesDIV2REPreplace(doppelbyte,1,bitmap(zeilenzaehler)(spaltenzaehler));out(doppelbyte)PER.druckedieseite:out("�*rB");out("�E").END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD
+12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETlaserjetplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-simulationssystem/3.0/src/mat.xerox4045 plot b/app/schulis-simulationssystem/3.0/src/mat.xerox4045 plot
new file mode 100644
index 0000000..d78d2ca
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/mat.xerox4045 plot
@@ -0,0 +1,4 @@
+PACKETxeroxplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LEThorpixel=720,verpixel=532,intsperscanline=45,horfaktor=29.528,vertfaktor=29.528,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARanzahlgleichersixel,altessixel,plotterchannel:=15;INT VARxpos,ypos,xfak,yfak,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.75,buchstabenbreite:=0.305,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=24.4;ycm:=18.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARbitsleft:=0,bits,hilfsvariable,buffer;anzahlgleichersixel:=1;druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterkanal).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out("�+X
�+0XCP12.5iso-L
�0"+"�+P
�m2480,0,0,0,3508
�gw");magnification4;out(";236,312,"+text(horpixel)+","+text(verpixel)+"
");altessixel:=-53.magnification4:out("4").gibdiebitmapaus:INT VARi;FORiFROMverpixelDOWNTO1REPgibeinezeilederbitmapausPER.gibeinezeilederbitmapaus:INT VARj;FORjFROM1UPTOintsperscanlineREPbits:=bitmap(i)(j);gibdie16bitsalssixelausPER.gibdie16bitsalssixelaus:SELECTbitsleftOF CASE0:sendemitshift0CASE2:sendemitshift2CASE4:sendemitshift4END SELECT.sendemitshift0:sixelsend(firstsixbits);sixelsend((bitsAND1008)DIV16);buffer:=((bitsAND15)*4);bitsleft:=4.firstsixbits:hilfsvariable:=bits;rotate(hilfsvariable,6);hilfsvariableAND63.sendemitshift2:sixelsend(buffer+firstfourbits);sixelsend((bitsAND4032)DIV64);sixelsend(bitsAND63);bitsleft:=0.firstfourbits:hilfsvariable:=bits;rotate(hilfsvariable,4);hilfsvariableAND15.sendemitshift4:sixelsend(buffer+firsttwobits);sixelsend((bitsAND16128)DIV256);sixelsend((bitsAND252)DIV4);buffer:=((bitsAND3)*16);bitsleft:=2.firsttwobits:hilfsvariable:=bits;rotate(hilfsvariable,2);hilfsvariableAND3.druckedieseite:sendeletztessixel;out("��+P
").sendeletztessixel:sixelsend(-1).END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;korrigierenextpointnr.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<
+totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;PROCsixelsend(INT CONSTneuessixel):IFneuessixel<>altessixelTHENsendealtessixel;altessixel:=neuessixelELIFanzahlgleichersixel<32000THENanzahlgleichersixelINCR1ELSEsendealtessixel;altessixel:=neuessixelFI.sendealtessixel:IFanzahlgleichersixel=1THENout(code(altessixel+63))ELSEout(text(anzahlgleichersixel)+code(altessixel+63));anzahlgleichersixel:=1FI.END PROCsixelsend;INT PROCplotterkanal:plotterchannel
+END PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETxeroxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16");
+
diff --git a/app/schulis-simulationssystem/3.0/src/modellbasis dialog b/app/schulis-simulationssystem/3.0/src/modellbasis dialog
new file mode 100644
index 0000000..17202fe
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/modellbasis dialog
@@ -0,0 +1,24 @@
+PACKETmodellbasisDEFINESinfotextauswahl,auskunftsdienst,modellmitdatenfuellen,listemodellbanken,anzahlmodellbanken,listedermodelle,anzahldglmodelle,anzahlwdmodelle,anzahlausfuehrbarerwdmodelle,fuegeein,loesche,modelldatenraum,neuebank,modellbankvolldgl,modellbankvollwd,modellbankvoll,copy,modellaktuell,MODELLDGL,compilierbaregleichungen,modellname,modellbezeichnung,informationstext,vorgabekurve,vorgabevergleichskurve,:=,modellerfassung,nilmodell,kopplean,wdmodelle,wddsnamen,wdeinfuegen,wdumbenennen,komprimiere,KRITERIUM,allemodelle,alleaenderbaren,allelauffaehigen,schickeanmanagertask,putgetformular1:
+LETesc=""27"",return=""13"",rechts=""2"",links=""8"",hoch=""3"",runter=""10"",tab=""9"",dsname="Modell Infodatei",auskunftseite1=""28"",allgemeineauskunftseite2=""29""30""31"",auskeingabebeispiel=""42"",auskdatenkorrekt=""43"",auskfehlerfestgestellt=""44"",auskgleichungunvollstaendig=""45"",ausklabelzulang=""46"",ausklabeldoppelt=""47""48"",auskcompilunbekkomm=""49"" ,auskcompilparameter=""50"" ,auskcompilsymbole=""51""52"" ,auskkeinegleichungen=""53"",auskunftzummodellerfassenseite2=""54""56"",auskvariablen=59,auskmodell=62,auskgleichungen=63,auskparameter=64,auskcompilungueltzw=""65""66"" ,auskcompilmehrfdekl=""67"" ,auskcompilsonstiges=""68"" ;
+LETmaxmodelle=40,maxdglmodelle=20,maxwdmodelle=20,maxdialogpkt=20,maxinterpretlaenge=2000,terminaltaskname="ARBEITSPLATZ",geraetekanal=1,simulationneustarten=10,typnrmodellbank=1199,typnrwdausfuehrbar=1207,dglsuffix="(DGL)",wdsuffix=" (WD)",maxdimension=20,maxparameter=20,typnrmodell=1077,maxvarlaenge=30,maxinfo=50,maxgleichungen=50,maxdarstellungszeilen=500,uebersetzbar=0,notuebersetzbar=1,endezeichen="zZz",sp=" ",praefix="d ",modellcode=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds",darstellungskopf="  PROC darstellung 4 (LOESUNG VAR lsg, BOOL VAR in demo, TEXT VAR taste):",darstellungsende="  END PROC darstellung 4 ;";LETbtsimulationunmoeglich=63,btwartenallgemein=44,btwartenwaehrendspeichern=87,btwartenwaehrenddrucken=88;INT CONSTexistiertnicht:=-1,nichtempfangsbereit:=-2;LETabbruchtaste="a",abbruchtastemenu="m",auskunftstaste="i",auskunftsloeschtaste1="z",auskunftsloeschtaste2="l",weitertaste="w",blaettertaste="b",speichertaste="s",zuruecktaste="z",simulationstaste="w",prueftaste="p",drucktaste="d",dupliziertaste="k",loeschtaste="-",wiedergabetaste="+",spalte3=3,infozeilenanfang=19,ersteseingabefeld=2,beginnseite1=1,endeseite1=10,beginnseite2=11,endeseite2=20,bildschirmzeilen=10,maxzeileneingabe=20,maxvarparaanzahl=61,maxvariablenlaenge=7,maxparlaenge=30,maxmodellnamelang=30,maxmodellnamelangaufgeblaeht=40,maxmodellnamekurz=15,stmenuoderweiter=33,auskihrfehler=7,auskpruefung=13,auskgespeichert=14,auskinfogedruckt=15;LETunbekkommdo="unbekanntes Kommando",undefdyadischop="undefinierter dyadischer",undefmonadop="undefinierter monadischer",paramsindfalsch="Typen der Parameter sind falsch",nurletzteanweisg="nur die letzte Anweisung",anstelledessymb="anstelle des letzten Symbols",unzulselektsymb="unzulaessiges Selektor-Symbol",konstdarfnicht="die Konstante darf nicht veraendert",klammerauffehlt="'(' fehlt",klammerzufehlt="')' fehlt",operatorfehlt="';' oder Operator ('+',",ungueltigzwischen="ungueltig zwischen Anweisungen",istmehrfachdekl="ist mehrfach deklariert";LETfehlertaste=4,fehlerparameterzulang=28,fehlerkopierposition=29,fehlerlangname=80,fehlerkurzname=81,fehlerlangnamefehlt=82,fehlerkurznamefehlt=83,fehlergleichungsart=85,fehlergleichungsartfehlt=86,fehlergleichungfehlt=87,fehlervariable=88,fehlervariablefehlt=89,fehlervariablezulang=90,fehlerdoppeldeklaration=91,fehlermodellnamedoppelt=92,fragenochmalspeichern=93,fehlervundgdoppelt=94,fehlerzeitvariabledoppelt=95,fragehierabspeichern=96,mldcursorbenutzung=97,mldnichtablauffaehig=98;TEXT CONSTgleichungsunterstriche:=60*"_"+140*" ",variablenunterstriche:=maxvariablenlaenge*"_",parameterunterstriche:=8*"_"+22*" ",leeresfeld:=77*" ",unterstrichfeld:=77*"-";TYPE KRITERIUM=INT;KRITERIUM CONSTallemodelle:=0,alleaenderbaren:=1,allelauffaehigen:=2;OP:=(KRITERIUM VARt,INT CONSTi):CONCR(t):=iENDOP:=;BOOL OP=(KRITERIUM CONSTlinks,rechts):CONCR(links)=CONCR(rechts)END OP=;LET ZEILE=STRUCT(TEXTgleichungsart,gleichung,variable,INTnummer);TYPE MODELLBANK=STRUCT(INTanzahldglmodelle,ROWmaxdglmodelleMODELLDGLmodelle,THESAURUSwdmodelle,wddsnamen);TYPE DEMOLAUF=STRUCT(VORGABEoriginal,vergleich,INTxindex,yindex,BOOLautomatisch,TEXTvariablenwahl);TYPE VORGABE=STRUCT(TEXTstartwert,parameter,REALanfangszeitpunkt,beobachtungsdauer,TEXTkurve);TYPE LOESUNG=STRUCT(ZUSTANDstartwert,PARAMETERparameter,REALanfangszeitpunkt,beobachtungsdauer,KURVEkurve);TYPE NAMEN=STRUCT(TEXTelan,lang,kurz);TYPE ZUSTANDSDATEN=STRUCT(INTanzahl,TEXToberbegriff,oberbegriffkurzform,ROWmaxdimensionTEXTnamelang,namekurz,TEXTunteregrenze,oberegrenze,randoben,randunten);TYPE COVARIABLENDATEN=STRUCT(INTanzahl,ROWmaxdimensionTEXTnamelang,namekurz);TYPE KOMBINATION=STRUCT(TEXTname,INTxindex,yindex,BOOLautomatisch);TYPE KOMBINATIONSANGEBOT=STRUCT(BOOLmitkombinationen,INTanzahl,ROWmaxdimensionKOMBINATIONpaar);TYPE PARAMETERDATEN=STRUCT(INTanzahl,ROWmaxparameterTEXTnamelang,nameelan,TEXTunteregrenze,oberegrenze);TYPE DARSTELLUNGSDATEN=STRUCT(BOOLimmodell,TEXTname);TYPE BESCHRAENKUNG=STRUCT(
+REALminbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,INTanzahlbeobachtungspunkte);LET TEXTDATEN=BOUND STRUCT(ROWmaxinfoTEXTinfo,ROWmaxgleichungenTEXTgleichungen,cogleichungen,ROWmaxdarstellungszeilenTEXTdarstellungscode);TYPE MODELLDGL=STRUCT(NAMENname,ZUSTANDSDATENvariablen,COVARIABLENDATENcovariablen,PARAMETERDATENparameter,DARSTELLUNGSDATENdarstellung,BOOLmitphasendiagramm,BOOLganzzahlig,KOMBINATIONSANGEBOTkombinationen,TEXTcodeundinfo,BESCHRAENKUNGbeschraenkung,DEMOLAUFdemolauf,INTmodellzustand,BOOLgeschuetzt);BOUND MODELLBANK VARmb;MODELLDGL VARmodell;TEXTDATEN VARtextdaten;TEXT PROCmodellbezeichnung:modell.name.lang.END PROCmodellbezeichnung;TEXT PROCmodellkurzbezeichnung:modell.name.kurz.END PROCmodellkurzbezeichnung;TEXT PROCmodellname:modell.name.elan.END PROCmodellname;TEXT PROCmodelldatenraum:modell.codeundinfo.END PROCmodelldatenraum;BOOL PROCcompilierbaregleichungen:modell.modellzustand=uebersetzbarEND PROCcompilierbaregleichungen;INT PROCdimension:modell.variablen.anzahl.END PROCdimension;INT PROCcodimension:modell.covariablen.anzahl.END PROCcodimension;INT PROCparameteranzahl:modell.parameter.anzahl.END PROCparameteranzahl;BOOL PROCmitzusatzdarstellung:modell.darstellung.immodell.END PROCmitzusatzdarstellung;BOOL PROCmitphasendiagramm:modell.mitphasendiagramm.END PROCmitphasendiagramm;BOOL PROCergebnisganzzahlig:modell.ganzzahlig.END PROCergebnisganzzahlig;DATASPACE VARtextds;PROCinformationstext(FILE VARtexte):forget(textds);textds:=nilspace;texte:=sequentialfile(output,textds);holeinformationstext.holeinformationstext:TEXT VARsatz:="";INT VARi;IFmodell.geschuetztTHENputline(texte," "+modellbezeichnung);putline(texte," "+(areaxsize(grossesrahmenfenster)-2)*waagerecht);FI;FORiFROM1UPTOmaxinfoWHILEtextdaten.info(i)<>endezeichenREPsatz:=textdaten.info(i);putline(texte,satz);PER;.END PROCinformationstext;TEXT PROCvariablenname(INT CONSTi):TEXT CONSTt:=(modell.variablen.namelang(i));t+(maxvarlaenge-LENGTH(t))*" ".END PROCvariablenname;TEXT PROCvariablenkurzform(INT CONSTi):modell.variablen.namekurz(i).END PROCvariablenkurzform;TEXT PROCcovariablenname(INT CONSTi):TEXT CONSTt:=modell.covariablen.namelang(i);t+(maxvarlaenge-LENGTH(t))*" ".END PROCcovariablenname;TEXT PROCcovariablenkurzform(INT CONSTi):modell.covariablen.namekurz(i).END PROCcovariablenkurzform;TEXT PROCparametername(INT CONSTi):modell.parameter.namelang(i).END PROCparametername;TEXT PROCparameterkurzform(INT CONSTi):modell.parameter.nameelan(i).END PROCparameterkurzform;TEXT PROCdarstellungsname:modell.darstellung.name.END PROCdarstellungsname;PARAMETER PROCvorgabeparameter:parameter(modell.demolauf.original.parameter).END PROCvorgabeparameter;REAL PROCvorgabeanfangszeitpunkt:modell.demolauf.original.anfangszeitpunkt.END PROCvorgabeanfangszeitpunkt;ZUSTAND PROCvorgabevergleichssystemzustand:zustand(modell.demolauf.vergleich.startwert).END PROCvorgabevergleichssystemzustand;PARAMETER PROCvorgabevergleichsparameter:parameter(modell.demolauf.vergleich.parameter).END PROCvorgabevergleichsparameter;ZUSTAND PROCzustandunteregrenze:zustand(modell.variablen.unteregrenze).END PROCzustandunteregrenze;ZUSTAND PROCzustandoberegrenze:zustand(modell.variablen.oberegrenze).END PROCzustandoberegrenze;PARAMETER PROCparameteroberegrenze:parameter(modell.parameter.oberegrenze).END PROCparameteroberegrenze;PARAMETER PROCparameterunteregrenze:parameter(modell.parameter.unteregrenze).END PROCparameterunteregrenze;ZUSTAND PROCrandoben:zustand(modell.variablen.randoben).END PROCrandoben;ZUSTAND PROCrandunten:zustand(modell.variablen.randunten).END PROCrandunten;REAL PROCminbeobachtungsdauer:modell.beschraenkung.minbeobachtungsdauer.END PROCminbeobachtungsdauer;REAL PROCmaxbeobachtungsdauer:modell.beschraenkung.maxbeobachtungsdauer.END PROCmaxbeobachtungsdauer;REAL PROCminanfangszeitpunkt:modell.beschraenkung.minanfangszeitpunkt.END PROCminanfangszeitpunkt;REAL PROCmaxanfangszeitpunkt:modell.beschraenkung.maxanfangszeitpunkt.END PROC
+maxanfangszeitpunkt;INT PROCanzahlbeobachtungspunkte:modell.beschraenkung.anzahlbeobachtungspunkte.END PROCanzahlbeobachtungspunkte;BOOL PROCmitkombinationen:modell.kombinationen.mitkombinationen.END PROCmitkombinationen;PROClistekombinationen(ROWmaxdimensionTEXT VARnamen,INT VARanzahl):INT VARi;anzahl:=modell.kombinationen.anzahl;FORiFROM1UPTOanzahlREPnamen(i):=modell.kombinationen.paar(i).name;PER;END PROClistekombinationen;PROCindiceskombinationen(INT CONSTkombnr,INT VARxachse,yachse,BOOL VARvertauschbar):xachse:=modell.kombinationen.paar(kombnr).xindex;yachse:=modell.kombinationen.paar(kombnr).yindex;vertauschbar:=modell.kombinationen.paar(kombnr).automatisch;END PROCindiceskombinationen;ZUSTAND PROCvorgabesystemzustand:zustand(modell.demolauf.original.startwert).END PROCvorgabesystemzustand;REAL PROCvorgabebeobachtungsdauer:modell.demolauf.original.beobachtungsdauer.END PROCvorgabebeobachtungsdauer;TEXT PROCvorgabekurve:modell.demolauf.original.kurve.END PROCvorgabekurve;REAL PROCvorgabevergleichsanfangszeitpunkt:modell.demolauf.vergleich.anfangszeitpunkt.END PROCvorgabevergleichsanfangszeitpunkt;REAL PROCvorgabevergleichsbeobachtungsdauer:modell.demolauf.vergleich.beobachtungsdauer.END PROCvorgabevergleichsbeobachtungsdauer;TEXT PROCvorgabevergleichskurve:modell.demolauf.vergleich.kurve.END PROCvorgabevergleichskurve;ZUSTAND PROCdemomuster:zustand(modell.demolauf.variablenwahl).END PROCdemomuster;BOOL PROCdemoautomatik:modell.demolauf.automatisch.END PROCdemoautomatik;INT PROCdemoxindex:modell.demolauf.xindexEND PROCdemoxindex;INT PROCdemoyindex:modell.demolauf.yindexEND PROCdemoyindex;TEXT PROCgleichung(INT CONSTi):textdaten.gleichungen(i)END PROCgleichung;TEXT PROCcogleichung(INT CONSTi):textdaten.cogleichungen(i)END PROCcogleichung;TEXT PROCdarstellungszeile(INT CONSTi):textdaten.darstellungscode(i)END PROCdarstellungszeile;PROCkopplean(MODELLDGL VARaktuellesmodell):modell:=aktuellesmodell;IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo);FI END PROCkopplean;PROCkopplean(INT CONSTaktuellesmodell):IFdglmodellTHENmodell:=mb.modelle(aktuellesmodell);IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo)FI FI.dglmodell:aktuellesmodell<=maxdglmodelle.END PROCkopplean;MODELLDGL PROCmodellaktuell(INT CONSTaktuellesmodell):mb.modelle(aktuellesmodell).END PROCmodellaktuell;PROCnilmodell(MODELLDGL VARmod):initialisieremodell.initialisieremodell:INT VARi;mod.name.elan:="";mod.name.lang:="";mod.name.kurz:="";mod.variablen.anzahl:=0;mod.variablen.oberbegriff:="";mod.variablen.oberbegriffkurzform:="";FORiFROM1UPTOmaxdimensionREPmod.variablen.namelang(i):="";mod.variablen.namekurz(i):="";PER;mod.variablen.unteregrenze:="";mod.variablen.oberegrenze:="";mod.variablen.randoben:="";mod.variablen.randunten:="";mod.covariablen.anzahl:=0;FORiFROM1UPTOmaxdimensionREPmod.covariablen.namelang(i):="";mod.covariablen.namekurz(i):="";PER;mod.parameter.anzahl:=0;FORiFROM1UPTOmaxparameterREPmod.parameter.namelang(i):="";mod.parameter.nameelan(i):="";PER;mod.parameter.unteregrenze:="";mod.parameter.oberegrenze:="";mod.darstellung.immodell:=FALSE;mod.darstellung.name:="";mod.mitphasendiagramm:=FALSE;mod.ganzzahlig:=FALSE;mod.demolauf.vergleich.startwert:="";mod.demolauf.vergleich.parameter:="";mod.demolauf.vergleich.beobachtungsdauer:=0.0;mod.demolauf.vergleich.anfangszeitpunkt:=0.0;mod.demolauf.vergleich.kurve:="";mod.demolauf.original.startwert:="";mod.demolauf.original.parameter:="";mod.demolauf.original.anfangszeitpunkt:=0.0;mod.demolauf.original.beobachtungsdauer:=0.0;mod.demolauf.original.kurve:="";mod.demolauf.xindex:=0;mod.demolauf.yindex:=0;mod.demolauf.automatisch:=FALSE;mod.demolauf.variablenwahl:="";mod.kombinationen.mitkombinationen:=FALSE;mod.kombinationen.anzahl:=0;FORiFROM1UPTOmaxdimensionREPmod.kombinationen.paar(i).xindex:=0;mod.kombinationen.paar(i).yindex:=0;mod.kombinationen.paar(i).automatisch:=FALSE;mod.kombinationen.paar(i).name:="";PER;mod.beschraenkung.minbeobachtungsdauer:=0.0;mod.beschraenkung
+.maxbeobachtungsdauer:=0.0;mod.beschraenkung.minanfangszeitpunkt:=0.0;mod.beschraenkung.maxanfangszeitpunkt:=0.0;mod.beschraenkung.anzahlbeobachtungspunkte:=0;mod.modellzustand:=notuebersetzbar;mod.geschuetzt:=FALSE;END PROCnilmodell;PROCbildedsnamenneu(MODELLDGL VARmod,TEXT CONSTmodellbank,INT CONSTmodellnr):mod.codeundinfo:=modellbank+sp+text(modellnr)+modellcode;mod.demolauf.original.kurve:=modellbank+sp+text(modellnr)+originalkurve;mod.demolauf.vergleich.kurve:=modellbank+sp+text(modellnr)+vergleichskurve;END PROCbildedsnamenneu;PROCgleichungsprozeduren(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARprog:=sequentialfile(output,dateiname);schreibegleichungsproz;schreibecogleichungsproz;schreibedarstellung4;.schreibegleichungsproz:putline(prog,"ZUSTAND PROC f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationen;gleichungen;ergebnis;putline(prog,"END PROC f;");.schreibecogleichungsproz:putline(prog,"ZUSTAND PROC co f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationenvoncof;cogleichungen;cofergebnis;putline(prog,"END PROC co f;").gleichungen:FORiFROM1UPTOmaxgleichungenWHILEgleichung(i)<>endezeichenREPputline(prog,gleichung(i));PER.cogleichungen:INT VARi;FORiFROM1UPTOmaxgleichungenWHILEcogleichung(i)<>endezeichenREPputline(prog,cogleichung(i));PER;.deklarationen:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand (DSUB alter zustand);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI PER FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFdimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOdimensionREPput(prog,praefix+elan(variablenkurzform(i)));IFi=dimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.ergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOdimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+praefix+elan(variablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.deklarationenvoncof:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand ( co dimension);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFcodimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOcodimensionREPput(prog,elan(covariablenkurzform(i)));IFi=codimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.cofergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOcodimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+elan(covariablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.schreibedarstellung4:IFmitzusatzdarstellungTHENschreibedarstellungscodeELSEschreibeleerenprozedurkopfFI.schreibeleerenprozedurkopf:putline(prog,darstellungskopf);putline(prog,darstellungsende);.schreibedarstellungscode:FORiFROM1UPTOmaxdarstellungszeilenWHILEdarstellungszeile(i)<>endezeichenREPputline(prog,darstellungszeile(i));PER.END PROCgleichungsprozeduren;TEXT PROCelan(TEXT CONSTalt):INT VARi:=1;TEXT VARt:="";FORiFROM1UPTO(LENGTHalt)REP IF(tanderstellei>=97CANDtanderstellei<=122)COR(tanderstellei>216CANDtanderstellei<=219)COR(tanderstellei>=48CANDtanderstellei<=57)THENtCATsubtext(alt,i,i)ELIF(tanderstellei>=65CANDtanderstellei<=
+90)THENtCATcode(tanderstellei+32)ELIF(tanderstellei>=214CANDtanderstellei<=216)THENtCATcode(tanderstellei+3)ELSEtCAT" "FI PER;t.tanderstellei:code(subtext(alt,i,i))END PROCelan;OP:=(MODELLDGL VARmod,MODELLDGL CONSTm):CONCR(mod.name):=CONCR(m.name);CONCR(mod.variablen):=CONCR(m.variablen);CONCR(mod.covariablen):=CONCR(m.covariablen);CONCR(mod.parameter):=CONCR(m.parameter);CONCR(mod.darstellung):=CONCR(m.darstellung);mod.mitphasendiagramm:=m.mitphasendiagramm;mod.ganzzahlig:=m.ganzzahlig;mod.kombinationen.mitkombinationen:=m.kombinationen.mitkombinationen;mod.kombinationen.anzahl:=m.kombinationen.anzahl;INT VARi;FORiFROM1UPTOmaxdimensionREP CONCR(mod.kombinationen.paar(i)):=CONCR(m.kombinationen.paar(i))PER;mod.codeundinfo:=m.codeundinfo;CONCR(mod.beschraenkung):=CONCR(m.beschraenkung);CONCR(mod.demolauf.original):=CONCR(m.demolauf.original);CONCR(mod.demolauf.vergleich):=CONCR(m.demolauf.vergleich);mod.demolauf.xindex:=m.demolauf.xindex;mod.demolauf.yindex:=m.demolauf.yindex;mod.demolauf.automatisch:=m.demolauf.automatisch;mod.demolauf.variablenwahl:=m.demolauf.variablenwahl;mod.modellzustand:=m.modellzustand;mod.geschuetzt:=m.geschuetztEND OP:=;PROCloesche(INT CONSTmodellnr,TEXT CONSTmodellbankname):INT VARi;disablestop;IFdglmodellTHENforget(mb.modelle(modellnr).demolauf.original.kurve,quiet);forget(mb.modelle(modellnr).demolauf.vergleich.kurve,quiet);forget(mb.modelle(modellnr).codeundinfo,quiet);rueckedieanderenmodelleaufELSEforget(name(wddsnamen,modellindex),quiet);delete(mb.wddsnamen,modellindex);delete(mb.wdmodelle,modellindex);FI;enablestop.dglmodell:modellnr<=maxdglmodelle.modellindex:modellnr-maxdglmodelle.rueckedieanderenmodelleauf:FORiFROMmodellnr+1UPTOmb.anzahldglmodelleREPmb.modelle(i-1):=mb.modelle(i);bildedsnamenneu(mb.modelle(i-1),modellbankname,i-1);IFexists(mb.modelle(i).codeundinfo)THENrename(mb.modelle(i).codeundinfo,mb.modelle(i-1).codeundinfo);FI;KURVE VARkurvezurumbenennung,altekurve;IFexists(mb.modelle(i).demolauf.original.kurve)THENaltekurve:=old(mb.modelle(i).demolauf.original.kurve);copy(kurvezurumbenennung,mb.modelle(i-1).demolauf.original.kurve,altekurve);forget(mb.modelle(i).demolauf.original.kurve,quiet);FI;IFexists(mb.modelle(i).demolauf.vergleich.kurve)THENaltekurve:=old(mb.modelle(i).demolauf.vergleich.kurve);copy(kurvezurumbenennung,mb.modelle(i-1).demolauf.vergleich.kurve,altekurve);forget(mb.modelle(i).demolauf.vergleich.kurve,quiet);FI;PER;mb.anzahldglmodelleDECR1;.END PROCloesche;PROCneuebank(TEXT CONSTmodellbankname):INT VARi;IF NOTexists(modellbankname)CAND NOT(modellbankname="")THENmb:=new(modellbankname);type(old(modellbankname),typnrmodellbank);initialisierebank;FI.initialisierebank:mb.anzahldglmodelle:=0;FORiFROM1UPTOmaxdglmodelleREPnilmodell(mb.modelle(i));PER;mb.wdmodelle:=emptythesaurus;mb.wddsnamen:=emptythesaurus.END PROCneuebank;PROCkopplean(TEXT CONSTmodellbankname):IFexists(modellbankname)THENmb:=old(modellbankname)FI END PROCkopplean;PROClistemodellbanken(ROWmaxdialogpktTEXT VARnamensliste,INT VARanzahlbanken):suchedateienmitrichtigemtyp;.suchedateienmitrichtigemtyp:anzahlbanken:=0;TEXT VARname,d;beginlist;getlistentry(name,d);WHILEname<>""REP IFtype(old(name))=typnrmodellbankTHENanzahlbankenINCR1;namensliste(anzahlbanken):=name;FI;getlistentry(name,d);PER.END PROClistemodellbanken;INT PROCanzahlmodellbanken:INT VARanzahlbanken;suchedateienmitrichtigemtyp;anzahlbanken.suchedateienmitrichtigemtyp:anzahlbanken:=0;TEXT VARname,d;beginlist;getlistentry(name,d);WHILEname<>""REP IFtype(old(name))=typnrmodellbankTHENanzahlbankenINCR1;FI;getlistentry(name,d);PER;.END PROCanzahlmodellbanken;PROCloesche(TEXT CONSTmbname):kopplean(mbname);INT VARi;FORiFROM1UPTOmb.anzahldglmodelleREPforget(mb.modelle(i).demolauf.original.kurve,quiet);forget(mb.modelle(i).demolauf.vergleich.kurve,quiet);forget(mb.modelle(i).codeundinfo,quiet)PER;doquiet(PROC(TEXT CONST,QUIET CONST)forget,mb.wddsnamen);forget(mbname,quiet);END PROCloesche;PROCdoquiet(PROC(TEXT CONST,QUIET CONST)f,THESAURUS CONSTt):INT
+ VARi:=0;TEXT VARname;WHILEi<highestentry(t)REPget(t,name,i);IFname<>""THENf(name,quiet)FI PER;END PROCdoquiet;PROClistedermodelle(ROWmaxmodelleTEXT VARnamensliste,ROWmaxmodelleINT VARmodelliste,KRITERIUM CONSTkriterium,INT VARmodellzaehler):INT VARmodnr;holemodellnamen.holemodellnamen:modellzaehler:=0;FORmodnrFROM1UPTOmb.anzahldglmodelleREPholedglnamen;PER;modnr:=0;WHILEmodnr<highestentry(mb.wdmodelle)REPholewdnamenPER.holewdnamen:TEXT VARmodellname;get(mb.wdmodelle,modellname,modnr);IFwdmodellerfuelltdaskriteriumTHENmodellzaehlerINCR1;namensliste(modellzaehler):=text(modellname,maxmodellnamelangaufgeblaeht)+sp+wdsuffix;modelliste(modellzaehler):=modnr+maxdglmodelle;FI.holedglnamen:IFdglmodellerfuelltdaskriteriumTHENmodellzaehlerINCR1;namensliste(modellzaehler):=text(mb.modelle(modnr).name.lang,maxmodellnamelangaufgeblaeht)+sp+dglsuffix;modelliste(modellzaehler):=modnrFI.wdmodellerfuelltdaskriterium:kriterium=allemodelleCORkriterium=alleaenderbarenCOR(kriterium=allelauffaehigenCANDwdmodelllauffaehig).wdmodelllauffaehig:type(old(name(mb.wddsnamen,modnr)))=typnrwdausfuehrbar.dglmodellerfuelltdaskriterium:kriterium=allemodelleCOR(kriterium=alleaenderbarenCANDdglmodellaenderbar)COR(kriterium=allelauffaehigenCANDdglmodelllauffaehig).dglmodellaenderbar:NOTmb.modelle(modnr).geschuetzt.dglmodelllauffaehig:mb.modelle(modnr).modellzustand=uebersetzbar.END PROClistedermodelle;PROClistedermodelle(INT VARanzahlveraenderbar,anzahlausfuehrbar):INT VARmodnr;anzahlveraenderbar:=0;anzahlausfuehrbar:=0;FORmodnrFROM1UPTOmb.anzahldglmodelleREPzaehlehochPER;anzahlveraenderbarINCRanzahlwdmodelle;anzahlausfuehrbarINCRanzahlausfuehrbarerwdmodelle.zaehlehoch:IF NOT(mb.modelle(modnr).geschuetzt)THENanzahlveraenderbarINCR1FI;IFmb.modelle(modnr).modellzustand=uebersetzbarTHENanzahlausfuehrbarINCR1FI.END PROClistedermodelle;INT PROCanzahldglmodelle:mb.anzahldglmodelleEND PROCanzahldglmodelle;BOOL PROCmodellbankvoll:(mb.anzahldglmodelle+anzahlwdmodelle)>=maxmodelleEND PROCmodellbankvoll;BOOL PROCmodellbankvolldgl:mb.anzahldglmodelle>=maxdglmodelleEND PROCmodellbankvolldgl;BOOL PROCmodellbankvollwd:anzahlwdmodelle>=maxwdmodelleEND PROCmodellbankvollwd;PROCfuegeein(TEXT CONSTmodellbank):INT VARreturncode;fuegeein(modellbank,returncode)END PROCfuegeein;PROCwdeinfuegen(TEXT CONSTmodellbank,TEXT CONSTlangname,kurzname):INT VARneuerindex:=0;THESAURUS VARt1:=mb.wdmodelle,t2:=mb.wddsnamen;disablestop;insert(mb.wdmodelle,langname,neuerindex);insert(mb.wddsnamen,modellbank+sp+text(neuerindex+maxdglmodelle)+sp+wdsuffix);diagrammnameneintragen(langname,kurzname);forget(name(mb.wddsnamen,neuerindex),quiet);aenderungenspeichern(name(mb.wddsnamen,neuerindex));IFiserrorTHENkonsistenzherstellenFI;.konsistenzherstellen:forget(name(mb.wddsnamen,neuerindex),quiet);mb.wdmodelle:=t1;mb.wddsnamen:=t2.END PROCwdeinfuegen;PROCwdumbenennen(TEXT CONSTlangname,kurzname,INT CONSTmodellnr):THESAURUS VARt:=mb.wdmodelle;disablestop;diagrammnameneintragen(langname,kurzname);rename(mb.wdmodelle,modellnr,langname);IFiserrorTHENclearerror;konsistenzherstellenFI;enablestop;.konsistenzherstellen:mb.wdmodelle:=t.END PROCwdumbenennen;PROCfuegeein(TEXT CONSTmodellbank,INT VARreturncode):INT VARneuesmodell;returncode:=1;BOOL VARmodellabgelegt:=FALSE;IF NOTmodellbankvolldglTHENmb.anzahldglmodelleINCR1;neuesmodell:=mb.anzahldglmodelle;nilmodell(mb.modelle(neuesmodell));bildedsnamenneu(mb.modelle(neuesmodell),modellbank,neuesmodell);loescheleereds;initgleichungsds;disablestop;modellerfassung(neuesmodell,modellbank,modellabgelegt);IFiserrorTHENclearerror;enablestop;loesche(neuesmodell,modellbank);errorstop(errormessage);ELIFlength(compress(mb.modelle(neuesmodell).name.lang))=0THENloesche(neuesmodell,modellbank);ELSE IFmodellabgelegtTHENreturncode:=0;FI;enablestop;FI FI.loescheleereds:forget(mb.modelle(neuesmodell).codeundinfo,quiet);forget(mb.modelle(neuesmodell).demolauf.original.kurve,quiet);forget(mb.modelle(neuesmodell).demolauf.vergleich.kurve,quiet);.initgleichungsds:textdaten:=new(mb.modelle(
+neuesmodell).codeundinfo);type(old(mb.modelle(neuesmodell).codeundinfo),typnrmodell);textdaten.info(1):=endezeichen;textdaten.gleichungen(1):=endezeichen;textdaten.cogleichungen(1):=endezeichen;textdaten.darstellungscode(1):=endezeichen;.END PROCfuegeein;PROCcopy(INT CONSTaltesmodell,TEXT CONSTmodellbank):INT VARreturncode;copy(altesmodell,modellbank,returncode);END PROCcopy;PROCcopy(INT CONSTaltesmodell,TEXT CONSTmodellbank,INT VARreturncode):INT VARneuesmodell;returncode:=1;IF NOTmodellbankvolldglTHENmb.anzahldglmodelleINCR1;neuesmodell:=mb.anzahldglmodelle;mb.modelle(neuesmodell):=mb.modelle(altesmodell);bildedsnamenneu(mb.modelle(neuesmodell),modellbank,neuesmodell);IF(mb.modelle(altesmodell).codeundinfo)<>(mb.modelle(neuesmodell).codeundinfo)THENforget(mb.modelle(neuesmodell).codeundinfo,quiet);IFexists(mb.modelle(altesmodell).codeundinfo)THENcopy(mb.modelle(altesmodell).codeundinfo,mb.modelle(neuesmodell).codeundinfo);FI;disablestop;modellerfassung(neuesmodell,modellbank);IFiserrorTHENclearerror;enablestop;loesche(neuesmodell,modellbank);errorstop(errormessage);ELIFlength(compress(mb.modelle(neuesmodell).name.lang))=0CORmb.modelle(neuesmodell).name.lang=mb.modelle(altesmodell).name.langTHENloesche(neuesmodell,modellbank);ELSEreturncode:=0;FI;enablestop;FI;FI;END PROCcopy;THESAURUS PROCwdmodelle:mb.wdmodelleEND PROCwdmodelle;THESAURUS PROCwddsnamen:mb.wddsnamenEND PROCwddsnamen;INT PROCanzahlwdmodelle:INT VARi:=0,anzahl:=0;TEXT VARwdname:="";WHILEi<highestentry(mb.wdmodelle)REPget(mb.wdmodelle,wdname,i);IFwdname<>""THENanzahlINCR1FI PER;anzahlEND PROCanzahlwdmodelle;INT PROCanzahlausfuehrbarerwdmodelle:INT VARi:=0,anzahl:=0;TEXT VARwdname:="";WHILEi<highestentry(mb.wddsnamen)REPget(mb.wddsnamen,wdname,i);IFwdname<>""CANDausfuehrbarTHENanzahlINCR1FI PER;anzahl.ausfuehrbar:type(old(wdname))=typnrwdausfuehrbar.END PROCanzahlausfuehrbarerwdmodelle;DATASPACE VARfeldds,glzeileds,eingabeparameternameds;BOUND ROW100TEXT VARfeld;BOUND ROWmaxzeileneingabeZEILE VARglzeile;BOUND ROWmaxzeileneingabeTEXT VAReingabeparametername;TEXTDATEN VARgleichungsraum;TAG VARzweiteseite;INT VARzeilenzaehler,cursorfeld,pmerker,zmerker,anzahlparameter,gleichungsanzahl,egleichungsanzahl,dgleichungsanzahl;TEXT VARfehlertext,fehlermeldung,taste;INT CONSTseite1:=18,seite2:=2,infowahllang:=3,steuerzseite2:=4,steuerzseite3:=5,infoseite:=6,teilfeld:=7,infowahlkurz:=8;PROCmodellerfassung(INT VARmodellnr,TEXT CONSTmodellbank):enablestop;BOOL VARmodellabgelegt:=FALSE;modellerfassung(modellnr,modellbank,modellabgelegt);END PROCmodellerfassung;PROCmodellerfassung(INT VARmodellnr,TEXT CONSTmodellbank,BOOL VARmodellabgelegt):enablestop;MODELLDGL VARvorabmodell:=mb.modelle(modellnr);ZEILE VARzeilenmerker;INT VARfeldart,altefeldart;TEXT VARfeldmerker,modellcodeinfo,infotext,infos,lang:="",kurz:="",meldungsmerker;BOOL VARfalscheeingaben:=FALSE,tastenfehleralsletztes:=FALSE,explizitgespeichertaufseitezwei:=FALSE,explizitgespeichert:=FALSE;modellabgelegt:=FALSE;forget(feldds);feldds:=nilspace;feld:=feldds;fehlertext:="";initialisierungenfuermodelldatenerfassung;allefelderfreigeben;REPkernvonmodellerfassungPER.kernvonmodellerfassung:maskezurmodellinitialisierungausgeben(vorabmodell.name.lang,vorabmodell.name.kurz);REPexplizitgespeichert:=FALSE;putgetformular1(feld,cursorfeld,taste);IFtaste=abbruchtastemenuTHEN IFabspeicherngewuenschtTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHENvorabmodell.name.lang:=lang;vorabmodell.name.kurz:=kurz;vorabmodell.name.elan:=elan(kurz);speichereaufseiteeins;leavemodellerfassungFI;ELSEleavemodellerfassungFI ELIFtaste=auskunftstasteTHENinfotext:=auskunftseite1;fehlermeldung:="";auskunftsdienst(infotext,fehlermeldung,auskunftsloeschtaste1);show(formular(seite1));cursorfeld:=2;feld(1):=leeresfeld;footnote(steuerleiste(stmenuoderweiter));ELIFtaste=weitertasteTHENeingabendeserstenformularspruefen(lang,kurz,modellnr,falscheeingaben);IF NOTfalscheeingabenTHENvorabmodell.name.lang:=lang;
+vorabmodell.name.kurz:=kurz;vorabmodell.name.elan:=elan(kurz);modelldatenerfassungFI ELSEfeld(1):=meldungstext(fehlertaste)FI;PER.speichereaufseiteeins:mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE;.leavemodellerfassung:forget(feldds);forget(glzeileds);forget(eingabeparameternameds);LEAVEmodellerfassung.modelldatenerfassung:REPkernvonmodelldatenerfassungPER.initialisierungenfuermodelldatenerfassung:forget(glzeileds);forget(eingabeparameternameds);glzeileds:=nilspace;eingabeparameternameds:=nilspace;glzeile:=glzeileds;eingabeparametername:=eingabeparameternameds;zweiteseite:=formular(seite2);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellcodeinfo:=vorabmodell.codeundinfo;zwischenspeichermitmodelldatenfuellen(vorabmodell);.kernvonmodelldatenerfassung:maskezurmodelldatenerfassungausgeben(infos);meldungsmerker:=meldungstext(mldcursorbenutzung);tastenfehleralsletztes:=FALSE;explizitgespeichertaufseitezwei:=FALSE;REPexplizitgespeichert:=FALSE;vorabmodell.modellzustand:=notuebersetzbar;put(formular(teilfeld),infos,2);IFtastenfehleralsletztesTHENtastenfehleralsletztes:=FALSE;ELSEfeld(1):=meldungsmerker;FI;putget(zweiteseite,feld,cursorfeld,taste);feld(1):=meldungstext(mldcursorbenutzung);IFtaste=abbruchtasteTHEN IFabspeicherngewuenschtTHENspeichereaufseitezweiFI;leavemodellerfassungELIFtaste=blaettertasteTHENnaechsteseitezeigen;ELIFtaste=dupliziertasteTHENzeilebzwfeldkopierenELIFtaste=loeschtasteTHENzeilebzwfeldmerkenundloeschenELIFtaste=wiedergabetasteTHENspeicherinhaltaufaktuellepositionuebertragenELIFtaste=auskunftstasteTHENinfotextauswahl(fehlertext,fehlermeldung);show(zweiteseite);show(formular(teilfeld));show(formular(steuerzseite2));cursorfeld:=2;infos:=auskunftstext(code(auskeingabebeispiel))ELIFtaste=speichertasteTHENfeld(1):=anwendungstext(btwartenwaehrendspeichern);put(zweiteseite,feld(1),1);speichereaufseitezwei;explizitgespeichertaufseitezwei:=TRUE;ELIFtaste=drucktasteTHENfeld(1):=anwendungstext(btwartenwaehrenddrucken);put(zweiteseite,feld(1),1);druckeinfotextaufseitezwei;ELIFtaste=prueftasteTHENfeld(1):=auskunftstext(auskpruefung);put(zweiteseite,feld(1),1);eingabenzwischenspeichern;eingabendeszweitenformularsordnen;eingabendeszweitenformularspruefen(falscheeingaben);IF NOTfalscheeingabenTHENinfos:=auskunftstext(code(auskdatenkorrekt));weiterebearbeitungdesmodellsELIFfehlertext=""THENinfos:=auskunftstext(code(auskkeinegleichungen));ELSEinfos:=auskunftstext(code(auskfehlerfestgestellt))FI;meldungsmerker:=feld(1);ELSEfeld(1):=meldungstext(fehlertaste);tastenfehleralsletztes:=TRUE;FI PER.speichereaufseitezwei:eingabenzwischenspeichern;eingabendeszweitenformularsordnen;gleichungenundparameterzaehlen(falscheeingaben);forget(vorabmodell.codeundinfo,quiet);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellmitdatenfuellen(vorabmodell);infotextablegen(vorabmodell);mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE.druckeinfotextaufseitezwei:eingabenzwischenspeichern;eingabendeszweitenformularsordnen;gleichungenundparameterzaehlen(falscheeingaben);forget(vorabmodell.codeundinfo,quiet);bildedsnamenneu(vorabmodell,modellbank,modellnr);modellmitdatenfuellen(vorabmodell);infodateiausdrucken(vorabmodell,modellbank);.naechsteseitezeigen:cursorfeld:=2;IFzeilenzaehler=endeseite1THENzwischenspeichern(beginnseite1,endeseite1);formularfuellen(beginnseite2,endeseite2);ELSEzwischenspeichern(beginnseite2,endeseite2);formularfuellen(beginnseite1,endeseite1)FI.zeilebzwfeldkopieren:altefeldart:=cursorfeldMOD4;IFaltefeldart=2THENzeilenmerkerfuellenELSEfeldmerker:=feld(cursorfeld)FI.zeilenmerkerfuellen:zeilenmerker.gleichungsart:=feld(cursorfeld);zeilenmerker.gleichung:=feld(cursorfeld+1);zeilenmerker.variable:=feld(cursorfeld+2).zeilebzwfeldmerkenundloeschen:altefeldart:=cursorfeldMOD4;IFaltefeldart=2THENzeilenmerkerfuellen;feld(cursorfeld):="_";feld(cursorfeld+1):=gleichungsunterstriche;feld(cursorfeld+2):=variablenunterstriche;ELSEfeldmerker:=feld(cursorfeld);IFaltefeldart=3THENfeld(cursorfeld):=gleichungsunterstriche
+ELIFaltefeldart=0THENfeld(cursorfeld):=variablenunterstricheELSEfeld(cursorfeld):=parameterunterstricheFI FI.speicherinhaltaufaktuellepositionuebertragen:feldart:=cursorfeldMOD4;IFaltefeldart=feldartTHEN IFfeldart=2THENfeld(cursorfeld):=zeilenmerker.gleichungsart;feld(cursorfeld+1):=zeilenmerker.gleichung;feld(cursorfeld+2):=zeilenmerker.variableELSEfeld(cursorfeld):=feldmerkerFI ELSEfeld(1):=meldungstext(fehlerkopierposition);tastenfehleralsletztes:=TRUE;FI.eingabenzwischenspeichern:IFzeilenzaehler=endeseite1THENzwischenspeichern(beginnseite1,endeseite1)ELSEzwischenspeichern(beginnseite2,endeseite2)FI.weiterebearbeitungdesmodells:REPkernvonweiterebearbeitungdesmodellsPER.kernvonweiterebearbeitungdesmodells:put(zweiteseite,feld);vorabmodell.modellzustand:=uebersetzbar;put(formular(teilfeld),infos,2);show(formular(steuerzseite3));REPfeld(1):=leeresfeld;cursor(77,23);warteaufesc;tasteeinlesen(taste);IFtaste=zuruecktasteTHENallefelderfreigeben;cursorfeld:=2;show(formular(steuerzseite2));infos:=auskunftstext(code(auskeingabebeispiel));feld(1):=meldungstext(mldcursorbenutzung);leaveweiterebearbeitungdesmodellsELIFtaste=speichertasteTHENspeichereaufseitedrei;feld(1):=auskunftstext(auskgespeichert);put(zweiteseite,feld(1),1);explizitgespeichert:=TRUE;ELIFtaste=abbruchtasteTHEN IF NOTexplizitgespeichertCANDabspeicherngewuenschtTHENspeichereaufseitedreiFI;leavemodellerfassungELIFtaste=simulationstasteTHENfuehreggfdiesimulationaus;ELIFtaste=drucktasteTHENinfodateiausdrucken(vorabmodell,modellbank);put(zweiteseite,feld(1),1)ELSEfeld(1):=meldungstext(fehlertaste);put(zweiteseite,feld(1),1)FI PER.speichereaufseitedrei:vorabmodell.codeundinfo:=modellcodeinfo;forget(vorabmodell.codeundinfo,quiet);modellmitdatenfuellen(vorabmodell);infotextablegen(vorabmodell);mb.modelle(modellnr):=vorabmodell;modellabgelegt:=TRUE;.leaveweiterebearbeitungdesmodells:LEAVEweiterebearbeitungdesmodells.reenterweiterebearbeitungdesmodells:show(zweiteseite);LEAVEkernvonweiterebearbeitungdesmodells.fuehreggfdiesimulationaus:feld(1):=anwendungstext(btwartenallgemein);put(zweiteseite,feld(1),1);simulieremitdglmodell;IFokTHENfeld(1):="";put(zweiteseite,feld(1),1);reenterweiterebearbeitungdesmodellsELSEfeld(1):=anwendungstext(btsimulationunmoeglich);put(zweiteseite,feld(1),1)FI.ok:retcode=0.simulieremitdglmodell:DATASPACE VARdsp;BOUND INT VARkanalnummer;BOUND MODELLDGL VARaktmodell;INT VARretcode:=0;vorabmodell.codeundinfo:=modellbank+sp+"X"+sp+"hilfscode";forget(vorabmodell.codeundinfo,quiet);modellmitdatenfuellen(vorabmodell);vorabmodell.modellzustand:=uebersetzbar;infotextablegen(vorabmodell);kopplean(vorabmodell);REPmodellbearbeiten;UNTILordnungsgemaessbeendetodertasknichtempfangsbereitPER;forget(vorabmodell.codeundinfo,quiet);enablestop;.ordnungsgemaessbeendetodertasknichtempfangsbereit:retcode<>simulationneustarten.modellbearbeiten:IFretcode=simulationneustartenTHENshow(zweiteseite);feld(1):=anwendungstext(btwartenallgemein);put(zweiteseite,feld(1),1);FI;retcode:=0;schickemodelldaten;IFokTHENschickegleichungen;IFokTHENstartesimulationFI FI;continue(geraetekanal);.schickemodelldaten:dsp:=nilspace;aktmodell:=dsp;aktmodell:=vorabmodell;schickeanmanagertask(dsp,2,retcode);.schickegleichungen:IFexists(modelldatenraum)THENdsp:=old(modelldatenraum);schickeanmanagertask(dsp,5,retcode);ELSEretcode:=99;FI.startesimulation:break(quiet);dsp:=nilspace;schickeanmanagertask(dsp,6,retcode);.abspeicherngewuenscht:IFvorabmodell.modellzustand=notuebersetzbarTHEN IFexplizitgespeichertaufseitezweiTHENput(formular(seite2),meldungstext(fragenochmalspeichern),1);cursor(51,21);ELSEput(formular(seite2),meldungstext(mldnichtablauffaehig),1);cursor(63,21);FI;yes(" ")ELSEput(formular(seite2),"",1);cursor(spalte3,20);yes(compress(meldungstext(fragehierabspeichern)))FI.ENDPROCmodellerfassung;PROCschickeanmanagertask(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARmesscode):INT CONSTeingabevomkanal:=-4;TASK VARmanagertask:=/terminaltaskname,kontrolltask:=/terminaltaskname;REPmanagertask:=
+kontrolltask;send(managertask,verarbeitung,datenraum,messcode);forget(datenraum);IFmesscode<>existiertnichtCANDmesscode<>nichtempfangsbereitTHENwarteaufquittungELSE LEAVEschickeanmanagertaskFI PER.warteaufquittung:managertask:=/terminaltaskname;wait(datenraum,messcode,managertask);forget(datenraum);IFquerschlaegersendungTHEN IFcontinueversuchTHEN LEAVEschickeanmanagertask;ELSE IFmesscode=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(datenraum);FI;FI ELSE LEAVEschickeanmanagertask;FI.querschlaegersendung:NOT(managertask=kontrolltask).continueversuch:managertask=supervisorAND((task(messcodeMOD100)=niltask)OR(task(messcodeMOD100)=myself))END PROCschickeanmanagertask;PROCzwischenspeichermitmodelldatenfuellen(MODELLDGL VARzwmodell):INT VARi;IFexists(zwmodell.codeundinfo)THENgleichungsraum:=old(zwmodell.codeundinfo);FORiFROM1UPTOzwmodell.variablen.anzahlREPglzeile(i).gleichungsart:="d";glzeile(i).variable:=zwmodell.variablen.namelang(i);glzeile(i).gleichung:=gleichungsraum.gleichungen(i)PER;FORiFROMzwmodell.variablen.anzahl+1UPTOzwmodell.variablen.anzahl+zwmodell.covariablen.anzahlREPglzeile(i).gleichungsart:="e";glzeile(i).variable:=zwmodell.covariablen.namelang(i-zwmodell.variablen.anzahl);glzeile(i).gleichung:=gleichungsraum.cogleichungen(i-zwmodell.variablen.anzahl)PER;FORiFROMzwmodell.variablen.anzahl+zwmodell.covariablen.anzahl+1UPTOmaxzeileneingabeREPglzeile(i).gleichungsart:="_";glzeile(i).gleichung:="";glzeile(i).variable:=""PER;FORiFROM1UPTOzwmodell.parameter.anzahlREPeingabeparametername(i):=zwmodell.parameter.namelang(i)PER;FORiFROMzwmodell.parameter.anzahl+1UPTOmaxzeileneingabeREPeingabeparametername(i):=""PER ELSE FORiFROM1UPTOmaxzeileneingabeREPglzeile(i).gleichungsart:="_";glzeile(i).variable:="";glzeile(i).gleichung:="";eingabeparametername(i):=""PER FI.END PROCzwischenspeichermitmodelldatenfuellen;PROCallefelderfreigeben:INT VARfeldzaehler;FORfeldzaehlerFROM2UPTO4*bildschirmzeilenREPprotect(zweiteseite,feldzaehler,FALSE)PER.END PROCallefelderfreigeben;PROCmaskezurmodellinitialisierungausgeben(TEXT CONSTlang,kurz):show(formular(seite1));footnote(steuerleiste(stmenuoderweiter));cursorfeld:=2;feld(1):=leeresfeld;feld(2):=lang+(maxmodellnamelang-length(lang))*"_";feld(3):=kurz+(maxmodellnamekurz-length(kurz))*"_";feld(4):="";feld(5):="";.END PROCmaskezurmodellinitialisierungausgeben;PROCeingabendeserstenformularspruefen(TEXT VARlang,kurz,INT CONSTmodellinbearbeitung,BOOL VARfalscheeingaben):INT VARi;ROW5TEXT VARhilfsfeld;feld(1):=leeresfeld;put(formular(seite1),feld(1),1);langnamenpruefen;aufnamensgleichheitpruefen;kurznamenpruefen;eingabenablegen;falscheeingaben:=FALSE.verlasseeingabendeserstenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeserstenformularspruefen.langnamenpruefen:hilfsfeld(2):=feld(2);hilfsfeld(2):=komprimiere(hilfsfeld(2));IFlength(hilfsfeld(2))=0THENfeld(1):=meldungstext(fehlerlangnamefehlt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(2))>maxmodellnamelangTHENfeld(1):=meldungstext(fehlerlangname);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI.kurznamenpruefen:hilfsfeld(3):=feld(3);hilfsfeld(3):=komprimiere(hilfsfeld(3));IFlength(hilfsfeld(3))=0THENfeld(1):=meldungstext(fehlerkurznamefehlt);cursorfeld:=3;verlasseeingabendeserstenformularspruefenELIFlength(hilfsfeld(3))>maxmodellnamekurzTHENfeld(1):=meldungstext(fehlerkurzname);cursorfeld:=3;verlasseeingabendeserstenformularspruefenFI.aufnamensgleichheitpruefen:FORiFROM1UPTOmb.anzahldglmodelleREP IFi<>modellinbearbeitungCANDhilfsfeld(2)=mb.modelle(i).name.langTHENfeld(1):=meldungstext(fehlermodellnamedoppelt);cursorfeld:=2;verlasseeingabendeserstenformularspruefenFI;PER;.eingabenablegen:lang:=hilfsfeld(2);kurz:=hilfsfeld(3).END PROCeingabendeserstenformularspruefen;PROCmaskezurmodelldatenerfassungausgeben(TEXT VARinformation):show(zweiteseite);show(formular(steuerzseite2));cursorfeld:=2;formularfuellen(beginnseite1,endeseite1);information:=auskunftstext(code(auskeingabebeispiel)).END PROC
+maskezurmodelldatenerfassungausgeben;PROCformularfuellen(INT CONSTseitenbeginn,seitenende):INT VARfeldzaehler;feldzaehlerauferstesfeldsetzen;FORzeilenzaehlerFROMseitenbeginnUPTOseitenendeREPformularzeilefuellenPER;zeilenzaehler:=seitenende.feldzaehlerauferstesfeldsetzen:feldzaehler:=ersteseingabefeld.formularzeilefuellen:feld(feldzaehler):="_";replace(feld(feldzaehler),1,glzeile(zeilenzaehler).gleichungsart);feldzaehlerINCR1;feld(feldzaehler):=gleichungsunterstriche;IFlength(glzeile(zeilenzaehler).gleichung)>length(gleichungsunterstriche)THENfeld(feldzaehler):=glzeile(zeilenzaehler).gleichungELSEreplace(feld(feldzaehler),1,glzeile(zeilenzaehler).gleichung);FI;feldzaehlerINCR1;feld(feldzaehler):=variablenunterstriche;replace(feld(feldzaehler),1,glzeile(zeilenzaehler).variable);feldzaehlerINCR1;feld(feldzaehler):=parameterunterstriche;replace(feld(feldzaehler),1,eingabeparametername(zeilenzaehler));feldzaehlerINCR1.END PROCformularfuellen;PROCzwischenspeichern(INT CONSTseitenbeginn,seitenende):INT VARfeldzaehler;feldzaehlerauferstesfeldsetzen;FORzeilenzaehlerFROMseitenbeginnUPTOseitenendeREPzwischenspeicherfuellenPER;zeilenzaehler:=seitenende.feldzaehlerauferstesfeldsetzen:feldzaehler:=ersteseingabefeld.zwischenspeicherfuellen:glzeile(zeilenzaehler).gleichungsart:=subtext(feld(feldzaehler),1,1);feldzaehlerINCR1;glzeile(zeilenzaehler).gleichung:=feld(feldzaehler);glzeile(zeilenzaehler).gleichung:=komprimiere(glzeile(zeilenzaehler).gleichung);ohneumlauteundeszet(glzeile(zeilenzaehler).gleichung);IFlength(glzeile(zeilenzaehler).gleichung)>0CANDsubtext(glzeile(zeilenzaehler).gleichung,length(glzeile(zeilenzaehler).gleichung))<>";"THENglzeile(zeilenzaehler).gleichungCAT";"FI;feldzaehlerINCR1;glzeile(zeilenzaehler).variable:=feld(feldzaehler);glzeile(zeilenzaehler).variable:=komprimiere(glzeile(zeilenzaehler).variable);ohneumlauteundeszet(glzeile(zeilenzaehler).variable);feldzaehlerINCR1;eingabeparametername(zeilenzaehler):=feld(feldzaehler);eingabeparametername(zeilenzaehler):=komprimiere(eingabeparametername(zeilenzaehler));ohneumlauteundeszet(eingabeparametername(zeilenzaehler));feldzaehlerINCR1;END PROCzwischenspeichern;PROCeingabendeszweitenformularsordnen:INT VARi,zzaehler;FORzzaehlerFROM1UPTOmaxzeileneingabeREPohneumlauteundeszet(glzeile(zzaehler).variable);glzeile(zzaehler).nummer:=zzaehlerPER;zmerkerundpmerkerbestimmen;glzeilenordnen(1,zmerker);parameterordnen;formularfuellen(beginnseite1,endeseite1).zmerkerundpmerkerbestimmen:i:=maxzeileneingabe+1;REPiDECR1;zmerker:=iUNTILi=0CORzeilenichtleerPER;i:=maxzeileneingabe+1;REPiDECR1;pmerker:=iUNTILi=0CORlength(eingabeparametername(i))>0PER.zeilenichtleer:NOT(length(glzeile(i).gleichungsart)=0CANDlength(glzeile(i).gleichung)=0CANDlength(glzeile(i).variable)=0).END PROCeingabendeszweitenformularsordnen;PROCglzeilenordnen(INT CONSTanfang,ende):INT VARpivotadresse,zeigeroben,zeigerunten,adrgroesserpivot,adrkleinerpivot;ZEILE VARpivotzeile;IFanfang<endeTHENermittlepivotelement;initialisiereoberenundunterenvergleichszeiger;ordnedieelementemithilfevonpivot;sortiereteillistenwennsiemehralseinelemententhaltenFI.ermittlepivotelement:pivotadresse:=(ende+anfang)DIV2;pivotzeile:=glzeile(pivotadresse).initialisiereoberenundunterenvergleichszeiger:zeigeroben:=anfang;zeigerunten:=ende.ordnedieelementemithilfevonpivot:glzeile(pivotadresse):=glzeile(anfang);WHILEzeigeroben<zeigeruntenREPsuchevonobenechtgroesserpivot;suchevonuntenkleinergleichpivotwennnoetigPER.suchevonobenechtgroesserpivot:adrgroesserpivot:=zeigeroben+1;WHILEadrgroesserpivot<=zeigeruntenCANDprioritaet(pivotzeile)>=prioritaet(glzeile(adrgroesserpivot))REPadrgroesserpivotINCR1PER.suchevonuntenkleinergleichpivotwennnoetig:IFadrgroesserpivot>zeigeruntenTHENmacheletztenplatzfreiundsetzepivotdahin;zeigeroben:=zeigeruntenELSEsuchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesserenFI.macheletztenplatzfreiundsetzepivotdahin:glzeile(zeigeroben):=glzeile(zeigerunten);glzeile(zeigerunten):=pivotzeile.
+suchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesseren:adrkleinerpivot:=zeigerunten;WHILEadrkleinerpivot>=adrgroesserpivotCANDprioritaet(glzeile(adrkleinerpivot))>prioritaet(pivotzeile)REPadrkleinerpivotDECR1PER;IFadrkleinerpivot<adrgroesserpivotTHENbringepivotoberhalbvonadrgroesserpivotunterELSEglzeile(zeigeroben):=glzeile(adrkleinerpivot);glzeile(adrkleinerpivot):=glzeile(adrgroesserpivot);glzeile(adrgroesserpivot):=pivotzeile;zeigeroben:=adrgroesserpivot;zeigerunten:=adrkleinerpivot-1FI.bringepivotoberhalbvonadrgroesserpivotunter:glzeile(zeigeroben):=glzeile(adrgroesserpivot-1);glzeile(adrgroesserpivot-1):=pivotzeile;zeigeroben:=adrgroesserpivot-1;zeigerunten:=zeigeroben.sortiereteillistenwennsiemehralseinelemententhalten:IFende-anfang>1THENpruefeobsortierbereichveraendert;glzeilenordnen(anfang,zeigeroben);glzeilenordnen(zeigeroben+1,ende)FI.pruefeobsortierbereichveraendert:IFzeigeroben=endeTHENzeigeroben:=zeigeroben-1FI.END PROCglzeilenordnen;INT PROCprioritaet(ZEILE CONSTgleichungszeile):INT VARnummer:=gleichungszeile.nummer;TEXT VARart:=gleichungszeile.gleichungsart;IFart=" "THENchange(art," ","_")FI;IFart="d"THENnummerELIFart="e"THENnummer+maxzeileneingabeELIFart<>"_"THENnummer+(2*maxzeileneingabe)ELIFleeresgleichungsfeldCANDleeresvariablenfeldTHENnummer+(4*maxzeileneingabe)ELSEnummer+(3*maxzeileneingabe)FI.leeresgleichungsfeld:length(gleichungszeile.gleichung)=0.leeresvariablenfeld:length(gleichungszeile.variable)=0.END PROCprioritaet;PROCparameterordnen:ROWmaxzeileneingabeTEXT VARsortierhilfe;INT VARzzaehler,leerzeilenmerker:=0;FORzzaehlerFROM1UPTOpmerkerREPohneumlauteundeszet(eingabeparametername(zzaehler));parametersortierenPER;FORzzaehlerFROM(pmerker-leerzeilenmerker)+1UPTOpmerkerREPsortierhilfe(zzaehler):="";PER;FORzzaehlerFROM1UPTOpmerkerREPeingabeparametername(zzaehler):=sortierhilfe(zzaehler)PER.parametersortieren:IFlength(eingabeparametername(zzaehler))>0THENsortierhilfe(zzaehler-leerzeilenmerker):=eingabeparametername(zzaehler)ELSEleerzeilenmerkerINCR1FI.END PROCparameterordnen;PROCgleichungenundparameterzaehlen(BOOL VARfalscheeingaben):INT VARi:=1;WHILEi<=maxzeileneingabeCANDglzeile(i).gleichungsart="d"REPiINCR1PER;dgleichungsanzahl:=i-1;WHILEi<=maxzeileneingabeCANDglzeile(i).gleichungsart="e"REPiINCR1PER;egleichungsanzahl:=i-dgleichungsanzahl-1;gleichungsanzahl:=i-1;i:=1;WHILEi<=maxzeileneingabeCANDlength(eingabeparametername(i))>0REPiINCR1PER;anzahlparameter:=i-1;IFgleichungsanzahl=0THENfeld(1):=meldungstext(mldcursorbenutzung);fehlertext:="";falscheeingaben:=TRUE FI.END PROCgleichungenundparameterzaehlen;PROCeingabendeszweitenformularspruefen(BOOL VARfalscheeingaben):INT VARzzaehler,i,pruefling,fehlerfeldvariable,feldzaehler;TEXT VARprozeduranfangd,deklarationend,prozedurended,prozeduranfange,deklarationene,prozedurendee,procd,proce,prozedurd,prozedure;BOOL VARdoppeltdeklariert:=FALSE,vorherigefelderleer:=FALSE;falscheeingaben:=FALSE;FORzzaehlerFROM1UPTOmaxzeileneingabeREPgleichungsartpruefen;gleichungpruefen;variablepruefen;parameterpruefenPER;gleichungenundparameterzaehlen(falscheeingaben);IFfalscheeingabenTHENfehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);verlasseeingabendeszweitenformularspruefenFI;variableundparametereinzelnaufuebersetzbarkeitpruefen;doppeltdeklariert:=FALSE;aufdoppeldeklarationenpruefen(doppeltdeklariert);IFdoppeltdeklariertTHEN IFcursorfeld>41THENcursorfeldDECR40;formularfuellen(beginnseite2,endeseite2)FI;fehlertext:=ausklabeldoppelt;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);verlasseeingabendeszweitenformularspruefenFI;gleichungenpruefen;fehlertext:="";fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);feld(1):=leeresfeld;put(zweiteseite,feld(1),1);allefeldersperren.cursorpositionierenundggfformularfuellen:IFzzaehler>endeseite1THENcursorfeld:=(zzaehler-endeseite1)*4+fehlerfeldvariable;formularfuellen(beginnseite2,endeseite2)ELSEcursorfeld:=(zzaehler*4)+fehlerfeldvariable;FI;verlasseeingabendeszweitenformularspruefen.
+verlasseeingabendeszweitenformularspruefen:falscheeingaben:=TRUE;LEAVEeingabendeszweitenformularspruefen.gleichungsartpruefen:IFglzeile(zzaehler).gleichungsart=""THENglzeile(zzaehler).gleichungsart:="_"FI;IFpos("de_",glzeile(zzaehler).gleichungsart)=0THENfehlerfeldvariable:=-2;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungsart);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELSEvorherigefelderleer:=(glzeile(zzaehler).gleichungsart="_")FI.gleichungpruefen:IFlength(glzeile(zzaehler).gleichung)=0CAND NOTvorherigefelderleerTHENfehlerfeldvariable:=-1;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungfehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELIFlength(glzeile(zzaehler).gleichung)>0CANDvorherigefelderleerTHENfehlerfeldvariable:=-2;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlergleichungsartfehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.variablepruefen:IFvorherigefelderleerTHEN IFlength(glzeile(zzaehler).variable)>0THENfehlerfeldvariable:=0;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlervariable);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI ELIFlength(glzeile(zzaehler).variable)=0THENfehlerfeldvariable:=0;fehlertext:=auskgleichungunvollstaendig;feld(1):=meldungstext(fehlervariablefehlt);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenELIFlength(glzeile(zzaehler).variable)>maxvariablenlaengeTHENfehlerfeldvariable:=0;fehlertext:=ausklabelzulang;feld(1):=meldungstext(fehlervariablezulang);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.parameterpruefen:IFlength(eingabeparametername(zzaehler))>maxparlaengeTHENfehlerfeldvariable:=1;fehlertext:=ausklabelzulang;feld(1):=meldungstext(fehlerparameterzulang);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI.variableundparametereinzelnaufuebersetzbarkeitpruefen:allevariableneinzelnaufuebersetzbarkeitpruefen;alleparametereinzelnaufuebersetzbarkeitpruefen.allevariableneinzelnaufuebersetzbarkeitpruefen:FORiFROM1UPTOgleichungsanzahlREP IFnichtuebersetzbar("REAL VAR"+elan(glzeile(i).variable)+";")THENzzaehler:=i;fehlerfeldvariable:=0;fehlertext:=ausklabelzulang;feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.alleparametereinzelnaufuebersetzbarkeitpruefen:FORiFROM1UPTOanzahlparameterREP IFnichtuebersetzbar("REAL VAR"+elan(eingabeparametername(i))+";")THENzzaehler:=i;fehlerfeldvariable:=1;fehlertext:=ausklabelzulang;feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.gleichungenpruefen:IFdgleichungsanzahl>0THENprozeduranfangderzeugen;prozedurendederzeugen;alledgleichungeneinzelnpruefen;alledgleichungenzusammenpruefenFI;IFegleichungsanzahl>0THENprozeduranfangeerzeugen;prozedurendeeerzeugen;alleegleichungeneinzelnpruefen;alleegleichungenzusammenpruefenFI.prozeduranfangderzeugen:prozedurkopfderzeugen;deklarationenderzeugen.prozedurkopfderzeugen:prozeduranfangd:="PROC diff gleichungen:".prozedurendederzeugen:prozedurended:="END PROC diff gleichungen;".deklarationenderzeugen:deklarationend:="REAL CONST";FORiFROM1UPTOdgleichungsanzahlREPdeklarationendCAT(elan(glzeile(i).variable)+":= 0.0,")PER;FORiFROM1UPTOanzahlparameterREPdeklarationendCAT(elan(eingabeparametername(i))+":= 0.0,")PER;deklarationendCAT"zeit:= 0.0;";prozeduranfangdCATdeklarationend.alledgleichungeneinzelnpruefen:FORiFROM1UPTOdgleichungsanzahlREPprocd:="";procdCATprozeduranfangd;procdCAT("REAL VAR d"+elan(glzeile(i).variable)+";");procdCATglzeile(i).gleichung;procdCATprozedurended;IFnichtuebersetzbar(procd)THENzzaehler:=i;
+fehlerfeldvariable:=-1;fehlertext:=errorauswertung(errormessage);feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.alledgleichungenzusammenpruefen:prozedurd:="";prozedurdCATprozeduranfangd;prozedurdCAT("REAL VAR d"+elan(glzeile(1).variable));FORiFROM2UPTOdgleichungsanzahlREPprozedurdCAT(", d"+elan(glzeile(i).variable))PER;prozedurdCAT";";FORiFROM1UPTOdgleichungsanzahlREPprozedurdCATglzeile(i).gleichungPER;prozedurdCATprozedurended;IFlength(compress(prozedurd))<=maxinterpretlaengeCANDnichtuebersetzbar(prozedurd)THENfeld(1):=errormessage;fehlertext:=errorauswertung(errormessage);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorfeld:=ersteseingabefeld;verlasseeingabendeszweitenformularspruefenFI.prozeduranfangeerzeugen:prozedurkopfeerzeugen;deklarationeneerzeugen.prozedurkopfeerzeugen:prozeduranfange:="PROC ergaenzungsgleichungen:".prozedurendeeerzeugen:prozedurendee:="END PROC ergaenzungsgleichungen;".deklarationeneerzeugen:deklarationene:="REAL CONST";FORiFROM1UPTOdgleichungsanzahlREPdeklarationeneCAT(elan(glzeile(i).variable)+":= 0.0,")PER;FORiFROM1UPTOanzahlparameterREPdeklarationeneCAT(elan(eingabeparametername(i))+":= 0.0,")PER;deklarationeneCAT("zeit:= 0.0;");prozeduranfangeCATdeklarationene.alleegleichungeneinzelnpruefen:FORprueflingFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPproce:="";proceCATprozeduranfange;objektealskonstanten;proceCATglzeile(pruefling).gleichung;proceCATprozedurendee;IFnichtuebersetzbar(proce)THENzzaehler:=pruefling;fehlerfeldvariable:=-1;fehlertext:=errorauswertung(errormessage);feld(1):=errormessage;fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorpositionierenundggfformularfuellenFI PER.objektealskonstanten:proceCAT"REAL VAR"+elan(glzeile(pruefling).variable)+";";IFegleichungsanzahl>1THENproceCAT"REAL CONST";IFpruefling=dgleichungsanzahl+1THENi:=dgleichungsanzahl+2;ELSEi:=dgleichungsanzahl+1;FI;proceCAT(elan(glzeile(i).variable))+":= 0.0";iINCR1;WHILEi<=gleichungsanzahlREP IFi<>prueflingTHENproceCAT(","+elan(glzeile(i).variable))+":= 0.0"FI;iINCR1;PER;proceCAT";";FI;.alleegleichungenzusammenpruefen:prozedure:="";prozedureCATprozeduranfange;objektealsvariablen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPprozedureCATglzeile(i).gleichungPER;prozedureCATprozedurendee;IFlength(compress(prozedure))<=maxinterpretlaengeCANDnichtuebersetzbar(prozedure)THENfeld(1):=errormessage;fehlertext:=errorauswertung(errormessage);fehlermeldung:=auskunftstext(auskihrfehler)+" "+feld(1);cursorfeld:=ersteseingabefeld;verlasseeingabendeszweitenformularspruefenFI.objektealsvariablen:prozedureCAT"REAL VAR";prozedureCAT(elan(glzeile(dgleichungsanzahl+1).variable));FORiFROMdgleichungsanzahl+2UPTOgleichungsanzahlREPprozedureCAT(","+elan(glzeile(i).variable))PER;prozedureCAT";";.allefeldersperren:FORfeldzaehlerFROM2UPTO4*bildschirmzeilenREPprotect(zweiteseite,feldzaehler,TRUE)PER.END PROCeingabendeszweitenformularspruefen;PROCaufdoppeldeklarationenpruefen(BOOL VARdoppeltdeklariert):ROWmaxvarparaanzahlTEXT VARpruefung;INT VARzaehler,counter:=1,sortierende:=gleichungsanzahl+dgleichungsanzahl+anzahlparameter+1;zupruefenderowmitwertenfuellen;pruefung(sortierende):="00"+"z"+"zeit";quicksort(pruefung,1,sortierende);zaehler:=1;WHILEzaehler<sortierendeREP IFnameohneblanks(pruefung(zaehler))=nameohneblanks(pruefung(zaehler+1))THENcursoraufdiefalscheeingabepositionierenundfehlermelden;FI;zaehlerINCR1PER.zupruefenderowmitwertenfuellen:FORzaehlerFROM1UPTOgleichungsanzahlREPpruefung(zaehler):=zweistelligezahl(counter)+"v"+elan(glzeile(counter).variable);counterINCR1PER;counter:=1;FORzaehlerFROMgleichungsanzahl+1UPTOgleichungsanzahl+anzahlparameterREPpruefung(zaehler):=zweistelligezahl(counter)+"p"+elan(eingabeparametername(counter));counterINCR1PER;counter:=1;FORzaehlerFROMgleichungsanzahl+anzahlparameter+1UPTOsortierende-1REPpruefung(zaehler):=zweistelligezahl(counter)+"g"+"d"+elan(glzeile(counter).variable);counterINCR1PER.
+cursoraufdiefalscheeingabepositionierenundfehlermelden:IFaufeinanderfolgendekennzeichengundvodergundpTHENcursoraufvariablebzwparameterpositionieren;feld(1):=meldungstext(fehlervundgdoppelt);doppeltdeklariert:=TRUE;LEAVEaufdoppeldeklarationenpruefenFI;IFaufeinanderfolgendekennzeichenzundvoderzundpTHENcursoraufvariablebzwparameterpositionieren;feld(1):=meldungstext(fehlerzeitvariabledoppelt);doppeltdeklariert:=TRUE;LEAVEaufdoppeldeklarationenpruefenFI;IFsubtext(pruefung(zaehler),3,3)="v"THENcursorfeld:=lfdnummer(pruefung(zaehler))*4;feld(1):=meldungstext(fehlerdoppeldeklaration);doppeltdeklariert:=TRUE;LEAVEaufdoppeldeklarationenpruefenELIFsubtext(pruefung(zaehler),3,3)="p"THENcursorfeld:=lfdnummer(pruefung(zaehler))*4+1;feld(1):=meldungstext(fehlerdoppeldeklaration);doppeltdeklariert:=TRUE;LEAVEaufdoppeldeklarationenpruefenFI.aufeinanderfolgendekennzeichengundvodergundp:(subtext(pruefung(zaehler),3,3)="g"CANDsubtext(pruefung(zaehler+1),3,3)="v")COR(subtext(pruefung(zaehler),3,3)="v"CANDsubtext(pruefung(zaehler+1),3,3)="g")COR(subtext(pruefung(zaehler),3,3)="g"CANDsubtext(pruefung(zaehler+1),3,3)="p")COR(subtext(pruefung(zaehler),3,3)="p"CANDsubtext(pruefung(zaehler+1),3,3)="g").aufeinanderfolgendekennzeichenzundvoderzundp:(subtext(pruefung(zaehler),3,3)="z"CANDsubtext(pruefung(zaehler+1),3,3)="v")COR(subtext(pruefung(zaehler),3,3)="v"CANDsubtext(pruefung(zaehler+1),3,3)="z")COR(subtext(pruefung(zaehler),3,3)="z"CANDsubtext(pruefung(zaehler+1),3,3)="p")COR(subtext(pruefung(zaehler),3,3)="p"CANDsubtext(pruefung(zaehler+1),3,3)="z").cursoraufvariablebzwparameterpositionieren:IFsubtext(pruefung(zaehler),3,3)="v"THENcursorfeld:=lfdnummer(pruefung(zaehler))*4ELIFsubtext(pruefung(zaehler+1),3,3)="v"THENcursorfeld:=lfdnummer(pruefung(zaehler+1))*4ELIFsubtext(pruefung(zaehler),3,3)="p"THENcursorfeld:=lfdnummer(pruefung(zaehler))*4+1ELIFsubtext(pruefung(zaehler+1),3,3)="p"THENcursorfeld:=lfdnummer(pruefung(zaehler+1))*4+1FI.END PROCaufdoppeldeklarationenpruefen;TEXT PROCerrorauswertung(TEXT CONSTmessage):IFpos(message,unbekkommdo)<>0THENauskcompilunbekkommELIFpos(message,undefdyadischop)<>0CORpos(message,undefmonadop)<>0CORpos(message,paramsindfalsch)<>0THENauskcompilparameterELIFpos(message,nurletzteanweisg)<>0CORpos(message,anstelledessymb)<>0CORpos(message,unzulselektsymb)<>0CORpos(message,konstdarfnicht)<>0THENauskcompilsymboleELIFpos(message,klammerauffehlt)<>0CORpos(message,klammerzufehlt)<>0CORpos(message,operatorfehlt)<>0CORpos(message,ungueltigzwischen)<>0THENauskcompilungueltzwELIFpos(message,istmehrfachdekl)<>0THENauskcompilmehrfdeklELSEauskcompilsonstigesFI.END PROCerrorauswertung;PROCquicksort(ROWmaxvarparaanzahlTEXT VARpruefung,INT CONSTanfang,ende):INT VARpivotadresse,zeigeroben,zeigerunten,adrgroesserpivot,adrkleinerpivot;TEXT VARpivot;IFanfang<endeTHENermittlepivotelement;initialisiereoberenundunterenvergleichszeiger;ordnedieelementemithilfevonpivot;sortiereteillistenwennsiemehralseinelemententhaltenFI.ermittlepivotelement:pivotadresse:=(ende+anfang)DIV2;pivot:=pruefung(pivotadresse).initialisiereoberenundunterenvergleichszeiger:zeigeroben:=anfang;zeigerunten:=ende.ordnedieelementemithilfevonpivot:pruefung(pivotadresse):=pruefung(anfang);WHILEzeigeroben<zeigeruntenREPsuchevonobenechtgroesserpivot;suchevonuntenkleinergleichpivotwennnoetigPER.suchevonobenechtgroesserpivot:adrgroesserpivot:=zeigeroben+1;WHILEadrgroesserpivot<=zeigeruntenCANDname(pivot)>=name(pruefung(adrgroesserpivot))REPadrgroesserpivotINCR1PER.suchevonuntenkleinergleichpivotwennnoetig:IFadrgroesserpivot>zeigeruntenTHENmacheletztenplatzfreiundsetzepivotdahin;zeigeroben:=zeigeruntenELSEsuchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesserenFI.macheletztenplatzfreiundsetzepivotdahin:pruefung(zeigeroben):=pruefung(zeigerunten);pruefung(zeigerunten):=pivot.suchevonuntenelementkleinergleichpivotundvertauscheesmitdemgroesseren:adrkleinerpivot:=zeigerunten;WHILEadrkleinerpivot>=adrgroesserpivotCANDname(pruefung(adrkleinerpivot))>name(pivot)REP
+adrkleinerpivotDECR1PER;IFadrkleinerpivot<adrgroesserpivotTHENbringepivotoberhalbvonadrgroesserpivotunterELSEpruefung(zeigeroben):=pruefung(adrkleinerpivot);pruefung(adrkleinerpivot):=pruefung(adrgroesserpivot);pruefung(adrgroesserpivot):=pivot;zeigeroben:=adrgroesserpivot;zeigerunten:=adrkleinerpivot-1FI.bringepivotoberhalbvonadrgroesserpivotunter:pruefung(zeigeroben):=pruefung(adrgroesserpivot-1);pruefung(adrgroesserpivot-1):=pivot;zeigeroben:=adrgroesserpivot-1;zeigerunten:=zeigeroben.sortiereteillistenwennsiemehralseinelemententhalten:IFende-anfang>1THENpruefeobsortierbereichveraendert;quicksort(pruefung,anfang,zeigeroben);quicksort(pruefung,zeigeroben+1,ende)FI.pruefeobsortierbereichveraendert:IFzeigeroben=endeTHENzeigeroben:=zeigeroben-1FI.END PROCquicksort;PROCmodellmitdatenfuellen(MODELLDGL VARzwmodell):INT VARvz,i;ZUSTAND VARz1:=neuerzustand(dgleichungsanzahl),z2:=z1;PARAMETER VARp1:=neuerparameter(anzahlparameter),p2:=p1;FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,0.0)PER;zwmodell.demolauf.original.startwert:=text(z1);zwmodell.demolauf.vergleich.startwert:=text(z1);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.unteregrenze:=text(z1);zwmodell.variablen.oberegrenze:=text(z2);z1:=neuerzustand(gleichungsanzahl);z2:=z1;FORvzFROM1UPTOgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.randoben:=text(z2);zwmodell.variablen.randunten:=text(z1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,0.0)PER;zwmodell.demolauf.original.parameter:=text(p1);zwmodell.demolauf.vergleich.parameter:=text(p1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,-1.0e+126);replace(p2,vz,1.0e+126)PER;zwmodell.parameter.unteregrenze:=text(p1);zwmodell.parameter.oberegrenze:=text(p2);zwmodell.demolauf.original.anfangszeitpunkt:=0.0;zwmodell.demolauf.original.beobachtungsdauer:=0.0;zwmodell.demolauf.vergleich.anfangszeitpunkt:=0.0;zwmodell.demolauf.vergleich.beobachtungsdauer:=0.0;zwmodell.beschraenkung.minbeobachtungsdauer:=0.0;zwmodell.beschraenkung.maxbeobachtungsdauer:=1.0e+126;zwmodell.beschraenkung.minanfangszeitpunkt:=-1.0e+126;zwmodell.beschraenkung.maxanfangszeitpunkt:=1.0e+126;zwmodell.beschraenkung.anzahlbeobachtungspunkte:=21;forget(zwmodell.codeundinfo,quiet);gleichungsraum:=new(zwmodell.codeundinfo);FORiFROM1UPTOdgleichungsanzahlREPzwmodell.variablen.namelang(i):=glzeile(i).variable;zwmodell.variablen.namekurz(i):=glzeile(i).variable;gleichungsraum.gleichungen(i):=glzeile(i).gleichungPER;gleichungsraum.gleichungen(dgleichungsanzahl+1):=endezeichen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPzwmodell.covariablen.namelang(i-dgleichungsanzahl):=glzeile(i).variable;zwmodell.covariablen.namekurz(i-dgleichungsanzahl):=glzeile(i).variable;gleichungsraum.cogleichungen(i-dgleichungsanzahl):=glzeile(i).gleichungPER;gleichungsraum.cogleichungen(egleichungsanzahl+1):=endezeichen;FORiFROM1UPTOanzahlparameterREPzwmodell.parameter.namelang(i):=eingabeparametername(i);zwmodell.parameter.nameelan(i):=elan(eingabeparametername(i))PER;zwmodell.variablen.anzahl:=dgleichungsanzahl;zwmodell.covariablen.anzahl:=egleichungsanzahl;zwmodell.parameter.anzahl:=anzahlparameter;zwmodell.mitphasendiagramm:=TRUE;zwmodell.geschuetzt:=FALSE;.END PROCmodellmitdatenfuellen;PROCmodellmitdatenfuellen(MODELLDGL VARzwmodell,THESAURUS CONSTvnamenlang,vnamenkurz,enamenlang,enamenkurz,pnamen):INT VARvz,i;ZUSTAND VARz1:=neuerzustand(dgleichungsanzahl),z2:=z1;PARAMETER VARp1:=neuerparameter(anzahlparameter),p2:=p1;zwmodell.name.lang:=aktuellermodellname;zwmodell.name.kurz:=aktuellermodellkurzname;zwmodell.name.elan:=elan(aktuellermodellkurzname);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,0.0)PER;zwmodell.demolauf.original.startwert:=text(z1);zwmodell.demolauf.vergleich.startwert:=text(z1);FORvzFROM1UPTOdgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.unteregrenze:=text(z1);zwmodell.variablen.oberegrenze:=text(z2);z1:=neuerzustand(
+gleichungsanzahl);z2:=z1;FORvzFROM1UPTOgleichungsanzahlREPreplace(z1,vz,-1.0e+126);replace(z2,vz,1.0e+126)PER;zwmodell.variablen.randoben:=text(z2);zwmodell.variablen.randunten:=text(z1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,0.0)PER;zwmodell.demolauf.original.parameter:=text(p1);zwmodell.demolauf.vergleich.parameter:=text(p1);FORvzFROM1UPTOanzahlparameterREPreplace(p1,vz,-1.0e+126);replace(p2,vz,1.0e+126)PER;zwmodell.parameter.unteregrenze:=text(p1);zwmodell.parameter.oberegrenze:=text(p2);zwmodell.demolauf.original.anfangszeitpunkt:=0.0;zwmodell.demolauf.original.beobachtungsdauer:=0.0;zwmodell.demolauf.vergleich.anfangszeitpunkt:=0.0;zwmodell.demolauf.vergleich.beobachtungsdauer:=0.0;zwmodell.beschraenkung.minbeobachtungsdauer:=0.0;zwmodell.beschraenkung.maxbeobachtungsdauer:=1.0e+126;zwmodell.beschraenkung.minanfangszeitpunkt:=-1.0e+126;zwmodell.beschraenkung.maxanfangszeitpunkt:=1.0e+126;zwmodell.beschraenkung.anzahlbeobachtungspunkte:=21;zwmodell.variablen.namelang:=vnamenlang;zwmodell.variablen.namekurz:=vnamenkurz;zwmodell.covariablen.namelang:=enamenlang;zwmodell.covariablen.namekurz:=enamenkurz;zwmodell.parameter.namelang:=pnamen;FORiFROM1UPTOanzahlparameterREPzwmodell.parameter.nameelan(i):=""PER;zwmodell.variablen.anzahl:=dgleichungsanzahl;zwmodell.covariablen.anzahl:=egleichungsanzahl;zwmodell.parameter.anzahl:=anzahlparameter;zwmodell.mitphasendiagramm:=TRUE;zwmodell.geschuetzt:=FALSE;zwmodell.modellzustand:=uebersetzbar;zwmodell.codeundinfo:="";.dgleichungsanzahl:highestentry(vnamenlang).egleichungsanzahl:highestentry(enamenlang).anzahlparameter:highestentry(pnamen).gleichungsanzahl:egleichungsanzahl+dgleichungsanzahl.END PROCmodellmitdatenfuellen;OP:=(ROWmaxdimensionTEXT VARrow,THESAURUS CONSTthes):TEXT VARname;INT VARi:=0;WHILEi<highestentry(thes)ANDi<=maxdimensionREPget(thes,name,i);row(i):=namePER END OP:=;PROCauskunftsdienst(TEXT CONSTinfotext,fehler,loeschtaste):TEXT VARerstesfeld,zweitesfeld,drittesfeld;INT VARseitenzahl;maskezumauskunftsdienstausgeben;REPkernvonauskunftsdienstPER.kernvonauskunftsdienst:infotextundsteuerzeileausgeben;REPwarteaufesc;tasteeinlesen(taste);IFtaste=blaettertasteTHENseitenzahlINCR1;IFseitenzahl>length(infotext)THENseitenzahl:=1FI;reenterauskunftsdienst;ELIFtaste=loeschtasteTHENleaveauskunftsdienstELSEput(formular(infoseite),meldungstext(fehlertaste),1);FI PER.maskezumauskunftsdienstausgeben:show(formular(infoseite));seitenzahl:=1;erstesfeld:=fehler.reenterauskunftsdienst:LEAVEkernvonauskunftsdienst.leaveauskunftsdienst:LEAVEauskunftsdienst.infotextundsteuerzeileausgeben:IFlength(infotext)>seitenzahlTHENdrittesfeld:=steuerleiste(17)ELIFlength(infotext)>1THENdrittesfeld:=steuerleiste(16)ELIFloeschtaste=auskunftsloeschtaste2THENdrittesfeld:=steuerleiste(18)ELSEdrittesfeld:=steuerleiste(15)FI;IFinfotext=""THENzweitesfeld:=""ELSEzweitesfeld:=auskunftstext(code(infotextSUBseitenzahl))FI;put(formular(infoseite),zweitesfeld,2);put(formular(infoseite),erstesfeld,1);put(formular(infoseite),drittesfeld,3);erstesfeld:=fehler;.END PROCauskunftsdienst;PROCinfotextauswahl(TEXT CONSTfehlertext,fehler):infotextauswahl(fehlertext,fehler,allgemeineauskunftseite2,auskunftzummodellerfassenseite2)END PROCinfotextauswahl;PROCinfotextauswahl(TEXT CONSTfehlertext,fehler,top1,top2):INT VARformularnr,eingabezeile;TEXT VARerstesfeld,auskunftzufehler,auskunft;BOOL VARfalscheeingaben;IFfehlertext=""THENformularnr:=infowahlkurz;eingabezeile:=15;ELSEformularnr:=infowahllang;eingabezeile:=17;FI;REPkernvoninfotextauswahlPER.kernvoninfotextauswahl:maskezurinfotextauswahlausgeben;REPput(formular(formularnr),erstesfeld,1);falscheeingaben:=FALSE;cursor(60,eingabezeile);tasteeinlesen(taste);IFtaste="1"THENauskunft:=top1;fehlermeldung:=""ELIFtaste="2"THENauskunft:=top2;fehlermeldung:=""ELIFtaste="3"CANDfehlertext<>""THEN TEXT VARtt:=compress(fehlermeldung);changeall(tt,"  ","");auskunft:=fehlertext;fehlermeldung:=tt;ELIFtaste=auskunftsloeschtaste1THENleaveinfotextauswahlELSEerstesfeld:=meldungstext(fehlertaste
+);falscheeingaben:=TRUE FI;IF NOTfalscheeingabenTHEN IFauskunft=""THENerstesfeld:="Hierzu existiert noch keine Auskunft!"ELSEauskunftsdienst(auskunft,fehlermeldung,auskunftsloeschtaste2);reenterinfotextauswahlFI FI PER.maskezurinfotextauswahlausgeben:show(formular(formularnr));erstesfeld:=leeresfeld.reenterinfotextauswahl:LEAVEkernvoninfotextauswahl.leaveinfotextauswahl:LEAVEinfotextauswahl.END PROCinfotextauswahl;PROCwarteaufesc:TEXT VAReingabe;REPeingabe:=incharetyUNTILeingabe=escPER.END PROCwarteaufesc;PROCinfotextablegen(MODELLDGL VARzwmodell):FILE VARinformation;INT VARz;TEXT VARzeile;IF NOTexists(zwmodell.codeundinfo)THENgleichungsraum:=new(zwmodell.codeundinfo);FI;information:=modellinfo(zwmodell,dsname);infotextimdatenraumablegen;forget(dsname,quiet).infotextimdatenraumablegen:input(information);z:=1;WHILE NOTeof(information)REPgetline(information,zeile);IFz>maxinfo-1THENgleichungsraum.info(z):=endezeichen;LEAVEinfotextimdatenraumablegenFI;gleichungsraum.info(z):=zeile;zINCR1PER;gleichungsraum.info(z):=endezeichen.END PROCinfotextablegen;PROCtasteeinlesen(TEXT VAReinlesetaste):REPeinlesetaste:=incharetyUNTILeinlesetaste<>""PER END PROCtasteeinlesen;INT PROClfdnummer(TEXT CONSTtext):int(subtext(text,1,2))END PROClfdnummer;TEXT PROCzweistelligezahl(INT CONSTzahl):IFlength(text(zahl))=1THEN"0"+text(zahl)ELSEtext(zahl)FI END PROCzweistelligezahl;TEXT PROCnameohneblanks(TEXT VARtext):changeall(text," ","");subtext(text,4)END PROCnameohneblanks;TEXT PROCname(TEXT CONSTtext):subtext(text,4)END PROCname;TEXT PROCkomprimiere(TEXT CONSTt):TEXT VARergebnis,z;INT VARi,l;suchevonvorne;suchevonhinten;ersetzekern;ergebnis.suchevonvorne:l:=LENGTHt;FORiFROM1UPTOlREPz:=(tSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi>lTHENergebnis:=""ELSEergebnis:=subtext(t,i,l);FI.suchevonhinten:l:=LENGTHergebnis;FORiFROMlDOWNTO1REPz:=(ergebnisSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi<1THENergebnis:=""ELSEergebnis:=subtext(ergebnis,1,i);FI.ersetzekern:changeall(ergebnis,"_"," ").END PROCkomprimiere;PROCohneumlauteundeszet(TEXT VARtext):changeall(text,"ß","ss");END PROCohneumlauteundeszet;BOOL PROCnichtuebersetzbar(TEXT CONSTtext):BOOL VARergebnis;disablestop;do(text);ergebnis:=iserror;IFiserrorTHENclearerrorFI;enablestop;ergebnisEND PROCnichtuebersetzbar;PROCprotect(TAG VARt,INT CONSTfeld,BOOL CONSTprneu):INT VARdummy;BOOL VARcl,se,sp,le,pr;fieldinfos(t,feld,dummy,cl,pr,se,sp,le);setfieldinfos(t,feld,cl,prneu,se)END PROCprotect;PROCvertauschezeilen(ZEILE VARzeile1,zeile2):ZEILE VARhilfe;hilfe:=zeile1;zeile1:=zeile2;zeile2:=hilfeEND PROCvertauschezeilen;LETtrennzeichen=6,klammerauf="(",semikolon=";",thenwort="THEN",elsewort="ELSE",repwort="REP";FILE PROCmodellinfo(MODELLDGL VARzwmodell,TEXT CONSTdatenraum):forget(datenraum,quiet);FILE VARinfo:=sequentialfile(output,datenraum);INT VARz,typ1,typ2,zeilenanfang,filler;TEXT VARersteszeichen,zweiteszeichen;TEXT VARggfluecke:="";modellnameangeben;putline(info,auskunftstext(auskgleichungen));putline(info,unterstrichfeld);IFdgleichungsanzahl>0THEN FORzFROM1UPTOdgleichungsanzahlREPdgleichungausgeben;PER FI;IFegleichungsanzahl>0THEN FORzFROM1UPTOegleichungsanzahlREPegleichungausgeben;PER FI;line(info);IFanzahlparameter>0THENputline(info,compress(auskunftstext(auskvariablen))+10*" "+compress(auskunftstext(auskparameter)));putline(info,unterstrichfeld);FORzFROM1UPTOmax(anzahlparameter,gleichungsanzahl)REPvariableundparameterausgeben;line(info)PER;ELSEputline(info,compress(auskunftstext(auskvariablen)));putline(info,unterstrichfeld);FORzFROM1UPTOdgleichungsanzahlREPputline(info,zwmodell.variablen.namekurz(z))PER;FORzFROM1UPTOegleichungsanzahlREPputline(info,zwmodell.covariablen.namekurz(z))PER FI;info.modellnameangeben:putline(info,compress(auskunftstext(auskmodell))+"    "+zwmodell.name.lang);putline(info,length(unterstrichfeld)*"=");line(info,2).dgleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.gleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REP
+dasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.egleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.cogleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REPdasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende:IF(zeilenanfang+length(ersteszeichen)+1)>=77THENzeilenanfang:=1;FI;zeilenanfangINCRlength(ersteszeichen);nextsymbol(zweiteszeichen,typ2);SELECTtyp2OF CASEtrennzeichen:IFzweiteszeichen=klammeraufCANDtyp1<>trennzeichenTHENggfluecke:=" "ELSEggfluecke:=""FI;OTHERWISEggfluecke:=" "END SELECT;SELECTtyp1OF CASE1:write(info,ersteszeichen+ggfluecke);CASE2:IFersteszeichen=thenwortCORersteszeichen=elsewortTHENline(info);put(info,ersteszeichen);ELIFersteszeichen=repwortTHENput(info,ersteszeichen);line(info)ELSEput(info,ersteszeichen);FI;CASE3:write(info,ersteszeichen+ggfluecke);CASE4:write(info,ersteszeichen+ggfluecke);CASE5:put(info,ersteszeichen);CASE6:write(info,ersteszeichen);IFersteszeichen=semikolonTHENline(info);ggfluecke:=""ELIFersteszeichen=klammeraufTHENggfluecke:=""FI;write(info,ggfluecke);ENDSELECT;IFggfluecke=" "THENzeilenanfangINCR1;FI;ersteszeichen:=zweiteszeichen;typ1:=typ2.variableundparameterausgeben:IFz<=dgleichungsanzahlTHENgebevariableausELIFz<=gleichungsanzahlTHENgebecovariableausFI;IFz<=anzahlparameterTHENgebeparameterausFI;.gebevariableaus:put(info,zwmodell.variablen.namekurz(z));IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(zwmodell.variablen.namekurz(z)));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI.gebecovariableaus:put(info,zwmodell.covariablen.namekurz(z-dgleichungsanzahl));IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(zwmodell.covariablen.namekurz(z-dgleichungsanzahl)));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI.gebeparameteraus:IFz>gleichungsanzahlTHENfiller:=infozeilenanfang+1;FI;write(info,filler*" ");put(info,zwmodell.parameter.namelang(z));.END PROCmodellinfo;PROCinfodateiausdrucken(MODELLDGL VARzwmodell,TEXT CONSTmodellbank):INT VARi;TEXT CONSTdsnameaktuell:=dsname+"."+timeofday;gleichungsraummitdatenfuellen;infodateifuellen;print(dsnameaktuell);feld(1):=auskunftstext(auskinfogedruckt);forget(dsnameaktuell,quiet);forget(zwmodell.codeundinfo,quiet).gleichungsraummitdatenfuellen:zwmodell.codeundinfo:=modellbank+sp+"X"+sp+"hilfscode";forget(zwmodell.codeundinfo,quiet);gleichungsraum:=new(zwmodell.codeundinfo);FORiFROM1UPTOdgleichungsanzahlREPgleichungsraum.gleichungen(i):=glzeile(i).gleichungPER;gleichungsraum.gleichungen(dgleichungsanzahl+1):=endezeichen;FORiFROMdgleichungsanzahl+1UPTOgleichungsanzahlREPgleichungsraum.cogleichungen(i-dgleichungsanzahl):=glzeile(i).gleichungPER;gleichungsraum.cogleichungen(egleichungsanzahl+1):=endezeichen.infodateifuellen:forget(dsnameaktuell,quiet);FILE VARinfo:=sequentialfile(output,dsnameaktuell);INT VARz,typ1,typ2,zeilenanfang,filler;TEXT VARersteszeichen,zweiteszeichen;TEXT VARggfluecke:="";modellnameangeben;putline(info,auskunftstext(auskgleichungen));putline(info,unterstrichfeld);FORzFROM1UPTOdgleichungsanzahlREPdgleichungausgeben;PER;FORzFROM1UPTOegleichungsanzahlREPegleichungausgeben;PER;line(info);IFanzahlparameter>0THENueberschriftschreiben;FORzFROM1UPTOmax(anzahlparameter,gleichungsanzahl)REPvariableundparameterausgeben;line(info)PER;ELSEputline(info,compress(auskunftstext(auskvariablen)));putline(info,unterstrichfeld);FORzFROM1UPTOgleichungsanzahlREPgebevariableaus;line(info)PER;FI;.modellnameangeben:putline(info,compress(auskunftstext(auskmodell))+"    "+zwmodell.name.lang);putline(info,length(unterstrichfeld)*"=");line(info,2).ueberschriftschreiben:putline(info,compress(auskunftstext(auskvariablen))+10*" "+compress(auskunftstext(auskparameter)));putline(info,unterstrichfeld);.dgleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.gleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REP
+dasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.egleichungausgeben:zeilenanfang:=1;scan(gleichungsraum.cogleichungen(z));nextsymbol(ersteszeichen,typ1);dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende;WHILEtyp1<7REPdasnaechstezeichenschreibenmitruecksichtaufdaszeilenendePER.dasnaechstezeichenschreibenmitruecksichtaufdaszeilenende:IF(zeilenanfang+length(ersteszeichen)+1)>=77THENzeilenanfang:=1;FI;zeilenanfangINCRlength(ersteszeichen);nextsymbol(zweiteszeichen,typ2);SELECTtyp2OF CASEtrennzeichen:IFzweiteszeichen=klammeraufCANDtyp1<>trennzeichenTHENggfluecke:=" "ELSEggfluecke:=""FI;OTHERWISEggfluecke:=" "END SELECT;SELECTtyp1OF CASE1:write(info,ersteszeichen+ggfluecke);CASE2:IFersteszeichen=thenwortCORersteszeichen=elsewortTHENline(info);put(info,ersteszeichen);ELIFersteszeichen=repwortTHENput(info,ersteszeichen);line(info)ELSEput(info,ersteszeichen);FI;CASE3:write(info,ersteszeichen+ggfluecke);CASE4:write(info,ersteszeichen+ggfluecke);CASE5:put(info,ersteszeichen);CASE6:write(info,ersteszeichen);IFersteszeichen=semikolonTHENline(info);ggfluecke:=""ELIFersteszeichen=klammeraufTHENggfluecke:=""FI;write(info,ggfluecke);ENDSELECT;IFggfluecke=" "THENzeilenanfangINCR1;FI;ersteszeichen:=zweiteszeichen;typ1:=typ2;.variableundparameterausgeben:IFz<=gleichungsanzahlTHENgebevariableaus;FI;IFz<=anzahlparameterTHENgebeparameterausFI;.gebevariableaus:put(info,glzeile(z).variable);IFz<=anzahlparameterTHENfiller:=infozeilenanfang-length(compress(glzeile(z).variable));IFfiller=infozeilenanfangTHENfillerINCR1FI;FI;.gebeparameteraus:IFz>gleichungsanzahlTHENfiller:=infozeilenanfang+1;FI;write(info,filler*" ");put(info,eingabeparametername(z)).END PROCinfodateiausdrucken;PROCputgetformular1(ROW100TEXT VARfeld,INT VARcursorfeld,TEXT VARtaste):TEXT CONSTinternetasten:=return+hoch+runter+tab;put(formular(seite1),feld);REPput(formular(seite1),feld(cursorfeld),cursorfeld);get(formular(seite1),feld(cursorfeld),cursorfeld,taste);IFtaste=runterTHENcursorfeld:=3FI;IFtaste=hochTHENcursorfeld:=2FI;IFtaste=returnTHEN IFcursorfeld=2THENcursorfeld:=3ELSEcursorfeld:=2FI FI UNTILpos(internetasten,taste)=0PER END PROCputgetformular1;END PACKETmodellbasis;
+
+
diff --git a/app/schulis-simulationssystem/3.0/src/modellbasis geraet b/app/schulis-simulationssystem/3.0/src/modellbasis geraet
new file mode 100644
index 0000000..2a0a82a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/modellbasis geraet
@@ -0,0 +1,9 @@
+PACKETmodellbasisDEFINESmodelldatenraum,compilierbaregleichungen,MODELLDGL,modellname,modellbezeichnung,modellkurzbezeichnung,dimension,codimension,parameteranzahl,mitzusatzdarstellung,mitphasendiagramm,informationstext,variablenoberbegriff,variablenoberbegriffkurzform,variablenname,variablenkurzform,covariablenname,covariablenkurzform,parametername,parameterkurzform,darstellungsname,zustandunteregrenze,zustandoberegrenze,parameterunteregrenze,parameteroberegrenze,randoben,randunten,vorgabesystemzustand,vorgabeparameter,vorgabebeobachtungsdauer,vorgabeanfangszeitpunkt,vorgabekurve,vorgabevergleichssystemzustand,vorgabevergleichsparameter,vorgabevergleichsbeobachtungsdauer,vorgabevergleichsanfangszeitpunkt,vorgabevergleichskurve,demomuster,demoxindex,demoyindex,demoautomatik,minbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,anzahlbeobachtungspunkte,mitkombinationen,listekombinationen,indiceskombinationen,ergebnisganzzahlig,:=,VON,LOESUNG,STARTZEIT,DAUER,STARTWERT,PARAMETERSATZ,LOESUNGSABSCHNITT,KURVENDIMENSION,vergleichswerte,originalwerte,gleichungsprozeduren,setzemodelltyp,wirkungsdgr,kopplean:LETmaxdimension=20,maxparameter=20,typnrmodell=1077,maxvarlaenge=30,maxinfo=50,maxgleichungen=50,maxdarstellungszeilen=500,uebersetzbar=0,notuebersetzbar=1,initialisierungds="x",endezeichen="zZz",sp=" ",praefix="d ",modellcode=" code info ds",originalkurve=" originalkurve ds",vergleichskurve=" vergleichskurve ds",uebersetzungsfile="uebersetzungsdatei",darstellungskopf="  PROC darstellung 4 (LOESUNG VAR lsg, BOOL VAR in demo, TEXT VAR taste):",darstellungsende="  END PROC darstellung 4 ;";LETabbruchtaste="a",auskunftstaste="i",auskunftsloeschtaste1="z",auskunftsloeschtaste2="l",weitertaste="w",blaettertaste="b",speichertaste="s",zuruecktaste="z",simulationstaste="w",drucktaste="d",esc="�";LET ZEILE=STRUCT(TEXTgleichungsart,gleichung,variable,INTnummer);TYPE DEMOLAUF=STRUCT(VORGABEoriginal,vergleich,INTxindex,yindex,BOOLautomatisch,TEXTvariablenwahl);TYPE VORGABE=STRUCT(TEXTstartwert,parameter,REALanfangszeitpunkt,beobachtungsdauer,TEXTkurve);TYPE LOESUNG=STRUCT(ZUSTANDstartwert,PARAMETERparameter,REALanfangszeitpunkt,beobachtungsdauer,KURVEkurve);TYPE NAMEN=STRUCT(TEXTelan,ohneumlaute,kurz);TYPE ZUSTANDSDATEN=STRUCT(INTanzahl,TEXToberbegriff,oberbegriffkurzform,ROWmaxdimensionTEXTnamelang,namekurz,TEXTunteregrenze,oberegrenze,randoben,randunten);TYPE COVARIABLENDATEN=STRUCT(INTanzahl,ROWmaxdimensionTEXTnamelang,namekurz);TYPE KOMBINATION=STRUCT(TEXTname,INTxindex,yindex,BOOLautomatisch);TYPE KOMBINATIONSANGEBOT=STRUCT(BOOLmitkombinationen,INTanzahl,ROWmaxdimensionKOMBINATIONpaar);TYPE PARAMETERDATEN=STRUCT(INTanzahl,ROWmaxparameterTEXTnamelang,nameelan,TEXTunteregrenze,oberegrenze);TYPE DARSTELLUNGSDATEN=STRUCT(BOOLimmodell,TEXTname);TYPE BESCHRAENKUNG=STRUCT(REALminbeobachtungsdauer,maxbeobachtungsdauer,minanfangszeitpunkt,maxanfangszeitpunkt,INTanzahlbeobachtungspunkte);LET TEXTDATEN=BOUND STRUCT(ROWmaxinfoTEXTinfo,ROWmaxgleichungenTEXTgleichungen,cogleichungen,ROWmaxdarstellungszeilenTEXTdarstellungscode);TYPE MODELLDGL=STRUCT(NAMENname,ZUSTANDSDATENvariablen,COVARIABLENDATENcovariablen,PARAMETERDATENparameter,DARSTELLUNGSDATENdarstellung,BOOLmitphasendiagramm,BOOLganzzahlig,KOMBINATIONSANGEBOTkombinationen,TEXTcodeundinfo,BESCHRAENKUNGbeschraenkung,DEMOLAUFdemolauf,INTmodellzustand,BOOLgeschuetzt);MODELLDGL VARmodell;TEXTDATEN VARtextdaten;BOOL VARwd:=FALSE;OP:=(LOESUNG VARlinks,LOESUNG CONSTrechts):links.startwert:=rechts.startwert;links.parameter:=rechts.parameter;links.anfangszeitpunkt:=rechts.anfangszeitpunkt;links.beobachtungsdauer:=rechts.beobachtungsdauer;links.kurve:=rechts.kurve;END OP:=;OP VON(LOESUNG VARlinks,LOESUNG CONSTrechts):links.startwert:=rechts.startwert;links.parameter:=rechts.parameter;links.anfangszeitpunkt:=rechts.anfangszeitpunkt;links.beobachtungsdauer:=rechts.beobachtungsdauer;END OP VON;LOESUNG PROCvergleichswerte:LOESUNG VARlsg;lsg.startwert:=vorgabevergleichssystemzustand;
+lsg.parameter:=vorgabevergleichsparameter;lsg.anfangszeitpunkt:=vorgabevergleichsanfangszeitpunkt;lsg.beobachtungsdauer:=vorgabevergleichsbeobachtungsdauer;lsg.kurve:=old(vorgabevergleichskurve);lsg.END PROCvergleichswerte;LOESUNG PROCoriginalwerte:LOESUNG VARlsg;lsg.startwert:=vorgabesystemzustand;lsg.parameter:=vorgabeparameter;lsg.anfangszeitpunkt:=vorgabeanfangszeitpunkt;lsg.beobachtungsdauer:=vorgabebeobachtungsdauer;IFexists(vorgabekurve)THENlsg.kurve:=old(vorgabekurve);FI;lsg.END PROCoriginalwerte;OP STARTZEIT(LOESUNG VARlsg,REAL CONSTstartzeit):lsg.anfangszeitpunkt:=startzeitEND OP STARTZEIT;REAL OP STARTZEIT(LOESUNG CONSTlsg):lsg.anfangszeitpunktEND OP STARTZEIT;OP DAUER(LOESUNG VARlsg,REAL CONSTdauer):lsg.beobachtungsdauer:=dauerEND OP DAUER;REAL OP DAUER(LOESUNG CONSTlsg):lsg.beobachtungsdauerEND OP DAUER;OP STARTWERT(LOESUNG VARlsg,ZUSTAND CONSTstartwert):lsg.startwert:=startwertEND OP STARTWERT;ZUSTAND OP STARTWERT(LOESUNG CONSTlsg):lsg.startwertEND OP STARTWERT;OP PARAMETERSATZ(LOESUNG VARlsg,PARAMETER CONSTparameter):lsg.parameter:=parameterEND OP PARAMETERSATZ;PARAMETER OP PARAMETERSATZ(LOESUNG CONSTlsg):lsg.parameterEND OP PARAMETERSATZ;OP LOESUNGSABSCHNITT(LOESUNG VARlsg,KURVE CONSTkurve):lsg.kurve:=kurveEND OP LOESUNGSABSCHNITT;KURVE OP LOESUNGSABSCHNITT(LOESUNG CONSTlsg):lsg.kurveEND OP LOESUNGSABSCHNITT;INT OP KURVENDIMENSION(KURVE CONSTkurve):dimension+codimension+1.END OP KURVENDIMENSION;TEXT PROCmodellbezeichnung:modell.name.ohneumlaute.END PROCmodellbezeichnung;TEXT PROCmodellkurzbezeichnung:modell.name.kurzEND PROCmodellkurzbezeichnung;TEXT PROCmodellname:modell.name.elanEND PROCmodellname;TEXT PROCmodelldatenraum:modell.codeundinfoEND PROCmodelldatenraum;BOOL PROCcompilierbaregleichungen:modell.modellzustand=uebersetzbarEND PROCcompilierbaregleichungen;INT PROCdimension:modell.variablen.anzahlEND PROCdimension;INT PROCcodimension:modell.covariablen.anzahlEND PROCcodimension;INT PROCparameteranzahl:modell.parameter.anzahlEND PROCparameteranzahl;BOOL PROCmitzusatzdarstellung:modell.darstellung.immodellEND PROCmitzusatzdarstellung;BOOL PROCmitphasendiagramm:modell.mitphasendiagrammEND PROCmitphasendiagramm;BOOL PROCergebnisganzzahlig:modell.ganzzahligEND PROCergebnisganzzahlig;FILE PROCinformationstext(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARtexte:=sequentialfile(output,dateiname);holeinformationstext;texte.holeinformationstext:TEXT VARsatz:="";INT VARi;IFmodell.geschuetztTHENputline(texte," "+modellbezeichnung);putline(texte," "+(areaxsize(grossesrahmenfenster)-2)*waagerecht);FI;FORiFROM1UPTOmaxinfoWHILEtextdaten.info(i)<>endezeichenREPsatz:=textdaten.info(i);putline(texte,satz);PER;.END PROCinformationstext;TEXT PROCvariablenoberbegriff:modell.variablen.oberbegriff.END PROCvariablenoberbegriff;TEXT PROCvariablenoberbegriffkurzform:modell.variablen.oberbegriffkurzform.END PROCvariablenoberbegriffkurzform;TEXT PROCvariablenname(INT CONSTi):TEXT CONSTt:=(modell.variablen.namelang(i));t+(maxvarlaenge-LENGTH(t))*" ".END PROCvariablenname;TEXT PROCvariablenkurzform(INT CONSTi):modell.variablen.namekurz(i).END PROCvariablenkurzform;TEXT PROCcovariablenname(INT CONSTi):TEXT CONSTt:=modell.covariablen.namelang(i);t+(maxvarlaenge-LENGTH(t))*" ".END PROCcovariablenname;TEXT PROCcovariablenkurzform(INT CONSTi):modell.covariablen.namekurz(i).END PROCcovariablenkurzform;TEXT PROCparametername(INT CONSTi):modell.parameter.namelang(i).END PROCparametername;TEXT PROCparameterkurzform(INT CONSTi):modell.parameter.nameelan(i).END PROCparameterkurzform;TEXT PROCdarstellungsname:modell.darstellung.name.END PROCdarstellungsname;PARAMETER PROCvorgabeparameter:parameter(modell.demolauf.original.parameter).END PROCvorgabeparameter;REAL PROCvorgabeanfangszeitpunkt:modell.demolauf.original.anfangszeitpunkt.END PROCvorgabeanfangszeitpunkt;ZUSTAND PROCvorgabevergleichssystemzustand:zustand(modell.demolauf.vergleich.startwert).END PROCvorgabevergleichssystemzustand;PARAMETER PROCvorgabevergleichsparameter:parameter(
+modell.demolauf.vergleich.parameter).END PROCvorgabevergleichsparameter;ZUSTAND PROCzustandunteregrenze:zustand(modell.variablen.unteregrenze).END PROCzustandunteregrenze;ZUSTAND PROCzustandoberegrenze:zustand(modell.variablen.oberegrenze).END PROCzustandoberegrenze;PARAMETER PROCparameteroberegrenze:parameter(modell.parameter.oberegrenze).END PROCparameteroberegrenze;PARAMETER PROCparameterunteregrenze:parameter(modell.parameter.unteregrenze).END PROCparameterunteregrenze;ZUSTAND PROCrandoben:zustand(modell.variablen.randoben).END PROCrandoben;ZUSTAND PROCrandunten:zustand(modell.variablen.randunten).END PROCrandunten;REAL PROCminbeobachtungsdauer:modell.beschraenkung.minbeobachtungsdauer.END PROCminbeobachtungsdauer;REAL PROCmaxbeobachtungsdauer:modell.beschraenkung.maxbeobachtungsdauer.END PROCmaxbeobachtungsdauer;REAL PROCminanfangszeitpunkt:modell.beschraenkung.minanfangszeitpunkt.END PROCminanfangszeitpunkt;REAL PROCmaxanfangszeitpunkt:modell.beschraenkung.maxanfangszeitpunkt.END PROCmaxanfangszeitpunkt;INT PROCanzahlbeobachtungspunkte:modell.beschraenkung.anzahlbeobachtungspunkte.END PROCanzahlbeobachtungspunkte;BOOL PROCmitkombinationen:modell.kombinationen.mitkombinationen.END PROCmitkombinationen;PROClistekombinationen(ROWmaxdimensionTEXT VARnamen,INT VARanzahl):INT VARi;anzahl:=modell.kombinationen.anzahl;FORiFROM1UPTOanzahlREPnamen(i):=modell.kombinationen.paar(i).name;PER;END PROClistekombinationen;PROCindiceskombinationen(INT CONSTkombnr,INT VARxachse,yachse,BOOL VARvertauschbar):xachse:=modell.kombinationen.paar(kombnr).xindex;yachse:=modell.kombinationen.paar(kombnr).yindex;vertauschbar:=modell.kombinationen.paar(kombnr).automatisch;END PROCindiceskombinationen;ZUSTAND PROCvorgabesystemzustand:zustand(modell.demolauf.original.startwert).END PROCvorgabesystemzustand;REAL PROCvorgabebeobachtungsdauer:modell.demolauf.original.beobachtungsdauer.END PROCvorgabebeobachtungsdauer;TEXT PROCvorgabekurve:modell.demolauf.original.kurve.END PROCvorgabekurve;REAL PROCvorgabevergleichsanfangszeitpunkt:modell.demolauf.vergleich.anfangszeitpunkt.END PROCvorgabevergleichsanfangszeitpunkt;REAL PROCvorgabevergleichsbeobachtungsdauer:modell.demolauf.vergleich.beobachtungsdauer.END PROCvorgabevergleichsbeobachtungsdauer;TEXT PROCvorgabevergleichskurve:modell.demolauf.vergleich.kurve.END PROCvorgabevergleichskurve;ZUSTAND PROCdemomuster:zustand(modell.demolauf.variablenwahl).END PROCdemomuster;BOOL PROCdemoautomatik:modell.demolauf.automatisch.END PROCdemoautomatik;INT PROCdemoxindex:modell.demolauf.xindex.END PROCdemoxindex;INT PROCdemoyindex:modell.demolauf.yindex.END PROCdemoyindex;TEXT PROCgleichung(INT CONSTi):TEXT VARt:=textdaten.gleichungen(i);t.END PROCgleichung;TEXT PROCcogleichung(INT CONSTi):TEXT VARt:=textdaten.cogleichungen(i);t.END PROCcogleichung;TEXT PROCdarstellungszeile(INT CONSTi):TEXT VARt:=textdaten.darstellungscode(i);t.END PROCdarstellungszeile;PROCkopplean(MODELLDGL VARaktuellesmodell):modell:=aktuellesmodell;IFexists(modell.codeundinfo)THENtextdaten:=old(modell.codeundinfo);FI;END PROCkopplean;PROCgleichungsprozeduren(TEXT CONSTdateiname):forget(dateiname,quiet);FILE VARprog:=sequentialfile(output,dateiname);schreibegleichungsproz;schreibecogleichungsproz;schreibedarstellung4;.schreibegleichungsproz:putline(prog,"ZUSTAND PROC f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationen;gleichungen;ergebnis;putline(prog,"END PROC f;");.schreibecogleichungsproz:putline(prog,"ZUSTAND PROC co f (REAL CONST zeit, "+" ZUSTAND CONST alter zustand, "+" PARAMETER CONST alle parameter):");deklarationenvoncof;cogleichungen;cofergebnis;putline(prog,"END PROC co f;");.gleichungen:FORiFROM1UPTOmaxgleichungenWHILEgleichung(i)<>endezeichenREPputline(prog,gleichung(i));PER;.cogleichungen:INT VARi;FORiFROM1UPTOmaxgleichungenWHILEcogleichung(i)<>endezeichenREPputline(prog,cogleichung(i));PER;.deklarationen:putline(prog,"ZUSTAND VAR dvektorxyx"+
+" := neuer zustand (DSUB alter zustand);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFdimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOdimensionREPput(prog,praefix+elan(variablenkurzform(i)));IFi=dimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.ergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOdimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+praefix+elan(variablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.deklarationenvoncof:putline(prog,"ZUSTAND VAR dvektorxyx"+" := neuer zustand ( co dimension);");IFdimension>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOdimensionREPput(prog,elan(variablenkurzform(i))+" :: ");IFi=dimensionTHENputline(prog,"alter zustand SUB "+text(i)+" ;");ELSEputline(prog,"alter zustand SUB "+text(i)+" ,");FI;PER;FI;IFparameteranzahl>0THENputline(prog,"REAL CONST ");FORiFROM1UPTOparameteranzahlREPput(prog,elan(parameterkurzform(i))+" :: ");IFi=parameteranzahlTHENputline(prog,"alle parameter SUB "+text(i)+" ;");ELSEputline(prog,"alle parameter SUB "+text(i)+" ,");FI;PER;FI;IFcodimension>0THENput(prog,"REAL VAR ");FORiFROM1UPTOcodimensionREPput(prog,elan(covariablenkurzform(i)));IFi=codimensionTHENputline(prog,";")ELSEputline(prog,",")FI;PER;FI;.cofergebnis:putline(prog,"ergebnisxyx .");putline(prog,"ergebnisxyx : ");FORiFROM1UPTOcodimensionREPputline(prog,"replace (dvektorxyx ,"+text(i)+","+elan(covariablenkurzform(i))+" );");PER;putline(prog,"dvektorxyx.");.schreibedarstellung4:IFmitzusatzdarstellungTHENschreibedarstellungscodeELSEschreibeleerenprozedurkopfFI;.schreibeleerenprozedurkopf:putline(prog,darstellungskopf);putline(prog,darstellungsende);.schreibedarstellungscode:FORiFROM1UPTOmaxdarstellungszeilenWHILEdarstellungszeile(i)<>endezeichenREPputline(prog,darstellungszeile(i));PER;.END PROCgleichungsprozeduren;
+TEXT PROCelan(TEXT CONSTalt):INT VARi:=1;TEXT VARt:="";FORiFROM1UPTO(LENGTHalt)REP IF(tanderstellei>=97CANDtanderstellei<=122)COR(tanderstellei>216CANDtanderstellei<=219)COR(tanderstellei>=48CANDtanderstellei<=57)THENtCATsubtext(alt,i,i)ELIF(tanderstellei>=65CANDtanderstellei<=
+90)THENtCATcode(tanderstellei+32)ELIF(tanderstellei>=214CANDtanderstellei<=216)THENtCATcode(tanderstellei+3)ELSEtCAT" "FI PER;t.tanderstellei:code(subtext(alt,i,i))END PROCelan;
+;OP:=(MODELLDGL VARmod,MODELLDGL CONSTm):CONCR(mod.name):=CONCR(m.name);CONCR(mod.variablen):=CONCR(m.variablen);CONCR(mod.covariablen):=CONCR(m.covariablen);CONCR(mod.parameter):=CONCR(m.parameter);CONCR(mod.darstellung):=CONCR(m.darstellung);mod.mitphasendiagramm:=m.mitphasendiagramm;mod.ganzzahlig:=m.ganzzahlig;mod.kombinationen.mitkombinationen:=m.kombinationen.mitkombinationen;mod.kombinationen.anzahl:=m.kombinationen.anzahl;INT VARi;FORiFROM1UPTOmaxdimensionREP CONCR(mod.kombinationen.paar(i)):=CONCR(m.kombinationen.paar(i))PER;mod.codeundinfo:=m.codeundinfo;CONCR(mod.beschraenkung):=CONCR(m.beschraenkung);CONCR(mod.demolauf.original):=CONCR(m.demolauf.original);CONCR(mod.demolauf.vergleich):=CONCR(m.demolauf.vergleich);mod.demolauf.xindex:=m.demolauf.xindex;mod.demolauf.yindex:=m.demolauf.yindex;mod.demolauf.automatisch:=m.demolauf.automatisch;mod.demolauf.variablenwahl:=m.demolauf.variablenwahl;mod.modellzustand:=m.modellzustand;mod.geschuetzt:=m.geschuetztEND OP:=;PROCwarteaufesc:TEXT VAReingabe;REPeingabe:=incharetyUNTILeingabe=escPER.END PROCwarteaufesc;PROCtasteeinlesen(TEXT VAReinlesetaste):REPeinlesetaste:=incharetyUNTIL
+einlesetaste<>""PER END PROCtasteeinlesen;TEXT PROCkomprimiere(TEXT CONSTt):TEXT VARergebnis,z;INT VARi,l;suchevonvorne;suchevonhinten;ersetzekern;ergebnis.suchevonvorne:l:=LENGTHt;FORiFROM1UPTOlREPz:=(tSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi>lTHENergebnis:=""ELSEergebnis:=subtext(t,i,l);FI.suchevonhinten:l:=LENGTHergebnis;FORiFROMlDOWNTO1REPz:=(ergebnisSUBi)UNTIL NOT(z=" "CORz="_")PER;IFi<1THENergebnis:=""ELSEergebnis:=subtext(ergebnis,1,i);FI.ersetzekern:changeall(ergebnis,"_"," ").END PROCkomprimiere;BOOL PROCnichtuebersetzbar(TEXT CONSTtext):BOOL VARergebnis;disablestop;do(text);ergebnis:=iserror;IFiserrorTHENclearerrorFI;enablestop;ergebnisEND PROCnichtuebersetzbar;PROCsetzemodelltyp(BOOL CONSTwirkungsdiagramm):wd:=wirkungsdiagramm;END PROCsetzemodelltyp;BOOL PROCwirkungsdgr:wdEND PROCwirkungsdgr;END PACKETmodellbasis;
+
diff --git a/app/schulis-simulationssystem/3.0/src/modellwerte b/app/schulis-simulationssystem/3.0/src/modellwerte
new file mode 100644
index 0000000..931df75
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/modellwerte
@@ -0,0 +1,3 @@
+PACKETmodellwerteDEFINESwandle,modellwerteausgeben,delta,zahlen:LETheadvar=49,headpar=50,headzeit=51,headanfpkt=52,headbeob=53,headblanks="   ";LETintervallaenge=0.25;TEXT PROCwandle(REAL CONSTx,INT CONSTlaenge,frac):TEXT VARausgabe:="";INT VARi:=0;xgleichnull;xindezimaldarstellung;IFxzugrossTHENausgabe:=text(x,laenge);LEAVEwandleWITHausgabe;ELSE FORiFROMfrac+1UPTOlaenge-2REP IFxnichtzukleinTHENausgabe:=text(x,laenge,i);nullenstreichenmitverschieben(ausgabe);LEAVEwandleWITHausgabeFI;PER;ausgabe:=text(x,laenge);FI;ausgabe.xnichtzuklein:abs(x)>=10.0**(-i).xzugross:abs(x)>(10.0**(laenge-2))-10.0**(-1).ximnormalbereich:abs(x)<=(10.0**(laenge-frac+i-2))-10.0**(-frac+i-1)CANDabs(x)>=(10.0**(-frac+i)).xindezimaldarstellung:FORiFROM0UPTOfracREP IFximnormalbereichTHENausgabe:=text(x,laenge,frac-i);nullenstreichenohneverschieben(ausgabe);LEAVEwandleWITHausgabeFI;PER.xgleichnull:IFx=0.0THENausgabe:=text(0.0,laenge,frac);nullenstreichenohneverschieben(ausgabe);replace(ausgabe,laenge-frac+1,"0");LEAVEwandleWITHausgabe;FI.ENDPROCwandle;PROCnullenstreichenohneverschieben(TEXT VARausgabe):INT VARi;FORiFROMlength(ausgabe)DOWNTO1REP IFsubtext(ausgabe,i,i)="0"THENreplace(ausgabe,i," ")ELSE LEAVEnullenstreichenohneverschiebenFI;PER;ENDPROCnullenstreichenohneverschieben;PROCnullenstreichenmitverschieben(TEXT VARausgabe):INT VARi;FORiFROMlength(ausgabe)DOWNTO1REP IFsubtext(ausgabe,length(ausgabe),length(ausgabe))="0"THENausgabe:=" "+subtext(ausgabe,1,length(ausgabe)-1)ELSE LEAVEnullenstreichenmitverschiebenFI;PER;ENDPROCnullenstreichenmitverschieben;FILE PROCmodellwerteausgeben(LOESUNG CONSTloesung):LETdateiname=" modellwerte";ZUSTAND CONSTzustand:=STARTWERTloesung;PARAMETER CONSTparameter:=PARAMETERSATZloesung;REAL CONSTzeitpunkt:=STARTZEITloesung,beobachtungsdauer:=DAUERloesung;IFexists(dateiname)THENforget(dateiname,quiet)FI;FILE VARausgabe:=sequentialfile(output,dateiname);TEXT VARueberschrift,zahl;STRUCT(TEXTbezeichnung,REALmodellwert)VARzeile;INT VARi,laenge:=8,fracs:=2;IFdimension>0THENschreibevariablen;FI;IFparameteranzahl>0THENschreibeparameter;FI;schreibezeitangaben;ausgabe.schreibevariablen:ueberschrift:=headblanks+compress(meldungstext(headvar));putline(ausgabe,ueberschrift);FORiFROM1UPTOdimensionREPvariablenzeileausgebenPER.variablenzeileausgeben:zeile.bezeichnung:=(variablenname(i)+(30-(length(variablenname(i))))*" ");zeile.modellwert:=zustandSUBi;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).schreibeparameter:putline(ausgabe," ");ueberschrift:=headblanks+compress(meldungstext(headpar));putline(ausgabe,ueberschrift);FORiFROM1UPTOparameteranzahlREPparameterzeileausgebenPER.parameterzeileausgeben:zeile.bezeichnung:=(parametername(i)+(30-(length(parametername(i))))*" ");zeile.modellwert:=parameterSUBi;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).schreibezeitangaben:putline(ausgabe," ");ueberschrift:=headblanks+compress(meldungstext(headzeit));putline(ausgabe,ueberschrift);zeile.bezeichnung:=meldungstext(headanfpkt);zeile.bezeichnung:=zeile.bezeichnung+(30-length(zeile.bezeichnung))*" ";zeile.modellwert:=zeitpunkt;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl);zeile.bezeichnung:=meldungstext(headbeob);zeile.bezeichnung:=zeile.bezeichnung+(30-length(zeile.bezeichnung))*" ";zeile.modellwert:=beobachtungsdauer;zahl:=wandle(zeile.modellwert,laenge,fracs);putline(ausgabe,zeile.bezeichnung+zahl).ENDPROCmodellwerteausgeben;PROCzahlen(REAL CONSTmin,max,ROW3REAL VARschoenezahlen):REAL VARmi,ma,g1,g2,g3;bildenderteilintervalle;ermittelnschoenerzahlen.bildenderteilintervalle:g1:=(min+(max-min)*intervallaenge/2.0);g2:=(((max-min)*(intervallaenge/2.0)));g3:=(max-(max-min)*intervallaenge/2.0);.intervall1:mi:=min;ma:=g1.intervall2:mi:=((min+max)/2.0)-g2;ma:=((min+max)/2.0)+g2.intervall3:mi:=g3;ma:=max.ermittelnschoenerzahlen:intervall1;schoenezahlen(1):=schoenezahl(mi,ma);intervall2;schoenezahlen(2):=schoenezahl(mi,ma);intervall3;
+schoenezahlen(3):=schoenezahl(mi,ma).END PROCzahlen;REAL PROCschoenezahl(REAL CONSTminimum,maximum,):INT VARschalter:=0;REAL VARz,a;IFnullimintervallTHENa:=0.0ELSE IFminimum>=0.0THENmax:=maximum;min:=minimum;a:=positivesintervallELIFmaximum<=0.0THEN REAL VARmax:=ABSminimum;REAL VARmin:=ABSmaximum;schalter:=1;a:=positivesintervallELSEa:=0.0FI;FI;a.nullimintervall:0.0>=minimumAND0.0<=minimum.positivesintervall:exponentenermitteln;zahlermitteln.exponentenermitteln:INT VARi:=decimalexponent(max);.zahlermitteln:REAL VARd:=0.0,zplus5;REPd:=10.0**(i);z:=floor(max/d)*(d);zplus5:=z+5.0*10.0**(i-1);IFmin<=zANDz<=maxTHEN IFschalter=1THENz:=-zFI;LEAVEzahlermittelnWITHzELIFmin<=zplus5ANDzplus5<=maxTHENz:=zplus5;IFschalter=1THENz:=-zFI;LEAVEzahlermittelnWITHzELSEiDECR1FI PER;0.0.END PROCschoenezahl;LETcaschritte=5.0;REAL PROCdelta(REAL CONSTminimum,maximum):REAL VARlaenge:=(maximum-minimum)/caschritte;exponentenermitteln;zahlermitteln.exponentenermitteln:INT VARi:=decimalexponent(laenge);.zahlermitteln:REAL VARd,z,fuenfmald;d:=10.0**i;z:=floor(laenge/d)*d;fuenfmald:=5.0*d;IFfuenfmald<=laengeTHENfuenfmaldELSEzFI END PROCdelta;ENDPACKETmodellwerte;
+
diff --git a/app/schulis-simulationssystem/3.0/src/neue startschl b/app/schulis-simulationssystem/3.0/src/neue startschl
new file mode 100644
index 0000000..850f251
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/neue startschl
@@ -0,0 +1,3 @@
+PACKETstartinmanagergrafiktaskDEFINESmanagerschleife:INT CONSTeingabevomkanal:=-4,existiertnicht:=-1,nichtempfangsbereit:=-2;LETuebersetzungsfile="uebersetzungsdatei",kanalgeraetetask=1,modellbankverwaltung="MODELLBANKVERWALTUNG",menukarteinstallieren="installmenu(""ls-MENUKARTE:Simsel"",FALSE)",dglmodell=1,wdmodell=2,okcode=0,tasknamefuersohn="-",msgmodelldaten=2,msgoriginalkurve=3,msgvergleichskurve=4,msggleichungen=5,msgdglsimulation=6,msgwdinfotext=7,msgwdsimulation=9,wiederaufsetzen=10,aufruf="wahl der bearbeitung (PROC f , PROC co f, PROC darstellung 4) ;";TASK VARsohntask:=niltask;TEXT VARfehlertext:="";PROCmanagerschleife:DATASPACE VARtransportds;INT VARmesscode,retcode;INT VARinfoint:=0;TASK VARauftraggeber,kontrolltask:=/modellbankverwaltung;disablestop;break(quiet);REPkernvonmanagerschleifePER.kernvonmanagerschleife:retcode:=0;wait(transportds,messcode,auftraggeber);IFauftraggeber=kontrolltaskTHEN IFmesscode=msgmodelldatenTHENrichtesohneinundsendemodelldaten;ELIFmesscode=msgoriginalkurveTHENsendeaktuellenmesscode;ELIFmesscode=msgvergleichskurveTHENsendeaktuellenmesscode;ELIFmesscode=msggleichungenTHENsendeaktuellenmesscode;ELIFmesscode=msgdglsimulationTHENstartedglsimulationinsohntask;ELIFmesscode=msgwdinfotextTHENsendeaktuellenmesscode;ELIFmesscode=msgwdsimulationTHENstartewdsimulationinsohntask;FI;transportds:=nilspace;auftraggeber:=kontrolltask;infoint:=0;send(auftraggeber,retcode,transportds,infoint);forget(transportds);FI;fehlerbehandlung.fehlerbehandlung:IFiserrorTHENclearerrorFI.richtesohneinundsendemodelldaten:IFexists(son(myself))THENend(son(myself));FI;begin(tasknamefuersohn,PROCstartprocfuersimulationstask,sohntask);REP UNTILexists(sohntask)CANDstatus(sohntask)=2PER;schickeansohntask(transportds,messcode,retcode);.sendeaktuellenmesscode:schickeansohntask(transportds,messcode,retcode);.startedglsimulationinsohntask:schickeansohntask(transportds,messcode,retcode);end(son(myself));.startewdsimulationinsohntask:schickeansohntask(transportds,messcode,retcode);end(son(myself));.END PROCmanagerschleife;PROCschickeansohntask(DATASPACE VARdatenraum,INT CONSTverarbeitung,INT VARret):TASK VARzieltask:=sohntask,kontrolltask:=sohntask;ret:=okcode;REP REP UNTILstatus(zieltask)=2PER;zieltask:=sohntask;send(zieltask,verarbeitung,datenraum,ret);forget(datenraum);IFret<>existiertnichtCANDret<>nichtempfangsbereitTHENzieltask:=kontrolltask;wait(datenraum,ret,zieltask);forget(datenraum);FI;LEAVEschickeansohntask;PER;END PROCschickeansohntask;PROCstartprocfuersimulationstask:disablestop;bearbeiteauftrag;IFiserrorTHENclearerror;DATASPACE VARtransporter:=nilspace;INT VARnachricht:=wiederaufsetzen,return:=0;TASK VARdestinationtask:=father;REP UNTILstatus(destinationtask)=2PER;send(destinationtask,nachricht,transporter,return);FI;.END PROCstartprocfuersimulationstask;PROCbearbeiteauftrag:FILE VARfx;BOUND TEXT VARtx;DATASPACE VARtransportdatenraum;INT VARmsgtype;TASK VARsourcetask:=father,destinationtask:=father;enablestop;REPwait(transportdatenraum,msgtype,sourcetask);verarbeitebotschaft;UNTILinstallationfertigPER;.installationfertig:msgtype=msgdglsimulationORmsgtype=msgwdsimulation.verarbeitebotschaft:IFsourcetask=fatherTHEN IFmsgtype=msgmodelldatenTHENkopieremodelldaten;ELIFmsgtype=msgoriginalkurveTHENkopiereoriginalkurve;ELIFmsgtype=msgvergleichskurveTHENkopierevergleichskurve;ELIFmsgtype=msggleichungenTHENkopieregleichungen;ELIFmsgtype=msgdglsimulationTHENstartedglsimulation;ELIFmsgtype=msgwdinfotextTHENkopiereinfotextwd;ELIFmsgtype=msgwdsimulationTHENstartewdsimulation;ELIFmsgtype=eingabevomkanalTHEN REP UNTILincharety=""PER;forget(transportdatenraum);LEAVEverarbeitebotschaftELSEforget(transportdatenraum);LEAVEverarbeitebotschaftFI;ELSE IFmsgtype=eingabevomkanalTHEN REP UNTILincharety=""PER;FI;forget(transportdatenraum);LEAVEverarbeitebotschaftFI;sendeantwort;.kopieremodelldaten:BOUND MODELLDGL VARmodelltransporter;MODELLDGL VARaktuellesmodell;texteankoppeln;modelltransporter:=transportdatenraum;aktuellesmodell:=
+modelltransporter;kopplean(aktuellesmodell);.kopiereoriginalkurve:forget(vorgabekurve,quiet);copy(transportdatenraum,vorgabekurve);.kopierevergleichskurve:forget(vorgabevergleichskurve,quiet);copy(transportdatenraum,vorgabevergleichskurve);.kopieregleichungen:forget(modelldatenraum,quiet);copy(transportdatenraum,modelldatenraum);kopplean(aktuellesmodell);.kopiereinfotextwd:uebergebeinfotextfuerwd(transportdatenraum);.startedglsimulation:startesimulation(dglmodell,transportdatenraum);forget(vorgabekurve,quiet);forget(vorgabevergleichskurve,quiet);forget(modelldatenraum,quiet);.startewdsimulation:startesimulation(wdmodell,transportdatenraum);.sendeantwort:transportdatenraum:=nilspace;msgtype:=okcode;destinationtask:=father;REP UNTILstatus(destinationtask)=2PER;send(destinationtask,msgtype,transportdatenraum).END PROCbearbeiteauftrag;PROCstartesimulation(INT CONSTmodelltyp,DATASPACE VARwddsfertigegleichungen):FILE VARrundatei;enablestop;continue(kanalgeraetetask);setzemodelltyp(modelltyp=wdmodell);forget(uebersetzungsfile,quiet);IFmodelltyp=dglmodellTHENgleichungsprozeduren(uebersetzungsfile)ELIFmodelltyp=wdmodellTHENcopy(wddsfertigegleichungen,uebersetzungsfile)FI;rundatei:=sequentialfile(output,uebersetzungsfile);putline(rundatei,"continue ( "+text(kanalgeraetetask)+");");putline(rundatei,aufruf);do(menukarteinstallieren);break(quiet);uebersetze;break(quiet);.uebersetze:run(uebersetzungsfile);forget(uebersetzungsfile,quiet);.END PROCstartesimulation;END PACKETstartinmanagergrafiktask;
+
diff --git a/app/schulis-simulationssystem/3.0/src/o b/app/schulis-simulationssystem/3.0/src/o
new file mode 100644
index 0000000..b5ca640
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/o
@@ -0,0 +1,2 @@
+PACKETobjektDEFINES OBJEKT,variable,ergebnis,parameter,formel,zeit,nil,:=,=,typ,typbezeichner,typkennzeichen,new,name,variablenname,ergaenzungsvariablenname,parametername,formelname,langname,kurzname,ausdruck,elanname:LETtypbezeichnervariable=511,typbezeichnerergebnis=512,typbezeichnerparameter=513,typbezeichnerformel=514,typbezeichnerzeit=515;LETelannamederzeit="zeit";TYPE TYP=INT;TYPE OBJEKT=STRUCT(TYPtyp,TEXTlangname,kurzname,elanname);TYP CONSTnil:=0,variable:=1,ergebnis:=2,parameter:=3,formel:=4,zeit:=5;OP:=(TYP VARt,INT CONSTi):CONCR(t):=iENDOP:=;OP:=(TYP VARl,TYP CONSTr):CONCR(l):=CONCR(r)ENDOP:=;BOOL OP=(TYP CONSTl,TYP CONSTr):CONCR(l)=CONCR(r)ENDOP=;TEXT PROCtypbezeichner(OBJEKT CONSTobj):TYP VARobjekttyp:=obj.typ;IFobjekttyp=variableTHENanwendungstext(typbezeichnervariable)ELIFobjekttyp=ergebnisTHENanwendungstext(typbezeichnerergebnis)ELIFobjekttyp=parameterTHENanwendungstext(typbezeichnerparameter)ELIFobjekttyp=formelTHENanwendungstext(typbezeichnerformel)ELIFobjekttyp=zeitTHENanwendungstext(typbezeichnerzeit)ELSE""FI END PROCtypbezeichner;TEXT PROCtypkennzeichen(OBJEKT CONSTobj):TYP VARobjekttyp:=obj.typ;IFobjekttyp=variableTHEN"v"ELIFobjekttyp=ergebnisTHEN"e"ELIFobjekttyp=parameterTHEN"p"ELIFobjekttyp=formelTHEN"f"ELIFobjekttyp=zeitTHEN"z"ELSEwaagerechtFI END PROCtypkennzeichen;OBJEKT PROCnew(TYP CONSTtyp):OBJEKT VARo;IFtyp=zeitTHENnewtimeELSE CONCR(o.typ):=CONCR(typ);o.langname:="";o.kurzname:="";o.elanname:="";oFI END PROCnew;OBJEKT PROCnewtime:OBJEKT VARo;CONCR(o.typ):=CONCR(zeit);o.langname:=anwendungstext(typbezeichnerzeit);o.kurzname:=o.langname;o.elanname:=elannamederzeit;oEND PROCnewtime;OP:=(OBJEKT VARl,OBJEKT CONSTr):CONCR(l):=CONCR(r);END OP:=;TEXT PROCname(OBJEKT CONSTo):o.langnameEND PROCname;TYP PROCtyp(OBJEKT CONSTo):o.typEND PROCtyp;TEXT PROClangname(OBJEKT CONSTo):o.langnameEND PROClangname;TEXT PROCkurzname(OBJEKT CONSTo):o.kurznameEND PROCkurzname;TEXT PROCausdruck(OBJEKT CONSTo):o.kurznameEND PROCausdruck;TEXT PROCelanname(OBJEKT CONSTo):o.elannameEND PROCelanname;PROCname(OBJEKT VARo,TEXT CONSTt):o.langname:=tEND PROCname;PROCvariablenname(OBJEKT VARo,TEXT CONSTl,k,e):IFo.typ=variableTHENo.langname:=l;o.kurzname:=k;o.elanname:=eFI END PROCvariablenname;PROCergaenzungsvariablenname(OBJEKT VARo,TEXT CONSTl,k,e):IFo.typ=ergebnisTHENo.langname:=l;o.kurzname:=k;o.elanname:=eFI END PROCergaenzungsvariablenname;PROCparametername(OBJEKT VARo,TEXT CONSTl,e):IFo.typ=parameterTHENo.langname:=l;o.elanname:=eFI END PROCparametername;PROCformelname(OBJEKT VARo,TEXT CONSTl,e,a):IFo.typ=formelTHENo.langname:=l;o.elanname:=e;o.kurzname:=aFI END PROCformelname;END PACKETobjekt;
+
diff --git a/app/schulis-simulationssystem/3.0/src/op1 b/app/schulis-simulationssystem/3.0/src/op1
new file mode 100644
index 0000000..1874496
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/op1
@@ -0,0 +1,4 @@
+PACKETobjektrepraesentation1DEFINESbewegecursorauflinkpositionen,zeichneverbindung,gibinformation,box,boxohnerahmen,objekttext:LETmaxlink=8;LETrechts=1,links=2,oben=3,unten=4,stern="*",blank=" ",maxlength=9,plus=" + ",differentialzeichen="d ",rand="    ",zuweisung=" = ";WINDOW VARfenster:=standardfenster;PROCboxaufbs(OBJEKT CONSTobj,INT CONSTi,j,BOOL CONSTbelegt):IFbelegtTHENschreibevolleboxaufbs;ELSEschreibeleereboxaufbs;FI.schreibevolleboxaufbs:newout(fenster,i,j,eckeobenlinks+typkennzeichen(obj)+((maxlength-1)*waagerecht)+eckeobenrechts);newout(fenster,i,j+1,senkrecht+objektname(obj)+senkrecht);newout(fenster,i,j+2,eckeuntenlinks+(maxlength*waagerecht)+eckeuntenrechts);.schreibeleereboxaufbs:TEXT CONSTleer:=(maxlength+2)*blank;newout(fenster,i,j,leer);newout(fenster,i,j+1,leer);newout(fenster,i,j+2,leer).END PROCboxaufbs;PROCbox(INT CONSTi,j):CELL CONSTc:=cell(i,j);box(objekt(c),gpos(mpos(c)),belegt(c))END PROCbox;PROCbox(OBJEKT CONSTobj,GPOS CONSTgitterpos,BOOL CONSTstatus):IFimgitter(gitterpos)THENboxaufbs(obj,iwindowpos(gitterpos),jwindowpos(gitterpos),status)FI END PROCbox;TEXT PROCobjektname(OBJEKT CONSTobj):blank+text(name(obj),maxlength-2)+ggfstern.ggfstern:IFlength(name(obj))>(maxlength-2)THENsternELSEblankFI.END PROCobjektname;PROCboxohnerahmen(OBJEKT CONSTobj,GPOS CONSTgitterpos):IFimgitter(gitterpos)THENboxohnerahmenaufbs(obj,iwindowpos(gitterpos),jwindowpos(gitterpos))FI END PROCboxohnerahmen;PROCboxohnerahmenaufbs(OBJEKT CONSTobj,INT CONSTi,j):newout(fenster,i+1,j+1,objektname(obj))END PROCboxohnerahmenaufbs;PROCnewout(TEXT CONSTt):INT VARi,j;getcursor(fenster,i,j);newout(fenster,i,j,t)END PROCnewout;PROClineout(TEXT CONSTt):INT VARi,j;getcursor(fenster,i,j);lineout(fenster,i,j,t)END PROClineout;INT PROCbewegecursorauflinkpositionen(GPOS CONSTgp,TEXT CONSTzulaessigepositionen):bewegebscursorauflinkpositionen(i,j,zulaessigepositionen).i:iwindowpos(gp).j:jwindowpos(gp).END PROCbewegecursorauflinkpositionen;INT PROCbewegebscursorauflinkpositionen(INT CONSTi,j,TEXT CONSTzulaessigepositionen):LETesc="�",return="
";TEXT CONSTcursorbewegungen:="��";INT VARergebnis:=1;startpositioneinnehmen;REPlesetaste;bewegeggfcursorUNTILabbruchgewuenschtPER;behandleabbruch.startpositioneinnehmen:setzelinkposition(position,i,j).position:int(zulaessigepositionenSUBergebnis).lesetaste:TEXT VARtaste;inchar(taste).bewegeggfcursor:SELECTpos(cursorbewegungen,taste)OF CASE1:rechtsCASE2:linksEND SELECT.rechts:IFergebnis=length(zulaessigepositionen)THENergebnis:=1ELSEergebnisINCR1FI;setzelinkposition(position,i,j).links:IFergebnis=1THENergebnis:=length(zulaessigepositionen)ELSEergebnisDECR1FI;setzelinkposition(position,i,j).abbruchgewuenscht:taste=escORtaste=return.behandleabbruch:IFtaste=escTHEN0ELSEpositionFI.END PROCbewegebscursorauflinkpositionen;PROCsetzelinkposition(INT CONSTergebnis,i,j):SELECTergebnisOF CASE1,2,3:cursor(fenster,i+2*ergebnis+1,j)CASE4:cursor(fenster,i+maxlength+1,j+1)CASE5,6,7:cursor(fenster,i+2*(maxlink-ergebnis)+1,j+2)CASE8:cursor(fenster,i,j+1)ENDSELECT END PROCsetzelinkposition;PROCsetzelinkposition(INT CONSTergebnis,GPOS CONSTgp):setzelinkposition(ergebnis,i,j).i:iwindowpos(gp).j:jwindowpos(gp).END PROCsetzelinkposition;PROCsetzestartposition(INT CONSTergebnis,INT VARi,j):SELECTergebnisOF CASE1,2,3:i:=i+2*ergebnis+1;jDECR1CASE4:i:=i+maxlength+2;jINCR1CASE5,6,7:i:=i+2*(maxlink-ergebnis)+1;jINCR3CASE8:iDECR1;jINCR1ENDSELECT END PROCsetzestartposition;PROCzeichneverbindung(MPOS CONSTvon,INT CONSTvonnr,MPOS CONSTbis,INT CONSTbisnr):INT VARvi,vj,bi,bj,ai,aj,alterichtung,neuerichtung;GPOS VARgvon,gbis;IF NOT(imgitter(von)ORimgitter(bis))THEN LEAVEzeichneverbindungFI;bestimmeviundvj;bestimmebiundbj;gehevonspalteviinzeilevjnachzeilebj;gehenachspaltebi;IFimgitter(bis)THENschreibeendsymbolFI.bestimmeviundvj:IFimgitter(von)THENgvon:=gpos(von);vi:=iwindowpos(gvon);vj:=jwindowpos(gvon);setzelinkposition(vonnr,gvon);schreibestartsymbol;setzestartposition(vonnr,vi,vj);IF NOTimgitter(bis)THENbi:=randwertfuerbi;bj:=randwertfuerbj
+FI;FI.bestimmebiundbj:IFimgitter(bis)THENgbis:=gpos(bis);bi:=iwindowpos(gbis);bj:=jwindowpos(gbis);setzestartposition(bisnr,bi,bj);IF NOTimgitter(von)THENvi:=randwertfuervi;vj:=randwertfuervjFI;FI.randwertfuerbi:IFimpos(bis)=impos(von)THENviELIFimpos(bis)<impos(gitterstart)THEN1ELIFimpos(bis)<=impos(gitterstart)+igittersize-1THENiwindowpos(gpos(newmpos(impos(bis),jmpos(von))))ELSEareaxsize(standardfenster)FI.randwertfuerbj:IFjmpos(bis)=jmpos(von)THENvjELIFjmpos(bis)<jmpos(gitterstart)THEN1ELIFjmpos(bis)<=jmpos(gitterstart)+jgittersize-1THENjwindowpos(gpos(newmpos(impos(von),jmpos(bis))))ELSEareaysize(standardfenster)FI.randwertfuervi:IFimpos(von)=impos(bis)THENbiELIFimpos(von)<impos(gitterstart)THEN1ELIFimpos(von)<=impos(gitterstart)+igittersize-1THENiwindowpos(gpos(newmpos(impos(von),jmpos(bis))))ELSEareaxsize(standardfenster)FI.randwertfuervj:IFjmpos(bis)=jmpos(von)THENbjELIFjmpos(von)<jmpos(gitterstart)THEN1ELIFjmpos(von)<=jmpos(gitterstart)+jgittersize-1THENjwindowpos(gpos(newmpos(impos(bis),jmpos(von))))ELSEareaysize(standardfenster)FI.gehevonspalteviinzeilevjnachzeilebj:ai:=vi;aj:=vj;neuerichtung:=anfangsrichtung;IFsuedostTHENgehetendenziellnachsuedostELIFsuedwestTHENgehetendenziellnachsuedwestELIFnordostTHENgehetendenziellnachnordostELSEgehetendenziellnachnordwestFI.suedost:aj<bjANDai<bi.suedwest:aj<bjANDai>=bi.nordost:aj>=bjANDai<bi.gehetendenziellnachsuedost:WHILE(aj<bj)OR(NOTzeilefrei)REP IFuntenplatzTHENgeheevtlnachuntenELIFrechtsplatzTHENnachrechts(alterichtung,neuerichtung,ai,aj)FI PER.gehetendenziellnachsuedwest:WHILE(aj<bj)OR(NOTzeilefrei)REP IFuntenplatzTHENgeheevtlnachuntenELIFlinksplatzTHENnachlinks(alterichtung,neuerichtung,ai,aj)FI PER.gehetendenziellnachnordost:WHILE(aj>bj)OR(NOTzeilefrei)REP IFobenplatzTHENgeheevtlnachobenELIFrechtsplatzTHENnachrechts(alterichtung,neuerichtung,ai,aj)FI PER.gehetendenziellnachnordwest:WHILE(aj>bj)OR(NOTzeilefrei)REP IFobenplatzTHENgeheevtlnachobenELIFlinksplatzTHENnachlinks(alterichtung,neuerichtung,ai,aj)FI PER.gehenachspaltebi:IFai<biTHEN WHILE NOT(ai=bi)REPnachrechts(alterichtung,neuerichtung,ai,aj)PER ELIFai>biTHEN WHILE NOT(ai=bi)REPnachlinks(alterichtung,neuerichtung,ai,aj)PER FI;IFaj<bjTHEN WHILE NOT(aj=bj)REPnachunten(alterichtung,neuerichtung,ai,aj)PER ELIFaj>bjTHEN WHILE NOT(aj=bj)REPnachoben(alterichtung,neuerichtung,ai,aj)PER FI.geheevtlnachunten:IFobjektenichtingleichergitterspalteANDletzterichtunglinksoderrechtsANDstartpunktuntenoderobenanderboxTHENfuehreeinenschrittindieletzterichtungausFI;nachunten(alterichtung,neuerichtung,ai,aj).objektenichtingleichergitterspalte:igpos(gvon)<>igpos(gbis).letzterichtunglinksoderrechts:neuerichtung=rechtsORneuerichtung=links.startpunktuntenoderobenanderbox:vonnr<4OR(vonnr>4ANDvonnr<8).geheevtlnachoben:IFobjektenichtingleichergitterspalteANDletzterichtunglinksoderrechtsANDstartpunktuntenoderobenanderboxTHENfuehreeinenschrittindieletzterichtungausFI;nachoben(alterichtung,neuerichtung,ai,aj).fuehreeinenschrittindieletzterichtungaus:IFneuerichtung=rechtsTHENnachrechts(alterichtung,neuerichtung,ai,aj)ELSEnachlinks(alterichtung,neuerichtung,ai,aj)FI.zeilefrei:INT VARax:=areax(fenster);zwischenraumohnebox(areay(fenster)+aj-1,min(ax+ai-1,ax+bi-1),max(ax+ai-1,ax+bi-1)).anfangsrichtung:SELECTvonnrOF CASE1,2,3:lineout(fenster,ai,aj,senkrecht);obenCASE4:lineout(fenster,ai,aj,waagerecht);rechtsCASE5,6,7:lineout(fenster,ai,aj,senkrecht);untenCASE8:lineout(fenster,ai,aj,waagerecht);linksOTHERWISE0END SELECT.obenplatz:NOTinbox(ai,aj-1).untenplatz:NOTinbox(ai,aj+1).rechtsplatz:NOTinbox(ai+1,aj).linksplatz:NOTinbox(ai-1,aj).schreibestartsymbol:lineout(startsymbol).startsymbol:SELECTvonnrOF CASE1,2,3:"^"CASE4:">"CASE5,6,7:"v"CASE8:"<"OTHERWISE""END SELECT.schreibeendsymbol:TEXT VARendsymbol:=pfeil;setzelinkposition(bisnr,gbis);lineout(endsymbol).pfeil:SELECTbisnrOF CASE1,2,3:lineout(fenster,bi,bj,ecksymbol(neuerichtung,unten));"v"CASE4:lineout(fenster,bi,bj,ecksymbol(neuerichtung,links));"<"CASE5,6,7:lineout(fenster,bi,bj,ecksymbol(
+neuerichtung,oben));"^"CASE8:lineout(fenster,bi,bj,ecksymbol(neuerichtung,rechts));">"OTHERWISE""END SELECT.END PROCzeichneverbindung;PROCnachrechts(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=rechts;richtungswechsel(alterichtung,neuerichtung,ai,aj);aiINCR1;lineout(fenster,ai,aj,waagerecht)END PROCnachrechts;PROCnachlinks(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=links;richtungswechsel(alterichtung,neuerichtung,ai,aj);aiDECR1;lineout(fenster,ai,aj,waagerecht)END PROCnachlinks;PROCnachoben(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=oben;richtungswechsel(alterichtung,neuerichtung,ai,aj);ajDECR1;lineout(fenster,ai,aj,senkrecht)END PROCnachoben;PROCnachunten(INT VARalterichtung,neuerichtung,ai,aj):alterichtung:=neuerichtung;neuerichtung:=unten;richtungswechsel(alterichtung,neuerichtung,ai,aj);ajINCR1;lineout(fenster,ai,aj,senkrecht)END PROCnachunten;PROCrichtungswechsel(INT CONSTalterichtung,neuerichtung,ai,aj):IFalterichtung<>neuerichtungTHEN TEXT VARecke:=ecksymbol(alterichtung,neuerichtung);IFecke<>""THENlineout(fenster,ai,aj,ecke)FI FI END PROCrichtungswechsel;TEXT PROCecksymbol(INT CONSTalt,neu):SELECTaltOF CASEunten:altuntenCASEoben:altobenCASErechts:altrechtsCASElinks:altlinksOTHERWISE""END SELECT.altunten:SELECTneuOF CASErechts:eckeuntenlinksCASElinks:eckeuntenrechtsOTHERWISE""END SELECT.altrechts:SELECTneuOF CASEunten:eckeobenrechtsCASEoben:eckeuntenrechtsOTHERWISE""END SELECT.altoben:SELECTneuOF CASErechts:eckeobenlinksCASElinks:eckeobenrechtsOTHERWISE""END SELECT.altlinks:SELECTneuOF CASEunten:eckeobenlinksCASEoben:eckeuntenlinksOTHERWISE""END SELECT.END PROCecksymbol;BOOL PROCinbox(INT CONSTi,j):inboxspeicher(areay(fenster)+j-1,areax(fenster)+i-1)<>blankEND PROCinbox;PROCgibinformation(INT CONSTnr):IFnr>0THEN WINDOW VARw:=window(1,2,79,23);boxinfo(w,anwendungstext(nr))FI END PROCgibinformation;PROCobjekttext(FILE VARf,MPOS CONSTmp):IFtyp(objekt(mp))=variableTHENstelledifferentialquotientenzusammenELIFtyp(objekt(mp))=ergebnisTHENstellesummezusammenELIFtyp(objekt(mp))=parameterTHENzeigenamenELIFtyp(objekt(mp))=formelTHENinformiereueberarithmetischenausdruckFI.zeigenamen:putline(f,rand+elanname(objekt(mp)));line(f).stelledifferentialquotientenzusammen:stellelinkeseitederdglzusammen;schreibenenner;schreibebruchstrichundrechteseite;schreibezaehler;line(f).stellesummezusammen:putline(f,rand+elanname(objekt(mp))+zuweisung+summederankommendenpfeile);line(f).stellelinkeseitederdglzusammen:TEXT VARnenner:=differentialzeichen+elanname(objekt(mp)),zaehler:=differentialzeichen+elanname(new(zeit)),strich:=max(LENGTHnenner,LENGTHzaehler)*"-".schreibenenner:putline(f,rand+(abs((LENGTHstrich)-(LENGTHnenner))DIV2)*blank+nenner).schreibebruchstrichundrechteseite:putline(f,rand+strich+zuweisung+summederankommendenpfeile).schreibezaehler:putline(f,rand+(abs((LENGTHstrich)-(LENGTHzaehler))DIV2)*blank+zaehler).summederankommendenpfeile:IFkeineverbindungvonanderenobjektenaufgebautTHEN"0.0"ELSE TEXT VARterm:="";FORiFROM1UPTOmaxlinkREPnotiereeinquellobjektPER;subtext(term,1,(LENGTHterm)-(LENGTHplus))FI.notiereeinquellobjekt:IFcEINGANGiTHENtermCATnamederquelle;termCATplusFI.namederquelle:elanname(objekt(quelle)).quelle:quellenposition.quellenposition:cUEBERi.keineverbindungvonanderenobjektenaufgebaut:INT VARi,z:=0;FORiFROM1UPTOmaxlinkREP IFcEINGANGiTHENzINCR1FI PER;z=0.c:cell(mp).informiereueberarithmetischenausdruck:putline(f,rand+elanname(objekt(mp))+zuweisung+ausdruck(objekt(mp)));line(f).END PROCobjekttext;END PACKETobjektrepraesentation1;
+
diff --git a/app/schulis-simulationssystem/3.0/src/op2 b/app/schulis-simulationssystem/3.0/src/op2
new file mode 100644
index 0000000..861939f
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/op2
@@ -0,0 +1,11 @@
+PACKETobjektrepraesentation2DEFINESvariableeditieren,parametereditieren,formeleditieren,termistkorrekt,listeallerbezeichner,boxvorhanden:LETzeitnichtalsvariable=520,leerebezeichnerlisteteil1=532,leerebezeichnerlisteteil2=533,leerebezeichnerlisteteil3=534,nurdieseelannamen=551,quithinweis=519,singularmodellgroesse=511,singularergebnis=512,singularparameter=513,singularformel=514,pluralformel=538,listedernamen=536,nochkeinenamenvergeben=537,tabellenkopf1=543,tabellenkopf2=550,tabellenkopf3=545,tabellenrumpf=546,tabellenfuss=547,hinweisleerername=523,hinweissyntaxfehler=524,hinweisdoppeltername=525,hinweislangername=526,hinweisformalerfehler=527,standardhinweis=528,hinweisfalscheranfang=529,ueberschriftfuervariable=530,ueberschriftfuerergaenzungsvariable=531,hinweisleererausdruck=539;LETlang=3,elan=4,kurz=5,aus=5,maxi=20,maxj=10,maxlink=8,maxlaengefuerdo=2000,hoch="�",runter="
+",return="
",blank=" ",underscore="_",stern="*",info="?",pruefen="p",halt="v",zurueck="z",vtag=9,ptag=10,ftag=11,laengefuerformeln=300,laengefuernamen=30,laengefuerkurznamen=7,realvar="REAL VAR ",tag=1,delimiter=6;ROW100TEXT VARfeld;INT VARi;FORiFROM1UPTO100REPfeld(i):=""PER;ROWmaxlinkTEXT VARname;TEXT VARtaste;INT VARfeldnummer;BOOL VARboxaufgebaut:=FALSE;BOOL PROCboxvorhanden:boxaufgebautEND PROCboxvorhanden;PROCvariableeditieren(CELL CONSTactualcell,BOOL VARgespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="",zwischenspeicherk:="";taste:="";boxaufgebaut:=FALSE;BOOL VARlangnameok,elannameok,kurznameok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,8);TAG VARvariablentag:=formular(vtag);show(variablentag);outframe(eingabefenster);feld(2):=anwendungstext(ueberschrift);put(variablentag,feld(2),2);zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.ueberschrift:IFtyp(aktuellesobjekt)=variableTHENueberschriftfuervariableELSEueberschriftfuerergaenzungsvariableFI.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang),zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerkurznamen,feld(kurz),zwischenspeicherk,laengefuerkurznamen);langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);kurznameok:=(length(kurzname(aktuellesobjekt))>0);BOOL VARersteeingabefuerkurznamen:=TRUE,ersteeingabefuerelannamen:=TRUE;put(variablentag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).vorschlagoderletzteeingabefuerkurznamen:kurzname(aktuellesobjekt).setzecursoraufersteseingabefeld:feldnummer:=lang;get(variablentag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=pruefenANDpruefenunsinnigTHENmeldeleerenausdruck(fehlercode)FI;wechslezwischendeneingabefeldernPER.pruefenunsinnig:NOTboxaufgebautANDfeld(lang)="".wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameCASEkurz:pruefekurznameEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamenundkurznamen;putget(variablentag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis));FI.gibggfvorgabefuerelannamenundkurznamen:IFkurznamebisherleerTHENersteeingabefuerkurznamen:=FALSE;belegefeld(letzteeingabefuerlangnamen,feld(kurz),zwischenspeicherk,laengefuerkurznamen);ELIFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI.
+kurznamebisherleer:ersteeingabefuerkurznamenAND(NOTkurznameok)ANDfeldnummer=kurz.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamegleichzeitTHENmeldezeitunzulaessig(fehlercode,fehlermeldung)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))ORlangnamegleichzeitOR((zwischenspeicherl=feld(lang))AND NOTlangnameok).langnamegleichzeit:TEXT VARx:=zwischenspeicher;changeall(x," ","");(((xSUB1)="z")COR((xSUB1)="Z"))CAND(((xSUB2)="e")COR((xSUB2)="E"))CAND(((xSUB3)="i")COR((xSUB3)="I"))CAND(((xSUB4)="t")COR((xSUB4)="T"))AND(length(x)=4).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).pruefekurzname:IFkurznamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(kurz));kurznameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFkurznamezulangTHENmeldezulangennamen(fehlercode)ELIFkurznamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSEzwischenspeicherk:=feld(kurz);kurznameok:=TRUE;vsetzeneuenfeldindexFI ELSEvsetzeneuenfeldindexFI.kurznamemussgeprueftwerden:(zwischenspeicherk<>feld(kurz))OR((zwischenspeicherk=feld(kurz))AND NOTkurznameok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:langnameokANDelannameokANDkurznameok.schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;IFtyp(aktuellesobjekt)=variableTHENvariablenname(aktuellesobjekt,bereinigt(zwischenspeicherl),bereinigt(zwischenspeicherk),zwischenspeichere);ELSEergaenzungsvariablenname(aktuellesobjekt,bereinigt(zwischenspeicherl),bereinigt(zwischenspeicherk),zwischenspeichere);FI;gespeichert:=TRUE;aktuellesobjektWRITEmp.nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).kurznamenichteindeutig:NOTkurznameeindeutig(zwischenspeicher,mpos(actualcell)).langnamezulang:length(zwischenspeicher)>laengefuernamen.kurznamezulang:length(zwischenspeicher)>laengefuerkurznamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);raeumeeditierhilfeweg.END PROCvariableeditieren;PROCvsetzeneuenfeldindex:IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldnummer<langTHENfeldnummer:=kurzELIFfeldnummer>kurzTHENfeldnummer:=langFI END PROCvsetzeneuenfeldindex;PROCformeleditieren(CELL CONSTactualcell,BOOL VAR
+gespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="",zwischenspeicherf:="";taste:="";BOOL VARlangnameok,elannameok,formelok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,8);TAG VARformeltag:=formular(ftag);show(formeltag);outframe(eingabefenster);zulaessigebezeichnerzeigen;zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.zulaessigebezeichnerzeigen:INT VARi,k:=0,j:=0;TEXT VARzw:="";WINDOW VARbezeichnerfenster:=window(40,3,36,8);outframe(bezeichnerfenster);page(bezeichnerfenster);FORiFROM1UPTOmaxlinkREP IF(actualcellEINGANGi)THENzw:=compress(elanname(objekt(actualcellUEBERi)));name(i):=zw;changeall(name(i)," ","");IFname(i)<>""AND(NOTschondagewesen)THENschreibeggfueberschrift;out(bezeichnerfenster,ausgabevonzw);line(bezeichnerfenster)FI;kINCR1ELSEname(i):=""FI PER;IFkeinbezeichnervorhandenTHENputline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil1));putline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil2));putline(bezeichnerfenster,anwendungstext(leerebezeichnerlisteteil3))FI.schreibeggfueberschrift:IFersterbezeichnerTHENout(bezeichnerfenster,ueberschrift)FI.ersterbezeichner:k=0.keinbezeichnervorhanden:k=0.ueberschrift:center(bezeichnerfenster,invers(anwendungstext(nurdieseelannamen))).ausgabevonzw:IFlength(zw)>30THENsubtext(zw,1,30)+sternELSEzwFI.schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang),zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerausdruck,feld(aus),zwischenspeicherf,max(laengefuerformeln,length(feld(aus))));langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);formelok:=arithmetischerausdruckistkorrekt(actualcell,bereinigt(zwischenspeicherf),fehlermeldung);BOOL VARersteeingabefuerelannamen:=TRUE;put(formeltag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).vorschlagoderletzteeingabefuerausdruck:BOOL VARfeldfuerausdruckgesperrt:=FALSE;IFausdruck(aktuellesobjekt)=""THENfeldfuerausdruckgesperrt:=TRUE;"0.0"ELSEausdruck(aktuellesobjekt)FI.setzecursoraufersteseingabefeld:IF NOTformelokTHENmeldesyntaxverletzung(fehlercode,fehlermeldung);feldnummer:=ausELSEfeldnummer:=langFI;get(formeltag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernFI;wechslezwischendeneingabefeldernPER.wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameCASEaus:pruefeausdruckEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamen;putget(formeltag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis))FI.gibggfvorgabefuerelannamen:IFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex(
+feldfuerausdruckgesperrt)FI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))OR((zwischenspeicherl=feld(lang))AND NOTlangnameok).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).pruefeausdruck:IFausdruckmussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(aus));formelok:=FALSE;IFausdruckleerTHENmeldeleerenausdruck(fehlercode)ELIFcompilermeldetfehlerTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEzwischenspeicherf:=feld(aus);formelok:=TRUE;fsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI ELSEfsetzeneuenfeldindex(feldfuerausdruckgesperrt)FI.ausdruckmussgeprueftwerden:(zwischenspeicherf<>feld(aus))OR((zwischenspeicherf=feld(aus))AND NOTformelok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:(langnameokANDelannameokANDformelok)OR(feldfuerausdruckgesperrtANDlangnameokANDelannameok).schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;formelname(aktuellesobjekt,bereinigt(zwischenspeicherl),zwischenspeichere,bereinigt(zwischenspeicherf));gespeichert:=TRUE;aktuellesobjektWRITEmp.ausdruckleer:zwischenspeicher="".nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).compilermeldetfehler:fehlermeldung:="";NOTarithmetischerausdruckistkorrekt(actualcell,zwischenspeicher,fehlermeldung).langnamezulang:length(zwischenspeicher)>laengefuernamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);bsspeicherlesen(bezeichnerfenster);raeumeeditierhilfeweg.END PROCformeleditieren;PROCfsetzeneuenfeldindex(BOOL CONSTfeldfuerausdruckgesperrt):IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldfuerausdruckgesperrtTHEN IFfeldnummer<langTHENfeldnummer:=elanELIFfeldnummer>elanTHENfeldnummer:=langFI ELSE IFfeldnummer<langTHENfeldnummer:=ausELIFfeldnummer>ausTHENfeldnummer:=langFI FI END PROCfsetzeneuenfeldindex;PROCparametereditieren(CELL CONSTactualcell,BOOL VARgespeichert,INT VARfehlercode,TEXT VARfehlermeldung):enablestop;TEXT VARzwischenspeicher:="",zwischenspeicherl:="",zwischenspeichere:="";taste:="";BOOL VARlangnameok,elannameok;OBJEKT VARaktuellesobjekt:=objekt(actualcell);MPOS CONSTmp:=mpos(actualcell);gespeichert:=FALSE;pruefedentyp;baueboxumeingabefelderauf;repeatwechslezwischendeneingabefeldern;raeumebildschirmauf.pruefedentyp:.baueboxumeingabefelderauf:WINDOW VAReingabefenster:=window(6,3,32,6);TAG VARvariablentag:=formular(ptag);show(variablentag);outframe(eingabefenster);zeigealleeingabefelder;doublefootnote(anwendungstext(standardhinweis));setzecursoraufersteseingabefeld.zeigealleeingabefelder:belegefeld(langname(aktuellesobjekt),feld(lang),
+zwischenspeicherl,laengefuernamen);belegefeld(vorschlagoderletzteeingabefuerelannamen,feld(elan),zwischenspeichere,laengefuernamen);langnameok:=(length(langname(aktuellesobjekt))>0);elannameok:=(length(elanname(aktuellesobjekt))>0);BOOL VARersteeingabefuerelannamen:=TRUE;put(variablentag,feld);.vorschlagoderletzteeingabefuerelannamen:elanname(aktuellesobjekt).setzecursoraufersteseingabefeld:feldnummer:=lang;get(variablentag,feld(feldnummer),feldnummer,taste).repeatwechslezwischendeneingabefeldern:REP IFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernFI;wechslezwischendeneingabefeldernPER.wechslezwischendeneingabefeldern:boxaufgebaut:=TRUE;SELECTfeldnummerOF CASElang:pruefelangnameCASEelan:pruefeelannameEND SELECT;behandletaste;gibggfstandardhinweisaus;gibggfvorgabefuerelannamen;putget(variablentag,feld(feldnummer),feldnummer,taste);.gibggfstandardhinweisaus:IFeingabenohnefehlundtadelTHENdoublefootnote(anwendungstext(standardhinweis))FI.gibggfvorgabefuerelannamen:IFelannamebisherleerTHENersteeingabefuerelannamen:=FALSE;belegefeld(elanname(letzteeingabefuerlangnamen),feld(elan),zwischenspeichere,laengefuernamen);FI.elannamebisherleer:ersteeingabefuerelannamenAND(NOTelannameok)ANDfeldnummer=elan.letzteeingabefuerlangnamen:bereinigt(zwischenspeicherl).pruefelangname:IFlangnamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(lang));langnameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFlangnamezulangTHENmeldezulangennamen(fehlercode)ELIFlangnamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELSElangnameok:=TRUE;zwischenspeicherl:=feld(lang);psetzeneuenfeldindexFI ELSEpsetzeneuenfeldindexFI.langnamemussgeprueftwerden:(zwischenspeicherl<>feld(lang))OR((zwischenspeicherl=feld(lang))AND NOTlangnameok).pruefeelanname:IFelannamemussgeprueftwerdenTHENzwischenspeicher:=bereinigt(feld(elan));elannameok:=FALSE;IFnameleerTHENmeldeleerennamen(fehlercode)ELIFelannamemitfalschemanfangTHENmeldefalschenanfang(fehlercode)ELIFelannamemitfalschenzeichenTHENmeldeformalenfehler(fehlercode)ELIFelannamenichteindeutigTHENmeldedoppeltennamen(fehlercode)ELIFeingabeentsprichtnichtelannotationTHENmeldesyntaxverletzung(fehlercode,fehlermeldung)ELSEelannameok:=TRUE;zwischenspeichere:=feld(elan);psetzeneuenfeldindexFI ELSEpsetzeneuenfeldindexFI.elannamemussgeprueftwerden:(zwischenspeichere<>feld(elan))OR((zwischenspeichere=feld(elan))AND NOTelannameok).behandletaste:IFtaste=pruefenANDeingabenohnefehlundtadelTHENschreibeeditiertesobjektzurueck;LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=haltTHEN LEAVErepeatwechslezwischendeneingabefeldernELIFtaste=infoTHENgibeditierhilfeFI.eingabenohnefehlundtadel:langnameokANDelannameok.schreibeeditiertesobjektzurueck:zwischenspeichere:=bereinigt(zwischenspeichere);changeall(zwischenspeichere," ","");IFzwischenspeichere<>elanname(aktuellesobjekt)ANDelanname(aktuellesobjekt)<>""THENfuehrenamensaenderunginallenabhaengigenformelnaus(actualcell,zwischenspeichere)FI;parametername(aktuellesobjekt,bereinigt(zwischenspeicherl),zwischenspeichere);gespeichert:=TRUE;aktuellesobjektWRITEmp.nameleer:zwischenspeicher="".langnamenichteindeutig:NOTlangnameeindeutig(zwischenspeicher,mpos(actualcell)).elannamenichteindeutig:NOTelannameeindeutig(zwischenspeicher,mpos(actualcell)).elannamemitfalschemanfang:NOTimkleinenalphabet(zwischenspeicherSUB1).elannamemitfalschenzeichen:NOTelannamealphabetisch(zwischenspeicher).eingabeentsprichtnichtelannotation:fehlermeldung:="";NOTelannameistelanbezeichner(zwischenspeicher,fehlermeldung).langnamezulang:length(zwischenspeicher)>laengefuernamen.raeumebildschirmauf:bsspeicherlesen(eingabefenster);raeumeeditierhilfeweg.END PROCparametereditieren;PROCpsetzeneuenfeldindex:IFtaste=hochTHENfeldnummerDECR1ELIFtaste=runterORtaste=returnTHENfeldnummerINCR1FI;IFfeldnummer<langTHENfeldnummer:=elanELIFfeldnummer>elanTHENfeldnummer:=langFI END PROCpsetzeneuenfeldindex;TEXT PROCtextfuereingabefeld(TEXT CONSTfeld,INT CONSTlaenge):TEXT VARergebnis:=text(feld,laenge);changeall(ergebnis," ",
+"_");ergebnisEND PROCtextfuereingabefeld;TEXT PROCbereinigt(TEXT CONSTfeld):TEXT VARergebnis:=feld;changeall(ergebnis,underscore,blank);compress(ergebnis)END PROCbereinigt;PROCbelegefeld(TEXT CONSToriginal,TEXT VARfuerfeld,fuerzwischenspeicher,INT CONSTlaenge):fuerfeld:=textfuereingabefeld(original,laenge);fuerzwischenspeicher:=fuerfeld;END PROCbelegefeld;BOOL PROCelannamealphabetisch(TEXT CONSTname):INT VARi;IFersterbuchstabenichtimkleinenalphabetTHEN FALSE ELSE FORiFROM1UPTOlength(name)REP IFiteszeichennichtimkleinenalphabetodernumerischoderblankTHEN LEAVEelannamealphabetischWITH FALSE FI PER;TRUE FI.ersterbuchstabenichtimkleinenalphabet:NOTimkleinenalphabet(nameSUB1).iteszeichennichtimkleinenalphabetodernumerischoderblank:NOT(imkleinenalphabet(nameSUBi)ORnumerisch(nameSUBi)ORblank=(nameSUBi)).END PROCelannamealphabetisch;TEXT PROCelanname(TEXT CONSTname):INT VARi;TEXT VARneuername:="";FORiFROM1UPTOlength(name)REP IFiteszeichenimgrossenalphabetTHENneuernameCATcode(code(nameSUBi)+32)ELIFiteszeichenimkleinenalphabetodernumerischTHENneuernameCAT(nameSUBi)ELIFiteszeichenszTHENneuernameCAT"ss"FI PER;neuername.iteszeichenimgrossenalphabet:imgrossenalphabet(nameSUBi).iteszeichenimkleinenalphabetodernumerisch:imkleinenalphabet(nameSUBi)ORnumerisch(nameSUBi).iteszeichensz:(nameSUBi)="ß".END PROCelanname;BOOL PROCimgrossenalphabet(TEXT CONSTc):(code("A")<=code(c)ANDcode(c)<=code("Z"))ORpos("ÄÖÜ",c)>0END PROCimgrossenalphabet;BOOL PROCimkleinenalphabet(TEXT CONSTc):(code("a")<=code(c)ANDcode(c)<=code("z"))ORpos("äöü",c)>0END PROCimkleinenalphabet;BOOL PROCnumerisch(TEXT CONSTc):(code("0")<=code(c)ANDcode(c)<=code("9"))END PROCnumerisch;BOOL PROClangnameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtCANDijnichtaktuellepositionTHEN IFlangname(objekt(cell(i,j)))=bezeichnerTHEN LEAVElangnameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:belegt(cell(i,j)).END PROClangnameeindeutig;BOOL PROCelannameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtANDijnichtaktuellepositionTHEN IFelanname(objekt(cell(i,j)))=bezeichnerTHEN LEAVEelannameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:belegt(cell(i,j)).END PROCelannameeindeutig;BOOL PROCkurznameeindeutig(TEXT CONSTbezeichner,MPOS CONSTmp):INT VARimp:=impos(mp),jmp:=jmpos(mp),i,j;FORiFROM1UPTOmaxiREP FORjFROM1UPTOmaxjREP IFpositionbelegtANDijnichtaktuellepositionTHEN IFkurzname(objekt(cell(i,j)))=bezeichnerTHEN LEAVEkurznameeindeutigWITH FALSE FI FI PER PER;TRUE.ijnichtaktuelleposition:NOT(i=impANDj=jmp).positionbelegt:CELL CONSTc:=cell(i,j);belegt(c)AND NOT(typ(objekt(c))=parameter).END PROCkurznameeindeutig;BOOL PROCelannameistelanbezeichner(TEXT CONSTzwischenspeicher,TEXT VARfehlermeldung):TEXT CONSTvariablendefinition:=realvar+zwischenspeicher+";";ergebnisdescompilers(variablendefinition,fehlermeldung)END PROCelannameistelanbezeichner;BOOL PROCergebnisdescompilers(TEXT CONSTausdruck,TEXT VARfehlermeldung):BOOL VARfehler;fehlermeldung:="";IFausdruckzulangTHEN TRUE ELSEdisablestop;do(ausdruck);fehler:=iserror;IFiserrorTHENclearerror;enablestop;fehlermeldung:=errormessageELSEenablestopFI;NOTfehlerFI.ausdruckzulang:length(ausdruck)>maxlaengefuerdo.END PROCergebnisdescompilers;BOOL PROCarithmetischerausdruckistkorrekt(CELL CONSTactualcell,TEXT CONSTeingabe,TEXT VARfehlermeldung):TEXT CONSTrefinementname:="abcdefghijklmnopqrstuvwxyz0123456789";INT VARi,j;erstertestmitlokalenbezeichnern;zweitertestmitallenbezeichnern;TRUE.erstertestmitlokalenbezeichnern:kleinevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.zweitertestmitallenbezeichnern:grossevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.kleinevariablenlistezusammenstellen:TEXT VARausdruck:="";
+FORiFROM1UPTOmaxlinkREP IFname(i)<>""CAND(NOTschondagewesen)THENausdruckCAT(realvar+name(i)+";")FI PER.grossevariablenlistezusammenstellen:ausdruck:=listeallerbezeichner(mpos(actualcell)).schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.variablenlistemiteingabeverknuepfen:ausdruckCAT("REAL "+procname+":"+refinementname+"."+refinementname+":"+eingabe+"END "+procname).procname:"PROC proc "+refinementname.ausdruckpruefen:IF NOTergebnisdescompilers(ausdruck,fehlermeldung)THEN LEAVEarithmetischerausdruckistkorrektWITH FALSE FI.END PROCarithmetischerausdruckistkorrekt;BOOL PROCtermistkorrekt(CELL CONSTactualcell,TEXT CONSTeingabe,liste,TEXT VARfehlermeldung):INT VARi,j;TEXT CONSTrefinementname:="abcdefghijklmnopqrstuvwxyz0123456789";erstertestmitlokalenbezeichnern;zweitertestmitallenbezeichnern;TRUE.erstertestmitlokalenbezeichnern:kleinevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.zweitertestmitallenbezeichnern:grossevariablenlistezusammenstellen;variablenlistemiteingabeverknuepfen;ausdruckpruefen.kleinevariablenlistezusammenstellen:zulaessigebezeichnerzusammenstellen(actualcell);TEXT VARausdruck:="";FORiFROM1UPTOmaxlinkREP IFname(i)<>""CAND(NOTschondagewesen)THENausdruckCAT(realvar+name(i)+";")FI PER.grossevariablenlistezusammenstellen:ausdruck:=liste.schondagewesen:FORjFROM1UPTOi-1REP IFname(j)=name(i)THEN LEAVEschondagewesenWITH TRUE FI PER;FALSE.variablenlistemiteingabeverknuepfen:ausdruckCAT("REAL "+procname+":"+refinementname+"."+refinementname+":"+eingabe+"END "+procname).procname:"PROC proc "+refinementname.ausdruckpruefen:IF NOTergebnisdescompilers(ausdruck,fehlermeldung)THEN LEAVEtermistkorrektWITH FALSE FI.END PROCtermistkorrekt;PROCzulaessigebezeichnerzusammenstellen(CELL CONSTactualcell):INT VARi;FORiFROM1UPTOmaxlinkREP IF(actualcellEINGANGi)THENname(i):=compress(elanname(objekt(actualcellUEBERi)));changeall(name(i)," ","");ELSEname(i):=""FI PER END PROCzulaessigebezeichnerzusammenstellen;PROCfuehrenamensaenderunginallenabhaengigenformelnaus(CELL CONSTactualcell,TEXT CONSTneuername):OBJEKT CONSTaktuellesobjekt:=objekt(actualcell);INT VARi;FORiFROM1UPTOmaxlinkREP IFiterpfeilweistaufformelTHENaendereelannameninnachbarformelFI PER.iterpfeilweistaufformel:(actualcellAUSGANGi)AND(typ(objekt(actualcellUEBERi))=formel).aendereelannameninnachbarformel:TEXT CONSTaltername:=elanname(aktuellesobjekt);MPOS CONSTzielposition:=(actualcellUEBERi);OBJEKT VARzielformel:=objekt(zielposition);TEXT CONSTterm:=ausdruck(zielformel);TEXT VARneuerterm:="";scanneterminzielformel;schreibeneuentermzurueck.scanneterminzielformel:TEXT VARsymbol:="";INT VARtype:=0,lasttype:=0;scan(term);nextsymbol(symbol,type);WHILE NOTendeerreichtREPverarbeitesymbol;nextsymbol(symbol,type)PER.endeerreicht:type>delimiter.verarbeitesymbol:SELECTtypeOF CASEtag:neuertermCAT(ggfneuername+" ")CASEdelimiter:verarbeitedelimiterOTHERWISEneuertermCAT(symbol+" ")ENDSELECT;lasttype:=type.ggfneuername:IFsymbol=alternameTHENneuernameELSEsymbolFI.verarbeitedelimiter:IFletzteszeichenimneuentermblankAND(lasttype=delimiterORsymbol=")")THENneuerterm:=subtext(neuerterm,1,length(neuerterm)-1)FI;neuertermCATsymbol.letzteszeichenimneuentermblank:(neuertermSUBlength(neuerterm))=" ".schreibeneuentermzurueck:formelname(zielformel,namederformel,elannamederformel,neuerterm);zielformelWRITEzielposition.namederformel:langname(zielformel).elannamederformel:elanname(zielformel).END PROCfuehrenamensaenderunginallenabhaengigenformelnaus;TEXT PROClisteallerbezeichner(MPOS CONSTmp):TEXT VARdeklarationen:=realvar+"zeit";variablenanhaengen;ergebnisseanhaengen;parameteranhaengen;formelnanhaengen;listeabschliessen.variablenanhaengen:deklarationenCATteilliste(variablenthesaurus).ergebnisseanhaengen:deklarationenCATteilliste(ergebnisthesaurus).parameteranhaengen:deklarationenCATteilliste(parameterthesaurus).formelnanhaengen:deklarationenCATteilliste(formelthesaurus,mp).listeabschliessen:deklarationenCAT";";deklarationen.
+END PROClisteallerbezeichner;TEXT PROCteilliste(THESAURUS CONSTpositionen):INT VARi:=0;MPOS VARmp;TEXT VARliste:="";WHILEi<highestentry(positionen)REPgetmpos(positionen,mp,i);listeCAT(","+elanname(objekt(mp)))PER;listeEND PROCteilliste;TEXT PROCteilliste(THESAURUS CONSTpositionen,MPOS CONSTactualmp):INT VARi:=0;MPOS VARmp;TEXT VARliste:="";WHILEi<highestentry(positionen)REPgetmpos(positionen,mp,i);IF NOT(mp=actualmp)THENlisteCAT(","+elanname(objekt(mp)))FI PER;listeEND PROCteilliste;WINDOW VARw:=window(6,12,69,10);BOOL VARhilfeschoneingeblendet:=FALSE;DATASPACE VARds;FILE VARhf;INT VARerstezeile:=3,erstespalte:=1;PROCraeumeeditierhilfeweg:IFhilfeschoneingeblendetTHENbsspeicherlesen(w);hilfeschoneingeblendet:=FALSE FI END PROCraeumeeditierhilfeweg;PROCgibeditierhilfe:MPOS VARmp;TEXT VARtaste:="";IF NOThilfeschoneingeblendetTHENstellehilfezusammen;erstezeile:=3;erstespalte:=1;outframe(w);FI;wechsleinfenstermithilfe.wechsleinfenstermithilfe:doublefootnote(anwendungstext(quithinweis));scroll(w,hf,1,3,0,erstezeile,erstespalte,zurueck,taste);doublefootnote(anwendungstext(standardhinweis)).stellehilfezusammen:forget(ds);ds:=nilspace;hf:=sequentialfile(output,ds);INT VARi,v:=0,e:=0,p:=0,f:=0;erstezeile:=1;erstespalte:=1;fischevariablenundihrenamenausmatrix;fischeergaenzungsvariablenundihrenamenausmatrix;fischeparameterundihrenamenausmatrix;fischeformelnundihrenamenausmatrix;ggfueberschrifttfuerleereliste;hilfeschoneingeblendet:=TRUE.ggfueberschrifttfuerleereliste:IFv+e+f+p=0THENputline(hf,anwendungstext(nochkeinenamenvergeben))FI.fischevariablenundihrenamenausmatrix:i:=0;WHILEi<highestentry(variablenthesaurus)REPgetmpos(variablenthesaurus,mp,i);behandlevariablePER;IFv>0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandlevariable:IFv=0THENschreibeueberschriftfuernichtleerevlisteFI;vINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),kurzname(objekt(mp)));.fischeergaenzungsvariablenundihrenamenausmatrix:i:=0;WHILEi<highestentry(ergebnisthesaurus)REPgetmpos(ergebnisthesaurus,mp,i);behandleergebnisPER;IFe>0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleergebnis:IFe=0THENschreibeueberschriftfuernichtleereelisteFI;eINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),kurzname(objekt(mp))).fischeparameterundihrenamenausmatrix:i:=0;WHILEi<highestentry(parameterthesaurus)REPgetmpos(parameterthesaurus,mp,i);behandleparameterPER;IFp>0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleparameter:IFp=0THENschreibeueberschriftfuernichtleereplisteFI;pINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),3*"-").fischeformelnundihrenamenausmatrix:i:=0;WHILEi<highestentry(formelthesaurus)REPgetmpos(formelthesaurus,mp,i);behandleformelPER;IFf>0THENputline(hf,anwendungstext(tabellenfuss));line(hf)FI.behandleformel:IFf=0THENschreibeueberschriftfuernichtleereflisteFI;fINCR1;neuezeile(langname(objekt(mp)),elanname(objekt(mp)),3*"-");.schreibeueberschriftfuernichtleerevliste:ggfueberschrift;putline(hf,anwendungstext(singularmodellgroesse)+"n");ueberschrift.schreibeueberschriftfuernichtleereeliste:ggfueberschrift;putline(hf,anwendungstext(singularergebnis)+"n");ueberschrift.schreibeueberschriftfuernichtleerepliste:ggfueberschrift;putline(hf,anwendungstext(singularparameter));ueberschrift.schreibeueberschriftfuernichtleerefliste:ggfueberschrift;putline(hf,anwendungstext(ueberschriftfuerformel));ueberschrift.ueberschriftfuerformel:IFf=1THENsingularformelELSEpluralformelFI.ggfueberschrift:IFv+e+f+p=0THENputline(hf,anwendungstext(listedernamen));putline(hf,length(anwendungstext(listedernamen))*waagerecht);line(hf)FI.END PROCgibeditierhilfe;PROCueberschrift:putline(hf,anwendungstext(tabellenkopf1));putline(hf,anwendungstext(tabellenkopf2));putline(hf,anwendungstext(tabellenkopf3));END PROCueberschrift;PROCneuezeile(TEXT CONSTl,e,k):TEXT VARzeile:=anwendungstext(tabellenrumpf);replace(zeile,3,l);replace(zeile,35,ausgabefuerelannamen);replace(zeile,56,k);putline(hf,zeile).ausgabefuerelannamen:IFlength(e)>17THEN
+subtext(e,1,17)+"*"ELSEeFI.END PROCneuezeile;PROCmeldeleerennamen(INT VARfehlercode):fehlercode:=hinweisleerername;outfehler(fehlercode)END PROCmeldeleerennamen;PROCmeldeleerenausdruck(INT VARfehlercode):fehlercode:=hinweisleererausdruck;outfehler(fehlercode)END PROCmeldeleerenausdruck;PROCmeldefalschenanfang(INT VARfehlercode):fehlercode:=hinweisfalscheranfang;outfehler(fehlercode)END PROCmeldefalschenanfang;PROCmeldeformalenfehler(INT VARfehlercode):fehlercode:=hinweisformalerfehler;outfehler(fehlercode)END PROCmeldeformalenfehler;PROCmeldesyntaxverletzung(INT VARfehlercode,TEXT CONSTfehlermeldung):fehlercode:=hinweissyntaxfehler;doublefootnote(anwendungstext(hinweissyntaxfehler)+return+fehlermeldung)END PROCmeldesyntaxverletzung;PROCmeldezeitunzulaessig(INT VARfehlercode,TEXT CONSTfehlermeldung):fehlercode:=zeitnichtalsvariable;doublefootnote(anwendungstext(zeitnichtalsvariable)+return+fehlermeldung)END PROCmeldezeitunzulaessig;PROCmeldedoppeltennamen(INT VARfehlercode):fehlercode:=hinweisdoppeltername;outfehler(fehlercode)END PROCmeldedoppeltennamen;PROCmeldezulangennamen(INT VARfehlercode):fehlercode:=hinweislangername;outfehler(fehlercode)END PROCmeldezulangennamen;PROCoutfehler(INT CONSTfehlercode):doublefootnote(anwendungstext(fehlercode))END PROCoutfehler;END PACKETobjektrepraesentation2;
+
diff --git a/app/schulis-simulationssystem/3.0/src/output b/app/schulis-simulationssystem/3.0/src/output
new file mode 100644
index 0000000..79fb6f5
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/output
@@ -0,0 +1,7 @@
+PACKEToutputDEFINES OUTPUT,:=,niloutput,replace,FILESUB,gebeaufbildschirmaus,plotterahmendoppelt,plottefusszeile,blaettere,blaetternoben,blaetternunten,blaettern,putpicture,putkreuz,nildiagramm,nildiagrammmitkreuz,nilkreuz,window,legefensterfest,versendeoutput,setzerahmen,kopfzeilezusammenstellen,forget:LETstrukt1fenster=1,strukt2texte=2,strukt2diagramme1text=3,strukt4fenster=4,strukttabelleunten=5,strukttabelleoben=6,fensterganz=1,fensteroben=2,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8,stdfarbe=1,stddicke=0,durchgezogen=1,hintergrund=0,vordergrund=1,maxpictures=10,blockstartwerte=9,neuerplottertaskname="SIMSEL-PRINTERDEPOT",alterplottertaskname="simsel plotter",maxplotobjekteinplottertask=25,mlplottertaskzuvoll=31,mlplottertaskexistiertnicht=40,mlplottertasknichtempfangsbereit=41,mlplotunmoeglich=43,plotok=0,produktname=21,zwischenraum=" ",maxfilezeilen=500,teilfenster="teiltextname",anfangszeile=1,typnummer=1055,lkszeilenanfang=4,rtszeilenanfang=42,rtszeilenende=79,obenerstezeile=3,obenletztezeile=12,untenerstezeile=14,untenletztezeile=23;REAL VARhorcm,vertcm;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);REAL CONSTbuchsthoehe:=stdhoehe,buchstbreite:=stdbreite,minyabstand:=0.1,minxabstand:=buchstbreite/3.0;REAL CONSThoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,spaltenmitte:=(vertcm)/2.0,oben:=vertcm-hoehe,unten:=hoehe,zeilenmitte:=horcm/2.0,rahmenoben:=vertcm,rahmenunten:=0.0,abstand:=0.1;REAL VARverkleinerunghoehe:=2.5,verkleinerungbreite:=1.5;ROW6PICTURE VARrahmenmitkreuz;erstellerahmen;TYPE OUTPUT=BOUND STRUCT(INTaufbau,TEXTkopfzeilentext,INTschluesselfusszeile,BOOLmitrahmen,REALstandardhoehe,standardbreite,sourcewidth,sourceheight,TEXTmodellbezeichner,dsname,ROW2DIAGRAMMdiag,NURTEXTtext1,text2,startwerte,PICTURErahmen);TYPE NURTEXT=STRUCT(BOOLbelegt,INTaktzeile,naechsteseite,SIMSELFILEinhalt);TYPE DIAGRAMM=STRUCT(BOOLbelegt,INTanzahlpictures,anzahlpicfuerkreuz,REALxmin,xmax,ymin,ymax,ROWmaxpicturesPICTUREkreuz,ROWmaxpicturesPICTUREinhalt);TYPE SIMSELFILE=STRUCT(ROWmaxfilezeilenTEXTfilezeile,INTzeilenanzahl);PROCversendeoutput(OUTPUT VARobjekt,TEXT CONSTmodellbezeichner,kopfzeilentext,INT CONSTsteuerzeilennr,TEXT CONSTziel):INT VARret;TEXT VARdsname:=kopfzeilentext+"."+modellbezeichner+". "+timeofday;changeall(dsname,":",".");changeall(dsname," ","");change(dsname,"Demonstration","D");forget(dsname,quiet);copy(objekt.dsname,dsname);OUTPUT VARkopie;CONCR(kopie):=old(dsname);kopie.dsname:=dsname;kopie.modellbezeichner:=modellbezeichner;kopie.kopfzeilentext:=kopfzeilentext;kopie.schluesselfusszeile:=steuerzeilennr;IF NOTframeTHENkopie.mitrahmen:=FALSE;kopie.sourceheight:=kopie.sourceheight-2.0*hoeheeinerrandzeileELSEplotteallerandzeilen(kopie);FI;ret:=erfolgreicherplotversuch(kopie.dsname,ziel);IFret=plotokTHENforget(kopie.dsname,quiet);ELSEforget(kopie.dsname,quiet);plotend;errorstop(meldungstext(ret));FI;.hoeheeinerrandzeile:kopie.standardhoehe+3.0*minyabstand.END PROCversendeoutput;PROCversendeoutput(OUTPUT VARobjekt,TEXT CONSTmodellbezeichner,INT CONSTkopfzeilennr,steuerzeilennr,TEXT CONSTziel):versendeoutput(objekt,modellbezeichner,kopfzeile(kopfzeilennr),steuerzeilennr,ziel);END PROCversendeoutput;INT PROCerfolgreicherplotversuch(TEXT CONSTdatname,TEXT CONSTdestination):TEXT VARzieltask:="";disablestop;IFdestination=alterplottertasknameTHENzieltask:=neuerplottertasknameELSEzieltask:=destinationFI;IFexiststask(zieltask)THEN IFstatus(/zieltask)=2THEN IFplottertaskzuvoll(/zieltask)THENenablestop;mlplottertaskzuvollELSEsicherezuplotterFI ELSEenablestop;mlplottertasknichtempfangsbereitFI ELSEenablestop;mlplottertaskexistiertnichtFI.sicherezuplotter:commanddialogue(FALSE);save(datname,/zieltask);commanddialogue(TRUE);IFiserrorTHENclearerror;enablestop;mlplotunmoeglichELSEenablestop;plotokEND IF.END PROCerfolgreicherplotversuch;BOOL PROCplottertaskzuvoll(TASK CONSTziel):THESAURUS VARth:=ALLziel;INT VARi:=0,anzahl:=0;TEXT VARt;
+WHILEi<=highestentry(th)REPget(th,t,i);IFt<>""THENanzahlINCR1;FI;UNTILi=0PER;anzahl>=maxplotobjekteinplottertask.END PROCplottertaskzuvoll;PROCplotohneclear(DIAGRAMM VARp):INT VARi;PICTURE VARpic;beginplot;FORiFROM1UPTOp.anzahlpicfuerkreuzREPpic:=p.kreuz(i);plottepic;PER;FORiFROM1UPTOp.anzahlpicturesREPpic:=p.inhalt(i);plottepic;PER;endplot.plottepic:IFpen(pic)<>0THENpen(0,stdfarbe,stddicke,pen(pic));plot(pic)FI.END PROCplotohneclear;OP:=(OUTPUT VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCforget(OUTPUT VARalt):forget(alt.dsname,quiet);END PROCforget;DATASPACE PROCniloutput(INT CONSTbildaufbau,TEXT CONSTspacename):OUTPUT VARneu;forget(spacename,quiet);neu:=new(spacename);type(old(spacename),typnummer);neu.aufbau:=bildaufbau;neu.dsname:=spacename;neu.text1.belegt:=FALSE;neu.text1.aktzeile:=anfangszeile;simselfile(neu.text1.inhalt);neu.text1.naechsteseite:=anfangszeile;neu.text2.belegt:=FALSE;neu.text2.aktzeile:=anfangszeile;simselfile(neu.text2.inhalt);neu.text2.naechsteseite:=anfangszeile;neu.startwerte.belegt:=FALSE;neu.startwerte.aktzeile:=anfangszeile;simselfile(neu.startwerte.inhalt);neu.startwerte.naechsteseite:=anfangszeile;neu.standardhoehe:=stdhoehe;neu.standardbreite:=stdbreite;neu.sourcewidth:=horcm;neu.sourceheight:=vertcm;neu.diag(1).belegt:=FALSE;neu.diag(1).anzahlpictures:=0;neu.diag(2).anzahlpictures:=0;neu.diag(1).anzahlpicfuerkreuz:=0;neu.diag(2).anzahlpicfuerkreuz:=0;neu.diag(2).belegt:=FALSE;neu.mitrahmen:=TRUE;neu.rahmen:=rahmenmitkreuz(bildaufbau);old(neu.dsname).END PROCniloutput;PROCerstellerahmen:INT VARi;PICTURE VARgrenzen;FORiFROM1UPTO6REPgrenzen:=nilpicture;plrahmenunten;plrahmenlinks;plrahmenoben;plrahmenrechts;innererrahmenoben;innererrahmenunten;erstellekreuz;rahmenmitkreuz(i):=grenzen;PER;.plrahmenunten:movecm(grenzen,links,rahmenunten);drawcm(grenzen,rechts,rahmenunten).plrahmenlinks:movecm(grenzen,links,rahmenunten);drawcm(grenzen,links,rahmenoben).plrahmenoben:movecm(grenzen,links,rahmenoben);drawcm(grenzen,rechts,rahmenoben).plrahmenrechts:movecm(grenzen,rechts,rahmenoben);drawcm(grenzen,rechts,rahmenunten).innererrahmenoben:movecm(grenzen,links,oben);drawcm(grenzen,rechts,oben).innererrahmenunten:movecm(grenzen,links,unten);drawcm(grenzen,rechts,unten).erstellekreuz:SELECTiOF CASEstrukt2texte:waagerechtlks;waagerechtrts;CASEstrukttabelleunten:waagerechtlks;waagerechtrts;senkrechtoben;CASEstrukt4fenster:waagerechtlks;waagerechtrts;senkrechtoben;senkrechtunten;CASEstrukttabelleoben:waagerechtlks;waagerechtrts;senkrechtunten;CASEstrukt2diagramme1text:waagerechtlks;senkrechtoben;senkrechtunten;END SELECT;.waagerechtlks:movecm(grenzen,links,spaltenmitte);drawcm(grenzen,zeilenmitte,spaltenmitte).waagerechtrts:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,rechts,spaltenmitte).senkrechtoben:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,oben).senkrechtunten:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,unten).END PROCerstellerahmen;PROCplotterahmen(OUTPUT VARoutput):beginplot;clear;pen(hintergrund,vordergrund,stddicke,durchgezogen);viewport(links,rechts,rahmenunten,rahmenoben);window(0.0,1.0,0.0,1.0);plot(output.rahmen);endplot;.END PROCplotterahmen;PROCplotterahmendoppelt(OUTPUT VARoutput):viewport(links,rechts,rahmenunten,rahmenoben);window(0.0,1.0,0.0,1.0);beginplot;pen(hintergrund,vordergrund,stddicke,durchgezogen);plot(output.rahmen);endplot;.END PROCplotterahmendoppelt;PROCgebeaufbildschirmaus(OUTPUT VARobjekt,TEXT CONSTbezeichnung,textkopfzeile,INT CONSTsteuerzeilennr):objekt.modellbezeichner:=bezeichnung;objekt.kopfzeilentext:=textkopfzeile;objekt.schluesselfusszeile:=steuerzeilennr;plotterahmen(objekt);plottekopfzeile(objekt.kopfzeilentext,objekt.modellbezeichner);plottedarstellung;plotterahmendoppelt(objekt);loescheeingabepuffer;beginplot;plottefusszeile(objekt,objekt.schluesselfusszeile);endplot;.loescheeingabepuffer:TEXT VARt:="";REPt:=incharetyUNTILt=""PER.plottedarstellung:SELECTobjekt.aufbauOF CASEstrukt1fenster:IF
+objekt.text1.belegtTHENplot(fensterganz,objekt.text1)ELIFobjekt.diag(1).belegtTHENplot(fensterganz,objekt)FI;CASEstrukt2texte:IFobjekt.text1.belegtTHENplot(fensteroben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterunten,objekt.text2)FI;CASEstrukt2diagramme1text:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechts,objekt.text1);FI;CASEstrukt4fenster:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechtsoben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterrechtsunten,objekt.text2);FI;CASEstrukttabelleunten:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.text1.belegtTHENplot(fensterrechtsoben,objekt.text1);FI;IFobjekt.text2.belegtTHENplot(fensterunten,objekt.text2);FI;CASEstrukttabelleoben:IFobjekt.text1.belegtTHENplot(fensteroben,objekt.text1);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text2.belegtTHENplot(fensterrechtsunten,objekt.text2);FI;END SELECT.END PROCgebeaufbildschirmaus;PROCgebeaufbildschirmaus(OUTPUT VARobjekt,TEXT CONSTbezeichnung,INT CONSTkopfzeilennr,steuerzeilennr):IFkopfzeilennr=0THENgebeaufbildschirmaus(objekt,bezeichnung," ",steuerzeilennr);ELSEgebeaufbildschirmaus(objekt,bezeichnung,kopfzeile(kopfzeilennr),steuerzeilennr);FI;END PROCgebeaufbildschirmaus;PROCplotteallerandzeilen(OUTPUT VARobjekt):PICTURE VARrandzeilen:=nilpicture;REAL CONSTgrenzeunten:=2.0*minyabstand+rahmenunten,grenzeoben:=oben+2.0*minyabstand,textende:=rechts-2.0*minyabstand,textanfang:=2.0*minyabstand+links;erstellekopfzeile;erstellesteuerleiste;objekt.rahmenCATrandzeilen;.erstellekopfzeile:TEXT VARzeilentext:=kopfzeilezusammenstellen(objekt.kopfzeilentext,objekt.modellbezeichner,int((textende-textanfang)/buchstbreite));steckekopfzeileinpicture;.steckekopfzeileinpicture:movecm(randzeilen,textanfang,grenzeoben);draw(randzeilen,zeilentext,0.0,buchsthoehe,buchstbreite);.erstellesteuerleiste:IFobjekt.schluesselfusszeile<>0THENmovecm(randzeilen,textanfang,grenzeunten);draw(randzeilen,steuerleiste(objekt.schluesselfusszeile),0.0,buchsthoehe,buchstbreite)FI.END PROCplotteallerandzeilen;PROCplottekopfzeile(TEXT CONSTkopfzeilentext,namedesmodells):REAL CONSTgrenzeoben:=oben+2.0*minyabstand,textende:=rechts-minyabstand,textanfang:=((2.0*minxabstand)+links);erstellekopfzeile;.erstellekopfzeile:TEXT VARzeilentext:=kopfzeilezusammenstellen(kopfzeilentext,namedesmodells,int((textende-textanfang)/buchstbreite));steckekopfzeileinpicture;.steckekopfzeileinpicture:beginplot;viewport(links,rechts,rahmenunten,rahmenoben);pen(0,1,0,1);movecm(textanfang,grenzeoben);draw(zeilentext,0.0,buchsthoehe,buchstbreite);endplot;.END PROCplottekopfzeile;PROCplottefusszeile(OUTPUT VARobjekt,INT CONSTtextnr):REAL CONSTgrenzeunten:=2.0*minyabstand+rahmenunten,textanfang:=((2.0*minxabstand)+links);objekt.schluesselfusszeile:=textnr;erstellesteuerleiste;.erstellesteuerleiste:IFtextnr<>0THENviewport(links,rechts,rahmenunten,rahmenoben);pen(0,1,0,1);movecm(textanfang,grenzeunten);draw(steuerleiste(textnr),0.0,buchsthoehe,buchstbreite)FI.END PROCplottefusszeile;PROCgibzeileaus(PICTURE VARrandzeile):viewport(links,rechts,rahmenunten,rahmenoben);beginplot;plot(randzeile);endplot;END PROCgibzeileaus;OP:=(OUTPUT VARneu,OUTPUT VARalt):CONCR(neu):=old(alt.dsname)END OP:=;PROCdraw(INT CONSTfenster,OUTPUT VARobjekt):SIMSELFILE VARtxt;IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENtxt:=objekt.text1.inhaltELIF(fenster=fensterrechtsunten)COR(fenster=fensterunten)THENtxt:=objekt.text2.inhaltFI;setzefensterdaten;schreibeintextfenster;plottetextfenster;.setzefensterdaten:REAL VARlks,rts,un,ob;legefensterfest(objekt,lks,rts,un,ob,fenster);ob:=ob-stdhoehe;INT VARzeilenlaenge:=int((rts-lks)/(stdbreite/verkleinerungbreite));.schreibeintextfenster:PICTURE
+ VARplotobj:=nilpicture;REAL VARzeile:=ob;INT VARzeiger;TEXT VARzeilentext;zeiger:=1;WHILEzeile>unCAND NOTeof(txt,zeiger)REPgetline(txt,zeiger,zeilentext);movecm(plotobj,lks,zeile);draw(plotobj,subtext(zeilentext,1,zeilenlaenge),0.0,stdhoehe/verkleinerunghoehe+abstand,stdbreite/verkleinerungbreite);zeigerINCR1;zeile:=zeile-(stdhoehe/verkleinerunghoehe)-abstand;PER;.plottetextfenster:viewport(lks,rts,un,ob);window(0.0,1.0,0.0,1.0);beginplot;plot(plotobj);endplot;.END PROCdraw;PROCplot(INT CONSTfenster,OUTPUT VARobj):DIAGRAMM VARdiagramm;IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENdiagramm:=obj.diag(1)ELSEdiagramm:=obj.diag(2)FI;REAL VARx1,x2,y1,y2;IFdiagramm.belegtTHENplottediagr;FI;.plottediagr:legefensterfest(obj,x1,x2,y1,y2,fenster);window(diagramm.xmin,diagramm.xmax,diagramm.ymin,diagramm.ymax);viewport(x1,x2,y1,y2);plotohneclear(diagramm);.END PROCplot;PROClegefensterfest(OUTPUT VARobj,REAL VARlks,rts,un,ob,INT CONSTfensterlage):SELECTfensterlageOF CASEfensterganz:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=horcm-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=vertcm-hoehe-abstand-obj.standardhoehe;CASEfensteroben:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=horcm-abstand;un:=(vertcm/2.0)+(3.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterunten:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=horcm-abstand;un:=hoehe+(3.0*abstand);ob:=(vertcm/2.0)-2.0*abstand;CASEfensterlinksoben:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(horcm/2.0)-2.0*abstand;un:=(vertcm/2.0)+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=vertcm-hoehe-abstand-obj.standardhoehe;CASEfensterlinksunten:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(horcm/2.0)-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=(vertcm/2.0)-abstand-obj.standardhoehe;CASEfensterrechts:lks:=horcm/2.0+(3.0*abstand)+obj.standardbreite;rts:=horcm-abstand;un:=hoehe+(2.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterrechtsoben:lks:=horcm/2.0+(2.0*abstand);rts:=horcm-abstand;un:=(vertcm/2.0)+(2.0*abstand);ob:=vertcm-hoehe-2.0*abstand;CASEfensterrechtsunten:lks:=horcm/2.0+(2.0*abstand);rts:=horcm-abstand;un:=hoehe+(2.0*abstand);ob:=(vertcm/2.0)-2.0*abstand;END SELECT;END PROClegefensterfest;PROClegefensterfest(INT VARlks,rts,un,ob,INT CONSTfensterlage,):SELECTfensterlageOF CASEfensterganz:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEfensteroben:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterunten:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechtsoben:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterrechtsunten:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechts:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEblockstartwerte:lks:=40+1;rts:=78;un:=12;ob:=3;END SELECT;END PROClegefensterfest;OP:=(DIAGRAMM VARa,DIAGRAMM CONSTb):INT VARi;FORiFROM1UPTOb.anzahlpicturesREPa.inhalt(i):=b.inhalt(i)PER;FORiFROMb.anzahlpictures+1UPTOmaxpicturesREPa.inhalt(i):=nilpicture;PER;FORiFROM1UPTOb.anzahlpicfuerkreuzREPa.kreuz(i):=b.kreuz(i)PER;FORiFROMb.anzahlpicfuerkreuz+1UPTOmaxpicturesREPa.kreuz(i):=nilpicture;PER;a.belegt:=b.belegt;a.anzahlpictures:=b.anzahlpictures;a.anzahlpicfuerkreuz:=b.anzahlpicfuerkreuz;a.xmin:=b.xmin;a.xmax:=b.xmax;a.ymin:=b.ymin;a.ymax:=b.ymax;END OP:=;PROCnilkreuz(OUTPUT VARa,INT CONSTfenster):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).anzahlpicfuerkreuz:=0;ELSEa.diag(2).anzahlpicfuerkreuz:=0;FI;END PROCnilkreuz;PROCnildiagramm(OUTPUT VARa,INT CONSTfenster):nildiagrammmitkreuz(a,fenster);nilkreuz(a,fenster);END PROCnildiagramm;PROCnildiagrammmitkreuz(OUTPUT VARa,INT CONSTfenster):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).anzahlpictures:=0;a.diag(1).belegt:=TRUE;IFa.aufbau=strukt1fensterTHENa.text1.belegt:=FALSE FI;ELSEa.diag(2)
+.anzahlpictures:=0;a.diag(2).belegt:=TRUE;FI;END PROCnildiagrammmitkreuz;PROCputpicture(OUTPUT VARa,INT CONSTfenster,PICTURE CONSTpic):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THEN IFa.diag(1).anzahlpictures<maxpicturesTHENa.diag(1).anzahlpicturesINCR1;a.diag(1).inhalt(a.diag(1).anzahlpictures):=pic;FI;ELSE IFa.diag(2).anzahlpictures<maxpicturesTHENa.diag(2).anzahlpicturesINCR1;a.diag(2).inhalt(a.diag(2).anzahlpictures):=pic;FI;FI;END PROCputpicture;PROCputkreuz(OUTPUT VARa,INT CONSTfenster,PICTURE CONSTpic):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THEN IFa.diag(1).anzahlpicfuerkreuz<maxpicturesTHENa.diag(1).anzahlpicfuerkreuzINCR1;a.diag(1).kreuz(a.diag(1).anzahlpicfuerkreuz):=pic;FI;ELSE IFa.diag(2).anzahlpicfuerkreuz<maxpicturesTHENa.diag(2).anzahlpicfuerkreuzINCR1;a.diag(2).kreuz(a.diag(2).anzahlpicfuerkreuz):=pic;FI;FI;END PROCputkreuz;PROCwindow(OUTPUT VARa,INT CONSTfenster,REAL CONSTx1,x2,y1,y2):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).xmin:=x1;a.diag(1).xmax:=x2;a.diag(1).ymin:=y1;a.diag(1).ymax:=y2;ELSEa.diag(2).xmin:=x1;a.diag(2).xmax:=x2;a.diag(2).ymin:=y1;a.diag(2).ymax:=y2;FI;END PROCwindow;PROCwindow(OUTPUT VARa,INT CONSTfenster,REAL CONSTy1,y2):IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENa.diag(1).ymin:=y1;a.diag(1).ymax:=y2;ELSEa.diag(2).ymin:=y1;a.diag(2).ymax:=y2;FI;END PROCwindow;PROCreplace(OUTPUT VARoutput,FILE CONSTfenstertext):FILE VARzwischenfile:=fenstertext;output.startwerte.belegt:=TRUE;output.startwerte.inhalt:=zwischenfile;output.startwerte.aktzeile:=anfangszeile;output.startwerte.naechsteseite:=anfangszeile;END PROCreplace;PROCreplace(OUTPUT VARoutput,INT CONSTfenster,FILE CONSTfenstertext):FILE VARzwischenfile:=fenstertext;IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENoutput.text1.belegt:=TRUE;output.text1.inhalt:=zwischenfile;output.text1.aktzeile:=anfangszeile;output.text1.naechsteseite:=anfangszeile;IFoutput.aufbau=strukt1fensterTHENoutput.diag(1).belegt:=FALSE;FI;ELIF(fenster=fensterrechtsunten)COR(fenster=fensterunten)THENoutput.text2.belegt:=TRUE;output.text2.inhalt:=zwischenfile;output.text2.aktzeile:=anfangszeile;output.text2.naechsteseite:=anfangszeile;FI;END PROCreplace;PROCplot(INT CONSTfenster,NURTEXT VARobj):setzefensterdaten;schreibe;.setzefensterdaten:INT VARlks,rts,un,ob;legefensterfest(lks,rts,un,ob,fenster);INT VARzeilenlaenge:=rts-lks+1;.schreibe:INT VARzeile:=ob,zeiger;TEXT VARzeilentext,ausgabezeile,leerzeile:=zeilenlaenge*" ";zeiger:=obj.aktzeile;FORzeileFROMobUPTOunWHILE NOTeof(obj.inhalt,zeiger)REPgetline(obj.inhalt,zeiger,zeilentext);ausgabezeile:=leerzeile;replace(ausgabezeile,1,zeilentext);cursor(lks,zeile);out(ausgabezeile);zeigerINCR1;PER;ob:=zeile;FORzeileFROMobUPTOunREPcursor(lks,zeile);loeschezeile;PER;IFeof(obj.inhalt,zeiger)THENobj.naechsteseite:=anfangszeileELSEobj.naechsteseite:=zeigerFI;.loeschezeile:out(leerzeile);.END PROCplot;FILE OP FILESUB(OUTPUT VARobjekt,INT CONSTfenster):TEXT VARfiletext;INT VARi;IFexists(teilfenster)THENforget(teilfenster,quiet)FI;FILE VARf:=sequentialfile(output,teilfenster);IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENholetext1ELSEholetext2FI;f.holetext1:FORiFROM1UPTOzeilenanzahl(objekt.text1.inhalt)REPgetline(objekt.text1.inhalt,i,filetext);putline(f,filetext);PER;.holetext2:FORiFROM1UPTOzeilenanzahl(objekt.text2.inhalt)REPgetline(objekt.text2.inhalt,i,filetext);putline(f,filetext);PER;.END OP FILESUB;PROCblaettere(OUTPUT VARobjekt,INT CONSTfenster):plottenaechsteseite;IF NOT(fenster=blockstartwerte)THENplotterahmendoppelt(objekt);FI.plottenaechsteseite:IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENobjekt.text1.aktzeile:=objekt.text1.naechsteseite;ELIFfenster=blockstartwerteTHENobjekt.startwerte.aktzeile:=objekt.startwerte.naechsteseite;ELSEobjekt.text2.aktzeile:=objekt.text2.naechsteseite;FI;
+SELECTfensterOF CASEfensterganz:plot(fensterganz,objekt.text1)CASEfensteroben:plot(fensteroben,objekt.text1)CASEfensterunten:plot(fensterunten,objekt.text2)CASEfensterrechts:plot(fensterrechts,objekt.text1)CASEfensterrechtsoben:plot(fensterrechtsoben,objekt.text1)CASEfensterrechtsunten:plot(fensterrechtsunten,objekt.text2)CASEblockstartwerte:plot(blockstartwerte,objekt.startwerte)END SELECT.END PROCblaettere;PROCblaettern(OUTPUT VARobjekt):SELECTobjekt.aufbauOF CASEstrukt1fenster:blaettere(objekt,fensterganz)CASEstrukt2diagramme1text:blaettere(objekt,fensterrechts)OTHERWISEerrorstop("falsches Fenster");END SELECT;plotterahmendoppelt(objekt);END PROCblaettern;PROCblaetternoben(OUTPUT VARobjekt):SELECTobjekt.aufbauOF CASEstrukt2texte:blaettere(objekt,fensteroben)CASEstrukt4fenster:blaettere(objekt,fensterrechtsoben)CASEstrukttabelleunten:blaettere(objekt,fensterrechtsoben)CASEstrukttabelleoben:blaettere(objekt,fensteroben)OTHERWISEerrorstop("falsches Fenster");END SELECT;plotterahmendoppelt(objekt);END PROCblaetternoben;PROCblaetternunten(OUTPUT VARobjekt):SELECTobjekt.aufbauOF CASEstrukt2texte:blaettere(objekt,fensterunten)CASEstrukt4fenster:blaettere(objekt,fensterrechtsunten)CASEstrukttabelleunten:blaettere(objekt,fensterunten)CASEstrukttabelleoben:blaettere(objekt,fensterrechtsunten)OTHERWISEerrorstop("falsches Fenster");END SELECT;plotterahmendoppelt(objekt);END PROCblaetternunten;BOOL PROCeof(SIMSELFILE VARn,INT CONSTaktuellezeile):aktuellezeile>zeilenanzahl(n).END PROCeof;OP:=(SIMSELFILE VARa,FILE VARb):INT VARi;input(b);FORiFROM1UPTOmaxfilezeilenWHILE NOTeof(b)REPgetline(b,a.filezeile(i));PER;a.zeilenanzahl:=i-1;END OP:=;OP:=(SIMSELFILE VARa,SIMSELFILE VARb):INT VARi;FORiFROM1UPTOb.zeilenanzahlREPa.filezeile(i):=b.filezeile(i);PER;a.zeilenanzahl:=b.zeilenanzahl;END OP:=;PROCsimselfile(SIMSELFILE VARsf):sf.zeilenanzahl:=0;END PROCsimselfile;PROCgetline(SIMSELFILE VARsf,INT CONSTzeiger,TEXT VARinhalt):IFzeiger<=sf.zeilenanzahlTHENinhalt:=sf.filezeile(zeiger);FI;END PROCgetline;INT PROCzeilenanzahl(SIMSELFILE VARsf):sf.zeilenanzahl.END PROCzeilenanzahl;BOOL VARframe:=TRUE;PROCsetzerahmen(BOOL CONSTx):frame:=xEND PROCsetzerahmen;TEXT PROCkopfzeilezusammenstellen(TEXT CONSTkopfzeilentext,namedesmodells,INT CONSTlaenge):TEXT VARzeilenanfang:=compress(auskunftstext(produktname))+zwischenraum,produktn:=compress(auskunftstext(produktname)),zeilenende:="";IFlength(namedesmodells)<length(produktn)THENzeilenende:=(length(produktn)-length(namedesmodells))*" ";FI;zeilenende:=zeilenende+zwischenraum+namedesmodells;INT VARzeilenrest:=laenge-length(zeilenanfang+zeilenende),blanks:=0;IFzeilenrest<length(kopfzeilentext)THENunterdrueckemodellnameFI;lieferekopfzeile.unterdrueckemodellname:zeilenanfang:=compress(auskunftstext(produktname));zeilenende:="";zeilenrest:=laenge-length(zeilenanfang);.lieferekopfzeile:zeilenrest:=zeilenrest-length(kopfzeilentext);blanks:=zeilenrestDIV2;zeilenanfang+(blanks*" ")+kopfzeilentext+(blanks*" ")+zeilenende.END PROCkopfzeilezusammenstellen;END PACKEToutput;
+
diff --git a/app/schulis-simulationssystem/3.0/src/output test b/app/schulis-simulationssystem/3.0/src/output test
new file mode 100644
index 0000000..5e286ad
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/output test
@@ -0,0 +1,5 @@
+PACKEToutputDEFINES OUTPUT,:=,niloutput,legefensterfest,plotteoutput,realarea,endgeraetbreite,graphikbreite,forget,:LETstrukt1fenster=1,strukt2texte=2,strukt2diagramme1text=3,strukt4fenster=4,strukttabelleunten=5,strukttabelleoben=6,fensterganz=1,fensteroben=2,fensterunten=3,fensterlinksoben=4,fensterlinksunten=5,fensterrechtsoben=6,fensterrechtsunten=7,fensterrechts=8,stdfarbe=1,stddicke=0,durchgezogen=1,hintergrund=0,vordergrund=1,maxpictures=10,blockstartwerte=9,maxfilezeilen=500,anfangszeile=1,typnummer=1055,lkszeilenanfang=4,rtszeilenanfang=42,rtszeilenende=79,obenerstezeile=3,obenletztezeile=12,untenerstezeile=14,untenletztezeile=23;REAL VARdruckerfaktor:=1.0,horcm,vertcm,width,height;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);width:=horcm;height:=vertcm;REAL VARbuchsthoehe:=stdhoehe,buchstbreite:=stdbreite,minyabstand:=0.1,minxabstand:=buchstbreite/3.0;REAL VARhoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,spaltenmitte:=(vertcm)/2.0,oben:=vertcm-hoehe,unten:=hoehe,zeilenmitte:=horcm/2.0,rahmenoben:=vertcm,rahmenunten:=0.0,abstand:=0.1;REAL VARverkleinerunghoehe:=1.57,verkleinerungbreite:=1.2;ROW6PICTURE VARrahmenmitkreuz;erstellerahmen;TYPE OUTPUT=BOUND STRUCT(INTaufbau,TEXTkopfzeilentext,INTschluesselfusszeile,BOOLmitrahmen,REALstandardhoehe,standardbreite,sourcewidth,sourceheight,TEXTmodellbezeichner,dsname,ROW2DIAGRAMMdiag,NURTEXTtext1,text2,startwerte,PICTURErahmen);TYPE NURTEXT=STRUCT(BOOLbelegt,INTaktzeile,naechsteseite,SIMSELFILEinhalt);TYPE DIAGRAMM=STRUCT(BOOLbelegt,INTanzahlpictures,anzahlpicfuerkreuz,REALxmin,xmax,ymin,ymax,ROWmaxpicturesPICTUREkreuz,ROWmaxpicturesPICTUREinhalt);TYPE SIMSELFILE=STRUCT(ROWmaxfilezeilenTEXTfilezeile,INTzeilenanzahl);PROCplotohneclear(DIAGRAMM VARp):INT VARi;PICTURE VARpic;beginplot;FORiFROM1UPTOp.anzahlpicfuerkreuzREPpic:=p.kreuz(i);plottepic;PER;FORiFROM1UPTOp.anzahlpicturesREPpic:=p.inhalt(i);plottepic;PER;endplot.plottepic:IFpen(pic)<>0THENpen(0,stdfarbe,stddicke,pen(pic));plot(pic)FI.END PROCplotohneclear;OP:=(OUTPUT VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCforget(OUTPUT VARalt):forget(alt.dsname,quiet);END PROCforget;DATASPACE PROCniloutput(INT CONSTbildaufbau,TEXT CONSTspacename):OUTPUT VARneu;forget(spacename,quiet);neu:=new(spacename);type(old(spacename),typnummer);neu.aufbau:=bildaufbau;neu.dsname:=spacename;neu.text1.belegt:=FALSE;neu.text1.aktzeile:=anfangszeile;simselfile(neu.text1.inhalt);neu.text1.naechsteseite:=anfangszeile;neu.text2.belegt:=FALSE;neu.text2.aktzeile:=anfangszeile;simselfile(neu.text2.inhalt);neu.text2.naechsteseite:=anfangszeile;neu.startwerte.belegt:=FALSE;neu.startwerte.aktzeile:=anfangszeile;simselfile(neu.startwerte.inhalt);neu.startwerte.naechsteseite:=anfangszeile;neu.standardhoehe:=stdhoehe;neu.standardbreite:=stdbreite;neu.sourcewidth:=horcm;neu.sourceheight:=vertcm;neu.diag(1).belegt:=FALSE;neu.diag(1).anzahlpictures:=0;neu.diag(2).anzahlpictures:=0;neu.diag(1).anzahlpicfuerkreuz:=0;neu.diag(2).anzahlpicfuerkreuz:=0;neu.diag(2).belegt:=FALSE;neu.mitrahmen:=TRUE;neu.rahmen:=rahmenmitkreuz(bildaufbau);old(neu.dsname).END PROCniloutput;PROCerstellerahmen:INT VARi;FORiFROM1UPTO6REPrahmenmitkreuz(i):=erstellerahmen(i)PER;END PROCerstellerahmen;PICTURE PROCerstellerahmen(INT CONSTi):PICTURE VARgrenzen;grenzen:=nilpicture;plrahmenunten;plrahmenlinks;plrahmenoben;plrahmenrechts;innererrahmenoben;innererrahmenunten;erstellekreuz;grenzen.plrahmenunten:movecm(grenzen,links,rahmenunten);drawcm(grenzen,rechts,rahmenunten).plrahmenlinks:movecm(grenzen,links,rahmenunten);drawcm(grenzen,links,rahmenoben).plrahmenoben:movecm(grenzen,links,rahmenoben);drawcm(grenzen,rechts,rahmenoben).plrahmenrechts:movecm(grenzen,rechts,rahmenoben);drawcm(grenzen,rechts,rahmenunten).innererrahmenoben:movecm(grenzen,links,oben);drawcm(grenzen,rechts,oben).innererrahmenunten:movecm(grenzen,links,unten);drawcm(grenzen,rechts,unten).erstellekreuz:SELECTiOF CASEstrukt2texte:waagerechtlks;waagerechtrts;CASEstrukttabelleunten:
+waagerechtlks;waagerechtrts;senkrechtoben;CASEstrukt4fenster:waagerechtlks;waagerechtrts;senkrechtoben;senkrechtunten;CASEstrukttabelleoben:waagerechtlks;waagerechtrts;senkrechtunten;CASEstrukt2diagramme1text:waagerechtlks;senkrechtoben;senkrechtunten;END SELECT;.waagerechtlks:movecm(grenzen,links,spaltenmitte);drawcm(grenzen,zeilenmitte,spaltenmitte).waagerechtrts:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,rechts,spaltenmitte).senkrechtoben:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,oben).senkrechtunten:movecm(grenzen,zeilenmitte,spaltenmitte);drawcm(grenzen,zeilenmitte,unten).END PROCerstellerahmen;PROCplotterahmen(OUTPUT VARoutput):beginplot;clear;pen(hintergrund,vordergrund,stddicke,durchgezogen);viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(0.0,1.0,0.0,1.0);plot(output.rahmen);endplot;END PROCplotterahmen;PROCplotteoutput(THESAURUS CONSTth):do(PROC(TEXT CONST)plotteoutput,th)END PROCplotteoutput;PROCplotteoutput(TEXT CONSTdsname):enablestop;IFexists(dsname)THEN OUTPUT VARobjekt:=old(dsname)IF NOT(type(old(dsname))=typnummer)THENputline("Datenraum hat falschen Typ!");LEAVEplotteoutput;FI;ELSEputline("Datenraum existiert nicht!");LEAVEplotteoutputFI;setzeabmessungenbezueglichendgeraet;beginplot;clear;viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(0.0,1.0,0.0,1.0);pen(0,1,0,1);IFobjekt.mitrahmenTHENplot(objekt.rahmen)FI;plottedarstellung;plotend;.setzeabmessungenbezueglichendgeraet:IFwidth>horcmTHENwidth:=horcmFI;height:=(width/objekt.sourcewidth)*objekt.sourceheight;IFheight>vertcmTHENheight:=vertcm;width:=(height/objekt.sourceheight)*objekt.sourcewidthFI;IFobjekt.mitrahmenTHENhoehe:=objekt.standardhoehe+3.0*minyabstandELSEhoehe:=0.0FI;rechts:=objekt.sourcewidth;spaltenmitte:=objekt.sourceheight/2.0;oben:=objekt.sourceheight-hoehe;unten:=hoehe;zeilenmitte:=objekt.sourcewidth/2.0;rahmenoben:=objekt.sourceheight;rahmenunten:=0.0;abstand:=0.1;druckerfaktor:=width/objekt.sourcewidth;cmfaktor(druckerfaktor).plottedarstellung:SELECTobjekt.aufbauOF CASEstrukt1fenster:IFobjekt.text1.belegtTHENdraw(fensterganz,objekt)ELIFobjekt.diag(1).belegtTHENplot(fensterganz,objekt)FI;CASEstrukt2texte:IFobjekt.text1.belegtTHENdraw(fensteroben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterunten,objekt);FI;CASEstrukt2diagramme1text:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechts,objekt);FI;CASEstrukt4fenster:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechtsoben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterrechtsunten,objekt);FI;CASEstrukttabelleunten:IFobjekt.diag(1).belegtTHENplot(fensterlinksoben,objekt);FI;IFobjekt.text1.belegtTHENdraw(fensterrechtsoben,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterunten,objekt);FI;CASEstrukttabelleoben:IFobjekt.text1.belegtTHENdraw(fensteroben,objekt);FI;IFobjekt.diag(2).belegtTHENplot(fensterlinksunten,objekt);FI;IFobjekt.text2.belegtTHENdraw(fensterrechtsunten,objekt);FI;END SELECT.END PROCplotteoutput;PROCendgeraetbreite(REAL CONSTbreite):width:=min(breite,horcm)END PROCendgeraetbreite;REAL PROCendgeraetbreite:widthEND PROCendgeraetbreite;PROCgraphikbreite(OUTPUT CONSTobj,REAL VARpapierbreite,endbreite):papierbreite:=min(vertcm,papierbreite);endbreite:=papierbreite/obj.sourceheight*obj.sourcewidth;IFendbreite>horcmTHENendbreite:=horcm;papierbreite:=endbreite/obj.sourcewidth*obj.sourceheightFI END PROCgraphikbreite;PROCrealarea(TEXT CONSToutputname,REAL VARquellbreite,quellhoehe):OUTPUT VARobj:=old(outputname);quellbreite:=obj.sourcewidth;quellhoehe:=obj.sourceheightEND PROCrealarea;PROCgibzeileaus(PICTURE VARrandzeile):viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*
+rahmenoben);beginplot;plot(randzeile);endplot;END PROCgibzeileaus;OP:=(OUTPUT VARneu,OUTPUT VARalt):CONCR(neu):=old(alt.dsname)END OP:=;PROCdraw(INT CONSTfenster,OUTPUT VARobjekt):SIMSELFILE VARtxt;IF(fenster=fensterganz)COR(fenster=fensteroben)COR(fenster=fensterrechtsoben)COR(fenster=fensterrechts)THENtxt:=objekt.text1.inhaltELIF(fenster=fensterrechtsunten)COR(fenster=fensterunten)THENtxt:=objekt.text2.inhaltFI;setzefensterdaten;schreibeintextfenster;plottetextfenster;.setzefensterdaten:REAL VARlks,rts,un,ob;legefensterfest(objekt,lks,rts,un,ob,fenster);ob:=ob-objekt.standardhoehe;INT VARzeilenlaenge:=int((rts-lks)/(objekt.standardbreite/verkleinerungbreite));.schreibeintextfenster:PICTURE VARplotobj:=nilpicture;REAL VARzeile:=ob;INT VARzeiger;TEXT VARzeilentext;zeiger:=1;WHILEzeile>unCAND NOTeof(txt,zeiger)REPgetline(txt,zeiger,zeilentext);movecm(plotobj,lks,zeile);draw(plotobj,subtext(zeilentext,1,zeilenlaenge),0.0,objekt.standardhoehe/verkleinerunghoehe,objekt.standardbreite/verkleinerungbreite);zeigerINCR1;zeile:=zeile-(objekt.standardhoehe/verkleinerunghoehe)-abstand;PER;.plottetextfenster:viewport(druckerfaktor*lks,druckerfaktor*rts,druckerfaktor*un,druckerfaktor*ob);window(0.0,1.0,0.0,1.0);beginplot;pen(0,stdfarbe,stddicke,durchgezogen);plot(plotobj);endplot;.END PROCdraw;PROCplot(INT CONSTfenster,OUTPUT VARobj):DIAGRAMM VARdiagramm;IF(fenster=fensterganz)COR(fenster=fensterlinksoben)THENdiagramm:=obj.diag(1)ELSEdiagramm:=obj.diag(2)FI;REAL VARx1,x2,y1,y2;IFdiagramm.belegtTHENplottediagr;FI;.plottediagr:legefensterfest(obj,x1,x2,y1,y2,fenster);window(diagramm.xmin,diagramm.xmax,diagramm.ymin,diagramm.ymax);viewport(druckerfaktor*x1,druckerfaktor*x2,druckerfaktor*y1,druckerfaktor*y2);plotohneclear(diagramm);.END PROCplot;PROClegefensterfest(OUTPUT VARobj,REAL VARlks,rts,un,ob,INT CONSTfensterlage):SELECTfensterlageOF CASEfensterganz:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=obj.sourcewidth-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=obj.sourceheight-hoehe-abstand-obj.standardhoehe;CASEfensteroben:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=(obj.sourceheight/2.0)+(3.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterunten:lks:=(3.0*abstand)+2.0*obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=hoehe+(3.0*abstand);ob:=(obj.sourceheight/2.0)-2.0*abstand;CASEfensterlinksoben:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(obj.sourcewidth/2.0)-2.0*abstand;un:=(obj.sourceheight/2.0)+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=obj.sourceheight-hoehe-abstand-obj.standardhoehe;CASEfensterlinksunten:lks:=(3.0*abstand)+(8.5*obj.standardbreite);rts:=(obj.sourcewidth/2.0)-2.0*abstand;un:=hoehe+(2.0*obj.standardhoehe)+(4.0*abstand);ob:=(obj.sourceheight/2.0)-abstand-obj.standardhoehe;CASEfensterrechts:lks:=obj.sourcewidth/2.0+(3.0*abstand)+obj.standardbreite;rts:=obj.sourcewidth-abstand;un:=hoehe+(2.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterrechtsoben:lks:=obj.sourcewidth/2.0+(2.0*abstand);rts:=obj.sourcewidth-abstand;un:=(obj.sourceheight/2.0)+(2.0*abstand);ob:=obj.sourceheight-hoehe-2.0*abstand;CASEfensterrechtsunten:lks:=obj.sourcewidth/2.0+(2.0*abstand);rts:=obj.sourcewidth-abstand;un:=hoehe+(2.0*abstand);ob:=(obj.sourceheight/2.0)-2.0*abstand;END SELECT;END PROClegefensterfest;PROClegefensterfest(INT VARlks,rts,un,ob,INT CONSTfensterlage,):SELECTfensterlageOF CASEfensterganz:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;CASEfensteroben:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterunten:lks:=lkszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechtsoben:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=obenletztezeile;ob:=obenerstezeile;CASEfensterrechtsunten:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=untenerstezeile;CASEfensterrechts:lks:=rtszeilenanfang;rts:=rtszeilenende;un:=untenletztezeile;ob:=obenerstezeile;
+CASEblockstartwerte:lks:=40+1;rts:=78;un:=12;ob:=3;END SELECT;END PROClegefensterfest;OP:=(DIAGRAMM VARa,DIAGRAMM CONSTb):INT VARi;FORiFROM1UPTOb.anzahlpicturesREPa.inhalt(i):=b.inhalt(i)PER;FORiFROMb.anzahlpictures+1UPTOmaxpicturesREPa.inhalt(i):=nilpicture;PER;FORiFROM1UPTOb.anzahlpicfuerkreuzREPa.kreuz(i):=b.kreuz(i)PER;FORiFROMb.anzahlpicfuerkreuz+1UPTOmaxpicturesREPa.kreuz(i):=nilpicture;PER;a.belegt:=b.belegt;a.anzahlpictures:=b.anzahlpictures;a.anzahlpicfuerkreuz:=b.anzahlpicfuerkreuz;a.xmin:=b.xmin;a.xmax:=b.xmax;a.ymin:=b.ymin;a.ymax:=b.ymax;END OP:=;BOOL PROCeof(SIMSELFILE VARn,INT CONSTaktuellezeile):aktuellezeile>zeilenanzahl(n).END PROCeof;OP:=(SIMSELFILE VARa,FILE VARb):INT VARi;input(b);FORiFROM1UPTOmaxfilezeilenWHILE NOTeof(b)REPgetline(b,a.filezeile(i));PER;a.zeilenanzahl:=i-1;END OP:=;OP:=(SIMSELFILE VARa,SIMSELFILE VARb):INT VARi;FORiFROM1UPTOb.zeilenanzahlREPa.filezeile(i):=b.filezeile(i);PER;a.zeilenanzahl:=b.zeilenanzahl;END OP:=;PROCsimselfile(SIMSELFILE VARsf):sf.zeilenanzahl:=0;END PROCsimselfile;PROCgetline(SIMSELFILE VARsf,INT CONSTzeiger,TEXT VARinhalt):IFzeiger<=sf.zeilenanzahlTHENinhalt:=sf.filezeile(zeiger);FI;END PROCgetline;INT PROCzeilenanzahl(SIMSELFILE VARsf):sf.zeilenanzahl.END PROCzeilenanzahl;END PACKEToutput;
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel basis plot b/app/schulis-simulationssystem/3.0/src/simsel basis plot
new file mode 100644
index 0000000..a4bf17d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel basis plot
@@ -0,0 +1,4 @@
+PACKETsimselbasisplotDEFINEStransform,setvalues,getvalues,getparameter,putparameter,newvalues,drawingarea,window,viewport,view,box,move,draw,mover,drawr,movecm,drawcm,movecmr,drawcmr,kreispunkte,circle,where:BOOL VARnewlimits:=TRUE,valuesnew:=TRUE,perspectiveprojektion:=FALSE;INT VARpixelhor,pixelvert;REAL VARdisplayhor,displayvert,sizehor,sizevert;drawingarea(sizehor,sizevert,pixelhor,pixelvert);displayhor:=real(pixelhor);displayvert:=real(pixelvert);REAL VARhminlimit:=0.0,hmaxlimit:=displayhor,vminlimit:=0.0,vmaxlimit:=displayvert,hmin:=0.0,hmax:=sizehor,vmin:=0.0,vmax:=sizevert,horrelation:=displayhor/sizehor,vertrelation:=displayvert/sizevert,relation:=sizehor/sizevert;ROW5ROW5REAL VARp:=ROW5ROW5REAL:(ROW5REAL:(1.0,0.0,0.0,0.0,0.0),ROW5REAL:(0.0,1.0,0.0,0.0,0.0),ROW5REAL:(0.0,0.0,1.0,0.0,0.0),ROW5REAL:(0.0,0.0,0.0,1.0,0.0),ROW5REAL:(0.0,0.0,0.0,0.0,1.0));ROW3ROW2REAL VARsized:=ROW3ROW2REAL:(ROW2REAL:(0.0,1.0),ROW2REAL:(0.0,1.0),ROW2REAL:(0.0,1.0));ROW2ROW2REAL VARlimitsd:=ROW2ROW2REAL:(ROW2REAL:(0.0,relation),ROW2REAL:(0.0,1.0));ROW4REAL VARanglesd:=ROW4REAL:(0.0,0.0,0.0,0.0);ROW2REAL VARobliqued:=ROW2REAL:(0.0,0.0);ROW3REAL VARperspectived:=ROW3REAL:(0.0,0.0,0.0);REAL VARsizehord:=sizehor,sizevertd:=sizevert;INT VARpixelhord:=pixelhor,pixelvertd:=pixelvert;INT VARi,j;REAL VARkreisschritt:=18.0;PROCkreispunkte(INT CONSTp):kreisschritt:=360.0/real(p)END PROCkreispunkte;BOOL OP=(ROW3ROW2REAL CONSTl,r):FORiFROM1UPTO3REP IFl[i][1]<>r[i][1]ORl[i][2]<>r[i][2]THEN LEAVE=WITH FALSE FI PER;TRUE END OP=;BOOL OP=(ROW2ROW2REAL CONSTl,r):FORiFROM1UPTO2REP IFl[i][1]<>r[i][1]ORl[i][2]<>r[i][2]THEN LEAVE=WITH FALSE FI PER;TRUE END OP=;BOOL OP=(ROW2REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]END OP=;BOOL OP=(ROW3REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]ANDl[3]=r[3]END OP=;BOOL OP=(ROW4REAL CONSTl,r):l[1]=r[1]ANDl[2]=r[2]ANDl[3]=r[3]ANDl[4]=r[4]END OP=;PROCwindow(BOOL CONSTdev):newlimits:=devEND PROCwindow;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax):window(xmin,xmax,ymin,ymax,0.0,1.0)END PROCwindow;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax,zmin,zmax):setvalues(ROW3ROW2REAL:(ROW2REAL:(xmin,xmax),ROW2REAL:(ymin,ymax),ROW2REAL:(zmin,zmax)),limitsd,anglesd,obliqued,perspectived)END PROCwindow;PROCviewport(REAL CONSThmin,hmax,vmin,vmax):setvalues(sized,ROW2ROW2REAL:(ROW2REAL:(hmin,hmax),ROW2REAL:(vmin,vmax)),anglesd,obliqued,perspectived)END PROCviewport;PROCview(REAL CONSTalpha):setvalues(sized,limitsd,ROW4REAL:(alpha,anglesd(2),anglesd(3),anglesd(4)),obliqued,perspectived)END PROCview;PROCview(REAL CONSTphi,theta):setvalues(sized,limitsd,ROW4REAL:(anglesd(1),sind(theta)*cosd(phi),sind(theta)*sind(phi),cosd(theta)),obliqued,perspectived)END PROCview;PROCview(REAL CONSTx,y,z):setvalues(sized,limitsd,ROW4REAL:(anglesd(1),x,y,z),obliqued,perspectived)END PROCview;setvalues(sized,limitsd,anglesd,obliqued,perspectived);PROCdrawingarea(REAL VARminh,maxh,minv,maxv):minh:=hminlimit;maxh:=hmaxlimit;minv:=vminlimit;maxv:=vmaxlimitEND PROCdrawingarea;BOOL PROCnewvalues:IFvaluesnewTHENvaluesnew:=FALSE;TRUE ELSE FALSE FI END PROCnewvalues;PROCgetparameter(ROW5ROW5REAL VARvalues):values:=p;END PROCgetparameter;PROCputparameter(ROW5ROW5REAL CONSTvalues):p:=values;END PROCputparameter;PROCgetvalues(ROW3ROW2REAL VARsize,ROW2ROW2REAL VARlimits,ROW4REAL VARangles,ROW2REAL VARoblique,ROW3REAL VARperspective):size:=sized;limits:=limitsd;angles:=anglesd;oblique:=obliqued;perspective:=perspectived;END PROCgetvalues;PROCsetvalues(ROW3ROW2REAL CONSTsize,ROW2ROW2REAL CONSTlimits,ROW4REAL CONSTangles,ROW2REAL CONSToblique,ROW3REAL CONSTperspective):drawingarea(sizehor,sizevert,pixelhor,pixelvert);displayhor:=real(pixelhor);displayvert:=real(pixelvert);IF NOTsamevaluesTHENvaluesnew:=TRUE;copyvalues;setviews;checkperspectiveprojektion;calclimits;changeprojektionFI.samevalues:sizehord=sizehorANDsizevertd=sizevertANDpixelhord=pixelhorANDpixelvertd=pixelvertANDsized=sizeANDlimitsd=limitsANDanglesd=anglesANDobliqued=obliqueANDperspectived=perspective.copyvalues:sizehord:=sizehor;sizevertd:=
+sizevert;pixelhord:=pixelhor;pixelvertd:=pixelvert;hmaxlimit:=displayhor;vmaxlimit:=displayvert;hmax:=sizehor;vmax:=sizevert;horrelation:=displayhor/sizehor;vertrelation:=displayvert/sizevert;relation:=sizehor/sizevert;sized:=size;limitsd:=limits;anglesd:=angles;obliqued:=oblique;perspectived:=perspective.setviews:REAL VARdiagonale:=sqrt(angles[2]*angles[2]+angles[3]*angles[3]+angles[4]*angles[4]),projektion:=sqrt(angles[2]*angles[2]+angles[4]*angles[4]),sinp,cosp,sint,cost,sina,cosa;IFdiagonale=0.0THENsinp:=0.0;cosp:=1.0;sint:=0.0;cost:=1.0ELIFprojektion=0.0THENsinp:=angles[3]/diagonale;cosp:=projektion/diagonale;sint:=0.0;cost:=1.0ELSEsinp:=angles[3]/diagonale;cosp:=projektion/diagonale;sint:=angles[2]/projektion;cost:=angles[4]/projektionFI;REAL VARsinpsint:=sinp*sint,sinpcost:=sinp*cost,cospsint:=cosp*sint,cospcost:=cosp*cost,dx:=size[1][2]-size[1][1],dy:=size[2][2]-size[2][1],dz:=size[3][2]-size[3][1],normaz:=oblique[1],normbz:=oblique[2],normcx:=perspective[1]/dx,normcy:=perspective[2]/dy,normcz:=perspective[3]/dz;p:=ROW5ROW5REAL:(ROW5REAL:(cost/dx-cospsint/dx*normaz,-sinpsint/dx-cospsint/dx*normbz,0.0,-cospsint/dx*normcz,0.0),ROW5REAL:(-sinp/dy*normaz,cosp/dy-sinp/dy*normbz,0.0,-sinp/dy*normcz,0.0),ROW5REAL:(sint/dz+cospcost/dz*normaz,+sinpcost/dz+cospcost/dz*normbz,0.0,cospcost/dz*normcz,0.0),ROW5REAL:(-normcx,-normcy,0.0,1.0,0.0),ROW5REAL:(0.0,0.0,0.0,0.0,1.0));IFangles(1)=0.0THENsetalphaasyverticalELSEsina:=sind(angles(1));cosa:=cosd(angles(1))FI;FORjFROM1UPTO5REP REAL CONSTpj1:=p(j)(1);p(j)(1):=pj1*cosa-p(j)(2)*sina;p(j)(2):=pj1*sina+p(j)(2)*cosaPER.setalphaasyvertical:REAL VARr:=sqrt(p(2)(1)**2+p(2)(2)**2);IFr=0.0THENsina:=0.0;cosa:=1.0ELSEsina:=-p(2)(1)/r;cosa:=p(2)(2)/rFI.checkperspectiveprojektion:perspectiveprojektion:=perspective[3]<>0.0.calclimits:IFnewlimitsTHENcalctwodimextrema;IFalllimitssmallerthan2THENprozenteELSEzentimeterFI FI.calctwodimextrema:hmin:=maxreal;hmax:=-maxreal;vmin:=maxreal;vmax:=-maxreal;extrema(size[1][1],size[2][1],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][1],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][2],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][2],size[3][1],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][1],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][1],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][2],size[2][2],size[3][2],hmin,hmax,vmin,vmax);extrema(size[1][1],size[2][2],size[3][2],hmin,hmax,vmin,vmax).alllimitssmallerthan2:limits(1)(2)<2.0ANDlimits(2)(2)<2.0.prozente:hminlimit:=displayhor*limits(1)(1)/relation;hmaxlimit:=displayhor*limits(1)(2)/relation;vminlimit:=limits(2)(1)*displayvert;vmaxlimit:=limits(2)(2)*displayvert.zentimeter:hminlimit:=displayhor*(limits(1)(1)/sizehor);hmaxlimit:=displayhor*(limits(1)(2)/sizehor);vminlimit:=displayvert*(limits(2)(1)/sizevert);vmaxlimit:=displayvert*(limits(2)(2)/sizevert).changeprojektion:REAL VARsh:=(hmaxlimit-hminlimit)/(hmax-hmin),sv:=(vmaxlimit-vminlimit)/(vmax-vmin),dh:=hminlimit-hmin*sh,dv:=vminlimit-vmin*sv;FORjFROM1UPTO5REPp(j)(1):=p(j)(1)*sh;p(j)(2):=p(j)(2)*svPER;p(5)(1):=dh;p(5)(2):=dv.END PROCsetvalues;PROCtransform(REAL CONSTx,y,z,INT VARh,v):disablestop;IFperspectiveprojektionTHEN REAL CONSTw:=1.0/(x*p(1)(4)+y*p(2)(4)+z*p(3)(4)+1.0);h:=int((x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(4)(1))*w+p(5)(1));v:=int((x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(4)(2))*w+p(5)(2))ELSEh:=int(x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(5)(1));v:=int(x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(5)(2));FI;IFiserrorTHENh:=-1;v:=-1;clearerror;FI;enablestop;END PROCtransform;PROCextrema(REAL CONSTx,y,z,REAL VARhmin,hmax,vmin,vmax):REAL VARh,v;IFperspectiveprojektionTHEN REAL CONSTw:=1.0/(x*p(1)(4)+y*p(2)(4)+z*p(3)(4)+1.0);h:=(x*p(1)(1)+y*p(2)(1)+z*p(3)(1)+p(4)(1))*w;v:=(x*p(1)(2)+y*p(2)(2)+z*p(3)(2)+p(4)(2))*wELSEh:=(x*p(1)(1)+y*p(2)(1)+z*p(3)(1));v:=(x*p(1)(2)+y*p(2)(2)+z*p(3)(2))FI;IFh<hminTHENhmin:=hELIFh>hmaxTHENhmax:=hFI;IFv<vminTHENvmin:=vELIFv>vmaxTHENvmax:=vFI END PROCextrema;LET POS=STRUCT(REALx,y,z);POS VARpos:=POS
+:(0.0,0.0,0.0);INT VARh:=0,v:=0;PROCbox:move(int(hminlimit+0.5),int(vminlimit+0.5));draw(int(hmaxlimit+0.5),int(vminlimit+0.5));draw(int(hmaxlimit+0.5),int(vmaxlimit+0.5));draw(int(hminlimit+0.5),int(vmaxlimit+0.5));draw(int(hminlimit+0.5),int(vminlimit+0.5))END PROCbox;PROCmove(REAL CONSTx,y):transform(x,y,0.0,h,v);move(h,v);pos:=POS:(x,y,0.0)END PROCmove;PROCdraw(REAL CONSTx,y):transform(x,y,0.0,h,v);draw(h,v);pos:=POS:(x,y,0.0)END PROCdraw;PROCmover(REAL CONSTx,y):transform(pos.x+x,pos.y+y,pos.z,h,v);move(h,v);pos:=POS:(pos.x+x,pos.y+y,pos.z)END PROCmover;PROCdrawr(REAL CONSTx,y):transform(pos.x+x,pos.y+y,pos.z,h,v);draw(h,v);pos:=POS:(pos.x+x,pos.y+y,pos.z)END PROCdrawr;PROCmovecm(REAL CONSTxcm,ycm):h:=int(xcm*horrelation+0.5);v:=int(ycm*vertrelation+0.5);move(h,v)END PROCmovecm;PROCdrawcm(REAL CONSTxcm,ycm):h:=int(xcm*horrelation+0.5);v:=int(ycm*vertrelation+0.5);draw(h,v);END PROCdrawcm;PROCmovecmr(REAL CONSTxcm,ycm):hINCRint(xcm*horrelation+0.5);vINCRint(ycm*vertrelation+0.5);move(h,v)END PROCmovecmr;PROCdrawcmr(REAL CONSTxcm,ycm):hINCRint(xcm*horrelation+0.5);vINCRint(ycm*vertrelation+0.5);draw(h,v)END PROCdrawcmr;PROCwhere(REAL VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;PROCcircle(REAL CONSTr,from,to,INT CONSTpattern):REAL VARt:=from;INT VARi,j;transform(pos.x,pos.y,0.0,h,v);i:=h;j:=v;h:=i+int(horrelation*r*cosd(t));v:=j+int(vertrelation*r*sind(t));WHILEt<=toREPh:=i+int(horrelation*r*cosd(t));v:=j+int(vertrelation*r*sind(t));draw(h,v);tINCRkreisschrittPER;draw(h,v).END PROCcircle;ENDPACKETsimselbasisplot;
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel cga plot b/app/schulis-simulationssystem/3.0/src/simsel cga plot
new file mode 100644
index 0000000..03b2685
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel cga plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldout,oldcursor,oldgetcursor:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETcgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,out,cursor,getcursor,zeichensatz:LEThorfaktor=29.09091,vertfaktor=14.59854,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,anzahlx=640,anzahly=200,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.525167,buchstabenbreite:=0.275;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IF(textcopySUB1)>code(31)THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die CGA-Karte (oder eine kompatible");putline("Karte, z.B. EGA-Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE;ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE;ENDPROCplotend;PROCclear:control(-5,6,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,anzahly-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;
+yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,anzahly-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,anzahly-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>anzahlx-1THENxwert:=anzahlx-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>anzahly-1THENywert:=anzahly-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETcgaplot;zeichensatz("ZEICHEN 8*8")
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel ega plot b/app/schulis-simulationssystem/3.0/src/simsel ega plot
new file mode 100644
index 0000000..07f7fe3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel ega plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,cursor,getcursor,out,zeichensatz:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xpixel-1;y:=ypixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:1CASEkurzgestrichelt:2CASElanggestrichelt:3CASEstrichpunkt:4OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold;.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+y;PER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy);control(-6,pos.x,ypixel-1-pos.y,dummy);control(-7,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROC
+grenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>xpixel-1THENxwert:=xpixel-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>ypixel-1THENywert:=ypixel-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETegaplot;zeichensatz("ZEICHEN 8*14")
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel formulare b/app/schulis-simulationssystem/3.0/src/simsel formulare
new file mode 100644
index 0000000..b7a1377
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel formulare
diff --git a/app/schulis-simulationssystem/3.0/src/simsel hercules plot b/app/schulis-simulationssystem/3.0/src/simsel hercules plot
new file mode 100644
index 0000000..b0b61a3
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel hercules plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,drawingarea:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0);END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy);CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy);CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy);CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy);CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy);OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy);ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):control(-7,x,347-y,dummy);xalt:=x;yalt:=y;END OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIV
+zeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an   ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14")
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel picture b/app/schulis-simulationssystem/3.0/src/simsel picture
new file mode 100644
index 0000000..52ee52d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel picture
@@ -0,0 +1,3 @@
+PACKETsimselpictureDEFINES PICTURE,:=,CAT,nilpicture,cmfaktor,draw,drawr,drawcm,drawcmr,move,mover,movecm,movecmr,circle,length,dim,pen,where,extrema,rotate,stretch,translate,text,picture,plot:LETdrawkey=1,movekey=2,textkey=3,moverkey=4,drawrkey=5,movecmkey=6,drawcmkey=7,movecmrkey=8,drawcmrkey=9,circlekey=11,max2dim=31983,maxtext=31974,maxbar=31982,maxcircle=31974,maxlength=32000;TYPE PICTURE=STRUCT(INTdim,pen,TEXTpoints);INT VARreadpos;REAL VARx,y,z,fak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��",i2:="����";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;OP CAT(PICTURE VARl,PICTURE CONSTr):IFl.dim<>r.dimTHENerrorstop("OP CAT : left dimension <> right dimension")ELIFlength(l.points)>maxlength-length(r.points)THENerrorstop("OP CAT : Picture overflow")FI;l.pointsCATr.pointsEND OP CAT;PICTURE PROCnilpicture:PICTURE:(2,1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCcmfaktor(REAL CONSTn):fak:=nEND PROCcmfaktor;PROCdraw(PICTURE VARp,TEXT CONSTtext,REAL CONSTangle,height,bright):write(p,text,angle,height,bright,textkey)END PROCdraw;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCdrawr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawrkey)END PROCdrawr;PROCdrawcm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmkey)END PROCdrawcm;PROCdrawcmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmrkey)END PROCdrawcmr;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCmover(PICTURE VARp,REAL CONSTx,y):write(p,x,y,moverkey)END PROCmover;PROCmovecm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmkey)END PROCmovecm;PROCmovecmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmrkey)END PROCmovecmr;PROCcircle(PICTURE VARp,REAL CONSTradius,from,to,INT CONSTpattern):write(p,radius,from,to,pattern,circlekey)END PROCcircle;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTkey):IFlength(p.points)<max2dimTHENp.pointsCATcode(key);replace(r2,1,x);replace(r2,2,y);p.pointsCATr2ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTn,key):IFlength(p.points)<maxbarTHENp.pointsCATcode(key);replace(r2,1,x);replace(r2,2,y);p.pointsCATr2;replace(i1,1,n);p.pointsCATi1ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCwrite(PICTURE VARp,REAL CONSTx,y,z,INT CONSTn,key):IFlength(p.points)<maxcircleTHENp.pointsCATcode(key);replace(r3,1,x);replace(r3,2,y);replace(r3,3,z);p.pointsCATr3;replace(i1,1,n);p.pointsCATi1ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCwrite(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright,INT CONSTkey):IFmaxtext-length(p.points)>=length(t)THENp.pointsCATcode(key);replace(i1,1,length(t));p.pointsCATi1;p.pointsCATt;replace(r3,1,angle);replace(r3,2,height);replace(r3,3,bright);p.pointsCATr3FI;END PROCwrite;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;INT PROCdim(PICTURE CONSTpic):pic.dimEND PROCdim;PROCpen(PICTURE VARp,INT CONSTpen):IFpen<0ORpen>16THENerrorstop("pen out of range [0-16]")FI;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;PROCwhere(PICTURE CONSTp,REAL VARx,y):IFp.dim=0THENx:=0.0;y:=0.0ELIFp.dim=3THENerrorstop("Picture is 3 dimensional")ELSEx:=subtext(p.points,length(p.points)-15,length(p.points)-8)RSUB1;y:=subtext(p.points,length(p.points)-7,length(p.points))RSUB1FI END PROCwhere;PROCextrema(PICTURE CONSTp,REAL VARxmin,xmax,ymin,ymax):xmin:=maxreal;xmax:=-maxreal;ymin:=maxreal;ymax:=-maxreal;readpos:=0;INT CONSTpiclength:=length(p.points);WHILEreadpos<piclengthREPcheckpositionPER.checkposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:calcextremaCASEmovekey:calcextremaCASEmoverkey:calcrelextremaCASEdrawrkey:calcrelextremaCASEmovecmkey:readposINCR16CASEdrawcmkey:readposINCR16CASEmovecmrkey:readposINCR16CASEdrawcmrkey:readposINCR16CASEtextkey:readposINCRnextint+24CASEcirclekey:readposINCR26OTHERWISEerrorstop("wrong key code")END SELECT.calcextrema:x:=nextreal;y:=nextreal;xmin:=min(xmin,x);xmax:=max(xmax,x);ymin:=min(ymin,y);ymax:=
+max(ymax,y).calcrelextrema:xINCRnextreal;yINCRnextreal;xmin:=min(xmin,x);xmax:=max(xmax,x);ymin:=min(ymin,y);ymax:=max(ymax,y).nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.END PROCextrema;PROCrotate(PICTURE VARp,REAL CONSTangle):REAL CONSTs:=sind(angle),c:=cosd(angle);transform(p,ROW4ROW3REAL:(ROW3REAL:(1.0,0.0,0.0),ROW3REAL:(0.0,c,s),ROW3REAL:(0.0,-s,c),ROW3REAL:(0.0,0.0,0.0)))END PROCrotate;PROCstretch(PICTURE VARpic,REAL CONSTsx,sy):stretch(pic,sx,sy,1.0)END PROCstretch;PROCstretch(PICTURE VARp,REAL CONSTsx,sy,sz):transform(p,ROW4ROW3REAL:(ROW3REAL:(sx,0.0,0.0),ROW3REAL:(0.0,sy,0.0),ROW3REAL:(0.0,0.0,sz),ROW3REAL:(0.0,0.0,0.0)))END PROCstretch;PROCtranslate(PICTURE VARp,REAL CONSTdx,dy):translate(p,dx,dy,0.0)END PROCtranslate;PROCtranslate(PICTURE VARp,REAL CONSTdx,dy,dz):transform(p,ROW4ROW3REAL:(ROW3REAL:(1.0,0.0,0.0),ROW3REAL:(0.0,1.0,0.0),ROW3REAL:(0.0,0.0,1.0),ROW3REAL:(dx,dy,dz)))END PROCtranslate;PROCtransform(PICTURE VARp,ROW4ROW3REAL CONSTa):INT CONSTpiclength:=length(p.points);INT VARbeginpos;readpos:=0;x:=0.0;y:=0.0;z:=0.0;transform2dimpic.transform2dimpic:WHILEreadpos<piclengthREPtransform2dimpositionPER.transform2dimposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:transform2dimpointCASEmovekey:transform2dimpointCASEmoverkey:transform2dimpointCASEdrawrkey:transform2dimpointCASEmovecmkey:readposINCR16CASEdrawcmkey:readposINCR16CASEmovecmrkey:readposINCR16CASEdrawcmrkey:readposINCR16CASEtextkey:readposINCRnextint+24CASEcirclekey:readposINCR26OTHERWISEerrorstop("wrong key code")END SELECT.transform2dimpoint:beginpos:=readpos+1;x:=nextreal;y:=nextreal;transform(a,x,y,z);replace(r2,1,x);replace(r2,2,y);replace(p.points,beginpos,r2).nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.END PROCtransform;PROCtransform(ROW4ROW3REAL CONSTa,REAL VARx,y,z):REAL CONSTox:=x,oy:=y,oz:=z;x:=ox*a(1)(1)+oy*a(2)(1)+oz*a(3)(1)+a(4)(1);y:=ox*a(1)(2)+oy*a(2)(2)+oz*a(3)(2)+a(4)(2);z:=ox*a(1)(3)+oy*a(2)(3)+oz*a(3)(3)+a(4)(3)END PROCtransform;TEXT PROCtext(PICTURE CONSTpic):replace(i2,1,pic.dim);replace(i2,2,pic.pen);i2+pic.pointsEND PROCtext;PICTURE PROCpicture(TEXT CONSTtext):PICTURE:(textISUB1,textISUB2,subtext(text,5))END PROCpicture;PROCplot(PICTURE CONSTp):INT CONSTpiclength:=length(p.points);readpos:=0;plottwodimpic.plottwodimpic:WHILEreadpos<piclengthREPplottwodimpositionPER.plottwodimposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:draw(nextreal,nextreal)CASEmovekey:move(nextreal,nextreal)CASEmoverkey:mover(nextreal,nextreal)CASEdrawrkey:drawr(nextreal,nextreal)CASEmovecmkey:movecm(fak*nextreal,fak*nextreal)CASEdrawcmkey:drawcm(fak*nextreal,fak*nextreal)CASEmovecmrkey:movecmr(fak*nextreal,fak*nextreal)CASEdrawcmrkey:drawcmr(fak*nextreal,fak*nextreal)CASEtextkey:draw(nexttext,nextreal,fak*nextreal,fak*nextreal)CASEcirclekey:circle(fak*nextreal,nextreal,nextreal,nextint)OTHERWISEerrorstop("wrong key code")END SELECT.nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.nexttext:INT CONSTtextlength:=nextint;readposINCRtextlength;subtext(p.points,readpos-textlength+1,readpos).END PROCplot;END PACKETsimselpicture;
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel vga plot b/app/schulis-simulationssystem/3.0/src/simsel vga plot
new file mode 100644
index 0000000..c222eb7
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel vga plot
@@ -0,0 +1,3 @@
+PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETvgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,clear,pen,move,draw,cursor,getcursor,out,zeichensatz:LEThorfaktor=29.09091,vertfaktor=35.0365,anzahlx=640,anzahly=480,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=480,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die VGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz ""+name+"" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,17,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):INT VARxx:=x,yy:=y;pos.xDRAWpos.y;grenzkontrolle(xx,yy);control(-6,xx,ypixel-1-yy,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;
+grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):INT VARxwert,ywert;IFx>xpixel-1THENxwert:=xpixel-1ELIFx<0THENxwert:=0ELSExwert:=xFI;IFy>ypixel-1THENywert:=ypixel-1ELIFy<0THENywert:=0ELSEywert:=yFI;x:=xwert;y:=ywert;END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19")
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel.druckermenu b/app/schulis-simulationssystem/3.0/src/simsel.druckermenu
new file mode 100644
index 0000000..16f983e
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel.druckermenu
@@ -0,0 +1,2 @@
+PACKETdruckermenuDEFINESdruckeingang,druckezeichnungen,loeschezeichnungen,stellezeichenbreiteein,definieredruckerkanal,stoppedrucker,plottereingestellt:LETdepottaskname="SIMSEL-PRINTERDEPOT",druckprocindex=1,loeschprocindex=2,untenlinks=3,zentral=5,bell="�",abbruch="!",niltext="",arbeitertaskname="workertask",minimalekanalnr=2,maximalekanalnr=32,text1="Bitte warten bis der letzte Druckauftrag bearbeitet ist.",text2="Drucken von Zeichnungen",text3="Auswahl der Zeichnungen durch ankreuzen",text4="Löschen von Zeichnungen",text5="Sollen die ausgewählten Zeichnungen gelöscht werden",text6="Die Zeichnungen werden gelöscht: ",text7=" Wert zwischen 5.0 cm und ",text8=" cm eingeben! ",text9=" Bitte Zahl zwischen 2 und 32 für Kanalnummer des Druckers eingeben! ",text10="Speicher für Zeichnungen ist nicht eingerichtet.",text11="Ist für die nächste Zeichnung Papier eingelegt",text12="Auswahl einer Zeichnung durch ankreuzen";TEXT VARzeichnungsname;TASK VARarbeitertask,depottask;BOOL VARplotteraktiv:=TRUE;THESAURUS VARauswahl;PROCdruckeingang:IF NOTexiststask(depottaskname)THENerrorstop(text10)END IF;depottask:=/depottaskname;IFhighestentry(ALLdepottask)=0THENdeactivate(druckprocindex);deactivate(loeschprocindex)ELSEactivate(druckprocindex);activate(loeschprocindex)END IF END PROCdruckeingang;PROCdruckezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEdruckezeichnungenEND IF;IF NOTplottereingestelltTHENauswahl:=menusome(ALLdepottask,text2,text3,TRUE);IFnotempty(auswahl)THENbegin(arbeitertaskname,PROCzeichnungendrucken,arbeitertask)END IF ELSEzeichnungsname:=menuone(ALLdepottask,text2,text12,TRUE);IFzeichnungsname<>niltextCANDmenuyes(text11,zentral)THENbegin(arbeitertaskname,PROCdruckeeinezeichnung,arbeitertask)END IF END IF END PROCdruckezeichnungen;PROCzeichnungendrucken:disablestop;fetch(auswahl,depottask);plotteoutput(auswahl);end(myself)END PROCzeichnungendrucken;PROCdruckeeinezeichnung:disablestop;fetch(zeichnungsname,depottask);plotteoutput(zeichnungsname);end(myself)END PROCdruckeeinezeichnung;PROCloeschezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEloeschezeichnungenEND IF;auswahl:=menusome(ALLdepottask,text4,text3,TRUE);IF NOTnotempty(auswahl)THEN LEAVEloeschezeichnungenEND IF;IFmenuyes(text5,zentral)THENcommanddialogue(FALSE);footnote(text6);cursor(36,24);erase(auswahl,depottask);commanddialogue(TRUE);oldfootnote;druckeingangEND IF END PROCloeschezeichnungen;PROCstellezeichenbreiteein:LETminimum=5.0;REAL VARmaximum,maxlaenge,breite;INT VARxpixel,ypixel;TEXT VAReingabe;drawingarea(maximum,maxlaenge,xpixel,ypixel);maximum:=floor(maximum);IFendgeraetbreite>maximumTHENendgeraetbreite(maximum)END IF;REPeingabe:=menuanswer(text7+text(maximum)+text8,text(endgeraetbreite),zentral);IFcompress(eingabe)=niltextTHEN LEAVEstellezeichenbreiteeinEND IF;breite:=real(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHENendgeraetbreite(breite);LEAVEstellezeichenbreiteeinEND IF;out(bell)END REP END PROCstellezeichenbreiteein;PROCdefinieredruckerkanal:TEXT VAReingabe;INT VARnr;REPeingabe:=menuanswer(text9,text(plotterkanal),zentral);IFcompress(eingabe)=niltextTHEN LEAVEdefinieredruckerkanalEND IF;nr:=int(eingabe);IFlastconversionokCANDnr>=minimalekanalnrCANDnr<=maximalekanalnrTHENplotterkanal(nr);LEAVEdefinieredruckerkanalEND IF;out(bell)END REP END PROCdefinieredruckerkanal;PROCstoppedrucker:IFexiststask(arbeitertaskname)THENend(/arbeitertaskname)END IF END PROCstoppedrucker;PROCplottereingestellt(BOOL CONSTwert):plotteraktiv:=wertEND PROCplottereingestellt;BOOL PROCplottereingestellt:plotteraktivEND PROCplottereingestellt;END PACKETdruckermenu;
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel.text als row b/app/schulis-simulationssystem/3.0/src/simsel.text als row
new file mode 100644
index 0000000..0bdc52d
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel.text als row
@@ -0,0 +1,2 @@
+PACKETtextalsrowDEFINESins,del,CAT,ipos,dump,replaceiac,VSUB,VISUB:LETnil13byte="�������������",nil4byte="����",nilbyte="�";TEXT VARg1,code2:="��";PROCins(TEXT VARrow,INT CONSTwo,was):replace(code2,1,was);g1:=subtext(row,2*wo-1);row:=subtext(row,1,2*wo-2);rowCATcode2;rowCATg1END PROCins;PROCdel(TEXT VARrow,INT CONSTwo):g1:=subtext(row,2*wo+1);row:=subtext(row,1,2*wo-2);rowCATg1END PROCdel;OP CAT(TEXT VARrow,INT CONSTwas):replace(code2,1,was);rowCATcode2END OP CAT;INT PROCipos(TEXT CONSTrow,INT CONSTwas):INT VARstart:=0;replace(code2,1,was);REPstart:=pos(row,code2,start+1)UNTILstartMOD2=1ORstart=0PER;(start+1)DIV2END PROCipos;PROCdump(TEXT VARrow):INT VARi;FORiFROM1UPTOlength(row)DIV2REPput(rowISUBi)PER END PROCdump;PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCATnil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt<woREPtCATnilbytePER END PROCstretch;PROCreplaceiac(TEXT VARstring,INT CONSTwo,INT CONSTwas):IF LENGTHstring<=2*(wo+1)THENstretch(string,2*(wo+1))FI;replace(string,wo,was)END PROCreplaceiac;INT OP VSUB(TEXT CONSTstring,INT CONSTpos):code(stringSUBpos)END OP VSUB;INT OP VISUB(TEXT CONSTstring,INT CONSTpos):IFpos*2<=LENGTHstringTHENstringISUBposELSE0FI END OP VISUB;END PACKETtextalsrow;
+
diff --git a/app/schulis-simulationssystem/3.0/src/simsel.verwaltung b/app/schulis-simulationssystem/3.0/src/simsel.verwaltung
new file mode 100644
index 0000000..f77604a
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/simsel.verwaltung
@@ -0,0 +1,7 @@
+PACKETsimselverwaltungDEFINESsimsel,installieresimselsystem:LETsystemname="s c h u l i s - Simulationssystem    Version 3.0",titel1="Systemverwaltung",titel2="Installation",titel3="Installation: Drucker",meldung1="Das Simulationssystem ist noch nicht installiert.",meldung2="Kein Druckertreiber für Graphiken installiert.",meldung3="1 ... Simulationssystem",meldung5="2 ... Zeichnungen drucken",meldung6="---------------------------------------",meldung7="3 ... Neuinstallation: Simulationssystem",meldung8="4 ... Neuinstallation: Graphikdrucker",meldung9="q ... Simulationssystem verlassen",meldung10="Gewünschte Funktion:",meldung11="Bitte wählen Sie unter folgenden Anpassungen eine",meldung12="für Ihr Terminal und die zugehörige Grafikkarte",meldung13="angemessene heraus:",meldung14="                 hercules-Anpassung",meldung15="                 cga-Anpassung",meldung16="                 ega-Anpassung",meldung17="                 vga-Anpassung",meldung18="Solange vorgeschlagene Anpassung verneinen <n/N>",meldung19="bis passende genannt wird.",meldung20="Diese bejahen <j/J/y/Y>.",meldung21="Installation korrekt beendet",meldung22="Installation wegen Systemfehler gestoppt",meldung23="Verfügt das Terminal über den IBM-Zeichensatz",meldung24="Soll das vorhandene Simulationssystem gelöscht werden",meldung25="Soll der vorhandene Druckertreiber gelöscht werden",meldung26="Weiter mit beliebiger Taste",meldung27="Geladen wird Datei Nr. ",meldung28="Die benötigten Dateien sind vollständig geladen.",meldung29="Sie können die Diskette aus dem Laufwerk nehmen.",meldung30="Bitte warten - das Simulationssystem wird installiert.",meldung31="Installiert wird Datei      von ",meldung32="Fehler bei der Übersetzung der Programme.",meldung33="   richtige Anpassung",meldung34="für Ihren Drucker geeigenete aus:",meldung35="  DRUCKER          PLOTTER",meldung36="  xerox 4045       hp 72xx",meldung37="  epson sq         hp 74xx",meldung38="  epson fx",meldung39="  binder 8600",meldung40="  kyocera",meldung41="  hp laserjet",meldung42="Bitte warten - der Druckertreiber wird installiert",meldung43="Bitte zunächst das Simulationssystem installieren.",meldung44="Zunächst müssen die erforderlichen Dateien geladen werden.",meldung45="Passwort: ",meldung46="Soll das System mit einem Passwort geschützt werden",meldung47="Fehler: Die Diskette ist ungültig oder nicht korrekt eingelegt!",meldung49="Installation vorzeitig abgebrochen",meldung50="Bitte legen sie eine Diskette der Anwendung",meldung51="in das Laufwerk und schließen es.",meldung52="Installation fortsetzen: <w>",meldung53="Installation abbrechen : <ESC>",meldung54="Bitte legen Sie eine weitere Diskette der Anwendung",menutasten="1234q",zeilenmenu1=9,zeilenmenu2=12,zeilenmenu3=14,menuankoppeln="installmenu(""ls-MENUKARTE:Simsel"",FALSE)",startschleifeaufrufen="managerschleife",ebenembvhandle="handlemenu(""Modellbankverwaltung"")",druckmenuhandle="handlemenu(""Drucken"")",ibmzeichensatz="ibmgraphicchar",stdsatzzeichen="stdgraphicchar",plotterein="plotter eingestellt (TRUE)",plotteraus="plotter eingestellt (FALSE)",depottaskname="simsel depot",lsmktaskname="ls-MENUKARTEN",lstaskname="LS-ANWENDUNG",simulationstaskname="ARBEITSPLATZ",mbverwtaskname="MODELLBANKVERWALTUNG",printertaskname="SIMSEL-PRINTER",pridepottaskname="SIMSEL-PRINTERDEPOT",umstelltaskname="DRUCKERANPASSUNGEN",archivname="simsel",menukarte="ls-MENUKARTE:Simsel",maskenname="simsel formulare",textdsname="TEXTE deutsch",mathekuerzel="simsel ",plotkuerzel=" plot",anzahlgesamt=39,anzahlsimprocs=18,anzahllsprocs=5,anzahlmbverwprocs=16,anzahlpriprocs=8,anzahldruckerds=18,ok=1111,fehler=9999,insertieren=2525,druckererzeugen=3260,drucker1erzeugen=3261,drucker8erzeugen=3268,systemstarten=4444,ebenembvbehandeln=4445,arbeitskanal=1,del="�",delpage="�",bell="�",left="�",beginmark="",endmark="",weiter="w",abbruch="�",niltext="";TASK VARdepottask,lsmktask,simulationstask,mbverwtask,lstask,pridepottask,printertask,ordertask,umstelltask;THESAURUS VAR
+archivinhalt;TEXT VARgraphicart,installationspassword:=niltext;INT VARdruckerindex;BOOL VARibmsatz;INT VARinstallationszaehler,antwort,ordercode;DATASPACE VARmessageds;BOOL VARsimselsysteminstalliert:=FALSE,graphikdruckerinstalliert:=FALSE;ROWanzahllsprocsTEXT CONSTvorlaufdatei:=ROWanzahllsprocsTEXT:("ls-DIALOG 1.korrektur","ls-DIALOG 2.simsel","ls-DIALOG 3.korrektur","ls-DIALOG 4.wd","ls zustaende parameter kurve");ROWanzahldruckerdsTEXT CONSTdruckerdatei:=ROWanzahldruckerdsTEXT:("ZEICHEN 8*8","ZEICHEN 6*10","ZEICHEN 8*16","spool cmd","mat.xerox4045 plot","mat.epson-sq plot","mat.epson-fx plot","mat.binder plot","mat.kyocera plot","mat.laserjet plot","mat.hp72xx plot","mat.hp74xx plot","simsel basis plot","simsel picture","ls dialoghilfen","output test","ls-DIALOG 5.korrektur","simsel.druckermenu");ROWzeilenmenu1TEXT CONSTmenu1:=ROWzeilenmenu1TEXT:(meldung3,meldung5,meldung6,meldung7,meldung8,niltext,meldung9,niltext,meldung10);ROWzeilenmenu2TEXT CONSTmenu2:=ROWzeilenmenu2TEXT:(meldung11,meldung12,meldung13,niltext,meldung14,meldung15,meldung16,meldung17,niltext,meldung18,meldung19,meldung20);ROWzeilenmenu3TEXT CONSTmenu3:=ROWzeilenmenu3TEXT:(meldung11,meldung34,niltext,meldung35,meldung36,meldung37,meldung38,meldung39,meldung40,meldung41,niltext,meldung18,meldung19,meldung20);PROCsimsel:disablestop;zeigekopierhinweis;startsystem;IFiserrorTHENclearerror;commanddialogue(FALSE);forget(all);commanddialogue(TRUE);zeigetitelzeile(titel1);gibmeldung(errormessage);startsystemEND IF END PROCsimsel;PROCzeigekopierhinweis:LETz1="schulis - Simulationssystem (SIMSEL)",z2="Lizenzfreie Software der",z3="Gesellschaft für Mathematik und Datenverarbeitung mbH",z4="Die Nutzung der Software ist nur im Schul- und Hochschulbereich",z5="für nichtkommerzielle Zwecke gestattet.",z6="Gewährleistung und Haftung werden ausgeschlossen.",z7="Weiter mit beliebiger Taste";page;cursor(26,3);out(z1);cursor(27,8);out(z2);cursor(13,10);out(z3);cursor(8,14);out(z4);cursor(20,15);out(z5);cursor(16,17);out(z6);cursor(26,23);out(z7);pause(100)END PROCzeigekopierhinweis;PROCstartsystem:TEXT VARch;INT VARrang,zeile,xpos,ypos;grundeinstellungen;REPzeigeverwaltungsmenu;warteaufkorrekteeingabe;werteeingabeausEND REP.grundeinstellungen:enablestop;checkoff;warningsoff.zeigeverwaltungsmenu:zeigetitelzeile(titel1);FORzeileFROM7UPTO15REPcursor(24,zeile);out(menu1(zeile-6))END REP;clearbuffer.warteaufkorrekteeingabe:getcursor(xpos,ypos);REPinchar(ch);rang:=pos(menutasten,ch);IFrang=0THENout(bell)ELSEcursor(xpos+1,ypos);out(ch);END IF UNTILrang<>0END REP.werteeingabeaus:SELECTrangOF CASE1:fuehresimselsystemausCASE2:fuehredruckermenuausCASE3:installieresimselsystemCASE4:installieredruckeranpassungOTHERWISE LEAVEstartsystemEND SELECT.fuehresimselsystemaus:IF NOTsimselsysteminstalliertTHENout(bell);gibmeldung(meldung1);LEAVEfuehresimselsystemausEND IF;uebergibbildschirm(mbverwtask,ebenembvbehandeln).fuehredruckermenuaus:IF NOTgraphikdruckerinstalliertTHENout(bell);gibmeldung(meldung2);LEAVEfuehredruckermenuausEND IF;uebergibbildschirm(/printertaskname,systemstarten).installieredruckeranpassung:IF NOTsimselsysteminstalliertTHENout(bell);gibmeldung(meldung43);LEAVEinstallieredruckeranpassungEND IF;IFgraphikdruckerinstalliertCAND NOTja(meldung25)THEN LEAVEinstallieredruckeranpassungEND IF;startprinterinstallation;IFiserrorTHENclearerror;gibmeldung(errormessage);ELSEzeigeinstallationsergebnis(titel3,graphikdruckerinstalliert)END IF END PROCstartsystem;PROCinstallieresimselsystem:IF NOTkorrektespasswordTHEN LEAVEinstallieresimselsystemEND IF;IFsimselsysteminstalliertCAND NOTja(meldung24)THEN LEAVEinstallieresimselsystemEND IF;startsimselinstallation;zeigeinstallationsergebnis(titel2,simselsysteminstalliert);IFsimselsysteminstalliertTHENdefinierepasswordEND IF;graphikdruckerinstalliert:=FALSE.END PROCinstallieresimselsystem;PROCstartsimselinstallation:INT VARi;bestimmegraphicundhalbgraphic;IF NOTerforderlichesystemdateieneingelesenTHENerrorstop(meldung49)END IF;
+loescheggfvorhandenetasks;stellebeziehungzulsmenukartenher;richtesicherungstasksein;sicheredateien;meldeinstallationsbeginn;richtelstaskein;richtesimulationstaskein;richtembverwtaskein;loeschedepottask.bestimmegraphicundhalbgraphic:graphicart:=graphikkarte;ibmsatz:=ja(meldung23).loescheggfvorhandenetasks:IFexiststask(depottaskname)THENend(/depottaskname)END IF;IFexiststask(lstaskname)THENend(/lstaskname)END IF.stellebeziehungzulsmenukartenher:IF NOTexiststask(lsmktaskname)THENerrorstop(meldung49)ELSElsmktask:=/lsmktasknameEND IF.richtesicherungstasksein:begin(depottaskname,PROCfreeglobalmanager,depottask);IF NOTexiststask(umstelltaskname)THENerrorstop(meldung49)ELSEumstelltask:=/umstelltasknameEND IF.sicheredateien:commanddialogue(FALSE);save(menukarte,lsmktask);save(maskenname,lsmktask);save(textdsname,lsmktask);save(archivinhalt,depottask);FORiFROM1UPTOanzahldruckerdsREP IF NOTexists(druckerdatei(i),umstelltask)THENsave(druckerdatei(i),umstelltask)END IF END REP;forget(archivinhalt).meldeinstallationsbeginn:zeigetitelzeile(titel2);cursor(15,10);out(meldung30);cursor(15,12);out(meldung31+text(anzahlgesamt)+" Dateien");installationszaehler:=0.richtelstaskein:begin(lstaskname,PROCinstallls,lstask);FORiFROM1UPTOanzahllsprocsREPinsertiereprogramme(lstask)END REP.richtesimulationstaskein:REP UNTILexiststask(simulationstaskname)CANDstatus(/simulationstaskname)=2END REP;simulationstask:=/simulationstaskname;FORiFROM1UPTOanzahlsimprocsREPinsertiereprogramme(simulationstask)END REP.richtembverwtaskein:REP UNTILexiststask(mbverwtaskname)CANDstatus(/mbverwtaskname)=2END REP;mbverwtask:=/mbverwtaskname;FORiFROM1UPTOanzahlmbverwprocsREPinsertiereprogramme(mbverwtask)END REP.loeschedepottask:end(depottask)END PROCstartsimselinstallation;BOOL PROCerforderlichesystemdateieneingelesen:LETdateien=60,nichtgeladen="0",geladen="1";ROWdateienTEXT CONSTsystemdatei:=ROWdateienTEXT:("simsel cga plot","simsel ega plot","simsel vga plot","simsel hercules plot","ZEICHEN 8*8","ZEICHEN 9*14","ZEICHEN 8*19","ZEICHEN 8*14","ZEICHEN 6*10","ZEICHEN 8*16","simsel formulare","TEXTE deutsch","ls-MENUKARTE:Simsel","ls-DIALOG 1.korrektur","ls-DIALOG 2.simsel","ls-DIALOG 3.korrektur","ls-DIALOG 4.wd","ls-DIALOG 5.korrektur","ls-DIALOG 5.simsel","spool cmd","mat.xerox4045 plot","mat.epson-sq plot","mat.epson-fx plot","mat.binder plot","mat.kyocera plot","mat.laserjet plot","mat.hp72xx plot","mat.hp74xx plot","simsel.druckermenu","ls zustaende parameter kurve","ls dateiscroll","modellbasis geraet","modellwerte","ls bildschirmeingaben","simsel basis plot","simsel picture","ls dialoghilfen","output","output test","ls co routinen und co","steuerung","ls demonstration","ls kombination","ls simulation","ltbearb","neue startschl","ls starte bearbeitung","simsel.text als row","ls simsel.masken","e","g","bs","o","m","op1","op2","modellbasis dialog","ls dp1","dp2","ls simselstarter");TEXT VARanweisung:=meldung50,pruefleiste:=dateien*nichtgeladen;TEXT CONSTziel:=dateien*geladen,anpassung:=mathekuerzel+graphicart+plotkuerzel;INT VARi,zaehler:=1;THESAURUS VARdiskinhalt;zeigetitelzeile(titel2);archivinhalt:=emptythesaurus;FORiFROM1UPTO4REP IFsystemdatei(i)<>anpassungTHENreplace(pruefleiste,i,geladen)END IF END REP;REPwarteaufeingabe;FORiFROM1UPTOdateienREP IF(pruefleisteSUBi)=nichtgeladenCAND(diskinhaltCONTAINSsystemdatei(i))THENladediedateiEND IF END REP;anweisung:=meldung54UNTILpruefleiste=zielEND REP;abschlussaktivitaeten;TRUE.zeigetexte:cursor(8,8);out(meldung44);cursor(8,9);out(anweisung);cursor(8,10);out(meldung51);cursor(8,12);out(meldung52);cursor(8,13);out(meldung53).warteaufeingabe:TEXT VARch;REPzeigetexte;inchar(ch);IFch=abbruchTHENrelease(archive);LEAVEerforderlichesystemdateieneingelesenWITH FALSE ELIFch=weiterTHENdisablestop;cursor(8,9);out(del);cursor(8,10);out(del);cursor(8,12);out(del);cursor(8,13);out(del);cursor(8,15);out(del);archive(archivname);diskinhalt:=ALLtestarchive;IFiserrorTHENclearerror;cursor(8,15);out(meldung47);enablestop;ELSEenablestop;LEAVE
+warteaufeingabeEND IF ELSEout(bell)END IF END REP.ladediedatei:cursor(8,9);out(meldung27+text(zaehler)+" von "+text(dateien-3)+" Dateien");fetch(systemdatei(i),testarchive);replace(pruefleiste,i,geladen);insert(archivinhalt,systemdatei(i));zaehlerINCR1.abschlussaktivitaeten:release(archive);cursor(8,8);out(meldung28+del);cursor(8,9);out(meldung29+del);pause(50).testarchive:archive.END PROCerforderlichesystemdateieneingelesen;PROCinstallls:INT VARi;FORiFROM1UPTOanzahllsprocsREPinsertiere(vorlaufdatei(i),depottask)END REP;IFibmsatzTHENdo(ibmzeichensatz)ELSEdo(stdsatzzeichen)END IF;begin(simulationstaskname,PROCinstallsimulationstask,simulationstask);begin(mbverwtaskname,PROCinstallmodellbankverwaltung,mbverwtask);disablestop;REP REPwarteaufauftragUNTILordercode>=drucker1erzeugenCANDordercode<=drucker8erzeugenEND REP;druckerindex:=ordercode-druckererzeugen;begin(printertaskname,PROCinstallprinter,printertask);gibantwort(ok)END REP END PROCinstallls;PROCinstallsimulationstask:ROWanzahlsimprocsTEXT CONSTsimproc:=ROWanzahlsimprocsTEXT:("ls dateiscroll",mathekuerzel+graphicart+plotkuerzel,"ls dialoghilfen","modellbasis geraet","modellwerte","ls bildschirmeingaben","simsel basis plot","simsel picture","output","ls co routinen und co","steuerung","ls demonstration","ls kombination","ls simulation","ltbearb","ls-DIALOG 5.simsel","neue startschl","ls starte bearbeitung");TEXT CONSTzugehoerendezeichen:=passenderzeichensatz;holenotfalls(zugehoerendezeichen,depottask);INT VARi;FORiFROM1UPTOanzahlsimprocsREPinsertiere(simproc(i),depottask)END REP;forget(zugehoerendezeichen,quiet);do(startschleifeaufrufen);.passenderzeichensatz:IFgraphicart="vga"THEN"ZEICHEN 8*19"ELIFgraphicart="ega"THEN"ZEICHEN 8*14"ELIFgraphicart="cga"THEN"ZEICHEN 8*8"ELSE"ZEICHEN 9*14"END IF.END PROCinstallsimulationstask;PROCinstallmodellbankverwaltung:ROWanzahlmbverwprocsTEXT CONSTdname:=ROWanzahlmbverwprocsTEXT:("ls dateiscroll","ls-DIALOG 5.korrektur","ls dialoghilfen","simsel.text als row","ls simsel.masken","e","g","bs","o","m","op1","op2","modellbasis dialog","ls dp1","dp2","ls simselstarter");INT VARi;insertierembverwsystem;beendeinstallation.insertierembverwsystem:FORiFROM1UPTOanzahlmbverwprocsREPinsertiere(dname(i),depottask)PER;do(menuankoppeln);.beendeinstallation:commanddialogue(FALSE);forget(all-textdsname-maskenname);commanddialogue(TRUE);disablestop;REP REPwarteaufauftragUNTILordercode=ebenembvbehandelnEND REP;continue(arbeitskanal);do(ebenembvhandle);gibbildschirmfrei(ok)END REP;END PROCinstallmodellbankverwaltung;PROCstartprinterinstallation:loescheggfvorhandenetask;bestimmedruckeranpassung;meldeinstallationsbeginn;richtedruckertasksein.loescheggfvorhandenetask:IFexiststask(printertaskname)THENend(/printertaskname)END IF.bestimmedruckeranpassung:druckerindex:=druckertreiber.meldeinstallationsbeginn:INT VARende:=anzahlpriprocs;IFdruckerindex>6THENendeDECR1END IF;zeigetitelzeile(titel2);cursor(15,10);out(meldung42);cursor(15,12);out(meldung31+text(ende)+" Dateien");installationszaehler:=0.richtedruckertasksein:INT VARi;IF NOTexiststask(pridepottaskname)THENbegin(pridepottaskname,PROCfreeglobalmanager,pridepottask)END IF;lstask:=/lstaskname;rufe(lstask,druckererzeugen+druckerindex);REP UNTILexiststask(printertaskname)CANDstatus(/printertaskname)=2END REP;printertask:=/printertaskname;FORiFROM1UPTOendeREPinsertiereprogramme(printertask)END REP END PROCstartprinterinstallation;PROCinstallprinter:LETanzahlzeichensaetze=3;ROWanzahlpriprocsTEXT CONSTprogramm:=ROWanzahlpriprocsTEXT:(druckerdatei(4),druckerdatei(4+druckerindex),druckerdatei(13),druckerdatei(14),druckerdatei(15),druckerdatei(16),druckerdatei(17),druckerdatei(18));INT VARi;BOOL VARplotterwirdinstalliert:=druckerindex>6;IF NOTplotterwirdinstalliertTHENholezeichensaetzeEND IF;insertieredieeinzelnenprogramme;do(menuankoppeln);abschlussaktivitaet.holezeichensaetze:FORiFROM1UPTOanzahlzeichensaetzeREPholenotfalls(druckerdatei(i),/umstelltaskname)PER.insertieredieeinzelnenprogramme:INT VARanfang:=1;IF
+plotterwirdinstalliertTHENanfang:=2END IF;FORiFROManfangUPTOanzahlpriprocsREPinsertiere(programm(i),/umstelltaskname)END REP.abschlussaktivitaet:IF NOTplotterwirdinstalliertTHEN FORiFROM1UPTOanzahlzeichensaetzeREPforget(druckerdatei(i),quiet)END REP END IF;IFplotterwirdinstalliertTHENdo(plotterein)ELSEdo(plotteraus)END IF;disablestop;REP REPwarteaufauftragUNTILordercode=systemstartenEND REP;continue(arbeitskanal);do(druckmenuhandle);gibbildschirmfrei(ok)END REP END PROCinstallprinter;PROCinsertiereprogramme(TASK VARzieltask):installationszaehlerINCR1;cursor(40,12);out(text(installationszaehler));rufe(zieltask,insertieren);IFantwort<>okTHENerrorstop(meldung32)END IF END PROCinsertiereprogramme;PROCinsertiere(TEXT CONSTname,TASK CONSTherkunft):REPwarteaufauftragUNTILordercode=insertierenEND REP;disablestop;holenotfalls(name,herkunft);insert(name);forget(name,quiet);IFiserrorTHENclearerror;gibantwort(fehler)ELSEgibantwort(ok)END IF;enablestopEND PROCinsertiere;PROCholenotfalls(TEXT CONSTname,TASK CONSTherkunft):IF NOTexists(name)THENfetch(name,herkunft)END IF END PROCholenotfalls;PROCrufe(TASK CONSTzieltask,INT CONSTauftrag):messageds:=nilspace;call(zieltask,auftrag,messageds,antwort);forget(messageds)END PROCrufe;PROCwarteaufauftrag:wait(messageds,ordercode,ordertask);forget(messageds)END PROCwarteaufauftrag;PROCgibantwort(INT CONSTantwortcode):messageds:=nilspace;send(ordertask,antwortcode,messageds);END PROCgibantwort;PROCuebergibbildschirm(TASK CONSTt,INT CONSTauftrag):break(quiet);rufe(t,auftrag);continue(arbeitskanal)END PROCuebergibbildschirm;PROCgibbildschirmfrei(INT CONSTantwortcode):break(quiet);gibantwort(antwortcode)END PROCgibbildschirmfrei;TEXT PROCgraphikkarte:LETanzahlplotprocs=4;ROWanzahlplotprocsTEXT CONSTplotname:=ROWanzahlplotprocsTEXT:("hercules","cga","ega","vga");INT VARi:=1,zeile;commanddialogue(TRUE);zeigetitelzeile(titel2);FORzeileFROM6UPTO17REPcursor(16,zeile);out(menu2(zeile-5))END REP;REPcursor(16,20);out(invers(text(plotname(i),11)));IFyes(meldung33)THENcommanddialogue(FALSE);LEAVEgraphikkarteWITHplotname(i)END IF;i:=iMODanzahlplotprocs+1END REP;plotname(i)END PROCgraphikkarte;INT PROCdruckertreiber:LETanzahlplotterprocs=8;ROWanzahlplotterprocsTEXT CONSTplotname:=ROWanzahlplotterprocsTEXT:("xerox4045","epson-sq","epson-fx","binder","kyocera","laserjet","hp72xx","hp74xx");INT VARi,zeile;commanddialogue(TRUE);zeigetitelzeile(titel3);FORzeileFROM3UPTO16REPcursor(16,zeile);out(menu3(zeile-2))END REP;i:=1;REPcursor(16,20);out(invers(text(plotname(i),11)));IFyes(meldung33)THENcommanddialogue(FALSE);LEAVEdruckertreiberWITHiEND IF;i:=iMODanzahlplotterprocs+1END REP;iEND PROCdruckertreiber;PROCzeigetitelzeile(TEXT CONSTfktbezeichner):TEXT CONSTzeile:=text(systemname,78-length(fktbezeichner))+fktbezeichner;page;cursor(1,1);out(invers(text(zeile,79)))END PROCzeigetitelzeile;PROCzeigeinstallationsergebnis(TEXT CONSTziel,BOOL VARerfolg):zeigetitelzeile(ziel);IFiserrorTHENclearerror;gibmeldung(meldung22);erfolg:=FALSE ELSEgibmeldung(meldung21);erfolg:=TRUE END IF END PROCzeigeinstallationsergebnis;PROCgibmeldung(TEXT CONSTmeldungstext):cursor(1,23);out(meldungstext);cursor(1,24);out(invers(text(meldung26,77)));clearbuffer;pauseEND PROCgibmeldung;PROCclearbuffer:REP UNTILincharety=niltextPER END PROCclearbuffer;BOOL PROCja(TEXT CONSTfrage):BOOL VARantwort;commanddialogue(TRUE);cursor(1,22);antwort:=yes(frage);cursor(1,22);out(del);commanddialogue(FALSE);antwortEND PROCja;TEXT PROCinvers(TEXT CONSTt):beginmark+t+endmarkEND PROCinvers;BOOL PROCkorrektespassword:installationspassword=niltextCORpasswordgetroffen.passwordgetroffen:TEXT VAReingabe;cursor(24,18);out(meldung45+del);getsecretline(eingabe);IFeingabe=installationspasswordTHENcursor(24,18);out(del);LEAVEpasswordgetroffenWITH TRUE END IF;out(bell);FALSE END PROCkorrektespassword;PROCdefinierepassword:installationspassword:=niltext;cursor(1,23);out(delpage);IFja(meldung46)THENcursor(1,23);out(meldung45+beginmark+left);editget(installationspassword,40,20);out(
+endmark)END IF END PROCdefinierepassword;END PACKETsimselverwaltung;
+
diff --git a/app/schulis-simulationssystem/3.0/src/spool cmd b/app/schulis-simulationssystem/3.0/src/spool cmd
new file mode 100644
index 0000000..966ab79
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/spool cmd
@@ -0,0 +1,3 @@
+PACKETspoolcmdDEFINESspoolcontrolpassword,killspool,firstspool,startspool,stopspool,haltspool,waitforhalt:LETerrornak=2,entrylinecode=23,killercode=24,firstcode=25,startcode=26,stopcode=27,haltcode=28,waitforhaltcode=29;DATASPACE VARds;BOUND STRUCT(TEXTentryline,INTindex,TEXTactualentries,password)VARcontrolmsg;BOUND TEXT VARerrormsg;INT VARreply;INITFLAG VARinthistask:=FALSE;BOOL VARdialogue;TEXT VARcontrolpassword,password;controlpassword:="";PROCspoolcontrolpassword(TEXT CONSTnewpassword):IFonlineTHENsay("�
�")FI;disablestop;do("enterspoolcontrolpassword(""+newpassword+"")");clearerror;nodoagain;covertracks;covertracks(controlpassword);controlpassword:=newpassword;END PROCspoolcontrolpassword;PROCcallspool(INT CONSTopcode,TEXT CONSTname,TASK CONSTspool):dialogue:=commanddialogue;password:=writepassword;passwordCAT"/";passwordCATreadpassword;disablestop;commanddialogue(FALSE);enterpassword(controlpassword);commanddialogue(dialogue);call(opcode,name,spool);commanddialogue(FALSE);enterpassword(password);commanddialogue(dialogue);END PROCcallspool;PROCstartspool(TASK CONSTspool):enablestop;callspool(haltcode,"",spool);callspool(startcode,"",spool);END PROCstartspool;PROCstartspool(TASK CONSTspool,INT CONSTnewchannel):enablestop;callspool(haltcode,"",spool);callspool(startcode,text(newchannel),spool);END PROCstartspool;PROCstopspool(TASK CONSTspool):callspool(stopcode,"",spool);END PROCstopspool;PROCstopspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(stopcode,deactivemsg,spool);END PROCstopspool;PROChaltspool(TASK CONSTspool):callspool(haltcode,"",spool);END PROChaltspool;PROChaltspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(haltcode,deactivemsg,spool);END PROChaltspool;PROCwaitforhalt(TASK CONSTspool):callspool(waitforhaltcode,"",spool);END PROCwaitforhalt;PROCwaitforhalt(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(waitforhaltcode,deactivemsg,spool);END PROCwaitforhalt;PROCcontrolspool(TASK CONSTspool,INT CONSTcontrolcode,TEXT CONSTquestion,BOOL CONSTleave):enablestop;initializecontrolmsg;WHILEvalidspoolentryREP IFcontrolquestionTHENcontrolspoolentryFI PER;.initializecontrolmsg:IF NOTinitialized(inthistask)THENds:=nilspaceFI;forget(ds);ds:=nilspace;controlmsg:=ds;controlmsg.entryline:="";controlmsg.password:=controlpassword;controlmsg.index:=0;say("

+");.validspoolentry:call(spool,entrylinecode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;controlmsg.index<>0.controlquestion:say(controlmsg.entryline);yes(question).controlspoolentry:call(spool,controlcode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;IFleaveTHEN LEAVEcontrolspoolFI;END PROCcontrolspool;PROCkillspool(TASK CONSTspool):controlspool(spool,killercode,"   loeschen",FALSE)END PROCkillspool;PROCfirstspool(TASK CONSTspool):controlspool(spool,firstcode,"   als erstes",TRUE)END PROCfirstspool;END PACKETspoolcmd;
+
diff --git a/app/schulis-simulationssystem/3.0/src/steuerung b/app/schulis-simulationssystem/3.0/src/steuerung
new file mode 100644
index 0000000..94e029c
--- /dev/null
+++ b/app/schulis-simulationssystem/3.0/src/steuerung
@@ -0,0 +1,6 @@
+PACKETsteuerungDEFINESsteuerprozessfuereineloesung,steuerprozessfuerzweiloesungen:LETesc="�",hop="�",rechts="�",links="�",plotten="p",tasteblaettern="b",tasteblaetternoben="o",tasteblaetternunten="u",piepton="�",plottask="SIMSEL-PRINTERDEPOT",initialisieren=0,kreuzerzeugen=1,anfpunktloeschen=4,bildschirminhaltplotten=5,abschluss=6,warten1=0,warten2=1;LETfusszeileleer=0;DATASPACE VARdsco1,dsco2;KURVE VARk1,k2;REAL VARzeitt1,zeitt2;ZUSTAND VARzustand1,zustand2;PROCsteuerprozessfuereineloesung(OUTPUT VARseite,KURVE VARk,ZUSTAND CONSTmaske1,maske2,INT CONSTfenster1,fenster2,kopfzeile,steuerzeile,TEXT CONSTtasteninnen,tastenraus,TEXT VARabbruchtaste,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine1,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine2):TEXT VARtaste;REAL VARzeitt,null:=0.0;BOOL VARauto1,auto2,vorwaertslesen,richtungswechsel;ZUSTAND VARzustand,maske1intern,maske2intern;INT VARmerker,co1wastun,co1wastunalt,co2wastun,co2wastunalt;vorwaertsundrueckwaerts;fuehreabschlussarbeitenaus.vorwaertsundrueckwaerts:INT VARinternerzustand:=0;initialisieredensteuerprozess;initialisierecoroutine1;initialisierecoroutine2;leseersten(k,zeitt,zustand);internerzustand:=4;REPvorwaerts;rueckwaertsPER.fuehreabschlussarbeitenaus:schliessecoroutine1ab;schliessecoroutine2ab.initialisieredensteuerprozess:forget(dsco1);forget(dsco2);dsco1:=nilspace;dsco2:=nilspace;auto1:=FALSE;auto2:=FALSE;vorwaertslesen:=TRUE;maske1intern:=maske1;maske2intern:=maske2;merker:=warten1;gebeaufbildschirmaus(seite,modellkurzbezeichnung,kopfzeile,fusszeileleer);beginplot;plottefusszeile(seite,steuerzeile);endplot.initialisierecoroutine1:co1wastun:=initialisieren;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1);co1wastun:=kreuzerzeugen;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).initialisierecoroutine2:co2wastun:=initialisieren;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2);co2wastun:=kreuzerzeugen;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).vorwaerts:REP SELECTinternerzustandOF CASE4:vorwaerts4CASE9:vorwaerts9CASE13:vorwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVEvorwaertsFI;internerzustand:=neuervzustand;PER.rueckwaerts:REP SELECTinternerzustandOF CASE4:rueckwaerts4CASE9:rueckwaerts9CASE13:rueckwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVErueckwaertsFI;internerzustand:=neuerrzustand;PER.vorwaerts4:uebergibpunktancoroutine1;uebergibpunktancoroutine2.vorwaerts9:lesenaechsten(k,zeitt,zustand);uebergibpunktancoroutine1;uebergibpunktancoroutine2.vorwaerts13:merker:=warten2.rueckwaerts4:uebergibpunktancoroutine1;uebergibpunktancoroutine2;merker:=warten2.rueckwaerts9:lesevorherigen(k,zeitt,zustand);uebergibpunktancoroutine1;uebergibpunktancoroutine2.rueckwaerts13:.uebergibpunktancoroutine1:coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).uebergibpunktancoroutine2:coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).neuervzustand:SELECTinternerzustandOF CASE4:iznach4vCASE9:iznach9vCASE13:13OTHERWISE0ENDSELECT.neuerrzustand:SELECTinternerzustandOF CASE4:4CASE9:iznach9rCASE13:iznach13rOTHERWISE0ENDSELECT.iznach4v:IFendederloesung(k)THEN13ELSE9FI.iznach9v:iznach4v.iznach9r:IFanfangderloesung(k)THEN4ELSE9FI.iznach13r:9.liesoderwarteaufbenutzereingaben:REPliesbenutzereingaben(taste,tasteninnen,tastenraus,merker);IFtaste<>""THENinterpretieretasteundfuehreaktionausELSErichtungswechsel:=FALSE;LEAVEliesoderwarteaufbenutzereingabenFI;PER.interpretieretasteundfuehreaktionaus:IF(pos(tastenraus,taste)>0)THENabbruchtaste:=taste;LEAVE
+vorwaertsundrueckwaertsFI;IFtaste=rechtsTHENrichtungswechsel:=NOTvorwaertslesen;vorwaertslesen:=TRUE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=linksTHENrichtungswechsel:=vorwaertslesen;vorwaertslesen:=FALSE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=plottenTHENplotteloesungskurveELIFtaste=tasteblaetternTHENblaettern(seite);out(hop)ELIFtaste=tasteblaetternobenTHENblaetternoben(seite);out(hop)ELIFtaste=tasteblaetternuntenTHENblaetternunten(seite);out(hop)FI.plotteloesungskurve:nildiagrammmitkreuz(seite,fenster1);nildiagrammmitkreuz(seite,fenster2);co1wastunalt:=co1wastun;co1wastun:=bildschirminhaltplotten;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1);co1wastun:=co1wastunalt;co2wastunalt:=co2wastun;co2wastun:=bildschirminhaltplotten;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2);co2wastun:=co2wastunalt;versendeoutput(seite,modellkurzbezeichnung,kopfzeile,steuerzeile,plottask);piep.piep:out(piepton).schliessecoroutine1ab:co1wastun:=abschluss;coroutine1(seite,fenster1,k,zeitt,maske1intern,zustand,dsco1,co1wastun,null,null,null,null,auto1).schliessecoroutine2ab:co2wastun:=abschluss;coroutine2(seite,fenster2,k,zeitt,maske2intern,zustand,dsco2,co2wastun,null,null,null,null,auto2).END PROCsteuerprozessfuereineloesung;PROCsteuerprozessfuerzweiloesungen(OUTPUT VARseite,KURVE VARkurve1,kurve2,ZUSTAND CONSTmaske,INT CONSTfenster1,fenster2,kopfzeile,steuerzeile,TEXT CONSTtasteninnen,tastenraus,TEXT VARabbruchtaste,PROC(OUTPUT VAR,INT CONST,KURVE VAR,REAL VAR,ZUSTAND VAR,ZUSTAND VAR,DATASPACE VAR,INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)coroutine,PROC(OUTPUT VAR,KURVE VAR,KURVE VAR,ZUSTAND VAR,INT CONST,INT CONST,ROW4INT VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,REAL VAR,BOOL VAR)kreuzvergleich):LETmaxloe=4;ROWmaxloeINT VARposition;TEXT VARtaste;BOOL VARautomatik,vorwaertslesen,richtungswechsel;ZUSTAND VARmaskeintern;INT VARco1wastun,co1wastunalt,co2wastun,co2wastunalt,merker;REAL VARx1min,x1max,x2min,x2max,ymin,ymax;k1:=kurve1;k2:=kurve2;vorwaertsundrueckwaerts.vorwaertsundrueckwaerts:INT VARinternerzustand:=0;initialisieredensteuerprozess;initialisierediecoroutinedoppelt;leseersten(k1,zeitt1,zustand1);leseersten(k2,zeitt2,zustand2);internerzustand:=internerzustandnach0v;REPvorwaerts;rueckwaertsPER.initialisieredensteuerprozess:forget(dsco1);forget(dsco2);dsco1:=nilspace;dsco2:=nilspace;automatik:=FALSE;merker:=warten1;vorwaertslesen:=TRUE;maskeintern:=maske;gebeaufbildschirmaus(seite,modellkurzbezeichnung,kopfzeile,fusszeileleer);beginplot;plottefusszeile(seite,steuerzeile);kreuzvergleich(seite,k1,k2,maskeintern,fenster1,fenster2,position,x1min,x1max,x2min,x2max,ymin,ymax,automatik);endplot.initialisierediecoroutinedoppelt:co1wastun:=initialisieren;coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik);co2wastun:=initialisieren+10;coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik).vorwaerts:REP SELECTinternerzustandOF CASE1:vorwaerts1CASE2:vorwaerts2CASE3:vorwaerts3CASE4:vorwaerts4CASE5:vorwaerts5CASE6:vorwaerts6CASE7:vorwaerts7CASE8:vorwaerts8CASE9:vorwaerts9CASE10:vorwaerts10CASE11:vorwaerts11CASE12:vorwaerts12CASE13:vorwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVEvorwaertsFI;internerzustand:=neuervzustand;PER.rueckwaerts:REP SELECTinternerzustandOF CASE1:rueckwaerts1CASE2:rueckwaerts2CASE3:rueckwaerts3CASE4:rueckwaerts4CASE5:rueckwaerts5CASE6:rueckwaerts6CASE7:rueckwaerts7CASE8:rueckwaerts8CASE9:rueckwaerts9CASE10:rueckwaerts10CASE11:rueckwaerts11CASE12:rueckwaerts12CASE13:rueckwaerts13ENDSELECT;liesoderwarteaufbenutzereingaben;IFrichtungswechselTHEN LEAVErueckwaertsFI;loescheggfanfpunkteinerkurve;internerzustand:=neuerrzustand;PER.neuervzustand:SELECTinternerzustandOF CASE1:internerzustandnach1vCASE2:internerzustandnach2vCASE3:internerzustandnach3vCASE4:
+internerzustandnach4vCASE5:internerzustandnach5vCASE6:internerzustandnach6vCASE7:internerzustandnach7vCASE8:internerzustandnach8vCASE9:internerzustandnach9vCASE10:internerzustandnach10vCASE11:internerzustandnach11vCASE12:internerzustandnach12vCASE13:13OTHERWISE0ENDSELECT.neuerrzustand:SELECTinternerzustandOF CASE1:1CASE2:internerzustandnach2rCASE3:internerzustandnach3rCASE4:4CASE5:5CASE6:internerzustandnach6rCASE7:internerzustandnach7rCASE8:internerzustandnach8rCASE9:internerzustandnach9rCASE10:internerzustandnach10rCASE11:internerzustandnach11rCASE12:internerzustandnach12rCASE13:internerzustandnach13rOTHERWISE0ENDSELECT.loescheggfanfpunkteinerkurve:SELECTinternerzustandOF CASE3:loescheerstenfuerkurve2CASE7:loescheerstenfuerkurve1ENDSELECT.vorwaerts1:zeichnefuerkurve1.vorwaerts2:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts3:zeichnefuerkurve2.vorwaerts4:zeichnefuerkurve1;zeichnefuerkurve2.vorwaerts5:zeichnefuerkurve2.vorwaerts6:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts7:zeichnefuerkurve1.vorwaerts8:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts9:lesenaechsten(k1,zeitt1,zustand1);lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve1;zeichnefuerkurve2.vorwaerts10:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts11:lesenaechsten(k2,zeitt2,zustand2);zeichnefuerkurve2.vorwaerts12:lesenaechsten(k1,zeitt1,zustand1);zeichnefuerkurve1.vorwaerts13:merker:=warten2.rueckwaerts1:zeichnefuerkurve1;merker:=warten2.rueckwaerts2:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts3:zeichnefuerkurve2.rueckwaerts4:zeichnefuerkurve1;zeichnefuerkurve2;merker:=warten2.rueckwaerts5:zeichnefuerkurve2;merker:=warten2.rueckwaerts6:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts7:zeichnefuerkurve1.rueckwaerts8:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts9:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1;lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts10:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts11:lesevorherigen(k2,zeitt2,zustand2);zeichnefuerkurve2.rueckwaerts12:lesevorherigen(k1,zeitt1,zustand1);zeichnefuerkurve1.rueckwaerts13:.zeichnefuerkurve1:uebergibpunktdererstenkurveancoroutine.zeichnefuerkurve2:uebergibpunktderzweitenkurveancoroutine.loescheerstenfuerkurve1:co1wastun:=anfpunktloeschen;uebergibpunktdererstenkurveancoroutine.loescheerstenfuerkurve2:co2wastun:=anfpunktloeschen;uebergibpunktderzweitenkurveancoroutine.uebergibpunktdererstenkurveancoroutine:coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik).uebergibpunktderzweitenkurveancoroutine:coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik).liesoderwarteaufbenutzereingaben:REPliesbenutzereingaben(taste,tasteninnen,tastenraus,merker);IFtaste<>""THENinterpretieretasteundfuehreaktionausELSErichtungswechsel:=FALSE;LEAVEliesoderwarteaufbenutzereingabenFI;PER.interpretieretasteundfuehreaktionaus:IF(pos(tastenraus,taste)>0)THENabbruchtaste:=taste;LEAVEvorwaertsundrueckwaertsFI;IFtaste=rechtsTHENrichtungswechsel:=NOTvorwaertslesen;vorwaertslesen:=TRUE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=linksTHENrichtungswechsel:=vorwaertslesen;vorwaertslesen:=FALSE;LEAVEliesoderwarteaufbenutzereingabenELIFtaste=plottenTHENplotteloesungskurveELIFtaste=tasteblaetternTHENblaettern(seite);out(hop)ELIFtaste=tasteblaetternobenTHENblaetternoben(seite);out(hop)ELIFtaste=tasteblaetternuntenTHENblaetternunten(seite);out(hop)FI.plotteloesungskurve:nildiagrammmitkreuz(seite,fenster1);nildiagrammmitkreuz(seite,fenster2);co1wastunalt:=co1wastun;co1wastun:=bildschirminhaltplotten;coroutine(seite,fenster1,k1,zeitt1,maskeintern,zustand1,dsco1,co1wastun,x1min,x1max,ymin,ymax,automatik);co1wastun:=co1wastunalt;co2wastunalt:=co2wastun;co2wastun:=bildschirminhaltplotten;coroutine(seite,fenster2,k2,zeitt2,maskeintern,zustand2,dsco2,co2wastun,x2min,x2max,ymin,ymax,automatik)
+;co2wastun:=co2wastunalt;versendeoutput(seite,modellkurzbezeichnung,kopfzeile,steuerzeile,plottask);piep.piep:out(piepton).END PROCsteuerprozessfuerzweiloesungen;PROCliesbenutzereingaben(TEXT VARtaste,TEXT CONSTtasteninnen,tastenraus,INT VARmerker):SELECTmerkerOF CASEwarten1:erkenneescCASEwarten2:warteaufnaechstetasteEND SELECT.erkenneesc:taste:=incharety;IFtaste=escTHENwarteaufnaechstetasteELSEtaste:=""FI.warteaufnaechstetaste:inchar(taste);WHILE NOTtastezulaessigREP IFtaste<>escTHENpiepFI;inchar(taste);PER;IF(pos(tastenraus,taste)>0)THEN LEAVEliesbenutzereingabenELIFtaste=hopTHENrichtungfestlegenELSEmerker:=warten2FI.tastezulaessig:(pos(tasteninnen+tastenraus,taste)>0)COR(taste=hop)COR(taste=rechts)COR(taste=links).richtungfestlegen:inchar(taste);WHILE NOT((taste=rechts)COR(taste=links))REPpiep;inchar(taste);PER;merker:=warten1.piep:out(code(7)).END PROCliesbenutzereingaben;INT PROCinternerzustandnach0v:IFzeitt1<zeitt2THEN1ELIFzeitt1>zeitt2THEN5ELSE4FI.END PROCinternerzustandnach0v;INT PROCinternerzustandnach1v:IFendederloesung(k1)THEN3ELSEnaechstezeit(k1,zeitt1);IFzeitt1<=zeitt2THEN2ELSE3FI FI.END PROCinternerzustandnach1v;INT PROCinternerzustandnach2v:internerzustandnach1vEND PROCinternerzustandnach2v;INT PROCinternerzustandnach3v:IFendederloesung(k1)CANDendederloesung(k2)THEN13ELIFendederloesung(k1)THEN11ELIFendederloesung(k2)THEN12ELSEnaechstezeit(k1,zeitt1);naechstezeit(k2,zeitt2);IFzeitt1<zeitt2THEN8ELIFzeitt1>zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach3v;INT PROCinternerzustandnach4v:internerzustandnach3vEND PROCinternerzustandnach4v;INT PROCinternerzustandnach5v:IFendederloesung(k2)THEN7ELSEnaechstezeit(k2,zeitt2);IFzeitt2<=zeitt1THEN6ELSE7FI FI.END PROCinternerzustandnach5v;INT PROCinternerzustandnach6v:internerzustandnach5vEND PROCinternerzustandnach6v;INT PROCinternerzustandnach7v:internerzustandnach3vEND PROCinternerzustandnach7v;INT PROCinternerzustandnach8v:IFendederloesung(k1)THEN11ELSEnaechstezeit(k1,zeitt1);IFzeitt1<zeitt2THEN8ELIFzeitt1>zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach8v;INT PROCinternerzustandnach9v:internerzustandnach3v.END PROCinternerzustandnach9v;INT PROCinternerzustandnach10v:IFendederloesung(k2)THEN12ELSEnaechstezeit(k2,zeitt2);IFzeitt1<zeitt2THEN8ELIFzeitt1>zeitt2THEN10ELSE9FI FI.END PROCinternerzustandnach10v;INT PROCinternerzustandnach11v:IFendederloesung(k2)THEN13ELSE11FI.END PROCinternerzustandnach11v;INT PROCinternerzustandnach12v:IFendederloesung(k1)THEN13ELSE12FI.END PROCinternerzustandnach12v;INT PROCinternerzustandnach2r:IFanfangderloesung(k1)THEN1ELSE2FI.END PROCinternerzustandnach2r;INT PROCinternerzustandnach3r:internerzustandnach2r.END PROCinternerzustandnach3r;INT PROCinternerzustandnach6r:IFanfangderloesung(k2)THEN5ELSE6FI.END PROCinternerzustandnach6r;INT PROCinternerzustandnach7r:internerzustandnach6r.END PROCinternerzustandnach7r;INT PROCinternerzustandnach8r:IFanfangderloesung(k1)CANDanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN7ELIFzeitt1<zeitt2THEN3ELSE4FI ELIFanfangderloesung(k1)THEN IFzeitt1>=zeitt2THEN7ELSE10FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN8ELSE3FI ELIFzeitt1>zeitt2THEN8ELIFzeitt1<zeitt2THEN10ELSE9FI.END PROCinternerzustandnach8r;INT PROCinternerzustandnach9r:internerzustandnach8r.END PROCinternerzustandnach9r;INT PROCinternerzustandnach10r:internerzustandnach8r.END PROCinternerzustandnach10r;INT PROCinternerzustandnach11r:IFanfangderloesung(k1)CANDanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN7ELIFzeitt1<zeitt2THEN3ELSE4FI ELIFanfangderloesung(k1)THEN IFzeitt1>=zeitt2THEN7ELSE11FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN8ELSE3FI ELIFzeitt1>zeitt2THEN8ELIFzeitt1<zeitt2THEN11ELSE9FI.END PROCinternerzustandnach11r;INT PROCinternerzustandnach12r:IFanfangderloesung(k1)CANDanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN7ELIFzeitt1<zeitt2THEN3ELSE4FI ELIFanfangderloesung(k1)THEN IFzeitt1>=zeitt2THEN7ELSE10FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN12ELSE3FI ELIFzeitt1>zeitt2THEN12ELIFzeitt1<zeitt2THEN10ELSE9FI.END PROC
+internerzustandnach12r;INT PROCinternerzustandnach13r:IFanfangderloesung(k1)CANDanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN7ELIFzeitt1<zeitt2THEN3ELSE4FI ELIFanfangderloesung(k1)THEN IFzeitt1>=zeitt2THEN7ELSE11FI ELIFanfangderloesung(k2)THEN IFzeitt1>zeitt2THEN12ELSE3FI ELIFzeitt1>zeitt2THEN12ELIFzeitt1<zeitt2THEN11ELSE9FI.END PROCinternerzustandnach13r;END PACKETsteuerung;
+
diff --git a/app/schulis/2.2.1/data/db/2.BAISY-0 b/app/schulis/2.2.1/data/db/2.BAISY-0
new file mode 100644
index 0000000..9412329
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/2.BAISY-0
diff --git a/app/schulis/2.2.1/data/db/2.BAISY-1 b/app/schulis/2.2.1/data/db/2.BAISY-1
new file mode 100644
index 0000000..5840f5d
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/2.BAISY-1
diff --git a/app/schulis/2.2.1/data/db/BAISY-2 b/app/schulis/2.2.1/data/db/BAISY-2
new file mode 100644
index 0000000..d5066ff
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/BAISY-2
diff --git a/app/schulis/2.2.1/data/db/BAISY-3 b/app/schulis/2.2.1/data/db/BAISY-3
new file mode 100644
index 0000000..dd2af90
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/BAISY-3
diff --git a/app/schulis/2.2.1/data/db/BAISY-4 b/app/schulis/2.2.1/data/db/BAISY-4
new file mode 100644
index 0000000..52ce9bf
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/BAISY-4
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy b/app/schulis/2.2.1/data/db/EUMELbase.baisy
new file mode 100644
index 0000000..2e9852b
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy.data0 b/app/schulis/2.2.1/data/db/EUMELbase.baisy.data0
new file mode 100644
index 0000000..b11232d
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy.data0
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy.data1 b/app/schulis/2.2.1/data/db/EUMELbase.baisy.data1
new file mode 100644
index 0000000..3cdc6a2
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy.data1
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree0 b/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree0
new file mode 100644
index 0000000..7b13c5c
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree0
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree1 b/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree1
new file mode 100644
index 0000000..026ef9f
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy.tree1
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.baisy.treedescription b/app/schulis/2.2.1/data/db/EUMELbase.baisy.treedescription
new file mode 100644
index 0000000..ea123ac
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.baisy.treedescription
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis b/app/schulis/2.2.1/data/db/EUMELbase.schulis
new file mode 100644
index 0000000..fae85ba
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis.data0 b/app/schulis/2.2.1/data/db/EUMELbase.schulis.data0
new file mode 100644
index 0000000..42a82fc
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis.data0
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis.data1 b/app/schulis/2.2.1/data/db/EUMELbase.schulis.data1
new file mode 100644
index 0000000..2e5fd82
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis.data1
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree0 b/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree0
new file mode 100644
index 0000000..7bc7a83
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree0
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree1 b/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree1
new file mode 100644
index 0000000..c0daa5f
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis.tree1
diff --git a/app/schulis/2.2.1/data/db/EUMELbase.schulis.treedescription b/app/schulis/2.2.1/data/db/EUMELbase.schulis.treedescription
new file mode 100644
index 0000000..17154f0
--- /dev/null
+++ b/app/schulis/2.2.1/data/db/EUMELbase.schulis.treedescription
diff --git a/app/schulis/2.2.1/data/vordrucke/VORDRUCKE.files b/app/schulis/2.2.1/data/vordrucke/VORDRUCKE.files
new file mode 100644
index 0000000..b055c9e
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/VORDRUCKE.files
@@ -0,0 +1,49 @@
+vordruck anmeldebestaetigung zur jgst 5
+vordruck anmeldebestaetigung zur jgst 11
+vordruck mitteilung ueber eine abmeldung
+vordruck mitteilung ueber eine anmeldung mit hjd
+vordruck mitteilung ueber eine anmeldung mit diffd
+vordruck schulbescheinigung
+vordruck fuer wiederholer
+vordruck nachpruefungsbescheinigung
+vordruck fuer anschreiben an herkunftsschulen fuer jgst 11
+vordruck fuer anschreiben an herkunftsschulen fuer jgst 5
+vordruck1 auskunft betroffene
+vordruck2 auskunft betroffene
+vordruck3 auskunft betroffene
+vordruck4 auskunft betroffene
+vordruck5 auskunft betroffene
+vordruck1 protokoll versetzkonf
+vordruck2 protokoll versetzkonf
+vordruck3 protokoll versetzkonf
+vordruck klassenbuchliste
+vordruck nachpruefungszulassung
+vordruck1 auskunft lehrer
+vordruck2 auskunft lehrer
+vordruck3 auskunft lehrer
+vordruck4 auskunft lehrer
+vordruck5 auskunft lehrer
+vordruck1 einzelstdpl lehrer
+vordruck2 einzelstdpl lehrer
+vordruck1 einzelstdpl raeume
+vordruck2 einzelstdpl raeume
+vordruck1 einzelstdpl sek1
+vordruck2 einzelstdpl sek1
+vordruck3 einzelstdpl sek1
+vordruck4 einzelstdpl sek1
+vordruck5 einzelstdpl sek1
+vordruck6 einzelstdpl sek1
+vordruck7 einzelstdpl sek1
+fehlerliste konsistenzpruefung
+vordruck6 auskunft lehrer
+vordruck7 auskunft lehrer
+vordruck1 unterrichtsvertlg fuer lehrer
+vordruck2 unterrichtsvertlg fuer lehrer
+vordruck1 vertretungen
+vordruck2 vertretungen
+vordruck1 einzelstdpl sek2
+vordruck2 einzelstdpl sek2
+vordruck1 kursli kopfueb
+vordruck2 kursli zeile
+vordruck3 einzelstdpl lehrer
+
diff --git a/app/schulis/2.2.1/data/vordrucke/fehlerliste konsistenzpruefung b/app/schulis/2.2.1/data/vordrucke/fehlerliste konsistenzpruefung
new file mode 100644
index 0000000..d1e0343
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/fehlerliste konsistenzpruefung
@@ -0,0 +1,64 @@
+Fall 1: 
+Klassengruppe # : ungültige Schülergruppenbezeichnung # 
+Fall 2: 
+Raumgruppe # : ungültige Raumbezeichnung # 
+Fall 3: 
+Lehrveranstaltung # : ungültige Fachbezeichnung # 
+Fall 4: 
+Lehrveranstaltung # : ungültige Lehrerparaphe # 
+Fall 5: 
+Lehrveranstaltung # : # weder gültig als Klassengruppe, noch als 
+Kennung einer Schülergruppe dieser Jgst. 
+Fall 6: 
+Lehrveranstaltung # , Klassengruppe # : 
+     Fehlermeldung zur Klassengruppe beachten! 
+Fall 7: 
+Lehrveranstaltung # : # weder gültig als Raumgruppe, noch als Raum 
+Fall 8: 
+Lehrveranstaltung # : Raumgruppe # : 
+     Fehlermeldung zur Raumgruppe beachten! 
+Fall 9: 
+Lehrer # : mehr Wochenstunden als Sollstunden 
+Fall 10: 
+Zeitwünsche: # ungültige Bezeichnung für # 
+     ******  Zeitwunsch wurde gelöscht ******* 
+Fall 11: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     ungültige Lehrveranstaltungsbezeichnung 
+     ******  Stundenplaneintrag wurde gelöscht ****** 
+Fall 12: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     Fehlermeldung für diese Lehrveranstaltung beachten! 
+Fall 13: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     Lehrerparaphe zwischenzeitlich geändert : alt #, neu # 
+     ******  neue Paraphe eingesetzt, keine Zeitüberschneidung  ******  
+Fall 14: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     Lehrerparaphe zwischenzeitlich geändert : alt #, neu # 
+     für neue Paraphe evtl. Zeitüberschneidung 
+Fall 15: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     ******  ungültige Raumangabe wurde gelöscht  ******  
+Fall 16: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     Kopplung zwischenzeitlich geändert: alt # , neu # 
+     ******  neue Kopplung eingesetzt  ******  
+Fall 17: 
+Stundenplan für Lehrveranstaltung # , Zeit # : 
+     Zeitüberschneidung für Schüler 
+Fall 18: 
+Stundenplan für Zeit # : Zeit laut Zeitraster gesperrt 
+     betrifft Lehrveranstaltung # 
+     ******  Eintrag für diese Zeit wurde gelöscht  ******  
+Fall 19: 
+Aufsichtsplan für Aufsichtszeit # : Aufsichtszeit ungültig 
+     ******  Eintrag wurde gelöscht  ******  
+Fall 20: 
+Aufsichtsplan für Aufsichtszeit # und Aufsichtsort #: 
+     Aufsichtsort ungültig  
+Fall 21: 
+Aufsichtsplan für Aufsichtszeit # und Aufsichtsort #: 
+     Lehrerparaphe ungültig 
+ 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 11 b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 11
new file mode 100644
index 0000000..eca6b7e
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 11
@@ -0,0 +1,47 @@
+<502                                                >                 
+<503                                                > 
+ 
+<504                                                >        <501   > 
+ 
+ 
+ 
+ 
+ 
+<511%v#<20> <21%#*<21> ><3>#m#<29> <30%#*<30> ><28>> 
+<24                           >> 
+ 
+<25                                                 >> 
+ 
+ 
+ 
+ 
+ 
+ 
+<511%v#Ihre Anmeldung an unsere Schule zum Schuljahr <507>><512%w#Anmeldung der Schülerin #m#Anmeldung des Schülers ><511%m#<20> <21%#*<21> ><3>>
+<511%m#an unsere Schule zum Schuljahr <507>> 
+ 
+ 
+Wir bestätigen hiermit, daß <511%v#Sie><512%w#die Schülerin #m#der Schüler ><511%m#<20> <21%#*<21> ><3>>
+entsprechend Ihrem Wunsch zum Schuljahr <507  >> in die Jahrgangsstufe 11
+unserer Schule aufgenommen <511%v#werden#m#wird>. Diese Zusage erfolgt unter der
+Bedingung, daß <511%v#Sie><512%m#der Schüler#w#die Schülerin> bis zum 3. Schultag
+des kommenden Schuljahres die entsprechenden Voraussetzungen <511%v#erfüllen#m#erfüllt>. 
+ 
+In der Anlage finden Sie weitere Informationen und Termine. 
+ 
+Es ist unbedingt erforderlich, daß <511%v#Sie><512%w#die Schülerin#m#der Schüler> an den
+Kurswahlen termingerecht <511%v#teilnehmen#m#teilnimmt>, damit die Schule das
+Unterrichtsangebot für das kommende Schuljahr gewährleisten kann. Aus dem
+gleichen Grund bitten wir auch, uns unverzüglich zu informieren, wenn
+<511%v#Sie><512%w#die Schülerin#m#der Schüler> nicht wie vorgesehen in unsere Schule
+eintreten <511%v#werden#m#wird>. 
+ 
+ 
+Mit freundlichen Grüßen 
+ 
+ 
+ 
+ 
+<506                 >> 
+(Schulleiter) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5 b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5
new file mode 100644
index 0000000..d9eff7f
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck anmeldebestaetigung zur jgst 5
@@ -0,0 +1,38 @@
+<502                                                >                 
+<503                                                > 
+ 
+<504                                                >        <501   > 
+ 
+ 
+ 
+ 
+<29                      >> <30%#*<30> ><28                       >> 
+<31                           >> 
+ 
+<32                                                 >> 
+ 
+ 
+ 
+ 
+ 
+ 
+Aufnahme <12%m#des Schülers#w#der Schülerin> <20                    >> <21%#*<21> ><3                          >> an
+unsere Schule zur Jahrgangsstufe 5 
+ 
+ 
+Wir bestätigen hiermit, daß <12%w#Ihre Tochter#m#Ihr Sohn> <20                    >>
+entsprechend Ihrem Wunsch zum Schuljahr <507  >> in die Jahrgangsstufe 5
+unserer Schule aufgenommen wurde. 
+ 
+Einzelheiten zum Schulbeginn entnehmen Sie bitte dem beiliegenden
+Informationsblatt. 
+ 
+ 
+Mit freundlichen Grüßen 
+ 
+ 
+ 
+ 
+<506                 >> 
+(Schulleiter) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11 b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11
new file mode 100644
index 0000000..c61cb47
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 11
@@ -0,0 +1,15 @@
+Anmeldung von Schülern zur Jahrgangsstufe 11 
+ 
+ 
+Sehr geehrte Damen und Herren, 
+ 
+die nachstehend genannten Schülerinnen und Schüler Ihrer Schule wurden zum
+kommenden Schuljahr für die Jahrgangsstufe 11 an unserer Schule angemeldet.
+Wir bitten Sie, uns jeweils zu bestätigen, ob die Schülerin/der Schüler eine
+2. Fremdsprache gelernt hat, die den Bedingungen der Ausbildungs- und
+Prüfungsordnung der gymnasialen Oberstufe genügt. Wir bitten um Antwort bis
+zum Beginn des kommenden Schuljahrs. 
+ 
+ 
+Mit freundlichen Grüßen 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5 b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5
new file mode 100644
index 0000000..d6593ac
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer anschreiben an herkunftsschulen fuer jgst 5
@@ -0,0 +1,13 @@
+Anmeldung von Schülern zur Jahrgangsstufe 5 
+ 
+ 
+Sehr geehrte Damen und Herren, 
+ 
+die nachstehend genannten Schülerinnen und Schüler Ihrer Schule wurden zum
+kommenden Schuljahr für die Jahrgangsstufe 5 an unserer Schule angemeldet.
+Wir bitten Sie, uns jeweils das Grundschulgutachten und das letzte Zeugnis
+dieser Schüler im Verlauf der nächsten zwei Wochen zuzusenden.
+ 
+ 
+Mit freundlichen Grüßen 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer b/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer
new file mode 100644
index 0000000..6f5a224
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck fuer wiederholer
@@ -0,0 +1,44 @@
+<502                                                >                 
+<503                                                > 
+ 
+<504                                                >        <501   > 
+ 
+ 
+ 
+ 
+<511%v#<20> <21%#*<21> ><3>#m#<29> <30%#*<30> ><28>> 
+<24                           >> 
+ 
+<25                                                > 
+ 
+ 
+ 
+ 
+ 
+Versetzung zum Ende des Schuljahres <505    >> 
+ 
+ 
+Laut Beschluß der Versetzungskonferenz<511%v# haben Sie>
+<512%w#hat Ihre Tochter #m#hat Ihr Sohn ><511%m#<20> >die Versetzung in die
+Jahrgangsstufe <513>> nicht erreicht. 
+ 
+Das diesem Beschluß zugrundeliegende Zeugnis fügen wir als Anlage bei. Wir
+überlassen es Ihrer Entscheidung, ob<511%v# Sie>
+<512%w#Ihre Tochter #m#Ihr Sohn >am letzten Schultag
+<511%v#teilnehmen#m#teilnimmt>. 
+ 
+Falls Sie wünschen, daß <511%v#Sie><512%w#Ihre Tochter#m#Ihr Sohn> in eine
+bestimmte Klasse/Tutorenkurs aufgenommen <511%v#werden#m#wird>, sind wir
+bemüht, dies zu realisieren, sofern Sie uns Ihren Wunsch und die Gründe
+dafür bis zum ersten Ferientag wissen lassen. 
+ 
+ 
+Mit freundlichen Grüßen 
+ 
+ 
+ 
+ 
+<506                 >> 
+(Schulleiter) 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste b/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste
new file mode 100644
index 0000000..880662a
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck klassenbuchliste
@@ -0,0 +1,5 @@
+<511%#*<511>> 
+<503                                                  > 
+ 
+<512%#*<512>> 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung
new file mode 100644
index 0000000..1493b9f
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine abmeldung
@@ -0,0 +1,54 @@
+<502                                                      >           
+<503                                                      > 
+ 
+<504                                                      >  <501   > 
+ 
+ 
+ 
+ 
+ 
+Mitteilung über eine Abmeldung 
+ 
+ 
+ 
+Am <512%#___________*<512>> verläßt unsere Schule: 
+ 
+           Schüler:  <513                                       > 
+      Geburtsdatum:  <514                  > 
+ 
+      Abgangsgrund:  <515                                       > 
+ 
+ 
+Klasse/Tutorenkurs:  <519    >><520%#*, <520>> 
+ 
+ 
+ 
+Kurs    Fachlehrer                           Unterschr. Note Anz.entl 
+                                                              Bücher 
+-------:------------------------------------:----------:----:-------- 
+ 
+<530  >><531                              >><530%#<590>* <591>> 
+<532  >><533                              >><532%#<590>* <591>> 
+<534  >><535                              >><534%#<590>* <591>> 
+<536  >><537                              >><536%#<590>* <591>> 
+<538  >><539                              >><538%#<590>* <591>> 
+<540  >><541                              >><540%#<590>* <591>> 
+<542  >><543                              >><542%#<590>* <591>> 
+<544  >><545                              >><544%#<590>* <591>> 
+<546  >><547                              >><546%#<590>* <591>> 
+<548  >><549                              >><548%#<590>* <591>> 
+<550  >><551                              >><550%#<590>* <591>> 
+<552  >><553                              >><552%#<590>* <591>> 
+<554  >><555                              >><554%#<590>* <591>> 
+<556  >><557                              >><556%#<590>* <591>> 
+<558  >><559                              >><558%#<590>* <591>> 
+ 
+ 
+ 
+             erreichter Abschluß:  <516                          > 
+ 
+          Zeugnis ausgestellt am:  ____________________ 
+ 
+Unterschrift Klassenlehrer/Tutor:  ______________________________ 
+ 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd
new file mode 100644
index 0000000..8fbfa16
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit diffd
@@ -0,0 +1,44 @@
+<502                                                   >              
+<503                                                   > 
+ 
+<504                                                   >     <501   > 
+ 
+ 
+ 
+ 
+ 
+Mitteilung über eine Anmeldung 
+ 
+ 
+ 
+Ab dem <512       >> nimmt am Unterricht teil: 
+ 
+ 
+           Schüler:  <513                                           > 
+      Geburtsdatum:  <514            > 
+ 
+           Adresse:  <516                                        > 
+                     <517                                        > 
+           Telefon:  <518                         > 
+ 
+ 
+ 
+Klasse/Tutorenkurs:  <519  >><520%#*, <520>> 
+ 
+ 
+<530%#*Der Schüler nimmt teil am Unterricht in:> 
+ 
+<<530             >  <531                          > 
+<<532             >  <533                          > 
+<<534             >  <535                          > 
+<<536             >  <537                          > 
+<<538             >  <539                          > 
+<<540             >  <541                          > 
+<<542             >  <543                          > 
+<<544             >  <545                          > 
+<<546             >  <547                          > 
+<<548             >  <549                          > 
+<<550             >  <551                          > 
+<<552             >  <553                          > 
+<<554             >  <555                          > 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd
new file mode 100644
index 0000000..fa551f8
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck mitteilung ueber eine anmeldung mit hjd
@@ -0,0 +1,48 @@
+<502                                                   >              
+<503                                                   > 
+ 
+<504                                                   >     <501   > 
+ 
+ 
+ 
+ 
+ 
+Mitteilung über eine Anmeldung 
+ 
+ 
+ 
+Ab dem <512       >> nimmt am Unterricht teil: 
+ 
+ 
+           Schüler:  <513                                           > 
+      Geburtsdatum:  <514            > 
+ 
+           Adresse:  <516                                        > 
+                     <517                                        > 
+           Telefon:  <518                         > 
+ 
+ 
+ 
+Klasse/Tutorenkurs:  <519  >><520%#*, <520>> 
+ 
+ 
+<530%#*Der Schüler nimmt teil am Unterricht in:> 
+ 
+<530%#*Kurs    Fach                            Fachlehrer> 
+<530%#*-------:-------------------------------:-----------------------------> 
+<530  > <531                          > <532                       >> 
+<533  > <534                          > <535                       >> 
+<536  > <537                          > <538                       >> 
+<539  > <540                          > <541                       >> 
+<542  > <543                          > <544                       >> 
+<545  > <546                          > <547                       >> 
+<548  > <549                          > <550                       >> 
+<551  > <552                          > <553                       >> 
+<554  > <555                          > <556                       >> 
+<557  > <558                          > <559                       >> 
+<560  > <561                          > <562                       >> 
+<563  > <564                          > <565                       >> 
+<566  > <567                          > <568                       >> 
+<569  > <570                          > <571                       >> 
+<572  > <573                          > <574                       >> 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung
new file mode 100644
index 0000000..406c2c7
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungsbescheinigung
@@ -0,0 +1,34 @@
+<502                                                >                 
+<503                                                > 
+ 
+<504                                                >        <501   > 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+Bescheinigung 
+ 
+ 
+Gemäß <519%#*<519>> hat <514%m#der Schüler#w#die Schülerin>
+<513                    >> <512%#*<512> ><511                     >>,
+geboren am <515        >>, in Jahrgangsstufe <517>> im
+Fach <518%#                     *<518 >> an einer Prüfung
+teilgenommen.
+<514%m#Er#w#Sie> hat die Nachprüfung <516%x#nicht >bestanden und damit
+<520%#                      *<520>> <516%x#nicht >erreicht. 
+ 
+Diese Bescheinigung ist nur in Verbindung mit dem Versetzungszeugnis des
+Schuljahres <508   >> gültig. Auf Antrag wird ein neues Zeugnis mit
+der in der Nachprüfung erreichten Note ausgestellt. 
+ 
+ 
+ 
+ 
+ 
+ 
+<506                >> 
+(Schulleiter) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung
new file mode 100644
index 0000000..032afcb
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck nachpruefungszulassung
@@ -0,0 +1,48 @@
+<502                                                  >        
+<503                                                  > 
+ 
+<504                                                  >     <501    > 
+ 
+ 
+ 
+ 
+ 
+<515%v#<513> <512%#*<512> ><511>#m#<521> <520%#*<520> ><519>> 
+<515%v#<517>#m#<522>> 
+ 
+<515%v#<518>#m#<523>> 
+ 
+ 
+ 
+ 
+ 
+Versetzung zum Ende des Schuljahres <505  >> 
+ 
+ 
+Gemäß <524%#*<524>> hat die Versetzungskonferenz festgestellt, daß
+<515%v#Sie#m#<514%m#Ihr Sohn#w#Ihre Tochter> <513>> eine Nachprüfung
+<525%#*in <525>> ablegen <515 %v#können#m#kann>. 
+ 
+Durch die Nachprüfung kann nachträglich <526%#               *<526>>
+erworben werden. 
+ 
+Die Prüfung findet in den ersten Tagen nach den Schulferien statt.
+Meldungen sind unter Angabe des Prüfungsfaches bis zum Ende der
+zweiten Ferienwoche im Sekretariat abzugeben. Die genauen
+Prüfungstermine erfragen Sie bitte in der letzten Ferienwoche im
+Sekretariat. 
+ 
+Das diesem Beschluß zugrundeliegende Zeugnis fügen wir als Anlage
+bei. Wir überlassen es Ihrer Entscheidung, ob
+<515%v#Sie#m#<514%m#Ihr Sohn#w#Ihre Tochter> <513>> am letzten
+Schultag am Unterricht <515%v#teilnehmen#m#teilnimmt>. 
+ 
+ 
+Mit freundlichen Grüßen 
+ 
+ 
+ 
+ 
+<506                      >> 
+(Schulleiter) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung b/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung
new file mode 100644
index 0000000..84c95a8
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck schulbescheinigung
@@ -0,0 +1,29 @@
+<502                                                >                 
+<503                                                > 
+ 
+<504                                                >     <501     > 
+ 
+ 
+ 
+ 
+ 
+Bescheinigung 
+ 
+ 
+ 
+ 
+<12%m#Der Schüler#w#Die Schülerin> <20                   >> <21%#*<21> ><3                     >>, 
+ 
+geboren am <5        >>, 
+ 
+ist im Schuljahr <505   >> <12%m#Schüler#w#Schülerin> der Jahrgangsstufe <7>>
+unserer Schule. 
+ 
+ 
+ 
+ 
+ 
+ 
+<506                >> 
+(Schulleiter) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene
new file mode 100644
index 0000000..c922e82
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft betroffene
@@ -0,0 +1,60 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+Auskunft über die im schulis-System gespeicherten Daten des Schülers 
+ 
+Familienname: <3                           > 
+Namenszusatz: <21   >          Geburtsname: <22                > 
+     Rufname: <4            >     Vornamen: <20                > 
+Geburtsdatum: <5     > 
+ 
+      Status: <6 > <583                                             > 
+ 
+     Adresse: <24                               > 
+              <511                       > 
+     Telefon: <26           > 
+              <512               > 
+    Ortsteil: <27>> <513                                          >> 
+ 
+erziehungsberechtigt: <34>> <514                                  >> 
+                Name: <28                          > 
+            Vornamen: <29                               > 
+       Namenszusätze: <30   > 
+             Adresse: <568                              > 
+                      <515                       > 
+             Telefon: <569          > 
+ 
+       Geburtsort/Kreis: <40               >> / <41                >> 
+    Staatsangehörigkeit: <35  >> <516                                >> 
+          Muttersprache: <39  >> <517                                >> 
+         Spätaussiedler: <518    >> 
+             Geschlecht: <12>> <519                                >> 
+ Religionszugehörigkeit: <36  >> <520                                >> 
+Zeugnisvermerk Religion: <521>> 
+ 
+      Einschulungsjahr: <42>> 
+         letzte Schule: <570                                   > 
+                        <571                              > 
+                        <522                       > 
+    letzte Klasse dort: <15>       Schulform: <582>> <523                >> 
+ 
+      Eintritt in diese Schule: <43    >      in Jahrgangsstufe: <13>> 
+            Eintritt in Sek.II: <524> 
+        aktuelle Schülergruppe: <7   >> <8   >> 
+Zugang zur akt. Jahrgangsstufe: <10>> <525                           >> 
+               neuer Zug/Tutor: <11> 
+ 
+       Abgangsdatum: <16    >     Abgangsgrund: <17  >> <526                >> 
+erworbener Abschluß: <18  >> <527                   >> 
+        neue Schule: <572                                   > 
+                     <573                              > 
+                     <528                       > 
+ 
+           Vermerk1: <45 > 
+           Vermerk2: <46 > 
+           Vermerk3: <47 > 
+           Vermerk4: <48 > 
+           Vermerk5: <49 > 
+           Vermerk6: <50 > 
+ 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer
new file mode 100644
index 0000000..7bedad8
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 auskunft lehrer
@@ -0,0 +1,38 @@
+<502                                                  >                     
+<503                                                  > 
+<504                                        >                   <501      > 
+ 
+       Auskunft an Betroffene im Sinne des Datenschutzesgesetzes              
+       für: <511> <151%#*<151>> <513                                      > 
+ 
+       (Stunden- und Aufsichtsplan werden auf Wunsch gesondert erstellt.) 
+ 
+                   Paraphe: <147> 
+              Familienname: <148                         > 
+                   Rufname: <149           > 
+              Namenszusatz: <150  > 
+    Amtsbezeichnung, Titel: <151          > 
+                Geschlecht: <152> 
+ 
+      Adresse  Straße, Nr.: <164                               > 
+                  PLZ, Ort: <165                         > 
+                   Tel.Nr.: <166          >                                 
+ 
+              Sprechzeiten: <163                    > 
+ 
+               Sollstunden: <153> 
+            Pflichtstunden: <154> 
+              Ermäßigung 1: <155> Grund: <156>(<550                   >>) 
+              Ermäßigung 2: <157> Grund: <158>(<551                   >>) 
+              Ermäßigung 3: <159> Grund: <160>(<552                   >>) 
+              Ermäßigung 4: <161> Grund: <162>(<553                   >>) 
+ 
+     Lehrbefähigung Fach 1: <514 >  Art: <515>(<554                   >>) 
+                    Fach 2: <516 >  Art: <517>(<555                   >>) 
+                    Fach 3: <518 >  Art: <519>(<556                   >>) 
+                    Fach 4: <520 >  Art: <521>(<557                   >>) 
+                    Fach 5: <522 >  Art: <523>(<558                   >>) 
+                    Fach 6: <524 >  Art: <525>(<559                   >>) 
+ 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer
new file mode 100644
index 0000000..5dc680e
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl lehrer
@@ -0,0 +1,13 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+ 
+Stundenplan für <511>> <151%#*<151>> <512                               >> 
+Schuljahr <514>>, <515>>. Halbjahr                      
+ 
+ 
+ 
+Std: Montag    : Dienstag  : Mittwoch  : Donnerstag: Freitag   : Samstag   : 
+---+-----------+-----------+-----------+-----------+-----------+-----------: 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume
new file mode 100644
index 0000000..2158494
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl raeume
@@ -0,0 +1,13 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+ 
+Belegungsplan für Raum <511>>  (<514                   >>) 
+Schuljahr <512>>, <513>>. Halbjahr                      
+ 
+ 
+ 
+Std: Montag    : Dienstag  : Mittwoch  : Donnerstag: Freitag   : Samstag   : 
+---+-----------+-----------+-----------+-----------+-----------+-----------: 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1
new file mode 100644
index 0000000..e58f75f
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek1
@@ -0,0 +1,14 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+ 
+Stundenplan für Klasse <511> 
+Schuljahr <512>>, <513>>. Halbjahr                      
+ 
+ Klassenleiter: <514                                                       > 
+Stellvertreter: <516                                                       > 
+ 
+Std: Montag    : Dienstag  : Mittwoch  : Donnerstag: Freitag   : Samstag   : 
+---+-----------+-----------+-----------+-----------+-----------+-----------: 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2 b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2
new file mode 100644
index 0000000..662b9f2
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 einzelstdpl sek2
@@ -0,0 +1,14 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+ 
+Stundenplan für <511        >> <512                       >>, geb. <513    > 
+Schuljahr <514>>, <515>>. Halbjahr                      
+ 
+Tutorkurs: <516                                                            > 
+ 
+ 
+Std: Montag    : Dienstag  : Mittwoch  : Donnerstag: Freitag   : Samstag   : 
+---+-----------+-----------+-----------+-----------+-----------+-----------: 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb b/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb
new file mode 100644
index 0000000..b9a87c7
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 kursli kopfueb
@@ -0,0 +1,10 @@
+<502                                                  >         <501      > 
+<504                                                  > 
+ 
+  Kurs : <520     > 
+Lehrer : <521>><522                                                    > 
+ 
+Hinweis: Familienname, Rufname, Geburtsdatum 
+-------+------------------------------------------------------------------- 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf
new file mode 100644
index 0000000..d064f40
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 protokoll versetzkonf
@@ -0,0 +1,6 @@
+<502                                                    >          <501   > 
+<503                                                  > 
+ 
+ 
+Versetzungskonferenz zum Ende des Schuljahrs 19<505>, <511                > 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer
new file mode 100644
index 0000000..0d85b97
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 unterrichtsvertlg fuer lehrer
@@ -0,0 +1,21 @@
+<502                                                  >                     
+<503                                                  > 
+<504                                        >                   <501      > 
+ 
+Unterrichtsverteilung im Schuljahr <520>, <521>>. Halbjahr 
+ 
+<522>> <151>> <150 >> <148                                                >> 
+ 
+ 
+                   Paraphe: <147> 
+       
+               Sollstunden: <153> 
+            Pflichtstunden: <154> 
+              Ermäßigung 1: <155> Grund: <156>(<530                   >>) 
+              Ermäßigung 2: <157> Grund: <158>(<531                   >>) 
+              Ermäßigung 3: <159> Grund: <160>(<532                   >>) 
+              Ermäßigung 4: <161> Grund: <162>(<533                   >>) 
+ 
+      Lehrveranstaltungen : <<183> <534>> <535> Wstd.: <<536> 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen b/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen
new file mode 100644
index 0000000..e1b636d
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck1 vertretungen
@@ -0,0 +1,14 @@
+<502                                                  >                     
+<503                                                  > 
+<504                                        >                   <501      > 
+ 
+Aufstellung der Daten über Vertretungen und Freistunden 
+ 
+für: <550                                                                 > 
+ 
+ 
+Datum     Zeit   Art   ausgefallene/vertretene 
+                       Lehrveranstaltungen 
+--------+------+-----+----------------------------- 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene
new file mode 100644
index 0000000..2531674
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft betroffene
@@ -0,0 +1,3 @@
+Familienname: <3                           > 
+Namenszusatz: <21   >    Rufname: <4            >      (Fortsetzung) 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer
new file mode 100644
index 0000000..2be3ff8
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 auskunft lehrer
@@ -0,0 +1,7 @@
+ 
+Unterrichtsverteilung Schuljahr <526>>, <527>>.Halbjahr                      
+ 
+Jgst.      Fach      Kurs     Wochenstd. 
+ 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer
new file mode 100644
index 0000000..f9e0f34
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl lehrer
@@ -0,0 +1,9 @@
+ 
+  Klassenleitung/Tutor für:  <540                                          > 
+ 
+stellv. Klassenleitung für:  <541                                          > 
+ 
+                Aufsichten:  Ort   Zeit 
+ 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume
new file mode 100644
index 0000000..538fa14
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl raeume
@@ -0,0 +1,4 @@
+<520>> : <521     >: <522     >: <523     >: <524     >: <525     >: <526     >: 
+   :    <527>  :    <528>  :    <529>  :    <530>  :    <531>  :    <532>  : 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1
new file mode 100644
index 0000000..16a5152
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek1
@@ -0,0 +1,3 @@
+<520>> : <521    > : <522    > : <523    > : <524    > : <525    > : <526    > : 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2 b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2
new file mode 100644
index 0000000..a44f64b
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 einzelstdpl sek2
@@ -0,0 +1,3 @@
+<540     >          <541                                                  > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile b/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile
new file mode 100644
index 0000000..32a345c
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 kursli zeile
@@ -0,0 +1,3 @@
+ <523> : <524                 >>, <525                    >>, <526   > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf
new file mode 100644
index 0000000..288806c
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 protokoll versetzkonf
@@ -0,0 +1,13 @@
+ 
+ 
+Datum: ________   Beginn:_____ Uhr, Ende:_____ Uhr 
+ 
+ 
+Anwesend:
+
+           <512%#*<512>> 
+ 
+Ort, Zeit und Tagesordnung sind den Mitgliedern ordnungsgemäß bekannt
+gegeben worden. Der Vorsitzende hat die Beschlußfähigkeit der Konferenz
+festgestellt. 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer
new file mode 100644
index 0000000..f29b7d5
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 unterrichtsvertlg fuer lehrer
@@ -0,0 +1,3 @@
+                            <<183> <534>> <535>        <<536> 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen b/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen
new file mode 100644
index 0000000..441742c
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck2 vertretungen
@@ -0,0 +1,3 @@
+<520   >  <521>   <522 >  <523                          > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene
new file mode 100644
index 0000000..aad98ea
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft betroffene
@@ -0,0 +1,28 @@
+ 
+Differenzierungsdaten: 
+          1. Fremdsprache: <55  >> <537                             >> 
+                      von: <538>  bis: <539> 
+          2. Fremdsprache: <58  >> <540                             >> 
+                      von: <541>  bis: <542> 
+          3. Fremdsprache: <61  >> <543                             >> 
+                      von: <544>  bis: <545> 
+          4. Fremdsprache: <64  >><546                             >> 
+                      von: <547>  bis: <548> 
+   Religionsunterricht in: <67>> <549                               >> 
+               abgemeldet: <68    >    wiederangemeldet: <69    > 
+              Kunst/Musik: <70>> <550                               >> 
+Wahlpflichtfächer in 09.1: <71  >> <551                             >> 
+                           <72  >> <552                             >> 
+Wahlpflichtfächer in 09.2: <73  >> <553                             >> 
+                           <74  >> <554                             >> 
+Wahlpflichtfächer in 10.1: <75  >> <555                             >> 
+                           <76  >> <556                             >> 
+Wahlpflichtfächer in 10.2: <77  >> <557                             >> 
+                           <78  >> <558                             >> 
+    Arbeitsgemeinschaften: <79  >> <559                             >> 
+                      von: <560>  bis: <561> 
+    Arbeitsgemeinschaften: <82  >> <562                             >> 
+                      von: <563>  bis: <564> 
+    Arbeitsgemeinschaften: <85  >> <565                             >> 
+                      von: <566>  bis: <567>  
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer
new file mode 100644
index 0000000..6616e46
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 auskunft lehrer
@@ -0,0 +1,3 @@
+ <528 >    <529>     <530>      <531>              
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer
new file mode 100644
index 0000000..f54fce2
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl lehrer
@@ -0,0 +1,3 @@
+                             <543> <542                 > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1
new file mode 100644
index 0000000..e72e32c
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 einzelstdpl sek1
@@ -0,0 +1,7 @@
+ 
+Erläuterungen: 
+ 
+Fach (Kopplung)  Fach                 Lehrer 
+----:-----------:--------------------:-------------------------- 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf b/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf
new file mode 100644
index 0000000..cd69816
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck3 protokoll versetzkonf
@@ -0,0 +1,9 @@
+ 
+ 
+ 
+Abkürzungen in Spalte "Bem.": w/x = Schüler wiederholte diese Jgst. 
+                              ab  = Schüler abgemeldet 
+ 
+ 
+Vorsitzender:______________________ Protokollführer:______________________ 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene
new file mode 100644
index 0000000..2b24d03
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft betroffene
@@ -0,0 +1,23 @@
+ 
+ 
+Daten zum Schuljahr <511>, <93>>. Halbjahr, Jgst. <94> Zug/Tutor: <95 > 
+ 
+     Versetzung: <518> <519                                             > 
+        Warnung: <512>  mit Bem.Nr.: <513> 
+    Nachwarnung: <515>  mit Bem.Nr.: <516>
+                                           <517%#*<517>> 
+ Nachpr.mögl.in: <520> <521                                             > 
+                 <522> <523                                             > 
+                 <524> <525                                             > 
+    abgelegt in: <526> mit Note: <527>> 
+Zeugnis Bem.Nr.: <528>
+                       <529%#*<529>> 
+                 <530>
+                       <531%#*<531>> 
+                 <532>
+                       <533%#*<533>> 
+ 
+Bemerkung zur Nachprüfung: <108> <537                                  >>
+ 
+Versäumt mit/ohne Entschuldigung: <534>>/<535>> Std.  verspätet: <536>> mal 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer
new file mode 100644
index 0000000..31bf2b0
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 auskunft lehrer
@@ -0,0 +1,7 @@
+ 
+ 
+Leitung von Schülergruppen: <526                                        >
+   Klassenleiter/Tutor: <580  > <582  > <584  > <586  > <588  > 
+        Stellvertreter: <581  > <583  > <585  > <587  > <589  > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1
new file mode 100644
index 0000000..810e66f
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck4 einzelstdpl sek1
@@ -0,0 +1,3 @@
+<518>>  <519     >  <520                > <521                                 > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene
new file mode 100644
index 0000000..43c0388
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft betroffene
@@ -0,0 +1,38 @@
+ 
+Wahl geprüft: <537                                                  > 
+ 
+Fach     <538                                                            > 
+Art      <539                                                            > 
+Klausur  <541                                                            > 
+Kurs Nr. <542                                                            > 
+Warnung  <543                                                            > 
+Note     <544                                                            > 
+Bem. dazu<545                                                            > 
+ 
+Bem. Nr. <546>:
+                <547%#*<547>> 
+         <548>:
+                <549%#*<549>> 
+         <550>:
+                <551%#*<551>> 
+         <552>:
+                <553%#*<553>> 
+         <554>:
+                <555%#*<555>> 
+         <556>:
+                <557%#*<557>> 
+         <558>:
+                <559%#*<559>> 
+         <560>:
+                <561%#*<561>> 
+         <562>:
+                <563%#*<563>> 
+         <564>:
+                <565%#*<565>> 
+         <566>:
+                <567%#*<567>> 
+         <568>:
+                <569%#*<569>> 
+         <570>:
+                <571%#*<571>> 
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer
new file mode 100644
index 0000000..2b5f0dd
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 auskunft lehrer
@@ -0,0 +1,20 @@
+ 
+ 
+Zeitwünsche <526                                                       > 
+Wünsche für bestimmte Zeiten: 
+        1   2   3   4   5   6   7   8   9  10  11  12 
+   ----------------------------------------------------- 
+   Mo  <531>>  <532>>  <533>>  <534>>  <535>>  <536>>  <537>>  <538>>  <539>>  <540>>  <541>>  <542>> 
+   Di  <543>>  <544>>  <545>>  <546>>  <547>>  <548>>  <549>>  <550>>  <551>>  <552>>  <553>>  <554>>  
+   Mi  <555>>  <556>>  <557>>  <558>>  <559>>  <560>>  <561>>  <562>>  <563>>  <564>>  <565>>  <566>>  
+   Do  <567>>  <568>>  <569>>  <570>>  <571>>  <572>>  <573>>  <574>>  <575>>  <576>>  <577>>  <578>>  
+   Fr  <579>>  <580>>  <581>>  <582>>  <583>>  <584>>  <585>>  <586>>  <587>>  <588>>  <589>>  <590>>  
+   Sa  <591>>  <592>>  <593>>  <594>>  <595>>  <596>> 
+ 
+insgesamt sollen frei sein (incl. den o.g. Wünschen) : 
+                              Anzahl  Gewicht 
+                 ganze Tage     <520>   <521> 
+                 Vormittage     <522>   <523> 
+    zusätzliche Nachmittage     <524>   <525> 
+    
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1
new file mode 100644
index 0000000..d7bd03e
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck5 einzelstdpl sek1
@@ -0,0 +1,9 @@
+ 
+ 
+Räume für gekoppelten Unterricht: 
+ 
+Kopplung          Zeiten 
+         Fach     Räume 
+--------:-------:------:------:------:------:------:------:------:------: 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer
new file mode 100644
index 0000000..90c1a7a
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck6 auskunft lehrer
@@ -0,0 +1,5 @@
+ 
+Vertretungen: 
+Datum: <520   >   Zeit: <521>  Art: <522 >>  Lehrveranst.: <523     > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1
new file mode 100644
index 0000000..d7c5b14
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck6 einzelstdpl sek1
@@ -0,0 +1,3 @@
+<530   >          <531>  <532>  <533>  <534>  <535>  <536>  <537>  <538> 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer b/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer
new file mode 100644
index 0000000..0ac9975
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck7 auskunft lehrer
@@ -0,0 +1,3 @@
+       <520   >         <521>       <522 >>                <523      > 
+
+
diff --git a/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1 b/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1
new file mode 100644
index 0000000..b64618e
--- /dev/null
+++ b/app/schulis/2.2.1/data/vordrucke/vordruck7 einzelstdpl sek1
@@ -0,0 +1,3 @@
+         <540   > <541>  <542>  <543>  <544>  <545>  <546>  <547>  <548> 
+
+
diff --git a/app/schulis/2.2.1/source-disk b/app/schulis/2.2.1/source-disk
new file mode 100644
index 0000000..0fbb9d3
--- /dev/null
+++ b/app/schulis/2.2.1/source-disk
@@ -0,0 +1,5 @@
+schulis-grundpaket-schulverwaltung-2.2.1/03_schulis-quellen.img
+schulis-grundpaket-schulverwaltung-2.2.1/04_schulis-quellen.img
+schulis-grundpaket-schulverwaltung-2.2.1/05_schulis-quellen.img
+schulis-grundpaket-schulverwaltung-2.2.1/06_vordrucke.img
+schulis-grundpaket-schulverwaltung-2.2.1/07_baisy-schulis-db.img
diff --git a/app/schulis/2.2.1/src/0.ANSCHREIBEN.files b/app/schulis/2.2.1/src/0.ANSCHREIBEN.files
new file mode 100644
index 0000000..1352f80
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ANSCHREIBEN.files
@@ -0,0 +1,14 @@
+1.anschr.schulbescheinigung
+1.anschr.anmeldebestaetigung fuer jgst 5 und 11
+1.anschr.wiederholer
+1.anschr.nachpruefungsbescheinigung
+1.anschr.nachpruefungszulassung
+1.auskunft.betroffene
+1.anschr.mitteilungen neuangemeldete und abgemeldete
+1.listen.anherk 
+3.anschr.betroffene lehrer
+4.anschr.unterrichtsvertlg fuer lehrer 
+4.anschr.vertretungen
+
+
+
diff --git a/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files
new file mode 100644
index 0000000..22746c7
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE TEIL2.files
@@ -0,0 +1,6 @@
+0.anschr.druckereinstellung 
+0.listen.werkzeuge
+0.listen.druckbearbeitung
+0.listen.steuerung
+
+
diff --git a/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files
new file mode 100644
index 0000000..aec57ff
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ANSCHRLISTWERKZEUGE.files
@@ -0,0 +1,6 @@
+0.anschr.grundfunktionen 
+0.anschr.steuerfunktionen einfach 
+0.anschr.steuerfunktionen zusammengesetzt 
+0.schulis schrifttyp
+
+
diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files
new file mode 100644
index 0000000..07e60dd
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN 2.files
@@ -0,0 +1,10 @@
+3.erf lehrer
+0.erf.faecher
+0.schulkenndaten bearbeiten
+0.erf.schuldaten
+0.klassengruppen definieren
+0.raumgruppen bearbeiten
+0.erf zeitraster
+0.erf aufsichtszeiten
+
+
diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files
new file mode 100644
index 0000000..9931455
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN EINZELN.files
@@ -0,0 +1,15 @@
+0.kurswahlbasis bereinigen
+0.hjd grundfunktionen
+1.erf.schuelerdaten
+1.erf.abmeldedaten
+1.abgegangene aussortieren
+1.schuelerjgst aendern
+1.halbjahresdaten bearbeiten
+1.hoeherstufen anw do.prog
+1.stat grundfunktionen
+1.stat intern
+
+
+
+
+
diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files
new file mode 100644
index 0000000..51bb04d
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN LISTENWEISE.files
@@ -0,0 +1,10 @@
+0.hjd grundfunktionen
+0.listenweise grundfunktionen
+0.kurswahlbasis bereinigen
+0.listenweise klassen erf
+1.listenweise erg vers konf
+1.listenweise erg nachpr
+1.listenweise dif dat erf
+1.listenweise klassenbildung
+3.listenweise lehrer erf
+
diff --git a/app/schulis/2.2.1/src/0.ERFASSUNGEN.files b/app/schulis/2.2.1/src/0.ERFASSUNGEN.files
new file mode 100644
index 0000000..139597f
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ERFASSUNGEN.files
@@ -0,0 +1,2 @@
+
+
diff --git a/app/schulis/2.2.1/src/0.IDA SERVER.files b/app/schulis/2.2.1/src/0.IDA SERVER.files
new file mode 100644
index 0000000..504c576
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.IDA SERVER.files
@@ -0,0 +1,4 @@
+0.ida.data 
+0.ida.server
+
+
diff --git a/app/schulis/2.2.1/src/0.IDA SICHERUNG.files b/app/schulis/2.2.1/src/0.IDA SICHERUNG.files
new file mode 100644
index 0000000..6a7804e
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.IDA SICHERUNG.files
@@ -0,0 +1,4 @@
+0.ida.data 
+0.ida.form
+
+
diff --git a/app/schulis/2.2.1/src/0.LISTEN 2.files b/app/schulis/2.2.1/src/0.LISTEN 2.files
new file mode 100644
index 0000000..bfb49ca
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.LISTEN 2.files
@@ -0,0 +1,18 @@
+0.listen.faecher
+0.listen.schuelergruppen
+3.listen.paraphen
+3.listen.sprechzeiten
+3.listen.wochenstunden
+3.listen.lehrbef faecherweise 
+3.listen.lehrbef lehrerweise
+4.faecherangebot drucken
+0.liste der zeitrasterdaten
+4.listen.unterrichtsverteilung
+0.listen.raumgruppen 
+0.listen.klassengruppen
+4.zeitwuensche drucken
+0.liste der aufsichtszeiten
+4.listen.aufsichtsplan
+4.liste ausgewaehlter kopplungen drucken
+
+
diff --git a/app/schulis/2.2.1/src/0.LISTEN.files b/app/schulis/2.2.1/src/0.LISTEN.files
new file mode 100644
index 0000000..af0173b
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.LISTEN.files
@@ -0,0 +1,15 @@
+1.listen.neuan
+1.listen.gesamt
+1.listen.gebu
+1.listen.adressen
+1.listen.klassenbuch
+1.listen.klassen
+1.listen.abgem
+0.listen.benutz
+1.listen.wiederholer
+1.listen.nachpruefung
+1.listen.prot versetzkonferenz
+0.listen.schlueabku
+0.listen.schulen
+
+
diff --git a/app/schulis/2.2.1/src/0.LOCAL.files b/app/schulis/2.2.1/src/0.LOCAL.files
new file mode 100644
index 0000000..1731322
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.LOCAL.files
@@ -0,0 +1,4 @@
+0.grundfunktionen local 
+0.hoeherstufen local.prog 
+
+
diff --git a/app/schulis/2.2.1/src/0.anschr.druckereinstellung b/app/schulis/2.2.1/src/0.anschr.druckereinstellung
new file mode 100644
index 0000000..5e014bf
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.anschr.druckereinstellung
@@ -0,0 +1,69 @@
+PACKET anschrdruckereinstellungDEFINES einstellungderausgabefueranschreiben,
+einstellungderausgabefuermitteilung,
+leseveraenderteausgabeneinstellunganschreiben,
+leseveraenderteausgabeneinstellungmitteilung,
+initialisieredruckerfueranschreiben,initialisieredruckerfuermitteilung,:REAL 
+VAR anschreibenstartx:=2.54,anschreibenstarty:=2.35,mitteilungstartx:=2.54,
+mitteilungstarty:=2.35;INT VAR anschreibendruckbreite:=70,
+mitteilungdruckbreite:=70;INT CONST minbreiteanschreiben:=50,
+minbreitemitteilung:=70;LET maske="ms einstellung druck anschreiben";LET 
+schriftfeldnr=2,druckbreitefeldnr=3,mindruckbreitefeldnr=4,startxfeldnr=5,
+startyfeldnr=6;LET maxstartxy=10.0,textnull="0.0",realnull=0.0,
+eingabenichtsinnvoll=162;LET niltext="";PROC 
+initialisieredruckerfueranschreiben:setzeanzahlderzeichenprozeile(
+anschreibendruckbreite);schrift(anschreibenschrifttyp);start(
+anschreibenstartx,anschreibenstarty);END PROC 
+initialisieredruckerfueranschreiben;PROC einstellungderausgabefueranschreiben
+:standardstartproc(maske);standardmaskenfeld(anschreibenschrifttyp,
+schriftfeldnr);standardmaskenfeld(text(anschreibendruckbreite),
+druckbreitefeldnr);standardmaskenfeld(text(minbreiteanschreiben),
+mindruckbreitefeldnr);standardmaskenfeld(text(anschreibenstartx),startxfeldnr
+);standardmaskenfeld(text(anschreibenstarty),startyfeldnr);standardnprocEND 
+PROC einstellungderausgabefueranschreiben;PROC 
+leseveraenderteausgabeneinstellunganschreiben:INT VAR testdruckzeilenbreite;
+TEXT VAR teststartx,teststarty;BOOL VAR werteinordnung:=TRUE ;
+testdruckzeilenbreite:=int(standardmaskenfeld(druckbreitefeldnr));teststartx
+:=compress(standardmaskenfeld(startxfeldnr));teststarty:=compress(
+standardmaskenfeld(startyfeldnr));ueberpruefendergegebenenwerte;IF 
+werteinordnungTHEN werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
+ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<minbreiteanschreiben
+THEN infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF (teststartx<>
+textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real(
+teststartx)<realnullTHEN infeld(startxfeldnr);werteinordnung:=FALSE ELIF (
+teststarty<>textnullAND real(teststarty)=realnull)OR real(teststarty)>
+maxstartxyOR real(teststarty)<realnullTHEN infeld(startyfeldnr);
+werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .werteuebernehmen:
+setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));
+anschreibendruckbreite:=testdruckzeilenbreite;anschreibenstartx:=real(
+teststartx);anschreibenstarty:=real(teststarty).meldefehler:standardmeldung(
+eingabenichtsinnvoll,niltext).END PROC 
+leseveraenderteausgabeneinstellunganschreiben;PROC 
+initialisieredruckerfuermitteilung:setzeanzahlderzeichenprozeile(
+mitteilungdruckbreite);schrift(mitteilungschrifttyp);start(mitteilungstartx,
+mitteilungstarty);END PROC initialisieredruckerfuermitteilung;PROC 
+einstellungderausgabefuermitteilung:standardstartproc(maske);
+standardmaskenfeld(mitteilungschrifttyp,schriftfeldnr);standardmaskenfeld(
+text(mitteilungdruckbreite),druckbreitefeldnr);standardmaskenfeld(text(
+minbreitemitteilung),mindruckbreitefeldnr);standardmaskenfeld(text(
+mitteilungstartx),startxfeldnr);standardmaskenfeld(text(mitteilungstarty),
+startyfeldnr);standardnprocEND PROC einstellungderausgabefuermitteilung;PROC 
+leseveraenderteausgabeneinstellungmitteilung:INT VAR testdruckzeilenbreite;
+TEXT VAR teststartx,teststarty;BOOL VAR werteinordnung:=TRUE ;
+testdruckzeilenbreite:=int(standardmaskenfeld(druckbreitefeldnr));teststartx
+:=compress(standardmaskenfeld(startxfeldnr));teststarty:=compress(
+standardmaskenfeld(startyfeldnr));ueberpruefendergegebenenwerte;IF 
+werteinordnungTHEN werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
+ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<minbreitemitteilung
+THEN infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF (teststartx<>
+textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real(
+teststartx)<realnullTHEN infeld(startxfeldnr);werteinordnung:=FALSE ELIF (
+teststarty<>textnullAND real(teststarty)=realnull)OR real(teststarty)>
+maxstartxyOR real(teststarty)<realnullTHEN infeld(startyfeldnr);
+werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .werteuebernehmen:
+setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));
+mitteilungdruckbreite:=testdruckzeilenbreite;mitteilungstartx:=real(
+teststartx);mitteilungstarty:=real(teststarty).meldefehler:standardmeldung(
+eingabenichtsinnvoll,niltext).END PROC 
+leseveraenderteausgabeneinstellungmitteilung;END PACKET 
+anschrdruckereinstellung
+
diff --git a/app/schulis/2.2.1/src/0.anschr.grundfunktionen b/app/schulis/2.2.1/src/0.anschr.grundfunktionen
new file mode 100644
index 0000000..0330b7a
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.anschr.grundfunktionen
@@ -0,0 +1,193 @@
+PACKET anschrgrundfunktionenfueranschreibenDEFINES volljaehrig,
+setzesonderwert,setzesonderwerteschulkenndaten,zeigeallesonderwerte,
+initialisieresonderwerte,sonderwert,indexadressat,adressat,
+setzeanzahlderzeichenprozeile,schrift,start,schreibesteuerzeichenzeile,
+briefalternative:LET linkeklammer="<",rechteklammer=">",parametergrenze="%",
+parametertrennzeichen="#",otherwise="*",niltext="";INT CONST indexadressat:=
+510;LET swindexdatum=1,swindexschulname=2,swindexschulstrasse=3,
+swindexschulort=4,swindexschuljahr=5,swindexschulleiter=6,
+swindexnaechstesschuljahr=7,swindexvorangehendesschuljahr=8,swindexhalbjahr=9
+;LET kennzahlsonderwert=500;LET laengedessonderwertpuffers=100,
+anzahlsonderwerteschulkenndaten=10;LET volljaehrigkeitsalter=18;TEXT VAR 
+schrifttyp:="pica",ersterparameterstartanweisung:="1.0",
+zweiterparameterstartanweisung:="1.0";INT VAR zeilenlaenge:=70;ROW 
+laengedessonderwertpuffersTEXT VAR sonderwertpuffer;BOOL PROC volljaehrig(
+TEXT CONST alter):TEXT VAR stichtag:=date;change(stichtag,7,8,text(int(
+subtext(stichtag,7,8))-volljaehrigkeitsalter));datum(alter)<=datum(stichtag)
+END PROC volljaehrig;PROC initialisieresonderwerte:INT VAR z;FOR zFROM 
+anzahlsonderwerteschulkenndaten+1UPTO laengedessonderwertpuffersREP 
+sonderwertpuffer(z):=""PER END PROC initialisieresonderwerte;PROC 
+initialisiereallesonderwerte:INT VAR z;FOR zFROM 1UPTO 
+anzahlsonderwerteschulkenndatenREP sonderwertpuffer(z):=""PER ;
+initialisieresonderwerteEND PROC initialisiereallesonderwerte;PROC 
+setzesonderwert(INT CONST index,TEXT CONST sondertext):IF (index>(
+kennzahlsonderwert+anzahlsonderwerteschulkenndaten))AND (index<=
+laengedessonderwertpuffers+kennzahlsonderwert)THEN sonderwertpuffer(index-
+kennzahlsonderwert):=sondertextFI END PROC setzesonderwert;PROC 
+sonderwertefuernaechstesundvorangehendesschuljahr(TEXT CONST 
+aktuellesschuljahr):sonderwertfuernaechstesschuljahr;
+sonderwertfuervorangehendesschuljahr.sonderwertfuernaechstesschuljahr:
+sonderwertpuffer(swindexnaechstesschuljahr):=addierezumerstenjahreins+"/"+
+addierezumzweitenjahreins;.addierezumerstenjahreins:text((int(subtext(
+aktuellesschuljahr,1,2))+1)MOD 100).addierezumzweitenjahreins:text((int(
+subtext(aktuellesschuljahr,3,4))+1)MOD 100).
+sonderwertfuervorangehendesschuljahr:sonderwertpuffer(
+swindexvorangehendesschuljahr):=subtrahierevomerstenjahreins+"/"+
+subtrahierevomzweitenjahreins;.subtrahierevomerstenjahreins:text((int(subtext
+(aktuellesschuljahr,1,2))+99)MOD 100).subtrahierevomzweitenjahreins:text((int
+(subtext(aktuellesschuljahr,3,4))+99)MOD 100).END PROC 
+sonderwertefuernaechstesundvorangehendesschuljahr;PROC zeigeallesonderwerte:
+INT VAR z,z1;page;z:=1;REP FOR z1FROM 1UPTO 20REP putline(text(z)+" "+
+sonderwertpuffer(z));zINCR 1;PER ;pauseUNTIL z>=laengedessonderwertpuffers
+PER ;END PROC zeigeallesonderwerte;TEXT PROC sonderwert(INT CONST swindex):
+IF swindex>kennzahlsonderwertAND swindex<=kennzahlsonderwert+
+laengedessonderwertpuffersTHEN sonderwertpuffer(swindex-kennzahlsonderwert)
+ELSE niltextFI END PROC sonderwert;PROC adressat(TEXT CONST name):
+sonderwertpuffer(indexadressat-kennzahlsonderwert):=compress(subtext(name,1,
+20))END PROC adressat;TEXT PROC lueckenwert(INT CONST fnr1):IF fnr1<=
+kennzahlsonderwertTHEN aufbereiteterdbwertELSE sonderwertpuffer(fnr1-
+kennzahlsonderwert)FI .aufbereiteterdbwert:IF (feldtyp(fnr1)=intfeldCAND 
+intwert(fnr1)=0)COR (feldtyp(fnr1)=datumfeldCAND wert(fnr1)="01.01.00")THEN 
+""ELSE wert(fnr1)FI .END PROC lueckenwert;TEXT PROC zeilenalternative(TEXT 
+CONST eingabe,BOOL CONST rekursiveraufruf):INT VAR positionlinkeklammer:=1,
+positionrechteklammer:=1,positionlinkeskreuz,positionrechteskreuz,
+positionmittlereskreuz,positionparametergrenze,parameter1,parameter2,
+positionparametertrennzeichen,laenge,pufferlaenge,aktuelleposition,
+positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR ausdruckvorhanden,
+caseaufruf,linkeseitevariabel,rechteseitevariabel;TEXT VAR puffer,
+vergleichswert,aktuellessymbol,ausgabe:=eingabe;REP 
+auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN 
+bestimmungderuebergabeparameterfuerdieprozedurlueckenwert;
+aufrufderprozedurlueckenwert;IF NOT caseaufrufTHEN bestimmungdesteiltextes
+ELSE bestimmungderrichtigenalternativeFI ;
+einsetzendesteiltextesoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ;
+ausgabe.auffindeneinesspitzgeklammertenausdrucks:aktuelleposition:=0;
+linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:=pos(
+ausgabe,linkeklammer);ausdruckvorhanden:=aktuelleposition<>0;
+positionlinkeklammer:=aktuelleposition.
+bestimmungderuebergabeparameterfuerdieprozedurlueckenwert:
+ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenerstenuebergabeparameter;
+IF aktuellessymbol<>parametertrennzeichenTHEN parameter2:=1;ELSE 
+bestimmedenzweitenuebergabeparameterFI ;IF aktuellessymbol=rechteklammerTHEN 
+caseaufruf:=FALSE ;fuehreleseoperationaus;
+ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ;
+positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus:
+aktuellepositionINCR 1;aktuellessymbol:=ausgabeSUB aktuelleposition;IF 
+aktuellessymbol=linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF 
+aktuellessymbol=rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI .
+ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus;
+linkeseitevariabel:=aktuellessymbol=linkeklammer.
+bestimmedenerstenuebergabeparameter:WHILE NOT (aktuellessymbol=
+parametertrennzeichenOR aktuellessymbol=parametergrenzeOR aktuellessymbol=
+rechteklammer)REP fuehreleseoperationausPER ;IF linkeseitevariabelTHEN 
+parameter1:=int(subtext(ausgabe,positionlinkeklammer+2,aktuelleposition-1))
+ELSE parameter1:=int(subtext(ausgabe,positionlinkeklammer+1,aktuelleposition-
+1))FI .bestimmedenzweitenuebergabeparameter:positionparametertrennzeichen:=
+aktuelleposition;REP fuehreleseoperationausUNTIL aktuellessymbol=
+parametergrenzeOR aktuellessymbol=rechteklammerPER ;parameter2:=int(subtext(
+ausgabe,positionparametertrennzeichen+1,aktuelleposition-1)).
+ueberpruefeobrechteseitedoppeltgeklammert:IF aktuellessymbol=rechteklammer
+THEN rechteseitevariabel:=TRUE ;positionrechteklammer:=aktuellepositionELSE 
+positionrechteklammer:=aktuelleposition-1FI .bestimmungdesteiltextes:IF NOT 
+rekursiveraufrufTHEN bestimmungderlaengederauszufuellendenluecke;
+entsprechendenabschnittdeserhaltenenwortesbestimmenFI .
+aufrufderprozedurlueckenwert:puffer:=lueckenwert(parameter1#,parameter2#).
+bestimmungderlaengederauszufuellendenluecke:laenge:=positionrechteklammer-
+positionlinkeklammer+1.entsprechendenabschnittdeserhaltenenwortesbestimmen:
+pufferlaenge:=length(puffer);IF pufferlaenge<=laengeTHEN IF NOT (
+linkeseitevariabelOR rechteseitevariabel)THEN puffer:=puffer+((laenge-
+pufferlaenge)*" ")ELIF linkeseitevariabelTHEN puffer:=((laenge-pufferlaenge)*
+" ")+pufferFI ;ELSE IF NOT linkeseitevariabelTHEN puffer:=subtext(puffer,1,
+laenge);ELSE puffer:=subtext(puffer,pufferlaenge-laenge+1,pufferlaenge)FI ;
+FI .bestimmungderrichtigenalternative:bestimmungdeserstenvergleichswertes;
+WHILE vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP 
+suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen;
+IF vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinTHEN 
+bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)=
+otherwiseTHEN puffer:=zeilenalternative(subtext(ausgabe,positionotherwise+1,
+positionrechteklammer-1),TRUE )ELSE bereitstelleneinerleerenalternativeFI .
+bestimmungdeserstenvergleichswertes:positionlinkeskreuz:=
+positionparametergrenze;positionmittlereskreuz:=pos(ausgabe,
+parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe,
+positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen.
+suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz;
+positionmittlereskreuz:=pos(ausgabe,parametertrennzeichen,positionlinkeskreuz
++1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1,
+positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen:
+aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP 
+fuehreleseoperationausUNTIL (anzahldergeoeffnetenklammern=0AND (
+aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR 
+anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition;
+positionotherwise:=aktuelleposition.
+vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufueberein:
+vergleichswert=puffer.bereitstellenderentsprechendenalternative:puffer:=
+zeilenalternative(subtext(ausgabe,positionmittlereskreuz+1,
+positionrechteskreuz-1),TRUE ).bereitstelleneinerleerenalternative:puffer:=""
+.vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT 
+vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinAND 
+einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden:
+aktuellessymbol=parametertrennzeichen.
+positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0;
+IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern
+<0AND aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER FI ;
+positionrechteklammer:=aktuelleposition.
+einsetzendesteiltextesoderderalternative:change(ausgabe,positionlinkeklammer,
+positionrechteklammer,puffer).END PROC zeilenalternative;PROC 
+setzeanzahlderzeichenprozeile(INT CONST anzahl):zeilenlaenge:=anzahlEND PROC 
+setzeanzahlderzeichenprozeile;PROC schrift(TEXT CONST typ):schrifttyp:=typ
+END PROC schrift;PROC start(REAL CONST x,y):ersterparameterstartanweisung:=
+text(x);zweiterparameterstartanweisung:=text(y)END PROC start;PROC 
+schreibesteuerzeichenzeile(TEXT CONST dateiname):FILE VAR f:=sequentialfile(
+output,dateiname);LET druckersteuerzeichen="#",praefixschrifttypanweisung=
+"type(""",praefixstartanweisung="start(",komma=",",suffixstartanweisung=")",
+suffixschrifttypanweisung=""")",pagelengthanweisung="#pagelength(29.0)#";
+putline(f,druckersteuerzeichen+praefixschrifttypanweisung+schrifttyp+
+suffixschrifttypanweisung+druckersteuerzeichen+druckersteuerzeichen+
+praefixstartanweisung+ersterparameterstartanweisung+komma+
+zweiterparameterstartanweisung+suffixstartanweisung+druckersteuerzeichen+
+pagelengthanweisung)END PROC schreibesteuerzeichenzeile;PROC briefalternative
+(TEXT CONST eingabedatei,ausgabedatei):TEXT VAR ausgabe:=ausgabedatei;TEXT 
+VAR zeile:="",text:="",praefixdernaechstenzeile:="",briefzeile:="";BOOL VAR 
+absatzende;INT VAR postrennzeichen:=1,z;LET trennzeichen=" ";FILE VAR f:=
+sequentialfile(output,ausgabe);FILE VAR eingabe:=sequentialfile(input,
+eingabedatei);WHILE NOT eof(eingabe)REP holezeileausdemvordruck;
+einrueckendererstenbriefzeilevorbereiten;REP ueberpruefeaufabsatzende;
+ersetzeindergeholtenzeilediegeklammertenausdruecke;
+konkatenierediegeholtezeilemitdemrestdervorangehenden;IF briefzeilelanggenug
+OR absatzendeTHEN zeilenumbruch;WHILE absatzendeAND nochtextvorhandenREP 
+bildedenrestdesumbruchs;zeilenumbruchPER FI ;IF NOT absatzendeTHEN 
+holezeileausdemvordruck;einrueckendernaechstenbriefzeilevorbereiten;FI ;
+UNTIL absatzendePER PER .holezeileausdemvordruck:getline(eingabe,zeile).
+konkatenierediegeholtezeilemitdemrestdervorangehenden:briefzeile:=text+zeile+
+trennzeichen;text:=briefzeile.ueberpruefeaufabsatzende:absatzende:=(zeileSUB 
+(length(zeile)))=trennzeichen.briefzeilelanggenug:(length(briefzeile))>=
+zeilenlaenge.bildedenrestdesumbruchs:briefzeile:=text.nochtextvorhanden:
+length(subtext(text,length(praefixdernaechstenzeile)+1))>1.zeilenumbruch:IF (
+zeilenlaenge<length(briefzeile))THEN postrennzeichen:=zeilenlaenge+1ELSE 
+postrennzeichen:=length(briefzeile)FI ;WHILE (briefzeileSUB postrennzeichen)
+<>trennzeichenREP postrennzeichen:=postrennzeichen-1PER ;putline(f,subtext(
+briefzeile,1,postrennzeichen-1));text:=praefixdernaechstenzeile+subtext(
+briefzeile,postrennzeichen+1);.einrueckendernaechstenbriefzeilevorbereiten:
+praefixdernaechstenzeile:="";z:=1;WHILE ((zeileSUB z)=trennzeichen)AND (
+length(zeile)>z)REP praefixdernaechstenzeile:=praefixdernaechstenzeile+
+trennzeichen;z:=z+1PER ;zeile:=subtext(zeile,z);.
+einrueckendererstenbriefzeilevorbereiten:praefixdernaechstenzeile:="";z:=1;
+WHILE ((zeileSUB z)=trennzeichen)AND (length(zeile)>z)REP 
+praefixdernaechstenzeile:=praefixdernaechstenzeile+trennzeichen;z:=z+1PER ;
+text:="";.ersetzeindergeholtenzeilediegeklammertenausdruecke:zeile:=
+zeilenalternative(zeile,FALSE ).END PROC briefalternative;PROC 
+setzesonderwerteschulkenndaten:TEXT VAR schlsicherung;savetupel(dnrschluessel
+,schlsicherung);TEXT VAR aktj:=schulkenndatum("Schuljahr");sonderwertpuffer(
+swindexschulname):=schulkenndatum("Schulname");sonderwertpuffer(
+swindexschulstrasse):=schulkenndatum("Schulstraße");sonderwertpuffer(
+swindexschulort):=schulkenndatum("Schulort");sonderwertpuffer(
+swindexschuljahr):=aktj;insertchar(sonderwertpuffer(swindexschuljahr),"/",3);
+sonderwertpuffer(swindexschulleiter):=schulkenndatum("Schulleiter");
+sonderwertpuffer(swindexhalbjahr):=schulkenndatum("Schulhalbjahr");
+sonderwertpuffer(swindexdatum):=date;
+sonderwertefuernaechstesundvorangehendesschuljahr(aktj);restoretupel(
+dnrschluessel,schlsicherung);ENDPROC setzesonderwerteschulkenndaten;
+initialisiereallesonderwerte;initialisiereschriftundstart.
+initialisiereschriftundstart:schrift("pica");.END PACKET 
+anschrgrundfunktionenfueranschreiben;
+
diff --git a/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach
new file mode 100644
index 0000000..e0024ca
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen einfach
@@ -0,0 +1,96 @@
+PACKET anschrsteuerfunktionenfuereinfacheanschreibenDEFINES anschreibenstart,
+naechstesanschreiben:LET anschreibentext="Text des Anschreibens";LET manager=
+"anschreiben server";LET niltext="",nildatum="01.01.00";LET nproc=1,
+eingangsbildschirm=2;LET vorwaertstaste="a";LET tupelstackgroesse=10;LET 
+ROWTEXT =ROW 10TEXT ;LET druckmeldnr=125,existiertnichtnr=126,leermeldnr=127,
+endemeldnr=128,weitereangabenr=129,nichterstellbarmeldnr=130;TEXT VAR 
+druckmeld:="";LET meldkz="#";INT VAR dateinummer,aktuellerindex,anzgeftupel;
+TEXT VAR anschreibenvordruck;BOOL VAR einzelbearbeitung;PROC anschreibenstart
+(INT CONST aktuellerinx,TEXT CONST vordruck,BOOL CONST anschreibenzeigen,
+peinzelbearbeitung,BOOL PROC sonderwerteundueberpruefungauferstellbarkeit,
+BOOL PROC pruefespeziell):ROWTEXT VAR schluesselsve1,schluesselsve2;INT VAR i
+;vorbereitungen;IF einzelbearbeitungTHEN einzelanschreibenELSE 
+anschreibenfuerbestandFI .anschreibenfuerbestand:IF leererbestandTHEN 
+meldeleerenbestand;zurueckzumeingangsbildschirmELSE 
+bearbeiteallediesesbestandesFI .bearbeiteallediesesbestandes:IF 
+anschreibenzeigenTHEN erstenbearbeitenELSE anschreibenleseschleife(BOOL PROC 
+sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell);
+meldeendederbrieferstellung;zurueckzumeingangsbildschirmFI .erstenbearbeiten:
+BOOL VAR erstellbar:=TRUE ;BOOL VAR bestandleer:=FALSE ;erstellbar:=
+sonderwerteundueberpruefungauferstellbarkeit;IF erstellbarTHEN 
+bearbeitenzumzeigenELSE REP IF anzgeftupel=0THEN anzgeftupel:=
+tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0
+THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE 
+bestandleer:=TRUE FI UNTIL bestandleerCOR 
+sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN 
+bearbeitenzumzeigenELSE zurueckzumeingangsbildschirm;
+meldeendederbrieferstellungFI FI .bearbeitenzumzeigen:IF einzelbearbeitung
+CAND NOT sonderwerteundueberpruefungauferstellbarkeitTHEN 
+meldenichterstellbar;zurueckzumeingangsbildschirmELSE 
+schreibesteuerzeichenzeile(anschreibentext);briefalternative(
+anschreibenvordruck,anschreibentext);editierebriefFI .einzelanschreiben:
+direktlesen;IF gefundenTHEN IF eindeutigTHEN datenlesen;IF anschreibenzeigen
+THEN bearbeitenzumzeigenELSE einzelbriefschreiben;
+zurueckzumeingangsbildschirmFI ELSE meldeanforderunggenauererangaben;
+zurueckzumeingangsbildschirmFI ELSE meldenichtgefunden;
+zurueckzumeingangsbildschirmFI .vorbereitungen:dateinummer:=dateinr(primdatid
+(aktuellerinx));aktuellerindex:=aktuellerinx;einzelbearbeitung:=
+peinzelbearbeitung;meldungstext(druckmeldnr,druckmeld);
+setzesonderwerteschulkenndaten;setzewerte;holeanschreibenvordruck.setzewerte:
+anschreibenvordruck:=vordruck.holeanschreibenvordruck:loeschealtenvordruck;
+fetch(anschreibenvordruck,/manager).loeschealtenvordruck:forget(vordruck,
+quiet).direktlesen:gesetztenschluesselsichern(schluesselsve1);anzgeftupel:=2;
+multisearchforward(aktuellerindex,anzgeftupel).gefunden:IF anzgeftupel=0THEN 
+FALSE ELSE multisucc;pruefespeziellCAND schluesselgleichFI .schluesselgleich:
+NOT schluesselungleich(schluesselsve1,schluesselsve1).eindeutig:anzgeftupel=1
+COR naechsterungleich.naechsterungleich:gesetztenschluesselsichern(
+schluesselsve2);multisucc;IF NOT pruefespeziellTHEN TRUE ELSE 
+schluesselungleich(schluesselsve1,schluesselsve2)FI .datenlesen:stackentry(1)
+.einzelbriefschreiben:IF NOT sonderwerteundueberpruefungauferstellbarkeit
+THEN meldenichterstellbarELSE briefschreibenFI .meldenichtgefunden:
+standardmeldung(existiertnichtnr,niltext).meldeanforderunggenauererangaben:
+standardmeldung(weitereangabenr,niltext).meldenichterstellbar:standardmeldung
+(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz).
+meldeendederbrieferstellung:standardmeldung(endemeldnr,niltext).
+zurueckzumeingangsbildschirm:return(nproc).leererbestand:anzgeftupel:=
+tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);IF 
+anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;NOT pruefespeziellELSE TRUE 
+FI .meldeleerenbestand:standardmeldung(leermeldnr,niltext).END PROC 
+anschreibenstart;BOOL PROC schluesselungleich(ROWTEXT CONST sve1,sve2):INT 
+VAR i;FOR iFROM 1UPTO anzkey(dateinummer)REP IF sve1[i]=""COR (feldtyp(
+dateinummer+i)=datumfeldCAND sve1[i]=nildatum)THEN LEAVE schluesselungleich
+WITH FALSE FI ;IF sve2[i]<>wert(dateinummer+i)THEN LEAVE schluesselungleich
+WITH TRUE FI PER ;FALSE ENDPROC schluesselungleich;PROC 
+gesetztenschluesselsichern(ROW 10TEXT VAR schluesselsve):INT VAR i;FOR iFROM 
+1UPTO anzkey(dateinummer)REP schluesselsve[i]:=wert(dateinummer+i)PER 
+ENDPROC gesetztenschluesselsichern;PROC briefschreiben:
+schreibesteuerzeichenzeile(anschreibentext);briefalternative(
+anschreibenvordruck,anschreibentext);print(anschreibentext);standardmeldung(
+druckmeldnr,sonderwert(indexadressat)+meldkz);forget(anschreibentext,quiet)
+END PROC briefschreiben;PROC anschreibenleseschleife(BOOL PROC 
+sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell):BOOL 
+VAR schluss:=FALSE ;vorlesen;leseschleife.leseschleife:WHILE NOT schlussREP 
+IF sonderwerteundueberpruefungauferstellbarkeitTHEN briefschreibenELSE 
+standardmeldung(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz)FI ;
+lesenPER .lesen:IF anzgeftupel=0THEN anzgeftupel:=tupelstackgroesse;multisucc
+(aktuellerindex,anzgeftupel)FI ;satzlesen.vorlesen:anzgeftupel:=
+tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);satzlesen.
+satzlesen:IF anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;schluss:=NOT 
+pruefespeziellELSE schluss:=TRUE FI .END PROC anschreibenleseschleife;PROC 
+editierebrief:editiere(anschreibentext,vorwaertstaste,FALSE )END PROC 
+editierebrief;PROC naechstesanschreiben(BOOL PROC 
+sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,BOOL 
+CONST drucken):BOOL VAR bestandleer:=FALSE ;IF druckenTHEN print(
+anschreibentext);standardmeldung(druckmeld#nr,#,sonderwert(indexadressat)+
+meldkz)FI ;forget(anschreibentext,quiet);IF einzelbearbeitungTHEN enter(
+eingangsbildschirm)ELSE REP IF anzgeftupel=0THEN anzgeftupel:=
+tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0
+THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE 
+bestandleer:=TRUE FI UNTIL bestandleerCOR 
+sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN 
+schreibesteuerzeichenzeile(anschreibentext);briefalternative(
+anschreibenvordruck,anschreibentext);return(nproc)ELSE standardmeldung(
+endemeldnr,niltext);#enter(eingangsbildschirm)#return(eingangsbildschirm)FI 
+FI END PROC naechstesanschreiben;END PACKET 
+anschrsteuerfunktionenfuereinfacheanschreiben;
+
diff --git a/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt
new file mode 100644
index 0000000..0b77e49
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.anschr.steuerfunktionen zusammengesetzt
@@ -0,0 +1,87 @@
+PACKET anschrsteuerfunktionenfuerzusammengesetzteanschreibenDEFINES 
+zusammengesetztesanschreiben,naechsteszusammengesetztesanschreiben:LET 
+niltext="",nildatum="01.01.00";LET nproc=1,eingangsbildschirm=2;LET 
+vorwaertstaste="a";LET tupelstackgroesse=10;LET druckmeldnr=125,
+existiertnichtnr=126,leermeldnr=127,endemeldnr=128,weitereangabenr=129,
+nichterstellbarmeldnr=130;TEXT VAR druckmeld:="",anschreibentext;LET meldkz=
+"#";INT VAR dateinummer,aktuellerindex,anzgeftupel;BOOL VAR einzelbearbeitung
+;PROC zusammengesetztesanschreiben(INT CONST aktuellerinx,BOOL CONST 
+anschreibenzeigen,peinzelbearbeitung,BOOL PROC sonderwerteundueberpruefungauf
+erstellbarkeit,BOOL PROC pruefespeziell,TEXT PROC druckdatei):ROW 10TEXT VAR 
+schluesselsve1,schluesselsve2;INT VAR i;vorbereitungen;IF einzelbearbeitung
+THEN einzelanschreibenELSE anschreibenfuerbestandFI .anschreibenfuerbestand:
+IF leererbestandTHEN meldeleerenbestand;zurueckzumeingangsbildschirmELSE 
+bearbeiteallediesesbestandesFI .bearbeiteallediesesbestandes:IF 
+anschreibenzeigenTHEN erstenbearbeitenELSE anschreibenleseschleife(BOOL PROC 
+sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,TEXT 
+PROC druckdatei);meldeendederbrieferstellung;zurueckzumeingangsbildschirmFI .
+erstenbearbeiten:BOOL VAR erstellbar:=TRUE ;BOOL VAR bestandleer:=FALSE ;
+erstellbar:=sonderwerteundueberpruefungauferstellbarkeit;IF erstellbarTHEN 
+bearbeitenzumzeigenELSE REP IF anzgeftupel=0THEN anzgeftupel:=
+tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0
+THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE 
+bestandleer:=TRUE FI UNTIL bestandleerCOR 
+sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN 
+bearbeitenzumzeigenELSE zurueckzumeingangsbildschirm;
+meldeendederbrieferstellungFI FI .bearbeitenzumzeigen:IF einzelbearbeitung
+CAND NOT sonderwerteundueberpruefungauferstellbarkeitTHEN 
+meldenichterstellbar;zurueckzumeingangsbildschirmELSE anschreibentext:=
+druckdatei;editierebriefFI .einzelanschreiben:direktlesen;IF gefundenTHEN IF 
+eindeutigTHEN datenlesen;IF anschreibenzeigenTHEN bearbeitenzumzeigenELSE 
+einzelbriefschreiben;zurueckzumeingangsbildschirmFI ELSE 
+meldeanforderunggenauererangaben;return(1)FI ELSE meldenichtgefunden;return(1
+)FI .vorbereitungen:dateinummer:=dateinr(primdatid(aktuellerinx));
+aktuellerindex:=aktuellerinx;einzelbearbeitung:=peinzelbearbeitung;
+meldungstext(druckmeldnr,druckmeld);setzesonderwerteschulkenndaten;.
+direktlesen:gesetztenschluesselsichern(schluesselsve1);anzgeftupel:=2;
+multisearchforward(aktuellerindex,anzgeftupel).gefunden:IF anzgeftupel=0THEN 
+FALSE ELSE multisucc;pruefespeziellFI .eindeutig:anzgeftupel=1COR 
+naechsterungleich.naechsterungleich:gesetztenschluesselsichern(schluesselsve2
+);multisucc;IF NOT pruefespeziellTHEN TRUE ELSE FOR iFROM 1UPTO anzkey(
+dateinummer)REP IF schluesselsve1[i]=""COR (feldtyp(dateinummer+i)=datumfeld
+CAND schluesselsve1[i]=nildatum)THEN LEAVE naechsterungleichWITH FALSE FI ;
+IF schluesselsve2[i]<>wert(dateinummer+i)THEN LEAVE naechsterungleichWITH 
+TRUE FI PER ;FALSE FI .datenlesen:stackentry(1).einzelbriefschreiben:IF NOT 
+sonderwerteundueberpruefungauferstellbarkeitTHEN meldenichterstellbarELSE 
+briefschreibenFI .meldenichtgefunden:standardmeldung(existiertnichtnr,niltext
+).meldeanforderunggenauererangaben:standardmeldung(weitereangabenr,niltext).
+meldenichterstellbar:standardmeldung(nichterstellbarmeldnr,sonderwert(
+indexadressat)+meldkz).meldeendederbrieferstellung:standardmeldung(endemeldnr
+,niltext).zurueckzumeingangsbildschirm:enter(nproc).leererbestand:anzgeftupel
+:=tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);IF 
+anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;NOT pruefespeziellELSE TRUE 
+FI .meldeleerenbestand:standardmeldung(leermeldnr,niltext).briefschreiben:
+anschreibentext:=druckdatei;print(anschreibentext);standardmeldung(
+druckmeldnr,sonderwert(indexadressat)+meldkz);forget(anschreibentext,quiet).
+END PROC zusammengesetztesanschreiben;PROC gesetztenschluesselsichern(ROW 10
+TEXT VAR schluesselsve):INT VAR i;FOR iFROM 1UPTO anzkey(dateinummer)REP 
+schluesselsve[i]:=wert(dateinummer+i)PER ENDPROC gesetztenschluesselsichern;
+PROC anschreibenleseschleife(BOOL PROC sonderwerteundueberpruefungauf
+erstellbarkeit,BOOL PROC pruefespeziell,TEXT PROC druckdatei):BOOL VAR 
+schluss:=FALSE ;vorlesen;leseschleife.leseschleife:WHILE NOT schlussREP IF 
+sonderwerteundueberpruefungauferstellbarkeitTHEN briefschreibenELSE 
+standardmeldung(nichterstellbarmeldnr,sonderwert(indexadressat)+meldkz)FI ;
+lesenPER .lesen:IF anzgeftupel=0THEN anzgeftupel:=tupelstackgroesse;multisucc
+(aktuellerindex,anzgeftupel)FI ;satzlesen.vorlesen:anzgeftupel:=
+tupelstackgroesse;multisearchforward(aktuellerindex,anzgeftupel);satzlesen.
+satzlesen:IF anzgeftupel<>0THEN multisucc;anzgeftupelDECR 1;schluss:=NOT 
+pruefespeziellELSE schluss:=TRUE FI .briefschreiben:anschreibentext:=
+druckdatei;print(anschreibentext);standardmeldung(druckmeldnr,sonderwert(
+indexadressat)+meldkz);forget(anschreibentext,quiet).END PROC 
+anschreibenleseschleife;PROC editierebrief:editiere(anschreibentext,
+vorwaertstaste,FALSE )END PROC editierebrief;PROC 
+naechsteszusammengesetztesanschreiben(BOOL PROC 
+sonderwerteundueberpruefungauferstellbarkeit,BOOL PROC pruefespeziell,BOOL 
+CONST drucken,TEXT PROC druckdatei):BOOL VAR bestandleer:=FALSE ;IF drucken
+THEN print(anschreibentext);standardmeldung(druckmeld#nr,#,sonderwert(
+indexadressat)+meldkz)FI ;forget(anschreibentext,quiet);IF einzelbearbeitung
+THEN enter(eingangsbildschirm)ELSE REP IF anzgeftupel=0THEN anzgeftupel:=
+tupelstackgroesse;multisucc(aktuellerindex,anzgeftupel)FI ;IF anzgeftupel<>0
+THEN multisucc;anzgeftupelDECR 1;bestandleer:=NOT pruefespeziellELSE 
+bestandleer:=TRUE FI UNTIL bestandleerCOR 
+sonderwerteundueberpruefungauferstellbarkeitPER ;IF NOT bestandleerTHEN 
+anschreibentext:=druckdatei;return(nproc)ELSE standardmeldung(endemeldnr,
+niltext);enter(eingangsbildschirm)FI FI END PROC 
+naechsteszusammengesetztesanschreiben;END PACKET 
+anschrsteuerfunktionenfuerzusammengesetzteanschreiben;
+
diff --git a/app/schulis/2.2.1/src/0.erf aufsichtszeiten b/app/schulis/2.2.1/src/0.erf aufsichtszeiten
new file mode 100644
index 0000000..443be9d
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.erf aufsichtszeiten
@@ -0,0 +1,201 @@
+PACKET erfaufsichtszeitenDEFINES aufsichtszeitenveraendern,
+aufsichtszeitenspeichern,aufsichtszeitenzeileentfernen,
+aufsichtszeitenzeileeinfuegen,aufsichtszeitenuebernehmen,
+aufsichtszeitenkopieren:LET niltext="",titelanfang="Aufsichtszeiten für das "
+,titelmitte=". Halbjahr ",trennerfuerschuljahr="/",null=0,eins=1;LET 
+fnrfueruebernehmen=2,fnrfuergeplbearb=3,fnrabtagfuergepl=4,fnrfueraktbearb=5,
+fnrabtagfuerakt=6,fnrcursorruhepos=7,allewochentagsbezeichnungen=
+"MODIMIDOFRSAMoDiMiDoFrSamodimidofrsa",maske="ms aufsichtszeiten",
+fnrwochentag=2,fnrerstebezeichnung=3,felderprozeile=5,offsetstundevor=1,
+offsetstundenach=2,offsetbeginnuhr=3,offsetendeuhr=4,fnrerstesfeldletztezeile
+=73,fnrletztesfeld=77,erstestundeamtag=1,stundenprowochentag=12,
+stundenamsamstag=6,stelledestages=100,datensaetzepromaske=15;LET 
+textschuljahr="Schuljahr",textschulhalbjahr="Schulhalbjahr";LET 
+meldungfeldleerlassen=390,meldungzeilezutief=391,meldungmindeinestunde=392,
+meldungspeicherung=50,meldungfalschezeitangabe=54,meldungeingabesinnlos=56,
+meldungplausi=57,meldungdatenfehlen=68,meldungspeicherfehler=73,
+meldungfrageuebernehmen=300,meldunguebernehmen=301,meldungzeitangabezulang=
+341,meldungfalschezeitfolge=342,meldungfalschetagesbez=385,
+meldungstdnachfolgend=386;TEXT VAR schuljahr:=niltext,halbjahr:=niltext;BOOL 
+VAR datenvorhanden;INT VAR tagnr;LET nummerfürmo=1,kürzelfürmo="Mo",
+nummerfürdi=2,kürzelfürdi="Di",nummerfürmi=3,kürzelfürmi="Mi",nummerfürdo=4,
+kürzelfürdo="Do",nummerfürfr=5,kürzelfürfr="Fr",nummerfürsa=6,kürzelfürsa=
+"Sa";ROW datensaetzepromaskeTEXT VAR alteaufsichtszeiten;INT VAR aktindex;
+PROC aufsichtszeitenzeileeinfuegen:INT VAR i,cursorfeld:=infeld;IF cursorfeld
+>=fnrerstesfeldletztezeileTHEN standardmeldung(meldungzeilezutief,niltext);
+ELSE cursorfeld:=cursorfeld-((cursorfeld-fnrerstebezeichnung)MOD 
+felderprozeile)+felderprozeile;FOR iFROM fnrletztesfeldDOWNTO cursorfeld+
+felderprozeileREP standardmaskenfeld(standardmaskenfeld(i-felderprozeile),i)
+PER ;FOR iFROM cursorfeldUPTO cursorfeld+offsetendeuhrREP standardmaskenfeld(
+niltext,i)PER ;FI ;return(1);END PROC aufsichtszeitenzeileeinfuegen;PROC 
+aufsichtszeitenzeileentfernen:INT VAR i,cursorfeld:=infeld;cursorfeld:=
+cursorfeld-((cursorfeld-fnrerstebezeichnung)MOD felderprozeile);FOR iFROM 
+cursorfeldUPTO cursorfeld+offsetendeuhrREP standardmaskenfeld(niltext,i)PER ;
+infeld(cursorfeld);return(1);END PROC aufsichtszeitenzeileentfernen;PROC 
+aufsichtszeitenveraendern:INT VAR aktfnr;pruefeplausidereingangsmaske;
+setzeschulhalbjahrindenmaskekopf;holealledatendestages;infeld(fnrwochentag);
+standardfelderausgeben;infeld(fnrerstebezeichnung);standardnproc.
+pruefeplausidereingangsmaske:IF standardmaskenfeld(fnrfueruebernehmen)<>
+niltextOR NOT (standardmaskenfeld(fnrfuergeplbearb)<>niltextXOR 
+standardmaskenfeld(fnrfueraktbearb)<>niltext)THEN standardmeldung(
+meldungeingabesinnlos,niltext);IF standardmaskenfeld(fnrfueruebernehmen)=
+niltextTHEN infeld(fnrfuergeplbearb)ELSE infeld(fnrfueruebernehmen)FI ;return
+(1);LEAVE aufsichtszeitenveraendernFI ;IF standardmaskenfeld(fnrfuergeplbearb
+)=niltextTHEN aktfnr:=fnrabtagfuergeplELSE aktfnr:=fnrabtagfueraktFI ;IF 
+standardmaskenfeld(aktfnr)<>niltextTHEN standardmeldung(meldungfeldleerlassen
+,niltext);infeld(aktfnr);return(1);LEAVE aufsichtszeitenveraendernFI ;IF 
+standardmaskenfeld(fnrfuergeplbearb)=niltextTHEN aktfnr:=fnrabtagfueraktELSE 
+aktfnr:=fnrabtagfuergeplFI ;IF standardmaskenfeld(aktfnr)=niltextTHEN tagnr:=
+nummerfürmo;ELSE tagnr:=pos(allewochentagsbezeichnungen,standardmaskenfeld(
+aktfnr));IF tagnr=0THEN standardmeldung(meldungfalschetagesbez,niltext);
+infeld(aktfnr);return(1);LEAVE aufsichtszeitenveraendernFI ;tagnr:=(tagnrMOD 
+12)DIV 2+1;FI .setzeschulhalbjahrindenmaskekopf:schuljahr:=schulkenndatum(
+textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr);IF 
+standardmaskenfeld(fnrfuergeplbearb)<>niltextTHEN geplanteshjundsjberechnen(
+halbjahr,schuljahr)FI ;standardstartproc(maske);
+standardkopfmaskeaktualisieren(titelanfang+halbjahr+titelmitte+text(schuljahr
+,2)+trennerfuerschuljahr+subtext(schuljahr,3)).END PROC 
+aufsichtszeitenveraendern;PROC aufsichtszeitenspeichern(BOOL CONST speichern)
+:INT VAR fehlerstatus:=null,aktfnr,aznr,beginn,ende,letztestd,i;IF speichern
+THEN pruefeplausibilitaet;IF fehlerstatus<>nullTHEN infeld(fehlerstatus);
+return(1);LEAVE aufsichtszeitenspeichernFI ;speicherungdurchfuehren;FI ;IF 
+tagnr<nummerfürsaTHEN tagnrINCR 1;holealledatendestages;infeld(fnrwochentag);
+standardfelderausgeben;infeld(fnrerstebezeichnung);return(1)ELSE enter(2)FI .
+pruefeplausibilitaet:standardmeldung(meldungplausi,niltext);aktfnr:=
+fnrerstebezeichnung-1;FOR iFROM 1UPTO datensaetzepromaskeREP aktfnrINCR 1;IF 
+(standardmaskenfeld(aktfnr)<>niltextCOR standardmaskenfeld(aktfnr+
+offsetbeginnuhr)<>niltextCOR standardmaskenfeld(aktfnr+offsetendeuhr)<>
+niltext)CAND standardmaskenfeld(aktfnr+offsetstundevor)=niltextCAND 
+standardmaskenfeld(aktfnr+offsetstundenach)=niltextTHEN standardmeldung(
+meldungmindeinestunde,niltext);fehlerstatus:=aktfnr+offsetstundevor;LEAVE 
+pruefeplausibilitaetFI ;IF tagnr=nummerfürsaTHEN letztestd:=stundenamsamstag
+ELSE letztestd:=stundenprowochentagFI ;aktfnrINCR 1;IF standardmaskenfeld(
+aktfnr)<>niltextTHEN standardpruefe(2,aktfnr,null,null,niltext,fehlerstatus);
+IF fehlerstatus<>0THEN LEAVE pruefeplausibilitaetFI ;standardpruefe(3,aktfnr,
+erstestundeamtag,letztestd,niltext,fehlerstatus);IF fehlerstatus<>0THEN 
+LEAVE pruefeplausibilitaetFI ;FI ;beginn:=int(standardmaskenfeld(aktfnr));
+aktfnrINCR 1;IF standardmaskenfeld(aktfnr)<>niltextTHEN standardpruefe(2,
+aktfnr,null,null,niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE 
+pruefeplausibilitaetFI ;standardpruefe(3,aktfnr,erstestundeamtag,letztestd,
+niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE pruefeplausibilitaetFI ;
+FI ;ende:=int(standardmaskenfeld(aktfnr));IF beginn>0AND ende>0AND ende<>
+beginn+1THEN standardmeldung(meldungstdnachfolgend,niltext);fehlerstatus:=
+aktfnr-1;LEAVE pruefeplausibilitaetFI ;aktfnrINCR 1;beginn:=int(
+standardmaskenfeld(aktfnr));IF falschezeitangabe(beginn,aktfnr,fehlerstatus)
+THEN LEAVE pruefeplausibilitaetFI ;aktfnrINCR 1;ende:=int(standardmaskenfeld(
+aktfnr));IF falschezeitangabe(ende,aktfnr,fehlerstatus)THEN LEAVE 
+pruefeplausibilitaetFI ;IF beginn>endeAND ende>0THEN standardmeldung(
+meldungfalschezeitfolge,niltext);fehlerstatus:=aktfnr-1;LEAVE 
+pruefeplausibilitaetFI PER .speicherungdurchfuehren:standardmeldung(
+meldungspeicherung,niltext);aktfnr:=fnrerstebezeichnung;aznr:=1;
+suchenächstenichtleerezeile;WHILE aktfnr<=fnrerstesfeldletztezeileREP infeld(
+aktfnr);fülleprimärindexfelder;search(dnraufsichtszeiten,true);
+füllerestlichedbfelder;IF dbstatus<>nullTHEN insert(dnraufsichtszeiten)ELSE 
+update(dnraufsichtszeiten)FI ;speicherfehlerabfangen;aktfnrINCR 
+felderprozeile;aznrINCR 1;suchenächstenichtleerezeile;PER ;dbstatus(0);WHILE 
+dbstatus=0CAND aznr<=datensaetzepromaskeREP fülleprimärindexfelder;delete(
+dnraufsichtszeiten);aznrINCR 1;PER .suchenächstenichtleerezeile:WHILE aktfnr
+<=fnrerstesfeldletztezeileCAND zeileistleerREP aktfnrINCR felderprozeilePER .
+zeileistleer:standardmaskenfeld(aktfnr)+standardmaskenfeld(aktfnr+
+offsetbeginnuhr)+standardmaskenfeld(aktfnr+offsetendeuhr)+standardmaskenfeld(
+aktfnr+offsetstundevor)+standardmaskenfeld(aktfnr+offsetstundenach)=niltext.
+fülleprimärindexfelder:putwert(fnrazsj,schuljahr);putwert(fnrazhj,halbjahr);
+putintwert(fnrazaufsichtszeit,tagnr*stelledestages+aznr);.
+füllerestlichedbfelder:putwert(fnrazbezeichnung,standardmaskenfeld(aktfnr));
+IF standardmaskenfeld(aktfnr+offsetstundevor)=niltextTHEN putintwert(
+fnraztagstdvor,null)ELSE putintwert(fnraztagstdvor,(tagnr-1)*
+stundenprowochentag+int(standardmaskenfeld(aktfnr+offsetstundevor)))FI ;IF 
+standardmaskenfeld(aktfnr+offsetstundenach)=niltextTHEN putintwert(
+fnraztagstdnach,null)ELSE putintwert(fnraztagstdnach,(tagnr-1)*
+stundenprowochentag+int(standardmaskenfeld(aktfnr+offsetstundenach)))FI ;
+putwert(fnrazbeginnuhr,standardmaskenfeld(aktfnr+offsetbeginnuhr));putwert(
+fnrazendeuhr,standardmaskenfeld(aktfnr+offsetendeuhr)).speicherfehlerabfangen
+:IF dbstatus<>nullTHEN standardmeldung(meldungspeicherfehler,niltext);return(
+1);LEAVE aufsichtszeitenspeichernFI .END PROC aufsichtszeitenspeichern;PROC 
+aufsichtszeitenkopieren:INT VAR i,altetagnr;aktindex:=null;altetagnr:=tagnr;
+tagnr:=nummerfürmo;inittupel(dnraufsichtszeiten);statleseschleife(
+dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC fuellenurmaske);
+FOR iFROM aktindex*felderprozeile+fnrerstebezeichnungUPTO fnrletztesfeldREP 
+standardmaskenfeld(niltext,i)PER ;tagnr:=altetagnr;infeld(fnrerstebezeichnung
+);return(1);END PROC aufsichtszeitenkopieren;PROC aufsichtszeitenuebernehmen(
+BOOL CONST hauptaktion):TEXT VAR geplhj,geplsj;INT VAR i,j,altetagnr;IF NOT 
+hauptaktionTHEN prüfeobeingangsmaskerichtigangekreuzt;schuljahr:=
+schulkenndatum(textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr);
+tagnr:=nummerfürmo;fuelledenpuffermitdenaufsichtszeiten;IF datenvorhanden
+THEN standardmeldung(meldungfrageuebernehmen,niltext);feldschutz(
+fnrfueruebernehmen);feldschutz(fnrfuergeplbearb);feldschutz(fnrabtagfuergepl)
+;feldschutz(fnrfueraktbearb);feldschutz(fnrabtagfuerakt);feldfrei(
+fnrcursorruhepos);infeld(fnrcursorruhepos);standardnproc;ELSE standardmeldung
+(meldungdatenfehlen,niltext);infeld(fnrfueruebernehmen);return(1)FI ELSE 
+standardmeldung(meldunguebernehmen,niltext);geplhj:=halbjahr;geplsj:=
+schuljahr;geplanteshjundsjberechnen(geplhj,geplsj);WHILE datenvorhandenREP 
+löschealletagebiszumvorliegenden;speicheredenvorliegendentag;tagnrINCR 1;
+fuelledenpuffermitdenaufsichtszeiten;PER ;löscheallerestlichentage;enter(2)
+FI .prüfeobeingangsmaskerichtigangekreuzt:IF standardmaskenfeld(
+fnrfueruebernehmen)=niltextOR standardmaskenfeld(fnrfuergeplbearb)<>niltext
+OR standardmaskenfeld(fnrfueraktbearb)<>niltextTHEN standardmeldung(
+meldungeingabesinnlos,niltext);infeld(fnrfueruebernehmen);return(1);LEAVE 
+aufsichtszeitenuebernehmenFI ;IF standardmaskenfeld(fnrabtagfuergepl)<>
+niltextTHEN standardmeldung(meldungfeldleerlassen,niltext);infeld(
+fnrabtagfuergepl);return(1);LEAVE aufsichtszeitenuebernehmenFI ;IF 
+standardmaskenfeld(fnrabtagfuerakt)<>niltextTHEN standardmeldung(
+meldungfeldleerlassen,niltext);infeld(fnrabtagfuerakt);return(1);LEAVE 
+aufsichtszeitenuebernehmenFI ;.fuelledenpuffermitdenaufsichtszeiten:aktindex
+:=null;datenvorhanden:=FALSE ;altetagnr:=tagnr;inittupel(dnraufsichtszeiten);
+statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC 
+fuellenurpuffer);.löschealletagebiszumvorliegenden:FOR iFROM altetagnrUPTO 
+tagnr-1REP löschedateneinestagesPER .löschedateneinestages:j:=1;dbstatus(0);
+WHILE dbstatus=0CAND j<=datensaetzepromaskeREP putwert(fnrazsj,geplsj);
+putwert(fnrazhj,geplhj);putintwert(fnrazaufsichtszeit,i*stelledestages+j);
+delete(dnraufsichtszeiten);jINCR 1;PER .speicheredenvorliegendentag:i:=1;
+WHILE i<=aktindexREP fülleprimärindexfelder;search(dnraufsichtszeiten,true);
+füllerestlichedbfelder;IF dbstatus<>nullTHEN insert(dnraufsichtszeiten)ELSE 
+update(dnraufsichtszeiten)FI ;speicherfehlerabfangen;iINCR 1;PER ;WHILE 
+dbstatus=0CAND i<=datensaetzepromaskeREP fülleprimärindexfelder;delete(
+dnraufsichtszeiten);iINCR 1;PER .fülleprimärindexfelder:putwert(fnrazsj,
+geplsj);putwert(fnrazhj,geplhj);putintwert(fnrazaufsichtszeit,tagnr*
+stelledestages+i);.füllerestlichedbfelder:restoretupel(dnraufsichtszeiten,
+alteaufsichtszeiten(i));putwert(fnrazsj,geplsj);putwert(fnrazhj,geplhj);.
+speicherfehlerabfangen:IF dbstatus<>nullTHEN standardmeldung(
+meldungspeicherfehler,niltext);infeld(fnrfueruebernehmen);return(2);LEAVE 
+aufsichtszeitenuebernehmenFI .löscheallerestlichentage:FOR iFROM altetagnr
+UPTO nummerfürsaREP löschedateneinestagesPER .END PROC 
+aufsichtszeitenuebernehmen;PROC holealledatendestages:TEXT VAR tag;INT VAR i;
+setzewochentagindiemaske;holegewünschtentagindiemaske.
+setzewochentagindiemaske:SELECT tagnrOF CASE nummerfürmo:tag:=kürzelfürmo
+CASE nummerfürdi:tag:=kürzelfürdiCASE nummerfürmi:tag:=kürzelfürmiCASE 
+nummerfürdo:tag:=kürzelfürdoCASE nummerfürfr:tag:=kürzelfürfrCASE nummerfürsa
+:tag:=kürzelfürsaEND SELECT ;standardmaskenfeld(tag,fnrwochentag).
+holegewünschtentagindiemaske:aktindex:=null;inittupel(dnraufsichtszeiten);
+statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,PROC 
+fuellenurmaske);FOR iFROM aktindex*felderprozeile+fnrerstebezeichnungUPTO 
+fnrletztesfeldREP standardmaskenfeld(niltext,i)PER ;.END PROC 
+holealledatendestages;PROC fuellenurmaske(BOOL VAR b):INT VAR feldnr,stunde;
+IF wert(fnrazsj)>schuljahrCOR wert(fnrazhj)>halbjahrCOR intwert(
+fnrazaufsichtszeit)>tagnr*stelledestages+datensaetzepromaskeCOR dbstatus<>0
+THEN b:=TRUE ELSE IF intwert(fnrazaufsichtszeit)>tagnr*stelledestagesTHEN 
+aktindexINCR eins;feldnr:=fnrerstebezeichnung+(aktindex-1)*felderprozeile;
+standardmaskenfeld(wert(fnrazbezeichnung),feldnr);feldnrINCR 1;stunde:=
+intwert(fnraztagstdvor);IF stunde>0THEN stunde:=(stunde-1)MOD 
+stundenprowochentag+1;standardmaskenfeld(text(stunde),feldnr);ELSE 
+standardmaskenfeld(niltext,feldnr);FI ;feldnrINCR 1;stunde:=intwert(
+fnraztagstdnach);IF stunde>0THEN stunde:=(stunde-1)MOD stundenprowochentag+1;
+standardmaskenfeld(text(stunde),feldnr);ELSE standardmaskenfeld(niltext,
+feldnr);FI ;feldnrINCR 1;standardmaskenfeld(wert(fnrazbeginnuhr),feldnr);
+feldnrINCR 1;standardmaskenfeld(wert(fnrazendeuhr),feldnr);FI FI END PROC 
+fuellenurmaske;PROC fuellenurpuffer(BOOL VAR b):IF wert(fnrazsj)>schuljahr
+COR wert(fnrazhj)>halbjahrCOR (datenvorhandenCAND intwert(fnrazaufsichtszeit)
+>tagnr*stelledestages+datensaetzepromaske)COR dbstatus<>0THEN b:=TRUE ELSE 
+IF intwert(fnrazaufsichtszeit)>tagnr*stelledestagesTHEN IF NOT datenvorhanden
+THEN datenvorhanden:=TRUE ;tagnr:=intwert(fnrazaufsichtszeit)DIV 
+stelledestagesFI ;aktindexINCR eins;savetupel(dnraufsichtszeiten,
+alteaufsichtszeiten(aktindex));FI FI END PROC fuellenurpuffer;BOOL PROC 
+falschezeitangabe(INT CONST zeit,fnr,INT VAR status):IF standardmaskenfeld(
+fnr)=niltextTHEN LEAVE falschezeitangabeWITH FALSE FI ;IF length(
+standardmaskenfeld(fnr))>4THEN standardmeldung(meldungzeitangabezulang,
+niltext);status:=fnr;LEAVE falschezeitangabeWITH TRUE FI ;standardpruefe(2,
+fnr,null,null,niltext,status);IF status<>nullTHEN LEAVE falschezeitangabe
+WITH TRUE FI ;IF zeit<nullOR zeitMOD 100>59OR zeitDIV 100>24THEN 
+standardmeldung(meldungfalschezeitangabe,niltext);status:=fnr;TRUE ELSE 
+FALSE FI END PROC falschezeitangabe;END PACKET erfaufsichtszeiten;
+
diff --git a/app/schulis/2.2.1/src/0.erf zeitraster b/app/schulis/2.2.1/src/0.erf zeitraster
new file mode 100644
index 0000000..b1b1bd7
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.erf zeitraster
@@ -0,0 +1,145 @@
+PACKET erfzeitrasterDEFINES zeitrasterveraendern,zeitrasterspeichern,
+zeitrasteruebernehmen,zeitrasterkopieren:LET trenner="�",niltext="",
+titelanfang="Zeitraster für das ",titelmitte=". Halbjahr ",
+trennerfuerschuljahr="/",null=0,eins=1;LET fnrfueruebernehmen=2,
+fnrfuergeplbearb=3,fnrfueraktbearb=4,fnrcursorruhepos=5,maske="ms zeitraster"
+,fnrerstertagesteil=2,wochentage=6,stundenprowochentag=12,stundenamsamstag=6,
+vormittagsstunden=6,nachmittagsstunden=6,zeitfelderprowochentag=24,
+felderprowochentag=36,datensaetzepromaske=66,erstesfeldfuersamstag=182;LET 
+textschuljahr="Schuljahr",textschulhalbjahr="Schulhalbjahr";LET 
+kennungvormittag="v",kennungnachmittag="n",allekennungen="vnx",
+kennungmoerstestd=1;LET meldungeingabesinnlos=56,meldungfalschekennung=55,
+meldungfalschezeitangabe=54,meldungzeitangabezulang=341,
+meldungfalschezeitfolge=342,meldungplausi=57,meldungdatenfehlen=68,
+meldungfrageuebernehmen=300,meldunguebernehmen=301,meldungfeldfuellen=52,
+meldungspeicherfehler=73,meldungspeicherung=50;TEXT VAR schuljahr:=niltext,
+halbjahr:=niltext;BOOL VAR datenvorhanden,datenlueckenhaft;ROW 
+datensaetzepromaskeTEXT VAR alteszeitraster;INT VAR aktindex;PROC 
+zeitrasterveraendern:INT VAR i,j,aktfnr;IF standardmaskenfeld(
+fnrfueruebernehmen)=niltextAND (standardmaskenfeld(fnrfuergeplbearb)<>niltext
+XOR standardmaskenfeld(fnrfueraktbearb)<>niltext)THEN schuljahr:=
+schulkenndatum(textschuljahr);halbjahr:=schulkenndatum(textschulhalbjahr);IF 
+standardmaskenfeld(fnrfuergeplbearb)<>niltextTHEN geplanteshjundsjberechnen(
+halbjahr,schuljahr)FI ;standardstartproc(maske);
+standardkopfmaskeaktualisieren(titelanfang+halbjahr+titelmitte+text(schuljahr
+,2)+trennerfuerschuljahr+subtext(schuljahr,3));aktindex:=null;inittupel(
+dnrzeitraster);statleseschleife(dnrzeitraster,schuljahr,halbjahr,fnrzrsj,
+fnrzrhj,PROC fuellemaskeundpuffer);datenvorhanden:=aktindex>null;
+datenlueckenhaft:=datenvorhandenCAND aktindex<datensaetzepromaske;IF NOT 
+datenvorhandenTHEN aktfnr:=fnrerstertagesteil;FOR iFROM einsUPTO wochentage-
+einsREP FOR jFROM einsUPTO vormittagsstundenREP standardmaskenfeld(
+kennungvormittag,aktfnr);aktfnrINCR einsPER ;FOR jFROM einsUPTO 
+nachmittagsstundenREP standardmaskenfeld(kennungnachmittag,aktfnr);aktfnr
+INCR einsPER ;aktfnrINCR zeitfelderprowochentag;PER ;FOR iFROM einsUPTO 
+stundenamsamstagREP standardmaskenfeld(kennungvormittag,aktfnr);aktfnrINCR 
+einsPER ;FI ;standardnprocELSE standardmeldung(meldungeingabesinnlos,niltext)
+;IF standardmaskenfeld(fnrfueruebernehmen)=niltextTHEN infeld(
+fnrfuergeplbearb)ELSE infeld(fnrfueruebernehmen)FI ;return(1)FI END PROC 
+zeitrasterveraendern;PROC zeitrasterspeichern:INT VAR fehlerstatus:=null,
+aktfnr,aktfnrbeginn,aktfnrende,beginnzeit,endezeit,i;pruefeplausibilitaet;IF 
+fehlerstatus<>nullTHEN infeld(fehlerstatus);return(1);LEAVE 
+zeitrasterspeichernELSE speicherungdurchfuehrenFI ;enter(2).
+pruefeplausibilitaet:standardmeldung(meldungplausi,niltext);FOR iFROM null
+UPTO datensaetzepromaske-einsREP aktfnr:=fnrerstertagesteil+iMOD 
+stundenprowochentag+(iDIV stundenprowochentag)*felderprowochentag;IF aktfnr>=
+erstesfeldfuersamstagTHEN aktfnrbeginn:=aktfnr+stundenamsamstag;aktfnrende:=
+aktfnrbeginn+stundenamsamstagELSE aktfnrbeginn:=aktfnr+stundenprowochentag;
+aktfnrende:=aktfnrbeginn+stundenprowochentagFI ;IF standardmaskenfeld(aktfnr)
+=niltextTHEN standardmeldung(meldungfeldfuellen,niltext);fehlerstatus:=aktfnr
+;LEAVE pruefeplausibilitaetFI ;IF pos(allekennungen,standardmaskenfeld(aktfnr
+))=nullTHEN standardmeldung(meldungfalschekennung,niltext);fehlerstatus:=
+aktfnr;LEAVE pruefeplausibilitaetFI ;beginnzeit:=int(standardmaskenfeld(
+aktfnrbeginn));IF falschezeitangabe(beginnzeit,aktfnrbeginn,fehlerstatus)
+THEN LEAVE pruefeplausibilitaetFI ;endezeit:=int(standardmaskenfeld(
+aktfnrende));IF falschezeitangabe(endezeit,aktfnrende,fehlerstatus)THEN 
+LEAVE pruefeplausibilitaetFI ;IF beginnzeit>endezeitAND endezeit>0THEN 
+standardmeldung(meldungfalschezeitfolge,niltext);fehlerstatus:=aktfnrbeginn;
+LEAVE pruefeplausibilitaetFI PER .speicherungdurchfuehren:standardmeldung(
+meldungspeicherung,niltext);FOR aktindexFROM einsUPTO datensaetzepromaskeREP 
+berechnemaskenunddbgroessen;IF datenvorhandenTHEN IF stundewurdeveraendert
+THEN infeld(aktfnr);putwert(fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr);
+putintwert(fnrzrtagstunde,aktindex);search(dnrzeitraster,true);putwert(
+fnrzrkennungteil,standardmaskenfeld(aktfnr));putwert(fnrzrbeginnuhr,
+standardmaskenfeld(aktfnrbeginn));putwert(fnrzrendeuhr,standardmaskenfeld(
+aktfnrende));IF dbstatus<>nullTHEN insert(dnrzeitraster)ELSE update(
+dnrzeitraster)FI ;speicherfehlerabfangenFI ELSE infeld(aktfnr);putwert(
+fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr);putintwert(fnrzrtagstunde,
+aktindex);putwert(fnrzrkennungteil,standardmaskenfeld(aktfnr));putwert(
+fnrzrbeginnuhr,standardmaskenfeld(aktfnrbeginn));putwert(fnrzrendeuhr,
+standardmaskenfeld(aktfnrende));insert(dnrzeitraster)FI PER .
+berechnemaskenunddbgroessen:aktfnr:=fnrerstertagesteil+(aktindex-eins)MOD 
+stundenprowochentag+((aktindex-eins)DIV stundenprowochentag)*
+felderprowochentag;IF aktfnr>=erstesfeldfuersamstagTHEN aktfnrbeginn:=aktfnr+
+stundenamsamstag;aktfnrende:=aktfnrbeginn+stundenamsamstagELSE aktfnrbeginn:=
+aktfnr+stundenprowochentag;aktfnrende:=aktfnrbeginn+stundenprowochentagFI ;.
+stundewurdeveraendert:datenlueckenhaftCOR standardmaskenfeld(aktfnr)+trenner+
+standardmaskenfeld(aktfnrbeginn)+trenner+standardmaskenfeld(aktfnrende)<>
+alteszeitraster(aktindex).speicherfehlerabfangen:IF dbstatus<>nullTHEN 
+standardmeldung(meldungspeicherfehler,niltext);return(1);LEAVE 
+zeitrasterspeichernFI .END PROC zeitrasterspeichern;PROC zeitrasterkopieren:
+TEXT VAR tagesteil,beginn,ende;INT VAR i,j,aktfnr:=fnrerstertagesteil;FOR i
+FROM 0UPTO stundenprowochentag-1REP aktfnr:=fnrerstertagesteil+i;tagesteil:=
+standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;beginn:=
+standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;ende:=
+standardmaskenfeld(aktfnr);aktfnrINCR stundenprowochentag;FOR jFROM 1UPTO 
+wochentage-2REP standardmaskenfeld(tagesteil,aktfnr);aktfnrINCR 
+stundenprowochentag;standardmaskenfeld(beginn,aktfnr);aktfnrINCR 
+stundenprowochentag;standardmaskenfeld(ende,aktfnr);aktfnrINCR 
+stundenprowochentagPER ;IF i<stundenamsamstagTHEN standardmaskenfeld(
+tagesteil,aktfnr);aktfnrINCR stundenamsamstag;standardmaskenfeld(beginn,
+aktfnr);aktfnrINCR stundenamsamstag;standardmaskenfeld(ende,aktfnr)FI PER ;
+return(1);END PROC zeitrasterkopieren;PROC zeitrasteruebernehmen(BOOL CONST 
+hauptaktion):INT VAR posi,i;TEXT VAR satz;BOOL VAR ueberschreiben;IF NOT 
+hauptaktionTHEN IF NOT eingangsmaskerichtigangekreuztTHEN standardmeldung(
+meldungeingabesinnlos,niltext);infeld(fnrfueruebernehmen);return(1);LEAVE 
+zeitrasteruebernehmenFI ;schuljahr:=schulkenndatum(textschuljahr);halbjahr:=
+schulkenndatum(textschulhalbjahr);fuelledenpuffermitdemzeitraster;IF 
+datenvorhandenTHEN standardmeldung(meldungfrageuebernehmen,niltext);
+feldschutz(fnrfueruebernehmen);feldschutz(fnrfuergeplbearb);feldschutz(
+fnrfueraktbearb);feldfrei(fnrcursorruhepos);infeld(fnrcursorruhepos);
+standardnproc;ELSE standardmeldung(meldungdatenfehlen,niltext);infeld(
+fnrfueruebernehmen);return(1)FI ELSE standardmeldung(meldunguebernehmen,
+niltext);geplanteshjundsjberechnen(halbjahr,schuljahr);
+testeobdatenschonvorhanden;FOR iFROM einsUPTO aktindexREP 
+ladedendatenbankpuffer;IF ueberschreibenCAND dbstatus=nullTHEN update(
+dnrzeitraster)ELSE insert(dnrzeitraster)FI ;speicherfehlerabfangen;PER ;enter
+(2)FI .eingangsmaskerichtigangekreuzt:standardmaskenfeld(fnrfueruebernehmen)
+<>niltextAND standardmaskenfeld(fnrfuergeplbearb)=niltextAND 
+standardmaskenfeld(fnrfueraktbearb)=niltext.fuelledenpuffermitdemzeitraster:
+aktindex:=null;inittupel(dnrzeitraster);statleseschleife(dnrzeitraster,
+schuljahr,halbjahr,fnrzrsj,fnrzrhj,PROC fuellenurpuffer);datenvorhanden:=
+aktindex>null.testeobdatenschonvorhanden:putwert(fnrzrsj,schuljahr);putwert(
+fnrzrhj,halbjahr);putintwert(fnrzrtagstunde,kennungmoerstestd);search(
+dnrzeitraster,TRUE );ueberschreiben:=dbstatus=null.ladedendatenbankpuffer:
+putwert(fnrzrsj,schuljahr);putwert(fnrzrhj,halbjahr);satz:=alteszeitraster(i)
+;posi:=pos(satz,trenner);putwert(fnrzrtagstunde,text(satz,posi-eins));IF 
+ueberschreibenTHEN search(dnrzeitraster,TRUE )FI ;satz:=subtext(satz,posi+
+eins);posi:=pos(satz,trenner);putwert(fnrzrkennungteil,text(satz,posi-eins));
+satz:=subtext(satz,posi+eins);posi:=pos(satz,trenner);putwert(fnrzrbeginnuhr,
+text(satz,posi-eins));satz:=subtext(satz,posi+eins);putwert(fnrzrendeuhr,satz
+).speicherfehlerabfangen:IF ueberschreibenCAND dbstatus<>nullTHEN 
+standardmeldung(meldungspeicherfehler,niltext);infeld(fnrfueruebernehmen);
+return(1);LEAVE zeitrasteruebernehmenFI .END PROC zeitrasteruebernehmen;PROC 
+fuellemaskeundpuffer(BOOL VAR b):INT VAR feldnr,feldnr2;IF wert(fnrzrsj)>
+schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>0THEN b:=TRUE ELSE feldnr:=
+fnrerstertagesteil+aktindexMOD stundenprowochentag+(aktindexDIV 
+stundenprowochentag)*felderprowochentag;aktindexINCR eins;alteszeitraster(
+aktindex):=wert(fnrzrkennungteil)+trenner+wert(fnrzrbeginnuhr)+trenner+wert(
+fnrzrendeuhr);standardmaskenfeld(wert(fnrzrkennungteil),feldnr);IF feldnr>=
+erstesfeldfuersamstagTHEN feldnrINCR stundenamsamstag;feldnr2:=feldnr+
+stundenamsamstagELSE feldnrINCR stundenprowochentag;feldnr2:=feldnr+
+stundenprowochentagFI ;standardmaskenfeld(wert(fnrzrbeginnuhr),feldnr);
+standardmaskenfeld(wert(fnrzrendeuhr),feldnr2);FI END PROC 
+fuellemaskeundpuffer;PROC fuellenurpuffer(BOOL VAR b):IF wert(fnrzrsj)>
+schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>0THEN b:=TRUE ELSE aktindex
+INCR eins;alteszeitraster(aktindex):=wert(fnrzrtagstunde)+trenner+wert(
+fnrzrkennungteil)+trenner+wert(fnrzrbeginnuhr)+trenner+wert(fnrzrendeuhr)FI 
+END PROC fuellenurpuffer;BOOL PROC falschezeitangabe(INT CONST zeit,fnr,INT 
+VAR status):IF standardmaskenfeld(fnr)=niltextTHEN LEAVE falschezeitangabe
+WITH FALSE FI ;IF length(standardmaskenfeld(fnr))>4THEN standardmeldung(
+meldungzeitangabezulang,niltext);status:=fnr;LEAVE falschezeitangabeWITH 
+TRUE FI ;standardpruefe(2,fnr,null,null,niltext,status);IF status<>nullTHEN 
+LEAVE falschezeitangabeWITH TRUE FI ;IF zeit<nullOR zeitMOD 100>59OR zeitDIV 
+100>24THEN standardmeldung(meldungfalschezeitangabe,niltext);status:=fnr;
+TRUE ELSE FALSE FI END PROC falschezeitangabe;END PACKET erfzeitraster;
+
diff --git a/app/schulis/2.2.1/src/0.erf.faecher b/app/schulis/2.2.1/src/0.erf.faecher
new file mode 100644
index 0000000..b3cc71b
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.erf.faecher
@@ -0,0 +1,38 @@
+PACKET erffaecherDEFINES erfassungfaecher:LET maskenname="ms erf faecher",
+fnrletztesfeld=5,fnrkennung=2,fnrlangtext=3,fnrgruppe=4,fnrbereich=5,trenner=
+" = ";LET maxlaengefach=2;LET meldnrfachzulang=60;PROC erfassungfaecher(INT 
+CONST proznr):systemdboff;reinitparsing;SELECT proznrOF CASE 1:
+setzeerfassungsparameterCASE 2:zeigefachzurbearbeitungCASE 3:
+pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5:
+setzeidentiobjektfuerobjektlisteCASE 6:faecherlesenCASE 7:faecheraendernCASE 
+8:faechereinfuegenCASE 9:faecherloeschenEND SELECT END PROC erfassungfaecher;
+PROC setzeerfassungsparameter:setzeerfassungsparameter(dnrfaecher,maskenname,
+fnrletztesfeld)END PROC setzeerfassungsparameter;PROC zeigefachzurbearbeitung
+:setzeerfassungsfeld(wert(fnrffach),fnrkennung);setzeerfassungsfeld(wert(
+fnrffachbez),fnrlangtext);setzeerfassungsfeld(textnichtnull(wert(fnrffachgrp)
+),fnrgruppe);setzeerfassungsfeld(wert(fnrffachbereich),fnrbereich);END PROC 
+zeigefachzurbearbeitung;PROC pruefeplausibilitaet:LET leer="",null=0;INT VAR 
+fehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null,
+null,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus
+);LEAVE pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))>
+maxlaengefachTHEN meldeauffaellig(erfassungsmaske,meldnrfachzulang);
+setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;pruefe(1,
+erfassungsmaske,PROC erfassungswert,fnrlangtext,null,null,leer,fehlerstatus);
+IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);FI ;END PROC 
+pruefeplausibilitaet;PROC setzewertefuerdbspeicherung:putwert(fnrffach,
+compress(erfassungswert(fnrkennung)));putwert(fnrffachbez,erfassungswert(
+fnrlangtext));putwert(fnrffachgrp,erfassungswert(fnrgruppe));putwert(
+fnrffachbereich,erfassungswert(fnrbereich));END PROC 
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET 
+trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(fnrffach)+
+trenner+wert(fnrffachbez);setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert(fnrffach)
+.END PROC setzeidentiobjektfuerobjektliste;PROC faecherlesen:putwert(fnrffach
+,compress(schluessel));search(dnrfaecher,TRUE );IF dbstatus=okTHEN 
+saveupdateposition(dnrfaecher)FI END PROC faecherlesen;PROC faecheraendern:
+restoreupdateposition(dnrfaecher);update(dnrfaecher)END PROC faecheraendern;
+PROC faechereinfuegen:insert(dnrfaecher)END PROC faechereinfuegen;PROC 
+faecherloeschen:delete(dnrfaecher)END PROC faecherloeschen;TEXT PROC 
+schluessel:erfassungswert(fnrkennung)END PROC schluessel;END PACKET 
+erffaecher
+
diff --git a/app/schulis/2.2.1/src/0.erf.schuldaten b/app/schulis/2.2.1/src/0.erf.schuldaten
new file mode 100644
index 0000000..d2bedbd
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.erf.schuldaten
@@ -0,0 +1,51 @@
+PACKET erfschuldatenDEFINES erfassungschuldaten:LET maskenname=
+"ms erf schuldaten",fnrletztesfeld=9,fnrkennung=2,fnrschulname=3,
+fnrstrasseundnummer=4,fnrtelefon=5,fnrplzort=6,fnrschulart=7,fnrschulnr=8,
+fnrbundesland=9,trenner=" = ";LET maxlaengekennung=7,meldkennungzulang=60;
+LET bestandschulart="c02 schulart";PROC erfassungschuldaten(INT CONST proznr)
+:systemdboff;reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameter
+CASE 2:zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+schuldatenlesenCASE 7:schuldatenaendernCASE 8:schuldateneinfuegenCASE 9:
+schuldatenloeschenEND SELECT END PROC erfassungschuldaten;PROC 
+setzeerfassungsparameter:setzeerfassungsparameter(dnrschulen,maskenname,
+fnrletztesfeld)END PROC setzeerfassungsparameter;PROC 
+zeigeschluesselzurbearbeitung:setzeerfassungsfeld(wert(fnrschkennung),
+fnrkennung);setzeerfassungsfeld(wert(fnrschname),fnrschulname);
+setzeerfassungsfeld(wert(fnrschstrnr),fnrstrasseundnummer);
+setzeerfassungsfeld(wert(fnrschtelnr),fnrtelefon);setzeerfassungsfeld(wert(
+fnrschplzort),fnrplzort);setzeerfassungsfeld(wert(fnrschart),fnrschulart);
+setzeerfassungsfeld(wert(fnrschamtlnr),fnrschulnr);setzeerfassungsfeld(wert(
+fnrschbundesland),fnrbundesland);END PROC zeigeschluesselzurbearbeitung;PROC 
+pruefeplausibilitaet:LET leer="",null=0;INT VAR fehlerstatus;pruefe(1,
+erfassungsmaske,PROC erfassungswert,fnrkennung,null,null,leer,fehlerstatus);
+ueberpruefefehlerstatus;IF length(erfassungswert(fnrkennung))>
+maxlaengekennungTHEN meldeauffaellig(erfassungsmaske,meldkennungzulang);
+setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;pruefe(1,
+erfassungsmaske,PROC erfassungswert,fnrschulname,null,null,leer,fehlerstatus)
+;ueberpruefefehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert,
+fnrschulart,null,null,leer,fehlerstatus);ueberpruefefehlerstatus;pruefe(4,
+erfassungsmaske,PROC erfassungswert,fnrschulart,null,null,bestandschulart,
+fehlerstatus);ueberpruefefehlerstatus;.ueberpruefefehlerstatus:IF 
+fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE 
+pruefeplausibilitaetFI ;.END PROC pruefeplausibilitaet;PROC 
+setzewertefuerdbspeicherung:putwert(fnrschkennung,erfassungswert(fnrkennung))
+;putwert(fnrschname,erfassungswert(fnrschulname));putwert(fnrschstrnr,
+erfassungswert(fnrstrasseundnummer));putwert(fnrschtelnr,erfassungswert(
+fnrtelefon));putwert(fnrschplzort,erfassungswert(fnrplzort));putwert(
+fnrschart,erfassungswert(fnrschulart));putwert(fnrschamtlnr,erfassungswert(
+fnrschulnr));putwert(fnrschbundesland,erfassungswert(fnrbundesland));END 
+PROC setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET 
+trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(dnrschulen+1)+
+trenner+wert(dnrschulen+2);identizeile:=subtext(identizeile,1,
+maxidentizeilenlaenge);setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert(
+dnrschulen+1).END PROC setzeidentiobjektfuerobjektliste;PROC schuldatenlesen:
+putwert(fnrschkennung,schluessel);search(dnrschulen,TRUE );IF dbstatus=ok
+THEN saveupdateposition(dnrschulen);FI END PROC schuldatenlesen;PROC 
+schuldatenaendern:restoreupdateposition(dnrschulen);update(dnrschulen);END 
+PROC schuldatenaendern;PROC schuldateneinfuegen:insert(dnrschulen)END PROC 
+schuldateneinfuegen;PROC schuldatenloeschen:delete(dnrschulen)END PROC 
+schuldatenloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung)END PROC 
+schluessel;END PACKET erfschuldaten;
+
diff --git a/app/schulis/2.2.1/src/0.grundfunktionen local b/app/schulis/2.2.1/src/0.grundfunktionen local
new file mode 100644
index 0000000..d7b0fc8
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.grundfunktionen local
@@ -0,0 +1,132 @@
+PACKET ispgrundfunktionenlocalDEFINES lieferehalbjahreszeile,
+lieferehjdgrenzen,schulisdbname,baisydbname,putwert,wert,init,
+halbjahresdatenloeschen,schluesselfuerhjdsetzen,
+neueklasseinhalbjahresdateneintragen,schulkenndatum,datumskonversion,
+datumrekonversion,melde,jgstaufber:LET punkt=".",anzkenndat=3;LET null=0,
+niltext="",blank=" ";LET dnrhalbjahresdaten=88,fnrhjdjgst=94,fnrhjdkennung=95
+,dnrschluessel=137,fnrschlsachgebiet=138,fnrschlschluessel=139,
+fnrschllangtext=140,ixhjdfamrufgebjgsthj=263;INT VAR jgstgrenze;TEXT VAR 
+halbjahrgrenze;LET maxhalbjahre=18,anzahlhalbjahrevoraktuell=5,
+gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;TEXT CONST zeilehalbjahre
+:="05.105.206.106.207.107.208.108.209.109.2"+
+"10.110.211.111.212.112.213.113.2";INT CONST gesamtzeilenlaenge:=
+gesamtanzahlhalbjahre*laengehalbjahreseintrag;INT VAR ihalbjahr;ROW 
+maxhalbjahreSTRUCT (INT vorher,nachher)VAR anzahlhjd;
+initialisierehalbjahresdatentabelle;PROC lieferehalbjahreszeile(TEXT VAR 
+zeile,TEXT CONST hjdkennung):INT VAR subtextbeginn:=pos(zeilehalbjahre,
+hjdkennung);INT VAR subtextende;ihalbjahr:=(subtextbeginnDIV 
+laengehalbjahreseintrag)+1;TEXT VAR blanksvorher:=((anzahlhalbjahrevoraktuell
+-anzahlhjd(ihalbjahr).vorher)*laengehalbjahreseintrag)*blank;subtextbeginn:=(
+ihalbjahr-anzahlhjd(ihalbjahr).vorher-1)*laengehalbjahreseintrag+1;
+subtextende:=(ihalbjahr+anzahlhjd(ihalbjahr).nachher)*laengehalbjahreseintrag
+;TEXT VAR interessanterteilderzeilehalbjahre:=subtext(zeilehalbjahre,
+subtextbeginn,subtextende);zeile:=text(blanksvorher+
+interessanterteilderzeilehalbjahre,gesamtzeilenlaenge).END PROC 
+lieferehalbjahreszeile;PROC initialisierehalbjahresdatentabelle:anzahlhjd(1).
+vorher:=0;anzahlhjd(1).nachher:=1;anzahlhjd(2).vorher:=1;anzahlhjd(2).nachher
+:=1;anzahlhjd(3).vorher:=1;anzahlhjd(3).nachher:=1;anzahlhjd(4).vorher:=2;
+anzahlhjd(4).nachher:=1;anzahlhjd(5).vorher:=1;anzahlhjd(5).nachher:=1;
+anzahlhjd(6).vorher:=2;anzahlhjd(6).nachher:=1;anzahlhjd(7).vorher:=1;
+anzahlhjd(7).nachher:=1;anzahlhjd(8).vorher:=2;anzahlhjd(8).nachher:=1;
+anzahlhjd(9).vorher:=1;anzahlhjd(9).nachher:=1;anzahlhjd(10).vorher:=2;
+anzahlhjd(10).nachher:=1;anzahlhjd(11).vorher:=1;anzahlhjd(11).nachher:=1;
+anzahlhjd(12).vorher:=2;anzahlhjd(12).nachher:=6;anzahlhjd(13).vorher:=1;
+anzahlhjd(13).nachher:=5;anzahlhjd(14).vorher:=2;anzahlhjd(14).nachher:=4;
+anzahlhjd(15).vorher:=2;anzahlhjd(15).nachher:=3;anzahlhjd(16).vorher:=3;
+anzahlhjd(16).nachher:=2;anzahlhjd(17).vorher:=4;anzahlhjd(17).nachher:=1;
+anzahlhjd(18).vorher:=5;anzahlhjd(18).nachher:=0.END PROC 
+initialisierehalbjahresdatentabelle;PROC lieferehjdgrenzen(INT VAR anfang,
+ende,TEXT CONST hjdkennung):ihalbjahr:=(poshjdkennungDIV 
+laengehalbjahreseintrag)+1;anfang:=-anzahlhjd(ihalbjahr).vorher;ende:=
+anzahlhjd(ihalbjahr).nachher.poshjdkennung:pos(zeilehalbjahre,hjdkennung).
+END PROC lieferehjdgrenzen;TEXT PROC schulisdbname:"EUMELbase.schulis"END 
+PROC schulisdbname;TEXT PROC baisydbname:"EUMELbase.baisy"END PROC 
+baisydbname;TEXT PROC wert(INT CONST fnr,posi,laenge):TEXT VAR teiltext:=
+subtext(wert(fnr),posi,posi+laenge-1);INT VAR anfang:=pos(teiltext," ");IF 
+teiltext=laenge*" "THEN teiltext:=""ELSE WHILE anfang>0REP IF subtext(
+teiltext,anfang,laenge)=(laenge-anfang+1)*" "THEN teiltext:=text(teiltext,
+anfang-1);anfang:=0ELSE anfang:=pos(teiltext," ",anfang+1)FI PER FI ;teiltext
+END PROC wert;PROC putwert(INT CONST fnr,TEXT CONST t,INT CONST posi,laenge):
+INT VAR i:=length(wert(fnr));TEXT VAR string:=wert(fnr);IF i<posiTHEN IF t<>
+niltextTHEN stringCAT ((posi-i-1)*" ");stringCAT (text(t,laenge))FI ELSE 
+replace(string,posi,text(t,laenge))FI ;putwert(fnr,string)END PROC putwert;
+PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP feld(i):=""
+PER .END PROC init;TEXT PROC datumskonversion(TEXT CONST datum):TEXT VAR d:=
+datum;IF nurblanksoderleer(datum)OR d="  .  .  "THEN "01.01.00"ELSE changeall
+(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3);insertchar(d,".",
+6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC datumskonversion;BOOL 
+PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR iFROM 1UPTO length(t)REP 
+IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH FALSE FI PER ;TRUE ENDPROC 
+nurblanksoderleer;TEXT PROC datumrekonversion(TEXT CONST datum):TEXT VAR d:=
+datum;changeall(d,".","");IF d="010100"THEN d:=""FI ;dENDPROC 
+datumrekonversion;PROC melde(TEXT CONST txt):melde(txt,24)END PROC melde;
+PROC melde(TEXT CONST txt,INT CONST zeile):LET maxlaenge=72,spalte=4;INT VAR 
+txtlaenge,pos;TEXT VAR ausgabetxt:="";txtlaenge:=min(length(txt),maxlaenge);
+pos:=(maxlaenge-txtlaenge)DIV 2;ausgabetxtCAT (pos*" ");ausgabetxtCAT txt;
+cursor(spalte,zeile);out(text(ausgabetxt,maxlaenge))END PROC melde;TEXT PROC 
+jgstaufber(TEXT CONST jgst):LET erstestellejgst="0",maxsek1=10;INT VAR ijgst
+:=int(jgst);IF ijgst>=maxsek1THEN jgstELIF ijgst=0THEN ""ELSE erstestellejgst
++text(ijgst)FI END PROC jgstaufber;PROC halbjahresdatenloeschen(ROW 
+anzkenndatTEXT CONST kenndatum,TEXT CONST altejgst,neuejgst,neueshalbjahr):
+BOOL CONST jgsthochgesetzt:=neuejgst>altejgst;INT VAR loeschevorher,
+loeschenachher,jgstpos,maxhjdvorherneu,maxhjdnachherneu;TEXT VAR 
+jgstcathalbjahr:=neuejgst+punkt+neueshalbjahr,grenzehalbjahr:="";IF neuejgst
+<>altejgstTHEN loeschenderhalbjahresdatenvorbereiten;
+loeschenderhalbjahresdatenFI .loeschenderhalbjahresdatenvorbereiten:
+lieferehjdgrenzen(maxhjdvorherneu,maxhjdnachherneu,jgstcathalbjahr);jgstpos:=
+pos(zeilehalbjahre,jgstcathalbjahr);IF jgsthochgesetztTHEN loeschevorher:=((
+abs(maxhjdvorherneu))*4);grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos-
+loeschevorher,jgstpos-loeschevorher+3);ELSE loeschenachher:=(maxhjdnachherneu
+*4);grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos+loeschenachher,jgstpos+
+loeschenachher+3);FI ;jgstgrenze:=int(subtext(grenzehalbjahr,1,2));
+halbjahrgrenze:=subtext(grenzehalbjahr,4);.loeschenderhalbjahresdaten:IF 
+jgsthochgesetztTHEN halbjahresdatenloeschen(PROC (INT CONST )pred,kenndatum,
+halbjahrgrenze,jgstgrenze,jgsthochgesetzt);ELSE halbjahresdatenloeschen(PROC 
+(INT CONST )succ,kenndatum,halbjahrgrenze,jgstgrenze,jgsthochgesetzt);FI .
+END PROC halbjahresdatenloeschen;PROC halbjahresdatenloeschen(PROC (INT 
+CONST )step,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST hjgrenze,INT CONST 
+jgstgrenze,BOOL CONST vorher):hjddatenloeschen(PROC step,kenndatum,
+dnrhalbjahresdaten,ixhjdfamrufgebjgsthj,hjgrenze,jgstgrenze,vorher);.END 
+PROC halbjahresdatenloeschen;PROC hjddatenloeschen(PROC (INT CONST )step,ROW 
+anzkenndatTEXT CONST kenndatum,INT CONST dateinummer,index,TEXT CONST 
+hjgrenze,INT CONST jgstgrenze,BOOL CONST vorher):TEXT VAR hj,jg;
+parsenooffields(8);schluesselfuerhjdsetzen(dateinummer,kenndatum,hjgrenze,
+jgstgrenze);hj:=wert(dateinummer+5);#vorläufig#jg:=wert(dateinummer+6);#
+vorläufig#search(index,FALSE );IF dbstatus=0CAND richtigersatz#CAND 
+eigentlichunnötig#THEN #beisucheTRUE #hj:=wert(dateinummer+5);jg:=wert(
+dateinummer+6);step(index);IF NOT vorherCAND dbstatus=okCAND wiederholerTHEN 
+step(index);FI ;loeschschleife;ELIF dbstatus=okCAND gleicherschuelerTHEN IF 
+vorherTHEN step(index);FI ;loeschschleifeFI ;#vorläufig#reinitparsing.
+wiederholer:gleicherschuelerCAND hj=wert(dateinummer+5)CAND jg=wert(
+dateinummer+6).gleicherschueler:kenndatum(1)=wert(dateinummer+1)CAND 
+kenndatum(2)=wert(dateinummer+2)CAND kenndatum(3)=datumrekonversion(wert(
+dateinummer+3)).richtigersatz:#hoffentlichüberflüssig#gleicherschuelerCAND 
+wert(dateinummer+5)=hjCAND wert(dateinummer+6)=jg.loeschschleife:WHILE 
+dbstatus=okCAND gleicherschuelerREP delete(dateinummer);step(index);PER .END 
+PROC hjddatenloeschen;PROC schluesselfuerhjdsetzen(INT CONST dateinummer,ROW 
+anzkenndatTEXT CONST kenndatum,TEXT CONST halbjahrgrenze,INT CONST jgstgrenze
+):TEXT VAR jgsttext:=text(jgstgrenze);inittupel(dateinummer);putwert(
+dateinummer+1,kenndatum(1));putwert(dateinummer+2,kenndatum(2));putwert(
+dateinummer+3,datumskonversion(kenndatum(3)));putwert(dateinummer+5,
+halbjahrgrenze);putwert(dateinummer+6,jgstaufber(jgsttext)).END PROC 
+schluesselfuerhjdsetzen;PROC schluesselfuerhjdsetzen(INT CONST dateinummer,
+ROW anzkenndatTEXT CONST kenndatum,TEXT CONST sj,hj,jgst):inittupel(
+dateinummer);putwert(dateinummer+1,kenndatum(1));putwert(dateinummer+2,
+kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum(3)));putwert(
+dateinummer+4,sj);putwert(dateinummer+5,hj);putwert(dateinummer+6,jgstaufber(
+jgst)).END PROC schluesselfuerhjdsetzen;PROC 
+neueklasseinhalbjahresdateneintragen(ROW anzkenndatTEXT CONST kenndatum,TEXT 
+CONST sj,hj,jgst,neueklasse):halbjahresdatensuchen;IF datenvorhandenTHEN IF 
+schuelergruppegeaendertTHEN halbjahresdatenaendernFI ;FI .
+halbjahresdatensuchen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum,sj
+,hj,niltext);search(dnrhalbjahresdaten,TRUE );.datenvorhanden:dbstatus=null.
+schuelergruppegeaendert:wert(fnrhjdjgst)<>jgstOR wert(fnrhjdkennung)<>
+neueklasse.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);putwert(
+fnrhjdkennung,neueklasse);update(dnrhalbjahresdaten);.END PROC 
+neueklasseinhalbjahresdateneintragen;TEXT PROC schulkenndatum(TEXT CONST 
+schluessel):LET schulkenndaten="c02 schulkenndaten";TEXT VAR schuldaten:="";
+systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,schulkenndaten
+);putwert(fnrschlschluessel,schluessel);search(dnrschluessel,TRUE );IF 
+dbstatus=okTHEN schuldaten:=wert(fnrschllangtext)ELSE schuldaten:=""FI ;
+schuldatenENDPROC schulkenndatum;END PACKET ispgrundfunktionenlocal
+
diff --git a/app/schulis/2.2.1/src/0.hjd grundfunktionen b/app/schulis/2.2.1/src/0.hjd grundfunktionen
new file mode 100644
index 0000000..f553908
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.hjd grundfunktionen
@@ -0,0 +1,110 @@
+PACKET isphjdgrundfunktionenDEFINES lieferehalbjahreszeile,lieferehjdgrenzen,
+put,putwert,wert,init,halbjahresdatenloeschen,schluesselfuerhjdsetzen,
+neueklasseinhalbjahresdateneintragen,:LET maxanzfelder=100;LET punkt=".",
+anzkenndat=3;LET null=0,niltext="",blank=" ";INT VAR jgstgrenze;TEXT VAR 
+halbjahrgrenze;LET maxhalbjahre=18,anzahlhalbjahrevoraktuell=5,
+gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;TEXT CONST zeilehalbjahre
+:="05.105.206.106.207.107.208.108.209.109.2"+
+"10.110.211.111.212.112.213.113.2";INT CONST gesamtzeilenlaenge:=
+gesamtanzahlhalbjahre*laengehalbjahreseintrag;INT VAR ihalbjahr;ROW 
+maxhalbjahreSTRUCT (INT vorher,nachher)VAR anzahlhjd;
+initialisierehalbjahresdatentabelle;PROC lieferehalbjahreszeile(TEXT VAR 
+zeile,TEXT CONST hjdkennung):INT VAR subtextbeginn:=pos(zeilehalbjahre,
+hjdkennung);INT VAR subtextende;ihalbjahr:=(subtextbeginnDIV 
+laengehalbjahreseintrag)+1;TEXT VAR blanksvorher:=((anzahlhalbjahrevoraktuell
+-anzahlhjd(ihalbjahr).vorher)*laengehalbjahreseintrag)*blank;subtextbeginn:=(
+ihalbjahr-anzahlhjd(ihalbjahr).vorher-1)*laengehalbjahreseintrag+1;
+subtextende:=(ihalbjahr+anzahlhjd(ihalbjahr).nachher)*laengehalbjahreseintrag
+;TEXT VAR interessanterteilderzeilehalbjahre:=subtext(zeilehalbjahre,
+subtextbeginn,subtextende);zeile:=text(blanksvorher+
+interessanterteilderzeilehalbjahre,gesamtzeilenlaenge).END PROC 
+lieferehalbjahreszeile;PROC initialisierehalbjahresdatentabelle:anzahlhjd(1).
+vorher:=0;anzahlhjd(1).nachher:=1;anzahlhjd(2).vorher:=1;anzahlhjd(2).nachher
+:=1;anzahlhjd(3).vorher:=1;anzahlhjd(3).nachher:=1;anzahlhjd(4).vorher:=2;
+anzahlhjd(4).nachher:=1;anzahlhjd(5).vorher:=1;anzahlhjd(5).nachher:=1;
+anzahlhjd(6).vorher:=2;anzahlhjd(6).nachher:=1;anzahlhjd(7).vorher:=1;
+anzahlhjd(7).nachher:=1;anzahlhjd(8).vorher:=2;anzahlhjd(8).nachher:=1;
+anzahlhjd(9).vorher:=1;anzahlhjd(9).nachher:=1;anzahlhjd(10).vorher:=2;
+anzahlhjd(10).nachher:=1;anzahlhjd(11).vorher:=1;anzahlhjd(11).nachher:=1;
+anzahlhjd(12).vorher:=2;anzahlhjd(12).nachher:=6;anzahlhjd(13).vorher:=1;
+anzahlhjd(13).nachher:=5;anzahlhjd(14).vorher:=2;anzahlhjd(14).nachher:=4;
+anzahlhjd(15).vorher:=2;anzahlhjd(15).nachher:=3;anzahlhjd(16).vorher:=3;
+anzahlhjd(16).nachher:=2;anzahlhjd(17).vorher:=4;anzahlhjd(17).nachher:=1;
+anzahlhjd(18).vorher:=5;anzahlhjd(18).nachher:=0.END PROC 
+initialisierehalbjahresdatentabelle;PROC lieferehjdgrenzen(INT VAR anfang,
+ende,TEXT CONST hjdkennung):ihalbjahr:=(poshjdkennungDIV 
+laengehalbjahreseintrag)+1;anfang:=-anzahlhjd(ihalbjahr).vorher;ende:=
+anzahlhjd(ihalbjahr).nachher.poshjdkennung:pos(zeilehalbjahre,hjdkennung).
+END PROC lieferehjdgrenzen;TEXT PROC wert(INT CONST fnr,posi,laenge):TEXT 
+VAR teiltext:=subtext(wert(fnr),posi,posi+laenge-1);INT VAR anfang:=pos(
+teiltext," ");IF teiltext=laenge*" "THEN teiltext:=""ELSE WHILE anfang>0REP 
+IF subtext(teiltext,anfang,laenge)=(laenge-anfang+1)*" "THEN teiltext:=text(
+teiltext,anfang-1);anfang:=0ELSE anfang:=pos(teiltext," ",anfang+1)FI PER FI 
+;teiltextEND PROC wert;PROC putwert(INT CONST fnr,TEXT CONST t,INT CONST posi
+,laenge):INT VAR i:=length(wert(fnr));TEXT VAR string:=wert(fnr);IF i<posi
+THEN IF t<>niltextTHEN stringCAT ((posi-i-1)*" ");stringCAT (text(t,laenge))
+FI ELSE replace(string,posi,text(t,laenge))FI ;putwert(fnr,string)END PROC 
+putwert;PROC put(TAG CONST t,ROW maxanzfelderTEXT VAR pfeld,INT CONST von,bis
+):INT VAR i;FOR iFROM vonUPTO bisREP IF fieldexists(t,i)THEN put(t,pfeld(i),i
+)FI ;PER ;END PROC put;PROC put(TAG CONST t,ROW maxanzfelderTEXT VAR pfeld,
+INT CONST pos):INT VAR i;FOR iFROM posUPTO maxanzfelderREP IF fieldexists(t,i
+)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC init(ROW maxanzfelderTEXT 
+VAR feld):INT VAR i;FOR iFROM 1UPTO maxanzfelderREP feld(i):=""PER .END PROC 
+init;PROC halbjahresdatenloeschen(ROW anzkenndatTEXT CONST kenndatum,TEXT 
+CONST altejgst,neuejgst,neueshalbjahr):BOOL CONST jgsthochgesetzt:=neuejgst>
+altejgst;INT VAR loeschevorher,loeschenachher,jgstpos,maxhjdvorherneu,
+maxhjdnachherneu;TEXT VAR jgstcathalbjahr:=neuejgst+punkt+neueshalbjahr,
+grenzehalbjahr:="";IF neuejgst<>altejgstTHEN 
+loeschenderhalbjahresdatenvorbereiten;loeschenderhalbjahresdatenFI .
+loeschenderhalbjahresdatenvorbereiten:lieferehjdgrenzen(maxhjdvorherneu,
+maxhjdnachherneu,jgstcathalbjahr);jgstpos:=pos(zeilehalbjahre,jgstcathalbjahr
+);IF jgsthochgesetztTHEN loeschevorher:=((abs(maxhjdvorherneu))*4);
+grenzehalbjahr:=subtext(zeilehalbjahre,jgstpos-loeschevorher,jgstpos-
+loeschevorher+3);ELSE loeschenachher:=(maxhjdnachherneu*4);grenzehalbjahr:=
+subtext(zeilehalbjahre,jgstpos+loeschenachher,jgstpos+loeschenachher+3);FI ;
+jgstgrenze:=int(subtext(grenzehalbjahr,1,2));halbjahrgrenze:=subtext(
+grenzehalbjahr,4);.loeschenderhalbjahresdaten:IF jgsthochgesetztTHEN 
+halbjahresdatenloeschen(PROC (INT CONST )pred,kenndatum,halbjahrgrenze,
+jgstgrenze,jgsthochgesetzt);ELSE halbjahresdatenloeschen(PROC (INT CONST )
+succ,kenndatum,halbjahrgrenze,jgstgrenze,jgsthochgesetzt);FI .END PROC 
+halbjahresdatenloeschen;PROC halbjahresdatenloeschen(PROC (INT CONST )step,
+ROW anzkenndatTEXT CONST kenndatum,TEXT CONST hjgrenze,INT CONST jgstgrenze,
+BOOL CONST vorher):hjddatenloeschen(PROC step,kenndatum,dnrhalbjahresdaten,
+ixhjdfamrufgebjgsthj,hjgrenze,jgstgrenze,vorher);.END PROC 
+halbjahresdatenloeschen;PROC hjddatenloeschen(PROC (INT CONST )step,ROW 
+anzkenndatTEXT CONST kenndatum,INT CONST dateinummer,index,TEXT CONST 
+hjgrenze,INT CONST jgstgrenze,BOOL CONST vorher):TEXT VAR hj,jg;
+schluesselfuerhjdsetzen(dateinummer,kenndatum,hjgrenze,jgstgrenze);hj:=wert(
+dateinummer+5);#vorläufig#jg:=wert(dateinummer+6);#vorläufig#search(index,
+FALSE );IF dbstatus=0CAND richtigersatz#CAND eigentlichunnötig#THEN #beisuche
+TRUE #hj:=wert(dateinummer+5);jg:=wert(dateinummer+6);step(index);IF NOT 
+vorherCAND dbstatus=okCAND wiederholerTHEN step(index);FI ;loeschschleife;
+ELIF dbstatus=okCAND gleicherschuelerTHEN IF vorherTHEN step(index);FI ;
+loeschschleifeFI #vorläufig#.wiederholer:gleicherschuelerCAND hj=wert(
+dateinummer+5)CAND jg=wert(dateinummer+6).gleicherschueler:kenndatum(1)=wert(
+dateinummer+1)CAND kenndatum(2)=wert(dateinummer+2)CAND kenndatum(3)=
+datumrekonversion(wert(dateinummer+3)).richtigersatz:#hoffentlichüberflüssig#
+gleicherschuelerCAND wert(dateinummer+5)=hjCAND wert(dateinummer+6)=jg.
+loeschschleife:WHILE dbstatus=okCAND gleicherschuelerREP delete(dateinummer);
+step(index);PER .END PROC hjddatenloeschen;PROC schluesselfuerhjdsetzen(INT 
+CONST dateinummer,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST 
+halbjahrgrenze,INT CONST jgstgrenze):TEXT VAR jgsttext:=text(jgstgrenze);
+inittupel(dateinummer);putwert(dateinummer+1,kenndatum(1));putwert(
+dateinummer+2,kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum(
+3)));putwert(dateinummer+5,halbjahrgrenze);putwert(dateinummer+6,jgstaufber(
+jgsttext)).END PROC schluesselfuerhjdsetzen;PROC schluesselfuerhjdsetzen(INT 
+CONST dateinummer,ROW anzkenndatTEXT CONST kenndatum,TEXT CONST sj,hj,jgst):
+inittupel(dateinummer);putwert(dateinummer+1,kenndatum(1));putwert(
+dateinummer+2,kenndatum(2));putwert(dateinummer+3,datumskonversion(kenndatum(
+3)));putwert(dateinummer+4,sj);putwert(dateinummer+5,hj);putwert(dateinummer+
+6,jgstaufber(jgst)).END PROC schluesselfuerhjdsetzen;PROC 
+neueklasseinhalbjahresdateneintragen(ROW anzkenndatTEXT CONST kenndatum,TEXT 
+CONST sj,hj,jgst,neueklasse):halbjahresdatensuchen;IF datenvorhandenTHEN IF 
+schuelergruppegeaendertTHEN halbjahresdatenaendernFI ;FI .
+halbjahresdatensuchen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum,sj
+,hj,niltext);search(dnrhalbjahresdaten,TRUE );.datenvorhanden:dbstatus=null.
+schuelergruppegeaendert:wert(fnrhjdjgst)<>jgstOR wert(fnrhjdkennung)<>
+neueklasse.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);putwert(
+fnrhjdkennung,neueklasse);selupdate(dnrhalbjahresdaten);.END PROC 
+neueklasseinhalbjahresdateneintragen;END PACKET isphjdgrundfunktionen;
+
diff --git a/app/schulis/2.2.1/src/0.hoeherstufen local.prog b/app/schulis/2.2.1/src/0.hoeherstufen local.prog
new file mode 100644
index 0000000..73f5b20
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.hoeherstufen local.prog
@@ -0,0 +1,312 @@
+PACKET hoeherstufenlocalprogDEFINES schuljahreswechsel,halbjahreswechsel:LET 
+dnrschueler=2,fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6
+,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsutidakthjd=9,fnrsuartzugang=10,
+fnrsuneuerzugtut=11,fnrsujgsteintr=13,#fnrsuskennlschule=14,dr13.05.88#
+fnrsuabgdats=16,fnrsuabschluss=18,fnrsueintrittinsek=44,dnrhalbjahresdaten=88
+,fnrhjdfamnames=89,fnrhjdrufnames=90,fnrhjdgebdats=91,fnrhjdsj=92,fnrhjdhj=93
+,fnrhjdjgst=94,fnrhjdkennung=95,fnrhjdversetzung=96,#dnrschulen=120,dr13.
+05.88##fnrschkennung=121,dr13.05.88#dnraktschuelergruppen=129,fnrsgrpsj=130,
+fnrsgrphj=131,fnrsgrpjgst=132,fnrsgrpkennung=133,ixsustatfamrufgeb=243,
+ixsustatjgstzug=244,ixsustatjgst=250;LET hellan="",hellaus=" ",meldz=23;
+LET neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso";LET jgst13="13",
+jgst11="11";LET posvers=1,posnachpr=2,posspringer=3,posfreiwillig=4,
+posnichtvers=5,poshoeherstufen=2,kennzeichenneuan="z",kennzeichenabitur="K",
+gueltigekennzeichen="vnsfw",dreizehnnachpr="N";LET null=0,niltext="",
+trennername=", ",sgtrenner="/",blank=" ",maxjahr=100,minjahr="00",klammerauf=
+" (",klammerzu=")",leerdatum="01.01.00";LET halbjahr1="1",halbjahr2="2",
+zumschuljahresende=1,zumhalbjahresende=0;LET schluesselschuljahr="Schuljahr",
+schluesselhalbjahr="Schulhalbjahr",schluesselendeschulhalbjahr=
+"Ende Schulhalbjahr";LET bestandabgegangene="abg",aktbestand="ls";LET 
+anzkenndaten=3;LET protname="Fehlerprotokoll";LET schulname="Schulname",
+schulort="Schulort",zeilenlaenge=77,datumslaenge=8,ordnungstrenner=". ",
+absatztrenner="    - ",protueberschrift=
+"Fehlerprotokoll zum automatischen Hochsetzen";LET weiterefehler=
+"Abbruch des Programmes, da zu viele Fehler",maxfehler=50;LET 
+fehlerkeinverserg=1,fehlerkeinneuertutor=2,fehlerungueltigesverserg=3,
+fehlerungueltigesg=4,fehlerungueltigehjd=5,fehlerstatus=6,fehlerplanung=7;
+LET maxfehlerart=7;LET fehleraendern="Ändern: ",fehlerloeschen="Löschen: ";
+LET rcodeprot=1001,rcodenoprot=1002;BOOL VAR updatenoetig:=FALSE ;DATASPACE 
+VAR ds:=nilspace;FILE VAR fehlerprot;INT VAR fehlerzahl,kanal;TEXT VAR 
+stichtag:="";TEXT VAR letztername,letzterrufname,letztesgebdatum,
+letzterstatus;ROW anzkenndatenTEXT VAR key;ROW maxfehlerartTEXT CONST 
+fehlertext:=ROW maxfehlerartTEXT :("Es liegt kein Versetzungsergebnis vor",
+"Es wurde kein neuer Zug/Tutor eingetragen",
+"Das eingetragene Versetzungsergebnis ist nicht zulässig",
+"Die eingetragene Schülergruppe ist nicht vorgesehen",
+"Zu diesem Schüler liegen keine oder unvollständige Halbjahresdaten vor",
+"Fehler beim Datenbankzugriff","Keine Schülergruppen im Planungsbestand");
+TEXT VAR geplschuelergruppen,aufbermeld,aufberprot,aktschuljahr,akthalbjahr,
+kommendesschuljahr;PROC schuljahreswechsel:abschnittsendebearbeitung(
+zumschuljahresende)END PROC schuljahreswechsel;PROC halbjahreswechsel:
+abschnittsendebearbeitung(zumhalbjahresende)END PROC halbjahreswechsel;PROC 
+abschnittsendebearbeitung(INT CONST zeitpunkt):forget(ds);kanal:=int(
+getrcvparam(1));continue(kanal);reinitparsing;stichtag:=schulkenndatum(
+schluesselendeschulhalbjahr);aktschuljahr:=schulkenndatum(schluesselschuljahr
+);akthalbjahr:=schulkenndatum(schluesselhalbjahr);kommendesschuljahr:=subtext
+(aktschuljahr,3,4);kommendesschuljahrCAT (jahrestext(int(kommendesschuljahr)+
+1));fehlerbehandlungvorbereiten;verarbeitung;fehlerauswertung;break(quiet).
+fehlerbehandlungvorbereiten:disablestop;forget(protname,quiet);fehlerzahl:=
+null.verarbeitung:IF zeitpunkt=zumschuljahresendeTHEN hochsetzenderschueler
+ELSE halbjahreswechselderschuelerFI .fehlerauswertung:IF fehleraufgetreten
+THEN schickefehlerprotokollananwenderELSE putsndcode(rcodenoprot);ds:=
+nilspace;putsndds(ds);forget(ds)FI ;forget(protname,quiet).fehleraufgetreten:
+fehlerzahl>null.schickefehlerprotokollananwender:clearerror;enablestop;
+putsndcode(rcodeprot);ds:=old(protname);putsndds(ds);forget(ds).END PROC 
+abschnittsendebearbeitung;PROC halbjahreswechselderschueler:enablestop;
+schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN 
+aktuellanderschulebefindlicheschuelerdurchgehen(zumhalbjahresende)FI .END 
+PROC halbjahreswechselderschueler;PROC hochsetzenderschueler:enablestop;
+schuelergruppenausplanunguebernehmen;IF fehlerzahl=nullTHEN 
+aktuellanderschulebefindlicheschuelerdurchgehen(zumschuljahresende);
+neuanmeldungenuebernehmenFI .neuanmeldungenuebernehmen:
+neuanmeldungenzur5uebernehmen;neuanmeldungenzur11uebernehmen;
+sonstigeneuanmeldungenuebernehmen.END PROC hochsetzenderschueler;PROC 
+schuelergruppenausplanunguebernehmen:TEXT VAR folgesj,folgehj;
+geplschuelergruppen:=niltext;neuewertefuerschuljahrhalbjahrbestimmen;
+inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,folgesj);putwert(fnrsgrphj
+,folgehj);search(dnraktschuelergruppen,FALSE );WHILE dbstatus=okCAND 
+richtigesschulhalbjahrREP leseeinesg;succ(dnraktschuelergruppen)PER ;IF 
+geplschuelergruppen=niltextTHEN fehler(niltext,fehlerplanung)ELSE 
+alteschuelergruppenloeschen;#statistikwuerfelvorbereitendr11.05.88#FI .
+neuewertefuerschuljahrhalbjahrbestimmen:IF akthalbjahr=halbjahr1THEN folgesj
+:=aktschuljahr;folgehj:=halbjahr2ELSE folgesj:=kommendesschuljahr;folgehj:=
+halbjahr1FI .richtigesschulhalbjahr:wert(fnrsgrpsj)=folgesjCAND wert(
+fnrsgrphj)=folgehj.#dr11.05.88statistikwuerfelvorbereiten:melde(hellan+
+"Die speziellen Statistiken werden initialisiert"+hellaus,meldz);initstatraum
+(TRUE );bestaendeinstatraumeintragen(folgesj,folgehj);
+kuerzelnameninstatraumeintragen.#END PROC 
+schuelergruppenausplanunguebernehmen;PROC alteschuelergruppenloeschen:TEXT 
+VAR sg:="";inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,aktschuljahr);
+putwert(fnrsgrphj,akthalbjahr);search(dnraktschuelergruppen,FALSE );WHILE 
+altesschuljahrhalbjahrREP sg:=wert(fnrsgrpjgst)+wert(fnrsgrpkennung);delete(
+dnraktschuelergruppen);IF dbstatus<>nullTHEN fehler(sg,fehlerstatus,
+fehlerloeschen+text(dbstatus))ELSE melde("Die aktuelle Schülergruppe "+hellan
++sg+hellaus+"wird gelöscht",meldz)FI ;search(dnraktschuelergruppen,FALSE )
+PER .altesschuljahrhalbjahr:dbstatus=nullCAND wert(fnrsgrpsj)=aktschuljahr
+CAND wert(fnrsgrphj)=akthalbjahr.END PROC alteschuelergruppenloeschen;PROC 
+leseeinesg:TEXT CONST jgstkurz:=wert(fnrsgrpjgst),jgstlang:=jgstaufber(
+jgstkurz),zug:=compress(wert(fnrsgrpkennung));melde(
+"Die aktuelle Schülergruppe "+hellan+jgstlang+zug+hellaus+"wird eingerichtet"
+,meldz);geplschuelergruppenCAT jgstlang;geplschuelergruppenCAT zug;
+geplschuelergruppenCAT sgtrennerEND PROC leseeinesg;PROC 
+aktuellanderschulebefindlicheschuelerdurchgehen(INT CONST zeitpunkt):TEXT 
+VAR schuelertid:="";bereitevor;erstenlesen;WHILE nochwelchedaREP schuelertid
+:=gettid;saveupdateposition(dnrschueler);verarbeiten;aenderungspeichern;
+updatenoetig:=TRUE ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler);
+putwert(fnrsustatuss,aktbestand);updatenoetig:=TRUE .erstenlesen:search(
+ixsustatfamrufgeb,FALSE );merkealleschluesselwerte.naechstenlesen:IF wert(
+fnrsustatuss)=bestandabgegangeneTHEN putwert(fnrsustatuss,aktbestand);search(
+ixsustatfamrufgeb,FALSE )ELSE succ(ixsustatfamrufgeb)FI ;IF 
+selbensatznochmalgelesenTHEN succ(ixsustatfamrufgeb)FI ;
+merkealleschluesselwerte.merkealleschluesselwerte:letztername:=wert(
+fnrsufamnames);letzterrufname:=wert(fnrsurufnames);letztesgebdatum:=wert(
+fnrsugebdatums);letzterstatus:=wert(fnrsustatuss).selbensatznochmalgelesen:
+letztername=wert(fnrsufamnames)CAND letzterrufname=wert(fnrsurufnames)CAND 
+letztesgebdatum=wert(fnrsugebdatums)CAND letzterstatus=wert(fnrsustatuss).
+nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=aktbestand.verarbeiten:
+setzekenndaten;setzejgstundsg;meldebearbeitung;IF abgemeldetTHEN 
+anderschulebefindlicheabmeldenELIF zeitpunkt=zumschuljahresendeTHEN 
+anderschulebefindlichebehandeln(aktjgst,aktsg)ELSE 
+schuelerzumhalbjahreswechselbehandeln(aktjgst,aktsg)FI .setzejgstundsg:TEXT 
+VAR aktjgst:=jgstaufber(wert(fnrsusgrpjgst)),aktsg:=compress(wert(
+fnrsusgrpzugtut)).meldebearbeitung:melde("Die Daten von "+hellan+aufbermeld+
+hellaus+", "+hellan+aktjgst+aktsg+hellaus+"werden bearbeitet",meldz).
+abgemeldet:INT VAR aktabmeldedatum:=datum(wert(fnrsuabgdats));(
+aktabmeldedatum<>datum(leerdatum))CAND (datum(stichtag)>=aktabmeldedatum).
+anderschulebefindlicheabmelden:putwert(fnrsustatuss,bestandabgegangene);
+updatenoetig:=TRUE ;hjdnaechstesschulhalbjahrbearbeiten(aktjgst,aktsg).
+aenderungspeichern:IF dbstatus=okTHEN IF updatenoetigTHEN 
+restoreupdateposition(dnrschueler);selupdate(dnrschueler);ELSE replace(
+dnrschueler,schuelertid);putptid(schuelertid);insertinindex(ixsustatjgstzug);
+IF zeitpunkt=zumschuljahresendeTHEN insertinindex(ixsustatjgst)FI FI ;IF 
+dbstatus<>nullTHEN fehler(aufberprot,fehlerstatus,fehleraendern+text(dbstatus
+))FI FI .END PROC aktuellanderschulebefindlicheschuelerdurchgehen;PROC 
+schuelerzumhalbjahreswechselbehandeln(TEXT CONST aktjgst,aktsg):TEXT VAR 
+neueklasse,neuesg;tutorloeschen;neueklassepruefen;dbstatus(ok).tutorloeschen:
+#removeoutoffindex(ixsustatjgstzug);##dr18.08.88#neuesg:=compress(wert(
+fnrsuneuerzugtut));IF neuesg<>niltextTHEN putwert(fnrsusgrpzugtut,niltext)FI 
+.neueklassepruefen:IF neuesg=niltextTHEN neueklasse:=aktjgst+aktsg;neuesg:=
+aktsgELSE neueklasse:=aktjgst+neuesg;putwert(fnrsuneuerzugtut,niltext);
+putwert(fnrsusgrpzugtut,neuesg);FI ;IF NOT gueltigesg(neueklasse)THEN fehler(
+aufberprot,fehlerungueltigesg,neueklasse);dbstatus(9);LEAVE 
+schuelerzumhalbjahreswechselbehandelnELSE hjdnaechstesschulhalbjahrbearbeiten
+(aktjgst,neuesg)FI .END PROC schuelerzumhalbjahreswechselbehandeln;PROC 
+anderschulebefindlichebehandeln(TEXT CONST aktjgst,aktsg):holehjd;
+analysierehalbjahresdaten;aendere.holehjd:IF wert(fnrsutidakthjd)<>niltext
+THEN readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));IF iserrorTHEN 
+clearerror;dbstatus(notfound)FI ELSE dbstatus(notfound)FI ;IF 
+keinehalbjahresdatenvorhandenTHEN fehler(aufberprot,fehlerungueltigehjd);
+LEAVE anderschulebefindlichebehandelnFI .keinehalbjahresdatenvorhanden:
+dbstatus<>okCOR aktschuljahr<>wert(fnrhjdsj)COR akthalbjahr<>wert(fnrhjdhj)
+COR key[1]<>wert(fnrhjdfamnames)COR key[2]<>wert(fnrhjdrufnames)COR key[3]<>
+datumrekonversion(wert(fnrhjdgebdats))COR aktjgst<>jgstaufber(wert(fnrhjdjgst
+))COR aktsg<>compress(wert(fnrhjdkennung)).analysierehalbjahresdaten:TEXT 
+VAR versetzung:=wert(fnrhjdversetzung);pruefeversetzungskennzeichen.
+pruefeversetzungskennzeichen:BOOL VAR datenkorrekt:=FALSE ;TEXT CONST 
+neuerzugtutor:=wert(fnrsuneuerzugtut);IF versetzung=niltextTHEN fehler(
+aufberprot,fehlerkeinverserg)ELIF pos(gueltigekennzeichen,versetzung)<=null
+THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);ELIF 
+nichtnormalhoeherstufenCAND keinzugtutorTHEN fehler(aufberprot,
+fehlerkeinneuertutor);ELSE datenkorrekt:=TRUE FI ;IF NOT datenkorrektTHEN 
+LEAVE anderschulebefindlichebehandelnFI .nichtnormalhoeherstufen:pos(
+gueltigekennzeichen,versetzung)>poshoeherstufen.keinzugtutor:neuerzugtutor=
+niltext.aendere:TEXT VAR neuesg:=wert(fnrsusgrpzugtut);#removeoutoffindex(
+ixsustatjgst);removeoutoffindex(ixsustatjgstzug);##dr18.08.88#IF 
+neuerzugtutor<>niltextTHEN neuesg:=neuerzugtutorFI ;aendereschueler(aktjgst,
+aktsg,neuesg,versetzung).END PROC anderschulebefindlichebehandeln;PROC 
+aendereschueler(TEXT CONST aktjgst,aktsg,neuesg,versetzung):bereitevor;
+setzedaten;hjddatenloeschen;hjdnaechstesschulhalbjahrbearbeiten(neuejgst,
+neuesg).bereitevor:TEXT VAR neuejgst:=aktjgst;TEXT VAR loeschjgst:=aktjgst;.
+setzedaten:trageversetzungundtutorein;INT CONST kennzeichenpos:=pos(
+gueltigekennzeichen,versetzung);SELECT kennzeichenposOF CASE posspringer:
+springenCASE posvers:normalversetzenCASE posnachpr:zurnachpruefungversetzen
+CASE posnichtvers,posfreiwillig:sitzenbleibenEND SELECT ;TEXT VAR neueklasse
+:=neuejgst+neuesg;IF falscherzugtutorTHEN fehler(aufberprot,
+fehlerungueltigesg,neueklasse);LEAVE aendereschuelerFI .falscherzugtutor:NOT 
+gueltigesg(neueklasse).trageversetzungundtutorein:putwert(fnrsuartzugang,
+versetzung);putwert(fnrsuneuerzugtut,niltext).springen:IF int(aktjgst)>11
+THEN fehler(aufberprot,fehlerungueltigesverserg,versetzung);LEAVE 
+aendereschuelerFI ;BOOL VAR sitzenbleiber:=FALSE ;neuejgst:=jgstaufber(text(
+int(aktjgst)+2));loeschjgst:=jgstaufber(text(int(aktjgst)+1));
+nachfolgendehjdsloeschen;sgeintragen;eintrittsek2evtleintragen.
+normalversetzen:IF inder13THEN dreizehnerabmelden;
+hjdnaechstesschulhalbjahrbearbeiten(neuejgst,aktsg);LEAVE aendereschueler
+ELSE normalhochsetzenFI .zurnachpruefungversetzen:IF inder13THEN 
+nachpruefling13ELSE normalhochsetzenFI .normalhochsetzen:sitzenbleiber:=
+FALSE ;neuejgst:=jgstaufber(text(int(aktjgst)+1));loeschjgst:=neuejgst;
+sgeintragen;eintrittsek2evtleintragen.sgeintragen:putwert(fnrsusgrpjgst,
+neuejgst);putwert(fnrsusgrpzugtut,neuesg);.eintrittsek2evtleintragen:IF 
+neuejgst=jgst11THEN putwert(fnrsueintrittinsek,kommendesschuljahr);FI .
+nachpruefling13:sitzenbleiber:=TRUE ;putwert(fnrsuartzugang,dreizehnnachpr);
+sgeintragen.sitzenbleiben:sitzenbleiber:=TRUE ;sgeintragen;
+nachfolgendehjdsloeschen.nachfolgendehjdsloeschen:halbjahresdatenloeschen(
+PROC (INT CONST )succ,key,halbjahr2,int(aktjgst),FALSE );.inder13:aktjgst=
+jgst13.hjddatenloeschen:halbjahresdatenloeschen(key,aktjgst,loeschjgst,
+halbjahr1).END PROC aendereschueler;PROC dreizehnerabmelden:putwert(
+fnrsuabgdats,stichtag);putwert(fnrsuabschluss,kennzeichenabitur);putwert(
+fnrsustatuss,bestandabgegangene);updatenoetig:=TRUE ;END PROC 
+dreizehnerabmelden;PROC neuanmeldungenzur5uebernehmen:uebernehmenaus(
+neuanmeld5,1)END PROC neuanmeldungenzur5uebernehmen;PROC 
+neuanmeldungenzur11uebernehmen:uebernehmenaus(neuanmeld11,1)END PROC 
+neuanmeldungenzur11uebernehmen;PROC sonstigeneuanmeldungenuebernehmen:
+uebernehmenaus(neuanmeldsonst,2)END PROC sonstigeneuanmeldungenuebernehmen;
+PROC uebernehmenaus(TEXT CONST bestand,INT CONST meld):BOOL VAR 
+allesinordnung:=FALSE ;TEXT VAR neuejgst,neuerzug;bereitevor;erstenlesen;
+WHILE nochwelchedaREP saveupdateposition(dnrschueler);pruefen;IF 
+allesinordnungTHEN uebernehmen;putwert(fnrsustatuss,bestand);meldeuebernahme;
+FI ;naechstenlesen;PER .bereitevor:inittupel(dnrschueler);putwert(
+fnrsustatuss,bestand).erstenlesen:search(ixsustatfamrufgeb,FALSE ).
+nochwelcheda:dbstatus=nullCAND wert(fnrsustatuss)=bestand.pruefen:
+setzekenndaten;pruefetutorsg(allesinordnung);.uebernehmen:neuejgst:=wert(
+fnrsujgsteintr);neuerzug:=wert(fnrsuneuerzugtut);dbwertesetzen;
+hjdnaechstesschulhalbjahrbearbeiten(neuejgst,neuerzug);restoreupdateposition(
+dnrschueler);selupdate(dnrschueler);IF dbstatus<>nullTHEN fehler(aufberprot,
+fehlerstatus,fehleraendern+text(dbstatus))FI .dbwertesetzen:putwert(
+fnrsusgrpjgst,jgstaufber(neuejgst));putwert(fnrsusgrpzugtut,neuerzug);putwert
+(fnrsuartzugang,kennzeichenneuan);putwert(fnrsuneuerzugtut,niltext).
+meldeuebernahme:IF meld=1THEN melde("Bearbeitung der Neuangemeldeten zur "+
+jgstaufber(neuejgst)+": "+hellan+aufbermeld+hellaus,meldz)ELSE melde(
+"Bearbeitung sonstiger Neuanmeldungen: "+hellan+aufbermeld+hellaus,meldz)FI .
+naechstenlesen:search(ixsustatfamrufgeb,FALSE )#dr18.08.88##succ(
+ixsustatfamrufgeb)##eigentlichrichtig#.END PROC uebernehmenaus;PROC fehler(
+TEXT CONST name,INT CONST fehlernr):fehler(name,fehlernr,niltext)END PROC 
+fehler;PROC fehler(TEXT CONST name,INT CONST fehlernr,TEXT CONST ergaenzung):
+IF ersterfehlerTHEN fehlerprotokollbeginnenELIF zuvielefehlerTHEN 
+programmendeFI ;nameinprotokoll;fehler(fehlernr,ergaenzung);dbstatus(notfound
+);.ersterfehler:fehlerzahl=null.zuvielefehler:fehlerzahl=maxfehler.
+fehlerprotokollbeginnen:fehlerprot:=sequentialfile(output,protname);TEXT VAR 
+protzeile:=schulkenndatum(schulname);protzeileCAT ((zeilenlaenge-datumslaenge
+-length(protzeile))*blank);protzeileCAT date;putline(fehlerprot,protzeile);
+putline(fehlerprot,schulkenndatum(schulort));line(fehlerprot,3);putline(
+fehlerprot,protueberschrift);line(fehlerprot).programmende:line(fehlerprot);
+putline(fehlerprot,weiterefehler);stop.nameinprotokoll:fehlerzahlINCR 1;line(
+fehlerprot);protzeile:=text(fehlerzahl)+ordnungstrenner+name;putline(
+fehlerprot,protzeile).END PROC fehler;PROC fehler(INT CONST fehlernr,TEXT 
+CONST ergaenzung):TEXT VAR protzeile:=absatztrenner+fehlertext(fehlernr);IF 
+ergaenzung<>niltextTHEN protzeileCAT klammerauf;protzeileCAT ergaenzung;
+protzeileCAT klammerzuFI ;putline(fehlerprot,protzeile)END PROC fehler;PROC 
+pruefetutorsg(BOOL VAR allesinordnung):TEXT VAR eintrittjgst:=wert(
+fnrsujgsteintr),neuerzug:=wert(fnrsuneuerzugtut);allesinordnung:=neuerzug<>
+niltext;IF allesinordnungTHEN allesinordnung:=gueltigesg(eintrittjgst+
+neuerzug);IF NOT allesinordnungTHEN fehler(aufberprot,fehlerungueltigesg,
+eintrittjgst+neuerzug)FI ELSE fehler(aufberprot,fehlerkeinneuertutor)FI ;END 
+PROC pruefetutorsg;BOOL PROC gueltigesg(TEXT CONST sg):pos(
+geplschuelergruppen,sg+sgtrenner)>nullEND PROC gueltigesg;PROC setzekenndaten
+:key(1):=wert(fnrsufamnames);key(2):=wert(fnrsurufnames);key(3):=
+datumrekonversion(wert(fnrsugebdatums));aufbermeld:=key(1)+trennername+key(2)
+;aufberprot:=aufbermeld+trennername+datumskonversion(key(3))END PROC 
+setzekenndaten;TEXT PROC jahrestext(INT CONST jahr):IF jahr=maxjahrTHEN 
+minjahrELSE text(jahr)FI END PROC jahrestext;PROC 
+hjdnaechstesschulhalbjahrbearbeiten(TEXT CONST jgst,zug):IF wert(fnrsustatuss
+)<>aktbestandTHEN halbjahresdateninitialisierenundverarbeitenELSE 
+halbjahresdatensuchenundverarbeitenFI ;dbstatus(ok)#dr18.08.88##inittupel(
+dnrschulen);dr11.05.88putwert(fnrschkennung,wert(fnrsuskennlschule));search(
+dnrschulen,TRUE );einenschuelerinstatraumeinfuegen#.
+halbjahresdateninitialisierenundverarbeiten:putwert(fnrsutidakthjd,niltext);
+inittupel(dnrhalbjahresdaten);IF wert(fnrsustatuss)<>bestandabgegangeneTHEN 
+putwert(fnrsustatuss,aktbestand)FI .halbjahresdatensuchenundverarbeiten:
+schluesselsetzen;search(dnrhalbjahresdaten,TRUE );IF dbstatus=okTHEN 
+eventuellneueklasseeintragen;putwert(fnrsutidakthjd,gettid)ELSE putwert(
+fnrsutidakthjd,niltext)FI .schluesselsetzen:IF akthalbjahr=halbjahr1THEN 
+schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,aktschuljahr,halbjahr2,jgst)
+ELSE schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,kommendesschuljahr,
+halbjahr2,jgst)FI .eventuellneueklasseeintragen:IF schuelergruppegeaendert
+THEN halbjahresdatenaendernFI .schuelergruppegeaendert:wert(fnrhjdjgst)<>jgst
+OR wert(fnrhjdkennung)<>zug.halbjahresdatenaendern:putwert(fnrhjdjgst,jgst);
+putwert(fnrhjdkennung,zug);selupdate(dnrhalbjahresdaten).END PROC 
+hjdnaechstesschulhalbjahrbearbeiten;LET seperatorzeichen=":./ ",
+seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b;
+BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC 
+nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90
+,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212,
+letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334
+,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j):
+INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0
+THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a
+:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a>
+letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<=
+letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<=
+letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<=
+letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI .
+januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m
+:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<=
+letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a-
+letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli
+THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli
+ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m
+:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a-
+letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum(
+TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j;
+IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5)
+*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum
+FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF 
+seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1);
+seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:=
+z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2
+)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ;
+IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH 
+nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q
+)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo):
+INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e
+FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j
+INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE 
+SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4,
+6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j)
+ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND 
+SELECT FI END PROC datum;INT PROC erg(INT CONST t,m,jc):INT VAR j:=jc;INT 
+VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR 88;result:=-1FI ;
+resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:=tagundmonat+365*j;IF 
+tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR 1ELIF tagimzyklus=
+erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ;result+tagimzyklus.
+erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:tCASE 2:t+
+letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+
+letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9
+:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+
+letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END 
+PROC erg;INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END 
+PROC jahr;TEXT PROC datum(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);
+IF t<0THEN LEAVE datumWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);e
+CAT seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT 
+seperatorzeichen1;eCAT code((jMOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND 
+PROC datum;END PACKET hoeherstufenlocalprog
+
diff --git a/app/schulis/2.2.1/src/0.ida.data b/app/schulis/2.2.1/src/0.ida.data
new file mode 100644
index 0000000..a9cff8e
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ida.data
@@ -0,0 +1,170 @@
+PACKET idadataDEFINES putformular,openformular,initformular,getactivformular,
+getformtextname,getformularinfo,putformularinfo,getformularname,
+getformularindex,getsteuercode,putsteuercode,getdruckaufbereitung,
+putdruckaufbereitung,getzeile,putzeile,geteinfuegstellen,puteinfuegstellen,
+getzeilenanzahl,putzeilenanzahl,getunterbloecke,putunterbloecke,
+getvorzeilennr,putvorzeilennr,getanzahlselfelder,putanzahlselfelder,
+getselektion,putselektion,getobjektklasse,putobjektklasse,getleitindex,
+putleitindex,getscan,putscan,getanzahlregeln,putanzahlregeln,getregelnummer,
+deleteregel,getblockregelnummer,putblockregelnummer,getzugriffsregel,
+putzugriffsregel,getanzahlregelfelder,putanzahlregelfelder,getvergleichswert,
+putvergleichswert,getblockanzahl,FORMULAR ,openmitloeschen,
+setzeidazeichensatz:TEXT VAR idazeichensatz:="";LET maxanw=100,maxblock=11,
+maxregel=50,maxobjekt=10,maxfeld=10,maxtext=100,maxsel=200;TYPE FORMULAR =
+STRUCT (INFO formularbeschreibung,ROW maxregelREGEL zugriffsregel,INT 
+anzregeln,ROW maxobjektTEXT objektklassen,ROW maxselSELEKT selektion,INT 
+anzselfelder,DRUCKFORM druckform);TYPE INFO =STRUCT (TEXT formname,
+scanbedingung,INT formindex,leitindex,BOOL formtyp);TYPE REGEL =STRUCT (INT 
+objektklassennr,regelnummer,indexnr,anzkeyfelder,ROW maxfeldTEXT 
+vergleichswert);TYPE SELEKT =STRUCT (TEXT selektionsfeld,wert);TYPE BLOCK =
+STRUCT (ROW maxtextTEXT zeile,ROW maxtextTEXT einfuegstellen,INT anzzeilen,
+zuregelnummer,TEXT unterblock,vorzeilennr);TYPE DRUCKFORM =STRUCT (ROW 
+maxblockBLOCK block,ROW maxanwSTCODE stcodes,INT anzblock,DRUCK 
+druckaufbereitung);TYPE STCODE =STRUCT (TEXT steuercode,INT laenge,BOOL 
+rechtsbuendig,druckvariable);TYPE DRUCK =STRUCT (TEXT schrifttyp,REAL 
+startlinks,startoben,INT zeilenproseite,REAL zeilenbreite);DATASPACE VAR fds
+:=nilspace;BOUND FORMULAR VAR form;INT VAR aktformindex:=0;PROC 
+setzeidazeichensatz(TEXT CONST schriftart):idazeichensatz:=schriftartEND 
+PROC setzeidazeichensatz;BOOL VAR loeschenerlaubt:=TRUE ;BOOL PROC 
+openmitloeschen:loeschenerlaubtENDPROC openmitloeschen;PROC openmitloeschen(
+BOOL CONST b):loeschenerlaubt:=bENDPROC openmitloeschen;PROC putformular(
+DATASPACE CONST ds):forget(fds);fds:=ds;form:=fds;aktformindex:=
+getformularindexENDPROC putformular;PROC openformular(INT CONST index):IF 
+aktformindex<>indexCAND loeschenerlaubtTHEN letzteformularloeschenFI ;
+aktformindex:=index;IF exists(getformdataname)THEN form:=old(getformdataname)
+ELSE initformular(index);FI .letzteformularloeschen:forget(getformdataname,
+quiet);forget(getformtextname,quiet).ENDPROC openformular;PROC initformular(
+INT CONST index):INT VAR i,j;FILE VAR formtext;aktformindex:=index;forget(
+getformdataname,quiet);form:=new(getformdataname);putanzahlregeln(0);
+putanzahlselfelder(0);putleitindex(0);putscan("");formtext:=sequentialfile(
+output,getformtextname);FOR iFROM 1UPTO maxobjektREP putobjektklasse(i,"")
+PER ;FOR iFROM 1UPTO maxanwREP putsteuercode(i,"",0,FALSE ,TRUE )PER ;FOR i
+FROM 1UPTO maxregelREP FOR jFROM 1UPTO maxfeldREP form.zugriffsregel[i].
+vergleichswert[j]:=""PER PER ;putdruckaufbereitung(idazeichensatz,2.0,2.0,60,
+77.0);putformularinfo("",index,TRUE )ENDPROC initformular;INT PROC 
+getactivformular:aktformindexENDPROC getactivformular;TEXT PROC 
+getformdataname:"FORMDATA."+text(aktformindex)ENDPROC getformdataname;TEXT 
+PROC getformtextname:"FORMTEXT."+text(aktformindex)ENDPROC getformtextname;
+PROC getsteuercode(INT CONST index,TEXT VAR ausdruck,INT VAR ausglaenge,BOOL 
+VAR rbuendig,druckvar):IF index<1COR index>maxanwTHEN ausdruck:=""ELSE 
+ausdruck:=form.druckform.stcodes[index].steuercode;ausglaenge:=form.druckform
+.stcodes[index].laenge;rbuendig:=form.druckform.stcodes[index].rechtsbuendig;
+druckvar:=form.druckform.stcodes[index].druckvariable;FI ENDPROC 
+getsteuercode;PROC putsteuercode(INT CONST index,TEXT CONST ausdruck,INT 
+CONST ausglaenge,BOOL CONST rbuendig,druckvar):form.druckform.stcodes[index].
+steuercode:=ausdruck;form.druckform.stcodes[index].laenge:=ausglaenge;form.
+druckform.stcodes[index].rechtsbuendig:=rbuendig;form.druckform.stcodes[index
+].druckvariable:=druckvar;ENDPROC putsteuercode;PROC putdruckaufbereitung(
+TEXT CONST schriftart,REAL CONST linkerrandlinks,linkerrandoben,INT CONST 
+zeilenperseite,REAL CONST zeichenperzeile):form.druckform.druckaufbereitung.
+schrifttyp:=schriftart;form.druckform.druckaufbereitung.startlinks:=
+linkerrandlinks;form.druckform.druckaufbereitung.startoben:=linkerrandoben;
+form.druckform.druckaufbereitung.zeilenproseite:=zeilenperseite;form.
+druckform.druckaufbereitung.zeilenbreite:=zeichenperzeile;ENDPROC 
+putdruckaufbereitung;PROC getdruckaufbereitung(TEXT VAR schriftart,REAL VAR 
+linkerrandlinks,linkerrandoben,INT VAR zeilenperseite,REAL VAR 
+zeichenperzeile):schriftart:=form.druckform.druckaufbereitung.schrifttyp;
+linkerrandlinks:=form.druckform.druckaufbereitung.startlinks;linkerrandoben:=
+form.druckform.druckaufbereitung.startoben;zeilenperseite:=form.druckform.
+druckaufbereitung.zeilenproseite;zeichenperzeile:=form.druckform.
+druckaufbereitung.zeilenbreite;ENDPROC getdruckaufbereitung;TEXT PROC 
+getzeile(INT CONST blocknr,zeilennr):form.druckform.block[blocknr+1].zeile[
+zeilennr]ENDPROC getzeile;PROC putzeile(INT CONST blocknr,zeilennr,TEXT 
+CONST textzeile):form.druckform.block[blocknr+1].zeile[zeilennr]:=textzeile;
+form.druckform.anzblock:=max(form.druckform.anzblock,blocknr)ENDPROC putzeile
+;TEXT PROC geteinfuegstellen(INT CONST blocknr,zeilennr):form.druckform.block
+[blocknr+1].einfuegstellen[zeilennr]ENDPROC geteinfuegstellen;PROC 
+puteinfuegstellen(INT CONST blocknr,zeilennr,TEXT CONST einfueg):form.
+druckform.block[blocknr+1].einfuegstellen[zeilennr]:=einfuegENDPROC 
+puteinfuegstellen;INT PROC getzeilenanzahl(INT CONST blocknr):form.druckform.
+block[blocknr+1].anzzeilenENDPROC getzeilenanzahl;PROC putzeilenanzahl(INT 
+CONST blocknr,zeilennr):form.druckform.block[blocknr+1].anzzeilen:=zeilennr
+ENDPROC putzeilenanzahl;INT PROC getblockregelnummer(INT CONST blocknr):form.
+druckform.block[blocknr+1].zuregelnummerENDPROC getblockregelnummer;PROC 
+putblockregelnummer(INT CONST blocknr,regel):form.druckform.block[blocknr+1].
+zuregelnummer:=regelENDPROC putblockregelnummer;INT PROC getblockanzahl:form.
+druckform.anzblockENDPROC getblockanzahl;TEXT PROC getunterbloecke(INT CONST 
+blocknr):form.druckform.block[blocknr+1].unterblockENDPROC getunterbloecke;
+PROC putunterbloecke(INT CONST blocknr,TEXT CONST ub):form.druckform.block[
+blocknr+1].unterblock:=ubENDPROC putunterbloecke;TEXT PROC getvorzeilennr(
+INT CONST blocknr):form.druckform.block[blocknr+1].vorzeilennrENDPROC 
+getvorzeilennr;PROC putvorzeilennr(INT CONST blocknr,TEXT CONST zeilenno):
+form.druckform.block[blocknr+1].vorzeilennr:=zeilennoENDPROC putvorzeilennr;
+TEXT PROC getscan:form.formularbeschreibung.scanbedingungENDPROC getscan;
+PROC putscan(TEXT CONST bedingung):form.formularbeschreibung.scanbedingung:=
+bedingungENDPROC putscan;TEXT PROC getobjektklasse(INT CONST ix):form.
+objektklassen[ix]ENDPROC getobjektklasse;PROC putobjektklasse(INT CONST ix,
+TEXT CONST okname):form.objektklassen[ix]:=oknameENDPROC putobjektklasse;
+TEXT PROC getformularname:form.formularbeschreibung.formnameENDPROC 
+getformularname;INT PROC getformularindex:form.formularbeschreibung.formindex
+ENDPROC getformularindex;PROC getformularinfo(TEXT VAR name,INT VAR index,
+BOOL VAR typ):name:=form.formularbeschreibung.formname;index:=form.
+formularbeschreibung.formindex;typ:=form.formularbeschreibung.formtyp;
+ENDPROC getformularinfo;PROC putformularinfo(TEXT CONST name,INT CONST index,
+BOOL CONST typ):form.formularbeschreibung.formname:=name;form.
+formularbeschreibung.formindex:=index;form.formularbeschreibung.formtyp:=typ;
+ENDPROC putformularinfo;INT PROC getleitindex:form.formularbeschreibung.
+leitindexENDPROC getleitindex;PROC putleitindex(INT CONST neuerindex):form.
+formularbeschreibung.leitindex:=neuerindexENDPROC putleitindex;INT PROC 
+getanzahlregeln:form.anzregelnENDPROC getanzahlregeln;PROC putanzahlregeln(
+INT CONST anzahl):form.anzregeln:=anzahlENDPROC putanzahlregeln;PROC 
+putanzahlselfelder(INT CONST anzahl):form.anzselfelder:=anzahlENDPROC 
+putanzahlselfelder;INT PROC getanzahlselfelder:form.anzselfelderENDPROC 
+getanzahlselfelder;OP :=(REGEL VAR left,REGEL CONST right):CONCR (left):=
+CONCR (right)ENDOP :=;INT PROC getregelnummer(INT CONST objektklasse,regelnr)
+:INT VAR i;FOR iFROM 1UPTO getanzahlregelnREP IF form.zugriffsregel[i].
+objektklassennr=objektklasseCAND form.zugriffsregel[i].regelnummer=regelnr
+THEN LEAVE getregelnummerWITH iFI PER ;0ENDPROC getregelnummer;PROC 
+deleteregel(INT CONST regel):INT VAR i;IF regel<=getanzahlregelnCAND regel>0
+THEN FOR iFROM regelUPTO getanzahlregeln-1REP form.zugriffsregel[i]:=form.
+zugriffsregel[i+1]PER ;putanzahlregeln(getanzahlregeln-1)FI ENDPROC 
+deleteregel;PROC getzugriffsregel(INT CONST nr,INT VAR objekt,regel,index,
+anzfelder):objekt:=form.zugriffsregel[nr].objektklassennr;regel:=form.
+zugriffsregel[nr].regelnummer;index:=form.zugriffsregel[nr].indexnr;anzfelder
+:=form.zugriffsregel[nr].anzkeyfelder;ENDPROC getzugriffsregel;PROC 
+putzugriffsregel(INT CONST nr,INT CONST objekt,regel,index,anzfelder):form.
+anzregeln:=max(nr,form.anzregeln);form.zugriffsregel[nr].objektklassennr:=
+objekt;form.zugriffsregel[nr].regelnummer:=regel;form.zugriffsregel[nr].
+indexnr:=index;form.zugriffsregel[nr].anzkeyfelder:=anzfelder;ENDPROC 
+putzugriffsregel;INT PROC getanzahlregelfelder(INT CONST regelnr):form.
+zugriffsregel[regelnr].anzkeyfelderENDPROC getanzahlregelfelder;PROC 
+putanzahlregelfelder(INT CONST regelnr,anzahl):form.zugriffsregel[regelnr].
+anzkeyfelder:=anzahlENDPROC putanzahlregelfelder;TEXT PROC getvergleichswert(
+INT CONST regel,nr):form.zugriffsregel[regel].vergleichswert[nr]ENDPROC 
+getvergleichswert;PROC putvergleichswert(INT CONST regelnr,TEXT CONST vglwert
+):form.zugriffsregel[regelnr].anzkeyfelderINCR 1;form.zugriffsregel[regelnr].
+vergleichswert[form.zugriffsregel[regelnr].anzkeyfelder]:=vglwertENDPROC 
+putvergleichswert;PROC putselektion(TEXT CONST feldname,vglwert):form.
+anzselfelderINCR 1;form.selektion[form.anzselfelder].selektionsfeld:=feldname
+;form.selektion[form.anzselfelder].wert:=vglwert;ENDPROC putselektion;PROC 
+getselektion(INT CONST ix,TEXT VAR feldname,vglwert):feldname:=form.selektion
+[ix].selektionsfeld;vglwert:=form.selektion[ix].wert;ENDPROC getselektion;
+TEXT PROC getselektion:buildselektionENDPROC getselektion;LET textbegrenzer=
+"""",klammerauf="<",klammerzu=">",gleich="=",undoperator=" UND ",operatoren=
+"=<>";INT PROC postextende(TEXT CONST ausgabe,INT CONST aktuelleposition):
+INT VAR neupos:=aktuelleposition+1;WHILE (ausgabeSUB neupos)<>textbegrenzer
+REP neuposINCR 1;IF (ausgabeSUB neupos)=textbegrenzerCAND (ausgabeSUB neupos+
+1)=textbegrenzerTHEN neuposINCR 2;FI ;UNTIL neupos>length(ausgabe)PER ;neupos
++1ENDPROC postextende;INT PROC operatorposition(TEXT VAR ausdruck,INT CONST 
+abpos):INT VAR p:=abpos;WHILE p<=length(ausdruck)AND pos(operatoren,ausdruck
+SUB p)=0REP IF (ausdruckSUB p)=textbegrenzerTHEN insertchar(ausdruck,
+klammerauf,p);pINCR 1;p:=postextende(ausdruck,p);insertchar(ausdruck,
+klammerzu,p);pINCR 1;ELSE pINCR 1FI ;PER ;IF p>length(ausdruck)THEN 0ELSE p
+FI ENDPROC operatorposition;TEXT PROC buildselektion:INT VAR i:=1,oppos,
+lastpos;TEXT VAR selausdruck:="",feldname:="",einfacherausdruck:="",
+feldausdruck:="";WHILE i<=getanzahlselfelderREP getselektion(i,feldname,
+einfacherausdruck);IF einfacherausdruck>""THEN evtlumoperatorergaenzen;
+feldausdruck:="";lastpos:=1;oppos:=operatorposition(einfacherausdruck,1);
+WHILE oppos>0REP teilausdruckuebernehmen;feldnameneinfuegen;lastpos:=oppos;
+opposINCR 1;IF pos(operatoren,einfacherausdruckSUB oppos)>0THEN opposINCR 1
+FI ;oppos:=operatorposition(einfacherausdruck,oppos);PER ;restuebernehmen;
+feldausdruckklammern;IF length(selausdruck)>0THEN selausdruckCAT undoperator
+FI ;selausdruckCAT feldausdruck;FI ;iINCR 1;PER ;selausdruck.
+evtlumoperatorergaenzen:IF pos(operatoren,einfacherausdruckSUB 1)=0THEN 
+einfacherausdruck:=gleich+einfacherausdruckFI .teilausdruckuebernehmen:
+feldausdruckCAT subtext(einfacherausdruck,lastpos,oppos-1).feldnameneinfuegen
+:feldausdruck:=feldausdruck+textbegrenzer+feldname+textbegrenzer+" ".
+restuebernehmen:feldausdruckCAT subtext(einfacherausdruck,lastpos).
+feldausdruckklammern:feldausdruck:="("+feldausdruck+")".ENDPROC 
+buildselektion;ENDPACKET idadata
+
diff --git a/app/schulis/2.2.1/src/0.ida.form b/app/schulis/2.2.1/src/0.ida.form
new file mode 100644
index 0000000..faa2776
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ida.form
@@ -0,0 +1,34 @@
+PACKET formdbDEFINES putform,getform,delform,formexists,formdbstatus:LET 
+putdatacode=10,puttextcode=11,getdatacodeno=12,gettextcodeno=13,
+getdatacodename=19,gettextcodename=20,initializeserver=18,delcodeno=14,
+existscodeno=15,delcodename=16,existscodename=17,errornak=2,ok=0,
+cformtextname="FORMTEXT.",cformdataname="FORMDATA.";DATASPACE VAR ds;INT VAR 
+formnr,replycode;TASK VAR formdbserver:=/"ida server";BOUND TEXT VAR 
+boundinhalt;TEXT VAR id,formname;BOUND FORMULAR VAR form;TEXT PROC 
+formtextname:cformtextname+text(getformularindex)ENDPROC formtextname;TEXT 
+PROC formdataname:cformdataname+text(getformularindex)ENDPROC formdataname;
+TEXT PROC formtextname(INT CONST formnr):cformtextname+text(formnr)ENDPROC 
+formtextname;TEXT PROC formdataname(INT CONST formnr):cformdataname+text(
+formnr)ENDPROC formdataname;PROC formdbstatus(INT CONST newcode):replycode:=
+newcode;ENDPROC formdbstatus;INT PROC formdbstatus:replycodeENDPROC 
+formdbstatus;PROC putform:forget(ds);formnr:=getformularindex;ds:=old(
+formdataname);c(formdbserver,putdatacode,ds,replycode);IF replycode=okTHEN 
+forget(ds);ds:=old(formtextname(formnr));type(ds,formnr);c(formdbserver,
+puttextcode,ds,replycode);forget(ds)FI ENDPROC putform;PROC getform(INT 
+CONST formnr):call(text(formnr),getdatacodeno);receive(replycode)ENDPROC 
+getform;PROC getform(TEXT CONST formname):call(formname,getdatacodename);
+receive(replycode);ENDPROC getform;PROC receive(INT CONST replycode):IF 
+replycode=okTHEN putformular(ds);formnr:=getformularindex;forget(formdataname
+,quiet);copy(ds,formdataname);call(text(formnr),gettextcodeno);forget(
+formtextname(formnr),quiet);type(ds,1003);copy(ds,formtextname(formnr));
+forget(ds)FI ENDPROC receive;PROC delform(INT CONST formnr):call(text(formnr)
+,delcodeno)ENDPROC delform;PROC delform(TEXT CONST formname):call(formname,
+delcodename)ENDPROC delform;BOOL PROC formexists(INT CONST formnr):call(text(
+formnr),existscodeno);replycode=okENDPROC formexists;BOOL PROC formexists(
+TEXT CONST formname):call(text(formnr),existscodename);replycode=okENDPROC 
+formexists;PROC call(TEXT CONST inhalt,INT CONST ordercode):forget(ds);ds:=
+nilspace;boundinhalt:=ds;boundinhalt:=inhalt;c(formdbserver,ordercode,ds,
+replycode);ENDPROC call;PROC c(TASK CONST t,INT CONST i,DATASPACE VAR d,INT 
+VAR r):call(t,i,d,r);IF r=errornakTHEN boundinhalt:=ds;errorstop(
+"IDA-MANAGER-Fehler: "+boundinhalt);FI ENDPROC c;ENDPACKET formdb;
+
diff --git a/app/schulis/2.2.1/src/0.ida.server b/app/schulis/2.2.1/src/0.ida.server
new file mode 100644
index 0000000..ee1b067
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.ida.server
@@ -0,0 +1,51 @@
+PACKET idaserverDEFINES idaserver:LET ok=00,#SERVER M essages&E rrors#
+notfound=04,noform="",cformtextname="FORMTEXT.",#SERVER const#cformdataname=
+"FORMDATA.",putdatacode=10,#SERVER ordercodes#puttextcode=11,getdatacodeno=12
+,gettextcodeno=13,getdatacodename=19,gettextcodename=20,delcodeno=14,
+delcodename=16,existscodeno=15,existscodename=17,#initserver=18,#errornak=2,#
+EUMEL S ystemerrors#continuecode=100;#EUMEL S ystemcodes#DATASPACE VAR ds:=
+nilspace;#BOUND FORMULAR VAR form;#BOUND TEXT VAR errortext,formtext;TASK 
+VAR ordertask;INT VAR i,ordercode;ROW 100TEXT VAR formname;TEXT VAR id;FOR i
+FROM 1UPTO 100REP formname[i]:="";PER ;#TEXT PROC formtextname:cformtextname+
+text(getformularindex)ENDPROC formtextname;#TEXT PROC formdataname:
+cformdataname+text(getformularindex)ENDPROC formdataname;TEXT PROC 
+formtextname(TEXT CONST formnr):cformtextname+formnrENDPROC formtextname;
+TEXT PROC formdataname(TEXT CONST formnr):cformdataname+formnrENDPROC 
+formdataname;TEXT PROC searchid:INT VAR count;TEXT VAR returntext;formtext:=
+ds;returntext:=formtext;IF ordercode=delcodenameOR ordercode=existscodename
+OR ordercode=getdatacodenameTHEN searchheaderELSE returntextFI .searchheader:
+FOR countFROM 1UPTO 100REP IF formname[count]=formtextTHEN LEAVE searchid
+WITH text(count);FI ;PER ;noform.ENDPROC searchid;PROC server:SELECT 
+ordercodeOF CASE putdatacode:writeformdataCASE puttextcode:writeformtextCASE 
+getdatacodeno,getdatacodename:readformdataCASE gettextcodeno,gettextcodename:
+readformtextCASE delcodeno,delcodename:deleteformCASE existscodename,
+existscodeno:existsformOTHERWISE :errorstop("Unbekannter  Auftrag")ENDSELECT 
+;eventuellfehlerbehandlung;send(ordertask,ordercode,ds).
+eventuellfehlerbehandlung:IF iserrorTHEN ordercode:=errornak;errortext:=ds;
+errortext:=errormessage;clearerrorFI .writeformdata:putformular(ds);#form:=ds
+;#id:=text(getformularindex);i:=getformularindex;formname[i]:=getformularname
+;forget(formdataname,quiet);copy(ds,formdataname);forget(ds);ds:=nilspace;
+ordercode:=ok.writeformtext:#form:=ds;#id:=text(type(ds));forget(formtextname
+(id),quiet);type(ds,1003);copy(ds,formtextname(id));forget(ds);ordercode:=ok;
+ds:=nilspace.readformdata:id:=searchid;IF id=noformTHEN ordercode:=notfound;
+LEAVE readformdataFI ;forget(ds);IF exists(formdataname(id))THEN ordercode:=
+ok;ds:=old(formdataname(id));ELSE ds:=nilspace;ordercode:=notfoundFI .
+readformtext:id:=searchid;IF id=noformTHEN ordercode:=notfound;LEAVE 
+readformtextFI ;forget(ds);IF exists(formtextname(id))THEN ordercode:=ok;ds:=
+old(formtextname(id));ELSE ordercode:=notfound;ds:=nilspaceFI .ENDPROC server
+;PROC deleteform:id:=searchid;ordercode:=ok;IF id=noformTHEN LEAVE deleteform
+FI ;forget(formtextname(id),quiet);forget(formdataname(id),quiet);forget(ds);
+ds:=nilspace;ENDPROC deleteform;PROC existsform:id:=searchid;IF id=noform
+THEN ordercode:=notfoundELSE IF exists(formtextname(id))CAND exists(
+formdataname(id))THEN ordercode:=okELSE ordercode:=notfoundFI FI ;ENDPROC 
+existsform;PROC idaserver:globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT 
+CONST ,TASK CONST )idaserver)ENDPROC idaserver;PROC idaserver(DATASPACE VAR 
+dsp,INT CONST orderp,phasep,TASK CONST ordertaskp):IF orderp>=continuecode
+AND ordertaskp=supervisorTHEN forget(dsp);spoolcommand(orderp)ELSE clearerror
+;enablestop;forget(ds);ds:=dsp;ordercode:=orderp;ordertask:=ordertaskp;server
+FI ENDPROC idaserver;PROC spoolcommand(INT CONST order):TEXT VAR commandline
+:="";enablestop;break(quiet);continue(order-continuecode);disablestop;REP 
+commanddialogue(TRUE );getcommand("ISP-IDA-MANAGER:",commandline);do(
+commandline)UNTIL NOT onlinePER ;commanddialogue(FALSE );break(quiet);
+setautonomEND PROC spoolcommand;ENDPACKET idaserver;
+
diff --git a/app/schulis/2.2.1/src/0.klassengruppen definieren b/app/schulis/2.2.1/src/0.klassengruppen definieren
new file mode 100644
index 0000000..0765de9
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.klassengruppen definieren
@@ -0,0 +1,81 @@
+PACKET erfklassengruppenDEFINES erfassungklassengruppen:LET maskenname=
+"ms erf klassengruppen",fnrkennung=2,fnrletztesfeld=32,trenner=" = ",
+maxsugruppen=15,laengejgst=2,laengezug=4,laengeeinersugruppe=6,
+laengeklassengruppe=4,felderprozeile=2;INT VAR fnrjgst;TEXT VAR sugruppen:=""
+;TEXT VAR sugruppe:="";INT VAR anzsugruppen;TEXT VAR gueltigeschuelergruppen
+:="";LET postrenner="�";LET fuehrendenull="0",jgst5=5,jgst10=10,jgst13=13;
+LET meldnrfehlendeangabe=52,meldnrungueltigesugruppe=55,
+meldnrklassengruppezulang=60,meldnrungueltigegruppenbez=86;LET wertaktuell=
+"aktuell",wertgeplant="geplant";PROC erfassungklassengruppen(INT CONST proznr
+):systemdboff;reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameter
+CASE 2:zeigeklassengruppezurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+klassengruppenlesenCASE 7:klassengruppenaendernCASE 8:klassengruppeneinfuegen
+CASE 9:klassengruppenloeschenEND SELECT END PROC erfassungklassengruppen;
+PROC setzeerfassungsparameter:gueltigeschuelergruppen:="";
+setzeerfassungsparameter(dnrklassengruppen,maskenname,fnrletztesfeld)END 
+PROC setzeerfassungsparameter;PROC zeigeklassengruppezurbearbeitung:
+setzeerfassungsfeld(wert(fnrkgklassengrp),fnrkennung);sugruppen:=wert(
+fnrkgschuelergrp);anzsugruppen:=(length(sugruppen))DIV laengeeinersugruppe;
+INT VAR i:=1;fnrjgst:=fnrkennung+1;WHILE i<=anzsugruppenREP sugruppe:=subtext
+(sugruppen,1,laengeeinersugruppe);sugruppen:=subtext(sugruppen,
+laengeeinersugruppe+1);setzeerfassungsfeld(subtext(sugruppe,1,laengejgst),
+fnrjgst);setzeerfassungsfeld(compress(subtext(sugruppe,laengejgst+1)),fnrjgst
++1);fnrjgstINCR felderprozeile;iINCR 1PER ;WHILE i<=maxsugruppenREP 
+setzeerfassungsfeld("",fnrjgst);setzeerfassungsfeld("",fnrjgst+1);fnrjgst
+INCR felderprozeile;iINCR 1PER ;END PROC zeigeklassengruppezurbearbeitung;
+PROC pruefeplausibilitaet:LET leer="",null=0;INT VAR pruefbez;IF 
+gueltigeschuelergruppen=""THEN 
+holeallegeplundaktschuelergruppeningueltigesugruppenFI ;INT VAR fehlerstatus;
+pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null,null,leer,
+fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE 
+pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))>
+laengeklassengruppeTHEN meldeauffaellig(erfassungsmaske,
+meldnrklassengruppezulang);setzefehlerstatus(fnrkennung);LEAVE 
+pruefeplausibilitaetELSE pruefbez:=int(erfassungswert(fnrkennung));IF 
+lastconversionokTHEN IF pruefbez>=jgst5CAND pruefbez<=jgst13THEN 
+meldeauffaellig(erfassungsmaske,meldnrungueltigegruppenbez);setzefehlerstatus
+(fnrkennung);LEAVE pruefeplausibilitaetFI FI FI ;INT VAR i;fnrjgst:=
+fnrkennung+1;FOR iFROM 1UPTO maxsugruppenREP IF erfassungswert(fnrjgst)<>""
+THEN pruefe(3,erfassungsmaske,PROC erfassungswert,fnrjgst,jgst5,jgst13,leer,
+fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE 
+pruefeplausibilitaetELIF kennungangegebenCAND ungueltigeschuelergruppenangabe
+THEN setzefehlerstatus(fnrjgst);meldeauffaellig(erfassungsmaske,
+meldnrungueltigesugruppe);LEAVE pruefeplausibilitaetFI ;ELIF kennungangegeben
+THEN setzefehlerstatus(fnrjgst);meldeauffaellig(erfassungsmaske,
+meldnrfehlendeangabe);LEAVE pruefeplausibilitaetFI ;fnrjgstINCR 
+felderprozeilePER .kennungangegeben:erfassungswert(fnrjgst+1)<>"".
+ungueltigeschuelergruppenangabe:pos(gueltigeschuelergruppen,suchwert)=0.
+suchwert:postrenner+text(int(erfassungswert(fnrjgst)))+compress(
+erfassungswert(fnrjgst+1))+postrenner.END PROC pruefeplausibilitaet;PROC 
+holeallegeplundaktschuelergruppeningueltigesugruppen:gueltigeschuelergruppen
+:=postrenner;statleseschleife(dnraktschuelergruppen,"","",fnrsgrpsj,fnrsgrpsj
+,PROC sugruppelesen);END PROC 
+holeallegeplundaktschuelergruppeningueltigesugruppen;PROC sugruppelesen(BOOL 
+VAR b):IF dbstatus<>0THEN b:=TRUE ELSE gueltigeschuelergruppenCAT wert(
+fnrsgrpjgst)+wert(fnrsgrpkennung)+postrennerFI END PROC sugruppelesen;PROC 
+setzewertefuerdbspeicherung:putwert(fnrkgklassengrp,erfassungswert(fnrkennung
+));sugruppen:="";INT VAR i;fnrjgst:=fnrkennung+1;FOR iFROM 1UPTO maxsugruppen
+REP sugruppe:=erfassungswert(fnrjgst);IF sugruppe<>""THEN sugruppenCAT 
+jgstangabe;sugruppenCAT text(erfassungswert(fnrjgst+1),laengezug)FI ;fnrjgst
+INCR felderprozeilePER ;putwert(fnrkgschuelergrp,sugruppen).jgstangabe:INT 
+VAR ijgst:=int(sugruppe);IF ijgst>=jgst10CAND ijgst<=jgst13THEN sugruppeELSE 
+fuehrendenull+text(ijgst,1)FI .END PROC setzewertefuerdbspeicherung;PROC 
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR 
+identizeile;identizeile:=wert(fnrkgklassengrp)+trenner+wert(fnrkgschuelergrp)
+;setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert(
+fnrkgklassengrp).END PROC setzeidentiobjektfuerobjektliste;PROC 
+klassengruppenlesen:putwert(fnrkgklassengrp,schluessel);search(
+dnrklassengruppen,TRUE );IF dbstatus=okTHEN saveupdateposition(
+dnrklassengruppen)FI END PROC klassengruppenlesen;PROC klassengruppenaendern:
+restoreupdateposition(dnrklassengruppen);update(dnrklassengruppen);
+aenderungsvermerksetzen(wertaktuell);aenderungsvermerksetzen(wertgeplant)END 
+PROC klassengruppenaendern;PROC klassengruppeneinfuegen:insert(
+dnrklassengruppen);aenderungsvermerksetzen(wertaktuell);
+aenderungsvermerksetzen(wertgeplant)END PROC klassengruppeneinfuegen;PROC 
+klassengruppenloeschen:delete(dnrklassengruppen);aenderungsvermerksetzen(
+wertaktuell);aenderungsvermerksetzen(wertgeplant)END PROC 
+klassengruppenloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung)END 
+PROC schluessel;END PACKET erfklassengruppen;
+
diff --git a/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen b/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen
new file mode 100644
index 0000000..8be6d56
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.kurswahlbasis bereinigen
@@ -0,0 +1,34 @@
+PACKET kurswahlbasisbereinigenDEFINES kurswahlserveraktualisieren,
+kurswahlserverlvaktualisieren:LET server="kurswahl server",jg9=9,jg14=14,hj1=
+"1",hj2="2",dbsj="Schuljahr",dbhj="Schulhalbjahr",kurswahl="Kurswahl-",kw2=
+"2 ",kw0="0 ";INT VAR sj1,sj2,sj3,sj4,akthj;TEXT VAR schuljahr,halbjahr;TASK 
+VAR takuser;PROC kurswahlserveraktualisieren(TEXT CONST jgst,spezjgst,spezhj)
+:serveraktualisieren(kw2,jgst,spezjgst,spezhj)END PROC 
+kurswahlserveraktualisieren;PROC kurswahlserverlvaktualisieren(TEXT CONST 
+jgst,spezjgst,spezhj):serveraktualisieren(kw0,jgst,spezjgst,spezhj)END PROC 
+kurswahlserverlvaktualisieren;PROC serveraktualisieren(TEXT CONST ds,jgst,
+spezjgst,spezhj):INT VAR jg:=int(jgst),spezjg:=int(spezjgst),jgdiff;IF 
+existstask(server)THEN takuser:=task(server);schuljahr:=schulkenndatum(dbsj);
+halbjahr:=schulkenndatum(dbhj);sj1:=int(schuljahr);sj2:=sj1+101;sj3:=sj2+101;
+sj4:=sj3+101;IF jg>jg9CAND jg<jg14THEN commanddialogue(FALSE );IF (spezjgst=
+""CAND spezhj="")THEN loeschealledatenraeumeELIF spezjg>jg9CAND spezjg<jg14
+THEN IF spezhj=hj1COR spezhj=hj2THEN loeschespezdatenraumFI ;FI ;
+commanddialogue(TRUE );FI ;FI .loeschealledatenraeume:IF NOT (jg=10CAND 
+halbjahr="1")THEN erase(datenraumname(jg,ds,hj1,schuljahr),takuser);erase(
+datenraumname(jg,ds,hj2,schuljahr),takuser);erase(datenraumname(jg+1,ds,hj1,
+konvsj(sj2)),takuser);erase(datenraumname(jg+1,ds,hj2,konvsj(sj2)),takuser);
+erase(datenraumname(jg+2,ds,hj1,konvsj(sj3)),takuser);erase(datenraumname(jg+
+2,ds,hj2,konvsj(sj3)),takuser);erase(datenraumname(jg+3,ds,hj1,konvsj(sj4)),
+takuser);erase(datenraumname(jg+3,ds,hj2,konvsj(sj4)),takuser)FI .
+loeschespezdatenraum:akthj:=int(halbjahr);jgdiff:=spezjg-jg;IF NOT (jg=10
+CAND spezjg=10)THEN IF jgdiff=0CAND spezhj>=halbjahrTHEN erase(datenraumname(
+spezjg,ds,spezhj,schuljahr),takuser)ELIF jgdiff=1THEN erase(datenraumname(
+spezjg,ds,spezhj,konvsj(sj2)),takuser)ELIF jgdiff=2THEN erase(datenraumname(
+spezjg,ds,spezhj,konvsj(sj3)),takuser)ELIF jgdiff=3THEN erase(datenraumname(
+spezjg,ds,spezhj,konvsj(sj4)),takuser)FI FI .END PROC serveraktualisieren;
+TEXT PROC datenraumname(INT CONST jgst,TEXT CONST dsp,halbjahr,schuljahr):
+TEXT VAR name:=kurswahl;nameCAT dsp;nameCAT text(jgst);nameCAT " ";nameCAT 
+halbjahr;nameCAT ".";nameCAT schuljahr;nameEND PROC datenraumname;TEXT PROC 
+konvsj(INT CONST sjbez):IF sjbez<9901THEN text(sjbez)ELSE subtext(text(sjbez)
+,2)FI END PROC konvsj;END PACKET kurswahlbasisbereinigen;
+
diff --git a/app/schulis/2.2.1/src/0.liste der aufsichtszeiten b/app/schulis/2.2.1/src/0.liste der aufsichtszeiten
new file mode 100644
index 0000000..c0138c4
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.liste der aufsichtszeiten
@@ -0,0 +1,93 @@
+PACKET listederaufsichtszeitenDEFINES 
+aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen:LET fnrausggeplanteshj
+=2,fnrausgaktuelleshj=3,fnrausgdrucker=4,fnrausgbild=5;LET 
+schluesselschuljahr="Schuljahr",schluesselschulhalbjahr="Schulhalbjahr";LET 
+zusätzlicherlaubtetasten="vr";LET meldunglistewirdaufgebaut=7,
+meldunglistewirdausgedruckt=58,meldungbittewarten=69,
+meldungkeinedatenvorhanden=68;LET dateinamezumzeigen=
+"Liste der Aufsichtszeiten",ueberschrift1fuerdruckdatei=
+"Liste der Aufsichtszeiten",ueberschrift2fuerdruckdatei=
+"-------------------------",textanfangfuerschulhalbjahr="für Schuljahr ",
+trennerfuerschuljahr="/",textmittefuerschulhalbjahr=", ",
+textendefuerschulhalbjahr=". Halbjahr",ueberschrift1dertabelle=
+" Tag Nr.  Bezeichnung            Stunde            Uhrzeit",
+ueberschrift2dertabelle=
+"                                 vorher nachher    von      bis",
+trennstrichdertabelle=
+"--------+----------------------+-----------------+-----------------",
+stelligkeitdestages=100,füllervorbezeichnung=".  ",bezeichnungslänge=20,
+füllervorstunde="   ",stundenprowochentag=12,leerestunde="  ",füllerinstunde=
+".    ",füllervoruhrzeit=".        ",blankszumauffüllen="    ",stellenfürzeit
+=4,füllerinuhrzeit="    ",stdundmintrenner=":",laengederstundenzeit=2,
+blanksvorwochentag="  ",leererwochentag="     ",textmontag="Mo",textdienstag=
+"Di",textmittwoch="Mi",textdonnerstag="Do",textfreitag="Fr",textsamstag="Sa",
+nummerfürsa=6;LET niltext="",blank=" ";BOOL VAR erstaufbildschirm:=FALSE ;
+TEXT VAR schuljahr:=niltext,halbjahr:=niltext;INT VAR fehlerstatus;FILE VAR f
+;INT VAR akttag;PROC aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen(
+INT CONST nr):SELECT nrOF CASE 1:aufsichtszeitenlisteerstellenCASE 2:
+aufsichtszeitenlistedruckenENDSELECT .END PROC 
+aufsichtszeitenlisteerstellenunddruckenggfvorherzeigen;PROC 
+aufsichtszeitenlisteerstellen:INT VAR i;prüfeobrichtigangekreuztist;IF 
+fehlerstatus<>0THEN infeld(fehlerstatus);return(1);LEAVE 
+aufsichtszeitenlisteerstellenFI ;erstaufbildschirm:=standardmaskenfeld(
+fnrausgbild)<>niltext;IF erstaufbildschirmTHEN standardmeldung(
+meldunglistewirdaufgebaut,niltext)ELSE standardmeldung(meldungbittewarten,
+niltext)FI ;berechnebearbeitungsschuljahrundhalbjahr;
+fuellediedateimitdenaufsichtszeiten;IF akttag=0THEN standardmeldung(
+meldungkeinedatenvorhanden,niltext);forget(dateinamezumzeigen,quiet);return(1
+);LEAVE aufsichtszeitenlisteerstellenFI ;IF erstaufbildschirmTHEN zeigedatei(
+dateinamezumzeigen,zusätzlicherlaubtetasten)ELSE standardmeldung(
+meldunglistewirdausgedruckt,niltext);aufsichtszeitenlistedruckenFI .
+prüfeobrichtigangekreuztist:standardpruefe(5,fnrausggeplanteshj,
+fnrausgaktuelleshj,0,niltext,fehlerstatus);IF fehlerstatus=0THEN 
+standardpruefe(5,fnrausgdrucker,fnrausgbild,0,niltext,fehlerstatus);FI .
+fuellediedateimitdenaufsichtszeiten:f:=sequentialfile(output,
+dateinamezumzeigen);putline(f,blank);putline(f,zentriert(
+textanfangfuerschulhalbjahr+text(schuljahr,2)+trennerfuerschuljahr+subtext(
+schuljahr,3)+textmittefuerschulhalbjahr+halbjahr+textendefuerschulhalbjahr,
+bildbreite));putline(f,blank);putline(f,blank);putline(f,
+ueberschrift1dertabelle+blank);putline(f,ueberschrift2dertabelle+blank);
+putline(f,trennstrichdertabelle+blank);akttag:=0;inittupel(dnraufsichtszeiten
+);statleseschleife(dnraufsichtszeiten,schuljahr,halbjahr,fnrazsj,fnrazhj,
+PROC fuellediedatei);FOR iFROM akttag+1UPTO nummerfürsaREP putline(f,blank);
+putline(f,wochentag(i));PER ;.berechnebearbeitungsschuljahrundhalbjahr:
+schuljahr:=schulkenndatum(schluesselschuljahr);halbjahr:=schulkenndatum(
+schluesselschulhalbjahr);IF standardmaskenfeld(fnrausgaktuelleshj)=niltext
+THEN geplanteshjundsjberechnen(halbjahr,schuljahr)FI .END PROC 
+aufsichtszeitenlisteerstellen;PROC aufsichtszeitenlistedrucken:INT VAR 
+zeilenzähler;TEXT VAR t;FILE VAR f1:=sequentialfile(input,dateinamezumzeigen)
+;initdruckkopf(zentriert(ueberschrift1fuerdruckdatei,druckbreite),zentriert(
+ueberschrift2fuerdruckdatei,druckbreite));setzemitseitennummern(TRUE );
+druckvorbereiten;druckkopfschreiben;getline(f1,t);druckzeileschreiben(t);
+getline(f1,t);druckzeileschreiben(zentriert(compress(t),druckbreite));
+zeilenzähler:=drucklaenge(2)-2;WHILE NOT eof(f1)REP IF zeilenzähler=0THEN 
+seitenwechsel;druckkopfschreiben;druckzeileschreiben(ueberschrift1dertabelle)
+;druckzeileschreiben(ueberschrift2dertabelle);druckzeileschreiben(
+trennstrichdertabelle);zeilenzähler:=drucklaenge(2)-3;FI ;getline(f1,t);
+druckzeileschreiben(t);zeilenzählerDECR 1;PER ;drucknachbereiten;forget(
+dateinamezumzeigen,quiet);IF erstaufbildschirmTHEN enter(2)ELSE enter(1)FI 
+END PROC aufsichtszeitenlistedrucken;TEXT PROC wochentag(INT CONST tag):TEXT 
+VAR t;SELECT tagOF CASE 1:t:=blanksvorwochentag+textmontag+blankCASE 2:t:=
+blanksvorwochentag+textdienstag+blankCASE 3:t:=blanksvorwochentag+
+textmittwoch+blankCASE 4:t:=blanksvorwochentag+textdonnerstag+blankCASE 5:t:=
+blanksvorwochentag+textfreitag+blankCASE 6:t:=blanksvorwochentag+textsamstag+
+blankEND SELECT ;tEND PROC wochentag;PROC fuellediedatei(BOOL VAR b):INT VAR 
+i,neuertag;TEXT VAR t,t2;IF wert(fnrazsj)>schuljahrCOR wert(fnrazhj)>halbjahr
+COR dbstatus<>okTHEN b:=TRUE ELSE neuertag:=intwert(fnrazaufsichtszeit)DIV 
+stelligkeitdestages;IF neuertag>akttagTHEN putline(f,blank);FOR iFROM akttag+
+1UPTO neuertag-1REP putline(f,wochentag(i));putline(f,blank);PER ;t:=
+wochentag(neuertag);akttag:=neuertag;ELSE t:=leererwochentagFI ;tCAT text(
+intwert(fnrazaufsichtszeit)MOD stelligkeitdestages,2);tCAT 
+füllervorbezeichnung;tCAT text(wert(fnrazbezeichnung),bezeichnungslänge);t
+CAT füllervorstunde;IF intwert(fnraztagstdvor)=0THEN tCAT leerestundeELSE i:=
+(intwert(fnraztagstdvor)-1)MOD stundenprowochentag+1;tCAT text(i,2);FI ;tCAT 
+füllerinstunde;IF intwert(fnraztagstdnach)=0THEN tCAT leerestundeELSE i:=(
+intwert(fnraztagstdnach)-1)MOD stundenprowochentag+1;tCAT text(i,2);FI ;tCAT 
+füllervoruhrzeit;t2:=blankszumauffüllen+wert(fnrazbeginnuhr);t2:=subtext(t2,
+length(t2)+1-stellenfürzeit);tCAT text(t2,laengederstundenzeit);tCAT 
+stdundmintrenner;tCAT subtext(t2,laengederstundenzeit+1);tCAT füllerinuhrzeit
+;t2:=blankszumauffüllen+wert(fnrazendeuhr);t2:=subtext(t2,length(t2)+1-
+stellenfürzeit);tCAT text(t2,laengederstundenzeit);tCAT stdundmintrenner;t
+CAT subtext(t2,laengederstundenzeit+1);tCAT blank;putline(f,t);FI END PROC 
+fuellediedatei;END PACKET listederaufsichtszeiten
+
diff --git a/app/schulis/2.2.1/src/0.liste der zeitrasterdaten b/app/schulis/2.2.1/src/0.liste der zeitrasterdaten
new file mode 100644
index 0000000..51e91c9
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.liste der zeitrasterdaten
@@ -0,0 +1,101 @@
+PACKET listederzeitrasterdatenDEFINES 
+zeitrasterlisteerstellenunddruckenggfvorherzeigen:LET fnrausggeplanteshj=2,
+fnrausgaktuelleshj=3,fnrausgdrucker=4,fnrausgbild=5;LET schluesselschuljahr=
+"Schuljahr",schluesselschulhalbjahr="Schulhalbjahr",
+anzahldatensaetzeprozeitraster=66;LET zusätzlicherlaubtetasten="vr";LET 
+meldunglistewirdaufgebaut=7,meldunglistewirdausgedruckt=58,meldungbittewarten
+=69,meldungkeinedatenvorhanden=68;LET dateinamezumzeigen=
+"Liste der Zeitrasterdaten",ueberschrift1fuerdruckdatei=
+"Liste der Zeitrasterdaten",ueberschrift2fuerdruckdatei=
+"-------------------------",blankszumauffuellen="    ",
+textanfangfuerschulhalbjahr="für Schuljahr 19",trennerfuerschuljahr="/",
+textmittefuerschulhalbjahr=", ",textendefuerschulhalbjahr=". Halbjahr",
+ueberschriftdererstentabelle="Uhrzeiten:",unterschriftdererstentabelle=
+"----------",zeilederwochentage=
+"          Mo     Di     Mi     Do     Fr     Sa",textvorbeginnzeiten=
+".  von",textvorendezeiten="     bis",trennerdererstentabelle="  ",
+stdundmintrenner=":",laengederstundenzeit=2,stellenderstundennummer=2,
+zeilenzahldererstentabelle=45,ueberschriftderzweitentabelle=
+"Kennzeichnung der Tagesteile:",unterschriftderzweitentabelle=
+"-----------------------------",zeilederstunden=
+"     1.  2.  3.  4.  5.  6.  7.  8.  9. 10. 11. 12.",textmontag="Mo",
+textdienstag="Di",textmittwoch="Mi",textdonnerstag="Do",textfreitag="Fr",
+textsamstag="Sa",trennerderzweitentabelle="   ",stundenamsamstag=6,
+stundenprowochentag=12,mobissa=6,mobisfr=5,poskennungtagesteil=1,
+anfposbeginnzeit=2,endeposbeginnzeit=5,anfposendezeit=6,endeposendezeit=9,
+gesamtetextlaenge=9,stellenfuerkennungtagesteil=1,stellenfuerzeit=4;LET 
+niltext="",blank=" ",null=0,eins=1;BOOL VAR erstaufbildschirm:=FALSE ;TEXT 
+VAR schuljahr:=niltext,halbjahr:=niltext;INT VAR fehlerstatus;ROW 
+anzahldatensaetzeprozeitrasterTEXT VAR alteszeitraster;INT VAR aktindex;PROC 
+zeitrasterlisteerstellenunddruckenggfvorherzeigen(INT CONST nr):SELECT nrOF 
+CASE 1:zeitrasterlisteerstellenCASE 2:zeitrasterlistedruckenENDSELECT .END 
+PROC zeitrasterlisteerstellenunddruckenggfvorherzeigen;PROC 
+zeitrasterlisteerstellen:INT VAR i;prüfeobrichtigangekreuztist;IF 
+fehlerstatus<>nullTHEN infeld(fehlerstatus);return(1);LEAVE 
+zeitrasterlisteerstellenFI ;erstaufbildschirm:=standardmaskenfeld(fnrausgbild
+)<>niltext;IF erstaufbildschirmTHEN standardmeldung(meldunglistewirdaufgebaut
+,niltext)ELSE standardmeldung(meldungbittewarten,niltext)FI ;
+berechnebearbeitungsschuljahrundhalbjahr;fuelledenpuffermitdemzeitraster;IF 
+aktindex=nullTHEN standardmeldung(meldungkeinedatenvorhanden,niltext);return(
+1);LEAVE zeitrasterlisteerstellenFI ;fuegeerstetabelleindateian;
+fuegezweitetabelleindateian;IF erstaufbildschirmTHEN zeigedatei(
+dateinamezumzeigen,zusätzlicherlaubtetasten)ELSE standardmeldung(
+meldunglistewirdausgedruckt,niltext);zeitrasterlistedruckenFI .
+prüfeobrichtigangekreuztist:standardpruefe(5,fnrausggeplanteshj,
+fnrausgaktuelleshj,null,niltext,fehlerstatus);IF fehlerstatus=nullTHEN 
+standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,fehlerstatus);FI .
+fuelledenpuffermitdemzeitraster:aktindex:=null;inittupel(dnrzeitraster);
+statleseschleife(dnrzeitraster,schuljahr,halbjahr,fnrzrsj,fnrzrhj,PROC 
+fuellenurpuffer);FOR iFROM aktindex+einsUPTO anzahldatensaetzeprozeitraster
+REP alteszeitraster(i):=gesamtetextlaenge*blankPER .
+berechnebearbeitungsschuljahrundhalbjahr:schuljahr:=schulkenndatum(
+schluesselschuljahr);halbjahr:=schulkenndatum(schluesselschulhalbjahr);IF 
+standardmaskenfeld(fnrausgaktuelleshj)=niltextTHEN geplanteshjundsjberechnen(
+halbjahr,schuljahr)FI .END PROC zeitrasterlisteerstellen;PROC 
+zeitrasterlistedrucken:INT VAR i;TEXT VAR t;FILE VAR f1:=sequentialfile(input
+,dateinamezumzeigen);initdruckkopf(zentriert(ueberschrift1fuerdruckdatei,
+druckbreite),zentriert(ueberschrift2fuerdruckdatei,druckbreite));
+setzemitseitennummern(TRUE );druckvorbereiten;druckkopfschreiben;getline(f1,t
+);druckzeileschreiben(t);getline(f1,t);druckzeileschreiben(zentriert(compress
+(t),druckbreite));FOR iFROM einsUPTO zeilenzahldererstentabelleREP getline(f1
+,t);druckzeileschreiben(t)PER ;seitenwechsel;druckkopfschreiben;WHILE NOT eof
+(f1)REP getline(f1,t);druckzeileschreiben(t)PER ;drucknachbereiten;forget(
+dateinamezumzeigen,quiet);IF erstaufbildschirmTHEN enter(2)ELSE enter(1)FI 
+END PROC zeitrasterlistedrucken;PROC fuegeerstetabelleindateian:INT VAR i,j,k
+;TEXT VAR t1,t2,t3;FILE VAR f:=sequentialfile(output,dateinamezumzeigen);
+putline(f,blank);putline(f,zentriert(textanfangfuerschulhalbjahr+text(
+schuljahr,2)+trennerfuerschuljahr+subtext(schuljahr,3)+
+textmittefuerschulhalbjahr+halbjahr+textendefuerschulhalbjahr,bildbreite));
+putline(f,blank);putline(f,blank);putline(f,ueberschriftdererstentabelle+
+blank);putline(f,unterschriftdererstentabelle+blank);putline(f,blank);putline
+(f,zeilederwochentage+blank);FOR iFROM einsUPTO stundenprowochentagREP 
+putline(f,blank);t1:=text(i,stellenderstundennummer)+textvorbeginnzeiten;t2:=
+textvorendezeiten;IF i>stundenamsamstagTHEN k:=mobisfrELSE k:=mobissaFI ;FOR 
+jFROM einsUPTO kREP t1CAT trennerdererstentabelle;t2CAT 
+trennerdererstentabelle;t3:=subtext(alteszeitraster(i+(j-eins)*
+stundenprowochentag),anfposbeginnzeit,endeposbeginnzeit);t1CAT text(t3,
+laengederstundenzeit)+stdundmintrenner+subtext(t3,laengederstundenzeit+1);t3
+:=subtext(alteszeitraster(i+(j-eins)*stundenprowochentag),anfposendezeit,
+endeposendezeit);t2CAT text(t3,laengederstundenzeit)+stdundmintrenner+subtext
+(t3,laengederstundenzeit+1);PER ;putline(f,t1+blank);putline(f,t2+blank);PER 
+;putline(f,blank);putline(f,blank);putline(f,blank)END PROC 
+fuegeerstetabelleindateian;PROC fuegezweitetabelleindateian:INT VAR i,j,k;
+TEXT VAR t1;FILE VAR f:=sequentialfile(output,dateinamezumzeigen);putline(f,
+blank);putline(f,ueberschriftderzweitentabelle+blank);putline(f,
+unterschriftderzweitentabelle+blank);putline(f,blank);putline(f,
+zeilederstunden+blank);putline(f,blank);FOR iFROM einsUPTO mobissaREP SELECT 
+iOF CASE 1:t1:=textmontagCASE 2:t1:=textdienstagCASE 3:t1:=textmittwochCASE 4
+:t1:=textdonnerstagCASE 5:t1:=textfreitagCASE 6:t1:=textsamstagEND SELECT ;
+IF i=mobissaTHEN k:=stundenamsamstagELSE k:=stundenprowochentagFI ;FOR jFROM 
+einsUPTO kREP t1CAT trennerderzweitentabelle+text(alteszeitraster((i-eins)*
+stundenprowochentag+j),poskennungtagesteil);PER ;putline(f,t1+blank);PER END 
+PROC fuegezweitetabelleindateian;PROC fuellenurpuffer(BOOL VAR b):TEXT VAR t;
+IF wert(fnrzrsj)>schuljahrCOR wert(fnrzrhj)>halbjahrCOR dbstatus<>okTHEN b:=
+TRUE ELSE aktindexINCR eins;t:=blankszumauffuellen+wert(fnrzrkennungteil);
+alteszeitraster(aktindex):=subtext(t,length(t)+eins-
+stellenfuerkennungtagesteil);t:=blankszumauffuellen+wert(fnrzrbeginnuhr);
+alteszeitraster(aktindex)CAT subtext(t,length(t)+eins-stellenfuerzeit);t:=
+blankszumauffuellen+wert(fnrzrendeuhr);alteszeitraster(aktindex)CAT subtext(t
+,length(t)+eins-stellenfuerzeit)FI END PROC fuellenurpuffer;END PACKET 
+listederzeitrasterdaten
+
diff --git a/app/schulis/2.2.1/src/0.listen.benutz b/app/schulis/2.2.1/src/0.listen.benutz
new file mode 100644
index 0000000..cabeae1
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.benutz
@@ -0,0 +1,84 @@
+PACKET benutzerlisteDEFINES benulispezielleteile:LET niltext="",blank=" ",
+null=0,slash="/",spaltentrenner="  ",ueberschriftenzeilen=1,anzspalten=6,
+dateiname="sortdatei",ausgfeldlaenge=9,spaltenbreite=11,AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,benulieingangsmaske="mu liste einfach eingang",
+benulianfpos=2,mnrbearbeitetwerden=104;#LET dnrbenutz=7,fnrbenutzname=9,
+fnrbenutzberecht=11;#INT VAR druckzeilenzahl,bildanf,eingabestatus,
+aktuelleindexnr,ausgfeldlaengereal;TEXT VAR benuliueberschrift,kennung,
+berechtigungen,bearbeitetwerden,startwert,anfbuchstabe,neueranfbuchstabe;
+AUSGFELD VAR ausgfeld;BOOL PROC multistop:TRUE END PROC multistop;PROC 
+benulispezielleteile(INT CONST nr):SELECT nrOF CASE 1:benulidialogvorbereiten
+CASE 2:benulieingabenrichtigCASE 3:benulilistenvorbereitenCASE 4:
+benulidruckvorbereitenCASE 5:benuliseitedruckenCASE 6:
+benulibildschirmvorbereitenCASE 7:benuliseitezeigenENDSELECT .END PROC 
+benulispezielleteile;PROC benulidialogvorbereiten:systemdbon;#first(dnrbenutz
+);startwert:=wert(fnrbenutzname);#benuliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(benulieingangsmaske,benulianfpos).END PROC 
+benulidialogvorbereiten;PROC benulieingabenrichtig:LET fnrausgdrucker=2,
+fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);
+setzeeingabetest(TRUE )FI .END PROC benulieingabenrichtig;PROC 
+benulilistenvorbereiten:INT VAR i;BOOL VAR b:=FALSE ;initspalten;FOR iFROM 1
+UPTO anzspaltenREP setzespaltenbreite(spaltenbreite)PER ;setzespaltentrenner(
+spaltentrenner);aktuelleindexnr:=dnrbenutz;inittupel(dnrbenutz);
+setzeidentiwert("");initobli(2);objektlistestarten(aktuelleindexnr,"",
+fnrbenutzname,FALSE ,b);setzebestandende(NOT multistop)END PROC 
+benulilistenvorbereiten;PROC benulibildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(benuliueberschrift);bildanf:=fnrausganf;
+setzebildanfangsposition(bildanf).END PROC benulibildschirmvorbereiten;PROC 
+benuliseitezeigen:blaettern(PROC (INT CONST )benutzerzeigen,aktion,FALSE ,
+FALSE ,BOOL PROC multistop);END PROC benuliseitezeigen;PROC benutzerzeigen(
+INT CONST x):benutzerholen;benutzeraufbereitenbild;benutzeraufbildschirm.END 
+PROC benutzerzeigen;PROC benutzeraufbereitenbild:INT VAR i;
+benutzeraufbereitenallgemein(bildbreite);restbehandlungbild.
+restbehandlungbild:FOR iFROM ausgfeldlaengereal+1UPTO ausgfeldlaengeREP 
+ausgfeld(i):=text(blank,bildbreite)PER .END PROC benutzeraufbereitenbild;
+PROC benutzeraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND REP .END PROC 
+benutzeraufbildschirm;PROC benulidruckvorbereiten:anfbuchstabe:=niltext;
+druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(zentriert(
+benuliueberschrift,druckbreite));holemeldung;systemdbon;inittupel(dnrbenutz);
+setzebestandende(NOT multistop);lesenvorbereitendruck(PROC (INT CONST ,BOOL 
+PROC ,INT VAR )scanforward,BOOL PROC multistop).holemeldung:meldungstext(
+mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen).END PROC 
+benulidruckvorbereiten;PROC benuliseitedrucken:benuliueberschriftdrucken;
+seitedrucken(PROC (INT VAR )benutzerdrucken,druckzeilenzahl,ausgfeldlaenge,
+BOOL PROC multistop);seitenwechsel.END PROC benuliseitedrucken;PROC 
+benuliueberschriftdrucken:druckkopfschreiben.END PROC 
+benuliueberschriftdrucken;PROC benutzerdrucken(INT VAR zeilenzaehler):LET 
+markiert="#";benutzerholen;ggflmeldunganfbuchstabe;benutzeraufbereitendruck;
+zeilenzaehlerINCR ausgfeldlaengereal;benutzerindruckdatei.
+ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .
+anfbuchstabegeaendert:neueranfbuchstabe:=kennungSUB 1;anfbuchstabe<>
+neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(bearbeitetwerden,
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+benutzerdrucken;PROC benutzeraufbereitendruck:benutzeraufbereitenallgemein(
+druckbreite).END PROC benutzeraufbereitendruck;PROC benutzerindruckdatei:INT 
+VAR i;FOR iFROM 1UPTO ausgfeldlaengerealREP druckzeileschreiben(ausgfeld(i))
+PER .END PROC benutzerindruckdatei;PROC benutzeraufbereitenallgemein(INT 
+CONST breite):INT VAR position,anzahlberechtigungen,anzzeilenreal,i,j,k;FILE 
+VAR f;TEXT VAR berechtigung;kennungaufbereiten;berechtigungenaufbereiten.
+kennungaufbereiten:ausgfeld(1):=text(kennung,breite).
+berechtigungenaufbereiten:erstenslashimtextueberlesen;
+berechtigungenindateiundsortieren;wirklichezeilenzahlberechnen;
+ausgabefelderberechtigungenauffuellen.erstenslashimtextueberlesen:position:=
+pos(berechtigungen,slash);berechtigungen:=subtext(berechtigungen,position+1).
+berechtigungenindateiundsortieren:f:=sequentialfile(output,dateiname);
+anzahlberechtigungen:=null;position:=pos(berechtigungen,slash);WHILE position
+<>nullREP anzahlberechtigungenINCR 1;putline(f,subtext(berechtigungen,1,
+position-1));berechtigungen:=subtext(berechtigungen,position+1);position:=pos
+(berechtigungen,slash)PER ;putline(f,berechtigungen);anzahlberechtigungen
+INCR 1;sort(dateiname).wirklichezeilenzahlberechnen:anzzeilenreal:=
+anzahlberechtigungenDIV anzspalten;IF (anzahlberechtigungenMOD anzspalten<>
+null)THEN anzzeilenrealINCR 1FI .ausgabefelderberechtigungenauffuellen:f:=
+sequentialfile(input,dateiname);i:=null;FOR jFROM 1UPTO anzzeilenrealREP FOR 
+kFROM 1UPTO anzspaltenREP iINCR 1;IF i>anzahlberechtigungenTHEN spaltenweise(
+blank)ELSE getline(f,berechtigung);spaltenweise(berechtigung)FI ;PER ;
+ausgfeld(j+1):=zeilePER ;forget(dateiname,quiet);ausgfeldlaengereal:=
+anzzeilenreal+2;ausgfeld(ausgfeldlaengereal):=text(blank,breite).END PROC 
+benutzeraufbereitenallgemein;PROC benutzerholen:kennung:=wert(fnrbenutzname);
+berechtigungen:=wert(fnrbenutzberecht);END PROC benutzerholen;END PACKET 
+benutzerliste;
+
diff --git a/app/schulis/2.2.1/src/0.listen.druckbearbeitung b/app/schulis/2.2.1/src/0.listen.druckbearbeitung
new file mode 100644
index 0000000..a7c47be
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.druckbearbeitung
@@ -0,0 +1,207 @@
+PACKET listendruckbearbeitungDEFINES einstellungderlistenausgabe,
+leseveraendertelisteneinstellung,einstellungdersonderlistenausgabe,
+leseveraendertesonderlisteneinstellung,
+einstellungderstartwertefueruebersichtsplaene,
+leseveraenderteuebersichtsplaneinstellung,lesenvorbereitendruck,seitedrucken,
+druckbreite,drucklaenge,initdruckkopf,druckvorbereiten,druckkopfschreiben,
+druckzeileschreiben,seitenwechsel,setzemitseitennummern,drucknachbereiten,
+drucknachbereitenohneausdrucken:LET niltext="",blank=" ",null=0,
+schulnameschluessel="Schulname",schulstrasseschluessel="Schulstraße",
+schulortschluessel="Schulort",seitennrtrenner="/",seitenwechselanweisung=
+"###page#",stdxeumel=2.54,stdyeumel=2.35,druckdateinamepre="liste.",
+dateilaenge=4073,seitenwechselzeilen=2,tatsdruckkopflaenge=7,
+eineueberschriftzeilen=1,zweiueberschriftenzeilen=2,ueberschriftenmaxzeilen=2
+,schreiben=FALSE ,lesen=TRUE ,schriftfeldnr=2,druckbreitefeldnr=3,
+drucklaengefeldnr=4,mindruckbreitefeldnr=4,startxfeldnr=5,startyfeldnr=6,
+startxfeldnruebplan=3,startyfeldnruebplan=4,maxdruckbreite=76,mindruckbreite=
+60,mindrucklaenge=26,maxstartxy=10.0,textnull="0.0",realnull=0.0,
+eingabenichtsinnvoll=162,stackgroessedrucktupel=3,DRUCKKOPF =STRUCT (ROW 
+tatsdruckkopflaengeTEXT zeile,BOOL zweiueberschriften);REAL VAR startx:=
+stdxeumel,starty:=stdyeumel,schreibflaeche;INT VAR druckzeilenbreite:=75,
+druckseitenlaenge:=60,testdruckzeilenbreite,testdruckseitenlaenge,
+anzahldrucktupel,bearbeitetedrucktupel,minbreitemitteilung;TEXT VAR 
+teststartx,teststarty;BOOL VAR werteinordnung,mitseitennummern;INT VAR 
+maxdateiseiten,schreibbaredrucklaenge,druckzeilennummer,druckseitennummer,
+druckdateinummer,zeilenzaehler;TEXT VAR schulname,schulstrasse,schulort,
+druckdateiname;DRUCKKOPF VAR druckkopf;FILE VAR druckdatei;INT PROC 
+druckbreite:druckzeilenbreiteEND PROC druckbreite;PROC 
+einstellungderlistenausgabe:LET maske="ms einstellung druck listen";
+druckzeilenbreite:=75;standardstartproc(maske);standardmaskenfeld(schrifttyp,
+schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr);
+standardmaskenfeld(text(druckseitenlaenge),drucklaengefeldnr);
+standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty)
+,startyfeldnr);standardnprocEND PROC einstellungderlistenausgabe;PROC 
+einstellungdersonderlistenausgabe:LET maske=
+"ms einstellung druck anschreiben";minbreitemitteilung:=70;druckzeilenbreite
+:=75;standardstartproc(maske);standardmaskenfeld(schrifttyp,schriftfeldnr);
+standardmaskenfeld(text(druckzeilenbreite),druckbreitefeldnr);
+standardmaskenfeld(text(minbreitemitteilung),mindruckbreitefeldnr);
+standardmaskenfeld(text(startx),startxfeldnr);standardmaskenfeld(text(starty)
+,startyfeldnr);standardnprocEND PROC einstellungdersonderlistenausgabe;PROC 
+einstellungdersonderlistenausgabe(INT CONST anzzeichen):LET maske=
+"ms einstellung druck anschreiben";minbreitemitteilung:=anzzeichen;
+druckzeilenbreite:=anzzeichen;standardstartproc(maske);standardmaskenfeld(
+schrifttyp,schriftfeldnr);standardmaskenfeld(text(druckzeilenbreite),
+druckbreitefeldnr);standardmaskenfeld(text(minbreitemitteilung),
+mindruckbreitefeldnr);standardmaskenfeld(text(startx),startxfeldnr);
+standardmaskenfeld(text(starty),startyfeldnr);standardnprocEND PROC 
+einstellungdersonderlistenausgabe;PROC 
+einstellungderstartwertefueruebersichtsplaene:LET maske=
+"ms einstellung startwerte";standardstartproc(maske);standardmaskenfeld(
+schrifttyp,schriftfeldnr);standardmaskenfeld(text(startx),startxfeldnruebplan
+);standardmaskenfeld(text(starty),startyfeldnruebplan);standardnprocEND PROC 
+einstellungderstartwertefueruebersichtsplaene;PROC 
+leseveraenderteuebersichtsplaneinstellung:werteinordnung:=TRUE ;teststartx:=
+compress(standardmaskenfeld(startxfeldnruebplan));teststarty:=compress(
+standardmaskenfeld(startyfeldnruebplan));ueberpruefendergegebenenwerte;IF 
+werteinordnungTHEN werteuebernehmen;IF fontexists(schrifttyp)THEN 
+schreibflaeche:=(16.0-(real(teststartx)-stdxeumel));druckzeilenbreite:=((
+xstepconversion(schreibflaeche))DIV (charpitch(font(schrifttyp)," ")))FI ;IF 
+druckzeilenbreite<mindruckbreiteTHEN druckzeilenbreite:=mindruckbreiteELIF 
+druckzeilenbreite>maxdruckbreiteTHEN druckzeilenbreite:=maxdruckbreiteFI ;
+enter(2)ELSE meldefehler;return(1)FI ;.ueberpruefendergegebenenwerte:IF (
+teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)>
+maxstartxyOR real(teststartx)<realnullTHEN infeld(startxfeldnruebplan);
+werteinordnung:=FALSE ELSE IF (teststarty<>textnullAND real(teststarty)=
+realnull)OR real(teststarty)>maxstartxyOR real(teststarty)<realnullTHEN 
+infeld(startyfeldnruebplan);werteinordnung:=FALSE ELSE werteinordnung:=TRUE 
+FI ;FI .werteuebernehmen:setzeschuliszeichensatz(standardmaskenfeld(
+schriftfeldnr));startx:=real(teststartx);starty:=real(teststarty).meldefehler
+:standardmeldung(eingabenichtsinnvoll,niltext).END PROC 
+leseveraenderteuebersichtsplaneinstellung;PROC 
+leseveraendertelisteneinstellung:werteinordnung:=TRUE ;testdruckzeilenbreite
+:=int(standardmaskenfeld(druckbreitefeldnr));testdruckseitenlaenge:=int(
+standardmaskenfeld(drucklaengefeldnr));teststartx:=compress(
+standardmaskenfeld(startxfeldnr));teststarty:=compress(standardmaskenfeld(
+startyfeldnr));ueberpruefendergegebenenwerte;IF werteinordnungTHEN 
+werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
+ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<mindruckbreiteTHEN 
+infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF testdruckseitenlaenge<
+mindrucklaengeTHEN infeld(drucklaengefeldnr);werteinordnung:=FALSE ELIF (
+teststartx<>textnullAND real(teststartx)=realnull)OR real(teststartx)>
+maxstartxyOR real(teststartx)<realnullTHEN infeld(startxfeldnr);
+werteinordnung:=FALSE ELIF (teststarty<>textnullAND real(teststarty)=realnull
+)OR real(teststarty)>maxstartxyOR real(teststarty)<realnullTHEN infeld(
+startyfeldnr);werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .
+werteuebernehmen:setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));
+druckzeilenbreite:=testdruckzeilenbreite;druckseitenlaenge:=
+testdruckseitenlaenge;maxdateiseiten:=dateilaengeDIV druckseitenlaenge;
+schreibbaredrucklaenge:=druckseitenlaenge-seitenwechselzeilen;startx:=real(
+teststartx);starty:=real(teststarty).meldefehler:standardmeldung(
+eingabenichtsinnvoll,niltext).END PROC leseveraendertelisteneinstellung;PROC 
+leseveraendertesonderlisteneinstellung:werteinordnung:=TRUE ;
+testdruckzeilenbreite:=int(standardmaskenfeld(druckbreitefeldnr));teststartx
+:=compress(standardmaskenfeld(startxfeldnr));teststarty:=compress(
+standardmaskenfeld(startyfeldnr));ueberpruefendergegebenenwerte;IF 
+werteinordnungTHEN werteuebernehmen;enter(2)ELSE meldefehler;return(1)FI .
+ueberpruefendergegebenenwerte:IF testdruckzeilenbreite<minbreitemitteilung
+THEN infeld(druckbreitefeldnr);werteinordnung:=FALSE ELIF (teststartx<>
+textnullAND real(teststartx)=realnull)OR real(teststartx)>maxstartxyOR real(
+teststartx)<realnullTHEN infeld(startxfeldnr);werteinordnung:=FALSE ELIF (
+teststarty<>textnullAND real(teststarty)=realnull)OR real(teststarty)>
+maxstartxyOR real(teststarty)<realnullTHEN infeld(startyfeldnr);
+werteinordnung:=FALSE ELSE werteinordnung:=TRUE FI .werteuebernehmen:
+setzeschuliszeichensatz(standardmaskenfeld(schriftfeldnr));druckzeilenbreite
+:=testdruckzeilenbreite;startx:=real(teststartx);starty:=real(teststarty).
+meldefehler:standardmeldung(eingabenichtsinnvoll,niltext).END PROC 
+leseveraendertesonderlisteneinstellung;PROC lesenvorbereitendruck(PROC (INT 
+CONST ,BOOL PROC ,INT VAR )mitscanner,BOOL PROC pruefungspeziell):
+anzahldrucktupel:=stackgroessedrucktupel;eineseiteeinlesen(PROC (INT CONST ,
+BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST ,INT VAR )multisearchforward,
+TRUE ,BOOL PROC pruefungspeziell,anzahldrucktupel);IF anzahldrucktupel>0THEN 
+einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc,
+TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE 
+setzebestandende(TRUE )FI END PROC lesenvorbereitendruck;PROC lesendruck(
+PROC (INT CONST ,BOOL PROC ,INT VAR )mitscanner,BOOL PROC pruefungspeziell):
+anzahldrucktupel:=stackgroessedrucktupel;eineseiteeinlesen(PROC (INT CONST ,
+BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST ,INT VAR )multisucc,TRUE ,
+BOOL PROC pruefungspeziell,anzahldrucktupel);IF anzahldrucktupel>0THEN 
+einendatensatzlesen(PROC (INT CONST ,BOOL PROC )scanstacksucc,PROC multisucc,
+TRUE ,BOOL PROC pruefungspeziell);bearbeitetedrucktupel:=1ELSE 
+setzebestandende(TRUE )FI END PROC lesendruck;TEXT PROC tb:IF bestandende
+THEN "Bestandsende"ELSE "kein Ende"FI ENDPROC tb;PROC dummy(INT CONST i,INT 
+VAR j):ENDPROC dummy;PROC dummy:ENDPROC dummy;PROC naechsteseiteeinlesen(
+BOOL PROC pruefungspeziell):lesendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )
+scansucc,BOOL PROC pruefungspeziell)ENDPROC naechsteseiteeinlesen;PROC 
+seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,BOOL 
+PROC pruefespeziell):seitedrucken(PROC (INT VAR )drucken,zeilenzahl,
+maxsatzlaenge,PROC dummy,BOOL PROC pruefespeziell)ENDPROC seitedrucken;PROC 
+seitedrucken(PROC (INT VAR )drucken,INT CONST zeilenzahl,maxsatzlaenge,PROC 
+bestandendesimulierenbeimerkmalwechsel,BOOL PROC pruefespeziell):
+zeilenzaehler:=null;WHILE NOT bestandendeCAND (zeilenzaehler<=zeilenzahl-
+maxsatzlaenge)CAND pruefespeziellREP drucken(zeilenzaehler);
+naechstensatzlesen;#IF NOT bestandendeTHEN #
+bestandendesimulierenbeimerkmalwechsel#FI #PER .naechstensatzlesen:IF 
+bearbeitetedrucktupel=anzahldrucktupelTHEN IF anzahldrucktupel<>
+stackgroessedrucktupelTHEN setzebestandende(TRUE )ELSE naechsteseiteeinlesen(
+BOOL PROC pruefespeziell)FI ELSE einendatensatzlesen(PROC (INT CONST ,BOOL 
+PROC )scanstacksucc,PROC multisucc,TRUE ,BOOL PROC pruefespeziell);
+bearbeitetedrucktupelINCR 1FI .END PROC seitedrucken;INT PROC drucklaenge(
+INT CONST ueberschriftenzeilen):schreibbaredrucklaenge-druckkopflaenge(
+ueberschriftenzeilen).END PROC drucklaenge;INT PROC drucklaenge:
+schreibbaredrucklaenge.END PROC drucklaenge;PROC initdruckkopf:initdruckkopf(
+niltext,niltext).END PROC initdruckkopf;PROC initdruckkopf(TEXT CONST 
+ueberschrift):initdruckkopf(ueberschrift,niltext).END PROC initdruckkopf;
+PROC initdruckkopf(TEXT CONST ueberschrift1,ueberschrift2):schulname:=
+schulkenndatum(schulnameschluessel);schulort:=schulkenndatum(
+schulortschluessel);druckkopf.zeile(1):=geblockt(schulname,date,
+druckzeilenbreite);IF (ueberschrift1=niltext)AND (ueberschrift2=niltext)THEN 
+teilbriefkopfELSE teillistenkopfFI ;druckkopf.zeile(4):=ueberschrift1;
+druckkopf.zeile(5):=ueberschrift2;druckkopf.zeile(6):=niltext;druckkopf.zeile
+(7):=niltext;druckkopf.zweiueberschriften:=ueberschrift2<>niltext.
+teilbriefkopf:schulstrasse:=schulkenndatum(schulstrasseschluessel);druckkopf.
+zeile(2):=schulstrasse;druckkopf.zeile(3):=schulort.teillistenkopf:druckkopf.
+zeile(2):=schulort;druckkopf.zeile(3):=niltext.END PROC initdruckkopf;PROC 
+druckvorbereiten:druckdateinummer:=0;druckseitennummer:=0;druckzeilennummer:=
+0;dateieroeffnen(schreiben).END PROC druckvorbereiten;PROC druckkopfschreiben
+:INT VAR i;FOR iFROM 1UPTO druckkopflaengeREPEAT druckzeileschreiben(
+druckkopf.zeile[i])END REPEAT .END PROC druckkopfschreiben;PROC 
+druckzeileschreiben(TEXT CONST inhalt):IF druckzeilennummer<
+schreibbaredrucklaengeTHEN put(druckdatei,inhalt);line(druckdatei);
+druckzeilennummerINCR 1END IF .END PROC druckzeileschreiben;PROC 
+seitenwechsel:trageggfleerzeilenein;putline(druckdatei,seitenwechselanweisung
+);druckseitennummerINCR 1;druckzeilennummer:=0;ggffolgedateieroeffnen(
+schreiben).trageggfleerzeilenein:INT CONST fehlendezeilen:=max(0,
+druckseitenlaenge-druckzeilennummer-1);line(druckdatei,fehlendezeilen).END 
+PROC seitenwechsel;PROC setzemitseitennummern(BOOL CONST ja):mitseitennummern
+:=ja.END PROC setzemitseitennummern;PROC drucknachbereiten:INT VAR i;
+ggfseitenwechsel;IF mitseitennummernTHEN seitennummerneintragenFI ;FOR iFROM 
+1UPTO druckdateinummerREPEAT druckdateiname:=druckdateinamepre+text(i);
+dateidruckenundloeschenEND REPEAT .ggfseitenwechsel:IF druckzeilennummer>0
+THEN seitenwechselEND IF .dateidruckenundloeschen:print(druckdateiname);
+forget(druckdateiname,quiet).END PROC drucknachbereiten;PROC 
+drucknachbereitenohneausdrucken:ggfseitenwechsel;IF mitseitennummernTHEN 
+seitennummerneintragenFI .ggfseitenwechsel:IF druckzeilennummer>0THEN 
+seitenwechselEND IF .END PROC drucknachbereitenohneausdrucken;PROC 
+seitennummerneintragen:IF mehralseineseiteTHEN 
+trageseitennummernindruckdateieinEND IF .mehralseineseite:druckseitennummer>1
+.trageseitennummernindruckdateiein:INT CONST seiten:=druckseitennummer;
+druckdateinummer:=0;dateieroeffnen(lesen);FOR druckseitennummerFROM 1UPTO 
+seitenREPEAT down(druckdatei,seitenwechselanweisung);trageseitennummerein;
+ggffolgedateieroeffnen(lesen)END REPEAT .trageseitennummerein:writerecord(
+druckdatei,seitennummer+seitenwechselanweisung);down(druckdatei).seitennummer
+:TEXT CONST seitennr:=nr;blanks+seitennr.nr:text(druckseitennummer)+
+seitennrtrenner+text(seiten).blanks:(druckzeilenbreite-seitennrlaenge)*blank.
+seitennrlaenge:length(seitennr).END PROC seitennummerneintragen;PROC 
+ggffolgedateieroeffnen(BOOL CONST lesen):IF druckseitennummerMOD 
+maxdateiseiten=0THEN dateieroeffnen(lesen)END IF .END PROC 
+ggffolgedateieroeffnen;PROC dateieroeffnen(BOOL CONST lesen):druckdateinummer
+INCR 1;druckdateiname:=druckdateinamepre+text(druckdateinummer);IF lesenTHEN 
+lesedateieroeffnenELSE schreibdateieroeffnenEND IF .lesedateieroeffnen:
+druckdatei:=sequentialfile(modify,druckdateiname);down(druckdatei,
+seitenwechselanweisung).schreibdateieroeffnen:forget(druckdateiname,quiet);
+druckdatei:=sequentialfile(output,druckdateiname);maxdateiseiten:=dateilaenge
+DIV druckseitenlaenge;schreibbaredrucklaenge:=druckseitenlaenge;IF 
+mitseitennummernTHEN schreibbaredrucklaenge:=schreibbaredrucklaenge-
+seitenwechselzeilenFI ;setzeanzahlderzeichenprozeile(druckzeilenbreite);
+schrift(schrifttyp);start(startx,starty);schreibesteuerzeichenzeile(
+druckdateiname);putline(druckdatei,seitenwechselanweisung).END PROC 
+dateieroeffnen;INT PROC druckkopflaenge(INT CONST ueberschriftenzeilen):IF 
+ueberschriftenzeilen>ueberschriftenmaxzeilenTHEN errorstop("max "+text(
+ueberschriftenmaxzeilen)+" Ueberschriften im Druckkopf");0ELSE 
+tatsdruckkopflaenge-ueberschriftenmaxzeilen+ueberschriftenzeilenEND IF .END 
+PROC druckkopflaenge;INT PROC druckkopflaenge:druckkopflaenge(
+ueberschriftenzeilen).ueberschriftenzeilen:IF druckkopf.zweiueberschriften
+THEN zweiueberschriftenzeilenELSE eineueberschriftzeilenEND IF .END PROC 
+druckkopflaenge;END PACKET listendruckbearbeitung
+
diff --git a/app/schulis/2.2.1/src/0.listen.faecher b/app/schulis/2.2.1/src/0.listen.faecher
new file mode 100644
index 0000000..650efde
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.faecher
@@ -0,0 +1,86 @@
+PACKET faecherlistenDEFINES faecherlispezielleteile:LET faechereingangsmaske=
+"mu liste einfach eingang",spaltentrenner=" ",faecheranfpos=2,spalte1breite=5
+,spalte2breite=35,spalte3breite=10,spalte4breite=11,niltext="",blank=" ",null
+=0,strich="-",ueberschriftenzeilen=2,mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=109,ausgkopflaenge=2,ausgfeldlaenge=1,
+anzahlderobjekteprobildschirm=17;TEXT VAR faecherueberschrift:=
+"Liste der Fächer",fach,fachbezeichnung,fachgruppe,fachbereich,anfbuchstabe,
+neueranfbuchstabe:="",auswahlnichtsinnvoll,bearbeitetwerden;TEXT CONST 
+leerzeile:=bildbreite*blank,textueberschrift:=("Fach"+2*blank+
+"Fachbezeichnung"+21*blank+"Fachgruppe"+blank+"Fachbereich");INT VAR 
+eingabestatus,lesestart,bildanfang,spalte2druckbreite,druckzeilenzahl;INT 
+CONST aktuelleindexnr:=dnrfaecher,fnrfach:=fnrffach,fnrfachbezeichnung:=
+fnrffachbez,fnrfachgruppe:=fnrffachgrp,fnrfachbereich:=fnrffachbereich;LET 
+AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,
+AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR 
+ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC 
+multistop;PROC faecherlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+faecherdialogvorbereitenCASE 2:faechereingabenrichtigCASE 3:
+faecherlistenvorbereitenCASE 4:faecherdruckvorbereitenCASE 5:
+faecherseitedruckenCASE 6:faecherbildschirmvorbereitenCASE 7:
+faecherseitezeigenENDSELECT .END PROC faecherlispezielleteile;PROC 
+faecherdialogvorbereiten:faecherueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(faechereingangsmaske,faecheranfpos)END PROC 
+faecherdialogvorbereiten;PROC faechereingabenrichtig:LET fnrausgdrucker=2,
+fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus=0THEN setzeeingabetest(TRUE );
+setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext)ELSE meldefehler;
+setzeeingabetest(FALSE )FI .meldefehler:meldungstext(mnrauswahlnichtsinnvoll,
+auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC 
+faechereingabenrichtig;PROC faecherlistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);lesestart:=fnrfach;inittupel(dnrfaecher);
+setzeidentiwert("");initobli(anzahlderobjekteprobildschirm);
+objektlistestarten(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(
+NOT multistopCOR b);END PROC faecherlistenvorbereiten;PROC 
+faecherbildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren(
+faecherueberschrift);bildanfang:=fnrausganf;setzebildanfangsposition(
+bildanfang);INT VAR i;setzespaltenbreite(bildbreite);spaltenweise(
+textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;spaltenweise(leerzeile);ausgfeld(1):=zeile;ausgfeld(1
+)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4);
+initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2breite);setzespaltenbreite(
+spalte3breite);setzespaltenbreite(spalte4breite);END PROC 
+faecherbildschirmvorbereiten;PROC faecherseitezeigen:blaettern(PROC (INT 
+CONST )faecherdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC 
+faecherseitezeigen;PROC faecherdatenzeigen(INT CONST x):faecherdatenholen;
+faecherdatenaufbereitenbild;faecherdatenaufbildschirm.END PROC 
+faecherdatenzeigen;PROC faecherdatenholen:fach:=wert(fnrfach);fachbezeichnung
+:=wert(fnrfachbezeichnung);IF wert(fnrfachgruppe)=text(null)THEN fachgruppe:=
+strichELSE fachgruppe:=wert(fnrfachgruppe);FI ;IF wert(fnrfachbereich)=
+niltextTHEN fachbereich:=strichELSE fachbereich:=wert(fnrfachbereich)FI ;END 
+PROC faecherdatenholen;PROC faecherdatenaufbereitenbild:spaltenweise(fach);
+spaltenweise(fachbezeichnung);spaltenweise(fachgruppe);spaltenweise(
+fachbereich);END PROC faecherdatenaufbereitenbild;PROC 
+faecherdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END 
+PROC faecherdatenaufbildschirm;PROC faecherdruckvorbereiten:setzebestandende(
+FALSE );anfbuchstabe:=" ";druckvorbereiten;variablenfuerdrucksetzen;
+initdruckkopf(zentriert(faecherueberschrift,druckbreite),zentriert(length(
+faecherueberschrift)*"-",druckbreite));initspalten;setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2breite);setzespaltenbreite(
+spalte3breite);setzespaltenbreite(spalte4breite);holemeldung;inittupel(
+dnrfaecher);initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL 
+PROC ,INT VAR )scanforward,BOOL PROC multistop);.holemeldung:meldungstext(
+mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+faecherdruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):=
+textueberschrift;ausgkopfdruck(2):=leerzeile;END PROC initausgabekopfdruck;
+PROC faecherseitedrucken:faecherueberschriftdrucken;seitedrucken(PROC (INT 
+VAR )lehrerdrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop);
+seitenwechsel.END PROC faecherseitedrucken;PROC faecherueberschriftdrucken:
+INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP 
+druckzeileschreiben(ausgkopfdruck(i))PER END PROC faecherueberschriftdrucken;
+PROC lehrerdrucken(INT VAR zeilenzaehler):LET markiert="#";faecherdatenholen;
+ggflmeldunganfbuchstabe;faecheraufbereitendruck;zeilenzaehlerINCR 
+ausgfeldlaenge;faecherindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:
+neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,neueranfbuchstabe+
+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC lehrerdrucken;PROC 
+faecheraufbereitendruck:spaltenweise(fach);spaltenweise(fachbezeichnung);
+spaltenweise(fachgruppe);spaltenweise(fachbereich);ausgfeld(1):=zeile;END 
+PROC faecheraufbereitendruck;PROC faecherindruckdatei:INT VAR i;FOR iFROM 1
+UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER .END PROC 
+faecherindruckdatei;END PACKET faecherlisten
+
diff --git a/app/schulis/2.2.1/src/0.listen.klassengruppen b/app/schulis/2.2.1/src/0.listen.klassengruppen
new file mode 100644
index 0000000..7543dad
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.klassengruppen
@@ -0,0 +1,104 @@
+PACKET klassengruppenlistenDEFINES klassengruppenspezielleteile:LET 
+klassengruppeneingangsmaske="mu liste einfach eingang",spaltentrenner="  ",
+klassengruppenanfpos=2,spaltenbreite1=12,spaltenbreite2=7,niltext="",blank=
+" ",strich="-",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2,ausgfeldlaenge=
+1,anzahlderobjekteprobildschirm=5,mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=352;TEXT CONST spaltentext1:="Klassengruppe",spaltentext2
+:="Bezeichnung  Zusammensetzung";TEXT VAR klassengrueberschrift:=
+"Liste der Raumgruppen",schuelergrfuerzeile1,schuelergrfuerzeile2,
+schuelergrfuerzeile3,klassengruppe,alteklassengruppe:="",anfbuchstabe,
+neueranfbuchstabe:="",teiltextmeldung:=
+"die Klassengruppe dem Anfangsbuchstaben:";INT VAR eingabestatus,bildanfang,
+druckzeilenzahl;LET AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW 
+ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR 
+ausgfeld;AUSGKOPF VAR ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC 
+multistop:TRUE END PROC multistop;PROC klassengruppenspezielleteile(INT 
+CONST nr):SELECT nrOF CASE 1:klassengrdialogvorbereitenCASE 2:
+klassengreingabenrichtigCASE 3:klassengrlistenvorbereitenCASE 4:
+klassengrdruckvorbereitenCASE 5:klassengrseitedruckenCASE 6:
+klassengrbildschirmvorbereitenCASE 7:klassengrseitezeigenENDSELECT .END PROC 
+klassengruppenspezielleteile;PROC klassengrdialogvorbereiten:
+klassengrueberschrift:=text(vergleichsknoten);setzeanfangswerte(
+klassengruppeneingangsmaske,klassengruppenanfpos)END PROC 
+klassengrdialogvorbereiten;PROC klassengreingabenrichtig:LET fnrausgdrucker=2
+,fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus=0THEN setzeeingabetest(TRUE );
+setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE meldefehler
+;setzeeingabetest(FALSE )FI ;.meldefehler:standardmeldung(
+mnrauswahlnichtsinnvoll,niltext).END PROC klassengreingabenrichtig;PROC 
+klassengrlistenvorbereiten:BOOL VAR b;initspalten;setzespaltentrenner(
+spaltentrenner);inittupel(dnrklassengruppen);setzeidentiwert("");initobli(
+anzahlderobjekteprobildschirm);objektlistestarten(dnrklassengruppen,"",
+fnrkgklassengrp,TRUE ,b);setzebestandende(NOT multistopCOR b);END PROC 
+klassengrlistenvorbereiten;PROC klassengrbildschirmvorbereiten:LET fnrausganf
+=2;standardkopfmaskeaktualisieren(klassengrueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);initspalten;
+setzespaltenbreite(bildbreite);spaltenweise(spaltentext1);ausgfeld(1):=zeile;
+ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(spaltentext2);
+ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+spaltenweise(blank);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;setzebildanfangsposition(5);spaltenbreitensetzenEND 
+PROC klassengrbildschirmvorbereiten;PROC klassengrseitezeigen:blaettern(PROC 
+(INT CONST )klassengrdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END 
+PROC klassengrseitezeigen;PROC klassengrdatenzeigen(INT CONST x):
+klassengrdatenholen;klassengrdatenaufbereitenbild1;
+klassengrdatenaufbildschirm;klassengrdatenaufbereitenbild2;
+klassengrdatenaufbildschirm;klassengrdatenaufbereitenbild3;
+klassengrdatenaufbildschirmEND PROC klassengrdatenzeigen;PROC 
+klassengrdatenaufbereitenbild1:INT VAR y:=1;spaltenweise(klassengruppe);
+spaltenweise(subtext(schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(
+subtext(schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile1,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile1,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild1;
+PROC klassengrdatenaufbereitenbild2:INT VAR y:=1;spaltenweise(blank);
+spaltenweise(subtext(schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(
+subtext(schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile2,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile2,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild2;
+PROC klassengrdatenaufbereitenbild3:INT VAR y:=1;spaltenweise(blank);
+spaltenweise(subtext(schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(
+subtext(schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile3,y,y+5));yINCR 6;spaltenweise(subtext(
+schuelergrfuerzeile3,y,y+5));yINCR 6;END PROC klassengrdatenaufbereitenbild3;
+PROC klassengrdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END 
+PROC klassengrdatenaufbildschirm;PROC klassengrdruckvorbereiten:
+setzebestandende(FALSE );anfbuchstabe:=" ";druckvorbereiten;
+variablenfuerdrucksetzen;initdruckkopf(zentriert(klassengrueberschrift,
+druckbreite),zentriert(length(klassengrueberschrift)*strich,druckbreite));
+initausgabekopfdruck;inittupel(dnrklassengruppen);spaltenbreitensetzen;
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistop);.variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen)-ausgkopflaenge.END PROC klassengrdruckvorbereiten;PROC 
+klassengrseitedrucken:klassengrueberschriftdrucken;seitedrucken(PROC (INT 
+VAR )klassengrdatendrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop
+);seitenwechsel.END PROC klassengrseitedrucken;PROC 
+klassengrueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO 
+ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER ;ausgfeld(1):=
+zeile;druckzeileschreiben(ausgfeld(1))END PROC klassengrueberschriftdrucken;
+PROC klassengrdatendrucken(INT VAR zeilenzaehler):LET markiert="#";
+klassengrdatenholen;ggflmeldunganfbuchstabe;klassengrdatenaufbereitenbild1;
+zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;IF 
+schuelergrfuerzeile2<>niltextTHEN klassengrdatenaufbereitenbild2;
+zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;IF 
+schuelergrfuerzeile3<>niltextTHEN klassengrdatenaufbereitenbild3;
+zeilenzaehlerINCR ausgfeldlaenge;klassengrindruckdatei;FI FI ;.
+ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .
+anfbuchstabegeaendert:neueranfbuchstabe:=klassengruppeSUB 1;anfbuchstabe<>
+neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,
+teiltextmeldung+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.
+END PROC klassengrdatendrucken;PROC initausgabekopfdruck:ausgkopfdruck(1):=
+spaltentext1;ausgkopfdruck(2):=spaltentext2;END PROC initausgabekopfdruck;
+PROC klassengrindruckdatei:ausgfeld(1):=zeile;INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC 
+klassengrindruckdatei;PROC spaltenbreitensetzen:INT VAR z;initspalten;
+setzespaltenbreite(spaltenbreite1);FOR zFROM 1UPTO 5REP setzespaltenbreite(
+spaltenbreite2);PER END PROC spaltenbreitensetzen;PROC klassengrdatenholen:
+klassengruppe:=wert(fnrkgklassengrp);schuelergrfuerzeile1:=subtext(wert(
+fnrkgschuelergrp),1,30);schuelergrfuerzeile2:=subtext(wert(fnrkgschuelergrp),
+31,60);schuelergrfuerzeile3:=subtext(wert(fnrkgschuelergrp),61,90);END PROC 
+klassengrdatenholen;END PACKET klassengruppenlisten;
+
diff --git a/app/schulis/2.2.1/src/0.listen.raumgruppen b/app/schulis/2.2.1/src/0.listen.raumgruppen
new file mode 100644
index 0000000..9d8b0f4
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.raumgruppen
@@ -0,0 +1,97 @@
+PACKET raumgruppenlistenDEFINES raumgruppenspezielleteile:LET 
+raumgruppeneingangsmaske="mu liste einfach eingang",spaltentrenner="  ",
+raumgruppenanfpos=2,spaltenbreite1=4,spaltenbreite2=12,niltext="",blank=" ",
+strich="-",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2,ausgfeldlaenge=1,
+anzahlderobjekteprobildschirm=8,mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=352;TEXT VAR raumgrueberschrift:="Liste der Raumgruppen",
+spaltentext:="Raumgruppe   Räume",raeumefuerzeile1,raeumefuerzeile2,raum1,
+raum2,raum3,raum4,raum5,raum6,raum7,raum8,raum9,raum10,raum11,raum12,raum13,
+raum14,raum15,raumgruppe,alteraumgruppe:="",anfbuchstabe,neueranfbuchstabe:=
+"",teiltextmeldung:="die Raumgruppe dem Anfangsbuchstaben:";INT VAR 
+eingabestatus,bildanfang,spalte2druckbreite,druckzeilenzahl;LET AUSGFELD =
+ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW 
+ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;
+AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop;
+PROC raumgruppenspezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+raumgrdialogvorbereitenCASE 2:raumgreingabenrichtigCASE 3:
+raumgrlistenvorbereitenCASE 4:raumgrdruckvorbereitenCASE 5:raumgrseitedrucken
+CASE 6:raumgrbildschirmvorbereitenCASE 7:raumgrseitezeigenENDSELECT .END 
+PROC raumgruppenspezielleteile;PROC raumgrdialogvorbereiten:
+raumgrueberschrift:=text(vergleichsknoten);setzeanfangswerte(
+raumgruppeneingangsmaske,raumgruppenanfpos)END PROC raumgrdialogvorbereiten;
+PROC raumgreingabenrichtig:LET fnrausgdrucker=2,fnrausgbild=3;standardpruefe(
+5,fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0
+THEN setzeeingabetest(TRUE );setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);ELSE meldefehler;setzeeingabetest(FALSE )FI ;.
+meldefehler:standardmeldung(mnrauswahlnichtsinnvoll,niltext).END PROC 
+raumgreingabenrichtig;PROC raumgrlistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);inittupel(dnrraumgruppen);setzeidentiwert
+("");initobli(anzahlderobjekteprobildschirm);objektlistestarten(
+dnrraumgruppen,"",fnrrgraumgrp,TRUE ,b);setzebestandende(NOT multistopCOR b);
+END PROC raumgrlistenvorbereiten;PROC raumgrbildschirmvorbereiten:LET 
+fnrausganf=2;standardkopfmaskeaktualisieren(raumgrueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);initspalten;
+setzespaltenbreite(bildbreite);spaltenweise(spaltentext);ausgfeld(1):=zeile;
+ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(blank);ausgfeld
+(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+setzebildanfangsposition(4);spaltenbreitensetzenEND PROC 
+raumgrbildschirmvorbereiten;PROC raumgrseitezeigen:blaettern(PROC (INT CONST 
+)raumgrdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC 
+raumgrseitezeigen;PROC raumgrdatenzeigen(INT CONST x):raumgrdatenholen;
+raumgrdatenaufbereitenbild1;raumgrdatenaufbildschirm;
+raumgrdatenaufbereitenbild2;raumgrdatenaufbildschirmEND PROC 
+raumgrdatenzeigen;PROC raumgrdatenaufbereitenbild1:spaltenweise(raumgruppe);
+spaltenweise(raum1);spaltenweise(raum2);spaltenweise(raum3);spaltenweise(
+raum4);spaltenweise(raum5);spaltenweise(raum6);spaltenweise(raum7);
+spaltenweise(raum8);spaltenweise(raum9);spaltenweise(raum10);END PROC 
+raumgrdatenaufbereitenbild1;PROC raumgrdatenaufbereitenbild2:spaltenweise(
+blank);spaltenweise(raum11);spaltenweise(raum12);spaltenweise(raum13);
+spaltenweise(raum14);spaltenweise(raum15);spaltenweise(blank);spaltenweise(
+blank);spaltenweise(blank);spaltenweise(blank);spaltenweise(blank);END PROC 
+raumgrdatenaufbereitenbild2;PROC raumgrdatenaufbildschirm:INT VAR i;FOR i
+FROM 1UPTO ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeins;PER ;END PROC raumgrdatenaufbildschirm;PROC 
+raumgrdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" ";
+druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(zentriert(
+raumgrueberschrift,druckbreite),zentriert(length(raumgrueberschrift)*strich,
+druckbreite));initausgabekopfdruck;inittupel(dnrraumgruppen);
+spaltenbreitensetzen;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+raumgrdruckvorbereiten;PROC raumgrseitedrucken:raumgrueberschriftdrucken;
+seitedrucken(PROC (INT VAR )raumgrdatendrucken,druckzeilenzahl,ausgfeldlaenge
+,BOOL PROC multistop);seitenwechsel.END PROC raumgrseitedrucken;PROC 
+raumgrueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO 
+ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END PROC 
+raumgrueberschriftdrucken;PROC raumgrdatendrucken(INT VAR zeilenzaehler):LET 
+markiert="#";raumgrdatenholen;ggflmeldunganfbuchstabe;
+raumgrdatenaufbereitenbild1;zeilenzaehlerINCR ausgfeldlaenge;
+raumgrindruckdatei;IF raeumefuerzeile2<>niltextTHEN 
+raumgrdatenaufbereitenbild2;zeilenzaehlerINCR ausgfeldlaenge;
+raumgrindruckdatei;FI ;.ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN 
+meldunganfbuchstabeFI .anfbuchstabegeaendert:neueranfbuchstabe:=raumgruppe
+SUB 1;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(
+mnrbearbeitetwerden,teiltextmeldung+neueranfbuchstabe+markiert);anfbuchstabe
+:=neueranfbuchstabe.END PROC raumgrdatendrucken;PROC initausgabekopfdruck:
+TEXT VAR unterstreichung:=druckbreite*strich;ausgkopfdruck(1):=spaltentext;
+ausgkopfdruck(2):=unterstreichung;END PROC initausgabekopfdruck;PROC 
+raumgrindruckdatei:ausgfeld(1):=zeile;INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC 
+raumgrindruckdatei;PROC spaltenbreitensetzen:initspalten;setzespaltenbreite(
+spaltenbreite2);INT VAR x;INT CONST zehnraeumedererstenzeile:=10;FOR xFROM 1
+UPTO zehnraeumedererstenzeileREP setzespaltenbreite(spaltenbreite1);PER ;END 
+PROC spaltenbreitensetzen;PROC raumgrdatenholen:INT VAR x:=1;raumgruppe:=wert
+(fnrrgraumgrp);raeumefuerzeile1:=subtext(wert(fnrrgraeume),1,40);
+raeumefuerzeile2:=subtext(wert(fnrrgraeume),41,60);raum1:=subtext(
+raeumefuerzeile1,x,x+4);xINCR 4;raum2:=subtext(raeumefuerzeile1,x,x+4);xINCR 
+4;raum3:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum4:=subtext(
+raeumefuerzeile1,x,x+4);xINCR 4;raum5:=subtext(raeumefuerzeile1,x,x+4);xINCR 
+4;raum6:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum7:=subtext(
+raeumefuerzeile1,x,x+4);xINCR 4;raum8:=subtext(raeumefuerzeile1,x,x+4);xINCR 
+4;raum9:=subtext(raeumefuerzeile1,x,x+4);xINCR 4;raum10:=subtext(
+raeumefuerzeile1,x,x+4);xINCR 4;raum11:=subtext(raeumefuerzeile2,x,x+4);x
+INCR 4;raum12:=subtext(raeumefuerzeile2,x,x+4);xINCR 4;raum13:=subtext(
+raeumefuerzeile2,x,x+4);xINCR 4;raum14:=subtext(raeumefuerzeile2,x,x+4);x
+INCR 4;raum15:=subtext(raeumefuerzeile2,x,x+4);xINCR 4;alteraumgruppe:=
+raumgruppe;END PROC raumgrdatenholen;END PACKET raumgruppenlisten;
+
diff --git a/app/schulis/2.2.1/src/0.listen.schlueabku b/app/schulis/2.2.1/src/0.listen.schlueabku
new file mode 100644
index 0000000..54a928d
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.schlueabku
@@ -0,0 +1,69 @@
+PACKET schluesselundabkulisteDEFINES schlueabkulieingang,
+schlueabkulispezielleteile:LET niltext="",null=0,ueberschriftenzeilen=1,
+spalte1breite=10,anzspaltentrenner=1,ausgfeldlaenge=1,AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,schlueabkulieingangsmaske="mu liste einfach eingang",
+schlueabkulianfpos=2;#LET dnrschluessel=137,fnrschlsachgebiet=138,
+fnrschlschluessel=139,fnrschllangtext=140,dnrgesamtbestand=--,fnrbestandname=
+--,fnrbestandid=--;#INT CONST spalte2bildbreite:=bildbreite-anzspaltentrenner
+-spalte1breite;INT VAR spalte2druckbreite,druckzeilenzahl,bildanf,
+eingabestatus;TEXT VAR schlueabkuliueberschrift,bestand,schluesselabk,
+schluessellangtext;AUSGFELD VAR ausgfeld;#INT VAR sachgebiet;#BOOL PROC 
+multistop:BOOL VAR b;b:=wert(fnrschlsachgebiet)=bestand;bENDPROC multistop;
+BOOL PROC multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);b
+ENDPROC multistopdruck;PROC schlueabkulieingang(TEXT CONST spezbestand):
+bestand:=spezbestand;eingangsmaskezeigenundparameterlesen(PROC 
+schlueabkulispezielleteile).END PROC schlueabkulieingang;PROC 
+schlueabkulispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+schlueabkulidialogvorbereitenCASE 2:schlueabkulieingabenrichtigCASE 3:
+schlueabkulilistenvorbereitenCASE 4:schlueabkulidruckvorbereitenCASE 5:
+schlueabkuliseitedruckenCASE 6:schlueabkulibildschirmvorbereitenCASE 7:
+schlueabkuliseitezeigenENDSELECT .END PROC schlueabkulispezielleteile;PROC 
+schlueabkulidialogvorbereiten:schlueabkuliueberschrift:=text(vergleichsknoten
+);setzeanfangswerte(schlueabkulieingangsmaske,schlueabkulianfpos).END PROC 
+schlueabkulidialogvorbereiten;PROC schlueabkulieingabenrichtig:LET 
+fnrausgdrucker=2,fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,
+null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);
+setzeeingabetest(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);setzeeingabetest(TRUE )FI .END PROC 
+schlueabkulieingabenrichtig;PROC bestandidbestimmenundalssachgebieteintragen:
+#jf##systemdbon;putwert(fnrbestandname,bestand);search(dnrgesamtbestand,TRUE 
+);IF dbstatus=okTHEN sachgebiet:=intwert(fnrbestandid)ELSE sachgebiet:=maxint
+FI ;#systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,bestand)
+ENDPROC bestandidbestimmenundalssachgebieteintragen;PROC 
+schlueabkulilistenvorbereiten:BOOL VAR b:=FALSE ;
+bestandidbestimmenundalssachgebieteintragen;initobli(19);#A nzahlproS eite#
+reinitparsing;setzeidentiwert("");objektlistestarten(dnrschluessel,"",
+fnrschlschluessel,TRUE ,b);setzebestandende(b)END PROC 
+schlueabkulilistenvorbereiten;PROC schlueabkulibildschirmvorbereiten:LET 
+fnrausganf=2;standardkopfmaskeaktualisieren(schlueabkuliueberschrift);
+initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite(
+spalte2bildbreite);bildanf:=fnrausganf;setzebildanfangsposition(bildanf).END 
+PROC schlueabkulibildschirmvorbereiten;PROC schlueabkuliseitezeigen:blaettern
+(PROC (INT CONST )abkuerzungzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop);
+END PROC schlueabkuliseitezeigen;PROC abkuerzungzeigen(INT CONST dummy):
+abkuerzungholen;abkuerzungaufbereiten;abkuerzungaufbildschirm.END PROC 
+abkuerzungzeigen;PROC abkuerzungaufbildschirm:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND 
+REPEAT .END PROC abkuerzungaufbildschirm;PROC schlueabkulidruckvorbereiten:
+druckvorbereiten;variablenfuerdrucksetzen;initspalten;setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2druckbreite);initdruckkopf(zentriert
+(schlueabkuliueberschrift,druckbreite));
+bestandidbestimmenundalssachgebieteintragen;lesenvorbereitendruck(PROC (INT 
+CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopdruck).
+variablenfuerdrucksetzen:spalte2druckbreite:=druckbreite-anzspaltentrenner-
+spalte1breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen).END PROC 
+schlueabkulidruckvorbereiten;PROC schlueabkuliseitedrucken:
+schlueabkuliueberschriftdrucken;seitedrucken(PROC (INT VAR )abkuerzungdrucken
+,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopdruck);seitenwechsel.END 
+PROC schlueabkuliseitedrucken;PROC schlueabkuliueberschriftdrucken:
+druckkopfschreiben;END PROC schlueabkuliueberschriftdrucken;PROC 
+abkuerzungdrucken(INT VAR zeilenzaehler):abkuerzungholen;
+abkuerzungaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;abkuerzungindruckdatei
+.END PROC abkuerzungdrucken;PROC abkuerzungindruckdatei:druckzeileschreiben(
+ausgfeld(1)).END PROC abkuerzungindruckdatei;PROC abkuerzungaufbereiten:
+schreibeabkuerzunglangtext.schreibeabkuerzunglangtext:spaltenweise(
+schluesselabk);spaltenweise(schluessellangtext);ausgfeld(1):=zeile.END PROC 
+abkuerzungaufbereiten;PROC abkuerzungholen:schluesselabk:=wert(
+fnrschlschluessel);schluessellangtext:=wert(fnrschllangtext);END PROC 
+abkuerzungholen;END PACKET schluesselundabkuliste;
+
diff --git a/app/schulis/2.2.1/src/0.listen.schuelergruppen b/app/schulis/2.2.1/src/0.listen.schuelergruppen
new file mode 100644
index 0000000..cbef1c3
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.schuelergruppen
@@ -0,0 +1,109 @@
+PACKET schuelergruppenlistenDEFINES schuelergruplispezielleteile:LET 
+AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,
+AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR 
+ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;LET schuelergruppeneingangsmaske=
+"ms liste schuelergruppen",ausgfeldlaenge=1,anzahlderobjekteprobildschirm=17,
+ueberschriftenzeilen=2,ausgkopflaenge=2,spaltentrenner=" ",
+schuelergruppenanfpos=2,jgstspalte1breite=14,zugspalte2breite=9,
+lehrerspalte3breite=15,stellvspalte4breite=15,strich="/",niltext="",blank=" "
+,null=0,mnrauswahlnichtsinnvoll=56;LET textsj="Schuljahr",texthj=
+"Schulhalbjahr";TEXT VAR schuelergruppenueberschrift:="",schuljahr,halbjahr,
+jahrgangsstufe,altejahrgangsstufe:="",bearbeitungsschuljahr,
+bearbeitungshalbjahr,zugtutor,klassenlehrer,stellvertreter,
+auswahlnichtsinnvoll;TEXT CONST leerzeile:=bildbreite*blank,textueberschrift
+:=("Jahrgangsstufe"+blank+"Zug/Tutor"+blank+"Klassenleiter"+3*blank+
+"Stellvertreter");INT VAR eingabestatus,bildanfang,spalte2druckbreite,
+druckzeilenzahl;INT CONST aktuelleindexnr:=dnraktschuelergruppen;BOOL VAR 
+aktuelleshjgewaehlt;BOOL PROC multistop:BOOL VAR b;IF dbstatus=okTHEN b:=(
+bearbeitungshalbjahr=wert(fnrsgrphj)AND bearbeitungsschuljahr=wert(fnrsgrpsj)
+)ELSE b:=FALSE FI ;bEND PROC multistop;BOOL PROC multistopsim:
+setzebestandende(FALSE );BOOL VAR b:=multistop;setzebestandende(NOT b);bEND 
+PROC multistopsim;PROC schuelergruplispezielleteile(INT CONST nr):SELECT nr
+OF CASE 1:schuelergruppendialogvorbereitenCASE 2:
+schuelergruppeneingabenrichtigCASE 3:schuelergruppenlistenvorbereitenCASE 4:
+schuelergruppendruckvorbereitenCASE 5:schuelergruppenseitedruckenCASE 6:
+schuelergruppenbildschirmvorbereitenCASE 7:schuelergruppenseitezeigen
+ENDSELECT .END PROC schuelergruplispezielleteile;PROC 
+schuelergruppendialogvorbereiten:schuelergruppenueberschrift:=text(
+vergleichsknoten);setzeanfangswerte(schuelergruppeneingangsmaske,
+schuelergruppenanfpos)END PROC schuelergruppendialogvorbereiten;PROC 
+schuelergruppeneingabenrichtig:LET fnrausggeplanteshj=2,fnrausgaktuelleshj=3,
+fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5,fnrausgdrucker,fnrausgbild,
+null,niltext,eingabestatus);IF eingabestatus=0THEN standardpruefe(5,
+fnrausggeplanteshj,fnrausgaktuelleshj,null,niltext,eingabestatus);IF 
+eingabestatus=0THEN gewaehlteshalbjahrmerken;setzeeingabetest(TRUE );
+setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext)ELSE meldefehler;
+setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest(FALSE )FI .
+meldefehler:meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);
+standardmeldung(auswahlnichtsinnvoll,niltext).gewaehlteshalbjahrmerken:
+aktuelleshjgewaehlt:=standardmaskenfeld(fnrausgaktuelleshj)<>niltext.END 
+PROC schuelergruppeneingabenrichtig;PROC schuelergruppenlistenvorbereiten:
+BOOL VAR b;initspalten;setzespaltentrenner(spaltentrenner);
+bearbeitungsschuljahr:=schulkenndatum(textsj);bearbeitungshalbjahr:=
+schulkenndatum(texthj);IF NOT (aktuelleshjgewaehlt)THEN 
+geplanteshjundsjberechnen(bearbeitungshalbjahr,bearbeitungsschuljahr)FI ;
+inittupel(dnraktschuelergruppen);setzeidentiwert("");initobli(
+anzahlderobjekteprobildschirm);parsenooffields(6);putwert(fnrsgrpsj,
+bearbeitungsschuljahr);putwert(fnrsgrphj,bearbeitungshalbjahr);
+setzescanendewert("255");objektlistestarten(aktuelleindexnr,
+bearbeitungsschuljahr,fnrsgrpjgst,TRUE ,b);setzebestandende(NOT multistopCOR 
+b);END PROC schuelergruppenlistenvorbereiten;PROC 
+schuelergruppenbildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(schuelergruppenueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite(
+bildbreite);spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN 
+ausgabepos;erhoeheausgabeposumeins;spaltenweise(leerzeile);ausgfeld(1):=zeile
+;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4)
+;initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite(
+jgstspalte1breite);setzespaltenbreite(zugspalte2breite);setzespaltenbreite(
+lehrerspalte3breite);setzespaltenbreite(stellvspalte4breite);END PROC 
+schuelergruppenbildschirmvorbereiten;PROC schuelergruppenseitezeigen:
+blaettern(PROC (INT CONST )schuelergruppendatenzeigen,aktion,TRUE ,TRUE ,
+BOOL PROC multistop)END PROC schuelergruppenseitezeigen;PROC 
+schuelergruppendatenzeigen(INT CONST x):schuelergruppendatenholen;
+schuelergruppendatenaufbereitenbild;schuelergruppendatenaufbildschirm;END 
+PROC schuelergruppendatenzeigen;PROC schuelergruppendatenholen:schuljahr:=
+wert(fnrsgrpsj);halbjahr:=wert(fnrsgrphj);jahrgangsstufe:=wert(fnrsgrpjgst);
+zugtutor:=wert(fnrsgrpkennung);klassenlehrer:=wert(fnrsgrplehrer);
+stellvertreter:=wert(fnrsgrpstellvlehrer);END PROC schuelergruppendatenholen;
+PROC schuelergruppendatenaufbereitenbild:IF length(jahrgangsstufe)=1THEN 
+spaltenweise(13*blank+jahrgangsstufe);ELSE spaltenweise(12*blank+
+jahrgangsstufe);FI ;spaltenweise(zugtutor);spaltenweise(klassenlehrer);
+spaltenweise(stellvertreter);END PROC schuelergruppendatenaufbereitenbild;
+PROC schuelergruppendatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeins;PER ;END PROC schuelergruppendatenaufbildschirm;PROC 
+schuelergruppendruckvorbereiten:setzebestandende(FALSE );druckvorbereiten;
+variablenfuerdrucksetzen;TEXT VAR schjaufbereitet:=text(bearbeitungsschuljahr
+,2)+strich+text(bearbeitungsschuljahr,2,3),halbjaufbereitet:=
+bearbeitungshalbjahr+". Halbjahr";schuelergruppenueberschrift:=
+"Liste der Schülergruppen im Schuljahr "+schjaufbereitet+blank+
+halbjaufbereitet;initdruckkopf(zentriert(schuelergruppenueberschrift,
+druckbreite),zentriert(length(schuelergruppenueberschrift)*"-",druckbreite));
+initspalten;setzespaltenbreite(jgstspalte1breite);setzespaltenbreite(
+zugspalte2breite);setzespaltenbreite(lehrerspalte3breite);setzespaltenbreite(
+stellvspalte4breite);inittupel(dnraktschuelergruppen);initausgabekopfdruck;
+putwert(fnrsgrpsj,bearbeitungsschuljahr);putwert(fnrsgrphj,
+bearbeitungshalbjahr);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistopsim);.variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+schuelergruppendruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):=
+textueberschrift;ausgkopfdruck(2):=leerzeileEND PROC initausgabekopfdruck;
+PROC schuelergruppenseitedrucken:schuelergruppenueberschriftdrucken;
+seitedrucken(PROC (INT VAR )schuelergruppendrucken,druckzeilenzahl,
+ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END PROC 
+schuelergruppenseitedrucken;PROC schuelergruppenueberschriftdrucken:INT VAR i
+;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben(
+ausgkopfdruck(i))PER END PROC schuelergruppenueberschriftdrucken;PROC 
+schuelergruppendrucken(INT VAR zeilenzaehler):schuelergruppendatenholen;IF 
+altejahrgangsstufe<>jahrgangsstufeTHEN spaltenweise(" ");spaltenweise(" ");
+spaltenweise(" ");spaltenweise(" ");ausgfeld(1):=zeile;zeilenzaehlerINCR 
+ausgfeldlaenge;schuelergruppenindruckdateiFI ;schuelergruppenaufbereitendruck
+;zeilenzaehlerINCR ausgfeldlaenge;schuelergruppenindruckdatei.END PROC 
+schuelergruppendrucken;PROC schuelergruppenaufbereitendruck:
+setzespaltentrenner(spaltentrenner);schuelergruppendatenaufbereitenbild;
+ausgfeld(1):=zeile;altejahrgangsstufe:=jahrgangsstufe;END PROC 
+schuelergruppenaufbereitendruck;PROC schuelergruppenindruckdatei:INT VAR i;
+FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END 
+PROC schuelergruppenindruckdatei;END PACKET schuelergruppenlisten
+
diff --git a/app/schulis/2.2.1/src/0.listen.schulen b/app/schulis/2.2.1/src/0.listen.schulen
new file mode 100644
index 0000000..c23ade2
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.schulen
@@ -0,0 +1,87 @@
+PACKET schulenlistenDEFINES schulenspezielleteile:LET niltext="",blank=" ",
+mittestrich="-",ueberschriftenzeilen=1,#bestand="c05 schulen",#spalte1breite=
+8,spalte2breite=8,spalte4breite=17,anzspaltentrenner=3,ausgkopflaenge=3,
+ausgfeldlaenge=5,#maxdbwerte=100,##anzdbwerte=8,#AUSGFELD =ROW ausgfeldlaenge
+TEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,schuleneingangsmaske=
+"mu liste einfach eingang",schulenanfpos=2;#LET dnrschulen=120,fnrschkennung=
+121,fnrschname=122,fnrschart=123,fnrschamtlnr=127,fnrschbundesland=128,
+fnrschstrnr=124,fnrschplzort=125,fnrschtelnr=126;#INT CONST spalte3bildbreite
+:=bildbreite-anzspaltentrenner-spalte1breite-spalte2breite-spalte4breite;INT 
+VAR spalte3druckbreite,spalte3breite,druckzeilenzahl,bildanf,eingabestatus;
+TEXT VAR schulenueberschrift,schulkennung,schulart,amtlschulkennnr,schulname,
+schulstrnr,schulnat,schulplz,schulort,schulland,schultelnr,anfbuchstabe,
+neueranfbuchstabe;TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*
+mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL PROC multistop:
+TRUE ENDPROC multistop;BOOL PROC multistopsim:setzebestandende(FALSE );TRUE 
+ENDPROC multistopsim;PROC schulenspezielleteile(INT CONST nr):SELECT nrOF 
+CASE 1:schulendialogvorbereitenCASE 2:schuleneingabenrichtigCASE 3:
+schulenlistenvorbereitenCASE 4:schulendruckvorbereitenCASE 5:
+schulenseitedruckenCASE 6:schulenbildschirmvorbereitenCASE 7:
+schulenseitezeigenENDSELECT .END PROC schulenspezielleteile;PROC 
+schulendialogvorbereiten:schulenueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(schuleneingangsmaske,schulenanfpos).END PROC 
+schulendialogvorbereiten;PROC schuleneingabenrichtig:LET fnrausgdrucker=2,
+fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,0,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);
+setzeeingabetest(TRUE )END IF .END PROC schuleneingabenrichtig;PROC 
+schulenlistenvorbereiten:BOOL VAR b;inittupel(dnrschulen);initobli(3);
+reinitparsing;setzeidentiwert("");objektlistestarten(dnrschulen,"",
+fnrschkennung,TRUE ,b);setzebestandende(b)END PROC schulenlistenvorbereiten;
+PROC schulenbildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(schulenueberschrift);initspalten;spalte3breite
+:=spalte3bildbreite;ausgfeld(5):=bildbreite*blank;setzespaltenbreiten;
+initausgabekopf(bildstrich);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO 
+ausgkopflaengeREPEAT ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ;
+setzebildanfangsposition(bildanf).END PROC schulenbildschirmvorbereiten;PROC 
+schulenseitezeigen:blaettern(PROC (INT CONST )schulezeigen,aktion,TRUE ,
+FALSE ,BOOL PROC multistop);END PROC schulenseitezeigen;PROC schulezeigen(
+INT CONST dummy):schuleholen;schuleaufbereiten;schuleaufbildschirm.END PROC 
+schulezeigen;PROC schuleaufbildschirm:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND 
+REPEAT .END PROC schuleaufbildschirm;PROC schulendruckvorbereiten:
+anfbuchstabe:=niltext;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf
+(zentriert(schulenueberschrift,druckbreite));initspalten;spalte3breite:=
+spalte3druckbreite;ausgfeld(5):=druckbreite*blank;setzespaltenbreiten;
+initausgabekopf(druckstrich);inittupel(dnrschulen);setzebestandende(FALSE );
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistopsim).variablenfuerdrucksetzen:druckstrich:=druckbreite*
+mittestrich;spalte3druckbreite:=druckbreite-anzspaltentrenner-spalte1breite-
+spalte2breite-spalte4breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen
+)-ausgkopflaenge.END PROC schulendruckvorbereiten;PROC schulenseitedrucken:
+schulenueberschriftdrucken;seitedrucken(PROC (INT VAR )schuledrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END 
+PROC schulenseitedrucken;PROC schulenueberschriftdrucken:druckkopfschreiben;
+INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i
+))END REPEAT .END PROC schulenueberschriftdrucken;PROC schuledrucken(INT VAR 
+zeilenzaehler):LET druckmeldung=101,markiert="#";schuleholen;
+ggfmeldunganfbuchstabe;schuleaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuleindruckdatei.ggfmeldunganfbuchstabe:IF anfangsbuchstabegeaendertTHEN 
+meldunganfbuchstabeEND IF .anfangsbuchstabegeaendert:neueranfbuchstabe:=
+schulkennungSUB 1;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:
+standardmeldung(druckmeldung,neueranfbuchstabe+markiert);anfbuchstabe:=
+neueranfbuchstabe.END PROC schuledrucken;PROC schuleindruckdatei:INT VAR i;
+FOR iFROM 1UPTO ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END 
+REPEAT .END PROC schuleindruckdatei;PROC setzespaltenbreiten:
+setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite);
+setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite);END PROC 
+setzespaltenbreiten;PROC initausgabekopf(TEXT CONST strich):LET kennung=
+"Kennung",art="Schulart",name="Name",amtlnr="amtl. Nr.",adresse="Adresse",
+telnr="Telefon";spaltenweise(kennung);spaltenweise(art);spaltenweise(name);
+spaltenweise(blank);ausgkopf(1):=zeile;spaltenweise(blank);spaltenweise(
+amtlnr);spaltenweise(adresse);spaltenweise(telnr);ausgkopf(2):=zeile;ausgkopf
+(3):=strich.END PROC initausgabekopf;PROC schuleholen:schulkennung:=wert(
+fnrschkennung);schulname:=wert(fnrschname);schulart:=wert(fnrschart);
+amtlschulkennnr:=wert(fnrschamtlnr);schulland:=wert(fnrschbundesland);
+schulstrnr:=wert(fnrschstrnr);schulort:=wert(fnrschplzort);schultelnr:=wert(
+fnrschtelnr).END PROC schuleholen;PROC schuleaufbereiten:LET deutsch="D";
+schreibekennungartname;schreibeamtlnrstrtelnr;schreibeortland.
+schreibekennungartname:spaltenweise(schulkennung);spaltenweise(schulart);
+spaltenweise(schulname);spaltenweise(blank);ausgfeld(1):=zeile.
+schreibeamtlnrstrtelnr:spaltenweise(blank);spaltenweise(amtlschulkennnr);
+spaltenweise(schulstrnr);spaltenweise(schultelnr);ausgfeld(2):=zeile.
+schreibeortland:spaltenweise(blank);spaltenweise(blank);spaltenweise(schulort
+);spaltenweise(blank);ausgfeld(3):=zeile;spaltenweise(blank);spaltenweise(
+blank);spaltenweise(schulland);spaltenweise(blank);ausgfeld(4):=zeile.END 
+PROC schuleaufbereiten;END PACKET schulenlisten;
+
diff --git a/app/schulis/2.2.1/src/0.listen.steuerung b/app/schulis/2.2.1/src/0.listen.steuerung
new file mode 100644
index 0000000..bafd51b
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.steuerung
@@ -0,0 +1,67 @@
+PACKET listensteuerungDEFINES eingangsmaskezeigenundparameterlesen,
+listedruckenoderzeigenggflweitereaktionlesen,weitereaktionlesen,
+aufbildschirmblaettern,druckbearbeitung,setzeanfangswerte,setzeausgabedrucker
+,ausgabedrucker,setzeeingabetest,setzebildanfangsposition,ausgabepos,
+erhoeheausgabeposumeins,seitenzaehler,erhoeheseitenzaehlerumeins,aktion,
+bildbreite,bildlaenge:LET namebildausgabemaske="mu liste bildausgabe",
+datenexistierennicht=59,warteaufforderung=69,listewirdgedruckt=58,
+zurnachprozedur=1,niltext="",blank=" ";INT VAR bildanfangsposition,
+aktuelleposition,zeiger,richtung,seite;TEXT VAR nameauswahlmaske;BOOL VAR 
+eingabenrichtig,ausgdrucker;TEXT CONST leerzeilebild:=bildbreite*blank;PROC 
+eingangsmaskezeigenundparameterlesen(PROC (INT CONST )spezielleteile):
+enablestop;dialogvorbereiten;dialogstarten.dialogvorbereiten:spezielleteile(1
+);standardstartproc(nameauswahlmaske).dialogstarten:infeld(aktuelleposition);
+standardnproc.END PROC eingangsmaskezeigenundparameterlesen;PROC 
+listedruckenoderzeigenggflweitereaktionlesen(PROC (INT CONST )spezielleteile)
+:eingabenueberpruefen;IF eingabenrichtigTHEN werteauswahlausundgibausELSE 
+wiederholeauswahlFI .eingabenueberpruefen:spezielleteile(2).
+werteauswahlausundgibaus:meldewarten;vorbereitungenliste;IF bestandendeTHEN 
+meldekeinbestand;zurueckzumdialogELIF ausgdruckerTHEN druckbearbeitung(
+zurnachprozedur,PROC spezielleteile)ELSE 
+bildschirmvorbereitenundersteseitezeigen(PROC spezielleteile)FI .
+vorbereitungenliste:spezielleteile(3).meldewarten:standardmeldung(
+warteaufforderung,niltext).meldekeinbestand:standardmeldung(
+datenexistierennicht,niltext).wiederholeauswahl:zurueckzumdialog.
+zurueckzumdialog:return(1).END PROC 
+listedruckenoderzeigenggflweitereaktionlesen;PROC druckbearbeitung(INT CONST 
+ruecksprung,PROC (INT CONST )spezielleteile):IF NOT (ruecksprung=
+zurnachprozedur)THEN setzeausgabedrucker(TRUE )FI ;seite:=1;
+ausgebenaufdrucker(PROC spezielleteile);zurueckzumdialog.zurueckzumdialog:IF 
+ruecksprung=zurnachprozedurTHEN return(ruecksprung)ELSE enter(ruecksprung)FI 
+.END PROC druckbearbeitung;PROC ausgebenaufdrucker(PROC (INT CONST )
+spezielleteile):setzemitseitennummern(TRUE );druckvorbereiten;druckeeineseite
+;WHILE NOT bestandendeREP nimmnaechsteseite;druckeeineseitePER ;
+meldelistewirdgedruckt;drucknachbereiten.druckvorbereiten:spezielleteile(4).
+druckeeineseite:spezielleteile(5).nimmnaechsteseite:seiteINCR 1.
+meldelistewirdgedruckt:standardmeldung(listewirdgedruckt,niltext).END PROC 
+ausgebenaufdrucker;PROC bildschirmvorbereitenundersteseitezeigen(PROC (INT 
+CONST )spezielleteile):standardstartproc(namebildausgabemaske);spezielleteile
+(6);richtung:=#1;#3;seitezeigen(PROC spezielleteile);dialogstarten.
+dialogstarten:weitereaktionlesen.END PROC 
+bildschirmvorbereitenundersteseitezeigen;PROC weitereaktionlesen:maskendialog
+.maskendialog:aktuelleposition:=21;infeld(aktuelleposition);standardnproc.
+END PROC weitereaktionlesen;PROC aufbildschirmblaettern(INT CONST was,PROC (
+INT CONST )spezielleteile):richtung:=was;standardkopfmaskeaktualisieren;
+seitezeigen(PROC spezielleteile);zurueckzumdialog.zurueckzumdialog:return(1).
+END PROC aufbildschirmblaettern;PROC setzeanfangswerte(TEXT CONST 
+eingangsmaske,INT CONST anfpos):nameauswahlmaske:=eingangsmaske;
+aktuelleposition:=anfpos;END PROC setzeanfangswerte;PROC seitezeigen(PROC (
+INT CONST )spezielleteile):LET fnrausgende=20;aktuelleposition:=
+bildanfangsposition;spezielleteile(7);ggfrestbildloeschen.ggfrestbildloeschen
+:IF neuesbildangefangenTHEN restbildloeschenFI .neuesbildangefangen:
+aktuelleposition>bildanfangsposition.restbildloeschen:FOR zeigerFROM 
+aktuellepositionUPTO fnrausgendeREP leerzeilebildIN zeigerPER .END PROC 
+seitezeigen;PROC setzeausgabedrucker(BOOL CONST b):ausgdrucker:=bEND PROC 
+setzeausgabedrucker;BOOL PROC ausgabedrucker:ausgdruckerEND PROC 
+ausgabedrucker;PROC setzeeingabetest(BOOL CONST b):eingabenrichtig:=bEND 
+PROC setzeeingabetest;PROC setzebildanfangsposition(INT CONST anfangsposition
+):bildanfangsposition:=anfangspositionEND PROC setzebildanfangsposition;INT 
+PROC ausgabepos:aktuellepositionEND PROC ausgabepos;PROC 
+erhoeheausgabeposumeins:aktuellepositionINCR 1END PROC 
+erhoeheausgabeposumeins;INT PROC seitenzaehler:seiteEND PROC seitenzaehler;
+PROC erhoeheseitenzaehlerumeins:seiteINCR 1END PROC 
+erhoeheseitenzaehlerumeins;INT PROC aktion:richtungEND PROC aktion;LET 
+bildzeilenbreite=78,bildseitenlaenge=23,bildkopflaenge=4;INT CONST bildbreite
+:=bildzeilenbreite,bildlaenge:=bildseitenlaenge-bildkopflaenge;END PACKET 
+listensteuerung;
+
diff --git a/app/schulis/2.2.1/src/0.listen.werkzeuge b/app/schulis/2.2.1/src/0.listen.werkzeuge
new file mode 100644
index 0000000..011db81
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listen.werkzeuge
@@ -0,0 +1,29 @@
+PACKET listenwerkzeugeDEFINES initspalten,setzespaltenbreite,
+setzespaltentrenner,spaltenweise,zeile,geblockt,zentriert,zweistellig,
+vergleichsdatum:LET maxanzspalten=20,null=0,blank=" ",niltext=""#,andenanfang
+=1,ansende=2,vorwaerts=3,rueckwaerts=4,naechstenlesen=1;#;TEXT VAR 
+zwischenpuffer,spaltentrenner;INT VAR aktspalte,aktmaxanzspalten;ROW 
+maxanzspaltenINT VAR spaltenbreite;PROC initspalten:INT VAR i;FOR iFROM 1
+UPTO maxanzspaltenREP spaltenbreite(i):=nullPER ;aktmaxanzspalten:=null;
+aktspalte:=1;zwischenpuffer:=niltext;spaltentrenner:=blank;END PROC 
+initspalten;PROC setzespaltenbreite(INT CONST breite):aktmaxanzspaltenINCR 1;
+IF aktmaxanzspalten<=maxanzspaltenTHEN spaltenbreite(aktmaxanzspalten):=
+breiteFI ;END PROC setzespaltenbreite;PROC setzespaltentrenner(TEXT CONST 
+trenner):spaltentrenner:=trennerEND PROC setzespaltentrenner;PROC 
+spaltenweise(TEXT CONST t):IF aktspalte>aktmaxanzspaltenTHEN aktspalte:=1;
+zwischenpuffer:=niltextFI ;zwischenpuffer:=zwischenpuffer+text(t,
+spaltenbreite(aktspalte));IF aktspalte<aktmaxanzspaltenTHEN zwischenpuffer:=
+zwischenpuffer+spaltentrennerFI ;aktspalteINCR 1END PROC spaltenweise;TEXT 
+PROC zeile:zwischenpufferEND PROC zeile;TEXT PROC geblockt(TEXT CONST links,
+rechts,INT CONST breite):links+blanks+rechts.blanks:(breite-length(links)-
+length(rechts))*blank.END PROC geblockt;TEXT PROC zentriert(TEXT CONST text,
+INT CONST breite):INT CONST blankanzahl:=breite-length(text);TEXT CONST 
+blanks:=blankausgleich;IF blankanzahlgeradeTHEN blanks+text+blanksELSE blanks
++text+blanks+blankFI .blankausgleich:(blankanzahlDIV 2)*blank.
+blankanzahlgerade:blankanzahlMOD 2=0.END PROC zentriert;TEXT PROC zweistellig
+(TEXT CONST jahrgang):TEXT VAR puffer;puffer:=text(null)+jahrgang;subtext(
+puffer,length(puffer)-1).END PROC zweistellig;INT PROC vergleichsdatum(INT 
+CONST jahre):INT VAR hilfe;hilfe:=int(subtext(date,7,8));hilfeDECR jahre;
+datum(subtext(date,1,6)+text(hilfe)).END PROC vergleichsdatum;END PACKET 
+listenwerkzeuge;
+
diff --git a/app/schulis/2.2.1/src/0.listenweise grundfunktionen b/app/schulis/2.2.1/src/0.listenweise grundfunktionen
new file mode 100644
index 0000000..7b7d32c
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listenweise grundfunktionen
@@ -0,0 +1,51 @@
+PACKET listenweisegrundfunktionenDEFINES holevergleichssg,istzulaessigesg,
+sgeinerjgst,initgruppenwechsel,gruppenwechsel,eingangsbehandlunglistenweise,
+startebildschirmblock,bildschirmblock:LET blank=" ",niltext="";LET maxgw=10;
+LET bestandtrenner="/";LET schuljahrkey="Schuljahr",schulhalbjahrkey=
+"Schulhalbjahr",halbjahr1="1",halbjahr2="2";BOOL VAR nichtzuende,starten,sek2
+;INT VAR bestand;INT VAR schuelerzahl;ROW maxgwTEXT VAR gw;TEXT VAR 
+aktuelleschuelergruppen;TEXT VAR vergljgst,letztejgst;TEXT VAR schuljahr,
+schulhalbjahr;PROC holevergleichssg(TEXT CONST jgst,BOOL CONST aktuell):
+schuljahr:=schulkenndatum(schuljahrkey);schulhalbjahr:=schulkenndatum(
+schulhalbjahrkey);aktuelleschuelergruppen:=niltext;vergljgst:=jgst;inittupel(
+dnraktschuelergruppen);setzerichtigeschulkenndaten;IF jgst<>niltextTHEN 
+statleseschleife(dnraktschuelergruppen,jgst,niltext,fnrsgrpjgst,
+fnrsgrpkennung,PROC pruefesg)ELSE sek2:=FALSE ;letztejgst:=niltext;
+statleseschleife(dnraktschuelergruppen,jgst,niltext,fnrsgrpjgst,
+fnrsgrpkennung,PROC allesg)FI ;.setzerichtigeschulkenndaten:IF NOT aktuell
+THEN IF schulhalbjahr=halbjahr1THEN schulhalbjahr:=halbjahr2ELSE schuljahr:=
+subtext(schuljahr,3,4);schuljahrCAT text(int(schuljahr)+1);schulhalbjahr:=
+halbjahr1FI ;FI ;putwert(fnrsgrpsj,schuljahr);putwert(fnrsgrphj,schulhalbjahr
+);.END PROC holevergleichssg;BOOL PROC istzulaessigesg(TEXT CONST sg):pos(
+aktuelleschuelergruppen,sg)>0END PROC istzulaessigesg;TEXT PROC sgeinerjgst:
+aktuelleschuelergruppenEND PROC sgeinerjgst;PROC pruefesg(BOOL VAR schluss):
+TEXT CONST sg:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung);IF dbstatus
+=0CAND subtext(sg,1,2)=vergljgstTHEN neueaktuelleschuelergruppe(sg)ELSE 
+schluss:=TRUE FI .END PROC pruefesg;PROC allesg(BOOL VAR schluss):IF dbstatus
+<>0OR wert(fnrsgrpsj)<>schuljahrOR wert(fnrsgrphj)<>schulhalbjahrTHEN schluss
+:=TRUE ELSE TEXT CONST sg:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung)
+;neueaktuelleschuelergruppe(sg)FI END PROC allesg;PROC 
+neueaktuelleschuelergruppe(TEXT CONST sg):IF aktuelleschuelergruppen=niltext
+THEN anhaengenELSE trennen;anhaengenFI .anhaengen:aktuelleschuelergruppenCAT 
+sg;.trennen:aktuelleschuelergruppenCAT bestandtrenner.END PROC 
+neueaktuelleschuelergruppe;PROC initgruppenwechsel:INT VAR i;FOR iFROM 1UPTO 
+maxgwREP gw(i):=niltextPER .END PROC initgruppenwechsel;PROC gruppenwechsel(
+TEXT CONST gwneu,INT CONST gwalt,INT CONST laenge,incr,INT VAR aktuellesfeld)
+:IF gruppenwechselliegtvorTHEN gruppenwechselzeigenELSE leeresfeldFI ;
+weiterzaehlen.gruppenwechselliegtvor:(schuelerzahl=1)COR (gw(gwalt)<>gwneu).
+gruppenwechselzeigen:standardmaskenfeld(text(gwneu,laenge),aktuellesfeld);gw(
+gwalt):=gwneu.leeresfeld:standardmaskenfeld(laenge*blank,aktuellesfeld).
+weiterzaehlen:aktuellesfeldINCR incr.END PROC gruppenwechsel;PROC 
+eingangsbehandlunglistenweise:standardvproc(maske(vergleichsknoten))END PROC 
+eingangsbehandlunglistenweise;PROC startebildschirmblock(INT CONST best,sz):
+nichtzuende:=TRUE ;bestand:=best;starten:=TRUE ;schuelerzahl:=sz.END PROC 
+startebildschirmblock;PROC bildschirmblock(PROC schuelerzeigen,BOOL PROC (
+INT CONST )pruefungspeziell,INT CONST was):INT VAR lv,anzahl;IF startenTHEN 
+erstenzeigen;neuerblock;erhoehezaehlerELSE neuerblockFI .erstenzeigen:
+schuelerzeigen;changeindex.erhoehezaehler:schuelerzahlINCR 1.neuerblock:
+anzahl:=schuelerzahl;starten:=FALSE ;IF nichtzuendeTHEN multisucc(bestand,
+anzahl);FOR lvFROM 1UPTO anzahlREP schuelerlesen;nichtzuende:=
+pruefungspeziell(was);IF nichtzuendeTHEN schuelerzeigenELSE LEAVE neuerblock
+FI PER ;nichtzuende:=anzahl=schuelerzahlFI ;.schuelerlesen:stackentry(lv).
+END PROC bildschirmblock;END PACKET listenweisegrundfunktionen;
+
diff --git a/app/schulis/2.2.1/src/0.listenweise klassen erf b/app/schulis/2.2.1/src/0.listenweise klassen erf
new file mode 100644
index 0000000..9b3c02e
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.listenweise klassen erf
@@ -0,0 +1,215 @@
+PACKET listenweiseklassenerfDEFINES neueinfuegenklassen,entfernenklassen,
+bearbeitungklassen,klassennichtspeichern,klassenspeichern:LET tofather=1,
+tograndfather=2,niltext="",blank=" ",null=0,trenner="/",meldtrenner="#";LET 
+standardanfang=1,standardeinstieg=4;LET jgst5=5,jgst13=13,erstejgst="05";LET 
+erstesfeld=3,felderprozeile=4,klassenproseite=18;LET meldbestleer=59,
+meldnichtspeichern=63,meldplausi=57,meldwertzulang=60,meldwarten=69,
+meldspeicherung=132,meldspeicherfehler=131,meldfalscheauswahl=56,
+meldfortschreibung=140,meldkeinelehrer=141,meldfalscherlehrer=142,meldschonda
+=143,meldnichtleer=144,meldnichtda=134,meldloeschung=145;LET maxlaengekennung
+=4,maxlaengeintegabez=4;LET pruefartalternative=5,pruefartgrenzen=3;LET 
+fnrjgst=4,fnrakt=3,fnrgepl=2,fnrfort2=5,fnrfortneu=6;LET keysj="Schuljahr",
+keyshj="Schulhalbjahr";LET wertaktuell="aktuell",wertgeplant="geplant";LET 
+paraphentrenner="
";LET vaaendern=1,vaneu=2,valoeschen=3;LET hj1="1",hj2="2";
+BOOL VAR nochwelcheda,akthalbjahr,fortschreibungzweiteshalbjahr,
+fortschreibungneuesschuljahr,fortschreibung;INT VAR klassenzahl,aktuellesfeld
+,pruefstatus,verarbeitungsart;ROW klassenproseiteTEXT VAR kennung;ROW 
+klassenproseiteTEXT VAR altedaten;TEXT VAR neuesschuljahr,neueshalbjahr,
+vergleichsjgst,lehrerparaphen:=niltext,schuljahr:=niltext,halbjahr:=niltext;
+PROC eingangsbildschirmpruefen(BOOL CONST neu):reinitparsing;
+ankreuzfelderpruefen;IF eingangsbildschirmokTHEN jgstpruefen;IF 
+eingangsbildschirmokTHEN fortschreibungpruefenFI FI .ankreuzfelderpruefen:
+standardpruefe(pruefartalternative,fnrgepl,fnrakt,null,niltext,pruefstatus).
+jgstpruefen:akthalbjahr:=standardmaskenfeld(fnrakt)<>niltext;standardpruefe(
+pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus);.
+fortschreibungpruefen:vergleichsjgst:=jgstaufber(standardmaskenfeld(fnrjgst))
+;fortschreibungzweiteshalbjahr:=standardmaskenfeld(fnrfort2)<>niltext;
+fortschreibungneuesschuljahr:=standardmaskenfeld(fnrfortneu)<>niltext;
+fortschreibung:=(fortschreibungzweiteshalbjahrCOR 
+fortschreibungneuesschuljahr);IF (fortschreibungzweiteshalbjahrCAND 
+fortschreibungneuesschuljahr)THEN pruefstatus:=fnrfort2ELIF (fortschreibung
+CAND akthalbjahr)THEN pruefstatus:=fnraktELIF (fortschreibungCAND (NOT neu))
+THEN pruefstatus:=meldfortschreibungELIF ((NOT akthalbjahr)CAND (
+vergleichsjgst=erstejgst))CAND fortschreibungneuesschuljahrTHEN pruefstatus:=
+fnrjgstFI ;IF pruefstatus=meldfortschreibungTHEN standardmeldung(pruefstatus,
+niltext);pruefstatus:=fnrjgstELIF pruefstatus<>nullTHEN standardmeldung(
+meldfalscheauswahl,niltext)FI .eingangsbildschirmok:pruefstatus=0.END PROC 
+eingangsbildschirmpruefen;PROC neueinfuegenklassen:verarbeitungsart:=vaneu;
+eingangsbehandlungEND PROC neueinfuegenklassen;PROC entfernenklassen:
+verarbeitungsart:=valoeschen;eingangsbehandlungEND PROC entfernenklassen;
+PROC bearbeitungklassen:verarbeitungsart:=vaaendern;eingangsbehandlungEND 
+PROC bearbeitungklassen;PROC eingangsbehandlung:BOOL CONST neueklassen:=(
+verarbeitungsart=vaneu);eingangsbildschirmpruefen(neueklassen);IF 
+eingangsbildschirmokTHEN neuesschuljahrhalbjahrerrechnen;
+initialisierungenvornehmen;blocklesenundausgeben;IF keinemehrdaTHEN 
+bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE 
+eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmok:pruefstatus=0.
+initialisierungenvornehmen:bestandsetzen;plausipruefungvorbereiten;
+standardstartproc(maske(vergleichsknoten)).bestandsetzen:infeld(fnrjgst);IF 
+verarbeitungsart=vaaendernTHEN pruefebestandELSE nochwelcheda:=trueFI .
+pruefebestand:inittupel(dnraktschuelergruppen);klassengrunddateninpuffer;
+search(dnraktschuelergruppen,FALSE );IF keineklassezudieserjgstTHEN 
+bestandleermelden;return(tofather);LEAVE eingangsbehandlungELSE nochwelcheda
+:=trueFI .keineklassezudieserjgst:(dbstatus<>null)COR ((jgstaufber(wert(
+fnrsgrpjgst))<>vergleichsjgst)COR (wert(fnrsgrpsj)<>neuesschuljahr)COR (wert(
+fnrsgrphj)<>neueshalbjahr)).plausipruefungvorbereiten:standardmeldung(
+meldwarten,niltext);.keinemehrda:NOT nochwelcheda.bestandleermelden:
+standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:infeld(pruefstatus
+).END PROC eingangsbehandlung;PROC klassennichtspeichern:nichtspeichernmelden
+;neuerblock.nichtspeichernmelden:standardmeldung(meldnichtspeichern,niltext);
+pause(10).END PROC klassennichtspeichern;PROC klassenspeichern:SELECT 
+verarbeitungsartOF CASE vaaendern:aenderungenspeichernCASE vaneu:
+neueklassenspeichernCASE valoeschen:klassenloeschenEND SELECT .
+aenderungenspeichern:speicherungdurchfuehren(PROC (BOOL VAR )
+pruefeaenderungsplausi,false,true,false).neueklassenspeichern:
+speicherungdurchfuehren(PROC (BOOL VAR )pruefeneuplausi,true,false,false).
+klassenloeschen:speicherungdurchfuehren(PROC (BOOL VAR )pruefeloeschplausi,
+false,false,true).END PROC klassenspeichern;PROC pruefeloeschplausi(BOOL VAR 
+dateninordnung):INT VAR satzindex:=erstesfeld,plausind;FOR plausindFROM 1
+UPTO klassenzahlREP pruefezeile;IF NOT dateninordnungTHEN fehlermeldung;
+LEAVE pruefeloeschplausiFI ;satzindexINCR felderprozeilePER .pruefezeile:IF 
+standardmaskenfeld(satzindex)<>niltextTHEN dateninordnung:=
+schuelergruppevorhandenFI .schuelergruppevorhanden:klassengrunddateninpuffer;
+putwert(fnrsgrpkennung,standardmaskenfeld(satzindex));search(
+dnraktschuelergruppen,TRUE );aktuellesfeld:=satzindex;(dbstatus=null).
+fehlermeldung:IF (akthalbjahr)CAND (dbstatus=null)THEN TEXT VAR pruefsg:=
+vergleichsjgst+standardmaskenfeld(satzindex);standardmeldung(meldnichtleer,
+pruefsg+meldtrenner)ELSE standardmeldung(meldnichtda,standardmaskenfeld(
+satzindex)+meldtrenner)FI .END PROC pruefeloeschplausi;PROC pruefeneuplausi(
+BOOL VAR dateninordnung):BOOL VAR parapheninordnung;INT VAR satzindex:=
+erstesfeld,plausind;IF lehrerparaphen=niltextTHEN holeallelehrerparaphenFI ;
+FOR plausindFROM 1UPTO klassenzahlREP IF standardmaskenfeld(satzindex)<>
+niltextTHEN IF length(standardmaskenfeld(satzindex))>maxlaengekennungTHEN 
+dateninordnung:=FALSE ;standardmeldung(meldwertzulang,meldtrenner);
+aktuellesfeld:=satzindex;LEAVE pruefeneuplausiELIF length(standardmaskenfeld(
+satzindex+3))>maxlaengeintegabezTHEN dateninordnung:=FALSE ;standardmeldung(
+meldwertzulang,meldtrenner);aktuellesfeld:=satzindex+3;LEAVE pruefeneuplausi
+ELSE parapheninordnung:=korrekteparaphe(satzindex+1)CAND korrekteparaphe(
+satzindex+2);dateninordnung:=parapheninordnungCAND schuelergruppenochnichtda;
+IF NOT dateninordnungTHEN fehlermeldung;LEAVE pruefeneuplausiFI FI FI ;
+satzindexINCR felderprozeilePER .schuelergruppenochnichtda:TEXT VAR pruefsg:=
+vergleichsjgst+standardmaskenfeld(satzindex);klassengrunddateninpuffer;
+putwert(fnrsgrpkennung,standardmaskenfeld(satzindex));search(
+dnraktschuelergruppen,TRUE );aktuellesfeld:=satzindex;(dbstatus<>null).
+fehlermeldung:IF NOT parapheninordnungTHEN IF lehrerparaphen=paraphentrenner
+THEN standardmeldung(meldkeinelehrer,niltext)ELSE standardmeldung(
+meldfalscherlehrer,standardmaskenfeld(aktuellesfeld)+meldtrenner)FI ELSE 
+standardmeldung(meldschonda,pruefsg+meldtrenner)FI .END PROC pruefeneuplausi;
+PROC pruefeaenderungsplausi(BOOL VAR dateninordnung):INT VAR satzindex:=
+erstesfeld,plausind;IF lehrerparaphen=niltextTHEN holeallelehrerparaphenFI ;
+FOR plausindFROM 1UPTO klassenzahlREP IF length(standardmaskenfeld(satzindex)
+)>maxlaengekennungTHEN dateninordnung:=FALSE ;standardmeldung(meldwertzulang,
+meldtrenner);aktuellesfeld:=satzindex;LEAVE pruefeaenderungsplausiELIF length
+(standardmaskenfeld(satzindex+3))>maxlaengeintegabezTHEN dateninordnung:=
+FALSE ;standardmeldung(meldwertzulang,meldtrenner);aktuellesfeld:=satzindex+3
+;LEAVE pruefeaenderungsplausiELSE dateninordnung:=korrekteparaphe(satzindex+1
+)CAND korrekteparaphe(satzindex+2);IF NOT dateninordnungTHEN fehlermeldung;
+LEAVE pruefeaenderungsplausiFI ;FI ;satzindexINCR felderprozeilePER .
+fehlermeldung:IF lehrerparaphen=paraphentrennerTHEN standardmeldung(
+meldkeinelehrer,niltext)ELSE standardmeldung(meldfalscherlehrer,
+standardmaskenfeld(aktuellesfeld)+meldtrenner)FI .END PROC 
+pruefeaenderungsplausi;PROC speicherungdurchfuehren(PROC (BOOL VAR )plausi,
+BOOL CONST neu,aendern,loeschen):pruefeplausibilitaet;IF dateninordnungTHEN 
+speicherntransaktion;neuerblockELSE eingabefehler;return(tofather)FI ;.
+pruefeplausibilitaet:BOOL VAR dateninordnung:=true;standardmeldung(meldplausi
+,niltext);plausi(dateninordnung).speicherntransaktion:BOOL VAR 
+transaktionsfehler:=false;BOOL VAR aenderungsvermerkzusetzen:=FALSE ;
+aendernschleife;IF aenderungsvermerkzusetzenTHEN IF akthalbjahrTHEN 
+aenderungsvermerksetzen(wertaktuell)ELSE aenderungsvermerksetzen(wertgeplant)
+FI ELSE pause(10)FI .aendernschleife:INT VAR suind;INT VAR zahlderaenderungen
+:=null;INT VAR satzindex:=erstesfeld;FOR suindFROM 1UPTO klassenzahlREP 
+behandleklassensatz;satzindexINCR felderprozeilePER .behandleklassensatz:IF 
+datenveraendertTHEN fuehreaenderungaus;aenderungsvermerkzusetzen:=TRUE ;
+meldevollzugFI .datenveraendert:((NOT aendern)CAND (standardmaskenfeld(
+satzindex)<>niltext))COR (aendernCAND (altedaten(suind)<>(standardmaskenfeld(
+satzindex+1)+trenner+standardmaskenfeld(satzindex+2)+trenner+
+standardmaskenfeld(satzindex+3)))).fuehreaenderungaus:lesenvorbereiten;lesen;
+zurueckschreiben.lesenvorbereiten:zahlderaenderungenINCR 1;
+klassengrunddateninpuffer;putwert(fnrsgrpkennung,standardmaskenfeld(satzindex
+)).lesen:IF NOT neuTHEN search(dnraktschuelergruppen,TRUE );
+transaktionsfehler:=(dbstatus<>null)FI .zurueckschreiben:IF NOT 
+transaktionsfehlerTHEN saveupdateposition(dnraktschuelergruppen);IF NOT 
+loeschenTHEN putwert(fnrsgrplehrer,standardmaskenfeld(satzindex+1));putwert(
+fnrsgrpstellvlehrer,standardmaskenfeld(satzindex+2));bereiteintegabezauf;
+putwert(fnrsgrpintegabez,standardmaskenfeld(satzindex+3));IF aendernTHEN 
+selupdate(dnraktschuelergruppen)ELSE insert(dnraktschuelergruppen);#
+wuerfelwarten(vergleichsjgst,dr10.05.88standardmaskenfeld(satzindex))#FI 
+ELSE delete(dnraktschuelergruppen);#wuerfelwarten(vergleichsjgst,dr10.05.88
+standardmaskenfeld(satzindex))#FI FI .bereiteintegabezauf:IF 
+standardmaskenfeld(satzindex+3)=niltextCAND length(standardmaskenfeld(
+satzindex))<=2THEN standardmaskenfeld(standardmaskenfeld(erstesfeld-1)+
+standardmaskenfeld(satzindex),satzindex+3)FI .meldevollzug:TEXT VAR 
+meldungstext;IF dbstatus=nullTHEN meldungstext:=vergleichsjgst+
+standardmaskenfeld(satzindex)+meldtrenner;IF NOT loeschenTHEN standardmeldung
+(meldspeicherung,meldungstext)ELSE standardmeldung(meldloeschung,meldungstext
+)FI ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT (
+vergleichsjgst+standardmaskenfeld(satzindex));meldungstextCAT meldtrenner;
+standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE 
+speicherungdurchfuehrenFI ;infeld(satzindex).eingabefehler:infeld(
+aktuellesfeld).END PROC speicherungdurchfuehren;PROC neuerblock:enter(
+tograndfather)END PROC neuerblock;PROC blocklesenundausgeben:SELECT 
+verarbeitungsartOF CASE vaaendern:aenderungsblocklesenCASE vaneu:
+blocklesenneuCASE valoeschen:blocklesenloeschenEND SELECT .blocklesenneu:
+neuerbildschirm.blocklesenloeschen:neuerbildschirm;
+paraphenfelderundintegabezsperren.paraphenfelderundintegabezsperren:INT VAR 
+sperrfeld:=erstesfeld+1;INT VAR i;FOR iFROM 1UPTO klassenproseiteREP 
+feldschutz(sperrfeld);feldschutz(sperrfeld+1);feldschutz(sperrfeld+2);
+sperrfeldINCR felderprozeilePER .END PROC blocklesenundausgeben;PROC 
+neuerbildschirm:vorbereiten;gewuenschteszeigen;nachbereiten.vorbereiten:
+standardmaskenfeld(vergleichsjgst,erstesfeld-1);aktuellesfeld:=erstesfeld.
+gewuenschteszeigen:IF fortschreibungTHEN TEXT VAR altejgst:=vergleichsjgst;
+TEXT VAR altesschuljahr:=neuesschuljahr,alteshalbjahr:=neueshalbjahr;
+klassenzahl:=null;IF fortschreibungneuesschuljahrTHEN vergleichsjgst:=
+jgstaufber(text(int(altejgst)-1));FI ;neuesschuljahr:=schulkenndatum(keysj);
+neueshalbjahr:=schulkenndatum(keyshj);klassengrunddateninpuffer;
+statleseschleife(dnraktschuelergruppen,vergleichsjgst,niltext,fnrsgrpjgst,
+fnrsgrpkennung,PROC zeigeklassendaten);vergleichsjgst:=altejgst;
+neuesschuljahr:=altesschuljahr;neueshalbjahr:=alteshalbjahrFI .nachbereiten:
+klassenzahl:=klassenproseite;infeld(standardanfang);standardfelderausgeben;
+infeld(erstesfeld).END PROC neuerbildschirm;PROC aenderungsblocklesen:
+vorbereiten;gewuenschteszeigen;nachbereiten.vorbereiten:standardmeldung(
+meldwarten,niltext);klassenzahl:=null;standardmaskenfeld(vergleichsjgst,
+erstesfeld-1);aktuellesfeld:=erstesfeld.gewuenschteszeigen:
+klassengrunddateninpuffer;statleseschleife(dnraktschuelergruppen,
+vergleichsjgst,niltext,fnrsgrpjgst,fnrsgrpkennung,PROC zeigeklassendaten).
+nachbereiten:restlichezeilenloeschen;infeld(standardanfang);
+standardfelderausgeben;infeld(standardeinstieg).restlichezeilenloeschen:INT 
+VAR zeilenzaehler;INT VAR zeilenfeld:=(klassenzahl*felderprozeile)+erstesfeld
+;FOR zeilenzaehlerFROM klassenzahl+1UPTO klassenproseiteREP loeschezeilePER .
+loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP 
+standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,zeilenfeld);
+feldschutz(zeilenfeld);zeilenfeldINCR 1PER ;.END PROC aenderungsblocklesen;
+PROC zeigeklassendaten(BOOL VAR schluss):IF gehoertdazuTHEN klassenzahlINCR 1
+;kennungzeigen;paraphenzeigen;integabezzeigenFI .gehoertdazu:schluss:=(
+jgstaufber(wert(fnrsgrpjgst))<>vergleichsjgst)COR klassenzahl=klassenproseite
+;NOT schluss.kennungzeigen:TEXT CONST zug:=wert(fnrsgrpkennung);kennung(
+klassenzahl):=zug;standardmaskenfeld(zug,aktuellesfeld);IF NOT fortschreibung
+THEN feldschutz(aktuellesfeld);FI ;aktuellesfeldINCR 1.paraphenzeigen:TEXT 
+VAR paraphen:=wert(fnrsgrplehrer);TEXT CONST par:=wert(fnrsgrpstellvlehrer);
+standardmaskenfeld(paraphen,aktuellesfeld);feldfrei(aktuellesfeld);
+aktuellesfeldINCR 1;standardmaskenfeld(par,aktuellesfeld);feldfrei(
+aktuellesfeld);aktuellesfeldINCR 1;paraphenCAT (trenner+par);altedaten(
+klassenzahl):=paraphen+trenner+wert(fnrsgrpintegabez).integabezzeigen:
+standardmaskenfeld(wert(fnrsgrpintegabez),aktuellesfeld);feldfrei(
+aktuellesfeld);aktuellesfeldINCR 1.END PROC zeigeklassendaten;PROC 
+feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld)
+END PROC feldloeschen;PROC holeallelehrerparaphen:lehrerparaphen:=
+paraphentrenner;statleseschleife(dnrlehrer,niltext,niltext,fnrlparaphe,
+fnrlfamname,PROC setzelehrparaphe)END PROC holeallelehrerparaphen;PROC 
+neuesschuljahrhalbjahrerrechnen:IF schuljahr=niltextTHEN schuljahr:=
+schulkenndatum(keysj);halbjahr:=schulkenndatum(keyshj)FI ;IF akthalbjahrTHEN 
+neuesschuljahr:=schuljahr;neueshalbjahr:=halbjahrELIF halbjahr=hj1THEN 
+neuesschuljahr:=schuljahr;neueshalbjahr:=hj2ELSE ersteshalbjahrneuesschuljahr
+FI .ersteshalbjahrneuesschuljahr:neuesschuljahr:=subtext(schuljahr,3,4);
+neuesschuljahrCAT text(int(neuesschuljahr)+1,2);neueshalbjahr:=hj1.END PROC 
+neuesschuljahrhalbjahrerrechnen;PROC setzelehrparaphe(BOOL VAR b):
+lehrerparaphenCAT paraphe(wert(fnrlparaphe))END PROC setzelehrparaphe;TEXT 
+PROC paraphe(TEXT CONST p):p+paraphentrennerEND PROC paraphe;BOOL PROC 
+korrekteparaphe(INT CONST ind):TEXT CONST par:=standardmaskenfeld(ind);INT 
+VAR paraphenpos:=pos(lehrerparaphen,paraphentrenner+paraphe(par));
+aktuellesfeld:=ind;(par=niltext)COR (paraphenpos>null)END PROC 
+korrekteparaphe;PROC klassengrunddateninpuffer:putwert(fnrsgrpsj,
+neuesschuljahr);putwert(fnrsgrphj,neueshalbjahr);putwert(fnrsgrpjgst,
+vergleichsjgst);END PROC klassengrunddateninpuffer;END PACKET 
+listenweiseklassenerf;
+
diff --git a/app/schulis/2.2.1/src/0.raumgruppen bearbeiten b/app/schulis/2.2.1/src/0.raumgruppen bearbeiten
new file mode 100644
index 0000000..b61497b
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.raumgruppen bearbeiten
@@ -0,0 +1,54 @@
+PACKET erfraumgruppenDEFINES erfassungraumgruppen:LET maskenname=
+"ms erf raumgruppen",fnrkennung=2,fnrletztesfeld=17,trenner=" = ",maxraeume=
+15,laengeraumgruppe=4,laengeeinerraumangabe=4;TEXT VAR raeume:="";TEXT VAR 
+raum:="";INT VAR anzraeume;TEXT VAR gueltigeraeume:="";LET postrenner="�";
+LET meldnrungueltigerraum=55,meldnrraumgruppezulang=60;LET sachgebietraum=
+"c02 raeume"PROC erfassungraumgruppen(INT CONST proznr):systemdboff;
+reinitparsing;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2:
+zeigeraumgruppezurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+raumgruppelesenCASE 7:raumgruppeaendernCASE 8:raumgruppeeinfuegenCASE 9:
+raumgruppeloeschenEND SELECT END PROC erfassungraumgruppen;PROC 
+setzeerfassungsparameter:gueltigeraeume:="";setzeerfassungsparameter(
+dnrraumgruppen,maskenname,fnrletztesfeld)END PROC setzeerfassungsparameter;
+PROC zeigeraumgruppezurbearbeitung:setzeerfassungsfeld(wert(fnrrgraumgrp),
+fnrkennung);raeume:=wert(fnrrgraeume);anzraeume:=(length(raeume))DIV 
+laengeeinerraumangabe;INT VAR i:=1;WHILE i<=anzraeumeREP raum:=subtext(raeume
+,1,laengeeinerraumangabe);raeume:=subtext(raeume,laengeeinerraumangabe+1);
+setzeerfassungsfeld(compress(raum),i+fnrkennung);iINCR 1PER ;WHILE i<=
+maxraeumeREP setzeerfassungsfeld("",i+fnrkennung);iINCR 1PER ;END PROC 
+zeigeraumgruppezurbearbeitung;PROC pruefeplausibilitaet:LET leer="",null=0;
+IF gueltigeraeume=""THEN holealleraeumeingueltigeraeumeFI ;INT VAR 
+fehlerstatus;pruefe(1,erfassungsmaske,PROC erfassungswert,fnrkennung,null,
+null,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus
+);LEAVE pruefeplausibilitaetELIF length(erfassungswert(fnrkennung))>
+laengeraumgruppeTHEN meldeauffaellig(erfassungsmaske,meldnrraumgruppezulang);
+setzefehlerstatus(fnrkennung);LEAVE pruefeplausibilitaetFI ;INT VAR i;FOR i
+FROM 1UPTO maxraeumeREP INT VAR fnrraum:=i+fnrkennung;IF erfassungswert(
+fnrraum)<>""THEN IF ungueltigeraumangabeTHEN setzefehlerstatus(fnrraum);
+meldeauffaellig(erfassungsmaske,meldnrungueltigerraum);LEAVE 
+pruefeplausibilitaetFI ;FI ;PER .ungueltigeraumangabe:pos(gueltigeraeume,
+suchwert)=0.suchwert:postrenner+compress(erfassungswert(fnrraum))+postrenner.
+END PROC pruefeplausibilitaet;PROC holealleraeumeingueltigeraeume:
+gueltigeraeume:=postrenner;statleseschleife(dnrschluessel,sachgebietraum,"",
+fnrschlsachgebiet,fnrschlschluessel,PROC raumlesen);END PROC 
+holealleraeumeingueltigeraeume;PROC raumlesen(BOOL VAR b):IF dbstatus<>0COR 
+wert(fnrschlsachgebiet)>sachgebietraumTHEN b:=TRUE ELSE gueltigeraeumeCAT 
+wert(fnrschlschluessel)+postrennerFI END PROC raumlesen;PROC 
+setzewertefuerdbspeicherung:putwert(fnrrgraumgrp,erfassungswert(fnrkennung));
+INT VAR i;raeume:="";FOR iFROM fnrkennung+1UPTO fnrletztesfeldREP raum:=
+erfassungswert(i);IF raum<>""THEN raeumeCAT text(raum,laengeeinerraumangabe)
+FI PER ;putwert(fnrrgraeume,raeume)END PROC setzewertefuerdbspeicherung;PROC 
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR 
+identizeile;identizeile:=wert(fnrrgraumgrp)+trenner+wert(fnrrgraeume);
+setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+wert(
+fnrrgraumgrp).END PROC setzeidentiobjektfuerobjektliste;PROC raumgruppelesen:
+putwert(fnrrgraumgrp,schluessel);search(dnrraumgruppen,TRUE );IF dbstatus=ok
+THEN saveupdateposition(dnrraumgruppen)FI END PROC raumgruppelesen;PROC 
+raumgruppeaendern:restoreupdateposition(dnrraumgruppen);update(dnrraumgruppen
+)END PROC raumgruppeaendern;PROC raumgruppeeinfuegen:insert(dnrraumgruppen)
+END PROC raumgruppeeinfuegen;PROC raumgruppeloeschen:delete(dnrraumgruppen)
+END PROC raumgruppeloeschen;TEXT PROC schluessel:erfassungswert(fnrkennung)
+END PROC schluessel;END PACKET erfraumgruppen;
+
diff --git a/app/schulis/2.2.1/src/0.schulis schrifttyp b/app/schulis/2.2.1/src/0.schulis schrifttyp
new file mode 100644
index 0000000..19f6bf8
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.schulis schrifttyp
@@ -0,0 +1,9 @@
+PACKET schulisschrifttypDEFINES schrifttyp,anschreibenschrifttyp,
+mitteilungschrifttyp,setzeschuliszeichensatz:TEXT VAR zeichensatz:="";PROC 
+setzeschuliszeichensatz(TEXT CONST font):zeichensatz:=fontEND PROC 
+setzeschuliszeichensatz;TEXT PROC schrifttyp:zeichensatzEND PROC schrifttyp;
+TEXT PROC anschreibenschrifttyp:zeichensatzEND PROC anschreibenschrifttyp;
+TEXT PROC mitteilungschrifttyp:zeichensatzEND PROC mitteilungschrifttyp;IF 
+fontexists(font(1))THEN zeichensatz:=font(1)ELSE zeichensatz:=""FI .END 
+PACKET schulisschrifttyp;
+
diff --git a/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten b/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten
new file mode 100644
index 0000000..d82c587
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.schulkenndaten bearbeiten
@@ -0,0 +1,109 @@
+PACKET schulkenndatenbearbeitenDEFINES schulkenndatenbearbeiten,
+schulkenndatenspeichern:LET maske="ms erf schulkenndaten";LET sachgebiet=
+"c02 schulkenndaten";LET schuljahr="Schuljahr",schulhalbjahr="Schulhalbjahr",
+anfangschulhj="Anfang Schulhalbjahr",endeschulhj="Ende Schulhalbjahr",
+schulname="Schulname",schulleiter="Schulleiter",schulort="Schulort",
+schulstrasse="Schulstraße",schulrufnummer="Schulrufnummer";LET fnrschuljahr=2
+,fnrschulhalbjahr=3,fnranfangschulhj=4,fnrendeschulhj=5,fnrschulname=6,
+fnrschulleiter=7,fnrschulort=8,fnrschulstrasse=9,fnrschulrufnummer=10;LET 
+melddatenwerdengespeichert=50,meldfehlendesdatum=52,melddatennichtspeichern=
+63,meldkeinupdatemoeglich=73,meldungueltigesdatum=157,meldungueltigeangabe=
+162;INT VAR ifnr;LET maxfelder=10;ROW maxfelderTEXT VAR alterwert;LET 
+laengeschuljahr=4;INT VAR erstesjahr,zweitesjahr;LET zwischenpunkt=".",
+logbucheintrag="Anw. 10.3.1 Änderung an den Schulkenndaten";PROC 
+schulkenndatenbearbeiten:standardstartproc(maske);zeigeschulkenndaten;infeld(
+fnrschuljahr);standardnproc.zeigeschulkenndaten:alterwert(fnrschuljahr):=
+schulkenndatum(schuljahr);alterwert(fnrschulhalbjahr):=schulkenndatum(
+schulhalbjahr);alterwert(fnranfangschulhj):=kurzdatum(schulkenndatum(
+anfangschulhj));alterwert(fnrendeschulhj):=kurzdatum(schulkenndatum(
+endeschulhj));alterwert(fnrschulname):=schulkenndatum(schulname);alterwert(
+fnrschulleiter):=schulkenndatum(schulleiter);alterwert(fnrschulort):=
+schulkenndatum(schulort);alterwert(fnrschulstrasse):=schulkenndatum(
+schulstrasse);alterwert(fnrschulrufnummer):=schulkenndatum(schulrufnummer);
+FOR ifnrFROM fnrschuljahrUPTO maxfelderREP standardmaskenfeld(alterwert(ifnr)
+,ifnr)PER ;infeld(fnrschuljahr);standardfelderausgeben.END PROC 
+schulkenndatenbearbeiten;PROC schulkenndatenspeichern(BOOL CONST speichern):
+IF NOT speichernTHEN standardmeldung(melddatennichtspeichern,"");pause(10);
+return(2)ELSE INT VAR fehlerstatus:=0;dbstatus(0);pruefeplausibilitaet(
+fehlerstatus);IF fehlerstatus=0THEN datenspeichern;logeintrag(logbucheintrag)
+;IF dbstatus<>0THEN standardmeldung(meldkeinupdatemoeglich,"");return(1)ELSE 
+return(2)FI ELSE infeld(fehlerstatus);return(1)FI FI .datenspeichern:
+standardmeldung(melddatenwerdengespeichert,"");IF standardmaskenfeld(
+fnrschuljahr)<>alterwert(fnrschuljahr)THEN putwert(fnrschlsachgebiet,
+sachgebiet);putwert(fnrschlschluessel,schuljahr);search(dnrschluessel,TRUE );
+putwert(fnrschllangtext,standardmaskenfeld(fnrschuljahr));IF dbstatus=0THEN 
+update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschuljahr);LEAVE 
+datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(
+fnrschulhalbjahr)<>alterwert(fnrschulhalbjahr)THEN putwert(fnrschlsachgebiet,
+sachgebiet);putwert(fnrschlschluessel,schulhalbjahr);search(dnrschluessel,
+TRUE );putwert(fnrschllangtext,standardmaskenfeld(fnrschulhalbjahr));IF 
+dbstatus=0THEN update(dnrschluessel);IF dbstatus<>0THEN infeld(
+fnrschulhalbjahr);LEAVE datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF 
+standardmaskenfeld(fnranfangschulhj)<>alterwert(fnranfangschulhj)THEN putwert
+(fnrschlsachgebiet,sachgebiet);putwert(fnrschlschluessel,anfangschulhj);
+search(dnrschluessel,TRUE );putwert(fnrschllangtext,langdatum(
+standardmaskenfeld(fnranfangschulhj)));IF dbstatus=0THEN update(dnrschluessel
+);IF dbstatus<>0THEN infeld(fnranfangschulhj);LEAVE datenspeichernFI ELSE 
+insert(dnrschluessel)FI FI ;IF standardmaskenfeld(fnrendeschulhj)<>alterwert(
+fnrendeschulhj)THEN putwert(fnrschlsachgebiet,sachgebiet);putwert(
+fnrschlschluessel,endeschulhj);search(dnrschluessel,TRUE );putwert(
+fnrschllangtext,langdatum(standardmaskenfeld(fnrendeschulhj)));IF dbstatus=0
+THEN update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrendeschulhj);LEAVE 
+datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(
+fnrschulname)<>alterwert(fnrschulname)THEN putwert(fnrschlsachgebiet,
+sachgebiet);putwert(fnrschlschluessel,schulname);search(dnrschluessel,TRUE );
+putwert(fnrschllangtext,standardmaskenfeld(fnrschulname));IF dbstatus=0THEN 
+update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulname);LEAVE 
+datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(
+fnrschulleiter)<>alterwert(fnrschulleiter)THEN putwert(fnrschlsachgebiet,
+sachgebiet);putwert(fnrschlschluessel,schulleiter);search(dnrschluessel,TRUE 
+);putwert(fnrschllangtext,standardmaskenfeld(fnrschulleiter));IF dbstatus=0
+THEN update(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulleiter);LEAVE 
+datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(
+fnrschulort)<>alterwert(fnrschulort)THEN putwert(fnrschlsachgebiet,sachgebiet
+);putwert(fnrschlschluessel,schulort);search(dnrschluessel,TRUE );putwert(
+fnrschllangtext,standardmaskenfeld(fnrschulort));IF dbstatus=0THEN update(
+dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulort);LEAVE datenspeichernFI 
+ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(fnrschulstrasse)<>
+alterwert(fnrschulstrasse)THEN putwert(fnrschlsachgebiet,sachgebiet);putwert(
+fnrschlschluessel,schulstrasse);search(dnrschluessel,TRUE );putwert(
+fnrschllangtext,standardmaskenfeld(fnrschulstrasse));IF dbstatus=0THEN update
+(dnrschluessel);IF dbstatus<>0THEN infeld(fnrschulstrasse);LEAVE 
+datenspeichernFI ELSE insert(dnrschluessel)FI FI ;IF standardmaskenfeld(
+fnrschulrufnummer)<>alterwert(fnrschulrufnummer)THEN putwert(
+fnrschlsachgebiet,sachgebiet);putwert(fnrschlschluessel,schulrufnummer);
+search(dnrschluessel,TRUE );putwert(fnrschllangtext,standardmaskenfeld(
+fnrschulrufnummer));IF dbstatus=0THEN update(dnrschluessel);IF dbstatus<>0
+THEN infeld(fnrschulrufnummer);LEAVE datenspeichernFI ELSE insert(
+dnrschluessel)FI FI .END PROC schulkenndatenspeichern;PROC 
+pruefeplausibilitaet(INT VAR fstatus):TEXT VAR pruefwert;pruefwert:=
+standardmaskenfeld(fnrschuljahr);IF length(pruefwert)<>laengeschuljahrTHEN 
+standardmeldung(meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE 
+pruefeplausibilitaetFI ;erstesjahr:=int(pruefwert);IF NOT lastconversionok
+THEN standardmeldung(meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE 
+pruefeplausibilitaetELIF erstesjahr<0THEN standardmeldung(
+meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE pruefeplausibilitaetFI ;
+erstesjahr:=int(subtext(pruefwert,1,2));zweitesjahr:=int(subtext(pruefwert,3,
+4));IF ((erstesjahr+1)MOD 100)<>zweitesjahrTHEN standardmeldung(
+meldungueltigeangabe,"");fstatus:=fnrschuljahr;LEAVE pruefeplausibilitaetFI ;
+IF standardmaskenfeld(fnrschulhalbjahr)<>"1"AND standardmaskenfeld(
+fnrschulhalbjahr)<>"2"THEN standardmeldung(meldungueltigeangabe,"");fstatus:=
+fnrschulhalbjahr;LEAVE pruefeplausibilitaetFI ;IF fehlerhaftesdatum(
+standardmaskenfeld(fnranfangschulhj))THEN standardmeldung(
+meldungueltigesdatum,"");fstatus:=fnranfangschulhj;LEAVE pruefeplausibilitaet
+FI ;IF fehlerhaftesdatum(standardmaskenfeld(fnrendeschulhj))THEN 
+standardmeldung(meldungueltigesdatum,"");fstatus:=fnrendeschulhj;LEAVE 
+pruefeplausibilitaetFI ;IF subtext(standardmaskenfeld(fnrendeschulhj),5,6)<>
+"00"AND NOT (datum(standardmaskenfeld(fnrendeschulhj))>datum(
+standardmaskenfeld(fnranfangschulhj)))THEN standardmeldung(
+meldungueltigesdatum,"");fstatus:=fnrendeschulhj;LEAVE pruefeplausibilitaet
+FI ;IF standardmaskenfeld(fnrschulname)=""THEN standardmeldung(
+meldfehlendesdatum,"");fstatus:=fnrschulname;LEAVE pruefeplausibilitaetFI .
+END PROC pruefeplausibilitaet;BOOL PROC fehlerhaftesdatum(TEXT CONST 
+testdatum):datum(testdatum)=nildatumEND PROC fehlerhaftesdatum;TEXT PROC 
+kurzdatum(TEXT CONST langdatum):subtext(langdatum,1,2)+subtext(langdatum,4,5)
++subtext(langdatum,7,8)END PROC kurzdatum;TEXT PROC langdatum(TEXT CONST 
+kurzdatum):subtext(kurzdatum,1,2)+zwischenpunkt+subtext(kurzdatum,3,4)+
+zwischenpunkt+subtext(kurzdatum,5,6)END PROC langdatum;END PACKET 
+schulkenndatenbearbeiten
+
diff --git a/app/schulis/2.2.1/src/1.abgegangene aussortieren b/app/schulis/2.2.1/src/1.abgegangene aussortieren
new file mode 100644
index 0000000..ac73783
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.abgegangene aussortieren
@@ -0,0 +1,75 @@
+PACKET abgegangeneaussortierenDEFINES 
+abgegangeneaussortiereneingangsbehandlung,abgegangeneaussortieren:LET null=0,
+fnrdatum=2,fnrankreuz1=3,fnrankreuz2=4,pruefartalternative=5,niltext="",
+tofather=1,meldtrenner="#",namenstrenner=", ",meldfalschesdatum=157,
+meldbearbeitung=153,meldspeicherfehler=131,meldende=158;LET falschertag="00",
+keindatum="01.01.00";LET anzschlfelder=3;LET bestandabgegangene="abg",
+bestandlaufsj="ls";LET jgstufe10=10;LET logtextbeginn1=
+"Anw. 1.3.4 Abgemeldete bis ",logtextbeginn2="Anw. 1.3.4 Abgegangene bis ",
+logtextende1=" aussortieren",logtextende2=" entfernen";ROW anzschlfelderTEXT 
+VAR key;TEXT VAR jgst,zugtutor;PROC abgegangeneaussortiereneingangsbehandlung
+:reinitparsing;standardvproc(maske(vergleichsknoten)).END PROC 
+abgegangeneaussortiereneingangsbehandlung;PROC abgegangeneaussortieren:
+pruefeplausibilitaet;IF allesokTHEN aussortierendurchfuehrenELSE 
+fehlerbehandlungFI .pruefeplausibilitaet:pruefedatum;IF allesokTHEN 
+pruefeankreuzfelderFI .allesok:INT VAR pruefstatus;pruefstatus=null.
+pruefeankreuzfelder:standardpruefe(pruefartalternative,fnrankreuz1,
+fnrankreuz2,null,niltext,pruefstatus);.pruefedatum:TEXT VAR stichtag:=
+standardmaskenfeld(fnrdatum);IF (subtext(stichtag,1,2)=falschertag)COR (datum
+(stichtag)=nildatum)THEN pruefstatus:=fnrdatum;standardmeldung(
+meldfalschesdatum,niltext);ELSE pruefstatus:=nullFI .fehlerbehandlung:infeld(
+pruefstatus);return(tofather).aussortierendurchfuehren:aussortieren(stichtag,
+standardmaskenfeld(fnrankreuz1)<>niltext);return(tofather).END PROC 
+abgegangeneaussortieren;PROC aussortieren(TEXT CONST stichtag,BOOL CONST 
+uebertragen):TEXT VAR eintrag;IF uebertragenTHEN inbestandabgegangeneELSE 
+endgueltigloeschenFI .inbestandabgegangene:eintrag:=logtextbeginn1;eintrag
+CAT datumskonversion(stichtag);eintragCAT logtextende1;logeintrag(eintrag);
+leseschleife(ixsustatabgdat,bestandlaufsj,stichtag,PROC 
+abgegangeneuebertragen).endgueltigloeschen:eintrag:=logtextbeginn2;eintrag
+CAT datumskonversion(stichtag);eintragCAT logtextende2;logeintrag(eintrag);
+leseschleife(ixsustatabgdat,bestandabgegangene,stichtag,PROC 
+endgueltigloeschen).END PROC aussortieren;PROC leseschleife(INT CONST 
+sekbestandindex,TEXT CONST sustatus,TEXT CONST stichtag,PROC (BOOL VAR )
+aktion):erstenlesen;WHILE NOT schlussREP ausfuehrung;naechstenlesenPER ;
+endemeldung.erstenlesen:BOOL VAR endegewuenscht:=FALSE ;putwert(fnrsustatuss,
+sustatus);putwert(fnrsuabgdats,datumskonversion(stichtag));search(
+sekbestandindex,FALSE );IF NOT gueltigesabgangsdatum(sustatus,stichtag)THEN 
+pred(sekbestandindex)FI ;statusueberpruefen.schluss:(dbstatus<>null)COR 
+endegewuenscht.ausfuehrung:bearbeitungmelden;aktion(endegewuenscht).
+naechstenlesen:pred(sekbestandindex);statusueberpruefen.endemeldung:IF NOT 
+endegewuenschtTHEN standardmeldung(meldende,niltext)FI .statusueberpruefen:
+IF gueltigesabgangsdatum(sustatus,stichtag)THEN lesenzumaendernELSE dbstatus(
+notfound)FI .END PROC leseschleife;PROC abgegangeneuebertragen(BOOL VAR 
+schluss):delete(dnrschueler);IF dbstatus=okTHEN IF intwert(fnrsusgrpjgst)>=
+jgstufe10THEN kurswahlserveraktualisieren(wert(fnrsusgrpjgst),"","")FI ;
+putwert(fnrsustatuss,bestandabgegangene);insert(dnrschueler);IF dbstatus<>ok
+THEN aktbestandzuruecksetzen;schlussundfehlermeldenFI ;
+aktbestandzuruecksetzenELSE schlussundfehlermeldenFI .aktbestandzuruecksetzen
+:putwert(fnrsustatuss,bestandlaufsj);.schlussundfehlermelden:schluss:=TRUE ;
+fehlermelden.END PROC abgegangeneuebertragen;PROC endgueltigloeschen(BOOL 
+VAR schluss):#aenderunginstatraumvorbereiten(TRUE );dr11.05.88#IF NOT schluss
+THEN #einenschuelerausstatraumentfernen;dr11.05.88#datenloeschen(
+dnrhalbjahresdaten,schluss);IF NOT schlussTHEN diffdatenloeschen;delete(
+dnrschueler);schluss:=dbstatus<>null;FI FI ;IF schlussTHEN #
+einenschuelerinstatraumeinfuegen;dr11.05.88#fehlermeldenFI .diffdatenloeschen
+:IF wert(fnrsudiffdatennrs)<>""THEN putwert(fnrdddiffdatennr,wert(
+fnrsudiffdatennrs));search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN delete(
+dnrdiffdaten)FI FI .END PROC endgueltigloeschen;PROC datenloeschen(INT CONST 
+dateinummer,BOOL VAR schluss):inittupel(dateinummer);putwert(dateinummer+1,
+key(1));putwert(dateinummer+2,key(2));putwert(dateinummer+3,datumskonversion(
+key(3)));search(dateinummer,FALSE );WHILE dbstatus=okCAND gleicherschueler
+REP delete(dateinummer);IF dbstatus<>okTHEN schluss:=TRUE ELSE succ(
+dateinummer)FI PER .gleicherschueler:key(1)=wert(dateinummer+1)CAND key(2)=
+wert(dateinummer+2)CAND key(3)=datumrekonversion(wert(dateinummer+3)).END 
+PROC datenloeschen;BOOL PROC gueltigesabgangsdatum(TEXT CONST bestand,
+stichtag):dbstatus=okCAND wert(fnrsustatuss)=bestandCAND wert(fnrsuabgdats)<>
+keindatumCAND datum(wert(fnrsuabgdats))<=datum(datumskonversion(stichtag)).
+END PROC gueltigesabgangsdatum;PROC lesenzumaendern:key(1):=wert(
+fnrsufamnames);key(2):=wert(fnrsurufnames);key(3):=datumrekonversion(wert(
+fnrsugebdatums));jgst:=wert(fnrsusgrpjgst);zugtutor:=wert(fnrsusgrpzugtut)
+END PROC lesenzumaendern;PROC bearbeitungmelden:standardmeldung(
+meldbearbeitung,key(1)+namenstrenner+key(2)+meldtrenner+jgst+zugtutor+
+meldtrenner)END PROC bearbeitungmelden;PROC fehlermelden:standardmeldung(
+meldspeicherfehler,text(dbstatus)+meldtrenner+key(1)+namenstrenner+key(2)+
+meldtrenner);END PROC fehlermelden;END PACKET abgegangeneaussortieren
+
diff --git a/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11 b/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11
new file mode 100644
index 0000000..608e8e4
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.anmeldebestaetigung fuer jgst 5 und 11
@@ -0,0 +1,58 @@
+PACKET anschranmeldebestaetigungfuerjgst5und11DEFINES anschreibenbesteingang,
+anschreibenbestneustarten,sonderwertebestneu,multistopanmeld:LET swindexvollj
+=511,swindexminderjmaennlweibl=512,vollj="v",minderjaehrig="m",maennl="m",
+weibl="w",trennsymbol=" ",punkt=".";LET vordruckneu11=
+"vordruck anmeldebestaetigung zur jgst 11";LET vordruckneu5=
+"vordruck anmeldebestaetigung zur jgst 5";LET hellan="",hellaus=" ",maske=
+"ms anschreiben best",jgstfeldnr=3,bestandfeldnr=2,namefeldnr=4,vornamefeldnr
+=5,gebdatfeldnr=6,bildschirmfeldnr=7,druckerfeldnr=8;LET niltext="",
+fehlermeldnr=56,wartemeldnr=69,datumfehler=157,vater=1;LET jgst05="05";INT 
+VAR eingabestatus;BOOL VAR anschreibenfuerjgst5;PROC anschreibenbesteingang(
+TEXT CONST jgst):anschreibenfuerjgst5:=(jgst=jgst05);standardstartproc(maske)
+;standardmaskenfeld(hellan+jgst+hellaus,jgstfeldnr);standardnprocEND PROC 
+anschreibenbesteingang;BOOL PROC sonderwertebestneu:IF NOT 
+anschreibenfuerjgst5THEN IF volljaehrig(wert(fnrsugebdatums))THEN 
+setzesonderwert(swindexvollj,vollj);setzesonderwert(swindexminderjmaennlweibl
+,niltext)ELSE setzesonderwert(swindexvollj,minderjaehrig);IF wert(
+fnrsugeschlechts)=weiblTHEN setzesonderwert(swindexminderjmaennlweibl,weibl)
+ELSE setzesonderwert(swindexminderjmaennlweibl,maennl)FI FI FI ;IF 
+andereerzieheradresseCAND NOT volljaehrig(wert(fnrsugebdatums))#sf30.10.#
+THEN leseerzieheradresse;uebertrageerzieheradresseFI ;adressat((wert(
+fnrsuvornames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));TRUE .
+andereerzieheradresse:#intwert(fnradresskuerzel)<>0#wert(fnrsuplzorte)<>"".
+leseerzieheradresse:#inittupel(dnradressen);putwert(dnradressen+1,wert(
+fnradresskuerzel));search(dnradressen,TRUE )#.uebertrageerzieheradresse:
+putwert(fnrsustrnrs,wert(fnrsustrnre));putwert(fnrsuplzorts,wert(fnrsuplzorte
+)).END PROC sonderwertebestneu;PROC anschreibenbestneustarten:TEXT VAR 
+vordruckneu:="";lesemaskenwerte;IF NOT (auswahldruckeroderbildschirmok)THEN 
+meldedenfehler;infeld(bildschirmfeldnr);zurueckzumdialogELSE IF 
+schluesselmitdatumangegebenTHEN IF schuelerschluessel3okTHEN 
+startenausfuehrenELSE standardmeldung(datumfehler,niltext);infeld(
+gebdatfeldnr);zurueckzumdialogFI ;ELSE IF (alleschuelergewaehltXOR 
+einschuelerohnedatumgewaehlt)THEN startenausfuehrenELSE meldedenfehler;
+zurueckzumdialogFI ;FI ;FI .lesemaskenwerte:TEXT CONST schluessel1:=
+standardmaskenfeld(namefeldnr);TEXT CONST schluessel2:=standardmaskenfeld(
+vornamefeldnr);TEXT CONST schluessel3:=standardmaskenfeld(gebdatfeldnr);BOOL 
+CONST anschreibenzeigen:=standardmaskenfeld(bildschirmfeldnr)<>niltext;BOOL 
+CONST alle:=standardmaskenfeld(bestandfeldnr)<>niltext.
+auswahldruckeroderbildschirmok:(standardmaskenfeld(bildschirmfeldnr)<>niltext
+)XOR (standardmaskenfeld(druckerfeldnr)<>niltext).schluesselmitdatumangegeben
+:NOT alleAND schluessel1<>niltextAND schluessel2<>niltextAND schluessel3<>
+niltext.alleschuelergewaehlt:alleAND (schluessel1+schluessel2+schluessel3)=
+niltext.einschuelerohnedatumgewaehlt:NOT alleAND schluessel1<>niltextAND 
+schluessel3=niltext.schuelerschluessel3ok:standardpruefe(6,6,0,0,niltext,
+eingabestatus);IF NOT (eingabestatus=0)THEN FALSE ELSE TRUE FI .
+meldedenfehler:standardmeldung(fehlermeldnr,niltext).zurueckzumdialog:return(
+vater).startenausfuehren:standardmeldung(wartemeldnr,niltext);
+initialisieredruckerfueranschreiben;inittupel(dnrschueler);parsenooffields(30
+);uebernimmnamen;IF anschreibenfuerjgst5THEN putwert(fnrsustatuss,"n05");
+vordruckneu:=vordruckneu5ELSE putwert(fnrsustatuss,"n11");vordruckneu:=
+vordruckneu11FI ;anschreibenstart(ixsustatfamrufgeb,vordruckneu,
+anschreibenzeigen,(schluessel1+schluessel2)<>"",BOOL PROC sonderwertebestneu,
+BOOL PROC multistopanmeld).uebernimmnamen:putwert(fnrsufamnames,schluessel1);
+putwert(fnrsurufnames,schluessel2);putwert(fnrsugebdatums,datumskonversion(
+schluessel3)).END PROC anschreibenbestneustarten;BOOL PROC multistopanmeld:
+BOOL VAR b;IF anschreibenfuerjgst5THEN b:=wert(fnrsustatuss)="n05"ELSE b:=
+wert(fnrsustatuss)="n11"FI ;bENDPROC multistopanmeld;END PACKET 
+anschranmeldebestaetigungfuerjgst5und11;
+
diff --git a/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete b/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete
new file mode 100644
index 0000000..3271256
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.mitteilungen neuangemeldete und abgemeldete
@@ -0,0 +1,262 @@
+PACKET anschrmitteilungenneuangemeldeteundabgemeldeteDEFINES 
+mitteilungeingang,mitteilungende,mitteilungneuangstarten,
+mitteilungabmeldungstarten,sonderwertemitteilungabmeldung,
+sonderwertemitteilungneuangmithjd,sonderwertemitteilungneuangmitdiffd,
+dummystop:LET laufenderbestand="ls";LET bestandfuerabgang="c02 abgang",
+bestandfuerabschluss="c02 abschluss";LET swaktuelleshalbjahr=509,
+sweintrittsdatum=512,swabgangsdatum=512,swschuelername=513,swgeburtsdatum=514
+,swabgangsgrund=515,swstrhausnr=516,swerreichterabschluss=516,swplzort=517,
+swtelephonnr=518,swaktjgst=519,swklassenlehrer=520,#swbafoeg=521,dr05.03.88#
+swkursanfang=530,swfelderunterschrnoteentlbuecher=591,swmatrixfeld=590;INT 
+VAR swkurse,eingabestatus;TEXT VAR aktuellejgst,tutorlehrer,abglangtext,
+abslangtext;TEXT VAR aktuelleshalbjahr:="",aktuellesschuljahr:="",
+schuljahranfang:="",schuljahrende:="";LET textschulhalbjahr="Schulhalbjahr",
+textschuljahr="Schuljahr",textschuljahranfang="Anfang Schulhalbjahr",
+textschuljahrende="Ende Schulhalbjahr";BOOL VAR hjdvorhanden,abmeldung:=
+FALSE ,schuelergefunden;LET jgst09="09",jgst10="10";LET maske="ms mitteilung"
+;LET namefeldnr=2,rufnamefeldnr=3,geburtsdatumfeldnr=4,bildschirmfeldnr=5,
+druckerfeldnr=6;LET father=1;LET wartemeldnr=69,existiertnichtmeldnr=126,
+falschesdatum=192,datumfehler=157,fehlermeldnr=56;TEXT VAR familienname,
+rufname,geburtsdatum;BOOL VAR zeigen;BOOL VAR erstemitteilung:=TRUE ;LET 
+vordruckmithjd="vordruck mitteilung ueber eine anmeldung mit hjd",
+vordruckmitdiffd="vordruck mitteilung ueber eine anmeldung mit diffd",
+vordruckabmeldung="vordruck mitteilung ueber eine abmeldung";LET 
+maxanzahlbelegtekurse=15,anzahlkurskomponenten=4;ROW maxanzahlbelegtekurse
+ROW anzahlkurskomponentenTEXT VAR kursdaten;LET lerngruppenindex=1,
+fachlangtextindex=2,lehrerindex=3,fachschluesselindex=4;LET 
+indexdiffdatenbeschreibung=1,indexdiffdatenschluessel=2;INT VAR 
+anzahlderfaecher:=1,anzahlderbelegtenkurse:=0,anzahlderdiffdaten:=0;INT VAR 
+zaehler,zaehler1,zaehler2;TEXT VAR fachkuerzel;LET weiblich="w",maennlich="m"
+,anredeweibl="Fr.",anredemaennl="Hr.",erstehalbj="1",auszufuellendesfeld=
+"___________________________",trennsymbol=" ",punkt=".",niltext="",nildatum=
+"01.01.00",textwahlpflichtfach="Wahlpflichtf. ";TEXT CONST 
+auszufuellendefelderunterschrnoteentlbuecher:="__________ ____ ________";
+TEXT CONST auszufuellendesfeldlehrer:="____________________________________ "
+;TEXT CONST matrixfeld:="_______ "+auszufuellendesfeldlehrer+
+auszufuellendefelderunterschrnoteentlbuecher;LET maxanzahlderfaecher=100;ROW 
+maxanzahlderfaecherROW 2TEXT VAR faecherkartei;LET karteifachschluesselindex=
+1,karteifachlangtext=2;LET anzstacktupel=25;PROC initialisierekursdaten:FOR 
+zaehler1FROM 1UPTO maxanzahlbelegtekurseREP FOR zaehler2FROM 1UPTO 
+anzahlkurskomponentenREP kursdaten(zaehler1)(zaehler2):=niltextPER PER END 
+PROC initialisierekursdaten;PROC holekursdaten:INT VAR i;
+anzahlderbelegtenkurse:=length(wert(fnrhjdfach))DIV 2;FOR iFROM 1UPTO 
+anzahlderbelegtenkurseREP fachkuerzel:=subtext(wert(fnrhjdfach),i*2-1,i*2);
+kursdaten(i)(fachschluesselindex):=compress(fachkuerzel);kursdaten(i)(
+lerngruppenindex):=fachkuerzel+trennsymbol+subtext(wert(fnrhjdlerngrpkenn),i*
+4-3,i*4);PER ;END PROC holekursdaten;PROC suchelangtextzufachschluessel(INT 
+VAR anzahlderschluessel):INT VAR i;FOR iFROM 1UPTO anzahlderschluesselREP 
+zaehler:=0;REP zaehlerINCR 1UNTIL zaehler>anzahlderfaecherCOR faecherkartei(
+zaehler)(karteifachschluesselindex)=kursdaten(i)(fachschluesselindex)PER ;IF 
+faecherkartei(zaehler)(karteifachschluesselindex)=kursdaten(i)(
+fachschluesselindex)THEN kursdaten(i)(fachlangtextindex):=faecherkartei(
+zaehler)(karteifachlangtext);FI PER ;END PROC suchelangtextzufachschluessel;
+PROC zuordnunglerngruppelehrer:INT VAR i;anzahlderbelegtenkurse:=length(wert(
+fnrhjdfach))DIV 2;FOR iFROM 1UPTO anzahlderbelegtenkurseREP kursdaten(i)(
+lehrerindex):=lehrerzukurs(subtext(wert(fnrhjdfach),i*2-1,i*2),i)PER ;END 
+PROC zuordnunglerngruppelehrer;TEXT PROC lehrerzukurs(TEXT CONST fachkuerzel,
+INT CONST wievielte):INT VAR i:=wievielte;suchelerngruppe;IF dbstatus=okTHEN 
+suchelehrerELSE auszufuellendesfeldlehrerFI .suchelerngruppe:putwert(fnrlvsj,
+wert(fnrhjdsj));putwert(fnrlvhj,wert(fnrhjdhj));putwert(fnrlvfachkennung,
+fachkuerzel+compress(subtext(wert(fnrhjdlerngrpkenn),i*4-3,i*4)));putwert(
+fnrlvjgst,wert(fnrhjdjgst));search(dnrlehrveranstaltungen,TRUE ).suchelehrer:
+putwert(dnrlehrer+1,wert(fnrlvparaphe));search(dnrlehrer,TRUE );IF dbstatus<>
+okTHEN auszufuellendesfeldlehrerELSE kompletteanredeFI .kompletteanrede:text(
+anrede+lehrertitel+lehrerzusatz+trennsymbol+wert(fnrlfamname),length(
+auszufuellendesfeldlehrer)).anrede:IF wert(fnrlgeschlecht)=weiblichTHEN 
+anredeweiblELIF wert(fnrlgeschlecht)=maennlichTHEN anredemaennlELSE niltext
+FI .lehrertitel:IF wert(fnrlamtsbeztitel)=niltextTHEN niltextELSE trennsymbol
++wert(fnrlamtsbeztitel)FI .lehrerzusatz:IF wert(fnrlzusatz)=niltextTHEN 
+niltextELSE trennsymbol+wert(fnrlzusatz)FI .ENDPROC lehrerzukurs;PROC 
+sonderwertfueradressaten:adressat((wert(fnrsurufnames)SUB 1)+punkt+
+trennsymbol+wert(fnrsufamnames))END PROC sonderwertfueradressaten;PROC 
+sonderwerteallgschuelerdaten:IF wert(fnrsunamenszusatzs)<>niltextTHEN 
+setzesonderwert(swschuelername,wert(fnrsurufnames)+trennsymbol+wert(
+fnrsunamenszusatzs)+trennsymbol+wert(fnrsufamnames))ELSE setzesonderwert(
+swschuelername,wert(fnrsurufnames)+trennsymbol+wert(fnrsufamnames))FI ;
+setzesonderwert(swgeburtsdatum,wert(fnrsugebdatums));END PROC 
+sonderwerteallgschuelerdaten;PROC 
+sonderwerteschuelerdatenfueranmeldebestaetigung:sonderwerteallgschuelerdaten;
+setzesonderwert(swstrhausnr,wert(fnrsustrnrs));setzesonderwert(swplzort,wert(
+fnrsuplzorts));setzesonderwert(swtelephonnr,wert(fnrsutelnrs));END PROC 
+sonderwerteschuelerdatenfueranmeldebestaetigung;PROC sonderwertfueraktjgst:
+aktuellejgst:=wert(fnrsusgrpjgst)+wert(fnrsusgrpjgst+1);setzesonderwert(
+swaktjgst,aktuellejgst);END PROC sonderwertfueraktjgst;PROC 
+sonderwertfuerklassenlehrer:sucheklassenlehrer;IF dbstatus=okTHEN IF wert(
+fnrlgeschlecht)=weiblichTHEN tutorlehrer:=anredeweibl+trennsymbolELIF wert(
+fnrlgeschlecht)=maennlichTHEN tutorlehrer:=anredemaennl+trennsymbolELSE 
+tutorlehrer:=niltextFI ;IF wert(fnrlzusatz)<>niltextTHEN tutorlehrer:=
+tutorlehrer+wert(fnrlzusatz)+trennsymbolFI ;setzesonderwert(swklassenlehrer,
+text(tutorlehrer+wert(fnrlfamname),37));FI .sucheklassenlehrer:
+sucheschuelergruppe;suchelehrer.sucheschuelergruppe:putwert(fnrsgrpsj,
+aktuellesschuljahr);putwert(fnrsgrphj,aktuelleshalbjahr);putwert(fnrsgrpjgst,
+wert(fnrsusgrpjgst));putwert(fnrsgrpkennung,wert(fnrsusgrpzugtut));search(
+dnraktschuelergruppen,TRUE ).suchelehrer:inittupel(dnrlehrer);IF dbstatus=ok
+THEN putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,TRUE )FI .END 
+PROC sonderwertfuerklassenlehrer;PROC bildefaecherbestand:
+initialisierefaecherkartei;vorbereitung;leseschleife.
+initialisierefaecherkartei:FOR zaehler1FROM 1UPTO maxanzahlderfaecherREP FOR 
+zaehler2FROM 1UPTO karteifachlangtextREP faecherkartei(zaehler1)(zaehler2):=
+niltextPER PER .vorbereitung:BOOL VAR wenigergelesen:=FALSE ;INT VAR anztupel
+;inittupel(dnrfaecher);anztupel:=anzstacktupel;anzahlderfaecher:=0;
+multisearchforward(dnrfaecher,anztupel);evtweniger.leseschleife:WHILE 
+anztupel>0CAND anzahlderfaecher<=maxanzahlderfaecherREP anzahlderfaecherINCR 
+1;anztupelDECR 1;multisucc;faecherkartei(anzahlderfaecher)(1):=wert(
+dnrfaecher+1);faecherkartei(anzahlderfaecher)(2):=wert(dnrfaecher+2);IF 
+anztupel=0CAND NOT wenigergelesenTHEN anztupel:=anzstacktupel;multisucc(
+dnrfaecher,anztupel);evtwenigerFI PER .evtweniger:IF anztupel<anzstacktupel
+THEN wenigergelesen:=TRUE FI .END PROC bildefaecherbestand;PROC 
+mitteilungeingang:standardvproc(maske);IF erstemitteilungTHEN 
+bildefaecherbestand;erstemitteilung:=FALSE FI ;END PROC mitteilungeingang;
+PROC mitteilungende:erstemitteilung:=TRUE ;enter(2)END PROC mitteilungende;
+BOOL PROC sonderwertemitteilungneuangmithjd:initialisierekursdaten;
+initialisieresonderwerte;sonderwertfueradressaten;
+sonderwertfuereintrittsdatum;sonderwerteschuelerdatenfueranmeldebestaetigung;
+sonderwertfueraktjgst;bestimmekurse;sonderwertfuerklassenlehrer;
+sonderwertefuerkurse;TRUE .sonderwertfuereintrittsdatum:setzesonderwert(
+sweintrittsdatum,wert(fnrsueintrittsdats)).bestimmekurse:holekursdaten;
+suchelangtextzufachschluessel(anzahlderbelegtenkurse);
+zuordnunglerngruppelehrer;.sonderwertefuerkurse:swkurse:=swkursanfang;FOR 
+zaehler1FROM 1UPTO anzahlderbelegtenkurseREP setzesonderwert(swkurse,
+kursdaten(zaehler1)(lerngruppenindex));swkurseINCR 1;setzesonderwert(swkurse,
+kursdaten(zaehler1)(fachlangtextindex));swkurseINCR 1;setzesonderwert(swkurse
+,kursdaten(zaehler1)(lehrerindex));swkurseINCR 1;PER .END PROC 
+sonderwertemitteilungneuangmithjd;BOOL PROC 
+sonderwertemitteilungneuangmitdiffd:initialisierekursdaten;
+initialisieresonderwerte;sonderwertfueradressaten;
+sonderwertfuereintrittsdatum;sonderwerteschuelerdatenfueranmeldebestaetigung;
+sonderwertfueraktjgst;bestimmediffdaten;sonderwertfuerklassenlehrer;
+sonderwertefuerdiffdaten;TRUE .sonderwertfuereintrittsdatum:setzesonderwert(
+sweintrittsdatum,wert(fnrsueintrittsdats)).bestimmediffdaten:
+anzahlderdiffdaten:=0;ermittlediefremdsprachen;
+ueberpruefeobreligionsteilnahme;ueberpruefeobkunstodermusik;IF wert(
+fnrsusgrpjgst)=jgst09THEN ermittlewp09FI ;IF wert(fnrsusgrpjgst)=jgst10THEN 
+ermittlewp10FI ;ermittleags.ermittlediefremdsprachen:INT VAR 
+anzahlderbelegtenfremdsprachen:=1;INT VAR wievieltesprache:=0;REP fachkuerzel
+:=wert(fnrdd1fremdfach+wievieltesprache);IF fachkuerzel<>niltextTHEN 
+anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)(
+indexdiffdatenbeschreibung):=text(anzahlderbelegtenfremdsprachen)+
+". Fremdsprache:";anzahlderbelegtenfremdsprachenINCR 1;kursdaten(
+anzahlderdiffdaten)(indexdiffdatenschluessel):=fachkuerzel;FI ;
+wievieltespracheINCR 3UNTIL (fnrdd1fremdfach+wievieltesprache)>fnrdd4fremde
+PER .ueberpruefeobreligionsteilnahme:IF wert(fnrddreliunter)<>niltextCAND (
+wert(fnrddreliunter+1)=nildatum)OR (wert(fnrddreliunter+1)<>nildatumAND wert(
+fnrddreliunter+2)<>nildatum)THEN anzahlderdiffdatenINCR 1;kursdaten(
+anzahlderdiffdaten)(indexdiffdatenbeschreibung):="Religion:";kursdaten(
+anzahlderdiffdaten)(indexdiffdatenschluessel):=wert(fnrddreliunter)FI .
+ueberpruefeobkunstodermusik:IF wert(fnrddkunstmusik)<>niltextTHEN 
+anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)(
+indexdiffdatenbeschreibung):="Kunst/Musik:";kursdaten(anzahlderdiffdaten)(
+indexdiffdatenschluessel):=wert(fnrddkunstmusik)FI .ermittlewp09:TEXT VAR txt
+;IF erstehalbjahrTHEN txt:=textwahlpflichtfach+"09.1:";wps(fnrddfach091a,
+anzahlderdiffdaten,txt);wps(fnrddfach091b,anzahlderdiffdaten,txt)ELSE txt:=
+textwahlpflichtfach+"09.2:";wps(fnrddfach092a,anzahlderdiffdaten,txt);wps(
+fnrddfach092b,anzahlderdiffdaten,txt)FI .ermittlewp10:IF erstehalbjahrTHEN 
+txt:=textwahlpflichtfach+"10.1:";wps(fnrddfach101a,anzahlderdiffdaten,txt);
+wps(fnrddfach101b,anzahlderdiffdaten,txt);ELSE txt:=textwahlpflichtfach+
+"10.2:";wps(fnrddfach102a,anzahlderdiffdaten,txt);wps(fnrddfach102b,
+anzahlderdiffdaten,txt)FI .erstehalbjahr:erstehalbj=sonderwert(
+swaktuelleshalbjahr).ermittleags:INT VAR wievielteag:=0;REP fachkuerzel:=wert
+(fnrddagthema1+wievielteag);IF fachkuerzel<>niltextTHEN anzahlderdiffdaten
+INCR 1;kursdaten(anzahlderdiffdaten)(indexdiffdatenbeschreibung):="AG:";
+kursdaten(anzahlderdiffdaten)(indexdiffdatenschluessel):=fachkuerzel;FI ;
+wievielteagINCR 3#2#UNTIL (fnrddagthema1+wievielteag)>fnrddagthema3PER .
+sonderwertefuerdiffdaten:swkurse:=swkursanfang;FOR zaehler1FROM 1UPTO 
+anzahlderdiffdatenREP FOR zaehler2FROM 1UPTO indexdiffdatenschluesselREP 
+setzesonderwert(swkurse,kursdaten(zaehler1)(zaehler2));swkurseINCR 1PER PER .
+END PROC sonderwertemitteilungneuangmitdiffd;PROC wps(INT CONST fnr,INT VAR 
+anzahlderdiffdaten,TEXT CONST txt):IF wert(fnr)<>niltextTHEN 
+anzahlderdiffdatenINCR 1;kursdaten(anzahlderdiffdaten)(
+indexdiffdatenbeschreibung):=txt;kursdaten(anzahlderdiffdaten)(
+indexdiffdatenschluessel):=wert(fnr)FI ENDPROC wps;BOOL PROC 
+sonderwertemitteilungabmeldung:initialisierekursdaten;
+initialisieresonderwerte;sonderwertezumaufbaueinermatrix;
+sonderwertfueradressaten;sonderwerteallgschuelerdaten;
+abgangsdatumundabgangsgrund;sonderwertfueraktjgst;
+sonderwertefuerkursebeimabgang;sonderwertfuerklassenlehrer;
+sonderwertfuerabgangsgrundundabschluss;TRUE .abgangsdatumundabgangsgrund:
+TEXT VAR abgdatum:=wert(fnrsuabgdats);IF abgdatum=nildatumTHEN abgdatum:=""
+FI ;setzesonderwert(swabgangsdatum,abgdatum);TEXT VAR abgkuerzel:=wert(
+fnrsuabggrund);TEXT VAR abskuerzel:=wert(fnrsuabschluss);.
+sonderwertfuerabgangsgrundundabschluss:IF langtextgefunden(
+bestandfuerabschluss,abskuerzel,abslangtext)THEN setzesonderwert(
+swerreichterabschluss,abslangtext)ELSE setzesonderwert(swerreichterabschluss,
+auszufuellendesfeld)FI ;IF langtextgefunden(bestandfuerabgang,abgkuerzel,
+abglangtext)THEN setzesonderwert(swabgangsgrund,abglangtext)ELSE 
+setzesonderwert(swabgangsgrund,auszufuellendesfeld)FI .
+sonderwertefuerkursebeimabgang:IF hjdvorhandenTHEN holekursdaten;
+zuordnunglerngruppelehrer;swkurse:=swkursanfangELSE anzahlderbelegtenkurse:=0
+FI ;FOR zaehler1FROM 1UPTO anzahlderbelegtenkurseREP setzesonderwert(swkurse,
+plusanhang(kursdaten(zaehler1)(fachschluesselindex),subtext(wert(
+fnrhjdlerngrpkenn),zaehler1*4-3,zaehler1*4)));swkurseINCR 1;setzesonderwert(
+swkurse,kursdaten(zaehler1)(lehrerindex));swkurseINCR 1PER .
+sonderwertezumaufbaueinermatrix:setzesonderwert(
+swfelderunterschrnoteentlbuecher,auszufuellendefelderunterschrnoteentlbuecher
+);setzesonderwert(swmatrixfeld,matrixfeld).END PROC 
+sonderwertemitteilungabmeldung;TEXT PROC plusanhang(TEXT CONST t,t2):text(t,3
+)+text(t2,5)ENDPROC plusanhang;BOOL PROC langtextgefunden(TEXT CONST bestand,
+kuerzel,TEXT VAR lang):systemdboff;putwert(fnrschlsachgebiet,bestand);putwert
+(fnrschlschluessel,kuerzel);search(dnrschluessel,TRUE );lang:=wert(
+fnrschllangtext);dbstatus=okENDPROC langtextgefunden;PROC lesemaskenwerte:
+familienname:=standardmaskenfeld(namefeldnr);rufname:=standardmaskenfeld(
+rufnamefeldnr);geburtsdatum:=standardmaskenfeld(geburtsdatumfeldnr);zeigen:=
+standardmaskenfeld(bildschirmfeldnr)<>niltextEND PROC lesemaskenwerte;PROC 
+ermittledievorliegendendaten:standardmeldung(wartemeldnr,niltext);IF 
+aktuelleshalbjahr=""THEN aktuelleshalbjahr:=schulkenndatum(textschulhalbjahr)
+;aktuellesschuljahr:=schulkenndatum(textschuljahr);FI ;
+uebernimmschluesselwerte;search(ixsustatfamrufgeb,FALSE );schuelergefunden:=(
+dbstatus=ok)CAND (wert(fnrsufamnames)=familienname)CAND (wert(fnrsurufnames)=
+rufnameCOR rufname="")CAND (wert(fnrsugebdatums)=datumskonversion(
+geburtsdatum)COR geburtsdatum="");IF schuelergefundenCAND abmeldungCAND 
+falschesabmelddatumTHEN schuelergefunden:=FALSE ;meldefalschesdatum;
+zurueckzumdialogELSE weiterverarbeitungFI .falschesabmelddatum:IF 
+schuljahranfang=""THEN schuljahranfang:=schulkenndatum(textschuljahranfang);
+schuljahrende:=schulkenndatum(textschuljahrende)FI ;NOT ((date(wert(
+fnrsuabgdats))>=date(schuljahranfang))CAND (date(wert(fnrsuabgdats))<=date(
+schuljahrende))).weiterverarbeitung:IF schuelergefundenTHEN 
+halbjahresdatenholen;ueberpruefeobkursdatenvorliegen;IF NOT hjdvorhandenTHEN 
+diffdatenholenFI ELSE meldeschuelerexistiertnicht;zurueckzumdialogFI .
+halbjahresdatenholen:inittupel(dnrhalbjahresdaten);TEXT VAR tidhjddaten:=wert
+(fnrsutidakthjd);readtid(dnrhalbjahresdaten,tidhjddaten).diffdatenholen:
+inittupel(dnrdiffdaten);TEXT VAR tiddiffdaten:=wert(fnrsutiddiffdaten);
+readtid(dnrdiffdaten,tiddiffdaten).meldeschuelerexistiertnicht:
+standardmeldung(existiertnichtmeldnr,niltext).meldefalschesdatum:
+standardmeldung(falschesdatum,niltext).ueberpruefeobkursdatenvorliegen:
+hjdvorhanden:=dbstatus=okCAND wert(fnrhjdfach)<>"".zurueckzumdialog:return(
+father).END PROC ermittledievorliegendendaten;PROC uebernimmschluesselwerte:
+putwert(fnrsustatuss,laufenderbestand);putwert(fnrsufamnames,familienname);
+putwert(fnrsurufnames,rufname);putwert(fnrsugebdatums,datumskonversion(
+geburtsdatum))ENDPROC uebernimmschluesselwerte;PROC mitteilungneuangstarten:
+reinitparsing;lesemaskenwerte;IF NOT (wahldruckeroderbildschirmok)THEN 
+meldedenfehler;zurueckzumdialogELSE IF (schluesselmitdatum)AND (NOT (datumok)
+)THEN meldefehlerbeidatum;zurueckzumdialogELSE IF (schluesselmitdatumXOR 
+schluesselohnedatumok)THEN neuangemeldeteweiterELSE meldedenfehler;
+zurueckzumdialogFI ;FI ;FI .neuangemeldeteweiter:abmeldung:=FALSE ;
+ermittledievorliegendendaten;IF schuelergefundenTHEN 
+initialisieredruckerfuermitteilung;IF hjdvorhandenTHEN anschreibenstart(
+ixsustatfamrufgeb,vordruckmithjd,zeigen,TRUE ,BOOL PROC 
+sonderwertemitteilungneuangmithjd,BOOL PROC dummystop)ELSE anschreibenstart(
+ixsustatfamrufgeb,vordruckmitdiffd,zeigen,TRUE ,BOOL PROC 
+sonderwertemitteilungneuangmitdiffd,BOOL PROC dummystop)FI ;FI ;.END PROC 
+mitteilungneuangstarten;PROC meldedenfehler:standardmeldung(fehlermeldnr,
+niltext)END PROC meldedenfehler;PROC zurueckzumdialog:return(father)END PROC 
+zurueckzumdialog;BOOL PROC wahldruckeroderbildschirmok:standardmaskenfeld(
+bildschirmfeldnr)<>niltextXOR standardmaskenfeld(druckerfeldnr)<>niltextEND 
+PROC wahldruckeroderbildschirmok;BOOL PROC schluesselmitdatum:familienname<>
+niltextAND rufname<>niltextAND geburtsdatum<>niltextEND PROC 
+schluesselmitdatum;BOOL PROC schluesselohnedatumok:familienname<>niltextAND 
+geburtsdatum=niltextEND PROC schluesselohnedatumok;BOOL PROC datumok:
+standardpruefe(6,6,0,0,niltext,eingabestatus);IF NOT (eingabestatus=0)THEN 
+FALSE ELSE TRUE FI END PROC datumok;PROC meldefehlerbeidatum:standardmeldung(
+datumfehler,niltext)END PROC meldefehlerbeidatum;PROC 
+mitteilungabmeldungstarten:reinitparsing;lesemaskenwerte;IF NOT (
+wahldruckeroderbildschirmok)THEN meldedenfehler;zurueckzumdialogELSE IF (
+schluesselmitdatum)AND (NOT (datumok))THEN meldefehlerbeidatum;
+zurueckzumdialogELSE IF (schluesselmitdatumXOR schluesselohnedatumok)THEN 
+abgemeldeteweiterELSE meldedenfehler;zurueckzumdialogFI ;FI ;FI .
+abgemeldeteweiter:abmeldung:=TRUE ;ermittledievorliegendendaten;IF 
+schuelergefundenTHEN initialisieredruckerfuermitteilung;anschreibenstart(
+ixsustatfamrufgeb,vordruckabmeldung,zeigen,TRUE ,BOOL PROC 
+sonderwertemitteilungabmeldung,BOOL PROC dummystop)FI .END PROC 
+mitteilungabmeldungstarten;BOOL PROC dummystop:TRUE ENDPROC dummystop;END 
+PACKET anschrmitteilungenneuangemeldeteundabgemeldete;
+
diff --git a/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung b/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung
new file mode 100644
index 0000000..27212bf
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.nachpruefungsbescheinigung
@@ -0,0 +1,150 @@
+PACKET anschrnachpruefungsbescheinigungDEFINES 
+nachpruefungsbescheinigungeingang,nachpruefungsbescheinigungende,
+nachpruefungsbescheinigungstarten,sonderwertenachpruefungsbescheinigung,
+multistopnachpruefbesch:INT VAR aktuellerindex;TEXT VAR schuelerschluessel1,
+schuelerschluessel2,schuelerschluessel3,bestandsschluessel1,
+bestandsschluessel2,aktuellesschuljahr,vorigesschuljahr;LET #
+schluesselversetztmitpruefung="n"#schluesselnachpruefung="n";#
+schluesselwiederholtmitpruefung="x",schluesselwiederholer="w";#LET vordruck=
+"vordruck nachpruefungsbescheinigung";LET maske=
+"ms auswahl schueler o. klasse";LET namefeldnr=2,vornamefeldnr=3,
+geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr=6,bildschirmfeldnr=7,
+druckerfeldnr=8;LET niltext="",trennsymbol=" ",punkt=".",meldkennz="#",
+fehlerhalbjnr=165,fehlermeldnr=56,#wartemeldnr=69,sortiervorgangwartemeldnr=
+76,#dieauswahlderjgstistnichtzulaessignr=146,vater=1;LET minjgst=5,jgst11=11,
+maxjgst=13;LET swschulhalbjahr=509,swzuname=511,swnamenszusaetze=512,
+swvornamen=513,swgeschlecht=514,swgeburtsdatum=515,swzugang=516,
+swjgstnachpruefung=517,swnachpruefungsfach=518,swparagraph=519,swbemerkung=
+520;LET maxanzahlderfaecher=100,fachschluesselindex=1,fachlangtextindex=2;
+ROW maxanzahlderfaecherROW fachlangtextindexTEXT VAR faecherkartei;INT VAR 
+anzahlderfaecher:=0;BOOL VAR eingang:=TRUE ,erstehalbjahr:=TRUE ,
+anschreibenzeigen;TEXT PROC langtextzufachschluessel(TEXT CONST schluessel):
+INT VAR zaehler:=1;TEXT VAR langtext:="";WHILE zaehler<anzahlderfaecherCAND 
+schluessel<>faecherkartei(zaehler)(fachschluesselindex)REP zaehlerINCR 1PER ;
+IF schluessel=faecherkartei(zaehler)(fachschluesselindex)THEN langtext:=
+faecherkartei(zaehler)(fachlangtextindex)FI ;langtextEND PROC 
+langtextzufachschluessel;PROC bildefaecherbestand:LET anzstacktupel=25;
+initialisierefaecherkartei;vorbereitung;leseschleife.
+initialisierefaecherkartei:INT VAR zaehler1,zaehler2;FOR zaehler1FROM 1UPTO 
+maxanzahlderfaecherREP FOR zaehler2FROM 1UPTO fachlangtextindexREP 
+faecherkartei(zaehler1)(zaehler2):=niltextPER PER .vorbereitung:BOOL VAR 
+wenigergelesen:=FALSE ;INT VAR anztupel;inittupel(dnrfaecher);anztupel:=
+anzstacktupel;anzahlderfaecher:=0;multisearchforward(dnrfaecher,anztupel);
+evtweniger.leseschleife:WHILE anztupel>0CAND anzahlderfaecher<=
+maxanzahlderfaecherREP anzahlderfaecherINCR 1;anztupelDECR 1;multisucc;
+faecherkartei(anzahlderfaecher)(1):=wert(dnrfaecher+1);faecherkartei(
+anzahlderfaecher)(2):=wert(dnrfaecher+2);IF anztupel=0CAND NOT wenigergelesen
+THEN anztupel:=anzstacktupel;multisucc(dnrfaecher,anztupel);evtwenigerFI PER 
+.evtweniger:IF anztupel<anzstacktupelTHEN wenigergelesen:=TRUE FI .END PROC 
+bildefaecherbestand;PROC nachpruefungsbescheinigungeingang:standardvproc(
+maske);IF eingangTHEN setzesonderwerteschulkenndaten;
+feststellenoberstehalbjahr;IF erstehalbjahrTHEN berechneschuljahre;
+bildefaecherbestand;FI ;aendernderflaggeFI .feststellenoberstehalbjahr:
+erstehalbjahr:=int(sonderwert(swschulhalbjahr))=1.aendernderflagge:eingang:=
+FALSE .berechneschuljahre:aktuellesschuljahr:=schulkenndatum("Schuljahr");
+vorigesschuljahr:=vorigesjahr.vorigesjahr:text(int(subtext(aktuellesschuljahr
+,1,2))-1)+text(int(subtext(aktuellesschuljahr,3,4))-1).END PROC 
+nachpruefungsbescheinigungeingang;PROC nachpruefungsbescheinigungende:eingang
+:=TRUE ;enter(2)END PROC nachpruefungsbescheinigungende;BOOL PROC 
+sonderwertenachpruefungsbescheinigung:initialisieresonderwerte;sucheschueler;
+sonderwertfuerdenadressaten;sonderwerteschuelerdaten;sonderwertartdeszugangs;
+sonderwertfuerdiejahrgangsstufe;sonderwertparagraph;
+sonderwertfuerdasnachpruefungsfach;sonderwertfuerbemerkung;TRUE .
+sucheschueler:inittupel(dnrschueler);uebernehmeentsprdaten;search(dnrschueler
+,TRUE ).uebernehmeentsprdaten:putwert(fnrsufamnames,wert(fnrhjdfamnames));
+putwert(fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(
+fnrhjdgebdats)).sonderwertfuerdenadressaten:adressat((wert(fnrsuvornames)SUB 
+1)+punkt+trennsymbol+wert(fnrsufamnames)).sonderwerteschuelerdaten:
+setzesonderwert(swzuname,wert(fnrsufamnames));setzesonderwert(
+swnamenszusaetze,wert(fnrsunamenszusatzs));setzesonderwert(swvornamen,wert(
+fnrsuvornames));setzesonderwert(swgeschlecht,wert(fnrsugeschlechts));
+setzesonderwert(swgeburtsdatum,wert(fnrsugebdatums));#setzesonderwert(
+swstrhausnr,wert(fnrsustrnrs));setzesonderwert(swplzort,wert(fnrsuplzorts));
+IF volljaehrig(wert(fnrsugebdatums))THEN setzesonderwert(swvollj,vollj);ELSE 
+setzesonderwert(swvollj,minderj)FI #.sonderwertartdeszugangs:IF #wert(
+fnrsuartzugang)="x"#bestandenTHEN setzesonderwert(swzugang,"")ELSE 
+setzesonderwert(swzugang,"x")FI .bestanden:TEXT VAR nachpruefergebnis:=wert(
+fnrhjdnacherg);(length(nachpruefergebnis)>1CAND int(nachpruefergebnis)>=4)
+COR (length(nachpruefergebnis)=1CAND int(nachpruefergebnis)<=4).
+sonderwertfuerdiejahrgangsstufe:#IF wert(fnrsuartzugang)="x"THEN 
+setzesonderwert(swjgstnachpruefung,text(int(wert(fnrsujgst))-1))ELSE 
+setzesonderwert(swjgstnachpruefung,wert(fnrsujgst))FI #setzesonderwert(
+swjgstnachpruefung,wert(fnrhjdjgst)).sonderwertparagraph:TEXT CONST 
+paragraphsek1:="Nr. 4 der Verordnung über die Abschlüsse und "+
+"die Versetzung in Sekundarstufe 1 (AVO - SI)",paragraphsek2:=
+"Nr. 11 der Verordnung über den Bildungsgang"+
+" und die Abiturprüfung der gymnasialen Oberstufe";IF int(wert(fnrhjdjgst))<
+jgst11THEN setzesonderwert(swparagraph,paragraphsek1)ELSE setzesonderwert(
+swparagraph,paragraphsek2)FI .sonderwertfuerdasnachpruefungsfach:TEXT VAR 
+fachschluessel:="";#TEXT VAR nachpruefungsfach:="";#TEXT VAR langtext:="";
+fachschluessel:=wert(fnrhjdnachfach);langtext:=langtextzufachschluessel(
+fachschluessel);setzesonderwert(swnachpruefungsfach,langtext).
+sonderwertfuerbemerkung:sucheschluesselbemerkung;
+suchelangtextzubemerkungundsetzesonderwert.sucheschluesselbemerkung:TEXT VAR 
+bemerkungsschluessel:="";bemerkungsschluessel:=wert(fnrhjdbemerk).
+suchelangtextzubemerkungundsetzesonderwert:#INT VAR bestandsid:=0;systemdbon;
+putwert(fnrsysbestand,"c02 bemerkungen");search(dnrsysbestaende,TRUE );IF 
+dbstatus=okTHEN bestandsid:=intwert(fnrsysbestandsid)FI ;systemdboff;#putwert
+(fnrschlsachgebiet,"c02 bemerkungen");putwert(fnrschlschluessel,
+bemerkungsschluessel);search(dnrschluessel,TRUE );IF dbstatus=okTHEN 
+setzesonderwert(swbemerkung,wert(fnrschllangtext))ELSE dbstatus(ok);
+setzesonderwert(swbemerkung,niltext)FI .END PROC 
+sonderwertenachpruefungsbescheinigung;PROC nachpruefungsbescheinigungstarten:
+IF erstehalbjahrTHEN lesemaskenwerte;IF maskenwerteinordnungTHEN IF 
+beibestandsauswahlauswahlzulaessigTHEN #bildebestand;IF status<>0AND NOT 
+einzelbearbeitungTHEN meldenichterstellbar;zurueckzumdialogELSE #
+startenausfuehren#FI #ELSE meldeunzulaessigeschuelergruppenauswahl;
+zurueckzumdialogFI ELSE meldedenfehler;zurueckzumdialogFI ELSE 
+meldefalscheshalbjahr;zurueckzumdialogFI .meldefalscheshalbjahr:LET 
+ersteshalbjahr="1";standardmeldung(fehlerhalbjnr,ersteshalbjahr+meldkennz).
+lesemaskenwerte:schuelerschluessel1:=standardmaskenfeld(namefeldnr);
+schuelerschluessel2:=standardmaskenfeld(vornamefeldnr);schuelerschluessel3:=
+standardmaskenfeld(geburtsdatumfeldnr);bestandsschluessel1:=
+standardmaskenfeld(jgstfeldnr);bestandsschluessel2:=standardmaskenfeld(
+zugtutorfeldnr);anschreibenzeigen:=standardmaskenfeld(bildschirmfeldnr)<>
+niltext.maskenwerteinordnung:IF NOT ((standardmaskenfeld(bildschirmfeldnr)<>
+niltext)XOR (standardmaskenfeld(druckerfeldnr)<>niltext))THEN infeld(
+bildschirmfeldnr);FALSE ELIF ((schuelerschluessel1<>niltextAND 
+bestandsschluessel1+bestandsschluessel2=niltextAND (schuelerschluessel2<>
+niltextXOR (schuelerschluessel2=niltextAND schuelerschluessel3=niltext)))XOR 
+(schuelerschluessel1+schuelerschluessel2+schuelerschluessel3=niltextAND 
+bestandsschluessel1<>niltext)XOR (schuelerschluessel1+schuelerschluessel2+
+schuelerschluessel3+bestandsschluessel1+bestandsschluessel2=niltext))THEN 
+TRUE ELSE infeld(namefeldnr);FALSE FI .meldedenfehler:standardmeldung(
+fehlermeldnr,niltext).zurueckzumdialog:return(vater).
+meldeunzulaessigeschuelergruppenauswahl:standardmeldung(
+dieauswahlderjgstistnichtzulaessignr,niltext).
+beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR (
+bestandsschluessel1<>niltextCAND int(bestandsschluessel1)<=maxjgstCAND int(
+bestandsschluessel1)>=minjgst).#einzelbearbeitung:schuelerschluessel1<>
+niltext.startenausfuehren:initialisieredruckerfueranschreiben;
+anschreibenstart(endbestand,vordruck,dbmnachpruefungsbescheinigung,
+schuelerschluessel1,schuelerschluessel2+schuelerschluessel3,anschreibenzeigen
+,laengedbmnachpruefungsbescheinigung,BOOL PROC 
+sonderwertenachpruefungsbescheinigung);.END PROC 
+nachpruefungsbescheinigungstarten;#startenausfuehren:
+initialisieredruckerfueranschreiben;dbstatus(ok);parsenooffields(44);
+indexnummerbestimmen;uebernimmentsprechendedaten;anschreibenstart(
+aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+
+schuelerschluessel2)<>"",BOOL PROC sonderwertenachpruefungsbescheinigung,
+BOOL PROC multistopnachpruefbesch).uebernimmentsprechendedaten:putwert(
+fnrhjdsj,#aktuellesschuljahr#vorigesschuljahr);putintwert(fnrhjdhj,2);putwert
+(fnrhjdfamnames,schuelerschluessel1);putwert(fnrhjdrufnames,
+schuelerschluessel2);putwert(fnrhjdgebdats,datumskonversion(
+schuelerschluessel3));putwert(fnrhjdjgst,bestandsschluessel1);putwert(
+fnrhjdkennung,bestandsschluessel2);putwert(fnrhjdversetzung,
+schluesselnachpruefung).indexnummerbestimmen:IF schuelerschluessel1<>niltext
+THEN aktuellerindex:=#dnrhjd#ixhjdverfamsjhjrufgebELSE aktuellerindex:=
+ixhjdversjhjjgstkennFI .END PROC nachpruefungsbescheinigungstarten;BOOL PROC 
+multistopnachpruefbesch:BOOL VAR b:=wert(fnrhjdsj)=#aktuellesschuljahr#
+vorigesschuljahrCAND intwert(fnrhjdhj)=2CAND wert(fnrhjdversetzung)=
+schluesselnachpruefung;IF bTHEN weitereueberpruefungFI ;b.
+weitereueberpruefung:IF aktuellerindex=ixhjdverfamsjhjrufgebTHEN 
+ueberpruefenamenELSE IF bestandsschluessel1<>""THEN ueberpruefejgstFI FI .
+ueberpruefenamen:b:=wert(fnrhjdfamnames)=schuelerschluessel1CAND (
+schuelerschluessel2=""COR wert(fnrhjdrufnames)=schuelerschluessel2)CAND (
+schuelerschluessel3=""COR wert(fnrhjdgebdats)=datumskonversion(
+schuelerschluessel3)).ueberpruefejgst:b:=bestandsschluessel1=wert(fnrhjdjgst)
+CAND (bestandsschluessel2=""COR bestandsschluessel2=wert(fnrhjdkennung)).
+ENDPROC multistopnachpruefbesch;END PACKET anschrnachpruefungsbescheinigung;
+
diff --git a/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung b/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung
new file mode 100644
index 0000000..871d9b6
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.nachpruefungszulassung
@@ -0,0 +1,146 @@
+PACKET anschrnachpruefungszulassungDEFINES nachpruefungszulassungeingang,
+nachpruefungszulassungende,nachpruefungszulassungstarten,
+sonderwertenachpruefungszulassung,multistopnachpruefler:INT VAR 
+aktuellerindex;TEXT VAR schuelerschluessel1,schuelerschluessel2,
+schuelerschluessel3,bestandsschluessel1,bestandsschluessel2,
+aktuellesschuljahr;LET schluesselnachpruefung="n";LET vordruck=
+"vordruck nachpruefungszulassung";LET maske="ms anschr schueler o. klasse";
+LET namefeldnr=2,vornamefeldnr=3,geburtsdatumfeldnr=4,jgstfeldnr=5,
+zugtutorfeldnr=6,bildschirmfeldnr=7,druckerfeldnr=8;LET niltext="",
+trennsymbol=" ",vollj="v",minderj="m",oder=" oder ",punkt=".",meldkennz="#",
+fehlerhalbjnr=167,fehlermeldnr=56,#wartemeldnr=69,#
+dieauswahlderjgstistnichtzulaessignr=146,#
+anschreibenkannnichterstelltwerdennr=124,#vater=1;LET minjgst=5,jgst11=11,
+maxjgst=13;LET swschulhalbjahr=509,swzuname=511,swnamenszusaetze=512,
+swvornamen=513,swgeschlecht=514,swvollj=515,swstrhausnr=517,swplzort=518,
+swnameerzieher=519,swnamenszusaetzeerzieher=520,swvornameerzieher=521,
+swstrhausnrerzieher=522,swplzorterzieher=523,swparagraph=524,
+swnachpruefungsfaecher=525,swbemerkung=526;LET maxanzahlderfaecher=100,
+karteifachlangtext=2,fachschluesselindex=1,fachlangtextindex=2;ROW 
+maxanzahlderfaecherROW karteifachlangtextTEXT VAR faecherkartei;INT VAR 
+anzahlderfaecher:=0;BOOL VAR eingang:=TRUE ,zweitehalbjahr:=TRUE ,
+anschreibenzeigen;PROC bildefaecherbestand:LET anzstacktupel=25;
+initialisierefaecherkartei;vorbereitung;leseschleife.
+initialisierefaecherkartei:INT VAR zaehler1,zaehler2;FOR zaehler1FROM 1UPTO 
+maxanzahlderfaecherREP FOR zaehler2FROM 1UPTO karteifachlangtextREP 
+faecherkartei(zaehler1)(zaehler2):=niltextPER PER .vorbereitung:BOOL VAR 
+wenigergelesen:=FALSE ;INT VAR anztupel;inittupel(dnrfaecher);anztupel:=
+anzstacktupel;anzahlderfaecher:=0;multisearchforward(dnrfaecher,anztupel);
+evtweniger.leseschleife:WHILE anztupel>0CAND anzahlderfaecher<=
+maxanzahlderfaecherREP anzahlderfaecherINCR 1;anztupelDECR 1;multisucc;
+faecherkartei(anzahlderfaecher)(1):=wert(dnrfaecher+1);faecherkartei(
+anzahlderfaecher)(2):=wert(dnrfaecher+2);IF anztupel=0CAND NOT wenigergelesen
+THEN anztupel:=anzstacktupel;multisucc(dnrfaecher,anztupel);evtwenigerFI PER 
+.evtweniger:IF anztupel<anzstacktupelTHEN wenigergelesen:=TRUE FI .END PROC 
+bildefaecherbestand;TEXT PROC langtextzufachschluessel(TEXT CONST schluessel)
+:INT VAR zaehler:=1;TEXT VAR langtext:="";WHILE zaehler<anzahlderfaecherCAND 
+schluessel<>faecherkartei(zaehler)(fachschluesselindex)REP zaehlerINCR 1PER ;
+IF schluessel=faecherkartei(zaehler)(fachschluesselindex)THEN langtext:=
+faecherkartei(zaehler)(fachlangtextindex)FI ;langtextEND PROC 
+langtextzufachschluessel;PROC nachpruefungszulassungeingang:standardvproc(
+maske);IF eingangTHEN setzesonderwerteschulkenndaten;
+feststellenobzweitehalbjahr;IF zweitehalbjahrTHEN bildefaecherbestand;FI ;
+aendernderflaggeFI .feststellenobzweitehalbjahr:zweitehalbjahr:=int(
+sonderwert(swschulhalbjahr))=2.aendernderflagge:eingang:=FALSE .END PROC 
+nachpruefungszulassungeingang;PROC nachpruefungszulassungende:eingang:=TRUE ;
+enter(2)END PROC nachpruefungszulassungende;BOOL PROC 
+sonderwertenachpruefungszulassung:initialisieresonderwerte;sucheschueler;
+sonderwertfuerdenadressaten;sonderwerteschuelerdaten;sonderwerteerzieherdaten
+;sonderwertparagraph;sonderwertfuerdienachpruefungsfaecher;
+sonderwertfuerbemerkung;TRUE .sucheschueler:inittupel(dnrschueler);
+uebernehmeentsprdaten;search(dnrschueler,TRUE ).uebernehmeentsprdaten:putwert
+(fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert(
+fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats)).
+sonderwertfuerdenadressaten:adressat((wert(fnrsuvornames)SUB 1)+punkt+
+trennsymbol+wert(fnrsufamnames)).sonderwerteschuelerdaten:setzesonderwert(
+swzuname,wert(fnrsufamnames));setzesonderwert(swnamenszusaetze,wert(
+fnrsunamenszusatzs));setzesonderwert(swvornamen,wert(fnrsuvornames));
+setzesonderwert(swgeschlecht,wert(fnrsugeschlechts));setzesonderwert(
+swstrhausnr,wert(fnrsustrnrs));setzesonderwert(swplzort,wert(fnrsuplzorts));
+IF volljaehrig(wert(fnrsugebdatums))THEN setzesonderwert(swvollj,vollj);ELSE 
+setzesonderwert(swvollj,minderj)FI .sonderwerteerzieherdaten:setzesonderwert(
+swnameerzieher,wert(fnrsufamnamee));setzesonderwert(swnamenszusaetzeerzieher,
+wert(fnrsunamenszusatze));setzesonderwert(swvornameerzieher,wert(
+fnrsuvornamee));sucheerzieheradresse;setzesonderwert(swstrhausnrerzieher,wert
+(fnrsustrnrs));setzesonderwert(swplzorterzieher,wert(fnrsuplzorts));.
+sucheerzieheradresse:#IF wert(fnradresse)<>""THEN putwert(fnradrkuerzel,wert(
+fnradresse));search(dnradressen,TRUE );IF dbstatus=okTHEN 
+uebernehmeerzieheradresseELSE dbstatus(ok)FI FI #IF wert(fnrsuplzorte)<>""
+THEN uebernehmeerzieheradresseFI .uebernehmeerzieheradresse:putwert(
+fnrsustrnrs,wert(fnrsustrnre));putwert(fnrsuplzorts,wert(fnrsuplzorte)).
+sonderwertparagraph:TEXT CONST paragraphsek1:=
+"Nr. 4 der Verordnung über die Abschlüsse und "+
+"die Versetzung in Sekundarstufe 1 (AVO - SI)",paragraphsek2:=
+"Nr. 11 der Verordnung über den Bildungsgang"+
+" und die Abiturprüfung der gymnasialen Oberstufe";IF int(wert(fnrhjdjgst))<
+jgst11THEN setzesonderwert(swparagraph,paragraphsek1)ELSE setzesonderwert(
+swparagraph,paragraphsek2)FI .sonderwertfuerdienachpruefungsfaecher:TEXT VAR 
+fachschluessel:="";TEXT VAR nachpruefungsfach:="";TEXT VAR langtext:="";
+bestimmungderfaecherindennachpruefungmoeglich;setzesonderwert(
+swnachpruefungsfaecher,nachpruefungsfach).
+bestimmungderfaecherindennachpruefungmoeglich:fachschluessel:=wert(
+fnrhjdnachfach1);langtext:=langtextzufachschluessel(fachschluessel);IF 
+langtext<>niltextTHEN nachpruefungsfach:=langtext;fachschluessel:=wert(
+fnrhjdnachfach2);langtext:=langtextzufachschluessel(fachschluessel);IF 
+langtext<>niltextTHEN nachpruefungsfach:=nachpruefungsfach+oder+langtext;
+fachschluessel:=wert(fnrhjdnachfach3);langtext:=langtextzufachschluessel(
+fachschluessel);IF langtext<>niltextTHEN nachpruefungsfach:=nachpruefungsfach
++oder+langtextFI FI FI .sonderwertfuerbemerkung:sucheschluesselbemerkung;
+suchelangtextzubemerkungundsetzesonderwert.sucheschluesselbemerkung:TEXT VAR 
+bemerkungsschluessel:="";bemerkungsschluessel:=wert(fnrhjdbemnach).
+suchelangtextzubemerkungundsetzesonderwert:putwert(fnrschlsachgebiet,
+"c02 bemerkungen");putwert(fnrschlschluessel,bemerkungsschluessel);search(
+dnrschluessel,TRUE );IF dbstatus=okTHEN setzesonderwert(swbemerkung,wert(
+fnrschllangtext))ELSE dbstatus(ok);setzesonderwert(swbemerkung,niltext)FI .
+END PROC sonderwertenachpruefungszulassung;PROC nachpruefungszulassungstarten
+:IF zweitehalbjahrTHEN lesemaskenwerte;IF maskenwerteinordnungTHEN IF 
+beibestandsauswahlauswahlzulaessigTHEN startenausfuehrenELSE 
+meldeunzulaessigeschuelergruppenauswahl;zurueckzumdialogFI ELSE 
+meldedenfehler;zurueckzumdialogFI ELSE meldefalscheshalbjahr;zurueckzumdialog
+FI .meldefalscheshalbjahr:LET zweiteshalbjahr="2";standardmeldung(
+fehlerhalbjnr,zweiteshalbjahr+meldkennz).lesemaskenwerte:schuelerschluessel1
+:=standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld(
+vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr);
+bestandsschluessel1:=standardmaskenfeld(jgstfeldnr);bestandsschluessel2:=
+standardmaskenfeld(zugtutorfeldnr);anschreibenzeigen:=standardmaskenfeld(
+bildschirmfeldnr)<>niltext.maskenwerteinordnung:IF NOT ((standardmaskenfeld(
+bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld(druckerfeldnr)<>niltext))
+THEN infeld(bildschirmfeldnr);FALSE ELIF ((schuelerschluessel1<>niltextAND 
+bestandsschluessel1+bestandsschluessel2=niltextAND (schuelerschluessel2<>
+niltextXOR (schuelerschluessel2=niltextAND schuelerschluessel3=niltext)))XOR 
+(schuelerschluessel1+schuelerschluessel2+schuelerschluessel3=niltextAND 
+bestandsschluessel1<>niltext)XOR (schuelerschluessel1+schuelerschluessel2+
+schuelerschluessel3+bestandsschluessel1+bestandsschluessel2=niltext))THEN 
+TRUE ELSE infeld(namefeldnr);FALSE FI .meldedenfehler:standardmeldung(
+fehlermeldnr,niltext).zurueckzumdialog:return(vater).
+meldeunzulaessigeschuelergruppenauswahl:standardmeldung(
+dieauswahlderjgstistnichtzulaessignr,niltext).
+beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR (
+bestandsschluessel1<>niltextCAND int(bestandsschluessel1)<=maxjgstCAND int(
+bestandsschluessel1)>=minjgst).startenausfuehren:
+initialisieredruckerfueranschreiben;dbstatus(ok);parsenooffields(30);
+indexnummerbestimmen;uebernimmentsprechendedaten;anschreibenstart(
+aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+
+schuelerschluessel2)<>"",BOOL PROC sonderwertenachpruefungszulassung,BOOL 
+PROC multistopnachpruefler).uebernimmentsprechendedaten:aktuellesschuljahr:=
+schulkenndatum("Schuljahr");putwert(fnrhjdsj,aktuellesschuljahr);putintwert(
+fnrhjdhj,2);putwert(fnrhjdfamnames,schuelerschluessel1);putwert(
+fnrhjdrufnames,schuelerschluessel2);putwert(fnrhjdgebdats,datumskonversion(
+schuelerschluessel3));putwert(fnrhjdjgst,bestandsschluessel1);putwert(
+fnrhjdkennung,bestandsschluessel2);putwert(fnrhjdversetzung,
+schluesselnachpruefung).indexnummerbestimmen:IF schuelerschluessel1<>niltext
+THEN aktuellerindex:=#dnrhalbjahresdaten#ixhjdverfamsjhjrufgebELSE 
+aktuellerindex:=ixhjdversjhjjgstkennFI .END PROC 
+nachpruefungszulassungstarten;BOOL PROC multistopnachpruefler:BOOL VAR b:=
+wert(fnrhjdsj)=aktuellesschuljahrCAND intwert(fnrhjdhj)=2CAND wert(
+fnrhjdversetzung)=schluesselnachpruefung;IF bTHEN weitereueberpruefungFI ;b.
+weitereueberpruefung:IF aktuellerindex=ixhjdverfamsjhjrufgebTHEN 
+ueberpruefenamenELSE IF bestandsschluessel1<>""THEN ueberpruefejgstFI FI .
+ueberpruefenamen:b:=wert(fnrhjdfamnames)=schuelerschluessel1CAND (
+schuelerschluessel2=""COR wert(fnrhjdrufnames)=schuelerschluessel2)CAND (
+schuelerschluessel3=""COR wert(fnrhjdgebdats)=datumskonversion(
+schuelerschluessel3)).ueberpruefejgst:b:=int(bestandsschluessel1)=intwert(
+fnrhjdjgst)CAND (bestandsschluessel2=""COR bestandsschluessel2=wert(
+fnrhjdkennung)).ENDPROC multistopnachpruefler;END PACKET 
+anschrnachpruefungszulassung;
+
diff --git a/app/schulis/2.2.1/src/1.anschr.schulbescheinigung b/app/schulis/2.2.1/src/1.anschr.schulbescheinigung
new file mode 100644
index 0000000..16686b2
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.schulbescheinigung
@@ -0,0 +1,61 @@
+PACKET anschrschulbescheinigungDEFINES schulbescheinigungeingang,
+schulbescheinigungstarten,sonderwerteschulbescheinigung,
+multistopschulbescheinigung:TEXT VAR schuelerschluessel1,schuelerschluessel2,
+schuelerschluessel3,bestandsschluessel1,bestandsschluessel2;BOOL VAR 
+anschreibenzeigen;INT VAR aktuellerindex,eingabestatus;LET vordruck=
+"vordruck schulbescheinigung";LET trennsymbol=" ",punkt=".";LET maske=
+"ms auswahl schueler o. klasse",namefeldnr=2,vornamefeldnr=3,
+geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr=6,bildschirmfeldnr=7,
+druckerfeldnr=8,niltext="",fehlermeldnr=56,wartemeldnr=69,datumfehler=157,
+vater=1;PROC schulbescheinigungeingang:standardvproc(maske)END PROC 
+schulbescheinigungeingang;BOOL PROC sonderwerteschulbescheinigung:adressat((
+wert(fnrsurufnames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));TRUE END 
+PROC sonderwerteschulbescheinigung;PROC schulbescheinigungstarten:
+lesemaskenwerte;IF NOT (auswahldruckeroderbildschirmok)THEN meldedenfehler;
+infeld(bildschirmfeldnr);zurueckzumdialogELSE IF schluesselmitdatumangegeben
+THEN IF schuelerschluessel3okTHEN indexnrbilden;startenausfuehrenELSE 
+standardmeldung(datumfehler,niltext);infeld(geburtsdatumfeldnr);
+zurueckzumdialogFI ;ELSE IF (alleschuelergewaehltXOR schuelergruppegewaehlt
+XOR einschuelerohnedatumgewaehlt)THEN indexnrbilden;startenausfuehrenELSE 
+meldedenfehler;zurueckzumdialogFI ;FI ;FI .lesemaskenwerte:
+schuelerschluessel1:=standardmaskenfeld(namefeldnr);schuelerschluessel2:=
+standardmaskenfeld(vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(
+geburtsdatumfeldnr);bestandsschluessel1:=standardmaskenfeld(jgstfeldnr);
+bestandsschluessel2:=standardmaskenfeld(zugtutorfeldnr);anschreibenzeigen:=
+standardmaskenfeld(bildschirmfeldnr)<>niltext.auswahldruckeroderbildschirmok:
+(standardmaskenfeld(bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld(
+druckerfeldnr)<>niltext).schluesselmitdatumangegeben:((bestandsschluessel1+
+bestandsschluessel2)=niltextAND schuelerschluessel1<>niltextAND 
+schuelerschluessel2<>niltextAND schuelerschluessel3<>niltext).
+alleschuelergewaehlt:(schuelerschluessel1+schuelerschluessel2+
+schuelerschluessel3+bestandsschluessel1+bestandsschluessel2)=niltext.
+schuelergruppegewaehlt:bestandsschluessel1<>niltextAND (schuelerschluessel1+
+schuelerschluessel2+schuelerschluessel3=niltext).einschuelerohnedatumgewaehlt
+:(bestandsschluessel1+bestandsschluessel2+schuelerschluessel3)=niltextAND 
+schuelerschluessel1<>niltext.schuelerschluessel3ok:standardpruefe(6,4,0,0,
+niltext,eingabestatus);IF NOT (eingabestatus=0)THEN FALSE ELSE TRUE FI .
+meldedenfehler:standardmeldung(fehlermeldnr,niltext).zurueckzumdialog:return(
+vater).indexnrbilden:standardmeldung(wartemeldnr,niltext);IF 
+bestandsschluessel1<>niltextTHEN IF bestandsschluessel2<>niltextTHEN 
+aktuellerindex:=ixsustatjgstzugELSE aktuellerindex:=ixsustatjgstFI ELSE 
+aktuellerindex:=dnrschuelerFI .startenausfuehren:
+initialisieredruckerfueranschreiben;#anschreibenstart(bestand,vordruck,
+dbmschulbescheinigung,schuelerschluessel1,schuelerschluessel2+
+schuelerschluessel3,anschreibenzeigen,laengedbmschulbescheinigung,BOOL PROC 
+sonderwerteschulbescheinigung);#dbstatus(ok);inittupel(dnrschueler);
+parsenooffields(19);uebernimmentsprechendedaten;anschreibenstart(
+aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+
+schuelerschluessel2)<>"",BOOL PROC sonderwerteschulbescheinigung,BOOL PROC 
+multistopschulbescheinigung).uebernimmentsprechendedaten:putwert(
+fnrsufamnames,schuelerschluessel1);putwert(fnrsurufnames,schuelerschluessel2)
+;putwert(fnrsugebdatums,datumskonversion(schuelerschluessel3));putwert(
+fnrsusgrpjgst,bestandsschluessel1);putwert(fnrsusgrpzugtut,
+bestandsschluessel2);putwert(fnrsustatuss,"ls").END PROC 
+schulbescheinigungstarten;BOOL PROC multistopschulbescheinigung:BOOL VAR b:=
+FALSE ;IF wert(fnrsustatuss)="ls"THEN IF aktuellerindex<>dnrschuelerTHEN IF 
+aktuellerindex=ixsustatjgstTHEN b:=bestandsschluessel1=wert(fnrsusgrpjgst)
+ELSE b:=(bestandsschluessel1=wert(fnrsusgrpjgst)CAND bestandsschluessel2=wert
+(fnrsusgrpzugtut))FI ELSE b:=(schuelerschluessel1<>niltextCAND dbstatus=ok)
+COR (schuelerschluessel1=niltextCAND TRUE )FI ;FI ;bENDPROC 
+multistopschulbescheinigung;END PACKET anschrschulbescheinigung;
+
diff --git a/app/schulis/2.2.1/src/1.anschr.wiederholer b/app/schulis/2.2.1/src/1.anschr.wiederholer
new file mode 100644
index 0000000..8de4b25
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.anschr.wiederholer
@@ -0,0 +1,91 @@
+PACKET anschrwiederholerDEFINES wiederholereingang,wiederholerstarten,
+sonderwertewiederholer,multistopwiederholer:INT VAR aktuellerindex;TEXT VAR 
+schuelerschluessel1,schuelerschluessel2,schuelerschluessel3,
+bestandsschluessel1,bestandsschluessel2,aktuellesschuljahr:="";LET vordruck=
+"vordruck fuer wiederholer";LET swindexvolljminderj=511,
+swindexminderjmaennlweibl=512,swindexnichterreichtejgst=513;LET jgst13=13,
+weibl="w",maennl="m",minderj="m",vollj="v",niltext="",trennsymbol=" ",punkt=
+".",schluesselwiederholer="w";LET maske="ms anschr schueler o. klasse";LET 
+namefeldnr=2,vornamefeldnr=3,geburtsdatumfeldnr=4,jgstfeldnr=5,zugtutorfeldnr
+=6,bildschirmfeldnr=7,druckerfeldnr=8;LET fehlermeldnr=56,nurimzweitenhj=194,
+#wartemeldnr=69,anschreibenkannnichterstelltwerdennr=124,#
+dieauswahlderjgstistnichtzulaessignr=146,vater=1;LET minjgst=5,maxjgst=13;
+PROC wiederholereingang:standardvproc(maske)END PROC wiederholereingang;BOOL 
+PROC sonderwertewiederholer:BOOL VAR erstellbar:=TRUE ;sucheschuelerdaten;
+sonderwertfuervolljoderminderjundmaennlweibl;sonderwertfuernichterreichtejgst
+;sonderwertfueradressaten;erstellbar#keitsangabe#.sucheschuelerdaten:
+inittupel(dnrschueler);uebernimmschuelerdaten;search(dnrschueler,TRUE ).
+uebernimmschuelerdaten:putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert(
+fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats
+)).sonderwertfuervolljoderminderjundmaennlweibl:IF volljaehrig(wert(
+fnrsugebdatums))THEN setzesonderwert(swindexvolljminderj,vollj);
+setzesonderwert(swindexminderjmaennlweibl,niltext)ELSE setzesonderwert(
+swindexvolljminderj,minderj);IF wert(fnrsugeschlechts)=weiblTHEN 
+setzesonderwert(swindexminderjmaennlweibl,weibl)ELSE setzesonderwert(
+swindexminderjmaennlweibl,maennl)FI ;setzeerzieheradresseFI .
+setzeerzieheradresse:#IF intwert(fnradresse)<>0THEN putwert(fnradrkuerzel,
+wert(fnradresse));search(dnradressen,TRUE );IF dbstatus=okTHEN putwert(
+fnrsustrnrs,wert(fnradrstrasse));putwert(fnrsuplzorts,wert(fnradrort))FI FI #
+IF wert(fnrsuplzorte)<>""THEN putwert(fnrsustrnrs,wert(fnrsustrnre));putwert(
+fnrsuplzorts,wert(fnrsuplzorts))FI .sonderwertfuernichterreichtejgst:
+setzesonderwert(swindexnichterreichtejgst,text(intwert(fnrhjdjgst)+1));
+erstellbar:=NOT (intwert(fnrhjdjgst)=jgst13).sonderwertfueradressaten:
+adressat((wert(fnrsurufnames)SUB 1)+punkt+trennsymbol+wert(fnrsufamnames));.#
+erstellbarkeitsangabe:IF intwert(fnrzugang)=schluesselwiederholerTHEN 
+erstellbar:=wert(dbmindexversetzung,zweiteteilsegment)=schluesselwiederholer
+AND erstellbarELSE erstellbar:=(dbwert(dbmindexversetzung,ersteteilsegment)=
+schluesselwiederholer)AND erstellbarFI ;erstellbar.#END PROC 
+sonderwertewiederholer;PROC wiederholerstarten:IF zweiteshjTHEN weiterFI .
+weiter:lesemaskenwerte;IF maskenwerteinordnungTHEN IF 
+beibestandsauswahlauswahlzulaessigTHEN #bestandbilden;IF status<>0THEN 
+meldenichterstellbar;zurueckzumdialogELSE #indexnummerbestimmen;
+startenausfuehren#FI #ELSE meldeunzulaessigeschuelergruppenauswahl;
+zurueckzumdialogFI ELSE meldedenfehler;zurueckzumdialogFI .zweiteshj:IF int(
+schulkenndatum("Schulhalbjahr"))=1THEN standardmeldung(nurimzweitenhj,"2.#");
+zurueckzumdialog;FALSE ELSE TRUE FI .lesemaskenwerte:schuelerschluessel1:=
+standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld(
+vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr);
+bestandsschluessel1:=standardmaskenfeld(jgstfeldnr);bestandsschluessel2:=
+standardmaskenfeld(zugtutorfeldnr);BOOL CONST anschreibenzeigen:=
+standardmaskenfeld(bildschirmfeldnr)<>niltext.maskenwerteinordnung:IF NOT ((
+standardmaskenfeld(bildschirmfeldnr)<>niltext)XOR (standardmaskenfeld(
+druckerfeldnr)<>niltext))THEN infeld(bildschirmfeldnr);FALSE ELIF ((
+schuelerschluessel1<>niltextAND bestandsschluessel1+bestandsschluessel2=
+niltextAND (schuelerschluessel2<>niltextXOR (schuelerschluessel2=niltextAND 
+schuelerschluessel3=niltext)))XOR (schuelerschluessel1+schuelerschluessel2+
+schuelerschluessel3=niltextAND bestandsschluessel1<>niltext)XOR (
+schuelerschluessel1+schuelerschluessel2+schuelerschluessel3+
+bestandsschluessel1+bestandsschluessel2=niltext))THEN TRUE ELSE infeld(
+namefeldnr);FALSE FI .meldedenfehler:standardmeldung(fehlermeldnr,niltext).
+zurueckzumdialog:return(vater).#meldenichterstellbar:standardmeldung(
+anschreibenkannnichterstelltwerdennr,niltext);.#
+meldeunzulaessigeschuelergruppenauswahl:standardmeldung(
+dieauswahlderjgstistnichtzulaessignr,niltext).
+beibestandsauswahlauswahlzulaessig:(bestandsschluessel1=niltext)OR (
+bestandsschluessel1<>niltextCAND int(bestandsschluessel1)<maxjgstCAND int(
+bestandsschluessel1)>=minjgst).startenausfuehren:
+initialisieredruckerfueranschreiben;dbstatus(ok);inittupel(dnrhalbjahresdaten
+);parsenooffields(28);uebernimmentsprechendedaten;anschreibenstart(
+aktuellerindex,vordruck,anschreibenzeigen,(schuelerschluessel1+
+schuelerschluessel2)<>"",BOOL PROC sonderwertewiederholer,BOOL PROC 
+multistopwiederholer).uebernimmentsprechendedaten:putwert(fnrhjdfamnames,
+schuelerschluessel1);putwert(fnrhjdrufnames,schuelerschluessel2);putwert(
+fnrhjdgebdats,datumskonversion(schuelerschluessel3));aktuellesschuljahr:=
+schulkenndatum("Schuljahr");putwert(fnrhjdsj,aktuellesschuljahr);putintwert(
+fnrhjdhj,2);putwert(fnrhjdjgst,bestandsschluessel1);putwert(fnrhjdkennung,
+bestandsschluessel2);putwert(fnrhjdversetzung,schluesselwiederholer);.
+indexnummerbestimmen:IF schuelerschluessel1<>niltextTHEN aktuellerindex:=#
+dnrhalbjahresdaten#ixhjdverfamsjhjrufgebELSE aktuellerindex:=
+ixhjdversjhjjgstkennFI .END PROC wiederholerstarten;BOOL PROC 
+multistopwiederholer:BOOL VAR b:=wert(fnrhjdsj)=aktuellesschuljahrCAND 
+intwert(fnrhjdhj)=2CAND wert(fnrhjdversetzung)=schluesselwiederholer;IF b
+THEN weitereueberpruefungFI ;b.weitereueberpruefung:IF aktuellerindex=
+ixhjdverfamsjhjrufgebTHEN ueberpruefenamenELSE IF bestandsschluessel1<>""
+THEN ueberpruefejgstFI FI .ueberpruefenamen:b:=wert(fnrhjdfamnames)=
+schuelerschluessel1CAND (schuelerschluessel2=""COR wert(fnrhjdrufnames)=
+schuelerschluessel2)CAND (schuelerschluessel3=""COR wert(fnrhjdgebdats)=
+datumskonversion(schuelerschluessel3)).ueberpruefejgst:b:=int(
+bestandsschluessel1)=intwert(fnrhjdjgst)CAND (bestandsschluessel2=""COR 
+bestandsschluessel2=wert(fnrhjdkennung)).ENDPROC multistopwiederholer;END 
+PACKET anschrwiederholer;
+
diff --git a/app/schulis/2.2.1/src/1.auskunft.betroffene b/app/schulis/2.2.1/src/1.auskunft.betroffene
new file mode 100644
index 0000000..bfa245d
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.auskunft.betroffene
@@ -0,0 +1,259 @@
+PACKET auskbetroffenDEFINES auskbetroffeneingang,auskbetroffenstarten,
+auskbetroffensonderwerte:TEXT VAR schuelerschluessel1,schuelerschluessel2,
+schuelerschluessel3;LET swiort=511,swiwohntbei=512,swilangtextortsteil=513,
+swilangtexterzber=514,swiorterzber=515,swilangtextstaatsan=516,
+swilangtextsprache=517,swilangtextspaetaus=518,swilangtextgeschl=519,
+swilangtextrelizug=520,swilangtextrelizeugnis=521,swiortletzteschule=522,
+swilangtextschulform=523,swiaufbschuljeintrsek2=524,swilangtextzugang=525,
+swilangtextabgang=526,swilangtextabschluss=527,swiortneueschule=528,
+swilangtextfremdspr1=537,swiaufbhjafremdspr1=538,swiaufbhjefremdspr1=539,
+swilangtextfremdspr2=540,swiaufbhjafremdspr2=541,swiaufbhjefremdspr2=542,
+swilangtextfremdspr3=543,swiaufbhjafremdspr3=544,swiaufbhjefremdspr3=545,
+swilangtextfremdspr4=546,swiaufbhjafremdspr4=547,swiaufbhjefremdspr4=548,
+swilangtextreliunt=549,swilangtextkumu=550,swilangtextwpf191=551,
+swilangtextwpf291=552,swilangtextwpf192=553,swilangtextwpf292=554,
+swilangtextwpf1101=555,swilangtextwpf2101=556,swilangtextwpf1102=557,
+swilangtextwpf2102=558,swilangtextag1=559,swiaufbhjaag1=560,swiaufbhjeag1=561
+,swilangtextag2=562,swiaufbhjaag2=563,swiaufbhjeag2=564,swilangtextag3=565,
+swiaufbhjaag3=566,swiaufbhjeag3=567,swistrasseerz=568,switelerz=569,
+swinameletzte=570,swistrasseletzte=571,swinameneue=572,swistrasseneue=573,
+swischulform=582,swilangtextstatus=583;LET suffix1="c02 ortsteil",suffix2=
+"c02 verwandtschaft",suffix3="c02 staaten",suffix4="c02 sprachen",suffix5=
+"c02 relizugehoerigkeit",suffix6="c02 schulart",suffix7="c02 zugang",suffix8=
+"c02 abgang",suffix9="c02 abschluss",suffix12="c02 blauer brief",suffix13=
+"c02 bemerkungen",suffix14="c02 versetzung",namefeldnr=2,vornamefeldnr=3,
+geburtsdatumfeldnr=4,niltext="",null=0,blank=" ",punkt=".",kla="(",klz=")",
+fehlermeld1=56,fehlermeld2=157,wartemeldnr=69,vater=1,maske=
+"ms auswahl schueler o. klasse mit bestand";TEXT VAR aktjgsthj;INT VAR 
+aktuellesschuljahr,aktuelleshalbjahr,jahr,halbjahr,eingabestatus;INT VAR 
+gewindex;BOOL CONST anschreibenzeigen:=FALSE ;PROC auskbetroffeneingang:
+standardvproc(maske)END PROC auskbetroffeneingang;PROC auskbetroffenstarten:
+lesemaskenwerte;IF schluesselmitdatumangegebenTHEN IF datumseingabekorrekt
+THEN fortfahrenELSE meldungdatumnichtkorrekt;zurueckzumdialogFI ;ELSE IF 
+schlüsselohnedatumkorrektTHEN fortfahrenELSE meldungauswahlnichtsinnvoll;
+zurueckzumdialogFI ;FI .schluesselmitdatumangegeben:schuelerschluessel1<>
+niltextCAND schuelerschluessel2<>niltextCAND schuelerschluessel3<>niltext.
+datumseingabekorrekt:standardpruefe(6,4,0,0,niltext,eingabestatus);
+eingabestatus=0.schlüsselohnedatumkorrekt:schuelerschluessel3=niltextCAND 
+schuelerschluessel1<>niltext.fortfahren:setzemitseitennummern(TRUE );gewindex
+:=dnrschueler;startenausfuehren.lesemaskenwerte:schuelerschluessel1:=
+standardmaskenfeld(namefeldnr);schuelerschluessel2:=standardmaskenfeld(
+vornamefeldnr);schuelerschluessel3:=standardmaskenfeld(geburtsdatumfeldnr).
+meldungauswahlnichtsinnvoll:standardmeldung(fehlermeld1,niltext).
+meldungdatumnichtkorrekt:standardmeldung(fehlermeld2,niltext).
+zurueckzumdialog:return(vater).startenausfuehren:BOOL CONST einzelbearbeitung
+:=TRUE ;reinitparsing;standardmeldung(wartemeldnr,niltext);#dr20.08.87#
+aktjgsthj:=schulkenndatum("Schulhalbjahr");aktuelleshalbjahr:=int(aktjgsthj);
+aktuellesschuljahr:=int(schulkenndatum("Schuljahr"));convertierehalbjahr;
+setzesonderwerteschulkenndaten;setzewerte;zusammengesetztesanschreiben(
+gewindex,anschreibenzeigen,einzelbearbeitung,BOOL PROC 
+auskbetroffensonderwerte,BOOL PROC multistopauskunft,TEXT PROC 
+druckdateiauskzusammenstellen).setzewerte:putwert(fnrsufamnames,
+schuelerschluessel1);putwert(fnrsurufnames,schuelerschluessel2);putwert(
+fnrsugebdatums,datumskonversion(schuelerschluessel3)).convertierehalbjahr:IF 
+aktuelleshalbjahr=1THEN jahr:=int(subtext(wert(2),1,2));halbjahr:=2ELSE jahr
+:=int(subtext(wert(2),3,4));halbjahr:=1FI .END PROC auskbetroffenstarten;
+BOOL PROC auskbetroffensonderwerte:LET nein="n",ja="j",langtextnein="nein",
+langtextja="ja";initialisieresonderwerte;holediffdaten;adressat((wert(
+fnrsurufnames)SUB 1)+punkt+blank+wert(fnrsufamnames));setzesonderwert(swiort,
+wert(fnrsuplzorts));setzesonderwert(swiorterzber,wert(fnrsuplzorte));
+setzesonderwert(swistrasseerz,wert(fnrsustrnre));setzesonderwert(switelerz,
+wert(fnrsutelnre));sucheadressezurschule(wert(fnrsuskennlschule));
+setzesonderwert(swiortletzteschule,wert(fnrschplzort));setzesonderwert(
+swischulform,wert(fnrschart));setzesonderwert(swilangtextschulform,langtext(
+suffix6,wert(fnrschart)));setzesonderwert(swinameletzte,wert(fnrschname));
+setzesonderwert(swistrasseletzte,wert(fnrschstrnr));sucheadressezurschule(
+wert(fnrsuskennnschule));setzesonderwert(swiortneueschule,wert(fnrschplzort))
+;setzesonderwert(swinameneue,wert(fnrschname));setzesonderwert(swistrasseneue
+,wert(fnrschstrnr));setzesonderwert(swiwohntbei,wohntbei);setzesonderwert(
+swilangtextgeschl,langtextgeschl);setzesonderwert(swilangtextspaetaus,
+langtextspaetaus);setzesonderwert(swilangtextrelizeugnis,langtextrelizeugnis)
+;setzesonderwert(swilangtextstatus,langtextstatus);setzesonderwert(
+swilangtextortsteil,langtext(suffix1,wert(fnrsuortsteils)));setzesonderwert(
+swilangtexterzber,langtext(suffix2,wert(fnrsuverhes)));setzesonderwert(
+swilangtextstaatsan,langtext(suffix3,wert(fnrsustaatsangs)));setzesonderwert(
+swilangtextsprache,langtext(suffix4,wert(fnrsumuttersprache)));
+setzesonderwert(swilangtextrelizug,langtext(suffix5,wert(fnrsureligionsz)));
+setzesonderwert(swilangtextzugang,langtext(suffix7,wert(fnrsuartzugang)));
+setzesonderwert(swilangtextabgang,langtext(suffix8,wert(fnrsuabggrund)));
+setzesonderwert(swilangtextabschluss,langtext(suffix9,wert(fnrsuabschluss)));
+setzesonderwert(swilangtextfremdspr1,langtextfach(wert(fnrdd1fremdfach)));
+setzesonderwert(swilangtextfremdspr2,langtextfach(wert(fnrdd2fremdfach)));
+setzesonderwert(swilangtextfremdspr3,langtextfach(wert(fnrdd3fremdfach)));
+setzesonderwert(swilangtextfremdspr4,langtextfach(wert(fnrdd4fremdfach)));
+setzesonderwert(swilangtextreliunt,langtextfach(wert(fnrddreliunter)));
+setzesonderwert(swilangtextkumu,langtextfach(wert(fnrddkunstmusik)));
+setzesonderwert(swilangtextwpf191,langtextfach(wert(fnrddfach091a)));
+setzesonderwert(swilangtextwpf291,langtextfach(wert(fnrddfach091b)));
+setzesonderwert(swilangtextwpf192,langtextfach(wert(fnrddfach092a)));
+setzesonderwert(swilangtextwpf292,langtextfach(wert(fnrddfach092b)));
+setzesonderwert(swilangtextwpf1101,langtextfach(wert(fnrddfach101a)));
+setzesonderwert(swilangtextwpf2101,langtextfach(wert(fnrddfach101b)));
+setzesonderwert(swilangtextwpf1102,langtextfach(wert(fnrddfach102a)));
+setzesonderwert(swilangtextwpf2102,langtextfach(wert(fnrddfach102b)));
+setzesonderwert(swilangtextag1,langtextfach(wert(fnrddagthema1)));
+setzesonderwert(swilangtextag2,langtextfach(wert(fnrddagthema2)));
+setzesonderwert(swilangtextag3,langtextfach(wert(fnrddagthema3)));
+setzesonderwert(swiaufbschuljeintrsek2,aufbschuljahr(fnrsueintrittinsek));
+setzesonderwert(swiaufbhjafremdspr1,aufbhalbjahr(fnrdd1fremdb));
+setzesonderwert(swiaufbhjefremdspr1,aufbhalbjahr(fnrdd1fremde));
+setzesonderwert(swiaufbhjafremdspr2,aufbhalbjahr(fnrdd2fremdb));
+setzesonderwert(swiaufbhjefremdspr2,aufbhalbjahr(fnrdd2fremde));
+setzesonderwert(swiaufbhjafremdspr3,aufbhalbjahr(fnrdd3fremdb));
+setzesonderwert(swiaufbhjefremdspr3,aufbhalbjahr(fnrdd3fremde));
+setzesonderwert(swiaufbhjafremdspr4,aufbhalbjahr(fnrdd4fremdb));
+setzesonderwert(swiaufbhjefremdspr4,aufbhalbjahr(fnrdd4fremde));
+setzesonderwert(swiaufbhjaag1,aufbhalbjahr(fnrddagthema1b));setzesonderwert(
+swiaufbhjeag1,aufbhalbjahr(fnrddagthema1e));setzesonderwert(swiaufbhjaag2,
+aufbhalbjahr(fnrddagthema2b));setzesonderwert(swiaufbhjeag2,aufbhalbjahr(
+fnrddagthema2e));setzesonderwert(swiaufbhjaag3,aufbhalbjahr(fnrddagthema3b));
+setzesonderwert(swiaufbhjeag3,aufbhalbjahr(fnrddagthema3e));TRUE .
+holediffdaten:readtid(dnrdiffdaten,zugriff(fnrsutiddiffdaten)).langtextstatus
+:IF wert(fnrsustatuss)="n05"THEN geklammert(
+"Neuangemeldet zur Jahrgangsstufe 5")ELIF wert(fnrsustatuss)="n011"THEN 
+geklammert("Neuangemeldet zu jahrgangsstufe 11")ELIF wert(fnrsustatuss)="nso"
+THEN geklammert("Neuangemeldet")ELIF wert(fnrsustatuss)="abg"THEN geklammert(
+"Abgegangen")ELIF wert(fnrsustatuss)="ls"THEN geklammert(
+"Laufendes Schuljahr")ELSE geklammert("Kein Eintrag")FI .wohntbei:IF wert(
+fnrsuwohntbei)=niltextTHEN niltextELSE "bei: "+wert(fnrsuwohntbei)FI .
+langtextgeschl:LET weiblich="w",langtextweibl="weiblich",langtextmaennl=
+"männlich";IF wert(fnrsugeschlechts)=weiblichTHEN kla+langtextweibl+klzELSE 
+kla+langtextmaennl+klzFI .langtextspaetaus:IF wert(fnrsuspaetaus)=neinTHEN 
+langtextneinELIF wert(fnrsuspaetaus)=jaTHEN langtextjaELSE niltextFI .
+langtextrelizeugnis:IF wert(fnrsureligionsz)=neinTHEN langtextneinELIF wert(
+fnrsureligionsz)=jaTHEN langtextjaELSE niltextFI .END PROC 
+auskbetroffensonderwerte;PROC sucheadressezurschule(TEXT CONST schulk):
+inittupel(dnrschulen);IF schulk<>""THEN putwert(fnrschkennung,schulk);search(
+dnrschulen,TRUE );FI ENDPROC sucheadressezurschule;TEXT PROC langtextfach(
+TEXT CONST kuerzel):inittupel(dnrfaecher);putwert(dnrfaecher+1,kuerzel);
+search(dnrfaecher,TRUE );geklammert(wert(dnrfaecher+2))END PROC langtextfach;
+TEXT PROC langtext(TEXT CONST bestand,bemerkungsschluessel):TEXT VAR 
+gefundenerlangtext:="";INT VAR bestandsid:=0;putwert(fnrschlsachgebiet,
+bestand);putwert(fnrschlschluessel,bemerkungsschluessel);search(dnrschluessel
+,TRUE );IF dbstatus=okTHEN gefundenerlangtext:=wert(fnrschllangtext)ELSE 
+dbstatus(ok);FI ;geklammert(gefundenerlangtext)END PROC langtext;TEXT PROC 
+geklammert(TEXT CONST zuklammern):IF zuklammern=niltextTHEN niltextELSE kla+
+zuklammern+klzFI ENDPROC geklammert;TEXT PROC aufbschuljahr(INT CONST dbindex
+):LET trenner="/";IF wert(dbindex)=niltextOR wert(dbindex)="0"THEN niltext
+ELSE subtext(wert(dbindex),1,2)+trenner+subtext(wert(dbindex),3,4)FI END 
+PROC aufbschuljahr;TEXT PROC aufbhalbjahr(INT CONST dbindex):LET trenner=".";
+IF wert(dbindex)=niltextTHEN niltextELSE subtext(wert(dbindex),1,2)+trenner+
+subtext(wert(dbindex),3,3)FI END PROC aufbhalbjahr;TEXT PROC aufbhalbjahr(
+INT CONST dbindex,ae):LET trenner=".";TEXT VAR hj:=subtext(wert(dbindex),(ae*
+3)-2,ae*3);IF hj=niltextTHEN niltextELSE subtext(hj,1,2)+trenner+subtext(hj,3
+,3)FI END PROC aufbhalbjahr;TEXT PROC druckdateiauskzusammenstellen:LET 
+prevordruck="vordruck",postvordruck=" auskunft betroffene",vordruck1=
+"vordruck1 auskunft betroffene",vordruck2="vordruck2 auskunft betroffene",
+vordruck3="vordruck3 auskunft betroffene",vordruck4=
+"vordruck4 auskunft betroffene",vordruck5="vordruck5 auskunft betroffene",
+anzvordrucke=5,hilfsdatei1="hilfsdatei1",hilfsdatei2="hilfsdatei2",
+hilfsdateikopf="hilfsdatei kopf",druckdatei="liste.1",manager=
+"anschreiben server";INT VAR i,zeilenanz1,zeilenanz2,zeilenanzkopf,anzhj;
+TEXT VAR zeile,schuljahr;INT VAR neuesschuljahr;FILE VAR f,g,kopfspeicher;
+aktuellevordruckevommanagerholen;druckvorbereiten;
+allgemeineschuelerdatenindiedruckdateischreiben;
+halbjahresdatendesschuelersindiedruckdateischreiben;
+letztehilfsdateiindruckdateibringen;drucknachbereitenohneausdrucken;
+druckdatei.aktuellevordruckevommanagerholen:FOR iFROM 1UPTO anzvordruckeREP 
+forget(prevordruck+text(i)+postvordruck,quiet);fetch(prevordruck+text(i)+
+postvordruck,/manager)PER .allgemeineschuelerdatenindiedruckdateischreiben:
+briefalternative(vordruck1,hilfsdatei1);f:=sequentialfile(input,hilfsdatei1);
+#limit(75);##"unerklärliche"Z eilenumbrüche#maxlinelength(f,75);zeilenanz1:=
+lines(f);FOR iFROM 1UPTO zeilenanz1REP getline(f,zeile);druckzeileschreiben(
+zeile)PER ;seitenwechsel;forget(hilfsdatei1,quiet);briefalternative(vordruck2
+,hilfsdatei1);vordruck2merkenfuerfolgeseiten;briefalternative(vordruck3,
+hilfsdatei1);f:=sequentialfile(output,hilfsdatei1);zeilenanz1:=lines(f).
+halbjahresdatendesschuelersindiedruckdateischreiben:bestimme5teshjvor;lesehjd
+;WHILE (dbstatus=ok)CAND gleicherschuelerREP initialisieresonderwerte;
+alteanweisungsfolge;succ(dnrhalbjahresdaten);PER .bestimme5teshjvor:anzhj:=-5
+;bestimmeentsprechendesschuljahr.bestimmeentsprechendesschuljahr:IF anzhj<0
+THEN anzhj:=anzhj*-1;neuesschuljahr:=jahr-(anzhjDIV 2);IF (anzhjMOD 2)=0CAND 
+halbjahr=2THEN schuljahr:=text(neuesschuljahr)+text(neuesschuljahr+1);ELSE 
+schuljahr:=text(neuesschuljahr-1)+text(neuesschuljahr);FI ELSE neuesschuljahr
+:=jahr+(anzhjDIV 2)+anzhjMOD 2;IF ((anzhjMOD 2)=1CAND halbjahr=2)COR (
+halbjahr=1)THEN schuljahr:=text(neuesschuljahr-1)+text(neuesschuljahr);ELSE 
+schuljahr:=text(neuesschuljahr)+text(neuesschuljahr+1);FI FI .lesehjd:
+inittupel(dnrhalbjahresdaten);uebernehmenschuelerdaten;search(
+dnrhalbjahresdaten,FALSE ).uebernehmenschuelerdaten:putwert(fnrhjdfamnames,
+wert(fnrsufamnames));putwert(fnrhjdrufnames,wert(fnrsurufnames));putwert(
+fnrhjdgebdats,wert(fnrsugebdatums));putwert(fnrhjdsj,schuljahr);putintwert(
+fnrhjdhj,neueshalbjahr);.neueshalbjahr:IF aktuelleshalbjahr=1THEN 2ELSE 1FI .
+gleicherschueler:wert(fnrhjdfamnames)=wert(fnrsufamnames)CAND wert(
+fnrhjdrufnames)=wert(fnrsurufnames)CAND wert(fnrhjdgebdats)=wert(
+fnrsugebdatums).alteanweisungsfolge:teil1hjdaufbereiten(vordruck4,hilfsdatei2
+);aufbereitetedatenunterbringen;teil2hjdaufbereiten(vordruck5,hilfsdatei2);
+aufbereitetedatenunterbringen;.vordruck2merkenfuerfolgeseiten:copy(
+hilfsdatei1,hilfsdateikopf);kopfspeicher:=sequentialfile(input,hilfsdateikopf
+);zeilenanzkopf:=lines(kopfspeicher).aufbereitetedatenunterbringen:g:=
+sequentialfile(input,hilfsdatei2);#limit(75);##"unerklärliche"Z eilenumbrüche
+#maxlinelength(g,75);zeilenanz2:=lines(g);IF zeilenanz1+zeilenanz2>
+drucklaengeTHEN hilfsdatei1indruckdateibringenundloeschen;seitenwechsel;
+vordruckkopfnachhilfsdatei1;zeilenanz1:=zeilenanz2+zeilenanzkopf;ELSE 
+zeilenanz1:=zeilenanz1+zeilenanz2;FI ;hilfsdatei2nachhilfsdatei1undloeschen;.
+hilfsdatei1indruckdateibringenundloeschen:input(f);FOR iFROM 1UPTO zeilenanz1
+REP getline(f,zeile);druckzeileschreiben(zeile);PER ;forget(hilfsdatei1,quiet
+).vordruckkopfnachhilfsdatei1:f:=sequentialfile(output,hilfsdatei1);input(
+kopfspeicher);FOR iFROM 1UPTO zeilenanzkopfREP getline(kopfspeicher,zeile);
+putline(f,zeile)PER .hilfsdatei2nachhilfsdatei1undloeschen:FOR iFROM 1UPTO 
+zeilenanz2REP getline(g,zeile);putline(f,zeile)PER ;forget(hilfsdatei2,quiet)
+.letztehilfsdateiindruckdateibringen:input(f);FOR iFROM 1UPTO zeilenanz1REP 
+getline(f,zeile);druckzeileschreiben(zeile)PER ;forget(hilfsdateikopf,quiet);
+forget(hilfsdatei1,quiet).END PROC druckdateiauskzusammenstellen;PROC 
+teil1hjdaufbereiten(TEXT CONST vordruck,hilfsdatei):LET wiederholung=
+"     Wiederholung",zuwiederholen="     zu wiederholen",wirdwiederholt=
+"     wird wiederholt",swiaufbschuljahr=511,swiwarnung1=512,swibemnr1=513,
+swilangtextbemnr1=514,swiwarnung2=515,swibemnr2=516,swilangtextbemnr2=517,
+swiversetzung=518,swilangtextversetzung=519,swistartnachpruefungen=520,
+swinotenachpruef=527,swistartzeugnisbemerk=528,swistartversaeumtverspaetet=
+534,swilangtextbemerknachpruefung=537;INT VAR hilfsindex,i,swi;TEXT VAR wie;
+wie:=wert(fnrhjdversetzung);setzesonderwert(swiaufbschuljahr,aufbschuljahr(
+fnrhjdsj));setzesonderwert(swiwarnung1,wert(fnrhjdvermblau));setzesonderwert(
+swibemnr1,wert(fnrhjdbemblau));setzesonderwert(swilangtextbemnr1,langtext(
+suffix12,wert(fnrhjdbemblau)));setzesonderwert(swiwarnung2,wert(
+fnrhjdvermnachwarn));setzesonderwert(swibemnr2,wert(fnrhjdbemnachwarn));
+setzesonderwert(swilangtextbemnr2,langtext(suffix13,wert(fnrhjdbemnachwarn)))
+;setzesonderwert(swiversetzung,wert(fnrhjdversetzung));setzesonderwert(
+swilangtextversetzung,langtext(suffix14,wert(fnrhjdversetzung)));
+setzesonderwert(swilangtextbemerknachpruefung,langtext("Bemerkungen",
+geklammert(wert(fnrhjdbemnach))));swi:=swistartnachpruefungen;FOR iFROM 1
+UPTO 3REP setzesonderwert(swi,wert(fnrhjdnachfach1+i-1));swiINCR 1;
+setzesonderwert(swi,langtextfach(wert(fnrhjdnachfach1+i-1)));swiINCR 1;
+hilfsindexINCR 1PER ;setzesonderwert(swi,wert(fnrhjdnachfach));
+setzesonderwert(swinotenachpruef,wert(fnrhjdnacherg));swi:=
+swistartzeugnisbemerk;FOR iFROM 1UPTO 3REP setzesonderwert(swi,wert(
+fnrhjdbemzeug1+i-1));swiINCR 1;setzesonderwert(swi,langtext(suffix13,wert(
+fnrhjdbemzeug1+i-1)));swiINCR 1;hilfsindexINCR 1PER ;swi:=
+swistartversaeumtverspaetet;FOR iFROM 1UPTO 3REP setzesonderwert(swi,wert(
+fnrhjdversstdm+i-1));swiINCR 1;hilfsindexINCR 1PER ;briefalternative(vordruck
+,hilfsdatei).END PROC teil1hjdaufbereiten;PROC teil2hjdaufbereiten(TEXT 
+CONST vordruck,hilfsdatei):LET swifach=538,swiart=539,swiklau=541,swiknr=542,
+swiwarn=543,swinote=544,swibem=545;setzesonderwert(swifach,aufbereiteterwert(
+fnrhjdfach,2));setzesonderwert(swiart,aufbereiteterwert(fnrhjdkursart,2));
+setzesonderwert(swiklau,aufbereiteterwert(fnrhjdklausurteiln,1));
+setzesonderwert(swiknr,aufbereiteterwert(fnrhjdlerngrpkenn,4));
+setzesonderwert(swiwarn,aufbereiteterwert(fnrhjdvermwarnung,1));
+setzesonderwert(swinote,aufbereiteterwert(fnrhjdnotepunkte,2));
+setzesonderwert(swibem,aufbereiteterwert(fnrhjdbemerk,3));fuellebemerkungen;
+briefalternative(vordruck,hilfsdatei).fuellebemerkungen:LET kuerzelbreite=3;
+INT VAR i,l:=length(wert(fnrhjdbemerk))DIV kuerzelbreite,von,bis;TEXT VAR 
+kuerzel;INT VAR swib:=546;FOR iFROM 1UPTO lREP von:=((i-1)*kuerzelbreite)+1;
+bis:=i*kuerzelbreite;kuerzel:=subtext(wert(fnrhjdbemerk),von,bis);
+setzesonderwert(swib,kuerzel);swibINCR 1;setzesonderwert(swib,langtext(
+suffix13,kuerzel));swibINCR 1PER .END PROC teil2hjdaufbereiten;TEXT PROC 
+aufbereiteterwert(INT CONST fnr,kuerzelbreite):LET doppelpunkt=":",anzspalten
+=13,spaltenbreitetab=4;INT VAR i,l:=length(wert(fnr))DIV kuerzelbreite,von,
+bis,blankanz;TEXT VAR zeile:="",kuerzel;#IF l>nullTHEN #FOR iFROM 1UPTO #l#
+anzspaltenREP von:=((i-1)*kuerzelbreite)+1;bis:=i*kuerzelbreite;kuerzel:=
+subtext(wert(fnr),von,bis);zeile:=zeile+aufbkuerzelPER ;#ELSE zeile:=
+anzspalten*(doppelpunkt+spaltenbreitetab*blank)FI ;#zeile.aufbkuerzel:IF 
+length(kuerzel)<>nullTHEN blankanz:=spaltenbreitetab-length(kuerzel);
+doppelpunkt+preblankanz*blank+kuerzel+postblankanz*blankELSE doppelpunkt+
+spaltenbreitetab*blankFI .preblankanz:blankanzDIV 2.postblankanz:blankanz-
+preblankanz.ENDPROC aufbereiteterwert;BOOL PROC multistopauskunft:(
+schuelerschluessel1=wert(fnrsufamnames))CAND (schuelerschluessel2=wert(
+fnrsurufnames)COR schuelerschluessel2="")CAND (schuelerschluessel3=
+datumrekonversion(wert(fnrsugebdatums))COR schuelerschluessel3="")END PROC 
+multistopauskunft;TEXT PROC leerintintext(TEXT CONST t):IF t="0"THEN ""ELSE t
+FI END PROC leerintintext;TEXT PROC kurz(TEXT CONST t):TEXT VAR txt:=niltext;
+IF t<>niltextTHEN txt:=t+blankFI ;txtEND PROC kurz;END PACKET auskbetroffen;
+
diff --git a/app/schulis/2.2.1/src/1.erf.abmeldedaten b/app/schulis/2.2.1/src/1.erf.abmeldedaten
new file mode 100644
index 0000000..9c5523b
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.erf.abmeldedaten
@@ -0,0 +1,142 @@
+PACKET erfabmeldedatenDEFINES suabmeldedatenbearbeiten,
+suabmeldedatenspeichern,suausgesuchteabmeldedatenbearbeiten,
+schuelerlistezeigen,pruefungschuelerab:LET maskennameeingang=
+"ms schuelerangabe",maskenstammname="ms erf abmeldedaten",aktbestand="ls",
+bestandschulen="Schulen",fnrname=2,fnrrufname=3,fnrgebdatum=4,fnrjgst=5,
+fnrzug=6,fnrabdatum=7,fnrabgrund=8,fnrneueschule=9,fnrabschluss=10,
+meldunglistenerstellung=7,meldungspeicherung=50,pruefemeldung=57,
+meldungkeineaenderung=63,meldungletzter=67,meldungkeineliste=68,
+meldunggibtsnicht=71,meldungspeicherungfehlerhaft=73,meldungfalschesdatum=157
+;LET leer="",oblitrenner="$";LET anzschluessel=3;#A nzahlderamP 
+rimärschlüselbeteiligtenF elder#BOOL VAR falschesdatum:=FALSE ;FILE VAR f;
+ROW anzschluesselTEXT VAR schluessel;#24.03.87#TAG VAR maske;TEXT VAR 
+dateiname:="Schülerliste",schuelertid:="";TEXT VAR abdatumsicherung,
+abgrundsicherung,abschlusssicherung;LET logtextbeginn=
+"Anw. 1.3.1 Änderung """;PROC bearbeitunginitialisieren:forget(dateiname,
+quiet).END PROC bearbeitunginitialisieren;PROC suabmeldedatenbearbeiten:BOOL 
+VAR sudatenexistieren;falschesdatum:=FALSE ;systemdboff;reinitparsing;
+bearbeitunginitialisieren;schluessel(1):=standardmaskenfeld(fnrname);
+schluessel(2):=standardmaskenfeld(fnrrufname);schluessel(3):=
+datumrekonversion(standardmaskenfeld(fnrgebdatum));pruefeobsudatenexistieren(
+sudatenexistieren);IF NOT falschesdatumTHEN IF sudatenexistierenTHEN 
+schluessel(1):=wert(fnrsufamnames);schluessel(2):=wert(fnrsurufnames);
+schluessel(3):=datumrekonversion(wert(fnrsugebdatums));standardstartproc(
+maskenstammname);bereiteaenderungvor;standardnproc;ELSE standardmeldung(
+meldunggibtsnicht,"");return(1)FI ;ELSE return(1)FI .END PROC 
+suabmeldedatenbearbeiten;PROC bereiteaenderungvor:saveupdateposition(
+dnrschueler);schuelertid:=gettid;holedbwerteinmaske;abdatumsicherung:=wert(
+fnrsuabgdats);abgrundsicherung:=wert(fnrsuabggrund);abschlusssicherung:=wert(
+fnrsuabschluss);infeld(fnrname);standardfelderausgeben;infeld(fnrabdatum).
+END PROC bereiteaenderungvor;PROC holedbwerteinmaske:standardmaskenfeld(wert(
+fnrsufamnames),fnrname);standardmaskenfeld(wert(fnrsurufnames),fnrrufname);
+standardmaskenfeld(datumrekonversion(wert(fnrsugebdatums)),fnrgebdatum);
+standardmaskenfeld(jgstaufber(wert(fnrsusgrpjgst)),fnrjgst);
+standardmaskenfeld(wert(fnrsusgrpzugtut),fnrzug);standardmaskenfeld(
+datumrekonversion(wert(fnrsuabgdats)),fnrabdatum);standardmaskenfeld(wert(
+fnrsuabggrund),fnrabgrund);standardmaskenfeld(wert(fnrsuskennnschule),
+fnrneueschule);standardmaskenfeld(wert(fnrsuabschluss),fnrabschluss)END PROC 
+holedbwerteinmaske;PROC pruefeobsudatenexistieren(BOOL VAR suexist):TEXT VAR 
+datenbankwerte,schluesselwerte;inittupel(dnrschueler);maskenwerteindatenbank;
+IF NOT falschesdatumTHEN search(ixsustatfamrufgeb);IF dbstatus=okTHEN 
+datenbankwerte:=wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));
+schluesselwerte:=schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=
+schluessel(1)CAND ((schluessel(2)=leerAND schluessel(3)=leer)OR (pos(
+datenbankwerte,schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC 
+pruefeobsudatenexistieren;PROC maskenwerteindatenbank:putwert(fnrsufamnames,
+schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop;initmaske(
+maske,maskennameeingang);putwert(fnrsugebdatums,datumskonversion(schluessel(3
+)));IF iserrorTHEN clearerror;standardmeldung(meldungfalschesdatum,"");infeld
+(fnrgebdatum);falschesdatum:=TRUE ;enablestop;ELSE enablestop;putwert(
+fnrsustatuss,aktbestand);FI ;END PROC maskenwerteindatenbank;PROC 
+suabmeldedatenspeichern(BOOL CONST zuspeichern):IF zuspeichernTHEN 
+bereitespeicherungvorELSE standardmeldung(meldungkeineaenderung,"");
+vorbereitendernaechstendatenbehandlungFI .bereitespeicherungvor:INT VAR 
+fehlerstatus:=0;pruefeplausibilitaet(fehlerstatus);IF datenfehlerfreiTHEN 
+datenschreiben;vorbereitendernaechstendatenbehandlungELSE fehlerbehandeln;
+return(1)FI .datenfehlerfrei:fehlerstatus=0.fehlerbehandeln:infeld(
+fehlerstatus).datenschreiben:meldespeicherung;datenindatenbankspeichern.
+meldespeicherung:standardmeldung(meldungspeicherung,"").
+datenindatenbankspeichern:logeintragvornehmen;setzedbwerte;
+abmeldedatenschreiben.logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;
+eintragCAT schluessel(1);eintragCAT ", ";eintragCAT schluessel(2);eintragCAT 
+", ";eintragCAT datumskonversion(schluessel(3));eintragCAT """";logeintrag(
+eintrag).setzedbwerte:putwert(fnrsuabggrund,standardmaskenfeld(fnrabgrund));
+putwert(fnrsuskennnschule,standardmaskenfeld(fnrneueschule));putwert(
+fnrsuabschluss,standardmaskenfeld(fnrabschluss));putwert(fnrsuabgdats,
+datumskonversion(standardmaskenfeld(fnrabdatum)));.abmeldedatenschreiben:IF 
+abdatumsicherung<>wert(fnrsuabgdats)THEN restoreupdateposition(dnrschueler);
+selupdate(dnrschueler);ELSE replace(dnrschueler,schuelertid)FI ;IF dbstatus<>
+0THEN standardmeldung(meldungspeicherungfehlerhaft,"")#dr11.05.88ELIF 
+grundgeaendertTHEN grundinstatraumaendernELIF abschlussgeaendertTHEN 
+abschlussinstatraumaendern#FI .#drgrundgeaendert:11.05.88abgrundsicherung<>
+wert(fnrsuabggrund).abschlussgeaendert:abschlusssicherung<>wert(
+fnrsuabschluss).grundinstatraumaendern:kuerzelaendern(statnrabgrund,
+abgrundsicherung,wert(fnrsuabggrund)).abschlussinstatraumaendern:
+kuerzelaendern(statnrabschluss,abschlusssicherung,wert(fnrsuabschluss)).#END 
+PROC suabmeldedatenspeichern;PROC vorbereitendernaechstendatenbehandlung:IF 
+exists(dateiname)THEN holenaechstenschluesselauslisteELSE enter(2)FI .
+holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+holenaechstenmehrtlgschluesselausdatei(ok);WHILE okREP 
+pruefeobsudatenexistieren(ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=
+FALSE ELSE holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF 
+kannbearbeitetwerdenTHEN bereiteaenderungvor;return(1)ELSE 
+behandleendederthesaurusabarbeitungFI .behandleendederthesaurusabarbeitung:
+standardmeldung(meldungletzter,"");enter(3).END PROC 
+vorbereitendernaechstendatenbehandlung;PROC schuelerlistezeigen:BOOL VAR 
+keineliste;schluessel(1):=standardmaskenfeld(fnrname);schluessel(2):=
+standardmaskenfeld(fnrrufname);schluessel(3):=datumrekonversion(
+standardmaskenfeld(fnrgebdatum));falschesdatum:=FALSE ;systemdboff;
+parsenooffields(5);maskenwerteindatenbank;IF NOT falschesdatumTHEN 
+objektlistestarten(ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE ,
+keineliste);IF keinelisteTHEN reinitparsing;standardmeldung(meldungkeineliste
+,"");return(1)ELSE standardmeldung(meldunglistenerstellung,"");
+datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler,TRUE ,BOOL PROC 
+pruefungschuelerab)FI ELSE return(1)FI END PROC schuelerlistezeigen;BOOL 
+PROC pruefungschuelerab:wert(fnrsustatuss)=aktbestandEND PROC 
+pruefungschuelerab;PROC suausgesuchteabmeldedatenbearbeiten:BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;bearbeitunginitialisieren;objektlistebeenden(
+dateiname,TRUE );reinitparsing;holeerstenmehrtlgschluesselausdatei(ok);WHILE 
+okREP pruefeobsudatenexistieren(ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok
+:=FALSE ELSE holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF 
+kannbearbeitetwerdenTHEN standardstartproc(maskenstammname);
+bereiteaenderungvor;standardnprocELSE enter(2)FI .END PROC 
+suausgesuchteabmeldedatenbearbeiten;PROC holeerstenmehrtlgschluesselausdatei(
+BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;LEAVE 
+holeerstenmehrtlgschluesselausdateiFI ;f:=sequentialfile(input,dateiname);
+holenaechstenmehrtlgschluesselausdatei(ok);END PROC 
+holeerstenmehrtlgschluesselausdatei;PROC 
+holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:=
+"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1,
+anzschlfelder:=anzkey(dnrschueler);IF eof(f)THEN ok:=FALSE ;
+loeschedieerstellteobjektlisteELSE getline(f,thesaurustext);
+bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext,
+oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner,
+schluesselbeginn+1);FOR iFROM 1UPTO anzschlfelderREP IF schluesseltrennung>0
+THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1,
+schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung
+:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):=
+subtext(thesaurustext,schluesselbeginn+1);FI ;PER ;schluessel(3):=
+datumrekonversion(schluessel(3));.END PROC 
+holenaechstenmehrtlgschluesselausdatei;PROC loeschedieerstellteobjektliste:
+forget(dateiname,quiet);END PROC loeschedieerstellteobjektliste;PROC 
+pruefeplausibilitaet(INT VAR fstatus):LET pruefartdatum=5,fmeldnichtimbestand
+=55,bestandabgangsgrund="c02 abgang",bestandabschluss="c02 abschluss";fstatus
+:=0;standardmeldung(pruefemeldung,"");IF standardmaskenfeld(fnrabgrund)<>leer
+THEN IF NOT imschlbestand(standardmaskenfeld(fnrabgrund),bestandabgangsgrund)
+THEN fstatus:=fnrabgrund;standardmeldung(fmeldnichtimbestand,"");LEAVE 
+pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrneueschule)<>leerTHEN 
+IF NOT imbestand(standardmaskenfeld(fnrneueschule),bestandschulen)THEN 
+fstatus:=fnrneueschule;standardmeldung(fmeldnichtimbestand,"");LEAVE 
+pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrabschluss)<>leerTHEN IF 
+NOT imschlbestand(standardmaskenfeld(fnrabschluss),bestandabschluss)THEN 
+fstatus:=fnrabschluss;standardmeldung(fmeldnichtimbestand,"");LEAVE 
+pruefeplausibilitaetFI ;FI ;IF standardmaskenfeld(fnrabdatum)<>leerTHEN 
+standardpruefe(pruefartdatum,fnrabdatum,0,0,"",fstatus);FI ;END PROC 
+pruefeplausibilitaet;#dr11.05.88PROC kuerzelaendern(INT CONST statnr,TEXT 
+CONST alterwert,neuerwert):kuerzelsummeeinsrunter(statnr,jgstaufber(wert(
+fnrsusgrpjgst)),compress(wert(fnrsusgrpzugtut)),aktbestand,alterwert);
+kuerzelsummeeinsrauf(statnr,jgstaufber(wert(fnrsusgrpjgst)),compress(wert(
+fnrsusgrpzugtut)),aktbestand,neuerwert)END PROC kuerzelaendern;#END PACKET 
+erfabmeldedaten
+
diff --git a/app/schulis/2.2.1/src/1.erf.schuelerdaten b/app/schulis/2.2.1/src/1.erf.schuelerdaten
new file mode 100644
index 0000000..fb86963
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.erf.schuelerdaten
@@ -0,0 +1,605 @@
+PACKET erfschuelerdatenDEFINES sustartunderfassungsbildschirmaufbauen,
+suvonerfassungsbildschirmeinlesen,suanmeldungbearbeiten,suanmeldungeinfuegen,
+suanmeldungzeigen,suanmeldungloeschen,suanmeldungloeschenausfuehren,
+suanmeldungspeichern,suschuelerbsblaettern,sudatenimbildschirmkopieren,
+suausgesuchtezurbearbeitung,suanmeldungausgesuchteloeschen,
+suzurueckzumanfangsbildschirm,suerfassungswert,suerfassungschueler,
+pruefungschueler:LET maskenstammname="ms erf schuelerdaten",maskennameeingang
+="ms schuelerangabe",maskennamebearbeitung="ms bearb schuelerdaten";LET 
+bestandneu5="n05",bestandneu11="n11",bestandneusonst="nso",bestandlaufschulj=
+"ls",#bestandschuelergruppen="aktuelle Schülergruppen",#bestandschulen=
+"Schulen",kuerzelzugangaktjgst="z";LET meldungloeschfrage=65,meldungloeschung
+=83,meldungkeineloeschung=84,meldunggibtsschon=70,meldunggibtsnicht=71,
+meldungletzter=67,meldungkeineliste=68,meldungspeicherung=80,meldungaenderung
+=81,meldungkeineaenderung=82,meldunglistenerstellung=7,
+meldungblaetterngehtnicht=72,meldungspeicherungfehlerhaft=73,
+meldungloeschenfehlerhaft=74,meldungangabengenauer=129,meldungfalschesdatum=
+157,meldungbittename=166,pruefemeldung=57;LET fmeldbittefuellen=52,
+fmeldnichtimbestand=55,fmeldfalschesdatum=157,fmeldnumundbegrenzt=54,
+fmeldbitteanderejgst=85,weiblich="w",maennlich="m",bestandstaaten=
+"c02 staaten",bestandreligion="c02 relizugehoerigkeit",bestandzugang=
+"c02 zugang";LET fbs1=1,fbs2=2,fbs3=3,fbs4=4,erstesfeldbeierfassungbs1=2,
+erstesfeldbeierfassungbs2=2,erstesfeldbeierfassungbs3=3,
+erstesfeldbeierfassungbs4=3,erstererfbildschirm=2,letztererfbildschirm=4;LET 
+fnrname=2,fnrnamenszus=3,fnrgebname=4,fnrvornamen=5,fnrrufname=6,fnrsustr=7,
+fnrsutelefon=8,fnrsuplzort=9,fnrwohntbei=10,fnrortsteil=11,fnrgebdat=12,
+fnrgeschlecht=13,fnrstaatsan=14,fnrreligion=15,fnrverwandt=16,fnrerzname=17,
+fnrerznamenszus=18,fnrerzvornamen=19,fnrerzstr=20,fnrerztelefon=21,
+fnrerzplzort=22,fnrloeschfeld=23,fnrgebort=3,fnrkreisland=4,fnrmuttersprache=
+5,fnraussiedler=6,fnreinschulung=7,fnrschulkuerzel=8,fnrletzteklasse=9,
+fnreintrittsdatum=10,fnreintrittjgst=11,fnrsek2=12,fnrjgst=13,fnrzug=14,
+fnrzugang=15,fnrneuerzug=16,fnrvermerk1=17,fnrabdatum=23,fnrabgrund=24,
+fnrneueschule=25,fnrabschluss=26,fnrreligionunterricht=3,
+fnrreligionabmelddatum=4,fnrreligionanmelddatum=5,fnrfremdsprache=6,
+fnrkunstmusik=18,fnrag=19,fnrwpsek1=28,fnrauswahlanfang=2,fnrauswahlende=5,
+fnrneuan5=2,fnrneuan11=3,fnrneusonst=4,fnrneulaufschulj=5,fnrparamname=6,
+fnrparamrufname=7,fnrparamgebdat=8,fnrparambearbname=2,fnrparambearbrufname=3
+,fnrparambearbgebdat=4,fnrerstesausgabefeld=2,fnrletztesausgabefeld=40,
+fnrausgabename=2;LET zahldervermerke=6,maxlaengenamebeiaenderung=32,
+maxlaengenamebeikeineaenderung=26;LET pruefartdatum=6,pruefartauswahl=5;LET 
+satzeinfuegen=1,#satzaendern=2,#satzloeschen=3,satzneueschluessel=4;LET 
+kennungerfassungsprogramm=1,kennungbearbeitungsprogramm=2,
+kennungzeigeprogramm=3;LET leer="",leerzeichen=" ",oblitrenner="$",
+kennzmeldungauffaellig="#";LET jgst05="05",jgst11="11",jgstufe5=5,jgstufe10=
+10,jgstufe11=11,jgstufe13=13;LET bsanzahl=4,maxfelderzahl=100;LET 
+anzschluesselsu=3;LET aktschuljahr="Schuljahr",akthalbjahr="Schulhalbjahr";
+LET aendern=1,loeschen=2;BOOL VAR zurueckschreiben:=FALSE ;BOOL VAR 
+neuerschueler,neuenschuelereinfuegen,neuerschuelerersteintrag;BOOL VAR 
+zeigeprogramm:=FALSE ,mehrereloeschen:=FALSE ,feldschutzzumloeschengesetzt:=
+FALSE ;FILE VAR f;INT VAR statussudatei:=0;INT VAR startpos;INT VAR 
+programmnummer;INT VAR bs,bsdraussen,fnrfehlerfeld;ROW bsanzahlROW 
+maxfelderzahlTEXT VAR erfassungsfeld;ROW bsanzahlTAG VAR maske;ROW bsanzahl
+BOOL VAR maskegeholt;ROW anzschluesselsuTEXT VAR schluessel;ROW 
+anzschluesselsuTEXT VAR alterschluessel;TEXT VAR dateiname:="Schülerliste",
+hjdtid:="",diffdatentid:="";#schultypsich:="",verskennzsich:="";#TEXT VAR 
+aktbestand,programmname,tupelsich;LET logtextbeginn1="Anw. 1.1.1 ",
+logtextbeginn2="Anw. 1.2.2 ";BOOL PROC erfassungsprogramm:programmnummer=
+kennungerfassungsprogrammEND PROC erfassungsprogramm;BOOL PROC 
+bearbeitungsprogramm:programmnummer=kennungbearbeitungsprogrammEND PROC 
+bearbeitungsprogramm;PROC sustartunderfassungsbildschirmaufbauen(INT CONST 
+progrnr):IF progrnr=kennungzeigeprogrammTHEN programmnummer:=
+kennungbearbeitungsprogramm;zeigeprogramm:=TRUE ELSE programmnummer:=progrnr;
+zeigeprogramm:=FALSE FI ;startprozedur;erfassungsbildschirmaufbauen;
+suvonerfassungsbildschirmeinlesen.END PROC 
+sustartunderfassungsbildschirmaufbauen;PROC startprozedur:programmname:=text(
+vergleichsknoten);reinitparsing;systemdboff;bildschirmeinitialisieren;
+standardkopfmaskeausgeben(programmname);.END PROC startprozedur;PROC 
+bildschirmeinitialisieren:FOR bsFROM 1UPTO bsanzahlREP maskegeholt(bs):=
+FALSE PER ;bs:=1;maskeholen(bs);bsdraussen:=0.END PROC 
+bildschirmeinitialisieren;PROC erfassungsbildschirmaufbauen:reinitparsing;
+standardkopfmaskeaktualisieren(bstitel);erfassungsmaskeausgeben;
+feldvorbelegungenbehandeln;felderausgeben.bstitel:IF bs>1THEN programmname+
+" ("+text(bs-1)+".Bildschirm)"ELSE programmnameFI .erfassungsmaskeausgeben:
+IF bs<>bsdraussenTHEN zeigemaske;bsdraussen:=bsFI .zeigemaske:show(maske(bs))
+.felderausgeben:startpos:=fnrerstesausgabefeld;put(maske(bs),erfassungsfeld(
+bs),startpos);IF zeigeprogrammCAND (bs<>fbs1)THEN feldschutzfuerallefelder;
+startpos:=1ELSE startpos:=erstesfeldbeierfassung(bs)FI .
+feldschutzfuerallefelder:INT VAR i;protect(maske(bs),1,FALSE );FOR iFROM 
+fnrerstesausgabefeldUPTO fnrletztesausgabefeldREP protect(maske(bs),i,TRUE )
+PER .END PROC erfassungsbildschirmaufbauen;PROC maskeholen(INT CONST maskennr
+):initmaske(maske(maskennr),initmaskenname);maskegeholt(maskennr):=TRUE .
+initmaskenname:IF erfassungsprogrammTHEN maskenstammname+text(maskennr)ELSE 
+maskennamefuerbearbeitungFI .maskennamefuerbearbeitung:SELECT maskennrOF 
+CASE 1:maskennameeingangCASE 2:maskenstammname+text(maskennr)CASE 3:
+maskennamebearbeitung+text(maskennr)CASE 4:maskenstammname+text(maskennr)
+OTHERWISE ""END SELECT .END PROC maskeholen;PROC feldvorbelegungenbehandeln:
+SELECT bsOF CASE 1:bsfelderinitialisierenCASE 2:vorbelegungen2CASE 3:
+vorbelegungen3CASE 4:vorbelegungen4END SELECT .vorbelegungen2:
+vorbelegungneuerschueler2;loeschfeldverdecken.loeschfeldverdecken:LET 
+rahmenzeichen="=";erfassungsfeld(bs)(fnrloeschfeld):=rahmenzeichen.
+vorbelegungen3:vorbelegungname3;vorbelegungzugang;vorbelegungeintrittjgst;
+feldschutzfuerfelderbeineuanmeldungen;.vorbelegungen4:vorbelegungname4.END 
+PROC feldvorbelegungenbehandeln;PROC vorbelegungname3:TEXT VAR vor,zus,nach;
+vor:=erfassungsfeld(fbs2)(fnrrufname)+leerzeichen;zus:=erfassungsfeld(fbs2)(
+fnrnamenszus);IF zus<>leerTHEN zusCAT leerzeichenFI ;nach:=erfassungsfeld(
+fbs2)(fnrname);erfassungsfeld(bs)(fnrausgabename):=text(vor+zus+nach,
+laengefnrausgabename).laengefnrausgabename:length(maske(bs),fnrausgabename).
+END PROC vorbelegungname3;PROC vorbelegungzugang:IF aktbestand<>
+bestandlaufschuljTHEN erfassungsfeld(bs)(fnrzugang):=kuerzelzugangaktjgst;
+protect(maske(bs),fnrzugang,TRUE )ELSE protect(maske(bs),fnrzugang,FALSE )FI 
+.END PROC vorbelegungzugang;PROC vorbelegungname4:erfassungsfeld(bs)(
+fnrausgabename):=erfassungsfeld(fbs3)(fnrausgabename).END PROC 
+vorbelegungname4;PROC vorbelegungneuerschueler2:IF neuerschuelerersteintrag
+THEN neuerschuelerersteintrag:=FALSE ;erfassungsfeld(fbs2)(fnrname):=
+erfassungsfeld(fbs1)(fnrparamname);erfassungsfeld(fbs2)(fnrrufname):=
+erfassungsfeld(fbs1)(fnrparamrufname);erfassungsfeld(fbs2)(fnrvornamen):=
+erfassungsfeld(fbs1)(fnrparamrufname);erfassungsfeld(fbs2)(fnrgebdat):=
+erfassungsfeld(fbs1)(fnrparamgebdat)FI .END PROC vorbelegungneuerschueler2;
+PROC vorbelegungeintrittjgst:protect(maske(bs),fnrsek2,FALSE );protect(maske(
+bs),fnreintrittjgst,FALSE );IF aktbestand=bestandneu5THEN erfassungsfeld(bs)(
+fnreintrittjgst):=jgst05;protect(maske(bs),fnreintrittjgst,TRUE )ELIF 
+aktbestand=bestandneu11THEN erfassungsfeld(bs)(fnreintrittjgst):=jgst11;
+protect(maske(bs),fnreintrittjgst,TRUE );IF neuerschuelerTHEN 
+eintrittinsek2vorbelegenFI FI .END PROC vorbelegungeintrittjgst;PROC 
+eintrittinsek2vorbelegen:TEXT VAR schuljahr:=schulkenndatum(aktschuljahr);
+schuljahr:=subtext(schuljahr,3,4);schuljahr:=schuljahr+text(int(schuljahr)+1)
+;erfassungsfeld(bs)(fnrsek2):=schuljahr;protect(maske(bs),fnrsek2,TRUE ).END 
+PROC eintrittinsek2vorbelegen;PROC feldschutzfuerfelderbeineuanmeldungen:IF 
+aktbestand=bestandlaufschuljTHEN protect(maske(bs),fnrzug,FALSE );IF 
+neuerschuelerTHEN protect(maske(bs),fnrjgst,FALSE )ELSE protect(maske(bs),
+fnrjgst,TRUE )FI ELSE protect(maske(bs),fnrjgst,TRUE );protect(maske(bs),
+fnrzug,TRUE )FI .END PROC feldschutzfuerfelderbeineuanmeldungen;PROC 
+suvonerfassungsbildschirmeinlesen:get(maske(bs),erfassungsfeld(bs),startpos);
+loeschemeldung(maske(bs)).END PROC suvonerfassungsbildschirmeinlesen;PROC 
+suanmeldungbearbeiten:neuenschuelereinfuegen:=FALSE ;IF 
+sinnvolleauswahlgetroffenTHEN bearbeitungvorbereitungbeginnenELSE startpos:=
+fnrfehlerfeld;return(1)FI .bearbeitungvorbereitungbeginnen:IF 
+namenangabenausreichendTHEN bearbeitungbeginnenELSE startpos:=fnrfehlerfeld;
+return(1)FI .namenangabenausreichend:IF erfassungsprogrammTHEN 
+namenangabenausreichendbeierfassungELSE 
+namenangabenausreichendbeibearbeitungoderzeigenFI .bearbeitungbeginnen:
+legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ;schluesselbereitstellen
+;pruefeobnameexistiert(suexistiert);IF suexistiertTHEN saveupdateposition(
+dnrschueler);diffdatenlesen;schluessel(1):=wert(fnrsufamnames);schluessel(2)
+:=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert(fnrsugebdatums));
+loeschedieerstellteobjektliste;zurueckschreiben:=TRUE ;#
+schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvor;
+suvonerfassungsbildschirmeinlesenELSE meldeauffaellig(maske(bs),
+meldunggibtsnicht);IF erfassungsprogrammTHEN startpos:=fnrparamnameELSE 
+startpos:=fnrparambearbnameFI ;return(1)FI .END PROC suanmeldungbearbeiten;
+BOOL PROC sinnvolleauswahlgetroffen:fnrfehlerfeld:=0;IF erfassungsprogramm
+THEN pruefe(pruefartauswahl,maske(bs),erfassungsfeld(fbs1),fnrauswahlanfang,
+fnrauswahlende,0,leer,fnrfehlerfeld);IF fnrfehlerfeld=0THEN IF erfassungsfeld
+(fbs1)(fnrparamgebdat)<>leerTHEN pruefe(pruefartdatum,maske(bs),
+erfassungsfeld(fbs1),fnrparamgebdat,0,0,leer,fnrfehlerfeld);FI FI ;
+fnrfehlerfeld=0ELSE IF erfassungsfeld(fbs1)(fnrparambearbgebdat)<>leerTHEN 
+pruefe(pruefartdatum,maske(bs),erfassungsfeld(fbs1),fnrparambearbgebdat,0,0,
+leer,fnrfehlerfeld);FI ;fnrfehlerfeld=0FI .END PROC sinnvolleauswahlgetroffen
+;TEXT PROC suerfassungswert(INT CONST feldnr):IF (feldnr>maxfelderzahl)OR (
+feldnr<1)THEN ""ELSE erfassungsfeld(bs)(feldnr)FI .END PROC suerfassungswert;
+PROC schluesselbereitstellen:IF erfassungsprogrammTHEN schluessel(1):=
+erfassungsfeld(fbs1)(fnrparamname);schluessel(2):=erfassungsfeld(fbs1)(
+fnrparamrufname);schluessel(3):=erfassungsfeld(fbs1)(fnrparamgebdat)ELIF 
+bearbeitungsprogrammTHEN schluessel(1):=erfassungsfeld(fbs1)(
+fnrparambearbname);schluessel(2):=erfassungsfeld(fbs1)(fnrparambearbrufname);
+schluessel(3):=erfassungsfeld(fbs1)(fnrparambearbgebdat)FI ;alterschluessel(1
+):=schluessel(1);alterschluessel(2):=schluessel(2);alterschluessel(3):=
+schluessel(3);END PROC schluesselbereitstellen;PROC pruefeobnameexistiert(
+BOOL VAR suexist):TEXT VAR datenbankwerte,schluesselwerte;inittupel(
+dnrschueler);putwert(fnrsufamnames,schluessel(1));putwert(fnrsurufnames,
+schluessel(2));putwert(fnrsugebdatums,datumskonversion(schluessel(3)));
+putwert(fnrsustatuss,aktbestand);IF neuenschuelereinfuegenTHEN search(
+dnrschueler,FALSE )ELSE search(ixsustatfamrufgeb,FALSE );FI ;IF (NOT 
+neuenschuelereinfuegenCAND dbstatus=okCAND wert(fnrsustatuss)=aktbestand)OR (
+neuenschuelereinfuegenCAND dbstatus=ok)THEN datenbankwerte:=wert(
+fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));schluesselwerte:=
+schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=schluessel(1)CAND (
+(schluessel(2)=leerAND schluessel(3)=leer)OR (pos(datenbankwerte,
+schluesselwerte)=1)))ELSE suexist:=FALSE FI .END PROC pruefeobnameexistiert;
+PROC bereiteaenderungvor:savetupel(dnrschueler,tupelsich);neuerschueler:=
+FALSE ;holemaskenfallsnotwendig;fuelledbdateninfelder;bs:=erstererfbildschirm
+;erfassungsbildschirmaufbauen.fuelledbdateninfelder:INT VAR bsn;FOR bsnFROM 
+erstererfbildschirmUPTO letztererfbildschirmREP holedbwerte(bsn)PER .END 
+PROC bereiteaenderungvor;PROC holemaskenfallsnotwendig:IF NOT (maskegeholt(
+erstererfbildschirm))THEN FOR bsFROM erstererfbildschirmUPTO 
+letztererfbildschirmREP IF NOT maskegeholt(bs)THEN maskeholen(bs)FI ;PER FI .
+END PROC holemaskenfallsnotwendig;PROC suanmeldungeinfuegen:
+neuenschuelereinfuegen:=TRUE ;IF sinnvolleauswahlgetroffenTHEN 
+neueintragbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI .
+neueintragbeginnen:legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ;
+schluesselbereitstellen;pruefeobnameexistiert(suexistiert);IF suexistiert
+THEN meldeauffaellig(maske(bs),meldunggibtsschon);return(1)ELSE 
+zurueckschreiben:=FALSE ;bereiteneueintragvor;
+suvonerfassungsbildschirmeinlesenFI .bereiteneueintragvor:neuerschueler:=
+TRUE ;neuerschuelerersteintrag:=TRUE ;holemaskenfallsnotwendig;bs:=
+erstererfbildschirm;erfassungsbildschirmaufbauen.END PROC 
+suanmeldungeinfuegen;PROC legeaktuellenbestandfest:IF bearbeitungsprogramm
+THEN aktbestand:=bestandlaufschuljELIF erfassungsfeld(fbs1)(fnrneuan5)<>leer
+THEN aktbestand:=bestandneu5ELIF erfassungsfeld(fbs1)(fnrneuan11)<>leerTHEN 
+aktbestand:=bestandneu11ELIF erfassungsfeld(fbs1)(fnrneusonst)<>leerTHEN 
+aktbestand:=bestandneusonstELIF erfassungsfeld(fbs1)(fnrneulaufschulj)<>leer
+THEN aktbestand:=bestandlaufschuljFI .END PROC legeaktuellenbestandfest;PROC 
+suanmeldungspeichern(BOOL CONST zuspeichern):BOOL VAR suexistiert;TEXT VAR 
+schuelertupel:="";IF NOT zuspeichernTHEN IF neuerschuelerTHEN 
+vorbereitendesnaechstenneuen;return(1)ELSE IF NOT zeigeprogrammTHEN melde(
+maske(bs),meldungkeineaenderung,subtext(namefuermeldung,1,
+maxlaengenamebeikeineaenderung)+kennzmeldungauffaellig)FI ;
+vorbereitendernaechstenschluesselbehandlungFI ELSE speicherungstartenFI .
+speicherungstarten:INT VAR fehlerstatus:=0;
+pruefeobbeineuemschuelerschonvorhanden;IF datenfehlerfreiTHEN datenschreiben;
+IF statussudatei<>0THEN melde(maske(bs),meldungspeicherungfehlerhaft,text(
+statussudatei)+kennzmeldungauffaellig);#altenschuelerwiedereintragen;dr10.
+05.88#return(1)ELIF neuerschuelerTHEN #schuelerinstatwuerfeleinfuegen;dr10.
+05.88#vorbereitendesnaechstenneuen;return(1)ELSE #
+schuelerinstatwuerfeleinfuegen;dr10.05.88#
+vorbereitendernaechstenschluesselbehandlungFI ;ELSE fehlerbehandeln;return(1)
+FI .pruefeobbeineuemschuelerschonvorhanden:IF falschesdatum(erfassungsfeld(
+fbs2)(fnrgebdat))THEN fehlerstatus:=fnrgebdat;bs:=fbs2;
+erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),meldungfalschesdatum);
+ELSE schluessel(1):=erfassungsfeld(fbs2)(fnrname);schluessel(2):=
+erfassungsfeld(fbs2)(fnrrufname);schluessel(3):=erfassungsfeld(fbs2)(
+fnrgebdat);IF geaenderteschluesselfelderTHEN savetupel(dnrschueler,
+schuelertupel);pruefeobnameexistiert(suexistiert);restoretupel(dnrschueler,
+schuelertupel);IF suexistiertTHEN fehlerstatus:=fnrname;bs:=fbs2;
+erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),meldunggibtsschon);
+ELSE pruefeplausibilitaet(fehlerstatus);FI ELSE pruefeplausibilitaet(
+fehlerstatus);FI FI .datenfehlerfrei:fehlerstatus=0.fehlerbehandeln:startpos
+:=fehlerstatus.END PROC suanmeldungspeichern;PROC datenschreiben:
+meldespeicherung;dbwertzuordnung;IF neuerschuelerTHEN logeintragvornehmen(
+"Neueinfügen");neueneinfuegenELSE logeintragvornehmen("Änderung");
+bearbeitetenschreibenFI ;.meldespeicherung:IF neuerschuelerTHEN melde(maske(
+bs),meldungspeicherung,namefuermeldung+kennzmeldungauffaellig)ELSE melde(
+maske(bs),meldungaenderung,subtext(namefuermeldung,1,
+maxlaengenamebeiaenderung)+kennzmeldungauffaellig)FI .dbwertzuordnung:INT 
+VAR bsn;IF neuerschuelerTHEN inittupel(dnrschueler)FI ;FOR bsnFROM 
+erstererfbildschirmUPTO letztererfbildschirmREP setzedbwerte(bsn)PER ;.END 
+PROC datenschreiben;TEXT PROC namefuermeldung:LET kennznametrenner=".";(
+schluessel(2)SUB 1)+kennznametrenner+schluessel(1).END PROC namefuermeldung;
+PROC logeintragvornehmen(TEXT CONST logergaenzung):TEXT VAR eintrag;IF 
+erfassungsprogrammTHEN eintrag:=logtextbeginn1ELSE eintrag:=logtextbeginn2FI 
+;eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel(1);eintrag
+CAT ", ";eintragCAT schluessel(2);eintragCAT ", ";eintragCAT datumskonversion
+(schluessel(3));eintragCAT """";logeintrag(eintrag)END PROC 
+logeintragvornehmen;PROC neueneinfuegen:diffdatentid:="";putwert(
+fnrdddiffdatennr,unique(dnrdiffdaten));insert(dnrdiffdaten);IF dbstatus=ok
+THEN search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN diffdatentid:=gettid;FI 
+ELSE fehlerprotokoll(dnrdiffdaten,satzeinfuegen);FI ;putwert(
+fnrsudiffdatennrs,wert(fnrdddiffdatennr));putwert(fnrsustatuss,aktbestand);
+putwert(fnrsutiddiffdaten,diffdatentid);insert(dnrschueler);statussudatei:=
+dbstatus;evtlaenderungderkurswahldatenvollziehenEND PROC neueneinfuegen;PROC 
+bearbeitetenschreiben:TEXT VAR sj:=schulkenndatum(aktschuljahr),hj:=
+schulkenndatum(akthalbjahr);putwert(fnrsustatuss,aktbestand);
+restoreupdateposition(dnrschueler);#update(dnrschueler);dr10.05.88#selupdate(
+dnrschueler);statussudatei:=dbstatus;replace(dnrdiffdaten,wert(
+fnrsutiddiffdaten));IF statussudatei=okCAND aktbestand=bestandlaufschuljTHEN 
+neueklasseinhalbjahresdateneintragen(schluessel,sj,hj,wert(fnrsusgrpjgst),
+wert(fnrsusgrpzugtut))FI ;IF statussudatei=okCAND geaenderteschluesselfelder
+THEN hjddateiupdate(dnrhalbjahresdaten,satzneueschluessel);
+evtlaenderungderkurswahldatenvollziehenFI END PROC bearbeitetenschreiben;
+BOOL PROC geaenderteschluesselfelder:schluessel(1)<>alterschluessel(1)OR 
+schluessel(2)<>alterschluessel(2)OR schluessel(3)<>alterschluessel(3)END 
+PROC geaenderteschluesselfelder;PROC 
+vorbereitendernaechstenschluesselbehandlung:IF exists(dateiname)THEN 
+holenaechstenschluesselauslisteELSE zurueckschreiben:=FALSE ;
+suzurueckzumanfangsbildschirm(2);FI .holenaechstenschluesselausliste:BOOL 
+VAR ok,kannbearbeitetwerden:=FALSE ;holenaechstenmehrtlgschluesselausdatei(ok
+);WHILE okREP pruefeobnameexistiert(ok);IF okTHEN saveupdateposition(
+dnrschueler);diffdatenlesen;kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden
+THEN zurueckschreiben:=TRUE ;IF mehrereloeschenTHEN bereiteloeschenvor;return
+(1)ELSE #schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvor;
+return(1)FI ELSE zurueckschreiben:=FALSE ;behandleendederlistenabarbeitungFI 
+.behandleendederlistenabarbeitung:mehrereloeschen:=FALSE ;meldeauffaellig(
+maske(bs),meldungletzter);suzurueckzumanfangsbildschirm(3).END PROC 
+vorbereitendernaechstenschluesselbehandlung;PROC sudatenimbildschirmkopieren:
+INT VAR curspos:=startpos;IF bs=fbs2THEN IF curspos=fnrrufnameTHEN 
+erfassungsfeld(bs)(fnrrufname):=erfassungsfeld(bs)(fnrvornamen);put(maske(bs)
+,erfassungsfeld(bs)(fnrrufname),fnrrufname)ELIF curspos=fnrerznameTHEN 
+erfassungsfeld(bs)(fnrerzname):=erfassungsfeld(bs)(fnrname);put(maske(bs),
+erfassungsfeld(bs)(fnrerzname),fnrerzname);erfassungsfeld(bs)(fnrerznamenszus
+):=erfassungsfeld(bs)(fnrnamenszus);put(maske(bs),erfassungsfeld(bs)(
+fnrerznamenszus),fnrerznamenszus);INT VAR i;FOR iFROM 0UPTO fnrerzplzort-
+fnrerzstrREP erfassungsfeld(bs)(fnrerzstr+i):=erfassungsfeld(bs)(fnrsustr+i);
+put(maske(bs),erfassungsfeld(bs)(fnrerzstr+i),fnrerzstr+i)PER ;FI ;startpos:=
+cursposFI ;return(1).END PROC sudatenimbildschirmkopieren;PROC 
+suanmeldungzeigen:BOOL VAR listeexistiertnicht;IF sinnvolleauswahlgetroffen
+THEN listezeigenbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI .
+listezeigenbeginnen:schluesselbereitstellen;legeaktuellenbestandfest;
+setzedbwerte(bs);meldeauffaellig(maske(bs),meldunglistenerstellung);
+parsenooffields(5);putwert(fnrsustatuss,aktbestand);objektlistestarten(
+ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE ,listeexistiertnicht);IF 
+listeexistiertnichtTHEN reinitparsing;meldeauffaellig(maske(bs),
+meldungkeineliste);return(1)ELSE bsdraussen:=0;datensatzlistenausgabe(PROC (
+INT CONST )suerfassungschueler,TRUE ,BOOL PROC pruefungschueler)FI .END PROC 
+suanmeldungzeigen;PROC suerfassungschueler(INT CONST n):LET namenlaenge=63,
+trenner=", ";TEXT VAR identizeile,schluesselanhang:="";INT VAR i;identizeile
+:=wert(fnrsufamnames)+trenner+wert(fnrsurufnames);identizeile:=text(
+identizeile,namenlaenge)+wert(fnrsugebdatums);schluesselkoppeln;
+setzeidentiwert(identizeilemitschluesselanhang).schluesselkoppeln:FOR iFROM 1
+UPTO anzschluesselsuREP schluesselanhangCAT oblitrenner;schluesselanhangCAT 
+wert(dnrschueler+i);PER .identizeilemitschluesselanhang:identizeile+
+schluesselanhang.END PROC suerfassungschueler;BOOL PROC pruefungschueler:wert
+(fnrsustatuss)=aktbestandEND PROC pruefungschueler;PROC 
+suausgesuchtezurbearbeitung:behandlungderausgesuchten(aendern)END PROC 
+suausgesuchtezurbearbeitung;PROC holeerstenmehrtlgschluesselausdatei(BOOL 
+VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;LEAVE 
+holeerstenmehrtlgschluesselausdateiFI ;f:=sequentialfile(input,dateiname);
+holenaechstenmehrtlgschluesselausdatei(ok);END PROC 
+holeerstenmehrtlgschluesselausdatei;PROC 
+holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:=
+"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1;IF 
+eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f,
+thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext,
+oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner,
+schluesselbeginn+1);FOR iFROM 1UPTO anzschluesselsuREP IF schluesseltrennung>
+0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1,
+schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung
+:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):=
+subtext(thesaurustext,schluesselbeginn+1);FI ;PER ;schluessel(3):=
+datumrekonversion(schluessel(3));.END PROC 
+holenaechstenmehrtlgschluesselausdatei;PROC loeschedieerstellteobjektliste:
+forget(dateiname,quiet);END PROC loeschedieerstellteobjektliste;INT PROC 
+erstesfeldbeierfassung(INT CONST bildschirmnummer):IF bildschirmnummer=fbs1
+THEN erstesfeldbeierfassungbs1ELIF bildschirmnummer=fbs2THEN 
+erstesfeldbeierfassungbs2ELIF bildschirmnummer=fbs3THEN 
+erstesfeldbeierfassungbs3ELIF bildschirmnummer=fbs4THEN 
+erstesfeldbeierfassungbs4ELSE 1FI .END PROC erstesfeldbeierfassung;PROC 
+suschuelerbsblaettern(BOOL CONST vorwaerts):IF blaetternsinnlosTHEN 
+meldeauffaellig(maske(bs),meldungblaetterngehtnicht)ELSE 
+fuehreblaettervorgangdurch;FI ;return(1).blaetternsinnlos:(vorwaertsAND (bs=
+letztererfbildschirm))OR (NOT vorwaertsAND (bs=erstererfbildschirm)).
+fuehreblaettervorgangdurch:IF vorwaertsTHEN bsINCR 1ELSE bsDECR 1FI ;
+erfassungsbildschirmaufbauen.END PROC suschuelerbsblaettern;PROC 
+bsfelderinitialisieren:INT VAR bsnr;FOR bsnrFROM 1UPTO bsanzahlREP init(
+erfassungsfeld(bsnr))PER .END PROC bsfelderinitialisieren;PROC 
+vorbereitendesnaechstenneuen:bsfelderinitialisieren;bs:=erstererfbildschirm;
+erfassungsbildschirmaufbauen.END PROC vorbereitendesnaechstenneuen;PROC 
+suzurueckzumanfangsbildschirm(INT CONST schritte):bs:=1;IF zurueckschreiben
+THEN #schuelerinstatwuerfeleinfuegendr10.05.88#FI ;IF 
+feldschutzzumloeschengesetztTHEN feldschutzfuerallefelderaufheben;
+feldschutzzumloeschengesetzt:=FALSE FI ;erfassungsbildschirmaufbauen;return(
+schritte);.feldschutzfuerallefelderaufheben:INT VAR i;FOR iFROM 
+fnrerstesausgabefeldUPTO fnrloeschfeld-1REP protect(maske(erstererfbildschirm
+),i,FALSE )PER ;protect(maske(erstererfbildschirm),fnrloeschfeld,TRUE ).END 
+PROC suzurueckzumanfangsbildschirm;PROC pruefeplausibilitaet(INT VAR fstatus)
+:fstatus:=0;INT VAR fmeld;meldeauffaellig(maske(bs),pruefemeldung);pruefebs2;
+IF fstatus<>0THEN fehlerausgabeELSE pruefebs3;IF fstatus<>0THEN fehlerausgabe
+ELSE pruefebs4;IF fstatus<>0THEN fehlerausgabeFI FI FI .pruefebs2:IF 
+erfassungsfeld(fbs2)(fnrname)=leerTHEN fstatus:=fnrname;bs:=fbs2;fmeld:=
+fmeldbittefuellen;LEAVE pruefebs2FI ;IF erfassungsfeld(fbs2)(fnrrufname)=leer
+THEN fstatus:=fnrrufname;bs:=fbs2;fmeld:=fmeldbittefuellen;LEAVE pruefebs2FI 
+;IF erfassungsfeld(fbs2)(fnrgebdat)=leerTHEN fstatus:=fnrgebdat;bs:=fbs2;
+fmeld:=fmeldbittefuellen;LEAVE pruefebs2ELSE IF falschesdatum(erfassungsfeld(
+fbs2)(fnrgebdat))THEN fstatus:=fnrgebdat;bs:=fbs2;fmeld:=fmeldfalschesdatum;
+LEAVE pruefebs2FI FI ;IF NOT ((erfassungsfeld(fbs2)(fnrgeschlecht)=weiblich)
+OR (erfassungsfeld(fbs2)(fnrgeschlecht)=maennlich))THEN fstatus:=
+fnrgeschlecht;bs:=fbs2;fmeld:=fmeldnichtimbestand;LEAVE pruefebs2FI ;IF 
+erfassungsfeld(fbs2)(fnrstaatsan)<>leerTHEN IF NOT imschlbestand(
+erfassungsfeld(fbs2)(fnrstaatsan),bestandstaaten)THEN fstatus:=fnrstaatsan;bs
+:=fbs2;fmeld:=fmeldnichtimbestand;LEAVE pruefebs2FI FI ;IF erfassungsfeld(
+fbs2)(fnrreligion)<>leerTHEN IF NOT imschlbestand(erfassungsfeld(fbs2)(
+fnrreligion),bestandreligion)THEN fstatus:=fnrreligion;bs:=fbs2;fmeld:=
+fmeldnichtimbestand;LEAVE pruefebs2FI FI .pruefebs3:INT CONST eintrittsjgst:=
+int(erfassungsfeld(fbs3)(fnreintrittjgst));IF erfassungsfeld(fbs3)(
+fnreintrittsdatum)=leerTHEN fstatus:=fnreintrittsdatum;bs:=fbs3;fmeld:=
+fmeldbittefuellen;LEAVE pruefebs3ELSE IF falschesdatum(erfassungsfeld(fbs3)(
+fnreintrittsdatum))THEN fstatus:=fnreintrittsdatum;bs:=fbs3;fmeld:=
+fmeldfalschesdatum;LEAVE pruefebs3FI FI ;IF aktbestand=bestandneusonstTHEN 
+IF erfassungsfeld(fbs3)(fnreintrittjgst)=leerTHEN fstatus:=fnreintrittjgst;bs
+:=fbs3;fmeld:=fmeldbittefuellen;LEAVE pruefebs3FI ;IF eintrittsjgst<jgstufe5
+COR eintrittsjgst>jgstufe13THEN fstatus:=fnreintrittjgst;bs:=fbs3;fmeld:=
+fmeldnumundbegrenzt;LEAVE pruefebs3FI ;IF eintrittsjgst=jgstufe5COR 
+eintrittsjgst=jgstufe11THEN fstatus:=fnreintrittjgst;bs:=fbs3;fmeld:=
+fmeldbitteanderejgst;LEAVE pruefebs3FI FI ;IF erfassungsfeld(fbs3)(
+fnrschulkuerzel)<>leerTHEN IF NOT imbestand(erfassungsfeld(fbs3)(
+fnrschulkuerzel),bestandschulen)THEN fstatus:=fnrschulkuerzel;bs:=fbs3;fmeld
+:=fmeldnichtimbestand;LEAVE pruefebs3FI FI ;IF aktbestand=bestandlaufschulj
+THEN IF erfassungsfeld(fbs3)(fnrzugang)=leerTHEN fstatus:=fnrzugang;bs:=fbs3;
+fmeld:=fmeldbittefuellen;LEAVE pruefebs3ELIF NOT imschlbestand(erfassungsfeld
+(fbs3)(fnrzugang),bestandzugang)THEN fstatus:=fnrzugang;bs:=fbs3;fmeld:=
+fmeldnichtimbestand;LEAVE pruefebs3FI ;FI ;IF bearbeitungsprogrammCAND 
+erfassungsfeld(fbs3)(fnrneueschule)<>leerTHEN IF NOT imbestand(erfassungsfeld
+(fbs3)(fnrneueschule),bestandschulen)THEN fstatus:=fnrneueschule;bs:=fbs3;
+fmeld:=fmeldnichtimbestand;LEAVE pruefebs3FI FI ;IF bearbeitungsprogrammCAND 
+erfassungsfeld(fbs3)(fnrabdatum)<>leerTHEN IF falschesdatum(erfassungsfeld(
+fbs3)(fnrabdatum))THEN fstatus:=fnrabdatum;bs:=fbs3;fmeld:=fmeldfalschesdatum
+;LEAVE pruefebs3FI FI ;IF aktbestand<>bestandlaufschuljTHEN LEAVE pruefebs3
+FI ;TEXT VAR jgst:=erfassungsfeld(fbs3)(fnrjgst);TEXT VAR zug:=erfassungsfeld
+(fbs3)(fnrzug);IF jgst=leerTHEN fstatus:=fnrjgst;bs:=fbs3;fmeld:=
+fmeldbittefuellen;LEAVE pruefebs3FI ;IF zug=leerTHEN fstatus:=fnrzug;bs:=fbs3
+;fmeld:=fmeldbittefuellen;LEAVE pruefebs3FI ;IF NOT imbestandschuelergruppen
+THEN IF neuerschuelerTHEN fstatus:=fnrjgstELSE fstatus:=fnrzugFI ;bs:=fbs3;
+fmeld:=fmeldnichtimbestand;LEAVE pruefebs3FI .pruefebs4:IF erfassungsfeld(
+fbs4)(fnrreligionabmelddatum)<>leerTHEN IF falschesdatum(erfassungsfeld(fbs4)
+(fnrreligionabmelddatum))THEN fstatus:=fnrreligionabmelddatum;bs:=fbs4;fmeld
+:=fmeldfalschesdatum;LEAVE pruefebs4FI FI ;IF erfassungsfeld(fbs4)(
+fnrreligionanmelddatum)<>leerTHEN IF falschesdatum(erfassungsfeld(fbs4)(
+fnrreligionanmelddatum))THEN fstatus:=fnrreligionanmelddatum;bs:=fbs4;fmeld:=
+fmeldfalschesdatum;LEAVE pruefebs4FI FI ;.fehlerausgabe:
+erfassungsbildschirmaufbauen;meldeauffaellig(maske(bs),fmeld).END PROC 
+pruefeplausibilitaet;BOOL PROC imbestandschuelergruppen:TEXT VAR schuljahr:=
+schulkenndatum(aktschuljahr),halbjahr:=schulkenndatum(akthalbjahr);INT VAR 
+dateinummer:=dnraktschuelergruppen;putwert(dateinummer+1,schuljahr);putwert(
+dateinummer+2,halbjahr);putwert(dateinummer+3,erfassungsfeld(fbs3)(fnrjgst));
+putwert(dateinummer+4,erfassungsfeld(fbs3)(fnrzug));search(dateinummer,TRUE )
+;dbstatus=0END PROC imbestandschuelergruppen;BOOL PROC falschesdatum(TEXT 
+CONST pruefdatum):LET falschertag="00";datum(pruefdatum)=nildatumCOR subtext(
+pruefdatum,1,2)=falschertag.END PROC falschesdatum;PROC setzedbwerte(INT 
+CONST bsnr):INT VAR lv,verm;SELECT bsnrOF CASE fbs1:setzedbwertevonbs1CASE 
+fbs2:setzedbwertevonbs2CASE fbs3:setzedbwertevonbs3CASE fbs4:
+setzedbwertevonbs4END SELECT ;IF neuenschuelereinfuegenTHEN putwert(
+fnrsutidakthjd,leer)ELSE putwert(fnrsutidakthjd,hjdtid)FI .setzedbwertevonbs1
+:IF NOT bearbeitungsprogrammTHEN putwert(fnrsufamnames,erfassungsfeld[bsnr][
+fnrparamname]);putwert(fnrsurufnames,erfassungsfeld[bsnr][fnrparamrufname]);
+putwert(fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrparamgebdat])
+);ELSE putwert(fnrsufamnames,erfassungsfeld[bsnr][fnrparambearbname]);putwert
+(fnrsurufnames,erfassungsfeld[bsnr][fnrparambearbrufname]);putwert(
+fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrparambearbgebdat]));
+FI .setzedbwertevonbs2:putwert(fnrsufamnames,erfassungsfeld[bsnr][fnrname]);
+putwert(fnrsunamenszusatzs,erfassungsfeld[bsnr][fnrnamenszus]);putwert(
+fnrsugebnames,erfassungsfeld[bsnr][fnrgebname]);putwert(fnrsuvornames,
+erfassungsfeld[bsnr][fnrvornamen]);putwert(fnrsurufnames,erfassungsfeld[bsnr]
+[fnrrufname]);putwert(fnrsustrnrs,erfassungsfeld[bsnr][fnrsustr]);putwert(
+fnrsutelnrs,erfassungsfeld[bsnr][fnrsutelefon]);putwert(fnrsuplzorts,
+erfassungsfeld[bsnr][fnrsuplzort]);putwert(fnrsuwohntbei,erfassungsfeld[bsnr]
+[fnrwohntbei]);putwert(fnrsuortsteils,erfassungsfeld[bsnr][fnrortsteil]);
+putwert(fnrsugebdatums,datumskonversion(erfassungsfeld[bsnr][fnrgebdat]));
+putwert(fnrsugeschlechts,erfassungsfeld[bsnr][fnrgeschlecht]);putwert(
+fnrsustaatsangs,erfassungsfeld[bsnr][fnrstaatsan]);putwert(fnrsureligionsz,
+erfassungsfeld[bsnr][fnrreligion]);putwert(fnrsuverhes,erfassungsfeld[bsnr][
+fnrverwandt]);putwert(fnrsufamnamee,erfassungsfeld[bsnr][fnrerzname]);putwert
+(fnrsunamenszusatze,erfassungsfeld[bsnr][fnrerznamenszus]);putwert(
+fnrsuvornamee,erfassungsfeld[bsnr][fnrerzvornamen]);putwert(fnrsustrnre,
+erfassungsfeld[bsnr][fnrerzstr]);putwert(fnrsutelnre,erfassungsfeld[bsnr][
+fnrerztelefon]);putwert(fnrsuplzorte,erfassungsfeld[bsnr][fnrerzplzort]);.
+setzedbwertevonbs3:putwert(fnrsugeborts,erfassungsfeld[bsnr][fnrgebort]);
+putwert(fnrsugebkreiss,erfassungsfeld[bsnr][fnrkreisland]);putwert(
+fnrsumuttersprache,erfassungsfeld[bsnr][fnrmuttersprache]);putwert(
+fnrsuspaetaus,erfassungsfeld[bsnr][fnraussiedler]);putwert(fnrsujahreinschul,
+erfassungsfeld[bsnr][fnreinschulung]);putwert(fnrsuskennlschule,
+erfassungsfeld[bsnr][fnrschulkuerzel]);putwert(fnrsuklasselschule,
+erfassungsfeld[bsnr][fnrletzteklasse]);putwert(fnrsueintrittsdats,
+datumskonversion(erfassungsfeld[bsnr][fnreintrittsdatum]));putwert(
+fnrsujgsteintr,jgstaufber(erfassungsfeld[bsnr][fnreintrittjgst]));putwert(
+fnrsueintrittinsek,erfassungsfeld[bsnr][fnrsek2]);putwert(fnrsusgrpjgst,
+jgstaufber(erfassungsfeld[bsnr][fnrjgst]));putwert(fnrsusgrpzugtut,
+erfassungsfeld[bsnr][fnrzug]);putwert(fnrsuartzugang,erfassungsfeld[bsnr][
+fnrzugang]);putwert(fnrsuneuerzugtut,erfassungsfeld[bsnr][fnrneuerzug]);FOR 
+vermFROM 0UPTO zahldervermerke-1REP putwert(fnrsuvermerk1+verm,erfassungsfeld
+[bsnr][fnrvermerk1+verm])PER ;IF bearbeitungsprogrammTHEN putwert(
+fnrsuabgdats,datumskonversion(erfassungsfeld[bsnr][fnrabdatum]));putwert(
+fnrsuabggrund,erfassungsfeld[bsnr][fnrabgrund]);putwert(fnrsuskennnschule,
+erfassungsfeld[bsnr][fnrneueschule]);putwert(fnrsuabschluss,erfassungsfeld[
+bsnr][fnrabschluss]);FI .setzedbwertevonbs4:putwert(fnrddreliunter,
+erfassungsfeld[bsnr][fnrreligionunterricht]);putwert(fnrddreliunter+1,
+datumskonversion(erfassungsfeld[bsnr][fnrreligionabmelddatum]));putwert(
+fnrddreliunter+2,datumskonversion(erfassungsfeld[bsnr][fnrreligionanmelddatum
+]));FOR lvFROM 0UPTO 11REP putwert(fnrdd1fremdfach+lv,erfassungsfeld[bsnr][
+fnrfremdsprache+lv]);PER ;putwert(fnrddkunstmusik,erfassungsfeld[bsnr][
+fnrkunstmusik]);FOR lvFROM 0UPTO 8REP putwert(fnrddagthema1+lv,erfassungsfeld
+[bsnr][fnrag+lv]);PER ;FOR lvFROM 0UPTO 7REP putwert(fnrddfach091a+lv,
+erfassungsfeld[bsnr][fnrwpsek1+lv]);PER .END PROC setzedbwerte;PROC 
+holedbwerte(INT CONST bsnr):INT VAR lv,verm;SELECT bsnrOF CASE fbs1:
+holedbwertevonbs1CASE fbs2:holedbwertevonbs2CASE fbs3:holedbwertevonbs3CASE 
+fbs4:holedbwertevonbs4END SELECT ;hjdtid:=wert(fnrsutidakthjd);.
+holedbwertevonbs1:IF NOT bearbeitungsprogrammTHEN erfassungsfeld[bsnr][
+fnrparamname]:=wert(fnrsufamnames);erfassungsfeld[bsnr][fnrparamrufname]:=
+wert(fnrsurufnames);erfassungsfeld[bsnr][fnrparamgebdat]:=wert(fnrsugebdatums
+);ELSE erfassungsfeld[bsnr][fnrparambearbname]:=wert(fnrsufamnames);
+erfassungsfeld[bsnr][fnrparambearbrufname]:=wert(fnrsurufnames);
+erfassungsfeld[bsnr][fnrparambearbgebdat]:=wert(fnrsugebdatums);FI .
+holedbwertevonbs2:erfassungsfeld[bsnr][fnrname]:=wert(fnrsufamnames);
+erfassungsfeld[bsnr][fnrnamenszus]:=wert(fnrsunamenszusatzs);erfassungsfeld[
+bsnr][fnrgebname]:=wert(fnrsugebnames);erfassungsfeld[bsnr][fnrvornamen]:=
+wert(fnrsuvornames);erfassungsfeld[bsnr][fnrrufname]:=wert(fnrsurufnames);
+erfassungsfeld[bsnr][fnrsustr]:=wert(fnrsustrnrs);erfassungsfeld[bsnr][
+fnrsutelefon]:=wert(fnrsutelnrs);erfassungsfeld[bsnr][fnrsuplzort]:=wert(
+fnrsuplzorts);erfassungsfeld[bsnr][fnrwohntbei]:=wert(fnrsuwohntbei);
+erfassungsfeld[bsnr][fnrortsteil]:=wert(fnrsuortsteils);erfassungsfeld[bsnr][
+fnrgebdat]:=datumrekonversion(wert(fnrsugebdatums));erfassungsfeld[bsnr][
+fnrgeschlecht]:=wert(fnrsugeschlechts);erfassungsfeld[bsnr][fnrstaatsan]:=
+wert(fnrsustaatsangs);erfassungsfeld[bsnr][fnrreligion]:=wert(fnrsureligionsz
+);erfassungsfeld[bsnr][fnrverwandt]:=wert(fnrsuverhes);erfassungsfeld[bsnr][
+fnrerzname]:=wert(fnrsufamnamee);erfassungsfeld[bsnr][fnrerznamenszus]:=wert(
+fnrsunamenszusatze);erfassungsfeld[bsnr][fnrerzvornamen]:=wert(fnrsuvornamee)
+;erfassungsfeld[bsnr][fnrerzstr]:=wert(fnrsustrnre);erfassungsfeld[bsnr][
+fnrerztelefon]:=wert(fnrsutelnre);erfassungsfeld[bsnr][fnrerzplzort]:=wert(
+fnrsuplzorte);alteschluesselsichern.alteschluesselsichern:alterschluessel(1)
+:=erfassungsfeld[bsnr][fnrname];alterschluessel(2):=erfassungsfeld[bsnr][
+fnrrufname];alterschluessel(3):=erfassungsfeld[bsnr][fnrgebdat];.
+holedbwertevonbs3:TEXT VAR einjgst:=wert(fnrsujgsteintr),aktjgst:=wert(
+fnrsusgrpjgst);erfassungsfeld[bsnr][fnrgebort]:=wert(fnrsugeborts);
+erfassungsfeld[bsnr][fnrkreisland]:=wert(fnrsugebkreiss);erfassungsfeld[bsnr]
+[fnrmuttersprache]:=wert(fnrsumuttersprache);erfassungsfeld[bsnr][
+fnraussiedler]:=wert(fnrsuspaetaus);erfassungsfeld[bsnr][fnreinschulung]:=
+textnichtnull(wert(fnrsujahreinschul));erfassungsfeld[bsnr][fnrschulkuerzel]
+:=wert(fnrsuskennlschule);erfassungsfeld[bsnr][fnrletzteklasse]:=wert(
+fnrsuklasselschule);erfassungsfeld[bsnr][fnreintrittsdatum]:=
+datumrekonversion(wert(fnrsueintrittsdats));erfassungsfeld[bsnr][
+fnreintrittjgst]:=jgstaufber(einjgst);erfassungsfeld[bsnr][fnrsek2]:=
+textnichtnull(wert(fnrsueintrittinsek));erfassungsfeld[bsnr][fnrjgst]:=
+jgstaufber(aktjgst);erfassungsfeld[bsnr][fnrzug]:=wert(fnrsusgrpzugtut);
+erfassungsfeld[bsnr][fnrzugang]:=wert(fnrsuartzugang);erfassungsfeld[bsnr][
+fnrneuerzug]:=wert(fnrsuneuerzugtut);FOR vermFROM 0UPTO zahldervermerke-1REP 
+erfassungsfeld[bsnr][fnrvermerk1+verm]:=wert(fnrsuvermerk1+verm)PER ;IF 
+bearbeitungsprogrammTHEN erfassungsfeld[bsnr][fnrabdatum]:=datumrekonversion(
+wert(fnrsuabgdats));erfassungsfeld[bsnr][fnrabgrund]:=wert(fnrsuabggrund);
+erfassungsfeld[bsnr][fnrneueschule]:=wert(fnrsuskennnschule);erfassungsfeld[
+bsnr][fnrabschluss]:=wert(fnrsuabschluss);FI .holedbwertevonbs4:
+erfassungsfeld[bsnr][fnrreligionunterricht]:=wert(fnrddreliunter);
+erfassungsfeld[bsnr][fnrreligionabmelddatum]:=datumrekonversion(wert(
+fnrddreliunter+1));erfassungsfeld[bsnr][fnrreligionanmelddatum]:=
+datumrekonversion(wert(fnrddreliunter+2));FOR lvFROM 0UPTO 11REP 
+erfassungsfeld[bsnr][fnrfremdsprache+lv]:=wert(fnrdd1fremdfach+lv);PER ;
+erfassungsfeld[bsnr][fnrkunstmusik]:=wert(fnrddkunstmusik);FOR lvFROM 0UPTO 8
+REP erfassungsfeld[bsnr][fnrag+lv]:=wert(fnrddagthema1+lv);PER ;FOR lvFROM 0
+UPTO 7REP erfassungsfeld[bsnr][fnrwpsek1+lv]:=wert(fnrddfach091a+lv);PER .
+END PROC holedbwerte;PROC suanmeldungloeschen:IF sinnvolleauswahlgetroffen
+THEN loeschenvorbereitungbeginnenELSE startpos:=fnrfehlerfeld;return(1)FI .
+loeschenvorbereitungbeginnen:IF namenangabenausreichendTHEN loeschenbeginnen
+ELSE startpos:=fnrfehlerfeld;return(1)FI .namenangabenausreichend:IF 
+erfassungsprogrammTHEN namenangabenausreichendbeierfassungELSE 
+namenangabenausreichendbeibearbeitungoderzeigenFI .loeschenbeginnen:
+legeaktuellenbestandfest;BOOL VAR suexistiert:=FALSE ;schluesselbereitstellen
+;pruefeobnameexistiert(suexistiert);IF suexistiertTHEN saveupdateposition(
+dnrschueler);diffdatenlesen;schluessel(1):=wert(fnrsufamnames);schluessel(2)
+:=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert(fnrsugebdatums));
+loeschedieerstellteobjektliste;zurueckschreiben:=FALSE ;bereiteloeschenvor;
+suvonerfassungsbildschirmeinlesenELSE meldeauffaellig(maske(bs),
+meldunggibtsnicht);IF erfassungsprogrammTHEN startpos:=fnrparamnameELSE 
+startpos:=fnrparambearbnameFI ;return(1)FI .END PROC suanmeldungloeschen;
+PROC bereiteloeschenvor:bereiteaenderungvor;
+feldschutzfuerallefelderausserloeschfeldsetzen;meldeauffaellig(maske(bs),
+meldungloeschfrage);startpos:=fnrloeschfeldEND PROC bereiteloeschenvor;PROC 
+feldschutzfuerallefelderausserloeschfeldsetzen:INT VAR i;FOR iFROM 
+fnrerstesausgabefeldUPTO fnrloeschfeld-1REP protect(maske(bs),i,TRUE )PER ;
+protect(maske(erstererfbildschirm),fnrloeschfeld,FALSE );
+feldschutzzumloeschengesetzt:=TRUE .END PROC 
+feldschutzfuerallefelderausserloeschfeldsetzen;PROC 
+suanmeldungloeschenausfuehren(BOOL CONST zuloeschen):IF zuloeschenTHEN melde(
+maske(bs),meldungloeschung,namefuermeldung+kennzmeldungauffaellig);
+logeintragvornehmen("Entfernen");schuelerloeschen;IF dbstatus<>0THEN melde(
+maske(bs),meldungloeschenfehlerhaft,text(dbstatus)+kennzmeldungauffaellig);#
+altenschuelerwiedereintragen;dr10.05.88#return(1)ELSE 
+vorbereitendernaechstenschluesselbehandlungFI ELSE melde(maske(bs),
+meldungkeineloeschung,namefuermeldung+kennzmeldungauffaellig);
+vorbereitendernaechstenschluesselbehandlungFI .schuelerloeschen:
+hjddateiupdate(dnrhalbjahresdaten,satzloeschen);diffdatenloeschen;delete(
+dnrschueler);evtlaenderungderkurswahldatenvollziehen.diffdatenloeschen:IF 
+wert(fnrsudiffdatennrs)<>""THEN putwert(fnrdddiffdatennr,wert(
+fnrsudiffdatennrs));search(dnrdiffdaten,TRUE );IF dbstatus=okTHEN delete(
+dnrdiffdaten)FI FI .END PROC suanmeldungloeschenausfuehren;PROC 
+suanmeldungausgesuchteloeschen:behandlungderausgesuchten(loeschen)END PROC 
+suanmeldungausgesuchteloeschen;PROC behandlungderausgesuchten(INT CONST 
+wasistzutun):BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+loeschedieerstellteobjektliste;objektlistebeenden(dateiname,TRUE );
+reinitparsing;holeerstenmehrtlgschluesselausdatei(ok);WHILE okREP 
+pruefeobnameexistiert(ok);IF okTHEN saveupdateposition(dnrschueler);
+diffdatenlesen;kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden
+THEN zurueckschreiben:=TRUE ;IF wasistzutun=aendernTHEN #
+schuelerausstatwuerfelentfernen;dr10.05.88#bereiteaenderungvorELSE 
+bereiteloeschenvor;mehrereloeschen:=TRUE FI ;
+suvonerfassungsbildschirmeinlesenELSE zurueckschreiben:=FALSE ;
+suzurueckzumanfangsbildschirm(2)FI .END PROC behandlungderausgesuchten;BOOL 
+PROC namenangabenausreichendbeierfassung:IF erfassungsfeld(fbs1)(fnrparamname
+)=leerTHEN meldeauffaellig(maske(bs),meldungbittename);fnrfehlerfeld:=
+fnrparamname;FALSE ELIF erfassungsfeld(fbs1)(fnrparamrufname)=leerCAND 
+erfassungsfeld(fbs1)(fnrparamgebdat)<>leerTHEN meldeauffaellig(maske(bs),
+meldungangabengenauer);fnrfehlerfeld:=fnrparamrufname;FALSE ELSE TRUE FI .
+END PROC namenangabenausreichendbeierfassung;BOOL PROC 
+namenangabenausreichendbeibearbeitungoderzeigen:IF erfassungsfeld(fbs1)(
+fnrparambearbname)=leerTHEN meldeauffaellig(maske(bs),meldungbittename);
+fnrfehlerfeld:=fnrparambearbname;FALSE ELIF erfassungsfeld(fbs1)(
+fnrparambearbrufname)=leerCAND erfassungsfeld(fbs1)(fnrparambearbgebdat)<>
+leerTHEN meldeauffaellig(maske(bs),meldungangabengenauer);fnrfehlerfeld:=
+fnrparambearbrufname;FALSE ELSE TRUE FI .END PROC 
+namenangabenausreichendbeibearbeitungoderzeigen;PROC hjddateiupdate(INT 
+CONST dateinummer,wasistzutun):LET stackgroesse=6;INT VAR anzahltupel:=
+stackgroesse;inittupel(dateinummer);putwert(dateinummer+1,alterschluessel(1))
+;putwert(dateinummer+2,alterschluessel(2));putwert(dateinummer+3,
+datumskonversion(alterschluessel(3)));multisearchforward(dateinummer,
+anzahltupel);WHILE anzahltupel>0REP multisucc;IF gleicherschuelerTHEN SELECT 
+wasistzutunOF CASE satzloeschen:datenloeschenCASE satzneueschluessel:
+schluesselfelderaendernENDSELECT ;anzahltupelDECR 1;IF anzahltupel=0THEN 
+nachlesenFI ;ELSE LEAVE hjddateiupdateFI PER .gleicherschueler:
+alterschluessel(1)=wert(dateinummer+1)CAND alterschluessel(2)=wert(
+dateinummer+2)CAND alterschluessel(3)=datumrekonversion(wert(dateinummer+3)).
+datenloeschen:delete(dateinummer);fehlerprotokoll(dateinummer,satzloeschen).
+schluesselfelderaendern:putwert(dateinummer+1,schluessel(1));putwert(
+dateinummer+2,schluessel(2));putwert(dateinummer+3,datumskonversion(
+schluessel(3)));#update(dateinummer);dr10.05.88#selupdate(dateinummer);
+fehlerprotokoll(dateinummer,satzneueschluessel);putwert(dateinummer+1,
+alterschluessel(1));putwert(dateinummer+2,alterschluessel(2));putwert(
+dateinummer+3,datumskonversion(alterschluessel(3)));.nachlesen:anzahltupel:=
+stackgroesse;multisucc(dateinummer,anzahltupel).END PROC hjddateiupdate;PROC 
+fehlerprotokoll(INT CONST dateinummer,wasausdrucken):TEXT CONST fehlerdatei:=
+"Fehlerprotokoll";ROW 4TEXT VAR fehlerwobei:=ROW 4TEXT :(
+"Einfügen in die Datei ","Ändern in der Datei ","Löschen in der Datei ",
+"Ändern der Schlüsselfelder der Datei ");IF dbstatus<>okTHEN FILE VAR f:=
+sequentialfile(output,fehlerdatei);putline(f,
+"Fehlerprotokoll zur Bearbeitung des Schülers:");putline(f,schluessel(2)+
+leerzeichen+schluessel(1)+", geboren am "+datumskonversion(schluessel(3)));
+putline(f,leer);putline(f,"Fehler beim "+fehlerwobei[wasausdrucken]+name(
+dateinummer));print(fehlerdatei);forget(fehlerdatei,quiet);FI END PROC 
+fehlerprotokoll;PROC diffdatenlesen:readtid(dnrdiffdaten,wert(
+fnrsutiddiffdaten))END PROC diffdatenlesen;PROC 
+evtlaenderungderkurswahldatenvollziehen:IF dbstatus=0THEN IF aktbestand=
+bestandlaufschuljTHEN IF intwert(fnrsusgrpjgst)>=jgstufe10THEN 
+kurswahlserveraktualisieren(wert(fnrsusgrpjgst),"","")FI ELIF aktbestand=
+bestandneu11THEN kurswahlserveraktualisieren(text(jgstufe10),"","")ELIF 
+aktbestand=bestandneusonstTHEN IF intwert(fnrsujgsteintr)>jgstufe10THEN 
+kurswahlserveraktualisieren(text(intwert(fnrsujgsteintr)-1),"","")FI FI ;FI 
+END PROC evtlaenderungderkurswahldatenvollziehen;END PACKET erfschuelerdaten
+
diff --git a/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten b/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten
new file mode 100644
index 0000000..3427981
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.halbjahresdaten bearbeiten
@@ -0,0 +1,679 @@
+PACKET halbjahresdatenbearbeitenDEFINES halbjahresdatenbearbeiten,
+halbjahresdatenblaettern,halbjahresdatenspeichern,
+listezuhalbjahresdatenzeigen,
+halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten,
+halbjahresdatendesschuelersnichtbearbeiten,
+halbjahresdatendesschuelersbearbeiten,halbjahresdatenentfernenvorbereiten,
+halbjahresdatenentfernen,halbjahresdatennichtentfernen,pruefunghjd,
+hjderfassungswert:LET maskennamebearb1="ms bearb halbjahresdaten 1",
+maskennamebearb2="ms bearb halbjahresdaten 2",maskennameeingang=
+"ms bearb halbjahresdaten 0",fnrname=2,fnrrufname=3,fnrgebdatum=4,
+fnrgewschuljahr=5,fnrgewhalbjahr=6,fnrgewjgst=7,fnrabgangbestand=8,
+fnrausgabename=2,fnrausgaberufname=3,fnrausgabegebdatum=4,fnrausgabeaktjgst=5
+,fnrausgabeaktzug=6,fnrausgabeabgegangen=7,fnrausgabegewschj=8,
+fnrausgabegewhj=9,fnrausgabegewjgst=10,fnrausgabegewzug=11,fnrblbriefwarn=12,
+fnrblbriefbem=13,fnrblbriefnwarn=14,fnrblbriefnbem=15,fnrversetzung=16,
+fnrnachpr1=17,fnrnachpr2=18,fnrnachpr3=19,fnrnachprbem=20,fnrnachprabgelegt=
+21,fnrnachprnote=22,fnrzeugbem1=23,fnrzeugbem2=24,fnrzeugbem3=25,
+fnrversaeumtmit=26,fnrversaeumtohne=27,fnrverspaetet=28,fnrfachanf=12,
+fnrfachende=24,fnrkursartanf=25,fnrkursartende=37,fnrklausuranf=38,
+fnrklausurende=50,fnrkursanf=51,fnrkursende=63,fnrnoteanf=64,fnrnoteende=76,
+fnrbemanf=77,fnrbemende=89,fnrwarnunganf=90,fnrwarnungende=102,
+schueleraktuell="ls",schuelerabgegangen="abg",schulhalbjahr="Schulhalbjahr",
+schuljahr="Schuljahr",bestandblauerbrief="c02 blauer brief",
+bestandbemerkungen="c02 bemerkungen",bestandzeugnisnoten="c02 zeugnisnoten",
+bestandartlv="c02 art lehrveranstaltung",trenner="�",stdplausileiste=
+"0000000000000",paramausgabe="#",anzschluesselsu=3,fmeldnichtimbestand=55,
+meldungnureinesderfaechererl=147,meldungfachangabeunzulaessig=310,
+meldungversetzungskzunzulaessig=136,meldungwirklichloeschen=65,
+meldunggibtsnicht=71,meldunghjdgibtsnicht=168,meldungunerlaubterwert=34,
+meldunglistenerstellung=7,meldungkeineliste=68,meldungletzter=67,
+meldungspeicherung=50,meldungkeinespeicherung=63,meldungfalschesdatum=157,#
+meldungkeinewiederholungsdaten=160,#meldunghalbjahrnichtrelevant=161,
+meldungungueltigekursart=164,meldungfeldfuellen=170,meldungschuljahrangeben=
+171,meldungjgstangeben=172,meldungfalschejgst=173,meldungfalschefunktion=72,
+meldungnichtentfernt=62,meldungentfernt=61,meldungspeicherfehler=73,
+meldungvornamepraez=129,meldunginakthjkeineaenderung=379,pruefemeldung=57,
+dateiname="Schülerliste",oblitrenner="$",leer="",niltext="",punkt=".",
+textabgegangen="abgegangen",schrittefuerobjektliste=2,anzmasken=3,eingang=1,
+bearb1=2,bearb2=3,maxfeldbearb0=8,maxfeldbearb1=28,maxfeldbearb2=102,
+saetzederliste=17,pruefartdatum=6;BOOL VAR maskebearb1nochnichtda:=TRUE ,
+maskebearb2nochnichtda:=TRUE ,maskeeingangnochnichtda:=TRUE ,falschesdatum:=
+FALSE ;BOOL VAR schuljahrgefuellt,halbjahrgefuellt,jgstgefuellt,
+halbjahresdatenschonvorhanden;FILE VAR f;INT VAR fehlerfeld:=0,ind,bs,
+posgewhalbjahr,fnrfehler,fehlerstatus,fmeld:=0,lv:=0,feldnummer:=0;ROW 
+anzschluesselsuTEXT VAR schluessel;ROW anzmaskenROW maxfeldbearb2TEXT VAR 
+erfassungsfeld;ROW anzmaskenTAG VAR maske;TEXT VAR sicherunghjd:="",
+schuelertid:="",hjdtid:="",vergleichszeile:="",hjdfachleiste:="",hjdartleiste
+:="",hjdklausurleiste:="",hjdkennungenleiste:="",verglfachleiste:="",
+verglartleiste:="",verglklausurleiste:="",verglkennungenleiste:="",leiste,
+plausivar:="",plausileiste:="",pruefbestand:="",plausitxt,akthalbjahr:="",
+aktschuljahr:="",gewhalbjahr:="",gewschuljahr:="",jgst,zug,vglgewhalbjahr:=""
+,vglakthalbjahr:="",gewjgst:="",gewzug:="",aktbestand,spalteninhalte,versetzg
+:=trenner+trenner+"v"+trenner+"n"+trenner+"s"+trenner+"f"+trenner+"w"+trenner
+,faecher:=trenner+trenner,blbrief:=trenner+trenner,bemerk:=trenner+trenner,
+noten:=trenner+trenner,artlv:=trenner+trenner;LET logtextbeginn="Anw. 1.2.3 "
+;PROC halbjahresdatenentfernen:standardmeldung(meldungentfernt,niltext);
+infeld(fnrname);inittupel(dnrhalbjahresdaten);schluesselfuerhjdsetzen(
+dnrhalbjahresdaten,schluessel,gewschuljahr,gewhalbjahr,gewjgst);
+logeintragvornehmen("Entfernen");delete(dnrhalbjahresdaten);IF 
+aktuellesschulhalbjahrinbearbeitungTHEN loeschehjdtidinsu;FI ;enter(2).
+loeschehjdtidinsu:inittupel(dnrschueler);putwert(fnrsufamnames,schluessel(1))
+;putwert(fnrsurufnames,schluessel(2));putwert(fnrsugebdatums,schluessel(3));
+search(dnrschueler,TRUE );putwert(fnrsutidakthjd,"");update(dnrschueler).END 
+PROC halbjahresdatenentfernen;PROC halbjahresdatennichtentfernen:
+standardmeldung(meldungnichtentfernt,niltext);infeld(fnrname);return(2)END 
+PROC halbjahresdatennichtentfernen;PROC halbjahresdatenentfernenvorbereiten:
+BOOL VAR suexistiert:=FALSE ;IF maskeeingangnochnichtdaTHEN bs:=1;initmaske(
+maske(bs),maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:=
+FALSE FI ;IF erfassungsfeld(bs)(fnrname)<>""CAND erfassungsfeld(bs)(
+fnrgebdatum)<>""CAND erfassungsfeld(bs)(fnrrufname)=""THEN meldungausgeben(
+meldungvornamepraez,fnrrufname);LEAVE halbjahresdatenentfernenvorbereitenFI ;
+schluesselbereitstellen;IF NOT falschesdatumTHEN pruefeobnameexistiert(
+suexistiert);IF suexistiertTHEN bs:=1;holedbwerte(bs);schluessel(1):=
+erfassungsfeld(bs)(fnrname);schluessel(2):=erfassungsfeld(bs)(fnrrufname);
+schluessel(3):=datumskonversion(erfassungsfeld(eingang)(fnrgebdatum));
+weiterepruefungELSE meldungausgeben(meldunggibtsnicht,fnrname)FI ELSE 
+meldungausgeben(meldungfalschesdatum,fnrgebdatum)FI .weiterepruefung:jgst:=
+jgstaufber(wert(fnrsusgrpjgst));zug:=wert(fnrsusgrpzugtut);akthalbjahr:=
+schulkenndatum(schulhalbjahr);erfassungsfeld(bs)(fnrgewschuljahr):=
+standardmaskenfeld(fnrgewschuljahr);erfassungsfeld(bs)(fnrgewhalbjahr):=
+standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0
+THEN erfassungsfeld(bs)(fnrgewjgst):=niltext;gewjgst:=standardmaskenfeld(
+fnrgewjgst);ELSE erfassungsfeld(bs)(fnrgewjgst):=jgstaufber(
+standardmaskenfeld(fnrgewjgst));gewjgst:=jgstaufber(standardmaskenfeld(
+fnrgewjgst));FI ;gewschuljahr:=standardmaskenfeld(fnrgewschuljahr);
+gewhalbjahr:=standardmaskenfeld(fnrgewhalbjahr);fnrfehler:=0;
+pruefenobeintraegefuerhjdausreichend;IF fnrfehler=0THEN IF eingabenummerisch(
+gewschuljahr)CAND korrekteschuljahreseingabe(gewschuljahr)THEN 
+weiterevorbereitungnachfehlerpruefungELSE meldungausgeben(
+meldungunerlaubterwert,fnrgewschuljahr)FI ELSE meldungausgeben(
+meldungfeldfuellen,fnrfehler)FI .pruefenobeintraegefuerhjdausreichend:
+schuljahrgefuellt:=standardmaskenfeld(fnrgewschuljahr)<>leer;halbjahrgefuellt
+:=standardmaskenfeld(fnrgewhalbjahr)<>leer;jgstgefuellt:=standardmaskenfeld(
+fnrgewjgst)<>leer;IF allefelderleerOR nurhalbjahrgefuelltTHEN fnrfehler:=
+fnrgewschuljahrELIF nurschuljahrgefuelltOR nurjgstgefuelltOR 
+nurschuljahrundjgstgefuelltTHEN fnrfehler:=fnrgewhalbjahrFI .allefelderleer:(
+NOT schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (NOT jgstgefuellt).
+nurhalbjahrgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT 
+jgstgefuellt).nurschuljahrgefuellt:(schuljahrgefuellt)CAND (NOT 
+halbjahrgefuellt)CAND (NOT jgstgefuellt).nurjgstgefuellt:(NOT 
+schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (jgstgefuellt).
+nurschuljahrundjgstgefuellt:(schuljahrgefuellt)CAND (NOT halbjahrgefuellt)
+CAND (jgstgefuellt).weiterevorbereitungnachfehlerpruefung:
+halbjahresdatenschonvorhanden:=FALSE ;IF allefeldergefuelltTHEN 
+angabevonsjhjjgstELIF nurschuljahrundhalbjahrgefuelltTHEN angabevonsjhjELIF 
+nurhalbjahrundjgstgefuelltTHEN angabevonhjjgstFI ;gibmaskemitrowaus(eingang,
+fnrname,fnrabgangbestand).allefeldergefuellt:(schuljahrgefuellt)CAND (
+halbjahrgefuellt)CAND (jgstgefuellt).nurschuljahrundhalbjahrgefuellt:(
+schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT jgstgefuellt).
+nurhalbjahrundjgstgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)
+CAND (jgstgefuellt).angabevonsjhjjgst:jgst:=jgstaufber(wert(fnrsusgrpjgst));
+vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr;vglakthalbjahr:=jgst+punkt+
+akthalbjahr;schuelerhjdlesen(dnrhalbjahresdaten,TRUE );IF 
+halbjahresdatenschonvorhandenTHEN loeschedatensatzELSE meldunghjdgibtesnicht
+FI .angabevonsjhj:schuelerhjdlesen(dnrhalbjahresdaten,FALSE );IF 
+halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd);
+saveupdateposition(dnrhalbjahresdaten);gewjgst:=jgstaufber(wert(fnrhjdjgst));
+erfassungsfeld(eingang)(fnrgewjgst):=gewjgst;erfassungsfeld(bearb1)(
+fnrausgabegewjgst):=gewjgst;loeschedatensatzELSE meldungausgeben(
+meldungjgstangeben,fnrgewjgst)FI .angabevonhjjgst:schuelerhjdlesen(
+ixhjdfamrufgebjgsthj,TRUE );IF halbjahresdatenschonvorhandenTHEN savetupel(
+dnrhalbjahresdaten,sicherunghjd);saveupdateposition(dnrhalbjahresdaten);
+gewschuljahr:=wert(fnrhjdsj);erfassungsfeld(eingang)(fnrgewschuljahr):=gew
+schuljahr;erfassungsfeld(bearb1)(fnrausgabegewschj):=gewschuljahr;IF 
+wiederholungvorhanden(dnrhalbjahresdaten,ixhjdfamrufgebjgsthj)THEN 
+meldungbitteschuljahrangebenELSE restoreupdateposition(dnrhalbjahresdaten);
+loeschedatensatzFI ELSE meldungbitteschuljahrangebenFI .
+meldungbitteschuljahrangeben:meldungausgeben(meldungschuljahrangeben,
+fnrgewschuljahr).meldunghjdgibtesnicht:meldungausgeben(meldunghjdgibtsnicht,
+fnrgewschuljahr).loeschedatensatz:standardmaskenfeld(wert(fnrsufamnames),
+fnrname);standardmaskenfeld(wert(fnrsurufnames),fnrrufname);
+standardmaskenfeld(datumrekonversion(wert(fnrsugebdatums)),fnrgebdatum);
+standardmaskenfeld(gewschuljahr,fnrgewschuljahr);standardmaskenfeld(
+gewhalbjahr,fnrgewhalbjahr);standardmaskenfeld(gewjgst,fnrgewjgst);IF 
+aktbestand=schueleraktuellTHEN standardmaskenfeld("",fnrabgangbestand);ELSE 
+standardmaskenfeld("x",fnrabgangbestand);FI ;infeld(fnrname);
+standardfelderausgeben;meldungausgebeneinfach(meldungwirklichloeschen,fnrname
+).END PROC halbjahresdatenentfernenvorbereiten;PROC halbjahresdatenblaettern(
+BOOL CONST b):IF bTHEN IF bs=2THEN blaetteraufbearb2ELSE fehlermeldungFI 
+ELSE IF bs=3THEN blaetteraufbearb1ELSE fehlermeldungFI FI .fehlermeldung:
+standardmeldung(meldungfalschefunktion,"");return(1).blaetteraufbearb2:
+merkeinhaltbearb1;gibbearb2maskeaus;gibinhaltebearb2aus;.merkeinhaltbearb1:
+merkemaskeninhalt(bearb1,fnrausgabegewjgst,fnrverspaetet).gibbearb2maskeaus:
+IF maskebearb2nochnichtdaTHEN initmaske(maske(bearb2),maskennamebearb2);init(
+bearb2,maxfeldbearb2);FI ;standardstartproc(maskennamebearb2).
+gibinhaltebearb2aus:bs:=3;fuellehjddateninfelder;maskebearb2nochnichtda:=
+FALSE ;infeld(fnrausgabename);standardfelderausgeben;infeld(fnrfachanf);
+return(1).blaetteraufbearb1:merkeinhaltbearb2;gibbearb1maskeaus;
+gibinhaltebearb1aus.merkeinhaltbearb2:merkemaskeninhalt(bearb2,fnrfachanf,
+fnrwarnungende).gibbearb1maskeaus:standardstartproc(maskennamebearb1).
+gibinhaltebearb1aus:bs:=2;fuellehjddateninfelder;infeld(fnrausgabename);
+standardfelderausgeben;IF akthalbjahr=gewhalbjahrCAND aktschuljahr=
+gewschuljahrTHEN infeld(fnrblbriefwarn)ELSE infeld(fnrausgabegewjgst);FI ;
+return(1).END PROC halbjahresdatenblaettern;PROC gibmaskemitrowaus(INT CONST 
+maske,vonfeld,bisfeld):INT VAR lv;FOR lvFROM vonfeldUPTO bisfeldREP 
+standardmaskenfeld(erfassungsfeld(maske)(lv),lv);PER END PROC 
+gibmaskemitrowaus;PROC merkemaskeninhalt(INT CONST maske,vonfeld,bisfeld):
+INT VAR lv;FOR lvFROM vonfeldUPTO bisfeldREP erfassungsfeld(maske)(lv):=
+standardmaskenfeld(lv);PER END PROC merkemaskeninhalt;PROC 
+halbjahresdatenbearbeiten:BOOL VAR suexistiert:=FALSE ;reinitparsing;bs:=
+eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske(bs),maskennameeingang)
+;init(bs,maxfeldbearb0);maskeeingangnochnichtda:=FALSE FI ;erfassungsfeld(bs)
+(fnrname):=standardmaskenfeld(fnrname);erfassungsfeld(bs)(fnrrufname):=
+standardmaskenfeld(fnrrufname);erfassungsfeld(bs)(fnrgebdatum):=
+standardmaskenfeld(fnrgebdatum);IF erfassungsfeld(bs)(fnrname)<>""CAND 
+erfassungsfeld(bs)(fnrgebdatum)<>""CAND erfassungsfeld(bs)(fnrrufname)=""
+THEN meldungausgeben(meldungvornamepraez,fnrrufname);LEAVE 
+halbjahresdatenbearbeitenFI ;schluesselbereitstellen;IF NOT falschesdatum
+THEN pruefeobnameexistiert(suexistiert);IF suexistiertTHEN 
+loeschedieerstellteobjektliste;holedbwerte(bs);schluessel(1):=erfassungsfeld(
+bs)(fnrname);schluessel(2):=erfassungsfeld(bs)(fnrrufname);schluessel(3):=
+datumskonversion(erfassungsfeld(bs)(fnrgebdatum));jgst:=jgstaufber(wert(
+fnrsusgrpjgst));zug:=wert(fnrsusgrpzugtut);akthalbjahr:=schulkenndatum(
+schulhalbjahr);aktschuljahr:=schulkenndatum(schuljahr);
+halbjahresdatendesschuelersbearbeiten;ELSE meldungausgeben(meldunggibtsnicht,
+fnrname)FI ELSE return(1)FI .END PROC halbjahresdatenbearbeiten;PROC 
+halbjahresdatendesschuelersbearbeiten:maskebearb1nochnichtda:=TRUE ;
+maskebearb2nochnichtda:=TRUE ;erfassungsfeld(bs)(fnrgewschuljahr):=
+standardmaskenfeld(fnrgewschuljahr);erfassungsfeld(bs)(fnrgewhalbjahr):=
+standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0
+THEN erfassungsfeld(bs)(fnrgewjgst):=niltext;gewjgst:=standardmaskenfeld(
+fnrgewjgst);ELSE erfassungsfeld(bs)(fnrgewjgst):=jgstaufber(
+standardmaskenfeld(fnrgewjgst));gewjgst:=erfassungsfeld(bs)(fnrgewjgst)FI ;
+gewschuljahr:=standardmaskenfeld(fnrgewschuljahr);gewhalbjahr:=
+standardmaskenfeld(fnrgewhalbjahr);infeld(fnrname);gibmaskemitrowaus(eingang,
+fnrname,fnrgewjgst);standardfelderausgeben;IF akthalbjahr=gewhalbjahrCAND 
+aktschuljahr=gewschuljahrTHEN IF erfassungsfeld(bs)(fnrgewjgst)<>niltextCAND 
+jgst<>gewjgstTHEN meldungausgeben(meldungfalschejgst,fnrgewjgst);LEAVE 
+halbjahresdatendesschuelersbearbeitenFI ;FI ;
+pruefenobeintraegefuerhjdausreichend;#dr16.07.87#IF fnrfehler=0THEN IF 
+eingabenummerisch(gewschuljahr)CAND korrekteschuljahreseingabe(gewschuljahr)
+THEN initmaske(maske(bs),maskennamebearb1);init(bearb1,maxfeldbearb1);
+erfassungsfeld(bearb1)(fnrausgabename):=schluessel(1);erfassungsfeld(bearb1)(
+fnrausgaberufname):=schluessel(2);erfassungsfeld(bearb1)(fnrausgabegebdatum)
+:=erfassungsfeld(eingang)(fnrgebdatum);erfassungsfeld(bearb1)(
+fnrausgabeaktjgst):=jgst;erfassungsfeld(bearb1)(fnrausgabeaktzug):=zug;IF 
+aktbestand="ls"THEN erfassungsfeld(bearb1)(fnrausgabeabgegangen):=
+"          "ELSE erfassungsfeld(bearb1)(fnrausgabeabgegangen):="abgegangen"
+FI ;erfassungsfeld(bearb1)(fnrausgabegewschj):=gewschuljahr;erfassungsfeld(
+bearb1)(fnrausgabegewhj):=gewhalbjahr;erfassungsfeld(bearb1)(
+fnrausgabegewjgst):=gewjgst;weiterevorbereitungnachfehlerpruefungELSE 
+meldungausgeben(meldungunerlaubterwert,fnrgewschuljahr)FI ELSE 
+meldungausgeben(meldungfeldfuellen,fnrfehler)FI .
+pruefenobeintraegefuerhjdausreichend:fnrfehler:=0;schuljahrgefuellt:=
+standardmaskenfeld(fnrgewschuljahr)<>leer;halbjahrgefuellt:=
+standardmaskenfeld(fnrgewhalbjahr)<>leer;jgstgefuellt:=standardmaskenfeld(
+fnrgewjgst)<>leer;IF allefelderleerOR nurhalbjahrgefuelltTHEN fnrfehler:=
+fnrgewschuljahrELIF nurschuljahrgefuelltOR nurjgstgefuelltOR 
+nurschuljahrundjgstgefuelltTHEN fnrfehler:=fnrgewhalbjahrFI .allefelderleer:(
+NOT schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (NOT jgstgefuellt).
+nurhalbjahrgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT 
+jgstgefuellt).nurschuljahrgefuellt:(schuljahrgefuellt)CAND (NOT 
+halbjahrgefuellt)CAND (NOT jgstgefuellt).nurjgstgefuellt:(NOT 
+schuljahrgefuellt)CAND (NOT halbjahrgefuellt)CAND (jgstgefuellt).
+nurschuljahrundjgstgefuellt:(schuljahrgefuellt)CAND (NOT halbjahrgefuellt)
+CAND (jgstgefuellt).weiterevorbereitungnachfehlerpruefung:
+halbjahresdatenschonvorhanden:=FALSE ;IF allefeldergefuelltTHEN 
+angabevonsjhjjgstELIF nurschuljahrundhalbjahrgefuelltTHEN angabevonsjhjELIF 
+nurhalbjahrundjgstgefuelltTHEN angabevonhjjgstFI ;gibmaskemitrowaus(bearb1,
+fnrname,fnrabgangbestand).allefeldergefuellt:(schuljahrgefuellt)CAND (
+halbjahrgefuellt)CAND (jgstgefuellt).nurschuljahrundhalbjahrgefuellt:(
+schuljahrgefuellt)CAND (halbjahrgefuellt)CAND (NOT jgstgefuellt).
+nurhalbjahrundjgstgefuellt:(NOT schuljahrgefuellt)CAND (halbjahrgefuellt)
+CAND (jgstgefuellt).angabevonsjhjjgst:IF halbjahrrelevantTHEN 
+schuelerhjdlesen(dnrhalbjahresdaten,TRUE );IF halbjahresdatenschonvorhanden
+THEN savetupel(dnrhalbjahresdaten,sicherunghjd);saveupdateposition(
+dnrhalbjahresdaten);IF passendejgstTHEN aenderungsvorbereitungELSE 
+meldungausgeben(meldungfalschejgst,fnrgewjgst);LEAVE 
+halbjahresdatendesschuelersbearbeitenFI ;ELSE aenderungsvorbereitungFI ;ELSE 
+meldungausgeben(meldunghalbjahrnichtrelevant,fnrgewjgst);LEAVE 
+halbjahresdatendesschuelersbearbeitenFI .passendejgst:int(gewjgst)=intwert(
+fnrhjdjgst).angabevonsjhj:schuelerhjdlesen(dnrhalbjahresdaten,FALSE );IF 
+halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd);
+saveupdateposition(dnrhalbjahresdaten);gewjgst:=jgstaufber(wert(fnrhjdjgst));
+erfassungsfeld(eingang)(fnrgewjgst):=gewjgst;erfassungsfeld(bearb1)(
+fnrausgabegewjgst):=gewjgst;infeld(fnrgewjgst);standardmaskenfeld(gewjgst,
+fnrgewjgst);standardfelderausgeben;vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr;
+vglakthalbjahr:=jgst+punkt+akthalbjahr;aenderungsvorbereitungELIF akthalbjahr
+=gewhalbjahrCAND aktschuljahr=gewschuljahrTHEN infeld(fnrgewjgst);
+standardmaskenfeld(jgst,fnrgewjgst);standardfelderausgeben;erfassungsfeld(
+bearb1)(fnrausgabegewjgst):=jgst;vglgewhalbjahr:=gewjgst+punkt+gewhalbjahr;
+vglakthalbjahr:=jgst+punkt+akthalbjahr;aenderungsvorbereitungELSE 
+meldungausgeben(meldungjgstangeben,fnrgewjgst);LEAVE 
+halbjahresdatendesschuelersbearbeitenFI .angabevonhjjgst:IF halbjahrrelevant
+THEN schuelerhjdlesen(ixhjdfamrufgebjgsthj,TRUE );IF 
+halbjahresdatenschonvorhandenTHEN savetupel(dnrhalbjahresdaten,sicherunghjd);
+saveupdateposition(dnrhalbjahresdaten);gewschuljahr:=wert(fnrhjdsj);
+erfassungsfeld(eingang)(fnrgewschuljahr):=gewschuljahr;erfassungsfeld(bearb1)
+(fnrausgabegewschj):=gewschuljahr;IF wiederholungvorhanden(dnrhalbjahresdaten
+,ixhjdfamrufgebjgsthj)THEN meldungbitteschuljahrangeben;LEAVE 
+halbjahresdatendesschuelersbearbeitenELSE infeld(fnrgewschuljahr);
+standardmaskenfeld(gewschuljahr,fnrgewschuljahr);standardfelderausgeben;
+aenderungsvorbereitungFI ELSE meldungbitteschuljahrangeben;LEAVE 
+halbjahresdatendesschuelersbearbeitenFI ELSE meldungausgeben(
+meldunghalbjahrnichtrelevant,fnrgewjgst);LEAVE 
+halbjahresdatendesschuelersbearbeitenFI .meldungbitteschuljahrangeben:
+meldungausgeben(meldungschuljahrangeben,fnrgewschuljahr).
+aenderungsvorbereitung:standardstartproc(maskennamebearb1);bs:=bearb1;IF 
+maskebearb1nochnichtdaTHEN maskebearb1nochnichtda:=FALSE FI ;
+bereiteaenderungvor.halbjahrrelevant:vglgewhalbjahr:=gewjgst+punkt+
+gewhalbjahr;vglakthalbjahr:=jgst+punkt+akthalbjahr;lieferehalbjahreszeile(
+vergleichszeile,vglakthalbjahr);posgewhalbjahr:=pos(vergleichszeile,
+vglgewhalbjahr);posgewhalbjahr>0.END PROC 
+halbjahresdatendesschuelersbearbeiten;PROC meldungausgeben(INT CONST welche,
+fehlerfeld):standardmeldung(welche,niltext);infeld(fehlerfeld);return(1)END 
+PROC meldungausgeben;PROC meldungausgebeneinfach(INT CONST welche,fehlerfeld)
+:standardmeldung(welche,niltext);infeld(fehlerfeld);standardnprocEND PROC 
+meldungausgebeneinfach;PROC schluesselbereitstellen:falschesdatum:=FALSE ;
+fehlerfeld:=0;schluessel(1):=standardmaskenfeld(fnrname);schluessel(2):=
+standardmaskenfeld(fnrrufname);schluessel(3):=datumrekonversion(
+standardmaskenfeld(fnrgebdatum));IF standardmaskenfeld(fnrgebdatum)<>niltext
+THEN pruefe(pruefartdatum,maske(bs),TEXT PROC (INT CONST )hjderfassungswert,
+fnrgebdatum,0,0,niltext,fehlerfeld);IF fehlerfeld<>0THEN infeld(fehlerfeld);
+falschesdatum:=TRUE ;FI FI ;IF NOT falschesdatumTHEN legeaktuellenbestandfest
+FI .END PROC schluesselbereitstellen;PROC legeaktuellenbestandfest:
+erfassungsfeld(bs)(fnrabgangbestand):=standardmaskenfeld(fnrabgangbestand);
+IF standardmaskenfeld(fnrabgangbestand)=""THEN aktbestand:=schueleraktuell
+ELSE aktbestand:=schuelerabgegangenFI END PROC legeaktuellenbestandfest;PROC 
+pruefeobnameexistiert(BOOL VAR suexist):TEXT VAR datenbankwerte,
+schluesselwerte;inittupel(dnrschueler);maskenwerteindatenbank;IF NOT 
+falschesdatumTHEN search(ixsustatfamrufgeb,FALSE );IF dbstatus=okCAND wert(
+fnrsustatuss)=aktbestandTHEN schuelertid:=gettid;hjdtid:=wert(fnrsutidakthjd)
+;datenbankwerte:=wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));
+schluesselwerte:=schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=
+schluessel(1)CAND ((schluessel(2)=leerAND schluessel(3)=leer)OR (pos(
+datenbankwerte,schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC 
+pruefeobnameexistiert;PROC maskenwerteindatenbank:putwert(fnrsufamnames,
+schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop;putwert(
+fnrsugebdatums,datumskonversion(schluessel(3)));IF iserrorTHEN clearerror;
+standardmeldung(meldungfalschesdatum,"");infeld(fnrgebdatum);falschesdatum:=
+TRUE ;ELSE putwert(fnrsustatuss,aktbestand);FI ;enablestopEND PROC 
+maskenwerteindatenbank;PROC bereiteaenderungvor:IF 
+halbjahresdatenschonvorhandenTHEN restoretupel(dnrhalbjahresdaten,
+sicherunghjd);holedbwerte(bearb1);FI ;IF aktuelleshalbjahrTHEN IF NOT 
+halbjahresdatenschonvorhandenTHEN erfassungsfeld(bearb1)(fnrausgabegewzug):=
+zug;FI ;fuellehjddateninfelder;infeld(fnrausgabename);standardfelderausgeben;
+infeld(fnrblbriefwarn)ELSE IF NOT halbjahresdatenschonvorhandenTHEN 
+erfassungsfeld(bearb1)(fnrausgabegewzug):=gewzug;FI ;fuellehjddateninfelder;
+infeld(fnrausgabename);standardfelderausgeben;infeld(fnrausgabegewjgst)FI ;
+standardnproc.aktuelleshalbjahr:akthalbjahr=gewhalbjahrCAND aktschuljahr=
+gewschuljahr.END PROC bereiteaenderungvor;BOOL PROC wiederholungvorhanden(
+INT CONST dnr,index):ROW 5TEXT VAR feld;feld(1):=wert(dnr+1);feld(2):=wert(
+dnr+2);feld(3):=wert(dnr+3);feld(4):=wert(dnr+5);feld(5):=wert(dnr+6);succ(
+index);dbstatus=okCAND feld(1)=wert(dnr+1)CAND feld(2)=wert(dnr+2)CAND feld(3
+)=wert(dnr+3)CAND feld(4)=wert(dnr+5)CAND feld(5)=wert(dnr+6).END PROC 
+wiederholungvorhanden;PROC fuellehjddateninfelder:IF bs=2THEN 
+gibmaskemitrowaus(bearb1,fnrname,fnrverspaetet);ELSE gibmaskemitrowaus(bearb1
+,fnrname,fnrausgabegewzug);IF maskebearb2nochnichtdaTHEN fachfuellen;
+artfuellen;klausurfuellen;kursfuellen;notefuellen;bemfuellen;warnungfuellen;
+ELSE gibmaskemitrowaus(bearb2,fnrfachanf,fnrwarnungende)FI FI .fachfuellen:
+hjdfachleiste:=wert(fnrhjdfach);FOR indFROM 0UPTO (fnrfachende-fnrfachanf)
+REP standardmaskenfeld(wert(fnrhjdfach,(ind*2+1),2),(fnrfachanf+ind))PER .
+artfuellen:hjdartleiste:=wert(fnrhjdkursart);FOR indFROM 0UPTO (
+fnrkursartende-fnrkursartanf)REP standardmaskenfeld(wert(fnrhjdkursart,(ind*2
++1),2),(fnrkursartanf+ind))PER .klausurfuellen:hjdklausurleiste:=wert(
+fnrhjdklausurteiln);FOR indFROM 0UPTO (fnrklausurende-fnrklausuranf)REP 
+standardmaskenfeld(wert(fnrhjdklausurteiln,(ind+1),1),(fnrklausuranf+ind))
+PER .kursfuellen:TEXT VAR klzeichen;hjdkennungenleiste:=wert(
+fnrhjdlerngrpkenn);FOR indFROM 0UPTO (fnrkursende-fnrkursanf)REP 
+standardmaskenfeld(wert(fnrhjdlerngrpkenn,(4*ind+1),4),(fnrkursanf+ind))PER .
+notefuellen:FOR indFROM 0UPTO (fnrnoteende-fnrnoteanf)REP standardmaskenfeld(
+wert(fnrhjdnotepunkte,(2*ind+1),2),(fnrnoteanf+ind))PER .bemfuellen:FOR ind
+FROM 0UPTO (fnrbemende-fnrbemanf)REP standardmaskenfeld(wert(fnrhjdbemerk,(3*
+ind+1),3),(fnrbemanf+ind))PER .warnungfuellen:FOR indFROM 0UPTO (
+fnrwarnungende-fnrwarnunganf)REP standardmaskenfeld(wert(fnrhjdvermwarnung,(
+ind+1),1),(fnrwarnunganf+ind))PER .END PROC fuellehjddateninfelder;PROC 
+loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC 
+loeschedieerstellteobjektliste;PROC schuelerhjdlesen(INT CONST index,BOOL 
+CONST jgstgesetzt):IF jgstgesetztTHEN IF aktuellesschulhalbjahrinbearbeitung
+THEN IF hjdtid<>leerTHEN readtid(dnrhalbjahresdaten,hjdtid);
+halbjahresdatenschonvorhanden:=dbstatus=0ELSE inittupel(dnrhalbjahresdaten);
+halbjahresdatenschonvorhanden:=FALSE FI ELSE richtigsuchenundlesenFI ELSE 
+richtigsuchenundlesenFI ;IF halbjahresdatenschonvorhandenAND wert(
+fnrhjdkennung)<>""THEN gewzug:=wert(fnrhjdkennung)ELSE gewzug:=""FI .
+richtigsuchenundlesen:inittupel(dnrhalbjahresdaten);schluesselfuerhjdsetzen(
+dnrhalbjahresdaten,schluessel,gewschuljahr,gewhalbjahr,gewjgst);search(index,
+TRUE );halbjahresdatenschonvorhanden:=dbstatus=0.END PROC schuelerhjdlesen;
+PROC halbjahresdatenspeichern(BOOL CONST speichern):INT VAR aktjg:=int(jgst);
+IF speichernTHEN IF faecher=trenner+trennerTHEN holeaktdatenFI ;fehlerstatus
+:=0;merkeinhaltdesaktuellenschirms;pruefeplausibilitaet(fehlerstatus);IF 
+datenfehlerfreiTHEN standardmeldung(meldungspeicherung,"");datenspeichern;#
+eventuellinstatwuerfeleintragen;dr11.05.88#
+ueberpruefobkurswahlbasisnochaktuell;
+vorbereitendernaechstenschluesselbehandlung(2)ELSE return(1)FI ELSE 
+standardmeldung(meldungkeinespeicherung,"");
+vorbereitendernaechstenschluesselbehandlung(2)FI .
+ueberpruefobkurswahlbasisnochaktuell:IF NOT maskebearb2nochnichtdaTHEN IF 
+sek2jgstTHEN IF aktoderzukhjTHEN IF aenderunginkurswahldatenTHEN 
+loeschspezkurswahlbasisFI FI FI FI .sek2jgst:aktjg>9.aktoderzukhj:(int(
+gewjgst)=aktjgCAND int(gewhalbjahr)>=int(akthalbjahr))COR int(gewjgst)>aktjg.
+aenderunginkurswahldaten:hjdfachleiste<>verglfachleisteCOR hjdartleiste<>
+verglartleisteCOR hjdklausurleiste<>verglklausurleisteCOR hjdkennungenleiste
+<>verglkennungenleiste.loeschspezkurswahlbasis:kurswahlserveraktualisieren(
+jgst,gewjgst,gewhalbjahr).holeaktdaten:holeblbrief;holebemerk;holenoten;
+holefaecher;holeartlv.holeblbrief:inittupel(dnrschluessel);statleseschleife(
+dnrschluessel,bestandblauerbrief,"",fnrschlsachgebiet,fnrschlschluessel,PROC 
+briefcat).holebemerk:inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+bestandbemerkungen,"",fnrschlsachgebiet,fnrschlschluessel,PROC bemerkcat).
+holenoten:inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+bestandzeugnisnoten,"",fnrschlsachgebiet,fnrschlschluessel,PROC notencat).
+holefaecher:inittupel(dnrfaecher);statleseschleife(dnrfaecher,"","",fnrffach,
+fnrffachbez,PROC fachcat).holeartlv:inittupel(dnrschluessel);statleseschleife
+(dnrschluessel,bestandartlv,"",fnrschlsachgebiet,fnrschlschluessel,PROC 
+artcat).merkeinhaltdesaktuellenschirms:IF bs=2THEN merkemaskeninhalt(bearb1,
+fnrausgabegewjgst,fnrverspaetet)ELSE merkemaskeninhalt(bearb2,fnrfachanf,
+fnrwarnungende);FI .datenfehlerfrei:fehlerstatus=0.datenspeichern:IF 
+halbjahresdatenschonvorhandenTHEN logeintragvornehmen("Änderung");
+datenaendernELSE logeintragvornehmen("Neueinfügen");schluesselsetzen(
+dnrhalbjahresdaten);dateneinfuegenFI .datenaendern:dbwertesetzen;
+restoreupdateposition(dnrhalbjahresdaten);selupdate(dnrhalbjahresdaten);
+statusabfrage.dateneinfuegen:dbwertesetzen;insert(dnrhalbjahresdaten);
+statusabfrage;IF dbstatus=ok#dr11.05.88#THEN hjdtid:=gettid;
+eventuellneueshjdtideintragenFI .END PROC halbjahresdatenspeichern;PROC 
+logeintragvornehmen(TEXT CONST logergaenzung):TEXT VAR eintrag:=logtextbeginn
+;eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel(1);eintrag
+CAT ", ";eintragCAT schluessel(2);eintragCAT ", ";eintragCAT schluessel(3);
+eintragCAT """";logeintrag(eintrag)END PROC logeintragvornehmen;PROC fachcat(
+BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE faecherCAT wert(fnrffach);faecher
+CAT trennerFI END PROC fachcat;PROC artcat(BOOL VAR b):IF wert(
+fnrschlsachgebiet)>bestandartlvCOR dbstatus<>0THEN b:=TRUE ELSE artlvCAT wert
+(fnrschlschluessel);artlvCAT trennerFI END PROC artcat;PROC briefcat(BOOL 
+VAR b):IF wert(fnrschlsachgebiet)>bestandblauerbriefCOR dbstatus<>0THEN b:=
+TRUE ELSE blbriefCAT wert(fnrschlschluessel);blbriefCAT trennerFI END PROC 
+briefcat;PROC bemerkcat(BOOL VAR b):IF wert(fnrschlsachgebiet)>
+bestandbemerkungenCOR dbstatus<>0THEN b:=TRUE ELSE bemerkCAT wert(
+fnrschlschluessel);bemerkCAT trennerFI END PROC bemerkcat;PROC notencat(BOOL 
+VAR b):IF wert(fnrschlsachgebiet)>bestandzeugnisnotenCOR dbstatus<>0THEN b:=
+TRUE ELSE notenCAT wert(fnrschlschluessel);notenCAT trennerFI END PROC 
+notencat;PROC statusabfrage:IF dbstatus<>0THEN standardmeldung(
+meldungspeicherfehler,text(dbstatus)+paramausgabe);pauseFI .END PROC 
+statusabfrage;PROC schluesselsetzen(INT CONST dateinummer):
+schluesselfuerhjdsetzen(dateinummer,schluessel,gewschuljahr,gewhalbjahr,
+gewjgst)END PROC schluesselsetzen;PROC dbwertesetzen:INT VAR lv;IF bs=2THEN 
+datenbearb1vombsholen;datenbearb2setzenELSE datenbearb1setzen;
+datenbearb2vombsholenFI .datenbearb1vombsholen:FOR lvFROM fnrausgabegewjgst
+UPTO fnrverspaetetREP erfassungsfeld(bearb1)(lv):=standardmaskenfeld(lv)PER ;
+setzedbwerte(bearb1);setzekennung;.setzekennung:IF 
+aktuellesschulhalbjahrinbearbeitungTHEN putwert(fnrhjdkennung,compress(zug))
+FI .datenbearb2setzen:IF NOT maskebearb2nochnichtdaTHEN setzedbwerte(bearb2)
+FI .datenbearb1setzen:setzedbwerte(bearb1).datenbearb2vombsholen:fachsetzen;
+artsetzen;klausursetzen;kurssetzen;notesetzen;bemerksetzen;kurswarnungsetzen.
+fachsetzen:spalteninhalte:="";FOR indFROM fnrfachanfUPTO fnrfachendeREP 
+plausivar:=standardmaskenfeld(ind);IF compress(plausivar)<>""THEN 
+spalteninhalteCAT text(plausivar,2)FI ;PER ;putwert(fnrhjdfach,spalteninhalte
+).artsetzen:spalteninhalte:="";FOR indFROM fnrkursartanfUPTO fnrkursartende
+REP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text(
+standardmaskenfeld(ind),2)FI ;PER ;putwert(fnrhjdkursart,spalteninhalte).
+klausursetzen:spalteninhalte:="";FOR indFROM fnrklausuranfUPTO fnrklausurende
+REP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text(
+standardmaskenfeld(ind),1)FI ;PER ;putwert(fnrhjdklausurteiln,spalteninhalte)
+.kurssetzen:spalteninhalte:="";FOR indFROM fnrkursanfUPTO fnrkursendeREP IF (
+plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text(
+standardmaskenfeld(ind),4)FI ;PER ;putwert(fnrhjdlerngrpkenn,spalteninhalte).
+notesetzen:spalteninhalte:="";FOR indFROM fnrnoteanfUPTO fnrnoteendeREP IF (
+plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text(
+standardmaskenfeld(ind),2)FI ;PER ;putwert(fnrhjdnotepunkte,spalteninhalte).
+bemerksetzen:spalteninhalte:="";FOR indFROM fnrbemanfUPTO fnrbemendeREP IF (
+plausileisteSUB ((ind+1)MOD 13+1))="1"THEN spalteninhalteCAT text(
+standardmaskenfeld(ind),3)FI ;PER ;putwert(fnrhjdbemerk,spalteninhalte).
+kurswarnungsetzen:spalteninhalte:="";FOR indFROM fnrwarnunganfUPTO 
+fnrwarnungendeREP IF (plausileisteSUB ((ind+1)MOD 13+1))="1"THEN 
+spalteninhalteCAT text(standardmaskenfeld(ind),1)FI ;PER ;putwert(
+fnrhjdvermwarnung,spalteninhalte).END PROC dbwertesetzen;PROC 
+vorbereitendernaechstenschluesselbehandlung(INT CONST rueckschritte):IF 
+exists(dateiname)THEN holenaechstenschluesselauslisteELSE enter(2)FI .
+holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+holenaechstenmehrtlgschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(
+ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden
+THEN bereiteeingangsmaskefuerausgewaehltenvor;return(rueckschritte)ELSE 
+behandleendederlistenabarbeitungFI .behandleendederlistenabarbeitung:
+standardmeldung(meldungletzter,"");enter(rueckschritte+
+schrittefuerobjektliste).END PROC vorbereitendernaechstenschluesselbehandlung
+;PROC bereiteeingangsmaskefuerausgewaehltenvor:standardstartproc(
+maskennameeingang);bs:=eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske
+(bs),maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:=
+FALSE FI ;jgst:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);akthalbjahr:=
+schulkenndatum(schulhalbjahr);fuellemaskenfeldereingang;gibmaskemitrowaus(
+eingang,fnrname,fnrabgangbestand);infeld(fnrname);standardfelderausgeben;
+setzefeldschutz;infeld(fnrgewschuljahr)END PROC 
+bereiteeingangsmaskefuerausgewaehltenvor;PROC pruefeplausibilitaet(INT VAR 
+fstatus):fmeld:=0;feldnummer:=0;pruefbestand:="";fstatus:=0;standardmeldung(
+pruefemeldung,"");pruefeplausibilitaetbearb1;IF NOT maskebearb2nochnichtda
+THEN pruefeplausibilitaetbearb2FI .fehlerbehandlungbearb1:IF bs=3THEN 
+standardstartproc(maskennamebearb1);bs:=2;fuellehjddateninfelder;infeld(
+fnrausgabename);standardfelderausgeben;FI ;fehlerausgabespeziell;infeld(
+fstatus);LEAVE pruefeplausibilitaet.fehlerausgabespeziell:IF fmeld=
+meldungversetzungskzunzulaessigTHEN standardmeldung(fmeld,erfassungsfeld(
+bearb1)(fnrversetzung)+paramausgabe);ELIF fmeld=meldungnureinesderfaechererl
+THEN standardmeldung(fmeld,plausitxt+paramausgabe);ELIF fmeld=
+meldunginakthjkeineaenderungTHEN standardmeldung(fmeld,erfassungsfeld(bearb1)
+(fnrrufname)+" "+erfassungsfeld(bearb1)(fnrname)+paramausgabe+jgst+zug+
+paramausgabe)ELSE standardmeldung(fmeld,"")FI .fehlerbehandlungbearb2:IF bs=2
+THEN standardstartproc(maskennamebearb2);bs:=3;fuellehjddateninfelder;infeld(
+fnrausgabename);standardfelderausgeben;FI ;fehlerausgabe;LEAVE 
+pruefeplausibilitaet.fehlerausgabe:infeld(fstatus);standardmeldung(fmeld,"").
+pruefeplausibilitaetbearb1:IF erfassungsfeld(bearb1)(fnrausgabegewjgst)=""
+THEN fstatus:=fnrausgabegewjgst;fmeld:=meldungjgstangeben;
+fehlerbehandlungbearb1ELIF erfassungsfeld(bearb1)(fnrausgabegewzug)=""THEN 
+fstatus:=fnrausgabegewzug;fmeld:=meldungfeldfuellen;fehlerbehandlungbearb1
+ELIF erfassungsfeld(bearb1)(fnrausgabegewjgst)<>jgstCAND aktuellessjhjTHEN 
+fstatus:=fnrausgabegewjgst;fmeld:=meldunginakthjkeineaenderung;
+fehlerbehandlungbearb1ELIF erfassungsfeld(bearb1)(fnrausgabegewzug)<>zugCAND 
+aktuellessjhjTHEN fstatus:=fnrausgabegewzug;fmeld:=
+meldunginakthjkeineaenderung;fehlerbehandlungbearb1ELSE gewjgst:=jgstaufber(
+erfassungsfeld(bearb1)(fnrausgabegewjgst));vglgewhalbjahr:=gewjgst+punkt+
+gewhalbjahr;vglakthalbjahr:=jgst+punkt+akthalbjahr;lieferehalbjahreszeile(
+vergleichszeile,vglakthalbjahr);posgewhalbjahr:=pos(vergleichszeile,
+vglgewhalbjahr);IF posgewhalbjahr<1THEN fstatus:=fnrausgabegewjgst;fmeld:=
+meldunghalbjahrnichtrelevant;fehlerbehandlungbearb1FI ;FI ;IF pos(blbrief,
+trenner+erfassungsfeld(bearb1)(fnrblbriefwarn)+trenner)<1THEN fstatus:=
+fnrblbriefwarn;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(
+blbrief,trenner+erfassungsfeld(bearb1)(fnrblbriefnwarn)+trenner)<1THEN 
+fstatus:=fnrblbriefnwarn;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI 
+;IF pos(bemerk,trenner+erfassungsfeld(bearb1)(fnrblbriefbem)+trenner)<1THEN 
+fstatus:=fnrblbriefbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;
+IF pos(bemerk,trenner+erfassungsfeld(bearb1)(fnrblbriefnbem)+trenner)<1THEN 
+fstatus:=fnrblbriefnbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;
+IF pos(versetzg,trenner+erfassungsfeld(bearb1)(fnrversetzung)+trenner)<1THEN 
+fstatus:=fnrversetzung;fmeld:=meldungversetzungskzunzulaessig;
+fehlerbehandlungbearb1FI ;IF pos(faecher,trenner+erfassungsfeld(bearb1)(
+fnrnachpr1)+trenner)<1THEN fstatus:=fnrnachpr1;fmeld:=
+meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(faecher,trenner
++erfassungsfeld(bearb1)(fnrnachpr2)+trenner)<1THEN fstatus:=fnrnachpr2;fmeld
+:=meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(faecher,
+trenner+erfassungsfeld(bearb1)(fnrnachpr3)+trenner)<1THEN fstatus:=fnrnachpr3
+;fmeld:=meldungfachangabeunzulaessig;fehlerbehandlungbearb1FI ;IF pos(bemerk,
+trenner+erfassungsfeld(bearb1)(fnrnachprbem)+trenner)<1THEN fstatus:=
+fnrnachprbem;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;plausitxt:=
+"";plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr1);
+plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr2);
+plausitxtCAT trenner;plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr3);
+plausitxtCAT trenner;IF pos(plausitxt,trenner+erfassungsfeld(bearb1)(
+fnrnachprabgelegt)+trenner)<1THEN plausitxt:="";IF erfassungsfeld(bearb1)(
+fnrnachpr1)<>""THEN plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr1);FI ;IF 
+erfassungsfeld(bearb1)(fnrnachpr2)<>""THEN plausitxtCAT ",";plausitxtCAT 
+erfassungsfeld(bearb1)(fnrnachpr2);FI ;IF erfassungsfeld(bearb1)(fnrnachpr3)
+<>""THEN plausitxtCAT ",";plausitxtCAT erfassungsfeld(bearb1)(fnrnachpr3);FI 
+;fstatus:=fnrnachprabgelegt;fmeld:=meldungnureinesderfaechererl;
+fehlerbehandlungbearb1FI ;IF pos(noten,trenner+erfassungsfeld(bearb1)(
+fnrnachprnote)+trenner)<1THEN fstatus:=fnrnachprnote;fmeld:=
+fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+
+erfassungsfeld(bearb1)(fnrzeugbem1)+trenner)<1THEN fstatus:=fnrzeugbem1;fmeld
+:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+
+erfassungsfeld(bearb1)(fnrzeugbem2)+trenner)<1THEN fstatus:=fnrzeugbem2;fmeld
+:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;IF pos(bemerk,trenner+
+erfassungsfeld(bearb1)(fnrzeugbem3)+trenner)<1THEN fstatus:=fnrzeugbem3;fmeld
+:=fmeldnichtimbestand;fehlerbehandlungbearb1FI ;plausitxt:=erfassungsfeld(
+bearb1)(fnrversaeumtmit);IF plausitxt<>""CAND plausitxt<>"0"THEN IF int(
+plausitxt)=0THEN fstatus:=fnrversaeumtmit;fmeld:=meldungunerlaubterwert;
+fehlerbehandlungbearb1FI FI ;plausitxt:=erfassungsfeld(bearb1)(
+fnrversaeumtohne);IF plausitxt<>""CAND plausitxt<>"0"THEN IF int(plausitxt)=0
+THEN fstatus:=fnrversaeumtohne;fmeld:=meldungunerlaubterwert;
+fehlerbehandlungbearb1FI FI ;plausitxt:=erfassungsfeld(bearb1)(fnrverspaetet)
+;IF plausitxt<>""CAND plausitxt<>"0"THEN IF int(plausitxt)=0THEN fstatus:=
+fnrverspaetet;fmeld:=meldungunerlaubterwert;fehlerbehandlungbearb1FI FI .
+aktuellessjhj:akthalbjahr=gewhalbjahrCAND aktschuljahr=gewschuljahr.
+pruefeplausibilitaetbearb2:verglfachleiste:="";verglartleiste:="";
+verglklausurleiste:="";verglkennungenleiste:="";plausileiste:=stdplausileiste
+;FOR lvFROM 0UPTO fnrfachende-fnrfachanfREP plausitxt:=erfassungsfeld(bearb2)
+(fnrfachanf+lv);IF plausitxt<>""THEN replace(plausileiste,lv+1,"1");
+verglfachleisteCAT text(plausitxt,2);IF pos(faecher,trenner+plausitxt+trenner
+)<1THEN fstatus:=fnrfachanf+lv;fmeld:=meldungfachangabeunzulaessig;
+fehlerbehandlungbearb2FI FI PER ;FOR lvFROM 0UPTO fnrkursartende-
+fnrkursartanfREP plausitxt:=erfassungsfeld(bearb2)(fnrkursartanf+lv);IF (
+plausileisteSUB (lv+1))="1"THEN verglartleisteCAT text(plausitxt,2)FI ;IF 
+plausitxt<>""THEN IF pos(artlv,trenner+plausitxt+trenner)<1THEN fstatus:=
+fnrkursartanf+lv;fmeld:=meldungungueltigekursart;fehlerbehandlungbearb2FI ;
+FI PER ;FOR lvFROM 0UPTO fnrkursende-fnrkursanfREP plausitxt:=erfassungsfeld(
+bearb2)(fnrkursanf+lv);IF (plausileisteSUB (lv+1))="1"THEN 
+verglkennungenleisteCAT text(plausitxt,4)FI PER ;FOR lvFROM 0UPTO 
+fnrklausurende-fnrklausuranfREP plausitxt:=erfassungsfeld(bearb2)(
+fnrklausuranf+lv);IF (plausileisteSUB (lv+1))="1"THEN verglklausurleisteCAT 
+text(plausitxt,1)FI PER ;FOR lvFROM 0UPTO fnrnoteende-fnrnoteanfREP plausitxt
+:=erfassungsfeld(bearb2)(fnrnoteanf+lv);IF plausitxt<>""THEN IF pos(noten,
+trenner+plausitxt+trenner)<1THEN fstatus:=fnrnoteanf+lv;fmeld:=
+fmeldnichtimbestand;fehlerbehandlungbearb2FI FI ;PER ;FOR lvFROM 0UPTO 
+fnrbemende-fnrbemanfREP plausitxt:=erfassungsfeld(bearb2)(fnrbemanf+lv);IF 
+plausitxt<>""THEN IF pos(bemerk,trenner+plausitxt+trenner)<1THEN fstatus:=
+fnrbemanf+lv;fmeld:=fmeldnichtimbestand;fehlerbehandlungbearb2FI FI ;PER ;
+FOR lvFROM 0UPTO fnrwarnungende-fnrwarnunganfREP plausitxt:=erfassungsfeld(
+bearb2)(fnrwarnunganf+lv);IF plausitxt<>""THEN IF pos(blbrief,trenner+
+plausitxt+trenner)<1THEN fstatus:=fnrwarnunganf+lv;fmeld:=fmeldnichtimbestand
+;fehlerbehandlungbearb2FI FI ;PER .END PROC pruefeplausibilitaet;PROC 
+listezuhalbjahresdatenzeigen:BOOL VAR listeexistiertnicht;falschesdatum:=
+FALSE ;bs:=eingang;IF maskeeingangnochnichtdaTHEN initmaske(maske(bs),
+maskennameeingang);init(bs,maxfeldbearb0);maskeeingangnochnichtda:=FALSE FI ;
+gewschuljahr:=standardmaskenfeld(fnrgewschuljahr);gewhalbjahr:=
+standardmaskenfeld(fnrgewhalbjahr);IF int(standardmaskenfeld(fnrgewjgst))=0
+THEN gewjgst:=standardmaskenfeld(fnrgewjgst);ELSE gewjgst:=jgstaufber(
+standardmaskenfeld(fnrgewjgst));FI ;schluesselbereitstellen;IF NOT 
+falschesdatumTHEN putwert(fnrsustatuss,aktbestand);standardmeldung(
+meldunglistenerstellung,"");initobli(saetzederliste);parsenooffields(5);
+objektlistestarten(ixsustatfamrufgeb,standardmaskenfeld(fnrname),
+fnrsufamnames,TRUE ,listeexistiertnicht);IF listeexistiertnichtTHEN 
+reinitparsing;standardmeldung(meldungkeineliste,"");return(1)ELSE 
+datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler,TRUE ,BOOL PROC 
+pruefunghjd);FI ELSE return(1)FI .END PROC listezuhalbjahresdatenzeigen;BOOL 
+PROC pruefunghjd:wert(fnrsustatuss)=aktbestandEND PROC pruefunghjd;PROC 
+halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten:BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;loeschedieerstellteobjektliste;
+objektlistebeenden(dateiname,TRUE );reinitparsing;
+holeerstenmehrtlgschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok)
+;IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenmehrtlgschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerden
+THEN bereiteeingangsmaskefuerausgewaehltenvor;standardnprocELSE 
+standardmeldung(meldungletzter,"");enter(2)FI .END PROC 
+halbjahresdatenausgewaehlterschuelerbearbeitenvorbereiten;PROC 
+fuellemaskenfeldereingang:INT VAR lv;holedbwerte(bs);erfassungsfeld(bs)(
+fnrgewschuljahr):=gewschuljahr;erfassungsfeld(bs)(fnrgewhalbjahr):=
+gewhalbjahr;erfassungsfeld(bs)(fnrgewjgst):=gewjgst;IF aktbestand=
+schueleraktuellTHEN erfassungsfeld(bs)(fnrabgangbestand):=""ELSE 
+erfassungsfeld(bs)(fnrabgangbestand):="x"FI ;FOR lvFROM fnrnameUPTO 
+fnrabgangbestandREP standardmaskenfeld(erfassungsfeld(bs)(lv),lv)PER .END 
+PROC fuellemaskenfeldereingang;PROC setzefeldschutz:INT VAR i;FOR iFROM 
+fnrnameUPTO fnrabgangbestandREP feldschutz(i)PER ;feldfrei(fnrgewschuljahr);
+feldfrei(fnrgewhalbjahr);feldfrei(fnrgewjgst);.END PROC setzefeldschutz;PROC 
+holeerstenmehrtlgschluesselausdatei(BOOL VAR ok):IF NOT exists(dateiname)
+THEN ok:=FALSE ;LEAVE holeerstenmehrtlgschluesselausdateiFI ;f:=
+sequentialfile(input,dateiname);holenaechstenmehrtlgschluesselausdatei(ok).
+END PROC holeerstenmehrtlgschluesselausdatei;PROC 
+holenaechstenmehrtlgschluesselausdatei(BOOL VAR ok):TEXT VAR thesaurustext:=
+"";INT VAR schluesselbeginn:=0;INT VAR schluesseltrennung:=0;INT VAR i:=1;IF 
+eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f,
+thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext,
+oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner,
+schluesselbeginn+1);FOR iFROM 1UPTO anzschluesselsuREP IF schluesseltrennung>
+0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1,
+schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung
+:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):=
+subtext(thesaurustext,schluesselbeginn+1);FI ;schluessel(3):=
+datumrekonversion(schluessel(3));PER ;.END PROC 
+holenaechstenmehrtlgschluesselausdatei;PROC 
+halbjahresdatendesschuelersnichtbearbeiten:
+vorbereitendernaechstenschluesselbehandlung(1)END PROC 
+halbjahresdatendesschuelersnichtbearbeiten;TEXT PROC hjderfassungswert(INT 
+CONST feldnr):IF (feldnr>maxfeldbearb2)OR (feldnr<1)THEN ""ELSE 
+erfassungsfeld(bs)(feldnr)FI .END PROC hjderfassungswert;PROC setzedbwerte(
+INT CONST mnr):SELECT mnrOF CASE eingang:setzedbwerteeingangCASE bearb1:
+setzedbwertebearb1CASE bearb2:setzedbwertebearb2END SELECT .
+setzedbwerteeingang:putwert(fnrsufamnames,erfassungsfeld[mnr][fnrname]);
+putwert(fnrsurufnames,erfassungsfeld[mnr][fnrrufname]);putwert(fnrsugebdatums
+,datumskonversion(erfassungsfeld[mnr][fnrgebdatum]));.setzedbwertebearb1:
+putwert(fnrhjdjgst,erfassungsfeld[mnr][fnrausgabegewjgst]);putwert(
+fnrhjdkennung,erfassungsfeld[mnr][fnrausgabegewzug]);putwert(fnrhjdvermblau,
+erfassungsfeld[mnr][fnrblbriefwarn]);putwert(fnrhjdbemblau,erfassungsfeld[mnr
+][fnrblbriefbem]);putwert(fnrhjdvermnachwarn,erfassungsfeld[mnr][
+fnrblbriefnwarn]);putwert(fnrhjdbemnachwarn,erfassungsfeld[mnr][
+fnrblbriefnbem]);putwert(fnrhjdversetzung,erfassungsfeld[mnr][fnrversetzung])
+;putwert(fnrhjdnachfach1,erfassungsfeld[mnr][fnrnachpr1]);putwert(
+fnrhjdnachfach2,erfassungsfeld[mnr][fnrnachpr2]);putwert(fnrhjdnachfach3,
+erfassungsfeld[mnr][fnrnachpr3]);putwert(fnrhjdbemnach,erfassungsfeld[mnr][
+fnrnachprbem]);putwert(fnrhjdnachfach,erfassungsfeld[mnr][fnrnachprabgelegt])
+;putwert(fnrhjdnacherg,erfassungsfeld[mnr][fnrnachprnote]);putwert(
+fnrhjdbemzeug1,erfassungsfeld[mnr][fnrzeugbem1]);putwert(fnrhjdbemzeug2,
+erfassungsfeld[mnr][fnrzeugbem2]);putwert(fnrhjdbemzeug3,erfassungsfeld[mnr][
+fnrzeugbem3]);putwert(fnrhjdversstdm,erfassungsfeld[mnr][fnrversaeumtmit]);
+putwert(fnrhjdversstdo,erfassungsfeld[mnr][fnrversaeumtohne]);putwert(
+fnrhjdverspaet,erfassungsfeld[mnr][fnrverspaetet]);.setzedbwertebearb2:
+setzedbwertfach;setzedbwertart;setzedbwertklausur;setzedbwertkurs;
+setzedbwertnote;setzedbwertbem;setzedbwertwarnung.setzedbwertfach:
+spalteninhalte:="";FOR indFROM fnrfachanfUPTO fnrfachendeREP spalteninhalte
+CAT text(erfassungsfeld[mnr][ind],2)PER ;putwert(fnrhjdfach,spalteninhalte).
+setzedbwertart:spalteninhalte:="";FOR indFROM fnrkursartanfUPTO 
+fnrkursartendeREP spalteninhalteCAT text(erfassungsfeld[mnr][ind],2)PER ;
+putwert(fnrhjdkursart,spalteninhalte).setzedbwertklausur:spalteninhalte:="";
+FOR indFROM fnrklausuranfUPTO fnrklausurendeREP spalteninhalteCAT text(
+erfassungsfeld[mnr][ind],1)PER ;putwert(fnrhjdklausurteiln,spalteninhalte).
+setzedbwertkurs:spalteninhalte:="";FOR indFROM fnrkursanfUPTO fnrkursendeREP 
+spalteninhalteCAT text(erfassungsfeld[mnr][ind],4)PER ;putwert(
+fnrhjdlerngrpkenn,spalteninhalte).setzedbwertnote:spalteninhalte:="";FOR ind
+FROM fnrnoteanfUPTO fnrnoteendeREP spalteninhalteCAT text(erfassungsfeld[mnr]
+[ind],2)PER ;putwert(fnrhjdnotepunkte,spalteninhalte).setzedbwertbem:
+spalteninhalte:="";FOR indFROM fnrbemanfUPTO fnrbemendeREP spalteninhalteCAT 
+text(erfassungsfeld[mnr][ind],3)PER ;putwert(fnrhjdbemerk,spalteninhalte).
+setzedbwertwarnung:spalteninhalte:="";FOR indFROM fnrwarnunganfUPTO 
+fnrwarnungendeREP spalteninhalteCAT text(erfassungsfeld[mnr][ind],1)PER ;
+putwert(fnrhjdvermwarnung,spalteninhalte).END PROC setzedbwerte;PROC 
+holedbwerte(INT CONST mnr):SELECT mnrOF CASE eingang:holedbwerteeingangCASE 
+bearb1:holedbwertebearb1CASE bearb2:holedbwertebearb2END SELECT .
+holedbwerteeingang:erfassungsfeld[mnr][fnrname]:=wert(fnrsufamnames);
+erfassungsfeld[mnr][fnrrufname]:=wert(fnrsurufnames);erfassungsfeld[mnr][
+fnrgebdatum]:=datumrekonversion(wert(fnrsugebdatums));.holedbwertebearb1:
+erfassungsfeld[mnr][fnrausgabegewjgst]:=jgstaufber(wert(fnrhjdjgst));
+erfassungsfeld[mnr][fnrausgabegewzug]:=wert(fnrhjdkennung);erfassungsfeld[mnr
+][fnrblbriefwarn]:=wert(fnrhjdvermblau);erfassungsfeld[mnr][fnrblbriefbem]:=
+wert(fnrhjdbemblau);erfassungsfeld[mnr][fnrblbriefnwarn]:=wert(
+fnrhjdvermnachwarn);erfassungsfeld[mnr][fnrblbriefnbem]:=wert(
+fnrhjdbemnachwarn);erfassungsfeld[mnr][fnrversetzung]:=wert(fnrhjdversetzung)
+;erfassungsfeld[mnr][fnrnachpr1]:=wert(fnrhjdnachfach1);erfassungsfeld[mnr][
+fnrnachpr2]:=wert(fnrhjdnachfach2);erfassungsfeld[mnr][fnrnachpr3]:=wert(
+fnrhjdnachfach3);erfassungsfeld[mnr][fnrnachprbem]:=wert(fnrhjdbemnach);
+erfassungsfeld[mnr][fnrnachprabgelegt]:=wert(fnrhjdnachfach);erfassungsfeld[
+mnr][fnrnachprnote]:=wert(fnrhjdnacherg);erfassungsfeld[mnr][fnrzeugbem1]:=
+wert(fnrhjdbemzeug1);erfassungsfeld[mnr][fnrzeugbem2]:=wert(fnrhjdbemzeug2);
+erfassungsfeld[mnr][fnrzeugbem3]:=wert(fnrhjdbemzeug3);erfassungsfeld[mnr][
+fnrversaeumtmit]:=wert(fnrhjdversstdm);erfassungsfeld[mnr][fnrversaeumtohne]
+:=wert(fnrhjdversstdo);erfassungsfeld[mnr][fnrverspaetet]:=wert(
+fnrhjdverspaet).holedbwertebearb2:.END PROC holedbwerte;BOOL PROC 
+korrekteschuljahreseingabe(TEXT CONST eingabe):eingabe=niltextOR eingabe=
+"9900"OR int(subtext(eingabe,1,2))=int(subtext(eingabe,3,4))-1END PROC 
+korrekteschuljahreseingabe;PROC eventuellneueshjdtideintragen:IF 
+aktuellesschulhalbjahrinbearbeitungTHEN neueshjdtideintragenFI .
+neueshjdtideintragen:readtid(dnrschueler,schuelertid);putwert(fnrsutidakthjd,
+hjdtid);replace(dnrschueler,schuelertid).END PROC 
+eventuellneueshjdtideintragen;#dr11.05.88PROC eventuellinstatwuerfeleintragen
+:IF aktuellesschulhalbjahrinbearbeitungCAND versetzungseintrag<>wert(
+fnrhjdversetzung)THEN kuerzelsummeeinsrunter(statnrversetzung,jgst,zug,
+aktbestand,versetzungseintrag);kuerzelsummeeinsrauf(statnrversetzung,jgst,zug
+,aktbestand,wert(fnrhjdversetzung));FI END PROC 
+eventuellinstatwuerfeleintragen;#BOOL PROC 
+aktuellesschulhalbjahrinbearbeitung:vglgewhalbjahr=vglakthalbjahrCAND 
+gewschuljahr=schulkenndatum(schuljahr)END PROC 
+aktuellesschulhalbjahrinbearbeitung;TEXT PROC ohnestrich(TEXT CONST txt):
+TEXT VAR t:=txt;changeall(t,"_",niltext);tEND PROC ohnestrich;PROC init(INT 
+CONST bsnr,maxfeld):FOR lvFROM 1UPTO maxfeldREP erfassungsfeld(bsnr)(lv):=""
+PER END PROC init;END PACKET halbjahresdatenbearbeiten;
+
diff --git a/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog b/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog
new file mode 100644
index 0000000..d7dc1ea
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.hoeherstufen anw do.prog
@@ -0,0 +1,43 @@
+PACKET hoeherstufenanwdoprogDEFINES halbjahreswechselbearbeitung,
+hochsetzeneingangsbehandlung,hochsetzenbearbeitung,hochsetzenprotokolldrucken
+:#LET schuljahreswechsel="isp.hoeherstufen local.sj",halbjahreswechsel=
+"isp.hoeherstufen local.hj";#LET niltext="",tofather=1,tograndfather=2,
+maxjahr=100,minjahr="00";LET zumschuljahresende=1,zumhalbjahresende=0;LET 
+schluesselschuljahr="Schuljahr",schluesselhalbjahr="Schulhalbjahr",
+schuljahresfeld=2,infofeld=3;LET meldende=110,melddruck=58,meldwarten=156;
+LET protname="Fehlerprotokoll";LET rcodeprot=1001;DATASPACE VAR ds;INT VAR 
+kanal:=channel,rcode;TAG VAR aktuellemaske;TEXT VAR aktschuljahr,akthalbjahr,
+kommendesschuljahr;LET logbucheintragsjwechsel="Anw. 1.5.1 Hochsetzen ",
+logbucheintraghjwechsel="Anw. 1.5.2 Halbjahreswechsel ";TEXT VAR 
+logbuchtextanfang;PROC hochsetzeneingangsbehandlung:reinitparsing;
+eingangsbildschirmzeigen;schuljahrzeigen;aufaktionwarten.
+eingangsbildschirmzeigen:initmaske(aktuellemaske,maske(vergleichsknoten));
+standardstartproc(maske(vergleichsknoten)).schuljahrzeigen:schuljahrIN 
+schuljahresfeld.schuljahr:aktschuljahr:=schulkenndatum(schluesselschuljahr);
+akthalbjahr:=schulkenndatum(schluesselhalbjahr);kommendesschuljahr:=subtext(
+aktschuljahr,3,4);kommendesschuljahrCAT (jahrestext(int(kommendesschuljahr)+1
+));aktschuljahr.aufaktionwarten:infeld(infofeld);standardnproc.END PROC 
+hochsetzeneingangsbehandlung;PROC halbjahreswechselbearbeitung:
+logbuchtextanfang:=logbucheintraghjwechsel;logeintrag(logbucheintraghjwechsel
++"gestartet");abschnittsendebearbeitung(zumhalbjahresende)END PROC 
+halbjahreswechselbearbeitung;PROC hochsetzenbearbeitung:logbuchtextanfang:=
+logbucheintragsjwechsel;logeintrag(logbucheintragsjwechsel+"gestartet");
+abschnittsendebearbeitung(zumschuljahresende)END PROC hochsetzenbearbeitung;
+PROC abschnittsendebearbeitung(INT CONST zeitpunkt):meldewarten;
+fehlerbehandlungvorbereiten;verarbeitung;reinitparsing;fehlerauswertung.
+meldewarten:standardmeldung(meldwarten,niltext).fehlerbehandlungvorbereiten:
+forget(protname,quiet);disablestop.verarbeitung:kanal:=channel;#17.10.88dr#
+putsndparam(1,text(kanal));break(quiet);IF zeitpunkt=zumschuljahresendeTHEN 
+doonserver("schuljahreswechsel",rcode)ELSE doonserver("halbjahreswechsel",
+rcode)FI ;continue(kanal).fehlerauswertung:loeschemeldung(aktuellemaske);IF 
+rcode=rcodeprotTHEN ds:=getrcvds;copy(ds,protname);forget(ds);logeintrag(
+logbuchtextanfang+"beendet mit Fehlern");zeigefehlerprotokollELSE logeintrag(
+logbuchtextanfang+"beendet ohne Fehler");fertigmeldungFI .
+zeigefehlerprotokoll:store(FALSE );clearerror;enablestop;editiere(protname).
+fertigmeldung:IF NOT iserrorTHEN standardmeldung(meldende,niltext);FI ;return
+(tofather).END PROC abschnittsendebearbeitung;PROC hochsetzenprotokolldrucken
+:print(protname);forget(protname,quiet);reorganizescreen;standardmeldung(
+melddruck,niltext);return(tograndfather)END PROC hochsetzenprotokolldrucken;
+TEXT PROC jahrestext(INT CONST jahr):IF jahr=maxjahrTHEN minjahrELSE text(
+jahr)FI END PROC jahrestext;END PACKET hoeherstufenanwdoprog
+
diff --git a/app/schulis/2.2.1/src/1.listen.abgem b/app/schulis/2.2.1/src/1.listen.abgem
new file mode 100644
index 0000000..da5fb1b
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.abgem
@@ -0,0 +1,115 @@
+PACKET abgemlistenDEFINES abgemlispezielleteile:LET niltext="",blank=" ",
+mittestrich="-",null=0,ueberschriftenzeilen=1,spalte1breite=7,spalte3breite=8
+,spalte4breite=8,spalte5breite=7,anzspaltentrenner=4,ausgkopflaenge=3,
+ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW 
+ausgkopflaengeTEXT ,abgemlieingangsmaske="mu liste einfach eingang",
+abgemlianfpos=2,mnrbearbeitetwirdjgst=106,#ixsustatabgdat=260,dnrschueler=2,
+fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6,fnrsusgrpjgst
+=7,fnrsusgrpzugtut=8,fnrsunamenszusatzs=21,fnrsuabgdats=16,fnrsuabggrund=17,
+fnrsuabschluss=18,#anfangsj="Anfang Schulhalbjahr",endesj=
+"Ende Schulhalbjahr";INT CONST spalte2bildbreite:=bildbreite-
+anzspaltentrenner-spalte1breite-spalte3breite-spalte4breite-spalte5breite;
+INT VAR spalte2druckbreite,druckzeilenzahl,aktuelleindexnr,bildanf,
+eingabestatus,breite;TEXT VAR abgemliueberschrift,bearbeitetwirdjgst,
+schuljahr,jahr1,jahr2,schuelername,schuelerrufname,schuelernamenszus,
+schuelerjgst,schuelerzug,schuelergebdat,schuelerabdat,schuelerabgrund,
+schuelerabqual,jgst,neuejgst,startwert,klasse,neueklasse,anfangsdatum:="",
+endedatum:="";TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*
+mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR 
+ersteraufbildschirm,klassegeaendert:=FALSE ;BOOL PROC multistop:BOOL VAR b:=(
+date(wert(fnrsuabgdats))>=date(anfangsdatum))CAND (date(wert(fnrsuabgdats))<=
+date(endedatum))CAND (wert(fnrsustatuss)="ls");bEND PROC multistop;BOOL PROC 
+multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);bENDPROC 
+multistopdruck;PROC abgemlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+abgemlidialogvorbereitenCASE 2:abgemlieingabenrichtigCASE 3:
+abgemlilistenvorbereitenCASE 4:abgemlidruckvorbereitenCASE 5:
+abgemliseitedruckenCASE 6:abgemlibildschirmvorbereitenCASE 7:
+abgemliseitezeigenENDSELECT .END PROC abgemlispezielleteile;PROC 
+abgemlidialogvorbereiten:abgemliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(abgemlieingangsmaske,abgemlianfpos)END PROC 
+abgemlidialogvorbereiten;PROC abgemlieingabenrichtig:LET fnrausgdrucker=2,
+fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);
+setzeeingabetest(TRUE )FI .END PROC abgemlieingabenrichtig;PROC 
+abgemlilistenvorbereiten:BOOL VAR b:=FALSE ;LET schluessel="Schuljahr";
+aktuellesschuljahrermitteln;aktuelleindexnr:=ixsustatabgdat;startwert:="ls";
+inittupel(dnrschueler);initobli(8);parsenooffields(21);setzeidentiwert("");
+putwert(fnrsustatuss,startwert);putwert(fnrsuabgdats,anfangsdatum);#
+objektlistestarten(aktuelleindexnr,"",3,TRUE ,b);#objektlistestarten(
+aktuelleindexnr,"",fnrsuabgdats,TRUE ,b);setzebestandende(NOT multistopOR b).
+aktuellesschuljahrermitteln:schuljahr:=schulkenndatum(schluessel);jahr1:=
+subtext(schuljahr,1,2);jahr2:=subtext(schuljahr,3,4);anfangsdatum:=
+schulkenndatum(anfangsj);endedatum:=schulkenndatum(endesj).END PROC 
+abgemlilistenvorbereiten;PROC abgemlibildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(abgemliueberschrift);breite:=bildbreite;
+initspalten;setzespaltenbreiten(spalte2bildbreite);initausgabekopf(bildstrich
+);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf
+(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;
+setzebildanfangsposition(bildanf).END PROC abgemlibildschirmvorbereiten;PROC 
+abgemliseitezeigen:ersteraufbildschirm:=TRUE ;setzescanendewert(endedatum);
+setzescanstartwert(anfangsdatum);blaettern(PROC (INT CONST )schuelerzeigen,
+aktion,TRUE ,TRUE ,BOOL PROC multistop);setzescanendewert("�");
+setzescanstartwert("�")END PROC abgemliseitezeigen;PROC schuelerzeigen(INT 
+CONST x):schuelerholen;IF ersteraufbildschirmTHEN klassegeaendert:=TRUE ;
+ersteraufbildschirm:=FALSE FI ;schueleraufbereiten;schueleraufbildschirm.END 
+PROC schuelerzeigen;PROC schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsEND 
+REPEAT .END PROC schueleraufbildschirm;PROC abgemlidruckvorbereiten:LET 
+uebteil1="Liste der im Schuljahr ",uebteil2=" abgemeldeten Schüler";TEXT VAR 
+ueberschrift;jgst:=niltext;klasse:=niltext;druckvorbereiten;
+variablenfuerdrucksetzen;ueberschriftvorbereitendruck;initdruckkopf(zentriert
+(ueberschrift,druckbreite));breite:=druckbreite;initspalten;
+setzespaltenbreiten(spalte2druckbreite);initausgabekopf(druckstrich);
+holemeldung;inittupel(dnrschueler);putwert(fnrsustatuss,startwert);putwert(
+fnrsuabgdats,anfangsdatum);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,
+INT VAR )scanforward,BOOL PROC multistopdruck).holemeldung:meldungstext(
+mnrbearbeitetwirdjgst,bearbeitetwirdjgst).variablenfuerdrucksetzen:
+druckstrich:=druckbreite*mittestrich;spalte2druckbreite:=druckbreite-
+anzspaltentrenner-spalte1breite-spalte3breite-spalte4breite-spalte5breite;
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.
+ueberschriftvorbereitendruck:ueberschrift:=uebteil1+aufbereitetesschuljahr+
+uebteil2.aufbereitetesschuljahr:"19"+jahr1+"/"+jahr2.END PROC 
+abgemlidruckvorbereiten;PROC abgemliseitedrucken:abgemliueberschriftdrucken;
+seitedrucken(PROC (INT VAR )schuelerdrucken,druckzeilenzahl,ausgfeldlaenge,
+BOOL PROC multistopdruck);seitenwechsel.END PROC abgemliseitedrucken;PROC 
+abgemliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO 
+ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC 
+abgemliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET 
+markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE 
+FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI .
+jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung:
+standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END 
+PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC 
+schuelerindruckdatei;PROC setzespaltenbreiten(INT CONST spalte2breite):
+setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite);
+setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite);
+setzespaltenbreite(spalte5breite);END PROC setzespaltenbreiten;PROC 
+initausgabekopf(TEXT CONST strich):LET jgst="Jgst.",klasse="   Kl.",name=
+"Familienname",rufname="  Rufname",geb="Geburts-",abg="Abgangs-",datum=
+"datum",grund="Grund",qual="  Qual.";spaltenweise(jgst);spaltenweise(name);
+spaltenweise(geb);spaltenweise(abg);spaltenweise(grund);ausgkopf(1):=zeile;
+spaltenweise(klasse);spaltenweise(rufname);spaltenweise(datum);spaltenweise(
+datum);spaltenweise(qual);ausgkopf(2):=zeile;ausgkopf(3):=strich;END PROC 
+initausgabekopf;PROC schuelerholen:schuelername:=wert(fnrsufamnames);
+schuelerrufname:=wert(fnrsurufnames);schuelernamenszus:=wert(
+fnrsunamenszusatzs);schuelerjgst:=wert(fnrsusgrpjgst);schuelerzug:=wert(
+fnrsusgrpzugtut);schuelergebdat:=wert(fnrsugebdatums);schuelerabdat:=wert(
+fnrsuabgdats);schuelerabgrund:=wert(fnrsuabggrund);schuelerabqual:=wert(
+fnrsuabschluss);neueklasse:=schuelerjgst+schuelerzug;klassegeaendert:=klasse
+<>neueklasse;klasse:=neueklasse.END PROC schuelerholen;PROC 
+schueleraufbereiten:LET minus="-";schreibenameabdaten;schreiberufname.
+schreibenameabdaten:spaltenweise(aufbschuelerklasse);spaltenweise(
+aufbschuelername);spaltenweise(schuelergebdat);spaltenweise(schuelerabdat);
+spaltenweise(blank+aufbschuelerabgrund+blank+aufbschuelerabqual);ausgfeld(1)
+:=zeile.schreiberufname:ausgfeld(2):=text(aufbrufname,breite).
+aufbschuelerklasse:IF klassegeaendertTHEN schuelerjgst+blank+schuelerzugELSE 
+spalte1breite*blankFI .aufbschuelername:IF schuelernamenszus=niltextTHEN 
+schuelernameELSE schuelernamenszus+blank+schuelernameFI .aufbschuelerabqual:
+IF schuelerabqual=niltextTHEN minusELSE schuelerabqualFI .aufbschuelerabgrund
+:IF schuelerabgrund=niltextTHEN minusELSE schuelerabgrundFI .aufbrufname:(
+spalte1breite+3)*blank+schuelerrufname.END PROC schueleraufbereiten;END 
+PACKET abgemlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.adressen b/app/schulis/2.2.1/src/1.listen.adressen
new file mode 100644
index 0000000..0a45d7b
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.adressen
@@ -0,0 +1,186 @@
+PACKET adressenlistenDEFINES adrlispezielleteile:LET niltext="",blank=" ",
+mittestrich="-",null=0,komma=",",altervolljaehrig=18,uebteil21="Jgst. ",
+uebteil22="Klasse ",uebteil23="Tutorenkurs ",uebteil24="alphabetisch",
+ueberschriftenzeilen=2,#bestand1="c12 schueler",bestand2=
+"c11 akt schuelergruppen",praefix1="c12 jgst",praefix2="c12 sg",#
+ausgfeldlaenge=9,AUSGFELD =ROW ausgfeldlaengeTEXT ,adrlieingangsmaske=
+"ms liste adressen eingang",adrlianfpos=2,#dnrschueler=2,fnrsufamnames=3,
+fnrsurufnames=4,fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsugebnames=22,
+fnrsugebdatums=5,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsuwohntbei=23,
+fnrsustrnrs=24,fnrsuplzorts=25,fnrsutelnrs=26,fnrsufamnamee=28,fnrsuvornamee=
+29,fnrsunamenszusatzs=30,fnrsustrnre=31,fnrsuplzorte=32,fnrsutelnre=33,
+ixsustatjgstzug=255,ixsustatjgst=261,ixstatfamrufgeb=254,stattnachfolgendemI 
+ndexixsustat=252,#mnrbearbeitetwerden=102,mnrbearbeitetwird=100,
+mnrauswahlnichtsinnvoll=56,mnrlistewirdgedruckt=58;INT VAR aktuelleindexnr,
+druckzeilenzahl,bildanf,vergldatum,ausgfeldzeile,eingabestatus,zaehler;TEXT 
+VAR adrliueberschrift,ueberschrift1,ueberschrift2,anfbuchstabe,
+neueranfbuchstabe,startjahr,startzug,bearbeitetwerden,bearbeitetwird,
+schuelername,schuelervorname,schuelernamenszusatz,schuelergebname,gebdat,
+jahrgangsstufe,zug,adressename,adressestrasse,adresseort,adressetelnr,
+erzbername,erzbervorname,erzbernamenszusatz,erzberstrasse,erzberort,
+erzbertelnr;AUSGFELD VAR ausgfeld;ausgfeld(ausgfeldlaenge):=niltext;TEXT VAR 
+druckstrich;BOOL VAR einjahrgang,alle,sortalpha,neueklasse;BOOL PROC 
+multistop:BOOL VAR b:=FALSE ;IF wert(fnrsustatuss)="ls"THEN IF startjahr<>
+niltextTHEN IF startzug=niltextTHEN b:=(wert(fnrsusgrpjgst)=startjahr)ELSE b
+:=(wert(fnrsusgrpzugtut)=startzugAND wert(fnrsusgrpjgst)=startjahr)FI ELSE b
+:=dbstatus=okFI ;FI ;bEND PROC multistop;BOOL PROC multistopsim:BOOL VAR b:=
+multistop;setzebestandende(NOT b);bENDPROC multistopsim;PROC 
+adrlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:adrlidialogvorbereiten
+CASE 2:adrlieingabenrichtigCASE 3:adrlilistenvorbereitenCASE 4:
+adrlidruckvorbereitenCASE 5:adrliseitedruckenCASE 6:
+adrlibildschirmvorbereitenCASE 7:adrliseitezeigenENDSELECT .END PROC 
+adrlispezielleteile;PROC adrlidialogvorbereiten:adrliueberschrift:=text(
+vergleichsknoten);setzeanfangswerte(adrlieingangsmaske,adrlianfpos).END PROC 
+adrlidialogvorbereiten;PROC adrlieingabenrichtig:LET fnrjgst=2,fnrzug=3,
+fnralphasort=4,fnrklassensort=5,fnrausgdrucker=6,fnrausgbild=7;alle:=FALSE ;
+einjahrgang:=FALSE ;sortalpha:=FALSE ;wohinausgabepruefen;IF 
+falschausgefuelltTHEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE 
+jahrgangsstufe:=standardmaskenfeld(fnrjgst);zug:=standardmaskenfeld(fnrzug);
+wasausgabepruefenFI .wohinausgabepruefen:standardpruefe(5,fnrausgdrucker,
+fnrausgbild,null,niltext,eingabestatus).wasausgabepruefen:IF jahrgangsstufe=
+niltextTHEN IF zug=niltextTHEN wieausgabepruefen;IF falschausgefuelltTHEN 
+infeld(eingabestatus);setzeeingabetest(FALSE )ELSE alle:=TRUE ;
+wertesetzenfuerweiterebearbeitungFI ELSE meldefehler;infeld(fnrzug);
+setzeeingabetest(FALSE )FI ELSE standardpruefe(3,fnrjgst,5,13,niltext,
+eingabestatus);IF falschausgefuelltTHEN infeld(eingabestatus);
+setzeeingabetest(FALSE )ELSE jahrgangsstufe:=zweistellig(jahrgangsstufe);
+einjahrgang:=(zug=niltext);IF einjahrgangTHEN wieausgabepruefen;IF 
+falschausgefuelltTHEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE 
+wertesetzenfuerweiterebearbeitungFI ELSE wertesetzenfuerweiterebearbeitung;
+sortalpha:=TRUE FI ;FI ;FI .wieausgabepruefen:standardpruefe(5,fnralphasort,
+fnrklassensort,null,niltext,eingabestatus).wertesetzenfuerweiterebearbeitung:
+sortalpha:=standardmaskenfeld(fnrklassensort)=niltext;setzeausgabedrucker(
+standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest(TRUE ).
+falschausgefuellt:eingabestatus<>0.meldefehler:standardmeldung(
+mnrauswahlnichtsinnvoll,niltext).END PROC adrlieingabenrichtig;PROC 
+adrlilistenvorbereiten:BOOL VAR b:=FALSE ;INT VAR staticfield:=dnrschueler+1;
+vergldatum:=vergleichsdatum(altervolljaehrig);startjahr:=jahrgangsstufe;
+startzug:=zug;IF sortalphaTHEN IF startjahr<>niltextTHEN IF startzug<>niltext
+THEN aktuelleindexnr:=ixsustatjgstzugELSE aktuelleindexnr:=ixsustatjgstFI ;
+ELSE staticfield:=fnrsustatuss;#?????#aktuelleindexnr:=ixsustatfamrufgeb#
+aktuelleindexnr:=ixsustat#FI ;ELSE IF startjahr=""THEN staticfield:=
+fnrsusgrpjgstELSE staticfield:=fnrsusgrpzugtutFI ;aktuelleindexnr:=
+ixsustatjgstzugFI ;inittupel(dnrschueler);initobli(2);parsenooffields(34);
+setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,
+startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"",
+fnrsustatuss,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield,
+TRUE ,b);setzebestandende(NOT multistopCOR b)END PROC adrlilistenvorbereiten;
+PROC adrlibildschirmvorbereiten:LET fnrausganf=2;ueberschriftvorbereitenbild;
+standardkopfmaskeaktualisieren(ueberschrift1);bildanf:=fnrausganf;#
+setzenderhilfsgroessenfuersblaettern(min(maxblocklaenge,bildblocklaenge),
+bildsatzzahl);#setzebildanfangsposition(bildanf).END PROC 
+adrlibildschirmvorbereiten;PROC ueberschriftvorbereitenbild:LET aufein="",
+aufaus=" ";ueberschrift1:=adrliueberschrift;IF NOT alleTHEN ueberschrift1:=
+ueberschrift1+komma+blank;IF einjahrgangTHEN ueberschrift1:=ueberschrift1+
+uebteil21+aufein+jahrgangsstufe+aufausELSE IF int(jahrgangsstufe)<11THEN 
+ueberschrift1:=ueberschrift1+uebteil22ELSE ueberschrift1:=ueberschrift1+
+uebteil23FI ;ueberschrift1:=ueberschrift1+aufein+jahrgangsstufe+blank+zug+
+aufausFI FI ;END PROC ueberschriftvorbereitenbild;PROC adrliseitezeigen:
+blaettern(PROC (INT CONST )adressdatenzeigen,aktion,TRUE ,aktuelleindexnr<>
+dnrschueler,BOOL PROC multistop)END PROC adrliseitezeigen;PROC 
+adressdatenzeigen(INT CONST x):TEXT CONST leerzeile:=text(blank,bildbreite);
+INT VAR i;adressdatenholen;adressdatenaufbereiten(bildbreite);
+ggfleerzeilenfuellen;adressdatenaufbildschirm.ggfleerzeilenfuellen:
+ausgfeldzeileINCR 1;FOR iFROM ausgfeldzeileUPTO ausgfeldlaenge-1REP ausgfeld(
+i):=leerzeilePER .END PROC adressdatenzeigen;PROC adressdatenaufbildschirm:
+INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeinsEND REPEAT .END PROC adressdatenaufbildschirm;PROC 
+adrlidruckvorbereiten:IF (alleOR einjahrgang)AND NOT sortalphaTHEN zaehler:=
+null;neueklasse:=TRUE ELSE anfbuchstabe:=niltextFI ;druckvorbereiten;
+variablenfuerdrucksetzen;holemeldungen;inittupel(dnrschueler);putwert(
+fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,startzug);putwert(
+fnrsustatuss,"ls");lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR 
+)scanforward,BOOL PROC multistopsim);ueberschriftvorbereitendruck;
+initdruckkopf(zentriert(ueberschrift1,druckbreite),zentriert(ueberschrift2,
+druckbreite)).variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen);druckstrich:=druckbreite*mittestrich.holemeldungen:
+meldungstext(mnrbearbeitetwird,bearbeitetwird);meldungstext(
+mnrbearbeitetwerden,bearbeitetwerden).END PROC adrlidruckvorbereiten;PROC 
+ueberschriftvorbereitendruck:jahrgangsstufe:=wert(fnrsusgrpjgst);zug:=wert(
+fnrsusgrpzugtut);ueberschrift1:=compress(adrliueberschrift);#dr28.03.88#IF 
+alleTHEN IF sortalphaTHEN ueberschrift2:=uebteil24ELSE klassenueberschriftFI 
+ELSE IF einjahrgangTHEN IF sortalphaTHEN ueberschrift2:=uebteil21+
+jahrgangsstufe+komma+blank+uebteil24ELSE klassenueberschriftFI ELSE 
+klassenueberschriftFI FI .klassenueberschrift:IF int(jahrgangsstufe)<11THEN 
+ueberschrift2:=uebteil22ELSE ueberschrift2:=uebteil23FI ;ueberschrift2:=
+ueberschrift2+jahrgangsstufe+blank+zug.END PROC ueberschriftvorbereitendruck;
+PROC adrliseitedrucken:adrliueberschriftdrucken;IF (alleOR einjahrgang)AND 
+NOT sortalphaTHEN seitedrucken(PROC (INT VAR )adressdatendrucken,
+druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeiklassenwechsel,
+BOOL PROC multistopsim);IF neueklasseTHEN simuliertesendezuruecknehmen;
+neuelistevorbereitenELSE seitenwechselFI ELSE seitedrucken(PROC (INT VAR )
+adressdatendrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);
+seitenwechselFI .simuliertesendezuruecknehmen:setzebestandende(FALSE ).
+neuelistevorbereiten:meldelistewirdgedruckt;drucknachbereiten;
+druckvorbereiten;zaehler:=null;ueberschriftvorbereitendruck;initdruckkopf(
+zentriert(ueberschrift1,druckbreite),zentriert(ueberschrift2,druckbreite)).
+meldelistewirdgedruckt:standardmeldung(mnrlistewirdgedruckt,"").END PROC 
+adrliseitedrucken;PROC adrliueberschriftdrucken:druckkopfschreiben.END PROC 
+adrliueberschriftdrucken;PROC adressdatendrucken(INT VAR zeilenzaehler):LET 
+markiert="#";adressdatenholen;ggfmeldung;zaehlerINCR 1;adressdatenaufbereiten
+(druckbreite);zeilenzaehlerINCR ausgfeldzeile;adressdatenindruckdatei.
+ggfmeldung:IF (alleOR einjahrgang)AND NOT sortalphaTHEN ggfmeldungklasseELSE 
+ggfmeldunganfbuchstabeEND IF .ggfmeldungklasse:IF zaehler=nullTHEN 
+standardmeldung(bearbeitetwird,jahrgangsstufe+blank+zug+markiert)FI .
+ggfmeldunganfbuchstabe:IF anfangsbuchstabegeaendertTHEN meldunganfbuchstabe
+END IF .anfangsbuchstabegeaendert:neueranfbuchstabe:=schuelernameSUB 1;
+anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(
+bearbeitetwerden,neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.
+END PROC adressdatendrucken;PROC adressdatenindruckdatei:INT VAR i;FOR iFROM 
+1UPTO ausgfeldzeileREP druckzeileschreiben(ausgfeld(i))PER .END PROC 
+adressdatenindruckdatei;PROC bestandendesimulierenbeiklassenwechsel:IF 
+bestandendeTHEN neueklasse:=FALSE ELSE nochklassezubearbeiten;IF neueklasse
+THEN setzebestandende(TRUE )FI ;FI .nochklassezubearbeiten:neueklasse:=zug<>
+wert(fnrsusgrpzugtut);IF alleTHEN neueklasse:=neueklasseOR (int(
+jahrgangsstufe)<>int(wert(fnrsusgrpjgst)))FI .END PROC 
+bestandendesimulierenbeiklassenwechsel;PROC adressdatenholen:schuelername:=
+wert(fnrsufamnames);schuelervorname:=wert(fnrsurufnames);schuelernamenszusatz
+:=wert(fnrsunamenszusatzs);schuelergebname:=wert(fnrsugebnames);gebdat:=wert(
+fnrsugebdatums);jahrgangsstufe:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut
+);adressename:=wert(fnrsuwohntbei);adressestrasse:=wert(fnrsustrnrs);
+adresseort:=wert(fnrsuplzorts);adressetelnr:=wert(fnrsutelnrs);erzbername:=
+wert(fnrsufamnamee);erzbervorname:=wert(fnrsuvornamee);erzbernamenszusatz:=
+wert(fnrsunamenszusatze);erzberstrasse:=wert(fnrsustrnre);erzberort:=wert(
+fnrsuplzorte);erzbertelnr:=wert(fnrsutelnre)END PROC adressdatenholen;PROC 
+adressdatenaufbereiten(INT CONST breite):LET prebreite=19,klassetelnrbreite=
+21,deutsch="D",namevornametrenner=", ",gebnamepre=", geb. ",gebdatpre=
+"         Geb.Dat.: ",vollj="(Vollj.)",klassepre="Klasse: ",adressepre=
+"         Adresse : ",preleer="                   ",adressnamepre="bei ",
+telnrpre="Tel.: ",erzberpre="         Erz.Ber.: ";INT CONST breiteohnepre:=
+breite-prebreite,ortgebdatbreite:=breiteohnepre-klassetelnrbreite;
+schreibenamenszeile;schreibegebdatundggfklasse;schreibeschueleradresse;
+schreibeggferzberadresse.schreibenamenszeile:ausgfeld(1):=text(
+zusammengesetztername,breite).zusammengesetztername:subtext(schuelername+
+namevornametrenner+schuelervorname+blank+schuelernamenszusatz+gebname,1,
+breite).gebname:IF schuelergebname=niltextTHEN niltextELSE gebnamepre+
+schuelergebnameEND IF .schreibegebdatundggfklasse:ausgfeld(2):=gebdatpre+
+gebdatundggfklasse.gebdatundggfklasse:IF alleOR einjahrgangTHEN text(gebdat+
+ggfvollj,ortgebdatbreite)+text(klassepre+klasse,klassetelnrbreite)ELSE text(
+gebdat+ggfvollj,breiteohnepre)FI .klasse:jahrgangsstufe+blank+zug.ggfvollj:
+IF volljaehrig(datum(gebdat))THEN volljELSE niltextEND IF .
+schreibeschueleradresse:IF adressename=niltextTHEN ausgfeld(3):=text(
+adressepre+adressestrasse,breite);ausgfeldzeile:=4ELSE ausgfeld(3):=text(
+adressepre+adressnamepre+adressename,breite);ausgfeld(4):=text(preleer+
+adressestrasse,breite);ausgfeldzeile:=5FI ;ausgfeld(ausgfeldzeile):=preleer+
+ortundggftelefon.ortundggftelefon:IF adressetelnr=niltextTHEN text(
+adresseggflandundort,breiteohnepre)ELSE text(adresseggflandundort,
+ortgebdatbreite)+text(telnrpre+adressetelnr,klassetelnrbreite)FI .
+adresseggflandundort:adresseort.schreibeggferzberadresse:IF erzbername=
+niltextTHEN schreibeleerzeileELSE schreibeerzberadresseFI .
+schreibeerzberadresse:schreibeerzbername;schreibeggferzberstrort.
+schreibeerzbername:ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text(
+erzberpre+ggferzbernamenszusatz+erzbername+namevornametrenner+erzbervorname,
+breite).ggferzbernamenszusatz:IF erzbernamenszusatz<>niltextTHEN 
+erzbernamenszusatz+blankELSE niltextFI .schreibeggferzberstrort:IF (
+erzberstrasse=niltext)AND (erzberort=niltext)THEN schreibeleerzeileELSE 
+schreibeerzberstrasse;schreibeerzberortundggftelnrFI .schreibeerzberstrasse:
+ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text(preleer+erzberstrasse,
+breite).schreibeerzberortundggftelnr:ausgfeldzeileINCR 1;ausgfeld(
+ausgfeldzeile):=preleer+erzberortundggftelefon.erzberortundggftelefon:IF 
+erzbertelnr=niltextTHEN text(erzberggflandundort,breiteohnepre)ELSE text(
+erzberggflandundort,ortgebdatbreite)+text(telnrpre+erzbertelnr,
+klassetelnrbreite)FI .erzberggflandundort:erzberort.schreibeleerzeile:
+ausgfeldzeileINCR 1;ausgfeld(ausgfeldzeile):=text(blank,breite).END PROC 
+adressdatenaufbereiten;BOOL PROC volljaehrig(INT CONST geburtstag):geburtstag
+<=vergldatumEND PROC volljaehrig;END PACKET adressenlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.anherk b/app/schulis/2.2.1/src/1.listen.anherk
new file mode 100644
index 0000000..fb9a34e
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.anherk
@@ -0,0 +1,124 @@
+PACKET anherklistenDEFINES anherklispezielleteile:#LET dnrschueler=2,
+fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums=5,fnrsustatuss=6,
+fnrsuskennlschule=14,fnrsuklasselschule=15,fnrsunamenszusatzs=21,dnrschulen=
+120,fnrschkennung=121,fnrschname=122,fnrschstrnr=124,fnrschplzort=125,
+ixsustatschulkenn=253,#LET mnrbearbeitetwirdschule=103,mnrlistewirdgedruckt=
+58;TEXT VAR bearbeitetwirdschule:="",listewirdgedruckt:="",startwert:="";LET 
+niltext="",blank=" ",mittestrich="-",null=0,komma=",",ueberschriftenzeilen=1,
+spalte2breite=8,spalte3breite=27,anzspaltentrenner=2,spaltentrenner=":",
+ausgkopflaenge=3,ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF 
+=ROW ausgkopflaengeTEXT ,anherklieingangsmaske="ms liste anherk eingang",
+anherklianfpos=2;INT VAR druckzeilenzahl,druckzeilenzahlseite1,
+druckzeilenzahlfolgeseiten,spalte1breite,eingabestatus;TEXT VAR #
+anherkliueberschrift,#schuelername,schuelerrufname,schuelernamenszus,
+schuelergebdat,schulkuerzel,letzteklasse,vordruck,vordruckueberarbeitet;TEXT 
+VAR druckstrich;AUSGFELD VAR ausgfelddruck;AUSGKOPF VAR ausgkopfdruck;BOOL 
+VAR jgst5,neueherkschule;FILE VAR textanschr;PROC anherklispezielleteile(INT 
+CONST nr):SELECT nrOF CASE 1:anherklidialogvorbereitenCASE 2:
+anherklieingabenrichtigCASE 3:anherklilistenvorbereitenCASE 4:
+anherklidruckvorbereitenCASE 5:anherkliseitedruckenENDSELECT .END PROC 
+anherklispezielleteile;PROC anherklidialogvorbereiten:setzeanfangswerte(
+anherklieingangsmaske,anherklianfpos).END PROC anherklidialogvorbereiten;
+PROC anherklieingabenrichtig:LET fnrjgst5=2,fnrjgst11=3;standardpruefe(5,
+fnrjgst5,fnrjgst11,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld
+(eingabestatus);setzeeingabetest(FALSE )ELSE jgst5:=(standardmaskenfeld(
+fnrjgst11)=niltext);setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI .
+END PROC anherklieingabenrichtig;PROC anherklilistenvorbereiten:BOOL VAR b:=
+FALSE ;IF jgst5THEN startwert:="n05"ELSE startwert:="n11"FI ;meldungstext(
+mnrbearbeitetwirdschule,bearbeitetwirdschule);meldungstext(
+mnrlistewirdgedruckt,listewirdgedruckt);inittupel(dnrschueler);
+parsenooffields(21);setzeidentiwert("");putwert(fnrsustatuss,startwert);
+putwert(fnrsuskennlschule," ");objektlistestarten(ixsustatschulkenn,"",#
+fnrsustatuss#dnrschueler+1,TRUE ,b);setzebestandende(b)END PROC 
+anherklilistenvorbereiten;PROC anherklidruckvorbereiten:LET vordr1=
+"vordruck fuer anschreiben an herkunftsschulen fuer jgst 5",vordr2=
+"vordruck fuer anschreiben an herkunftsschulen fuer jgst 11",vordrueberarb=
+"vordruck ueberarbeitet",manager="anschreiben server";neueherkschule:=TRUE ;
+druckvorbereiten;festenanschreibentextholen;variablenfuerdrucksetzen;
+inittupel(dnrschueler);putwert(fnrsustatuss,startwert);putwert(
+fnrsuskennlschule," ");lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistopsim);initdruckkopf;initspalten;
+initausgabekopfdruck.festenanschreibentextholen:IF jgst5THEN vordruck:=vordr1
+ELSE vordruck:=vordr2FI ;vordruckueberarbeitet:=vordrueberarb;forget(vordruck
+,quiet);forget(vordruckueberarbeitet,quiet);fetch(vordruck,/manager);
+briefalternative(vordruck,vordruckueberarbeitet).variablenfuerdrucksetzen:
+druckstrich:=druckbreite*mittestrich;spalte1breite:=druckbreite-
+anzspaltentrenner-spalte2breite-spalte3breite;druckzeilenzahlseite1:=
+drucklaenge(ueberschriftenzeilen)-ausgkopflaenge;druckzeilenzahlfolgeseiten:=
+drucklaenge-ausgkopflaenge.END PROC anherklidruckvorbereiten;PROC 
+initausgabekopfdruck:LET name="Name",geb="Geburts-",dat="datum",letzte=
+"letzte:",klasse="Klasse:",bedingung="Bed. 2. Fremdsprache",erfuellt=
+"erfüllt für";hilfsfeldervorbelegen;spaltenweise(niltext);spaltenweise(geb);
+IF jgst5THEN spaltenweise(letzte)ELSE spaltenweise(letzte+bedingung)FI ;
+ausgkopfdruck(1):=zeile;spaltenweise(name);spaltenweise(dat);IF jgst5THEN 
+spaltenweise(klasse)ELSE spaltenweise(klasse+erfuellt)FI ;ausgkopfdruck(2):=
+zeile;ausgkopfdruck(3):=druckstrich.hilfsfeldervorbelegen:setzespaltentrenner
+(spaltentrenner);setzespaltenbreite(spalte1breite);setzespaltenbreite(
+spalte2breite);setzespaltenbreite(spalte3breite).END PROC 
+initausgabekopfdruck;BOOL PROC multistopsim:BOOL VAR b;IF jgst5THEN b:=wert(
+fnrsustatuss)="n05"ELSE b:=wert(fnrsustatuss)="n11"FI ;setzebestandende(NOT b
+);bENDPROC multistopsim;PROC anherkliseitedrucken:anherkliueberschriftdrucken
+;seitedrucken(PROC (INT VAR )schuelerdatendrucken,druckzeilenzahl,
+ausgfeldlaenge,PROC bestandendesimulierenbeischulwechsel,BOOL PROC 
+multistopsim);IF neueherkschuleTHEN simuliertesendezuruecknehmen;
+neuelistevorbereitenELSE seitenwechselFI .simuliertesendezuruecknehmen:
+setzebestandende(FALSE ).neuelistevorbereiten:meldelistewirdgedruckt;
+drucknachbereiten;druckvorbereiten;initdruckkopf.meldelistewirdgedruckt:
+standardmeldung(listewirdgedruckt,"").END PROC anherkliseitedrucken;PROC 
+anherkliueberschriftdrucken:LET anzleerzeilen=3,markiert="#";INT VAR i;IF 
+neueherkschuleTHEN zwischenmeldung;druckzeilenzahl:=druckzeilenzahlseite1;
+druckkopfschreiben;anschreibenschreibenELSE druckzeilenzahl:=
+druckzeilenzahlfolgeseitenFI ;FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+druckzeileschreiben(ausgkopfdruck(i))END REPEAT .zwischenmeldung:
+standardmeldung(bearbeitetwirdschule,wert(fnrsuskennlschule)+markiert).
+anschreibenschreiben:#ROW 3TEXT VAR herkschuldaten,merker;##dbwertemerken;#
+adresseherkschuleholen;adresseherkschuleschreiben;festentextschreiben;
+unterschriftschreiben;#dbwertezurueckholen.#.#dbwertemerken:FOR iFROM 1UPTO 3
+REP merker(i):=dbwert(i)PER .#adresseherkschuleholen:putwert(fnrschkennung,
+wert(fnrsuskennlschule));search(dnrschulen,TRUE );IF NOT gefundenTHEN 
+inittupel(dnrschulen)FI .gefunden:dbstatus=ok.adresseherkschuleschreiben:LET 
+an="An",zeilenzahladresse=7;ausgfelddruck(1):=text(an,druckbreite);
+druckzeileschreiben(ausgfelddruck(1));drucke(text(wert(fnrschname),
+druckbreite));drucke(text(wert(fnrschstrnr),druckbreite));drucke(text(wert(
+fnrschplzort),druckbreite));#FOR iFROM 1UPTO 3REP ausgfelddruck(1):=text(
+herkschuldaten(i),druckbreite);druckzeileschreiben(ausgfelddruck(1))PER ;#
+FOR iFROM 1UPTO anzleerzeilenREP ausgfelddruck(1):=text(niltext,druckbreite);
+druckzeileschreiben(ausgfelddruck(1))PER ;druckzeilenzahl:=druckzeilenzahl-
+zeilenzahladresse.festentextschreiben:textanschr:=sequentialfile(input,
+vordruckueberarbeitet);WHILE NOT eof(textanschr)REP getline(textanschr,
+ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1
+PER ;FOR iFROM 1UPTO anzleerzeilenREP ausgfelddruck(1):=text(niltext,
+druckbreite);druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1PER .
+unterschriftschreiben:LET schluessel="Schulleiter",klammer1="(",klammer2=")",
+anzblank=5;TEXT VAR schulleiter;schulleiter:=schulkenndatum("Schulleiter");
+ausgfelddruck(1):=text(varanzblank*blank+klammer1+schulleiter+klammer2,
+druckbreite);druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1;
+ausgfelddruck(1):=text(anzblank*blank+schluessel,druckbreite);
+druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1;FOR iFROM 1UPTO 
+anzleerzeilenREP ausgfelddruck(1):=text(niltext,druckbreite);
+druckzeileschreiben(ausgfelddruck(1));druckzeilenzahlDECR 1PER .varanzblank:
+anzblank-((length(schulleiter)+2-length(schluessel))DIV 2).#
+dbwertezurueckholen:FOR iFROM 1UPTO 3REP dbwert(merker(i),i)PER .#END PROC 
+anherkliueberschriftdrucken;PROC drucke(TEXT CONST drucktext):ausgfelddruck(1
+):=drucktext;druckzeileschreiben(ausgfelddruck(1))ENDPROC drucke;PROC 
+schuelerdatendrucken(INT VAR zeilenzaehler):schuelerdatenholen;
+schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerdatenindruckdatei.END PROC schuelerdatendrucken;PROC 
+schuelerdatenholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(
+fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:=
+wert(fnrsugebdatums);schulkuerzel:=wert(fnrsuskennlschule);letzteklasse:=wert
+(fnrsuklasselschule).END PROC schuelerdatenholen;PROC 
+schuelerdatenaufbereiten:LET restjgst5="  :",restjgst11="  :    _________";
+schreibenamegebdatletzteklasse.schreibenamegebdatletzteklasse:spaltenweise(
+schuelernameaufber);spaltenweise(schuelergebdat);IF jgst5THEN spaltenweise(
+blank+letzteklasseaufber+restjgst5)ELSE spaltenweise(blank+letzteklasseaufber
++restjgst11)FI ;ausgfelddruck(1):=zeile.schuelernameaufber:schuelername+komma
++blank+schuelerrufname+blank+schuelernamenszus.letzteklasseaufber:IF 
+letzteklasse=niltextTHEN 3*blankELSE ((3-length(letzteklasse))*blank)+
+letzteklasseFI .END PROC schuelerdatenaufbereiten;PROC 
+schuelerdatenindruckdatei:druckzeileschreiben(ausgfelddruck(1)).END PROC 
+schuelerdatenindruckdatei;PROC bestandendesimulierenbeischulwechsel:IF 
+bestandendeTHEN neueherkschule:=FALSE ELSE neueherkschule:=schulkuerzel<>wert
+(fnrsuskennlschule);IF neueherkschuleTHEN setzebestandende(TRUE )FI ;FI .END 
+PROC bestandendesimulierenbeischulwechsel;END PACKET anherklisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.gebu b/app/schulis/2.2.1/src/1.listen.gebu
new file mode 100644
index 0000000..a025331
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.gebu
@@ -0,0 +1,125 @@
+PACKET geburtslistenDEFINES gebulispezielleteile:LET niltext="",blank=" ",
+mittestrich="-",null=0,komma=",",ueberschriftenzeilen=2,klas="Klasse",name=
+"Name, Rufname",gebtag="Geburtstag",spalte1breite=7,spalte3breite=12,
+anzspaltentrenner=2,ausgkopflaenge=2,ausgfeldlaenge=1,AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,gebulieingangsmaske=
+"ms liste gebjahr eingang",gebulianfpos=2,mnrbearbeitetwird=100;INT CONST 
+spalte2bildbreite:=bildbreite-anzspaltentrenner-spalte1breite-spalte3breite;
+INT VAR spalte2druckbreite,druckzeilenzahl,bildanf,eingabestatus,
+aktuelleindexnr;TEXT VAR gebjahreingang,schuelername,schuelerrufname,
+schuelernamenszus,schuelergebdat,klasse,alteklasse,druckstrich,bearbeitetwird
+,startjahr,startgeschl;TEXT CONST bildstrich:=bildbreite*mittestrich;
+AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR weibl,maennl,
+ersteraufbildschirm,klassegeaendert:=FALSE ;#DBMASKE VAR sortiertnachgebjahr,
+sortiertnachgebjahrgeschl,sortiertnachklassename;#BOOL PROC multistopstatus:
+BOOL VAR b:=wert(fnrsustatuss)="ls";setzebestandende(NOT b);bENDPROC 
+multistopstatus;BOOL PROC multistopdrucken:BOOL VAR b:=multistopmitdbstatus(
+FALSE );setzebestandende(NOT b);bENDPROC multistopdrucken;BOOL PROC 
+multistopmitdbstatusdrucken:BOOL VAR b:=multistopmitdbstatus(TRUE );
+setzebestandende(NOT b);bENDPROC multistopmitdbstatusdrucken;BOOL PROC 
+multistop:multistopmitdbstatus(FALSE )ENDPROC multistop;BOOL PROC 
+multistopmitdbstatus:multistopmitdbstatus(TRUE )ENDPROC multistopmitdbstatus;
+BOOL PROC multistopmitdbstatus(BOOL CONST mitdbstatus):BOOL VAR b:=FALSE ;IF 
+wert(fnrsustatuss)="ls"THEN IF startgeschl<>""THEN IF wert(fnrsugeschlechts)=
+startgeschlTHEN b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang)ELSE b:=
+FALSE FI ELSE b:=(subtext(wert(fnrsugebdatums),7,8)=gebjahreingang);IF 
+mitdbstatusTHEN b:=bCAND (dbstatus=ok)FI FI ;FI ;bEND PROC 
+multistopmitdbstatus;PROC gebulispezielleteile(INT CONST nr):SELECT nrOF 
+CASE 1:gebulidialogvorbereitenCASE 2:gebulieingabenrichtigCASE 3:
+gebulilistenvorbereitenCASE 4:gebulidruckvorbereitenCASE 5:gebuliseitedrucken
+CASE 6:gebulibildschirmvorbereitenCASE 7:gebuliseitezeigenENDSELECT .END 
+PROC gebulispezielleteile;PROC gebulidialogvorbereiten:setzeanfangswerte(
+gebulieingangsmaske,gebulianfpos)END PROC gebulidialogvorbereiten;PROC 
+gebulieingabenrichtig:LET fnrgebjahr=2,fnrmaennlich=3,fnrweiblich=4,
+fnrausgdrucker=5,fnrausgbild=6;standardpruefe(2,fnrgebjahr,null,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE waspruefen;wohinpruefen;IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE setzegeburtsjahr;
+setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest
+(TRUE )FI FI .waspruefen:weibl:=(standardmaskenfeld(fnrmaennlich)=niltext)
+AND (standardmaskenfeld(fnrweiblich)<>niltext);maennl:=(standardmaskenfeld(
+fnrweiblich)=niltext)AND (standardmaskenfeld(fnrmaennlich)<>niltext).
+wohinpruefen:standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus).setzegeburtsjahr:gebjahreingang:=standardmaskenfeld(fnrgebjahr
+);IF int(gebjahreingang)<10THEN gebjahreingang:=text(null)+text(int(
+gebjahreingang))FI .END PROC gebulieingabenrichtig;PROC 
+gebulilistenvorbereiten:#bestanderstellen(PROC 
+bestandgeburtsjahrgaengeerstellen).#BOOL VAR b:=FALSE ;startjahr:="01.01."+
+gebjahreingang;setzescanendewert("01.01."+text(int(gebjahreingang)+1));
+setzescanstartwert(startjahr);IF weiblTHEN startgeschl:="w";ELIF maennlTHEN 
+startgeschl:="m";ELSE startgeschl:="";FI ;IF startgeschl=""THEN 
+aktuelleindexnr:=ixsustatgebELSE aktuelleindexnr:=ixsustatgeschlgeb;FI ;
+inittupel(dnrschueler);initobli(14);parsenooffields(19);setzeidentiwert("");
+putdatumwert(fnrsugebdatums,startjahr);putwert(fnrsugeschlechts,startgeschl);
+putwert(fnrsustatuss,"ls");dbstatus(ok);objektlistestarten(aktuelleindexnr,""
+,fnrsugebdatums,TRUE ,b);setzebestandende(NOT multistopmitdbstatus)END PROC 
+gebulilistenvorbereiten;PROC gebulibildschirmvorbereiten:LET fnrausganf=2,
+gebuliueberschriftneu="Schülerliste Geburtsjahrgang 19";INT VAR i;
+standardkopfmaskeaktualisieren(gebuliueberschriftneu+gebjahreingang);
+initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite(
+spalte2bildbreite);setzespaltenbreite(spalte3breite);initausgabekopf(
+bildstrich);bildanf:=fnrausganf;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf
+(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;#
+setzenderhilfsgroessenfuersblaettern(min(bildblocklaenge,maxblocklaenge),
+bildsatzzahl);#setzebildanfangsposition(bildanf).END PROC 
+gebulibildschirmvorbereiten;PROC gebuliseitezeigen:ersteraufbildschirm:=TRUE 
+;blaettern(PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC 
+multistop).END PROC gebuliseitezeigen;PROC schuelerzeigen(INT CONST x):
+schuelerholen1;schuelerholen2;IF ersteraufbildschirmTHEN klassegeaendert:=
+TRUE ;ersteraufbildschirm:=FALSE FI ;schueleraufbereiten;
+schueleraufbildschirm.END PROC schuelerzeigen;PROC schueleraufbildschirm:INT 
+VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC 
+gebulidruckvorbereiten:LET uebteil1="Liste der im Jahr 19",uebteil2=
+" geborenen ",uebteil31="weiblichen ",uebteil32="männlichen ",uebteil4=
+"Schüler";TEXT VAR ueberschrift;klasse:=niltext;druckvorbereiten;
+variablenfuerdrucksetzen;ueberschriftvorbereitendruck;initdruckkopf(
+ueberschrift);initspalten;setzespaltenbreite(spalte1breite);
+setzespaltenbreite(spalte2druckbreite);setzespaltenbreite(spalte3breite);
+initausgabekopf(druckstrich);holemeldungen;#putwert(dateinr(primdatid(
+aktuelleindexnr))+1,"");putwert(fnrsugebdatums,"01.01."+gebjahreingang);
+dbstatus(ok);#inittupel(dnrschueler);putwert(fnrsustatuss,"ls");
+aktuelleindexnr:=ixsustatjgstzug;BOOL VAR b;objektlistestarten(
+aktuelleindexnr,"",fnrsusgrpzugtut,TRUE ,b);lesenvorbereitendruck(PROC (INT 
+CONST ,BOOL PROC ,INT VAR )scanforward,#BOOL PROC multistopmitdbstatusdrucken
+#BOOL PROC multistopstatus).variablenfuerdrucksetzen:druckstrich:=druckbreite
+*mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-spalte1breite-
+spalte3breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-
+ausgkopflaenge.ueberschriftvorbereitendruck:ueberschrift:=uebteil1+
+gebjahreingang+uebteil2;IF weiblTHEN ueberschrift:=ueberschrift+uebteil31
+ELSE IF maennlTHEN ueberschrift:=ueberschrift+uebteil32FI ;FI ;ueberschrift:=
+ueberschrift+uebteil4.holemeldungen:meldungstext(mnrbearbeitetwird,
+bearbeitetwird).END PROC gebulidruckvorbereiten;PROC gebuliseitedrucken:
+gebuliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken,
+druckzeilenzahl,ausgfeldlaenge,#BOOL PROC multistopdrucken#BOOL PROC 
+multistopstatus);seitenwechsel.END PROC gebuliseitedrucken;PROC 
+gebuliueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO 
+ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC 
+gebuliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET 
+markiert="#";schuelerholen1;evtleave;schuelerholen2;ggflmeldungklasse;IF 
+zeilenzaehler=nullTHEN klassegeaendert:=TRUE FI ;IF klassegeaendertTHEN 
+leerzeileindruckdateiFI ;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge
+;schuelerindruckdatei.evtleave:IF jahrstimmtnichtCOR geschlechtstimmtnicht
+THEN LEAVE schuelerdruckenFI .jahrstimmtnicht:subtext(wert(fnrsugebdatums),7,
+8)<>gebjahreingang.geschlechtstimmtnicht:startgeschl<>""CAND wert(
+fnrsugeschlechts)<>startgeschl.ggflmeldungklasse:IF klassegeaendertTHEN 
+meldungklasseFI .meldungklasse:standardmeldung(bearbeitetwird,klasse+markiert
+).leerzeileindruckdatei:ausgfeld(1):=text(blank,druckbreite);
+druckzeileschreiben(ausgfeld(1));zeilenzaehlerINCR 1.END PROC schuelerdrucken
+;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT 
+druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC schuelerindruckdatei;
+PROC initausgabekopf(TEXT CONST strich):spaltenweise(klas);spaltenweise(name)
+;spaltenweise(gebtag);ausgkopf(1):=zeile;ausgkopf(2):=strich;END PROC 
+initausgabekopf;PROC schuelerholen1:schuelergebdat:=wert(fnrsugebdatums);
+schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(fnrsurufnames);
+schuelernamenszus:=wert(fnrsunamenszusatzs);#alteklasse:=klasse;klasse:=wert(
+fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse<>
+klasse.#END PROC schuelerholen1;PROC schuelerholen2:alteklasse:=klasse;klasse
+:=wert(fnrsusgrpjgst)+blank+wert(fnrsusgrpzugtut);klassegeaendert:=alteklasse
+<>klasse.END PROC schuelerholen2;PROC schueleraufbereiten:
+schreibeklassenamegebdat.schreibeklassenamegebdat:IF klassegeaendertTHEN 
+spaltenweise(klasse)ELSE spaltenweise(blank)FI ;spaltenweise(
+schuelernameaufber);spaltenweise(schuelergebdat);ausgfeld(1):=zeile.
+schuelernameaufber:schuelername+komma+blank+schuelerrufname+blank+
+schuelernamenszus.END PROC schueleraufbereiten;END PACKET geburtslisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.gesamt b/app/schulis/2.2.1/src/1.listen.gesamt
new file mode 100644
index 0000000..2ec7ee7
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.gesamt
@@ -0,0 +1,106 @@
+PACKET gesamtlisteDEFINES geslispezielleteile:#LET dnrschueler=2,
+ixsustatfamrufgeb=254,stattnachfolgendemI ndexixsustat=252,fnrsufamnames=3,
+fnrsurufnames=4,fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsugebdatums=5,
+fnrsuabgdats=16,fnrsusgrpjgst=7,fnrsusgrpzugtut=8;#LET niltext="",nildatum=
+"01.01.00",blank=" ",mittestrich="-",null=0,komma=",",kleina="a",stern="*",
+ueberschriftenzeilen=1,altervolljaehrig=18,spalte2breite=10,spalte3breite=9,
+anzspaltentrenner=2,spaltentrenner=":",ausgkopflaengebild=2,
+ausgkopflaengedruck=6,ausgfeldlaenge=1,AUSGKOPFBILD =ROW ausgkopflaengebild
+TEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengedruckTEXT ,AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,geslieingangsmaske="mu liste einfach eingang",geslianfpos
+=2,nname="Name, Rufname",gebdat="  Geb.Dat.",klasse="Jgst./Kl.";INT CONST 
+spalte1bildbreite:=bildbreite-anzspaltentrenner-spalte2breite-spalte3breite;
+INT VAR spalte1druckbreite,druckzeilenzahl,bildanf,vergldatum,eingabestatus;
+TEXT VAR gesliueberschrift,schuelername,schuelerrufname,schuelernamenszus,
+schuelergebdat,schuelerabdat,schuelernameaufber,gebdataufber,klasseaufber,
+jahrgang,zug,anfbuchstabe,neueranfbuchstabe;TEXT VAR druckstrich;TEXT CONST 
+bildstrich:=bildbreite*mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPFDRUCK VAR 
+ausgkopfdruck;AUSGKOPFBILD VAR ausgkopfbild;PROC geslispezielleteile(INT 
+CONST nr):SELECT nrOF CASE 1:geslidialogvorbereitenCASE 2:
+geslieingabenrichtigCASE 3:geslilistenvorbereitenCASE 4:geslidruckvorbereiten
+CASE 5:gesliseitedruckenCASE 6:geslibildschirmvorbereitenCASE 7:
+gesliseitezeigenENDSELECT .END PROC geslispezielleteile;PROC 
+geslidialogvorbereiten:gesliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(geslieingangsmaske,geslianfpos).END PROC 
+geslidialogvorbereiten;PROC geslieingabenrichtig:LET fnrausgdrucker=2,
+fnrausgbild=3;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);
+setzeeingabetest(TRUE )FI .END PROC geslieingabenrichtig;PROC 
+geslilistenvorbereiten:BOOL VAR b;setzespaltentrenner(spaltentrenner);
+vergldatum:=vergleichsdatum(altervolljaehrig);inittupel(dnrschueler);initobli
+(17);parsenooffields(21);setzeidentiwert("");putwert(fnrsustatuss,"ls");
+objektlistestarten(ixsustatfamrufgeb,"",fnrsufamnames,TRUE ,b);
+setzebestandende(NOT multistopCOR b)END PROC geslilistenvorbereiten;BOOL 
+PROC multistop:wert(fnrsustatuss)="ls"ENDPROC multistop;BOOL PROC 
+multistopdruck:BOOL VAR b:=multistop;setzebestandende(NOT b);bENDPROC 
+multistopdruck;PROC geslibildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(gesliueberschrift);initspalten;
+setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2breite);
+setzespaltenbreite(spalte3breite);initausgabekopfbild;bildanf:=fnrausganf;
+INT VAR i;FOR iFROM 1UPTO ausgkopflaengebildREPEAT ausgkopfbild(i)IN bildanf;
+bildanfINCR 1END REPEAT ;setzebildanfangsposition(bildanf).END PROC 
+geslibildschirmvorbereiten;PROC initausgabekopfbild:spaltenweise(nname);
+spaltenweise(gebdat);spaltenweise(klasse);ausgkopfbild(1):=zeile;ausgkopfbild
+(2):=bildstrich;END PROC initausgabekopfbild;PROC gesliseitezeigen:blaettern(
+PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END 
+PROC gesliseitezeigen;BOOL PROC dummystop:#dbstatus<>ok#TRUE ENDPROC 
+dummystop;PROC schuelerzeigen(INT CONST x):schuelerholen;schueleraufbereiten;
+schueleraufbildschirm;END PROC schuelerzeigen;PROC schueleraufbildschirm:INT 
+VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC 
+geslidruckvorbereiten:anfbuchstabe:=niltext;druckvorbereiten;
+variablenfuerdrucksetzen;inittupel(dnrschueler);putwert(fnrsustatuss,"ls");
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistopdruck);initdruckkopf(zentriert(gesliueberschrift,druckbreite));
+initspalten;setzespaltenbreite(spalte1druckbreite);setzespaltenbreite(
+spalte2breite);setzespaltenbreite(spalte3breite);initausgabekopfdruck.
+variablenfuerdrucksetzen:druckstrich:=druckbreite*mittestrich;
+spalte1druckbreite:=druckbreite-anzspaltentrenner-spalte2breite-spalte3breite
+;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaengedruck.END 
+PROC geslidruckvorbereiten;PROC initausgabekopfdruck:LET kommentar1=
+"Die abgemeldeten Schüler sind mit einem a vor Jgst./",kommentar2=
+"Kl. markiert,",kommentar3="die volljährigen Schüler mit einem * vor dem ",
+kommentar4="Geburtsdatum.";ausgkopfdruck(1):=text(kommentar1+kommentar2,
+druckbreite);ausgkopfdruck(2):=text(kommentar3+kommentar4,druckbreite);
+ausgkopfdruck(3):=text(niltext,druckbreite);ausgkopfdruck(4):=text(niltext,
+druckbreite);spaltenweise(nname);spaltenweise(gebdat);spaltenweise(klasse);
+ausgkopfdruck(5):=zeile;ausgkopfdruck(6):=druckstrich;END PROC 
+initausgabekopfdruck;PROC gesliseitedrucken:gesliueberschriftdrucken;
+seitedrucken(PROC (INT VAR )schuelerdrucken,druckzeilenzahl,ausgfeldlaenge,
+BOOL PROC multistopdruck);seitenwechsel.END PROC gesliseitedrucken;PROC 
+gesliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO 
+ausgkopflaengedruckREPEAT druckzeileschreiben(ausgkopfdruck[i])END REPEAT .
+END PROC gesliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler)
+:LET bearbeitetwerden=102,markiert="#";schuelerholen;ggflmeldunganfbuchstabe;
+schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;schuelerindruckdatei.
+ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .
+anfbuchstabegeaendert:neueranfbuchstabe:=schuelernameSUB 1;anfbuchstabe<>
+neueranfbuchstabe.meldunganfbuchstabe:standardmeldung(bearbeitetwerden,
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+schuelerdrucken;PROC schuelerindruckdatei:druckzeileschreiben(ausgfeld(1)).
+END PROC schuelerindruckdatei;#PROC schuelerbestanderstellen(TEXT VAR aktbest
+,DBMASKE VAR nameklassegebdat):setzemaske(nameklassegebdat,
+"t c12 familienname/"+"t c12 rufname/"+"t c12 namenszusaetze(1)/"+
+"i c12 geburtsdatum/"+"i c12 abgangsdatum/"+"t c12 aktuelle schuelergruppe");
+aktbest:=bestand.END PROC schuelerbestanderstellen;#PROC schueleraufbereiten:
+schuelervorbereiten;schreibenamegebdatklasse.schreibenamegebdatklasse:
+ausgfeld(1):=zeile.END PROC schueleraufbereiten;PROC schuelervorbereiten:
+schuelernamevorbereiten;gebdatvorbereiten;klassevorbereiten;zeilefuellen.
+schuelernamevorbereiten:schuelernameaufber:=niltext;IF schuelernamenszus<>
+niltextTHEN schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber
+:=schuelernameaufber+schuelername+komma+blank+schuelerrufname.
+gebdatvorbereiten:IF (schuelergebdat<>niltext)THEN IF volljaehrig(datum(
+schuelergebdat))THEN gebdataufber:=sternELSE gebdataufber:=blankFI ;
+gebdataufber:=gebdataufber+blank+schuelergebdatELSE gebdataufber:=niltextFI .
+klassevorbereiten:IF (schuelerabdat<>nildatum)THEN klasseaufber:=kleinaELSE 
+klasseaufber:=blankFI ;klasseaufber:=klasseaufber+blank+jahrgang+blank+zug.
+zeilefuellen:spaltenweise(schuelernameaufber);spaltenweise(gebdataufber);
+spaltenweise(klasseaufber).END PROC schuelervorbereiten;BOOL PROC volljaehrig
+(INT CONST geburtstag):geburtstag<=vergldatumEND PROC volljaehrig;PROC 
+schuelerholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(
+fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:=
+wert(fnrsugebdatums);schuelerabdat:=wert(fnrsuabgdats);jahrgang:=wert(
+fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);END PROC schuelerholen;END PACKET 
+gesamtliste;
+
diff --git a/app/schulis/2.2.1/src/1.listen.klassen b/app/schulis/2.2.1/src/1.listen.klassen
new file mode 100644
index 0000000..7b4d39b
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.klassen
@@ -0,0 +1,157 @@
+PACKET klassenlistenDEFINES klalispezielleteile:LET niltext="",blank=" ",
+mittestrich="-",null=0,komma=",",stern="*",ueb1teil1="Klassenliste",ueb1teil2
+=" für Klasse ",ueb1teil3="Klassenlehrer: ",ueb2teil1="Tutorenkursliste",
+ueb2teil21=" für Jahrgangsstufe ",ueb2teil22=" für den Kurs ",ueb2teil3=
+"Tutor: ",ueb3="n der Jahrgangsstufe ",ueberschriftenzeilen=2,
+spalte1druckbreite=3,spalte2bildbreite=7,anzspaltentrenner=1,ausgkopflaenge=2
+,ausgfeldlaenge=1,AUSGFELDDRUCK =ROW ausgfeldlaengeTEXT ,AUSGFELDBILD =ROW 
+ausgfeldlaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ,AUSGKOPFBILD =ROW 
+ausgkopflaengeTEXT ,klalieingangsmaske="ms liste klassen eingang",klalianfpos
+=2,nr="Nr.",name="Name, Rufname",sternvolljaehrig=
+" ( * entspricht volljährig )",klasse="Klasse",altervolljaehrig=18,
+mnrbearbeitetwird=100,mnrlistewirdgedruckt=58,mnrauswahlnichtsinnvoll=56;INT 
+CONST spalte1bildbreite:=bildbreite-anzspaltentrenner-spalte2bildbreite;INT 
+VAR spalte2druckbreite,druckzeilenzahlmax,druckzeilenzahl,bildanf,zaehler,
+vergldatum,aktuelleindexnr,eingabestatus;TEXT VAR klaliueberschrift,
+schuelername,schuelerrufname,schuelernamenszus,schuelergebdat,
+schuelernameaufber,zaehleraufber,ueberschrift1,ueberschrift2,lehrer,jahrgang,
+zug,startjgst,startzug,bearbeitetwird,listewirdgedruckt,auswahlnichtsinnvoll;
+TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*mittestrich;
+AUSGFELDDRUCK VAR ausgfelddruck;AUSGFELDBILD VAR ausgfeldbild;AUSGKOPFDRUCK 
+VAR ausgkopfdruck;AUSGKOPFBILD VAR ausgkopfbild;BOOL VAR einjahrgang,alle,
+voll,neueklasse;BOOL PROC multistop:BOOL VAR b;IF startjgst<>""THEN IF 
+einjahrgangTHEN b:=wert(fnrsusgrpjgst)=startjgst;ELSE b:=wert(fnrsusgrpjgst)=
+startjgstAND wert(fnrsusgrpzugtut)=startzug;FI ELSE b:=wert(fnrsustatuss)=
+"ls";FI ;bEND PROC multistop;BOOL PROC multistopsim:BOOL VAR b:=multistop;
+setzebestandende(NOT b);bENDPROC multistopsim;PROC klalispezielleteile(INT 
+CONST nr):SELECT nrOF CASE 1:klalidialogvorbereitenCASE 2:
+klalieingabenrichtigCASE 3:klalilistenvorbereitenCASE 4:klalidruckvorbereiten
+CASE 5:klaliseitedruckenCASE 6:klalibildschirmvorbereitenCASE 7:
+klaliseitezeigenENDSELECT .END PROC klalispezielleteile;PROC 
+klalidialogvorbereiten:klaliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(klalieingangsmaske,klalianfpos).END PROC 
+klalidialogvorbereiten;PROC klalieingabenrichtig:LET fnrjgst=2,fnrzug=3,
+fnrvoll=4,fnrausgdrucker=5,fnrausgbild=6;alle:=FALSE ;einjahrgang:=FALSE ;
+voll:=FALSE ;standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE zug:=standardmaskenfeld(fnrzug);jahrgang:=standardmaskenfeld(
+fnrjgst);IF standardmaskenfeld(fnrjgst)=niltextTHEN IF zug=niltextTHEN alle:=
+TRUE ;voll:=(standardmaskenfeld(fnrvoll)<>niltext);setzeausgabedrucker(
+standardmaskenfeld(fnrausgbild)=niltext);setzeeingabetest(TRUE )ELSE 
+meldefehler;infeld(fnrzug);setzeeingabetest(FALSE )FI ELSE standardpruefe(3,
+fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE jahrgang:=zweistellig(
+standardmaskenfeld(fnrjgst));einjahrgang:=(zug=niltext);voll:=(
+standardmaskenfeld(fnrvoll)<>niltext);setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);setzeeingabetest(TRUE )FI FI FI .meldefehler:
+meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung(
+auswahlnichtsinnvoll,niltext).END PROC klalieingabenrichtig;PROC 
+klalilistenvorbereiten:BOOL VAR b:=FALSE ;startjgst:=jahrgang;startzug:=zug;
+neueklasse:=FALSE ;aktuelleindexnr:=ixsustatjgstzug;inittupel(dnrschueler);
+initobli(17);parsenooffields(19);setzeidentiwert("");putwert(fnrsustatuss,
+"ls");putwert(fnrsusgrpjgst,startjgst);putwert(fnrsusgrpzugtut,startzug);
+vergldatum:=vergleichsdatum(altervolljaehrig);#objektlistestarten(
+aktuelleindexnr,"",fnrsustatuss,TRUE ,b);#objektlistestarten(aktuelleindexnr,
+"",staticfield,TRUE ,b);setzebestandende(NOT multistopCOR b).staticfield:IF 
+startjgst=niltextTHEN fnrsusgrpjgstELSE IF startzug=niltextTHEN 
+fnrsusgrpzugtutELSE dnrschueler+1FI FI .END PROC klalilistenvorbereiten;PROC 
+klalibildschirmvorbereiten:LET fnrausganf=2;ueberschriftvorbereitenbild;
+standardkopfmaskeaktualisieren(ueberschrift1);initspalten;initausgabekopfbild
+;bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+ausgkopfbild(i)IN bildanf;bildanfINCR 1END REPEAT ;setzebildanfangsposition(
+bildanf).END PROC klalibildschirmvorbereiten;PROC ueberschriftvorbereitenbild
+:LET aufein="",aufaus=" ";IF alleTHEN ueberschrift1:=klaliueberschriftELSE 
+IF einjahrgangTHEN IF int(jahrgang)<11THEN ueberschrift1:=ueb1teil1ELSE 
+ueberschrift1:=ueb2teil1FI ;ueberschrift1:=ueberschrift1+ueb3+aufein+jahrgang
++aufausELSE IF int(jahrgang)<11THEN ueberschrift1:=ueb1teil1+ueb1teil2ELSE 
+ueberschrift1:=ueb2teil1+ueb2teil22FI ;ueberschrift1:=ueberschrift1+aufein+
+jahrgang+blank+wert(fnrsusgrpzugtut)+aufausFI FI ;END PROC 
+ueberschriftvorbereitenbild;PROC initausgabekopfbild:IF einjahrgangOR alle
+THEN hilfsfeldervorbelegen;ausgkopfbild(1):=zeileELSE ausgkopfbild(1):=text(
+name,bildbreite)FI ;ausgkopfbild(2):=bildstrich.hilfsfeldervorbelegen:
+setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2bildbreite);
+IF vollTHEN spaltenweise(name+sternvolljaehrig)ELSE spaltenweise(name)FI ;
+spaltenweise(klasse).END PROC initausgabekopfbild;PROC klaliseitezeigen:
+blaettern(PROC (INT CONST )schuelerdatenzeigen,aktion,TRUE ,TRUE ,BOOL PROC 
+multistop)END PROC klaliseitezeigen;PROC schuelerdatenzeigen(INT CONST x):
+schuelerdatenholen;schuelerdatenaufbereitenbild;schuelerdatenaufbildschirm.
+END PROC schuelerdatenzeigen;PROC schuelerdatenaufbereitenbild:
+schuelernameaufbereiten;IF alleOR einjahrgangTHEN schreibenamerufnameklasse
+ELSE schreibenamerufnameFI .schreibenamerufnameklasse:spaltenweise(
+schuelernameaufber);spaltenweise(jahrgang+blank+wert(fnrsusgrpzugtut));
+ausgfeldbild(1):=zeile.schreibenamerufname:ausgfeldbild(1):=text(
+schuelernameaufber,bildbreite).END PROC schuelerdatenaufbereitenbild;PROC 
+schuelerdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT 
+ausgfeldbild(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC 
+schuelerdatenaufbildschirm;PROC klalidruckvorbereiten:zaehler:=null;
+neueklasse:=TRUE ;druckvorbereiten;variablenfuerdrucksetzen;druckzeilenzahl:=
+druckzeilenzahlmax;IF vollTHEN druckzeilenzahl:=druckzeilenzahl-2FI ;
+holemeldung;inittupel(dnrschueler);putwert(fnrsusgrpjgst,startjgst);putwert(
+fnrsusgrpzugtut,startzug);putwert(fnrsustatuss,"ls");lesenvorbereitendruck(
+PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim);
+ueberschriftvorbereitendruck;initdruckkopf(ueberschrift1,ueberschrift2);
+initspalten;initausgabekopfdruck.variablenfuerdrucksetzen:druckstrich:=
+druckbreite*mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-
+spalte1druckbreite;druckzeilenzahlmax:=drucklaenge(ueberschriftenzeilen)-
+ausgkopflaenge.holemeldung:meldungstext(mnrbearbeitetwird,bearbeitetwird).
+END PROC klalidruckvorbereiten;PROC ueberschriftvorbereitendruck:IF int(
+jahrgang)<11THEN ueberschrift1:=ueb1teil1+ueb1teil2+wert(fnrsusgrpjgst)+blank
++wert(fnrsusgrpzugtut);ueberschrift2:=ueb1teil3ELSE ueberschrift1:=ueb2teil1+
+ueb2teil21+jahrgang;ueberschrift2:=ueb2teil3FI ;klassenlehrer(lehrer,jahrgang
+,wert(fnrsusgrpzugtut));ueberschrift2:=ueberschrift2+lehrer;END PROC 
+ueberschriftvorbereitendruck;PROC klassenlehrer(TEXT VAR lehrer,TEXT CONST 
+jahrgang,TEXT CONST zug):putwert(fnrsgrpsj,schulkenndatum("Schuljahr"));
+putwert(fnrsgrphj,schulkenndatum("Schulhalbjahr"));putwert(fnrsgrpjgst,
+jahrgang);putwert(fnrsgrpkennung,zug);search(dnraktschuelergruppen,TRUE );IF 
+dbstatus=okTHEN putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,
+TRUE );IF dbstatus=okTHEN lehrer:=wert(fnrlfamname)ELSE lehrer:=""FI ;ELSE 
+lehrer:=""FI END PROC klassenlehrer;PROC initausgabekopfdruck:
+hilfsfeldervorbelegen;ausgkopfdruck(1):=zeile;ausgkopfdruck(2):=druckstrich.
+hilfsfeldervorbelegen:setzespaltenbreite(spalte1druckbreite);
+setzespaltenbreite(spalte2druckbreite);spaltenweise(nr);spaltenweise(name).
+END PROC initausgabekopfdruck;PROC klaliseitedrucken:LET kommentar=
+"* Schüler ist am Tag der Listenerstellung volljährig";
+klaliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdatendrucken,
+druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeiklassenwechsel,
+BOOL PROC multistopsim);ggflkommentarzeile;IF neueklasseTHEN 
+simuliertesendezuruecknehmen;neuelistevorbereitenELSE seitenwechselFI .
+ggflkommentarzeile:IF vollTHEN kommentarzeiledruckenFI .kommentarzeiledrucken
+:ausgfelddruck(1):=text(niltext,druckbreite);druckzeileschreiben(
+ausgfelddruck(1));ausgfelddruck(1):=text(kommentar,druckbreite);
+druckzeileschreiben(ausgfelddruck(1)).simuliertesendezuruecknehmen:
+setzebestandende(FALSE ).neuelistevorbereiten:meldelistewirdgedruckt;
+drucknachbereiten;druckvorbereiten;zaehler:=null;schuelerdatenholen;
+ueberschriftvorbereitendruck;initdruckkopf(ueberschrift1,ueberschrift2).
+meldelistewirdgedruckt:meldungstext(mnrlistewirdgedruckt,listewirdgedruckt);
+standardmeldung(listewirdgedruckt,niltext).END PROC klaliseitedrucken;PROC 
+klaliueberschriftdrucken:druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO 
+ausgkopflaengeREPEAT druckzeileschreiben(ausgkopfdruck(i))END REPEAT .END 
+PROC klaliueberschriftdrucken;PROC schuelerdatendrucken(INT VAR zeilenzaehler
+):LET markiert="#";schuelerdatenholen;ggflmeldungklasse;zaehlerINCR 1;
+schuelerdatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerdatenindruckdatei.ggflmeldungklasse:IF zaehler=nullTHEN 
+standardmeldung(bearbeitetwird,jahrgang+blank+zug+markiert)FI .END PROC 
+schuelerdatendrucken;PROC schuelerdatenaufbereitendruck:zaehleraufbereiten;
+schuelernameaufbereiten;schreibenrnamerufname.zaehleraufbereiten:IF zaehler<
+10THEN zaehleraufber:=blankELSE zaehleraufber:=niltextFI ;zaehleraufber:=
+zaehleraufber+text(zaehler).schreibenrnamerufname:spaltenweise(zaehleraufber)
+;spaltenweise(schuelernameaufber);ausgfelddruck(1):=zeile;END PROC 
+schuelerdatenaufbereitendruck;PROC schuelerdatenindruckdatei:
+druckzeileschreiben(ausgfelddruck(1)).END PROC schuelerdatenindruckdatei;
+PROC bestandendesimulierenbeiklassenwechsel:IF bestandendeTHEN neueklasse:=
+FALSE ELSE nochklassezubearbeiten;IF neueklasseTHEN setzebestandende(TRUE )
+FI ;FI .nochklassezubearbeiten:neueklasse:=zug<>wert(fnrsusgrpzugtut);IF alle
+THEN neueklasse:=neueklasseOR (int(jahrgang)<>int(wert(fnrsusgrpjgst)))FI .
+END PROC bestandendesimulierenbeiklassenwechsel;PROC schuelernameaufbereiten:
+schuelernameaufber:=niltext;IF schuelernamenszus<>niltextTHEN 
+schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber:=
+schuelernameaufber+schuelername+komma+blank+schuelerrufname;IF vollCAND (
+schuelergebdat<>niltext)CAND volljaehrig(datum(schuelergebdat))THEN 
+schuelernameaufber:=schuelernameaufber+blank+sternFI ;END PROC 
+schuelernameaufbereiten;BOOL PROC volljaehrig(INT CONST geburtstag):
+geburtstag<=vergldatumEND PROC volljaehrig;PROC schuelerdatenholen:
+schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(fnrsurufnames);
+schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:=wert(
+fnrsugebdatums);jahrgang:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut).END 
+PROC schuelerdatenholen;END PACKET klassenlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.klassenbuch b/app/schulis/2.2.1/src/1.listen.klassenbuch
new file mode 100644
index 0000000..e0c2386
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.klassenbuch
@@ -0,0 +1,237 @@
+PACKET klassenbuchlistenDEFINES klabulispezielleteile:LET nildatumdb=
+"01.01.00",niltext="",blank=" ",mittestrich="-",null=0,slspalte3breite=16,
+slanzspaltentrenner=2,ausgkopflaenge=3,ausgfeldlaenge=3,maxanzproseite=50,
+AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,SPEICHER 
+=ROW maxanzproseiteTEXT ,klabulieingangsmaske="ms liste klabuch eingang",
+klabulianfpos=2,#dnrschueler=2,fnrsufamnames=3,fnrsurufnames=4,fnrsugebdatums
+=5,fnrsustatuss=6,fnrsusgrpjgst=7,fnrsusgrpzugtut=8,fnrsugeschlechts=12,
+fnrsunamenszusatzs=21,fnrsustrnrs=24,fnrsuplzorts=25,dbiplz=--,fnrsutelnrs=26
+,fnrsutidiffdaten=52,dnrdiffdaten=53,fnrddreliunter=67,fnrddreliunteranmeld=
+69,fnrddreliunterabmeld=68,fnrddkunstmusik=70,fnrddfach091a=71,fnrddfach091b=
+72,fnrddfach092a=73,fnrddfach092b=74,fnrddfach101a=75,fnrddfach101b=76,
+fnrddfach102a=77,fnrddfach102b=78,fnrhjdfamnames=89,fnrhjdrufnames=90,
+fnrhjdgebdats=91,fnrhjdhj=93,fnrhjdjgst=94,fnrhjdfach=113,fnrhjdkursart=114,
+dnrfaecher=141,fnrffach=142,fnrffachbez=143,ixhjdfamrufgebjgsthj=276,
+ixsustatjgstzug=255,#mnrlistewirdgedruckt=58,mnrbearbeitetwird=100,
+mnrauswahlnichtsinnvoll=56;INT VAR slspalte1breite,slspalte2breite,
+druckzeilenzahlgrund,druckzeilenzahl,druckzeilenzahlrest,zaehler,anzzaehler,
+indexspeicher,eingabestatus,aktuelleindexnr;TEXT VAR vordruck,
+vordruckueberarbsl,vordruckueberarbsr,klabuliueberschrift,
+auswahlnichtsinnvoll,listewirdgedruckt,bearbeitetwird,startjahr,startzug,
+schuelername,schuelerrufname,schuelernamenszus,jahrgang,zug,schuelerstrasse,
+schuelerort,schuelertelefon,schuelergebdat,schuelergeschlecht,schuelerreliunt
+,schuelersprachen,schuelermusfach,schuelerwpffach,schuelerkursfachbez,
+schuelerkursartbez,zaehleraufber,lehrer,puffer1,puffer2,druckstrich;AUSGFELD 
+VAR ausgfeld;AUSGKOPF VAR slausgkopf,srausgkopf;SPEICHER VAR speicher;FILE 
+VAR f,g;BOOL VAR einjahrgang,alle,elementsek1,neueklasse:=FALSE ;BOOL PROC 
+multistopsim:BOOL VAR b:=FALSE ;IF wert(fnrsustatuss)="ls"THEN IF startjahr<>
+""THEN b:=wert(fnrsusgrpjgst)=startjahr;IF bCAND startzug<>""THEN b:=wert(
+fnrsusgrpzugtut)=startzugFI ELSE #b:=dbstatus=ok;#b:=wert(fnrsustatuss)="ls"
+FI ;FI ;setzebestandende(NOT b);bEND PROC multistopsim;PROC 
+klabulispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+klabulidialogvorbereiten;CASE 2:klabulieingabenrichtig;CASE 3:
+klabulilistenvorbereiten;CASE 4:klabulidruckvorbereiten;CASE 5:
+klabuliseitedrucken;ENDSELECT .END PROC klabulispezielleteile;PROC 
+klabulidialogvorbereiten:klabuliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(klabulieingangsmaske,klabulianfpos).END PROC 
+klabulidialogvorbereiten;PROC klabulieingabenrichtig:LET fnrjgst=2,fnrzug=3;
+alle:=FALSE ;einjahrgang:=FALSE ;reinitparsing;zug:=standardmaskenfeld(fnrzug
+);jahrgang:=standardmaskenfeld(fnrjgst);IF standardmaskenfeld(fnrjgst)=
+niltextTHEN IF zug=niltextTHEN alle:=TRUE ;setzeausgabedrucker(TRUE );
+setzeeingabetest(TRUE )ELSE meldefehler;infeld(fnrzug);setzeeingabetest(
+FALSE )FI ELSE standardpruefe(3,fnrjgst,5,13,niltext,eingabestatus);IF 
+eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE 
+jahrgang:=zweistellig(standardmaskenfeld(fnrjgst));einjahrgang:=(zug=niltext)
+;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI FI .meldefehler:
+meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung(
+auswahlnichtsinnvoll,niltext).END PROC klabulieingabenrichtig;PROC 
+klabulilistenvorbereiten:BOOL VAR b;startjahr:=jahrgang;startzug:=zug;
+aktuelleindexnr:=ixsustatjgstzug;inittupel(dnrschueler);initobli(9);
+setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,
+startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"",
+fnrsusgrpjgst,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",fnrsustatuss,
+TRUE ,b);setzebestandende(NOT multistopsim)END PROC klabulilistenvorbereiten;
+PROC klabulidruckvorbereiten:LET vordr="vordruck klassenbuchliste",manager=
+"anschreiben server";setzemitseitennummern(FALSE );zaehler:=null;neueklasse:=
+TRUE ;druckvorbereiten;variablenfuerdrucksetzen;holemeldungen;inittupel(
+dnrschueler);putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,
+startzug);putwert(fnrsustatuss,"ls");lesenvorbereitendruck(PROC (INT CONST ,
+BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim);
+vordruckvommanagerholen;ueberschriftenvorbereiten;initspalten;
+ausgabekoepfevorbereiten;ausgfeld(3):=druckstrich.holemeldungen:meldungstext(
+mnrbearbeitetwird,bearbeitetwird).variablenfuerdrucksetzen:druckstrich:=
+druckbreite*mittestrich;slspalte2breite:=(druckbreite-slanzspaltentrenner-
+slspalte3breite)DIV 2;slspalte1breite:=druckbreite-slanzspaltentrenner-
+slspalte2breite-slspalte3breite;druckzeilenzahlgrund:=drucklaenge-
+ausgkopflaenge.vordruckvommanagerholen:vordruck:=vordr;forget(vordruck,quiet)
+;fetch(vordruck,/manager).END PROC klabulidruckvorbereiten;PROC 
+ueberschriftenvorbereiten:LET swischuledatum=511,swiuebzeile=512,
+vordrueberarbsl="vordruck ueberarbeitet sl",vordrueberarbsr=
+"vordruck ueberarbeitet sr",beginnsek2=11,uebteil1sek1="Klasse: ",
+uebteil1sek2="Tutorenkurs: ",ueb1teil2sek1="   Klassenlehrer: ",ueb1teil2sek2
+="   Tutor: ",ueb2teil2="Schuljahr ";jahrgangundzugholen;elementsek1bestimmen
+;#puffer1:=wert();#setzesonderwerteschulkenndaten;#putwert(,puffer1);#
+vordruckfuellenfuerueberschrift1;vordruckfuellenfuerueberschrift2;
+verbleibendedruckzeilenzahlbestimmen.jahrgangundzugholen:jahrgang:=wert(
+fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut).elementsek1bestimmen:elementsek1:=
+FALSE ;IF int(jahrgang)<beginnsek2THEN elementsek1:=TRUE FI .
+vordruckfuellenfuerueberschrift1:setzesonderwert(swischuledatum,
+aufbereiteteschuledatum);setzesonderwert(swiuebzeile,aufbereiteteklasselehrer
+);vordruckueberarbsl:=vordrueberarbsl;forget(vordruckueberarbsl,quiet);
+briefalternative(vordruck,vordruckueberarbsl);f:=sequentialfile(input,
+vordruckueberarbsl).vordruckfuellenfuerueberschrift2:setzesonderwert(
+swischuledatum,aufbereiteteschuledatum);setzesonderwert(swiuebzeile,
+aufbereiteteklasseschuljahr);vordruckueberarbsr:=vordrueberarbsr;forget(
+vordruckueberarbsr,quiet);briefalternative(vordruck,vordruckueberarbsr);g:=
+sequentialfile(input,vordruckueberarbsr).aufbereiteteschuledatum:puffer1:=
+sonderwert(501);puffer2:=sonderwert(502);puffer2+(druckbreite-length(puffer2)
+-length(puffer1))*blank+puffer1.aufbereiteteklasselehrer:klassenlehrer(lehrer
+,jahrgang,zug);puffer2:=jahrgang+blank+zug;IF int(jahrgang)<11THEN 
+uebteil1sek1+puffer2+ueb1teil2sek1+lehrerELSE uebteil1sek2+puffer2+
+ueb1teil2sek2+lehrerFI .aufbereiteteklasseschuljahr:puffer1:=ueb2teil2+
+sonderwert(505);puffer2:=jahrgang+blank+zug;IF int(jahrgang)<11THEN puffer2:=
+uebteil1sek1+puffer2ELSE puffer2:=uebteil1sek2+puffer2FI ;puffer2+(
+druckbreite-length(puffer2)-length(puffer1))*blank+puffer1.
+verbleibendedruckzeilenzahlbestimmen:druckzeilenzahl:=druckzeilenzahlgrund-
+max(lines(f),lines(g));druckzeilenzahl:=min((maxanzproseiteDIV (
+ausgfeldlaenge-1))*ausgfeldlaenge,druckzeilenzahl).END PROC 
+ueberschriftenvorbereiten;PROC klassenlehrer(TEXT VAR lehrer,TEXT CONST 
+jahrgang,TEXT CONST zug):putwert(fnrsgrpsj,schulkenndatum("Schuljahr"));
+putwert(fnrsgrphj,schulkenndatum("Schulhalbjahr"));putwert(fnrsgrpjgst,
+jahrgang);putwert(fnrsgrpkennung,zug);search(dnraktschuelergruppen,TRUE );IF 
+dbstatus=okTHEN putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,
+TRUE );IF dbstatus=okTHEN lehrer:=wert(fnrlfamname)ELSE lehrer:=""FI ;ELSE 
+lehrer:=""FI END PROC klassenlehrer;PROC ausgabekoepfevorbereiten:LET name=
+"    Familienname",strasse="Straße Hausnummer",telefon="Telefonnummer",
+nrrufname="Nr.   Rufname Namenszusatz",ort="Plz Ort";ausgabekopfslvorbelegen;
+ausgabekopfsrvorbelegen.ausgabekopfslvorbelegen:hilfsfeldervorbelegen;
+spaltenweise(name);spaltenweise(strasse);spaltenweise(telefon);slausgkopf(1)
+:=zeile;spaltenweise(nrrufname);spaltenweise(ort);spaltenweise(blank);
+slausgkopf(2):=zeile;slausgkopf(3):=druckstrich.hilfsfeldervorbelegen:
+setzespaltenbreite(slspalte1breite);setzespaltenbreite(slspalte2breite);
+setzespaltenbreite(slspalte3breite).END PROC ausgabekoepfevorbereiten;PROC 
+ausgabekopfsrvorbelegen:LET srkopft1="    Geburts-  J/M  ",srkopft2=
+"Nr.   datum        ",srkopf1t1="Unterr.   Sprachen  musisches  Wahlpflicht-"
+,srkopf1t2="Religion            Fach       fächer",srkopf2t1="Fächer",
+srkopf2t2="Kurskennungen";IF elementsek1THEN srausgkopf(1):=srkopft1+
+srkopf1t1;srausgkopf(2):=srkopft2+srkopf1t2ELSE srausgkopf(1):=srkopft1+
+srkopf2t1;srausgkopf(2):=srkopft2+srkopf2t2FI ;srausgkopf(3):=druckstrich.
+END PROC ausgabekopfsrvorbelegen;PROC klabuliseitedrucken:
+speicherrechteseiteloeschen;klabulislueberschriftdrucken;anzzaehler:=null;
+seitedrucken(PROC (INT VAR )schuelerdatendrucken,druckzeilenzahl,
+ausgfeldlaenge,PROC bestandendesimulierenbeiklassenwechsel,BOOL PROC 
+multistopsim);IF neueklasseTHEN simuliertesendezuruecknehmen;
+neuelistevorbereitenELSE IF NOT bestandendeTHEN rechteseitedrucken;
+seitenwechselFI FI .speicherrechteseiteloeschen:FOR indexspeicherFROM 1UPTO 
+maxanzproseiteREP speicher(indexspeicher):=niltextPER ;indexspeicher:=null.
+simuliertesendezuruecknehmen:setzebestandende(FALSE ).neuelistevorbereiten:
+leereschuelereintragen;rechteseitedrucken;meldelistewirdgedruckt;
+drucknachbereiten;druckvorbereiten;zaehler:=null;ueberschriftenvorbereiten.
+meldelistewirdgedruckt:meldungstext(mnrlistewirdgedruckt,listewirdgedruckt);
+standardmeldung(listewirdgedruckt,niltext).END PROC klabuliseitedrucken;PROC 
+klabulislueberschriftdrucken:INT VAR i;input(f);WHILE NOT eof(f)REP getline(f
+,ausgfeld(1));druckzeileschreiben(ausgfeld(1));PER ;druckzeileschreiben(
+druckstrich);FOR iFROM 1UPTO ausgkopflaengeREPEAT druckzeileschreiben(
+slausgkopf(i))END REPEAT ;druckzeilenzahlrest:=druckzeilenzahl.END PROC 
+klabulislueberschriftdrucken;PROC bestandendesimulierenbeiklassenwechsel:IF 
+bestandendeTHEN leereschuelereintragen;rechteseitedrucken;neueklasse:=FALSE 
+ELSE nochklassezubearbeiten;IF neueklasseTHEN setzebestandende(TRUE )FI ;FI .
+nochklassezubearbeiten:IF alleTHEN neueklasse:=int(jahrgang)<>int(wert(
+fnrsusgrpjgst));IF neueklasseTHEN ausgabekopfsrvorbelegenFI ;neueklasse:=
+neueklasseOR (zug<>wert(fnrsusgrpzugtut));ELSE neueklasse:=zug<>wert(
+fnrsusgrpzugtut)FI .END PROC bestandendesimulierenbeiklassenwechsel;PROC 
+schuelerdatendrucken(INT VAR zeilenzaehler):LET markiert="#";
+schuelerdatenholen;ggflmeldungklasse;zaehlerINCR 1;anzzaehlerINCR 1;
+schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerdatenindruckdatei.ggflmeldungklasse:IF zaehler=nullTHEN 
+standardmeldung(bearbeitetwird,jahrgang+blank+zug+markiert)FI .END PROC 
+schuelerdatendrucken;PROC schuelerdatenholen:LET weiblich="w",maennlich="m",
+junge="J",maedchen="M",anzsprachen=4,prosprache=3;INT VAR i,j;schuelername:=
+wert(fnrsufamnames);schuelerrufname:=2*blank+wert(fnrsurufnames);
+schuelernamenszus:=wert(fnrsunamenszusatzs);jahrgang:=wert(fnrsusgrpjgst);zug
+:=wert(fnrsusgrpzugtut);schuelerstrasse:=wert(fnrsustrnrs);schuelerort:=wert(
+fnrsuplzorts);schuelertelefon:=wert(fnrsutelnrs);schuelergebdat:=wert(
+fnrsugebdatums);IF wert(fnrsugeschlechts)=weiblichTHEN schuelergeschlecht:=
+maedchenELIF wert(fnrsugeschlechts)=maennlichTHEN schuelergeschlecht:=junge
+ELSE schuelergeschlecht:=blankFI ;IF elementsek1THEN 
+diffdatenholenundaufbereitenELSE schuelerkursfachbez:=niltext;
+schuelerkursartbez:=niltext;kursdatenholenundaufbereitenFI .
+diffdatenholenundaufbereiten:INT VAR difstatus:=0;inittupel(dnrdiffdaten);IF 
+wert(fnrsutiddiffdaten)<>""THEN disablestop;readtid(dnrdiffdaten,wert(
+fnrsutiddiffdaten));IF iserrorTHEN clearerror;difstatus:=1FI ;enablestopFI ;
+IF difstatus=0THEN schuelersprachen:=niltext;sprachenaufbereiten;
+schuelerreliunt:=wert(fnrddreliunter);schuelermusfach:=wert(fnrddkunstmusik);
+schuelerwpffach:=niltext;IF jahrgang="09"THEN wpf9aufbereitenELIF jahrgang=
+"10"THEN wpf10aufbereitenFI FI .sprachenaufbereiten:FOR iFROM 0UPTO 
+anzsprachen-1REP j:=(3*i)+55;puffer1:=wert(j);schuelersprachen:=
+schuelersprachen+puffer1+(prosprache-length(puffer1))*blankPER .
+wpf9aufbereiten:puffer1:=wert(fnrddfach091a);schuelerwpffach:=puffer1+(5-
+length(puffer1))*blank;puffer1:=wert(fnrddfach091b);schuelerwpffach:=
+schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1:=wert(fnrddfach092a
+);schuelerwpffach:=schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1
+:=wert(fnrddfach092b);schuelerwpffach:=schuelerwpffach+puffer1+(5-length(
+puffer1))*blank.wpf10aufbereiten:puffer1:=wert(fnrddfach101a);schuelerwpffach
+:=puffer1+(5-length(puffer1))*blank;puffer1:=wert(fnrddfach101b);
+schuelerwpffach:=schuelerwpffach+puffer1+(5-length(puffer1))*blank;puffer1:=
+wert(fnrddfach102a);schuelerwpffach:=schuelerwpffach+puffer1+(5-length(
+puffer1))*blank;puffer1:=wert(fnrddfach102b);schuelerwpffach:=schuelerwpffach
++puffer1+(5-length(puffer1))*blank.kursdatenholenundaufbereiten:putwert(
+fnrhjdfamnames,schuelername);putwert(fnrhjdrufnames,compress(schuelerrufname)
+);putwert(fnrhjdgebdats,schuelergebdat);putwert(fnrhjdjgst,jahrgang);putwert(
+fnrhjdhj,schulkenndatum("Schulhalbjahr"));search(ixhjdfamrufgebjgsthj,TRUE );
+pause(5);IF dbstatus=okTHEN kursartzuweisenFI .#dr31.03.88kursartzuweisen:
+TEXT VAR suchbegriff:="";FOR iFROM 1UPTO (length(wert(fnrhjdfach))DIV 2)REP 
+puffer1:=wert(fnrhjdkursart)SUB i;schuelerkursartbez:=schuelerkursartbez+
+puffer1+(2-length(puffer1))*blank;suchbegriff:=subtext(wert(fnrhjdfach),(2*i)
+-1,2*i);suchbegriff:=compress(suchbegriff);putwert(fnrffach,suchbegriff);
+search(dnrfaecher,TRUE );IF dbstatus=okTHEN puffer1:=wert(fnrffachbez);
+schuelerkursfachbez:=schuelerkursfachbez+puffer1+(3-length(puffer1))*blank;
+FI ;PER .#kursartzuweisen:TEXT VAR suchbegriff:="";FOR iFROM 1UPTO (length(
+wert(fnrhjdfach))DIV 2)REP suchbegriff:=subtext(wert(fnrhjdfach),(2*i)-1,2*i)
+;suchbegriff:=compress(suchbegriff);putwert(fnrffach,suchbegriff);search(
+dnrfaecher,TRUE );IF dbstatus=okTHEN puffer1:=wert(fnrffach);
+schuelerkursfachbez:=schuelerkursfachbez+text(puffer1,3);puffer1:=wert(
+fnrhjdkursart)SUB i;schuelerkursartbez:=schuelerkursartbez+text(puffer1,3);
+ELSE schuelerkursfachbez:=schuelerkursfachbez+(3*blank);schuelerkursartbez:=
+schuelerkursartbez+(3*blank);FI ;PER .END PROC schuelerdatenholen;PROC 
+schuelerdatenaufbereiten:zaehleraufbereiten;schreibenrnamestrassetelnr;
+schreiberufnameort;datenfuerrechteseitespeichern.schreibenrnamestrassetelnr:
+spaltenweise(zaehleraufber+2*blank+schuelername);spaltenweise(schuelerstrasse
+);spaltenweise(schuelertelefon);ausgfeld(1):=zeile.schreiberufnameort:
+spaltenweise(4*blank+schuelerrufname+blank+schuelernamenszus);spaltenweise(
+schuelerort);spaltenweise(blank);ausgfeld(2):=zeile.
+datenfuerrechteseitespeichern:indexspeicherINCR 1;speicher(indexspeicher):=
+zaehleraufber+2*blank+aufbgebdat+3*blank+schuelergeschlecht;IF elementsek1
+THEN speicher(indexspeicher):=speicher(indexspeicher)+6*blank+aufbreliunt+5*
+blank+schuelersprachen+4*blank+aufbmusfach+6*blank+schuelerwpffach;
+indexspeicherINCR 1ELSE speicher(indexspeicher):=speicher(indexspeicher)+3*
+blank+schuelerkursfachbez;indexspeicherINCR 1;speicher(indexspeicher):=19*
+blank+schuelerkursartbezFI .aufbgebdat:IF schuelergebdat=niltextTHEN 8*blank
+ELSE schuelergebdatFI .aufbreliunt:IF schuelerreliunt=niltextOR (reliabmeld
+AND NOT relianmeld)THEN 2*blankELSE schuelerreliuntFI .reliabmeld:wert(
+fnrddabmeldedatreli)<>nildatumdb.relianmeld:wert(fnrddanmeldedatreli)<>
+nildatumdb.aufbmusfach:IF schuelermusfach=niltextTHEN 2*blankELSE 
+schuelermusfachFI .END PROC schuelerdatenaufbereiten;PROC 
+schuelerdatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfeld(i))PER ;druckzeilenzahlrestDECR ausgfeldlaenge.
+END PROC schuelerdatenindruckdatei;PROC leereschuelereintragen:INT VAR 
+leereschuelermoeglich,i;indexspeicherINCR 1;moeglicheschuelereintragen.
+moeglicheschuelereintragen:leereschuelermoeglich:=druckzeilenzahlrestDIV 
+ausgfeldlaenge;FOR iFROM 1UPTO leereschuelermoeglichREP zaehlerINCR 1;
+zaehleraufbereiten;ausgfeld(1):=text(zaehleraufber,druckbreite);ausgfeld(2):=
+text(blank,druckbreite);schuelerdatenindruckdatei;
+leerenschuelerfuerrechteseitespeichernPER .
+leerenschuelerfuerrechteseitespeichern:anzzaehlerINCR 1;speicher(
+indexspeicher):=text(zaehleraufber,druckbreite);indexspeicherINCR 2.END PROC 
+leereschuelereintragen;PROC rechteseitedrucken:INT VAR i,j;seitenwechsel;
+klabulisrueberschriftdrucken;FOR iFROM 1UPTO anzzaehlerREP j:=2*i;ausgfeld(1)
+:=speicher(j-1);ausgfeld(2):=speicher(j);schuelerdatenindruckdateiPER .END 
+PROC rechteseitedrucken;PROC klabulisrueberschriftdrucken:INT VAR i;input(g);
+WHILE NOT eof(g)REP getline(g,ausgfeld(1));druckzeileschreiben(ausgfeld(1));
+PER ;druckzeileschreiben(druckstrich);FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+druckzeileschreiben(srausgkopf(i))END REPEAT .END PROC 
+klabulisrueberschriftdrucken;PROC zaehleraufbereiten:LET zaehlerzweistellig=
+10;IF zaehler<zaehlerzweistelligTHEN zaehleraufber:=blankELSE zaehleraufber:=
+niltextFI ;zaehleraufber:=zaehleraufber+text(zaehler).END PROC 
+zaehleraufbereiten;END PACKET klassenbuchlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.nachpruefung b/app/schulis/2.2.1/src/1.listen.nachpruefung
new file mode 100644
index 0000000..0247060
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.nachpruefung
@@ -0,0 +1,155 @@
+PACKET nachprueflistenDEFINES nachprlispezielleteile:LET 
+mnrbearbeitetwirdjgst=106,nurimzweitenhj=193,schluesselnachpruefler="n";TEXT 
+VAR aktuellesschuljahr,endewertjgst,startwertjgst,bearbeitetwirdjgst;LET 
+niltext="",blank=" ",mittestrich="-",null=0,ueberschriftenzeilen=2,
+spalte1breite=7,spalte3breite=40,anzspaltentrenner=2,spaltentrenner=":",
+ausgkopflaenge=3,ausgfeldlaenge=4,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF 
+=ROW ausgkopflaengeTEXT ,nachprlieingangsmaske=
+"ms liste versetz nachpr eingang",nachprlianfpos=2;INT CONST 
+spalte2bildbreite:=bildbreite-anzspaltentrenner-spalte1breite-spalte3breite;
+INT VAR spalte2druckbreite,druckzeilenzahl,bildanf,eingabestatus,breite,
+ausgfeldlaengereal;TEXT VAR nachprliueberschrift,schuljahr,jahr1,jahr2,
+schuelername,schuelerrufname,schuelernamenszus,schuelerjgst,schuelerzug,fach1
+,fach2,fach3,paraphe1,paraphe2,paraphe3,jgst,neuejgst,klasse,neueklasse;TEXT 
+VAR druckstrich;TEXT CONST bildstrich:=bildbreite*mittestrich;AUSGFELD VAR 
+ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR sek1,sek2,ersteraufbildschirm,
+klassegeaendert:=FALSE ;PROC nachprlispezielleteile(INT CONST nr):SELECT nr
+OF CASE 1:nachprlidialogvorbereitenCASE 2:nachprlieingabenrichtigCASE 3:
+nachprlilistenvorbereitenCASE 4:nachprlidruckvorbereitenCASE 5:
+nachprliseitedruckenCASE 6:nachprlibildschirmvorbereitenCASE 7:
+nachprliseitezeigenENDSELECT .END PROC nachprlispezielleteile;PROC 
+nachprlidialogvorbereiten:nachprliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(nachprlieingangsmaske,nachprlianfpos)END PROC 
+nachprlidialogvorbereiten;PROC nachprlieingabenrichtig:LET fnrsek1=2,fnrsek2=
+3,fnrjgst=4,fnrausgdrucker=5,fnrausgbild=6,auswahlnichtsinnvoll=56;IF int(
+schulkenndatum("Schulhalbjahr"))=1THEN standardmeldung(nurimzweitenhj,"2.#");
+setzeeingabetest(FALSE )ELSE wohinpruefenFI .wohinpruefen:standardpruefe(5,
+fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus<>0
+THEN infeld(eingabestatus);setzeeingabetest(FALSE )ELSE waspruefenFI .
+waspruefen:sek1:=FALSE ;sek2:=FALSE ;fach1:="";fach2:="";fach3:="";
+reinitparsing;IF standardmaskenfeld(fnrjgst)=niltextTHEN standardpruefe(5,
+fnrsek1,fnrsek2,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE sek1:=standardmaskenfeld(fnrsek2)
+=niltext;sek2:=NOT sek1;setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=
+niltext);setzeeingabetest(TRUE )FI ;ELSE IF (standardmaskenfeld(fnrsek1)=
+niltext)AND (standardmaskenfeld(fnrsek2)=niltext)THEN standardpruefe(3,
+fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE jgst:=zweistellig(
+standardmaskenfeld(fnrjgst));setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;ELSE meldefehler;infeld(
+fnrsek1);setzeeingabetest(FALSE )FI ;FI .meldefehler:standardmeldung(
+auswahlnichtsinnvoll,niltext).END PROC nachprlieingabenrichtig;PROC 
+nachprlilistenvorbereiten:BOOL VAR b;LET schluessel="Schuljahr";
+startwertjgstbestimmen;aktuellesschuljahrermitteln;inittupel(
+dnrhalbjahresdaten);initobli(4);setzeidentiwert("");startwertesetzen;
+objektlistestarten(ixhjdversjhjjgstkenn,"",fnrhjdjgst,TRUE ,b);
+setzebestandende(NOT multistopnachprueflerCOR b).startwertjgstbestimmen:
+aktuellesschuljahr:=schulkenndatum("Schuljahr");endewertjgst:=endeberechnung;
+startwertjgst:=anfangsberechnung;.anfangsberechnung:IF sek1THEN "05"ELIF sek2
+THEN "11"ELSE jgstFI .endeberechnung:IF sek1THEN "11"ELIF sek2THEN "14"ELSE 
+text(int(jgst)+1)FI .startwertesetzen:putwert(fnrhjdversetzung,
+schluesselnachpruefler);putwert(fnrhjdjgst,startwertjgst);putwert(fnrhjdsj,
+aktuellesschuljahr);putintwert(fnrhjdhj,2).aktuellesschuljahrermitteln:
+schuljahr:=schulkenndatum(schluessel);jahr1:=subtext(schuljahr,1,2);jahr2:=
+subtext(schuljahr,3,4).END PROC nachprlilistenvorbereiten;PROC 
+nachprlibildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren
+(nachprliueberschrift);breite:=bildbreite;initspalten;setzespaltentrenner(
+spaltentrenner);setzespaltenbreiten(spalte2bildbreite);initausgabekopf(
+bildstrich);bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaenge
+REPEAT ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;
+setzebildanfangsposition(bildanf).END PROC nachprlibildschirmvorbereiten;
+PROC nachprliseitezeigen:setzescanstartwert(startwertjgst);setzescanendewert(
+endewertjgst);blaettern(PROC (INT CONST )schuelerzeigen,aktion,TRUE ,TRUE ,
+BOOL PROC multistopnachpruefler);setzescanstartwert("");setzescanendewert("�"
+).#endewertjgstpluseinsbeigleichheit:IF startwertjgst=endewertjgstTHEN text(
+int(endewertjgst)+1)ELSE endewertjgstFI .#END PROC nachprliseitezeigen;PROC 
+schuelerzeigen(INT CONST x):schuelerholen;IF ersteraufbildschirmTHEN 
+klassegeaendert:=TRUE ;ersteraufbildschirm:=FALSE FI ;schueleraufbereiten;
+schueleraufbildschirm.END PROC schuelerzeigen;PROC schueleraufbildschirm:INT 
+VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeinsEND REPEAT .END PROC schueleraufbildschirm;PROC 
+nachprlidruckvorbereiten:LET uebteil11=
+"Liste der zur Nachprüfung berechtigten Schüler, ",uebteil12="Sek.I",
+uebteil13="Sek.II",uebteil14="Jgst. ",uebteil2="Schuljahr: ";TEXT VAR 
+ueberschrift1,ueberschrift2;ueberschriftvorbereitendruck;jgst:=niltext;klasse
+:=niltext;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(
+ueberschrift1,ueberschrift2);breite:=druckbreite;initspalten;
+setzespaltentrenner(spaltentrenner);setzespaltenbreiten(spalte2druckbreite);
+initausgabekopf(druckstrich);holemeldungen;setzewerte;lesenvorbereitendruck(
+PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC 
+multistopnachprueflersim).holemeldungen:meldungstext(mnrbearbeitetwirdjgst,
+bearbeitetwirdjgst).setzewerte:inittupel(dnrhalbjahresdaten);putwert(
+fnrhjdversetzung,schluesselnachpruefler);putwert(fnrhjdjgst,startwertjgst);
+putwert(fnrhjdsj,aktuellesschuljahr);putintwert(fnrhjdhj,2).
+ueberschriftvorbereitendruck:ueberschrift1:=uebteil11;IF sek1THEN 
+ueberschrift1:=ueberschrift1+uebteil12ELSE IF sek2THEN ueberschrift1:=
+ueberschrift1+uebteil13ELSE ueberschrift1:=ueberschrift1+uebteil14+jgstFI ;
+FI ;ueberschrift2:=uebteil2+aufbereitetesschuljahr.aufbereitetesschuljahr:
+"19"+jahr1+"/"+jahr2.variablenfuerdrucksetzen:druckstrich:=druckbreite*
+mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner-spalte1breite-
+spalte3breite;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-
+ausgkopflaenge.END PROC nachprlidruckvorbereiten;PROC nachprliseitedrucken:
+nachprliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopnachprueflersim);
+seitenwechsel.END PROC nachprliseitedrucken;PROC nachprliueberschriftdrucken:
+druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC 
+nachprliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET 
+markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE 
+FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaengereal;
+schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI .
+jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung:
+standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END 
+PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengerealREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END 
+PROC schuelerindruckdatei;PROC setzespaltenbreiten(INT CONST spalte2breite):
+setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2breite);
+setzespaltenbreite(spalte3breite);END PROC setzespaltenbreiten;PROC 
+initausgabekopf(TEXT CONST strich):LET jgst="Jgst.",zugtut="Zug/Tut",name=
+"Familienname",rufname="  Rufname",rest1=
+"Meldg. :Prüfer        :Datum  :    :    ",rest2=
+"  :Fach:Fach:Vors:Beis:   Zeit:Raum:Note";spaltenweise(jgst);spaltenweise(
+name);spaltenweise(rest1);ausgkopf(1):=zeile;spaltenweise(zugtut);
+spaltenweise(rufname);spaltenweise(rest2);ausgkopf(2):=zeile;ausgkopf(3):=
+strich;END PROC initausgabekopf;PROC schuelerholen:schuelername:=wert(
+fnrhjdfamnames);schuelerrufname:=wert(fnrhjdrufnames);#schuelernamenszus:=
+wert(fnrhjdzusatz);#schuelernamenszus:="";schuelerjgst:=wert(fnrhjdjgst);
+schuelerzug:=wert(fnrhjdkennung);fach1:=wert(fnrhjdnachfach1);fach2:=wert(
+fnrhjdnachfach2);fach3:=wert(fnrhjdnachfach3);fachlehrersuchen(fach1,paraphe1
+);fachlehrersuchen(fach2,paraphe2);fachlehrersuchen(fach3,paraphe3);
+neueklasse:=schuelerjgst+schuelerzug;klassegeaendert:=klasse<>neueklasse;
+klasse:=neueklasse.END PROC schuelerholen;PROC fachlehrersuchen(TEXT CONST 
+fach,TEXT VAR paraphe):putwert(fnrlvhj,wert(fnrhjdhj));putwert(fnrlvsj,wert(
+fnrhjdsj));putwert(fnrlvjgst,wert(fnrhjdjgst));#putwert(fnrlvzug,wert(
+fnrhjdkennung));#putwert(fnrlvfachkennung,fach+wert(fnrhjdkennung));search(
+dnrlehrveranstaltungen,TRUE );IF dbstatus=okTHEN paraphe:=wert(fnrlvparaphe)
+ELSE paraphe:=""FI END PROC fachlehrersuchen;PROC schueleraufbereiten:LET 
+zwizeile="  :    :    :    :    :       :    :";INT VAR posausgfeld;
+posausgfeld:=null;schreibeklassenamefach1;schreiberufnamefach2;IF 
+ausgabedruckerTHEN schreibeggffach3ELSE schreibefach3FI ;
+schreibezwischenzeile.schreibeklassenamefach1:spaltenweise(aufbschuelerklasse
+);spaltenweise(aufbschuelername);spaltenweise(aufbfach1);posausgfeldINCR 1;
+ausgfeld(posausgfeld):=zeile;posausgfeldINCR 1.schreiberufnamefach2:
+spaltenweise(blank);spaltenweise(aufbrufname);spaltenweise(aufbfach2);
+ausgfeld(posausgfeld):=zeile;posausgfeldINCR 1.schreibeggffach3:IF fach3<>
+niltextTHEN schreibefach3FI ;ausgfeldlaengereal:=posausgfeld.schreibefach3:
+spaltenweise(blank);spaltenweise(blank);spaltenweise(aufbfach3);ausgfeld(
+posausgfeld):=zeile;posausgfeldINCR 1.schreibezwischenzeile:spaltenweise(
+blank);spaltenweise(blank);spaltenweise(zwizeile);ausgfeld(posausgfeld):=
+zeile.aufbschuelerklasse:IF klassegeaendertTHEN schuelerjgst+blank+
+schuelerzugELSE blankFI .aufbschuelername:IF schuelernamenszus=niltextTHEN 
+schuelernameELSE schuelernamenszus+blank+schuelernameFI .aufbfach1:aufbfach(
+fach1,paraphe1).aufbrufname:2*blank+schuelerrufname.aufbfach2:aufbfach(fach2,
+paraphe2).aufbfach3:aufbfach(fach3,paraphe3).END PROC schueleraufbereiten;
+TEXT PROC aufbfach(TEXT CONST fach,paraphe):LET vorfach="__: ",nachfach=
+":____:____:_______:____:____";vorfach+fach+(3-length(fach))*blank+
+spaltentrenner+paraphe+(4-length(paraphe))*blank+nachfach.END PROC aufbfach;
+BOOL PROC elementsek1:sek1COR int(startwertjgst)<11ENDPROC elementsek1;BOOL 
+PROC multistopnachpruefler:BOOL VAR b;b:=nachprueflerundrichtigesdatumCAND 
+int(wert(fnrhjdjgst))>=int(startwertjgst)CAND int(wert(fnrhjdjgst))<#=#int(
+endewertjgst);b.nachprueflerundrichtigesdatum:wert(fnrhjdversetzung)=
+schluesselnachprueflerCAND wert(fnrhjdsj)=aktuellesschuljahrCAND wert(
+fnrhjdhj)="2".ENDPROC multistopnachpruefler;BOOL PROC 
+multistopnachprueflersim:BOOL VAR b:=multistopnachpruefler;setzebestandende(
+NOT b);bENDPROC multistopnachprueflersim;END PACKET nachprueflisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.neuan b/app/schulis/2.2.1/src/1.listen.neuan
new file mode 100644
index 0000000..6fd7fc5
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.neuan
@@ -0,0 +1,121 @@
+PACKET neuanlistenDEFINES neuanlispezielleteile:LET niltext="",blank=" ",
+mittestrich="-",null=0,komma=",",ueberschriftenzeilen=2,nname="Name",schule=
+"Schule",klasse="Klasse",spalte3breite=6,anzspaltentrenner=2,ausgkopflaenge=2
+,ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW 
+ausgkopflaengeTEXT ,neuanlieingangsmaske="ms liste neuanmeld eingang",
+neuanlianfpos=2,#fnrsustatuss=6,fnrsunamenszusatzs=21,fnrsuskennlschule=14,
+fnrsuklasselschule=15,ixsustatschulkenn=253,ixsustatfamrufgeb=254dnrschueler=
+2,dnrschulen=120,fnrschkennung=121,fnrschname=122,#mnrbearbeitetwerdenschulen
+=101,mnrbearbeitetwerdenschueler=102;INT CONST spalte1bildbreite:=(bildbreite
+-anzspaltentrenner-spalte3breite)DIV 2,spalte2bildbreite:=spalte1bildbreite;#
+bildsatzzahl:=(bildlaenge-ausgkopflaenge)DIV ausgfeldlaenge,bildblocklaenge:=
+(bildsatzzahl+1)DIV 2;#INT VAR spalte1druckbreite,spalte2druckbreite,
+druckzeilenzahl,bildanf,eingabestatus,aktuelleindexnr;TEXT VAR schuljahr,
+schuelername,schuelerrufname,schuelernamenszus,schuelerherkschule,
+schuelerherkklasse,schuelernameaufber,jahrgang,#sortbest,#anfbuchstabe,
+neueranfbuchstabe,startwert,bearbeitetwerdenschulen,bearbeitetwerdenschueler;
+TEXT VAR druckstrich;TEXT CONST bildstrich:=bildbreite*mittestrich;AUSGFELD 
+VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR sortalpha,jgst5,jgst11;BOOL PROC 
+multistop:BOOL VAR b;IF jgst5THEN b:=wert(fnrsustatuss)="n05"ELIF jgst11THEN 
+b:=wert(fnrsustatuss)="n11"ELSE b:=wert(fnrsustatuss)="nso"FI ;bENDPROC 
+multistop;BOOL PROC multistopsim:BOOL VAR b:=multistop;setzebestandende(NOT b
+);bENDPROC multistopsim;PROC neuanlispezielleteile(INT CONST nr):SELECT nrOF 
+CASE 1:neuanlidialogvorbereitenCASE 2:neuanlieingabenrichtigCASE 3:
+neuanlilistenvorbereitenCASE 4:neuanlidruckvorbereitenCASE 5:
+neuanliseitedruckenCASE 6:neuanlibildschirmvorbereitenCASE 7:
+neuanliseitezeigenENDSELECT .END PROC neuanlispezielleteile;PROC 
+neuanlidialogvorbereiten:setzeanfangswerte(neuanlieingangsmaske,neuanlianfpos
+)END PROC neuanlidialogvorbereiten;PROC neuanlieingabenrichtig:LET fnrjgst5=2
+,fnrjgst11=3,fnrjgstsonst=4,fnrsortalpha=5,fnrsortschule=6,fnrausgdrucker=7,
+fnrausgbild=8;standardpruefe(5,fnrjgst5,fnrjgstsonst,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE standardpruefe(5,fnrsortalpha,fnrsortschule,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);setzeeingabetest
+(FALSE )ELSE jgst5:=standardmaskenfeld(fnrjgst5)<>niltext;jgst11:=
+standardmaskenfeld(fnrjgst11)<>niltext;sortalpha:=standardmaskenfeld(
+fnrsortschule)=niltext;#note("-->"+standardmaskenfeld(fnrsortschule)+"<--");
+noteline;#setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);
+setzeeingabetest(TRUE )FI FI FI .END PROC neuanlieingabenrichtig;PROC 
+neuanlilistenvorbereiten:LET fuenf="05",elf="11",sonst="sonst";BOOL VAR b:=
+FALSE ;IF jgst5THEN jahrgang:=fuenf;startwert:="n05"ELSE IF jgst11THEN 
+jahrgang:=elf;startwert:="n11"ELSE jahrgang:=sonst;startwert:="nso"FI ;FI ;
+IF sortalphaTHEN aktuelleindexnr:=ixsustatfamrufgebELSE aktuelleindexnr:=
+ixsustatschulkennFI ;#note("Nr,: "+text(aktuelleindexnr));noteline;#inittupel
+(dnrschueler);initobli(8);parsenooffields(21);setzeidentiwert("");putwert(
+fnrsustatuss,startwert);#objektlistestarten(aktuelleindexnr,"",fnrsustatuss,
+TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield,TRUE ,b);
+setzebestandende(b).staticfield:IF sortalphaTHEN dnrschueler+1ELSE 
+fnrsuskennlschuleFI .END PROC neuanlilistenvorbereiten;PROC 
+neuanlibildschirmvorbereiten:LET fnrausganf=2,aufein="",aufaus=" ",
+neuanliueberschriftneu1="Liste der Neuanmeldungen zur Jgst. ",
+neuanliueberschriftneu2="Liste der sonstigen Neuanmeldungen";
+standardkopfmaskeaktualisieren(neueueberschrift);initspalten;
+setzespaltenbreite(spalte1bildbreite);setzespaltenbreite(spalte2bildbreite);
+setzespaltenbreite(spalte3breite);initausgabekopf(bildstrich);bildanf:=
+fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT ausgkopf(i)IN 
+bildanf;bildanfINCR 1END REPEAT ;setzebildanfangsposition(bildanf).
+neueueberschrift:IF (jgst5OR jgst11)THEN neuanliueberschriftneu1+aufein+
+jahrgang+aufausELSE neuanliueberschriftneu2FI .END PROC 
+neuanlibildschirmvorbereiten;PROC neuanliseitezeigen:blaettern(PROC (INT 
+CONST )schuelerzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END PROC 
+neuanliseitezeigen;PROC schuelerzeigen(INT CONST x):schuelerholen;
+schueleraufbereiten;schueleraufbildschirmEND PROC schuelerzeigen;PROC 
+schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld
+(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC 
+schueleraufbildschirm;PROC neuanlidruckvorbereiten:LET schluessel="Schuljahr"
+,uebteil1="Folgende Schüler wurden zum Schuljahr ",uebteil2=" für die",
+uebteil31="Jahrgangsstufe ",uebteil32="sonstigen Jahrgangsstufen ",uebteil4=
+" angemeldet:";TEXT VAR ueberschrift1,ueberschrift2;anfbuchstabe:=blank;
+druckvorbereiten;variablenfuerdrucksetzen;ueberschriftvorbereitendruck;
+initdruckkopf(ueberschrift1,ueberschrift2);initspalten;setzespaltenbreite(
+spalte1druckbreite);setzespaltenbreite(spalte2druckbreite);setzespaltenbreite
+(spalte3breite);initausgabekopf(druckstrich);holemeldungen;inittupel(
+dnrschueler);putwert(fnrsustatuss,startwert);lesenvorbereitendruck(PROC (INT 
+CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistopsim).
+variablenfuerdrucksetzen:druckstrich:=druckbreite*mittestrich;
+spalte1druckbreite:=(druckbreite-anzspaltentrenner-spalte3breite)DIV 2;
+spalte2druckbreite:=spalte1druckbreite;druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen)-ausgkopflaenge.ueberschriftvorbereitendruck:schuljahr:=
+schulkenndatum(schluessel);schuljahraufbereiten;ueberschrift1:=uebteil1+
+schuljahr+uebteil2;IF (jgst5OR jgst11)THEN ueberschrift2:=uebteil31+jahrgang+
+uebteil4ELSE ueberschrift2:=uebteil32+uebteil4FI .schuljahraufbereiten:
+schuljahr:="19"+subtext(schuljahr,1,2)+"/"+subtext(schuljahr,3,4).
+holemeldungen:meldungstext(mnrbearbeitetwerdenschulen,bearbeitetwerdenschulen
+);meldungstext(mnrbearbeitetwerdenschueler,bearbeitetwerdenschueler).END 
+PROC neuanlidruckvorbereiten;PROC neuanliseitedrucken:
+neuanliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END 
+PROC neuanliseitedrucken;PROC neuanliueberschriftdrucken:druckkopfschreiben;
+INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT druckzeileschreiben(ausgkopf(i
+))END REPEAT .END PROC neuanliueberschriftdrucken;PROC schuelerdrucken(INT 
+VAR zeilenzaehler):LET markiert="#";schuelerholen;ggflmeldunganfbuchstabe;
+schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;schuelerindruckdatei.
+ggflmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN zwischenmeldungFI .
+anfbuchstabegeaendert:IF sortalphaTHEN neueranfbuchstabe:=schuelernameSUB 1
+ELSE neueranfbuchstabe:=schuelerherkschuleSUB 1FI ;anfbuchstabe<>
+neueranfbuchstabe.zwischenmeldung:IF sortalphaTHEN standardmeldung(
+bearbeitetwerdenschueler,neueranfbuchstabe+markiert)ELSE standardmeldung(
+bearbeitetwerdenschulen,neueranfbuchstabe+markiert)FI ;anfbuchstabe:=
+neueranfbuchstabe;END PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR 
+i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END 
+REPEAT .END PROC schuelerindruckdatei;PROC initausgabekopf(TEXT CONST strich)
+:spaltenweise(nname);spaltenweise(schule);spaltenweise(klasse);ausgkopf(1):=
+zeile;ausgkopf(2):=strich;END PROC initausgabekopf;PROC schuelerholen:
+schuelername:=wert(3);schuelerrufname:=2*blank+wert(4);schuelernamenszus:=
+wert(fnrsunamenszusatzs);sucheschule;schuelerherkklasse:=wert(
+fnrsuklasselschule).sucheschule:putwert(fnrschkennung,wert(fnrsuskennlschule)
+);search(dnrschulen,TRUE );IF dbstatus=okTHEN schuelerherkschule:=wert(
+fnrschname)ELSE schuelerherkschule:=wert(fnrsuskennlschule)FI .END PROC 
+schuelerholen;PROC schueleraufbereiten:schuelernameaufbereiten;
+schreibenameschuleklasse;schreiberufname.schreibenameschuleklasse:
+spaltenweise(schuelernameaufber);spaltenweise(schuelerherkschule);
+spaltenweise(schuelerherkklasse);ausgfeld(1):=zeile.schreiberufname:
+spaltenweise(schuelerrufname);spaltenweise(blank);spaltenweise(blank);
+ausgfeld(2):=zeile.END PROC schueleraufbereiten;PROC schuelernameaufbereiten:
+schuelernameaufber:=niltext;IF schuelernamenszus<>niltextTHEN 
+schuelernameaufber:=schuelernamenszus+blankFI ;schuelernameaufber:=
+schuelernameaufber+schuelername+komma;END PROC schuelernameaufbereiten;END 
+PACKET neuanlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz b/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz
new file mode 100644
index 0000000..976d67c
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.prot versetzkonferenz
@@ -0,0 +1,162 @@
+PACKET protversetzkonflistenDEFINES konfprolispezielleteile:LET 
+mnrbearbeitetwirdjgst=106,mnrbearbeitetwirdklasse=107,mnrbearbeitetwirdkurs=
+108;TEXT VAR bearbeitetwirdjgst,bearbeitetwirdklasse,bearbeitetwirdkurs,
+startjahr,startzug;INT VAR aktuelleindexnr;LET niltext="",nildatum="01.01.00"
+,null=0,blank=" ",mittestrich="-",doppelpunkt=":",vordr1ueberarb=
+"vordruck1 ueberarbeitet",vordr2ueberarb="vordruck2 ueberarbeitet",
+vordr3ueberarb="vordruck3 ueberarbeitet",spalte2breite=52,anzspaltentrenner=1
+,ausgkopflaenge=3,ausgfeldlaenge=2,AUSGFELD =ROW ausgfeldlaengeTEXT ,
+AUSGKOPF =ROW ausgkopflaengeTEXT ,konfprolieingangsmaske=
+"ms liste konfpro eingang",konfprolianfpos=2;INT VAR spalte1breite,
+druckzeilenzahl,druckzeilenzahlrest,zeilenanz,schuelerzaehler,eingabestatus;
+TEXT VAR konfproliueberschrift,zug,jahrgang,schuelername,schuelerrufname,
+schuelernamenszus,schuelergebdat,zugangjgst,abmeldedat,schuelerjgst,
+schuelerzug,vordruck,vordruckueberarbeitet,druckstrich;AUSGFELD VAR 
+ausgfelddruck;AUSGKOPF VAR ausgkopfdruck;BOOL VAR sek1,einjahrgang,alle,
+neuesmerkmal;FILE VAR f;PROC konfprolispezielleteile(INT CONST nr):SELECT nr
+OF CASE 1:konfprolidialogvorbereitenCASE 2:konfprolieingabenrichtigCASE 3:
+konfprolilistenvorbereitenCASE 4:konfprolidruckvorbereitenCASE 5:
+konfproliseitedruckenENDSELECT .END PROC konfprolispezielleteile;PROC 
+konfprolidialogvorbereiten:konfproliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(konfprolieingangsmaske,konfprolianfpos).END PROC 
+konfprolidialogvorbereiten;PROC konfprolieingabenrichtig:LET fnrmskjgst=2,
+fnrmskzug=3,auswahlnichtsinnvoll=56;sek1:=FALSE ;alle:=FALSE ;einjahrgang:=
+FALSE ;jahrgang:="";zug:=compress(standardmaskenfeld(fnrmskzug));IF 
+standardmaskenfeld(fnrmskjgst)=niltextTHEN IF zug=niltextTHEN alle:=TRUE ;
+sek1:=TRUE ;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )ELSE 
+meldefehler;infeld(fnrmskzug);setzeeingabetest(FALSE )FI ELSE standardpruefe(
+3,fnrmskjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE jahrgang:=zweistellig(
+standardmaskenfeld(fnrmskjgst));einjahrgang:=(zug=niltext);IF int(jahrgang)<
+11THEN sek1:=TRUE FI ;setzeausgabedrucker(TRUE );setzeeingabetest(TRUE )FI 
+FI .meldefehler:standardmeldung(auswahlnichtsinnvoll,niltext).END PROC 
+konfprolieingabenrichtig;PROC konfprolilistenvorbereiten:BOOL VAR b:=FALSE ;
+startjahr:=jahrgang;startzug:=zug;IF startjahr>"10"CAND startzug=niltextTHEN 
+aktuelleindexnr:=ixsustatjgstELSE aktuelleindexnr:=ixsustatjgstzugFI ;
+dbstatus(ok);inittupel(dnrschueler);initobli(1);parsenooffields(19);
+setzeidentiwert("");putwert(fnrsusgrpjgst,startjahr);putwert(fnrsusgrpzugtut,
+startzug);putwert(fnrsustatuss,"ls");#objektlistestarten(aktuelleindexnr,"",
+fnrsusgrpjgst,TRUE ,b);#objektlistestarten(aktuelleindexnr,"",staticfield,
+TRUE ,b);setzebestandende(NOT multistopkonf).staticfield:IF aktuelleindexnr=
+ixsustatjgstzugTHEN fnrsusgrpzugtutELSE dnrschueler+1FI .END PROC 
+konfprolilistenvorbereiten;PROC konfprolidruckvorbereiten:LET prevordruck=
+"vordruck",postvordruck=" protokoll versetzkonf",vordr3=
+"vordruck3 protokoll versetzkonf",anzvordrucke=3,manager="anschreiben server"
+;INT VAR i;schuelerzaehler:=null;jahrgang:=wert(fnrsusgrpjgst);zug:=wert(
+fnrsusgrpzugtut);aktuellevordruckevommanagerholen;neuesmerkmal:=TRUE ;
+druckvorbereiten;variablenfuerdrucksetzen;vordruck3fuellen;
+setzesonderwerteschulkenndaten;holemeldungen;putwert(dateinr(primdatid(
+aktuelleindexnr))+1,"");putwert(fnrsusgrpjgst,startjahr);putwert(
+fnrsusgrpzugtut,startzug);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,
+INT VAR )scanforward,BOOL PROC multistopkonfsim);initspalten;
+initausgabekopfdruck.holemeldungen:meldungstext(mnrbearbeitetwirdjgst,
+bearbeitetwirdjgst);meldungstext(mnrbearbeitetwirdklasse,bearbeitetwirdklasse
+);meldungstext(mnrbearbeitetwirdkurs,bearbeitetwirdkurs).
+aktuellevordruckevommanagerholen:FOR iFROM 1UPTO anzvordruckeREP forget(
+prevordruck+text(i)+postvordruck,quiet);fetch(prevordruck+text(i)+
+postvordruck,/manager);PER .variablenfuerdrucksetzen:druckstrich:=druckbreite
+*mittestrich;spalte1breite:=druckbreite-anzspaltentrenner-spalte2breite.
+vordruck3fuellen:vordruck:=vordr3;vordruckueberarbeitet:=vordr3ueberarb;
+forget(vordruckueberarbeitet,quiet);briefalternative(vordruck,
+vordruckueberarbeitet).END PROC konfprolidruckvorbereiten;PROC 
+initausgabekopfdruck:LET name="   :Familienname",rufname="   :  Rufname",
+rest1="        :    :Erg.  :Fächer:",rest2=
+"Geb.dat.:Bem.:v/w/n :Nachpr:Gründe";hilfsfeldervorbelegen;spaltenweise(name)
+;spaltenweise(rest1);ausgkopfdruck(1):=zeile;spaltenweise(rufname);
+spaltenweise(rest2);ausgkopfdruck(2):=zeile;ausgkopfdruck(3):=druckstrich.
+hilfsfeldervorbelegen:setzespaltentrenner(blank);setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2breite).END PROC 
+initausgabekopfdruck;PROC konfproliseitedrucken:LET listewirdgedruckt=58;
+konfproliueberschriftdrucken;seitedrucken(PROC (INT VAR )schuelerdatendrucken
+,druckzeilenzahl,ausgfeldlaenge,PROC bestandendesimulierenbeimerkmalwechsel,
+BOOL PROC multistopkonfsim);IF neuesmerkmalTHEN simuliertesendezuruecknehmen;
+konfproliunterschriftdrucken;meldelistewirdgedruckt;drucknachbereiten;
+schuelerzaehler:=null;neuelistevorbereitenELIF NOT bestandendeTHEN 
+seitenwechselFI .simuliertesendezuruecknehmen:setzebestandende(FALSE ).
+meldelistewirdgedruckt:standardmeldung(listewirdgedruckt,niltext).
+neuelistevorbereiten:druckvorbereiten.END PROC konfproliseitedrucken;PROC 
+konfproliueberschriftdrucken:LET vordr1="vordruck1 protokoll versetzkonf",
+vordr2="vordruck2 protokoll versetzkonf",anzleerzeilen=2,markiert="#";INT 
+VAR i;TEXT VAR klassejgstaufber;IF neuesmerkmalTHEN 
+zwischenmeldungundvordruckefuellenFI ;vordruck1schreiben;IF neuesmerkmalTHEN 
+vordruck2schreibenFI ;leerzeilenschreiben;ausgabekopfschreiben.
+zwischenmeldungundvordruckefuellen:LET swiklassebzwjgst=511,
+swianwesendelehrer=512,klasse="Klasse ",kurs="Tutorenkurs ",jgst="Jgst. ";
+klassejgstaufber:=jahrgang;IF (alleOR einjahrgang)AND NOT sek1THEN 
+standardmeldung(bearbeitetwirdjgst,klassejgstaufber+markiert);
+klassejgstaufber:=jgst+klassejgstaufberELSE klassejgstaufber:=
+klassejgstaufber+blank+zug;IF sek1THEN standardmeldung(bearbeitetwirdklasse,
+klassejgstaufber+markiert);klassejgstaufber:=klasse+klassejgstaufberELSE 
+standardmeldung(bearbeitetwirdkurs,klassejgstaufber+markiert);
+klassejgstaufber:=kurs+klassejgstaufberFI ;FI ;festesonderwertesetzen;
+vordruck:=vordr1;vordruckueberarbeitet:=vordr1ueberarb;forget(
+vordruckueberarbeitet,quiet);briefalternative(vordruck,vordruckueberarbeitet)
+;vordruck:=vordr2;vordruckueberarbeitet:=vordr2ueberarb;forget(
+vordruckueberarbeitet,quiet);briefalternative(vordruck,vordruckueberarbeitet)
+.festesonderwertesetzen:setzesonderwert(swiklassebzwjgst,klassejgstaufber);
+setzesonderwert(swianwesendelehrer,blank).vordruck2schreiben:
+vordruckueberarbeitet:=vordr2ueberarb;f:=sequentialfile(input,
+vordruckueberarbeitet);zeilenanz:=lines(f);FOR iFROM 1UPTO zeilenanzREP 
+getline(f,ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1));PER ;
+druckzeilenzahlDECR zeilenanz.leerzeilenschreiben:FOR iFROM 1UPTO 
+anzleerzeilenREP druckzeileschreiben(blank)PER ;druckzeilenzahlDECR 
+anzleerzeilen.ausgabekopfschreiben:FOR iFROM 1UPTO ausgkopflaengeREP 
+druckzeileschreiben(ausgkopfdruck(i))PER ;druckzeilenzahlDECR ausgkopflaenge;
+druckzeilenzahlrest:=druckzeilenzahl.END PROC konfproliueberschriftdrucken;
+PROC konfproliunterschriftdrucken:INT VAR i;vordruck3holen;vordruck3schreiben
+.vordruck3holen:vordruckueberarbeitet:=vordr3ueberarb;f:=sequentialfile(input
+,vordruckueberarbeitet);zeilenanz:=lines(f).vordruck3schreiben:IF zeilenanz>
+druckzeilenzahlrestTHEN seitenwechselmitneuemkopfFI ;FOR iFROM 1UPTO 
+zeilenanzREP getline(f,ausgfelddruck(1));druckzeileschreiben(ausgfelddruck(1)
+);PER ;druckzeilenzahlrestDECR zeilenanz.seitenwechselmitneuemkopf:
+seitenwechsel;vordruck1schreiben;druckzeilenzahlrest:=druckzeilenzahl;
+vordruck3holen.END PROC konfproliunterschriftdrucken;PROC vordruck1schreiben:
+INT VAR i;druckzeilenzahl:=drucklaenge;vordruckueberarbeitet:=vordr1ueberarb;
+f:=sequentialfile(input,vordruckueberarbeitet);zeilenanz:=lines(f);FOR iFROM 
+1UPTO zeilenanzREP getline(f,ausgfelddruck(1));druckzeileschreiben(
+ausgfelddruck(1));PER ;druckzeilenzahlDECR zeilenanz.END PROC 
+vordruck1schreiben;PROC schuelerdatendrucken(INT VAR zeilenzaehler):
+schuelerdatenholen;schuelerdatenaufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerdatenindruckdatei.END PROC schuelerdatendrucken;PROC 
+schuelerdatenholen:schuelername:=wert(fnrsufamnames);schuelerrufname:=wert(
+fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);schuelergebdat:=
+wert(fnrsugebdatums);zugangjgst:=wert(fnrsuartzugang);abmeldedat:=wert(
+fnrsuabgdats);schuelerjgst:=wert(fnrsusgrpjgst);schuelerzug:=wert(
+fnrsusgrpzugtut).END PROC schuelerdatenholen;PROC schuelerdatenaufbereiten:
+LET unterstrich="_",bem1="w",bem2="x",abgemeldet="ab",gebdatlaenge=8,
+zugangjgstlaenge=4,ausgleich1=3,ausgleich2=2,abgemlaenge1=4,abgemlaenge2=2,
+rest1=":      :      :",rest2=":______:______:________________________";
+schuelerzaehlerINCR 1;schreibenamegebdatbemerkungen.
+schreibenamegebdatbemerkungen:setzespaltentrenner(blank);spaltenweise(
+schuelernameundnraufber);spaltenweise(schuelerbemteil1aufber);ausgfelddruck(1
+):=zeile;setzespaltentrenner(unterstrich);spaltenweise(schuelerrufnameaufber)
+;spaltenweise(schuelerbemteil2aufber);ausgfelddruck(2):=zeile.
+schuelernameundnraufber:IF schuelernamenszus=niltextTHEN nr+doppelpunkt+
+schuelernameELSE nr+doppelpunkt+schuelernamenszus+blank+schuelernameFI .nr:(
+ausgleich1-length(text(schuelerzaehler)))*blank+text(schuelerzaehler).
+schuelerbemteil1aufber:gebdatlaenge*blank+doppelpunkt+zugangjgstaufber+rest1.
+zugangjgstaufber:IF (zugangjgst=bem1)OR (zugangjgst=bem2)THEN zugangjgst+(
+zugangjgstlaenge-length(zugangjgst))*blankELSE zugangjgstlaenge*blankFI .
+schuelerrufnameaufber:ausgleich1*unterstrich+doppelpunkt+ausgleich2*
+unterstrich+schuelerrufname+anzunterstriche*unterstrich.
+schuelerbemteil2aufber:schuelergebdat+doppelpunkt+abgemeldetaufber+rest2.
+anzunterstriche:spalte1breite-ausgleich2-length(schuelerrufname).
+abgemeldetaufber:IF abmeldedat=nildatumTHEN abgemlaenge1*unterstrichELSE 
+abgemeldet+abgemlaenge2*unterstrichFI .END PROC schuelerdatenaufbereiten;
+PROC schuelerdatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfelddruck(i))PER ;druckzeilenzahlrestDECR 
+ausgfeldlaenge.END PROC schuelerdatenindruckdatei;PROC 
+bestandendesimulierenbeimerkmalwechsel:IF bestandendeTHEN neuesmerkmal:=
+FALSE ;konfproliunterschriftdruckenELSE nochklassebzwjgstzubearbeiten;IF 
+neuesmerkmalTHEN setzebestandende(TRUE )FI ;FI .nochklassebzwjgstzubearbeiten
+:jahrgang:=wert(fnrsusgrpjgst);zug:=wert(fnrsusgrpzugtut);neuesmerkmal:=
+neuejgst;IF neuesmerkmalAND int(jahrgang)>10THEN sek1:=FALSE FI ;IF sek1THEN 
+neuesmerkmal:=neuesmerkmalOR neuerzugFI .neuejgst:schuelerjgst<>jahrgang.
+neuerzug:schuelerzug<>zug.END PROC bestandendesimulierenbeimerkmalwechsel;
+BOOL PROC multistopkonf:BOOL VAR b:=#TRUE ;#FALSE ;IF wert(fnrsustatuss)="ls"
+THEN b:=TRUE ;IF startjahr<>""THEN IF startzug=niltextTHEN b:=(wert(
+fnrsusgrpjgst)=startjahr)ELSE b:=(wert(fnrsusgrpzugtut)=startzugAND wert(
+fnrsusgrpjgst)=startjahr)FI ;FI ;FI ;bEND PROC multistopkonf;BOOL PROC 
+multistopkonfsim:BOOL VAR b:=multistopkonf;setzebestandende(NOT b);bENDPROC 
+multistopkonfsim;END PACKET protversetzkonflisten;
+
diff --git a/app/schulis/2.2.1/src/1.listen.wiederholer b/app/schulis/2.2.1/src/1.listen.wiederholer
new file mode 100644
index 0000000..e0541d2
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listen.wiederholer
@@ -0,0 +1,160 @@
+PACKET versetzlistenDEFINES verslispezielleteile:LET schluesselwiederholer=
+"w";INT CONST mnrbearbeitetwirdjgst:=106,nurimzweitenhj:=193;TEXT VAR 
+bearbeitetwirdjgst:="",aktuellesschuljahr:="",endewertjgst:="",startwertjgst
+:="";LET niltext="",nildatum="01.01.00",blank=" ",mittestrich="-",null=0,
+komma=",",ueberschriftenzeilen=2,spalte1breitesek1=5,spalte3breitesek1=32,
+spalte1breitesek2=8,spalte3breitesek2=25,anzspaltentrenner=2,spaltentrenner=
+":",ausgkopflaenge=3,ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT ,
+AUSGKOPF =ROW ausgkopflaengeTEXT ,verslieingangsmaske=
+"ms liste versetz nachpr eingang",verslianfpos=2;INT CONST 
+spalte2bildbreitesek1:=bildbreite-anzspaltentrenner-spalte1breitesek1-
+spalte3breitesek1,spalte2bildbreitesek2:=bildbreite-anzspaltentrenner-
+spalte1breitesek2-spalte3breitesek2;INT VAR spalte2druckbreite,
+druckzeilenzahl,bildanf,eingabestatus,breite;TEXT VAR versliueberschrift,
+jahr1,jahr2,schuelername,schuelerrufname,schuelernamenszus,schuelerjgst,
+schuelerzug,schuelerabdat,ortsteil,erstesprache,religionsunt,kuodermu,jgst,
+neuejgst,klasse,neueklasse;TEXT VAR druckstrich;TEXT CONST bildstrich:=
+bildbreite*mittestrich;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;BOOL VAR 
+sek1,sek2,ersteraufbildschirm,klassegeaendert:=FALSE ;PROC 
+verslispezielleteile(INT CONST nr):SELECT nrOF CASE 1:verslidialogvorbereiten
+CASE 2:verslieingabenrichtigCASE 3:verslilistenvorbereitenCASE 4:
+verslidruckvorbereitenCASE 5:versliseitedruckenCASE 6:
+verslibildschirmvorbereitenCASE 7:versliseitezeigenENDSELECT .END PROC 
+verslispezielleteile;PROC verslidialogvorbereiten:versliueberschrift:=text(
+vergleichsknoten);setzeanfangswerte(verslieingangsmaske,verslianfpos);
+reinitparsingEND PROC verslidialogvorbereiten;PROC verslieingabenrichtig:LET 
+fnrsek1=2,fnrsek2=3,fnrjgst=4,fnrausgdrucker=5,fnrausgbild=6,
+auswahlnichtsinnvoll=56;IF int(schulkenndatum("Schulhalbjahr"))=1THEN 
+standardmeldung(nurimzweitenhj,"2.#");setzeeingabetest(FALSE )ELSE 
+wohinpruefenFI .wohinpruefen:standardpruefe(5,fnrausgdrucker,fnrausgbild,null
+,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(eingabestatus);
+setzeeingabetest(FALSE )ELSE waspruefenFI .waspruefen:sek1:=FALSE ;sek2:=
+FALSE ;jgst:="";IF standardmaskenfeld(fnrjgst)=niltextTHEN standardpruefe(5,
+fnrsek1,fnrsek2,null,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE sek1:=standardmaskenfeld(fnrsek2)
+=niltext;sek2:=NOT sek1;setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=
+niltext);setzeeingabetest(TRUE )FI ;ELSE IF (standardmaskenfeld(fnrsek1)=
+niltext)AND (standardmaskenfeld(fnrsek2)=niltext)THEN standardpruefe(3,
+fnrjgst,5,13,niltext,eingabestatus);IF eingabestatus<>0THEN infeld(
+eingabestatus);setzeeingabetest(FALSE )ELSE jgst:=zweistellig(
+standardmaskenfeld(fnrjgst));setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;ELSE meldefehler;infeld(
+fnrsek1);setzeeingabetest(FALSE )FI ;FI .meldefehler:standardmeldung(
+auswahlnichtsinnvoll,niltext).END PROC verslieingabenrichtig;PROC 
+verslilistenvorbereiten:BOOL VAR b;LET schluessel="Schuljahr";
+aktuellesschuljahrermitteln;startwertjgstbestimmen;inittupel(
+dnrhalbjahresdaten);initobli(16);setzeidentiwert("");startwertesetzen;
+objektlistestarten(ixhjdversjhjjgstkenn,"",fnrhjdjgst,TRUE ,b);
+setzebestandende(NOT multistopniverCOR b).aktuellesschuljahrermitteln:
+aktuellesschuljahr:=schulkenndatum(schluessel);jahr1:=subtext(
+aktuellesschuljahr,1,2);jahr2:=subtext(aktuellesschuljahr,3,4).
+startwertjgstbestimmen:endewertjgst:=endeberechnung;startwertjgst:=
+anfangsberechnung;.anfangsberechnung:IF sek1THEN "05"ELIF sek2THEN "11"ELSE 
+jgstFI .endeberechnung:IF sek1THEN "11"ELIF sek2THEN "14"ELSE text(int(jgst)+
+1)FI .startwertesetzen:putwert(fnrhjdversetzung,schluesselwiederholer);
+putwert(fnrhjdjgst,startwertjgst);putwert(fnrhjdsj,aktuellesschuljahr);
+putintwert(fnrhjdhj,2).END PROC verslilistenvorbereiten;BOOL PROC 
+multistopniver:BOOL VAR b;b:=wiederholerundrichtigesdatumCAND int(wert(
+fnrhjdjgst))>=int(startwertjgst)CAND int(wert(fnrhjdjgst))<#=#int(
+endewertjgst);b.wiederholerundrichtigesdatum:wert(fnrhjdversetzung)=
+schluesselwiederholerCAND wert(fnrhjdsj)=aktuellesschuljahrCAND wert(fnrhjdhj
+)="2".ENDPROC multistopniver;BOOL PROC multistopniversim:BOOL VAR b:=
+multistopniver;setzebestandende(NOT b);bENDPROC multistopniversim;PROC 
+verslibildschirmvorbereiten:LET fnrausganf=2;standardkopfmaskeaktualisieren(
+versliueberschrift);breite:=bildbreite;initspalten;setzespaltentrenner(
+spaltentrenner);IF elementsek1THEN setzespaltenbreitensek1(
+spalte2bildbreitesek1);initausgabekopfsek1(bildstrich)ELSE 
+setzespaltenbreitensek2(spalte2bildbreitesek2);initausgabekopfsek2(bildstrich
+)FI ;bildanf:=fnrausganf;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+ausgkopf(i)IN bildanf;bildanfINCR 1END REPEAT ;klasse:=niltext;
+setzebildanfangsposition(bildanf).END PROC verslibildschirmvorbereiten;PROC 
+versliseitezeigen:setzescanstartwert(startwertjgst);setzescanendewert(
+endewertjgstpluseinsbeigleichheit);blaettern(PROC (INT CONST )schuelerzeigen,
+aktion,TRUE ,TRUE ,BOOL PROC multistopniver);setzescanstartwert("");
+setzescanendewert("�").endewertjgstpluseinsbeigleichheit:IF startwertjgst=
+endewertjgstTHEN text(int(endewertjgst)+1)ELSE endewertjgstFI .END PROC 
+versliseitezeigen;PROC schuelerzeigen(INT CONST x):schuelerholen;IF 
+ersteraufbildschirmTHEN klassegeaendert:=TRUE ;ersteraufbildschirm:=FALSE FI 
+;schueleraufbereiten;schueleraufbildschirm.END PROC schuelerzeigen;PROC 
+schueleraufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREPEAT ausgfeld
+(i)IN ausgabepos;erhoeheausgabeposumeinsEND REPEAT .END PROC 
+schueleraufbildschirm;PROC verslidruckvorbereiten:LET uebteil11=
+"Liste der nicht versetzten Schüler, ",uebteil12="Sek.I",uebteil13="Sek.II",
+uebteil14="Jgst. ",uebteil2="Schuljahr: ";TEXT VAR ueberschrift1,
+ueberschrift2;ueberschriftvorbereitendruck;jgst:=niltext;klasse:=niltext;
+druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(ueberschrift1,
+ueberschrift2);breite:=druckbreite;initspalten;setzespaltentrenner(
+spaltentrenner);IF elementsek1THEN setzespaltenbreitensek1(spalte2druckbreite
+);initausgabekopfsek1(druckstrich)ELSE setzespaltenbreitensek2(
+spalte2druckbreite);initausgabekopfsek2(druckstrich)FI ;holemeldungen;
+setzewerte;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )
+scanforward,BOOL PROC multistopniversim).holemeldungen:meldungstext(
+mnrbearbeitetwirdjgst,bearbeitetwirdjgst).setzewerte:inittupel(
+dnrhalbjahresdaten);putwert(fnrhjdversetzung,schluesselwiederholer);putwert(
+fnrhjdjgst,startwertjgst);putwert(fnrhjdsj,aktuellesschuljahr);putintwert(
+fnrhjdhj,2).ueberschriftvorbereitendruck:ueberschrift1:=uebteil11;IF sek1
+THEN ueberschrift1:=ueberschrift1+uebteil12ELSE IF sek2THEN ueberschrift1:=
+ueberschrift1+uebteil13ELSE ueberschrift1:=ueberschrift1+uebteil14+jgstFI ;
+FI ;ueberschrift2:=uebteil2+aufbereitetesschuljahr.aufbereitetesschuljahr:
+"19"+jahr1+"/"+jahr2.variablenfuerdrucksetzen:druckstrich:=druckbreite*
+mittestrich;spalte2druckbreite:=druckbreite-anzspaltentrenner;IF elementsek1
+THEN spalte2druckbreite:=spalte2druckbreite-spalte1breitesek1-
+spalte3breitesek1ELSE spalte2druckbreite:=spalte2druckbreite-
+spalte1breitesek2-spalte3breitesek2FI ;druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen)-ausgkopflaenge.END PROC verslidruckvorbereiten;PROC 
+versliseitedrucken:versliueberschriftdrucken;seitedrucken(PROC (INT VAR )
+schuelerdrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopniversim);
+seitenwechsel.END PROC versliseitedrucken;PROC versliueberschriftdrucken:
+druckkopfschreiben;INT VAR i;FOR iFROM 1UPTO ausgkopflaengeREPEAT 
+druckzeileschreiben(ausgkopf(i))END REPEAT .END PROC 
+versliueberschriftdrucken;PROC schuelerdrucken(INT VAR zeilenzaehler):LET 
+markiert="#";schuelerholen;IF zeilenzaehler=nullTHEN klassegeaendert:=TRUE 
+FI ;ggflmeldungjgst;schueleraufbereiten;zeilenzaehlerINCR ausgfeldlaenge;
+schuelerindruckdatei.ggflmeldungjgst:IF jgstgeaendertTHEN zwischenmeldungFI .
+jgstgeaendert:neuejgst:=schuelerjgst;jgst<>neuejgst.zwischenmeldung:
+standardmeldung(bearbeitetwirdjgst,neuejgst+markiert);jgst:=neuejgst;END 
+PROC schuelerdrucken;PROC schuelerindruckdatei:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREPEAT druckzeileschreiben(ausgfeld(i))END REPEAT .END PROC 
+schuelerindruckdatei;PROC setzespaltenbreitensek1(INT CONST spalte2breitesek1
+):setzespaltenbreite(spalte1breitesek1);setzespaltenbreite(spalte2breitesek1)
+;setzespaltenbreite(spalte3breitesek1);END PROC setzespaltenbreitensek1;PROC 
+setzespaltenbreitensek2(INT CONST spalte2breitesek2):setzespaltenbreite(
+spalte1breitesek2);setzespaltenbreite(spalte2breitesek2);setzespaltenbreite(
+spalte3breitesek2);END PROC setzespaltenbreitensek2;PROC initausgabekopfsek1(
+TEXT CONST strich):LET jgst="Jgst.",zug="  Zug",name="Name",rest1=
+"Orts-:Rel.: L : KU :  Klasse",rest2="teil :unt.: F : MU :Wunsch:neu";
+spaltenweise(jgst);spaltenweise(blank);spaltenweise(rest1);ausgkopf(1):=zeile
+;spaltenweise(zug);spaltenweise(name);spaltenweise(rest2);ausgkopf(2):=zeile;
+ausgkopf(3):=strich;END PROC initausgabekopfsek1;PROC initausgabekopfsek2(
+TEXT CONST strich):LET jgst="Jgst.",tutor="   Tutor",name="Name",rest1=
+"Abmeldung";spaltenweise(jgst);spaltenweise(blank);spaltenweise(blank);
+ausgkopf(1):=zeile;spaltenweise(tutor);spaltenweise(name);spaltenweise(rest1)
+;ausgkopf(2):=zeile;ausgkopf(3):=strich;END PROC initausgabekopfsek2;PROC 
+schuelerholen:sucheschueler;schuelername:=wert(fnrsufamnames);schuelerrufname
+:=wert(fnrsurufnames);schuelernamenszus:=wert(fnrsunamenszusatzs);
+schuelerjgst:=wert(fnrhjdjgst);schuelerzug:=wert(fnrhjdkennung);schuelerabdat
+:=wert(fnrsuabgdats);IF elementsek1THEN ortsteil:=wert(fnrsuortsteils);
+erstesprache:=wert(fnrdd1fremdfach);religionsunt:=wert(fnrddreliunter);
+kuodermu:=wert(fnrddkunstmusik)FI ;neueklasse:=schuelerjgst+schuelerzug;
+klassegeaendert:=klasse<>neueklasse;klasse:=neueklasse.sucheschueler:
+uebernehmewerte;search(dnrschueler,TRUE );IF dbstatus=okTHEN readtid(
+dnrdiffdaten,zugriff(fnrsutiddiffdaten))ELSE inittupel(dnrdiffdaten)FI .
+uebernehmewerte:putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert(
+fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats
+)).END PROC schuelerholen;PROC schueleraufbereiten:LET abgemsek1="abgem.",
+abgemsek2="abgemeldet";schreibeklassenamerest.schreibeklassenamerest:
+spaltenweise(aufbschuelerklasse);spaltenweise(aufbschuelername);spaltenweise(
+aufbrest);ausgfeld(1):=zeile.aufbschuelerklasse:IF klassegeaendertTHEN 
+schuelerjgst+blank+schuelerzugELSE blankFI .aufbschuelername:IF 
+schuelernamenszus=niltextTHEN schuelername+komma+blank+schuelerrufnameELSE 
+schuelernamenszus+blank+schuelername+komma+blank+schuelerrufnameFI .aufbrest:
+IF elementsek1THEN ganzerrestsek1ELSE abmeldungsek2FI .ganzerrestsek1:blank+
+text(ortsteil,3)+blank+spaltentrenner+blank+text(religionsunt,2)+blank+
+spaltentrenner+blank+text(erstesprache,1)+blank+spaltentrenner+blank+text(
+kuodermu,2)+blank+spaltentrenner+abmeldungsek1.abmeldungsek1:IF (
+schuelerabdat=niltext)OR (schuelerabdat=nildatum)THEN text(blank,6)+
+spaltentrennerELSE abgemsek1+spaltentrenner+blank+mittestrichFI .
+abmeldungsek2:IF (schuelerabdat=niltext)OR (schuelerabdat=nildatum)THEN blank
+ELSE abgemsek2FI .END PROC schueleraufbereiten;BOOL PROC elementsek1:sek1COR 
+int(startwertjgst)<11ENDPROC elementsek1;END PACKET versetzlisten;
+
diff --git a/app/schulis/2.2.1/src/1.listenweise dif dat erf b/app/schulis/2.2.1/src/1.listenweise dif dat erf
new file mode 100644
index 0000000..0ef8cfd
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listenweise dif dat erf
@@ -0,0 +1,255 @@
+PACKET listenweisedifdaterfDEFINES bearbeitungdifdaterf,
+difdaterfnichtspeichern,difdaterfspeichern:LET tofather=1,tograndfather=2,
+maxsek1="10",niltext="",blank=" ",namenstrenner=", ",null=0,meldtrenner="#";
+LET maskennamepreallg="ms dif dat erf bearbeitung";LET jgst5=5,jgst13=13,
+standardanfang=1;LET maxschueler=14,schuelerproseite=15;LET meldbestleer=59,
+meldnichtspeichern=63,meldplausi=57,meldwarten=69,meldspeicherung=132,
+meldspeicherfehler=131,meldnrfalschesdatum=157,meldnrfalscherschluessel=34;
+LET pruefartalternative=5,pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3,fnrfs1=4
+,fnrag=12,fnrmaskentitel=3,fnrklasse=2;LET mnr1=1,mnr2=2,mnr3=3,mnr4=4,mnr5=5
+,titel09="09",titel10="10",ef1=4,fpz1=4,ef2=3,fpz3=2,fpz4=5;LET awfs1=1,awfs2
+=2,awfs3=3,awfs4=4,awreli=5,awkunst=6,awwp9=7,awwp10=8,awag=9,
+auswertungsdistanz=3;LET maxag=3;LET allespruefen=1,einejgstpruefen=2,
+eineklassepruefen=3;LET schuelerbestand="ls";LET logtextbeginn="Anw. 1.4.2 ",
+logtextalleklassen="alle Klassen";LET logtext1=".Fremdsprache",logtext2=
+"Teilnahme am Religionsunterricht",logtext3="Kunst/Musik",logtext4=
+"Wahlpflichtfächer",logtext5="Arbeitsgemeinschaften";TEXT VAR logarttext;
+BOOL VAR nochwelcheda,alleklassen,tutorenkurs,sek2,eineklasse,
+nochweiterebestaende,einejgst;INT VAR fremdsprachenindex,wpindex,waspruefen,
+erstesfeld,felderprozeile,standardeinstieg,laengename,laengeklasse,
+schuelerzahl,aktuellesfeld,auswertungsnr;ROW schuelerproseiteTEXT VAR name;
+ROW schuelerproseiteTEXT VAR rufname;ROW schuelerproseiteTEXT VAR gebdat;ROW 
+schuelerproseiteTEXT VAR altedaten;TEXT VAR vergleichsjgst,vergleichszug,
+sicherungstupel;PROC bearbeitungdifdaterf:TEXT VAR jgst,zug;reinitparsing;
+eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN 
+initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN 
+bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE 
+eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmok:pruefstatus=0.
+eingangsbildschirmpruefen:ankreuzfelderpruefen;IF eingangsbildschirmokTHEN 
+jgstzugpruefenFI .ankreuzfelderpruefen:INT VAR pruefstatus;standardpruefe(
+pruefartalternative,fnrfs1,fnrag,null,niltext,pruefstatus);.jgstzugpruefen:
+alleklassen:=FALSE ;IF standardmaskenfeld(fnrjgst)<>niltextTHEN 
+standardpruefe(pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus)ELIF 
+standardmaskenfeld(fnrtutor)<>niltextTHEN pruefstatus:=fnrtutorELSE 
+alleklassen:=TRUE FI .initialisierungenvornehmen:bestandundmaskesetzen;
+bearbeitungsmaskevorbereiten;laengenfestlegen;IF sek2CAND NOT tutorenkurs
+THEN startebildschirmblock(ixsustatjgst,maxschueler)ELSE 
+startebildschirmblock(ixsustatjgstzug,maxschueler)FI .
+bearbeitungsmaskevorbereiten:standardstartproc(maskennamepreallg+text(
+auswertungsmaskennr));IF maskentitel<>niltextTHEN standardmaskenfeld(
+maskentitel,fnrmaskentitel)FI ;SELECT auswertungsmaskennrOF CASE mnr1:
+erstesfeld:=ef1;felderprozeile:=fpz1CASE mnr2:erstesfeld:=ef2;felderprozeile
+:=fpz1CASE mnr3:erstesfeld:=ef2;felderprozeile:=fpz3CASE mnr4:erstesfeld:=ef1
+;felderprozeile:=fpz4CASE mnr5:erstesfeld:=ef2;felderprozeile:=fpz1END 
+SELECT ;standardeinstieg:=erstesfeld+1.laengenfestlegen:laengeklasse:=
+standardfeldlaenge(fnrklasse);laengename:=standardfeldlaenge(erstesfeld).
+naechsteportionlesen:blocklesenundausgeben.keinemehrda:NOT nochwelcheda.
+bestandleermelden:standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:
+#standardmeldung(meldfalscheauswahl,niltext);#infeld(pruefstatus).
+bestandundmaskesetzen:standardmeldung(meldwarten,niltext);bestimmebestand;
+setzestartkeys;pruefebestand;bestimmemaske.bestimmebestand:eineklasse:=FALSE 
+;einejgst:=FALSE ;jgst:=jgstaufber(standardmaskenfeld(fnrjgst));zug:=
+standardmaskenfeld(fnrtutor);IF alleklassenTHEN alleklassensetzenELIF 
+nureineklasseTHEN setzeklasseELSE setzejgstFI .alleklassensetzen:waspruefen:=
+allespruefen;sek2:=FALSE ;vergleichsjgst:=niltext;infeld(fnrjgst).
+nureineklasse:tutorenkurs:=zug<>niltext;tutorenkurs.setzeklasse:eineklasse:=
+TRUE ;waspruefen:=eineklassepruefen;vergleichsjgst:=jgst;vergleichszug:=zug;
+sek2:=FALSE ;infeld(fnrtutor).setzejgst:sek2:=istsek2(jgst);einejgst:=TRUE ;
+waspruefen:=einejgstpruefen;vergleichsjgst:=jgst;infeld(fnrjgst).
+setzestartkeys:inittupel(dnrschueler);putwert(fnrsustatuss,schuelerbestand);
+putwert(fnrsusgrpjgst,jgst);putwert(fnrsusgrpzugtut,zug);.pruefebestand:
+search(ixsustatjgstzug,FALSE );IF dbstatus=nullCAND (pruefungspeziell(
+waspruefen))THEN vergleichsjgst:=wert(fnrsusgrpjgst);vergleichszug:=wert(
+fnrsusgrpzugtut);nochwelcheda:=TRUE ;IF alleklassenTHEN waspruefen:=
+eineklassepruefenELIF NOT sek2CAND waspruefen=einejgstpruefenTHEN waspruefen
+:=eineklassepruefenFI ELSE bestandleermelden;return(tofather);LEAVE 
+bearbeitungdifdaterfFI .bestimmemaske:setzeauswertungsnr;SELECT auswertungsnr
+OF CASE awfs1,awfs2,awfs3,awfs4:auswertungfremdspracheCASE awreli:
+auswertungreliCASE awkunst:auswertungkunstCASE awwp9:auswertungwp9CASE awwp10
+:auswertungwp10CASE awag:auswertungagEND SELECT .auswertungfremdsprache:INT 
+VAR auswertungsmaskennr:=mnr1;maskentitel:=text(auswertungsnr);logarttext:=
+maskentitel;logarttextCAT logtext1.auswertungreli:auswertungsmaskennr:=mnr2;
+logarttext:=logtext2.auswertungkunst:auswertungsmaskennr:=mnr3;logarttext:=
+logtext3.auswertungwp9:auswertungsmaskennr:=mnr4;maskentitel:=titel09;
+logarttext:=logtext4.auswertungwp10:auswertungsmaskennr:=mnr4;maskentitel:=
+titel10;logarttext:=logtext4.auswertungag:auswertungsmaskennr:=mnr5;
+logarttext:=logtext5.setzeauswertungsnr:INT VAR indauswertungsnr;TEXT VAR 
+maskentitel:=niltext;FOR indauswertungsnrFROM fnrfs1UPTO fnragREP IF 
+standardmaskenfeld(indauswertungsnr)<>niltextTHEN auswertungsnr:=
+indauswertungsnr-auswertungsdistanz;LEAVE setzeauswertungsnrFI PER .END PROC 
+bearbeitungdifdaterf;PROC difdaterfnichtspeichern:nichtspeichernmelden;
+startkeyssetzen;neuerblock.nichtspeichernmelden:standardmeldung(
+meldnichtspeichern,niltext);pause(10).startkeyssetzen:restoretupel(
+dnrschueler,sicherungstupel);changeindex.END PROC difdaterfnichtspeichern;
+PROC difdaterfspeichern:BOOL VAR falschesdatum:=FALSE ;INT VAR lv;
+pruefeplausibilitaet;IF dateninordnungTHEN speicherungdurchfuehren;
+startkeyssetzen;neuerblockELSE eingabefehler;return(tofather);FI .
+pruefeplausibilitaet:BOOL VAR dateninordnung:=TRUE ;standardmeldung(
+meldplausi,niltext);aktuellesfeldvorbelegen;FOR suindFROM 1UPTO schuelerzahl
+REP pruefezeile;IF NOT dateninordnungTHEN LEAVE pruefeplausibilitaetFI PER .
+aktuellesfeldvorbelegen:SELECT auswertungsnrOF CASE awfs1,awfs2,awfs3,awfs4:
+vorbelegungmitsprungCASE awreli:vorbelegungmitsprungCASE awkunst:
+vorbelegungmitsprungCASE awwp9,awwp10:vorbelegungohnesprungCASE awag:
+vorbelegungohnesprungEND SELECT .vorbelegungmitsprung:aktuellesfeld:=
+erstesfeld+1-felderprozeile.vorbelegungohnesprung:aktuellesfeld:=erstesfeld.
+pruefezeile:falschesdatum:=FALSE ;SELECT auswertungsnrOF CASE awfs1,awfs2,
+awfs3,awfs4:ueberpruefefachmitsprungCASE awreli:ueberpruefefachmitsprungCASE 
+awkunst:ueberpruefefachmitsprungCASE awwp9,awwp10:ueberpruefefachinreiheCASE 
+awag:ueberpruefefachinreiheEND SELECT .ueberpruefefachmitsprung:aktuellesfeld
+:=aktuellesfeld+felderprozeile;dateninordnung:=schluesselexistiert;IF 
+auswertungsnr=awreliTHEN disablestop;FOR lvFROM 1UPTO 2REP putwert(
+fnrddreliunter+lv,datumskonversion(standardmaskenfeld(aktuellesfeld+lv)));IF 
+iserrorTHEN clearerror;falschesdatum:=TRUE ;dateninordnung:=FALSE ;enablestop
+;LEAVE ueberpruefefachmitsprungFI ;PER ;enablestop;FI .ueberpruefefachinreihe
+:INT VAR i;FOR iFROM 1UPTO felderprozeile-1REP aktuellesfeldINCR 1;
+dateninordnung:=schluesselexistiert;IF NOT dateninordnungTHEN LEAVE 
+ueberpruefefachinreiheFI PER ;aktuellesfeldINCR 1.schluesselexistiert:TEXT 
+CONST schleintrag:=compress(subtext(standardmaskenfeld(aktuellesfeld),1,2));(
+schleintrag=niltext)COR schluesselvorhanden(schleintrag).
+speicherungdurchfuehren:logeintragvornehmen;aendernschleife;kurzwarten.
+logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;eintragCAT logarttext;
+eintragCAT " für ";IF alleklassenTHEN eintragCAT logtextalleklassenELSE 
+eintragCAT vergleichsjgst;eintragCAT vergleichszugFI ;logeintrag(eintrag).
+kurzwarten:pause(10).aendernschleife:INT VAR suind;INT VAR zahlderaenderungen
+:=null;INT VAR satzindex:=erstesfeld;FOR suindFROM 1UPTO schuelerzahlREP 
+behandleschuelersatz;satzindexINCR felderprozeilePER .behandleschuelersatz:
+IF datenveraendertTHEN fuehreaenderungaus;meldevollzugFI .fuehreaenderungaus:
+lesenvorbereiten;lesen;zurueckschreiben;.lesenvorbereiten:zahlderaenderungen
+INCR 1;putwert(fnrsufamnames,name(suind));putwert(fnrsurufnames,rufname(suind
+));putwert(fnrsugebdatums,gebdat(suind)).lesen:search(dnrschueler,TRUE );IF 
+dbstatus=okCAND wert(fnrsutiddiffdaten)<>niltextTHEN readtid(dnrdiffdaten,
+wert(fnrsutiddiffdaten))ELSE dbstatus(notfound)FI .zurueckschreiben:IF 
+dbstatus=0THEN dbwertesetzen;aenderntransaktionFI .dbwertesetzen:
+aktuellesfeld:=satzindex+1;SELECT auswertungsnrOF CASE awfs1,awfs2,awfs3,
+awfs4:setzefremdsprachenCASE awreli:setzereliCASE awkunst:setzekunstCASE 
+awwp9,awwp10:setzewpCASE awag:setzeagEND SELECT .aenderntransaktion:replace(
+dnrdiffdaten,wert(fnrsutiddiffdaten)).meldevollzug:TEXT VAR meldungstext;IF 
+dbstatus=0THEN meldungstext:=compress(standardmaskenfeld(satzindex))+
+meldtrenner;standardmeldung(meldspeicherung,meldungstext)ELSE meldungstext:=
+text(dbstatus)+meldtrenner;meldungstextCAT compress(standardmaskenfeld(
+satzindex));meldungstextCAT meldtrenner;standardmeldung(meldspeicherfehler,
+meldungstext);return(tofather);LEAVE difdaterfspeichernFI ;infeld(satzindex+1
+).datenveraendert:altedaten(suind)<>jetzigedaten.jetzigedaten:INT VAR datind;
+TEXT VAR datenindermaske:=niltext;FOR datindFROM 1UPTO felderprozeile-1REP 
+datenindermaskeCAT text(standardmaskenfeld(satzindex+datind),
+standardfeldlaenge(satzindex+datind))PER ;datenindermaske.startkeyssetzen:
+restoretupel(dnrschueler,sicherungstupel);changeindex.eingabefehler:IF 
+falschesdatumTHEN standardmeldung(meldnrfalschesdatum,niltext);infeld(
+aktuellesfeld+lv)ELSE standardmeldung(meldnrfalscherschluessel,niltext);
+infeld(aktuellesfeld)FI ;.END PROC difdaterfspeichern;BOOL PROC 
+schluesselvorhanden(TEXT CONST eingabe):putwert(fnrffach,eingabe);search(
+dnrfaecher,TRUE );dbstatus=okEND PROC schluesselvorhanden;PROC neuerblock:
+evtlnaechsterbestand;blocklesenundausgeben;IF nochwelchedaTHEN return(
+tofather)ELSE enter(tograndfather)FI .evtlnaechsterbestand:IF schuelerzahl=
+maxschuelerTHEN IF sek2CAND NOT tutorenkursTHEN succ(ixsustatjgst)ELSE succ(
+ixsustatjgstzug);FI ;IF dbstatus<>0THEN nochwelcheda:=FALSE ;
+nochweiterebestaende:=FALSE ;FI FI ;IF NOT pruefungspeziell(waspruefen)THEN 
+IF naechsterbestandTHEN changeindex;vergleichsjgst:=wert(fnrsusgrpjgst);
+vergleichszug:=wert(fnrsusgrpzugtut);startebildschirmblock(ixsustatjgstzug,
+maxschueler)ELSE nochwelcheda:=FALSE FI ELSE restoretupel(dnrschueler,
+sicherungstupel);changeindexFI .END PROC neuerblock;PROC 
+blocklesenundausgeben:REP vorbereiten;gewuenschteszeigen;nachbereitenPER .
+vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgebenFI ;
+standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:=
+erstesfeld.nachbereiten:nochwelcheda:=(schuelerzahl>null);IF nochwelcheda
+THEN savetupel(dnrschueler,sicherungstupel);restlichezeilenloeschen;infeld(
+standardanfang);standardfelderausgeben;infeld(standardeinstieg);LEAVE 
+blocklesenundausgebenELIF naechsterbestandTHEN vergleichsjgst:=wert(
+fnrsusgrpjgst);vergleichszug:=wert(fnrsusgrpzugtut);#???#
+startebildschirmblock(ixsustatjgstzug,maxschueler);nochwelcheda:=TRUE ELSE 
+LEAVE blocklesenundausgebenFI ;.restlichezeilenloeschen:INT VAR zeilenzaehler
+;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+(erstesfeld-1);FOR 
+zeilenzaehlerFROM schuelerzahlUPTO maxschuelerREP loeschezeilePER .
+loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP 
+zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,
+zeilenfeld);feldschutz(zeilenfeld)PER ;.gewuenschteszeigen:SELECT 
+auswertungsnrOF CASE awfs1:zeigefremdsprache1CASE awfs2:zeigefremdsprache2
+CASE awfs3:zeigefremdsprache3CASE awfs4:zeigefremdsprache4CASE awreli:
+zeigereliCASE awkunst:zeigekunstCASE awwp9:zeigewp9CASE awwp10:zeigewp10CASE 
+awag:zeigeagEND SELECT ;.zeigefremdsprache1:fremdsprachenindex:=
+fnrdd1fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST 
+)pruefungspeziell,waspruefen).zeigefremdsprache2:fremdsprachenindex:=
+fnrdd2fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST 
+)pruefungspeziell,waspruefen).zeigefremdsprache3:fremdsprachenindex:=
+fnrdd3fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST 
+)pruefungspeziell,waspruefen).zeigefremdsprache4:fremdsprachenindex:=
+fnrdd4fremdfach;bildschirmblock(PROC fremdsprachezeigen,BOOL PROC (INT CONST 
+)pruefungspeziell,waspruefen).zeigereli:bildschirmblock(PROC relizeigen,BOOL 
+PROC (INT CONST )pruefungspeziell,waspruefen).zeigekunst:bildschirmblock(
+PROC kunstzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).zeigewp9:
+wpindex:=fnrddfach091a;bildschirmblock(PROC wpzeigen,BOOL PROC (INT CONST )
+pruefungspeziell,waspruefen).zeigewp10:wpindex:=fnrddfach101a;bildschirmblock
+(PROC wpzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).zeigeag:
+bildschirmblock(PROC agzeigen,BOOL PROC (INT CONST )pruefungspeziell,
+waspruefen).END PROC blocklesenundausgeben;PROC namezeigen:IF ersterTHEN 
+klassezeigenundrettenFI ;namenretten;standardmaskenfeld(text(schuelername+
+namenstrenner+schuelervorname,laengename),aktuellesfeld);readtid(dnrdiffdaten
+,wert(fnrsutiddiffdaten));aktuellesfeldINCR 1.erster:schuelerzahl=null.
+klassezeigenundretten:sek2:=istsek2(wert(fnrsusgrpjgst));IF sek2CAND (NOT 
+tutorenkurs)THEN sek2sonderbehandlungELSE normalbehandlungFI .
+normalbehandlung:vergleichsjgst:=wert(fnrsusgrpjgst);vergleichszug:=wert(
+fnrsusgrpzugtut);standardmaskenfeld(text(vergleichsjgst+vergleichszug,
+laengeklasse),fnrklasse).sek2sonderbehandlung:vergleichsjgst:=wert(
+fnrsusgrpjgst);standardmaskenfeld(text(vergleichsjgst,laengeklasse),fnrklasse
+).namenretten:TEXT VAR schuelername,schuelervorname;schuelername:=wert(
+fnrsufamnames);schuelervorname:=wert(fnrsurufnames);schuelerzahlINCR 1;name(
+schuelerzahl):=schuelername;rufname(schuelerzahl):=schuelervorname;gebdat(
+schuelerzahl):=wert(fnrsugebdatums).END PROC namezeigen;PROC 
+fremdsprachezeigen:namezeigen;gewaehltefremdsprachezeigen.
+gewaehltefremdsprachezeigen:TEXT VAR was;INT VAR lv;altedaten(schuelerzahl):=
+niltext;FOR lvFROM fremdsprachenindexUPTO fremdsprachenindex+2REP was:=wert(
+lv);standardmaskenfeld(was,aktuellesfeld);altedaten(schuelerzahl)CAT text(was
+,standardfeldlaenge(aktuellesfeld));feldfrei(aktuellesfeld);aktuellesfeld
+INCR 1PER .END PROC fremdsprachezeigen;PROC setzefremdsprachen:TEXT VAR was;
+INT VAR lv;FOR lvFROM fremdsprachenindexUPTO fremdsprachenindex+2REP was:=
+standardmaskenfeld(aktuellesfeld);putwert(lv,was);aktuellesfeldINCR 1;PER .
+END PROC setzefremdsprachen;PROC relizeigen:namezeigen;relidatenzeigen.
+relidatenzeigen:INT VAR was:=fnrddreliunter,lv;TEXT VAR daten;altedaten(
+schuelerzahl):=niltext;FOR lvFROM wasUPTO was+2REP IF lv=wasTHEN daten:=(wert
+(lv));ELSE daten:=datumrekonversion(wert(lv))FI ;standardmaskenfeld(daten,
+aktuellesfeld);altedaten(schuelerzahl)CAT text(daten,standardfeldlaenge(
+aktuellesfeld));feldfrei(aktuellesfeld);aktuellesfeldINCR 1PER .END PROC 
+relizeigen;PROC setzereli:INT VAR was:=fnrddreliunter,lv;TEXT VAR daten;FOR 
+lvFROM wasUPTO was+2REP IF lv=wasTHEN daten:=standardmaskenfeld(aktuellesfeld
+);ELSE daten:=datumskonversion(standardmaskenfeld(aktuellesfeld));FI ;putwert
+(lv,daten);aktuellesfeldINCR 1PER END PROC setzereli;PROC kunstzeigen:
+namezeigen;fachzeigen;merken.fachzeigen:TEXT VAR fach:=wert(fnrddkunstmusik);
+standardmaskenfeld(fach,aktuellesfeld);feldfrei(aktuellesfeld);aktuellesfeld
+INCR 1.merken:altedaten(schuelerzahl):=text(fach,2).END PROC kunstzeigen;
+PROC setzekunst:putwert(fnrddkunstmusik,standardmaskenfeld(aktuellesfeld));
+END PROC setzekunst;PROC wpzeigen:namezeigen;zeigefaecher;merken.zeigefaecher
+:INT VAR lv;TEXT VAR wpfaecher:=niltext,fach;FOR lvFROM wpindexUPTO wpindex+3
+REP fach:=wert(lv);standardmaskenfeld(fach,aktuellesfeld);feldfrei(
+aktuellesfeld);aktuellesfeldINCR 1;wpfaecherCAT text(fach,2)PER .merken:
+altedaten(schuelerzahl):=wpfaecher.END PROC wpzeigen;PROC setzewp:INT VAR lv;
+TEXT VAR fach;FOR lvFROM wpindexUPTO wpindex+3REP fach:=standardmaskenfeld(
+aktuellesfeld);putwert(lv,fach);aktuellesfeldINCR 1PER END PROC setzewp;PROC 
+agzeigen:namezeigen;agdatenzeigen.agdatenzeigen:INT VAR agind,woher:=0,
+laengeag:=2;TEXT VAR ag:=niltext;altedaten(schuelerzahl):=niltext;FOR agind
+FROM 0UPTO maxag-1REP ag:=text(wert(fnrddagthema1+woher),laengeag);agCAT text
+(wert(fnrddagthema1b+woher),laengeag+1);agCAT text(wert(fnrddagthema1e+woher)
+,laengeag+1);IF compress(ag)<>niltextTHEN standardmaskenfeld(ag,aktuellesfeld
+);ELSE standardmaskenfeld(niltext,aktuellesfeld);FI ;altedaten(schuelerzahl)
+CAT text(ag,standardfeldlaenge(aktuellesfeld));feldfrei(aktuellesfeld);
+aktuellesfeldINCR 1;woherINCR 3PER .END PROC agzeigen;PROC setzeag:INT VAR 
+agind,wohin:=0;TEXT VAR ag:=niltext;FOR agindFROM 0UPTO maxag-1REP ag:=
+standardmaskenfeld(aktuellesfeld);putwert(fnrddagthema1+wohin,subtext(ag,1,2)
+);putwert(fnrddagthema1b+wohin,subtext(ag,3,5));putwert(fnrddagthema1e+wohin,
+subtext(ag,6,8));wohinINCR 3;aktuellesfeldINCR 1;PER END PROC setzeag;PROC 
+feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld)
+END PROC feldloeschen;BOOL PROC istsek2(TEXT CONST jgst):jgst>maxsek1END 
+PROC istsek2;BOOL PROC naechsterbestand:nochweiterebestaende:=(alleklassen
+CAND pruefungspeziell(allespruefen))OR (einejgstCAND pruefungspeziell(
+einejgstpruefen))OR (eineklasseCAND pruefungspeziell(eineklassepruefen));
+nochweiterebestaendeEND PROC naechsterbestand;BOOL PROC pruefungspeziell(INT 
+CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT wasistzutunOF CASE allespruefen:
+pruefungalleklassen(b)CASE einejgstpruefen:pruefungeinejgst(b)CASE 
+eineklassepruefen:pruefungeineklasse(b)END SELECT ;bEND PROC pruefungspeziell
+;PROC pruefungalleklassen(BOOL VAR bool):bool:=wert(fnrsustatuss)=
+schuelerbestandEND PROC pruefungalleklassen;PROC pruefungeinejgst(BOOL VAR 
+bool):bool:=(wert(fnrsustatuss)=schuelerbestandCAND wert(fnrsusgrpjgst)=
+vergleichsjgst)END PROC pruefungeinejgst;PROC pruefungeineklasse(BOOL VAR 
+bool):bool:=(wert(fnrsustatuss)=schuelerbestandCAND wert(fnrsusgrpjgst)=
+vergleichsjgstCAND wert(fnrsusgrpzugtut)=vergleichszug)END PROC 
+pruefungeineklasse;END PACKET listenweisedifdaterf
+
diff --git a/app/schulis/2.2.1/src/1.listenweise erg nachpr b/app/schulis/2.2.1/src/1.listenweise erg nachpr
new file mode 100644
index 0000000..6b5a676
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listenweise erg nachpr
@@ -0,0 +1,250 @@
+PACKET listenweiseergnachprDEFINES bearbeitungergnachpr,
+ergnachprnichtspeichern,ergnachprspeichern:LET tofather=1,tograndfather=2,
+jgst5=5,jgst13=13,niltext="",blank=" ",namenstrenner=", ",null=0,punkt=".",
+meldtrenner="#";LET jgstufe10=10;LET einejgst=2,eineklasse=3;LET 
+geaendertersatz="x",kznachpruefung="n",dreizehnnachprsatz="N";LET 
+standardanfang=1,standardeinstieg=2,abstandzumnamen=2;LET maxschueler=15,
+erstesfeld=5,felderprozeile=6,schuelerproseite=16;LET gwklasse=1;LET 
+bestandengrenzeeinstellig=4,bestandengrenzezweistellig="05",minnoteeinstellig
+=1,maxnoteeinstellig=6,minnotezweistellig="00",maxnotezweistellig="15",
+leernote="";LET meldbestleer=59,meldnichtspeichern=63,meldwarten=69,
+meldspeicherung=132,meldspeicherfehler=131,meldfalschesfach=147,
+meldungueltigenote=148,meldfalschesg=134,meldfehlendesfach=52,
+meldtransaktionsfehler=138,meldplausi=57,meldfalscheauswahl=56,
+meldzugtutorfehlt=52;LET pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3,fnrklasse
+=2,fnrname=3,fnrbetr=4,fnrfach=5,fnrnote=6,fnrzug=7;LET schuljahrkey=
+"Schuljahr",anfangschuljahrkey="Anfang Schulhalbjahr",halbjahr1="1",halbjahr2
+="2",bestandlaufsj="ls",bestandabgegangene="abg";LET allespruefen=1,
+einejgstpruefen=2,eineklassepruefen=3;LET anzkenndaten=3,sek2min=11;LET 
+logtextbeginn="Anw. 1.4.9 Nachprüfungen für ",logtextalleklassen=
+"alle Klassen";BOOL VAR nochwelcheda,alleklassen;INT VAR waspruefen,
+laengeklasse,laengename,laengebetr,laengefach,laengenote,laengezugtutor,
+bestandindex,schuelerzahl,aktuellesfeld;ROW schuelerproseiteTEXT VAR name;
+ROW schuelerproseiteTEXT VAR rufname;ROW schuelerproseiteTEXT VAR gebdatum;
+ROW schuelerproseiteBOOL VAR dreizehner;ROW schuelerproseiteTEXT VAR 
+altedaten;ROW schuelerproseiteTEXT VAR npfaecher;ROW anzkenndatenTEXT VAR key
+;TEXT VAR startkey1,startkey2,aktschuljahr,schuljahr,schulhalbjahr,hjdtupel,
+schuelertupel,sichtupel;PROC bearbeitungergnachpr:reinitparsing;
+eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN 
+initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN 
+bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE 
+eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen:INT VAR 
+pruefstatus:=null;startkey1:=niltext;startkey2:=niltext;alleklassen:=FALSE ;
+IF standardmaskenfeld(fnrjgst)<>niltextTHEN standardpruefe(pruefartgrenzen,
+fnrjgst,jgst5,jgst13,niltext,pruefstatus);IF pruefstatus=nullTHEN startkey1:=
+jgstaufber(standardmaskenfeld(fnrjgst));startkey2:=standardmaskenfeld(
+fnrtutor);IF standardmaskenfeld(fnrtutor)=niltextTHEN bestandindex:=einejgst
+ELSE bestandindex:=eineklasseFI FI ELIF standardmaskenfeld(fnrtutor)<>niltext
+THEN pruefstatus:=fnrtutorELSE alleklassen:=TRUE FI .eingangsbildschirmok:
+pruefstatus=null.initialisierungenvornehmen:plausipruefungvorbereiten;
+bestandsetzen;standardstartproc(maske(vergleichsknoten));laengenfestlegen;IF 
+waspruefen=einejgstpruefenAND sek2THEN startebildschirmblock(
+ixhjdsjhjverjgstkenn,maxschueler);ELSE startebildschirmblock(ixhjdsjhjverjgst
+,maxschueler);FI .sek2:int(startkey1)>=sek2min.bestandsetzen:bestimmebestand;
+setzestartkeys;pruefebestand.bestimmebestand:aktschuljahr:=schulkenndatum(
+schuljahrkey);schuljahr:=subtext(aktschuljahr,1,2);schuljahr:=text(int(
+schuljahr)-1)+schuljahr;schulhalbjahr:=halbjahr2;IF alleklassenTHEN 
+alleklassensetzenELSE SELECT bestandindexOF CASE einejgst:bestandjgstCASE 
+eineklasse:bestandklasseEND SELECT FI ;.alleklassensetzen:waspruefen:=
+allespruefen;infeld(fnrjgst).bestandjgst:waspruefen:=einejgstpruefen;infeld(
+fnrjgst).bestandklasse:waspruefen:=eineklassepruefen;infeld(fnrtutor).
+setzestartkeys:putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj,schulhalbjahr);
+putwert(fnrhjdjgst,startkey1);putwert(fnrhjdkennung,startkey2);putwert(
+fnrhjdversetzung,kznachpruefung).pruefebestand:search(ixhjdsjhjverjgstkenn,
+FALSE );IF dbstatus<>nullOR (NOT pruefungspeziell(waspruefen))THEN 
+bestandleermelden;return(tofather);LEAVE bearbeitungergnachprELSE 
+nochwelcheda:=TRUE FI .laengenfestlegen:laengeklasse:=standardfeldlaenge(
+fnrklasse);laengename:=standardfeldlaenge(fnrname);laengebetr:=
+standardfeldlaenge(fnrbetr);laengefach:=standardfeldlaenge(fnrfach);
+laengenote:=standardfeldlaenge(fnrnote);laengezugtutor:=standardfeldlaenge(
+fnrzug).plausipruefungvorbereiten:standardmeldung(meldwarten,niltext);.
+naechsteportionlesen:blocklesenundausgeben.keinemehrda:NOT nochwelcheda.
+bestandleermelden:infeld(fnrjgst);standardmeldung(meldbestleer,niltext).
+eingangsmaskenfehler:standardmeldung(meldfalscheauswahl,niltext);infeld(
+pruefstatus).END PROC bearbeitungergnachpr;PROC ergnachprnichtspeichern:
+nichtspeichernmelden;startkeyssetzen;neuerblock.nichtspeichernmelden:
+standardmeldung(meldnichtspeichern,niltext);pause(10).startkeyssetzen:
+restoretupel(dnrhalbjahresdaten,hjdtupel);changeindex.END PROC 
+ergnachprnichtspeichern;PROC ergnachprspeichern:BOOL VAR 
+halbjahresdateninzwischengeaendert,schuelerdateninzwischengeaendert;TEXT VAR 
+altejgst:="",alterzug:="",neuejgst:="";pruefeplausibilitaet;IF dateninordnung
+THEN speicherungdurchfuehren;startkeyssetzen;neuerblockELSE eingabefehler;
+return(tofather)FI .pruefeplausibilitaet:standardmeldung(meldplausi,niltext);
+BOOL VAR dateninordnung:=TRUE ;INT VAR satzindex:=erstesfeld;INT VAR fehlernr
+;TEXT VAR fehlertext:=niltext;FOR suindFROM 1UPTO schuelerzahlREP pruefezeile
+;IF NOT dateninordnungTHEN LEAVE pruefeplausibilitaetFI ;satzindexINCR 
+felderprozeilePER .pruefezeile:dateninordnung:=allesfreiCOR allesrichtig.
+allesrichtig:((noterichtig)CAND (schuelergrupperichtig))CAND (fachrichtig).
+noterichtig:((NOT fehlendertutor)CAND (gueltigenote))CAND (NOT fehlendesfach)
+.fehlendertutor:fehlernr:=meldzugtutorfehlt;aktuellesfeld:=satzindex+2;
+sitzengebliebenCAND keintutor.sitzengeblieben:IF length(eingegebenenote)=1
+THEN int(eingegebenenote)>bestandengrenzeeinstelligELSE eingegebenenote<
+bestandengrenzezweistelligFI .eingegebenenote:standardmaskenfeld(satzindex+1)
+.gueltigenote:fehlernr:=meldungueltigenote;aktuellesfeld:=satzindex+1;TEXT 
+VAR pruefungsnote:=eingegebenenote;noteimbereich.noteimbereich:pruefungsnote=
+leernoteOR (notenichtzukleinCAND notenichtzugross).notenichtzuklein:IF length
+(pruefungsnote)=1THEN int(pruefungsnote)>=minnoteeinstelligELSE pruefungsnote
+>=minnotezweistelligFI .notenichtzugross:IF length(pruefungsnote)=1THEN int(
+pruefungsnote)<=maxnoteeinstelligELSE pruefungsnote<=maxnotezweistelligFI .
+fehlendesfach:fehlernr:=meldfehlendesfach;aktuellesfeld:=satzindex;bestanden
+CAND keinfach.bestanden:NOT sitzengeblieben.schuelergrupperichtig:fehlernr:=
+meldfalschesg;aktuellesfeld:=satzindex+2;fehlertext:=standardmaskenfeld(
+aktuellesfeld)+meldtrenner;keintutorCOR schuelergruppeimbestand.
+schuelergruppeimbestand:#????#putwert(fnrsgrpsj,aktschuljahr);putwert(
+fnrsgrphj,halbjahr1);putwert(fnrsgrpjgst,schuelergruppenschluessel);putwert(
+fnrsgrpkennung,eingegebenertutor);search(dnraktschuelergruppen,TRUE );
+dbstatus=null.schuelergruppenschluessel:IF bestandenCAND NOT 
+dreizehnernachprueflingTHEN jahrgangsstufeeinshoeherELSE 
+bisherigejahrgangsstufeFI .bisherigejahrgangsstufe:subtext(altedaten(suind),1
+,2).jahrgangsstufeeinshoeher:jgstaufber(text(int(bisherigejahrgangsstufe)+1))
+.eingegebenertutor:standardmaskenfeld(satzindex+2).fachrichtig:fehlernr:=
+meldfalschesfach;aktuellesfeld:=satzindex;fehlertext:=npfaecher(suind)+
+meldtrenner;keinfachCOR ausdemvorgegebenenbereich.ausdemvorgegebenenbereich:
+pos(fehlertext,eingegebenesfach)>null.eingegebenesfach:standardmaskenfeld(
+satzindex).allesfrei:(keintutorCAND keinfach)CAND keinenote.keintutor:
+eingegebenertutor=niltextCOR eingegebenertutor="abg.".keinenote:
+standardmaskenfeld(satzindex+1)=niltext.keinfach:eingegebenesfach=niltext.
+speicherungdurchfuehren:logeintragvornehmen;aendernschleife;kurzwarten.
+logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;IF alleklassenTHEN 
+eintragCAT logtextalleklassenELSE eintragCAT startkey1;eintragCAT startkey2
+FI ;logeintrag(eintrag).kurzwarten:pause(10).aendernschleife:INT VAR suind;
+INT VAR zahlderaenderungen:=null;satzindex:=erstesfeld-abstandzumnamen;FOR 
+suindFROM 1UPTO schuelerzahlREP behandleschuelersatz;satzindexINCR 
+felderprozeilePER .behandleschuelersatz:IF datenveraendertTHEN 
+aenderungvorbereiten;IF zwischenzeitlichgeaendertTHEN transaktionsfehlerELSE 
+dateninpuffersetzen;schreibtransaktion;meldevollzugFI ;FI ;.datenveraendert:
+subtext(altedaten(suind),laengeklasse+1)<>jetzigedaten.jetzigedaten:INT VAR 
+datenfeldanfang:=satzindex+abstandzumnamen;standardmaskenfeld(datenfeldanfang
+)+standardmaskenfeld(datenfeldanfang+1)+standardmaskenfeld(datenfeldanfang+2)
+.aenderungvorbereiten:lesenvorbereiten;lesen.lesenvorbereiten:
+zahlderaenderungenINCR 1;key(1):=name(suind);key(2):=rufname(suind);key(3):=
+datumrekonversion(gebdatum(suind));schluesselfuerhjddateisetzen.
+schluesselfuerhjddateisetzen:schluesselfuerhjdsetzen(dnrhalbjahresdaten,key,
+schuljahr,halbjahr2,"").lesen:search(dnrhalbjahresdaten,TRUE );
+halbjahresdateninzwischengeaendert:=(dbstatus<>ok);IF dbstatus=okTHEN 
+saveupdateposition(dnrhalbjahresdaten);savetupel(dnrhalbjahresdaten,sichtupel
+);altejgst:=jgstaufber(wert(fnrhjdjgst));schluesselfuerschuelerdateisetzen;
+search(dnrschueler,TRUE );schuelerdateninzwischengeaendert:=(dbstatus<>ok);
+IF dbstatus=okTHEN alterzug:=wert(fnrsusgrpzugtut);saveupdateposition(
+dnrschueler);savetupel(dnrschueler,schuelertupel)FI FI .
+zwischenzeitlichgeaendert:halbjahresdateninzwischengeaendertOR 
+schuelerdateninzwischengeaendert.transaktionsfehler:standardmeldung(
+meldtransaktionsfehler,niltext);return(tofather);infeld(satzindex+
+abstandzumnamen);LEAVE ergnachprspeichern.dateninpuffersetzen:IF jetzigedaten
+=niltextTHEN noteundfachsetzen;schuelerdatenaendernELIF nichtbestandenTHEN 
+nichtbestandenneuELSE notenfachundneuerzugFI ;neuerzugtutorloeschen.
+schuelerdatenaendern:putwert(fnrsustatuss,bestandlaufsj);IF 
+dreizehnernachprueflingTHEN putwert(fnrsusgrpjgst,text(jgst13));putwert(
+fnrsuartzugang,dreizehnnachprsatz)ELSE neuejgst:=jgstaufber(text(int(altejgst
+)+1));putwert(fnrsusgrpjgst,neuejgst);putwert(fnrsusgrpzugtut,wert(
+fnrhjdkennung));putwert(fnrsuartzugang,kznachpruefung)FI .nichtbestanden:
+datenfeldanfang:=satzindex+abstandzumnamen;IF length(standardmaskenfeld(
+datenfeldanfang+1))=1THEN int(standardmaskenfeld(datenfeldanfang+1))>
+bestandengrenzeeinstelligELSE standardmaskenfeld(datenfeldanfang+1)<
+bestandengrenzezweistelligFI .notenfachundneuerzug:noteundfachsetzen;IF 
+dreizehnernachprueflingTHEN dreizehnerabmeldenELSE neuejgst:=jgstaufber(text(
+int(altejgst)+1));putwert(fnrsusgrpjgst,neuejgst);putwert(fnrsuartzugang,
+kznachpruefung);neuerzugsetzenFI .noteundfachsetzen:TEXT VAR fach:=
+standardmaskenfeld(datenfeldanfang);TEXT VAR note:=standardmaskenfeld(
+datenfeldanfang+1);putwert(fnrhjdnachfach,fach);putwert(fnrhjdnacherg,note).
+dreizehnernachpruefling:dreizehner(suind).dreizehnerabmelden:putwert(
+fnrsustatuss,bestandabgegangene);putwert(fnrsuabgdats,schulkenndatum(
+anfangschuljahrkey)).neuerzugsetzen:TEXT VAR neuerzug;neuerzug:=
+standardmaskenfeld(datenfeldanfang+2);IF neuerzug<>niltextTHEN IF neuerzug<>
+alterzugTHEN putwert(fnrsusgrpzugtut,neuerzug);FI ELSE IF jgstaufber(wert(
+fnrsusgrpjgst))=altejgstTHEN putwert(fnrsusgrpzugtut,wert(fnrhjdkennung))FI 
+FI ;zuginakthjdaendern.zuginakthjdaendern:savetupel(dnrhalbjahresdaten,
+sichtupel);neueklasseinhalbjahresdateneintragen(key,aktschuljahr,halbjahr1,
+neuejgst,neuerzug);IF dbstatus=okTHEN putwert(fnrsutidakthjd,gettid)FI ;
+restoretupel(dnrhalbjahresdaten,sichtupel).nichtbestandenneu:
+noteundfachsetzen;setzezugang;savetupel(dnrhalbjahresdaten,sichtupel);
+setzejgstrunter;halbjahresdatenbearbeiten;restoretupel(dnrhalbjahresdaten,
+sichtupel).setzezugang:putwert(fnrsuartzugang,geaendertersatz).
+setzejgstrunter:neuejgst:=jgstaufber(text(int(altejgst)));neuerzug:=
+standardmaskenfeld(datenfeldanfang+2);putwert(fnrsusgrpjgst,neuejgst);putwert
+(fnrsusgrpzugtut,neuerzug);putwert(fnrsustatuss,bestandlaufsj);.
+halbjahresdatenbearbeiten:IF NOT dreizehnernachprueflingTHEN 
+nachfolgendehjdsloeschen;FI .nachfolgendehjdsloeschen:halbjahresdatenloeschen
+(PROC (INT CONST )succ,key,halbjahr2,int(neuejgst),FALSE );.
+neuerzugtutorloeschen:putwert(fnrsuneuerzugtut,niltext).schreibtransaktion:
+restoreupdateposition(dnrhalbjahresdaten);selupdate(dnrhalbjahresdaten);IF 
+dbstatus<>okTHEN restoretupel(dnrschueler,schuelertupel)ELSE 
+restoreupdateposition(dnrschueler);selupdate(dnrschueler);IF dbstatus<>ok
+THEN restoretupel(dnrschueler,schuelertupel)ELSE IF int(neuejgst)=int(
+altejgst)THEN evtlkurswahldatenfuerwiederholerbehandelnFI ;FI FI .
+evtlkurswahldatenfuerwiederholerbehandeln:IF int(neuejgst)>=jgstufe10THEN 
+kurswahlserveraktualisieren(neuejgst,"","")FI ;IF (int(neuejgst)+1)>=
+jgstufe10THEN kurswahlserveraktualisieren(text(int(neuejgst)+1),"","")FI .
+meldevollzug:TEXT VAR meldungstext;IF dbstatus=0THEN meldungstext:=compress(
+standardmaskenfeld(satzindex))+meldtrenner;standardmeldung(meldspeicherung,
+meldungstext)ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT 
+compress(standardmaskenfeld(satzindex));meldungstextCAT meldtrenner;
+standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE 
+ergnachprspeichernFI ;infeld(satzindex+abstandzumnamen).startkeyssetzen:
+restoretupel(dnrhalbjahresdaten,hjdtupel);changeindex.eingabefehler:
+standardmeldung(fehlernr,fehlertext);infeld(aktuellesfeld).END PROC 
+ergnachprspeichern;PROC neuerblock:blocklesenundausgeben;IF nochwelchedaTHEN 
+return(tofather)ELSE enter(tograndfather)FI .END PROC neuerblock;PROC 
+blocklesenundausgeben:vorbereiten;initgruppenwechsel;gewuenschteszeigen;
+nachbereiten.vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgeben
+FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:=
+standardeinstieg.gewuenschteszeigen:bildschirmblock(PROC datenzeigen,BOOL 
+PROC (INT CONST )pruefungspeziell,waspruefen).nachbereiten:nochwelcheda:=(
+schuelerzahl>null);IF nochwelchedaTHEN savetupel(dnrhalbjahresdaten,hjdtupel)
+;restlichezeilenloeschen;infeld(standardanfang);standardfelderausgebenELSE 
+LEAVE blocklesenundausgebenFI ;infeld(erstesfeld).restlichezeilenloeschen:
+INT VAR zeilenzaehler;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+1;
+FOR zeilenzaehlerFROM schuelerzahlUPTO schuelerproseite-1REP loeschezeilePER 
+.loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP 
+zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,
+zeilenfeld);feldschutz(zeilenfeld)PER ;.END PROC blocklesenundausgeben;PROC 
+datenzeigen:TEXT VAR merkdaten:=niltext;zaehlen;zeigenundmerken.zaehlen:
+schuelerzahlINCR 1.zeigenundmerken:altejgstzeigen;namezeigen;aktjgstzeigen;
+fachzeigen;npfaechermerken;notezeigen;neuerzugtutorzeigen.altejgstzeigen:IF 
+dreizehnerzurnachpruefungTHEN aenderungsetzenELSE neusetzenFI ;
+betreffendeszeigen.dreizehnerzurnachpruefung:intwert(fnrhjdjgst)=jgst13.
+aenderungsetzen:BOOL VAR satzgeaendert:=TRUE ;.neusetzen:satzgeaendert:=
+FALSE ;.betreffendeszeigen:TEXT VAR alteklasse:=jgstaufber(wert(fnrhjdjgst))+
+wert(fnrhjdkennung);dreizehner(schuelerzahl):=satzgeaendert;
+standardmaskenfeld(text(alteklasse,laengeklasse),aktuellesfeld);merkdaten:=
+text(alteklasse,laengeklasse);gruppenwechsel(alteklasse,gwklasse,laengeklasse
+,1,aktuellesfeld);.namezeigen:namenretten;standardmaskenfeld(text(
+schuelername+namenstrenner+schuelervorname,laengename),aktuellesfeld);
+aktuellesfeldINCR 1.namenretten:TEXT VAR schuelername,schuelervorname;
+schuelername:=wert(fnrhjdfamnames);schuelervorname:=wert(fnrhjdrufnames);name
+(schuelerzahl):=schuelername;rufname(schuelerzahl):=schuelervorname;gebdatum(
+schuelerzahl):=wert(fnrhjdgebdats).aktjgstzeigen:TEXT VAR aktklasse:=niltext;
+schluesselfuerschuelerdateisetzen;search(dnrschueler,TRUE );IF dbstatus=ok
+THEN aktklasse:=jgstaufber(wert(fnrsusgrpjgst))+wert(fnrsusgrpzugtut)FI ;
+standardmaskenfeld(aktklasse,aktuellesfeld);aktuellesfeldINCR 1.fachzeigen:
+TEXT VAR fach:=niltext,faecher:=niltext;fach:=wert(fnrhjdnachfach);merkdaten
+CAT fach;standardmaskenfeld(fach,aktuellesfeld);feldfrei(aktuellesfeld);
+aktuellesfeldINCR 1.npfaechermerken:INT VAR fachind;FOR fachindFROM 
+fnrhjdnachfach1UPTO fnrhjdnachfach1+2REP faecherCAT wert(fachind);faecherCAT 
+namenstrenner;PER ;npfaecher(schuelerzahl):=faecher.notezeigen:TEXT VAR note;
+note:=wert(fnrhjdnacherg);merkdatenCAT note;standardmaskenfeld(note,
+aktuellesfeld);feldfrei(aktuellesfeld);aktuellesfeldINCR 1.
+neuerzugtutorzeigen:#????#TEXT VAR tutor;IF wert(fnrsustatuss)=
+bestandabgegangeneTHEN tutor:=bestandabgegangene+punktELSE tutor:=niltext;#
+wert(fnrsusgrpzugtut);15.07.87dr#FI ;merkdatenCAT tutor;standardmaskenfeld(
+tutor,aktuellesfeld);altedaten(schuelerzahl):=merkdaten;feldfrei(
+aktuellesfeld);aktuellesfeldINCR 1.END PROC datenzeigen;PROC 
+schluesselfuerschuelerdateisetzen:inittupel(dnrschueler);putwert(
+fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert(fnrhjdrufnames
+));putwert(fnrsugebdatums,wert(fnrhjdgebdats));.END PROC 
+schluesselfuerschuelerdateisetzen;PROC feldloeschen(INT CONST laenge):
+standardmaskenfeld(laenge*blank,aktuellesfeld)END PROC feldloeschen;BOOL 
+PROC pruefungspeziell(INT CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT 
+wasistzutunOF CASE allespruefen:pruefungalleklassen(b)CASE einejgstpruefen:
+pruefungeinejgst(b)CASE eineklassepruefen:pruefungeineklasse(b)END SELECT ;b
+END PROC pruefungspeziell;PROC pruefungalleklassen(BOOL VAR bool):bool:=(wert
+(fnrhjdsj)=schuljahrCAND wert(fnrhjdhj)=schulhalbjahrCAND wert(
+fnrhjdversetzung)=kznachpruefung)END PROC pruefungalleklassen;PROC 
+pruefungeinejgst(BOOL VAR bool):bool:=(wert(fnrhjdsj)=schuljahrCAND wert(
+fnrhjdhj)=schulhalbjahrCAND wert(fnrhjdversetzung)=kznachpruefungCAND 
+jgstaufber(wert(fnrhjdjgst))=startkey1)END PROC pruefungeinejgst;PROC 
+pruefungeineklasse(BOOL VAR bool):bool:=(wert(fnrhjdsj)=schuljahrCAND wert(
+fnrhjdhj)=schulhalbjahrCAND wert(fnrhjdversetzung)=kznachpruefungCAND 
+jgstaufber(wert(fnrhjdjgst))=startkey1CAND wert(fnrhjdkennung)=startkey2)END 
+PROC pruefungeineklasse;END PACKET listenweiseergnachpr
+
diff --git a/app/schulis/2.2.1/src/1.listenweise erg vers konf b/app/schulis/2.2.1/src/1.listenweise erg vers konf
new file mode 100644
index 0000000..83ce515
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listenweise erg vers konf
@@ -0,0 +1,219 @@
+PACKET listenweiseergverskonfDEFINES bearbeitungergverskonf,
+ergverskonfnichtspeichern,ergverskonfspeichern:LET tofather=1,tograndfather=2
+,jgst5=5,jgst13=13,leerejgst="  ",maxfach=3,niltext="",blank=" ",
+namenstrenner=", ",unterstrich="_",null=0,leererzug="    ",meldtrenner="#";
+LET nachpruefling="n",versetzter="vs",wiederholer="wf";LET schuljahrkey=
+"Schuljahr",schulhalbjahrkey="Schulhalbjahr";LET maxschueler=15,erstesfeld=2,
+felderprozeile=4,schuelerproseite=16,laengefach=2;LET gwklasse=1;LET 
+meldbestleer=59,meldnichtspeichern=63,meldplausi=57,meldwarten=69,
+meldspeicherung=132,meldspeicherfehler=131,meldfalscheauswahl=56,
+meldtransaktionsfehler=138,meldfalscheeingabe1=136,meldfalscheeingabe2=137,
+meldungueltigesfach=149;LET pruefartgrenzen=3;LET fnrjgst=2,fnrtutor=3,
+fnrklasse=2,fnrname=3,fnrvers=4,fnrnachprfaecher=5;LET einejgst=2,eineklasse=
+3;LET standardanfang=1,standardeinstieg=4;LET allespruefen=1,einejgstpruefen=
+2,eineklassepruefen=3;LET anzkenndaten=3,sek2min=11,laufbestand="ls";LET 
+logtextbeginn="Anw. 1.4.4 Versetzungen für ",logtextalleklassen=
+"alle Klassen";BOOL VAR nochwelcheda,alleklassen;INT VAR waspruefen:=0;INT 
+VAR laengeklasse,laengename,laengenachprfaecher,bestandindex,laengevers,
+schuelerzahl,aktuellesfeld;ROW schuelerproseiteROW anzkenndatenTEXT VAR 
+kenndatum;ROW schuelerproseiteTEXT VAR altedaten;TEXT VAR schuelertid:="",
+hjdtid:="";TEXT VAR versetzungszeichen:="";TEXT VAR startkey1,startkey2,
+sicherungstupel,vergleichsjgst,zulaessigekuerzel,schuljahr,schulhalbjahr,
+gueltigejgst,gueltigerzug;TEXT VAR fachkatalog:="";LET trenner="�";PROC 
+bearbeitungergverskonf:reinitparsing;eingangsbildschirmpruefen;IF 
+eingangsbildschirmokTHEN initialisierungenvornehmen;naechsteportionlesen;IF 
+keinemehrdaTHEN bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE 
+eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen:INT VAR 
+pruefstatus:=null;startkey1:=niltext;startkey2:=niltext;vergleichsjgst:=
+niltext;alleklassen:=FALSE ;IF standardmaskenfeld(fnrjgst)<>niltextTHEN 
+standardpruefe(pruefartgrenzen,fnrjgst,jgst5,jgst13,niltext,pruefstatus);IF 
+pruefstatus=nullTHEN startkey1:=jgstaufber(standardmaskenfeld(fnrjgst));
+vergleichsjgst:=startkey1;startkey2:=standardmaskenfeld(fnrtutor);IF 
+standardmaskenfeld(fnrtutor)=niltextTHEN bestandindex:=einejgstELSE 
+bestandindex:=eineklasseFI FI ELIF standardmaskenfeld(fnrtutor)<>niltextTHEN 
+pruefstatus:=fnrtutorELSE alleklassen:=TRUE FI .eingangsbildschirmok:
+pruefstatus=null.initialisierungenvornehmen:plausipruefungvorbereiten;
+bestandsetzen;standardstartproc(maske(vergleichsknoten));laengenfestlegen;IF 
+waspruefen=einejgstpruefenCAND sek2THEN startebildschirmblock(ixsustatjgst,
+maxschueler);ELSE startebildschirmblock(ixsustatjgstzug,maxschueler);FI .sek2
+:int(startkey1)>=sek2min.bestandsetzen:bestimmebestand;setzestartkeys;
+pruefebestand.bestimmebestand:schuljahr:=schulkenndatum(schuljahrkey);
+schulhalbjahr:=schulkenndatum(schulhalbjahrkey);IF alleklassenTHEN 
+alleklassensetzenELSE SELECT bestandindexOF CASE einejgst:bestandjgstCASE 
+eineklasse:bestandklasseEND SELECT FI ;.alleklassensetzen:waspruefen:=
+allespruefen;infeld(fnrjgst).bestandjgst:waspruefen:=einejgstpruefen;infeld(
+fnrjgst).bestandklasse:waspruefen:=eineklassepruefen;infeld(fnrtutor).
+setzestartkeys:inittupel(dnrschueler);putwert(fnrsustatuss,laufbestand);
+putwert(fnrsusgrpjgst,startkey1);putwert(fnrsusgrpzugtut,startkey2);.
+pruefebestand:IF waspruefen=einejgstpruefenCAND sek2THEN search(ixsustatjgst,
+FALSE )ELSE search(ixsustatjgstzug,FALSE )FI ;IF dbstatus<>nullCOR (NOT 
+pruefungspeziell(waspruefen))THEN bestandleermelden;return(tofather);LEAVE 
+bearbeitungergverskonfELSE nochwelcheda:=TRUE FI .laengenfestlegen:
+laengeklasse:=standardfeldlaenge(fnrklasse);laengename:=standardfeldlaenge(
+fnrname);laengevers:=standardfeldlaenge(fnrvers);laengenachprfaecher:=
+standardfeldlaenge(fnrnachprfaecher).plausipruefungvorbereiten:
+standardmeldung(meldwarten,niltext);zulaessigekuerzel:=nachpruefling+
+versetzter+wiederholer+blank.naechsteportionlesen:blocklesenundausgeben.
+keinemehrda:NOT nochwelcheda.bestandleermelden:infeld(fnrjgst);
+standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:standardmeldung(
+meldfalscheauswahl,niltext);infeld(pruefstatus).END PROC 
+bearbeitungergverskonf;PROC ergverskonfnichtspeichern:nichtspeichernmelden;
+startkeyssetzen;neuerblock.nichtspeichernmelden:standardmeldung(
+meldnichtspeichern,niltext);pause(10).startkeyssetzen:restoretupel(
+dnrschueler,sicherungstupel);#dr02.05.88#changeindex.END PROC 
+ergverskonfnichtspeichern;PROC ergverskonfspeichern:BOOL VAR hjdgefunden:=
+FALSE ;pruefeplausibilitaet;IF dateninordnungTHEN speicherungdurchfuehren;
+startkeyssetzen;neuerblockELSE eingabefehler;return(tofather)FI .
+pruefeplausibilitaet:standardmeldung(meldplausi,niltext);BOOL VAR 
+dateninordnung:=TRUE ,richtigesverskz,ungueltigefachangaben:=FALSE ,
+fachfehler:=FALSE ;INT VAR versfeld:=felderprozeile;FOR suindFROM 1UPTO 
+schuelerzahlREP pruefezeile;IF NOT dateninordnungTHEN LEAVE 
+pruefeplausibilitaetFI ;versfeldINCR felderprozeilePER .pruefezeile:TEXT VAR 
+gefundenesverskz:=standardmaskenfeld(versfeld);richtigesverskz:=
+gefundenesverskz=niltextOR (pos(zulaessigekuerzel,gefundenesverskz)>null);IF 
+richtigesverskzTHEN pruefefachangabenzuverskz;IF ungueltigefachangabenTHEN 
+dateninordnung:=FALSE FI ELSE dateninordnung:=FALSE FI .
+pruefefachangabenzuverskz:IF gefundenesverskz<>nachprueflingTHEN IF NOT 
+keineeingabenTHEN ungueltigefachangaben:=TRUE FI ELSE pruefefachangaben;IF 
+fachfehlerTHEN ungueltigefachangaben:=TRUE FI FI .pruefefachangaben:IF 
+fachkatalog=niltextTHEN holeaktuellenfachkatalogFI ;TEXT VAR fachangaben:=
+standardmaskenfeld(versfeld+1);INT VAR lenfachang:=length(fachangaben);INT 
+VAR fachanzahl:=(lenfachang+1)DIV laengefach;INT VAR i;TEXT VAR fach;FOR i
+FROM 0UPTO fachanzahl-1REP fach:=subtext(fachangaben,i*laengefach+1,i*
+laengefach+laengefach);changeall(fach,unterstrich,niltext);fach:=compress(
+fach);IF fach<>niltextCAND fachungueltig(fach)THEN fachfehler:=TRUE FI UNTIL 
+fachfehlerPER .keineeingaben:BOOL VAR b:=TRUE ;INT VAR lv;TEXT VAR t:=
+standardmaskenfeld(versfeld+1);FOR lvFROM 1UPTO length(t)REP b:=(tSUB lv)=
+unterstrichUNTIL NOT bPER ;b.speicherungdurchfuehren:vorbereiten;
+logeintragvornehmen;aendernschleife;kurzwarten.logeintragvornehmen:TEXT VAR 
+eintrag:=logtextbeginn;IF alleklassenTHEN eintragCAT logtextalleklassenELSE 
+eintragCAT startkey1;eintragCAT startkey2FI ;logeintrag(eintrag).kurzwarten:
+pause(10).vorbereiten:gueltigejgst:=vergleichsjgst;gueltigerzug:=startkey2;.
+aendernschleife:INT VAR suind;INT VAR zahlderaenderungen:=null;INT VAR 
+satzindex:=felderprozeile-1;FOR suindFROM 1UPTO schuelerzahlREP 
+behandleschuelersatz;satzindexINCR felderprozeilePER .behandleschuelersatz:
+IF vergleichsjgst=niltextTHEN gueltigejgstneubestimmenFI ;IF startkey2=
+niltextTHEN gueltigenzugneubestimmenFI ;IF datenveraendertTHEN 
+fuehreaenderungaus;meldevollzugFI .gueltigejgstneubestimmen:TEXT VAR 
+pruefjgst:=subtext(standardmaskenfeld(satzindex-1),1,2);IF pruefjgst<>
+leerejgstTHEN gueltigejgst:=pruefjgstFI ;.gueltigenzugneubestimmen:TEXT VAR 
+pruefzug:=subtext(standardmaskenfeld(satzindex-1),3,6);IF pruefzug<>leererzug
+THEN gueltigerzug:=pruefzugFI .datenveraendert:altedaten(suind)<>(
+standardmaskenfeld(satzindex+1)+standardmaskenfeld(satzindex+2)).
+fuehreaenderungaus:lesenvorbereiten;lesen;hjdgefunden:=dbstatus=ok;IF 
+dbstatus=okTHEN saveupdateposition(dnrhalbjahresdaten);hjdtid:=gettid;
+versetzungszeichen:=wert(fnrhjdversetzung);zurueckschreiben;ELSE 
+versetzungszeichen:=niltext;neuensatzankoppelnFI .lesenvorbereiten:
+zahlderaenderungenINCR 1;schluesselfuerhjdsetzen(dnrhalbjahresdaten,kenndatum
+[suind],schuljahr,schulhalbjahr,gueltigejgst);.lesen:search(
+dnrhalbjahresdaten,TRUE );.zurueckschreiben:IF datenaenderungTHEN 
+transaktionsfehlerELSE schreibtransaktionFI .datenaenderung:(
+versetzungsergebnis+nachpruefungsfaecher)<>altedaten(suind).
+versetzungsergebnis:wert(fnrhjdversetzung).transaktionsfehler:standardmeldung
+(meldtransaktionsfehler,niltext);return(tofather);infeld(suind*felderprozeile
+);LEAVE ergverskonfspeichern.schreibtransaktion:setzedaten;
+vorhandenensatzaendern.setzedaten:setzeverskz;setzefaecherdaten.setzeverskz:
+putwert(fnrhjdversetzung,standardmaskenfeld(satzindex+1)).setzefaecherdaten:
+INT VAR fachindanfang:=1,fachindende:=2;INT VAR fachind;TEXT VAR 
+eingegebenenpfaecher:=standardmaskenfeld(satzindex+2);TEXT VAR einzelfach;
+FOR fachindFROM 0UPTO maxfach-1REP einzelfach:=subtext(eingegebenenpfaecher,
+fachindanfang,fachindende);IF einzelfach<>laengefach*unterstrichTHEN 
+changeall(einzelfach,unterstrich,niltext);putwert(fnrhjdnachfach1+fachind,
+compress(einzelfach))ELSE putwert(fnrhjdnachfach1+fachind,niltext)FI ;
+fachindanfangINCR laengefach;fachindendeINCR laengefach;PER .
+vorhandenensatzaendern:IF standardmaskenfeld(satzindex+1)<>versetzungszeichen
+THEN restoreupdateposition(dnrhalbjahresdaten);#update(dnrhalbjahresdaten);
+dr10.05.88#selupdate(dnrhalbjahresdaten)ELSE replace(dnrhalbjahresdaten,
+hjdtid)FI .neuensatzankoppeln:setzedaten;putwert(fnrhjdkennung,compress(
+gueltigerzug));insert(dnrhalbjahresdaten);hjdtid:=gettid;.meldevollzug:TEXT 
+VAR meldungstext;IF dbstatus=0THEN IF NOT hjdgefundenTHEN 
+neueshjdtidinschuelerdateieintragen(satzindex+1);FI ;#dr04.05.88hjdtid:=
+gettid;neueshjdtidinschuelerdateieintragen(satzindex+1);##dr10.05.88
+eventuellinstatwuerfelaendern(satzindex+1);#meldungstext:=compress(
+standardmaskenfeld(satzindex))+meldtrenner;standardmeldung(meldspeicherung,
+meldungstext)ELSE meldungstext:=text(dbstatus)+meldtrenner;meldungstextCAT 
+compress(standardmaskenfeld(satzindex));meldungstextCAT meldtrenner;
+standardmeldung(meldspeicherfehler,meldungstext);return(tofather);LEAVE 
+ergverskonfspeichernFI ;infeld(satzindex+1).startkeyssetzen:restoretupel(
+dnrschueler,sicherungstupel);#dr02.05.88#changeindex.eingabefehler:IF NOT 
+richtigesverskzTHEN standardmeldung(meldfalscheeingabe1,standardmaskenfeld(
+versfeld)+meldtrenner);infeld(versfeld)ELIF fachfehlerTHEN standardmeldung(
+meldungueltigesfach,fach+meldtrenner);infeld(versfeld+1)ELSE standardmeldung(
+meldfalscheeingabe2,niltext);infeld(versfeld+1)FI .END PROC 
+ergverskonfspeichern;PROC neuerblock:blocklesenundausgeben;IF nochwelcheda
+THEN return(tofather)ELSE enter(tograndfather)FI .END PROC neuerblock;PROC 
+blocklesenundausgeben:parsenooffields(fnrhjdnachfach3-dnrhalbjahresdaten);
+vorbereiten;initgruppenwechsel;gewuenschteszeigen;nachbereiten;reinitparsing.
+vorbereiten:IF NOT nochwelchedaTHEN reinitparsing;LEAVE blocklesenundausgeben
+FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:=
+erstesfeld.gewuenschteszeigen:parsenooffields(12);#dr04.05.88#bildschirmblock
+(PROC datenzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen);
+reinitparsing#dr04.05.88#.nachbereiten:nochwelcheda:=(schuelerzahl>null);IF 
+nochwelchedaTHEN savetupel(dnrschueler,sicherungstupel);#dr02.05.88#
+restlichezeilenloeschen;infeld(standardanfang);standardfelderausgebenELSE 
+LEAVE blocklesenundausgebenFI ;infeld(standardeinstieg).
+restlichezeilenloeschen:INT VAR zeilenzaehler;INT VAR zeilenfeld:=(
+schuelerzahl*felderprozeile)+1;FOR zeilenzaehlerFROM schuelerzahlUPTO 
+maxschuelerREP loeschezeilePER .loeschezeile:INT VAR zeilenincr;FOR 
+zeilenincrFROM 1UPTO felderprozeileREP zeilenfeldINCR 1;standardmaskenfeld(
+standardfeldlaenge(zeilenfeld)*blank,zeilenfeld);feldschutz(zeilenfeld)PER .
+END PROC blocklesenundausgeben;PROC namezeigen:namenretten;standardmaskenfeld
+(text(schuelername+namenstrenner+schuelervorname,laengename),aktuellesfeld);
+aktuellesfeldINCR 1.namenretten:TEXT VAR schuelername,schuelervorname;
+schuelername:=wert(fnrsufamnames);schuelervorname:=wert(fnrsurufnames);
+kenndatum[schuelerzahl][1]:=schuelername;kenndatum[schuelerzahl][2]:=
+schuelervorname;kenndatum[schuelerzahl][3]:=datumrekonversion(wert(
+fnrsugebdatums));.END PROC namezeigen;PROC datenzeigen:BOOL VAR neuerstellen
+:=FALSE ;zeigen;merken.zeigen:vorbereiten;alteklassezeigen;namezeigen;
+halbjahresdatensuchen;versetzungsdatenzeigen.vorbereiten:schuelerzahlINCR 1;
+TEXT VAR merkdaten:=niltext.alteklassezeigen:TEXT CONST alteklasse:=
+jgstaufber(wert(fnrsusgrpjgst))+wert(fnrsusgrpzugtut);gruppenwechsel(
+alteklasse,gwklasse,laengeklasse,1,aktuellesfeld).halbjahresdatensuchen:
+inittupel(dnrhalbjahresdaten);#schluesselfuerhjdsetzen(dnrhalbjahresdaten,
+kenndatum[schuelerzahl],schuljahr,schulhalbjahr,startkey1);search(
+dnrhalbjahresdaten,TRUE );neuerstellen:=dbstatus<>ok##dr04.05.88#IF wert(
+fnrsutidakthjd)<>niltext#neudr04.05.88#THEN disablestop;readtid(
+dnrhalbjahresdaten,wert(fnrsutidakthjd));IF iserrorTHEN clearerror;
+neuerstellen:=TRUE ELSE neuerstellen:=FALSE FI ;enablestopELSE neuerstellen:=
+TRUE FI .versetzungsdatenzeigen:versetzunginmaske;feldfreigeben;
+nachprfaecherinmaske;feldfreigeben.versetzunginmaske:TEXT VAR versetzungskz:=
+niltext;IF NOT neuerstellenTHEN versetzungskz:=wert(fnrhjdversetzung);FI ;
+merkdatenCAT versetzungskz;standardmaskenfeld(versetzungskz,aktuellesfeld).
+nachprfaecherinmaske:TEXT VAR nachprfaecher:=niltext;IF NOT neuerstellenTHEN 
+nachprfaecher:=nachpruefungsfaecher;FI ;merkdatenCAT nachprfaecher;
+standardmaskenfeld(nachprfaecher,aktuellesfeld).feldfreigeben:feldfrei(
+aktuellesfeld);aktuellesfeldINCR 1.merken:altedaten(schuelerzahl):=merkdaten.
+END PROC datenzeigen;TEXT PROC nachpruefungsfaecher:TEXT VAR nfaecher:=
+niltext;INT VAR fachind;FOR fachindFROM 0UPTO maxfach-1REP IF wert(
+fnrhjdnachfach1+fachind)=niltextTHEN nfaecherCAT (laengefach*unterstrich)
+ELSE nfaecherCAT text(wert(fnrhjdnachfach1+fachind),laengefach);FI PER ;
+nfaecherEND PROC nachpruefungsfaecher;PROC feldloeschen(INT CONST laenge):
+standardmaskenfeld(laenge*blank,aktuellesfeld)END PROC feldloeschen;BOOL 
+PROC pruefungspeziell(INT CONST wasistzutun):BOOL VAR b:=FALSE ;SELECT 
+wasistzutunOF CASE allespruefen:pruefungalleklassen(b)CASE einejgstpruefen:
+pruefungeinejgst(b)CASE eineklassepruefen:pruefungeineklasse(b)END SELECT ;b
+END PROC pruefungspeziell;PROC pruefungalleklassen(BOOL VAR bool):bool:=(wert
+(fnrsustatuss)=laufbestand)END PROC pruefungalleklassen;PROC pruefungeinejgst
+(BOOL VAR bool):bool:=(wert(fnrsustatuss)=laufbestandCAND jgstaufber(wert(
+fnrsusgrpjgst))=startkey1)END PROC pruefungeinejgst;PROC pruefungeineklasse(
+BOOL VAR bool):bool:=(wert(fnrsustatuss)=laufbestandCAND jgstaufber(wert(
+fnrsusgrpjgst))=startkey1CAND wert(fnrsusgrpzugtut)=startkey2)END PROC 
+pruefungeineklasse;PROC neueshjdtidinschuelerdateieintragen(INT CONST nr):IF 
+standardmaskenfeld(nr)<>versetzungszeichenTHEN inittupel(dnrschueler);putwert
+(fnrsufamnames,wert(fnrhjdfamnames));putwert(fnrsurufnames,wert(
+fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats));search(
+dnrschueler,TRUE );IF dbstatus=okTHEN schuelertid:=gettid;putwert(
+fnrsutidakthjd,hjdtid);replace(dnrschueler,schuelertid)FI FI END PROC 
+neueshjdtidinschuelerdateieintragen;BOOL PROC fachungueltig(TEXT CONST objekt
+):pos(fachkatalog,trenner+objekt+trenner)=0END PROC fachungueltig;PROC 
+fachcat(BOOL VAR b):fachkatalogCAT wert(dnrfaecher+1)+trenner;END PROC 
+fachcat;PROC holeaktuellenfachkatalog:fachkatalog:=trenner;statleseschleife(
+dnrfaecher,"","",dnrfaecher+1,dnrfaecher+1,PROC fachcat);END PROC 
+holeaktuellenfachkatalog;#dr10.05.88PROC eventuellinstatwuerfelaendern(INT 
+CONST nummer):IF standardmaskenfeld(nummer)<>versetzungszeichenTHEN 
+kuerzelsummeeinsrunter(statnrversetzung,jgstaufber(gueltigejgst),compress(
+gueltigerzug),compress(laufbestand),compress(versetzungszeichen));
+kuerzelsummeeinsrauf(statnrversetzung,jgstaufber(gueltigejgst),compress(
+gueltigerzug),compress(laufbestand),compress(standardmaskenfeld(nummer)));FI 
+END PROC eventuellinstatwuerfelaendern;#END PACKET listenweiseergverskonf
+
diff --git a/app/schulis/2.2.1/src/1.listenweise klassenbildung b/app/schulis/2.2.1/src/1.listenweise klassenbildung
new file mode 100644
index 0000000..c563019
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.listenweise klassenbildung
@@ -0,0 +1,270 @@
+PACKET listenweiseklassenbildungDEFINES bearbeitungklassenbildung,
+klassenbildungnichtspeichern,klassenbildungspeichern:LET meldbestleer=59,
+meldnichtspeichern=63,meldwarten=69,meldspeicherung=132,meldspeicherfehler=
+131,meldplausi=57,meldfalscheauswahl=56,meldexistiertnicht=134,
+meldzuggewechselt=135,meldfalscheshj=78;LET meldtrenner="#",meldkznorm="+";
+LET fnrneuan5=2,fnrneuan11=3,fnrneuansonst=4,fnrjgst=5,fnrtutor=6,
+fnrnurnichtvers=7,fnrgeplhj=8,fnrakthj=9;LET fnrherk=2,fnralteklasse=3,
+fnrname=4,fnrneueklasse=5;LET tofather=1,tograndfather=2;LET niltext="",blank
+=" ",namenstrenner=", ";LET pruefartalternative=5,pruefartgrenzen=3,jgst5=5,
+jgst13=13,null=0,freigabeincr=2;LET schuljahrkey="Schuljahr",schulhalbjahrkey
+="Schulhalbjahr",best5="n05",best11="n11",bestsonst="nso",bestlaufsj="ls";
+LET jgst05="05",jgst11="11",maxjgst="13",leerejgst="  ";LET kzwiederholer="w"
+;LET standardanfang=1,standardeinstieg=6;LET ersteskommendeshj=1,
+geplanteszweiteshj=2,aktuelleshj=3;LET maxschueler=15,erstesfeld=2,
+felderprozeile=5,schuelerproseite=16,anzkenndaten=3;LET gwherk=1,gwalteklasse
+=2,gwneuejgst=3;LET logtextbeginn="Anw. 1.4.1 Klassenbildung ",logtextneu5=
+"Neu 5",logtextneu11="Neu 11",logtextneuso="Neu sonstige",logtextwiederhol=
+", Wiederholer",logtextfuer="für ",logtextakthj="aktuelles Halbjahr ";BOOL 
+VAR nochwelcheda,klassenbehandlung,nurnichtversetzte,logakthalbjahr;LET 
+allespruefen=1,einejgstpruefen=2,eineklassepruefen=3,
+einejgstwiederholerpruefen=4,eineklassewiederholerpruefen=5;INT VAR 
+waspruefen:=0;INT VAR laengeherk,laengealteklasse,laengename,laengeneueklasse
+,bestandindex,halbjahresindex,indexbestand,schuelerzahl,aktuellesfeld,
+wiederholerbestand;ROW schuelerproseiteROW anzkenndatenTEXT VAR kenndatum;#
+ROW schuelerproseiteTEXT VAR name;ROW schuelerproseiteTEXT VAR rufname;ROW 
+schuelerproseiteTEXT VAR gebdat;##17.07.87dr#ROW schuelerproseiteTEXT VAR 
+zugtutor;TEXT VAR altejgst,neuejgst,benoetigtevergljgst,vergleichsjgst,
+vergleichszug,sicherungstupel,klassenbildungsbestand,aktschuljahr,
+aktschulhalbjahr;PROC bearbeitungklassenbildung:reinitparsing;
+eingangsbildschirmpruefen;IF eingangsbildschirmokTHEN 
+initialisierungenvornehmen;naechsteportionlesen;IF keinemehrdaTHEN 
+bestandleermelden;enter(tofather)ELSE standardnprocFI ELSE 
+eingangsmaskenfehler;return(tofather)FI .eingangsbildschirmpruefen:
+ankreuzfelderpruefen;IF eingangsbildschirmokTHEN jgstzugpruefen;IF 
+eingangsbildschirmokTHEN halbjahrmitankreuzungvergleichenFI FI .
+ankreuzfelderpruefen:INT VAR pruefstatus;standardpruefe(pruefartalternative,
+fnrneuan5,fnrjgst,null,niltext,pruefstatus);.jgstzugpruefen:IF 
+standardmaskenfeld(fnrjgst)<>niltextTHEN standardpruefe(pruefartgrenzen,
+fnrjgst,jgst5,jgst13,niltext,pruefstatus)FI ;IF eingangsbildschirmokTHEN 
+nurnichtversetzte:=standardmaskenfeld(fnrnurnichtvers)<>niltext;
+bestimmebestandindex;IF nurnichtversetzteCAND (bestandindex<fnrjgst)THEN 
+standardmeldung(meldfalscheauswahl,niltext);pruefstatus:=fnrnurnichtversFI 
+FI .bestimmebestandindex:FOR bestandindexFROM fnrneuan5UPTO fnrjgstREP IF 
+standardmaskenfeld(bestandindex)<>niltextTHEN LEAVE bestimmebestandindexFI 
+PER .halbjahrmitankreuzungvergleichen:aktschulhalbjahr:=schulkenndatum(
+schulhalbjahrkey);aktschuljahr:=schulkenndatum(schuljahrkey);IF 
+aktschulhalbjahr="2"THEN IF standardmaskenfeld(fnrgeplhj)<>""THEN 
+standardmeldung(meldfalscheshj,aktschulhalbjahr+meldkznorm);pruefstatus:=
+fnrgeplhjFI ELIF aktschulhalbjahr="1"THEN IF standardmaskenfeld(fnrgeplhj)=""
+CAND standardmaskenfeld(fnrakthj)=""THEN standardmeldung(meldfalscheshj,
+aktschulhalbjahr+meldkznorm);pruefstatus:=fnrgeplhjFI FI .
+eingangsbildschirmok:pruefstatus=0.initialisierungenvornehmen:
+bestandunddbmaskesetzen;halbjahrsetzen;nichtverspruefen;
+plausipruefungvorbereiten;standardstartproc(maske(vergleichsknoten));
+laengenfestlegen;IF nurnichtversetzteTHEN startebildschirmblock(
+wiederholerbestand,maxschueler)ELSE startebildschirmblock(indexbestand,
+maxschueler)FI .bestandunddbmaskesetzen:standardmeldung(meldwarten,niltext);
+klassenbehandlung:=FALSE ;SELECT bestandindexOF CASE fnrneuan5:neuan5setzen
+CASE fnrneuan11:neuan11setzenCASE fnrneuansonst:neuansonstsetzenOTHERWISE 
+jgstoderzugsetzenEND SELECT ;pruefebestand.neuan5setzen:vergleichsjgst:=
+jgst05;benoetigtevergljgst:=vergleichsjgst;klassenbildungsbestand:=best5;
+indexbestand:=ixsustatschulkenn;waspruefen:=allespruefen;infeld(fnrneuan5).
+neuan11setzen:vergleichsjgst:=jgst11;benoetigtevergljgst:=vergleichsjgst;
+klassenbildungsbestand:=best11;indexbestand:=ixsustatschulkenn;waspruefen:=
+allespruefen;infeld(fnrneuan11).neuansonstsetzen:vergleichsjgst:=niltext;
+benoetigtevergljgst:=vergleichsjgst;klassenbildungsbestand:=bestsonst;
+indexbestand:=ixsustatschulkenn;waspruefen:=allespruefen;infeld(fnrneuansonst
+).jgstoderzugsetzen:TEXT CONST jgst:=jgstaufber(standardmaskenfeld(fnrjgst));
+vergleichsjgst:=jgst;klassenbildungsbestand:=bestlaufsj;IF eineklasseTHEN 
+setzeklasseELSE setzejgstFI ;IF NOT ((akthalbjahrCOR geplhalbjahr)COR 
+nurnichtversetzte)THEN neuejgst:=jgstaufber(text(int(altejgst)+1));
+benoetigtevergljgst:=neuejgstELSE neuejgst:=altejgst;benoetigtevergljgst:=
+altejgstFI .eineklasse:TEXT CONST zug:=standardmaskenfeld(fnrtutor);
+vergleichszug:=zug;klassenbehandlung:=zug<>niltext;klassenbehandlung.
+setzeklasse:IF nurnichtversetzteTHEN wiederholerbestand:=ixhjdsjhjverjgstkenn
+;waspruefen:=eineklassewiederholerpruefenELSE indexbestand:=ixsustatjgstzug;
+waspruefen:=eineklassepruefen;FI ;altejgst:=jgst;infeld(fnrtutor).setzejgst:
+IF nurnichtversetzteTHEN IF NOT klassenbehandlungTHEN #???index#
+wiederholerbestand:=ixhjdsjhjverjgst;#wiederholer#ELSE wiederholerbestand:=
+ixhjdsjhjverjgstkenn;FI ;waspruefen:=einejgstwiederholerpruefenELSE IF NOT 
+klassenbehandlungTHEN indexbestand:=ixsustatjgst;ELSE indexbestand:=
+ixsustatjgstzug;FI ;waspruefen:=einejgstpruefen;FI ;altejgst:=jgst;infeld(
+fnrjgst).pruefebestand:reinitparsing;IF nurnichtversetzteTHEN inittupel(
+dnrhalbjahresdaten);schluesselfelderinhalbjahresdatenbelegen;search(
+wiederholerbestand,FALSE );ELSE inittupel(dnrschueler);
+schluesselfelderinschuelerbelegen;search(indexbestand,FALSE );FI ;IF 
+bestandnichtvorhandenTHEN bestandleermelden;return(tofather);LEAVE 
+bearbeitungklassenbildungELSE nochwelcheda:=TRUE FI .
+schluesselfelderinhalbjahresdatenbelegen:putwert(fnrhjdversetzung,
+kzwiederholer);putwert(fnrhjdsj,aktschuljahr);putwert(fnrhjdhj,
+aktschulhalbjahr);putwert(fnrhjdjgst,vergleichsjgst);putwert(fnrhjdkennung,
+vergleichszug);.schluesselfelderinschuelerbelegen:putwert(fnrsustatuss,
+klassenbildungsbestand);IF indexbestand=ixsustatjgstzugOR indexbestand=
+ixsustatjgstTHEN putwert(fnrsusgrpjgst,vergleichsjgst);putwert(
+fnrsusgrpzugtut,vergleichszug)FI .bestandnichtvorhanden:dbstatus<>okOR (NOT 
+nurnichtversetzteCAND NOT pruefungspeziell(waspruefen))OR (nurnichtversetzte
+CAND NOT pruefungspeziell(waspruefen)).halbjahrsetzen:logakthalbjahr:=FALSE ;
+IF geplhalbjahrTHEN geplhalbjahrsetzenELIF akthalbjahrTHEN logakthalbjahr:=
+TRUE ;akthalbjahrsetzenELSE ersteshalbjahrsetzenFI .geplhalbjahr:INT VAR 
+angekreuztesfeld;standardmaskenfeld(fnrgeplhj)<>niltext.geplhalbjahrsetzen:
+IF akthalbjahrCOR neuanmeldungTHEN angekreuztesfeld:=fnrgeplhj;falscheauswahl
+ELSE halbjahresindex:=geplanteszweiteshjFI .akthalbjahr:standardmaskenfeld(
+fnrakthj)<>niltext.akthalbjahrsetzen:IF neuanmeldungTHEN angekreuztesfeld:=
+fnrakthj;falscheauswahlELSE halbjahresindex:=aktuelleshjFI .
+ersteshalbjahrsetzen:halbjahresindex:=ersteskommendeshj.neuanmeldung:
+bestandindex<=fnrneuansonst.falscheauswahl:standardmeldung(meldfalscheauswahl
+,niltext);infeld(angekreuztesfeld);return(tofather);LEAVE 
+bearbeitungklassenbildung.nichtverspruefen:IF (nurnichtversetzteCAND (
+halbjahresindex<>ersteskommendeshj))COR (((NOT nurnichtversetzte)CAND (jgst=
+maxjgst))CAND (halbjahresindex=ersteskommendeshj))THEN angekreuztesfeld:=
+fnrnurnichtvers;falscheauswahlELIF nurnichtversetzteTHEN halbjahresindex:=
+ersteskommendeshjFI .plausipruefungvorbereiten:#holevergleichssg(
+benoetigtevergljgst,(halbjahresindex=aktuelleshj)COR nurnichtversetzte)dr13.
+11.87#holevergleichssg(benoetigtevergljgst,halbjahresindex=aktuelleshj).
+laengenfestlegen:laengeherk:=standardfeldlaenge(fnrherk);laengealteklasse:=
+standardfeldlaenge(fnralteklasse);laengename:=standardfeldlaenge(fnrname);
+laengeneueklasse:=standardfeldlaenge(fnrneueklasse).naechsteportionlesen:
+blocklesenundausgeben.keinemehrda:NOT nochwelcheda.bestandleermelden:
+standardmeldung(meldbestleer,niltext).eingangsmaskenfehler:infeld(pruefstatus
+).END PROC bearbeitungklassenbildung;PROC klassenbildungnichtspeichern:
+nichtspeichernmelden;startkeyssetzen;neuerblock.nichtspeichernmelden:
+standardmeldung(meldnichtspeichern,niltext);pause(10).startkeyssetzen:
+restoretupel(dnrschueler,sicherungstupel);changeindex.END PROC 
+klassenbildungnichtspeichern;PROC klassenbildungspeichern:
+bestimmeaenderungsart;pruefeplausibilitaet;IF dateninordnungTHEN 
+speicherungdurchfuehren;startkeyssetzen;neuerblockELSE eingabefehler;return(
+tofather)FI .bestimmeaenderungsart:BOOL VAR normalfall:=NOT ((bestandindex>
+fnrneuansonst)CAND (halbjahresindex=aktuelleshj));.pruefeplausibilitaet:BOOL 
+VAR dateninordnung:=TRUE ;INT VAR aktfeld:=1;TEXT VAR bezugsjgst:="",
+gelesenejgst;standardmeldung(meldplausi,niltext);FOR suindFROM 1UPTO 
+schuelerzahlREP pruefezeile;IF NOT dateninordnungTHEN LEAVE 
+pruefeplausibilitaetFI ;PER .pruefezeile:TEXT VAR aktuellerzug;TEXT VAR 
+aktuelleschuelergruppe;aktfeldINCR felderprozeile;aktuellerzug:=
+standardmaskenfeld(aktfeld);gelesenejgst:=standardmaskenfeld(aktfeld-1);IF 
+gelesenejgst<>leerejgstTHEN bezugsjgst:=gelesenejgst;FI ;
+aktuelleschuelergruppe:=bezugsjgst+aktuellerzug;IF normalfallTHEN 
+dateninordnung:=(aktuellerzug=niltext)COR istzulaessigesg(
+aktuelleschuelergruppe)ELSE dateninordnung:=istzulaessigesg(
+aktuelleschuelergruppe)CAND (aktuellerzug<>niltext)FI .
+speicherungdurchfuehren:vorbereiten;logeintragvornehmen;aendernschleife;
+kurzwarten.logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;IF 
+klassenbildungsbestand=best5THEN eintragCAT logtextfuer;eintragCAT 
+logtextneu5ELIF klassenbildungsbestand=best11THEN eintragCAT logtextfuer;
+eintragCAT logtextneu11ELIF klassenbildungsbestand=bestsonstTHEN eintragCAT 
+logtextfuer;eintragCAT logtextneusoELIF klassenbildungsbestand=bestlaufsj
+THEN IF logakthalbjahrTHEN eintragCAT logtextakthjFI ;eintragCAT logtextfuer;
+eintragCAT vergleichsjgst;eintragCAT vergleichszug;IF nurnichtversetzteTHEN 
+eintragCAT logtextwiederholFI ;FI ;logeintrag(eintrag).kurzwarten:pause(10).
+vorbereiten:INT VAR aufsatzpunkt:=null;.aendernschleife:INT VAR suind;INT 
+VAR zahlderaenderungen:=null;FOR suindFROM 1UPTO schuelerzahlREP 
+behandleschuelersatzPER .behandleschuelersatz:IF datenveraendertTHEN 
+fuehreaenderungaus;meldevollzugELSE merkenalsaufsatzpunktFI .datenveraendert:
+zugtutor(suind)<>standardmaskenfeld((suind*felderprozeile)+1).
+merkenalsaufsatzpunkt:aufsatzpunkt:=suind.fuehreaenderungaus:lesenvorbereiten
+;lesen;IF normalfallTHEN zurueckschreibenELSE aenderneinheitFI .
+lesenvorbereiten:putwert(fnrsufamnames,kenndatum[suind][1]);putwert(
+fnrsurufnames,kenndatum[suind][2]);putwert(fnrsugebdatums,datumskonversion(
+kenndatum[suind][3]));zahlderaenderungenINCR 1;.lesen:search(dnrschueler,
+TRUE ).zurueckschreiben:IF dbstatus=0THEN putwert(fnrsuneuerzugtut,
+standardmaskenfeld((suind*felderprozeile)+1));replace(dnrschueler,gettid)FI .
+aenderneinheit:TEXT VAR alterzug:=zugtutor(suind);TEXT VAR neuerzug:=
+standardmaskenfeld((suind*felderprozeile)+1);TEXT VAR geliefertejgst:=
+jgstaufber(wert(fnrsusgrpjgst));TEXT VAR gelieferterzug:=wert(fnrsusgrpzugtut
+);IF dbstatus=0CAND geliefertejgst=altejgstCAND gelieferterzug=alterzugTHEN 
+TEXT VAR schuelertid:=gettid;aenderntransaktion;ELSE transaktionsfehlerFI .
+aenderntransaktion:removeoutofindex(ixsustatjgstzug);#
+aenderunginstatraumvorbereiten(FALSE );dr10.05.88
+einenschuelerausstatraumentfernen;#IF wert(fnrsutidakthjd)<>niltextTHEN 
+readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));putwert(fnrhjdkennung,
+neuerzug);#update(dnrhalbjahresdaten);dr10.05.88#selupdate(dnrhalbjahresdaten
+);putwert(fnrsutidakthjd,gettid)ELSE FI ;putwert(fnrsusgrpzugtut,neuerzug);
+replace(dnrschueler,schuelertid);insertinindex(ixsustatjgstzug);#IF dbstatus
+<>okTHEN putwert(fnrsusgrpzugtut,zugtutor[suind]);FI ;
+einenschuelerinstatraumeinfuegen;dr10.05.88#.transaktionsfehler:
+standardmeldung(meldzuggewechselt,niltext);return(tofather);infeld((suind*
+felderprozeile)+1);LEAVE klassenbildungspeichern.meldevollzug:TEXT VAR 
+meldungstext;INT VAR satzindex:=(suind*felderprozeile)-1;IF dbstatus=0THEN 
+meldungstext:=compress(standardmaskenfeld(satzindex))+meldtrenner;
+standardmeldung(meldspeicherung,meldungstext)ELSE meldungstext:=text(dbstatus
+)+meldtrenner;meldungstextCAT compress(standardmaskenfeld(satzindex));
+meldungstextCAT meldtrenner;standardmeldung(meldspeicherfehler,meldungstext);
+return(tofather);LEAVE klassenbildungspeichernFI ;infeld(satzindex+2).
+startkeyssetzen:IF (NOT klassenbehandlung)OR normalfallTHEN aufsatzpunkt:=
+schuelerzahlFI ;IF aufsatzpunkt>nullTHEN restoretupel(dnrschueler,
+sicherungstupel);changeindexFI .eingabefehler:standardmeldung(
+meldexistiertnicht,standardmaskenfeld(aktfeld)+meldtrenner);infeld(aktfeld).
+END PROC klassenbildungspeichern;PROC neuerblock:blocklesenundausgeben;IF 
+nochwelchedaTHEN return(tofather)ELSE enter(tograndfather)FI .END PROC 
+neuerblock;PROC blocklesenundausgeben:vorbereiten;initgruppenwechsel;SELECT 
+bestandindexOF CASE fnrneuan5:neuan5lesenCASE fnrneuan11:neuan11lesenCASE 
+fnrneuansonst:neuansonstlesenOTHERWISE jgstoderzuglesenEND SELECT ;
+nachbereiten.vorbereiten:IF NOT nochwelchedaTHEN LEAVE blocklesenundausgeben
+FI ;standardmeldung(meldwarten,niltext);schuelerzahl:=null;aktuellesfeld:=
+erstesfeld.neuan5lesen:bildschirmblock(PROC neuan5zeigen,BOOL PROC (INT 
+CONST )pruefungspeziell,waspruefen).neuan11lesen:bildschirmblock(PROC 
+neuan11zeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).
+neuansonstlesen:bildschirmblock(PROC neuansonstzeigen,BOOL PROC (INT CONST )
+pruefungspeziell,waspruefen).jgstoderzuglesen:bildschirmblock(PROC 
+jgstoderzugzeigen,BOOL PROC (INT CONST )pruefungspeziell,waspruefen).
+nachbereiten:nochwelcheda:=(schuelerzahl>null);IF nochwelchedaTHEN savetupel(
+dnrschueler,sicherungstupel);restlichezeilenloeschen;infeld(standardanfang);
+standardfelderausgebenFI ;infeld(standardeinstieg).restlichezeilenloeschen:
+INT VAR zeilenzaehler;INT VAR zeilenfeld:=(schuelerzahl*felderprozeile)+1;
+FOR zeilenzaehlerFROM schuelerzahlUPTO maxschuelerREP loeschezeilePER .
+loeschezeile:INT VAR zeilenincr;FOR zeilenincrFROM 1UPTO felderprozeileREP 
+zeilenfeldINCR 1;standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,
+zeilenfeld)PER ;feldschutz(zeilenfeld).END PROC blocklesenundausgeben;PROC 
+neuanzeigen(TEXT CONST jgst):schuelerzahlINCR 1;herkunftsschulezeigen;
+alteklassezeigen;namezeigen;neueklassezeigen;neuerzugtutorzeigen.
+neueklassezeigen:gruppenwechsel(jgst,gwneuejgst,laengeneueklasse,1,
+aktuellesfeld).END PROC neuanzeigen;PROC namezeigen:namenretten;
+standardmaskenfeld(text(schuelername+namenstrenner+schuelervorname,laengename
+),aktuellesfeld);INT VAR eingabefeld:=aktuellesfeld+freigabeincr;
+standardmaskenfeld(niltext,eingabefeld);feldfrei(eingabefeld);aktuellesfeld
+INCR 1.namenretten:TEXT VAR schuelername,schuelervorname;schuelername:=wert(
+fnrsufamnames);schuelervorname:=wert(fnrsurufnames);kenndatum[schuelerzahl][1
+]:=schuelername;kenndatum[schuelerzahl][2]:=schuelervorname;kenndatum[
+schuelerzahl][3]:=datumrekonversion(wert(fnrsugebdatums));.END PROC 
+namezeigen;PROC herkunftsschulezeigen:gruppenwechsel(wert(fnrsuskennlschule),
+gwherk,laengeherk,1,aktuellesfeld)END PROC herkunftsschulezeigen;PROC 
+alteklassezeigen:gruppenwechsel(wert(fnrsuklasselschule),gwalteklasse,
+laengealteklasse,1,aktuellesfeld)END PROC alteklassezeigen;PROC neuan5zeigen:
+neuanzeigen(jgst05)END PROC neuan5zeigen;PROC neuan11zeigen:neuanzeigen(
+jgst11)END PROC neuan11zeigen;PROC neuansonstzeigen:schuelerzahlINCR 1;
+herkunftsschulezeigen;alteklassezeigen;namezeigen;neueklassezeigen;
+neuerzugtutorzeigen.neueklassezeigen:gruppenwechsel(jgstaufber(wert(
+fnrsujgsteintr)),gwneuejgst,2,1,aktuellesfeld).END PROC neuansonstzeigen;
+PROC neuerzugtutorzeigen:TEXT CONST neuerzugtutor:=wert(fnrsuneuerzugtut);
+standardmaskenfeld(neuerzugtutor,aktuellesfeld);zugtutor(schuelerzahl):=
+neuerzugtutor;aktuellesfeldINCR 1END PROC neuerzugtutorzeigen;PROC 
+jgstoderzugzeigen:schuelerzahlINCR 1;herkunftsschuleloeschen;
+aktuelleklassezeigen;namezeigen;neueklassezeigen;zugtutorbehandeln.
+herkunftsschuleloeschen:feldloeschen(laengeherk);aktuellesfeldINCR 1.
+aktuelleklassezeigen:TEXT VAR aktjgst:=jgstaufber(wert(fnrsusgrpjgst));IF 
+halbjahresindex=aktuelleshjTHEN feldloeschen(laengealteklasse);aktuellesfeld
+INCR 1ELSE gruppenwechsel(aktjgst+wert(fnrsusgrpzugtut),gwalteklasse,
+laengealteklasse,1,aktuellesfeld)FI .neueklassezeigen:IF halbjahresindex=
+ersteskommendeshjTHEN gruppenwechsel(neuejgst,gwneuejgst,2,1,aktuellesfeld)
+ELSE gruppenwechsel(aktjgst,gwneuejgst,2,1,aktuellesfeld)FI .
+zugtutorbehandeln:IF halbjahresindex<>aktuelleshjTHEN neuerzugtutorzeigen
+ELSE TEXT CONST zugtutordesschuelers:=wert(fnrsusgrpzugtut);zugtutor(
+schuelerzahl):=zugtutordesschuelers;standardmaskenfeld(zugtutordesschuelers,
+aktuellesfeld);aktuellesfeldINCR 1FI .END PROC jgstoderzugzeigen;PROC 
+feldloeschen(INT CONST laenge):standardmaskenfeld(laenge*blank,aktuellesfeld)
+END PROC feldloeschen;BOOL PROC pruefungspeziell(INT CONST wasistzutun):BOOL 
+VAR b:=FALSE ;SELECT wasistzutunOF CASE allespruefen:pruefungalleklassen(b)
+CASE einejgstpruefen:pruefungeinejgst(b)CASE eineklassepruefen:
+pruefungeineklasse(b)CASE einejgstwiederholerpruefen:
+pruefungeinejgstwiederholer(b)CASE eineklassewiederholerpruefen:
+pruefungeineklassewiederholer(b)END SELECT ;bEND PROC pruefungspeziell;PROC 
+pruefungalleklassen(BOOL VAR bool):bool:=(wert(fnrsustatuss)=
+klassenbildungsbestand)END PROC pruefungalleklassen;PROC pruefungeinejgst(
+BOOL VAR bool):bool:=(wert(fnrsustatuss)=bestlaufsjCAND jgstaufber(wert(
+fnrsusgrpjgst))=vergleichsjgst)END PROC pruefungeinejgst;PROC 
+pruefungeineklasse(BOOL VAR bool):bool:=(wert(fnrsustatuss)=bestlaufsjCAND 
+jgstaufber(wert(fnrsusgrpjgst))=vergleichsjgstCAND wert(fnrsusgrpzugtut)=
+vergleichszug)END PROC pruefungeineklasse;PROC pruefungeinejgstwiederholer(
+BOOL VAR bool):inschuelerdateisuchen;bool:=(wert(fnrhjdversetzung)=
+kzwiederholerCAND wert(fnrhjdsj)=aktschuljahrCAND wert(fnrhjdhj)=
+aktschulhalbjahrCAND jgstaufber(wert(fnrhjdjgst))=vergleichsjgst)END PROC 
+pruefungeinejgstwiederholer;PROC pruefungeineklassewiederholer(BOOL VAR bool)
+:inschuelerdateisuchen;bool:=(wert(fnrhjdversetzung)=kzwiederholerCAND wert(
+fnrhjdsj)=aktschuljahrCAND wert(fnrhjdhj)=aktschulhalbjahrCAND jgstaufber(
+wert(fnrhjdjgst))=vergleichsjgstCAND wert(fnrhjdkennung)=vergleichszug)END 
+PROC pruefungeineklassewiederholer;PROC inschuelerdateisuchen:inittupel(
+dnrschueler);putwert(fnrsufamnames,wert(fnrhjdfamnames));putwert(
+fnrsurufnames,wert(fnrhjdrufnames));putwert(fnrsugebdatums,wert(fnrhjdgebdats
+));putwert(fnrsustatuss,bestlaufsj);search(ixsustatfamrufgeb,TRUE );END PROC 
+inschuelerdateisuchen;END PACKET listenweiseklassenbildung
+
diff --git a/app/schulis/2.2.1/src/1.schuelerjgst aendern b/app/schulis/2.2.1/src/1.schuelerjgst aendern
new file mode 100644
index 0000000..1a80c4f
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.schuelerjgst aendern
@@ -0,0 +1,161 @@
+PACKET schuelerjgstaendernDEFINES schuelerjgstbearbeiten,
+schuelerjgstaenderungschuelerzeigen,
+schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten,
+schuelerjgstaenderungspeichern,pruefungschuelerjgst:LET maskenname=
+"ms schuelerjgst aendern",maskennameeingang="ms schuelerjgst aendern eingang"
+,fnrname=2,fnrrufname=3,fnrgebdatum=4,fnrjgst=5,fnrhalbjahr=6,fnrzug=7,
+fnrzugang=8,fnraktuellehjd=9,fnrneueshj1=10,fnrneuehjd1=11,fnrneueshj2=12,
+fnrneuehjd2=13;LET schulhalbjahr="Schulhalbjahr";LET aktbestand="ls",
+aktschuljahr="Schuljahr";LET meldunggibtsnicht=71,meldunglistenerstellung=7,
+meldungkeineliste=68,meldungletzter=67,meldungspeicherung=50,
+meldungkeinespeicherung=63,pruefemeldung=57;LET dateiname="Schülerliste";
+FILE VAR f;TEXT VAR schuelertupel:="",zugangsicherung:="",schuelertid:="",
+hjdtid:="";TEXT VAR akthalbjahr,jgstalt,zugalt,jgst,zug,jgsttext;LET 
+gesamtanzahlhalbjahre=12,laengehalbjahreseintrag=4;LET jgst05="05",jgst13=
+"13";LET jgstufe10=10;LET oblitrenner="$",leer="",punkt=".";LET 
+anzschlfeldersu=3;BOOL VAR falschesdatum:=FALSE ;INT CONST gesamtzeilenlaenge
+:=gesamtanzahlhalbjahre*laengehalbjahreseintrag;ROW anzschlfeldersuTEXT VAR 
+schluessel;TAG VAR maske;TEXT VAR ausgabezeile:="",halbjahrkuerzel:="";LET 
+logtextbeginn="Anw. 1.2.4 Änderung";PROC schuelerjgstbearbeiten:BOOL VAR 
+suexistiert:=FALSE ;falschesdatum:=FALSE ;systemdboff;reinitparsing;
+schluesselbereitstellen;pruefeobnameexistiert(suexistiert);IF NOT 
+falschesdatumTHEN IF suexistiertTHEN schluessel(1):=wert(fnrsufamnames);
+schluessel(2):=wert(fnrsurufnames);schluessel(3):=datumrekonversion(wert(
+fnrsugebdatums));loeschedieerstellteobjektliste;standardstartproc(maskenname)
+;bereiteaenderungvor;infeld(fnrjgst);standardnprocELSE standardmeldung(
+meldunggibtsnicht,"");return(1)FI ELSE return(1)FI .END PROC 
+schuelerjgstbearbeiten;PROC schluesselbereitstellen:schluessel(1):=
+standardmaskenfeld(fnrname);schluessel(2):=standardmaskenfeld(fnrrufname);
+schluessel(3):=datumrekonversion(standardmaskenfeld(fnrgebdatum));END PROC 
+schluesselbereitstellen;PROC pruefeobnameexistiert(BOOL VAR suexist):TEXT 
+VAR datenbankwerte,schluesselwerte;inittupel(dnrschueler);
+maskenwerteindatenbank;IF NOT falschesdatumTHEN search(ixsustatfamrufgeb,
+FALSE );IF dbstatus=okTHEN saveupdateposition(dnrschueler);datenbankwerte:=
+wert(fnrsurufnames)+datumrekonversion(wert(fnrsugebdatums));schluesselwerte:=
+schluessel(2)+schluessel(3);suexist:=(wert(fnrsufamnames)=schluessel(1)CAND (
+(schluessel(2)=leerAND schluessel(3)=leer)OR (pos(datenbankwerte,
+schluesselwerte)=1)))ELSE suexist:=FALSE FI FI .END PROC 
+pruefeobnameexistiert;PROC bereiteaenderungvor:saveupdateposition(dnrschueler
+);savetupel(dnrschueler,schuelertupel);schuelertid:=gettid;hjdtid:=wert(
+fnrsutidakthjd);zugangsicherung:=wert(fnrsuartzugang);wertelesen;
+fuelledbdateninfelder;fuellehjddateninfelder;infeld(1);standardfelderausgeben
+;infeld(fnrjgst).wertelesen:akthalbjahr:=schulkenndatum(schulhalbjahr);.
+fuelledbdateninfelder:jgstalt:=jgstaufber(wert(fnrsusgrpjgst));zugalt:=
+compress(wert(fnrsusgrpzugtut));standardmaskenfeld(schluessel(1),fnrname);
+standardmaskenfeld(schluessel(2),fnrrufname);standardmaskenfeld(schluessel(3)
+,fnrgebdatum);standardmaskenfeld(akthalbjahr,fnrhalbjahr);standardmaskenfeld(
+jgstalt,fnrjgst);standardmaskenfeld(zugalt,fnrzug);standardmaskenfeld(wert(
+fnrsuartzugang),fnrzugang);.fuellehjddateninfelder:jgsttext:=jgstalt;
+halbjahrkuerzel:=jgsttext+punkt+akthalbjahr;lieferehalbjahreszeile(
+ausgabezeile,halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnraktuellehjd)
+;IF jgstalt=jgst05THEN erhoehejgsttext(TRUE );halbjahrkuerzel:=jgsttext+punkt
++akthalbjahr;standardmaskenfeld(halbjahrkuerzel,fnrneueshj1);
+lieferehalbjahreszeile(ausgabezeile,halbjahrkuerzel);standardmaskenfeld(
+ausgabezeile,fnrneuehjd1);liefereleerzeileELIF jgstalt=jgst13THEN 
+erhoehejgsttext(FALSE );halbjahrkuerzel:=jgsttext+punkt+akthalbjahr;
+standardmaskenfeld(halbjahrkuerzel,fnrneueshj1);lieferehalbjahreszeile(
+ausgabezeile,halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnrneuehjd1);
+liefereleerzeileELSE erhoehejgsttext(FALSE );halbjahrkuerzel:=jgsttext+punkt+
+akthalbjahr;standardmaskenfeld(halbjahrkuerzel,fnrneueshj1);
+lieferehalbjahreszeile(ausgabezeile,halbjahrkuerzel);standardmaskenfeld(
+ausgabezeile,fnrneuehjd1);jgsttext:=jgstalt;erhoehejgsttext(TRUE );
+halbjahrkuerzel:=jgsttext+punkt+akthalbjahr;standardmaskenfeld(
+halbjahrkuerzel,fnrneueshj2);lieferehalbjahreszeile(ausgabezeile,
+halbjahrkuerzel);standardmaskenfeld(ausgabezeile,fnrneuehjd2)FI .
+liefereleerzeile:standardmaskenfeld(leereshj,fnrneueshj2);standardmaskenfeld(
+leerezeile,fnrneuehjd2).leereshj:text(" ",laengehalbjahreseintrag).leerezeile
+:text(" ",gesamtzeilenlaenge).END PROC bereiteaenderungvor;PROC 
+erhoehejgsttext(BOOL CONST erhoehen):INT VAR jgstint:=int(jgsttext);IF 
+erhoehenTHEN jgstintINCR 1ELSE jgstintDECR 1FI ;jgsttext:=jgstaufber(text(
+jgstint))END PROC erhoehejgsttext;PROC loeschedieerstellteobjektliste:forget(
+dateiname,quiet);END PROC loeschedieerstellteobjektliste;PROC 
+schuelerjgstaenderungschuelerzeigen:BOOL VAR listeexistiertnicht;
+falschesdatum:=FALSE ;systemdboff;schluesselbereitstellen;
+maskenwerteindatenbank;IF NOT falschesdatumTHEN standardmeldung(
+meldunglistenerstellung,"");parsenooffields(5);objektlistestarten(
+ixsustatfamrufgeb,schluessel(1),fnrsufamnames,TRUE ,listeexistiertnicht);IF 
+listeexistiertnichtTHEN reinitparsing;standardmeldung(meldungkeineliste,"");
+return(1)ELSE datensatzlistenausgabe(PROC (INT CONST )suerfassungschueler,
+TRUE ,BOOL PROC pruefungschuelerjgst)FI ELSE return(1)FI .END PROC 
+schuelerjgstaenderungschuelerzeigen;PROC maskenwerteindatenbank:putwert(
+fnrsufamnames,schluessel(1));putwert(fnrsurufnames,schluessel(2));disablestop
+;initmaske(maske,maskennameeingang);putwert(fnrsugebdatums,datumskonversion(
+schluessel(3)));IF iserrorTHEN clearerror;meldeauffaellig(maske,157);infeld(
+fnrgebdatum);falschesdatum:=TRUE ;enablestopELSE enablestop;putwert(
+fnrsustatuss,aktbestand);FI END PROC maskenwerteindatenbank;BOOL PROC 
+pruefungschuelerjgst:wert(fnrsustatuss)=aktbestandEND PROC 
+pruefungschuelerjgst;PROC 
+schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten:BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;loeschedieerstellteobjektliste;
+objektlistebeenden(dateiname,TRUE );reinitparsing;
+holeerstenschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok);IF ok
+THEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerdenTHEN 
+standardstartproc(maskenname);bereiteaenderungvor;infeld(fnrjgst);
+standardnprocELSE enter(2)FI .END PROC 
+schuelerjgstaenderungfuerausgesuchteschuelerbearbeiten;PROC 
+holeerstenschluesselausdatei(BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=
+FALSE ;LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input,
+dateiname);holenaechstenschluesselausdatei(ok);END PROC 
+holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(BOOL VAR ok
+):TEXT VAR thesaurustext:="";INT VAR schluesselbeginn,schluesseltrennung,i;
+IF eof(f)THEN ok:=FALSE ;loeschedieerstellteobjektlisteELSE getline(f,
+thesaurustext);bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:schluesselbeginn:=pos(thesaurustext,
+oblitrenner);schluesseltrennung:=pos(thesaurustext,oblitrenner,
+schluesselbeginn+1);FOR iFROM 1UPTO anzschlfeldersuREP IF schluesseltrennung>
+0THEN schluessel(i):=subtext(thesaurustext,schluesselbeginn+1,
+schluesseltrennung-1);schluesselbeginn:=schluesseltrennung;schluesseltrennung
+:=pos(thesaurustext,oblitrenner,schluesselbeginn+1);ELSE schluessel(i):=
+subtext(thesaurustext,schluesselbeginn+1);FI ;schluessel(3):=
+datumrekonversion(schluessel(3));PER ;.END PROC 
+holenaechstenschluesselausdatei;PROC schuelerjgstaenderungspeichern(BOOL 
+CONST speichern):IF speichernTHEN INT VAR fehlerstatus:=0;
+pruefeplausibilitaet(fehlerstatus);IF datenfehlerfreiTHEN standardmeldung(
+meldungspeicherung,"");datenspeichern;
+vorbereitendernaechstenschluesselbehandlungELSE fehlerbehandeln;return(1)FI 
+ELSE standardmeldung(meldungkeinespeicherung,"");
+vorbereitendernaechstenschluesselbehandlungFI .datenfehlerfrei:fehlerstatus=0
+.fehlerbehandeln:infeld(fehlerstatus).datenspeichern:logeintragvornehmen;
+aenderungschreiben;halbjahresdatenloeschen(schluessel,jgstalt,jgst,
+akthalbjahr).logeintragvornehmen:TEXT VAR eintrag:=logtextbeginn;eintragCAT 
+" """;eintragCAT schluessel(1);eintragCAT ", ";eintragCAT schluessel(2);
+eintragCAT ", ";eintragCAT datumskonversion(schluessel(3));eintragCAT """";
+logeintrag(eintrag).aenderungschreiben:IF jgstoderzuggeaendertTHEN 
+dbfelderfuellen;aenderunginhjdeintragen;restoreupdateposition(dnrschueler);
+selupdate(dnrschueler);IF dbstatus<>0THEN restoretupel(dnrschueler,
+schuelertupel)ELSE IF jgst<>jgstaltTHEN IF int(jgst)>=jgstufe10THEN 
+kurswahlserveraktualisieren(jgst,"","")FI ;IF int(jgstalt)>=jgstufe10THEN 
+kurswahlserveraktualisieren(jgstalt,"","")FI ;FI ;FI ;ELSE dbfelderfuellen;
+replace(dnrschueler,schuelertid);FI .dbfelderfuellen:putwert(fnrsusgrpjgst,
+jgst);putwert(fnrsusgrpzugtut,zug);putwert(fnrsuartzugang,standardmaskenfeld(
+fnrzugang));.jgstoderzuggeaendert:jgst<>jgstaltCOR zug<>zugalt.
+aenderunginhjdeintragen:IF hjdtid<>leerTHEN putwert(fnrhjdjgst,jgst);putwert(
+fnrhjdkennung,zug);selupdate(dnrhalbjahresdaten);IF dbstatus=okTHEN putwert(
+fnrsutidakthjd,gettid)FI FI .END PROC schuelerjgstaenderungspeichern;PROC 
+vorbereitendernaechstenschluesselbehandlung:IF exists(dateiname)THEN 
+holenaechstenschluesselauslisteELSE enter(2)FI .
+holenaechstenschluesselausliste:BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+holenaechstenschluesselausdatei(ok);WHILE okREP pruefeobnameexistiert(ok);IF 
+okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE ELSE 
+holenaechstenschluesselausdatei(ok)FI PER ;IF kannbearbeitetwerdenTHEN 
+bereiteaenderungvor;return(1)ELSE behandleendederlistenabarbeitungFI .
+behandleendederlistenabarbeitung:standardmeldung(meldungletzter,"");enter(3).
+END PROC vorbereitendernaechstenschluesselbehandlung;PROC 
+pruefeplausibilitaet(INT VAR fstatus):INT VAR fmeld;LET fmeldbittefuellen=52,
+fmeldnichtimbestand=55,bestandzugang="c02 zugang";fstatus:=0;standardmeldung(
+pruefemeldung,"");IF NOT imschlbestand(standardmaskenfeld(fnrzugang),
+bestandzugang)THEN fstatus:=fnrzugang;fmeld:=fmeldnichtimbestand;
+behandledenplausifehlerFI ;jgst:=jgstaufber(standardmaskenfeld(fnrjgst));zug
+:=compress(standardmaskenfeld(fnrzug));IF jgst=leerTHEN fstatus:=fnrjgst;
+fmeld:=fmeldbittefuellen;behandledenplausifehlerFI ;IF zug=leerTHEN fstatus:=
+fnrzug;fmeld:=fmeldbittefuellen;behandledenplausifehlerFI ;IF NOT 
+imbestandschuelergruppenTHEN fstatus:=fnrjgst;fmeld:=fmeldnichtimbestand;
+behandledenplausifehlerFI .imbestandschuelergruppen:TEXT VAR schuljahr:=
+schulkenndatum(aktschuljahr),halbjahr:=schulkenndatum(schulhalbjahr);INT VAR 
+dateinummer:=dnraktschuelergruppen;putwert(dateinummer+1,schuljahr);putwert(
+dateinummer+2,halbjahr);putwert(dateinummer+3,jgst);putwert(dateinummer+4,zug
+);search(dateinummer,TRUE );dbstatus=0.behandledenplausifehler:
+standardmeldung(fmeld,"");LEAVE pruefeplausibilitaet.END PROC 
+pruefeplausibilitaet;END PACKET schuelerjgstaendern
+
diff --git a/app/schulis/2.2.1/src/1.stat grundfunktionen b/app/schulis/2.2.1/src/1.stat grundfunktionen
new file mode 100644
index 0000000..8ef332a
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.stat grundfunktionen
@@ -0,0 +1,70 @@
+PACKET statgrundfunktionenDEFINES statleseschleife,statauszaehlen,statinit,
+statausgeben,statspalteausgeben,statzeilevertauschen,rechtstext,loeschespalte
+:LET matrixanfang=6,zeilenlaenge=8,zeilensummentitel=93,spaltensummenbasis=12
+,matrixspaltenzahl=6,matrixzeilenzahl=11,laengezaehlfeld=5,laengewertefeld=8;
+LET mv=100,nv=20,summentitel="Summe",maxfeld=100,niltext="     ";BOOL VAR 
+maskierung;INT VAR zeilenzahl,spaltenzahl;INT VAR aktuellestartzeile;INT VAR 
+aktuelleendzeile;INT VAR gesamtsumme:=0;ROW mvROW nvINT VAR statzaehler;ROW 
+mvINT VAR zeilenzeiger;INT PROC zaehler(INT CONST i,j):IF maskierungTHEN 
+statzaehler(zeilenzeiger(i))(j)ELSE statzaehler(i)(j)FI END PROC zaehler;
+PROC statzeilevertauschen(INT CONST i,j):INT VAR k:=zeilenzeiger(j);
+zeilenzeiger(j):=zeilenzeiger(i);zeilenzeiger(i):=k;maskierung:=TRUE END 
+PROC statzeilevertauschen;PROC statleseschleife(INT CONST indexnummer,TEXT 
+CONST startschluessel1,startschluessel2,INT CONST feldnr1,feldnr2,PROC (BOOL 
+VAR )stataktion):vorbereitungen;leseschleife.vorbereitungen:LET maxleseanzahl
+=10;BOOL VAR vorzeitigesende:=FALSE ;#INT CONST maxblock:=maxfeldDIV 
+zahlderfelder;#INT VAR anzahltupel;#INT CONST maxanzahl:=(maxintDIV maxblock)
+*maxblock#.leseschleife:putwert(feldnr1,startschluessel1);putwert(feldnr2,
+startschluessel2);search(indexnummer);IF dbstatus=0THEN einleseschleifeFI .
+einleseschleife:zaehlen;WHILE NOT schlussREP anzahltupel:=maxleseanzahl;
+multisucc(indexnummer,anzahltupel);stackdurchlaufPER ;.stackdurchlauf:IF 
+anzahltupel=0THEN dbstatus(1)ELSE WHILE anzahltupel<>0REP lesen;zaehlen;IF 
+vorzeitigesendeTHEN dbstatus(1);anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0
+.zaehlen:stataktion(vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END 
+PROC statleseschleife;PROC statauszaehlen(INT CONST zeile,spalte):statzaehler
+(zeile)(spalte)INCR 1;gesamtsummeINCR 1END PROC statauszaehlen;PROC 
+statauszaehlen(INT CONST zeile,spalte,anzahl):statzaehler(zeile)(spalte):=
+anzahl;gesamtsummeINCR anzahlEND PROC statauszaehlen;PROC statinit(INT CONST 
+zeilen,spalten):#INT VAR i,j;#gesamtsumme:=0;spaltenzahl:=spalten;
+aktuellestartzeile:=1;zeilenzahl:=0;maskierung:=FALSE ;statinit(zeilen)END 
+PROC statinit;PROC statinit(INT CONST zeilen):INT VAR i,j;FOR iFROM 
+zeilenzahl+1UPTO zeilenREP zeilenzeiger(i):=i;FOR jFROM 1UPTO spaltenzahlREP 
+statzaehler(i)(j):=0PER PER ;zeilenzahl:=zeilen;aktuelleendzeile:=min(
+zeilenzahl,matrixzeilenzahl)END PROC statinit;PROC statausgeben(INT CONST 
+startzeile,startspalte):initialisieren;spaltenausgeben;
+restlichespaltenloeschen;summenberechnen.initialisieren:INT VAR spalte;
+aktuellestartzeile:=startzeile;BOOL VAR gesamtsummeausgeben:=TRUE ;INT CONST 
+endzeile:=min(zeilenzahl,startzeile+matrixzeilenzahl-1);aktuelleendzeile:=
+endzeile;INT CONST endspalte:=min(spaltenzahl,startspalte+matrixspaltenzahl-1
+);INT VAR spaltennr:=1;.spaltenausgeben:FOR spalteFROM startspalteUPTO 
+endspalteREP statspalteausgeben(spalte,spaltennr);spaltennrINCR 1PER ;.
+summenberechnen:IF zeilensummedarstellbarTHEN statzeilensummeELSE 
+gesamtsummeausgeben:=FALSE ;FI ;IF spaltensummedarstellbarTHEN 
+statspaltensumme(startspalte,endspalte);ELSE gesamtsummeausgeben:=FALSE ;FI ;
+IF gesamtsummeausgebenTHEN statgesamtsummeFI .spaltensummedarstellbar:(
+endzeile=zeilenzahl).zeilensummedarstellbar:(endspalte=spaltenzahl).
+restlichespaltenloeschen:INT VAR i,basis:=matrixanfang+spaltennr-1;FOR iFROM 
+spaltennrUPTO matrixspaltenzahl+1REP loeschespalte(basis);basisINCR 1PER .
+END PROC statausgeben;PROC loeschespalte(INT CONST basis):INT VAR feldnr:=
+basis;WHILE feldnr<=maxfeldREP niltextIN feldnr;feldnrINCR zeilenlaengePER 
+END PROC loeschespalte;PROC statspalteausgeben(INT CONST spalte,spaltennr):
+INT VAR i,basis:=matrixanfang+spaltennr-1;FOR iFROM aktuellestartzeileUPTO 
+aktuelleendzeileREP text(zaehler(i,spalte),laengezaehlfeld)IN basis;basis
+INCR zeilenlaengePER ;WHILE basis<=maxfeldREP (niltextIN basis);basisINCR 
+zeilenlaengePER END PROC statspalteausgeben;PROC statzeilensumme:INT VAR i,
+basis:=spaltensummenbasis;FOR iFROM aktuellestartzeileUPTO aktuelleendzeile
+REP text(zeilensumme(i),laengezaehlfeld)IN basis;basisINCR zeilenlaengePER 
+END PROC statzeilensumme;PROC statgesamtsumme:INT VAR basis:=
+zeilensummentitel+zeilenlaenge-1;text(gesamtsumme,laengezaehlfeld)IN basis
+END PROC statgesamtsumme;PROC statspaltensumme(INT CONST startspalte,
+endspalte):titel;einzelsummen.titel:rechtstext(summentitel,laengewertefeld)
+IN zeilensummentitel.einzelsummen:INT VAR j,basis:=zeilensummentitel+1;FOR j
+FROM startspalteUPTO endspalteREP text(spaltensumme(j),laengezaehlfeld)IN 
+basis;basisINCR 1;PER .END PROC statspaltensumme;INT PROC zeilensumme(INT 
+CONST zeilennr):INT VAR summe:=0;INT VAR j;FOR jFROM 1UPTO spaltenzahlREP 
+summeINCR zaehler(zeilennr,j)PER ;summeEND PROC zeilensumme;INT PROC 
+spaltensumme(INT CONST spaltennr):INT VAR summe:=0;INT VAR i;FOR iFROM 1UPTO 
+zeilenzahlREP summeINCR zaehler(i,spaltennr)PER ;summeEND PROC spaltensumme;
+TEXT PROC rechtstext(TEXT CONST t,INT CONST laenge):((laenge-length(t))*" ")+
+tEND PROC rechtstext;END PACKET statgrundfunktionen
+
diff --git a/app/schulis/2.2.1/src/1.stat intern b/app/schulis/2.2.1/src/1.stat intern
new file mode 100644
index 0000000..a94ef21
--- /dev/null
+++ b/app/schulis/2.2.1/src/1.stat intern
@@ -0,0 +1,337 @@
+PACKET statinternDEFINES statinternstart,statistiklistezeigen,
+erstellestatistik,zeigefertigestatistik,statblaettern:LET matrix=
+"ms stat matrix",obli="mu objektliste",ueberschriftenfeld=2,fortsetzungsfeld=
+3,spaltentitel=4,wertebereichanfang=5,spaltenzahl=6,zeilenzahl=11,
+zeilenlaenge=8,maxfeld=100,laengezaehlfeld=5,laengewertefeld=8;LET mv=100,nv=
+20;ROW nvTEXT VAR spaltenwert;INT VAR maxspaltenwert;ROW mvTEXT VAR 
+zeilenwert;INT VAR maxzeilenwert;INT VAR zeileleer;LET anhangzeilen=2;LET 
+maxbestaende=8,maxauswertungen=17;LET titelergaenz1="alle Klassen ",
+titelergaenz2="alle Tutorenkurse ";ROW maxbestaendeTEXT CONST bestandtitel1:=
+ROW maxbestaendeTEXT :("der Jahrgangsstufe ","Jahrgangsstufen der Sek. 1",
+"Jahrgangsstufen der Sek. 2","alle Jahrgangsstufen",
+"Neuangemeldete zur Jgst. 5","Neuangemeldete zur Jgst. 11",
+"Neuangemeldete zu einer anderen Jgst.","Abgegangene aller Jahrgangsstufen");
+LET allejgstsek1=2,allejgstsek2=3,allejgst=4,neuan5=5,neuan11=6,neuansonst=7,
+abgegangene=8;ROW maxauswertungenTEXT CONST bestandtitel2:=ROW 
+maxauswertungenTEXT :("Geschlecht","Alter","Schultyp der Herkunftsschule",
+"Art des Zugangs zur Jgst.","Versetzungsergebnis",
+"Teilnahme Religionsunterricht","Sprachenfolge","Kunst/Musik",
+"Ortsteil des Wohnortes","Staatsangehörigkeit","Muttersprache",
+"Einschulungsjahr Grundschule","Herkunftsschule","Religionszugehörigkeit",
+"Spätaussiedler","Abgangsgrund","Abschluß");LET geschlecht=1,alter=2,schultyp
+=3,zugang=4,versetzung=5,teilnahmereli=6,fremdsprachen=7,kunst=8,ort=9,staat=
+10,sprache=11,einschulung=12,herkunft=13,religion=14,aussiedler=15,abgang=16,
+abschluss=17;LET fortsetzungstitel=" Forts.",leertitel="leer",
+leertitelplatzhalter="�",sonsttitel="sonst",summentitel="Summe";LET 
+neuanmeld5="n05",neuanmeld11="n11",neuanmeldsonst="nso",archivbestand="abg",
+gesamtbestand="ls";LET bestort="c02 ortsteil",beststaat="c02 staaten",
+bestsprache="c02 sprachen",bestreligion="c02 relizugehoerigkeit",bestabgang=
+"c02 abgang",bestabschluss="c02 abschluss",bestschulart="c02 schulart",
+bestversetzung="c02 versetzung",bestzugang="c02 zugang",bestherkunft=
+"Schulen";LET null="0",niltext="",blank=" ";LET allesek1=
+"   05   06   07   08   09   10",allesek2="   11   12   13";LET einenbestand=
+2,einejgst=1,alleinsek1=4,alleinsek2=5;LET sjahr="Schuljahr",shj=
+"Schulhalbjahr",trenner1=".",trenner2="/",trennpos1=2,trennpos2=3,stattext1=
+"alle",stattext2="Werte",maxsek1=10,titeltrenner=", ",links=4,rechts=3,oben=2
+,unten=1,minjgst=5,maxjgst=13,abgkz="abg. ",maxkreuzzahl=1,basisohnebestand=1
+,laengespaltentitel=30,standardanfang=2;LET weiblich="w",maennlich="m",ja="j"
+,nein="n";LET unzulaessigewahlnr=56,wartennr=69,fertignr=77,meldzuvielewerte=
+87,nproc=1,standardabstand=2;LET maxoblizeile=18,listenauskunft=2018;LET 
+beginntag=1,endetag=2,beginnmonat=4,endemonat=5,beginnjahr=7;BOOL VAR 
+rechtsverschiebbar,variablezaehlung,neueintragnoetig,#20.01.88dr#
+vergleichsstart,sprungvonunten,fehlerzuvielewerte;INT VAR xaktuell,yaktuell,
+aktuellerbestand,statbestandnr,statjgst,statauswertungsnr,statbasisnr,
+jahrdestagesdatums,monatdestagesdatums,tagdestagesdatums,waspruefen,#06.07.87
+dr#dateinummer,#01.02.88dr#schluesseldateinr,vglfeld,gewindex;#05.08.87dr#
+TEXT VAR kuerzelbestand,gewbestand,#06.08.87dr#bestaendezeile,vergleichsjgst,
+statgrundmaske,aktschuljahr,akthalbjahr,titelzeile;PROC statinternstart:
+standardvproc(maske(vergleichsknoten));sprungvonunten:=FALSE END PROC 
+statinternstart;PROC statistiklistezeigen:IF eingangsbildschirmkorrektTHEN 
+standardstartproc(obli);auskunftstextergaenzen;fuellestatistikliste;
+standardnprocELSE fehlerbehandlungFI .auskunftstextergaenzen:titelzeile:=
+niltext;IF statbestandnr=einejgstTHEN titelzeile1ELSE einfachetitelzeileFI ;
+ergaenzeauskunft(titelzeile+auskunftstextende,listenauskunft).titelzeile1:IF 
+insek1THEN titelzeileCAT titelergaenz1ELSE titelzeileCAT titelergaenz2FI ;
+titelzeileCAT bestandtitel1(statbestandnr);titelzeileCAT aufberzweistellig(
+text(statjgst)).insek1:statjgst<=maxsek1.einfachetitelzeile:titelzeileCAT 
+bestandtitel1(statbestandnr).fuellestatistikliste:INT VAR feldnr:=
+standardabstand+1;FOR iFROM 1UPTO maxauswertungenREP standardmaskenfeld(
+bestandtitel2(i),feldnr);feldnrINCR standardabstandPER ;feldnrDECR 1;FOR i
+FROM maxauswertungen+1UPTO maxoblizeileREP feldschutz(feldnr);feldnrINCR 
+standardabstandPER .eingangsbildschirmkorrekt:IF sprungvonuntenTHEN TRUE 
+ELSE INT VAR i,kreuzzahl:=0;TEXT VAR ankreuzfeld;statbestandnr:=
+standardanfang;FOR iFROM standardanfangUPTO maxbestaende+1REP ankreuzfeld:=
+standardmaskenfeld(i);IF ankreuzfeld<>niltextTHEN IF (i=standardanfang)THEN 
+statjgst:=int(ankreuzfeld);IF (NOT lastconversionok)COR statjgstungueltig
+THEN LEAVE eingangsbildschirmkorrektWITH FALSE FI FI ;kreuzzahlINCR 1;
+statbestandnr:=iFI PER ;statbestandnrDECR 1;(kreuzzahl<=maxkreuzzahl)CAND (
+kreuzzahl>0)FI .statjgstungueltig:(statjgst<minjgst)COR (statjgst>maxjgst).
+fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext);infeld(
+statbestandnr+1);return(nproc).END PROC statistiklistezeigen;PROC 
+erstellestatistik:reinitparsing;IF listenwahlkorrektTHEN startestatistik(
+statbestandnr,statjgst,statauswertungsnr);initialisiereblaettern;
+zeigefertigestatistikELSE fehlerbehandlungFI .listenwahlkorrekt:INT VAR i,
+kreuzzahl:=0;TEXT VAR ankreuzfeld;statauswertungsnr:=standardanfang;INT VAR 
+feldnr:=standardabstand;FOR iFROM 1UPTO maxauswertungenREP ankreuzfeld:=
+standardmaskenfeld(feldnr);IF ankreuzfeld<>niltextTHEN kreuzzahlINCR 1;
+statauswertungsnr:=iFI ;feldnrINCR standardabstandPER ;(kreuzzahl<=
+maxkreuzzahl)CAND (kreuzzahl>0).initialisiereblaettern:sprungvonunten:=TRUE ;
+IF NOT fehlerzuvielewerteTHEN standardmeldung(fertignr,niltext)FI ;xaktuell:=
+1;yaktuell:=1.fehlerbehandlung:standardmeldung(unzulaessigewahlnr,niltext);
+infeld(statauswertungsnr*standardabstand);return(nproc).END PROC 
+erstellestatistik;PROC zeigefertigestatistik:infeld(fortsetzungsfeld);
+standardnprocEND PROC zeigefertigestatistik;PROC startestatistik(INT CONST 
+bestandnr,jgst,auswertungsnr):initialisiere;maskeausgeben;titelausgeben;
+indexbestimmen;bestaendeausgeben;werteverarbeitung(auswertungsnr).
+initialisiere:fehlerzuvielewerte:=FALSE ;statbasisnr:=basisohnebestand;
+statgrundmaske:=niltext.maskeausgeben:standardstartproc(matrix);
+standardmeldung(wartennr,niltext).titelausgeben:titelzeileCAT titeltrenner;
+IF auswertungsnr=versetzungTHEN versetzungsergaenzungFI ;titelzeilenrest;
+titelzeileausgeben.versetzungsergaenzung:liesschuljahr;lieshalbjahr;
+titelzeilenzusatz.liesschuljahr:aktschuljahr:=schulkenndatum(sjahr).
+lieshalbjahr:akthalbjahr:=schulkenndatum(shj).titelzeilenzusatz:titelzeile
+CAT (subtext(aktschuljahr,1,trennpos1));titelzeileCAT trenner2;titelzeileCAT 
+(subtext(aktschuljahr,trennpos2));titelzeileCAT trenner1;titelzeileCAT 
+akthalbjahr;titelzeileCAT titeltrenner.titelzeilenrest:titelzeileCAT 
+bestandtitel2(auswertungsnr);.titelzeileausgeben:titelzeileIN 
+ueberschriftenfeld.indexbestimmen:SELECT bestandnrOF CASE allejgst,neuan5,
+neuan11,neuansonst,abgegangene:gewindex:=ixsustatfamrufgebCASE allejgstsek1,
+allejgstsek2,einejgst:gewindex:=ixsustatjgstEND SELECT ;indexvorbelegen.
+indexvorbelegen:inittupel(dnrschueler);waspruefen:=einenbestand;gewbestand:=
+gesamtbestand;SELECT bestandnrOF CASE einejgst:putwert(fnrsustatuss,
+gesamtbestand);putwert(fnrsusgrpjgst,jgstkonv(jgst));waspruefen:=einejgst;
+CASE allejgstsek1:putwert(fnrsustatuss,gesamtbestand);putwert(fnrsusgrpjgst,
+"05");waspruefen:=alleinsek1;CASE allejgstsek2:putwert(fnrsustatuss,
+gesamtbestand);putwert(fnrsusgrpjgst,"11");waspruefen:=alleinsek2;CASE 
+allejgst:putwert(fnrsustatuss,gesamtbestand);CASE neuan5:putwert(fnrsustatuss
+,neuanmeld5);gewbestand:=neuanmeld5;CASE neuan11:putwert(fnrsustatuss,
+neuanmeld11);gewbestand:=neuanmeld11;CASE neuansonst:putwert(fnrsustatuss,
+neuanmeldsonst);gewbestand:=neuanmeldsonst;CASE abgegangene:putwert(
+fnrsustatuss,archivbestand);gewbestand:=archivbestand;END SELECT .
+bestaendeausgeben:SELECT bestandnrOF CASE einejgst:ermittleallekomponenten(
+jgst)CASE allejgstsek1:ermittlebestaendezeile(allesek1)CASE allejgstsek2:
+ermittlebestaendezeile(allesek2)CASE allejgst,neuansonst,abgegangene:
+ermittlebestaendezeile(allesek1+allesek2)CASE neuan5:ermittlebestaendezeile(
+praefix(allesek1))CASE neuan11:ermittlebestaendezeile(praefix(allesek2))END 
+SELECT ;bestaendezeileersterteilIN spaltentitel.bestaendezeileersterteil:IF 
+laengespaltentitel<length(bestaendezeile)THEN rechtsverschiebbar:=TRUE ;text(
+bestaendezeile,laengespaltentitel)ELSE rechtsverschiebbar:=FALSE ;text(
+bestaendezeile,laengespaltentitel)+summentitelFI .END PROC startestatistik;
+PROC werteverarbeitung(INT CONST auswertungsnr):vorbereitung;auswertung.
+vorbereitung:schluesseldateinr:=dnrschluessel.auswertung:dateinummer:=
+dnrschueler;SELECT auswertungsnrOF CASE geschlecht:vglfeld:=fnrsugeschlechts;
+statkonst(weiblich,maennlich);CASE alter:vglfeld:=fnrsugebdatums;statalter
+CASE schultyp:vglfeld:=fnrschart;dateinummer:=dnrschulen;statschluessel(
+bestschulart,PROC registriereeinenschueler)CASE zugang:vglfeld:=
+fnrsuartzugang;statschluessel(bestzugang)CASE versetzung:vglfeld:=
+fnrhjdversetzung;dateinummer:=dnrhalbjahresdaten;statschluessel(
+bestversetzung,PROC registriereeinenschueler)CASE teilnahmereli:dateinummer:=
+dnrdiffdaten;statreliCASE fremdsprachen:dateinummer:=dnrdiffdaten;
+statfremdsprachenCASE kunst:vglfeld:=fnrddkunstmusik;dateinummer:=
+dnrdiffdaten;statvariabel(PROC registriereeinenschueler)CASE ort:vglfeld:=
+fnrsuortsteils;statschluessel(bestort)CASE staat:vglfeld:=fnrsustaatsangs;
+statschluessel(beststaat)CASE sprache:vglfeld:=fnrsumuttersprache;
+statschluessel(bestsprache)CASE einschulung:vglfeld:=fnrsujahreinschul;
+stateinschulungCASE herkunft:vglfeld:=fnrsuskennlschule;statherkunftCASE 
+religion:vglfeld:=fnrsureligionsz;statschluessel(bestreligion)CASE aussiedler
+:vglfeld:=fnrsuspaetaus;statkonst(ja,nein);CASE abgang:vglfeld:=fnrsuabggrund
+;statschluessel(bestabgang)CASE abschluss:vglfeld:=fnrsuabschluss;
+statschluessel(bestabschluss)END SELECT .statalter:holetagesdatum;
+statvariabel(PROC zaehlmethodealter).stateinschulung:statvariabel(PROC 
+registriereeinenschueler).statherkunft:schluesseldateinr:=dnrschulen;
+statschluessel(bestherkunft).statreli:statvariabel(PROC zaehlmethodereli).
+statfremdsprachen:statvariabel(PROC zaehlmethodefremdsprachen).END PROC 
+werteverarbeitung;PROC ermittlebestaendezeile(TEXT CONST titel):
+bestaendezeile:=titel;INT VAR lg:=length(titel),ug:=1,og:=laengezaehlfeld,i:=
+0;REP iINCR 1;spaltenwert(i):=compress(subtext(titel,ug,og));ug:=og+1;ogINCR 
+laengezaehlfeldUNTIL og>lgPER ;maxspaltenwert:=iEND PROC 
+ermittlebestaendezeile;PROC ermittleallekomponenten(INT CONST jgst):INT VAR 
+dnrklassenbestand:=dnraktschuelergruppen;bestaendezeile:=niltext;
+maxspaltenwert:=0;vergleichsjgst:=jgstkonv(jgst);vergleichsstart:=TRUE ;
+inittupel(dnrklassenbestand);putwert(fnrsgrpsj,schulkenndatum(sjahr));putwert
+(fnrsgrphj,schulkenndatum(shj));statleseschleife(dnrklassenbestand,
+vergleichsjgst,niltext,dnrklassenbestand+3,dnrklassenbestand+4,PROC (BOOL 
+VAR )gibklasseaus);END PROC ermittleallekomponenten;PROC gibklasseaus(BOOL 
+VAR ende):INT CONST dnr:=dnraktschuelergruppen;TEXT CONST klassenjgst:=
+jgstkonv(intwert(dnr+3));IF vergleichsstartTHEN IF vergleichsjgst<>
+klassenjgstTHEN ende:=TRUE ELSE vergleichsjgst:=klassenjgst;vergleichsstart:=
+FALSE FI ELSE IF vergleichsjgst<>klassenjgstTHEN ende:=TRUE FI FI ;IF NOT 
+endeTHEN TEXT CONST klassenkennung:=wert(dnr+4);maxspaltenwertINCR 1;
+spaltenwert(maxspaltenwert):=compress(klassenkennung);bestaendezeileCAT 
+rechtstext(klassenkennung,laengezaehlfeld);FI END PROC gibklasseaus;PROC 
+felderparsen:IF dateinummer=dnrschuelerTHEN IF vglfeld<=fnrsujgsteintrTHEN 
+parsenooffields(fnrsujgsteintr-dnrschueler)ELSE parsenooffields(vglfeld-
+dnrschueler)FI ELIF dateinummer=dnrhalbjahresdatenTHEN parsenooffields(
+fnrhjdversetzung)ELIF dateinummer=dnrschulenTHEN parsenooffields(
+fnrsuskennlschule)ELSE parsenooffields(fnrsutiddiffdaten-dnrschueler)FI END 
+PROC felderparsen;PROC statkonst(TEXT CONST wert1,wert2):#dr11.05.88#LET 
+konstwertezahl=2;felderparsen;setzewerte;gibwerteaus;startezaehlung.
+setzewerte:variablezaehlung:=FALSE ;maxzeilenwert:=konstwertezahl+
+anhangzeilen;zeileleer:=konstwertezahl+1;zeilenwert(1):=wert1;zeilenwert(2):=
+wert2;zeilenwert(zeileleer):=niltext.gibwerteaus:ausgabederzeilenwerte(1).
+startezaehlung:statzaehlung(PROC registriereeinenschueler).END PROC statkonst
+;PROC statschluessel(TEXT CONST bestand):statschluessel(bestand,PROC 
+registriereeinenschueler)END PROC statschluessel;PROC statschluessel(TEXT 
+CONST bestand,PROC zaehlmethode):systemdboff;setzewerte;gibwerteaus;
+startezaehlung.setzewerte:kuerzelbestand:=bestand;variablezaehlung:=FALSE ;
+maxzeilenwert:=0;inittupel(schluesseldateinr);IF schluesselbestandTHEN 
+statleseschleife(schluesseldateinr,bestand,niltext,schluesseldateinr+1,
+schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)ELSE 
+statleseschleife(schluesseldateinr,niltext,niltext,schluesseldateinr+1,
+schluesseldateinr+2,PROC (BOOL VAR )tragegefundenenzeilenwertein)FI ;
+maxzeilenwertINCR anhangzeilen;zeileleer:=maxzeilenwert-1;zeilenwert(
+maxzeilenwert):=sonsttitel;zeilenwert(zeileleer):=niltext.schluesselbestand:(
+bestandSUB 1)="c".gibwerteaus:ausgabederzeilenwerte(1).startezaehlung:
+statzaehlung(PROC zaehlmethode).END PROC statschluessel;PROC 
+tragegefundenenzeilenwertein(BOOL VAR schluss):IF dbstatus=okTHEN IF 
+schluesseldateinr=dnrschluesselTHEN IF wert(fnrschlsachgebiet)=kuerzelbestand
+THEN IF maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ;
+standardmeldung(meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert(
+maxzeilenwert):=wert(fnrschlschluessel)FI ELSE schluss:=TRUE FI ELSE IF 
+maxzeilenwert=mv-anhangzeilenTHEN fehlerzuvielewerte:=TRUE ;standardmeldung(
+meldzuvielewerte,niltext)ELSE maxzeilenwertINCR 1;zeilenwert(maxzeilenwert):=
+wert(schluesseldateinr+1)FI FI ELSE schluss:=TRUE FI END PROC 
+tragegefundenenzeilenwertein;PROC statvariabel(PROC zaehlmethode):setzewerte;
+gibwerteaus;startezaehlung.setzewerte:variablezaehlung:=TRUE ;maxzeilenwert:=
+0.gibwerteaus:stattext1IN wertebereichanfang;stattext2IN (wertebereichanfang+
+zeilenlaenge).startezaehlung:statzaehlung(PROC zaehlmethode).END PROC 
+statvariabel;PROC statzaehlung(PROC zaehlmethode):LET stackgroesse=15;INT 
+VAR anzahl;vorbereitung;zaehlschleife;IF variablezaehlungTHEN umsortierenFI ;
+ausgabe.vorbereitung:reinitparsing;neueintragnoetig:=FALSE ;statinit(
+maxzeilenwert,maxspaltenwert).zaehlschleife:anzahl:=stackgroesse;
+multisearchforward(gewindex,anzahl);WHILE anzahl>0REP felderparsen;multisucc;
+IF pruefungbestand(waspruefen)THEN IF dateinummer=dnrdiffdaten#dr11.05.88#
+THEN diffdatenlesenELIF dateinummer=dnrhalbjahresdatenTHEN hjddatenlesenELIF 
+dateinummer=dnrschulenTHEN schuldatenlesenFI ;zaehlmethode;
+gegebenenfallsneuenzeilenwertausgeben;anzahlDECR 1;
+wennstackabgearbeitetnachlesenELSE LEAVE zaehlschleifeFI ;PER .diffdatenlesen
+:inittupel(dnrdiffdaten);IF wert(fnrsutiddiffdaten)<>niltextTHEN readtid(
+dnrdiffdaten,wert(fnrsutiddiffdaten))FI .hjddatenlesen:inittupel(
+dnrhalbjahresdaten);IF wert(fnrsutidakthjd)<>niltextTHEN readtid(
+dnrhalbjahresdaten,wert(fnrsutidakthjd));FI .schuldatenlesen:inittupel(
+dnrschulen);IF wert(fnrsuskennlschule)<>niltextTHEN putwert(fnrschkennung,
+wert(fnrsuskennlschule));search(dnrschulen,TRUE )FI .
+gegebenenfallsneuenzeilenwertausgeben:IF variablezaehlungCAND 
+neueintragnoetigTHEN ausgabederzeilenwerte(1)FI .
+wennstackabgearbeitetnachlesen:IF anzahl=0THEN anzahl:=stackgroesse;multisucc
+(gewindex,anzahl);FI .umsortieren:quicksort(1,maxzeilenwert).ausgabe:
+zwischentitel(0);ausgabederzeilenwerte(1);statausgeben(1,1).END PROC 
+statzaehlung;PROC ausgabederzeilenwerte(INT CONST startzeile):
+sovielzeilenwiemoeglich;uebrigezeilenloeschen.sovielzeilenwiemoeglich:INT 
+VAR i,endwert:=min(maxzeilenwert,startzeile+zeilenzahl-1);INT VAR basis:=
+wertebereichanfang;TEXT VAR ausgabewert:="";FOR iFROM startzeileUPTO endwert
+REP IF variablezaehlungTHEN ausgabewert:=zeilenwert(i);IF ausgabewert=
+leertitelplatzhalterTHEN ausgabewert:=leertitelFI ELIF i=zeileleerTHEN 
+ausgabewert:=leertitelELIF i=maxzeilenwertTHEN ausgabewert:=sonsttitelELSE 
+ausgabewert:=zeilenwert(i)FI ;rechtstext(ausgabewert,laengewertefeld)IN basis
+;basisINCR zeilenlaengePER .uebrigezeilenloeschen:TEXT CONST loeschwert:=
+rechtstext(niltext,laengewertefeld);WHILE basis<maxfeldREP loeschwertIN basis
+;basisINCR zeilenlaengePER .END PROC ausgabederzeilenwerte;PROC 
+ausgabederspaltenwerte(INT CONST startspalte):INT VAR basis:=((startspalte-1)
+*laengezaehlfeld)+1;TEXT VAR titel:=subtext(bestaendezeile,basis);IF length(
+titel)<=laengespaltentitelTHEN setzesummenspalteELSE titel:=text(titel,
+laengespaltentitel)FI ;titelIN spaltentitel.setzesummenspalte:titel:=text(
+titel,laengespaltentitel)+summentitel.END PROC ausgabederspaltenwerte;PROC 
+spaltenneuausgeben(INT CONST basisspalte):INT VAR i;FOR iFROM spaltenzahl-1
+DOWNTO 1REP statspalteausgeben(basisspalte+i,i)PER END PROC 
+spaltenneuausgeben;PROC zwischentitel(INT CONST bestandnr):IF bestandnr=0
+THEN IF rechtsverschiebbarTHEN bestaendetitelsoweitesgehtIN spaltentitel;FI 
+ELSE setzecursorFI .bestaendetitelsoweitesgeht:text(bestaendezeile,
+laengespaltentitel).setzecursor:INT VAR aktuellespalte:=bestandnr,basis;IF 
+bestandnr>spaltenzahlTHEN basis:=((bestandnr-spaltenzahl)*laengezaehlfeld)+1;
+text(subtext(bestaendezeile,basis),laengespaltentitel)IN spaltentitel;
+aktuellespalte:=spaltenzahl;loeschespalte(wertebereichanfang+aktuellespalte);
+spaltenneuausgeben(bestandnr-spaltenzahl)FI ;infeld(wertebereichanfang+
+aktuellespalte);INT VAR x,y;getcursor(x,y);cursor(x+laengezaehlfeld-1,y-2).
+END PROC zwischentitel;PROC statblaettern(INT CONST richtung):SELECT richtung
+OF CASE links:nachlinksblaetternCASE rechts:nachrechtsblaetternCASE unten:
+nachuntenblaetternCASE oben:nachobenblaetternEND SELECT ;return(nproc).
+nachlinksblaettern:blaettern(xaktuell,yaktuell,0,-spaltenzahl).
+nachrechtsblaettern:blaettern(xaktuell,yaktuell,0,spaltenzahl).
+nachuntenblaettern:blaettern(xaktuell,yaktuell,zeilenzahl,0).
+nachobenblaettern:blaettern(xaktuell,yaktuell,-zeilenzahl,0).END PROC 
+statblaettern;PROC blaettern(INT VAR x,y,INT CONST xincr,yincr):IF zulaessig
+THEN meldefortsetzung;fuehreausFI .zulaessig:INT CONST xneu:=x+xincr;INT 
+CONST yneu:=y+yincr;((xneu>0)CAND (xneu<=maxzeilenwert))CAND ((yneu>0)CAND (
+yneu<=maxspaltenwert)).meldefortsetzung:IF (xneu=1)CAND (yneu=1)THEN 
+rechtstext(niltext,laengewertefeld)IN fortsetzungsfeldELSE fortsetzungstitel
+IN fortsetzungsfeldFI .fuehreaus:x:=xneu;y:=yneu;IF xincr=0THEN 
+spaltentitelneuELSE zeilentitelneuFI ;statausgeben(xneu,yneu).spaltentitelneu
+:ausgabederspaltenwerte(yneu).zeilentitelneu:ausgabederzeilenwerte(xneu).END 
+PROC blaettern;PROC registriereeinenschueler:tragevariablenwertein(wert(
+vglfeld))END PROC registriereeinenschueler;PROC zaehlmethodealter:TEXT CONST 
+suchwert:=jgstkonv(lebensalter(wert(fnrsugebdatums)));tragevariablenwertein(
+suchwert)END PROC zaehlmethodealter;PROC zaehlmethodereli:TEXT VAR suchwert:=
+"";suchwert:=wert(fnrddreliunter);IF NOT leerTHEN IF abgemeldetTHEN suchwert
+:=abgkz+suchwertFI FI ;eintragen.leer:suchwert=niltext.abgemeldet:datum(
+datumrekonversion(wert(fnrddabmeldedatreli)))<>nildatum.eintragen:
+tragevariablenwertein(suchwert).END PROC zaehlmethodereli;PROC 
+zaehlmethodefremdsprachen:TEXT VAR suchwert:=text(wert(fnrdd1fremdfach),2)+
+text(wert(fnrdd2fremdfach),2)+text(wert(fnrdd3fremdfach),2)+text(wert(
+fnrdd4fremdfach),2);IF suchwert=zeilenlaenge*blankTHEN suchwert:=niltextFI ;
+tragevariablenwertein(suchwert)END PROC zaehlmethodefremdsprachen;PROC 
+tragevariablenwertein(TEXT CONST suchwert):INT VAR lva:=0,zeilennr:=0;BOOL 
+VAR gefunden:=TRUE ;TEXT VAR gefundenerwert:=niltext;sucheaktuellenbestand;
+suchegefundenenwert;IF NOT gefundenAND variablezaehlungTHEN IF maxzeilenwert=
+mvTHEN fehlerzuvielewerte:=TRUE ;standardmeldung(meldzuvielewerte,niltext)
+ELSE neueintragnoetig:=TRUE ;zeilennrINCR 1;maxzeilenwert:=zeilennr;
+zeilenwert(zeilennr):=gefundenerwert;statinit(maxzeilenwert);registrierenFI 
+ELSE neueintragnoetig:=FALSE ;registrierenFI .sucheaktuellenbestand:SELECT 
+statbestandnrOF CASE einejgst:bestimmeaktuellenbestandCASE allejgstsek2:
+aktuellerbestand:=int(wert(fnrsusgrpjgst))-10CASE allejgst,allejgstsek1,
+abgegangene:aktuellerbestand:=int(wert(fnrsusgrpjgst))-4CASE neuansonst:
+aktuellerbestand:=int(wert(fnrsujgsteintr))-4CASE neuan5,neuan11:
+aktuellerbestand:=1END SELECT ;.bestimmeaktuellenbestand:FOR lvaFROM 1UPTO 
+maxspaltenwertREP IF compress(wert(fnrsusgrpzugtut))=compress(spaltenwert(lva
+))THEN aktuellerbestand:=lva;LEAVE bestimmeaktuellenbestandFI PER .
+suchegefundenenwert:IF suchwert=niltextTHEN IF variablezaehlungTHEN 
+gefundenerwert:=leertitelplatzhalter;zeilennr:=gefundenezeile(gefundenerwert,
+maxzeilenwert,gefunden)ELSE zeilennr:=zeileleerFI ELSE gefundenerwert:=
+suchwert;zeilennr:=gefundenezeile(gefundenerwert,maxzeilenwert,gefunden)FI .
+registrieren:statauszaehlen(zeilennr,aktuellerbestand).END PROC 
+tragevariablenwertein;INT PROC gefundenezeile(TEXT CONST vergleichswert,INT 
+CONST oberegrenze,BOOL VAR gefunden):INT VAR i;FOR iFROM 1UPTO oberegrenze
+REP IF vergleichswert=zeilenwert(i)THEN gefunden:=TRUE ;LEAVE gefundenezeile
+WITH iFI PER ;gefunden:=FALSE ;maxzeilenwertEND PROC gefundenezeile;PROC 
+holetagesdatum:TEXT CONST tagesdatum:=date;jahrdestagesdatums:=int(subtext(
+tagesdatum,beginnjahr));monatdestagesdatums:=int(subtext(tagesdatum,
+beginnmonat,endemonat));tagdestagesdatums:=int(subtext(tagesdatum,beginntag,
+endetag));END PROC holetagesdatum;INT PROC lebensalter(TEXT CONST 
+geburtsdatum):INT VAR grundalter:=jahrdestagesdatums-int(subtext(geburtsdatum
+,beginnjahr));IF spaeterermonatgeborenCOR (gleichermonatgeborenCAND 
+spaeterertaggeboren)THEN einsjuengerFI ;grundalter.einsjuenger:grundalter
+DECR 1.spaeterermonatgeboren:INT CONST geburtsmonat:=int(subtext(geburtsdatum
+,beginnmonat,endemonat));geburtsmonat>monatdestagesdatums.
+gleichermonatgeboren:geburtsmonat=monatdestagesdatums.spaeterertaggeboren:int
+(subtext(geburtsdatum,beginntag,endetag))>tagdestagesdatums.END PROC 
+lebensalter;TEXT PROC aufberzweistellig(TEXT CONST jgst):IF length(jgst)=1
+THEN null+jgstELSE jgstFI END PROC aufberzweistellig;TEXT PROC praefix(TEXT 
+CONST t):subtext(t,1,laengezaehlfeld)END PROC praefix;PROC quicksort(INT 
+CONST anfang,ende):IF anfang<endeTHEN waehlepivot;sortieregrob;fuegepivotein;
+quicksort(anfang,pivotstelle-1);quicksort(pivotstelle+1,ende)FI .waehlepivot:
+vertauscheinzeilenwert(anfang,(anfang+ende)DIV 2);TEXT CONST pivot:=
+zeilenwert(anfang).sortieregrob:nimmreduziertezeilenwert;REP schluckelinks;
+schluckerechts;IF nochnichtleerTHEN vertauscheamrandELSE LEAVE sortieregrob
+FI PER .nimmreduziertezeilenwert:INT VAR bereichsanfang:=anfang+1,
+bereichsende:=ende.nochnichtleer:bereichsanfang<=bereichsende.schluckelinks:
+WHILE nochnichtleerCAND zeilenwert(bereichsanfang)<=pivotREP bereichsanfang
+INCR 1PER .schluckerechts:WHILE nochnichtleerCAND zeilenwert(bereichsende)>=
+pivotREP bereichsendeDECR 1PER .vertauscheamrand:vertauscheinzeilenwert(
+bereichsanfang,bereichsende).fuegepivotein:INT CONST pivotstelle:=
+bereichsende;vertauscheinzeilenwert(anfang,pivotstelle).END PROC quicksort;
+PROC vertauscheinzeilenwert(INT CONST i,j):TEXT VAR hilfselement:=zeilenwert(
+i);zeilenwert(i):=zeilenwert(j);zeilenwert(j):=hilfselement;
+statzeilevertauschen(i,j)END PROC vertauscheinzeilenwert;TEXT PROC jgstkonv(
+INT CONST jgst):TEXT CONST tjgst:=text(jgst);IF jgst<maxsek1THEN null+tjgst
+ELSE tjgstFI END PROC jgstkonv;BOOL PROC pruefungbestand(INT CONST welchen):
+BOOL VAR b;SELECT welchenOF CASE einenbestand:pruefungeinenbestand(b)CASE 
+einejgst:pruefungeinejgst(b)CASE alleinsek1:pruefungsek1(b)CASE alleinsek2:
+pruefungsek2(b)END SELECT ;bEND PROC pruefungbestand;PROC pruefungeinejgst(
+BOOL VAR b):b:=(wert(fnrsustatuss)=gewbestandCAND wert(fnrsusgrpjgst)=
+vergleichsjgst)END PROC pruefungeinejgst;PROC pruefungeinenbestand(BOOL VAR b
+):b:=(wert(fnrsustatuss)=gewbestand)END PROC pruefungeinenbestand;PROC 
+pruefungsek1(BOOL VAR b):b:=(wert(fnrsustatuss)=gewbestandCAND intwert(
+fnrsusgrpjgst)<=maxsek1)END PROC pruefungsek1;PROC pruefungsek2(BOOL VAR b):b
+:=(wert(fnrsustatuss)=gewbestandCAND intwert(fnrsusgrpjgst)>maxsek1)END PROC 
+pruefungsek2;END PACKET statintern;
+
diff --git a/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files b/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files
new file mode 100644
index 0000000..e5bd001
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.AUSWERTUNGEN KURSWAHL.files
@@ -0,0 +1,7 @@
+2.kurswahl schnittstelle
+2.likw schuelerwahl sek2
+2.likw kurskombinationen sek2
+2.likw wahl und kursdaten sek2
+2.kw anschr kurslisten sek2
+2.stand der kursbildung analysieren
+
diff --git a/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files
new file mode 100644
index 0000000..8e00897
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL 2.files
@@ -0,0 +1,5 @@
+2.kurswahl schnittstelle
+2.kurszuordnung und umwahl fuer einzelne schueler sek2
+2.kursdaten exportieren
+2.kursdaten importieren
+
diff --git a/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files
new file mode 100644
index 0000000..2f7ea21
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.ERFASSUNGEN KURSWAHL.files
@@ -0,0 +1,8 @@
+0.kurswahlbasis bereinigen
+2.kurswahl schnittstelle
+2.erf wahldaten
+2.kurse auf planbloecke legen
+2.schueler zu kursen zuordnen
+2.konsistenzpruefung in kursdaten
+2.halbjahreswechsel fuer kursdaten
+
diff --git a/app/schulis/2.2.1/src/2.erf wahldaten b/app/schulis/2.2.1/src/2.erf wahldaten
new file mode 100644
index 0000000..79ab36c
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.erf wahldaten
@@ -0,0 +1,395 @@
+PACKET erfwahldatenDEFINES wahldatenveraendern,wahldatenspeichern,
+wahldatenbeenden,wahldatenuebernehmen,wahldatenschuelerlisten,
+wahldatenlisteblaettern,wahldatenlistenachbereiten:LET eingangsmaske=
+"ms wahldaten eingang",textzumeingangsknoten="Wahldaten bearbeiten",
+fnreingbetrjgst=2,fnreingbetrhj=3,fnreingsuderjgst=4,fnreingneuangzurjgst=5,
+fnreingfamiliennamesu=6,fnreingrufnamesu=7,fnreinggeburtsdatumsu=8,
+fnreingkurse=9,fnreinguebernausjgst=10,fnreinguebernaushj=11,
+fnreingcursorruhepos=12;LET jgst10="10",jgst11="11",jgst12="12",jgst13="13",
+hj1="1",hj2="2";LET logtext1="Anw. 2.1.1 Wahl ",logtext2="übernehmen ",
+logtext3=" nach ",logtext4=" für akt. ",text1=" """,text2=""" ",komma=", ",
+punkt=".";TEXT VAR logmeldung;TEXT VAR betrjgst,betrhj,jgstfuersu,
+jgstfuerneuang,aktjgst,schuelermenge,gewsj,sufamname,surufname,sugebdatum,
+kurswahlgewünscht,uebernausjgst,uebernaushj;LET bearbeitungsmaske=
+"ms wahldaten",fnrmeldungsfeld=1,fnrschuljahr=2,fnrschueler=3,
+fnrerstesfachart=4,fnrersteeingabe=5,letztefeldnummer=195,
+offsetnächsteeingabe=2,textfaecherwahl="Fächerwahl",textkurswahl="Kurswahl",
+titelanfang=" eingeben für jetzige Jgst. ",titelmitte=" in ",trennerfuerjgst=
+".",trennerfuerschuljahr="/";LET längedesfaches=2,längederart=2,
+längederkennung=4,längefachmitkennung=6,längeeinesplbl=3,maxfächeroderkurse=
+96,maximalewahlen=13;TEXT VAR aktuellerschueler,alleabiturklausurkürzel;LET 
+ankreuzung="x";TEXT VAR allefächeroderkursangebote;INT VAR 
+längefachoderkursangebot;LET längefachangebot=4,posfachimfachangebot=3,
+längekursangebot=10,poskennungimkursangebot=3,endposkennungimkursangebot=6,
+posartimkursangebot=9;LET listenmaske="mu objektliste",fnrerstesankreuzfeld=2
+,felderprolisteneintrag=2,listeneintraegeproseite=18;LET andenanfang=1,
+ansende=2,vorwaerts=3,rueckwaerts=4,dummyschueler="",sunamenstrenner=", ",
+sulaengeohnedatum=60,datumstrenner=".",maxankreuzungen=1000,ankreuzungliste=
+"x",keineankreuzung="",boolvektordatei="Boolvektor";BOUND ROW maxankreuzungen
+BOOL VAR boolvektor;LET meldungfalschejgst=404,meldungfalscheshj=405,
+meldungfalschejgstfuersu=404,meldungfalschejgstfuerneuang=404,
+meldungmindestenseinejgst=409,meldungjgstsaufeinanderfolgend=410,
+meldungjgstzurueckliegend=411,meldunghjzurueckliegend=412,
+meldungnurzweiteshjmoeglich=413,meldungfeldleerlassen=390,meldungfamnamefehlt
+=166,meldungrufnamefehlt=129,meldungsperrengescheitert=425,
+meldungkeinenschülerangeben=414,meldungübernahmeinsichselbst=415,
+meldungfrageuebernehmen=300,meldungdatenfehlen=68,meldunguebernehmen=301,
+meldunginbearbeitung=352,meldungdatenuebernommen=302,meldungplausi=57,
+meldunglistewirderstellt=7,meldungblaetternnichtmöglich=72,
+meldungkurswahlserverfehlt=416,meldungsugruppeleer=423,meldungkeinangebot=417
+,meldungangebotzugross=418,meldungzuvielewahlen=421,meldungfalscheskürzel=55,
+meldunginkonsistenz=419,meldungdoppelbelegung=420,meldungspeicherung=50,
+meldungspeicherfehler=73;LET kuerzelfuerneuang="N",kuerzelfuersuderjgst="O",
+kuerzelfuerallesu="",kennungnursuname="N",kennungnurwahldatenzumsu="K",
+kennungalleszumsu="A",längeeinerwahl=15,posklausurineinerwahl=1,
+posartineinerwahl=2,leereart="  ",posfachineinerwahl=4,poskennungineinerwahl=
+6,leerekennung="    ",posplbl1ineinerwahl=10,leererplbl="   ",
+leerekennungundplbl="          ",kennungnurplanblöcke="P",poszweiterplbl=4,
+keinplbl="",zusperrenderkwdatenraum="Kurswahl-2 ";LET dbtrenner="�",
+textschulhalbjahr="Schulhalbjahr",textschuljahr="Schuljahr",
+bestandabiturklausur="c02 abitur klausur";LET blank=" ",niltext="";TEXT VAR 
+zugrundeliegendeshj:=niltext,zugrundeliegendessj:=niltext,
+zugrundeliegendejgst:=niltext;BOOL VAR übernahmeingang:=FALSE ,
+bearbeitennachliste:=FALSE ,bearbeitungingang:=FALSE ;INT VAR aktuellezeile,
+erstezeile,letztezeile;LET pufferdatenraum="temporärdatei";ROW maximalewahlen
+TEXT VAR plbl1,plbl2;ROW maximalewahlenINT VAR fnrzurwahl;TEXT VAR eintrag;
+FILE VAR f;BOOL VAR keineplanblöcke;INT VAR ptrfachoderkursangebot,zähler,
+rücksprungweite:=1;PROC wahldatenveraendern:INT VAR fehlerstatus,fnr,i;BOOL 
+VAR sperregesetzt;IF NOT bearbeitennachlisteTHEN fehlerstatus:=
+angabenpruefungdereingangsmaske(2);IF fehlerstatus<>0THEN infeld(fehlerstatus
+);return(1);LEAVE wahldatenveraendernFI ;FI ;holeallerelevantendaten;
+bearbeitungingang:=TRUE ;setzeueberschriftindenmaskekopf;
+bleibendeangabenindiemaskefüllen;gefuelltebearbeitungsmaskeausgeben;
+standardnproc.holeallerelevantendaten:IF NOT bearbeitennachlisteTHEN 
+kurswahlinitialisieren(aktjgst,betrjgst,betrhj,schuelermenge,gewsj);
+kurswahlbasisholen(fehlerstatus);IF fehlerstatus<>0THEN infeld(
+fnreingbetrjgst);wahldatenbeenden;standardmeldung(meldungkurswahlserverfehlt,
+niltext);LEAVE wahldatenveraendernFI ;IF letzterschueler<ersterschuelerTHEN 
+IF schuelermenge=kuerzelfuerneuangTHEN infeld(fnreingneuangzurjgst)ELSE 
+infeld(fnreingsuderjgst)FI ;wahldatenbeenden;standardmeldung(
+meldungsugruppeleer,niltext);LEAVE wahldatenveraendernFI ;
+ermittlelistenstartundende;FI ;IF kurswahlgewünscht=niltextTHEN 
+zugrundeliegendejgst:=aktjgst;IF aktjgst<betrjgstCOR zugrundeliegendeshj<
+betrhjTHEN geplanteshjundsjberechnen(zugrundeliegendeshj,zugrundeliegendessj)
+;IF zugrundeliegendeshj=hj1THEN zugrundeliegendejgst:=text(int(aktjgst)+1,2)
+FI FI ;allefächeroderkursangebote:=niltext;first(dnrfaecherangebot);
+statleseschleife(dnrfaecherangebot,zugrundeliegendessj,zugrundeliegendeshj,
+fnrfangsj,fnrfanghj,PROC (BOOL VAR )sammlefächerangebot);
+längefachoderkursangebot:=längefachangebot;ELSE allefächeroderkursangebote:=
+allekurse;längefachoderkursangebot:=längekursangebot;FI ;IF 
+allefächeroderkursangebote=niltextTHEN infeld(fnreingbetrjgst);
+wahldatenbeenden;standardmeldung(meldungkeinangebot,niltext);LEAVE 
+wahldatenveraendernFI ;IF length(allefächeroderkursangebote)DIV 
+längefachoderkursangebot>maxfächeroderkurseTHEN infeld(fnreingbetrjgst);
+wahldatenbeenden;standardmeldung(meldungangebotzugross,niltext);LEAVE 
+wahldatenveraendernFI ;alleabiturklausurkürzel:=ankreuzung;first(
+dnrschluessel);statleseschleife(dnrschluessel,bestandabiturklausur,"",
+fnrschlsachgebiet,fnrschlschluessel,PROC (BOOL VAR )sammlekürzel);IF 
+bearbeitennachlisteTHEN aktuellezeile:=erstezeile-1ELSE aktuellezeileDECR 1
+FI ;naechsterindex(aktuellezeile);IF aktuellezeile=0THEN infeld(
+fnreingbetrjgst);wahldatenbeenden;LEAVE wahldatenveraendernFI ;
+kurswahlsperresetzen(zusperrenderkwdatenraum,sperregesetzt);IF NOT 
+sperregesetztTHEN infeld(fnreingbetrjgst);wahldatenbeenden;standardmeldung(
+meldungsperrengescheitert,niltext);LEAVE wahldatenveraendernFI ;.
+setzeueberschriftindenmaskekopf:TEXT VAR t;IF kurswahlgewünscht<>niltextTHEN 
+t:=textkurswahlELSE t:=textfaecherwahlFI ;tCAT titelanfang;tCAT aktjgst;tCAT 
+titelmitte;tCAT betrjgst;tCAT trennerfuerjgst;tCAT betrhj;standardstartproc(
+bearbeitungsmaske);standardkopfmaskeaktualisieren(t).
+bleibendeangabenindiemaskefüllen:standardmaskenfeld(text(gewsj,2)+
+trennerfuerschuljahr+subtext(gewsj,3),fnrschuljahr);fnr:=fnrerstesfachart;
+FOR iFROM 1UPTO length(allefächeroderkursangebote)DIV 
+längefachoderkursangebotREP eintrag:=subtext(allefächeroderkursangebote,1+(i-
+1)*längefachoderkursangebot,i*längefachoderkursangebot);IF kurswahlgewünscht=
+niltextTHEN eintrag:=subtext(eintrag,posfachimfachangebot)+blank+text(text(
+eintrag,längederart),längederkennung)ELSE eintrag:=text(eintrag,
+längedesfaches)+blank+subtext(eintrag,poskennungimkursangebot,
+endposkennungimkursangebot)FI ;standardmaskenfeld(eintrag,fnr);fnrINCR 
+offsetnächsteeingabePER ;fnrINCR 1;WHILE fnr<=letztefeldnummerREP feldschutz(
+fnr);fnrINCR offsetnächsteeingabePER .END PROC wahldatenveraendern;PROC 
+wahldatenspeichern(BOOL CONST speichern):INT VAR i,j,fnr,fehlerstatus;TEXT 
+VAR wahldaten,p1,p2,fname,rname,gebdat;IF speichernTHEN 
+evtlaktuelleplanblöckeholen;pruefeplausibilitaet;speicherungdurchfuehren;
+logbucheintragausfuehrenFI ;naechsterindex(aktuellezeile);IF aktuellezeile<>0
+THEN gefuelltebearbeitungsmaskeausgeben;return(1)ELSE wahldatenbeendenFI .
+logbucheintragausfuehren:logmeldung:=betrjgst;logmeldungCAT punkt;logmeldung
+CAT betrhj;logmeldungCAT text1;logmeldungCAT fname;logmeldungCAT komma;
+logmeldungCAT rname;logmeldungCAT komma;logmeldungCAT gebdat;logmeldungCAT 
+text2;logbucheintragvornehmen(logmeldung);.evtlaktuelleplanblöckeholen:IF 
+kurswahlgewünscht<>niltextTHEN kurswahl1holen(fehlerstatus);keineplanblöcke:=
+fehlerstatus<>0FI .pruefeplausibilitaet:standardmeldung(meldungplausi,niltext
+);wahldaten:=niltext;zähler:=0;fnr:=fnrersteeingabe;FOR iFROM 1UPTO length(
+allefächeroderkursangebote)DIV längefachoderkursangebotREP IF 
+standardmaskenfeld(fnr)<>niltextTHEN zählerINCR 1;IF zähler>maximalewahlen
+THEN standardmeldung(meldungzuvielewahlen,niltext);infeld(fnr);return(1);
+LEAVE wahldatenspeichernFI ;IF length(standardmaskenfeld(fnr))>1COR pos(
+alleabiturklausurkürzel,standardmaskenfeld(fnr))=0THEN standardmeldung(
+meldungfalscheskürzel,niltext);infeld(fnr);return(1);LEAVE wahldatenspeichern
+FI ;IF standardmaskenfeld(fnr)=ankreuzungTHEN wahldatenCAT blankELSE 
+wahldatenCAT standardmaskenfeld(fnr)FI ;ptrfachoderkursangebot:=(i-1)*
+längefachoderkursangebot;IF kurswahlgewünscht=niltextTHEN wahldatenCAT 
+subtext(allefächeroderkursangebote,ptrfachoderkursangebot+1,
+ptrfachoderkursangebot+längefachoderkursangebot);wahldatenCAT 
+leerekennungundplbl;ELSE wahldatenCAT subtext(allefächeroderkursangebote,
+ptrfachoderkursangebot+posartimkursangebot,ptrfachoderkursangebot+
+längekursangebot);p1:=subtext(allefächeroderkursangebote,
+ptrfachoderkursangebot+1,ptrfachoderkursangebot+längefachmitkennung);
+wahldatenCAT p1;IF keineplanblöckeTHEN wahldatenCAT leererplbl;wahldatenCAT 
+leererplblELSE p1:=kursdaten(p1,kennungnurplanblöcke);IF p1=keinplblTHEN p1:=
+leererplbl;p2:=leererplblELSE p2:=subtext(p1,poszweiterplbl);p1:=subtext(p1,1
+,längeeinesplbl)FI ;FOR jFROM 1UPTO zähler-1REP IF (p1<>leererplblCAND (p1=
+plbl1[j]COR p1=plbl2[j]))COR (p2<>leererplblCAND (p2=plbl2[j]COR p2=plbl1[j])
+)THEN standardmeldung(meldungdoppelbelegung,standardmaskenfeld(fnrzurwahl[j])
++"#");infeld(fnr);return(1);LEAVE wahldatenspeichernFI ;PER ;plbl1[zähler]:=
+p1;plbl2[zähler]:=p2;wahldatenCAT p1;wahldatenCAT p2;fnrzurwahl[zähler]:=fnr-
+1;FI FI FI ;fnrINCR offsetnächsteeingabePER .speicherungdurchfuehren:
+standardmeldung(meldungspeicherung,niltext);i:=pos(aktuellerschueler,
+dbtrenner);j:=pos(aktuellerschueler,dbtrenner,i+1);fname:=text(
+aktuellerschueler,i-1);rname:=subtext(aktuellerschueler,i+1,j-1);gebdat:=
+subtext(aktuellerschueler,j+1);schuelerwahleintragen(fname,rname,gebdat,
+wahldaten);.END PROC wahldatenspeichern;PROC wahldatenbeenden:INT VAR 
+fehlerstatus:=0,i;rücksprungweite:=1;IF übernahmeingangTHEN forget(
+pufferdatenraum,quiet);FOR iFROM fnreingbetrjgstUPTO fnreinguebernaushjREP 
+feldfrei(i)PER ;feldschutz(fnreingcursorruhepos);infeld(fnreingbetrjgst);IF 
+NOT bearbeitungingangTHEN kurswahlsperrebeenden(zusperrenderkwdatenraum);
+rücksprungweiteINCR 1FI ;übernahmeingang:=FALSE ELSE IF bearbeitennachliste
+COR bearbeitungingangTHEN fülleeingangsmaskeFI FI ;IF bearbeitennachliste
+THEN forget(boolvektordatei,quiet);bearbeitennachliste:=FALSE ;
+rücksprungweiteINCR 1FI ;IF bearbeitungingangTHEN kurswahl2sichern(
+fehlerstatus);IF fehlerstatus<>0THEN standardmeldung(meldungspeicherfehler,
+niltext);infeld(fnreingbetrjgst)FI ;kurswahlsperrebeenden(
+zusperrenderkwdatenraum);bearbeitungingang:=FALSE ;rücksprungweiteINCR 1FI ;
+return(rücksprungweite).fülleeingangsmaske:standardstartproc(eingangsmaske);
+standardkopfmaskeaktualisieren(textzumeingangsknoten);standardmaskenfeld(
+betrjgst,fnreingbetrjgst);standardmaskenfeld(betrhj,fnreingbetrhj);
+standardmaskenfeld(jgstfuersu,fnreingsuderjgst);standardmaskenfeld(
+jgstfuerneuang,fnreingneuangzurjgst);standardmaskenfeld(sufamname,
+fnreingfamiliennamesu);standardmaskenfeld(surufname,fnreingrufnamesu);
+standardmaskenfeld(sugebdatum,fnreinggeburtsdatumsu);standardmaskenfeld(
+kurswahlgewünscht,fnreingkurse);standardmaskenfeld(uebernausjgst,
+fnreinguebernausjgst);standardmaskenfeld(uebernaushj,fnreinguebernaushj);
+standardmaskenfeld(niltext,fnreingcursorruhepos);.END PROC wahldatenbeenden;
+PROC wahldatenuebernehmen(BOOL CONST hauptaktion):INT VAR i,j1,j2,j3,j4,
+fehlerstatus;TEXT VAR zeile,wahlen,t;BOOL VAR sperregesetzt;IF NOT 
+hauptaktionTHEN fehlerstatus:=angabenpruefungdereingangsmaske(1);IF 
+fehlerstatus<>0THEN infeld(fehlerstatus);return(1);LEAVE wahldatenuebernehmen
+FI ;kurswahlinitialisieren(aktjgst,uebernausjgst,uebernaushj,schuelermenge,
+gewsj);kurswahlbasisholen(fehlerstatus);IF fehlerstatus<>0THEN 
+standardmeldung(meldungkurswahlserverfehlt,niltext);infeld(fnreingbetrjgst);
+return(1);LEAVE wahldatenuebernehmenFI ;IF letzterschueler<ersterschueler
+THEN standardmeldung(meldungsugruppeleer,niltext);IF schuelermenge=
+kuerzelfuerneuangTHEN infeld(fnreingneuangzurjgst)ELSE infeld(
+fnreingsuderjgst)FI ;return(1);LEAVE wahldatenuebernehmenFI ;IF NOT 
+kurswahldatenvorhandenTHEN standardmeldung(meldungdatenfehlen,niltext);infeld
+(fnreinguebernausjgst);return(1);LEAVE wahldatenuebernehmenFI ;f:=
+sequentialfile(output,pufferdatenraum);FOR iFROM ersterschuelerUPTO 
+letzterschuelerREP putline(f,wahldatenzumindex(i,kennungalleszumsu))PER ;
+kurswahlinitialisieren(aktjgst,betrjgst,betrhj,schuelermenge,gewsj);
+kurswahlbasisholen(fehlerstatus);IF fehlerstatus<>0THEN standardmeldung(
+meldungkurswahlserverfehlt,niltext);infeld(fnreingbetrjgst);forget(
+pufferdatenraum,quiet);return(1);LEAVE wahldatenuebernehmenFI ;
+kurswahlsperresetzen(zusperrenderkwdatenraum,sperregesetzt);IF NOT 
+sperregesetztTHEN standardmeldung(meldungsperrengescheitert,niltext);infeld(
+fnreingbetrjgst);forget(pufferdatenraum,quiet);return(1);LEAVE 
+wahldatenuebernehmenFI ;übernahmeingang:=TRUE ;standardmeldung(
+meldungfrageuebernehmen,niltext);FOR iFROM fnreingbetrjgstUPTO 
+fnreinguebernaushjREP feldschutz(i)PER ;feldfrei(fnreingcursorruhepos);infeld
+(fnreingcursorruhepos);standardnproc;ELSE standardmeldung(meldunguebernehmen,
+niltext);bearbeitungingang:=TRUE ;f:=sequentialfile(input,pufferdatenraum);
+WHILE NOT eof(f)REP getline(f,zeile);j1:=pos(zeile,dbtrenner);j2:=pos(zeile,
+dbtrenner,j1+1);j3:=pos(zeile,dbtrenner,j2+1);j4:=pos(zeile,dbtrenner,j3+1);
+standardmeldung(meldunginbearbeitung,subtext(zeile,j1+1,j2-1)+"#");IF 
+kurswahlgewünscht=niltextTHEN t:=text(zeile,j1-1);wahlen:=niltext;FOR iFROM 1
+UPTO length(t)DIV längeeinerwahlREP wahlenCAT subtext(t,(i-1)*längeeinerwahl+
+1,(i-1)*längeeinerwahl+poskennungineinerwahl-1);wahlenCAT leerekennungundplbl
+PER ELSE wahlen:=text(zeile,j1-1)FI ;schuelerwahleintragen(subtext(zeile,j1+1
+,j2-1),subtext(zeile,j2+1,j3-1),subtext(zeile,j3+1,j4-1),wahlen);PER ;
+standardmeldung(meldungdatenuebernommen,niltext);logmeldung:=logtext2;
+logmeldungCAT uebernausjgst;logmeldungCAT punkt;logmeldungCAT uebernaushj;
+logmeldungCAT logtext3;logmeldungCAT betrjgst;logmeldungCAT punkt;logmeldung
+CAT betrhj;logmeldungCAT logtext4;logmeldungCAT aktjgst;
+logbucheintragvornehmen(logmeldung);wahldatenbeendenFI END PROC 
+wahldatenuebernehmen;PROC wahldatenschuelerlisten:INT VAR i,fehlerstatus;
+fehlerstatus:=angabenpruefungdereingangsmaske(2);IF fehlerstatus<>0THEN 
+infeld(fehlerstatus);return(1);LEAVE wahldatenschuelerlistenFI ;
+standardmeldung(meldunglistewirderstellt,niltext);kurswahlinitialisieren(
+aktjgst,betrjgst,betrhj,schuelermenge,gewsj);kurswahlbasisholen(fehlerstatus)
+;IF fehlerstatus<>0THEN standardmeldung(meldungkurswahlserverfehlt,niltext);
+infeld(fnreingbetrjgst);return(1);LEAVE wahldatenschuelerlistenFI ;IF 
+letzterschueler<ersterschuelerTHEN standardmeldung(meldungsugruppeleer,
+niltext);IF schuelermenge=kuerzelfuerneuangTHEN infeld(fnreingneuangzurjgst)
+ELSE infeld(fnreingsuderjgst)FI ;return(1);LEAVE wahldatenschuelerlistenFI ;
+bearbeitennachliste:=TRUE ;ermittlelistenstartundende;initboolvektor;
+standardstartproc(listenmaske);listezeigenabzeile(aktuellezeile);
+wahldatenlistenachbereiten.initboolvektor:boolvektor:=new(boolvektordatei);
+FOR iFROM erstezeileUPTO letztezeileREP boolvektor(i):=FALSE PER .END PROC 
+wahldatenschuelerlisten;PROC wahldatenlisteblaettern(INT CONST aktion):
+SELECT aktionOF CASE andenanfang:aktuellezeile:=erstezeile;listezeigenabzeile
+(aktuellezeile)CASE ansende:IF aktuellezeile+listeneintraegeproseite>
+letztezeileTHEN standardmeldung(meldungblaetternnichtmöglich,"")ELSE 
+aktuellezeile:=max(1,letztezeile-listeneintraegeproseite+1);
+listezeigenabzeile(aktuellezeile)FI CASE vorwaerts:IF aktuellezeile+
+listeneintraegeproseite>letztezeileTHEN standardmeldung(
+meldungblaetternnichtmöglich,"")ELSE aktuellezeileINCR 
+listeneintraegeproseite;listezeigenabzeile(aktuellezeile)FI CASE rueckwaerts:
+IF aktuellezeile=erstezeileTHEN standardmeldung(meldungblaetternnichtmöglich,
+"")ELSE aktuellezeileDECR listeneintraegeproseite;aktuellezeile:=max(
+aktuellezeile,erstezeile);listezeigenabzeile(aktuellezeile)FI END SELECT ;
+return(1)END PROC wahldatenlisteblaettern;PROC wahldatenlistenachbereiten:
+INT VAR i,fnr;infeld(fnrerstesankreuzfeld);standardnproc;fnr:=
+fnrerstesankreuzfeld;FOR iFROM aktuellezeileUPTO min(aktuellezeile+
+listeneintraegeproseite,letztezeile)REP boolvektor(i):=standardmaskenfeld(fnr
+)<>niltext;fnrINCR felderprolisteneintragPER END PROC 
+wahldatenlistenachbereiten;PROC ermittlelistenstartundende:INT VAR index,j1,
+j2;TEXT VAR t;letztezeile:=min(maxankreuzungen,letzterschueler);erstezeile:=
+min(ersterschueler,letztezeile);aktuellezeile:=erstergewuenschterschueler.
+erstergewuenschterschueler:index:=erstezeile;IF sufamname<>niltextTHEN t:=
+wahldatenzumindex(index,kennungnursuname);j1:=pos(t,dbtrenner);WHILE 
+sufamname>text(t,j1-1)CAND index<letztezeileREP indexINCR 1;t:=
+wahldatenzumindex(index,kennungnursuname);j1:=pos(t,dbtrenner);PER ;IF 
+sufamname=text(t,j1-1)THEN j2:=pos(t,dbtrenner,j1+1);WHILE sufamname=text(t,
+j1-1)CAND surufname>subtext(t,j1+1,j2-1)CAND index<letztezeileREP indexINCR 1
+;t:=wahldatenzumindex(index,kennungnursuname);j1:=pos(t,dbtrenner);j2:=pos(t,
+dbtrenner,j1+1);PER ;FI ;IF sugebdatum<>niltextTHEN WHILE sufamname=text(t,j1
+-1)CAND surufname=subtext(t,j1+1,j2-1)CAND text(sugebdatum,2)+datumstrenner+
+subtext(sugebdatum,3,4)+datumstrenner+subtext(sugebdatum,5)<>subtext(t,j2+1)
+CAND index<letztezeileREP indexINCR 1;t:=wahldatenzumindex(index,
+kennungnursuname);j1:=pos(t,dbtrenner);j2:=pos(t,dbtrenner,j1+1);PER ;FI ;FI 
+;index.END PROC ermittlelistenstartundende;PROC listezeigenabzeile(INT CONST 
+zeile):INT VAR i,j1,j2,fnr;TEXT VAR t,t1;fnr:=fnrerstesankreuzfeld;FOR iFROM 
+zeileUPTO zeile+listeneintraegeproseiteREP IF i<=letztezeileTHEN t:=
+wahldatenzumindex(i,kennungnursuname);feldfrei(fnr);IF boolvektor(i)THEN 
+standardmaskenfeld(ankreuzungliste,fnr);ELSE standardmaskenfeld(
+keineankreuzung,fnr);FI ;bereiteschuelerzeileauf;standardmaskenfeld(t1,fnr+1)
+;ELSE standardmaskenfeld(niltext,fnr);feldschutz(fnr);standardmaskenfeld(
+dummyschueler,fnr+1)FI ;fnrINCR felderprolisteneintrag;PER ;infeld(
+fnrerstesankreuzfeld);standardfelderausgeben;.bereiteschuelerzeileauf:j1:=pos
+(t,dbtrenner);j2:=pos(t,dbtrenner,j1+1);t1:=text(t,j1-1);t1CAT 
+sunamenstrenner;t1CAT subtext(t,j1+1,j2-1);t1:=text(t1,sulaengeohnedatum);t1
+CAT blank;t1CAT subtext(t,j2+1).END PROC listezeigenabzeile;PROC 
+naechsterindex(INT VAR index):indexINCR 1;IF bearbeitennachlisteTHEN WHILE 
+index<=letztezeileCAND NOT boolvektor(index)REP indexINCR 1PER FI ;IF index>
+letztezeileTHEN index:=0FI END PROC naechsterindex;PROC sammlefächerangebot(
+BOOL VAR b):IF intwert(fnrfangsj)>int(zugrundeliegendessj)COR intwert(
+fnrfanghj)>int(zugrundeliegendeshj)COR intwert(fnrfangjgst)>int(
+zugrundeliegendejgst)COR dbstatus<>0THEN b:=TRUE ELIF intwert(fnrfangjgst)=
+int(zugrundeliegendejgst)THEN allefächeroderkursangeboteCAT text(wert(
+fnrfangart),längederart);allefächeroderkursangeboteCAT text(wert(fnrfangfach)
+,längedesfaches);FI END PROC sammlefächerangebot;PROC sammlekürzel(BOOL VAR b
+):IF wert(fnrschlsachgebiet)<>bestandabiturklausurCOR dbstatus<>0THEN b:=
+TRUE ELSE alleabiturklausurkürzelCAT wert(fnrschlschluessel)FI ;END PROC 
+sammlekürzel;PROC gefuelltebearbeitungsmaskeausgeben:TEXT VAR wahldaten,
+klausurleiste,suchtext;INT VAR i,anfposaktuellewahl,position,fnr;BOOL VAR 
+warnung:=FALSE ;wahldaten:=wahldatenzumindex(aktuellezeile,kennungnursuname);
+aktuellerschueler:=wahldaten;changeall(wahldaten,dbtrenner,sunamenstrenner);
+standardmaskenfeld(text(wahldaten,standardfeldlaenge(fnrschueler)),
+fnrschueler);wahldaten:=wahldatenzumindex(aktuellezeile,
+kennungnurwahldatenzumsu);klausurleiste:=(length(allefächeroderkursangebote)
+DIV längefachoderkursangebot)*dbtrenner;FOR iFROM 1UPTO length(wahldaten)DIV 
+längeeinerwahlREP anfposaktuellewahl:=(i-1)*längeeinerwahl;IF 
+kurswahlgewünscht=niltextTHEN IF subtext(wahldaten,anfposaktuellewahl+
+poskennungineinerwahl,anfposaktuellewahl+posplbl1ineinerwahl-1)<>leerekennung
+THEN warnung:=TRUE FI ;IF subtext(wahldaten,anfposaktuellewahl+
+posartineinerwahl,anfposaktuellewahl+posfachineinerwahl-1)=leereartTHEN 
+warnung:=TRUE ELSE suchtext:=subtext(wahldaten,anfposaktuellewahl+
+posartineinerwahl,anfposaktuellewahl+poskennungineinerwahl-1);position:=pos(
+allefächeroderkursangebote,suchtext);WHILE position<>0CAND positionMOD 
+längefachoderkursangebot<>1REP position:=pos(allefächeroderkursangebote,
+suchtext,position+1);PER ;IF position=0THEN warnung:=TRUE ELSE position:=
+positionDIV längefachoderkursangebot+1;IF (klausurleisteSUB position)<>
+dbtrennerTHEN warnung:=TRUE ELSE IF (wahldatenSUB (anfposaktuellewahl+
+posklausurineinerwahl))=blankTHEN change(klausurleiste,position,position,
+ankreuzung)ELSE change(klausurleiste,position,position,wahldatenSUB (
+anfposaktuellewahl+posklausurineinerwahl))FI FI ;FI FI ELSE IF subtext(
+wahldaten,anfposaktuellewahl+posartineinerwahl,anfposaktuellewahl+
+posfachineinerwahl-1)=leereartTHEN warnung:=TRUE FI ;suchtext:=subtext(
+wahldaten,anfposaktuellewahl+posfachineinerwahl,anfposaktuellewahl+
+posplbl1ineinerwahl-1);position:=pos(allefächeroderkursangebote,suchtext);
+WHILE position<>0CAND positionMOD längefachoderkursangebot<>1REP position:=
+pos(allefächeroderkursangebote,suchtext,position+1);PER ;IF position=0THEN 
+warnung:=TRUE ELSE position:=positionDIV längefachoderkursangebot+1;IF (
+klausurleisteSUB position)<>dbtrennerTHEN warnung:=TRUE ELSE IF (wahldaten
+SUB (anfposaktuellewahl+posklausurineinerwahl))=blankTHEN change(
+klausurleiste,position,position,ankreuzung)ELSE change(klausurleiste,position
+,position,wahldatenSUB (anfposaktuellewahl+posklausurineinerwahl))FI FI FI 
+FI ;PER ;fnr:=fnrersteeingabe;FOR iFROM 1UPTO length(klausurleiste)REP IF (
+klausurleisteSUB i)=dbtrennerTHEN standardmaskenfeld(niltext,fnr)ELSE 
+standardmaskenfeld(klausurleisteSUB i,fnr)FI ;fnrINCR offsetnächsteeingabe
+PER ;IF warnungTHEN standardmeldung(meldunginkonsistenz,niltext);infeld(
+fnrschuljahr)ELSE infeld(fnrmeldungsfeld)FI ;standardfelderausgeben;infeld(
+fnrersteeingabe)END PROC gefuelltebearbeitungsmaskeausgeben;INT PROC 
+angabenpruefungdereingangsmaske(INT CONST aktion):INT VAR fehlerstatus;
+betrjgst:=standardmaskenfeld(fnreingbetrjgst);betrhj:=standardmaskenfeld(
+fnreingbetrhj);IF betrjgst<>jgst11AND betrjgst<>jgst12AND betrjgst<>jgst13
+THEN standardmeldung(meldungfalschejgst,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingbetrjgstFI ;IF betrhj<>hj1AND 
+betrhj<>hj2THEN standardmeldung(meldungfalscheshj,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingbetrhjFI ;jgstfuersu:=
+standardmaskenfeld(fnreingsuderjgst);IF jgstfuersu<>niltextCAND jgstfuersu<>
+jgst10CAND jgstfuersu<>jgst11CAND jgstfuersu<>jgst12CAND jgstfuersu<>jgst13
+THEN standardmeldung(meldungfalschejgstfuersu,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingsuderjgstFI ;jgstfuerneuang:=
+standardmaskenfeld(fnreingneuangzurjgst);IF jgstfuerneuang<>niltextCAND 
+jgstfuerneuang<>jgst11CAND jgstfuerneuang<>jgst12CAND jgstfuerneuang<>jgst13
+THEN standardmeldung(meldungfalschejgstfuerneuang,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingneuangzurjgstFI ;IF jgstfuersu=
+niltextCAND jgstfuerneuang=niltextTHEN standardmeldung(
+meldungmindestenseinejgst,niltext);LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreingsuderjgstFI ;IF jgstfuersu<>niltextCAND jgstfuerneuang<>niltextCAND 
+int(jgstfuersu)+1<>int(jgstfuerneuang)THEN standardmeldung(
+meldungjgstsaufeinanderfolgend,niltext);LEAVE angabenpruefungdereingangsmaske
+WITH fnreingsuderjgstFI ;zugrundeliegendeshj:=schulkenndatum(
+textschulhalbjahr);zugrundeliegendessj:=schulkenndatum(textschuljahr);IF 
+jgstfuerneuang<>niltextTHEN IF jgstfuerneuang>betrjgstTHEN standardmeldung(
+meldungjgstzurueckliegend,niltext);LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreingbetrjgstFI ;aktjgst:=text(int(jgstfuerneuang)-1);IF jgstfuersu<>
+niltextTHEN schuelermenge:=kuerzelfuerallesuELSE schuelermenge:=
+kuerzelfuerneuangFI ELSE IF jgstfuersu>betrjgstTHEN standardmeldung(
+meldungjgstzurueckliegend,niltext);LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreingbetrjgstFI ;IF betrjgst=jgstfuersuCAND betrhj<zugrundeliegendeshjTHEN 
+standardmeldung(meldunghjzurueckliegend,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingbetrhjFI ;aktjgst:=jgstfuersu;
+schuelermenge:=kuerzelfuersuderjgstFI ;IF aktjgst=jgst10CAND 
+zugrundeliegendeshj=hj1THEN standardmeldung(meldungnurzweiteshjmoeglich,
+niltext);IF jgstfuersu<>niltextTHEN LEAVE angabenpruefungdereingangsmaske
+WITH fnreingsuderjgstELSE LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreingneuangzurjgstFI FI ;kurswahlgewünscht:=standardmaskenfeld(fnreingkurse
+);sufamname:=standardmaskenfeld(fnreingfamiliennamesu);surufname:=
+standardmaskenfeld(fnreingrufnamesu);sugebdatum:=standardmaskenfeld(
+fnreinggeburtsdatumsu);uebernausjgst:=standardmaskenfeld(fnreinguebernausjgst
+);uebernaushj:=standardmaskenfeld(fnreinguebernaushj);IF aktion=2THEN IF 
+sufamname=niltextCAND (surufname<>niltextOR sugebdatum<>niltext)THEN 
+standardmeldung(meldungfamnamefehlt,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingfamiliennamesuFI ;IF surufname=
+niltextCAND sugebdatum<>niltextTHEN standardmeldung(meldungrufnamefehlt,
+niltext);LEAVE angabenpruefungdereingangsmaskeWITH fnreingrufnamesuFI ;IF 
+sugebdatum<>niltextTHEN standardpruefe(6,fnreinggeburtsdatumsu,0,0,"",
+fehlerstatus);IF fehlerstatus<>0THEN LEAVE angabenpruefungdereingangsmaske
+WITH fehlerstatusFI FI ;IF uebernausjgst<>niltextTHEN standardmeldung(
+meldungfeldleerlassen,niltext);LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreinguebernausjgstFI ;IF uebernaushj<>niltextTHEN standardmeldung(
+meldungfeldleerlassen,niltext);LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreinguebernaushjFI ELSE IF length(sufamname)+length(surufname)+length(
+sugebdatum)>0THEN standardmeldung(meldungkeinenschülerangeben,niltext);IF 
+sufamname<>niltextTHEN LEAVE angabenpruefungdereingangsmaskeWITH 
+fnreingfamiliennamesuELIF surufname<>niltextTHEN LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreingrufnamesuELSE LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreinggeburtsdatumsuFI ;FI ;IF 
+uebernausjgst<>jgst11AND uebernausjgst<>jgst12AND uebernausjgst<>jgst13THEN 
+standardmeldung(meldungfalschejgst,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ;IF uebernaushj<>
+hj1AND uebernaushj<>hj2THEN standardmeldung(meldungfalscheshj,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreinguebernaushjFI ;IF uebernausjgst=
+betrjgstCAND uebernaushj=betrhjTHEN standardmeldung(
+meldungübernahmeinsichselbst,niltext);LEAVE angabenpruefungdereingangsmaske
+WITH fnreinguebernausjgstFI ;IF jgstfuerneuang<>niltextTHEN IF jgstfuerneuang
+>uebernausjgstTHEN standardmeldung(meldungjgstzurueckliegend,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ;ELSE IF 
+jgstfuersu>uebernausjgstTHEN standardmeldung(meldungjgstzurueckliegend,
+niltext);LEAVE angabenpruefungdereingangsmaskeWITH fnreinguebernausjgstFI ;
+IF uebernausjgst=jgstfuersuCAND uebernaushj<zugrundeliegendeshjTHEN 
+standardmeldung(meldunghjzurueckliegend,niltext);LEAVE 
+angabenpruefungdereingangsmaskeWITH fnreinguebernaushjFI ;FI ;FI ;0END PROC 
+angabenpruefungdereingangsmaske;PROC logbucheintragvornehmen(TEXT CONST 
+escfunktion):logeintrag(logtext1+escfunktion)END PROC logbucheintragvornehmen
+;END PACKET erfwahldaten
+
diff --git a/app/schulis/2.2.1/src/2.halbjahreswechsel fuer kursdaten b/app/schulis/2.2.1/src/2.halbjahreswechsel fuer kursdaten
new file mode 100644
index 0000000..4443395
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.halbjahreswechsel fuer kursdaten
@@ -0,0 +1,77 @@
+PACKET halbjahreswechselfuerkursdatenDEFINES 
+halbjahreswechselfuerkursdatenvorbereiten,
+halbjahreswechselfuerkursdatenstarten,halbjahreswechselfuerkursdatendrucken:
+LET maske="ms halbjahreswechsel fuer kursdaten";INT VAR fnraktsj:=2,fnrakthj
+:=3,fnrgeplsj:=4,fnrgeplhj:=5,fnrauskunft:=6;LET 
+meldnrhalbjahreswechsellaeuft=156,meldnrinbearbeitung=352,
+meldnrkurswahlfehler=416;FILE VAR prot;LET protname=
+"Protokoll zum Halbjahreswechsel";FILE VAR f,faus;LET datei="Ausgangsliste",
+bearbdatei="Bearbeitungsliste";LET schuljahr="Schuljahr",schulhalbjahr=
+"Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET ueberschrift=
+"Schulhalbjahreswechsel für Kursdaten Sek. 2",untertitel1=
+"Wechsel von Schuljahr ",untertitel2="        zum Schuljahr ",halbjahr=
+". Halbjahr",protokollanfang="Planblockschema und Hilfsdateien zu";LET strich
+="-",schraegstrich="/",kennzhell="#";LET beginnjgst=12,beginnhj=15,beginnsj=
+17,beginnjgstsort=6,beginndateiname=8;LET kurswahlpraefix="Kurswahl-",
+kurswahl2praefix="Kurswahl-2",sperrepraefix="Sperre Kurswahl-";TEXT VAR aktsj
+:="",akthj:="",geplsj,geplhj;TEXT VAR vergleichshj:="",vergleichsjgst,
+aktuelleshj;TEXT VAR zeile,neuezeile,auszeile;LET tasknameserver=
+"kurswahl server";TASK VAR kurswahlserver;THESAURUS VAR thes;LET 
+logbucheintraghjwechsel="Anw. 2.2.4.1 Halbjahreswechsel für Kursdaten Sek. 2"
+;PROC halbjahreswechselfuerkursdatenvorbereiten:standardstartproc(maske);IF 
+aktsj=""THEN aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(
+schulhalbjahr)FI ;geplsj:=aktsj;geplhj:=akthj;geplanteshjundsjberechnen(
+geplhj,geplsj);standardmaskenfeld(aktsj,fnraktsj);standardmaskenfeld(akthj,
+fnrakthj);standardmaskenfeld(geplsj,fnrgeplsj);standardmaskenfeld(geplhj,
+fnrgeplhj);infeld(fnraktsj);standardfelderausgeben;infeld(fnrauskunft);
+standardnprocEND PROC halbjahreswechselfuerkursdatenvorbereiten;PROC 
+halbjahreswechselfuerkursdatenstarten:IF NOT existstask(tasknameserver)THEN 
+standardmeldung(meldnrkurswahlfehler,"");return(1)ELSE kurswahlserver:=/
+tasknameserver;standardmeldung(meldnrhalbjahreswechsellaeuft,"");logeintrag(
+logbucheintraghjwechsel+" Start");dateienverzeichnissortierterstellen;
+dateienverzeichnisbehandeln;logeintrag(logbucheintraghjwechsel+" Ende");
+zeigedatei(protname,"")FI .dateienverzeichnissortierterstellen:forget(datei,
+quiet);forget(bearbdatei,quiet);thes:=ALL kurswahlserver;dateiFILLBY thes;f:=
+sequentialfile(input,datei);faus:=sequentialfile(output,bearbdatei);WHILE 
+NOT eof(f)REP getline(f,zeile);IF pos(zeile,kurswahlpraefix)=1THEN 
+sortierkriterienanzeilenanfangkopierenELSE neuezeile:=zeileFI ;putline(faus,
+neuezeile)PER ;forget(datei,quiet);sort(bearbdatei).
+sortierkriterienanzeilenanfangkopieren:neuezeile:=subtext(zeile,beginnsj);
+neuezeileCAT (zeileSUB beginnhj);neuezeileCAT subtext(zeile,beginnjgst,
+beginnjgst+1);neuezeileCAT zeile.dateienverzeichnisbehandeln:aktuelleshj:=
+aktsj;aktuelleshjCAT akthj;f:=sequentialfile(input,bearbdatei);forget(
+protname,quiet);prot:=sequentialfile(output,protname);
+kopfinausgabedateischreiben;commanddialogue(FALSE );WHILE NOT eof(f)REP 
+getline(f,zeile);zeileuntersuchenPER ;forget(bearbdatei,quiet);
+commanddialogue(TRUE ).zeileuntersuchen:IF pos(zeile,kurswahlpraefix)=0THEN 
+erase(zeile,kurswahlserver)ELIF pos(zeile,sperrepraefix)>0THEN erase(zeile,
+kurswahlserver)ELSE IF subtext(zeile,1,5)<>vergleichshjTHEN vergleichshj:=
+subtext(zeile,1,5);vergleichsjgst:="";line(prot);standardmeldung(
+meldnrinbearbeitung,(vergleichshjSUB 5)+". "+subtext(vergleichshj,1,2)+
+schraegstrich+subtext(vergleichshj,3,4)+kennzhell)FI ;IF vergleichshj<=
+aktuelleshjTHEN meldeloeschung(zeile,TRUE );erase(subtext(zeile,
+beginndateiname),kurswahlserver)ELIF pos(zeile,kurswahl2praefix)>0THEN erase(
+subtext(zeile,beginndateiname),kurswahlserver)ELSE meldeloeschung(zeile,
+FALSE )FI FI .kopfinausgabedateischreiben:putline(prot,schulkenndatum(
+schulname));putline(prot,text(schulkenndatum(schulort),65)+date);line(prot);
+putline(prot,ueberschrift);putline(prot,length(ueberschrift)*strich);line(
+prot);auszeile:=untertitel1;auszeileCAT subtext(aktsj,1,2);auszeileCAT 
+schraegstrich;auszeileCAT subtext(aktsj,3,4);auszeileCAT " , ";auszeileCAT 
+akthj;auszeileCAT halbjahr;putline(prot,auszeile);auszeile:=untertitel2;
+auszeileCAT subtext(geplsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext
+(geplsj,3,4);auszeileCAT " , ";auszeileCAT geplhj;auszeileCAT halbjahr;
+putline(prot,auszeile);line(prot);putline(prot,protokollanfang)END PROC 
+halbjahreswechselfuerkursdatenstarten;PROC meldeloeschung(TEXT CONST 
+ausdatname,BOOL CONST loeschen):IF vergleichsjgst<>jgstinausdatnameTHEN 
+vergleichsjgst:=jgstinausdatname;TEXT VAR auszeile:="Jgst. ";auszeileCAT 
+vergleichsjgst;auszeileCAT " in ";auszeileCAT subtext(vergleichshj,1,2);
+auszeileCAT "/";auszeileCAT subtext(vergleichshj,3,4);auszeileCAT " ";
+auszeileCAT (vergleichshjSUB 5);auszeileCAT ". Halbjahr  ";IF loeschenTHEN 
+auszeileCAT "wurden gelöscht"ELSE auszeileCAT "existieren"FI ;putline(prot,
+auszeile)FI .jgstinausdatname:subtext(ausdatname,beginnjgstsort,
+beginnjgstsort+1).END PROC meldeloeschung;PROC 
+halbjahreswechselfuerkursdatendrucken(BOOL CONST drucken):IF druckenTHEN 
+print(protname)FI ;forget(protname,quiet);enter(2)END PROC 
+halbjahreswechselfuerkursdatendrucken;END PACKET 
+halbjahreswechselfuerkursdaten
+
diff --git a/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten b/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten
new file mode 100644
index 0000000..c027414
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.konsistenzpruefung in kursdaten
@@ -0,0 +1,75 @@
+PACKET konsistenzpruefunginkursdatenDEFINES 
+konsistenzpruefunginkursdatenstarten,
+konsistenzpruefunginkursdatenprotokolldrucken:LET meldnrblankomeldung=343;
+LET protname="Protokoll zur Konsistenzprüfung";FILE VAR prot;LET schuljahr=
+"Schuljahr",schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort=
+"Schulort";LET ueberschrift="Konsistenzprüfung in Kursdaten",untertitel1=
+"Kursdaten zum Schuljahr ",texthalbjahr=". Halbjahr",untertitel2=
+"Prüfung am ",beginnderfehlerliste="      festgestellte Inkonsistenzen:";LET 
+strich="-",schraegstrich="/",blank=" ",kennzhell="#";TEXT VAR aktsj:="",akthj
+:="",gewsj:="",gewhj:="",bearbschuljahr;INT VAR ihalbjahr;LET maxhalbjahre=7;
+LET ersteshj="1";INT VAR jgst,gewjgst,jgstinkrement,startjgst;LET jgst10=10,
+jgst11=11,jgst13=13;TEXT VAR auszeile;TEXT VAR gueltigekurse,alleplanbloecke,
+allekursedesplanblocks,planblock,kurs;LET kennungkurse="K";LET 
+laengeplanblock=3,laengekurs=6,laengekursangaben=10;INT VAR posplanblock,
+poskurs;BOOL VAR keinfehleraufgetreten;PROC 
+konsistenzpruefunginkursdatenstarten:IF aktsj=""THEN aktsj:=schulkenndatum(
+schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI ;gewsj:=aktsj;gewhj:=akthj;
+protokollvorbereiten;ausgabekopfaufbereiten;pruefunginkursdatendurchfuehren;
+zeigedatei(protname,"").protokollvorbereiten:forget(protname,quiet);prot:=
+sequentialfile(output,protname).ausgabekopfaufbereiten:putline(prot,
+schulkenndatum(schulname));putline(prot,schulkenndatum(schulort));line(prot,2
+);putline(prot,20*blank+ueberschrift);putline(prot,20*blank+length(
+ueberschrift)*strich);line(prot);auszeile:=untertitel1;auszeileCAT 
+aufberschuljahr;auszeileCAT ", ";auszeileCAT akthj;auszeileCAT texthalbjahr;
+putline(prot,auszeile);auszeile:=untertitel2;auszeileCAT date;auszeileCAT 
+blank;auszeileCAT timeofday;putline(prot,auszeile);line(prot,2).END PROC 
+konsistenzpruefunginkursdatenstarten;PROC pruefunginkursdatendurchfuehren:IF 
+akthj=ersteshjTHEN startjgst:=jgst11ELSE startjgst:=jgst10FI ;FOR jgstFROM 
+startjgstUPTO jgst13REP kurswahlserveraktualisieren(text(jgst),"","")#spr16.
+01.91#PER ;jgstinkrement:=0;FOR ihalbjahrFROM 1UPTO maxhalbjahreREP 
+gewhalbjahrbearbeiten;halbjahrerhoehenPER .halbjahrerhoehen:
+geplanteshjundsjberechnen(gewhj,gewsj);IF gewhj=ersteshjTHEN jgstinkrement
+INCR 1FI .gewhalbjahrbearbeiten:FOR jgstFROM startjgstUPTO jgst13REP gewjgst
+:=jgst+jgstinkrement;IF gewjgst<=13THEN kurswahlinitialisieren(text(jgst),
+text(gewjgst),gewhj,"",bearbschuljahr);IF istkurswahlbasisvorhandenTHEN 
+bearbeiteFI ;FI ;PER .bearbeite:kontrollmeldungausgeben;
+datenmeldunginprotokollausgeben;fehlerschalterinitialisieren;IF 
+aktuellesodergeplanteshalbjahrTHEN INT VAR fehlerstatus;kurswahlbasisholen(
+fehlerstatus);pruefeplanblockschemamitkursen;kurswahl1sichern(fehlerstatus)
+FI ;fehlerschalterauswerten.aktuellesodergeplanteshalbjahr:ihalbjahr=1COR 
+ihalbjahr=2.kontrollmeldungausgeben:auszeile:="Daten zu Jgst. ";auszeileCAT 
+text(gewjgst);auszeileCAT ".";auszeileCAT gewhj;auszeileCAT " in ";auszeile
+CAT aufberschuljahr;auszeileCAT " werden geprüft.";auszeileCAT kennzhell;
+standardmeldung(meldnrblankomeldung,auszeile).datenmeldunginprotokollausgeben
+:auszeile:="Wahldaten für Schüler der Jgst. ";auszeileCAT text(jgst);auszeile
+CAT ": Schuljahr ";auszeileCAT aufberschuljahr;auszeileCAT " Jgst. ";auszeile
+CAT text(gewjgst);auszeileCAT ".";auszeileCAT gewhj;putline(prot,auszeile).
+fehlerschalterinitialisieren:keinfehleraufgetreten:=TRUE .
+fehlerschalterauswerten:IF keinfehleraufgetretenTHEN putline(prot,
+beginnderfehlerliste+" keine")FI ;line(prot,2).pruefeplanblockschemamitkursen
+:gueltigekurse:=allekurse;alleplanbloecke:=alleplanblockbezeichner;
+posplanblock:=1;WHILE posplanblock<length(alleplanbloecke)REP planblock:=
+subtext(alleplanbloecke,posplanblock,posplanblock+laengeplanblock-1);
+allekursedesplanblocks:=planblockdaten(planblock,kennungkurse);poskurs:=1;
+WHILE poskurs<length(allekursedesplanblocks)REP kurs:=subtext(
+allekursedesplanblocks,poskurs,poskurs+laengekurs-1);IF suchpos(gueltigekurse
+,kurs,laengekursangaben)=0THEN planbloeckezumkurseintragen(kurs,"","");
+fehlerprotokollierenFI ;poskursINCR laengekursPER ;posplanblockINCR 
+laengeplanblockPER .fehlerprotokollieren:IF keinfehleraufgetretenTHEN 
+keinfehleraufgetreten:=FALSE ;putline(prot,beginnderfehlerliste)FI ;
+fehlerzeileschreiben.fehlerzeileschreiben:auszeile:="Kurs ";auszeileCAT text(
+gewjgst);auszeileCAT blank;auszeileCAT subtext(kurs,1,2);auszeileCAT blank;
+auszeileCAT subtext(kurs,3);auszeileCAT 
+" : Bezeichnung ungültig, wurde aus der Blockung gelöscht";putline(prot,
+auszeile).END PROC pruefunginkursdatendurchfuehren;TEXT PROC aufberschuljahr:
+TEXT VAR aufbersj:=subtext(gewsj,1,2);aufbersjCAT schraegstrich;aufbersjCAT 
+subtext(gewsj,3,4);aufbersjEND PROC aufberschuljahr;PROC 
+konsistenzpruefunginkursdatenprotokolldrucken(BOOL CONST drucken):IF drucken
+THEN print(protname)FI ;forget(protname,quiet);enter(2)END PROC 
+konsistenzpruefunginkursdatenprotokolldrucken;INT PROC suchpos(TEXT CONST 
+quelle,suchtext,INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext);
+WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE 
+findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;END 
+PACKET konsistenzpruefunginkursdaten
+
diff --git a/app/schulis/2.2.1/src/2.kursdaten exportieren b/app/schulis/2.2.1/src/2.kursdaten exportieren
new file mode 100644
index 0000000..e93c54d
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kursdaten exportieren
@@ -0,0 +1,226 @@
+PACKET kursdatenueberschnittstelleexportierenDEFINES 
+kursdatenschnittstelleexportanfang,
+kursdatenschnittstelleexportaufbereitenoderabfrage,
+kursdatenschnittstelleexportaufbereiten,kursdatenschnittstelleexportzeigen,
+kursdatenschnittstelleexportzeigenverlassen,
+kursdatenschnittstelleexportloeschenabfrage,
+kursdatenschnittstelleexportloeschen,kursdatenschnittstelleexportarchiv,
+kursdatenschnittstelleexportabfrage,
+kursdatenschnittstelleexportloescheundreturn,
+kursdatenschnittstelleexportdrucken,kursdatenschnittstelleexportabbruch:LET 
+eingangsmaske="ms kurswahldaten exportieren",schuljahr="Schuljahr",halbjahr=
+"Schulhalbjahr",filemodus="file ibm",listenname=
+"Liste der Dateien auf der Diskette:",trenner="�",dos="DOS",einganggewjgst=2,
+einganggewhj=3,eingangaktjgst=4,eingangaktneue=5,eingangmitkursen=6,
+eingangdateiname=7,anzeingangsfelder=7,kurslaenge=15,kznurneue="N",kzohneneue
+="O",kzalle="A",kzname="N",kzkurse="K",suffixfa=".FA",suffixwk=".WK",suffixbr
+=".BR",suffixzi=".ZI",suffixzieintrag="                   ",leerekennung="  "
+,meldungkeineschueler=423,meldungbearbwird=352,meldungwarten=69,
+meldungdrucken=58,meldungpraezisieren=129,meldungfeldfuellen=52,
+meldungfalschejgst=404,meldungfalscheshj=405,meldungserverfehler=416,
+meldungandereauswahl=318,meldungdatengeloescht=431,meldungnamefalsch=323,
+meldungrausreichen=343,meldungdisksichern=347,meldungdiskinit=348,
+meldungnameloeschen=349,meldungaufdiskschr=350,meldungnameunbek=351;ROW 
+anzeingangsfelderTEXT VAR eingangrow:=ROW anzeingangsfelderTEXT :("","","",""
+,"","","schulis");INT VAR i,j;TEXT VAR t,t1,t2;INT VAR pos1,pos2,letztepos,
+fstat,ruecksprung,aktfeld;TEXT VAR aktdateiname:="schulis",gewjgst,gewhj,
+aktjgst,aktneue,gewsj,aktsj:="0000",akthj,schuelergruppe,aktsuffix:=suffixfa,
+fahj,fasj,kweintrag,kurseintrag,dateieintrag;THESAURUS VAR thes;BOOL VAR 
+archivfehler;FILE VAR dsfa,dswk,dsbr,dszi,g;PROC 
+kursdatenschnittstelleexportanfang:standardstartproc(eingangsmaske);
+gibeingangaus;standardfelderausgeben;infeld(letztepos);standardnproc.
+gibeingangaus:infeld(1);FOR iFROM 1UPTO anzeingangsfelderREP 
+standardmaskenfeld(eingangrow(i),i);IF eingangrow(i)<>""THEN letztepos:=iFI 
+PER .END PROC kursdatenschnittstelleexportanfang;PROC 
+kursdatenschnittstelleexportaufbereitenoderabfrage:
+pruefeingabeundbelegvariablen;IF fstat=0THEN abfrageloeschenFI .
+abfrageloeschen:beginlist;REP getlistentry(t1,t2);IF pos(t1,suffixfa)>0THEN 
+infeld(eingangdateiname);ruecksprung:=2;standardmeldung(meldungnameloeschen,
+t1+" (-WK,-BR,-ZI)#"+text(t2,8)+"#");standardnproc;LEAVE 
+kursdatenschnittstelleexportaufbereitenoderabfrageFI UNTIL t1=""PER ;
+ruecksprung:=1;kursdatenschnittstelleexportaufbereiten.END PROC 
+kursdatenschnittstelleexportaufbereitenoderabfrage;PROC 
+kursdatenschnittstelleexportaufbereiten:kurswahlinitialisieren(aktjgst,
+gewjgst,gewhj,schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0
+THEN meldungausgeben(meldungserverfehler,einganggewjgst,1);ELIF 
+letzterschueler<ersterschuelerTHEN meldungausgeben(meldungkeineschueler,
+einganggewjgst,1);ELSE bereitefadateiauf;bereitewkdateiauf;bereitebrdateiauf;
+bereitezidateiauf;loeschemeldung;return(ruecksprung)FI .bereitefadateiauf:IF 
+gewjgst=aktjgstCAND gewhj=akthjTHEN fahj:=akthj;fasj:=aktsjELSE 
+geplanteshjundsjberechnen(fahj,fasj)FI ;standardmeldung(meldungbearbwird,
+aktdateiname+suffixfa+"#");forget(aktdateiname+suffixfa,quiet);dsfa:=
+sequentialfile(output,aktdateiname+suffixfa);inittupel(dnrfaecherangebot);
+putwert(fnrfangjgst,gewjgst);statleseschleife(dnrfaecherangebot,fasj,fahj,
+fnrfangsj,fnrfanghj,PROC faecherangebotindateischreiben).bereitewkdateiauf:
+forget(aktdateiname+suffixwk,quiet);dswk:=sequentialfile(output,aktdateiname+
+suffixwk);standardmeldung(meldungbearbwird,aktdateiname+suffixwk+"#");IF 
+eingangrow(eingangmitkursen)<>""THEN erstelledateimitkennungELSE 
+erstelledateiohnekennungFI .erstelledateimitkennung:FOR iFROM ersterschueler
+UPTO letzterschuelerREP kweintrag:=wahldatenzumindex(i,kzname);pos1:=pos(
+kweintrag,trenner)-1;pos2:=pos(kweintrag,trenner,pos1+2)-1;dateieintrag:=text
+(kweintrag,pos1);dateieintrag:=text(dateieintrag,30);dateieintragCAT text(
+subtext(kweintrag,pos1+2,pos2),15);dateieintragCAT subtext(kweintrag,pos2+2);
+kweintrag:=wahldatenzumindex(i,kzkurse);pos1:=1;FOR jFROM 1UPTO length(
+kweintrag)DIV kurslaengeREP kurseintrag:=subtext(kweintrag,pos1,pos1+
+kurslaenge-1);dateieintragCAT subtext(kurseintrag,4,5);dateieintragCAT 
+subtext(kurseintrag,2,3);dateieintragCAT (kurseintragSUB 1);dateieintragCAT 
+subtext(kurseintrag,6,7);pos1INCR kurslaenge;PER ;put(dswk,dateieintrag);line
+(dswk);PER .erstelledateiohnekennung:FOR iFROM ersterschuelerUPTO 
+letzterschuelerREP kweintrag:=wahldatenzumindex(i,kzname);pos1:=pos(kweintrag
+,trenner)-1;pos2:=pos(kweintrag,trenner,pos1+2)-1;dateieintrag:=text(
+kweintrag,pos1);dateieintrag:=text(dateieintrag,30);dateieintragCAT text(
+subtext(kweintrag,pos1+2,pos2),15);dateieintragCAT subtext(kweintrag,pos2+2);
+kweintrag:=wahldatenzumindex(i,kzkurse);pos1:=1;FOR jFROM 1UPTO length(
+kweintrag)DIV kurslaengeREP kurseintrag:=subtext(kweintrag,pos1,pos1+
+kurslaenge-1);dateieintragCAT subtext(kurseintrag,4,5);dateieintragCAT 
+subtext(kurseintrag,2,3);dateieintragCAT (kurseintragSUB 1);dateieintragCAT 
+leerekennung;pos1INCR kurslaenge;PER ;put(dswk,dateieintrag);line(dswk);PER .
+bereitebrdateiauf:forget(aktdateiname+suffixbr,quiet);dsbr:=sequentialfile(
+output,aktdateiname+suffixbr).bereitezidateiauf:forget(aktdateiname+suffixzi,
+quiet);standardmeldung(meldungbearbwird,aktdateiname+suffixzi+"#");dszi:=
+sequentialfile(output,aktdateiname+suffixzi);dateieintrag:=gewsj;dateieintrag
+CAT gewjgst;dateieintragCAT gewhj;dateieintragCAT date;dateieintragCAT 
+"schulis   ";dateieintragCAT suffixzieintrag;put(dszi,dateieintrag).END PROC 
+kursdatenschnittstelleexportaufbereiten;PROC faecherangebotindateischreiben(
+BOOL VAR b):INT VAR wstd;IF wert(fnrfangsj)=fasjCAND wert(fnrfanghj)=fahj
+CAND wert(fnrfangjgst)=gewjgstCAND dbstatus=okTHEN wstd:=intwert(
+fnrfangwochenstd);IF wstd>9THEN wstd:=9FI ;put(dsfa,text(wert(fnrfangfach),2)
++text(wert(fnrfangart),2)+text(wert(fnrfanganzlv),2)+text(wstd));line(dsfa)
+ELSE dbstatus(1);b:=FALSE FI .END PROC faecherangebotindateischreiben;PROC 
+kursdatenschnittstelleexportzeigen:aktdateiname:=standardmaskenfeld(
+eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists(
+aktdateiname+suffixfa)THEN zeigdateiELSE fehlermeldungdateifehltFI .END PROC 
+kursdatenschnittstelleexportzeigen;PROC zeigdatei:zeigedatei(aktdateiname+
+aktsuffix,"vr").END PROC zeigdatei;PROC 
+kursdatenschnittstelleexportzeigenverlassen:IF aktsuffix=suffixziTHEN 
+aktsuffix:=suffixfa;enter(2)ELSE IF aktsuffix=suffixfaTHEN aktsuffix:=
+suffixwkELIF aktsuffix=suffixwkTHEN aktsuffix:=suffixziFI ;enter(1)FI .END 
+PROC kursdatenschnittstelleexportzeigenverlassen;PROC 
+kursdatenschnittstelleexportloeschenabfrage:aktdateiname:=standardmaskenfeld(
+eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists(
+aktdateiname+suffixfa)THEN beginlist;t1:=" ";REP getlistentry(t1,t2);IF t1=
+aktdateiname+suffixfaTHEN standardmeldung(meldungnameloeschen,t1+
+" (-WK,-BR,-ZI)#"+text(t2,8)+"#");standardnproc;LEAVE 
+kursdatenschnittstelleexportloeschenabfrageFI ;UNTIL t1=""PER ELSE 
+fehlermeldungdateifehltFI .END PROC 
+kursdatenschnittstelleexportloeschenabfrage;PROC 
+kursdatenschnittstelleexportloeschen:forget(aktdateiname+suffixfa,quiet);
+forget(aktdateiname+suffixwk,quiet);forget(aktdateiname+suffixbr,quiet);
+forget(aktdateiname+suffixzi,quiet);standardmeldung(meldungdatengeloescht,"")
+;return(2).END PROC kursdatenschnittstelleexportloeschen;PROC 
+kursdatenschnittstelleexportdrucken:aktdateiname:=standardmaskenfeld(
+eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists(
+aktdateiname+suffixfa)THEN druckalledateienELSE fehlermeldungdateifehltFI .
+druckalledateien:standardmeldung(meldungdrucken,"");print(aktdateiname+
+suffixfa);print(aktdateiname+suffixwk);print(aktdateiname+suffixzi);return(1)
+.END PROC kursdatenschnittstelleexportdrucken;PROC 
+pruefeingabeundbelegvariablen:fstat:=0;eingangrow(einganggewjgst):=
+standardmaskenfeld(einganggewjgst);eingangrow(einganggewhj):=
+standardmaskenfeld(einganggewhj);eingangrow(eingangaktjgst):=
+standardmaskenfeld(eingangaktjgst);eingangrow(eingangaktneue):=
+standardmaskenfeld(eingangaktneue);eingangrow(eingangmitkursen):=
+standardmaskenfeld(eingangmitkursen);IF aktsj="0000"THEN aktsj:=
+schulkenndatum(schuljahr);akthj:=schulkenndatum(halbjahr)FI ;gewjgst:=
+eingangrow(einganggewjgst);gewhj:=eingangrow(einganggewhj);aktjgst:=
+eingangrow(eingangaktjgst);aktneue:=eingangrow(eingangaktneue);prueffeld2;
+prueffeld3;prueffeld4und5;prueffeld4;prueffeld5;IF fstat=0THEN pruefdateiname
+FI .prueffeld2:i:=int(gewjgst);IF gewjgst=""THEN meldungausgeben(
+meldungfeldfuellen,einganggewjgst,1);LEAVE pruefeingabeundbelegvariablenELIF 
+i<11COR i>14THEN meldungausgeben(meldungfalschejgst,einganggewjgst,1);LEAVE 
+pruefeingabeundbelegvariablenFI .prueffeld3:i:=int(gewhj);IF gewhj=""THEN 
+meldungausgeben(meldungfeldfuellen,einganggewhj,1);LEAVE 
+pruefeingabeundbelegvariablenELIF i<1COR i>2THEN meldungausgeben(
+meldungfalscheshj,einganggewhj,1);LEAVE pruefeingabeundbelegvariablenFI .
+prueffeld4und5:IF aktjgst=""CAND aktneue=""THEN meldungausgeben(
+meldungpraezisieren,eingangaktjgst,1);LEAVE pruefeingabeundbelegvariablen
+ELIF aktjgst=""CAND aktneue<>""THEN schuelergruppe:=kznurneueELIF aktjgst<>""
+CAND aktneue=""THEN schuelergruppe:=kzohneneueELSE schuelergruppe:=kzalleFI .
+prueffeld4:i:=int(aktjgst);IF i<10COR i>14THEN meldungausgeben(
+meldungfalschejgst,einganggewjgst,1);LEAVE pruefeingabeundbelegvariablenELIF 
+i>int(gewjgst)THEN meldungausgeben(meldungandereauswahl,einganggewjgst,1);
+LEAVE pruefeingabeundbelegvariablenELIF i=int(gewjgst)THEN IF gewhj="1"CAND 
+akthj="2"THEN meldungausgeben(meldungandereauswahl,einganggewhj,1);LEAVE 
+pruefeingabeundbelegvariablenFI FI .prueffeld5:i:=int(aktneue);IF aktneue<>""
+CAND aktjgst<>""THEN IF i-1<>int(aktjgst)THEN meldungausgeben(
+meldungandereauswahl,eingangaktneue,1)FI ELIF aktneue<>""CAND aktjgst=""THEN 
+IF i<11COR i>14THEN meldungausgeben(meldungfalschejgst,eingangaktneue,1)ELIF 
+i+1>int(gewjgst)THEN meldungausgeben(meldungandereauswahl,eingangaktneue,1)
+ELIF i-1=int(gewjgst)THEN IF gewhj="1"CAND akthj="2"THEN meldungausgeben(
+meldungandereauswahl,einganggewhj,1)FI FI FI .pruefdateiname:aktdateiname:=
+standardmaskenfeld(eingangdateiname);IF aktdateiname=""THEN 
+fehlermeldungfeldfuellenELIF falschercode(aktdateiname)THEN 
+fehlermeldungnamefalsch(TRUE )FI .END PROC pruefeingabeundbelegvariablen;
+BOOL PROC falschercode(TEXT CONST t):INT VAR zeichencode;FOR iFROM 1UPTO 
+LENGTH t-3REP zeichencode:=code(tSUB i);IF NOT ((zeichencode>=48AND 
+zeichencode<=57)OR (zeichencode>=65AND zeichencode<=90)OR (zeichencode>=97
+AND zeichencode<=122))THEN LEAVE falschercodeWITH TRUE FI PER ;FALSE END 
+PROC falschercode;PROC meldungausgeben(INT CONST meldung,gewfeld,
+gewruecksprung):fstat:=1;standardmeldung(meldung,"");infeld(gewfeld);return(
+gewruecksprung)END PROC meldungausgeben;PROC archivanmelden:aktfeld:=infeld;
+archivfehler:=FALSE ;commanddialogue(FALSE );aktdateiname:=standardmaskenfeld
+(eingangdateiname);IF aktdateiname=""THEN fehlermeldungfeldfuellenELIF exists
+(aktdateiname+suffixfa)THEN meldearchivanELSE fehlermeldungdateifehltFI .
+meldearchivan:disablestop;reserve(filemodus,/dos);IF iserrorTHEN archivfehler
+:=TRUE ;abbruchnachfehler(1);ELSE enablestopFI .END PROC archivanmelden;PROC 
+kursdatenschnittstelleexportarchiv(INT CONST wahl):aktfeld:=infeld;SELECT 
+wahlOF CASE 1:archivinitialisierenCASE 2:archivanmelden;IF archivfehlerTHEN 
+LEAVE kursdatenschnittstelleexportarchivFI ;archivlistenCASE 3:
+archivbeschreibenCASE 4:archivueberschreibenEND SELECT ;infeld(aktfeld).
+archivinitialisieren:standardmeldung(meldungwarten,"");disablestop;clear(/dos
+);IF iserrorTHEN abbruchnachfehler(2);ELSE enablestop;loeschemeldung;release(
+/dos);return(2)FI .archivlisten:standardmeldung(meldungwarten,"");disablestop
+;g:=sequentialfile(output,listenname);thes:=ALL /dos;IF iserrorTHEN 
+abbruchnachfehler(1);ELSE thesaurusaufbereiten;enablestop;zeigedatei(
+listenname,"vr");release(/dos)FI .thesaurusaufbereiten:t:=" ";i:=0;REP get(
+thes,t,i);putline(g,t)UNTIL t=""PER .archivbeschreiben:standardmeldung(
+meldungwarten,"");disablestop;IF exists(aktdateiname+suffixfa,/dos)THEN IF 
+iserrorTHEN abbruchnachfehler(2);LEAVE kursdatenschnittstelleexportarchiv
+ELSE abfragedateiueberschreibenFI ELSE save(aktdateiname+suffixfa,/dos);IF 
+iserrorTHEN abbruchnachfehler(2);LEAVE kursdatenschnittstelleexportarchiv
+ELSE save(aktdateiname+suffixwk,/dos);save(aktdateiname+suffixbr,/dos);save(
+aktdateiname+suffixzi,/dos)FI ;enablestop;commanddialogue(TRUE );
+loeschemeldung;release(/dos);return(2)FI .abfragedateiueberschreiben:
+standardmeldung(meldungaufdiskschr,aktdateiname+".FA (-WK,-BR,-ZI)#");
+standardnproc.archivueberschreiben:standardmeldung(meldungwarten,"");
+disablestop;commanddialogue(FALSE );erase(aktdateiname+suffixfa,/dos);erase(
+aktdateiname+suffixwk,/dos);erase(aktdateiname+suffixbr,/dos);erase(
+aktdateiname+suffixzi,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE 
+kursdatenschnittstelleexportarchivFI ;save(aktdateiname+suffixfa,/dos);IF 
+iserrorTHEN abbruchnachfehler(3);LEAVE kursdatenschnittstelleexportarchiv
+ELSE save(aktdateiname+suffixwk,/dos);save(aktdateiname+suffixbr,/dos);save(
+aktdateiname+suffixzi,/dos)FI ;enablestop;commanddialogue(TRUE );
+loeschemeldung;release(/dos);return(3).END PROC 
+kursdatenschnittstelleexportarchiv;PROC abbruchnachfehler(INT CONST schritte)
+:standardmeldung(meldungrausreichen,"Fehler: "+errormessage+" !#");clearerror
+;return(schritte);infeld(aktfeld);release(/dos);commanddialogue(TRUE );
+enablestopEND PROC abbruchnachfehler;PROC kursdatenschnittstelleexportabbruch
+(INT CONST schritte):return(schritte);infeld(aktfeld);release(/dos);
+commanddialogue(TRUE );enablestopEND PROC kursdatenschnittstelleexportabbruch
+;PROC kursdatenschnittstelleexportabfrage(INT CONST wahl):SELECT wahlOF CASE 
+1:archivanmelden;IF archivfehlerTHEN LEAVE 
+kursdatenschnittstelleexportabfrageFI ;standardmeldung(meldungdisksichern,
+aktdateiname+".FA (-WK,-BR,-ZI)#")CASE 2:archivanmelden;IF archivfehlerTHEN 
+LEAVE kursdatenschnittstelleexportabfrageFI ;standardmeldung(meldungdiskinit,
+"")CASE 3:fragevorbereiten;standardmeldung(meldungnameloeschen,aktdateiname+
+".FA (-WK,-BR,-ZI)#"+text(t2,8)+"#")END SELECT ;standardnproc.
+fragevorbereiten:aktdateiname:=standardmaskenfeld(eingangdateiname);IF 
+aktdateiname=""THEN fehlermeldungnamefalsch(FALSE )ELIF falschercode(
+aktdateiname)THEN fehlermeldungnamefalsch(TRUE )FI ;IF exists(aktdateiname+
+suffixfa)THEN beginlist;REP getlistentry(t1,t2);UNTIL t1=aktdateiname+
+suffixfaCOR t1=""PER ;ELSE fehlermeldungdateifehlt;LEAVE 
+kursdatenschnittstelleexportabfrageFI .END PROC 
+kursdatenschnittstelleexportabfrage;PROC fehlermeldungdateifehlt:fstat:=1;
+standardmeldung(meldungnameunbek,aktdateiname+".FA (-WK,-BR,-ZI)#");infeld(
+eingangdateiname);return(1).END PROC fehlermeldungdateifehlt;PROC 
+fehlermeldungfeldfuellen:meldungausgeben(meldungpraezisieren,eingangdateiname
+,1).END PROC fehlermeldungfeldfuellen;PROC fehlermeldungnamefalsch(BOOL 
+CONST mitfalschemzeichen):IF mitfalschemzeichenTHEN fstat:=1;standardmeldung(
+meldungnamefalsch,subtext(aktdateiname,i,i)+"#"+aktdateiname+"#");infeld(
+eingangdateiname);return(1)ELSE meldungausgeben(meldungnamefalsch,
+eingangdateiname,1)FI END PROC fehlermeldungnamefalsch;PROC 
+kursdatenschnittstelleexportloescheundreturn(BOOL CONST b):IF bTHEN forget(
+listenname,quiet);FI ;loeschemeldung;return(2)END PROC 
+kursdatenschnittstelleexportloescheundreturn;PROC loeschemeldung:aktfeld:=
+infeld;infeld(1);standardfelderausgeben;infeld(aktfeld)END PROC 
+loeschemeldung;END PACKET kursdatenueberschnittstelleexportieren
+
diff --git a/app/schulis/2.2.1/src/2.kursdaten importieren b/app/schulis/2.2.1/src/2.kursdaten importieren
new file mode 100644
index 0000000..20dd27e
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kursdaten importieren
@@ -0,0 +1,199 @@
+PACKET kursdatenueberschnittstelleimportierenDEFINES 
+kursdatenschnittstelleimportanfang,
+kursdatenschnittstelleimportaufbereitenfrage,
+kursdatenschnittstelleimportaufbereiten,
+kursdatenschnittstelleimportloescheundreturn,
+kursdatenschnittstelleimportarchiv:LET eingangsmaske=
+"ms kurswahldaten importieren",schuljahr="Schuljahr",halbjahr="Schulhalbjahr"
+,kuwa2sperre="Kurswahl-2 ",filemodus="file ibm",listenname=
+"Liste der Dateien auf der Diskette:",protname="Protokoll zur Übernahme",
+schulname="Schulname",schulort="Schulort",leerzeile=" ",ueberschrift1=
+"Protokoll zur Übernahme von Kurswahldaten aus Standardschnittstelle der",
+ueberschrift2a="Jgst. ",ueberschrift2b=" für das Halbjahr ",ueberschrift2c=
+" (Schuljahr ",unterschrift=
+"-----------------------------------------------------------------------",
+fehlerfall1="Fehler,  Schüler nicht in akt. Jgst. : ",fehlerfall2=
+"Warnung, neuer Kurs                  : ",fehlerfall3a=
+"Fehler,  Planblock nicht übernommen  : ",fehlerfall3b=
+"            Nicht übernommene Daten  : ",fehlerfall3c=
+"                                       ",fehlerfall4a=
+"Fehler,  unbekannter Kurs            : ",fehlerfall4b=
+"         in Kurswahl von             : ",trenner="�",dos="DOS",
+eingangdateiname=2,kurslaengebr=6,kurslaengewk=7,kursendebr=5,kursendewk=6,
+kzart="A",kzalle="A",kzplbl="P",kzstd="S",suffixfa=".FA",suffixwk=".WK",
+suffixbr=".BR",suffixzi=".ZI",meldungkeineschueler=423,meldunggewhjunzul=405,
+meldunggewsjunzul=127,meldunggewjgstunzul=404,meldungparallelanw=425,
+meldungbearbwird=352,meldungwarten=69,meldungpraezisieren=129,
+meldungserverfehler=416,meldungdatenuebernehmen=433,meldungdatenirrelevant=
+432,meldungnamefalsch=323,meldungrausreichen=343,meldungnameunbek=351;INT 
+VAR i;TEXT VAR t;INT VAR fstat,aktfeld,ermwstd,kurspos,aktpos,aktzeile;TEXT 
+VAR aktdateiname:="schulis",gewjgst,gewhj,aktjgst,geplsj,geplhj,gewsj,aktsj:=
+"0000",akthj,neuewahldaten,aktfake,dateieintrag,aktkurs,neuekurse:=trenner,
+fach,kennung,behandeltekurse:=trenner,weitererblock;BOOL VAR archivfehler:=
+FALSE ,sperreok:=TRUE ,aktodergeplhj:=FALSE ;THESAURUS VAR thes;FILE VAR dsfa
+,dswk,dsbr,dszi,prot,g;PROC kursdatenschnittstelleimportanfang:
+standardstartproc(eingangsmaske);infeld(2);standardmaskenfeld(aktdateiname,
+eingangdateiname);standardfelderausgeben;standardnproc.END PROC 
+kursdatenschnittstelleimportanfang;PROC 
+kursdatenschnittstelleimportaufbereitenfrage:standardmeldung(meldungwarten,""
+);fstat:=0;pruefdateiname;holedateivomarchiv;holedatenfuerabfrage.
+holedatenfuerabfrage:toline(dszi,1);readrecord(dszi,dateieintrag);gewsj:=text
+(dateieintrag,4);i:=int(gewsj);IF NOT lastconversionokTHEN 
+fehlermeldungsjunzulaessigFI ;gewhj:=dateieintragSUB 7;IF gewhj<>"1"CAND 
+gewhj<>"2"THEN fehlermeldunggewhjunzulaessigFI ;gewjgst:=subtext(dateieintrag
+,5,6);IF gewjgst<>"10"CAND gewjgst<>"11"CAND gewjgst<>"12"CAND gewjgst<>"13"
+THEN fehlermeldunggewjgstunzulaessigFI ;IF aktsj="0000"THEN aktsj:=
+schulkenndatum(schuljahr);akthj:=schulkenndatum(halbjahr);geplhj:=akthj;
+geplsj:=aktsj;geplanteshjundsjberechnen(geplhj,geplsj)FI ;IF gewsj=aktsjCAND 
+gewhj=akthjTHEN aktodergeplhj:=TRUE ;aktjgst:=gewjgstELIF gewsj=aktsjCAND 
+gewhj<akthjTHEN fehlermeldungdatennichtrelevantELIF gewsj<aktsjTHEN 
+fehlermeldungdatennichtrelevantELSE IF gewsj=geplsjCAND gewhj=geplhjTHEN 
+aktodergeplhj:=TRUE ELSE aktodergeplhj:=FALSE FI ;aktjgst:=text(int(gewjgst)-
+(int(text(gewsj,2))-int(text(aktsj,2))))FI ;standardmeldung(
+meldungdatenuebernehmen,aktjgst+"#"+gewjgst+"."+gewhj+"#");standardnproc.
+fehlermeldungdatennichtrelevant:meldungausgeben(meldungdatenirrelevant,
+eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenfrage.
+fehlermeldungsjunzulaessig:meldungausgeben(meldunggewsjunzul,eingangdateiname
+,1);LEAVE kursdatenschnittstelleimportaufbereitenfrage.
+fehlermeldunggewhjunzulaessig:meldungausgeben(meldunggewhjunzul,
+eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenfrage.
+fehlermeldunggewjgstunzulaessig:meldungausgeben(meldunggewjgstunzul,
+eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenfrage.
+pruefdateiname:aktdateiname:=standardmaskenfeld(eingangdateiname);IF 
+aktdateiname=""THEN fehlermeldungfeldfuellenELIF falschercode(aktdateiname)
+THEN fehlermeldungnamefalsch(TRUE )FI .holedateivomarchiv:archivanmelden;IF 
+archivfehlerTHEN LEAVE kursdatenschnittstelleimportaufbereitenfrageFI ;
+disablestop;forget(aktdateiname+suffixfa,quiet);fetch(aktdateiname+suffixfa,/
+dos);IF iserrorTHEN abbruchnachfehler(1);LEAVE 
+kursdatenschnittstelleimportaufbereitenfrageFI ;dsfa:=sequentialfile(modify,
+old(aktdateiname+suffixfa));forget(aktdateiname+suffixwk,quiet);fetch(
+aktdateiname+suffixwk,/dos);IF iserrorTHEN abbruchnachfehler(1);LEAVE 
+kursdatenschnittstelleimportaufbereitenfrageFI ;dswk:=sequentialfile(modify,
+old(aktdateiname+suffixwk));forget(aktdateiname+suffixbr,quiet);fetch(
+aktdateiname+suffixbr,/dos);IF iserrorTHEN abbruchnachfehler(1);LEAVE 
+kursdatenschnittstelleimportaufbereitenfrageFI ;dsbr:=sequentialfile(modify,
+old(aktdateiname+suffixbr));forget(aktdateiname+suffixzi,quiet);fetch(
+aktdateiname+suffixzi,/dos);IF iserrorTHEN abbruchnachfehler(1);LEAVE 
+kursdatenschnittstelleimportaufbereitenfrageFI ;dszi:=sequentialfile(modify,
+old(aktdateiname+suffixzi));enablestop.END PROC 
+kursdatenschnittstelleimportaufbereitenfrage;PROC 
+kursdatenschnittstelleimportaufbereiten:standardmeldung(meldungwarten,"");
+kurswahlinitialisieren(aktjgst,gewjgst,gewhj,kzalle,gewsj);kurswahlbasisholen
+(fstat);IF fstat<>0THEN meldungausgeben(meldungserverfehler,eingangdateiname,
+1);LEAVE kursdatenschnittstelleimportaufbereitenELIF letzterschueler<
+ersterschuelerTHEN meldungausgeben(meldungkeineschueler,eingangdateiname,1);
+LEAVE kursdatenschnittstelleimportaufbereitenFI ;kurswahlsperresetzen(
+kuwa2sperre,sperreok);IF NOT sperreokTHEN meldungausgeben(meldungparallelanw,
+eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenFI ;
+neuekurse:=trenner;behandeltekurse:=trenner;bereiteprotokollvor;
+uebernehmebrdatei;uebernehmewkdatei;loeschemeldung;kurswahlsperrebeenden(
+kuwa2sperre);kurswahlbasissichern;zeigedatei(protname,"vr").
+kurswahlbasissichern:kurswahl0sichern(fstat);kurswahl1sichern(fstat);
+kurswahl2sichern(fstat);IF fstat<>0THEN meldungausgeben(meldungserverfehler,
+eingangdateiname,1);LEAVE kursdatenschnittstelleimportaufbereitenFI .
+bereiteprotokollvor:forget(protname,quiet);prot:=sequentialfile(output,
+protname);putline(prot,schulkenndatum(schulname));putline(prot,text(
+schulkenndatum(schulort),65)+date);putline(prot,leerzeile);putline(prot,
+ueberschrift1);putline(prot,ueberschrift2a+aktjgst+ueberschrift2b+gewjgst+"."
++gewhj+ueberschrift2c+text(gewsj,2)+"/"+subtext(gewsj,3)+"):");putline(prot,
+unterschrift);putline(prot,leerzeile).uebernehmebrdatei:bereitek1dateivor;
+toline(dsbr,1);col(dsbr,1);WHILE NOT eof(dsbr)REP readrecord(dsbr,
+dateieintrag);IF compress(dateieintrag)<>""THEN pruefplanblockundkurse(text(
+dateieintrag,3),subtext(dateieintrag,4))FI ;down(dsbr);col(dsbr,1)PER .
+bereitek1dateivor:planbloeckeinitialisieren;FOR iFROM 1UPTO 22REP 
+planblockloeschen(text(i))PER .uebernehmewkdatei:toline(dswk,1);col(dswk,1);
+WHILE NOT eof(dswk)REP readrecord(dswk,dateieintrag);pruefschueler(compress(
+text(dateieintrag,30)),compress(subtext(dateieintrag,31,45)),subtext(
+dateieintrag,46,53),subtext(dateieintrag,54));down(dswk);col(dswk,1)PER .END 
+PROC kursdatenschnittstelleimportaufbereiten;PROC pruefplanblockundkurse(
+TEXT CONST block,kurse):INT VAR blockbez:=int(text(block,2)),laengekurse:=
+length(kurse);standardmeldung(meldungbearbwird,"Planblock "+text(block,2)+"#"
+);IF blockbez>0CAND blockbez<23THEN tragblockein;tragkurseeinELSE 
+fehlermeldungblockfalschFI .fehlermeldungblockfalsch:putline(prot,
+fehlerfall3a+text(block,2));putline(prot,fehlerfall3b+text(kurse,42));IF 
+laengekurse>42THEN putline(prot,fehlerfall3c+subtext(kurse,43))FI .
+tragblockein:planblockeintragen(text(block,2),text(int(blockSUB 3))).
+tragkurseein:kurspos:=1;WHILE kurspos<laengekurseREP aktkurs:=subtext(kurse,
+kurspos,kurspos+kursendebr);aktfake:=text(aktkurs,2)+text(subtext(aktkurs,5),
+4);weitererblock:="";t:=kursdaten(aktfake,kzart);IF dbstatus=1CAND compress(
+aktfake)<>""THEN ermittlewstd;tragkursein;
+planbloeckezumkurseintragenmitevtlblockeintrag(aktfake,text(block,2),
+weitererblock);behandeltekurseCAT aktfake+trennerELSE 
+evtlplanbloeckeaktualisierenFI ;kursposINCR kurslaengebrPER .ermittlewstd:IF 
+pos(neuekurse,trenner+aktfake+trenner)=0THEN aktzeile:=lineno(dsbr);ermwstd:=
+int(blockSUB 3);toline(dsbr,aktzeile+1);col(dsbr,1);WHILE NOT eof(dsbr)REP 
+downety(dsbr,aktkurs);aktpos:=col(dsbr);IF NOT eof(dsbr)CAND ((aktpos-3)MOD 6
+)=1THEN readrecord(dsbr,t);ermwstdINCR int(tSUB 3);weitererblock:=text(t,2);
+down(dsbr);col(dsbr,1);neuekurseCAT aktfake+trenner;toline(dsbr,aktzeile);
+LEAVE ermittlewstdELSE col(dsbr,aktpos+1)FI ;PER ;neuekurseCAT aktfake+
+trenner;toline(dsbr,aktzeile)FI .evtlplanbloeckeaktualisieren:IF pos(
+behandeltekurse,trenner+aktfake+trenner)=0CAND compress(aktfake)<>""THEN 
+aktzeile:=lineno(dsbr);toline(dsbr,aktzeile+1);col(dsbr,1);WHILE NOT eof(dsbr
+)REP downety(dsbr,aktkurs);aktpos:=col(dsbr);IF NOT eof(dsbr)CAND ((aktpos-3)
+MOD 6)=1THEN readrecord(dsbr,t);weitererblock:=text(t,2);behandeltekurseCAT 
+aktfake+trenner;toline(dsbr,aktzeile);
+planbloeckezumkurseintragenmitevtlblockeintrag(aktfake,text(block,2),
+weitererblock);LEAVE evtlplanbloeckeaktualisierenELSE col(dsbr,aktpos+1)FI ;
+PER ;weitererblock:="";planbloeckezumkurseintragenmitevtlblockeintrag(aktfake
+,text(block,2),weitererblock);behandeltekurseCAT aktfake+trenner;toline(dsbr,
+aktzeile)FI .tragkursein:IF aktodergeplhjTHEN putline(prot,fehlerfall2+text(
+aktkurs,2)+" "+text(subtext(aktkurs,5),4)+", Art "+subtext(aktkurs,3,4))FI ;
+kurseintragen(text(aktkurs,2),text(subtext(aktkurs,5),4),text(ermwstd),
+subtext(aktkurs,3,4)).END PROC pruefplanblockundkurse;PROC 
+planbloeckezumkurseintragenmitevtlblockeintrag(TEXT CONST kurs,block1,block2)
+:TEXT VAR t:=planblockdaten(block1,kzstd);IF dbstatus=1THEN 
+planblockeintragen(block1,"0")FI ;t:=planblockdaten(block2,kzstd);IF dbstatus
+=1THEN planblockeintragen(block2,"0")FI ;planbloeckezumkurseintragen(kurs,
+block1,block2)END PROC planbloeckezumkurseintragenmitevtlblockeintrag;PROC 
+pruefschueler(TEXT CONST famname,rufname,gebdatum,wahldaten):standardmeldung(
+meldungbearbwird,famname+", "+rufname+"#");t:=wahldatenzumschueler(famname,
+rufname,gebdatum,kzart);IF dbstatus=1THEN fehlermeldungunbekschuelerELSE 
+tragwahldateneinFI .fehlermeldungunbekschueler:putline(prot,fehlerfall1+text(
+famname+", "+rufname+", "+gebdatum,40)).tragwahldatenein:
+schuelerwahleintragen(famname,rufname,gebdatum,aufbereitetewahldaten(famname,
+rufname,gebdatum,wahldaten)).END PROC pruefschueler;TEXT PROC 
+aufbereitetewahldaten(TEXT CONST famname,rufname,gebdatum,altewahldaten):INT 
+VAR wahllaenge:=length(altewahldaten);TEXT VAR planbloecke;kurspos:=1;
+neuewahldaten:="";WHILE kurspos<wahllaengeREP aktkurs:=subtext(altewahldaten,
+kurspos,kurspos+kursendewk);fach:=text(aktkurs,2);kennung:=subtext(aktkurs,6)
++"  ";planbloecke:=kursdaten(fach+kennung,kzplbl);IF compress(planbloecke)=""
+THEN putline(prot,fehlerfall4a+fach+" "+kennung+", Art "+subtext(aktkurs,3,4)
+);putline(prot,fehlerfall4b+text(famname+", "+rufname+", "+gebdatum,40))ELSE 
+ergaenzewahldatenFI ;kursposINCR kurslaengewkPER ;neuewahldaten.
+ergaenzewahldaten:neuewahldatenCAT (aktkursSUB 5);neuewahldatenCAT subtext(
+aktkurs,3,4);neuewahldatenCAT fach;neuewahldatenCAT kennung;neuewahldatenCAT 
+planbloecke.END PROC aufbereitetewahldaten;BOOL PROC falschercode(TEXT CONST 
+t):INT VAR zeichencode;FOR iFROM 1UPTO LENGTH t-3REP zeichencode:=code(tSUB i
+);IF NOT ((zeichencode>=48AND zeichencode<=57)OR (zeichencode>=65AND 
+zeichencode<=90)OR (zeichencode>=97AND zeichencode<=122))THEN LEAVE 
+falschercodeWITH TRUE FI PER ;FALSE END PROC falschercode;PROC 
+meldungausgeben(INT CONST meldung,gewfeld,gewruecksprung):fstat:=1;
+standardmeldung(meldung,"");infeld(gewfeld);return(gewruecksprung)END PROC 
+meldungausgeben;PROC archivanmelden:aktfeld:=infeld;archivfehler:=FALSE ;
+commanddialogue(FALSE );disablestop;reserve(filemodus,/dos);IF iserrorTHEN 
+archivfehler:=TRUE ;abbruchnachfehler(1);ELSE enablestopFI .END PROC 
+archivanmelden;PROC kursdatenschnittstelleimportarchiv:aktfeld:=infeld;
+archivanmelden;IF archivfehlerTHEN LEAVE kursdatenschnittstelleimportarchiv
+FI ;archivlisten;infeld(aktfeld).archivlisten:standardmeldung(meldungwarten,
+"");disablestop;g:=sequentialfile(output,listenname);thes:=ALL /dos;IF 
+iserrorTHEN abbruchnachfehler(1);ELSE thesaurusaufbereiten;enablestop;
+zeigedatei(listenname,"vr");release(/dos)FI .thesaurusaufbereiten:t:=" ";i:=0
+;REP get(thes,t,i);putline(g,t)UNTIL t=""PER .END PROC 
+kursdatenschnittstelleimportarchiv;PROC abbruchnachfehler(INT CONST schritte)
+:standardmeldung(meldungrausreichen,"Fehler: "+errormessage+" !#");clearerror
+;return(schritte);infeld(aktfeld);release(/dos);commanddialogue(TRUE );
+enablestopEND PROC abbruchnachfehler;PROC fehlermeldungdateifehlt:fstat:=1;
+standardmeldung(meldungnameunbek,aktdateiname+".FA (-WK,-BR,-ZI)#");infeld(
+eingangdateiname);return(1).END PROC fehlermeldungdateifehlt;PROC 
+fehlermeldungfeldfuellen:meldungausgeben(meldungpraezisieren,eingangdateiname
+,1).END PROC fehlermeldungfeldfuellen;PROC fehlermeldungnamefalsch(BOOL 
+CONST mitfalschemzeichen):IF mitfalschemzeichenTHEN fstat:=1;standardmeldung(
+meldungnamefalsch,subtext(aktdateiname,i,i)+"#"+aktdateiname+"#");infeld(
+eingangdateiname);return(1)ELSE meldungausgeben(meldungnamefalsch,
+eingangdateiname,1)FI END PROC fehlermeldungnamefalsch;PROC 
+kursdatenschnittstelleimportloescheundreturn:forget(listenname,quiet);forget(
+protname,quiet);loeschemeldung;return(3)END PROC 
+kursdatenschnittstelleimportloescheundreturn;PROC loeschemeldung:aktfeld:=
+infeld;infeld(1);standardfelderausgeben;infeld(aktfeld)END PROC 
+loeschemeldung;END PACKET kursdatenueberschnittstelleimportieren
+
diff --git a/app/schulis/2.2.1/src/2.kurse auf planbloecke legen b/app/schulis/2.2.1/src/2.kurse auf planbloecke legen
new file mode 100644
index 0000000..f23d29c
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kurse auf planbloecke legen
@@ -0,0 +1,449 @@
+PACKET kurseaufplanbloeckelegenDEFINES kurseaufbloeckestarten,
+kurseaufbloeckeinitialisieren,kurseaufbloeckeschemaspeichern,
+kurseaufbloeckeschemavorblaettern,kurseaufbloeckeschemaentfernenfrage,
+kurseaufbloeckeschemaentfernen,kurseaufbloeckeschemauebernehmenfrage,
+kurseaufbloeckeschemauebernehmen,kurseaufbloeckebearbeiten,
+kurseaufbloeckeinformationenaufbereiten,kurseaufbloeckerechtehaelftezeigen,
+kurseaufbloeckeaenderungenspeichern,kurseaufbloeckeschemaeinteilen,
+kurseaufbloecketeilblockabspalten,kurseaufbloecketeilblockentfernen,
+kurseaufbloeckeschemanichtweiteraendern,kurseaufbloeckezurueckzumbeginn:LET 
+maskeeingang="ms kurse auf planbloecke eingang",maskebearb=
+"ms kurse auf planbloecke";LET fnrgewjgst=2,fnrhalbjahr=3,fnraktjgst=4,
+fnrneuanjgst=5,fnrherkunftjgst=6,fnrherkunfthj=7,fnrmitkursen=8;LET fnrfach=2
+,fnrart=3,fnrwochenstunden=4,fnranzahlschueler=5,fnranzahlkurse=6,
+fnrschuelerprokurs=7,fnrausgabefach=8,fnrersterkurs=9,fnrletzterblock=44,
+fnrersteblockangabe=45,fnrerstewstd=46,fnrletztewstd=167;LET felderprozeile=
+11,felderprokurs=3;LET meldnrspeichern=50,meldnrkeinezahl=53,
+meldnrdatenwerdengeprueft=57,meldnrloeschen=61,meldnrnichtloeschen=62,
+meldnrnichtspeichern=63,meldnrloeschfrage=65,meldnrbittewarten=69,
+meldnrblaetternunmoeglich=72,meldnrbitteangabeergaenzen=129,
+meldnrangabenichtsinnvoll=162,meldnruebernehmenfrage=300,meldnruebernehmen=
+301,meldnrnichtuebernehmen=303,meldnrfeldleerlassen=390,
+meldnrfachartkombinationungueltig=393,meldnrfalschejgstfolge=410,
+meldnrfalschebezugsjgst=411,meldnruebernahmeingleicheshj=415,
+meldnrkurswahlfehler=416,meldnrdateninbearbeitung=425,meldnrschemagibtsnicht=
+426,meldnrschemagibtsschon=427,meldnrblocknichtteilbar=428,
+meldnrteilblockentfernen=429,meldnrstundensummmestimmtnicht=430;LET 
+feldanzmaskeeingang=8;ROW feldanzmaskeeingangTEXT VAR feldbs1;INT VAR 
+letztecursorfnr:=fnrgewjgst,letztecursorfnrbs2,pruefstatus;INT VAR ifnr;LET 
+maxblock=22;LET maxtabzeilen=66;LET TABZEILE =STRUCT (TEXT blockbez,TEXT wstd
+,INT frei,INT gesamt,TEXT kurse);ROW maxtabzeilenTABZEILE VAR blockzeile;INT 
+VAR izeile,iblock,erstergezeigterblock,letztergezeigterblock,letzterblock:=1;
+BOOL VAR rechtetabellenhaelftezeigen:=FALSE ;INT VAR ikurs;LET maxkurse=7;
+TEXT VAR allekursedesblocks,kursbez;INT VAR poskurs;LET laengekurs=6,
+laengeallekursangaben=10,laengefach=2,laengeart=2,laengefachartstd=5,incrwstd
+=4;LET KURSTAB =STRUCT (TEXT kursname,TEXT blocknr1,TEXT blocknr2);ROW 
+maxfachkursKURSTAB VAR kurstab;INT VAR ifachkurs;LET maxfachkurs=12;TEXT VAR 
+angabenzueinemkurs,gefundenerkurs,gefundeneplanbloecke,gefundenerblock1,
+gefundenerblock2;INT VAR blockwstd1,blockwstd2;LET jgst10=10,jgst11=11,jgst13
+=13,hj1=1,hj2=2;TEXT VAR aktjgst,gewjgst,gewhalbjahr,neuanjgst,kopiejgst,
+kopiehalbjahr,gewschuljahr,aktuelleshalbjahr,fangsj,fanghj;TEXT VAR blocknr,
+pruefblockbez;LET posblockkennung=3;LET kennungteilblockb="b";LET kennungwstd
+="S",kennungkurse="K",kennungplanbloecke="P";TEXT VAR alleplanblockbez;LET 
+planblocklaenge=3,laengeblocknr=2;INT VAR posplanblock;TEXT VAR 
+allekursedesgewhj,allekursedesherkunfthj;TEXT VAR fachartkombinationen:="",
+fach,fachart;INT VAR wochenstundenzahl,anzahlschuelermitfachart,
+anzahlschuelerprokurs,anzahlkursezufachart;BOOL VAR wstdfelderschutz:=FALSE ,
+planbloeckemitkursenuebernehmen,kurswahlsperreok;LET kurswahl1="Kurswahl-1 ";
+TEXT VAR gewschueler;LET nuraktuelleschueler="O",nurneuangemeldete="N";LET 
+zeilenprobildschirm=12;INT VAR kurswahlstatus;TEXT VAR ueberschrift;LET 
+titel1="Kurse blocken für jetzige ",titel2=" in ";LET schulhalbjahr=
+"Schulhalbjahr",schuljahr="Schuljahr";initfelderdeseingangsbildschirms;PROC 
+kurseaufbloeckestarten:standardstartproc(maskeeingang);
+wertedeseingangsbildschirmsholen;infeld(fnrgewjgst);standardfelderausgeben;
+infeld(letztecursorfnr);standardnprocEND PROC kurseaufbloeckestarten;PROC 
+kurseaufbloeckeinitialisieren:eingangsbehandlung(1);IF eingangsmaskenfehler
+THEN infeld(pruefstatus);return(1)ELSE wertedeseingangsbildschirmsmerken;
+kurswahlinitialisieren(aktjgst,gewjgst,gewhalbjahr,gewschueler,gewschuljahr);
+kurswahlbasisholen(kurswahlstatus);IF kurswahlstatus<>0THEN 
+kurswahlfehlerbehandeln;return(1)ELIF alleplanblockbezeichner<>""THEN 
+standardmeldung(meldnrschemagibtsschon,"");infeld(fnrgewjgst);return(1)ELSE 
+kurswahlsperresetzen(kurswahl1,kurswahlsperreok);IF NOT kurswahlsperreokTHEN 
+standardmeldung(meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:=
+FALSE ;blockschemazeigen(1);infeld(fnrerstewstd);standardnprocFI FI FI .END 
+PROC kurseaufbloeckeinitialisieren;PROC kurswahlfehlerbehandeln:
+standardmeldung(meldnrkurswahlfehler,"");pause(10)END PROC 
+kurswahlfehlerbehandeln;PROC kurseaufbloeckezurueckzumbeginn(INT CONST stufen
+):kurswahlsperrebeenden(kurswahl1);enter(stufen)END PROC 
+kurseaufbloeckezurueckzumbeginn;PROC blockschemazeigen(INT CONST art):
+standardstartproc(maskebearb);ueberschriftaufbereiten;
+standardkopfmaskeaktualisieren(ueberschrift);eingabefeldersperren(fnrfach,
+fnrart);zusatzfelderinitialisieren;IF art=1THEN blockschemainitialisieren
+ELSE blockschemafuellenFI ;rechtetabellenhaelftezeigen:=FALSE ;
+blockschemaausgebenab(1);infeld(fnrfach);standardfelderausgeben.
+ueberschriftaufbereiten:IF art=1THEN ueberschrift:=titel1;ueberschriftCAT 
+aktjgst;ueberschriftCAT titel2;ELIF art=2THEN ueberschrift:=text(
+vergleichsknoten);ueberschriftCAT " für ";ELIF art=3THEN IF 
+planbloeckemitkursenuebernehmenTHEN ueberschrift:=text(vergleichsknoten)ELSE 
+ueberschrift:="Blockschema ohne Kurse übernehmen"FI ;ueberschriftCAT 
+" für "FI ;ueberschriftCAT gewjgst;ueberschriftCAT ".";ueberschriftCAT 
+gewhalbjahr;ueberschriftCAT " ";ueberschriftCAT subtext(gewschuljahr,1,2);
+ueberschriftCAT "/";ueberschriftCAT subtext(gewschuljahr,3,4).
+zusatzfelderinitialisieren:FOR ifnrFROM fnrfachUPTO fnrersteblockangabe-1REP 
+standardmaskenfeld("",ifnr)PER .blockschemainitialisieren:FOR iblockFROM 1
+UPTO maxtabzeilenREP IF iblock>maxblockTHEN blockzeile(iblock).blockbez:=""
+ELSE blockzeile(iblock).blockbez:=textzweistellig(iblock)+" "FI ;blockzeile(
+iblock).wstd:="0";blockzeile(iblock).frei:=0;blockzeile(iblock).gesamt:=0;
+blockzeile(iblock).kurse:=""PER ;letzterblock:=maxblock.END PROC 
+blockschemazeigen;PROC blockschemafuellen:alleplanblockbez:=
+alleplanblockbezeichner;iblock:=0;posplanblock:=1;WHILE posplanblock<length(
+alleplanblockbez)REP iblockINCR 1;blocknr:=subtext(alleplanblockbez,
+posplanblock,posplanblock+2);blockzeile(iblock).blockbez:=blocknr;blockzeile(
+iblock).wstd:=planblockdaten(blocknr,kennungwstd);blockzeile(iblock).frei:=0;
+blockzeile(iblock).gesamt:=anzahlfreierschuelerimplanblock(subtext(blocknr,1,
+2),blocknrSUB 3,"","","","");blockzeile(iblock).kurse:=planblockdaten(blocknr
+,kennungkurse);posplanblockINCR planblocklaengeUNTIL iblock=maxtabzeilenPER ;
+letzterblock:=iblockEND PROC blockschemafuellen;PROC blockschemaausgebenab(
+INT CONST ersterblockeintrag):erstergezeigterblock:=ersterblockeintrag;iblock
+:=ersterblockeintrag-1;ifnr:=fnrersteblockangabe;FOR izeileFROM 1UPTO 
+zeilenprobildschirmREP IF iblock<letzterblockTHEN iblockINCR 1;
+volleblockzeileausgebenELSE leereblockzeileausgebenFI ;ifnrINCR 
+felderprozeilePER ;letztergezeigterblock:=iblock.leereblockzeileausgeben:
+standardmaskenfeld("   ",ifnr);standardmaskenfeld(" ",ifnr+1);
+standardmaskenfeld("   ",ifnr+2);standardmaskenfeld("   ",ifnr+3);FOR ikurs
+FROM 1UPTO maxkurseREP standardmaskenfeld("       ",ifnr+3+ikurs)PER ;
+feldschutz(ifnr+1).volleblockzeileausgeben:standardmaskenfeld(blockzeile(
+iblock).blockbez,ifnr);standardmaskenfeld(blockzeile(iblock).wstd,ifnr+1);
+standardmaskenfeld(text(blockzeile(iblock).frei),ifnr+2);standardmaskenfeld(
+text(blockzeile(iblock).gesamt),ifnr+3);allekursedesblocks:=blockzeile(iblock
+).kurse;IF rechtetabellenhaelftezeigenTHEN poskurs:=(maxkurse*laengekurs)+1
+ELSE poskurs:=1FI ;FOR ikursFROM 1UPTO maxkurseREP kursbez:=subtext(
+allekursedesblocks,poskurs,poskurs+laengekurs-1);IF kursbez=""THEN kursbez:=
+"       "ELSE kursbez:=subtext(kursbez,1,2)+" "+subtext(kursbez,3,6)FI ;
+standardmaskenfeld(kursbez,ifnr+3+ikurs);poskursINCR laengekursPER ;IF 
+wstdfelderschutzTHEN feldschutz(ifnr+1)ELSE feldfrei(ifnr+1)FI END PROC 
+blockschemaausgebenab;PROC kurseaufbloeckeschemaspeichern(BOOL CONST 
+speichern):IF speichernTHEN eingetragenewochenstundenmerken;pruefstatus:=0;
+allewochenstundenangabenpruefen;IF pruefstatus<>0THEN standardmeldung(
+meldnrkeinezahl,"");blockschemaausgebenab(pruefstatus);infeld(
+fnrersteblockangabe);standardfelderausgeben;infeld(fnrerstewstd);return(1)
+ELSE standardmeldung(meldnrspeichern,"");wochenstundenspeichern;
+kurswahl1sichern(kurswahlstatus);kurswahlsperrebeenden(kurswahl1);enter(2)FI 
+ELSE standardmeldung(meldnrnichtspeichern,"");kurswahlsperrebeenden(kurswahl1
+);enter(2)FI .allewochenstundenangabenpruefen:INT VAR testint;iblock:=1;
+WHILE iblock<=letzterblockAND pruefstatus=0REP testint:=int(blockzeile(iblock
+).wstd);IF NOT lastconversionokTHEN pruefstatus:=iblockFI ;iblockINCR 1PER .
+wochenstundenspeichern:FOR iblockFROM 1UPTO letzterblockREP 
+planblockeintragen(blockzeile(iblock).blockbez,blockzeile(iblock).wstd)PER .
+END PROC kurseaufbloeckeschemaspeichern;PROC eingetragenewochenstundenmerken:
+ifnr:=fnrerstewstd;iblock:=erstergezeigterblock;FOR izeileFROM 1UPTO 
+zeilenprobildschirmREP blockzeile(iblock).wstd:=standardmaskenfeld(ifnr);ifnr
+INCR felderprozeile;iblockINCR 1UNTIL iblock>letzterblockPER END PROC 
+eingetragenewochenstundenmerken;PROC kurseaufbloeckeschemavorblaettern(BOOL 
+CONST vorwaerts):letztecursorfnrbs2:=infeld;IF letztecursorfnrbs2>=
+fnrerstewstdTHEN letztecursorfnrbs2:=fnrerstewstdFI ;IF vorwaertsTHEN IF 
+letztergezeigterblock=letzterblockTHEN standardmeldung(
+meldnrblaetternunmoeglich,"")ELSE eingetragenewochenstundenmerken;
+blockschemaausgebenab(letztergezeigterblock+1);infeld(fnrersteblockangabe);
+standardfelderausgeben;infeld(letztecursorfnrbs2)FI ELSE IF 
+erstergezeigterblock=1THEN standardmeldung(meldnrblaetternunmoeglich,"")ELSE 
+eingetragenewochenstundenmerken;IF erstergezeigterblock>zeilenprobildschirm
+THEN blockschemaausgebenab(erstergezeigterblock-zeilenprobildschirm)ELSE 
+blockschemaausgebenab(1)FI ;infeld(fnrersteblockangabe);
+standardfelderausgeben;infeld(letztecursorfnrbs2)FI FI ;return(1)END PROC 
+kurseaufbloeckeschemavorblaettern;PROC kurseaufbloeckeschemaentfernenfrage:
+eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return(
+1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst,
+gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(
+kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)
+ELIF alleplanblockbezeichner<>""THEN kurswahlsperresetzen(kurswahl1,
+kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung(
+meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:=TRUE ;
+blockschemazeigen(2);standardmeldung(meldnrloeschfrage,"");feldfrei(fnrfach);
+infeld(fnrfach);standardnprocFI ELSE standardmeldung(meldnrschemagibtsnicht,
+"");infeld(fnrgewjgst);return(1)FI FI .END PROC 
+kurseaufbloeckeschemaentfernenfrage;PROC kurseaufbloeckeschemaentfernen(BOOL 
+CONST entfernen):IF entfernenTHEN standardmeldung(meldnrloeschen,"");
+planbloeckeinitialisierenELSE standardmeldung(meldnrnichtloeschen,"")FI ;
+kurswahlsperrebeenden(kurswahl1);enter(2)END PROC 
+kurseaufbloeckeschemaentfernen;PROC kurseaufbloeckeschemauebernehmenfrage:
+eingangsbehandlung(3);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return(
+1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst,
+gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(
+kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)
+ELIF alleplanblockbezeichner<>""THEN standardmeldung(meldnrschemagibtsschon,
+"");infeld(fnrgewjgst);return(1)ELSE IF planbloeckemitkursenuebernehmenTHEN 
+allekursedesgewhj:=allekurseFI ;TEXT VAR gewschuljahrsave:=gewschuljahr;
+kopiejgst:=standardmaskenfeld(fnrherkunftjgst);kopiehalbjahr:=
+standardmaskenfeld(fnrherkunfthj);kurswahlinitialisieren(aktjgst,kopiejgst,
+kopiehalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(kurswahlstatus);
+IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELIF 
+alleplanblockbezeichner<>""THEN wstdfelderschutz:=TRUE ;gewschuljahr:=
+gewschuljahrsave;blockschemazeigen(3);standardmeldung(meldnruebernehmenfrage,
+"");feldfrei(fnrfach);infeld(fnrfach);standardnprocELSE standardmeldung(
+meldnrschemagibtsnicht,"");infeld(fnrherkunftjgst);return(1)FI FI FI END 
+PROC kurseaufbloeckeschemauebernehmenfrage;PROC 
+kurseaufbloeckeschemauebernehmen(BOOL CONST uebernehmen):IF uebernehmenTHEN 
+standardmeldung(meldnruebernehmen,"");IF planbloeckemitkursenuebernehmenCAND 
+allekursedesgewhj=""THEN allekursedesherkunfthj:=allekurseFI ;
+kurswahlinitialisieren(aktjgst,gewjgst,gewhalbjahr,gewschueler,gewschuljahr);
+kurswahlbasisholen(kurswahlstatus);kurswahlsperresetzen(kurswahl1,
+kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung(
+meldnrdateninbearbeitung,"");return(1)ELSE 
+evtlkurseundplanblockschemauebernahmedurchfuehren;kurswahl0sichern(
+kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;
+kurswahlsperrebeenden(kurswahl1);return(1)ELSE kurswahl1sichern(
+kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;
+kurswahlsperrebeenden(kurswahl1);return(1)ELSE kurswahlsperrebeenden(
+kurswahl1);enter(2)FI FI FI ELSE standardmeldung(meldnrnichtuebernehmen,"");
+enter(2)FI .allekursealskursedesgewhjeintragen:poskurs:=1;WHILE poskurs<=
+length(allekursedesherkunfthj)REP kurseintragen(kursfach,kurskennung,kurswstd
+,kursart);poskursINCR laengeallekursangabenPER .kursfach:subtext(
+allekursedesherkunfthj,poskurs,poskurs+1).kurskennung:compress(subtext(
+allekursedesherkunfthj,poskurs+2,poskurs+5)).kurswstd:subtext(
+allekursedesherkunfthj,poskurs+6,poskurs+7).kursart:subtext(
+allekursedesherkunfthj,poskurs+8,poskurs+9).
+evtlkurseundplanblockschemauebernahmedurchfuehren:IF 
+planbloeckemitkursenuebernehmenCAND allekursedesgewhj=""THEN 
+allekursealskursedesgewhjeintragen;allekursedesgewhj:=allekursedesherkunfthj
+FI ;FOR iblockFROM 1UPTO letzterblockREP planblockeintragen(blockzeile(iblock
+).blockbez,blockzeile(iblock).wstd);IF planbloeckemitkursenuebernehmenTHEN 
+allekursedesblocks:=blockzeile(iblock).kurse;poskurs:=1;WHILE poskurs<=length
+(allekursedesblocks)REP kursbez:=subtext(allekursedesblocks,poskurs,poskurs+
+laengekurs-1);IF suchpos(allekursedesgewhj,kursbez,laengeallekursangaben)>0
+THEN kurszumplanblockeintragen(compress(kursbez),blockzeile(iblock).blockbez)
+FI ;poskursINCR laengekursPER ;FI PER .END PROC 
+kurseaufbloeckeschemauebernehmen;PROC kurseaufbloeckebearbeiten:
+eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return(
+1)ELSE wertedeseingangsbildschirmsmerken;kurswahlinitialisieren(aktjgst,
+gewjgst,gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(
+kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)
+ELIF alleplanblockbezeichner<>""THEN kurswahlsperresetzen(kurswahl1,
+kurswahlsperreok);IF NOT kurswahlsperreokTHEN standardmeldung(
+meldnrdateninbearbeitung,"");return(1)ELSE wstdfelderschutz:=TRUE ;
+blockschemazeigen(2);feldfrei(fnrfach);feldfrei(fnrart);infeld(fnrfach);
+standardnprocFI ELSE standardmeldung(meldnrschemagibtsnicht,"");infeld(
+fnrgewjgst);return(1)FI FI END PROC kurseaufbloeckebearbeiten;PROC 
+kurseaufbloeckeinformationenaufbereiten:fach:=text(standardmaskenfeld(fnrfach
+),laengefach);fachart:=text(standardmaskenfeld(fnrart),laengeart);IF 
+gueltigefachartkombination(fach,fachart,wochenstundenzahl)THEN kurswahl2holen
+(kurswahlstatus);IF kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)
+ELSE informationenwirklichaufbereiten;standardnprocFI ELSE standardmeldung(
+meldnrfachartkombinationungueltig,"");return(1)FI .
+informationenwirklichaufbereiten:feldschutzfuerinfosetzen;standardmaskenfeld(
+fach,fnrausgabefach);anzahlschuelermitfachart:=anzahlschuelermitwahl(fach,"",
+fachart,"");standardmaskenfeld(text(anzahlschuelermitfachart),
+fnranzahlschueler);standardmaskenfeld(text(wochenstundenzahl),
+fnrwochenstunden);kursezufachundartbestimmen;standardmaskenfeld(text(
+anzahlkursezufachart),fnranzahlkurse);IF anzahlkursezufachart>0THEN 
+anzahlschuelerprokurs:=anzahlschuelermitfachartDIV anzahlkursezufachart;
+standardmaskenfeld(text(anzahlschuelerprokurs),fnrschuelerprokurs)ELSE 
+standardmaskenfeld("   ",fnrschuelerprokurs)FI ;iblock:=0;posplanblock:=1;
+WHILE posplanblock<length(alleplanblockbez)REP iblockINCR 1;blocknr:=subtext(
+alleplanblockbez,posplanblock,posplanblock+2);blockzeile(iblock).frei:=
+anzahlfreierschuelerimplanblock(subtext(blocknr,1,2),blocknrSUB 3,fach,"",
+fachart,"");posplanblockINCR planblocklaengeUNTIL iblock=letzterblockPER ;
+blockschemaausgebenab(erstergezeigterblock);infeld(fnrwochenstunden);
+standardfelderausgeben;infeld(fnrersterkurs).feldschutzfuerinfosetzen:
+feldschutz(fnrfach);feldschutz(fnrart);eingabefelderoeffnen(fnrersterkurs,
+fnrletzterblock).kursezufachundartbestimmen:allekursedesgewhj:=allekurse;
+poskurs:=1;anzahlkursezufachart:=0;ifnr:=fnrersterkurs;FOR ifachkursFROM 1
+UPTO maxfachkursREP suchegewuenschtenkursinkursendeshj;IF gefundenerkurs<>""
+THEN standardmaskenfeld(compress(gefundenerkurs),ifnr);standardmaskenfeld(
+compress(gefundenerblock1),ifnr+1);standardmaskenfeld(compress(
+gefundenerblock2),ifnr+2);anzahlkursezufachartINCR 1ELSE standardmaskenfeld(
+"",ifnr);standardmaskenfeld("",ifnr+1);standardmaskenfeld("",ifnr+2)FI ;
+kurstab(ifachkurs).kursname:=standardmaskenfeld(ifnr);kurstab(ifachkurs).
+blocknr1:=standardmaskenfeld(ifnr+1);kurstab(ifachkurs).blocknr2:=
+standardmaskenfeld(ifnr+2);ifnrINCR felderprokursPER .
+suchegewuenschtenkursinkursendeshj:gefundenerkurs:="";WHILE poskurs<=length(
+allekursedesgewhj)REP angabenzueinemkurs:=subtext(allekursedesgewhj,poskurs,
+poskurs+laengeallekursangaben-1);IF subtext(angabenzueinemkurs,1,2)=fachCAND 
+subtext(angabenzueinemkurs,9,10)=fachartTHEN gefundenerkurs:=subtext(
+angabenzueinemkurs,1,6);gefundeneplanbloecke:=kursdaten(gefundenerkurs,
+kennungplanbloecke);gefundenerblock1:=subtext(gefundeneplanbloecke,1,3);
+gefundenerblock2:=subtext(gefundeneplanbloecke,4,6);gefundenerkurs:=subtext(
+gefundenerkurs,3)FI ;poskursINCR laengeallekursangabenUNTIL gefundenerkurs<>
+""PER .END PROC kurseaufbloeckeinformationenaufbereiten;BOOL PROC 
+gueltigefachartkombination(TEXT CONST prueffach,pruefart,INT VAR 
+auswochenstundenzahl):INT VAR postreffer;IF fachartkombinationen=""THEN 
+standardmeldung(meldnrbittewarten,"");holeallefachartkombinationenFI ;
+postreffer:=suchpos(fachartkombinationen,prueffach+pruefart,laengefachartstd)
+;IF postreffer=0THEN FALSE ELSE auswochenstundenzahl:=int(
+fachartkombinationenSUB (postreffer+incrwstd));TRUE FI .
+holeallefachartkombinationen:TEXT VAR aktuellesschuljahr:=schulkenndatum(
+schuljahr);inittupel(dnrfaecherangebot);fanghj:=aktuelleshalbjahr;fangsj:=
+aktuellesschuljahr;IF NOT (gewhalbjahr=aktuelleshalbjahrAND gewschuljahr=
+aktuellesschuljahr)THEN geplanteshjundsjberechnen(fanghj,fangsj)FI ;putwert(
+fnrfangsj,fangsj);putwert(fnrfanghj,fanghj);putwert(fnrfangjgst,gewjgst);
+search(dnrfaecherangebot,FALSE );statleseschleife(dnrfaecherangebot,fangsj,
+fanghj,fnrfangsj,fnrfanghj,PROC fanglesen)END PROC gueltigefachartkombination
+;PROC fanglesen(BOOL VAR b):IF dbstatus=0AND wert(fnrfangsj)=fangsjAND wert(
+fnrfanghj)=fanghjAND wert(fnrfangjgst)=gewjgstTHEN fachartkombinationenCAT 
+text(wert(fnrfangfach),laengefach);fachartkombinationenCAT text(wert(
+fnrfangart),laengeart);fachartkombinationenCAT text(wert(fnrfangwochenstd),1)
+ELSE b:=TRUE FI END PROC fanglesen;PROC kurseaufbloeckerechtehaelftezeigen(
+BOOL CONST rechts):rechtetabellenhaelftezeigen:=rechts;letztecursorfnrbs2:=
+infeld;blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe
+);standardfelderausgeben;infeld(letztecursorfnrbs2);return(1)END PROC 
+kurseaufbloeckerechtehaelftezeigen;PROC kurseaufbloeckeaenderungenspeichern(
+BOOL CONST speichern):IF speichernTHEN kurszuordnungenpruefen;IF pruefstatus>
+0THEN infeld(pruefstatus);return(1)ELSE kurszuordnungenspeichern;
+kurswahl0sichern(kurswahlstatus);IF kurswahlstatus<>0THEN 
+kurswahlfehlerbehandeln;return(1)ELSE kurswahl1sichern(kurswahlstatus);IF 
+kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELSE 
+zurueckzumbearbeitungsanfangFI FI ;FI ;ELSE standardmeldung(
+meldnrnichtspeichern,"");zurueckzumbearbeitungsanfangFI .
+kurszuordnungenpruefen:standardmeldung(meldnrdatenwerdengeprueft,"");
+pruefstatus:=0;ifnr:=fnrersterkurs;WHILE ifnr<fnrletzterblockREP kursbez:=
+standardmaskenfeld(ifnr);IF kursbezdoppeltangegebenTHEN pruefstatus:=ifnr;
+standardmeldung(meldnrangabenichtsinnvoll,"");LEAVE kurszuordnungenpruefenFI 
+;IF kursbez=""CAND (standardmaskenfeld(ifnr+1)<>""OR standardmaskenfeld(ifnr+
+2)<>"")THEN pruefstatus:=ifnr;standardmeldung(meldnrbitteangabeergaenzen,"");
+LEAVE kurszuordnungenpruefenFI ;pruefblockbez:=standardmaskenfeld(ifnr+1);IF 
+ungueltigepruefblockbezTHEN pruefstatus:=ifnr+1;standardmeldung(
+meldnrangabenichtsinnvoll,"");LEAVE kurszuordnungenpruefenFI ;pruefblockbez:=
+standardmaskenfeld(ifnr+2);IF ungueltigepruefblockbezTHEN pruefstatus:=ifnr+2
+;standardmeldung(meldnrangabenichtsinnvoll,"");LEAVE kurszuordnungenpruefen
+FI ;ifnrINCR felderprokursPER .ungueltigepruefblockbez:pruefblockbez<>""AND (
+suchpos(alleplanblockbez,pruefblockbez,planblocklaenge)=0COR length(compress(
+pruefblockbez))<laengeblocknr).kursbezdoppeltangegeben:INT VAR ifnrpruef:=
+ifnr;kursbez:=compress(kursbez);IF kursbez<>""THEN WHILE ifnrpruef>
+fnrersterkursREP ifnrpruefDECR felderprokurs;IF kursbez=compress(
+standardmaskenfeld(ifnrpruef))THEN LEAVE kursbezdoppeltangegebenWITH TRUE FI 
+;PER ;FI ;FALSE .kurszuordnungenspeichern:TEXT VAR kompkursbez;
+standardmeldung(meldnrspeichern,"");ifnr:=fnrersterkurs;ifachkurs:=1;WHILE 
+ifnr<fnrletzterblockREP kompkursbez:=compress(standardmaskenfeld(ifnr));IF 
+kompkursbez<>""THEN IF kurstab(ifachkurs).kursname=""THEN kursneuaufnehmen
+ELSE kursevtlueberschreibenFI ELSE IF kurstab(ifachkurs).kursname<>""THEN 
+kursentfernenFI FI ;ifachkursINCR 1;ifnrINCR felderprokursPER .
+kursevtlueberschreiben:IF kompkursbez=kurstab(ifachkurs).kursnameTHEN kursbez
+:=standardmaskenfeld(fnrausgabefach);kursbezCAT kompkursbez;
+planbloeckezumkurseintragen(kursbez,standardmaskenfeld(ifnr+1),
+standardmaskenfeld(ifnr+2))ELSE kursentfernen;kursneuaufnehmenFI .
+kursneuaufnehmen:kursbez:=standardmaskenfeld(fnrausgabefach);kursbezCAT 
+kompkursbez;kurseintragen(standardmaskenfeld(fnrausgabefach),kompkursbez,
+standardmaskenfeld(fnrwochenstunden),standardmaskenfeld(fnrart));
+planbloeckezumkurseintragen(kursbez,standardmaskenfeld(ifnr+1),
+standardmaskenfeld(ifnr+2)).kursentfernen:kursbez:=standardmaskenfeld(
+fnrausgabefach);kursbezCAT kurstab(ifachkurs).kursname;kursloeschen(fach,
+kurstab(ifachkurs).kursname).zurueckzumbearbeitungsanfang:wstdfelderschutz:=
+TRUE ;IF speichernTHEN blockschemaneufuellen;blockschemaausgebenab(1)FI ;
+eingabefeldersperren(fnrersterkurs,fnrletzterblock);feldfrei(fnrfach);
+feldfrei(fnrart);FOR ifnrFROM fnrwochenstundenUPTO fnrletzterblockREP 
+standardmaskenfeld("",ifnr)PER ;infeld(fnrfach);return(2).
+blockschemaneufuellen:iblock:=0;posplanblock:=1;WHILE posplanblock<length(
+alleplanblockbez)REP iblockINCR 1;blocknr:=subtext(alleplanblockbez,
+posplanblock,posplanblock+2);blockzeile(iblock).frei:=0;blockzeile(iblock).
+kurse:=planblockdaten(blocknr,kennungkurse);posplanblockINCR planblocklaenge
+UNTIL iblock=maxtabzeilenPER .END PROC kurseaufbloeckeaenderungenspeichern;
+INT PROC stundenzahl(INT CONST feldnr):pruefblockbez:=standardmaskenfeld(
+feldnr);IF pruefblockbez=""THEN 0ELSE int(planblockdaten(pruefblockbez,
+kennungwstd))FI END PROC stundenzahl;PROC kurseaufbloeckeschemaeinteilen:
+feldschutz(fnrfach);feldschutz(fnrart);wstdfelderschutz:=FALSE ;
+blockschemaausgebenab(erstergezeigterblock);infeld(fnrerstewstd);
+standardfelderausgeben;infeld(fnrerstewstd);standardnprocEND PROC 
+kurseaufbloeckeschemaeinteilen;PROC kurseaufbloecketeilblockabspalten:ifnr:=
+infeld;blocknr:=standardmaskenfeld(ifnr-1);iblockbestimmen;IF (blocknrSUB 
+posblockkennung)<>" "THEN standardmeldung(meldnrblocknichtteilbar,"")ELIF 
+text(blocknr,2)=naechsteblocknummerTHEN standardmeldung(
+meldnrblocknichtteilbar,"")ELIF standardmaskenfeld(ifnr)<"0"OR 
+standardmaskenfeld(ifnr)>blockzeile(iblock).wstdTHEN standardmeldung(
+meldnrangabenichtsinnvoll,"")ELSE teilblockabspaltendurchfuehrenFI ;return(1)
+.naechsteblocknummer:IF iblock=letzterblockTHEN ""ELSE text(blockzeile(iblock
++1).blockbez,2)FI .teilblockabspaltendurchfuehren:blockwstd1:=int(
+standardmaskenfeld(ifnr));blockwstd2:=int(blockzeile(iblock).wstd)-blockwstd1
+;planblockteilen(text(blocknr,2),text(blockwstd1),text(blockwstd2));
+kurswahl1sichern(kurswahlstatus);IF kurswahlstatus<>0THEN 
+kurswahlfehlerbehandelnELSE erstergezeigterblock:=iblock;blockschemafuellen;
+blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe);
+standardfelderausgeben;infeld(fnrerstewstd)FI END PROC 
+kurseaufbloecketeilblockabspalten;PROC iblockbestimmen:iblock:=
+erstergezeigterblock+incrblock.incrblock:(ifnr-fnrerstewstd)DIV 
+felderprozeileEND PROC iblockbestimmen;PROC kurseaufbloecketeilblockentfernen
+:ifnr:=infeld;blocknr:=standardmaskenfeld(ifnr-1);IF (blocknrSUB 
+posblockkennung)<>" "THEN standardmeldung(meldnrteilblockentfernen,"")ELSE 
+iblockbestimmen;IF teilbloeckevorhandenTHEN IF teilblockkurseidentischTHEN 
+allekursedesblocks:=blockzeile(iblock+1).kurse;planblockloeschen(blockzeile(
+iblock+1).blockbez);planblockloeschen(blockzeile(iblock+2).blockbez);
+allekurseinblocknreintragen;kurswahl1sichern(kurswahlstatus);IF 
+kurswahlstatus<>0THEN kurswahlfehlerbehandelnELSE blockschemafuellen;
+blockschemaausgebenab(erstergezeigterblock);infeld(fnrersteblockangabe);
+standardfelderausgeben;infeld(fnrerstewstd)FI ELSE standardmeldung(
+meldnrteilblockentfernen,"")FI ELSE standardmeldung(meldnrteilblockentfernen,
+"")FI FI ;return(1).teilbloeckevorhanden:text(blocknr,laengeblocknr)=
+naechsteblocknummer.naechsteblocknummer:IF iblock=letzterblockTHEN ""ELSE 
+text(blockzeile(iblock+1).blockbez,laengeblocknr)FI .teilblockkurseidentisch:
+blockzeile(iblock+1).kurse=blockzeile(iblock+2).kurse.
+allekurseinblocknreintragen:poskurs:=1;WHILE poskurs<=length(
+allekursedesblocks)REP kursbez:=subtext(allekursedesblocks,poskurs,poskurs+
+laengekurs-1);kurszumplanblockeintragen(kursbez,blocknr);poskursINCR 
+laengekursPER .END PROC kurseaufbloecketeilblockentfernen;PROC 
+kurseaufbloeckeschemanichtweiteraendern:INT VAR meldnrfehler;
+eingetragenewochenstundenmerken;pruefstatus:=0;
+allewochenstundenangabenpruefen;IF pruefstatus<>0THEN standardmeldung(
+meldnrfehler,"");blockschemaausgebenab(pruefstatus);infeld(
+fnrersteblockangabe);standardfelderausgeben;infeld(fnrerstewstd);return(1)
+ELSE standardmeldung(meldnrspeichern,"");wochenstundenspeichern;
+kurswahl1sichern(kurswahlstatus);feldfrei(fnrfach);feldfrei(fnrart);
+wstdfelderschutz:=TRUE ;eingabefeldersperren(fnrerstewstd,fnrletztewstd,
+felderprozeile);infeld(fnrfach);return(2)FI .allewochenstundenangabenpruefen:
+INT VAR testint;iblock:=1;WHILE iblock<=letzterblockAND pruefstatus=0REP 
+testint:=int(blockzeile(iblock).wstd);IF NOT lastconversionokTHEN pruefstatus
+:=iblock;meldnrfehler:=meldnrkeinezahlELIF ((blockzeile(iblock).blockbez)SUB 
+posblockkennung)=kennungteilblockbTHEN IF int(blockzeile(iblock-2).wstd)<>int
+(blockzeile(iblock-1).wstd)+int(blockzeile(iblock).wstd)THEN pruefstatus:=
+iblock-2;meldnrfehler:=meldnrstundensummmestimmtnichtFI FI ;iblockINCR 1PER .
+wochenstundenspeichern:FOR iblockFROM 1UPTO letzterblockREP 
+planblockeintragen(blockzeile(iblock).blockbez,blockzeile(iblock).wstd)PER .
+END PROC kurseaufbloeckeschemanichtweiteraendern;PROC eingangsbehandlung(INT 
+CONST art):pruefstatus:=0;aktjgst:=standardmaskenfeld(fnraktjgst);gewhalbjahr
+:=standardmaskenfeld(fnrhalbjahr);gewjgst:=standardmaskenfeld(fnrgewjgst);
+neuanjgst:=standardmaskenfeld(fnrneuanjgst);kopiehalbjahr:=standardmaskenfeld
+(fnrherkunfthj);kopiejgst:=standardmaskenfeld(fnrherkunftjgst);
+aktuelleshalbjahr:=schulkenndatum(schulhalbjahr);allgemeinefelderpruefen;IF 
+pruefstatus=0THEN IF art=1OR art=2THEN bearbeitungfelderpruefenELIF art=3
+THEN uebernahmefelderpruefen;planbloeckemitkursenuebernehmen:=
+standardmaskenfeld(fnrmitkursen)<>""FI FI .allgemeinefelderpruefen:
+standardpruefe(3,fnrgewjgst,jgst11,jgst13,"",pruefstatus);IF pruefstatus>0
+THEN LEAVE allgemeinefelderpruefenFI ;standardpruefe(3,fnrhalbjahr,hj1,hj2,""
+,pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;IF 
+aktjgst<>""THEN IF int(aktuelleshalbjahr)=hj2THEN standardpruefe(3,fnraktjgst
+,jgst10,jgst13,"",pruefstatus)ELSE standardpruefe(3,fnraktjgst,jgst11,jgst13,
+"",pruefstatus)FI ;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;
+IF neuanjgst<>""THEN standardpruefe(3,fnrneuanjgst,jgst11,jgst13,"",
+pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF 
+aktjgst<>""THEN IF neuanjgst<>""THEN IF int(neuanjgst)<>int(aktjgst)+1THEN 
+standardmeldung(meldnrfalschejgstfolge,"");pruefstatus:=fnraktjgst;LEAVE 
+allgemeinefelderpruefenFI ;gewschueler:=""ELSE gewschueler:=
+nuraktuelleschuelerFI ELIF neuanjgst=""THEN standardmeldung(
+meldnrbitteangabeergaenzen,"");pruefstatus:=fnraktjgst;LEAVE 
+allgemeinefelderpruefenELSE gewschueler:=nurneuangemeldete;aktjgst:=text(int(
+neuanjgst)-1)FI ;IF aktjgst>gewjgstCOR (aktjgst=gewjgstAND aktuelleshalbjahr>
+gewhalbjahr)THEN standardmeldung(meldnrfalschebezugsjgst,"");pruefstatus:=
+fnrgewjgst;LEAVE allgemeinefelderpruefenFI .bearbeitungfelderpruefen:IF 
+standardmaskenfeld(fnrherkunftjgst)<>""THEN standardmeldung(
+meldnrfeldleerlassen,"");pruefstatus:=fnrherkunftjgst;LEAVE 
+bearbeitungfelderpruefenFI ;IF standardmaskenfeld(fnrherkunfthj)<>""THEN 
+standardmeldung(meldnrfeldleerlassen,"");pruefstatus:=fnrherkunfthj;LEAVE 
+bearbeitungfelderpruefenFI ;IF standardmaskenfeld(fnrmitkursen)<>""THEN 
+standardmeldung(meldnrfeldleerlassen,"");pruefstatus:=fnrmitkursen;LEAVE 
+bearbeitungfelderpruefenFI .uebernahmefelderpruefen:standardpruefe(3,
+fnrherkunftjgst,jgst11,jgst13,"",pruefstatus);IF pruefstatus>0THEN LEAVE 
+uebernahmefelderpruefenFI ;standardpruefe(3,fnrherkunfthj,hj1,hj2,"",
+pruefstatus);IF pruefstatus>0THEN LEAVE uebernahmefelderpruefenFI ;IF gewjgst
+=kopiejgstCAND gewhalbjahr=kopiehalbjahrTHEN pruefstatus:=fnrgewjgst;
+standardmeldung(meldnruebernahmeingleicheshj,"");LEAVE 
+uebernahmefelderpruefenFI ;END PROC eingangsbehandlung;BOOL PROC 
+eingangsmaskenfehler:pruefstatus<>0END PROC eingangsmaskenfehler;INT PROC 
+suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=pos(
+quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE suchpos
+WITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND 
+PROC suchpos;PROC eingabefeldersperren(INT CONST von,bis):
+eingabefeldersperren(von,bis,1)END PROC eingabefeldersperren;PROC 
+eingabefeldersperren(INT CONST von,bis,abstand):INT VAR ifnr:=von;WHILE ifnr
+<=bisREP feldschutz(ifnr);ifnrINCR abstandPER END PROC eingabefeldersperren;
+PROC eingabefelderoeffnen(INT CONST von,bis):eingabefelderoeffnen(von,bis,1)
+END PROC eingabefelderoeffnen;PROC eingabefelderoeffnen(INT CONST von,bis,
+abstand):INT VAR ifnr:=von;WHILE ifnr<=bisREP feldfrei(ifnr);ifnrINCR abstand
+PER END PROC eingabefelderoeffnen;PROC initfelderdeseingangsbildschirms:INT 
+VAR i;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC 
+initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT 
+VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(
+i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC 
+wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO 
+feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC 
+wertedeseingangsbildschirmsholen;TEXT PROC textzweistellig(INT CONST i):IF i<
+10THEN "0"+text(i)ELSE text(i)FI END PROC textzweistellig;END PACKET 
+kurseaufplanbloeckelegen
+
diff --git a/app/schulis/2.2.1/src/2.kurswahl schnittstelle b/app/schulis/2.2.1/src/2.kurswahl schnittstelle
new file mode 100644
index 0000000..2b29d36
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kurswahl schnittstelle
@@ -0,0 +1,664 @@
+PACKET kurswahlschnittstelle240791DEFINES kurswahlinitialisieren,
+kurswahlbasisholen,erweitertekurswahlbasisholen,istkurswahlbasisvorhanden,
+kurswahldatenvorhanden,kurswahl0holen,kurswahl1holen,kurswahl2holen,
+kurswahl0sichern,kurswahl1sichern,kurswahl2sichern,kurswahlsperresetzen,
+kurswahlsperrebeenden,kurseintragen,kursloeschen,planblockeintragen,
+planblockteilen,planblockloeschen,planbloeckezumkurseintragen,
+planbloeckeinitialisieren,kurszumplanblockeintragen,schuelerwahleintragen,
+schuelerwahlaendern,ersterschueler,letzterschueler,wahldatenzumindex,
+wahldatenzumschueler,weiterewahldatenzumschueler,kursdaten,allekurse,
+alleplanblockbezeichner,planblockdaten,anzahlschuelermitwahl,schuelermitwahl,
+anzahlfreierschuelerimplanblock,schuelerinplanblock,schuelerundklausur:LET 
+namezwischendatei="Hj-Daten",meldungneuebasis=377;LET maxkuwa1zeilen=66,
+laengekurseintrag=15,laengeblockwstd=4,laengeblock=3,laengekurs=6,laengefach=
+2,laengekennung=4,laengeart=2,laengewstd=2,laengeklausur=1,server=
+"kurswahl server",kennungtplbl1="a",kennungtplbl2="b",leereplanbloecke=
+"      ",leererblock="   ",leerekennung="    ",leereart="  ",stat1="ls",stat2
+="n11",stat3="nso",kzschueler="�S�",kzneue="�N�",kzohneneue="O",kznurneue="N"
+,kzname="N",kzkurse="K",kzart="A",kzstd="S",kzplanbl="P",kzfake="FK",dbsj=
+"Schuljahr",dbhj="Schulhalbjahr",trenner="�",trenner2="$",kurswahl0=
+"Kurswahl-0 ",kurswahl1="Kurswahl-1 ",kurswahl2="Kurswahl-2 ",praefixsperre=
+"Sperre ";FILE VAR kuwa0,kuwa1,kuwa2,kuwa3,kuwahilf;TEXT VAR schuljahr:=
+"0000",halbjahr:="0",aktschuljahr:="0000",akthalbjahr:="0",jgst:="",hjdtid,
+fa1,ke1,fa2,ke2,ws,kl,ar,eintrag,status,datei,sj,hj;INT VAR bearbschueler,
+erster:=1,letzter:=0,namenpos,aktjg;BOOL VAR hjzukuenftig,hjaktgepl,
+kuwa2eintrag:=TRUE ,plblvorhanden:=FALSE ,faartschoneingetragen:=FALSE ,
+fakeschoneingetragen:=FALSE ,eintragloeschen:=FALSE ;TEXT VAR hjd1,hjd2,hjd3,
+hjd4,hjd5,hjd6,hjd7;TASK VAR takuser;PROC kurswahlinitialisieren(TEXT CONST 
+aktjgst,gewjgst,gewhj,schueler,TEXT VAR bersj):INT VAR j;aktjg:=int(aktjgst);
+IF schueler=kzohneneueTHEN bearbschueler:=1ELIF schueler=kznurneueTHEN 
+bearbschueler:=2ELSE bearbschueler:=3FI ;sj:=schulkenndatum(dbsj);hj:=
+schulkenndatum(dbhj);IF gewjgst=aktjgstTHEN schuljahr:=sjELSE j:=int(gewjgst)
+-int(aktjgst);schuljahr:=konvsjteil(text(sj,2),j)+konvsjteil(subtext(sj,3),j)
+FI ;bersj:=schuljahr;halbjahr:=gewhj;jgst:=gewjgst;IF hj="1"CAND int(gewjgst)
+>int(aktjgst)THEN hjzukuenftig:=TRUE ELIF hj="2"CAND int(gewjgst+gewhj)>(int(
+aktjgst)+1)*10+1THEN hjzukuenftig:=TRUE ELSE hjzukuenftig:=FALSE FI ;
+hjaktgepl:=NOT hjzukuenftigEND PROC kurswahlinitialisieren;BOOL PROC 
+istkurswahlbasisvorhanden:dbstatus(1);IF halbjahrnichtgesetztTHEN FALSE ELIF 
+NOT existstask(server)THEN FALSE ELSE takuser:=task(server);datei:=
+datenraumname(kurswahl1);dbstatus(0);exists(datei,takuser)FI END PROC 
+istkurswahlbasisvorhanden;PROC kurswahlbasisholen(INT VAR fehlerstatus):INT 
+VAR j;IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server)
+THEN fehlerstatus:=2ELSE takuser:=task(server);commanddialogue(FALSE );
+fehlerstatus:=0;datei:=datenraumname(kurswahl0);IF exists(datei,takuser)THEN 
+holkuwa0dateiundkoppleanELSE erstellekuwa0dateiFI ;datei:=datenraumname(
+kurswahl1);IF exists(datei,takuser)THEN plblvorhanden:=TRUE ;
+holkuwa1dateiundkoppleanELSE plblvorhanden:=FALSE ;erstellekuwa1dateiFI ;
+datei:=datenraumname(kurswahl2);IF exists(datei,takuser)THEN 
+holkuwa2dateiundkoppleanELSE erstellekuwa2dateiFI ;commanddialogue(TRUE )FI .
+holkuwa0dateiundkopplean:fetch(datei,takuser);kuwa0:=sequentialfile(modify,
+old(datei)).erstellekuwa0datei:IF hjzukuenftigTHEN kuwa0:=sequentialfile(
+modify,datei);insertrecord(kuwa0)ELSE datei:=datenraumname(kurswahl0);forget(
+datei,quiet);kursdatenholen;IF lines(kuwa0)=0THEN insertrecord(kuwa0)FI FI ;
+save(datei,takuser).holkuwa1dateiundkopplean:fetch(datei,takuser);kuwa1:=
+sequentialfile(modify,old(datei)).erstellekuwa1datei:kuwa1:=sequentialfile(
+modify,datei);FOR jFROM 1UPTO maxkuwa1zeilenREP insertrecord(kuwa1)PER ;save(
+datei,takuser).holkuwa2dateiundkopplean:fetch(datei,takuser);kuwa2:=
+sequentialfile(modify,old(datei));ermittleersterletzter.erstellekuwa2datei:
+kuwa2eintrag:=TRUE ;kurswahleinerjgstaufbereiten(jgst,halbjahr,schuljahr,
+kuwa2);save(datei,takuser).END PROC kurswahlbasisholen;PROC 
+ermittleersterletzter:IF bearbschueler<>2THEN erster:=1ELSE erster:=
+zeilennrzumschuelerbestand(FALSE )FI ;IF bearbschueler<>1THEN letzter:=lines(
+kuwa2)ELSE letzter:=zeilennrzumschuelerbestand(TRUE )FI END PROC 
+ermittleersterletzter;PROC erweitertekurswahlbasisholen(TEXT CONST gewjgst,
+gewhj,INT VAR fehlerstatus):TEXT VAR erwschuljahr;INT VAR j;IF 
+halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server)THEN 
+fehlerstatus:=2ELSE takuser:=task(server);commanddialogue(FALSE );IF int(
+gewjgst)=aktjgTHEN erwschuljahr:=sjELSE j:=int(gewjgst)-aktjg;erwschuljahr:=
+konvsjteil(text(sj,2),j)+konvsjteil(subtext(sj,3),j);FI ;fehlerstatus:=0;
+datei:=kurswahl2+gewjgst+" "+gewhj+"."+erwschuljahr;IF exists(datei,takuser)
+THEN holkuwa3dateiundkoppleanELSE erstellekuwa3dateiFI ;commanddialogue(TRUE 
+)FI .holkuwa3dateiundkopplean:fetch(datei,takuser);kuwa3:=sequentialfile(
+modify,old(datei)).erstellekuwa3datei:plblvorhanden:=FALSE ;kuwa2eintrag:=
+FALSE ;kurswahleinerjgstaufbereiten(gewjgst,gewhj,erwschuljahr,kuwa3).END 
+PROC erweitertekurswahlbasisholen;PROC kurswahl0holen(INT VAR fehlerstatus):
+IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(server)THEN 
+fehlerstatus:=2ELSE takuser:=task(server);datei:=datenraumname(kurswahl0);IF 
+exists(datei,takuser)THEN commanddialogue(FALSE );fetch(datei,takuser);
+commanddialogue(TRUE );kuwa0:=sequentialfile(modify,old(datei));fehlerstatus
+:=0ELSE fehlerstatus:=3FI ;FI .END PROC kurswahl0holen;PROC kurswahl1holen(
+INT VAR fehlerstatus):IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT 
+existstask(server)THEN fehlerstatus:=2ELSE takuser:=task(server);datei:=
+datenraumname(kurswahl1);IF exists(datei,takuser)THEN commanddialogue(FALSE )
+;fetch(datei,takuser);commanddialogue(TRUE );kuwa1:=sequentialfile(modify,old
+(datei));fehlerstatus:=0ELSE fehlerstatus:=3FI ;FI .END PROC kurswahl1holen;
+PROC kurswahl2holen(INT VAR fehlerstatus):IF halbjahrnichtgesetztTHEN 
+fehlerstatus:=1ELIF NOT existstask(server)THEN fehlerstatus:=2ELSE takuser:=
+task(server);datei:=datenraumname(kurswahl2);IF exists(datei,takuser)THEN 
+commanddialogue(FALSE );fetch(datei,takuser);commanddialogue(TRUE );kuwa2:=
+sequentialfile(modify,old(datei));ermittleersterletzter;fehlerstatus:=0ELSE 
+fehlerstatus:=3FI ;FI END PROC kurswahl2holen;PROC kurswahl0sichern(INT VAR 
+fehlerstatus):kurswahl02sichern(kurswahl0,fehlerstatus)END PROC 
+kurswahl0sichern;PROC kurswahl1sichern(INT VAR fehlerstatus):
+kurswahldatenraumsichern(kurswahl1,fehlerstatus)END PROC kurswahl1sichern;
+PROC kurswahl2sichern(INT VAR fehlerstatus):kurswahl02sichern(kurswahl2,
+fehlerstatus)END PROC kurswahl2sichern;PROC kurswahl02sichern(TEXT CONST 
+welchen,INT VAR fehlerstatus):INT VAR aktfeld:=infeld;datei:=datenraumname(
+welchen);IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT existstask(
+server)THEN fehlerstatus:=2ELIF NOT exists(datei)THEN fehlerstatus:=4ELSE 
+takuser:=task(server);IF exists(datei,takuser)THEN commanddialogue(FALSE );
+save(datei,takuser);commanddialogue(TRUE );fehlerstatus:=0ELSE 
+standardmeldung(meldungneuebasis,"");forget(datei,quiet);IF welchen=kurswahl2
+THEN bereitek2datenraumaufELSE bereitek0datenraumaufFI ;commanddialogue(
+FALSE );save(datei,takuser);commanddialogue(TRUE );fehlerstatus:=0;infeld(1);
+standardfelderausgeben;infeld(aktfeld)FI FI .bereitek0datenraumauf:IF 
+hjzukuenftigTHEN kuwa0:=sequentialfile(modify,datei);insertrecord(kuwa0)ELSE 
+kursdatenholen;IF lines(kuwa0)=0THEN insertrecord(kuwa0)FI FI .
+bereitek2datenraumauf:kuwa2eintrag:=TRUE ;kurswahleinerjgstaufbereiten(jgst,
+halbjahr,schuljahr,kuwa2).END PROC kurswahl02sichern;PROC 
+kurswahldatenraumsichern(TEXT CONST welchen,INT VAR fehlerstatus):datei:=
+datenraumname(welchen);IF halbjahrnichtgesetztTHEN fehlerstatus:=1ELIF NOT 
+existstask(server)THEN fehlerstatus:=2ELIF NOT exists(datei)THEN fehlerstatus
+:=4ELSE takuser:=task(server);commanddialogue(FALSE );save(datei,takuser);
+commanddialogue(TRUE );fehlerstatus:=0FI END PROC kurswahldatenraumsichern;
+BOOL PROC kurswahldatenvorhanden:INT VAR i;dbstatus(1);IF 
+halbjahrnichtgesetztTHEN FALSE ELSE datei:=datenraumname(kurswahl2);IF exists
+(datei)THEN ueberpruefwahldatenvorhandenELSE FALSE FI FI .
+ueberpruefwahldatenvorhanden:dbstatus(0);toline(kuwa2,erster);col(kuwa2,1);
+FOR iFROM ersterUPTO letzterREP readrecord(kuwa2,eintrag);IF (eintragSUB 1)<>
+trennerTHEN LEAVE ueberpruefwahldatenvorhandenWITH TRUE FI ;down(kuwa2);PER ;
+FALSE .END PROC kurswahldatenvorhanden;PROC kurswahlsperresetzen(TEXT CONST 
+was,BOOL VAR ok):IF halbjahrnichtgesetztTHEN ok:=FALSE ELIF NOT existstask(
+server)THEN ok:=FALSE ELSE takuser:=task(server);datei:=
+gesperrterdatenraumname(was);IF exists(datei,takuser)THEN ok:=FALSE ELSE 
+commanddialogue(FALSE );forget(datei,quiet);copy(datenraumname(was),datei);
+save(datei,takuser);forget(datei,quiet);commanddialogue(TRUE );ok:=TRUE FI ;
+FI END PROC kurswahlsperresetzen;PROC kurswahlsperrebeenden(TEXT CONST was):
+IF NOT halbjahrnichtgesetztAND existstask(server)THEN takuser:=task(server);
+datei:=gesperrterdatenraumname(was);commanddialogue(FALSE );erase(datei,
+takuser);commanddialogue(TRUE );FI END PROC kurswahlsperrebeenden;PROC 
+kurseintragen(TEXT CONST fach,kennung,wstd,art):dbstatus(1);IF 
+halbjahrnichtgesetztTHEN LEAVE kurseintragenELIF fach=""COR kennung=""COR 
+wstd=""COR art=""THEN LEAVE kurseintragenFI ;fa1:=text(fach,laengefach);ke1:=
+text(kennung,laengekennung);ws:=text(wstd,laengewstd);ar:=text(art,laengeart)
+;IF kurseingetragen(fa1+ke1)THEN LEAVE kurseintragenFI ;toline(kuwa0,lines(
+kuwa0));insertrecord(kuwa0);writerecord(kuwa0,fa1+ke1+ws+ar);IF hjaktgepl
+THEN tragindbeinELSE dbstatus(0)FI .tragindbein:inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);
+putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fa1+compress(ke1));
+putintwert(fnrlvwochenstd,int(wstd));putwert(fnrlvart,compress(art));insert(
+dnrlehrveranstaltungen).END PROC kurseintragen;PROC kursloeschen(TEXT CONST 
+fach,kennung):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE kursloeschenFI ;
+fa1:=text(fach,laengefach);ke1:=text(kennung,laengekennung);IF 
+kurseingetragen(fa1+ke1)THEN IF hjaktgeplTHEN aenderindbFI ;deleterecord(
+kuwa0);aenderkursinkuwa1(fa1+ke1,"")ELSE dbstatus(1)FI .aenderindb:inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);
+putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fa1+compress(ke1));search(
+dnrlehrveranstaltungen,TRUE );IF dbstatus=0THEN delete(dnrlehrveranstaltungen
+)ELSE dbstatus(1);LEAVE kursloeschenFI .END PROC kursloeschen;PROC 
+planblockeintragen(TEXT CONST anwblockbez,stunden):TEXT VAR blockbez:=
+formbezeichner(anwblockbez),blocknr:=text(blockbez,2),teilkennung:=blockbez
+SUB 3;INT VAR j:=int(blocknr)*3-2;dbstatus(1);IF halbjahrnichtgesetztTHEN 
+LEAVE planblockeintragenELIF j>0CAND j<=maxkuwa1zeilenTHEN IF teilkennung=
+kennungtplbl1THEN jINCR 1ELIF teilkennung=kennungtplbl2THEN jINCR 2ELIF 
+teilkennung<>""CAND teilkennung<>" "THEN LEAVE planblockeintragenFI ;toline(
+kuwa1,j);readrecord(kuwa1,eintrag);IF eintrag=""THEN writerecord(kuwa1,text(
+blockbez,3)+text(stunden,1))ELSE writerecord(kuwa1,text(eintrag,3)+text(
+stunden,1)+subtext(eintrag,5))FI ;dbstatus(0)FI END PROC planblockeintragen;
+PROC planblockteilen(TEXT CONST blocknr,wstd1,wstd2):INT VAR j:=int(blocknr)*
+3-2;dbstatus(1);IF halbjahrnichtgesetztCOR (compress(blocknrSUB 3))<>""THEN 
+LEAVE planblockteilenFI ;IF j>0CAND j<=maxkuwa1zeilenTHEN toline(kuwa1,j+1);
+readrecord(kuwa1,eintrag);IF eintrag=""THEN up(kuwa1);readrecord(kuwa1,
+eintrag);IF eintrag<>""THEN teileplanblockFI FI ;FI .teileplanblock:dbstatus(
+0);writerecord(kuwa1,text(eintrag,4));down(kuwa1);writerecord(kuwa1,text(
+eintrag,2)+kennungtplbl1+wstd1+subtext(eintrag,5));down(kuwa1);writerecord(
+kuwa1,text(eintrag,2)+kennungtplbl2+wstd2+subtext(eintrag,5)).END PROC 
+planblockteilen;PROC planblockloeschen(TEXT CONST anwblockbez):TEXT VAR 
+blockbez:=formbezeichner(anwblockbez),blocknr:=text(blockbez,2),teilkennung:=
+blockbezSUB 3;INT VAR j:=int(blocknr)*3-2;BOOL VAR pruefteilbloecke:=FALSE ;
+dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE planblockloeschenFI ;IF 
+teilkennung=kennungtplbl1THEN jINCR 1ELIF teilkennung=kennungtplbl2THEN j
+INCR 2ELSE pruefteilbloecke:=TRUE FI ;IF j>0CAND j<=maxkuwa1zeilenTHEN toline
+(kuwa1,j);IF pruefteilbloeckeTHEN down(kuwa1,2);readrecord(kuwa1,eintrag);IF 
+eintrag<>""THEN LEAVE planblockloeschenELSE up(kuwa1);readrecord(kuwa1,
+eintrag);IF eintrag<>""THEN LEAVE planblockloeschenELSE up(kuwa1)FI ;FI ;FI ;
+writerecord(kuwa1,"");dbstatus(0)FI .END PROC planblockloeschen;PROC 
+planbloeckeinitialisieren:TEXT VAR datei:=datenraumname(kurswahl1);INT VAR j;
+IF halbjahrnichtgesetztCOR NOT existstask(server)THEN dbstatus(1)ELSE takuser
+:=task(server);erstellekuwa1dateiFI .erstellekuwa1datei:forget(datei,quiet);
+kuwa1:=sequentialfile(modify,datei);FOR jFROM 1UPTO maxkuwa1zeilenREP 
+insertrecord(kuwa1)PER ;dbstatus(0);commanddialogue(FALSE );save(datei,
+takuser);commanddialogue(TRUE ).END PROC planbloeckeinitialisieren;PROC 
+planbloeckezumkurseintragen(TEXT CONST anwkurs,anwblockbez1,anwblockbez2):
+TEXT VAR kurs:=text(anwkurs,laengekurs),blockbez1:=formbezeichner(
+anwblockbez1),blockbez2:=formbezeichner(anwblockbez2);dbstatus(1);IF 
+halbjahrnichtgesetztTHEN LEAVE planbloeckezumkurseintragenFI ;IF blockbez1<>
+""COR blockbez2<>""THEN IF NOT kurseingetragen(kurs)THEN LEAVE 
+planbloeckezumkurseintragenFI FI ;IF compress(blockbez1)<>""THEN IF NOT 
+blockeingetragen(blockbez1)THEN LEAVE planbloeckezumkurseintragenFI ;FI ;IF 
+compress(blockbez2)<>""THEN IF NOT blockeingetragen(blockbez2)THEN LEAVE 
+planbloeckezumkurseintragenFI ;FI ;loescheplanbloeckezukurs(kurs);IF 
+blockeingetragen(blockbez1)THEN tragkurseinFI ;IF blockeingetragen(blockbez2)
+THEN tragkurseinFI ;dbstatus(0).tragkursein:readrecord(kuwa1,eintrag);eintrag
+CAT kurs;writerecord(kuwa1,eintrag).END PROC planbloeckezumkurseintragen;
+PROC loescheplanbloeckezukurs(TEXT CONST kurs):TEXT VAR bloecke:=planbloecke(
+kurs);IF bloecke<>leereplanbloeckeTHEN aenderkursinkuwa1(kurs,"")FI .END 
+PROC loescheplanbloeckezukurs;INT PROC planblockzeilennr(TEXT CONST 
+anwblockbez):TEXT VAR blockbez:=formbezeichner(anwblockbez);IF 
+blockeingetragen(blockbez)THEN lineno(kuwa1)ELSE 0FI END PROC 
+planblockzeilennr;PROC schuelerwahleintragen(TEXT CONST famname,rufname,
+gebdatum,wahl):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+
+gebdatum,wahldaten:=wahl;dbstatus(1);IF halbjahrnichtgesetztCOR length(
+wahldaten)MOD laengekurseintrag<>0THEN LEAVE schuelerwahleintragenFI ;IF 
+schuelereingetragen(schueler,kuwa2)THEN readrecord(kuwa2,eintrag);hjd1:=
+wahldaten;hjdateneintragen(famname,rufname,gebdatum,1);IF dbstatus=0THEN 
+schreibeintragFI ;FI .schreibeintrag:writerecord(kuwa2,wahldaten+subtext(
+eintrag,pos(eintrag,trenner))).END PROC schuelerwahleintragen;PROC 
+schuelerwahleintragen(TEXT CONST famname,rufname,gebdatum,fach,kennung,art,
+klausur):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+gebdatum,
+kurse;INT VAR aktpos;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE 
+schuelerwahleintragenFI ;fa1:=text(fach,laengefach);ke1:=text(kennung,
+laengekennung);ar:=text(art,laengeart);kl:=text(klausur,laengeklausur);IF 
+schuelereingetragen(schueler,kuwa2)THEN readrecord(kuwa2,eintrag);hjd1:=fa1;
+hjd2:=ke1;hjd3:=ar;hjd4:=kl;hjdateneintragen(famname,rufname,gebdatum,2);IF 
+dbstatus=0THEN schreibeintragFI FI .schreibeintrag:pruefanzkurse;IF ke1=
+leerekennungTHEN tragfachwahleinELSE tragkurswahleinFI .pruefanzkurse:aktpos
+:=pos(eintrag,trenner);kurse:=text(eintrag,aktpos-1);IF length(kurse)=195
+THEN LEAVE schuelerwahleintragenFI .tragfachwahlein:IF nichteingetragen(
+eintrag,ar+fa1,2,aktpos)THEN IF ke1<>leerekennungTHEN writerecord(kuwa2,kl+ar
++fa1+ke1+planbloecke(fa1+ke1)+eintrag)ELSE writerecord(kuwa2,kl+ar+fa1+ke1+
+leereplanbloecke+eintrag)FI ;FI .tragkurswahlein:IF nichteingetragen(eintrag,
+fa1+ke1,4,aktpos)THEN writerecord(kuwa2,kl+ar+fa1+ke1+planbloecke(fa1+ke1)+
+eintrag)FI .END PROC schuelerwahleintragen;PROC schuelerwahlaendern(TEXT 
+CONST famname,rufname,gebdatum,fachalt,kennungalt,artalt,fachneu,kennungneu,
+artneu,klausur):TEXT VAR schueler:=trenner+famname+trenner+rufname+trenner+
+gebdatum,neuereintrag,aralt,compke,compart;INT VAR aktpos,kurspos;dbstatus(1)
+;IF halbjahrnichtgesetztTHEN LEAVE schuelerwahlaendernFI ;
+faartschoneingetragen:=FALSE ;fakeschoneingetragen:=FALSE ;fa1:=text(fachalt,
+laengefach);ke1:=text(kennungalt,laengekennung);aralt:=text(artalt,laengeart)
+;fa2:=text(fachneu,laengefach);ke2:=text(kennungneu,laengekennung);ar:=text(
+artneu,laengeart);kl:=text(klausur,laengeklausur);IF schuelereingetragen(
+schueler,kuwa2)THEN pruefundtragein;hjd1:=fa1;hjd2:=ke1;hjd3:=fa2;hjd4:=ke2;
+hjd5:=ar;hjd6:=kl;hjd7:=aralt;hjdateneintragen(famname,rufname,gebdatum,3);
+IF dbstatus=0THEN aendereintragFI FI .pruefundtragein:readrecord(kuwa2,
+eintrag);IF fachalt=""THEN LEAVE schuelerwahlaendernFI ;IF kennungalt<>""
+THEN IF nichteingetragen(eintrag,fa1+ke1,4,aktpos)THEN LEAVE 
+schuelerwahlaendernFI ELIF artalt=""THEN LEAVE schuelerwahlaendernELIF 
+nichteingetragen(eintrag,aralt+fa1,2,aktpos)THEN LEAVE schuelerwahlaendernFI 
+;IF fachneu=""THEN eintragloeschen:=TRUE ;eintrag:=text(eintrag,aktpos-1)+
+subtext(eintrag,aktpos+laengekurseintrag)ELSE eintragloeschen:=FALSE ;compke
+:=compress(kennungneu);compart:=compress(artneu);IF compke=""CAND compart=""
+THEN LEAVE schuelerwahlaendernELIF compke<>""THEN IF NOT nichteingetragen(
+eintrag,fa2+ke2,4,kurspos)THEN fakeschoneingetragen:=TRUE FI ELIF compart<>""
+THEN IF NOT nichteingetragen(eintrag,ar+fa2,2,kurspos)THEN 
+faartschoneingetragen:=TRUE FI FI ;loeschundtrageinFI .aendereintrag:
+writerecord(kuwa2,eintrag).loeschundtragein:neuereintrag:=kl;neuereintragCAT 
+ar;neuereintragCAT fa2;neuereintragCAT ke2;IF (fa1+ke1)<>(fa2+ke2)THEN 
+neuereintragCAT planbloecke(fa2+ke2)ELSE neuereintragCAT subtext(eintrag,
+aktpos+9,aktpos+14)FI ;IF faartschoneingetragenCOR fakeschoneingetragenTHEN 
+ueberschreibneuenkursmitneuenwertenELSE substituieraltenkursmitneuemkursFI .
+substituieraltenkursmitneuemkurs:eintrag:=text(eintrag,aktpos-1)+neuereintrag
++subtext(eintrag,aktpos+laengekurseintrag).
+ueberschreibneuenkursmitneuenwerten:eintrag:=text(eintrag,kurspos-1)+
+neuereintrag+subtext(eintrag,kurspos+laengekurseintrag);IF aktpos<>kurspos
+THEN eintrag:=text(eintrag,aktpos-1)+subtext(eintrag,aktpos+laengekurseintrag
+)FI .END PROC schuelerwahlaendern;PROC hjdateneintragen(TEXT CONST famname,
+rufname,gebdatum,INT CONST aktion):INT VAR iii,iiii;TEXT VAR wahlteil,
+tutoreintrag;TEXT VAR t1,t2,t3,t4;SELECT aktionOF CASE 1:
+hjdatenersetzenoderanlegenCASE 2:hjdatenergaenzenoderanlegenCASE 3:
+hjdatensubstituierenEND SELECT .hjdatenersetzenoderanlegen:suchhjdaten(
+famname,rufname,gebdatum);IF dbstatus<>0THEN IF schuelerindbTHEN 
+erstellhjdatensatz;IF schuljahr=aktsjCAND halbjahr=akthjCAND dbstatus=0THEN 
+schreibtidinsudatenFI FI ELSE aenderehjdatensatzFI .aenderehjdatensatz:
+tragwahldatenein;putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t3);putwert(
+fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4);update(
+dnrhalbjahresdaten).erstellhjdatensatz:inittupel(dnrhalbjahresdaten);putwert(
+fnrhjdfamnames,famname);putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats
+,gebdatum);putwert(fnrhjdjgst,jgst);putwert(fnrhjdsj,schuljahr);putwert(
+fnrhjdhj,halbjahr);tragwahldatenein;IF schuljahr=aktsjCAND halbjahr=akthj
+THEN putwert(fnrhjdkennung,tutoreintrag)FI ;putwert(fnrhjdfach,t1);putwert(
+fnrhjdkursart,t3);putwert(fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4
+);insert(dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenELSE 
+hjdtid:=gettidFI .schuelerindb:parsenooffields(7);inittupel(dnrschueler);
+putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert(
+fnrsugebdatums,gebdatum);search(dnrschueler,TRUE );IF schuljahr=aktsjCAND 
+halbjahr=akthjCAND dbstatus=0THEN tutoreintrag:=wert(fnrsusgrpzugtut)FI ;
+reinitparsing;dbstatus=0.tragwahldatenein:t1:="";t2:="";t3:="";t4:="";FOR iii
+FROM 1UPTO length(hjd1)DIV 15REP wahlteil:=subtext(hjd1,(iii-1)*15+1,iii*15);
+t1CAT subtext(wahlteil,4,5);t2CAT subtext(wahlteil,6,9);t3CAT subtext(
+wahlteil,2,3);t4CAT (wahlteilSUB 1)PER .schreibtidinsudaten:inittupel(
+dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);
+putwert(fnrsugebdatums,gebdatum);search(dnrschueler,TRUE );IF dbstatus=0THEN 
+putwert(fnrsutidakthjd,hjdtid);selupdate(dnrschueler)FI .
+hjdatenergaenzenoderanlegen:suchhjdaten(famname,rufname,gebdatum);IF dbstatus
+<>0THEN IF schuelerindbTHEN generierhjdatensatz;IF schuljahr=aktsjCAND 
+halbjahr=akthjCAND dbstatus=0THEN schreibtidinsudatenFI FI ELSE 
+ergaenzehjdatensatzFI .ergaenzehjdatensatz:t1:=wert(fnrhjdfach);IF length(t1)
+=26THEN dbstatus(1);LEAVE hjdateneintragenELSE t3:=wert(fnrhjdkursart);t2:=
+wert(fnrhjdlerngrpkenn);t4:=wert(fnrhjdklausurteiln)FI ;t1CAT hjd1;t2CAT hjd2
+;t3CAT hjd3;t4CAT hjd4;putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t3);
+putwert(fnrhjdlerngrpkenn,t2);putwert(fnrhjdklausurteiln,t4);update(
+dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenFI .
+generierhjdatensatz:inittupel(dnrhalbjahresdaten);putwert(fnrhjdfamnames,
+famname);putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdatum);
+putwert(fnrhjdjgst,jgst);IF schuljahr=aktsjCAND halbjahr=akthjTHEN putwert(
+fnrhjdkennung,tutoreintrag)FI ;putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj,
+halbjahr);putwert(fnrhjdfach,hjd1);putwert(fnrhjdkursart,hjd3);putwert(
+fnrhjdlerngrpkenn,hjd2);putwert(fnrhjdklausurteiln,hjd4);insert(
+dnrhalbjahresdaten);IF dbstatus<>0THEN LEAVE hjdateneintragenFI ;hjdtid:=
+gettid.hjdatensubstituieren:suchhjdaten(famname,rufname,gebdatum);IF dbstatus
+<>0THEN dbstatus(1);LEAVE hjdateneintragenELSE substituierehjdatensatzFI .
+substituierehjdatensatz:t2:=wert(fnrhjdkursart);t3:=wert(fnrhjdlerngrpkenn);
+t4:=wert(fnrhjdklausurteiln);setzeuebergebenewerte;schreibgeaendertensatz.
+schreibgeaendertensatz:putwert(fnrhjdfach,t1);putwert(fnrhjdkursart,t2);
+putwert(fnrhjdlerngrpkenn,t3);putwert(fnrhjdklausurteiln,t4);update(
+dnrhalbjahresdaten).setzeuebergebenewerte:t1:=wert(fnrhjdfach);
+suchrichtigefachposition;IF eintragloeschenTHEN alteneintragloeschenELIF 
+faartschoneingetragenCOR fakeschoneingetragenTHEN eintragaktualisieren;IF iii
+<>iiiiTHEN alteneintragloeschenFI ELSE alteneintragueberschreibenFI .
+eintragaktualisieren:suchschonvorhandeneneintrag;IF faartschoneingetragen
+THEN t3:=text(t3,iiii*2-2)+hjd4+subtext(t3,iiii*2+3)ELSE t2:=text(t2,iiii-1)+
+hjd5+subtext(t2,iiii+2)FI ;t4:=text(t4,(iiii+1)DIV 2-1)+hjd6+subtext(t4,(iiii
++1)DIV 2+1).alteneintragloeschen:t1:=text(t1,iii-1)+subtext(t1,iii+2);t2:=
+text(t2,iii-1)+subtext(t2,iii+2);t3:=text(t3,iii*2-2)+subtext(t3,iii*2+3);t4
+:=text(t4,(iii+1)DIV 2-1)+subtext(t4,(iii+1)DIV 2+1).
+alteneintragueberschreiben:IF hjd1<>hjd3THEN t1:=text(t1,iii-1)+hjd3+subtext(
+t1,iii+2)FI ;IF hjd2<>hjd4THEN t3:=text(t3,iii*2-2)+hjd4+subtext(t3,iii*2+3)
+FI ;IF hjd5<>hjd7THEN t2:=text(t2,iii-1)+hjd5+subtext(t2,iii+2)FI ;t4:=text(
+t4,(iii+1)DIV 2-1)+hjd6+subtext(t4,(iii+1)DIV 2+1).suchrichtigefachposition:
+iii:=1;WHILE iii<>0REP iii:=pos(t1,hjd1,iii);IF iii=0THEN dbstatus(1);LEAVE 
+hjdateneintragenELSE pruefzugehoerigewerteFI ;iiiINCR 1PER ;dbstatus(1);
+LEAVE hjdateneintragen.pruefzugehoerigewerte:IF (iiiMOD 2)=1THEN IF compress(
+hjd2)<>""THEN pruefkennungELIF compress(hjd7)<>""THEN pruefartFI FI .
+pruefkennung:IF subtext(t3,iii*2-1,iii*2+2)=hjd2THEN LEAVE 
+suchrichtigefachpositionFI .pruefart:IF subtext(t2,iii,iii+1)=hjd7THEN LEAVE 
+suchrichtigefachpositionFI .suchschonvorhandeneneintrag:iiii:=1;WHILE iiii<>0
+REP iiii:=pos(t1,hjd3,iiii);IF iiii=0THEN dbstatus(1);LEAVE hjdateneintragen
+ELSE pruefweiterewerteFI ;iiiiINCR 1PER ;dbstatus(1);LEAVE hjdateneintragen.
+pruefweiterewerte:IF (iiiiMOD 2)=1THEN IF faartschoneingetragenTHEN IF 
+subtext(t2,iiii,iiii+1)=hjd5THEN LEAVE suchschonvorhandeneneintragFI ELIF 
+fakeschoneingetragenTHEN IF subtext(t3,iiii*2-1,iiii*2+2)=hjd4THEN LEAVE 
+suchschonvorhandeneneintragFI FI FI .END PROC hjdateneintragen;TEXT PROC 
+aktsj:IF aktschuljahr="0000"THEN aktschuljahr:=schulkenndatum("Schuljahr");
+FI ;aktschuljahrEND PROC aktsj;TEXT PROC akthj:IF akthalbjahr="0"THEN 
+akthalbjahr:=schulkenndatum("Schulhalbjahr");FI ;akthalbjahrEND PROC akthj;
+PROC suchhjdaten(TEXT CONST famname,rufname,gebdatum):inittupel(
+dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert(fnrhjdrufnames,
+rufname);putwert(fnrhjdgebdats,gebdatum);putwert(fnrhjdsj,schuljahr);putwert(
+fnrhjdhj,halbjahr);search(dnrhalbjahresdaten,TRUE )END PROC suchhjdaten;INT 
+PROC ersterschueler:ersterEND PROC ersterschueler;INT PROC letzterschueler:
+letzterEND PROC letzterschueler;TEXT PROC wahldatenzumindex(INT CONST 
+zeilennr,TEXT CONST kennung):INT VAR trennerpos;dbstatus(1);IF 
+halbjahrnichtgesetztTHEN LEAVE wahldatenzumindexWITH ""ELIF zeilennr<erster
+COR zeilennr>letzterTHEN LEAVE wahldatenzumindexWITH ""FI ;toline(kuwa2,
+zeilennr);col(kuwa2,1);readrecord(kuwa2,eintrag);IF kennung=kznameCOR kennung
+=kzkurseCOR kennung=kzartTHEN dbstatus(0);trennerpos:=pos(eintrag,trenner);
+IF kennung=kznameTHEN subtext(eintrag,trennerpos+1,length(eintrag)-3)ELIF 
+kennung=kzkurseTHEN text(eintrag,trennerpos-1)ELSE eintragFI ELSE ""FI END 
+PROC wahldatenzumindex;TEXT PROC wahldatenzumschueler(TEXT CONST famname,
+rufname,gebdatum,kennung):TEXT VAR schueler:=trenner+famname+trenner+rufname+
+trenner+gebdatum;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE 
+wahldatenzumschuelerWITH ""FI ;IF schuelereingetragen(schueler,kuwa2)THEN 
+readrecord(kuwa2,eintrag);IF kennung="F"COR kennung="A"COR kennung="FA"COR 
+kennung="FAk"COR kennung="FK"COR kennung="FKk"COR kennung="FKAk"COR kennung=
+"FP"THEN dbstatus(0);alledaten(eintrag,kennung)ELSE ""FI ELSE ""FI END PROC 
+wahldatenzumschueler;TEXT PROC weiterewahldatenzumschueler(TEXT CONST famname
+,rufname,gebdatum,kennung):TEXT VAR schueler:=trenner+famname+trenner+rufname
++trenner+gebdatum;dbstatus(1);IF halbjahrnichtgesetztTHEN LEAVE 
+weiterewahldatenzumschuelerWITH ""FI ;IF schuelereingetragen(schueler,kuwa3)
+THEN readrecord(kuwa3,eintrag);IF kennung="F"COR kennung="A"COR kennung="FA"
+COR kennung="FAk"COR kennung="FK"COR kennung="FKk"COR kennung="FKAk"THEN 
+dbstatus(0);alledaten(eintrag,kennung)ELSE ""FI ELSE ""FI END PROC 
+weiterewahldatenzumschueler;TEXT PROC kursdaten(TEXT CONST anwkurs,kennung):
+TEXT VAR ausgabe:="",kurs:=text(anwkurs,laengekurs);dbstatus(1);IF 
+halbjahrnichtgesetztTHEN LEAVE kursdatenWITH ""FI ;IF kurseingetragen(kurs)
+THEN readrecord(kuwa0,eintrag);IF kennung=kzartTHEN ausgabe:=subtext(eintrag,
+9);dbstatus(0)ELIF kennung=kzstdTHEN ausgabe:=subtext(eintrag,7,8);dbstatus(0
+)ELIF kennung=kzplanblTHEN ausgabe:=planbloecke(kurs);dbstatus(0)FI FI ;
+ausgabeEND PROC kursdaten;TEXT PROC allekurse:TEXT VAR ausgabe:="";IF 
+halbjahrnichtgesetztTHEN dbstatus(1);LEAVE allekurseWITH ""ELSE dbstatus(0)
+FI ;col(kuwa0,1);toline(kuwa0,1);WHILE NOT eof(kuwa0)REP readrecord(kuwa0,
+eintrag);IF eintrag<>""THEN ausgabeCAT eintragFI ;down(kuwa0)PER ;ausgabeEND 
+PROC allekurse;TEXT PROC alleplanblockbezeichner:TEXT VAR ausgabe:="";IF 
+halbjahrnichtgesetztTHEN dbstatus(1);LEAVE alleplanblockbezeichnerWITH ""
+ELSE dbstatus(0)FI ;col(kuwa1,1);toline(kuwa1,1);WHILE NOT eof(kuwa1)REP 
+readrecord(kuwa1,eintrag);IF eintrag<>""THEN ausgabeCAT text(eintrag,
+laengeblock)FI ;down(kuwa1)PER ;ausgabeEND PROC alleplanblockbezeichner;TEXT 
+PROC planblockdaten(TEXT CONST anwblockbez,kennung):TEXT VAR blockbez:=
+formbezeichner(anwblockbez);IF halbjahrnichtgesetztCOR NOT blockeingetragen(
+blockbez)THEN dbstatus(1);LEAVE planblockdatenWITH ""FI ;readrecord(kuwa1,
+eintrag);IF kennung=kzstdTHEN dbstatus(0);eintragSUB 4ELIF kennung=kzkurse
+THEN dbstatus(0);subtext(eintrag,5)ELSE ""FI END PROC planblockdaten;PROC 
+kurszumplanblockeintragen(TEXT CONST anwkurs,anwblockbez):TEXT VAR blockbez:=
+formbezeichner(anwblockbez);TEXT CONST kurs:=text(anwkurs,laengekurs);IF 
+halbjahrnichtgesetztCOR NOT blockeingetragen(blockbez)THEN dbstatus(1);LEAVE 
+kurszumplanblockeintragenFI ;readrecord(kuwa1,eintrag);IF length(eintrag)>
+laengeblockwstdTHEN IF wertnichteingetragen(subtext(eintrag,laengeblockwstd+1
+),kurs,1)THEN eintragCAT text(kurs,laengekurs);writerecord(kuwa1,eintrag)FI 
+ELSE eintragCAT text(kurs,laengekurs);writerecord(kuwa1,eintrag)FI ;dbstatus(
+0)END PROC kurszumplanblockeintragen;INT PROC anzahlschuelermitwahl(TEXT 
+CONST fach,kennung,art,klausur):IF halbjahrnichtgesetztTHEN dbstatus(1);
+LEAVE anzahlschuelermitwahlWITH 0FI ;fa1:=text(fach,laengefach);ke1:=text(
+kennung,laengekennung);ar:=text(art,laengeart);dbstatus(0);IF fach=""THEN 
+dbstatus(1);-1ELIF kennung=""CAND art=""CAND klausur=""THEN anzahlschueler(
+fa1,"",4)ELIF kennung=""CAND art=""THEN anzahlschueler(fa1,klausur,4)ELIF 
+kennung<>""CAND art=""CAND klausur=""THEN anzahlschueler(fa1+ke1,"",4)ELIF 
+kennung<>""CAND art=""THEN anzahlschueler(fa1+ke1,klausur,4)ELIF kennung=""
+CAND art<>""CAND klausur=""THEN anzahlschueler(ar+fa1,"",2)ELIF kennung=""
+CAND art<>""THEN anzahlschueler(klausur+ar+fa1,"",1)ELIF klausur=""THEN 
+anzahlschueler(ar+fa1+ke1,"",2)ELSE anzahlschueler(klausur+ar+fa1+ke1,"",1)
+FI END PROC anzahlschuelermitwahl;INT PROC anzahlschuelermitwahl(TEXT CONST 
+fach,kennung,art,klausur,fach2,kennung2,art2,klausur2):TEXT VAR p1,p3,p4,p6,
+ar1,ar2;INT VAR p2,p5;fa1:=text(fach,laengefach);fa2:=text(fach2,laengefach);
+ke1:=text(kennung,laengekennung);ke2:=text(kennung2,laengekennung);ar1:=text(
+art,laengeart);ar2:=text(art2,laengeart);IF halbjahrnichtgesetztCOR (fa1=fa2
+CAND kennung=kennung2CAND art=art2)THEN dbstatus(1);LEAVE 
+anzahlschuelermitwahlWITH 0FI ;pruefwahl.pruefwahl:dbstatus(0);IF fach=""
+THEN dbstatus(1);LEAVE anzahlschuelermitwahlWITH -1ELIF kennung=""CAND art=""
+CAND klausur=""THEN p1:=fa1;p2:=4;p3:=""ELIF kennung=""CAND art=""THEN p1:=
+fa1;p2:=4;p3:=klausurELIF kennung<>""CAND art=""CAND klausur=""THEN p1:=fa1+
+ke1;p2:=4;p3:=""ELIF kennung<>""CAND art=""THEN p1:=fa1+ke1;p2:=4;p3:=klausur
+ELIF kennung=""CAND art<>""CAND klausur=""THEN p1:=ar1+fa1;p2:=2;p3:="";ELIF 
+kennung=""CAND art<>""THEN p1:=klausur+ar1+fa1;p2:=1;p3:=""ELIF klausur=""
+THEN p1:=ar1+fa1+ke1;p2:=2;p3:=""ELSE p1:=klausur+ar1+fa1+ke1;p2:=1;p3:=""FI 
+;IF fach2=""THEN LEAVE anzahlschuelermitwahlWITH anzahlschueler(p1,p3,p2)
+ELIF kennung2=""CAND art2=""CAND klausur2=""THEN p4:=fa2;p5:=4;p6:=""ELIF 
+kennung2=""CAND art2=""THEN p4:=fa2;p5:=4;p6:=klausur2ELIF kennung2<>""CAND 
+art2=""CAND klausur2=""THEN p4:=fa2+ke2;p5:=4;p6:=""ELIF kennung2<>""CAND 
+art2=""THEN p4:=fa2+ke2;p5:=4;p6:=klausur2ELIF kennung2=""CAND art2<>""CAND 
+klausur2=""THEN p4:=ar2+fa2;p5:=2;p6:="";ELIF kennung2=""CAND art2<>""THEN p4
+:=klausur2+ar2+fa2;p5:=1;p6:=""ELIF klausur2=""THEN p4:=ar2+fa2+ke2;p5:=2;p6
+:=""ELSE p4:=klausur2+ar2+fa2+ke2;p5:=1;p6:=""FI ;anzahlschueler(p1,p3,p4,p6,
+p2,p5)END PROC anzahlschuelermitwahl;TEXT PROC schuelermitwahl(TEXT CONST 
+fach,kennung,art,klausur):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE 
+schuelermitwahlWITH ""FI ;fa1:=text(fach,laengefach);ke1:=text(kennung,
+laengekennung);ar:=text(art,laengeart);pruefwahl.pruefwahl:dbstatus(0);IF 
+fach=""THEN dbstatus(1);""ELIF kennung=""CAND art=""CAND klausur=""THEN 
+schueler(fa1,"",4)ELIF kennung=""CAND art=""THEN schueler(fa1,klausur,4)ELIF 
+kennung<>""CAND art=""CAND klausur=""THEN schueler(fa1+ke1,"",4)ELIF kennung
+<>""CAND art=""THEN schueler(fa1+ke1,klausur,4)ELIF kennung=""CAND art<>""
+CAND klausur=""THEN schueler(ar+fa1,"",2)ELIF kennung=""CAND art<>""THEN 
+schueler(klausur+ar+fa1,"",1)ELIF klausur=""THEN schueler(ar+fa1+ke1,"",2)
+ELSE schueler(klausur+ar+fa1+ke1,"",1)FI END PROC schuelermitwahl;INT PROC 
+anzahlfreierschuelerimplanblock(TEXT CONST blocknr,teilkennung,fach,kennung,
+art,klausur):TEXT VAR block:=text(blocknr,2)+text(teilkennung,1);INT VAR j:=
+int(blocknr)*3-2,anzspezschueler:=letzterschueler-ersterschueler+1,
+anzbelschueler:=0;IF halbjahrnichtgesetztCOR j<1COR j>maxkuwa1zeilenTHEN 
+dbstatus(1);LEAVE anzahlfreierschuelerimplanblockWITH -1FI ;IF fach=""THEN 
+anzspezschueler:=letzterschueler-ersterschueler+1ELSE anzspezschueler:=
+anzahlschuelermitwahl(fach,kennung,art,klausur)FI ;fa1:=text(fach,laengefach)
+;ke1:=text(kennung,laengekennung);ar:=text(art,laengeart);pruefwahl.pruefwahl
+:dbstatus(0);IF fach=""THEN anzbelschueler:=anzahlschueler("","",block,1)
+ELIF kennung=""CAND art=""CAND klausur=""THEN anzbelschueler:=anzahlschueler(
+fa1,"",block,4)ELIF kennung=""CAND art=""THEN anzbelschueler:=anzahlschueler(
+fa1,klausur,block,4)ELIF kennung<>""CAND art=""CAND klausur=""THEN 
+anzbelschueler:=anzahlschueler(fa1+ke1,"",block,4)ELIF kennung<>""CAND art=""
+THEN anzbelschueler:=anzahlschueler(fa1+ke1,klausur,block,4)ELIF kennung=""
+CAND art<>""CAND klausur=""THEN anzbelschueler:=anzahlschueler(ar+fa1,"",
+block,2)ELIF kennung=""CAND art<>""THEN anzbelschueler:=anzahlschueler(
+klausur+ar+fa1,"",block,1)ELIF klausur=""THEN anzbelschueler:=anzahlschueler(
+ar+fa1+ke1,"",block,2)ELSE anzbelschueler:=anzahlschueler(klausur+ar+fa1+ke1,
+"",block,1)FI ;anzspezschueler-anzbelschuelerEND PROC 
+anzahlfreierschuelerimplanblock;BOOL PROC schuelerinplanblock(TEXT CONST 
+famname,rufname,gebdatum,blockbez):TEXT VAR schueler:=trenner+famname+trenner
++rufname+trenner+gebdatum,block:=text(blockbez,laengeblock),schuelerkurse:=""
+,aktkurs,plblkurse:=planblockdaten(block,kzkurse);INT VAR kurspos;IF 
+planblockeingetragenCAND schuelereingetragen(schueler,kuwa2)CAND NOT 
+halbjahrnichtgesetztTHEN dbstatus(0);schuelerkurse:=wahldatenzumschueler(
+famname,rufname,gebdatum,kzfake);IF plblkurse=""THEN FALSE ELSE 
+betrachtealleschuelerkurseFI ELSE dbstatus(1);TRUE FI .planblockeingetragen:
+dbstatus=0.betrachtealleschuelerkurse:kurspos:=1;WHILE kurspos<length(
+schuelerkurse)REP aktkurs:=subtext(schuelerkurse,kurspos,kurspos+laengekurs-1
+);IF kursnichteingetragen(plblkurse,aktkurs)THEN kursposINCR laengekursELSE 
+LEAVE schuelerinplanblockWITH TRUE FI PER ;FALSE .END PROC 
+schuelerinplanblock;BOOL PROC kursnichteingetragen(TEXT CONST quelle,
+teilmuster):INT VAR suchab:=1,aktpos;WHILE pos(quelle,teilmuster,suchab)<>0
+REP aktpos:=pos(quelle,teilmuster,suchab);IF aktposMOD laengekurs=1THEN 
+LEAVE kursnichteingetragenWITH FALSE ELSE suchab:=aktpos+1FI PER ;TRUE END 
+PROC kursnichteingetragen;TEXT PROC schuelerundklausur(TEXT CONST fach,
+kennung,art):IF halbjahrnichtgesetztTHEN dbstatus(1);LEAVE schuelerundklausur
+WITH ""FI ;fa1:=text(fach,laengefach);ke1:=text(kennung,laengekennung);ar:=
+text(art,laengeart);pruefwahl.pruefwahl:dbstatus(0);IF fach=""THEN dbstatus(1
+);""ELIF kennung=""CAND art=""THEN klausurschueler(fa1,4)ELIF kennung<>""
+CAND art=""THEN klausurschueler(fa1+ke1,4)ELIF kennung=""CAND art<>""THEN 
+klausurschueler(ar+fa1,2)ELSE klausurschueler(ar+fa1+ke1,2)FI END PROC 
+schuelerundklausur;TEXT PROC klausurschueler(TEXT CONST suchtext,INT CONST 
+findpos):INT VAR aktpos;TEXT VAR namen:="";col(kuwa2,1);toline(kuwa2,erster);
+WHILE lineno(kuwa2)<=letzterREP downety(kuwa2,suchtext);aktpos:=col(kuwa2);
+IF lineno(kuwa2)>letzterTHEN LEAVE klausurschuelerWITH namenELIF aktposMOD 
+laengekurseintrag=findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos(eintrag
+,trenner);IF aktpos<namenposTHEN namenCAT trenner2+(eintragSUB (aktpos-
+findpos+1));namenCAT subtext(eintrag,namenpos,length(eintrag)-3)FI FI ;col(
+kuwa2,1);down(kuwa2)PER ;namen.END PROC klausurschueler;TEXT PROC schueler(
+TEXT CONST suchtext,klausur,INT CONST findpos):INT VAR aktpos;TEXT VAR namen
+:="";col(kuwa2,1);toline(kuwa2,erster);WHILE lineno(kuwa2)<=letzterREP 
+downety(kuwa2,suchtext);aktpos:=col(kuwa2);IF lineno(kuwa2)>letzterTHEN 
+LEAVE schuelerWITH namenELIF aktposMOD laengekurseintrag=findposTHEN 
+readrecord(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF aktpos<namenpos
+THEN IF klausur=""THEN namenCAT trenner2;namenCAT subtext(eintrag,namenpos,
+length(eintrag)-3)ELSE ueberpruefklausurFI FI FI ;col(kuwa2,1);down(kuwa2)
+PER ;namen.ueberpruefklausur:IF (eintragSUB (aktpos-findpos+1))=klausurTHEN 
+namenCAT trenner2;namenCAT subtext(eintrag,pos(eintrag,trenner),length(
+eintrag)-3)FI .END PROC schueler;INT PROC anzahlschueler(TEXT CONST suchtext,
+klausur,INT CONST findpos):INT VAR anz:=0,aktpos;col(kuwa2,1);toline(kuwa2,
+erster);WHILE lineno(kuwa2)<=letzterREP downety(kuwa2,suchtext);aktpos:=col(
+kuwa2);IF lineno(kuwa2)>letzterTHEN LEAVE anzahlschuelerWITH anzELIF aktpos
+MOD laengekurseintrag=findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos(
+eintrag,trenner);IF aktpos<namenposTHEN IF klausur=""THEN anzINCR 1ELSE 
+ueberpruefklausurFI FI FI ;down(kuwa2);col(kuwa2,1)PER ;anz.ueberpruefklausur
+:IF (eintragSUB (aktpos-findpos+1))=klausurTHEN anzINCR 1FI .END PROC 
+anzahlschueler;INT PROC anzahlschueler(TEXT CONST suchtext,klausur,anwblock,
+INT CONST findpos):INT VAR i,anz:=0,aktpos;TEXT VAR blocknr:=text(anwblock,2)
+,block:=text(blocknr,laengeblock);IF (anwblockSUB 3)="a"THEN blockCAT 
+anwblockELIF (anwblockSUB 3)="b"THEN blockCAT anwblockELSE block:=blocknrFI ;
+IF suchtext=""THEN zaehlalleschuelerELSE zaehlspezschuelerFI .
+zaehlspezschueler:col(kuwa2,1);toline(kuwa2,erster);WHILE lineno(kuwa2)<=
+letzterREP downety(kuwa2,suchtext);aktpos:=col(kuwa2);IF lineno(kuwa2)>
+letzterTHEN LEAVE anzahlschuelerWITH anzELIF aktposMOD laengekurseintrag=
+findposTHEN readrecord(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF 
+aktpos<namenposTHEN eintrag:=text(eintrag,namenpos-1);IF klausur=""THEN 
+pruefblockELSE ueberpruefklausurFI FI FI ;down(kuwa2);col(kuwa2,1)PER ;anz.
+ueberpruefklausur:IF (eintragSUB (aktpos-findpos+1))=klausurTHEN pruefblock
+FI .pruefblock:IF NOT (nichteingetragen(eintrag,block,10))COR NOT (
+nichteingetragen(eintrag,block,13))THEN anzINCR 1FI .zaehlalleschueler:col(
+kuwa2,1);FOR iFROM ersterUPTO letzterREP toline(kuwa2,i);readrecord(kuwa2,
+eintrag);eintrag:=text(eintrag,pos(eintrag,trenner)-1);pruefblockPER ;anz.
+END PROC anzahlschueler;INT PROC anzahlschueler(TEXT CONST suchtext,klausur,
+suchtext2,klausur2,INT CONST findpos,findpos2):INT VAR anz:=0,aktpos,kurspos;
+col(kuwa2,1);toline(kuwa2,erster);WHILE lineno(kuwa2)<=letzterREP downety(
+kuwa2,suchtext);aktpos:=col(kuwa2);IF lineno(kuwa2)>letzterTHEN LEAVE 
+anzahlschuelerWITH anzELIF aktposMOD laengekurseintrag=findposTHEN readrecord
+(kuwa2,eintrag);namenpos:=pos(eintrag,trenner);IF aktpos<namenposTHEN IF 
+klausur=""THEN ueberpruefkurs2ELSE ueberpruefklausurFI FI FI ;down(kuwa2);col
+(kuwa2,1)PER ;anz.ueberpruefklausur:IF (eintragSUB (aktpos-findpos+1))=
+klausurTHEN ueberpruefkurs2FI .ueberpruefkurs2:IF NOT nichteingetragen(
+eintrag,suchtext2,findpos2,kurspos)THEN IF klausur2=""THEN anzINCR 1ELIF (
+eintragSUB kurspos)=klausurTHEN anzINCR 1FI ;FI .END PROC anzahlschueler;
+TEXT PROC alledaten(TEXT CONST eintrag,kennung):INT VAR aktpos:=pos(eintrag,
+trenner);TEXT VAR kurse:=text(eintrag,aktpos-1),kurs,ausgabe:="";ausgabe:="";
+IF length(kurse)MOD laengekurseintrag<>0THEN dbstatus(1)ELSE aktpos:=1;WHILE 
+aktpos<length(kurse)REP kurs:=subtext(kurse,aktpos,aktpos+laengekurseintrag-1
+);IF kennung="F"THEN ausgabeCAT subtext(kurs,4,5)ELIF kennung="A"THEN ausgabe
+CAT subtext(kurs,2,3)ELIF kennung="FA"THEN ausgabeCAT subtext(kurs,4,5);
+ausgabeCAT subtext(kurs,2,3)ELIF kennung="FAk"THEN ausgabeCAT subtext(kurs,4,
+5);ausgabeCAT subtext(kurs,2,3);ausgabeCAT (kursSUB 1)ELIF kennung="FK"THEN 
+ausgabeCAT subtext(kurs,4,9)ELIF kennung="FKk"THEN ausgabeCAT subtext(kurs,4,
+9);ausgabeCAT (kursSUB 1)ELIF kennung="FKAk"THEN ausgabeCAT subtext(kurs,4,9)
+;ausgabeCAT subtext(kurs,2,3);ausgabeCAT (kursSUB 1)ELIF kennung="FP"THEN 
+ausgabeCAT subtext(kurs,4,5);ausgabeCAT planbloecke(subtext(kurs,4,9))FI ;
+aktposINCR laengekurseintragPER ;FI ;ausgabeEND PROC alledaten;INT PROC 
+zeilennrzumschuelerbestand(BOOL CONST letzterls):col(kuwa2,1);toline(kuwa2,1)
+;downety(kuwa2,kzneue);IF letzterlsTHEN IF eof(kuwa2)THEN lines(kuwa2)ELSE 
+lineno(kuwa2)-1FI ELSE IF eof(kuwa2)THEN lines(kuwa2)+1ELSE lineno(kuwa2)FI 
+FI END PROC zeilennrzumschuelerbestand;BOOL PROC nichteingetragen(TEXT CONST 
+urquelle,muster,INT CONST ripos,INT VAR findpos):INT VAR suchab:=1,aktpos,
+trennerpos:=pos(urquelle,trenner);TEXT VAR quelle;IF trennerpos>0THEN quelle
+:=text(urquelle,trennerpos-1)ELSE quelle:=urquelleFI ;WHILE pos(quelle,muster
+,suchab)<>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD 
+laengekurseintrag=riposTHEN findpos:=aktpos-ripos+1;LEAVE nichteingetragen
+WITH FALSE ELSE suchab:=aktpos+1FI PER ;findpos:=0;TRUE END PROC 
+nichteingetragen;BOOL PROC nichteingetragen(TEXT CONST urquelle,muster,INT 
+CONST ripos):INT VAR trennerpos:=pos(urquelle,trenner);TEXT VAR quelle,
+teilmuster;IF trennerpos>0THEN quelle:=text(urquelle,trennerpos-1)ELSE quelle
+:=urquelleFI ;IF length(muster)<4THEN wertnichteingetragen(quelle,muster,
+ripos)ELSE teilmuster:=text(muster,3);IF wertnichteingetragen(quelle,
+teilmuster,ripos)THEN teilmuster:=subtext(muster,4);wertnichteingetragen(
+quelle,teilmuster,ripos)ELSE FALSE FI FI END PROC nichteingetragen;BOOL PROC 
+wertnichteingetragen(TEXT CONST quelle,teilmuster,INT CONST ripos):INT VAR 
+suchab:=1,aktpos;WHILE pos(quelle,teilmuster,suchab)<>0REP aktpos:=pos(quelle
+,teilmuster,suchab);IF aktposMOD laengekurseintrag=riposTHEN LEAVE 
+wertnichteingetragenWITH FALSE ELSE suchab:=aktpos+1FI PER ;TRUE END PROC 
+wertnichteingetragen;TEXT PROC planbloecke(TEXT CONST kurs):TEXT VAR blockbez
+:="",zeile;INT VAR aktsp;col(kuwa1,1);toline(kuwa1,1);WHILE NOT eof(kuwa1)
+REP downety(kuwa1,kurs);IF NOT eof(kuwa1)THEN aktsp:=col(kuwa1);IF aktspMOD 
+laengekurs=5THEN readrecord(kuwa1,zeile);blockbezCAT text(zeile,laengeblock)
+FI ;col(kuwa1,aktsp+1)FI ;PER ;text(blockbez,6)END PROC planbloecke;PROC 
+aenderkursinkuwa1(TEXT CONST kurs,kursneu):INT VAR aktsp;col(kuwa1,1);toline(
+kuwa1,1);WHILE NOT eof(kuwa1)REP downety(kuwa1,kurs);IF NOT eof(kuwa1)THEN 
+aktsp:=col(kuwa1);IF aktspMOD laengekurs=5THEN readrecord(kuwa1,eintrag);
+writerecord(kuwa1,text(eintrag,aktsp-1)+kursneu+subtext(eintrag,aktsp+6))FI ;
+col(kuwa1,aktsp+1)FI ;PER END PROC aenderkursinkuwa1;BOOL PROC 
+schuelereingetragen(TEXT CONST schueler,FILE VAR file):col(file,1);toline(
+file,1);downety(file,schueler);IF NOT eof(file)THEN col(file,1);TRUE ELSE 
+FALSE FI END PROC schuelereingetragen;PROC planbloeckezukurseintragen(TEXT 
+CONST kurs,planbloecke):INT VAR aktpos;col(kuwa2,1);toline(kuwa2,1);WHILE 
+NOT eof(kuwa2)REP downety(kuwa2,kurs);IF NOT eof(kuwa2)THEN aktpos:=col(kuwa2
+);IF aktposMOD laengekurseintrag=4THEN korrigiereintragFI ;col(kuwa2,aktpos+
+11)FI PER .korrigiereintrag:readrecord(kuwa2,eintrag);writerecord(kuwa2,text(
+eintrag,aktpos+5)+planbloecke+subtext(eintrag,aktpos+12)).END PROC 
+planbloeckezukurseintragen;BOOL PROC kurseingetragen(TEXT CONST anwkurs):
+TEXT VAR kurs:=text(anwkurs,laengekurs);indateieingetragen(kuwa0,kurs)END 
+PROC kurseingetragen;BOOL PROC blockeingetragen(TEXT CONST planblock):
+indateieingetragen(kuwa1,planblock)END PROC blockeingetragen;BOOL PROC 
+indateieingetragen(FILE VAR dat,TEXT CONST suchtext):IF compress(suchtext)=""
+THEN LEAVE indateieingetragenWITH FALSE FI ;toline(dat,1);col(dat,1);downety(
+dat,suchtext);WHILE NOT eof(dat)REP IF col(dat)=1THEN LEAVE 
+indateieingetragenWITH TRUE ELSE col(dat,col(dat)+1)FI ;downety(dat,suchtext)
+PER ;FALSE END PROC indateieingetragen;TEXT PROC konvsjteil(TEXT CONST jahr,
+INT CONST jgstdiff):INT VAR kjahr:=int(jahr)+jgstdiff;IF kjahr>99THEN subtext
+(text(kjahr),2)ELSE text(kjahr)FI END PROC konvsjteil;PROC kursdatenholen:
+kuwa0:=sequentialfile(output,datei);inittupel(dnrlehrveranstaltungen);putwert
+(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);putwert(fnrlvjgst,jgst);
+statleseschleife(dnrlehrveranstaltungen,schuljahr,halbjahr,fnrlvsj,fnrlvhj,
+PROC kursdatenaktodergepl);modify(kuwa0).END PROC kursdatenholen;PROC 
+kursdatenaktodergepl(BOOL VAR b):IF wert(fnrlvsj)<>schuljahrCOR wert(fnrlvhj)
+<>halbjahrCOR wert(fnrlvjgst)<>jgstCOR dbstatus<>0THEN b:=TRUE ELSE putline(
+kuwa0,text(wert(fnrlvfachkennung),laengekurs)+text(wert(fnrlvwochenstd),
+laengewstd)+text(wert(fnrlvart),laengeart))FI .END PROC kursdatenaktodergepl;
+PROC kurswahleinerjgstaufbereiten(TEXT CONST jgst,halbjahr,schuljahr,FILE 
+VAR kuwadatei):datei:=kurswahl2+jgst+" "+halbjahr+"."+schuljahr;forget(datei,
+quiet);IF kuwa2eintragTHEN kuwa2:=sequentialfile(output,datei)ELSE kuwa3:=
+sequentialfile(output,datei)FI ;eintrag:=trenner;holhalbjahresdaten;
+holalleschueler;forget(namezwischendatei,quiet);IF kuwa2eintragTHEN modify(
+kuwa2)ELSE modify(kuwa3)FI .holhalbjahresdaten:inittupel(dnrhalbjahresdaten);
+changeindex;putwert(fnrhjdsj,schuljahr);putwert(fnrhjdhj,halbjahr);putwert(
+fnrhjdjgst,jgst);forget(namezwischendatei,quiet);kuwahilf:=sequentialfile(
+output,namezwischendatei);statleseschleife(ixhjdsjhjjgstkenn,schuljahr,
+halbjahr,fnrhjdsj,fnrhjdhj,PROC zwischenspeichern);.holalleschueler:modify(
+kuwahilf);IF bearbschueler<>2THEN erster:=1FI ;inittupel(dnrschueler);
+parsenooffields(5);changeindex;status:=stat1;statleseschleife(ixsustatjgst,
+status,text(aktjg),fnrsustatuss,fnrsusgrpjgst,PROC schuelerholen);IF aktjg=10
+THEN status:=stat2ELSE status:=stat3FI ;IF kuwa2eintragTHEN IF bearbschueler=
+1THEN letzter:=lines(kuwa2)ELIF bearbschueler=2THEN erster:=lines(kuwa2)+1FI 
+FI ;IF aktjg<>13THEN inittupel(dnrschueler);putintwert(fnrsujgsteintr,aktjg+1
+);statleseschleife(ixsustatjgst,status,"",fnrsustatuss,fnrsusgrpjgst,PROC 
+neueschuelerholen);FI ;IF kuwa2eintragTHEN IF bearbschueler<>1THEN letzter:=
+lines(kuwa2)FI ;IF erster=letzterTHEN letzterDECR 1FI FI ;reinitparsing.END 
+PROC kurswahleinerjgstaufbereiten;PROC zwischenspeichern(BOOL VAR b):IF wert(
+fnrhjdsj)<>schuljahrCOR wert(fnrhjdhj)<>halbjahrCOR wert(fnrhjdjgst)<>jgst
+COR dbstatus<>0THEN b:=TRUE ELSE tragwerteeinFI .tragwerteein:bereitedatenauf
+(wert(fnrhjdfach),wert(fnrhjdkursart),wert(fnrhjdlerngrpkenn),wert(
+fnrhjdklausurteiln));putline(kuwahilf,eintrag).END PROC zwischenspeichern;
+PROC bereitedatenauf(TEXT CONST faecher,arten,kennungen,klausuren):INT VAR i,
+j,l;TEXT VAR t,fach;l:=length(faecher)DIV laengefach;eintrag:="";FOR iFROM 1
+UPTO lREP holklausur;holart;holfach;holkennungPER ;eintragCAT trenner;eintrag
+CAT wert(fnrhjdfamnames);eintragCAT trenner;eintragCAT wert(fnrhjdrufnames);
+eintragCAT trenner;eintragCAT wert(fnrhjdgebdats).holklausur:t:=subtext(
+klausuren,i,i);IF t<>""THEN eintragCAT tELSE eintragCAT " "FI .holart:j:=i*
+laengeart-1;t:=subtext(arten,j,j+1);IF t<>""THEN eintragCAT tELSE eintragCAT 
+leereartFI .holfach:t:=subtext(faecher,j,j+1);IF t<>""THEN eintragCAT t;fach
+:=tELSE eintragCAT "  "FI .holkennung:j:=i*laengekennung-3;t:=subtext(
+kennungen,j,j+3);IF t<>""THEN eintragCAT t;IF plblvorhandenTHEN 
+holplanbloeckeELSE eintragCAT leereplanbloeckeFI ELSE eintragCAT leerekennung
++leereplanbloeckeFI .holplanbloecke:eintragCAT planbloecke(fach+t).END PROC 
+bereitedatenauf;PROC schuelerholen(BOOL VAR b):IF wert(fnrsustatuss)<>status
+COR intwert(fnrsusgrpjgst)<>aktjgCOR dbstatus<>0THEN dbstatus(1);b:=TRUE 
+ELSE schuelerdatenerstellen(kzschueler)FI .END PROC schuelerholen;PROC 
+neueschuelerholen(BOOL VAR b):IF wert(fnrsustatuss)<>statusCOR dbstatus<>0
+THEN dbstatus(1);b:=TRUE ELIF intwert(fnrsujgsteintr)=aktjg+1THEN 
+schuelerdatenerstellen(kzneue)FI .END PROC neueschuelerholen;PROC 
+schuelerdatenerstellen(TEXT CONST schuelerkennung):TEXT VAR famname,rufname,
+gebdatum,eintragkuwahilf;famname:=wert(fnrsufamnames);rufname:=wert(
+fnrsurufnames);gebdatum:=wert(fnrsugebdatums);eintragkuwahilf:=trenner+
+famname+trenner+rufname+trenner+gebdatum;IF keinehjdatenTHEN 
+schreibleereintragELSE suchinkuwahilfFI .keinehjdaten:eintrag=trenner.
+suchinkuwahilf:col(kuwahilf,1);toline(kuwahilf,1);downety(kuwahilf,
+eintragkuwahilf);IF eof(kuwahilf)THEN schreibleereintragELSE col(kuwahilf,1);
+readrecord(kuwahilf,eintragkuwahilf);eintragkuwahilfCAT schuelerkennung;IF 
+kuwa2eintragTHEN putline(kuwa2,eintragkuwahilf)ELSE putline(kuwa3,
+eintragkuwahilf)FI ;FI .schreibleereintrag:eintragkuwahilfCAT schuelerkennung
+;IF kuwa2eintragTHEN putline(kuwa2,eintragkuwahilf)ELSE putline(kuwa3,
+eintragkuwahilf)FI .END PROC schuelerdatenerstellen;BOOL PROC 
+halbjahrnichtgesetzt:schuljahr="0000"END PROC halbjahrnichtgesetzt;TEXT PROC 
+gesperrterdatenraumname(TEXT CONST namepraefix):praefixsperre+datenraumname(
+namepraefix)END PROC gesperrterdatenraumname;TEXT PROC datenraumname(TEXT 
+CONST namepraefix):TEXT VAR name:=namepraefix;nameCAT jgst;nameCAT " ";name
+CAT halbjahr;nameCAT ".";nameCAT schuljahr;nameEND PROC datenraumname;TEXT 
+PROC formbezeichner(TEXT CONST bezeichner):TEXT VAR bez:="",erg:="";INT VAR 
+ibez:=int(bezeichner);IF bezeichner=""THEN LEAVE formbezeichnerWITH 
+bezeichnerFI ;IF NOT (lastconversionok)THEN erg:=bezeichnerSUB 3;IF NOT (erg=
+kennungtplbl1COR erg=kennungtplbl2)THEN LEAVE formbezeichnerWITH ""FI ELSE 
+erg:=" "FI ;IF ibez<10THEN bezCAT "0";bezCAT text(ibez)ELSE bezCAT text(ibez)
+FI ;bezCAT erg;bezEND PROC formbezeichner;END PACKET 
+kurswahlschnittstelle240791;
+
diff --git a/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2 b/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2
new file mode 100644
index 0000000..2c44f7d
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kurszuordnung und umwahl fuer einzelne schueler sek2
@@ -0,0 +1,420 @@
+PACKET kurszuordnungundumwahlfuereinzelneschuelersek2DEFINES 
+kurszuordnungundumwahlsek2anfang,kurszuordnungundumwahlbearbeiten,
+kurszuordnungundumwahlspeichern,kurszuordnungundumwahlkurselisten,
+kurszuordnungundumwahlkopieren,kurszuordnungundumwahlrechtehaelfte,
+kurszuordnungundumwahllinkehaelfte,kurszuordnungundumwahlvorwaerts,
+kurszuordnungundumwahlrueckwaerts,kurszuordnungundumwahlbeenden,
+kurszuordnungundumwahllistezeigen,kurszuordnungundumwahllisteblaettern,
+kurszuordnungundumwahllistebearbeiten,kurszuordnungundumwahllistebeenden:LET 
+artbestand="c02 art lehrveranstaltung",abiklbestand="c02 abitur klausur",
+kuwa2sperre="Kurswahl-2 ",eingangsmaske=
+"ms kurszuordnung und umwahl sek2 eingang",bearbmaske=
+"ms kurszuordnung und umwahl sek2 bearb",listenmaske="mu objektliste",
+schuljahr="Schuljahr",halbjahr="Schulhalbjahr",laengefake=6,laengefakeartkl=9
+,laengevname=15,laengeplbleinesbs=36,laengekurseeinesbs=42,laengefamname=30,
+laengegebdat=8,laengename=53,einganggewjgst=2,einganggewhj=3,eingangaktjgst=4
+,eingangaktneue=5,eingangfamname=6,eingangrufname=7,eingangdatum=8,bearbname=
+2,bearbfaecher=3,bearbkurse=42,meldungwarten=69,meldungpraezisieren=129,
+meldungpruefen=329,meldungspeichern=50,meldungnspeichern=63,
+meldungfeldfuellen=52,meldungfalschejgst=404,meldungfalscheshj=405,
+meldungandereauswahl=318,meldunglistezeigen=7,meldungkeineschueler=423,
+meldungserverfehler=416,meldungkeinblaettern=72,meldungfalschesfach=310,
+meldungfalscheart=311,meldungunbeklv=360,meldungblockschnitt=424,
+meldungspfehler=419,meldungparallelanw=425,meldungfalscheartzk=434,
+meldungunbekannt=126,trenner="�",leerespraefix="         ",leererblock="   ",
+leerebloecke="      ",ausgzeichen="#",namenstrenner=", ",kzdoppeltbelegt=
+"  *   ",kzfaecher="F",kznurneue="N",kzname="N",kzohneneue="O",kzkurse="K",
+kzalle="A",kzart="A",kzstd="S",kzplbl="P",kzfaplbl="FP",kzfakeartkl="FKAk",
+logtext1="Anw. 2.3.1 Umwahl ",text1=" """,text2=""" ",punkt=".",komma=", ",
+ersteslistenfeld=2,erstesfachfeld=3,ersteskursfeld=42,anzbearbeingfelder=13,
+anzlistenfelder=18,anzbearbzeilen=12,anzfeldereingang=8;TEXT VAR gewsj,aktsj
+:="0000",akthj,gewjgst,gewhj,aktjgst,aktneue,aktwahl,aktname,aktvname,
+aktgebdatum,aktfaecher,aktartkl,aktkurse,aktschueler,schuelergruppe,
+schuelerliste,aktblock,alleplanbloecke:="",faecherbloecke,wahldaten,fach,art,
+klausur,kennung,fehlerblock,allearten:=trenner,allefaecher:=trenner,block12,
+block1,block2,alleklausurbez:="",praefix,kurse,pruefbloecke:=trenner,
+logmeldung;INT VAR i,j,letztepos:=2,fstat:=0,aktlistennr,fachfeld:=
+erstesfachfeld,artfeld:=16,klfeld:=17,kursfeld:=ersteskursfeld,aktplblindex:=
+1,anfpos,aktbsseite:=1,letztesfeld,listenpos:=1,aktindex,ersterindex:=
+ersterschueler;ROW anzbearbeingfelderROW 4TEXT VAR bearbrow;ROW 
+anzfeldereingangTEXT VAR eingangrow;ROW anzlistenfelderTEXT VAR aktliste;
+BOOL VAR listenbearbeitung:=FALSE ,rechtsscrollen:=FALSE ,sperreok,
+kopierfunktion:=FALSE ,scrollen:=FALSE ;WINDOW VAR w;initroweingang;
+initrowbearb;PROC initroweingang:FOR iFROM 2UPTO anzfeldereingangREP 
+eingangrow(i):=""PER ;END PROC initroweingang;PROC initrowbearb:INT VAR i;
+FOR iFROM 1UPTO anzbearbeingfelderREP bearbrow(i):=ROW 4TEXT :("","","","")
+PER ;END PROC initrowbearb;PROC kurszuordnungundumwahlsek2anfang:aktplblindex
+:=1;standardstartproc(eingangsmaske);gibeingangaus;infeld(1);
+standardfelderausgeben;infeld(letztepos);standardnproc.gibeingangaus:FOR i
+FROM 2UPTO anzfeldereingangREP standardmaskenfeld(eingangrow(i),i);IF 
+eingangrow(i)<>""THEN letztepos:=iFI PER .END PROC 
+kurszuordnungundumwahlsek2anfang;PROC kurszuordnungundumwahlbearbeiten:
+listenbearbeitung:=FALSE ;kopierfunktion:=FALSE ;schuelerliste:="";
+standardmeldung(meldungwarten,"");merkeeingang;aktname:=eingangrow(
+eingangfamname);aktvname:=eingangrow(eingangrufname);aktgebdatum:=konvdatum(
+eingangrow(eingangdatum));prueffeld2bis5;IF fstat<>0THEN LEAVE 
+kurszuordnungundumwahlbearbeitenFI ;kurswahlinitialisieren(aktjgst,gewjgst,
+gewhj,schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0THEN 
+meldungausgeben(meldungserverfehler,einganggewjgst,1);LEAVE 
+kurszuordnungundumwahlbearbeitenELIF letzterschueler<ersterschuelerTHEN 
+meldungausgeben(meldungkeineschueler,einganggewjgst,1);LEAVE 
+kurszuordnungundumwahlbearbeitenFI ;kurswahlsperresetzen(kuwa2sperre,sperreok
+);IF NOT sperreokTHEN meldungausgeben(meldungparallelanw,einganggewjgst,1);
+LEAVE kurszuordnungundumwahlbearbeitenFI ;prueffeld6bis8;standardstartproc(
+bearbmaske);standardkopfmaskeaktualisieren("Kurszuordnung für jetzige Jgst. "
++aktjgst+" in "+gewjgst+"."+gewhj);aktbsseite:=1;aktplblindex:=1;
+schuelerbearbeiten;standardnproc.prueffeld6bis8:FOR iFROM eingangfamnameUPTO 
+eingangdatumREP IF standardmaskenfeld(i)=""THEN meldungausgeben(
+meldungfeldfuellen,i,1);kurswahlsperrebeenden(kuwa2sperre);LEAVE 
+kurszuordnungundumwahlbearbeitenFI PER ;pruefexistschueler.pruefexistschueler
+:aktfaecher:=wahldatenzumschueler(aktname,aktvname,aktgebdatum,kzfaecher);IF 
+dbstatus<>0THEN meldungausgeben(meldungunbekannt,eingangfamname,1);
+kurswahlsperrebeenden(kuwa2sperre);LEAVE kurszuordnungundumwahlbearbeitenFI .
+END PROC kurszuordnungundumwahlbearbeiten;PROC schuelerbearbeiten:INT VAR 
+kurspos,rowindex:=1;aktschueler:=aktname+namenstrenner+aktvname+namenstrenner
++aktgebdatum;initrowbearb;ermittlefaecherartklkurse;standardmaskenfeld(text(
+aktschueler,laengename),bearbname);zeigplanblockkurszuordnung.
+ermittlefaecherartklkurse:fachfeld:=erstesfachfeld;artfeld:=16;klfeld:=17;
+kursfeld:=ersteskursfeld;kurspos:=1;aktfaecher:="";aktartkl:="";aktkurse:="";
+rowindex:=1;aktwahl:=wahldatenzumschueler(aktname,aktvname,aktgebdatum,
+kzfakeartkl);IF dbstatus=1COR aktwahl=""THEN aktwahl:="";initrowbearb;FOR j
+FROM 1UPTO anzbearbeingfelderREP standardmaskenfeld("",fachfeld);
+standardmaskenfeld("",artfeld);standardmaskenfeld("",klfeld);
+standardmaskenfeld("",kursfeld);fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2;
+kursfeldINCR 1;PER ;ELSE gibwahlausFI .gibwahlaus:WHILE kurspos<length(
+aktwahl)REP fach:=subtext(aktwahl,kurspos,kurspos+1);kennung:=subtext(aktwahl
+,kurspos+2,kurspos+5);aktfaecherCAT fach;aktkurseCAT kennung;fach:=compress(
+fach);kennung:=compress(kennung);art:=compress(subtext(aktwahl,kurspos+6,
+kurspos+7));klausur:=compress(aktwahlSUB (kurspos+8));standardmaskenfeld(fach
+,fachfeld);standardmaskenfeld(art,artfeld);standardmaskenfeld(klausur,klfeld)
+;standardmaskenfeld(kennung,kursfeld);bearbrow(rowindex):=ROW 4TEXT :(fach,
+art,klausur,kennung);IF rowindex<anzbearbeingfelderTHEN rowindexINCR 1FI ;
+fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2;kursfeldINCR 1;kursposINCR 
+laengefakeartklPER ;IF rowindex<anzbearbeingfelderTHEN FOR jFROM rowindex
+UPTO anzbearbeingfelderREP standardmaskenfeld("",fachfeld);standardmaskenfeld
+("",artfeld);standardmaskenfeld("",klfeld);standardmaskenfeld("",kursfeld);
+bearbrow(rowindex):=ROW 4TEXT :("","","","");IF rowindex<anzbearbeingfelder
+THEN rowindexINCR 1;fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2;kursfeldINCR 1;
+FI PER FI .zeigplanblockkurszuordnung:alleplanbloecke:=
+alleplanblockbezeichner;scrollen:=length(alleplanbloecke)>laengeplbleinesbs;
+zeigbearbdaten(aktplblindex).END PROC schuelerbearbeiten;PROC zeigbearbdaten(
+INT CONST planblocknr):INT VAR blockpos:=planblocknr*3-2;pruefbloecke:=
+trenner;faecherbloecke:=wahldatenzumschueler(aktname,aktvname,aktgebdatum,
+kzfaplbl);rechtsscrollen:=FALSE ;FOR iFROM 1UPTO anzbearbzeilenREP aktblock:=
+subtext(alleplanbloecke,blockpos,blockpos+2);IF aktblock=""THEN scrollen:=
+FALSE ;standardmaskenfeld("",i*4+51);standardmaskenfeld("",i*4+52);
+standardmaskenfeld("",i*4+53);standardmaskenfeld("",i*4+54)ELSE 
+standardmaskenfeld(konvplanblock(aktblock),i*4+51);standardmaskenfeld(
+planblockdaten(aktblock,kzstd),i*4+52);standardmaskenfeld("",i*4+53);
+ermittlemoeglichekurse;blockposINCR 3;FI ;PER ;
+kurszuordnungundumwahlkopierenvorbereiten;infeld(erstesfachfeld).END PROC 
+zeigbearbdaten;PROC ermittlemoeglichekurse:TEXT VAR kurse:=planblockdaten(
+aktblock,kzkurse),ausgabekurse;INT VAR kurspos:=1,berhilfe:=aktbsseite*
+laengekurseeinesbs;IF length(kurse)>berhilfeTHEN rechtsscrollen:=TRUE ;FI ;
+kurse:=subtext(kurse,berhilfe-laengekurseeinesbs+1,berhilfe);konvkurse;
+standardmaskenfeld(ausgabekurse,i*4+54).konvkurse:ausgabekurse:="";kurspos:=1
+;WHILE kurspos<length(kurse)REP ausgabekurseCAT subtext(kurse,kurspos,kurspos
++1);ausgabekurseCAT " ";ausgabekurseCAT subtext(kurse,kurspos+2,kurspos+5);
+kursposINCR 6PER .END PROC ermittlemoeglichekurse;TEXT PROC konvplanblock(
+TEXT CONST planblock):INT VAR blnr:=int(text(planblock,2));IF blnr<10THEN "0"
++text(blnr)+(planblockSUB 3)ELSE planblockFI END PROC konvplanblock;TEXT 
+PROC konvdatum(TEXT CONST datumohnepunkte):text(datumohnepunkte,2)+"."+
+subtext(datumohnepunkte,3,4)+"."+subtext(datumohnepunkte,5)END PROC konvdatum
+;PROC kurszuordnungundumwahlspeichern(BOOL CONST speichern):BOOL VAR 
+aenderung:=FALSE ;TEXT VAR std,fa,ke;IF speichernTHEN 
+pruefundspeicheraenderungen;ELSE standardmeldung(meldungnspeichern,"");FI ;
+naechsterbildschirm.naechsterbildschirm:IF listenbearbeitungTHEN IF listenpos
+>length(schuelerliste)THEN kurswahlsperrebeenden(kuwa2sperre);enter(3)ELSE 
+kopierfunktion:=FALSE ;IF naechsterschuelerTHEN infeld(1);schuelerbearbeiten;
+return(1)ELSE kurswahlsperrebeenden(kuwa2sperre);enter(3)FI FI ;ELSE 
+kurswahlsperrebeenden(kuwa2sperre);enter(2)FI .pruefundspeicheraenderungen:
+standardmeldung(meldungpruefen,"");fachfeld:=erstesfachfeld;artfeld:=16;
+klfeld:=17;kursfeld:=ersteskursfeld;aenderung:=FALSE ;wahldaten:="";FOR i
+FROM 1UPTO anzbearbeingfelderREP infeld(fachfeld);fach:=standardmaskenfeld(
+fachfeld);art:=standardmaskenfeld(artfeld);klausur:=standardmaskenfeld(klfeld
+);kennung:=standardmaskenfeld(kursfeld);block12:=kursdaten(text(fach,2)+
+kennung,kzplbl);IF fach<>bearbrow(i)(1)COR art<>bearbrow(i)(2)COR klausur<>
+bearbrow(i)(3)COR kennung<>bearbrow(i)(4)THEN aenderung:=TRUE FI ;IF fach<>""
+THEN IF art=""CAND kennung=""THEN meldungfeldfuellenausgebenELSE prueffachFI 
+ELIF art<>""COR kennung<>""THEN meldungfeldfachfuellenausgeben;LEAVE 
+kurszuordnungundumwahlspeichernFI ;IF art<>""THEN pruefartFI ;IF kennung<>""
+THEN pruefkennung;pruefartzumkurs;IF block12<>leerebloeckeTHEN 
+pruefkursueberschneidungFI FI ;IF fach<>""THEN wahldatenCAT text(klausur,1);
+wahldatenCAT text(art,2);wahldatenCAT text(fach,2);wahldatenCAT text(kennung,
+4);wahldatenCAT text(block12,6)FI ;fachfeldINCR 1;artfeldINCR 2;klfeldINCR 2;
+kursfeldINCR 1PER ;IF aenderungTHEN standardmeldung(meldungspeichern,"");
+schuelerwahleintragen(aktname,aktvname,aktgebdatum,wahldaten);IF dbstatus<>0
+THEN meldungausgeben(meldungspfehler,bearbfaecher,1);LEAVE 
+kurszuordnungundumwahlspeichernELSE logbucheintragvornehmen;kurswahl2sichern(
+fstat)FI FI .prueffach:IF allefaecher=trennerTHEN holepruefdatenFI ;IF pos(
+allefaecher,trenner+fach+trenner)=0THEN meldungausgeben(meldungfalschesfach,
+fachfeld,1);LEAVE kurszuordnungundumwahlspeichernFI .pruefart:IF pos(
+allearten,trenner+art+trenner)=0THEN meldungausgeben(meldungfalscheart,
+artfeld,1);LEAVE kurszuordnungundumwahlspeichernFI .pruefkennung:std:=
+compress(kursdaten(text(fach,2)+text(kennung,4),kzart));IF dbstatus<>0THEN 
+standardmeldung(meldungunbeklv,text(fach,2)+kennung+ausgzeichen);infeld(
+kursfeld);return(1);LEAVE kurszuordnungundumwahlspeichernFI .pruefartzumkurs:
+IF art<>""CAND std<>artCAND std<>""THEN meldungfalscheartausgeben;LEAVE 
+kurszuordnungundumwahlspeichernFI .pruefkursueberschneidung:TEXT VAR kuform;
+block1:=text(block12,3);block2:=subtext(block12,4);FOR jFROM 1UPTO i-1REP fa
+:=standardmaskenfeld(erstesfachfeld+j-1);ke:=standardmaskenfeld(
+ersteskursfeld+j-1);kuform:=text(text(fa,2)+ke,laengefake);IF fa<>""CAND ke<>
+""THEN IF kuform<>text(text(fach,2)+kennung,laengefake)THEN IF 
+planblockschnitt(kuform)THEN meldungblockschnittausgeben;LEAVE 
+kurszuordnungundumwahlspeichernFI FI FI PER ;FOR jFROM i+1UPTO 
+anzbearbeingfelderREP fa:=standardmaskenfeld(erstesfachfeld+j-1);ke:=
+standardmaskenfeld(ersteskursfeld+j-1);kuform:=text(text(fa,2)+ke,laengefake)
+;IF fa<>""CAND ke<>""THEN IF kuform<>text(text(fach,2)+kennung,laengefake)
+THEN IF planblockschnitt(kuform)THEN meldungblockschnittausgeben;LEAVE 
+kurszuordnungundumwahlspeichernFI FI FI PER .meldungfeldfuellenausgeben:
+meldungausgeben(meldungfeldfuellen,artfeld,1).meldungfeldfachfuellenausgeben:
+meldungausgeben(meldungfeldfuellen,fachfeld,1).meldungfalscheartausgeben:
+standardmeldung(meldungfalscheartzk,text(fach,2)+kennung+ausgzeichen+std+
+ausgzeichen);infeld(artfeld);return(1).meldungblockschnittausgeben:
+standardmeldung(meldungblockschnitt,compress(fehlerblock)+ausgzeichen);infeld
+(kursfeld);return(1).END PROC kurszuordnungundumwahlspeichern;BOOL PROC 
+naechsterschueler:aktindex:=int(subtext(schuelerliste,listenpos,listenpos+2))
+;belegeglobalevariablen(aktindex);listenposINCR 4;aktname<>""END PROC 
+naechsterschueler;BOOL PROC planblockschnitt(TEXT CONST andererkurs):TEXT 
+VAR bl1,bl2,bl12;IF compress(andererkurs)=""THEN LEAVE planblockschnittWITH 
+FALSE ELIF block1=leererblockCAND block2=leererblockTHEN LEAVE 
+planblockschnittWITH FALSE FI ;bl12:=kursdaten(andererkurs,kzplbl);IF 
+dbstatus=1THEN LEAVE planblockschnittWITH FALSE FI ;IF bl12=leerebloeckeTHEN 
+LEAVE planblockschnittWITH FALSE FI ;IF block1<>leererblockTHEN bl1:=text(
+bl12,3);IF block1ganzerblockCOR bl1ganzerblockTHEN block1:=text(block1,2);bl1
+:=text(bl12,2);ELSE bl1:=text(bl12,3)FI ;IF block1=bl1COR block1=bl2THEN 
+fehlerblock:=block1;LEAVE planblockschnittWITH TRUE FI ;FI ;IF block2<>
+leererblockTHEN bl2:=subtext(bl12,4);IF block2ganzerblockCOR bl2ganzerblock
+THEN block2:=text(block2,2);bl2:=subtext(bl12,4,5)ELSE bl2:=subtext(bl12,4)
+FI ;IF block2=bl1COR block2=bl2THEN fehlerblock:=block2;LEAVE 
+planblockschnittWITH TRUE FI ;FI ;FALSE .block1ganzerblock:(block1SUB 3)=" ".
+bl1ganzerblock:(bl1SUB 3)=" ".block2ganzerblock:(block2SUB 3)=" ".
+bl2ganzerblock:(bl2SUB 3)=" ".END PROC planblockschnitt;PROC holepruefdaten:
+allefaecher:=trenner;allearten:=trenner;inittupel(dnrfaecher);
+statleseschleife(dnrfaecher,"","",fnrffach,fnrffach,PROC sammleallefaecher);
+inittupel(dnrschluessel);statleseschleife(dnrschluessel,artbestand,"",
+fnrschlsachgebiet,fnrschlschluessel,PROC sammleallearten)END PROC 
+holepruefdaten;PROC sammleallefaecher(BOOL VAR b):allefaecherCAT wert(
+fnrffach);allefaecherCAT trennerEND PROC sammleallefaecher;PROC 
+sammleallearten(BOOL VAR b):IF wert(fnrschlsachgebiet)>artbestandCOR dbstatus
+<>0THEN b:=TRUE ELSE alleartenCAT wert(fnrschlschluessel);alleartenCAT 
+trenner;alleartenCAT text(wert(fnrschlschluessel),2);alleartenCAT trennerFI 
+END PROC sammleallearten;PROC kurszuordnungundumwahlkurselisten:TEXT VAR 
+kursliste,liste,ausgabeart;INT VAR aktfeld;kursliste:="";aktfeld:=infeld;w:=
+startwindow(20,23,77,1);liste:="";standardmeldung(meldunglistezeigen,"");#IF 
+menuedraussen08.02.91THEN reorganizescreenFI ;#fuelleliste;infeld(1);
+standardfelderausgeben;open(w);auskunfterteilung(liste,w,FALSE );
+reorganizescreen;setlasteditvalues;infeld(aktfeld);return(1).fuelleliste:
+holklausurkuerzel;listeCAT "Zusammensetzung der Kurse";listeCAT 
+auskunftstextende;listeCAT " ";listeCAT auskunftstextende;listeCAT 
+"Fach Art Kurs  Schüler Klausur";listeCAT auskunftstextende;listeCAT 
+"               ges.    ";FOR iFROM 1UPTO 6REP IF (alleklausurbezSUB i)<>""
+THEN listeCAT text((alleklausurbezSUB i),5)FI PER ;listeCAT auskunftstextende
+;listeallerkurse.holklausurkuerzel:IF alleklausurbez=""THEN statleseschleife(
+dnrschluessel,abiklbestand,"",fnrschlsachgebiet,fnrschlschluessel,PROC 
+sammlealleabikl)FI .listeallerkurse:belegefachart;betrachtekurse;anfpos:=1;
+praefix:=text(fach,5)+text(ausgabeart,4);WHILE anfpos<length(kursliste)REP 
+listeCAT praefix;IF praefix<>""THEN praefix:=leerespraefixFI ;kennung:=
+subtext(kursliste,anfpos,anfpos+3);listeCAT text(kennung,6);listeCAT text(
+anzahlschuelermitwahl(fach,kennung,"",""),3);listeCAT " ";FOR iFROM 1UPTO 6
+REP IF (alleklausurbezSUB i)<>""THEN listeCAT text(anzahlschuelermitwahl(fach
+,kennung,ausgabeart,(alleklausurbezSUB i)),5)FI PER ;listeCAT 
+auskunftstextende;anfposINCR 4PER ;listeCAT auskunftstextende.betrachtekurse:
+anfpos:=1;kursliste:="";kurse:=allekurse;WHILE anfpos<>0REP anfpos:=pos(kurse
+,fach,anfpos);IF anfposMOD 10=1THEN IF subtext(kurse,anfpos,anfpos+1)=text(
+fach,2)CAND subtext(kurse,anfpos+8,anfpos+9)=text(art,2)THEN kurslisteCAT 
+subtext(kurse,anfpos+2,anfpos+5)FI FI ;IF anfpos<>0THEN anfposINCR 1FI PER ;
+IF kursliste=""THEN ausgabeart:="";ermittleallekursezumfachELSE ausgabeart:=
+artFI .ermittleallekursezumfach:anfpos:=1;kursliste:="";WHILE anfpos<>0REP 
+anfpos:=pos(kurse,fach,anfpos);IF anfposMOD 10=1THEN IF subtext(kurse,anfpos,
+anfpos+1)=fachTHEN kurslisteCAT subtext(kurse,anfpos+2,anfpos+5)FI FI ;IF 
+anfpos<>0THEN anfposINCR 1FI PER .belegefachart:aktfeld:=infeld;IF aktfeld>2
+CAND aktfeld<16THEN fach:=standardmaskenfeld(aktfeld);art:=standardmaskenfeld
+(((aktfeld-2)*2-1)+15)ELIF aktfeld>15CAND aktfeld<42THEN fach:=
+standardmaskenfeld(aktfeldDIV 2-5);IF aktfeldMOD 2=0THEN art:=
+standardmaskenfeld(aktfeld)ELSE art:=standardmaskenfeld(aktfeld-1)FI ELSE 
+fach:=standardmaskenfeld(aktfeld-39);art:=standardmaskenfeld((aktfeld-39)*2+
+10)FI ;art:=compress(art).END PROC kurszuordnungundumwahlkurselisten;PROC 
+kurszuordnungundumwahllistebeenden:kurswahlsperrebeenden(kuwa2sperre);enter(2
+)END PROC kurszuordnungundumwahllistebeenden;PROC sammlealleabikl(BOOL VAR b)
+:IF wert(fnrschlsachgebiet)>abiklbestandCOR dbstatus<>0THEN b:=TRUE ELSE 
+alleklausurbezCAT wert(fnrschlschluessel)FI END PROC sammlealleabikl;PROC 
+kurszuordnungundumwahlkopierenvorbereiten:TEXT VAR fa,ke,f,k,aktplbl;INT VAR 
+z;TEXT VAR var:="",neuerkurseintrag:="";IF pruefbloecke=trennerTHEN 
+ermittlegezeigtebloecke;FI ;FOR jFROM 1UPTO anzbearbeingfelderREP fa:=
+standardmaskenfeld(bearbfaecher+j-1);ke:=standardmaskenfeld(bearbkurse+j-1);
+IF altedatenleerundneuedatenTHEN neuedateneintragenELIF 
+altedatenundneuedatenleerTHEN altedatenloeschenELIF altedatenundneuedaten
+THEN altedatenloeschenundneuedateneintragenFI ;bearbrow(j)(1):=fa;bearbrow(j)
+(4):=kePER ;standardfelderausgeben.altedatenleerundneuedaten:bearbrow(j)(4)=
+""CAND fa<>""CAND ke<>"".altedatenundneuedatenleer:bearbrow(j)(1)<>""CAND 
+bearbrow(j)(4)<>""CAND ke="".altedatenundneuedaten:bearbrow(j)(1)<>""CAND 
+bearbrow(j)(4)<>""CAND fa<>""CAND ke<>"".ermittlegezeigtebloecke:aktplbl:=
+subtext(alleplanbloecke,aktplblindex*3-2,(aktplblindex+anzbearbzeilen-1)*3);
+pruefbloecke:=trenner;FOR jFROM 1UPTO length(aktplbl)DIV 3REP pruefbloecke
+CAT subtext(aktplbl,j*3-2,j*3);pruefbloeckeCAT trennerPER .neuedateneintragen
+:faecherbloecke:=kursdaten(text(fa,2)+ke,kzplbl);IF faecherbloecke=
+leerebloeckeTHEN LEAVE neuedateneintragenFI ;aktplbl:=text(faecherbloecke,3);
+IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+aktplbl+trenner);IF i
+>0THEN i:=iDIV 4+1;tragneuenkurseinFI FI ;aktplbl:=subtext(faecherbloecke,4);
+IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+aktplbl+trenner);IF i
+>0THEN i:=iDIV 4+1;tragneuenkurseinFI FI .tragneuenkursein:IF 
+standardmaskenfeld(i*4+53)<>""CAND standardmaskenfeld(i*4+53)<>text(fa,2)+
+text(ke,4)THEN standardmaskenfeld(kzdoppeltbelegt,i*4+53)ELSE 
+standardmaskenfeld(text(fa,2)+text(ke,4),i*4+53)FI .altedatenloeschen:
+loescheintrag.altedatenloeschenundneuedateneintragen:IF bearbrow(j)(1)<>fa
+COR bearbrow(j)(4)<>keTHEN loescheintragFI ;neuedateneintragen.loescheintrag:
+faecherbloecke:=kursdaten(text(bearbrow(j)(1),2)+bearbrow(j)(4),kzplbl);IF 
+faecherbloecke=leerebloeckeTHEN LEAVE loescheintragFI ;aktplbl:=text(
+faecherbloecke,3);IF aktplbl<>leererblockTHEN i:=pos(pruefbloecke,trenner+
+aktplbl+trenner);IF i>0THEN i:=iDIV 4+1;IF standardmaskenfeld(i*4+53)=
+kzdoppeltbelegtTHEN traganderenkurseinELSE standardmaskenfeld("",i*4+53)FI 
+FI FI ;aktplbl:=subtext(faecherbloecke,4);IF aktplbl<>leererblockTHEN i:=pos(
+pruefbloecke,trenner+aktplbl+trenner);IF i>0THEN i:=iDIV 4+1;IF 
+standardmaskenfeld(i*4+53)=kzdoppeltbelegtTHEN traganderenkurseinELSE 
+standardmaskenfeld("",i*4+53)FI FI FI .traganderenkursein:neuerkurseintrag:=
+"";FOR zFROM 1UPTO j-1REP f:=standardmaskenfeld(bearbfaecher+z-1);IF f<>""
+THEN k:=standardmaskenfeld(bearbkurse+z-1);IF k<>""THEN var:=text(f,2)+k;var
+:=kursdaten(var,kzplbl);IF text(var,3)=aktplblCOR subtext(var,4)=aktplblTHEN 
+IF neuerkurseintrag=""THEN neuerkurseintrag:=text(f,2)+text(k,4)ELSE 
+standardmaskenfeld(kzdoppeltbelegt,i*4+53);LEAVE traganderenkurseinFI FI FI 
+FI PER ;FOR zFROM j+1UPTO anzbearbeingfelderREP f:=standardmaskenfeld(
+bearbfaecher+z-1);IF f<>""THEN k:=standardmaskenfeld(bearbkurse+z-1);IF k<>""
+THEN var:=text(f,2)+k;var:=kursdaten(var,kzplbl);IF text(var,3)=aktplblCOR 
+subtext(var,4)=aktplblTHEN IF neuerkurseintrag=""THEN neuerkurseintrag:=text(
+f,2)+text(k,4)ELSE standardmaskenfeld(kzdoppeltbelegt,i*4+53);LEAVE 
+traganderenkurseinFI FI FI FI PER ;IF neuerkurseintrag=""THEN 
+standardmaskenfeld("",i*4+53)ELSE tragkursausehemdoppelbeleinFI .
+tragkursausehemdoppelbelein:standardmaskenfeld(neuerkurseintrag,i*4+53).END 
+PROC kurszuordnungundumwahlkopierenvorbereiten;PROC 
+kurszuordnungundumwahlkopieren:kopierfunktion:=TRUE ;
+kurszuordnungundumwahlkopierenvorbereiten;kopierfunktion:=FALSE ;return(1)
+END PROC kurszuordnungundumwahlkopieren;PROC 
+kurszuordnungundumwahlrechtehaelfte:INT VAR blockpos:=aktplblindex*3-2,
+aktfeld:=infeld;IF rechtsscrollenTHEN aktbsseiteINCR 1;
+zeigweiteremoeglichekurseELSE letztesfeld:=infeld;meldungausgeben(
+meldungkeinblaettern,letztesfeld,1)FI .zeigweiteremoeglichekurse:FOR iFROM 1
+UPTO anzbearbzeilenREP aktblock:=subtext(alleplanbloecke,blockpos,blockpos+2)
+;IF aktblock=""THEN standardmaskenfeld("",i*4+54)ELSE ermittlemoeglichekurse;
+blockposINCR 3;FI ;PER ;infeld(1);standardfelderausgeben;infeld(aktfeld);
+return(1).END PROC kurszuordnungundumwahlrechtehaelfte;PROC 
+kurszuordnungundumwahllinkehaelfte:INT VAR blockpos:=aktplblindex*3-2,aktfeld
+:=infeld;IF aktbsseite<>1THEN rechtsscrollen:=TRUE ;aktbsseiteDECR 1;
+zeigweiteremoeglichekurseELSE letztesfeld:=infeld;meldungausgeben(
+meldungkeinblaettern,letztesfeld,1)FI .zeigweiteremoeglichekurse:FOR iFROM 1
+UPTO anzbearbzeilenREP aktblock:=subtext(alleplanbloecke,blockpos,blockpos+2)
+;IF aktblock=""THEN standardmaskenfeld("",i*4+54)ELSE ermittlemoeglichekurse;
+blockposINCR 3;FI ;PER ;infeld(1);standardfelderausgeben;infeld(aktfeld);
+return(1).END PROC kurszuordnungundumwahllinkehaelfte;PROC 
+kurszuordnungundumwahlvorwaerts:INT VAR aktfeld:=infeld;IF scrollenTHEN 
+aktplblindexINCR anzbearbzeilen;zeigbearbdaten(aktplblindex);infeld(aktfeld);
+return(1)ELSE letztesfeld:=infeld;meldungausgeben(meldungkeinblaettern,
+letztesfeld,1)FI END PROC kurszuordnungundumwahlvorwaerts;PROC 
+kurszuordnungundumwahlrueckwaerts:INT VAR aktfeld:=infeld;IF aktplblindex>1
+THEN scrollen:=TRUE ;aktplblindexDECR anzbearbzeilen;zeigbearbdaten(
+aktplblindex);infeld(aktfeld);return(1)ELSE letztesfeld:=infeld;
+meldungausgeben(meldungkeinblaettern,letztesfeld,1)FI END PROC 
+kurszuordnungundumwahlrueckwaerts;PROC kurszuordnungundumwahlbeenden:
+kurswahlsperrebeenden(kuwa2sperre);IF listenbearbeitungTHEN enter(3)ELSE 
+enter(2)FI END PROC kurszuordnungundumwahlbeenden;BOOL PROC datumkorrekt:
+standardpruefe(6,eingangdatum,1,1,"",fstat);fstat=0END PROC datumkorrekt;
+PROC prueffeld2bis5:fstat:=0;IF aktsj="0000"THEN aktsj:=schulkenndatum(
+schuljahr);akthj:=schulkenndatum(halbjahr)FI ;gewjgst:=eingangrow(
+einganggewjgst);gewhj:=eingangrow(einganggewhj);aktjgst:=eingangrow(
+eingangaktjgst);aktneue:=eingangrow(eingangaktneue);prueffeld2;prueffeld3;
+prueffeld4und5;prueffeld4;IF fstat=1THEN LEAVE prueffeld2bis5FI ;prueffeld5.
+prueffeld2:i:=int(gewjgst);IF gewjgst=""THEN meldungausgeben(
+meldungfeldfuellen,einganggewjgst,1);LEAVE prueffeld2bis5ELIF i<11COR i>14
+THEN meldungausgeben(meldungfalschejgst,einganggewjgst,1);LEAVE 
+prueffeld2bis5FI .prueffeld3:i:=int(gewhj);IF gewhj=""THEN meldungausgeben(
+meldungfeldfuellen,einganggewhj,1);LEAVE prueffeld2bis5ELIF i<1COR i>2THEN 
+meldungausgeben(meldungfalscheshj,einganggewhj,1);LEAVE prueffeld2bis5FI .
+prueffeld4und5:IF aktjgst=""CAND aktneue=""THEN meldungausgeben(
+meldungpraezisieren,eingangaktjgst,1);LEAVE prueffeld2bis5ELIF aktjgst=""
+CAND aktneue<>""THEN schuelergruppe:=kznurneueELIF aktjgst<>""CAND aktneue=""
+THEN schuelergruppe:=kzohneneueELSE schuelergruppe:=kzalleFI .prueffeld4:i:=
+int(aktjgst);IF i<10COR i>14THEN meldungausgeben(meldungfalschejgst,
+einganggewjgst,1)ELIF i>int(gewjgst)THEN meldungausgeben(meldungandereauswahl
+,einganggewjgst,1)ELIF i=int(gewjgst)THEN IF gewhj="1"CAND akthj="2"THEN 
+meldungausgeben(meldungandereauswahl,einganggewhj,1)FI FI .prueffeld5:i:=int(
+aktneue);IF aktneue<>""CAND aktjgst<>""THEN IF i-1<>int(aktjgst)THEN 
+meldungausgeben(meldungandereauswahl,eingangaktneue,1)FI ELIF aktneue<>""
+CAND aktjgst=""THEN IF i<11COR i>14THEN meldungausgeben(meldungfalschejgst,
+eingangaktneue,1)ELIF i+1>int(gewjgst)THEN meldungausgeben(
+meldungandereauswahl,eingangaktneue,1)ELIF i-1=int(gewjgst)THEN IF gewhj="1"
+CAND akthj="2"THEN meldungausgeben(meldungandereauswahl,einganggewhj,1)FI FI 
+FI .END PROC prueffeld2bis5;PROC kurszuordnungundumwahllistezeigen:
+standardmeldung(meldungwarten,"");merkeeingang;prueffeld2bis5;IF fstat<>0
+THEN LEAVE kurszuordnungundumwahllistezeigenELSE standardmeldung(
+meldunglistezeigen,"");kurswahlinitialisieren(aktjgst,gewjgst,gewhj,
+schuelergruppe,gewsj);kurswahlbasisholen(fstat);IF fstat<>0THEN 
+meldungausgeben(meldungserverfehler,einganggewjgst,1);LEAVE 
+kurszuordnungundumwahllistezeigenELIF letzterschueler<ersterschuelerTHEN 
+meldungausgeben(meldungkeineschueler,einganggewjgst,1);LEAVE 
+kurszuordnungundumwahllistezeigenFI ;kurswahlsperresetzen(kuwa2sperre,
+sperreok);IF NOT sperreokTHEN letztesfeld:=infeld;meldungausgeben(
+meldungparallelanw,letztesfeld,1);LEAVE kurszuordnungundumwahllistezeigenFI ;
+suchindices;zeigelisteFI .zeigeliste:schuelerliste:=trenner;standardstartproc
+(listenmaske);zeigliste(ersterindex);standardnproc.END PROC 
+kurszuordnungundumwahllistezeigen;PROC zeigliste(INT CONST zeilennr):
+aktlistennr:=zeilennr;infeld(ersteslistenfeld);FOR iFROM 1UPTO 
+anzlistenfelderREP aktname:=wahldatenzumindex(zeilennr+i-1,kzname);changeall(
+aktname,trenner,namenstrenner);standardmaskenfeld(aktname,i*2+1);IF pos(
+schuelerliste,trenner+text(aktlistennr+i-1,3)+trenner)>0THEN 
+standardmaskenfeld("x",i*2);aktliste(i):="x"ELSE standardmaskenfeld("",i*2);
+aktliste(i):=""FI PER ;infeld(1);standardfelderausgeben;infeld(
+ersteslistenfeld).END PROC zeigliste;PROC suchindices:TEXT VAR aktname;
+aktname:=eingangrow(eingangfamname);IF aktname=""THEN ersterindex:=
+ersterschuelerELSE vergleichnamenFI .vergleichnamen:aktname:=text(aktname,
+laengefamname);aktnameCAT trenner;aktnameCAT text(eingangrow(eingangrufname),
+laengevname);aktnameCAT trenner;aktnameCAT text(eingangrow(eingangdatum),
+laengegebdat);aktnameCAT trenner;FOR iFROM ersterschuelerUPTO letzterschueler
+REP IF wahldatenzumindex(i,kzname)>=aktnameTHEN ersterindex:=i;LEAVE 
+suchindicesFI PER ;ersterindex:=letzterschueler.END PROC suchindices;PROC 
+kurszuordnungundumwahllisteblaettern(INT CONST aktion):INT VAR 
+ersterschuelerletzterbs,aktfeld:=infeld;IF aktion=1THEN IF aktlistennr<>
+ersterschuelerTHEN analysierekennzeichnungen;ersterindex:=ersterschueler;
+zeigliste(ersterindex);return(1)ELSE fehlermeldungaktionnichtmöglichFI ELIF 
+aktion=2THEN ersterschuelerletzterbs:=letzterschueler-anzlistenfelder+1;IF 
+aktlistennr<ersterschuelerletzterbsCOR aktlistennr>ersterschuelerletzterbs
+THEN analysierekennzeichnungen;zeigliste(ersterschuelerletzterbs);return(1)
+ELIF aktlistennr=ersterschuelerletzterbsTHEN fehlermeldungaktionnichtmöglich
+FI ELIF aktion=3THEN IF aktlistennr>=letzterschueler-anzlistenfelder+1THEN 
+fehlermeldungaktionnichtmöglichELSE analysierekennzeichnungen;zeigliste(
+aktlistennr+anzlistenfelder);return(1)FI ELIF aktion=4THEN IF aktlistennr=
+ersterindexTHEN fehlermeldungaktionnichtmöglichELSE analysierekennzeichnungen
+;IF (aktlistennr-anzlistenfelder+1)<ersterindexTHEN zeigliste(ersterindex)
+ELSE zeigliste(aktlistennr-anzlistenfelder)FI ;return(1)FI FI .
+fehlermeldungaktionnichtmöglich:meldungausgeben(meldungkeinblaettern,aktfeld,
+1);LEAVE kurszuordnungundumwahllisteblaettern.END PROC 
+kurszuordnungundumwahllisteblaettern;PROC analysierekennzeichnungen:FOR i
+FROM 1UPTO anzlistenfelderREP IF standardmaskenfeld(i*2)<>aktliste(i)THEN 
+schuelerlisteCAT text(aktlistennr+i-1,3);schuelerlisteCAT trennerFI PER .END 
+PROC analysierekennzeichnungen;PROC kurszuordnungundumwahllistebearbeiten:
+listenpos:=1;listenbearbeitung:=TRUE ;kopierfunktion:=FALSE ;
+analysierekennzeichnungen;IF schuelerliste=trennerTHEN kurswahlsperrebeenden(
+kuwa2sperre);enter(2);LEAVE kurszuordnungundumwahllistebearbeitenELSE 
+schuelerliste:=subtext(schuelerliste,2)FI ;standardstartproc(bearbmaske);
+standardkopfmaskeaktualisieren("Kurszuordnung für jetzige Jgst. "+aktjgst+
+" in "+gewjgst+"."+gewhj);aktbsseite:=1;aktplblindex:=1;aktindex:=int(subtext
+(schuelerliste,listenpos,listenpos+2));belegeglobalevariablen(aktindex);
+schuelerbearbeiten;standardnproc;listenposINCR 4.END PROC 
+kurszuordnungundumwahllistebearbeiten;PROC belegeglobalevariablen(INT CONST 
+index):TEXT VAR iddaten:=wahldatenzumindex(index,kzname);INT VAR trenner1pos
+:=pos(iddaten,trenner),trenner2pos:=pos(iddaten,trenner,trenner1pos+1);IF 
+dbstatus=0THEN aktname:=text(iddaten,trenner1pos-1);aktvname:=subtext(iddaten
+,trenner1pos+1,trenner2pos-1);aktgebdatum:=subtext(iddaten,trenner2pos+1);
+ELSE aktname:="";aktvname:="";aktgebdatum:=""FI ;eingangrow(eingangfamname):=
+aktname;eingangrow(eingangrufname):=aktvname;eingangrow(eingangdatum):=
+datumrekonversion(aktgebdatum)END PROC belegeglobalevariablen;PROC 
+meldungausgeben(INT CONST meldung,gewfeld,gewruecksprung):fstat:=1;
+standardmeldung(meldung,"");infeld(gewfeld);return(gewruecksprung)END PROC 
+meldungausgeben;PROC merkeeingang:FOR iFROM 2UPTO anzfeldereingangREP 
+eingangrow(i):=standardmaskenfeld(i)PER END PROC merkeeingang;PROC 
+logbucheintragvornehmen:logmeldung:=logtext1;logmeldungCAT gewjgst;logmeldung
+CAT punkt;logmeldungCAT gewhj;logmeldungCAT text1;logmeldungCAT aktname;
+logmeldungCAT komma;logmeldungCAT aktvname;logmeldungCAT komma;logmeldungCAT 
+aktgebdatum;logmeldungCAT text2;logeintrag(logmeldung)END PROC 
+logbucheintragvornehmen;END PACKET 
+kurszuordnungundumwahlfuereinzelneschuelersek2
+
diff --git a/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2 b/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2
new file mode 100644
index 0000000..2f79a1b
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.kw anschr kurslisten sek2
@@ -0,0 +1,90 @@
+PACKET kwanschrkurslistensek2DEFINES kursliauskunfteingang,
+kursliauskunftstarten,kursliauskunftsonderwerte,kursliauskunftscanbedingung,
+kursliauskunftdruckdateibauen:LET swkurs=520,swanrede=521,swlehrer=522,
+swklausur=523,swname=524,swvorname=525,swgebdat=526,maske=
+"ms anschr kwkursli sek2 eingang",fnrjgst=2,fnrfach=3,fnrkennung=4,fnrakthj=5
+,fnrgeplhj=6,fnrausgbs=7,fnrausgdr=8,niltext="",blank=" ",null=0,satztrenner=
+"$",feldtrenner="�",mnrbittewarten=69,mnrbittepraeziser=129,mnrkeinekwdatenda
+=406,mnrjgstfalsch=404;INT VAR mnrallgemein;TEXT CONST dateimitvordruck1:=
+"vordruck1 kursli kopfueb",dateimitvordruck2:="vordruck2 kursli zeile";INT 
+VAR index,status,dbstatusgemerkt,fehler,zeilenzahl,zusatzzeilen,
+zeilenhilfszahl,anzahlsaetze,satzanfpos,feldpos1,feldpos2;TEXT VAR hj,
+fuerkwsj,jgst,fachkennung,fach,kennung,kwdaten,kurs,anredetext,lehrer;BOOL 
+VAR bestfach,bildschirmausgabe,akthjgewaehlt,hilfsdateida;PROC 
+kursliauskunfteingang:standardvproc(maske)END PROC kursliauskunfteingang;
+PROC kursliauskunftstarten:bestfach:=FALSE ;standardpruefe(5,fnrausgbs,
+fnrausgdr,null,niltext,status);IF status<>0THEN infeld(status);return(1)ELSE 
+standardpruefe(5,fnrakthj,fnrgeplhj,null,niltext,status);IF status<>0THEN 
+infeld(status);return(1)ELSE bildschirmausgabe:=standardmaskenfeld(fnrausgdr)
+=niltext;akthjgewaehlt:=standardmaskenfeld(fnrgeplhj)=niltext;jgst:=
+standardmaskenfeld(fnrjgst);fach:=standardmaskenfeld(fnrfach);kennung:=
+standardmaskenfeld(fnrkennung);IF weiterepruefungenokTHEN startenausfuehren
+ELSE standardmeldung(mnrallgemein,niltext);return(1)FI ;FI ;FI ;.
+weiterepruefungenok:standardpruefe(2,fnrjgst,null,null,niltext,status);IF 
+status<>0THEN infeld(fnrjgst);mnrallgemein:=mnrjgstfalsch;LEAVE 
+weiterepruefungenokWITH FALSE FI ;IF int(jgst)<11COR int(jgst)>13THEN infeld(
+fnrjgst);mnrallgemein:=mnrjgstfalsch;LEAVE weiterepruefungenokWITH FALSE FI ;
+IF (fach=niltextAND kennung<>niltext)THEN infeld(fnrfach);mnrallgemein:=
+mnrbittepraeziser;LEAVE weiterepruefungenokWITH FALSE FI ;IF (fach<>niltext
+AND kennung=niltext)THEN infeld(fnrkennung);mnrallgemein:=mnrbittepraeziser;
+LEAVE weiterepruefungenokWITH FALSE FI ;IF NOT kwdatenraumokTHEN infeld(
+fnrjgst);mnrallgemein:=mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE 
+FI ;inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,fuerkwsj);putwert(
+fnrlvhj,hj);putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,text(fach,2)+
+kennung);IF fach<>niltextAND kennung<>niltextTHEN bestfach:=TRUE ;search(
+dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN mnrallgemein:=
+mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE FI ;ELSE search(
+dnrlehrveranstaltungen,FALSE );IF dbstatus<>0COR wert(fnrlvjgst)<>jgstCOR 
+wert(fnrlvhj)<>hjCOR wert(fnrlvsj)<>fuerkwsjTHEN mnrallgemein:=
+mnrkeinekwdatenda;LEAVE weiterepruefungenokWITH FALSE FI ;FI ;kurs:=text(fach
+,2)+kennung;TRUE .kwdatenraumok:hj:=schulkenndatum("Schulhalbjahr");IF 
+akthjgewaehltTHEN kurswahlinitialisieren(jgst,jgst,hj,niltext,fuerkwsj)ELSE 
+IF hj="1"THEN hj:="2"ELSE hj:="1";jgst:=text(int(jgst)+1);FI ;
+kurswahlinitialisieren(jgst,jgst,hj,niltext,fuerkwsj)FI ;kurswahlbasisholen(
+fehler);fehler=0.startenausfuehren:setzesonderwerteschulkenndaten;IF bestfach
+THEN index:=ixlvsjhjkennELSE index:=dnrlehrveranstaltungenFI ;standardmeldung
+(mnrbittewarten,niltext);zusammengesetztesanschreiben(index,bildschirmausgabe
+,FALSE ,BOOL PROC kursliauskunftsonderwerte,BOOL PROC 
+kursliauskunftscanbedingung,TEXT PROC kursliauskunftdruckdateibauen)END PROC 
+kursliauskunftstarten;BOOL PROC kursliauskunftscanbedingung:BOOL VAR ok;IF 
+bestfachTHEN ok:=dbstatus=0AND jgst=wert(fnrlvjgst)AND kurs=wert(
+fnrlvfachkennung)ELSE ok:=dbstatus=0AND jgst=wert(fnrlvjgst)FI ;okEND PROC 
+kursliauskunftscanbedingung;BOOL PROC kursliauskunftsonderwerte:BOOL VAR 
+schuelerda:=FALSE ;initialisieresonderwerte;fachkennung:=wert(
+fnrlvfachkennung);adressat(fachkennung);fach:=subtext(fachkennung,1,2);
+kennung:=subtext(fachkennung,3,6);dbstatusgemerkt:=dbstatus;kwdaten:=
+schuelerundklausur(fach,kennung,niltext);IF length(kwdaten)<>0THEN schuelerda
+:=TRUE ;setzesonderwert(swkurs,wert(fnrlvjgst)+blank+fach+blank+kennung);
+inittupel(dnrlehrer);putwert(fnrlparaphe,wert(fnrlvparaphe));search(dnrlehrer
+,TRUE );IF dbstatus=0THEN lehrer:=wert(fnrlamtsbeztitel);lehrerCAT blank;
+lehrerCAT wert(fnrlzusatz);lehrerCAT blank;lehrerCAT wert(fnrlfamname);IF 
+wert(fnrlgeschlecht)="m"THEN anredetext:="Herr "ELSE anredetext:="Frau "FI ;
+FI ;setzesonderwert(swanrede,anredetext);setzesonderwert(swlehrer,lehrer);
+dbstatus(dbstatusgemerkt);FI ;dbstatus=0AND schuelerdaEND PROC 
+kursliauskunftsonderwerte;TEXT PROC kursliauskunftdruckdateibauen:LET 
+druckdatei="liste.1",hilfsdatei="hilfsdatei";vordruckeholen;
+setzemitseitennummern(TRUE );setzeanzahlderzeichenprozeile(78);
+druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0;briefalternative(
+dateimitvordruck1,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);hilfsdateida
+:=FALSE ;satzanfpos:=pos(kwdaten,satztrenner);WHILE satzanfpos<>0AND 
+satzanfpos<length(kwdaten)REP feldpos1:=pos(kwdaten,feldtrenner,satzanfpos);
+setzesonderwert(swklausur,subtext(kwdaten,satzanfpos+1,feldpos1-1));feldpos2
+:=pos(kwdaten,feldtrenner,feldpos1+1);setzesonderwert(swname,subtext(kwdaten,
+feldpos1+1,feldpos2-1));feldpos1:=pos(kwdaten,feldtrenner,feldpos2+1);
+setzesonderwert(swvorname,subtext(kwdaten,feldpos2+1,feldpos1-1));satzanfpos
+:=pos(kwdaten,satztrenner,feldpos1);IF satzanfpos=0THEN setzesonderwert(
+swgebdat,subtext(kwdaten,feldpos1+1,length(kwdaten)))ELSE setzesonderwert(
+swgebdat,subtext(kwdaten,feldpos1+1,satzanfpos-1))FI ;briefalternative(
+dateimitvordruck2,hilfsdatei);hilfsdateida:=TRUE ;PER ;IF hilfsdateidaTHEN 
+hilfsdateiindruckdatei(hilfsdatei);FI ;drucknachbereitenohneausdrucken;
+vordruckeloeschen;druckdatei.vordruckeholen:fetch(dateimitvordruck1,/
+"anschreiben server");fetch(dateimitvordruck2,/"anschreiben server");.
+vordruckeloeschen:forget(dateimitvordruck1,quiet);forget(dateimitvordruck2,
+quiet);END PROC kursliauskunftdruckdateibauen;PROC hilfsdateiindruckdatei(
+TEXT CONST hilfsdatei):FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(
+input,hilfsdatei);zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+
+zusatzzeilen>=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1
+UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ;
+forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC 
+hilfsdateiindruckdatei;END PACKET kwanschrkurslistensek2;
+
diff --git a/app/schulis/2.2.1/src/2.likw kurskombinationen sek2 b/app/schulis/2.2.1/src/2.likw kurskombinationen sek2
new file mode 100644
index 0000000..35caa9d
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.likw kurskombinationen sek2
@@ -0,0 +1,166 @@
+PACKET likwkurskombinatilonensek2DEFINES kurskombinationmaskebearbeiten,
+kurskombinationggferstellen,kurskombinationzeigen,kurskombinationendrucken:
+LET maske="ms kurskombination auszaehlen sek2 eingang",fnr2fuerjgst=2,
+fnr3fuerhj=3,fnr4jgstls=4,fnr5jgstneu=5,fnr6kurswahl=6,fnr7bestart=7,
+fnr8klausur=8,fnr9bs=9,fnr10dr=10,mnrjgstfalsch=404,mnrjgstfehlt=172,
+mnrhjfalsch=405,mnrkeinekwdatenda=406,mnrkeinedbdatenda=407,
+mnrbearbeitetwerden=352,mnrlistewirdgedruckt=58,mnrbittewarten=69,
+mnrlistewirdaufbereitet=190;INT VAR mnrallgemein;TEXT VAR mnrzusatz;TEXT 
+CONST mark:="#";LET niltext="",punkt=".",querstrich="/",blank=" ",
+blankklammer=" )",doppelpunkt=":",null=0,neuangemeldete="N",allederjgst="",
+ohneneuang="O";BOOL VAR bildschirmausgabe,kurswahlen,lsundneue,nurneue,nurls,
+bestimmtekursart;TEXT VAR dbsj,dbhj,dbjgst,fuerkwsj,fuerhj,fuerjgst,jgstls,
+jgstneu,hilfsstring,kursart,klausur,kennung,fachart,lvart,fachkennung1,
+fachkennung2,fachart1,fachart2,kursart1,kursart2;LET maxkurse=200,maxspalten=
+13;TEXT CONST ueberschrift3:="-------:"+13*"----+";TEXT VAR ueberschrift1,
+ueberschrift2,zeile;LET ausgfeldlaenge=1,AUSGFELD =ROW ausgfeldlaengeTEXT ,
+AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;
+AUSGKOPFDRUCK VAR ausgkopfdruck;LET ausgkopflaenge=2,ueberschriftenzeilen=2;
+TEXT CONST kopfueb1teil1:="Wahlergebnis für Jgst. ",kopfueb1teil2:=
+" im Schuljahr ",kopfueb1teil3:="    (Art/Klausur: ",kopfueb2teil1:=
+"Schüler der jetzigen Jgst. ",kopfueb2teil2:=" und der ",kopfueb2teil3:=
+"Neuangemeldeten zur Jgst. ";TEXT VAR textueb1:="",textueb2:="";INT VAR 
+status,dbstatusmerker,zaehler,x,y,z,anzangebote,anztabellen,anzspaltenschluss
+,anfang,ende,zeilenzaehler,druckzeilenzahl;LET datenraum="datenraum";LET 
+ZEILE =STRUCT (TEXT angebot,ROW maxkurseINT anzahl);BOUND ROW maxkurseZEILE 
+VAR zeilespalte;ROW maxspaltenINT VAR summen;PROC 
+kurskombinationmaskebearbeiten:standardvproc(maske);END PROC 
+kurskombinationmaskebearbeiten;PROC kurskombinationggferstellen:lsundneue:=
+FALSE ;nurls:=FALSE ;nurneue:=FALSE ;standardmeldung(mnrbittewarten,niltext);
+standardpruefe(5,fnr9bs,fnr10dr,null,niltext,status);IF status<>0THEN infeld(
+status);return(1)ELSE fuerjgst:=standardmaskenfeld(fnr2fuerjgst);fuerhj:=
+standardmaskenfeld(fnr3fuerhj);jgstls:=standardmaskenfeld(fnr4jgstls);jgstneu
+:=standardmaskenfeld(fnr5jgstneu);IF NOT eingabenzujgstundhjkorrektTHEN 
+standardmeldung(mnrallgemein,niltext);return(1);ELSE kursart:=
+standardmaskenfeld(fnr7bestart);klausur:=standardmaskenfeld(fnr8klausur);
+bestimmtekursart:=kursart<>niltext;kurswahlen:=standardmaskenfeld(
+fnr6kurswahl)<>niltext;bildschirmausgabe:=standardmaskenfeld(fnr10dr)=niltext
+;IF NOT datenraumfürgewaehltessjdaTHEN standardmeldung(mnrkeinekwdatenda,
+niltext);return(1);ELSE IF angebotelvsoderfaecherimrowTHEN 
+druckdateifuellenundausgebenELSE standardmeldung(mnrkeinedbdatenda,mnrzusatz+
+mark);return(1)FI ;FI ;FI ;FI ;.eingabenzujgstundhjkorrekt:dbhj:=
+schulkenndatum("Schulhalbjahr");dbsj:=schulkenndatum("Schuljahr");INT VAR 
+jgst;standardpruefe(2,fnr2fuerjgst,null,null,niltext,status);IF status<>0
+THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int(fuerjgst);IF jgst<11COR 
+jgst>13THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;IF fuerhj<>"1"AND fuerhj<>"2"THEN 
+mnrallgemein:=mnrhjfalsch;infeld(fnr3fuerhj);LEAVE eingabenzujgstundhjkorrekt
+WITH FALSE FI ;IF jgstls=niltextAND jgstneu=niltextTHEN mnrallgemein:=
+mnrjgstfehlt;infeld(fnr4jgstls);LEAVE eingabenzujgstundhjkorrektWITH FALSE 
+FI ;jgst:=int(jgstls);IF jgstls<>niltextTHEN standardpruefe(2,fnr4jgstls,null
+,null,niltext,status);IF status<>0COR (jgst<10COR jgst>13)THEN mnrallgemein:=
+mnrjgstfalsch;infeld(fnr4jgstls);LEAVE eingabenzujgstundhjkorrektWITH FALSE 
+FI ;FI ;jgst:=int(jgstneu);IF jgstneu<>niltextTHEN standardpruefe(2,
+fnr5jgstneu,null,null,niltext,status);IF status<>0COR (jgst<11COR jgst>13)
+THEN mnrallgemein:=mnrhjfalsch;infeld(fnr5jgstneu);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;IF jgstls<>niltextAND jgstneu<>
+niltextTHEN IF int(jgstls)+1=int(jgstneu)AND jgstneu<=fuerjgstTHEN lsundneue
+:=TRUE ELSE mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;ELIF jgstls=niltextTHEN IF jgstneu>
+fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE ELSE nurneue:=TRUE FI ;ELSE IF jgstls>
+fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE ELIF (jgstls="10"AND dbhj="1")COR (
+jgstls=fuerjgstAND fuerhj<dbhj)THEN mnrallgemein:=mnrhjfalsch;infeld(
+fnr3fuerhj);LEAVE eingabenzujgstundhjkorrektWITH FALSE ELSE nurls:=TRUE ;FI ;
+FI ;mnrallgemein:=1;TRUE .datenraumfürgewaehltessjda:BOOL VAR ok:=FALSE ;INT 
+VAR fehler;IF nurneueTHEN jgstls:=text(int(jgstneu)-1);kurswahlinitialisieren
+(jgstls,fuerjgst,fuerhj,neuangemeldete,fuerkwsj);kurswahlbasisholen(fehler);
+ok:=fehler=0;ELIF lsundneueTHEN kurswahlinitialisieren(jgstls,fuerjgst,fuerhj
+,allederjgst,fuerkwsj);kurswahlbasisholen(fehler);ok:=fehler=0;ELSE 
+kurswahlinitialisieren(jgstls,fuerjgst,fuerhj,ohneneuang,fuerkwsj);
+kurswahlbasisholen(fehler);ok:=fehler=0;FI ;okEND PROC 
+kurskombinationggferstellen;PROC kurskombinationendrucken(BOOL CONST 
+nachbsausgabe):IF nachbsausgabeTHEN rename("Kurskombinationen auszaehlen",
+"liste.1");FILE VAR f:=sequentialfile(output,"liste.1");output(f);
+drucknachbereiten;return(2);ELSE drucknachbereiten;return(1);FI ;
+standardmeldung(mnrlistewirdgedruckt,niltext);forget(datenraum,quiet);forget(
+"liste.1",quiet);END PROC kurskombinationendrucken;PROC kurskombinationzeigen
+:IF exists("liste.1")THEN rename("liste.1","Kurskombinationen auszaehlen")FI 
+;zeigedatei("Kurskombinationen auszaehlen","a");forget(datenraum,quiet);END 
+PROC kurskombinationzeigen;BOOL PROC angebotelvsoderfaecherimrow:BOOL VAR 
+angeboteda;forget("datenraum",quiet);forget("Kurskombinationen auszaehlen",
+quiet);zeilespalte:=new(datenraum);IF (nurlsAND fuerhj=dbhjAND fuerkwsj=dbsj)
+THEN dbjgst:=jgstlsELSE IF nurlsCOR lsundneueTHEN IF dbhj="2"THEN dbjgst:=
+text(int(jgstls)+1)ELSE dbjgst:=jgstlsFI ;ELSE IF dbhj="2"THEN dbjgst:=
+jgstneuELSE dbjgst:=text(int(jgstneu)-1)FI ;FI ;geplanteshjundsjberechnen(
+dbhj,dbsj);FI ;anzangebote:=0;zeilespalte(1).angebot:=niltext;IF kurswahlen
+THEN mnrzusatz:="Datei Lehrveranstaltungen";inittupel(dnrlehrveranstaltungen)
+;putwert(fnrlvjgst,dbjgst);statleseschleife(dnrlehrveranstaltungen,dbsj,dbhj,
+fnrlvsj,fnrlvhj,PROC angebotlvmerken);ELSE mnrzusatz:="Datei Fächerangebot";
+inittupel(dnrfaecherangebot);putwert(fnrfangjgst,dbjgst);statleseschleife(
+dnrfaecherangebot,dbsj,dbhj,fnrfangsj,fnrfanghj,PROC angebotfangmerken);FI ;
+angeboteda:=anzangebote>0;angebotedaEND PROC angebotelvsoderfaecherimrow;
+PROC angebotlvmerken(BOOL VAR ende):IF status<>0COR wert(fnrlvjgst)<>dbjgst
+THEN ende:=TRUE ;ELSE lvart:=wert(fnrlvart);IF (NOT bestimmtekursart)COR 
+lvart=kursartTHEN anzangeboteINCR 1;zeilespalte(anzangebote).angebot:=text(
+wert(fnrlvfachkennung),6)+lvart;FI ;FI ;END PROC angebotlvmerken;PROC 
+angebotfangmerken(BOOL VAR ende):IF status<>0COR wert(fnrfangjgst)<>dbjgst
+THEN ende:=TRUE ;ELSE fachart:=wert(fnrfangart);IF (NOT bestimmtekursart)COR 
+fachart=kursartTHEN anzangeboteINCR 1;zeilespalte(anzangebote).angebot:=text(
+wert(fnrfangfach),2)+fachart;FI ;FI ;END PROC angebotfangmerken;PROC 
+druckdateifuellenundausgeben:zeilenzaehler:=0;standardmeldung(
+mnrlistewirdaufbereitet,niltext);wahldatenauskwdatenrauminrowablegen;
+anztabellen:=anzangeboteDIV maxspalten;anzspaltenschluss:=anzangeboteMOD 
+maxspalten;ueberschriftenimdruckkopfbauen;variablenfuerdrucksetzen;
+druckvorbereiten;initdruckkopf(textueb1,textueb2);FOR zFROM 1UPTO anztabellen
+REP ende:=z*maxspalten;anfang:=ende-(maxspalten-1);
+tabellevonbisspalteausgeben(maxspalten);IF z<anztabellenTHEN seitenwechselFI 
+;PER ;IF anzspaltenschluss<>0THEN IF anztabellen<>0THEN anfang:=ende+1;
+seitenwechselELSE anfang:=1FI ;ende:=anzangebote;tabellevonbisspalteausgeben(
+anzspaltenschluss);FI ;IF bildschirmausgabeTHEN kurskombinationzeigenELSE 
+kurskombinationendrucken(FALSE )FI ;.variablenfuerdrucksetzen:druckzeilenzahl
+:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.
+ueberschriftenimdruckkopfbauen:textueb1:=kopfueb1teil1;textueb1CAT fuerjgst;
+textueb1CAT punkt;textueb1CAT fuerhj;textueb1CAT kopfueb1teil2;textueb1CAT 
+subtext(fuerkwsj,1,2)+querstrich;textueb1CAT subtext(fuerkwsj,3,4);IF 
+bestimmtekursartOR klausur<>niltextTHEN textueb1CAT kopfueb1teil3;textueb1
+CAT kursart+querstrich;textueb1CAT klausur+blankklammer;FI ;IF NOT (fuerhj=
+dbhjAND fuerjgst=jgstls)THEN geplanteshjundsjberechnen(dbhj,dbsj);FI ;IF 
+nurneueTHEN textueb2:=kopfueb2teil3;textueb2CAT jgstneu;ELSE textueb2:=
+kopfueb2teil1;textueb2CAT jgstls;IF lsundneueTHEN textueb2CAT kopfueb2teil2;
+textueb2CAT kopfueb2teil3;textueb2CAT jgstneu;FI ;FI ;END PROC 
+druckdateifuellenundausgeben;PROC wahldatenauskwdatenrauminrowablegen:FOR x
+FROM 1UPTO anzangeboteREP y:=1;IF kurswahlenTHEN WHILE y<=xREP 
+kombiationenlvsmerken(x,y);yINCR 1;PER ;ELSE WHILE y<=xREP 
+kombinationenfaechermerken(x,y);yINCR 1;PER ;FI ;PER ;END PROC 
+wahldatenauskwdatenrauminrowablegen;PROC kombiationenlvsmerken(INT CONST zeil
+,spal):fachkennung1:=zeilespalte(zeil).angebot;fachkennung2:=zeilespalte(spal
+).angebot;IF NOT bestimmtekursartTHEN kursart1:=subtext(fachkennung1,7,7);
+kursart2:=subtext(fachkennung2,7,7);ELSE kursart1:=kursart;kursart2:=kursart
+FI ;dbstatusmerker:=dbstatus;zeilespalte(zeil).anzahl(spal):=
+anzahlschuelermitwahl(subtext(fachkennung1,1,2),subtext(fachkennung1,3,6),
+kursart1,klausur,subtext(fachkennung2,1,2),subtext(fachkennung2,3,6),kursart2
+,klausur);dbstatus(dbstatusmerker);END PROC kombiationenlvsmerken;PROC 
+kombinationenfaechermerken(INT CONST zeil,spal):fachart1:=zeilespalte(zeil).
+angebot;fachart2:=zeilespalte(spal).angebot;IF bestimmtekursartTHEN kursart1
+:=kursart;kursart2:=kursart;ELSE kursart1:=subtext(fachart1,3,3);kursart2:=
+subtext(fachart2,3,3);FI ;kennung:=niltext;dbstatusmerker:=dbstatus;
+zeilespalte(zeil).anzahl(spal):=anzahlschuelermitwahl(subtext(fachart1,1,2),
+kennung,kursart1,klausur,subtext(fachart2,1,2),kennung,kursart2,klausur);
+dbstatus(dbstatusmerker);END PROC kombinationenfaechermerken;PROC 
+tabellevonbisspalteausgeben(INT CONST spaltenzahl):INT VAR s,kombinationen;
+FOR sFROM 1UPTO maxspaltenREP summen(s):=0PER ;zeilenzaehler:=0;ueberschrift1
+:="       :";ueberschrift2:="       :";FOR zaehlerFROM anfangUPTO endeREP 
+ueberschrift1CAT text(zeilespalte(zaehler).angebot,2)+"  :";IF NOT kurswahlen
+THEN ueberschrift2CAT subtext(zeilespalte(zaehler).angebot,3,3)+"   :";ELSE 
+ueberschrift2CAT subtext(zeilespalte(zaehler).angebot,3,6)+":";FI ;PER ;
+druckkopfschreiben;setzemitseitennummern(TRUE );druckzeileschreiben(
+ueberschrift1);druckzeileschreiben(ueberschrift2);druckzeileschreiben(
+ueberschrift3);zeilenzaehlerINCR 12;FOR zaehlerFROM 1UPTO anzangeboteREP s:=1
+;hilfsstring:=zeilespalte(zaehler).angebot;zeile:=text(hilfsstring,2)+blank;
+IF kurswahlenTHEN zeileCAT subtext(hilfsstring,3,6)+doppelpunkt;ELSE zeile
+CAT subtext(hilfsstring,3,3)+3*blank+doppelpunktFI ;FOR xFROM anfangUPTO ende
+REP IF x<zaehlerTHEN kombinationen:=zeilespalte(zaehler).anzahl(x);zeileCAT 
+text(kombinationen,3)+blank+doppelpunkt;summen(s)INCR kombinationen;ELIF x=
+zaehlerTHEN zeileCAT "  * :"ELSE kombinationen:=zeilespalte(x).anzahl(zaehler
+);zeileCAT text(kombinationen,3)+" :";summen(s)INCR kombinationen;FI ;sINCR 1
+;PER ;zeilenzaehlerINCR 1;IF drucklaenge-1=zeilenzaehlerTHEN seitenwechsel;
+druckzeileschreiben(ueberschrift1);druckzeileschreiben(ueberschrift2);
+druckzeileschreiben(ueberschrift3);zeilenzaehler:=4;FI ;druckzeileschreiben(
+zeile);PER ;druckzeileschreiben(ueberschrift3);zeile:="Summe  :";FOR sFROM 1
+UPTO spaltenzahlREP zeileCAT text(summen(s),3)+blank+doppelpunkt;PER ;
+zeilenzaehlerINCR 2;druckzeileschreiben(zeile);END PROC 
+tabellevonbisspalteausgeben;END PACKET likwkurskombinatilonensek2
+
diff --git a/app/schulis/2.2.1/src/2.likw schuelerwahl sek2 b/app/schulis/2.2.1/src/2.likw schuelerwahl sek2
new file mode 100644
index 0000000..7b395a3
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.likw schuelerwahl sek2
@@ -0,0 +1,173 @@
+PACKET likwschuelerwahlsek2DEFINES kurswahlauszaehlenspezielleteile:LET 
+AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,
+AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR 
+ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;#K onstantenzurM askenbearbeitung#
+LET maskeschuelerwahl="ms schuelerwahl auszaehlen sek2 eingang",fnr2fuerjgst=
+2,fnr3fuerhj=3,fnr4jgstls=4,fnr5jgstneu=5,fnr6kurswahl=6,fnr7bs=7,fnr8dr=8,
+ausgfeldlaenge=1,anzahlobjekteprobildschirm=13,ueberschriftenzeilen=2,#
+imstand.D ruckkopf#ausgkopflaenge=2,spaltentrenner=" :",spaltenbreite1=7,
+spaltenbreite2=6,spaltenbreite3bis13=3,bsanfpos=2,klausurbestand=
+"c02 abitur klausur";TEXT CONST kopfueb1teil1:="Wahlergebnis für Jgst. ",
+kopfueb1teil2:=" im Schuljahr ",kopfueb2teil1:="Schüler der jetzigen Jgst. ",
+kopfueb2teil2:=" und der ",kopfueb2teil3:="Neuangemeldeten zur Jgst. ",
+unterstreichung:="--------+-------+"+11*"----+",tabueb1:="Angebot  gewählt ";
+TEXT VAR tabueb2,kwsek2auszaehlenueb:="Wahlergebnis auszählen",klausurkuerzel
+,textueb1:="",textueb2:="";INT VAR bildanfang,druckzeilenzahl,status,
+dbstatusmerker,aktuellerindex,feldnr;LET mnrjgstfalsch=404,mnrjgstfehlt=172,
+mnrhjfalsch=405,mnrkeinekwdatenda=406,mnrkeinekuerzelda=408,
+mnrbearbeitetwerden=352,mnrbittewarten=69;INT VAR mnrallgemein;LET niltext=""
+,punkt=".",querstrich="/",blank=" ",vierblank="    ",null=0,maxkuerzel=11,
+zwoelf=12;ROW zwoelfINT VAR gesamtundeinzelsummen;INT VAR anzkuerzel,x;LET 
+neuangemeldete="N",allederjgst="",ohneneuang="O";BOOL VAR bildschirmausgabe,
+kurswahlen,nurls,lsundneue,nurneue;TEXT VAR dbsj,dbhj,dbjgst,fuerkwsj,
+fuerjgst:="",fuerhj:="",jgstls:="",jgstneu:="",fach,art,kennung,klkuerzel;
+BOOL PROC multistop:IF kurswahlenTHEN dbstatus=0AND dbjgst=wert(fnrlvjgst)
+AND dbsj=wert(fnrlvsj)AND dbhj=wert(fnrlvhj)ELSE dbstatus=0AND dbjgst=wert(
+fnrfangjgst)AND dbsj=wert(fnrfangsj)AND dbhj=wert(fnrfanghj)FI END PROC 
+multistop;BOOL PROC multistopsim:BOOL VAR b;setzebestandende(FALSE );b:=
+multistop;IF NOT multistopTHEN setzebestandende(TRUE )FI ;bEND PROC 
+multistopsim;PROC kurswahlauszaehlenspezielleteile(INT CONST nr):SELECT nrOF 
+CASE 1:kwsek2auszaehlendialogvorbereitenCASE 2:
+kwsek2auszaehleneingabenrichtigCASE 3:kwsek2auszaehlenlistenvorbereitenCASE 4
+:kwsek2auszaehlendruckvorbereitenCASE 5:kwsek2auszaehlenseitedruckenCASE 6:
+kwsek2auszaehlenbildschirmvorbereitenCASE 7:kwsek2auszaehlenseitezeigen
+ENDSELECT .END PROC kurswahlauszaehlenspezielleteile;PROC 
+kwsek2auszaehlendialogvorbereiten:kwsek2auszaehlenueb:=text(vergleichsknoten)
+;setzeanfangswerte(maskeschuelerwahl,bsanfpos)END PROC 
+kwsek2auszaehlendialogvorbereiten;PROC kwsek2auszaehleneingabenrichtig:nurls
+:=FALSE ;lsundneue:=FALSE ;nurneue:=FALSE ;standardmeldung(mnrbittewarten,
+niltext);standardpruefe(5,fnr7bs,fnr8dr,null,niltext,status);IF status<>0
+THEN infeld(status);setzeeingabetest(FALSE )ELSE fuerjgst:=standardmaskenfeld
+(fnr2fuerjgst);fuerhj:=standardmaskenfeld(fnr3fuerhj);jgstls:=
+standardmaskenfeld(fnr4jgstls);jgstneu:=standardmaskenfeld(fnr5jgstneu);IF 
+NOT eingabenzujgstundhjkorrektTHEN standardmeldung(mnrallgemein,niltext);
+setzeeingabetest(FALSE )ELSE kurswahlen:=standardmaskenfeld(fnr6kurswahl)<>
+niltext;bildschirmausgabe:=standardmaskenfeld(fnr8dr)=niltext;IF NOT (
+datenraumfürgewaehltessjda)THEN standardmeldung(mnrkeinekwdatenda,niltext);
+setzeeingabetest(FALSE )ELSE IF keineklausurkuerzelvorhandenTHEN 
+standardmeldung(mnrkeinekuerzelda,niltext);setzeeingabetest(FALSE )ELSE 
+setzeeingabetest(TRUE );setzeausgabedrucker(NOT bildschirmausgabe)FI ;FI ;FI 
+;FI ;.keineklausurkuerzelvorhanden:BOOL VAR nix:=TRUE ;klausurkuerzel:=
+niltext;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,klausurbestand);
+search(dnrschluessel,FALSE );anzkuerzel:=0;IF dbstatus<>0COR wert(
+fnrschlsachgebiet)<>klausurbestandTHEN LEAVE keineklausurkuerzelvorhanden
+WITH nixELSE FOR xFROM 1UPTO maxkuerzelREP IF wert(fnrschlsachgebiet)=
+klausurbestandTHEN klausurkuerzelCAT wert(fnrschlschluessel);anzkuerzelINCR 1
+;succ(dnrschluessel)FI ;PER ;FI ;nix:=anzkuerzel=0;nix.
+eingabenzujgstundhjkorrekt:dbhj:=schulkenndatum("Schulhalbjahr");dbsj:=
+schulkenndatum("Schuljahr");INT VAR jgst;standardpruefe(2,fnr2fuerjgst,null,
+null,niltext,status);IF status<>0THEN mnrallgemein:=mnrjgstfalsch;infeld(
+fnr2fuerjgst);LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int(
+fuerjgst);IF jgst<11COR jgst>13THEN mnrallgemein:=mnrjgstfalsch;infeld(
+fnr2fuerjgst);LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;IF fuerhj<>"1"
+AND fuerhj<>"2"THEN mnrallgemein:=mnrhjfalsch;infeld(fnr3fuerhj);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;IF jgstls=niltextAND jgstneu=niltext
+THEN mnrallgemein:=mnrjgstfehlt;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;jgst:=int(jgstls);IF jgstls<>niltext
+THEN standardpruefe(2,fnr4jgstls,null,null,niltext,status);IF status<>0COR (
+jgst<10COR jgst>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;jgst:=int(jgstneu);IF jgstneu<>
+niltextTHEN standardpruefe(2,fnr5jgstneu,null,null,niltext,status);IF status
+<>0COR (jgst<11COR jgst>13)THEN mnrallgemein:=mnrhjfalsch;infeld(fnr5jgstneu)
+;LEAVE eingabenzujgstundhjkorrektWITH FALSE FI ;FI ;IF jgstls<>niltextAND 
+jgstneu<>niltextTHEN IF int(jgstls)+1=int(jgstneu)AND jgstneu<=fuerjgstTHEN 
+lsundneue:=TRUE ELSE mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE FI ;ELIF jgstls=niltextTHEN IF jgstneu>
+fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr4jgstls);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE ELSE nurneue:=TRUE FI ;ELSE IF jgstls>
+fuerjgstTHEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2fuerjgst);LEAVE 
+eingabenzujgstundhjkorrektWITH FALSE ELIF (jgstls="10"AND dbhj="1")COR (
+jgstls=fuerjgstAND fuerhj<dbhj)THEN mnrallgemein:=mnrhjfalsch;infeld(
+fnr3fuerhj);LEAVE eingabenzujgstundhjkorrektWITH FALSE ELSE nurls:=TRUE ;FI ;
+FI ;mnrallgemein:=1;TRUE .datenraumfürgewaehltessjda:BOOL VAR ok:=FALSE ;INT 
+VAR fehler;IF nurneueTHEN jgstls:=text(int(jgstneu)-1);kurswahlinitialisieren
+(jgstls,fuerjgst,fuerhj,neuangemeldete,fuerkwsj);kurswahlbasisholen(fehler);
+ok:=fehler=0;ELIF lsundneueTHEN kurswahlinitialisieren(jgstls,fuerjgst,fuerhj
+,allederjgst,fuerkwsj);kurswahlbasisholen(fehler);ok:=fehler=0;ELSE 
+kurswahlinitialisieren(jgstls,fuerjgst,fuerhj,ohneneuang,fuerkwsj);
+kurswahlbasisholen(fehler);ok:=fehler=0;FI ;okEND PROC 
+kwsek2auszaehleneingabenrichtig;PROC kwsek2auszaehlenlistenvorbereiten:BOOL 
+VAR b;initspalten;setzespaltentrenner(spaltentrenner);textueb1:=kopfueb1teil1
+;textueb1CAT fuerjgst;textueb1CAT punkt;textueb1CAT fuerhj;textueb1CAT 
+kopfueb1teil2;textueb1CAT subtext(fuerkwsj,1,2)+querstrich;textueb1CAT 
+subtext(fuerkwsj,3,4);IF kurswahlenTHEN tabueb2:="Kurs     gesamt";ELSE 
+tabueb2:="Fach     gesamt";FI ;FOR xFROM 1UPTO anzkuerzelREP tabueb2CAT 
+vierblank;tabueb2CAT subtext(klausurkuerzel,x,x);PER ;IF (nurlsAND fuerhj=
+dbhjAND fuerjgst=jgstls)THEN dbjgst:=jgstlsELSE IF nurlsCOR lsundneueTHEN IF 
+dbhj="2"THEN dbjgst:=text(int(jgstls)+1)ELSE dbjgst:=jgstlsFI ;ELSE IF dbhj=
+"2"THEN dbjgst:=jgstneuELSE dbjgst:=text(int(jgstneu)-1)FI ;FI ;
+geplanteshjundsjberechnen(dbhj,dbsj);FI ;IF nurneueTHEN textueb2:=
+kopfueb2teil3;textueb2CAT jgstneu;ELSE textueb2:=kopfueb2teil1;textueb2CAT 
+jgstls;IF lsundneueTHEN textueb2CAT kopfueb2teil2;textueb2CAT kopfueb2teil3;
+textueb2CAT jgstneu;FI ;FI ;IF kurswahlenTHEN aktuellerindex:=
+dnrlehrveranstaltungen;inittupel(aktuellerindex);feldnr:=fnrlvfachkennung;
+putwert(fnrlvsj,dbsj);putwert(fnrlvhj,dbhj);putwert(fnrlvjgst,dbjgst);
+setzescanendewert("�");ELSE aktuellerindex:=dnrfaecherangebot;inittupel(
+aktuellerindex);feldnr:=fnrfanglfdnr;putwert(fnrfangsj,dbsj);putwert(
+fnrfanghj,dbhj);putwert(fnrfangjgst,dbjgst);setzescanendewert("255");FI ;
+setzeidentiwert("");initobli(anzahlobjekteprobildschirm);objektlistestarten(
+aktuellerindex,dbsj,feldnr,TRUE ,b);setzebestandende(NOT multistopCOR b);END 
+PROC kwsek2auszaehlenlistenvorbereiten;PROC 
+kwsek2auszaehlenbildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(kwsek2auszaehlenueb);bildanfang:=fnrausganf;
+setzebildanfangsposition(bildanfang);initspalten;setzespaltenbreite(
+bildbreite);spaltenweise(textueb1);ausgfeld(1):=zeile;ausgfeld(1)IN 
+ausgabepos;erhoeheausgabeposumeins;spaltenweise(textueb2);ausgfeld(1):=zeile;
+ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;erhoeheausgabeposumeins;
+spaltenweise(tabueb1);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;spaltenweise(tabueb2);ausgfeld(1):=zeile;ausgfeld(1)
+IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(unterstreichung);ausgfeld(
+1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+setzebildanfangsposition(8);initspalten;spaltendefinierenEND PROC 
+kwsek2auszaehlenbildschirmvorbereiten;PROC kwsek2auszaehlenseitezeigen:
+blaettern(PROC (INT CONST )kwwahldatensek2zeigen,aktion,TRUE ,TRUE ,BOOL 
+PROC multistop)END PROC kwsek2auszaehlenseitezeigen;PROC 
+kwwahldatensek2zeigen(INT CONST x):kwwahldatensek2holen;
+kwwahldatensek2aufbereiten;kwwahldatensek2aufbildschirm;END PROC 
+kwwahldatensek2zeigen;PROC kwwahldatensek2aufbildschirm:INT VAR i;FOR iFROM 1
+UPTO ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeins;PER ;END PROC kwwahldatensek2aufbildschirm;PROC 
+kwsek2auszaehlendruckvorbereiten:setzebestandende(FALSE );druckvorbereiten;
+variablenfuerdrucksetzen;IF kurswahlenTHEN inittupel(dnrlehrveranstaltungen);
+putwert(fnrlvsj,dbsj);putwert(fnrlvhj,dbhj);putwert(fnrlvjgst,dbjgst);
+setzescanendewert("�");ELSE inittupel(dnrfaecherangebot);putwert(fnrfangsj,
+dbsj);putwert(fnrfanghj,dbhj);putwert(fnrfangjgst,dbjgst);setzescanendewert(
+"255");FI ;initdruckkopf(textueb1,textueb2);initausgabekopfdruck;
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistopsim);.variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+kwsek2auszaehlendruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):=
+tabueb1;ausgkopfdruck(2):=tabueb2;END PROC initausgabekopfdruck;PROC 
+kwsek2auszaehlenseitedrucken:kwwahldatensek2ueberschriftdrucken;initspalten;
+spaltendefinieren;seitedrucken(PROC (INT VAR )kwwahldatensek2drucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END 
+PROC kwsek2auszaehlenseitedrucken;PROC kwwahldatensek2ueberschriftdrucken:
+INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP 
+druckzeileschreiben(ausgkopfdruck(i))PER ;druckzeileschreiben(unterstreichung
+);END PROC kwwahldatensek2ueberschriftdrucken;PROC kwwahldatensek2drucken(
+INT VAR zeilenzaehler):LET markiert="#";kwwahldatensek2holen;standardmeldung(
+mnrbearbeitetwerden,fach+markiert);kwwahldatensek2aufbereiten;ausgfeld(1):=
+zeile;zeilenzaehlerINCR ausgfeldlaenge;kwwahldatensek2indruckdatei;END PROC 
+kwwahldatensek2drucken;PROC kwwahldatensek2indruckdatei:INT VAR i;FOR iFROM 1
+UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC 
+kwwahldatensek2indruckdatei;PROC spaltendefinieren:INT VAR x;initspalten;
+setzespaltentrenner(spaltentrenner);setzespaltenbreite(spaltenbreite1);
+setzespaltenbreite(spaltenbreite2);FOR xFROM 1UPTO maxkuerzelREP 
+setzespaltenbreite(spaltenbreite3bis13)PER ;END PROC spaltendefinieren;PROC 
+kwwahldatensek2holen:TEXT VAR hilfstext;dbstatusmerker:=dbstatus;IF 
+kurswahlenTHEN hilfstext:=wert(fnrlvfachkennung);fach:=subtext(hilfstext,1,2)
+;kennung:=subtext(hilfstext,3,6);gesamtundeinzelsummen(1):=
+anzahlschuelermitwahl(fach,kennung,niltext,niltext);FOR xFROM 2UPTO 
+anzkuerzel+1REP klkuerzel:=subtext(klausurkuerzel,x-1,x-1);
+gesamtundeinzelsummen(x):=anzahlschuelermitwahl(fach,kennung,niltext,
+klkuerzel);PER ;ELSE fach:=text(wert(fnrfangfach),2);art:=wert(fnrfangart);
+gesamtundeinzelsummen(1):=anzahlschuelermitwahl(fach,niltext,art,niltext);
+FOR xFROM 2UPTO anzkuerzel+1REP klkuerzel:=subtext(klausurkuerzel,x-1,x-1);
+gesamtundeinzelsummen(x):=anzahlschuelermitwahl(fach,niltext,art,klkuerzel);
+PER ;FI ;dbstatus(dbstatusmerker);END PROC kwwahldatensek2holen;PROC 
+kwwahldatensek2aufbereiten:INT VAR x;IF kurswahlenTHEN spaltenweise(fach+
+blank+kennung);ELSE spaltenweise(fach+blank+art);FI ;FOR xFROM 1UPTO 
+anzkuerzel+1REP spaltenweise(text(gesamtundeinzelsummen(x),3));PER ;FOR x
+FROM 1UPTO maxkuerzel-anzkuerzelREP spaltenweise(niltext)PER ;END PROC 
+kwwahldatensek2aufbereiten;END PACKET likwschuelerwahlsek2;
+
diff --git a/app/schulis/2.2.1/src/2.likw wahl und kursdaten sek2 b/app/schulis/2.2.1/src/2.likw wahl und kursdaten sek2
new file mode 100644
index 0000000..992c52b
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.likw wahl und kursdaten sek2
@@ -0,0 +1,246 @@
+PACKET likwwahlundkursdatensek2DEFINES wahlundkursdatenmaskebearbeiten,
+wahlundkursdatenggfstarten,wahlundkursdatennaechsteliste,
+wahlundkursdatenabschluss,wahlundkursdatenggfbestandueberankreuzliste,
+wahlundkursdatenblaettern,wahldatenlistenseiteaktualisieren:LET objektmaske=
+"mu objektliste",eingangsmaske="ms wahl und kursdaten sek2 eingang",
+fnr2jgstls=2,fnr3jgstneu=3,fnr4famname=4,fnr5rufname=5,fnr6gebdat=6,fnr7bs=7,
+fnr8dr=8,mnrauswahlnichtsinnvoll=56,mnrlistewirdgedruckt=58,
+mnrdatenexistierennicht=59,mnrbittewarten=69,mnrdruckausgabefuerwirdgedruckt=
+125,mnrschuelernichtimentsprbestand=126,mnralledruckausgabenerstellt=128,
+mnrangabenpraezisieren=129,mnrungueltigesdatum=157,mnrjgstfehlt=172,
+mnrjgstoderschueler=318,mnrjgstfalsch=404,mnrkeinekwdatenda=406,
+mnrkeinedatendain=407,mnrjgstoderbestschueler=422,trenner="�",neuang="N",
+mitneuang="",ohneneuang="O";INT VAR mnrallgemein,egmaskefeldnr,status,erster,
+letzter,aktschueler,zaehler,pos1,pos2;TEXT VAR fach,mnrzusatz,ueb2,hilfstext;
+LET null=0,platzhalter="mehr- fach  ",niltext="",punkt=".",blank=" ",dopp=":"
+,doppblank=": ",blanksdopp="   :";LET maxanzfaecher=100,maxanzschulhj=10;ROW 
+maxanzfaecherROW maxanzschulhjTEXT VAR faecherschulhj;INT VAR ixfaecher,
+ixschulhj,anzfaecher;TEXT VAR uebsj,uebjgst,faecherstring,faecher,kennungen,
+klausuren,punkte,kursarten,zeile1,zeile2;BOOL VAR ankreuzliste,
+bildschirmausgabe,lsundneue,nurneue,nurls,bestschueler,faecherstringok;TEXT 
+VAR sj,hj,kwsj,jgstls,jgstneu,famname,rufname,gebdat;FILE VAR ausgabedatei;
+TEXT CONST ueb1:="Wahl- und Kursdaten von";LET fnrerstesankreuzfeld=2,
+felderprolisteneintrag=2,listeneintraegeproseite=18;LET 
+meldungblaetternnichtmöglich=72;LET dummyschueler="",sunamenstrenner=", ",
+sulaengeohnedatum=60,maxankreuzungen=1000,ankreuzung="x",keineankreuzung="",
+kennungnursuname="N",boolvektordatei="Boolvektor";BOOL VAR bearbeitungingang
+:=FALSE ;BOUND ROW maxankreuzungenBOOL VAR boolvektor;INT VAR aktuellezeile;
+PROC wahlundkursdatenmaskebearbeiten:standardvproc(eingangsmaske);
+ankreuzliste:=FALSE ;END PROC wahlundkursdatenmaskebearbeiten;PROC 
+wahlundkursdatenggfbestandueberankreuzliste:IF plausisallgemokAND 
+plausisspezankreuzokAND kurswahldatenraumdaTHEN ankreuzliste:=TRUE ;
+aktuellezeile:=erster;initboolvektor;standardstartproc(objektmaske);
+listezeigenabzeile(aktuellezeile);wahldatenlistenseiteaktualisieren;ELSE 
+standardmeldung(mnrallgemein,niltext);return(1);FI ;.plausisspezankreuzok:
+BOOL VAR ok:=FALSE ;IF bestschuelerTHEN mnrallgemein:=mnrjgstoderbestschueler
+;infeld(fnr4famname);ELSE ok:=TRUE FI ;ok.initboolvektor:boolvektor:=new(
+boolvektordatei);FOR zaehlerFROM ersterUPTO letzterREP boolvektor(zaehler):=
+FALSE PER ;END PROC wahlundkursdatenggfbestandueberankreuzliste;PROC 
+wahlundkursdatenggfstarten:bearbeitungingang:=FALSE ;IF ankreuzlisteTHEN 
+ersterDECR 1;naechsterindex(erster);startenELSE IF NOT plausisallgemokCOR 
+NOT plausisspezokTHEN standardmeldung(mnrallgemein,niltext);return(1);ELSE 
+startenFI ;FI ;.plausisspezok:IF bestschuelerTHEN IF NOT bestschuelerkorrekt
+THEN standardmeldung(mnrangabenpraezisieren,niltext);infeld(egmaskefeldnr);
+LEAVE plausisspezokWITH FALSE ELSE erster:=1;letzter:=1;FI ;ELSE IF lsundneue
+THEN IF int(jgstls)<>int(jgstneu)-1THEN mnrallgemein:=mnrjgstfalsch;infeld(
+fnr2jgstls);LEAVE plausisspezokWITH FALSE FI ;FI ;IF NOT kurswahldatenraumda
+THEN infeld(fnr2jgstls);LEAVE plausisspezokWITH FALSE FI ;FI ;TRUE .
+bestschuelerkorrekt:IF rufname=niltextTHEN IF gebdat=niltextTHEN IF 
+famnameeindeutigTHEN rufname:=wert(fnrsurufnames);gebdat:=wert(fnrsugebdatums
+);LEAVE bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH 
+FALSE ;FI ;ELSE egmaskefeldnr:=fnr5rufname;mnrallgemein:=
+mnrangabenpraezisieren;LEAVE bestschuelerkorrektWITH FALSE ;FI ;ELSE IF 
+gebdat<>niltextTHEN hilfstext:=subtext(gebdat,1,2);hilfstextCAT punkt;
+hilfstextCAT subtext(gebdat,3,4);hilfstextCAT punkt;hilfstextCAT subtext(
+gebdat,5,6);gebdat:=hilfstext;IF kompletterschluesselokTHEN LEAVE 
+bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH FALSE FI ;
+ELSE IF famnameundrufnameeindeutigTHEN gebdat:=wert(fnrsugebdatums);LEAVE 
+bestschuelerkorrektWITH TRUE ELSE LEAVE bestschuelerkorrektWITH FALSE ;FI ;
+FI ;FI ;TRUE END PROC wahlundkursdatenggfstarten;BOOL PROC famnameeindeutig:
+inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames,
+rufname);putwert(fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search(
+dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameTHEN egmaskefeldnr:=
+fnr4famname;mnrallgemein:=mnrdatenexistierennicht;LEAVE famnameeindeutigWITH 
+FALSE ;ELSE succ(dnrschueler);IF wert(fnrsufamnames)=famnameTHEN 
+egmaskefeldnr:=fnr5rufname;mnrallgemein:=mnrangabenpraezisieren;LEAVE 
+famnameeindeutigWITH FALSE ;ELSE pred(dnrschueler)FI ;FI ;TRUE END PROC 
+famnameeindeutig;BOOL PROC famnameundrufnameeindeutig:inittupel(dnrschueler);
+putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert(
+fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search(dnrschueler,FALSE );
+IF wert(fnrsufamnames)<>famnameCOR wert(fnrsurufnames)<>rufnameTHEN 
+egmaskefeldnr:=fnr4famname;mnrallgemein:=mnrdatenexistierennicht;LEAVE 
+famnameundrufnameeindeutigWITH FALSE ELSE succ(dnrschueler);IF wert(
+fnrsufamnames)=famnameAND wert(fnrsurufnames)=rufnameTHEN egmaskefeldnr:=
+fnr6gebdat;mnrallgemein:=mnrangabenpraezisieren;LEAVE 
+famnameundrufnameeindeutigWITH FALSE ELSE pred(dnrschueler)FI ;FI ;TRUE END 
+PROC famnameundrufnameeindeutig;BOOL PROC kompletterschluesselok:BOOL VAR 
+insek2:=TRUE ;standardpruefe(6,fnr6gebdat,null,null,niltext,status);IF status
+<>0THEN egmaskefeldnr:=fnr6gebdat;mnrallgemein:=mnrungueltigesdatum;LEAVE 
+kompletterschluesselokWITH FALSE ;FI ;hilfstext:=subtext(gebdat,1,2);
+hilfstextCAT punkt;hilfstextCAT subtext(gebdat,3,4);hilfstextCAT punkt;
+hilfstextCAT subtext(gebdat,5,6);gebdat:=hilfstext;inittupel(dnrschueler);
+putwert(fnrsufamnames,famname);putwert(fnrsurufnames,rufname);putwert(
+fnrsugebdatums,gebdat);putwert(fnrsustatuss,"ls");search(dnrschueler,TRUE );
+IF dbstatus<>0COR intwert(fnrsusgrpjgst)<11THEN egmaskefeldnr:=fnr4famname;
+mnrallgemein:=mnrschuelernichtimentsprbestand;insek2:=FALSE FI ;insek2END 
+PROC kompletterschluesselok;PROC starten:aktschueler:=erster;IF 
+bildschirmausgabeTHEN listeaufbereiten;bearbeitungingang:=TRUE ;rename(
+"liste.1","Wahl- und Kursdaten");zeigedatei("Wahl- und Kursdaten","vr");ELSE 
+IF ankreuzlisteTHEN WHILE aktschueler<>0REP 
+listeaufbereitendruckenundloeschenodermeldung;naechsterindex(aktschueler);
+PER ;ankreuzliste:=FALSE ;bearbeitungingang:=FALSE ;forget(boolvektordatei,
+quiet);standardstartproc(eingangsmaske);egmaskenfelderleerenzurueckundmeldung
+(2);ELSE FOR aktschuelerFROM ersterUPTO letzterREP 
+listeaufbereitendruckenundloeschenodermeldung;PER ;
+egmaskenfelderleerenzurueckundmeldung(1);FI ;FI ;END PROC starten;PROC 
+listeaufbereitendruckenundloeschenodermeldung:IF NOT schuelervorhandenTHEN 
+meldungELSE listemitdatenzumschueleraufbereiten;standardmeldung(
+mnrdruckausgabefuerwirdgedruckt,famname+"#");listedrucken;listeloeschen;FI ;
+END PROC listeaufbereitendruckenundloeschenodermeldung;PROC 
+wahlundkursdatennaechsteliste(BOOL CONST drucken):IF druckenTHEN listedrucken
+FI ;listeloeschen;IF ankreuzlisteTHEN naechsterindex(aktschueler);IF 
+aktschueler=0THEN forget(boolvektordatei,quiet);ankreuzliste:=FALSE ;
+standardstartproc(eingangsmaske);egmaskenfelderleerenzurueckundmeldung(3);
+ELSE listeaufbereiten;rename("liste.1","Wahl- und Kursdaten");return(1)FI ;
+ELSE IF aktschueler=letzterTHEN egmaskenfelderleerenzurueckundmeldung(2);
+ELSE aktschuelerINCR 1;listeaufbereiten;rename("liste.1",
+"Wahl- und Kursdaten");return(1);FI ;FI ;END PROC 
+wahlundkursdatennaechsteliste;PROC listeaufbereiten:IF NOT schuelervorhanden
+THEN listeleeraufbereitenELSE listemitdatenzumschueleraufbereiten;FI ;END 
+PROC listeaufbereiten;PROC meldung:mnrzusatz:="Halbjahresdaten";
+standardmeldung(mnrkeinedatendain,mnrzusatz+"#");END PROC meldung;PROC 
+schuelerdatenauskwdatenraumholen(INT CONST index):hilfstext:=
+wahldatenzumindex(index,kennungnursuname);pos1:=pos(hilfstext,trenner);pos2:=
+pos(hilfstext,trenner,pos1+1);famname:=subtext(hilfstext,1,pos1-1);rufname:=
+subtext(hilfstext,pos1+1,pos2-1);gebdat:=subtext(hilfstext,pos2+1,length(
+hilfstext));END PROC schuelerdatenauskwdatenraumholen;PROC 
+listeleeraufbereiten:dateioeffnenunddruckkopfschreiben;putline(ausgabedatei,
+"Keine Halbjahres-Daten vorhanden für: "+rufname+blank+famname)END PROC 
+listeleeraufbereiten;PROC dateioeffnenunddruckkopfschreiben:ausgabedatei:=
+sequentialfile(output,"liste.1");druckvorbereiten;ueb2:=famname;ueb2CAT blank
+;ueb2CAT rufname;ueb2CAT ", geboren am ";ueb2CAT gebdat;initdruckkopf(ueb1,
+ueb2);druckkopfschreiben;END PROC dateioeffnenunddruckkopfschreiben;PROC 
+rowinitialisieren:FOR ixfaecherFROM 1UPTO maxanzfaecherREP FOR ixschulhjFROM 
+1UPTO maxanzschulhjREP faecherschulhj(ixfaecher)(ixschulhj):=niltextPER ;PER 
+;END PROC rowinitialisieren;PROC listemitdatenzumschueleraufbereiten:
+faecherstringok:=FALSE ;rowinitialisieren;dateioeffnenunddruckkopfschreiben;
+uebsj:=5*blank+doppblank;uebjgst:="Fach "+doppblank;ixfaecher:=1;ixschulhj:=0
+;faecherstring:=wert(fnrhjdfach);WHILE dbstatus=0AND wert(fnrhjdfamnames)=
+famnameAND wert(fnrhjdrufnames)=rufnameAND wert(fnrhjdgebdats)=gebdatREP 
+shjueberschriftenmerken;IF compress(faecherstring)=niltextTHEN succ(
+dnrhalbjahresdaten);faecherstring:=wert(fnrhjdfach);ELSE 
+faecherstringaufbereitenundweiterewertelesen;IF faecherstring=faecherTHEN 
+FOR zaehlerFROM 1UPTO anzfaecherREP datenproshjprofachmerken(zaehler);PER ;
+ELSE pos1:=1;zaehler:=1;WHILE pos1<length(faecher)REP fach:=subtext(faecher,
+pos1,pos1+1);pos2:=pos(faecherstring,fach);WHILE pos2<>0AND pos2MOD 2=0REP 
+pos2:=pos(faecherstring,fach,pos2+1);PER ;IF pos2=0THEN anzfaecherINCR 1;
+ixfaecher:=anzfaecher;faecherstringCAT fach;ELSE ixfaecher:=(pos2+1)DIV 2FI ;
+datenproshjprofachmerken(ixfaecher);pos1INCR 2;PER ;FI ;succ(
+dnrhalbjahresdaten);FI ;PER ;ausgabederrowmatrixindatei;.
+shjueberschriftenmerken:ixschulhjINCR 1;hilfstext:=wert(fnrhjdsj);uebsjCAT 
+subtext(hilfstext,1,2);uebsjCAT "/";uebsjCAT subtext(hilfstext,3,4);uebsjCAT 
+doppblank;hilfstext:=text(wert(fnrhjdjgst),2);hilfstextCAT punkt;hilfstext
+CAT wert(fnrhjdhj);uebjgstCAT hilfstext;uebjgstCAT blank+doppblank;.
+faecherstringaufbereitenundweiterewertelesen:IF NOT faecherstringokTHEN 
+zaehler:=1;pos1:=1;WHILE zaehler<length(faecherstring)REP pos1:=pos(
+faecherstring,subtext(faecherstring,zaehler,zaehler+1),zaehler+2);WHILE pos1
+<>0AND pos1MOD 2=0REP pos1:=pos(faecherstring,subtext(faecherstring,zaehler,
+zaehler+1),pos1+1)PER ;IF pos1=0THEN zaehlerINCR 2;ELSE IF pos1MOD 2=1THEN 
+change(faecherstring,pos1,pos1+1,niltext);FI ;FI ;PER ;anzfaecher:=length(
+faecherstring)DIV 2;faecherstringok:=TRUE ;FI ;faecher:=wert(fnrhjdfach);
+kennungen:=wert(fnrhjdlerngrpkenn);klausuren:=wert(fnrhjdklausurteiln);
+kursarten:=wert(fnrhjdkursart);punkte:=wert(fnrhjdnotepunkte);IF punkte=
+niltextTHEN punkte:=length(faecher)*blankFI ;.ausgabederrowmatrixindatei:
+zeile1:=uebsj;druckzeileschreiben(zeile1);zeile1:=uebjgst;druckzeileschreiben
+(zeile1);zeile1:="-----+"+(10*"------+");druckzeileschreiben(zeile1);INT VAR 
+i;i:=1;FOR pos1FROM 1UPTO anzfaecherREP zeile1:=subtext(faecherstring,i,i+1);
+zeile1CAT blanksdopp;zeile2:=2*blank+blanksdopp;FOR zaehlerFROM 1UPTO 
+ixschulhjREP IF faecherschulhj(pos1)(zaehler)=niltextTHEN zeile1CAT 3*blank+
+blanksdopp;zeile2CAT 3*blank+blanksdopp;ELSE zeile1CAT subtext(faecherschulhj
+(pos1)(zaehler),1,6);zeile1CAT dopp;zeile2CAT subtext(faecherschulhj(pos1)(
+zaehler),7,12);zeile2CAT dopp;FI ;PER ;iINCR 2;druckzeileschreiben(zeile1);
+druckzeileschreiben(zeile2);PER ;END PROC listemitdatenzumschueleraufbereiten
+;PROC datenproshjprofachmerken(INT CONST rowindex):IF faecherschulhj(rowindex
+)(ixschulhj)<>niltextTHEN faecherschulhj(rowindex)(ixschulhj):=platzhalter
+ELSE faecherschulhj(rowindex)(ixschulhj):=subtext(kennungen,1,4)+blank+
+subtext(klausuren,1,1)+subtext(punkte,1,2)+blank+blank+subtext(kursarten,1,2)
+;FI ;kennungen:=subtext(kennungen,5,length(kennungen));klausuren:=subtext(
+klausuren,2,length(klausuren));punkte:=subtext(punkte,3,length(punkte));
+kursarten:=subtext(kursarten,3,length(kursarten));END PROC 
+datenproshjprofachmerken;PROC egmaskenfelderleerenzurueckundmeldung(INT 
+CONST stufe):FOR zaehlerFROM 2UPTO 8REP standardmaskenfeld(niltext,zaehler);
+PER ;return(stufe);standardmeldung(mnralledruckausgabenerstellt,niltext);END 
+PROC egmaskenfelderleerenzurueckundmeldung;PROC listedrucken:IF exists(
+"Wahl- und Kursdaten")THEN print("Wahl- und Kursdaten")ELSE print("liste.1");
+FI ;END PROC listedrucken;PROC listeloeschen:forget("Wahl- und Kursdaten",
+quiet);forget("liste.1",quiet)END PROC listeloeschen;PROC 
+wahlundkursdatenblaettern(INT CONST richtung):SELECT richtungOF CASE 1:
+andenanfangCASE 2:eineseitevorCASE 3:eineseitezurueckCASE 4:andasende
+ENDSELECT ;return(1).andenanfang:aktuellezeile:=erster;listezeigenabzeile(
+aktuellezeile);.andasende:aktuellezeile:=max(1,letzter-
+listeneintraegeproseite+1);listezeigenabzeile(aktuellezeile);.eineseitevor:
+IF aktuellezeile+listeneintraegeproseite>letzterTHEN standardmeldung(
+meldungblaetternnichtmöglich,"")ELSE aktuellezeileINCR 
+listeneintraegeproseite;listezeigenabzeile(aktuellezeile)FI ;.
+eineseitezurueck:IF aktuellezeile=ersterTHEN standardmeldung(
+meldungblaetternnichtmöglich,"")ELSE aktuellezeileDECR 
+listeneintraegeproseite;aktuellezeile:=max(aktuellezeile,erster);
+listezeigenabzeile(aktuellezeile)FI ;END PROC wahlundkursdatenblaettern;PROC 
+wahldatenlistenseiteaktualisieren:INT VAR i,fnr;standardnproc;fnr:=
+fnrerstesankreuzfeld;FOR iFROM aktuellezeileUPTO min(aktuellezeile+
+listeneintraegeproseite,letzter)REP boolvektor(i):=standardmaskenfeld(fnr)<>
+niltext;fnrINCR felderprolisteneintragPER END PROC 
+wahldatenlistenseiteaktualisieren;PROC listezeigenabzeile(INT CONST zeile):
+INT VAR i,j1,j2,fnr;TEXT VAR t,t1;fnr:=fnrerstesankreuzfeld;FOR iFROM zeile
+UPTO zeile+listeneintraegeproseiteREP IF i<=letzterTHEN t:=wahldatenzumindex(
+i,kennungnursuname);feldfrei(fnr);IF boolvektor(i)THEN standardmaskenfeld(
+ankreuzung,fnr);ELSE standardmaskenfeld(keineankreuzung,fnr);FI ;
+bereiteschuelerzeileauf;standardmaskenfeld(t1,fnr+1);ELSE standardmaskenfeld(
+niltext,fnr);feldschutz(fnr);standardmaskenfeld(dummyschueler,fnr+1)FI ;fnr
+INCR felderprolisteneintrag;PER ;infeld(fnrerstesankreuzfeld);
+standardfelderausgeben;.bereiteschuelerzeileauf:j1:=pos(t,trenner);j2:=pos(t,
+trenner,j1+1);t1:=text(t,j1-1);t1CAT sunamenstrenner;t1CAT subtext(t,j1+1,j2-
+1);t1:=text(t1,sulaengeohnedatum);t1CAT " ";t1CAT subtext(t,j2+1).END PROC 
+listezeigenabzeile;PROC naechsterindex(INT VAR index):indexINCR 1;WHILE index
+<=letzterCAND NOT boolvektor(index)REP indexINCR 1PER ;IF index>letzterTHEN 
+index:=0FI END PROC naechsterindex;PROC wahlundkursdatenabschluss:INT VAR 
+ruecksprungweite:=1;IF ankreuzlisteTHEN forget(boolvektordatei,quiet);
+ankreuzliste:=FALSE ;ruecksprungweiteINCR 1FI ;IF bearbeitungingangTHEN 
+bearbeitungingang:=FALSE ;ruecksprungweiteINCR 1FI ;listeloeschen;enter(
+ruecksprungweite);END PROC wahlundkursdatenabschluss;BOOL PROC 
+plausisallgemok:standardmeldung(mnrbittewarten,niltext);ankreuzliste:=FALSE ;
+bestschueler:=FALSE ;lsundneue:=FALSE ;nurneue:=FALSE ;nurls:=FALSE ;
+standardpruefe(5,fnr7bs,fnr8dr,null,niltext,status);IF status<>0THEN infeld(
+fnr7bs);mnrallgemein:=mnrauswahlnichtsinnvoll;LEAVE plausisallgemokWITH 
+FALSE FI ;bildschirmausgabe:=standardmaskenfeld(fnr8dr)=niltext;jgstls:=
+standardmaskenfeld(fnr2jgstls);jgstneu:=standardmaskenfeld(fnr3jgstneu);
+famname:=standardmaskenfeld(fnr4famname);rufname:=standardmaskenfeld(
+fnr5rufname);gebdat:=standardmaskenfeld(fnr6gebdat);IF famname<>niltextCOR 
+rufname<>niltextCOR gebdat<>niltextTHEN bestschueler:=TRUE ;IF jgstls<>
+niltextCOR jgstneu<>niltextTHEN infeld(fnr4famname);mnrallgemein:=
+mnrjgstoderbestschueler;LEAVE plausisallgemokWITH FALSE FI ;ELSE IF jgstls=
+niltextAND jgstneu=niltextTHEN infeld(fnr2jgstls);mnrallgemein:=mnrjgstfehlt;
+LEAVE plausisallgemokWITH FALSE ;FI ;IF jgstls<>niltextTHEN standardpruefe(2,
+fnr2jgstls,null,null,niltext,status);IF status<>0COR (int(jgstls)<10COR int(
+jgstls)>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr2jgstls);LEAVE 
+plausisallgemokWITH FALSE ;FI ;FI ;IF jgstneu<>niltextTHEN standardpruefe(2,
+fnr3jgstneu,null,null,niltext,status);IF status<>0COR (int(jgstneu)<11COR int
+(jgstneu)>13)THEN mnrallgemein:=mnrjgstfalsch;infeld(fnr3jgstneu);LEAVE 
+plausisallgemokWITH FALSE ;FI ;FI ;IF jgstls=niltextTHEN nurneue:=TRUE ELIF 
+jgstneu=niltextTHEN nurls:=TRUE ELSE lsundneue:=TRUE FI ;FI ;TRUE END PROC 
+plausisallgemok;BOOL PROC schuelervorhanden:IF NOT bestschuelerTHEN 
+schuelerdatenauskwdatenraumholen(aktschueler);FI ;inittupel(
+dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert(fnrhjdrufnames,
+rufname);putwert(fnrhjdgebdats,gebdat);putwert(fnrhjdsj,niltext);putwert(
+fnrhjdhj,niltext);search(dnrhalbjahresdaten,FALSE );dbstatus=0AND wert(
+fnrhjdfamnames)=famnameAND wert(fnrhjdrufnames)=rufnameAND wert(fnrhjdgebdats
+)=gebdatEND PROC schuelervorhanden;BOOL PROC kurswahldatenraumda:INT VAR 
+fehler;sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");
+IF nurlsTHEN kurswahlinitialisieren(jgstls,jgstls,hj,ohneneuang,kwsj);ELIF 
+nurneueTHEN jgstls:=text(int(jgstneu)-1);kurswahlinitialisieren(jgstls,jgstls
+,hj,neuang,kwsj);ELSE kurswahlinitialisieren(jgstls,jgstls,hj,mitneuang,kwsj)
+FI ;kurswahlbasisholen(fehler);IF fehler<>0THEN mnrallgemein:=
+mnrkeinekwdatenda;infeld(fnr2jgstls);ELSE erster:=ersterschueler;letzter:=
+letzterschuelerFI ;fehler=0END PROC kurswahldatenraumda;END PACKET 
+likwwahlundkursdatensek2
+
diff --git a/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen b/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen
new file mode 100644
index 0000000..32187e4
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.schueler zu kursen zuordnen
@@ -0,0 +1,384 @@
+PACKET schuelerzukursenzuordnenDEFINES schuelerkursenzuordnenabbruch,
+schuelerkursenzuordnenanfang,schuelerkursenzuordnenpruefuebernahme,
+schuelerkursenzuordnenuebernahme,schuelerkursenzuordnenpruefung,
+schuelerkursenzuordnenspeichern,schuelerkursenzuordnenkopieren,
+schuelerkursenzuordnenlisten:LET server="kurswahl server",kuwa2sperre=
+"Kurswahl-2 ",anzschuelerbs=15,laengefakeartkl=9,laengekurs=6,laengedseintrag
+=15,az="#",trenner1="$",trenner2="�",maskeeingang=
+"ms schueler zu kursen zuordnen eingang",maskebearb=
+"ms schueler zu kursen zuordnen bearb",stdzeigbloecke=
+"1  2  3  4  5  6  7  8  9  10 11 ",leerewahldaten="                      ",
+leereweiterewahldaten="    ",kzname="N",kzkurse="K",kznurneue="N",kzohneneue=
+"O",kzalle="A",kennungplanbl="P",kennungfapl="FP",kennungfaartkl="FAk",
+kennungfakeartkl="FKAk",kennungfake="FK",kennungkeinkurs=" -  ",
+kennungkeinfach=" *  ",meldungbearbwird=352,meldungfeldleeren=390,
+meldungunbeklv=360,meldungfeldfuellen=52,meldungschonkurs=424,
+meldungbittewarten=69,meldungfalscherwert=55,meldungspeicherfehler=364,
+meldungjgstfalsch=404,meldungjgstfehlt=172,meldunghjfalsch=405,meldungpruefen
+=329,meldungspeichern=50,meldungnspeichern=63,meldungandereauswahl=318,
+meldungunzulauswahl=56,meldungserverfehler=376,meldunglistezeigen=7,
+meldungparallelanw=425,meldungkeinedaten=68,meldungkeinekopfunktion=318,
+logtext1="Anw. 2.2.2 ",logtext2=" für akt. ",text1="Kurszuordnung ",text2=
+"Kurse übernehmen ",text3=" nach ",punkt=".",felderstername=7,
+felderstekennung=9,feldletztekennung=65,anzfeldereingang=36;INT VAR i,j,z;
+INT VAR letztepos:=2,ijgst,ihj,fstat,aktpos:=1,aktfeld,pos1,pos2,blockpos,
+suchab,jgst1,jgst2,findpos,feld,blpos,kopzeile,aktzeile,anfpos,anzkurse,
+anzsch,endpos,anzschueler,fapos,saktpos,ssuchab;TEXT VAR aktjgst,akthj:="",
+gewjgst,gewhj,zusjgst,zushj,gewsj,alleplblbez,alleschueler1:="",alleschueler2
+:="",wahl,neuewahldaten,weiterewahldaten,wahldaten,alleschueler:="",
+zeigbloecke,fach:="",art:="",kennungdesschuelers,name,kennungjetzt,
+kennungvorher,planbloecke,aktfeldinh,t,nname,vname,gdat,ausgabe:="",block,
+vorz,blockbez,aktkennung,liste:="",kurse,kurs,kennung,kursliste,fakennung,
+fawahl,sname,logmeldung,klkz,klwahl;ROW anzfeldereingangTEXT VAR eingangrow;
+ROW anzschuelerbsROW 4TEXT VAR schueler;BOOL VAR zusspaltezeigen:=FALSE ,
+belegungpruefen:=FALSE ,sperreok,speicherungsfehler:=FALSE ,bewertung,
+klausurkz:=FALSE ;WINDOW VAR w;PROC schuelerkursenzuordnenpruefuebernahme:IF 
+menuedraussenTHEN reorganizescreenFI END PROC 
+schuelerkursenzuordnenpruefuebernahme;PROC schuelerkursenzuordnenuebernahme(
+BOOL CONST uebernehmen):merkeeingangbs;IF uebernehmenTHEN standardmeldung(
+meldungbittewarten,"");aktpos:=1;gewjgst:=eingangrow(2);gewhj:=eingangrow(3);
+ijgst:=int(gewjgst);ihj:=int(gewhj);zusjgst:=eingangrow(35);zushj:=eingangrow
+(36);IF akthj=""THEN akthj:=schulkenndatum("Schulhalbjahr")FI ;prueffeld2und3
+;prueffeld4;prueffeld5;prueffeld634;prueffeld3536;datenholen;
+betrachtealleschueler;logmeldung:=text2;logmeldungCAT zusjgst;logmeldungCAT 
+punkt;logmeldungCAT zushj;logmeldungCAT text3;logmeldungCAT gewjgst;
+logmeldungCAT punkt;logmeldungCAT gewhj;logbucheintragvornehmen(logmeldung);
+kurswahlsperrebeenden(kuwa2sperre)FI ;enter(2).prueffeld2und3:IF gewjgst=""
+THEN fehlermeldungausgeben(2,meldungjgstfehlt,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF gewhj=""THEN fehlermeldungausgeben(2,
+meldunghjfalsch,1);LEAVE schuelerkursenzuordnenuebernahmeELIF jgstfalsch(
+gewjgst,"11")THEN fehlermeldungausgeben(2,meldungjgstfalsch,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF ihj<1COR ihj>2THEN fehlermeldungausgeben
+(3,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenuebernahmeFI .prueffeld4:
+aktfeldinh:=eingangrow(4);IF aktfeldinh=""THEN IF eingangrow(5)=""THEN 
+fehlermeldungausgeben(4,meldungandereauswahl,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELSE LEAVE prueffeld4FI ELIF jgstfalsch(
+gewjgst,aktfeldinh)THEN fehlermeldungausgeben(4,meldungunzulauswahl,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF int(aktfeldinh)=ijgstTHEN pruefhjELIF 
+aktfeldinh="10"CAND akthj="1"THEN fehlermeldungausgeben(4,
+meldungandereauswahl,1);LEAVE schuelerkursenzuordnenuebernahmeFI .pruefhj:IF 
+gewhj="1"CAND akthj="2"THEN fehlermeldungausgeben(3,meldungandereauswahl,1);
+LEAVE schuelerkursenzuordnenuebernahmeFI .prueffeld5:aktfeldinh:=eingangrow(5
+);IF aktfeldinh=""THEN LEAVE prueffeld5ELIF aktfeldinh<>""CAND eingangrow(4)
+<>""THEN IF int(aktfeldinh)<>int(eingangrow(4))+1THEN fehlermeldungausgeben(5
+,meldungunzulauswahl,1);LEAVE schuelerkursenzuordnenuebernahmeFI ELIF int(
+aktfeldinh)>ijgstTHEN fehlermeldungausgeben(5,meldungunzulauswahl,1);LEAVE 
+schuelerkursenzuordnenuebernahmeFI .prueffeld634:FOR iFROM 6UPTO 34REP IF 
+standardmaskenfeld(i)<>""THEN fehlermeldungausgeben(i,meldungfeldleeren,1);
+LEAVE schuelerkursenzuordnenuebernahmeFI PER .prueffeld3536:zusjgst:=
+eingangrow(35);zushj:=eingangrow(36);IF zusjgst=""THEN fehlermeldungausgeben(
+35,meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenuebernahmeELIF zushj=""
+THEN fehlermeldungausgeben(36,meldunghjfalsch,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF zusjgst=gewjgstCAND zushj=gewhjTHEN 
+fehlermeldungausgeben(35,meldungandereauswahl,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF jgstfalsch(zusjgst,"11")THEN 
+fehlermeldungausgeben(35,meldungjgstfalsch,1);LEAVE 
+schuelerkursenzuordnenuebernahmeELIF zushj<>"1"CAND zushj<>"2"THEN 
+fehlermeldungausgeben(36,meldunghjfalsch,1);LEAVE 
+schuelerkursenzuordnenuebernahmeFI .datenholen:IF NOT exists(/server)THEN 
+fehlermeldungausgeben(letztepos,meldungserverfehler,1);LEAVE 
+schuelerkursenzuordnenuebernahmeFI ;IF eingangrow(4)=""THEN t:=kznurneue;
+aktjgst:=text(int(eingangrow(5))-1)ELIF eingangrow(5)=""THEN t:=kzohneneue;
+aktjgst:=eingangrow(4)ELSE t:=kzalle;aktjgst:=eingangrow(4)FI ;
+kurswahlinitialisieren(aktjgst,gewjgst,gewhj,t,gewsj);kurswahlbasisholen(
+fstat);erweitertekurswahlbasisholen(zusjgst,zushj,fstat);kurswahlsperresetzen
+(kuwa2sperre,sperreok);IF NOT sperreokTHEN fehlermeldungausgeben(infeld,
+meldungparallelanw,1);LEAVE schuelerkursenzuordnenuebernahmeFI .
+betrachtealleschueler:FOR iFROM ersterschuelerUPTO letzterschuelerREP 
+wahldaten:=wahldatenzumindex(i,kzkurse);name:=wahldatenzumindex(i,kzname);
+pos1:=pos(name,trenner2,1)-1;pos2:=pos(name,trenner2,pos1+2)-1;nname:=subtext
+(name,1,pos1);vname:=subtext(name,pos1+2,pos2);gdat:=subtext(name,pos2+2,pos2
++9);standardmeldung(meldungbearbwird,vname+" "+nname+az);weiterewahldaten:=
+weiterewahldatenzumschueler(nname,vname,gdat,kennungfakeartkl);
+betrachtekennungen;kurswahl2sichern(fstat)PER .betrachtekennungen:pos1:=1;
+neuewahldaten:="";WHILE pos1<length(wahldaten)REP wahl:=subtext(wahldaten,
+pos1,pos1+laengedseintrag-1);kennungjetzt:=subtext(wahl,6,9);fach:=subtext(
+wahl,4,5);art:=subtext(wahl,2,3);kennungvorher:=kennungvonfach(TRUE );IF 
+kennungjetzt<>kennungvorherTHEN planbloecke:=kursdaten(fach+kennungvorher,
+kennungplanbl);IF dbstatus=0THEN neuewahldatenCAT text(wahl,1);neuewahldaten
+CAT art;neuewahldatenCAT fach;neuewahldatenCAT kennungvorher;neuewahldaten
+CAT planbloeckeELSE neuewahldatenCAT wahlFI ELSE neuewahldatenCAT wahlFI ;
+pos1INCR laengedseintragPER ;IF wahldaten<>neuewahldatenTHEN 
+schuelerwahleintragen(nname,vname,gdat,neuewahldaten)FI .END PROC 
+schuelerkursenzuordnenuebernahme;PROC schuelerkursenzuordnenanfang:
+standardstartproc(maskeeingang);gibeingangaus;standardfelderausgeben;infeld(
+letztepos);standardnproc.gibeingangaus:FOR iFROM 2UPTO anzfeldereingangREP 
+standardmaskenfeld(eingangrow(i),i);IF eingangrow(i)<>""THEN letztepos:=iFI 
+PER .END PROC schuelerkursenzuordnenanfang;PROC 
+schuelerkursenzuordnenpruefung:standardmeldung(meldungbittewarten,"");
+merkeeingangbs;aktpos:=1;gewjgst:=eingangrow(2);gewhj:=eingangrow(3);ijgst:=
+int(gewjgst);ihj:=int(gewhj);IF akthj=""THEN akthj:=schulkenndatum(
+"Schulhalbjahr")FI ;prueffeld2und3;prueffeld4;prueffeld5;prueffeld6und7;
+prueffeld8bis13;prueffeld3536;datenholen;betrachtebelegung;
+planblockbezpruefen;schueleraufzeigen.betrachtebelegung:FOR iFROM 14UPTO 23
+REP IF eingangrow(i)<>""THEN planblockvorzpruefen;planblockbez15bis23pruefen;
+belegungpruefen:=TRUE ;LEAVE betrachtebelegungFI ;PER ;belegungpruefen:=
+FALSE .prueffeld2und3:IF gewjgst=""THEN fehlermeldungausgeben(2,
+meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenpruefungELIF gewhj=""THEN 
+fehlermeldungausgeben(2,meldunghjfalsch,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF jgstfalsch(gewjgst,"11")THEN 
+fehlermeldungausgeben(2,meldungjgstfalsch,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF ihj<1COR ihj>2THEN fehlermeldungausgeben(3
+,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenpruefungFI .prueffeld4:
+aktfeldinh:=eingangrow(4);IF aktfeldinh=""THEN IF eingangrow(5)=""THEN 
+fehlermeldungausgeben(4,meldungandereauswahl,1);LEAVE 
+schuelerkursenzuordnenpruefungELSE LEAVE prueffeld4FI ELIF jgstfalsch(gewjgst
+,aktfeldinh)THEN fehlermeldungausgeben(4,meldungunzulauswahl,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF int(aktfeldinh)=ijgstTHEN pruefhjELIF 
+aktfeldinh="10"CAND akthj="1"THEN fehlermeldungausgeben(4,
+meldungandereauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI .pruefhj:IF 
+gewhj="1"CAND akthj="2"THEN fehlermeldungausgeben(3,meldungandereauswahl,1);
+LEAVE schuelerkursenzuordnenpruefungFI .prueffeld5:aktfeldinh:=eingangrow(5);
+IF aktfeldinh=""THEN LEAVE prueffeld5ELIF aktfeldinh<>""CAND eingangrow(4)<>
+""THEN IF int(aktfeldinh)<>int(eingangrow(4))+1THEN fehlermeldungausgeben(5,
+meldungunzulauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI ELIF int(
+aktfeldinh)>ijgstTHEN fehlermeldungausgeben(5,meldungunzulauswahl,1);LEAVE 
+schuelerkursenzuordnenpruefungFI .prueffeld6und7:zusjgst:=eingangrow(6);zushj
+:=eingangrow(7);IF zusjgst=""CAND zushj<>""THEN fehlermeldungausgeben(6,
+meldungjgstfehlt,1);LEAVE schuelerkursenzuordnenpruefungELIF zushj=""CAND 
+zusjgst<>""THEN fehlermeldungausgeben(7,meldunghjfalsch,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF zushj=""CAND zusjgst=""THEN 
+zusspaltezeigen:=FALSE ELIF zusjgst=gewjgstCAND zushj=gewhjTHEN 
+fehlermeldungausgeben(6,meldungandereauswahl,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF jgstfalsch(gewjgst,"11")THEN 
+fehlermeldungausgeben(6,meldungjgstfalsch,1);LEAVE 
+schuelerkursenzuordnenpruefungELIF ihj<1COR ihj>2THEN fehlermeldungausgeben(7
+,meldunghjfalsch,1);LEAVE schuelerkursenzuordnenpruefungELIF jgstfalsch(
+gewjgst,zusjgst)THEN fehlermeldungausgeben(6,meldungandereauswahl,1);LEAVE 
+schuelerkursenzuordnenpruefungELSE zusspaltezeigen:=TRUE FI .prueffeld8bis13:
+klkz:=compress(eingangrow(10));klausurkz:=klkz<>"";FOR iFROM 8UPTO 13REP IF 
+eingangrow(i)<>""THEN LEAVE prueffeld8bis13FI PER ;fehlermeldungausgeben(8,
+meldungfeldfuellen,1);LEAVE schuelerkursenzuordnenpruefung.prueffeld3536:IF 
+eingangrow(35)<>""COR eingangrow(36)<>""THEN fehlermeldungausgeben(35,
+meldungandereauswahl,1);LEAVE schuelerkursenzuordnenpruefungFI .
+planblockvorzpruefen:IF planblockvorzfalsch(14)COR planblockvorzfalsch(16)
+COR planblockvorzfalsch(18)COR planblockvorzfalsch(20)COR planblockvorzfalsch
+(22)THEN kurswahlsperrebeenden(kuwa2sperre);LEAVE 
+schuelerkursenzuordnenpruefungFI .datenholen:IF NOT exists(/server)THEN 
+fehlermeldungausgeben(letztepos,meldungserverfehler,1);LEAVE 
+schuelerkursenzuordnenpruefungFI ;IF eingangrow(4)=""THEN t:=kznurneue;
+aktjgst:=text(int(eingangrow(5))-1)ELIF eingangrow(5)=""THEN t:=kzohneneue;
+aktjgst:=eingangrow(4)ELSE t:=kzalle;aktjgst:=eingangrow(4)FI ;
+kurswahlinitialisieren(aktjgst,gewjgst,gewhj,t,gewsj);kurswahlbasisholen(
+fstat);IF zusspaltezeigenTHEN erweitertekurswahlbasisholen(zusjgst,zushj,
+fstat);FI ;kurswahlsperresetzen(kuwa2sperre,sperreok);IF sperreokTHEN 
+alleplblbez:=alleplanblockbezeichnerELSE fehlermeldungausgeben(infeld,
+meldungparallelanw,1);LEAVE schuelerkursenzuordnenpruefungFI .
+planblockbez15bis23pruefen:IF planblockbezfalsch(eingangrow(15))THEN 
+fehlermeldungausgeben(15,meldungfalscherwert,1);kurswahlsperrebeenden(
+kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF planblockbezfalsch(
+eingangrow(17))THEN fehlermeldungausgeben(17,meldungfalscherwert,1);
+kurswahlsperrebeenden(kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF 
+planblockbezfalsch(eingangrow(19))THEN fehlermeldungausgeben(19,
+meldungfalscherwert,1);kurswahlsperrebeenden(kuwa2sperre);LEAVE 
+schuelerkursenzuordnenpruefungELIF planblockbezfalsch(eingangrow(21))THEN 
+fehlermeldungausgeben(21,meldungfalscherwert,1);kurswahlsperrebeenden(
+kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungELIF planblockbezfalsch(
+eingangrow(23))THEN fehlermeldungausgeben(23,meldungfalscherwert,1);
+kurswahlsperrebeenden(kuwa2sperre);LEAVE schuelerkursenzuordnenpruefungFI .
+planblockbezpruefen:zeigbloecke:="";FOR iFROM 24UPTO 34REP IF 
+planblockbezfalsch(eingangrow(i))THEN fehlermeldungausgeben(i,
+meldungfalscherwert,1);kurswahlsperrebeenden(kuwa2sperre);LEAVE 
+schuelerkursenzuordnenpruefungFI ;IF eingangrow(i)<>""THEN zeigbloeckeCAT 
+konvblock(eingangrow(i))FI ;PER .END PROC schuelerkursenzuordnenpruefung;
+BOOL PROC planblockbezfalsch(TEXT CONST anwblock):suchab:=1;IF anwblock=""
+THEN FALSE ELSE block:=text(anwblock,3);WHILE pos(alleplblbez,block,suchab)<>
+0REP j:=pos(alleplblbez,block,suchab);IF jMOD 3=1THEN LEAVE 
+planblockbezfalschWITH FALSE ELSE suchab:=j+1FI PER ;TRUE FI END PROC 
+planblockbezfalsch;BOOL PROC planblockvorzfalsch(INT CONST feld):t:=(
+eingangrow(feld)SUB 1);IF t<>""THEN IF eingangrow(feld+1)=""THEN 
+fehlermeldungausgeben(feld+1,meldungfeldfuellen,1);TRUE ELIF NOT (t="-"COR t=
+"+")THEN fehlermeldungausgeben(feld,meldungfalscherwert,1);TRUE ELSE FALSE 
+FI ELIF eingangrow(feld+1)<>""THEN fehlermeldungausgeben(feld,
+meldungfeldfuellen,1);TRUE ELSE FALSE FI END PROC planblockvorzfalsch;PROC 
+fehlermeldungausgeben(INT CONST feld,meldung,ruecksprung):infeld(feld);
+standardmeldung(meldung,"");return(ruecksprung)END PROC fehlermeldungausgeben
+;BOOL PROC jgstfalsch(TEXT CONST jgst,abjgst):jgst1:=int(jgst);jgst2:=int(
+abjgst);jgst1<jgst2COR jgst1>13END PROC jgstfalsch;PROC initbspuffer:FOR i
+FROM 1UPTO anzschuelerbsREP schueler(i)(1):="";schueler(i)(2):="";schueler(i)
+(3):="";schueler(i)(4):=""PER END PROC initbspuffer;PROC schueleraufzeigen:
+fach:=text(eingangrow(8),2);art:=text(eingangrow(9),2);holschueler;IF 
+alleschueler=""THEN meldungkeineschueler;kurswahlsperrebeenden(kuwa2sperre)
+ELSE zeigbearbschirm;standardnprocFI .zeigbearbschirm:standardstartproc(
+maskebearb);standardkopfmaskeaktualisieren("Kurszuordnung für jetzige Jgst. "
++aktjgst+" in "+gewjgst+"."+gewhj);ausgabe:=fach;ausgabeCAT art;ausgabeCAT 
+text(eingangrow(10),1);IF eingangrow(11)<>""THEN ausgabeCAT "+";ausgabeCAT 
+text(eingangrow(11),2);ausgabeCAT text(eingangrow(12),2);ausgabeCAT text(
+eingangrow(13),1);ELSE ausgabeCAT "      "FI ;standardmaskenfeld(ausgabe,2);
+ausgabe:=" ";ausgabeCAT text(eingangrow(14),1);ausgabeCAT konvblock(
+eingangrow(15));ausgabeCAT text(eingangrow(16),1);ausgabeCAT konvblock(
+eingangrow(17));ausgabeCAT text(eingangrow(18),1);ausgabeCAT konvblock(
+eingangrow(19));ausgabeCAT text(eingangrow(20),1);ausgabeCAT konvblock(
+eingangrow(21));ausgabeCAT text(eingangrow(22),1);ausgabeCAT konvblock(
+eingangrow(23));standardmaskenfeld(ausgabe,3);IF zusspaltezeigenTHEN 
+standardmaskenfeld(eingangrow(6)+"."+eingangrow(7),4);ELSE standardmaskenfeld
+("    ",4);FI ;standardmaskenfeld(fach,5);IF zeigbloecke=""THEN zeigbloecke:=
+stdzeigbloecke;standardmaskenfeld(stdzeigbloecke,6)ELSE standardmaskenfeld(
+text(zeigbloecke,33),6)FI ;zeigschueler.meldungkeineschueler:
+fehlermeldungausgeben(14,meldungkeinedaten,1).holschueler:alleschueler:="";
+alleschueler1:=schuelermitwahl(fach,"",art,eingangrow(10));IF eingangrow(11)
+<>""THEN alleschueler2:=schuelermitwahl(eingangrow(11),"",eingangrow(12),
+eingangrow(13));schuelervergleichELSE alleschueler2:="";IF belegungpruefen
+THEN pruefbelegungallerschuelerELSE alleschueler:=alleschueler1;anzschueler:=
+anzahlschuelermitwahl(fach,"",art,eingangrow(10))FI ;FI .
+pruefbelegungallerschueler:saktpos:=1;ssuchab:=2;alleschueler:="";anzschueler
+:=0;WHILE saktpos<>0REP saktpos:=pos(alleschueler1,trenner1,ssuchab);IF 
+saktpos<>0THEN sname:=subtext(alleschueler1,ssuchab,saktpos-1);IF 
+richtigebelegung(sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1
+FI ;ssuchab:=saktpos+1FI PER ;sname:=subtext(alleschueler1,ssuchab);IF 
+richtigebelegung(sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1
+FI .END PROC schueleraufzeigen;PROC zeigschueler:aktfeld:=felderstername;
+initbspuffer;FOR iFROM 1UPTO anzschuelerbsREP wahldaten:="";weiterewahldaten
+:="";kennungdesschuelers:="";standardmaskenfeld(schuelername,aktfeld);
+standardmaskenfeld(text(wahldaten,22),aktfeld+3);standardmaskenfeld(
+weiterewahldaten,aktfeld+1);IF kennungdesschuelers=leereweiterewahldatenTHEN 
+standardmaskenfeld("",aktfeld+2)ELSE standardmaskenfeld(kennungdesschuelers,
+aktfeld+2)FI ;aktfeldINCR 4PER ;infeld(1);standardfelderausgeben;infeld(9).
+END PROC zeigschueler;TEXT PROC schuelername:findpos:=pos(alleschueler,
+trenner1,aktpos+1);IF findpos>0THEN name:=subtext(alleschueler,aktpos+2,
+findpos-1);aktpos:=findposELIF aktpos=length(alleschueler)THEN name:=""ELSE 
+name:=subtext(alleschueler,aktpos+2);aktpos:=length(alleschueler)FI ;
+bereitenameauf(name)END PROC schuelername;TEXT PROC bereitenameauf(TEXT 
+CONST name):ausgabe:=name;change(ausgabe,trenner2,", ");ausgabe:=text(ausgabe
+,pos(ausgabe,trenner2)-1);wahldatenaufbereiten(name);text(ausgabe,23)END 
+PROC bereitenameauf;PROC wahldatenaufbereiten(TEXT CONST name):TEXT VAR 
+zblock;IF name=""THEN wahldaten:=leerewahldaten;weiterewahldaten:=
+leereweiterewahldatenELSE pos1:=pos(name,trenner2,1)-1;pos2:=pos(name,
+trenner2,pos1+2)-1;nname:=subtext(name,1,pos1);vname:=subtext(name,pos1+2,
+pos2);gdat:=subtext(name,pos2+2,pos2+9);kennungdesschuelers:=kennungvonfach(
+FALSE );IF kennungdesschuelers=kennungkeinfachCOR kennungdesschuelers=
+kennungkeinkursTHEN kennungdesschuelers:=""FI ;schueler(i)(1):=nname;schueler
+(i)(2):=vname;schueler(i)(3):=gdat;schueler(i)(4):=kennungdesschuelers;
+ermittlewahldaten;ermittleweiterewahldatenFI .ermittlewahldaten:wahl:=
+wahldatenzumschueler(nname,vname,gdat,kennungfake);blockpos:=1;WHILE blockpos
+<length(zeigbloecke)REP zblock:=subtext(zeigbloecke,blockpos,blockpos+2);IF 
+schuelerinplanblock(nname,vname,gdat,zblock)THEN wahldatenCAT 
+fachvomplanblock(zblock);ELSE wahldatenCAT "  "FI ;blockposINCR 3PER .
+ermittleweiterewahldaten:IF zusspaltezeigenTHEN weiterewahldaten:=
+kennungvonfach(TRUE )ELSE weiterewahldaten:=leereweiterewahldatenFI .END 
+PROC wahldatenaufbereiten;TEXT PROC kennungvonfach(BOOL CONST inweiterendaten
+):fapos:=1;fawahl:="";IF inweiterendatenTHEN fawahl:=
+weiterewahldatenzumschueler(nname,vname,gdat,kennungfakeartkl)ELSE fawahl:=
+wahldatenzumschueler(nname,vname,gdat,kennungfakeartkl)FI ;IF fawahl=""THEN 
+leereweiterewahldatenELSE betrachteallefaecherFI .betrachteallefaecher:WHILE 
+fapos<length(fawahl)REP IF subtext(fawahl,fapos,fapos+1)=fachCAND subtext(
+fawahl,fapos+6,fapos+7)=artTHEN fakennung:=subtext(fawahl,fapos+2,fapos+5);
+IF fakennung=leereweiterewahldatenTHEN LEAVE betrachteallefaecherWITH 
+kennungkeinkursELSE LEAVE betrachteallefaecherWITH compress(fakennung)FI 
+ELSE faposINCR laengefakeartklFI PER ;kennungkeinfach.END PROC kennungvonfach
+;TEXT PROC fachvomplanblock(TEXT CONST block):TEXT VAR plbld:=planblockdaten(
+block,kzkurse),k;blpos:=1;WHILE blpos<LENGTH wahlREP k:=subtext(wahl,blpos,
+blpos+laengekurs-1);IF kurseingetragen(plbld,k)THEN LEAVE fachvomplanblock
+WITH text(k,2)ELSE blposINCR laengekursFI PER ;"  "END PROC fachvomplanblock;
+BOOL PROC kurseingetragen(TEXT CONST quelle,teilmuster):INT VAR suchab:=1,
+aktpos;WHILE pos(quelle,teilmuster,suchab)<>0REP aktpos:=pos(quelle,
+teilmuster,suchab);IF aktposMOD laengekurs=1THEN LEAVE kurseingetragenWITH 
+TRUE ELSE suchab:=aktpos+1FI PER ;FALSE END PROC kurseingetragen;PROC 
+schuelervergleich:saktpos:=1;ssuchab:=2;anzschueler:=0;WHILE saktpos<>0REP 
+saktpos:=pos(alleschueler1,trenner1,ssuchab);IF saktpos<>0THEN sname:=subtext
+(alleschueler1,ssuchab,saktpos-1);IF pos(alleschueler2,sname)>0THEN IF 
+belegungpruefenTHEN IF richtigebelegung(sname)THEN alleschuelerCAT trenner1+
+sname;anzschuelerINCR 1FI ELSE alleschuelerCAT trenner1+sname;anzschueler
+INCR 1FI FI ;ssuchab:=saktpos+1FI PER ;sname:=subtext(alleschueler1,ssuchab);
+IF pos(alleschueler2,sname)>0THEN IF belegungpruefenTHEN IF richtigebelegung(
+sname)THEN alleschuelerCAT trenner1+sname;anzschuelerINCR 1FI ELSE 
+alleschuelerCAT trenner1+sname;anzschuelerINCR 1FI FI .END PROC 
+schuelervergleich;BOOL PROC richtigebelegung(TEXT CONST name):bewertung:=
+TRUE ;pos1:=pos(name,trenner2,2)-1;pos2:=pos(name,trenner2,pos1+2)-1;nname:=
+subtext(name,2,pos1);vname:=subtext(name,pos1+2,pos2);gdat:=subtext(name,pos2
++2,pos2+9);feld:=12;FOR iFROM 1UPTO 5REP feldINCR 2;vorz:=eingangrow(feld);
+IF vorz<>""THEN blockbez:=eingangrow(feld+1);block:=konvblock(blockbez);IF 
+vorz="-"THEN bewertung:=NOT schuelerinplanblock(nname,vname,gdat,block)ELSE 
+bewertung:=schuelerinplanblock(nname,vname,gdat,block)FI ;IF NOT bewertung
+THEN LEAVE richtigebelegungWITH FALSE FI FI ;PER ;bewertungEND PROC 
+richtigebelegung;PROC schuelerkursenzuordnenspeichern(BOOL CONST speichern):
+speicherungsfehler:=FALSE ;IF speichernTHEN pruefkennungen;speicherkennungen;
+logmeldung:=text1;logmeldungCAT gewjgst;logmeldungCAT punkt;logmeldungCAT 
+gewhj;logbucheintragvornehmen(logmeldung);kurswahl2sichern(i);ELSE 
+standardmeldung(meldungnspeichern," ")FI ;naechsterbildschirm.pruefkennungen:
+standardmeldung(meldungpruefen," ");j:=felderstekennung;FOR iFROM 1UPTO 
+anzschuelerbsREP kennung:=standardmaskenfeld(j);infeld(j);IF kennung<>""THEN 
+IF schueler(i)(1)=""THEN fehlermeldungkeinschuelerFI ;planbloecke:=compress(
+kursdaten(fach+kennung,kennungplanbl));IF dbstatus<>0THEN 
+fehlermeldungunbekkennungELIF planbloecke<>""CAND kennung<>schueler(i)(4)
+THEN pruefplanbloeckeFI FI ;jINCR 4PER .pruefplanbloecke:prueferstenblock;IF 
+length(planbloecke)>3THEN pruefzweitenblockFI .prueferstenblock:IF 
+schuelerinplanblock(schueler(i)(1),schueler(i)(2),schueler(i)(3),text(
+planbloecke,3))THEN fehlermeldungschonkursblock1FI .pruefzweitenblock:IF 
+schuelerinplanblock(schueler(i)(1),schueler(i)(2),schueler(i)(3),subtext(
+planbloecke,4))THEN fehlermeldungschonkursblock2FI .
+fehlermeldungschonkursblock1:infeld((i-1)*4+9);standardmeldung(
+meldungschonkurs,text(planbloecke,3)+az);return(1);LEAVE 
+schuelerkursenzuordnenspeichern.fehlermeldungschonkursblock2:infeld((i-1)*4+9
+);standardmeldung(meldungschonkurs,subtext(planbloecke,4)+az);return(1);
+LEAVE schuelerkursenzuordnenspeichern.fehlermeldungkeinschueler:
+fehlermeldungausgeben((i-1)*4+9,meldungfeldleeren,1);LEAVE 
+schuelerkursenzuordnenspeichern.fehlermeldungunbekkennung:infeld((i-1)*4+9);
+standardmeldung(meldungunbeklv,fach+kennung+az);return(1);LEAVE 
+schuelerkursenzuordnenspeichern.speicherkennungen:standardmeldung(
+meldungspeichern," ");j:=felderstekennung;FOR iFROM 1UPTO anzschuelerbsREP 
+kennung:=standardmaskenfeld(j);infeld(j);IF kennung<>schueler(i)(4)THEN IF 
+NOT klausurkzTHEN ermittleklkennzFI ;schuelerwahlaendern(schueler(i)(1),
+schueler(i)(2),schueler(i)(3),fach,schueler(i)(4),art,fach,kennung,art,klkz);
+IF dbstatus<>0THEN speicherungsfehler:=TRUE FI ;FI ;jINCR 4PER ;IF 
+speicherungsfehlerTHEN kurswahlserveraktualisieren(aktjgst,gewjgst,gewhj)FI .
+naechsterbildschirm:kurswahl0holen(fstat);kurswahl1holen(fstat);IF aktpos<
+length(alleschueler)CAND NOT speicherungsfehlerTHEN zeigschueler;return(1);
+IF speicherungsfehlerTHEN standardmeldung(meldungspeicherfehler,"");FI ELSE 
+kurswahlsperrebeenden(kuwa2sperre);enter(2);IF speicherungsfehlerTHEN 
+standardmeldung(meldungspeicherfehler,"");infeld(letztepos)FI FI .END PROC 
+schuelerkursenzuordnenspeichern;PROC ermittleklkennz:klwahl:=
+wahldatenzumschueler(schueler(i)(1),schueler(i)(2),schueler(i)(3),
+kennungfaartkl);z:=1;WHILE z<LENGTH (klwahl)REP IF subtext(klwahl,z,z+3)=fach
++artTHEN klkz:=klwahlSUB z+4;LEAVE ermittleklkennzELSE zINCR 5FI PER ;klkz:=
+""END PROC ermittleklkennz;PROC schuelerkursenzuordnenabbruch:
+kurswahlsperrebeenden(kuwa2sperre);enter(2)END PROC 
+schuelerkursenzuordnenabbruch;PROC schuelerkursenzuordnenkopieren:kopzeile:=
+infeld;aktzeile:=kopzeile+4;aktkennung:=standardmaskenfeld(kopzeile);IF 
+kopzeile=feldletztekennungTHEN fehlermeldungkeinkopELSE WHILE aktzeile<=
+feldletztekennungCAND schueler((aktzeile-5)DIV 4)(1)<>""REP 
+standardmaskenfeld(aktkennung,aktzeile);aktzeileINCR 4PER ;infeld(kopzeile+4)
+;standardfelderausgeben;infeld(kopzeile+4);FI ;return(1).fehlermeldungkeinkop
+:standardmeldung(meldungkeinekopfunktion,"").END PROC 
+schuelerkursenzuordnenkopieren;PROC schuelerkursenzuordnenlisten:kursliste:=
+"";aktfeld:=infeld;w:=startwindow(35,23,77,1);liste:="";standardmeldung(
+meldunglistezeigen,"");IF menuedraussenTHEN reorganizescreenFI ;fuelleliste;
+infeld(1);standardfelderausgeben;open(w);auskunfterteilung(liste,w,FALSE );
+reorganizescreen;setlasteditvalues;infeld(aktfeld);return(1).fuelleliste:
+listeCAT "Anzahl Schüler wie ausgewählt";listeCAT auskunftstextende;listeCAT 
+text(anzschueler);listeCAT auskunftstextende;listeCAT " ";listeCAT 
+auskunftstextende;listeCAT "Fach     gewählt     Kurszahl/-größe";listeCAT 
+auskunftstextende;listeCAT fach;listeCAT " ";listeCAT art;listeCAT "     ";
+listeCAT gewaehlteschueler;listeCAT "     ";listeCAT anzahlkurse;listeCAT 
+kursgroesse;listeCAT auskunftstextende;listeCAT " ";listeCAT 
+auskunftstextende;listeCAT "Kurse    Planblock   Schüler";listeCAT 
+auskunftstextende;listeallerkurse.listeallerkurse:anfpos:=1;WHILE anfpos<
+length(kursliste)REP listeCAT fach+" ";kennung:=subtext(kursliste,anfpos,
+anfpos+3);listeCAT kennung;listeCAT "  ";kurs:=kursdaten(fach+kennung,
+kennungplanbl);IF kurs=""THEN listeCAT "            "ELSE listeCAT text(int(
+text(kurs,3)),2);listeCAT "  ";listeCAT text(int(subtext(kurs,4)),2);liste
+CAT "      ";FI ;listeCAT text(anzahlschuelermitwahl(fach,kennung,"",""));
+listeCAT auskunftstextende;anfposINCR 4PER .gewaehlteschueler:anzsch:=
+anzahlschuelermitwahl(fach,"",art,"");text(text(anzsch),6).kursgroesse:text(
+anzschDIV anzkurse).anzahlkurse:kurse:=allekurse;suchanfang;suchende;IF 
+anfpos=0THEN "0        "ELSE kurse:=subtext(kurse,anfpos,endpos);
+betrachtekurse;text(text(anzkurse),10)FI .betrachtekurse:anzkurse:=0;anfpos:=
+1;kursliste:="";WHILE anfpos<length(kurse)REP IF subtext(kurse,anfpos,anfpos+
+1)=fachCAND subtext(kurse,anfpos+8,anfpos+9)=artTHEN anzkurseINCR 1;kursliste
+CAT subtext(kurse,anfpos+2,anfpos+5);FI ;anfposINCR 10PER .suchanfang:anfpos
+:=pos(kurse,fach,1);WHILE anfpos<>0REP IF (anfposMOD 10)=1CAND subtext(kurse,
+anfpos+8,anfpos+9)=artTHEN LEAVE suchanfangELSE anfpos:=pos(kurse,fach,anfpos
++1)FI ;PER .suchende:findpos:=pos(kurse,fach,anfpos+1);IF anfpos<>0THEN 
+endpos:=anfpos+9;WHILE findpos<>0REP IF (findposMOD 10)=1CAND subtext(kurse,
+findpos+8,findpos+9)=artTHEN endpos:=findpos+9FI ;findpos:=pos(kurse,fach,
+findpos+1)PER ;ELSE endpos:=0FI .END PROC schuelerkursenzuordnenlisten;TEXT 
+PROC konvblock(TEXT CONST blockbez):INT VAR block;IF blockbez<>""THEN block:=
+int(text(blockbez,2));IF block<10THEN "0"+text(block)+text(blockbezSUB 3,1)
+ELSE text(block)+text(blockbezSUB 3,1)FI ELSE "   "FI END PROC konvblock;
+PROC initrow:FOR iFROM 2UPTO anzfeldereingangREP eingangrow(i):=""PER END 
+PROC initrow;PROC merkeeingangbs:FOR iFROM 2UPTO anzfeldereingangREP 
+eingangrow(i):=standardmaskenfeld(i)PER .END PROC merkeeingangbs;PROC 
+logbucheintragvornehmen(TEXT CONST escfunktion):logeintrag(logtext1+
+escfunktion+logtext2+aktjgst)END PROC logbucheintragvornehmen;initrow;END 
+PACKET schuelerzukursenzuordnen;
+
diff --git a/app/schulis/2.2.1/src/2.stand der kursbildung analysieren b/app/schulis/2.2.1/src/2.stand der kursbildung analysieren
new file mode 100644
index 0000000..f199978
--- /dev/null
+++ b/app/schulis/2.2.1/src/2.stand der kursbildung analysieren
@@ -0,0 +1,132 @@
+PACKET standderkursbildunganalysierenDEFINES 
+standderkursbildunganalysierenvorbereiten,
+standderkursbildunganalysierenstarten,standderkursbildunganalysierendrucken:
+LET maskeeingang="ms stand der kursbildung analysieren";LET fnrgewjgst=2,
+fnrhalbjahr=3,fnraktjgst=4,fnrneuanjgst=5,fnralleschueler=6;FILE VAR prot;
+LET protname="Zuordnung von Schülern zu Kursen";LET schulhalbjahr=
+"Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET jgst10=10,
+jgst11=11,jgst13=13,hj1=1,hj2=2;LET meldnrdatenwerdengeprueft=57,
+meldnrbittewarten=69,meldnrbearbeitetwird=102,meldnrbitteangabeergaenzen=129,
+meldnrfalschejgstfolge=410,meldnrfalschebezugsjgst=411,meldnrkurswahlfehler=
+416;LET feldanzmaskeeingang=6;ROW feldanzmaskeeingangTEXT VAR feldbs1;INT 
+VAR letztecursorfnr:=fnrgewjgst,pruefstatus,kurswahlstatus;TEXT VAR 
+aktuelleshalbjahr:="",aktjgst,gewjgst,gewhalbjahr,neuanjgst,gewschuljahr;
+BOOL VAR alleschueler,fehlerinschuelerwahl;TEXT VAR gewschueler;LET 
+nuraktuelleschueler="O",nurneuangemeldete="N";INT VAR ischueler;TEXT VAR 
+wahldaten,schuelername,anfangsbuchstabe,kurs,gueltigekurse;INT VAR ikurs;LET 
+maxkurse=13;ROW maxkurseSTRUCT (TEXT eintrag,TEXT pb1,TEXT pb2)VAR 
+kurshinweis;TEXT VAR planbloecke,belegtebloecke,pbnr,pbkennung,pruefblock;
+LET pbkennunga="a",pbkennungb="b",pbleer="   ";INT VAR poskurs;LET laengekurs
+=6,laengeschuelerkurs=15,laengekursangaben=10,laengeplanblock=3;LET trenner=
+"�",schraegstrich="/",doppelpunkt=":",kennzhell="#";LET kennungname="N",
+kennungkurse="K",kennungplanblock="P";TEXT VAR auszeile,fachzeile,kurszeile,
+fehlerzeile;LET ueberschrift="Zuordnung von Schülern zu Kursen",untertitel1=
+"Jgst. ",erklaerung1="(Fehlende Zuordnungen sind mit ""_"" hervorgehoben,",
+erklaerung2="Überschneidungen in Planblöcken mit ""*"",",erklaerung3=
+"ungültige Kursbezeichnungen mit ""$"" markiert.)",blank=" ",zeilenbeginn=
+"   ",leereintrag="    :",ungueltigerkurs="$$$$:",fehlenderkurs="____:",
+gleichzeitigerkurs="****:";initfelderdeseingangsbildschirms;PROC 
+standderkursbildunganalysierenvorbereiten:standardstartproc(maskeeingang);
+wertedeseingangsbildschirmsholen;infeld(fnrgewjgst);standardfelderausgeben;
+infeld(letztecursorfnr);standardnprocEND PROC 
+standderkursbildunganalysierenvorbereiten;PROC 
+standderkursbildunganalysierenstarten:eingangsbehandlung;IF pruefstatus>0
+THEN infeld(pruefstatus);return(1)ELSE wertedeseingangsbildschirmsmerken;
+standardmeldung(meldnrbittewarten,"");kurswahlinitialisieren(aktjgst,gewjgst,
+gewhalbjahr,gewschueler,gewschuljahr);kurswahlbasisholen(kurswahlstatus);IF 
+kurswahlstatus<>0THEN kurswahlfehlerbehandeln;return(1)ELSE 
+protokollvorbereiten;kurszuordnungenanalysieren;zeigedatei(protname,"")FI FI 
+.protokollvorbereiten:forget(protname,quiet);prot:=sequentialfile(output,
+protname);putline(prot,schulkenndatum(schulname));auszeile:=text(
+schulkenndatum(schulort),60);auszeileCAT date;putline(prot,auszeile);line(
+prot,2);putline(prot,20*blank+ueberschrift);auszeile:=22*blank;auszeileCAT 
+untertitel1;auszeileCAT aktjgst;auszeileCAT " für ";auszeileCAT gewjgst;
+auszeileCAT ".";auszeileCAT gewhalbjahr;auszeileCAT blank;auszeileCAT 
+aufberschuljahr;putline(prot,auszeile);line(prot,2);auszeile:=erklaerung1;
+putline(prot,auszeile);auszeile:=erklaerung2;putline(prot,auszeile);auszeile
+:=erklaerung3;putline(prot,auszeile).END PROC 
+standderkursbildunganalysierenstarten;PROC kurswahlfehlerbehandeln:
+standardmeldung(meldnrkurswahlfehler,"");pause(10)END PROC 
+kurswahlfehlerbehandeln;TEXT PROC aufberschuljahr:TEXT VAR aufbersj:=subtext(
+gewschuljahr,1,2);aufbersjCAT schraegstrich;aufbersjCAT subtext(gewschuljahr,
+3,4);aufbersjEND PROC aufberschuljahr;PROC kurszuordnungenanalysieren:
+gueltigekurse:=allekurse;anfangsbuchstabe:="";FOR ischuelerFROM 
+ersterschuelerUPTO letzterschuelerREP schuelerwahluntersuchenPER .
+schuelerwahluntersuchen:fachzeile:=zeilenbeginn;kurszeile:=zeilenbeginn;
+wahldaten:=wahldatenzumindex(ischueler,kennungkurse);schuelername:=
+wahldatenzumindex(ischueler,kennungname);IF (schuelernameSUB 1)<>
+anfangsbuchstabeTHEN anfangsbuchstabe:=schuelernameSUB 1;standardmeldung(
+meldnrbearbeitetwird,anfangsbuchstabe+kennzhell)FI ;fehlerinschuelerwahl:=
+FALSE ;belegtebloecke:="";poskurs:=1;FOR ikursFROM 1UPTO maxkurseREP kurs:=
+subtext(wahldaten,poskurs+3,poskurs+laengekurs+2);IF kurs<>""THEN 
+facheintragen;kurseintragen;kurshinweiseintragenELSE leereintraegeergaenzen
+FI ;poskursINCR laengeschuelerkursPER ;fehlerzeilezusammenstellen;IF 
+fehlerinschuelerwahlCOR alleschuelerTHEN line(prot);changeall(schuelername,
+trenner,", ");putline(prot,schuelername);putline(prot,fachzeile);putline(prot
+,kurszeile);putline(prot,fehlerzeile)FI .facheintragen:fachzeileCAT subtext(
+kurs,1,2);fachzeileCAT "  :".kurseintragen:IF subtext(kurs,3,6)<>"    "THEN 
+kurszeileCAT subtext(kurs,3,6)ELSE kurszeileCAT subtext(wahldaten,poskurs+1,
+poskurs+2);kurszeileCAT "  "FI ;kurszeileCAT doppelpunkt.kurshinweiseintragen
+:IF subtext(kurs,3,6)="    "THEN kurshinweis(ikurs).eintrag:=fehlenderkurs
+ELIF suchpos(gueltigekurse,kurs,laengekursangaben)=0THEN kurshinweis(ikurs).
+eintrag:=ungueltigerkursELSE kurshinweis(ikurs).eintrag:="";planbloecke:=
+kursdaten(kurs,kennungplanblock);kurshinweis(ikurs).pb1:=subtext(planbloecke,
+1,3);kurshinweis(ikurs).pb2:=subtext(planbloecke,4,6);belegtenblockeintragen(
+kurshinweis(ikurs).pb1);belegtenblockeintragen(kurshinweis(ikurs).pb2)FI .
+fehlerzeilezusammenstellen:fehlerzeile:=zeilenbeginn;FOR ikursFROM 1UPTO 
+maxkurseREP IF kurshinweis(ikurs).eintrag=""THEN doppelbelegungpruefen;
+fehlerzeileCAT kurshinweis(ikurs).eintrag;ELIF kurshinweis(ikurs).eintrag=
+leereintragTHEN fehlerzeileCAT leereintragELSE fehlerzeileCAT kurshinweis(
+ikurs).eintrag;fehlerinschuelerwahl:=TRUE FI PER .leereintraegeergaenzen:
+fachzeileCAT leereintrag;kurszeileCAT leereintrag;kurshinweis(ikurs).eintrag
+:=leereintrag.doppelbelegungpruefen:pruefblock:=kurshinweis(ikurs).pb1;IF 
+schnittliegtvorTHEN kurshinweis(ikurs).eintrag:=gleichzeitigerkurs;
+fehlerinschuelerwahl:=TRUE ELSE pruefblock:=kurshinweis(ikurs).pb2;IF 
+schnittliegtvorTHEN kurshinweis(ikurs).eintrag:=gleichzeitigerkurs;
+fehlerinschuelerwahl:=TRUE ELSE kurshinweis(ikurs).eintrag:=leereintragFI FI 
+.schnittliegtvor:IF pruefblock=pbleerTHEN FALSE ELSE pos(belegtebloecke,
+pruefblock,suchpos(belegtebloecke,pruefblock,laengeplanblock)+1)>0FI .END 
+PROC kurszuordnungenanalysieren;PROC belegtenblockeintragen(TEXT VAR 
+belegterpb):IF belegterpb<>pbleerTHEN pbnr:=subtext(belegterpb,1,2);pbkennung
+:=belegterpbSUB laengeplanblock;belegtebloeckeCAT pbnr;belegtebloeckeCAT 
+pbkennung;IF pbkennung=blankTHEN belegtebloeckeCAT pbnr;belegtebloeckeCAT 
+pbkennunga;belegtebloeckeCAT pbnr;belegtebloeckeCAT pbkennungb;ELSE 
+belegtebloeckeCAT pbnr;belegtebloeckeCAT blankFI ;FI END PROC 
+belegtenblockeintragen;PROC standderkursbildunganalysierendrucken(BOOL CONST 
+drucken):IF druckenTHEN print(protname)FI ;forget(protname,quiet);enter(2)
+END PROC standderkursbildunganalysierendrucken;PROC eingangsbehandlung:
+pruefstatus:=0;standardmeldung(meldnrdatenwerdengeprueft,"");aktjgst:=
+standardmaskenfeld(fnraktjgst);gewhalbjahr:=standardmaskenfeld(fnrhalbjahr);
+gewjgst:=standardmaskenfeld(fnrgewjgst);neuanjgst:=standardmaskenfeld(
+fnrneuanjgst);alleschueler:=standardmaskenfeld(fnralleschueler)<>"";IF 
+aktuelleshalbjahr=""THEN aktuelleshalbjahr:=schulkenndatum(schulhalbjahr)FI ;
+allgemeinefelderpruefen.allgemeinefelderpruefen:standardpruefe(3,fnrgewjgst,
+jgst11,jgst13,"",pruefstatus);IF pruefstatus>0THEN LEAVE 
+allgemeinefelderpruefenFI ;standardpruefe(3,fnrhalbjahr,hj1,hj2,"",
+pruefstatus);IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;IF aktjgst
+<>""THEN IF int(aktuelleshalbjahr)=hj2THEN standardpruefe(3,fnraktjgst,jgst10
+,jgst13,"",pruefstatus)ELSE standardpruefe(3,fnraktjgst,jgst11,jgst13,"",
+pruefstatus)FI ;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF 
+neuanjgst<>""THEN standardpruefe(3,fnrneuanjgst,jgst11,jgst13,"",pruefstatus)
+;IF pruefstatus>0THEN LEAVE allgemeinefelderpruefenFI ;FI ;IF aktjgst<>""
+THEN IF neuanjgst<>""THEN IF int(neuanjgst)<>int(aktjgst)+1THEN 
+standardmeldung(meldnrfalschejgstfolge,"");pruefstatus:=fnraktjgst;LEAVE 
+allgemeinefelderpruefenFI ;gewschueler:=""ELSE gewschueler:=
+nuraktuelleschuelerFI ELIF neuanjgst=""THEN standardmeldung(
+meldnrbitteangabeergaenzen,"");pruefstatus:=fnraktjgst;LEAVE 
+allgemeinefelderpruefenELSE gewschueler:=nurneuangemeldete;aktjgst:=text(int(
+neuanjgst)-1)FI ;IF aktjgst>gewjgstCOR (aktjgst=gewjgstAND aktuelleshalbjahr>
+gewhalbjahr)THEN standardmeldung(meldnrfalschebezugsjgst,"");pruefstatus:=
+fnrgewjgst;LEAVE allgemeinefelderpruefenFI .END PROC eingangsbehandlung;INT 
+PROC suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=
+pos(quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE 
+suchposWITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ;
+findposEND PROC suchpos;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR i
+FROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC 
+initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT 
+VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(
+i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC 
+wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO 
+feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC 
+wertedeseingangsbildschirmsholen;END PACKET standderkursbildunganalysieren
+
diff --git a/app/schulis/2.2.1/src/3.anschr.betroffene lehrer b/app/schulis/2.2.1/src/3.anschr.betroffene lehrer
new file mode 100644
index 0000000..453a590
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.anschr.betroffene lehrer
@@ -0,0 +1,174 @@
+PACKET auskunftlehrerDEFINES lehrerauskunfteingang,lehrerauskunftstarten,
+lehrerauskunftsonderwerte:LET anrede=511,nameaufbereitet=513;INT VAR x,index
+:=dnrlehrer,aktuellesfach,aktuelleart,aktuelleartlehrbefaehigunglangtext;LET 
+schulj=526,halbj=527,ermaessgrund1langtext=550,ermaessgrund2langtext=551,
+ermaessgrund3langtext=552,ermaessgrund4langtext=553;INT VAR 
+aktswklassenlehrer:=580,aktswstellvertreter:=581;LET ganztage=520,ganzgew=521
+,vormtage=522,vormgew=523,nachtage=524,nachgew=525;LET swdatum=520,swzeit=521
+,swart=522,swlv=523;LET maske="ms auskunft lehrer eingang",paraphenfeldnr=2,
+trenner="/",niltext="",blank=" ",strich=" --- ",mnrbittewarten=69,
+mnrkeinegueltigeparaphe=344;TEXT CONST dateimitvordruck1:=
+"vordruck1 auskunft lehrer",dateimitvordruck2:="vordruck2 auskunft lehrer",
+dateimitvordruck3:="vordruck3 auskunft lehrer",dateimitvordruck4:=
+"vordruck4 auskunft lehrer",dateimitvordruck5:="vordruck5 auskunft lehrer",
+dateimitvordruck6:="vordruck6 auskunft lehrer",dateimitvordruck7:=
+"vordruck7 auskunft lehrer",bestandnameartlehrbefaehigung:=
+"c02 art lehrbefaehigung",bestandnamepersoenlermaessigung:=
+"c02 persoenl ermaess";TEXT VAR angegebeneparaphe:="",aktuelleshalbjahr,
+aktuellesschuljahr,geplanteshalbjahr,geplantesschuljahr,schuljahr:="",
+halbjahr:="";INT VAR zeilenzahl,zeilenhilfszahl,zusatzzeilen;BOOL PROC 
+paraphevorhanden:putwert(fnrlparaphe,angegebeneparaphe);search(dnrlehrer,
+TRUE );IF dbstatus=0THEN TRUE ELSE FALSE FI END PROC paraphevorhanden;PROC 
+lehrerauskunfteingang:standardvproc(maske)END PROC lehrerauskunfteingang;
+PROC lehrerauskunftstarten:angegebeneparaphe:=standardmaskenfeld(
+paraphenfeldnr);IF angegebeneparaphe<>niltextTHEN startenausfuehrenELSE 
+meldeeingabefehler;zurueckzumdialogFI ;.meldeeingabefehler:standardmeldung(
+mnrkeinegueltigeparaphe,niltext).zurueckzumdialog:return(1).startenausfuehren
+:IF NOT (paraphevorhanden)THEN meldeeingabefehler;zurueckzumdialogELSE BOOL 
+CONST bildschirmausgabe:=FALSE ,einzelbearbeitung:=TRUE ;aktuelleshalbjahr:=
+schulkenndatum("Schulhalbjahr");aktuellesschuljahr:=schulkenndatum(
+"Schuljahr");geplanteshalbjahr:=aktuelleshalbjahr;geplantesschuljahr:=
+aktuellesschuljahr;geplanteshjundsjberechnen(geplanteshalbjahr,
+geplantesschuljahr);setzesonderwerteschulkenndaten;setzewerte;standardmeldung
+(mnrbittewarten,niltext);zusammengesetztesanschreiben(index,bildschirmausgabe
+,einzelbearbeitung,BOOL PROC lehrerauskunftsonderwerte,BOOL PROC 
+scanbedingung,TEXT PROC druckdateibauen);FI ;.setzewerte:putwert(fnrlparaphe,
+angegebeneparaphe)END PROC lehrerauskunftstarten;BOOL PROC scanbedingung:IF 
+dbstatus=0THEN TRUE ELSE FALSE FI END PROC scanbedingung;BOOL PROC 
+lehrerauskunftsonderwerte:LET sechs=6;ROW sechsTEXT VAR artlehrbefaehigung;
+initialisieresonderwerte;adressat(angegebeneparaphe);TEXT VAR anredetext:=
+"Frau";IF wert(fnrlgeschlecht)="m"THEN anredetext:="Herrn"FI ;setzesonderwert
+(anrede,anredetext);setzesonderwert(nameaufbereitet,wert(fnrlrufname)+" "+
+wert(fnrlzusatz)+" "+wert(fnrlfamname));TEXT VAR grund1,grund2,grund3,grund4;
+grund1:=wert(fnrlermgrund1);grund2:=wert(fnrlermgrund2);grund3:=wert(
+fnrlermgrund3);grund4:=wert(fnrlermgrund4);inittupel(dnrlehrbefaehigungen);
+putwert(fnrlbparaphe,angegebeneparaphe);search(ixlbpar,FALSE );aktuellesfach
+:=514;aktuelleart:=515;aktuelleartlehrbefaehigunglangtext:=554;FOR xFROM 1
+UPTO sechsREP IF dbstatus=0AND wert(fnrlbparaphe)=angegebeneparapheTHEN 
+setzesonderwert(aktuellesfach,wert(fnrlbfach));artlehrbefaehigung(x):=wert(
+fnrlbart);setzesonderwert(aktuelleart,artlehrbefaehigung(x));ELSE 
+setzesonderwert(aktuellesfach,niltext);artlehrbefaehigung(x):=niltext;
+setzesonderwert(aktuelleart,niltext);FI ;succ(ixlbpar);aktuellesfachINCR 2;
+aktuelleartINCR 2PER ;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,
+bestandnamepersoenlermaessigung);putwert(fnrschlschluessel,grund1);search(
+dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(ermaessgrund1langtext,
+wert(fnrschllangtext))ELSE setzesonderwert(ermaessgrund1langtext,blank)FI ;
+putwert(fnrschlschluessel,grund2);search(dnrschluessel,TRUE );IF dbstatus=0
+THEN setzesonderwert(ermaessgrund2langtext,wert(fnrschllangtext));ELSE 
+setzesonderwert(ermaessgrund2langtext,blank);FI ;putwert(fnrschlschluessel,
+grund3);search(dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(
+ermaessgrund3langtext,wert(fnrschllangtext))ELSE setzesonderwert(
+ermaessgrund3langtext,blank)FI ;putwert(fnrschlschluessel,grund4);search(
+dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(ermaessgrund4langtext,
+wert(fnrschllangtext))ELSE setzesonderwert(ermaessgrund4langtext,blank)FI ;
+putwert(fnrschlsachgebiet,bestandnameartlehrbefaehigung);FOR xFROM 1UPTO 6
+REP putwert(fnrschlschluessel,artlehrbefaehigung(x));search(dnrschluessel,
+TRUE );IF dbstatus=0THEN setzesonderwert(aktuelleartlehrbefaehigunglangtext,
+wert(fnrschllangtext))ELSE setzesonderwert(aktuelleartlehrbefaehigunglangtext
+,blank)FI ;aktuelleartlehrbefaehigunglangtextINCR 1PER ;TRUE END PROC 
+lehrerauskunftsonderwerte;TEXT PROC druckdateibauen:LET druckdatei="liste.1",
+hilfsdatei="hilfsdatei";TEXT VAR zeile;INT VAR i;BOOL VAR mitdatendesgeplhjs
+:=FALSE ;BOOL VAR weiteresaetzeda:=FALSE ;vordruckeholen;
+setzemitseitennummern(TRUE );druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0;
+briefalternative(dateimitvordruck1,hilfsdatei);hilfsdateiindruckdatei(
+hilfsdatei);zusatzzeilen:=5;sonderwertsjundhjsetzen(aktuellesschuljahr,
+aktuelleshalbjahr);ggfvordruck21malundvordruck3xmalindruckdatei(
+mitdatendesgeplhjs);mitdatendesgeplhjs:=TRUE ;sonderwertsjundhjsetzen(
+geplantesschuljahr,geplanteshalbjahr);
+ggfvordruck21malundvordruck3xmalindruckdatei(mitdatendesgeplhjs);zusatzzeilen
+:=4;vordruck4indruckdatei(aktuellesschuljahr,aktuelleshalbjahr);
+vordruck4indruckdatei(geplantesschuljahr,geplanteshalbjahr);zusatzzeilen:=14;
+vordruck5indruckdatei(aktuellesschuljahr,aktuelleshalbjahr);
+vordruck5indruckdatei(geplantesschuljahr,geplanteshalbjahr);zusatzzeilen:=4;
+ggf1malvordruck6undxmalvordruck7indruckdatei;drucknachbereitenohneausdrucken;
+vordruckeloeschen;druckdatei.vordruckeholen:fetch(dateimitvordruck1,/
+"anschreiben server");fetch(dateimitvordruck2,/"anschreiben server");fetch(
+dateimitvordruck3,/"anschreiben server");fetch(dateimitvordruck4,/
+"anschreiben server");fetch(dateimitvordruck5,/"anschreiben server");fetch(
+dateimitvordruck6,/"anschreiben server");fetch(dateimitvordruck7,/
+"anschreiben server");.vordruckeloeschen:forget(dateimitvordruck1,quiet);
+forget(dateimitvordruck2,quiet);forget(dateimitvordruck3,quiet);forget(
+dateimitvordruck4,quiet);forget(dateimitvordruck5,quiet);forget(
+dateimitvordruck6,quiet);forget(dateimitvordruck7,quiet);.
+ggf1malvordruck6undxmalvordruck7indruckdatei:inittupel(dnrvertretungen);
+putwert(fnrvparaphe,angegebeneparaphe);search(ixvpar,FALSE );IF dbstatus=0
+AND wert(fnrvparaphe)=angegebeneparapheTHEN swvertretungenfuellen;
+briefalternative(dateimitvordruck6,hilfsdatei);hilfsdateiindruckdatei(
+hilfsdatei);weiteresaetzeda:=FALSE ;succ(ixvpar);zusatzzeilen:=1;WHILE 
+dbstatus=0AND wert(fnrvparaphe)=angegebeneparapheREP weiteresaetzeda:=TRUE ;
+swvertretungenfuellen;briefalternative(dateimitvordruck7,hilfsdatei);succ(
+ixvpar);PER ;IF weiteresaetzedaTHEN hilfsdateiindruckdatei(hilfsdatei)FI ;FI 
+;END PROC druckdateibauen;PROC swvertretungenfuellen:TEXT VAR datum,
+datumaufber,lehrveranstg,lvaufber,zeitaufber;INT VAR zeit,tag,std;
+initialisieresonderwerte;datum:=wert(fnrvdatum);zeit:=intwert(fnrvtagstd);
+lehrveranstg:=wert(fnrvveranstaltung);datumaufber:=subtext(datum,1,2)+".";
+datumaufberCAT subtext(datum,4,5)+".";datumaufberCAT subtext(datum,7,8);tag:=
+(zeit-1)DIV 12;std:=zeitMOD 12;IF tag=0THEN zeitaufber:="Mo "ELIF tag=1THEN 
+zeitaufber:="Di "ELIF zeit=2THEN zeitaufber:="Mi "ELIF zeit=3THEN zeitaufber
+:="Do "ELIF zeit=4THEN zeitaufber:="Fr "ELIF zeit=5THEN zeitaufber:="Sa "FI ;
+zeitaufberCAT text(std,2);lvaufber:=subtext(lehrveranstg,1,2)+blank;lvaufber
+CAT subtext(lehrveranstg,3,4)+blank;lvaufberCAT subtext(lehrveranstg,5,8);
+setzesonderwert(swdatum,datumaufber);setzesonderwert(swzeit,zeitaufber);
+setzesonderwert(swart,wert(fnrvanrechnung));setzesonderwert(swlv,lvaufber);
+END PROC swvertretungenfuellen;PROC hilfsdateiindruckdatei(TEXT CONST 
+hilfsdatei):FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input,
+hilfsdatei);zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+
+zusatzzeilen>=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1
+UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ;
+forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC 
+hilfsdateiindruckdatei;PROC sonderwertsjundhjsetzen(TEXT VAR sj,hj):
+setzesonderwert(schulj,subtext(sj,1,2)+trenner+subtext(sj,3,4));
+setzesonderwert(halbj,hj);END PROC sonderwertsjundhjsetzen;PROC 
+ggfvordruck21malundvordruck3xmalindruckdatei(BOOL VAR geplhj):LET aktjgst=528
+,aktfach=529,aktkurs=530,aktwochstd=531,hilfsdatei="hilfsdatei";TEXT VAR fach
+,jgst:=blank,kennung;IF geplhjTHEN halbjahr:=geplanteshalbjahr;schuljahr:=
+geplantesschuljahr;ELSE halbjahr:=aktuelleshalbjahr;schuljahr:=
+aktuellesschuljahr;FI ;inittupel(dnrlehrveranstaltungen);putwert(fnrlvparaphe
+,angegebeneparaphe);putwert(fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);
+search(ixlvsjhjpar,FALSE );IF dbstatus=0AND (wert(fnrlvparaphe)=
+angegebeneparaphe)AND (wert(fnrlvhj)=halbjahr)AND (wert(fnrlvsj)=schuljahr)
+THEN briefalternative(dateimitvordruck2,hilfsdatei);
+sonderwertesetzenundinhilfsdateischreiben;hilfsdateiindruckdatei(hilfsdatei);
+FI ;.sonderwertesetzenundinhilfsdateischreiben:WHILE dbstatus=0AND (wert(
+fnrlvparaphe)=angegebeneparaphe)AND (wert(fnrlvhj)=halbjahr)AND (wert(fnrlvsj
+)=schuljahr)REP fach:=subtext(wert(fnrlvfachkennung),1,2);setzesonderwert(
+aktfach,fach);kennung:=subtext(wert(fnrlvfachkennung),3,6);setzesonderwert(
+aktkurs,kennung);jgstCAT wert(fnrlvjgst);IF length(jgst)>2THEN 
+setzesonderwert(aktjgst,subtext(jgst,2,3));ELSE setzesonderwert(aktjgst,jgst)
+;FI ;jgst:=blank;setzesonderwert(aktwochstd,wert(fnrlvwochenstd));
+briefalternative(dateimitvordruck3,hilfsdatei);succ(ixlvsjhjpar);PER ;END 
+PROC ggfvordruck21malundvordruck3xmalindruckdatei;PROC vordruck4indruckdatei(
+TEXT VAR sj,hj):LET hilfsdatei="hilfsdatei";TEXT VAR aufberwert:=niltext;
+BOOL VAR hilfsdateiangelegt:=FALSE ;TEXT VAR ueberschrift:="Schuljahr ";
+initialisieresonderwerte;aktswklassenlehrer:=580;aktswstellvertreter:=581;
+ueberschriftCAT subtext(sj,1,2)+"/"+subtext(sj,3,4);ueberschriftCAT ", "+hj+
+". Halbjahr";setzesonderwert(schulj,ueberschrift);inittupel(
+dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj);search(
+dnraktschuelergruppen,FALSE );WHILE dbstatus=0AND wert(fnrsgrphj)=hjREP IF 
+wert(fnrsgrplehrer)=angegebeneparapheAND aktswklassenlehrer<590THEN 
+aufberwert:=wert(fnrsgrpjgst);aufberwertCAT wert(fnrsgrpkennung);
+setzesonderwert(aktswklassenlehrer,aufberwert);aktswklassenlehrerINCR 2;
+hilfsdateiangelegt:=TRUE ;ELSE IF wert(fnrsgrpstellvlehrer)=angegebeneparaphe
+AND aktswstellvertreter<591THEN aufberwert:=wert(fnrsgrpjgst);aufberwertCAT 
+wert(fnrsgrpkennung);setzesonderwert(aktswstellvertreter,aufberwert);
+aktswstellvertreterINCR 2;hilfsdateiangelegt:=TRUE ;FI ;FI ;succ(
+dnraktschuelergruppen)PER ;IF hilfsdateiangelegtTHEN briefalternative(
+dateimitvordruck4,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);FI ;END 
+PROC vordruck4indruckdatei;PROC vordruck5indruckdatei(TEXT VAR sj,hj):LET 
+hilfsdatei="hilfsdatei";TEXT VAR zeitwuensche,ueberschrift:="Schuljahr ";
+initialisieresonderwerte;INT VAR aktswzeitwunsch:=531,position:=1,i;
+ueberschriftCAT subtext(sj,1,2)+"/"+subtext(sj,3,4);ueberschriftCAT ", "+hj+
+". Halbjahr";setzesonderwert(schulj,ueberschrift);inittupel(dnrzeitwuensche);
+putwert(fnrzwsj,sj);putwert(fnrzwhj,hj);putwert(fnrzwbezug,"P");putwert(
+fnrzwbezugsobjekt,angegebeneparaphe);search(dnrzeitwuensche,TRUE );IF 
+dbstatus=0THEN zeitwuensche:=wert(fnrzwunbestimmtewuensche);setzesonderwert(
+ganztage,zeitwuenscheSUB 1);setzesonderwert(ganzgew,zeitwuenscheSUB 3);
+setzesonderwert(vormtage,zeitwuenscheSUB 4);setzesonderwert(vormgew,
+zeitwuenscheSUB 6);setzesonderwert(nachtage,zeitwuenscheSUB 7);
+setzesonderwert(nachgew,zeitwuenscheSUB 9);zeitwuensche:=wert(
+fnrzwbestimmtewuensche);FOR iFROM 1UPTO 66REP setzesonderwert(aktswzeitwunsch
+,subtext(zeitwuensche,position,position+1));aktswzeitwunschINCR 1;position
+INCR 2PER ;briefalternative(dateimitvordruck5,hilfsdatei);
+hilfsdateiindruckdatei(hilfsdatei);FI ;END PROC vordruck5indruckdatei;END 
+PACKET auskunftlehrer;
+
diff --git a/app/schulis/2.2.1/src/3.erf lehrer b/app/schulis/2.2.1/src/3.erf lehrer
new file mode 100644
index 0000000..47846ee
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.erf lehrer
@@ -0,0 +1,134 @@
+PACKET erflehrerDEFINES erfassunglehrer:LET trenner=" = ",komma=", ",leer="",
+trennerfuerimbestand="�",dateinameschluessel="Schlüssel",dateinamefaecher=
+"Fächer",null=0;LET maskenname="ms erf lehrer",fnrletztesfeld=32,fnrparaphe=2
+,fnrfamilienname=3,fnrrufname=4,fnrnamenszusatz=5,fnramtsbezeichnung=6,
+fnrgeschlecht=7,fnrstrasseundnummer=8,fnrplzundort=9,fnrtelefon=10,
+fnrlehrbeffach=11,fnrlehrbefart=12,fnrpflichtstunden=23,fnrermaessigung=24,
+fnrermaessigungsgrund=25,fnrsprechzeiten=32,anzlehrbefprolehrer=6,
+anzermprolehrer=4;LET untergrenze=0,obergrenze=99,paraphenlaenge=4,
+bestandermgrund="c02 persoenl ermaess",bestandartlehrbef=
+"c02 art lehrbefaehigung",meldungparaphezulang=178,meldungzugeschlecht=55,
+meldungzumbestand=55,meldungzusollstunden=175,meldungzulehrbeffach=177,
+meldungzufachdoppelt=176;ROW anzlehrbefprolehrerSTRUCT (TEXT fach,art)VAR 
+altelehrbefaehigungen;TEXT VAR alteparaphe;INT VAR sollstunden;PROC 
+erfassunglehrer(INT CONST proznr):reinitparsing;SELECT proznrOF CASE 1:
+setzeerfassungsparameterCASE 2:zeigelehrerzurbearbeitungCASE 3:
+pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5:
+setzeidentiobjektfuerobjektlisteCASE 6:lehrerlesenCASE 7:lehreraendernCASE 8:
+lehrereinfuegenCASE 9:lehrerloeschenEND SELECT END PROC erfassunglehrer;PROC 
+setzeerfassungsparameter:systemdboff;setzeerfassungsparameter(dnrlehrer,
+maskenname,fnrletztesfeld).END PROC setzeerfassungsparameter;PROC 
+zeigelehrerzurbearbeitung:INT VAR i;alteparaphe:=wert(fnrlparaphe);
+setzeerfassungsfeld(wert(fnrlparaphe),fnrparaphe);setzeerfassungsfeld(wert(
+fnrlfamname),fnrfamilienname);setzeerfassungsfeld(wert(fnrlrufname),
+fnrrufname);setzeerfassungsfeld(wert(fnrlzusatz),fnrnamenszusatz);
+setzeerfassungsfeld(wert(fnrlamtsbeztitel),fnramtsbezeichnung);
+setzeerfassungsfeld(wert(fnrlgeschlecht),fnrgeschlecht);setzeerfassungsfeld(
+wert(fnrlpflichtstd),fnrpflichtstunden);FOR iFROM 0UPTO anzermprolehrer-1REP 
+setzeerfassungsfeld(wert(fnrlerm1+2*i),fnrermaessigung+2*i);
+setzeerfassungsfeld(wert(fnrlermgrund1+2*i),fnrermaessigungsgrund+2*i)PER ;
+FOR iFROM 0UPTO 5REP setzeerfassungsfeld(altelehrbefaehigungen(i+1).fach,
+fnrlehrbeffach+2*i);setzeerfassungsfeld(altelehrbefaehigungen(i+1).art,
+fnrlehrbefart+2*i)PER ;setzeerfassungsfeld(wert(fnrlsprechzeit),
+fnrsprechzeiten);setzeerfassungsfeld(wert(fnrlstrnr),fnrstrasseundnummer);
+setzeerfassungsfeld(wert(fnrlplzort),fnrplzundort);setzeerfassungsfeld(wert(
+fnrltelnr),fnrtelefon)END PROC zeigelehrerzurbearbeitung;PROC 
+pruefeplausibilitaet:INT VAR i,j,fehlerstatus;pruefe(1,erfassungsmaske,PROC 
+erfassungswert,fnrparaphe,null,null,leer,fehlerstatus);IF fehlerstatus<>0
+THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;IF length(
+erfassungswert(fnrparaphe))>paraphenlaengeTHEN meldeauffaellig(
+erfassungsmaske,meldungparaphezulang);setzefehlerstatus(fnrparaphe);LEAVE 
+pruefeplausibilitaetFI ;pruefe(1,erfassungsmaske,PROC erfassungswert,
+fnrfamilienname,null,null,leer,fehlerstatus);IF fehlerstatus<>0THEN 
+setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;IF 
+erfassungswert(fnrgeschlecht)<>"m"AND erfassungswert(fnrgeschlecht)<>"w"THEN 
+meldeauffaellig(erfassungsmaske,meldungzugeschlecht);setzefehlerstatus(
+fnrgeschlecht);LEAVE pruefeplausibilitaetFI ;FOR iFROM 0UPTO 
+anzlehrbefprolehrer-1REP IF erfassungswert(fnrlehrbefart+2*i)<>""THEN IF 
+erfassungswert(fnrlehrbeffach+2*i)=""THEN meldeauffaellig(erfassungsmaske,
+meldungzulehrbeffach);setzefehlerstatus(fnrlehrbeffach+2*i);LEAVE 
+pruefeplausibilitaetFI ;IF NOT imbestand(bestandartlehrbef+
+trennerfuerimbestand+erfassungswert(fnrlehrbefart+2*i),dateinameschluessel)
+THEN meldeauffaellig(erfassungsmaske,meldungzumbestand);setzefehlerstatus(
+fnrlehrbefart+2*i);LEAVE pruefeplausibilitaetFI FI ;IF erfassungswert(
+fnrlehrbeffach+2*i)<>""THEN FOR jFROM i+1UPTO anzlehrbefprolehrer-1REP IF 
+erfassungswert(fnrlehrbeffach+2*i)=erfassungswert(fnrlehrbeffach+2*j)THEN 
+meldeauffaellig(erfassungsmaske,meldungzufachdoppelt);setzefehlerstatus(
+fnrlehrbeffach+2*i);LEAVE pruefeplausibilitaetFI PER ;IF NOT imbestand(
+erfassungswert(fnrlehrbeffach+2*i),dateinamefaecher)THEN meldeauffaellig(
+erfassungsmaske,meldungzumbestand);setzefehlerstatus(fnrlehrbeffach+2*i);
+LEAVE pruefeplausibilitaetFI FI PER ;IF erfassungswert(fnrpflichtstunden)<>""
+THEN pruefe(2,erfassungsmaske,PROC erfassungswert,fnrpflichtstunden,null,null
+,leer,fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);
+LEAVE pruefeplausibilitaetFI ;pruefe(3,erfassungsmaske,PROC erfassungswert,
+fnrpflichtstunden,untergrenze,obergrenze,leer,fehlerstatus);IF fehlerstatus<>
+0THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;FI ;
+sollstunden:=int(erfassungswert(fnrpflichtstunden));FOR iFROM 0UPTO 
+anzermprolehrer-1REP IF erfassungswert(fnrermaessigung+2*i)<>""THEN pruefe(2,
+erfassungsmaske,PROC erfassungswert,fnrermaessigung+2*i,null,null,leer,
+fehlerstatus);IF fehlerstatus<>0THEN setzefehlerstatus(fehlerstatus);LEAVE 
+pruefeplausibilitaetFI ;pruefe(3,erfassungsmaske,PROC erfassungswert,
+fnrermaessigung+2*i,untergrenze,obergrenze,leer,fehlerstatus);IF fehlerstatus
+<>0THEN setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;FI ;
+sollstunden:=sollstunden-int(erfassungswert(fnrermaessigung+2*i));IF 
+sollstunden<0THEN meldeauffaellig(erfassungsmaske,meldungzusollstunden);
+setzefehlerstatus(fnrermaessigung+2*i);LEAVE pruefeplausibilitaetFI ;IF 
+erfassungswert(fnrermaessigungsgrund+2*i)<>""THEN IF NOT imbestand(
+bestandermgrund+trennerfuerimbestand+erfassungswert(fnrermaessigungsgrund+2*i
+),dateinameschluessel)THEN meldeauffaellig(erfassungsmaske,meldungzumbestand)
+;setzefehlerstatus(fnrermaessigungsgrund+2*i);LEAVE pruefeplausibilitaetFI 
+FI PER END PROC pruefeplausibilitaet;PROC setzewertefuerdbspeicherung:INT 
+VAR i;putwert(fnrlparaphe,erfassungswert(fnrparaphe));putwert(fnrlfamname,
+erfassungswert(fnrfamilienname));putwert(fnrlrufname,erfassungswert(
+fnrrufname));putwert(fnrlzusatz,erfassungswert(fnrnamenszusatz));putwert(
+fnrlamtsbeztitel,erfassungswert(fnramtsbezeichnung));putwert(fnrlgeschlecht,
+erfassungswert(fnrgeschlecht));putintwert(fnrlsollstd,sollstunden);putwert(
+fnrlpflichtstd,erfassungswert(fnrpflichtstunden));FOR iFROM 0UPTO 
+anzermprolehrer-1REP putwert(fnrlerm1+2*i,erfassungswert(fnrermaessigung+2*i)
+);putwert(fnrlermgrund1+2*i,erfassungswert(fnrermaessigungsgrund+2*i))PER ;
+putwert(fnrlsprechzeit,erfassungswert(fnrsprechzeiten));putwert(fnrlstrnr,
+erfassungswert(fnrstrasseundnummer));putwert(fnrlplzort,erfassungswert(
+fnrplzundort));putwert(fnrltelnr,erfassungswert(fnrtelefon))END PROC 
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET 
+trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(fnrlparaphe)+
+trenner+wert(fnrlfamname)+komma+wert(fnrlrufname);setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+
+trennsymbolfuerobli+wert(fnrlparaphe).END PROC 
+setzeidentiobjektfuerobjektliste;PROC lehrerlesen:INT VAR i,j;putwert(
+fnrlparaphe,schluessel);search(dnrlehrer,TRUE );IF dbstatus=okTHEN 
+saveupdateposition(dnrlehrer);putwert(fnrlbparaphe,schluessel);putwert(
+fnrlbfach,leer);search(ixlbpar);i:=0;WHILE dbstatus=okCAND i<
+anzlehrbefprolehrerCAND wert(fnrlbparaphe)=schluesselREP i:=i+1;
+altelehrbefaehigungen(i).fach:=wert(fnrlbfach);altelehrbefaehigungen(i).art:=
+wert(fnrlbart);succ(ixlbpar);PER ;FOR jFROM i+1UPTO anzlehrbefprolehrerREP 
+altelehrbefaehigungen(j).fach:="";altelehrbefaehigungen(j).art:=""PER ;
+dbstatus(ok)FI END PROC lehrerlesen;PROC lehreraendern:INT VAR i;
+restoreupdateposition(dnrlehrer);update(dnrlehrer);logbucheintrag("Änderung")
+;FOR iFROM 0UPTO anzlehrbefprolehrer-1REP IF alteparaphe<>schluesselCOR 
+erfassungswert(fnrlehrbeffach+2*i)<>altelehrbefaehigungen(i+1).fachCOR 
+erfassungswert(fnrlehrbefart+2*i)<>altelehrbefaehigungen(i+1).artTHEN IF 
+altelehrbefaehigungen(i+1).fach=leerCAND erfassungswert(fnrlehrbeffach+2*i)<>
+leerTHEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2*i));putwert(
+fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe,schluessel);
+insert(dnrlehrbefaehigungen)ELSE putwert(fnrlbfach,altelehrbefaehigungen(i+1)
+.fach);putwert(fnrlbparaphe,alteparaphe);putwert(fnrlbart,
+altelehrbefaehigungen(i+1).art);IF erfassungswert(fnrlehrbeffach+2*i)=leer
+THEN delete(dnrlehrbefaehigungen)ELSE search(dnrlehrbefaehigungen,TRUE );IF 
+dbstatus=okTHEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2*i));putwert
+(fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe,schluessel)
+;update(dnrlehrbefaehigungen)FI FI FI ;dbstatus(ok)FI PER END PROC 
+lehreraendern;PROC lehrereinfuegen:INT VAR i;insert(dnrlehrer);logbucheintrag
+("Neueinfügen");FOR iFROM 0UPTO anzlehrbefprolehrer-1REP IF erfassungswert(
+fnrlehrbeffach+2*i)<>""THEN putwert(fnrlbfach,erfassungswert(fnrlehrbeffach+2
+*i));putwert(fnrlbart,erfassungswert(fnrlehrbefart+2*i));putwert(fnrlbparaphe
+,schluessel);insert(dnrlehrbefaehigungen)FI PER END PROC lehrereinfuegen;
+PROC lehrerloeschen:delete(dnrlehrer);logbucheintrag("Entfernen");putwert(
+fnrlbparaphe,schluessel);putwert(fnrlbfach,leer);search(ixlbpar);WHILE 
+dbstatus=okCAND wert(fnrlbparaphe)=schluesselREP delete(dnrlehrbefaehigungen)
+;succ(ixlbpar);PER ;dbstatus(ok)END PROC lehrerloeschen;PROC logbucheintrag(
+TEXT CONST logergaenzung):TEXT VAR eintrag:="Anw. 3.1.1 ";eintragCAT 
+logergaenzung;eintragCAT " """;eintragCAT schluessel;eintragCAT """  """;
+eintragCAT wert(fnrlfamname);eintragCAT """";logeintrag(eintrag)END PROC 
+logbucheintrag;TEXT PROC schluessel:erfassungswert(fnrparaphe)END PROC 
+schluessel;END PACKET erflehrer
+
diff --git a/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise b/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise
new file mode 100644
index 0000000..d9c03b3
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listen.lehrbef faecherweise
@@ -0,0 +1,104 @@
+PACKET lehrbefaehigungenfaecherweiselisteDEFINES 
+faecherwlehrbeflispezielleteile:LET lehrbefaehigungeingangsmaske=
+"ms liste lehrbefaehigungen faecherweise eingang",
+anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,lehrbefaehigunganfpos=2,
+spaltenbreite1fach=12,spaltenbreite2art=6,spaltenbreite3paraphe=4,
+spaltentrenner=" ",wochenstdanfpos=2,ueberschriftenzeilen=2,ausgkopflaenge=2,
+strich="-",blank=" ",null=0,niltext="",mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=352;TEXT CONST spaltentext:=("Fach"+9*blank+"Art"+3*blank
++"Lehrer"),spaltenstrich:=length(spaltentext)*strich;TEXT VAR 
+lehrbefaehigungueberschriftbs:="Liste der Lehrbefähigungen",
+lehrbefaehigungueberschriftdr:="Liste der Lehrbefähigungen",alteparahpe:="",
+paraphe:="",alteart:="",art:="",altesfach:="",fach:="",teiltextmeldung:=
+"Fächer mit den Anfangsbuchstaben:",anfbuchstabe:="",neueranfbuchstabe:="";
+INT VAR eingabestatus,bildanfang,druckzeilenzahl;LET AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW 
+ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;
+AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop;
+PROC faecherwlehrbeflispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+faecherwlehrbefaehigungdialogvorbereitenCASE 2:
+faecherwlehrbefaehigungeingabenrichtigCASE 3:
+faecherwlehrbefaehigunglistenvorbereitenCASE 4:
+faecherwlehrbefaehigungdruckvorbereitenCASE 5:
+faecherwlehrbefaehigungseitedruckenCASE 6:
+faecherwlehrbefaehigungbildschirmvorbereitenCASE 7:
+faecherwlehrbefaehigungseitezeigenENDSELECT .END PROC 
+faecherwlehrbeflispezielleteile;PROC faecherwlehrbefaehigungdialogvorbereiten
+:lehrbefaehigungueberschriftbs:=text(vergleichsknoten);setzeanfangswerte(
+lehrbefaehigungeingangsmaske,lehrbefaehigunganfpos)END PROC 
+faecherwlehrbefaehigungdialogvorbereiten;PROC 
+faecherwlehrbefaehigungeingabenrichtig:LET fnrausgdrucker=2,fnrausgbild=3;
+standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF 
+eingabestatus=0THEN setzeeingabetest(TRUE );setzeausgabedrucker(
+standardmaskenfeld(fnrausgbild)=niltext);ELSE meldefehler;setzeeingabetest(
+FALSE )FI ;.meldefehler:standardmeldung(mnrauswahlnichtsinnvoll,niltext).END 
+PROC faecherwlehrbefaehigungeingabenrichtig;PROC 
+faecherwlehrbefaehigunglistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);inittupel(dnrlehrbefaehigungen);
+setzeidentiwert("");initobli(anzahlderobjekteprobildschirm);
+objektlistestarten(ixlbart,"",0,TRUE ,b);setzebestandende(b);END PROC 
+faecherwlehrbefaehigunglistenvorbereiten;PROC 
+faecherwlehrbefaehigungbildschirmvorbereiten:LET fnrausganf=2;
+standardkopfmaskeaktualisieren(lehrbefaehigungueberschriftbs);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);setzespaltenbreite(bildbreite
+);spaltenweise(spaltentext);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;spaltenweise(spaltenstrich);ausgfeld(1):=zeile;
+ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;setzebildanfangsposition(4);
+spaltenbreitensetzenEND PROC faecherwlehrbefaehigungbildschirmvorbereiten;
+PROC faecherwlehrbefaehigungseitezeigen:altesfach:=niltext;alteart:=niltext;
+blaettern(PROC (INT CONST )lehrbefdatenfachweisezeigen,aktion,TRUE ,FALSE ,
+BOOL PROC multistop)END PROC faecherwlehrbefaehigungseitezeigen;PROC 
+lehrbefdatenfachweisezeigen(INT CONST x):
+datenausdateilehrbefaehigungenfachweiseholen;
+datenausdateilehrbefaehigungenfachweiseaufbereitenbild;
+datenfachweiseaufbildschirmausgebenEND PROC lehrbefdatenfachweisezeigen;PROC 
+datenausdateilehrbefaehigungenfachweiseholen:fach:=wert(fnrlbfach);art:=wert(
+fnrlbart);paraphe:=wert(fnrlbparaphe)END PROC 
+datenausdateilehrbefaehigungenfachweiseholen;PROC 
+datenausdateilehrbefaehigungenfachweiseaufbereitenbild:IF fach<>altesfach
+THEN spaltenweise(fach);spaltenweise(art)ELSE spaltenweise(blank);IF art<>
+alteartTHEN spaltenweise(art)ELSE spaltenweise(blank)FI ;FI ;spaltenweise(
+paraphe);alteparahpe:=paraphe;altesfach:=fach;alteart:=art;END PROC 
+datenausdateilehrbefaehigungenfachweiseaufbereitenbild;PROC 
+datenfachweiseaufbildschirmausgeben:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge
+REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;
+END PROC datenfachweiseaufbildschirmausgeben;PROC 
+faecherwlehrbefaehigungdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe
+:=" ";druckvorbereiten;variablenfuerdrucksetzen;lehrbefaehigungueberschriftdr
+CAT " fachweise";initdruckkopf(zentriert(lehrbefaehigungueberschriftdr,
+druckbreite),zentriert(length(lehrbefaehigungueberschriftdr)*"-",druckbreite)
+);spaltenbreitensetzen;initausgabekopfdruck;inittupel(dnrlehrbefaehigungen);
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistop);.variablenfuerdrucksetzen:druckzeilenzahl:=drucklaenge(
+ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+faecherwlehrbefaehigungdruckvorbereiten;PROC initausgabekopfdruck:
+ausgkopfdruck(1):=spaltentext;ausgkopfdruck(2):=spaltenstrichEND PROC 
+initausgabekopfdruck;PROC faecherwlehrbefaehigungseitedrucken:
+lehrbefaehigungueberschriftdrucken;altesfach:=niltext;alteart:=niltext;
+seitedrucken(PROC (INT VAR )lehrbefaehigungdrucken,druckzeilenzahl,
+ausgfeldlaenge,BOOL PROC multistop);seitenwechselEND PROC 
+faecherwlehrbefaehigungseitedrucken;PROC lehrbefaehigungueberschriftdrucken:
+INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP 
+druckzeileschreiben(ausgkopfdruck(i))PER END PROC 
+lehrbefaehigungueberschriftdrucken;PROC lehrbefaehigungdrucken(INT VAR 
+zeilenzaehler):LET markiert="#";datenausdateilehrbefaehigungenfachweiseholen;
+ggflmeldunganfbuchstabe;IF fach<>altesfachTHEN spaltenweise(blank);
+spaltenweise(blank);spaltenweise(blank);ausgfeld(1):=zeile;zeilenzaehlerINCR 
+ausgfeldlaenge;lehrerstundendatenindruckdateiFI ;
+lehrerstundendatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge;
+lehrerstundendatenindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:
+neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+lehrbefaehigungdrucken;PROC lehrerstundendatenaufbereitendruck:
+setzespaltentrenner(spaltentrenner);
+datenausdateilehrbefaehigungenfachweiseaufbereitenbild;ausgfeld(1):=zeile;
+END PROC lehrerstundendatenaufbereitendruck;PROC 
+lehrerstundendatenindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfeld(1))PER END PROC lehrerstundendatenindruckdatei;
+PROC spaltenbreitensetzen:initspalten;setzespaltenbreite(spaltenbreite1fach);
+setzespaltenbreite(spaltenbreite2art);setzespaltenbreite(
+spaltenbreite3paraphe);END PROC spaltenbreitensetzen;END PACKET 
+lehrbefaehigungenfaecherweiseliste;
+
diff --git a/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise b/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise
new file mode 100644
index 0000000..1c3e172
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listen.lehrbef lehrerweise
@@ -0,0 +1,100 @@
+PACKET lehrbefaehigungenlehrerweiselisteDEFINES 
+lehrerwlehrbeflidruckenoderzeigen:LET datenraum="datenraum",ausgkopflaenge=2,
+ueberschriftenzeilen=2,anzahlparapheninlehrbef=300,neunfelder=9,niltext="",
+blank=" ",null=0,strich="-",mnrbearbeitetwerden=352,mnrlistewirdgedruckt=58,
+mnrauswahlnichtsinnvoll=56,mnrlistewirdaufbereiet=190;INT VAR zeilenzaehler,
+druckzeilenzahl,anzahlparindateilehrbef,anzahlparindateilehrer,x,y,
+eingabestatus;BOUND ROW anzahlparapheninlehrbefROW neunfelderTEXT VAR 
+datenauszweidateien;FILE VAR ausgabedatei;TEXT CONST ausgabedateiname:=
+"Liste der Lehrbefähigungen",teiltextmeldung:=
+"Lehrerparaphen mit den Anfangsbuchstaben:",spaltentext:=
+"Lehrer  Soll. Pfl.  Lehrbefähigung Fach/Art",tasten:="vr",spaltenstrich:=60*
+strich;TEXT VAR neueranfbuchstabe:="",anfbuchstabe:="",ueberschrift:=
+"Liste der Lehrbefähigungen aller Lehrer",paraphe:="",aufbereitetezeile:="";
+BOOL VAR ausgabedrucker:=FALSE ;LET AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;
+AUSGKOPFDRUCK VAR ausgkopfdruck;PROC lehrerwlehrbeflidruckenoderzeigen(INT 
+CONST nr):anzahlparindateilehrer:=int(records(dnrlehrer));SELECT nrOF CASE 1:
+druckenoderbildschirmausgabeCASE 2:druckennachbildschirmausgabe;return(2);
+forget(ausgabedateiname,quiet)CASE 3:rowimdatenraumloeschen;enter(2);forget(
+ausgabedateiname,quiet)ENDSELECT .END PROC lehrerwlehrbeflidruckenoderzeigen;
+PROC rowimdatenraumloeschen:forget(datenraum,quiet)END PROC 
+rowimdatenraumloeschen;PROC druckennachbildschirmausgabe:
+lehrerwlehrbefdruckenEND PROC druckennachbildschirmausgabe;PROC 
+druckenoderbildschirmausgabe:LET fnrausgdrucker=2,fnrausgbild=3;IF 
+eingabenrichtigTHEN standardmeldung(mnrlistewirdaufbereiet,niltext);
+datenauszweidateienholenundimrowablegen;ausgabedrucker:=(standardmaskenfeld(
+fnrausgbild)=niltext);IF ausgabedruckerTHEN lehrerwlehrbefdrucken;return(1);
+ELSE ausgabedatei:=sequentialfile(output,"Liste der Lehrbefähigungen");
+lehrerwlehrbefaufbildschirmzeigenFI ;ELSE meldefehler;return(1)FI ;.
+eingabenrichtig:standardpruefe(5,fnrausgdrucker,fnrausgbild,null,niltext,
+eingabestatus);IF eingabestatus=0THEN TRUE ELSE FALSE FI .meldefehler:
+standardmeldung(mnrauswahlnichtsinnvoll,niltext)END PROC 
+druckenoderbildschirmausgabe;PROC lehrerwlehrbefaufbildschirmzeigen:
+datenausrowinshowdateischreiben;dateiaufbildschirmausgeben;END PROC 
+lehrerwlehrbefaufbildschirmzeigen;PROC lehrerwlehrbefdrucken:
+druckdateimitrowdatenfuellendruckenundloeschen;rowimdatenraumloeschenEND 
+PROC lehrerwlehrbefdrucken;PROC 
+druckdateimitrowdatenfuellendruckenundloeschen:TEXT VAR zeile;INT VAR 
+zeilenanz:=1,x:=1;druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(
+ueberschrift);initausgabekopfdruck;druckkopfschreiben;
+spaltenueberschriftdrucken;setzemitseitennummern(TRUE );x:=1;zeilenzaehler:=1
+;WHILE zeilenanz<=anzahlparindateilehrbefREP zeileaufbereiten;
+ggfmeldunganfbuchstabe;neueranfbuchstabe:=anfbuchstabe;IF zeilenzaehler>
+druckzeilenzahlTHEN seitenwechsel;spaltenueberschriftdrucken;zeilenzaehler:=0
+;FI ;druckzeileschreiben(zeile);xINCR 1;zeilenanzINCR 1;zeilenzaehlerINCR 1;
+PER ;standardmeldung(mnrlistewirdgedruckt,niltext);drucknachbereiten;.
+ggfmeldunganfbuchstabe:IF anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .
+anfbuchstabegeaendert:anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:
+LET markiert="#";standardmeldung(mnrbearbeitetwerden,teiltextmeldung+
+neueranfbuchstabe+markiert);.variablenfuerdrucksetzen:druckzeilenzahl:=
+drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.zeileaufbereiten:y:=1;zeile
+:=text(datenauszweidateien(x)(y),8);FOR yFROM 8UPTO neunfelderREP zeileCAT 
+text(datenauszweidateien(x)(y),6)PER ;FOR yFROM 2UPTO 7REP zeileCAT text(
+datenauszweidateien(x)(y),7)PER ;anfbuchstabe:=(datenauszweidateien(x)(1))
+SUB 1;END PROC druckdateimitrowdatenfuellendruckenundloeschen;PROC 
+initausgabekopfdruck:ausgkopfdruck(1):=spaltentext;ausgkopfdruck(2):=
+spaltenstrichEND PROC initausgabekopfdruck;PROC spaltenueberschriftdrucken:
+INT VAR l;FOR lFROM 1UPTO ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck
+(l))PER END PROC spaltenueberschriftdrucken;PROC 
+datenausrowinshowdateischreiben:putline(ausgabedatei,blank);putline(
+ausgabedatei,spaltentext);putline(ausgabedatei,spaltenstrich);putline(
+ausgabedatei,blank);FOR xFROM 1UPTO anzahlparindateilehrbefREP 
+zeileaufbereiten;aufbereitetezeileindateischreibenPER .zeileaufbereiten:y:=1;
+aufbereitetezeile:=text(datenauszweidateien(x)(y),8);FOR yFROM 8UPTO 
+neunfelderREP aufbereitetezeileCAT text(datenauszweidateien(x)(y),6)PER ;FOR 
+yFROM 2UPTO 7REP aufbereitetezeileCAT text(datenauszweidateien(x)(y),7)PER ;.
+aufbereitetezeileindateischreiben:putline(ausgabedatei,aufbereitetezeile);
+aufbereitetezeile:=niltextEND PROC datenausrowinshowdateischreiben;PROC 
+dateiaufbildschirmausgeben:zeigedatei(ausgabedateiname,tasten);END PROC 
+dateiaufbildschirmausgeben;PROC datenauszweidateienholenundimrowablegen:
+datenauszweidateien:=new(datenraum);lehrerdatenrowinitialisieren;inittupel(
+ixlbpar);x:=0;y:=1;statleseschleife(ixlbpar,"","",fnrlbparaphe,fnrlbfach,
+PROC holedatenausdateilehrbefaehigungeninsrow);anzahlparindateilehrbef:=x;
+inittupel(dnrlehrer);x:=1;y:=1;statleseschleife(dnrlehrer,"","",fnrlparaphe,
+fnrlfamname,PROC holedatenausdateilehrerinsrow);.lehrerdatenrowinitialisieren
+:FOR xFROM 1UPTO anzahlparindateilehrerREP FOR yFROM 1UPTO neunfelderREP 
+datenauszweidateien(x)(y):=niltext;PER ;PER END PROC 
+datenauszweidateienholenundimrowablegen;PROC 
+holedatenausdateilehrbefaehigungeninsrow(BOOL VAR b):IF dbstatus<>0THEN b:=
+TRUE ELSE IF paraphe<>wert(fnrlbparaphe)THEN xINCR 1;y:=1;paraphe:=wert(
+fnrlbparaphe);datenauszweidateien(x)(y):=paraphe;FI ;yINCR 1;
+datenauszweidateien(x)(y):=text(wert(fnrlbfach),2)+"/"+wert(fnrlbart);FI ;
+END PROC holedatenausdateilehrbefaehigungeninsrow;PROC 
+holedatenausdateilehrerinsrow(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE IF 
+wert(fnrlparaphe)=datenauszweidateien(x)(1)THEN datenauszweidateien(x)(8):=
+wert(fnrlsollstd);datenauszweidateien(x)(9):=wert(fnrlpflichtstd);xINCR 1;FI 
+;FI ;END PROC holedatenausdateilehrerinsrow;PROC statleseschleife(INT CONST 
+indexnummer,TEXT CONST startschluessel1,startschluessel2,INT CONST feldnr1,
+feldnr2,PROC (BOOL VAR )stataktion):vorbereitungen;leseschleife.
+vorbereitungen:LET maxleseanzahl=10;BOOL VAR vorzeitigesende:=FALSE ;#INT 
+CONST maxblock:=maxfeldDIV zahlderfelder;#INT VAR anzahltupel;#INT CONST 
+maxanzahl:=(maxintDIV maxblock)*maxblock#.leseschleife:putwert(feldnr1,
+startschluessel1);putwert(feldnr2,startschluessel2);search(indexnummer);IF 
+dbstatus=0THEN einleseschleifeFI .einleseschleife:zaehlen;WHILE NOT schluss
+REP anzahltupel:=maxleseanzahl;multisucc(indexnummer,anzahltupel);
+stackdurchlaufPER ;.stackdurchlauf:IF anzahltupel=0THEN dbstatus(1)ELSE 
+WHILE anzahltupel<>0REP lesen;zaehlen;IF vorzeitigesendeTHEN dbstatus(1);
+anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0.zaehlen:stataktion(
+vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END PROC statleseschleife
+;END PACKET lehrbefaehigungenlehrerweiseliste;
+
diff --git a/app/schulis/2.2.1/src/3.listen.paraphen b/app/schulis/2.2.1/src/3.listen.paraphen
new file mode 100644
index 0000000..d45d2c7
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listen.paraphen
@@ -0,0 +1,81 @@
+PACKET lehrerparaphenlistenDEFINES parlispezielleteile:LET parlieingangsmaske
+="ms liste lehrerparaphen eingang",spaltentrenner=" ",parlianfpos=2,
+spalte1breite=7,niltext="",blank=" ",komma=",",null=0,ueberschriftenzeilen=2,
+mnrauswahlnichtsinnvoll=56,mnrbearbeitetwerden=352,ausgkopflaenge=2,
+ausgfeldlaenge=1,anzahlderobjekteprobildschirm=19;TEXT VAR parliueberschrift
+:="Liste der Lehrerparaphen",lehrername,rufname,namenszusatz,amtsbez,anrede,
+geschlecht,paraphe,anfbuchstabe,neueranfbuchstabe:="",lehrernameaufbereitet,
+auswahlnichtsinnvoll,teiltextmeldung:=
+"die Paraphe mit dem Anfangsbuchstaben:";INT VAR aktuelleindexnr,
+eingabestatus,lesestart,bildanfang,spalte2druckbreite,druckzeilenzahl;INT 
+CONST indexlehrername:=ixlfamruf,spalte2bildbreite:=bildbreite-spalte1breite-
+1;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW ausgfeldlaengeTEXT ,
+AUSGKOPF =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf
+;BOOL PROC multistop:TRUE END PROC multistop;PROC parlispezielleteile(INT 
+CONST nr):SELECT nrOF CASE 1:parlidialogvorbereitenCASE 2:
+parlieingabenrichtigCASE 3:parlilistenvorbereitenCASE 4:parlidruckvorbereiten
+CASE 5:parliseitedruckenCASE 6:parlibildschirmvorbereitenCASE 7:
+parliseitezeigenENDSELECT .END PROC parlispezielleteile;PROC 
+parlidialogvorbereiten:parliueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(parlieingangsmaske,parlianfpos)END PROC 
+parlidialogvorbereiten;PROC parlieingabenrichtig:LET fnrsortparaphen=2,
+fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5,
+fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0
+THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext,
+eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE 
+);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE 
+meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest(
+FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld(
+fnrsortparaphen)<>niltext.meldefehler:meldungstext(mnrauswahlnichtsinnvoll,
+auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC 
+parlieingabenrichtig;PROC parlilistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);IF sortierungnachparaphenTHEN 
+aktuelleindexnr:=dnrlehrer;lesestart:=fnrlparapheELSE aktuelleindexnr:=
+indexlehrername;lesestart:=0;FI ;inittupel(dnrlehrer);setzeidentiwert("");
+initobli(anzahlderobjekteprobildschirm);parsenooffields(6);objektlistestarten
+(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(NOT multistopCOR b);
+END PROC parlilistenvorbereiten;PROC parlibildschirmvorbereiten:LET 
+fnrausganf=2;standardkopfmaskeaktualisieren(parliueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2bildbreite);END PROC 
+parlibildschirmvorbereiten;PROC parliseitezeigen:blaettern(PROC (INT CONST )
+lehrerdatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC 
+parliseitezeigen;PROC lehrerdatenzeigen(INT CONST x):lehrerdatenholen;
+lehrerdatenaufbereitenbild;lehrerdatenaufbildschirm.END PROC 
+lehrerdatenzeigen;PROC lehrerdatenholen:paraphe:=wert(fnrlparaphe);lehrername
+:=wert(fnrlfamname);rufname:=wert(fnrlrufname);namenszusatz:=wert(fnrlzusatz)
+;amtsbez:=wert(fnrlamtsbeztitel);geschlecht:=wert(fnrlgeschlecht);IF 
+geschlecht="w"XOR geschlecht="W"THEN anrede:="Fr. "ELSE anrede:="Hr. "FI ;
+lehrernameaufbereitet:=(lehrername+komma+blank+anrede+amtsbezeichnung+rufname
++blank+namenszusatz);.amtsbezeichnung:IF amtsbez<>niltextTHEN amtsbez+blank
+ELSE ""FI .END PROC lehrerdatenholen;PROC lehrerdatenaufbereitenbild:
+spaltenweise(paraphe);spaltenweise(lehrernameaufbereitet);END PROC 
+lehrerdatenaufbereitenbild;PROC lehrerdatenaufbildschirm:INT VAR i;FOR iFROM 
+1UPTO ausgfeldlaengeREP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;
+erhoeheausgabeposumeins;PER ;END PROC lehrerdatenaufbildschirm;PROC 
+parlidruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" ";
+druckvorbereiten;variablenfuerdrucksetzen;spalte2druckbreite:=druckbreite-(
+spalte1breite+1);initdruckkopf(zentriert(parliueberschrift,druckbreite),
+zentriert(length(parliueberschrift)*"-",druckbreite));initspalten;
+setzespaltenbreite(spalte1breite);setzespaltenbreite(spalte2druckbreite);
+inittupel(dnrlehrer);lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+parlidruckvorbereiten;PROC parliseitedrucken:parliueberschriftdrucken;
+seitedrucken(PROC (INT VAR )lehrerdrucken,druckzeilenzahl,ausgfeldlaenge,
+BOOL PROC multistop);seitenwechsel.END PROC parliseitedrucken;PROC 
+parliueberschriftdrucken:druckkopfschreiben.END PROC parliueberschriftdrucken
+;PROC lehrerdrucken(INT VAR zeilenzaehler):LET markiert="#";lehrerdatenholen;
+ggflmeldunganfbuchstabe;lehreraufbereitendruck;zeilenzaehlerINCR 
+ausgfeldlaenge;lehrerindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF 
+sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE 
+neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+lehrerdrucken;PROC lehreraufbereitendruck:spaltenweise(paraphe);spaltenweise(
+lehrernameaufbereitet);ausgfeld(1):=zeile;END PROC lehreraufbereitendruck;
+PROC lehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfeld(1))PER .END PROC lehrerindruckdatei;END PACKET 
+lehrerparaphenlisten;
+
diff --git a/app/schulis/2.2.1/src/3.listen.sprechzeiten b/app/schulis/2.2.1/src/3.listen.sprechzeiten
new file mode 100644
index 0000000..7f33cb7
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listen.sprechzeiten
@@ -0,0 +1,99 @@
+PACKET lehrersprechzeitenlisteDEFINES sprechzeitlispezielleteile:LET 
+sprechzeingangsmaske="ms liste lehrerparaphen eingang",
+anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,spalte1breite=46,
+spalte2breite=25,spaltentrenner=": ",sprechzanfpos=2,ueberschriftenzeilen=2,
+strich="-",niltext="",blank=" ",komma=",",null=0,ausgkopflaenge=2,
+mittelstrich="-",teilueb1="Lehrer",teilueb2="Sprechzeiten",
+mnrauswahlnichtsinnvoll=56,mnrbearbeitetwerden=352;TEXT VAR 
+sprechzueberschrift:="Liste der Lehrersprechzeiten",paraphe,lehrername,
+lehrernameaufbereitet,lehrernameaufbereitetmitparaphe,rufname,namenszusatz,
+amtsbez,geschlecht,sprechzeit,druckstrich,textueberschrift,teiltextmeldung:=
+"die Lehrer mit den Anfangsbuchstaben:",anfbuchstabe,neueranfbuchstabe:="",
+auswahlnichtsinnvoll;INT VAR aktuelleindexnr,eingabestatus,lesestart,
+bildanfang,druckzeilenzahl;INT CONST indexlehrername:=ixlfamruf,
+maxspaltenlaengepara:=5;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW 
+ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;
+AUSGKOPFDRUCK VAR ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop;
+PROC sprechzeitlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+sprechzdialogvorbereitenCASE 2:sprechzeingabenrichtigCASE 3:
+sprechzlistenvorbereitenCASE 4:sprechzdruckvorbereitenCASE 5:
+sprechzseitedruckenCASE 6:sprechzbildschirmvorbereitenCASE 7:
+sprechzseitezeigenENDSELECT .END PROC sprechzeitlispezielleteile;PROC 
+sprechzdialogvorbereiten:sprechzueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(sprechzeingangsmaske,sprechzanfpos)END PROC 
+sprechzdialogvorbereiten;PROC sprechzeingabenrichtig:LET fnrsortparaphen=2,
+fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5,
+fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0
+THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext,
+eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE 
+);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE 
+meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest(
+FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld(
+fnrsortparaphen)<>niltext.meldefehler:meldungstext(mnrauswahlnichtsinnvoll,
+auswahlnichtsinnvoll);standardmeldung(auswahlnichtsinnvoll,niltext).END PROC 
+sprechzeingabenrichtig;PROC sprechzlistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);IF sortierungnachparaphenTHEN 
+aktuelleindexnr:=dnrlehrer;lesestart:=fnrlparapheELSE aktuelleindexnr:=
+indexlehrername;lesestart:=0;FI ;inittupel(dnrlehrer);setzeidentiwert("");
+initobli(anzahlderobjekteprobildschirm);parsenooffields(17);
+objektlistestarten(aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(b);
+END PROC sprechzlistenvorbereiten;PROC sprechzbildschirmvorbereiten:LET 
+fnrausganf=2;standardkopfmaskeaktualisieren(sprechzueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite(
+bildbreite);textueberschrift:=teilueb1+((spalte1breite+1)-(length(teilueb1)))
+*blank+teilueb2;spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)
+IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(bildbreite*strich);
+ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+setzebildanfangsposition(4);initspalten;setzespaltenbreite(spalte1breite);
+setzespaltenbreite(spalte2breite);END PROC sprechzbildschirmvorbereiten;PROC 
+sprechzseitezeigen:blaettern(PROC (INT CONST )lehrerdatenzeigen,aktion,TRUE ,
+FALSE ,BOOL PROC multistop)END PROC sprechzseitezeigen;PROC lehrerdatenzeigen
+(INT CONST x):lehrerdatenholen;lehrerdatenaufbereitenbild;
+lehrerdatenaufbildschirm.END PROC lehrerdatenzeigen;PROC lehrerdatenholen:
+paraphe:=wert(fnrlparaphe);lehrername:=wert(fnrlfamname);rufname:=wert(
+fnrlrufname);namenszusatz:=wert(fnrlzusatz);amtsbez:=wert(fnrlamtsbeztitel);
+geschlecht:=wert(fnrlgeschlecht);sprechzeit:=wert(fnrlsprechzeit);IF 
+geschlecht="w"XOR geschlecht="W"THEN geschlecht:="Fr. "ELSE geschlecht:=
+"Hr. "FI ;lehrernameaufbereitet:=(lehrername+komma+blank+geschlecht+
+amtsbezeichnung+rufname+blank+namenszusatz);IF sortierungnachparaphenTHEN 
+lehrernameaufbereitetmitparaphe:=paraphe+(maxspaltenlaengepara-length(paraphe
+))*blank+lehrernameaufbereitetFI .amtsbezeichnung:IF amtsbez<>niltextTHEN 
+amtsbez+blankELSE ""FI .END PROC lehrerdatenholen;PROC 
+lehrerdatenaufbereitenbild:IF sortierungnachparaphenTHEN spaltenweise(
+lehrernameaufbereitetmitparaphe)ELSE spaltenweise(lehrernameaufbereitet)FI ;
+spaltenweise(sprechzeit);END PROC lehrerdatenaufbereitenbild;PROC 
+lehrerdatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP ausgfeld
+(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END PROC 
+lehrerdatenaufbildschirm;PROC sprechzdruckvorbereiten:setzebestandende(FALSE 
+);anfbuchstabe:=" ";druckvorbereiten;variablenfuerdrucksetzen;initdruckkopf(
+zentriert(sprechzueberschrift,druckbreite),zentriert(length(
+sprechzueberschrift)*"-",druckbreite));initspalten;setzespaltenbreite(
+spalte1breite);setzespaltenbreite(spalte2breite);inittupel(dnrlehrer);
+initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistop);.variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+sprechzdruckvorbereiten;PROC initausgabekopfdruck:druckstrich:=(spalte1breite
+*mittelstrich)+(spaltentrennerSUB 1)+(spalte2breite+1)*mittelstrich;
+textueberschrift:=teilueb1+(spalte1breite-(length(teilueb1)))*blank+
+spaltentrenner+teilueb2;ausgkopfdruck(1):=textueberschrift;ausgkopfdruck(2):=
+druckstrich;END PROC initausgabekopfdruck;PROC sprechzseitedrucken:
+sprechzueberschriftdrucken;seitedrucken(PROC (INT VAR )lehrerdrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistop);seitenwechsel.END PROC 
+sprechzseitedrucken;PROC sprechzueberschriftdrucken:INT VAR i;
+druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben(
+ausgkopfdruck(i))PER END PROC sprechzueberschriftdrucken;PROC lehrerdrucken(
+INT VAR zeilenzaehler):LET markiert="#";lehrerdatenholen;
+ggflmeldunganfbuchstabe;lehreraufbereitendruck;zeilenzaehlerINCR 
+ausgfeldlaenge;lehrerindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF 
+sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE 
+neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+lehrerdrucken;PROC lehreraufbereitendruck:setzespaltentrenner(spaltentrenner)
+;lehrerdatenaufbereitenbild;ausgfeld(1):=zeile;END PROC 
+lehreraufbereitendruck;PROC lehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO 
+ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER END PROC 
+lehrerindruckdatei;END PACKET lehrersprechzeitenliste;
+
diff --git a/app/schulis/2.2.1/src/3.listen.wochenstunden b/app/schulis/2.2.1/src/3.listen.wochenstunden
new file mode 100644
index 0000000..a8cd29c
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listen.wochenstunden
@@ -0,0 +1,114 @@
+PACKET wochenstundenlisteDEFINES wochenstdlispezielleteile:LET 
+wochenstdeingangsmaske="ms liste lehrerparaphen eingang",
+anzahlderobjekteprobildschirm=17,ausgfeldlaenge=1,spalte1breite=5,
+spalte2breite=30,spalte3breite=4,spalte4breite=31,spaltentrenner=" ",
+wochenstdanfpos=2,ueberschriftenzeilen=2,niltext="",blank=" ",komma=",",null=
+0,ausgkopflaenge=2,mittelstrich="-",mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=352;TEXT CONST blanknull:=" 0/",unterstreichung:=
+bildbreite*mittelstrich,textueberschrift:=("Lehrer"+31*blank+
+"Soll  Pfl.  Ermäßigung/Grund");TEXT VAR wochenstdueberschrift:=
+"Liste der Wochenstunden und Ermäßigungen",schraegstrich:="/",paraphe,
+lehrername,rufname,namenszusatz,amtsbez,geschlecht,sollstdn,pflichtstdn,
+ermaessigung1,ermaessigung2,ermaessigung3,ermaessigung4,ermgrund1,ermgrund2,
+ermgrund3,ermgrund4,lehrernameaufbereitet,bearbeitetwerden,anfbuchstabe,
+neueranfbuchstabe:="",auswahlnichtsinnvoll,teiltextmeldung:=
+"die Paraphe mit dem Anfangsbuchstaben:";INT VAR aktuelleindexnr,
+eingabestatus,lesestart,bildanfang,druckzeilenzahl;INT CONST indexlehrername
+:=ixlfamruf;BOOL VAR sortierungnachparaphen;LET AUSGFELD =ROW ausgfeldlaenge
+TEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,AUSGKOPFDRUCK =ROW ausgkopflaenge
+TEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR ausgkopf;AUSGKOPFDRUCK VAR 
+ausgkopfdruck;BOOL PROC multistop:TRUE END PROC multistop;PROC 
+wochenstdlispezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+wochenstddialogvorbereitenCASE 2:wochenstdeingabenrichtigCASE 3:
+wochenstdlistenvorbereitenCASE 4:wochenstddruckvorbereitenCASE 5:
+wochenstdseitedruckenCASE 6:wochenstdbildschirmvorbereitenCASE 7:
+wochenstdseitezeigenENDSELECT .END PROC wochenstdlispezielleteile;PROC 
+wochenstddialogvorbereiten:wochenstdueberschrift:=text(vergleichsknoten);
+setzeanfangswerte(wochenstdeingangsmaske,wochenstdanfpos)END PROC 
+wochenstddialogvorbereiten;PROC wochenstdeingabenrichtig:LET fnrsortparaphen=
+2,fnrsortlehrernamen=3,fnrausgdrucker=4,fnrausgbild=5;standardpruefe(5,
+fnrausgdrucker,fnrausgbild,null,niltext,eingabestatus);IF eingabestatus=0
+THEN standardpruefe(5,fnrsortparaphen,fnrsortlehrernamen,null,niltext,
+eingabestatus);IF eingabestatus=0THEN sortierartmerken;setzeeingabetest(TRUE 
+);setzeausgabedrucker(standardmaskenfeld(fnrausgbild)=niltext);ELSE 
+meldefehler;setzeeingabetest(FALSE )FI ;ELSE meldefehler;setzeeingabetest(
+FALSE )FI .sortierartmerken:sortierungnachparaphen:=standardmaskenfeld(
+fnrsortparaphen)<>niltext;.meldefehler:standardmeldung(
+mnrauswahlnichtsinnvoll,niltext).END PROC wochenstdeingabenrichtig;PROC 
+wochenstdlistenvorbereiten:BOOL VAR b;initspalten;setzespaltentrenner(
+spaltentrenner);IF sortierungnachparaphenTHEN aktuelleindexnr:=dnrlehrer;
+lesestart:=fnrlparapheELSE aktuelleindexnr:=indexlehrername;lesestart:=0;FI ;
+inittupel(dnrlehrer);setzeidentiwert("");initobli(
+anzahlderobjekteprobildschirm);parsenooffields(16);objektlistestarten(
+aktuelleindexnr,"",lesestart,TRUE ,b);setzebestandende(b);END PROC 
+wochenstdlistenvorbereiten;PROC wochenstdbildschirmvorbereiten:LET fnrausganf
+=2;standardkopfmaskeaktualisieren(wochenstdueberschrift);bildanfang:=
+fnrausganf;setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite(
+bildbreite);spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN 
+ausgabepos;erhoeheausgabeposumeins;spaltenweise(unterstreichung);ausgfeld(1)
+:=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+setzebildanfangsposition(4);initspalten;setzespaltenbreite(spalte1breite);
+setzespaltenbreite(spalte2breite);setzespaltenbreite(spalte3breite);
+setzespaltenbreite(spalte3breite);setzespaltenbreite(spalte4breite);END PROC 
+wochenstdbildschirmvorbereiten;PROC wochenstdseitezeigen:blaettern(PROC (INT 
+CONST )stundendatenzeigen,aktion,TRUE ,FALSE ,BOOL PROC multistop)END PROC 
+wochenstdseitezeigen;PROC stundendatenzeigen(INT CONST x):stundendatenholen;
+stundendatenaufbereitenbild;stundendatenaufbildschirm.END PROC 
+stundendatenzeigen;PROC stundendatenaufbereitenbild:TEXT VAR ermaessigungen:=
+niltext;spaltenweise(paraphe);spaltenweise(lehrernameaufbereitet);
+spaltenweise(2*blank+sollstdn);spaltenweise(2*blank+pflichtstdn);IF 
+ermaessigung1=blanknullTHEN ermaessigung1:=3*blankELSE ermaessigungen:=2*
+blank+ermaessigung1+ermgrund1FI ;IF ermaessigung2=blanknullTHEN ermaessigung2
+:=3*blankELSE ermaessigungenCAT 3*blank+ermaessigung2+ermgrund2FI ;IF 
+ermaessigung3=blanknullTHEN ermaessigung3:=3*blankELSE ermaessigungenCAT 3*
+blank+ermaessigung3+ermgrund3FI ;IF ermaessigung4=blanknullTHEN ermaessigung4
+:=blankELSE ermaessigungenCAT 3*blank+ermaessigung4+ermgrund4FI ;spaltenweise
+(ermaessigungen);END PROC stundendatenaufbereitenbild;PROC 
+stundendatenaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;END 
+PROC stundendatenaufbildschirm;PROC wochenstddruckvorbereiten:
+setzebestandende(FALSE );anfbuchstabe:=" ";druckvorbereiten;
+variablenfuerdrucksetzen;initdruckkopf(zentriert(wochenstdueberschrift,
+druckbreite),zentriert(length(wochenstdueberschrift)*"-",druckbreite));
+initspalten;setzespaltenbreite(spalte1breite);setzespaltenbreite(
+spalte2breite);setzespaltenbreite(spalte3breite);setzespaltenbreite(
+spalte3breite);setzespaltenbreite(spalte4breite);holemeldung;inittupel(
+dnrlehrer);initausgabekopfdruck;lesenvorbereitendruck(PROC (INT CONST ,BOOL 
+PROC ,INT VAR )scanforward,BOOL PROC multistop);.holemeldung:meldungstext(
+mnrbearbeitetwerden,bearbeitetwerden).variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+wochenstddruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck(1):=
+textueberschrift;ausgkopfdruck(2):=unterstreichungEND PROC 
+initausgabekopfdruck;PROC wochenstdseitedrucken:wochenstdueberschriftdrucken;
+seitedrucken(PROC (INT VAR )wochenstdndrucken,druckzeilenzahl,ausgfeldlaenge,
+BOOL PROC multistop);seitenwechsel.END PROC wochenstdseitedrucken;PROC 
+wochenstdueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR iFROM 1UPTO 
+ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END PROC 
+wochenstdueberschriftdrucken;PROC wochenstdndrucken(INT VAR zeilenzaehler):
+LET markiert="#";stundendatenholen;ggflmeldunganfbuchstabe;
+lehrerstundendatenaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge;
+lehrerstundendatenindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF 
+sortierungnachparaphenTHEN neueranfbuchstabe:=lehrernameSUB 1;ELSE 
+neueranfbuchstabe:=parapheSUB 1;FI ;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:standardmeldung(mnrbearbeitetwerden,teiltextmeldung+
+neueranfbuchstabe+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+wochenstdndrucken;PROC lehrerstundendatenaufbereitendruck:setzespaltentrenner
+(spaltentrenner);stundendatenaufbereitenbild;ausgfeld(1):=zeile;END PROC 
+lehrerstundendatenaufbereitendruck;PROC lehrerstundendatenindruckdatei:INT 
+VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))PER 
+END PROC lehrerstundendatenindruckdatei;PROC stundendatenholen:paraphe:=wert(
+fnrlparaphe);lehrername:=wert(fnrlfamname);rufname:=wert(fnrlrufname);
+namenszusatz:=wert(fnrlzusatz);amtsbez:=wert(fnrlamtsbeztitel);geschlecht:=
+wert(fnrlgeschlecht);sollstdn:=text(intwert(fnrlsollstd),2);pflichtstdn:=text
+(intwert(fnrlpflichtstd),2);ermaessigung1:=text(intwert(fnrlerm1),2)+
+schraegstrich;ermgrund1:=text(wert(fnrlermgrund1),2);ermaessigung2:=text(
+intwert(fnrlerm2),2)+schraegstrich;ermgrund2:=text(wert(fnrlermgrund2),2);
+ermaessigung3:=text(intwert(fnrlerm3),2)+schraegstrich;ermgrund3:=text(wert(
+fnrlermgrund3),2);ermaessigung4:=text(intwert(fnrlerm4),2)+schraegstrich;
+ermgrund4:=text(wert(fnrlermgrund4),2);IF geschlecht="w"XOR geschlecht="W"
+THEN geschlecht:="Fr. "ELSE geschlecht:="Hr. "FI ;lehrernameaufbereitet:=(
+lehrername+komma+blank+geschlecht+amtsbezeichnung+rufname+blank+namenszusatz)
+;.amtsbezeichnung:IF amtsbez<>niltextTHEN amtsbez+blankELSE ""FI .END PROC 
+stundendatenholen;END PACKET wochenstundenliste;
+
diff --git a/app/schulis/2.2.1/src/3.listenweise lehrer erf b/app/schulis/2.2.1/src/3.listenweise lehrer erf
new file mode 100644
index 0000000..9715e4d
--- /dev/null
+++ b/app/schulis/2.2.1/src/3.listenweise lehrer erf
@@ -0,0 +1,95 @@
+PACKET listenweiselehrererfDEFINES bearbeitunglehrer,lehrerspeichern:LET 
+tofather=1,tograndfather=2,niltext="",blank=" ",trennerfuerimbestand="�",
+dateinameschluessel="Schlüssel",null=0;LET maskeerm="ms lehrer erm bearb",
+maskespr="ms lehrer spr bearb",lehrerproseite=18,felderprozeileerm=11,
+felderprozeilespr=3,fnrparapheeingangsmaske=2,fnrersteparaphe=2,fnrersteerm=5
+,fnrersterermgrund=6,fnrerstespr=4,anzermprolehrer=4;LET untergrenze=0,
+obergrenze=99,bestandermgrund="c02 persoenl ermaess",meldungbestleer=59,
+meldungnichtspeichern=63,meldungplausi=57,meldungwarten=69,meldungspeicherung
+=132,meldungspeicherfehler=179,meldungzumbestand=55,meldungzusollstunden=175,
+hell="#";ROW lehrerproseiteSTRUCT (TEXT paraphe,sprechzeiten,pflichtstunden,
+sollstunden,ROW anzermprolehrerTEXT erm,grund)VAR altelehrer;BOOL VAR 
+bearbeitungdererm,nochwelcheda;INT VAR lehrerzahl,felderprozeile,
+fnrerstesbearbeitungsfeld;TEXT VAR paraphe,bearbeitungsmaske;LET 
+logbucheintragerm="Anw. 3.1.2 Änderungen der Stundenermäßigung",
+logbucheintragspr="Anw. 3.1.3 Änderungen der Sprechzeiten";PROC neuerblock:
+IF lehrerzahl=lehrerproseiteTHEN succ(dnrlehrer);nochwelcheda:=dbstatus=null;
+putwert(fnrlparaphe,paraphe);changeindex;FI ;blocklesenundausgeben;IF 
+nochwelchedaTHEN return(tofather)ELSE enter(tograndfather)FI END PROC 
+neuerblock;PROC blocklesenundausgeben:IF nochwelchedaTHEN standardmeldung(
+meldungwarten,niltext);lehrerzahl:=null;bildschirmblock(PROC zeilezeigen,
+BOOL PROC (INT CONST )leerepruefung,null);nochwelcheda:=(lehrerzahl>null);IF 
+nochwelchedaTHEN paraphe:=wert(fnrlparaphe);restlichefelderloeschen;infeld(1)
+;standardfelderausgeben;infeld(fnrerstesbearbeitungsfeld);FI FI .
+restlichefelderloeschen:INT VAR zeilenfeld;FOR zeilenfeldFROM fnrersteparaphe
++lehrerzahl*felderprozeileUPTO lehrerproseite*felderprozeile+1REP 
+standardmaskenfeld(standardfeldlaenge(zeilenfeld)*blank,zeilenfeld);
+feldschutz(zeilenfeld)PER .END PROC blocklesenundausgeben;PROC zeilezeigen:
+INT VAR i,aktuellesfeld;aktuellesfeld:=fnrersteparaphe+felderprozeile*
+lehrerzahl;lehrerzahlINCR 1;altelehrer(lehrerzahl).paraphe:=wert(fnrlparaphe)
+;standardmaskenfeld(wert(fnrlparaphe),aktuellesfeld);aktuellesfeldINCR 1;
+standardmaskenfeld(wert(fnrlfamname),aktuellesfeld);aktuellesfeldINCR 1;IF 
+bearbeitungderermTHEN altelehrer(lehrerzahl).pflichtstunden:=wert(
+fnrlpflichtstd);standardmaskenfeld(wert(fnrlpflichtstd),aktuellesfeld);
+aktuellesfeldINCR 1;FOR iFROM 1UPTO anzermprolehrerREP altelehrer(lehrerzahl)
+.erm(i):=wert(fnrlerm1+2*(i-1));standardmaskenfeld(wert(fnrlerm1+2*(i-1)),
+aktuellesfeld);aktuellesfeldINCR 1;altelehrer(lehrerzahl).grund(i):=wert(
+fnrlermgrund1+2*(i-1));standardmaskenfeld(wert(fnrlermgrund1+2*(i-1)),
+aktuellesfeld);aktuellesfeldINCR 1;PER ELSE altelehrer(lehrerzahl).
+sprechzeiten:=wert(fnrlsprechzeit);standardmaskenfeld(wert(fnrlsprechzeit),
+aktuellesfeld);aktuellesfeldINCR 1;FI END PROC zeilezeigen;BOOL PROC 
+leerepruefung(INT CONST dummy):TRUE END PROC leerepruefung;PROC 
+bearbeitunglehrer(INT CONST programm):reinitparsing;
+initialisierungenvornehmen;pruefeobimbestand;IF dbstatus<>nullTHEN 
+standardmeldung(meldungbestleer,niltext);return(tofather);LEAVE 
+bearbeitunglehrerFI ;nochwelcheda:=TRUE ;standardstartproc(bearbeitungsmaske)
+;startebildschirmblock(dnrlehrer,lehrerproseite-1);blocklesenundausgeben;
+standardnproc.initialisierungenvornehmen:bearbeitungdererm:=programm=1;IF 
+bearbeitungderermTHEN bearbeitungsmaske:=maskeerm;felderprozeile:=
+felderprozeileerm;fnrerstesbearbeitungsfeld:=fnrersteerm;ELSE 
+bearbeitungsmaske:=maskespr;felderprozeile:=felderprozeilespr;
+fnrerstesbearbeitungsfeld:=fnrerstespr;FI ;standardmeldung(meldungwarten,
+niltext).pruefeobimbestand:inittupel(dnrlehrer);putwert(fnrlparaphe,
+standardmaskenfeld(fnrparapheeingangsmaske));search(dnrlehrer,FALSE ).END 
+PROC bearbeitunglehrer;PROC lehrerspeichern(BOOL CONST speichern):INT VAR 
+fehlerstatus:=0,i,j,sollstunden;BOOL VAR lehrerdatengeaendert;INT VAR aktfnr;
+IF speichernTHEN pruefeplausibilitaet;IF fehlerstatus<>0THEN infeld(
+fehlerstatus);return(tofather);LEAVE lehrerspeichernELSE 
+speicherungdurchführenFI ELSE standardmeldung(meldungnichtspeichern,niltext)
+FI ;putwert(fnrlparaphe,paraphe);changeindex;neuerblock;.pruefeplausibilitaet
+:IF bearbeitungderermTHEN standardmeldung(meldungplausi,niltext);FOR jFROM 1
+UPTO lehrerzahlREP pruefeeinezeilePER FI .pruefeeinezeile:sollstunden:=int(
+altelehrer(j).pflichtstunden);FOR iFROM 0UPTO anzermprolehrer-1REP aktfnr:=
+fnrersteerm+(j-1)*felderprozeile+2*i;IF standardmaskenfeld(aktfnr)<>""THEN 
+standardpruefe(2,aktfnr,null,null,niltext,fehlerstatus);IF fehlerstatus<>0
+THEN LEAVE pruefeplausibilitaetFI ;standardpruefe(3,aktfnr,untergrenze,
+obergrenze,niltext,fehlerstatus);IF fehlerstatus<>0THEN LEAVE 
+pruefeplausibilitaetFI ;FI ;sollstunden:=sollstunden-int(standardmaskenfeld(
+aktfnr));IF sollstunden<0THEN standardmeldung(meldungzusollstunden,niltext);
+fehlerstatus:=aktfnr;LEAVE pruefeplausibilitaetELSE altelehrer(j).sollstunden
+:=text(sollstunden)FI ;aktfnr:=fnrersterermgrund+(j-1)*felderprozeile+2*i;IF 
+standardmaskenfeld(aktfnr)<>""THEN IF NOT imbestand(bestandermgrund+
+trennerfuerimbestand+standardmaskenfeld(aktfnr),dateinameschluessel)THEN 
+standardmeldung(meldungzumbestand,niltext);fehlerstatus:=aktfnr;LEAVE 
+pruefeplausibilitaetFI FI PER .speicherungdurchführen:IF bearbeitungdererm
+THEN logeintrag(logbucheintragerm)ELSE logeintrag(logbucheintragspr)FI ;FOR j
+FROM 0UPTO lehrerzahl-1REP IF lehrerdatenwurdengeaendertTHEN putwert(
+fnrlparaphe,altelehrer(j+1).paraphe);search(dnrlehrer,true);
+speicherfehlerabfangen;IF bearbeitungderermTHEN FOR iFROM 0UPTO 
+anzermprolehrer-1REP putwert(fnrlerm1+2*i,standardmaskenfeld(fnrersteerm+j*
+felderprozeile+2*i));putwert(fnrlermgrund1+2*i,standardmaskenfeld(
+fnrersterermgrund+j*felderprozeile+2*i));PER ;putwert(fnrlsollstd,altelehrer(
+j+1).sollstunden)ELSE putwert(fnrlsprechzeit,standardmaskenfeld(fnrerstespr+j
+*felderprozeile));FI ;update(dnrlehrer);speicherfehlerabfangen;
+standardmeldung(meldungspeicherung,altelehrer(j+1).paraphe+hell)FI PER .
+lehrerdatenwurdengeaendert:lehrerdatengeaendert:=FALSE ;IF bearbeitungdererm
+THEN i:=0;WHILE NOT lehrerdatengeaendertCAND i<anzermprolehrerREP 
+lehrerdatengeaendert:=standardmaskenfeld(fnrersteerm+j*felderprozeile+2*i)<>
+altelehrer(j+1).erm(i+1)COR standardmaskenfeld(fnrersterermgrund+j*
+felderprozeile+2*i)<>altelehrer(j+1).grund(i+1);iINCR 1PER ELSE 
+lehrerdatengeaendert:=standardmaskenfeld(fnrerstespr+j*felderprozeile)<>
+altelehrer(j+1).sprechzeitenFI ;lehrerdatengeaendert.speicherfehlerabfangen:
+IF dbstatus<>nullTHEN standardmeldung(meldungspeicherfehler,altelehrer(j+1).
+paraphe+hell);return(tofather);LEAVE lehrerspeichernFI .END PROC 
+lehrerspeichern;END PACKET listenweiselehrererf
+
diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files
new file mode 100644
index 0000000..f1e4883
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 2.files
@@ -0,0 +1,5 @@
+4.stundenplan schnittstelle
+4.einhaltung zeitwuensche pruefen
+4.daten für intega aufbereiten
+
+
diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files
new file mode 100644
index 0000000..34b3d36
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN 3.files
@@ -0,0 +1,6 @@
+4.stundenplan schnittstelle
+4.aufsichten erstellen
+4.vertretungen organisieren
+4.stdpluebersichten
+4.einzelstdpl.sek2
+
diff --git a/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files
new file mode 100644
index 0000000..fe85e58
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.AUSWERTUNGEN STUNDENPLAN.files
@@ -0,0 +1,11 @@
+4.stundenplan schnittstelle
+4.einzelstdpl.raeume
+4.einzelstdpl.lehrer
+4.einzelstdpl.sek1
+4.stand der stundenplanung analysieren
+4.springstunden lehrer analysieren
+4.springstunden schueler analysieren
+4.raumwuensche pruefen
+4.teilstdpl fach lehrer
+
+
diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files
new file mode 100644
index 0000000..afefca2
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 2.files
@@ -0,0 +1,6 @@
+0.listenweise grundfunktionen
+0.kurswahlbasis bereinigen
+4.faecherangebot planen
+4.lehrveranstaltungen benennen
+4.uv und kopplungen bearbeiten
+
diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files
new file mode 100644
index 0000000..230eb9a
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN LISTENWEISE 3.files
@@ -0,0 +1,7 @@
+0.listenweise grundfunktionen
+4.zeitwuensche bearbeiten
+4.vertretungsdaten bearbeiten
+
+
+
+
diff --git a/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files b/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files
new file mode 100644
index 0000000..7ca8dae
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.ERFASSUNGEN STUNDENPLAN.files
@@ -0,0 +1,11 @@
+4.stundenplan schnittstelle
+4.stundenplan raumweise erfassen
+4.stundenplan im dialog erstellen
+4.daten für schulis aufbereiten
+4.halbjahreswechsel zum stundenplan
+4.konsistenzpruefung
+4.stundenplan nach zeiten erfassen
+4.stundenplan nach lv erfassen
+4.stundenplan akt halbj uebernehmen
+
+
diff --git a/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer b/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer
new file mode 100644
index 0000000..9c695d8
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.anschr.unterrichtsvertlg fuer lehrer
@@ -0,0 +1,137 @@
+PACKET anschrunterrichtsvertlgfuerlehrerDEFINES 
+unterrichtsvertlgfuerlehrereingang,unterrichtsvertlgfuerlehrerstarten,
+unterrichtsvertlgfuerlehrersonderwerte,unterrichtsvertlgfuerlehrermultistop,
+unterrichtsvertlgfuerlehrerdruckdateibauen:LET maske=
+"ms unterrichtsverteilung fuer lehrer drucken",fnrparaphe=2,fnrzeitwuensche=3
+,fnraktsj=4,fnrbsausgabe=5,fnrdrausgabe=6,mnrbittewarten=69,
+mnrkeinegueltigeparaphe=344,mnrlistewirdaufbereitet=190,trenner="/",blank=" "
+,niltext="";TEXT CONST v1datlehrer:="vordruck1 unterrichtsvertlg fuer lehrer"
+,v2datlehrveranstgn:="vordruck2 unterrichtsvertlg fuer lehrer",
+v3dataktschuelergr:="vordruck4 auskunft lehrer",v4datzeitwuensche:=
+"vordruck5 auskunft lehrer",bestandnamepersoenlermaessigung:=
+"c02 persoenl ermaess";LET swsj=520,swhj=521,swanrede=522,
+swermaessgrund1langtext=530,swermaessgrund2langtext=531,
+swermaessgrund3langtext=532,swermaessgrund4langtext=533,swfach=534,swkennung=
+535,swwstd=536,swdummy=526,ganztage=520,ganzgew=521,vormtage=522,vormgew=523,
+nachtage=524,nachgew=525;BOOL VAR bildschirmausgabe,mitzeitwuenschen,
+einzelbearbeitung,aktsj;TEXT VAR angegebeneparaphe:="",aktparaphe,halbjahr,
+schuljahr,wochstdn,fachkennung;INT VAR gemerkterdbstatus,status,sollstdn,
+differenz,summewochstdn:=0,zeilenhilfszahl,zeilenzahl,zusatzzeilen,
+swaktklassenleiter,swaktstellvertreter;BOOL PROC paraphevorhanden:putwert(
+fnrlparaphe,angegebeneparaphe);search(dnrlehrer,TRUE );IF dbstatus=0THEN 
+TRUE ELSE FALSE FI END PROC paraphevorhanden;PROC 
+unterrichtsvertlgfuerlehrereingang:standardvproc(maske)END PROC 
+unterrichtsvertlgfuerlehrereingang;PROC unterrichtsvertlgfuerlehrerstarten:
+standardpruefe(5,fnrbsausgabe,fnrdrausgabe,0,"",status);IF status<>0THEN 
+infeld(status);return(1);ELSE angegebeneparaphe:=standardmaskenfeld(
+fnrparaphe);IF angegebeneparaphe=niltextCOR paraphevorhandenTHEN 
+bildschirmausgabe:=standardmaskenfeld(fnrbsausgabe)<>niltext;
+einzelbearbeitung:=standardmaskenfeld(fnrparaphe)<>niltext;mitzeitwuenschen:=
+standardmaskenfeld(fnrzeitwuensche)<>niltext;aktsj:=standardmaskenfeld(
+fnraktsj)<>niltext;aktparaphe:=angegebeneparaphe;startenausfuehrenELSE 
+standardmeldung(mnrkeinegueltigeparaphe,niltext);return(1)FI ;FI .
+startenausfuehren:halbjahr:=schulkenndatum("Schulhalbjahr");schuljahr:=
+schulkenndatum("Schuljahr");IF NOT (aktsj)THEN geplanteshjundsjberechnen(
+halbjahr,schuljahr);FI ;setzesonderwerteschulkenndaten;setzewerte;
+standardmeldung(mnrbittewarten,niltext);zusammengesetztesanschreiben(
+dnrlehrer,bildschirmausgabe,einzelbearbeitung,BOOL PROC 
+unterrichtsvertlgfuerlehrersonderwerte,BOOL PROC 
+unterrichtsvertlgfuerlehrermultistop,TEXT PROC 
+unterrichtsvertlgfuerlehrerdruckdateibauen).setzewerte:putwert(fnrlparaphe,
+aktparaphe)END PROC unterrichtsvertlgfuerlehrerstarten;BOOL PROC 
+unterrichtsvertlgfuerlehrermultistop:BOOL VAR ok;IF einzelbearbeitungTHEN ok
+:=angegebeneparaphe=wert(fnrlparaphe)AND dbstatus=0ELSE ok:=dbstatus=0FI ;ok
+END PROC unterrichtsvertlgfuerlehrermultistop;BOOL PROC 
+unterrichtsvertlgfuerlehrersonderwerte:TEXT VAR grund1,grund2,grund3,grund4;
+initialisieresonderwerte;aktparaphe:=wert(fnrlparaphe);adressat(aktparaphe);
+gemerkterdbstatus:=dbstatus;setzesonderwert(swsj,subtext(schuljahr,1,2)+
+trenner+subtext(schuljahr,3,4));setzesonderwert(swhj,halbjahr);TEXT VAR 
+anredetext;IF wert(fnrlgeschlecht)="m"THEN anredetext:="Herrn"ELSE anredetext
+:="Frau";FI ;setzesonderwert(swanrede,anredetext);grund1:=wert(fnrlermgrund1)
+;grund2:=wert(fnrlermgrund2);grund3:=wert(fnrlermgrund3);grund4:=wert(
+fnrlermgrund4);sollstdn:=intwert(fnrlsollstd);inittupel(dnrschluessel);
+putwert(fnrschlsachgebiet,bestandnamepersoenlermaessigung);putwert(
+fnrschlschluessel,grund1);search(dnrschluessel,TRUE );IF dbstatus=0THEN 
+setzesonderwert(swermaessgrund1langtext,wert(fnrschllangtext))ELSE 
+setzesonderwert(swermaessgrund1langtext,blank)FI ;putwert(fnrschlschluessel,
+grund2);search(dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(
+swermaessgrund2langtext,wert(fnrschllangtext));ELSE setzesonderwert(
+swermaessgrund2langtext,blank);FI ;putwert(fnrschlschluessel,grund3);search(
+dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(
+swermaessgrund3langtext,wert(fnrschllangtext))ELSE setzesonderwert(
+swermaessgrund3langtext,blank)FI ;putwert(fnrschlschluessel,grund4);search(
+dnrschluessel,TRUE );IF dbstatus=0THEN setzesonderwert(
+swermaessgrund4langtext,wert(fnrschllangtext))ELSE setzesonderwert(
+swermaessgrund4langtext,blank)FI ;inittupel(dnrlehrveranstaltungen);putwert(
+fnrlvsj,schuljahr);putwert(fnrlvhj,halbjahr);putwert(fnrlvparaphe,aktparaphe)
+;search(ixlvsjhjpar,TRUE );IF dbstatus=0THEN fachkennung:=wert(
+fnrlvfachkennung);wochstdn:=wert(fnrlvwochenstd);setzesonderwert(swfach,
+subtext(fachkennung,1,2));setzesonderwert(swkennung,subtext(fachkennung,3,6))
+;setzesonderwert(swwstd,wochstdn);summewochstdn:=int(wochstdn);ELSE 
+setzesonderwert(swfach,blank);setzesonderwert(swkennung,blank);
+setzesonderwert(swwstd,blank);summewochstdn:=0;FI ;dbstatus(gemerkterdbstatus
+);TRUE END PROC unterrichtsvertlgfuerlehrersonderwerte;TEXT PROC 
+unterrichtsvertlgfuerlehrerdruckdateibauen:LET druckdatei="liste.1",
+hilfsdatei="hilfsdatei";TEXT VAR zeile;zeilenzahl:=0;zusatzzeilen:=0;
+vordruckeholen;setzemitseitennummern(TRUE );druckvorbereiten;standardmeldung(
+mnrlistewirdaufbereitet,niltext);briefalternative(v1datlehrer,hilfsdatei);
+hilfsdateiindruckdatei(hilfsdatei);vordruck2ggfxmalindruckdatei;zeile:=blank;
+druckzeileschreiben(zeile);zeilenzahlINCR 1;zeile:=42*blank+"Wstd. Summe: "+
+text(summewochstdn,2);druckzeileschreiben(zeile);zeilenzahlINCR 1;IF sollstdn
+<>summewochstdnTHEN differenz:=sollstdn-summewochstdn;IF differenz<0THEN 
+zeile:=43*blank+"Mehrarbeit: "+text(-differenz,2)+" Std.";ELSE zeile:=24*
+blank+"Sollstunden unterschritten um: "+text(differenz,2)+" Std.";FI ;
+druckzeileschreiben(zeile);zeilenzahlINCR 1;FI ;zeilenzahl:=5;
+vordruck3ggfindruckdatei;IF mitzeitwuenschenTHEN zeilenzahl:=17;
+vordruck4ggfindruckdatei;FI ;drucknachbereitenohneausdrucken;
+vordruckeloeschen;druckdatei.vordruckeholen:fetch(v1datlehrer,/
+"anschreiben server");fetch(v2datlehrveranstgn,/"anschreiben server");fetch(
+v3dataktschuelergr,/"anschreiben server");fetch(v4datzeitwuensche,/
+"anschreiben server");.vordruckeloeschen:forget(v1datlehrer,quiet);forget(
+v2datlehrveranstgn,quiet);forget(v3dataktschuelergr,quiet);forget(
+v4datzeitwuensche,quiet);END PROC unterrichtsvertlgfuerlehrerdruckdateibauen;
+PROC vordruck2ggfxmalindruckdatei:TEXT VAR hilfsdatei:="hilfsdatei";BOOL VAR 
+hilfsdateida:=FALSE ;succ(ixlvsjhjpar);WHILE dbstatus=0AND wert(fnrlvparaphe)
+=aktparapheREP fachkennung:=wert(fnrlvfachkennung);wochstdn:=subtext(wert(
+fnrlvwochenstd),1,2);setzesonderwert(swfach,subtext(fachkennung,1,2));
+setzesonderwert(swkennung,subtext(fachkennung,3,6));setzesonderwert(swwstd,
+wochstdn);summewochstdnINCR int(wochstdn);briefalternative(v2datlehrveranstgn
+,hilfsdatei);succ(ixlvsjhjpar);hilfsdateida:=TRUE ;PER ;IF hilfsdateidaTHEN 
+hilfsdateiindruckdatei(hilfsdatei)FI ;END PROC vordruck2ggfxmalindruckdatei;
+PROC vordruck3ggfindruckdatei:LET hilfsdatei="hilfsdatei";TEXT VAR aufberwert
+:=niltext;BOOL VAR hilfsdateiangelegt:=FALSE ;setzesonderwert(swdummy,blank);
+swaktklassenleiter:=580;swaktstellvertreter:=581;gemerkterdbstatus:=dbstatus;
+inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,schuljahr);putwert(
+fnrsgrphj,halbjahr);search(dnraktschuelergruppen,FALSE );WHILE dbstatus=0AND 
+wert(fnrsgrphj)=halbjahrREP IF wert(fnrsgrplehrer)=aktparapheAND 
+swaktklassenleiter<590THEN aufberwert:=wert(fnrsgrpjgst);aufberwertCAT wert(
+fnrsgrpkennung);setzesonderwert(swaktklassenleiter,aufberwert);
+swaktklassenleiterINCR 2;hilfsdateiangelegt:=TRUE ;ELSE IF wert(
+fnrsgrpstellvlehrer)=aktparapheAND swaktstellvertreter<591THEN aufberwert:=
+wert(fnrsgrpjgst);aufberwertCAT wert(fnrsgrpkennung);setzesonderwert(
+swaktstellvertreter,aufberwert);swaktstellvertreterINCR 2;hilfsdateiangelegt
+:=TRUE ;FI ;FI ;succ(dnraktschuelergruppen)PER ;IF hilfsdateiangelegtTHEN 
+briefalternative(v3dataktschuelergr,hilfsdatei);hilfsdateiindruckdatei(
+hilfsdatei);FI ;dbstatus(gemerkterdbstatus)END PROC vordruck3ggfindruckdatei;
+PROC vordruck4ggfindruckdatei:gemerkterdbstatus:=dbstatus;LET hilfsdatei=
+"hilfsdatei";TEXT VAR zeitwuensche;initialisieresonderwerte;INT VAR 
+aktswzeitwunsch:=531,position:=1,i;setzesonderwert(swdummy,blank);inittupel(
+dnrzeitwuensche);putwert(fnrzwsj,schuljahr);putwert(fnrzwhj,halbjahr);putwert
+(fnrzwbezug,"P");putwert(fnrzwbezugsobjekt,aktparaphe);search(dnrzeitwuensche
+,TRUE );IF dbstatus=0THEN zeitwuensche:=wert(fnrzwunbestimmtewuensche);
+setzesonderwert(ganztage,zeitwuenscheSUB 1);setzesonderwert(ganzgew,
+zeitwuenscheSUB 3);setzesonderwert(vormtage,zeitwuenscheSUB 4);
+setzesonderwert(vormgew,zeitwuenscheSUB 6);setzesonderwert(nachtage,
+zeitwuenscheSUB 7);setzesonderwert(nachgew,zeitwuenscheSUB 9);zeitwuensche:=
+wert(fnrzwbestimmtewuensche);FOR iFROM 1UPTO 66REP setzesonderwert(
+aktswzeitwunsch,subtext(zeitwuensche,position,position+1));aktswzeitwunsch
+INCR 1;positionINCR 2PER ;briefalternative(v4datzeitwuensche,hilfsdatei);
+hilfsdateiindruckdatei(hilfsdatei);FI ;dbstatus(gemerkterdbstatus)END PROC 
+vordruck4ggfindruckdatei;PROC hilfsdateiindruckdatei(TEXT CONST hilfsdatei):
+FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input,hilfsdatei);
+zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+zusatzzeilen>=
+drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1UPTO 
+zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ;forget(
+hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC 
+hilfsdateiindruckdatei;END PACKET anschrunterrichtsvertlgfuerlehrer
+
diff --git a/app/schulis/2.2.1/src/4.anschr.vertretungen b/app/schulis/2.2.1/src/4.anschr.vertretungen
new file mode 100644
index 0000000..d806e14
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.anschr.vertretungen
@@ -0,0 +1,149 @@
+PACKET anschrvertretungenDEFINES vertretungeneingang,vertretungenstarten,
+vertretungensonderwerte,vertretungendruckdateibauen,vertretungenscanbedingung
+,vertretungslistedrucken:LET swnameaufbereitet=550,swdatum=520,swzeit=521,
+swstd=521,swart=522,swlv=523,swlangtext=523;LET maske=
+"ms vertretungen eingang",fnrparaphe=2,fnrvonzeit=3,fnrbiszeit=4,fnrbsausgabe
+=5,fnrdrausgabe=6,niltext="",blank=" ",strich="-----",kreuz="+",klammerauf=
+"(",klammerzu=")",maxvertretungsarten=16,sonstigkuerzel="qq",
+mnrauswahlnichtsinnvoll=56,mnrbittewarten=69,mnrlistewirderstellt=7,
+mnrnichtimbestand=55;LET druckdatei="liste.1";TEXT CONST sonstiges:=
+"Sonstiges",dateimitformularkopf:="vordruck1 vertretungen",
+dateimitvertretungsdaten:="vordruck2 vertretungen";REAL VAR obergrenze,
+untergrenze,aktzeit;INT VAR index:=dnrlehrer,status,zeilenzahl,
+zeilenhilfszahl,zusatzzeilen,zaehler;TEXT VAR angegebeneparaphe:="",
+aktparaphe,letzteparaphe,datum,hilfstext,bestand:="c02 anrechnung vertret",
+vertretungsarten;ROW maxvertretungsartenTEXT VAR vertretungen;BOOL VAR 
+bildschirmausgabe,einzelbearbeitung,zeituntergrenze,zeitobergrenze,dateiende,
+ersteraufruf;PROC vertretungslistedrucken(BOOL CONST drucken):IF druckenTHEN 
+print(druckdatei);FI ;forget(druckdatei,quiet);IF einzelbearbeitungTHEN 
+forget(dateimitformularkopf,quiet);forget(dateimitvertretungsdaten,quiet);
+enter(2)ELIF dateiendeTHEN forget(dateimitformularkopf,quiet);forget(
+dateimitvertretungsdaten,quiet);enter(2)ELSE enter(1)FI ;END PROC 
+vertretungslistedrucken;PROC vertretungeneingang:ersteraufruf:=TRUE ;
+standardvproc(maske)END PROC vertretungeneingang;PROC vertretungenstarten:
+TEXT VAR vonzeit,biszeit;IF NOT ersteraufrufTHEN putwert(fnrvparaphe,
+aktparaphe);zusammengesetztesanschreiben(ixvpar,bildschirmausgabe,
+einzelbearbeitung,BOOL PROC vertretungensonderwerte,BOOL PROC 
+vertretungenscanbedingung,TEXT PROC vertretungendruckdateibauen);ELSE last(
+ixvpar);letzteparaphe:=wert(fnrvparaphe);standardpruefe(5,fnrbsausgabe,
+fnrdrausgabe,0,"",status);IF status<>0THEN infeld(status);return(1);ELSE 
+standardmeldung(mnrbittewarten,niltext);vonzeit:=standardmaskenfeld(
+fnrvonzeit);biszeit:=standardmaskenfeld(fnrbiszeit);zeituntergrenze:=vonzeit
+<>niltext;zeitobergrenze:=biszeit<>niltext;IF datumspruefungenkorrektTHEN 
+angegebeneparaphe:=standardmaskenfeld(fnrparaphe);IF 
+angabenindateivertretungenvorhandenTHEN ersteraufruf:=FALSE ;
+parametersetzenundstartenELSE standardmeldung(mnrnichtimbestand,niltext);
+return(1)FI ;ELSE return(1)FI ;FI ;FI ;.parametersetzenundstarten:dateiende:=
+FALSE ;datum:=wert(fnrvdatum);vertretungsartenausbestandholen;
+bildschirmausgabe:=standardmaskenfeld(fnrdrausgabe)=niltext;
+setzesonderwerteschulkenndaten;vordruckeholen;standardmeldung(
+mnrlistewirderstellt,niltext);putwert(fnrvparaphe,aktparaphe);disablestop;
+zusammengesetztesanschreiben(ixvpar,bildschirmausgabe,einzelbearbeitung,BOOL 
+PROC vertretungensonderwerte,BOOL PROC vertretungenscanbedingung,TEXT PROC 
+vertretungendruckdateibauen);IF iserrorTHEN clearerrorFI ;enablestop.
+vordruckeholen:forget(dateimitformularkopf,quiet);forget(
+dateimitvertretungsdaten,quiet);fetch(dateimitformularkopf,/
+"anschreiben server");fetch(dateimitvertretungsdaten,/"anschreiben server");.
+datumspruefungenkorrekt:IF zeituntergrenzeTHEN standardpruefe(6,fnrvonzeit,0,
+0,"",status);IF status<>0THEN infeld(status);LEAVE datumspruefungenkorrekt
+WITH FALSE ELSE datum:=subtext(vonzeit,5,6);datumCAT subtext(vonzeit,3,4);
+datumCAT subtext(vonzeit,1,2);untergrenze:=real(datum);FI ;FI ;IF 
+zeitobergrenzeTHEN standardpruefe(6,fnrbiszeit,0,0,"",status);IF status<>0
+THEN infeld(status);LEAVE datumspruefungenkorrektWITH FALSE ELSE datum:=
+subtext(biszeit,5,6);datumCAT subtext(biszeit,3,4);datumCAT subtext(biszeit,1
+,2);obergrenze:=real(datum);FI ;FI ;IF zeituntergrenzeAND zeitobergrenzeTHEN 
+IF untergrenze>obergrenzeTHEN infeld(fnrvonzeit);standardmeldung(
+mnrauswahlnichtsinnvoll,niltext);LEAVE datumspruefungenkorrektWITH FALSE FI ;
+FI ;TRUE .vertretungsartenausbestandholen:vertretungsarten:=niltext;inittupel
+(dnrschluessel);putwert(fnrschlsachgebiet,bestand);search(dnrschluessel);
+WHILE wert(fnrschlsachgebiet)=bestandREP vertretungsartenCAT text(wert(
+fnrschlschluessel),2);succ(dnrschluessel);PER ;.
+angabenindateivertretungenvorhanden:BOOL VAR ok:=FALSE ;einzelbearbeitung:=
+angegebeneparaphe<>niltext;inittupel(dnrvertretungen);IF einzelbearbeitung
+THEN putwert(fnrvparaphe,angegebeneparaphe);search(ixvpar,TRUE )ELSE search(
+ixvpar,FALSE )FI ;IF dbstatus<>0THEN ok:=FALSE ELSE aktparaphe:=wert(
+fnrvparaphe);IF einzelbearbeitungTHEN WHILE dbstatus=0AND angegebeneparaphe=
+aktparapheAND obergrenzeokAND NOT untergrenzeokREP succ(ixvpar);aktparaphe:=
+wert(fnrvparaphe);PER ;ok:=dbstatus=0AND obergrenzeokAND untergrenzeokAND 
+angegebeneparaphe=aktparapheELSE WHILE dbstatus=0AND (NOT obergrenzeokCOR 
+NOT untergrenzeok)REP succ(ixvpar);PER ;aktparaphe:=wert(fnrvparaphe);ok:=
+dbstatus=0AND obergrenzeokAND untergrenzeokFI ;FI ;okEND PROC 
+vertretungenstarten;BOOL PROC obergrenzeok:BOOL VAR b:=TRUE ;IF 
+zeitobergrenzeTHEN datum:=wert(fnrvdatum);hilfstext:=subtext(datum,7,8);
+hilfstextCAT subtext(datum,4,5);hilfstextCAT subtext(datum,1,2);aktzeit:=real
+(hilfstext);b:=aktzeit<=obergrenze;FI ;bEND PROC obergrenzeok;BOOL PROC 
+untergrenzeok:BOOL VAR b:=TRUE ;IF zeituntergrenzeTHEN datum:=wert(fnrvdatum)
+;hilfstext:=subtext(datum,7,8);hilfstextCAT subtext(datum,4,5);hilfstextCAT 
+subtext(datum,1,2);aktzeit:=real(hilfstext);b:=aktzeit>=untergrenze;FI ;bEND 
+PROC untergrenzeok;BOOL PROC vertretungenscanbedingung:BOOL VAR b;IF 
+einzelbearbeitungTHEN b:=aktparaphe=angegebeneparapheAND dbstatus=0ELSE b:=
+dbstatus=0AND NOT dateiendeFI ;bEND PROC vertretungenscanbedingung;BOOL PROC 
+vertretungensonderwerte:TEXT VAR hilfsstring1:=niltext,hilfsstring2;INT VAR 
+dbstatussave;initialisieresonderwerte;adressat(aktparaphe);dbstatussave:=
+dbstatus;inittupel(dnrlehrer);putwert(fnrlparaphe,aktparaphe);search(
+dnrlehrer,TRUE );IF wert(fnrlgeschlecht)="m"THEN hilfsstring1:="Herrn "ELSE 
+hilfsstring1:="Frau ";FI ;hilfsstring2:=wert(fnrlamtsbeztitel);IF 
+hilfsstring2<>niltextTHEN hilfsstring1CAT hilfsstring2+blank;FI ;hilfsstring2
+:=wert(fnrlzusatz);IF hilfsstring2<>niltextTHEN hilfsstring1CAT hilfsstring2+
+blank;FI ;hilfsstring1CAT wert(fnrlfamname);setzesonderwert(swnameaufbereitet
+,hilfsstring1);dbstatus(0);TRUE END PROC vertretungensonderwerte;TEXT PROC 
+vertretungendruckdateibauen:LET druckdatei="liste.1",hilfsdatei="hilfsdatei";
+TEXT VAR zeile;INT VAR i;BOOL VAR einsatzda:=FALSE ;setzemitseitennummern(
+TRUE );druckvorbereiten;zeilenzahl:=0;zusatzzeilen:=0;briefalternative(
+dateimitformularkopf,hilfsdatei);hilfsdateiindruckdatei(hilfsdatei);FOR 
+zaehlerFROM 1UPTO maxvertretungsartenREP vertretungen(zaehler):=niltextPER ;
+vordruck2xmalinhilfsdatei;hilfsdateiindruckdatei(hilfsdatei);IF zeilenzahl+3>
+drucklaengeTHEN seitenwechsel;zeilenzahl:=0FI ;zeile:=blank;
+druckzeileschreiben(zeile);druckzeileschreiben(zeile);zeile:=
+"Summe Stunden    Art";druckzeileschreiben(zeile);zeile:=3*strich+kreuz+7*
+strich;druckzeileschreiben(zeile);zeilenzahlINCR 4;setzesonderwert(swdatum,
+niltext);imrowgemerktedatenübervordruck2indruckdatei;
+drucknachbereitenohneausdrucken;druckdateiEND PROC 
+vertretungendruckdateibauen;PROC vordruck2xmalinhilfsdatei:LET hilfsdatei=
+"hilfsdatei";INT VAR savedbstatus;savedbstatus:=dbstatus;inittupel(
+dnrvertretungen);statleseschleife(ixvpar,"",aktparaphe,fnrvparaphe,
+fnrvparaphe,PROC saetzezurparapheinvordruck);dbstatus(savedbstatus);IF NOT 
+einzelbearbeitungTHEN search(ixvpar,FALSE );WHILE dbstatus=0AND (NOT 
+obergrenzeokCOR NOT untergrenzeokCOR aktparaphe=wert(fnrvparaphe))REP succ(
+ixvpar);PER ;dateiende:=letzteparaphe=aktparapheOR dbstatus<>0;aktparaphe:=
+wert(fnrvparaphe);FI ;END PROC vordruck2xmalinhilfsdatei;PROC 
+saetzezurparapheinvordruck(BOOL VAR b):LET hilfsdatei="hilfsdatei";b:=FALSE ;
+IF NOT obergrenzeokCOR wert(fnrvparaphe)<>aktparapheCOR dbstatus=3THEN b:=
+TRUE ;ELSE IF untergrenzeokTHEN swvertretungenfuellen;briefalternative(
+dateimitvertretungsdaten,hilfsdatei);FI ;FI ;END PROC 
+saetzezurparapheinvordruck;PROC swvertretungenfuellen:TEXT VAR zeitaufber,
+artvertr,lehrveranstg,lvaufber;INT VAR zeit,std,tag,position;zeit:=intwert(
+fnrvtagstd);lehrveranstg:=wert(fnrvveranstaltung);artvertr:=text(wert(
+fnrvanrechnung),2);datum:=wert(fnrvdatum);position:=pos(vertretungsarten,
+artvertr);IF position=0THEN vertretungen(16)CAT sonstigkuerzelELSE WHILE (
+positionMOD 2)=0AND position<>0AND position<32REP position:=pos(
+vertretungsarten,artvertr,position+1);PER ;IF position=0OR (positionMOD 2)=0
+THEN vertretungen(16)CAT sonstigkuerzelELSE vertretungen(position)CAT 
+artvertrFI ;FI ;tag:=(zeit-1)DIV 12;std:=zeitMOD 12;IF tag=0THEN zeitaufber:=
+"Mo "ELIF tag=1THEN zeitaufber:="Di "ELIF tag=2THEN zeitaufber:="Mi "ELIF tag
+=3THEN zeitaufber:="Do "ELIF tag=4THEN zeitaufber:="Fr "ELIF tag=5THEN 
+zeitaufber:="Sa "FI ;zeitaufberCAT text(std,2);lvaufber:=subtext(lehrveranstg
+,1,2)+blank;lvaufberCAT subtext(lehrveranstg,3,4)+blank;lvaufberCAT subtext(
+lehrveranstg,5,8);setzesonderwert(swdatum,datum);setzesonderwert(swzeit,
+zeitaufber);setzesonderwert(swart,artvertr);setzesonderwert(swlv,lvaufber);
+END PROC swvertretungenfuellen;PROC 
+imrowgemerktedatenübervordruck2indruckdatei:BOOL VAR angabeda:=FALSE ;TEXT 
+VAR hilfsdatei:="hilfsdatei",kuerzel,langtext;INT VAR savedbstatus;
+savedbstatus:=dbstatus;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,
+bestand);zaehler:=1;WHILE zaehler<=maxvertretungsartenREP kuerzel:=text(
+vertretungen(zaehler),2);IF kuerzel<>"  "THEN IF kuerzel=sonstigkuerzelTHEN 
+kuerzel:="  ";langtext:=sonstigesELSE putwert(fnrschlschluessel,compress(
+kuerzel));search(dnrschluessel,TRUE );langtext:=wert(fnrschllangtext);FI ;
+setzesonderwert(swstd,text(length(vertretungen(zaehler))DIV 2,2));
+setzesonderwert(swart,kuerzel);setzesonderwert(swlangtext,klammerauf+langtext
++klammerzu);briefalternative(dateimitvertretungsdaten,hilfsdatei);angabeda:=
+TRUE ;FI ;zaehlerINCR 1;PER ;dbstatus(savedbstatus);IF angabedaTHEN 
+hilfsdateiindruckdatei(hilfsdatei)FI ;END PROC 
+imrowgemerktedatenübervordruck2indruckdatei;PROC hilfsdateiindruckdatei(TEXT 
+CONST hilfsdatei):FILE VAR f;INT VAR i;TEXT VAR zeile;f:=sequentialfile(input
+,hilfsdatei);zeilenhilfszahl:=lines(f);IF zeilenzahl+zeilenhilfszahl+
+zusatzzeilen>=drucklaengeTHEN seitenwechsel;zeilenzahl:=0;FI ;FOR iFROM 1
+UPTO zeilenhilfszahlREP getline(f,zeile);druckzeileschreiben(zeile)PER ;
+forget(hilfsdatei,quiet);zeilenzahlINCR zeilenhilfszahlEND PROC 
+hilfsdateiindruckdatei;END PACKET anschrvertretungen;
+
diff --git a/app/schulis/2.2.1/src/4.aufsichten erstellen b/app/schulis/2.2.1/src/4.aufsichten erstellen
new file mode 100644
index 0000000..06022bf
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.aufsichten erstellen
@@ -0,0 +1,194 @@
+PACKET aufsichtenerstellenDEFINES aufsichtsplandatenbearbeiten,
+aufsichtsplandatenspeichern,aufsichtsplanlehrerlistezeigen:LET feldeingtag=2,
+feldeingnr=3,feldeingakthj=4,feldbearbtag=2,feldbearbnr=3,feldbearbname=4,
+feldbearbort1=5,feldbearbpar1=6,letztesbearbfeld=38,leerereintrag="    ",
+bestandorte="c02 aufsichtsorte",trenner="�",schuljahr="Schuljahr",halbjahr=
+"Schulhalbjahr",ausgparam="#",bearbmaske="ms aufsichtsplan erstellen bearb",
+kennungparaphe="P",kennunglv="L",kennungraum="R",laengetagbeschr=17,
+laengeparaphe=4,laengeaufsort=4,laengeraumminus=3,maxanzorte=17,
+meldungserverfehler=376,meldungbearbwird=352,meldungkeinstdplan=366,
+meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326,
+meldungzuvielelv=358,meldungbasisinkon=378,meldunglisteerstellen=7,
+meldungfalschertag=385,meldungfalschepar=142,meldungwarten=69,
+meldungzuvieleorte=398,meldungkeinelehrer=337,meldungkeineorte=399,
+meldungkeinedaten=59,meldungschonaufs=401,meldungspeichern=50,
+meldungfalscherwert=54,meldungnichtsp=63,meldungspfehler=364,meldungplausi=57
+;ROW maxanzorteTEXT VAR datenausplan;TEXT VAR alletage:=
+"�01�1� 1�MO�mo�Mo�02�2� 2�DI�di�Di�"+"03�3� 3�MI�mi�Mi�04�4� 4�DO�do�Do�"+
+"05�5� 5�FR�fr�Fr�06�6� 6�SA�sa�Sa��";TEXT VAR tag:="",nr:="",komprpar:="",
+lehrerliste:="",orteliste:="",aufslehrerliste:="",schhj,schj,hjsjanhang:="",
+eintragtag,eintragnr,eintragname;INT VAR i,j,fstat,stdvor,stdnach,rowindex:=1
+,anzaufsorte:=0,hjkennalt:=-1,hjkennneu:=0,anzaufs:=0;BOOL VAR 
+aenderungsfehler:=FALSE ,stundenplannichtda:=TRUE ,zuvieleorte:=FALSE ;
+WINDOW VAR w:=startwindow(27,23,77,1);TEXT VAR liste,aktpar,lvvor,lvnach,
+raumvor,raumnach,paraphenvorstd:="",paraphennachstd:="",lvvorstd:="",
+lvnachstd:="",raeumevorstd:="",raeumenachstd:="";PROC 
+aufsichtsplandatenbearbeiten:standardmeldung(meldungwarten," ");
+pruefeingabedaten;holedaten;aufsichtsplandatenzeigen.pruefeingabedaten:
+prueftag;pruefnr.prueftag:tag:=standardmaskenfeld(feldeingtag);i:=pos(
+alletage,trenner+tag+trenner);IF i=0THEN return(1);infeld(feldeingtag);
+standardmeldung(meldungfalschertag,"");LEAVE aufsichtsplandatenbearbeiten
+ELSE IF tag=""THEN tag:="1"ELSE tag:=text(iDIV laengetagbeschr+1)FI FI .
+pruefnr:nr:=standardmaskenfeld(feldeingnr);IF nr=""THEN nr:="01"ELSE i:=int(
+nr);IF i<1COR i>15THEN return(1);infeld(feldeingnr);standardmeldung(
+meldungfalscherwert,"");LEAVE aufsichtsplandatenbearbeitenELSE nr:="0"+text(i
+);nr:=subtext(nr,length(nr)-1);FI ;FI .holedaten:IF akthj<>""THEN hjkennneu:=
+0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN hjkennalt:=hjkennneu;schj:=
+schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF hjkennneu=1THEN 
+geplanteshjundsjberechnen(schhj,schj)FI ;stundenplanhalbjahrsetzen(schhj,schj
+);hjsjanhang:=schhj+". "+text(schj,2)+"/"+subtext(schj,3);FI ;IF records(
+dnraufsichtszeiten)=0.0THEN fehlermeldungkeineaufszeitenFI ;IF orteliste=""
+THEN holeorteFI ;holestartzeit;holeparaphenzurstartzeit.akthj:
+standardmaskenfeld(feldeingakthj).fehlermeldungkeineaufszeiten:return(1);
+infeld(feldeingnr);standardmeldung(meldungkeinedaten,"");LEAVE 
+aufsichtsplandatenbearbeiten.holeorte:IF records(dnrschluessel)=0.0THEN 
+fehlermeldungkeineorteELSE zuvieleorte:=FALSE ;inittupel(dnrschluessel);
+statleseschleife(dnrschluessel,bestandorte,"",dnrschluessel+1,dnrschluessel+2
+,PROC erstelleorteliste);IF orteliste=""THEN fehlermeldungkeineorteELIF 
+anzaufsorte>maxanzorteTHEN orteliste:=text(orteliste,maxanzorte*laengeaufsort
+);anzaufsorte:=maxanzorte;zuvieleorte:=TRUE FI FI .fehlermeldungkeineorte:
+return(1);infeld(feldeingtag);standardmeldung(meldungkeineorte,"");LEAVE 
+aufsichtsplandatenbearbeiten.holestartzeit:inittupel(dnraufsichtszeiten);
+putwert(fnrazsj,schj);putwert(fnrazhj,schhj);putwert(fnrazaufsichtszeit,tag+
+nr);search(dnraufsichtszeiten,TRUE );IF dbstatus<>0THEN 
+fehlermeldungkeineaufszeitenELSE eintragtag:=tagesangabe(tag);eintragnr:=text
+(int(nr),2);eintragname:=wert(fnrazbezeichnung);stdvor:=intwert(
+fnraztagstdvor);stdnach:=intwert(fnraztagstdnach)FI .holeparaphenzurstartzeit
+:IF records(dnraufsichtsplan)=0.0THEN LEAVE holeparaphenzurstartzeitELSE 
+inittupel(dnraufsichtsplan);aufslehrerliste:="";putwert(fnrapaufsichtszeit,
+tag+nr);statleseschleife(dnraufsichtsplan,schj,schhj,fnrapsj,fnraphj,PROC 
+parderaufsicht)FI .END PROC aufsichtsplandatenbearbeiten;PROC 
+aufsichtsplandatenzeigen:standardstartproc(bearbmaske);
+standardkopfmaskeaktualisieren("Aufsichtsplan erstellen für "+hjsjanhang);
+fuellemaske;standardnprocEND PROC aufsichtsplandatenzeigen;PROC fuellemaske:
+INT VAR aktpos,aktfeld;TEXT VAR ort,paraphe;infeld(1);standardmaskenfeld(
+eintragtag,feldbearbtag);standardmaskenfeld(eintragnr,feldbearbnr);
+standardmaskenfeld(eintragname,feldbearbname);gibaufsorteaus;
+standardfelderausgeben;infeld(feldbearbpar1);liste:="";aenderungsfehler:=
+FALSE ;IF zuvieleorteTHEN standardmeldung(meldungzuvieleorte,"");zuvieleorte
+:=FALSE FI .gibaufsorteaus:aktpos:=1;rowindex:=1;aktfeld:=feldbearbort1;
+WHILE aktpos<length(orteliste)REP ort:=subtext(orteliste,aktpos,aktpos+
+laengeaufsort-1);paraphe:=holeaufsicht(ort);datenausplan(rowindex):=paraphe;
+standardmaskenfeld(ort,aktfeld);standardmaskenfeld(paraphe,aktfeld+1);
+rowindexINCR 1;aktposINCR laengeaufsort;aktfeldINCR 2PER ;FOR iFROM aktfeld
+UPTO letztesbearbfeldREP standardmaskenfeld(leerereintrag,i);IF iMOD 2=0THEN 
+feldschutz(i)FI PER .END PROC fuellemaske;TEXT PROC holeaufsicht(TEXT CONST 
+ort):INT VAR aktpos;aktpos:=pos(aufslehrerliste,trenner+trenner+ort+trenner);
+IF aktpos>0THEN subtext(aufslehrerliste,aktpos+7,pos(aufslehrerliste,trenner,
+aktpos+7)-1)ELSE ""FI END PROC holeaufsicht;PROC aufsichtsplandatenspeichern(
+BOOL CONST speichern):TEXT VAR zeit,eintragort,eintragpar,weiterereintragpar;
+INT VAR aktfeld:=5,feld;aenderungsfehler:=FALSE ;IF speichernTHEN 
+aenderungenspeichernELSE standardmeldung(meldungnichtsp,"")FI ;IF 
+aenderungsfehlerTHEN fehlermeldungspfehlerFI ;naechstezeit.
+aenderungenspeichern:standardmeldung(meldungplausi,"");aenderungsfehler:=
+FALSE ;aktfeld:=5;FOR iFROM 1UPTO anzaufsorteREP eintragpar:=
+standardmaskenfeld(aktfeld+1);IF eintragpar<>""THEN IF NOT 
+bezeichnungzulaessig("P",eintragpar)THEN fehlermeldungfalscheparapheELIF 
+eintragpar<>datenausplan(i)THEN pruefanderebseintraegeFI FI ;aktfeldINCR 2
+PER ;standardmeldung(meldungspeichern,"");aktfeld:=5;FOR iFROM 1UPTO 
+anzaufsorteREP eintragort:=standardmaskenfeld(aktfeld);eintragpar:=
+standardmaskenfeld(aktfeld+1);IF datenausplan(i)<>eintragparTHEN 
+speicheraenderungenFI ;aktfeldINCR 2PER .pruefanderebseintraege:feld:=6;FOR j
+FROM 1UPTO anzaufsorteREP IF feld<>aktfeld+1THEN weiterereintragpar:=
+standardmaskenfeld(feld);IF eintragpar=weiterereintragparTHEN 
+fehlermeldungparaphedoppeltFI ;FI ;feldINCR 2PER .fehlermeldungparaphedoppelt
+:standardmeldung(meldungschonaufs,eintragpar+ausgparam+standardmaskenfeld(
+feld-1)+ausgparam);infeld(aktfeld+1);return(1);LEAVE 
+aufsichtsplandatenspeichern.fehlermeldungfalscheparaphe:standardmeldung(
+meldungfalschepar,eintragpar+ausgparam);infeld(aktfeld+1);return(1);LEAVE 
+aufsichtsplandatenspeichern.fehlermeldungspfehler:standardmeldung(
+meldungspfehler,"");infeld(feldbearbpar1);return(1);LEAVE 
+aufsichtsplandatenspeichern.speicheraenderungen:IF datenausplan(i)=""CAND 
+eintragpar<>""THEN insertsatzELIF datenausplan(i)<>""CAND eintragpar=""THEN 
+deletesatzELSE updatesatzFI .insertsatz:inittupel(dnraufsichtsplan);putwert(
+fnrapsj,schj);putwert(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr);
+putwert(fnrapaufsichtsort,compress(eintragort));putwert(fnrapparaphe,
+eintragpar);insert(dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:=
+TRUE FI .updatesatz:inittupel(dnraufsichtsplan);putwert(fnrapsj,schj);putwert
+(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr);putwert(fnrapaufsichtsort,
+compress(eintragort));putwert(fnrapparaphe,datenausplan(i));search(
+dnraufsichtsplan,TRUE );IF dbstatus=okTHEN putwert(fnrapparaphe,eintragpar);
+update(dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:=TRUE FI ELSE 
+aenderungsfehler:=TRUE FI .deletesatz:inittupel(dnraufsichtsplan);putwert(
+fnrapsj,schj);putwert(fnraphj,schhj);putwert(fnrapaufsichtszeit,tag+nr);
+putwert(fnrapaufsichtsort,compress(eintragort));putwert(fnrapparaphe,
+datenausplan(i));search(dnraufsichtsplan,TRUE );IF dbstatus=okTHEN delete(
+dnraufsichtsplan);IF dbstatus<>okTHEN aenderungsfehler:=TRUE FI ELSE 
+aenderungsfehler:=TRUE FI .naechstezeit:succ(dnraufsichtszeiten);IF wert(
+fnrazsj)<>schjCOR wert(fnrazhj)<>schhjCOR dbstatus<>0THEN verlasseanwendung
+ELSE zeit:=wert(fnrazaufsichtszeit);tag:=text(zeit,1);nr:=subtext(zeit,2);
+eintragtag:=tagesangabe(tag);eintragnr:=text(int(nr),2);eintragname:=wert(
+fnrazbezeichnung);stdvor:=intwert(fnraztagstdvor);stdnach:=intwert(
+fnraztagstdnach);inittupel(dnraufsichtsplan);aufslehrerliste:="";putwert(
+fnrapaufsichtszeit,zeit);statleseschleife(dnraufsichtsplan,schj,schhj,fnrapsj
+,fnraphj,PROC parderaufsicht);fuellemaske;return(1)FI .verlasseanwendung:
+enter(2).END PROC aufsichtsplandatenspeichern;PROC 
+aufsichtsplanlehrerlistezeigen:INT VAR parpos,anfpos,aktfeld:=infeld;
+standardmeldung(meldunglisteerstellen,"");IF liste=""THEN IF lehrerliste=""
+THEN holelehrerFI ;IF stundenplannichtdaTHEN 
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+meldungausgeben(fstat);return(1);LEAVE aufsichtsplanlehrerlistezeigenELSE 
+stundenplannichtda:=FALSE FI ;FI ;IF stdvor<>0THEN paraphenvorstd:=
+datenderzeit(stdvor,kennungparaphe);lvvorstd:=datenderzeit(stdvor,kennunglv);
+raeumevorstd:=datenderzeit(stdvor,kennungraum)ELSE paraphenvorstd:="";
+lvvorstd:="";raeumevorstd:="";FI ;IF stdnach<>0THEN paraphennachstd:=
+datenderzeit(stdnach,kennungparaphe);lvnachstd:=datenderzeit(stdnach,
+kennunglv);raeumenachstd:=datenderzeit(stdnach,kennungraum)ELSE 
+paraphennachstd:="";lvnachstd:="";raeumenachstd:=""FI ;fuelleliste;FI ;IF 
+menuedraussenTHEN reorganizescreenFI ;infeld(1);standardfelderausgeben;open(w
+);auskunfterteilung(liste,w,FALSE );reorganizescreen;setlasteditvalues;infeld
+(aktfeld);return(1).fuelleliste:listeCAT "Aufsicht möglich durch:";listeCAT 
+auskunftstextende;listeCAT "Paraphe Anz. Unterr. vorher  Unterr. nachher";
+listeCAT auskunftstextende;FOR iFROM 1UPTO length(lehrerliste)DIV 
+laengeparapheREP lvvor:="";lvnach:="";raumvor:="";raumnach:="";aktpar:=
+subtext(lehrerliste,(i-1)*laengeparaphe+1,i*laengeparaphe);parpos:=suchpos(
+paraphenvorstd,aktpar,laengeparaphe);IF parpos>0THEN anfpos:=(parpos-1)*2;
+lvvor:=subtext(lvvorstd,anfpos+1,anfpos+8);raumvor:=subtext(raeumevorstd,
+parpos,parpos+laengeraumminus)FI ;parpos:=suchpos(paraphennachstd,aktpar,
+laengeparaphe);IF parpos>0THEN anfpos:=(parpos-1)*2;lvnach:=subtext(lvnachstd
+,anfpos+1,anfpos+8);raumnach:=subtext(raeumenachstd,parpos,parpos+
+laengeraumminus)FI ;IF lvvor<>""COR lvnach<>""THEN schreiblisteneintragFI ;
+PER ;listeCAT "*";listeCAT auskunftstextende.holelehrer:IF records(dnrlehrer)
+=0.0THEN fehlermeldungkeinelehrerELSE inittupel(dnrlehrer);statleseschleife(
+dnrlehrer,"","",fnrlparaphe,fnrlfamname,PROC erstellelehrerliste)FI .
+fehlermeldungkeinelehrer:return(1);infeld(feldeingtag);standardmeldung(
+meldungkeinelehrer,"");LEAVE aufsichtsplanlehrerlistezeigen.END PROC 
+aufsichtsplanlehrerlistezeigen;PROC schreiblisteneintrag:standardmeldung(
+meldungbearbwird,aktpar+ausgparam);listeCAT text(aktpar,8);komprpar:=compress
+(aktpar);listeCAT text(aufsichtenderparaphe,2);IF lvvor=""THEN listeCAT 
+"                  ";ELSE listeCAT "   ";listeCAT text(lvvor,2);listeCAT " ";
+listeCAT subtext(lvvor,3,4);listeCAT " ";listeCAT subtext(lvvor,5);listeCAT 
+"/";listeCAT raumvorFI ;IF lvnach=""THEN listeCAT "                ";ELSE 
+listeCAT " ";listeCAT text(lvnach,2);listeCAT " ";listeCAT subtext(lvnach,3,4
+);listeCAT " ";listeCAT subtext(lvnach,5);listeCAT "/";listeCAT raumnachFI ;
+listeCAT auskunftstextende.END PROC schreiblisteneintrag;INT PROC 
+aufsichtenderparaphe:inittupel(dnraufsichtsplan);anzaufs:=0;statleseschleife(
+ixappar,komprpar,"",fnrapparaphe,fnrapsj,PROC anzaufsichtenzaehlen);anzaufs
+END PROC aufsichtenderparaphe;PROC anzaufsichtenzaehlen(BOOL VAR b):IF 
+dbstatus<>okCOR wert(fnrapparaphe)>komprparTHEN dbstatus(1);b:=TRUE ELIF wert
+(fnrapsj)=schjCAND wert(fnraphj)=schhjTHEN anzaufsINCR 1FI END PROC 
+anzaufsichtenzaehlen;INT PROC suchpos(TEXT CONST quelle,muster,INT CONST 
+musterlaenge):INT VAR suchab:=1,aktpos;IF quelle<>""THEN WHILE pos(quelle,
+muster,suchab)>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD 
+musterlaenge=1THEN LEAVE suchposWITH aktposELSE suchab:=aktpos+1FI ;PER ;FI ;
+0END PROC suchpos;PROC erstellelehrerliste(BOOL VAR b):IF dbstatus<>0THEN b:=
+TRUE ELSE lehrerlisteCAT text(wert(fnrlparaphe),laengeparaphe)FI END PROC 
+erstellelehrerliste;PROC erstelleorteliste(BOOL VAR b):IF wert(dnrschluessel+
+1)>bestandorteCOR dbstatus<>0THEN b:=TRUE ELSE ortelisteCAT text(wert(
+dnrschluessel+2),laengeaufsort);anzaufsorteINCR 1FI END PROC 
+erstelleorteliste;PROC parderaufsicht(BOOL VAR b):IF wert(fnrapsj)<>schjCOR 
+wert(fnraphj)<>schhjCOR wert(fnrapaufsichtszeit)<>tag+nrCOR dbstatus<>0THEN 
+dbstatus(1);b:=TRUE ELSE aufslehrerlisteCAT trenner;aufslehrerlisteCAT 
+trenner;aufslehrerlisteCAT text(wert(fnrapaufsichtsort),laengeaufsort);
+aufslehrerlisteCAT trenner;aufslehrerlisteCAT wert(fnrapparaphe);
+aufslehrerlisteCAT trennerFI END PROC parderaufsicht;TEXT PROC tagesangabe(
+TEXT CONST tag):IF tag="1"THEN "Mo"ELIF tag="2"THEN "Di"ELIF tag="3"THEN "Mi"
+ELIF tag="4"THEN "Do"ELIF tag="5"THEN "Fr"ELSE "Sa"FI END PROC tagesangabe;
+PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung(
+meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan,
+"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5
+THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN 
+standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;END PACKET aufsichtenerstellen
+
diff --git a/app/schulis/2.2.1/src/4.daten für intega aufbereiten b/app/schulis/2.2.1/src/4.daten für intega aufbereiten
new file mode 100644
index 0000000..008e89e
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.daten für intega aufbereiten
@@ -0,0 +1,462 @@
+PACKET datenfuerintegaaufbereitenDEFINES integastdvproc,integaarchiv,
+integaabfrage,integaaufbereitenoderabfrage,integaentfernen,integaposhalt,
+integaloescheundreturn,integadatenzeigen,integadatendrucken,
+schulisintegatransfer:LET raumkenndaten="c02 raeume",schulkenndaten=
+"c02 schulkenndaten",schulhj="Schulhalbjahr",schulj="Schuljahr",schulname=
+"Schulname",schulort="Schulort",schulstr="Schulstraße",eingmaske=
+"ms eing integaeingabedatei",fldakthj=2,fldfix1=3,fldfix2=4,fldinteganame=5,
+meldg0=69,meldg1=340,meldg2=323,meldg3=324,meldg4=331,meldg5=332,meldg6=333,
+meldg7=334,meldg8=335,meldg9=336,meldg10=337,meldg11=338,meldg13=343,meldg14=
+345,meldg15=346,meldg16=347,meldg17=348,meldg18=349,meldg19=350,meldg20=351,
+meldg21=381,meldg22=56,meldg23=58,meldungbearbwird=352,meldungserverfehler=
+376,meldungkeinstdplan=366,meldungkeinesugruppen=334,meldungzuvielesugruppen=
+356,meldungkeinelv=326,meldungzuvielelv=358,meldungbasisinkon=378,
+meldungstdplauswvorber=384,zeilenende="",erstestde=1,maxstden=66,vormstden=6,
+nachmstden=6,stdenprotag=12,vorm=6,nachm=5,unttage=6,eumelgrenzemaxzeilen=
+4000,ausgparam="#",trenner="�";LET filemodus="file ibm",leererunbestwunsch=
+"         ",dateikennung=".DP",dos="DOS",kennpar="P",kennsugrup="S",kennraum=
+"R",kennkoppl="K",kennfach="F",listenname=
+"Liste der Dateien auf der Diskette:";DATASPACE VAR dszeitw,dslverf,dskverf;
+FILE VAR f,g,z,k,l;INT VAR p,i,j,h,fstat,zz:=0,ruecksprung:=1,maxvs:=0,maxns
+:=0,vs:=vormstden,ns:=nachmstden,nulltestd:=0,vm:=vorm,objvm,nm:=nachm,objnm,
+ut:=unttage,objut,jahrende;TEXT VAR sgrdaten:="",sgridaten:="",klgr:=trenner,
+klgrdaten:="",rgrdaten:=trenner,letztepar:="",par:="",objektverf:="",
+lehrerdaten,bearbkopplungen,kartenart,zeitwuensche:=trenner,
+schulverfuegbarkeit:="",dateiname:="SCHULIS.DP",schuldaten:="",zeile:="",
+aktschj:="0",aktschhj:="0",geplschj:="0",geplschhj:="0",schj,schhj,record:=""
+,t1:="",t2:="",zeitdaten:="";BOOL VAR datenfehler,fehler,mindeinraum,
+archivfehler,falschesugrupgefunden:=FALSE ,abbruchwegen4000zeilen:=FALSE ;
+THESAURUS VAR thes;TEXT VAR t:="",leererbestwunsch:=
+"                                                                      "+
+"                                                              ",bestwunsch,
+unbestwunsch;PROC integaposhalt(INT CONST rueck):infeld(fldakthj);return(
+rueck)END PROC integaposhalt;PROC loeschemeldung:INT VAR ankreuzung:=1;FOR i
+FROM fldakthjUPTO fldfix2REP IF standardmaskenfeld(i)<>""THEN ankreuzung:=
+ankreuzung*(2*i-1)FI PER ;standardstartproc(eingmaske);infeld(fldakthj);FOR i
+FROM fldakthjUPTO fldfix2REP IF ankreuzungMOD (2*i-1)=0THEN 
+standardmaskenfeld("x",i)FI PER ;standardmaskenfeld(text(dateiname,pos(
+dateiname,".")-1),fldinteganame);standardfelderausgeben;infeld(fldakthj);END 
+PROC loeschemeldung;PROC archivanmelden:archivfehler:=FALSE ;commanddialogue(
+FALSE );disablestop;dateiname:=standardmaskenfeld(fldinteganame)+".DP";IF 
+standardmaskenfeld(fldinteganame)=""THEN fehlermeldungnamefalschELIF 
+falschercode(dateiname)THEN fehlermeldungnamefalschFI ;reserve(filemodus,/dos
+);IF iserrorTHEN archivfehler:=TRUE ;abbruchnachfehler(1);LEAVE 
+archivanmeldenFI ;enablestop.fehlermeldungnamefalsch:archivfehler:=TRUE ;
+return(ruecksprung);infeld(fldinteganame);standardmeldung(meldg2,subtext(
+dateiname,i,i)+"#"+dateiname+"#");LEAVE archivanmelden.END PROC 
+archivanmelden;PROC integaarchiv(INT CONST wahl):SELECT wahlOF CASE 1:
+archivinitialisierenCASE 2:archivanmelden;IF archivfehlerTHEN LEAVE 
+integaarchivFI ;archivlistenCASE 3:archivbeschreibenCASE 4:
+archivueberschreibenEND SELECT .archivinitialisieren:standardmeldung(meldg0,
+" ");disablestop;clear(/dos);IF iserrorTHEN abbruchnachfehler(2);LEAVE 
+integaarchivFI ;enablestop;loeschemeldung;return(2).archivlisten:
+standardmeldung(meldg0," ");disablestop;g:=sequentialfile(output,listenname);
+thes:=ALL /dos;IF iserrorTHEN abbruchnachfehler(1);LEAVE integaarchivFI ;
+thesaurusaufbereiten;enablestop;zeigedatei(listenname,"vr").
+thesaurusaufbereiten:t:=" ";i:=0;REP get(thes,t,i);putline(g,t)UNTIL t=""PER 
+.archivbeschreiben:standardmeldung(meldg0," ");disablestop;IF exists(
+dateiname,/dos)THEN IF iserrorTHEN abbruchnachfehler(2);LEAVE integaarchiv
+ELSE abfragedateiueberschreibenFI ELSE save(dateiname,/dos);IF iserrorTHEN 
+abbruchnachfehler(2);LEAVE integaarchivFI ;enablestop;commanddialogue(TRUE );
+loeschemeldung;return(2);FI .abfragedateiueberschreiben:infeld(1);
+standardmeldung(meldg19,dateiname+"#");standardnproc.archivueberschreiben:
+standardmeldung(meldg0," ");disablestop;commanddialogue(FALSE );erase(
+dateiname,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE integaarchivFI ;
+save(dateiname,/dos);IF iserrorTHEN abbruchnachfehler(3);LEAVE integaarchiv
+FI ;enablestop;commanddialogue(TRUE );loeschemeldung;return(3).END PROC 
+integaarchiv;PROC integaloescheundreturn(BOOL CONST b):IF bTHEN forget(
+listenname,quiet);FI ;loeschemeldung;return(2)END PROC integaloescheundreturn
+;PROC abbruchnachfehler(INT CONST schritte):standardmeldung(meldg13,
+"Fehler: "+errormessage+" !#");clearerror;infeld(fldakthj);return(schritte);
+release(/dos);commanddialogue(TRUE );enablestopEND PROC abbruchnachfehler;
+PROC integaabfrage(INT CONST wahl):SELECT wahlOF CASE 1:archivanmelden;IF 
+archivfehlerTHEN LEAVE integaabfrageFI ;standardmeldung(meldg16,"")CASE 2:
+archivanmelden;IF archivfehlerTHEN LEAVE integaabfrageFI ;standardmeldung(
+meldg17,"")CASE 3:fragevorbereiten;standardmeldung(meldg18,dateiname+"#"+text
+(t2,8)+"#")END SELECT ;infeld(1);standardnproc.fragevorbereiten:dateiname:=
+standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld(fldinteganame)=
+""THEN fehlermeldungnamefalschELIF falschercode(dateiname)THEN 
+fehlermeldungnamefalschFI ;IF exists(dateiname)THEN beginlist;REP 
+getlistentry(t1,t2);UNTIL t1=dateinameCOR t1=""PER ;ELSE return(1);infeld(
+fldinteganame);standardmeldung(meldg20,dateiname+"#");LEAVE integaabfrageFI .
+fehlermeldungnamefalsch:return(1);infeld(fldinteganame);standardmeldung(
+meldg2,subtext(dateiname,i,i)+"#"+dateiname+"#");LEAVE integaabfrage.END 
+PROC integaabfrage;PROC integadatenzeigen:standardmeldung(meldg0," ");
+dateiname:=standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld(
+fldinteganame)=""THEN fehlermeldungnamefalschELIF falschercode(dateiname)
+THEN fehlermeldungnamefalschFI ;IF exists(dateiname)THEN zeigedatenELSE 
+return(1);infeld(fldinteganame);standardmeldung(meldg20,dateiname+"#");LEAVE 
+integadatenzeigenFI .fehlermeldungnamefalsch:return(1);infeld(fldinteganame);
+standardmeldung(meldg2,subtext(dateiname,i,i)+"#"+dateiname+"#");LEAVE 
+integadatenzeigen.zeigedaten:zeigedatei(dateiname,"vr").END PROC 
+integadatenzeigen;PROC integadatendrucken:dateiname:=standardmaskenfeld(
+fldinteganame)+".DP";IF exists(dateiname)THEN standardmeldung(meldg23,"");
+print(dateiname)ELSE infeld(fldinteganame);standardmeldung(meldg20,dateiname+
+"#");FI ;return(1).END PROC integadatendrucken;PROC integaentfernen:infeld(
+fldinteganame);dateiname:=standardmaskenfeld(fldinteganame)+".DP";forget(
+dateiname,quiet);infeld(fldakthj);return(2);END PROC integaentfernen;PROC 
+integastdvproc:standardstartproc(eingmaske);standardmaskenfeld("SCHULIS",
+fldinteganame);standardfelderausgeben;infeld(fldakthj);standardnprocEND PROC 
+integastdvproc;PROC integaaufbereitenoderabfrage:beginlist;REP getlistentry(
+t1,t2);IF pos(t1,dateikennung)>0THEN standardmeldung(meldg18,t1+"#"+text(t2,8
+)+"#");infeld(fldinteganame);standardnproc;ruecksprung:=2;LEAVE 
+integaaufbereitenoderabfrageFI ;UNTIL t1=""PER ;ruecksprung:=1;
+schulisintegatransferEND PROC integaaufbereitenoderabfrage;PROC 
+schulisintegatransfer:falschesugrupgefunden:=FALSE ;standardmeldung(meldg0,
+" ");forget(t1,quiet);init;pruefeeingmaske;stelledateinamefest;
+stellehalbjahrfest;pruefobintegabezda;holestundenplandaten;melde("A");
+schreibeschulname;stellezeitvarfest;berechneschulverfuegbarkeit;melde("BA");
+schreibefragenkatalog;melde("BB");schreibegewichtungen;melde("BC");
+schreibezeitraster1;melde("BD");schreibezeitraster2;pruefdateigroesse;
+holeallezeitwuensche;melde("C");schreibelehrerdaten;pruefdateigroesse;melde(
+"D und F");schreibeklassen;pruefdateigroesse;melde("G");schreiberaumgruppen;
+pruefdateigroesse;melde("H");schreibeuvdaten;pruefdateigroesse;melde("I");
+schreibeschulverfgbkt;pruefdateigroesse;melde("J");schreibelehrerverfgbkt;
+pruefdateigroesse;melde("K");schreiberaumverfgbkt;pruefdateigroesse;melde("L"
+);schreibeklassenverfgbkt;pruefdateigroesse;melde("M");schreibefachverfgbkt;
+pruefdateigroesse;melde("N");schreibevorbelegungen;pruefdateigroesse;
+gibfertigmeldungaus.pruefdateigroesse:IF zz>eumelgrenzemaxzeilenTHEN 
+standardmeldung(meldg14,"");return(ruecksprung);LEAVE schulisintegatransfer
+FI .init:dszeitw:=nilspace;dslverf:=nilspace;dskverf:=nilspace;z:=
+sequentialfile(modify,dszeitw);l:=sequentialfile(modify,dslverf);k:=
+sequentialfile(modify,dskverf);insertrecord(z);insertrecord(l);insertrecord(k
+);zz:=0.pruefeeingmaske:IF standardmaskenfeld(fldfix1)<>""CAND 
+standardmaskenfeld(fldfix2)<>""THEN return(ruecksprung);standardmeldung(
+meldg22,"");infeld(fldfix1);LEAVE schulisintegatransferFI ;dateiname:=
+standardmaskenfeld(fldinteganame)+".DP";IF standardmaskenfeld(fldinteganame)=
+""THEN i:=0;fehlermeldungnamefalschELIF falschercode(dateiname)THEN 
+fehlermeldungnamefalschFI .fehlermeldungnamefalsch:return(ruecksprung);infeld
+(fldinteganame);standardmeldung(meldg2,subtext(dateiname,i,i)+"#"+dateiname+
+"#");LEAVE schulisintegatransfer.pruefobintegabezda:sgridaten:="";letztepar:=
+"";inittupel(dnraktschuelergruppen);datenfehler:=FALSE ;dbleer(
+dnraktschuelergruppen);IF fehlerTHEN fehlerkeineschuelergruppenFI ;
+statleseschleife(dnraktschuelergruppen,schj,schhj,dnraktschuelergruppen+1,
+dnraktschuelergruppen+2,PROC sgridatenholen);IF datenfehlerTHEN 
+fehlermeldungintegaELSE sgridatenCAT trennerFI .fehlerkeineschuelergruppen:
+return(ruecksprung);standardmeldung(meldg7,"");LEAVE schulisintegatransfer.
+fehlermeldungintega:return(ruecksprung);standardmeldung(meldg4,"");LEAVE 
+schulisintegatransfer.stelledateinamefest:f:=sequentialfile(output,dateiname)
+.stellehalbjahrfest:holeschuldaten;aktschhj:=holedatum(schuldaten,trenner+
+schulhj+trenner);aktschj:=holedatum(schuldaten,trenner+schulj+trenner);IF 
+aktschhj="1"THEN geplschhj:="2";geplschj:=aktschjELSE geplschhj:="1";geplschj
+:=subtext(aktschj,3);jahrende:=int(geplschj)+1;geplschjCAT subtext("0"+text(
+jahrende),LENGTH ("0"+text(jahrende))-1)FI ;IF standardmaskenfeld(fldakthj)<>
+""THEN schj:=aktschj;schhj:=aktschhjELSE schj:=geplschj;schhj:=geplschhjFI .
+holeschuldaten:dbleer(dnrschluessel);IF fehlerTHEN fehlerkeineschuldatenFI ;
+schuldaten:=trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+schulkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC schulkennung).
+fehlerkeineschuldaten:return(ruecksprung);standardmeldung(meldg8,"");LEAVE 
+schulisintegatransfer.holestundenplandaten:standardmeldung(
+meldungstdplauswvorber,"");stundenplanhalbjahrsetzen(schhj,schj);
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+meldungausgeben(fstat);return(ruecksprung);LEAVE schulisintegatransferFI .
+stellezeitvarfest:holezeitdaten;IF zeitdaten=trennerTHEN LEAVE 
+stellezeitvarfestELSE stelleunttagefestFI .holezeitdaten:zeitdaten:=trenner;
+dbleer(dnrzeitraster);IF fehlerTHEN fehlerkeinezeitdatenFI ;inittupel(
+dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,dnrzeitraster+1,
+dnrzeitraster+2,PROC zeitrasterdaten).fehlerkeinezeitdaten:return(ruecksprung
+);standardmeldung(meldg9,"");LEAVE schulisintegatransfer.stelleunttagefest:
+INT VAR akttagv:=0,akttagn:=0;vm:=0;nm:=0;ut:=0;FOR iFROM 1UPTO unttageREP vs
+:=0;ns:=0;nulltestd:=(i-1)*stdenprotag;IF pos(zeitdaten,trenner+text(
+nulltestd+1)+trenner)>0THEN utINCR 1;stellestdenfestELSE LEAVE 
+stelleunttagefestFI PER .stellestdenfest:FOR jFROM 1UPTO stdenprotagREP IF 
+pos(zeitdaten,trenner+text(nulltestd+j)+trenner)>0THEN holedrittesdatum(
+zeitdaten,trenner+text(nulltestd+j)+trenner);zaehlevunstden;IF akttagv<>i
+CAND t1="v"THEN vmINCR 1;akttagv:=iFI ;IF akttagn<>iCAND t1="n"THEN nmINCR 1;
+akttagn:=iFI ;ELSE LEAVE stellestdenfestFI ;PER ;IF maxvs<vsTHEN maxvs:=vsFI 
+;IF maxns<nsTHEN maxns:=nsFI .zaehlevunstden:IF t1="v"THEN vsINCR 1ELIF t1=
+"n"THEN nsINCR 1FI .schreibeschulname:zeile:="";zeileCAT holedatum(schuldaten
+,trenner+schulname+trenner);zeileCAT "  "+holedatum(schuldaten,trenner+
+schulort+trenner);zeileCAT "  "+holedatum(schuldaten,trenner+schulstr+trenner
+);zeile:=text(zeile,70);zeileCAT "A ";zeileCAT zeilenende;putlinezz(f,zeile);
+zeile:=schhj+". Hj.";zeileCAT " "+text(schj,2)+"/"+subtext(schj,3);zeile:=
+text(zeile,70);zeileCAT "A ";zeileCAT zeilenende;putlinezz(f,zeile).
+berechneschulverfuegbarkeit:schulverfuegbarkeit:="";FOR iFROM 1UPTO unttage
+REP FOR jFROM 1UPTO stdenprotagREP IF pos(zeitdaten,trenner+text((i-1)*
+stdenprotag+j)+trenner)>0THEN holedrittesdatum(zeitdaten,trenner+text((i-1)*
+stdenprotag+j)+trenner);IF t1="x"THEN schulverfuegbarkeitCAT "1"ELSE 
+schulverfuegbarkeitCAT " "FI ELSE schulverfuegbarkeitCAT " "FI PER PER ;
+schulverfuegbarkeit:=text(schulverfuegbarkeit,maxstden).schreibeschulverfgbkt
+:putlinezz(f,"    "+schulverfuegbarkeit+"I"+zeilenende).schreibefragenkatalog
+:vs:=maxvs;ns:=maxns;zeile:="";zeileCAT "FRAGEN   ";zeileCAT " N N N 0";IF vs
+<10THEN zeileCAT " "+text(vs)ELSE zeileCAT text(vs)FI ;zeileCAT 
+" 0 312 3100 0  ";zeileCAT text(ut);zeileCAT 
+"253146                             BA";zeileCAT zeilenende;putlinezz(f,zeile
+).schreibegewichtungen:zeile:="";zeileCAT "GEWICHT  ";zeileCAT 
+" 2 2 2 2 2 2 2 2 2 2 2 0";zeileCAT "                                     ";
+zeileCAT "BB";zeileCAT zeilenende;putlinezz(f,zeile).schreibezeitraster1:IF 
+zeitdaten=""THEN LEAVE schreibezeitraster1FI ;zeile:="";zeileCAT "RASTERR";
+zeileCAT " 1 1";IF vs<10THEN zeileCAT " "+text(vs)ELSE zeileCAT text(vs)FI ;
+zeileCAT "                                                         ";zeile
+CAT "BC";zeileCAT zeilenende;putlinezz(f,zeile);zeile:="";zeileCAT "RASTERR";
+zeileCAT " 2 1";IF vs<11THEN zeileCAT " "+text(vs-1)ELSE zeileCAT text(vs-1)
+FI ;zeileCAT "                                                         ";
+zeileCAT "BC";zeileCAT zeilenende;putlinezz(f,zeile);zeile:="";zeileCAT 
+"RASTERB";IF vs<6THEN zeileCAT " 2 1 3                  ";ELIF vs<8THEN zeile
+CAT " 2 1 3 5                ";ELIF vs<10THEN zeileCAT 
+" 2 1 3 5 7              ";ELIF vs<12THEN zeileCAT " 2 1 3 5 7 9            "
+;ELSE zeileCAT " 2 1 3 5 7 911          ";FI ;zeileCAT 
+"                                       ";zeileCAT "BC";zeileCAT zeilenende;
+putlinezz(f,zeile).schreibezeitraster2:IF zeitdaten=""THEN LEAVE 
+schreibezeitraster2FI ;FOR iFROM 1UPTO 12REP hole2daten(zeitdaten,trenner+
+text(i)+trenner);IF t1<>""COR t1<>" "THEN IF i<10THEN 
+zeitrasterzeilenerstellen(" "+text(i),t1,t2);ELSE zeitrasterzeilenerstellen(
+text(i),t1,t2);FI ;FI ;PER .holeallezeitwuensche:dbleer(dnrzeitwuensche);IF 
+NOT fehlerTHEN inittupel(dnrzeitwuensche);statleseschleife(dnrzeitwuensche,
+schj,schhj,dnrzeitwuensche+1,dnrzeitwuensche+2,PROC zeitw)FI .
+schreibelehrerdaten:inittupel(dnrlehrer);fehler:=FALSE ;dbleer(dnrlehrer);IF 
+fehlerTHEN fehlerkeinelehrerFI ;fehler:=FALSE ;statleseschleife(dnrlehrer,"",
+"",dnrlehrer+1,dnrlehrer+2,PROC lehrer);IF fehlerTHEN return(ruecksprung);
+standardmeldung(meldg3,"");LEAVE schulisintegatransferFI .fehlerkeinelehrer:
+return(ruecksprung);standardmeldung(meldg10,"");LEAVE schulisintegatransfer.
+schreibeklassen:sgrdaten:="";klgrdaten:="";inittupel(dnraktschuelergruppen);
+statleseschleife(dnraktschuelergruppen,schj,schhj,dnraktschuelergruppen+1,
+dnraktschuelergruppen+2,PROC sgrdatenholen);dbleer(dnrklassengruppen);IF NOT 
+fehlerTHEN inittupel(dnrklassengruppen);statleseschleife(dnrklassengruppen,""
+,"",dnrklassengruppen+1,dnrklassengruppen+2,PROC klgrdatenholen);FI ;IF 
+sgrdaten<>""THEN schreibeklstELSE fehlermeldungaktschgrfehlenFI ;IF klgrdaten
+<>""THEN schreibeklgrFI .fehlermeldungaktschgrfehlen:return(ruecksprung);
+standardmeldung(meldg5,"");LEAVE schulisintegatransfer.schreibeklst:p:=1;
+WHILE pos(sgrdaten,trenner,p+1)>0REP spput(subtext(sgrdaten,p+1,pos(sgrdaten,
+trenner,p+1)-1));p:=pos(sgrdaten,trenner,p+1)PER ;spput(subtext(sgrdaten,p+1)
+).schreibeklgr:p:=1;WHILE pos(klgrdaten,trenner,p+1)>0REP spiput(subtext(
+klgrdaten,p+1,pos(klgrdaten,trenner,p+1)-1));IF falschesugrupgefundenTHEN 
+fehlerunbekanntesugrupgefundenFI ;putlinezz(f,text(t1,64)+"  "+text(ut)+text(
+vm)+text(nm)+" F"+zeilenende);p:=pos(klgrdaten,trenner,p+1)PER ;spiput(
+subtext(klgrdaten,p+1));IF falschesugrupgefundenTHEN 
+fehlerunbekanntesugrupgefundenFI ;putlinezz(f,text(t1,64)+"  "+text(ut)+text(
+vm)+text(nm)+" F"+zeilenende).schreiberaumgruppen:schreibergrkarten;
+schreiberkarten.schreibergrkarten:dbleer(dnrraumgruppen);IF NOT fehlerTHEN 
+zeile:="";inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",
+dnrraumgruppen+1,dnrraumgruppen+2,PROC raumgr)FI .schreiberkarten:mindeinraum
+:=FALSE ;fehler:=FALSE ;zeile:="";inittupel(dnrschluessel);statleseschleife(
+dnrschluessel,raumkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC raum);IF 
+NOT mindeinraumTHEN return(ruecksprung);standardmeldung(meldg6,"");LEAVE 
+schulisintegatransferELIF zeile<>""THEN erstellrestraeumeFI .
+erstellrestraeume:putlinezz(f,"REST"+text(zeile,64)+"  G"+zeilenende);IF 
+length(zeile)>64THEN zeile:=subtext(zeile,65);h:=length(zeile)DIV 64;FOR i
+FROM 1UPTO hREP schreibekartePER ;IF length(zeile)MOD 64>0THEN 
+schreibrestkarteFI FI .schreibekarte:putlinezz(f,"    "+subtext(zeile,(i-1)*
+64+1,i*64)+"  G"+zeilenende).schreibrestkarte:putlinezz(f,"    "+text(subtext
+(zeile,h*64+1),64)+"  G"+zeilenende).schreibeuvdaten:dbleer(
+dnrlehrveranstaltungen);IF fehlerTHEN fehlerkeineuvFI ;inittupel(
+dnrlehrveranstaltungen);statleseschleife(dnrlehrveranstaltungen,schj,schhj,
+dnrlehrveranstaltungen+1,dnrlehrveranstaltungen+2,PROC lvschreiben);IF 
+falschesugrupgefundenTHEN fehlerunbekanntesugrupgefundenFI .fehlerkeineuv:
+return(ruecksprung);standardmeldung(meldg11,"");LEAVE schulisintegatransfer.
+fehlerunbekanntesugrupgefunden:return(ruecksprung);standardmeldung(meldg21,
+par+ausgparam+letztepar+ausgparam);LEAVE schulisintegatransfer.
+schreibelehrerverfgbkt:toline(l,1);col(l,1);WHILE NOT eof(l)REP readrecord(l,
+record);putlinezz(f,record);down(l)PER .schreiberaumverfgbkt:dbleer(
+dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennraum+trenner
+)FI .schreibeklassenverfgbkt:toline(k,1);col(k,1);WHILE NOT eof(k)REP 
+readrecord(k,record);putlinezz(f,record);down(k)PER .schreibefachverfgbkt:
+dbleer(dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennfach+
+trenner)FI .schreibevorbelegungen:IF standardmaskenfeld(fldfix2)<>""THEN 
+dbleer(dnrzeitwuensche);IF NOT fehlerTHEN schreibverfkarten(trenner+kennkoppl
++trenner)FI ELIF standardmaskenfeld(fldfix1)<>""THEN kartenart:="N";
+uebertragdatendesstundenplansFI .gibfertigmeldungaus:forget(dszeitw);forget(
+dslverf);forget(dskverf);standardmeldung(meldg15,dateiname+"#"+text(zz)+"#");
+return(ruecksprung).END PROC schulisintegatransfer;PROC 
+uebertragdatendesstundenplans:TEXT VAR kopplungenderzeit:="",aktkopplung;INT 
+VAR aktpos;bearbkopplungen:="";FOR iFROM erstestdeUPTO maxstdenREP 
+standardmeldung(meldungbearbwird,integatagstd(i)+ausgparam);kopplungenderzeit
+:=datenderzeit(i,kennkoppl);aktpos:=1;WHILE aktpos<length(kopplungenderzeit)
+REP aktkopplung:=subtext(kopplungenderzeit,aktpos,aktpos+7);IF 
+nichtbearbeitet(aktkopplung)THEN schreibvorbelegung(aktkopplung,allezeitenvon
+(kennkoppl,aktkopplung))FI ;aktposINCR 8PER ;pruefdateigroessePER .
+pruefdateigroesse:IF zz>eumelgrenzemaxzeilenTHEN standardmeldung(meldg14,"");
+return(ruecksprung);LEAVE uebertragdatendesstundenplansFI .END PROC 
+uebertragdatendesstundenplans;PROC schreibvorbelegung(TEXT CONST kopplung,
+allezeiten):INT VAR suchpos:=1,aktpos:=0;TEXT VAR kartenanfang:=text(kopplung
+,8),karte:="";kartenanfangCAT " ";WHILE pos(allezeiten,"1",suchpos)<>0REP 
+aktpos:=pos(allezeiten,"1",suchpos);IF aktpos>0THEN karteCAT integatagstd(
+aktpos);suchpos:=aktpos+1FI ;IF length(karte)=40THEN schreibkarte;
+kartenanfang:="         ";karte:=""FI PER ;IF length(karte)<>40THEN 
+schreibkarteFI .schreibkarte:objektverf:=kartenanfang+text(karte,61)+
+kartenart+zeilenende;putlinezz(f,objektverf).END PROC schreibvorbelegung;
+BOOL PROC nichtbearbeitet(TEXT CONST kopplung):INT VAR aktpos,suchab:=1;
+WHILE pos(bearbkopplungen,kopplung,suchab)<>0REP aktpos:=pos(bearbkopplungen,
+kopplung,suchab);IF aktposMOD 8=1THEN LEAVE nichtbearbeitetWITH FALSE ELSE 
+suchab:=aktpos+1FI ;PER ;bearbkopplungenCAT kopplung;TRUE END PROC 
+nichtbearbeitet;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN 
+standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(
+meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen
+,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6
+THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;PROC schreibverfkarten(TEXT CONST kennung):TEXT 
+VAR objekt:="";toline(z,1);col(z,1);REP col(z,col(z)+1);downety(z,kennung)
+UNTIL eof(z)COR (col(z)=142)PER ;IF kennung=trenner+kennraum+trennerTHEN 
+kartenart:="K"ELIF kennung=trenner+kennfach+trennerTHEN kartenart:="M"ELSE 
+kartenart:="N"FI ;IF NOT eof(z)CAND (kartenart<>"N")THEN REP readrecord(z,
+record);IF pos(record,kennung)<>142THEN LEAVE schreibverfkartenFI ;bestwunsch
+:=subtext(record,10,141);objekt:=holedatum(record,kennung);
+uebertragbestwunschinverfkarte(objektverf);objektverf:=text(objekt,4)+
+objektverf+kartenart+zeilenende;putlinezz(f,objektverf);down(z)PER ELIF NOT 
+eof(z)THEN REP readrecord(z,record);IF pos(record,kennung)<>142THEN LEAVE 
+schreibverfkartenFI ;bestwunsch:=subtext(record,10,141);IF bestwunsch<>
+leererbestwunschTHEN objekt:=holedatum(record,kennung);
+uebertragbestwunschinvorbelegung(objekt)FI ;down(z)PER FI .END PROC 
+schreibverfkarten;PROC uebertragbestwunschinvorbelegung(TEXT CONST kopplung):
+INT VAR suchpos:=1,aktpos:=0;TEXT VAR kartenanfang:=text(kopplung,8),karte:=
+"";kartenanfangCAT " ";WHILE pos(bestwunsch,"+3",suchpos)<>0REP aktpos:=pos(
+bestwunsch,"+3",suchpos);IF aktpos>0THEN karteCAT integatagstd((aktpos+1)DIV 
+2);suchpos:=aktpos+1FI ;IF length(karte)=40THEN schreibkarte;kartenanfang:=
+"         ";karte:=""FI PER ;IF karte<>""THEN schreibkarteFI .schreibkarte:
+objektverf:=kartenanfang+text(karte,61)+kartenart+zeilenende;putlinezz(f,
+objektverf).END PROC uebertragbestwunschinvorbelegung;TEXT PROC integatagstd(
+INT CONST intzeit):TEXT VAR std:="";INT VAR stdnr:=intzeit;std:=text((stdnr-1
+)MOD 12+1,2);SELECT (stdnr-1)DIV 12OF CASE 0:"MO"+stdCASE 1:"DI"+stdCASE 2:
+"MI"+stdCASE 3:"DO"+stdCASE 4:"FR"+stdCASE 5:"SA"+stdOTHERWISE "    "END 
+SELECT END PROC integatagstd;BOOL PROC falschercode(TEXT CONST t):INT VAR 
+zeichencode;FOR iFROM 1UPTO LENGTH t-3REP zeichencode:=code(tSUB i);IF NOT ((
+zeichencode>=48AND zeichencode<=57)OR (zeichencode>=65AND zeichencode<=90)OR 
+(zeichencode>=97AND zeichencode<=122))THEN LEAVE falschercodeWITH TRUE FI 
+PER ;FALSE END PROC falschercode;PROC zeitrasterzeilenerstellen(TEXT CONST 
+std,zeitanfang,zeitende):zeile:="";zeileCAT "ZEIT   ";zeileCAT std;zeileCAT 
+subtext(zeitanfang,LENGTH zeitanfang-3)+subtext(zeitende,LENGTH zeitende-3);
+zeileCAT "                                                     ";zeile:=text(
+zeile,70);zeileCAT "BB";zeileCAT zeilenende;putlinezz(f,zeile)END PROC 
+zeitrasterzeilenerstellen;PROC schulkennung(BOOL VAR b):IF wert(dnrschluessel
++1)>schulkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE schuldatenCAT wert(
+dnrschluessel+2)+trenner;schuldatenCAT wert(dnrschluessel+3)+trenner;FI END 
+PROC schulkennung;PROC zeitrasterdaten(BOOL VAR b):IF wert(dnrzeitraster+1)<>
+schjCOR wert(dnrzeitraster+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE 
+zeitdatenCAT wert(dnrzeitraster+3)+trenner;zeitdatenCAT " "+wert(
+dnrzeitraster+5)+trenner;zeitdatenCAT " "+wert(dnrzeitraster+6)+trenner;
+zeitdatenCAT wert(dnrzeitraster+4)+trenner;FI END PROC zeitrasterdaten;PROC 
+raumgr(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE schreibkarte;schreibraeume
+FI .schreibkarte:t2:=wert(dnrraumgruppen+2);putlinezz(f,text(wert(
+dnrraumgruppen+1),4)+text(t2,maxstden)+"G"+zeilenende).schreibraeume:FOR i
+FROM 1UPTO (LENGTH t2)DIV 4REP rgrdatenCAT compress(subtext(t2,i*4-3,i*4))+
+trennerPER .END PROC raumgr;PROC raum(BOOL VAR b):IF wert(dnrschluessel+1)>
+raumkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE mindeinraum:=TRUE ;IF pos(
+rgrdaten,trenner+wert(dnrschluessel+2)+trenner)<1THEN schreibrestraeumeFI ;
+FI .schreibrestraeume:zeileCAT text(wert(dnrschluessel+2),4).END PROC raum;
+PROC lvschreiben(BOOL VAR b):IF wert(dnrlehrveranstaltungen+1)<>schjCOR wert(
+dnrlehrveranstaltungen+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE schreibkarte
+FI .schreibkarte:zeile:="";zeileCAT text(wert(dnrlehrveranstaltungen+5),8)+
+text(wert(dnrlehrveranstaltungen+4),2)+"  "+text(wert(dnrlehrveranstaltungen+
+6),4)+subtext(" "+wert(dnrlehrveranstaltungen+7),length(" "+wert(
+dnrlehrveranstaltungen+7))-1)+"         ";FOR iFROM 8UPTO 11REP IF wert(
+dnrlehrveranstaltungen+i)=""CAND i=8THEN pruefrestlklgrELIF wert(
+dnrlehrveranstaltungen+i)=""CAND i<>8THEN zeileCAT "    "ELIF 
+istschuelergruppeTHEN zeileCAT text(substituiere,4)ELIF istklassengruppeTHEN 
+zeileCAT text(wert(dnrlehrveranstaltungen+i),4)ELIF istklassenstufeTHEN zeile
+CAT text(formatjgst(wert(dnrlehrveranstaltungen+i)),4)ELSE 
+falschesugrupgefunden:=TRUE ;par:=formatjgst(wert(dnrlehrveranstaltungen+3))+
+wert(dnrlehrveranstaltungen+4);letztepar:=wert(dnrlehrveranstaltungen+i);b:=
+TRUE ;LEAVE lvschreibenFI PER ;zeileCAT "         "+text(wert(
+dnrlehrveranstaltungen+12),4)+text(wert(dnrlehrveranstaltungen+13),4)+
+"          "+"H"+zeilenende;putlinezz(f,zeile).pruefrestlklgr:IF wert(
+dnrlehrveranstaltungen+9)=""CAND wert(dnrlehrveranstaltungen+10)=""CAND wert(
+dnrlehrveranstaltungen+11)=""THEN zeileCAT text(formatjgst(wert(
+dnrlehrveranstaltungen+3)),4)ELSE zeileCAT "    "FI .istschuelergruppe:pos(
+sgridaten,trenner+formatjgst(wert(dnrlehrveranstaltungen+3))+text(wert(
+dnrlehrveranstaltungen+i),4)+trenner)>0.istklassengruppe:pos(klgr,trenner+
+wert(dnrlehrveranstaltungen+i)+trenner)>0.istklassenstufe:intwert(
+dnrlehrveranstaltungen+i)>4CAND intwert(dnrlehrveranstaltungen+i)<14.
+substituiere:subst(text(jgst+wert(dnrlehrveranstaltungen+i),6)).jgst:
+formatjgst(wert(dnrlehrveranstaltungen+3)).END PROC lvschreiben;TEXT PROC 
+holedatum(TEXT VAR variable,TEXT CONST suchwort):IF pos(variable,suchwort)>0
+THEN subtext(variable,nachsuchwort,endezeichen)ELSE ""FI .nachsuchwort:pos(
+variable,suchwort)+LENGTH suchwort.endezeichen:pos(variable,trenner,
+nachsuchwort)-1.END PROC holedatum;PROC hole2daten(TEXT VAR variable,TEXT 
+CONST suchwort):IF pos(variable,suchwort)>0THEN t1:=subtext(variable,
+nachsuchwort,endezeichen);t2:=subtext(variable,endezeichen+2,
+naechstesendezeichen-1);ELSE t1:="";t2:=""FI .nachsuchwort:pos(variable,
+suchwort)+LENGTH suchwort.endezeichen:pos(variable,trenner,nachsuchwort)-1.
+naechstesendezeichen:pos(variable,trenner,endezeichen+2).END PROC hole2daten;
+PROC holedrittesdatum(TEXT VAR variable,TEXT CONST suchwort):INT VAR p:=pos(
+variable,suchwort),i;FOR iFROM 1UPTO 3REP p:=pos(variable,trenner,p+1);PER ;
+t1:=subtext(variable,p+1,pos(variable,trenner,p+1)-1)END PROC 
+holedrittesdatum;PROC spput(TEXT CONST t):TEXT VAR hohlstd:="0 ",
+weiterekarten:="",zeile:="",alleschgr,aktschgr;BOOL VAR jgstausgabe:=TRUE ;
+INT VAR anzschgrprozeile:=0;zeile:=text(t,4);alleschgr:=subtext(t,5);
+weiterekarten:="";FOR iFROM 1UPTO (length(t)-4)DIV 4REP objut:=ut;objvm:=vm;
+objnm:=nm;aktschgr:=subtext(alleschgr,(i-1)*4+1,i*4);suchezeitwunsch;
+schreibeintragPER ;IF anzschgrprozeileMOD 15<>0THEN eintragausgebenFI ;
+schreibschgrmitunbestwunsch.suchezeitwunsch:suchezeitw(trenner+kennsugrup+
+trenner+aktschgr+trenner);IF unbestwunsch<>""CAND unbestwunsch<>
+leererunbestwunschTHEN uebertragunbestwunschinkarte;IF objut<>utCOR objvm<>vm
+COR objnm<>nmTHEN weiterekartenCAT "    ";weiterekartenCAT aktschgr;
+weiterekartenCAT hohlstd;weiterekartenCAT text(objut);weiterekartenCAT text(
+objvm);weiterekartenCAT text(objnm)FI FI ;IF bestwunsch<>""CAND bestwunsch<>
+leererbestwunschTHEN uebertragbestwunschinverfkarte(objektverf);objektverf:=
+aktschgr+objektverf+"L"+zeilenende;putds(k,objektverf)FI .schreibeintrag:IF 
+keinwunschgefundenTHEN zeileCAT aktschgr;anzschgrprozeileINCR 1;IF 
+anzschgrprozeile=15THEN putlinezz(f,zeile+hohlstd+text(ut)+text(vm)+text(nm)+
+" D"+zeilenende);anzschgrprozeile:=0;jgstausgabe:=FALSE ;zeile:="    "FI FI .
+keinwunschgefunden:bestwunsch=""COR (objut=utCAND objvm=vmCAND objnm=nm).
+eintragausgeben:putlinezz(f,text(zeile,64)+hohlstd+text(ut)+text(vm)+text(nm)
++" D"+zeilenende);jgstausgabe:=FALSE .schreibschgrmitunbestwunsch:IF 
+weiterekarten<>""THEN FOR jFROM 1UPTO length(weiterekarten)DIV 13REP aktschgr
+:=subtext(weiterekarten,(j-1)*13+1,j*13);IF jgstausgabeTHEN putlinezz(f,zeile
++subtext(aktschgr,5,8)+
+"                                                        "+subtext(aktschgr,9
+)+" D"+zeilenende);jgstausgabe:=FALSE ELSE putlinezz(f,text(aktschgr,8)+
+"                                                        "+subtext(aktschgr,9
+)+" D"+zeilenende)FI ;PER ;FI .END PROC spput;PROC spiput(TEXT CONST t):t1:=
+text(t,4);FOR iFROM 1UPTO ((LENGTH t)-4)DIV 6REP IF subtext(t,i*6+1,i*6+4)=
+"    "THEN t1CAT subtext(t,i*6-1,i*6+2)ELSE t1CAT subst(subtext(t,i*6-1,i*6+4
+));IF falschesugrupgefundenTHEN par:=text(t,4);LEAVE spiputFI ;FI ;PER .END 
+PROC spiput;TEXT PROC subst(TEXT CONST t):IF pos(sgridaten,trenner+t+trenner)
+>0THEN subtext(sgridaten,pos(sgridaten,trenner+t+trenner)+8,pos(sgridaten,
+trenner+t+trenner)+11)ELSE letztepar:=t;falschesugrupgefunden:=TRUE ;""FI 
+END PROC subst;PROC lehrer(BOOL VAR b):lehrerdaten:="";objut:=ut;objvm:=vm;
+objnm:=nm;IF dbstatus<>0THEN b:=TRUE ELSE lehrerdatenCAT text(wert(dnrlehrer+
+2),20);par:=wert(dnrlehrer+1);lehrerdatenCAT text(wert(dnrlehrer+1),4)+
+"         ";lehrerdatenCAT subtext(" "+wert(dnrlehrer+7),length(" "+wert(
+dnrlehrer+7))-1);suchezeitw(trenner+kennpar+trenner+par+trenner);IF 
+bestwunsch<>""CAND bestwunsch<>leererbestwunschTHEN schreibverfuegkarteFI ;
+schreiblehrerkarteFI .schreibverfuegkarte:uebertragbestwunschinverfkarte(
+objektverf);objektverf:=text(par,4)+objektverf+"J"+zeilenende;putds(l,
+objektverf).schreiblehrerkarte:IF unbestwunsch<>""CAND unbestwunsch<>
+leererunbestwunschTHEN uebertragunbestwunschinkarteFI ;putlinezz(f,
+lehrerdaten+"   "+text(objut)+text(objvm)+text(objnm)+
+"                             C"+zeilenende).END PROC lehrer;PROC suchezeitw(
+TEXT CONST kennung):toline(z,1);col(z,1);downety(z,kennung);IF eof(z)THEN 
+bestwunsch:="";unbestwunsch:=""ELSE readrecord(z,record);unbestwunsch:=text(
+record,9);bestwunsch:=subtext(record,10,141)FI ;END PROC suchezeitw;PROC 
+zeitw(BOOL VAR b):IF wert(dnrzeitwuensche+1)<>schjCOR wert(dnrzeitwuensche+2)
+<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE zeitwuensche:="";zeitwuenscheCAT wert
+(dnrzeitwuensche+6);zeitwuenscheCAT wert(dnrzeitwuensche+5);zeitwuenscheCAT 
+trenner;zeitwuenscheCAT wert(dnrzeitwuensche+3);zeitwuenscheCAT trenner;IF 
+wert(dnrzeitwuensche+3)=kennsugrupTHEN zeitwuenscheCAT holedatum(sgridaten,
+trenner+text(wert(dnrzeitwuensche+4),6)+trenner);ELSE zeitwuenscheCAT wert(
+dnrzeitwuensche+4);FI ;zeitwuenscheCAT trenner;putds(z,zeitwuensche)FI END 
+PROC zeitw;PROC uebertragbestwunschinverfkarte(TEXT VAR verf):INT VAR suchpos
+:=1,aktpos:=0;verf:=schulverfuegbarkeit;WHILE pos(bestwunsch,"-3",suchpos)<>0
+REP aktpos:=pos(bestwunsch,"-3",suchpos);IF aktpos>0THEN replace(verf,(aktpos
++1)DIV 2,"1");suchpos:=aktpos+1FI PER END PROC uebertragbestwunschinverfkarte
+;PROC uebertragunbestwunschinkarte:INT VAR tageswunsch:=0;IF (unbestwunsch
+SUB 3)="3"THEN tageswunsch:=int(unbestwunschSUB 1);objutDECR tageswunsch;
+objvmDECR tageswunsch;objnmDECR tageswunsch-1FI ;IF (unbestwunschSUB 6)="3"
+THEN objvmDECR int(unbestwunschSUB 4)FI ;IF (unbestwunschSUB 9)="3"THEN objnm
+DECR int(unbestwunschSUB 7)FI ;END PROC uebertragunbestwunschinkarte;PROC 
+sgrdatenholen(BOOL VAR b):IF wert(dnraktschuelergruppen+1)<>schjCOR wert(
+dnraktschuelergruppen+2)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE IF wert(
+dnraktschuelergruppen+3)<>letzteparTHEN zeile:=formatjgst(wert(
+dnraktschuelergruppen+3));sgrdatenCAT trenner+text(zeile,4);letztepar:=wert(
+dnraktschuelergruppen+3)FI ;sgrdatenCAT text(wert(dnraktschuelergruppen+7),4)
+FI ;END PROC sgrdatenholen;PROC klgrdatenholen(BOOL VAR b):IF dbstatus<>0
+THEN b:=TRUE ELSE klgrdatenCAT trenner+text(wert(dnrklassengruppen+1),4);klgr
+CAT wert(dnrklassengruppen+1)+trenner;klgrdatenCAT wert(dnrklassengruppen+2)
+FI END PROC klgrdatenholen;PROC sgridatenholen(BOOL VAR b):IF wert(
+dnraktschuelergruppen+1)<>schjCOR wert(dnraktschuelergruppen+2)<>schhjCOR 
+dbstatus<>0THEN b:=TRUE ELSE sgridatenCAT trenner+jgstaufber(wert(
+dnraktschuelergruppen+3));sgridatenCAT text(wert(dnraktschuelergruppen+4),4)+
+trenner;sgridatenCAT text(wert(dnraktschuelergruppen+7),4);IF wert(
+dnraktschuelergruppen+7)=""THEN datenfehler:=TRUE FI FI ;END PROC 
+sgridatenholen;PROC putds(FILE VAR file,TEXT CONST t):writerecord(file,t);
+down(file);insertrecord(file)END PROC putds;PROC dbleer(INT CONST dateinr):
+fehler:=FALSE ;IF records(dateinr)<1.0THEN fehler:=TRUE FI END PROC dbleer;
+PROC melde(TEXT CONST meldungsergaenzung):standardmeldung(meldg1,
+meldungsergaenzung+"#")END PROC melde;PROC putlinezz(FILE VAR f,TEXT CONST t)
+:putline(f,t);IF zz>2999THEN abbruchwegen4000zeilen:=TRUE ELSE zzINCR 1FI 
+END PROC putlinezz;TEXT PROC formatjgst(TEXT CONST jgst):IF int(jgst)=0THEN 
+LEAVE formatjgstWITH "00"ELIF int(jgst)<10THEN LEAVE formatjgstWITH 
+jgstaufber(jgst)FI ;jgstEND PROC formatjgst;END PACKET 
+datenfuerintegaaufbereiten;
+
diff --git a/app/schulis/2.2.1/src/4.daten für schulis aufbereiten b/app/schulis/2.2.1/src/4.daten für schulis aufbereiten
new file mode 100644
index 0000000..89c96ea
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.daten für schulis aufbereiten
@@ -0,0 +1,184 @@
+PACKET integastundenplanuebernehmenDEFINES integastundenplanarchivlisten,
+integastundenplanstdvproc,integastundenplanuebernehmen,
+integastundenplandatenschreiben:LET integadatei="SCHULIS.PUN",filemodus=
+"file ibm",dos="DOS",anzstdenprotag=12,schulname="Schulname",schulort=
+"Schulort",schuljahr="Schuljahr",halbjahr="Schulhalbjahr",maskeeingang=
+"ms stdplan von intega uebernehmen",listenname=
+"Liste der Dateien auf der Diskette:",protokollname=
+"Stundenplan von INTEGA übernehmen",leerzeile=" ",ueberschrift=
+"   Fehlerprotokoll zur Übernahme des Stundenplans ",unterstrich=
+"   ------------------------------------------------------------------",
+fehler1kopf="1. Kopplung existiert in schulis nicht für:",fehler2kopf=
+"2. Lehrveranstaltung kann nicht identifiziert werden für:",fehler3kopf1=
+"3. Kopplung und Paraphe passen in schulis auf Lehrveranstaltung, aber",
+fehler3kopf2="   Fach stimmt nicht überein für:",fehler4kopf=
+"4. In INTEGA wurden Zeiten verplant, die in schulis gesperrt sind für:",
+fehlerspalten1=
+"            Kopplung Fach Lehrer Klassengruppen          Zeit  Raum",
+fehlerspalten2="   schulis  INTEGA ",fehlerspalten3=
+"   Lehrver. Kopplung Fach Lehrer Klassengruppen          Zeit  Raum",
+spalten3fueller="                                                         ",
+keinfehler="        Kein Fehler dieser Art aufgetreten!",tab1=
+"  +--------+--------+----+------+-----------------------+-----+----+",tab2=
+"           +--------+----+------+-----------------------+-----+----+",
+feldakthj=2,laengelvkopp=8,laengeindex=4,laengezeitraum=6,beginnkopp=1,
+endekopp=8,beginnfach=9,endefach=12,beginnlvfach=3,endelvfach=4,beginnpar=13,
+endepar=16,beginnklgr=19,endeklgr=42,beginnbelegg=43,fachergaenzung="  ",
+leereraumangabe="    ",leerelv="        ",pseudoraum="PSEU",ausgabeparam="#",
+frageraum="????",kennungkopplung="K",kennungparaphe="P",kennungzulzeit="ZZ",
+kennungmo="Mo ",kennungdi="Di ",kennungmi="Mi ",kennungdo="Do ",kennungfr=
+"Fr ",kennungsa="Sa ",meldungserverfehler=376,meldungkeinstdplan=366,
+meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326,
+meldungzuvielelv=358,meldungstdplanveraltet=377,meldungbasisinkon=378,
+meldwarten=69,melddatenaufber=357,melduebern=374,meldueberschr=372,
+meldaenderungenunvollstaendig=364,meldprotokollaufbereiten=373,
+meldstandderuebern=375,meldarchivfehler=343;FILE VAR g,protokoll,
+integastdplandatei;THESAURUS VAR thes;TEXT VAR gewsj,gewhj,t,integaeintrag,lv
+,leistekoppexistnicht,leistelvnichtident,leistelvfalschesfach,leisteunzzeit,
+integakopplung,integafach,integaparaphe,integabelegg,zeitraumeintrag,
+zeitderlv,raumderlv,stdplaneintrag;INT VAR fstat,i,posanf,posende,
+intzeitderlv;BOOL VAR archivfehler:=FALSE ,transferfehler:=FALSE ,eintragok;
+PROC archivanmelden(INT CONST ruecksprung):archivfehler:=FALSE ;
+commanddialogue(FALSE );disablestop;reserve(filemodus,/dos);IF iserrorTHEN 
+archivfehler:=TRUE ;abbruchnachfehler(ruecksprung);LEAVE archivanmeldenFI ;
+enablestopEND PROC archivanmelden;PROC integastundenplanarchivlisten:
+standardmeldung(meldwarten," ");archivanmelden(1);IF archivfehlerTHEN LEAVE 
+integastundenplanarchivlistenFI ;disablestop;forget(listenname,quiet);thes:=
+ALL (/dos);IF iserrorTHEN archivfehler:=TRUE ;abbruchnachfehler(1);ELSE 
+release(/dos);thesaurusaufbereiten;enablestop;zeigedatei(listenname,"vr")FI .
+thesaurusaufbereiten:g:=sequentialfile(output,listenname);t:=" ";i:=0;REP get
+(thes,t,i);putline(g,t)UNTIL t=""PER .END PROC integastundenplanarchivlisten;
+PROC integastundenplanstdvproc:standardstartproc(maskeeingang);IF 
+transferfehlerTHEN standardmeldung(meldaenderungenunvollstaendig,"")FI ;
+transferfehler:=FALSE ;infeld(2);standardnprocEND PROC 
+integastundenplanstdvproc;PROC integastundenplanuebernehmen:standardmeldung(
+meldwarten,"");gewsj:=schulkenndatum(schuljahr);gewhj:=schulkenndatum(
+halbjahr);IF standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen(
+gewhj,gewsj)FI ;stundenplanhalbjahrsetzen(gewhj,gewsj);standardmeldung(
+melddatenaufber,"");stundenplanbasisundstundenplanholen(fstat);IF fstat<>0
+CAND fstat<>8THEN standardmeldung(melduebern,"")ELSE standardmeldung(
+meldueberschr,"")FI ;standardnproc.END PROC integastundenplanuebernehmen;
+PROC integastundenplandatenschreiben:TEXT VAR alteerstellungszeit:="";IF 
+fstat<>0CAND fstat<>8THEN standardmeldung(meldwarten,"");
+stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(2);
+meldungausgeben(fstat);LEAVE integastundenplandatenschreibenELSE 
+stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN 
+return(2);meldungausgeben(fstat);LEAVE integastundenplandatenschreibenFI ;FI 
+;FI ;alteerstellungszeit:=erstellungszeitderdatenraeume;stundenplanloeschen(
+fstat);stundenplanerstellen(alteerstellungszeit,fstat);datenvonarchivholen(2)
+;IF archivfehlerTHEN LEAVE integastundenplandatenschreibenFI ;
+dateninstdplanschreibenEND PROC integastundenplandatenschreiben;PROC 
+datenvonarchivholen(INT CONST ruecksprung):standardmeldung(meldwarten," ");
+archivanmelden(ruecksprung);IF archivfehlerTHEN LEAVE datenvonarchivholenFI ;
+disablestop;fetch(integadatei,/dos);IF iserrorTHEN archivfehler:=TRUE ;
+abbruchnachfehler(ruecksprung);ELSE release(/dos);enablestop;commanddialogue(
+TRUE );FI END PROC datenvonarchivholen;PROC dateninstdplanschreiben:INT VAR 
+zeilennr:=0;TEXT VAR anzzeilen;BOOL VAR lvnichtvermerkt:=TRUE ;
+fehlerprotvorbereiten;datenraumankoppeln;WHILE NOT eof(integastdplandatei)
+REP zeilennrINCR 1;getline(integastdplandatei,integaeintrag);standardmeldung(
+meldstandderuebern,anzzeilen+ausgabeparam+text(zeilennr)+ausgabeparam);
+stundenplaneintraegevornehmenPER ;IF leisteunzzeit<>""COR 
+leistekoppexistnicht<>""COR leistelvnichtident<>""COR leistelvfalschesfach<>
+""THEN sicherstdplan;standardmeldung(meldprotokollaufbereiten," ");forget(
+protokollname,quiet);protokoll:=sequentialfile(output,protokollname);
+fuelleprotokoll;infeld(1);standardfelderausgeben;infeld(2);zeigedatei(
+protokollname,"vr")ELSE sicherstdplan;infeld(1);standardfelderausgeben;infeld
+(2);return(2)FI .sicherstdplan:stundenplanreorganisierenundsichern(fstat);IF 
+fstat<>0THEN transferfehler:=TRUE FI .fehlerprotvorbereiten:leisteunzzeit:=""
+;leistekoppexistnicht:="";leistelvnichtident:="";leistelvfalschesfach:="".
+datenraumankoppeln:integastdplandatei:=sequentialfile(input,integadatei);
+anzzeilen:=text(lines(integastdplandatei)).stundenplaneintraegevornehmen:
+integakopplung:=text(integaeintrag,laengelvkopp);integafach:=subtext(
+integaeintrag,beginnfach,endefach);integaparaphe:=subtext(integaeintrag,
+beginnpar,endepar);integabelegg:=subtext(integaeintrag,beginnbelegg);t:=
+allelvmit(kennungkopplung,integakopplung);IF t=""THEN leistekoppexistnicht
+CAT text(zeilennr,laengeindex)ELSE IF lvmitgleicherparaphe(t)THEN pruefefach
+ELSE leistelvnichtidentCAT text(zeilennr,laengeindex)FI FI .pruefefach:IF 
+integafach<>subtext(lv,beginnlvfach,endelvfach)+fachergaenzungTHEN 
+leistelvfalschesfachCAT text(zeilennr,laengeindex);leistelvfalschesfachCAT 
+text(lv,laengelvkopp)ELSE tragstundeneinundpruefezeitenFI .
+tragstundeneinundpruefezeiten:stdplaneintrag:=lv+integakopplung+integaparaphe
+;posanf:=1;posende:=length(integabelegg);lvnichtvermerkt:=TRUE ;WHILE posanf<
+posendeREP zeitraumeintrag:=subtext(integabelegg,posanf,posanf+laengezeitraum
+-1);zeitderlv:=text(zeitraumeintrag,2);intzeitderlv:=int(zeitderlv);raumderlv
+:=compress(subtext(zeitraumeintrag,3));IF raumderlv=""COR raumderlv=
+pseudoraumCOR raumderlv=frageraumTHEN raumderlv:=leereraumangabeFI ;IF NOT 
+bezeichnungzulaessig(kennungzulzeit,zeitderlv)THEN IF lvnichtvermerktTHEN 
+leisteunzzeitCAT text(zeilennr,laengeindex);leisteunzzeitCAT text(lv,
+laengelvkopp);lvnichtvermerkt:=FALSE FI ELSE planeintragvornehmen(
+intzeitderlv,lv,raumderlv,eintragok);IF NOT eintragokTHEN transferfehler:=
+TRUE FI ;FI ;posanfINCR laengezeitraumPER .fuelleprotokoll:putline(protokoll,
+schulkenndatum(schulname));putline(protokoll,text(schulkenndatum(schulort),65
+)+date);putline(protokoll,leerzeile);putline(protokoll,ueberschrift+gewhj+
+". "+text(gewsj,2)+"/"+subtext(gewsj,3)+" von INTEGA");putline(protokoll,
+unterstrich);putline(protokoll,leerzeile);putline(protokoll,fehler1kopf);
+putline(protokoll,leerzeile);IF leistekoppexistnicht=""THEN putline(protokoll
+,keinfehler)ELSE putline(protokoll,fehlerspalten1);putline(protokoll,tab2);
+gibfalschekopplungenausFI ;putline(protokoll,leerzeile);putline(protokoll,
+fehler2kopf);putline(protokoll,leerzeile);IF leistelvnichtident=""THEN 
+putline(protokoll,keinfehler)ELSE putline(protokoll,fehlerspalten1);putline(
+protokoll,tab2);gibfalschelvausFI ;putline(protokoll,leerzeile);putline(
+protokoll,fehler3kopf1);putline(protokoll,fehler3kopf2);putline(protokoll,
+leerzeile);IF leistelvnichtident=""THEN putline(protokoll,keinfehler)ELSE 
+putline(protokoll,fehlerspalten2);putline(protokoll,fehlerspalten3);putline(
+protokoll,tab1);gibnichtidentlvausFI ;putline(protokoll,leerzeile);putline(
+protokoll,fehler4kopf);putline(protokoll,leerzeile);IF leisteunzzeit=""THEN 
+putline(protokoll,keinfehler)ELSE putline(protokoll,fehlerspalten3);putline(
+protokoll,tab1);gibfalschezeitenausFI .gibfalschezeitenaus:gibleisteaus(
+leisteunzzeit,FALSE ,FALSE ).gibfalschekopplungenaus:gibleisteaus(
+leistekoppexistnicht,TRUE ,TRUE ).gibfalschelvaus:gibleisteaus(
+leistelvnichtident,TRUE ,TRUE ).gibnichtidentlvaus:gibleisteaus(
+leistelvfalschesfach,FALSE ,TRUE ).END PROC dateninstdplanschreiben;PROC 
+gibleisteaus(TEXT CONST leiste,BOOL CONST ohnelv,allezeiten):INT VAR 
+posanfleiste,posendeleiste,posanflv,posanfbelegg,posendebelegg;BOOL VAR 
+erstezeilederlv:=TRUE ;posanfleiste:=1;posendeleiste:=length(leiste);modify(
+integastdplandatei);WHILE posanfleiste<posendeleisteREP col(
+integastdplandatei,1);toline(integastdplandatei,int(subtext(leiste,
+posanfleiste,posanfleiste+laengeindex-1)));readrecord(integastdplandatei,
+integaeintrag);integabelegg:=subtext(integaeintrag,beginnbelegg);IF ohnelv
+THEN lv:=leerelv;posanfleisteINCR laengeindexELSE posanflv:=posanfleiste+
+laengeindex;lv:=subtext(leiste,posanflv,posanflv+laengelvkopp-1);posanfleiste
+INCR laengeindex+laengelvkoppFI ;posanfbelegg:=1;posendebelegg:=length(
+integabelegg);zeitraumeintrag:=subtext(integabelegg,posanfbelegg,posanfbelegg
++laengezeitraum-1);zeitderlv:=text(zeitraumeintrag,2);intzeitderlv:=int(
+zeitderlv);raumderlv:=subtext(zeitraumeintrag,3);IF raumderlv=""COR raumderlv
+=pseudoraumCOR raumderlv=frageraumTHEN raumderlv:=leereraumangabeFI ;IF 
+allezeitenTHEN putline(protokoll,"   "+lv+" "+subtext(integaeintrag,
+beginnkopp,endekopp)+" "+subtext(integaeintrag,beginnfach,endefach)+" "+
+subtext(integaeintrag,beginnpar,endepar)+"   "+subtext(integaeintrag,
+beginnklgr,endeklgr)+gibtagstd(intzeitderlv)+" "+raumderlv);posanfbeleggINCR 
+laengezeitraum;WHILE posanfbelegg<posendebeleggREP zeitraumeintrag:=subtext(
+integabelegg,posanfbelegg,posanfbelegg+laengezeitraum-1);zeitderlv:=text(
+zeitraumeintrag,2);intzeitderlv:=int(zeitderlv);putline(protokoll,
+spalten3fueller+gibtagstd(intzeitderlv)+" "+raumderlv);posanfbeleggINCR 
+laengezeitraumPER ELSE erstezeilederlv:=TRUE ;WHILE posanfbelegg<
+posendebeleggREP zeitraumeintrag:=subtext(integabelegg,posanfbelegg,
+posanfbelegg+laengezeitraum-1);zeitderlv:=text(zeitraumeintrag,2);IF NOT 
+bezeichnungzulaessig(kennungzulzeit,zeitderlv)THEN intzeitderlv:=int(
+zeitderlv);IF erstezeilederlvTHEN putline(protokoll,"   "+lv+" "+subtext(
+integaeintrag,beginnkopp,endekopp)+" "+subtext(integaeintrag,beginnfach,
+endefach)+" "+subtext(integaeintrag,beginnpar,endepar)+"   "+subtext(
+integaeintrag,beginnklgr,endeklgr)+gibtagstd(intzeitderlv)+" "+raumderlv);
+erstezeilederlv:=FALSE ELSE putline(protokoll,spalten3fueller+gibtagstd(
+intzeitderlv)+" "+raumderlv);FI ;FI ;posanfbeleggINCR laengezeitraum;PER FI 
+PER .END PROC gibleisteaus;BOOL PROC lvmitgleicherparaphe(TEXT CONST 
+allelvderkopp):posanf:=1;posende:=length(allelvderkopp);WHILE posanf<posende
+REP lv:=subtext(allelvderkopp,posanf,posanf+laengelvkopp-1);IF datenzurlv(
+kennungparaphe,lv)=integaparapheTHEN LEAVE lvmitgleicherparapheWITH TRUE FI ;
+posanfINCR laengelvkoppPER ;FALSE .END PROC lvmitgleicherparaphe;PROC 
+abbruchnachfehler(INT CONST ruecksprung):return(ruecksprung);standardmeldung(
+meldarchivfehler,"Fehler: "+errormessage+" !#");clearerror;release(/dos);
+commanddialogue(TRUE );enablestopEND PROC abbruchnachfehler;PROC 
+meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung(
+meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan,
+"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5
+THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN 
+standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;TEXT PROC gibtagstd(INT CONST index):INT VAR 
+intstd:=(index-1)MOD anzstdenprotag+1;TEXT VAR std:="0";IF intstd<10THEN std
+CAT text(intstd)ELSE std:=text(intstd)FI ;SELECT (index-1)DIV anzstdenprotag
+OF CASE 0:kennungmo+stdCASE 1:kennungdi+stdCASE 2:kennungmi+stdCASE 3:
+kennungdo+stdCASE 4:kennungfr+stdCASE 5:kennungsa+stdOTHERWISE stdEND SELECT 
+END PROC gibtagstd;END PACKET integastundenplanuebernehmen;
+
diff --git a/app/schulis/2.2.1/src/4.einhaltung zeitwuensche pruefen b/app/schulis/2.2.1/src/4.einhaltung zeitwuensche pruefen
new file mode 100644
index 0000000..6e953d3
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.einhaltung zeitwuensche pruefen
@@ -0,0 +1,195 @@
+PACKET einhaltungzeitwuenschepruefenDEFINES zeitwuenschepruefenausfuehren:
+LET dateiname="Liste zur Einhaltung der Zeitwünsche",trenner="198",
+letztestunde=66,fldlehrer=2,fldsugrup=3,fldraeume=4,fldfaecher=5,
+fldkopplungen=6,fldakthalbj=7,meldungwarten=69,meldungbearbwird=352,#
+meldungkeinelehrer=337,meldungkeineraeume=365,#meldungkeinefaecher=68,
+meldungkeinzeitraster=336,meldungkeinezeitwuensche=389,meldungserverfehler=
+376,meldungkeinstdplan=366,meldungkeinesugruppen=334,meldungzuvielesugruppen=
+356,meldungkeinelv=326,meldungzuvielelv=358,meldungbasisinkon=378,
+meldungstdplauswvorber=384,posanzut=1,posgewut=3,posanzvm=4,posgewvm=6,
+posanznm=7,posgewnm=9,ausgfreipos=2,ausganzpos=11,ausggewpos=18,ausgnerfpos=
+27,ausgabeparam="#",ausgnerf="*",minus="-",plus="+",leerzeile=" ",kennzlehrer
+="P",kennzsugrup="S",kennzraeume="R",kennzfaecher="F",kennzlv="L",kennzkoppl=
+"K",moeintrag="Mo  ",dieintrag="Di  ",mieintrag="Mi  ",doeintrag="Do  ",
+freintrag="Fr  ",saeintrag="Sa  ",anhangl="Lehrer ",anhangs="Schülergruppen "
+,anhangr="Räume ",anhangf="Fächer ",anhangk="Kopplungen ",ueberschrift=
+"Liste zur Einhaltung der Zeitwünsche für ",unterstrich=
+"-------------------------------------------------",leererunbestwunsch=
+"         ",kennungvorm="v",kennungnachm="n",schuljahr="Schuljahr",
+schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort",
+anzgewichte=6,anzunterrichtstage=6,anzvormittage=6,anznachmittage=5,
+anzsamstagstunden=6,anzunterrichtsstunden=12;FILE VAR datei;INT VAR hjkennneu
+:=0,hjkennalt:=-1;INT VAR i,j,fstat,fall,anztage,anzvorm,anznachm;TEXT VAR 
+schj,schhj,kenn,plan:="",anhang,faecherkatalog:=trenner;TEXT VAR bestwzeile,
+unbestwtage,unbestwvorm,unbestwnachm,bestwurzeile:=
+" _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _"+
+"   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _  "+
+" _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   "+
+"_   _   _   _   _   _   _   _   _   _   _   _   _   _   _ ";TEXT VAR 
+moobjeintrag,diobjeintrag,miobjeintrag,doobjeintrag,frobjeintrag,saobjeintrag
+;BOOL VAR keinezeitwuensche:=TRUE ;ROW 4ROW anzgewichteINT VAR 
+anzwuenschegesamt;ROW 4ROW anzgewichteINT VAR anznerfwuensche;PROC 
+zeitwuenschepruefenausfuehren:keinezeitwuensche:=TRUE ;kenn:="";
+standardmeldung(meldungwarten,"");pruefeeingangsmaske;pruefehalbjahr;
+zeitwuenschevorhanden;IF halbjahrveraendertTHEN hjkennalt:=hjkennneu;
+holestundenplan;erstellezeitrasterFI ;erstelleliste;IF keinezeitwuenscheTHEN 
+fehlerkeinezeitwuenscheELSE zeigedatei(dateiname,"vr")FI .halbjahrveraendert:
+hjkennneu<>hjkennalt.pruefeeingangsmaske:standardpruefe(5,2,6,0,"",fstat);IF 
+fstat<>0THEN infeld(fstat);return(1);LEAVE zeitwuenschepruefenausfuehrenELIF 
+standardmaskenfeld(fldlehrer)<>""THEN fall:=fldlehrer;anhang:=anhangl;kenn:=
+kennzlehrerELIF standardmaskenfeld(fldsugrup)<>""THEN fall:=fldsugrup;anhang
+:=anhangs;kenn:=kennzsugrupELIF standardmaskenfeld(fldraeume)<>""THEN fall:=
+fldraeume;anhang:=anhangr;kenn:=kennzraeume;pruefefaecherELIF 
+standardmaskenfeld(fldfaecher)<>""THEN fall:=fldfaecher;anhang:=anhangf;kenn
+:=kennzfaecher;IF faecherkatalog=trennerTHEN holallefaecherFI ;ELIF 
+standardmaskenfeld(fldkopplungen)<>""THEN fall:=fldkopplungen;anhang:=anhangk
+;kenn:=kennzkopplFI .holallefaecher:inittupel(dnrfaecher);statleseschleife(
+dnrfaecher,"","",fnrffach,fnrffach,PROC faecher).pruefefaecher:IF records(
+dnrfaecher)=0.0THEN fehlerkeinefaecherFI .pruefehalbjahr:schj:=schulkenndatum
+(schuljahr);schhj:=schulkenndatum(schulhalbjahr);IF standardmaskenfeld(
+fldakthalbj)=""THEN geplanteshjundsjberechnen(schhj,schj);hjkennneu:=1ELSE 
+hjkennneu:=0FI .holestundenplan:standardmeldung(meldungstdplauswvorber,"");
+stundenplanhalbjahrsetzen(schhj,schj);stundenplanbasisundstundenplanholen(
+fstat);IF fstat<>0CAND fstat<>8THEN meldungausgeben(fstat);return(1);LEAVE 
+zeitwuenschepruefenausfuehrenFI .erstellezeitraster:plan:="";IF records(
+dnrzeitraster)=0.0THEN fehlerzeitrasternichtvollstdELSE inittupel(
+dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,fnrzrsj,fnrzrhj,
+PROC zeitrasterdaten)FI ;IF length(plan)<letztestundeTHEN 
+fehlerzeitrasternichtvollstdFI .zeitwuenschevorhanden:IF records(
+dnrzeitwuensche)=0.0THEN fehlerkeinezeitwuenscheFI .
+fehlerzeitrasternichtvollstd:standardmeldung(meldungkeinzeitraster,"");return
+(1);LEAVE zeitwuenschepruefenausfuehren.fehlerkeinefaecher:standardmeldung(
+meldungkeinefaecher,"");return(1);LEAVE zeitwuenschepruefenausfuehren.
+fehlerkeinezeitwuensche:standardmeldung(meldungkeinezeitwuensche,"");return(1
+);LEAVE zeitwuenschepruefenausfuehren.END PROC zeitwuenschepruefenausfuehren;
+PROC erstelleliste:bereitedateiauf;initialisiererow;inittupel(dnrzeitwuensche
+);putwert(fnrzwbezug,kenn);statleseschleife(dnrzeitwuensche,schj,schhj,
+fnrzwsj,fnrzwhj,PROC zeitwuenschelisten);bereitestatistikauf.bereitedateiauf:
+forget(dateiname,quiet);datei:=sequentialfile(output,dateiname);putline(datei
+,schulkenndatum(schulname));putline(datei,text(schulkenndatum(schulort),65)+
+date);putline(datei,leerzeile);putline(datei,ueberschrift+anhang+schhj+". "+
+text(schj,2)+"/"+subtext(schj,3));putline(datei,unterstrich+length(anhang)*
+"-");putline(datei,leerzeile).initialisiererow:FOR iFROM 1UPTO 4REP FOR j
+FROM 1UPTO anzgewichteREP anzwuenschegesamt(i)(j):=0;anznerfwuensche(i)(j):=0
+PER ;PER .bereitestatistikauf:putline(datei,"#page#");putline(datei,
+"Endstatistik:");putline(datei,leerzeile);putline(datei,leerzeile);
+gibwerteaus("  Stunden    ",1);gibwerteaus("  ganze Tage ",2);gibwerteaus(
+"  Vormittage ",3);gibwerteaus("  Nachmittage",4).END PROC erstelleliste;
+PROC gibwerteaus(TEXT CONST objekt,INT CONST row):putline(datei,
+"Anzahl         Gewichte                            Summe ");putline(datei,
+objekt+"  -3    -2    -1    +1    +2    +3          ");putline(datei,
+"--------------+-----+-----+-----+-----+-----+-----+------");putline(datei,
+"gesamt       "+werte(row,TRUE ));putline(datei,"erfüllt      "+erfuelltwerte
+(row));putline(datei,"nicht erfüllt"+werte(row,FALSE ));putline(datei,
+leerzeile);putline(datei,leerzeile).END PROC gibwerteaus;TEXT PROC werte(INT 
+CONST row,BOOL CONST allewerte):TEXT VAR ausgabe:="";INT VAR summe:=0,eintrag
+;IF allewerteTHEN FOR iFROM 1UPTO anzgewichteREP eintrag:=anzwuenschegesamt(
+row)(i);summeINCR eintrag;ausgabeCAT text(eintrag,6)PER ELSE FOR iFROM 1UPTO 
+anzgewichteREP eintrag:=anznerfwuensche(row)(i);summeINCR eintrag;ausgabeCAT 
+text(eintrag,6)PER FI ;ausgabeCAT text(summe,6);ausgabeEND PROC werte;TEXT 
+PROC erfuelltwerte(INT CONST row):TEXT VAR ausgabe:="";INT VAR summe:=0,
+gesamt,nerf,erf;FOR iFROM 1UPTO anzgewichteREP gesamt:=anzwuenschegesamt(row)
+(i);nerf:=anznerfwuensche(row)(i);erf:=gesamt-nerf;summeINCR erf;ausgabeCAT 
+text(erf,6)PER ;ausgabeCAT text(summe,6);ausgabeEND PROC erfuelltwerte;PROC 
+zeitwuenschelisten(BOOL VAR b):IF wert(fnrzwsj)<>schjCOR wert(fnrzwhj)<>schhj
+COR wert(fnrzwbezug)<>kennCOR dbstatus<>0THEN b:=TRUE ELSE IF 
+keinezeitwuenscheTHEN keinezeitwuensche:=FALSE FI ;bereiteobjektauf(wert(
+fnrzwbezugsobjekt))FI END PROC zeitwuenschelisten;PROC bereiteobjektauf(TEXT 
+CONST objekt):TEXT VAR bestwunsch,unbestwunsch;INT VAR suchpos:=1,freietage,
+freievorm,freienachm,wnerf,wanz;TEXT VAR wunsch:="";standardmeldung(
+meldungbearbwird,objekt+ausgabeparam);IF kenn=kennzfaecherTHEN IF pos(
+faecherkatalog,trenner+objekt+trenner)=0THEN fehlereintragELSE listeneintrag
+FI ELIF bezeichnungzulaessig(kenn,objekt)THEN listeneintragELSE fehlereintrag
+FI .fehlereintrag:putline(datei,objekt+":   (ungültige Bezeichnung)");putline
+(datei,leerzeile).listeneintrag:moobjeintrag:=moeintrag;diobjeintrag:=
+dieintrag;miobjeintrag:=mieintrag;doobjeintrag:=doeintrag;frobjeintrag:=
+freintrag;saobjeintrag:=saeintrag;uebertragwuensche;putline(datei,objekt+":")
+;putline(datei,leerzeile);putline(datei,"Wünsche zu festen Zeiten:");putline(
+datei,"(nicht erfüllte sind mit * markiert)");putline(datei,
+"     1   2   3   4   5   6   7   8   9  10  11  12");putline(datei,
+moobjeintrag+text(bestwzeile,48));putline(datei,diobjeintrag+subtext(
+bestwzeile,49,96));putline(datei,miobjeintrag+subtext(bestwzeile,97,144));
+putline(datei,doobjeintrag+subtext(bestwzeile,145,192));putline(datei,
+frobjeintrag+subtext(bestwzeile,193,240));putline(datei,saobjeintrag+subtext(
+bestwzeile,241));putline(datei,leerzeile);putline(datei,
+"                im Plan  allgemeine Wünsche:");putline(datei,
+"                frei     Anzahl/Gewicht  nicht erfüllt");putline(datei,
+"ganze Tage      "+unbestwtage);putline(datei,"zusätzl. Vorm.  "+unbestwvorm)
+;putline(datei,"zusätzl. Nachm. "+unbestwnachm);putline(datei,leerzeile);
+putline(datei,leerzeile).uebertragwuensche:bestwunsch:=wert(
+fnrzwbestimmtewuensche);unbestwunsch:=wert(fnrzwunbestimmtewuensche);
+bestwzeile:=bestwurzeile;unbestwtage:=" _        _      _        _ ";
+unbestwvorm:=" _        _      _        _ ";unbestwnachm:=
+" _        _      _        _ ";tragbestwuenscheein;tragunbestwuenscheein.
+tragbestwuenscheein:suchpos:=1;WHILE suchpos<>0REP suchpos:=pos(bestwunsch,
+minus,suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1
+);zaehlebestwunsch(1,wunsch,TRUE );IF unterricht(objekt,suchposDIV 2+1)THEN 
+wunschCAT ausgnerf;zaehlebestwunsch(1,wunsch,FALSE )FI ;replace(bestwzeile,
+suchpos*2-1,wunsch);suchposINCR 1FI ;PER ;suchpos:=1;WHILE suchpos<>0REP 
+suchpos:=pos(bestwunsch,plus,suchpos);IF suchpos<>0THEN wunsch:=subtext(
+bestwunsch,suchpos,suchpos+1);zaehlebestwunsch(1,wunsch,TRUE );IF NOT (
+unterricht(objekt,suchposDIV 2+1))THEN wunschCAT ausgnerf;zaehlebestwunsch(1,
+wunsch,FALSE )FI ;replace(bestwzeile,suchpos*2-1,wunsch);suchposINCR 1FI ;
+PER .tragunbestwuenscheein:anztage:=0;anzvorm:=0;anznachm:=0;
+ermittleunbestwdaten(objekt);freietage:=anzunterrichtstage-anztage;freievorm
+:=anzvormittage-freietage-anzvorm;freienachm:=anznachmittage-freietage-
+anznachm;replace(unbestwtage,ausgfreipos,text(freietage));replace(unbestwvorm
+,ausgfreipos,text(freievorm));replace(unbestwnachm,ausgfreipos,text(
+freienachm));IF unbestwunsch<>leererunbestwunschTHEN wunsch:=unbestwunschSUB 
+posanzut;IF wunsch<>" "THEN replace(unbestwtage,ausganzpos,wunsch)FI ;wanz:=
+int(wunsch);IF freietage<wanzTHEN wnerf:=wanz-freietage;replace(unbestwtage,
+ausgnerfpos,text(wnerf))ELSE wnerf:=0FI ;wunsch:=unbestwunschSUB posgewut;IF 
+wunsch<>" "THEN replace(unbestwtage,ausggewpos,wunsch)FI ;zaehleunbestwunsch(
+2,wanz,wnerf,wunsch);wunsch:=unbestwunschSUB posanzvm;IF wunsch<>" "THEN 
+replace(unbestwvorm,ausganzpos,wunsch)FI ;wanz:=int(wunsch);IF freievorm<wanz
+THEN wnerf:=wanz-freievorm;replace(unbestwvorm,ausgnerfpos,text(wnerf))ELSE 
+wnerf:=0FI ;wunsch:=unbestwunschSUB posgewvm;IF wunsch<>" "THEN replace(
+unbestwvorm,ausggewpos,wunsch)FI ;zaehleunbestwunsch(3,wanz,wnerf,wunsch);
+wunsch:=unbestwunschSUB posanznm;IF wunsch<>" "THEN replace(unbestwnachm,
+ausganzpos,wunsch)FI ;wanz:=int(wunsch);IF freienachm<wanzTHEN wnerf:=wanz-
+freienachm;replace(unbestwnachm,ausgnerfpos,text(wnerf))ELSE wnerf:=0FI ;
+wunsch:=unbestwunschSUB posgewnm;IF wunsch<>" "THEN replace(unbestwnachm,
+ausggewpos,wunsch)FI ;zaehleunbestwunsch(4,wanz,wnerf,wunsch);FI .END PROC 
+bereiteobjektauf;PROC ermittleunbestwdaten(TEXT CONST objekt):BOOL VAR 
+tagnichtgezaehlt:=TRUE ;INT VAR incr:=0,anz,zeitstd;anz:=
+anzunterrichtsstunden;FOR iFROM 1UPTO anzunterrichtstage-1REP 
+tagnichtgezaehlt:=TRUE ;suchevormunterricht;suchenachmunterricht;incrINCR 
+anzunterrichtsstundenPER ;anz:=anzsamstagstunden;tagnichtgezaehlt:=TRUE ;
+suchevormunterricht;suchenachmunterricht.suchevormunterricht:FOR jFROM 1UPTO 
+anzREP zeitstd:=incr+j;IF (planSUB zeitstd)=kennungvormTHEN IF unterricht(
+objekt,incr+j)THEN anzvormINCR 1;anztageINCR 1;tagnichtgezaehlt:=FALSE ;
+LEAVE suchevormunterrichtFI ;ELIF (planSUB zeitstd)=kennungnachmTHEN LEAVE 
+suchevormunterrichtFI ;PER .suchenachmunterricht:FOR jFROM anzDOWNTO 1REP 
+zeitstd:=incr+j;IF (planSUB zeitstd)=kennungnachmTHEN IF unterricht(objekt,
+incr+j)THEN anznachmINCR 1;IF tagnichtgezaehltTHEN anztageINCR 1;LEAVE 
+suchenachmunterrichtFI ;FI ;ELIF (planSUB zeitstd)=kennungvormTHEN LEAVE 
+suchenachmunterrichtFI ;PER .END PROC ermittleunbestwdaten;PROC 
+zaehlebestwunsch(INT CONST rowindex,TEXT CONST wunsch,BOOL CONST erfuellt):
+INT VAR gew;IF wunsch="-3"THEN gew:=1ELIF wunsch="-2"THEN gew:=2ELIF wunsch=
+"-1"THEN gew:=3ELIF wunsch="+1"THEN gew:=4ELIF wunsch="+2"THEN gew:=5ELIF 
+wunsch="+3"THEN gew:=6FI ;IF erfuelltTHEN anzwuenschegesamt(rowindex)(gew)
+INCR 1ELSE anznerfwuensche(rowindex)(gew)INCR 1FI END PROC zaehlebestwunsch;
+PROC zaehleunbestwunsch(INT CONST rowindex,wanz,wnerf,TEXT CONST wunsch):INT 
+VAR gewicht;SELECT int(wunsch)OF CASE 3:gewicht:=1CASE 2:gewicht:=2OTHERWISE 
+gewicht:=3END SELECT ;anzwuenschegesamt(rowindex)(gewicht)INCR wanz;IF wnerf
+<>0THEN anznerfwuensche(rowindex)(gewicht)INCR wnerfFI END PROC 
+zaehleunbestwunsch;BOOL PROC unterricht(TEXT CONST objekt,INT CONST zeit):
+TEXT VAR lv,ra,par,daten;INT VAR spos,findpos;IF fall=fldsugrupCOR fall=
+fldlehrerCOR fall=fldraeumeTHEN objektunterrichtELSE objektindatenderzeitFI .
+objektunterricht:planeintraglesen(zeit,kenn,objekt,lv,ra,par);lv<>"".
+objektindatenderzeit:IF fall=fldfaecherTHEN daten:=datenderzeit(zeit,kennzlv)
+;findpos:=3ELSE daten:=datenderzeit(zeit,kenn);findpos:=1FI ;IF daten=""THEN 
+FALSE ELSE suchindatenFI .suchindaten:spos:=1;WHILE spos<>0REP spos:=pos(
+daten,objekt,spos);IF spos<>0THEN IF (sposMOD 8)=findposTHEN LEAVE unterricht
+WITH TRUE FI ;sposINCR 1FI ;PER ;FALSE .END PROC unterricht;PROC 
+zeitrasterdaten(BOOL VAR b):IF wert(fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhj
+COR dbstatus<>0THEN b:=TRUE ELSE planCAT wert(fnrzrkennungteil);FI END PROC 
+zeitrasterdaten;PROC faecher(BOOL VAR b):faecherkatalogCAT wert(fnrffach)+
+trennerEND PROC faecher;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN 
+standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(
+meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen
+,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6
+THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;END PACKET einhaltungzeitwuenschepruefen
+
diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.lehrer b/app/schulis/2.2.1/src/4.einzelstdpl.lehrer
new file mode 100644
index 0000000..39067e3
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.einzelstdpl.lehrer
@@ -0,0 +1,113 @@
+PACKET einzelstdpllehrerDEFINES einzelstdpllehrereingang,
+einzelstdpllehrerstarten,einzelstdpllehrersonderwerte,
+einzelstdpllehrermultistop,einzelstdpllehrerdruckdateibauen:LET swanrede=511,
+swlehrername=512,swschuljahr=514,swhalbjahr=515,swtagesstunde=520,
+swklassenleitungen=540,swstellvleitungen=541,swaufsichtszeit=542,
+swaufsichtsort=543,dateimitvordruck1="vordruck1 einzelstdpl lehrer",
+dateimitvordruck2="vordruck2 einzelstdpl raeume",dateimitvordruck3=
+"vordruck2 einzelstdpl lehrer",dateimitvordruck4=
+"vordruck3 einzelstdpl lehrer";TASK VAR vordruckserver;LET 
+maxzeichenimvordruck=79;TEXT VAR hj,sj,paraphe:="",anrede,klassenleitung:="",
+stellvleitung:="",l:="",r:="",p:="",geplantezeiten;LET maske=
+"ms einzelstdpl lehrer eingang",fnr2paraphe=2,fnr3akthj=3,fnr4ausgabebs=4,
+fnr5ausgabedr=5,blank=" ",null=0,niltext="",
+meldnrkeinestundenplandatenvorhanden=366,meldnrungueltigeparaphe=344,
+meldnrkeinelehrerdaten=337,meldnrauswahlunsinnig=56,meldnrbittewarten=69;INT 
+CONST swzweitezeile:=6,erstestd:=1,letztestd:=12,maxwochstdn:=66,maxwochtage
+:=6;BOOL VAR anschreibenaufbszeigen:=TRUE ,einzelanschreiben:=TRUE ,
+aktuelleshjgewaehlt:=TRUE ;INT VAR eingabestatus,x,meldnr;PROC 
+einzelstdpllehrereingang:standardvproc(maske)END PROC 
+einzelstdpllehrereingang;PROC einzelstdpllehrerstarten:vordruckserver:=/
+"anschreiben server";IF maskenwerteokTHEN IF stundenplanokTHEN 
+startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden;
+meldedenfehler;zurueckzumdialog;FI ;ELSE meldedenfehler;zurueckzumdialogFI ;.
+meldedenfehler:standardmeldung(meldnr,niltext).zurueckzumdialog:return(1).
+startenausfuehren:forget(dateimitvordruck1,quiet);forget(dateimitvordruck2,
+quiet);forget(dateimitvordruck3,quiet);forget(dateimitvordruck4,quiet);fetch(
+dateimitvordruck1,vordruckserver);fetch(dateimitvordruck2,vordruckserver);
+fetch(dateimitvordruck3,vordruckserver);fetch(dateimitvordruck4,
+vordruckserver);inittupel(dnrlehrer);putwert(fnrlparaphe,paraphe);
+standardmeldung(meldnrbittewarten,niltext);zusammengesetztesanschreiben(
+dnrlehrer,anschreibenaufbszeigen,einzelanschreiben,BOOL PROC 
+einzelstdpllehrersonderwerte,BOOL PROC einzelstdpllehrermultistop,TEXT PROC 
+einzelstdpllehrerdruckdateibauen);END PROC einzelstdpllehrerstarten;BOOL 
+PROC stundenplanok:sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum(
+"Schulhalbjahr");IF NOT (aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen(
+hj,sj)FI ;stundenplanhalbjahrsetzen(hj,sj);
+stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0OR 
+eingabestatus=8END PROC stundenplanok;BOOL PROC maskenwerteok:BOOL VAR ok:=
+FALSE ;standardpruefe(5,fnr4ausgabebs,fnr5ausgabedr,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld(
+fnr4ausgabebs);ok:=FALSE ELSE anschreibenaufbszeigen:=standardmaskenfeld(
+fnr5ausgabedr)=niltext;einzelanschreiben:=standardmaskenfeld(fnr2paraphe)<>
+niltext;aktuelleshjgewaehlt:=standardmaskenfeld(fnr3akthj)<>niltext;IF 
+einzelanschreibenTHEN IF gueltigeparapheTHEN paraphe:=wert(fnrlparaphe);ok:=
+TRUE ELSE meldnr:=meldnrungueltigeparaphe;infeld(fnr2paraphe);ok:=FALSE FI ;
+ELSE IF dateilehrerleerTHEN meldnr:=meldnrkeinelehrerdaten;infeld(fnr3akthj);
+ok:=FALSE ELSE ok:=TRUE FI ;FI ;FI ;okEND PROC maskenwerteok;BOOL PROC 
+gueltigeparaphe:inittupel(dnrlehrer);putwert(fnrlparaphe,standardmaskenfeld(
+fnr2paraphe));search(dnrlehrer,TRUE );dbstatus=0END PROC gueltigeparaphe;
+BOOL PROC dateilehrerleer:inittupel(dnrlehrer);search(dnrlehrer);dbstatus<>0
+END PROC dateilehrerleer;BOOL PROC einzelstdpllehrersonderwerte:INT VAR 
+gemerkterdbstatus;paraphe:=wert(fnrlparaphe);initialisieresonderwerte;IF wert
+(fnrlgeschlecht)="m"THEN anrede:="Herrn"ELSE anrede:="Frau"FI ;adressat(wert(
+fnrlfamname));setzesonderwert(swschuljahr,subtext(sj,1,2)+"/"+subtext(sj,3,4)
+);setzesonderwert(swhalbjahr,hj);setzesonderwert(swanrede,anrede);
+setzesonderwert(swlehrername,wert(fnrlfamname));gemerkterdbstatus:=dbstatus;
+inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj);
+search(dnraktschuelergruppen);klassenleitung:=niltext;stellvleitung:=niltext;
+WHILE (dbstatus=0AND wert(fnrsgrphj)=hj)REP IF wert(fnrsgrplehrer)=wert(
+fnrlparaphe)THEN klassenleitungCAT (wert(fnrsgrpjgst)+wert(fnrsgrpkennung)+
+blank)FI ;IF wert(fnrsgrpstellvlehrer)=wert(fnrlparaphe)THEN stellvleitung
+CAT (wert(fnrsgrpjgst)+wert(fnrsgrpkennung)+blank)FI ;succ(
+dnraktschuelergruppen);PER ;setzesonderwert(swklassenleitungen,klassenleitung
+);setzesonderwert(swstellvleitungen,stellvleitung);dbstatus(gemerkterdbstatus
+);TRUE END PROC einzelstdpllehrersonderwerte;BOOL PROC 
+einzelstdpllehrermultistop:BOOL VAR b;IF einzelanschreibenTHEN b:=wert(
+fnrlparaphe)=parapheELSE b:=dbstatus=0FI ;bENDPROC einzelstdpllehrermultistop
+;TEXT PROC einzelstdpllehrerdruckdateibauen:INT VAR dbstatusintern;LET 
+stddruckdatei="liste.1",hilfsdatei="hilfsdatei";FILE VAR f;TEXT VAR zeile:=""
+,druckdatei:="Lehrer-Einzelplan";TEXT CONST teil1:="---+",teil2:=
+"-----------+",teil3:="-----------: ",teil4:="-------------------",
+normaletrennlinie:=teil1+5*teil2+teil3,abschlusslinie:=4*teil4+blank;
+setzemitseitennummern(TRUE );druckvorbereiten;setzeanzahlderzeichenprozeile(
+maxzeichenimvordruck);briefalternative(dateimitvordruck1,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);
+geplantezeiten:=allezeitenvon("P",paraphe);FOR xFROM erstestdUPTO letztestd
+REP datendeszweitenvordrucksindruckdateiPER ;briefalternative(
+dateimitvordruck3,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+forget(hilfsdatei,quiet);inittupel(dnraufsichtsplan);putwert(fnrapsj,sj);
+putwert(fnraphj,hj);putwert(fnrapparaphe,paraphe);search(ixappar,TRUE );
+WHILE dbstatus=0AND wert(fnrapsj)=sjAND wert(fnraphj)=hjAND wert(fnrapparaphe
+)=parapheREP setzesonderwert(swaufsichtsort,wert(fnrapaufsichtsort));
+dbstatusintern:=dbstatus;inittupel(dnraufsichtszeiten);putwert(fnrazsj,sj);
+putwert(fnrazhj,hj);putwert(fnrapaufsichtszeit,wert(fnrapaufsichtszeit));
+search(dnraufsichtszeiten,TRUE );IF dbstatus=0THEN setzesonderwert(
+swaufsichtszeit,wert(fnrazbezeichnung))ELSE setzesonderwert(swaufsichtszeit,
+blank)FI ;briefalternative(dateimitvordruck4,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);
+dbstatus(dbstatusintern);succ(ixappar);PER ;drucknachbereitenohneausdrucken;
+rename(stddruckdatei,druckdatei);f:=sequentialfile(modify,druckdatei);toline(
+f,1);input(f);druckdatei.datendeszweitenvordrucksindruckdatei:setzesonderwert
+(swtagesstunde,text(x,2));
+planeintraegeprowochenstdenlesenundsonderwertesetzen(x);briefalternative(
+dateimitvordruck2,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+IF x<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=abschlusslinieFI ;
+druckzeileschreiben(zeile);forget(hilfsdatei,quiet);END PROC 
+einzelstdpllehrerdruckdateibauen;PROC zeilenweisehilfsdateiindruckdatei(TEXT 
+CONST hilfsdatei):INT VAR i;TEXT VAR zeile:="";FILE VAR f;f:=sequentialfile(
+input,hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile);
+druckzeileschreiben(zeile)PER ;END PROC zeilenweisehilfsdateiindruckdatei;
+PROC planeintraegeprowochenstdenlesenundsonderwertesetzen(INT CONST std):INT 
+VAR i,wochenstd:=std,sonderwert:=521;TEXT VAR ausgabe;FOR iFROM 1UPTO 
+maxwochtageREP IF (geplantezeitenSUB wochenstd)="1"THEN planeintraglesen(
+wochenstd,"P",paraphe,l,r,p);IF wochenstd<=maxwochstdnTHEN ausgabe:=subtext(l
+,1,2);ausgabeCAT blank;ausgabeCAT subtext(l,3,4);ausgabeCAT blank;ausgabeCAT 
+subtext(l,5,8);setzesonderwert(sonderwert,ausgabe);setzesonderwert(sonderwert
++swzweitezeile,r);ELSE setzesonderwert(sonderwert,blank);setzesonderwert(
+sonderwert+swzweitezeile,blank);FI ;ELSE setzesonderwert(sonderwert,blank);
+setzesonderwert(sonderwert+swzweitezeile,blank);FI ;ausgabe:=niltext;
+sonderwertINCR 1;wochenstdINCR letztestd;PER ;END PROC 
+planeintraegeprowochenstdenlesenundsonderwertesetzen;END PACKET 
+einzelstdpllehrer
+
diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.raeume b/app/schulis/2.2.1/src/4.einzelstdpl.raeume
new file mode 100644
index 0000000..aeb0db5
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.einzelstdpl.raeume
@@ -0,0 +1,86 @@
+PACKET einzelstdplraeumeDEFINES einzelstdplraeumeeingang,
+einzelstdplraeumestarten,einzelstdplraeumesonderwerte,
+einzelstdplraeumemultistop,einzelstdplraeumedruckdateibauen:LET maske=
+"ms einzelstdpl raeume eingang",fnr2raum=2,fnr3akthj=3,fnr4ausgabebs=4,
+fnr5ausgabedr=5,blank=" ",null=0,niltext="",
+fehlermeldnrkeinestundenplandatenvorhanden=366,fehlermeldnrungueltigerraum=
+359,fehlermeldnrauswahlunsinnig=56,fehlermeldnrbestandraeumeleer=365,
+meldnrbittewarten=69,swraum=511,swschuljahr=512,swhalbjahr=513,swraumlangtext
+=514,swtagesstunde=520,maxzeichenimvordruck=79;TASK VAR vordruckserver;TEXT 
+CONST dateimitvordruck1:="vordruck1 einzelstdpl raeume",dateimitvordruck2:=
+"vordruck2 einzelstdpl raeume",bestandnameraeume:="c02 raeume",strich:="-",
+kreuz:="+",abschlusslinie:=76*strich+blank,normaletrennlinie:=3*strich+kreuz+
+5*(11*strich+kreuz)+11*strich+": ";TEXT VAR hj,sj,raum:="",l:="",r:="",p:="";
+BOOL VAR anschreibenaufbszeigen:=TRUE ,einzelanschreiben:=TRUE ,
+aktuelleshjgewaehlt:=TRUE ;INT VAR eingabestatus,i,x,fehlermeldnr;INT CONST 
+aktuellerindex:=dnrschluessel,maxwochstdn:=66,erstestd:=1,letztestd:=12;PROC 
+einzelstdplraeumeeingang:standardvproc(maske)END PROC 
+einzelstdplraeumeeingang;PROC einzelstdplraeumestarten:IF maskenwerteokTHEN 
+IF stundenplanokTHEN startenausfuehrenELSE fehlermeldnr:=
+fehlermeldnrkeinestundenplandatenvorhanden;meldedenfehler;zurueckzumdialog;
+FI ;ELSE meldedenfehler;zurueckzumdialogFI ;.meldedenfehler:standardmeldung(
+fehlermeldnr,niltext).zurueckzumdialog:return(1).startenausfuehren:
+vordruckserver:=/"anschreiben server";forget(dateimitvordruck1,quiet);forget(
+dateimitvordruck2,quiet);fetch(dateimitvordruck1,vordruckserver);fetch(
+dateimitvordruck2,vordruckserver);inittupel(dnrschluessel);putwert(
+fnrschlsachgebiet,bestandnameraeume);putwert(fnrschlschluessel,raum);
+standardmeldung(meldnrbittewarten,niltext);zusammengesetztesanschreiben(
+aktuellerindex,anschreibenaufbszeigen,einzelanschreiben,BOOL PROC 
+einzelstdplraeumesonderwerte,BOOL PROC einzelstdplraeumemultistop,TEXT PROC 
+einzelstdplraeumedruckdateibauen);END PROC einzelstdplraeumestarten;BOOL 
+PROC stundenplanok:stundenplanhalbjahrsetzen(hj,sj);
+stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0OR 
+eingabestatus=8END PROC stundenplanok;BOOL PROC maskenwerteok:BOOL VAR ok;
+standardpruefe(5,fnr4ausgabebs,fnr5ausgabedr,null,niltext,eingabestatus);IF 
+eingabestatus<>0THEN fehlermeldnr:=fehlermeldnrauswahlunsinnig;infeld(
+fnr4ausgabebs);ok:=FALSE ELSE anschreibenaufbszeigen:=standardmaskenfeld(
+fnr5ausgabedr)=niltext;einzelanschreiben:=standardmaskenfeld(fnr2raum)<>
+niltext;aktuelleshjgewaehlt:=standardmaskenfeld(fnr3akthj)<>niltext;sj:=
+schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");IF NOT (
+aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen(hj,sj)FI ;IF 
+einzelanschreibenTHEN IF gueltigerraumTHEN ok:=TRUE ELSE fehlermeldnr:=
+fehlermeldnrungueltigerraum;ok:=FALSE FI ;ELSE IF schluesselbestandleerTHEN 
+fehlermeldnr:=fehlermeldnrbestandraeumeleer;infeld(fnr2raum);ok:=FALSE ELSE 
+raum:=wert(fnrschlschluessel);ok:=TRUE FI ;FI ;FI ;okEND PROC maskenwerteok;
+BOOL PROC gueltigerraum:raum:=standardmaskenfeld(fnr2raum);inittupel(
+dnrschluessel);putwert(fnrschlsachgebiet,bestandnameraeume);putwert(
+fnrschlschluessel,raum);search(dnrschluessel,TRUE );dbstatus=0END PROC 
+gueltigerraum;BOOL PROC schluesselbestandleer:inittupel(dnrschluessel);
+putwert(fnrschlsachgebiet,bestandnameraeume);search(dnrschluessel);raum:=wert
+(fnrschlschluessel);dbstatus<>0COR wert(fnrschlsachgebiet)<>bestandnameraeume
+END PROC schluesselbestandleer;BOOL PROC einzelstdplraeumesonderwerte:
+initialisieresonderwerte;adressat(raum);setzesonderwert(swschuljahr,subtext(
+sj,1,2)+"/"+subtext(sj,3,4));setzesonderwert(swhalbjahr,hj);setzesonderwert(
+swraum,wert(fnrschlschluessel));setzesonderwert(swraumlangtext,wert(
+fnrschllangtext));TRUE END PROC einzelstdplraeumesonderwerte;BOOL PROC 
+einzelstdplraeumemultistop:BOOL VAR b;IF einzelanschreibenTHEN b:=wert(
+fnrschlschluessel)=raumELSE b:=wert(fnrschlsachgebiet)=bestandnameraeumeFI ;b
+ENDPROC einzelstdplraeumemultistop;TEXT PROC einzelstdplraeumedruckdateibauen
+:LET stddruckdatei="liste.1",hilfsdatei="hilfsdatei";FILE VAR f;TEXT VAR 
+zeile:="",druckdatei:="Raumplan";forget(druckdatei,quiet);druckvorbereiten;
+setzeanzahlderzeichenprozeile(maxzeichenimvordruck);raum:=wert(
+fnrschlschluessel);datendeserstenvordrucksindruckdatei;FOR xFROM erstestd
+UPTO letztestdREP datendeszweitenvordrucksindruckdateiPER ;rename(
+stddruckdatei,druckdatei);f:=sequentialfile(modify,druckdatei);toline(f,1);
+input(f);druckdatei.datendeserstenvordrucksindruckdatei:briefalternative(
+dateimitvordruck1,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+forget(hilfsdatei,quiet);.datendeszweitenvordrucksindruckdatei:
+setzesonderwert(swtagesstunde,text(x,2));
+planeintraegeprowochenstdenlesenundsonderwertesetzen(x);briefalternative(
+dateimitvordruck2,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+IF x<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=abschlusslinieFI ;
+druckzeileschreiben(zeile);forget(hilfsdatei,quiet);END PROC 
+einzelstdplraeumedruckdateibauen;PROC zeilenweisehilfsdateiindruckdatei(TEXT 
+CONST hilfsdatei):TEXT VAR zeile:=niltext;FILE VAR f;f:=sequentialfile(input,
+hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile);druckzeileschreiben(
+zeile)PER ;END PROC zeilenweisehilfsdateiindruckdatei;PROC 
+planeintraegeprowochenstdenlesenundsonderwertesetzen(INT CONST std):INT VAR 
+wochenstd:=std,sonderwert:=521;TEXT VAR ausgabe;WHILE wochenstd<=maxwochstdn
+REP planeintraglesen(wochenstd,"R",raum,l,r,p);IF r<>""THEN ausgabe:=subtext(
+l,1,2);ausgabeCAT blank;ausgabeCAT subtext(l,3,4);ausgabeCAT blank;ausgabe
+CAT subtext(l,5,8);setzesonderwert(sonderwert,ausgabe);setzesonderwert(
+sonderwert+6,p);ELSE setzesonderwert(sonderwert,blank);setzesonderwert(
+sonderwert+6,blank);FI ;ausgabe:=niltext;sonderwertINCR 1;wochenstdINCR 12;
+PER ;END PROC planeintraegeprowochenstdenlesenundsonderwertesetzen;END 
+PACKET einzelstdplraeume;
+
diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.sek1 b/app/schulis/2.2.1/src/4.einzelstdpl.sek1
new file mode 100644
index 0000000..1f72cd0
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.einzelstdpl.sek1
@@ -0,0 +1,233 @@
+PACKET einzelstdplsek1DEFINES einzelstdplsek1eingang,einzelstdplsek1starten,
+einzelstdplsek1sonderwerte,einzelstdplsek1multistop,
+einzelstdplsek1druckdateibauen:LET laengelv=8,geplantestd="1",
+maxlvgnproschuelergr=100,maxwochstdn=66,swschuelergruppe=511,swschuljahr=512,
+swhalbjahr=513,swklassenleiter=514,swstellvertreter=516,swtagesstunde=520,
+sw4fach=518,sw4kopplung=519,sw4fachlangtext=520,sw4erllehrer=521,sw6kopplung=
+530,sw7lv=540,maske="ms einzelstdpl sek1 eingang",fnr2jgst=2,fnr3kennung=3,
+fnr4ohneerlaeuterung=4,fnr5akthj=5,fnr6ausgabebs=6,fnr7ausgabedr=7,blank=" ",
+vierblanks="    ",null=0,niltext="",meldnrauswahlunsinnig=56,
+meldnrbittewarten=69,meldnrkeinestundenplandatenvorhanden=366,
+meldnrkeineentsprechendenschuelerda=127,meldnrungueltigeklassengr=320,
+meldnrungueltigejgst=146,maxzeichenimvordruck=79;TASK VAR vordruckserver;
+TEXT CONST dateimitvordruck1:="vordruck1 einzelstdpl sek1",dateimitvordruck2
+:="vordruck2 einzelstdpl sek1",dateimitvordruck3:=
+"vordruck3 einzelstdpl sek1",dateimitvordruck4:="vordruck4 einzelstdpl sek1",
+dateimitvordruck5:="vordruck5 einzelstdpl sek1",dateimitvordruck6:=
+"vordruck6 einzelstdpl sek1",dateimitvordruck7:="vordruck7 einzelstdpl sek1",
+strich:="-",kreuz:="+",abschlusslinie:=76*strich+blank,normaletrennlinie:=3*
+strich+kreuz+5*(11*strich+kreuz)+11*strich+": ";TEXT VAR kopplg:="",hj,sj,
+sjaufber,jgst:="",kennung:="",stdplanrede,uebfolgeseiten,l:="",r:="",p:="",
+lvgnproschuelgr,lv,paraphezurlv,string,schuelergr,kopplungsbez,hilfstext,
+lehrer:="";BOUND ROW maxlvgnproschuelergrTEXT VAR zeitenzulv;BOUND ROW 
+maxwochstdnTEXT VAR kopplungen;BOOL VAR gesamtesek1:=FALSE ,bestjgst:=FALSE ,
+bestschuelergruppe:=FALSE ,korrektewahl:=FALSE ,anschreibenaufbszeigen:=TRUE 
+,miterlaeuterung:=TRUE ,einzelanschreiben:=TRUE ,aktuelleshjgewaehlt:=TRUE ;
+INT VAR anzzeilen,eingabestatus,i,x,y,z:=0,anzlvgnprokopplg,
+anzlvgnproschuelergr,meldnr;INT CONST aktuellerindex:=dnraktschuelergruppen,
+erstestd:=1,letztestd:=12,sek1max:=10,sek1min:=5,maxwochtage:=6;PROC 
+einzelstdplsek1eingang:standardvproc(maske)END PROC einzelstdplsek1eingang;
+PROC einzelstdplsek1starten:IF maskenwerteokTHEN IF stundenplanokTHEN 
+startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden;
+meldedenfehler;zurueckzumdialog;FI ;ELSE meldedenfehler;zurueckzumdialogFI ;.
+meldedenfehler:standardmeldung(meldnr,niltext).zurueckzumdialog:return(1).
+startenausfuehren:vordruckserver:=/"anschreiben server";forget(
+dateimitvordruck1,quiet);forget(dateimitvordruck2,quiet);fetch(
+dateimitvordruck1,vordruckserver);fetch(dateimitvordruck2,vordruckserver);
+forget("datenraum1",quiet);forget("datenraum2",quiet);IF miterlaeuterungTHEN 
+forget(dateimitvordruck3,quiet);forget(dateimitvordruck4,quiet);forget(
+dateimitvordruck5,quiet);forget(dateimitvordruck6,quiet);forget(
+dateimitvordruck7,quiet);fetch(dateimitvordruck3,vordruckserver);fetch(
+dateimitvordruck4,vordruckserver);fetch(dateimitvordruck5,vordruckserver);
+fetch(dateimitvordruck6,vordruckserver);fetch(dateimitvordruck7,
+vordruckserver);FI ;setzesonderwerteschulkenndaten;standardmeldung(
+meldnrbittewarten,niltext);zusammengesetztesanschreiben(aktuellerindex,
+anschreibenaufbszeigen,einzelanschreiben,BOOL PROC einzelstdplsek1sonderwerte
+,BOOL PROC einzelstdplsek1multistop,TEXT PROC einzelstdplsek1druckdateibauen)
+;END PROC einzelstdplsek1starten;BOOL PROC maskenwerteok:BOOL VAR ok:=FALSE ;
+standardpruefe(5,fnr6ausgabebs,fnr7ausgabedr,null,niltext,eingabestatus);IF 
+eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld(fnr6ausgabebs);
+ELSE sortierungsetzen;aktuelleshjgewaehlt:=standardmaskenfeld(fnr5akthj)<>
+niltext;sj:=schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");
+IF NOT (aktuelleshjgewaehlt)THEN geplanteshjundsjberechnen(hj,sj)FI ;sjaufber
+:=subtext(sj,1,2)+"/"+subtext(sj,3,4);anschreibenaufbszeigen:=
+standardmaskenfeld(fnr7ausgabedr)=niltext;miterlaeuterung:=standardmaskenfeld
+(fnr4ohneerlaeuterung)=niltext;korrektewahl:=FALSE ;inittupel(
+dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj,hj);IF 
+gesamtesek1THEN IF gueltigesek1THEN einzelanschreiben:=FALSE ;ok:=TRUE ELSE 
+meldnr:=meldnrkeineentsprechendenschuelerda;infeld(fnr2jgst)FI ;ELIF bestjgst
+THEN IF gueltigejgstTHEN einzelanschreiben:=FALSE ;ok:=TRUE ELSE meldnr:=
+meldnrungueltigejgst;infeld(fnr2jgst)FI ;ELIF bestschuelergruppeTHEN IF 
+gueltigeschuelergrTHEN einzelanschreiben:=TRUE ;ok:=TRUE ELSE meldnr:=
+meldnrungueltigeklassengr;infeld(fnr2jgst)FI ;ELSE meldnr:=
+meldnrauswahlunsinnig;infeld(fnr2jgst);FI ;FI ;ok.sortierungsetzen:IF (
+standardmaskenfeld(fnr2jgst)=niltextAND standardmaskenfeld(fnr3kennung)=
+niltext)THEN gesamtesek1:=TRUE ;ELSE IF (standardmaskenfeld(fnr2jgst)<>
+niltextAND standardmaskenfeld(fnr3kennung)<>niltext)THEN bestschuelergruppe:=
+TRUE ELSE IF standardmaskenfeld(fnr3kennung)=niltextTHEN bestjgst:=TRUE FI ;
+FI ;FI END PROC maskenwerteok;BOOL PROC stundenplanok:
+stundenplanhalbjahrsetzen(hj,sj);stundenplanbasisundstundenplanholen(
+eingabestatus);eingabestatus=0OR eingabestatus=8END PROC stundenplanok;BOOL 
+PROC gueltigesek1:search(dnraktschuelergruppen);IF (sek1min<=int(wert(
+fnrsgrpjgst))AND sek1max>=int(wert(fnrsgrpjgst))AND dbstatus=0)THEN IF length
+(wert(fnrsgrpjgst))=1THEN jgst:="0"+wert(fnrsgrpjgst);ELSE jgst:=wert(
+fnrsgrpjgst)FI ;kennung:=wert(fnrsgrpkennung);korrektewahl:=TRUE FI ;
+korrektewahlEND PROC gueltigesek1;BOOL PROC gueltigejgst:IF length(
+standardmaskenfeld(fnr2jgst))=1THEN jgst:="0"+standardmaskenfeld(fnr2jgst)
+ELSE jgst:=standardmaskenfeld(fnr2jgst)FI ;IF int(jgst)<=sek1maxAND int(jgst)
+>=sek1minTHEN putwert(fnrsgrpjgst,jgst);search(dnraktschuelergruppen);IF 
+dbstatus=0THEN kennung:=wert(fnrsgrpkennung);korrektewahl:=TRUE FI ;FI ;
+korrektewahlEND PROC gueltigejgst;BOOL PROC gueltigeschuelergr:IF length(
+standardmaskenfeld(fnr2jgst))=1THEN jgst:="0"+standardmaskenfeld(fnr2jgst)
+ELSE jgst:=standardmaskenfeld(fnr2jgst)FI ;kennung:=standardmaskenfeld(
+fnr3kennung);IF int(jgst)<=sek1maxAND int(jgst)>=sek1minTHEN putwert(
+fnrsgrpjgst,jgst);putwert(fnrsgrpkennung,kennung);search(
+dnraktschuelergruppen,TRUE );IF dbstatus=0THEN korrektewahl:=TRUE FI ;FI ;
+korrektewahlEND PROC gueltigeschuelergr;BOOL PROC einzelstdplsek1multistop:
+BOOL VAR b;IF bestschuelergruppeTHEN b:=intwert(fnrsgrpsj)=int(sj)AND intwert
+(fnrsgrphj)=int(hj)AND intwert(fnrsgrpjgst)=int(jgst)AND wert(fnrsgrpkennung)
+=kennungAND dbstatus=okELIF bestjgstTHEN b:=intwert(fnrsgrpsj)=int(sj)AND 
+intwert(fnrsgrphj)=int(hj)AND intwert(fnrsgrpjgst)=int(jgst)AND dbstatus=ok
+ELSE b:=intwert(fnrsgrpsj)=int(sj)AND intwert(fnrsgrphj)=int(hj)AND intwert(
+fnrsgrpjgst)<=sek1maxAND intwert(fnrsgrpjgst)>=sek1minAND dbstatus=okFI ;b
+ENDPROC einzelstdplsek1multistop;BOOL PROC einzelstdplsek1sonderwerte:INT 
+VAR gemerkterdbstatus;initialisieresonderwerte;setzesonderwert(swschuljahr,
+sjaufber);setzesonderwert(swhalbjahr,hj);IF length(wert(fnrsgrpjgst))=1THEN 
+jgst:="0"+wert(fnrsgrpjgst);ELSE jgst:=wert(fnrsgrpjgst)FI ;kennung:=wert(
+fnrsgrpkennung);schuelergr:=jgst+kennung;setzesonderwert(swschuelergruppe,
+jgst+kennung);adressat(schuelergr);gemerkterdbstatus:=dbstatus;inittupel(
+dnrlehrer);putwert(fnrlparaphe,wert(fnrsgrplehrer));search(dnrlehrer,TRUE );
+IF dbstatus=0THEN IF wert(fnrlgeschlecht)="m"THEN lehrer:="Hr. "ELSE lehrer:=
+"Fr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltextTHEN lehrer
+CAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF hilfstext<>
+niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert(
+fnrlfamname);setzesonderwert(swklassenleiter,lehrer);FI ;inittupel(dnrlehrer)
+;putwert(fnrlparaphe,wert(fnrsgrpstellvlehrer));search(dnrlehrer,TRUE );IF 
+dbstatus=0THEN IF wert(fnrlgeschlecht)="m"THEN lehrer:="Hr. "ELSE lehrer:=
+"Fr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltextTHEN lehrer
+CAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF hilfstext<>
+niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert(
+fnrlfamname);setzesonderwert(swstellvertreter,lehrer);FI ;dbstatus(
+gemerkterdbstatus);TRUE END PROC einzelstdplsek1sonderwerte;TEXT PROC 
+einzelstdplsek1druckdateibauen:LET stddruckdatei="liste.1",druckdatei=
+"Stundenplan",hilfsdatei="hilfsdatei";FILE VAR f;IF miterlaeuterungTHEN 
+kopplungsmerkrowinitialisieren;setzemitseitennummern(TRUE )FI ;forget(
+druckdatei,quiet);druckvorbereiten;setzeanzahlderzeichenprozeile(
+maxzeichenimvordruck);uebfolgeseiten:="Stundenplan für Klasse "+schuelergr+
+"(Schuljahr "+sjaufber+", "+hj+". Halbjahr)";anzzeilen:=1;briefalternative(
+dateimitvordruck1,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+forget(hilfsdatei,quiet);proschuelergruppeallelvgnmitzeitenind2ablegen;FOR x
+FROM erstestdUPTO letztestdREP 
+datendeszweitenvordrucksindruckdateiundggfkopplgmerken(x)PER ;IF 
+miterlaeuterungTHEN briefalternative(dateimitvordruck3,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);FOR x
+FROM 1UPTO anzlvgnproschuelergrREP datendesviertenvordrucksindruckdatei;PER ;
+IF anzzeilen+8>=drucklaengeTHEN seitenwechsel;druckzeileschreiben(
+uebfolgeseiten);druckzeileschreiben(blank);anzzeilen:=3FI ;briefalternative(
+dateimitvordruck5,hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);
+forget(hilfsdatei,quiet);FOR xFROM 1UPTO maxwochstdnREP 
+datendessechstenundsiebtenvordrucksindruckdatei(x);PER ;FI ;
+drucknachbereitenohneausdrucken;rename(stddruckdatei,druckdatei);f:=
+sequentialfile(modify,druckdatei);toline(f,1);input(f);druckdatei.
+kopplungsmerkrowinitialisieren:forget("datenraum1",quiet);kopplungen:=new(
+"datenraum1");FOR xFROM 1UPTO maxwochstdnREP kopplungen(x):=niltext;PER .
+proschuelergruppeallelvgnmitzeitenind2ablegen:lvgnproschuelgr:=
+lvderschuelergruppe(schuelergr);anzlvgnproschuelergr:=(length(lvgnproschuelgr
+))DIV laengelv;forget("datenraum2",quiet);zeitenzulv:=new("datenraum2");INT 
+VAR position:=0;FOR xFROM 1UPTO anzlvgnproschuelergrREP lv:=subtext(
+lvgnproschuelgr,position+1,position+laengelv);string:=allezeitenvon("L",lv);
+stringCAT lv;zeitenzulv(x):=string;positionINCR laengelv;PER ;FOR xFROM 
+anzlvgnproschuelergr+1UPTO maxlvgnproschuelergrREP zeitenzulv(x):=niltext;
+PER ;.datendesviertenvordrucksindruckdatei:TEXT VAR fach:=subtext(zeitenzulv(
+x),maxwochstdn+3,maxwochstdn+4);fachCAT blank;setzesonderwert(sw4fach,fach);
+IF length(zeitenzulv(x))>maxwochstdn+laengelvTHEN kopplg:=subtext(zeitenzulv(
+x),maxwochstdn+laengelv+1,maxwochstdn+2*laengelv);setzesonderwert(sw4kopplung
+,"("+kopplg+")");ELSE setzesonderwert(sw4kopplung,10*blank)FI ;inittupel(
+dnrfaecher);putwert(fnrffach,compress(fach));search(dnrfaecher,TRUE );IF 
+dbstatus=okTHEN setzesonderwert(sw4fachlangtext,wert(fnrffachbez))ELSE 
+setzesonderwert(sw4fachlangtext,blank)FI ;paraphezurlv:=datenzurlv("P",
+subtext(zeitenzulv(x),maxwochstdn+1,maxwochstdn+laengelv));inittupel(
+dnrlehrer);putwert(fnrlparaphe,compress(paraphezurlv));search(dnrlehrer,TRUE 
+);IF dbstatus=okTHEN IF wert(fnrlgeschlecht)="w"THEN lehrer:="Fr. "ELSE 
+lehrer:="Hr. "FI ;hilfstext:=wert(fnrlamtsbeztitel);IF hilfstext<>niltext
+THEN lehrerCAT hilfstext;lehrerCAT blank;FI ;hilfstext:=wert(fnrlzusatz);IF 
+hilfstext<>niltextTHEN lehrerCAT hilfstext;lehrerCAT blank;FI ;lehrerCAT wert
+(fnrlfamname);setzesonderwert(sw4erllehrer,lehrer);ELSE setzesonderwert(
+sw4erllehrer,blank);FI ;briefalternative(dateimitvordruck4,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);END 
+PROC einzelstdplsek1druckdateibauen;PROC zeilenweisehilfsdateiindruckdatei(
+TEXT CONST hilfsdatei):TEXT VAR zeile:=niltext;FILE VAR f;f:=sequentialfile(
+input,hilfsdatei);FOR iFROM 1UPTO lines(f)REP getline(f,zeile);anzzeilenINCR 
+1;IF anzzeilen<drucklaengeTHEN druckzeileschreiben(zeile);ELSE seitenwechsel;
+druckzeileschreiben(uebfolgeseiten);druckzeileschreiben(blank);
+druckzeileschreiben(zeile);anzzeilen:=3;FI ;PER ;END PROC 
+zeilenweisehilfsdateiindruckdatei;PROC 
+datendeszweitenvordrucksindruckdateiundggfkopplgmerken(INT CONST std):LET 
+hilfsdatei="hilfsdatei";TEXT VAR zeile:=niltext;FILE VAR f;setzesonderwert(
+swtagesstunde,text(std,2));IF miterlaeuterungTHEN 
+stdplanprowochstdlesenswsetzenunddatenprokopplgmerken(std)ELSE 
+stdplanprowochstdlesenundswsetzen(std)FI ;briefalternative(dateimitvordruck2,
+hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);f:=sequentialfile(
+input,hilfsdatei);IF std<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=
+abschlusslinieFI ;druckzeileschreiben(zeile);anzzeilenINCR 1;forget(
+hilfsdatei,quiet);END PROC 
+datendeszweitenvordrucksindruckdateiundggfkopplgmerken;PROC 
+datendessechstenundsiebtenvordrucksindruckdatei(INT CONST d1index):LET 
+hilfsdatei="hilfsdatei";FILE VAR f;INT VAR y,z,index:=d1index;TEXT VAR tagstd
+,zeiten,altekopplg,fach,allelvsderkopplg;INT CONST maxauszugebendezeiten:=8;
+INT VAR anzzeitenprokopplg,poslv,sonderwert;IF kopplungen(index)<>niltext
+THEN altekopplg:=kopplungen(index);setzesonderwert(sw6kopplung,altekopplg);
+zeiten:=text(index,2);FOR zFROM index+1UPTO maxwochstdnREP IF kopplungen(z)=
+altekopplgTHEN zeitenCAT text(z,2);kopplungen(z):=niltext;FI ;PER ;
+anzzeitenprokopplg:=length(zeiten)DIV 2;poslv:=1;sonderwert:=sw6kopplung+1;
+FOR zFROM 1UPTO 8REP IF anzzeitenprokopplg>=zTHEN tagstd:=subtext(zeiten,
+poslv,poslv+1);setzesonderwert(sonderwert,tagstunde(int(tagstd),TRUE ));ELSE 
+setzesonderwert(sonderwert,blank)FI ;poslvINCR 2;sonderwertINCR 1PER ;
+briefalternative(dateimitvordruck6,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);
+allelvsderkopplg:=allelvmit("K",altekopplg);anzlvgnprokopplg:=(length(
+allelvsderkopplg)DIV laengelv);poslv:=1;TEXT VAR lvderkopplg;BOOL VAR 
+lvmind1malgeplant;FOR yFROM 1UPTO anzlvgnprokopplgREP lvmind1malgeplant:=
+FALSE ;lvderkopplg:=subtext(allelvsderkopplg,poslv,poslv+7);IF pos(
+lvgnproschuelgr,lvderkopplg)<>0THEN 
+fuerallezeitenderlvplaneintraegelesenundsonderwertesetzen;FI ;IF 
+lvmind1malgeplantTHEN briefalternative(dateimitvordruck7,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);FI ;
+poslvINCR laengelv;PER ;TEXT VAR leerzeile:=blank;druckzeileschreiben(
+leerzeile);FI ;.fuerallezeitenderlvplaneintraegelesenundsonderwertesetzen:
+TEXT VAR l,r,p;INT VAR zeit,poszeit;sonderwert:=sw7lv;fach:=subtext(
+lvderkopplg,3,4);setzesonderwert(sonderwert,fach);poszeit:=1;FOR zFROM 1UPTO 
+maxauszugebendezeitenREP sonderwertINCR 1;IF anzzeitenprokopplg>=zTHEN zeit:=
+int(subtext(zeiten,poszeit,poszeit+1));IF lvgeplant(zeit,lvderkopplg)THEN 
+planeintraglesen(zeit,"L",lvderkopplg,l,r,p);IF r=vierblanksTHEN 
+setzesonderwert(sonderwert,"x");ELSE setzesonderwert(sonderwert,r);FI ;
+lvmind1malgeplant:=TRUE ;FI ;ELSE setzesonderwert(sonderwert,blank);FI ;
+poszeitINCR 2PER END PROC datendessechstenundsiebtenvordrucksindruckdatei;
+PROC stdplanprowochstdlesenundswsetzen(INT CONST std):INT VAR x,sonderwert:=
+521;INT VAR wochenstd:=std;FOR iFROM 1UPTO maxwochtageREP IF wochenstd<=
+maxwochstdnTHEN string:="";FOR xFROM 1UPTO anzlvgnproschuelergrREP IF (
+zeitenzulv(x)SUB wochenstd)=geplantestdTHEN stringCAT (subtext(zeitenzulv(x),
+maxwochstdn+1,maxwochstdn+laengelv));FI ;PER ;IF length(string)<=laengelv
+THEN planeintraglesen(wochenstd,"L",string,l,r,p);setzesonderwert(sonderwert,
+subtext(l,3,4)+" "+r)ELSE planeintraglesen(wochenstd,"L",subtext(string,1,8),
+l,r,p);setzesonderwert(sonderwert,"*"+datenzurlv("K",l))FI ;wochenstdINCR 
+letztestd;sonderwertINCR 1;ELSE setzesonderwert(sonderwert,blank)FI ;PER ;
+END PROC stdplanprowochstdlesenundswsetzen;PROC 
+stdplanprowochstdlesenswsetzenunddatenprokopplgmerken(INT CONST stunde):INT 
+VAR x,pos,posstring,sonderwert:=521;INT VAR wochenstd:=stunde;TEXT VAR 
+lvposimrow;FOR iFROM 1UPTO maxwochtageREP IF wochenstd<=maxwochstdnTHEN 
+string:="";lvposimrow:=niltext;FOR xFROM 1UPTO anzlvgnproschuelergrREP IF (
+zeitenzulv(x)SUB wochenstd)=geplantestdTHEN stringCAT (subtext(zeitenzulv(x),
+maxwochstdn+1,maxwochstdn+laengelv));lvposimrowCAT text(x,3);FI ;PER ;IF 
+length(lvposimrow)=3THEN planeintraglesen(wochenstd,"L",string,l,r,p);
+setzesonderwert(sonderwert,subtext(l,3,4)+" "+r);ELIF length(lvposimrow)>3
+THEN kopplungsbez:=datenzurlv("K",subtext(string,1,laengelv));setzesonderwert
+(sonderwert,"*"+kopplungsbez);kopplungen(wochenstd):=kopplungsbez;pos:=1;
+posstring:=1;FOR yFROM 1UPTO (length(lvposimrow)DIV 3)REP IF length(
+zeitenzulv(int(subtext(lvposimrow,pos,pos+2))))=maxwochstdn+laengelvTHEN 
+zeitenzulv(int(subtext(lvposimrow,pos,pos+2)))CAT kopplungsbezFI ;posINCR 3;
+posstringINCR 8PER ;ELSE setzesonderwert(sonderwert,blank);FI ;wochenstdINCR 
+letztestd;sonderwertINCR 1;ELSE setzesonderwert(sonderwert,blank)FI ;PER ;
+END PROC stdplanprowochstdlesenswsetzenunddatenprokopplgmerken;END PACKET 
+einzelstdplsek1;
+
diff --git a/app/schulis/2.2.1/src/4.einzelstdpl.sek2 b/app/schulis/2.2.1/src/4.einzelstdpl.sek2
new file mode 100644
index 0000000..17bc9bd
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.einzelstdpl.sek2
@@ -0,0 +1,197 @@
+PACKET einzelstdplsek2DEFINES einzelstdplsek2eingang,einzelstdplsek2starten,
+einzelstdplsek2sonderwerte,einzelstdplsek2multistop,
+einzelstdplsek2druckdateibauen:LET swrufname=511,swfamname=512,swgebdat=513,
+swschuljahr=514,swhalbjahr=515,swtutorkurs=516,swtagesstunde=520,swmozeile1=
+521,swsazeile1=526,swlv=540,swlehrername=541,maske=
+"ms einzelstdpl sek2 eingang",fnr2jgst=2,fnr3famname=3,fnr4rufname=4,
+fnr5gebdat=5,fnr6ausgbs=6,fnr7ausgdr=7,meldnrauswahlunsinnig=56,
+meldnrdatenexistierennicht=59,meldnrbittewarten=69,
+meldnrschuelernichtimentsprbestand=126,meldnrpraezisieren=129,
+meldnrungueltigesdatum=157,meldnrjgstoderschueler=318,
+meldnrkeinestundenplandatenvorhanden=366,meldnrfalschejgstangabe=404,
+maxwochstdn=66,maxanzfaecher=100;INT CONST maxwochtage:=6,erstestd:=1,
+letztestd:=12;LET blank=" ",null=0,niltext="",punkt=".",maxzeichenimvordruck=
+79;TASK VAR vordruckserver;TEXT CONST dateimitueberschrift:=
+"vordruck1 einzelstdpl sek2",dateimitstdplzeilen:=
+"vordruck2 einzelstdpl raeume",dateimiterlauterungen:=
+"vordruck2 einzelstdpl sek2",strich:="-",kreuz:="+",abschlusslinie:=76*strich
++blank,normaletrennlinie:=3*strich+kreuz+5*(11*strich+kreuz)+11*strich+": ",
+lvnichtimbestand:="nicht in Datei 'Lehrveranstaltungen' enthalten ",
+paraphenichtimbestand:=" nicht in Datei 'Lehrer' enthalten ";TEXT VAR hj,sj,
+sjaufber,uebfolgeseiten,famname,rufname,gebdat,jgst,tutorkurs,tutorkursalt,
+hilfsstring,tupelwerthjd,kennungen,faecher,paraphe,anrede,titel,zusatz,name,
+hilfstext,lv,zeile1,zeile2,l:="",r:="",p:="";ROW maxanzfaecherTEXT VAR 
+lehrveranstaltungen;BOOL VAR gesamtesek2,bestjgst,einzelschueler,
+bildschirmausgabe;INT VAR aktuellerindex,gemerkterdbstatus,anzzeilen,
+eingabestatus,i,x,y,z,feldnr,meldnr,zaehler,anzfaecher;PROC 
+einzelstdplsek2eingang:standardvproc(maske)END PROC einzelstdplsek2eingang;
+PROC einzelstdplsek2starten:sj:=schulkenndatum("Schuljahr");hj:=
+schulkenndatum("Schulhalbjahr");IF maskenwerteokTHEN IF stundenplanokTHEN 
+startenausfuehrenELSE meldnr:=meldnrkeinestundenplandatenvorhanden;
+meldefehlerundzurueckzumdialog;FI ;ELSE meldefehlerundzurueckzumdialog;FI ;.
+startenausfuehren:sjaufber:=subtext(sj,1,2)+"/";sjaufberCAT subtext(sj,3,4);
+vordruckserver:=/"anschreiben server";forget(dateimitueberschrift,quiet);
+forget(dateimitstdplzeilen,quiet);forget(dateimiterlauterungen,quiet);fetch(
+dateimitueberschrift,vordruckserver);fetch(dateimitstdplzeilen,vordruckserver
+);fetch(dateimiterlauterungen,vordruckserver);setzesonderwerteschulkenndaten;
+standardmeldung(meldnrbittewarten,niltext);inittupel(dnrhalbjahresdaten);
+putwert(fnrhjdsj,sj);putwert(fnrhjdhj,hj);putwert(fnrhjdfamnames,famname);
+putwert(fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdat);IF 
+einzelschuelerTHEN aktuellerindex:=dnrhalbjahresdaten;ELSE aktuellerindex:=
+ixhjdsjhjjgstkenn;putwert(fnrhjdjgst,jgst);FI ;tutorkursalt:=niltext;
+zusammengesetztesanschreiben(aktuellerindex,bildschirmausgabe,einzelschueler,
+BOOL PROC einzelstdplsek2sonderwerte,BOOL PROC einzelstdplsek2multistop,TEXT 
+PROC einzelstdplsek2druckdateibauen);END PROC einzelstdplsek2starten;PROC 
+meldefehlerundzurueckzumdialog:standardmeldung(meldnr,niltext);return(1)END 
+PROC meldefehlerundzurueckzumdialog;BOOL PROC maskenwerteok:BOOL VAR ok:=
+FALSE ,gesamtesek2:=FALSE ;bestjgst:=FALSE ;einzelschueler:=FALSE ;
+standardpruefe(5,fnr6ausgbs,fnr7ausgdr,null,niltext,eingabestatus);IF 
+eingabestatus<>0THEN meldnr:=meldnrauswahlunsinnig;infeld(fnr6ausgbs);ELSE 
+bildschirmausgabe:=standardmaskenfeld(fnr7ausgdr)=niltext;jgst:=
+standardmaskenfeld(fnr2jgst);famname:=standardmaskenfeld(fnr3famname);rufname
+:=standardmaskenfeld(fnr4rufname);gebdat:=standardmaskenfeld(fnr5gebdat);IF 
+jgst=niltextTHEN IF famname=niltextCAND rufname=niltextCAND gebdat=niltext
+THEN gesamtesek2:=TRUE ;jgst:="11";ok:=TRUE ELSE IF einzelschuelerkorrekt
+THEN einzelschueler:=TRUE ;ok:=TRUE ELSE infeld(feldnr)FI ;FI ;ELSE 
+standardpruefe(2,fnr2jgst,null,null,niltext,eingabestatus);IF eingabestatus<>
+0COR int(jgst)<11COR int(jgst)>13THEN meldnr:=meldnrfalschejgstangabe;infeld(
+fnr2jgst);ELSE IF famname<>niltextCOR rufname<>niltextCOR gebdat<>niltext
+THEN meldnr:=meldnrjgstoderschueler;infeld(fnr2jgst)ELSE bestjgst:=TRUE ;ok:=
+TRUE FI ;FI ;FI ;FI ;okEND PROC maskenwerteok;BOOL PROC stundenplanok:
+stundenplanhalbjahrsetzen(hj,sj);stundenplanbasisundstundenplanholen(
+eingabestatus);eingabestatus=0OR eingabestatus=8END PROC stundenplanok;BOOL 
+PROC einzelschuelerkorrekt:IF famname=niltextTHEN feldnr:=fnr3famname;meldnr
+:=meldnrpraezisieren;LEAVE einzelschuelerkorrektWITH FALSE ;FI ;IF rufname=
+niltextTHEN IF gebdat=niltextTHEN IF famnameeindeutigTHEN rufname:=wert(
+fnrsurufnames);gebdat:=wert(fnrsugebdatums);LEAVE einzelschuelerkorrektWITH 
+TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE ;FI ;ELSE feldnr:=fnr4rufname
+;meldnr:=meldnrpraezisieren;LEAVE einzelschuelerkorrektWITH FALSE ;FI ;ELSE 
+IF gebdat<>niltextTHEN IF kompletterschluesselokundhjddaTHEN LEAVE 
+einzelschuelerkorrektWITH TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE FI 
+;ELSE IF famnameundrufnameeindeutigTHEN gebdat:=wert(fnrsugebdatums);LEAVE 
+einzelschuelerkorrektWITH TRUE ELSE LEAVE einzelschuelerkorrektWITH FALSE FI 
+;FI ;FI ;TRUE END PROC einzelschuelerkorrekt;BOOL PROC famnameeindeutig:
+inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsustatuss,
+"ls");search(dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameTHEN feldnr:=
+fnr3famname;meldnr:=meldnrdatenexistierennicht;LEAVE famnameeindeutigWITH 
+FALSE ;ELSE succ(dnrschueler);IF wert(fnrsufamnames)=famnameTHEN feldnr:=
+fnr4rufname;meldnr:=meldnrpraezisieren;LEAVE famnameeindeutigWITH FALSE ;
+ELSE pred(dnrschueler);FI ;FI ;TRUE END PROC famnameeindeutig;BOOL PROC 
+famnameundrufnameeindeutig:inittupel(dnrschueler);putwert(fnrsufamnames,
+famname);putwert(fnrsurufnames,rufname);putwert(fnrsustatuss,"ls");search(
+dnrschueler,FALSE );IF wert(fnrsufamnames)<>famnameCOR wert(fnrsurufnames)<>
+rufnameTHEN feldnr:=fnr3famname;meldnr:=meldnrdatenexistierennicht;LEAVE 
+famnameundrufnameeindeutigWITH FALSE ELSE succ(dnrschueler);IF wert(
+fnrsufamnames)=famnameAND wert(fnrsurufnames)=rufnameTHEN feldnr:=fnr5gebdat;
+meldnr:=meldnrpraezisieren;LEAVE famnameundrufnameeindeutigWITH FALSE ELSE 
+pred(dnrschueler);FI ;FI ;TRUE END PROC famnameundrufnameeindeutig;BOOL PROC 
+kompletterschluesselokundhjdda:standardpruefe(6,fnr5gebdat,null,null,niltext,
+eingabestatus);IF eingabestatus<>0THEN feldnr:=fnr5gebdat;meldnr:=
+meldnrungueltigesdatum;LEAVE kompletterschluesselokundhjddaWITH FALSE ;FI ;
+hilfstext:=subtext(gebdat,1,2);hilfstextCAT punkt;hilfstextCAT subtext(gebdat
+,3,4);hilfstextCAT punkt;hilfstextCAT subtext(gebdat,5,6);gebdat:=hilfstext;
+inittupel(dnrhalbjahresdaten);putwert(fnrhjdfamnames,famname);putwert(
+fnrhjdrufnames,rufname);putwert(fnrhjdgebdats,gebdat);putwert(fnrhjdsj,sj);
+putwert(fnrhjdhj,hj);search(dnrhalbjahresdaten,TRUE );IF dbstatus<>0THEN 
+feldnr:=fnr3famname;meldnr:=meldnrschuelernichtimentsprbestand;LEAVE 
+kompletterschluesselokundhjddaWITH FALSE ;FI ;TRUE END PROC 
+kompletterschluesselokundhjdda;BOOL PROC einzelstdplsek2multistop:BOOL VAR b;
+IF einzelschuelerTHEN b:=wert(fnrhjdfamnames)=famnameAND wert(fnrhjdrufnames)
+=rufnameAND intwert(fnrhjdjgst)>10AND schulhalbjahrkorrektAND dbstatus=ok
+ELIF bestjgstTHEN b:=wert(fnrhjdjgst)=jgstAND schulhalbjahrkorrektAND 
+dbstatus=okELSE b:=schulhalbjahrkorrektAND dbstatus=okFI ;bENDPROC 
+einzelstdplsek2multistop;BOOL PROC schulhalbjahrkorrekt:intwert(fnrhjdsj)=int
+(sj)AND intwert(fnrhjdhj)=int(hj)END PROC schulhalbjahrkorrekt;BOOL PROC 
+einzelstdplsek2sonderwerte:initialisieresonderwerte;setzesonderwert(
+swschuljahr,sjaufber);setzesonderwert(swhalbjahr,hj);famname:=wert(
+fnrhjdfamnames);rufname:=wert(fnrhjdrufnames);gebdat:=wert(fnrhjdgebdats);
+jgst:=wert(fnrhjdjgst);adressat(famname);setzesonderwert(swrufname,rufname);
+setzesonderwert(swfamname,famname);setzesonderwert(swgebdat,gebdat);tutorkurs
+:=wert(fnrhjdkennung);IF tutorkurs=niltextTHEN gemerkterdbstatus:=dbstatus;
+inittupel(dnrschueler);putwert(fnrsufamnames,famname);putwert(fnrsurufnames,
+rufname);putwert(fnrsugebdatums,gebdat);search(dnrschueler,TRUE );IF dbstatus
+=0THEN tutorkurs:=wert(fnrsusgrpzugtut);FI ;dbstatus(gemerkterdbstatus);FI ;
+gemerkterdbstatus:=dbstatus;inittupel(dnrlehrer);IF tutorkurs<>tutorkursalt
+THEN inittupel(dnraktschuelergruppen);putwert(fnrsgrpsj,sj);putwert(fnrsgrphj
+,hj);putwert(fnrsgrpjgst,jgst);putwert(fnrsgrpkennung,tutorkurs);search(
+dnrlehrveranstaltungen,TRUE );paraphe:=wert(fnrsgrplehrer);IF dbstatus<>0COR 
+paraphe=niltextTHEN hilfsstring:=jgst+blank+tutorkurs;setzesonderwert(
+swtutorkurs,hilfsstring);ELSE hilfsstring:=jgst+blank;hilfsstringCAT paraphe;
+putwert(fnrlparaphe,paraphe);search(dnrlehrer,TRUE );IF wert(fnrlgeschlecht)=
+"m"THEN hilfsstringCAT " Hr. "ELSE hilfsstringCAT " Fr. "FI ;hilfsstringCAT 
+wert(fnrlamtsbeztitel);hilfsstringCAT blank+wert(fnrlzusatz);hilfsstringCAT 
+blank+wert(fnrlfamname);setzesonderwert(swtutorkurs,hilfsstring);FI ;
+tutorkursalt:=tutorkurs;ELSE setzesonderwert(swtutorkurs,hilfsstring);FI ;
+dbstatus(gemerkterdbstatus);TRUE END PROC einzelstdplsek2sonderwerte;TEXT 
+PROC einzelstdplsek2druckdateibauen:LET stddruckdatei="liste.1",druckdatei=
+"Stundenplan",hilfsdatei="hilfsdatei";FILE VAR f;forget(druckdatei,quiet);
+setzemitseitennummern(TRUE );druckvorbereiten;setzeanzahlderzeichenprozeile(
+maxzeichenimvordruck);jgst:=wert(fnrhjdjgst);faecher:=wert(fnrhjdfach);
+kennungen:=wert(fnrhjdlerngrpkenn);lehrveranstaltungenimrowmerken;
+uebfolgeseiten:="Erläuterungen zum Stundenplan: "+rufname+blank+famname+" ("+
+sjaufber+","+hj+") ";anzzeilen:=1;briefalternative(dateimitueberschrift,
+hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,
+quiet);FOR xFROM erstestdUPTO letztestdREP vordruckzweiindruckdatei(x)PER ;
+ueberschriftenfuererlaeuterungenindruckdatei;FOR zaehlerFROM 1UPTO anzfaecher
+REP IF anzzeilen>drucklaengeTHEN seitenwechsel;druckzeileschreiben(
+uebfolgeseiten);druckzeileschreiben(blank);spaltenueberschriftenindruckdatei;
+anzzeilenINCR 4;FI ;vordruckdreiindruckdatei(zaehler)PER ;
+drucknachbereitenohneausdrucken;rename(stddruckdatei,druckdatei);f:=
+sequentialfile(modify,druckdatei);toline(f,1);input(f);druckdatei.
+lehrveranstaltungenimrowmerken:FOR iFROM 1UPTO maxanzfaecherREP 
+lehrveranstaltungen(i):=niltextPER ;anzfaecher:=length(faecher)DIV 2;FOR i
+FROM 1UPTO anzfaecherREP lehrveranstaltungen(i):=jgst+subtext(faecher,1,2)+
+subtext(kennungen,1,4);faecher:=subtext(faecher,3,length(faecher));kennungen
+:=subtext(kennungen,5,length(kennungen));PER ;.
+ueberschriftenfuererlaeuterungenindruckdatei:IF anzzeilen+6>drucklaengeTHEN 
+seitenwechsel;druckzeileschreiben(uebfolgeseiten);druckzeileschreiben(blank);
+anzzeilen:=3;FI ;zeile1:=blank;druckzeileschreiben(zeile1);zeile1:=
+"Erläuterungen: ";druckzeileschreiben(zeile1);zeile1:=blank;
+druckzeileschreiben(zeile1);spaltenueberschriftenindruckdatei;anzzeilenINCR 6
+;END PROC einzelstdplsek2druckdateibauen;PROC 
+spaltenueberschriftenindruckdatei:zeile1:="Lehrveranstaltung : Lehrer ";
+druckzeileschreiben(zeile1);zeile1:="------------------:"+56*"-"+blank;
+druckzeileschreiben(zeile1);END PROC spaltenueberschriftenindruckdatei;PROC 
+zeilenweisehilfsdateiindruckdatei(TEXT CONST hilfsdatei):TEXT VAR zeile:=
+niltext;FILE VAR f;f:=sequentialfile(input,hilfsdatei);FOR iFROM 1UPTO lines(
+f)REP getline(f,zeile);anzzeilenINCR 1;IF anzzeilen<drucklaengeTHEN 
+druckzeileschreiben(zeile);ELSE seitenwechsel;druckzeileschreiben(
+uebfolgeseiten);druckzeileschreiben(blank);druckzeileschreiben(zeile);
+anzzeilen:=3;FI ;PER ;END PROC zeilenweisehilfsdateiindruckdatei;PROC 
+vordruckzweiindruckdatei(INT CONST std):LET hilfsdatei="hilfsdatei";TEXT VAR 
+zeile:=niltext;FILE VAR f;setzesonderwert(swtagesstunde,text(std,2));
+stdplanprowochstdlesenundswsetzen(std);briefalternative(dateimitstdplzeilen,
+hilfsdatei);zeilenweisehilfsdateiindruckdatei(hilfsdatei);f:=sequentialfile(
+input,hilfsdatei);IF std<>letztestdTHEN zeile:=normaletrennlinieELSE zeile:=
+abschlusslinieFI ;druckzeileschreiben(zeile);anzzeilenINCR 1;forget(
+hilfsdatei,quiet);END PROC vordruckzweiindruckdatei;PROC 
+vordruckdreiindruckdatei(INT CONST index):LET hilfsdatei="hilfsdatei";TEXT 
+VAR zeile:=niltext;FILE VAR f;hilfstext:=lehrveranstaltungen(index);lv:=
+subtext(hilfstext,1,2)+blank;lvCAT subtext(hilfstext,3,4)+blank;lvCAT subtext
+(hilfstext,5,8);setzesonderwert(swlv,lv);gemerkterdbstatus:=dbstatus;
+inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,sj);putwert(fnrlvhj,hj);
+putwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,compress(subtext(hilfstext,3
+,8)));search(dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN setzesonderwert
+(swlehrername,lvnichtimbestand);ELSE inittupel(dnrlehrer);putwert(fnrlparaphe
+,wert(fnrlvparaphe));search(dnrlehrer,TRUE );IF dbstatus<>0THEN 
+setzesonderwert(swlehrername,"Paraphe "+wert(fnrlvparaphe)+
+paraphenichtimbestand)ELSE anredetitelusfzusammensetzten;setzesonderwert(
+swlehrername,anrede+titel+name)FI ;FI ;dbstatus(gemerkterdbstatus);
+briefalternative(dateimiterlauterungen,hilfsdatei);
+zeilenweisehilfsdateiindruckdatei(hilfsdatei);forget(hilfsdatei,quiet);.
+anredetitelusfzusammensetzten:IF wert(fnrlgeschlecht)="w"THEN anrede:="Fr. "
+ELSE anrede:="Hr. "FI ;titel:=wert(fnrlamtsbeztitel);zusatz:=wert(fnrlzusatz)
+;name:=blank+wert(fnrlfamname);IF length(titel)>0THEN titelCAT blank;titel
+CAT zusatzELSE titel:=zusatzFI ;END PROC vordruckdreiindruckdatei;PROC 
+stdplanprowochstdlesenundswsetzen(INT CONST std):INT VAR sonderwert;INT VAR 
+wochenstd:=std;FOR sonderwertFROM swmozeile1UPTO swsazeile1REP zaehler:=1;IF 
+wochenstd<=maxwochstdnTHEN WHILE zaehler<=anzfaecherAND NOT lvgeplant(
+wochenstd,lehrveranstaltungen(zaehler))REP zaehlerINCR 1;PER ;IF zaehler>
+anzfaecherTHEN setzesonderwert(sonderwert,niltext);setzesonderwert(sonderwert
++6,niltext);ELSE lv:=lehrveranstaltungen(zaehler);planeintraglesen(wochenstd,
+"L",lv,l,r,p);zeile1:=subtext(lv,1,2)+blank;zeile1CAT subtext(lv,3,8);zeile2
+:=text(r,10);setzesonderwert(sonderwert,zeile1);setzesonderwert(sonderwert+6,
+zeile2);FI ;wochenstdINCR letztestd;ELSE zeile2:=niltext;setzesonderwert(
+sonderwert,zeile2);setzesonderwert(sonderwert+6,zeile2);FI ;PER ;END PROC 
+stdplanprowochstdlesenundswsetzen;END PACKET einzelstdplsek2;
+
diff --git a/app/schulis/2.2.1/src/4.faecherangebot drucken b/app/schulis/2.2.1/src/4.faecherangebot drucken
new file mode 100644
index 0000000..f38c047
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.faecherangebot drucken
@@ -0,0 +1,110 @@
+PACKET druckefaecherangebotDEFINES faecherangebotspezielleteile:LET AUSGFELD 
+=ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,ausgfeldlaenge=1,
+ausgkopflaenge=2,sj="Schuljahr",hj="Schulhalbjahr",ueberschrzeilen=1,
+ausgabeparam="#",jg="Jgst.",fc="Fach",ar="Art",ws="Wstd.",an=
+"Anz. Lehrveranst.",eingmaske="ms liste faecherangebot",meldungbearb=352,
+meldungpraez=129,fldgeplshj=2,fldaktshj=3,fldsortjgst=4,fldsortfach=5,
+fldaufdr=6,fldaufbs=7,zeilenanzahl=17,jgstbezbreite=5,fachbezbreite=4,
+artbezbreite=3,wstdbezbreite=5,anzbezbreite=17;AUSGFELD VAR ausgfeld;
+AUSGKOPF VAR ausgkopf;INT VAR i,status,index,druckzeilenzahl;TEXT VAR 
+geplschj,geplschhj,aktschj,aktschhj,schj,schhj:="0";TEXT VAR meldungaltejgst
+:="",meldungaltesfach:="",altejgst:="",altesfach:="",jgst,fach,art,wstd,anzlv
+,druckstrich,faecherangebotueberschrift;BOOL VAR erstezeile;BOOL PROC 
+multistop:IF dbstatus=okTHEN LEAVE multistopWITH wert(fnrfanghj)=schhjCAND 
+wert(fnrfangsj)=schjFI ;FALSE END PROC multistop;BOOL PROC multistopsim:IF 
+dbstatus=okTHEN IF wert(fnrfanghj)=schhjCAND wert(fnrfangsj)=schjTHEN LEAVE 
+multistopsimWITH TRUE ELSE setzebestandende(TRUE );LEAVE multistopsimWITH 
+FALSE FI ELSE setzebestandende(TRUE )FI ;FALSE END PROC multistopsim;PROC 
+holeakthj:holakthj;holaktj;bergeplhjuj.holakthj:aktschhj:=schulkenndatum(hj).
+holaktj:aktschj:=schulkenndatum(sj).bergeplhjuj:geplschhj:=aktschhj;geplschj
+:=aktschj;geplanteshjundsjberechnen(geplschhj,geplschj).END PROC holeakthj;
+PROC faecherangebotspezielleteile(INT CONST anwahl):SELECT anwahlOF CASE 1:
+faecherangebotdialogvorbereitenCASE 2:faecherangebotrichtigCASE 3:
+faecherangebotlistenvorbereitenCASE 4:faecherangebotdruckvorbereitenCASE 5:
+faecherangebotseitedruckenCASE 6:faecherangebotbsvorbereitenCASE 7:
+faecherangebotseitezeigenEND SELECT .END PROC faecherangebotspezielleteile;
+PROC faecherangebotdialogvorbereiten:holeakthj;faecherangebotueberschrift:=
+text(vergleichsknoten);setzeanfangswerte(eingmaske,fldgeplshj)END PROC 
+faecherangebotdialogvorbereiten;PROC faecherangebotrichtig:IF (
+standardmaskenfeld(fldgeplshj)=""CAND standardmaskenfeld(fldaktshj)="")COR (
+standardmaskenfeld(fldsortjgst)=""CAND standardmaskenfeld(fldsortfach)="")
+COR (standardmaskenfeld(fldaufdr)=""CAND standardmaskenfeld(fldaufbs)="")
+THEN standardmeldung(meldungpraez,"");setzeeingabetest(FALSE );infeld(
+fldgeplshj);LEAVE faecherangebotrichtigFI ;standardpruefe(5,fldgeplshj,
+fldaktshj,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest(
+FALSE )ELSE standardpruefe(5,fldsortjgst,fldsortfach,0,"",status);IF status<>
+0THEN infeld(status);setzeeingabetest(FALSE )ELSE standardpruefe(5,fldaufdr,
+fldaufbs,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest(FALSE 
+)ELSE IF standardmaskenfeld(fldgeplshj)<>""THEN schj:=geplschj;schhj:=
+geplschhjELSE schj:=aktschj;schhj:=aktschhjFI ;IF standardmaskenfeld(
+fldsortjgst)<>""THEN index:=dnrfaecherangebot;setzescanendewert("255")ELSE 
+index:=ixfangsjhjfach;setzescanendewert("�")FI ;setzeausgabedrucker(
+standardmaskenfeld(fldaufdr)<>"");setzeeingabetest(TRUE );FI ;FI ;FI END 
+PROC faecherangebotrichtig;PROC faecherangebotlistenvorbereiten:BOOL VAR b;
+inittupel(dnrfaecherangebot);initobli(zeilenanzahl);reinitparsing;
+setzeidentiwert("");setzewerte;objektlistestarten(index,schj,staticfield,
+TRUE ,b);setzebestandende(NOT multistopCOR b).setzewerte:putwert(fnrfangsj,
+schj);putwert(fnrfanghj,schhj).staticfield:IF index=dnrfaecherangebotTHEN 
+fnrfangjgstELSE fnrfangfachFI .END PROC faecherangebotlistenvorbereiten;PROC 
+faecherangebotbsvorbereiten:standardkopfmaskeaktualisieren(
+faecherangebotueberschrift+" für "+schhj+". "+text(schj,2)+"/"+subtext(schj,3
+));initspalten;setzespaltentrenner("       ");setzespaltenbreiten;
+initausgabekopf(bildbreite*"-");ausgkopf(1)IN 2;ausgkopf(2)IN 3;
+setzebildanfangsposition(4).END PROC faecherangebotbsvorbereiten;PROC 
+setzespaltenbreiten:setzespaltenbreite(jgstbezbreite);setzespaltenbreite(
+fachbezbreite);setzespaltenbreite(artbezbreite);setzespaltenbreite(
+wstdbezbreite);setzespaltenbreite(anzbezbreite);END PROC setzespaltenbreiten;
+PROC faecherangebotseitezeigen:altejgst:="";blaettern(PROC (INT CONST )
+faecherangebotzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop);END PROC 
+faecherangebotseitezeigen;PROC faecherangebotzeigen(INT CONST procparameter):
+faecherangebotholen;faecherangebotaufbereiten;faecherangebotaufbs;END PROC 
+faecherangebotzeigen;PROC faecherangebotholen:jgst:=text(intwert(fnrfangjgst)
+,2);fach:=wert(fnrfangfach);art:=wert(fnrfangart);wstd:=text(intwert(
+fnrfangwochenstd),2);anzlv:=text(intwert(fnrfanganzlv),2);IF NOT multistop
+THEN setzebestandende(TRUE )FI .END PROC faecherangebotholen;PROC 
+faecherangebotaufbereiten:IF jgst<>altejgstTHEN spaltenweise(jgst);altejgst:=
+jgstELSE spaltenweise(" ")FI ;spaltenweise(fach);spaltenweise(art);
+spaltenweise(wstd);spaltenweise(anzlv);ausgfeld(1):=zeile.END PROC 
+faecherangebotaufbereiten;PROC faecherangebotaufbs:ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeinsEND PROC faecherangebotaufbs;PROC initausgabekopf(
+TEXT CONST t):spaltenweise(jg);spaltenweise(fc);spaltenweise(ar);spaltenweise
+(ws);spaltenweise(an);ausgkopf(1):=zeile;ausgkopf(2):=t;END PROC 
+initausgabekopf;PROC faecherangebotdruckvorbereiten:druckvorbereiten;
+variablensetzen;initdruckkopf(zentriert(faecherangebotueberschrift+" für "+
+schhj+". "+text(schj,2)+"/"+subtext(schj,3),druckbreite));initspalten;
+setzespaltentrenner("       ");setzespaltenbreiten;initausgabekopf(
+druckbreite*"-");inittupel(index);setzebestandende(FALSE );setzewerte;
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistopsim).variablensetzen:druckstrich:=druckbreite*"-";
+druckzeilenzahl:=drucklaenge(ueberschrzeilen)-ausgkopflaenge.setzewerte:
+putwert(fnrfangsj,schj);putwert(fnrfanghj,schhj).END PROC 
+faecherangebotdruckvorbereiten;PROC faecherangebotseitedrucken:altejgst:="";
+altesfach:="";erstezeile:=TRUE ;faecherangebotueberschriftdrucken;
+seitedrucken(PROC (INT VAR )faecherangebotdrucken,druckzeilenzahl,
+ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel;END PROC 
+faecherangebotseitedrucken;PROC faecherangebotueberschriftdrucken:
+druckkopfschreiben;FOR iFROM 1UPTO ausgkopflaengeREP druckzeileschreiben(
+ausgkopf(i))PER .END PROC faecherangebotueberschriftdrucken;PROC 
+faecherangebotdrucken(INT VAR zz):faecherangebotholen;IF index=
+dnrfaecherangebotTHEN IF meldungaltejgst<>jgstTHEN meldungaltejgst:=jgst;
+standardmeldung(meldungbearb,"Jgst. "+jgst+ausgabeparam)FI ;ELSE IF 
+meldungaltesfach<>fachTHEN meldungaltesfach:=fach;standardmeldung(
+meldungbearb,"Fach "+fach+ausgabeparam)FI ;FI ;
+faecherangebotaufbereitenmitleerzeile(zz);faecherangebotindruckdatei(zz);IF 
+zz>=druckzeilenzahl-1THEN zzINCR ausgfeldlaengeFI .END PROC 
+faecherangebotdrucken;PROC faecherangebotaufbereitenmitleerzeile(INT VAR zz):
+IF index=dnrfaecherangebotTHEN IF jgst<>altejgstTHEN gibleerzeileaus;
+spaltenweise(jgst)ELSE spaltenweise(" ")FI ELSE IF fach<>altesfachTHEN 
+gibleerzeileaus;altejgst:=""FI ;IF jgst<>altejgstTHEN spaltenweise(jgst)ELSE 
+spaltenweise(" ")FI FI ;spaltenweise(fach);spaltenweise(art);spaltenweise(
+wstd);spaltenweise(anzlv);ausgfeld(1):=zeile.gibleerzeileaus:IF NOT 
+erstezeileTHEN spaltenweise(" ");spaltenweise(" ");spaltenweise(" ");
+spaltenweise(" ");spaltenweise(" ");ausgfeld(1):=zeile;
+faecherangebotindruckdatei(zz)FI .END PROC 
+faecherangebotaufbereitenmitleerzeile;PROC faecherangebotindruckdatei(INT 
+VAR zz):zzINCR ausgfeldlaenge;IF jgst<>altejgstTHEN altejgst:=jgstFI ;IF fach
+<>altesfachCAND index=ixfangsjhjfachTHEN altesfach:=fachFI ;IF erstezeile
+THEN erstezeile:=FALSE FI ;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfeld(i))PER END PROC faecherangebotindruckdatei;END 
+PACKET druckefaecherangebot
+
diff --git a/app/schulis/2.2.1/src/4.faecherangebot planen b/app/schulis/2.2.1/src/4.faecherangebot planen
new file mode 100644
index 0000000..91d301d
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.faecherangebot planen
@@ -0,0 +1,369 @@
+PACKET planefaecherangebotDEFINES fachangpruefuebern,fachangpruefbearb,
+fachangmodbldsch,fachangstdvproc,fachanguebern,fachangspeichern:LET sj=
+"Schuljahr",hj="Schulhalbjahr",art="c02 art lehrveranstaltung",eingmaske=
+"ms erf faecherangebot",bearbmaske="ms bearb faecherangebot",
+kennzeichnunggeplant="geplant",maxzahl=99,minzahl=0,bearbzl=19,jgstfeldnr=10,
+meldg0=56,meldg1=300,meldg3=302,meldg4=303,meldg5=304,meldg6=305,meldg7=306,
+meldg8=307,meldg9=308,meldg11=310,meldg12=311,meldg10=318,meldg13=315,meldg14
+=312,meldg15=313,meldg16=314,meldg17=69,meldg18=57,meldg19=50,trenner="�";
+ROW 10TEXT VAR eingbldsch;ROW bearbzlINT VAR dbsatzbsnr;ROW bearbzlSTRUCT (
+TEXT fach,TEXT art,TEXT wstd,TEXT anz)VAR bearbbldsch;ROW bearbzlSTRUCT (
+TEXT fach,TEXT art,TEXT wstd,TEXT anz,)VAR dbinh;INT VAR i,j,k,letztepos:=2,
+status,zeignr:=1,z1dbnr:=1,nzaehler:=0,ersteeinfuegezeile:=1,bszeiger:=1,
+dbzeiger:=1,letztejgst:=1,anzbssaetze,anzdbsaetze,letztebearbzeile:=0;TEXT 
+VAR fa:="",ar:="",ws:="",an:="",tupel:="",fachkatalog,artkatalog,
+maskenkopferg:="";INT VAR aktzeile:=0;TEXT VAR aktschhj:="0",aktschj:="0",
+geplschhj:="0",geplschj:="0";BOOL VAR okay:=TRUE ,rueck,istfehler,neu:=FALSE 
+,dbfa2,bldfa2,f2:=FALSE ,f3:=FALSE ,f6:=FALSE ,modifsatzgeprueft:=FALSE ,
+keinescn:=TRUE ,saetzeunveraendert;PROC holeaktdaten:statleseschleife(
+dnrfaecher,"","",fnrffach,fnrffach,PROC fachcat);statleseschleife(
+dnrschluessel,art,"",fnrschlsachgebiet,fnrschlschluessel,PROC artcat)END 
+PROC holeaktdaten;PROC holeakthj:aktschhj:=schulkenndatum(hj);aktschj:=
+schulkenndatum(sj);geplschhj:=aktschhj;geplschj:=aktschj;
+geplanteshjundsjberechnen(geplschhj,geplschj);maskenkopferg:=text(
+vergleichsknoten)+" "+geplschhj+". "+text(geplschj,2)+"/"+subtext(geplschj,3)
+END PROC holeakthj;PROC initrows:fachkatalog:=trenner;artkatalog:=trenner;
+FOR iFROM 1UPTO 10REP eingbldsch(i):=""PER ;FOR iFROM 1UPTO bearbzlREP 
+bearbbldsch(i).fach:="";bearbbldsch(i).art:="";bearbbldsch(i).wstd:="";
+bearbbldsch(i).anz:="";dbsatzbsnr(i):=0;dbinh(i).fach:="";dbinh(i).art:="";
+dbinh(i).wstd:="";dbinh(i).anz:="";PER ;END PROC initrows;PROC 
+fachangpruefuebern:merkeeingsch;f2:=FALSE ;f3:=FALSE ;f6:=FALSE ;okay:=TRUE ;
+fall1;fall2;fall3;fall6;fall9;IF okayTHEN merkeeingsch;standardmeldung(meldg1
+,"");standardnprocELSE IF NOT rueckTHEN fachangzurueckmitmeldg(meldg0,1,
+letztepos,"")FI FI .fall1:IF eingbldsch(2)=""CAND eingbldsch(3)=""CAND 
+eingbldsch(6)=""THEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE 
+fachangpruefuebernFI .fall2:IF eingbldsch(2)<>""THEN f2:=TRUE ;prueferestFI .
+prueferest:FOR iFROM 3UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE ;
+letztepos:=2;FI PER .fall3:IF eingbldsch(3)<>""CAND okayTHEN f3:=TRUE ;
+pruefandereFI .pruefandere:IF eingbldsch(2)<>""THEN okay:=FALSE FI ;FOR i
+FROM 6UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE FI PER ;IF NOT okay
+THEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE fachangpruefuebernFI ;IF 
+eingbldsch(4)=""CAND okayTHEN fachangzurueckmitmeldg(meldg5,1,4,"");LEAVE 
+fachangpruefuebernFI ;IF eingbldsch(5)=""CAND okayTHEN fachangzurueckmitmeldg
+(meldg5,1,5,"");LEAVE fachangpruefuebernFI ;pruefjgst(4);IF NOT okayTHEN 
+LEAVE fachangpruefuebernFI ;pruefjgst(5);IF NOT okayTHEN LEAVE 
+fachangpruefuebernFI .fall6:IF eingbldsch(6)<>""CAND okayTHEN f6:=TRUE ;
+pruefnochFI .pruefnoch:FOR iFROM 2UPTO 5REP IF eingbldsch(i)<>""THEN okay:=
+FALSE FI PER ;FOR iFROM 9UPTO 10REP IF eingbldsch(i)<>""THEN okay:=FALSE FI 
+PER ;IF NOT okayTHEN fachangzurueckmitmeldg(meldg0,1,0,"");LEAVE 
+fachangpruefuebernFI ;IF eingbldsch(7)=""CAND okayTHEN fachangzurueckmitmeldg
+(meldg5,1,7,"");LEAVE fachangpruefuebernFI ;IF eingbldsch(8)=""CAND okayTHEN 
+fachangzurueckmitmeldg(meldg5,1,8,"");LEAVE fachangpruefuebernFI ;pruefjgst(7
+);IF NOT okayTHEN LEAVE fachangpruefuebernFI ;pruefjgst(8);IF NOT okayTHEN 
+LEAVE fachangpruefuebernFI ;IF eingbldsch(7)=eingbldsch(8)THEN 
+fachangzurueckmitmeldg(meldg0,1,7,"");LEAVE fachangpruefuebernFI .fall9:IF 
+eingbldsch(9)<>""COR eingbldsch(10)<>""CAND okayTHEN IF NOT rueckTHEN 
+fachangzurueckmitmeldg(meldg10,1,letztepos,"")FI ;LEAVE fachangpruefuebernFI 
+.END PROC fachangpruefuebern;PROC fachangpruefbearb:standardmeldung(meldg17,
+" ");merkeeingsch;okay:=TRUE ;FOR iFROM 2UPTO 8REP IF eingbldsch(i)<>""THEN 
+fachangzurueckmitmeldg(meldg10,1,i,"");LEAVE fachangpruefbearbFI ;PER ;IF 
+eingbldsch(9)=""CAND okayTHEN fachangzurueckmitmeldg(meldg0,1,i,"");LEAVE 
+fachangpruefbearbFI ;IF eingbldsch(10)=""THEN fachangzurueckmitmeldg(meldg5,1
+,10,"");LEAVE fachangpruefbearbELSE pruefjgst(10);FI ;IF okayCAND eingbldsch(
+10)<>""THEN erfasstefelderausgeben(zeignr);standardnprocELSE IF NOT rueck
+THEN fachangzurueckmitmeldg(meldg0,1,0,"")FI FI .END PROC fachangpruefbearb;
+PROC pruefjgst(INT CONST eingbldschindex):rueck:=FALSE ;IF compress(
+eingbldsch(eingbldschindex))="0"COR eingbldsch(eingbldschindex)="00"THEN 
+LEAVE pruefjgstELIF int(eingbldsch(eingbldschindex))>4CAND int(eingbldsch(
+eingbldschindex))<14THEN LEAVE pruefjgstELSE fachangzurueckmitmeldg(meldg6,1,
+0,"");okay:=FALSE ;rueck:=TRUE ;infeld(eingbldschindex);FI END PROC pruefjgst
+;PROC pruefdbfd(TEXT CONST objekt,katalog):IF pos(katalog,trenner+objekt+
+trenner)<1THEN istfehler:=TRUE ;IF katalog=fachkatalogTHEN 
+fachangzurueckmitmeldg(meldg11,0,i*4-1,"")ELSE fachangzurueckmitmeldg(meldg12
+,0,i*4,"")FI FI .END PROC pruefdbfd;PROC prueftypfd(INT CONST feld):
+standardpruefe(3,feld,minzahl,maxzahl,"",status);IF status>0THEN istfehler:=
+TRUE ;infeld(feld)FI END PROC prueftypfd;PROC fachangstdvproc:gibeingschaus;
+standardnproc.END PROC fachangstdvproc;PROC gibeingschaus:zeignr:=1;
+standardstartproc(eingmaske);gibeingbldschaus;infeld(2);
+standardfelderausgeben;infeld(letztepos).gibeingbldschaus:FOR iFROM 1UPTO 10
+REP standardmaskenfeld(eingbldsch(i),i);IF eingbldsch(i)<>""THEN letztepos:=i
+FI PER .END PROC gibeingschaus;PROC erfasstefelderausgeben(INT CONST znr):
+ersteeinfuegezeile:=1;keinescn:=TRUE ;IF aktschhj="0"THEN holeakthjFI ;z1dbnr
+:=znr;anzdbsaetze:=0;j:=1;IF znr=1THEN loeschedbinh;standardstartproc(
+bearbmaske);standardkopfmaskeaktualisieren(maskenkopferg);standardmaskenfeld(
+eingbldsch(jgstfeldnr),2);ELSE loeschefelder;FI ;putwert(fnrfangsj,geplschj);
+putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(jgstfeldnr
+)));putintwert(fnrfanglfdnr,znr);search(dnrfaecherangebot,FALSE );IF dbstatus
+<>okTHEN gibleerenbildschirmELIF wert(fnrfangsj)=geplschjCAND intwert(
+fnrfanglfdnr)=znrCAND intwert(fnrfangjgst)=int(eingbldsch(jgstfeldnr))CAND 
+wert(fnrfanghj)=geplschhjTHEN z1dbnr:=intwert(fnrfanglfdnr);k:=1;
+startebildschirmblock(dnrfaecherangebot,bearbzl-1);bildschirmblock(PROC 
+gibbearbzeileaus,BOOL PROC (INT CONST )pruefung,i);neu:=FALSE ;ELSE 
+gibleerenbildschirmFI ;infeld(2);standardfelderausgeben;infeld(k*4-1).
+gibleerenbildschirm:infeld(2);standardfelderausgeben;infeld(3);IF znr=1THEN 
+neu:=TRUE ;FI ;LEAVE erfasstefelderausgeben.loeschedbinh:FOR iFROM 1UPTO 
+bearbzlREP dbsatzbsnr(i):=0;dbinh(i).fach:="";dbinh(i).art:="";dbinh(i).wstd
+:="";dbinh(i).anz:="";PER .loeschefelder:FOR iFROM 1UPTO bearbzlREP dbinh(i).
+fach:="";dbinh(i).art:="";dbinh(i).wstd:="";dbinh(i).anz:="";PER ;
+standardstartproc(bearbmaske);standardkopfmaskeaktualisieren(maskenkopferg);
+standardmaskenfeld(eingbldsch(jgstfeldnr),2).END PROC erfasstefelderausgeben;
+PROC gibbearbzeileaus:merkdbwerte;standardmaskenfeld(fa,k*4-1);
+standardmaskenfeld(ar,k*4);standardmaskenfeld(ws,k*4+1);standardmaskenfeld(an
+,k*4+2);IF k<bearbzlTHEN kINCR 1FI .merkdbwerte:fa:=wert(fnrfangfach);ar:=
+wert(fnrfangart);ws:=wert(fnrfangwochenstd);an:=wert(fnrfanganzlv);dbinh(k).
+fach:=fa;dbinh(k).art:=ar;dbinh(k).wstd:=ws;dbinh(k).anz:=an;anzdbsaetzeINCR 
+1;dbsatzbsnr(k):=k.END PROC gibbearbzeileaus;BOOL PROC pruefung(INT CONST i):
+int(eingbldsch(jgstfeldnr))=intwert(fnrfangjgst)CAND geplschhj=wert(fnrfanghj
+)CAND geplschj=wert(fnrfangsj)END PROC pruefung;PROC merkeeingsch:FOR iFROM 1
+UPTO 10REP eingbldsch(i):=standardmaskenfeld(i)PER ;END PROC merkeeingsch;
+PROC fachcat(BOOL VAR b):fachkatalogCAT wert(fnrffach)+trenner;END PROC 
+fachcat;PROC artcat(BOOL VAR b):IF wert(fnrschlsachgebiet)>artCOR dbstatus<>0
+THEN b:=TRUE ELSE artkatalogCAT wert(fnrschlschluessel)+trennerFI END PROC 
+artcat;PROC merkebearbsch:anzbssaetze:=0;FOR iFROM 1UPTO letztebearbzeileREP 
+bearbbldsch(i).fach:=standardmaskenfeld((i-1)*4+3);bearbbldsch(i).art:=
+standardmaskenfeld((i-1)*4+4);bearbbldsch(i).wstd:=standardmaskenfeld((i-1)*4
++5);bearbbldsch(i).anz:=standardmaskenfeld((i-1)*4+6);IF compress(bearbbldsch
+(i).fach)<>""THEN anzbssaetzeINCR 1FI PER ;IF letztebearbzeile<bearbzlTHEN 
+FOR iFROM letztebearbzeile+1UPTO bearbzlREP bearbbldsch(i).fach:="";
+bearbbldsch(i).art:="";bearbbldsch(i).wstd:="";bearbbldsch(i).anz:="";PER FI 
+END PROC merkebearbsch;PROC fachangzurueckmitmeldg(INT CONST meldg,
+ruecksprung,feld,TEXT CONST markiert):standardmeldung(meldg,markiert);IF feld
+>0THEN infeld(feld)FI ;IF ruecksprung>0THEN return(ruecksprung)FI END PROC 
+fachangzurueckmitmeldg;PROC fachanguebern(BOOL CONST b):IF bTHEN IF aktschhj=
+"0"THEN holeakthjFI ;letztejgst:=1;IF f2THEN uebernaktkompELIF f3THEN 
+uebernaktpartELIF f6THEN ueberngeplpartFI ;aenderungsvermerksetzen(
+kennzeichnunggeplant)ELSE standardmeldung(meldg4,"");infeld(2);return(2)FI 
+END PROC fachanguebern;PROC uebernaktkomp:putwert(fnrfangsj,aktschj);putwert(
+fnrfanghj,aktschhj);putintwert(fnrfangjgst,0);putintwert(fnrfanglfdnr,1);
+search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN 
+meldungdatennichtuebernommenELIF wert(fnrfangsj)<>aktschjCAND wert(fnrfanghj)
+<>aktschhjTHEN meldungdatennichtuebernommenELSE savetupel(dnrfaecherangebot,
+tupel);loeschevorhandenesaetze(2);restoretupel(dnrfaecherangebot,tupel);
+schreibtupelFI ;korrtupelindbpuffer;succ(dnrfaecherangebot);WHILE dbstatus=ok
+CAND wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjREP schreibtupel;
+korrtupelindbpuffer;succ(dnrfaecherangebot);PER ;meldungdatenuebernommen.
+meldungdatenuebernommen:return(2);standardmeldung(meldg3,"");LEAVE 
+uebernaktkomp.meldungdatennichtuebernommen:return(2);standardmeldung(meldg13,
+"");LEAVE uebernaktkomp.schreibtupel:putwert(fnrfangsj,geplschj);putwert(
+fnrfanghj,geplschhj);putintwert(fnrfangjgst,intwert(fnrfangjgst));putintwert(
+fnrfanglfdnr,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach));
+putwert(fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert(
+fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));IF intwert(
+fnrfangjgst)<>letztejgstTHEN standardmeldung(meldg14,text(intwert(fnrfangjgst
+))+"#");letztejgst:=intwert(fnrfangjgst);FI ;insert(dnrfaecherangebot).
+korrtupelindbpuffer:putwert(fnrfangsj,aktschj);putwert(fnrfanghj,aktschhj).
+END PROC uebernaktkomp;PROC uebernaktpart:putwert(fnrfangsj,aktschj);putwert(
+fnrfanghj,aktschhj);putintwert(fnrfangjgst,int(eingbldsch(4)));putintwert(
+fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN 
+meldungdatennichtuebernommenELIF intwert(fnrfangjgst)=int(eingbldsch(4))CAND 
+wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjTHEN savetupel(
+dnrfaecherangebot,tupel);loeschevorhandenesaetze(5);restoretupel(
+dnrfaecherangebot,tupel);standardmeldung(meldg14,eingbldsch(5)+"#");
+schreibtupelELSE meldungdatennichtuebernommenFI ;korrtupelindbpuffer;succ(
+dnrfaecherangebot);WHILE dbstatus=okCAND intwert(fnrfangjgst)=int(eingbldsch(
+4))CAND wert(fnrfanghj)=aktschhjCAND wert(fnrfangsj)=aktschjREP schreibtupel;
+korrtupelindbpuffer;succ(dnrfaecherangebot);PER ;meldungdatenuebernommen.
+meldungdatenuebernommen:return(2);standardmeldung(meldg3,"");LEAVE 
+uebernaktpart.meldungdatennichtuebernommen:return(2);standardmeldung(meldg13,
+"");LEAVE uebernaktpart.schreibtupel:putwert(fnrfangsj,geplschj);putwert(
+fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(5)));putintwert(
+fnrfanglfdnr,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach));
+putwert(fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert(
+fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));insert(
+dnrfaecherangebot).korrtupelindbpuffer:putwert(fnrfangsj,aktschj);putwert(
+fnrfanghj,aktschhj);putintwert(fnrfangjgst,int(eingbldsch(4))).END PROC 
+uebernaktpart;PROC ueberngeplpart:putwert(fnrfangsj,geplschj);putwert(
+fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(7)));putintwert(
+fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN 
+meldungdatennichtuebernommenELIF wert(fnrfangsj)<>geplschjCAND intwert(
+fnrfangjgst)<>int(eingbldsch(7))CAND wert(fnrfanghj)<>geplschhjTHEN 
+meldungdatennichtuebernommenELSE savetupel(dnrfaecherangebot,tupel);
+loeschevorhandenesaetze(8);restoretupel(dnrfaecherangebot,tupel);
+standardmeldung(meldg14,eingbldsch(8)+"#");schreibtupelFI ;
+korrtupelindbpuffer;succ(dnrfaecherangebot);WHILE dbstatus=okCAND intwert(
+fnrfangjgst)=int(eingbldsch(7))CAND wert(fnrfanghj)=geplschhjCAND wert(
+fnrfangsj)=geplschjREP schreibtupel;korrtupelindbpuffer;succ(
+dnrfaecherangebot);PER ;meldungdatenuebernommen.meldungdatenuebernommen:
+return(2);standardmeldung(meldg3,"");LEAVE ueberngeplpart.
+meldungdatennichtuebernommen:return(2);standardmeldung(meldg13,"");LEAVE 
+ueberngeplpart.schreibtupel:putwert(fnrfangsj,geplschj);putwert(fnrfanghj,
+geplschhj);putintwert(fnrfangjgst,int(eingbldsch(8)));putintwert(fnrfanglfdnr
+,intwert(fnrfanglfdnr));putwert(fnrfangfach,wert(fnrfangfach));putwert(
+fnrfangart,wert(fnrfangart));putintwert(fnrfangwochenstd,intwert(
+fnrfangwochenstd));putintwert(fnrfanganzlv,intwert(fnrfanganzlv));insert(
+dnrfaecherangebot).korrtupelindbpuffer:putintwert(fnrfangjgst,int(eingbldsch(
+7))).END PROC ueberngeplpart;PROC loeschevorhandenesaetze(INT CONST feld):
+inittupel(dnrfaecherangebot);IF feld=2THEN putwert(fnrfangsj,geplschj);
+putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,0);putintwert(
+fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN 
+letztejgst:=1;LEAVE loeschevorhandenesaetzeELIF wert(fnrfangsj)=geplschjCAND 
+wert(fnrfanghj)=geplschhjTHEN standardmeldung(meldg15,text(intwert(
+fnrfangjgst))+"#");letztejgst:=intwert(fnrfangjgst);WHILE wert(fnrfanghj)=
+geplschhjCAND dbstatus=okCAND wert(fnrfangsj)=geplschjREP IF intwert(
+fnrfangjgst)<>letztejgstTHEN standardmeldung(meldg15,text(intwert(fnrfangjgst
+))+"#");letztejgst:=intwert(fnrfangjgst);FI ;delete(dnrfaecherangebot);succ(
+dnrfaecherangebot)PER ;FI ELSE putwert(fnrfangsj,geplschj);putwert(fnrfanghj,
+geplschhj);putintwert(fnrfangjgst,int(eingbldsch(feld)));putintwert(
+fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN 
+letztejgst:=1;LEAVE loeschevorhandenesaetzeELIF intwert(fnrfangjgst)=int(
+eingbldsch(feld))CAND wert(fnrfangsj)=geplschjCAND wert(fnrfanghj)=geplschhj
+THEN standardmeldung(meldg15,eingbldsch(feld)+"#");WHILE intwert(fnrfangjgst)
+=int(eingbldsch(feld))CAND wert(fnrfanghj)=geplschhjCAND wert(fnrfangsj)=
+geplschjCAND dbstatus=0REP delete(dnrfaecherangebot);succ(dnrfaecherangebot)
+PER ;ELSE letztejgst:=1;LEAVE loeschevorhandenesaetzeFI FI ;END PROC 
+loeschevorhandenesaetze;PROC fachangspeichern(BOOL CONST speichern):
+stelleletztebearbzeilefest;merkebearbsch;bestimmenzaehler;IF speichernTHEN 
+standardmeldung(meldg18," ");fachleerurest;IF fachkatalog=trennerTHEN 
+holeaktdatenFI ;speicherdaten;IF NOT saetzeunveraendertTHEN 
+aenderungsvermerksetzen(kennzeichnunggeplant);FI ;standardmeldung(meldg7,"");
+FI ;naechsterbildschirm;nzaehler:=0;.fachleerurest:FOR iFROM 1UPTO bearbzl
+REP IF bearbbldsch(i).fach=""CAND (bearbbldsch(i).art<>""COR bearbbldsch(i).
+wstd<>""COR bearbbldsch(i).anz<>"")THEN fachangzurueckmitmeldg(meldg8,1,(i*4-
+1),"");LEAVE fachangspeichernFI PER .speicherdaten:pruefefachartkombination;
+standardmeldung(meldg19," ");IF NOT neuCAND nzaehler>0CAND anzdbsaetze<
+anzbssaetze+nzaehlerCAND letztebearbzeile>0THEN korrigieredbsaetzerueckwFI ;
+behandlebildschirmsaetze;IF NOT neuCAND anzbssaetze<anzdbsaetze-nzaehlerCAND 
+letztebearbzeile>0THEN korrigieredbsaetzevorwFI .bestimmenzaehler:FOR iFROM 
+anzdbsaetzeDOWNTO 1REP IF dbsatzbsnr(i)<bearbzl+1THEN nzaehler:=anzdbsaetze-i
+;LEAVE bestimmenzaehlerFI PER .pruefefachartkombination:dbzeiger:=1;
+saetzeunveraendert:=TRUE ;FOR iFROM 1UPTO letztebearbzeileREP istfehler:=
+FALSE ;IF compress(bearbbldsch(i).fach)<>""THEN IF neuTHEN pruefesatz;
+pruefefachart(i,1);IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");
+LEAVE fachangspeichernFI ;ELIF NOT neuCAND neuersatzTHEN pruefesatz;
+pruefefachart(i,3);IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");
+LEAVE fachangspeichernELIF dbfa2THEN pruefobvorhergeaendert;FI ;ELIF 
+geaendertersatzTHEN pruefesatz;IF fachartgeaendertCOR (nzaehler>0CAND i>
+ersteeinfuegezeile)THEN pruefefachart(i,3);FI ;modifsatzgeprueft:=TRUE ;IF 
+bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");LEAVE fachangspeichern
+ELIF dbfa2THEN pruefobvorhergeaendert;FI ;IF geaenderteraltersatzTHEN 
+dbzeigerINCR 1FI ELIF unveraendertersatzTHEN ueberpruefesonderfall;dbzeiger
+INCR 1FI ;ELSE pruefobgeloeschtersatzFI PER .ueberpruefesonderfall:IF 
+nzaehler>0CAND i>ersteeinfuegezeileTHEN pruefefachart(i,3);modifsatzgeprueft
+:=TRUE ;IF bldfa2THEN fachangzurueckmitmeldg(meldg9,1,i*4-1,"");LEAVE 
+fachangspeichernELIF dbfa2THEN pruefobvorhergeaendert;FI ;FI .
+pruefobgeloeschtersatz:FOR kFROM i+1UPTO bearbzlREP IF bearbbldsch(k).fach<>
+""THEN IF bearbbldsch(k).fach=dbinh(k).fachCAND bearbbldsch(k).art=dbinh(k).
+artCAND bearbbldsch(k).wstd=dbinh(k).wstdCAND bearbbldsch(k).anz=dbinh(k).anz
+THEN dbzeigerINCR 1;LEAVE pruefobgeloeschtersatzFI FI PER .
+geaenderteraltersatz:FOR kFROM i+1UPTO bearbzlREP IF bearbbldsch(k).fach<>""
+CAND dbzeiger<bearbzlTHEN IF bearbbldsch(k).fach=dbinh(dbzeiger).fachCAND 
+bearbbldsch(k).art=dbinh(dbzeiger).artCAND bearbbldsch(k).wstd=dbinh(dbzeiger
+).wstdCAND bearbbldsch(k).anz=dbinh(dbzeiger).anzTHEN LEAVE 
+geaenderteraltersatzWITH FALSE ELSE LEAVE geaenderteraltersatzWITH TRUE FI 
+FI PER ;TRUE .stelleletztebearbzeilefest:letztebearbzeile:=0;FOR iFROM 
+bearbzlDOWNTO 1REP IF standardmaskenfeld((i-1)*4+3)<>""COR standardmaskenfeld
+((i-1)*4+4)<>""THEN letztebearbzeile:=i;LEAVE stelleletztebearbzeilefestFI 
+PER .neuersatz:i+z1dbnr-1>=z1dbnr+anzdbsaetze-nzaehlerCAND (bearbbldsch(i).
+fach<>dbinh(dbzeiger).fachCAND bearbbldsch(i).art<>dbinh(dbzeiger).artCAND 
+bearbbldsch(i).wstd<>dbinh(dbzeiger).wstdCAND bearbbldsch(i).anz<>dbinh(
+dbzeiger).anz).geaendertersatz:bearbbldsch(i).fach<>dbinh(dbzeiger).fachCOR 
+bearbbldsch(i).art<>dbinh(dbzeiger).artCOR bearbbldsch(i).wstd<>dbinh(
+dbzeiger).wstdCOR bearbbldsch(i).anz<>dbinh(dbzeiger).anz.fachartgeaendert:
+bearbbldsch(i).fach<>dbinh(dbzeiger).fachCOR bearbbldsch(i).art<>dbinh(
+dbzeiger).art.unveraendertersatz:bearbbldsch(i).fach=dbinh(dbzeiger).fachCOR 
+bearbbldsch(i).art=dbinh(dbzeiger).artCOR bearbbldsch(i).wstd=dbinh(dbzeiger)
+.wstdCOR bearbbldsch(i).anz=dbinh(dbzeiger).anz.behandlebildschirmsaetze:
+dbzeiger:=1;FOR bszeigerFROM 1UPTO letztebearbzeileREP infeld((bszeiger-1)*4+
+3);IF compress(bearbbldsch(bszeiger).fach)<>""THEN IF NOT satzgeaendert(
+dbzeiger,bszeiger)THEN dbzeigerINCR 1ELIF dbinh(dbzeiger).fach<>""CAND 
+dbsatzbsnr(dbzeiger)<bearbzl+1THEN aenderesatz;dbzeigerINCR 1ELSE 
+schreibesatz;FI FI ;PER ;IF dbzeiger<bearbzl+1CAND dbinh(dbzeiger).fach<>""
+CAND anzdbsaetze>anzbssaetze+nzaehlerTHEN FOR iFROM 1UPTO zuloeschendesaetze
+REP loeschesatz;dbzeigerINCR 1PER FI ;dbzeiger:=1;bszeiger:=1.
+zuloeschendesaetze:anzdbsaetze-anzbssaetze-nzaehler.schreibesatz:IF 
+saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj,
+geplschj);putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(
+jgstfeldnr)));putintwert(fnrfanglfdnr,z1dbnr+dbzeiger-1);dbzeigerINCR 1;
+putwert(fnrfangfach,bearbbldsch(bszeiger).fach);putwert(fnrfangart,
+bearbbldsch(bszeiger).art);putintwert(fnrfangwochenstd,int(bearbbldsch(
+bszeiger).wstd));putintwert(fnrfanganzlv,int(bearbbldsch(bszeiger).anz));
+insert(dnrfaecherangebot);neu:=FALSE .aenderesatz:IF saetzeunveraendertTHEN 
+saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj,geplschj);putwert(fnrfanghj,
+geplschhj);putintwert(fnrfangjgst,int(eingbldsch(jgstfeldnr)));putintwert(
+fnrfanglfdnr,dbzeiger+z1dbnr-1);search(dnrfaecherangebot,TRUE );putwert(
+fnrfangfach,bearbbldsch(bszeiger).fach);putwert(fnrfangart,bearbbldsch(
+bszeiger).art);putintwert(fnrfangwochenstd,int(bearbbldsch(bszeiger).wstd));
+putintwert(fnrfanganzlv,int(bearbbldsch(bszeiger).anz));update(
+dnrfaecherangebot).loeschesatz:IF saetzeunveraendertTHEN saetzeunveraendert:=
+FALSE FI ;putwert(fnrfangsj,geplschj);putwert(fnrfanghj,geplschhj);putintwert
+(fnrfangjgst,int(eingbldsch(jgstfeldnr)));putintwert(fnrfanglfdnr,dbzeiger+
+z1dbnr-1);search(dnrfaecherangebot,TRUE );IF dbstatus<>okTHEN errorstop(
+"Systemfehler, zu löschenden Satz nicht gefunden !")FI ;delete(
+dnrfaecherangebot).korrigieredbsaetzevorw:IF saetzeunveraendertTHEN 
+saetzeunveraendert:=FALSE FI ;suchedbsatz(geplschj,geplschhj,int(eingbldsch(
+jgstfeldnr)),bearbbldsch(letztebearbzeile).fach,bearbbldsch(letztebearbzeile)
+.art,bearbbldsch(letztebearbzeile).wstd,bearbbldsch(letztebearbzeile).anz);
+REP succ(dnrfaecherangebot);IF dbstatus=okCAND intwert(fnrfangjgst)=int(
+eingbldsch(jgstfeldnr))CAND wert(fnrfanghj)=geplschhjCAND wert(fnrfangsj)=
+geplschjTHEN putintwert(fnrfanglfdnr,intwert(fnrfanglfdnr)-zuloeschendesaetze
+);update(dnrfaecherangebot);ELSE LEAVE korrigieredbsaetzevorwFI UNTIL intwert
+(fnrfangjgst)<>int(eingbldsch(jgstfeldnr))PER .korrigieredbsaetzerueckw:IF 
+saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;putwert(fnrfangsj,
+geplschj);putwert(fnrfanghj,geplschhj);putintwert(fnrfangjgst,int(eingbldsch(
+jgstfeldnr)));putintwert(fnrfanglfdnr,maxint);search(dnrfaecherangebot,FALSE 
+);REP pred(dnrfaecherangebot);IF intwert(fnrfangjgst)=int(eingbldsch(
+jgstfeldnr))CAND wert(fnrfanghj)=geplschhjCAND nichtbssatzCAND wert(fnrfangsj
+)=geplschjTHEN putintwert(fnrfanglfdnr,intwert(fnrfanglfdnr)+anzbssaetze-
+anzdbsaetze+nzaehler);update(dnrfaecherangebot);ELSE LEAVE 
+korrigieredbsaetzerueckwFI PER .nichtbssatz:intwert(fnrfanglfdnr)>z1dbnr+
+anzdbsaetze-1-nzaehler.naechsterbildschirm:j:=1;IF speichernTHEN IF 
+anzbssaetze=bearbzlCOR anzdbsaetze=bearbzlCOR nzaehler>0THEN zeignrINCR 
+anzbssaetze;erfasstefelderausgeben(zeignr);return(1);ELSE zeignr:=1;enter(2);
+FI ELSE IF anzdbsaetze<bearbzlCAND nzaehler=0THEN zeignr:=1;enter(2);ELSE 
+zeignrINCR anzdbsaetze-nzaehler;erfasstefelderausgeben(zeignr);return(1);FI 
+FI .pruefobvorhergeaendert:IF intwert(fnrfanglfdnr)<z1dbnrCOR intwert(
+fnrfanglfdnr)>z1dbnr+anzdbsaetze-1-nzaehlerTHEN fachangzurueckmitmeldg(meldg9
+,1,i*4-1,"");LEAVE fachangspeichernFI .pruefesatz:pruefdbfd(bearbbldsch(i).
+fach,fachkatalog);raus;pruefdbfd(bearbbldsch(i).art,artkatalog);raus;IF 
+bearbbldsch(i).wstd<>""THEN prueftypfd(i*4+1);raus;FI ;IF bearbbldsch(i).anz
+<>""THEN prueftypfd(i*4+2);rausFI .raus:IF istfehlerTHEN return(1);LEAVE 
+fachangspeichernFI .END PROC fachangspeichern;PROC suchedbsatz(TEXT CONST 
+supsj,supshj,INT CONST supjgst,TEXT CONST fach,art,wstd,anz):putwert(
+fnrfangsj,supsj);putwert(fnrfanghj,supshj);putintwert(fnrfangjgst,supjgst);
+putintwert(fnrfanglfdnr,1);search(dnrfaecherangebot,FALSE );IF NOT (dbstatus=
+okCAND wert(fnrfanghj)=supshjCAND intwert(fnrfangjgst)=supjgstCAND wert(
+fnrfangsj)=supsjCAND wert(fnrfangfach)=fachCAND wert(fnrfangart)=artCAND 
+intwert(fnrfangwochenstd)=int(wstd)CAND intwert(fnrfanganzlv)=int(anz))THEN 
+REP succ(dnrfaecherangebot);IF dbstatus=okCAND wert(fnrfanghj)=supshjCAND 
+intwert(fnrfangjgst)=supjgstCAND wert(fnrfangsj)=supsjCAND wert(fnrfangfach)=
+fachCAND wert(fnrfangart)=artCAND intwert(fnrfangwochenstd)=int(wstd)CAND 
+intwert(fnrfanganzlv)=int(anz)THEN LEAVE suchedbsatzFI UNTIL dbstatus<>okPER 
+FI .END PROC suchedbsatz;PROC pruefefachart(INT CONST i,p):IF neuTHEN 
+pruefbldschELSE pruefbldsch;pruefdbFI .pruefbldsch:bldfa2:=FALSE ;FOR jFROM 1
+UPTO i-1REP IF j<anzdbsaetze+1THEN IF NOT neuCAND NOT (satzgeaendert(j,j)
+CAND modifsatzgeprueft)THEN vergleichesaetzeFI FI PER ;FOR jFROM i+1UPTO 
+letztebearbzeileREP IF bearbbldsch(i).fach=bearbbldsch(j).fachCAND 
+bearbbldsch(i).art=bearbbldsch(j).artTHEN bldfa2:=TRUE ;LEAVE pruefefachart
+FI PER .vergleichesaetze:IF bearbbldsch(i).fach=bearbbldsch(j).fachCAND 
+bearbbldsch(i).art=bearbbldsch(j).artTHEN bldfa2:=TRUE ;LEAVE pruefefachart
+FI .pruefdb:dbfa2:=FALSE ;putwert(fnrfangsj,geplschj);putwert(fnrfanghj,
+geplschhj);putwert(fnrfangfach,bearbbldsch(i).fach);putintwert(fnrfangjgst,
+int(eingbldsch(jgstfeldnr)));putwert(fnrfangart,bearbbldsch(i).art);
+putintwert(fnrfanglfdnr,1);search(ixfangsjhjfach,TRUE );IF dbstatus=okCAND 
+wert(fnrfangart)=bearbbldsch(i).artCAND intwert(fnrfangjgst)=int(eingbldsch(
+jgstfeldnr))THEN IF p=1THEN dbfa2:=TRUE ;LEAVE pruefefachartELIF p=3THEN IF 
+intwert(fnrfanglfdnr)<>z1dbnr+i-1THEN dbfa2:=TRUE ;LEAVE pruefefachartELIF 
+nzaehler>0CAND i>ersteeinfuegezeileTHEN dbfa2:=TRUE ;LEAVE pruefefachartFI 
+FI ELSE REP pruefnachfolger;UNTIL nachfolgerfalschPER FI .nachfolgerfalsch:
+dbstatus<>okCOR wert(fnrfangfach)<>bearbbldsch(i).fachCOR wert(fnrfangsj)<>
+geplschjCOR wert(fnrfanghj)<>geplschhjCOR intwert(fnrfangjgst)>int(eingbldsch
+(jgstfeldnr)).pruefnachfolger:succ(ixfangsjhjfach);IF dbstatus=okCAND wert(
+fnrfanghj)=geplschhjCAND intwert(fnrfangjgst)=int(eingbldsch(jgstfeldnr))
+CAND wert(fnrfangfach)=bearbbldsch(i).fachCAND wert(fnrfangart)=bearbbldsch(i
+).artCAND wert(fnrfangsj)=geplschjTHEN IF p=1THEN dbfa2:=TRUE ;LEAVE 
+pruefefachartELIF p=3THEN IF intwert(fnrfanglfdnr)<>z1dbnr+i-1THEN dbfa2:=
+TRUE ;LEAVE pruefefachartELIF nzaehler>0CAND i>ersteeinfuegezeileTHEN dbfa2:=
+TRUE ;LEAVE pruefefachartFI FI FI .END PROC pruefefachart;BOOL PROC 
+satzgeaendert(INT CONST dbnr,bsnr):NOT (dbinh(dbnr).fach=bearbbldsch(bsnr).
+fachCAND dbinh(dbnr).art=bearbbldsch(bsnr).artCAND dbinh(dbnr).wstd=
+bearbbldsch(bsnr).wstdCAND dbinh(dbnr).anz=bearbbldsch(bsnr).anz)END PROC 
+satzgeaendert;PROC fachangmodbldsch(INT CONST iproc):SELECT iprocOF CASE 1:
+zeileneinfuegenCASE 2:zeileloeschenEND SELECT .zeileneinfuegen:aktzeile:=
+bearbfeldzuzeile(infeld);IF keinescnTHEN ersteeinfuegezeile:=aktzeile;
+keinescn:=FALSE FI ;IF aktzeile=bearbzlTHEN fachangzurueckmitmeldg(meldg16,1,
+infeld," ");LEAVE zeileneinfuegenFI ;infeld((aktzeile+1)*4-1);FOR iFROM 
+bearbzl-1DOWNTO aktzeile+1REP standardmaskenfeld(standardmaskenfeld(i*4-1),(i
++1)*4-1);standardmaskenfeld(standardmaskenfeld(i*4),(i+1)*4);
+standardmaskenfeld(standardmaskenfeld(i*4+1),(i+1)*4+1);standardmaskenfeld(
+standardmaskenfeld(i*4+2),(i+1)*4+2);PER ;standardmaskenfeld("",(aktzeile+1)*
+4-1);standardmaskenfeld("",(aktzeile+1)*4);standardmaskenfeld("",(aktzeile+1)
+*4+1);standardmaskenfeld("",(aktzeile+1)*4+2);infeld((aktzeile+1)*4-1);
+standardfelderausgeben;FOR iFROM 1UPTO anzdbsaetzeREP IF dbsatzbsnr(i)>
+aktzeileTHEN dbsatzbsnr(i)INCR 1;FI PER ;return(1).zeileloeschen:loeschzeile(
+bearbfeldzuzeile(infeld)).END PROC fachangmodbldsch;INT PROC bearbfeldzuzeile
+(INT CONST feldnr):(feldnr+1)DIV 4END PROC bearbfeldzuzeile;PROC loeschzeile(
+INT CONST zeilennr):INT VAR z:=zeilennr*4;infeld(z-1);standardmaskenfeld("",z
+-1);standardmaskenfeld("",z);standardmaskenfeld("",z+1);standardmaskenfeld(""
+,z+2);standardfelderausgeben;infeld(z-1);return(1)END PROC loeschzeile;
+initrows;END PACKET planefaecherangebot;
+
diff --git a/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan b/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan
new file mode 100644
index 0000000..5955533
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.halbjahreswechsel zum stundenplan
@@ -0,0 +1,120 @@
+PACKET halbjahreswechselzumstundenplanDEFINES 
+halbjahreswechselzumstundenplanvorbereiten,
+halbjahreswechselzumstundenplanstarten,halbjahreswechselzumstundenplandrucken
+:LET maske="ms halbjahreswechsel zum stundenplan";INT VAR fnraktsj:=2,
+fnrakthj:=3,fnrgeplsj:=4,fnrgeplhj:=5,fnrauskunft:=6;LET 
+meldnrhalbjahreswechsellaeuft=156,meldnrinbearbeitung=352;FILE VAR prot;LET 
+protname="Protokoll zum Halbjahreswechsel";LET schuljahr="Schuljahr",
+schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET 
+aenderungsvermerk="c02 aenderungsvermerk",wertaktuell="aktuell",wertgeplant=
+"geplant";LET erstessj=1,letztessj=9900,naechstessj=101,ersteshj=1,letzteshj=
+2;TEXT CONST meldtextanfang:="Daten für ",meldtextexist:="  existieren.",
+meldtextexistnicht:="  existierten nicht.",meldtextgeloescht:=
+"  wurden gelöscht.",ueberschrift:=
+"Schulhalbjahreswechsel in Daten der Unterrichtsorganisation",untertitel1:=
+"Wechsel von Schuljahr ",untertitel2:="        zum Schuljahr ",halbjahr:=
+". Halbjahr",namestundenplan:="Stundenplan";LET strich="-",schraegstrich="/",
+doppelpunkt=":",kennzhell="#";LET laengedatname=30;TEXT VAR aktsj:="",akthj:=
+"",geplsj,geplhj;INT VAR bearbsj,bearbhj,gelesensj,gelesenhj,intaktsj,
+intakthj,intgeplsj,intgeplhj;INT VAR dateinummer;TEXT VAR auszeile,dateiname;
+LET logbucheintraghjwechsel=
+"Anw. 4.7.1 Halbjahreswechsel z. Unterrichtsorg. ";PROC 
+halbjahreswechselzumstundenplanvorbereiten:standardstartproc(maske);IF aktsj=
+""THEN aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(schulhalbjahr)
+FI ;geplsj:=aktsj;geplhj:=akthj;geplanteshjundsjberechnen(geplhj,geplsj);
+standardmaskenfeld(aktsj,fnraktsj);standardmaskenfeld(akthj,fnrakthj);
+standardmaskenfeld(geplsj,fnrgeplsj);standardmaskenfeld(geplhj,fnrgeplhj);
+infeld(fnraktsj);standardfelderausgeben;infeld(fnrauskunft);standardnprocEND 
+PROC halbjahreswechselzumstundenplanvorbereiten;PROC 
+halbjahreswechselzumstundenplanstarten:standardmeldung(
+meldnrhalbjahreswechsellaeuft,"");logeintrag(logbucheintraghjwechsel+
+"gestartet");protokollvorbereiten;ausgabekopfaufbereiten;
+halbjahreswechselvorbereiten;wechselfuerbestand(dnraktschuelergruppen);
+wechselfuerbestand(dnrzeitraster);wechselfuerbestand(dnraufsichtszeiten);
+wechselfuerbestand(dnrzeitwuensche);wechselfuerbestand(dnrfaecherangebot);
+wechselfuerbestand(dnrlehrveranstaltungen);wechselfuerbestandstundenplan;
+wechselfuerbestand(dnraufsichtsplan);logeintrag(logbucheintraghjwechsel+
+"beendet");aenderungsvermerkfuerstundenplansetzen;zeigedatei(protname,"").
+protokollvorbereiten:forget(protname,quiet);prot:=sequentialfile(output,
+protname).ausgabekopfaufbereiten:putline(prot,schulkenndatum(schulname));
+putline(prot,text(schulkenndatum(schulort),65)+date);line(prot);putline(prot,
+ueberschrift);putline(prot,length(ueberschrift)*strich);line(prot);auszeile:=
+untertitel1;auszeileCAT subtext(aktsj,1,2);auszeileCAT schraegstrich;auszeile
+CAT subtext(aktsj,3,4);auszeileCAT " , ";auszeileCAT akthj;auszeileCAT 
+halbjahr;putline(prot,auszeile);auszeile:=untertitel2;auszeileCAT subtext(
+geplsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext(geplsj,3,4);
+auszeileCAT " , ";auszeileCAT geplhj;auszeileCAT halbjahr;putline(prot,
+auszeile);line(prot).halbjahreswechselvorbereiten:intaktsj:=int(aktsj);
+intakthj:=int(akthj);intgeplsj:=int(geplsj);intgeplhj:=int(geplhj);
+dateinummer:=0.aenderungsvermerkfuerstundenplansetzen:inittupel(dnrschluessel
+);putwert(fnrschlsachgebiet,aenderungsvermerk);putwert(fnrschlschluessel,
+wertaktuell);search(dnrschluessel,TRUE );IF dbstatus=0THEN delete(
+dnrschluessel);FI ;putwert(fnrschlsachgebiet,aenderungsvermerk);putwert(
+fnrschlschluessel,wertgeplant);search(dnrschluessel,TRUE );IF dbstatus=0THEN 
+putwert(fnrschlschluessel,wertaktuell);update(dnrschluessel);FI .END PROC 
+halbjahreswechselzumstundenplanstarten;PROC wechselfuerbestand(INT CONST 
+dateinr):standardmeldung(meldnrinbearbeitung,name(dateinr)+kennzhell);
+dateinamefuerausgabevorbereiten;erstensatzlesen;WHILE 
+geleseneshalbjahrkleineraktuelleshalbjahrREP IF wechselliegtvorTHEN 
+zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)FI ;
+satzloeschen;satzlesenPER ;IF geleseneshalbjahrgleichaktuelleshalbjahrTHEN 
+zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj);REP 
+satzloeschen;satzlesenUNTIL NOT geleseneshalbjahrgleichaktuelleshalbjahrPER 
+ELSE zeilezuhalbjahrausgeben(meldtextexistnicht,intaktsj,intakthj)FI ;IF 
+geleseneshalbjahrgleichgeplanteshalbjahrTHEN zeilezuhalbjahrausgeben(
+meldtextexist,intgeplsj,intgeplhj)ELSE zeilezuhalbjahrausgeben(
+meldtextexistnicht,intgeplsj,intgeplhj)FI ;bearbsj:=gelesensj;bearbhj:=
+gelesenhj;WHILE nochsaetzedaREP IF wechselliegtvorTHEN 
+zeilezuhalbjahrausgeben(meldtextexist,gelesensj,gelesenhj)FI ;
+naechsteshalbjahrsuchenPER .dateinamefuerausgabevorbereiten:line(prot);
+dateinummerINCR 1;dateiname:=text(dateinummer);dateinameCAT ". ";dateiname
+CAT name(dateinr);dateinameCAT doppelpunkt;dateiname:=text(dateiname,
+laengedatname).geleseneshalbjahrkleineraktuelleshalbjahr:dbstatus=0AND ((
+gelesensj<intaktsj)OR (gelesensj=intaktsjAND gelesenhj<intakthj)).
+geleseneshalbjahrgleichaktuelleshalbjahr:dbstatus=0AND (gelesensj=intaktsj
+AND gelesenhj=intakthj).geleseneshalbjahrgleichgeplanteshalbjahr:dbstatus=0
+AND (gelesensj=intgeplsjAND gelesenhj=intgeplhj).nochsaetzeda:dbstatus=0.
+erstensatzlesen:bearbsj:=0;bearbhj:=-1;first(dateinr);gelesensj:=intwert(
+dateinr+1);gelesenhj:=intwert(dateinr+2).satzlesen:succ(dateinr);gelesensj:=
+intwert(dateinr+1);gelesenhj:=intwert(dateinr+2).satzloeschen:delete(dateinr)
+.naechsteshalbjahrsuchen:putintwert(dateinr+2,bearbhj+1);search(dateinr,
+FALSE );gelesensj:=intwert(dateinr+1);gelesenhj:=intwert(dateinr+2).
+wechselliegtvor:IF bearbsj<>gelesensjOR bearbhj<>gelesenhjTHEN bearbsj:=
+gelesensj;bearbhj:=gelesenhj;TRUE ELSE FALSE FI .END PROC wechselfuerbestand;
+PROC wechselfuerbestandstundenplan:INT VAR fstatusstuplan;standardmeldung(
+meldnrinbearbeitung,namestundenplan+kennzhell);
+dateinamefuerausgabevorbereiten;gelesensj:=erstessj;WHILE gelesensj<=
+letztessjREP FOR gelesenhjFROM ersteshjUPTO letzteshjREP 
+stundenplanhalbjahrsetzen(text(gelesenhj),gelesensjaufbereitet);IF 
+geleseneshalbjahrkleineraktuelleshalbjahrTHEN IF stundenplandatenvorhanden
+THEN stundenplanbasisundstundenplanloeschen(fstatusstuplan);
+zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)FI ELIF 
+geleseneshalbjahrgleichaktuelleshalbjahrTHEN IF stundenplandatenvorhanden
+THEN stundenplanbasisundstundenplanloeschen(fstatusstuplan);
+zeilezuhalbjahrausgeben(meldtextgeloescht,gelesensj,gelesenhj)ELSE 
+zeilezuhalbjahrausgeben(meldtextexistnicht,gelesensj,gelesenhj)FI ELIF 
+geleseneshalbjahrgleichgeplanteshalbjahrTHEN IF stundenplandatenvorhanden
+THEN zeilezuhalbjahrausgeben(meldtextexist,gelesensj,gelesenhj)ELSE 
+zeilezuhalbjahrausgeben(meldtextexistnicht,gelesensj,gelesenhj)FI ELSE IF 
+stundenplandatenvorhandenTHEN zeilezuhalbjahrausgeben(meldtextexist,gelesensj
+,gelesenhj)FI FI PER ;gelesensj:=gelesensj+naechstessjPER .
+geleseneshalbjahrkleineraktuelleshalbjahr:(gelesensj<intaktsj)OR (gelesensj=
+intaktsjAND gelesenhj<intakthj).geleseneshalbjahrgleichaktuelleshalbjahr:
+gelesensj=intaktsjAND gelesenhj=intakthj.
+geleseneshalbjahrgleichgeplanteshalbjahr:gelesensj=intgeplsjAND gelesenhj=
+intgeplhj.gelesensjaufbereitet:TEXT VAR ausgabesj:="000"+text(gelesensj);
+subtext(ausgabesj,length(ausgabesj)-3).dateinamefuerausgabevorbereiten:line(
+prot);dateinummerINCR 1;dateiname:=text(dateinummer);dateinameCAT ". ";
+dateinameCAT namestundenplan;dateinameCAT doppelpunkt;dateiname:=text(
+dateiname,laengedatname).END PROC wechselfuerbestandstundenplan;PROC 
+zeilezuhalbjahrausgeben(TEXT CONST ergaenzung,INT CONST aussj,aushj):TEXT 
+VAR ausgabesj:="000"+text(aussj);ausgabesj:=subtext(ausgabesj,length(
+ausgabesj)-3);auszeile:=dateiname;auszeileCAT meldtextanfang;auszeileCAT 
+subtext(ausgabesj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext(
+ausgabesj,3,4);auszeileCAT schraegstrich;auszeileCAT text(aushj);auszeileCAT 
+ergaenzung;putline(prot,auszeile);dateiname:=laengedatname*" ".END PROC 
+zeilezuhalbjahrausgeben;PROC halbjahreswechselzumstundenplandrucken(BOOL 
+CONST drucken):IF druckenTHEN print(protname)FI ;forget(protname,quiet);enter
+(2)END PROC halbjahreswechselzumstundenplandrucken;END PACKET 
+halbjahreswechselzumstundenplan
+
diff --git a/app/schulis/2.2.1/src/4.konsistenzpruefung b/app/schulis/2.2.1/src/4.konsistenzpruefung
new file mode 100644
index 0000000..bd95a94
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.konsistenzpruefung
@@ -0,0 +1,274 @@
+PACKET konsistenzpruefungDEFINES konsistenzpruefungstarten,
+konsistenzpruefungprotokolldrucken:INT VAR fnrgeplhj:=2,fnrakthj:=3;LET 
+meldnrinbearbeitung=352,meldnrstundenplanwirdaufbereitet=357,meldnrbasisalt=
+377;LET anschreibenserver="anschreiben server";LET fehlerzeilendatei=
+"fehlerliste konsistenzpruefung";FILE VAR fehldat;LET protname=
+"Protokoll zur Konsistenzprüfung";FILE VAR prot;LET sachgebietraum=
+"c02 raeume",sachgebietaufsichtsorte="c02 aufsichtsorte";LET schuljahr=
+"Schuljahr",schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort=
+"Schulort";LET ueberschrift="Konsistenzprüfung zum Stundenplan",untertitel1=
+"Stundenplan zum Schuljahr ",texthalbjahr=". Halbjahr",untertitel2=
+"Prüfung am ",anfangstext="Folgende Inkonsistenzen wurden festgestellt: ";
+LET strich="-",schraegstrich="/",blank=" ",kennzhell="#",fall="Fall ",
+doppelpunkt=":",ersatzzeichen="#",awtrenner="#";LET jgst05="05",jgst13="13";
+LET kennzzeitrastersperrung="x",leerraum="    ";LET laengekennung=4,
+laengeraum=4,laengeklassengruppe=4,laengesugruppe=6,laengeparaphe=4,
+laengefach=2,laengekopplung=8,laengelv=8,laengeorte=4,laengeaufsichtszeit=3;
+LET kennungkopplung="K",kennungparaphe="P",kennunglv="L",kennungraum="R";LET 
+maxlehrer=255;LET erstestunde=1,letztestunde=66;LET bezugfach="f",
+bezugsugruppe="s",bezugparaphe="l",bezugraum="r",bezugkopplung="k",
+bezugtextfach="Fach",bezugtextsugruppe="Schülergruppe",bezugtextparaphe=
+"Paraphe",bezugtextraum="Raum",bezugtextkopplung="Kopplung";TEXT VAR aktsj:=
+"",akthj:="",gewsj,gewhj;TEXT VAR auszeile,zeile,suchfall;TEXT VAR 
+klassengruppe,raumgruppe,jgst,fach,paraphe,lv,raum,ort,aufsichtszeit,kopplung
+,neuekopplung,neueparaphe;TEXT VAR gueltigeschuelergruppen,
+gueltigeklassengruppen,gueltigeraumgruppen,gueltigeraeume,gueltigefaecher,
+gueltigeparaphen,gueltigelv,gueltigekopplungen,gueltigeaufsichtszeiten,
+gueltigeaufsichtsorte;TEXT VAR fehlerhafteklassengruppen,
+fehlerhafteraumgruppen,fehlerhaftelv;TEXT VAR zeitrasterleiste;INT VAR 
+ifehler,ilehrer;ROW maxlehrerINT VAR lehrersollstd;ROW maxlehrerINT VAR 
+lehreriststd;INT VAR posraum,poslv,posparaphe;INT VAR izeit;PROC 
+konsistenzpruefungstarten:INT VAR fnrfehler:=0;standardpruefe(5,fnrgeplhj,
+fnrakthj,0,"",fnrfehler);IF fnrfehler<>0THEN infeld(fnrfehler);return(1)ELSE 
+pruefungstartenFI .pruefungstarten:IF aktsj=""THEN aktsj:=schulkenndatum(
+schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI ;gewsj:=aktsj;gewhj:=akthj;
+IF standardmaskenfeld(fnrgeplhj)<>""THEN geplanteshjundsjberechnen(gewhj,
+gewsj);FI ;protokollvorbereiten;ausgabekopfaufbereiten;
+pruefungklassengruppendurchfuehren;pruefungraumgruppendurchfuehren;
+pruefunglehrveranstaltungendurchfuehren;
+pruefunglehrerstundenzahlendurchfuehren;pruefungzeitwuenschedurchfuehren;
+pruefungstundenplandurchfuehren;pruefungaufsichtsplandurchfuehren;
+ausgabefussaufbereiten;zeigedatei(protname,"").protokollvorbereiten:forget(
+fehlerzeilendatei,quiet);fetch(fehlerzeilendatei,/anschreibenserver);fehldat
+:=sequentialfile(modify,fehlerzeilendatei);forget(protname,quiet);prot:=
+sequentialfile(output,protname);ifehler:=0.ausgabekopfaufbereiten:putline(
+prot,schulkenndatum(schulname));putline(prot,schulkenndatum(schulort));line(
+prot);putline(prot,20*blank+ueberschrift);putline(prot,20*blank+length(
+ueberschrift)*strich);line(prot);auszeile:=untertitel1;auszeileCAT subtext(
+gewsj,1,2);auszeileCAT schraegstrich;auszeileCAT subtext(gewsj,3,4);auszeile
+CAT ", ";auszeileCAT gewhj;auszeileCAT texthalbjahr;putline(prot,auszeile);
+auszeile:=untertitel2;auszeileCAT date;auszeileCAT blank;auszeileCAT 
+timeofday;putline(prot,auszeile);line(prot);line(prot);putline(prot,
+anfangstext);line(prot).ausgabefussaufbereiten:line(prot);IF ifehler=0THEN 
+putline(prot,20*blank+"keine")ELSE putline(prot,20*blank+20*strich)FI .END 
+PROC konsistenzpruefungstarten;PROC pruefungklassengruppendurchfuehren:
+standardmeldung(meldnrinbearbeitung,name(dnrklassengruppen)+kennzhell);
+holegueltigeschuelergruppen;gueltigeklassengruppen:="";
+fehlerhafteklassengruppen:="";inittupel(dnrklassengruppen);statleseschleife(
+dnrklassengruppen,"","",fnrkgklassengrp,fnrkgklassengrp,PROC 
+klassengruppelesenundpruefen)END PROC pruefungklassengruppendurchfuehren;
+PROC holegueltigeschuelergruppen:gueltigeschuelergruppen:="";inittupel(
+dnraktschuelergruppen);statleseschleife(dnraktschuelergruppen,gewsj,gewhj,
+fnrsgrpsj,fnrsgrphj,PROC schuelergruppelesen)END PROC 
+holegueltigeschuelergruppen;PROC schuelergruppelesen(BOOL VAR b):IF dbstatus
+<>0OR wert(fnrsgrpsj)<>gewsjOR wert(fnrsgrphj)<>gewhjTHEN b:=TRUE ELSE 
+gueltigeschuelergruppenCAT jgstzweistellig(intwert(fnrsgrpjgst));
+gueltigeschuelergruppenCAT text(wert(fnrsgrpkennung),laengekennung)FI END 
+PROC schuelergruppelesen;PROC klassengruppelesenundpruefen(BOOL VAR b):TEXT 
+VAR sugruppe,sugruppen;INT VAR possugruppe,laengesugruppen;IF dbstatus<>0
+THEN b:=TRUE ELSE klassengruppe:=wert(fnrkgklassengrp);gueltigeklassengruppen
+CAT text(klassengruppe,laengeklassengruppe);sugruppen:=wert(fnrkgschuelergrp)
+;laengesugruppen:=length(sugruppen);possugruppe:=1;WHILE possugruppe<
+laengesugruppenREP sugruppe:=subtext(sugruppen,possugruppe,possugruppe+
+laengesugruppe-1);IF suchpos(gueltigeschuelergruppen,sugruppe,laengesugruppe)
+=0AND sugruppeistnichtjgstTHEN fehlerprotokollieren(1,klassengruppe+awtrenner
++sugruppe+awtrenner);fehlerhafteklassengruppenCAT text(klassengruppe,
+laengeklassengruppe)FI ;possugruppeINCR laengesugruppePER ;FI .
+sugruppeistnichtjgst:subtext(sugruppe,3,6)<>"    ".END PROC 
+klassengruppelesenundpruefen;PROC pruefungraumgruppendurchfuehren:
+standardmeldung(meldnrinbearbeitung,name(dnrraumgruppen)+kennzhell);
+holegueltigeraeume;gueltigeraumgruppen:="";fehlerhafteraumgruppen:="";
+inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp,
+fnrrgraumgrp,PROC raumgruppelesenundpruefen)END PROC 
+pruefungraumgruppendurchfuehren;PROC holegueltigeraeume:gueltigeraeume:="";
+inittupel(dnrschluessel);statleseschleife(dnrschluessel,sachgebietraum,"",
+fnrschlsachgebiet,fnrschlschluessel,PROC raumlesen);END PROC 
+holegueltigeraeume;PROC raumlesen(BOOL VAR b):IF dbstatus<>0COR wert(
+fnrschlsachgebiet)>sachgebietraumTHEN b:=TRUE ELSE gueltigeraeumeCAT text(
+wert(fnrschlschluessel),laengeraum)FI END PROC raumlesen;PROC 
+raumgruppelesenundpruefen(BOOL VAR b):TEXT VAR alleraeume;INT VAR 
+laengeraeume;IF dbstatus<>0THEN b:=TRUE ELSE raumgruppe:=wert(fnrrgraumgrp);
+gueltigeraumgruppenCAT text(raumgruppe,laengeraum);alleraeume:=wert(
+fnrrgraeume);laengeraeume:=length(alleraeume);posraum:=1;WHILE posraum<
+laengeraeumeREP raum:=subtext(alleraeume,posraum,posraum+laengeraum-1);IF 
+suchpos(gueltigeraeume,raum,laengeraum)=0THEN fehlerprotokollieren(2,
+raumgruppe+awtrenner+raum+awtrenner);fehlerhafteraumgruppenCAT text(
+raumgruppe,laengeraum)FI ;posraumINCR laengeraumPER ;FI .END PROC 
+raumgruppelesenundpruefen;PROC pruefunglehrveranstaltungendurchfuehren:
+standardmeldung(meldnrinbearbeitung,name(dnrlehrveranstaltungen)+kennzhell);
+holegueltigeparaphen;holegueltigefaecher;gueltigelv:="";fehlerhaftelv:="";
+gueltigekopplungen:="";inittupel(dnrlehrveranstaltungen);statleseschleife(
+dnrlehrveranstaltungen,gewsj,gewhj,fnrlvsj,fnrlvhj,PROC lvlesenundpruefen)
+END PROC pruefunglehrveranstaltungendurchfuehren;PROC holegueltigeparaphen:
+gueltigeparaphen:="";ilehrer:=0;inittupel(dnrlehrer);statleseschleife(
+dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC paraphelesen);END PROC 
+holegueltigeparaphen;PROC paraphelesen(BOOL VAR b):IF dbstatus<>0THEN b:=
+TRUE ELSE gueltigeparaphenCAT text(wert(fnrlparaphe),laengeparaphe);ilehrer
+INCR 1;lehrersollstd(ilehrer):=intwert(fnrlsollstd);lehreriststd(ilehrer):=0
+FI END PROC paraphelesen;PROC holegueltigefaecher:gueltigefaecher:="";
+inittupel(dnrfaecher);statleseschleife(dnrfaecher,"","",fnrffach,fnrffach,
+PROC fachlesen);END PROC holegueltigefaecher;PROC fachlesen(BOOL VAR b):IF 
+dbstatus<>0THEN b:=TRUE ELSE gueltigefaecherCAT text(wert(fnrffach),
+laengefach)FI END PROC fachlesen;PROC lvlesenundpruefen(BOOL VAR b):IF 
+dbstatus<>0OR wert(fnrlvhj)<>gewhjOR wert(fnrlvsj)<>gewsjTHEN b:=TRUE ELSE 
+lvdatenpruefenFI .lvdatenpruefen:jgst:=jgstzweistellig(intwert(fnrlvjgst));
+paraphe:=text(wert(fnrlvparaphe),laengeparaphe);fach:=subtext(wert(
+fnrlvfachkennung),1,2);lv:=jgst+wert(fnrlvfachkennung);gueltigelvCAT text(lv,
+laengelv);gueltigekopplungenCAT text(wert(fnrlvkopplung),laengekopplung);IF 
+suchpos(gueltigefaecher,fach,laengefach)=0THEN fehlerprotokollieren(3,lv+
+awtrenner+fach+awtrenner);fehlerhaftelvCAT text(lv,laengelv)FI ;posparaphe:=
+suchpos(gueltigeparaphen,paraphe,laengeparaphe);IF posparaphe=0THEN 
+fehlerprotokollieren(4,lv+awtrenner+paraphe+awtrenner);fehlerhaftelvCAT text(
+lv,laengelv)ELSE lehrerstundenaufsummierenFI ;INT VAR fnrklgrp;FOR fnrklgrp
+FROM fnrlvklgrp1UPTO fnrlvklgrp4REP klassengruppe:=wert(fnrklgrp);IF 
+klassengruppe<>""THEN IF suchpos(gueltigeschuelergruppen,jgst+klassengruppe,
+laengesugruppe)=0THEN IF intwert(fnrlvjgst)>0THEN IF jgst<>klassengruppeTHEN 
+pruefeobgueltigeklassengruppeFI ELIF klassengruppeistkeinejgstTHEN 
+pruefeobgueltigeklassengruppeFI FI ;FI ;PER ;INT VAR fnrraumgrp;FOR 
+fnrraumgrpFROM fnrlvraumgrp1UPTO fnrlvraumgrp2REP raum:=wert(fnrraumgrp);IF 
+raum<>""THEN raum:=text(raum,laengeraum);IF suchpos(gueltigeraeume,raum,
+laengeraum)=0THEN IF suchpos(gueltigeraumgruppen,raum,laengeraum)=0THEN 
+fehlerprotokollieren(7,lv+awtrenner+raum+awtrenner)ELIF suchpos(
+fehlerhafteraumgruppen,raum,laengeraum)>0THEN fehlerprotokollieren(8,lv+
+awtrenner+raum+awtrenner)FI FI ;FI ;PER ;.klassengruppeistkeinejgst:
+jgstaufber(klassengruppe)<jgst05OR jgstaufber(klassengruppe)>jgst13.
+pruefeobgueltigeklassengruppe:IF suchpos(gueltigeklassengruppen,klassengruppe
+,laengeklassengruppe)=0THEN fehlerprotokollieren(5,lv+awtrenner+klassengruppe
++awtrenner)ELIF suchpos(fehlerhafteklassengruppen,klassengruppe,
+laengeklassengruppe)>0THEN fehlerprotokollieren(6,lv+awtrenner+klassengruppe+
+awtrenner)FI .lehrerstundenaufsummieren:ilehrer:=((posparaphe-1)DIV 
+laengeparaphe)+1;lehreriststd(ilehrer):=lehreriststd(ilehrer)+intwert(
+fnrlvwochenstd).END PROC lvlesenundpruefen;PROC 
+pruefunglehrerstundenzahlendurchfuehren:standardmeldung(meldnrinbearbeitung,
+name(dnrlehrer)+kennzhell);ilehrer:=1;posparaphe:=1;WHILE posparaphe<length(
+gueltigeparaphen)REP IF lehreriststd(ilehrer)>lehrersollstd(ilehrer)THEN 
+fehlerprotokollieren(9,subtext(gueltigeparaphen,posparaphe,posparaphe+
+laengeparaphe-1)+awtrenner);FI ;ilehrerINCR 1;posparapheINCR laengeparaphe
+PER .END PROC pruefunglehrerstundenzahlendurchfuehren;PROC 
+pruefungzeitwuenschedurchfuehren:standardmeldung(meldnrinbearbeitung,name(
+dnrzeitwuensche)+kennzhell);inittupel(dnrzeitwuensche);statleseschleife(
+dnrzeitwuensche,gewsj,gewhj,fnrzwsj,fnrzwhj,PROC zeitwuenschelesenundpruefen)
+END PROC pruefungzeitwuenschedurchfuehren;PROC zeitwuenschelesenundpruefen(
+BOOL VAR b):IF dbstatus<>0OR wert(fnrzwhj)<>gewhjOR wert(fnrzwsj)<>gewsjTHEN 
+b:=TRUE ELSE zeitwunschpruefenFI .zeitwunschpruefen:INT VAR bezuglaenge:=0;
+TEXT VAR bezug,bezugsobjekt,bezugtext,bezugmenge;bezug:=wert(fnrzwbezug);IF 
+bezug=bezugfachTHEN bezuglaenge:=laengefach;bezugtext:=bezugtextfach;
+bezugmenge:=gueltigefaecherELIF bezug=bezugsugruppeTHEN bezuglaenge:=
+laengesugruppe;bezugtext:=bezugtextsugruppe;bezugmenge:=
+gueltigeschuelergruppenELIF bezug=bezugparapheTHEN bezuglaenge:=laengeparaphe
+;bezugtext:=bezugtextparaphe;bezugmenge:=gueltigeparaphenELIF bezug=bezugraum
+THEN bezuglaenge:=laengeraum;bezugtext:=bezugtextraum;bezugmenge:=
+gueltigeraeumeELIF bezug=bezugkopplungTHEN bezuglaenge:=laengekopplung;
+bezugtext:=bezugtextkopplung;bezugmenge:=gueltigekopplungenELSE LEAVE 
+zeitwunschpruefenFI ;bezugsobjekt:=text(wert(fnrzwbezugsobjekt),bezuglaenge);
+IF suchpos(bezugmenge,bezugsobjekt,bezuglaenge)=0THEN delete(dnrzeitwuensche)
+;fehlerprotokollieren(10,bezugsobjekt+awtrenner+bezugtext+awtrenner)FI END 
+PROC zeitwuenschelesenundpruefen;PROC pruefungstundenplandurchfuehren:INT 
+VAR fstatusstuplan;BOOL VAR ok;stundenplanhalbjahrsetzen(gewhj,gewsj);
+standardmeldung(meldnrstundenplanwirdaufbereitet,"");
+stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan=8THEN 
+standardmeldung(meldnrbasisalt,"")FI ;IF fstatusstuplan=0OR fstatusstuplan=8
+THEN pruefestundenplan;stundenplanreorganisierenundsichern(fstatusstuplan)
+ELSE stundenplanfehlerbehandelnFI .stundenplanfehlerbehandeln:putline(prot,
+"*** Der Stundenplan wurde nicht geprüft. ***").pruefestundenplan:TEXT VAR 
+lvderzeit,paraphenderzeit,kopplungenderzeit,raeumederzeit;holezeitraster;
+standardmeldung(meldnrinbearbeitung,"Stundenplan"+kennzhell);FOR izeitFROM 
+erstestundeUPTO letztestundeREP lvderzeit:=datenderzeit(izeit,kennunglv);IF 
+lvderzeit<>""THEN pruefeallelvderzeitFI PER .pruefeallelvderzeit:IF (
+zeitrasterleisteSUB izeit)=kennzzeitrastersperrungTHEN poslv:=1;WHILE poslv<
+length(lvderzeit)REP lv:=subtext(lvderzeit,poslv,poslv+laengelv-1);
+planeintragloeschen(izeit,lv,ok);fehlerprotokollieren(18,tagstunde(izeit,
+TRUE )+awtrenner+lv+awtrenner);poslvINCR laengelvPER ELSE 
+weiterepruefungenzulvFI .weiterepruefungenzulv:paraphenderzeit:=datenderzeit(
+izeit,kennungparaphe);kopplungenderzeit:=datenderzeit(izeit,kennungkopplung);
+raeumederzeit:=datenderzeit(izeit,kennungraum);poslv:=1;WHILE poslv<length(
+lvderzeit)REP lv:=subtext(lvderzeit,poslv,poslv+laengelv-1);IF suchpos(
+gueltigelv,lv,laengelv)=0THEN planeintragloeschen(izeit,lv,ok);
+fehlerprotokollieren(11,paramlvzeit)ELIF suchpos(fehlerhaftelv,lv,laengelv)>0
+THEN fehlerprotokollieren(12,paramlvzeit)ELSE inhaltspruefungzueintragFI ;
+poslvINCR laengelvPER .inhaltspruefungzueintrag:posparaphe:=((poslv-1)DIV 2)+
+1;paraphe:=subtext(paraphenderzeit,posparaphe,posparaphe+laengeparaphe-1);
+neueparaphe:=datenzurlv(kennungparaphe,lv);IF neueparaphe<>parapheTHEN IF 
+suchpos(paraphenderzeit,neueparaphe,laengeparaphe)>0THEN fehlerprotokollieren
+(14,paramparaphenwechsel)ELSE fehlerprotokollieren(13,paramparaphenwechsel);
+posraum:=posparaphe;raum:=subtext(raeumederzeit,posraum,posraum+laengeraum-1)
+;IF raum<>leerraumTHEN IF suchpos(gueltigeraeume,raum,laengeraum)=0THEN raum
+:=leerraum;fehlerprotokollieren(15,paramlvzeit)FI ;FI ;planeintragvornehmen(
+izeit,lv,raum,ok);FI ELSE posraum:=posparaphe;raum:=subtext(raeumederzeit,
+posraum,posraum+laengeraum-1);IF raum<>leerraumTHEN IF suchpos(gueltigeraeume
+,raum,laengeraum)=0THEN raum:=leerraum;fehlerprotokollieren(15,paramlvzeit);
+planeintragvornehmen(izeit,lv,raum,ok);FI ;FI ;kopplung:=subtext(
+kopplungenderzeit,poslv,poslv+laengekopplung-1);neuekopplung:=datenzurlv(
+kennungkopplung,lv);IF neuekopplung<>kopplungTHEN fehlerprotokollieren(16,
+paramkopplungswechsel);planeintragvornehmen(izeit,lv,raum,ok);kopplung:=
+neuekopplungFI ;FI ;IF schuelergruppenschnittbeizeit(izeit,kennungkopplung,
+kopplung,"")THEN fehlerprotokollieren(17,paramlvzeit)FI .END PROC 
+pruefungstundenplandurchfuehren;TEXT PROC paramlvzeit:TEXT VAR param:=lv;
+paramCAT awtrenner;paramCAT tagstunde(izeit,TRUE );paramCAT awtrenner;param
+END PROC paramlvzeit;TEXT PROC paramparaphenwechsel:TEXT VAR param:=
+paramlvzeit;paramCAT paraphe;paramCAT awtrenner;paramCAT neueparaphe;param
+CAT awtrenner;paramEND PROC paramparaphenwechsel;TEXT PROC 
+paramkopplungswechsel:TEXT VAR param:=paramlvzeit;paramCAT kopplung;paramCAT 
+awtrenner;paramCAT neuekopplung;paramCAT awtrenner;paramEND PROC 
+paramkopplungswechsel;PROC holezeitraster:zeitrasterleiste:=letztestunde*
+blank;inittupel(dnrzeitraster);statleseschleife(dnrzeitraster,gewsj,gewhj,
+fnrzrsj,fnrzrhj,PROC erstellezeitrasterleiste);END PROC holezeitraster;PROC 
+erstellezeitrasterleiste(BOOL VAR b):IF wert(fnrzrsj)<>gewsjCOR wert(fnrzrhj)
+<>gewhjCOR dbstatus<>0THEN b:=TRUE ELSE IF wert(fnrzrkennungteil)=
+kennzzeitrastersperrungTHEN replace(zeitrasterleiste,intwert(fnrzrtagstunde),
+kennzzeitrastersperrung)FI FI END PROC erstellezeitrasterleiste;PROC 
+pruefungaufsichtsplandurchfuehren:standardmeldung(meldnrinbearbeitung,name(
+dnraufsichtsplan)+kennzhell);holegueltigeaufsichtsorte;
+holegueltigeaufsichtszeiten;inittupel(dnraufsichtsplan);statleseschleife(
+dnraufsichtsplan,gewsj,gewhj,fnrapsj,fnraphj,PROC aufsichtenlesenundpruefen)
+END PROC pruefungaufsichtsplandurchfuehren;PROC holegueltigeaufsichtsorte:
+gueltigeaufsichtsorte:="";inittupel(dnrschluessel);statleseschleife(
+dnrschluessel,sachgebietaufsichtsorte,"",fnrschlsachgebiet,fnrschlschluessel,
+PROC aufsichtsortlesen);END PROC holegueltigeaufsichtsorte;PROC 
+aufsichtsortlesen(BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)>
+sachgebietaufsichtsorteTHEN b:=TRUE ELSE gueltigeaufsichtsorteCAT text(wert(
+fnrschlschluessel),laengeorte)FI END PROC aufsichtsortlesen;PROC 
+holegueltigeaufsichtszeiten:gueltigeaufsichtszeiten:="";inittupel(
+dnraufsichtszeiten);statleseschleife(dnraufsichtszeiten,gewsj,gewhj,fnrazsj,
+fnrazhj,PROC aufsichtszeitlesen)END PROC holegueltigeaufsichtszeiten;PROC 
+aufsichtszeitlesen(BOOL VAR b):IF dbstatus<>0OR wert(fnrazsj)<>gewsjOR wert(
+fnrazhj)<>gewhjTHEN b:=TRUE ELSE gueltigeaufsichtszeitenCAT text(wert(
+fnrazaufsichtszeit),laengeaufsichtszeit)FI END PROC aufsichtszeitlesen;PROC 
+aufsichtenlesenundpruefen(BOOL VAR b):IF dbstatus<>0OR wert(fnraphj)<>gewhj
+OR wert(fnrapsj)<>gewsjTHEN b:=TRUE ELSE aufsichtsplandatenpruefenFI .
+aufsichtsplandatenpruefen:aufsichtszeit:=text(wert(fnrapaufsichtszeit),
+laengeaufsichtszeit);IF suchpos(gueltigeaufsichtszeiten,aufsichtszeit,
+laengeaufsichtszeit)=0THEN delete(dnraufsichtsplan);fehlerprotokollieren(19,
+aufsichtszeit+awtrenner)ELSE ort:=text(wert(fnrapaufsichtsort),laengeorte);
+IF suchpos(gueltigeaufsichtsorte,ort,laengeorte)=0THEN fehlerprotokollieren(
+20,aufsichtszeit+awtrenner+ort+awtrenner)FI ;paraphe:=text(wert(fnrapparaphe)
+,laengeparaphe);IF suchpos(gueltigeparaphen,paraphe,laengeparaphe)=0THEN 
+fehlerprotokollieren(21,aufsichtszeit+awtrenner+ort+awtrenner)FI ;FI END 
+PROC aufsichtenlesenundpruefen;PROC konsistenzpruefungprotokolldrucken(BOOL 
+CONST drucken):IF druckenTHEN print(protname)FI ;forget(protname,quiet);enter
+(2)END PROC konsistenzpruefungprotokolldrucken;PROC fehlerprotokollieren(INT 
+CONST fallnr,TEXT CONST aktwerte):TEXT VAR aktuellerwert;INT VAR awpos,
+awendepos,epos;LET maxfehler=100;IF ifehler>maxfehlerTHEN LEAVE 
+fehlerprotokollierenELIF ifehler=maxfehlerTHEN putline(prot,
+"keine weitere Fehlerprotokollierung");ifehlerINCR 1;LEAVE 
+fehlerprotokollierenFI ;suchfall:=fall;suchfallCAT text(fallnr);suchfallCAT 
+doppelpunkt;toline(fehldat,1);col(fehldat,1);WHILE NOT eof(fehldat)REP 
+downety(fehldat,suchfall);readrecord(fehldat,zeile);IF pos(zeile,suchfall)=1
+THEN down(fehldat);behandlefallELSE col(fehldat,col(fehldat)+1)FI PER .
+behandlefall:ifehlerINCR 1;auszeile:=text(ifehler);auszeileCAT ") ";INT VAR 
+praefixlaenge:=length(auszeile);awpos:=1;WHILE NOT eof(fehldat)REP readrecord
+(fehldat,zeile);IF pos(zeile,fall)>0THEN line(prot);LEAVE behandlefallFI ;
+ersetzeevtlersatzzeichendurchaktuellewerte;auszeileCAT zeile;putline(prot,
+auszeile);down(fehldat);auszeile:=praefixlaenge*blankPER .
+ersetzeevtlersatzzeichendurchaktuellewerte:epos:=pos(zeile,ersatzzeichen);
+WHILE epos>0REP awendepos:=pos(aktwerte,awtrenner,awpos);aktuellerwert:=
+subtext(aktwerte,awpos,awendepos-1);awpos:=awendepos+1;change(zeile,
+ersatzzeichen,aktuellerwert);epos:=pos(zeile,ersatzzeichen,epos+length(
+aktuellerwert));PER .END PROC fehlerprotokollieren;INT PROC suchpos(TEXT 
+CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext)
+;WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE 
+findpos:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT 
+PROC jgstzweistellig(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4
+AND intjgst<10THEN "0"+text(intjgst)ELSE text(intjgst)FI END PROC 
+jgstzweistellig;END PACKET konsistenzpruefung
+
diff --git a/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen b/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen
new file mode 100644
index 0000000..7965000
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.lehrveranstaltungen benennen
@@ -0,0 +1,480 @@
+PACKET lehrveranstaltungenbenennenDEFINES lehrveranstaltungenbenennenstart,
+lehrveranstaltungenuebernehmenstart,lehrveranstaltungenuebernehmen,
+bearbeitunglehrveranstaltungen,lehrveranstaltungenzeileeinfuegen,
+lehrveranstaltungenspeichern:LET maskeeingang=
+"ms lehrveranstalt benennen eingang";LET maskebearb=
+"ms lehrveranstalt benennen";LET fnrbearbeiten=2,fnrbearbaktsj=3,
+fnrbearbgeplsj=4,fnrbearbjgst=5,fnrbearbfach=6,fnrfachanguebernehmen=7,
+fnrfachangaktsj=8,fnrfachanggeplsj=9,fnrfachangjgst=10,fnrlehrveruebernehmen=
+11,fnrlehrverjgst=12;LET feldanzmaskeeingang=12;ROW feldanzmaskeeingangTEXT 
+VAR feldbs1;LET felderprozeile=9;LET ersteseingabefeld=3;LET 
+erstestabellenfeld=2;LET incrfuerkennung=1,incrfuerlvart=2,
+incrfuerklassengranfang=3,incrfuerklassengrende=6,incrfuerwstd=7;LET 
+meldnrdatenspeichern=50,meldnrungueltigeauswahl=56,meldnrkennungzulang=60,
+meldnrdatennichtspeichern=63,meldnrbittewarten=69,meldnrbitteangabegenauer=
+129,meldnrungueltigeuebernahmejgst=146,meldnrfragedatenuebernehmen=300,
+meldnrdatenwerdenuebernommen=301,meldnrdatenwurdenuebernommen=302,
+meldnrdatenwurdennichtuebernommen=303,meldnrkeinfachzuanderenangaben=307,
+meldnrungueltigesfach=310,meldnrungueltigeart=311,
+meldnrletztezeilenichteinfuegen=314,meldnrkeinfaecherangebot=315,
+meldnruebernehmenderjgst=316,meldnrlehrveranstaltungloeschen=317,
+meldnrfalschetastezuankreuz=318,meldnrfalscheausfuellung=319,
+meldnrungueltigeklassengruppe=320,meldnrkeinelehrveranstaltungen=321,
+meldnrlehrveranstaltunggibtsschon=322,meldnrfehlerhaftejgst=305;LET kennzhell
+="#";LET textschulj="Schuljahr",texthalbj="Schulhalbjahr",ersteshalbjahr="1",
+zweiteshalbjahr="2";LET wertaktuell="aktuell",wertgeplant="geplant";LET 
+artbestand="c02 art lehrveranstaltung";BOOL VAR aktuelleshalbjahrzubearbeiten
+;TEXT VAR gewschulj,gewhalbj,aktschulj:="",akthalbj:="";INT VAR gewjgst,
+startjgst,endejgst;TEXT VAR vgljgst:="",vglfach:="";INT VAR 
+jgstdesletztensatzes:=0;LET fachlaenge=2;LET kennunglaenge=4;INT VAR zugriff;
+BOOL VAR eingangsmaskenfehler:=FALSE ;INT VAR pruefstatus:=0,letztecursorfnr
+:=fnrbearbeiten;INT VAR aktzeile;INT VAR ifnr,ijgst;LET trenner="�";TEXT VAR 
+geprueftefaecher,gueltigeschuelergruppen:="",gueltigeklassengruppen:="",
+gueltigelvart:="";TEXT VAR pruefklasse;INT VAR pruefjgst,pruefbez;TEXT VAR 
+sugruppen,sugruppejgst;INT VAR possugruppe,laengesugruppen;LET 
+laengeeinersugruppe=6;LET blankzeichen=" ",trennstrich="/",
+textueberschriftanfang="Lehrveranstaltungen benennen für Halbjahr ";TEXT VAR 
+ueberschrift;LET jgst0=0,jgst5=5,jgst10=10,jgst13=13;BOOL VAR gueltigejgst;
+BOOL VAR bearbeitungallerjgst;BOOL VAR leerenbszeigen;LET lvdateiname=
+"LV-Datei";FILE VAR lvdatei;TEXT VAR lvdateizeile;TEXT VAR nfschulj,nfhalbj,
+nfjgst,nffachkennung;INT VAR izeile,anzahlgezeigtezeilen,
+anzahleingegebenezeilen;LET zeilenanzahl=18;ROW zeilenanzahlSTRUCT (TEXT jgst
+,TEXT fach,TEXT kennung,TEXT kopplung,TEXT art,TEXT klasse1,TEXT klasse2,
+TEXT klasse3,TEXT klasse4,TEXT wstd)VAR bszeile;
+initfelderdeseingangsbildschirms;initbszeilepuffer;PROC 
+lehrveranstaltungenbenennenstart:standardstartproc(maskeeingang);
+wertedeseingangsbildschirmsholen;infeld(fnrbearbeiten);standardfelderausgeben
+;infeld(letztecursorfnr);standardnprocEND PROC 
+lehrveranstaltungenbenennenstart;PROC lehrveranstaltungenuebernehmenstart:
+BOOL VAR ausgangsdatenfehlen:=FALSE ;eingangsbehandlung(1);IF 
+eingangsmaskenfehlerTHEN infeld(pruefstatus);return(1)ELSE 
+wertedeseingangsbildschirmsmerken;schulhalbjahrbestimmen;IF jgstangabeleer
+THEN startjgst:=jgst0;endejgst:=jgst13ELSE startjgst:=int(vgljgst);endejgst:=
+startjgstFI ;IF standardmaskenfeld(fnrfachanguebernehmen)<>""THEN 
+pruefendesfaecherangebots;IF ausgangsdatenfehlenTHEN standardmeldung(
+meldnrkeinfaecherangebot,"");return(1)ELSE standardmeldung(
+meldnrfragedatenuebernehmen,"");eingabefeldersperren(fnrfachanguebernehmen);
+standardnprocFI ELSE pruefenderlehrveranstaltungen;IF ausgangsdatenfehlen
+THEN standardmeldung(meldnrkeinelehrveranstaltungen,"");return(1)ELIF 
+gewhalbj=ersteshalbjahrAND startjgst=jgst13THEN standardmeldung(
+meldnrungueltigeuebernahmejgst,"");infeld(fnrlehrverjgst);return(1)ELSE 
+standardmeldung(meldnrfragedatenuebernehmen,"");eingabefeldersperren(
+fnrlehrveruebernehmen);standardnprocFI FI FI .pruefendesfaecherangebots:
+ausgangsdatenfehlen:=FALSE ;putwert(fnrfangsj,gewschulj);putwert(fnrfanghj,
+gewhalbj);putintwert(fnrfangjgst,startjgst);putintwert(fnrfanglfdnr,0);search
+(dnrfaecherangebot,FALSE );IF dbstatus<>okTHEN ausgangsdatenfehlen:=TRUE 
+ELIF wert(fnrfanghj)<>gewhalbjCOR wert(fnrfangsj)<>gewschuljCOR intwert(
+fnrfangjgst)>endejgstTHEN ausgangsdatenfehlen:=TRUE FI .
+pruefenderlehrveranstaltungen:ausgangsdatenfehlen:=FALSE ;putwert(fnrlvsj,
+aktschulj);putwert(fnrlvhj,akthalbj);putintwert(fnrlvjgst,startjgst);putwert(
+fnrlvfachkennung,"");search(dnrlehrveranstaltungen,FALSE );IF dbstatus<>ok
+THEN ausgangsdatenfehlen:=TRUE ELIF wert(fnrlvhj)<>akthalbjCOR wert(fnrlvsj)
+<>aktschuljCOR intwert(fnrlvjgst)>endejgstTHEN ausgangsdatenfehlen:=TRUE FI .
+END PROC lehrveranstaltungenuebernehmenstart;PROC eingabefeldersperren(INT 
+CONST fnrfreiesfeld):FOR ifnrFROM fnrbearbeitenUPTO feldanzmaskeeingangREP 
+IF ifnr<>fnrfreiesfeldTHEN feldschutz(ifnr)FI PER ;infeld(fnrfreiesfeld)END 
+PROC eingabefeldersperren;PROC eingabefelderfreigeben:FOR ifnrFROM 
+fnrbearbeitenUPTO feldanzmaskeeingangREP feldfrei(ifnr)PER END PROC 
+eingabefelderfreigeben;PROC lehrveranstaltungenuebernehmen(BOOL CONST 
+uebernehmen):INT VAR letztejgst:=-1;IF uebernehmenTHEN standardmeldung(
+meldnrdatenwerdenuebernommen,"");IF standardmaskenfeld(fnrfachanguebernehmen)
+<>""THEN evtlvorhandenelehrveranstaltungenloeschen;
+neuelvausfaecherangebotschreibenELSE neuelvauslehrveranstaltungenschreibenFI 
+;evtlkurswahldatenbeimuebernehmenaktualisieren;IF 
+aktuelleshalbjahrzubearbeitenTHEN aenderungsvermerksetzen(wertaktuell)ELSE 
+aenderungsvermerksetzen(wertgeplant)FI ;standardmeldung(
+meldnrdatenwurdenuebernommen,"")ELSE standardmeldung(
+meldnrdatenwurdennichtuebernommen,"")FI ;eingabefelderfreigeben;return(2).
+evtlkurswahldatenbeimuebernehmenaktualisieren:IF 
+aktuelleshalbjahrzubearbeitenOR gewhalbj=zweiteshalbjahrTHEN FOR gewjgstFROM 
+startjgstUPTO endejgstREP IF gewjgst>jgst10THEN kurswahlserverlvaktualisieren
+(text(gewjgst),text(gewjgst),gewhalbj)FI ;PER ;ELSE FOR gewjgstFROM startjgst
+UPTO endejgstREP IF gewjgst>=jgst10THEN kurswahlserverlvaktualisieren(text(
+gewjgst),text(gewjgst+1),gewhalbj)FI ;PER ;FI .
+evtlvorhandenelehrveranstaltungenloeschen:
+sucheerstelehrveranstaltungzugewhalbj;WHILE lehrveranstaltungzuloeschenREP 
+meldungzumloeschenbeijgstwechsel;loeschevorhandenelehrveranstaltung;
+suchenaechstelehrveranstaltungzugewhalbjPER .
+sucheerstelehrveranstaltungzugewhalbj:putwert(fnrlvsj,gewschulj);putwert(
+fnrlvhj,gewhalbj);putintwert(fnrlvjgst,startjgst);putwert(fnrlvfachkennung,""
+);search(dnrlehrveranstaltungen,FALSE );letztejgst:=-1;.
+lehrveranstaltungzuloeschen:dbstatus=okCAND wert(fnrlvsj)=gewschuljCAND wert(
+fnrlvhj)=gewhalbjCAND intwert(fnrlvjgst)<=endejgst.
+loeschevorhandenelehrveranstaltung:delete(dnrlehrveranstaltungen).
+meldungzumloeschenbeijgstwechsel:IF intwert(fnrlvjgst)<>letztejgstTHEN 
+letztejgst:=intwert(fnrlvjgst);standardmeldung(
+meldnrlehrveranstaltungloeschen,text(letztejgst)+kennzhell)FI .
+suchenaechstelehrveranstaltungzugewhalbj:succ(dnrlehrveranstaltungen).
+neuelvausfaecherangebotschreiben:letztejgst:=-1;REP 
+lehrveranstaltungenzufaecherangebotschreiben;
+suchenaechstesfaecherangebotzugewhalbjUNTIL faecherangebotabgehandeltPER .
+lehrveranstaltungenzufaecherangebotschreiben:INT VAR satzanzahl:=intwert(
+fnrfanganzlv);INT VAR isatz;
+setzefestewerteausfaecherangebotfuerlehrveranstaltung;
+meldungzuruebernahmebeijgstwechsel;FOR isatzFROM 1UPTO satzanzahlREP 
+setzevarwerteausfaecherangebotfuerlehrveranstaltung;insert(
+dnrlehrveranstaltungen)PER .meldungzuruebernahmebeijgstwechsel:IF intwert(
+fnrlvjgst)<>letztejgstTHEN letztejgst:=intwert(fnrlvjgst);standardmeldung(
+meldnruebernehmenderjgst,text(letztejgst)+kennzhell)FI .
+setzefestewerteausfaecherangebotfuerlehrveranstaltung:putwert(fnrlvsj,
+gewschulj);putwert(fnrlvhj,gewhalbj);putintwert(fnrlvjgst,intwert(fnrfangjgst
+));putwert(fnrlvparaphe,"");putwert(fnrlvart,wert(fnrfangart));putintwert(
+fnrlvwochenstd,intwert(fnrfangwochenstd));putwert(fnrlvklgrp1,"");putwert(
+fnrlvklgrp2,"");putwert(fnrlvklgrp3,"");putwert(fnrlvklgrp4,"");putwert(
+fnrlvraumgrp1,"");putwert(fnrlvraumgrp2,"");.
+setzevarwerteausfaecherangebotfuerlehrveranstaltung:TEXT VAR lvkennung:=text(
+wert(fnrfangart),2)+textzweistellig(isatz);putwert(fnrlvfachkennung,text(wert
+(fnrfangfach),fachlaenge)+lvkennung);putwert(fnrlvkopplung,textzweistellig(
+intwert(fnrfangjgst))+textzweistellig(intwert(fnrfanglfdnr))+lvkennung);.
+suchenaechstesfaecherangebotzugewhalbj:succ(dnrfaecherangebot).
+faecherangebotabgehandelt:NOT (dbstatus=okCAND intwert(fnrfangjgst)<=endejgst
+CAND wert(fnrfangsj)=gewschuljCAND wert(fnrfanghj)=gewhalbj).
+neuelvauslehrveranstaltungenschreiben:lvsaetzezuaktuellenjgstindateischreiben
+;evtlvorhandenelehrveranstaltungenloeschenvorbereiten;
+evtlvorhandenelehrveranstaltungenloeschen;
+lvsaetzeausdateizugeplantenjgstschreiben.
+lvsaetzezuaktuellenjgstindateischreiben:forget(lvdateiname,quiet);lvdatei:=
+sequentialfile(output,lvdateiname);standardmeldung(meldnrbittewarten,"");
+holegueltigelehrveranstaltungen.
+evtlvorhandenelehrveranstaltungenloeschenvorbereiten:IF gewhalbj=
+ersteshalbjahrAND NOT jgstangabeleerTHEN IF startjgst>=jgst5THEN startjgst
+INCR 1;endejgstINCR 1FI FI .lvsaetzeausdateizugeplantenjgstschreiben:
+letztejgst:=-1;lvdatei:=sequentialfile(input,lvdateiname);WHILE NOT eof(
+lvdatei)REP getline(lvdatei,lvdateizeile);restoretupel(dnrlehrveranstaltungen
+,lvdateizeile);putwert(fnrlvhj,gewhalbj);IF gewhalbj=ersteshalbjahrTHEN 
+putwert(fnrlvsj,gewschulj);ijgst:=intwert(fnrlvjgst);IF ijgst>0THEN 
+putintwert(fnrlvjgst,ijgst+1);TEXT VAR bearbkopplung:=wert(fnrlvkopplung);IF 
+int(subtext(bearbkopplung,1,2))=ijgstTHEN putwert(fnrlvkopplung,
+textzweistellig(ijgst+1)+subtext(bearbkopplung,3))FI ;FI ;FI ;IF intwert(
+fnrlvjgst)>jgst13THEN LEAVE lvsaetzeausdateizugeplantenjgstschreibenELSE 
+meldungzuruebernahmebeijgstwechsel;insert(dnrlehrveranstaltungen)FI PER END 
+PROC lehrveranstaltungenuebernehmen;PROC holegueltigelehrveranstaltungen:
+inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,aktschulj);putwert(fnrlvhj,
+akthalbj);putintwert(fnrlvjgst,startjgst);search(dnrlehrveranstaltungen,
+FALSE );statleseschleife(dnrlehrveranstaltungen,aktschulj,akthalbj,fnrlvsj,
+fnrlvhj,PROC lehrveranstaltungindateieinlesen)END PROC 
+holegueltigelehrveranstaltungen;PROC lehrveranstaltungindateieinlesen(BOOL 
+VAR b):IF dbstatus<>0OR wert(fnrlvsj)<>aktschuljOR wert(fnrlvhj)<>akthalbjOR 
+intwert(fnrlvjgst)>endejgstTHEN b:=TRUE ELSE savetupel(dnrlehrveranstaltungen
+,lvdateizeile);putline(lvdatei,lvdateizeile)FI END PROC 
+lehrveranstaltungindateieinlesen;PROC bearbeitunglehrveranstaltungen:
+eingangsbehandlung(2);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return(
+1)ELSE wertedeseingangsbildschirmsmerken;schulhalbjahrbestimmen;
+zugriffauflehrveranstaltungenbestimmen;erstensatzlesen;IF 
+keinelehrveranstaltungengespeichertCAND bearbeitungallerjgstTHEN 
+standardmeldung(meldnrkeinelehrveranstaltungen,"");return(1)ELSE 
+standardstartproc(maskebearb);ueberschriftzeilezusammensetzen;
+standardkopfmaskeaktualisieren(ueberschrift);bsfuellen;infeld(
+ersteseingabefeld);standardnprocFI ;FI .
+zugriffauflehrveranstaltungenbestimmen:IF fachangabeleerTHEN zugriff:=
+ixlvsjhjkoppELIF jgstangabeleerTHEN zugriff:=ixlvsjhjkennELSE zugriff:=
+dnrlehrveranstaltungenFI .erstensatzlesen:putwert(fnrlvsj,gewschulj);putwert(
+fnrlvhj,gewhalbj);putintwert(fnrlvjgst,int(vgljgst));IF zugriff=ixlvsjhjkopp
+THEN putwert(fnrlvkopplung,textzweistellig(int(vgljgst)))ELSE putwert(
+fnrlvfachkennung,vglfach)FI ;jgstdesletztensatzes:=int(vgljgst);search(
+zugriff,FALSE );leerenbszeigen:=NOT (dbstatus=okCAND wert(fnrlvhj)=gewhalbj
+CAND wert(fnrlvsj)=gewschuljCAND (jgstangabeleerCOR intwert(fnrlvjgst)=int(
+vgljgst))CAND (fachangabeleerCOR compress(subtext(wert(fnrlvfachkennung),1,
+fachlaenge))=vglfach)).keinelehrveranstaltungengespeichert:dbstatus<>0.
+ueberschriftzeilezusammensetzen:ueberschrift:=textueberschriftanfang;
+ueberschriftCAT gewhalbj;ueberschriftCAT blankzeichen;ueberschriftCAT subtext
+(gewschulj,1,2);ueberschriftCAT trennstrich;ueberschriftCAT subtext(gewschulj
+,3,4).END PROC bearbeitunglehrveranstaltungen;BOOL PROC fachangabeleer:
+vglfach=""END PROC fachangabeleer;BOOL PROC jgstangabeleer:vgljgst=""END 
+PROC jgstangabeleer;PROC bsfuellen:izeile:=0;IF NOT leerenbszeigenTHEN 
+startebildschirmblock(zugriff,zeilenanzahl-1);bildschirmblock(PROC satzmerken
+,BOOL PROC (INT CONST )satzzubehandeln,0);IF dbstatus=0THEN succ(zugriff);IF 
+dbstatus<>0THEN inittupel(dnrlehrveranstaltungen)FI ELSE inittupel(
+dnrlehrveranstaltungen)FI ;merkesatzalsnachfolgerELSE nffachkennung:=""FI ;
+evtlleerzeilenhinzufuegen;werteausbszeileinstandardfeldersetzen;infeld(
+erstestabellenfeld);standardfelderausgeben;.evtlleerzeilenhinzufuegen:
+anzahlgezeigtezeilen:=izeile;WHILE izeile<zeilenanzahlREP izeileINCR 1;
+bszeile(izeile).jgst:=text(jgstdesletztensatzes);bszeile(izeile).fach:="";
+bszeile(izeile).kennung:="";bszeile(izeile).kopplung:="";bszeile(izeile).art
+:="";bszeile(izeile).klasse1:="";bszeile(izeile).klasse2:="";bszeile(izeile).
+klasse3:="";bszeile(izeile).klasse4:="";bszeile(izeile).wstd:=""PER .
+werteausbszeileinstandardfeldersetzen:ifnr:=erstestabellenfeld;TEXT VAR 
+letztejgst:="-1";FOR izeileFROM 1UPTO zeilenanzahlREP IF bszeile(izeile).jgst
+=letztejgstTHEN standardmaskenfeld("  ",ifnr);ELSE letztejgst:=bszeile(izeile
+).jgst;standardmaskenfeld(textzweistellig(int(letztejgst)),ifnr);FI ;
+standardmaskenfeld(bszeile(izeile).fach,ifnr+1);standardmaskenfeld(bszeile(
+izeile).kennung,ifnr+2);standardmaskenfeld(bszeile(izeile).art,ifnr+3);
+standardmaskenfeld(bszeile(izeile).klasse1,ifnr+4);standardmaskenfeld(bszeile
+(izeile).klasse2,ifnr+5);standardmaskenfeld(bszeile(izeile).klasse3,ifnr+6);
+standardmaskenfeld(bszeile(izeile).klasse4,ifnr+7);standardmaskenfeld(bszeile
+(izeile).wstd,ifnr+8);ifnrINCR felderprozeilePER .merkesatzalsnachfolger:
+nfschulj:=wert(fnrlvsj);nfhalbj:=wert(fnrlvhj);nfjgst:=wert(fnrlvjgst);
+nffachkennung:=wert(fnrlvfachkennung).END PROC bsfuellen;BOOL PROC 
+satzzubehandeln(INT CONST dummynr):IF NOT (izeile<zeilenanzahlCAND dbstatus=
+okCAND wert(fnrlvsj)=gewschuljCAND wert(fnrlvhj)=gewhalbj)THEN LEAVE 
+satzzubehandelnWITH FALSE FI ;IF NOT jgstangabeleerCAND intwert(fnrlvjgst)<>
+int(vgljgst)THEN LEAVE satzzubehandelnWITH FALSE FI ;IF NOT fachangabeleer
+CAND compress(subtext(wert(fnrlvfachkennung),1,fachlaenge))<>vglfachTHEN 
+LEAVE satzzubehandelnWITH FALSE FI ;TRUE .END PROC satzzubehandeln;PROC 
+satzmerken:izeileINCR 1;bszeile(izeile).jgst:=wert(fnrlvjgst);
+jgstdesletztensatzes:=intwert(fnrlvjgst);bszeile(izeile).fach:=compress(
+subtext(wert(fnrlvfachkennung),1,2));bszeile(izeile).kennung:=subtext(wert(
+fnrlvfachkennung),3);bszeile(izeile).kopplung:=wert(fnrlvkopplung);bszeile(
+izeile).art:=wert(fnrlvart);bszeile(izeile).klasse1:=wert(fnrlvklgrp1);
+bszeile(izeile).klasse2:=wert(fnrlvklgrp2);bszeile(izeile).klasse3:=wert(
+fnrlvklgrp3);bszeile(izeile).klasse4:=wert(fnrlvklgrp4);bszeile(izeile).wstd
+:=wert(fnrlvwochenstd);.END PROC satzmerken;PROC lehrveranstaltungenspeichern
+(BOOL CONST speichern):IF speichernTHEN plausipruefung;ELSE pruefstatus:=0FI 
+;IF pruefstatus<>0THEN infeld(pruefstatus);return(1)ELSE datenspeichern(
+speichern);IF nachfolgesatzvorhandenTHEN holewertedesnachfolgersatzes;search(
+dnrlehrveranstaltungen,TRUE );IF dbstatus<>0THEN search(
+dnrlehrveranstaltungen,FALSE )FI ;izeile:=0;IF satzzubehandeln(izeile)THEN 
+changeindex;leerenbszeigen:=FALSE ;setzejgstfuerneuenbildschirm;
+naechstenbildschirmzeigenELSE enter(2)FI ELIF letzteeingabezeilegefuelltTHEN 
+leerenbszeigen:=TRUE ;naechstenbildschirmzeigenELSE enter(2)FI ;FI .
+nachfolgesatzvorhanden:nffachkennung<>"".letzteeingabezeilegefuellt:
+standardmaskenfeld((zeilenanzahl-1)*felderprozeile+ersteseingabefeld)<>"".
+holewertedesnachfolgersatzes:putwert(fnrlvsj,nfschulj);putwert(fnrlvhj,
+nfhalbj);putwert(fnrlvjgst,nfjgst);putwert(fnrlvfachkennung,nffachkennung).
+naechstenbildschirmzeigen:bsfuellen;infeld(ersteseingabefeld);return(1).
+setzejgstfuerneuenbildschirm:izeile:=zeilenanzahl;WHILE 
+keinbezugaufletztensatzREP izeileDECR 1PER ;jgstdesletztensatzes:=int(bszeile
+(izeile).jgst);.keinbezugaufletztensatz:bszeile(izeile).fach="".END PROC 
+lehrveranstaltungenspeichern;PROC datenspeichern(BOOL CONST speichern):IF 
+speichernTHEN standardmeldung(meldnrdatenspeichern,"");
+datenspeicherungdurchfuehren;ELSE standardmeldung(meldnrdatennichtspeichern,
+"");FI ;END PROC datenspeichern;PROC datenspeicherungdurchfuehren:BOOL VAR 
+aenderungsvermerkzusetzen:=FALSE ;FOR izeileFROM 1UPTO zeilenanzahlREP 
+holevergleichswerte;IF lvzeileloeschenTHEN aenderungszeileanzeigen;
+aenderungsvermerkzusetzen:=TRUE ;altelvloeschenELIF lvzeileeinfuegenTHEN 
+aenderungszeileanzeigen;aenderungsvermerkzusetzen:=TRUE ;neuelveinfuegenELIF 
+lvzeileueberschreibenTHEN aenderungszeileanzeigen;aenderungsvermerkzusetzen:=
+TRUE ;altelvupdateFI PER ;IF aenderungsvermerkzusetzenTHEN IF 
+aktuelleshalbjahrzubearbeitenTHEN aenderungsvermerksetzen(wertaktuell)ELSE 
+aenderungsvermerksetzen(wertgeplant)FI FI .holevergleichswerte:INT VAR 
+prueffnr:=fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr);
+TEXT VAR altesfach:=bszeile(izeile).fach.lvzeileloeschen:prueffach=""CAND 
+altesfach<>"".altelvloeschen:setzealtesuchwerteindbpuffer;search(
+dnrlehrveranstaltungen,TRUE );IF dbstatus=0THEN delete(dnrlehrveranstaltungen
+);evtlkurswahldatenbeimbearbeitenaktualisierenFI .lvzeileeinfuegen:prueffach
+<>""CAND altesfach="".neuelveinfuegen:setzeneuewerteindbpuffer;
+setzenichtsichtbarewerteindbpuffer;insert(dnrlehrveranstaltungen);
+evtlkurswahldatenbeimbearbeitenaktualisieren.lvzeileueberschreiben:NOT (
+standardmaskenfeld(prueffnr)=bszeile(izeile).fachCAND standardmaskenfeld(
+prueffnr+1)=bszeile(izeile).kennungCAND standardmaskenfeld(prueffnr+2)=
+bszeile(izeile).artCAND standardmaskenfeld(prueffnr+3)=bszeile(izeile).
+klasse1CAND standardmaskenfeld(prueffnr+4)=bszeile(izeile).klasse2CAND 
+standardmaskenfeld(prueffnr+5)=bszeile(izeile).klasse3CAND standardmaskenfeld
+(prueffnr+6)=bszeile(izeile).klasse4CAND standardmaskenfeld(prueffnr+7)=
+bszeile(izeile).wstd).altelvupdate:setzealtesuchwerteindbpuffer;search(
+dnrlehrveranstaltungen,TRUE );setzeneuewerteindbpuffer;IF standardmaskenfeld(
+prueffnr)<>bszeile(izeile).fachCOR compress(standardmaskenfeld(prueffnr+1))<>
+bszeile(izeile).kennungTHEN setzenichtsichtbarewerteindbpufferFI ;update(
+dnrlehrveranstaltungen);evtlkurswahldatenbeimbearbeitenaktualisieren.
+setzealtesuchwerteindbpuffer:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,
+gewhalbj);putwert(fnrlvjgst,bszeile(izeile).jgst);putwert(fnrlvfachkennung,
+text(altesfach,fachlaenge)+bszeile(izeile).kennung).setzeneuewerteindbpuffer:
+putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj);putwert(fnrlvjgst,
+bszeile(izeile).jgst);putwert(fnrlvfachkennung,neuekennung);putwert(fnrlvart,
+standardmaskenfeld(prueffnr+2));putwert(fnrlvklgrp1,standardmaskenfeld(
+prueffnr+3));putwert(fnrlvklgrp2,standardmaskenfeld(prueffnr+4));putwert(
+fnrlvklgrp3,standardmaskenfeld(prueffnr+5));putwert(fnrlvklgrp4,
+standardmaskenfeld(prueffnr+6));putwert(fnrlvwochenstd,standardmaskenfeld(
+prueffnr+7)).setzenichtsichtbarewerteindbpuffer:putwert(fnrlvkopplung,
+neuekopplung);putwert(fnrlvparaphe,"");putwert(fnrlvraumgrp1,"");putwert(
+fnrlvraumgrp2,"").neuekennung:text(prueffach,fachlaenge)+compress(
+standardmaskenfeld(prueffnr+1)).neuekopplung:textzweistellig(int(bszeile(
+izeile).jgst))+neuekennung.END PROC datenspeicherungdurchfuehren;PROC 
+evtlkurswahldatenbeimbearbeitenaktualisieren:IF intwert(fnrlvjgst)>jgst10
+THEN IF aktuelleshalbjahrzubearbeitenOR gewhalbj=zweiteshalbjahrTHEN 
+kurswahlserverlvaktualisieren(wert(fnrlvjgst),wert(fnrlvjgst),gewhalbj)ELSE 
+kurswahlserverlvaktualisieren(text(intwert(fnrlvjgst)-1),wert(fnrlvjgst),
+gewhalbj)FI FI END PROC evtlkurswahldatenbeimbearbeitenaktualisieren;PROC 
+aenderungszeileanzeigen:infeld((izeile-1)*felderprozeile+ersteseingabefeld)
+END PROC aenderungszeileanzeigen;PROC lehrveranstaltungenzeileeinfuegen(BOOL 
+CONST zeilerein):INT VAR erstefnr;IF zeilereinTHEN zeileeinfuegenELSE 
+zeileloeschenFI ;return(1).zeileeinfuegen:aktzeile:=bearbeitungszeilezufeld(
+infeld);IF aktzeile=zeilenanzahlTHEN standardmeldung(
+meldnrletztezeilenichteinfuegen,"");LEAVE zeileeinfuegenFI ;IF bszeile(
+zeilenanzahl).fach<>""THEN merkeverdraengtensatzalsnachfolgesatz;
+anzahlgezeigtezeilen:=zeilenanzahlFI ;FOR izeileFROM zeilenanzahl-1DOWNTO 
+aktzeile+1REP zeileiminternenpufferverschieben;
+wertederzeileaufdembildschirmverschiebenPER ;izeile:=aktzeile+1;
+leerzeileschreiben;jgstineingefuegterzeilevermerken;neuezeilenausgeben.
+merkeverdraengtensatzalsnachfolgesatz:nfschulj:=gewschulj;nfhalbj:=gewhalbj;
+nfjgst:=bszeile(zeilenanzahl).jgst;nffachkennung:=text(bszeile(zeilenanzahl).
+fach,fachlaenge)+bszeile(zeilenanzahl).kennung.
+zeileiminternenpufferverschieben:bszeile(izeile+1).jgst:=bszeile(izeile).jgst
+;bszeile(izeile+1).fach:=bszeile(izeile).fach;bszeile(izeile+1).kennung:=
+bszeile(izeile).kennung;bszeile(izeile+1).kopplung:=bszeile(izeile).kopplung;
+bszeile(izeile+1).art:=bszeile(izeile).art;bszeile(izeile+1).klasse1:=bszeile
+(izeile).klasse1;bszeile(izeile+1).klasse2:=bszeile(izeile).klasse2;bszeile(
+izeile+1).klasse3:=bszeile(izeile).klasse3;bszeile(izeile+1).klasse4:=bszeile
+(izeile).klasse4;bszeile(izeile+1).wstd:=bszeile(izeile).wstd;.
+wertederzeileaufdembildschirmverschieben:FOR ifnrFROM erstesfeldderzeileUPTO 
+letztesfeldderzeileREP standardmaskenfeld(standardmaskenfeld(ifnr),ifnr+
+felderprozeile)PER .erstesfeldderzeile:(izeile-1)*felderprozeile+
+erstestabellenfeld.letztesfeldderzeile:erstesfeldderzeile+felderprozeile-1.
+jgstineingefuegterzeilevermerken:bszeile(izeile).jgst:=bszeile(aktzeile).jgst
+;bszeile(izeile).fach:="";bszeile(izeile).kennung:="";bszeile(izeile).
+kopplung:="";bszeile(izeile).art:="";bszeile(izeile).klasse1:="";bszeile(
+izeile).klasse2:="";bszeile(izeile).klasse3:="";bszeile(izeile).klasse4:="";
+bszeile(izeile).wstd:="";standardmaskenfeld(textzweistellig(int(bszeile(
+izeile).jgst)),erstefnr);.zeileloeschen:izeile:=bearbeitungszeilezufeld(
+infeld);leerzeileschreiben;neuezeilenausgeben.leerzeileschreiben:erstefnr:=
+erstesfeldderzeile;standardmaskenfeld("  ",erstefnr);FOR ifnrFROM erstefnr+1
+UPTO letztesfeldderzeileREP standardmaskenfeld("",ifnr)PER .
+neuezeilenausgeben:infeld(erstefnr);standardfelderausgeben;infeld(erstefnr+1)
+.END PROC lehrveranstaltungenzeileeinfuegen;INT PROC bearbeitungszeilezufeld(
+INT CONST feldnr):((feldnr-erstestabellenfeld)DIV felderprozeile)+1END PROC 
+bearbeitungszeilezufeld;PROC eingangsbehandlung(INT CONST plausiart):LET 
+uebernehmen=1,bearbeiten=2;BOOL VAR ok;reinitparsing;eingangsmaskenfehler:=
+FALSE ;ankreuzfelderpruefen;IF mehralseineauswahlangekreuztTHEN 
+standardmeldung(meldnrungueltigeauswahl,"");pruefstatus:=fnrbearbeiten;
+eingangsmaskenfehler:=TRUE ;LEAVE eingangsbehandlungFI ;IF 
+uebernehmenpruefungTHEN IF ankreuz1THEN ankreuzfehler(fnrbearbeiten);LEAVE 
+eingangsbehandlungFI ELIF bearbeitenpruefungTHEN IF ankreuz2THEN 
+ankreuzfehler(fnrfachanguebernehmen);LEAVE eingangsbehandlungELIF ankreuz3
+THEN ankreuzfehler(fnrlehrveruebernehmen);LEAVE eingangsbehandlungFI FI ;IF 
+bearbeitenpruefungTHEN standardpruefe(5,fnrbearbaktsj,fnrbearbgeplsj,0,"",
+pruefstatus);IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ;LEAVE 
+eingangsbehandlungELSE jgstpruefung(fnrbearbjgst,ok);IF NOT okTHEN jgstfehler
+(fnrbearbjgst);LEAVE eingangsbehandlungFI ;vgljgst:=standardmaskenfeld(
+fnrbearbjgst);vglfach:=compress(standardmaskenfeld(fnrbearbfach))FI ELIF 
+ankreuz2THEN standardpruefe(5,fnrfachangaktsj,fnrfachanggeplsj,0,"",
+pruefstatus);IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ;LEAVE 
+eingangsbehandlungELSE jgstpruefung(fnrfachangjgst,ok);IF NOT okTHEN 
+jgstfehler(fnrfachangjgst);LEAVE eingangsbehandlungELSE vgljgst:=
+standardmaskenfeld(fnrfachangjgst)FI ;FI ELSE jgstpruefung(fnrlehrverjgst,ok)
+;IF NOT okTHEN jgstfehler(fnrlehrverjgst);LEAVE eingangsbehandlungELSE 
+vgljgst:=standardmaskenfeld(fnrlehrverjgst)FI ;FI ;IF ankreuz1THEN FOR ifnr
+FROM fnrfachanguebernehmenUPTO fnrlehrverjgstREP IF standardmaskenfeld(ifnr)
+<>""THEN eintragfehler(ifnr);LEAVE eingangsbehandlungFI PER ELIF ankreuz2
+THEN FOR ifnrFROM fnrbearbeitenUPTO fnrbearbfachREP IF standardmaskenfeld(
+ifnr)<>""THEN eintragfehler(ifnr);LEAVE eingangsbehandlungFI PER ;IF 
+standardmaskenfeld(fnrlehrverjgst)<>""THEN eintragfehler(fnrlehrverjgst);
+LEAVE eingangsbehandlungFI ELSE FOR ifnrFROM fnrbearbeitenUPTO fnrfachangjgst
+REP IF standardmaskenfeld(ifnr)<>""THEN eintragfehler(ifnr);LEAVE 
+eingangsbehandlungFI PER FI .ankreuzfelderpruefen:INT VAR summe:=0;IF 
+ankreuz1THEN summeINCR 1FI ;IF ankreuz2THEN summeINCR 1FI ;IF ankreuz3THEN 
+summeINCR 1FI .mehralseineauswahlangekreuzt:summe<>1.ankreuz1:
+standardmaskenfeld(fnrbearbeiten)<>"".ankreuz2:standardmaskenfeld(
+fnrfachanguebernehmen)<>"".ankreuz3:standardmaskenfeld(fnrlehrveruebernehmen)
+<>"".uebernehmenpruefung:plausiart=uebernehmen.bearbeitenpruefung:plausiart=
+bearbeiten.END PROC eingangsbehandlung;PROC ankreuzfehler(INT CONST 
+fehlerfeld):pruefstatus:=fehlerfeld;eingangsmaskenfehler:=TRUE ;
+standardmeldung(meldnrfalschetastezuankreuz,"").END PROC ankreuzfehler;PROC 
+jgstpruefung(INT CONST fnrpruefjgst,BOOL VAR ok):IF standardmaskenfeld(
+fnrpruefjgst)=""THEN bearbeitungallerjgst:=TRUE ;ok:=TRUE ;ELSE 
+bearbeitungallerjgst:=FALSE ;gewjgst:=int(standardmaskenfeld(fnrpruefjgst));
+ok:=lastconversionokCAND (gewjgst=jgst0OR (gewjgst>=jgst5AND gewjgst<=jgst13)
+)FI END PROC jgstpruefung;PROC jgstfehler(INT CONST fehlerfeld):pruefstatus:=
+fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung(meldnrfehlerhaftejgst,
+"").END PROC jgstfehler;PROC eintragfehler(INT CONST fehlerfeld):pruefstatus
+:=fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung(
+meldnrfalscheausfuellung,"").END PROC eintragfehler;PROC plausipruefung:
+pruefstatus:=0;facheintraegepruefen;IF eingabefehlerTHEN LEAVE plausipruefung
+FI ;datenkonsistenzpruefen;IF eingabefehlerTHEN LEAVE plausipruefungFI .
+eingabefehler:pruefstatus<>0.END PROC plausipruefung;PROC 
+facheintraegepruefen:anzahleingegebenezeilen:=0;geprueftefaecher:=trenner;IF 
+gueltigeschuelergruppen=""THEN holegueltigeschuelergruppenFI ;IF 
+gueltigeklassengruppen=""THEN holegueltigeklassengruppenFI ;IF gueltigelvart=
+""THEN holegueltigelvartenFI ;FOR izeileFROM 1UPTO zeilenanzahlREP IF 
+fachfehlerTHEN LEAVE facheintraegepruefenFI PER .fachfehler:INT VAR prueffnr
+:=fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr);IF 
+prueffachleerTHEN IF eintraginfolgefelderderzeileTHEN pruefstatus:=prueffnr;
+standardmeldung(meldnrkeinfachzuanderenangaben,"");TRUE ELSE FALSE FI ELIF 
+prueffachungueltigTHEN pruefstatus:=prueffnr;standardmeldung(
+meldnrungueltigesfach,"");TRUE ELIF length(standardmaskenfeld(prueffnr+
+incrfuerkennung))>kennunglaengeTHEN pruefstatus:=prueffnr+incrfuerkennung;
+standardmeldung(meldnrkennungzulang,"");TRUE ELIF compress(standardmaskenfeld
+(prueffnr+incrfuerkennung))=""THEN pruefstatus:=prueffnr+incrfuerkennung;
+standardmeldung(meldnrbitteangabegenauer,"");TRUE ELIF lvartungueltigTHEN 
+TRUE ELIF klassengruppenungueltigTHEN TRUE ELIF wochenstundenungueltigTHEN 
+pruefstatus:=prueffnr+incrfuerwstd;TRUE ELSE anzahleingegebenezeilenINCR 1;
+FALSE FI .prueffachleer:prueffach="".eintraginfolgefelderderzeile:
+standardmaskenfeld(prueffnr+1)<>""COR standardmaskenfeld(prueffnr+2)<>""COR 
+standardmaskenfeld(prueffnr+3)<>""COR standardmaskenfeld(prueffnr+4)<>""COR 
+standardmaskenfeld(prueffnr+5)<>""COR standardmaskenfeld(prueffnr+6)<>""COR 
+standardmaskenfeld(prueffnr+7)<>"".prueffachungueltig:IF 
+fachkuerzelschongeprueftTHEN FALSE ELIF fachimfachbestandTHEN 
+geprueftefaecherCAT prueffach;geprueftefaecherCAT trenner;FALSE ELSE TRUE FI 
+.fachkuerzelschongeprueft:pos(geprueftefaecher,trenner+prueffach+trenner)>0.
+fachimfachbestand:putwert(fnrffach,prueffach);search(dnrfaecher,TRUE );
+dbstatus=0.lvartungueltig:IF pos(gueltigelvart,trenner+standardmaskenfeld(
+prueffnr+incrfuerlvart)+trenner)=0THEN standardmeldung(meldnrungueltigeart,""
+);pruefstatus:=prueffnr+incrfuerlvart;TRUE ELSE FALSE FI .
+klassengruppenungueltig:pruefjgst:=int(bszeile(izeile).jgst);FOR ifnrFROM 
+prueffnr+incrfuerklassengranfangUPTO prueffnr+incrfuerklassengrendeREP 
+pruefklasse:=standardmaskenfeld(ifnr);IF klassengruppeungueltigTHEN 
+standardmeldung(meldnrungueltigeklassengruppe,"");pruefstatus:=ifnr;LEAVE 
+klassengruppenungueltigWITH TRUE FI PER ;FALSE .klassengruppeungueltig:IF 
+pruefklasse=""THEN FALSE ELIF pruefklasseistschuelergruppeTHEN FALSE ELIF 
+pruefklasseistklassengruppeTHEN FALSE ELIF pruefklasseistgueltigejgstTHEN 
+FALSE ELSE TRUE FI .pruefklasseistschuelergruppe:pos(gueltigeschuelergruppen,
+trenner+bszeile(izeile).jgst+pruefklasse+trenner)>0.
+pruefklasseistklassengruppe:IF pos(gueltigeklassengruppen,trenner+pruefklasse
++trenner)=0THEN FALSE ELIF pruefjgst=jgst0THEN TRUE ELSE putwert(
+fnrkgklassengrp,pruefklasse);search(dnrklassengruppen,TRUE );IF dbstatus<>0
+THEN FALSE ELSE sugruppen:=wert(fnrkgschuelergrp);laengesugruppen:=length(
+sugruppen);possugruppe:=1;WHILE possugruppe<laengesugruppenREP sugruppejgst:=
+subtext(sugruppen,possugruppe,possugruppe+1);IF int(sugruppejgst)<>pruefjgst
+THEN LEAVE pruefklasseistklassengruppeWITH FALSE FI ;possugruppeINCR 
+laengeeinersugruppePER ;TRUE FI FI .pruefklasseistgueltigejgst:gueltigejgst:=
+FALSE ;pruefbez:=int(pruefklasse);IF lastconversionokTHEN IF pruefbez>=jgst5
+CAND pruefbez<=jgst13THEN IF pruefjgst=jgst0OR pruefjgst=pruefbezTHEN 
+gueltigejgst:=TRUE FI FI FI ;gueltigejgst.wochenstundenungueltig:
+standardpruefe(1,prueffnr+incrfuerwstd,0,0,"",pruefstatus);IF pruefstatus=0
+THEN standardpruefe(2,prueffnr+incrfuerwstd,0,0,"",pruefstatus);pruefstatus<>
+0ELSE TRUE FI .END PROC facheintraegepruefen;INT PROC fachfnrin(INT CONST 
+zeilennr):(zeilennr-1)*felderprozeile+ersteseingabefeldEND PROC fachfnrin;
+PROC datenkonsistenzpruefen:FOR izeileFROM 1UPTO zeilenanzahlREP IF 
+zeileungueltigTHEN pruefstatus:=prueffnr;standardmeldung(
+meldnrlehrveranstaltunggibtsschon,"");LEAVE datenkonsistenzpruefenFI PER .
+zeileungueltig:IF leerzeileTHEN FALSE ELIF 
+zeileistimschluesselunveraendertgebliebenTHEN FALSE ELSE 
+ergebnisderpruefungzeileschongespeichertFI .leerzeile:INT VAR prueffnr:=
+fachfnrin(izeile);TEXT VAR prueffach:=standardmaskenfeld(prueffnr);prueffach=
+"".zeileistimschluesselunveraendertgeblieben:standardmaskenfeld(prueffnr)=
+bszeile(izeile).fachCAND compress(standardmaskenfeld(prueffnr+1))=bszeile(
+izeile).kennung.ergebnisderpruefungzeileschongespeichert:
+neuewerteindbpuffersetzen;search(dnrlehrveranstaltungen,TRUE );dbstatus=0.
+neuewerteindbpuffersetzen:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj
+);putwert(fnrlvjgst,bszeile(izeile).jgst);putwert(fnrlvfachkennung,text(
+prueffach,fachlaenge)+compress(standardmaskenfeld(prueffnr+1))).END PROC 
+datenkonsistenzpruefen;PROC schulhalbjahrbestimmen:IF akthalbj=""THEN 
+akthalbj:=schulkenndatum(texthalbj);aktschulj:=schulkenndatum(textschulj)FI ;
+IF standardmaskenfeld(fnrlehrveruebernehmen)<>""THEN 
+aktuelleshalbjahrzubearbeiten:=FALSE ELSE aktuelleshalbjahrzubearbeiten:=
+standardmaskenfeld(fnrbearbaktsj)<>""OR standardmaskenfeld(fnrfachangaktsj)<>
+""FI ;gewhalbj:=akthalbj;gewschulj:=aktschulj;IF NOT 
+aktuelleshalbjahrzubearbeitenTHEN geplanteshjundsjberechnen(gewhalbj,
+gewschulj)FI END PROC schulhalbjahrbestimmen;PROC holegueltigeschuelergruppen
+:gueltigeschuelergruppen:=trenner;inittupel(dnraktschuelergruppen);
+statleseschleife(dnraktschuelergruppen,gewschulj,gewhalbj,fnrsgrpsj,fnrsgrphj
+,PROC schuelergruppelesen)END PROC holegueltigeschuelergruppen;PROC 
+schuelergruppelesen(BOOL VAR b):IF dbstatus<>0OR wert(fnrsgrpsj)<>gewschulj
+OR wert(fnrsgrphj)<>gewhalbjTHEN b:=TRUE ELSE gueltigeschuelergruppenCAT wert
+(fnrsgrpjgst);gueltigeschuelergruppenCAT wert(fnrsgrpkennung);
+gueltigeschuelergruppenCAT trennerFI END PROC schuelergruppelesen;PROC 
+holegueltigeklassengruppen:gueltigeklassengruppen:=trenner;inittupel(
+dnrklassengruppen);statleseschleife(dnrklassengruppen,"","",fnrkgklassengrp,
+fnrkgklassengrp,PROC klassengruppelesen)END PROC holegueltigeklassengruppen;
+PROC klassengruppelesen(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE 
+gueltigeklassengruppenCAT wert(fnrkgklassengrp);gueltigeklassengruppenCAT 
+trennerFI END PROC klassengruppelesen;PROC holegueltigelvarten:gueltigelvart
+:=trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel,artbestand,
+"",fnrschlsachgebiet,fnrschlschluessel,PROC holelvart)END PROC 
+holegueltigelvarten;PROC holelvart(BOOL VAR b):IF wert(fnrschlsachgebiet)>
+artbestandCOR dbstatus<>0THEN b:=TRUE ELSE gueltigelvartCAT wert(
+fnrschlschluessel);gueltigelvartCAT trennerFI END PROC holelvart;TEXT PROC 
+textzweistellig(INT CONST i):IF i<10THEN "0"+text(i)ELSE text(i)FI END PROC 
+textzweistellig;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR iFROM 1
+UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC 
+initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT 
+VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(
+i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC 
+wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO 
+feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC 
+wertedeseingangsbildschirmsholen;PROC initbszeilepuffer:FOR izeileFROM 1UPTO 
+zeilenanzahlREP bszeile(izeile).jgst:="";bszeile(izeile).fach:="";bszeile(
+izeile).kennung:="";bszeile(izeile).art:="";bszeile(izeile).klasse1:="";
+bszeile(izeile).klasse2:="";bszeile(izeile).klasse3:="";bszeile(izeile).
+klasse4:="";bszeile(izeile).wstd:="";PER END PROC initbszeilepuffer;END 
+PACKET lehrveranstaltungenbenennen
+
diff --git a/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken b/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken
new file mode 100644
index 0000000..3b86dd8
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.liste ausgewaehlter kopplungen drucken
@@ -0,0 +1,72 @@
+PACKET listeausgewaehlterkopplungendruckenDEFINES 
+listekopplungenmitanzlverstellen,listekopplungenmitanzlvdrucken:LET feldanzlv
+=2,feldakthj=3,anzkopfzeilen=9,anzzeilen=45,ausgparam="#",leerzeile=" ",
+meldungbearbwird=352,meldunglistedrucken=58,meldunglisteaufbereiten=7,
+meldungwarten=69,meldungkeinedaten=68,meldungfalscherwert=54,meldungkeinelv=
+326,dateiname="Liste der Kopplungen",zwdateiname="zwischenspeicherung",
+praefix="          ",ueberschrift="Liste aller Kopplungen",kopfzeile=
+"Kopplung   Anzahl gekoppelter Lehrveranstaltungen",stdkopf=
+"            1   2   3   4   5   6   7   8   9   10  11  12  13  14 >14",
+unterstrich=
+"----------+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---",
+spaltentrenner=":   :   :   :   :   :   :   :   :   :   :   :   :   :   :   "
+,spaltentrenner1=
+": x :   :   :   :   :   :   :   :   :   :   :   :   :   :   ",
+spaltentrennerl=
+":   :   :   :   :   :   :   :   :   :   :   :   :   :   : x ",schuljahr=
+"Schuljahr",halbjahr="Schulhalbjahr",schulname="Schulname",schulort=
+"Schulort";TEXT VAR schj,schhj,aktkopplung:="",postfix:="",anzseiten,
+ueberschriftanhang,anzahllv:="",neuerkopf:="";INT VAR i,j,anzlv,anwanzlv,
+spaltenindex,anzs;BOOL VAR erstekopplung:=TRUE ;FILE VAR datei,zwdatei;PROC 
+listekopplungenmitanzlverstellen:standardmeldung(meldungwarten,"");schj:=
+schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF 
+standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen(schhj,schj)FI 
+;anzahllv:=standardmaskenfeld(feldanzlv);IF anzahllv<>""THEN anwanzlv:=int(
+anzahllv);IF lastconversionokTHEN IF anwanzlv<1COR anwanzlv>99THEN 
+fehlermeldungfalscherwertFI ELSE fehlermeldungfalscherwertFI ;
+ueberschriftanhang:=" ab "+text(anwanzlv)+" Lehrveranstaltungen";ELSE 
+anwanzlv:=1;ueberschriftanhang:=""FI ;spaltenindex:=anwanzlv-1;inittupel(
+dnrlehrveranstaltungen);IF records(dnrlehrveranstaltungen)=0.0THEN 
+standardmeldung(meldungkeinelv,"");return(1)ELSE bereiteprotokollvor;dbstatus
+(0);erstekopplung:=TRUE ;aktkopplung:="";anzlv:=1;statleseschleife(
+ixlvsjhjkopp,schj,schhj,fnrlvsj,fnrlvhj,PROC holekopplungen);IF lines(datei)=
+anzkopfzeilenTHEN standardmeldung(meldungkeinedaten,"");return(1);ELSE 
+zeigedatei(dateiname,"vr")FI FI .fehlermeldungfalscherwert:standardmeldung(
+meldungfalscherwert,"");return(1);LEAVE listekopplungenmitanzlverstellen.
+bereiteprotokollvor:standardmeldung(meldunglisteaufbereiten,"");forget(
+dateiname,quiet);datei:=sequentialfile(output,dateiname);forget(zwdateiname,
+quiet);zwdatei:=sequentialfile(output,zwdateiname);schreibkopf(datei).END 
+PROC listekopplungenmitanzlverstellen;PROC schreibkopf(FILE VAR dat):INT VAR 
+k;putline(dat,schulkenndatum(schulname));putline(dat,text(schulkenndatum(
+schulort),65)+date);putline(dat,leerzeile);putline(dat,ueberschrift+
+ueberschriftanhang);putline(dat,"Schuljahr  19"+text(schj,2)+"/"+subtext(schj
+,3)+"  "+schhj+". Halbjahr");putline(dat,leerzeile);putline(dat,kopfzeile);
+IF anwanzlv=1THEN putline(dat,stdkopf)ELSE neuerkopf:=praefix;FOR kFROM 1
+UPTO 14REP neuerkopfCAT text(anwanzlv-1+k,4)PER ;neuerkopfCAT " >"+text(
+anwanzlv+13);putline(dat,neuerkopf)FI ;putline(dat,unterstrich).END PROC 
+schreibkopf;PROC schreibfuss(INT CONST nr):putline(zwdatei,leerzeile);putline
+(zwdatei,leerzeile);putline(zwdatei,text(nr,70)+"/"+anzseiten);putline(
+zwdatei,"#page#")END PROC schreibfuss;PROC holekopplungen(BOOL VAR b):IF wert
+(fnrlvsj)<>schjCOR wert(fnrlvhj)<>schhjCOR dbstatus<>0THEN dbstatus(1);b:=
+TRUE ELIF aktkopplung<>wert(fnrlvkopplung)THEN gibeintragaus;aktkopplung:=
+wert(fnrlvkopplung);standardmeldung(meldungbearbwird,aktkopplung+ausgparam);
+anzlv:=1ELSE anzlvINCR 1FI .gibeintragaus:IF erstekopplungTHEN erstekopplung
+:=FALSE ELIF anzlv=anwanzlvTHEN putline(datei,text(aktkopplung,10)+
+spaltentrenner1)ELIF anzlv>anwanzlv+13THEN putline(datei,text(aktkopplung,10)
++spaltentrennerl)ELIF anzlv>anwanzlvCAND anzlv<anwanzlv+14THEN postfix:=
+spaltentrenner;replace(postfix,(anzlv-spaltenindex)*4-1,"x");putline(datei,
+text(aktkopplung,10)+postfix)FI .END PROC holekopplungen;PROC 
+listekopplungenmitanzlvdrucken:INT VAR volleseiten:=0,restzeilen:=0;TEXT VAR 
+zeile:="";standardmeldung(meldunglistedrucken,"");modify(datei);
+ermittleseiten;giballeseitenaus.ermittleseiten:i:=lines(datei)-anzkopfzeilen;
+anzs:=iDIV anzzeilen;volleseiten:=anzs;restzeilen:=iMOD anzzeilen;IF 
+restzeilen<>0THEN anzsINCR 1FI ;anzseiten:=text(anzs,2).giballeseitenaus:
+toline(datei,anzkopfzeilen+1);FOR iFROM 1UPTO volleseitenREP schreibkopf(
+zwdatei);FOR jFROM 1UPTO anzzeilenREP readrecord(datei,zeile);down(datei);
+putline(zwdatei,zeile)PER ;schreibfuss(i)PER ;IF restzeilen<>0THEN 
+schreibkopf(zwdatei);FOR iFROM 1UPTO restzeilenREP readrecord(datei,zeile);
+down(datei);putline(zwdatei,zeile)PER ;FOR iFROM restzeilen+1UPTO anzzeilen
+REP putline(zwdatei,leerzeile)PER ;schreibfuss(anzs)FI ;print(zwdateiname);
+enter(2).END PROC listekopplungenmitanzlvdrucken;END PACKET 
+listeausgewaehlterkopplungendrucken;
+
diff --git a/app/schulis/2.2.1/src/4.listen.aufsichtsplan b/app/schulis/2.2.1/src/4.listen.aufsichtsplan
new file mode 100644
index 0000000..ba9c597
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.listen.aufsichtsplan
@@ -0,0 +1,78 @@
+PACKET aufsichtsplandruckenDEFINES aufsichtsplanmaskebearbeiten,
+aufsichtsplanggferstellen,aufsichtsplanzeigen,aufsichtsplandrucken:LET maske=
+"ms aufsichtsplan drucken eingang",mnrlistewirderstellt=7,
+mnrlistewirdgedruckt=58,mnrbittewarten=69,mnrlistewirdaufbereitet=190,
+mnrkeinedatenimbestand=68,blank=" ",sixblanks="      ";INT CONST fnr2aktsj:=2
+,fnr3ausgbs:=3,fnr4ausgdr:=4;INT VAR druckzeilenzahl;TEXT VAR 
+gesamtueberschrift,ueberschrift2,halbjahr,schuljahr,sjhjaufber,altertag;TEXT 
+CONST ueberschrift1:="Aufsicht  Aufsichtsorte ",ueberschrift3:=7*"----------"
++blank,aufsichtsorte:="c02 aufsichtsorte";FILE VAR showdatei,druckdatei;LET 
+niltext="",maxaufsichtszeiten=90,maxorteprozeile=10;ROW maxaufsichtszeiten
+TEXT VAR zeiten;ROW maxorteprozeileTEXT VAR ortejezeile;BOOL VAR keinedatenda
+;INT VAR status,zaehler,anzahlzeiten,anzahlorte;BOOL VAR bildschirmausgabe;
+PROC aufsichtsplanmaskebearbeiten:standardvproc(maske);END PROC 
+aufsichtsplanmaskebearbeiten;PROC aufsichtsplanggferstellen:standardpruefe(5,
+fnr3ausgbs,fnr4ausgdr,0,niltext,status);IF status<>0THEN infeld(status);
+return(1)ELSE bildschirmausgabe:=standardmaskenfeld(fnr4ausgdr)=niltext;
+standardmeldung(mnrbittewarten,niltext);ggfdatenmerkenundshowdateierstellen;
+IF keinedatendaTHEN standardmeldung(mnrkeinedatenimbestand,niltext);return(1)
+ELSE IF bildschirmausgabeTHEN aufsichtsplanzeigenELSE aufsichtsplandrucken(0)
+FI ;FI ;FI ;.ggfdatenmerkenundshowdateierstellen:halbjahr:=schulkenndatum(
+"Schulhalbjahr");schuljahr:=schulkenndatum("Schuljahr");IF standardmaskenfeld
+(fnr2aktsj)=niltextTHEN geplanteshjundsjberechnen(halbjahr,schuljahr)FI ;
+sjhjaufber:=subtext(schuljahr,1,2)+"/";sjhjaufberCAT subtext(schuljahr,3,4)+
+" ";sjhjaufberCAT halbjahr;zaehler:=0;keinedatenda:=FALSE ;inittupel(
+dnraufsichtszeiten);exactmatch(FALSE );statleseschleife(dnraufsichtszeiten,
+schuljahr,halbjahr,fnrazsj,fnrazhj,PROC aufsichtszeitenmerken);keinedatenda:=
+anzahlzeiten=0;IF NOT keinedatendaTHEN ggfdiezehnerstenortelesenFI ;.
+ggfdiezehnerstenortelesen:zaehler:=0;anzahlorte:=0;inittupel(dnrschluessel);
+putwert(fnrschlsachgebiet,aufsichtsorte);search(dnrschluessel,FALSE );IF 
+dbstatus<>0OR wert(fnrschlsachgebiet)<>aufsichtsorteTHEN keinedatenda:=TRUE ;
+ELSE maximalzehnortemerkenundueberschriftenbasteln;standardmeldung(
+mnrlistewirderstellt,niltext);TEXT CONST namedershowdatei:="Aufsichtsplan : "
++sjhjaufber+". Halbj.";forget(namedershowdatei,quiet);showdatei:=
+sequentialfile(output,namedershowdatei);inittupel(dnraufsichtsplan);putwert(
+fnrapsj,schuljahr);putwert(fnraphj,halbjahr);
+prozeitproorteintraegeausaufsichtsplaninshowdatei;IF anzahlorte=
+maxorteprozeileTHEN WHILE wert(fnrschlsachgebiet)=aufsichtsorteAND dbstatus<>
+3REP anzahlorte:=0;zaehler:=0;maximalzehnortemerkenundueberschriftenbasteln;
+prozeitproorteintraegeausaufsichtsplaninshowdatei;PER FI ;FI ;END PROC 
+aufsichtsplanggferstellen;PROC maximalzehnortemerkenundueberschriftenbasteln:
+ueberschrift2:="Tag Nr.  ";WHILE dbstatus<>3AND wert(fnrschlsachgebiet)=
+aufsichtsorteAND zaehler<maxorteprozeileREP zaehlerINCR 1;ortejezeile(zaehler
+):=wert(fnrschlschluessel);ueberschrift2CAT text(ortejezeile(zaehler),6);succ
+(dnrschluessel);PER ;anzahlorte:=zaehlerEND PROC 
+maximalzehnortemerkenundueberschriftenbasteln;PROC aufsichtszeitenmerken(
+BOOL VAR b):IF dbstatus<>0OR wert(fnrazhj)<>halbjahrTHEN b:=TRUE ;ELSE 
+zaehlerINCR 1;zeiten(zaehler):=wert(fnrazaufsichtszeit);FI ;anzahlzeiten:=
+zaehlerEND PROC aufsichtszeitenmerken;PROC 
+prozeitproorteintraegeausaufsichtsplaninshowdatei:INT VAR hilfszaehler;TEXT 
+VAR hilfstext,tag,aufsichtsnr,zeile;putline(showdatei,ueberschrift1);putline(
+showdatei,ueberschrift2);putline(showdatei,ueberschrift3);altertag:="";FOR 
+zaehlerFROM 1UPTO anzahlzeitenREP hilfstext:=zeiten(zaehler);putwert(
+fnrapaufsichtszeit,hilfstext);IF length(hilfstext)=2THEN aufsichtsnr:=" ";
+aufsichtsnrCAT subtext(hilfstext,2,2);ELSE aufsichtsnr:=subtext(hilfstext,2,3
+);FI ;tagnummeraufbereiten;FOR hilfszaehlerFROM 1UPTO anzahlorteREP putwert(
+fnrapaufsichtsort,ortejezeile(hilfszaehler));search(dnraufsichtsplan,TRUE );
+IF dbstatus=0THEN hilfstextCAT text(wert(fnrapparaphe),6);ELSE hilfstextCAT 
+sixblanksFI ;PER ;zeile:=hilfstext;hilfstext:=sixblanks;putline(showdatei,
+zeile);PER ;putline(showdatei,blank);.tagnummeraufbereiten:tag:=text(
+hilfstext,1);IF tag="1"THEN tag:="Mo "ELIF tag="2"THEN tag:="Di "ELIF tag="3"
+THEN tag:="Mi "ELIF tag="4"THEN tag:="Do "ELIF tag="5"THEN tag:="Fr "ELIF tag
+="6"THEN tag:="Sa "FI ;IF tag=altertagTHEN hilfstext:=3*blankELSE hilfstext:=
+tag;FI ;hilfstextCAT aufsichtsnr+".   ";altertag:=tagEND PROC 
+prozeitproorteintraegeausaufsichtsplaninshowdatei;PROC aufsichtsplanzeigen:
+zeigedatei("Aufsichtsplan : "+sjhjaufber+". Halbj.","a");END PROC 
+aufsichtsplanzeigen;PROC aufsichtsplandrucken(INT CONST ruecksprungregel):
+INT VAR zeilenzaehler:=1;TEXT VAR zeile;gesamtueberschrift:=
+"Aufsichtsplan für Schuljahr ";gesamtueberschriftCAT sjhjaufber;
+gesamtueberschriftCAT ". Halbjahr";druckdatei:=sequentialfile(output,
+"liste.1");input(showdatei);druckvorbereiten;druckzeilenzahl:=drucklaenge(2);
+initdruckkopf(gesamtueberschrift,blank);druckkopfschreiben;
+setzemitseitennummern(TRUE );WHILE NOT eof(showdatei)REP getline(showdatei,
+zeile);druckzeileschreiben(zeile);zeilenzaehlerINCR 1;IF zeilenzaehler>
+druckzeilenzahlTHEN seitenwechsel;zeilenzaehler:=1FI ;PER ;drucknachbereiten;
+IF ruecksprungregel=0THEN return(1)ELSE return(2)FI ;standardmeldung(
+mnrlistewirdgedruckt,niltext);END PROC aufsichtsplandrucken;END PACKET 
+aufsichtsplandrucken;
+
diff --git a/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung b/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung
new file mode 100644
index 0000000..39eaee2
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.listen.unterrichtsverteilung
@@ -0,0 +1,252 @@
+PACKET unterrichtsverteilunglistenDEFINES unterrichtsverteilungspezielleteile
+:LET AUSGFELD =ROW ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ,
+AUSGKOPFDRUCK =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;AUSGKOPF VAR 
+ausgkopf;AUSGKOPFDRUCK VAR ausgkopfdruck;LET maskeunterrichtsverteilung=
+"ms liste unterrichtsverteilung eingang",ausgfeldlaenge=1,
+anzahlderobjekteprobildschirm=17,ueberschriftenzeilen=2,ausgkopflaenge=2,
+spaltentrenner=" ",zweierspaltenbreite=2,viererspaltenbreite=4,
+fuenferspaltenbreite=5,achterspaltenbreite=8,neunerspaltenbreite=9,
+zehnerspaltenbreite=10,unterrichtsverteilunganfpos=2,niltext="",blank=" ",
+null=0,strich="-",mnrfachfalsch=305,mnrjgstfalsch=305,mnrbearbeitetwerden=352
+,mnrparapheungueltig=344,mnrauswahlnichtsinnvoll=56;TEXT VAR 
+neueranfbuchstabe,teiltextmeldung,unterrichtsverteilungueberschrift:="",
+schuljahr,halbjahr,altejahrgangsstufe:="",alteparaphe:="",altekopplung:="",
+altesfach,gewaehltejgst,gewaehlteparaphe,gewaehltesfach,bearbeitungsschuljahr
+,bearbeitungshalbjahr,jahrgangsstufe:="",fach,kennung,kopplung,paraphe,
+wochenstdn,klassengruppe1,klassengruppe2,klassengruppe3,klassengruppe4,
+raumgruppe1,raumgruppe2,anfbuchstabe,auswahlnichtsinnvoll;TEXT CONST 
+unterstreichung:=bildbreite*"-",leerzeile:=bildbreite*blank,textueb1:=
+"Jgst. ",textueb2:="Fach Kenng.  ",textueb3:="Paraphe ",textueb4:="Kopplung "
+,textueb5:="Wstd.  Klassengruppen        Räume   ";TEXT VAR textueberschrift
+:="";INT VAR eingabestatus,bildanfang,spalte2druckbreite,druckzeilenzahl,
+aktuelleindexnr:=dnrlehrveranstaltungen,feldnr,jgsthilfsvar;INT CONST 
+groesstejgst:=13,kleinstejgst:=5;BOOL VAR geplanteshjgewaehlt,erstezeile:=
+FALSE ,sortjgstalle,sortjgstbest,sortparaphenalle,sortparaphebest,
+sortkopplungen,sortfaecher,sortbestfach;BOOL PROC multistop:BOOL VAR b;IF 
+dbstatus=okTHEN IF sortjgstalleXOR sortparaphenalleXOR sortkopplungenXOR 
+sortfaecherTHEN b:=bearbeitungshalbjahr=wert(fnrlvhj)ELIF sortjgstbestTHEN b
+:=gewaehltejgst=wert(fnrlvjgst)AND bearbeitungshalbjahr=wert(fnrlvhj)ELIF 
+sortparaphebestTHEN b:=gewaehlteparaphe=wert(fnrlvparaphe)AND 
+bearbeitungshalbjahr=wert(fnrlvhj)ELIF sortbestfachTHEN b:=text(
+gewaehltesfach,2)=text(wert(fnrlvfachkennung),2)AND bearbeitungshalbjahr=wert
+(fnrlvhj)FI ;ELSE b:=FALSE FI ;bEND PROC multistop;BOOL PROC multistopsim:
+setzebestandende(FALSE );BOOL VAR b:=multistop;setzebestandende(NOT b);bEND 
+PROC multistopsim;PROC unterrichtsverteilungspezielleteile(INT CONST nr):
+SELECT nrOF CASE 1:unterrichtsverteilungdialogvorbereitenCASE 2:
+unterrichtsverteilungeingabenrichtigCASE 3:
+unterrichtsverteilunglistenvorbereitenCASE 4:
+unterrichtsverteilungdruckvorbereitenCASE 5:unterrichtsverteilungseitedrucken
+CASE 6:unterrichtsverteilungbildschirmvorbereitenCASE 7:
+unterrichtsverteilungseitezeigenENDSELECT .END PROC 
+unterrichtsverteilungspezielleteile;PROC 
+unterrichtsverteilungdialogvorbereiten:unterrichtsverteilungueberschrift:=
+text(vergleichsknoten);setzeanfangswerte(maskeunterrichtsverteilung,
+unterrichtsverteilunganfpos)END PROC unterrichtsverteilungdialogvorbereiten;
+PROC unterrichtsverteilungeingabenrichtig:LET fnrlehrveranstgn=2,
+fnrlehrveranstgnjgst=3,fnrkopplungen=4,fnrparaphen=5,fnrbestparaphe=6,
+fnrfaecher=7,fnrfach=8,fnraktuelleshj=9,fnrausgbild=10,fnrausgdrucker=11;
+sortjgstalle:=FALSE ;sortjgstbest:=FALSE ;sortparaphenalle:=FALSE ;
+sortparaphebest:=FALSE ;sortkopplungen:=FALSE ;sortfaecher:=FALSE ;
+sortbestfach:=FALSE ;IF ausgabemediumkorrektgewaehltTHEN setzeausgabedrucker(
+standardmaskenfeld(fnrausgbild)=niltext);geplanteshjgewaehlt:=
+standardmaskenfeld(fnraktuelleshj)=niltext;
+sortierartpruefenundmerkenbzwfehlermeldungausgeben;ELSE 
+meldefehlerauswahldruckerbildschirm;setzeeingabetest(FALSE )FI .
+ausgabemediumkorrektgewaehlt:standardpruefe(5,fnrausgbild,fnrausgdrucker,null
+,niltext,eingabestatus);eingabestatus=0.
+sortierartpruefenundmerkenbzwfehlermeldungausgeben:IF (standardmaskenfeld(
+fnrkopplungen)=niltextAND standardmaskenfeld(fnrparaphen)=niltextAND 
+standardmaskenfeld(fnrbestparaphe)=niltextAND standardmaskenfeld(fnrfaecher)=
+niltextAND standardmaskenfeld(fnrfach)=niltext)THEN IF standardmaskenfeld(
+fnrlehrveranstgn)=niltextTHEN meldefehler;setzeeingabetest(FALSE )ELSE 
+sortierungnachlehrveranstaltungenweiterpruefenFI ;ELSE IF NOT (
+standardmaskenfeld(fnrlehrveranstgn)=niltextAND standardmaskenfeld(
+fnrlehrveranstgnjgst)=niltext)THEN meldefehler;setzeeingabetest(FALSE )ELSE 
+sortierungnachkopplungenparaphenoderfaechernpruefenFI ;FI .
+sortierungnachlehrveranstaltungenweiterpruefen:IF standardmaskenfeld(
+fnrlehrveranstgnjgst)=niltextTHEN sortjgstalle:=TRUE ;setzeeingabetest(TRUE )
+ELSE IF jgstkorrektTHEN sortjgstbest:=TRUE ;setzeeingabetest(TRUE )ELSE 
+meldefehlerjgst;setzeeingabetest(FALSE )FI ;FI ;.
+sortierungnachkopplungenparaphenoderfaechernpruefen:IF standardmaskenfeld(
+fnrkopplungen)<>niltextTHEN IF standardmaskenfeld(fnrparaphen)=niltextAND 
+standardmaskenfeld(fnrbestparaphe)=niltextAND standardmaskenfeld(fnrfaecher)=
+niltextAND standardmaskenfeld(fnrfach)=niltextTHEN sortkopplungen:=TRUE ;
+setzeeingabetest(TRUE )ELSE meldefehler;setzeeingabetest(FALSE )FI ;ELSE IF 
+standardmaskenfeld(fnrparaphen)<>niltextTHEN IF standardmaskenfeld(fnrfaecher
+)=niltextAND standardmaskenfeld(fnrfach)=niltextTHEN 
+weiterepruefungzursortierungparaphenELSE meldefehler;setzeeingabetest(FALSE )
+FI ;ELSE IF standardmaskenfeld(fnrfaecher)<>niltextTHEN IF standardmaskenfeld
+(fnrparaphen)=niltextAND standardmaskenfeld(fnrbestparaphe)=niltextTHEN 
+weiterepruefungzursortierungfaecherELSE meldefehler;setzeeingabetest(FALSE )
+FI ;FI ;FI ;FI ;.weiterepruefungzursortierungparaphen:IF standardmaskenfeld(
+fnrbestparaphe)=niltextTHEN sortparaphenalle:=TRUE ;setzeeingabetest(TRUE )
+ELSE gewaehlteparaphe:=standardmaskenfeld(fnrbestparaphe);IF paraphekorrekt
+THEN sortparaphebest:=TRUE ;setzeeingabetest(TRUE )FI ;FI ;.
+weiterepruefungzursortierungfaecher:IF standardmaskenfeld(fnrfach)=niltext
+THEN sortfaecher:=TRUE ;setzeeingabetest(TRUE )ELSE gewaehltesfach:=
+standardmaskenfeld(fnrfach);IF fachkorrektTHEN sortbestfach:=TRUE ;
+setzeeingabetest(TRUE )FI ;FI ;.meldefehlerauswahldruckerbildschirm:infeld(
+fnrausgbild);standardmeldung(mnrauswahlnichtsinnvoll,niltext).meldefehler:
+meldungstext(mnrauswahlnichtsinnvoll,auswahlnichtsinnvoll);standardmeldung(
+auswahlnichtsinnvoll,niltext).jgstkorrekt:gewaehltejgst:=standardmaskenfeld(
+fnrlehrveranstgnjgst);jgsthilfsvar:=int(gewaehltejgst);IF NOT 
+lastconversionokTHEN LEAVE jgstkorrektWITH FALSE FI ;IF jgsthilfsvar<10THEN 
+gewaehltejgst:=text(jgsthilfsvar);FI ;jgsthilfsvar<=groesstejgstAND 
+jgsthilfsvar>=kleinstejgst.paraphekorrekt:inittupel(dnrlehrer);putwert(
+fnrlparaphe,gewaehlteparaphe);search(dnrlehrer,TRUE );dbstatus=ok.fachkorrekt
+:inittupel(dnrfaecher);putwert(fnrffach,gewaehltesfach);search(dnrfaecher,
+TRUE );dbstatus=ok.fehlerfalscheparaphe:standardmeldung(mnrparapheungueltig,
+niltext);infeld(fnrbestparaphe);.meldefehlerjgst:standardmeldung(
+mnrjgstfalsch,niltext);infeld(fnrlehrveranstgnjgst);.END PROC 
+unterrichtsverteilungeingabenrichtig;PROC 
+unterrichtsverteilunglistenvorbereiten:BOOL VAR b;initspalten;
+setzespaltentrenner(spaltentrenner);bearbeitungshalbjahr:=schulkenndatum(
+"Schulhalbjahr");bearbeitungsschuljahr:=schulkenndatum("Schuljahr");IF 
+geplanteshjgewaehltTHEN geplanteshjundsjberechnen(bearbeitungshalbjahr,
+bearbeitungsschuljahr);FI ;inittupel(dnrlehrveranstaltungen);setzeidentiwert(
+"");initobli(anzahlderobjekteprobildschirm);putwert(fnrlvsj,
+bearbeitungsschuljahr);putwert(fnrlvhj,bearbeitungshalbjahr);IF sortjgstalle
+XOR sortjgstbestTHEN sortierungnachprimärindexvorbereitenELIF sortkopplungen
+THEN sortierungnachsekindexlvkopplungvorbereitenELIF sortfaecherOR 
+sortbestfachTHEN sortierungnachsekindexlvfachvorbereitenELSE 
+sortierungnachsekindexlvparaphevorbereitenFI ;objektlistestarten(
+aktuelleindexnr,bearbeitungsschuljahr,feldnr,TRUE ,b);setzebestandende(NOT 
+multistopCOR b);.sortierungnachprimärindexvorbereiten:setzescanstartwert("");
+setzescanendewert("�");textueberschrift:=(textueb1+textueb2+textueb4+2*blank+
+textueb3+blank+textueb5);aktuelleindexnr:=dnrlehrveranstaltungen;IF 
+sortjgstbestTHEN putwert(fnrlvjgst,gewaehltejgst);feldnr:=fnrlvfachkennung;
+ELSE feldnr:=fnrlvjgst;setzescanendewert("255");FI ;.
+sortierungnachsekindexlvkopplungvorbereiten:textueberschrift:=(textueb4+
+textueb1+textueb2+2*blank+textueb3+2*blank+textueb5);aktuelleindexnr:=
+ixlvsjhjkopp;feldnr:=fnrlvkopplung;.
+sortierungnachsekindexlvparaphevorbereiten:textueberschrift:=(textueb3+
+textueb1+textueb2+textueb4+2*blank+textueb5);aktuelleindexnr:=ixlvsjhjpar;IF 
+sortparaphebestTHEN putwert(fnrlvparaphe,gewaehlteparaphe);feldnr:=
+fnrlvfachkennung;ELSE feldnr:=fnrlvparapheFI ;.
+sortierungnachsekindexlvfachvorbereiten:textueberschrift:=(textueb2+textueb1+
+textueb4+textueb3+2*blank+textueb5);aktuelleindexnr:=ixlvsjhjkenn;IF 
+sortbestfachTHEN feldnr:=fnrlvfachkennung;putwert(fnrlvfachkennung,
+gewaehltesfach);setzescanstartwert(gewaehltesfach);setzescanendewert(text(
+gewaehltesfach,2)+code(255));ELSE feldnr:=fnrlvfachkennung;FI ;END PROC 
+unterrichtsverteilunglistenvorbereiten;PROC 
+unterrichtsverteilungbildschirmvorbereiten:LET fnrausganf=2;
+unterrichtsverteilungueberschrift:="Unterrichtsverteilung im Schuljahr "+(
+text(bearbeitungsschuljahr,2)+"/"+text(bearbeitungsschuljahr,2,3)+", "+
+bearbeitungshalbjahr+". Halbjahr");standardkopfmaskeaktualisieren(
+unterrichtsverteilungueberschrift);bildanfang:=fnrausganf;
+setzebildanfangsposition(bildanfang);INT VAR i;setzespaltenbreite(bildbreite)
+;spaltenweise(textueberschrift);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;spaltenweise(length(textueberschrift)*strich);
+ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;
+setzebildanfangsposition(4);spaltendefinierenEND PROC 
+unterrichtsverteilungbildschirmvorbereiten;PROC 
+unterrichtsverteilungseitezeigen:altejahrgangsstufe:=niltext;alteparaphe:=
+niltext;altekopplung:=niltext;altesfach:=niltext;blaettern(PROC (INT CONST )
+unterrichtsverteilungzeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop)END PROC 
+unterrichtsverteilungseitezeigen;PROC unterrichtsverteilungzeigen(INT CONST x
+):unterrichtsverteilungholen;unterrichtsverteilungaufbereitenbild;
+unterrichtsverteilungaufbildschirm;END PROC unterrichtsverteilungzeigen;PROC 
+unterrichtsverteilungaufbereitenbild:IF sortkopplungenTHEN kopplungausgeben;
+spaltenweise(jahrgangsstufe);spaltenweise(fach);spaltenweise(kennung);
+spaltenweise(blank);spaltenweise(paraphe);ELIF sortjgstalleXOR sortjgstbest
+THEN jahrgangsstufeausgeben;spaltenweise(fach);spaltenweise(kennung);
+spaltenweise(kopplung);spaltenweise(paraphe);ELIF sortparaphenalleXOR 
+sortparaphebestTHEN parapheausgeben;spaltenweise(blank);spaltenweise(
+jahrgangsstufe);spaltenweise(fach);spaltenweise(kennung);spaltenweise(
+kopplung);ELIF sortfaecherXOR sortbestfachTHEN fachausgeben;spaltenweise(
+kennung);spaltenweise(jahrgangsstufe);spaltenweise(kopplung);spaltenweise(
+paraphe);FI ;spaltenweise(wochenstdn);spaltenweise(blank);spaltenweise(
+klassengruppe1);spaltenweise(klassengruppe2);spaltenweise(klassengruppe3);
+spaltenweise(klassengruppe4);spaltenweise(raumgruppe1);spaltenweise(
+raumgruppe2);.jahrgangsstufeausgeben:IF altejahrgangsstufe<>jahrgangsstufe
+THEN spaltenweise(jahrgangsstufe);altejahrgangsstufe:=jahrgangsstufe;ELSE 
+spaltenweise(blank)FI ;.parapheausgeben:IF alteparaphe<>parapheTHEN 
+spaltenweise(paraphe);alteparaphe:=parapheELSE spaltenweise(blank)FI ;.
+fachausgeben:IF altesfach<>fachTHEN spaltenweise(fach);altesfach:=fachELSE 
+spaltenweise(blank)FI ;.kopplungausgeben:IF altekopplung<>kopplungTHEN 
+spaltenweise(kopplung);altekopplung:=kopplung;ELSE spaltenweise(blank)FI ;
+END PROC unterrichtsverteilungaufbereitenbild;PROC 
+unterrichtsverteilungaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge
+REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;
+END PROC unterrichtsverteilungaufbildschirm;PROC 
+unterrichtsverteilungdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=
+" ";druckvorbereiten;variablenfuerdrucksetzen;
+unterrichtsverteilungueberschrift:="Unterrichtsverteilung im Schuljahr "+(
+text(bearbeitungsschuljahr,2)+"/"+text(bearbeitungsschuljahr,2,3)+", "+
+bearbeitungshalbjahr+". Halbjahr");initdruckkopf(zentriert(
+unterrichtsverteilungueberschrift,druckbreite),zentriert(length(
+unterrichtsverteilungueberschrift)*strich,druckbreite));spaltendefinieren;
+initausgabekopfdruck;inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,
+bearbeitungsschuljahr);putwert(fnrlvhj,bearbeitungshalbjahr);IF sortjgstbest
+THEN putwert(fnrlvjgst,gewaehltejgst);ELIF sortparaphebestTHEN putwert(
+fnrlvparaphe,gewaehlteparaphe);ELIF sortbestfachTHEN putwert(fnrlvfachkennung
+,gewaehltesfach);FI ;lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT 
+VAR )scanforward,BOOL PROC multistopsim);.variablenfuerdrucksetzen:
+druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-ausgkopflaenge.END PROC 
+unterrichtsverteilungdruckvorbereiten;PROC initausgabekopfdruck:ausgkopfdruck
+(1):=textueberschrift;ausgkopfdruck(2):=unterstreichungEND PROC 
+initausgabekopfdruck;PROC unterrichtsverteilungseitedrucken:
+unterrichtsverteilungueberschriftdrucken;altejahrgangsstufe:=niltext;
+alteparaphe:=niltext;altekopplung:=niltext;altesfach:=niltext;erstezeile:=
+TRUE ;seitedrucken(PROC (INT VAR )unterrichtsverteilungdrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel.END 
+PROC unterrichtsverteilungseitedrucken;PROC 
+unterrichtsverteilungueberschriftdrucken:INT VAR i;druckkopfschreiben;FOR i
+FROM 1UPTO ausgkopflaengeREP druckzeileschreiben(ausgkopfdruck(i))PER END 
+PROC unterrichtsverteilungueberschriftdrucken;PROC 
+unterrichtsverteilungdrucken(INT VAR zeilenzaehler):LET markiert="#";
+unterrichtsverteilungholen;ggflmeldunganfbuchstabe;IF NOT (erstezeile)AND ((
+sortjgstalleAND altejahrgangsstufe<>jahrgangsstufe)XOR (sortkopplungenAND 
+altekopplung<>kopplung)XOR (sortparaphenalleAND alteparaphe<>paraphe)XOR (
+sortfaecherAND altesfach<>fach))THEN leerzeileindruckdateiFI ;
+unterrichtsverteilungaufbereitendruck;zeilenzaehlerINCR ausgfeldlaenge;
+unterrichtsverteilungindruckdatei;erstezeile:=FALSE .leerzeileindruckdatei:
+ausgfeld(1):=text(blank,druckbreite);druckzeileschreiben(ausgfeld(1));
+zeilenzaehlerINCR ausgfeldlaenge;.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:IF 
+sortjgstalleXOR sortjgstbestTHEN neueranfbuchstabe:=jahrgangsstufeSUB 1;
+teiltextmeldung:="Jgst "ELIF sortparaphenalleXOR sortparaphebestTHEN 
+neueranfbuchstabe:=parapheSUB 1;teiltextmeldung:=
+"Paraphen mit Anfangsbuchstaben: "ELIF sortkopplungenTHEN neueranfbuchstabe:=
+kopplungSUB 1;teiltextmeldung:="Kopplungen mit Anfangsbuchstaben: "ELIF 
+sortfaecherXOR sortbestfachTHEN neueranfbuchstabe:=fach;teiltextmeldung:=
+"Fach: "FI ;anfbuchstabe<>neueranfbuchstabe.meldunganfbuchstabe:
+standardmeldung(mnrbearbeitetwerden,teiltextmeldung+neueranfbuchstabe+
+markiert);anfbuchstabe:=neueranfbuchstabe.END PROC 
+unterrichtsverteilungdrucken;PROC unterrichtsverteilungaufbereitendruck:
+unterrichtsverteilungaufbereitenbild;ausgfeld(1):=zeile;END PROC 
+unterrichtsverteilungaufbereitendruck;PROC unterrichtsverteilungindruckdatei:
+INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(1))
+PER END PROC unterrichtsverteilungindruckdatei;PROC spaltendefinieren:
+initspalten;setzespaltentrenner(spaltentrenner);IF sortkopplungenTHEN 
+setzespaltenbreite(neunerspaltenbreite);setzespaltenbreite(
+fuenferspaltenbreite);setzespaltenbreite(zweierspaltenbreite);
+setzespaltenbreite(achterspaltenbreite);setzespaltenbreite(
+zweierspaltenbreite);setzespaltenbreite(achterspaltenbreite);ELIF 
+sortjgstalleXOR sortjgstbestTHEN setzespaltenbreite(fuenferspaltenbreite);
+setzespaltenbreite(zweierspaltenbreite);setzespaltenbreite(
+neunerspaltenbreite);setzespaltenbreite(zehnerspaltenbreite);
+setzespaltenbreite(achterspaltenbreite);ELIF sortparaphenalleXOR 
+sortparaphebestTHEN setzespaltenbreite(viererspaltenbreite);
+setzespaltenbreite(zweierspaltenbreite);setzespaltenbreite(
+fuenferspaltenbreite);setzespaltenbreite(zweierspaltenbreite);
+setzespaltenbreite(neunerspaltenbreite);setzespaltenbreite(
+zehnerspaltenbreite);ELIF sortfaecherXOR sortbestfachTHEN setzespaltenbreite(
+viererspaltenbreite);setzespaltenbreite(achterspaltenbreite);
+setzespaltenbreite(viererspaltenbreite);setzespaltenbreite(
+neunerspaltenbreite);setzespaltenbreite(neunerspaltenbreite);FI ;
+setzespaltenbreite(viererspaltenbreite);setzespaltenbreite(
+zweierspaltenbreite);setzespaltenbreite(viererspaltenbreite);
+setzespaltenbreite(viererspaltenbreite);setzespaltenbreite(
+viererspaltenbreite);setzespaltenbreite(fuenferspaltenbreite);
+setzespaltenbreite(viererspaltenbreite);setzespaltenbreite(
+viererspaltenbreite);END PROC spaltendefinieren;PROC 
+unterrichtsverteilungholen:TEXT VAR fachkennung;halbjahr:=wert(fnrlvhj);
+jahrgangsstufe:=text(intwert(fnrlvjgst),2);fachkennung:=wert(fnrlvfachkennung
+);fach:=text(fachkennung,2);kennung:=subtext(fachkennung,3,6);kopplung:=wert(
+fnrlvkopplung);paraphe:=wert(fnrlvparaphe);wochenstdn:=text(intwert(
+fnrlvwochenstd),2);klassengruppe1:=wert(fnrlvklgrp1);klassengruppe2:=wert(
+fnrlvklgrp2);klassengruppe3:=wert(fnrlvklgrp3);klassengruppe4:=wert(
+fnrlvklgrp4);raumgruppe1:=wert(fnrlvraumgrp1);raumgruppe2:=wert(fnrlvraumgrp2
+);END PROC unterrichtsverteilungholen;END PACKET unterrichtsverteilunglisten
+
diff --git a/app/schulis/2.2.1/src/4.raumwuensche pruefen b/app/schulis/2.2.1/src/4.raumwuensche pruefen
new file mode 100644
index 0000000..109eace
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.raumwuensche pruefen
@@ -0,0 +1,117 @@
+PACKET raumwuenschepruefenDEFINES raumwuenschepruefenstarten,
+raumwuenschepruefenlistedrucken:INT VAR fnrakthj:=2,fnrausgabebildschirm:=3,
+fnrausgabedrucker:=4;LET meldnrlistewirdgedruckt=58,meldnrkeinelv=326,
+meldnrkeinesugruppen=334,meldnrinbearbeitung=352,meldnrzuvielesugruppen=356,
+meldnrstundenplanwirdaufbereitet=357,meldnrzuvielelv=358,
+meldnrstundenplanserverfehlt=376,meldnrbasisalt=377,meldnrbasisinkons=378;
+LET protname="Einhaltung der Raumwünsche";FILE VAR prot;LET raumgruppendatei=
+"Datei mit Raumgruppen";FILE VAR datraumgruppen;LET schuljahr="Schuljahr",
+schulhalbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";LET 
+ueberschrift="Einhaltung der Raumwünsche, Stundenplan ",texthalbjahr=
+". Halbjahr",kopfzeile1="Lehrver-   Zeit    belegter Anmerkungen",kopfzeile2=
+"anstaltung         Raum";LET meldkeinwunschraumfrei=
+"kein Wunsch- oder Ersatzraum frei",meldwunschraumfrei=" frei",
+meldkeinwunschangegeben="Raum fehlt, kein Raumwunsch angegeben";LET 
+fallkeinwunschraumfrei=1,fallwunschraumfrei=2,fallkeinwunschangegeben=3;LET 
+laengeschulname=61;LET strich="-",schraegstrich="/",blank=" ",vierblanks=
+"    ",leerraum="    ",kennzhell="#",editorzusatztasten="vr";LET laengeraum=4
+,laengelv=8;LET kennunglv="L",kennungraum="R",kennungwunschraum="RW",
+kennungersatzraum="RE";LET erstestunde=1,letztestunde=66,zeitbelegt="1";LET 
+posraeumeinrgzeile=5;TEXT VAR aktsj:="",akthj:="",gewsj,gewhj;TEXT VAR 
+auszeile;TEXT VAR jgst,lv,letztelv,raum,freierwunschraum,wunschraeumederlv,
+raeumederzeit,raumgruppenzeile,zeitenderlv;INT VAR izeit;INT VAR posraum;INT 
+VAR fstatusstuplan;PROC raumwuenschepruefenstarten:INT VAR fnrfehler:=0;
+standardpruefe(5,fnrausgabebildschirm,fnrausgabedrucker,0,"",fnrfehler);IF 
+fnrfehler<>0THEN infeld(fnrfehler);return(1)ELSE 
+schulhalbjahrbestimmenundstundenplanholen;IF fstatusstuplan<>0THEN 
+stundenplanfehlerbehandeln;return(1)ELSE pruefungraumwuenschedurchfuehren;IF 
+listedirektdruckenTHEN standardmeldung(meldnrlistewirdgedruckt,"");print(
+protname);forget(protname,quiet);return(1)ELSE zeigedatei(protname,
+editorzusatztasten)FI ;FI FI .listedirektdrucken:standardmaskenfeld(
+fnrausgabedrucker)<>"".schulhalbjahrbestimmenundstundenplanholen:IF aktsj=""
+THEN aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(schulhalbjahr)FI 
+;gewsj:=aktsj;gewhj:=akthj;IF standardmaskenfeld(fnrakthj)=""THEN 
+geplanteshjundsjberechnen(gewhj,gewsj);FI ;stundenplanhalbjahrsetzen(gewhj,
+gewsj);standardmeldung(meldnrstundenplanwirdaufbereitet,"");
+stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan=0THEN 
+stundenplanreorganisierenundsichern(fstatusstuplan)ELIF fstatusstuplan=8THEN 
+standardmeldung(meldnrbasisalt,"");stundenplanreorganisierenundsichern(
+fstatusstuplan)FI .stundenplanfehlerbehandeln:IF fstatusstuplan=2THEN 
+standardmeldung(meldnrstundenplanserverfehlt,"")ELIF fstatusstuplan=4THEN 
+standardmeldung(meldnrkeinesugruppen,"")ELIF fstatusstuplan=5THEN 
+standardmeldung(meldnrzuvielesugruppen,"")ELIF fstatusstuplan=6THEN 
+standardmeldung(meldnrkeinelv,"")ELIF fstatusstuplan=7THEN standardmeldung(
+meldnrzuvielelv,"")ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt,
+"")ELIF fstatusstuplan=9THEN standardmeldung(meldnrbasisinkons,"")FI .
+pruefungraumwuenschedurchfuehren:protokollvorbereiten;ausgabekopfaufbereiten;
+raumgruppeninraumgruppendateiauslesen;letztelv:="";inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvsj,gewsj);putwert(fnrlvhj,gewhj);
+statleseschleife(dnrlehrveranstaltungen,gewsj,gewhj,fnrlvsj,fnrlvhj,PROC 
+raeumeeinerlvpruefen);ausgabefussaufbereiten.protokollvorbereiten:forget(
+protname,quiet);prot:=sequentialfile(output,protname).ausgabekopfaufbereiten:
+auszeile:=text(schulkenndatum(schulname),laengeschulname);auszeileCAT date;
+putline(prot,auszeile);putline(prot,schulkenndatum(schulort));line(prot);
+auszeile:=ueberschrift;auszeileCAT subtext(gewsj,1,2);auszeileCAT 
+schraegstrich;auszeileCAT subtext(gewsj,3,4);auszeileCAT ", ";auszeileCAT 
+gewhj;auszeileCAT texthalbjahr;putline(prot,auszeile);putline(prot,length(
+auszeile)*strich);line(prot);putline(prot,kopfzeile1);putline(prot,kopfzeile2
+);putline(prot,65*strich).ausgabefussaufbereiten:line(prot);putline(prot,20*
+blank+20*strich).raumgruppeninraumgruppendateiauslesen:IF NOT exists(
+raumgruppendatei)THEN datraumgruppen:=sequentialfile(output,raumgruppendatei)
+;inittupel(dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp
+,fnrrgraeume,PROC raumgruppeindateischreiben)FI .END PROC 
+raumwuenschepruefenstarten;PROC raumgruppeindateischreiben(BOOL VAR b):IF 
+dbstatus=0THEN putline(datraumgruppen,text(wert(fnrrgraumgrp),laengeraum)+
+wert(fnrrgraeume))ELSE b:=TRUE FI END PROC raumgruppeindateischreiben;PROC 
+raeumeeinerlvpruefen(BOOL VAR b):IF dbstatus<>0OR wert(fnrlvsj)<>gewsjOR wert
+(fnrlvhj)<>gewhjTHEN b:=TRUE ELSE pruefeallelveintraegeFI .
+pruefeallelveintraege:jgst:=jgstzweistellig(intwert(fnrlvjgst));lv:=text(jgst
++wert(fnrlvfachkennung),laengelv);standardmeldung(meldnrinbearbeitung,lv+
+kennzhell);wunschraeumezulvbestimmen;zeitenderlv:=allezeitenvon(kennunglv,lv)
+;FOR izeitFROM erstestundeUPTO letztestundeREP IF (zeitenderlvSUB izeit)=
+zeitbelegtTHEN prueferaumeintragFI PER .wunschraeumezulvbestimmen:
+wunschraeumederlv:="";raum:=datenzurlv(kennungwunschraum,lv);IF raum<>""THEN 
+IF bezeichnungzulaessig(kennungraum,raum)THEN wunschraeumederlvCAT raumELSE 
+wunschraeumederlvCAT raeumederraumgruppeFI ;FI ;raum:=datenzurlv(
+kennungersatzraum,lv);IF raum<>""THEN IF bezeichnungzulaessig(kennungraum,
+raum)THEN wunschraeumederlvCAT raumELSE wunschraeumederlvCAT 
+raeumederraumgruppeFI ;FI .prueferaumeintrag:TEXT VAR suchpara,suchlv;
+planeintraglesen(izeit,kennunglv,lv,suchlv,raum,suchpara);raeumederzeit:=
+datenderzeit(izeit,kennungraum);IF wunschraeumederlv<>""THEN 
+erstenfreienwunschraumbestimmen;IF freierwunschraum=""THEN IF 
+belegterraumistkeinwunschraumTHEN inlisteschreiben(fallkeinwunschraumfrei)FI 
+ELIF freierwunschraumistbesseralsbelegterTHEN inlisteschreiben(
+fallwunschraumfrei)FI ELIF raum=leerraumTHEN inlisteschreiben(
+fallkeinwunschangegeben)FI .erstenfreienwunschraumbestimmen:freierwunschraum
+:="";posraum:=1;WHILE posraum<length(wunschraeumederlv)REP freierwunschraum:=
+subtext(wunschraeumederlv,posraum,posraum+laengeraum-1);IF suchpos(
+raeumederzeit,freierwunschraum,laengeraum)=0THEN LEAVE 
+erstenfreienwunschraumbestimmenFI ;posraumINCR laengeraumPER ;
+freierwunschraum:="".belegterraumistkeinwunschraum:suchpos(wunschraeumederlv,
+raum,laengeraum)=0.freierwunschraumistbesseralsbelegter:raum=leerraumOR (
+suchpos(wunschraeumederlv,freierwunschraum,laengeraum)<suchpos(
+wunschraeumederlv,raum,laengeraum)).END PROC raeumeeinerlvpruefen;TEXT PROC 
+raeumederraumgruppe:datraumgruppen:=sequentialfile(modify,raumgruppendatei);
+toline(datraumgruppen,1);col(datraumgruppen,1);WHILE NOT eof(datraumgruppen)
+REP downety(datraumgruppen,raum);IF col(datraumgruppen)=1CAND NOT eof(
+datraumgruppen)THEN readrecord(datraumgruppen,raumgruppenzeile);LEAVE 
+raeumederraumgruppeWITH subtext(raumgruppenzeile,posraeumeinrgzeile)ELSE col(
+datraumgruppen,col(datraumgruppen)+1)FI ;PER ;"".END PROC raeumederraumgruppe
+;PROC inlisteschreiben(INT CONST fallnr):auszeile:=jgst;auszeileCAT blank;
+auszeileCAT subtext(lv,3,4);auszeileCAT blank;auszeileCAT subtext(lv,5);
+auszeileCAT blank;auszeileCAT text(tagstunde(izeit,TRUE ),8);auszeileCAT raum
+;auszeileCAT vierblanks;auszeileCAT blank;IF fallnr=fallkeinwunschraumfrei
+THEN auszeileCAT meldkeinwunschraumfreiELIF fallnr=fallwunschraumfreiTHEN 
+auszeileCAT freierwunschraum;auszeileCAT meldwunschraumfreiELIF fallnr=
+fallkeinwunschangegebenTHEN auszeileCAT meldkeinwunschangegebenFI ;IF 
+letztelv<>lvTHEN line(prot);letztelv:=lvFI ;putline(prot,auszeile)END PROC 
+inlisteschreiben;PROC raumwuenschepruefenlistedrucken(BOOL CONST drucken):IF 
+druckenTHEN print(protname)FI ;forget(protname,quiet);enter(2)END PROC 
+raumwuenschepruefenlistedrucken;INT PROC suchpos(TEXT CONST quelle,suchtext,
+INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext);WHILE findpos>0REP 
+IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE findpos:=pos(quelle,
+suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT PROC jgstzweistellig
+(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4AND intjgst<10THEN "0"
++text(intjgst)ELSE text(intjgst)FI END PROC jgstzweistellig;END PACKET 
+raumwuenschepruefen;
+
diff --git a/app/schulis/2.2.1/src/4.springstunden lehrer analysieren b/app/schulis/2.2.1/src/4.springstunden lehrer analysieren
new file mode 100644
index 0000000..bd205d2
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.springstunden lehrer analysieren
@@ -0,0 +1,122 @@
+PACKET springstundenlehrerDEFINES springstundenlehrerausfuehren:LET fnrakthj=
+2,fnrohneminiplan=3,minitagestr="!",minivornachmtr=" ",miniunterricht="*",
+minisprstd="o",minifrei=".",ausgabeparam="#",leerzeile=" ",laengeparbez=9,
+tageprowoche=6,stdprotag=12,letztestunde=66,meldungbearbwird=352,
+meldungwarten=69,meldungkeinelehrer=337,meldungkeinzeitraster=336,
+meldungserverfehler=376,meldungkeinstdplan=366,meldungkeinesugruppen=334,
+meldungzuvielesugruppen=356,meldungkeinelv=326,meldungzuvielelv=358,
+meldungbasisinkon=378,meldungstdplauswvorber=384,kennungpar="P",kennunggesp=
+"x",kennungvorm="v",kennungnachm="n",dateiname="Liste der Springstunden",
+ueberschrift="Springstunden der Lehrer für das Schulhalbjahr ",unterstrich=
+"-------------------------------------------------------",legende1=
+"In den Mini-Stundenplänen bedeuten:",legende2=
+"""  Unterricht für den Lehrer",legende3="""  Springstunde für den Lehrer",
+legende4="""  andere Zeiten ohne Unterricht",legende5=
+"    ""x""  gesperrte Zeiten aufgrund des Zeitrasters",legende6=
+"""  Trennzeichen Vor- und Nachmittag",legende7=
+"""  Trennzeichen Unterrichtstage",legende8="Zeitraster der Schule:",legende9
+="Mo            Di            Mi            Do            Fr            Sa",
+ausgabewstd=" Wstd.  ",vorgabetage=" 0 Tage (0 v/ 0 n)  ",vorgabesprstd1=
+" Springstd. (",vorgabesprstd2=" x1/ ",vorgabesprstd3=" x2/ ",vorgabesprstd4=
+" xgr.)",posunttage=2,posvormtage=10,posnachmtage=15,schuljahr="Schuljahr",
+halbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";TEXT VAR 
+paraphe,schj,schhj,ausgabetage,ausgabesprstd,miniplan:="",iminiplan,
+ausgminiplan,tagesplan,zeile,vormnachmwechsel:="",relzeit,zeichen;INT VAR i,j
+,wstd,stdverschiebung,erstepos,letztepos,anzunttage,anzvormtage,anznachmtage,
+anzsprstd,anzsprstd1,anzsprstd2,anzsprstdx,sprstdlaenge,indextagesanf,mittag,
+fstat;TEXT VAR kvn,kzt,kaktvn;BOOL VAR miniplanausgabe:=FALSE ,
+erstenichtvormstd:=TRUE ,keinmittag:=TRUE ;FILE VAR datei;PROC 
+springstundenlehrerausfuehren:standardmeldung(meldungwarten,"");
+miniplanausgabe:=FALSE ;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum
+(halbjahr);IF standardmaskenfeld(fnrakthj)=""THEN geplanteshjundsjberechnen(
+schhj,schj)FI ;IF standardmaskenfeld(fnrohneminiplan)=""THEN miniplanausgabe
+:=TRUE ;FI ;erstelleminiplan;stundenplanhalbjahrsetzen(schhj,schj);
+standardmeldung(meldungstdplauswvorber,"");
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+meldungausgeben(fstat);return(1);LEAVE springstundenlehrerausfuehrenFI ;
+inittupel(dnrlehrer);IF records(dnrlehrer)=0.0THEN standardmeldung(
+meldungkeinelehrer,"");return(1);LEAVE springstundenlehrerausfuehrenELSE 
+bereiteprotokollvor;statleseschleife(dnrlehrer,"","",dnrlehrer+1,dnrlehrer+2,
+PROC lehrer)FI ;zeigedatei(dateiname,"vr").bereiteprotokollvor:forget(
+dateiname,quiet);datei:=sequentialfile(output,dateiname);putline(datei,
+schulkenndatum(schulname));putline(datei,text(schulkenndatum(schulort),65)+
+date);putline(datei,leerzeile);putline(datei,ueberschrift+schhj+". "+text(
+schj,2)+"/"+subtext(schj,3));putline(datei,unterstrich);putline(datei,
+leerzeile);IF miniplanausgabeTHEN putline(datei,legende1);putline(datei,
+"    """+miniunterricht+legende2);putline(datei,"    """+minisprstd+legende3)
+;putline(datei,"    """+minifrei+legende4);putline(datei,legende5);putline(
+datei,"    """+minivornachmtr+legende6);putline(datei,"    """+minitagestr+
+legende7);putline(datei,leerzeile);putline(datei,legende8);putline(datei,
+legende9);bereiteplanauf(miniplan);putline(datei,ausgminiplan);putline(datei,
+leerzeile)FI .erstelleminiplan:miniplan:="";vormnachmwechsel:="";IF records(
+dnrzeitraster)=0.0THEN standardmeldung(meldungkeinzeitraster,"");return(1);
+LEAVE springstundenlehrerausfuehrenFI ;erstenichtvormstd:=TRUE ;inittupel(
+dnrzeitraster);statleseschleife(dnrzeitraster,schj,schhj,dnrzeitraster+1,
+dnrzeitraster+2,PROC zeitrasterdaten);IF length(miniplan)<letztestundeTHEN 
+standardmeldung(meldungkeinzeitraster,"");return(1);LEAVE 
+springstundenlehrerausfuehrenFI .END PROC springstundenlehrerausfuehren;PROC 
+lehrer(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE paraphe:=wert(fnrlparaphe)
+;standardmeldung(meldungbearbwird,paraphe+ausgabeparam);wstd:=
+anzahlverplstden(paraphe);zeile:=text(paraphe,laengeparbez);zeileCAT text(
+wstd,2);zeileCAT ausgabewstd;untersuchetage;zeileCAT ausgabetage;
+untersuchesprstden;zeileCAT ausgabesprstd;putline(datei,zeile);IF 
+miniplanausgabeTHEN bereiteplanauf(iminiplan);changeall(ausgminiplan,
+kennungvorm,minifrei);changeall(ausgminiplan,kennungnachm,minifrei);putline(
+datei,ausgminiplan)FI ;line(datei)FI .untersuchetage:ausgabetage:=vorgabetage
+;IF anzunttage<>0THEN replace(ausgabetage,posunttage,text(anzunttage))FI ;IF 
+anzvormtage<>0THEN replace(ausgabetage,posvormtage,text(anzvormtage))FI ;IF 
+anznachmtage<>0THEN replace(ausgabetage,posnachmtage,text(anznachmtage))FI .
+untersuchesprstden:anzsprstd:=0;anzsprstd1:=0;anzsprstd2:=0;anzsprstdx:=0;
+FOR iFROM 1UPTO tageprowocheREP erstepos:=0;letztepos:=0;indextagesanf:=(i-1)
+*stdprotag;tagesplan:=subtext(iminiplan,indextagesanf+1,i*stdprotag);
+ermittlerandundsprstdenPER .ermittlerandundsprstden:erstepos:=pos(tagesplan,
+miniunterricht);IF erstepos<>0THEN ermittleletztestd;ermittlevormnachmwechsel
+;ermittlespringstdFI .ermittleletztestd:FOR jFROM stdprotagDOWNTO 1REP IF (
+tagesplanSUB j)=miniunterrichtTHEN letztepos:=j;LEAVE ermittleletztestdFI 
+PER .ermittlevormnachmwechsel:mittag:=0;FOR jFROM 12DOWNTO 1REP IF (miniplan
+SUB indextagesanf+j)=kennungvormTHEN mittag:=j;LEAVE ermittlevormnachmwechsel
+FI PER .ermittlespringstd:keinmittag:=TRUE ;FOR jFROM letzteposDOWNTO 
+ersteposREP IF (tagesplanSUB j)=kennungvormCOR (tagesplanSUB j)=kennungnachm
+COR (tagesplanSUB j)=kennunggespTHEN anzsprstdINCR 1;sprstdlaengeINCR 1;IF 
+miniplanausgabeTHEN replace(iminiplan,indextagesanf+j,minisprstd);FI ;IF j=
+mittag+1COR j=mittagTHEN IF keinmittagTHEN anzsprstdINCR 1;sprstdlaengeINCR 1
+;keinmittag:=FALSE FI FI ELSE IF sprstdlaenge=1THEN anzsprstd1INCR 1ELIF 
+sprstdlaenge=2THEN anzsprstd2INCR 1ELIF sprstdlaenge>2THEN anzsprstdxINCR 1
+FI ;sprstdlaenge:=0;FI PER ;IF keinmittagCAND erstepos<=mittagCAND letztepos>
+mittagTHEN anzsprstdINCR 1;anzsprstd1INCR 1FI ;ausgabesprstd:=text(anzsprstd,
+2)+vorgabesprstd1+text(anzsprstd1,2)+vorgabesprstd2+text(anzsprstd2,2)+
+vorgabesprstd3+text(anzsprstdx,2)+vorgabesprstd4.END PROC lehrer;PROC 
+bereiteplanauf(TEXT CONST plan):ausgminiplan:=plan;stdverschiebung:=0;FOR i
+FROM 1UPTO length(vormnachmwechsel)DIV 3REP relzeit:=vormnachmwechselSUB i*3-
+2;relzeitCAT (vormnachmwechselSUB i*3-1);zeichen:=vormnachmwechselSUB i*3;
+insertchar(ausgminiplan,zeichen,int(relzeit)+stdverschiebung);stdverschiebung
+INCR 1PER ;END PROC bereiteplanauf;PROC zeitrasterdaten(BOOL VAR b):IF wert(
+fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE kvn:=
+wert(fnrzrkennungteil);kzt:=text(wert(fnrzrtagstunde),2);miniplanCAT kvn;IF 
+kvn<>kennungvormTHEN IF erstenichtvormstdTHEN kaktvn:=kzt;erstenichtvormstd:=
+FALSE FI ELSE erstenichtvormstd:=TRUE FI ;IF int(kzt)MOD stdprotag=1CAND kzt
+<>"1 "THEN IF kaktvn<>""THEN vormnachmwechselCAT kaktvn;vormnachmwechselCAT 
+minivornachmtr;kaktvn:=""FI ;vormnachmwechselCAT kzt;vormnachmwechselCAT 
+minitagestrFI ;IF kzt=text(letztestunde)THEN IF kaktvn<>""THEN 
+vormnachmwechselCAT kaktvn;vormnachmwechselCAT minivornachmtr;kaktvn:=""FI 
+FI FI END PROC zeitrasterdaten;INT PROC anzahlverplstden(TEXT CONST paraphe):
+TEXT VAR stundenplan:=allezeitenvon(kennungpar,paraphe),unttage:=tageprowoche
+*"0",vormtage:=tageprowoche*"0",nachmtage:=tageprowoche*"0";INT VAR einspos:=
+1,anzeinsen:=0,wochentag;iminiplan:=miniplan;anzunttage:=0;anzvormtage:=0;
+anznachmtage:=0;WHILE einspos<>0REP einspos:=pos(stundenplan,"1",einspos);IF 
+einspos<>0THEN anzeinsenINCR 1;replace(iminiplan,einspos,miniunterricht);
+wochentag:=(einspos-1)DIV stdprotag+1;IF (unttageSUB wochentag)="0"THEN 
+replace(unttage,wochentag,"1");anzunttageINCR 1FI ;IF (vormtageSUB wochentag)
+="0"CAND vormittagsunterrichtTHEN replace(vormtage,wochentag,"1");anzvormtage
+INCR 1FI ;IF (nachmtageSUB wochentag)="0"CAND nachmittagsunterrichtTHEN 
+replace(nachmtage,wochentag,"1");anznachmtageINCR 1FI ;einsposINCR 1FI PER ;
+anzeinsen.vormittagsunterricht:(miniplanSUB einspos)=kennungvorm.
+nachmittagsunterricht:(miniplanSUB einspos)=kennungnachm.END PROC 
+anzahlverplstden;PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN 
+standardmeldung(meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(
+meldungkeinstdplan,"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen
+,"");ELIF fstat=5THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6
+THEN standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;END PACKET springstundenlehrer;
+
diff --git a/app/schulis/2.2.1/src/4.springstunden schueler analysieren b/app/schulis/2.2.1/src/4.springstunden schueler analysieren
new file mode 100644
index 0000000..39a9bfc
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.springstunden schueler analysieren
@@ -0,0 +1,137 @@
+PACKET springstundenschuelerDEFINES springstundenschuelerausfuehren:LET 
+fnrakthj=3,fnrohneminiplan=4,minitagestr="!",minivornachmtr=" ",
+miniunterricht="*",minisprstd="o",minifrei=".",ausgabeparam="#",leerzeile=" "
+,laengelv=8,laengeschgrbez=9,tageprowoche=6,stdprotag=12,letztestunde=66,
+meldungbearbwird=352,meldungwarten=69,meldungkeineschueler=332,
+meldungkeinzeitraster=336,meldungserverfehler=376,meldungkeinstdplan=366,
+meldungkeinesugruppen=334,meldungzuvielesugruppen=356,meldungkeinelv=326,
+meldungzuvielelv=358,meldungbasisinkon=378,meldungstdplauswvorber=384,
+kennunglv="L",kennunggesp="x",kennungvorm="v",kennungnachm="n",dateiname=
+"Liste der Springstunden",ueberschrift=
+"Springstunden der Schülergruppen Sek.1 für das Schulhalbjahr ",unterstrich=
+"---------------------------------------------------------------------",
+legende1="In den Mini-Stundenplänen bedeuten:",legende2=
+"""  Unterricht für die Schülergruppe",legende3=
+"""  Springstunde für die Schülergruppe",legende4=
+"""  andere Zeiten ohne Unterricht",legende5=
+"    ""x""  gesperrte Zeiten aufgrund des Zeitrasters",legende6=
+"""  Trennzeichen Vor- und Nachmittag",legende7=
+"""  Trennzeichen Unterrichtstage",legende8="Zeitraster der Schule:",legende9
+="Mo            Di            Mi            Do            Fr            Sa",
+ausgabewstd=" Wstd.  ",vorgabetage=" 0 Tage (0 v/ 0 n)  ",vorgabesprstd1=
+" Springstd. (",vorgabesprstd2=" x1/ ",vorgabesprstd3=" x2/ ",vorgabesprstd4=
+" xgr.)",posunttage=2,posvormtage=10,posnachmtage=15,schuljahr="Schuljahr",
+halbjahr="Schulhalbjahr",schulname="Schulname",schulort="Schulort";TEXT VAR 
+schgrbez,schj,schhj,ausgabetage,ausgabesprstd,miniplan:="",iminiplan,
+ausgminiplan,tagesplan,zeile,vormnachmwechsel:="",relzeit,zeichen;TEXT VAR 
+kvn,kzt,kaktvn;INT VAR i,j,wstd,stdverschiebung,erstepos,letztepos,mittag,
+anzunttage,anzvormtage,anznachmtage,anzsprstd,anzsprstd1,anzsprstd2,
+anzsprstdx,sprstdlaenge,indextagesanf,fstat;BOOL VAR miniplanausgabe:=FALSE ,
+erstenichtvormstd:=TRUE ,keinmittag:=TRUE ,keinschueler:=TRUE ;FILE VAR datei
+;PROC springstundenschuelerausfuehren:standardmeldung(meldungwarten,"");
+miniplanausgabe:=FALSE ;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum
+(halbjahr);IF standardmaskenfeld(fnrakthj)=""THEN geplanteshjundsjberechnen(
+schhj,schj)FI ;IF standardmaskenfeld(fnrohneminiplan)=""THEN miniplanausgabe
+:=TRUE ;FI ;erstelleminiplan;stundenplanhalbjahrsetzen(schhj,schj);
+standardmeldung(meldungstdplauswvorber,"");
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+meldungausgeben(fstat);return(1);LEAVE springstundenschuelerausfuehrenFI ;
+inittupel(dnraktschuelergruppen);IF records(dnraktschuelergruppen)=0.0THEN 
+standardmeldung(meldungkeineschueler,"");return(1);LEAVE 
+springstundenschuelerausfuehrenELSE bereiteprotokollvor;keinschueler:=TRUE ;
+statleseschleife(dnraktschuelergruppen,schj,schhj,fnrsgrpsj,fnrsgrphj,PROC 
+schueler);IF keinschuelerTHEN standardmeldung(meldungkeineschueler,"");return
+(1);LEAVE springstundenschuelerausfuehrenFI FI ;zeigedatei(dateiname,"vr").
+bereiteprotokollvor:forget(dateiname,quiet);datei:=sequentialfile(output,
+dateiname);putline(datei,schulkenndatum(schulname));putline(datei,text(
+schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline(datei,
+ueberschrift+schhj+". "+text(schj,2)+"/"+subtext(schj,3));putline(datei,
+unterstrich);putline(datei,leerzeile);IF miniplanausgabeTHEN putline(datei,
+legende1);putline(datei,"    """+miniunterricht+legende2);putline(datei,
+"    """+minisprstd+legende3);putline(datei,"    """+minifrei+legende4);
+putline(datei,legende5);putline(datei,"    """+minivornachmtr+legende6);
+putline(datei,"    """+minitagestr+legende7);putline(datei,leerzeile);putline
+(datei,legende8);putline(datei,legende9);bereiteplanauf(miniplan);putline(
+datei,ausgminiplan);putline(datei,leerzeile)FI .erstelleminiplan:miniplan:=""
+;vormnachmwechsel:="";IF records(dnrzeitraster)=0.0THEN standardmeldung(
+meldungkeinzeitraster,"");return(1);LEAVE springstundenschuelerausfuehrenFI ;
+erstenichtvormstd:=TRUE ;inittupel(dnrzeitraster);statleseschleife(
+dnrzeitraster,schj,schhj,dnrzeitraster+1,dnrzeitraster+2,PROC zeitrasterdaten
+);IF length(miniplan)<letztestundeTHEN standardmeldung(meldungkeinzeitraster,
+"");return(1);LEAVE springstundenschuelerausfuehrenFI .END PROC 
+springstundenschuelerausfuehren;PROC schueler(BOOL VAR b):IF wert(fnrsgrpsj)
+<>schjCOR wert(fnrsgrphj)<>schhjCOR intwert(fnrsgrpjgst)>10COR dbstatus<>0
+THEN b:=TRUE ELSE schgrbez:=jgstaufber(wert(fnrsgrpjgst))+wert(fnrsgrpkennung
+);standardmeldung(meldungbearbwird,schgrbez+ausgabeparam);wstd:=
+anzahlverplstden(schgrbez);zeile:=text(schgrbez,laengeschgrbez);zeileCAT text
+(wstd,2);zeileCAT ausgabewstd;untersuchetage;zeileCAT ausgabetage;
+untersuchesprstden;zeileCAT ausgabesprstd;putline(datei,zeile);IF 
+miniplanausgabeTHEN bereiteplanauf(iminiplan);changeall(ausgminiplan,
+kennungvorm,minifrei);changeall(ausgminiplan,kennungnachm,minifrei);putline(
+datei,ausgminiplan)FI ;line(datei);IF keinschuelerTHEN keinschueler:=FALSE 
+FI FI .untersuchetage:ausgabetage:=vorgabetage;IF anzunttage<>0THEN replace(
+ausgabetage,posunttage,text(anzunttage))FI ;IF anzvormtage<>0THEN replace(
+ausgabetage,posvormtage,text(anzvormtage))FI ;IF anznachmtage<>0THEN replace(
+ausgabetage,posnachmtage,text(anznachmtage))FI .untersuchesprstden:anzsprstd
+:=0;anzsprstd1:=0;anzsprstd2:=0;anzsprstdx:=0;FOR iFROM 1UPTO tageprowoche
+REP erstepos:=0;letztepos:=0;indextagesanf:=(i-1)*stdprotag;tagesplan:=
+subtext(iminiplan,indextagesanf+1,i*stdprotag);ermittlerandundsprstdenPER .
+ermittlerandundsprstden:erstepos:=pos(tagesplan,miniunterricht);IF erstepos<>
+0THEN ermittleletztestd;ermittlevormnachmwechsel;ermittlespringstdFI .
+ermittleletztestd:FOR jFROM stdprotagDOWNTO 1REP IF (tagesplanSUB j)=
+miniunterrichtTHEN letztepos:=j;LEAVE ermittleletztestdFI PER .
+ermittlevormnachmwechsel:mittag:=0;FOR jFROM 12DOWNTO 1REP IF (miniplanSUB 
+indextagesanf+j)=kennungvormTHEN mittag:=j;LEAVE ermittlevormnachmwechselFI 
+PER .ermittlespringstd:keinmittag:=TRUE ;FOR jFROM letzteposDOWNTO erstepos
+REP IF (tagesplanSUB j)=kennungvormCOR (tagesplanSUB j)=kennungnachmCOR (
+tagesplanSUB j)=kennunggespTHEN anzsprstdINCR 1;sprstdlaengeINCR 1;IF 
+miniplanausgabeTHEN replace(iminiplan,indextagesanf+j,minisprstd);FI ;IF j=
+mittag+1COR j=mittagTHEN IF keinmittagTHEN anzsprstdINCR 1;sprstdlaengeINCR 1
+;keinmittag:=FALSE ;FI FI ELSE IF sprstdlaenge=1THEN anzsprstd1INCR 1ELIF 
+sprstdlaenge=2THEN anzsprstd2INCR 1ELIF sprstdlaenge>2THEN anzsprstdxINCR 1
+FI ;sprstdlaenge:=0;FI PER ;IF keinmittagCAND erstepos<=mittagCAND letztepos>
+mittagTHEN anzsprstdINCR 1;anzsprstd1INCR 1FI ;ausgabesprstd:=text(anzsprstd,
+2)+vorgabesprstd1+text(anzsprstd1,2)+vorgabesprstd2+text(anzsprstd2,2)+
+vorgabesprstd3+text(anzsprstdx,2)+vorgabesprstd4.END PROC schueler;PROC 
+bereiteplanauf(TEXT CONST plan):ausgminiplan:=plan;stdverschiebung:=0;FOR i
+FROM 1UPTO length(vormnachmwechsel)DIV 3REP relzeit:=vormnachmwechselSUB i*3-
+2;relzeitCAT (vormnachmwechselSUB i*3-1);zeichen:=vormnachmwechselSUB i*3;
+insertchar(ausgminiplan,zeichen,int(relzeit)+stdverschiebung);stdverschiebung
+INCR 1PER ;END PROC bereiteplanauf;PROC zeitrasterdaten(BOOL VAR b):IF wert(
+fnrzrsj)<>schjCOR wert(fnrzrhj)<>schhjCOR dbstatus<>0THEN b:=TRUE ELSE kvn:=
+wert(fnrzrkennungteil);kzt:=text(wert(fnrzrtagstunde),2);miniplanCAT kvn;IF 
+kvn<>kennungvormTHEN IF erstenichtvormstdTHEN kaktvn:=kzt;erstenichtvormstd:=
+FALSE FI ELSE erstenichtvormstd:=TRUE FI ;IF int(kzt)MOD stdprotag=1CAND kzt
+<>"1 "THEN IF kaktvn<>""THEN vormnachmwechselCAT kaktvn;vormnachmwechselCAT 
+minivornachmtr;kaktvn:=""FI ;vormnachmwechselCAT kzt;vormnachmwechselCAT 
+minitagestrFI #IF kzt=text(letztestunde)THEN IF kaktvn<>""THEN 
+vormnachmwechselCAT kaktvn;vormnachmwechselCAT minivornachmtr;kaktvn:=""FI 
+FI #FI END PROC zeitrasterdaten;INT PROC anzahlverplstden(TEXT CONST schgr):
+TEXT VAR stundenplan:=erstelleallezeiten(schgr),unttage:=tageprowoche*"0",
+vormtage:=tageprowoche*"0",nachmtage:=tageprowoche*"0";INT VAR einspos:=1,
+anzeinsen:=0,wochentag;iminiplan:=miniplan;anzunttage:=0;anzvormtage:=0;
+anznachmtage:=0;WHILE einspos<>0REP einspos:=pos(stundenplan,"1",einspos);IF 
+einspos<>0THEN anzeinsenINCR 1;replace(iminiplan,einspos,miniunterricht);
+wochentag:=(einspos-1)DIV stdprotag+1;IF (unttageSUB wochentag)="0"THEN 
+replace(unttage,wochentag,"1");anzunttageINCR 1FI ;IF (vormtageSUB wochentag)
+="0"CAND vormittagsunterrichtTHEN replace(vormtage,wochentag,"1");anzvormtage
+INCR 1FI ;IF (nachmtageSUB wochentag)="0"CAND nachmittagsunterrichtTHEN 
+replace(nachmtage,wochentag,"1");anznachmtageINCR 1FI ;einsposINCR 1FI PER ;
+anzeinsen.vormittagsunterricht:(miniplanSUB einspos)=kennungvorm.
+nachmittagsunterricht:(miniplanSUB einspos)=kennungnachm.END PROC 
+anzahlverplstden;TEXT PROC erstelleallezeiten(TEXT CONST schgruppe):TEXT VAR 
+allelv:=lvderschuelergruppe(schgruppe),allezeiten,aktzeiten:="",aktlv;INT 
+VAR i,einspos:=1;aktlv:=text(allelv,laengelv);allezeiten:=allezeitenvon(
+kennunglv,aktlv);FOR iFROM 2UPTO length(allelv)DIV laengelvREP aktlv:=subtext
+(allelv,(i-1)*laengelv+1,i*laengelv);aktzeiten:=allezeitenvon(kennunglv,aktlv
+);einspos:=1;WHILE einspos<>0REP einspos:=pos(aktzeiten,"1",einspos);IF 
+einspos<>0THEN IF (allezeitenSUB einspos)="0"THEN replace(allezeiten,einspos,
+"1");FI ;einsposINCR 1FI ;PER ;PER ;allezeitenEND PROC erstelleallezeiten;
+PROC meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung(
+meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan,
+"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5
+THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN 
+standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI END PROC meldungausgeben;END PACKET springstundenschueler;
+
diff --git a/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren b/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren
new file mode 100644
index 0000000..c505d27
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stand der stundenplanung analysieren
@@ -0,0 +1,98 @@
+PACKET standderstundenplanunganalysierenDEFINES 
+stundenplanstandanalyseausfuehren:LET feldakthj=2,dateiname="Fehlerprotokoll"
+,schulname="Schulname",schulort="Schulort",schuljahr="Schuljahr",halbjahr=
+"Schulhalbjahr",kennunglv="L",kennungkopplg="K",ausgpar="#",anzkopfzeilen=10,
+laengelv=8,laengekopplg=8,laengefachkenn=6,leererraum="    ",leerzeile=" ",
+ueberschrift1="Fehlerprotokoll zum Stand der Stundenplanung",unterstrich1=
+"-----------------------------------------------------",ausgkopp="          "
+,ausgkopplv="                                   ",ueberschrift2=
+"Kopplung  Lehrveranst.  Wstd.      Anmerkung",ueberschrift3=
+"                        soll/ist",unterstrich2=
+"---------+------------+-----------+--------------------------------------",
+keinefehler="Keine Fehler aufgetreten (alle Kopplungen korrekt verplant)!",
+zuvielverpl=" Std. zuviel verplant",raumfehlt="Raum fehlt für ",zuverplanen=
+" Std. noch zu verplanen",keinekopplg="Kopplung nicht erhalten (",
+meldungserverfehler=376,meldungkeinstdplan=366,meldungkeinesugruppen=334,
+meldungzuvielesugruppen=356,meldungkeinelv=326,meldungzuvielelv=358,
+meldungbasisinkon=378,meldungwarten=69,meldungstdplauswvorber=384,
+meldungkeinehjdaten=382,meldungbearbeitetwird=352;FILE VAR datei;TEXT VAR 
+aktkopplg:="",aktlv:="",sj,hj,ausgzeile,ausgpostfix;BOOL VAR 
+kopplungausgegeben:=FALSE ,lvausgegeben:=FALSE ;INT VAR maxwstd:=0,verplstden
+:=0,aktwstd:=0,anzverplstden:=0,fstat:=0,anzleereraumzuw:=0,jgstderlv;PROC 
+meldungausgeben(INT VAR fstat):IF fstat=2THEN standardmeldung(
+meldungserverfehler,"");ELIF fstat=3THEN standardmeldung(meldungkeinstdplan,
+"");ELIF fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5
+THEN standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN 
+standardmeldung(meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(
+meldungzuvielelv,"")ELIF fstat=9THEN standardmeldung(meldungbasisinkon,"");
+FI ;return(1)END PROC meldungausgeben;PROC stundenplanstandanalyseausfuehren:
+standardmeldung(meldungwarten,"");bestimmehalbjahr;bereiteprotokollvor;
+setzepufferwerte;holeunduntersuchekopplungen;IF lines(datei)=anzkopfzeilen
+THEN putline(datei,keinefehler)FI ;zeigedatei(dateiname,"vr").
+bereiteprotokollvor:forget(dateiname,quiet);datei:=sequentialfile(output,
+dateiname);putline(datei,schulkenndatum(schulname));putline(datei,text(
+schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline(datei,
+ueberschrift1+" "+hj+". "+text(sj,2)+"/"+subtext(sj,3));putline(datei,
+unterstrich1);putline(datei,leerzeile);putline(datei,ueberschrift2);putline(
+datei,ueberschrift3);putline(datei,unterstrich2);putline(datei,leerzeile).
+bestimmehalbjahr:sj:=schulkenndatum(schuljahr);hj:=schulkenndatum(halbjahr);
+IF standardmaskenfeld(feldakthj)=""THEN geplanteshjundsjberechnen(hj,sj);FI .
+setzepufferwerte:inittupel(dnrlehrveranstaltungen).
+holeunduntersuchekopplungen:IF keinehjdatenTHEN fehlermeldungkeinelvFI ;
+standardmeldung(meldungstdplauswvorber,"");stundenplanhalbjahrsetzen(hj,sj);
+stundenplanbasisundstundenplanholen(fstat);IF fstat=0COR fstat=8THEN 
+statleseschleife(ixlvsjhjkopp,sj,hj,fnrlvsj,fnrlvhj,PROC 
+kopplungenuntersuchen)ELSE meldungausgeben(fstat);LEAVE 
+stundenplanstandanalyseausfuehren;FI .keinehjdaten:records(
+dnrlehrveranstaltungen)=0.0.fehlermeldungkeinelv:standardmeldung(
+meldungkeinehjdaten,"");return(1).END PROC stundenplanstandanalyseausfuehren;
+PROC kopplungenuntersuchen(BOOL VAR b):IF wert(fnrlvsj)<>sjCOR wert(fnrlvhj)
+<>hjCOR dbstatus<>0THEN b:=TRUE ELSE IF aktkopplg<>wert(fnrlvkopplung)THEN 
+IF nichterstersatzCAND mehrerelvTHEN ueberpruefeinhaltungderkopplungFI ;
+aktkopplg:=wert(fnrlvkopplung);standardmeldung(meldungbearbeitetwird,
+aktkopplg+ausgpar);maxwstd:=0;IF kopplungausgegebenTHEN putline(datei,
+leerzeile)FI ;kopplungausgegeben:=FALSE ;FI ;lvausgegeben:=FALSE ;jgstderlv:=
+intwert(fnrlvjgst);IF jgstderlv=0THEN aktlv:="00"+text(wert(fnrlvfachkennung)
+,laengefachkenn)ELSE aktlv:=jgstaufber(wert(fnrlvjgst))+text(wert(
+fnrlvfachkennung),laengefachkenn)FI ;aktwstd:=intwert(fnrlvwochenstd);IF 
+maxwstd<aktwstdTHEN maxwstd:=aktwstdFI ;ueberpruefanzstdenundleereraumangabe;
+FI .nichterstersatz:aktkopplg<>"".mehrerelv:length(allelvmit(kennungkopplg,
+aktkopplg))>laengelv.ueberpruefanzstdenundleereraumangabe:anzleereraumzuw:=0;
+verplstden:=anzahlverplstden(kennunglv,aktlv);IF verplstden<aktwstdTHEN 
+fehlerzuwenigstdenELIF verplstden>aktwstdTHEN fehlerzuvielstdenFI ;IF 
+anzleereraumzuw>0THEN ausgzeile:="";ausgpostfix:=raumfehlt+text(
+anzleereraumzuw)+" Std.";IF kopplungausgegebenTHEN IF lvausgegebenTHEN 
+ausgzeileCAT ausgkopplv;lvausgegeben:=TRUE ELSE ausgzeileCAT ausgkopp;
+ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden,
+5);ausgzeileCAT "    ";FI ;ELSE ausgzeileCAT text(aktkopplg,laengekopplg+2);
+ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden,
+5);ausgzeileCAT "    ";kopplungausgegeben:=TRUE ;lvausgegeben:=TRUE FI ;
+ausgzeileCAT ausgpostfix;putline(datei,ausgzeile)FI .fehlerzuwenigstden:
+ausgzeile:="";ausgpostfix:=aktlv;ausgpostfixCAT text(aktwstd,8);ausgpostfix
+CAT text(verplstden,5);ausgpostfixCAT "    ";ausgpostfixCAT text(aktwstd-
+verplstden);ausgpostfixCAT zuverplanen;IF kopplungausgegebenTHEN ausgzeile:=
+ausgkopp;ELSE ausgzeile:=text(aktkopplg,laengekopplg+2);kopplungausgegeben:=
+TRUE FI ;ausgzeileCAT ausgpostfix;putline(datei,ausgzeile);lvausgegeben:=
+TRUE .fehlerzuvielstden:ausgzeile:="";ausgpostfix:=aktlv;ausgpostfixCAT text(
+aktwstd,8);ausgpostfixCAT text(verplstden,5);ausgpostfixCAT "    ";
+ausgpostfixCAT text(verplstden-aktwstd);ausgpostfixCAT zuvielverpl;IF 
+kopplungausgegebenTHEN ausgzeile:=ausgkopp;ELSE ausgzeile:=text(aktkopplg,
+laengekopplg+2);kopplungausgegeben:=TRUE FI ;ausgzeileCAT ausgpostfix;putline
+(datei,ausgzeile);lvausgegeben:=TRUE .ueberpruefeinhaltungderkopplung:
+anzverplstden:=anzahlverplstden(kennungkopplg,aktkopplg);IF anzverplstden>
+maxwstdTHEN ausgpostfix:=keinekopplg;ausgpostfixCAT text(anzverplstden);
+ausgpostfixCAT " Wstd.)";IF kopplungausgegebenTHEN IF lvausgegebenTHEN 
+ausgzeile:=ausgkopplv;ELSE ausgzeile:=ausgkopp;ausgzeileCAT aktlv;ausgzeile
+CAT text(aktwstd,8);ausgzeileCAT text(verplstden,5);ausgzeileCAT "    ";
+lvausgegeben:=TRUE FI ;ELSE ausgzeile:=text(aktkopplg,laengekopplg+2);
+ausgzeileCAT aktlv;ausgzeileCAT text(aktwstd,8);ausgzeileCAT text(verplstden,
+5);kopplungausgegeben:=TRUE FI ;ausgzeileCAT ausgpostfix;putline(datei,
+ausgzeile)FI .END PROC kopplungenuntersuchen;INT PROC anzahlverplstden(TEXT 
+CONST kennung,kennungstext):TEXT VAR stundenplan:=allezeitenvon(kennung,
+kennungstext),plv,praum,ppar;INT VAR einspos:=1,anzeinsen:=0;WHILE einspos<>0
+REP einspos:=pos(stundenplan,"1",einspos);IF einspos<>0THEN anzeinsenINCR 1;
+IF kennung=kennunglvTHEN ueberpruefleererraumFI ;einsposINCR 1FI PER ;
+anzeinsen.ueberpruefleererraum:planeintraglesen(einspos,kennunglv,
+kennungstext,plv,praum,ppar);IF praum=leererraumTHEN anzleereraumzuwINCR 1FI 
+.END PROC anzahlverplstden;END PACKET standderstundenplanunganalysieren;
+
diff --git a/app/schulis/2.2.1/src/4.stdpluebersichten b/app/schulis/2.2.1/src/4.stdpluebersichten
new file mode 100644
index 0000000..2c760c7
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stdpluebersichten
@@ -0,0 +1,425 @@
+PACKET stdpluebersichtenDEFINES merkeartderstdpluebersichtundzeigemaske,
+stdpluebersichterstellenunddruckenggfvorherzeigen,
+stdpluebersichtdruckenundggfnaechsteerstellen:INT VAR 
+ausgewaehlteuebersichtsart;LET artlehrer=1,artraeume=2,artsek1=3,artsek2=4,
+artzeiten=5,maskennamefuerlehrer="ms stdpluebersicht fuer lehrer",
+maskennamefuerraeume="ms stdpluebersicht fuer raeume",maskennamefuersek1=
+"ms stdpluebersicht fuer sek1",maskennamefuersek2=
+"ms stdpluebersicht fuer sek2",maskennamefuerzeiten=
+"ms stdpluebersicht fuer zeiten";TEXT VAR sj,hj,kennung,vonobjekt,bisobjekt,
+sek1kennungvon,sek1kennungbis,ueberschrift1,ueberschrift2,tag,
+listeallerobjekte:="";INT VAR laengederlistenobjekte,ptraktobjekt,sek1jgstvon
+,sek1jgstbis,varspbreite,anzahlspalten,vonstd,bisstd,anzahltage;BOOL VAR 
+nurdrucken,zweizeilig;LET fnr2geplsj=2,fnr3aktsj=3,fnr4einzeilig=4,
+fnr5zweizeilig=5,fnr6vonobjekt=6,fnr7bisobjekt=7,fnr8vonstd=8,fnr9bisstd=9,
+fnr10spaltenproseite=10,fnr11tageproseite=11,fnr12bildschirm=12,fnr13drucker=
+13,fnrz4vonstd=4,fnrz5bisstd=5,fnrz6anzspalten=6,fnrz7bildschirm=7,
+fnrz8drucker=8;LET erstestd=1,letztestdmofr=12,letztestdsa=6,maxanzstdn=66,
+letztertag=6,erstertag=1,allewochentagsbezeichnungen=
+"MODIMIDOFRSAMoDiMiDoFrSamodimidofrsa";LET konstspbreite=6,
+konstkopplungsbreite=8,maxanzspalten1bis4=9,maxanzspalten5=5,maxanzspalten=9,
+minanzspalten=1,spaltenbreite8=8,spaltenbreite10=10,spaltenbreite12=12,
+spaltenbreite27=27,druckdatei="liste.1",textstdpluebersicht=
+"Stundenplanübersicht für ",textlehrer="Lehrer",textraeume="Räume",textsek1=
+"Klassen der Sek. 1",textsek2="Jgst. ",textzeiten="Zeiten",
+textanfangfuerschulhalbjahr="Schuljahr 19",trennerfuerschuljahr="/",
+textmittefuerschulhalbjahr=", ",textendefuerschulhalbjahr=". Halbjahr",
+ueberschriftenzahl=2,spaltentrenner=":",trennstrichzeichen="-",
+spaltentrennerimstrich="+",textzeiterstespalte="Zeit  :",leereerstespalte=
+"      :",textmontag="Mo",textdienstag="Di",textmittwoch="Mi",textdonnerstag=
+"Do",textfreitag="Fr",textsamstag="Sa",textkeintag="  ",trennstrichfuerlv="/"
+,ueberschriftspalte2beiart4="Kopplung:",ueberschriftspalte3beiart4=
+" Lehrveranstaltungen",ueberschriftbeiart5="Lv      /R   /P   /Kopplg. ",
+endeposjgstinlv=2,anfposfachinlv=3,endeposfachinlv=4,anfposkennunginlv=5,
+laengeeinerlv=8,laengeeinerkopplung=8,laengeeinerparaphe=4,laengeeinesraumes=
+4,laengeeinersgrp=6,laengeeinerjgst=2,zeilebeianfangneueseite=2,
+maxtabzahljedruckdatei=10;LET meldnrlistewirdaufgebaut=7,
+meldnrbittezahlangeben=53,meldnrzahlausserhalbdergrenzen=54,
+meldnrungueltigeeingabe=55,meldnrauswahlnichtsinnvoll=56,meldnrplausi=57,
+meldnrlistewirdausgedruckt=58,meldnrbittewarten=69,meldnrinbearbeitung=352,
+meldnrkeinegueltigejgst=146,meldnrungueltigeparaphe=344,
+meldnrkeinelehrerdatenda=337,meldnrfalscheraumangabe=359,
+meldnrkeineraumdatenda=365,meldnrkeinestdpldatenda=366,meldnrfalschetagesbez=
+385,meldnrfalschestundenfolge=386,meldnralphabetischefolge=380,
+meldnrkeinehjdatenda=382,meldnrmaxzeichenueberschritten=383,
+meldnrstdpldatenwerdenaufbereitet=384;INT VAR fehlermeldnr:=
+meldnrauswahlnichtsinnvoll,status,aktdnr;BOOL VAR druckenfertig;LET niltext=
+"",blank=" ",null=0,bestandraeume="c02 raeume";LET letztejgstsek1=10,jgst11=
+"11",jgst12="12",jgst13="13";PROC merkeartderstdpluebersichtundzeigemaske(
+INT CONST art):ausgewaehlteuebersichtsart:=art;SELECT artOF CASE artlehrer:
+laengederlistenobjekte:=laengeeinerparaphe;kennung:="P";varspbreite:=
+spaltenbreite10;standardvproc(maskennamefuerlehrer)CASE artraeume:
+laengederlistenobjekte:=laengeeinesraumes;kennung:="R";varspbreite:=
+spaltenbreite10;standardvproc(maskennamefuerraeume)CASE artsek1:
+laengederlistenobjekte:=laengeeinersgrp;kennung:="S";varspbreite:=
+spaltenbreite8;standardvproc(maskennamefuersek1)CASE artsek2:
+laengederlistenobjekte:=laengeeinerjgst;kennung:="L";varspbreite:=
+spaltenbreite12;standardvproc(maskennamefuersek2)CASE artzeiten:varspbreite:=
+spaltenbreite27;standardvproc(maskennamefuerzeiten)END SELECT ;END PROC 
+merkeartderstdpluebersichtundzeigemaske;PROC 
+stdpluebersichtdruckenundggfnaechsteerstellen(BOOL CONST drucken):FILE VAR f;
+IF druckenTHEN standardmeldung(meldnrlistewirdausgedruckt,niltext);f:=
+sequentialfile(output,druckdatei);drucknachbereiten;ELSE TEXT VAR dateiname:=
+niltext;INT VAR index:=0;THESAURUS VAR t:=allLIKE "liste.*";get(t,dateiname,
+index);WHILE dateiname<>niltextREP forget(dateiname,quiet);get(t,dateiname,
+index)PER ;FI ;IF druckenfertigTHEN enter(2)ELSE IF 
+ausgewaehlteuebersichtsart=artzeitenTHEN bereitetabellefuerzeitenaufELSE 
+bereitetabelleninderdruckdateiaufFI ;return(1)FI ;END PROC 
+stdpluebersichtdruckenundggfnaechsteerstellen;PROC 
+stdpluebersichterstellenunddruckenggfvorherzeigen:standardmeldung(
+meldnrplausi,niltext);IF NOT (maskenwerteok)THEN return(1)ELSE IF NOT (
+druckwerteok)THEN fehlermeldnr:=meldnrmaxzeichenueberschritten;
+standardmeldung(fehlermeldnr,niltext);return(1)ELSE IF NOT (datenvorhanden)
+THEN standardmeldung(fehlermeldnr,niltext);return(1)ELSE IF nurdruckenTHEN 
+standardmeldung(meldnrbittewarten,niltext)ELSE standardmeldung(
+meldnrlistewirdaufgebaut,niltext)FI ;ueberschrift2:=
+textanfangfuerschulhalbjahr;ueberschrift2CAT text(sj,2);ueberschrift2CAT 
+trennerfuerschuljahr;ueberschrift2CAT subtext(sj,3);ueberschrift2CAT 
+textmittefuerschulhalbjahr;ueberschrift2CAT hj;ueberschrift2CAT 
+textendefuerschulhalbjahr;initdruckkopf(ueberschrift1,ueberschrift2);
+setzemitseitennummern(TRUE );druckenfertig:=FALSE ;ptraktobjekt:=1;IF 
+ausgewaehlteuebersichtsart=artzeitenTHEN bereitetabellefuerzeitenaufELSE 
+bereitetabelleninderdruckdateiaufFI ;IF nurdruckenTHEN drucknachbereiten;
+WHILE NOT druckenfertigREP IF ausgewaehlteuebersichtsart=artzeitenTHEN 
+bereitetabellefuerzeitenaufELSE bereitetabelleninderdruckdateiaufFI ;
+drucknachbereiten;PER ;enter(1)ELSE zeigedatei(druckdatei,"vr");FI ;FI ;FI ;
+FI ;END PROC stdpluebersichterstellenunddruckenggfvorherzeigen;BOOL PROC 
+maskenwerteok:standardpruefe(5,fnr2geplsj,fnr3aktsj,null,niltext,status);IF 
+status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;sj:=
+schulkenndatum("Schuljahr");hj:=schulkenndatum("Schulhalbjahr");IF 
+standardmaskenfeld(fnr3aktsj)=niltextTHEN geplanteshjundsjberechnen(hj,sj)FI 
+;stundenplanhalbjahrsetzen(hj,sj);IF ausgewaehlteuebersichtsart<>artzeiten
+THEN IF NOT (druckerbildschirmok(fnr12bildschirm,fnr13drucker))THEN LEAVE 
+maskenwerteokWITH FALSE FI ;standardpruefe(5,fnr4einzeilig,fnr5zweizeilig,
+null,niltext,status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH 
+FALSE FI ;zweizeilig:=standardmaskenfeld(fnr4einzeilig)=niltext;IF NOT (
+spaltenanzahlok(fnr10spaltenproseite))THEN LEAVE maskenwerteokWITH FALSE FI ;
+IF (standardmaskenfeld(fnr11tageproseite))=niltextTHEN anzahltage:=letztertag
++1ELSE standardpruefe(2,fnr11tageproseite,null,null,niltext,status);IF status
+=0THEN standardpruefe(3,fnr11tageproseite,erstertag,letztertag,niltext,status
+);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE ELSE 
+anzahltage:=int(standardmaskenfeld(fnr11tageproseite));FI ;ELSE infeld(status
+);LEAVE maskenwerteokWITH FALSE FI ;FI ;IF standardmaskenfeld(fnr8vonstd)=
+niltextTHEN vonstd:=erstestdELSE standardpruefe(2,fnr8vonstd,null,null,
+niltext,status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH 
+FALSE FI ;standardpruefe(3,fnr8vonstd,erstestd,letztestdmofr,niltext,status);
+IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;vonstd:=int
+(standardmaskenfeld(fnr8vonstd))FI ;IF standardmaskenfeld(fnr9bisstd)=niltext
+THEN bisstd:=letztestdmofrELSE standardpruefe(2,fnr9bisstd,null,null,niltext,
+status);IF status<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;
+standardpruefe(3,fnr9bisstd,erstestd,letztestdmofr,niltext,status);IF status
+<>0THEN infeld(status);LEAVE maskenwerteokWITH FALSE FI ;bisstd:=int(
+standardmaskenfeld(fnr9bisstd))FI ;IF vonstd>bisstdTHEN infeld(fnr9bisstd);
+fehlermeldnr:=meldnrauswahlnichtsinnvoll;standardmeldung(fehlermeldnr,niltext
+);LEAVE maskenwerteokWITH FALSE ;FI ;vonobjekt:=standardmaskenfeld(
+fnr6vonobjekt);bisobjekt:=standardmaskenfeld(fnr7bisobjekt);ELSE IF NOT (
+druckerbildschirmok(fnrz7bildschirm,fnrz8drucker))THEN LEAVE maskenwerteok
+WITH FALSE ELSE IF NOT anfangsundendzeitokTHEN standardmeldung(fehlermeldnr,
+niltext);LEAVE maskenwerteokWITH FALSE FI ;IF NOT (spaltenanzahlok(
+fnrz6anzspalten))THEN LEAVE maskenwerteokWITH FALSE FI ;FI ;FI ;TRUE .
+anfangsundendzeitok:TEXT VAR hilfstext;INT VAR tag;hilfstext:=
+standardmaskenfeld(fnrz4vonstd);IF hilfstext=niltextTHEN vonstd:=erstestd
+ELSE tag:=pos(allewochentagsbezeichnungen,text(hilfstext,2));IF tag=0THEN 
+fehlermeldnr:=meldnrfalschetagesbez;infeld(fnrz4vonstd);LEAVE 
+anfangsundendzeitokWITH FALSE FI ;tag:=(tagMOD 12)DIV 2;vonstd:=int(subtext(
+hilfstext,3));IF NOT lastconversionokTHEN fehlermeldnr:=
+meldnrbittezahlangeben;infeld(fnrz4vonstd);LEAVE anfangsundendzeitokWITH 
+FALSE FI ;IF vonstd<erstestdCOR (tag<letztertag-1AND vonstd>letztestdmofr)
+COR (tag=letztertag-1AND vonstd>letztestdsa)THEN fehlermeldnr:=
+meldnrzahlausserhalbdergrenzen;infeld(fnrz4vonstd);LEAVE anfangsundendzeitok
+WITH FALSE FI ;vonstd:=vonstd+(tag*letztestdmofr);FI ;hilfstext:=
+standardmaskenfeld(fnrz5bisstd);IF hilfstext=niltextTHEN bisstd:=maxanzstdn
+ELSE tag:=pos(allewochentagsbezeichnungen,text(hilfstext,2));IF tag=0THEN 
+fehlermeldnr:=meldnrfalschetagesbez;infeld(fnrz5bisstd);LEAVE 
+anfangsundendzeitokWITH FALSE FI ;tag:=(tagMOD 12)DIV 2;bisstd:=int(subtext(
+hilfstext,3));IF NOT lastconversionokTHEN fehlermeldnr:=
+meldnrbittezahlangeben;infeld(fnrz5bisstd);LEAVE anfangsundendzeitokWITH 
+FALSE FI ;IF bisstd<erstestdCOR (tag<letztertag-1AND bisstd>letztestdmofr)
+COR (tag=letztertag-1AND bisstd>letztestdsa)THEN fehlermeldnr:=
+meldnrzahlausserhalbdergrenzen;infeld(fnrz4vonstd);LEAVE anfangsundendzeitok
+WITH FALSE FI ;bisstd:=bisstd+(tag*letztestdmofr);FI ;IF vonstd>bisstdTHEN 
+fehlermeldnr:=meldnrfalschestundenfolge;infeld(fnrz4vonstd);LEAVE 
+anfangsundendzeitokWITH FALSE FI ;TRUE END PROC maskenwerteok;BOOL PROC 
+druckerbildschirmok(INT CONST fnrbs,fnrdr):BOOL VAR richtig:=FALSE ;
+standardpruefe(5,fnrbs,fnrdr,null,niltext,status);IF status<>0THEN infeld(
+status);ELSE richtig:=TRUE ;nurdrucken:=standardmaskenfeld(fnrbs)=niltext;FI 
+;richtigEND PROC druckerbildschirmok;BOOL PROC spaltenanzahlok(INT CONST 
+fnrspaltenanz):BOOL VAR richtig:=FALSE ;INT VAR spaltenmax,spaltenstandard;
+IF ausgewaehlteuebersichtsart=artzeitenTHEN spaltenstandard:=2;spaltenmax:=
+maxanzspalten5;ELIF ausgewaehlteuebersichtsart=artsek2THEN spaltenstandard:=4
+;spaltenmax:=maxanzspalten1bis4ELSE spaltenstandard:=5;spaltenmax:=
+maxanzspalten1bis4FI ;IF standardmaskenfeld(fnrspaltenanz)=niltextTHEN 
+anzahlspalten:=spaltenstandard;richtig:=TRUE ELSE standardpruefe(2,
+fnrspaltenanz,null,null,niltext,status);IF status<>0THEN infeld(status);ELSE 
+standardpruefe(3,fnrspaltenanz,minanzspalten,spaltenmax,niltext,status);IF 
+status<>0THEN infeld(status)ELSE anzahlspalten:=int(standardmaskenfeld(
+fnrspaltenanz));richtig:=TRUE FI ;FI ;FI ;richtigEND PROC spaltenanzahlok;
+BOOL PROC druckwerteok:BOOL VAR richtig;IF ausgewaehlteuebersichtsart=artsek2
+THEN richtig:=konstspbreite+1+konstkopplungsbreite+1+(varspbreite+1)*
+anzahlspalten<=druckbreiteELSE richtig:=konstspbreite+1+(varspbreite+1)*
+anzahlspalten<=druckbreiteFI ;IF NOT richtigTHEN IF 
+ausgewaehlteuebersichtsart=artzeitenTHEN infeld(fnrz6anzspalten)ELSE infeld(
+fnr10spaltenproseite)FI ;FI ;richtigEND PROC druckwerteok;BOOL PROC 
+datenvorhanden:BOOL VAR richtig:=FALSE ;stundenplanbasisundstundenplanholen(
+status);IF status<>0AND status<>8THEN fehlermeldnr:=meldnrkeinestdpldatenda;
+infeld(fnr2geplsj);ELSE SELECT ausgewaehlteuebersichtsartOF CASE artlehrer:
+aktdnr:=dnrlehrer;IF (datenpruefungok(fnrlparaphe,fnrlfamname))THEN richtig:=
+TRUE ;ueberschrift1:=textstdpluebersicht;ueberschrift1CAT textlehrer;FI ;
+CASE artraeume:aktdnr:=dnrschluessel;IF (datenpruefungok(fnrschlsachgebiet,
+fnrschlschluessel))THEN richtig:=TRUE ;ueberschrift1:=textstdpluebersicht;
+ueberschrift1CAT textraeume;FI ;CASE artsek1:aktdnr:=dnraktschuelergruppen;
+IF (datenpruefungok(fnrsgrpsj,fnrsgrphj))THEN richtig:=TRUE ;ueberschrift1:=
+textstdpluebersicht;ueberschrift1CAT textsek1;FI ;CASE artsek2:IF jgstokTHEN 
+richtig:=TRUE ;ueberschrift1:=textstdpluebersicht;ueberschrift1CAT textsek2;
+FI ;CASE artzeiten:richtig:=TRUE ;ueberschrift1:=textstdpluebersicht;
+ueberschrift1CAT textzeiten;END SELECT ;FI ;richtig.jgstok:IF vonobjekt=
+niltextTHEN vonobjekt:=jgst11FI ;IF bisobjekt=niltextTHEN bisobjekt:=jgst13
+FI ;IF vonobjekt<>jgst11AND vonobjekt<>jgst12AND vonobjekt<>jgst13THEN 
+fehlermeldnr:=meldnrkeinegueltigejgst;infeld(fnr6vonobjekt);LEAVE jgstokWITH 
+FALSE FI ;IF bisobjekt<>jgst11AND bisobjekt<>jgst12AND bisobjekt<>jgst13THEN 
+fehlermeldnr:=meldnrkeinegueltigejgst;infeld(fnr7bisobjekt);LEAVE jgstokWITH 
+FALSE FI ;IF int(bisobjekt)<int(vonobjekt)THEN fehlermeldnr:=
+meldnrauswahlnichtsinnvoll;infeld(fnr6vonobjekt);LEAVE jgstokWITH FALSE FI ;
+listeallerobjekte:=vonobjekt;IF vonobjekt=jgst11AND bisobjekt=jgst13THEN 
+listeallerobjekteCAT jgst12FI ;IF listeallerobjekte<>bisobjektTHEN 
+listeallerobjekteCAT bisobjektFI ;TRUE END PROC datenvorhanden;BOOL PROC 
+datenpruefungok(INT CONST erstesfeld,zweitesfeld):TEXT VAR ersterparameter,
+zweiterparameter;inittupel(aktdnr);listeallerobjekte:=niltext;IF 
+ausgewaehlteuebersichtsart=artlehrerTHEN IF records(aktdnr)=0.0THEN 
+fehlermeldnr:=meldnrkeinelehrerdatenda;infeld(fnr6vonobjekt);LEAVE 
+datenpruefungokWITH FALSE ;FI ;IF vonobjekt<>niltextTHEN putwert(fnrlparaphe,
+vonobjekt);search(aktdnr,TRUE );IF dbstatus<>0THEN fehlermeldnr:=
+meldnrungueltigeparaphe;infeld(fnr6vonobjekt);LEAVE datenpruefungokWITH 
+FALSE ;FI ;FI ;IF bisobjekt<>niltextTHEN putwert(fnrlparaphe,bisobjekt);
+search(aktdnr,TRUE );IF dbstatus<>0THEN fehlermeldnr:=meldnrungueltigeparaphe
+;infeld(fnr7bisobjekt);LEAVE datenpruefungokWITH FALSE ;FI ;FI ;
+ersterparameter:=vonobjekt;zweiterparameter:=niltext;inittupel(aktdnr);ELIF 
+ausgewaehlteuebersichtsart=artraeumeTHEN ersterparameter:=bestandraeume;
+zweiterparameter:=vonobjekt;putwert(fnrschlsachgebiet,ersterparameter);
+putwert(fnrschlschluessel,zweiterparameter);search(dnrschluessel,FALSE );IF 
+dbstatus<>0OR wert(fnrschlsachgebiet)<>bestandraeumeTHEN IF vonobjekt=niltext
+THEN fehlermeldnr:=meldnrkeineraumdatenda;ELSE fehlermeldnr:=
+meldnrfalscheraumangabe;FI ;infeld(fnr6vonobjekt);LEAVE datenpruefungokWITH 
+FALSE FI ;IF vonobjekt<>niltextTHEN search(dnrschluessel,TRUE );IF dbstatus<>
+0THEN fehlermeldnr:=meldnrfalscheraumangabe;infeld(fnr6vonobjekt);LEAVE 
+datenpruefungokWITH FALSE FI ;FI ;IF bisobjekt<>niltextTHEN putwert(
+fnrschlschluessel,bisobjekt);search(dnrschluessel,TRUE );IF dbstatus<>0THEN 
+fehlermeldnr:=meldnrfalscheraumangabe;infeld(fnr7bisobjekt);LEAVE 
+datenpruefungokWITH FALSE FI ;FI ;inittupel(aktdnr);ELSE ersterparameter:=sj;
+zweiterparameter:=hj;putwert(fnrsgrpsj,ersterparameter);putwert(fnrsgrphj,
+zweiterparameter);search(dnrschluessel,FALSE );IF dbstatus<>0OR wert(
+fnrsgrphj)<>hjTHEN infeld(fnr6vonobjekt);fehlermeldnr:=meldnrkeinehjdatenda;
+LEAVE datenpruefungokWITH FALSE FI ;IF vonobjekt<>niltextTHEN sek1kennungvon
+:=subtext(vonobjekt,3,6);sek1jgstvon:=int(subtext(vonobjekt,1,2));IF NOT (
+lastconversionok)THEN infeld(fnr6vonobjekt);fehlermeldnr:=
+meldnrkeinegueltigejgst;LEAVE datenpruefungokWITH FALSE FI ;FI ;IF bisobjekt
+<>niltextTHEN sek1kennungbis:=subtext(bisobjekt,3,6);sek1jgstbis:=int(subtext
+(bisobjekt,1,2));IF NOT lastconversionokCOR sek1jgstvon<5COR sek1jgstvon>11
+COR sek1jgstbis<5COR sek1jgstbis>11THEN infeld(fnr7bisobjekt);fehlermeldnr:=
+meldnrkeinegueltigejgst;LEAVE datenpruefungokWITH FALSE ELSE putintwert(
+fnrsgrpjgst,sek1jgstvon);putwert(fnrsgrpkennung,sek1kennungvon);IF 
+sek1jgstvon>sek1jgstbisTHEN infeld(fnr6vonobjekt);fehlermeldnr:=
+meldnrzahlausserhalbdergrenzen;LEAVE datenpruefungokWITH FALSE FI ;IF 
+sek1jgstvon=sek1jgstbisTHEN IF sek1kennungvon>sek1kennungbisTHEN infeld(
+fnr6vonobjekt);fehlermeldnr:=meldnralphabetischefolge;LEAVE datenpruefungok
+WITH FALSE FI ;FI ;IF sek1jgstbis<>10THEN bisobjekt:="0"+text(sek1jgstbis)+
+sek1kennungbis;FI ;IF sek1jgstvon<>10THEN vonobjekt:="0"+text(sek1jgstvon)+
+sek1kennungvon;FI ;FI ;FI ;FI ;IF vonanfangbisendeTHEN statleseschleife(
+aktdnr,ersterparameter,zweiterparameter,erstesfeld,zweitesfeld,PROC dateiende
+);ELIF vonanfangbiswertTHEN IF NOT bezeichnungzulaessig(kennung,bisobjekt)
+THEN infeld(fnr7bisobjekt);fehlermeldnr:=meldnrungueltigeeingabe;
+standardmeldung(fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE 
+statleseschleife(aktdnr,ersterparameter,zweiterparameter,erstesfeld,
+zweitesfeld,PROC endewert);FI ;ELIF vonwertbisendeTHEN IF NOT 
+bezeichnungzulaessig(kennung,vonobjekt)THEN infeld(fnr6vonobjekt);
+fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung(fehlermeldnr,niltext);
+LEAVE datenpruefungokWITH FALSE ELSE statleseschleife(aktdnr,ersterparameter,
+zweiterparameter,erstesfeld,zweitesfeld,PROC dateiende);FI ;ELIF 
+vonwertbiswertTHEN IF NOT bezeichnungzulaessig(kennung,vonobjekt)THEN infeld(
+fnr6vonobjekt);fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung(
+fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE IF NOT 
+bezeichnungzulaessig(kennung,bisobjekt)THEN infeld(fnr7bisobjekt);
+fehlermeldnr:=meldnrungueltigeeingabe;standardmeldung(fehlermeldnr,niltext);
+LEAVE datenpruefungokWITH FALSE ELSE IF vonobjekt>bisobjektTHEN infeld(
+fnr7bisobjekt);fehlermeldnr:=meldnralphabetischefolge;standardmeldung(
+fehlermeldnr,niltext);LEAVE datenpruefungokWITH FALSE ELSE statleseschleife(
+aktdnr,ersterparameter,zweiterparameter,erstesfeld,zweitesfeld,PROC endewert)
+;FI ;FI ;FI ;ELSE statleseschleife(aktdnr,ersterparameter,zweiterparameter,
+erstesfeld,zweitesfeld,PROC endewert);FI ;TRUE .vonanfangbisende:vonobjekt=
+niltextAND bisobjekt=niltext.vonanfangbiswert:vonobjekt=niltextAND bisobjekt
+<>niltext.vonwertbisende:vonobjekt<>niltextAND bisobjekt=niltext.
+vonwertbiswert:vonobjekt<>niltextAND bisobjekt<>niltextEND PROC 
+datenpruefungok;PROC endewert(BOOL VAR letzter):IF ausgewaehlteuebersichtsart
+=artlehrerTHEN IF dbstatus=0AND wert(fnrlparaphe)<=bisobjektTHEN 
+listeallerobjekteCAT text(wert(fnrlparaphe),laengederlistenobjekte)ELSE 
+letzter:=TRUE ;FI ;ELIF ausgewaehlteuebersichtsart=artraeumeTHEN IF dbstatus=
+0AND wert(fnrschlsachgebiet)=bestandraeumeAND bisobjekt>=wert(
+fnrschlschluessel)THEN listeallerobjekteCAT text(wert(fnrschlschluessel),
+laengederlistenobjekte)ELSE letzter:=TRUE ;FI ;ELSE IF dbstatus=0AND wert(
+fnrsgrpsj)=sjAND wert(fnrsgrphj)=hjAND (sek1jgstbis>intwert(fnrsgrpjgst)OR (
+sek1jgstbis=intwert(fnrsgrpjgst)AND sek1kennungbis>=wert(fnrsgrpkennung)))
+THEN listeallerobjekteCAT text(wert(fnrsgrpjgst),2);listeallerobjekteCAT text
+(wert(fnrsgrpkennung),4);ELSE letzter:=TRUE ;FI ;FI ;END PROC endewert;PROC 
+dateiende(BOOL VAR ende):IF ausgewaehlteuebersichtsart=artlehrerTHEN IF 
+dbstatus=0THEN listeallerobjekteCAT text(wert(fnrlparaphe),
+laengederlistenobjekte)ELSE ende:=TRUE FI ;ELIF ausgewaehlteuebersichtsart=
+artraeumeTHEN IF dbstatus=0AND wert(fnrschlsachgebiet)=bestandraeumeTHEN 
+listeallerobjekteCAT text(wert(fnrschlschluessel),laengederlistenobjekte);
+ELSE ende:=TRUE FI ;ELSE IF dbstatus=0AND wert(fnrsgrpsj)=sjAND wert(
+fnrsgrphj)=hjAND letztejgstsek1>=intwert(fnrsgrpjgst)THEN listeallerobjekte
+CAT text(wert(fnrsgrpjgst),2);listeallerobjekteCAT text(wert(fnrsgrpkennung),
+4);ELSE ende:=TRUE ;FI ;FI ;END PROC dateiende;PROC drucketrennstrich:TEXT 
+VAR t:=konstspbreite*trennstrichzeichen;tCAT spaltentrennerimstrich;IF 
+ausgewaehlteuebersichtsart=artsek2THEN tCAT konstkopplungsbreite*
+trennstrichzeichen;tCAT spaltentrennerimstrich;FI ;tCAT anzahlspalten*(
+varspbreite*trennstrichzeichen+spaltentrennerimstrich);druckzeileschreiben(t)
+END PROC drucketrennstrich;PROC druckespaltenueberschriften(ROW maxanzspalten
+TEXT CONST spaltenueberschrift):TEXT VAR t:=textzeiterstespalte;INT VAR i;IF 
+ausgewaehlteuebersichtsart=artsek2THEN tCAT spaltenueberschrift[1];tCAT 
+spaltenueberschrift[2]ELSE FOR iFROM 1UPTO anzahlspaltenREP tCAT text(
+spaltenueberschrift[i],varspbreite);tCAT spaltentrennerPER FI ;tCAT blank;
+druckzeileschreiben(t)END PROC druckespaltenueberschriften;PROC 
+bereitetabelleninderdruckdateiauf:TEXT VAR jgstbez,lvsderjgst,aktlv,aktkopplg
+,lvsprozeit,kopplgnprozeit,kopplgundlvs;INT VAR ptraktlv;INT VAR position,
+anfpos,endpos;INT VAR zeilenzaehler,aktstd,spaltenzaehler,stundenzaehler,
+tagzaehler,tabellenzaehler;TEXT VAR t,t1,lv,rm,par;BOOL VAR 
+erstezeilederstunde,stundenochnichtfertig;ROW maxanzspaltenTEXT VAR 
+spaltenueberschrift,zusatzangabe;druckvorbereiten;FOR tabellenzaehlerFROM 1
+UPTO maxtabzahljedruckdateiREP bestimmespaltenueberschriften;IF 
+ausgewaehlteuebersichtsart<>artsek2THEN standardmeldung(meldnrinbearbeitung,
+spaltenueberschrift(1)+"#");FI ;zeilenzaehler:=zeilebeianfangneueseite;
+druckkopfschreiben;druckespaltenueberschriften(spaltenueberschrift);
+drucketrennstrich;FOR tagzaehlerFROM erstertagUPTO letztertagREP IF 
+tagzaehler=letztertagTHEN aktstd:=min(bisstd,letztestdsa)ELSE aktstd:=bisstd
+FI ;FOR stundenzaehlerFROM vonstdUPTO aktstdREP bereitezeileneinerstundeauf
+PER ;IF zeilenzaehler>zeilebeianfangneueseiteTHEN drucketrennstrich;
+zeilenzaehlerINCR 1;evtlseitenumbruchwgueberlaenge;FI ;
+evtlseitenumbruchwgtageszahljeseite;PER ;IF zeilenzaehler>
+zeilebeianfangneueseiteTHEN seitenwechsel;zeilenzaehler:=
+zeilebeianfangneueseite;FI ;PER ;druckenfertig:=ptraktobjekt>length(
+listeallerobjekte).bestimmespaltenueberschriften:IF 
+ausgewaehlteuebersichtsart=artsek2THEN IF ptraktobjekt>length(
+listeallerobjekte)THEN druckenfertig:=TRUE ;LEAVE 
+bereitetabelleninderdruckdateiaufFI ;jgstbez:=subtext(listeallerobjekte,
+ptraktobjekt,ptraktobjekt+laengederlistenobjekte-1);lvsderjgst:=
+lvderschuelergruppe(jgstbez);spaltenueberschrift[1]:=
+ueberschriftspalte2beiart4;spaltenueberschrift[2]:=ueberschriftspalte3beiart4
+;initdruckkopf(ueberschrift1+blank+jgstbez,ueberschrift2);ptraktobjektINCR 
+laengederlistenobjekte;ELSE spaltenzaehler:=0;WHILE (spaltenzaehler<
+anzahlspalten)AND (ptraktobjekt<=length(listeallerobjekte))REP spaltenzaehler
+INCR 1;spaltenueberschrift[spaltenzaehler]:=subtext(listeallerobjekte,
+ptraktobjekt,ptraktobjekt+laengederlistenobjekte-1);ptraktobjektINCR 
+laengederlistenobjekte;PER ;IF spaltenzaehler=0THEN druckenfertig:=TRUE ;
+LEAVE bereitetabelleninderdruckdateiaufFI ;anzahlspalten:=spaltenzaehlerFI .
+bereitezeileneinerstundeauf:erstezeilederstunde:=TRUE ;stundenochnichtfertig
+:=TRUE ;WHILE stundenochnichtfertigREP IF erstezeilederstundeTHEN IF 
+stundenzaehler=vonstdTHEN SELECT tagzaehlerOF CASE 1:t:=textmontag;CASE 2:t:=
+textdienstag;CASE 3:t:=textmittwoch;CASE 4:t:=textdonnerstag;CASE 5:t:=
+textfreitag;CASE 6:t:=textsamstag;END SELECT ;tag:=t;ELSE t:=textkeintagFI ;t
+CAT blank;tCAT text(stundenzaehler,2);tCAT blank;tCAT spaltentrenner;ELSE t:=
+leereerstespalte;FI ;IF ausgewaehlteuebersichtsart=artsek2THEN IF 
+erstezeilederstundeTHEN anfpos:=1;endpos:=8;lvsprozeit:=datenderzeit((
+tagzaehler-1)*letztestdmofr+stundenzaehler,"L");kopplgnprozeit:=datenderzeit(
+(tagzaehler-1)*letztestdmofr+stundenzaehler,"K");position:=0;WHILE endpos<=
+length(lvsderjgst)AND positionMOD 8<>1REP aktlv:=subtext(lvsderjgst,anfpos,
+endpos);position:=pos(lvsprozeit,aktlv);anfposINCR 8;endposINCR 8PER ;IF 
+position<>0THEN aktkopplg:=subtext(kopplgnprozeit,position,position+7);
+kopplgundlvs:=aktkopplg;anfpos:=1;endpos:=8;position:=pos(kopplgnprozeit,
+aktkopplg);WHILE endpos<=length(kopplgnprozeit)AND position<>0REP IF position
+MOD 8=1THEN aktlv:=subtext(lvsprozeit,position,position+7);IF pos(
+kopplgundlvs,aktlv)=0THEN kopplgundlvsCAT aktlvFI ;anfposINCR 8;endposINCR 8;
+FI ;position:=pos(kopplgnprozeit,aktkopplg,position+1);PER ;ELSE kopplgundlvs
+:=niltextFI ;tCAT text(text(kopplgundlvs,laengeeinerkopplung),
+konstkopplungsbreite);ptraktlv:=laengeeinerkopplung+1;ELSE tCAT 
+konstkopplungsbreite*blankFI ;tCAT spaltentrenner;standardmeldung(
+meldnrinbearbeitung,"Jahrgangsstufe: "+jgstbez+" Wochentag: "+tag+"#");FI ;
+aktstd:=(tagzaehler-1)*letztestdmofr+stundenzaehler;FOR spaltenzaehlerFROM 1
+UPTO anzahlspaltenREP IF ausgewaehlteuebersichtsart=artsek2THEN IF ptraktlv<=
+length(kopplgundlvs)THEN lv:=subtext(kopplgundlvs,ptraktlv,ptraktlv+
+laengeeinerlv-1);ptraktlvINCR laengeeinerlv;planeintraglesen(aktstd,kennung,
+lv,lv,rm,par);rm:=8*blank+rm;t1:=subtext(lv,anfposfachinlv,endeposfachinlv);
+t1CAT blank;t1CAT subtext(lv,anfposkennunginlv);t1CAT trennstrichfuerlv;t1
+CAT par;ELSE t1:=niltext;par:=niltext;rm:=niltext;FI ;ELSE planeintraglesen(
+aktstd,kennung,spaltenueberschrift[spaltenzaehler],lv,rm,par);IF lv=niltext
+THEN t1:=niltextELSE IF ausgewaehlteuebersichtsart=artsek1THEN IF length(lv)>
+laengeeinerlvTHEN lv:=text(lv,laengeeinerlv);t1:=datenzurlv("K",lv);rm:=
+niltext;ELSE t1:=blank;t1CAT subtext(lv,anfposfachinlv,endeposfachinlv);t1
+CAT blank;t1CAT par;FI ;rm:=4*blank+rmELSE t1:=text(lv,endeposjgstinlv);t1
+CAT blank;t1CAT subtext(lv,anfposfachinlv,endeposfachinlv);t1CAT blank;t1CAT 
+subtext(lv,anfposkennunginlv);FI ;FI ;FI ;tCAT text(t1,varspbreite);tCAT 
+spaltentrenner;IF zweizeiligTHEN IF ausgewaehlteuebersichtsart=artraeumeTHEN 
+zusatzangabe[spaltenzaehler]:=parELSE zusatzangabe[spaltenzaehler]:=rmFI ;
+zusatzangabe[spaltenzaehler]:=text(zusatzangabe[spaltenzaehler],varspbreite);
+FI ;PER ;druckzeileschreiben(t);zeilenzaehlerINCR 1;IF zeilenzaehler=
+drucklaenge(ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler:=
+zeilebeianfangneueseite;IF zweizeiligCOR tagzaehler<letztertagCOR 
+stundenzaehler<min(bisstd,letztestdsa)COR (ausgewaehlteuebersichtsart=artsek2
+AND ptraktlv<=length(kopplgundlvs))THEN druckkopfschreiben;
+druckespaltenueberschriften(spaltenueberschrift);drucketrennstrich;FI ;FI ;
+IF zweizeiligTHEN t:=leereerstespalte;IF ausgewaehlteuebersichtsart=artsek2
+THEN tCAT konstkopplungsbreite*blank;tCAT spaltentrenner;FI ;FOR 
+spaltenzaehlerFROM 1UPTO anzahlspaltenREP tCAT zusatzangabe[spaltenzaehler];t
+CAT spaltentrenner;PER ;druckzeileschreiben(t);zeilenzaehlerINCR 1;IF 
+zeilenzaehler=drucklaenge(ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler
+:=zeilebeianfangneueseite;IF tagzaehler<letztertagCOR stundenzaehler<min(
+bisstd,letztestdsa)COR (ausgewaehlteuebersichtsart=artsek2AND ptraktlv<=
+length(kopplgundlvs))THEN druckkopfschreiben;druckespaltenueberschriften(
+spaltenueberschrift);drucketrennstrich;FI ;FI ;FI ;IF 
+ausgewaehlteuebersichtsart=artsek2THEN stundenochnichtfertig:=ptraktlv<=
+length(kopplgundlvs)ELSE stundenochnichtfertig:=FALSE FI ;erstezeilederstunde
+:=FALSE ;PER .evtlseitenumbruchwgueberlaenge:IF zeilenzaehler=drucklaenge(
+ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler:=zeilebeianfangneueseite;
+IF tagzaehler<letztertagTHEN druckkopfschreiben;druckespaltenueberschriften(
+spaltenueberschrift);drucketrennstrich;FI ;FI .
+evtlseitenumbruchwgtageszahljeseite:IF tagzaehlerMOD anzahltage=0AND 
+zeilenzaehler>zeilebeianfangneueseiteTHEN seitenwechsel;zeilenzaehler:=
+zeilebeianfangneueseite;IF tagzaehler<letztertagTHEN druckkopfschreiben;
+druckespaltenueberschriften(spaltenueberschrift);drucketrennstrich;FI ;FI .
+END PROC bereitetabelleninderdruckdateiauf;PROC bereitetabellefuerzeitenauf:
+BOOL VAR erstezeilederstunde:=TRUE ;TEXT VAR stringkopplungen,stringparaphen,
+stringraeume;INT VAR ptraktkopplung,ptraktparaphe,ptraktraum;ROW 
+maxanzspaltenTEXT VAR spaltenueberschrift;INT VAR zeilenzaehler,
+stundenzaehler,spaltenzaehler;TEXT VAR t;bestimmespaltenueberschriften;
+druckvorbereiten;druckkopfschreiben;druckespaltenueberschriften(
+spaltenueberschrift);drucketrennstrich;zeilenzaehler:=zeilebeianfangneueseite
+;FOR stundenzaehlerFROM vonstdUPTO bisstdREP IF stundenzaehler=vonstdOR 
+stundenzaehlerMOD letztestdmofr=1THEN SELECT (stundenzaehler-1)DIV 
+letztestdmofrOF CASE 0:tag:=textmontag;CASE 1:tag:=textdienstag;CASE 2:tag:=
+textmittwoch;CASE 3:tag:=textdonnerstag;CASE 4:tag:=textfreitag;CASE 5:tag:=
+textsamstag;END SELECT ;standardmeldung(meldnrinbearbeitung,"Wochentag : "+
+tag+"#");FI ;bereitezeileneinerstundeauf;evtltrennstrichdrucken;PER ;
+druckenfertig:=TRUE ;.bestimmespaltenueberschriften:FOR spaltenzaehlerFROM 1
+UPTO anzahlspaltenREP spaltenueberschrift[spaltenzaehler]:=
+ueberschriftbeiart5;PER ;.evtltrennstrichdrucken:IF (stundenzaehlerMOD 
+letztestdmofr=0OR stundenzaehler=bisstd)AND zeilenzaehler>
+zeilebeianfangneueseiteTHEN drucketrennstrich;zeilenzaehlerINCR 1;IF 
+zeilenzaehler=drucklaenge(ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler
+:=zeilebeianfangneueseite;IF stundenzaehler<bisstdTHEN druckkopfschreiben;
+druckespaltenueberschriften(spaltenueberschrift);drucketrennstrich;FI ;FI FI 
+;.bereitezeileneinerstundeauf:listeallerobjekte:=datenderzeit(stundenzaehler,
+"L");ptraktobjekt:=1;stringkopplungen:=datenderzeit(stundenzaehler,"K");
+ptraktkopplung:=1;stringparaphen:=datenderzeit(stundenzaehler,"P");
+ptraktparaphe:=1;stringraeume:=datenderzeit(stundenzaehler,"R");ptraktraum:=1
+;erstezeilederstunde:=TRUE ;WHILE ptraktobjekt<=length(listeallerobjekte)OR 
+erstezeilederstundeREP IF erstezeilederstundeOR zeilenzaehler=
+zeilebeianfangneueseiteTHEN t:=tag;tCAT blank;tCAT text((stundenzaehler-1)
+MOD letztestdmofr+1,2);tCAT blank;tCAT spaltentrenner;erstezeilederstunde:=
+FALSE ELSE t:=leereerstespalteFI ;FOR spaltenzaehlerFROM 1UPTO anzahlspalten
+REP IF ptraktobjekt>length(listeallerobjekte)THEN tCAT konstkopplungsbreite*
+blank;tCAT trennstrichfuerlv;tCAT 4*blank;tCAT trennstrichfuerlv;tCAT 4*blank
+;tCAT trennstrichfuerlv;tCAT konstkopplungsbreite*blank;tCAT spaltentrenner;
+ELSE tCAT subtext(listeallerobjekte,ptraktobjekt,ptraktobjekt+laengeeinerlv-1
+);tCAT trennstrichfuerlv;ptraktobjektINCR laengeeinerlv;tCAT subtext(
+stringraeume,ptraktraum,ptraktraum+laengeeinesraumes-1);tCAT 
+trennstrichfuerlv;ptraktraumINCR laengeeinesraumes;tCAT subtext(
+stringparaphen,ptraktparaphe,ptraktparaphe+laengeeinerparaphe-1);tCAT 
+trennstrichfuerlv;ptraktparapheINCR laengeeinerparaphe;tCAT subtext(
+stringkopplungen,ptraktkopplung,ptraktkopplung+laengeeinerkopplung-1);tCAT 
+spaltentrenner;ptraktkopplungINCR laengeeinerkopplung;FI ;PER ;
+druckzeileschreiben(t);zeilenzaehlerINCR 1;evtlseitenumbruchwgueberlaenge;
+PER .evtlseitenumbruchwgueberlaenge:IF zeilenzaehler=drucklaenge(
+ueberschriftenzahl)THEN seitenwechsel;zeilenzaehler:=zeilebeianfangneueseite;
+IF stundenzaehler<bisstdCOR listeallerobjekte<>niltextTHEN druckkopfschreiben
+;druckespaltenueberschriften(spaltenueberschrift);drucketrennstrich;FI ;FI ;.
+END PROC bereitetabellefuerzeitenauf;END PACKET stdpluebersichten;
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen b/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen
new file mode 100644
index 0000000..0d29a46
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan akt halbj uebernehmen
@@ -0,0 +1,141 @@
+PACKET stundenplanakthalbjuebernehmenDEFINES stundenplanuebernehmenpruefen,
+stundenplanuebernehmen:LET feldjgst1=2,feldjgst2=3,maxanzfehler=500,laengelv=
+8,schuljahr="Schuljahr",halbjahr="Schulhalbjahr",schulname="Schulname",
+schulort="Schulort",kennungraum="R",kennungparaphe="P",kennunglv="L",allejgst
+="00050607080910111213",leererraum="    ",ausgabeparam="#",erstestd=1,
+letztestd=66,dateiname="Protokoll zur Stundenplan-Übernahme",zwdatei=
+"Zwischenspeicherung",lvungueltig="Lehrveranstaltung nicht geplant",
+raumungueltig1="Raumbezeichnung ",raumungueltig2=" ungültig",ohneraum=
+" (Übernahme ohne Raum)",schnittschueler="Zeitüberschneidung Schüler durch ",
+schnittlehrer="Zeitüberschneidung Lehrer durch",schnittraum=
+"Zeitüberschneidung Raum ",leerzeile=" ",ueberschrift1=
+"Stundenplan für Jgst. ",ueberschrift2=" übernehmen von ",ueberschrift3=
+" nach ",meldungwirklichuebern=300,meldungfalschejgst=305,meldungabbruch=400,
+meldungbearbwird=352,meldungplausi=57,meldungwarten=69,meldungkeinesugruppen=
+334,meldungzuvielesugruppen=356,meldungkeinelv=326,meldungserverfehler=376,
+meldungbasisinkon=378,meldungjgst13=402,meldungzuvielelv=358;TEXT VAR aktsj,
+akthj,geplsj,geplhj,jgst1,jgst2,allelvderzeit,alleraeumederzeit,eintrag,
+aktzubearbjgst,geplzubearbjgst;INT VAR i,j,fstat,jg1,jg2,jgstpos,anzbearbjgst
+,zz:=0;BOOL VAR geplstundenplanneu:=FALSE ,jgstumzusetzen:=FALSE ,
+erstereintrag:=TRUE ;FILE VAR datei,z;PROC stundenplanreorganisiertverlassen:
+stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(2);
+meldungausgeben(fstat)FI END PROC stundenplanreorganisiertverlassen;PROC 
+stundenplanuebernehmenpruefen:standardmeldung(meldungwarten," ");
+holestartdaten;jgst1:=standardmaskenfeld(feldjgst1);jgst2:=standardmaskenfeld
+(feldjgst2);pruefeingaben;gibmeldunguebernahmeaus;standardnproc.
+holestartdaten:aktsj:=schulkenndatum(schuljahr);akthj:=schulkenndatum(
+halbjahr);geplsj:=aktsj;geplhj:=akthj;geplanteshjundsjberechnen(geplhj,geplsj
+).pruefeingaben:standardmeldung(meldungplausi,"");IF jgstrichtig(jgst1,jg1,1)
+THEN IF NOT jgstrichtig(jgst2,jg2,2)THEN infeld(feldjgst2);
+fehlermeldungfalschejgstFI ELSE infeld(feldjgst1);fehlermeldungfalschejgstFI 
+;IF jgst1=jgst2THEN aktzubearbjgst:=jgst1;ELSE aktzubearbjgst:=subtext(
+allejgst,pos(allejgst,jgst1),pos(allejgst,jgst2)+1)FI ;anzbearbjgst:=length(
+aktzubearbjgst)DIV 2;IF geplhj="2"THEN geplzubearbjgst:=aktzubearbjgstELIF 
+jgst1="13"THEN infeld(feldjgst1);fehlermeldungfalscherwertELIF jgst2="13"
+THEN infeld(feldjgst2);fehlermeldungfalscherwertELSE jgstumzusetzen:=TRUE ;
+berechnegeplzubearbjgstFI .fehlermeldungfalschejgst:standardmeldung(
+meldungfalschejgst,"");return(1);LEAVE stundenplanuebernehmenpruefen.
+fehlermeldungfalscherwert:standardmeldung(meldungjgst13,"");return(1);LEAVE 
+stundenplanuebernehmenpruefen.gibmeldunguebernahmeaus:standardmeldung(
+meldungwirklichuebern,"").END PROC stundenplanuebernehmenpruefen;PROC 
+berechnegeplzubearbjgst:TEXT VAR jg;jgstpos:=1;geplzubearbjgst:="";FOR iFROM 
+1UPTO anzbearbjgstREP jg:=subtext(aktzubearbjgst,jgstpos,jgstpos+1);IF jg=
+"00"THEN geplzubearbjgstCAT "00"ELSE geplzubearbjgstCAT jgstaufber(text(int(
+jg)+1))FI ;jgstposINCR 2PER END PROC berechnegeplzubearbjgst;BOOL PROC 
+jgstrichtig(TEXT VAR jgst,INT VAR jg,INT CONST pruefung):IF jgst<>""THEN jg:=
+int(jgst);IF jg=0CAND lastconversionokTHEN jgst:="00";TRUE ELIF 
+lastconversionokTHEN IF jg>4CAND jg<14THEN jgst:=jgstaufber(jgst);TRUE ELSE 
+FALSE FI ELSE FALSE FI ELIF pruefung=1THEN jgst:="05";jg:=5;TRUE ELIF 
+pruefung=2THEN jgst:=jgst1;jg:=jg1;TRUE ELSE FALSE FI .END PROC jgstrichtig;
+PROC stundenplanuebernehmen(BOOL CONST uebernahme):TEXT VAR ueberschrift:="";
+IF uebernahmeTHEN standardmeldung(meldungbearbwird,"Stundenplan "+akthj+". "+
+text(aktsj,2)+"/"+subtext(aktsj,3)+ausgabeparam);stundenplanhalbjahrsetzen(
+akthj,aktsj);stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat
+<>8THEN meldungausgeben(fstat);return(2);LEAVE stundenplanuebernehmenFI ;
+forget(dateiname,quiet);datei:=sequentialfile(output,dateiname);ueberschrift
+:=ueberschrift1+jgst1;IF jgst1<>jgst2THEN ueberschriftCAT " bis "+jgst2FI ;
+ueberschriftCAT ueberschrift2;ueberschriftCAT akthj+". ";ueberschriftCAT text
+(aktsj,2)+"/";ueberschriftCAT subtext(aktsj,3);ueberschriftCAT ueberschrift3;
+ueberschriftCAT geplhj+". ";ueberschriftCAT text(geplsj,2)+"/";ueberschrift
+CAT subtext(geplsj,3);putline(datei,schulkenndatum(schulname));putline(datei,
+text(schulkenndatum(schulort),65)+date);putline(datei,leerzeile);putline(
+datei,ueberschrift);putline(datei,length(ueberschrift)*"-");holalleeintraege;
+fstat:=0;loeschealleeintraege;IF fstat<>0CAND fstat<>8THEN meldungausgeben(
+fstat);return(2);LEAVE stundenplanuebernehmenFI ;uebertragalleeintraege;
+stundenplanreorganisiertverlassen;IF zz>maxanzfehlerTHEN standardmeldung(
+meldungabbruch,text(zz)+ausgabeparam)ELIF zz=0THEN 
+eintragkeineuebernahmefehlerFI ;IF fstat=0THEN zeigedatei(dateiname,"vr");FI 
+ELSE return(2)FI .eintragkeineuebernahmefehler:putline(datei,leerzeile);
+putline(datei,"Bei der Übernahme traten keine Fehler auf!").END PROC 
+stundenplanuebernehmen;PROC loeschealleeintraege:INT VAR jgstpos:=1;
+geplstundenplanneu:=FALSE ;stundenplanhalbjahrsetzen(geplhj,geplsj);
+standardmeldung(meldungbearbwird,"Stundenplan "+geplhj+". "+text(geplsj,2)+
+"/"+subtext(geplsj,3)+ausgabeparam);stundenplanbasisundstundenplanholen(fstat
+);IF fstat<>0CAND fstat<>8THEN stundenplanbasisundstundenplanerstellen(fstat)
+;IF fstat<>0THEN LEAVE loeschealleeintraegeELSE geplstundenplanneu:=TRUE ;
+stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN 
+meldungausgeben(fstat);return(2);LEAVE loeschealleeintraegeFI FI FI ;IF 
+geplstundenplanneuTHEN LEAVE loeschealleeintraegeFI ;FOR iFROM erstestdUPTO 
+letztestdREP standardmeldung(meldungbearbwird,tagstunde(i,FALSE )+
+" (Einträge löschen)"+ausgabeparam);allelvderzeit:=datenderzeit(i,kennunglv);
+jgstpos:=1;FOR jFROM 1UPTO anzbearbjgstREP loeschelv(subtext(geplzubearbjgst,
+jgstpos,jgstpos+1));jgstposINCR 2PER PER .END PROC loeschealleeintraege;PROC 
+loeschelv(TEXT CONST jgst):INT VAR suchab:=1,aktpos;BOOL VAR spok:=TRUE ;
+WHILE pos(allelvderzeit,jgst,suchab)>0REP aktpos:=pos(allelvderzeit,jgst,
+suchab);IF aktposMOD laengelv=1THEN planeintragloeschen(i,subtext(
+allelvderzeit,aktpos,aktpos+7),spok)FI ;suchab:=aktpos+7PER .END PROC 
+loeschelv;PROC holalleeintraege:forget(zwdatei,quiet);z:=sequentialfile(
+output,zwdatei);FOR iFROM erstestdUPTO letztestdREP standardmeldung(
+meldungbearbwird,tagstunde(i,FALSE )+" (Einträge holen)"+ausgabeparam);
+allelvderzeit:=datenderzeit(i,kennunglv);alleraeumederzeit:=datenderzeit(i,
+kennungraum);jgstpos:=1;eintrag:="";FOR jFROM 1UPTO anzbearbjgstREP holelv(
+subtext(aktzubearbjgst,jgstpos,jgstpos+1));jgstposINCR 2PER ;putline(z,
+eintrag)PER .END PROC holalleeintraege;PROC holelv(TEXT CONST jgst):INT VAR 
+suchab:=1,aktpos,ii;TEXT VAR lveintrag;WHILE pos(allelvderzeit,jgst,suchab)>0
+REP aktpos:=pos(allelvderzeit,jgst,suchab);IF aktposMOD laengelv=1THEN ii:=(
+aktpos+1)DIV 2;IF jgstumzusetzenTHEN lveintrag:=lv;IF text(lveintrag,2)<>"00"
+THEN eintragCAT jgstaufber(text(int(text(lveintrag,2))+1));eintragCAT subtext
+(lveintrag,3);ELSE eintragCAT lvFI ;eintragCAT raumELSE eintragCAT lv+raumFI 
+FI ;suchab:=aktpos+7PER .lv:subtext(allelvderzeit,aktpos,aktpos+7).raum:
+subtext(alleraeumederzeit,ii,ii+3).END PROC holelv;PROC 
+uebertragalleeintraege:zz:=0;modify(z);toline(z,1);col(z,1);FOR iFROM 
+erstestdUPTO letztestdREP standardmeldung(meldungbearbwird,tagstunde(i,FALSE 
+)+" (Einträge übernehmen)"+ausgabeparam);readrecord(z,eintrag);IF eintrag<>""
+THEN erstereintrag:=TRUE ;schreibeintraegeFI ;down(z);IF zz>maxanzfehlerTHEN 
+putline(datei,leerzeile);putline(datei,
+"Abbruch, da bei der Übernahme zuviele Fehler auftraten!");LEAVE 
+uebertragalleeintraegeFI PER END PROC uebertragalleeintraege;PROC 
+schreibeintraege:TEXT VAR lv,raum,t1,t2;INT VAR lvpos:=1;BOOL VAR ohnefehler;
+WHILE lvpos<length(eintrag)REP ohnefehler:=TRUE ;lv:=subtext(eintrag,lvpos,
+lvpos+7);raum:=subtext(eintrag,lvpos+8,lvpos+11);pruefungundeintrag;lvpos
+INCR 12PER .pruefungundeintrag:prueflv;pruefschnittschueler;
+pruefschnittlehrer;pruefraumundschnitt;IF ohnefehlerTHEN planeintragvornehmen
+(i,lv,raum,ohnefehler)FI .prueflv:IF NOT bezeichnungzulaessig(kennunglv,lv)
+THEN IF erstereintragTHEN putline(datei,leerzeile);erstereintrag:=FALSE FI ;
+putline(datei,jgfake(lv)+": "+tagstunde(i,TRUE )+". : "+lvungueltig);zzINCR 1
+;LEAVE pruefungundeintragFI .pruefschnittschueler:IF schuelerunterrichtTHEN 
+IF erstereintragTHEN putline(datei,leerzeile);erstereintrag:=FALSE FI ;
+putline(datei,jgfake(lv)+": "+tagstunde(i,TRUE )+". : "+schnittschueler+
+jgfake(t1));zzINCR 1;ohnefehler:=FALSE FI .schuelerunterricht:
+schuelergruppenschnittbeizeit(i,kennunglv,lv,"",t1,t2).pruefschnittlehrer:t1
+:=datenzurlv(kennungparaphe,lv);IF lehrerunterrichtTHEN IF erstereintragTHEN 
+putline(datei,leerzeile);erstereintrag:=FALSE FI ;putline(datei,jgfake(lv)+
+": "+tagstunde(i,TRUE )+". : "+schnittlehrer+jgfake(t2));zzINCR 1;ohnefehler
+:=FALSE FI .lehrerunterricht:t2:=geplantelvfuer(i,kennungparaphe,t1);t2<>lv
+CAND t2<>"".pruefraumundschnitt:IF raum<>leererraumTHEN IF NOT 
+bezeichnungzulaessig(kennungraum,raum)THEN IF erstereintragTHEN putline(datei
+,leerzeile);erstereintrag:=FALSE FI ;putline(datei,jgfake(lv)+": "+tagstunde(
+i,TRUE )+". : "+raumungueltig1+raum+raumungueltig2+ohneraum);zzINCR 1;raum:=
+leererraumELIF raumunterrichtTHEN IF erstereintragTHEN putline(datei,
+leerzeile);erstereintrag:=FALSE FI ;putline(datei,jgfake(lv)+": "+tagstunde(i
+,TRUE )+". : "+schnittraum+raum+ohneraum);zzINCR 1;raum:=leererraumFI FI .
+raumunterricht:t1:=geplantelvfuer(i,kennungraum,raum);t1<>lvCAND t1<>"".END 
+PROC schreibeintraege;TEXT PROC jgfake(TEXT CONST lv):text(lv,2)+" "+subtext(
+lv,3,4)+" "+subtext(lv,5)END PROC jgfake;PROC meldungausgeben(INT VAR fstat):
+IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF fstat=4THEN 
+standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN standardmeldung(
+meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung(meldungkeinelv,""
+)ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF fstat=9THEN 
+standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgebenFI END PROC 
+meldungausgeben;END PACKET stundenplanakthalbjuebernehmen;
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen b/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen
new file mode 100644
index 0000000..634545c
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan im dialog erstellen
@@ -0,0 +1,382 @@
+PACKET stundenplanimdialogerstellenundaendernDEFINES stupidstart,
+stupidbearbeitendesstundenplans,stupidspeicherndieserzeitenfuerkopplung,
+stupidspeichernderraeumeundzeitenderlv,stupidkopierenderraumangabe,
+stupidnichtaendernweitermitkopplung,
+stupidnichtaendernweitermitnaechsterkopplung,stupidstoerendelvlisten,
+stupidraumbelegunglisten,stupidlistedrucken:LET maskeeingang=
+"ms erf stuplan im dialog 0";LET maskebearb1="ms erf stuplan im dialog 1";
+LET maskebearb2="ms erf stuplan im dialog 2";LET fnrkopplungbs0=2,
+fnrakthalbjahr=3,fnrmitzeitwuenschen=4,fnrkopplungbs1=2,fnrwstdmaxbs1=3,
+felderbistabbeginn=2,fnrersteseingabefeldbs1=4,felderproeintragbs1=2,
+fnrletztesfeldbs1=135,fnrlehrveranstaltbs2=2,fnrwstdbs2=3,fnrparaphebs2=4,
+fnrklassengruppenbeginn=5,fnrraumwunsch=9,felderbistabbeginnbs2=10,
+fnrersterraumbs2=12,fnrletztesfeldbs2=142,felderproeintragbs2=2;INT VAR 
+fnrersteseingabefeldbs2;INT VAR ifnr;LET meldnrbittewarten=69,
+meldnrdatenwurdengespeichert=302,meldnrdatenwurdennichtgespeichert=303,
+meldnrungueltigekopplung=325,meldnrkeinelv=326,meldnrkeinesugruppen=334,
+meldnrzuvielesugruppen=356,meldnrdatenaufbereitet=357,meldnrzuvielelv=358,
+meldnrungueltigerraum=359,meldnrzuordnungwegensperrungunmoegl=368,
+meldnrzuvielezuordnungen=369,meldnrraumschonbelegt=370,
+meldnrstundenplanserverfehlt=376,meldnrbasisalt=377,meldnrbasisinkons=378,
+meldnrkeinestoerendenlv=371;FILE VAR ausgabeliste;LET liste1=
+"störende Lehrveranstaltungen",liste2="Raumbelegungen";TEXT VAR zeigdatei;
+LET raumgruppendatei="Datei mit Raumgruppen";FILE VAR datraumgruppen;LET 
+wunschraumdatei="Datei mit Raumwünschen";FILE VAR datraumwunsch;LET 
+zwdateiname="Datei mit Zeitwünschen";FILE VAR zwdatei;LET laengelv=8,
+laengefachkenn=6,laengekopplung=8,laengeparaphe=4,laengeraum=4,laengewstd=2,
+laengesugruppe=6,laengeklagruppe=4,laengenfaktor=2;LET erstestd=1,letztestd=
+66;LET kennzlehrergesperrt="L",kennzzeitgesperrt="X",kennzraumgesperrt="R",
+kennzschuelergesperrt="S",kennzzeitrastersperrung="x",kennzlehrerwunsch="l",
+kennzraumevtlgesperrt="r",kennzverplant="x",kennzkeinfreierwunschraum="x",
+kennzraumungeprueft="-";LET kennungkopplung="K",kennungparaphe="P",kennunglv=
+"L",kennungraum="R",kennungwunschraum="RW",kennungersatzraum="RE";LET 
+stundeverplant="1",stundefrei="0",stundefehlerhaft="$";LET textschulj=
+"Schuljahr",texthalbj="Schulhalbjahr";LET raumkenndaten="c02 raeume";LET 
+posraeumeinrgzeile=5;LET raumplatzhalter="    ",lehrerplatzhalter="    ",
+blankzeichen=" ",trennstrich="/",vorschlagzeichen="*",textueberschriftanhang=
+" für Halbjahr ",textueberschriftbs2="Raumzuordnung in Kopplung ";LET zwbezug
+="P";LET minusdrei="-3";INT VAR fstatusstuplan;INT VAR i;INT VAR 
+maxwochenstunden;TEXT VAR aktschulj:="",akthalbj:="",gewschulj,gewhalbj,
+behandeltesschulj:="",behandelteshalbj:="";TEXT VAR kopplung,ankreuzung,
+eintrag,lv,paraphe,raum,raumhinweis,raumzeile,raumgruppenzeile,zwdateizeile,
+raumbelegliste,raumsetzliste,alleraeume:="",paraphenmitzeitwuenschen:="",
+sugruppen;INT VAR anzahlraeume,posraum;INT VAR wstdderlv;TEXT VAR 
+kopplungszeiten,schuelerschnittzeiten,zeitrasterleiste:="",
+halbjderzeitrasterleiste:="",zeitwunschleiste,halbjderzeitwuensche:="",
+lvliste,paraphenliste;INT VAR ilv,anzahllv;TEXT VAR suchlv,suchraum,
+suchparaphe;TEXT VAR ueberschrift,ueberschriftbs1:="";BOOL VAR 
+mitzeitwuenschen,meldungzufehlergezeigt;TEXT VAR wertfeld2:="",wertfeld3:="",
+wertfeld4:="";PROC stupidstart:standardstartproc(maskeeingang);
+wertedeseingangsbildschirmsholen;infeld(fnrkopplungbs0);
+standardfelderausgeben;infeld(fnrkopplungbs0);standardnprocEND PROC 
+stupidstart;PROC stupidbearbeitendesstundenplans:
+schulhalbjahrbestimmenundstundenplanholen;IF fstatusstuplan<>0THEN 
+stundenplanfehlerbehandeln;return(1)ELSE suchekopplung;IF 
+keinegueltigekopplungTHEN standardmeldung(meldnrungueltigekopplung,"");return
+(1)ELSE wertedeseingangsbildschirmsmerken;standardstartproc(maskebearb1);
+kopplungzeigen;standardnprocFI FI .schulhalbjahrbestimmenundstundenplanholen:
+IF akthalbj=""THEN akthalbj:=schulkenndatum(texthalbj);aktschulj:=
+schulkenndatum(textschulj);FI ;gewhalbj:=akthalbj;gewschulj:=aktschulj;IF 
+standardmaskenfeld(fnrakthalbjahr)=""THEN geplanteshjundsjberechnen(gewhalbj,
+gewschulj)FI ;mitzeitwuenschen:=standardmaskenfeld(fnrmitzeitwuenschen)<>"";
+IF mitzeitwuenschenTHEN IF paraphenmitzeitwuenschen=""COR gewhalbj<>
+halbjderzeitwuenscheTHEN halbjderzeitwuensche:=gewhalbj;standardmeldung(
+meldnrbittewarten,"");dateimitzeitwuenschenzusammenstellenFI FI ;IF NOT (
+gewhalbj=behandelteshalbjAND gewschulj=behandeltesschulj)THEN 
+behandelteshalbj:=gewhalbj;behandeltesschulj:=gewschulj;
+stundenplanhalbjahrsetzen(gewhalbj,gewschulj);standardmeldung(
+meldnrdatenaufbereitet,"");stundenplanbasisundstundenplanholen(fstatusstuplan
+);IF fstatusstuplan=0THEN stundenplanreorganisierenundsichern(fstatusstuplan)
+ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt,"");
+stundenplanreorganisierenundsichern(fstatusstuplan)ELSE 
+stundenplanbasisundstundenplanerstellen(fstatusstuplan);IF fstatusstuplan=0
+THEN stundenplanbasissichern(fstatusstuplan);stundenplansichern(
+fstatusstuplan)FI FI FI .stundenplanfehlerbehandeln:IF fstatusstuplan=2THEN 
+standardmeldung(meldnrstundenplanserverfehlt,"")ELIF fstatusstuplan=4THEN 
+standardmeldung(meldnrkeinesugruppen,"")ELIF fstatusstuplan=5THEN 
+standardmeldung(meldnrzuvielesugruppen,"")ELIF fstatusstuplan=6THEN 
+standardmeldung(meldnrkeinelv,"")ELIF fstatusstuplan=7THEN standardmeldung(
+meldnrzuvielelv,"")ELIF fstatusstuplan=8THEN standardmeldung(meldnrbasisalt,
+"")ELIF fstatusstuplan=9THEN standardmeldung(meldnrbasisinkons,"")FI .
+suchekopplung:kopplung:=standardmaskenfeld(fnrkopplungbs0);putwert(fnrlvsj,
+gewschulj);putwert(fnrlvhj,gewhalbj);putwert(fnrlvkopplung,kopplung);search(
+ixlvsjhjkopp,FALSE ).END PROC stupidbearbeitendesstundenplans;BOOL PROC 
+keinegueltigekopplung:dbstatus<>0OR wert(fnrlvhj)<>gewhalbjOR wert(fnrlvsj)<>
+gewschuljEND PROC keinegueltigekopplung;PROC 
+dateimitzeitwuenschenzusammenstellen:forget(zwdateiname,quiet);zwdatei:=
+sequentialfile(output,zwdateiname);paraphenmitzeitwuenschen:="";inittupel(
+dnrzeitwuensche);putwert(fnrzwbezug,zwbezug);statleseschleife(dnrzeitwuensche
+,gewschulj,gewhalbj,fnrzwsj,fnrzwhj,PROC zeitwunschlesen)END PROC 
+dateimitzeitwuenschenzusammenstellen;PROC zeitwunschlesen(BOOL VAR b):IF 
+dbstatus<>0OR wert(fnrzwsj)<>gewschuljOR wert(fnrzwhj)<>gewhalbjOR wert(
+fnrzwbezug)>zwbezugTHEN b:=TRUE ELSE paraphenmitzeitwuenschenCAT text(wert(
+fnrzwbezugsobjekt),laengeparaphe);zwdateizeile:=wert(fnrzwbestimmtewuensche);
+putline(zwdatei,zwdateizeile)FI END PROC zeitwunschlesen;PROC kopplungzeigen:
+ueberschriftzeilezusammensetzen;standardkopfmaskeaktualisieren(ueberschrift);
+standardmeldung(meldnrbittewarten,"");datenbestimmenundausgeben;infeld(
+fnrersteseingabefeldbs1).ueberschriftzeilezusammensetzen:IF ueberschriftbs1=
+""THEN ueberschriftbs1:=text(vergleichsknoten)FI ;ueberschrift:=
+ueberschriftbs1;ueberschriftCAT textueberschriftanhang;ueberschriftCAT 
+gewhalbj;ueberschriftCAT blankzeichen;ueberschriftCAT subtext(gewschulj,1,2);
+ueberschriftCAT trennstrich;ueberschriftCAT subtext(gewschulj,3,4).
+datenbestimmenundausgeben:kopplung:=wert(fnrlvkopplung);
+maxwochenstundenbestimmen;zeitrasterleistefestlegen;kopplungszeitenfestlegen;
+lvlisteholen;paraphenlisteundwunschraumlisteholen;schuelerschnittzeitenholen;
+zeitwunschleistefestlegen;standardmaskenfeld(kopplung,fnrkopplungbs1);
+standardmaskenfeld(text(maxwochenstunden),fnrwstdmaxbs1);
+meldungzufehlergezeigt:=FALSE ;FOR iFROM erstestdUPTO letztestdREP 
+fuelleeintrag;standardmaskenfeld(ankreuzung,i*felderproeintragbs1+
+felderbistabbeginn);standardmaskenfeld(text(eintrag,3),i*felderproeintragbs1+
+felderbistabbeginn+1);PER ;IF meldungzufehlergezeigtTHEN infeld(2)ELSE infeld
+(1)FI ;standardfelderausgeben.maxwochenstundenbestimmen:maxwochenstunden:=0;
+putwert(fnrlvkopplung,kopplung);putintwert(fnrlvjgst,0);statleseschleife(
+ixlvsjhjkopp,gewschulj,gewhalbj,fnrlvsj,fnrlvhj,PROC maxwochenstdberechnen).
+fuelleeintrag:IF (kopplungszeitenSUB i)=stundeverplantTHEN ankreuzung:=
+kennzverplantELSE ankreuzung:=""FI ;eintrag:="";IF (zeitrasterleisteSUB i)=
+kennzzeitrastersperrungTHEN eintragCAT kennzzeitgesperrtELSE 
+weiterepruefungenzueintragFI .weiterepruefungenzueintrag:IF 
+istlehrerzurzeitverplantTHEN eintragCAT kennzlehrergesperrtELSE IF 
+mitzeitwuenschenCAND (zeitwunschleisteSUB i)=stundeverplantTHEN eintragCAT 
+kennzlehrerwunschFI FI ;IF (schuelerschnittzeitenSUB i)=stundeverplantTHEN 
+eintragCAT kennzschuelergesperrtELIF (schuelerschnittzeitenSUB i)=
+stundefehlerhaftCAND NOT meldungzufehlergezeigtTHEN standardmeldung(
+meldnrbasisinkons,"");meldungzufehlergezeigt:=TRUE FI ;IF eintrag=
+kennzlehrergesperrt+kennzschuelergesperrtTHEN eintragCAT kennzraumungeprueft
+ELSE raumhinweis:="";prueferaumbelegung;eintragCAT raumhinweisFI .
+kopplungszeitenfestlegen:kopplungszeiten:=allezeitenvon(kennungkopplung,
+kopplung).lvlisteholen:lvliste:=allelvmit(kennungkopplung,kopplung);anzahllv
+:=length(lvliste)DIV laengelv.schuelerschnittzeitenholen:
+schuelerschnittzeiten:=schuelergruppenschnittallezeiten(kennungkopplung,
+kopplung).paraphenlisteundwunschraumlisteholen:paraphenliste:="";
+raumgruppeninraumgruppendateiauslesen;forget(wunschraumdatei,quiet);
+datraumwunsch:=sequentialfile(output,wunschraumdatei);INT VAR lvpos:=1,iraum;
+FOR ilvFROM 1UPTO anzahllvREP lv:=subtext(lvliste,lvpos,lvpos+laengelv-1);
+paraphenlisteCAT datenzurlv(kennungparaphe,lv);raumzeile:="";raum:=datenzurlv
+(kennungwunschraum,lv);IF bezeichnungzulaessig(kennungraum,compress(raum))
+THEN raumzeileCAT raumELSE raumzeileCAT raeumederraumgruppeFI ;raum:=
+datenzurlv(kennungersatzraum,lv);IF bezeichnungzulaessig(kennungraum,compress
+(raum))THEN raumzeileCAT raumELSE raumzeileCAT raeumederraumgruppeFI ;putline
+(datraumwunsch,raumzeile);lvpos:=lvpos+laengelvPER .
+raumgruppeninraumgruppendateiauslesen:IF NOT exists(raumgruppendatei)THEN 
+datraumgruppen:=sequentialfile(output,raumgruppendatei);inittupel(
+dnrraumgruppen);statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp,
+fnrrgraeume,PROC raumgruppeindateischreiben)FI .raeumederraumgruppe:
+datraumgruppen:=sequentialfile(modify,raumgruppendatei);toline(datraumgruppen
+,1);col(datraumgruppen,1);WHILE NOT eof(datraumgruppen)REP downety(
+datraumgruppen,raum);IF col(datraumgruppen)=1CAND NOT eof(datraumgruppen)
+THEN readrecord(datraumgruppen,raumgruppenzeile);LEAVE raeumederraumgruppe
+WITH subtext(raumgruppenzeile,posraeumeinrgzeile)ELSE col(datraumgruppen,col(
+datraumgruppen)+1)FI ;PER ;"".prueferaumbelegung:BOOL VAR vorlaeufiggesetzt;
+raumbelegliste:=datenderzeit(i,kennungraum);IF raumbelegliste<>""THEN 
+raumsetzliste:="";datraumwunsch:=sequentialfile(input,wunschraumdatei);ilv:=0
+;WHILE NOT eof(datraumwunsch)REP getline(datraumwunsch,raumzeile);ilv:=ilv+1;
+IF raumzeile<>""THEN anzahlraeume:=length(raumzeile)DIV laengeraum;
+vorlaeufiggesetzt:=FALSE ;posraum:=1;FOR iraumFROM 1UPTO anzahlraeumeREP raum
+:=subtext(raumzeile,posraum,posraum+laengeraum-1);prueferaum;posraum:=posraum
++laengeraumUNTIL vorlaeufiggesetztPER ;IF NOT vorlaeufiggesetztTHEN 
+raumhinweis:=kennzraumevtlgesperrtFI ;FI ;PER ;FI .prueferaum:IF suchpos(
+raumbelegliste,raum,laengeraum)>0THEN lv:=subtext(lvliste,(ilv-1)*laengelv+1,
+ilv*laengelv);planeintraglesen(i,kennungraum,raum,suchlv,suchraum,suchparaphe
+);IF suchlv<>lvTHEN IF iraum=anzahlraeumeTHEN raumhinweis:=kennzraumgesperrt;
+LEAVE prueferaumbelegungFI ELSE vorlaeufiggesetzt:=TRUE FI ELSE IF suchpos(
+raumsetzliste,raum,laengeraum)=0THEN raumsetzliste:=raum;vorlaeufiggesetzt:=
+TRUE FI FI .zeitwunschleistefestlegen:IF mitzeitwuenschenTHEN zwdatei:=
+sequentialfile(modify,zwdateiname);zeitwunschleiste:=letztestd*stundefrei;
+INT VAR fundpos,posparaphe:=1;WHILE posparaphe<length(paraphenliste)REP 
+suchparaphe:=subtext(paraphenliste,posparaphe,posparaphe+laengeparaphe-1);
+fundpos:=suchpos(paraphenmitzeitwuenschen,suchparaphe,laengeparaphe);IF 
+fundpos>0THEN zeitwuenschezerlegenFI ;posparapheINCR laengeparaphe;PER ;FI .
+zeitwuenschezerlegen:INT VAR izeile:=(fundpos+3)DIV laengeparaphe;toline(
+zwdatei,izeile);readrecord(zwdatei,zwdateizeile);fundpos:=pos(zwdateizeile,
+minusdrei,1);WHILE fundpos>0REP fundposINCR 1;replace(zeitwunschleiste,
+fundposDIV 2,stundeverplant);fundpos:=pos(zwdateizeile,minusdrei,fundpos)PER 
+.END PROC kopplungzeigen;PROC raumgruppeindateischreiben(BOOL VAR b):IF 
+dbstatus=0THEN putline(datraumgruppen,text(wert(fnrrgraumgrp),laengeraum)+
+wert(fnrrgraeume))ELSE b:=TRUE FI END PROC raumgruppeindateischreiben;PROC 
+maxwochenstdberechnen(BOOL VAR b):IF dbstatus=0CAND wert(fnrlvkopplung)=
+kopplungCAND wert(fnrlvsj)=gewschuljCAND wert(fnrlvhj)=gewhalbjTHEN 
+maxwochenstunden:=max(intwert(fnrlvwochenstd),maxwochenstunden)ELSE b:=TRUE 
+FI END PROC maxwochenstdberechnen;PROC zeitrasterleistefestlegen:IF gewhalbj
+<>halbjderzeitrasterleisteOR zeitrasterleiste=""THEN zeitrasterleiste:=
+letztestd*blankzeichen;inittupel(dnrzeitraster);statleseschleife(
+dnrzeitraster,gewschulj,gewhalbj,fnrzrsj,fnrzrhj,PROC 
+erstellezeitrasterleiste);halbjderzeitrasterleiste:=gewhalbj;FI END PROC 
+zeitrasterleistefestlegen;PROC erstellezeitrasterleiste(BOOL VAR b):IF wert(
+fnrzrsj)<>gewschuljCOR wert(fnrzrhj)<>gewhalbjCOR dbstatus<>0THEN b:=TRUE 
+ELSE IF wert(fnrzrkennungteil)=kennzzeitrastersperrungTHEN replace(
+zeitrasterleiste,intwert(fnrzrtagstunde),kennzzeitrastersperrung)FI FI END 
+PROC erstellezeitrasterleiste;BOOL PROC istlehrerzurzeitverplant:TEXT VAR 
+kopplungenderzeit:="";TEXT VAR lehrerderzeit:=datenderzeit(i,kennungparaphe);
+IF lehrerderzeit=""COR paraphenliste=lehrerplatzhalterTHEN LEAVE 
+istlehrerzurzeitverplantWITH FALSE FI ;INT VAR posparaphe:=1;INT VAR 
+poslehrer,poskopplung;WHILE posparaphe<=length(paraphenliste)REP paraphe:=
+subtext(paraphenliste,posparaphe,posparaphe+laengeparaphe-1);IF paraphe<>
+lehrerplatzhalterTHEN poslehrer:=suchpos(lehrerderzeit,paraphe,laengeparaphe)
+;IF poslehrer>0THEN IF kopplungenderzeit=""THEN kopplungenderzeit:=
+datenderzeit(i,kennungkopplung)FI ;poskopplung:=(poslehrer-1)*laengenfaktor+1
+;IF subtext(kopplungenderzeit,poskopplung,poskopplung+laengekopplung-1)<>text
+(kopplung,laengekopplung)THEN LEAVE istlehrerzurzeitverplantWITH TRUE FI FI ;
+FI ;posparaphe:=posparaphe+laengeparaphePER ;FALSE END PROC 
+istlehrerzurzeitverplant;PROC stupidstoerendelvlisten:TEXT VAR prueflv,
+pruefkopplung,pruefparaphe,lvderzeit,kopplungenderzeit,paraphenderzeit,
+vglkopplung,auszeile;INT VAR feldnr:=infeld;IF 
+sperrungderzeitdurchlehreroderschuelerTHEN erstelledateimitstoerendenlv;
+zeigedatei(zeigdatei,"");ELSE standardmeldung(meldnrkeinestoerendenlv,"");
+return(1)FI .sperrungderzeitdurchlehreroderschueler:pos(standardmaskenfeld(
+feldnr+1),kennzlehrergesperrt)>0OR pos(standardmaskenfeld(feldnr+1),
+kennzschuelergesperrt)>0.erstelledateimitstoerendenlv:i:=(feldnr-
+felderbistabbeginn)DIV felderproeintragbs1;zeigdatei:=liste1;forget(zeigdatei
+,quiet);ausgabeliste:=sequentialfile(output,zeigdatei);auszeile:="Kopplung ";
+auszeileCAT kopplung;auszeileCAT " am ";auszeileCAT tagstunde(i,FALSE );
+auszeileCAT ".Stunde verhindert durch:";putline(ausgabeliste,auszeile);line(
+ausgabeliste);auszeile:="Lehrveranst. (Kopplung) Lehrer Klassengruppen";
+putline(ausgabeliste,auszeile);lvderzeit:=datenderzeit(i,kennunglv);
+kopplungenderzeit:=datenderzeit(i,kennungkopplung);paraphenderzeit:=
+datenderzeit(i,kennungparaphe);INT VAR poslv:=1,poskopplung:=1,posparaphe:=1;
+vglkopplung:=text(kopplung,laengekopplung);WHILE poslv<=length(lvderzeit)REP 
+pruefkopplung:=subtext(kopplungenderzeit,poskopplung,poskopplung+
+laengekopplung-1);IF pruefkopplung<>vglkopplungTHEN pruefparaphe:=subtext(
+paraphenderzeit,posparaphe,posparaphe+laengeparaphe-1);prueflv:=subtext(
+lvderzeit,poslv,poslv+laengelv-1);IF suchpos(paraphenliste,pruefparaphe,
+laengeparaphe)>0CAND pruefparaphe<>lehrerplatzhalterTHEN vermerkelvELIF 
+gemeinsameschuelergruppen(kennungkopplung,kopplung,kennunglv,prueflv)THEN 
+vermerkelvFI ;FI ;poskopplung:=poskopplung+laengekopplung;poslv:=poslv+
+laengelv;posparaphe:=posparaphe+laengeparaphe;PER .vermerkelv:auszeile:=
+subtext(prueflv,1,2);auszeileCAT blankzeichen;auszeileCAT subtext(prueflv,3,4
+);auszeileCAT blankzeichen;auszeileCAT subtext(prueflv,5);auszeileCAT "   ";
+auszeileCAT pruefkopplung;auszeileCAT "   ";auszeileCAT pruefparaphe;auszeile
+CAT "   ";sugruppen:=beteiligteschuelergruppen(kennunglv,prueflv);INT VAR 
+possu:=1;WHILE possu<=length(sugruppen)REP auszeileCAT subtext(sugruppen,
+possu,possu+laengesugruppe-1);auszeileCAT blankzeichen;possu:=possu+
+laengesugruppePER ;putline(ausgabeliste,auszeile).END PROC 
+stupidstoerendelvlisten;PROC stupidraumbelegunglisten:TEXT VAR auszeile;INT 
+VAR feldnr:=infeld;erstelledateimitraumbelegung;zeigedatei(zeigdatei,"").
+erstelledateimitraumbelegung:i:=(feldnr-felderbistabbeginnbs2)DIV 
+felderproeintragbs2;zeigdatei:=liste2;forget(zeigdatei,quiet);ausgabeliste:=
+sequentialfile(output,zeigdatei);auszeile:=
+"Raumbelegung für Lehrveranstaltung ";auszeileCAT subtext(lv,1,2);auszeile
+CAT blankzeichen;auszeileCAT subtext(lv,3,4);auszeileCAT blankzeichen;
+auszeileCAT subtext(lv,5);auszeileCAT " am ";auszeileCAT tagstunde(i,FALSE );
+auszeileCAT ".Stunde:";putline(ausgabeliste,auszeile);line(ausgabeliste);
+putline(ausgabeliste,"freie Räume:");line(ausgabeliste);IF alleraeume=""THEN 
+alleraeumeholenFI ;posraum:=1;WHILE posraum<=length(alleraeume)REP raum:=
+subtext(alleraeume,posraum,posraum+laengeraum-1);planeintraglesen(i,
+kennungraum,raum,suchlv,suchraum,suchparaphe);IF suchraum=""THEN putline(
+ausgabeliste,raum)FI ;posraum:=posraum+laengeraumPER ;line(ausgabeliste);line
+(ausgabeliste);putline(ausgabeliste,"Belegung der Wunsch- und Ersatzräume:");
+datraumwunsch:=sequentialfile(modify,wunschraumdatei);toline(datraumwunsch,
+ilv);readrecord(datraumwunsch,raumzeile);posraum:=1;WHILE posraum<=length(
+raumzeile)REP raum:=subtext(raumzeile,posraum,posraum+laengeraum-1);
+planeintraglesen(i,kennungraum,raum,suchlv,suchraum,suchparaphe);IF suchraum
+<>""THEN auszeile:=raum;auszeileCAT " :  ";auszeileCAT subtext(suchlv,1,2);
+auszeileCAT blankzeichen;auszeileCAT subtext(suchlv,3,4);auszeileCAT 
+blankzeichen;auszeileCAT subtext(suchlv,5);putline(ausgabeliste,auszeile);FI 
+;posraum:=posraum+laengeraumPER .alleraeumeholen:inittupel(dnrschluessel);
+statleseschleife(dnrschluessel,raumkenndaten,"",fnrschlsachgebiet,
+fnrschlschluessel,PROC raeumeholen).END PROC stupidraumbelegunglisten;PROC 
+raeumeholen(BOOL VAR b):IF wert(fnrschlsachgebiet)>raumkenndatenCOR dbstatus
+<>0THEN b:=TRUE ELSE alleraeumeCAT text(wert(fnrschlschluessel),laengeraum)
+FI END PROC raeumeholen;PROC stupidspeicherndieserzeitenfuerkopplung:BOOL 
+VAR plausifehler:=FALSE ;INT VAR anzahlankreuzungen:=0;ifnr:=
+fnrersteseingabefeldbs1;REP IF standardmaskenfeld(ifnr)<>""THEN IF zeitbelegt
+OR lehrerbelegtOR schuelerbelegtTHEN plausifehler:=TRUE ;standardmeldung(
+meldnrzuordnungwegensperrungunmoegl,"");infeld(ifnr)FI ;anzahlankreuzungen
+INCR 1FI ;ifnrINCR felderproeintragbs1UNTIL (ifnr>fnrletztesfeldbs1)OR 
+plausifehlerPER ;IF plausifehlerTHEN return(1)ELIF anzahlankreuzungen>
+maxwochenstundenTHEN standardmeldung(meldnrzuvielezuordnungen,"");return(1)
+ELSE speichernderkopplung;standardmeldung(meldnrdatenwurdengespeichert,"");
+stundenplansichern(fstatusstuplan);IF anzahlankreuzungen=0THEN 
+stupidnichtaendernweitermitnaechsterkopplungELSE standardstartproc(
+maskebearb2);erstelvzurkopplungnocheinmallesen;ilv:=1;lvzeigen;standardnproc
+FI FI .zeitbelegt:pos(standardmaskenfeld(ifnr+1),kennzzeitgesperrt)>0.
+lehrerbelegt:pos(standardmaskenfeld(ifnr+1),kennzlehrergesperrt)>0.
+schuelerbelegt:pos(standardmaskenfeld(ifnr+1),kennzschuelergesperrt)>0.
+erstelvzurkopplungnocheinmallesen:putwert(fnrlvsj,gewschulj);putwert(fnrlvhj,
+gewhalbj);putwert(fnrlvkopplung,kopplung);search(ixlvsjhjkopp,FALSE ).
+speichernderkopplung:INT VAR poslv;ifnr:=fnrersteseingabefeldbs1;FOR iFROM 
+erstestdUPTO letztestdREP ankreuzung:=standardmaskenfeld(ifnr);IF (
+kopplungszeitenSUB i)=stundeverplantTHEN IF ankreuzung=""THEN 
+kopplungentfernenELSE kopplungueberschreibenFI ELSE IF ankreuzung<>""THEN 
+kopplungschreibenFI ;FI ;ifnr:=ifnr+felderproeintragbs1PER .kopplungschreiben
+:BOOL VAR ok;poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext(lvliste,
+poslv,poslv+laengelv-1);planeintragvornehmen(i,lv,raumplatzhalter,ok);poslv:=
+poslv+laengelvPER ;replace(kopplungszeiten,i,stundeverplant).
+kopplungentfernen:poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext(
+lvliste,poslv,poslv+laengelv-1);planeintragloeschen(i,lv,ok);poslv:=poslv+
+laengelvPER ;replace(kopplungszeiten,i,stundefrei).kopplungueberschreiben:
+poslv:=1;WHILE poslv<=length(lvliste)REP lv:=subtext(lvliste,poslv,poslv+
+laengelv-1);planeintraglesen(i,kennunglv,lv,suchlv,suchraum,suchparaphe);
+suchraum:=compress(suchraum);IF suchraum=""THEN suchraum:=raumplatzhalterFI ;
+planeintragvornehmen(i,lv,suchraum,ok);poslv:=poslv+laengelvPER .END PROC 
+stupidspeicherndieserzeitenfuerkopplung;PROC lvzeigen:
+ueberschriftzeilezusammensetzen;standardkopfmaskeaktualisieren(ueberschrift);
+datenbestimmenundausgeben.ueberschriftzeilezusammensetzen:ueberschrift:=
+textueberschriftbs2;ueberschriftCAT kopplung;ueberschriftCAT 
+textueberschriftanhang;ueberschriftCAT gewhalbj;ueberschriftCAT blankzeichen;
+ueberschriftCAT subtext(gewschulj,1,2);ueberschriftCAT trennstrich;
+ueberschriftCAT subtext(gewschulj,3,4).datenbestimmenundausgeben:
+werteauslvsatzholen;ifnr:=felderbistabbeginnbs2;fnrersteseingabefeldbs2:=0;
+FOR iFROM erstestdUPTO letztestdREP IF (kopplungszeitenSUB i)=stundeverplant
+THEN planeintraglesen(i,kennunglv,text(lv,laengelv),suchlv,suchraum,
+suchparaphe);IF compress(suchraum)<>""THEN standardmaskenfeld(blankzeichen,
+ifnr+1);standardmaskenfeld(compress(suchraum),ifnr+2)ELSE standardmaskenfeld(
+vorschlagzeichen,ifnr+1);standardmaskenfeld(compress(wunschraumvorschlag),
+ifnr+2)FI ;IF fnrersteseingabefeldbs2=0THEN fnrersteseingabefeldbs2:=ifnr+2
+FI ELSE standardmaskenfeld(blankzeichen,ifnr+1);standardmaskenfeld(
+raumplatzhalter,ifnr+2);feldschutz(ifnr+2)FI ;ifnr:=ifnr+felderproeintragbs2
+PER ;infeld(1);standardfelderausgeben;infeld(fnrersteseingabefeldbs2).
+werteauslvsatzholen:lv:=jgstzweistellig(intwert(fnrlvjgst))+text(wert(
+fnrlvfachkennung),laengefachkenn);wstdderlv:=intwert(fnrlvwochenstd);paraphe
+:=wert(fnrlvparaphe);standardmaskenfeld(text(lv,laengelv),
+fnrlehrveranstaltbs2);standardmaskenfeld(text(wstdderlv,laengewstd),
+fnrwstdbs2);standardmaskenfeld(text(paraphe,laengeparaphe),fnrparaphebs2);
+standardmaskenfeld(text(wert(fnrlvklgrp1),laengeklagruppe),
+fnrklassengruppenbeginn);standardmaskenfeld(text(wert(fnrlvklgrp2),
+laengeklagruppe),fnrklassengruppenbeginn+1);standardmaskenfeld(text(wert(
+fnrlvklgrp3),laengeklagruppe),fnrklassengruppenbeginn+2);standardmaskenfeld(
+text(wert(fnrlvklgrp4),laengeklagruppe),fnrklassengruppenbeginn+3);
+standardmaskenfeld(text(wert(fnrlvraumgrp1),laengeraum),fnrraumwunsch);
+standardmaskenfeld(text(wert(fnrlvraumgrp2),laengeraum),fnrraumwunsch+1).
+wunschraumvorschlag:datraumwunsch:=sequentialfile(modify,wunschraumdatei);
+toline(datraumwunsch,ilv);readrecord(datraumwunsch,raumzeile);raumbelegliste
+:=datenderzeit(i,kennungraum);posraum:=1;WHILE posraum<=length(raumzeile)REP 
+raum:=subtext(raumzeile,posraum,posraum+laengeraum-1);IF suchpos(
+raumbelegliste,raum,laengeraum)=0THEN LEAVE wunschraumvorschlagWITH raumFI ;
+posraum:=posraum+laengeraumPER ;kennzkeinfreierwunschraum.END PROC lvzeigen;
+PROC stupidspeichernderraeumeundzeitenderlv(BOOL CONST speichern):BOOL VAR 
+plausifehler,ok;IF speichernTHEN plausifehler:=FALSE ;
+plausipruefungfuerraeumezulv;IF plausifehlerTHEN return(1)ELSE 
+raeumezulvspeichern;standardmeldung(meldnrdatenwurdengespeichert,"");
+stundenplansichern(fstatusstuplan);naechstelvzurbearbeitungFI ELSE 
+standardmeldung(meldnrdatenwurdennichtgespeichert,"");
+naechstelvzurbearbeitungFI .plausipruefungfuerraeumezulv:INT VAR 
+anzahlankreuzungen:=0;ifnr:=fnrersterraumbs2;FOR iFROM erstestdUPTO letztestd
+REP IF (kopplungszeitenSUB i)=stundeverplantTHEN raum:=compress(
+standardmaskenfeld(ifnr));IF raum<>""THEN anzahlankreuzungen:=
+anzahlankreuzungen+1;IF raum<>kennzkeinfreierwunschraumTHEN IF NOT 
+bezeichnungzulaessig(kennungraum,raum)THEN standardmeldung(
+meldnrungueltigerraum,"");infeld(ifnr);plausifehler:=TRUE ELIF 
+raumdurchanderelvbelegtTHEN standardmeldung(meldnrraumschonbelegt,"");infeld(
+ifnr);plausifehler:=TRUE FI FI FI FI ;ifnr:=ifnr+felderproeintragbs2UNTIL 
+plausifehlerPER ;IF NOT plausifehlerTHEN IF anzahlankreuzungen>wstdderlvTHEN 
+standardmeldung(meldnrzuvielezuordnungen,"");infeld(fnrersteseingabefeldbs2);
+plausifehler:=TRUE FI FI .raumdurchanderelvbelegt:planeintraglesen(i,
+kennungraum,raum,suchlv,suchraum,suchparaphe);compress(suchraum)<>""AND 
+suchlv<>lv.raeumezulvspeichern:ifnr:=fnrersterraumbs2;FOR iFROM erstestdUPTO 
+letztestdREP IF (kopplungszeitenSUB i)=stundeverplantTHEN raum:=compress(
+standardmaskenfeld(ifnr));IF raum=""THEN planeintragloeschen(i,lv,ok);ELSE 
+IF raum=kennzkeinfreierwunschraumTHEN raum:=raumplatzhalterFI ;
+planeintragvornehmen(i,lv,raum,ok);FI FI ;ifnr:=ifnr+felderproeintragbs2PER .
+naechstelvzurbearbeitung:succ(ixlvsjhjkopp);IF dbstatus=0THEN IF 
+weiterelvzukopplungvorhandenTHEN ilv:=ilv+1;lvzeigen;return(1)ELSE 
+standardstartproc(maskebearb1);kopplungzeigen;return(2)FI ELSE enter(3)FI .
+weiterelvzukopplungvorhanden:wert(fnrlvkopplung)=kopplungAND wert(fnrlvhj)=
+gewhalbjAND wert(fnrlvsj)=gewschulj.END PROC 
+stupidspeichernderraeumeundzeitenderlv;PROC stupidkopierenderraumangabe:INT 
+VAR feldnr:=infeld;ifnr:=feldnr;WHILE ifnr<fnrletztesfeldbs2REP ifnrINCR 
+felderproeintragbs2;IF standardmaskenfeld(ifnr)<>raumplatzhalterTHEN 
+standardmaskenfeld(standardmaskenfeld(feldnr),ifnr)FI PER ;return(1)END PROC 
+stupidkopierenderraumangabe;PROC stupidnichtaendernweitermitkopplung:putwert(
+fnrlvkopplung,kopplung+blankzeichen);search(ixlvsjhjkopp,FALSE );IF 
+keinegueltigekopplungTHEN enter(3)ELSE standardstartproc(maskebearb1);
+kopplungzeigen;return(2)FI END PROC stupidnichtaendernweitermitkopplung;PROC 
+stupidnichtaendernweitermitnaechsterkopplung:putwert(fnrlvkopplung,kopplung+
+blankzeichen);search(ixlvsjhjkopp,FALSE );IF keinegueltigekopplungTHEN enter(
+2)ELSE kopplungzeigen;return(1)FI END PROC 
+stupidnichtaendernweitermitnaechsterkopplung;PROC stupidlistedrucken(BOOL 
+CONST drucken):IF druckenTHEN print(zeigdatei)FI ;forget(zeigdatei,quiet);
+return(2)END PROC stupidlistedrucken;INT PROC suchpos(TEXT CONST quelle,
+suchtext,INT CONST laenge):INT VAR findpos:=pos(quelle,suchtext);WHILE 
+findpos>0REP IF findposMOD laenge=1THEN LEAVE suchposWITH findposELSE findpos
+:=pos(quelle,suchtext,findpos+1);FI PER ;findposEND PROC suchpos;TEXT PROC 
+jgstzweistellig(INT CONST intjgst):IF intjgst=0THEN "00"ELIF intjgst>4AND 
+intjgst<10THEN "0"+text(intjgst)ELSE text(intjgst)FI END PROC jgstzweistellig
+;PROC wertedeseingangsbildschirmsmerken:wertfeld2:=standardmaskenfeld(
+fnrkopplungbs0);wertfeld3:=standardmaskenfeld(fnrakthalbjahr);wertfeld4:=
+standardmaskenfeld(fnrmitzeitwuenschen)END PROC 
+wertedeseingangsbildschirmsmerken;PROC wertedeseingangsbildschirmsholen:
+standardmaskenfeld(wertfeld2,fnrkopplungbs0);standardmaskenfeld(wertfeld3,
+fnrakthalbjahr);standardmaskenfeld(wertfeld4,fnrmitzeitwuenschen)END PROC 
+wertedeseingangsbildschirmsholen;END PACKET 
+stundenplanimdialogerstellenundaendern
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen b/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen
new file mode 100644
index 0000000..376fbac
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan nach lv erfassen
@@ -0,0 +1,133 @@
+PACKET stundenplannachlverfassenDEFINES stundenplannachlvspeichern,
+stundenplannachlvreorganisiertverlassen,stundenplannachlvkopieren,
+stundenplannachlvzeigen:LET stdplmaske="ms stdplan nach lv bearb",
+feldeingjgst=2,feldeingfach=3,feldeingkenn=4,feldeingakthj=5,laengelv=8,
+lvmitleeremraum="x",leererraum="    ",leererlehrer="    ",schuljahr=
+"Schuljahr",halbjahr="Schulhalbjahr",kennungwstd="W",kennungraum="R",
+kennungparaphe="P",kennunglv="L",kennungzulzeit="ZZ",ausgabeparam="#",
+maxstunden=66,meldungplausi=57,meldungfeldfuellen=52,meldungfalschejgst=305,
+meldungzuvielewstd=369,meldungjgstergaenzen=304,meldungfalschesfach=310,
+meldungkeinestartlv=68,meldungspeichern=50,meldungwarten=69,
+meldungdatenaufbereitet=357,meldungkeinesugruppen=334,meldungzuvielesugruppen
+=356,meldunglehrerbesetzt=361,meldungraumbesetzt=370,meldungsugrupbesetzt=362
+,meldungzeitgesperrt=363,meldungkeinelv=326,meldungaenderungsfehler=364,
+meldunguvfehler=403,meldungserverfehler=376,meldungbasisinkon=378,
+meldunganderewahl=318,meldungfalscherraum=359,meldungzuvielelv=358;ROW 
+maxstundenTEXT VAR lvausstdpl;ROW maxstundenTEXT VAR lvvombs;TEXT VAR schhj,
+schj,aktfachkenn,aktlv,eintraglv,lveintrag,raumeintrag,pareintrag,hjsjanhang
+:="";INT VAR i,fstat,hjkennalt:=-1,aktjgst,uvokfeld:=2,wstdderlv,hjkennneu:=0
+;BOOL VAR spok:=TRUE ,uvok:=TRUE ,aenderungsfehler:=FALSE ;PROC 
+stundenplannachlvkopieren:INT VAR aktfeld:=infeld;TEXT VAR feldinhalt:="";IF 
+aktfeld=67THEN fehlermeldunganwunzulELSE kopierenFI ;return(1).kopieren:
+feldinhalt:=standardmaskenfeld(aktfeld);standardmaskenfeld(feldinhalt,aktfeld
++1);standardfelderausgeben;infeld(aktfeld).fehlermeldunganwunzul:
+standardmeldung(meldunganderewahl,"").END PROC stundenplannachlvkopieren;
+PROC stundenplannachlvreorganisiertverlassen:
+stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(1);
+meldungausgeben(fstat)ELSE enter(2)FI END PROC 
+stundenplannachlvreorganisiertverlassen;PROC stundenplannachlvzeigen:INT VAR 
+jgst:=0;TEXT VAR jg:="",fach:="",kennung:="";standardmeldung(meldungwarten,
+" ");jg:=standardmaskenfeld(feldeingjgst);fach:=standardmaskenfeld(
+feldeingfach);kennung:=standardmaskenfeld(feldeingkenn);pruefeeingabe;
+maskeundinitialisierung;holstartlv;stundenplannachlvausgeben.pruefeeingabe:
+IF jg<>""THEN jgst:=int(jg);IF lastconversionokTHEN pruefjgstELSE 
+fehlermeldungfalschejgstFI ;FI ;prueffach;pruefkennung.pruefjgst:IF jgst<>0
+THEN IF jgst<5COR jgst>13THEN fehlermeldungfalschejgstFI FI .
+fehlermeldungfalschejgst:standardmeldung(meldungfalschejgst,"");infeld(
+feldeingjgst);return(1);LEAVE stundenplannachlvzeigen.prueffach:IF fach<>""
+THEN IF jg=""THEN standardmeldung(meldungjgstergaenzen,"");infeld(
+feldeingjgst);return(1);LEAVE stundenplannachlvzeigenELSE fach:=compress(fach
+);inittupel(dnrfaecher);putwert(fnrffach,fach);search(dnrfaecher,TRUE );IF 
+dbstatus<>okTHEN fehlermeldungfalschesfachFI FI FI .fehlermeldungfalschesfach
+:standardmeldung(meldungfalschesfach,"");infeld(feldeingfach);return(1);
+LEAVE stundenplannachlvzeigen.pruefkennung:IF kennung<>""THEN IF jg=""THEN 
+standardmeldung(meldungfeldfuellen,"");infeld(feldeingjgst);return(1);LEAVE 
+stundenplannachlvzeigenFI ;IF fach=""THEN standardmeldung(meldungfeldfuellen,
+"");infeld(feldeingfach);return(1);LEAVE stundenplannachlvzeigenFI ;FI .
+maskeundinitialisierung:aktlv:="";aktjgst:=0;aktfachkenn:="";IF akthj<>""
+THEN hjkennneu:=0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN hjkennalt:=
+hjkennneu;schj:=schulkenndatum(schuljahr);schhj:=schulkenndatum(halbjahr);IF 
+hjkennneu=1THEN geplanteshjundsjberechnen(schhj,schj)FI ;
+stundenplanhalbjahrsetzen(schhj,schj);hjsjanhang:=schhj+". "+text(schj,2)+"/"
++subtext(schj,3);holestdplanFI .akthj:standardmaskenfeld(feldeingakthj).
+holestdplan:standardmeldung(meldungdatenaufbereitet,"");
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(1);
+meldungausgeben(fstat);LEAVE stundenplannachlvzeigenELSE 
+stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN 
+return(1);meldungausgeben(fstat);LEAVE stundenplannachlvzeigenFI FI ELIF 
+fstat=8THEN meldungausgeben(fstat)FI .holstartlv:fach:=text(fach+" ",2);
+inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj
+);putintwert(fnrlvjgst,jgst);putwert(fnrlvfachkennung,fach+kennung);search(
+dnrlehrveranstaltungen,FALSE );IF dbstatus>2THEN fehlermeldungkeinestartlv
+ELSE aktjgst:=intwert(fnrlvjgst);aktfachkenn:=wert(fnrlvfachkennung);aktlv:=
+text(jgstaufbereiten(aktjgst)+aktfachkenn,laengelv)FI .
+fehlermeldungkeinestartlv:standardmeldung(meldungkeinestartlv,"");infeld(
+feldeingjgst);return(1);LEAVE stundenplannachlvzeigen.END PROC 
+stundenplannachlvzeigen;PROC stundenplannachlvausgeben:standardstartproc(
+stdplmaske);fuellemaske;IF NOT uvokTHEN infeld(uvokfeld);standardmeldung(
+meldunguvfehler," ")FI ;standardnproc.END PROC stundenplannachlvausgeben;
+PROC fuellemaske:standardkopfmaskeaktualisieren("Stundenplan "+hjsjanhang+
+" für Lehrveranstaltung "+aktlv+"");uvok:=TRUE ;raumeintrag:="";lveintrag:=
+"";pareintrag:="";wstdderlv:=int(datenzurlv(kennungwstd,aktlv));FOR iFROM 1
+UPTO maxstundenREP planeintraglesen(i,kennunglv,aktlv,lveintrag,raumeintrag,
+pareintrag);IF raumeintrag<>""THEN IF raumeintrag=leererraumTHEN raumeintrag
+:=lvmitleeremraumELSE raumeintrag:=compress(raumeintrag)FI ;lvausstdpl(i):=
+raumeintrag;standardmaskenfeld(raumeintrag,i+1);IF pareintrag=leererlehrer
+THEN IF uvokTHEN uvok:=FALSE ;uvokfeld:=i+1;eintraglv:=lveintragFI FI ELSE 
+lvausstdpl(i):="";standardmaskenfeld("",i+1);FI PER ;infeld(1);
+standardfelderausgeben;infeld(2).END PROC fuellemaske;PROC meldungausgeben(
+INT VAR fstat):IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF 
+fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN 
+standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung(
+meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF 
+fstat=9THEN standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgeben
+FI END PROC meldungausgeben;PROC stundenplannachlvspeichern(BOOL CONST 
+speichern):TEXT VAR raumeintrag,t:="",lv:="";INT VAR bisherigejgst:=0,anzwstd
+;IF speichernTHEN aenderungenvornehmen;FI ;naechstersatz;return(1).
+naechstersatz:succ(dnrlehrveranstaltungen);IF dbstatus>2COR wert(fnrlvsj)<>
+schjCOR wert(fnrlvhj)<>schhjTHEN stundenplannachlvreorganisiertverlassen;
+LEAVE stundenplannachlvspeichernELIF intwert(fnrlvjgst)<>bisherigejgstTHEN 
+stundenplanreorganisierenundsichern(fstat);bisherigejgst:=intwert(fnrlvjgst)
+FI ;aktjgst:=intwert(fnrlvjgst);aktfachkenn:=wert(fnrlvfachkennung);aktlv:=
+text(jgstaufbereiten(aktjgst)+aktfachkenn,laengelv);fuellemaske;IF NOT uvok
+THEN infeld(uvokfeld);standardmeldung(meldunguvfehler,eintraglv+ausgabeparam)
+FI .aenderungenvornehmen:standardmeldung(meldungplausi," ");plausipruefung;
+standardmeldung(meldungspeichern," ");aenderungsfehler:=FALSE ;speicherung;
+IF aenderungsfehlerTHEN standardmeldung(meldungaenderungsfehler,"");return(1)
+;LEAVE stundenplannachlvspeichernELSE stundenplansichern(fstat)FI ;IF fstat<>
+0THEN meldungausgeben(fstat);return(1);LEAVE stundenplannachlvspeichernFI .
+plausipruefung:anzwstd:=0;FOR iFROM 1UPTO maxstundenREP infeld(i+1);
+raumeintrag:=standardmaskenfeld(i+1);IF raumeintrag<>""THEN pruefezeit;IF 
+raumeintrag<>lvmitleeremraumTHEN prueferaum;lvvombs(i):=raumeintragELSE 
+lvvombs(i):=leererraumFI ;schnittraeume;schnittlehrer;schnittsugruppen;
+wstdzahlok;anzwstdINCR 1;ELSE lvvombs(i):=""FI ;PER .pruefezeit:IF NOT 
+bezeichnungzulaessig(kennungzulzeit,text(i))THEN standardmeldung(
+meldungzeitgesperrt,tagstunde(i,TRUE )+" Std."+ausgabeparam);return(1);LEAVE 
+stundenplannachlvspeichernFI .prueferaum:IF NOT bezeichnungzulaessig(
+kennungraum,raumeintrag)THEN standardmeldung(meldungfalscherraum,"");return(1
+);LEAVE stundenplannachlvspeichernFI .schnittraeume:IF raumunterrichtTHEN 
+standardmeldung(meldungraumbesetzt,"");return(1);LEAVE 
+stundenplannachlvspeichernFI .raumunterricht:lv:=geplantelvfuer(i,kennungraum
+,raumeintrag);lv<>aktlvCAND lv<>"".schnittlehrer:t:=datenzurlv(kennungparaphe
+,aktlv);IF t<>leererlehrerTHEN IF lehrerunterrichtTHEN standardmeldung(
+meldunglehrerbesetzt,t+ausgabeparam);return(1);LEAVE 
+stundenplannachlvspeichernFI FI .lehrerunterricht:lv:=geplantelvfuer(i,
+kennungparaphe,t);lv<>aktlvCAND lv<>"".schnittsugruppen:IF 
+sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,lv+
+ausgabeparam);return(1);LEAVE stundenplannachlvspeichernFI .
+sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(i,kennunglv,aktlv,
+"",lv,t).wstdzahlok:IF anzwstd=wstdderlvTHEN standardmeldung(
+meldungzuvielewstd,"");return(1);LEAVE stundenplannachlvspeichernFI .
+speicherung:FOR iFROM 1UPTO maxstundenREP IF lvausstdpl(i)<>""COR lvvombs(i)
+<>""THEN infeld(i+1);IF loeschenTHEN planeintragentfernenELSE 
+planeintragschreibenFI ;FI ;PER .loeschen:lvausstdpl(i)<>""CAND lvvombs(i)=""
+.planeintragentfernen:planeintragloeschen(i,aktlv,spok);IF NOT spokTHEN 
+aenderungsfehler:=TRUE FI .planeintragschreiben:IF lvausstdpl(i)<>""THEN 
+planeintragloeschen(i,aktlv,spok);IF spokTHEN planeintragvornehmen(i,aktlv,
+lvvombs(i),spok);FI ;ELSE planeintragvornehmen(i,aktlv,lvvombs(i),spok);FI ;
+IF NOT spokTHEN aenderungsfehler:=TRUE FI .END PROC 
+stundenplannachlvspeichern;TEXT PROC jgstaufbereiten(INT CONST jgst):TEXT 
+VAR lv:="0";lvCAT text(jgst);subtext(lv,length(lv)-1)END PROC jgstaufbereiten
+;END PACKET stundenplannachlverfassen;
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen b/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen
new file mode 100644
index 0000000..51a812d
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan nach zeiten erfassen
@@ -0,0 +1,157 @@
+PACKET stundenplannachzeitenerfassenDEFINES stundenplannachzeitenspeichern,
+stundenplannachzeitenzurueckzummenue,stdnraustagstd,
+stundenplannachzeitenzeigen:LET stdplmaske="ms stdplan nach zeit bearb",
+feldeingtag=2,feldeingstd=3,feldeingakt=4,laengelv=8,laengeraum=4,trenner="�"
+,schuljahr="Schuljahr",halbjahr="Schulhalbjahr",kennungraum="R",
+kennungparaphe="P",kennunglv="L",kennungzulzeit="ZZ",leerelv="        ",
+leererraum="    ",leererlehrer="    ",ausgabeparam="#",maxeintraege=60,
+erstestunde=1,letztestunde=66,stdprotag=12,meldungzeitgesperrt=363,
+meldungnichtspeichern=63,meldungraumangloeschen=396,meldungraumbesetzt=370,
+meldungplausi=57,meldungnur60lv=394,meldungspeichern=50,meldungwarten=69,
+meldungdatenaufbereitet=357,meldungfalschertag=385,meldungfalschestd=54,
+meldungfalscherraum=359,meldungkeinesugruppen=334,meldungzuvielesugruppen=356
+,meldungnichtlv=360,meldunglehrerbesetzt=361,meldungsugrupbesetzt=362,
+meldungkeinelv=326,meldungaenderungsfehler=364,meldunguvfehler=403,#
+meldungstdplanveraltet=377,#meldungserverfehler=376,meldungbasisinkon=378,
+meldungzuvielelv=358;ROW maxeintraegeTEXT VAR eintragausstdpl;TEXT VAR 
+maskeneintragtag:="",maskeneintragstd:="",gewhj,gewsj,allelv,alleraeume,
+alleparaphen,uvoklv,lveintrag,raumeintrag,hjsjanhang:="",altereintrag:="";
+TEXT VAR alletage:="��01�02�03�04�05�06�1�2�3�4�5�6�MO�DI�MI�DO�FR�SA�"+
+"�mo�di�mi�do�fr�sa�Mo�Di�Mi�Do�Fr�Sa�"+
+"� 1� 2� 3� 4� 5� 6�1 �2 �3 �4 �5 �6 �",allestden:=
+"��01�02�03�04�05�06�07�08�09�10�11�12�13� 1� 2� 3�"+
+"� 4� 5� 6� 7� 8� 9�1 �2 �3 �4 �5 �6 �7 �8 �9 �"+"1�2�3�4�5�6�7�8�9�";INT 
+VAR i,fstat,abstd:=0,uvokfeld,hjkennalt:=-1,hjkennneu:=0,letztebearbstd:=66;
+BOOL VAR spok:=TRUE ,uvok:=TRUE ,anzlvok:=TRUE ,stdplzeilegeloescht:=FALSE ,
+aenderungsfehler:=FALSE ;INT PROC stdnraustagstd(TEXT CONST tag,std):INT VAR 
+itag:=int(tag),istd;IF lastconversionokTHEN IF itag=0COR itag=1THEN itag:=1
+FI ELSE IF tag="MO"COR tag="mo"COR tag="Mo"COR tag=""THEN itag:=1ELIF tag=
+"DI"COR tag="di"COR tag="Di"THEN itag:=2ELIF tag="MI"COR tag="mi"COR tag="Mi"
+THEN itag:=3ELIF tag="DO"COR tag="do"COR tag="Do"THEN itag:=4ELIF tag="FR"
+COR tag="fr"COR tag="Fr"THEN itag:=5ELSE itag:=6FI FI ;IF std=""THEN istd:=1
+ELSE istd:=int(std)FI ;(itag-1)*stdprotag+istdEND PROC stdnraustagstd;PROC 
+stundenplannachzeitenreorganisiertverlassen:
+stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(1);
+meldungausgeben(fstat)ELSE enter(2)FI END PROC 
+stundenplannachzeitenreorganisiertverlassen;PROC stundenplannachzeitenzeigen:
+standardmeldung(meldungwarten," ");maskeneintragtag:=standardmaskenfeld(
+feldeingtag);maskeneintragstd:=standardmaskenfeld(feldeingstd);abstd:=
+stdnraustagstd(maskeneintragtag,maskeneintragstd);prueftag;pruefstd;IF akthj
+<>""THEN hjkennneu:=0ELSE hjkennneu:=1FI ;IF hjkennneu<>hjkennaltTHEN 
+hjkennalt:=hjkennneu;gewsj:=schulkenndatum(schuljahr);gewhj:=schulkenndatum(
+halbjahr);IF hjkennneu=1THEN geplanteshjundsjberechnen(gewhj,gewsj)FI ;
+stundenplanhalbjahrsetzen(gewhj,gewsj);ermittleletztestunde;hjsjanhang:=" "+
+gewhj+". "+text(gewsj,2)+"/"+subtext(gewsj,3)+", Raum ";holestdplanFI ;
+pruefzeitzulaessig;stundenplannachzeitenausgeben.akthj:standardmaskenfeld(
+feldeingakt).holestdplan:standardmeldung(meldungdatenaufbereitet,"");
+stundenplanbasisundstundenplanholen(fstat);IF fstat<>0CAND fstat<>8THEN 
+stundenplanbasisundstundenplanerstellen(fstat);IF fstat<>0THEN return(1);
+meldungausgeben(fstat);LEAVE stundenplannachzeitenzeigenELSE 
+stundenplanbasissichern(fstat);stundenplansichern(fstat);IF fstat<>0THEN 
+return(1);meldungausgeben(fstat);LEAVE stundenplannachzeitenzeigenFI FI ELIF 
+fstat=8THEN meldungausgeben(fstat)FI .prueftag:IF pos(alletage,trenner+
+maskeneintragtag+trenner)=0THEN return(1);infeld(feldeingtag);standardmeldung
+(meldungfalschertag,"");LEAVE stundenplannachzeitenzeigenFI .pruefstd:IF pos(
+allestden,trenner+maskeneintragstd+trenner)=0THEN return(1);infeld(
+feldeingstd);standardmeldung(meldungfalschestd,"");LEAVE 
+stundenplannachzeitenzeigenELIF abstdDIV stdprotag=6THEN IF abstd-60>6THEN 
+return(1);infeld(feldeingstd);standardmeldung(meldungfalschestd,"");LEAVE 
+stundenplannachzeitenzeigenFI ;FI .pruefzeitzulaessig:IF NOT 
+bezeichnungzulaessig(kennungzulzeit,text(abstd))THEN return(1);infeld(
+feldeingtag);standardmeldung(meldungzeitgesperrt,tagstunde(abstd,FALSE )+"."+
+ausgabeparam);LEAVE stundenplannachzeitenzeigenFI .ermittleletztestunde:FOR i
+FROM letztestundeDOWNTO erstestundeREP IF bezeichnungzulaessig(kennungzulzeit
+,text(i))THEN letztebearbstd:=i;LEAVE ermittleletztestundeFI PER .END PROC 
+stundenplannachzeitenzeigen;PROC stundenplannachzeitenausgeben:
+standardstartproc(stdplmaske);fuellemaske;IF NOT anzlvokTHEN standardmeldung(
+meldungnur60lv,tagstunde(abstd,TRUE )+ausgabeparam)ELIF NOT uvokTHEN infeld(
+uvokfeld);standardmeldung(meldunguvfehler," ");FI ;standardnproc.END PROC 
+stundenplannachzeitenausgeben;PROC fuellemaske:TEXT VAR lvimstdplan,
+raumimstdplan,parimstdplan;INT VAR poslv,posraum,index;stdplzeilegeloescht:=
+FALSE ;allelv:=datenderzeit(abstd,kennunglv);alleraeume:=datenderzeit(abstd,
+kennungraum);alleparaphen:=datenderzeit(abstd,kennungparaphe);
+standardkopfmaskeaktualisieren("Stundenplan für "+tagstunde(abstd,FALSE )+
+". Stunde");uvok:=TRUE ;anzlvok:=TRUE ;uvokfeld:=2;poslv:=1;posraum:=1;IF 
+length(allelv)>maxeintraege*laengelvTHEN allelv:=text(allelv,maxeintraege*
+laengelv);alleraeume:=text(alleraeume,maxeintraege*laengeraum);anzlvok:=
+FALSE FI ;FOR iFROM 1UPTO maxeintraegeREP index:=i*2;IF poslv<length(allelv)
+THEN lvimstdplan:=subtext(allelv,poslv,poslv+7);raumimstdplan:=subtext(
+alleraeume,posraum,posraum+3);parimstdplan:=subtext(alleparaphen,posraum,
+posraum+3);standardmaskenfeld(compress(lvimstdplan),index);standardmaskenfeld
+(compress(raumimstdplan),index+1);eintragausstdpl(i):=lvimstdplan+
+raumimstdplan;IF parimstdplan=leererlehrerCAND uvokTHEN uvokfeld:=index;uvok
+:=FALSE FI ;poslvINCR 8;posraumINCR 4;ELSE standardmaskenfeld("",index);
+standardmaskenfeld("",index+1);eintragausstdpl(i):=""FI ;PER ;infeld(1);
+standardfelderausgeben;infeld(2).END PROC fuellemaske;PROC meldungausgeben(
+INT VAR fstat):IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF 
+fstat=4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN 
+standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung(
+meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF 
+fstat=9THEN standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgeben
+FI END PROC meldungausgeben;PROC stundenplannachzeitenspeichern(BOOL CONST 
+speichern):TEXT VAR par:="",lv:="",t1:="",t2:="";INT VAR pos:=1;IF abstd=
+letztebearbstdTHEN IF speichernCAND anzlvokTHEN aenderungenvornehmen;ELIF 
+stdplzeilegeloeschtTHEN alteeintraegeschreibenFI ;
+stundenplannachzeitenreorganisiertverlassenELSE IF speichernCAND anzlvokTHEN 
+aenderungenvornehmen;ELIF stdplzeilegeloeschtTHEN alteeintraegeschreibenFI ;
+IF abstdMOD 12=0THEN stundenplanreorganisierenundsichern(fstat)FI ;
+naechstestd;meldungenbeifehler;return(1)FI .alteeintraegeschreiben:
+standardmeldung(meldungnichtspeichern,"");loescheinhaltaktstundenplanzeile;
+FOR iFROM 1UPTO maxeintraegeREP IF eintragausstdpl(i)<>""THEN 
+planeintragvornehmen(abstd,text(eintragausstdpl(i),laengelv),subtext(
+eintragausstdpl(i),laengelv+1),spok)ELSE LEAVE alteeintraegeschreibenFI PER .
+loescheinhaltaktstundenplanzeile:stdplzeilegeloescht:=TRUE ;t1:=datenderzeit(
+abstd,kennunglv);pos:=1;WHILE pos<length(t1)REP planeintragloeschen(abstd,
+subtext(t1,pos,pos+laengelv-1),spok);posINCR laengelvPER .naechstestd:FOR i
+FROM abstd+1UPTO letztebearbstdREP IF bezeichnungzulaessig(kennungzulzeit,
+text(i))THEN abstd:=i;fuellemaske;LEAVE naechstestdELSE abstd:=letztebearbstd
+FI ;PER .meldungenbeifehler:IF NOT anzlvokTHEN standardmeldung(meldungnur60lv
+,tagstunde(abstd,TRUE )+ausgabeparam)ELIF NOT uvokTHEN infeld(uvokfeld);
+standardmeldung(meldunguvfehler," ")FI .aenderungenvornehmen:standardmeldung(
+meldungplausi," ");aenderungsfehler:=FALSE ;plausipruefungundspeicherung;IF 
+aenderungsfehlerTHEN standardmeldung(meldungaenderungsfehler,"");return(1);
+LEAVE stundenplannachzeitenspeichernELSE standardmeldung(meldungspeichern," "
+);IF abstdMOD 12=0THEN stundenplannachzeitenreorganisiertverlassenELSE 
+stundenplansichern(fstat)FI ;IF fstat<>0THEN meldungausgeben(fstat);return(1)
+;LEAVE stundenplannachzeitenspeichernFI ;FI .plausipruefungundspeicherung:
+loescheinhaltaktstundenplanzeile;FOR iFROM 1UPTO maxeintraegeREP infeld(i*2);
+altereintrag:=eintragausstdpl(i);lveintrag:=standardmaskenfeld(i*2);IF (
+lveintragSUB 1)=" "THEN lveintrag:=jgstaufber(text(lveintrag,2))+subtext(
+lveintrag,3)FI ;lveintrag:=text(lveintrag,laengelv);raumeintrag:=text(
+standardmaskenfeld(i*2+1),laengeraum);IF lveintrag+raumeintrag<>leerelv+
+leererraumTHEN infeld(i*2);pruefelvleerundraum;pruefelvgueltig;
+prueferaumgueltig;pruefelehrerfrei;prueferaumfrei;pruefesugruppenfrei;
+planeintragschreibenFI ;PER .pruefelvleerundraum:IF lveintrag=leerelvCAND 
+raumeintrag<>leererraumTHEN standardmeldung(meldungraumangloeschen,"");return
+(1);LEAVE stundenplannachzeitenspeichernFI .pruefelvgueltig:IF NOT 
+bezeichnungzulaessig(kennunglv,lveintrag)THEN standardmeldung(meldungnichtlv,
+lveintrag+ausgabeparam);return(1);LEAVE stundenplannachzeitenspeichernFI .
+prueferaumgueltig:IF raumeintrag<>leererraumTHEN IF NOT bezeichnungzulaessig(
+kennungraum,raumeintrag)THEN standardmeldung(meldungfalscherraum,"");infeld(i
+*2+1);return(1);LEAVE stundenplannachzeitenspeichernFI FI .pruefelehrerfrei:
+par:=datenzurlv(kennungparaphe,lveintrag);IF par<>leererlehrerTHEN IF 
+lehrerunterrichtTHEN standardmeldung(meldunglehrerbesetzt,par+ausgabeparam);
+return(1);LEAVE stundenplannachzeitenspeichernFI FI .lehrerunterricht:lv:=
+geplantelvfuer(abstd,kennungparaphe,par);lv<>lveintragCAND lv<>"".
+prueferaumfrei:IF raumeintrag<>leererraumTHEN IF inraumunterrichtTHEN 
+standardmeldung(meldungraumbesetzt,"");infeld(i*2+1);return(1);LEAVE 
+stundenplannachzeitenspeichernFI FI .inraumunterricht:t1:=geplantelvfuer(
+abstd,kennungraum,raumeintrag);t1<>lveintragCAND t1<>"".pruefesugruppenfrei:
+IF sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,t1+
+ausgabeparam);return(1);LEAVE stundenplannachzeitenspeichernFI .
+sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(abstd,kennunglv,
+lveintrag,text(altereintrag,8),t1,t2).planeintragschreiben:
+planeintragvornehmen(abstd,lveintrag,raumeintrag,spok);IF NOT spokTHEN 
+aenderungsfehler:=TRUE FI .END PROC stundenplannachzeitenspeichern;PROC 
+stundenplannachzeitenzurueckzummenue:INT VAR pos;TEXT VAR t1;standardmeldung(
+meldungnichtspeichern,"");IF stdplzeilegeloeschtTHEN alteeintraegeschreiben
+FI ;stundenplanreorganisierenundsichern(fstat);enter(2).
+alteeintraegeschreiben:loescheinhaltaktstundenplanzeile;FOR iFROM 1UPTO 
+maxeintraegeREP IF eintragausstdpl(i)<>""THEN planeintragvornehmen(abstd,text
+(eintragausstdpl(i),laengelv),subtext(eintragausstdpl(i),laengelv+1),spok)
+ELSE LEAVE alteeintraegeschreibenFI PER .loescheinhaltaktstundenplanzeile:t1
+:=datenderzeit(abstd,kennunglv);pos:=1;WHILE pos<length(t1)REP 
+planeintragloeschen(abstd,subtext(t1,pos,pos+laengelv-1),spok);posINCR 
+laengelvPER .END PROC stundenplannachzeitenzurueckzummenue;END PACKET 
+stundenplannachzeitenerfassen;
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan raumweise erfassen b/app/schulis/2.2.1/src/4.stundenplan raumweise erfassen
new file mode 100644
index 0000000..03f5b9e
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan raumweise erfassen
@@ -0,0 +1,135 @@
+PACKET stundenplanraumweiseerfassenDEFINES stundenplanraumweisespeichern,
+stundenplanraumweisekopieren,stundenplanraumweisereorganisiertverlassen,
+stundenplanraumweisezeigen:LET stdplmaske="ms stdplan raumweise bearb",
+feldeingraum=2,feldeingakt=3,laengelv=8,laengeraum=4,laengejgst=2,trenner="�"
+,raumkenndaten="c02 raeume",schuljahr="Schuljahr",halbjahr="Schulhalbjahr",
+kennungraum="R",kennungparaphe="P",kennunglv="L",kennungzulzeit="ZZ",
+ungueltigepar="$$$$",leererlehrer="    ",alleklst=
+"�00�05�06�07�08�09�10�11�12�13�",ausgabeparam="#",maxstunden=66,
+meldungplausi=57,meldungspeichern=50,meldungwarten=69,meldungdatenaufbereitet
+=357,meldungfalscherraum=359,meldungkeinesugruppen=334,
+meldungzuvielesugruppen=356,meldungnichtlv=360,meldunglehrerbesetzt=361,
+meldungsugrupbesetzt=362,meldungzeitgesperrt=363,meldungkeinelv=326,
+meldungaenderungsfehler=364,meldungkeineraeume=365,meldunguvfehler=403,
+meldungstdplanveraltet=377,meldungserverfehler=376,meldungbasisinkon=378,
+meldungunzulaessig=318,meldungzuvielelv=358;ROW maxstundenTEXT VAR lvausstdpl
+;ROW maxstundenTEXT VAR lvvombs;TEXT VAR maskeneintragraum:="",gewhj,gewsj,
+plausiraeume:=trenner+trenner,raumleiste:="",restraumleiste:="",
+stdpleintraglv:="",stdpleintragjgst:="",stdpleintraglvident:="",
+stdpleintraglvraum:="",stdpleintraglvpar:="",eintraglv,hjsjanhang:="";INT 
+VAR i,fstat,aktbspos,anzraeume:=0,hjkennalt:=-1,uvokfeld,hjkennneu:=0;BOOL 
+VAR spok:=TRUE ,uvok:=TRUE ,aenderungsfehler:=FALSE ;PROC 
+stundenplanraumweisekopieren:INT VAR aktfeld:=infeld;TEXT VAR feldinhalt:="";
+IF aktfeld=67THEN fehlermeldunganwunzulELIF aktfeld=66THEN kopieren;infeld(
+aktfeld)ELSE kopieren;infeld(aktfeld+2)FI ;return(1).kopieren:feldinhalt:=
+standardmaskenfeld(aktfeld);standardmaskenfeld(feldinhalt,aktfeld+1);
+standardfelderausgeben.fehlermeldunganwunzul:standardmeldung(
+meldungunzulaessig,"").END PROC stundenplanraumweisekopieren;PROC 
+stundenplanraumweisereorganisiertverlassen:
+stundenplanreorganisierenundsichern(fstat);IF fstat<>0THEN return(1);
+meldungausgeben(fstat)ELSE enter(2)FI END PROC 
+stundenplanraumweisereorganisiertverlassen;PROC stundenplanraumweisezeigen:
+maskeundinitialisierung;IF maskeneintragraum<>""THEN IF raumfalsch(
+maskeneintragraum)THEN standardmeldung(meldungfalscherraum,"");return(1)ELSE 
+restraumleiste:=text(raumleiste,pos(raumleiste,maskeneintragraum)+laengeraum-
+1);anzraeume:=length(restraumleiste)DIV laengeraum;
+stundenplanraumweiseausgeben(letzterraum);FI ;ELSE restraumleiste:=raumleiste
+;anzraeume:=length(restraumleiste)DIV laengeraum;IF anzraeume>=1THEN 
+stundenplanraumweiseausgeben(letzterraum)ELSE standardmeldung(
+meldungkeineraeume,"");return(1)FI ;FI .letzterraum:subtext(restraumleiste,(
+anzraeume-1)*laengeraum+1).maskeundinitialisierung:standardmeldung(
+meldungwarten," ");IF akthj<>""THEN hjkennneu:=0ELSE hjkennneu:=1FI ;
+merkeraum;IF hjkennneu<>hjkennaltTHEN hjkennalt:=hjkennneu;gewsj:=
+schulkenndatum(schuljahr);gewhj:=schulkenndatum(halbjahr);IF hjkennneu=1THEN 
+geplanteshjundsjberechnen(gewhj,gewsj)FI ;stundenplanhalbjahrsetzen(gewhj,
+gewsj);hjsjanhang:=" "+gewhj+". "+text(gewsj,2)+"/"+subtext(gewsj,3)+
+", Raum ";holestdplanFI ;IF plausiraeume=trenner+trennerTHEN holeplausiraeume
+FI .akthj:standardmaskenfeld(feldeingakt).merkeraum:maskeneintragraum:=
+standardmaskenfeld(feldeingraum).holestdplan:standardmeldung(
+meldungdatenaufbereitet,"");stundenplanbasisundstundenplanholen(fstat);IF 
+fstat<>0CAND fstat<>8THEN stundenplanbasisundstundenplanerstellen(fstat);IF 
+fstat<>0THEN return(1);meldungausgeben(fstat);LEAVE 
+stundenplanraumweisezeigenELSE stundenplanbasissichern(fstat);
+stundenplansichern(fstat);IF fstat<>0THEN return(1);meldungausgeben(fstat);
+LEAVE stundenplanraumweisezeigenFI FI ELIF fstat=8THEN meldungausgeben(fstat)
+FI .holeplausiraeume:inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+raumkenndaten,"",dnrschluessel+1,dnrschluessel+2,PROC raeumeholen).END PROC 
+stundenplanraumweisezeigen;PROC stundenplanraumweiseausgeben(TEXT CONST raum)
+:standardstartproc(stdplmaske);fuellemaske(raum);IF NOT uvokTHEN infeld(
+uvokfeld);standardmeldung(meldunguvfehler," ")FI ;standardnproc.END PROC 
+stundenplanraumweiseausgeben;PROC fuellemaske(TEXT CONST raum):TEXT VAR 
+paraphelvnulleintrag:="";standardkopfmaskeaktualisieren("Stundenplan für"+
+hjsjanhang+raum);maskeneintragraum:=compress(raum);uvok:=TRUE ;uvokfeld:=2;
+FOR iFROM 1UPTO maxstundenREP planeintraglesen(i,kennungraum,raum,
+stdpleintraglvident,stdpleintraglvraum,stdpleintraglvpar);IF 
+stdpleintraglvident<>""THEN lvausstdpl(i):=stdpleintraglvident;
+standardmaskenfeld(stdpleintraglvident,i+1);IF stdpleintraglvpar=leererlehrer
+THEN IF uvokTHEN uvok:=FALSE ;uvokfeld:=i+1FI ELSE pruefeparaphestdplanlvnull
+FI ELSE lvausstdpl(i):="";standardmaskenfeld("",i+1);FI PER ;infeld(1);
+standardfelderausgeben;infeld(2).pruefeparaphestdplanlvnull:
+paraphelvnulleintrag:=datenzurlv(kennungparaphe,stdpleintraglvident);IF 
+stdpleintraglvpar<>paraphelvnulleintragTHEN planeintragvornehmen(i,
+stdpleintraglvident,paraphelvnulleintrag,spok)FI .END PROC fuellemaske;BOOL 
+PROC raumfalsch(TEXT CONST raum):pos(plausiraeume,trenner+raum+trenner)=0END 
+PROC raumfalsch;PROC raeumeholen(BOOL VAR b):IF wert(dnrschluessel+1)>
+raumkenndatenCOR dbstatus<>0THEN b:=TRUE ELSE plausiraeumeCAT wert(
+dnrschluessel+2);plausiraeumeCAT trenner;raumleiste:=text(wert(dnrschluessel+
+2),laengeraum)+raumleisteFI END PROC raeumeholen;PROC meldungausgeben(INT 
+VAR fstat):IF fstat=2THEN standardmeldung(meldungserverfehler,"");ELIF fstat=
+4THEN standardmeldung(meldungkeinesugruppen,"");ELIF fstat=5THEN 
+standardmeldung(meldungzuvielesugruppen,"")ELIF fstat=6THEN standardmeldung(
+meldungkeinelv,"")ELIF fstat=7THEN standardmeldung(meldungzuvielelv,"")ELIF 
+fstat=8THEN standardmeldung(meldungstdplanveraltet,"");ELIF fstat=9THEN 
+standardmeldung(meldungbasisinkon,"");ELSE LEAVE meldungausgebenFI END PROC 
+meldungausgeben;PROC stundenplanraumweisespeichern(BOOL CONST speichern):
+TEXT VAR t:="",lv:="";INT VAR posrestraumleiste;IF anzraeume=1THEN IF 
+speichernTHEN aenderungenvornehmen;FI ;
+stundenplanraumweisereorganisiertverlassenELSE IF speichernTHEN 
+aenderungenvornehmen;FI ;anzraeumeDECR 1;IF anzraeumeMOD 10=0THEN 
+stundenplanreorganisierenundsichern(fstat)FI ;naechsterraum;return(1)FI .
+naechsterraum:posrestraumleiste:=(anzraeume-1)*laengeraum+1;fuellemaske(
+subtext(restraumleiste,posrestraumleiste,posrestraumleiste+laengeraum-1));IF 
+NOT uvokTHEN infeld(uvokfeld);standardmeldung(meldunguvfehler," ")FI .
+aenderungenvornehmen:standardmeldung(meldungplausi," ");plausipruefung;
+standardmeldung(meldungspeichern," ");aenderungsfehler:=FALSE ;speicherung;
+IF aenderungsfehlerTHEN standardmeldung(meldungaenderungsfehler,"");return(1)
+;LEAVE stundenplanraumweisespeichernELSE IF anzraeumeMOD 20=0THEN 
+stundenplanraumweisereorganisiertverlassenELSE stundenplansichern(fstat)FI ;
+IF fstat<>0THEN meldungausgeben(fstat);return(1);LEAVE 
+stundenplanraumweisespeichernFI ;FI .plausipruefung:FOR iFROM 1UPTO 
+maxstundenREP aktbspos:=i+1;infeld(aktbspos);stdpleintraglv:=text(
+standardmaskenfeld(aktbspos),laengelv);stdpleintragjgst:=text(stdpleintraglv,
+laengejgst);IF keinejgstmitfuehrendernullTHEN IF stdpleintragjgst="0 "COR 
+stdpleintragjgst=" 0"THEN stdpleintraglv:="00"+subtext(stdpleintraglv,
+laengejgst+1)ELSE stdpleintraglv:=jgstaufber(stdpleintragjgst)+subtext(
+stdpleintraglv,laengejgst+1);IF NOT lastconversionokTHEN standardmeldung(
+meldungnichtlv,standardmaskenfeld(aktbspos)+ausgabeparam);return(1);LEAVE 
+stundenplanraumweisespeichernFI ;FI ;FI ;IF compress(stdpleintraglv)<>""THEN 
+lvvombs(i):=stdpleintraglv;pruefezeit;pruefelvundpar;pruefesugruppenfreiELSE 
+lvvombs(i):="";FI ;PER .speicherung:FOR iFROM 1UPTO maxstundenREP IF 
+lvausstdpl(i)<>""COR lvvombs(i)<>""THEN aktbspos:=i+1;infeld(aktbspos);IF 
+loeschenTHEN planeintragentfernenELSE planeintragschreibenFI ;FI ;PER .
+keinejgstmitfuehrendernull:keinejgstCAND keinleerereintrag.keinejgst:pos(
+alleklst,trenner+stdpleintragjgst+trenner)=0.keinleerereintrag:compress(
+stdpleintraglv)<>"".pruefelvundpar:t:=datenzurlv(kennungparaphe,
+stdpleintraglv);IF t=ungueltigeparTHEN standardmeldung(meldungnichtlv,
+standardmaskenfeld(aktbspos)+ausgabeparam);return(1);LEAVE 
+stundenplanraumweisespeichernELIF t<>leererlehrerTHEN IF lehrerunterricht
+THEN standardmeldung(meldunglehrerbesetzt,t+ausgabeparam);return(1);LEAVE 
+stundenplanraumweisespeichernFI FI .lehrerunterricht:lv:=geplantelvfuer(i,
+kennungparaphe,t);lv<>stdpleintraglvCAND lv<>"".pruefesugruppenfrei:IF 
+sugruppenichtunterrichtsfreiTHEN standardmeldung(meldungsugrupbesetzt,lv+
+ausgabeparam);return(1);LEAVE stundenplanraumweisespeichernFI .
+sugruppenichtunterrichtsfrei:schuelergruppenschnittbeizeit(i,kennunglv,
+stdpleintraglv,lvausstdpl(i),lv,t).pruefezeit:t:=text(i);IF NOT 
+bezeichnungzulaessig(kennungzulzeit,t)THEN standardmeldung(
+meldungzeitgesperrt,tagstunde(i,TRUE )+" Std."+ausgabeparam);return(1);LEAVE 
+stundenplanraumweisespeichernFI .loeschen:lvausstdpl(i)<>""CAND lvvombs(i)=""
+.planeintragentfernen:planeintragloeschen(i,lvausstdpl(i),spok);IF NOT spok
+THEN aenderungsfehler:=TRUE FI .planeintragschreiben:IF lvausstdpl(i)<>""
+THEN planeintragloeschen(i,lvausstdpl(i),spok);IF spokTHEN 
+planeintragvornehmen(i,lvvombs(i),maskeneintragraum,spok);FI ;ELSE 
+planeintragvornehmen(i,lvvombs(i),maskeneintragraum,spok);FI ;IF NOT spok
+THEN aenderungsfehler:=TRUE FI .END PROC stundenplanraumweisespeichern;END 
+PACKET stundenplanraumweiseerfassen;
+
diff --git a/app/schulis/2.2.1/src/4.stundenplan schnittstelle b/app/schulis/2.2.1/src/4.stundenplan schnittstelle
new file mode 100644
index 0000000..bc036af
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.stundenplan schnittstelle
@@ -0,0 +1,692 @@
+PACKET stundenplanschnittstelleDEFINES tagstunde,stundenplanhalbjahrsetzen,
+stundenplanbasisundstundenplanerstellen,stundenplanerstellen,
+stundenplanbasisundstundenplanholen,stundenplanbasissichern,
+stundenplansichern,stundenplandatenvorhanden,
+stundenplanbasisundstundenplanloeschen,stundenplanloeschen,
+stundenplanreorganisierenundsichern,bezeichnungzulaessig,datenzurlv,
+beteiligteschuelergruppen,schuelergruppenschnittbeizeit,
+schuelergruppenschnittallezeiten,gemeinsameschuelergruppen,
+lvderschuelergruppe,allelvmit,lvgeplant,geplantelvfuer,allezeitenvon,
+datenderzeit,planeintraglesen,planeintragvornehmen,planeintragloeschen,
+erstellungszeitderdatenraeume:LET maxdatenraumeintraege=4000,
+maxlehrveranstaltungen=2500,erstestunde=1,letztestunde=66,stdprotag=12,
+samstagstd=6,schultage=6,stuplanverwalter="stundenplan server",sgnull=
+"Stundenplan-0 ",sgeins="Stundenplan-1 ",lvnull="Stundenplan-2 ",lveins=
+"Stundenplan-3 ",stuplan="Stundenplan-4 ",aenderungakt="aktuell",
+aenderunggepl="geplant",maxsugruppen=30,laengelv=8,laengekopplung=8,
+laengeparaphe=4,laengeraum=4,laengezeit=2,laengejgst=2,laengefachkennung=6,
+laengesugruppe=6,laengeklagruppe=4,laengewochenstd=2,laengestuplaneintrag=24,
+stuplanposjgst=1,stuplanposkopplung=9,stuplanposparaphe=17,stuplanposraum=21,
+erstellzeittag=1,erstellzeitmonat=4,erstellzeitjahr=7,erstellzeitstdmin=10,
+beginnlvjgst=1,beginnlvbez=1,beginnlvkopplung=9,beginnlvparaphe=17,
+beginnlvwochenstd=21,beginnlvraumgr1=23,beginnlvraumgr2=27;INT CONST 
+endelvbez:=beginnlvbez+laengelv-1,endelvkopplung:=beginnlvkopplung+
+laengekopplung-1,endelvparaphe:=beginnlvparaphe+laengeparaphe-1,
+endelvwochenstd:=beginnlvwochenstd+laengewochenstd-1,endelvraumgr1:=
+beginnlvraumgr1+laengeraum-1,endelvraumgr2:=beginnlvraumgr2+laengeraum-1;LET 
+leistenlaenge=8,bits=16,jgstnull=0,jgstfuenf=5,jgstdreizehn=13,anzklst=9,
+trenner="�",klstjgst="�05�5�06�6�07�7�08�8�09�9�10�11�12�13�",
+zeitrastersperre="x",dbraeume="c02 raeume",dbaenderung=
+"c02 aenderungsvermerk",dbaenderungakt="aktuell",dbaenderunggepl="geplant",
+halbj="Schulhalbjahr",fehlerzeichen="$",blank=" ",punkt=".",null="0",eins="1"
+,leereraumangabe="    ",kennunglv="L",kennungkopplung="K",kennungparaphe="P",
+kennungraum="R",kennungzeit="ZA",kennungzugelassenezeit="ZZ",kennungsugruppe=
+"S",kennungwochenstd="W",kennungwunschraum="RW",kennungersatzraum="RE";LET 
+kennungmo="Mo ",kennungdi="Di ",kennungmi="Mi ",kennungdo="Do ",kennungfr=
+"Fr ",kennungsa="Sa ",kennungmontag="Montag ",kennungdienstag="Dienstag ",
+kennungmittwoch="Mittwoch ",kennungdonnerstag="Donnerstag ",kennungfreitag=
+"Freitag ",kennungsamstag="Samstag ";TYPE BITLEISTE =ROW leistenlaengeINT ;
+BITLEISTE VAR sugrupurleiste,sugrupleiste;BOUND ROW maxlehrveranstaltungen
+BITLEISTE VAR lvbitleisten;BOUND ROW maxdatenraumeintraegeBITLEISTE VAR 
+sgbitleisten;ROW maxsugruppenBITLEISTE VAR sugruppenstack;DATASPACE VAR dslv,
+dssugrup,dsstdpl;FILE VAR lvdatei,sugrupdatei,stuplandatei;TEXT VAR gewschulj
+:="",gewhalbj:="",halbjplausizeit:="",dateieintrag,ergebnis,dserstellungszeit
+,behandeltesugruppen:=trenner,letztedbzeit,lvzeile,sugruppeneinerklgr:="",
+plausiparaphen:=trenner,plausizeiten:="",plausiklgr:=trenner,plausiraeume:=
+trenner;INT VAR i,j,k,zz,anzbitleisten:=0,lowbit,anzsugrup,anzsugrupundklgr,
+anzlv,lvjgstnullanfang,lvjgstnullende,lvsugrupjgstanfang,lvsugrupjgstende,
+letzteposstuplanzeile,letzterzugrifflv0:=1;BOOL VAR klgreintrag;TEXT PROC 
+tagstunde(INT CONST anwstdnr,BOOL CONST mitkurzform):INT VAR stdnr:=
+konvertierezeit(anwstdnr);TEXT VAR std;IF stdnr<erstestundeCOR stdnr>
+letztestundeTHEN ""ELSE std:=text((stdnr-1)MOD stdprotag+1);IF mitkurzform
+THEN SELECT (stdnr-1)DIV stdprotagOF CASE 0:kennungmo+stdCASE 1:kennungdi+std
+CASE 2:kennungmi+stdCASE 3:kennungdo+stdCASE 4:kennungfr+stdCASE 5:kennungsa+
+stdOTHERWISE ""END SELECT ELSE SELECT (stdnr-1)DIV stdprotagOF CASE 0:
+kennungmontag+stdCASE 1:kennungdienstag+stdCASE 2:kennungmittwoch+stdCASE 3:
+kennungdonnerstag+stdCASE 4:kennungfreitag+stdCASE 5:kennungsamstag+std
+OTHERWISE ""END SELECT FI FI END PROC tagstunde;PROC 
+stundenplanhalbjahrsetzen(TEXT CONST anwhalbj,anwschulj):gewschulj:=anwschulj
+;gewhalbj:=anwhalbj;plausizeiten:=""END PROC stundenplanhalbjahrsetzen;PROC 
+stundenplanbasisundstundenplanerstellen(INT VAR fehlerstatus):IF gewschulj=""
+THEN fehlerstatus:=1ELSE hilfsdatenerstellen(fehlerstatus);IF fehlerstatus=0
+THEN schreibeerstellungszeitFI ;FI .END PROC 
+stundenplanbasisundstundenplanerstellen;PROC stundenplanerstellen(TEXT CONST 
+zeit,INT VAR fehlerstatus):commanddialogue(FALSE );IF gewschulj=""THEN 
+fehlerstatus:=1;forget(stuplandatenraum)ELSE forget(stuplandatenraum);#
+dsstdpl:=new(stuplandatenraum);forget(dsstdpl);#commanddialogue(TRUE );
+stuplandatei:=sequentialfile(modify,stuplandatenraum);FOR iFROM erstestunde
+UPTO letztestunde+1REP insertrecord(stuplandatei)PER ;schreibzeitinstdpl;
+fehlerstatus:=0FI .schreibzeitinstdpl:toline(stuplandatei,letztestunde+1);
+writerecord(stuplandatei,zeit).END PROC stundenplanerstellen;PROC 
+stundenplanbasissichern(INT VAR fehlerstatus):TASK VAR server;disablestop;
+server:=task(stuplanverwalter);IF iserrorTHEN clearerror;fehlerstatus:=2;
+ELIF gewschulj=""THEN fehlerstatus:=1;ELIF NOT exists(lvnulldatenraum)COR 
+NOT exists(lveinsdatenraum)COR NOT exists(sgnulldatenraum)COR NOT exists(
+sgeinsdatenraum)THEN fehlerstatus:=3ELSE commanddialogue(FALSE );save(
+lvnulldatenraum,server);save(lveinsdatenraum,server);save(sgnulldatenraum,
+server);save(sgeinsdatenraum,server);commanddialogue(TRUE );fehlerstatus:=0
+FI ;enablestopEND PROC stundenplanbasissichern;PROC stundenplansichern(INT 
+VAR fehlerstatus):TASK VAR server;disablestop;server:=task(stuplanverwalter);
+IF iserrorTHEN clearerror;fehlerstatus:=2;ELIF gewschulj=""THEN fehlerstatus
+:=1ELIF NOT exists(stuplandatenraum)THEN fehlerstatus:=3ELSE commanddialogue(
+FALSE );save(stuplandatenraum,server);commanddialogue(TRUE );fehlerstatus:=0;
+FI ;enablestopEND PROC stundenplansichern;PROC 
+stundenplanbasisundstundenplanholen(INT VAR fehlerstatus):TASK VAR server;
+disablestop;server:=task(stuplanverwalter);IF iserrorTHEN clearerror;
+fehlerstatus:=2;ELIF gewschulj=""THEN fehlerstatus:=1ELIF NOT exists(
+lvnulldatenraum,server)COR NOT exists(lveinsdatenraum,server)COR NOT exists(
+sgnulldatenraum,server)COR NOT exists(sgeinsdatenraum,server)COR NOT exists(
+stuplandatenraum,server)THEN fehlerstatus:=3;ELSE commanddialogue(FALSE );
+fetch(stuplandatenraum,server);fetch(lvnulldatenraum,server);fetch(
+lveinsdatenraum,server);fetch(sgnulldatenraum,server);fetch(sgeinsdatenraum,
+server);datenraeumeankoppeln;commanddialogue(TRUE );IF 
+stundenplanbasisaktuell(fehlerstatus)THEN anzsugrupundklgr:=lines(sugrupdatei
+)-anzklst;anzsugrup:=anzsugrupundklgr-int(records(dnrklassengruppen));anzlv:=
+lines(lvdatei);fehlerstatus:=0;ELSE IF fehlerstatus=9THEN 
+aenderungsvermerkderdbsetzen;FI ;stundenplanbasiserstellen(fehlerstatus);IF 
+fehlerstatus=0THEN stundenplanbasissichern(fehlerstatus);IF fehlerstatus=0
+THEN stundenplansichern(fehlerstatus);fehlerstatus:=8FI FI FI FI ;enablestop.
+aenderungsvermerkderdbsetzen:IF gewhalbj=schulkenndatum(halbj)THEN 
+aenderungsvermerksetzen(aenderungakt)ELSE aenderungsvermerksetzen(
+aenderunggepl)FI .END PROC stundenplanbasisundstundenplanholen;BOOL PROC 
+stundenplandatenvorhanden:TASK VAR server;IF NOT existstask(stuplanverwalter)
+THEN FALSE ELIF gewschulj=""THEN FALSE ELSE server:=task(stuplanverwalter);
+exists(lvnulldatenraum,server)COR exists(lveinsdatenraum,server)COR exists(
+sgnulldatenraum,server)COR exists(sgeinsdatenraum,server)COR exists(
+stuplandatenraum,server)FI END PROC stundenplandatenvorhanden;PROC 
+stundenplanbasisundstundenplanloeschen(INT VAR fehlerstatus):TASK VAR server;
+IF NOT existstask(stuplanverwalter)THEN fehlerstatus:=2ELIF gewschulj=""THEN 
+fehlerstatus:=1;ELSE server:=task(stuplanverwalter);commanddialogue(FALSE );
+erase(stuplandatenraum,server);erase(lvnulldatenraum,server);erase(
+lveinsdatenraum,server);erase(sgnulldatenraum,server);erase(sgeinsdatenraum,
+server);commanddialogue(TRUE );fehlerstatus:=0;FI END PROC 
+stundenplanbasisundstundenplanloeschen;PROC stundenplanloeschen(INT VAR 
+fehlerstatus):IF gewschulj=""THEN fehlerstatus:=1ELIF NOT exists(
+stuplandatenraum)THEN fehlerstatus:=3;ELSE forget(stuplandatenraum,quiet);
+fehlerstatus:=0FI END PROC stundenplanloeschen;PROC 
+stundenplanreorganisierenundsichern(INT VAR fehlerstatus):INT VAR kanal;IF 
+gewschulj=""THEN fehlerstatus:=1ELIF NOT exists(stuplandatenraum)THEN 
+fehlerstatus:=3ELSE kanal:=channel(myself);break(quiet);reorganize(
+stuplandatenraum);continue(kanal);modify(stuplandatei);stundenplansichern(
+fehlerstatus)FI END PROC stundenplanreorganisierenundsichern;TEXT PROC 
+erstellungszeitderdatenraeume:IF exists(stuplandatenraum)THEN toline(
+stuplandatei,letztestunde+1);readrecord(stuplandatei,dserstellungszeit);
+dserstellungszeitELSE fehlerzeichenFI END PROC erstellungszeitderdatenraeume;
+BOOL PROC bezeichnungzulaessig(TEXT CONST kennung,kennungstext):TEXT VAR 
+sicherung;INT VAR zeit,alterdbstatus;IF kennung=kennunglvTHEN lv0eintrag(text
+(kennungstext,laengelv))<>""ELIF kennung=kennungkopplungTHEN kopplunginlv0(
+text(kennungstext,laengekopplung))ELIF kennung=kennungparapheTHEN IF 
+plausiparaphen=trennerTHEN alterdbstatus:=dbstatus;savetupel(dnrlehrer,
+sicherung);statleseschleife(dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC 
+paraphencat);restoretupel(dnrlehrer,sicherung);dbstatus(alterdbstatus)FI ;pos
+(plausiparaphen,trenner+text(kennungstext,laengeparaphe)+trenner)>0ELIF 
+kennung=kennungsugruppeTHEN sg0eintrag(text(kennungstext,laengesugruppe))
+ELIF kennung=kennungraumTHEN IF plausiraeume=trennerTHEN alterdbstatus:=
+dbstatus;savetupel(dnrschluessel,sicherung);statleseschleife(dnrschluessel,
+dbraeume,"",fnrschlsachgebiet,fnrschlschluessel,PROC raumcat);restoretupel(
+dnrschluessel,sicherung);dbstatus(alterdbstatus)FI ;pos(plausiraeume,trenner+
+text(kennungstext,laengeraum)+trenner)>0ELIF kennung=kennungzeitTHEN IF real(
+kennungstext)<1000.0THEN konvertierezeit(int(kennungstext))<>0ELSE FALSE FI 
+ELIF kennung=kennungzugelassenezeitTHEN IF real(kennungstext)>1000.0THEN 
+LEAVE bezeichnungzulaessigWITH FALSE FI ;IF plausizeiten=""COR gewhalbj<>
+halbjplausizeitTHEN halbjplausizeit:=gewhalbj;plausizeiten:=letztestunde*"0";
+inittupel(dnrzeitraster);alterdbstatus:=dbstatus;savetupel(dnrzeitraster,
+sicherung);statleseschleife(dnrzeitraster,gewschulj,gewhalbj,fnrzrsj,fnrzrhj,
+PROC erstelleplausizeiten);restoretupel(dnrzeitraster,sicherung);dbstatus(
+alterdbstatus)FI ;zeit:=konvertierezeit(int(kennungstext));IF zeit<>0THEN (
+plausizeitenSUB zeit)="0"ELSE FALSE FI ELSE FALSE FI END PROC 
+bezeichnungzulaessig;TEXT PROC datenzurlv(TEXT CONST kennung,
+lehrveranstaltung):lvzeile:=lv0eintrag(text(lehrveranstaltung,laengelv));IF 
+lvzeile<>""THEN IF kennung=kennungparapheTHEN paraphederlv(lvzeile)ELIF 
+kennung=kennungkopplungTHEN kopplungderlv(lvzeile)ELIF kennung=
+kennungwochenstdTHEN wochenstdderlv(lvzeile)ELIF kennung=kennungwunschraum
+THEN wunschraumderlv(lvzeile)ELIF kennung=kennungersatzraumTHEN 
+ersatzraumderlv(lvzeile)ELSE fehlerzeichenFI ELSE ungueltigesergebnis(kennung
+)FI END PROC datenzurlv;TEXT PROC beteiligteschuelergruppen(TEXT CONST 
+kennung,kennungstext):BITLEISTE VAR bitleiste;IF kennung=kennunglvTHEN IF 
+lv0eintrag(text(kennungstext,laengelv))=""THEN ungueltigesergebnis(
+kennungsugruppe)ELSE sugruppenausbitleiste(lv1eintrag(zugriffszeilelv0))FI 
+ELIF kennung=kennungkopplungTHEN sammlebitleisten(text(kennungstext,
+laengekopplung),beginnlvkopplung,bitleiste);sugruppenausbitleiste(bitleiste)
+ELSE ungueltigesergebnis(kennungsugruppe)FI END PROC 
+beteiligteschuelergruppen;TEXT PROC schuelergruppenschnittallezeiten(TEXT 
+CONST kennung,anwkennungstext1):BITLEISTE VAR bitleiste,stdplbitleiste;TEXT 
+VAR allestdpllv:="",gesamtlv:="",jgst:="",kopplung:="",stdpllv:="",stdplkopp
+:="",stdpljgst:="",schuelergruppen:="",jgstzurnull:=trenner,verfplan:="",
+schgrjgst:="",fehler:=letztestunde*fehlerzeichen;TEXT VAR kennungstext1:="";
+INT VAR zeit,anfangeintrag,laengeallestdpllv,ij,schgrindex;BOOL VAR schnitt:=
+FALSE ;IF kennung=kennunglvTHEN kennungstext1:=text(anwkennungstext1,laengelv
+);gesamtlv:=lv0eintrag(kennungstext1);IF gesamtlv=""THEN LEAVE 
+schuelergruppenschnittallezeitenWITH fehlerELSE jgst:=text(gesamtlv,
+laengejgst);kopplung:=kopplungderlv(gesamtlv);bitleiste:=lv1eintrag(
+zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN kennungstext1:=text(
+anwkennungstext1,laengekopplung);jgst:=jgstzukopplung(kennungstext1);kopplung
+:=kennungstext1;IF jgst=""THEN LEAVE schuelergruppenschnittallezeitenWITH 
+fehlerELSE sammlebitleisten(kennungstext1,beginnlvkopplung,bitleiste)FI ELSE 
+LEAVE schuelergruppenschnittallezeitenWITH fehlerFI ;IF jgst="00"THEN 
+bildejgstzurnullFI ;FOR zeitFROM erstestundeUPTO letztestundeREP allestdpllv
+:=stuplanzeile(zeit);laengeallestdpllv:=length(allestdpllv);IF 
+laengeallestdpllv>laengejgstTHEN schnitt:=FALSE ;
+pruefeallestdplanlvaufschnitt;IF schnittTHEN verfplanCAT einsELSE verfplan
+CAT nullFI ;ELSE verfplanCAT nullFI ;PER ;verfplan.bildejgstzurnull:
+schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ijFROM 
+1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)*
+laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2);
+IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst;
+jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext(
+jgstzurnull,2,3);jgstzurnull:=""FI .pruefeallestdplanlvaufschnitt:
+anfangeintrag:=0;WHILE anfangeintrag<laengeallestdpllvREP stdpllv:=subtext(
+allestdpllv,anfangeintrag+beginnlvjgst,anfangeintrag+endelvbez);stdpljgst:=
+text(stdpllv,laengejgst);IF kennung=kennunglvTHEN IF jgstgleichCAND stdpllv<>
+kennungstext1THEN stdplkopp:=subtext(allestdpllv,anfangeintrag+
+beginnlvkopplung,anfangeintrag+endelvkopplung);IF kopplungsbezunterschiedlich
+THEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste:=lv1eintrag(
+zugriffszeilelv0);IF bitleistenschnittTHEN schnitt:=TRUE ;LEAVE 
+pruefeallestdplanlvaufschnittFI ELSE LEAVE schuelergruppenschnittallezeiten
+WITH fehlerFI ;FI ;FI ;ELSE IF jgstgleichTHEN stdplkopp:=subtext(allestdpllv,
+anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF 
+kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste
+:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN schnitt:=TRUE ;LEAVE 
+pruefeallestdplanlvaufschnittFI ELSE LEAVE schuelergruppenschnittallezeiten
+WITH fehlerFI ;FI ;FI ;FI ;anfangeintrag:=anfangeintrag+laengestuplaneintrag
+PER .jgstgleich:jgst=stdpljgstCOR stdpljgst="00"COR pos(jgstzurnull,trenner+
+stdpljgst+trenner)>0.kopplungsbezunterschiedlich:kopplung<>stdplkopp.
+bitleistenschnitt:gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END 
+PROC schuelergruppenschnittallezeiten;BOOL PROC schuelergruppenschnittbeizeit
+(INT CONST anwzeit,TEXT CONST kennung,anwkennungstext1,anwkennungstext2):
+BITLEISTE VAR bitleiste,stdplbitleiste;TEXT VAR allestdpllv:="",gesamtlv:="",
+jgst:="",kopplung:="",stdpllv:="",stdplkopp:="",stdpljgst:="",schgrjgst:="",
+schuelergruppen:="",jgstzurnull:=trenner;TEXT VAR kennungstext1:="",
+kennungstext2:="";INT VAR zeit:=konvertierezeit(anwzeit),anfangeintrag,
+laengeallestdpllv,ij,schgrindex;IF zeit=0THEN LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE ELIF kennung=kennunglvTHEN 
+kennungstext1:=text(anwkennungstext1,laengelv);IF anwkennungstext2<>""THEN 
+kennungstext2:=text(anwkennungstext2,laengelv)FI ;gesamtlv:=lv0eintrag(
+kennungstext1);IF gesamtlv=""THEN LEAVE schuelergruppenschnittbeizeitWITH 
+TRUE ELSE jgst:=text(gesamtlv,laengejgst);kopplung:=kopplungderlv(gesamtlv);
+bitleiste:=lv1eintrag(zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN 
+kennungstext1:=text(anwkennungstext1,laengekopplung);jgst:=jgstzukopplung(
+kennungstext1);kopplung:=kennungstext1;IF jgst=""THEN LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE ELSE sammlebitleisten(kennungstext1,
+beginnlvkopplung,bitleiste)FI ELSE LEAVE schuelergruppenschnittbeizeitWITH 
+TRUE FI ;allestdpllv:=stuplanzeile(zeit);laengeallestdpllv:=length(
+allestdpllv);IF laengeallestdpllv<laengejgstTHEN LEAVE 
+schuelergruppenschnittbeizeitWITH FALSE FI ;IF jgst="00"THEN bildejgstzurnull
+FI ;anfangeintrag:=0;WHILE anfangeintrag<laengeallestdpllvREP stdpllv:=
+subtext(allestdpllv,anfangeintrag+beginnlvjgst,anfangeintrag+endelvbez);
+stdpljgst:=text(stdpllv,laengejgst);IF kennung=kennunglvTHEN IF jgstgleich
+CAND stdpllv<>kennungstext1CAND stdpllv<>kennungstext2THEN stdplkopp:=subtext
+(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF 
+kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste
+:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;ELSE IF jgstgleichTHEN 
+stdplkopp:=subtext(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+
+endelvkopplung);IF kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""
+THEN stdplbitleiste:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN 
+LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;FI ;anfangeintrag:=
+anfangeintrag+laengestuplaneintragPER ;FALSE .bildejgstzurnull:
+schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ijFROM 
+1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)*
+laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2);
+IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst;
+jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext(
+jgstzurnull,2,3);jgstzurnull:=""FI .jgstgleich:jgst=stdpljgstCOR stdpljgst=
+"00"COR pos(jgstzurnull,trenner+stdpljgst+trenner)>0.
+kopplungsbezunterschiedlich:kopplung<>stdplkopp.bitleistenschnitt:
+gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END PROC 
+schuelergruppenschnittbeizeit;BOOL PROC schuelergruppenschnittbeizeit(INT 
+CONST anwzeit,TEXT CONST kennung,anwkennungstext1,anwkennungstext2,TEXT VAR 
+lv,sugruppen):BITLEISTE VAR bitleiste,stdplbitleiste;TEXT VAR allestdpllv,
+gesamtlv,jgst,kopplung,stdpllv,stdplkopp,stdpljgst:="",schgrjgst:="",
+schuelergruppen:="",jgstzurnull:=trenner;TEXT VAR kennungstext1:="",
+kennungstext2:="";INT VAR zeit:=konvertierezeit(anwzeit),anfangeintrag,
+laengeallestdpllv,ij,schgrindex;lv:="";sugruppen:="";IF zeit=0THEN LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE ELIF kennung=kennunglvTHEN 
+kennungstext1:=text(anwkennungstext1,laengelv);IF anwkennungstext2<>""THEN 
+kennungstext2:=text(anwkennungstext2,laengelv)FI ;gesamtlv:=lv0eintrag(
+kennungstext1);IF gesamtlv=""THEN LEAVE schuelergruppenschnittbeizeitWITH 
+TRUE ELSE jgst:=text(gesamtlv,laengejgst);kopplung:=kopplungderlv(gesamtlv);
+bitleiste:=lv1eintrag(zugriffszeilelv0);FI ELIF kennung=kennungkopplungTHEN 
+kennungstext1:=text(anwkennungstext1,laengekopplung);jgst:=jgstzukopplung(
+kennungstext1);kopplung:=kennungstext1;IF jgst=""THEN LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE ELSE sammlebitleisten(kennungstext1,
+beginnlvkopplung,bitleiste)FI ELSE LEAVE schuelergruppenschnittbeizeitWITH 
+TRUE FI ;allestdpllv:=stuplanzeile(zeit);laengeallestdpllv:=length(
+allestdpllv);IF laengeallestdpllv<laengejgstTHEN LEAVE 
+schuelergruppenschnittbeizeitWITH FALSE FI ;IF jgst="00"THEN bildejgstzurnull
+FI ;anfangeintrag:=0;WHILE anfangeintrag<laengeallestdpllvREP stdpllv:=
+subtext(allestdpllv,anfangeintrag+beginnlvjgst,anfangeintrag+endelvbez);
+stdpljgst:=text(stdpllv,laengejgst);IF kennung=kennunglvTHEN IF jgstgleich
+CAND stdpllv<>kennungstext1CAND stdpllv<>kennungstext2THEN stdplkopp:=subtext
+(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+endelvkopplung);IF 
+kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste
+:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lv:=stdpllv;sugruppen
+:=sugruppenausbitleiste(bitleistegemeinsamesugruppen(stdplbitleiste,bitleiste
+));LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ELSE LEAVE 
+schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;ELSE IF jgstgleichTHEN 
+stdplkopp:=subtext(allestdpllv,anfangeintrag+beginnlvkopplung,anfangeintrag+
+endelvkopplung);IF kopplungsbezunterschiedlichTHEN IF lv0eintrag(stdpllv)<>""
+THEN stdplbitleiste:=lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lv
+:=stdpllv;sugruppen:=sugruppenausbitleiste(bitleistegemeinsamesugruppen(
+stdplbitleiste,bitleiste));LEAVE schuelergruppenschnittbeizeitWITH TRUE FI 
+ELSE LEAVE schuelergruppenschnittbeizeitWITH TRUE FI ;FI ;FI ;FI ;
+anfangeintrag:=anfangeintrag+laengestuplaneintragPER ;FALSE .bildejgstzurnull
+:schuelergruppen:=beteiligteschuelergruppen(kennung,kennungstext1);FOR ij
+FROM 1UPTO length(schuelergruppen)DIV laengesugruppeREP schgrindex:=(ij-1)*
+laengesugruppe;schgrjgst:=subtext(schuelergruppen,schgrindex+1,schgrindex+2);
+IF pos(jgstzurnull,trenner+schgrjgst+trenner)=0THEN jgstzurnullCAT schgrjgst;
+jgstzurnullCAT trennerFI PER ;IF length(jgstzurnull)=4THEN jgst:=subtext(
+jgstzurnull,2,3);jgstzurnull:=""FI .jgstgleich:jgst=stdpljgstCOR stdpljgst=
+"00"COR pos(jgstzurnull,trenner+stdpljgst+trenner)>0.
+kopplungsbezunterschiedlich:kopplung<>stdplkopp.bitleistenschnitt:
+gibtesgemeinsamesugruppen(bitleiste,stdplbitleiste).END PROC 
+schuelergruppenschnittbeizeit;BOOL PROC gemeinsameschuelergruppen(TEXT CONST 
+kennung1,akennungstext1,kennung2,akennungstext2):BITLEISTE VAR bitleiste1,
+bitleiste2;TEXT VAR kennungstext1:="",kennungstext2:="";IF kennung1=kennunglv
+THEN kennungstext1:=text(akennungstext1,laengelv);IF lv0eintrag(kennungstext1
+)=""THEN LEAVE gemeinsameschuelergruppenWITH TRUE ELSE bitleiste1:=lv1eintrag
+(zugriffszeilelv0)FI ELIF kennung1=kennungkopplungTHEN kennungstext1:=text(
+akennungstext1,laengekopplung);sammlebitleisten(kennungstext1,
+beginnlvkopplung,bitleiste1);ELSE LEAVE gemeinsameschuelergruppenWITH TRUE 
+FI ;IF kennung2=kennunglvTHEN kennungstext2:=text(akennungstext2,laengelv);
+IF lv0eintrag(kennungstext2)=""THEN LEAVE gemeinsameschuelergruppenWITH TRUE 
+ELSE bitleiste2:=lv1eintrag(zugriffszeilelv0)FI ELIF kennung2=kennungkopplung
+THEN kennungstext2:=text(akennungstext2,laengekopplung);sammlebitleisten(
+kennungstext2,beginnlvkopplung,bitleiste2);ELSE LEAVE 
+gemeinsameschuelergruppenWITH TRUE FI ;gibtesgemeinsamesugruppen(bitleiste1,
+bitleiste2)END PROC gemeinsameschuelergruppen;TEXT PROC lvderschuelergruppe(
+TEXT CONST anwsugrup):INT VAR i,folgejgst:=5;TEXT VAR lvmitsugrup:="",
+aufberjgst:=formatjgst(anwsugrup),sugrup:=text(anwsugrup,laengesugruppe);
+BITLEISTE VAR bitleiste:=sugrupurleiste;IF pos(klstjgst,trenner+compress(
+sugrup)+trenner)>0COR aufberjgst="00"COR schuelergruppeTHEN betrachtelvELSE 
+ungueltigesergebnis(kennunglv)FI .betrachtelv:bitleiste:=sg1eintrag(sugrup);
+lvjgstnullanfang:=1;lvjgstnullende:=-1;WHILE lvjgstnullende=-1CAND folgejgst<
+14REP lvjgstnullende:=erstezeileindatei(lvdatei,formatjgst(text(folgejgst)),1
+,beginnlvjgst)-1;folgejgstINCR 1PER ;IF formatjgst(anwsugrup)<>"00"THEN 
+lvsugrupjgstanfang:=erstezeileindatei(lvdatei,aufberjgst,1,beginnlvjgst);IF 
+int(sugrup)=jgstdreizehnTHEN lvsugrupjgstende:=anzlv;ELSE lvsugrupjgstende:=
+erstezeileindatei(lvdatei,formatjgst(text(int(sugrup)+1)),lvsugrupjgstanfang,
+beginnlvjgst);FI ;IF lvsugrupjgstanfang=0THEN lvsugrupjgstanfang:=
+lvsugrupjgstende+1FI ELSE lvsugrupjgstanfang:=1;lvsugrupjgstende:=0FI ;FOR i
+FROM lvjgstnullanfangUPTO lvjgstnullendeREP IF 
+bitleistenvergleichgemeinsamesugruppenTHEN lvmitsugrupCAT text(lv0eintrag(i),
+laengelv)FI PER ;FOR iFROM lvsugrupjgstanfangUPTO lvsugrupjgstendeREP IF 
+bitleistenvergleichgemeinsamesugruppenTHEN lvmitsugrupCAT text(lv0eintrag(i),
+laengelv)FI PER ;lvmitsugrup.bitleistenvergleichgemeinsamesugruppen:
+gibtesgemeinsamesugruppen(bitleiste,lv1eintrag(i)).schuelergruppe:toline(
+sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety(
+sugrupdatei,sugrup);IF col(sugrupdatei)=1THEN LEAVE schuelergruppeWITH TRUE 
+ELSE positionierenFI ;PER ;FALSE .positionieren:col(sugrupdatei,col(
+sugrupdatei)+1).END PROC lvderschuelergruppe;TEXT PROC allelvmit(TEXT CONST 
+kennung,anwkennungstext):TEXT VAR lvmit:="",lv:="",kennungstext:="";INT VAR 
+richtigepos;IF kennung=kennungparapheTHEN kennungstext:=text(anwkennungstext,
+laengeparaphe);richtigepos:=stuplanposparapheELIF kennung=kennungkopplung
+THEN kennungstext:=text(anwkennungstext,laengekopplung);richtigepos:=
+stuplanposkopplungELSE LEAVE allelvmitWITH ungueltigesergebnis(kennunglv)FI ;
+toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety(lvdatei,
+kennungstext);IF col(lvdatei)=richtigeposCAND NOT eof(lvdatei)THEN readrecord
+(lvdatei,lv);lvmitCAT text(lv,laengelv)FI ;positionierenPER ;lvmit.
+positionieren:col(lvdatei,col(lvdatei)+1).END PROC allelvmit;BOOL PROC 
+lvgeplant(INT CONST zeit,TEXT CONST lehrveranstaltung):INT CONST std:=
+konvertierezeit(zeit);TEXT VAR eintrag:="";IF std=0THEN TRUE ELSE eintrag:=
+stuplanzeile(std);instuplanzeile(eintrag,text(lehrveranstaltung,laengelv),
+stuplanposjgst,letzteposstuplanzeile)FI END PROC lvgeplant;TEXT PROC 
+geplantelvfuer(INT CONST zeit,TEXT CONST kennung,anwkennungstext):INT VAR std
+:=konvertierezeit(zeit),poslv,richtigepos;TEXT VAR kennungstext:="";IF std=0
+THEN LEAVE geplantelvfuerWITH ungueltigesergebnis(kennunglv)ELIF kennung=
+kennungparapheTHEN kennungstext:=text(anwkennungstext,laengeparaphe);
+richtigepos:=stuplanposparapheELIF kennung=kennungraumTHEN kennungstext:=text
+(anwkennungstext,laengeraum);richtigepos:=stuplanposraumELSE LEAVE 
+geplantelvfuerWITH ungueltigesergebnis(kennunglv)FI ;IF instuplanzeile(
+stuplanzeile(std),kennungstext,richtigepos,letzteposstuplanzeile)THEN 
+holentsprlvELSE ""FI .holentsprlv:poslv:=letzteposstuplanzeile-richtigepos+1;
+subtext(stuplanzeile(std),poslv,poslv+laengelv-1).END PROC geplantelvfuer;
+TEXT PROC allezeitenvon(TEXT CONST kennung,anwkennungstext):INT VAR i,
+richtigepos;TEXT VAR verfplan:="",kennungstext:="";IF kennung=kennungparaphe
+THEN kennungstext:=text(anwkennungstext,laengeparaphe);richtigepos:=
+stuplanposparapheELIF kennung=kennunglvTHEN kennungstext:=text(
+anwkennungstext,laengelv);richtigepos:=stuplanposjgstELIF kennung=kennungraum
+THEN kennungstext:=text(anwkennungstext,laengeraum);richtigepos:=
+stuplanposraumELIF kennung=kennungkopplungTHEN kennungstext:=text(
+anwkennungstext,laengekopplung);richtigepos:=stuplanposkopplungELSE LEAVE 
+allezeitenvonWITH letztestunde*fehlerzeichenFI ;FOR iFROM erstestundeUPTO 
+letztestundeREP IF instuplanzeile(stuplanzeile(i),kennungstext,richtigepos,
+letzteposstuplanzeile)THEN verfplanCAT einsELSE verfplanCAT nullFI PER ;
+verfplanEND PROC allezeitenvon;TEXT PROC datenderzeit(INT CONST zeit,TEXT 
+CONST kennung):INT VAR std:=konvertierezeit(zeit),poseintrag,laengeeintrag,
+objektlaenge,objektbeginn;TEXT VAR eintrag:="",ausgabe:="";IF kennung=
+kennunglvTHEN objektlaenge:=laengelv;objektbeginn:=stuplanposjgstELIF kennung
+=kennungkopplungTHEN objektlaenge:=laengekopplung;objektbeginn:=
+stuplanposkopplungELIF kennung=kennungparapheTHEN objektlaenge:=laengeparaphe
+;objektbeginn:=stuplanposparapheELIF kennung=kennungraumTHEN objektlaenge:=
+laengeraum;objektbeginn:=stuplanposraumELSE LEAVE datenderzeitWITH 
+fehlerzeichenFI ;IF std=0THEN LEAVE datenderzeitWITH ungueltigesergebnis(
+kennung)FI ;toline(stuplandatei,std);readrecord(stuplandatei,eintrag);ausgabe
+:="";poseintrag:=objektbeginn;laengeeintrag:=length(eintrag);WHILE poseintrag
+<laengeeintragREP ausgabeCAT subtext(eintrag,poseintrag,poseintrag+
+objektlaenge-1);poseintrag:=poseintrag+laengestuplaneintragPER ;ausgabeEND 
+PROC datenderzeit;PROC planeintraglesen(INT CONST zeit,TEXT CONST kennung,
+anwkennungstext,TEXT VAR lehrveranstaltung,raum,paraphe):INT VAR std:=
+konvertierezeit(zeit),poslv,richtigepos,stackpos,anfangeintrag,
+laengeallestdpllv;TEXT VAR kennungstext:="",stdpllv,allestdpllv,jgstdersugrup
+,jgstderlv;BITLEISTE VAR sugrupbitleiste,stdplbitleiste;IF std=0THEN 
+lehrveranstaltung:=ungueltigesergebnis(kennunglv);raum:="";paraphe:="";LEAVE 
+planeintraglesenELIF kennung=kennunglvTHEN kennungstext:=text(anwkennungstext
+,laengelv);richtigepos:=stuplanposjgstELIF kennung=kennungparapheTHEN 
+kennungstext:=text(anwkennungstext,laengeparaphe);richtigepos:=
+stuplanposparapheELIF kennung=kennungraumTHEN kennungstext:=text(
+anwkennungstext,laengeraum);richtigepos:=stuplanposraumELIF kennung=
+kennungsugruppeTHEN jgstdersugrup:=jgstaufber(text(anwkennungstext,laengejgst
+));kennungstext:=text(jgstdersugrup+subtext(anwkennungstext,laengejgst+1),
+laengesugruppe)ELSE fehlerbehandlungFI ;lehrveranstaltung:="";raum:="";
+paraphe:="";IF kennung<>kennungsugruppeTHEN IF instuplanzeile(stuplanzeile(
+std),kennungstext,richtigepos,letzteposstuplanzeile)THEN holentsprlvFI ELSE 
+holelvderzeit;ermittlebitleiste;vergleichelvmitbitleisteFI .holentsprlv:poslv
+:=letzteposstuplanzeile-richtigepos+1;lehrveranstaltung:=subtext(stuplanzeile
+(std),poslv,poslv+laengestuplaneintrag-1);raum:=subtext(lehrveranstaltung,
+stuplanposraum);paraphe:=subtext(lehrveranstaltung,stuplanposparaphe,
+stuplanposparaphe+laengeparaphe-1);lehrveranstaltung:=text(lehrveranstaltung,
+laengelv).ermittlebitleiste:stackpos:=pos(behandeltesugruppen,trenner+
+kennungstext+trenner);IF bitleistenochzuermittelnTHEN sugrupbitleiste:=
+sg1eintrag(kennungstext);IF anzbitleisten<maxsugruppenTHEN sugruppenstack(
+anzbitleisten+1):=sugrupbitleiste;behandeltesugruppenCAT kennungstext;
+behandeltesugruppenCAT trenner;anzbitleistenINCR 1FI ELSE sugrupbitleiste:=
+sugruppenstack((stackpos+6)DIV 7)FI .bitleistenochzuermitteln:stackpos=0.
+holelvderzeit:allestdpllv:=stuplanzeile(std);laengeallestdpllv:=length(
+allestdpllv);IF laengeallestdpllv<laengejgstTHEN LEAVE planeintraglesenFI .
+vergleichelvmitbitleiste:anfangeintrag:=0;WHILE anfangeintrag<
+laengeallestdpllvREP stdpllv:=subtext(allestdpllv,anfangeintrag+beginnlvjgst,
+anfangeintrag+endelvbez);jgstderlv:=text(stdpllv,laengejgst);IF 
+jgstgleichodernullnullTHEN IF lv0eintrag(stdpllv)<>""THEN stdplbitleiste:=
+lv1eintrag(zugriffszeilelv0);IF bitleistenschnittTHEN lehrveranstaltungCAT 
+stdpllv;raumCAT subtext(allestdpllv,anfangeintrag+stuplanposraum,
+anfangeintrag+laengestuplaneintrag);parapheCAT subtext(allestdpllv,
+anfangeintrag+stuplanposparaphe,anfangeintrag+stuplanposraum-1)FI FI ;FI ;
+anfangeintrag:=anfangeintrag+laengestuplaneintragPER .jgstgleichodernullnull:
+jgstdersugrup=jgstderlvCOR jgstderlv="00".bitleistenschnitt:
+gibtesgemeinsamesugruppen(sugrupbitleiste,stdplbitleiste).fehlerbehandlung:
+lehrveranstaltung:=ungueltigesergebnis(kennunglv);raum:="";paraphe:="";LEAVE 
+planeintraglesen.END PROC planeintraglesen;PROC planeintragvornehmen(INT 
+CONST zeit,TEXT CONST anwlehrveranstaltung,anwraum,BOOL VAR ok):INT VAR std:=
+konvertierezeit(zeit);TEXT VAR lv,eintrag,neuereintrag,lehrveranstaltung:=
+text(anwlehrveranstaltung,laengelv),raum:=text(anwraum,laengeraum);IF std=0
+THEN ok:=FALSE ;LEAVE planeintragvornehmenFI ;IF raum<>leereraumangabeAND (
+NOT bezeichnungzulaessig(kennungraum,raum))THEN ok:=FALSE ;LEAVE 
+planeintragvornehmenFI ;lv:=lv0eintrag(lehrveranstaltung);IF lv=""THEN ok:=
+FALSE ;ELIF instuplanzeile(stuplanzeile(std),lehrveranstaltung,stuplanposjgst
+,letzteposstuplanzeile)THEN holstuplaneintrag;substituierelvELSE 
+holstuplaneintrag;erweitereumlvFI .holstuplaneintrag:ok:=TRUE ;toline(
+stuplandatei,std);readrecord(stuplandatei,eintrag).erweitereumlv:eintragCAT 
+text(lv,laengelv+laengekopplung+laengeparaphe);eintragCAT text(raum,
+laengeraum);writerecord(stuplandatei,eintrag).substituierelv:neuereintrag:=
+text(eintrag,letzteposstuplanzeile-1);neuereintragCAT text(lv,laengelv+
+laengekopplung+laengeparaphe);neuereintragCAT text(raum,laengeraum);
+neuereintragCAT subtext(eintrag,letzteposstuplanzeile+laengestuplaneintrag);
+writerecord(stuplandatei,neuereintrag).END PROC planeintragvornehmen;PROC 
+planeintragloeschen(INT CONST zeit,TEXT CONST lehrveranstaltung,BOOL VAR ok):
+INT VAR std:=konvertierezeit(zeit);TEXT VAR eintrag,neuereintrag;IF std=0
+THEN ok:=FALSE ELIF instuplanzeile(stuplanzeile(std),text(lehrveranstaltung,
+laengelv),stuplanposjgst,letzteposstuplanzeile)THEN holstuplaneintrag;
+loescheeintragELSE ok:=FALSE FI .holstuplaneintrag:ok:=TRUE ;toline(
+stuplandatei,std);readrecord(stuplandatei,eintrag).loescheeintrag:
+neuereintrag:=text(eintrag,letzteposstuplanzeile-1);neuereintragCAT subtext(
+eintrag,letzteposstuplanzeile+laengestuplaneintrag);writerecord(stuplandatei,
+neuereintrag).END PROC planeintragloeschen;PROC resetbitleiste(BITLEISTE VAR 
+bitleiste):FOR iFROM 1UPTO leistenlaengeREP FOR jFROM 0UPTO bits-1REP 
+resetbit(bitleiste(i),j)PER PER ;END PROC resetbitleiste;PROC 
+loeschdatenraeume:forget(lvnulldatenraum,quiet);forget(sgnulldatenraum,quiet)
+;forget(lveinsdatenraum,quiet);forget(sgeinsdatenraum,quiet)END PROC 
+loeschdatenraeume;OP :=(BITLEISTE VAR eins,BITLEISTE CONST zwei):INT VAR i;
+FOR iFROM 1UPTO leistenlaengeREP eins(i):=zwei(i)PER END OP :=;PROC 
+schreibesugrupundklgrinds:zz:=0;positioniersugrup;holsugrupdaten;IF zz=0THEN 
+LEAVE schreibesugrupundklgrindsFI ;anzsugrup:=zz;positionierklgr;holklgrdaten
+;IF anzsugrup=-1THEN LEAVE schreibesugrupundklgrindsFI ;anzsugrupundklgr:=zz;
+FOR iFROM jgstfuenfUPTO jgstdreizehnREP toline(sugrupdatei,lines(sugrupdatei)
++1);schreibjgstindateiPER .positioniersugrup:inittupel(dnraktschuelergruppen)
+;putwert(fnrsgrpsj,gewschulj);putwert(fnrsgrphj,gewhalbj);putintwert(
+fnrsgrpjgst,0).positionierklgr:inittupel(dnrklassengruppen);first(
+dnrklassengruppen).holsugrupdaten:IF records(dnraktschuelergruppen)=0.0THEN 
+LEAVE schreibesugrupundklgrindsFI ;statleseschleife(dnraktschuelergruppen,
+gewschulj,gewhalbj,fnrsgrpsj,fnrsgrphj,PROC sugrupinds).holklgrdaten:IF 
+records(dnrklassengruppen)=0.0THEN LEAVE holklgrdatenFI ;statleseschleife(
+dnrklassengruppen,"","",fnrkgklassengrp,fnrkgschuelergrp,PROC klgrinds).
+schreibjgstindatei:putds(sugrupdatei,text(formatjgst(text(i)),laengesugruppe)
+);schreibbitleisteinds.schreibbitleisteinds:sugrupleiste:=sugrupurleiste;
+ermittlebitleistejgstodersugrupklgr(formatjgst(text(i,laengejgst)));
+sgbitleisten(zz+1):=sugrupleiste;zzINCR 1.END PROC schreibesugrupundklgrinds;
+PROC schreibelvinds:anzlv:=0;sucheerstensatz;schreibsugrupleiste;IF zz<>0
+THEN anzlv:=zz-1FI .sucheerstensatz:IF records(dnrlehrveranstaltungen)=0.0
+THEN LEAVE schreibelvindsFI ;inittupel(dnrlehrveranstaltungen);putwert(
+fnrlvsj,gewschulj);putwert(fnrlvhj,gewhalbj);putintwert(fnrlvjgst,jgstnull);
+putwert(fnrlvfachkennung,"");search(dnrlehrveranstaltungen,FALSE ).
+schreibsugrupleiste:zz:=0;statleseschleife(dnrlehrveranstaltungen,gewschulj,
+gewhalbj,fnrlvsj,fnrlvhj,PROC sugrupleisteinds).END PROC schreibelvinds;PROC 
+sugrupleisteinds(BOOL VAR b):IF wert(fnrlvsj)=gewschuljCAND wert(fnrlvhj)=
+gewhalbjCAND dbstatus=0CAND zz<2499THEN klgreintrag:=FALSE ;sugrupleiste:=
+sugrupurleiste;analysiereklgreinerlv(fnrlvklgrp1);IF anzsugrup=-1THEN b:=
+TRUE ;LEAVE sugrupleisteindsELSE analysiereklgreinerlv(fnrlvklgrp2);IF 
+anzsugrup=-1THEN b:=TRUE ;LEAVE sugrupleisteindsELSE analysiereklgreinerlv(
+fnrlvklgrp3);IF anzsugrup=-1THEN b:=TRUE ;LEAVE sugrupleisteindsELSE 
+analysiereklgreinerlv(fnrlvklgrp4);FI ;FI ;FI ;IF NOT klgreintragTHEN 
+ermittlebitleistejgst(wert(fnrlvjgst));FI ;schreiblvindatei;
+schreibsugrupleisteindsELSE b:=TRUE FI .schreiblvindatei:dateieintrag:="";
+dateieintragCAT formatjgst(wert(fnrlvjgst));dateieintragCAT text(wert(
+fnrlvfachkennung),laengefachkennung);dateieintragCAT text(wert(fnrlvkopplung)
+,laengekopplung);dateieintragCAT text(wert(fnrlvparaphe),laengeparaphe);
+dateieintragCAT text(wert(fnrlvwochenstd),laengewochenstd);dateieintragCAT 
+text(wert(fnrlvraumgrp1),laengeraum);dateieintragCAT text(wert(fnrlvraumgrp2)
+,laengeraum);putds(lvdatei,dateieintrag).schreibsugrupleisteinds:lvbitleisten
+(zz+1):=sugrupleiste;zzINCR 1;.END PROC sugrupleisteinds;PROC 
+analysiereklgreinerlv(INT CONST lvklgrfeld):IF wert(lvklgrfeld)<>""THEN IF 
+istjgst(wert(lvklgrfeld))THEN ermittlebitleistejgst(wert(lvklgrfeld));ELIF 
+istklgr(wert(lvklgrfeld))THEN ermittlebitleistejgstodersugrupklgr(wert(
+lvklgrfeld));ELSE ermittlebitleistejgstodersugrupklgr(formatjgst(wert(
+fnrlvjgst))+wert(lvklgrfeld));IF anzsugrup=-1THEN LEAVE analysiereklgreinerlv
+FI ;FI ;klgreintrag:=TRUE FI ;END PROC analysiereklgreinerlv;PROC sugrupinds(
+BOOL VAR b):IF wert(fnrsgrpsj)=gewschuljCAND wert(fnrsgrphj)=gewhalbjCAND 
+dbstatus=0THEN sugrupleiste:=sugrupurleiste;putds(sugrupdatei,formatjgst(wert
+(fnrsgrpjgst))+text(wert(fnrsgrpkennung),laengeklagruppe));IF zz<127THEN 
+schreibesugrupleisteFI ;sgbitleisten(zz+1):=sugrupleiste;zzINCR 1;ELIF wert(
+fnrsgrpsj)>gewschuljCOR wert(fnrsgrphj)>gewhalbjCOR dbstatus<>0COR zz=127
+THEN b:=TRUE FI .schreibesugrupleiste:setzebit(zz).END PROC sugrupinds;PROC 
+klgrinds(BOOL VAR b):IF dbstatus=0THEN toline(sugrupdatei,lines(sugrupdatei)+
+1);plausiklgrCAT wert(fnrkgklassengrp)+trenner;putds(sugrupdatei,text(wert(
+fnrkgklassengrp),laengesugruppe));analysieresugrupen;sgbitleisten(zz+1):=
+sugrupleiste;zzINCR 1ELSE b:=TRUE FI .analysieresugrupen:sugrupleiste:=
+sugrupurleiste;sugruppeneinerklgr:=wert(fnrkgschuelergrp);FOR kFROM 1UPTO 
+LENGTH sugruppeneinerklgrDIV laengesugruppeREP 
+ermittlebitleistejgstodersugrupklgr(subtext(sugruppeneinerklgr,(k-1)*
+laengesugruppe+1,k*laengesugruppe));IF anzsugrup=-1THEN b:=TRUE ;LEAVE 
+klgrindsFI ;PER .END PROC klgrinds;PROC ermittlebitleistejgstodersugrupklgr(
+TEXT CONST klgrteil):TEXT VAR compklgrteil:=compress(klgrteil);IF istjgst(
+compklgrteil)THEN stellebitleistenjgstELSE stellebitleistesugrupoderklgrFI .
+stellebitleistesugrupoderklgr:IF istklgr(compklgrteil)THEN toline(sugrupdatei
+,anzsugrup);ELSE toline(sugrupdatei,1);FI ;col(sugrupdatei,1);downety(
+sugrupdatei,compklgrteil);IF NOT eof(sugrupdatei)THEN oderbitleisten;LEAVE 
+stellebitleistesugrupoderklgrELSE anzsugrup:=-1;LEAVE 
+ermittlebitleistejgstodersugrupklgrFI .stellebitleistenjgst:toline(
+sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety(
+sugrupdatei,formatjgst(klgrteil));IF col(sugrupdatei)=1CAND lineno(
+sugrupdatei)<=anzsugrupTHEN oderbitleistenFI ;positionierenPER .positionieren
+:col(sugrupdatei,col(sugrupdatei)+1).oderbitleisten:BITLEISTE VAR bitleiste:=
+sgbitleisten(lineno(sugrupdatei));FOR jFROM 1UPTO leistenlaengeREP 
+sugrupleiste(j):=sugrupleiste(j)OR bitleiste(j)PER .END PROC 
+ermittlebitleistejgstodersugrupklgr;PROC ermittlebitleistejgst(TEXT CONST 
+klgrteil):stellebitleistenjgst.stellebitleistenjgst:toline(sugrupdatei,
+anzsugrupundklgr);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)REP downety(
+sugrupdatei,formatjgst(klgrteil));IF col(sugrupdatei)=1THEN oderbitleistenFI 
+;positionierenPER .positionieren:col(sugrupdatei,col(sugrupdatei)+1).
+oderbitleisten:BITLEISTE VAR bitleiste:=sgbitleisten(lineno(sugrupdatei));
+FOR jFROM 1UPTO leistenlaengeREP sugrupleiste(j):=sugrupleiste(j)OR bitleiste
+(j)PER .END PROC ermittlebitleistejgst;BOOL PROC stundenplanbasisaktuell(INT 
+VAR fehlerstatus):dserstellungszeit:="";letztedbzeit:="";ermittledszeit;
+ermittledbzeit;vergleichezeit;IF fehlerstatus=0THEN TRUE ELSE FALSE FI .
+ermittledszeit:dserstellungszeit:=erstellungszeitderdatenraeume.
+ermittledbzeit:IF gewhalbj=schulkenndatum(halbj)THEN inittupel(dnrschluessel)
+;putwert(fnrschlschluessel,dbaenderungakt);ELSE inittupel(dnrschluessel);
+putwert(fnrschlschluessel,dbaenderunggepl);FI ;putwert(fnrschlsachgebiet,
+dbaenderung);search(dnrschluessel,TRUE );IF dbstatus<>okTHEN fehlerstatus:=9;
+LEAVE stundenplanbasisaktuellWITH FALSE ELSE letztedbzeit:=wert(
+fnrschllangtext)FI .vergleichezeit:IF dsjahr=dbjahrTHEN pruefmonatELIF dsjahr
+>dbjahrTHEN fehlerstatus:=0ELSE fehlerstatus:=1FI .pruefmonat:IF dsmonat=
+dbmonatTHEN prueftagELIF dsmonat>dbmonatTHEN fehlerstatus:=0ELSE fehlerstatus
+:=1FI .prueftag:IF dstag=dbtagTHEN pruefzeitELIF dstag>dbtagTHEN fehlerstatus
+:=0ELSE fehlerstatus:=1FI .pruefzeit:IF dszeit>=dbzeitTHEN fehlerstatus:=0
+ELSE fehlerstatus:=1FI .dsjahr:subtext(dserstellungszeit,erstellzeitjahr,
+erstellzeitjahr+1).dbjahr:subtext(letztedbzeit,erstellzeitjahr,
+erstellzeitjahr+1).dsmonat:subtext(dserstellungszeit,erstellzeitmonat,
+erstellzeitmonat+1).dbmonat:subtext(letztedbzeit,erstellzeitmonat,
+erstellzeitmonat+1).dstag:text(dserstellungszeit,erstellzeittag+1).dbtag:text
+(letztedbzeit,erstellzeittag+1).dszeit:subtext(dserstellungszeit,
+erstellzeitstdmin).dbzeit:subtext(letztedbzeit,erstellzeitstdmin).END PROC 
+stundenplanbasisaktuell;PROC stundenplanbasiserstellen(INT VAR fehlerstatus):
+hilfsdatenerstellen(fehlerstatus);IF fehlerstatus=0THEN toline(stuplandatei,
+letztestunde+1);writerecord(stuplandatei,date+blank+timeofday);FI .END PROC 
+stundenplanbasiserstellen;PROC hilfsdatenerstellen(INT VAR fehlerstatus):
+inithilfsdateien;schreibesugrupundklgrinds;IF anzsugrup=-1THEN fehlerstatus:=
+9;forget(sgnulldatenraum,quiet);forget(sgeinsdatenraum,quiet)ELIF anzsugrup=0
+THEN fehlerstatus:=4ELIF anzsugrup>127THEN fehlerstatus:=5;loeschdatenraeume
+ELSE schreibelvinds;IF anzsugrup=-1THEN fehlerstatus:=9;loeschdatenraeume
+ELIF anzlv=0THEN fehlerstatus:=6;loeschdatenraeumeELIF anzlv>2499THEN 
+fehlerstatus:=7;loeschdatenraeumeELSE fehlerstatus:=0FI ;FI .inithilfsdateien
+:commanddialogue(FALSE );loeschdatenraeume;commanddialogue(TRUE );#dslv:=new(
+lvnulldatenraum);dssugrup:=new(sgnulldatenraum);commanddialogue(FALSE );
+forget(dslv);forget(dssugrup);commanddialogue(TRUE );#lvdatei:=sequentialfile
+(modify,lvnulldatenraum);sugrupdatei:=sequentialfile(modify,sgnulldatenraum);
+lvbitleisten:=new(lveinsdatenraum);sgbitleisten:=new(sgeinsdatenraum);
+resetbitleiste(sugrupurleiste).END PROC hilfsdatenerstellen;PROC 
+datenraeumeankoppeln:IF exists(lvnulldatenraum)THEN lvdatei:=sequentialfile(
+modify,old(lvnulldatenraum))FI ;IF exists(sgnulldatenraum)THEN sugrupdatei:=
+sequentialfile(modify,old(sgnulldatenraum))FI ;IF exists(stuplandatenraum)
+THEN stuplandatei:=sequentialfile(modify,old(stuplandatenraum))FI ;IF exists(
+lveinsdatenraum)THEN lvbitleisten:=old(lveinsdatenraum);FI ;IF exists(
+sgeinsdatenraum)THEN sgbitleisten:=old(sgeinsdatenraum);FI END PROC 
+datenraeumeankoppeln;INT PROC zugriffszeilelv0:letzterzugrifflv0END PROC 
+zugriffszeilelv0;TEXT PROC lv0eintrag(TEXT CONST lv):TEXT VAR dateieintrag:=
+"";letzterzugrifflv0:=0;dateieintrag:="";toline(lvdatei,1);col(lvdatei,1);
+WHILE NOT eof(lvdatei)REP downety(lvdatei,lv);IF col(lvdatei)=beginnlvbez
+CAND NOT eof(lvdatei)THEN readrecord(lvdatei,dateieintrag);letzterzugrifflv0
+:=lineno(lvdatei);LEAVE lv0eintragWITH dateieintragELSE positionierenFI ;PER 
+;"".positionieren:col(lvdatei,col(lvdatei)+1).END PROC lv0eintrag;TEXT PROC 
+lv0eintrag(INT CONST index):TEXT VAR dateieintrag:="";toline(lvdatei,index);
+col(lvdatei,1);IF eof(lvdatei)THEN ""ELSE readrecord(lvdatei,dateieintrag);
+dateieintragFI END PROC lv0eintrag;BOOL PROC kopplunginlv0(TEXT CONST 
+kopplung):toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety(
+lvdatei,kopplung);IF col(lvdatei)=beginnlvkopplungCAND NOT eof(lvdatei)THEN 
+LEAVE kopplunginlv0WITH TRUE ELSE positionierenFI ;PER ;FALSE .positionieren:
+col(lvdatei,col(lvdatei)+1).END PROC kopplunginlv0;BOOL PROC sg0eintrag(TEXT 
+CONST sg):toline(sugrupdatei,1);col(sugrupdatei,1);WHILE NOT eof(sugrupdatei)
+REP downety(sugrupdatei,sg);IF col(sugrupdatei)=1CAND NOT eof(sugrupdatei)
+CAND lineno(sugrupdatei)<=anzsugrupTHEN LEAVE sg0eintragWITH TRUE ELSE 
+positionierenFI ;PER ;FALSE .positionieren:col(sugrupdatei,col(sugrupdatei)+1
+).END PROC sg0eintrag;TEXT PROC sg0eintrag(INT CONST index):dateieintrag:="";
+toline(sugrupdatei,index);col(sugrupdatei,1);IF eof(sugrupdatei)THEN ""ELSE 
+readrecord(sugrupdatei,dateieintrag);text(dateieintrag,laengesugruppe)FI END 
+PROC sg0eintrag;BITLEISTE PROC sg1eintrag(TEXT CONST anwsugrup):TEXT VAR 
+sugrup:=text(anwsugrup,laengesugruppe);toline(sugrupdatei,1);col(sugrupdatei,
+1);WHILE NOT eof(sugrupdatei)REP downety(sugrupdatei,sugrup);IF col(
+sugrupdatei)=1CAND NOT eof(sugrupdatei)THEN LEAVE sg1eintragWITH sgbitleisten
+(lineno(sugrupdatei))ELSE positionierenFI ;PER ;sugrupurleiste.positionieren:
+col(sugrupdatei,col(sugrupdatei)+1).END PROC sg1eintrag;BITLEISTE PROC 
+lv1eintrag(INT CONST index):lvbitleisten(index)END PROC lv1eintrag;TEXT PROC 
+sugruppenausbitleiste(BITLEISTE CONST bitleiste):sugruppeneinerklgr:="";FOR j
+FROM 1UPTO leistenlaengeREP lowbit:=lowestset(bitleiste(j));IF lowbit<>-1
+THEN FOR kFROM lowbitUPTO bits-1REP IF bit(bitleiste(j),k)THEN 
+sugruppeneinerklgrCAT sg0eintrag(k+(j-1)*bits+1)FI PER ;FI ;PER ;
+sugruppeneinerklgrEND PROC sugruppenausbitleiste;BITLEISTE PROC 
+bitleisteallesugruppen(BITLEISTE VAR v,BITLEISTE CONST c):BITLEISTE VAR b:=
+sugrupurleiste;FOR jFROM 1UPTO leistenlaengeREP b(j):=v(j)OR c(j)PER ;bEND 
+PROC bitleisteallesugruppen;BITLEISTE PROC bitleistegemeinsamesugruppen(
+BITLEISTE CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO 
+leistenlaengeREP b(j):=v(j)AND c(j)PER ;bEND PROC 
+bitleistegemeinsamesugruppen;BOOL PROC gibtesgemeinsamesugruppen(BITLEISTE 
+CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO leistenlaengeREP b
+(j):=v(j)AND c(j);lowbit:=lowestset(b(j));IF lowbit<>-1THEN LEAVE 
+gibtesgemeinsamesugruppenWITH TRUE FI ;PER ;FALSE END PROC 
+gibtesgemeinsamesugruppen;BITLEISTE PROC bitleistenichtgemeinsamesugruppen(
+BITLEISTE CONST v,c):BITLEISTE VAR b:=sugrupurleiste;FOR jFROM 1UPTO 
+leistenlaengeREP b(j):=v(j)XOR c(j)PER ;bEND PROC 
+bitleistenichtgemeinsamesugruppen;PROC sammlebitleisten(TEXT CONST 
+kennungstext,INT CONST richtigepos,BITLEISTE VAR bitleiste):resetbitleiste(
+bitleiste);toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety
+(lvdatei,kennungstext);IF col(lvdatei)=richtigeposCAND NOT eof(lvdatei)THEN 
+bitleiste:=bitleisteallesugruppen(bitleiste,lv1eintrag(lineno(lvdatei)));FI ;
+positionieren;PER .positionieren:col(lvdatei,col(lvdatei)+1).END PROC 
+sammlebitleisten;TEXT PROC jgstzukopplung(TEXT CONST kennungstext):TEXT VAR 
+lv:="";toline(lvdatei,1);col(lvdatei,1);WHILE NOT eof(lvdatei)REP downety(
+lvdatei,kennungstext);IF col(lvdatei)=beginnlvkopplungCAND NOT eof(lvdatei)
+THEN readrecord(lvdatei,lv);LEAVE jgstzukopplungWITH text(lv,laengejgst)FI ;
+positionieren;PER ;"".positionieren:col(lvdatei,col(lvdatei)+1).END PROC 
+jgstzukopplung;TEXT PROC ungueltigesergebnis(TEXT CONST kennung):IF kennung=
+kennunglvTHEN ergebnis:=laengelv*fehlerzeichenELIF kennung=kennungzeitOR 
+kennung=kennungzugelassenezeitTHEN ergebnis:=laengezeit*fehlerzeichenELIF 
+kennung=kennungparapheTHEN ergebnis:=laengeparaphe*fehlerzeichenELIF kennung=
+kennungkopplungTHEN ergebnis:=laengekopplung*fehlerzeichenELIF kennung=
+kennungsugruppeTHEN ergebnis:=laengesugruppe*fehlerzeichenELIF kennung=
+kennungraumOR kennung=kennungwunschraumOR kennung=kennungersatzraumTHEN 
+ergebnis:=laengeraum*fehlerzeichenELIF kennung=kennungwochenstdTHEN ergebnis
+:=laengewochenstd*fehlerzeichenELSE ergebnis:=fehlerzeichenFI ;ergebnisEND 
+PROC ungueltigesergebnis;PROC raumcat(BOOL VAR b):IF wert(fnrschlsachgebiet)=
+dbraeumeTHEN plausiraeumeCAT text(wert(fnrschlschluessel),laengeraum)+trenner
+;ELIF wert(fnrschlsachgebiet)>dbraeumeCOR dbstatus<>0THEN b:=TRUE FI END 
+PROC raumcat;PROC paraphencat(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE 
+plausiparaphenCAT text(wert(dnrlehrer+1),laengeparaphe);plausiparaphenCAT 
+trennerFI END PROC paraphencat;PROC erstelleplausizeiten(BOOL VAR b):IF wert(
+fnrzrsj)>gewschuljCOR wert(fnrzrhj)<>gewhalbjCOR dbstatus<>0THEN b:=TRUE 
+ELSE IF wert(fnrzrkennungteil)=zeitrastersperreTHEN replace(plausizeiten,
+intwert(fnrzrtagstunde),"1")FI ;FI END PROC erstelleplausizeiten;TEXT PROC 
+stuplanzeile(INT CONST zeit):INT VAR std:=konvertierezeit(zeit);TEXT VAR 
+eintrag:="";IF std=0THEN laengestuplaneintrag*fehlerzeichenELSE toline(
+stuplandatei,std);eintrag:="";readrecord(stuplandatei,eintrag);eintragFI END 
+PROC stuplanzeile;BOOL PROC instuplanzeile(TEXT CONST quelle,muster,INT 
+CONST richtigepos,INT VAR findpos):INT VAR suchab:=1,aktpos;WHILE pos(quelle,
+muster,suchab)<>0REP aktpos:=pos(quelle,muster,suchab);IF aktposMOD 
+laengestuplaneintrag=richtigeposTHEN findpos:=aktpos;LEAVE instuplanzeile
+WITH TRUE ELSE suchab:=aktpos+1FI PER ;FALSE END PROC instuplanzeile;INT 
+PROC erstezeileindatei(FILE VAR datei,TEXT CONST muster,INT CONST suchab,
+richtigepos):toline(datei,suchab);col(datei,1);WHILE NOT eof(datei)REP 
+downety(datei,muster);IF col(datei)=richtigeposTHEN LEAVE erstezeileindatei
+WITH lineno(datei)FI ;positionierenPER ;0.positionieren:col(datei,col(datei)+
+1).END PROC erstezeileindatei;PROC schreibeerstellungszeit:INT VAR 
+fehlerstatus;IF NOT exists(stuplandatenraum)THEN stundenplanerstellen(date+
+blank+timeofday,fehlerstatus)FI END PROC schreibeerstellungszeit;INT PROC 
+konvertierezeit(INT CONST tagstd):IF tagstd<1THEN 0ELIF tagstd<=letztestunde
+THEN tagstdELIF tagstd>schultage*100+samstagstdTHEN 0ELIF tagstdMOD 100>
+stdprotagTHEN 0ELIF tagstdMOD 100=0THEN 0ELSE ((tagstdDIV 100)-1)*stdprotag+(
+tagstdMOD 100)FI END PROC konvertierezeit;PROC setzebit(INT CONST bitnr):IF 
+bitnrDIV bits+1>leistenlaengeTHEN LEAVE setzebitFI ;setbit(sugrupleiste(bitnr
+DIV bits+1),bitnrMOD bits)END PROC setzebit;BOOL PROC istjgst(TEXT CONST t):
+pos(klstjgst,trenner+t+trenner)>0END PROC istjgst;BOOL PROC istklgr(TEXT 
+CONST t):pos(plausiklgr,trenner+t+trenner)>0END PROC istklgr;PROC putds(FILE 
+VAR file,TEXT CONST t):insertrecord(file);writerecord(file,t);down(file);END 
+PROC putds;TEXT PROC formatjgst(TEXT CONST t):subtext("0"+compress(text(t,
+laengejgst)),length("0"+compress(text(t,laengejgst)))-1)END PROC formatjgst;
+TEXT PROC lvnulldatenraum:lvnull+gewhalbj+punkt+gewschuljEND PROC 
+lvnulldatenraum;TEXT PROC lveinsdatenraum:lveins+gewhalbj+punkt+gewschuljEND 
+PROC lveinsdatenraum;TEXT PROC sgnulldatenraum:sgnull+gewhalbj+punkt+
+gewschuljEND PROC sgnulldatenraum;TEXT PROC sgeinsdatenraum:sgeins+gewhalbj+
+punkt+gewschuljEND PROC sgeinsdatenraum;TEXT PROC stuplandatenraum:stuplan+
+gewhalbj+punkt+gewschuljEND PROC stuplandatenraum;TEXT PROC bezderlv(TEXT 
+CONST lvzeile):subtext(lvzeile,beginnlvbez,endelvbez)END PROC bezderlv;TEXT 
+PROC kopplungderlv(TEXT CONST lvzeile):subtext(lvzeile,beginnlvkopplung,
+endelvkopplung)END PROC kopplungderlv;TEXT PROC paraphederlv(TEXT CONST 
+lvzeile):subtext(lvzeile,beginnlvparaphe,endelvparaphe)END PROC paraphederlv;
+TEXT PROC wochenstdderlv(TEXT CONST lvzeile):subtext(lvzeile,
+beginnlvwochenstd,endelvwochenstd)END PROC wochenstdderlv;TEXT PROC 
+wunschraumderlv(TEXT CONST lvzeile):subtext(lvzeile,beginnlvraumgr1,
+endelvraumgr1)END PROC wunschraumderlv;TEXT PROC ersatzraumderlv(TEXT CONST 
+lvzeile):subtext(lvzeile,beginnlvraumgr2,endelvraumgr2)END PROC 
+ersatzraumderlv;END PACKET stundenplanschnittstelle
+
diff --git a/app/schulis/2.2.1/src/4.teilstdpl fach lehrer b/app/schulis/2.2.1/src/4.teilstdpl fach lehrer
new file mode 100644
index 0000000..c9b0972
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.teilstdpl fach lehrer
@@ -0,0 +1,124 @@
+PACKET teilstdplfachlehrerDEFINES stdplfachlehrerspezielleteile:LET 
+eingangsmaske="ms teilstdpl fach lehrer",maskenanfpos=2,spaltentrenner=":",
+niltext="",blank=" ",komma=",",null=0,ueberschriftenzeilen=2,ausgkopflaenge=2
+,ausgfeldlaenge=1,anzahlderobjekteprobildschirm=17,spalte1fach=4,
+spalte2paraphe=6,spalte3art=3,spalte4lvs=59,mnrgewaehltezeitenfalsch=397,
+mnrkeinestdplandatenvorhanden=366,mnrauswahlnichtsinnvoll=56,
+mnrbearbeitetwerden=352;TEXT VAR spaltenstrich,stdplfachlehreruebbild,
+stdplfachlehreruebdruck1:=
+"Übersicht über Lehrbefähigte und ihren Stundenplan zu bestimmten Zeiten",
+stdplfachlehreruebdruck2,spaltenueberschrift,anfbuchstabe,neueranfbuchstabe:=
+"",teiltextmeldung1:="die Fächer mit Anfangsbuchstaben: ",teiltextmeldung2:=
+"das Fach: ",angegebenesfach,fach,altesfach,paraphe,art,lehrveranstaltung,
+schuljahr,halbjahr,sjhjaufber;INT VAR status,index:=dnrlehrbefaehigungen,
+eingabestatus,lesestart,bildanfang,druckzeilenzahl,zeit,zaehler;LET 
+maxanzahlzeiten=6;ROW maxanzahlzeitenINT VAR zeiten;BOOL VAR 
+geplantessjgewaehlt,mitscanner,bestfachgewaehlt;LET AUSGFELD =ROW 
+ausgfeldlaengeTEXT ,AUSGKOPF =ROW ausgkopflaengeTEXT ;AUSGFELD VAR ausgfeld;
+AUSGKOPF VAR ausgkopf;BOOL PROC multistop:BOOL VAR a;IF bestfachgewaehltTHEN 
+a:=wert(fnrlbfach)=angegebenesfachAND dbstatus=okELSE a:=dbstatus=0FI ;aEND 
+PROC multistop;BOOL PROC multistopsim:setzebestandende(FALSE );BOOL VAR b:=
+multistop;setzebestandende(NOT b);bEND PROC multistopsim;PROC 
+stdplfachlehrerspezielleteile(INT CONST nr):SELECT nrOF CASE 1:
+stdplfachlehrerdialogvorbereitenCASE 2:stdplfachlehrereingabenrichtigCASE 3:
+stdplfachlehrerlistenvorbereitenCASE 4:stdplfachlehrerdruckvorbereitenCASE 5:
+stdplfachlehrerseitedruckenCASE 6:stdplfachlehrerbildschirmvorbereitenCASE 7:
+stdplfachlehrerseitezeigenENDSELECT .END PROC stdplfachlehrerspezielleteile;
+PROC stdplfachlehrerdialogvorbereiten:stdplfachlehreruebbild:=text(
+vergleichsknoten);setzeanfangswerte(eingangsmaske,maskenanfpos);END PROC 
+stdplfachlehrerdialogvorbereiten;PROC stdplfachlehrereingabenrichtig:LET 
+fnrfach=2,fnrakthj=69,fnrgeplhj=70,fnrausgbild=71,fnrausgdruck=72;
+standardpruefe(5,fnrausgbild,fnrausgdruck,null,niltext,status);IF status<>0
+THEN infeld(status);setzeeingabetest(FALSE )ELSE standardpruefe(5,fnrakthj,
+fnrgeplhj,null,niltext,status);IF status<>0THEN infeld(status);
+setzeeingabetest(FALSE )ELSE IF NOT anzahldergewaehltenzeitenkorrektTHEN 
+infeld(3);standardmeldung(mnrgewaehltezeitenfalsch,niltext);setzeeingabetest(
+FALSE )ELSE spaltenstrich:="----+------+---+";spaltenstrichCAT zeit*
+"--------+";parametersetzen;IF NOT stundenplandatenvorhandenTHEN infeld(
+fnrakthj);standardmeldung(mnrkeinestdplandatenvorhanden,niltext);
+setzeeingabetest(FALSE )ELSE setzeausgabedrucker(standardmaskenfeld(
+fnrausgbild)=niltext);setzeeingabetest(TRUE )FI ;FI ;FI ;FI .
+anzahldergewaehltenzeitenkorrekt:INT VAR unterrichtsstd,std;zeit:=0;
+spaltenueberschrift:="Fach Lehrer Art ";FOR stdFROM 3UPTO 68REP IF 
+standardmaskenfeld(std)<>niltextTHEN zeitINCR 1;IF zeit<=maxanzahlzeitenTHEN 
+unterrichtsstd:=std-2;zeiten(zeit):=unterrichtsstd;
+spaltenueberschriftweiterzusammenbauen(unterrichtsstd);FI ;FI ;PER ;zeit<=
+maxanzahlzeitenAND zeit>0.parametersetzen:angegebenesfach:=standardmaskenfeld
+(fnrfach);bestfachgewaehlt:=angegebenesfach<>niltext;mitscanner:=
+bestfachgewaehlt;geplantessjgewaehlt:=standardmaskenfeld(fnrakthj)=niltext;
+schuljahr:=schulkenndatum("Schuljahr");halbjahr:=schulkenndatum(
+"Schulhalbjahr");IF geplantessjgewaehltTHEN geplanteshjundsjberechnen(
+halbjahr,schuljahr);FI ;sjhjaufber:=subtext(schuljahr,1,2)+"/";sjhjaufberCAT 
+subtext(schuljahr,3,4)+komma+blank;sjhjaufberCAT halbjahr;.
+stundenplandatenvorhanden:stundenplanhalbjahrsetzen(halbjahr,schuljahr);
+stundenplanbasisundstundenplanholen(eingabestatus);eingabestatus=0END PROC 
+stdplfachlehrereingabenrichtig;PROC spaltenueberschriftweiterzusammenbauen(
+INT VAR unterrichtsstd):INT VAR x;TEXT VAR hilfstext;x:=(unterrichtsstd-1)
+DIV 12;IF x=0THEN hilfstext:="Mo "ELIF x=1THEN hilfstext:="Di "ELIF x=2THEN 
+hilfstext:="Mi "ELIF x=3THEN hilfstext:="Do "ELIF x=4THEN hilfstext:="Fr "
+ELSE hilfstext:="Sa "FI ;x:=unterrichtsstdMOD 12;IF x=0THEN hilfstextCAT 
+"12   "ELSE hilfstextCAT text(x,2)+4*blankFI ;spaltenueberschriftCAT 
+hilfstext;END PROC spaltenueberschriftweiterzusammenbauen;PROC 
+stdplfachlehrerlistenvorbereiten:BOOL VAR b;altesfach:=niltext;inittupel(
+dnrlehrbefaehigungen);initspalten;setzeidentiwert("");initobli(
+anzahlderobjekteprobildschirm);putwert(fnrlbfach,angegebenesfach);IF 
+bestfachgewaehltTHEN objektlistestarten(index,angegebenesfach,fnrlbparaphe,
+TRUE ,b)ELSE objektlistestarten(index,angegebenesfach,0,TRUE ,b);FI ;
+setzebestandende(NOT multistopCOR b);END PROC 
+stdplfachlehrerlistenvorbereiten;PROC stdplfachlehrerbildschirmvorbereiten:
+LET fnrausganf=2;standardkopfmaskeaktualisieren(stdplfachlehreruebbild);
+bildanfang:=fnrausganf;setzebildanfangsposition(bildanfang);
+setzespaltenbreite(bildbreite);spaltenweise(spaltenueberschrift);ausgfeld(1)
+:=zeile;ausgfeld(1)IN ausgabepos;erhoeheausgabeposumeins;spaltenweise(
+spaltenstrich);ausgfeld(1):=zeile;ausgfeld(1)IN ausgabepos;
+erhoeheausgabeposumeins;setzebildanfangsposition(4);spaltenbreitensetzen;END 
+PROC stdplfachlehrerbildschirmvorbereiten;PROC spaltenbreitensetzen:
+initspalten;setzespaltentrenner(spaltentrenner);setzespaltenbreite(
+spalte1fach);setzespaltenbreite(spalte2paraphe);setzespaltenbreite(spalte3art
+);setzespaltenbreite(spalte4lvs);END PROC spaltenbreitensetzen;PROC 
+stdplfachlehrerseitezeigen:altesfach:=niltext;blaettern(PROC (INT CONST )
+teilstdplfachlehrerzeigen,aktion,TRUE ,mitscanner,BOOL PROC multistop);END 
+PROC stdplfachlehrerseitezeigen;PROC teilstdplfachlehrerzeigen(INT CONST x):
+datenauslehrbefundstdplholen;datenauslehrbefundstdplaufbereitenbild;
+datenauslehrbefundstdplaufbildschirmEND PROC teilstdplfachlehrerzeigen;PROC 
+datenauslehrbefundstdplholen:TEXT VAR lv,raum,par;lehrveranstaltung:=niltext;
+paraphe:=wert(fnrlbparaphe);art:=wert(fnrlbart);fach:=wert(fnrlbfach);FOR 
+zaehlerFROM 1UPTO zeitREP planeintraglesen(zeiten(zaehler),"P",paraphe,lv,
+raum,par);lehrveranstaltungCAT text(lv,8)+spaltentrennerPER ;END PROC 
+datenauslehrbefundstdplholen;PROC datenauslehrbefundstdplaufbereitenbild:IF 
+altesfach<>fachTHEN spaltenweise(fach);altesfach:=fach;ELSE spaltenweise(
+blank);FI ;spaltenweise(paraphe);spaltenweise(art);spaltenweise(
+lehrveranstaltung)END PROC datenauslehrbefundstdplaufbereitenbild;PROC 
+datenauslehrbefundstdplaufbildschirm:INT VAR i;FOR iFROM 1UPTO ausgfeldlaenge
+REP ausgfeld(i):=zeile;ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeins;PER ;
+END PROC datenauslehrbefundstdplaufbildschirm;PROC 
+stdplfachlehrerdruckvorbereiten:setzebestandende(FALSE );anfbuchstabe:=" ";
+druckvorbereiten;druckzeilenzahl:=drucklaenge(ueberschriftenzeilen)-
+ausgkopflaenge;stdplfachlehreruebdruck2:="Schulhalbjahr ";
+stdplfachlehreruebdruck2CAT sjhjaufber;stdplfachlehreruebdruck2CAT 
+". Halbjahr";initdruckkopf(stdplfachlehreruebdruck1,stdplfachlehreruebdruck2)
+;inittupel(index);putwert(fnrlbfach,angegebenesfach);lesenvorbereitendruck(
+PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL PROC multistop);
+setzebestandende(NOT multistop)END PROC stdplfachlehrerdruckvorbereiten;PROC 
+stdplfachlehrerseitedrucken:druckkopfschreiben;initspalten;setzespaltenbreite
+(bildbreite);spaltenweise(spaltenueberschrift);ausgfeld(1):=zeile;ausgfeld(1)
+IN ausgabepos;druckzeileschreiben(ausgfeld(1));spaltenweise(spaltenstrich);
+ausgfeld(1):=zeile;druckzeileschreiben(ausgfeld(1));spaltenbreitensetzen;
+altesfach:=niltext;seitedrucken(PROC (INT VAR )stdplfachlehrerdrucken,
+druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);seitenwechsel;END 
+PROC stdplfachlehrerseitedrucken;PROC stdplfachlehrerdrucken(INT VAR 
+zeilenzaehler):LET markiert="#";datenauslehrbefundstdplholen;
+ggflmeldunganfbuchstabe;stdplfachlehreraufbereitendruck;zeilenzaehlerINCR 
+ausgfeldlaenge;stdplfachlehrerindruckdatei.ggflmeldunganfbuchstabe:IF 
+anfbuchstabegeaendertTHEN meldunganfbuchstabeFI .anfbuchstabegeaendert:
+neueranfbuchstabe:=fachSUB 1;anfbuchstabe<>neueranfbuchstabe.
+meldunganfbuchstabe:IF bestfachgewaehltTHEN standardmeldung(
+mnrbearbeitetwerden,teiltextmeldung2+fach+markiert);ELSE standardmeldung(
+mnrbearbeitetwerden,teiltextmeldung1+neueranfbuchstabe+markiert);FI ;
+anfbuchstabe:=neueranfbuchstabeEND PROC stdplfachlehrerdrucken;PROC 
+stdplfachlehreraufbereitendruck:datenauslehrbefundstdplaufbereitenbild;
+ausgfeld(1):=zeile;END PROC stdplfachlehreraufbereitendruck;PROC 
+stdplfachlehrerindruckdatei:INT VAR i;FOR iFROM 1UPTO ausgfeldlaengeREP 
+druckzeileschreiben(ausgfeld(1))PER .END PROC stdplfachlehrerindruckdatei;
+END PACKET teilstdplfachlehrer
+
diff --git a/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten b/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten
new file mode 100644
index 0000000..2733d0d
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.uv und kopplungen bearbeiten
@@ -0,0 +1,319 @@
+PACKET uvundkopplungenbearbeitenDEFINES uvukstdvproc,uvukspeichern,uvuklisten
+,uvukvorjparaphe,uvukpruefbearb:LET ausknr=746,auskende="*",ra="c02 raeume",
+sj="Schuljahr",hj="Schulhalbjahr",eingmaske="ms eing uv und kopplungen",
+bearbmaske="ms bearb uv und kopplungen",kennzeichnungakt="aktuell",
+kennzeichnunggepl="geplant",ausgparam="#",leereparaphe="",trenner="�",bearbzl
+=18,letztesfld=163,anzeingfld=10,laengekopplung=8,laengejgst=2,laengefach=2,
+krlvjgst=2,fldjgst=3,krlvfa=4,fldfa=5,krlvkopp=6,fldkopp=7,krlvpar=8,fldpar=9
+,fldjahr=10,meldg0=56,meldg1=325,meldg2=326,meldg3=69,meldg4=60,meldg6=305,
+meldg7=355,meldg8=353,meldg9=354,meldg11=149,meldg12=142,meldg13=50,meldg14=
+63,meldg15=327,meldg16=328,meldg17=329,meldg18=360,meldg19=318,meldg20=310,
+meldg21=387,meldg22=388,meldg23=352;ROW anzeingfldTEXT VAR eingbs;ROW bearbzl
+STRUCT (TEXT kopplg,fakenn,lehrer,ROW 4TEXT klgr,ROW 2TEXT rgr)VAR dbinh;INT 
+VAR i,k,z,zz,letztepos:=2,index:=0,fall:=0,aktpos,suchpos,anzdbsaetze;INT 
+VAR aktzeile,jgst,fachsoll,fachist,lehrersoll,lehrerist,lehrerimfach;TEXT 
+VAR lv,sicherungstupel,allefaecher,fachbez,fachgrbez,fach,paraphe,
+lehrbeflehrer,liste;TEXT VAR klgrkatalog,jgstkatalog,rgrkatalog,lehrv:="",
+fachkatalog:="",klgrpruefkatalog,parkatalog,sollstdkatalog,aktschgrkatalog,
+geplschgrkatalog;TEXT VAR schj,schhj:="0",aktschhj:="0",aktschj:="0",
+geplschhj:="0",geplschj:="0",aenderungskennzeichen:="";TEXT VAR plausikopp,
+plausipa,plausilv,jgstsugrp,plausijgst;TEXT VAR kopplung,lvfake,lehrer,sgr1,
+sgr2,sgr3,sgr4,rgr1,rgr2,maskenkopf;BOOL VAR istfehler:=FALSE ,
+koppparnichtgeprueft:=TRUE ,saetzeunveraendert:=TRUE ,ohnefehler:=TRUE ;PROC 
+holeakthj:aktschhj:=schulkenndatum(hj);aktschj:=schulkenndatum(sj);geplschhj
+:=aktschhj;geplschj:=aktschj;geplanteshjundsjberechnen(geplschhj,geplschj)
+END PROC holeakthj;PROC holeaktdatenpruefung:i:=100;statleseschleife(
+dnrfaecher,"","",fnrffach,fnrffach,PROC spezcat);i:=103;statleseschleife(
+dnrlehrer,"","",fnrlparaphe,fnrlparaphe,PROC spezcat);END PROC 
+holeaktdatenpruefung;PROC holeaktdatenspeicherung:i:=101;statleseschleife(
+dnrklassengruppen,"","",fnrkgklassengrp,fnrkgklassengrp,PROC spezcat);i:=102;
+statleseschleife(dnrraumgruppen,"","",fnrrgraumgrp,fnrrgraumgrp,PROC spezcat)
+;i:=104;statleseschleife(dnrschluessel,ra,"",fnrschlsachgebiet,
+fnrschlschluessel,PROC spezcat);i:=105;statleseschleife(dnraktschuelergruppen
+,"","",fnrsgrpsj,fnrsgrphj,PROC spezcat);i:=106;statleseschleife(
+dnraktschuelergruppen,"","",fnrsgrpsj,fnrsgrphj,PROC spezcat);END PROC 
+holeaktdatenspeicherung;PROC initrows:IF fachkatalog=""THEN fachkatalog:=
+trenner;klgrkatalog:=trenner;klgrpruefkatalog:=trenner;jgstkatalog:=
+"�5�05�6�06�7�07�8�08�";jgstkatalogCAT "9�09�10�11�12�13�0�00�";
+aktschgrkatalog:=trenner;geplschgrkatalog:=trenner;rgrkatalog:=trenner;
+parkatalog:=trenner;sollstdkatalog:=trenner;FOR iFROM 1UPTO anzeingfldREP 
+eingbs(i):=""PER ;FOR iFROM 1UPTO bearbzlREP dbinh(i).kopplg:="";dbinh(i).
+fakenn:="";dbinh(i).lehrer:="";dbinh(i).klgr(1):="";dbinh(i).klgr(2):="";
+dbinh(i).klgr(3):="";dbinh(i).klgr(4):="";dbinh(i).rgr(1):="";dbinh(i).rgr(2)
+:="";PER ;FI END PROC initrows;PROC uvukpruefbearb:standardmeldung(meldg3," "
+);IF schhj="0"THEN holeakthjFI ;merkeeingsch;istfehler:=FALSE ;gibteskennz;
+stellejahrfest;putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putintwert(
+fnrlvjgst,0);putwert(fnrlvfachkennung,"");search(dnrlehrveranstaltungen,
+FALSE );IF dbstatus<>okCAND wert(fnrlvsj)<>schjCAND wert(fnrlvhj)<>schhjTHEN 
+dateileerFI ;pruefung;erfasstelvausgeben;standardnproc.gibteskennz:letztepos
+:=2;IF eingbs(krlvjgst)<>""THEN fall:=2;LEAVE gibteskennzELIF eingbs(krlvfa)
+<>""THEN fall:=4;LEAVE gibteskennzELIF eingbs(krlvkopp)<>""THEN fall:=6;
+LEAVE gibteskennzELIF eingbs(krlvpar)<>""THEN fall:=8;LEAVE gibteskennzELSE 
+zurueckmitmeldg(meldg0,1,letztepos,"");LEAVE uvukpruefbearbFI ;IF eingbs(fall
++1)<>""THEN letztepos:=fall+1ELSE letztepos:=fallFI .stellejahrfest:IF eingbs
+(fldjahr)=""THEN schhj:=geplschhj;schj:=geplschj;aenderungskennzeichen:=
+kennzeichnunggeplELSE schhj:=aktschhj;schj:=aktschj;aenderungskennzeichen:=
+kennzeichnungaktFI .pruefung:IF fachkatalog=trennerTHEN holeaktdatenpruefung
+FI ;prueferest(fall);IF istfehlerTHEN zurueckmitmeldg(meldg0,1,letztepos,"");
+LEAVE uvukpruefbearbFI ;IF fall=2THEN IF eingbs(fldjgst)<>""THEN pruefejgst;
+FI ;index:=dnrlehrveranstaltungen;ELIF fall=4THEN pruefedbfld(eingbs(fldfa),
+fachkatalog,fldfa);index:=ixlvsjhjkennELIF fall=6THEN pruefekopplungsnr;index
+:=ixlvsjhjkopp;ELSE pruefedbfld(eingbs(fldpar),parkatalog,fldpar);index:=
+ixlvsjhjparFI ;IF istfehlerTHEN LEAVE uvukpruefbearbFI .pruefekopplungsnr:
+putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putwert(fnrlvkopplung,eingbs(
+fldkopp));search(ixlvsjhjkopp);IF dbstatus=1COR dbstatus=3THEN 
+koppnichtgefundenFI .koppnichtgefunden:zurueckmitmeldg(meldg1,1,fldkopp,"");
+LEAVE uvukpruefbearb.dateileer:zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE 
+uvukpruefbearb.END PROC uvukpruefbearb;PROC prueferest(INT CONST feldnr):FOR 
+iFROM 2UPTO feldnr-1REP IF eingbs(i)<>""THEN fehlerFI PER ;FOR iFROM feldnr+2
+UPTO 9REP IF eingbs(i)<>""THEN fehlerFI PER .fehler:istfehler:=TRUE ;
+letztepos:=i;LEAVE prueferest.END PROC prueferest;PROC pruefejgst:IF compress
+(eingbs(fldjgst))="0"COR eingbs(fldjgst)="00"THEN LEAVE pruefejgstELIF int(
+eingbs(fldjgst))>4CAND int(eingbs(fldjgst))<14THEN LEAVE pruefejgstELSE 
+zurueckmitmeldg(meldg6,1,fldjgst,"");istfehler:=TRUE ;FI .END PROC pruefejgst
+;PROC pruefedbfld(TEXT CONST objekt,katalog,INT CONST feld):plausijgst:=text(
+standardmaskenfeld(i*9-6),2);IF objekt=""THEN LEAVE pruefedbfldELIF katalog=
+jgstkatalogTHEN IF pos(jgstkatalog,trenner+objekt+trenner)=0THEN 
+pruefeaufschuelergruppeELSE pruefejgstenFI ;ELIF pos(katalog,trenner+objekt+
+trenner)=0THEN istfehler:=TRUE ;IF katalog=fachkatalogTHEN zurueckmitmeldg(
+meldg11,1,feld,objekt+"#")ELIF katalog=parkatalogTHEN zurueckmitmeldg(meldg12
+,1,feld,objekt+"#")ELIF katalog=rgrkatalogTHEN zurueckmitmeldg(meldg16,1,feld
+,objekt+"#")FI FI .pruefeaufschuelergruppe:IF eingbs(fldjahr)<>""THEN IF pos(
+aktschgrkatalog,trenner+text(int(plausijgst))+objekt+trenner)<>0THEN LEAVE 
+pruefedbfldELSE pruefeaufklgrFI ELIF pos(geplschgrkatalog,trenner+text(int(
+plausijgst))+objekt+trenner)<>0THEN LEAVE pruefedbfldELSE pruefeaufklgrFI .
+pruefeaufklgr:IF pos(klgrkatalog,trenner+objekt+trenner)>0THEN IF 
+jgstnichtnullTHEN pruefejgstinklgrFI ELSE istfehler:=TRUE ;zurueckmitmeldg(
+meldg15,1,feld,objekt+"#")FI .pruefejgsten:IF int(plausijgst)<>int(objekt)
+CAND int(plausijgst)<>0THEN istfehler:=TRUE ;zurueckmitmeldg(meldg9,1,feld,
+objekt+"#"+plausijgst+"#");FI .jgstnichtnull:plausijgst<>"00".
+pruefejgstinklgr:zz:=0;jgstsugrp:="";zz:=pos(klgrpruefkatalog,trenner+objekt+
+trenner)+length(objekt)+2;jgstsugrp:=subtext(klgrpruefkatalog,zz,pos(
+klgrpruefkatalog,trenner,zz)-1);FOR zzFROM 1UPTO length(jgstsugrp)DIV 2REP 
+IF subtext(jgstsugrp,zz*2-1,zz*2)<>plausijgstTHEN istfehler:=TRUE ;
+zurueckmitmeldg(meldg9,1,feld,objekt+"#"+plausijgst+"#");LEAVE pruefedbfldFI 
+PER ;END PROC pruefedbfld;PROC pruefekopplgpar(TEXT CONST kopp,lv,pa,INT 
+CONST feldnr):plausikopp:=kopp;plausipa:=pa;plausilv:=lv;pruefeindb;
+pruefeaufbs.pruefeindb:istfehler:=FALSE ;inittupel(dnrlehrveranstaltungen);
+putwert(fnrlvkopplung,plausikopp);z:=feldnr;statleseschleife(ixlvsjhjkopp,
+schj,schhj,fnrlvsj,fnrlvhj,PROC suchekopplungen);IF istfehlerTHEN infeld(
+feldnr);LEAVE pruefekopplgparFI .pruefeaufbs:INT VAR z;FOR zFROM 1UPTO i-1
+REP IF plausikopp=standardmaskenfeld(z*9-7)THEN IF plausipa=
+standardmaskenfeld(z*9-5)THEN istfehler:=TRUE ;zurueckmitmeldg(meldg8,1,
+feldnr,plausipa+"#"+plausikopp+"#"+text(standardmaskenfeld(z*9-6),2)+dbinh(z)
+.fakenn+"#");LEAVE pruefekopplgparFI ;FI ;PER ;FOR zFROM i+1UPTO bearbzlREP 
+IF plausikopp=standardmaskenfeld(z*9-7)THEN IF plausipa=standardmaskenfeld(z*
+9-5)THEN istfehler:=TRUE ;zurueckmitmeldg(meldg8,1,feldnr,plausipa+"#"+
+plausikopp+"#"+text(standardmaskenfeld(z*9-6),2)+dbinh(z).fakenn+"#");LEAVE 
+pruefekopplgparFI ;FI ;PER .END PROC pruefekopplgpar;PROC suchekopplungen(
+BOOL VAR b):IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND wert(
+fnrlvkopplung)=plausikoppCAND dbstatus=0THEN ueberpruefeparapheELSE b:=TRUE 
+FI .ueberpruefeparaphe:IF wert(fnrlvparaphe)=plausipaCAND nichtplausilvTHEN 
+istfehler:=TRUE ;zurueckmitmeldg(meldg8,1,z,plausipa+"#"+plausikopp+"#"+
+formattext(wert(fnrlvjgst))+wert(fnrlvfachkennung)+"#");b:=TRUE ;LEAVE 
+suchekopplungenFI .nichtplausilv:formattext(wert(fnrlvjgst))<>text(plausilv,2
+)COR wert(fnrlvfachkennung)<>dbinh(i).fakenn.END PROC suchekopplungen;PROC 
+zurueckmitmeldg(INT CONST meldg,ruecksprung,feld,TEXT CONST markiert):IF 
+ruecksprung>0THEN return(ruecksprung)FI ;standardmeldung(meldg,markiert);IF 
+feld>0THEN infeld(feld)FI END PROC zurueckmitmeldg;PROC uvukstdvproc:initrows
+;fachbez:=trenner;fachgrbez:=trenner;gibeingschaus;standardnproc.END PROC 
+uvukstdvproc;PROC gibeingschaus:standardstartproc(eingmaske);gibeingbsaus;
+standardfelderausgeben;infeld(letztepos).gibeingbsaus:FOR iFROM 2UPTO 
+anzeingfldREP standardmaskenfeld(eingbs(i),i);IF eingbs(i)<>""THEN letztepos
+:=iFI PER .END PROC gibeingschaus;PROC erfasstelvausgeben:anzdbsaetze:=0;k:=1
+;pruefobsaetzevorhanden;loeschefelder;maskenkopf:=text(vergleichsknoten)+" "+
+schhj+"."+" "+subtext(schj,1,2)+"/"+subtext(schj,3);standardstartproc(
+bearbmaske);standardkopfmaskeaktualisieren(maskenkopf);startebildschirmblock(
+index,bearbzl-1);bildschirmblock(PROC gibbearbzeileaus,BOOL PROC (INT CONST )
+pruefung,i);standardfelderausgeben;infeld(2).pruefobsaetzevorhanden:putwert(
+fnrlvsj,schj);putwert(fnrlvhj,schhj);putintwert(fnrlvjgst,int(eingbs(fldjgst)
+));putwert(fnrlvfachkennung,eingbs(fldfa));putwert(fnrlvkopplung,eingbs(
+fldkopp));putwert(fnrlvparaphe,eingbs(fldpar));search(index,FALSE );IF 
+dbstatus<>okTHEN zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE 
+erfasstelvausgebenELSE pruefobsatzrichtigFI .pruefobsatzrichtig:IF wert(
+fnrlvsj)=schjCAND wert(fnrlvhj)=schhjTHEN IF fall=1CAND eingbs(fldjgst)<>""
+CAND intwert(fnrlvjgst)<>int(eingbs(fldjgst))THEN gibfehlerausELIF fall=2
+CAND eingbs(fldfa)<>""CAND text(wert(fnrlvfachkennung),2)<>eingbs(fldfa)THEN 
+gibfehlerausELIF fall=3CAND eingbs(fldkopp)<>""CAND wert(fnrlvkopplung)<>
+eingbs(fldkopp)THEN gibfehlerausELIF fall=4CAND eingbs(fldpar)<>""CAND wert(
+fnrlvparaphe)<>eingbs(fldpar)THEN gibfehlerausFI ELSE gibfehlerausFI .
+gibfehleraus:zurueckmitmeldg(meldg2,1,letztepos,"");LEAVE erfasstelvausgeben.
+END PROC erfasstelvausgeben;PROC loeschefelder:FOR iFROM 1UPTO bearbzlREP 
+dbinh(i).kopplg:="";dbinh(i).fakenn:="";dbinh(i).lehrer:="";dbinh(i).klgr(1)
+:="";dbinh(i).klgr(2):="";dbinh(i).klgr(3):="";dbinh(i).klgr(4):="";dbinh(i).
+rgr(1):="";dbinh(i).rgr(2):="";PER ;FOR iFROM 2UPTO letztesfldREP 
+standardmaskenfeld("",i)PER .END PROC loeschefelder;PROC gibbearbzeileaus:
+kopplung:=wert(fnrlvkopplung);lvfake:=wert(fnrlvfachkennung);lehrer:=wert(
+fnrlvparaphe);sgr1:=wert(fnrlvklgrp1);sgr2:=wert(fnrlvklgrp2);sgr3:=wert(
+fnrlvklgrp3);sgr4:=wert(fnrlvklgrp4);rgr1:=wert(fnrlvraumgrp1);rgr2:=wert(
+fnrlvraumgrp2);merkdbwerte;lehrv:=formattext(wert(fnrlvjgst))+text(lvfake,2)+
+text(subtext(lvfake,3),4)+text(intwert(fnrlvwochenstd),2);standardmaskenfeld(
+kopplung,k*9-7);standardmaskenfeld(lehrv,k*9-6);standardmaskenfeld(lehrer,k*9
+-5);standardmaskenfeld(sgr1,k*9-4);standardmaskenfeld(sgr2,k*9-3);
+standardmaskenfeld(sgr3,k*9-2);standardmaskenfeld(sgr4,k*9-1);
+standardmaskenfeld(rgr1,k*9);standardmaskenfeld(rgr2,k*9+1);IF k<bearbzlTHEN 
+kINCR 1FI .merkdbwerte:dbinh(k).kopplg:=kopplung;dbinh(k).fakenn:=lvfake;
+dbinh(k).lehrer:=lehrer;dbinh(k).klgr(1):=sgr1;dbinh(k).klgr(2):=sgr2;dbinh(k
+).klgr(3):=sgr3;dbinh(k).klgr(4):=sgr4;dbinh(k).rgr(1):=rgr1;dbinh(k).rgr(2)
+:=rgr2;anzdbsaetzeINCR 1.END PROC gibbearbzeileaus;BOOL PROC pruefung(INT 
+CONST notwprocparam):schhj=wert(fnrlvhj)CAND schj=wert(fnrlvsj)END PROC 
+pruefung;PROC merkeeingsch:FOR iFROM 2UPTO anzeingfldREP eingbs(i):=
+standardmaskenfeld(i)PER ;END PROC merkeeingsch;TEXT PROC formattext(TEXT 
+CONST jgst):IF int(jgst)<10CAND jgst<>"00"THEN LEAVE formattextWITH "0"+jgst
+FI ;jgstEND PROC formattext;PROC uvukspeichern(BOOL CONST speichern):IF 
+speichernTHEN speicherdaten;naechsterbildschirmELSE zurueckmitmeldg(meldg14,0
+,1,"");naechsterbildschirmFI .speicherdaten:saetzeunveraendert:=TRUE ;IF 
+aktschgrkatalog=trennerTHEN holeaktdatenspeicherungFI ;zurueckmitmeldg(
+meldg17,0,1,"");FOR iFROM 1UPTO anzdbsaetzeREP kopplung:=standardmaskenfeld(i
+*9-7);lehrer:=standardmaskenfeld(i*9-5);sgr1:=standardmaskenfeld(i*9-4);sgr2
+:=standardmaskenfeld(i*9-3);sgr3:=standardmaskenfeld(i*9-2);sgr4:=
+standardmaskenfeld(i*9-1);rgr1:=standardmaskenfeld(i*9);rgr2:=
+standardmaskenfeld(i*9+1);IF satzgeaendertTHEN infeld(i*9-7);pruefedaten;FI 
+PER ;zurueckmitmeldg(meldg13,0,1,"");FOR iFROM 1UPTO anzdbsaetzeREP kopplung
+:=standardmaskenfeld(i*9-7);lehrer:=standardmaskenfeld(i*9-5);sgr1:=
+standardmaskenfeld(i*9-4);sgr2:=standardmaskenfeld(i*9-3);sgr3:=
+standardmaskenfeld(i*9-2);sgr4:=standardmaskenfeld(i*9-1);rgr1:=
+standardmaskenfeld(i*9);rgr2:=standardmaskenfeld(i*9+1);IF satzgeaendertTHEN 
+IF saetzeunveraendertTHEN saetzeunveraendert:=FALSE FI ;infeld(i*9-7);
+speicheraenderungenFI PER ;IF NOT saetzeunveraendertTHEN 
+aenderungsvermerksetzen(aenderungskennzeichen)FI .satzgeaendert:kopplung<>
+dbinh(i).kopplgCOR lehrer<>dbinh(i).lehrerCOR sgr1<>dbinh(i).klgr(1)COR sgr2
+<>dbinh(i).klgr(2)COR sgr3<>dbinh(i).klgr(3)COR sgr4<>dbinh(i).klgr(4)COR 
+rgr1<>dbinh(i).rgr(1)COR rgr2<>dbinh(i).rgr(2).pruefedaten:istfehler:=FALSE ;
+koppparnichtgeprueft:=TRUE ;IF kopplung<>dbinh(i).kopplgTHEN 
+pruefekopplungsnrFI ;IF lehrer<>dbinh(i).lehrerCAND lehrer<>leereparapheTHEN 
+pruefelehrerFI ;IF sgr1<>dbinh(i).klgr(1)COR sgr2<>dbinh(i).klgr(2)COR sgr3<>
+dbinh(i).klgr(3)COR sgr4<>dbinh(i).klgr(4)THEN pruefeklassenFI ;IF rgr1<>
+dbinh(i).rgr(1)COR rgr2<>dbinh(i).rgr(2)THEN prueferaeumeFI .
+pruefekopplungsnr:IF kopplung=""THEN istfehler:=TRUE ;zurueckmitmeldg(meldg7,
+1,i*9-7,"");LEAVE uvukspeichernELIF length(kopplung)>laengekopplungTHEN 
+istfehler:=TRUE ;zurueckmitmeldg(meldg4,1,i*9-7,"");LEAVE uvukspeichernELSE 
+koppparnichtgeprueft:=FALSE ;IF lehrer<>leereparapheTHEN pruefekopplgpar(
+kopplung,standardmaskenfeld(i*9-6),lehrer,i*9-7);abfragefehlerFI FI .
+pruefelehrer:pruefedbfld(lehrer,parkatalog,i*9-5);abfragefehler;IF 
+koppparnichtgeprueftTHEN pruefekopplgpar(kopplung,standardmaskenfeld(i*9-6),
+lehrer,i*9-5);abfragefehlerFI .pruefeklassen:IF sgr1<>dbinh(i).klgr(1)THEN 
+pruefedbfld(sgr1,jgstkatalog,i*9-4);abfragefehlerFI ;IF sgr2<>dbinh(i).klgr(2
+)THEN pruefedbfld(sgr2,jgstkatalog,i*9-3);abfragefehlerFI ;IF sgr3<>dbinh(i).
+klgr(3)THEN pruefedbfld(sgr3,jgstkatalog,i*9-2);abfragefehlerFI ;IF sgr4<>
+dbinh(i).klgr(4)THEN pruefedbfld(sgr4,jgstkatalog,i*9-1);abfragefehlerFI .
+prueferaeume:pruefedbfld(rgr1,rgrkatalog,i*9);abfragefehler;pruefedbfld(rgr2,
+rgrkatalog,i*9+1);abfragefehler.abfragefehler:IF istfehlerTHEN LEAVE 
+uvukspeichernFI .speicheraenderungen:putwert(fnrlvsj,schj);putwert(fnrlvhj,
+schhj);putintwert(fnrlvjgst,int(text(standardmaskenfeld(i*9-6),2)));putwert(
+fnrlvfachkennung,dbinh(i).fakenn);search(dnrlehrveranstaltungen,TRUE );IF 
+dbstatus=0THEN aktualisierenFI .aktualisieren:putwert(fnrlvkopplung,kopplung)
+;putwert(fnrlvparaphe,lehrer);putwert(fnrlvklgrp1,sgr1);putwert(fnrlvklgrp2,
+sgr2);putwert(fnrlvklgrp3,sgr3);putwert(fnrlvklgrp4,sgr4);putwert(
+fnrlvraumgrp1,rgr1);putwert(fnrlvraumgrp2,rgr2);update(dnrlehrveranstaltungen
+).naechsterbildschirm:IF anzdbsaetze<bearbzlTHEN enter(2);LEAVE uvukspeichern
+FI ;k:=1;putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putintwert(fnrlvjgst,
+int(text(lehrv,2)));putwert(fnrlvfachkennung,dbinh(anzdbsaetze).fakenn);
+search(dnrlehrveranstaltungen,TRUE );changeindex;succ(index);loeschefelder;
+IF dbstatus<>okTHEN enter(2)ELSE anzdbsaetze:=0;
+standardkopfmaskeaktualisieren(maskenkopf);startebildschirmblock(index,
+bearbzl-1);bildschirmblock(PROC gibbearbzeileaus,BOOL PROC (INT CONST )
+pruefung,i);infeld(1);standardfelderausgeben;infeld(2);return(1)FI .END PROC 
+uvukspeichern;PROC uvuklisten:INT VAR aktfeld:=infeld;WINDOW VAR w:=
+startwindow(42,23,77,1);liste:="";standardmeldung(meldg3,"");aktzeile:=(
+aktfeld-2)DIV 9+1;jgst:=int(text(standardmaskenfeld(aktzeile*9-6),laengejgst)
+);lv:=text(dbinh(aktzeile).fakenn,laengefach);sicherdbposition;
+berechnefachdaten;bereitelisteauf;giballelehreraus;listeCAT "*";listeCAT 
+auskunftstextende;erstelledbposition;IF menuedraussenTHEN reorganizescreenFI 
+;open(w);auskunfterteilung(liste,w,FALSE );reorganizescreen;setlasteditvalues
+;return(1).sicherdbposition:savetupel(index,sicherungstupel);.
+erstelledbposition:restoretupel(index,sicherungstupel).berechnefachdaten:
+allefaecher:=trenner;inittupel(dnrfaecher);putwert(fnrffach,compress(lv));
+search(dnrfaecher,TRUE );IF dbstatus<>okTHEN standardmeldung(meldg20,"");
+return(1);LEAVE uvuklistenELSE IF wert(fnrffachgrp)<>""THEN lv:=text(wert(
+fnrffachgrp),laengefach);ermittleanderefaecherELSE allefaecherCAT lv;
+allefaecherCAT trenner;FI ;ermittlestdenFI .ermittleanderefaecher:IF fachbez=
+trennerTHEN IF records(dnrfaecher)=0.0THEN standardmeldung(meldg21,"");return
+(1);LEAVE uvuklistenELSE statleseschleife(dnrfaecher,"","",fnrffach,fnrffach,
+PROC faecherholen)FI ;FI ;holallefaecher.holallefaecher:allefaecher:=
+allefaecherzu(trenner+lv+trenner).ermittlestden:allestdenberechnen.
+bereitelisteauf:listeCAT "Lehrbefähigte mit Stundenzahl:";listeCAT 
+auskunftstextende;listeCAT "       Soll  Ist im Fach Rest";listeCAT 
+auskunftstextende;listeCAT "Fach:  ----+----+-------+----";listeCAT 
+auskunftstextende;listeCAT text(lv,5);listeCAT text(fachsoll,6);listeCAT text
+(fachist,5);listeCAT text(fachsoll-fachist,13);listeCAT auskunftstextende;
+listeCAT " ";listeCAT auskunftstextende.giballelehreraus:IF fachkatalog=
+trennerTHEN holeaktdatenpruefungFI ;lehrbeflehrer:="";inittupel(
+dnrlehrbefaehigungen);statleseschleife(dnrlehrbefaehigungen,compress(lv),"",
+fnrlbfach,fnrlbparaphe,PROC lehrbeflehrerholen);IF lehrbeflehrer=""THEN 
+meldungkeinelehrbeflehrerELSE giblehrerausFI .meldungkeinelehrbeflehrer:
+standardmeldung(meldg22,lv+ausgparam);return(1);LEAVE uvuklisten.giblehreraus
+:suchpos:=1;aktpos:=1;listeCAT "Lehrer:";listeCAT auskunftstextende;WHILE 
+aktpos>0REP aktpos:=pos(lehrbeflehrer,trenner,suchpos);IF aktpos>0THEN 
+paraphe:=subtext(lehrbeflehrer,suchpos,aktpos-1);standardmeldung(meldg23,
+paraphe+ausgparam);ermittlestdenlehrer;IF ohnefehlerTHEN listeCAT text(
+paraphe,5);listeCAT text(lehrersoll,6);listeCAT text(lehrerist,5);listeCAT 
+text(lehrerimfach,8);listeCAT text(lehrersoll-lehrerist,5);listeCAT 
+auskunftstextendeFI ;suchpos:=aktpos+1FI ;PER ;infeld(1);
+standardfelderausgeben;infeld(aktfeld).END PROC uvuklisten;PROC 
+ermittlestdenlehrer:lehrersoll:=0;lehrerist:=0;lehrerimfach:=0;ohnefehler:=
+TRUE ;ermittlelehrersoll;ermittlelehreristundimfach.ermittlelehrersoll:zz:=
+pos(parkatalog,trenner+paraphe+trenner);IF zz>0THEN lehrersoll:=int((
+sollstdkatalogSUB (zz+1))+(sollstdkatalogSUB (zz+2)))ELSE ohnefehler:=FALSE ;
+LEAVE ermittlestdenlehrerFI .ermittlelehreristundimfach:inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvparaphe,paraphe);statleseschleife(
+ixlvsjhjpar,schj,schhj,fnrlvsj,fnrlvhj,PROC holelehrerstden).END PROC 
+ermittlestdenlehrer;PROC holelehrerstden(BOOL VAR b):TEXT VAR lvfach:=text(
+wert(fnrlvfachkennung),laengefach);IF wert(fnrlvsj)<>schjCOR wert(fnrlvhj)<>
+schhjCOR wert(fnrlvparaphe)<>parapheTHEN b:=TRUE ELSE IF inallefaecher(lvfach
+)THEN lehrerimfachINCR intwert(fnrlvwochenstd)FI ;lehreristINCR intwert(
+fnrlvwochenstd)FI END PROC holelehrerstden;BOOL PROC inallefaecher(TEXT 
+CONST fach):pos(allefaecher,trenner+text(fach,laengefach)+trenner)>0END PROC 
+inallefaecher;PROC lehrbeflehrerholen(BOOL VAR b):IF dbstatus<>okCOR text(
+wert(fnrlbfach),laengefach)<>lvTHEN b:=TRUE ELSE lehrbeflehrerCAT wert(
+fnrlbparaphe);lehrbeflehrerCAT trenner;FI END PROC lehrbeflehrerholen;PROC 
+allestdenberechnen:INT VAR i;fachsoll:=0;fachist:=0;FOR iFROM 1UPTO length(
+allefaecher)DIV (laengefach+1)REP fach:=(subtext(allefaecher,(i-1)*(
+laengefach+1)+2,i*(laengefach+1)));berechnestdenzufachPER END PROC 
+allestdenberechnen;PROC berechnestdenzufach:inittupel(dnrlehrveranstaltungen)
+;putwert(fnrlvfachkennung,fach);statleseschleife(ixlvsjhjkenn,schj,schhj,
+fnrlvsj,fnrlvhj,PROC stdenzufach)END PROC berechnestdenzufach;PROC 
+stdenzufach(BOOL VAR b):TEXT VAR lvfach:=text(wert(fnrlvfachkennung),
+laengefach);INT VAR lvstd;IF wert(fnrlvsj)<>schjCOR wert(fnrlvhj)<>schhjCOR 
+lvfach>fachTHEN b:=TRUE ELSE IF lvfach=fachTHEN lvstd:=intwert(fnrlvwochenstd
+);fachsollINCR lvstd;IF wert(fnrlvparaphe)<>""THEN fachistINCR lvstdFI FI FI 
+END PROC stdenzufach;TEXT PROC allefaecherzu(TEXT CONST bez):suchpos:=1;
+aktpos:=1;WHILE aktpos>0REP aktpos:=pos(fachgrbez,bez,suchpos);IF aktpos>0
+THEN allefaecherCAT (fachbezSUB (aktpos+1));allefaecherCAT (fachbezSUB (
+aktpos+2));allefaecherCAT trenner;suchpos:=aktpos+1;FI PER ;allefaecherEND 
+PROC allefaecherzu;PROC uvukvorjparaphe:IF aenderungskennzeichen=
+kennzeichnungaktTHEN standardmeldung(meldg19,"");return(1)ELSE aktzeile:=(
+infeld-2)DIV 9+1;jgst:=int(text(standardmaskenfeld(aktzeile*9-6),laengejgst))
+;lv:=dbinh(aktzeile).fakenn;IF geplschhj="1"CAND jgst=5THEN standardmeldung(
+meldg19,"");return(1);LEAVE uvukvorjparapheFI ;suchedbsatzundausgabeFI .
+suchedbsatzundausgabe:savetupel(index,sicherungstupel);saveupdateposition(
+index);IF index<>dnrlehrveranstaltungenTHEN changeindex;FI ;inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvsj,aktschj);putwert(fnrlvhj,aktschhj);
+IF aktschhj="2"CAND jgst>5THEN putintwert(fnrlvjgst,jgst-1);ELSE putintwert(
+fnrlvjgst,jgst)FI ;putwert(fnrlvfachkennung,lv);search(dnrlehrveranstaltungen
+,TRUE );IF dbstatus<>okTHEN standardmeldung(meldg18,"Schulj. "+aktschhj+". "+
+text(aktschj,2)+"/"+subtext(aktschj,3)+" Lv. "+text(jgst)+lv+ausgparam);
+return(1);LEAVE uvukvorjparapheELSE standardmaskenfeld(wert(fnrlvparaphe),
+aktzeile*9-5);standardfelderausgebenFI ;IF index<>dnrlehrveranstaltungenTHEN 
+changeindex;FI ;restoreupdateposition(index);restoretupel(index,
+sicherungstupel);return(1).END PROC uvukvorjparaphe;PROC faecherholen(BOOL 
+VAR b):IF dbstatus<>okTHEN b:=TRUE ELSE fachbezCAT text(wert(fnrffach),
+laengefach);fachbezCAT trenner;fachgrbezCAT text(wert(fnrffachgrp),laengefach
+);fachgrbezCAT trennerFI END PROC faecherholen;PROC spezcat(BOOL VAR b):TEXT 
+VAR zwsp:="";IF i=100THEN fachkatalogCAT wert(fnrffach)+trenner;ELIF i=101
+THEN jgstsugrp:="";klgrkatalogCAT wert(fnrkgklassengrp)+trenner;
+klgrpruefkatalogCAT wert(fnrkgklassengrp)+trenner;jgstsugrp:=wert(
+fnrkgschuelergrp);stellejgstzurklgrfest;ELIF i=105THEN IF wert(fnrsgrphj)=
+aktschhjCAND dbstatus=okTHEN aktschgrkatalogCAT wert(fnrsgrpjgst)+wert(
+fnrsgrpkennung)+trenner;ELIF dbstatus<>okTHEN b:=TRUE FI ELIF i=106THEN IF 
+wert(fnrsgrphj)=geplschhjCAND dbstatus=okTHEN geplschgrkatalogCAT wert(
+fnrsgrpjgst)+wert(fnrsgrpkennung)+trenner;ELIF dbstatus<>okTHEN b:=TRUE FI 
+ELIF i=102THEN rgrkatalogCAT wert(fnrrgraumgrp)+trenner;ELIF i=103THEN zwsp:=
+wert(fnrlparaphe)+trenner;parkatalogCAT zwsp;sollstdkatalogCAT text(wert(
+fnrlsollstd),length(zwsp))ELIF i=104THEN IF wert(fnrschlsachgebiet)=raTHEN 
+rgrkatalogCAT wert(fnrschlschluessel)+trenner;ELIF wert(fnrschlsachgebiet)>ra
+THEN b:=TRUE FI FI .stellejgstzurklgrfest:FOR zzFROM 1UPTO length(jgstsugrp)
+DIV 6REP klgrpruefkatalogCAT subtext(jgstsugrp,zz*6-5,zz*6-4)PER ;
+klgrpruefkatalogCAT trenner.END PROC spezcat;END PACKET 
+uvundkopplungenbearbeiten;
+
diff --git a/app/schulis/2.2.1/src/4.vertretungen organisieren b/app/schulis/2.2.1/src/4.vertretungen organisieren
new file mode 100644
index 0000000..e0cd6ba
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.vertretungen organisieren
@@ -0,0 +1,318 @@
+PACKET vertretungenorganisierenDEFINES vertretungenorgbearbeiten,
+vertretungenorgvertretungsdatenlisten,vertretungenorginlisteblaettern,
+vertretungenorgspeichern,vertretungenorglvauflisten,
+vertretungenorglvauflisteneinlesen,vertretungenorginlvlisteblaettern,
+vertretungenorgangekreuztebearbeiten:LET maskebearb=
+"ms vertretungen organisieren",maskeliste="mu objektliste";LET fnrsuchparaphe
+=2,fnrstartdatum=3,fnrstartstunde=4,fnrendedatum=5,fnrendestunde=6,fnrparaphe
+=2,fnranrechnungart=3,fnrvertretdatum=4,fnrvertrettag=5,fnrvertretstd=6,
+fnrvertretlv=7,fnrvertretparaphe=8,fnrtabellenanfang=9;LET 
+meldnrlistewirdaufbereitet=7,meldnrbittefuellen=52,
+meldnrungueltigerschluessel=55,meldnrletzterbehandelt=67,meldnrbittewarten=69
+,meldnrblaetternnichtmoeglich=72,meldnrspeicherungunmoeglich=73,
+meldnrzulangevertretungsdauer=157,meldnrdatenwerdengespeichert=301,
+meldnrdatenwerdennichtgespeichert=303,meldnrungueltigeparaphe=344,
+meldnrstundenplanfehlt=366,meldnrparapheschonzugeteilt=361,
+meldnrzweitesdatumkleiner=386,meldnrkeinunterrichtzurzeit=395;LET schuljahr=
+"Schuljahr",schulhalbjahr="Schulhalbjahr";LET sachgebietanrechnungskennz=
+"c02 anrechnung vertret";LET kennzhell="#";LET kennzfreistunde="f",ankreuzung
+="x",fehlanzeige="-",lehrerbelegt="1",trenner="�";LET erstestunde=1,
+letztestunde=66,samstagstd=6,stundenprotag=12;LET kennungparaphe="P",
+kennunglv="L";LET laengesugruppe=6,laengeparaphe=4,laengelv=8;LET 
+logbucheintrag="Anw. 4.6.1 Vertretungen eingegeben oder geändert";INT VAR 
+pruefstatus:=0;INT VAR ifnr;TEXT VAR gueltigeanrechnungskennz:="",
+gueltigeparaphen:="";TEXT VAR paraphe,gespeicherteparaphe,startdatum,
+startstunde,endedatum,endestunde,aktschuljahr:="",akthalbjahr:="";TEXT VAR 
+auszeile;TEXT VAR liste:="";TEXT VAR lv,letztebehandeltelv:="",
+vertretungsdatum,hinweisfreistunde,hinweisvorherfrei,hinweisnachherfrei,
+hinweislehrerinsugruppe,hinweislehrbefaehigung,hinweislehrbefart;INT VAR std,
+dauer,erstevertretstd,letztevertretstd,idatum;INT VAR ivertret,maxvertret,
+erstevertretaufbildschirm;LET maxvertretaufbildschirm=14;FILE VAR fvertret;
+LET namevertretdatei="Liste der Vertretungsmöglichkeiten";INT VAR ilv,maxlv;
+ROW letztestundeSTRUCT (INT datum,INT std,TEXT lv)VAR vertret;ROW 
+letztestundeBOOL VAR listenankreuzung;INT VAR erstelvinliste;INT VAR izeile;
+LET maxlistenzeile=18,erstesfeldinliste=2,felderprozeileinliste=2;TEXT VAR 
+zeitendeslehrers,paraphenzursugruppe,allelvdersugruppe,lehrerderzeitvorher,
+lehrerderzeit,lehrerderzeitnachher,freielehrerderzeit,lehrerdesfachs,
+lehrbefartdesfachs,sugruppe,sugruppen,zuletztbehandeltesugruppen:="";TEXT 
+VAR fundlv,fundraum,fundparaphe,suchfach,zuletztbehandeltesfach:="";INT VAR 
+poslv,posparaphe,posfachlehrer,possugruppe;BOOL VAR vertretungliegtvor,
+bearbeitungueberobjektliste;INT VAR fstatusstuplan;PROC 
+vertretungenorgbearbeiten:eingangspruefung;IF pruefstatus<>0THEN infeld(
+pruefstatus);return(1)ELSE standardmeldung(meldnrbittewarten,"");
+vertretungsorganisationvorbereiten;IF zuvertretendelvvorhandenTHEN 
+standardstartproc(maskebearb);bearbeitungueberobjektliste:=FALSE ;
+zeigebsmitvertretungsmoeglichkeiten;standardnprocELSE standardmeldung(
+meldnrkeinunterrichtzurzeit,"");infeld(fnrstartdatum);return(1)FI FI .
+zuvertretendelvvorhanden:ilv<=maxlv.END PROC vertretungenorgbearbeiten;PROC 
+vertretungsorganisationvorbereiten:zeitendeslehrers:=allezeitenvon(
+kennungparaphe,paraphe);idatum:=datum(startdatum);erstevertretstd:=stundezu(
+startdatum,startstunde);letztevertretstd:=stundezu(endedatum,endestunde);ilv
+:=0;IF erstevertretstd>letztevertretstdTHEN FOR stdFROM erstevertretstdUPTO 
+letztestundeREP IF (zeitendeslehrersSUB std)=lehrerbelegtTHEN 
+planeintraglesen(std,kennungparaphe,paraphe,fundlv,fundraum,fundparaphe);ilv
+INCR 1;vertret(ilv).datum:=idatum;vertret(ilv).std:=std;vertret(ilv).lv:=
+fundlv;FI ;IF (stdMOD stundenprotag)=0THEN idatumINCR 1FI PER ;idatumINCR 2;
+erstevertretstd:=erstestunde;FI ;std:=erstevertretstd;WHILE std<=
+letztevertretstdREP IF (zeitendeslehrersSUB std)=lehrerbelegtTHEN 
+planeintraglesen(std,kennungparaphe,paraphe,fundlv,fundraum,fundparaphe);ilv
+INCR 1;vertret(ilv).datum:=idatum;vertret(ilv).std:=std;vertret(ilv).lv:=
+fundlv;FI ;IF (stdMOD stundenprotag)=0THEN idatumINCR 1FI ;stdINCR 1PER ;
+maxlv:=ilv;ilv:=1END PROC vertretungsorganisationvorbereiten;PROC 
+zeigebsmitvertretungsmoeglichkeiten:lv:=vertret(ilv).lv;std:=vertret(ilv).std
+;idatum:=vertret(ilv).datum;vertretungsdatum:=datum(idatum);
+standardmaskenfeld(vertretungsdatum,fnrvertretdatum);standardmaskenfeld(
+namedestags(tagnummer(vertretungsdatum)),fnrvertrettag);standardmaskenfeld(
+stundennummer(std),fnrvertretstd);standardmaskenfeld(lv,fnrvertretlv);
+standardmaskenfeld(text(paraphe,laengeparaphe),fnrvertretparaphe);
+holemoeglichevertretungenzulv;vertretungliegtvor:=FALSE ;inittupel(
+dnrvertretungen);putwert(fnrvdatum,vertretungsdatum);putintwert(fnrvtagstd,
+std);search(dnrvertretungen,FALSE );WHILE dbstatus=0AND wert(fnrvdatum)=
+vertretungsdatumAND intwert(fnrvtagstd)=stdREP IF compress(wert(
+fnrvveranstaltung))=compress(lv)THEN vertretungliegtvor:=TRUE ;
+standardmaskenfeld(wert(fnrvparaphe),fnrparaphe);standardmaskenfeld(wert(
+fnrvanrechnung),fnranrechnungart);FI ;succ(dnrvertretungen);UNTIL 
+vertretungliegtvorPER ;IF NOT vertretungliegtvorTHEN standardmaskenfeld("",
+fnrparaphe);standardmaskenfeld("",fnranrechnungart);FI ;gespeicherteparaphe:=
+standardmaskenfeld(fnrparaphe);infeld(1);standardfelderausgeben;infeld(
+fnrparaphe).END PROC zeigebsmitvertretungsmoeglichkeiten;PROC 
+holemoeglichevertretungenzulv:moeglichevertretungsdatenzusammenstellen;
+vertretungsdatenzeigen(1).moeglichevertretungsdatenzusammenstellen:ivertret:=
+0;forget(namevertretdatei,quiet);fvertret:=sequentialfile(output,
+namevertretdatei);IF (stdMOD stundenprotag)=0THEN lehrerderzeitnachher:="";
+lehrerderzeitvorher:=datenderzeit(std-1,kennungparaphe)ELIF (stdMOD 
+stundenprotag)=1THEN lehrerderzeitvorher:="";lehrerderzeitnachher:=
+datenderzeit(std+1,kennungparaphe)ELSE lehrerderzeitvorher:=datenderzeit(std-
+1,kennungparaphe);lehrerderzeitnachher:=datenderzeit(std+1,kennungparaphe)FI 
+;IF lv<>letztebehandeltelvTHEN letztebehandeltelv:=lv;sugruppen:=
+beteiligteschuelergruppen(kennunglv,lv);IF sugruppen<>
+zuletztbehandeltesugruppenTHEN zuletztbehandeltesugruppen:=sugruppen;
+bestimmedieparaphenzursugruppeFI FI ;freielehrerderzeit:="";
+holeallelehrerdesfachs;inittupel(dnrvertretungen);putwert(fnrvdatum,
+vertretungsdatum);putintwert(fnrvtagstd,std);search(dnrvertretungen,FALSE );
+WHILE dbstatus=0AND wert(fnrvdatum)=vertretungsdatumAND intwert(fnrvtagstd)=
+stdREP IF wert(fnrvanrechnung)=kennzfreistundeTHEN fundparaphe:=wert(
+fnrvparaphe);hinweisfreistunde:=ankreuzung;
+weiterehinweisezugefundenerparaphesetzen;
+ausgabezeilezugefundenerparapheindateischreibenFI ;succ(dnrvertretungen);PER 
+;lehrerderzeit:=datenderzeit(std,kennungparaphe);posparaphe:=1;WHILE 
+posparaphe<length(gueltigeparaphen)REP fundparaphe:=subtext(gueltigeparaphen,
+posparaphe,posparaphe+laengeparaphe-1);IF suchpos(lehrerderzeit,fundparaphe,
+laengeparaphe)=0THEN hinweisfreistunde:=fehlanzeige;
+weiterehinweisezugefundenerparaphesetzen;
+ausgabezeilezugefundenerparapheindateischreibenFI ;posparapheINCR 
+laengeparaphePER ;maxvertret:=ivertret.bestimmedieparaphenzursugruppe:
+allelvdersugruppe:="";possugruppe:=1;WHILE possugruppe<length(sugruppen)REP 
+sugruppe:=subtext(sugruppen,possugruppe,possugruppe+laengesugruppe-1);
+allelvdersugruppeCAT lvderschuelergruppe(sugruppe);possugruppeINCR 
+laengesugruppePER ;paraphenzursugruppe:="";poslv:=1;WHILE poslv<length(
+allelvdersugruppe)REP fundlv:=subtext(allelvdersugruppe,poslv,poslv+laengelv-
+1);paraphenzursugruppeCAT datenzurlv(kennungparaphe,fundlv);poslvINCR 
+laengelvPER END PROC holemoeglichevertretungenzulv;PROC 
+holeallelehrerdesfachs:suchfach:=compress(subtext(lv,3,4));IF suchfach<>
+zuletztbehandeltesfachTHEN zuletztbehandeltesfach:=suchfach;
+holeallelehrerdesfachsganzneuFI .holeallelehrerdesfachsganzneu:lehrerdesfachs
+:="";lehrbefartdesfachs:="";dbstatus(0);inittupel(dnrlehrbefaehigungen);
+statleseschleife(dnrlehrbefaehigungen,suchfach,suchfach,fnrlbfach,fnrlbfach,
+PROC lehrbefaehigunglesen);inittupel(dnrfaecher);putwert(fnrffach,suchfach);
+search(dnrfaecher,TRUE );IF dbstatus=0AND wert(fnrffachgrp)<>""THEN suchfach
+:=wert(fnrffachgrp);inittupel(dnrlehrbefaehigungen);statleseschleife(
+dnrlehrbefaehigungen,suchfach,suchfach,fnrlbfach,fnrlbfach,PROC 
+lehrbefaehigunglesen);FI ;END PROC holeallelehrerdesfachs;PROC 
+lehrbefaehigunglesen(BOOL VAR b):IF dbstatus<>0OR suchfach<>wert(fnrlbfach)
+THEN b:=TRUE ELSE lehrerdesfachsCAT text(wert(fnrlbparaphe),laengeparaphe);
+lehrbefartdesfachsCAT text(wert(fnrlbart),1)FI END PROC lehrbefaehigunglesen;
+PROC weiterehinweisezugefundenerparaphesetzen:IF suchpos(lehrerderzeitvorher,
+fundparaphe,laengeparaphe)>0THEN hinweisvorherfrei:=ankreuzungELSE 
+hinweisvorherfrei:=fehlanzeigeFI ;IF suchpos(lehrerderzeitnachher,fundparaphe
+,laengeparaphe)>0THEN hinweisnachherfrei:=ankreuzungELSE hinweisnachherfrei:=
+fehlanzeigeFI ;IF suchpos(paraphenzursugruppe,fundparaphe,laengeparaphe)>0
+THEN hinweislehrerinsugruppe:=ankreuzungELSE hinweislehrerinsugruppe:=
+fehlanzeigeFI ;posfachlehrer:=suchpos(lehrerdesfachs,fundparaphe,
+laengeparaphe);IF posfachlehrer>0THEN hinweislehrbefaehigung:=ankreuzung;
+hinweislehrbefart:=lehrbefartdeslehrersELSE hinweislehrbefaehigung:=
+fehlanzeige;hinweislehrbefart:=" "FI .lehrbefartdeslehrers:lehrbefartdesfachs
+SUB ((posfachlehrerDIV laengeparaphe)+1).END PROC 
+weiterehinweisezugefundenerparaphesetzen;PROC 
+ausgabezeilezugefundenerparapheindateischreiben:auszeile:=text(fundparaphe,
+laengeparaphe);freielehrerderzeitCAT auszeile;auszeileCAT hinweisfreistunde;
+auszeileCAT hinweisvorherfrei;auszeileCAT hinweisnachherfrei;auszeileCAT 
+hinweislehrerinsugruppe;auszeileCAT hinweislehrbefaehigung;auszeileCAT 
+hinweislehrbefart;putline(fvertret,auszeile);ivertretINCR 1END PROC 
+ausgabezeilezugefundenerparapheindateischreiben;PROC vertretungsdatenzeigen(
+INT CONST abzeile):fvertret:=sequentialfile(modify,namevertretdatei);
+erstevertretaufbildschirm:=abzeile;toline(fvertret,abzeile);col(fvertret,1);
+ivertret:=1;ifnr:=fnrtabellenanfang;WHILE ivertret<=maxvertretaufbildschirm
+REP IF NOT eof(fvertret)THEN readrecord(fvertret,auszeile);standardmaskenfeld
+(auszeile,ifnr);down(fvertret)ELSE standardmaskenfeld("          ",ifnr)FI ;
+ifnrINCR 1;ivertretINCR 1PER ;END PROC vertretungsdatenzeigen;PROC 
+vertretungenorgvertretungsdatenlisten:WINDOW VAR w:=startwindow(37,24,77,7);
+fundparaphe:=standardmaskenfeld(fnrparaphe);IF parapheungueltigTHEN 
+standardmeldung(meldnrungueltigeparaphe,"");return(1)ELSE standardmeldung(
+meldnrlistewirdaufbereitet,"");bereitelistenausgabeauf;IF menuedraussenTHEN 
+reorganizescreenFI ;open(w);auskunfterteilung(liste,w,FALSE );
+reorganizescreen;setlasteditvalues;infeld(1);standardfelderausgeben;infeld(
+fnrparaphe);return(1)FI .bereitelistenausgabeauf:liste:=
+"Vertretungsdaten zu Paraphe ";listeCAT fundparaphe;listeCAT 
+auskunftstextende;listeCAT "Datum     Zeit    Art Lehrveranst.";listeCAT 
+auskunftstextende;inittupel(dnrvertretungen);dbstatus(0);statleseschleife(
+ixvpar,fundparaphe,fundparaphe,fnrvparaphe,fnrvparaphe,PROC 
+vertretdatenzuparapheaufbereiten);listeCAT "*";listeCAT auskunftstextende.
+END PROC vertretungenorgvertretungsdatenlisten;PROC 
+vertretdatenzuparapheaufbereiten(BOOL VAR b):IF dbstatus=0AND wert(
+fnrvparaphe)=fundparapheTHEN listeCAT wert(fnrvdatum);listeCAT "  ";listeCAT 
+namedestags(tagnummer(wert(fnrvdatum)));listeCAT " ";listeCAT stundennummer(
+intwert(fnrvtagstd));listeCAT ".  ";listeCAT text(wert(fnrvanrechnung),2);
+listeCAT "  ";listeCAT lvaufbereitet;listeCAT auskunftstextendeELSE b:=TRUE 
+FI .lvaufbereitet:fundlv:=wert(fnrvveranstaltung);subtext(fundlv,1,2)+" "+
+subtext(fundlv,3,4)+" "+subtext(fundlv,5,8).END PROC 
+vertretdatenzuparapheaufbereiten;PROC vertretungenorginlisteblaettern(BOOL 
+CONST vor):IF vorTHEN IF erstevertretaufbildschirm+maxvertretaufbildschirm>
+maxvertretTHEN standardmeldung(meldnrblaetternnichtmoeglich,"")ELSE 
+vertretungsdatenzeigen(erstevertretaufbildschirm+maxvertretaufbildschirm)FI 
+ELSE IF erstevertretaufbildschirm=1THEN standardmeldung(
+meldnrblaetternnichtmoeglich,"")ELSE vertretungsdatenzeigen(
+erstevertretaufbildschirm-maxvertretaufbildschirm)FI FI ;return(1)END PROC 
+vertretungenorginlisteblaettern;PROC vertretungenorgspeichern(BOOL CONST 
+speichern):IF speichernTHEN fundparaphe:=standardmaskenfeld(fnrparaphe);IF 
+plausifehlerTHEN return(1)ELSE vertretungwieangegebenspeichern;logeintrag(
+logbucheintrag);IF dbstatus<>0THEN standardmeldung(
+meldnrspeicherungunmoeglich,"");return(1)ELSE naechstelvzeigenoderzurueckFI 
+FI ELSE standardmeldung(meldnrdatenwerdennichtgespeichert,"");
+naechstelvzeigenoderzurueckFI .plausifehler:IF fundparaphe=""THEN 
+standardmeldung(meldnrbittefuellen,"");infeld(fnrparaphe);TRUE ELIF 
+parapheungueltigTHEN standardmeldung(meldnrungueltigeparaphe,"");infeld(
+fnrparaphe);TRUE ELIF suchpos(freielehrerderzeit,fundparaphe,laengeparaphe)=0
+THEN standardmeldung(meldnrparapheschonzugeteilt,fundparaphe+kennzhell);
+infeld(fnrparaphe);TRUE ELIF standardmaskenfeld(fnranrechnungart)=
+kennzfreistundeTHEN standardmeldung(meldnrungueltigerschluessel,"");infeld(
+fnranrechnungart);TRUE ELIF ungueltigesanrechnungskennz(standardmaskenfeld(
+fnranrechnungart))THEN standardmeldung(meldnrungueltigerschluessel,"");infeld
+(fnranrechnungart);TRUE ELIF vertretungkannsonichtgespeichertwerdenTHEN 
+standardmeldung(meldnrparapheschonzugeteilt,fundparaphe+kennzhell);infeld(
+fnrparaphe);TRUE ELSE FALSE FI .vertretungkannsonichtgespeichertwerden:
+inittupel(dnrvertretungen);putwert(fnrvdatum,vertretungsdatum);putintwert(
+fnrvtagstd,std);putwert(fnrvparaphe,fundparaphe);search(dnrvertretungen,TRUE 
+);IF dbstatus<>0THEN FALSE ELIF wert(fnrvanrechnung)=kennzfreistundeTHEN 
+delete(dnrvertretungen);FALSE ELIF wert(fnrvveranstaltung)=compress(lv)THEN 
+FALSE ELSE TRUE FI .vertretungwieangegebenspeichern:standardmeldung(
+meldnrdatenwerdengespeichert,"");putwert(fnrvdatum,vertretungsdatum);
+putintwert(fnrvtagstd,std);IF gespeicherteparaphe=""THEN putwert(fnrvparaphe,
+fundparaphe);putwert(fnrvanrechnung,standardmaskenfeld(fnranrechnungart));
+putwert(fnrvveranstaltung,compress(lv));insert(dnrvertretungen)ELSE putwert(
+fnrvparaphe,gespeicherteparaphe);search(dnrvertretungen,TRUE );IF dbstatus=0
+THEN putwert(fnrvparaphe,fundparaphe);putwert(fnrvanrechnung,
+standardmaskenfeld(fnranrechnungart));putwert(fnrvveranstaltung,compress(lv))
+;update(dnrvertretungen)FI FI .naechstelvzeigenoderzurueck:IF 
+bearbeitungueberobjektlisteTHEN naechsteangekreuztelvsetzenELSE ilvINCR 1FI ;
+IF ilv>maxlvTHEN standardmeldung(meldnrletzterbehandelt,"");IF 
+bearbeitungueberobjektlisteTHEN enter(3)ELSE enter(2)FI ELSE 
+zeigebsmitvertretungsmoeglichkeiten;return(1)FI .naechsteangekreuztelvsetzen:
+ilvINCR 1;WHILE NOT listenankreuzung(ilv)REP ilvINCR 1UNTIL ilv>maxlvPER .
+END PROC vertretungenorgspeichern;PROC vertretungenorglvauflisten:
+eingangspruefung;IF pruefstatus<>0THEN infeld(pruefstatus);return(1)ELSE 
+vertretungsorganisationvorbereiten;IF zuvertretendelvvorhandenTHEN 
+bearbeitungueberobjektliste:=TRUE ;standardstartproc(maskeliste);
+standardmeldung(meldnrbittewarten,"");initlistenankreuzung;erstelvinliste:=1;
+zeigelvinliste;vertretungenorglvauflisteneinlesenELSE standardmeldung(
+meldnrkeinunterrichtzurzeit,"");infeld(fnrstartdatum);return(1)FI FI .
+zuvertretendelvvorhanden:ilv<=maxlv.initlistenankreuzung:FOR ilvFROM 1UPTO 
+letztestundeREP listenankreuzung(ilv):=FALSE PER .END PROC 
+vertretungenorglvauflisten;PROC zeigelvinliste:ifnr:=erstesfeldinliste;ilv:=
+erstelvinliste;FOR izeileFROM 1UPTO maxlistenzeileREP IF ilv>maxlvTHEN 
+zeigeleerzeileELSE zeigelvzeile;ilvINCR 1FI ;ifnrINCR felderprozeileinliste
+PER ;infeld(1);standardfelderausgeben;infeld(erstesfeldinliste);.
+zeigeleerzeile:feldschutz(ifnr);standardmaskenfeld("",ifnr);
+standardmaskenfeld(" ",ifnr+1).zeigelvzeile:feldfrei(ifnr);IF 
+listenankreuzung(ilv)THEN standardmaskenfeld(ankreuzung,ifnr)ELSE 
+standardmaskenfeld("",ifnr)FI ;auszeilezusammenbauen;standardmaskenfeld(
+auszeile,ifnr+1).auszeilezusammenbauen:auszeile:=datum(vertret(ilv).datum);
+auszeileCAT "  ";auszeileCAT namedestags(tagnummer(datum(vertret(ilv).datum))
+);auszeileCAT " ";auszeileCAT stundennummer(vertret(ilv).std);auszeileCAT 
+".  ";auszeileCAT "  ";auszeileCAT lvaufbereitet.lvaufbereitet:fundlv:=
+vertret(ilv).lv;subtext(fundlv,1,2)+" "+subtext(fundlv,3,4)+" "+subtext(
+fundlv,5,8).END PROC zeigelvinliste;PROC vertretungenorglvauflisteneinlesen:
+infeld(erstesfeldinliste);standardnproc;ilv:=erstelvinliste;ifnr:=
+erstesfeldinliste;FOR izeileFROM 1UPTO maxlistenzeileREP IF ilv<=maxlvTHEN 
+IF standardmaskenfeld(ifnr)<>""THEN listenankreuzung(ilv):=TRUE ELSE 
+listenankreuzung(ilv):=FALSE FI ;ilvINCR 1FI ;ifnrINCR felderprozeileinliste
+PER END PROC vertretungenorglvauflisteneinlesen;PROC 
+vertretungenorginlvlisteblaettern(BOOL CONST vor):IF vorTHEN IF 
+erstelvinliste+maxlistenzeile>maxlvTHEN standardmeldung(
+meldnrblaetternnichtmoeglich,"")ELSE erstelvinlisteINCR maxlistenzeile;
+zeigelvinlisteFI ;return(1)ELSE IF erstelvinliste=1THEN standardmeldung(
+meldnrblaetternnichtmoeglich,"")ELSE erstelvinlisteDECR maxlistenzeile;
+zeigelvinlisteFI ;return(1)FI END PROC vertretungenorginlvlisteblaettern;
+PROC vertretungenorgangekreuztebearbeiten:ilv:=1;WHILE NOT listenankreuzung(
+ilv)REP ilvINCR 1UNTIL ilv>maxlvPER ;IF ilv>maxlvTHEN standardmeldung(
+meldnrletzterbehandelt,"");enter(2)ELSE standardstartproc(maskebearb);
+zeigebsmitvertretungsmoeglichkeiten;standardnprocFI END PROC 
+vertretungenorgangekreuztebearbeiten;PROC eingangspruefung:IF aktschuljahr=""
+THEN aktschuljahr:=schulkenndatum(schuljahr);akthalbjahr:=schulkenndatum(
+schulhalbjahr)FI ;stundenplanhalbjahrsetzen(akthalbjahr,aktschuljahr);
+stundenplanbasisundstundenplanholen(fstatusstuplan);IF fstatusstuplan<>0AND 
+fstatusstuplan<>8THEN standardmeldung(meldnrstundenplanfehlt,"");pruefstatus
+:=fnrsuchparaphe;LEAVE eingangspruefungFI ;standardpruefe(1,fnrsuchparaphe,0,
+0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefungELSE 
+fundparaphe:=standardmaskenfeld(fnrsuchparaphe);IF gueltigeparaphen=""THEN 
+holegueltigeparaphenFI ;IF parapheungueltigTHEN standardmeldung(
+meldnrungueltigeparaphe,"");pruefstatus:=fnrsuchparaphe;LEAVE 
+eingangspruefungELSE paraphe:=fundparapheFI ;standardpruefe(6,fnrstartdatum,0
+,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefungELSE 
+startdatum:=standardmaskenfeld(fnrstartdatum)FI ;INT VAR ug,og,wochentagnr;
+standardpruefe(2,fnrstartstunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN 
+LEAVE eingangspruefungELSE wochentagnr:=tagnummer(startdatum);IF wochentagnr=
+6THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:=erstestunde;standardpruefe(
+3,fnrstartstunde,ug,og,"",pruefstatus);IF pruefstatus<>0THEN LEAVE 
+eingangspruefungELSE startstunde:=standardmaskenfeld(fnrstartstunde)FI FI ;
+endedatum:=standardmaskenfeld(fnrendedatum);endestunde:=standardmaskenfeld(
+fnrendestunde);IF endedatum=""THEN endedatum:=startdatum;IF endestunde=""
+THEN endestunde:=startstunde;LEAVE eingangspruefungELSE standardpruefe(2,
+fnrendestunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE 
+eingangspruefungELIF wochentagnr=6THEN og:=samstagstdELSE og:=stundenprotag
+FI ;ug:=int(startstunde);standardpruefe(3,fnrendestunde,ug,og,"",pruefstatus)
+;IF pruefstatus<>0THEN LEAVE eingangspruefungFI FI ;ELSE standardpruefe(6,
+fnrendedatum,0,0,"",pruefstatus);IF pruefstatus<>0THEN LEAVE eingangspruefung
+FI ;standardpruefe(2,fnrendestunde,0,0,"",pruefstatus);IF pruefstatus<>0THEN 
+LEAVE eingangspruefungELSE wochentagnr:=tagnummer(endedatum);IF wochentagnr=6
+THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:=erstestunde;standardpruefe(3
+,fnrendestunde,ug,og,"",pruefstatus);IF pruefstatus<>0THEN LEAVE 
+eingangspruefungFI ;FI ;dauer:=datum(endedatum)-datum(startdatum);pruefstatus
+:=fnrendedatum;IF dauer<0THEN standardmeldung(meldnrzweitesdatumkleiner,"");
+LEAVE eingangspruefungELIF dauer=0THEN IF int(endestunde)<int(startstunde)
+THEN standardmeldung(meldnrzweitesdatumkleiner,"");LEAVE eingangspruefungFI 
+ELIF dauer>7THEN standardmeldung(meldnrzulangevertretungsdauer,"");LEAVE 
+eingangspruefungELIF dauer>6THEN IF int(endestunde)>=int(startstunde)THEN 
+standardmeldung(meldnrzulangevertretungsdauer,"");LEAVE eingangspruefungFI 
+FI ;pruefstatus:=0;FI ;FI ;END PROC eingangspruefung;BOOL PROC 
+parapheungueltig:suchpos(gueltigeparaphen,fundparaphe,laengeparaphe)=0END 
+PROC parapheungueltig;PROC holegueltigeparaphen:gueltigeparaphen:="";
+inittupel(dnrlehrer);statleseschleife(dnrlehrer,"","",fnrlparaphe,fnrlparaphe
+,PROC paraphelesen)END PROC holegueltigeparaphen;PROC paraphelesen(BOOL VAR b
+):IF dbstatus<>0THEN b:=TRUE ELSE gueltigeparaphenCAT text(wert(fnrlparaphe),
+laengeparaphe)FI END PROC paraphelesen;BOOL PROC ungueltigesanrechnungskennz(
+TEXT CONST kennz):IF gueltigeanrechnungskennz=""THEN 
+holegueltigeanrechnungskennzFI ;pos(gueltigeanrechnungskennz,trenner+kennz+
+trenner)=0END PROC ungueltigesanrechnungskennz;PROC 
+holegueltigeanrechnungskennz:gueltigeanrechnungskennz:=trenner;inittupel(
+dnrschluessel);statleseschleife(dnrschluessel,sachgebietanrechnungskennz,"",
+fnrschlsachgebiet,fnrschlschluessel,PROC anrechnungskennzlesen)END PROC 
+holegueltigeanrechnungskennz;PROC anrechnungskennzlesen(BOOL VAR b):IF 
+dbstatus<>0COR wert(fnrschlsachgebiet)<>sachgebietanrechnungskennzTHEN b:=
+TRUE ELSE gueltigeanrechnungskennzCAT wert(fnrschlschluessel);
+gueltigeanrechnungskennzCAT trennerFI END PROC anrechnungskennzlesen;INT 
+PROC suchpos(TEXT CONST quelle,suchtext,INT CONST laenge):INT VAR findpos:=
+pos(quelle,suchtext);WHILE findpos>0REP IF findposMOD laenge=1THEN LEAVE 
+suchposWITH findposELSE findpos:=pos(quelle,suchtext,findpos+1);FI PER ;
+findposEND PROC suchpos;TEXT PROC jgstzweistellig(INT CONST intjgst):IF 
+intjgst=0THEN "00"ELIF intjgst>4AND intjgst<10THEN "0"+text(intjgst)ELSE text
+(intjgst)FI END PROC jgstzweistellig;INT PROC tagnummer(TEXT CONST 
+datumsangabe):(datum(datumsangabe)+5)MOD 7END PROC tagnummer;TEXT PROC 
+namedestags(INT CONST tagesnummer):SELECT tagesnummerOF CASE 0:"So"CASE 1:
+"Mo"CASE 2:"Di"CASE 3:"Mi"CASE 4:"Do"CASE 5:"Fr"CASE 6:"Sa"OTHERWISE ""END 
+SELECT .END PROC namedestags;TEXT PROC stundennummer(INT CONST istd):IF (istd
+MOD stundenprotag)=0THEN text(stundenprotag)ELSE text(istdMOD stundenprotag,2
+)FI END PROC stundennummer;INT PROC stundezu(TEXT CONST angtag,angstd):(
+tagnummer(angtag)-1)*stundenprotag+int(angstd)END PROC stundezu;END PACKET 
+vertretungenorganisieren
+
diff --git a/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten b/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten
new file mode 100644
index 0000000..7034ab6
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.vertretungsdaten bearbeiten
@@ -0,0 +1,279 @@
+PACKET vertretungsdatenbearbeitenDEFINES vertretungsdatenbearbeiteneingang,
+vertretungsdatenbearbeitenstart,vertretungsdatenentfernenstart,
+vertretungsdatenentfernen,vertretungsdatenzeileeinfuegen,
+vertretungsdatenspeichern:LET maskeeingang=
+"ms vertretungsdaten bearbeiten eingang";LET maskebearb=
+"ms vertretungsdaten bearbeiten";LET fnrauswahlparaphe=2,fnrstartparaphe=3,
+fnrauswahldatum=4,fnrstartdatum=5,fnrauswahlentfernen=6,fnrentfernendatum=7;
+LET feldanzmaskeeingang=7;ROW feldanzmaskeeingangTEXT VAR feldbs1;LET 
+felderprozeile=6;LET ersteseingabefeld=2;LET erstestabellenfeld=2;LET 
+meldnrungueltigerschluessel=55,meldnrungueltigeauswahl=56,
+meldnrplausiwirdgeprueft=57,meldnrloeschen=61,meldnrnichtloeschen=62,
+meldnrloeschfrage=65,meldnrloeschenmitdatum=83,meldnrvertretunggibtsschon=88,
+meldnrdatumfehltzurestangaben=129,meldnrungueltigesdatum=157,
+meldnrdatenwerdengespeichert=301,meldnrdatenwerdennichtgespeichert=303,
+meldnrletztezeilenichteinfuegen=314,meldnrfalschetastezuankreuz=318,
+meldnrfalscheausfuellung=319,meldnrungueltigeparaphe=344;LET 
+sachgebietanrechnungskennz="c02 anrechnung vertret";LET kennzhell="#";LET 
+erstesdatum="01.01.00",erstestunde=1,samstagstd=6,stundenprotag=12;LET 
+trenner="�",punkt=".";LET logbucheintrag=
+"Anw. 4.6.2 Vertretungen eingegeben oder geändert";INT VAR zugriff;BOOL VAR 
+eingangsmaskenfehler:=FALSE ;INT VAR pruefstatus:=0,letztecursorfnr:=
+fnrauswahlparaphe;INT VAR aktzeile;INT VAR ifnr;TEXT VAR startparaphe,
+startdatum,entfernendatum;TEXT VAR nfparaphe,nfdatum,nftagstd;TEXT VAR 
+gueltigeanrechnungskennz:="",gueltigeparaphen:="";INT VAR izeile,
+anzahlgezeigtezeilen,anzahleingegebenezeilen;LET zeilenanzahl=18;ROW 
+zeilenanzahlSTRUCT (TEXT datum,TEXT tag,TEXT stunde,TEXT paraphe,TEXT art,
+TEXT lv,TEXT tagstd)VAR bszeile;BOOL VAR leerenbszeigen;
+initfelderdeseingangsbildschirms;initbszeilepuffer;PROC 
+vertretungsdatenbearbeiteneingang:standardstartproc(maskeeingang);
+wertedeseingangsbildschirmsholen;infeld(fnrauswahlparaphe);
+standardfelderausgeben;infeld(letztecursorfnr);standardnprocEND PROC 
+vertretungsdatenbearbeiteneingang;PROC vertretungsdatenbearbeitenstart:
+eingangsbehandlung(1);IF eingangsmaskenfehlerTHEN infeld(pruefstatus);return(
+1)ELSE wertedeseingangsbildschirmsmerken;zugriffaufvertretungsdatenbestimmen;
+erstensatzlesen;standardstartproc(maskebearb);bsfuellen;infeld(
+ersteseingabefeld);standardnprocFI .zugriffaufvertretungsdatenbestimmen:IF 
+standardmaskenfeld(fnrauswahlparaphe)=""THEN zugriff:=dnrvertretungenELSE 
+zugriff:=ixvparFI .erstensatzlesen:inittupel(dnrvertretungen);IF zugriff=
+ixvparTHEN putwert(fnrvparaphe,startparaphe)ELSE putwert(fnrvdatum,startdatum
+)FI ;search(zugriff,FALSE );leerenbszeigen:=dbstatus<>ok;IF dbstatus=0THEN 
+IF zugriff=dnrvertretungenTHEN IF startdatum<>erstesdatumAND startdatum<>wert
+(fnrvdatum)THEN pred(zugriff)FI ELIF zugriff=ixvparTHEN IF startparaphe<>""
+AND startparaphe<>wert(fnrvparaphe)THEN pred(zugriff)FI FI FI .END PROC 
+vertretungsdatenbearbeitenstart;PROC bsfuellen:izeile:=0;IF NOT 
+leerenbszeigenTHEN startebildschirmblock(zugriff,zeilenanzahl-1);
+bildschirmblock(PROC satzmerken,BOOL PROC (INT CONST )satzzubehandeln,0);IF 
+dbstatus=0THEN succ(zugriff);IF dbstatus<>0THEN inittupel(dnrvertretungen);
+FI ELSE inittupel(dnrvertretungen);FI ;merkesatzalsnachfolgerELSE nfdatum:=
+erstesdatumFI ;evtlleerzeilenhinzufuegen;
+werteausbszeileinstandardfeldersetzen;infeld(1);standardfelderausgeben;.
+evtlleerzeilenhinzufuegen:anzahlgezeigtezeilen:=izeile;WHILE izeile<
+zeilenanzahlREP izeileINCR 1;bszeile(izeile).datum:="";bszeile(izeile).tag:=
+"  ";bszeile(izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile(izeile).
+art:="";bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";PER .
+werteausbszeileinstandardfeldersetzen:ifnr:=erstestabellenfeld;FOR izeile
+FROM 1UPTO zeilenanzahlREP standardmaskenfeld(bszeile(izeile).datum,ifnr);
+standardmaskenfeld(bszeile(izeile).tag,ifnr+1);standardmaskenfeld(bszeile(
+izeile).stunde,ifnr+2);standardmaskenfeld(bszeile(izeile).paraphe,ifnr+3);
+standardmaskenfeld(bszeile(izeile).art,ifnr+4);standardmaskenfeld(bszeile(
+izeile).lv,ifnr+5);ifnrINCR felderprozeilePER .merkesatzalsnachfolger:nfdatum
+:=wert(fnrvdatum);nftagstd:=wert(fnrvtagstd);nfparaphe:=wert(fnrvparaphe).
+END PROC bsfuellen;BOOL PROC satzzubehandeln(INT CONST dummynr):IF NOT (
+izeile<zeilenanzahlCAND dbstatus=ok)THEN LEAVE satzzubehandelnWITH FALSE FI ;
+TRUE .END PROC satzzubehandeln;PROC satzmerken:izeileINCR 1;bszeile(izeile).
+datum:=ausgabedatum;bszeile(izeile).tag:=namedestags(tagnummer(wert(fnrvdatum
+)));bszeile(izeile).stunde:=text(ausgabestd);bszeile(izeile).paraphe:=wert(
+fnrvparaphe);bszeile(izeile).art:=wert(fnrvanrechnung);bszeile(izeile).lv:=
+wert(fnrvveranstaltung);bszeile(izeile).tagstd:=wert(fnrvtagstd).ausgabedatum
+:subtext(wert(fnrvdatum),1,2)+subtext(wert(fnrvdatum),4,5)+subtext(wert(
+fnrvdatum),7,8).ausgabestd:INT VAR ausgabezeit:=intwert(fnrvtagstd)MOD 
+stundenprotag;IF ausgabezeit=0THEN stundenprotagELSE ausgabezeitFI .END PROC 
+satzmerken;PROC vertretungsdatenentfernenstart:eingangsbehandlung(2);IF 
+eingangsmaskenfehlerTHEN infeld(pruefstatus);return(1)ELSE 
+wertedeseingangsbildschirmsmerken;FOR ifnrFROM fnrauswahlparapheUPTO 
+fnrstartdatumREP feldschutz(ifnr)PER ;feldschutz(fnrentfernendatum);infeld(
+fnrauswahlentfernen);standardmeldung(meldnrloeschfrage,"");standardnprocFI 
+END PROC vertretungsdatenentfernenstart;PROC vertretungsdatenentfernen(BOOL 
+CONST entfernen):IF entfernenTHEN standardmeldung(meldnrloeschen,"");
+entfernendervertretungsdatenvornehmenELSE standardmeldung(meldnrnichtloeschen
+,"")FI ;enter(2).entfernendervertretungsdatenvornehmen:TEXT VAR 
+gelesenesdatum,datuminmeldung:="";INT VAR stichdatum:=datum(entfernendatum);
+first(dnrvertretungen);gelesenesdatum:=wert(fnrvdatum);WHILE dbstatus=0CAND 
+datum(gelesenesdatum)<stichdatumREP delete(dnrvertretungen);IF gelesenesdatum
+<>datuminmeldungTHEN datuminmeldung:=gelesenesdatum;standardmeldung(
+meldnrloeschenmitdatum,datuminmeldung+kennzhell)FI ;succ(dnrvertretungen);
+gelesenesdatum:=wert(fnrvdatum)PER END PROC vertretungsdatenentfernen;PROC 
+vertretungsdatenzeileeinfuegen(BOOL CONST einfuegen):INT VAR erstefnr;IF 
+einfuegenTHEN zeileeinfuegenELSE zeileloeschenFI ;return(1).zeileeinfuegen:
+aktzeile:=bearbeitungszeilezufeld(infeld);IF aktzeile=zeilenanzahlTHEN 
+standardmeldung(meldnrletztezeilenichteinfuegen,"");LEAVE zeileeinfuegenFI ;
+IF bszeile(zeilenanzahl).datum<>""THEN merkeverdraengtensatzalsnachfolgesatz;
+anzahlgezeigtezeilen:=zeilenanzahlFI ;FOR izeileFROM zeilenanzahl-1DOWNTO 
+aktzeile+1REP zeileiminternenpufferverschieben;
+wertederzeileaufdembildschirmverschiebenPER ;izeile:=aktzeile+1;
+leerzeileschreiben;werteineingefuegterzeilevermerken;neuezeilenausgeben.
+merkeverdraengtensatzalsnachfolgesatz:startdatum:=bszeile(zeilenanzahl).datum
+;nfdatum:=subtext(startdatum,1,2)+punkt+subtext(startdatum,3,4)+punkt+subtext
+(startdatum,5,6);nfparaphe:=bszeile(zeilenanzahl).paraphe;nftagstd:=bszeile(
+zeilenanzahl).tagstd.zeileiminternenpufferverschieben:bszeile(izeile+1).datum
+:=bszeile(izeile).datum;bszeile(izeile+1).tag:=bszeile(izeile).tag;bszeile(
+izeile+1).stunde:=bszeile(izeile).stunde;bszeile(izeile+1).paraphe:=bszeile(
+izeile).paraphe;bszeile(izeile+1).art:=bszeile(izeile).art;bszeile(izeile+1).
+lv:=bszeile(izeile).lv;bszeile(izeile+1).tagstd:=bszeile(izeile).tagstd;.
+wertederzeileaufdembildschirmverschieben:FOR ifnrFROM erstesfeldderzeileUPTO 
+letztesfeldderzeileREP standardmaskenfeld(standardmaskenfeld(ifnr),ifnr+
+felderprozeile)PER .erstesfeldderzeile:(izeile-1)*felderprozeile+
+erstestabellenfeld.letztesfeldderzeile:erstesfeldderzeile+felderprozeile-1.
+werteineingefuegterzeilevermerken:bszeile(izeile).datum:="";bszeile(izeile).
+tag:="  ";bszeile(izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile(
+izeile).art:="";bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";.
+zeileloeschen:izeile:=bearbeitungszeilezufeld(infeld);leerzeileschreiben;
+neuezeilenausgeben.leerzeileschreiben:erstefnr:=erstesfeldderzeile;
+standardmaskenfeld("",erstefnr);standardmaskenfeld("  ",erstefnr+1);FOR ifnr
+FROM erstefnr+2UPTO letztesfeldderzeileREP standardmaskenfeld("",ifnr)PER .
+neuezeilenausgeben:infeld(erstefnr);standardfelderausgeben;infeld(erstefnr).
+END PROC vertretungsdatenzeileeinfuegen;INT PROC bearbeitungszeilezufeld(INT 
+CONST feldnr):((feldnr-erstestabellenfeld)DIV felderprozeile)+1END PROC 
+bearbeitungszeilezufeld;PROC vertretungsdatenspeichern(BOOL CONST speichern):
+IF speichernTHEN standardmeldung(meldnrplausiwirdgeprueft,"");plausipruefung
+ELSE pruefstatus:=0FI ;IF pruefstatus<>0THEN infeld(pruefstatus);return(1)
+ELSE datenspeichern(speichern);IF nachfolgesatzvorhandenTHEN 
+holewertedesnachfolgersatzes;search(dnrvertretungen,TRUE );IF dbstatus<>0
+THEN search(dnrvertretungen,FALSE )FI ;izeile:=0;IF satzzubehandeln(izeile)
+THEN changeindex;leerenbszeigen:=FALSE ;naechstenbildschirmzeigenELSE enter(2
+)FI ELIF letzteeingabezeilegefuelltTHEN leerenbszeigen:=TRUE ;
+naechstenbildschirmzeigenELSE enter(2)FI ;FI .nachfolgesatzvorhanden:nfdatum
+<>erstesdatum.letzteeingabezeilegefuellt:standardmaskenfeld((zeilenanzahl-1)*
+felderprozeile+ersteseingabefeld)<>"".holewertedesnachfolgersatzes:putwert(
+fnrvdatum,nfdatum);putwert(fnrvtagstd,nftagstd);putwert(fnrvparaphe,nfparaphe
+).naechstenbildschirmzeigen:bsfuellen;infeld(ersteseingabefeld);return(1).
+END PROC vertretungsdatenspeichern;PROC datenspeichern(BOOL CONST speichern):
+IF speichernTHEN standardmeldung(meldnrdatenwerdengespeichert,"");
+datenspeicherungdurchfuehrenELSE standardmeldung(
+meldnrdatenwerdennichtgespeichert,"")FI END PROC datenspeichern;PROC 
+datenspeicherungdurchfuehren:FOR izeileFROM 1UPTO zeilenanzahlREP 
+holevergleichswerte;IF vertretungseintragloeschenTHEN aenderungszeileanzeigen
+;altevertretungloeschenELIF vertretungseintrageinfuegenTHEN 
+aenderungszeileanzeigen;neuevertretungeinfuegenELIF 
+vertretungseintragueberschreibenTHEN aenderungszeileanzeigen;
+altevertretungupdateFI PER ;logeintrag(logbucheintrag).holevergleichswerte:
+INT VAR prueffnr:=datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld(
+prueffnr);TEXT VAR altesdatum:=bszeile(izeile).datum.
+vertretungseintragloeschen:pruefdatum=""CAND altesdatum<>"".
+altevertretungloeschen:setzealtesuchwerteindbpuffer;search(dnrvertretungen,
+TRUE );IF dbstatus=0THEN delete(dnrvertretungen)FI .
+vertretungseintrageinfuegen:pruefdatum<>""CAND altesdatum="".
+neuevertretungeinfuegen:setzeneuewerteindbpuffer;insert(dnrvertretungen).
+vertretungseintragueberschreiben:NOT (standardmaskenfeld(prueffnr)=bszeile(
+izeile).datumCAND standardmaskenfeld(prueffnr+2)=bszeile(izeile).stundeCAND 
+standardmaskenfeld(prueffnr+3)=bszeile(izeile).parapheCAND standardmaskenfeld
+(prueffnr+4)=bszeile(izeile).artCAND standardmaskenfeld(prueffnr+5)=bszeile(
+izeile).lv).altevertretungupdate:setzealtesuchwerteindbpuffer;search(
+dnrvertretungen,TRUE );setzeneuewerteindbpuffer;update(dnrvertretungen).
+setzealtesuchwerteindbpuffer:pruefdatum:=bszeile(izeile).datum;pruefdatum:=
+subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext(
+pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putwert(fnrvtagstd,bszeile(
+izeile).tagstd);putwert(fnrvparaphe,bszeile(izeile).paraphe).
+setzeneuewerteindbpuffer:pruefdatum:=standardmaskenfeld(prueffnr);pruefdatum
+:=subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext(
+pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putintwert(fnrvtagstd,
+wochenstunde);putwert(fnrvparaphe,standardmaskenfeld(prueffnr+3));putwert(
+fnrvanrechnung,standardmaskenfeld(prueffnr+4));putwert(fnrvveranstaltung,
+standardmaskenfeld(prueffnr+5));.wochenstunde:(tagnummer(pruefdatum)-1)*
+stundenprotag+int(standardmaskenfeld(prueffnr+2)).END PROC 
+datenspeicherungdurchfuehren;PROC aenderungszeileanzeigen:infeld((izeile-1)*
+felderprozeile+ersteseingabefeld)END PROC aenderungszeileanzeigen;INT PROC 
+datumfnrin(INT CONST zeilennr):(zeilennr-1)*felderprozeile+ersteseingabefeld
+END PROC datumfnrin;INT PROC tagnummer(TEXT CONST datumsangabe):(datum(
+datumsangabe)+5)MOD 7END PROC tagnummer;TEXT PROC namedestags(INT CONST 
+tagesnummer):SELECT tagesnummerOF CASE 0:"So"CASE 1:"Mo"CASE 2:"Di"CASE 3:
+"Mi"CASE 4:"Do"CASE 5:"Fr"CASE 6:"Sa"OTHERWISE ""END SELECT .END PROC 
+namedestags;PROC eingangsbehandlung(INT CONST art):LET bearbeiten=1,entfernen
+=2;reinitparsing;eingangsmaskenfehler:=FALSE ;ankreuzfelderpruefen;IF 
+mehralseineauswahlangekreuztTHEN standardmeldung(meldnrungueltigeauswahl,"");
+pruefstatus:=fnrauswahlparaphe;eingangsmaskenfehler:=TRUE ;LEAVE 
+eingangsbehandlungFI ;IF entfernenpruefungTHEN IF ankreuz1THEN ankreuzfehler(
+fnrauswahlparaphe);LEAVE eingangsbehandlungELIF ankreuz2THEN ankreuzfehler(
+fnrauswahldatum);LEAVE eingangsbehandlungFI ELIF bearbeitenpruefungTHEN IF 
+ankreuz3THEN ankreuzfehler(fnrauswahlentfernen);LEAVE eingangsbehandlungFI 
+FI ;IF bearbeitenpruefungTHEN IF ankreuz1THEN IF standardmaskenfeld(
+fnrstartdatum)<>""THEN eintragfehler(fnrstartdatum);LEAVE eingangsbehandlung
+ELIF standardmaskenfeld(fnrentfernendatum)<>""THEN eintragfehler(
+fnrentfernendatum);LEAVE eingangsbehandlungFI ;startparaphe:=
+standardmaskenfeld(fnrstartparaphe);ELIF ankreuz2THEN IF standardmaskenfeld(
+fnrstartparaphe)<>""THEN eintragfehler(fnrstartparaphe);LEAVE 
+eingangsbehandlungELIF standardmaskenfeld(fnrentfernendatum)<>""THEN 
+eintragfehler(fnrentfernendatum);LEAVE eingangsbehandlungFI ;IF 
+standardmaskenfeld(fnrstartdatum)=""THEN startdatum:=erstesdatum;ELSE 
+standardpruefe(6,fnrstartdatum,0,0,"",pruefstatus);IF pruefstatus<>0THEN 
+eingangsmaskenfehler:=TRUE ;LEAVE eingangsbehandlungELSE startdatum:=
+standardmaskenfeld(fnrstartdatum);startdatum:=subtext(startdatum,1,2)+punkt+
+subtext(startdatum,3,4)+punkt+subtext(startdatum,5,6)FI ;FI ;FI ;FI ;IF 
+entfernenpruefungTHEN IF standardmaskenfeld(fnrstartparaphe)<>""THEN 
+eintragfehler(fnrstartparaphe);LEAVE eingangsbehandlungELIF 
+standardmaskenfeld(fnrstartdatum)<>""THEN eintragfehler(fnrstartdatum);LEAVE 
+eingangsbehandlungFI ;standardpruefe(6,fnrentfernendatum,0,0,"",pruefstatus);
+IF pruefstatus<>0THEN eingangsmaskenfehler:=TRUE ELSE entfernendatum:=
+standardmaskenfeld(fnrentfernendatum);entfernendatum:=subtext(entfernendatum,
+1,2)+punkt+subtext(entfernendatum,3,4)+punkt+subtext(entfernendatum,5,6)FI ;
+FI ;.ankreuzfelderpruefen:INT VAR summe:=0;IF ankreuz1THEN summeINCR 1FI ;IF 
+ankreuz2THEN summeINCR 1FI ;IF ankreuz3THEN summeINCR 1FI .
+mehralseineauswahlangekreuzt:summe<>1.ankreuz1:standardmaskenfeld(
+fnrauswahlparaphe)<>"".ankreuz2:standardmaskenfeld(fnrauswahldatum)<>"".
+ankreuz3:standardmaskenfeld(fnrauswahlentfernen)<>"".bearbeitenpruefung:art=
+bearbeiten.entfernenpruefung:art=entfernen.END PROC eingangsbehandlung;PROC 
+ankreuzfehler(INT CONST fehlerfeld):pruefstatus:=fehlerfeld;
+eingangsmaskenfehler:=TRUE ;standardmeldung(meldnrfalschetastezuankreuz,"").
+END PROC ankreuzfehler;PROC eintragfehler(INT CONST fehlerfeld):pruefstatus:=
+fehlerfeld;eingangsmaskenfehler:=TRUE ;standardmeldung(
+meldnrfalscheausfuellung,"").END PROC eintragfehler;PROC plausipruefung:
+pruefstatus:=0;vertretungseintraegepruefen;IF eingabefehlerTHEN LEAVE 
+plausipruefungFI ;datenkonsistenzpruefen;IF eingabefehlerTHEN LEAVE 
+plausipruefungFI .eingabefehler:pruefstatus<>0.END PROC plausipruefung;PROC 
+vertretungseintraegepruefen:anzahleingegebenezeilen:=0;IF gueltigeparaphen=""
+THEN holegueltigeparaphenFI ;IF gueltigeanrechnungskennz=""THEN 
+holegueltigeanrechnungskennzFI ;FOR izeileFROM 1UPTO zeilenanzahlREP IF 
+datumsfehlerTHEN LEAVE vertretungseintraegepruefenFI PER .datumsfehler:INT 
+VAR prueffnr:=datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld(
+prueffnr);IF pruefdatumleerTHEN IF eintraginfolgefelderderzeileTHEN 
+pruefstatus:=prueffnr;standardmeldung(meldnrdatumfehltzurestangaben,"");TRUE 
+ELSE FALSE FI ELSE standardpruefe(6,prueffnr,0,0,"",pruefstatus);IF 
+pruefstatus<>0THEN TRUE ELSE pruefdatum:=subtext(pruefdatum,1,2)+punkt+
+subtext(pruefdatum,3,4)+punkt+subtext(pruefdatum,5,6);IF tagnummer(pruefdatum
+)=0THEN pruefstatus:=prueffnr;standardmeldung(meldnrungueltigesdatum,"");
+TRUE ELIF stundeungueltigTHEN TRUE ELIF parapheungueltigTHEN standardmeldung(
+meldnrungueltigeparaphe,"");pruefstatus:=prueffnr+3;TRUE ELIF 
+anrechnungskennzungueltigTHEN standardmeldung(meldnrungueltigerschluessel,"")
+;pruefstatus:=prueffnr+4;TRUE ELSE anzahleingegebenezeilenINCR 1;FALSE FI FI 
+FI .pruefdatumleer:pruefdatum="".eintraginfolgefelderderzeile:
+standardmaskenfeld(prueffnr+2)<>""COR standardmaskenfeld(prueffnr+3)<>""COR 
+standardmaskenfeld(prueffnr+4)<>""COR standardmaskenfeld(prueffnr+5)<>"".
+stundeungueltig:INT VAR ug,og,wochentagnr;standardpruefe(2,prueffnr+2,0,0,"",
+pruefstatus);IF pruefstatus<>0THEN TRUE ELSE wochentagnr:=tagnummer(
+pruefdatum);IF wochentagnr=6THEN og:=samstagstdELSE og:=stundenprotagFI ;ug:=
+erstestunde;standardpruefe(3,prueffnr+2,ug,og,"",pruefstatus);pruefstatus<>0
+FI .parapheungueltig:pos(gueltigeparaphen,trenner+standardmaskenfeld(prueffnr
++3)+trenner)=0.anrechnungskennzungueltig:pos(gueltigeanrechnungskennz,trenner
++standardmaskenfeld(prueffnr+4)+trenner)=0.END PROC 
+vertretungseintraegepruefen;PROC datenkonsistenzpruefen:FOR izeileFROM 1UPTO 
+zeilenanzahlREP IF zeileungueltigTHEN pruefstatus:=prueffnr;standardmeldung(
+meldnrvertretunggibtsschon,"");LEAVE datenkonsistenzpruefenFI PER .
+zeileungueltig:IF leerzeileTHEN FALSE ELIF 
+zeileistimschluesselunveraendertgebliebenTHEN FALSE ELSE 
+ergebnisderpruefungzeileschongespeichertFI .leerzeile:INT VAR prueffnr:=
+datumfnrin(izeile);TEXT VAR pruefdatum:=standardmaskenfeld(prueffnr);
+pruefdatum="".zeileistimschluesselunveraendertgeblieben:standardmaskenfeld(
+prueffnr)=bszeile(izeile).datumCAND standardmaskenfeld(prueffnr+2)=bszeile(
+izeile).stundeCAND standardmaskenfeld(prueffnr+3)=bszeile(izeile).paraphe.
+ergebnisderpruefungzeileschongespeichert:neuewerteindbpuffersetzen;search(
+dnrvertretungen,TRUE );dbstatus=0.neuewerteindbpuffersetzen:pruefdatum:=
+subtext(pruefdatum,1,2)+punkt+subtext(pruefdatum,3,4)+punkt+subtext(
+pruefdatum,5,6);putwert(fnrvdatum,pruefdatum);putintwert(fnrvtagstd,
+wochenstunde);putwert(fnrvparaphe,standardmaskenfeld(prueffnr+3)).
+wochenstunde:(tagnummer(pruefdatum)-1)*stundenprotag+int(standardmaskenfeld(
+prueffnr+2)).END PROC datenkonsistenzpruefen;PROC holegueltigeparaphen:
+gueltigeparaphen:=trenner;inittupel(dnrlehrer);statleseschleife(dnrlehrer,"",
+"",fnrlparaphe,fnrlparaphe,PROC paraphelesen)END PROC holegueltigeparaphen;
+PROC paraphelesen(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE 
+gueltigeparaphenCAT wert(fnrlparaphe);gueltigeparaphenCAT trennerFI END PROC 
+paraphelesen;PROC holegueltigeanrechnungskennz:gueltigeanrechnungskennz:=
+trenner;inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+sachgebietanrechnungskennz,"",fnrschlsachgebiet,fnrschlschluessel,PROC 
+anrechnungskennzlesen)END PROC holegueltigeanrechnungskennz;PROC 
+anrechnungskennzlesen(BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)<>
+sachgebietanrechnungskennzTHEN b:=TRUE ELSE gueltigeanrechnungskennzCAT wert(
+fnrschlschluessel);gueltigeanrechnungskennzCAT trennerFI END PROC 
+anrechnungskennzlesen;PROC initfelderdeseingangsbildschirms:INT VAR i;FOR i
+FROM 1UPTO feldanzmaskeeingangREP feldbs1(i):=""PER END PROC 
+initfelderdeseingangsbildschirms;PROC wertedeseingangsbildschirmsmerken:INT 
+VAR i;letztecursorfnr:=infeld;FOR iFROM 1UPTO feldanzmaskeeingangREP feldbs1(
+i):=standardmaskenfeld(i)PER END PROC wertedeseingangsbildschirmsmerken;PROC 
+wertedeseingangsbildschirmsholen:INT VAR i;FOR iFROM 1UPTO 
+feldanzmaskeeingangREP standardmaskenfeld(feldbs1(i),i)PER END PROC 
+wertedeseingangsbildschirmsholen;PROC initbszeilepuffer:FOR izeileFROM 1UPTO 
+zeilenanzahlREP bszeile(izeile).datum:="";bszeile(izeile).tag:="";bszeile(
+izeile).stunde:="";bszeile(izeile).paraphe:="";bszeile(izeile).art:="";
+bszeile(izeile).lv:="";bszeile(izeile).tagstd:="";PER END PROC 
+initbszeilepuffer;END PACKET vertretungsdatenbearbeiten
+
diff --git a/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten b/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten
new file mode 100644
index 0000000..c52a4a9
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.zeitwuensche bearbeiten
@@ -0,0 +1,243 @@
+PACKET zeitwuenschebearbeitenDEFINES zeitwuenschebearbeiten,
+zeitwuenschekopieren,zeitwuenschespeichern:LET bearbmaske=
+"ms zeitwuensche bearb",zulgewichte="�-3�-2�-1�-0�+0�+1�+2�+3�",fldkzlehrer=2
+,fldparaphe=3,fldkzsugrup=4,fldjgst=5,fldkenn=6,fldkzraeume=7,fldraeume=8,
+fldkzfaecher=9,fldfaecher=10,fldkzkopp=11,fldkopp=12,fldhjkz=13,bearbfldbez=2
+,bearbfldmo1=3,bearbfldmo12=14,bearbflddi12=26,bearbfldmi12=38,bearbflddo12=
+50,bearbfldfr12=62,bearbfldsa6=68,bearbfldutanz=69,bearbfldutgew=70,
+bearbfldvmanz=71,bearbfldvmgew=72,bearbfldnmanz=73,bearbfldnmgew=74,posanzut=
+1,posgewut=3,posanzvm=4,posgewvm=6,posanznm=7,posgewnm=9,laengeallezeitw=132,
+laengejgst=2,laengeparaphe=4,laengefach=2,laengesugrup=6,laengesugrupkenn=4,
+laengeraum=4,laengebezfeld=22,meldungwarten=69,meldungobjektunbek=55,
+meldungfalschekz=56,meldungkeinelehrer=337,meldungkeinelv=321,
+meldungkeinefaecher=68,meldungkeinesugrup=332,meldungkeineraeume=365,
+meldungwertfalsch=34,meldungwertfehlt=129,meldungpruefen=329,meldungspeichern
+=50,meldungnichtsp=63,trenner="�",leererunbestwunsch="         ",
+raumkenndaten="c02 raeume",schuljahr="Schuljahr",halbjahr="Schulhalbjahr",
+kennpar="P",kennsugrup="S",kennraum="R",kennfach="F",kennkopp="K",minus="-",
+plus="+";INT VAR i;INT VAR prueffeld:=2,fall,objektlaenge:=0,anztage,anzvm,
+anznm,dbstatusbeimholen,hjkenn:=-1;TEXT VAR schj:="",schhj:="",hjkennz:="",
+startobjekt,allefaecher:=trenner,alleraeume:=trenner,alleparaphen:=trenner,
+allesugruppen:=trenner;TEXT VAR bearbfolge:="",bezug,bsbestzw:="",bsunbestzw
+:="",dbbestzw:="",dbunbestzw:="";TEXT VAR leererbestwunsch:=
+"                                                                  "+
+"                                                                  ";LET 
+logbucheintrag="Anw. 4.1.4 Zeitwünsche Lehrer geändert";PROC 
+zeitwuenschebearbeiten:standardmeldung(meldungwarten,"");
+pruefeingmaskeundsetzewerte;standardstartproc(bearbmaske);
+standardkopfmaskeaktualisieren(text(vergleichsknoten)+" "+schhj+"."+" "+text(
+schj,2)+"/"+subtext(schj,3));zeitwuenscheausgeben(startobjekt,bezug);
+standardnproc.pruefeingmaskeundsetzewerte:hjkennz:=standardmaskenfeld(fldhjkz
+);IF (hjkenn=0CAND hjkennz="")COR (hjkenn=1CAND hjkennz<>"")COR hjkenn=-1
+THEN ermittlehalbjahrFI ;IF standardmaskenfeld(fldkzlehrer)<>""THEN fall:=
+fldkzlehrer;bezug:=kennpar;IF restleer(fall)THEN startobjekt:=
+standardmaskenfeld(fldparaphe);IF startobjekt<>""THEN startobjekt:=text(
+startobjekt,laengeparaphe);IF bestandsfehlerTHEN IF alleparaphen<>trenner
+THEN standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1)FI ;
+LEAVE zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleparaphen,pos(
+alleparaphen,trenner+startobjekt+trenner)+laengeparaphe+2);FI ;ELSE IF 
+alleparaphen=trennerTHEN holalleparaphenFI ;IF alleparaphen=trennerTHEN 
+standardmeldung(meldungkeinelehrer,"");infeld(fall+1);return(1);LEAVE 
+zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleparaphen,laengeparaphe+3);
+startobjekt:=subtext(alleparaphen,2,2+laengeparaphe-1)FI ;FI ;objektlaenge:=
+laengeparaphe;ELSE standardmeldung(meldungfalschekz,"");infeld(prueffeld);
+return(1);LEAVE zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzsugrup)
+<>""THEN fall:=fldkzsugrup;bezug:=kennsugrup;IF restleer(fall)THEN 
+objektlaenge:=laengejgst+laengesugrupkenn;startobjekt:=standardmaskenfeld(
+fldjgst);IF startobjekt<>""THEN startobjekt:=jgstaufber(startobjekt);
+startobjektCAT text(standardmaskenfeld(fldkenn),laengesugrupkenn);IF 
+bestandsfehlerTHEN IF allesugruppen<>trennerTHEN standardmeldung(
+meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE 
+zeitwuenschebearbeitenELSE bearbfolge:=subtext(allesugruppen,pos(
+allesugruppen,trenner+startobjekt+trenner)+objektlaenge+2);FI ;ELSE IF 
+allesugruppen=trennerTHEN holallesugruppen;FI ;IF allesugruppen=trennerTHEN 
+standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1);LEAVE 
+zeitwuenschebearbeitenELSE bearbfolge:=subtext(allesugruppen,laengesugrup+3);
+startobjekt:=subtext(allesugruppen,2,2+laengesugrup-1)FI ;FI ;ELSE 
+standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE 
+zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzraeume)<>""THEN fall:=
+fldkzraeume;bezug:=kennraum;IF restleer(fall)THEN startobjekt:=
+standardmaskenfeld(fldraeume);IF startobjekt<>""THEN startobjekt:=text(
+startobjekt,laengeraum);IF bestandsfehlerTHEN IF alleraeume<>trennerTHEN 
+standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE 
+zeitwuenschebearbeitenELSE bearbfolge:=subtext(alleraeume,pos(alleraeume,
+trenner+startobjekt+trenner)+laengeraum+2);FI ;ELSE IF alleraeume=trenner
+THEN holalleraeumeFI ;IF alleraeume=trennerTHEN standardmeldung(
+meldungkeineraeume,"");infeld(fall+1);return(1);LEAVE zeitwuenschebearbeiten
+ELSE bearbfolge:=subtext(alleraeume,laengeraum+3);startobjekt:=subtext(
+alleraeume,2,2+laengeraum-1)FI ;FI ;objektlaenge:=laengeraum;ELSE 
+standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE 
+zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzfaecher)<>""THEN fall:=
+fldkzfaecher;bezug:=kennfach;IF restleer(fall)THEN startobjekt:=
+standardmaskenfeld(fldfaecher);IF startobjekt<>""THEN startobjekt:=text(
+startobjekt,laengefach);IF bestandsfehlerTHEN IF allefaecher<>trennerTHEN 
+standardmeldung(meldungobjektunbek,"");infeld(fall+1);return(1);FI ;LEAVE 
+zeitwuenschebearbeitenELSE bearbfolge:=subtext(allefaecher,pos(allefaecher,
+trenner+startobjekt+trenner)+laengefach+2);FI ;ELSE IF allefaecher=trenner
+THEN holallefaecherFI ;IF allefaecher=trennerTHEN standardmeldung(
+meldungkeinefaecher,"");infeld(fall+1);return(1);LEAVE zeitwuenschebearbeiten
+ELSE bearbfolge:=subtext(allefaecher,laengefach+3);startobjekt:=subtext(
+allefaecher,2,2+laengefach-1)FI ;FI ;objektlaenge:=laengefach;ELSE 
+standardmeldung(meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE 
+zeitwuenschebearbeitenFI ELIF standardmaskenfeld(fldkzkopp)<>""THEN fall:=
+fldkzkopp;bezug:=kennkopp;IF restleer(fall)THEN startobjekt:=
+standardmaskenfeld(fldkopp);IF startobjekt<>""THEN IF bestandsfehlerTHEN IF 
+wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjTHEN standardmeldung(
+meldungobjektunbek,"");infeld(fall+1);return(1)FI ;LEAVE 
+zeitwuenschebearbeitenFI ;ELSE holestartobjektFI ;ELSE standardmeldung(
+meldungfalschekz,"");infeld(prueffeld);return(1);LEAVE zeitwuenschebearbeiten
+FI ELSE standardmeldung(meldungwertfehlt,"");infeld(fldkzlehrer);return(1);
+LEAVE zeitwuenschebearbeitenFI .ermittlehalbjahr:allesugruppen:=trenner;schhj
+:=schulkenndatum(halbjahr);schj:=schulkenndatum(schuljahr);IF hjkennz=""THEN 
+geplanteshjundsjberechnen(schhj,schj);hjkenn:=1ELSE hjkenn:=0FI .
+holestartobjekt:inittupel(dnrlehrveranstaltungen);putwert(fnrlvsj,schj);
+putwert(fnrlvhj,schhj);putwert(fnrlvkopplung,"");search(ixlvsjhjkopp,FALSE );
+IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND dbstatus<2THEN startobjekt
+:=wert(fnrlvkopplung)ELSE standardmeldung(meldungkeinelv,"");infeld(fall);
+return(1);LEAVE zeitwuenschebearbeitenFI .END PROC zeitwuenschebearbeiten;
+PROC zeitwuenscheausgeben(TEXT CONST objekt,bez):IF fall=fldkzlehrerTHEN 
+standardmaskenfeld(text("Lehrer: "+objekt,laengebezfeld),bearbfldbez)ELIF 
+fall=fldkzsugrupTHEN standardmaskenfeld(text("Schülergruppe: "+startobjekt,
+laengebezfeld),bearbfldbez)ELIF fall=fldkzraeumeTHEN standardmaskenfeld(text(
+"Raum: "+objekt,laengebezfeld),bearbfldbez)ELIF fall=fldkzfaecherTHEN 
+standardmaskenfeld(text("Fach: "+objekt,laengebezfeld),bearbfldbez)ELSE 
+standardmaskenfeld(text("Kopplung: "+objekt,laengebezfeld),bearbfldbez)FI ;
+infeld(1);loeschebildschirm;zeitwunschholen;IF dbstatus=0THEN 
+zeitwunschausgebenELSE setzedbwerteFI ;standardfelderausgeben;infeld(
+bearbfldmo1).loeschebildschirm:FOR iFROM bearbfldmo1UPTO bearbfldnmgewREP 
+standardmaskenfeld("",i)PER .zeitwunschholen:inittupel(dnrzeitwuensche);
+putwert(fnrzwsj,schj);putwert(fnrzwhj,schhj);putwert(fnrzwbezug,bez);putwert(
+fnrzwbezugsobjekt,compress(objekt));search(dnrzeitwuensche,TRUE );
+dbstatusbeimholen:=dbstatus.zeitwunschausgeben:dbbestzw:=wert(
+fnrzwbestimmtewuensche);dbunbestzw:=wert(fnrzwunbestimmtewuensche);
+gibbestwuenscheaus(dbbestzw);gibunbestwuenscheaus(dbunbestzw).setzedbwerte:
+dbbestzw:=leererbestwunsch;dbunbestzw:=leererunbestwunsch.END PROC 
+zeitwuenscheausgeben;PROC gibbestwuenscheaus(TEXT CONST bestwunsch):INT VAR 
+suchpos:=1;TEXT VAR wunsch:="";WHILE suchpos<>0REP suchpos:=pos(bestwunsch,
+minus,suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1
+);standardmaskenfeld(wunsch,suchposDIV 2+3);suchposINCR 1FI ;PER ;suchpos:=1;
+WHILE suchpos<>0REP suchpos:=pos(bestwunsch,plus,suchpos);IF suchpos<>0THEN 
+wunsch:=subtext(bestwunsch,suchpos,suchpos+1);standardmaskenfeld(wunsch,
+suchposDIV 2+3);suchposINCR 1FI ;PER .END PROC gibbestwuenscheaus;PROC 
+gibunbestwuenscheaus(TEXT CONST unbestwunsch):TEXT VAR datum;IF unbestwunsch
+<>leererunbestwunschTHEN datum:=unbestwunschSUB posanzut;IF datum<>" "THEN 
+standardmaskenfeld(datum,bearbfldutanz);FI ;datum:=unbestwunschSUB posgewut;
+IF datum<>" "THEN standardmaskenfeld(datum,bearbfldutgew);FI ;datum:=
+unbestwunschSUB posanzvm;IF datum<>" "THEN standardmaskenfeld(datum,
+bearbfldvmanz)FI ;datum:=unbestwunschSUB posgewvm;IF datum<>" "THEN 
+standardmaskenfeld(datum,bearbfldvmgew)FI ;datum:=unbestwunschSUB posanznm;
+IF datum<>" "THEN standardmaskenfeld(datum,bearbfldnmanz)FI ;datum:=
+unbestwunschSUB posgewnm;IF datum<>" "THEN standardmaskenfeld(datum,
+bearbfldnmgew)FI ;FI END PROC gibunbestwuenscheaus;BOOL PROC bestandsfehler:
+IF fall=fldkzlehrerTHEN pruefparapheELIF fall=fldkzsugrupTHEN pruefsugrup
+ELIF fall=fldkzraeumeTHEN pruefraumELIF fall=fldkzfaecherTHEN prueffachELIF 
+fall=fldkzkoppTHEN pruefkoppELSE FALSE FI .pruefparaphe:IF alleparaphen=
+trennerTHEN holalleparaphen;IF alleparaphen=trennerTHEN standardmeldung(
+meldungkeinelehrer,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos(
+alleparaphen,trenner+startobjekt+trenner)=0.pruefsugrup:IF allesugruppen=
+trennerTHEN holallesugruppen;IF allesugruppen=trennerTHEN standardmeldung(
+meldungkeinesugrup,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos(
+allesugruppen,trenner+startobjekt+trenner)=0.pruefraum:IF alleraeume=trenner
+THEN holalleraeume;IF alleraeume=trennerTHEN standardmeldung(
+meldungkeineraeume,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos(
+alleraeume,trenner+startobjekt+trenner)=0.prueffach:IF allefaecher=trenner
+THEN holallefaecher;IF allefaecher=trennerTHEN standardmeldung(
+meldungkeinefaecher,"");return(1);LEAVE bestandsfehlerWITH TRUE FI FI ;pos(
+allefaecher,trenner+startobjekt+trenner)=0.pruefkopp:inittupel(
+dnrlehrveranstaltungen);putwert(fnrlvsj,schj);putwert(fnrlvhj,schhj);putwert(
+fnrlvkopplung,startobjekt);search(ixlvsjhjkopp,TRUE );dbstatus<>ok.END PROC 
+bestandsfehler;PROC holalleparaphen:inittupel(dnrlehrer);statleseschleife(
+dnrlehrer,"","",fnrlparaphe,fnrlfamname,PROC lehrer).END PROC holalleparaphen
+;PROC holalleraeume:inittupel(dnrschluessel);statleseschleife(dnrschluessel,
+raumkenndaten,"",fnrschlsachgebiet,fnrschlschluessel,PROC raeume).END PROC 
+holalleraeume;PROC holallesugruppen:inittupel(dnraktschuelergruppen);
+statleseschleife(dnraktschuelergruppen,schj,schhj,fnrsgrpsj,fnrsgrphj,PROC 
+sugruppen).END PROC holallesugruppen;PROC holallefaecher:inittupel(dnrfaecher
+);statleseschleife(dnrfaecher,"","",fnrffach,fnrffachbez,PROC faecher).END 
+PROC holallefaecher;PROC lehrer(BOOL VAR b):IF dbstatus<>0THEN b:=TRUE ELSE 
+alleparaphenCAT text(wert(fnrlparaphe),laengeparaphe);alleparaphenCAT trenner
+FI END PROC lehrer;PROC sugruppen(BOOL VAR b):IF dbstatus<>0COR wert(
+fnrsgrpsj)<>schjCOR wert(fnrsgrphj)<>schhjTHEN b:=TRUE ELSE allesugruppenCAT 
+jgstaufber(wert(fnrsgrpjgst));allesugruppenCAT text(wert(fnrsgrpkennung),
+laengesugrupkenn);allesugruppenCAT trennerFI END PROC sugruppen;PROC raeume(
+BOOL VAR b):IF dbstatus<>0COR wert(fnrschlsachgebiet)>raumkenndatenTHEN b:=
+TRUE ELSE alleraeumeCAT text(wert(fnrschlschluessel),laengeraum);alleraeume
+CAT trennerFI END PROC raeume;PROC faecher(BOOL VAR b):IF dbstatus<>0THEN b:=
+TRUE ELSE allefaecherCAT text(wert(fnrffach),laengefach);allefaecherCAT 
+trennerFI END PROC faecher;BOOL PROC restleer(INT CONST fall):IF fall=
+fldkzlehrerTHEN FOR iFROM fldkzsugrupUPTO fldkoppREP IF standardmaskenfeld(i)
+<>""THEN prueffeld:=i;LEAVE restleerWITH FALSE FI PER ELIF fall=fldkzsugrup
+THEN IF standardmaskenfeld(fldkzlehrer)<>""THEN prueffeld:=fldkzlehrer;LEAVE 
+restleerWITH FALSE FI ;IF standardmaskenfeld(fldparaphe)<>""THEN prueffeld:=
+fldparaphe;LEAVE restleerWITH FALSE FI ;FOR iFROM fldkzraeumeUPTO fldkoppREP 
+IF standardmaskenfeld(i)<>""THEN prueffeld:=i;LEAVE restleerWITH FALSE FI 
+PER ELIF fall=fldkzraeumeCOR fall=fldkzfaecherTHEN FOR iFROM fldkzlehrerUPTO 
+fall-1REP IF standardmaskenfeld(i)<>""THEN prueffeld:=i;LEAVE restleerWITH 
+FALSE FI PER ;FOR iFROM fall+2UPTO fldkoppREP IF standardmaskenfeld(i)<>""
+THEN prueffeld:=i;LEAVE restleerWITH FALSE FI PER ;ELIF fall=fldkzkoppTHEN 
+FOR iFROM fldkzlehrerUPTO fldfaecherREP IF standardmaskenfeld(i)<>""THEN 
+prueffeld:=i;LEAVE restleerWITH FALSE FI PER ;FI ;TRUE END PROC restleer;
+PROC zeitwuenschekopieren:INT VAR aktfld:=infeld;TEXT VAR wunsch;IF aktfld>=
+bearbfldmo1CAND aktfld<=bearbfldsa6THEN kopierfeldinhaltaufrestzeileFI ;
+return(1).kopierfeldinhaltaufrestzeile:wunsch:=standardmaskenfeld(aktfld);IF 
+aktfld<=bearbfldmo12THEN FOR iFROM aktfldUPTO bearbfldmo12REP 
+standardmaskenfeld(wunsch,i)PER ELIF aktfld<=bearbflddi12THEN FOR iFROM 
+aktfldUPTO bearbflddi12REP standardmaskenfeld(wunsch,i)PER ELIF aktfld<=
+bearbfldmi12THEN FOR iFROM aktfldUPTO bearbfldmi12REP standardmaskenfeld(
+wunsch,i)PER ELIF aktfld<=bearbflddo12THEN FOR iFROM aktfldUPTO bearbflddo12
+REP standardmaskenfeld(wunsch,i)PER ELIF aktfld<=bearbfldfr12THEN FOR iFROM 
+aktfldUPTO bearbfldfr12REP standardmaskenfeld(wunsch,i)PER ELSE FOR iFROM 
+aktfldUPTO bearbfldsa6REP standardmaskenfeld(wunsch,i)PER FI ;
+standardfelderausgeben;infeld(aktfld).END PROC zeitwuenschekopieren;PROC 
+zeitwuenschespeichern(BOOL CONST speichern):TEXT VAR zw:="";BOOL VAR 
+aenderung:=FALSE ;IF speichernTHEN standardmeldung(meldungpruefen,"");anztage
+:=0;anzvm:=0;anznm:=0;bsbestzw:="";bsunbestzw:="";FOR iFROM bearbfldmo1UPTO 
+bearbfldsa6REP zw:=standardmaskenfeld(i);IF zw=""THEN bsbestzwCAT "  "ELIF zw
+="-0"THEN bsbestzwCAT "  "ELIF zw="+0"THEN bsbestzwCAT "  "ELSE bsbestzwCAT 
+zwFI PER ;FOR iFROM bearbfldutanzUPTO bearbfldnmgewREP zw:=standardmaskenfeld
+(i);IF length(zw)>1THEN infeld(i);fehlermeldungFI ;IF iMOD 2=0THEN 
+bearbeitegewichtELSE bearbeiteanzahlFI PER ;IF dbbestzw<>bsbestzwTHEN 
+aenderung:=TRUE ;pruefebestzwFI ;IF dbunbestzw<>bsunbestzwTHEN aenderung:=
+TRUE ;pruefeunbestzwFI ;IF aenderungTHEN standardmeldung(meldungspeichern,"")
+;logeintrag(logbucheintrag);datenspeichernFI ;ELSE standardmeldung(
+meldungnichtsp,"")FI ;naechsterbildschirm.bearbeitegewicht:IF zw=""THEN 
+bsunbestzwCAT "  "ELSE bsunbestzwCAT "-";bsunbestzwCAT zwFI .bearbeiteanzahl:
+IF zw=""THEN bsunbestzwCAT " "ELSE bsunbestzwCAT zwFI .pruefebestzw:i:=1;
+WHILE i<laengeallezeitwREP zw:=subtext(bsbestzw,i,i+1);IF subtext(dbbestzw,i,
+i+1)<>zwTHEN pruefeeintragFI ;iINCR 2PER .pruefeeintrag:IF zw="  "THEN LEAVE 
+pruefeeintragFI ;IF pos(zulgewichte,trenner+zw+trenner)=0THEN infeld(iDIV 2+3
+);fehlermeldungFI .pruefeunbestzw:IF eingabefalsch(1,1,5)THEN infeld(
+bearbfldutanz);fehlermeldungFI ;IF eingabefalsch(4,1,6)THEN infeld(
+bearbfldvmanz);fehlermeldungFI ;IF eingabefalsch(7,1,5)THEN infeld(
+bearbfldnmanz);fehlermeldungFI ;IF eingabefalsch(3,1,3)THEN infeld(
+bearbfldutgew);fehlermeldungFI ;IF eingabefalsch(6,1,3)THEN infeld(
+bearbfldvmgew);fehlermeldungFI ;IF eingabefalsch(9,1,3)THEN infeld(
+bearbfldnmgew);fehlermeldungFI ;IF anztage+anzvm>6THEN infeld(bearbfldutanz);
+fehlermeldungnichtmöglichELIF anztage+anznm>6THEN infeld(bearbfldutanz);
+fehlermeldungnichtmöglichELIF anztage*2+anzvm+anznm>11THEN infeld(
+bearbfldutanz);fehlermeldungnichtmöglichFI ;FOR iFROM 1UPTO 3REP IF (
+bsunbestzwSUB (i*3-2))=" "CAND (bsunbestzwSUB (i*3))<>" "THEN infeld(
+bearbfldutanz+((i-1)*2));fehlermeldungfehlenderwertELIF (bsunbestzwSUB (i*3-2
+))<>" "CAND (bsunbestzwSUB (i*3))=" "THEN infeld(bearbfldutgew+((i-1)*2));
+fehlermeldungfehlenderwertFI PER .fehlermeldungnichtmöglich:return(1);
+standardmeldung(meldungfalschekz,"");LEAVE zeitwuenschespeichern.
+fehlermeldungfehlenderwert:return(1);standardmeldung(meldungwertfehlt,"");
+LEAVE zeitwuenschespeichern.fehlermeldung:return(1);standardmeldung(
+meldungwertfalsch,"");LEAVE zeitwuenschespeichern.naechsterbildschirm:IF fall
+=fldkzkoppTHEN WHILE wert(fnrlvkopplung)=startobjektCAND dbstatus<>3REP succ(
+ixlvsjhjkopp);PER ;IF wert(fnrlvsj)=schjCAND wert(fnrlvhj)=schhjCAND dbstatus
+<>3THEN startobjekt:=wert(fnrlvkopplung);zeitwuenscheausgeben(startobjekt,
+bezug);return(1)ELSE enter(2)FI ELIF bearbfolge=""THEN enter(2)ELSE 
+startobjekt:=text(bearbfolge,objektlaenge);bearbfolge:=subtext(bearbfolge,
+objektlaenge+2);zeitwuenscheausgeben(startobjekt,bezug);return(1)FI .
+datenspeichern:putwert(fnrzwbestimmtewuensche,bsbestzw);putwert(
+fnrzwunbestimmtewuensche,bsunbestzw);IF dbstatusbeimholen=0THEN update(
+dnrzeitwuensche)ELSE insert(dnrzeitwuensche)FI ;IF dbstatus<>0THEN 
+fehlermeldungbeimspeichernFI .fehlermeldungbeimspeichern:return(1);
+standardmeldung(meldungnichtsp,"");LEAVE zeitwuenschespeichern.END PROC 
+zeitwuenschespeichern;BOOL PROC eingabefalsch(INT CONST charpos,ugr,ogr):
+TEXT VAR datum:=bsunbestzwSUB charpos;INT VAR dat;IF datum=" "THEN FALSE 
+ELSE dat:=int(datum);IF charpos=1THEN anztage:=datELIF charpos=4THEN anzvm:=
+datELIF charpos=7THEN anznm:=datFI ;IF lastconversionokTHEN dat<ugrCOR dat>
+ogrELSE TRUE FI FI END PROC eingabefalsch;END PACKET zeitwuenschebearbeiten
+
diff --git a/app/schulis/2.2.1/src/4.zeitwuensche drucken b/app/schulis/2.2.1/src/4.zeitwuensche drucken
new file mode 100644
index 0000000..521ab2b
--- /dev/null
+++ b/app/schulis/2.2.1/src/4.zeitwuensche drucken
@@ -0,0 +1,129 @@
+PACKET zeitwuenschedruckenDEFINES zeitwuenschespezielleteile:LET AUSGFELD =
+ROW ausgfeldlaengeTEXT ,ausgfeldlaenge=18,zeilenbreite=60,zeilenanzahl=1,sj=
+"Schuljahr",hj="Schulhalbjahr",ueberschrzeilen=0,ausgabeparam="#",eingmaske=
+"ms liste zeitwuensche",meldungbearb=352,meldungpraez=129,fldsortlehrer=2,
+fldsortsugrup=3,fldsortraeume=4,fldsortfaecher=5,fldsortkopplg=6,fldakthj=7,
+fldaufdr=9,fldaufbs=8,posanzut=1,posgewut=3,posanzvm=4,posgewvm=6,posanznm=7,
+posgewnm=9,ausganzpos=11,ausggewpos=18,minus="-",plus="+",leerzeile=" ",
+kennzlehrer="P",kennzsugrup="S",kennzraeume="R",kennzfaecher="F",kennzkoppl=
+"K",moeintrag="Mo  ",dieintrag="Di  ",mieintrag="Mi  ",doeintrag="Do  ",
+freintrag="Fr  ",saeintrag="Sa  ",anhangl="Lehrer ",anhangs="Schülergruppen "
+,anhangr="Räume ",anhangf="Fächer ",anhangk="Kopplungen ",ueberschrift=
+"Liste der Zeitwünsche für ",leererunbestwunsch="         ";AUSGFELD VAR 
+ausgfeld;INT VAR i,status,druckzeilenzahl,fall;TEXT VAR bezug,objekt,
+objektbez,druckstrich;TEXT VAR sjahr,hjahr;INT VAR schj,schhj:=0;TEXT VAR 
+bestwunsch,unbestwunsch,zeitwuenscheueberschrift:="";TEXT VAR bestwzeile,
+unbestwtage,unbestwvorm,unbestwnachm,bestwurzeile:=
+" _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _"+
+"   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _  "+
+" _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   _   "+
+"_   _   _   _   _   _   _   _   _   _   _   _   _   _   _ ";TEXT VAR 
+moobjeintrag,diobjeintrag,miobjeintrag,doobjeintrag,frobjeintrag,saobjeintrag
+;BOOL PROC multistop:dbstatus=okCAND wert(fnrzwbezug)=bezugCAND intwert(
+fnrzwhj)=schhjCAND intwert(fnrzwsj)=schjEND PROC multistop;BOOL PROC 
+multistopsim:IF dbstatus=okTHEN IF intwert(fnrzwhj)=schhjCAND intwert(fnrzwsj
+)=schjCAND wert(fnrzwbezug)=bezugTHEN LEAVE multistopsimWITH TRUE ELSE 
+setzebestandende(TRUE );LEAVE multistopsimWITH FALSE FI ELSE setzebestandende
+(TRUE )FI ;FALSE END PROC multistopsim;PROC holeakthj:holakthj;holaktj;IF 
+standardmaskenfeld(fldakthj)=""THEN bergeplhjujFI .holakthj:hjahr:=
+schulkenndatum(hj);schhj:=int(hjahr).holaktj:sjahr:=schulkenndatum(sj);schj:=
+int(sjahr).bergeplhjuj:geplanteshjundsjberechnen(hjahr,sjahr);schj:=int(sjahr
+);schhj:=int(hjahr).END PROC holeakthj;PROC zeitwuenschespezielleteile(INT 
+CONST anwahl):SELECT anwahlOF CASE 1:zeitwuenschedialogvorbereitenCASE 2:
+zeitwuenscherichtigCASE 3:zeitwuenschelistenvorbereitenCASE 4:
+zeitwuenschedruckvorbereitenCASE 5:zeitwuenscheseitedruckenCASE 6:
+zeitwuenschebsvorbereitenCASE 7:zeitwuenscheseitezeigenEND SELECT .END PROC 
+zeitwuenschespezielleteile;PROC zeitwuenschedialogvorbereiten:
+setzeanfangswerte(eingmaske,fldsortlehrer)END PROC 
+zeitwuenschedialogvorbereiten;PROC zeitwuenscherichtig:IF standardmaskenfeld(
+fldsortlehrer)=""CAND standardmaskenfeld(fldsortsugrup)=""CAND 
+standardmaskenfeld(fldsortraeume)=""CAND standardmaskenfeld(fldsortfaecher)=
+""CAND standardmaskenfeld(fldsortkopplg)=""THEN standardmeldung(meldungpraez,
+"");setzeeingabetest(FALSE );infeld(fldsortlehrer);LEAVE zeitwuenscherichtig
+ELIF standardmaskenfeld(fldaufdr)=""CAND standardmaskenfeld(fldaufbs)=""THEN 
+standardmeldung(meldungpraez,"");setzeeingabetest(FALSE );infeld(
+fldsortlehrer);LEAVE zeitwuenscherichtigFI ;standardpruefe(5,fldsortlehrer,
+fldsortkopplg,0,"",status);IF status<>0THEN infeld(status);setzeeingabetest(
+FALSE )ELSE standardpruefe(5,fldaufdr,fldaufbs,0,"",status);IF status<>0THEN 
+infeld(status);setzeeingabetest(FALSE )ELSE IF standardmaskenfeld(
+fldsortlehrer)<>""THEN fall:=fldsortlehrer;objektbez:=anhangl;bezug:=
+kennzlehrerELIF standardmaskenfeld(fldsortsugrup)<>""THEN fall:=fldsortsugrup
+;objektbez:=anhangs;bezug:=kennzsugrupELIF standardmaskenfeld(fldsortraeume)
+<>""THEN fall:=fldsortraeume;objektbez:=anhangr;bezug:=kennzraeumeELIF 
+standardmaskenfeld(fldsortfaecher)<>""THEN fall:=fldsortfaecher;objektbez:=
+anhangf;bezug:=kennzfaecherELIF standardmaskenfeld(fldsortkopplg)<>""THEN 
+fall:=fldsortkopplg;objektbez:=anhangk;bezug:=kennzkopplFI ;
+setzeausgabedrucker(standardmaskenfeld(fldaufdr)<>"");setzeeingabetest(TRUE )
+;holeakthj;zeitwuenscheueberschrift:=ueberschrift+objektbez+hjahr+". "+text(
+sjahr,2)+"/"+subtext(sjahr,3)FI ;FI END PROC zeitwuenscherichtig;PROC 
+zeitwuenschelistenvorbereiten:BOOL VAR b;inittupel(dnrzeitwuensche);initobli(
+zeilenanzahl);setzeidentiwert("");setzewerte;objektlistestarten(
+dnrzeitwuensche,sjahr,fnrzwbezugsobjekt,TRUE ,b);setzebestandende(NOT 
+multistopCOR b).setzewerte:putintwert(fnrzwsj,schj);putintwert(fnrzwhj,schhj)
+;putwert(fnrzwbezug,bezug).END PROC zeitwuenschelistenvorbereiten;PROC 
+zeitwuenschebsvorbereiten:standardkopfmaskeaktualisieren(zentriert(
+zeitwuenscheueberschrift,51));setzebildanfangsposition(3)END PROC 
+zeitwuenschebsvorbereiten;PROC zeitwuenscheseitezeigen:blaettern(PROC (INT 
+CONST )zeitwuenschezeigen,aktion,TRUE ,TRUE ,BOOL PROC multistop);END PROC 
+zeitwuenscheseitezeigen;PROC zeitwuenschezeigen(INT CONST procparameter):
+zeitwuenscheholen;zeitwuenscheaufbereiten;zeitwuenscheaufbs;END PROC 
+zeitwuenschezeigen;PROC zeitwuenscheholen:objekt:=wert(fnrzwbezugsobjekt);
+bestwunsch:=wert(fnrzwbestimmtewuensche);unbestwunsch:=wert(
+fnrzwunbestimmtewuensche);IF NOT multistopTHEN setzebestandende(TRUE )FI .
+END PROC zeitwuenscheholen;PROC zeitwuenscheaufbereiten:bereiteobjektauf(
+objekt)END PROC zeitwuenscheaufbereiten;PROC zeitwuenscheaufbs:FOR iFROM 1
+UPTO ausgfeldlaengeREP ausgfeld(i)IN ausgabepos;erhoeheausgabeposumeinsPER 
+END PROC zeitwuenscheaufbs;PROC zeitwuenschedruckvorbereiten:druckvorbereiten
+;variablensetzen;initdruckkopf(zentriert(zeitwuenscheueberschrift,druckbreite
+));inittupel(dnrzeitwuensche);setzebestandende(FALSE );setzewerte;
+lesenvorbereitendruck(PROC (INT CONST ,BOOL PROC ,INT VAR )scanforward,BOOL 
+PROC multistopsim).variablensetzen:druckstrich:=druckbreite*"-";
+druckzeilenzahl:=drucklaenge(ueberschrzeilen).setzewerte:putintwert(fnrzwsj,
+schj);putintwert(fnrzwhj,schhj);putwert(fnrzwbezug,bezug).END PROC 
+zeitwuenschedruckvorbereiten;PROC zeitwuenscheseitedrucken:
+zeitwuenscheueberschriftdrucken;seitedrucken(PROC (INT VAR )
+zeitwuenschedrucken,druckzeilenzahl,ausgfeldlaenge,BOOL PROC multistopsim);
+seitenwechselEND PROC zeitwuenscheseitedrucken;PROC 
+zeitwuenscheueberschriftdrucken:druckkopfschreibenEND PROC 
+zeitwuenscheueberschriftdrucken;PROC zeitwuenschedrucken(INT VAR zz):
+zeitwuenscheholen;standardmeldung(meldungbearb,objektbez+objekt+ausgabeparam)
+;zeitwuenscheaufbereiten(zz);zeitwuenscheindruckdatei(zz)END PROC 
+zeitwuenschedrucken;PROC zeitwuenscheaufbereiten(INT VAR zz):bereiteobjektauf
+(objekt)END PROC zeitwuenscheaufbereiten;PROC zeitwuenscheindruckdatei(INT 
+VAR zz):FOR iFROM 1UPTO ausgfeldlaengeREP druckzeileschreiben(ausgfeld(i));zz
+INCR 1PER ;druckzeileschreiben(leerzeile);zzINCR 1;druckzeileschreiben(
+leerzeile);zzINCR 1END PROC zeitwuenscheindruckdatei;PROC bereiteobjektauf(
+TEXT CONST objekt):INT VAR suchpos:=1;TEXT VAR wunsch:="";moobjeintrag:=
+moeintrag;diobjeintrag:=dieintrag;miobjeintrag:=mieintrag;doobjeintrag:=
+doeintrag;frobjeintrag:=freintrag;saobjeintrag:=saeintrag;uebertragwuensche;
+ausgfeld(1):=(objekt+":");ausgfeld(2):=leerzeile;ausgfeld(3):=(
+"Wünsche zu festen Zeiten:");ausgfeld(4):=(leerzeile);ausgfeld(5):=(
+"     1   2   3   4   5   6   7   8   9  10  11  12");ausgfeld(6):=(
+moobjeintrag+text(bestwzeile,48));ausgfeld(7):=(diobjeintrag+subtext(
+bestwzeile,49,96));ausgfeld(8):=(miobjeintrag+subtext(bestwzeile,97,144));
+ausgfeld(9):=(doobjeintrag+subtext(bestwzeile,145,192));ausgfeld(10):=(
+frobjeintrag+subtext(bestwzeile,193,240));ausgfeld(11):=(saobjeintrag+subtext
+(bestwzeile,241));ausgfeld(12):=(leerzeile);ausgfeld(13):=(
+"                         allgemeine Wünsche:");ausgfeld(14):=(
+"                         Anzahl/Gewicht ");ausgfeld(15):=("ganze Tage      "
++unbestwtage);ausgfeld(16):=("zusätzl. Vorm.  "+unbestwvorm);ausgfeld(17):=(
+"zusätzl. Nachm. "+unbestwnachm);ausgfeld(18):=(leerzeile).uebertragwuensche:
+bestwzeile:=bestwurzeile;unbestwtage:="          _      _ ";unbestwvorm:=
+"          _      _ ";unbestwnachm:="          _      _ ";tragbestwuenscheein
+;tragunbestwuenscheein.tragbestwuenscheein:suchpos:=1;WHILE suchpos<>0REP 
+suchpos:=pos(bestwunsch,minus,suchpos);IF suchpos<>0THEN wunsch:=subtext(
+bestwunsch,suchpos,suchpos+1);replace(bestwzeile,suchpos*2-1,wunsch);suchpos
+INCR 1FI ;PER ;suchpos:=1;WHILE suchpos<>0REP suchpos:=pos(bestwunsch,plus,
+suchpos);IF suchpos<>0THEN wunsch:=subtext(bestwunsch,suchpos,suchpos+1);
+replace(bestwzeile,suchpos*2-1,wunsch);suchposINCR 1FI ;PER .
+tragunbestwuenscheein:IF unbestwunsch<>leererunbestwunschTHEN wunsch:=
+unbestwunschSUB posanzut;IF wunsch<>" "THEN replace(unbestwtage,ausganzpos,
+wunsch)FI ;wunsch:=unbestwunschSUB posgewut;IF wunsch<>" "THEN replace(
+unbestwtage,ausggewpos,wunsch)FI ;wunsch:=unbestwunschSUB posanzvm;IF wunsch
+<>" "THEN replace(unbestwvorm,ausganzpos,wunsch)FI ;wunsch:=unbestwunschSUB 
+posgewvm;IF wunsch<>" "THEN replace(unbestwvorm,ausggewpos,wunsch)FI ;wunsch
+:=unbestwunschSUB posanznm;IF wunsch<>" "THEN replace(unbestwnachm,ausganzpos
+,wunsch)FI ;wunsch:=unbestwunschSUB posgewnm;IF wunsch<>" "THEN replace(
+unbestwnachm,ausggewpos,wunsch)FI FI .END PROC bereiteobjektauf;END PACKET 
+zeitwuenschedrucken
+
diff --git a/app/schulis/2.2.1/src/5.STATISTIK SERVER.files b/app/schulis/2.2.1/src/5.STATISTIK SERVER.files
new file mode 100644
index 0000000..c813089
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.STATISTIK SERVER.files
@@ -0,0 +1,2 @@
+5.manager
+
diff --git a/app/schulis/2.2.1/src/5.STATISTIK.files b/app/schulis/2.2.1/src/5.STATISTIK.files
new file mode 100644
index 0000000..26554d2
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.STATISTIK.files
@@ -0,0 +1,9 @@
+5.thesaurus
+5.statistik liste
+5.merkmale
+5.datenbasis
+5.erstellen
+5.benennen
+5.felder
+5.drucken
+
diff --git a/app/schulis/2.2.1/src/5.benennen b/app/schulis/2.2.1/src/5.benennen
new file mode 100644
index 0000000..6f67e8a
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.benennen
@@ -0,0 +1,116 @@
+PACKET benennenDEFINES statbenennen:LET statistikdatei="STATISTIK.",
+statistikserver="statistik server",maskebenennen="mst statistik benennen",
+statistikvorzeilen=3,maxstatistiken=200,maxzeilen=75,maxspalten=50,
+minspaltenbreite=4,niltext="",space=" ",meldungzusatz="+",meldungback=
+"��������������",alt="alt",meldungrestore="              ",mgibtesnicht=477,
+mgibtesschon=485,mspeichern=486,mnichtspeichern=487,mentfernenfrage=488,
+mgeloescht=489,mnichtgeloescht=490,fstatnr=2,fbezeichnung=3,fzeilen=4,
+fspalten=5,fentfernen=6,pruefeimintervall=3,pruefeobwert=1;TEXT VAR 
+statistiknummer;FILE VAR stat;PROC statbenennen(INT CONST was):SELECT wasOF 
+CASE 1:benennenstartprocCASE 2:benennennprocCASE 3:
+benennenbearbeitenstartprocCASE 4:benennenbearbeitenspeichernCASE 5:
+benennenneustartprocCASE 6:benennenentfernenstartprocCASE 7:
+benennenentfernenexec;leave(2)CASE 8:statlistezeigen(int(standardmaskenfeld(
+fstatnr)))CASE 9:benennenlistebearbeitenstartprocCASE 10:
+benennenlistebearbeitenspeichernCASE 11:benennenlisteentfernenstartprocCASE 
+12:benennenentfernenexec;enter(1)CASE 13:benennenbearbeitennichtspeichern
+CASE 14:benennenentfernennichtloeschen;leave(2)CASE 15:
+benennenentfernennichtloeschen;enter(1)CASE 16:benennenentfernennichtloeschen
+;leave(3)END SELECT .benennenstartproc:standardstartproc(maskebenennen);
+standardmaskenfeld(niltext,fstatnr);benennennproc.benennennproc:
+standardmaskenfeld(niltext,fbezeichnung);feldschutz(fbezeichnung);
+standardmaskenfeld(niltext,fzeilen);feldschutz(fzeilen);standardmaskenfeld(
+niltext,fspalten);feldschutz(fspalten);feldschutz(fentfernen);feldfrei(
+fstatnr);infeld(fstatnr);standardnproc.benennenbearbeitenstartproc:IF NOT 
+nummerokTHEN leave(1);ELIF NOT statistikexistiert(statnummer)THEN statmeldung
+(mgibtesnicht);infeld(fstatnr);leave(1);ELSE benennenfreigebenundnproc;FI .
+benennenbearbeitenspeichern:IF NOT eingabenokTHEN leave(1);ELIF NOT (
+statistiknummer=statnummer)AND statistikexistiert(statnummer)THEN statmeldung
+(mgibtesschon);infeld(fstatnr);leave(1);ELSE statmeldung(mspeichern);
+statistikspeichern(statistiknummer,statnummer);standardmaskenfeld(niltext,
+fstatnr);leave(2);FI .benennenneustartproc:IF NOT nummerokTHEN leave(1);ELIF 
+statistikexistiert(statnummer)THEN statmeldung(mgibtesschon);infeld(fstatnr);
+leave(1);ELSE benennenfreigeben;statistiknummer:=statnummer;standardnprocFI .
+benennenentfernenstartproc:IF NOT nummerokTHEN leave(1);ELIF NOT 
+statistikexistiert(statnummer)THEN statmeldung(mgibtesnicht);infeld(fstatnr);
+leave(1);ELSE benennenschuetzenundnproc;FI .benennenschuetzenundnproc:
+benennenausfuellen(statnummer);feldschutz(fstatnr);feldschutz(fbezeichnung);
+feldschutz(fzeilen);feldschutz(fspalten);infeld(fstatnr);
+standardfelderausgeben;statmeldung(mentfernenfrage);infeld(fentfernen);
+standardnproc.benennenfreigebenundnproc:benennenausfuellen(statnummer);
+benennenfreigeben;statistiknummer:=statnummer;standardnproc.benennenfreigeben
+:feldfrei(fbezeichnung);feldfrei(fzeilen);feldfrei(fspalten);feldschutz(
+fentfernen);statnummerIN fstatnr;infeld(fbezeichnung).benennenentfernenexec:
+statistikloeschen(statnummer);statmeldung(mgeloescht);standardmaskenfeld(
+niltext,fstatnr).benennenlistebearbeitenstartproc:statlistebearbeiten(
+maskebenennen);IF statlisteeintrag>niltextTHEN standardmaskenfeld(
+statlisteeintrag,fstatnr);benennenfreigebenundnproc;ELSE standardmaskenfeld(
+niltext,fstatnr);leave(2);FI .benennenlistebearbeitenspeichern:IF NOT 
+eingabenokTHEN leave(1);ELIF NOT (statistiknummer=statnummer)AND 
+statistikexistiert(statnummer)THEN statmeldung(mgibtesschon);infeld(fstatnr);
+leave(1);ELSE statmeldung(mspeichern);statistikspeichern(statistiknummer,
+statnummer);enter(1);FI .benennenlisteentfernenstartproc:statlistebearbeiten(
+maskebenennen);IF statlisteeintrag>niltextTHEN standardmaskenfeld(
+statlisteeintrag,fstatnr);benennenschuetzenundnproc;ELSE standardmaskenfeld(
+niltext,fstatnr);leave(2);FI .benennenbearbeitennichtspeichern:statmeldung(
+mnichtspeichern);standardmaskenfeld(niltext,fstatnr);leave(2).
+benennenentfernennichtloeschen:statmeldung(mnichtgeloescht);
+standardmaskenfeld(niltext,fstatnr).nummerok:INT VAR status;standardpruefe(
+pruefeimintervall,fstatnr,1,maxstatistiken,niltext,status);IF status>0THEN 
+infeld(status)FI ;status=0.eingabenok:IF nummerokTHEN standardpruefe(
+pruefeobwert,fbezeichnung,0,0,niltext,status);FI ;IF status=0THEN 
+standardpruefe(pruefeimintervall,fzeilen,1,maxzeilen,niltext,status);FI ;IF 
+status=0THEN standardpruefe(pruefeimintervall,fspalten,1,maxspalten,niltext,
+status);FI ;IF status>0THEN infeld(status);FI ;status=0.statnummer:text(int(
+standardmaskenfeld(fstatnr))).END PROC statbenennen;PROC statmeldung(INT 
+CONST meldungnummer):standardmeldung(meldungnummer,standardmaskenfeld(fstatnr
+)+meldungzusatz);END PROC statmeldung;PROC benennenausfuellen(TEXT CONST 
+statnummer):TEXT VAR bezeichnung;INT VAR wert;forget(statistikdatei+
+statnummer,quiet);fetch(statistikdatei+statnummer,task(statistikserver));stat
+:=sequentialfile(input,statistikdatei+statnummer);standardmaskenfeld(
+statnummer,fstatnr);getline(stat,bezeichnung);standardmaskenfeld(bezeichnung,
+fbezeichnung);get(stat,wert);standardmaskenfeld(text(wert),fzeilen);get(stat,
+wert);standardmaskenfeld(text(wert),fspalten);forget(statistikdatei+
+statnummer,quiet);END PROC benennenausfuellen;BOOL PROC statistikexistiert(
+TEXT CONST statnummer):exists(statistikdatei+statnummer,task(statistikserver)
+)END PROC statistikexistiert;PROC statistikloeschen(TEXT CONST statnummer):
+IF statistikexistiert(statnummer)THEN commanddialogue(FALSE );erase(
+statistikdatei+statnummer,task(statistikserver));commanddialogue(TRUE );FI ;
+END PROC statistikloeschen;PROC statistikspeichern(TEXT CONST altername,
+neuername):INT VAR zeilenneu:=int(standardmaskenfeld(fzeilen)),spaltenneu:=
+int(standardmaskenfeld(fspalten)),benennenneu:=zeilenneu*spaltenneu,zeilenalt
+,spaltenalt,benennenalt,zaehl,zeile,spalte;TEXT VAR dateizeile;FILE VAR 
+statalt;forget(statistikdatei+altername,quiet);forget(statistikdatei+
+neuername,quiet);IF NOT statistikexistiert(altername)THEN 
+erzeugeneuestatistikELSE aenderealtestatistik;statistikloeschen(altername);
+FI ;sichereneuestatistik.erzeugeneuestatistik:erzeugestatistikmitneuemnamen;
+display(meldungback);FOR zaehlFROM benennenneuDOWNTO 1REP line(stat);cout(
+zaehl);PER ;display(meldungrestore).erzeugestatistikmitneuemnamen:stat:=
+sequentialfile(output,statistikdatei+neuername);putline(stat,
+standardmaskenfeld(fbezeichnung));dateizeile:=text(zeilenneu)+space+text(
+spaltenneu)+space;FOR zaehlFROM 1UPTO spaltenneuREP dateizeileCAT text(
+minspaltenbreite);dateizeileCAT space;PER ;putline(stat,dateizeile);line(stat
+).sichereneuestatistik:save(statistikdatei+neuername,task(statistikserver));
+forget(statistikdatei+neuername,quiet).aenderealtestatistik:forget(
+statistikdatei+alt,quiet);fetch(statistikdatei+altername,task(statistikserver
+));rename(statistikdatei+altername,statistikdatei+alt);statalt:=
+sequentialfile(input,statistikdatei+alt);getline(statalt,dateizeile);get(
+statalt,zeilenalt);get(statalt,spaltenalt);benennenalt:=zeilenalt*spaltenalt;
+IF zeilenalt<>zeilenneuOR spaltenalt<>spaltenneuTHEN aenderedieganzestatistik
+ELIF dateizeile<>standardmaskenfeld(fbezeichnung)THEN aenderediedateizeile
+ELSE rename(statistikdatei+alt,statistikdatei+neuername);FI .
+aenderediedateizeile:modify(statalt);tofirstrecord(statalt);writerecord(
+statalt,standardmaskenfeld(fbezeichnung));rename(statistikdatei+alt,
+statistikdatei+neuername).aenderedieganzestatistik:
+erzeugestatistikmitneuemnamen;modify(statalt);zaehl:=benennenneu;display(
+meldungback);FOR zeileFROM 1UPTO min(zeilenalt,zeilenneu)REP 
+uebertrageeinezeileausaltinneu;PER ;FOR zeileFROM zeilenalt+1UPTO zeilenneu
+REP schreibeeineleerezeile;PER ;display(meldungrestore);forget(statistikdatei
++alt,quiet).uebertrageeinezeileausaltinneu:toline(statalt,statistikvorzeilen+
+(zeile-1)*spaltenalt+1);FOR spalteFROM 1UPTO min(spaltenalt,spaltenneu)REP 
+readrecord(statalt,dateizeile);putline(stat,dateizeile);down(statalt);zaehlen
+PER ;FOR spalteFROM spaltenalt+1UPTO spaltenneuREP line(stat);zaehlenPER .
+schreibeeineleerezeile:FOR spalteFROM 1UPTO spaltenneuREP line(stat);zaehlen
+PER .zaehlen:cout(zaehl);zaehlDECR 1.END PROC statistikspeichern;END PACKET 
+benennen;
+
diff --git a/app/schulis/2.2.1/src/5.datenbasis b/app/schulis/2.2.1/src/5.datenbasis
new file mode 100644
index 0000000..4d28ff7
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.datenbasis
@@ -0,0 +1,62 @@
+PACKET datenbasisDEFINES statdatenbasisstartproc,statdatenbasisnproc,
+statdatenbasisaufbereiten,statdatenbasisentfernen,
+statdatenbasisentfernenmeldung,statdatenbasisnichtentfernen,
+statdatenbasisermitteln,statdatenbasisvorhanden:LET datenbasisname=
+"STATISTIK.basis",statistikserver="statistik server",maskedatenbasis=
+"mst datenbasis bereitstellen",niltext="",meldungzusatz="+",meldungstichtag=
+"zum Stichtag ",meldungnichtda="nicht                ",mnichts="+      +",
+mstart="�����������",mkeinedaten=68,mentfernenfrage=470,mkeinebasis=471,
+mbasisentfernt=472,mbasisnichtentfernt=473,maufbereitung=474,mabbruch=475,
+mbasisfertig=476,fstatnr=2,fcursor=3,filesize=4000,tupelstackgroesse=5;FILE 
+VAR basis;BOOL VAR datenbasisda;TEXT VAR datenbasisstichtag;PROC 
+statdatenbasisstartproc:enablestop;standardstartproc(maskedatenbasis);
+statdatenbasisermitteln(fstatnr);statdatenbasisnproc;END PROC 
+statdatenbasisstartproc;PROC statdatenbasisnproc:infeld(fstatnr);
+standardfelderausgeben;infeld(fcursor);standardnproc;END PROC 
+statdatenbasisnproc;PROC statdatenbasisermitteln(INT CONST feldnr):forget(
+datenbasisname,quiet);datenbasisda:=existstask(statistikserver)CAND exists(
+datenbasisname,task(statistikserver));IF datenbasisdaTHEN fetch(
+datenbasisname,task(statistikserver));basis:=sequentialfile(modify,
+datenbasisname);tofirstrecord(basis);readrecord(basis,datenbasisstichtag);
+datenbasisstichtag:=meldungstichtag+datenbasisstichtag;forget(datenbasisname,
+quiet);ELSE datenbasisstichtag:=meldungnichtdaFI ;standardmaskenfeld(
+datenbasisstichtag,feldnr);END PROC statdatenbasisermitteln;BOOL PROC 
+statdatenbasisvorhanden:datenbasisdaEND PROC statdatenbasisvorhanden;PROC 
+statdatenbasisentfernenmeldung:IF datenbasisdaTHEN standardmeldung(
+mentfernenfrage,niltext);infeld(fcursor);ELSE standardmeldung(mkeinebasis,
+niltext);leave(1);FI END PROC statdatenbasisentfernenmeldung;PROC 
+statdatenbasisentfernen:datenbasisloeschen;standardmeldung(mbasisentfernt,
+datenbasisstichtag+meldungzusatz);statdatenbasisermitteln(fstatnr);leave(2);
+END PROC statdatenbasisentfernen;PROC statdatenbasisnichtentfernen:
+standardmeldung(mbasisnichtentfernt,datenbasisstichtag+meldungzusatz);leave(2
+);END PROC statdatenbasisnichtentfernen;PROC datenbasisloeschen:BOOL CONST 
+comdia:=commanddialogue;IF datenbasisdaCAND exists(datenbasisname,task(
+statistikserver))THEN commanddialogue(FALSE );erase(datenbasisname,task(
+statistikserver));commanddialogue(comdia);FI ;END PROC datenbasisloeschen;
+PROC statdatenbasisaufbereiten:BOOL VAR schuelerda,abbruch:=FALSE ;INT VAR 
+anzahltupel:=tupelstackgroesse,bearbeitetetupel:=tupelstackgroesse,
+schuelerzahl:=0;IF datenbasisdaTHEN standardmeldung(mbasisentfernt,
+datenbasisstichtag+meldungzusatz);ELSE standardmeldung(maufbereitung,date+
+meldungzusatz);FI ;schuelerlesenvorbereiten;IF schuelerdaTHEN 
+datenbasisaufbereiten;FI ;IF NOT schuelerdaTHEN standardmeldung(mkeinedaten,
+niltext);ELIF abbruchTHEN standardmeldung(mabbruch,niltext);forget(
+datenbasisname,quiet);ELSE datenbasisloeschen;datenbasissichern;
+statdatenbasisermitteln(fstatnr);standardmeldung(mbasisfertig,niltext);FI ;
+leave(1).datenbasisaufbereiten:forget(datenbasisname,quiet);basis:=
+sequentialfile(output,datenbasisname);putline(basis,date);standardmeldung(
+maufbereitung,date+meldungzusatz);out(mstart);REP putline(basis,
+statdatenbasiszeile);schuelerzahlINCR 1;cout(schuelerzahl);naechsterschueler;
+UNTIL bestandendePER .schuelerindex:ixsustatfamrufgeb.
+schuelerlesenvorbereiten:inittupel(dnrdiffdaten);inittupel(dnrhalbjahresdaten
+);inittupel(dnrschulen);inittupel(dnrschueler);parsenooffields(50);
+systemdboff;search(schuelerindex,FALSE );schuelerda:=dbstatus=ok;
+setzebestandende(NOT schuelerda).naechsterschueler:IF bearbeitetetupel=
+anzahltupelTHEN IF anzahltupel<>tupelstackgroesseTHEN setzebestandende(TRUE )
+;ELIF NOT abbruchgewuenschtTHEN einpaarschuelerholen;FI ;ELSE multisucc;
+bearbeitetetupelINCR 1;FI .einpaarschuelerholen:anzahltupel:=
+tupelstackgroesse;scanstatus(ok);multisucc(schuelerindex,anzahltupel);IF 
+anzahltupel>0THEN multisucc;bearbeitetetupel:=1;ELSE setzebestandende(TRUE )
+FI .abbruchgewuenscht:abbruch:=lines(basis)>=filesize;abbruch.
+datenbasissichern:save(datenbasisname,task(statistikserver)).END PROC 
+statdatenbasisaufbereiten;END PACKET datenbasis;
+
diff --git a/app/schulis/2.2.1/src/5.drucken b/app/schulis/2.2.1/src/5.drucken
new file mode 100644
index 0000000..9b775ff
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.drucken
@@ -0,0 +1,153 @@
+PACKET druckenDEFINES statdrucken:LET statistikdatei="STATISTIK.",
+statistikserver="statistik server",erstedruckdatei="liste.1",druckdatei=
+"liste.",maxstatistiken=200,statistikvorzeilen=3,niltext="",space=" ",quote=
+"""",edittasten="vr",statistiktext="Statistik Nr. ",stichtagtext="Stichtag: "
+,definitiontext="Definition der Statistik Nr. ",groessetext=
+"Größe:    Zeilen,    Spalten",tabellentext=
+"Feld  Z / Sp  Art  Länge  Definition",tabellenlinie=
+"----+--------+----+------+----------",tabelleleer=
+"                           ",prozenttext=" %",meldungzusatz="+",mgibtesnicht
+=477,fstatnr=2,fmini=3,fstd=4,fscreen=5,fprinter=6,tsenkrecht=":",twaagerecht
+="-",tkreuz="+",tschraeg="/",pruefeimintervall=3,pruefenureinkreuz=5,
+minspaltenbreite=4,maxspalten=50,KONST =STRUCT (BOOL def,TEXT maske,INT 
+mvorbereiten,mdrucken,mnichtdrucken);KONST VAR druck;BOOL VAR 
+ausgabebildschirm,ausgabeminimal;TEXT VAR druckstatistik;ROW maxspaltenINT 
+VAR breiten;INT VAR zeilen,spalten,felder;FILE VAR stat;PROC statdrucken(
+BOOL CONST defdrucken,INT CONST was):INT VAR status:=0;IF defdruckenTHEN 
+druck:=KONST :(TRUE ,"mst statistik drucken",484,498,499);ELSE druck:=KONST :
+(FALSE ,"mst statistik ausgeben",481,482,483);FI ;SELECT wasOF CASE 1:
+druckenexecCASE 2:druckenlistezeigenCASE 3:druckenlisteexecCASE 4:ausdrucken;
+enter(1)CASE 5:ausdrucken;leave(2)CASE 6:nichtdrucken;enter(1);CASE 7:
+nichtdrucken;leave(2);END SELECT .druckenexec:standardpruefe(
+pruefeimintervall,fstatnr,1,maxstatistiken,niltext,status);IF NOT 
+alleeingabenkorrektTHEN leave(1);ELIF NOT exists(gewaehltestatistik,task(
+statistikserver))THEN standardmeldung(mgibtesnicht,standardmaskenfeld(2)+
+meldungzusatz);infeld(fstatnr);leave(1);ELSE drucken(text(int(
+standardmaskenfeld(fstatnr))));IF NOT ausgabebildschirmTHEN leave(1);FI ;FI .
+gewaehltestatistik:statistikdatei+text(int(standardmaskenfeld(fstatnr))).
+druckenlistezeigen:status:=0;IF alleeingabenkorrektTHEN statlistezeigen(int(
+standardmaskenfeld(fstatnr)));ELSE leave(1);FI .druckenlisteexec:IF 
+ausgabebildschirmTHEN statlistebearbeiten(druck.maske);IF statlisteeintrag>
+niltextTHEN drucken(statlisteeintrag);ELSE leave(2);FI ;ELSE 
+statlistebearbeiten(druck.maske);WHILE statlisteeintrag>niltextREP drucken(
+statlisteeintrag);statlistebearbeiten(druck.maske);PER ;leave(2);FI .
+alleeingabenkorrekt:IF status=0THEN standardpruefe(pruefenureinkreuz,fmini,
+fstd,0,niltext,status);FI ;IF druck.defTHEN ausgabebildschirm:=
+standardmaskenfeld(fmini)<>niltext;ELSE IF status=0THEN standardpruefe(
+pruefenureinkreuz,fscreen,fprinter,0,niltext,status);FI ;ausgabeminimal:=
+standardmaskenfeld(fmini)<>niltext;ausgabebildschirm:=standardmaskenfeld(
+fscreen)<>niltext;FI ;IF status>0THEN infeld(status)FI ;status=0.ausdrucken:
+standardmeldung(druck.mdrucken,druckstatistik+meldungzusatz);
+druckdateibehandeln(PROC (TEXT CONST )print);druckdateibehandeln(PROC (TEXT 
+CONST )forget).nichtdrucken:infeld(fstatnr);standardmaskenfeld(niltext,
+fstatnr);standardmeldung(druck.mnichtdrucken,druckstatistik+meldungzusatz);
+druckdateibehandeln(PROC (TEXT CONST )forget).END PROC statdrucken;PROC 
+drucken(TEXT CONST statistiknummer):statistiknummerIN fstatnr;infeld(fstatnr)
+;standardmaskenfeld(niltext,fstatnr);erstellediedruckdatei;IF 
+ausgabebildschirmTHEN druckstatistik:=statistiknummer;standardmeldung(niltext
+,meldungzusatz);zeigedatei(erstedruckdatei,edittasten);ELSE standardmeldung(
+druck.mdrucken,statistiknummer+meldungzusatz);druckdateibehandeln(PROC (TEXT 
+CONST )print);druckdateibehandeln(PROC (TEXT CONST )forget);FI .
+erstellediedruckdatei:standardmeldung(druck.mvorbereiten,statistiknummer+
+meldungzusatz+meldungzusatz);druckdateibehandeln(PROC (TEXT CONST )forget);
+statistikladen(statistiknummer);druckvorbereiten;IF druck.defTHEN 
+druckestatdef(statistiknummer);ELSE druckestatistik(statistiknummer);FI ;
+drucknachbereitenohneausdrucken;forget(statistikdatei+statistiknummer,quiet).
+END PROC drucken;PROC druckestatistik(TEXT CONST statistiknummer):TEXT VAR 
+kopf1,kopf2,linie,dateizeile;BOOL VAR inhalt;INT VAR gedrucktespalten:=0,
+spaltendieseseite:=0,aktspalte,aktzeile,aktbreite,zeilenbisseitenende,
+gedrucktefelder:=0;seitenkopffestlegen;evtlspaltenbreitenverkuerzen;REP 
+ermittlespaltendieseseite;druckeallezeilenbiszudieserspalte;gedrucktespalten
+INCR spaltendieseseite;UNTIL gedrucktespalten=spaltenPER .seitenkopffestlegen
+:toline(stat,1);readrecord(stat,kopf1);kopf1:=statistiktext+statistiknummer+
+space+kopf1;toline(stat,statistikvorzeilen);readrecord(stat,kopf2);kopf2:=
+compress(kopf2);IF kopf2>niltextTHEN kopf2:=stichtagtext+kopf2FI ;inhalt:=
+kopf2>niltext;setzemitseitennummern(FALSE );initdruckkopf(kopf1,kopf2).
+evtlspaltenbreitenverkuerzen:IF ausgabeminimalTHEN FOR aktspalteFROM 1UPTO 
+spaltenREP breiten[aktspalte]:=minspaltenbreite;PER FI .
+ermittlespaltendieseseite:initspalten;setzespaltentrenner(tsenkrecht);
+setzespaltenbreite(2);aktbreite:=3;spaltendieseseite:=0;REP spaltendieseseite
+INCR 1;aktbreiteINCR breiten[letztespalte];aktbreiteINCR 1;setzespaltenbreite
+(breiten[letztespalte]);UNTIL letztespalte>=spaltenCOR aktbreite+breiten[
+letztespalte+1]>=druckbreitePER .letztespalte:gedrucktespalten+
+spaltendieseseite.druckeallezeilenbiszudieserspalte:aktzeile:=0;erzeugelinie;
+WHILE aktzeile<zeilenREP druckeeineseitebiszudieserspaltePER .erzeugelinie:
+linie:=twaagerecht+twaagerecht+tkreuz;FOR aktspalteFROM gedrucktespalten+1
+UPTO letztespalteREP linieCAT (breiten[aktspalte]*twaagerecht);linieCAT 
+tkreuz;PER .druckeeineseitebiszudieserspalte:zeilenbisseitenende:=drucklaenge
+(anzahlkopfzeilen);druckkopfschreiben;spaltenkopfschreiben;WHILE 
+zeilenbisseitenende>=benoetigtezeilenREP aktzeileINCR 1;einezeileschreiben;
+IF aktzeileMOD 2=0THEN gibstandaus(statistiknummer,gedrucktefelder,felder);
+FI ;UNTIL aktzeile>=zeilenPER ;seitenwechsel.anzahlkopfzeilen:IF inhaltTHEN 2
+ELSE 1FI .benoetigtezeilen:IF ausgabeminimalTHEN 1ELSE 2FI .
+spaltenkopfschreiben:spaltenweise(niltext);FOR aktspalteFROM gedrucktespalten
++1UPTO letztespalteREP spaltenweise(text(aktspalte,3));PER ;
+druckzeileschreiben(zeile+tsenkrecht);zeilenbisseitenendeDECR 1.
+einezeileschreiben:IF NOT ausgabeminimalTHEN druckzeileschreiben(linie);
+zeilenbisseitenendeDECR 1;FI ;spaltenweise(text(aktzeile,2));FOR aktspalte
+FROM gedrucktespalten+1UPTO letztespalteREP tragefeldinhalteinPER ;
+gedrucktefelderINCR spaltendieseseite;druckzeileschreiben(zeile+tsenkrecht);
+zeilenbisseitenendeDECR 1.tragefeldinhaltein:toline(stat,((aktzeile-1)*
+spalten)+aktspalte+3);readrecord(stat,dateizeile);IF (dateizeileSUB 5)="t"
+THEN dateizeile:=subtext(dateizeile,7,length(dateizeile)-1);changeall(
+dateizeile,quote+quote,quote);spaltenweise(dateizeile);ELIF inhaltTHEN 
+spaltenweise(subtext(dateizeile,1,4));ELSE spaltenweise(niltext);FI .END 
+PROC druckestatistik;PROC druckestatdef(TEXT CONST statistiknummer):TEXT VAR 
+kopfname,kopfgroesse,kopflinie,dateizeile;INT VAR zeilenbisseitenende,aktfeld
+:=0,deffeldbreite,benoetigtezeilen,zeilenende;seitenkopffestlegen;
+tabellefestlegen;liesnaechstesfeld;REP druckeeineseiteUNTIL aktfeld>felder
+PER .seitenkopffestlegen:toline(stat,1);readrecord(stat,kopfname);kopfgroesse
+:=groessetext;replace(kopfgroesse,8,text(zeilen,2));replace(kopfgroesse,19,
+text(spalten,2));setzemitseitennummern(FALSE );initdruckkopf(definitiontext+
+statistiknummer,kopfname).tabellefestlegen:kopflinie:=tabellenlinie;WHILE 
+length(kopflinie)<druckbreiteREP kopflinieCAT twaagerecht;PER ;initspalten;
+setzespaltentrenner(tsenkrecht);setzespaltenbreite(4);setzespaltenbreite(8);
+setzespaltenbreite(4);setzespaltenbreite(6);deffeldbreite:=druckbreite-length
+(tabelleleer).druckeeineseite:zeilenbisseitenende:=drucklaenge(
+anzahlkopfzeilen);druckkopfschreiben;tabellenkopfschreiben;WHILE 
+zeilenbisseitenende>=benoetigtezeilenREP schreibedasfeld;IF aktfeldMOD 15=0
+THEN gibstandaus(statistiknummer,aktfeld,felder);FI ;liesnaechstesfeld;UNTIL 
+aktfeld>felderPER ;seitenwechsel.anzahlkopfzeilen:IF kopfname=niltextTHEN 1
+ELSE 2FI .tabellenkopfschreiben:IF aktfeld<=1THEN druckzeileschreiben(
+kopfgroesse);druckzeileschreiben(niltext);zeilenbisseitenendeDECR 2;FI ;
+druckzeileschreiben(tabellentext);druckzeileschreiben(kopflinie);
+zeilenbisseitenendeDECR 2.liesnaechstesfeld:aktfeldINCR 1;IF aktfeld<=felder
+THEN toline(stat,aktfeld+3);readrecord(stat,dateizeile);spaltenweise(text(
+aktfeld,4));spaltenweise(zeileundspalte);spaltenweise(space+space+(dateizeile
+SUB 5));spaltenweise(text(breiten[aktspalte],5));benoetigtezeilen:=1;IF 
+length(dateizeile)-5>deffeldbreiteTHEN zaehlebenoetigtezeilenFI ;FI .
+zeileundspalte:text(aktzeile,3)+tschraeg+text(aktspalte,3).aktzeile:(aktfeld-
+1)DIV spalten+1.aktspalte:(aktfeld-1)MOD spalten+1.zaehlebenoetigtezeilen:
+zeilenende:=5+deffeldbreite;gehezurueckzumwortende(dateizeile,zeilenende);
+WHILE zeilenende<length(dateizeile)REP benoetigtezeilenINCR 1;
+gehezurueckzumwortende(dateizeile,zeilenende);zeilenendeINCR deffeldbreite+1;
+PER .schreibedasfeld:zeilenende:=5+deffeldbreite;gehezurueckzumwortende(
+dateizeile,zeilenende);druckzeileschreiben(zeile+tsenkrecht+space+subtext(
+dateizeile,6,zeilenende));zeilenbisseitenendeDECR 1;WHILE zeilenende<length(
+dateizeile)REP dateizeile:=subtext(dateizeile,zeilenende+2);zeilenende:=
+deffeldbreite;gehezurueckzumwortende(dateizeile,zeilenende);
+druckzeileschreiben(tabelleleer+subtext(dateizeile,1,zeilenende));
+zeilenbisseitenendeDECR 1;PER .END PROC druckestatdef;PROC 
+gehezurueckzumwortende(TEXT CONST dateizeile,INT VAR zeilenende):INT VAR 
+naechsteszeichen;IF zeilenende<length(dateizeile)CAND NOT amwortendeTHEN REP 
+findewortende;UNTIL NOT hieristeinsamesquotePER ;zeilenende:=max(15,
+zeilenende);FI .findewortende:REP zeilenendeDECR 1;UNTIL amwortendeOR 
+zeilenende<1PER .amwortende:(dateizeileSUB zeilenende)<>spaceAND (dateizeile
+SUB (zeilenende+1))=space.hieristeinsamesquote:naechsteszeichen:=pos(
+dateizeile,"!","�",zeilenende+1);naechsteszeichen>0CAND (dateizeileSUB 
+naechsteszeichen)=quote.END PROC gehezurueckzumwortende;PROC gibstandaus(
+TEXT CONST nummer,INT CONST wert,hundert):disablestop;INT VAR proz:=(wert*100
+)DIV hundert;IF iserrorTHEN clearerror;proz:=int((real(wert)*100.0)/real(
+hundert));FI ;standardmeldung(druck.mvorbereiten,nummer+meldungzusatz+text(
+proz)+prozenttext+meldungzusatz);END PROC gibstandaus;PROC statistikladen(
+TEXT CONST statnummer):TEXT VAR dummy;INT VAR spaltenzaehler;forget(
+statistikdatei+statnummer,quiet);fetch(statistikdatei+statnummer,task(
+statistikserver));stat:=sequentialfile(input,statistikdatei+statnummer);
+getline(stat,dummy);get(stat,zeilen);get(stat,spalten);FOR spaltenzaehler
+FROM 1UPTO spaltenREP get(stat,breiten[spaltenzaehler]);PER ;modify(stat);
+felder:=zeilen*spalten;END PROC statistikladen;PROC druckdateibehandeln(PROC 
+(TEXT CONST )machwas):INT VAR i;TEXT VAR name;commanddialogue(FALSE );get(all
+,name,i);WHILE i>0REP IF subtext(name,1,length(druckdatei))=druckdateiTHEN 
+machwas(name);FI ;get(all,name,i);PER ;commanddialogue(TRUE ).END PROC 
+druckdateibehandeln;END PACKET drucken;
+
diff --git a/app/schulis/2.2.1/src/5.erstellen b/app/schulis/2.2.1/src/5.erstellen
new file mode 100644
index 0000000..902729d
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.erstellen
@@ -0,0 +1,146 @@
+PACKET erstellenDEFINES staterstellen:LET datenbasisname="STATISTIK.basis",
+statistikdatei="STATISTIK.",statistikserver="statistik server",maskeerstellen
+="mst statistik erstellen",niltext="",space=" ",meldungzusatz="+",spaces=
+"          ",sjoker="*",squote="""",sklammerzu=")",adate=2,erstedatenzeile=2,
+defvorzeilen=3,fstatnr=2,fstichtag=3,datepos=14,mkeinebasis=471,mzahleingeben
+=53,mgibtesnicht=477,mstatprozent=479,mstaterstellt=480,ogleich=1,ogroesser=2
+,okleiner=3,ogroessergleich=4,okleinergleich=5,oungleich=6,oenthalten=7,olike
+=8,maxvergleiche=25,ende=0,VERGLEICH =STRUCT (BOOL kursvergleich,INT operator
+,von,bis,INT undvergleich,odervergleich,INT zweiterkursvergleich,TEXT text);
+ROW maxvergleicheVERGLEICH VAR vergleiche;INT VAR anzahlvergleiche,verglpos;
+TEXT VAR vergl,basiszeile;PROC staterstellen(INT CONST was):SELECT wasOF 
+CASE 1:erstellenstartprocCASE 2:erstellenexecCASE 3:statlistezeigen(int(
+standardmaskenfeld(fstatnr)))CASE 4:erstellenlisteexecEND SELECT .
+erstellenstartproc:standardstartproc(maskeerstellen);statdatenbasisermitteln(
+fstichtag);standardnproc.erstellenexec:IF NOT statdatenbasisvorhandenTHEN 
+standardmeldung(mkeinebasis,niltext);ELIF int(standardmaskenfeld(fstatnr))<=0
+THEN standardmaskenfeld(niltext,fstatnr);standardmeldung(mzahleingeben,
+niltext);ELSE holedatenbasis;erstellen(standardmaskenfeld(fstatnr));
+loeschedatenbasis;FI ;leave(1).erstellenlisteexec:statlistebearbeiten(
+maskeerstellen);statdatenbasisermitteln(fstichtag);standardfelderausgeben;IF 
+NOT statdatenbasisvorhandenTHEN standardmeldung(mkeinebasis,niltext);ELSE 
+holedatenbasis;WHILE statlisteeintrag>niltextREP erstellen(statlisteeintrag);
+statlistebearbeiten(maskeerstellen);PER ;loeschedatenbasis;FI ;
+standardmaskenfeld(niltext,fstatnr);leave(2).END PROC staterstellen;PROC 
+erstellen(TEXT CONST statistiknummer):BOOL VAR abbruch:=FALSE ;IF NOT exists(
+gewaehltestatistik,task(statistikserver))THEN standardmeldung(mgibtesnicht,
+statistiknummer+meldungzusatz);ELSE erstellestatistik;FI .erstellestatistik:
+statistiknummerIN fstatnr;standardmaskenfeld(niltext,fstatnr);standardmeldung
+(mstaterstellt,statistiknummer+meldungzusatz+"wird"+meldungzusatz);forget(
+gewaehltestatistik,quiet);fetch(gewaehltestatistik,task(statistikserver));
+fuelleallefelderaus;IF abbruchTHEN standardmeldung(mstaterstellt,
+statistiknummer+meldungzusatz+"nicht"+meldungzusatz);ELSE commanddialogue(
+FALSE );save(gewaehltestatistik,task(statistikserver));commanddialogue(TRUE )
+;standardmeldung(mstaterstellt,statistiknummer+meldungzusatz+
+standardmaskenfeld(fstichtag)+meldungzusatz);FI ;forget(gewaehltestatistik,
+quiet).fuelleallefelderaus:FILE VAR basis:=sequentialfile(modify,
+datenbasisname),stat:=sequentialfile(modify,gewaehltestatistik);INT VAR 
+aktfeld,bearbeitetefelder:=0,felder:=lines(stat)-defvorzeilen;TEXT VAR 
+dateizeile;fuellebedingungfelder;fuellesummenfelder;toline(stat,defvorzeilen)
+;writerecord(stat,subtext(standardmaskenfeld(fstichtag),datepos)).
+fuellebedingungfelder:toline(stat,defvorzeilen+1);col(stat,1);WHILE NOT eof(
+stat)REP readrecord(stat,dateizeile);SELECT pos("bst",dateizeileSUB 5)OF 
+CASE 1:wertebedingungausCASE 2:replace(dateizeile,1,"    ")OTHERWISE 
+bearbeitetefelderINCR 1END SELECT ;writerecord(stat,dateizeile);down(stat);
+UNTIL abbruchPER .fuellesummenfelder:toline(stat,defvorzeilen+1);WHILE NOT 
+eof(stat)REP readrecord(stat,dateizeile);IF (dateizeileSUB 5)="s"THEN 
+wertesummeausFI ;writerecord(stat,dateizeile);down(stat);UNTIL abbruchPER .
+wertebedingungaus:replace(dateizeile,1,text(anzahlschueler(basis,subtext(
+dateizeile,6)),4));gibprozentmeldungaus.wertesummeaus:aktfeld:=lineno(stat);
+replace(dateizeile,1,text(summe(stat,subtext(dateizeile,6)),4));toline(stat,
+aktfeld);gibprozentmeldungaus.gibprozentmeldungaus:bearbeitetefelderINCR 1;
+disablestop;INT VAR proz:=(bearbeitetefelder*100)DIV felder;IF iserrorTHEN 
+clearerror;proz:=int((real(bearbeitetefelder)*100.0)/real(felder));FI ;
+enablestop;standardmeldung(mstatprozent,statistiknummer+meldungzusatz+text(
+proz)+meldungzusatz);.gewaehltestatistik:statistikdatei+statistiknummer.END 
+PROC erstellen;PROC holedatenbasis:forget(datenbasisname,quiet);fetch(
+datenbasisname,task(statistikserver));END PROC holedatenbasis;PROC 
+loeschedatenbasis:forget(datenbasisname,quiet);END PROC loeschedatenbasis;
+INT PROC summe(FILE VAR stat,TEXT CONST formel):INT VAR summe:=0,posi:=1,
+feldnr,faktor;REP faktor:=pos("+-",formelSUB posi);IF faktor>0THEN posiINCR 2
+;FI ;feldnr:=int(subtext(formel,posi+1,posi+4));toline(stat,feldnr+3);IF 
+faktor=2THEN summeDECR int(subtext(stat,1,4));ELSE summeINCR int(subtext(stat
+,1,4));FI ;posi:=pos(formel,space,posi)+1;UNTIL posi<=1PER ;max(summe,0).END 
+PROC summe;INT PROC anzahlschueler(FILE VAR basis,TEXT CONST bedingung):INT 
+VAR erstervergleich,anzahl;liesallevergleiche;zaehledieschueler;anzahl.
+liesallevergleiche:anzahlvergleiche:=0;verglpos:=1;vergl:=bedingung;
+erstervergleich:=liesvergleich.zaehledieschueler:anzahl:=0;toline(basis,
+erstedatenzeile);col(basis,1);WHILE NOT eof(basis)REP readrecord(basis,
+basiszeile);IF vergleichpositiv(erstervergleich)THEN anzahlINCR 1;FI ;down(
+basis);PER .END PROC anzahlschueler;INT PROC liesvergleich:INT VAR wurzel,
+knoten;BOOL VAR opand;wurzel:=naechstervergleich;verglposINCR 1;WHILE 
+nochmehrvergleicheREP liesboolop;knoten:=naechstervergleich;IF opandTHEN 
+verknuepfeand(wurzel,knoten);ELSE verknuepfeor(wurzel,knoten);FI ;verglpos
+INCR 1;PER ;wurzel.naechstervergleich:SELECT pos("(mk",verglSUB verglpos)OF 
+CASE 1:behandleklammerCASE 2:liesmerkmalCASE 3:lieskursOTHERWISE errorstop(
+"unzulässiger Vergleich");0END SELECT .behandleklammer:verglposINCR 1;
+liesvergleich.nochmehrvergleiche:(verglSUB verglpos-1)<>sklammerzuAND 
+verglpos<length(vergl).liesboolop:SELECT pos(vergl," ",verglpos)-verglposOF 
+CASE 2:verglposINCR 3;opand:=FALSE ;CASE 4:verglposINCR 5;opand:=FALSE ;
+OTHERWISE verglposINCR 4;opand:=TRUE ;END SELECT .END PROC liesvergleich;INT 
+PROC liesmerkmal:INT VAR merkmal:=int(subtext(vergl,verglpos+1,verglpos+2)),
+operator:=pos("=><",verglSUB verglpos+4)+pos(".=>",verglSUB verglpos+5),von,
+bis,jokerpos;TEXT VAR vergltext:=niltext;IF operator>okleinerTHEN verglpos
+INCR 7;ELSE verglposINCR 6;FI ;IF (verglSUB verglpos)=sjokerTHEN operator:=
+ogroesser;vergltext:=subtext(spaces,1,statfeldlaenge(merkmal));verglposINCR 1
+;ELSE liestext(vergltext);FI ;erzeugemerkmalvergleich.erzeugemerkmalvergleich
+:von:=statfeldpos(merkmal);bis:=von-1+statfeldlaenge(merkmal);jokerpos:=pos(
+vergltext,sjoker);IF jokerpos>0THEN aenderevergleichsmerkmale;ELIF 
+statfeldart(merkmal)=adateTHEN vergltext:=vergleichbaresdatum(vergltext);FI ;
+anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :(FALSE ,
+operator,von,bis,ende,ende,ende,vergltext);anzahlvergleiche.
+aenderevergleichsmerkmale:IF jokerpos=1AND pos(vergltext,sjoker,2)=length(
+vergltext)THEN operator:=oenthalten;vergltext:=subtext(vergltext,2,length(
+vergltext)-1);ELIF pos(vergltext,sjoker,jokerpos+1)>0THEN operator:=olike;
+ELIF jokerpos=1THEN vergltext:=subtext(vergltext,2);vonINCR (bis-von-length(
+vergltext)+1);ELIF jokerpos=length(vergltext)THEN vergltext:=subtext(
+vergltext,1,length(vergltext)-1);bisDECR (bis-von-length(vergltext)+1);ELSE 
+operator:=olike;FI .END PROC liesmerkmal;PROC liestext(TEXT VAR vergltext):
+INT VAR beginn;verglposINCR 1;REP beginn:=verglpos;verglpos:=pos(vergl,squote
+,beginn+1);vergltextCAT subtext(vergl,beginn,verglpos-1);verglposINCR 1;
+UNTIL (verglSUB verglpos)<>squotePER END PROC liestext;INT PROC lieskurs:
+TEXT VAR vergl1:=niltext,vergl2:=niltext;INT VAR von1:=1,bis1:=0,von2,bis2,
+teilfeld,operator:=ogleich;BOOL VAR zweivergleiche:=FALSE ;ROW 4INT CONST 
+laenge:=ROW 4INT :(2,2,4,1);verglposINCR 6;FOR teilfeldFROM 1UPTO 4REP 
+liesnaechstenteiltext;PER ;erzeugekursvergleich.liesnaechstenteiltext:
+verglposINCR 1;IF (verglSUB verglpos)=sjokerTHEN verglposINCR 1;
+leererteiltext;ELIF zweivergleicheTHEN liestext(vergl2);bis2INCR laenge[
+teilfeld];ELSE liestext(vergl1);bis1INCR laenge[teilfeld];FI .leererteiltext:
+IF zweivergleicheTHEN IF von2>bis2THEN von2INCR laenge[teilfeld];bis2INCR 
+laenge[teilfeld];FI ;ELIF von1>bis1THEN von1INCR laenge[teilfeld];bis1INCR 
+laenge[teilfeld];ELSE zweivergleiche:=TRUE ;von2:=bis1+laenge[teilfeld]+1;
+bis2:=bis1+laenge[teilfeld];FI .erzeugekursvergleich:IF von1>bis1THEN 
+operator:=ogroesser;ELIF zweivergleicheAND von2>bis2THEN zweivergleiche:=
+FALSE ;FI ;anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :(
+TRUE ,operator,von1,bis1,ende,ende,evtlvergl2,vergl1);IF zweivergleicheTHEN 
+anzahlvergleicheINCR 1;vergleiche[anzahlvergleiche]:=VERGLEICH :(TRUE ,
+ogleich,von2,bis2,ende,ende,ende,vergl2);anzahlvergleiche-1ELSE 
+anzahlvergleicheFI .evtlvergl2:IF zweivergleicheTHEN anzahlvergleiche+1ELSE 
+endeFI .END PROC lieskurs;PROC verknuepfeand(INT CONST wurzel,knoten):IF 
+vergleiche[wurzel].undvergleich<>endeTHEN verknuepfeand(vergleiche[wurzel].
+undvergleich,knoten);ELIF wurzel<>knotenTHEN vergleiche[wurzel].undvergleich
+:=knoten;FI ;IF vergleiche[wurzel].odervergleich<>endeTHEN verknuepfeand(
+vergleiche[wurzel].odervergleich,knoten);FI ;END PROC verknuepfeand;PROC 
+verknuepfeor(INT CONST wurzel,knoten):IF vergleiche[wurzel].odervergleich=
+endeTHEN vergleiche[wurzel].odervergleich:=knotenELSE verknuepfeor(vergleiche
+[wurzel].odervergleich,knoten);FI ;END PROC verknuepfeor;BOOL PROC 
+vergleichpositiv(INT CONST wurzel):(wurzelbedingungerfuelltCAND 
+undbedingungenerfuellt)COR oderbedingungenerfuellt.undbedingungenerfuellt:(v.
+undvergleich=endeOR vergleichpositiv(v.undvergleich)).oderbedingungenerfuellt
+:(v.odervergleich<>endeAND vergleichpositiv(v.odervergleich)).
+wurzelbedingungerfuellt:IF v.kursvergleichTHEN kursvergleichpositiv(wurzel)
+ELSE SELECT v.operatorOF CASE ogleich:basistext=v.textCASE ogroesser:
+basistext>v.textCASE okleiner:basistext<v.textCASE ogroessergleich:basistext
+>=v.textCASE okleinergleich:basistext<=v.textCASE oungleich:basistext<>v.text
+CASE oenthalten:pos(basistext,v.text)>0OTHERWISE basistextLIKE v.textEND 
+SELECT FI .basistext:subtext(basiszeile,v.von,v.bis).v:vergleiche[wurzel].
+END PROC vergleichpositiv;BOOL PROC kursvergleichpositiv(INT CONST wurzel):
+INT VAR kurspos:=122;IF v.operator=ogroesserTHEN stellefestobkursebelegtELSE 
+REP kurspos:=pos(basiszeile,v.text,kurspos+1);UNTIL kurspos=0COR (
+kursposstimmtCAND zweitervergleichok)PER ;kurspos>0FI .
+stellefestobkursebelegt:pos(basiszeile,"!","�",kurspos+1)>0.kursposstimmt:((
+kurspos-6)MOD 9)=v.von-1.zweitervergleichok:v.zweiterkursvergleich=endeCOR v2
+.text=subtext(basiszeile,beginn+v2.von,beginn+v2.bis).v:vergleiche[wurzel].v2
+:vergleiche[v.zweiterkursvergleich].beginn:kurspos-v.von.END PROC 
+kursvergleichpositiv;END PACKET erstellen;
+
diff --git a/app/schulis/2.2.1/src/5.felder b/app/schulis/2.2.1/src/5.felder
new file mode 100644
index 0000000..3fd6225
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.felder
@@ -0,0 +1,263 @@
+PACKET felderDEFINES statfelder:LET statistikdatei="STATISTIK.",
+statistikserver="statistik server",maskefelderdefinieren=
+"mst statistik felder definieren",maskefelderbearbeiten=
+"mst statistik felder bearbeiten",maskefelderstandarddruck=
+"mst statistik felder standarddruck",statistikvorzeilen=3,maxstatistiken=200,
+maxspalten=50,minbreite=4,maxbreite=30,niltext="",space=" ",meldungzusatz="+"
+,pruefeimintervall=3,fwarten=1,fstatnr=2,fuebertragen=3,ffeldnr=3,fzeile=4,
+fspalte=5,fart=6,fdef=7,fkopieren=8,fnaechstes=9,mnichterlaubt=34,
+mgibtesnicht=477,martangeben=478,mmussleerbleiben=491,mnureineauswahl=492,
+mspeichern=486,mnichtspeichern=487,muebernehmenfrage=493,mnichtgleichgross=
+494,muebernehmen=495,msyntaxfehler=496,mdefzulang=497;FILE VAR stat;TEXT VAR 
+statistikname;BOOL VAR statgeaendert;INT VAR zeilen,spalten,felder,
+letztemeldung,verlassentiefe;ROW maxspaltenINT VAR breiten;LET normalesende=
+FALSE ,klammeramende=TRUE ,fvergleicherwartet=1,fmerkmalerwartet=2,
+fvergleichsoperwartet=3,fkommaerwartet=4,ftexterwartet=5,fklammerzuerwartet=6
+,fbooloperwartet=7,ftextfeldsummiert=8,fdatumfalsch=9,fhierkeinjoker=10,
+frechenoperwartet=11,ffeldnrerwartet=12,ffeldnrzuhoch=13,fzubreit=14,
+fpatternzulang=15,fzahlfalsch=16,tendedestextes=7,tname=1,ttext=4,atext=1,
+adate=2,azahl=3,akurs=4,squote="""",snull="0",skomma=",",sgleich="=",sspace=
+" ",sgroesser=">",sklammerauf="(",skleiner="<",sklammerzu=")",sgroessergleich
+=">=",sfeld="f",skleinergleich="<=",skurs="kurs",sungleich="<>",smerkmal="m",
+sand="AND",sjoker="*",sor="OR",splus="+",sund="UND",sminus="-",soder="ODER";
+TEXT VAR symbol;INT VAR type,fehlernr;BOOL VAR ok;PROC statfelder(INT CONST 
+was):TEXT VAR bezeichnung,liste;INT VAR breite,hoehe,zaehler,status;SELECT 
+wasOF CASE 1:felderbearbeitenstartprocCASE 2:felderbearbeitenspeichernCASE 3:
+felderbearbeitennaechstesfeldCASE 4:felderbearbeitenzumbeginnCASE 5:
+felderbearbeitenmerkmalslisteCASE 6:felderbearbeitendefinitionkopierenCASE 7:
+felderlistezeigenCASE 8:felderlistebearbeitenstartprocCASE 9:
+felderstandarddruckstartprocCASE 10:felderstandarddruckspeichernCASE 11:
+felderstandarddrucknichtspeichernCASE 12:felderlistestandarddruckstartproc
+CASE 13:felderlistestandarddruckspeichernCASE 14:
+felderlistestandarddrucknichtspeichernCASE 15:
+felderlistestandarddruckzumbeginnCASE 16:felderuebernehmenstartprocCASE 17:
+felderuebernehmenexecCASE 18:allefelderspeichernEND SELECT .
+felderbearbeitenstartproc:IF NOT statnummerokTHEN leave(1);ELIF 
+standardmaskenfeld(fuebertragen)>niltextTHEN standardmeldung(mmussleerbleiben
+,niltext);infeld(fuebertragen);leave(1);ELSE statistikladen(statnummer);
+standardstartproc(maskefelderbearbeiten);verlassentiefe:=0;feldbearbeiten(1);
+standardnproc;FI .felderbearbeitenspeichern:IF NOT feldeingabenokTHEN leave(1
+);ELSE speicherefeldab;felderbearbeitennaechstesfeld;FI .
+felderbearbeitennaechstesfeld:IF NOT naechstefeldnummerokTHEN leave(1);ELIF 
+compress(standardmaskenfeld(fnaechstes))=niltextTHEN 
+felderbearbeitenzumbeginnELSE feldbearbeiten(int(standardmaskenfeld(
+fnaechstes)));leave(1);FI .felderbearbeitenzumbeginn:statistiksichern;
+standardstartproc(maskefelderdefinieren);standardmaskenfeld(statistikname,
+fstatnr);leave(2+verlassentiefe).allefelderspeichern:WHILE feldeingabenok
+CAND naechstefeldnummerokREP speicherefeldab;IF standardmaskenfeld(fnaechstes
+)=niltextTHEN felderbearbeitenzumbeginn;LEAVE allefelderspeichernELSE 
+feldbearbeiten(int(standardmaskenfeld(fnaechstes)));FI ;PER ;leave(1).
+felderbearbeitenmerkmalsliste:WINDOW VAR w:=startwindow(40,23,77,1);open(w);
+bereitelisteauf;listeCAT "*";listeCAT auskunftstextende;auskunfterteilung(
+liste,w,FALSE );reorganizescreen;setlasteditvalues;leave(1).bereitelisteauf:
+liste:="Bez.  Feld                Länge";listeCAT auskunftstextende;FOR 
+zaehlerFROM 1UPTO 50REP IF zaehler=39THEN listeCAT 
+"      davon Art               2";listeCAT auskunftstextende;listeCAT 
+"            Fach              2";listeCAT auskunftstextende;listeCAT 
+"            Kennung           4";listeCAT auskunftstextende;listeCAT 
+"            Klausur           1";listeCAT auskunftstextende;FI ;IF zaehler<
+10THEN listeCAT "m0"ELSE listeCAT "m"FI ;listeCAT text(zaehler);listeCAT 
+" = ";listeCAT text(statfeldname(zaehler),24);listeCAT text(statfeldlaenge(
+zaehler));listeCAT auskunftstextende;PER .felderbearbeitendefinitionkopieren:
+standardpruefe(pruefeimintervall,fkopieren,1,felder,niltext,status);IF status
+>0THEN infeld(status)ELSE felddefinitionzeigen(int(standardmaskenfeld(
+fkopieren)))FI ;leave(1).felderlistezeigen:letztemeldung:=0;statlistezeigen(
+int(standardmaskenfeld(fstatnr))).felderlistebearbeitenstartproc:IF 
+highestentry(thesaurusauswahl)=1THEN statlistebearbeiten(
+maskefelderbearbeiten);statistikladen(statlisteeintrag);verlassentiefe:=1;
+feldbearbeiten(1);standardnproc;ELSE standardstartproc(maskefelderdefinieren)
+;IF highestentry(thesaurusauswahl)>1THEN standardmeldung(mnureineauswahl,
+niltext);FI ;leave(2);FI .felderstandarddruckstartproc:IF NOT statnummerok
+THEN leave(1);ELIF standardmaskenfeld(fuebertragen)>niltextTHEN 
+standardmeldung(mmussleerbleiben,niltext);infeld(fuebertragen);leave(1);ELSE 
+statistikladen(statnummer);standardstartproc(maskefelderstandarddruck);
+spaltenbreiteneintragen;standardnproc;FI .felderstandarddruckspeichern:IF 
+NOT spaltenbreitenokTHEN leave(1);ELSE spaltenbreitenspeichern;
+standardstartproc(maskefelderdefinieren);standardmeldung(mspeichern,
+statistikname+meldungzusatz);statistiksichern;standardmaskenfeld(
+statistikname,fstatnr);leave(2);FI .felderstandarddrucknichtspeichern:
+standardstartproc(maskefelderdefinieren);standardmeldung(mnichtspeichern,
+statistikname+meldungzusatz);statistikvergessen;standardmaskenfeld(
+statistikname,fstatnr);leave(2).felderlistestandarddruckstartproc:
+statlistebearbeiten(maskefelderstandarddruck);IF statlisteeintrag>niltext
+THEN statistikladen(statlisteeintrag);spaltenbreiteneintragen;standardnproc;
+ELSE standardstartproc(maskefelderdefinieren);IF letztemeldung=mspeichernOR 
+letztemeldung=mnichtspeichernTHEN standardmeldung(letztemeldung,statistikname
++meldungzusatz);FI ;leave(2);FI .felderlistestandarddruckspeichern:IF NOT 
+spaltenbreitenokTHEN leave(1);ELSE standardmeldung(mspeichern,statistikname+
+meldungzusatz);letztemeldung:=mspeichern;spaltenbreitenspeichern;
+statistiksichern;standardmaskenfeld(statistikname,fstatnr);enter(1);FI .
+felderlistestandarddrucknichtspeichern:standardmeldung(mnichtspeichern,
+statistikname+meldungzusatz);letztemeldung:=mnichtspeichern;
+statistikvergessen;enter(1).felderlistestandarddruckzumbeginn:
+statistikvergessen;enter(3).felderuebernehmenstartproc:standardpruefe(
+pruefeimintervall,fuebertragen,1,maxstatistiken,niltext,status);IF status>0
+THEN infeld(status);leave(1);ELIF NOT statistikexistiert(uebernehmennummer)
+THEN standardmeldung(mgibtesnicht,uebernehmennummer+meldungzusatz);infeld(
+fuebertragen);leave(1);ELIF NOT statnummerokTHEN leave(1);ELIF 
+diedefinitionensindnichtgleichgrossTHEN standardmeldung(mnichtgleichgross,
+niltext);leave(1);ELSE standardmeldung(muebernehmenfrage,niltext);feldschutz(
+fwarten);feldschutz(fstatnr);feldschutz(fuebertragen);infeld(fwarten);
+standardnproc;FI .diedefinitionensindnichtgleichgross:statistikladen(
+statnummer);hoehe:=zeilen;breite:=spalten;statistikvergessen;statistikladen(
+uebernehmennummer);statistikvergessen;hoehe<>zeilenOR breite<>spalten.
+felderuebernehmenexec:statistikladen(statnummer);tofirstrecord(stat);
+readrecord(stat,bezeichnung);statistikvergessen;statistikladen(
+uebernehmennummer);tofirstrecord(stat);writerecord(stat,bezeichnung);toline(
+stat,statistikvorzeilen);writerecord(stat,niltext);rename(statistikdatei+
+uebernehmennummer,statistikdatei+statnummer);statistikname:=statnummer;
+statistiksichern;standardmeldung(muebernehmen,uebernehmennummer+meldungzusatz
+);feldfrei(fstatnr);feldfrei(fuebertragen);standardmaskenfeld(niltext,
+fuebertragen);infeld(fstatnr);leave(2).naechstefeldnummerok:IF compress(
+standardmaskenfeld(fnaechstes))=niltextTHEN standardmaskenfeld(niltext,
+fnaechstes);status:=0;ELSE standardpruefe(pruefeimintervall,fnaechstes,1,
+felder,niltext,status);FI ;IF status>0THEN infeld(status)FI ;status=0.
+feldeingabenok:status:=0;IF art=0THEN standardmeldung(mnichterlaubt,niltext);
+status:=fart;ELIF NOT definitionokTHEN status:=fdef;ELIF standardmaskenfeld(
+fkopieren)>niltextTHEN standardmeldung(mmussleerbleiben,niltext);status:=
+fkopieren;ELIF NOT naechstefeldnummerokTHEN status:=fnaechstes;FI ;IF status>
+0THEN infeld(status);FI ;status=0.definitionok:SELECT artOF CASE 1:
+bedingungok(fdef)CASE 2:summeok(fdef)CASE 3:textok(fdef,breiten[int(
+standardmaskenfeld(fspalte))])OTHERWISE leerokEND SELECT .leerok:IF 
+standardmaskenfeld(fdef)>niltextTHEN standardmeldung(martangeben,niltext);
+FALSE ELSE TRUE FI .art:IF standardmaskenfeld(fart)=niltextTHEN 4ELSE pos(
+"bst ",standardmaskenfeld(fart))FI .spaltenbreiteneintragen:input(stat);
+getline(stat,bezeichnung);get(stat,hoehe);get(stat,breite);standardmaskenfeld
+(text(statistikname,3),fstatnr);FOR zaehlerFROM 1UPTO spaltenREP 
+tragespaltenwertein;feldfrei(breitenfeld+1);PER ;FOR zaehlerFROM spalten+1
+UPTO maxspaltenREP standardmaskenfeld(space+space,breitenfeld);
+standardmaskenfeld(space+space,breitenfeld+1);feldschutz(breitenfeld+1);PER ;
+modify(stat);infeld(2);standardfelderausgeben;infeld(4).tragespaltenwertein:
+get(stat,breite);standardmaskenfeld(text(zaehler,2),breitenfeld);
+standardmaskenfeld(text(breite),breitenfeld+1).breitenfeld:(zaehler-1)MOD 10*
+10+(zaehler-1)DIV 10*2+3.spaltenbreitenok:FOR zaehlerFROM 1UPTO spaltenREP 
+standardpruefe(pruefeimintervall,breitenfeld+1,minbreite,maxbreite,niltext,
+status);UNTIL status>0PER ;IF status>0THEN infeld(status)FI ;status=0.
+spaltenbreitenspeichern:bezeichnung:=text(zeilen)+space+text(spalten)+space;
+FOR zaehlerFROM 1UPTO spaltenREP bezeichnungCAT text(int(standardmaskenfeld(
+breitenfeld+1)));bezeichnungCAT space;PER ;toline(stat,2);writerecord(stat,
+bezeichnung).statnummerok:standardpruefe(pruefeimintervall,fstatnr,1,
+maxstatistiken,niltext,status);IF status>0THEN infeld(status)ELIF NOT 
+statistikexistiert(statnummer)THEN standardmeldung(mgibtesnicht,statnummer+
+meldungzusatz);infeld(fstatnr);status:=fstatnrFI ;status=0.statnummer:text(
+int(standardmaskenfeld(fstatnr))).uebernehmennummer:text(int(
+standardmaskenfeld(fuebertragen))).END PROC statfelder;PROC statistikladen(
+TEXT CONST statnummer):INT VAR spaltenzaehler;forget(statistikdatei+
+statnummer,quiet);fetch(statistikdatei+statnummer,task(statistikserver));stat
+:=sequentialfile(input,statistikdatei+statnummer);getline(stat,statistikname)
+;get(stat,zeilen);get(stat,spalten);FOR spaltenzaehlerFROM 1UPTO spaltenREP 
+get(stat,breiten[spaltenzaehler]);PER ;modify(stat);felder:=zeilen*spalten;
+statistikname:=statnummer;statgeaendert:=FALSE ;END PROC statistikladen;PROC 
+statistiksichern:IF statgeaendertTHEN toline(stat,statistikvorzeilen);
+writerecord(stat,niltext);FI ;commanddialogue(FALSE );save(statistikdatei+
+statistikname,task(statistikserver));commanddialogue(TRUE );
+statistikvergessen;END PROC statistiksichern;PROC statistikvergessen:forget(
+statistikdatei+statistikname,quiet);END PROC statistikvergessen;BOOL PROC 
+statistikexistiert(TEXT CONST statnummer):exists(statistikdatei+statnummer,
+task(statistikserver))END PROC statistikexistiert;PROC feldbearbeiten(INT 
+CONST feldnummer):standardmaskenfeld(text(statistikname,3),fstatnr);
+standardmaskenfeld(text(feldnummer,4),ffeldnr);standardmaskenfeld(text((
+feldnummer-1)DIV spalten+1,2),fzeile);standardmaskenfeld(text((feldnummer-1)
+MOD spalten+1,2),fspalte);IF feldnummer<felderTHEN standardmaskenfeld(text(
+feldnummer+1),fnaechstes);ELSE standardmaskenfeld(niltext,fnaechstes);FI ;
+felddefinitionzeigen(feldnummer);END PROC feldbearbeiten;PROC 
+felddefinitionzeigen(INT CONST feldnummer):TEXT VAR felddefinition;toline(
+stat,statistikvorzeilen+feldnummer);readrecord(stat,felddefinition);
+standardmaskenfeld(felddefinitionSUB 5,fart);standardmaskenfeld(subtext(
+felddefinition,6),fdef);standardmaskenfeld(niltext,fkopieren);infeld(fstatnr)
+;standardfelderausgeben;infeld(fart);END PROC felddefinitionzeigen;PROC 
+speicherefeldab:TEXT VAR felddefinition;IF standardmaskenfeld(fart)=niltext
+OR standardmaskenfeld(fart)=spaceTHEN felddefinition:=niltextELSE 
+felddefinition:=minbreite*space;felddefinitionCAT standardmaskenfeld(fart);
+felddefinitionCAT standardmaskenfeld(fdef);FI ;toline(stat,statistikvorzeilen
++int(standardmaskenfeld(ffeldnr)));writerecord(stat,felddefinition);
+statgeaendert:=TRUE ;END PROC speicherefeldab;BOOL PROC bedingungok(INT 
+CONST maskenfeld):TEXT VAR bedingung;ok:=TRUE ;fehlernr:=0;scan(
+standardmaskenfeld(maskenfeld));naechstessymbol;bedingung:=normbedingung(
+normalesende);IF NOT okTHEN standardmeldung(msyntaxfehler,fehlermeldung+
+meldungzusatz);ELIF length(bedingung)>250THEN standardmaskenfeld(bedingung,
+maskenfeld);standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld(
+bedingung,maskenfeld);bedingungIN maskenfeld;FI ;okEND PROC bedingungok;TEXT 
+PROC normbedingung(BOOL CONST endeklammerzu):TEXT VAR bedingung:=niltext,
+operator;INT VAR merkmal;IF type=tendedestextesTHEN fehler(fvergleicherwartet
+);ELIF symbol=sklammeraufTHEN behandleklammerELIF symbol=skursTHEN 
+behandlekursELSE behandlemerkmalFI ;IF NOT okTHEN ELIF type<>tendedestextes
+THEN liesverknuepfungoderklammerzuELIF endeklammerzuTHEN fehler(
+fklammerzuerwartet);FI ;bedingung.behandleklammer:naechstessymbol;bedingung:=
+sklammerauf+normbedingung(klammeramende)+sklammerzu.behandlemerkmal:
+liesmerkmal;liesoperator;IF okTHEN bedingungCAT textderlaenge(statfeldlaenge(
+merkmal),statfeldart(merkmal),operator);FI .liesmerkmal:merkmal:=int(subtext(
+symbol,2,3));IF type=tnameAND length(symbol)=3AND (symbolSUB 1)=smerkmalAND 
+merkmal>=1AND merkmal<=50AND lastconversionokTHEN bedingungCAT symbol;
+naechstessymbol;ELSE fehler(fmerkmalerwartet);FI .liesoperator:IF symbol=
+sgleichOR symbol=sgroesserOR symbol=sgroessergleichOR symbol=sungleichOR 
+symbol=skleinerOR symbol=skleinergleichTHEN bedingungCAT sspace;bedingungCAT 
+symbol;bedingungCAT sspace;operator:=symbol;ELIF okTHEN fehler(
+fvergleichsoperwartet);FI .behandlekurs:naechstessymbol;IF symbol=sgleich
+THEN bedingungCAT skurs+sspace+sgleich+sspace;bedingungCAT textderlaenge(2,
+akurs,sgleich);lieskomma;bedingungCAT textderlaenge(2,akurs,sgleich);
+lieskomma;bedingungCAT textderlaenge(4,akurs,sgleich);lieskomma;bedingungCAT 
+textderlaenge(1,akurs,sgleich);ELSE fehler(fvergleichsoperwartet)FI .
+lieskomma:IF symbol=skommaTHEN bedingungCAT symbol;ELIF okTHEN fehler(
+fkommaerwartet);FI .liesverknuepfungoderklammerzu:IF endeklammerzuAND symbol=
+sklammerzuTHEN naechstessymbol;ELIF symbol=sandOR symbol=sundOR symbol=sorOR 
+symbol=soderTHEN bedingungCAT sspace;bedingungCAT symbol;bedingungCAT sspace;
+naechstessymbol;bedingungCAT normbedingung(endeklammerzu);ELSE fehler(
+fbooloperwartet);FI .END PROC normbedingung;TEXT PROC textderlaenge(INT 
+CONST laenge,art,TEXT CONST operator):TEXT VAR textsammler:=niltext;IF ok
+THEN sammletextteile;normieretext;textanhaengen;FI ;textsammler.
+sammletextteile:REP naechstessymbol;IF type=ttextTHEN textsammlerCAT symbol
+ELIF symbol=sjokerTHEN textsammlerCAT symbolELSE fehler(ftexterwartet);FI ;
+naechstessymbol;UNTIL NOT okOR symbol<>splusPER .normieretext:SELECT artOF 
+CASE atext:textbehandelnCASE adate:datumbehandelnCASE azahl:zahlbehandeln
+CASE akurs:kursbehandelnEND SELECT .textbehandeln:WHILE pos(textsammler,
+sjoker+sjoker)>0REP change(textsammler,sjoker+sjoker,sjoker);PER ;IF pos(
+textsammler,sjoker)=0THEN textsammler:=text(textsammler,laenge);ELIF operator
+<>sgleichTHEN fehler(fhierkeinjoker);ELIF length(textsammler)>laengeTHEN 
+fehler(fpatternzulang);FI .datumbehandeln:textsammler:=datum(datum(
+textsammler));IF textsammler=niltextTHEN fehler(fdatumfalsch);FI .
+zahlbehandeln:textsammler:=text(int(subtext(textsammler,1,4)));IF length(
+textsammler)>laengeOR textsammler=niltextOR NOT lastconversionokTHEN fehler(
+fzahlfalsch)ELSE textsammler:=(laenge-length(textsammler))*snull+textsammler;
+FI .kursbehandeln:IF pos(textsammler,sjoker)=0THEN textsammler:=text(
+textsammler,laenge);ELIF length(textsammler)<>1THEN fehler(fhierkeinjoker);
+FI .textanhaengen:IF textsammler<>sjokerTHEN changeall(textsammler,squote,
+squote+squote);textsammler:=squote+textsammler+squote;FI .END PROC 
+textderlaenge;BOOL PROC summeok(INT CONST maskenfeld):TEXT VAR summe:=niltext
+;ok:=TRUE ;fehlernr:=0;scan(standardmaskenfeld(maskenfeld));summenormieren;
+IF NOT okTHEN standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz);
+ELIF length(summe)>250THEN standardmaskenfeld(summe,maskenfeld);
+standardmeldung(mdefzulang,niltext);ELSE standardmaskenfeld(summe,maskenfeld)
+;summeIN maskenfeld;FI ;ok.summenormieren:naechstessymbol;REP IF symbol=splus
+OR symbol=sminusTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF 
+summe>niltextTHEN fehler(frechenoperwartet);FI ;INT CONST feldnr:=int(subtext
+(symbol,2,5));IF okTHEN IF type=tnameCAND lastconversionokCAND (symbolSUB 1)=
+sfeldCAND (symbolSUB 2)<>snullCAND feldnr>=1CAND feldnr<=felderCAND NOT 
+isttextfeldTHEN summeCAT sspace;summeCAT symbol;naechstessymbol;ELIF feldnr>
+felderTHEN fehler(ffeldnrzuhoch);ELIF isttextfeldTHEN fehler(
+ftextfeldsummiert);ELIF okTHEN fehler(ffeldnrerwartet);FI ;FI ;UNTIL type=
+tendedestextesOR NOT okPER ;summe:=subtext(summe,2).isttextfeld:toline(stat,
+statistikvorzeilen+feldnr);subtext(stat,minbreite+1,minbreite+1)="t".END 
+PROC summeok;BOOL PROC textok(INT CONST maskenfeld,feldbreite):TEXT VAR tex:=
+compress(standardmaskenfeld(maskenfeld));fehlernr:=0;ok:=TRUE ;scan(tex);
+naechstessymbol;IF type=tendedestextesTHEN tex:=squote+squoteELIF pos(symbol,
+sjoker)>0THEN fehler(fhierkeinjoker)ELIF type<>ttextTHEN fehler(ftexterwartet
+);ELIF length(symbol)>feldbreiteTHEN fehler(fzubreit);ELSE naechstessymbol;
+IF type<>tendedestextesTHEN fehler(ftexterwartet);FI ;FI ;IF NOT okTHEN 
+standardmeldung(msyntaxfehler,fehlermeldung+meldungzusatz);ELSE 
+standardmaskenfeld(tex,maskenfeld);texIN maskenfeld;FI ;ok.END PROC textok;
+PROC naechstessymbol:nextsymbol(symbol,type);END PROC naechstessymbol;PROC 
+fehler(INT CONST nummer):ok:=FALSE ;fehlernr:=nummer;END PROC fehler;TEXT 
+PROC fehlermeldung:SELECT fehlernrOF CASE fvergleicherwartet:
+"Vergleich erwartet"CASE fmerkmalerwartet:"Merkmal m01 bis m50 erwartet"CASE 
+fvergleichsoperwartet:"=, >, <, >=, <= oder <> erwartet"CASE fkommaerwartet:
+"Komma erwartet"CASE ftexterwartet:"""Text"" erwartet"CASE fklammerzuerwartet
+:"')' erwartet"CASE fbooloperwartet:"'UND' oder 'ODER' erwartet"CASE 
+ftextfeldsummiert:"Text-Feld in der Summenformel"CASE fdatumfalsch:
+"Datum nicht zulässig"CASE fhierkeinjoker:"'*' nicht zulässig"CASE 
+frechenoperwartet:"'+' oder '-' erwartet"CASE ffeldnrerwartet:
+"Feldnummer (z.B. f17) erwartet"CASE ffeldnrzuhoch:"Feldnummer zu hoch"CASE 
+fzubreit:"Text länger als Spaltenbreite"CASE fpatternzulang:
+"Pattern für das Merkmal zu lang"CASE fzahlfalsch:"Zahl falsch angegeben"
+OTHERWISE niltextEND SELECT END PROC fehlermeldung;END PACKET felder;
+
diff --git a/app/schulis/2.2.1/src/5.manager b/app/schulis/2.2.1/src/5.manager
new file mode 100644
index 0000000..c7fb1e4
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.manager
@@ -0,0 +1,47 @@
+PACKET statistikmanagerDEFINES statistikmanager:LET statistikdatei=
+"STATISTIK.",statistikbasis="STATISTIK.basis",statistikverzeichnis=
+"statistik verzeichnis",maxstatistiken=200,maxtheslaenge=80,niltext="",
+trenner="  ",stichtag="Stichtag ",keinstichtag="                 ";LET ack=0,
+fetchcode=11,savecode=12,erasecode=14,continuecode=100;THESAURUS VAR 
+statliste,statbezeichnungen;TEXT VAR filename;BOUND STRUCT (TEXT name,
+writepass,readpass)VAR msg;PROC statmanager(DATASPACE VAR ds,INT CONST order,
+phase,TASK CONST ordertask):disablestop;IF order>continuecodeTHEN 
+yterminaldialogELIF order=fetchcodeTHEN ylisteschickenELIF order=savecode
+THEN yeintraghinzufuegenELIF order=erasecodeTHEN yeintragloeschenELSE 
+freemanager(ds,order,phase,ordertask)FI .yeintraghinzufuegen:IF phase=1THEN 
+getfilename;freemanager(ds,order,phase,ordertask);ELSE freemanager(ds,order,
+phase,ordertask);IF NOT iserrorAND exists(filename)THEN eintragloeschen(
+filename);eintraghinzufuegen(filename);FI FI .yeintragloeschen:getfilename;
+freemanager(ds,order,phase,ordertask);IF NOT iserrorAND phase<>1AND NOT 
+exists(filename)THEN eintragloeschen(filename);FI .ylisteschicken:getfilename
+;IF filename=statistikverzeichnisTHEN schickedenthesaurusELSE freemanager(ds,
+order,phase,ordertask)FI .schickedenthesaurus:forget(ds);ds:=nilspace;BOUND 
+THESAURUS VAR allestatistiken:=ds;allestatistiken:=statbezeichnungen;send(
+ordertask,ack,ds);forget(ds).yterminaldialog:freemanager(ds,order,phase,
+ordertask);clearerror;statlisteerstellen.getfilename:msg:=ds;filename:=msg.
+name.END PROC statmanager;PROC eintragloeschen(TEXT CONST filename):
+enablestop;INT VAR index:=link(statliste,filename);IF index>0AND iststatistik
+(filename)THEN delete(statliste,index);delete(statbezeichnungen,index);FI 
+END PROC eintragloeschen;PROC eintraghinzufuegen(TEXT CONST filename):
+disablestop;IF iststatistik(filename)THEN eintragbearbeiten(filename);IF 
+iserrorTHEN clearerror;forget(filename,quiet);FI ;ELIF NOT (filename=
+statistikbasis)THEN forget(filename,quiet);FI .END PROC eintraghinzufuegen;
+PROC eintragbearbeiten(TEXT CONST filename):enablestop;FILE VAR f:=
+sequentialfile(modify,filename);TEXT VAR eintrag,dateizeile;eintrag:=text(int
+(statistiknummer),3);eintragCAT trenner;eintragCAT stichtagtext;eintragCAT 
+trenner;eintragCAT bezeichnung;insert(statliste,filename);insert(
+statbezeichnungen,subtext(eintrag,1,maxtheslaenge)).statistiknummer:subtext(
+filename,length(statistikdatei)+1).stichtagtext:toline(f,3);readrecord(f,
+dateizeile);IF dateizeile>niltextTHEN stichtag+dateizeileELSE keinstichtagFI 
+.bezeichnung:toline(f,1);readrecord(f,dateizeile);dateizeile.END PROC 
+eintragbearbeiten;PROC statlisteerstellen:enablestop;INT VAR index:=0;TEXT 
+VAR eintrag;statliste:=emptythesaurus;statbezeichnungen:=emptythesaurus;get(
+all,eintrag,index);WHILE index>0REP eintraghinzufuegen(eintrag);get(all,
+eintrag,index);PER ;END PROC statlisteerstellen;BOOL PROC iststatistik(TEXT 
+CONST filename):enablestop;TEXT CONST zahltext:=subtext(filename,length(
+statistikdatei)+1);INT CONST zahl:=int(zahltext);subtext(filename,1,length(
+statistikdatei))=statistikdateiAND zahl>=1AND zahl<=maxstatistikenAND text(
+zahl)=zahltext.END PROC iststatistik;PROC statistikmanager:statlisteerstellen
+;globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,TASK CONST )
+statmanager)END PROC statistikmanager;END PACKET statistikmanager;
+
diff --git a/app/schulis/2.2.1/src/5.merkmale b/app/schulis/2.2.1/src/5.merkmale
new file mode 100644
index 0000000..f41709f
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.merkmale
@@ -0,0 +1,52 @@
+PACKET merkmaleDEFINES statfeldname,statfeldlaenge,statfeldpos,statfeldart,
+statdatenbasiszeile,vergleichbaresdatum:LET niltext="",space=" ",null="0",
+arttext=1,artdate=2,artzahl=3;ROW 50INT CONST feldnr:=ROW 50INT :(5,6,7,8,10,
+12,13,0,16,17,18,0,27,35,36,38,39,42,43,44,45,46,47,48,49,50,55,56,58,59,61,
+62,64,65,67,68,69,0,0,0,0,0,0,0,0,0,0,0,0,0);ROW 50INT CONST feldlaenge:=ROW 
+50INT :(8,3,2,4,1,1,2,2,8,1,1,2,3,3,1,1,3,2,8,4,4,4,4,4,4,4,2,3,2,3,2,3,2,3,2
+,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9);ROW 50INT CONST feldpos:=ROW 50INT :(1,9,12,
+14,18,19,20,22,24,32,33,34,36,39,42,43,44,47,49,57,61,65,69,73,77,81,85,87,90
+,92,95,97,100,102,105,107,115,123,132,141,150,159,168,177,186,195,204,213,222
+,231);ROW 50INT CONST feldart:=ROW 50INT :(2,1,3,1,1,1,3,1,2,1,1,1,1,1,1,1,1,
+3,2,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1);TEXT 
+CONST leerezeile:=(feldpos[38]-1)*space,leerekurse:=(feldlaenge[38]*(50-37))*
+space;TEXT PROC statfeldname(INT CONST merkmal):INT CONST feldnum:=feldnr[
+merkmal];IF feldnum>0THEN name(feldnum)ELIF merkmal=8THEN 
+"Schulart letzte Schule"ELIF merkmal=12THEN "Schulart neue Schule"ELSE text(
+merkmal-37)+". Kurs"FI .END PROC statfeldname;INT PROC statfeldlaenge(INT 
+CONST merkmal):feldlaenge[merkmal]END PROC statfeldlaenge;INT PROC 
+statfeldpos(INT CONST merkmal):feldpos[merkmal]END PROC statfeldpos;INT PROC 
+statfeldart(INT CONST merkmal):feldart[merkmal]END PROC statfeldart;TEXT 
+PROC statdatenbasiszeile:TEXT VAR zeile:=leerezeile,kurse:=leerekurse,kennung
+,schule;INT VAR feldzaehler;holediffdaten;uebertragestandardfelder;
+uebertrageschularten;IF hjdatendaTHEN uebertragehjdatenFI ;zeileCAT kurse;
+zeile.uebertragestandardfelder:FOR feldzaehlerFROM 1UPTO 38REP IF feldnr[
+feldzaehler]>0THEN replace(zeile,feldpos[feldzaehler],feldinhalt);FI ;PER .
+feldinhalt:SELECT feldart[feldzaehler]OF CASE arttext:feldwertCASE artdate:
+vergleichbaresdatum(feldwert)CASE artzahl:kennung:=compress(feldwert);(
+feldlaenge[feldzaehler]-length(kennung))*null+kennungOTHERWISE niltextEND 
+SELECT .feldwert:subtext(wert(feldnr[feldzaehler]),1,feldlaenge[feldzaehler])
+.holediffdaten:IF wert(fnrsutiddiffdaten)=niltextTHEN errorstop(
+"Keine Diffdaten zu Schüler "+wert(fnrsufamnames));ELSE readtid(dnrdiffdaten,
+wert(fnrsutiddiffdaten));FI .uebertrageschularten:schule:=wert(
+fnrsuskennlschule);IF schule>niltextTHEN putwert(fnrschkennung,schule);search
+(dnrschulen);IF dbstatus=okTHEN replace(zeile,feldpos[8],wert(fnrschart));FI 
+;FI ;schule:=wert(fnrsuskennnschule);IF schule>niltextTHEN putwert(
+fnrschkennung,schule);search(dnrschulen);IF dbstatus=okTHEN replace(zeile,
+feldpos[12],wert(fnrschart));FI ;FI .hjdatenda:wert(fnrsutidakthjd)>niltext.
+uebertragehjdaten:readtid(dnrhalbjahresdaten,wert(fnrsutidakthjd));kennung:=
+wert(fnrhjdkursart);FOR feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP 
+replace(kurse,feldzaehler*9+1,diesekurskennung);PER ;kennung:=wert(fnrhjdfach
+);FOR feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP replace(kurse,
+feldzaehler*9+3,diesefachkennung);PER ;kennung:=wert(fnrhjdlerngrpkenn);FOR 
+feldzaehlerFROM 0UPTO length(kennung)DIV 2-1REP replace(kurse,feldzaehler*9+5
+,dieselernkennung);PER ;kennung:=wert(fnrhjdklausurteiln);FOR feldzaehler
+FROM 1UPTO length(kennung)REP replace(kurse,feldzaehler*9,dieseklsrkennung);
+PER .diesekurskennung:subtext(kennung,feldzaehler*2+1,feldzaehler*2+2).
+diesefachkennung:subtext(kennung,feldzaehler*2+1,feldzaehler*2+2).
+dieselernkennung:subtext(kennung,feldzaehler*4+1,feldzaehler*4+4).
+dieseklsrkennung:kennungSUB feldzaehler.END PROC statdatenbasiszeile;TEXT 
+PROC vergleichbaresdatum(TEXT CONST dat):INT CONST datzahl:=datum(dat);IF 
+datzahl<0THEN "  0"+text(datzahl-minint,5)ELSE "  1"+text(datzahl,5)FI END 
+PROC vergleichbaresdatum;END PACKET merkmale;
+
diff --git a/app/schulis/2.2.1/src/5.statistik liste b/app/schulis/2.2.1/src/5.statistik liste
new file mode 100644
index 0000000..f7c00ca
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.statistik liste
@@ -0,0 +1,27 @@
+PACKET statistiklisteDEFINES statlistezeigen,statlistebearbeiten,
+statlisteeintrag:LET statistikserver="statistik server",niltext="",
+maxstatistiken=200,null="�",eins="�",maxi="�",mlistewirderstellt=7,
+mkeinedaten=68;THESAURUS VAR thesauswahl;TEXT VAR theseintrag;INT VAR 
+thesindex;BOOL VAR theszeigen;PROC statlistezeigen(INT CONST abnr):BOOL VAR 
+istleer;standardmeldung(mlistewirderstellt,niltext);
+thesauruszeigenvorbereiten(allestatistikensortiert(abnr),istleer);IF istleer
+THEN standardmeldung(mkeinedaten,niltext);leave(1);ELSE theszeigen:=TRUE ;
+thesauruszeigen;FI .END PROC statlistezeigen;PROC statlistebearbeiten(TEXT 
+CONST standardmaskenname):IF theszeigenTHEN theszeigen:=FALSE ;thesauswahl:=
+thesaurusauswahl;thesindex:=0;standardstartproc(standardmaskenname);FI ;get(
+thesauswahl,theseintrag,thesindex);IF thesindex=0THEN theseintrag:=niltext;
+ELSE theseintrag:=text(int(theseintrag));FI ;END PROC statlistebearbeiten;
+TEXT PROC statlisteeintrag:theseintragEND PROC statlisteeintrag;THESAURUS 
+PROC allestatistikensortiert(INT CONST abnr):THESAURUS VAR verzeichnis:=
+allestatistiken(task(statistikserver)),sortiert:=emptythesaurus;INT VAR index
+:=0;TEXT VAR eintrag,sorter:=maxstatistiken*null;get(verzeichnis,eintrag,
+index);WHILE index>0REP replace(sorter,int(eintrag),code(index));get(
+verzeichnis,eintrag,index);PER ;index:=pos(sorter,eins,maxi,max(1,abnr));
+WHILE index>0REP insert(sortiert,name(verzeichnis,code(sorterSUB index)));
+index:=pos(sorter,eins,maxi,index+1);PER ;sortiert.END PROC 
+allestatistikensortiert;LET statistikverzeichnis="statistik verzeichnis";
+DATASPACE VAR ds;THESAURUS PROC allestatistiken(TASK CONST statmanager):
+disablestop;forget(ds);fetch(ds,statistikverzeichnis,statmanager);BOUND 
+THESAURUS VAR res:=ds;THESAURUS VAR result:=CONCR (res);forget(ds);resultEND 
+PROC allestatistiken;END PACKET statistikliste;
+
diff --git a/app/schulis/2.2.1/src/5.thesaurus b/app/schulis/2.2.1/src/5.thesaurus
new file mode 100644
index 0000000..571edf9
--- /dev/null
+++ b/app/schulis/2.2.1/src/5.thesaurus
@@ -0,0 +1,38 @@
+PACKET thesauruszeigenDEFINES thesauruszeigenvorbereiten,thesauruszeigen,
+thesaurusblaettern,thesaurusauswahl:LET listenmaskenname="mu objektliste";
+LET niltext="",markoff=" ",markon="x";LET andenanfang=1,andasende=2,vorwaerts
+=3,rueckwaerts=4;LET zeileninliste=18,ausgabelaenge=71;THESAURUS VAR 
+dateiliste;TEXT VAR markmerker;INT VAR erstezeile,letztezeile;PROC 
+thesauruszeigenvorbereiten(THESAURUS CONST th,BOOL VAR istleer):dateiliste:=
+COMPR th;letztezeile:=highestentry(dateiliste);markmerker:=letztezeile*
+markoff;erstezeile:=1;istleer:=letztezeile=0;END PROC 
+thesauruszeigenvorbereiten;PROC thesauruszeigen:standardstartproc(
+listenmaskenname);eineseitezeigen;standardnproc;END PROC thesauruszeigen;
+PROC thesaurusblaettern(INT CONST wohin):INT VAR merkeerstezeile:=erstezeile;
+SELECT wohinOF CASE andenanfang:andendateianfangCASE andasende:andasdateiende
+CASE vorwaerts:vorwaertsblaetternindateiCASE rueckwaerts:
+rueckwaertsblaetternindateiEND SELECT ;IF merkeerstezeile<>erstezeileTHEN 
+speicheremarkierungen(merkeerstezeile);eineseitezeigen;ELSE standardmeldung(
+72,niltext);FI ;leave(1).andendateianfang:IF erstezeile<>1THEN erstezeile:=1;
+FI .andasdateiende:IF erstezeile<letztezeile-zeileninliste+1THEN erstezeile:=
+letztezeile-zeileninliste+1;FI .vorwaertsblaetternindatei:IF erstezeile<
+letztezeile-zeileninliste+1THEN erstezeileINCR zeileninliste;FI .
+rueckwaertsblaetternindatei:erstezeile:=max(1,erstezeile-zeileninliste).END 
+PROC thesaurusblaettern;THESAURUS PROC thesaurusauswahl:THESAURUS VAR auswahl
+:=emptythesaurus;INT VAR i;speicheremarkierungen(erstezeile);FOR iFROM 1UPTO 
+letztezeileREP IF (markmerkerSUB i)=markonTHEN insert(auswahl,name(dateiliste
+,i));FI ;PER ;auswahlEND PROC thesaurusauswahl;PROC speicheremarkierungen(
+INT CONST erstezeile):INT VAR i;FOR iFROM 1UPTO zeileninlisteREP IF 
+standardmaskenfeld(2*i)<>niltextTHEN replace(markmerker,erstezeile+i-1,markon
+);ELSE replace(markmerker,erstezeile+i-1,markoff);FI PER END PROC 
+speicheremarkierungen;PROC eineseitezeigen:INT VAR i;FOR iFROM 1UPTO 
+zeileninlisteREP IF aktzeile<=letztezeileTHEN standardmaskenfeld(eintrag,i*2+
+1);standardmaskenfeld(markiert,i*2);ELSE standardmaskenfeld(spaces,i*2+1);
+standardmaskenfeld(niltext,i*2);feldschutz(i*2);FI PER ;infeld(2).markiert:
+IF (markmerkerSUB (aktzeile))=markonTHEN markonELSE niltextFI .aktzeile:
+erstezeile+i-1.eintrag:text(name(dateiliste,aktzeile),ausgabelaenge).spaces:
+text(niltext,ausgabelaenge).END PROC eineseitezeigen;THESAURUS OP COMPR (
+THESAURUS CONST th):THESAURUS VAR res:=emptythesaurus;TEXT VAR eintrag;INT 
+VAR index:=0;get(th,eintrag,index);WHILE index>0REP insert(res,eintrag);get(
+th,eintrag,index);PER ;resEND OP COMPR ;END PACKET thesauruszeigen;
+
diff --git a/app/schulis/2.2.1/src/6.IDA.files b/app/schulis/2.2.1/src/6.IDA.files
new file mode 100644
index 0000000..b901335
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.IDA.files
@@ -0,0 +1,17 @@
+6.db ref.sc
+6.db sel.sc
+6.db q.sc
+6.db snd query.sc
+0.ida.data 
+6.ida.gen 
+6.ida.druck
+0.ida.form
+6.ida.def.druck
+6.ida.grund
+6.ida.check 
+6.ida.plausi 
+6.ida.definieren
+6.ida.auswahl
+6.ida.eingang
+
+
diff --git a/app/schulis/2.2.1/src/6.db q.sc b/app/schulis/2.2.1/src/6.db q.sc
new file mode 100644
index 0000000..4b3c2b2
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.db q.sc
@@ -0,0 +1,222 @@
+#$IF mitinternerqueryTHEN #PACKET queryparserDEFINES QUERY ,query,
+getscanbedingung,getdnr,getinr,getanzahlverbunde,getselpointer,
+getstopbedpointer,getquery,putquery,setzeschluessel,getanzahltupel,
+getswanzfld,getswnachfld,getswvonfld,getswallefelder,getswfwert,getsohnverb,
+getbruderverb,geterstestupel,puterstestupel,selektionerfuellt,initquery,:=,
+baumdurchlauf,listeschluessel,putletzterverbund,getletzterverbund,puttid,
+gettid,getbruder,putbruder,tidfeld,updatefnr,updateausdruck,queryart,
+anzupdatefelder:TYPE UPDSTACK =STRUCT (INT uuuuuv,TEXT uuuuuw);BOUND ROW 100
+UPDSTACK VAR uuuuux;TYPE VERBELEMENT =STRUCT (TEXT uuuuuy,uuuuuz,BOOL uuuuvu,
+INT uuuuvv,uuuuvw,uuuuvx,uuuuvy,uuuuvz,uuuuwu);TYPE VERBUND =ROW uuuuwv
+VERBELEMENT ;TYPE QUERY =STRUCT (INT uuuuww,uuuuwx,uuuuwy,TEXT uuuuwz,uuuuxu,
+SELEKTION uuuuxv,VERBUND uuuuxw,SCHLUESSEL uuuuxx);TYPE SWERT =STRUCT (INT 
+uuuuxy,uuuuxz,TEXT wert);TYPE SCHLUESSELWERTE =STRUCT (BOOL uuuuyu,INT uuuuyv
+,ROW uuuuywSWERT uuuuyx);TYPE SCHLUESSEL =ROW uuuuwvSCHLUESSELWERTE ;LET 
+uuuuyz=0,uuuuzu=1,uuuuzv=2,uuuuzw=3,uuuuzx=6,uuuuzy=5,uuuuzz=7,uuuvuu=7,
+uuuvuv=4,uuuvuw="BY",uuuvux="UPDATE",uuuvuy="DELETE",uuuvuz=".query",uuuvvu=
+";",uuuvvv="(",uuuvvw=")",#uuuvvx=",",uuuvvy="=",uuuvvz=">=",uuuvwu="<=",#
+uuuvwv="/",uuuvww="""",uuuvwx=".",uuuvwy=":",uuuvwz=" ",uuuvxu=":=",uuuvxv=
+"<",uuuuwv=10,uuuvxx=20,uuuuyw=10,uuuvxz=80,uuuvyu=1,uuuvyv=2,uuuvyw=3;INT 
+VAR uuuvyx:=-5,uuuvyy:=-33,uuuvyz;DATASPACE VAR uuuvzu:=nilspace;INT VAR 
+uuuvzv:=0;INT PROC tidfeld:uuuvyyENDPROC tidfeld;FILE VAR uuuvzz;TEXT VAR 
+uuuwuu:="",uuuwuv:="",uuuwuw:="",uuuwux:="";INT VAR uuuwuy,uuuwuz,uuuwvu;
+BOOL VAR uuuwvv,uuuwvw;INT VAR uuuwvx:=0,uuuwvy,uuuwvz;ROW uuuvxxTEXT VAR 
+uuuwwv;OP :=(QUERY VAR uuuwww,QUERY CONST uuuwwx):CONCR (uuuwww):=CONCR (
+uuuwwx)ENDOP :=;OP :=(VERBELEMENT VAR uuuwww,VERBELEMENT CONST uuuwwx):CONCR 
+(uuuwww):=CONCR (uuuwwx)ENDOP :=;OP :=(VERBUND VAR uuuwww,VERBUND CONST 
+uuuwwx):CONCR (uuuwww):=CONCR (uuuwwx)ENDOP :=;INT PROC updatefnr(INT CONST 
+uuuwyx):uuuuux[uuuwyx].uuuuuvENDPROC updatefnr;TEXT PROC updateausdruck(INT 
+CONST uuuwyx):uuuuux[uuuwyx].uuuuuwENDPROC updateausdruck;INT PROC queryart:
+uuuvzvENDPROC queryart;PROC queryart(INT CONST uuuxvu):uuuvzv:=uuuxvuENDPROC 
+queryart;INT PROC anzupdatefelder:uuuvyzENDPROC anzupdatefelder;PROC 
+initquery(QUERY VAR uuuxww):uuuxwx;uuuxww.uuuuww:=0;uuuxww.uuuuwx:=0;uuuxww.
+uuuuwz:="";uuuxww.uuuuxu:="";initselektionen(uuuxww.uuuuxv);uuuxyw(uuuxww.
+uuuuxw);uuuxyz(uuuxww.uuuuxx)ENDPROC initquery;PROC uuuxwx:forget(uuuvzu);
+uuuvzu:=nilspace;uuuuux:=uuuvzuENDPROC uuuxwx;initquery(uuuyuy);PROC uuuxyw(
+VERBUND VAR uuuyvu):FOR uuuwvyFROM 1UPTO uuuuwvREP uuuyvx(uuuyvu[uuuwvy])PER 
+ENDPROC uuuxyw;PROC uuuyvx(VERBELEMENT VAR uuuyww):uuuyww.uuuuuy:="";uuuyww.
+uuuuuz:=""ENDPROC uuuyvx;#BOUND QUERY VAR uuuyuy;#QUERY VAR uuuyuy;PROC 
+getquery(QUERY VAR uuuxww):CONCR (uuuxww):=CONCR (uuuyuy)ENDPROC getquery;
+PROC putquery(QUERY CONST uuuxww):CONCR (uuuyuy):=CONCR (uuuxww)ENDPROC 
+putquery;PROC query:query(lastparam)ENDPROC query;PROC uuuyzz(TEXT CONST 
+uuuzuu):TEXT VAR uuuzuv:="",uuuzuw:="",uuuzux:="",uuuwuv:="";INT VAR uuuzuz;
+uuuxwx;uuuzvv;nextsymbol;queryparser(uuuzvx);uuuzvy;uuuzvz;uuuzwu;uuuzwv;
+baumdurchlauf;.uuuzvy:nextsymbol;WHILE uuuwuy<>uuuuzzREP uuuzxu;nextsymbol
+PER .uuuzxu:uuuzuw:="";IF uuuwuy<>uuuuzuTHEN uuuzxz(
+"Refinementname erwartet: "+uuuwuu)ELSE uuuzuv:=uuuwuu;nextsymbol;IF uuuwuu<>
+uuuvwyTHEN uuuzxz(uuuvww+uuuvwy+uuuvww+" erwartet: "+uuuwuu)ELSE uuuzzy;
+putref(uuuzuv,uuuzuw)FI FI .uuuzzy:nextsymbol;WHILE uuuwuy<>uuuuzzCAND uuuwuu
+<>uuuvwxREP uuuzuw:=uuuzuw+uuvuvw;nextsymbolPER ;IF uuuwuy=uuuuzzTHEN uuuzxz(
+"Refinement nicht mit ""."" abgeschlossen")FI .uuuzvv:enablestop;uuuvzz:=
+sequentialfile(input,uuuzuu);IF exists(uuuzuu+uuuvuz)THEN forget(uuuzuu+
+uuuvuz,quiet)FI ;#uuuyuy:=new(uuuzuu+uuuvuz);#lastparam(uuuzuu);uuvuxz(0);
+uuuwvx:=0;clearrefs;scan(uuuvzz);.uuuzwu:FOR uuuzuzFROM 1UPTO uuuwvxREP 
+uuuzux:="";uuuwuv:=uuvuzv(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,uuuwuy);
+WHILE uuuwuy<>uuuuzzREP IF uuuwuy=uuuuzuTHEN uuuzux:=uuuzux+getreftext(uuuwuu
+)ELSE uuuzux:=uuuzux+uuvuvwFI ;nextsymbol(uuuwuu,uuuwuy)PER ;uuvvwu(uuuzux,
+uuuzuz)PER .uuuzwv:INT VAR uuvvwy;initsel(uuuyuy.uuuuxv);FOR uuuzuzFROM 1
+UPTO getanzahlverbundeREP uuvvxx;uuvvxyPER .uuvvxx:uuvvwy:=getstopbedpointer(
+uuuzuz);IF uuvvwy>uuuuyzTHEN uuuwuv:=uuvuzv(uuvvwy);uuvvzw(baueselektionauf(
+uuuyuy.uuuuxv,uuuwuv),uuuzuz)FI .uuvvxy:uuvvwy:=getselpointer(uuuzuz);IF 
+uuvvwy>uuuuyzTHEN uuuwuv:=uuvuzv(uuvvwy);uuvwvy(baueselektionauf(uuuyuy.
+uuuuxv,uuuwuv),uuuzuz)FI .ENDPROC uuuyzz;PROC uuuzvz:INT VAR uuuzuz:=1;BOOL 
+VAR uuvwxu:=FALSE ;TEXT VAR uuuzux:="";WHILE uuuzuz<=getanzahlverbundeREP 
+uuuzux:="";uuuwuv:=getscanbedingung(uuuzuz);scan(uuuwuv);nextsymbol(uuuwuu,
+uuuwuy);WHILE uuuwuy<>uuuuzzREP IF uuuwuy=uuuuzuTHEN uuuzux:=uuuzux+
+getreftext(uuuwuu)ELSE uuuzux:=uuuzux+uuvuvwFI ;nextsymbol(uuuwuu,uuuwuy)PER 
+;IF getdnr(uuuzuz)=uuuvyxTHEN queryparser(uuuzux,uuuzuz);uuvwxu:=TRUE ELSE 
+uuvxwu(uuuzux,uuuzuz)FI ;uuuzuzINCR 1PER ;IF uuvwxuTHEN uuuzvzFI ENDPROC 
+uuuzvz;PROC queryparser(TEXT CONST uuuwuv,INT CONST uuvxxx):INT VAR uuvxxy;
+scan(uuuwuv);nextsymbol;uuvxyu;queryparser(uuvxxx);uuvxyx.uuvxyu:uuvxxy:=
+getbruderverb(uuvxxx);.uuvxyx:uuvxzx(uuvxxy,uuvxxx).ENDPROC queryparser;PROC 
+queryparser(INT CONST uuvxxx):TEXT VAR uuvyux:="";BOOL VAR uuvyuy:=FALSE ;
+uuuvzv:=0;REP uuvyvu;UNTIL uuvyuyPER ;uuvyvw;uuvyvx;uuvyvy;uuvyvz;SELECT 
+uuuvzvOF CASE uuuvyv,uuuvyu:uuvywx;IF uuvxxx=1THEN uuvywzFI CASE uuuvyw:
+uuvyxvENDSELECT .uuvyvu:IF uuuwuy=uuuvuvTHEN uuvyxz(dateinr(uuuwuu),uuvxxx);
+IF uuuvzv<1THEN uuuvzv:=uuuvyuFI ;uuvyuy:=TRUE ELSE IF uuuwuy=uuuuzvTHEN IF 
+uuuwuu=uuuvuxTHEN nextsymbol;uuuvzv:=uuuvywELIF uuuwuu=uuuvuyTHEN nextsymbol;
+uuuvzv:=uuuvyvELSE uuuzxz("Dateiname nicht gefunden: "+uuuwuu)FI FI FI .
+uuvyvw:nextsymbol;IF uuuwuy=uuuuzvCAND uuuwuu=uuuvuwTHEN uuvzvz;uuvzwuELSE 
+IF uuuwuy=uuuuzxCAND uuuwuu=uuuvvvTHEN uuvzwz(#getdnr(uuvxxx)#0,uuvxxx)ELSE 
+uuuzxz("Indexname bzw. ""("" fehlt")FI FI .uuvzvz:nextsymbol;IF uuuwuy=uuuvuv
+THEN uuvzwz(indexnr(uuuwuu),uuvxxx)ELSE uuuzxz("Indexname nicht gefunden: "+
+uuuwuu)FI .uuvzwu:nextsymbol;IF NOT (uuuwuy=uuuuzxCAND uuuwuu=uuuvvv)THEN 
+uuuzxz(uuuvww+uuuvvv+uuuvww+" erwartet")FI .uuvyvx:uuwuuy(uuuwuv);uuvxwu(
+uuuwuv,uuvxxx);.uuvyvy:BOOL VAR stop:=TRUE ;uuwuvy.uuvyvz:stop:=FALSE ;uuwuvy
+.uuwuvy:INT VAR uuvvwy;uuuwuw:="";IF NOT uuuwvvTHEN uuwuuy(uuuwuw);IF uuuwuw=
+""THEN IF stopTHEN uuvvzw(uuuuyz,uuvxxx)ELSE uuvwvy(uuuuyz,uuvxxx)FI ELSE 
+uuvvwy:=uuwuyx;IF stopTHEN uuvvzw(uuvvwy,uuvxxx)ELSE uuvwvy(uuvvwy,uuvxxx)FI 
+;uuvvwu(uuuwuw,uuvvwy)FI ELSE uuvwvy(uuuuyz,uuvxxx)FI .uuvywx:INT VAR uuwvuz;
+IF NOT uuuwvvTHEN uuwvvv(uuvxxx,uuwvuz);uuwvvy(uuwvuz,uuvxxx);uuvxzx(uuuuyz,
+uuvxxx)FI .uuvywz:nextsymbol;IF uuuwuy=uuuuzxOR uuuwuy=uuuuzzOR uuuwuy=uuuuzy
+THEN IF uuuwuu<>uuuvwvTHEN uuwvyvFI ;uuuuwx;uuwvyxELSE uuuzxz(uuuvww+uuuvwv+
+uuuvww+" bzw. "+uuuvww+uuuvvu+uuuvww+uuuvwv+uuuvww+uuuvwx+uuuvww+" erwartet")
+FI .uuwvyv:IF uuuwuu=uuuvvuOR uuuwuu=uuuvwxOR uuuwuy=uuuuzzTHEN uuwwvy(0);
+LEAVE uuvywzELSE uuuzxz("Falscher Tupelzahl-Operator: "+uuuwuu)FI .uuuuwx:
+nextsymbol;IF uuuwuy=uuuuzwTHEN uuwwvy(int(uuuwuu));ELSE uuuzxz(
+"Keine Zahlenangabe: "+uuuwuu)FI .uuwvyx:nextsymbol;IF uuuwuy<>uuuuzzCAND (
+NOT (uuuwuu=uuuvvuCOR uuuwuu=uuuvwx))THEN uuuzxz("""."" oder "";"" erwartet")
+FI .uuvyxv:uuuvyz:=0;nextsymbol;WHILE NOT uuuwvvREP uuuvyzINCR 1;uuwwzx;
+uuwwzy;uuwwzz;PER .uuwwzx:IF uuuwuy=uuuuzuTHEN uuwxuxELSE uuwxuyFI .uuwxux:
+uuuzxz("Zur Zeit keine Refinements in Update-Liste erlaubt!").uuwxuy:uuuuux[
+uuuvyz].uuuuuv:=feldnr(uuuwuu);IF uuuuux[uuuvyz].uuuuuv<3THEN uuuzxz(
+"Falscher Feldname: "+uuuwuu)FI ;nextsymbol.uuwwzy:IF NOT (uuuwuy=uuuuzyCAND 
+uuuwuu=uuuvxu)THEN uuuzxz("Keine Zuweisung: "+uuuwuu)FI .uuwwzz:uuwxyv(uuvyux
+);uuuuux[uuuvyz].uuuuuw:=uuvyux;nextsymbol.ENDPROC queryparser;PROC uuwxyv(
+TEXT VAR uuwxzx):INT VAR uuwxzy:=0,uuwxzz:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0;
+REP uuwxzx:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbolUNTIL uuwyvwPER .uuwyvw:
+IF (uuuwuy=uuuuzxCAND (uuuwuu=uuuvvuCOR (uuuwuu=uuuvvwCAND uuwxzz=0)))THEN 
+uuuwvv:=uuuwuu=uuuvvw;TRUE ELSE IF uuuwuy=uuuuzzTHEN uuuzxz(
+"Vorzeitiges END OF FILE!");FALSE ELSE IF uuuwuy=uuuuzxTHEN IF uuuwuu=uuuvvv
+THEN uuwxzzINCR 1FI ;IF uuuwuu=uuuvvwTHEN uuwxzzDECR 1FI ;FI ;FALSE FI FI .
+ENDPROC uuwxyv;PROC uuwvvv(INT CONST uuvxxx,INT VAR uuwvuz):INT VAR uuwyzz:=
+uuuuyz;uuwvuz:=uuuuyz;nextsymbol;IF uuuwuy=uuuuzxCAND uuuwuu=uuuvvwTHEN 
+uuuwvv:=TRUE ;LEAVE uuwvvvELIF uuuwuy=uuuuzuTHEN uuwvuz:=uuuzvx;uuvxwu(uuuwuu
+,uuwvuz);uuvwvy(uuuuyz,uuwvuz);uuvyxz(uuuvyx,uuwvuz);uuwvvv(uuwvuz,uuwyzz);
+uuvxzx(uuwyzz,uuwvuz)ELIF uuuwuy=uuuvuvTHEN uuwvuz:=uuuzvx;queryparser(uuwvuz
+);uuuwvv:=FALSE ;uuwvvv(uuwvuz,uuwyzz);uuvxzx(uuwyzz,uuwvuz)ELIF (uuuwuy=
+uuuuzxCAND uuuwuu=uuuvvu)THEN uuwvvv(uuvxxx,uuwvuz)ELSE uuuzxz(
+"Verbund-Fehler bei : "+uuuwuu)FI ENDPROC uuwvvv;PROC uuwuuy(TEXT VAR uuwxzx)
+:INT VAR uuwxzy:=0;uuwxzx:="";uuuwuu:="";uuuwuy:=0;uuuwvv:=FALSE ;REP uuwxzx
+:=uuwxzx+uuvuvw;uuwxzy:=uuuwuy;nextsymbolUNTIL uuxuyxPER .uuxuyx:IF (uuuwuy=
+uuuuzyCAND uuuwuu=uuuvwv)THEN TRUE ELSE IF uuuwuy=uuuuzzTHEN uuuzxz(uuuvww+
+uuuvwv+uuuvww+" fehlt");FALSE ELSE FALSE FI FI .ENDPROC uuwuuy;TEXT PROC 
+uuvuvw:IF uuuwuy=uuuvuvTHEN uuuvww+uuuwuu+uuuvwwELIF uuuwuy=uuuuzvTHEN uuuvwz
++uuuwuu+uuuvwzELSE uuuwuuFI ENDPROC uuvuvw;PROC nextsymbol:nextsymbol(uuuvzz,
+uuuwuu,uuuwuy);ENDPROC nextsymbol;PROC uuuzxz(TEXT CONST uuxvxx):errorstop(
+"Zeile "+text(lineno(uuuvzz))+" : "+uuxvxx)ENDPROC uuuzxz;PROC puterstestupel
+(TEXT CONST uuxvyw):uuuyuy.uuuuwz:=uuxvywENDPROC puterstestupel;TEXT PROC 
+geterstestupel:uuuyuy.uuuuwzENDPROC geterstestupel;PROC uuxvzz(TEXT CONST 
+uuxvyw):uuuyuy.uuuuxu:=uuxvywENDPROC uuxvzz;TEXT PROC uuxwuz:uuuyuy.uuuuxu
+ENDPROC uuxwuz;PROC uuwwvy(INT CONST uuxwvy):uuuyuy.uuuuwx:=uuxwvyENDPROC 
+uuwwvy;INT PROC getanzahltupel:uuuyuy.uuuuwxENDPROC getanzahltupel;PROC 
+putletzterverbund(INT CONST uuxwxw):uuuyuy.uuuuwy:=uuxwxwENDPROC 
+putletzterverbund;INT PROC getletzterverbund:uuuyuy.uuuuwyENDPROC 
+getletzterverbund;PROC puttid(INT CONST uuxwzu,TEXT CONST uuxwzv):uuuyuy.
+uuuuxw[uuxwzu].uuuuuz:=uuxwzvENDPROC puttid;TEXT PROC gettid(INT CONST uuxwzu
+):uuuyuy.uuuuxw[uuxwzu].uuuuuzENDPROC gettid;PROC putbruder(INT CONST uuxwzu,
+BOOL CONST uuxxvz):uuuyuy.uuuuxw[uuxwzu].uuuuvu:=uuxxvzENDPROC putbruder;
+BOOL PROC getbruder(INT CONST uuxwzu):uuuyuy.uuuuxw[uuxwzu].uuuuvuENDPROC 
+getbruder;PROC uuvxwu(TEXT CONST uuxxyw,INT CONST uuuzuz):uuuyuy.uuuuxw[
+uuuzuz].uuuuuy:=uuxxywENDPROC uuvxwu;TEXT PROC getscanbedingung(INT CONST 
+uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuuyENDPROC getscanbedingung;PROC uuvyxz(INT 
+CONST uuxyvu,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvv:=uuxyvuENDPROC uuvyxz;PROC 
+uuvzwz(INT CONST uuxywx,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvw:=uuxywxENDPROC 
+uuvzwz;INT PROC getdnr(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvvENDPROC 
+getdnr;INT PROC getinr(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvwENDPROC 
+getinr;PROC uuvwvy(INT CONST uuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvx:=
+uuxzuwENDPROC uuvwvy;INT PROC getselpointer(INT CONST uuuzuz):uuuyuy.uuuuxw[
+uuuzuz].uuuuvxENDPROC getselpointer;PROC uuvvzw(INT CONST uuxzuw,uuuzuz):
+uuuyuy.uuuuxw[uuuzuz].uuuuvy:=uuxzuwENDPROC uuvvzw;INT PROC getstopbedpointer
+(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvyENDPROC getstopbedpointer;
+PROC uuvxzx(INT CONST uuxzuw,uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuvz:=uuxzuw
+ENDPROC uuvxzx;INT PROC getbruderverb(INT CONST uuuzuz):uuuyuy.uuuuxw[uuuzuz]
+.uuuuvzENDPROC getbruderverb;PROC uuwvvy(INT CONST uuxzuw,uuuzuz):uuuyuy.
+uuuuxw[uuuzuz].uuuuwu:=uuxzuwENDPROC uuwvvy;INT PROC getsohnverb(INT CONST 
+uuuzuz):uuuyuy.uuuuxw[uuuzuz].uuuuwuENDPROC getsohnverb;PROC uuvuxz(INT 
+CONST uuyuzu):uuuyuy.uuuuww:=uuyuzuENDPROC uuvuxz;INT PROC getanzahlverbunde:
+uuuyuy.uuuuwwENDPROC getanzahlverbunde;INT PROC uuuzvx:INT VAR uuyuzu:=
+getanzahlverbunde+1;uuvuxz(uuyuzu);uuvxzx(uuuuyz,uuyuzu);uuwvvy(uuuuyz,uuyuzu
+);uuvxwu("",uuyuzu);uuyuzuENDPROC uuuzvx;INT PROC uuwuyx:uuuwvxINCR 1;uuuwvx
+ENDPROC uuwuyx;PROC uuvvwu(TEXT CONST uuuwuw,INT CONST uuvvwy):uuuwwv[uuvvwy]
+:=uuuwuwENDPROC uuvvwu;TEXT PROC uuvuzv(INT CONST uuvvwy):uuuwwv[uuvvwy]
+ENDPROC uuvuzv;PROC baumdurchlauf:IF mittestausgabenTHEN uuyvzzFI .uuyvzz:
+INT VAR uuywuv;FOR uuywuvFROM 1UPTO getanzahlverbundeREP note("Verbund  : "+
+text(uuywuv));noteline;note("   Datei : "+text(getdnr(uuywuv)));noteline;note
+("   Index : "+text(getinr(uuywuv)));noteline;note("   Scan  : "+
+getscanbedingung(uuywuv));noteline;note("   Bruder: "+text(getbruderverb(
+uuywuv)));noteline;note("   Sohn  : "+text(getsohnverb(uuywuv)));noteline;
+note("   SelPoi: "+text(getselpointer(uuywuv)));noteline;noteline;PER ;
+checkselektion(uuuyuy.uuuuxv).ENDPROC baumdurchlauf;PROC setzeschluessel(INT 
+CONST uuxwzu):TEXT VAR uuywxy:=getscanbedingung(uuxwzu);scan(uuywxy);
+nextsymbol;uuywyw;uuywyx;uuywyy;uuywyz;WHILE uuuwuy<>uuuvuuREP IF uuuwuu=
+uuuvxvTHEN nextsymbol;uuywzy(uuxwzu,uuyxuu,uuuwuu);uuyxuw(uuxwzu,uuyxuu,
+uuyxuz);uuyxvu(uuxwzu,uuyxuu,0);ELIF uuuwuy=uuuvuvTHEN uuywzy(uuxwzu,uuyxuu,
+"");uuyxuw(uuxwzu,uuyxuu,uuyxuz);uuyxvu(uuxwzu,uuyxuu,feldnr(uuuwuu));ELIF 
+uuuwuu=uuuvvuTHEN uuyxyuFI ;nextsymbolPER ;uuyxyv.uuywyx:IF uuuwuy=uuuvuv
+CAND feldtyp(feldnr(uuuwuu))=uuuvxzTHEN uuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1,
+tidfeld);uuyxvu(uuxwzu,1,feldnr(uuuwuu));uuyyux(uuxwzu,TRUE );uuyyuz(uuxwzu,1
+);LEAVE setzeschluesselFI ;.uuywyz:uuywzy(uuxwzu,1,"");uuyxuw(uuxwzu,1,0);
+uuyxvu(uuxwzu,1,0).uuyxyu:IF uuuwvwTHEN uuyxuzINCR 1ELSE uuuwuz:=uuuwvu+1;
+uuuwvu:=pos(uuuwux,uuuvvu,uuuwuz);uuyxuz:=uuxyvu+int(subtext(uuuwux,uuuwuz,
+uuuwvu-1))FI ;uuyxuuINCR 1.uuywyw:INT VAR uuyyzv:=getinr(uuxwzu),uuxyvu:=
+getdnr(uuxwzu),uuyxuz;IF uuyyzv=0THEN uuuwvw:=TRUE ;uuyxuz:=uuxyvu+1ELSE 
+uuuwux:=zugriff(uuyyzv);uuuwvu:=pos(uuuwux,uuuvvu);uuyxuz:=int(subtext(uuuwux
+,1,uuuwvu-1))+uuxyvu;uuuwvw:=FALSE FI .uuyzwy:IF uuuwvwTHEN (uuyxuz-uuxyvu)=
+anzkey(uuxyvu)ELSE uuuwvu=length(uuuwux)FI .uuywyy:INT VAR uuyxuu:=1;IF 
+uuuwuy=uuuvuuTHEN uuyxuu:=0FI .uuyxyv:uuyyux(uuxwzu,uuyzwyCAND (uuyxuu>0));
+uuyyuz(uuxwzu,uuyxuu).ENDPROC setzeschluessel;PROC uuyxvu(INT CONST uuxwzu,
+uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxy:=uuyxuzENDPROC 
+uuyxvu;PROC uuyxuw(INT CONST uuxwzu,uuzuux,uuyxuz):uuuyuy.uuuuxx[uuxwzu].
+uuuuyx[uuzuux].uuuuxz:=uuyxuzENDPROC uuyxuw;INT PROC getswvonfld(INT CONST 
+uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].uuuuxyENDPROC getswvonfld
+;INT PROC getswnachfld(INT CONST uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[
+uuzuux].uuuuxzENDPROC getswnachfld;PROC uuywzy(INT CONST uuxwzu,uuzuux,TEXT 
+CONST uuzvwu):uuuyuy.uuuuxx[uuxwzu].uuuuyx[uuzuux].wert:=uuzvwuENDPROC uuywzy
+;TEXT PROC getswfwert(INT CONST uuxwzu,uuzuux):uuuyuy.uuuuxx[uuxwzu].uuuuyx[
+uuzuux].wertENDPROC getswfwert;PROC uuyyux(INT CONST uuxwzu,BOOL CONST uuzvzv
+):uuuyuy.uuuuxx[uuxwzu].uuuuyu:=uuzvzvENDPROC uuyyux;BOOL PROC 
+getswallefelder(INT CONST uuxwzu):uuuyuy.uuuuxx[uuxwzu].uuuuyuENDPROC 
+getswallefelder;PROC uuyyuz(INT CONST uuxwzu,uuzwvz):uuuyuy.uuuuxx[uuxwzu].
+uuuuyv:=uuzwvzENDPROC uuyyuz;INT PROC getswanzfld(INT CONST uuxwzu):uuuyuy.
+uuuuxx[uuxwzu].uuuuyvENDPROC getswanzfld;PROC query(TEXT CONST uuzwyw):INT 
+VAR uuuzuz;uuuyzz(uuzwyw);FOR uuuzuzFROM 1UPTO getanzahlverbundeREP 
+setzeschluessel(uuuzuz)PER ;listeschluesselENDPROC query;OP :=(
+SCHLUESSELWERTE VAR uuuwww,SCHLUESSELWERTE CONST uuuwwx):CONCR (uuuwww):=
+CONCR (uuuwwx)ENDOP :=;OP :=(SWERT VAR uuuwww,SWERT CONST uuuwwx):CONCR (
+uuuwww):=CONCR (uuuwwx)ENDOP :=;OP :=(SCHLUESSEL VAR uuuwww,SCHLUESSEL CONST 
+uuuwwx):CONCR (uuuwww):=CONCR (uuuwwx)ENDOP :=;PROC listeschluessel:IF NOT 
+mittestausgabenTHEN LEAVE listeschluesselFI ;INT VAR uuuzuz,uuywuv;FOR uuuzuz
+FROM 1UPTO getanzahlverbundeREP noteline;note("Verbund : "+text(uuuzuz));
+noteline;note("=============");noteline;noteline;note("ANZAHL FLD: "+text(
+getswanzfld(uuuzuz)));noteline;note("ALLE      : "+uuzxxx);noteline;noteline;
+FOR uuywuvFROM 1UPTO getswanzfld(uuuzuz)REP note("   VON : "+text(getswvonfld
+(uuuzuz,uuywuv)));noteline;note("   NACH: "+text(getswnachfld(uuuzuz,uuywuv))
+);noteline;note("   WERT: "+getswfwert(uuuzuz,uuywuv));noteline;PER PER .
+uuzxxx:IF getswallefelder(uuuzuz)THEN "vollständiger Schlüssel"ELSE 
+"unvollständiger Schlüssel"FI .ENDPROC listeschluessel;BOOL PROC 
+selektionerfuellt(INT CONST uuzyux):werteselektionaus(uuuyuy.uuuuxv,uuzyux)
+ENDPROC selektionerfuellt;PROC uuuxyz(SCHLUESSEL VAR uuzyvx):FOR uuuwvyFROM 1
+UPTO uuuuwvREP FOR uuuwvzFROM 1UPTO uuuuywREP uuzyvx[uuuwvy].uuuuyx[uuuwvz].
+wert:=""PER PER ENDPROC uuuxyz;ENDPACKET queryparser;#$FI #
+
diff --git a/app/schulis/2.2.1/src/6.db ref.sc b/app/schulis/2.2.1/src/6.db ref.sc
new file mode 100644
index 0000000..58b059b
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.db ref.sc
@@ -0,0 +1,20 @@
+#$IF mitinternerqueryTHEN #PACKET queryrefDEFINES putref,getreftext,
+anzahlrefs,listerefs,clearrefs:LET uuuuuv=50,uuuuuw=1,uuuuux=2;LET 
+REFELEMENT =ROW 2TEXT ;TYPE REFINEMENT =STRUCT (INT uuuuuy,ROW uuuuuv
+REFELEMENT uuuuvu);REFINEMENT VAR uuuuvv;PROC putref(TEXT CONST uuuuvw,uuuuvx
+):INT VAR uuuuvy;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP IF uuuuvv.uuuuvu[
+uuuuvy][uuuuuw]=uuuuvwTHEN uuuuvv.uuuuvu[uuuuvy][uuuuuw]:=uuuuvx;LEAVE putref
+FI PER ;IF uuuuvv.uuuuuy=uuuuuvTHEN errorstop("Zuviele Refinements!")FI ;
+uuuuvv.uuuuuyINCR 1;uuuuvv.uuuuvu[uuuuvv.uuuuuy][uuuuuw]:=uuuuvw;uuuuvv.
+uuuuvu[uuuuvv.uuuuuy][uuuuux]:=uuuuvxENDPROC putref;TEXT PROC getreftext(
+TEXT CONST uuuuvw):INT VAR uuuuvy;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP IF 
+uuuuvv.uuuuvu[uuuuvy][uuuuuw]=uuuuvwTHEN LEAVE getreftextWITH uuuuvv.uuuuvu[
+uuuuvy][uuuuux]FI PER ;uuuuvwENDPROC getreftext;PROC clearrefs:INT VAR uuuuvy
+;FOR uuuuvyFROM 1UPTO uuuuvv.uuuuuyREP uuuuvv.uuuuvu[uuuuvy][uuuuuw]:="";
+uuuuvv.uuuuvu[uuuuvy][uuuuux]:=""PER ;uuuuvv.uuuuuy:=0ENDPROC clearrefs;INT 
+PROC anzahlrefs:uuuuvv.uuuuuyENDPROC anzahlrefs;PROC listerefs:INT VAR uuuwuu
+;note("Liste der Refinements :");noteline;note("=======================");
+noteline;noteline;FOR uuuwuuFROM 1UPTO anzahlrefsREP note(text(uuuuvv.uuuuvu[
+uuuwuu][uuuuuw],30)+":"+uuuuvv.uuuuvu[uuuwuu][uuuuux]);notelinePER ENDPROC 
+listerefs;ENDPACKET queryref;#$FI #
+
diff --git a/app/schulis/2.2.1/src/6.db sel.sc b/app/schulis/2.2.1/src/6.db sel.sc
new file mode 100644
index 0000000..4577620
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.db sel.sc
@@ -0,0 +1,127 @@
+PACKET queryselektionDEFINES SELEKTION ,#putoptyp,putrechts,putlinks,
+putselwert,#optyp,rechts,links,selwert,fnrlinks,fnrrechts,#allocselelement,#
+:=,checkselektion,baueselektionauf,werteselektionaus,mittestausgaben,
+initselektionen,initsel,initialisiereselektion,lex,lexon,lexoff:LET uuuuuv=0,
+uuuuuw=1,uuuuux=2,uuuuuy=6,uuuuuz=7,uuuuvu=8,uuuuvv=9,#uuuuvw=1,uuuuvx=3,#
+uuuuvy=2,uuuuvz=4,uuuuwu=5,uuuuwv=10,uuuuww=11,uuuuwx=12,uuuuwy=13,uuuuwz=14,
+uuuuxu=15,uuuuxv=16,uuuuxw=17,uuuuxx=18,uuuuxy=19,uuuuxz=20,uuuuyu=30,uuuuyv=
+73,uuuuyw=82,uuuuyx=68,uuuuyy=84;TYPE NODE =STRUCT (INT uuuuyz,uuuuzu,uuuuzv,
+TEXT selwert);TYPE SELEKTION =STRUCT (INT uuuuzx,ROW uuuuyuNODE exp);INT VAR 
+uuuuzz,uuuvuu,uuuvuv;REAL VAR uuuvuw,uuuvux;TEXT VAR uuuvuy,uuuvuz;INT VAR 
+uuuvvu;TEXT VAR uuuvvv:="";BOOL VAR uuuvvw:=FALSE ,lexsort:=FALSE ;BOOL PROC 
+lex:lexsortENDPROC lex;PROC lexon:lexsort:=TRUE ENDPROC lexon;PROC lexoff:
+lexsort:=FALSE ENDPROC lexoff;PROC mittestausgaben(BOOL CONST uuuvwy):uuuvvw
+:=uuuvwyENDPROC mittestausgaben;BOOL PROC mittestausgaben:uuuvvwENDPROC 
+mittestausgaben;OP :=(NODE VAR uuuvxz,NODE CONST uuuvyu):CONCR (uuuvxz):=
+CONCR (uuuvyu)ENDOP :=;OP :=(SELEKTION VAR uuuvxz,SELEKTION CONST uuuvyu):
+CONCR (uuuvxz):=CONCR (uuuvyu)ENDOP :=;PROC initsel(SELEKTION VAR uuuvzw):
+uuuvzw.uuuuzx:=0ENDPROC initsel;PROC initselektionen(SELEKTION VAR uuuwuv):
+INT VAR uuuwuw;FOR uuuwuwFROM 1UPTO uuuuyuREP uuuwuv.exp[uuuwuw].selwert:=""
+PER ENDPROC initselektionen;PROC initialisiereselektion(SELEKTION VAR uuuvzw)
+:initsel(uuuvzw);initselektionen(uuuvzw)ENDPROC initialisiereselektion;PROC 
+uuuwwy(SELEKTION VAR uuuvzw,INT CONST uuuwxu):uuuvzw.exp[uuuwxu].uuuuyz:=
+uuuuxy;uuuvzw.exp[uuuwxu].uuuuzv:=0;uuuvzw.exp[uuuwxu].uuuuzu:=0;uuuvzw.exp[
+uuuwxu].selwert:=""ENDPROC uuuwwy;INT PROC allocselelement(SELEKTION VAR 
+uuuvzw):uuuvzw.uuuuzxINCR 1;uuuwwy(uuuvzw,uuuvzw.uuuuzx);uuuvzw.uuuuzx
+ENDPROC allocselelement;PROC putoptyp(SELEKTION VAR uuuvzw,INT CONST uuuxvy,
+optyp):uuuvzw.exp[uuuxvy].uuuuyz:=optypENDPROC putoptyp;PROC uuuxwz(
+SELEKTION VAR uuuvzw,INT CONST uuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzv:=
+uuuxxwENDPROC uuuxwz;PROC putrechts(SELEKTION VAR uuuvzw,INT CONST uuuxvy,
+uuuxyz):uuuvzw.exp[uuuxvy].uuuuzv:=uuuxyzENDPROC putrechts;PROC uuuxzz(
+SELEKTION VAR uuuvzw,INT CONST uuuxvy,uuuxxw):uuuvzw.exp[uuuxvy].uuuuzu:=
+uuuxxwENDPROC uuuxzz;PROC putlinks(SELEKTION VAR uuuvzw,INT CONST uuuxvy,
+uuuwuw):uuuvzw.exp[uuuxvy].uuuuzu:=uuuwuwENDPROC putlinks;PROC putselwert(
+SELEKTION VAR uuuvzw,INT CONST uuuxvy,TEXT CONST uuuyxw):uuuvzw.exp[uuuxvy].
+selwert:=uuuyxwENDPROC putselwert;INT PROC optyp(SELEKTION VAR uuuvzw,INT 
+CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuyzENDPROC optyp;INT PROC fnrrechts(
+SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzvENDPROC 
+fnrrechts;INT PROC fnrlinks(SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp
+[uuuxvy].uuuuzuENDPROC fnrlinks;INT PROC rechts(SELEKTION CONST uuuvzw,INT 
+CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzvENDPROC rechts;INT PROC links(
+SELEKTION CONST uuuvzw,INT CONST uuuxvy):uuuvzw.exp[uuuxvy].uuuuzuENDPROC 
+links;TEXT PROC selwert(SELEKTION VAR uuuvzw,INT CONST uuuxvy):uuuvzw.exp[
+uuuxvy].selwertENDPROC selwert;INT PROC baueselektionauf(SELEKTION VAR uuuzzx
+,TEXT CONST uuuzzy):IF compress(uuuzzy)<>""THEN scan(uuuzzy);uuvuuv(uuuzzx)
+ELSE 0FI ENDPROC baueselektionauf;INT PROC uuvuuv(SELEKTION VAR uuuzzx):INT 
+VAR uuuwuw,uuvuvv;uuuwuw:=uuvuvx(uuuzzx);nextsymbol;IF uuvuvz=uuuuxxOR uuvuvz
+=uuuuxvTHEN uuvuvv:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvuvv,uuvuvz);
+putlinks(uuuzzx,uuvuvv,uuuwuw);putrechts(uuuzzx,uuvuvv,uuvuuv(uuuzzx));uuvuvv
+ELSE uuuwuwFI ENDPROC uuvuuv;INT PROC uuvuvx(SELEKTION VAR uuuzzx):INT VAR 
+uuvvuu;nextsymbol;SELECT uuvuvzOF CASE uuuuuw:uuvvuu:=uuvuuv(uuuzzx);#
+nextsymbol;#IF uuvuvz<>uuuuuxTHEN errorstop("Klammer zu fehlt! Gefunden: "+
+uuuvvv)FI ;CASE uuuuxw:uuvvuu:=allocselelement(uuuzzx);putoptyp(uuuzzx,uuvvuu
+,uuvuvz);putlinks(uuuzzx,uuvvuu,uuvuvx(uuuzzx));CASE uuuuuy:CASE uuuuvu:
+uuvvuu:=allocselelement(uuuzzx);uuvvyx;uuvvyy;nextsymbol;uuvvyzCASE uuuuvv:
+uuvvuu:=allocselelement(uuuzzx);uuvvzy;uuvvzz;uuvwuuCASE uuuuuz:OTHERWISE :
+errorstop("Falsches Symbol: "+uuuvvv+text(uuuvvu))ENDSELECT ;uuvvuu.uuvvyx:
+nextsymbol;IF uuuvvu<>uuuuvzTHEN uuvwvw("Falsche Wertangabe")ELSE putselwert(
+uuuzzx,uuvvuu,uuuvvv);nextsymbol;IF uuuvvu<>uuuuwuCAND uuuvvv<>">"THEN uuvwvw
+(""">"" bei Wertangabe fehlt!")FI FI .uuvvzz:nextsymbol;IF uuuvvu<>uuuuwu
+THEN uuvwvw("Falscher Operator: "+uuuvvv)FI ;putoptyp(uuuzzx,uuvvuu,uuvwyv).
+uuvvyy:nextsymbol;IF (uuuvvu=uuuuwu)COR (uuuvvu=uuuuvyCAND uuuvvv="IN")THEN 
+putoptyp(uuuzzx,uuvvuu,uuvwyv)ELSE uuvwvw("Falscher Operator: "+uuuvvv)FI ;.
+uuvvyz:uuuxwz(uuuzzx,uuvvuu,feldnr(uuuvvv)).uuvvzy:uuuxzz(uuuzzx,uuvvuu,
+feldnr(uuuvvv)).uuvwuu:nextsymbol;IF uuvuvz=uuuuvuTHEN uuvvyxELSE uuvvyzFI .
+ENDPROC uuvuvx;INT PROC uuvwyv:IF uuuvvv=">"THEN uuuuwzELIF uuuvvv="<"THEN 
+uuuuxuELIF uuuvvv="="THEN uuuuwvELIF uuuvvv=">="THEN uuuuwyELIF uuuvvv="<="
+THEN uuuuwxELIF uuuvvv="<>"THEN uuuuwwELIF uuuvvv="IN"THEN uuuuxzELSE uuuuxy
+FI ENDPROC uuvwyv;PROC nextsymbol:nextsymbol(uuuvvv,uuuvvu)ENDPROC nextsymbol
+;INT PROC uuvuvz:IF uuuvvv="("THEN uuuuuwELIF uuuvvv=")"THEN uuuuuxELIF 
+uuuvvv="NOT"OR uuuvvv="NICHT"THEN uuuuxwELIF uuuvvv="AND"OR uuuvvv="UND"THEN 
+uuuuxvELIF uuuvvv="OR"OR uuuvvv="ODER"THEN uuuuxxELIF uuuvvu=13THEN uuuuuy
+ELIF uuuvvu=uuuuwuCAND uuuvvv="<"THEN uuuuvuELIF uuuvvu=uuuuvzTHEN uuuuvv
+ELIF uuuvvu=7THEN uuuuuzELSE uuuuuvFI ENDPROC uuvuvz;PROC uuvwvw(TEXT CONST 
+uuvyyz):errorstop("FEHLERHAFTER AUSDRUCK: "+uuvyyz)ENDPROC uuvwvw;PROC 
+checkselektion(SELEKTION CONST uuuzzx):INT VAR uuvyzy,uuvyzz:=uuuzzx.uuuuzx;
+note("Anzahl Knoten: "+text(text(uuvyzz),5));noteline;noteline;noteline;FOR 
+uuvyzyFROM 1UPTO uuvyzzREP note("Knoten: "+text(uuvyzy));noteline;note(
+"     Operat: "+uuvzvu(uuuzzx.exp[uuvyzy]));noteline;note("     links : "+
+text(links(uuuzzx,uuvyzy)));noteline;note("     rechts: "+text(rechts(uuuzzx,
+uuvyzy)));noteline;note("     Wert  : "+">"+uuuzzx.exp[uuvyzy].selwert+"<");
+notelinePER ENDPROC checkselektion;TEXT PROC uuvzvu(NODE CONST uuuvzw):
+SELECT uuuvzw.uuuuyzOF CASE uuuuwv:"="CASE uuuuww:"<>"CASE uuuuwx:"<="CASE 
+uuuuwy:">="CASE uuuuwz:">"CASE uuuuxu:"<"CASE uuuuxw:"NOT"CASE uuuuxv:"AND"
+CASE uuuuxx:"OR"CASE uuuuxz:"IN"OTHERWISE :"UNDEFINED OPERATOR"ENDSELECT 
+ENDPROC uuvzvu;BOOL PROC werteselektionaus(SELEKTION VAR uuuvzw,INT CONST 
+uuvyzy):IF uuvyzy=0THEN LEAVE werteselektionausWITH TRUE FI ;uuwuux;SELECT 
+uuwuuyOF CASE uuuuxx:uuwuvuOR uuwuvvCASE uuuuxv:uuwuvuAND uuwuvvCASE uuuuxw:
+NOT uuwuvuCASE uuuuwx:uuwuwwCASE uuuuwy:uuwuwyCASE uuuuww:uuwuxuCASE uuuuwv:
+uuwuxwCASE uuuuxu:uuwuxyCASE uuuuwz:uuwuyuCASE uuuuxz:uuwuywOTHERWISE :FALSE 
+ENDSELECT .uuwuvu:werteselektionaus(uuuvzw,links(uuuvzw,uuvyzy)).uuwuvv:
+werteselektionaus(uuuvzw,rechts(uuuvzw,uuvyzy)).uuwuux:IF uuwuuy=uuuuxxCOR 
+uuwuuy=uuuuxvCOR uuwuuy=uuuuxwTHEN LEAVE uuwuuxELSE uuwvvz;uuwvwuFI .uuwvvz:
+IF fnrlinks(uuuvzw,uuvyzy)=0THEN SELECT uuwvwzOF CASE uuuuyv:uuuvuu:=int(
+selwert(uuuvzw,uuvyzy));uuuuzz:=uuuuyvCASE uuuuyw:uuuvuw:=real(selwert(uuuvzw
+,uuvyzy));uuuuzz:=uuuuywCASE uuuuyx:uuuvuw:=date(selwert(uuuvzw,uuvyzy));
+uuuuzz:=uuuuywOTHERWISE :uuuvuy:=selwert(uuuvzw,uuvyzy);uuuuzz:=uuuuyy
+ENDSELECT ELSE SELECT feldtyp(fnrlinks(uuuvzw,uuvyzy))OF CASE uuuuyv:uuuvuu:=
+intwert(fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuyvCASE uuuuyw:uuuvuw:=realwert(
+fnrlinks(uuuvzw,uuvyzy));uuuuzz:=uuuuywCASE uuuuyx:uuuvuw:=date(datumwert(
+fnrlinks(uuuvzw,uuvyzy)));uuuuzz:=uuuuywOTHERWISE :uuuvuy:=wert(fnrlinks(
+uuuvzw,uuvyzy));uuuuzz:=uuuuyyENDSELECT FI .uuwvwu:IF fnrrechts(uuuvzw,uuvyzy
+)=0THEN SELECT uuwxvvOF CASE uuuuyv:uuuvuv:=int(selwert(uuuvzw,uuvyzy))CASE 
+uuuuyw:uuuvux:=real(selwert(uuuvzw,uuvyzy))CASE uuuuyx:uuuvux:=date(selwert(
+uuuvzw,uuvyzy))OTHERWISE :uuuvuz:=selwert(uuuvzw,uuvyzy)ENDSELECT ELSE 
+SELECT feldtyp(fnrrechts(uuuvzw,uuvyzy))OF CASE uuuuyv:uuuvuv:=intwert(
+fnrrechts(uuuvzw,uuvyzy))CASE uuuuyw:uuuvux:=realwert(fnrrechts(uuuvzw,uuvyzy
+))CASE uuuuyx:uuuvux:=date(datumwert(fnrrechts(uuuvzw,uuvyzy)))OTHERWISE :
+uuuvuz:=wert(fnrrechts(uuuvzw,uuvyzy))ENDSELECT FI .uuwxvv:IF fnrlinks(uuuvzw
+,uuvyzy)=0THEN uuuuyyELSE feldtyp(fnrlinks(uuuvzw,uuvyzy))FI .uuwvwz:IF 
+fnrrechts(uuuvzw,uuvyzy)=0THEN uuuuyyELSE feldtyp(fnrrechts(uuuvzw,uuvyzy))
+FI .uuwuuy:optyp(uuuvzw,uuvyzy).ENDPROC werteselektionaus;BOOL PROC uuwuww:
+SELECT uuuuzzOF CASE uuuuyv:uuuvuu<=uuuvuvCASE uuuuyw:uuuvuw<=uuuvux
+OTHERWISE :uuuvuy<=uuuvuzENDSELECT ENDPROC uuwuww;BOOL PROC uuwuwy:SELECT 
+uuuuzzOF CASE uuuuyv:uuuvuu>=uuuvuvCASE uuuuyw:uuuvuw>=uuuvuxOTHERWISE :
+uuuvuy>=uuuvuzENDSELECT ENDPROC uuwuwy;BOOL PROC uuwuxy:SELECT uuuuzzOF CASE 
+uuuuyv:uuuvuu<uuuvuvCASE uuuuyw:uuuvuw<uuuvuxOTHERWISE :IF lexsortTHEN NOT (
+uuuvuyLEXGREATEREQUAL uuuvuz)ELSE uuuvuy<uuuvuzFI ENDSELECT ENDPROC uuwuxy;
+BOOL PROC uuwuyu:SELECT uuuuzzOF CASE uuuuyv:uuuvuu>uuuvuvCASE uuuuyw:uuuvuw>
+uuuvuxOTHERWISE :IF lexsortTHEN uuuvuyLEXGREATER uuuvuzELSE uuuvuy>uuuvuzFI 
+ENDSELECT ENDPROC uuwuyu;BOOL PROC uuwuxw:SELECT uuuuzzOF CASE uuuuyv:uuuvuu=
+uuuvuvCASE uuuuyw:uuuvuw=uuuvuxOTHERWISE :IF lexsortTHEN uuuvuyLEXEQUAL 
+uuuvuzELSE uuuvuy=uuuvuzFI ENDSELECT ENDPROC uuwuxw;BOOL PROC uuwuxu:SELECT 
+uuuuzzOF CASE uuuuyv:uuuvuu<>uuuvuvCASE uuuuyw:uuuvuw<>uuuvuxOTHERWISE :IF 
+lexsortTHEN NOT (uuuvuyLEXEQUAL uuuvuz)ELSE uuuvuy<>uuuvuzFI ENDSELECT 
+ENDPROC uuwuxu;BOOL PROC uuwuyw:IF uuuuzz=uuuuyyTHEN pos(uuuvuz,uuuvuy)>0
+ELSE FALSE FI ENDPROC uuwuyw;ENDPACKET queryselektion;
+
diff --git a/app/schulis/2.2.1/src/6.db snd query.sc b/app/schulis/2.2.1/src/6.db snd query.sc
new file mode 100644
index 0000000..dbf9cf5
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.db snd query.sc
@@ -0,0 +1,39 @@
+#$IF mitinternerqueryTHEN #PACKET dbsndqueryDEFINES auswertung,
+auswertungfortsetzen,qsucc,endofscan,ordernewstack,puttiefennr,gettiefennr,
+endqueryserver:LET uuuuuv=25,uuuuuw=0,uuuuux=1,uuuuuy=2,uuuuuz=2,uuuuvu=37,
+uuuuvv=10,uuuuvw=39,uuuuvx=40,uuuuvy=41,uuuuvz=1;INT CONST endofscan:=8,
+ordernewstack:=9;INT VAR uuuuwu,uuuuwv;DATASPACE VAR uuuuww;BOUND QUERY VAR 
+uuuuwx;BOUND TEXT VAR uuuuwy;ROW uuuuvvINT VAR uuuuxu;TYPE TUPEL =STRUCT (
+INT uuuuxv,uuuuxw,uuuuxx,TEXT uuuuxy);TYPE QUERYSTACK =STRUCT (INT uuuuxz,
+TASK uuuuyu,ROW uuuuuvTUPEL uuuuyw);INT VAR uuuuyx:=getanzahltupel,uuuuyy;
+TEXT VAR uuuuyz:="",uuuuzu:="";PROC endqueryserver:forget(uuuuww);uuuuww:=
+nilspace;send(uuuuzy,uuuuvx,uuuuww)ENDPROC endqueryserver;TASK VAR uuuuzy;
+BOUND QUERYSTACK VAR uuuvux;OP :=(TUPEL VAR uuuvuy,TUPEL CONST uuuvuz):CONCR 
+(uuuvuy):=CONCR (uuuvuz)ENDOP :=;OP :=(QUERYSTACK VAR uuuvuy,QUERYSTACK 
+CONST uuuvuz):CONCR (uuuvuy):=CONCR (uuuvuz)ENDOP :=;INT PROC gettiefennr(
+INT CONST uuuvwv):IF uuuvwv=0THEN 0ELSE uuuuxu[uuuvwv]FI ENDPROC gettiefennr;
+PROC puttiefennr(INT CONST uuuvwv,uuuvxw):uuuuxu[uuuvwv]:=uuuvxwENDPROC 
+puttiefennr;PROC auswertung(TEXT CONST uuuvyv):uuuuyy:=0;query(uuuvyv);IF 
+queryart=uuuuvzTHEN uuuvyzELSE uuuvzuFI .uuuvyz:uuuvzw;forget(uuuuww);uuuuww
+:=nilspace;uuuuwx:=uuuuww;getquery(uuuuwx);call(/name(1),uuuuvu,uuuuww,uuuuwu
+);uuuwuz;uuuvux:=uuuuww;uuuuzy:=uuuvux.uuuuyu.uuuvzu:forget(uuuuww);uuuuww:=
+old(uuuvyv);call(/name(1),uuuuvy,uuuuww,uuuuwu);uuuwuz.ENDPROC auswertung;
+PROC uuuvzw:uuuuwv:=0;uuuwxx(1)ENDPROC uuuvzw;PROC uuuwxx(INT CONST uuuwyu):
+uuuuwvINCR 1;puttiefennr(uuuwyu,uuuuwv);IF getsohnverb(uuuwyu)<>uuuuuwTHEN 
+uuuwxx(getsohnverb(uuuwyu))FI ;IF getbruderverb(uuuwyu)<>uuuuuwTHEN uuuwxx(
+getbruderverb(uuuwyu))FI ENDPROC uuuwxx;PROC auswertung(QUERY VAR uuuvyv):
+queryart(uuuuvz);uuuvzw;uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;uuuuwx:=
+uuuuww;uuuuwx:=uuuvyv;call(/name(1),uuuuvu,uuuuww,uuuuwu);uuuwuz;uuuvux:=
+uuuuww;uuuuzy:=uuuvux.uuuuyuENDPROC auswertung;PROC auswertungfortsetzen:
+uuuuyy:=0;forget(uuuuww);uuuuww:=nilspace;call(uuuuzy,uuuuvw,uuuuww,uuuuwu);
+uuuwuz;uuuvux:=uuuuwwENDPROC auswertungfortsetzen;PROC uuuwuz:IF uuuuwu=
+uuuuuzTHEN dbstatus(dberror);uuuuwy:=uuuuww;forget(uuuuww);errorstop(uuuuwy)
+ELSE dbstatus(uuuuwu)FI ENDPROC uuuwuz;PROC qsucc(INT VAR uuuwyu,uuuyuz):
+uuuuyyINCR 1;IF uuuuyy>uuuvux.uuuuxzTHEN uuuwyu:=0;uuuyuz:=0;dbstatus(
+endoffile)ELSE uuuyuz:=uuuvux.uuuuyw[uuuuyy].uuuuxw;#uuuywz(uuuvux.uuuuyw[
+uuuuyy].uuuuxy[uuuuux]);uuuyxz(uuuvux.uuuuyw[uuuuyy].uuuuxy[uuuuuy]);#
+parsetupel(uuuyuz,uuuyzu);IF uuuyzvTHEN dbstatus(endofscan)ELSE dbstatus(ok)
+FI FI .uuuyzu:uuuvux.uuuuyw[uuuuyy].uuuuxy.uuuyzv:uuuwyu:=uuuvux.uuuuyw[
+uuuuyy].uuuuxv;IF uuuwyu<0THEN uuuwyu:=abs(uuuwyu);TRUE ELSE FALSE FI .
+ENDPROC qsucc;ENDPACKET dbsndquery;#$FI #
+
diff --git a/app/schulis/2.2.1/src/6.ida.auswahl b/app/schulis/2.2.1/src/6.ida.auswahl
new file mode 100644
index 0000000..be92224
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.auswahl
@@ -0,0 +1,23 @@
+PACKET idaauswahlDEFINES idaauswahleinlesenundbearbeiten,idaauswahleinlesen,
+pruefungidaauswahl:LET niltext="";LET anzahlzeilen=18,erstesausgabefeld=2,
+vorwaerts=3;INT VAR anfang,ende,lv;TAG VAR maske;PROC 
+idaauswahleinlesenundbearbeiten(INT CONST nr):BOOL VAR listeexistiertnicht:=
+FALSE ;anfang:=(nr-1)*10+1;ende:=anfang+9;putintwert(fnridanummer,anfang);
+objektlistestarten(dnrida,text(anfang),fnridanummer,TRUE ,listeexistiertnicht
+);IF listeexistiertnichtOR NOT pruefungidaauswahlTHEN return(1)ELSE 
+datensatzlistenausgabe(PROC (INT CONST )erfassungdruckausgabe,TRUE ,BOOL 
+PROC pruefungidaauswahl);FI END PROC idaauswahleinlesenundbearbeiten;PROC 
+idaauswahleinlesen:feldersperren;infeld(erstesausgabefeld);standardnproc;END 
+PROC idaauswahleinlesen;BOOL PROC pruefungidaauswahl:intwert(fnridanummer)>=
+anfangCAND intwert(fnridanummer)<=endeEND PROC pruefungidaauswahl;PROC 
+datensatzlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,
+BOOL PROC pruefungspeziell):BOOL VAR rs:=ruecksprung;initobli;
+listenmaskeholenundausgeben;inlisteblaettern(PROC erfassungspeziell,vorwaerts
+,TRUE ,scanja,BOOL PROC pruefungspeziell);idaauswahleinlesenENDPROC 
+datensatzlistenausgabe;PROC listenmaskeholenundausgeben:LET listenmaskenname=
+"mu objektliste";initmaske(maske,listenmaskenname);setzeaktuellemaske(maske);
+standardstartproc(listenmaskenname)END PROC listenmaskeholenundausgeben;PROC 
+feldersperren:FOR lvFROM 1UPTO anzahlzeilenREP IF standardmaskenfeld(lv*2+1)=
+niltextTHEN protect(maske,lv*2,TRUE )FI PER END PROC feldersperren;END 
+PACKET idaauswahl;
+
diff --git a/app/schulis/2.2.1/src/6.ida.check b/app/schulis/2.2.1/src/6.ida.check
new file mode 100644
index 0000000..34d7616
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.check
@@ -0,0 +1,162 @@
+PACKET ispidacheckDEFINES fehlerinformular,formfehlermelden,
+fehlerindruckvariable,ausdruckwardruckvariable:LET okkenner="k",kennnormal=
+"+",kennauffaellig="#",linkeklammer="<",rechteklammer=">";FILE VAR formtext;
+TEXT VAR zeile:="",blockstruktur:="",zugriffsreihenfolge:="";INT VAR errormld
+:=0,errorline:=0;BOOL VAR fehlerfrei;LET mldplatzhalter=230,mldschachtelung=
+231,mldtextkosmetik=232,mldnichtverfuegbar=233,mldregelunbekannt=234,
+mldvarunbekannt=235,mldfeldunbekannt=236,mlddateiunbekannt=237,
+mldmussleitobjekt=238,laengeblockkey=6,kzkosmetik="#";LET mldkeinevar=239,
+mldvarfehler=240,mldkeinbegrenzer=241,mldtypkonflikt=242,mldkeinezeichenkette
+=243,mldrestunbekannt=244,mldklammerfehlt=245;LET parametergrenze="%",
+parametertrennzeichen="#",otherwise="*",textbegrenzer="""";BOOL VAR 
+wardruckvar:=TRUE ;PROC fehlersetzen(INT CONST nr):errormld:=nr;errorline:=
+max(lineno(formtext)-1,1);fehlerfrei:=FALSE ;ENDPROC fehlersetzen;PROC 
+formfehlermelden:TEXT VAR zusatz:=" in Zeile ";IF errormld>0THEN zusatzCAT 
+text(errorline);standardmeldung(errormld,zusatz+kennnormal+" <CR> "+
+kennauffaellig);pause;FI ;errormld:=0ENDPROC formfehlermelden;PROC 
+zugriffmerken(INT CONST objklasse):INT CONST dnr:=dateinr(getobjektklasse(
+objklasse));IF dnr=0THEN fehlersetzen(mlddateiunbekannt)ELSE 
+zugriffsreihenfolgeCAT "!"+text(dnr)+"!"FI ENDPROC zugriffmerken;BOOL PROC 
+dateischonimzugriff(INT CONST datei):pos(zugriffsreihenfolge,"!"+text(datei)+
+"!")>0ENDPROC dateischonimzugriff;TEXT PROC blockkey(INT CONST objklasse,
+regel):"!"+text(objklasse,2)+text(regel,2)+"!"ENDPROC blockkey;BOOL PROC 
+blockschliessen(INT CONST objklasse,regel):INT CONST p:=pos(blockstruktur,
+blockkey(objklasse,regel));IF p>0CAND fehlerfreiTHEN 
+pruefeobregelmehrfachauftritt;IF fehlerfreiTHEN pruefeobrichtiggeklammertFI 
+FI ;p>0.pruefeobregelmehrfachauftritt:IF pos(subtext(blockstruktur,p+
+laengeblockkey),blockkey(objklasse,regel))>0THEN fehlersetzen(mldschachtelung
+)FI .pruefeobrichtiggeklammert:TEXT VAR bs:=subtext(blockstruktur,p+
+laengeblockkey),kr:="";INT VAR pp;WHILE length(bs)>1REP kr:=text(bs,
+laengeblockkey);bs:=subtext(bs,laengeblockkey+1);pp:=pos(bs,kr);IF pp=0THEN 
+fehlersetzen(mldschachtelung);LEAVE pruefeobrichtiggeklammertELSE change(bs,
+pp,pp+laengeblockkey-1,"")FI PER .ENDPROC blockschliessen;PROC 
+pruefeaufdisjunkteobjektklassen(INT CONST objkl):TEXT VAR bs:=blockstruktur,
+kr:="";TEXT CONST objklkey:="!"+text(objkl,2);INT VAR p:=pos(bs,objklkey);
+WHILE p>0REP kr:=subtext(bs,p,p+laengeblockkey-1);change(bs,p,p+
+laengeblockkey-1,"");p:=pos(bs,kr);IF p=0THEN fehlersetzen(mldschachtelung);
+LEAVE pruefeaufdisjunkteobjektklassenELSE change(bs,p,p+laengeblockkey-1,"");
+p:=pos(bs,objklkey)FI PER ENDPROC pruefeaufdisjunkteobjektklassen;PROC 
+pruefeobverbundfelderverfuegbar(INT CONST regelnummer):INT VAR i,fnr,datei;
+TEXT VAR vglwert:="";FOR iFROM 1UPTO getanzahlregelfelder(regelnummer)REP 
+vglwert:=getvergleichswert(regelnummer,i);IF feldnameTHEN fnr:=feldnr(vglwert
+);IF fnr=0THEN fehlersetzen(mldfeldunbekannt);LEAVE 
+pruefeobverbundfelderverfuegbarFI ;datei:=dateinrzufeld(fnr);IF NOT 
+dateischonimzugriff(datei)THEN fehlersetzen(mldnichtverfuegbar);LEAVE 
+pruefeobverbundfelderverfuegbarFI FI PER .feldname:(vglwertSUB 1)<>"""".
+ENDPROC pruefeobverbundfelderverfuegbar;PROC pruefeobdatenbereitsverfuegbar(
+TEXT CONST ausdruck):LET parametergrenze="%";TEXT VAR evtlfeldname:=ausdruck;
+INT VAR fnr,dnr;IF pos(evtlfeldname,parametergrenze)>0THEN evtlfeldname:=text
+(evtlfeldname,pos(evtlfeldname,parametergrenze)-1);FI ;fnr:=feldnr(
+evtlfeldname);IF fnr>0THEN dnr:=dateinrzufeld(fnr);IF NOT dateischonimzugriff
+(dnr)THEN fehlersetzen(mldnichtverfuegbar);FI FI ENDPROC 
+pruefeobdatenbereitsverfuegbar;PROC blockkeymerken(INT CONST objklasse,regel)
+:IF blockstruktur=""CAND objklasse<>1CAND fehlerfreiTHEN fehlersetzen(
+mldmussleitobjekt)ELSE blockstrukturCAT blockkey(objklasse,regel);FI ENDPROC 
+blockkeymerken;BOOL PROC textkommando(TEXT CONST ausdruck):TEXT VAR parameter
+:="";IF pos("!page!head!bottom!end!","!"+ausdruck+"!")>0THEN LEAVE 
+textkommandoWITH TRUE FI ;IF pos(ausdruck,"on")=1THEN parameter:=compress(
+subtext(ausdruck,3));pruefeparameterELIF pos(ausdruck,"off")=1THEN parameter
+:=compress(subtext(ausdruck,4));pruefeparameterELSE FALSE FI .pruefeparameter
+:IF text(parameter,2)<>"("""COR subtext(parameter,length(parameter)-1)<>""")"
+THEN LEAVE pruefeparameterWITH FALSE FI ;parameter:=subtext(parameter,3,
+length(parameter)-2);pos("!bold!b!underline!u!","!"+parameter+"!")>0.ENDPROC 
+textkommando;PROC zeileueberpruefen(TEXT CONST zeile):TEXT VAR textzeile:=
+zeile,ausdruck:="";INT VAR vonp,bisp,stcodenr,ausglaenge;BOOL VAR rbuendig,
+druckvar;IF fehlerfreiTHEN druckvariablenpruefen;textkosmetikpruefenFI .
+druckvariablenpruefen:vonp:=pos(textzeile,linkeklammer);WHILE vonp>0REP bisp
+:=pos(textzeile,rechteklammer,vonp+1);IF bisp=0THEN fehlersetzen(
+mldplatzhalter);LEAVE zeileueberpruefenFI ;disablestop;stcodenr:=int(subtext(
+textzeile,vonp+1,bisp-1));clearerror;enablestop;getsteuercode(stcodenr,
+ausdruck,ausglaenge,rbuendig,druckvar);IF ausdruck=""COR NOT lastconversionok
+THEN fehlersetzen(mldvarunbekannt);LEAVE zeileueberpruefenELSE 
+pruefeobdatenbereitsverfuegbar(ausdruck);FI ;change(textzeile,vonp,bisp,"");
+vonp:=pos(textzeile,linkeklammer);PER .textkosmetikpruefen:textzeile:=zeile;
+vonp:=pos(textzeile,kzkosmetik);WHILE vonp>0REP bisp:=pos(textzeile,
+kzkosmetik,vonp+1);IF bisp=0THEN fehlersetzen(mldtextkosmetik);LEAVE 
+zeileueberpruefenFI ;ausdruck:=compress(subtext(textzeile,vonp+1,bisp-1));IF 
+NOT textkommando(ausdruck)THEN fehlersetzen(mldtextkosmetik);LEAVE 
+zeileueberpruefenFI ;change(textzeile,vonp,bisp,"");vonp:=pos(textzeile,
+kzkosmetik);PER .ENDPROC zeileueberpruefen;PROC bearbeiteblock:INT VAR p,bis,
+objklasse,regel;BOOL VAR eoformtext:=FALSE ;WHILE NOT eoformtextCAND 
+fehlerfreiREP IF zugriffsregelgefundenTHEN okundregelbestimmen;IF 
+blockschliessen(objklasse,regel)THEN blockkeymerken(objklasse,regel);LEAVE 
+bearbeiteblockELSE pruefeaufdisjunkteobjektklassen(objklasse);IF NOT 
+fehlerfreiTHEN LEAVE bearbeiteblockFI ;IF objklasse>1CAND fehlerfreiTHEN 
+pruefeobverbundfelderverfuegbar(getregelnummer(objklasse,regel));FI ;
+blockkeymerken(objklasse,regel);zugriffmerken(objklasse);IF NOT fehlerfrei
+THEN LEAVE bearbeiteblockFI ;IF compress(zeile)=""CAND NOT eoformtextTHEN 
+getline(formtext,zeile);FI ;bearbeiteblockFI ;ELSE zeileueberpruefen(zeile)
+FI ;IF eof(formtext)THEN eoformtext:=TRUE ELSE getline(formtext,zeile);FI ;
+PER ;.zugriffsregelgefunden:p:=pos(zeile,linkeklammer+okkenner);p>0.
+okundregelbestimmen:bis:=p+2;objklasse:=int(zeileSUB bis);bisINCR 1;IF 
+istziffer(zeileSUB bis)THEN objklasse:=objklasse*10+int(zeileSUB bis);bis
+INCR 1;FI ;IF objklasse<1COR objklasse>10THEN fehlersetzen(mldplatzhalter);
+LEAVE bearbeiteblockFI ;IF (zeileSUB bis)=rechteklammerTHEN regel:=1ELSE 
+regel:=int(zeileSUB bis+1);bisINCR 2;IF istziffer(zeileSUB bis)THEN regel:=
+regel*10+int(zeileSUB bis);bisINCR 1;FI ;FI ;change(zeile,p,bis,"");IF 
+objklasse>1CAND getregelnummer(objklasse,regel)=0THEN fehlersetzen(
+mldregelunbekannt);LEAVE bearbeiteblockFI ;.ENDPROC bearbeiteblock;BOOL PROC 
+fehlerinformular:#openformular(nr);#fehlerfrei:=TRUE ;stopbeifalschemnamen(
+FALSE );blockstruktur:="";zugriffsreihenfolge:="";zeile:="";errormld:=0;
+errorline:=0;formtext:=sequentialfile(input,getformtextname);IF NOT eof(
+formtext)THEN getline(formtext,zeile)FI ;IF eof(formtext)CAND zeile=""THEN 
+ELSE bearbeiteblockFI ;IF fehlerfreiCAND length(blockstruktur)<=
+laengeblockkeyTHEN fehlersetzen(mldschachtelung)FI ;stopbeifalschemnamen(
+TRUE );NOT fehlerfreiENDPROC fehlerinformular;BOOL PROC istziffer(TEXT CONST 
+t):pos("0123456789",t)>0END PROC istziffer;BOOL PROC istsonderfunktion(TEXT 
+CONST ausdruck):TEXT CONST liste:="#tagesdatum#tag#monat#jahr#zeit#tt#mm#jj#"
+;pos(liste,"#"+ausdruck+"#")>0ENDPROC istsonderfunktion;BOOL PROC istdbfeld(
+TEXT CONST feldname):feldnr(feldname)>0ENDPROC istdbfeld;BOOL PROC 
+falscherdenotertyp(TEXT CONST vglswert,INT CONST aktfeldtyp):BOOL VAR fehler
+:=FALSE ;INT VAR i;REAL VAR r;disablestop;IF aktfeldtyp=intfeldTHEN i:=int(
+vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp=realfeld
+THEN r:=real(vglswert);fehler:=NOT lastconversionokCOR iserrorELIF aktfeldtyp
+=datumfeldTHEN r:=date(vglswert);fehler:=iserrorFI ;clearerror;enablestop;
+fehlerEND PROC falscherdenotertyp;BOOL PROC ausdruckwardruckvariable:
+wardruckvarENDPROC ausdruckwardruckvariable;BOOL PROC fehlerindruckvariable(
+TEXT CONST origausdruck):BOOL VAR fehlerhaft:=FALSE ;INT VAR p;TEXT VAR 
+ausdruck:=compress(origausdruck),feldname:="";stopbeifalschemnamen(FALSE );
+wardruckvar:=TRUE ;liesfeldname;IF NOT istdbfeld(feldname)THEN IF 
+istsonderfunktion(feldname)THEN IF ausdruck=""THEN wardruckvar:=FALSE ELSE 
+standardmeldung(mldvarfehler,ausdruck);fehlerhaft:=TRUE ;FI ELSE 
+standardmeldung(mldkeinevar,feldname);fehlerhaft:=TRUE ;FI ;leaveprocFI ;IF 
+ausdruck>""THEN fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck)FI ;
+stopbeifalschemnamen(TRUE );fehlerhaft.liesfeldname:p:=pos(ausdruck,
+parametergrenze);IF p>0THEN feldname:=text(ausdruck,p-1);ausdruck:=subtext(
+ausdruck,p+1)ELSE feldname:=ausdruck;ausdruck:=""FI .leaveproc:
+stopbeifalschemnamen(TRUE );LEAVE fehlerindruckvariableWITH fehlerhaft.
+ENDPROC fehlerindruckvariable;BOOL PROC zusammengesetzterausdruck(TEXT CONST 
+aktfeld,TEXT VAR ausdruck):TEXT VAR feldname:="",vglswert:="";INT CONST 
+aktfeldtyp:=feldtyp(feldnr(aktfeld));INT VAR p;BOOL VAR fehlerhaft:=FALSE ;
+WHILE ausdruck>""CAND (ausdruckSUB 1)<>rechteklammerREP 
+pruefefallunterscheidung;PER ;fehlerhaft.pruefefallunterscheidung:p:=pos(
+ausdruck,parametertrennzeichen);IF p=0THEN standardmeldung(mldkeinbegrenzer,
+ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;vglswert:=text(
+ausdruck,p-1);ausdruck:=subtext(ausdruck,p+1);IF falscherdenotertyp(vglswert,
+aktfeldtyp)THEN standardmeldung(mldtypkonflikt,vglswert);LEAVE 
+zusammengesetzterausdruckWITH TRUE FI ;pruefesequenz;IF (ausdruckSUB 1)=
+otherwiseTHEN deletechar(ausdruck,1);pruefesequenzELIF (ausdruckSUB 1)=
+parametertrennzeichenTHEN deletechar(ausdruck,1)ELIF ausdruck>""THEN IF (
+ausdruckSUB 1)=parametertrennzeichenTHEN ELIF (ausdruckSUB 1)=rechteklammer
+THEN deletechar(ausdruck,1);LEAVE zusammengesetzterausdruckWITH fehlerhaft
+ELSE standardmeldung(mldrestunbekannt,ausdruck);LEAVE 
+zusammengesetzterausdruckWITH TRUE FI FI .pruefesequenz:
+zeichenketteueberlesen;IF (ausdruckSUB 1)=linkeklammerTHEN deletechar(
+ausdruck,1);IF postext(ausdruck,rechteklammer,1)=0THEN standardmeldung(
+mldklammerfehlt,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;
+liesfeldname;IF (ausdruckSUB 1)=parametergrenzeTHEN deletechar(ausdruck,1);
+fehlerhaft:=zusammengesetzterausdruck(feldname,ausdruck);IF fehlerhaftTHEN 
+LEAVE zusammengesetzterausdruckWITH TRUE FI ;ELSE deletechar(ausdruck,1);FI 
+FI .liesfeldname:p:=1;WHILE (ausdruckSUB p)<>rechteklammerCAND (ausdruckSUB p
+)<>parametergrenzeREP pINCR 1PER ;feldname:=text(ausdruck,p-1);ausdruck:=
+subtext(ausdruck,p);IF NOT istdbfeld(feldname)THEN standardmeldung(
+mldfeldunbekannt,feldname);LEAVE zusammengesetzterausdruckWITH TRUE FI .
+zeichenketteueberlesen:IF (ausdruckSUB 1)<>textbegrenzerTHEN standardmeldung(
+mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;p
+:=2;WHILE (ausdruckSUB p)<>textbegrenzerREP pINCR 1;IF (ausdruckSUB p)=
+textbegrenzerCAND (ausdruckSUB p+1)=textbegrenzerTHEN pINCR 2;FI ;UNTIL p>
+length(ausdruck)PER ;IF p>length(ausdruck)THEN standardmeldung(
+mldkeinezeichenkette,ausdruck);LEAVE zusammengesetzterausdruckWITH TRUE FI ;
+ausdruck:=compress(subtext(ausdruck,p+1)).ENDPROC zusammengesetzterausdruck;
+END PACKET ispidacheck
+
diff --git a/app/schulis/2.2.1/src/6.ida.def.druck b/app/schulis/2.2.1/src/6.ida.def.druck
new file mode 100644
index 0000000..81d218d
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.def.druck
@@ -0,0 +1,64 @@
+PACKET ispidadefinitiondruckenDEFINES druckdefinitionzusammenstellen,
+benoetigteregel,idaankreuzfelderpruefen:LET druckfile="Hilfsdatei.Druck",
+filenamezug="Hilfsdatei.Zugriff",niltext="";LET maxobjektklassen=10,
+maxvariablen=100,zobjklasse=2;BOOL VAR ba,bb;INT VAR ia,ib,ic,id,ie,lva,lvb,
+regelnummer;REAL VAR ra,rb,rc;TEXT VAR ta,tb,tc;FILE VAR f,g;PROC 
+druckdefinitionzusammenstellen(PROC (INT CONST )indatei,ROW 100TEXT VAR feld)
+:forget(druckfile,quiet);f:=sequentialfile(output,druckfile);
+nameundtypindateischreiben;objektklassenindateischreiben;
+zugriffsregelnindateischreiben(PROC (INT CONST )indatei,feld);
+selektionenindateischreiben(PROC (INT CONST )indatei);
+druckformularindateischreiben;druckvariablenindateischreiben;
+wertefuerdruckindateischreiben;print(druckfile);END PROC 
+druckdefinitionzusammenstellen;PROC nameundtypindateischreiben:putline(f,
+niltext);getformularinfo(ta,ia,ba);putline(f,"Nummer:  "+text(ia));putline(f,
+"  Name:  "+ta);END PROC nameundtypindateischreiben;PROC 
+objektklassenindateischreiben:putline(f,niltext);putline(f,"Objektklassen");
+putline(f,niltext);FOR iaFROM 1UPTO maxobjektklassenREP ta:=getobjektklasse(
+ia);IF ta<>niltextTHEN putline(f,"k"+text(ia)+":  "+ta);ELSE LEAVE 
+objektklassenindateischreibenFI PER ;END PROC objektklassenindateischreiben;
+PROC zugriffsregelnindateischreiben(PROC (INT CONST )indatei,ROW 100TEXT VAR 
+feld):putline(f,niltext);putline(f,"Zugriffsregeln");putline(f,niltext);FOR 
+lvaFROM 1UPTO getanzahlregelnREP bb:=TRUE ;getzugriffsregel(lva,ib,ic,id,ie);
+regelnummer:=lva;IF getobjektklasse(ib)<>niltextTHEN feld[zobjklasse]:=text(
+ib);indatei(4);g:=sequentialfile(modify,filenamezug);FOR lvbFROM 1UPTO lines(
+g)REP toline(g,lvb);readrecord(g,tb);IF pos(tb,"</>")>0THEN 
+zeilezusammensetzen;putline(f,ta);bb:=FALSE FI PER ;FI PER .
+zeilezusammensetzen:IF bbTHEN ta:="k"+text(ib,2)+"r"+text(ic,2)+" : ";ELSE ta
+:=9*" "FI ;taCAT text(subtext(tb,pos(tb,"<#>")+3,pos(tb,"<!>")-1),25);taCAT 
+" : ";taCAT subtext(tb,pos(tb,"</>")+3).END PROC 
+zugriffsregelnindateischreiben;PROC selektionenindateischreiben(PROC (INT 
+CONST )indatei):putline(f,niltext);putline(f,"Selektionen");putline(f,niltext
+);FOR lvaFROM 1UPTO getanzahlselfelderREP getselektion(lva,ta,tb);IF subtext(
+tb,pos(tb,"</>")+3)<>niltextTHEN zeilezusammensetzen;putline(f,tc)FI PER .
+zeilezusammensetzen:tc:=text(ta,25);tcCAT " : ";tcCAT tb.END PROC 
+selektionenindateischreiben;PROC druckformularindateischreiben:putline(f,
+niltext);putline(f,"Druckformular");putline(f,niltext);g:=sequentialfile(
+modify,getformtextname);FOR iaFROM 1UPTO lines(g)REP toline(g,ia);readrecord(
+g,ta);changeall(ta,"#","\#");putline(f,ta);PER ;END PROC 
+druckformularindateischreiben;PROC druckvariablenindateischreiben:putline(f,
+niltext);putline(f,"Druckvariablen");putline(f,niltext);FOR iaFROM 1UPTO 
+maxvariablenREP getsteuercode(ia,ta,ib,ba,bb);IF ta<>niltextTHEN changeall(ta
+,"#","\#");putline(f,text(ia,3)+":  "+ta);put(f,"      Länge: "+text(ib,2)+
+"  rechts-/linksbündig: ");IF baTHEN putline(f,"rechtsbündig")ELSE putline(f,
+"linksbündig")FI FI PER END PROC druckvariablenindateischreiben;PROC 
+wertefuerdruckindateischreiben:putline(f,niltext);putline(f,
+"Werte für die Druckaufbereitung");putline(f,niltext);getdruckaufbereitung(ta
+,ra,rb,ia,rc);putline(f,"                  Schrifttyp: "+ta);putline(f,
+"          linker oberer Rand: "+text(rb,4,1)+" cm von oben");putline(f,
+"                            : "+text(ra,4,1)+" cm von links");putline(f,
+" Anzahl der Zeilen pro Seite: "+text(ia));putline(f,
+"Anzahl der Zeichen pro Zeile: "+subtext(text(rc),1,pos(text(rc),".")-1));
+END PROC wertefuerdruckindateischreiben;INT PROC benoetigteregel:regelnummer
+END PROC benoetigteregel;BOOL PROC idaankreuzfelderpruefen:LET 
+meldungalternative=56,zeileninobjektliste=18;LET niltext="";BOOL VAR 
+angekreuzt:=FALSE ;INT VAR lva,lvi;IF NOT richtigangekreuztTHEN 
+standardmeldung(meldungalternative,niltext);return(1);FALSE ELSE TRUE FI .
+richtigangekreuzt:FOR lvaFROM 1UPTO anzahlderbelegtenzeilen-1REP IF 
+standardmaskenfeld(lva*2)<>niltextTHEN IF angekreuztTHEN infeld(lva*2);LEAVE 
+richtigangekreuztWITH FALSE ELSE angekreuzt:=TRUE FI FI PER ;angekreuzt.
+anzahlderbelegtenzeilen:FOR lviFROM 1UPTO zeileninobjektlisteREP IF 
+standardmaskenfeld(lvi*2+1)=niltextTHEN LEAVE anzahlderbelegtenzeilenWITH lvi
+FI PER ;0.END PROC idaankreuzfelderpruefen;END PACKET ispidadefinitiondrucken
+;
+
diff --git a/app/schulis/2.2.1/src/6.ida.definieren b/app/schulis/2.2.1/src/6.ida.definieren
new file mode 100644
index 0000000..696409b
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.definieren
@@ -0,0 +1,516 @@
+PACKET ispidadefinierenDEFINES druckausgabeeingangaufbauenundeinlesen,
+druckausgabeeingangeinlesen,druckausgabeaufbauenundeinlesen,
+druckausgabeeinlesen,druckausgabeausgebenundbearbeiten,druckausgabespeichern,
+druckausgabeneueinfuegen,druckausgabeloeschenvorbereiten,
+druckausgabeloeschfrage,druckausgabeloeschen,
+druckausgabelisteaufbauenundeinlesen,druckausgabelisteeinlesen,
+ausgesuchtedruckausgabeausgebenundbearbeiten,ausgesuchtedruckausgabeeinlesen,
+ausgesuchtedruckausgabeloeschenvorbereiten,ausgesuchtedruckausgabeloeschfrage
+,listederdruckausgabenzeigen,listederdruckausgabeneinlesen,
+indruckausgabenblaettern,inselektionenzurdruckausgabeblaettern,
+inregelzurdruckausgabeblaettern,zurueckzurbearbeitung,formularausdrucken,
+setzenummerderdruckausgabe,nochmeldungauszugeben,pruefungida,:LET filenamezug
+="Hilfsdatei.Zugriff",filenamesel="Hilfsdatei.Selektion",#filenamedruck=
+"Hilfsdatei.Druck",#filenameform="FORMTEXT.",filenamedata="FORMDATA.";LET 
+maskenzusatz=" für Druckausgabe ";LET nameundtyp=1,objektklassen=2,#
+datenvorrat=3,#zugriffsregeln=4,selektion=5,druckformular=6,druckvariablen=7,
+druckwerte=8,druckdefinition=9;LET ntnummer=2,ntname=3;LET oleitobjekt=2;LET 
+zobjklasse=2,zregelnr=3,zobjklname=4,znummer=5,zersterzugriff=6,
+zerstervergleich=7;LET sersteselektion=2,serstervergleich=3;LET dvnummer=2,
+dvdefinition=3,dvlaenge=4,dvrechtsbuendig=5;LET dwschriftart=2,
+dwlinkerrandoben=3,dwlinkerrandlinks=4,dwzeilenproseite=5,dwzeichenprozeile=6
+;LET minanfang=1.0,maxanfang=10.0;LET ankreuzzeichen="x",anzahltrenner="<?>",
+namentrenner="<#>",zeilennrtrenner="<!>",vergleichtrenner="</>",vartrenner=
+"%",trenner=". ",leitobjektschueler="Schüler",leitobjektlehrer="Lehrer",#
+gueltigerstatus="nw",#niltext="",semikolon=";"#oblitrenner="$"#;LET 
+leitobjekt=1,vorwaerts=1#rueckwaerts=2#;LET tl=3,maxzugriffe=16,
+maxselektionen=17,maxobjektklassen=10;LET fnrerstesausgabefeld=2,
+anzmaskeneing=2,anzmaskenbearb=9,anzmaskentitel=9;LET meldunglistenerstellung
+=7,meldungalternative=56,meldungplausipruefung=57,meldungloeschfrage=65,
+meldungkeineliste=68,meldungkeinblaettern=72,meldungformdrucken=219,
+meldungfalscheeingabe=204,meldungdgibtesschon=205,meldungdgibtesnicht=206,
+meldungfalschenummer=207,meldungfalschesobjekt=208,meldungsammelndruckdef=209
+,meldungdruckendruckdef=210,meldungrgibtesschon=211,meldungrgibtesnicht=212,
+meldungvgibtesschon=213,meldungvgibtesnicht=214,meldungkeinleitobjekt=215,
+meldungfalscheregel=217,meldungfalschevariable=218,meldungkeinefonttabelle=
+250,meldungkeineobjektklasse=251;BOOL VAR loeschenderdruckausgabe:=FALSE ,
+neuedruckausgabe:=FALSE ,neuedruckvariable:=FALSE ,neuezugriffsregel:=FALSE ,
+druckenderdefinition:=FALSE ,druckvariablegibtesbereits:=FALSE ,
+zugriffsregelgibtesbereits:=FALSE ;BOOL VAR drvrechtsbuendig,drvdruckvar;
+FILE VAR f;INT VAR fnrletztesausgabefeld:=100,fehlseite:=0,fehlzeile:=0,
+fehlmeld:=0;INT VAR startpos,datenseite,merkzeile,anzahlderdateizeilen,
+leseanfangindatei,fnummer,zeilennr,nrdruckausgabe,anzfelder,dnr,zuwas;INT 
+VAR regelnr,regnr,objklasse;INT VAR zrregel,zrobjekt,zrindex,zranzahl;INT 
+VAR drvlaenge;ROW anzmaskenbearbINT VAR letztesmaskenfeld:=ROW anzmaskenbearb
+INT :(3,11,100,52,35,100,5,6,100);ROW anzmaskeneingTEXT VAR eingangsmaske:=
+ROW anzmaskeneingTEXT :("mdr name und typ der druckausgabe",
+"mdr objektklasse waehlen eingang");ROW anzmaskenbearbTEXT VAR bearbmaske:=
+ROW anzmaskenbearbTEXT :("mdr name und typ der druckausgabe",
+"mdr objektklasse waehlen bearb","","mdr zugriffsregeln bearb",
+"mdr selektionsbedingung bearb","","mdr variablen definieren bearb",
+"mdr werte fuer druckausgabe festlegen bearb",
+"mdr objektklasse waehlen eingang");ROW anzmaskentitelTEXT VAR 
+maskentiteleingang:=ROW anzmaskentitelTEXT :("Name und Nummer definieren",
+"Objektklassen wählen","Datenvorrat festlegen","Zugriffsregeln bearbeiten",
+"Selektionsbedingungen angeben","Druckformular editieren",
+"Druckvariablen definieren","Werte für Druckaufbereitung",
+"Definition ausdrucken");ROW 100TEXT VAR erfassungsfeld;TAG VAR maske;BOOL 
+VAR gespeichert:=FALSE ;TEXT VAR sfeldname,svergleichswert;TEXT VAR 
+filenameformtp:="DUMMY";TEXT VAR meldungstext:="",nummerderdruckausgabe:="",
+pattern,zeile,programmname;PROC druckausgabeeingangaufbauenundeinlesen(INT 
+CONST was):systemdboff;drvdruckvar:=ruecksprung;loeschenderdruckausgabe:=
+FALSE ;setzedruckausgabelistenauswahl(FALSE );
+setzelistederdruckausgabengezeigt(FALSE );fehlseite:=1;fehlzeile:=1;fehlmeld
+:=0;init(erfassungsfeld);startpos:=fnrerstesausgabefeld;zuwas:=was;
+programmname:=maskentiteleingang[zuwas];eingangsmaskeinitialisieren;
+felderausgebenundeinlesen;.eingangsmaskeinitialisieren:IF zuwas=1THEN 
+initmaske(maske,eingangsmaske[1])ELSE initmaske(maske,eingangsmaske[2])FI ;
+nummerderdruckausgabe:=niltext;setzeaktuellemaske(maske).
+felderausgebenundeinlesen:IF zuwas=1THEN standardstartproc(eingangsmaske[1])
+ELSE standardstartproc(eingangsmaske[2])FI ;fnrletztesausgabefeld:=
+letztesmaskenfeld[zuwas];feldschutzfestlegen(fnrerstesausgabefeld+1);
+loeschfeldverdecken;eventuellmeldungausgeben;get(maske,erfassungsfeld,
+startpos);nummerderdruckausgabe:=erfassungsfeld[fnrerstesausgabefeld];
+standardmaskenfeld(nummerderdruckausgabe,fnrerstesausgabefeld).END PROC 
+druckausgabeeingangaufbauenundeinlesen;PROC druckausgabeeingangeinlesen(INT 
+CONST was):putget(maske,nummerderdruckausgabe,fnrerstesausgabefeld);END PROC 
+druckausgabeeingangeinlesen;PROC druckausgabeaufbauenundeinlesen(INT CONST 
+was):IF ruecksprungTHEN bearbeitungsbildschirmausgeben(PROC 
+erneuteeingabeerforderlich)ELSE eingangsbildschirmueberpruefen(PROC 
+erneuteeingabeerforderlich)FI END PROC druckausgabeaufbauenundeinlesen;PROC 
+druckausgabeeinlesen(INT CONST was):IF was=druckformularTHEN editiere(
+filenameformtp,FALSE )ELSE get(maske,erfassungsfeld,startpos);
+standardfelderfuellen;FI END PROC druckausgabeeinlesen;PROC 
+druckausgabeausgebenundbearbeiten(INT CONST was):zuwas:=was;loeschemeldung(
+aktuellemaske);loeschenderdruckausgabe:=FALSE ;neuedruckausgabe:=FALSE ;
+SELECT wasOF CASE zugriffsregeln:neuezugriffsregel:=FALSE ;
+zugriffsregelueberpruefenCASE druckvariablen:neuedruckvariable:=FALSE ;
+druckvariableueberpruefenCASE druckdefinition:eingangsbildschirmueberpruefen(
+PROC druckdefinitiondrucken)OTHERWISE :zurueck;eingangsbildschirmueberpruefen
+(PROC maskenwertezeigenundbearbeiten)END SELECT ;.END PROC 
+druckausgabeausgebenundbearbeiten;PROC druckausgabespeichern(BOOL CONST 
+speichern,INT CONST was):IF speichernTHEN angabenabspeichern(was);gespeichert
+:=TRUE ELSE gespeichert:=FALSE ;meldungstext:=("Die Angaben "+
+meldungseinschub+" wurden nicht gespeichert ");hilfsfilesloeschen;IF NOT 
+druckausgabelistenauswahl#dr01.08.88#THEN forget(getformtextname,quiet);
+forget(filenameformtp,quiet)FI ;eventuellmeldungbeilistenabarbeitungFI ;
+stopbeifalschemnamen(TRUE )END PROC druckausgabespeichern;PROC 
+druckausgabeneueinfuegen(INT CONST was):loeschemeldung(aktuellemaske);
+loeschenderdruckausgabe:=FALSE ;SELECT wasOF CASE nameundtyp:neuedruckausgabe
+:=TRUE ;eingangsbildschirmueberpruefen(PROC maskenwertezeigenundbearbeiten)
+CASE zugriffsregeln:neuezugriffsregel:=TRUE ;zugriffsregelueberpruefenCASE 
+druckvariablen:neuedruckvariable:=TRUE ;druckvariableueberpruefenOTHERWISE :
+rueckschrittevorproc(2)END SELECT END PROC druckausgabeneueinfuegen;PROC 
+druckausgabeloeschenvorbereiten(INT CONST was):loeschemeldung(aktuellemaske);
+loeschenderdruckausgabe:=TRUE ;SELECT wasOF CASE nameundtyp:neuedruckausgabe
+:=FALSE ;eingangsbildschirmueberpruefen(PROC maskenwertezeigenundbearbeiten)
+CASE zugriffsregeln:neuezugriffsregel:=FALSE ;zugriffsregelueberpruefenCASE 
+druckvariablen:neuedruckvariable:=FALSE ;druckvariableueberpruefenOTHERWISE :
+rueckschrittevorproc(2)END SELECT ;END PROC druckausgabeloeschenvorbereiten;
+PROC druckausgabeloeschfrage:TEXT VAR xy;meldeauffaellig(aktuellemaske,
+meldungloeschfrage);startpos:=letztesmaskenfeld[zuwas]+1;get(maske,xy,
+startpos).END PROC druckausgabeloeschfrage;PROC druckausgabeloeschen(BOOL 
+CONST loeschen,INT CONST was):IF loeschenTHEN meldungstext:=("Die Angaben "+
+meldungseinschub+" wurden gelöscht ");angabenloeschen(was);ELSE meldungstext
+:=("Die Angaben "+meldungseinschub+" wurden nicht gelöscht ");
+hilfsfilesloeschen;FI ;loeschenderdruckausgabe:=FALSE ;
+eventuellmeldungbeilistenabarbeitung;END PROC druckausgabeloeschen;PROC 
+druckausgabelisteaufbauenundeinlesen(INT CONST was):
+setzedruckausgabelistenauswahl(FALSE );SELECT wasOF CASE nameundtyp:
+druckausgabenlistezeigenCASE zugriffsregeln:listederregelnzeigenCASE 
+druckvariablen:listederdruckvariablenzeigenEND SELECT ;IF (was=nameundtypAND 
+listederdruckausgabengezeigt)OR ((was=zugriffsregelnOR was=druckvariablen)
+AND druckausgabelistenauswahl)THEN druckausgabelisteeinlesen(was);FI .
+listederregelnzeigen:loeschemeldung(aktuellemaske);IF erlaubteregeleingabeOR 
+regelleerTHEN regellistezeigenELSE meldeauffaellig(aktuellemaske,
+meldungfalscheregel);return(1);LEAVE druckausgabelisteaufbauenundeinlesenFI .
+regelleer:erfassungsfeld[zobjklasse]=niltextAND erfassungsfeld[zregelnr]=
+niltext.listederdruckvariablenzeigen:loeschemeldung(aktuellemaske);IF 
+erlaubtevariableneingabeOR druckvariableleerTHEN variablenlistezeigenELSE 
+meldeauffaellig(aktuellemaske,meldungfalschevariable);return(1);LEAVE 
+druckausgabelisteaufbauenundeinlesenFI .druckvariableleer:erfassungsfeld[
+dvnummer]=niltext.END PROC druckausgabelisteaufbauenundeinlesen;PROC 
+druckausgabelisteeinlesen(INT CONST was):infeld(fnrerstesausgabefeld);
+standardnproc;maskenwertesichern;END PROC druckausgabelisteeinlesen;PROC 
+ausgesuchtedruckausgabeausgebenundbearbeiten(INT CONST was):
+behandlungderausgesuchten(PROC (INT CONST )druckausgabeausgebenundbearbeiten,
+erfassungsfeld,was);END PROC ausgesuchtedruckausgabeausgebenundbearbeiten;
+PROC ausgesuchtedruckausgabeeinlesen(INT CONST welche):druckausgabeeinlesen(
+welche)END PROC ausgesuchtedruckausgabeeinlesen;PROC 
+ausgesuchtedruckausgabeloeschenvorbereiten(INT CONST was):
+behandlungderausgesuchten(PROC (INT CONST )druckausgabeloeschenvorbereiten,
+erfassungsfeld,was);END PROC ausgesuchtedruckausgabeloeschenvorbereiten;PROC 
+ausgesuchtedruckausgabeloeschfrage:druckausgabeloeschfrageEND PROC 
+ausgesuchtedruckausgabeloeschfrage;PROC listederdruckausgabenzeigen:BOOL VAR 
+listeexistiertnicht:=FALSE ;loeschemeldung(aktuellemaske);
+nummerderdruckausgabe:=erfassungsfeld[fnrerstesausgabefeld];
+standardmaskenfeld(nummerderdruckausgabe,fnrerstesausgabefeld);IF 
+nummerinrichtigengrenzen(nummerderdruckausgabe)OR nummerderdruckausgabe=
+niltextTHEN #putkeypart(niltext);putdatapart(niltext);##vorläufig14.03.88#
+pruefenobdruckausgabenexistierenELSE meldeauffaellig(aktuellemaske,
+meldungfalschenummer);rueckschrittenachproc(1)FI .
+pruefenobdruckausgabenexistieren:meldeauffaellig(aktuellemaske,
+meldunglistenerstellung);putwert(fnridanummer,nummerderdruckausgabe);
+objektlistestarten(dnrida,standardmaskenfeld(fnrerstesausgabefeld),
+fnridanummer,TRUE ,listeexistiertnicht);IF listeexistiertnichtTHEN 
+meldeauffaellig(aktuellemaske,meldungkeineliste);rueckschrittenachproc(1)
+ELSE druckausgabelisteaufbauenundeinlesen(nameundtyp)FI .END PROC 
+listederdruckausgabenzeigen;PROC listederdruckausgabeneinlesen:
+druckausgabelisteeinlesen(nameundtyp)END PROC listederdruckausgabeneinlesen;
+PROC indruckausgabenblaettern(INT CONST wie,worin):inlisteblaettern(wie);IF 
+ruecksprungTHEN meldeauffaellig(aktuellemaske,meldungkeinblaettern);FI ;
+return(1)END PROC indruckausgabenblaettern;PROC 
+inselektionenzurdruckausgabeblaettern(INT CONST wie):loeschemeldung(
+aktuellemaske);selektionenindateieintragen(leseanfangindatei,erfassungsfeld);
+datenseiteraufoderrunter(wie);IF maxselektionen*(datenseite-1)>=
+anzahlderdateizeilenOR datenseite=0THEN meldeauffaellig(aktuellemaske,
+meldungkeinblaettern);datenseiterunteroderrauf(wie)ELSE 
+selektionenzeigenvorbereiten(datenseite);FI ;put(maske,erfassungsfeld,
+letztesmaskenfeld[zuwas]);startpos:=serstervergleich;rueckschrittenachproc(1)
+;END PROC inselektionenzurdruckausgabeblaettern;PROC 
+inregelzurdruckausgabeblaettern(INT CONST wie):loeschemeldung(aktuellemaske);
+zugriffsregelnindateieintragen(leseanfangindatei,erfassungsfeld);
+datenseiteraufoderrunter(wie);IF maxzugriffe*(datenseite-1)>=
+anzahlderdateizeilenOR datenseite=0THEN meldeauffaellig(aktuellemaske,
+meldungkeinblaettern);datenseiterunteroderrauf(wie)ELSE 
+zugriffezeigenvorbereiten(datenseite)FI ;put(maske,erfassungsfeld,
+letztesmaskenfeld[zuwas]);startpos:=zerstervergleich;rueckschrittenachproc(1)
+END PROC inregelzurdruckausgabeblaettern;INT PROC nochmeldungauszugeben:IF 
+meldungstext=niltextTHEN 0ELSE meldungstext:=niltext;IF gespeichertTHEN 191
+ELSE 195FI FI END PROC nochmeldungauszugeben;PROC setzenummerderdruckausgabe(
+TEXT CONST nr):nummerderdruckausgabe:=nrEND PROC setzenummerderdruckausgabe;
+BOOL PROC pruefungida:FALSE END PROC pruefungida;PROC zurueckzurbearbeitung(
+INT CONST anzahl):zurueck;setzedruckausgabelistenauswahl(FALSE );init(
+erfassungsfeld);enter(anzahl)END PROC zurueckzurbearbeitung;PROC 
+formularausdrucken:standardmeldung(meldungformdrucken,niltext);changeinfile(
+filenameformtp,"#","\#");print(filenameformtp);changeinfile(filenameformtp,"\#"
+,"#");rueckschrittenachproc(1)END PROC formularausdrucken;PROC 
+druckvariableueberpruefen:IF erlaubtevariableneingabeTHEN 
+standardkopfmaskeaktualisieren(programmname);IF druckausgabelistenauswahl
+THEN initmaske(maske,bearbmaske[zuwas]);setzeaktuellemaske(maske);show(
+aktuellemaske);loeschfeldverdecken;FI ;IF existenzdervariablennotwendigTHEN 
+fehlerbehandlung;rueckschrittenachproc(1)ELSE maskenwertezeigenundbearbeiten;
+FI ELSE meldeauffaellig(aktuellemaske,meldungfalschevariable);startpos:=
+fnrerstesausgabefeld;rueckschrittenachproc(1)FI .
+existenzdervariablennotwendig:(neuedruckvariableAND 
+druckvariableexistiertschon)OR (NOT neuedruckvariableAND NOT 
+druckvariableexistiertschon).druckvariableexistiertschon:getsteuercode(int(
+erfassungsfeld[dvnummer]),erfassungsfeld[dvdefinition],drvlaenge,
+drvrechtsbuendig,drvdruckvar);druckvariablegibtesbereits:=erfassungsfeld[
+dvdefinition]<>niltext;erfassungsfeld[dvdefinition]<>niltext.fehlerbehandlung
+:IF neuedruckvariableAND druckvariableexistiertschonTHEN meldeauffaellig(
+aktuellemaske,meldungvgibtesschon)ELSE meldeauffaellig(aktuellemaske,
+meldungvgibtesnicht)FI .END PROC druckvariableueberpruefen;PROC 
+eingangsbildschirmueberpruefen(PROC wasweiter):BOOL VAR 
+druckausgabegibtesschon:=druckausgabeexistiertbereits;IF eingangsbildschirmok
+THEN IF listederdruckausgabengezeigtTHEN nummerderdruckausgabesetzen(
+nummerderdruckausgabe);druckausgabegibtesschon:=druckausgabeexistiertbereits
+FI ;getform(int(nummerderdruckausgabe));openformular(int(
+nummerderdruckausgabe));init(erfassungsfeld);angegebenedruckausgabebearbeiten
+ELSE fehlerbehandlung1;rueckschrittenachproc(1)FI .eingangsbildschirmok:IF 
+listederdruckausgabengezeigtTHEN nureinedruckausgabeangekreuztELSE 
+nummerinrichtigengrenzen(nummerderdruckausgabe)FI .fehlerbehandlung1:IF 
+listederdruckausgabengezeigtTHEN meldeauffaellig(aktuellemaske,
+meldungalternative)ELSE meldeauffaellig(aktuellemaske,meldungfalschenummer)
+FI .angegebenedruckausgabebearbeiten:IF existenzderdruckausgabenoetigTHEN IF 
+zuwas=druckdefinitionTHEN #wasweiterersetztdr16.12.87#
+bearbeitungsbildschirmausgeben(PROC wasweiter);ELIF zuwas=selektionAND 
+getobjektklasse(leitobjekt)=niltextTHEN meldeauffaellig(aktuellemaske,
+meldungkeinleitobjekt);rueckschrittenachproc(1)ELSE saveupdateposition(dnrida
+);bearbeitungsbildschirmausgeben(PROC wasweiter);FI ELSE fehlerbehandlung2;
+rueckschrittenachproc(1)FI .existenzderdruckausgabenoetig:(
+druckausgabegibtesschonAND NOT neuedruckausgabe)OR (NOT 
+druckausgabegibtesschonAND neuedruckausgabe).fehlerbehandlung2:IF NOT 
+druckausgabegibtesschonAND NOT neuedruckausgabeTHEN meldeauffaellig(
+aktuellemaske,meldungdgibtesnicht);forget(filenameform+text(getactivformular)
+,quiet);forget(filenamedata+text(getactivformular),quiet)ELIF 
+druckausgabegibtesschonAND neuedruckausgabeTHEN meldeauffaellig(aktuellemaske
+,meldungdgibtesschon)FI ;.END PROC eingangsbildschirmueberpruefen;BOOL PROC 
+druckausgabeexistiertbereits:#putkeypart(niltext);putdatapart(niltext);##
+vorläufig14.03.88#inittupel(dnrida);putwert(fnridanummer,
+nummerderdruckausgabe);search(dnrida,TRUE );dbstatus=okEND PROC 
+druckausgabeexistiertbereits;PROC bearbeitungsbildschirmausgeben(PROC 
+wasweiter):programmname:=maskentiteleingang[zuwas]+maskenzusatz+
+nummerderdruckausgabe;standardkopfmaskeaktualisieren(programmname);
+bearbeitungsmaskeausgeben;eventuellmeldungausgeben;wasweiter.
+bearbeitungsmaskeausgeben:initmaske(maske,bearbmaske[zuwas]);
+setzeaktuellemaske(maske);fnrletztesausgabefeld:=letztesmaskenfeld[zuwas];
+show(aktuellemaske);loeschfeldverdecken;getform(int(nummerderdruckausgabe));
+openformular(int(nummerderdruckausgabe)).END PROC 
+bearbeitungsbildschirmausgeben;PROC zugriffsregelueberpruefen:IF 
+erlaubteregeleingabeTHEN standardkopfmaskeaktualisieren(programmname);IF 
+druckausgabelistenauswahlTHEN initmaske(maske,bearbmaske[zuwas]);
+setzeaktuellemaske(maske);show(aktuellemaske);loeschfeldverdeckenFI ;IF 
+existenzderregelnotwendigTHEN fehlerbehandlung;rueckschrittenachproc(1)ELSE 
+maskenwertezeigenundbearbeiten;FI ELSE #dr02.05.88#IF falscheregelTHEN 
+meldeauffaellig(aktuellemaske,meldungfalscheregel)ELIF 
+esexistiertkeineobjektklasseTHEN meldeauffaellig(aktuellemaske,
+meldungkeineobjektklasse)FI ;startpos:=fnrerstesausgabefeld;
+rueckschrittenachproc(1)FI .existenzderregelnotwendig:(neuezugriffsregelAND 
+zugriffsregelexistiertschon)OR (NOT neuezugriffsregelAND NOT 
+zugriffsregelexistiertschon).zugriffsregelexistiertschon:objklasse:=int(
+erfassungsfeld[zobjklasse]);regnr:=int(erfassungsfeld[zregelnr]);regelnr:=
+getregelnummer(objklasse,regnr);zugriffsregelgibtesbereits:=regelnr>0;regelnr
+>0.fehlerbehandlung:IF neuezugriffsregelAND zugriffsregelexistiertschonTHEN 
+meldeauffaellig(aktuellemaske,meldungrgibtesschon)ELSE meldeauffaellig(
+aktuellemaske,meldungrgibtesnicht)FI .falscheregel:erfassungsfeld[zobjklasse]
+=niltextCOR erfassungsfeld[zregelnr]=niltext.esexistiertkeineobjektklasse:
+erfassungsfeld[zobjklasse]<>niltext#dr02.05.88#CAND int(erfassungsfeld[
+zobjklasse])<=10CAND getobjektklasse(int(erfassungsfeld[zobjklasse]))=niltext
+.END PROC zugriffsregelueberpruefen;PROC erneuteeingabeerforderlich:
+allefeldersperren(FALSE );feldschutzfuerbearbeitungfestlegen(zuwas);startpos
+:=fnrerstesausgabefeld;put(maske,erfassungsfeld,letztesmaskenfeld[zuwas]);
+druckausgabeeinlesen(zuwas)END PROC erneuteeingabeerforderlich;PROC 
+angabenabspeichern(INT CONST was):INT VAR lvf;TEXT VAR txt;fehlseite:=1;
+fehlzeile:=1;fehlmeld:=0;SELECT wasOF CASE nameundtyp:nameundtypspeichern
+CASE objektklassen:objektklassenspeichernCASE zugriffsregeln:
+zugriffsregelspeichernCASE selektion:selektionspeichernCASE druckformular:
+druckformularspeichernCASE druckvariablen:druckvariablespeichernCASE 
+druckwerte:druckwertespeichernEND SELECT ;meldungstext:=("Die Angaben "+
+meldungseinschub+" wurden gespeichert ");eventuellmeldungbeilistenabarbeitung
+#dr01.08.88#.nameundtypspeichern:meldeauffaellig(aktuellemaske,
+meldungplausipruefung);IF nameundtypok(erfassungsfeld,fnummer)THEN 
+putformularinfo(erfassungsfeld[ntname],int(erfassungsfeld[ntnummer]),FALSE );
+nameundtypindbeintragen;sichernundhilfsfilesloeschenELSE 
+meldefehlernameundtyp;startpos:=fnummer;rueckschrittenachproc(1);LEAVE 
+angabenabspeichernFI .nameundtypindbeintragen:putwert(fnridanummer,
+erfassungsfeld[ntnummer]);putwert(fnridaname,erfassungsfeld[ntname]);IF 
+neuedruckausgabeTHEN insert(dnrida)ELSE restoreupdateposition(dnrida);update(
+dnrida)FI .objektklassenspeichern:meldeauffaellig(aktuellemaske,
+meldungplausipruefung);IF objektklassenzugelassenTHEN FOR lvfFROM 1UPTO 
+maxobjektklassenREP putobjektklasse(lvf,erfassungsfeld[lvf+1])PER ;
+sichernundhilfsfilesloeschenELSE meldeauffaellig(aktuellemaske,
+meldungfalschesobjekt);startpos:=lvf+1;rueckschrittenachproc(1);LEAVE 
+angabenabspeichernFI .objektklassenzugelassen:IF 
+leitobjektklasseleeroderungueltigTHEN lvf:=1;LEAVE objektklassenzugelassen
+WITH FALSE FI ;stopbeifalschemnamen(FALSE );FOR lvfFROM 1UPTO 
+maxobjektklassenREP IF erfassungsfeld[lvf+1]<>niltextTHEN IF 
+objektklassekeindateinameTHEN LEAVE objektklassenzugelassenWITH FALSE FI FI 
+PER ;stopbeifalschemnamen(TRUE );TRUE .leitobjektklasseleeroderungueltig:
+erfassungsfeld[oleitobjekt]=niltextCOR (pos(leitobjektschueler,erfassungsfeld
+[oleitobjekt])=0AND pos(leitobjektlehrer,erfassungsfeld[oleitobjekt])=0).
+objektklassekeindateiname:dateinr(erfassungsfeld[lvf+1])=0.
+zugriffsregelspeichern:zugriffsregelnindateieintragen(leseanfangindatei,
+erfassungsfeld);meldeauffaellig(aktuellemaske,meldungplausipruefung);IF 
+zugriffsregelnok(fehlseite,fehlzeile,fehlmeld)THEN zugriffsregelnabspeichern;
+sichernundhilfsfilesloeschenELSE stopbeifalschemnamen(TRUE );datenseite:=
+fehlseite;zugriffezeigenvorbereiten(datenseite);put(maske,erfassungsfeld,
+letztesmaskenfeld[zuwas]);meldeauffaellig(aktuellemaske,fehlmeld);startpos:=
+fehlzeile+((fehlzeile+2)*2);rueckschrittenachproc(1);LEAVE angabenabspeichern
+FI .zugriffsregelnabspeichern:wertesetzenbeineuerzugriffsregel;
+erstenvergleichsuchenundindexsetzen;zugriffsregelundvergleichswertespeichern.
+wertesetzenbeineuerzugriffsregel:IF neuezugriffsregelTHEN regelnr:=
+getanzahlregeln+1;zrobjekt:=objklasse;zrregel:=regnr;ELSE FI .
+erstenvergleichsuchenundindexsetzen:pattern:=vergleichtrenner;toline(f,1);
+readrecord(f,zeile);IF pos(zeile,pattern)=0THEN down(f,pattern);readrecord(f,
+zeile);FI ;zrindex:=int(subtext(zeile,1,pos(zeile,anzahltrenner)-1)).
+zugriffsregelundvergleichswertespeichern:putzugriffsregel(regelnr,zrobjekt,
+zrregel,zrindex,0);WHILE pos(zeile,vergleichtrenner)>0REP putvergleichswert(
+regelnr,subtext(zeile,pos(zeile,vergleichtrenner)+tl));toline(f,lineno(f)+1);
+readrecord(f,zeile);PER .selektionspeichern:selektionenindateieintragen(
+leseanfangindatei,erfassungsfeld);meldeauffaellig(aktuellemaske,
+meldungplausipruefung);IF selektionswerteok(dnr,fehlseite,fehlzeile,fehlmeld)
+THEN selektionenabspeichern;sichernundhilfsfilesloeschenELSE datenseite:=
+fehlseite;selektionenzeigenvorbereiten(datenseite);put(maske,erfassungsfeld,
+letztesmaskenfeld[zuwas]);meldeauffaellig(aktuellemaske,fehlmeld);startpos:=(
+fehlzeile*2)+1;rueckschrittenachproc(1);LEAVE angabenabspeichernFI .
+selektionenabspeichern:putanzahlselfelder(0);FOR lvfFROM 1UPTO anzattr(dnr)
+REP toline(f,lvf);readrecord(f,zeile);sfeldname:=subtext(zeile,1,pos(zeile,
+zeilennrtrenner)-1);svergleichswert:=subtext(zeile,pos(zeile,vergleichtrenner
+)+tl);putselektion(sfeldname,svergleichswert)PER .druckformularspeichern:
+standardmeldung(meldungplausipruefung,niltext);forget(getformtextname,quiet);
+copy(filenameformtp,getformtextname);IF fehlerinformularTHEN formfehlermelden
+;rueckschrittenachproc(1);LEAVE angabenabspeichernELSE forget(filenameformtp,
+quiet);sichernundhilfsfilesloeschenFI .druckvariablespeichern:meldeauffaellig
+(aktuellemaske,meldungplausipruefung);IF fehlerindruckvariable(erfassungsfeld
+[dvdefinition])THEN rueckschrittenachproc(1);LEAVE angabenabspeichernELSE 
+drvdruckvar:=ausdruckwardruckvariable;putsteuercode(int(erfassungsfeld[
+dvnummer]),erfassungsfeld[dvdefinition],int(erfassungsfeld[dvlaenge]),
+erfassungsfeld[dvrechtsbuendig]<>niltext,drvdruckvar);
+sichernundhilfsfilesloeschenFI .druckwertespeichern:meldeauffaellig(
+aktuellemaske,meldungplausipruefung);IF druckwerteokTHEN startpos:=
+fnrerstesausgabefeld;putdruckaufbereitung(erfassungsfeld[dwschriftart],real(
+erfassungsfeld[dwlinkerrandlinks]),real(erfassungsfeld[dwlinkerrandoben]),int
+(erfassungsfeld[dwzeilenproseite]),real(erfassungsfeld[dwzeichenprozeile]));
+sichernundhilfsfilesloeschenELSE IF lvf=0THEN meldeauffaellig(aktuellemaske,
+meldungfalscheeingabe);ELSE meldeauffaellig(aktuellemaske,
+meldungkeinefonttabelle);FI ;rueckschrittenachproc(1);LEAVE 
+angabenabspeichernFI .druckwerteok:lvf:=0;fonttabelleeingestelltCAND 
+fontexistiertauchCAND linkerrandrichtigCAND rechterrandrichtig.
+linkerrandrichtig:startpos:=dwlinkerrandlinks;real(erfassungsfeld[
+dwlinkerrandlinks])>=minanfangCAND real(erfassungsfeld[dwlinkerrandlinks])<=
+maxanfang.rechterrandrichtig:startpos:=dwlinkerrandoben;real(erfassungsfeld[
+dwlinkerrandoben])>=minanfangCAND real(erfassungsfeld[dwlinkerrandoben])<=
+maxanfang.fonttabelleeingestellt:startpos:=dwschriftart;disablestop;txt:=font
+(1);IF iserrorTHEN clearerror;lvf:=1FI ;enablestop;lvf=0.fontexistiertauch:
+startpos:=dwschriftart;font(erfassungsfeld[dwschriftart])>0.END PROC 
+angabenabspeichern;PROC maskenwertezeigenundbearbeiten:IF 
+loeschenderdruckausgabeTHEN allefeldersperren(TRUE );
+maskenwerteholenundausgeben(zuwas);druckausgabeloeschfrageELSE 
+allefeldersperren(FALSE );maskenwerteholenundausgeben(zuwas);
+druckausgabeeinlesen(zuwas)FI ;END PROC maskenwertezeigenundbearbeiten;PROC 
+maskenwerteholenundausgeben(INT CONST wozu):LET maxanzobjektklassen=10;INT 
+VAR feld,nrindex,lvf,lvi;TEXT VAR z,datname;datenseite:=1;SELECT wozuOF CASE 
+nameundtyp:nameundtypzeigenCASE objektklassen:objektklassenzeigenCASE 
+zugriffsregeln:zugriffsregelzeigenCASE selektion:selektionzeigenCASE 
+druckformular:druckformularzeigenCASE druckvariablen:druckvariablezeigenCASE 
+druckwerte:druckwertezeigenEND SELECT ;IF wozu<>druckformularTHEN put(maske,
+erfassungsfeld,letztesmaskenfeld[zuwas]);FI .nameundtypzeigen:BOOL VAR 
+ausgabelistenweise;erfassungsfeld[ntnummer]:=nummerderdruckausgabe;IF NOT 
+neuedruckausgabeTHEN ausgabelistenweise:=FALSE ;getformularinfo(
+erfassungsfeld[ntname],nrdruckausgabe,ausgabelistenweise);FI ;IF 
+neuedruckausgabeTHEN protect(maske,fnrerstesausgabefeld,TRUE )FI ;startpos:=
+fnrerstesausgabefeld+1;.objektklassenzeigen:FOR lvfFROM 1UPTO 
+maxanzobjektklassenREP erfassungsfeld[lvf+1]:=getobjektklasse(lvf)PER ;.
+zugriffsregelzeigen:objektklasseholen;moeglichezugriffezeigen;
+anzahlderdateizeilen:=lines(f);IF zugriffsregelgibtesbereitsTHEN 
+gespeichertezugriffezeigen;FI ;zugriffezeigenvorbereiten(datenseite);startpos
+:=zerstervergleich.moeglichezugriffezeigen:primaerzugriffholen;IF firstindex>
+0THEN sekundaerzugriffeholen;FI ;.primaerzugriffholen:forget(filenamezug,
+quiet);f:=sequentialfile(modify,filenamezug);datname:=erfassungsfeld[
+zobjklname];dnr:=dateinr(datname);anzfelder:=anzkey(dnr);zeilennr:=1;nrindex
+:=0;FOR lvfFROM 1UPTO anzfelderREP feld:=dnr+lvf;zeileindateischreiben;PER ;.
+sekundaerzugriffeholen:FOR lviFROM firstindexUPTO firstfree-1REP IF dateinr(
+primdatid(lvi))=dnrTHEN anzahlderfelderbestimmen;nrindexINCR 1;FOR lvfFROM 1
+UPTO anzfelderREP feld:=dnr+int(subtext(z,1,pos(z,semikolon)-1));z:=subtext(z
+,pos(z,semikolon)+1);zeileindateischreiben;PER ;FI ;PER ;.
+anzahlderfelderbestimmen:z:=zugriff(lvi);INT VAR posi;anzfelder:=0;posi:=pos(
+z,semikolon);WHILE posi>0REP anzfelderINCR 1;posi:=pos(z,semikolon,posi+1)
+PER ;.zeileindateischreiben:zeilezusammensetzen;toline(f,zeilennr);
+insertrecord(f);writerecord(f,zeile);zeilennrINCR 1;.zeilezusammensetzen:IF 
+lvf=1THEN zeile:=text(nrindex)+anzahltrenner;zeileCAT text(anzfelder);zeile
+CAT namentrenner;ELSE zeile:=namentrennerFI ;zeileCAT name(feld);zeileCAT 
+zeilennrtrenner;zeileCAT text(zeilennr);.gespeichertezugriffezeigen:
+gespeichertezugriffeholen;gespeichertezugriffeindateieintragen.
+gespeichertezugriffeholen:IF druckenderdefinitionTHEN regelnr:=
+benoetigteregelFI ;getzugriffsregel(regelnr,zrobjekt,zrregel,zrindex,zranzahl
+);.gespeichertezugriffeindateieintragen:pattern:=text(zrindex)+anzahltrenner;
+toline(f,1);readrecord(f,zeile);IF pos(zeile,pattern)>0THEN zugriffeeintragen
+ELSE down(f,pattern);IF patternfoundTHEN zugriffeeintragenFI FI .
+zugriffeeintragen:zeilennr:=lineno(f);FOR lvfFROM 1UPTO zranzahlREP toline(f,
+zeilennr);readrecord(f,zeile);zeileCAT vergleichtrenner;zeileCAT 
+getvergleichswert(regelnr,lvf);writerecord(f,zeile);zeilennrINCR 1;PER .
+selektionzeigen:forget(filenamesel,quiet);f:=sequentialfile(modify,
+filenamesel);dnr:=dateinr(getobjektklasse(leitobjekt));
+feldnamenindateischreiben;anzahlderdateizeilen:=lines(f);
+gespeicherteselektionenindateischreiben;selektionenzeigenvorbereiten(
+datenseite);startpos:=serstervergleich.feldnamenindateischreiben:FOR lvfFROM 
+1UPTO anzattr(dnr)REP toline(f,lvf);insertrecord(f);zeile:=name(dnr+lvf)+
+zeilennrtrenner+text(lvf)+vergleichtrenner;writerecord(f,zeile);PER .
+gespeicherteselektionenindateischreiben:IF getanzahlselfelder<>0THEN FOR lvf
+FROM 1UPTO getanzahlselfelderREP toline(f,lvf);readrecord(f,zeile);
+getselektion(lvf,sfeldname,svergleichswert);zeileCAT svergleichswert;
+writerecord(f,zeile);PER FI .druckformularzeigen:filenameformtp:=wert(
+fnridanummer)+trenner+wert(fnridaname);forget(filenameformtp,quiet);IF exists
+(getformtextname)THEN copy(getformtextname,filenameformtp)FI ;startpos:=
+fnrerstesausgabefeld.druckvariablezeigen:IF druckvariablegibtesbereitsTHEN 
+protect(maske,dvnummer,TRUE );IF drvlaenge=0THEN erfassungsfeld[dvlaenge]:=
+niltextELSE erfassungsfeld[dvlaenge]:=text(drvlaenge)FI ;IF drvrechtsbuendig
+THEN erfassungsfeld[dvrechtsbuendig]:=ankreuzzeichenELSE erfassungsfeld[
+dvrechtsbuendig]:=niltextFI FI ;startpos:=dvdefinition.druckwertezeigen:REAL 
+VAR linksoben,linkslinks,spalten;INT VAR zeilen;zurueck;getdruckaufbereitung(
+erfassungsfeld[dwschriftart],linkslinks,linksoben,zeilen,spalten);
+erfassungsfeld[dwlinkerrandlinks]:=text(linkslinks);erfassungsfeld[
+dwlinkerrandoben]:=text(linksoben);erfassungsfeld[dwzeilenproseite]:=text(
+zeilen);erfassungsfeld[dwzeichenprozeile]:=subtext(text(spalten),1,pos(text(
+spalten),".")-1);.END PROC maskenwerteholenundausgeben;PROC objektklasseholen
+:erfassungsfeld[zobjklname]:=getobjektklasse(int(erfassungsfeld[zobjklasse]))
+;END PROC objektklasseholen;PROC selektionenzeigenvorbereiten(INT CONST 
+seitennr):bildschirmausgabenselektionsammeln(seitennr);
+selektionsfeldersperren;freizeilenselektionloeschenEND PROC 
+selektionenzeigenvorbereiten;PROC bildschirmausgabenselektionsammeln(INT 
+CONST seitennr):INT VAR lvf;merkzeile:=maxselektionen+1;leseanfangindatei:=(
+seitennr-1)*maxselektionen+1;FOR lvfFROM 1UPTO maxselektionenREP IF lvf+
+leseanfangindatei-1<=anzahlderdateizeilenTHEN toline(f,lvf+leseanfangindatei-
+1);readrecord(f,zeile);erfassungsfeld[sersteselektion+(lvf-1)*2]:=subtext(
+zeile,1,pos(zeile,zeilennrtrenner)-1);IF pos(zeile,vergleichtrenner)>0THEN 
+erfassungsfeld[serstervergleich+(lvf-1)*2]:=subtext(zeile,pos(zeile,
+vergleichtrenner)+tl);FI ;ELSE merkzeile:=lvf;LEAVE 
+bildschirmausgabenselektionsammelnFI PER ;END PROC 
+bildschirmausgabenselektionsammeln;PROC selektionsfeldersperren:INT VAR lvf;
+allefeldersperren(TRUE );FOR lvfFROM 1UPTO maxselektionenREP protect(maske,
+serstervergleich+(lvf-1)*2,FALSE )PER END PROC selektionsfeldersperren;PROC 
+freizeilenselektionloeschen:INT VAR lv;FOR lvFROM merkzeileUPTO 
+maxselektionenREP erfassungsfeld[sersteselektion+(lv-1)*2]:=niltext;
+erfassungsfeld[serstervergleich+(lv-1)*2]:=niltext;protect(maske,
+serstervergleich+(lv-1)*2,TRUE )PER END PROC freizeilenselektionloeschen;
+PROC zugriffezeigenvorbereiten(INT CONST seitennr):
+bildschirmausgabenzugriffsammeln(seitennr);zugriffsfeldersperren;
+freizeilenzugriffloeschenEND PROC zugriffezeigenvorbereiten;PROC 
+bildschirmausgabenzugriffsammeln(INT CONST seitennr):INT VAR lvf;merkzeile:=
+maxzugriffe+1;leseanfangindatei:=(seitennr-1)*maxzugriffe+1;FOR lvfFROM 1
+UPTO maxzugriffeREP IF lvf+leseanfangindatei-1<=anzahlderdateizeilenTHEN 
+toline(f,lvf+leseanfangindatei-1);readrecord(f,zeile);erfassungsfeld[znummer+
+(lvf-1)*3]:=subtext(zeile,1,pos(zeile,anzahltrenner)-1);erfassungsfeld[
+zersterzugriff+(lvf-1)*3]:=subtext(zeile,pos(zeile,namentrenner)+tl,pos(zeile
+,zeilennrtrenner)-1);IF pos(zeile,vergleichtrenner)>0THEN erfassungsfeld[
+zerstervergleich+(lvf-1)*3]:=subtext(zeile,pos(zeile,vergleichtrenner)+tl);
+ELSE erfassungsfeld[zerstervergleich+(lvf-1)*3]:=niltextFI ;ELSE merkzeile:=
+lvf;LEAVE bildschirmausgabenzugriffsammelnFI PER ;.END PROC 
+bildschirmausgabenzugriffsammeln;PROC zugriffsfeldersperren:INT VAR lvf;
+allefeldersperren(TRUE );FOR lvfFROM 1UPTO maxzugriffeREP protect(maske,
+zerstervergleich+(lvf-1)*3,FALSE )PER END PROC zugriffsfeldersperren;PROC 
+freizeilenzugriffloeschen:INT VAR lv;FOR lvFROM merkzeileUPTO maxzugriffeREP 
+erfassungsfeld[znummer+(lv-1)*3]:=niltext;erfassungsfeld[zersterzugriff+(lv-1
+)*3]:=niltext;erfassungsfeld[zerstervergleich+(lv-1)*3]:=niltext;protect(
+maske,zerstervergleich+(lv-1)*3,TRUE )PER END PROC freizeilenzugriffloeschen;
+PROC datenseiteraufoderrunter(INT CONST wie):IF wie=vorwaertsTHEN datenseite
+INCR 1ELSE datenseiteDECR 1FI ;END PROC datenseiteraufoderrunter;PROC 
+datenseiterunteroderrauf(INT CONST wie):IF wie=vorwaertsTHEN datenseiteDECR 1
+ELSE datenseiteINCR 1FI END PROC datenseiterunteroderrauf;PROC 
+angabenloeschen(INT CONST was):SELECT wasOF CASE nameundtyp:
+nameundtyploeschenCASE zugriffsregeln:zugriffsregelloeschenCASE 
+druckvariablen:druckvariableloeschenEND SELECT .nameundtyploeschen:delform(
+getactivformular);forget(getformtextname,quiet);forget(filenamedata+text(
+getactivformular),quiet);delete(dnrida).zugriffsregelloeschen:deleteregel(
+regelnr);sichernundhilfsfilesloeschen;.druckvariableloeschen:putsteuercode(
+int(erfassungsfeld[dvnummer]),niltext,0,FALSE ,FALSE );
+sichernundhilfsfilesloeschen.END PROC angabenloeschen;PROC allefeldersperren(
+BOOL CONST freigabe):INT VAR lv;FOR lvFROM fnrerstesausgabefeldUPTO 
+letztesmaskenfeld[zuwas]+5REP protect(maske,lv,freigabe)PER ;protect(maske,
+letztesmaskenfeld[zuwas]+1,TRUE );startpos:=fnrerstesausgabefeld;END PROC 
+allefeldersperren;PROC changeinfile(TEXT CONST fname,vorher,nachher):INT VAR 
+lv;f:=sequentialfile(modify,fname);FOR lvFROM 1UPTO lines(f)REP toline(f,lv);
+readrecord(f,zeile);changeall(zeile,vorher,nachher);writerecord(f,zeile)PER ;
+toline(f,1)END PROC changeinfile;PROC druckdefinitiondrucken:
+druckenderdefinition:=TRUE ;zugriffsregelgibtesbereits:=TRUE ;meldeauffaellig
+(aktuellemaske,meldungsammelndruckdef);druckdefinitionzusammenstellen(PROC (
+INT CONST )maskenwerteholenundausgeben,erfassungsfeld);meldeauffaellig(
+aktuellemaske,meldungdruckendruckdef);sichernundhilfsfilesloeschen;
+nummerderdruckausgabe:=niltext;druckenderdefinition:=FALSE ;
+zugriffsregelgibtesbereits:=FALSE ;rueckschrittevorproc(1)#dr16.12.87#END 
+PROC druckdefinitiondrucken;BOOL PROC erlaubteregeleingabe:LET maxeingabe=10;
+(nummernummerisch(erfassungsfeld[zobjklasse])CAND int(erfassungsfeld[
+zobjklasse])>1CAND int(erfassungsfeld[zobjklasse])<=maxeingabeCAND 
+getobjektklasse(int(erfassungsfeld[zobjklasse]))<>niltext)CAND (
+nummernummerisch(erfassungsfeld[zregelnr])CAND int(erfassungsfeld[zregelnr])>
+0CAND int(erfassungsfeld[zregelnr])<=maxeingabe)END PROC erlaubteregeleingabe
+;BOOL PROC erlaubtevariableneingabe:LET maxeingabe=100;(nummernummerisch(
+erfassungsfeld[dvnummer])CAND int(erfassungsfeld[dvnummer])>0CAND int(
+erfassungsfeld[dvnummer])<=maxeingabe)END PROC erlaubtevariableneingabe;PROC 
+eventuellmeldungausgeben:IF meldungstext<>niltextTHEN meldeauffaellig(
+aktuellemaske,meldungstext);meldungstext:=niltext;FI END PROC 
+eventuellmeldungausgeben;PROC eventuellmeldungbeilistenabarbeitung:IF 
+druckausgabelistenauswahlTHEN meldeauffaellig(aktuellemaske,meldungstext);
+kurzepause;meldungstext:=niltext;enter(1)ELSE IF listederdruckausgabengezeigt
+CAND (zuwas=zugriffsregelnOR zuwas=druckvariablen)CAND NOT (
+druckausgabelistenauswahl)THEN zurueckzurbearbeitung(2)ELSE 
+rueckschrittevorproc(2)FI ;FI .kurzepause:pause(10).END PROC 
+eventuellmeldungbeilistenabarbeitung;PROC feldschutzfestlegen(INT CONST abwo)
+:INT VAR lv;protect(maske,1,TRUE );FOR lvFROM abwoUPTO letztesmaskenfeld[
+zuwas]REP protect(maske,lv,TRUE )PER END PROC feldschutzfestlegen;PROC 
+feldschutzfuerbearbeitungfestlegen(INT CONST wozu):protect(maske,1,TRUE );
+SELECT wozuOF CASE zugriffsregeln:feldschutzfestlegen(fnrerstesausgabefeld+2)
+CASE druckvariablen:feldschutzfestlegen(fnrerstesausgabefeld+1)OTHERWISE :
+allefeldersperren(FALSE )END SELECT ;END PROC 
+feldschutzfuerbearbeitungfestlegen;PROC loeschfeldverdecken:LET rahmenzeichen
+="=";put(aktuellemaske,rahmenzeichen,letztesmaskenfeld[zuwas]+1);END PROC 
+loeschfeldverdecken;TEXT PROC meldungseinschub:TEXT VAR t;SELECT zuwasOF 
+CASE zugriffsregeln:t:="zur Regel k"+compress(erfassungsfeld[zobjklasse])+"r"
++compress(erfassungsfeld[zregelnr])CASE druckvariablen:t:=
+"zur Druckvariablen "+erfassungsfeld[dvnummer]OTHERWISE :t:=
+"zur Druckausgabe "+text(getactivformular)END SELECT ;tEND PROC 
+meldungseinschub;PROC standardfelderfuellen:INT VAR lv;FOR lvFROM 1UPTO 
+letztesmaskenfeld[zuwas]REP standardmaskenfeld(erfassungsfeld[lv],(lv))PER 
+END PROC standardfelderfuellen;END PACKET ispidadefinieren;
+
diff --git a/app/schulis/2.2.1/src/6.ida.druck b/app/schulis/2.2.1/src/6.ida.druck
new file mode 100644
index 0000000..d24c0cd
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.druck
@@ -0,0 +1,261 @@
+PACKET idadruckDEFINES listendruck,ausdruckauswerten,bschirm,drucker,
+namederdruckausgabe,namederdruckausgabeohne,druckausgabeausgeben,ruecksprung,
+zurueck,postext,seitenweise:LET linkeklammer="<",rechteklammer=">",
+platzhalter="�",linefeed="
",trenner=" ",kzkosmetik="#",kzseitenzahl="%",
+ddrucker=1,dbschirm=2,mlddrucken=58,mldaufb=190;TEXT VAR filename:=
+"ISP-Liste";INT CONST drucker:=ddrucker,bschirm:=dbschirm;FILE VAR ausgfile;
+INT VAR dbauswertung,anzzeilen,zeilenzaehler:=0,fusszeilen:=0,kopfzeilen:=0,
+aktuelleseite:=0,aktuellerds:=0,zeilenlaenge,verbund;BOOL VAR tupelbearbeitet
+,isppageform:=FALSE ;TEXT VAR restderletztenzeile:="";TEXT VAR schriftart:=""
+,kopfbereich:="",fussbereich:="",kosmetikbereich:="zzzz";REAL VAR links,oben;
+#nurtest!!!!!!PROC standardmeldung(INT CONST mldaufb,TEXT CONST t):fehler(
+"MELDUNG: "+text(mldaufb)+"  "+t)ENDPROC standardmeldung;PROC editiere(TEXT 
+CONST fname,BOOL CONST f):edit(fname)ENDPROC editiere;PROC enter(INT CONST i)
+:ENDPROC enter;#PROC seitenweise(BOOL CONST jn):isppageform:=jnENDPROC 
+seitenweise;BOOL PROC seitenweise:isppageformENDPROC seitenweise;TEXT PROC 
+rechtscompress(TEXT CONST zeile):TEXT VAR z:=zeile;INT VAR p:=length(zeile);
+WHILE p>0CAND (zSUB p)=trennerREP pDECR 1PER ;z:=text(z,p);zENDPROC 
+rechtscompress;INT PROC bestimmevorhandeneblanks(TEXT CONST zeile):INT VAR 
+vorhandeneblanks:=0,i;FOR iFROM 1UPTO length(zeile)REP IF (zeileSUB i)=
+trennerTHEN vorhandeneblanksINCR 1FI UNTIL (zeileSUB i)<>trennerPER ;
+vorhandeneblanksENDPROC bestimmevorhandeneblanks;TEXT PROC 
+textmitfuehrendenblanks(TEXT CONST z,INT CONST anzblanks):INT VAR 
+vorhandeneblanks:=0;TEXT VAR zeile:=z;vorhandeneblanks:=
+bestimmevorhandeneblanks(zeile);IF vorhandeneblanks>anzblanksTHEN 
+zeilekuerzenELSE mitblanksauffuellenFI ;zeile.zeilekuerzen:zeile:=subtext(
+zeile,vorhandeneblanks-anzblanks).mitblanksauffuellen:zeile:=(anzblanks-
+vorhandeneblanks)*trenner+zeile.ENDPROC textmitfuehrendenblanks;TEXT PROC 
+aktfilename:IF aktuellerds=0THEN filenameELSE filename+"."+text(aktuellerds)
+FI ENDPROC aktfilename;PROC schreibebereich(TEXT CONST bereich,BOOL CONST 
+kopf):INT VAR von:=0,bis;TEXT VAR zeile:="";bis:=pos(bereich,linefeed);WHILE 
+bis>0REP zeile:=subtext(bereich,von+1,bis-1);IF kopfTHEN changeall(zeile,
+kzseitenzahl,text(aktuelleseite));zeilenzaehlerINCR 1FI ;putline(ausgfile,
+zeile);von:=bis;bis:=pos(bereich,linefeed,von+1);PER ENDPROC schreibebereich;
+PROC schreibekopf:schreibebereich(kopfbereich,TRUE )ENDPROC schreibekopf;
+PROC schreibefuss:schreibebereich(fussbereich,FALSE )ENDPROC schreibefuss;
+PROC seitenvorschub:schreibefuss;IF filefastvollTHEN ausgabedateianlegenELSE 
+putline(ausgfile,"#page#")FI ;zeilenzaehler:=0;aktuelleseiteINCR 1;
+schreibekopf.filefastvoll:lines(ausgfile)>=3000COR storage(old(aktfilename))>
+700.ENDPROC seitenvorschub;PROC pageeinfuegen:putline(ausgfile,"#page#");
+zeilenzaehler:=0;ENDPROC pageeinfuegen;PROC zeilenvorschubundfussdrucken:
+WHILE zeilenzaehler<anzzeilen-fusszeilenREP putline(ausgfile,"");
+zeilenzaehlerINCR 1PER ;schreibefussENDPROC zeilenvorschubundfussdrucken;
+PROC putlein(TEXT CONST zeile,BOOL CONST nurkosmetik):IF seitenweiseTHEN IF 
+NOT nurkosmetikCAND zeilenzaehler=anzzeilen-fusszeilenTHEN seitenvorschubFI 
+ELSE IF zeilenzaehler=anzzeilen-fusszeilen-kopfzeilenTHEN pageeinfuegenFI FI 
+;putline(ausgfile,zeile);zeilenzaehlerINCR 1ENDPROC putlein;PROC putzeile(
+TEXT CONST zeile):TEXT VAR auszeile:="";BOOL CONST blocksatz:=(zeileSUB 
+length(zeile))=trenner;INT VAR trennpos,linkerrand;IF length(
+restderletztenzeile)>0THEN auszeile:=restderletztenzeile;IF 
+keintrennerzwischenzeilenTHEN auszeileCAT trennerFI FI ;auszeileCAT zeile;
+restderletztenzeile:="";IF length(auszeile)<=zeilenlaengeTHEN putlein(
+auszeile,FALSE )ELSE bestimmelinkenrand;WHILE length(auszeile)>zeilenlaenge
+REP trennpositionbestimmen;zeileausgebenundkürzen;PER ;IF length(auszeile)>0
+THEN IF blocksatzTHEN putlein(auszeile,FALSE )ELSE restderletztenzeile:=
+textmitfuehrendenblanks(auszeile,linkerrand)FI FI FI .
+keintrennerzwischenzeilen:(restderletztenzeileSUB length(restderletztenzeile)
+)<>trennerCAND (zeileSUB 1)<>trenner.bestimmelinkenrand:linkerrand:=
+bestimmevorhandeneblanks(auszeile);.trennpositionbestimmen:trennpos:=
+zeilenlaenge;WHILE trennpos>linkerrandCAND (auszeileSUB trennpos)<>trenner
+REP trennposDECR 1PER ;IF trennpos<=linkerrandTHEN trennpos:=max(zeilenlaenge
+,linkerrand+1);WHILE trennpos<=length(auszeile)CAND (auszeileSUB trennpos)<>
+trennerREP trennposINCR 1PER ;FI .zeileausgebenundkürzen:putlein(
+rechtscompress(text(auszeile,trennpos-1)),FALSE );auszeile:=compress(subtext(
+auszeile,trennpos+1));IF length(auszeile)>0THEN auszeile:=
+textmitfuehrendenblanks(auszeile,linkerrand)FI .ENDPROC putzeile;PROC 
+nextergebnistupel:INT VAR dnr;qsucc(verbund,dnr);tupelbearbeitet:=FALSE ;
+verbund:=gettiefennr(verbund);IF dbstatus=endoffileCAND dbauswertung=
+ordernewstackTHEN auswertungfortsetzen;dbauswertung:=dbstatus;qsucc(verbund,
+dnr);verbund:=gettiefennr(verbund);FI ENDPROC nextergebnistupel;TEXT PROC 
+sonderfunktion(TEXT CONST stcode):TEXT VAR t:=stcode,ausdruck:=stcode;IF (
+ausdruckSUB 1)=linkeklammerTHEN deletechar(ausdruck,1)FI ;IF (ausdruckSUB 
+length(ausdruck))=rechteklammerTHEN deletechar(ausdruck,length(ausdruck))FI ;
+IF ausdruck="tagesdatum"THEN t:=dateELIF ausdruck="tag"THEN t:=day(date(date)
+)ELIF ausdruck="monat"THEN t:=month(date(date))ELIF ausdruck="jahr"THEN t:=
+year(date(date))ELIF ausdruck="zeit"THEN t:=timeofdayELIF ausdruck="tt"THEN t
+:=text(date,2)ELIF ausdruck="mm"THEN t:=subtext(date,4,5)ELIF ausdruck="jj"
+THEN t:=subtext(date,7)FI ;tENDPROC sonderfunktion;TEXT PROC 
+aufbereitetezeile(TEXT CONST zeile,einfuegstellen):TEXT VAR auszeile:="",
+auswert:="",ausdruck:="";INT VAR p:=1,pp,ppalt:=1,ix,laenge;BOOL VAR rbuendig
+,druckvar;pp:=pos(zeile,platzhalter,ppalt);WHILE pp>0REP auszeileCAT subtext(
+zeile,ppalt,pp-1);ix:=decodezahl(einfuegstellen,p);IF ix>0THEN getsteuercode(
+ix,ausdruck,laenge,rbuendig,druckvar);IF druckvarTHEN auswert:=
+ausdruckauswerten(ausdruck);aufbereitenundschreiben;ELSE auswert:=
+sonderfunktion(ausdruck);aufbereitenundschreiben;FI FI ;ppalt:=pp+1;pp:=pos(
+zeile,platzhalter,ppalt);PER ;auszeileCAT subtext(zeile,ppalt);auszeile.
+aufbereitenundschreiben:IF laenge>0THEN IF length(auswert)>=laengeCOR NOT 
+rbuendigTHEN auswert:=text(auswert,laenge)ELSE auswert:=((laenge-length(
+auswert))*" ")+auswertFI ;FI ;auszeileCAT auswert.ENDPROC aufbereitetezeile;
+PROC druckezeile(TEXT CONST zeile,einfuegstellen):putzeile(aufbereitetezeile(
+zeile,einfuegstellen))ENDPROC druckezeile;PROC druckeblock(INT CONST blocknr)
+:INT VAR aktzeile:=1,pb,pz,nextblock,nextblockvorzeile;REP IF aktzeile=1CAND 
+verbund=blocknrTHEN tupelbearbeitet:=TRUE FI ;pb:=1;pz:=1;bestimmeunterblock;
+WHILE aktzeile<=getzeilenanzahl(blocknr)COR aktzeile=nextblockvorzeileREP IF 
+aktzeile=nextblockvorzeileTHEN IF verbund<nextblockCAND tupelbearbeitetTHEN 
+nextergebnistupelFI ;IF verbund=nextblockTHEN druckeblock(nextblock);FI ;
+bestimmeunterblock;ELSE IF NOT (seitenweiseCAND innerhalbkosmetikbereich)
+THEN druckezeile(getzeile(blocknr,aktzeile),geteinfuegstellen(blocknr,
+aktzeile));IF innerhalbkosmetikbereichTHEN zeilenzaehlerDECR 1FI FI ;aktzeile
+INCR 1;FI ;PER ;aktzeile:=1;IF tupelbearbeitetTHEN nextergebnistupel;IF 
+verbund<>blocknrTHEN LEAVE druckeblockFI ELIF verbund<>blocknrTHEN LEAVE 
+druckeblockFI UNTIL blocknr=0PER .innerhalbkosmetikbereich:(blocknr=0)CAND ((
+aktzeile>=code(kosmetikbereichSUB 1)CAND aktzeile<=code(kosmetikbereichSUB 2)
+)COR (aktzeile>=code(kosmetikbereichSUB 3)CAND aktzeile<=code(kosmetikbereich
+SUB 4))).bestimmeunterblock:nextblock:=decodezahl(getunterbloecke(blocknr),pb
+);nextblockvorzeile:=decodezahl(getvorzeilennr(blocknr),pz);.ENDPROC 
+druckeblock;PROC listendruck(INT CONST nr):listendruck(nr,bschirm)ENDPROC 
+listendruck;PROC ausgabedateianlegen:aktuellerdsINCR 1;forget(aktfilename,
+quiet);ausgfile:=sequentialfile(output,aktfilename);putlein(schrifttyp,TRUE )
+;putlein(startanweisung,TRUE );zeilenzaehler:=0.schrifttyp:IF schriftart=""
+THEN ""ELSE "#type ("""+schriftart+""")#"FI .startanweisung:"#start("+text(
+links)+","+text(oben)+")# ".ENDPROC ausgabedateianlegen;PROC 
+headundbottommerken:#block(0)nachheadundbottomuntersuchen#INT VAR aktzeile:=1
+,p;TEXT VAR ausdruck:="",zeile:="";kopfzeilen:=0;fusszeilen:=0;kopfbereich:=
+"";fussbereich:="";kosmetikbereich:="zzzz";WHILE aktzeile<=getzeilenanzahl(0)
+REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;p:=pos(zeile,kzkosmetik);IF p>
+0THEN ausdruckeinlesen;IF ausdruck="head"THEN kopfeinlesenELIF ausdruck=
+"bottom"THEN fusseinlesenFI ;FI ;PER .ausdruckeinlesen:ausdruck:=compress(
+subtext(zeile,p+1,pos(zeile,kzkosmetik,p+1)-1)).bereichsende:p:=pos(zeile,
+kzkosmetik);IF p>0THEN ausdruckeinlesen;pos(";head;bottom;end;",";"+ausdruck+
+";")>0ELSE FALSE FI .kopfeinlesen:replace(kosmetikbereich,1,code(aktzeile-1))
+;REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsendeTHEN replace(
+kosmetikbereich,2,code(aktzeile-1));LEAVE kopfeinlesenELSE kopfzeilenINCR 1;
+zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile-1));kopfbereich
+CAT (zeile+linefeed)FI PER .fusseinlesen:replace(kosmetikbereich,3,code(
+aktzeile-1));REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsende
+THEN replace(kosmetikbereich,4,code(aktzeile-1));LEAVE fusseinlesenELSE 
+fusszeilenINCR 1;zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile-
+1));fussbereichCAT (zeile+linefeed)FI PER .ENDPROC headundbottommerken;PROC 
+listendruck(INT CONST nr,INT CONST medium):REAL VAR limit;INT VAR fontnr:=0;
+getdruckaufbereitung(schriftart,links,oben,anzzeilen,limit);schriftartpruefen
+;zeilenlaenge:=int(limit);#IF seitenweiseTHEN #headundbottommerken;
+aktuelleseite:=1;aktuellerds:=-1;ausgabedateianlegen;IF seitenweiseTHEN 
+schreibekopfFI ;auswertung("QUERY."+text(nr));dbauswertung:=dbstatus;
+restderletztenzeile:="";verbund:=-1;tupelbearbeitet:=TRUE ;druckeblock(0);IF 
+length(restderletztenzeile)>0THEN putzeile("")FI ;IF seitenweiseCAND 
+fusszeilen>0THEN zeilenvorschubundfussdruckenFI ;druckegesamtliste.
+schriftartpruefen:disablestop;fontnr:=font(schriftart);IF iserrorTHEN 
+schriftart:="";clearerror;ELIF fontnr=0THEN schriftart:=font(1)FI ;enablestop
+.druckegesamtliste:BOOL VAR cd:=commanddialogue;INT VAR i;IF seitenweiseCOR 
+schriftart=""THEN druckausgabeausgeben(filename,medium);IF seitenweiseCAND 
+aktuellerds>0CAND medium=druckerTHEN FOR iFROM 1UPTO aktuellerdsREP 
+druckausgabeausgeben(filename,medium);PER FI ELSE sysout("dummy");
+commanddialogue(FALSE );standardmeldung(mldaufb,"");autopageform(filename);
+forget(filename,quiet);sysout("");forget("dummy",quiet);commanddialogue(cd);
+druckausgabeausgeben(filename+".p",medium)FI .ENDPROC listendruck;TEXT PROC 
+namederdruckausgabeohne:filenameENDPROC namederdruckausgabeohne;TEXT PROC 
+namederdruckausgabe:filename+".p"ENDPROC namederdruckausgabe;PROC 
+namederdruckausgabe(TEXT CONST fname):filename:=fnameENDPROC 
+namederdruckausgabe;PROC druckausgabeausgeben(TEXT CONST fname,INT CONST 
+medium):SELECT mediumOF CASE dbschirm:caufanfang;editiere(fname,FALSE );CASE 
+ddrucker:standardmeldung(mlddrucken,"");print(fname);enter(1)OTHERWISE :
+errorstop("Falscher Druck-Code")ENDSELECT ;zurueck.caufanfang:FILE VAR f:=
+sequentialfile(modify,fname);toline(f,1).ENDPROC druckausgabeausgeben;BOOL 
+VAR rueck:=FALSE ;PROC zurueck:rueck:=TRUE ENDPROC zurueck;BOOL PROC 
+ruecksprung:BOOL VAR b:=rueck;rueck:=FALSE ;bENDPROC ruecksprung;LET 
+parametergrenze="%",parametertrennzeichen="#",otherwise="*",niltext="",
+textbegrenzer="""";INT PROC postextende(TEXT CONST ausgabe,INT CONST 
+aktuelleposition):INT VAR neupos:=aktuelleposition+1;WHILE (ausgabeSUB neupos
+)<>textbegrenzerREP neuposINCR 1;IF (ausgabeSUB neupos)=textbegrenzerCAND (
+ausgabeSUB neupos+1)=textbegrenzerTHEN neuposINCR 2;FI ;UNTIL neupos>length(
+ausgabe)PER ;neupos+1ENDPROC postextende;INT PROC postext(TEXT CONST source,
+pattern,INT CONST from):INT VAR p:=from;WHILE (sourceSUB p)<>patternREP 
+nextcharUNTIL p>length(source)PER ;#9.12.87#IF p>length(source)THEN 0ELSE p
+FI .nextchar:IF (sourceSUB p)=textbegrenzerTHEN p:=postextende(source,p)ELSE 
+pINCR 1;#9.12.87#FI .ENDPROC postext;TEXT PROC dbwert(TEXT CONST feldname,
+BOOL VAR textvergleich):LET null="0",nulldatum="01.01.00";TEXT VAR ausgabe:=
+"";INT CONST fnr:=feldnr(compress(feldname));IF fnr>0THEN ausgabe:=wert(fnr);
+IF ((feldtyp(fnr)=intfeld)CAND (ausgabe=null))COR ((feldtyp(fnr)=datumfeld)
+CAND (ausgabe=nulldatum))THEN ausgabe:=""FI ;textvergleich:=NOT (feldtyp(fnr)
+=realfeldCOR feldtyp(fnr)=intfeld)ELSE textvergleich:=TRUE FI ;ausgabeEND 
+PROC dbwert;TEXT PROC auswerten(TEXT CONST eingabe):INT VAR 
+positionlinkeklammer:=1,positionrechteklammer:=1,positionlinkeskreuz,
+positionrechteskreuz,positionmittlereskreuz,positionparametergrenze,
+aktuelleposition:=1,positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR 
+ausdruckvorhanden,caseaufruf,linkeseitevariabel,rechteseitevariabel,
+textvergleich;TEXT VAR puffer,vergleichswert,aktuellessymbol,parameter1,
+ausgabe:=compress(eingabe);REP zeichenketteueberlesen;
+auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN 
+bestimmungdesfeldnamensfuerdieprozedurdbwert;aufrufderprozedurdbwert;IF 
+caseaufrufTHEN bestimmungderrichtigenalternativeFI ;
+einsetzendesfeldwertsoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ;
+ausgabe.zeichenketteueberlesen:INT VAR p:=aktuelleposition;#1#BOOL VAR 
+innerhalbzeichenkette:=TRUE ;IF (ausgabeSUB p)=linkeklammerTHEN pINCR 1;FI ;
+IF aktuelleszeichenisttextbegrenzerTHEN WHILE innerhalbzeichenketteREP REP 
+UNTIL textendeCOR aktuelleszeichenisttextbegrenzerPER ;IF NOT textendeCAND (
+ausgabeSUB p)=textbegrenzerTHEN innerhalbzeichenkette:=TRUE ;pINCR 1ELSE 
+innerhalbzeichenkette:=FALSE ;FI PER ;pDECR 1;aktuelleposition:=p;
+leerzeichenentfernen;FI .aktuelleszeichenisttextbegrenzer:IF (ausgabeSUB p)=
+textbegrenzerTHEN deletechar(ausgabe,p);TRUE ELSE pINCR 1;FALSE FI .textende:
+p>length(ausgabe).leerzeichenentfernen:WHILE (ausgabeSUB p)=" "REP deletechar
+(ausgabe,p)PER .auffindeneinesspitzgeklammertenausdrucks:#aktuelleposition:=0
+;#linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:=
+pos(ausgabe,linkeklammer,aktuelleposition);ausdruckvorhanden:=
+aktuelleposition<>0;positionlinkeklammer:=aktuelleposition.
+bestimmungdesfeldnamensfuerdieprozedurdbwert:
+ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenfeldnamen;IF 
+aktuellessymbol=rechteklammerTHEN caseaufruf:=FALSE ;fuehreleseoperationaus;
+ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ;
+positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus:
+aktuellepositionINCR 1;IF aktuelleposition>length(ausgabe)THEN 
+aktuellessymbol:=rechteklammerELSE aktuellessymbol:=ausgabeSUB 
+aktuelleposition;FI ;IF aktuellessymbol=linkeklammerTHEN 
+anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol=rechteklammerTHEN 
+anzahldergeoeffnetenklammernDECR 1FI .fuehreleseoperationausmittextueberlesen
+:aktuellepositionINCR 1;IF (ausgabeSUB aktuelleposition)=textbegrenzerTHEN 
+aktuelleposition:=postextende(ausgabe,aktuelleposition)FI ;IF 
+aktuelleposition>length(ausgabe)THEN aktuellessymbol:=rechteklammerELSE 
+aktuellessymbol:=ausgabeSUB aktuelleposition;FI ;IF aktuellessymbol=
+linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol=
+rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI .
+ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus;
+linkeseitevariabel:=aktuellessymbol=linkeklammer.bestimmedenfeldnamen:WHILE 
+NOT (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=parametergrenze
+OR aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER ;IF 
+linkeseitevariabelTHEN parameter1:=(subtext(ausgabe,positionlinkeklammer+2,
+aktuelleposition-1))ELSE parameter1:=(subtext(ausgabe,positionlinkeklammer+1,
+aktuelleposition-1))FI .ueberpruefeobrechteseitedoppeltgeklammert:IF 
+aktuellessymbol=rechteklammerTHEN rechteseitevariabel:=TRUE ;
+positionrechteklammer:=aktuellepositionELSE positionrechteklammer:=
+aktuelleposition-1FI .aufrufderprozedurdbwert:puffer:=dbwert(parameter1,
+textvergleich).bestimmungderrichtigenalternative:
+bestimmungdeserstenvergleichswertes;WHILE 
+vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP 
+suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen;
+IF vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinTHEN 
+bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)=
+otherwiseTHEN puffer:=auswerten(subtext(ausgabe,positionotherwise+1,
+positionrechteklammer-1))ELSE bereitstelleneinerleerenalternativeFI .
+bestimmungdeserstenvergleichswertes:positionlinkeskreuz:=
+positionparametergrenze;positionmittlereskreuz:=postext(ausgabe,
+parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe,
+positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen.
+suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz;
+positionmittlereskreuz:=postext(ausgabe,parametertrennzeichen,
+positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1,
+positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen:
+aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP 
+fuehreleseoperationausmittextueberlesenUNTIL (anzahldergeoeffnetenklammern=0
+AND (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR 
+anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition;
+positionotherwise:=aktuelleposition.
+vergleichswertstimmtmitdemergebnisausdemdbwertaufrufueberein:IF textvergleich
+THEN vergleichswert=pufferELSE real(vergleichswert)=real(puffer)FI .
+bereitstellenderentsprechendenalternative:puffer:=auswerten(subtext(ausgabe,
+positionmittlereskreuz+1,positionrechteskreuz-1)).
+bereitstelleneinerleerenalternative:puffer:=niltext.
+vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT 
+vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinAND 
+einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden:
+aktuellessymbol=parametertrennzeichen.
+positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0;
+IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern
+<0AND aktuellessymbol=rechteklammer)REP 
+fuehreleseoperationausmittextueberlesenPER FI ;positionrechteklammer:=
+aktuelleposition.einsetzendesfeldwertsoderderalternative:change(ausgabe,
+positionlinkeklammer,positionrechteklammer,puffer).ENDPROC auswerten;TEXT 
+PROC ausdruckauswerten(TEXT CONST ausdruck):TEXT VAR eingabe:=ausdruck;IF (
+eingabeSUB 1)<>linkeklammerTHEN insertchar(eingabe,linkeklammer,1)FI ;IF (
+eingabeSUB (length(eingabe)))<>rechteklammerTHEN eingabeCAT rechteklammerFI ;
+auswerten(eingabe)ENDPROC ausdruckauswerten;ENDPACKET idadruck;
+
diff --git a/app/schulis/2.2.1/src/6.ida.eingang b/app/schulis/2.2.1/src/6.ida.eingang
new file mode 100644
index 0000000..c4de3f7
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.eingang
@@ -0,0 +1,87 @@
+PACKET idaeingangsbildschirmDEFINES generieredruckausgabe,
+eingangsbildschirmdarstellen#,putdrucktyp,putdruckindex#:LET maskennamelehrer
+="mdr lehrerweise dr eingang",maskennameeinzeln=
+"mdr einzelobjekt druckausgabe eingang";LET maxfeld=8,wartemeldnr=69,
+auswahlnichtkorrekt=188,auswahlnichteind=189,niltext="",mldnrformnichtda=262;
+LET markiert="#";LET lehrer="Lehrer",schueler="Schüler";TEXT VAR 
+leitobjektklasse,scanwertlehrer;INT CONST primindex:=2;#(ROW maxfeldINT :(246
+,255,247,246,246,246,246,0),ROW maxfeldINT :(246,255,247,246,246,246,246,246)
+);#ROW maxfeldINT VAR indicesschueler:=ROW maxfeldINT :(ixsustatfamrufgeb,
+ixsustatjgst,ixsustatjgstzug,ixsustatfamrufgeb,ixsustatfamrufgeb,
+ixsustatfamrufgeb,ixsustatfamrufgeb,ixsustatfamrufgeb);TEXT VAR maskenname:=
+"";INT VAR letztenummerderdruckausgabe:=0;INT VAR druckinx,ankreuzfeld;INT 
+PROC druckindex:druckinxENDPROC druckindex;PROC putdruckindex(INT CONST dinx)
+:druckinx:=dinxENDPROC putdruckindex;PROC eingangsbildschirmdarstellen:TEXT 
+VAR fname:="";INT VAR findex:=0,nochmeld;BOOL VAR ftyp;
+setzelistederdruckausgabengezeigt(FALSE );IF ruecksprungTHEN ohnepruefung
+ELSE mitpruefungFI .mitpruefung:IF listenweiseauswahlkorrektTHEN 
+letztenummerderdruckausgabe:=nummerderdruckausgabe;putdruckindex(
+letztenummerderdruckausgabe);holeformular;namederdruckausgabe(getformularname
+);#standardkopfmaskeaktualisieren(namederdruckausgabe);#maskedarstellen;FI .
+ohnepruefung:putdruckindex(letztenummerderdruckausgabe);holeformular;
+maskedarstellen.holeformular:setzenummerderdruckausgabe(text(
+letztenummerderdruckausgabe));IF formexists(druckinx)THEN getform(druckinx)
+ELSE formunvollstaendigFI ;#openformular(druckinx);bereitsinformularzerlegen!
+#formularzerlegen(druckinx);IF getblockanzahl<1THEN formunvollstaendigFI ;
+getformularinfo(fname,findex,ftyp);systemdboff.formunvollstaendig:
+standardmeldung(mldnrformnichtda,niltext);return(1);LEAVE 
+eingangsbildschirmdarstellen.listenweiseauswahlkorrekt:
+idaankreuzfelderpruefen.maskedarstellen:leitobjektklasse:=getobjektklasse(1);
+IF leitobjektklasse=schuelerTHEN maskenname:=maskennameeinzelnELIF 
+leitobjektklasse=lehrerTHEN maskenname:=maskennamelehrerFI ;standardstartproc
+(maskenname);standardkopfmaskeaktualisieren(namederdruckausgabeohne);nochmeld
+:=nochmeldungauszugeben;IF nochmeld<>0THEN TEXT VAR drinx:=text(druckindex)+
+markiert;standardmeldung(nochmeld,drinx)FI ;standardnproc.END PROC 
+eingangsbildschirmdarstellen;PROC generieredruckausgabe(INT CONST medium):
+INT VAR leitinx;generieredruck.generieredruck:IF leitobjektklasse=schueler
+THEN leitinx:=leitindexschueler;ueberpruefeleitinx;putleitindex(
+leitindexschueler);ELSE leitinx:=leitindexlehrer;ueberpruefeleitinx;
+putleitindex(leitindexlehrer)FI ;putobjektklasse(1,leitobjektklasse);IF 
+leitobjektklasse=schuelerTHEN putscan(erzeugescan)ELSE putscan(scanwertlehrer
+)FI ;erzeugequery(druckindex);standardmeldung(wartemeldnr,niltext);
+listendruck(druckindex,medium).ueberpruefeleitinx:IF leitinx<=0THEN #return(1
+);#LEAVE generieredruckausgabeFI ;ENDPROC generieredruckausgabe;INT PROC 
+leitindexschueler:INT VAR wievielter;INT VAR i,leitinx,offset:=1;ankreuzfeld
+:=0;pruefeeindeutigkeit;bestimmeindex;bestimmewievielterindex.
+pruefeeindeutigkeit:FOR iFROM 2UPTO maxfeld+offsetREP IF standardmaskenfeld(i
+)<>""THEN IF ankreuzfeld>0THEN #note("Feld : "+text(i)+" Inhalt : "+
+standardmaskenfeld(i));noteline;note("Ankreuzfeld : "+text(ankreuzfeld));
+noteline;#standardmeldung(auswahlnichteind,niltext);return(1);LEAVE 
+leitindexschuelerWITH (-1)ELSE ankreuzfeld:=iFI FI PER ;IF ankreuzfeld<=0
+THEN #note("Feld : "+text(i)+" Inhalt : "+standardmaskenfeld(i));noteline;
+note("Ankreuzfeld : "+text(ankreuzfeld));noteline;#standardmeldung(
+auswahlnichtkorrekt,niltext);return(1);LEAVE leitindexschuelerWITH (-2)FI .
+bestimmeindex:leitinx:=indicesschueler[ankreuzfeld-1];.
+bestimmewievielterindex:wievielter:=0;FOR iFROM firstindexUPTO firstfree-1
+REP IF dateinr(primdatid(i))=primindexTHEN wievielterINCR 1;IF i=leitinxTHEN 
+LEAVE leitindexschuelerWITH wievielterFI FI PER ;0ENDPROC leitindexschueler;
+INT PROC leitindexlehrer:INT VAR status,leitinx;scanwertlehrer:="";
+standardpruefe(5,2,4,0,"",status);IF status<>0THEN standardmeldung(
+auswahlnichtkorrekt,niltext);return(1);leitinx:=-1;ELSE IF standardmaskenfeld
+(5)=""THEN IF standardmaskenfeld(2)<>""THEN leitinx:=dnrlehrerELIF 
+standardmaskenfeld(3)<>""THEN leitinx:=ixlfamrufELIF standardmaskenfeld(4)<>
+""THEN infeld(5);standardmeldung(auswahlnichteind,niltext);return(1);leitinx
+:=-1FI ;ELSE IF standardmaskenfeld(4)<>""THEN leitinx:=dnrlehrer;
+scanwertlehrer:="<""";scanwertlehrerCAT standardmaskenfeld(5);scanwertlehrer
+CAT """>";ELSE standardmeldung(auswahlnichtkorrekt,niltext);return(1);leitinx
+:=-1;FI ;FI ;FI ;leitinxEND PROC leitindexlehrer;TEXT PROC erzeugescan:INT 
+VAR i,evteinzel:=0;evteinzel:=1;scanfuereinzel.scanfuereinzel:SELECT 
+ankreuzfeldOF CASE 2:"<""ls"">"CASE 3:statusjgstCASE 4:statusjgstzugCASE 5:
+"<""ls"">"+evtschuelerCASE 6:"<""n05"">"+evtschuelerCASE 7:"<""n11"">"+
+evtschuelerCASE 8:"<""nso"">"+evtschuelerCASE 9:"<""abg"">"+evtschueler
+OTHERWISE :""ENDSELECT .evtschueler:scantxt:="";FOR iFROM 12UPTO 14REP IF 
+standardmaskenfeld(i)<>""THEN scantxt:=scantxt+";"+"<"""+evtdatum+""">"ELSE 
+LEAVE evtschuelerWITH scantxtFI PER ;scantxt.evtdatum:IF i=14THEN 
+datumskonversion(standardmaskenfeld(i))ELSE standardmaskenfeld(i)FI .
+statusjgst:IF standardmaskenfeld(9+evteinzel)<>""THEN "<""ls"">;<"""+
+jgstaufber(standardmaskenfeld(9+evteinzel))+""">"ELSE "<""ls"">"FI .
+statusjgstzug:TEXT VAR scantxt:="";IF standardmaskenfeld(9+evteinzel)<>""
+THEN scantxt:="<""ls"">;<"""+jgstaufber(standardmaskenfeld(9+evteinzel))+
+""">";IF standardmaskenfeld(10+evteinzel)<>""THEN scantxt:=scantxt+";<"""+
+standardmaskenfeld(10+evteinzel)+""">"FI ;scantxtELSE "<""ls"">"FI .ENDPROC 
+erzeugescan;INT PROC nummerderdruckausgabe:TEXT VAR t;INT VAR i,lv;FOR lv
+FROM 1UPTO 10REP IF standardmaskenfeld(lv*2#+1#)<>""THEN nummerermittelnFI 
+PER ;0.nummerermitteln:t:=standardmaskenfeld(lv*2+1);t:=subtext(t,1,pos(t,
+" = ")-1);i:=int(t);LEAVE nummerderdruckausgabeWITH i.END PROC 
+nummerderdruckausgabe;ENDPACKET idaeingangsbildschirm;
+
diff --git a/app/schulis/2.2.1/src/6.ida.gen b/app/schulis/2.2.1/src/6.ida.gen
new file mode 100644
index 0000000..c4d4eeb
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.gen
@@ -0,0 +1,79 @@
+PACKET idagenDEFINES formularzerlegen,erzeugequery:LET platzhalter="�",
+okkenner="k",linkeklammer="<",rechteklammer=">";FILE VAR formtext;TEXT VAR 
+zeile:="",blockstruktur:="";INT VAR lastblock:=0;TEXT PROC blockcode(INT 
+CONST objklasse,regel):"!"+text(objklasse)+"."+text(regel)+"!"ENDPROC 
+blockcode;BOOL PROC blockende(INT CONST objklasse,regel):pos(blockstruktur,
+blockcode(objklasse,regel))>0ENDPROC blockende;PROC blockmerken(INT CONST 
+objklasse,regel):blockstrukturCAT blockcode(objklasse,regel)ENDPROC 
+blockmerken;PROC unterblockeintragen(INT CONST blocknr,unterblock):TEXT VAR 
+ub:=getunterbloecke(blocknr),vz:=getvorzeilennr(blocknr);INT VAR zeilennr:=
+getzeilenanzahl(blocknr);ubCAT text(unterblock)+";";vzCAT text(zeilennr+1)+
+";";putunterbloecke(blocknr,ub);putvorzeilennr(blocknr,vz);ENDPROC 
+unterblockeintragen;PROC inaktuellenblockuebernehmen(TEXT CONST zeile,INT 
+CONST blocknr):TEXT VAR textzeile:=zeile,einfuegstellen:="";INT VAR zeilennr
+:=getzeilenanzahl(blocknr)+1,vonp,bisp,stcodenr;druckvariablenersetzen;
+putzeilenanzahl(blocknr,zeilennr);putzeile(blocknr,zeilennr,textzeile);
+puteinfuegstellen(blocknr,zeilennr,einfuegstellen);.druckvariablenersetzen:
+vonp:=pos(textzeile,linkeklammer);WHILE vonp>0REP bisp:=pos(textzeile,
+rechteklammer,vonp+1);IF bisp=0THEN bisp:=length(textzeile)FI ;stcodenr:=int(
+subtext(textzeile,vonp+1,bisp-1));einfuegstellenCAT text(stcodenr)+";";change
+(textzeile,vonp,bisp,platzhalter);vonp:=pos(textzeile,linkeklammer);PER .
+ENDPROC inaktuellenblockuebernehmen;PROC bearbeiteblock(INT CONST b):INT 
+CONST blocknr:=b;INT VAR p,bis,objklasse,regel;BOOL VAR eoformtext:=FALSE ;
+putzeilenanzahl(blocknr,0);putunterbloecke(blocknr,"");putvorzeilennr(blocknr
+,"");WHILE NOT eoformtextREP IF zugriffsregelgefundenTHEN okundregelbestimmen
+;IF blockende(objklasse,regel)THEN LEAVE bearbeiteblockELSE blockmerken(
+objklasse,regel);IF compress(zeile)=""CAND NOT eof(formtext)THEN getline(
+formtext,zeile);FI ;lastblockINCR 1;unterblockeintragen(blocknr,lastblock);
+putblockregelnummer(lastblock,getregelnummer(objklasse,regel));bearbeiteblock
+(lastblock)FI ;ELSE inaktuellenblockuebernehmen(zeile,blocknr)FI ;IF eof(
+formtext)THEN eoformtext:=TRUE ELSE getline(formtext,zeile);FI ;PER ;.
+zugriffsregelgefunden:p:=pos(zeile,linkeklammer+okkenner);p>0.
+okundregelbestimmen:bis:=p+2;objklasse:=int(zeileSUB bis);bisINCR 1;IF 
+istziffer(zeileSUB bis)THEN objklasse:=objklasse*10+int(zeileSUB bis);bis
+INCR 1;FI ;IF (zeileSUB bis)=rechteklammerTHEN regel:=1ELSE regel:=int(zeile
+SUB bis+1);bisINCR 2;IF istziffer(zeileSUB bis)THEN regel:=regel*10+int(zeile
+SUB bis);bisINCR 1;FI ;FI ;change(zeile,p,bis,"").ENDPROC bearbeiteblock;
+PROC formularzerlegen(INT CONST nr):openformular(nr);lastblock:=0;
+blockstruktur:="";zeile:="";formtext:=sequentialfile(input,getformtextname);
+IF NOT eof(formtext)THEN getline(formtext,zeile)FI ;IF eof(formtext)CAND 
+zeile=""THEN putzeilenanzahl(0,0);putunterbloecke(0,"");putvorzeilennr(0,"");
+ELSE bearbeiteblock(0)FI ENDPROC formularzerlegen;BOOL PROC istziffer(TEXT 
+CONST t):pos("0123456789",t)>0END PROC istziffer;LET textbegrenzer="""",
+klammerauf=" ( ",klammerzu=" ).",trenner=" / ",refinementname="verbund";FILE 
+VAR queryfile;TEXT PROC alstext(TEXT CONST t):textbegrenzer+t+textbegrenzer
+ENDPROC alstext;TEXT PROC bestimmeindexname(TEXT CONST dateiname,INT CONST nr
+):TEXT VAR n:=alstext(dateiname);INT VAR i,treffer:=0;IF nr>0CAND firstindex>
+0THEN FOR iFROM firstindexUPTO firstfree-1REP IF name(dateinr(primdatid(i)))=
+dateinameTHEN trefferINCR 1FI ;IF treffer=nrTHEN n:=n+" BY "+alstext(name(i))
+;FI UNTIL treffer=nrPER FI ;nENDPROC bestimmeindexname;TEXT PROC 
+bestimmeverbunde(INT CONST blocknr):TEXT VAR v:="";INT VAR nr,p:=1;REP nr:=
+decodezahl(getunterbloecke(blocknr),p);IF nr>0THEN IF v=""THEN vCAT 
+refinementname+text(nr)ELSE vCAT ";"+refinementname+text(nr)FI FI UNTIL nr=0
+PER ;vENDPROC bestimmeverbunde;TEXT PROC bestimmescanbedingung(INT CONST 
+regel,anzkeyfelder):TEXT VAR scan:="",vgl:="";INT VAR f;FOR fFROM 1UPTO 
+anzkeyfelderREP vgl:=getvergleichswert(regel,f);vergleichswertcodieren;IF 
+scan=""THEN scanCAT vglELSE scanCAT ";"+vglFI PER ;scan.
+vergleichswertcodieren:IF konstanteTHEN vgl:=linkeklammer+vgl+rechteklammer
+ELSE vgl:=textbegrenzer+vgl+textbegrenzerFI .konstante:(vglSUB 1)=
+textbegrenzer.ENDPROC bestimmescanbedingung;PROC verbund(INT CONST blocknr):
+TEXT VAR string:="";INT CONST regelnr:=getblockregelnummer(blocknr);INT VAR k
+,r,index,anzfelder;IF regelnr>0THEN getzugriffsregel(regelnr,k,r,index,
+anzfelder)FI ;line(queryfile);putline(queryfile,refinementname+text(blocknr)+
+":");IF regelnr>0THEN string:=bestimmeindexname(getobjektklasse(k),index);
+stringCAT klammerauf;stringCAT bestimmescanbedingung(regelnr,anzfelder);
+stringCAT trenner;stringCAT trenner;stringCAT trenner;stringCAT 
+bestimmeverbunde(blocknr);stringCAT klammerzu;putline(queryfile,string)ELSE 
+putline(queryfile,".")FI ENDPROC verbund;PROC erzeugequery(INT CONST nr):INT 
+VAR b;TEXT VAR string:="";forget(queryfilename,quiet);queryfile:=
+sequentialfile(output,queryfilename);FOR bFROM 1UPTO getblockanzahlREP IF b=1
+THEN initqueryELSE verbund(b)FI PER ;.queryfilename:"QUERY."+text(nr).
+initquery:string:=bestimmeindexname(getobjektklasse(1),getleitindex);string
+CAT klammerauf;stringCAT getscan;stringCAT trenner;stringCAT trenner;putline(
+queryfile,string);string:="";IF getselektion>""THEN stringCAT "selektion"FI ;
+stringCAT trenner;putline(queryfile,string);string:="";stringCAT 
+bestimmeverbunde(1);stringCAT klammerzu;putline(queryfile,string);IF 
+getselektion>""THEN line(queryfile);string:="selektion: ";stringCAT 
+getselektion;stringCAT ".";putline(queryfile,string);FI .ENDPROC erzeugequery
+;ENDPACKET idagen
+
diff --git a/app/schulis/2.2.1/src/6.ida.grund b/app/schulis/2.2.1/src/6.ida.grund
new file mode 100644
index 0000000..b298b95
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.grund
@@ -0,0 +1,182 @@
+PACKET ispidagrundfunktionenDEFINES selektionenindateieintragen,
+zugriffsregelnindateieintragen,druckausgabenlistezeigen,regellistezeigen,
+variablenlistezeigen,behandlungderausgesuchten,inlisteblaettern,
+maskenwertesichern,nummerderdruckausgabesetzen,nureinedruckausgabeangekreuzt,
+rueckschrittevorproc,rueckschrittenachproc,sichernundhilfsfilesloeschen,
+hilfsfilesloeschen,erfassungdruckausgabe,init,put,
+setzedruckausgabelistenauswahl,druckausgabelistenauswahl,
+setzelistederdruckausgabengezeigt,listederdruckausgabengezeigt,
+setzeaktuellemaske,aktuellemaske:LET filenamezug="Hilfsdatei.Zugriff",
+filenamesel="Hilfsdatei.Selektion",filenamedruck="Hilfsdatei.Druck",
+filenamedliste="Druckausgaben",filenamezliste="Zugriffe",filenamevliste=
+"Variablen";LET meldunglistenerstellung=7,meldungletzterwert=67,
+meldungkeineliste=68,meldungkeinblaettern=72,meldungkeinezugriffe=200,
+meldungkeinevariablen=201;LET maxselektionen=17,maxzugriffe=16,zeileninliste=
+18,ausgabelaenge=71,maxvariablen=100;LET zugriffsregeln=4,druckvariablen=7;
+LET serstervergleich=3,zobjkl=2,zregnr=3,zerstervergleich=7,lt=3,dnummer=2,
+vnummer=2;LET vergleichtrenner="</>",trenner=" = ",oblitrenner="$",blank=" ",
+kleinr="r",kleink="k",niltext="";LET andenanfang=1,andasende=2,vorwaerts=3,
+rueckwaerts=4;BOOL VAR listenauswahl,listegezeigt;BOOL VAR dvrrechts,
+dvrdruckvar,listeeinmalgezeigt:=FALSE ;INT VAR lvi,lvf,posi,zeilennr,
+dvrlaenge,zobjekt,zregel,zindex,zanzahl,startzeile,zeilenindatei,schritte;
+FILE VAR f,g;TAG VAR aktmaske;TEXT VAR zeile,dvrname,wert1,wert2,datname;
+PROC selektionenindateieintragen(INT CONST leseanfangindatei,ROW 100TEXT 
+CONST erfassungsfeld):f:=sequentialfile(modify,filenamesel);zeilennr:=
+leseanfangindatei;lvi:=serstervergleich;FOR lvfFROM leseanfangindateiUPTO 
+leseanfangindatei+maxselektionen-1REP IF zeilennr<=lines(f)THEN 
+vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf);
+readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:=
+subtext(zeile,1,posi-1)FI ;zeileCAT vergleichtrenner;zeileCAT erfassungsfeld[
+lvi];writerecord(f,zeile);lviINCR 2;zeilennrINCR 1;.END PROC 
+selektionenindateieintragen;PROC zugriffsregelnindateieintragen(INT CONST 
+leseanfangindatei,ROW 100TEXT CONST erfassungsfeld):f:=sequentialfile(modify,
+filenamezug);zeilennr:=leseanfangindatei;lvi:=zerstervergleich;FOR lvfFROM 
+leseanfangindateiUPTO leseanfangindatei+maxzugriffe-1REP IF zeilennr<=lines(f
+)THEN vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf)
+;readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:=
+subtext(zeile,1,posi-1);FI ;IF erfassungsfeld[lvi]<>niltextTHEN zeileCAT 
+vergleichtrenner;zeileCAT erfassungsfeld[lvi];FI ;writerecord(f,zeile);lvi
+INCR 3;zeilennrINCR 1;.END PROC zugriffsregelnindateieintragen;PROC 
+druckausgabenlistezeigen:forget(filenamedliste,quiet);datname:=filenamedliste
+;f:=sequentialfile(output,datname);first(dnrida);WHILE dbstatus=okREP 
+zeilezusammensetzen;putline(f,text(zeile,ausgabelaenge));succ(dnrida)PER ;
+startzeiledruckausgabenlistebestimmen(datname);IF startzeile=0THEN 
+meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE 
+setzelistederdruckausgabengezeigt(TRUE );listeeinmalgezeigt:=TRUE ;
+listezeigen(datname)FI .zeilezusammensetzen:zeile:=wert(fnridanummer)+trenner
++wert(fnridaname);.END PROC druckausgabenlistezeigen;PROC 
+startzeiledruckausgabenlistebestimmen(TEXT VAR fname):INT VAR lv;f:=
+sequentialfile(modify,fname);FOR lvFROM 1UPTO lines(f)REP toline(f,lv);
+readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile,trenner)-1))>=int(
+standardmaskenfeld(dnummer))THEN startzeile:=lv;LEAVE 
+startzeiledruckausgabenlistebestimmenFI PER ;startzeile:=0END PROC 
+startzeiledruckausgabenlistebestimmen;PROC regellistezeigen:forget(
+filenamezliste,quiet);datname:=filenamezliste;f:=sequentialfile(output,
+datname);IF getanzahlregeln=0THEN meldeauffaellig(aktuellemaske,
+meldungkeinezugriffe);return(1)ELSE meldeauffaellig(aktuellemaske,
+meldunglistenerstellung);listeeinmalgezeigt:=FALSE ;
+listederregelnzusammenstellen;startzeileregellistebestimmen(datname);IF 
+startzeile=0THEN meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)
+ELSE setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI ;END 
+PROC regellistezeigen;PROC listederregelnzusammenstellen:FOR lvfFROM 1UPTO 
+getanzahlregelnREP getzugriffsregel(lvf,zobjekt,zregel,zindex,zanzahl);zeile
+:=kleink+text(zobjekt)+kleinr+text(zregel);putline(f,text(zeile,ausgabelaenge
+))PER END PROC listederregelnzusammenstellen;PROC 
+startzeileregellistebestimmen(TEXT VAR fname):INT VAR lv,lvi,anzahl;f:=
+sequentialfile(modify,fname);regelnsortieren;anzahl:=lines(f);FOR lvFROM 1
+UPTO anzahlREP toline(f,lv);readrecord(f,zeile);IF objektindatei=
+objektinmaskeTHEN lvi:=lv;WHILE regelindatei<regelinmaskeREP 
+pruefenobdateiendesonstnaechstenlesenUNTIL objektindatei>objektinmaskePER ;
+startzeile:=lvi;LEAVE startzeileregellistebestimmenFI ;IF objektindatei>
+objektinmaskeTHEN startzeile:=lv;LEAVE startzeileregellistebestimmenFI PER ;
+startzeile:=0.objektindatei:int(subtext(zeile,2,pos(zeile,kleinr)-1)).
+objektinmaske:int(standardmaskenfeld(zobjkl)).regelindatei:int(subtext(zeile,
+pos(zeile,kleinr)+1)).regelinmaske:int(standardmaskenfeld(zregnr)).
+pruefenobdateiendesonstnaechstenlesen:IF lvi=anzahlTHEN startzeile:=0;LEAVE 
+startzeileregellistebestimmenELSE lviINCR 1;toline(f,lvi);readrecord(f,zeile)
+;FI .END PROC startzeileregellistebestimmen;PROC variablenlistezeigen:forget(
+filenamevliste,quiet);datname:=filenamevliste;f:=sequentialfile(output,
+datname);FOR lvfFROM 1UPTO maxvariablenREP getsteuercode(lvf,dvrname,
+dvrlaenge,dvrrechts,dvrdruckvar);IF dvrname<>niltextTHEN 
+listedervariablenzusammenstellen;FI PER ;IF lines(f)=0THEN meldeauffaellig(
+aktuellemaske,meldungkeinevariablen);return(1)ELSE meldeauffaellig(
+aktuellemaske,meldunglistenerstellung);listeeinmalgezeigt:=FALSE ;
+startzeilevariablenlistebestimmen(datname);IF startzeile=0THEN 
+meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE 
+setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI END PROC 
+variablenlistezeigen;PROC listedervariablenzusammenstellen:zeile:=text(lvf);
+zeileCAT trenner;zeileCAT dvrname;putline(f,text(zeile,ausgabelaenge))END 
+PROC listedervariablenzusammenstellen;PROC startzeilevariablenlistebestimmen(
+TEXT VAR fname):INT VAR lv;f:=sequentialfile(modify,fname);FOR lvFROM 1UPTO 
+lines(f)REP toline(f,lv);readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile
+,trenner)-1))>=int(standardmaskenfeld(vnummer))THEN startzeile:=lv;LEAVE 
+startzeilevariablenlistebestimmenFI PER ;startzeile:=0END PROC 
+startzeilevariablenlistebestimmen;PROC listezeigen(TEXT CONST dateiname):LET 
+listenmaskenname="mu objektliste";initobli;initmaske(aktmaske,
+listenmaskenname);standardstartproc(listenmaskenname);f:=sequentialfile(
+modify,dateiname);zeilenindatei:=lines(f);seitezeigenEND PROC listezeigen;
+PROC inlisteblaettern(INT CONST wohin):SELECT wohinOF CASE andenanfang:
+andendateianfangCASE andasende:andasdateiendeCASE vorwaerts:
+vorwaertsblaetternindateiCASE rueckwaerts:rueckwaertsblaetternindateiEND 
+SELECT ;.andendateianfang:IF startzeile<>1THEN startzeile:=1;seitezeigenELSE 
+zurueck;FI .andasdateiende:IF startzeile<zeilenindatei-zeileninliste+1THEN 
+startzeile:=zeilenindatei-zeileninliste+1;seitezeigenELSE zurueck;FI .
+vorwaertsblaetternindatei:IF startzeile<zeilenindatei-zeileninliste+1THEN 
+startzeileINCR zeileninliste;seitezeigenELSE zurueck;FI .
+rueckwaertsblaetternindatei:IF startzeile>zeileninlisteTHEN startzeileDECR 
+zeileninliste;seitezeigenELSE andendateianfangFI .END PROC inlisteblaettern;
+PROC seitezeigen:FOR lvfFROM 1UPTO zeileninlisteREP IF startzeile+lvf-1<=
+zeilenindateiTHEN toline(f,startzeile+lvf-1);readrecord(f,zeile);posi:=pos(
+zeile,vergleichtrenner);IF posi>0THEN standardmaskenfeld(subtext(zeile,1,posi
+-1),lvf*2+1);standardmaskenfeld(subtext(zeile,posi+lt),lvf*2);ELSE 
+standardmaskenfeld(zeile,lvf*2+1);standardmaskenfeld(niltext,lvf*2);FI ;
+feldfrei(lvf*2)ELSE standardmaskenfeld(text(niltext,ausgabelaenge),lvf*2+1);
+standardmaskenfeld(niltext,lvf*2);feldschutz(lvf*2)FI PER ;END PROC 
+seitezeigen;PROC maskenwertesichern:FOR lvfFROM 1UPTO zeileninlisteREP IF 
+standardmaskenfeld(lvf*2+1)<>ausgabelaenge*blankTHEN zeile:=
+standardmaskenfeld(lvf*2+1);zeileCAT vergleichtrenner;zeileCAT 
+standardmaskenfeld(lvf*2);toline(f,startzeile+lvf-1);writerecord(f,zeile)FI 
+PER END PROC maskenwertesichern;PROC behandlungderausgesuchten(PROC (INT 
+CONST )wastun,ROW 100TEXT VAR feld,INT CONST womit):BOOL VAR ok:=FALSE ;init(
+feld);wertholen(womit,ok);IF okTHEN feldervorbelegen;wastun(womit);ELSE 
+meldeauffaellig(aktuellemaske,meldungletzterwert);zurueck;
+setzedruckausgabelistenauswahl(FALSE );forget(datname,quiet);
+listeeinmalgezeigt:=FALSE ;enter(2)#rueckschrittevorproc(2)dr01.08.88#FI .
+feldervorbelegen:SELECT womitOF CASE zugriffsregeln:feld[zobjkl]:=wert1;feld[
+zregnr]:=wert2;CASE druckvariablen:feld[vnummer]:=wert1END SELECT .END PROC 
+behandlungderausgesuchten;PROC wertholen(INT CONST wozu,BOOL VAR nochda):g:=
+sequentialfile(modify,datname);#dr01.08.88#nochda:=lines(g)>0;IF NOT nochda
+THEN LEAVE wertholenELSE toline(g,1);WHILE lines(g)>0REP readrecord(g,zeile);
+posi:=pos(zeile,vergleichtrenner);deleterecord(g);UNTIL posi>0CAND subtext(
+zeile,posi+lt)<>niltextPER ;IF lines(g)>0THEN werteermittelnELIF posi>0CAND 
+subtext(zeile,posi+lt)<>niltextTHEN werteermittelnELSE nochda:=FALSE FI FI .
+werteermitteln:SELECT wozuOF CASE zugriffsregeln:objektundregelermittelnCASE 
+druckvariablen:variablennummerermittelnEND SELECT .objektundregelermitteln:
+wert1:=subtext(zeile,pos(zeile,kleink)+1,pos(zeile,kleinr)-1);wert2:=subtext(
+zeile,pos(zeile,kleinr)+1,pos(zeile,blank)-1).variablennummerermitteln:wert1
+:=subtext(zeile,1,pos(zeile,trenner)-1);wert2:=niltext.END PROC wertholen;
+PROC rueckschrittevorproc(INT CONST wieviele):BOOL VAR b:=TRUE ;schritte:=
+wieviele;WHILE bREP IF listeeinmalgezeigtTHEN schritteINCR 1;b:=FALSE ELSE #
+dr01.08.88#b:=listederdruckausgabengezeigt;listeeinmalgezeigt:=TRUE FI PER ;
+listeeinmalgezeigt:=listederdruckausgabengezeigt;enter(schritte)END PROC 
+rueckschrittevorproc;PROC rueckschrittenachproc(INT CONST wieviele):return(
+wieviele);END PROC rueckschrittenachproc;PROC nummerderdruckausgabesetzen(
+TEXT VAR nr):FOR lvfFROM 1UPTO lines(f)REP toline(f,lvf);readrecord(f,zeile);
+posi:=pos(zeile,vergleichtrenner);IF posi>0CAND subtext(zeile,posi+lt)<>
+niltextTHEN nr:=subtext(zeile,1,pos(zeile," = ")-1);LEAVE 
+nummerderdruckausgabesetzenFI ;PER END PROC nummerderdruckausgabesetzen;BOOL 
+PROC nureinedruckausgabeangekreuzt:BOOL VAR angekreuzt:=FALSE ;f:=
+sequentialfile(modify,filenamedliste);FOR lvfFROM 1UPTO lines(f)REP toline(f,
+lvf);readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0CAND 
+subtext(zeile,posi+lt)<>niltextTHEN IF angekreuztTHEN LEAVE 
+nureinedruckausgabeangekreuztWITH FALSE ELSE angekreuzt:=TRUE FI FI PER ;
+angekreuztEND PROC nureinedruckausgabeangekreuzt;PROC 
+sichernundhilfsfilesloeschen:putform;hilfsfilesloeschenEND PROC 
+sichernundhilfsfilesloeschen;PROC hilfsfilesloeschen:forget(filenamezug,quiet
+);forget(filenamesel,quiet);forget(filenamedruck,quiet);forget(filenamedliste
+,quiet)END PROC hilfsfilesloeschen;PROC erfassungdruckausgabe(INT CONST n):
+LET trenner=" = ";LET laengezeile=71;TEXT VAR identizeile;identizeile:=wert(
+fnridanummer)+trenner+wert(fnridaname);identizeile:=text(identizeile,
+laengezeile);setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+oblitrenner+wert(fnridanummer).
+END PROC erfassungdruckausgabe;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR 
+iFROM 1UPTO 100REP feld(i):=""PER END PROC init;PROC put(TAG CONST maske,ROW 
+100TEXT CONST feld,INT CONST letztesfeld):INT VAR lv;FOR lvFROM 2UPTO 
+letztesfeldREP IF fieldexists(maske,lv)THEN put(maske,feld[lv],lv)FI PER END 
+PROC put;PROC setzeaktuellemaske(TAG CONST welchemaske):aktmaske:=welchemaske
+END PROC setzeaktuellemaske;TAG PROC aktuellemaske:aktmaskeEND PROC 
+aktuellemaske;PROC setzedruckausgabelistenauswahl(BOOL CONST b):listenauswahl
+:=bEND PROC setzedruckausgabelistenauswahl;BOOL PROC 
+listederdruckausgabengezeigt:listegezeigtEND PROC 
+listederdruckausgabengezeigt;PROC setzelistederdruckausgabengezeigt(BOOL 
+CONST b):listegezeigt:=bEND PROC setzelistederdruckausgabengezeigt;BOOL PROC 
+druckausgabelistenauswahl:listenauswahlEND PROC druckausgabelistenauswahl;
+PROC regelnsortieren:INT VAR lv,anzahl;anzahl:=lines(f);blanksentfernen;sort(
+filenamezliste);moeglicherweisenachsortieren.blanksentfernen:FOR lvFROM 1
+UPTO anzahlREP toline(f,lv);readrecord(f,zeile);changeall(zeile," ","");
+writerecord(f,text(zeile,ausgabelaenge))PER .moeglicherweisenachsortieren:
+FOR lvFROM 1UPTO anzahlREP toline(f,1);readrecord(f,zeile);IF subtext(zeile,2
+,2)="1"THEN deleterecord(f);toline(f,anzahl);insertrecord(f);writerecord(f,
+text(zeile,ausgabelaenge))ELSE LEAVE regelnsortierenFI PER .END PROC 
+regelnsortieren;END PACKET ispidagrundfunktionen;
+
diff --git a/app/schulis/2.2.1/src/6.ida.plausi b/app/schulis/2.2.1/src/6.ida.plausi
new file mode 100644
index 0000000..b25272d
--- /dev/null
+++ b/app/schulis/2.2.1/src/6.ida.plausi
@@ -0,0 +1,114 @@
+PACKET ispidaplausiDEFINES nameundtypok,selektionswerteok,zugriffsregelnok,
+meldefehlernameundtyp,nummerinrichtigengrenzen,nummernummerisch,checktyp:LET 
+filenamesel="Hilfsdatei.Selektion",filenamezug="Hilfsdatei.Zugriff",
+filenamedata="FORMDATA.",filenameform="FORMTEXT.";LET meldungalternative=56,
+meldungungueltigeangaben=204,meldungdgibtesschon=205,meldungfalschenummer=207
+,meldungnamezulang=216,meldungnichterstezeile=252,meldungkeingeschlindex=253,
+meldungkeinfeldname=254,meldungkeinanfuehrzeichen=255,meldungfalscherfeldtypn
+=256,meldungfalscherfeldtypw=257,meldungletzterkeinvgl=258,
+meldungfalschervergleich=259,meldungfalscheroperator=260,
+meldungfalscheverkettung=261;LET ntnummer=2,ntname=3,ntliste=4,nteinzel=5;
+LET vergleichtrenner="</>",namentrenner="<#>",zeilennrtrenner="<!>",
+anzahltrenner="<?>",gueltigeziffern="0123456789",anfuehrung="""",niltext="";
+LET namenlaenge=46,kleinstedruckausgabe=1,groesstedruckausgabe=100,tl=3;LET 
+anzzeilenregeln=16,anzzeilenselektionen=17;FILE VAR f;INT VAR 
+fehlermldnametyp:=0;INT VAR zeilennr;TEXT VAR zeile,pattern;BOOL PROC 
+nameundtypok(ROW 100TEXT CONST feld,INT VAR fnr):IF 
+nummerderdruckausgabegeaendertTHEN ausstiegbeifalschernummer;
+ausstiegfallsschonvorhandenFI ;ausstiegbeizulangemnamen;TRUE .
+nummerderdruckausgabegeaendert:getactivformular<>int(feld[ntnummer]).
+ausstiegbeifalschernummer:IF NOT nummerinrichtigengrenzen(feld[ntnummer])
+THEN fehlermldnametyp:=meldungfalschenummer;fnr:=ntnummer;LEAVE nameundtypok
+WITH FALSE FI .ausstiegfallsschonvorhanden:IF formexists(int(feld[ntnummer]))
+THEN fehlermldnametyp:=meldungdgibtesschon;fnr:=ntnummer;LEAVE nameundtypok
+WITH FALSE ELSE rename(filenamedata+text(getactivformular),filenamedata+feld[
+ntnummer]);rename(filenameform+text(getactivformular),filenameform+feld[
+ntnummer]);delform(getactivformular);openformular(int(feld[ntnummer]))FI .
+ausstiegbeizulangemnamen:IF length(feld[ntname])>namenlaengeTHEN 
+fehlermldnametyp:=meldungnamezulang;fnr:=ntname;LEAVE nameundtypokWITH FALSE 
+FI .END PROC nameundtypok;BOOL PROC nummerinrichtigengrenzen(TEXT CONST nr):
+nummernummerisch(nr)CAND int(nr)>=kleinstedruckausgabeCAND int(nr)<=
+groesstedruckausgabeEND PROC nummerinrichtigengrenzen;BOOL PROC 
+nummernummerisch(TEXT CONST nr):INT VAR lv;IF length(nr)=0#dr02.05.88#THEN 
+LEAVE nummernummerischWITH FALSE ELSE FOR lvFROM 1UPTO length(nr)REP IF pos(
+gueltigeziffern,nrSUB lv)=0THEN LEAVE nummernummerischWITH FALSE FI PER ;FI ;
+TRUE END PROC nummernummerisch;PROC meldefehlernameundtyp:meldeauffaellig(
+aktuellemaske,fehlermldnametyp);fehlermldnametyp:=0END PROC 
+meldefehlernameundtyp;BOOL PROC selektionswerteok(INT CONST dnr,INT VAR fehls
+,fehlz,fehlm):INT VAR lvf;TEXT VAR sfeldname,svergleichswert;BOOL VAR ok;f:=
+sequentialfile(modify,filenamesel);FOR lvfFROM 1UPTO anzattr(dnr)REP toline(f
+,lvf);readrecord(f,zeile);sfeldname:=subtext(zeile,1,pos(zeile,
+zeilennrtrenner)-1);svergleichswert:=subtext(zeile,pos(zeile,vergleichtrenner
+)+tl);IF svergleichswert<>niltextTHEN IF NOT vergleichswertokTHEN fehls:=lvf
+DIV anzzeilenselektionen+1;fehlz:=lvfMOD anzzeilenselektionen;LEAVE 
+selektionswerteokWITH FALSE FI FI PER ;TRUE .vergleichswertok:
+pruefeselektionswert(sfeldname,svergleichswert,ok,fehlm);ok.END PROC 
+selektionswerteok;PROC pruefeselektionswert(TEXT CONST vglname,vglwert,BOOL 
+VAR bool,INT VAR fehlm):LET bold=2,textstring=4,operator=5,scanende=7,
+gueltigeoperatoren="<$<=$<>$>$>=$=",gueltigeverkettung="$UND$ODER$";BOOL VAR 
+op:=FALSE ,vgl:=FALSE ,vkt:=TRUE ;INT VAR type:=0,typesich:=0;TEXT VAR symbol
+:="",twert:=compress(vglwert),tname:=compress(vglname);IF 
+keineanfuehrungszeichenTHEN fehlm:=meldungkeinanfuehrzeichen;ausstiegmitfalse
+ELSE pruefendervergleiche;IF typesich<>textstringTHEN fehlm:=
+meldungletzterkeinvgl;ausstiegmitfalseELSE bool:=TRUE FI FI .
+keineanfuehrungszeichen:pos(twert,anfuehrung)=0.pruefendervergleiche:scan(
+twert);WHILE type<>scanendeREP nextsymbol(symbol,type);SELECT typeOF CASE 
+bold:verkettungueberpruefenCASE textstring:textueberpruefenCASE operator:
+operatorueberpruefenCASE scanende:LEAVE pruefendervergleicheOTHERWISE :fehlm
+:=meldungungueltigeangaben;ausstiegmitfalseEND SELECT ;typesich:=typePER .
+operatorueberpruefen:IF opOR NOT vktOR (NOT opAND pos(gueltigeoperatoren,
+symbol)=0)THEN fehlm:=meldungfalscheroperator;ausstiegmitfalseELSE op:=TRUE ;
+FI .textueberpruefen:IF vglOR NOT opOR NOT checktyp(tname,symbol)THEN fehlm:=
+meldungfalschervergleich;ausstiegmitfalseELSE vgl:=TRUE ;vkt:=FALSE FI .
+verkettungueberpruefen:INT VAR posi:=pos(gueltigeverkettung,symbol);IF vktOR 
+NOT opOR NOT vglOR posi=0OR (posi<>0AND (((gueltigeverkettungSUB posi-1)<>"$"
+)OR ((gueltigeverkettungSUB posi+length(symbol))<>"$")))THEN fehlm:=
+meldungfalscheverkettung;ausstiegmitfalseELSE vkt:=TRUE ;op:=FALSE ;vgl:=
+FALSE FI .ausstiegmitfalse:bool:=FALSE ;LEAVE pruefeselektionswert.END PROC 
+pruefeselektionswert;BOOL PROC zugriffsregelnok(INT VAR fehlseite,fehlzeile,
+fehlmeld):f:=sequentialfile(modify,filenamezug);toline(f,1);pattern:=
+vergleichtrenner;readrecord(f,zeile);zeilennr:=1;IF pos(zeile,pattern)>0THEN 
+diesesistersteindexzeileCAND nurfelderausdiesemindexgewaehlt(fehlseite,
+fehlzeile,fehlmeld)ELSE down(f,pattern);IF patternfoundTHEN zeilennr:=lineno(
+f);readrecord(f,zeile);diesesistersteindexzeileCAND 
+nurfelderausdiesemindexgewaehlt(fehlseite,fehlzeile,fehlmeld)ELSE TRUE FI FI 
+.diesesistersteindexzeile:fehlseite:=zeilennrDIV anzzeilenregeln+1;fehlzeile
+:=zeilennrMOD anzzeilenregeln;fehlmeld:=meldungnichterstezeile;pos(zeile,
+anzahltrenner)<>0.END PROC zugriffsregelnok;BOOL PROC 
+nurfelderausdiesemindexgewaehlt(INT VAR fehls,fehlz,fehlm):INT VAR merker:=0,
+lv,anzfelder;TEXT VAR twert:="",tname:="";anzfelder:=int(subtext(zeile,pos(
+zeile,anzahltrenner)+tl,pos(zeile,namentrenner)-1));FOR lvFROM zeilennrUPTO 
+zeilennr+anzfelder-1REP toline(f,lv);readrecord(f,zeile);IF pos(zeile,pattern
+)>0THEN IF merker=1THEN fehls:=((lv-1)DIV anzzeilenregeln)+1;fehlz:=(lv-1)
+MOD anzzeilenregeln;fehlm:=meldungkeingeschlindex;LEAVE 
+nurfelderausdiesemindexgewaehltWITH FALSE ELSE vergleichswertpruefenFI ELSE 
+merker:=1;FI PER ;IF lines(f)=1OR lines(f)=lineno(f)THEN LEAVE 
+nurfelderausdiesemindexgewaehltWITH TRUE ELSE down(f);down(f,pattern)FI ;
+fehls:=lineno(f)DIV anzzeilenregeln+1;fehlz:=lineno(f)MOD anzzeilenregeln;
+fehlm:=meldungkeingeschlindex;NOT patternfound.vergleichswertpruefen:twert:=
+compress(subtext(zeile,pos(zeile,pattern)+tl));tname:=compress(subtext(zeile,
+pos(zeile,namentrenner)+tl,pos(zeile,zeilennrtrenner)-1));IF 
+ersteszeichenkeinanfuehrungszeichenTHEN stopbeifalschemnamen(FALSE );IF 
+eingabekeinfeldnameTHEN fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD 
+anzzeilenregeln;fehlm:=meldungkeinfeldname;LEAVE 
+nurfelderausdiesemindexgewaehltWITH FALSE ELSE feldtypueberpruefenFI ;
+stopbeifalschemnamen(TRUE );ELSE IF letzteszeichenkeinanfuehrungszeichenTHEN 
+fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD anzzeilenregeln;fehlm:=
+meldungkeinanfuehrzeichen;LEAVE nurfelderausdiesemindexgewaehltWITH FALSE 
+ELSE eingabemitfeldtypvergleichenFI ;FI .ersteszeichenkeinanfuehrungszeichen:
+(twertSUB 1)<>anfuehrung.eingabekeinfeldname:feldnr(twert)=0.
+feldtypueberpruefen:IF feldtyp(feldnr(twert))<>feldtyp(feldnr(tname))THEN 
+fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD anzzeilenregeln;fehlm:=
+meldungfalscherfeldtypn;LEAVE nurfelderausdiesemindexgewaehltWITH FALSE FI .
+letzteszeichenkeinanfuehrungszeichen:(twertSUB length(twert))<>anfuehrung.
+eingabemitfeldtypvergleichen:twert:=subtext(twert,2,length(twert)-1);IF NOT 
+checktyp(tname,twert)THEN fehls:=lvDIV anzzeilenregeln+1;fehlz:=lvMOD 
+anzzeilenregeln;fehlm:=meldungfalscherfeldtypw;LEAVE 
+nurfelderausdiesemindexgewaehltWITH FALSE FI .END PROC 
+nurfelderausdiesemindexgewaehlt;BOOL PROC checktyp(TEXT CONST fname,
+fvergleich):LET integer=73,realwert=82,datum=68;disablestop;SELECT feldtyp(
+feldnr(fname))OF CASE integer:INT VAR i:=int(fvergleich)CASE realwert:REAL 
+VAR r:=real(fvergleich)CASE datum:REAL VAR d:=date(fvergleich)END SELECT ;IF 
+iserrorCOR NOT lastconversionokTHEN clearerror;enablestop;LEAVE checktypWITH 
+FALSE FI ;enablestop;TRUE END PROC checktyp;END PACKET ispidaplausi;
+
diff --git a/app/schulis/2.2.1/src/insert schulis b/app/schulis/2.2.1/src/insert schulis
new file mode 100644
index 0000000..a28c829
--- /dev/null
+++ b/app/schulis/2.2.1/src/insert schulis
@@ -0,0 +1,472 @@
+LET versionsnummer=" 2.2.1";INT VAR kanal:=0,meinestation:=0;ROW 2TEXT VAR 
+ausbaustufe;ausbaustufe(1):="0,1,6,";ausbaustufe(2):="0,1,6,3,4,2,5,";INT 
+VAR ausbaustufenr:=1;LET teilsystem4="4",teilsystem6="6",teilsystem2="2",
+teilsystem5="5";LET praefixtrenner=".",teilsystemtrenner=",",allgemeinedatei=
+"0";TEXT VAR gueltigepraefixe:=",";TEXT VAR installverzeichnis:="";TASK VAR 
+tasksourcequelle,testtask;BOOL VAR fehlerbeiinsert:=FALSE ,
+idanichtinstallierbar:=FALSE ;LET stundenplanpraefix="Stundenplan-*";LET 
+kurswahlpraefix="Kurswahl-*";TEXT VAR qtt:="SCHULIS-Quellen";page;TEXT VAR 
+procaufruf1:="setze schulis zeichensatz(""",procaufruf2:=
+"setze ida zeichensatz(""",procaufrufende:=""")",gewzeichensatz:="";BOOL VAR 
+exists:=TRUE ;disablestop;gewzeichensatz:=font(1);IF iserrorTHEN clearerror;
+line;putline("Vor Installation bitte Fonttabelle in "+
+"Task 'configurator' laden!");enablestop;ELSE enablestop;WHILE existsREP page
+;cursor(10,10);put("Bitte gewünschten Schrifttyp für Listen und andere");
+cursor(10,11);put("Druckausgaben angeben : ");editget(gewzeichensatz);exists
+:=NOT fontexists(gewzeichensatz)PER ;procaufruf1CAT gewzeichensatz;
+procaufruf1CAT procaufrufende;procaufruf2CAT gewzeichensatz;procaufruf2CAT 
+procaufrufende;startinsertinggesamtsystem;commanddialogue(FALSE );forget(all)
+;commanddialogue(TRUE );FI ;BOOL PROC einzurichten(TEXT CONST teilsystemnr):
+pos(gueltigepraefixe,teilsystemtrenner+teilsystemnr+teilsystemtrenner)>0END 
+PROC einzurichten;TEXT PROC inv(TEXT CONST txt):""+txt+"�"ENDPROC inv;PROC 
+startinsertinggesamtsystem:TASK VAR t;INT VAR msgcode;DATASPACE VAR ds:=
+nilspace;maske;maskentexteinitialisieren;maskentexte;IF NOT maskeeditiert
+THEN LEAVE startinsertinggesamtsystemFI ;line;kanal:=channel;taskpassword(
+taskpasswort);beginpassword(beginnpasswort);fetch((ALL sourcetaskbaisydb)
+LIKE "*BAISY-0",sourcetaskbaisydb);INT VAR pospraefixende;THESAURUS VAR thes
+:=allLIKE "*.BAISY-0";TEXT VAR datenraumname;INT VAR indexthes:=0;get(thes,
+datenraumname,indexthes);WHILE indexthes>0REP pospraefixende:=pos(
+datenraumname,praefixtrenner);ausbaustufenr:=int(subtext(datenraumname,1,
+pospraefixende-1));forget(datenraumname,quiet);get(thes,datenraumname,
+indexthes)PER ;gueltigepraefixeCAT ausbaustufe(ausbaustufenr);
+tasksourcequelle:=sourcetaskbaisy;checkoff;fetchundinsert("BASIS.files");
+break(quiet);disablestop;IF NOT fehlerbeiinsertTHEN begin("ACCESS",PROC 
+startinsertingaccess,t);call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert
+:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin("baisy server",PROC 
+startinsertingbaisyserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin("ida server",
+PROC startinsertingidaserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin(
+"anschreiben server",PROC startinsertinganschreibenserver,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT 
+fehlerbeiinsertTHEN begin("statistik server",PROC 
+startinsertingstatistikserver,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin(
+"kurswahl server",PROC startinsertingkurswahlserver,t);call(t,0,ds,msgcode);
+IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN 
+begin("stundenplan server",PROC startinsertingstundenplanserver,t);call(t,0,
+ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT 
+fehlerbeiinsertTHEN begin("DB.kom",PROC startinsertingdbkom,t);call(t,0,ds,
+msgcode);IF msgcodeMOD 2=0THEN fehlerbeiinsert:=TRUE FI ;IF msgcode>=2THEN 
+idanichtinstallierbar:=TRUE FI FI ;clearerror;enablestop;continue(kanal);
+putline("Hier ist wieder "+name(myself));putline("SCHULIS ist "+fehler+
+" eingerichtet !");IF idanichtinstallierbarTHEN putline(
+"Das Modul ""Anwenderspezifische Druckausgaben"" wurde nicht eingerichtet,");
+putline("da die EUMEL-Textverarbeitung fehlt !");lineFI ;IF NOT 
+fehlerbeiinsertTHEN putline(
+"Bitte Task ""isp.archive"" unter SYSUR einrichten!");putline(
+"Bitte Task ""LOG"" unter SYSUR einrichten! <RETURN>")ELSE putline(
+"Bitte beliebige Taste (außer STOP und SV) drücken !")FI ;pause;
+freeglobalmanager.fehler:IF fehlerbeiinsertTHEN "FEHLERHAFT"ELSE 
+"ordnungsgemäß"FI .END PROC startinsertinggesamtsystem;PROC 
+startinsertingbaisyserver:TASK VAR ruftask;INT VAR msgcodert;DATASPACE VAR 
+dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name
+(myself));tasksourcequelle:=sourcetaskbaisy;line;IF taskpasswort=""THEN 
+taskpassword("-")ELSE taskpassword(taskpasswort)FI ;beginpassword(
+beginnpasswort);disablestop;fetch((ALL sourcetaskbaisydb)LIKE "*BAISY-*",
+sourcetaskbaisydb);INT VAR pospraefixende;THESAURUS VAR thes:=allLIKE (text(
+ausbaustufenr)+".BAISY-*");TEXT VAR datenraumname,neuername;INT VAR indexthes
+:=0;get(thes,datenraumname,indexthes);WHILE indexthes>0REP pospraefixende:=
+pos(datenraumname,praefixtrenner);neuername:=subtext(datenraumname,
+pospraefixende+1);rename(datenraumname,neuername);get(thes,datenraumname,
+indexthes)PER ;fetchundinsert("BAISY SERVER.files");IF iserrorTHEN putline(
+errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name(
+myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0
+ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("baisy server")END PROC 
+startinsertingbaisyserver;PROC startinsertingidaserver:TASK VAR ruftask;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));tasksourcequelle:=
+sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;IF taskpasswort=""THEN 
+taskpassword("-")ELSE taskpassword(taskpasswort)FI ;beginpassword(
+beginnpasswort);disablestop;fetchundinsert("0.IDA SERVER.files");IF iserror
+THEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;
+putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN 
+msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("ida server"
+)END PROC startinsertingidaserver;PROC startinsertingstundenplanserver:TASK 
+VAR ruftask;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,
+msgcodert,ruftask);continue(kanal);line;putline(name(myself));#
+fehlerbeiinsert:=FALSE ;#line;taskpassword("-");beginpassword("-");fetch((
+ALL sourcetaskschulisdb)LIKE stundenplanpraefix,sourcetaskschulisdb);putline(
+name(myself)+" ist komplett.");break(quiet);msgcodert:=1;send(ruftask,
+msgcodert,dsrt);freeglobalmanager;END PROC startinsertingstundenplanserver;
+PROC startinsertingstatistikserver:TASK VAR ruftask;INT VAR msgcodert;
+DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);
+line;putline(name(myself));tasksourcequelle:=sourcetaskschulis;#
+fehlerbeiinsert:=FALSE ;#line;IF taskpasswort=""THEN taskpassword("-")ELSE 
+taskpassword(taskpasswort)FI ;beginpassword(beginnpasswort);disablestop;
+fetchundinsert("5.STATISTIK SERVER.files");IF iserrorTHEN putline(
+errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name(
+myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0
+ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("statistik manager")END 
+PROC startinsertingstatistikserver;PROC startinsertingkurswahlserver:TASK 
+VAR ruftask;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,
+msgcodert,ruftask);continue(kanal);line;putline(name(myself));#
+fehlerbeiinsert:=FALSE ;#line;taskpassword("-");beginpassword("-");fetch((
+ALL sourcetaskschulisdb)LIKE kurswahlpraefix,sourcetaskschulisdb);putline(
+name(myself)+" ist komplett.");break(quiet);msgcodert:=1;send(ruftask,
+msgcodert,dsrt);freeglobalmanager;END PROC startinsertingkurswahlserver;PROC 
+startinsertinganschreibenserver:TASK VAR ruftask;INT VAR msgcodert;DATASPACE 
+VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(
+name(myself));#fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);disablestop;fetch("VORDRUCKE.files",
+sourcetaskvordrucke);fetch(ALL "VORDRUCKE.files",sourcetaskvordrucke);
+clearerror;enablestop;putline(name(myself)+" ist komplett.");break(quiet);
+msgcodert:=1;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertinganschreibenserver;PROC startinsertingdbdd:TASK VAR t,ruftask;
+INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt
+,msgcodert,ruftask);continue(kanal);line;putline(name(myself));line;
+taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop;
+tasksourcequelle:=sourcetaskschulis;fetchundinsert("0.IDA SICHERUNG.files");
+tasksourcequelle:=sourcetaskbaisy;fetchundinsert("SICHERUNG.files");do(
+"postfix ("""")");do("ausgabe namen");do("kf (TRUE)");IF iserrorTHEN putline(
+errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;IF NOT 
+fehlerbeiinsertTHEN erzeugeeumelbasebaisy;erzeugeeumelbaseschulis;FI ;break(
+quiet);IF NOT fehlerbeiinsertTHEN begin("statistik sicherung",PROC 
+startinsertingstatistiksich,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin(
+"schulis sicherung",PROC startinsertingschulissich,t);call(t,0,ds,msgcode);
+IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN 
+begin("baisy sicherung",PROC startinsertingbaisysich,t);call(t,0,ds,msgcode);
+IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN 
+begin("ida sicherung",PROC startinsertingidasich,t);call(t,0,ds,msgcode);IF 
+msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF fehlerbeiinsertTHEN msgcodert
+:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanagerEND 
+PROC startinsertingdbdd;PROC startinsertingstatistiksich:TASK VAR ruftask;
+INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);break(quiet);msgcodert:=1;send(ruftask,
+msgcodert,dsrt);do("statistik(TRUE)");do(" postfix ("""") ");commanddialogue(
+FALSE );do("isp monitor sicherungstask(""Statistik"")")END PROC 
+startinsertingstatistiksich;PROC startinsertingidasich:TASK VAR ruftask;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);break(quiet);msgcodert:=1;send(ruftask,
+msgcodert,dsrt);do("ida(TRUE)");do("open mit loeschen (FALSE)");do(
+" postfix ("""") ");do(" fetch dd (""EUMELbase.schulis"") ");do(
+" BOOL VAR b:: db open (""EUMELbase.schulis"") ");commanddialogue(FALSE );do(
+"isp monitor sicherungstask(""EUMELbase.schulis"")")ENDPROC 
+startinsertingidasich;PROC startinsertingschulissich:TASK VAR ruftask;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);tasksourcequelle:=sourcetaskschulisdb;fetch((
+ALL tasksourcequelle)LIKE "EUMELbase.schulis*",tasksourcequelle);break(quiet)
+;msgcodert:=1;send(ruftask,msgcodert,dsrt);do(
+"isp monitor sicherungstask(""EUMELbase.schulis"")")ENDPROC 
+startinsertingschulissich;PROC startinsertingbaisysich:TASK VAR ruftask;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);tasksourcequelle:=sourcetaskbaisydb;fetch((ALL 
+tasksourcequelle)LIKE "EUMELbase.baisy*",tasksourcequelle);fetch((ALL 
+tasksourcequelle)LIKE "*BAISY-*",tasksourcequelle);rename(text(ausbaustufenr)
++".BAISY-0","BAISY-0");rename(text(ausbaustufenr)+".BAISY-1","BAISY-1");break
+(quiet);msgcodert:=1;send(ruftask,msgcodert,dsrt);do(
+"isp monitor sicherungstask(""EUMELbase.baisy"")")ENDPROC 
+startinsertingbaisysich;PROC startinsertingdbkom:TASK VAR t,ruftask;INT VAR 
+msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,
+msgcodert,ruftask);continue(kanal);line;putline(name(myself));
+tasksourcequelle:=sourcetaskbaisy;#fehlerbeiinsert:=FALSE ;#
+idanichtinstallierbar:=FALSE ;line;taskpassword(taskpasswort);beginpassword(
+beginnpasswort);disablestop;fetch("EUMELbase.schulis",sourcetaskschulisdb);
+fetchundinsert("DB.files");IF iserrorTHEN putline(errormessage);clearerror;
+fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN 
+begin("DB.dd",PROC startinsertingdbdd,t);call(t,0,ds,msgcode);IF msgcode=0
+THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT fehlerbeiinsertTHEN begin(
+"standard",PROC startinsertingstandard,t);call(t,0,ds,msgcode);IF msgcodeMOD 
+2=0THEN fehlerbeiinsert:=TRUE FI ;IF msgcode>=2THEN idanichtinstallierbar:=
+TRUE FI FI ;continue(kanal);putline(name(myself)+" ist komplett.");break(
+quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE msgcodert:=1FI ;IF 
+idanichtinstallierbarTHEN msgcodert:=msgcodert+2FI ;send(ruftask,msgcodert,
+dsrt);freeglobalmanager;END PROC startinsertingdbkom;PROC 
+startinsertingstandard:TASK VAR t,ruftask;INT VAR msgcodert,msgcode;
+DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));tasksourcequelle:=sourcetaskbaisy;
+#fehlerbeiinsert:=FALSE ;#idanichtinstallierbar:=FALSE ;line;taskpassword(
+taskpasswort);beginpassword(beginnpasswort);disablestop;fetchundinsert(
+"STANDARD.files");IF iserrorTHEN putline(errormessage);clearerror;
+fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten(teilsystem6
+)THEN IF NOT fehlerbeiinsertTHEN IF procexists("autopageform")THEN begin(
+"ida",PROC startinsertingida,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ELSE idanichtinstallierbar:=TRUE FI FI ;FI ;
+fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN begin(
+"anschrlist werkzeuge",PROC startinsertinganschrlistwerkzeuge,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=
+FALSE ;IF NOT fehlerbeiinsertTHEN begin("erfassungen",PROC 
+startinsertingerfassungen,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert
+THEN begin("anwendung",PROC startinsertinganwendung,t);call(t,0,ds,msgcode);
+IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);putline(name(
+myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0
+ELSE msgcodert:=1FI ;IF idanichtinstallierbarTHEN msgcodert:=msgcodert+2FI ;
+send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertingstandard;PROC startinsertingaccess:TASK VAR t,ruftask;INT VAR 
+msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,
+msgcodert,ruftask);continue(kanal);line;putline(name(myself));
+tasksourcequelle:=sourcetaskeumelbase;#fehlerbeiinsert:=FALSE ;#line;
+taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop;
+fetchundinsert("ACCESS.files");IF iserrorTHEN putline(errormessage);
+clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF NOT 
+fehlerbeiinsertTHEN begin("LOCAL",PROC startinsertinglocal,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;IF NOT 
+fehlerbeiinsertTHEN begin("DB REORG",PROC startinsertingdbreorg,t);call(t,0,
+ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);
+putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN 
+msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);
+freeglobalmanagerEND PROC startinsertingaccess;PROC startinsertinglocal:TASK 
+VAR t,ruftask;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=
+nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name(
+myself));tasksourcequelle:=sourcetaskschulis;line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);disablestop;fetchundinsert("0.LOCAL.files");IF 
+iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;
+enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin("MM",PROC 
+startinsertingmm,t);call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=
+TRUE FI ;FI ;continue(kanal);putline(name(myself)+" ist komplett.");break(
+quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,
+msgcodert,dsrt);freeglobalmanagerEND PROC startinsertinglocal;PROC 
+startinsertingdbreorg:TASK VAR t,ruftask;INT VAR msgcodert,msgcode;DATASPACE 
+VAR dsrt:=nilspace,ds:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);
+line;putline(name(myself));tasksourcequelle:=sourcetaskbaisy;line;
+taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop;
+fetchundinsert("DB REORG.files");IF iserrorTHEN putline(errormessage);
+clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;putline(name(myself)+
+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE 
+msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do("db reorganisation manager")
+END PROC startinsertingdbreorg;PROC startinsertingmm:TASK VAR ruftask;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));tasksourcequelle:=
+sourcetaskeumelbase;line;taskpassword(taskpasswort);beginpassword(
+beginnpasswort);disablestop;fetchundinsert("MM BAISY.files");IF iserrorTHEN 
+fehlerbeiinsert:=TRUE ;putline(errormessage);clearerrorFI ;enablestop;putline
+(name(myself)+" ist komplett.");enablestop;break(quiet);IF fehlerbeiinsert
+THEN msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);do(
+"generate db manager")END PROC startinsertingmm;PROC erzeugeeumelbasebaisy:
+disablestop;testtask:=/"EUMELbase.baisy";IF iserrorTHEN clearerror;
+tasksourcequelle:=sourcetaskbaisydb;fetch((ALL tasksourcequelle)LIKE 
+"EUMELbase.baisy*",tasksourcequelle);do(
+"BOOL VAR b:: create db (""EUMELbase.baisy"")");do(
+"restore db (""EUMELbase.baisy"")");commanddialogue(FALSE );forget(all);
+commanddialogue(TRUE );FI ;enablestopENDPROC erzeugeeumelbasebaisy;PROC 
+erzeugeeumelbaseschulis:disablestop;testtask:=/"EUMELbase.schulis";IF iserror
+THEN clearerror;tasksourcequelle:=sourcetaskschulisdb;fetch((ALL 
+tasksourcequelle)LIKE "EUMELbase.schulis*",tasksourcequelle);do(
+"BOOL VAR b:: create db (""EUMELbase.schulis"")");do(
+"restore db (""EUMELbase.schulis"")");commanddialogue(FALSE );forget(all);
+commanddialogue(TRUE );FI ;enablestopENDPROC erzeugeeumelbaseschulis;PROC 
+startinsertinganwendung:TASK VAR ruftask,t;INT VAR msgcodert,i;DATASPACE VAR 
+dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name
+(myself));tasksourcequelle:=sourcetaskschulis;line;taskpassword(taskpasswort)
+;beginpassword(beginnpasswort);disablestop;tasksourcequelle:=sourcetaskbaisy;
+checkoff;fetchundinsert("ANWENDUNG.files");IF iserrorTHEN putline(
+errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);
+FOR iFROM 1UPTO anzahlschulistasksREP IF NOT fehlerbeiinsertTHEN begin(
+"schulis"+text(i),PROC startschulis1,t);FI ;PER ;continue(kanal);putline(name
+(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0
+ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertinganwendung;PROC startinsertinganschrlistwerkzeuge:TASK VAR 
+ruftask,t;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace
+;wait(dsrt,msgcodert,ruftask);continue(kanal);line;putline(name(myself));
+tasksourcequelle:=sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;
+taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop;
+fetchundinsert("0.ANSCHRLISTWERKZEUGE.files");do(procaufruf1);fetchundinsert(
+"0.ANSCHRLISTWERKZEUGE TEIL2.files");IF iserrorTHEN putline(errormessage);
+clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten(
+teilsystem5)THEN fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN 
+installverzeichnis:="5.STATISTIK.files";begin("statistik",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem2)THEN 
+fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"2.AUSWERTUNGEN KURSWAHL.files";begin("auswertungen kurswahl",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem4)THEN 
+fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"4.AUSWERTUNGEN STUNDENPLAN 3.files";begin("auswertungen stundenplan 3",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert
+THEN installverzeichnis:="4.AUSWERTUNGEN STUNDENPLAN 2.files";begin(
+"auswertungen stundenplan 2",PROC startinsertinganwendungstask,t);call(t,0,ds
+,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=
+FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"4.AUSWERTUNGEN STUNDENPLAN.files";begin("auswertungen stundenplan",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT 
+fehlerbeiinsertTHEN installverzeichnis:="0.ANSCHREIBEN.files";begin(
+"anschreiben",PROC startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF 
+msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT 
+fehlerbeiinsertTHEN installverzeichnis:="0.LISTEN 2.files";begin("listen 2",
+PROC startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert
+THEN installverzeichnis:="0.LISTEN.files";begin("listen",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);putline(name(myself)+
+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE 
+msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertinganschrlistwerkzeuge;PROC startinsertinganwendungstask:TASK VAR 
+ruftask,t;INT VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,
+ruftask);continue(kanal);line;putline(name(myself));tasksourcequelle:=
+sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort);
+beginpassword(beginnpasswort);disablestop;fetchundinsert(installverzeichnis);
+IF iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;
+enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin(name(myself)+
+" manager",PROC starteaufrufmanager,t);FI ;continue(kanal);putline(name(
+myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0
+ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertinganwendungstask;PROC startinsertingerfassungen:TASK VAR ruftask,
+t;INT VAR msgcodert,msgcode;DATASPACE VAR dsrt:=nilspace,ds:=nilspace;wait(
+dsrt,msgcodert,ruftask);continue(kanal);line;putline(name(myself));
+tasksourcequelle:=sourcetaskschulis;#fehlerbeiinsert:=FALSE ;#line;
+taskpassword(taskpasswort);beginpassword(beginnpasswort);disablestop;
+fetchundinsert("0.ERFASSUNGEN.files");IF iserrorTHEN putline(errormessage);
+clearerror;fehlerbeiinsert:=TRUE FI ;enablestop;break(quiet);IF einzurichten(
+teilsystem2)THEN fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN 
+installverzeichnis:="2.ERFASSUNGEN KURSWAHL 2.files";begin(
+"erfassungen kurswahl 2",PROC startinsertinganwendungstask,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=
+FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"2.ERFASSUNGEN KURSWAHL.files";begin("erfassungen kurswahl",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;FI ;IF einzurichten(teilsystem4)THEN IF NOT 
+fehlerbeiinsertTHEN installverzeichnis:="4.ERFASSUNGEN STUNDENPLAN.files";
+begin("erfassungen stundenplan",PROC startinsertingerfassungenstundenplan,t);
+call(t,0,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;FI ;
+fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"0.ERFASSUNGEN EINZELN 2.files";begin("erfassungen einzeln 2",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT fehlerbeiinsert
+THEN installverzeichnis:="0.ERFASSUNGEN EINZELN.files";begin(
+"erfassungen einzeln",PROC startinsertinganwendungstask,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=
+FALSE ;IF einzurichten(teilsystem4)THEN IF NOT fehlerbeiinsertTHEN 
+installverzeichnis:="4.ERFASSUNGEN LISTENWEISE 3.files";begin(
+"erfassungen listenweise 3",PROC startinsertinganwendungstask,t);call(t,0,ds,
+msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;fehlerbeiinsert:=
+FALSE ;IF NOT fehlerbeiinsertTHEN installverzeichnis:=
+"4.ERFASSUNGEN LISTENWEISE 2.files";begin("erfassungen listenweise 2",PROC 
+startinsertinganwendungstask,t);call(t,0,ds,msgcode);IF msgcode=0THEN 
+fehlerbeiinsert:=TRUE FI ;FI ;FI ;fehlerbeiinsert:=FALSE ;IF NOT 
+fehlerbeiinsertTHEN installverzeichnis:="0.ERFASSUNGEN LISTENWEISE.files";
+begin("erfassungen listenweise",PROC startinsertinganwendungstask,t);call(t,0
+,ds,msgcode);IF msgcode=0THEN fehlerbeiinsert:=TRUE FI ;FI ;continue(kanal);
+putline(name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN 
+msgcodert:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);
+freeglobalmanager;END PROC startinsertingerfassungen;PROC 
+startinsertingerfassungenstundenplan:TASK VAR ruftask,t;INT VAR msgcodert;
+DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);continue(kanal);
+line;putline(name(myself));tasksourcequelle:=sourcetaskschulis;#
+fehlerbeiinsert:=FALSE ;#line;taskpassword(taskpasswort);beginpassword(
+beginnpasswort);disablestop;fetchundinsert("4.ERFASSUNGEN STUNDENPLAN.files")
+;IF iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;
+enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin(name(myself)+
+" manager",PROC starteaufrufmanagersingletask,t);FI ;continue(kanal);putline(
+name(myself)+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert
+:=0ELSE msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END 
+PROC startinsertingerfassungenstundenplan;PROC starteaufrufmanager:do(
+"starte aufruf manager")ENDPROC starteaufrufmanager;PROC 
+starteaufrufmanagersingletask:do("starte aufruf manager(1)")ENDPROC 
+starteaufrufmanagersingletask;PROC startinsertingida:TASK VAR ruftask,t;INT 
+VAR msgcodert;DATASPACE VAR dsrt:=nilspace;wait(dsrt,msgcodert,ruftask);
+continue(kanal);line;putline(name(myself));tasksourcequelle:=
+sourcetaskschulis;line;taskpassword(taskpasswort);beginpassword(
+beginnpasswort);disablestop;fetchundinsert("6.IDA.files");do(procaufruf2);IF 
+iserrorTHEN putline(errormessage);clearerror;fehlerbeiinsert:=TRUE FI ;
+enablestop;break(quiet);IF NOT fehlerbeiinsertTHEN begin("ida manager",PROC 
+starteaufrufmanager,t);FI ;continue(kanal);putline(name(myself)+
+" ist komplett.");break(quiet);IF fehlerbeiinsertTHEN msgcodert:=0ELSE 
+msgcodert:=1FI ;send(ruftask,msgcodert,dsrt);freeglobalmanager;END PROC 
+startinsertingida;PROC startbaisy1:do("monitor")END PROC startbaisy1;PROC 
+startschulis1:disablestop;startschulisunterdisablestop;IF iserrorTHEN 
+clearerrorFI ;enablestop;do("monitor")END PROC startschulis1;PROC 
+startschulisunterdisablestop:enablestop;do(
+"oeffne datenbank (""EUMELbase.schulis"")");do("starte schulis");END PROC 
+startschulisunterdisablestop;PROC fetchundinsert(TEXT CONST datname):IF 
+fehlerbeiinsertTHEN LEAVE fetchundinsertFI ;disablestop;fetch(datname,
+tasksourcequelle);putline("Task "+name(myself)+" wird eingerichtet !");INT 
+VAR indexnr:=0;TEXT VAR thesname;THESAURUS VAR thes:=ALL datname;get(thes,
+thesname,indexnr);WHILE indexnr>0REP IF dateizuberuecksichtigen(thesname)
+THEN fetch(thesname,tasksourcequelle);putline(thesname);INT VAR taskkanal:=
+channel;break(quiet);insert(thesname);continue(taskkanal);IF iserrorTHEN 
+fehlerbeiinsert:=TRUE ;put(errormessage);clearerrorFI ;forget(thesname,quiet)
+FI ;get(thes,thesname,indexnr);PER ;commanddialogue(FALSE );forget(datname,
+quiet);commanddialogue(TRUE );enablestop.END PROC fetchundinsert;BOOL PROC 
+dateizuberuecksichtigen(TEXT CONST dateiname):INT VAR pospraefixende:=pos(
+dateiname,praefixtrenner);TEXT VAR dateipraefix:=subtext(dateiname,1,
+pospraefixende-1);IF dateipraefix=""THEN TRUE ELIF dateipraefix=
+allgemeinedateiTHEN TRUE ELIF dateipraefix>"9"THEN TRUE ELSE pos(
+gueltigepraefixe,teilsystemtrenner+dateipraefix+teilsystemtrenner)>0FI END 
+PROC dateizuberuecksichtigen;LET invers="",inversoff="",cdown=10,cup=3,esc=
+27,hop=1,zeilenlaenge=80,strichelement="=",maxiofelder=15;TYPE MASKENTEXTE =
+STRUCT (INT x,y,l,TEXT t,BOOL lfest);ROW maxiofelderMASKENTEXTE VAR mt;TASK 
+PROC sourcetask(INT CONST i):IF int(mt[i+1].t)<>meinestationTHEN int(mt[i+1].
+t)/mt[i].tELSE /mt[i].tFI ENDPROC sourcetask;TASK PROC sourcetaskbaisy:
+sourcetask(1)ENDPROC sourcetaskbaisy;TASK PROC sourcetaskschulis:sourcetask(3
+)ENDPROC sourcetaskschulis;TASK PROC sourcetaskeumelbase:sourcetask(5)
+ENDPROC sourcetaskeumelbase;TASK PROC sourcetaskvordrucke:sourcetask(7)
+ENDPROC sourcetaskvordrucke;TASK PROC sourcetaskbaisydb:sourcetask(9)ENDPROC 
+sourcetaskbaisydb;TASK PROC sourcetaskschulisdb:sourcetask(11)ENDPROC 
+sourcetaskschulisdb;INT PROC anzahlschulistasks:int(mt[13].t)ENDPROC 
+anzahlschulistasks;TEXT PROC taskpasswort:mt[14].tENDPROC taskpasswort;TEXT 
+PROC beginnpasswort:mt[15].tENDPROC beginnpasswort;PROC writexytext(INT 
+CONST x,y,TEXT CONST t):cursor(x,y);write(t)ENDPROC writexytext;PROC 
+writexyinvers(INT CONST x,y,TEXT CONST t):cursor(x,y);write(invers+t+
+inversoff)ENDPROC writexyinvers;PROC strich(INT CONST zeile):writexytext(1,
+zeile,zeilenlaenge*strichelement)ENDPROC strich;PROC kosmetik:page;strich(1);
+strich(4);strich(23);kopf.kopf:writexyinvers(27,2," S  C  H  U  L  I  S ");
+writexytext(10,3,"Installationsprogramm für SCHULIS Version "+versionsnummer)
+.ENDPROC kosmetik;PROC maske:kosmetik;fuss;rumpf.fuss:writexyinvers(2,24,
+"ESC HOP = Start   CURSOR UP/DOWN = nächstes/voriges Feld   ESC ESC = Abbruch"
+);.rumpf:writexytext(3,5,
+"BAISY-Quelltexte in Task    :                             auf Station:");
+writexytext(3,7,
+"SCHULIS-Quelltexte in Task  :                             auf Station:");
+writexytext(3,9,
+"EUMELbase-Quelltexte in Task:                             auf Station:");
+writexytext(3,11,
+"Vordrucke in Task           :                             auf Station:");
+writexytext(3,13,
+"BAISY-Datenbank in Task     :                             auf Station:");
+writexytext(3,15,
+"SCHULIS-Datenbank in Task   :                             auf Station:");
+writexytext(3,20,"Anzahl der Arbeitsplätze für  SCHULIS:");writexytext(3,22,
+"Task-Password:                          Beginn-Password:").ENDPROC maske;
+TEXT PROC mystation:text(station(myself))ENDPROC mystation;PROC 
+maskentexteinitialisieren:setmt(1,33,5,27,"BAISY-Quellen");setmt(2,75,5,3,
+mystation,TRUE );setmt(3,33,7,27,"SCHULIS-Quellen");setmt(4,75,7,3,mystation,
+TRUE );setmt(5,33,9,27,"EUMELbase-Quellen");setmt(6,75,9,3,mystation,TRUE );
+setmt(7,33,11,27,"VORDRUCKE");setmt(8,75,11,3,mystation,TRUE );setmt(9,33,13,
+27,"BAISY-SCHULIS-DB");setmt(10,75,13,3,mystation,TRUE );setmt(11,33,15,27,
+"BAISY-SCHULIS-DB");setmt(12,75,15,3,mystation,TRUE );setmt(13,45,20,3,"1",
+TRUE );setmt(14,18,22,21,"");setmt(15,60,22,21,"");ENDPROC 
+maskentexteinitialisieren;PROC setmt(INT CONST i,px,py,pl,TEXT CONST pt):
+setmt(i,px,py,pl,pt,FALSE )ENDPROC setmt;PROC setmt(INT CONST i,px,py,pl,
+TEXT CONST pt,BOOL CONST pf):mt[i].x:=px;mt[i].y:=py;mt[i].l:=pl;mt[i].t:=pt;
+mt[i].lfest:=pfENDPROC setmt;PROC maskentexte:INT VAR i;FOR iFROM 1UPTO 
+maxiofelderREP writexytext(mt[i].x,mt[i].y,text(mt[i].t,mt[i].l))PER ENDPROC 
+maskentexte;BOOL PROC maskeeditiert:INT VAR fnr:=1,editl;TEXT VAR exitchar:=
+"";REP cursor(mt[fnr].x,mt[fnr].y);bestimmeeditlaenge;editget(mt[fnr].t,editl
+,mt[fnr].l,"�
+","��?",exitchar);exitchar:=exitcharSUB length(exitchar);
+SELECT code(exitchar)OF CASE cup:vorigesfeldCASE cdown:naechstesfeldCASE esc:
+kosmetik;cursor(8,10);IF yes(
+"Soll die Installation tatsächlich abgebrochen werden")THEN LEAVE 
+maskeeditiertWITH FALSE ELSE restorescreenFI CASE hop:kosmetik;cursor(1,10);
+IF yes("Soll mit der Installation von SCHULIS begonnen werden")THEN page;
+LEAVE maskeeditiertWITH TRUE ELSE restorescreenFI OTHERWISE :naechstesfeld
+ENDSELECT PER ;FALSE .restorescreen:maske;maskentexte.naechstesfeld:fnr:=(fnr
+MOD maxiofelder)+1.vorigesfeld:IF fnr=1THEN fnr:=maxiofelderELSE fnrDECR 1FI 
+.bestimmeeditlaenge:IF mt[fnr].lfestTHEN editl:=mt[fnr].lELSE editl:=maxint-1
+FI .ENDPROC maskeeditiert;LET endofpermanenttable=32767;DATASPACE VAR 
+bulletinds:=nilspace;FILE VAR bulletinfile;TEXT VAR buffer,objectname,pattern
+;INT VAR packetlink,linenumber;BOOL VAR found:=TRUE ;BOOL PROC procexists(
+TEXT CONST procname):prepbulletin;objectname:=compress(procname);scan(
+objectname);nextsymbol(pattern);packetlink:=endofpermanenttable;standardhelp.
+prepbulletin:forget(bulletinds);bulletinds:=nilspace;bulletinfile:=
+sequentialfile(output,bulletinds);linenumber:=0;buffer:="".standardhelp:
+toobject(pattern);found.END PROC procexists;PROC toobject(TEXT CONST 
+searchedobject):LET endofhashtable=1023;INT VAR permanentpointer,index,ntlink
+;ntlink:=0;FOR indexFROM 1UPTO LENGTH searchedobjectREP ntlinkINCR ntlink;IF 
+ntlink>endofhashtableTHEN ntlinkDECR endofhashtableFI ;ntlink:=(ntlink+code(
+searchedobjectSUB index))MOD 1024PER ;found:=FALSE ;WHILE yetanotherntentry
+REP permanentpointer:=cdbint(ntlink+1);objectname:=cdbtext(ntlink+2);IF 
+objectname=searchedobjectTHEN found:=TRUE ;LEAVE toobjectFI PER .
+yetanotherntentry:ntlink:=cdbint(ntlink);ntlink<>0.END PROC toobject;INT 
+PROC cdbint(INT CONST index):EXTERNAL 116END PROC cdbint;TEXT PROC cdbtext(
+INT CONST index):EXTERNAL 117END PROC cdbtext;
+
diff --git a/app/speedtest/1986/doc/MEM64180.PRT b/app/speedtest/1986/doc/MEM64180.PRT
new file mode 100644
index 0000000..410cebe
--- /dev/null
+++ b/app/speedtest/1986/doc/MEM64180.PRT
@@ -0,0 +1,103 @@
+#type("17.klein")# 

+     BASIS 108 mit 64180, SHARD 8, 64180/6.144

+     =========================================

+

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16384 

+Gesamtlaufzeit (CPU):                     98.95774   msec

+

+     Steuerkonstrukte

+

+FOR REP                                     .12208   msec

+WHILE REP                                   .11903   msec

+UNTIL REP                                   .10682   msec

+IF                                          .03968   msec

+SELECT                                      .17701   msec

+PROC                                        .29299   msec

+PROC (INT)                                  .35097   msec

+PROC (INT, INT)                             .40896   msec

+                                          ---------------

+                                           1.61754   msec

+     Integer Operationen

+

+INT := (Paketdaten)                         .05188   msec

+INT := (Prozedurdaten)                      .07630   msec

+INT := (Parameter)                          .12818   msec

+ROW INT [i]                                 .24416   msec

+INT =                                       .06409   msec

+INT <=                                      .06409   msec

+INT +                                       .07630   msec

+INT *                                       .18312   msec

+DIV                                         .34487   msec

+INCR                                        .05493   msec

+MOD                                         .36623   msec

+abs (INT)                                   .89727   msec

+min (INT , INT)                             .89117   msec

+                                         ----------------

+                                           3.44259   msec

+     Real Operationen

+

+REAL :=                                     .07935   msec

+ROW REAL [i]                                .29299   msec

+REAL =                                      .18617   msec

+REAL <=                                     .13123   msec

+REAL +                                      .44864   msec

+REAL *                                     1.36718   msec

+REAL /                                     2.64892   msec

+INCR                                       1.08344   msec

+MOD                                        5.84106   msec

+abs (REAL)                                  .99799   msec

+min (REAL, REAL)                            .94610   msec

+                                        -----------------

+                                          14.02307   msec

+     Text Operationen

+

+TEXT := (1)                                 .08545   msec

+TEXT := (10)                                .45169   msec

+TEXT := (30)                                .55545   msec

+ROW TEXT [i]                                .30214   msec

+TEXT = (1)                                  .10682   msec

+TEXT = (10)                                 .35097   msec

+TEXT = (30)                                 .58903   msec

+TEXT <= (1)                                 .20753   msec

+TEXT <= (10)                                .38454   msec

+TEXT <= (30)                                .61649   msec

+TEXT * (Faktor 1)                          1.41305   msec

+CAT (1)                                     .34792   msec

+TEXT + (1)                                 1.15669   msec

+TEXT + (10)                                2.22778   msec

+TEXT + (30)                                2.73437   msec

+length (1)                                  .07935   msec

+length (10)                                 .07630   msec

+length (30)                                 .08240   msec

+SUB (1)                                     .17701   msec

+SUB (10)                                    .17701   msec

+SUB (30)                                    .22890   msec

+subtext (TEXT, INT, INT) (1)                .22584   msec

+subtext (TEXT, INT, INT) (10)               .22584   msec

+subtext (TEXT, INT, INT) (30)               .27773   msec

+replace (TEXT, TEXT, INT) (1)               .24721   msec

+replace (TEXT, TEXT, INT) (10)              .24416   msec

+replace (TEXT, TEXT, INT) (30)              .32045   msec

+text (TEXT, INT, INT) (1)                  2.45971   msec

+text (TEXT, INT, INT) (10)                 2.37426   msec

+text (TEXT, INT, INT) (30)                 2.75268   msec

+pos (TEXT, TEXT, INT) (1)                   .30825   msec

+pos (TEXT, TEXT, INT) (10)                  .32351   msec

+pos (TEXT, TEXT, INT) (30)                  .42422   msec

+                                         ----------------

+                                          22.53475   msec

+     Konvertierungs Operationen

+

+int (REAL)                                 2.21266   msec

+real (INT)                                 1.15058   msec

+int (TEXT)                                10.32104   msec

+text (INT)                                 1.98376   msec

+text (INT, INT)                            6.70776   msec

+text (REAL)                               28.53393   msec

+text (REAL, INT, INT)                      6.24389   msec

+code (INT)                                  .07630   msec

+code (TEXT)                                 .10987   msec

+                                        -----------------

+                                          57.33979   msec

diff --git a/app/speedtest/1986/doc/MEMATARI.PRT b/app/speedtest/1986/doc/MEMATARI.PRT
new file mode 100644
index 0000000..18eab76
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMATARI.PRT
@@ -0,0 +1,101 @@
+     ATARI ST      68000-8

+     =====================

+

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .64701   msec

+WHILE REP                                   .54630   msec

+UNTIL REP                                   .43338   msec

+IF                                          .31130   msec

+SELECT                                      .93389   msec

+PROC                                       1.43441   msec

+PROC (INT)                                 1.67247   msec

+PROC (INT, INT)                            1.91967   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .36318   msec

+INT := (Prozedurdaten)                      .39370   msec

+INT := (Parameter)                          .58292   msec

+ROW INT [i]                                1.05597   msec

+INT =                                       .43643   msec

+INT <=                                      .43643   msec

+INT +                                       .50967   msec

+INT *                                       .69890   msec

+DIV                                         .73857   msec

+INCR                                        .39980   msec

+MOD                                         .75383   msec

+abs (INT)                                  3.92175   msec

+min (INT , INT)                            3.86987   msec

+

+

+     Real Operationen

+

+REAL :=                                     .38760   msec

+ROW REAL [i]                               1.06513   msec

+REAL =                                      .85149   msec

+REAL <=                                     .71721   msec

+REAL +                                      .94305   msec

+REAL *                                     2.80168   msec

+REAL /                                     5.93298   msec

+INCR                                       3.35409   msec

+MOD                                       15.60154   msec

+abs (REAL)                                 4.12928   msec

+min (REAL, REAL)                           3.98584   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .56461   msec

+TEXT := (10)                               1.04376   msec

+TEXT := (30)                               2.43850   msec

+ROW TEXT [i]                               1.26350   msec

+TEXT = (1)                                  .68974   msec

+TEXT = (10)                                1.04376   msec

+TEXT = (30)                                2.26759   msec

+TEXT <= (1)                                1.08954   msec

+TEXT <= (10)                               1.17195   msec

+TEXT <= (30)                               2.39578   msec

+TEXT * (Faktor 1)                          6.59525   msec

+CAT (1)                                    1.67552   msec

+TEXT + (1)                                 5.10590   msec

+TEXT + (10)                                7.75194   msec

+TEXT + (30)                               10.13245   msec

+length (1)                                  .48221   msec

+length (10)                                 .48221   msec

+length (30)                                 .50357   msec

+SUB (1)                                     .99188   msec

+SUB (10)                                    .98883   msec

+SUB (30)                                   1.47409   msec

+subtext (TEXT, INT, INT) (1)               1.13532   msec

+subtext (TEXT, INT, INT) (10)              1.13227   msec

+subtext (TEXT, INT, INT) (30)              1.61448   msec

+replace (TEXT, TEXT, INT) (1)              1.15058   msec

+replace (TEXT, TEXT, INT) (10)             1.18721   msec

+replace (TEXT, TEXT, INT) (30)             1.73350   msec

+text (TEXT, INT, INT) (1)                 10.85882   msec

+text (TEXT, INT, INT) (10)                10.23012   msec

+text (TEXT, INT, INT) (30)                11.81102   msec

+pos (TEXT, TEXT, INT) (1)                  1.51682   msec

+pos (TEXT, TEXT, INT) (10)                 1.56565   msec

+pos (TEXT, TEXT, INT) (30)                 2.35000   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                 9.87304   msec

+real (INT)                                 5.28597   msec

+int (TEXT)                                50.36318   msec

+text (INT)                                 5.92077   msec

+text (INT, INT)                           26.21010   msec

+text (REAL)                              124.03101   msec

+text (REAL, INT, INT)                     27.72996   msec

+code (INT)                                  .49747   msec

+code (TEXT)                                 .65922   msec

+

diff --git a/app/speedtest/1986/doc/MEMB108.PRT b/app/speedtest/1986/doc/MEMB108.PRT
new file mode 100644
index 0000000..2a54412
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMB108.PRT
@@ -0,0 +1,99 @@
+     Basis108      HD64180-6.144

+     ===========================

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .17701   msec

+WHILE REP                                   .18312   msec

+UNTIL REP                                   .14344   msec

+IF                                          .08545   msec

+SELECT                                      .30214   msec

+PROC                                        .48831   msec

+PROC (INT)                                  .57682   msec

+PROC (INT, INT)                             .66838   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .10377   msec

+INT := (Prozedurdaten)                      .14344   msec

+INT := (Parameter)                          .21974   msec

+ROW INT [i]                                 .38760   msec

+INT =                                       .12208   msec

+INT <=                                      .12513   msec

+INT +                                       .14344   msec

+INT *                                       .24721   msec

+DIV                                         .57377   msec

+INCR                                        .10987   msec

+MOD                                         .60734   msec

+abs (INT)                                  1.57480   msec

+min (INT , INT)                            1.41915   msec

+

+

+     Real Operationen

+

+REAL :=                                     .13429   msec

+ROW REAL [i]                                .41506   msec

+REAL =                                      .28993   msec

+REAL <=                                     .20143   msec

+REAL +                                      .70805   msec

+REAL *                                     2.18519   msec

+REAL /                                     4.24220   msec

+INCR                                       1.73350   msec

+MOD                                        9.34505   msec

+abs (REAL)                                 1.55344   msec

+min (REAL, REAL)                           1.47409   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .15565   msec

+TEXT := (10)                                .39980   msec

+TEXT := (30)                                .68058   msec

+ROW TEXT [i]                                .43338   msec

+TEXT = (1)                                  .19227   msec

+TEXT = (10)                                 .40286   msec

+TEXT = (30)                                 .78740   msec

+TEXT <= (1)                                 .35708   msec

+TEXT <= (10)                                .44864   msec

+TEXT <= (30)                                .82708   msec

+TEXT * (Faktor 1)                          2.29201   msec

+CAT (1)                                     .57987   msec

+TEXT + (1)                                 1.84948   msec

+TEXT + (10)                                2.89324   msec

+TEXT + (30)                                3.16792   msec

+length (1)                                  .14649   msec

+length (10)                                 .14344   msec

+length (30)                                 .15260   msec

+SUB (1)                                     .30825   msec

+SUB (10)                                    .30825   msec

+SUB (30)                                    .39370   msec

+subtext (TEXT, INT, INT) (1)                .36318   msec

+subtext (TEXT, INT, INT) (10)               .36318   msec

+subtext (TEXT, INT, INT) (30)               .44253   msec

+replace (TEXT, TEXT, INT) (1)               .41201   msec

+replace (TEXT, TEXT, INT) (10)              .41506   msec

+replace (TEXT, TEXT, INT) (30)              .53409   msec

+text (TEXT, INT, INT) (1)                  4.08961   msec

+text (TEXT, INT, INT) (10)                 3.72337   msec

+text (TEXT, INT, INT) (30)                 4.05298   msec

+pos (TEXT, TEXT, INT) (1)                   .51578   msec

+pos (TEXT, TEXT, INT) (10)                  .54019   msec

+pos (TEXT, TEXT, INT) (30)                  .66227   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                 3.59519   msec

+real (INT)                                 1.92272   msec

+int (TEXT)                                17.15803   msec

+text (INT)                                 1.99902   msec

+text (INT, INT)                            9.44882   msec

+text (REAL)                               45.09553   msec

+text (REAL, INT, INT)                     10.03479   msec

+code (INT)                                  .14039   msec

+code (TEXT)                                 .19532   msec

diff --git a/app/speedtest/1986/doc/MEMB1082.PRT b/app/speedtest/1986/doc/MEMB1082.PRT
new file mode 100644
index 0000000..c5e8467
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMB1082.PRT
@@ -0,0 +1,112 @@
+#type("17.klein")#

+     Basis108/Urlader #326   HD64180-6.144                      10.10.86

+     =====================================

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+Anmerkung: In der Version 1.8.0 (Urlader 175 #326) ist der Basis in fast

+allen Punkten schneller geworden als mit Urlader 173 #073 (bis zu 40%!).

+

+Langsamer sind die Vergleichsoperationen bei Texten auf dem Heap und die

+Integermultiplikation, sowie abhängige davon (ROW-TEXT Subscript mit mehr

+als zwei Elementen), da bei diesem Benchmakr die EUMEL0-INT-Multiplikation

+nicht durch den HD64180-Prozessorbefehl MULT ersetzt wurde. 

+ 

+Der FMOV Befehl (REAL :=) ist schneller als auf der

+M24, sowie einige Vergleiche von langen Texten. Der Test auf der M24 war mit

+einem V30 Prozessor durchgeführt worden. 

+ 

+

+     Steuerkonstrukte

+

+FOR REP                                     .17396   msec

+WHILE REP                                   .17396   msec

+UNTIL REP                                   .14955   msec

+IF                                          .05799   msec

+SELECT                                      .24721   msec

+PROC                                        .41201   msec

+PROC (INT)                                  .49441   msec

+PROC (INT, INT)                             .66532   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .07630   msec

+INT := (Prozedurdaten)                      .11292   msec

+INT := (Parameter)                          .18922   msec

+ROW INT [i]                                 .34182   msec

+INT =                                       .08851   msec

+INT <=                                      .09156   msec

+INT +                                       .10987   msec

+INT *                                       .25942   msec

+DIV                                         .48831   msec

+INCR                                        .07630   msec

+MOD                                         .51578   msec

+abs (INT)                                  1.28792   msec

+min (INT , INT)                            1.27876   msec

+

+

+     Real Operationen

+

+REAL :=                                     .10987   msec (schneller als M24)

+ROW REAL [i]                                .40591   msec

+REAL =                                      .25636   msec

+REAL <=                                     .17701   msec

+REAL +                                      .63175   msec

+REAL *                                     1.93798   msec (schneller als M24)

+REAL /                                     3.75084   msec

+INCR                                       1.55649   msec

+MOD                                        8.37148   msec

+abs (REAL)                                 1.43441   msec

+min (REAL, REAL)                           1.35812   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .11903   msec

+TEXT := (10)                                .64091   msec

+TEXT := (30)                                .59513   msec

+ROW TEXT [i]                                .42727   msec

+TEXT = (1)                                  .14955   msec (schneller als M24)

+TEXT = (10)                                 .50052   msec

+TEXT = (30)                                 .66838   msec (schneller als M24)

+TEXT <= (1)                                 .29299   msec

+TEXT <= (10)                                .54019   msec

+TEXT <= (30)                                .71415   msec (schneller als M24)

+TEXT * (Faktor 1)                          2.03259   msec

+CAT (1)                                     .49136   msec

+TEXT + (1)                                 1.66331   msec

+TEXT + (10)                                2.57889   msec

+TEXT + (30)                                2.79863   msec

+length (1)                                  .10987   msec

+length (10)                                 .10987   msec

+length (30)                                 .11597   msec

+SUB (1)                                     .25026   msec

+SUB (10)                                    .25026   msec

+SUB (30)                                    .32351   msec

+subtext (TEXT, INT, INT) (1)                .32045   msec

+subtext (TEXT, INT, INT) (10)               .32045   msec

+subtext (TEXT, INT, INT) (30)               .39370   msec

+replace (TEXT, TEXT, INT) (1)               .34792   msec

+replace (TEXT, TEXT, INT) (10)              .35097   msec

+replace (TEXT, TEXT, INT) (30)              .45779   msec

+text (TEXT, INT, INT) (1)                  3.54331   msec

+text (TEXT, INT, INT) (10)                 3.40902   msec

+text (TEXT, INT, INT) (30)                 3.75084   msec

+pos (TEXT, TEXT, INT) (1)                   .43643   msec

+pos (TEXT, TEXT, INT) (10)                  .45779   msec

+pos (TEXT, TEXT, INT) (30)                  .56461   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                 3.17097   msec

+real (INT)                                 1.65110   msec

+int (TEXT)                                14.84160   msec

+text (INT)                                 2.84746   msec

+text (INT, INT)                            9.62888   msec

+text (REAL)                               41.02728   msec

+text (REAL, INT, INT)                      8.95746   msec

+code (INT)                                  .10682   msec

+code (TEXT)                                 .15260   msec

diff --git a/app/speedtest/1986/doc/MEMBIC10.PRT b/app/speedtest/1986/doc/MEMBIC10.PRT
new file mode 100644
index 0000000..d0a41aa
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMBIC10.PRT
@@ -0,0 +1,100 @@
+     BICOS SYSTEM 286/20        80286-10

+     ===================================

+

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .03357   msec

+WHILE REP                                   .02747   msec

+UNTIL REP                                   .02442   msec

+IF                                          .01221   msec

+SELECT                                      .07630   msec

+PROC                                        .08240   msec

+PROC (INT)                                  .09461   msec

+PROC (INT, INT)                             .10987   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .01526   msec

+INT := (Prozedurdaten)                      .02136   msec

+INT := (Parameter)                          .03357   msec

+ROW INT [i]                                 .09766   msec

+INT =                                       .02136   msec

+INT <=                                      .02136   msec

+INT +                                       .01831   msec

+INT *                                       .06104   msec

+DIV                                         .07019   msec

+INCR                                        .01221   msec

+MOD                                         .07019   msec

+abs (INT)                                   .31435   msec

+min (INT , INT)                             .25331   msec

+

+

+     Real Operationen

+

+REAL :=                                     .04273   msec

+ROW REAL [i]                                .12818   msec

+REAL =                                      .10071   msec

+REAL <=                                     .06714   msec

+REAL +                                      .24416   msec

+REAL *                                      .92474   msec

+REAL /                                     1.70604   msec

+INCR                                        .49441   msec

+MOD                                        3.42733   msec

+abs (REAL)                                  .37234   msec

+min (REAL, REAL)                            .33877   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .04883   msec

+TEXT := (10)                                .24721   msec

+TEXT := (30)                                .20448   msec

+ROW TEXT [i]                                .14039   msec

+TEXT = (1)                                  .06104   msec

+TEXT = (10)                                 .20753   msec

+TEXT = (30)                                 .31740   msec

+TEXT <= (1)                                 .10987   msec

+TEXT <= (10)                                .21669   msec

+TEXT <= (30)                                .32656   msec

+TEXT * (Faktor 1)                           .49747   msec

+CAT (1)                                     .18312   msec

+TEXT + (1)                                  .45169   msec

+TEXT + (10)                                 .74162   msec

+TEXT + (30)                                 .77825   msec

+length (1)                                  .04273   msec

+length (10)                                 .04273   msec

+length (30)                                 .04273   msec

+SUB (1)                                     .09461   msec

+SUB (10)                                    .09156   msec

+SUB (30)    .12208   msec

+subtext (TEXT, INT, INT) (1)                .11597   msec

+subtext (TEXT, INT, INT) (10)               .11597   msec

+subtext (TEXT, INT, INT) (30)               .14344   msec

+replace (TEXT, TEXT, INT) (1)               .12208   msec

+replace (TEXT, TEXT, INT) (10)              .12208   msec

+replace (TEXT, TEXT, INT) (30)              .15565   msec

+text (TEXT, INT, INT) (1)                   .80877   msec

+text (TEXT, INT, INT) (10)                  .83928   msec

+text (TEXT, INT, INT) (30)                  .96136   msec

+pos (TEXT, TEXT, INT) (1)                   .15870   msec

+pos (TEXT, TEXT, INT) (10)                  .16480   msec

+pos (TEXT, TEXT, INT) (30)                  .20143   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                  .79045   msec

+real (INT)                                  .35708   msec

+int (TEXT)                                 4.05603   msec

+text (INT)                                  .61649   msec

+text (INT, INT)                            2.32253   msec

+text (REAL)                               12.34511   msec

+text (REAL, INT, INT)                      2.25539   msec

+code (INT)                                  .03968   msec

+code (TEXT)                                 .05493   msec

diff --git a/app/speedtest/1986/doc/MEMBIC8.PRT b/app/speedtest/1986/doc/MEMBIC8.PRT
new file mode 100644
index 0000000..c36e6f0
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMBIC8.PRT
@@ -0,0 +1,101 @@
+     BICOS 286/20   INTEL80286-8

+     ==========================================

+

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .04273   msec

+WHILE REP                                   .03968   msec

+UNTIL REP                                   .03357   msec

+IF                                          .01831   msec

+SELECT                                      .10071   msec

+PROC                                        .10377   msec

+PROC (INT)                                  .12208   msec

+PROC (INT, INT)                             .13734   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .01831   msec

+INT := (Prozedurdaten)                      .02442   msec

+INT := (Parameter)                          .04273   msec

+ROW INT [i]                                 .12513   msec

+INT =                                       .02442   msec

+INT <=                                      .02136   msec

+INT +                                       .02442   msec

+INT *                                       .07935   msec

+DIV                                         .08545   msec

+INCR                                        .01831   msec

+MOD                                         .08545   msec

+abs (INT)                                   .39980   msec

+min (INT , INT)                             .32045   msec

+

+

+     Real Operationen

+

+REAL :=                                     .05188   msec

+ROW REAL [i]                                .16480   msec

+REAL =                                      .12208   msec

+REAL <=                                     .08240   msec

+REAL +                                      .30825   msec

+REAL *                                     1.17805   msec

+REAL /                                     2.16688   msec

+INCR                                        .63175   msec

+MOD                                        4.30324   msec

+abs (REAL)                                  .47000   msec

+min (REAL, REAL)                            .42117   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .06104   msec

+TEXT := (10)                                .30519   msec

+TEXT := (30)                                .25636   msec

+ROW TEXT [i]                                .17396   msec

+TEXT = (1)                                  .07935   msec

+TEXT = (10)                                 .25636   msec

+TEXT = (30)                                 .39675   msec

+TEXT <= (1)                                 .13734   msec

+TEXT <= (10)                                .26857   msec

+TEXT <= (30)                                .40896   msec

+TEXT * (Faktor 1)                           .61954   msec

+CAT (1)                                     .22890   msec

+TEXT + (1)                                  .57377   msec

+TEXT + (10)                                 .93389   msec

+TEXT + (30)                                 .98883   msec

+length (1)                                  .04883   msec

+length (10)                                 .05188   msec

+length (30)                                 .05188   msec

+SUB (1)                                     .11903   msec

+SUB (10)                                    .11903   msec

+SUB (30)    .15565   msec

+subtext (TEXT, INT, INT) (1)                .14344   msec

+subtext (TEXT, INT, INT) (10)               .14955   msec

+subtext (TEXT, INT, INT) (30)               .18006   msec

+replace (TEXT, TEXT, INT) (1)               .15565   msec

+replace (TEXT, TEXT, INT) (10)              .15565   msec

+replace (TEXT, TEXT, INT) (30)              .19532   msec

+text (TEXT, INT, INT) (1)                  1.02545   msec

+text (TEXT, INT, INT) (10)                 1.06208   msec

+text (TEXT, INT, INT) (30)                 1.21467   msec

+pos (TEXT, TEXT, INT) (1)                   .20143   msec

+pos (TEXT, TEXT, INT) (10)                  .21058   msec

+pos (TEXT, TEXT, INT) (30)                  .25331   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                  .99799   msec

+real (INT)                                  .44864   msec

+int (TEXT)                                 5.13947   msec

+text (INT)                                  .78130   msec

+text (INT, INT)                            2.93597   msec

+text (REAL)                               15.58323   msec

+text (REAL, INT, INT)                      2.85662   msec

+code (INT)                                  .04883   msec

+code (TEXT)                                 .07019   msec

+

diff --git a/app/speedtest/1986/doc/MEMCLA15.PRT b/app/speedtest/1986/doc/MEMCLA15.PRT
new file mode 100644
index 0000000..07cb3bd
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMCLA15.PRT
@@ -0,0 +1,100 @@
+

+     Classis AT 15 MHz / 80286

+     =========================

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .02442   msec

+WHILE REP                                   .02136   msec

+UNTIL REP                                   .01831   msec

+IF                                          .00916   msec

+SELECT                                      .04883   msec

+PROC                                        .05188   msec

+PROC (INT)                                  .06104   msec

+PROC (INT, INT)                             .06714   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .00610   msec

+INT := (Prozedurdaten)                      .01221   msec

+INT := (Parameter)                          .02136   msec

+ROW INT [i]                                 .06104   msec

+INT =                                       .00916   msec

+INT <=                                      .00916   msec

+INT +                                       .00916   msec

+INT *                                       .03662   msec

+DIV                                         .04273   msec

+INCR                                        .00916   msec

+MOD                                         .04273   msec

+abs (INT)                                   .18006   msec

+min (INT , INT)                             .16786   msec

+

+

+     Real Operationen

+

+REAL :=                                     .02442   msec

+ROW REAL [i]                                .08240   msec

+REAL =                                      .07019   msec

+REAL <=                                     .04883   msec

+REAL +                                      .16786   msec

+REAL *                                      .62260   msec

+REAL /                                     1.12312   msec

+INCR                                        .33571   msec

+MOD                                        2.29506   msec

+abs (REAL)                                  .25331   msec

+min (REAL, REAL)                            .22584   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .03052   msec

+TEXT := (10)                                .15870   msec

+TEXT := (30)                                .13429   msec

+ROW TEXT [i]                                .09156   msec

+TEXT = (1)                                  .03968   msec

+TEXT = (10)                                 .13734   msec

+TEXT = (30)                                 .21058   msec

+TEXT <= (1)                                 .07325   msec

+TEXT <= (10)                                .14039   msec

+TEXT <= (30)                                .21364   msec

+TEXT * (Faktor 1)                           .32656   msec

+CAT (1)                                     .11903   msec

+TEXT + (1)                                  .30214   msec

+TEXT + (10)                                 .49441   msec

+TEXT + (30)                                 .51883   msec

+length (1)                                  .02442   msec

+length (10)                                 .02442   msec

+length (30)                                 .02442   msec

+SUB (1)                                     .06104   msec

+SUB (10)                                    .06104   msec

+SUB (30)            .08240   msec

+subtext (TEXT, INT, INT) (1)                .07630   msec

+subtext (TEXT, INT, INT) (10)               .07630   msec

+subtext (TEXT, INT, INT) (30)               .09156   msec

+replace (TEXT, TEXT, INT) (1)               .07935   msec

+replace (TEXT, TEXT, INT) (10)              .07935   msec

+replace (TEXT, TEXT, INT) (30)              .10377   msec

+text (TEXT, INT, INT) (1)                   .54325   msec

+text (TEXT, INT, INT) (10)                  .55545   msec

+text (TEXT, INT, INT) (30)                  .63480   msec

+pos (TEXT, TEXT, INT) (1)                   .10071   msec

+pos (TEXT, TEXT, INT) (10)                  .10682   msec

+pos (TEXT, TEXT, INT) (30)                  .13123   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                  .54630   msec

+real (INT)                                  .23500   msec

+int (TEXT)                                 2.72844   msec

+text (INT)                                  .41506   msec

+text (INT, INT)                            1.55039   msec

+text (REAL)                                8.32570   msec

+text (REAL, INT, INT)                      1.56870   msec

+code (INT)                                  .02747   msec

+code (TEXT)                                 .03357   msec

diff --git a/app/speedtest/1986/doc/MEMRUC12.PRT b/app/speedtest/1986/doc/MEMRUC12.PRT
new file mode 100644
index 0000000..110d5e3
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMRUC12.PRT
@@ -0,0 +1,101 @@
+#type ("17.klein")#

+     ruc-AT      80286/12 MHz

+     ========================

+ 

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .03052   msec

+WHILE REP                                   .03052   msec

+UNTIL REP                                   .02747   msec

+IF                                          .01221   msec

+SELECT                                      .06409   msec

+PROC                                        .06714   msec

+PROC (INT)                                  .07935   msec

+PROC (INT, INT)                             .08851   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .00916   msec

+INT := (Prozedurdaten)                      .01221   msec

+INT := (Parameter)                          .02747   msec

+ROW INT [i]                                 .07935   msec

+INT =                                       .01526   msec

+INT <=                                      .01221   msec

+INT +                                       .01221   msec

+INT *                                       .04883   msec

+DIV                                         .05493   msec

+INCR                                        .00916   msec

+MOD                                         .05799   msec

+abs (INT)                                   .22584   msec

+min (INT , INT)                             .21364   msec

+

+

+     Real Operationen

+

+REAL :=                                     .03052   msec

+ROW REAL [i]                                .10682   msec

+REAL =                                      .08851   msec

+REAL <=                                     .06409   msec

+REAL +                                      .21058   msec

+REAL *                                      .79351   msec

+REAL /                                     1.42831   msec

+INCR                                        .42727   msec

+MOD                                        2.91155   msec

+abs (REAL)                                  .32045   msec

+min (REAL, REAL)                            .28383   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .03968   msec

+TEXT := (10)                                .20143   msec

+TEXT := (30)                                .16786   msec

+ROW TEXT [i]                                .11292   msec

+TEXT = (1)                                  .04883   msec

+TEXT = (10)                                 .17091   msec

+TEXT = (30)                                 .26552   msec

+TEXT <= (1)                                 .08851   msec

+TEXT <= (10)                                .18006   msec

+TEXT <= (30)                                .27162   msec

+TEXT * (Faktor 1)                           .42422   msec

+CAT (1)                                     .14955   msec

+TEXT + (1)                                  .38149   msec

+TEXT + (10)                                 .62260   msec

+TEXT + (30)                                 .66532   msec

+length (1)                                  .03357   msec

+length (10)                                 .03357   msec

+length (30)                                 .03357   msec

+SUB (1)                                     .07630   msec

+SUB (10)                                    .07630   msec

+SUB (30)                                    .09766   msec

+subtext (TEXT, INT, INT) (1)                .09766   msec

+subtext (TEXT, INT, INT) (10)               .09461   msec

+subtext (TEXT, INT, INT) (30)               .11903   msec

+replace (TEXT, TEXT, INT) (1)               .10377   msec

+replace (TEXT, TEXT, INT) (10)              .10071   msec

+replace (TEXT, TEXT, INT) (30)              .13123   msec

+text (TEXT, INT, INT) (1)                   .68974   msec

+text (TEXT, INT, INT) (10)                  .71415   msec

+text (TEXT, INT, INT) (30)                  .81182   msec

+pos (TEXT, TEXT, INT) (1)                   .12818   msec

+pos (TEXT, TEXT, INT) (10)                  .13429   msec

+pos (TEXT, TEXT, INT) (30)                  .16786   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                  .69279   msec

+real (INT)                                  .29909   msec

+int (TEXT)                                 3.45480   msec

+text (INT)                                  .52799   msec

+text (INT, INT)                            1.95935   msec

+text (REAL)                               10.56583   msec

+text (REAL, INT, INT)                      1.98376   msec

+code (INT)                                  .03357   msec

+code (TEXT)                                 .04883   msec

diff --git a/app/speedtest/1986/doc/MEMV30.PRT b/app/speedtest/1986/doc/MEMV30.PRT
new file mode 100644
index 0000000..9cdbf69
--- /dev/null
+++ b/app/speedtest/1986/doc/MEMV30.PRT
@@ -0,0 +1,100 @@
+     M 24 mit V 30      V 30 /8Mhz

+     =============================

+

+

+Wiederholungsfaktor für schnelle Operationen :   32766 

+Wiederholungsfaktor für langsame Operationen :   16383 

+

+

+     Steuerkonstrukte

+

+FOR REP                                     .07325   msec

+WHILE REP                                   .07019   msec

+UNTIL REP                                   .06409   msec

+IF                                          .03968   msec

+SELECT                                      .18006   msec

+PROC                                        .18312   msec

+PROC (INT)                                  .21058   msec

+PROC (INT, INT)                             .24416   msec

+

+

+     Integer Operationen

+

+INT := (Paketdaten)                         .03052   msec

+INT := (Prozedurdaten)                      .04273   msec

+INT := (Parameter)                          .07325   msec

+ROW INT [i]                                 .20143   msec

+INT =                                       .04273   msec

+INT <=                                      .03968   msec

+INT +                                       .04273   msec

+INT *                                       .12513   msec

+DIV                                         .13734   msec

+INCR                                        .03052   msec

+MOD                                         .13734   msec

+abs (INT)                                   .58292   msec

+min (INT , INT)                             .54325   msec

+

+

+     Real Operationen

+

+REAL :=                                     .13123   msec

+ROW REAL [i]                                .26857   msec

+REAL =                                      .20143   msec

+REAL <=                                     .14039   msec

+REAL +                                      .51273   msec

+REAL *                                     2.10584   msec

+REAL /                                     3.72337   msec

+INCR                                       1.11091   msec

+MOD                                        7.51389   msec

+abs (REAL)                                  .77825   msec

+min (REAL, REAL)                            .70500   msec

+

+

+     Text Operationen

+

+TEXT := (1)                                 .10071   msec

+TEXT := (10)                                .48526   msec

+TEXT := (30)                                .55545   msec

+ROW TEXT [i]                                .28078   msec

+TEXT = (1)                                  .17701   msec

+TEXT = (10)                                 .40896   msec

+TEXT = (30)                                 .75078   msec

+TEXT <= (1)                                 .21974   msec

+TEXT <= (10)                                .42727   msec

+TEXT <= (30)                                .77214   msec

+TEXT * (Faktor 1)                          1.03766   msec

+CAT (1)                                     .36929   msec

+TEXT + (1)                                  .95221   msec

+TEXT + (10)                                1.69688   msec

+TEXT + (30)                                1.94104   msec

+length (1)                                  .08545   msec

+length (10)                                 .08545   msec

+length (30)                                 .08851   msec

+SUB (1)                                     .18922   msec

+SUB (10)                                    .18922   msec

+SUB (30)    .26247   msec

+subtext (TEXT, INT, INT) (1)                .24110   msec

+subtext (TEXT, INT, INT) (10)               .23805   msec

+subtext (TEXT, INT, INT) (30)               .29299   msec

+replace (TEXT, TEXT, INT) (1)               .24721   msec

+replace (TEXT, TEXT, INT) (10)              .24721   msec

+replace (TEXT, TEXT, INT) (30)              .32656   msec

+text (TEXT, INT, INT) (1)                  1.72740   msec

+text (TEXT, INT, INT) (10)                 1.77013   msec

+text (TEXT, INT, INT) (30)                 2.27675   msec

+pos (TEXT, TEXT, INT) (1)                   .32351   msec

+pos (TEXT, TEXT, INT) (10)                  .33266   msec

+pos (TEXT, TEXT, INT) (30)                  .40591   msec

+

+

+     Konvertierungs Operationen

+

+int (REAL)                                 1.68467   msec

+real (INT)                                  .75993   msec

+int (TEXT)                                 8.32570   msec

+text (INT)                                  .93389   msec

+text (INT, INT)                            4.52298   msec

+text (REAL)                               26.61295   msec

+text (REAL, INT, INT)                      5.20662   msec

+code (INT)                                  .08240   msec

+code (TEXT)                                 .11292   msec

diff --git a/app/speedtest/1986/src/convert operation b/app/speedtest/1986/src/convert operation
new file mode 100644
index 0000000..903f2e5
--- /dev/null
+++ b/app/speedtest/1986/src/convert operation
@@ -0,0 +1,396 @@
+PACKET convert DEFINES real to int, 

+                       int to real,

+                       text to int, 

+                       int to text, 

+                       int to text 2, 

+                       real to text, 

+                       real to text 2, 

+                       code int, 

+                       code text : 

+ 

+ 

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+INT VAR index, 

+        first int,

+        i ;

+

+

+REAL VAR begin,

+         end,

+         act result,

+         first real ;

+

+

+TEXT VAR single text :: "*",

+         free text ; 

+

+

+

+

+PROC real to int (INT CONST frequency) :

+

+  first real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := int (first real) 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real to int s (frequency)

+

+END PROC real to int ;

+

+

+

+ 

+PROC real to int s (INT CONST frequency) :

+

+  first real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := int (first real) 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("int (REAL)", act result * msec factor (frequency) - for corr)

+

+END PROC real to int s ;

+

+

+

+

+PROC int to real (INT CONST frequency) :

+

+  first int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := real (first int)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int to real s (frequency)

+

+END PROC int to real ;

+

+

+

+ 

+PROC int to real s (INT CONST frequency) :

+

+  first int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := real (first int)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("real (INT)", act result * msec factor (frequency) - for corr)

+

+END PROC int to real s ;

+

+

+

+

+PROC text to int (INT CONST frequency) :

+

+  free text := "1111" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first int := int (free text) 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text to int s (frequency)

+

+END PROC text to int ;

+

+

+

+ 

+PROC text to int s (INT CONST frequency) :

+

+  free text := "1111" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first int := int (free text) 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("int (TEXT)", act result * msec factor (frequency) - for corr)

+

+END PROC text to int s ;

+

+

+

+

+PROC int to text (INT CONST frequency) :

+

+  first int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          free text := text (first int) ;

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int to text s (frequency)

+

+END PROC int to text ;

+

+

+

+ 

+PROC int to text s (INT CONST frequency) :

+

+  first int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          free text := text (first int) ;

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (INT)", act result * msec factor (frequency) - for corr)

+

+END PROC int to text s ;

+

+

+

+

+PROC int to text 2 (INT CONST frequency) :

+

+   first int := 1 ;

+   i := 3 ;

+   begin := clock (0) ;

+   FOR index FROM 1 UPTO frequency

+       REP

+           free text := text (first int, i)

+       END REP ;

+   end := clock (0) ;

+

+  act result := end - begin ;

+

+  int to text 2 s (frequency)

+

+END PROC int to text 2 ;

+

+

+

+ 

+PROC int to text 2 s (INT CONST frequency) :

+

+   first int := 1 ;

+   i := 3 ;

+   begin := clock (0) ;

+   FOR index FROM 1 UPTO frequency

+       REP

+           free text := text (first int, i)

+       END REP ;

+   end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (INT, INT)", act result * msec factor (frequency) - for corr)

+

+END PROC int to text 2 s ;

+

+

+

+

+PROC real to text (INT CONST frequency) :

+

+  first real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (first real) 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real to text s (frequency)

+

+END PROC real to text ;

+

+

+

+ 

+PROC real to text s (INT CONST frequency) :

+

+  first real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (first real) 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (REAL)", act result * msec factor (frequency) - for corr)

+

+END PROC real to text s ;

+

+

+

+

+PROC real to text 2 (INT CONST frequency) :

+

+  first real := 1.0 ;

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (first real, i, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real to text 2 s (frequency)

+

+END PROC real to text 2 ;

+

+

+

+ 

+PROC real to text 2 s (INT CONST frequency) :

+

+  first real := 1.0 ;

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (first real, i, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (REAL, INT, INT)", act result * msec factor (frequency) - for corr)

+

+END PROC real to text 2 s ;

+

+

+

+

+PROC code int (INT CONST frequency) : 

+

+  i := 65 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := code (i) 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  code int s (frequency)

+

+END PROC code int ;

+

+

+

+ 

+PROC code int s (INT CONST frequency) : 

+

+  i := 65 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := code (i) 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("code (INT)", act result * msec factor (frequency) - for corr)

+

+END PROC code int s ;

+

+

+

+

+PROC code text (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := code (single text)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  code text s (frequency)

+

+END PROC code text ;

+

+

+

+

+PROC code text s (INT CONST frequency) :

+

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := code (single text)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("code (TEXT)", act result * msec factor (frequency) - for corr)

+

+END PROC code text s ;

+

+

+END PACKET convert ;

diff --git a/app/speedtest/1986/src/gen.benchmark b/app/speedtest/1986/src/gen.benchmark
new file mode 100644
index 0000000..bb53ecc
--- /dev/null
+++ b/app/speedtest/1986/src/gen.benchmark
@@ -0,0 +1,98 @@
+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+LET max quantity = 99, 

+    pagelength   = 20 ;

+

+ROW max quantity TEXT VAR prog list ;

+

+INT VAR prog counter :: 0,

+        namelength :: 0,

+        counter,

+        storage size,

+        used storage ;

+

+

+

+PROC announce (TEXT CONST prog name) :

+

+  prog counter INCR 1 ;

+  prog list [prog counter] := prog name ;

+  IF NOT exists (prog name) 

+     THEN fetch (prog name, archive)

+  FI ;

+  IF LENGTH prog name > namelength

+     THEN namelength := LENGTH prog name

+  FI ;

+

+END PROC announce ;

+

+

+

+PROC execute :

+

+  INT CONST first page :: 1,

+            last page :: (prog counter DIV pagelength) + 1 ;

+

+  INT VAR pagenumber,

+          linenumber,

+          act linenumber,

+          act first line,

+          act last line ;

+

+  FOR page number FROM first page UPTO last page

+      REP act first line := (pagenumber - 1) * pagelength + 1 ;

+          act last line := min (prog counter, pagenumber * pagelength) ;

+          FOR act line number FROM act first line UPTO act last line

+              REP display (""1""4"") ;

+                  display (" Stand der Benchmark Insertierung ") ;

+                  IF last page > 1

+                     THEN display ("(" + text (pagenumber) + ". von " + text (last page) + " Seiten) :") 

+                     ELSE display (":") 

+                  FI ;

+                  display (""13""10""13""10"") ;

+                  FOR linenumber FROM act first line UPTO act last line

+                      REP IF linenumber = act linenumber

+                             THEN display ("        " + ""15""8"" + prog list [linenumber] + ""14""8""5"") 

+                             ELSE display ("        " + prog list [linenumber] + ""5"") 

+                          FI ;

+                          display (""13""10"") 

+                      PER ;

+                  display (""6"" + code (act linenumber - act first line + 2) + code (namelength + 20)) ;

+                  insert (prog list [act linenumber]) ;

+                 #forget (prog list [act linenumber], quiet)#

+          PER 

+  PER ;

+  display (""1""4"") ;

+  display ("Insertierung abgeschlossen!") ;

+  display (""13""10"") ;

+  IF yes ("Benchmark starten")

+     THEN do ("test speed")

+  FI ;

+

+END PROC execute ;

+

+

+

+check off ;

+announce ("notice") ;

+announce ("run down logic") ;

+announce ("integer operation") ;

+announce ("real operation") ;

+announce ("text operation") ;

+announce ("convert operation") ;

+announce ("speed tester") ;

+

+

+display (""1""4"") ;

+execute ;

+release (archive) ;

+#forget ("gen.benchmark", quiet) ;#

+check on ;

+

+

+

diff --git a/app/speedtest/1986/src/integer operation b/app/speedtest/1986/src/integer operation
new file mode 100644
index 0000000..90ef0f2
--- /dev/null
+++ b/app/speedtest/1986/src/integer operation
@@ -0,0 +1,614 @@
+PACKET integer operation DEFINES int assign global,

+                                 int assign local,

+                                 int assign param,

+                                 int equal, 

+                                 int lequal,

+                                 int abs,

+                                 int min,

+                                 int incr,

+                                 row int,

+                                 int div,

+                                 int mod,

+                                 int add,

+                                 int mult :

+

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+ROW 10 INT VAR introw ;

+

+

+REAL VAR begin, 

+         end,

+         act result,

+         int assign factor ;

+

+

+INT VAR first int,

+        second int,

+        third int,

+        rest,

+        i ,

+        index ;

+

+

+

+PROC int assign global (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := second int

+      END REP ;

+  end := clock (0);

+

+  act result := end - begin ;

+

+  int assign global s (frequency)

+

+END PROC int assign global ;

+

+

+

+ 

+PROC int assign global s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := second int

+      END REP ;

+  end := clock (0);

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  int assign factor := act result * msec factor (frequency) - for corr ;

+

+  notice result ("INT := (Paketdaten)", int assign factor) ; 

+

+END PROC int assign global s ;

+

+

+

+

+PROC int assign local (INT CONST frequency) :

+

+  INT VAR number one :: 0,

+          number two :: 1 ;

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          number one := number two

+      END REP ;

+  end := clock (0);

+

+  act result := end - begin ;

+

+  int assign local s (frequency)

+

+END PROC int assign local ;

+

+

+

+ 

+PROC int assign local s (INT CONST frequency) :

+

+  INT VAR number one :: 0,

+          number two :: 1 ;

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          number one := number two

+      END REP ;

+  end := clock (0);

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT := (Prozedurdaten)", act result * msec factor (frequency) - for corr) ;

+

+END PROC int assign local s ;

+

+

+

+

+PROC int assign param (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  int assign (first int, second int, frequency) ;

+  first int := 0 ;

+  int assign s (first int, second int, frequency)

+

+END PROC int assign param ;

+

+

+

+ 

+PROC int assign (INT VAR one, INT CONST two, frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          one := two

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+END PROC int assign ;

+

+

+

+ 

+PROC int assign s (INT VAR one, INT CONST two, frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          one := two

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT := (Parameter)", act result * msec factor (frequency) - for corr) ;

+

+END PROC int assign s ;

+

+

+

+

+PROC row int (INT CONST frequency) :

+

+  i := 7 ;

+  int row [i] := 0 ;

+  first int := 10000 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          introw [i] := first int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  row int s (frequency)

+

+END PROC row int ;

+

+

+

+ 

+PROC row int s (INT CONST frequency) :

+

+  i := 7 ;

+  int row [i] := 0 ;

+  first int := 10000 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          introw [i] := first int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("ROW INT [i]", act result * msec factor (frequency) - for corr) ;

+

+END PROC row int s ;

+

+

+

+

+PROC int equal (INT CONST frequency) : 

+ 

+  first int := 10 ;

+  second int := 10 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first int = second int

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int equal s (frequency)

+

+END PROC int equal ;

+

+

+

+ 

+PROC int equal s (INT CONST frequency) : 

+ 

+  first int := 10 ;

+  second int := 10 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first int = second int

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT =", act result * msec factor (frequency) - for corr) 

+

+END PROC int equal s ;

+

+

+

+

+PROC int lequal (INT CONST frequency) :

+ 

+  first int := 10 ;

+  second int := 11 ;

+  begin := clock(0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first int <= second int

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int lequal s (frequency)

+

+END PROC int lequal ;

+

+

+

+ 

+PROC int lequal s (INT CONST frequency) :

+ 

+  first int := 10 ;

+  second int := 11 ;

+  begin := clock(0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first int <= second int

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT <=", act result * msec factor (frequency) - for corr)

+

+END PROC int lequal s ;

+

+

+

+ 

+PROC int add (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  third int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := second int + third int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int add s (frequency)

+

+END PROC int add ;

+

+

+

+ 

+PROC int add s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  third int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first int := second int + third int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT +", act result * msec factor (frequency) - for corr)

+

+END PROC int add s ;

+

+

+

+

+PROC int mult (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 99 ;

+  third int := 11 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          first int := second int * third int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int mult s (frequency)

+

+END PROC int mult ;

+

+

+

+ 

+PROC int mult s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 99 ;

+  third int := 11 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          first int := second int * third int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INT *", act result * msec factor (frequency) - for corr)

+

+END PROC int mult s ;

+

+

+

+

+PROC int div (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 10001 ;

+  third int := 99 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first int := second int DIV third int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int div s (frequency)

+

+END PROC int div ;

+

+

+

+ 

+PROC int div s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 10001 ;

+  third int := 99 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first int := second int DIV third int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("DIV", act result * msec factor (frequency) - for corr)

+

+END PROC int div s ;

+

+

+

+

+PROC int mod (INT CONST frequency) : 

+

+  first int := 9999 ;

+  second int := 55 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          rest := first int MOD second int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int mod s (frequency)

+

+END PROC int mod ;

+

+

+

+ 

+PROC int mod s (INT CONST frequency) : 

+

+  first int := 9999 ;

+  second int := 55 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          rest := first int MOD second int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("MOD", act result * msec factor (frequency) - for corr)

+

+END PROC int mod s ;

+

+

+

+

+PROC int incr (INT CONST frequency) :

+

+  first int:= 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          first int INCR second int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int incr s (frequency)

+

+END PROC int incr ;

+

+

+

+ 

+PROC int incr s (INT CONST frequency) :

+

+  first int:= 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          first int INCR second int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INCR" , act result * msec factor (frequency) - for corr) ;

+

+END PROC int incr s ;

+

+

+

+

+PROC int abs (INT CONST frequency) :

+

+  first int := - 10000 ;

+  second int := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          second int := abs (first int)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int abs s (frequency)

+

+END PROC int abs ;

+

+

+

+ 

+PROC int abs s (INT CONST frequency) :

+

+  first int := - 10000 ;

+  second int := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          second int := abs (first int)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("abs (INT)", act result * msec factor (frequency) - for corr) ;

+

+END PROC int abs s ;

+

+

+

+

+PROC int min (INT CONST frequency) :

+

+  i := 0 ;

+  first int := 9999 ;

+  second int := 10000 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          i := min (first int, second int)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  int min s (frequency)

+

+END PROC int min ;

+

+

+

+ 

+PROC int min s (INT CONST frequency) :

+

+  i := 0 ;

+  first int := 9999 ;

+  second int := 10000 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          i := min (first int, second int)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("min (INT , INT)", act result * msec factor (frequency) - for corr) ;

+

+END PROC int min s ;

+

+

+END PACKET integer operation ;

diff --git a/app/speedtest/1986/src/notice b/app/speedtest/1986/src/notice
new file mode 100644
index 0000000..3e112c5
--- /dev/null
+++ b/app/speedtest/1986/src/notice
@@ -0,0 +1,102 @@
+PACKET notice DEFINES notice material,

+                      notice heading,

+                      notice operation,

+                      notice result, 

+                      notice frequency,

+                      notice runtime,

+                      output mem :

+

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+FILE VAR mem ;

+

+

+

+PROC notice result (TEXT CONST operation, REAL CONST runtime) :

+

+  TEXT VAR layout :: "" ;

+ 

+  layout CAT (operation + (40 - LENGTH operation) * " " + text (runtime, 10, 5) + "   msec") ;

+  putline (mem, layout) 

+

+END PROC notice result ;

+

+

+

+PROC notice material (TEXT CONST name) :

+

+  TEXT VAR layout :: "" ;

+

+  layout CAT ("     " + name) ;

+  line (mem, 4) ;

+  putline (mem, layout) ;

+  layout := "     " + LENGTH name * "=" ;

+  putline (mem, layout) ;

+  line (mem, 3) 

+

+END PROC notice material ;

+

+

+

+PROC notice heading (TEXT CONST name) :

+

+  TEXT VAR layout :: "" ;

+

+  layout CAT ("     " + name) ;

+  line (mem,2) ;

+  putline (mem, layout) ;

+  line (mem, 1) ;

+

+  display (""6""+code(21)+code(0)) ;

+  display (""5""13"") ;

+  display (""15""+" "+name+" "+""14"")

+

+END PROC notice heading ;

+

+

+

+PROC notice frequency (INT CONST frequency 1, frequency 2) :

+

+  line (mem, 1) ;

+  put (mem, "Wiederholungsfaktor für schnelle Operationen :   "+text (frequency 1)) ;

+  line (mem, 1) ;

+  put (mem, "Wiederholungsfaktor für langsame Operationen :   "+text (frequency 2)) ;

+  line (mem, 1)

+

+END PROC notice frequency ;

+

+

+

+PROC notice operation (TEXT CONST operation) :

+

+  display(""6""+code(22)+code(0)) ;

+  display (""5""13"") ;

+  display (""15""+" "+ operation +" "+""14"") ;

+

+END PROC notice operation ;

+

+

+

+PROC notice runtime (REAL CONST runtime) :

+

+  line (mem, 3) ;

+  putline (mem, "Gesamtlaufzeit : " + text (runtime)) ;

+

+END PROC notice runtime ;

+

+

+

+PROC output mem :

+

+  mem := sequential file (output, "memory")

+

+END PROC output mem ;

+

+

+END PACKET notice ;

diff --git a/app/speedtest/1986/src/real operation b/app/speedtest/1986/src/real operation
new file mode 100644
index 0000000..2d63d1b
--- /dev/null
+++ b/app/speedtest/1986/src/real operation
@@ -0,0 +1,519 @@
+PACKET real operation DEFINES real assign,

+                              row real,

+                              real add,

+                              real mult,

+                              real div,

+                              real incr,

+                              real mod,

+                              real equal, 

+                              real lequal, 

+                              real abs,

+                              real min :

+

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+ROW 10 REAL VAR real row ;

+

+

+

+INT VAR index, 

+        i ;

+

+

+REAL VAR begin,

+         end,

+         first real,

+         second real,

+         third real,

+         rest,

+         act result,

+         real assign factor ;

+

+

+

+

+PROC real assign (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first real := second real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real assign s (frequency)

+

+END PROC real assign ;

+

+

+

+ 

+PROC real assign s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first real := second real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  real assign factor := act result * msec factor (frequency) - for corr ;

+

+  notice result ("REAL :=", real assign factor) ;

+

+END PROC real assign s ;

+

+

+

+

+PROC row real (INT CONST frequency) :

+

+  first real := 1.0 ;

+  i := 7 ;

+  real row [i] := 0.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          real row [i] := first real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  row real s (frequency)

+

+END PROC row real ;

+

+

+

+ 

+PROC row real s (INT CONST frequency) :

+

+  first real := 1.0 ;

+  i := 7 ;

+  real row [i] := 0.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          real row [i] := first real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("ROW REAL [i]", act result * msec factor (frequency) - for corr) ;

+ 

+END PROC row real s ;

+

+

+

+

+PROC real equal (INT CONST frequency) : 

+ 

+  first real := 10.0 ;

+  second real := 10.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first real = second real

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real equal s (frequency)

+

+END PROC real equal ;

+

+

+

+ 

+PROC real equal s (INT CONST frequency) : 

+ 

+  first real := 10.0 ;

+  second real := 10.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first real = second real

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("REAL =", act result * msec factor (frequency) - for corr)

+

+END PROC real equal s ;

+

+

+

+

+PROC real lequal (INT CONST frequency) :

+ 

+  first real := 10.0 ;

+  second real := 11.0 ;

+  begin := clock(0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first real <= second real

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real lequal s (frequency)

+

+END PROC real lequal ;

+

+

+

+ 

+PROC real lequal s (INT CONST frequency) :

+ 

+  first real := 10.0 ;

+  second real := 11.0 ;

+  begin := clock(0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF first real <= second real

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("REAL <=", act result * msec factor (frequency) - for corr) 

+

+END PROC real lequal s ;

+

+

+

+

+PROC real add (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  third real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first real := second real + third real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real add s (frequency)

+

+END PROC real add ;

+

+

+

+ 

+PROC real add s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  third real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          first real := second real + third real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("REAL +", act result * msec factor (frequency) - for corr) ;

+

+END PROC real add s ;

+

+

+

+

+PROC real mult (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.001 ;

+  third real := 1.001 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := second real * third real

+      END REP ;

+  end := clock (0) ;

+ 

+  act result := end - begin ;

+

+  real mult s (frequency)

+

+END PROC real mult ;

+

+

+

+ 

+PROC real mult s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.001 ;

+  third real := 1.001 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := second real * third real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("REAL *", act result * msec factor (frequency) - for corr) ;

+

+END PROC real mult s ;

+

+

+

+

+PROC real div (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 10000.0 ;

+  third real := 1.0001 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := second real / third real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real div s (frequency)

+

+END PROC real div ;

+

+

+

+ 

+PROC real div s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 10000.0 ;

+  third real := 1.0001 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first real := second real / third real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("REAL /", act result * msec factor (frequency) - for corr) ;

+

+END PROC real div s ;

+

+

+

+

+PROC real incr (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first real INCR second real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real incr s (frequency)

+

+END PROC real incr ;

+

+

+

+ 

+PROC real incr s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first real INCR second real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("INCR", act result * msec factor (frequency) - for corr) ;

+

+END PROC real incr s ;

+

+

+

+

+PROC real mod (INT CONST frequency) :

+

+  first real := 9999.9 ;

+  second real := 21.21 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          rest := first real MOD second real

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real mod s (frequency)

+

+END PROC real mod ;

+

+

+

+ 

+PROC real mod s (INT CONST frequency) :

+

+  first real := 9999.9 ;

+  second real := 21.21 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          rest := first real MOD second real

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("MOD", act result * msec factor (frequency) - for corr) ;

+

+END PROC real mod s ;

+

+

+

+

+PROC real abs (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := - 12345.6 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first real := abs (second real)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  real abs s (frequency)

+

+END PROC real abs ;

+

+

+

+ 

+PROC real abs s (INT CONST frequency) :

+

+  first real := 0.0 ;

+  second real := - 12345.6 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          first real := abs (second real)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("abs (REAL)", act result * msec factor (frequency) - for corr) ;

+ 

+END PROC real abs s ;

+

+

+

+

+PROC real min (INT CONST frequency) :

+

+  first real := 10000.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          rest := min (first real, second real)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  real min s (frequency)

+

+END PROC real min ;

+

+

+

+ 

+PROC real min s (INT CONST frequency) :

+

+  first real := 10000.0 ;

+  second real := 1.0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          rest := min (first real, second real)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("min (REAL, REAL)", act result * msec factor (frequency) - for corr) ;

+

+END PROC real min s ;

+

+

+END PACKET real operation ;

diff --git a/app/speedtest/1986/src/run down logic b/app/speedtest/1986/src/run down logic
new file mode 100644
index 0000000..49f0f0f
--- /dev/null
+++ b/app/speedtest/1986/src/run down logic
@@ -0,0 +1,429 @@
+PACKET run down logic DEFINES for loop, 

+                              msec factor,

+                              for corr, 

+                              while loop, 

+                              until loop, 

+                              if, 

+                              select, 

+                              proc, 

+                              proc one param int, 

+                              proc two param int : 

+ 

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+INT VAR first int,

+        second int,

+        index ;

+

+REAL VAR for loop corr,

+         begin,

+         end,

+         int incr corr,

+         act result ;

+

+BOOL VAR is initialized :: FALSE,

+         situation :: TRUE ;

+ 

+

+

+PROC for loop (INT CONST frequency) : 

+ 

+  notice operation ("FOR LOOP") ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  for loop s (frequency) 

+

+END PROC for loop ;

+

+

+

+PROC for loop s (INT CONST frequency) : 

+ 

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  for loop corr := act result * msec factor (frequency) ;

+

+  notice result ("FOR REP",for loop corr) 

+

+END PROC for loop s ;

+

+

+

+PROC initialize int incr corr (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first int INCR second int

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  initialize int incr corr s (frequency)

+

+END PROC initialize int incr corr ;

+

+

+

+PROC initialize int incr corr s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          first int INCR second int

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  int incr corr := act result * msec factor (frequency) - for corr ;

+

+END PROC initialize int incr corr s ;

+

+

+

+PROC while loop (INT CONST frequency) :

+

+  IF NOT is initialized

+         THEN initialize int incr corr (frequency)

+  FI ;

+

+  notice operation ("WHILE LOOP") ;

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  WHILE first int < frequency 

+        REP

+            first int INCR second int

+        END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  while loop s (frequency) 

+

+END PROC while loop ;

+

+

+

+PROC while loop s (INT CONST frequency) :

+

+  first int := 0 ;

+  second int := 1 ;

+  begin := clock (0) ;

+  WHILE first int < frequency 

+        REP

+            first int INCR second int

+        END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("WHILE REP", act result * msec factor (frequency) - int incr corr) ;

+

+END PROC while loop s ;

+

+

+

+PROC until loop (INT CONST frequency) :

+

+  IF NOT is initialized

+         THEN initialize int incr corr (frequency)

+  FI ;

+

+  notice operation ("UNTIL LOOP") ;

+  first int := 1 ;

+  second int := 1 ;

+  begin := clock (0) ;

+        REP

+            first int INCR second int

+  UNTIL first int > frequency

+        END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  until loop s (frequency)

+

+END PROC until loop ;

+

+

+ 

+PROC until loop s (INT CONST frequency) :

+

+  first int := 1 ;

+  second int := 1 ;

+  begin := clock (0) ;

+        REP

+            first int INCR second int

+  UNTIL first int > frequency

+        END REP ;

+  end := clock (0) ;

+

+  IF act result > act result

+     THEN act result := end - begin

+  FI ;

+

+  notice result("UNTIL REP", act result * msec factor (frequency) - int incr corr) 

+

+END PROC until loop s ;

+

+

+

+PROC if (INT CONST frequency) : 

+

+  notice operation ("IF") ;

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency

+      REP 

+          IF situation

+             THEN 

+          FI 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  act result := end - begin ;

+ 

+  if s (frequency)

+

+END PROC if ; 

+

+

+ 

+PROC if s (INT CONST frequency) : 

+

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency

+      REP 

+          IF situation

+             THEN 

+          FI 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("IF", act result * msec factor (frequency) - for corr) ; 

+ 

+END PROC if s ; 

+

+

+

+PROC select (INT CONST frequency) : 

+ 

+  notice operation ("SELECT") ;

+  first int := 0 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency

+      REP 

+          SELECT first int OF 

+                 CASE 0 : 

+                 OTHERWISE

+          END SELECT 

+      END REP ;

+  end := clock (0) ; 

+ 

+  act result := end - begin ;

+

+  select s (frequency)

+

+END PROC select ;

+

+

+ 

+PROC select s (INT CONST frequency) : 

+ 

+  first int := 0 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency

+      REP 

+          SELECT first int OF 

+                 CASE 0 : 

+                 OTHERWISE

+          END SELECT 

+      END REP ;

+  end := clock (0) ; 

+ 

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("SELECT", act result * msec factor (frequency) - for corr) ;

+

+END PROC select s ;

+

+

+

+PROC proc (INT CONST frequency) :

+

+  notice operation ("PROC") ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          nilproc 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  proc s (frequency)

+

+END PROC proc ;

+

+

+ 

+PROC proc s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          nilproc 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("PROC", act result * msec factor (frequency) - for corr) ;

+

+END PROC proc s ;

+

+

+

+PROC proc one param int (INT CONST frequency) :

+

+  notice operation ("PROC one param INT") ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          nilproc (first int)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  proc one param int s (frequency)

+

+END PROC proc one param int ;

+

+

+ 

+PROC proc one param int s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          nilproc (first int)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin 

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("PROC (INT)", act result * msec factor (frequency) - for corr) ;

+

+END PROC proc one param int s ;

+

+

+

+PROC proc two param int (INT CONST frequency) :

+

+  notice operation ("PROC two param INT") ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          nilproc (first int,  second int)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  proc two param int s (frequency)

+

+END PROC proc two param int ;

+

+

+ 

+PROC proc two param int s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP 

+          nilproc (first int,  second int)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("PROC (INT, INT)", act result * msec factor (frequency) - for corr) ;

+

+END PROC proc two param int s ;

+

+

+

+PROC nilproc :

+END PROC nilproc ;

+

+

+

+PROC nilproc (INT CONST number one) :

+END PROC nilproc ;

+

+

+

+PROC nilproc (INT CONST number one, number two) :

+END PROC nilproc ;

+

+

+

+REAL PROC for corr :

+

+  for loop corr

+

+END PROC for corr ;

+

+

+

+REAL PROC msec factor (INT CONST frequency) :

+

+  1000.0 / real (frequency)

+

+END PROC msec factor ;

+

+

+END PACKET run down logic ;

diff --git a/app/speedtest/1986/src/speed tester b/app/speedtest/1986/src/speed tester
new file mode 100644
index 0000000..3f69008
--- /dev/null
+++ b/app/speedtest/1986/src/speed tester
@@ -0,0 +1,209 @@
+PACKET speed tester DEFINES test speed :

+

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+PROC test speed :

+ 

+  INT VAR frequency 1,

+          frequency 2 ;

+ 

+  TEXT VAR name of material,

+           name of the heart of material,

+           high,

+           low ;

+

+  REAL VAR begin,

+           end ;

+

+

+  page ;

+  cursor (1,3) ;

+  out (""15""+" EUMEL SPEED TESTER "+"     "+" EUMEL SPEED TESTER "+"     "+" EUMEL SPEED TESTER "+""14"") ;

+  cursor (1,6) ;

+  put ("Bitte gib Name/Typbezeichnung des Test-PC ein") ;

+  line ;

+  getline (name of material) ;

+  line ;

+  put ("Bitte gib Prozessortyp/Taktfrequenz ein") ;

+  line ;

+  getline (name of the heart of material) ;

+  line ;

+  name of material CAT "      " ;

+

+  output mem ;

+  notice material (name of material + name of the heart of material) ;

+

+        REP

+            output mem ;

+            putline ("Bitte gib Genauigkeitsfaktor fuer schnelle Operationen ein") ;

+            put ("Voreingestellt ist maxint   --> ") ;

+            getline (high) ;

+            line ;

+            IF high = ""

+               THEN frequency 1 := 32766

+               ELSE frequency 1 := int (high)

+            FI ;

+            putline ("Bitte gib Genauigkeitsfaktor fuer langsame Operationen ein") ;

+            put ("Voreingestellt ist maxint Div 2   --> ") ;

+            getline (low) ;

+            IF low = ""

+               THEN frequency 2 := maxint DIV 2

+               ELSE frequency 2 := int (low)

+            FI ;

+            notice frequency (frequency 1, frequency 2) ;

+

+            begin := clock (0) ; 

+

+

+            test run down logic ;

+            test integer operation ;

+            test real operation ;

+            test text operation ;

+            test convert ;

+

+            end := clock (0) ; 

+            page ;

+            put ("Gesamtlaufzeit : ") ;

+            put (time (end-begin)) ;

+            line (2) ;

+            put ("Taste drücken oder warten") ;

+            pause (600) ; 

+

+

+            page ;

+            cursor (1,5) ;

+            out (""5""13"") ;

+            IF yes ("Ergebnis anschauen")

+               THEN edit ("memory") ;

+                    page

+            FI ;

+

+            cursor (1,5) ;

+            out (""5""13"") ;

+            IF yes ("Ergebnis loeschen") 

+               THEN forget ("memory",quiet)

+            FI ;

+

+            cursor (1,5) ;

+            out (""5""13"") 

+            UNTIL no ("Neuer test")

+        END REP .

+

+

+test run down logic :

+

+notice heading ("Steuerkonstrukte") ;

+

+for loop (frequency 1) ;

+while loop (frequency 1) ;

+until loop (frequency 1) ;

+if (frequency 1) ;

+select (frequency 1) ;

+proc (frequency 1) ;

+proc one param int (frequency 1) ;

+proc two param int (frequency 1) .

+

+

+

+test integer operation :

+

+notice heading ("Integer Operationen") ;

+

+int assign global (frequency 1) ;

+int assign local (frequency 1) ;

+int assign param (frequency 1) ;

+row int (frequency 1) ;

+int equal (frequency 1) ;

+int lequal (frequency 1) ;

+int add (frequency 1) ;

+int mult (frequency 1) ;

+int div (frequency 1) ;

+int incr (frequency 1) ;

+int mod (frequency 1) ;

+int abs (frequency 1) ;

+int min (frequency 1) .

+

+

+

+test real operation :

+

+notice heading ("Real Operationen") ;

+

+real assign (frequency 1) ;

+row real (frequency 1) ;

+real equal (frequency 1) ;

+real lequal (frequency 1) ;

+real add (frequency 1) ;

+real mult (frequency 2) ;

+real div (frequency 2) ;

+real incr (frequency 1) ;

+real mod (frequency 2) ;

+real abs (frequency 1) ;

+real min (frequency 1) .

+

+

+

+test text operation :

+

+notice heading ("Text Operationen") ;

+

+text assign 1 (frequency 1) ;

+text assign 10 (frequency 1) ;

+text assign 30 (frequency 1) ;

+row text (frequency 1) ;

+text equal 1 (frequency 1) ;

+text equal 10 (frequency 1) ;

+text equal 30 (frequency 1) ;

+text lequal 1 (frequency 1) ;

+text lequal 10 (frequency 1) ;

+text lequal 30 (frequency 1) ;

+text mult (frequency 1) ; 

+cat (frequency 1) ;

+text add 1 (frequency 1) ;

+text add 10 (frequency 2) ;

+text add 30 (frequency 2) ;

+text length 1 (frequency 1) ;

+text length 10 (frequency 1) ;

+text length 30 (frequency 1) ;

+text sub 1 (frequency 1) ;

+text sub 10 (frequency 1) ;

+text sub 30 (frequency 1) ;

+subtext 1 (frequency 1) ;

+subtext 10 (frequency 1) ;

+subtext 30 (frequency 1) ;

+replace 1 (frequency 1) ;

+replace 10 (frequency 1) ;

+replace 30 ( frequency 1) ;

+text 1 (frequency 2) ;

+text 10 (frequency 2) ;

+text 30 (frequency 2) ;

+pos 1 (frequency 1) ;

+pos 10 (frequency 1) ;

+pos 30 (frequency 1) .

+

+

+

+test convert :

+

+notice heading ("Konvertierungs Operationen") ;

+

+real to int (frequency 1) ;

+int to real (frequency 1) ;

+text to int (frequency 2) ;

+int to text (frequency 1) ;

+int to text 2 (frequency 2) ;

+real to text (frequency 2) ;

+real to text 2 (frequency 2) ;

+code int (frequency 1) ;

+code text (frequency 1) ;

+

+

+END PROC test speed ;

+

+END PACKET speed tester 

diff --git a/app/speedtest/1986/src/text operation b/app/speedtest/1986/src/text operation
new file mode 100644
index 0000000..30ad2ba
--- /dev/null
+++ b/app/speedtest/1986/src/text operation
@@ -0,0 +1,1401 @@
+PACKET text operation DEFINES text assign 1, 

+                              text assign 10, 

+                              text assign 30, 

+                              row text,

+                              text mult,

+                              cat,

+                              text equal 1,

+                              text equal 10,

+                              text equal 30,

+                              text lequal 1,

+                              text lequal 10,

+                              text lequal 30,

+                              text add 1,

+                              text add 10,

+                              text add 30, 

+                              text length 1,

+                              text length 10,

+                              text length 30,

+                              text sub 1,

+                              text sub 10,

+                              text sub 30,

+                              subtext 1,

+                              subtext 10,

+                              subtext 30, 

+                              replace 1,

+                              replace 10,

+                              replace 30,

+                              text 1,

+                              text 10,

+                              text 30,

+                              pos 1,

+                              pos 10,

+                              pos 30 :

+

+

+(***************************************************************************)

+(*                                                                         *)

+(*  Autor: A. Steinmann                        Copyright (C): HRZ - Unibi  *)

+(*                                                                         *)

+(***************************************************************************)

+

+

+ROW 10 TEXT VAR text row ;

+

+INT VAR index,

+        i, 

+        j ;

+ 

+REAL VAR begin,

+         end, 

+         act result,

+         text assign factor ;

+

+TEXT VAR single text :: "*",

+         short text :: "ELAN/EUMEL",

+         long text :: "Ein Multi User Betriebssystem!", 

+         free text ;

+

+

+

+

+PROC text assign 1 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := single text

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text assign 1 s (frequency)

+

+END PROC text assign 1 ;

+

+

+

+ 

+PROC text assign 1 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := single text

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  text assign factor := act result * msec factor (frequency) - for corr ;

+

+  notice result ("TEXT := (1)", text assign factor) 

+

+END PROC text assign 1 s ;

+

+

+

+

+PROC text assign 10 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := short text

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text assign 10 s (frequency)

+

+END PROC text assign 10 ;

+

+

+

+ 

+PROC text assign 10 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := short text

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT := (10)", act result * msec factor (frequency) - for corr) 

+

+END PROC text assign 10 s ;

+

+

+

+

+PROC text assign 30 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := long text

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text assign 30 s (frequency)

+

+END PROC text assign 30 ;

+

+

+

+ 

+PROC text assign 30 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := long text

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT := (30)", act result * msec factor (frequency) - for corr) 

+

+END PROC text assign 30 s ;

+

+

+

+

+PROC row text (INT CONST frequency) :

+

+  i := 7 ;

+  text row [i] := "" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          text row [i] := single text 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  row text s (frequency)

+

+END PROC row text ;

+

+

+

+ 

+PROC row text s (INT CONST frequency) :

+

+  i := 7 ;

+  text row [i] := "" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          text row [i] := single text 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("ROW TEXT [i]", act result * msec factor (frequency) - for corr)

+

+END PROC row text s ;

+

+

+

+

+PROC text equal 1 (INT CONST frequency) : 

+ 

+  free text := single text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = single text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text equal 1 s (frequency)

+

+END PROC text equal 1 ;

+

+

+

+ 

+PROC text equal 1 s (INT CONST frequency) : 

+ 

+  free text := single text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = single text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT = (1)", act result * msec factor (frequency) - for corr)

+

+END PROC text equal 1 s ;

+

+

+

+

+PROC text equal 10 (INT CONST frequency) : 

+ 

+  free text := short text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = short text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text equal 10 s (frequency)

+

+END PROC text equal 10 ;

+

+

+

+ 

+PROC text equal 10 s (INT CONST frequency) : 

+ 

+  free text := short text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = short text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT = (10)", act result * msec factor (frequency) - for corr)

+

+END PROC text equal 10 s ;

+

+

+

+

+PROC text equal 30 (INT CONST frequency) : 

+ 

+  free text := long text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = long text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text equal 30 s (frequency)

+

+END PROC text equal 30 ;

+

+

+

+ 

+PROC text equal 30 s (INT CONST frequency) : 

+ 

+  free text := long text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text = long text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT = (30)", act result * msec factor (frequency) - for corr)

+

+END PROC text equal 30 s ;

+

+

+

+

+PROC text lequal 1 (INT CONST frequency) : 

+ 

+  free text := single text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= single text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text lequal 1 s (frequency)

+

+END PROC text lequal 1 ;

+

+

+

+ 

+PROC text lequal 1 s (INT CONST frequency) : 

+ 

+  free text := single text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= single text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT <= (1)", act result * msec factor (frequency) - for corr)

+

+END PROC text lequal 1 s ;

+

+

+

+

+PROC text lequal 10 (INT CONST frequency) : 

+ 

+  free text := short text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= short text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text lequal 10 s (frequency)

+

+END PROC text lequal 10 ;

+

+

+

+ 

+PROC text lequal 10 s (INT CONST frequency) : 

+ 

+  free text := short text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= short text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT <= (10)", act result * msec factor (frequency) - for corr)

+

+END PROC text lequal 10 s ;

+

+

+

+

+PROC text lequal 30 (INT CONST frequency) : 

+ 

+  free text := long text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= long text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text lequal 30 s (frequency)

+

+END PROC text lequal 30 ;

+

+

+

+ 

+PROC text lequal 30 s (INT CONST frequency) : 

+ 

+  free text := long text ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          IF free text <= long text

+             THEN

+          FI

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT <= (30)", act result * msec factor (frequency) - for corr)

+

+END PROC text lequal 30 s ;

+

+

+

+

+PROC text mult (INT CONST frequency) :

+ 

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := i * single text

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  text mult s (frequency)

+

+END PROC text mult ;

+

+

+

+ 

+PROC text mult s (INT CONST frequency) :

+ 

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := i * single text

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT * (Faktor 1)", act result * msec factor (frequency) - for corr)

+ 

+END PROC text mult s ;

+

+

+

+

+PROC cat (INT CONST frequency) :

+

+  free text := "" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text CAT single text ;

+          free text := ""

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  cat s (frequency)

+

+END PROC cat ;

+

+

+

+ 

+PROC cat s (INT CONST frequency) :

+

+  free text := "" ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text CAT single text ;

+          free text := ""

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("CAT (1)", act result * msec factor (frequency) - for corr)

+ 

+END PROC cat s ;

+

+

+

+

+PROC text add 1 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := single text + single text

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text add 1 s (frequency)

+

+END PROC text add 1 ;

+

+

+

+

+PROC text add 1 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := single text + single text

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT + (1)", act result * msec factor (frequency) - for corr) 

+

+END PROC text add 1 s ;

+

+

+

+PROC text add 10 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := short text + short text 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text add 10 s (frequency)

+

+END PROC text add 10 ;

+

+

+

+ 

+PROC text add 10 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := short text + short text 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT + (10)", act result * msec factor (frequency) - for corr) 

+

+END PROC text add 10 s ;

+

+

+

+

+PROC text add 30 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := long text + long text 

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text add 30 s (frequency)

+

+END PROC text add 30 ;

+

+

+

+ 

+PROC text add 30 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := long text + long text 

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("TEXT + (30)", act result * msec factor (frequency) - for corr) 

+

+END PROC text add 30 s ;

+

+

+

+

+PROC text length 1 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (single text)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text length 1 s (frequency)

+

+END PROC text length 1 ;

+

+

+

+ 

+PROC text length 1 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (single text)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("length (1)", act result * msec factor (frequency) - for corr)

+

+END PROC text length 1 s ;

+

+

+

+

+PROC text length 10 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (short text)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text length 10 s (frequency)

+

+END PROC text length 10 ;

+

+

+

+ 

+PROC text length 10 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (short text)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("length (10)", act result * msec factor (frequency) - for corr)

+

+END PROC text length 10 s ;

+

+

+

+

+PROC text length 30 (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (long text)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text length 30 s (frequency)

+

+END PROC text length 30 ;

+

+

+

+ 

+PROC text length 30 s (INT CONST frequency) :

+

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          i := length (long text)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("length (30)", act result * msec factor (frequency) - for corr)

+

+END PROC text length 30 s ;

+

+

+

+

+PROC text sub 1 (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := single text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text sub 1 s (frequency)

+

+END PROC text sub 1 ;

+

+

+

+ 

+PROC text sub 1 s (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := single text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("SUB (1)", act result * msec factor (frequency) - for corr)

+

+END PROC text sub 1 s ;

+

+

+

+

+PROC text sub 10 (INT CONST frequency) :

+

+  i := 7 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := short text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text sub 10 s (frequency)

+

+END PROC text sub 10 ;

+

+

+

+ 

+PROC text sub 10 s (INT CONST frequency) :

+

+  i := 7 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := short text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("SUB (10)", act result * msec factor (frequency) - for corr)

+

+END PROC text sub 10 s ;

+

+

+

+

+PROC text sub 30 (INT CONST frequency) :

+

+  i := 17 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := long text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+

+  text sub 30 s (frequency)

+

+END PROC text sub 30 ;

+

+

+

+ 

+PROC text sub 30 s (INT CONST frequency) :

+

+  i := 17 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := long text SUB i

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("SUB (30)", act result * msec factor (frequency) - for corr)

+

+END PROC text sub 30 s ;

+

+

+

+

+PROC subtext 1 (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (single text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  subtext 1 s (frequency)

+

+END PROC subtext 1 ;

+

+

+

+ 

+PROC subtext 1 s (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (single text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("subtext (TEXT, INT, INT) (1)", act result * msec factor (frequency) - for corr)

+

+END PROC subtext 1 s ;

+

+

+

+

+PROC subtext 10 (INT CONST frequency) :

+

+  i := 7 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (short text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  subtext 10 s (frequency)

+

+END PROC subtext 10 ;

+

+

+

+ 

+PROC subtext 10 s (INT CONST frequency) :

+

+  i := 7 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (short text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("subtext (TEXT, INT, INT) (10)", act result * msec factor (frequency) - for corr)

+

+END PROC subtext 10 s ;

+

+

+

+

+PROC subtext 30 (INT CONST frequency) :

+

+  i := 17 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (long text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  subtext 30 s (frequency)

+

+END PROC subtext 30 ;

+

+

+

+ 

+PROC subtext 30 s (INT CONST frequency) :

+

+  i := 17 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency 

+      REP

+          free text := subtext (long text , i, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("subtext (TEXT, INT, INT) (30)", act result * msec factor (frequency) - for corr)

+

+END PROC subtext 30 s ;

+

+

+

+

+PROC replace 1 (INT CONST frequency) : 

+ 

+  i := 1 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (single text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  act result := end - begin ;

+

+  replace 1 s (frequency)

+

+END PROC replace 1 ;

+

+

+

+ 

+PROC replace 1 s (INT CONST frequency) : 

+ 

+  i := 1 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (single text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("replace (TEXT, TEXT, INT) (1)", act result * msec factor (frequency) - for corr)

+

+END PROC replace 1 s ;

+

+

+

+

+PROC replace 10 (INT CONST frequency) : 

+ 

+  i := 7 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (short text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  act result := end - begin ;

+

+  replace 10 s (frequency)

+

+END PROC replace 10 ;

+

+

+

+ 

+PROC replace 10 s (INT CONST frequency) : 

+ 

+  i := 7 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (short text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("replace (TEXT, TEXT, INT) (10)", act result * msec factor (frequency) - for corr)

+

+END PROC replace 10 s ;

+

+

+

+

+PROC replace 30 (INT CONST frequency) : 

+ 

+  i := 17 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (long text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  act result := end - begin ;

+

+  replace 30 s (frequency) 

+

+END PROC replace 30 ;

+

+

+

+ 

+PROC replace 30 s (INT CONST frequency) : 

+ 

+  i := 17 ; 

+  begin := clock (0) ; 

+  FOR index FROM 1 UPTO frequency 

+      REP 

+          replace (long text, i, single text) 

+      END REP ; 

+  end := clock (0) ; 

+ 

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("replace (TEXT, TEXT, INT) (30)", act result * msec factor (frequency) - for corr)

+

+END PROC replace 30 s ;

+

+

+

+

+PROC text 1 (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (single text, i, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  text 1 s (frequency)

+

+END PROC text 1 ;

+

+

+ 

+ 

+PROC text 1 s (INT CONST frequency) :

+

+  i := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (single text, i, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (TEXT, INT, INT) (1)", act result * msec factor (frequency) - for corr)

+

+END PROC text 1 s ;

+

+

+

+

+PROC text 10 (INT CONST frequency) :

+

+  i := 7 ;

+  j := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (short text, j, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  text 10 s (frequency)

+

+END PROC text 10 ;

+

+

+

+ 

+PROC text 10 s (INT CONST frequency) :

+

+  i := 7 ;

+  j := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (short text, j, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (TEXT, INT, INT) (10)", act result * msec factor (frequency) - for corr)

+

+END PROC text 10 s ;

+

+

+

+

+PROC text 30 (INT CONST frequency) :

+

+  i := 17 ;

+  j := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (long text, j, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  text 30 s (frequency)

+

+END PROC text 30 ;

+

+

+

+ 

+PROC text 30 s (INT CONST frequency) :

+

+  i := 17 ;

+  j := 1 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          free text := text (long text, j, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("text (TEXT, INT, INT) (30)", act result * msec factor (frequency) - for corr)

+

+END PROC text 30 s ;

+

+

+

+

+PROC pos 1 (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (single text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  pos 1 s (frequency)

+

+END PROC pos 1 ;

+

+

+

+ 

+PROC pos 1 s (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (single text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("pos (TEXT, TEXT, INT) (1)", act result * msec factor (frequency) - for corr)

+

+END PROC pos 1 s ;

+

+

+

+

+PROC pos 10 (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (short text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  pos 10 s (frequency)

+

+END PROC pos 10 ;

+

+

+

+ 

+PROC pos 10 s (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (short text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("pos (TEXT, TEXT, INT) (10)", act result * msec factor (frequency) - for corr)

+

+END PROC pos 10 s ;

+

+

+

+

+PROC pos 30 (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (long text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  act result := end - begin ;

+ 

+  pos 30 s (frequency)

+

+END PROC pos 30 ;

+

+

+

+ 

+PROC pos 30 s (INT CONST frequency) :

+

+  i := 1 ;

+  j := 0 ;

+  begin := clock (0) ;

+  FOR index FROM 1 UPTO frequency

+      REP

+          j := pos (long text, single text, i)

+      END REP ;

+  end := clock (0) ;

+

+  IF act result > end - begin

+     THEN act result := end - begin

+  FI ;

+

+  notice result ("pos (TEXT, TEXT, INT) (30)", act result * msec factor (frequency) - for corr)

+

+END PROC pos 30 s ;

+

+

+END PACKET text operation ;

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/tecal/TeCal b/app/tecal/1.8.7/src/TeCal
index 0bcb18e..0bcb18e 100644
--- a/tecal/TeCal
+++ b/app/tecal/1.8.7/src/TeCal
diff --git a/tecal/TeCal Auskunft b/app/tecal/1.8.7/src/TeCal Auskunft
index 9468265..9468265 100644
--- a/tecal/TeCal Auskunft
+++ b/app/tecal/1.8.7/src/TeCal Auskunft
diff --git a/tecal/TeCal.gen b/app/tecal/1.8.7/src/TeCal.gen
index c670db7..c670db7 100644
--- a/tecal/TeCal.gen
+++ b/app/tecal/1.8.7/src/TeCal.gen
diff --git a/devel/debug-copy/1986.07.11/source-disk b/devel/debug-copy/1986.07.11/source-disk
new file mode 100644
index 0000000..cafd9fe
--- /dev/null
+++ b/devel/debug-copy/1986.07.11/source-disk
@@ -0,0 +1 @@
+debug/debug-copy.img
diff --git a/devel/debug-copy/1986.07.11/src/copy files b/devel/debug-copy/1986.07.11/src/copy files
new file mode 100644
index 0000000..83b6f68
--- /dev/null
+++ b/devel/debug-copy/1986.07.11/src/copy files
@@ -0,0 +1,2977 @@
+PACKET copy worker DEFINES                    (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  copy worker,                                (* 11.07.86           *)
+  ds page nr feld,
+  block nr feld,
+  anzahl feld,
+  size feld,
+  check pointer feld,
+  check vektor start feld,
+  check vektor laenge:
+
+LET continue channel code = 200,
+    archive blocks   code = 201,
+    format disk      code = 202,
+    read             code = 203,
+    write            code = 204,
+    check read       code = 205,
+    init rerun test  code = 206;
+
+INT CONST ds page nr         feld :: 1,
+          block   nr         feld :: 2,
+          anzahl             feld :: 3,
+          size               feld :: 4,
+          check pointer      feld :: 9,
+          check vektor start feld :: 10,
+
+          check vektor laenge :: 19;
+
+LET ack       = 0;
+
+BOUND ROW 252 INT VAR align;
+
+BOUND STRUCT (ALIGN dummy, ROW 256 INT check row) VAR check struct;
+DATASPACE VAR check ds;
+INITFLAG VAR check ds initialisiert := FALSE;
+
+INT VAR old session;
+
+PROC copy worker:
+  access catalogue;
+  global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) copy worker)
+
+END PROC copy worker;
+
+PROC copy worker (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task):
+  enable stop;
+  INT VAR dummy; dummy := phase; (* so schalte ich eine warnung ab *)
+  ueberpruefe zugriffsberechtigung von order task;
+  SELECT order OF
+    CASE continue channel code: do continue channel (ds, order task)
+    CASE archive blocks   code: do archive blocks (ds, order task)
+    CASE format disk      code: do format disk (ds, order task)
+    CASE read             code: do read (ds, order task)
+    CASE write            code: do write (ds, order task)
+    CASE check read       code: do check read (ds, order task)
+    CASE init rerun test  code: do init rerun test (ds, order task)
+    OTHERWISE error stop ("falscher Auftrag")
+  END SELECT.
+
+ueberpruefe zugriffsberechtigung von order task:
+  IF NOT (order task = father (myself))
+    THEN error stop ("Unerlaubter Zugriff")
+  FI.
+
+END PROC copy worker;
+
+PROC do continue channel (DATASPACE VAR ds, TASK CONST order task):
+  BOUND INT VAR channel nr := ds;
+  continue channel (channel nr + 0);  (* + 0 --> keine Seiteneffekte *)
+  send (order task, ack, ds).
+
+END PROC do continue channel;
+
+PROC do archive blocks (DATASPACE VAR ds, TASK CONST order task):
+  enable stop;
+  check rerun;
+  BOUND INT VAR archive size := ds;
+  archive size := size (archive size);
+  send (order task, ack, ds).
+
+END PROC do archive blocks;
+
+PROC do init rerun test (DATASPACE VAR ds, TASK CONST order task):
+  old session := session;
+  send (order task, ack, ds).
+
+END PROC do init rerun test;
+
+PROC do format disk (DATASPACE VAR ds, TASK CONST order task):
+  enable stop;
+  check rerun;
+  BOUND INT VAR format code := ds;
+  format archive (format code);
+  send (order task, ack, ds).
+
+END PROC do format disk;
+
+PROC do read (DATASPACE VAR ds, TASK CONST order task):
+  enable stop;
+  align := ds;
+  INT CONST ds   start :: align [ds page nr feld],
+            disk start :: align [block   nr feld],
+            anzahl     :: align [anzahl     feld];
+  INT VAR return code, index;
+  FOR index FROM 0 UPTO anzahl - 1 REP
+    check rerun;
+    read block (ds, ds page nr, disk block nr, return code);
+    pruefe ob lesefehler
+  PER;
+  send (order task, ack, ds).
+
+pruefe ob lesefehler:
+  IF return code <> 0
+    THEN fehler melden
+  FI.
+
+fehler melden:
+  SELECT return code OF
+    CASE 1: errorstop ("Laufwerk nicht betriebsbereit") 
+    CASE 2: errorstop ("Lesefehler bei Block " + text (disk block nr)) 
+    CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) 
+    CASE 4: errorstop ("Block nicht lesbar " + text (disk block nr))
+    OTHERWISE errorstop ("Lesefehler " + text (return code))
+  END SELECT. 
+
+ds page nr:
+  ds start + index.
+
+disk block nr:
+  disk start + index.
+
+END PROC do read;
+
+PROC do write (DATASPACE VAR ds, TASK CONST order task):
+  enable stop;
+  align := ds;
+  INT CONST ds   start :: align [ds page nr feld],
+            disk start :: align [block   nr feld],
+            anzahl     :: align [anzahl     feld];
+  INT VAR return code, index;
+  FOR index FROM 0 UPTO anzahl - 1 REP
+    check rerun;
+    write block (ds, ds page nr, 0, disk block nr, return code);
+    pruefe ob schreibfehler
+  PER;
+  send (order task, ack, ds).
+
+pruefe ob schreibfehler:
+  IF return code <> 0
+    THEN fehler melden
+  FI.
+
+fehler melden:
+  SELECT return code OF
+    CASE 1: errorstop ("Laufwerk nicht betriebsbereit") 
+    CASE 2: errorstop ("Schreibfehler bei Block " + text (disk block nr)) 
+    CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) 
+    OTHERWISE errorstop ("Schreibfehler " + text (return code))
+  END SELECT. 
+
+ds page nr:
+  ds start + index.
+
+disk block nr:
+  disk start + index.
+
+END PROC do write;
+
+PROC do check read (DATASPACE VAR ds, TASK CONST order task):
+  enable stop;
+  IF NOT initialized (check ds initialisiert)
+    THEN check ds := nilspace;
+         check struct := check ds
+  FI;
+  align := ds;
+  INT CONST disk start :: align [block   nr feld],
+            anzahl     :: align [anzahl     feld];
+  INT VAR index;
+  INT VAR return code;
+  FOR index FROM 0 UPTO anzahl - 1 REP
+    check rerun;
+    read block (check ds, 2, disk block nr, return code);
+    pruefe ob lesefehler;
+    do check block
+  PER;
+  send (order task, ack, ds).
+
+pruefe ob lesefehler:
+  IF return code <> 0
+    THEN fehler melden
+  FI.
+
+fehler melden:
+  SELECT return code OF
+    CASE 1: errorstop ("Laufwerk nicht betriebsbereit") 
+    CASE 2: errorstop ("Lesefehler bei Block " + text (disk block nr)) 
+    CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) 
+    CASE 4: errorstop ("Block nicht lesbar " + text (disk block nr))
+    OTHERWISE errorstop ("Lesefehler " + text (return code))
+  END SELECT. 
+
+disk block nr:
+  disk start + index.
+
+do check block:
+  INT VAR block index;
+  FOR block index FROM 1 UPTO 256 REP
+    check vektor eintrag := check vektor eintrag XOR block eintrag;
+    incr check vektor pointer
+  PER.
+
+check vektor eintrag:
+  align [check vektor start feld + check pointer].
+
+check pointer:
+  align [check pointer feld].
+
+block eintrag:
+  check struct.check row [block index].
+
+incr check vektor pointer:
+  check pointer INCR 1;
+  IF check pointer = check vektor laenge
+    THEN check pointer := 0
+  FI.
+
+END PROC do check read;
+
+PROC check rerun:
+  IF session <> old session
+    THEN error stop ("Abbruch wegen RERUN")
+  FI.
+
+END PROC check rerun;
+
+END PACKET copy worker;
+PACKET copy io interface DEFINES              (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+                                              (* 21.11.86           *)
+  copy channel,
+  start copy worker,
+  initialisiere rerun test,
+  initialisiere diskettenzugriff,
+  formatiere diskette,
+  read,
+  check read,
+  write,
+  stop  copy worker:
+
+LET ack       = 0,
+    error nak = 2,
+    free code = 20;
+
+LET continue channel code = 200,
+    archive blocks   code = 201,
+    format disk      code = 202,
+    read             code = 203,
+    write            code = 204,
+    check read       code = 205,
+    init rerun test  code = 206;
+
+INT VAR reply;
+DATASPACE VAR ds := nilspace; forget (ds);
+
+BOUND ROW 252 INT VAR align;
+
+TASK VAR worker := niltask;
+INT VAR worker channel := 31;
+
+INT PROC copy channel:
+  worker channel
+
+END PROC copy channel;
+
+PROC copy channel (INT CONST channel nr):
+  worker channel := channel nr
+
+END PROC copy channel;
+
+PROC initialisiere rerun test:
+  forget (ds);
+  ds := nilspace;
+  call (worker, init rerun test code, ds, reply);
+  forget (ds).
+
+END PROC initialisiere rerun test;
+
+PROC start copy worker:
+  stop copy worker;
+  bestimme worker name;
+  starte worker;
+  kopple worker an kanal.
+
+bestimme worker name:
+  TEXT VAR worker name := "copy worker";
+  access catalogue;
+  BOUND THESAURUS CONST system catalogue :: syscat;
+  WHILE system catalogue CONTAINS worker name REP
+    worker name CAT "."
+  PER.
+
+starte worker:
+  begin (worker name, PROC copy worker, worker).
+
+kopple worker an kanal:
+  kanal freigeben falls diese task copy channel belegt;
+  forget (ds);
+  ds := nilspace;
+  BOUND INT VAR nr := ds;
+  nr := worker channel;
+  call (worker, continue channel code, ds, reply);
+  IF reply = error nak
+    THEN end (worker);
+         worker := niltask;
+         show error (ds)
+   ELIF reply <> ack
+    THEN end (worker);
+         worker := niltask;
+         forget (ds);
+         error stop ("copy worker nicht an Kanal " + text (worker channel) +
+                     " ankoppelbar")
+  FI;
+  forget (ds).
+
+kanal freigeben falls diese task copy channel belegt:
+  TASK CONST channel owner := task (copy channel);
+  IF NOT is niltask (channel owner) AND NOT (myself = channel owner)
+    THEN forget (ds); 
+         ds := nilspace; 
+         pingpong (channel owner, free code, ds, reply);
+         forget (ds)
+  FI.
+
+END PROC start copy worker;
+
+PROC initialisiere diskettenzugriff:
+  INT VAR dummy;
+  initialisiere diskettenzugriff (dummy)
+
+END PROC initialisiere diskettenzugriff;
+
+PROC initialisiere diskettenzugriff (INT VAR size):
+  initialisiere diskettenzugriff (0, size)
+
+END PROC initialisiere diskettenzugriff;
+
+PROC initialisiere diskettenzugriff (INT CONST mode, INT VAR size):
+  enable stop;
+  size := 0;
+  forget (ds);
+  ds := nilspace;
+  BOUND INT VAR i := ds;
+  i := mode;
+  call (worker, archive blocks code, ds, reply);
+  IF reply = error nak
+    THEN show error (ds)
+   ELSE i := ds;
+        size := i
+  FI;
+  forget (ds).
+
+END PROC initialisiere diskettenzugriff;
+
+PROC formatiere diskette (INT CONST modus):
+  enable stop;
+  forget (ds);
+  ds := nilspace;
+  BOUND INT VAR format param := ds;
+  format param := modus;
+  call (worker, format disk code, ds, reply);
+  IF reply = error nak
+    THEN show error (ds)
+  FI;
+  forget (ds).
+
+
+END PROC formatiere diskette;
+
+PROC read (DATASPACE VAR in ds, INT CONST erste ds seite, erster disk block,
+                                          anzahl bloecke):
+  enable stop;
+  align := in ds;
+  align [ds page nr feld] := erste ds seite;
+  align [block   nr feld] := erster disk block;
+  align [anzahl     feld] := anzahl bloecke;
+  call (worker, read code, in ds, reply);
+  IF reply = error nak
+    THEN show error (in ds)
+  FI.
+
+END PROC read;
+
+PROC write (DATASPACE VAR aus ds, INT CONST erste ds seite, erster disk block,
+                                            anzahl bloecke):
+  enable stop;
+  align := aus ds;
+  align [ds page nr feld] := erste ds seite;
+  align [block   nr feld] := erster disk block;
+  align [anzahl     feld] := anzahl bloecke;
+  call (worker, write code, aus ds, reply);
+  IF reply = error nak
+    THEN show error (aus ds)
+  FI.
+
+END PROC write;
+
+PROC check read (DATASPACE VAR in ds, INT CONST erster disk block,
+                                                anzahl bloecke):
+  enable stop;
+  align := in ds;
+  align [block   nr feld] := erster disk block;
+  align [anzahl     feld] := anzahl bloecke;
+  call (worker, check read code, in ds, reply);
+  IF reply = error nak
+    THEN show error (in ds)
+  FI.
+
+END PROC check read;
+
+PROC stop copy worker:
+  IF NOT (worker = niltask)
+    THEN disable stop;
+         end (worker);
+         worker := niltask;
+         clear error
+  FI.
+
+END PROC stop copy worker;
+
+PROC show error (DATASPACE CONST error ds):
+  BOUND TEXT VAR error msg := error ds;
+  error stop (error msg).
+
+END PROC show error;
+
+END PACKET copy io interface;
+PACKET copy utilities DEFINES                 (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+                                              (* 21.11.86           *)
+  ds start,
+  hg type,
+  disk type,
+  urlader type,
+  diskette anfordern,
+  disketten groesse zeigen,
+  ds name eingabe,
+  initialisiere check read,
+  check summe abspeichern,
+  check summen vergleichen, 
+  some,
+  list,
+  evtl diskette formatieren,
+  read and retry,
+  write and retry,
+  check read and retry:
+
+INT CONST hg type       :: 801,
+          disk type     :: 802,
+          urlader type  :: 803;
+
+INT CONST ds start :: 2;
+
+DATASPACE VAR list ds := nilspace; forget (list ds);
+DATASPACE VAR save ds := nilspace; forget (save ds);
+
+PROC diskette anfordern (TEXT CONST prompt):
+  WHILE NOT online REP pause (20) PER;
+  command dialogue (TRUE);
+  IF no (prompt)
+    THEN error stop ("Diskette nicht eingelegt")
+  FI;
+  line.
+
+END PROC diskette anfordern;
+
+PROC disketten groesse zeigen (INT CONST blocks):
+  putline ("die eingelegte Diskette enthält " + text (blocks DIV 2) + " KB");
+  line.
+
+END PROC disketten groesse zeigen;
+
+PROC ds name eingabe (TEXT VAR name, TEXT CONST name pre,
+                      BOOL CONST soll existieren, 
+                      TEXT CONST type vektor): 
+  enable stop;
+  IF soll existieren
+    THEN name eines existierenden ds bestimmen
+    ELSE name eines neuen ds bestimmen
+  FI.
+
+name eines existierenden ds bestimmen:
+  IF NOT name gueltig
+    THEN name := name pre
+  FI;
+  editget (name);
+  line;
+  WHILE NOT name gueltig REP
+    fehler zeigen;
+    IF yes ("neuen Namen angeben (sonst Abbruch)")
+      THEN put ("Eingabe:");
+           editget (name);
+           line
+      ELSE errorstop ("Abbruch, da Name fehlerhaft")
+    FI;
+  PER.
+
+name gueltig:
+  (name <> "") CAND (exists (name)) CAND type ok.
+
+type ok:
+  IF LENGTH type vektor = 0
+    THEN TRUE
+    ELSE INT CONST ds type := type (old (name));
+         INT VAR p;
+         FOR p FROM 1 UPTO length (type vektor) DIV 2 REP
+           IF ds type = (type vektor ISUB p)
+             THEN LEAVE type ok WITH TRUE
+           FI
+         PER;
+         FALSE
+  FI.
+
+fehler zeigen:
+  IF name = ""
+    THEN putline ("Kein Name angegeben")
+   ELIF NOT exists (name)
+    THEN putline ("""" + name + """ gibt es nicht")
+    ELSE putline ("""" + name + """ hat falschen Typ")
+  FI.
+
+name eines neuen ds bestimmen:
+  name := name pre;
+  editget (name);
+  line;
+  WHILE exists (name) OR (name = "") REP
+    IF name = ""
+      THEN put ("Kein Name eingegeben, Eingabe:");
+           editget (name);
+           line
+     ELIF yes ("alten Datenraum """ + name + """ löschen")
+      THEN forget (name, quiet)
+     ELIF yes ("neuen Namen angeben (sonst Abbruch)")
+      THEN put ("bitte Datenraumnamen angeben:");
+           editget (name);
+           line
+     ELSE error stop ("""" + name + """ existiert schon")
+     FI
+  PER.
+
+END PROC ds name eingabe;
+
+PROC initialisiere check read (DATASPACE VAR check read ds):
+  enable stop;
+  BOUND ROW 252 INT VAR align;
+  align := check read ds;
+  align [check pointer feld] := check vektor start feld;
+  INT VAR i;
+  FOR i FROM 0 UPTO check vektor laenge - 1 REP
+    align [check vektor start feld + i] := i
+  PER.
+
+END PROC initialisiere check read;
+
+PROC check summe abspeichern (TEXT CONST file name, DATASPACE CONST ds):
+  BOUND ROW 252 INT VAR align := ds;
+  FILE VAR f := sequential file (output, file name);
+  putline (f, "Prüfsumme");
+  INT VAR i;
+  FOR i FROM 0 UPTO check vektor laenge - 1 REP
+    putline (f, text (align [check vektor start feld + i]))
+  PER.
+
+END PROC check summe abspeichern;
+
+TEXT VAR edit type vektor := "  "; replace (edit type vektor, 1, 1003);
+
+PROC check summen vergleichen:
+  enable stop;
+  datei namen erfragen;
+  dateien vergleichen.
+
+datei namen erfragen:
+  TEXT VAR name1 := "prüf.",
+           name2 := "prüf.";
+  put ("Bitte Dateinamen der ersten  Prüfsummendatei eingeben:");
+  ds name eingabe (name1, "prüf.", TRUE, edit type vektor);
+  line;
+  put ("Bitte Dateinamen der zweiten Prüfsummendatei eingeben:");
+  ds name eingabe (name2, "prüf.", TRUE, edit type vektor);
+  line.
+
+dateien vergleichen:
+  FILE VAR f1 := sequential file (modify, name1);
+  FILE VAR f2 := sequential file (modify, name2);
+  INT VAR i;
+  FOR i FROM 1 UPTO check vektor laenge + 1 REP
+    vergleiche zeilen
+  PER;
+  putline ("Die Prüfsummen stimmen überein").
+
+vergleiche zeilen:
+  TEXT VAR zeile1, zeile2;
+  to line (f1, i);
+  to line (f2, i);
+  read record (f1, zeile1);
+  read record (f2, zeile2);
+  IF zeile1 <> zeile2
+    THEN putline (""7"FEHLER: UNTERSCHIEDLICHE PRÜFSUMMEN");
+         LEAVE check summen vergleichen
+  FI.
+
+END PROC check summen vergleichen;
+
+THESAURUS PROC some (THESAURUS CONST ur, INT CONST ds type):
+  THESAURUS VAR ziel := empty thesaurus;
+  TEXT VAR name;
+  INT VAR index := 0;
+  get (ur, name, index);
+  WHILE index > 0 REP
+    IF type (old (name)) = ds type
+      THEN insert (ziel, name)
+    FI;
+    get (ur, name, index);
+  PER;
+  ziel.
+
+END PROC some;
+
+PROC list (THESAURUS CONST list thes, TEXT CONST head text):
+  disable stop;
+  forget (list ds);
+  list ds := nilspace;
+  FILE VAR list file := sequential file (output, list ds);
+  headline (list file, head text);
+  INT VAR index := 0;
+  TEXT VAR name;
+  get (list thes, name, index);
+  WHILE index > 0 REP
+    putline (list file, name);
+    get (list thes, name, index);
+  PER;
+  show (list file);
+  forget (list ds).
+
+END PROC list;
+
+PROC read and retry (DATASPACE VAR in ds, INT CONST erste ds seite, erster disk block,
+                                                    anzahl bloecke):
+  disable stop;
+  forget (save ds);
+  save ds := in ds;
+  read (in ds, erste ds seite, erster disk block, anzahl bloecke);
+  WHILE is error REP
+    putline (""4"" + error message);
+    forget (in ds);
+    in ds := save ds;
+    IF yes ("noch ein Versuch")
+      THEN clear error;
+           read (in ds, erste ds seite, erster disk block, anzahl bloecke);
+      ELSE forget (save ds); enable stop
+    FI;
+    line
+  PER;
+  forget (save ds).
+
+
+END PROC read and retry;
+
+PROC write and retry (DATASPACE VAR out ds, INT CONST erste ds seite, erster disk block,
+                                                    anzahl bloecke):
+  disable stop;
+  forget (save ds);
+  save ds := out ds;
+  write (out ds, erste ds seite, erster disk block, anzahl bloecke);
+  WHILE is error REP
+    putline (""4"" + error message);
+    forget (out ds);
+    out ds := save ds;
+    IF yes ("noch ein Versuch")
+      THEN clear error;
+           write (out ds, erste ds seite, erster disk block, anzahl bloecke);
+      ELSE forget (save ds); enable stop
+    FI;
+    line
+  PER;
+  forget (save ds).
+
+END PROC write and retry;
+
+PROC check read and retry (DATASPACE VAR in ds, INT CONST erster disk block,
+                                                          anzahl bloecke):
+  disable stop;
+  forget (save ds);
+  save ds := in ds;
+  check read (in ds, erster disk block, anzahl bloecke);
+  WHILE is error REP
+    putline (""4"" + error message);
+    forget (in ds);
+    in ds := save ds;
+    IF yes ("noch ein Versuch")
+      THEN clear error;
+           check read (in ds, erster disk block, anzahl bloecke);
+      ELSE enable stop
+    FI;
+    line
+  PER.
+
+END PROC check read and retry;
+
+TEXT VAR formatierschluessel := "0";
+
+PROC evtl diskette formatieren:
+  command dialogue (TRUE);
+  IF yes ("Diskette zuerst formatieren")
+    THEN disable stop;
+         put ("Formatiercode:"); edit get (formatierschluessel);
+         formatiere diskette (int (formatierschluessel));
+         line;
+         WHILE is error REP
+           putline (""4"" + error message);
+           IF yes ("noch ein Versuch")
+             THEN clear error;
+                  put ("Formatiercode:"); edit get (formatierschluessel);
+                  formatiere diskette (int (formatierschluessel));
+                  line
+             ELSE enable stop
+           FI;
+         PER;
+         enable stop;
+  FI;
+  line.
+
+END PROC evtl diskette formatieren;
+
+END PACKET copy utilities;
+PACKET info DEFINES                           (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+                                              (* 20.08.86           *)
+  informationen ausgeben,
+  urlader informationen von diskette ausgeben,
+  urlader informationen von datenraum ausgeben,
+  hg informationen von diskette ausgeben,
+  hg informationen von datenraum ausgeben:
+
+TEXT VAR hg vektor := "  "; replace (hg vektor, 1, hg type);
+
+TEXT VAR hg urlader vektor := "    "; replace (hg urlader vektor, 1, hg type);
+                                      replace (hg urlader vektor, 2, urlader type);
+
+
+BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds struct;
+DATASPACE VAR ds work := nilspace; forget (ds work);
+
+INT VAR disk size;
+
+TEXT VAR versions nr;
+
+TEXT CONST eumel kennzeichen :: "EUMEL-";
+INT  CONST eumel kennzeichen wort 0 :: eumel kennzeichen ISUB 1,
+           eumel kennzeichen wort 1 :: eumel kennzeichen ISUB 2,
+           eumel kennzeichen wort 2 :: (eumel kennzeichen ISUB 3) AND 255;
+
+TEXT VAR ds name := "";
+
+PROC hg informationen von diskette ausgeben:
+  disable stop;
+  enable hg informationen von diskette ausgeben;
+  forget (ds work).
+
+END PROC hg informationen von diskette ausgeben;
+
+PROC enable hg informationen von diskette ausgeben:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  erste diskette anfordern;
+  relevante bloecke lesen;
+  informationen ausgeben (ds work, TRUE, TRUE).
+
+erste diskette anfordern:
+  command dialogue (TRUE);
+  diskette anfordern ("erste Hintergrunddiskette eingelegt");
+  cursor (1, 19); out (""4"").
+
+relevante bloecke lesen:
+  initialisiere disketten zugriff (0, disk size);
+  read (ds work, ds start, 0, 1);
+  read (ds work, ds start + 10, 10, 1).
+
+END PROC enable hg informationen von diskette ausgeben;
+
+PROC urlader informationen von diskette ausgeben:
+  disable stop;
+  enable urlader informationen von diskette ausgeben;
+  forget (ds work).
+
+END PROC urlader informationen von diskette ausgeben;
+
+PROC enable urlader informationen von diskette ausgeben:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  erste diskette anfordern;
+  relevante bloecke lesen;
+  informationen ausgeben (ds work, FALSE, TRUE).
+
+erste diskette anfordern:
+  diskette anfordern ("Urlader-Diskette eingelegt");
+  cursor (1, 19); out (""4"").
+
+relevante bloecke lesen:
+  initialisiere disketten zugriff (0, disk size);
+  read (ds work, ds start + 10, 10, 1).
+
+END PROC enable urlader informationen von diskette ausgeben;
+
+PROC hg informationen von datenraum ausgeben:
+  disable stop;
+  hg ds namen bestimmen;
+  ds work := old (ds name);
+  informationen ausgeben (ds work, TRUE, TRUE);
+  forget (ds work).
+
+hg ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "HG", TRUE, hg vektor);
+  cursor (1, 19); out (""4"").
+
+END PROC hg informationen von datenraum ausgeben;
+
+PROC urlader informationen von datenraum ausgeben:
+  disable stop;
+  urlader ds namen bestimmen;
+  ds work := old (ds name);
+  informationen ausgeben (ds work, FALSE, TRUE);
+  forget (ds work).
+
+urlader ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "", TRUE, hg urlader vektor);
+  cursor (1, 19); out (""4"").
+
+END PROC urlader informationen von datenraum ausgeben;
+
+PROC informationen ausgeben (DATASPACE CONST ds, 
+                             BOOL CONST hg info, urlader info): 
+  enable stop;
+  ds struct := ds;
+  IF hg info
+    THEN hg info ausgeben
+  FI;
+  IF urlader info
+    THEN urlader info ausgeben
+  FI.
+
+hg info ausgeben:
+  teste eumelkennzeichen;
+  versionsnummer ausgeben;
+  hg groesse ausgeben.
+
+teste eumelkennzeichen:
+  IF (eumelkennzeichen wort 0 <> ds struct.row [1]) OR
+     (eumelkennzeichen wort 1 <> ds struct.row [2]) OR
+     (eumelkennzeichen wort 2 <> (ds struct.row [3] AND 255)) OR
+     (NOT no plus hg AND (ds struct.row [43] <> 0))
+     (* ds struct.row [43]  <--> Sequenznummer *)
+    THEN error stop ("die Diskette ist nicht die erste Diskette eines EUMEL Hintergrundes")
+  FI.
+
+versionsnummer ausgeben:
+  versions nr := 6 * " ";
+  replace (versions nr, 1, ds struct.row [4]);
+  replace (versions nr, 2, ds struct.row [5]);
+  replace (versions nr, 3, ds struct.row [6]);
+  put ("EUMEL Hintergrund-Versionsnummer: " + versions nr);
+  IF NOT no plus hg
+    THEN put ("  (grosse Speicherverwaltung)");
+  FI;
+  line.
+
+hg groesse ausgeben:
+  IF no plus hg
+    THEN putline ("      Hintergrund-Größe:          " + text (4 * ds struct.row [19]) + " KB")
+    ELSE putline ("      Hintergrund-Größe:          " + text ((ds struct.row [41] + 1) DIV 2) + " KB")
+  FI.
+
+no plus hg:
+  (ds struct.row [41] = 1) AND (ds struct.row [42] = 0).
+
+urladerinfo ausgeben:
+  IF diskette enthaelt urlader
+    THEN urlader informationen vorhanden
+   ELIF hg info
+    THEN putline ("Diskette enthält keinen Urlader")
+    ELSE error stop ("Diskette enthält keinen Urlader")
+  FI.
+
+diskette enthaelt urlader:
+  (eumelkennzeichen wort 0 =  ds struct.row [2561]) AND
+  (eumelkennzeichen wort 1 =  ds struct.row [2562]) AND
+  (eumelkennzeichen wort 2 = (ds struct.row [2563] AND 255)).
+
+urlader informationen vorhanden:
+  urlader format bestimmen;
+  put ("      Urladerversion:  "); put (urlader version);   line;
+  put ("      Urlader-CPU-Type:"); put (cpu type);          line;
+  put ("      SHardversion min:"); put (shard version min); line;
+  put ("      SHardversion max:"); put (shard version max);
+  put ("            ").
+
+urladerformat bestimmen:
+  BOOL VAR motorola format := (ds struct.row [2571] = 1024).
+
+urlader version:
+  INT VAR dummy := ds struct.row [2572];
+  TEXT VAR ur ver := "";
+  IF motorola format
+    THEN rotate (dummy, 8);
+         INT CONST monate :: dummy DIV 100,
+                   tag    :: dummy MOD 100;
+         ur ver := text (tag);
+         ur ver CAT ".";
+         ur ver CAT text (m68000 monat);
+         ur ver CAT ".";
+         ur ver CAT text (84 + (monate - 1) DIV 12)
+    ELSE ur ver := "#" + text (dummy)
+  FI;
+  ur ver.
+
+m68000 monat:
+  IF monate MOD 12 = 0
+    THEN 12
+    ELSE monate MOD 12
+  FI.
+
+shard version min:
+  IF motorola format
+    THEN dummy := ds struct.row [2573];
+         rotate (dummy, 8)
+    ELSE dummy := ds struct.row [2574];
+  FI;
+  dummy.
+
+shard version max:
+  IF motorola format
+    THEN dummy := ds struct.row [2574];
+         rotate (dummy, 8)
+    ELSE dummy := ds struct.row [2575];
+  FI;
+  dummy.
+
+cpu type:
+  INT CONST cpu int :: ds struct.row [2571];
+  IF cpu int = 1
+    THEN "Z 80"
+   ELIF cpu int = 3
+    THEN "INTEL 8086 / 8088"
+   ELIF cpu int = 1024
+    THEN "Motorola 68000"
+    ELSE text (cpu int)
+  FI.
+
+END PROC informationen ausgeben;
+
+END PACKET info;
+PACKET gigads DEFINES                         (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  GIGADS,                                     (* 11.07.86           *)
+
+  giga ds size,
+  :=,
+  old zuweisen,
+  main,
+  forget,
+  copy,
+  read and retry,
+  write and retry,
+  informationen ausgeben,
+  type:
+ 
+LET max ds no = 10;
+
+TYPE GIGADS = ROW max ds no DATASPACE;
+
+INT VAR xgigads size;
+
+PROC gigads size (INT CONST max block no):
+  xgigads size := max block no
+
+END PROC giga ds size;
+
+INT PROC last used ds:
+  (xgigads size DIV 2000) + 1
+
+END PROC last used ds;
+
+INT PROC ds no (INT CONST page no):
+  (page no DIV 2000) + 1.
+
+END PROC ds no;
+
+INT PROC ds page no (INT CONST page no):
+  IF ds no (page no) = 1
+    THEN page no
+    ELSE (page no MOD 2000) + 2
+  FI.
+
+END PROC ds page no;
+
+TEXT PROC name (TEXT CONST pre, INT CONST no):
+  IF no = 1
+    THEN pre
+    ELSE pre + ".hintergrund datenraum extension nummer " + text (no - 1)
+  FI.
+
+END PROC name;
+
+OP := (GIGADS VAR gig, DATASPACE CONST ds):
+  gig [1] := ds;
+  INT VAR count;
+  FOR count FROM 2 UPTO max ds no REP
+    gig [count] := nilspace
+  PER
+
+END OP :=;
+
+DATASPACE PROC main (GIGADS CONST gig):
+  gig [1]
+
+END PROC main;
+
+PROC type (GIGADS VAR gig, INT CONST value):
+  INT VAR count;
+  FOR count FROM 1 UPTO max ds no REP
+    type (gig [count], value)
+  PER.
+
+END PROC type;
+
+INT PROC type (GIGADS CONST gig):
+  INT CONST value :: type (gig [1]);
+  INT VAR count;
+  FOR count FROM 2 UPTO max ds no REP
+    IF type (gig [count]) <> value
+      THEN error stop ("GIGADS inconsistent")
+    FI
+  PER;
+  value.
+
+END PROC type;
+
+PROC forget (GIGADS VAR gig):
+  INT VAR count;
+  FOR count FROM 1 UPTO max ds no REP
+    forget (gig [count])
+  PER.
+
+END PROC forget;
+
+PROC copy (GIGADS CONST gig, TEXT CONST name0):
+  IF exists (name 0)
+    THEN error stop ("""" + name0 + """ existiert schon")
+  FI;
+  INT VAR count;
+  FOR count FROM 1 UPTO last used ds REP
+    forget (name (name 0, count), quiet);
+    copy (gig [count], name (name 0, count))
+  PER
+
+END PROC copy;
+
+PROC old zuweisen (GIGADS VAR gig, TEXT CONST name0):
+  gig [1] := old (name0);
+  INT VAR count;
+  FOR count FROM 2 UPTO max ds no REP
+    IF exists (name (name0, count))
+      THEN gig [count] := old (name (name0, count))
+      ELSE gig [count] := nilspace
+    FI
+  PER.
+
+END PROC old zuweisen;
+
+PROC read and retry (GIGADS VAR gig,
+                     INT CONST erste ds seite, erster disk block, anzahl bloecke):
+  INT CONST no1 :: ds no (erste ds seite),
+            no2 :: ds no (erste ds seite + anzahl bloecke - 1);
+  IF no1 = no2
+    THEN read and retry (gig [no1], ds page no (erste ds seite),
+                         erster disk block, anzahl bloecke)
+    ELSE INT VAR count;
+         FOR count FROM 0 UPTO anzahl bloecke - 1 REP
+           read and retry (gig [ds no (erste ds seite + count)],
+                           ds page no (erste ds seite + count),
+                           erster disk block + count, 1);
+         PER
+  FI.
+
+END PROC read and retry;
+
+PROC write and retry (GIGADS VAR gig, INT CONST erste ds seite, erster disk block,
+                                      anzahl bloecke):
+  INT CONST no1 :: ds no (erste ds seite),
+            no2 :: ds no (erste ds seite + anzahl bloecke - 1);
+  IF no1 = no2
+    THEN write and retry (gig [no1], ds page no (erste ds seite),
+               erster disk block, anzahl bloecke)
+    ELSE INT VAR count;
+         FOR count FROM 0 UPTO anzahl bloecke - 1 REP
+           write and retry (gig [ds no (erste ds seite + count)],
+                 ds page no (erste ds seite + count),
+                 erster disk block + count, 1)
+         PER
+  FI.
+
+END PROC write and retry;
+
+PROC informationen ausgeben (GIGADS CONST gig, BOOL CONST b1, b2):
+  informationen ausgeben (gig [1], b1, b2)
+
+END PROC informationen ausgeben;
+
+END PACKET gigads;
+
+PACKET copy hg DEFINES                        (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  hg lesen,                                   (* 11.07.86           *)
+  hg schreiben,
+  hg check sum:
+
+TEXT VAR hg vektor := "  "; replace (hg vektor, 1, hg type);
+
+TEXT VAR ds name := "";
+
+INT VAR disk size,
+        hg   bloecke verarbeitet,
+        hg   bloecke zu verarbeiten,
+        disk bloecke verarbeitet;
+
+BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds work struct;
+GIGADS VAR ds work := nilspace; forget (ds work);
+
+DATASPACE VAR check ds := nilspace; forget (check ds);
+
+PROC hg lesen: 
+  disable stop;
+  enable hg lesen;
+  forget (ds work).
+
+END PROC hg lesen;
+
+PROC enable hg lesen:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  ds work struct := main (ds work);
+  type (ds work, hg type);
+  diskette anfordern ("erste zu lesende Hintergrunddiskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  header bloecke lesen;
+  informationen ausgeben (ds work, TRUE, TRUE);
+  line (2);
+  ds work namen bestimmen;
+  IF plus version
+    THEN hintergrund rest lesen plus version
+    ELSE hintergrundrest lesen no plus version
+  FI;
+  copy (ds work, ds name).
+
+header bloecke lesen:
+  read and retry (ds work, ds start, 0, 1);
+  read and retry (ds work, ds start + 10, 10, 1);
+  hg   bloecke verarbeitet := 1;
+  disk bloecke verarbeitet := 1.
+
+ds work namen bestimmen:
+  put ("bitte Datenraumnamen angeben:");
+  ds name eingabe (ds name, "HG", FALSE, "");
+  line.
+
+plus version:
+  NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0)).
+
+END PROC enable hg lesen;
+
+PROC hintergrund rest lesen no plus version:
+  disketten groesse zeigen (disk size);
+  hg bloecke zu verarbeiten := 8 * ds work struct.row [19];
+  giga ds size (hg bloecke zu verarbeiten + ds start);
+  status zeigen;
+  WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP
+    IF disk bloecke verarbeitet = disk size
+      THEN neue diskette anfordern
+    FI;
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+neue diskette anfordern:
+  diskette anfordern (""4"nächste zu lesende Hintergrunddiskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  line;
+  disketten groesse zeigen (disk size);
+  disk bloecke verarbeitet := 0.
+
+naechsten satz bloecke lesen:
+  bestimme anzahl zu lesender bloecke;
+  read and retry (ds work, ds start + hg bloecke verarbeitet,
+                  disk bloecke verarbeitet, anzahl zu lesender bloecke);
+  hg   bloecke verarbeitet INCR anzahl zu lesender bloecke;
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+bestimme anzahl zu lesender bloecke:
+  INT CONST anzahl zulesender bloecke :: min (moegliche hg bloecke auf disk, 20).
+
+moegliche hg bloecke auf disk:
+  min (hg bloecke zu verarbeiten - hg bloecke verarbeitet,
+       disk size - disk bloecke verarbeitet).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline ("Hintergrund:       " + text (hg bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         out (""3""3""13"")
+  FI.
+
+END PROC hintergrund rest lesen no plus version;
+
+PROC hintergrundrest lesen plus version:
+  BOOL VAR letzte diskette gelesen;
+  TEXT VAR sequenz nr map := 100 * " ";
+  INT VAR letzte sequenz nr;
+  hg bloecke zu verarbeiten := ds work struct.row [41] + 1;
+  giga ds size (hg bloecke zu verarbeiten + ds start);
+  hg bloecke verarbeitet := 1;
+  hg etikett merken;
+  lies diskette;
+  WHILE NOT ganzer hg gelesen REP
+    naechste diskette anfordern;
+    lies diskette
+  PER;
+  hg etikett herstellen.
+
+hg etikett merken:
+  TEXT VAR null etikett := 512 * " ";
+  INT VAR i;
+  FOR i FROM 1 UPTO 256 REP
+    replace (null etikett, i, ds work struct.row [i])
+  PER.
+
+hg etikett herstellen:
+  FOR i FROM 1 UPTO 256 REP
+    ds work struct.row [i] := null etikett ISUB i
+  PER.
+
+ganzer hg gelesen:
+  letzte diskette gelesen CAND
+  (subtext (sequenz nr map, 1, letzte sequenz nr) = (letzte sequenz nr * "R")).
+
+naechste diskette anfordern:
+  diskette anfordern (""4"naechste zu lesende Hintergrunddiskette eingelegt");
+  initialisiere diskettenzugriff (0, disk size);
+  line;
+  IF NOT etikett kompatibel zu null etikett
+    THEN error stop ("Diskette gehoert nicht zu dem bisher verarbeiteten Hintergrund")
+  FI.
+
+etikett kompatibel zu null etikett:
+  read and retry (ds work, ds start, 0, 1);
+  FOR i FROM 1 UPTO 40 REP
+    IF ds work struct.row [i] <> (null etikett ISUB i)
+      THEN LEAVE etikett kompatibel zu null etikett WITH FALSE
+    FI
+  PER;
+  FOR i FROM 46 UPTO 256 REP
+    IF ds work struct.row [i] <> (null etikett ISUB i)
+      THEN LEAVE etikett kompatibel zu null etikett WITH FALSE
+    FI
+  PER;
+  TRUE.
+
+lies diskette:
+  disketten groesse zeigen (disk size);
+  disk bloecke verarbeitet := 1;
+  INT CONST verschiebung :: ds work struct.row [44];
+  INT CONST letzter disk block :: min (disk size - 1, hg bloecke zu verarbeiten - verschiebung - 1);
+  status zeigen;
+  WHILE disk bloecke verarbeitet <= letzter disk block REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER;
+  INT CONST sequenz nr := ds work struct.row [43];
+  replace (sequenz nr map, sequenz nr, "R");
+  IF verschiebung + letzter disk block + 1 = hg bloecke zu verarbeiten
+    THEN letzte diskette gelesen := TRUE;
+         letzte sequenz nr := sequenz nr
+  FI.
+
+naechsten satz bloecke lesen:
+  read and retry (ds work, ds start + verschiebung + disk bloecke verarbeitet,
+                  disk bloecke verarbeitet, anzahl zu lesender bloecke);
+  hg bloecke verarbeitet INCR anzahl zu lesender bloecke;
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (letzter disk block - disk bloecke verarbeitet + 1, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline ("Hintergrund:       " + text (hg bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         out (""3""3""13"")
+  FI.
+
+END PROC hintergrund rest lesen plus version;
+
+PROC hg schreiben:
+  disable stop;
+  enable hg schreiben;
+  forget (ds work).
+
+END PROC hg schreiben;
+
+PROC enable hg schreiben:
+  enable stop;
+  initialisiere rerun test;
+  hg ds namen bestimmen;
+  old zuweisen (ds work, ds name);
+  ds work struct := main (ds work);
+  BOOL CONST plus version :: NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0));
+  informationen ausgeben (ds work, TRUE, TRUE);
+  line (2);
+  diskette anfordern ("erste zu beschreibende Diskette eingelegt");
+  evtl diskette formatieren;
+  initialisiere diskettenzugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  hintergrund schreiben;
+  bei plus version ersten hg block restaurieren.
+
+bei plus version ersten hg block restaurieren:
+  ds work struct.row [43] := 0;
+  ds work struct.row [44] := 0;
+  ds work struct.row [45] := 0.
+
+hg ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "HG", TRUE, hg vektor);
+  line.
+
+hintergrund schreiben:
+  INT VAR sequenz nr := 0;
+  hg   bloecke verarbeitet := 0;
+  disk bloecke verarbeitet := 0;
+  IF plus version
+    THEN hg bloecke zu verarbeiten := ds work struct.row [41] + 1
+    ELSE hg bloecke zu verarbeiten := 8 * ds work struct.row [19]
+  FI;
+  giga ds size (hg bloecke zu verarbeiten + ds start);
+  status zeigen;
+  WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP
+    IF disk bloecke verarbeitet = disk size
+      THEN neue diskette anfordern;
+           bei plus version etikett schreiben
+    FI;
+    naechsten satz bloecke schreiben;
+    status zeigen
+  PER.
+
+neue diskette anfordern:
+  diskette anfordern (""4"nächste zu beschreibende Diskette eingelegt");
+  evtl diskette formatieren;
+  initialisiere disketten zugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  disk bloecke verarbeitet := 0.
+
+bei plus version etikett schreiben:
+  IF plus version
+    THEN sequenz nr INCR 1;
+         ds work struct.row [43] := sequenz nr;
+         ds work struct.row [44] := hg bloecke verarbeitet - 1;
+         ds work struct.row [45] := 0;
+         write and retry (ds work, ds start, 0, 1);
+         disk bloecke verarbeitet := 1
+  FI.
+
+naechsten satz bloecke schreiben:
+  bestimme anzahl zu schreibender bloecke;
+  write and retry (ds work, ds start + hg bloecke verarbeitet,
+                   disk bloecke verarbeitet, anzahl zu schreibender bloecke);
+  hg   bloecke verarbeitet INCR anzahl zu schreibender bloecke;
+  disk bloecke verarbeitet INCR anzahl zu schreibender bloecke.
+
+bestimme anzahl zu schreibender bloecke:
+  INT CONST anzahl zuschreibender bloecke :: min (moegliche hg bloecke auf disk, 20).
+
+moegliche hg bloecke auf disk:
+  min (hg bloecke zu verarbeiten - hg bloecke verarbeitet,
+       disk size - disk bloecke verarbeitet).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline ("Hintergrund:       " + text (hg bloecke verarbeitet DIV 2, 4) + " KB geschrieben");
+         putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB geschrieben");
+         out (""3""3""13"")
+  FI.
+
+END PROC enable hg schreiben;
+
+PROC hg check sum:
+  disable stop;
+  enable hg check sum;
+  forget (check ds).
+
+END PROC hg check sum;
+
+PROC enable hg check sum:
+  enable stop;
+  initialisiere rerun test;
+  check ds := nilspace;
+  ds work struct := check ds;
+  diskette anfordern ("erste Hintergrunddiskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  relevante bloecke lesen;
+  hg etikett merken;
+  informationen ausgeben (check ds, TRUE, TRUE);
+  line (2);
+  check sum namen bestimmen;
+  hintergrund check sum berechnen;
+  check summe abspeichern (ds name, check ds).
+
+relevante bloecke lesen:
+  read and retry (check ds, ds start, 0, 1);
+  read and retry (check ds, ds start + 10, 10, 1).
+
+hg etikett merken:
+  TEXT VAR null etikett := 512 * " ";
+  INT VAR i;
+  FOR i FROM 1 UPTO 256 REP
+    replace (null etikett, i, ds work struct.row [i])
+  PER.
+
+check sum namen bestimmen:
+  putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:");
+  ds name eingabe (ds name, "prüf.HG", FALSE, "");
+  line.
+
+hintergrund check sum berechnen:
+  BOOL CONST plus version :: NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0));
+  IF plus version
+    THEN hg bloecke zu verarbeiten := ds work struct.row [41] + 1
+    ELSE hg bloecke zu verarbeiten := 8 * ds work struct.row [19]
+  FI;
+  INT VAR sequenz nr := 0;
+  hg   bloecke verarbeitet := 0;
+  disk bloecke verarbeitet := 0;
+  initialisiere check read (check ds);
+  disketten groesse zeigen (disk size);
+  status zeigen;
+  WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP
+    IF disk bloecke verarbeitet = disk size
+      THEN neue diskette anfordern
+    FI;
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+neue diskette anfordern:
+  diskette anfordern (""4"nächste Hintergrunddiskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  line;
+  disketten groesse zeigen (disk size);
+  sequenz nr INCR 1;
+  IF plus version
+    THEN disk bloecke verarbeitet := 1;
+         read and retry (check ds, ds start, 0, 1);
+         IF NOT etikett kompatibel zu null etikett
+           THEN error stop ("Diskette gehoert nicht zu dem bisher verarbeiteten Hintergrund")
+         FI;
+         IF ds work struct.row [43] <> sequenz nr
+           THEN error stop ("Falsche Reihenfolge der HG Disketten")
+         FI
+    ELSE disk bloecke verarbeitet := 0
+  FI.
+
+etikett kompatibel zu null etikett:
+  read and retry (check ds, ds start, 0, 1);
+  FOR i FROM 1 UPTO 40 REP
+    IF ds work struct.row [i] <> (null etikett ISUB i)
+      THEN LEAVE etikett kompatibel zu null etikett WITH FALSE
+    FI
+  PER;
+  FOR i FROM 46 UPTO 256 REP
+    IF ds work struct.row [i] <> (null etikett ISUB i)
+      THEN LEAVE etikett kompatibel zu null etikett WITH FALSE
+    FI
+  PER;
+  TRUE.
+
+naechsten satz bloecke lesen:
+  bestimme anzahl zu lesender bloecke;
+  check read and retry (check ds, disk bloecke verarbeitet, anzahl zu lesender bloecke);
+  hg   bloecke verarbeitet INCR anzahl zu lesender bloecke;
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+bestimme anzahl zu lesender bloecke:
+  INT CONST anzahl zulesender bloecke :: min (moegliche hg bloecke auf disk, 20).
+
+moegliche hg bloecke auf disk:
+  min (hg bloecke zu verarbeiten - hg bloecke verarbeitet,
+       disk size - disk bloecke verarbeitet).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline ("Hintergrund:       " + text (hg bloecke verarbeitet DIV 2, 4) + " KB verarbeitet");
+         putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB verarbeitet");
+         out (""3""3""13"")
+  FI.
+
+END PROC enable hg check sum;
+
+END PACKET copy hg;
+PACKET urlader copy DEFINES                   (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+                                              (* 22.08.86           *)
+  urlader check sum,
+  urlader von datenraum auf leere diskette schreiben,
+  urlader von datenraum auf hg diskette schreiben,
+  urlader von diskette in hg datenraum lesen,
+  urlader von diskette in leeren datenraum lesen:
+
+TEXT VAR ds name := "";
+
+TEXT VAR hg urlader vektor := "    "; replace (hg urlader vektor, 1, hg type);
+                                      replace (hg urlader vektor, 2, urlader type);
+
+INT VAR disk size;
+
+BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds struct;
+DATASPACE VAR ds work := nilspace; forget (ds work);
+DATASPACE VAR ds test := nilspace; forget (ds test);
+         
+PROC urlader von diskette in hg datenraum lesen:
+  urlader lesen (FALSE)
+
+END PROC urlader von diskette in hg datenraum lesen;
+
+PROC urlader von diskette in leeren datenraum lesen:
+  urlader lesen (TRUE)
+
+END PROC urlader von diskette in leeren datenraum lesen;
+
+PROC urlader lesen (BOOL CONST in leeren ds):
+  disable stop;
+  enable urlader lesen (in leeren ds);
+  forget (ds work).
+
+END PROC urlader lesen;
+
+PROC enable urlader lesen (BOOL CONST in leeren ds):
+  enable stop;
+  initialisiere rerun test;
+  diskette anfordern ("Urlader-Diskette eingelegt");
+  ersten urlader block lesen;
+  informationen ausgeben (ds work, FALSE, TRUE);
+  INT VAR urlader blocks := ds struct.row [2569];
+  IF motorola format
+    THEN rotate (urlader blocks, 8)
+  FI;
+  line (2);
+  ds work namen bestimmen;
+  ds work neu initialisieren;
+  urlader rest lesen;
+  IF exists (ds name) THEN forget (ds name, quiet) FI;
+  copy (ds work, ds name).
+
+ersten urlader block lesen:
+  ds work := nilspace;
+  ds struct := ds work;
+  initialisiere disketten zugriff (0, disk size);
+  read (ds work, ds start + 10, 10, 1).
+
+motorola format:
+  ds struct.row [2571] = 1024.
+
+ds work namen bestimmen:
+  put ("bitte Datenraumnamen angeben:");
+  IF in leeren ds
+    THEN ds name eingabe (ds name, "URLADER", FALSE, "")
+    ELSE ds name eingabe (ds name, "", TRUE, hg urlader vektor)
+  FI;
+  line.
+
+ds work neu initialisieren:
+  IF NOT in leeren ds
+    THEN forget (ds work);
+         ds work := old (ds name);
+         ds struct := ds work;
+         INT VAR space := ds struct.row [2569];
+         IF motorola format
+           THEN rotate (space, 8)
+         FI;
+         IF space < urlader blocks
+           THEN error stop ("Lücke für Urlader im Datenraum zu klein")
+         FI
+    ELSE type (ds work, urlader type)
+  FI.
+
+urlader rest lesen:
+  INT VAR urlader bloecke verarbeitet := 0;
+  status zeigen;
+  WHILE urlader bloecke verarbeitet < urlader blocks REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  read and retry (ds work, ds start + 10 + urlader bloecke verarbeitet,
+                  10 + urlader bloecke verarbeitet, anzahl zu lesender bloecke);
+  urlader bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (urlader blocks - urlader bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         out (""3""13"")
+  FI.
+
+END PROC enable urlader lesen;
+
+PROC urlader von datenraum auf leere diskette schreiben:
+  urlader schreiben (TRUE)
+
+END PROC urlader von datenraum auf leere diskette schreiben;
+
+PROC urlader von datenraum auf hg diskette schreiben:
+  urlader schreiben (FALSE)
+
+END PROC urlader von datenraum auf hg diskette schreiben;
+
+PROC urlader schreiben (BOOL CONST auf leere disk):
+  disable stop;
+  enable urlader schreiben (auf leere disk);
+  forget (ds test);
+  forget (ds work).
+
+END PROC urlader schreiben;
+
+PROC enable urlader schreiben (BOOL CONST auf leere disk):
+  enable stop;
+  initialisiere rerun test;
+  urlader ds namen bestimmen;
+  ds work := old (ds name);
+  ds struct := ds work;
+  INT VAR urlader blocks := ds struct.row [2569];
+  IF motorola format
+    THEN rotate (urlader blocks, 8)
+  FI;
+  informationen ausgeben (ds work, FALSE, TRUE);
+  line (2);
+  diskette anfordern ("zu beschreibende Diskette eingelegt");
+  IF auf leere disk
+    THEN evtl diskette formatieren;
+         initialisiere diskettenzugriff (0, disk size)
+    ELSE initialisiere diskettenzugriff (0, disk size);
+         platz fuer urlader ueberpruefen
+  FI;
+  urlader schreiben.
+
+urlader ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "", TRUE, hg urlader vektor);
+  line.
+
+motorola format:
+  ds struct.row [2571] = 1024.
+
+platz fuer urlader ueberpruefen:
+  TEXT CONST eumel kennzeichen :: "EUMEL-";
+  INT  CONST eumel kennzeichen wort 0 :: eumel kennzeichen ISUB 1,
+             eumel kennzeichen wort 1 :: eumel kennzeichen ISUB 2,
+             eumel kennzeichen wort 2 :: (eumel kennzeichen ISUB 3) AND 255;
+  ds test := nilspace;
+  ds struct := ds test;
+  read and retry (ds test, 2, 0, 1);
+  IF plus hg CAND sequenznummer falsch
+    THEN error stop ("Die eingelegte Diskette ist nicht erste Diskette eines Hintergrundes")
+  FI;
+  read and retry (ds test, 2, 10, 1);
+  IF NOT diskette enthaelt urlader COR luecke zu klein
+    THEN error stop ("Nicht genug Platz auf der Diskette; Urlader kann nicht geschrieben werden.")
+  FI.
+
+plus hg:
+  NOT ((ds struct.row [41] = 1) AND (ds struct.row [42] = 0)).
+
+sequenznummer falsch:
+  ds struct.row [43] <> 0.
+
+diskette enthaelt urlader:
+  (eumelkennzeichen wort 0 =  ds struct.row [1]) AND
+  (eumelkennzeichen wort 1 =  ds struct.row [2]) AND
+  (eumelkennzeichen wort 2 = (ds struct.row [3] AND 255)).
+
+luecke zu klein:
+  urlader blocks > ds struct.row [9].
+
+urlader schreiben:
+  INT VAR urlader bloecke verarbeitet := 0;
+  status zeigen;
+  WHILE urlader bloecke verarbeitet < urlader blocks REP
+    naechsten satz bloecke schreiben;
+    status zeigen
+  PER.
+
+naechsten satz bloecke schreiben:
+  write and retry (ds work, ds start + 10 + urlader bloecke verarbeitet,
+                   10 + urlader bloecke verarbeitet, anzahl zu schreibender bloecke);
+ 
+  urlader bloecke verarbeitet INCR anzahl zu schreibender bloecke.
+
+anzahl zu schreibender bloecke:
+  min (urlader blocks - urlader bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB geschrieben");
+         out (""3""13"")
+  FI.
+
+END PROC enable urlader schreiben;
+
+PROC urlader check sum:
+  disable stop;
+  enable urlader check sum;
+  forget (ds work).
+
+END PROC urlader check sum;
+
+PROC enable urlader check sum:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  ds struct := ds work;
+  diskette anfordern ("zu überprüfende Diskette eingelegt");
+  relevante bloecke lesen;
+  INT VAR urlader blocks := ds struct.row [2569];
+  IF motorola format
+    THEN rotate (urlader blocks, 8)
+  FI;
+  informationen ausgeben (ds work, FALSE, TRUE);
+  line (2);
+  check sum namen bestimmen;
+  urlader check sum berechnen;
+  check summe abspeichern (ds name, ds work).
+
+motorola format:
+  ds struct.row [2571] = 1024.
+
+relevante bloecke lesen:
+  initialisiere disketten zugriff (0, disk size);
+  read (ds work, ds start + 10, 10, 1).
+
+check sum namen bestimmen:
+  putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:");
+  ds name eingabe (ds name, "prüf.URLADER", FALSE, "").
+
+urlader check sum berechnen:
+  line;
+  INT VAR urlader bloecke verarbeitet := 0;
+  initialisiere check read (ds work);
+  status zeigen;
+  WHILE urlader bloecke verarbeitet < urlader blocks REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  check read and retry (ds work, 10 + urlader bloecke verarbeitet,
+                        anzahl zu lesender bloecke);
+  urlader bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (urlader blocks - urlader bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         out (""3""13"")
+  FI.
+
+END PROC enable urlader check sum;
+
+END PACKET urlader copy;
+PACKET copy dump DEFINES                      (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  show blocks:                                (* 11.07.86           *)
+
+TYPE BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);
+ 
+BLOCK VAR block; 
+ 
+DATASPACE VAR block ds; 
+ 
+TEXT VAR line text := 16 * "*";
+
+INITFLAG VAR this packet := FALSE;
+
+INT VAR disk size;
+
+INT VAR block nr;
+
+TEXT VAR command;
+
+PROC show blocks:
+  enable stop;
+  initialisiere rerun test;
+  access block space; 
+  block nr := 0;
+  diskette anfordern ("Diskette eingelegt");
+  initialisiere diskettenzugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  REP get command;
+      execute command
+  UNTIL end command
+  PER.
+
+access block space:
+  IF NOT initialized (this packet)
+    THEN block ds := nilspace
+  FI.
+
+get command:
+  line;
+  putline ("'+'  nächsten Block zeigen         'q'  Dump-Modus verlassen");
+  putline ("'-'  vorhergehenden Block zeigen   <nr> Block <nr> zeigen");
+  put (">"); 
+  get (command);
+  command := compress (command);
+  line.
+
+end command:
+  ((command SUB 1) = "q") OR ((command SUB 1) = "Q").
+
+execute command:
+  IF (command SUB 1) = "+"
+    THEN block nr INCR 1;
+         block zeigen
+   ELIF (command SUB 1) = "-"
+    THEN block nr DECR 1;
+         block zeigen;
+   ELIF (command SUB 1) = "q" OR (command SUB 1) = "Q"
+    THEN (* no op *)
+    ELSE INT VAR dummy := int (command);
+         IF last conversion ok
+           THEN block nr := dummy;
+                block zeigen
+           ELSE putline ("unzulässiges Kommando");
+                line
+         FI
+   FI.
+
+END PROC show blocks;
+
+PROC block zeigen:
+  block nr ueberpruefen;
+  block lesen;
+  CONCR (block) := block ds;
+  INT VAR zeile;
+  FOR zeile FROM 0 UPTO 31 REP
+    zeile zeigen
+  PER.
+
+block nr ueberpruefen:
+  IF block nr >= disk size
+    THEN putline ("Blocknummer zu hoch (maximal " + text (disk size -1) + ")");
+         block nr := disk size - 1;
+         LEAVE block zeigen
+   ELIF block nr < 0
+    THEN putline ("negative Blocknummer ist nicht erlaubt");
+         block nr := 0;
+         LEAVE block zeigen
+  FI.
+
+block lesen:
+  read and retry (block ds, 2, block nr, 1).
+
+zeile zeigen:
+  replace (line text, 1, block.block row [2 * zeile + 1]);
+  replace (line text, 2, block.block row [2 * zeile + 2]);  
+  TEXT VAR dump line := text (block nr, 4) + ":" + text (zeile * 16, 3) + "  ";
+  TEXT VAR char line := ""; 
+  INT VAR spalte;
+  FOR spalte FROM 1 UPTO 8 REP
+    cat char;
+    dump line CAT " "
+  PER;
+  dump line CAT " ";
+  FOR spalte FROM 9 UPTO 16 REP
+    cat char;
+    dump line CAT " "
+  PER;
+  dump line CAT " ";
+  dump line CAT charline;
+  IF incharety = ""27""
+    THEN LEAVE block zeigen
+  FI;
+  putline (dump line).
+
+cat char:
+  INT CONST char code := code (char);
+  LET hex chars = "0123456789ABCDEF";
+  dumpline CAT (hex chars SUB (char code DIV 16 + 1));
+  dumpline CAT (hex chars SUB (char code MOD 16 + 1));
+  charline CAT show char.
+
+show char:
+  IF (char code > 31 AND char code < 127)
+    THEN code (char code) 
+    ELSE "." 
+  FI.
+
+char:
+  line text SUB spalte.
+
+END PROC block zeigen;
+
+END PACKET copy dump;
+PACKET copy diskette DEFINES                  (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  diskette lesen,                             (* 11.07.86           *)
+  diskette schreiben,
+  diskette check sum:
+
+TEXT VAR disk type vektor := "  "; replace (disk type vektor, 1, disk type);
+
+TEXT VAR ds name := "";
+
+INT VAR disk size;
+
+BOUND ROW 252 INT VAR ds work row;
+DATASPACE VAR ds work := nilspace; forget (ds work);
+
+PROC diskette lesen:
+  disable stop;
+  enable diskette lesen;
+  forget (ds work).
+
+END PROC diskette lesen;
+
+PROC enable diskette lesen:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  ds work row := ds work;
+  type (ds work, disk type);
+  diskette anfordern ("zu lesende Diskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  ds work namen bestimmen;
+  diskette lesen;
+  size feld schreiben;
+  copy (ds work, ds name).
+
+size feld schreiben:
+  ds work row := ds work;
+  ds work row [size feld] := disk size.
+
+ds work namen bestimmen:
+  ds name := "";
+  put ("bitte Datenraumnamen angeben:");
+  ds name eingabe (ds name, "", FALSE, "");
+  line.
+
+diskette lesen:
+  INT VAR disk bloecke verarbeitet := 0;
+  status zeigen;
+  WHILE disk bloecke verarbeitet < disk size REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  read and retry (ds work, ds start + disk bloecke verarbeitet, disk bloecke verarbeitet,
+        anzahl zu lesender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (disk size - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen");
+         out (""3""13"")
+  FI.
+
+END PROC enable diskette lesen;
+
+PROC diskette schreiben:
+  disable stop;
+  enable diskette schreiben;
+  forget (ds work).
+
+END PROC diskette schreiben;
+
+PROC enable diskette schreiben:
+  enable stop;
+  initialisiere rerun test;
+  disk ds namen bestimmen;
+  ds work := old (ds name);
+  ds work row := ds work;
+  diskette anfordern ("zu beschreibende Diskette eingelegt");
+  evtl diskette formatieren;
+  initialisiere diskettenzugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  diskettengroesse ueberpruefen;
+  diskette schreiben.
+
+disk ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "", TRUE, disk type vektor);
+  line.
+
+diskettengroesse ueberpruefen:
+  IF ds work row [size feld] <> disk size
+    THEN putline (""7"ERROR: Datenraum enthält nicht genau eine Diskette");
+         putline ("       evtl. Menuepunkt 'Teil einer Diskette kopieren' verwenden");
+         pause (30);
+         error stop ("Datenraum enthält nicht genau eine Diskette")
+  FI.
+
+diskette schreiben:
+  INT VAR disk bloecke verarbeitet := 0;
+  status zeigen;
+  WHILE disk bloecke verarbeitet <  ds work row [size feld] REP
+    naechsten satz bloecke schreiben;
+    status zeigen
+  PER.
+
+naechsten satz bloecke schreiben:
+  write and retry (ds work, ds start + disk bloecke verarbeitet, disk bloecke verarbeitet,
+                   anzahl zu schreibender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu schreibender bloecke.
+
+anzahl zu schreibender bloecke:
+  min (ds work row [size feld] - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB geschrieben");
+         out (""3""13"")
+  FI.
+
+END PROC enable diskette schreiben;
+
+PROC diskette check sum:
+  disable stop;
+  enable diskette check sum;
+  forget (ds work).
+
+END PROC diskette check sum;
+
+PROC enable diskette check sum:
+  enable stop;
+  ds work := nilspace;
+  ds work row := ds work;
+  TEXT VAR name := "";
+  initialisiere rerun test;
+  diskette anfordern ("zu überprüfende Diskette eingelegt");
+  check sum namen bestimmen;
+  initialisiere diskettenzugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  check summe berechnen;
+  check summe abspeichern (name, ds work).
+
+check sum namen bestimmen:
+  putline ("bitte Dateinamen zum abspeichern der Prüfsumme angeben:");
+  ds name eingabe (name, "prüf.", FALSE, "");
+  line.
+
+check summe berechnen:
+  INT VAR disk bloecke verarbeitet := 0;
+  status zeigen;
+  initialisiere check read (ds work);
+  WHILE disk bloecke verarbeitet < disk size REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  check read and retry (ds work, disk bloecke verarbeitet, anzahl zu lesender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (disk size - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB verarbeitet");
+         out (""3""13"")
+  FI.
+
+END PROC enable diskette check sum;
+
+END PACKET copy diskette;
+PACKET copy disk part DEFINES                 (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+  disk part lesen,                            (* 31.07.86           *)
+  disk part schreiben,
+  disk part check sum:
+
+TEXT VAR disk type vektor := "  "; replace (disk type vektor, 1, disk type);
+
+TEXT VAR ds name := "";
+
+INT VAR disk size;
+INT VAR von sektor, bis sektor;
+
+BOUND ROW 252 INT VAR ds work row;
+DATASPACE VAR ds work := nilspace; forget (ds work);
+
+PROC disk part lesen:
+  disable stop;
+  enable disk part lesen;
+  forget (ds work).
+
+END PROC disk part lesen;
+
+PROC enable disk part lesen:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  ds work row := ds work;
+  type (ds work, disk type);
+  diskette anfordern ("zu lesende Diskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  grenzen bestimmen (disk size);
+  ds work namen bestimmen;
+  disk part lesen;
+  size feld schreiben;
+  copy (ds work, ds name).
+
+ds work namen bestimmen:
+  ds name := "";
+  put ("bitte Datenraumnamen angeben:");
+  ds name eingabe (ds name, "", FALSE, "");
+  line.
+
+size feld schreiben:
+  ds work row := ds work;
+  ds work row [size feld] := bis sektor - von sektor + 1.
+
+disk part lesen:
+  INT VAR disk bloecke verarbeitet := 0;
+  status zeigen;
+  WHILE disk bloecke verarbeitet < bis sektor - von sektor + 1 REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  read and retry (ds work, ds start + disk bloecke verarbeitet, von sektor + disk bloecke verarbeitet,
+                  anzahl zu lesender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (bis sektor - von sektor + 1 - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet, 4) + " Sektoren gelesen");
+         out (""3""13"")
+  FI.
+
+END PROC enable disk part lesen;
+
+PROC disk part schreiben:
+  disable stop;
+  enable disk part schreiben;
+  forget (ds work).
+
+END PROC disk part schreiben;
+
+PROC enable disk part schreiben:
+  enable stop;
+  initialisiere rerun test;
+  disk ds namen bestimmen;
+  ds work := old (ds name);
+  ds work row := ds work;
+  diskette anfordern ("zu beschreibende Diskette eingelegt");
+  evtl diskette formatieren;
+  initialisiere diskettenzugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  grenzen bestimmen (ds work row [size feld]);
+  disk part schreiben.
+
+disk ds namen bestimmen:
+  put ("Bitte Datenraumnamen eingeben:");
+  ds name eingabe (ds name, "", TRUE, disk type vektor);
+  line.
+
+disk part schreiben:
+  INT VAR disk bloecke verarbeitet := 0;
+  INT CONST disk bloecke zu verarbeiten :: bis sektor - von sektor + 1;
+  status zeigen;
+  WHILE disk bloecke verarbeitet < disk bloecke zu verarbeiten REP
+    naechsten satz bloecke schreiben;
+    status zeigen
+  PER.
+
+naechsten satz bloecke schreiben:
+  write and retry (ds work, ds start + disk bloecke verarbeitet, von sektor + disk bloecke verarbeitet,
+                   anzahl zu schreibender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu schreibender bloecke.
+
+anzahl zu schreibender bloecke:
+  min (disk bloecke zu verarbeiten - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet, 4) + " Sektoren geschrieben");
+         out (""3""13"")
+  FI.
+
+END PROC enable disk part schreiben;
+
+PROC disk part check sum:
+  disable stop;
+  enable disk part check sum;
+  forget (ds work).
+
+END PROC disk part check sum;
+
+PROC enable disk part check sum:
+  enable stop;
+  initialisiere rerun test;
+  ds work := nilspace;
+  diskette anfordern ("zu überprüfende Diskette eingelegt");
+  initialisiere disketten zugriff (0, disk size);
+  disketten groesse zeigen (disk size);
+  grenzen bestimmen (disk size);
+  check sum namen bestimmen;
+  check sum berechnen;
+  check summe abspeichern (ds name, ds work).
+
+check sum namen bestimmen:
+  putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:");
+  ds name eingabe (ds name, "prüf.", FALSE, "");
+  line.
+
+check sum berechnen:
+  INT VAR disk bloecke verarbeitet := 0;
+  initialisiere check read (ds work);
+  status zeigen;
+  WHILE disk bloecke verarbeitet < bis sektor - von sektor + 1 REP
+    naechsten satz bloecke lesen;
+    status zeigen
+  PER.
+
+naechsten satz bloecke lesen:
+  check read and retry (ds work, von sektor + disk bloecke verarbeitet, anzahl zu lesender bloecke);
+  disk bloecke verarbeitet INCR anzahl zu lesender bloecke.
+
+anzahl zu lesender bloecke:
+  min (bis sektor - von sektor + 1 - disk bloecke verarbeitet, 20).
+
+status zeigen:
+  IF online
+    THEN out (""13"");
+         putline (text (disk bloecke verarbeitet, 4) + " Sektoren gelesen");
+         out (""3""13"")
+  FI.
+
+END PROC enable disk part check sum;
+
+PROC disketten groesse zeigen (INT CONST blocks):
+  putline ("die eingelegte Diskette enthält die Sektoren 0 bis " + text (blocks - 1));
+  line.
+
+END PROC disketten groesse  zeigen;
+
+PROC grenzen bestimmen (INT CONST max anz bloecke):
+  INT VAR x,y;
+  REP
+    TEXT VAR ein := "0";
+    put ("erster Sektor:");
+    get cursor (x, y);
+    editget (ein);
+    von sektor := max (0, int (ein));
+    cursor (x, y);
+    out (""5"");
+    put (von sektor);
+    line;
+    put ("letzter Sektor:");
+    get cursor (x, y);
+    ein := text (min (disk size - 1, von sektor + max anz bloecke - 1));
+    editget (ein);
+(**)bis sektor := min (von sektor + max anz bloecke - 1, int (ein));
+(**)bis sektor := min (disk size - 1, bis sektor);
+    cursor (x, y);
+    out (""5"");
+    put (bis sektor);
+    line
+  UNTIL yes ("Eingaben richtig")
+  PER;
+  line.
+
+END PROC grenzen bestimmen;
+
+END PACKET copy disk part;
+PACKET menu handler DEFINES                        (* Autor: J.Liedtke *) 
+                                                   (*        R.Ruland  *) 
+                                                   (* Stand: 13.05.86  *)
+       menu monitor ,                              
+       menu out , 
+       next menu , 
+       menu param , 
+       set menu param , 
+       additional param , 
+       clear free lines , 
+       show key functions : 
+ 
+ 
+LET    menu width      = 77 , 
+       date pos        = 50 ,
+       time pos        = 63 ,
+       menu indent     = 6 , 
+       separate line   = 18 ,
+       first free line = 19 , 
+       max number of menu cases = 17 , 
+ 
+       blank = " " , 
+       left  = ""8"" ,
+       up    = ""3"" , 
+       down  = ""10"" , 
+       return= ""13"" , 
+       hop   = ""1"" , 
+       bell  = ""7"" , 
+       quote = """" , 
+       clear to end of line = ""5"" , 
+       clear to end of page = ""4"" ; 
+ 
+TEXT VAR param 1 := "" , param 2 , 
+         menu case list := "" , 
+         menu case := "", char := "",
+         last date := "";
+ 
+BOOL VAR screen changed, show keys ; 
+ 
+ 
+PROC next menu : 
+ 
+  screen changed := TRUE 
+ 
+ENDPROC next menu ; 
+ 
+PROC next menu (TEXT CONST key list) : 
+ 
+  next menu (key list, "") 
+ 
+ENDPROC next menu ; 
+ 
+PROC next menu (TEXT CONST key list, std case) : 
+ 
+  IF pos (key list, code (33), code (255), 1) > 0 
+     OR pos (key list, code (0), code (31), 1) > 0 
+     THEN menu case list := subtext (key list, 1, max number of menu cases) ; 
+  FI;
+  menu case := std case ; 
+  screen changed := TRUE ;
+ 
+ENDPROC next menu ; 
+ 
+ 
+PROC clear free lines : 
+ 
+  cursor (1, first free line) ; 
+  out (clear to end of page) . 
+ 
+ENDPROC clear free lines;
+ 
+ 
+PROC show key functions : 
+ 
+  show keys := TRUE; 
+ 
+END PROC show key functions; 
+ 
+ 
+PROC menu monitor (PROC (TEXT CONST) board , 
+                   PROC (TEXT CONST) execute , 
+                   TEXT CONST escape char) : 
+ 
+  disable stop ; 
+  page ; 
+  next menu ; 
+  show key functions;
+  REP 
+    show menu (PROC (TEXT CONST) board) ; 
+    screen changed := FALSE ;
+    show keys := FALSE;
+    select menu case (escape char) ; 
+    clear free lines ; 
+    IF is valid menu case AND char <> hop
+      THEN menu execute (PROC (TEXT CONST) execute) 
+    FI 
+  UNTIL menu escape occurred PER . 
+ 
+is valid menu case :    pos (menu case list, menu case) > 0 . 
+ 
+menu escape occurred :  menu case = escape char . 
+ 
+ENDPROC menu monitor ; 
+ 
+ 
+PROC show menu (PROC (TEXT CONST) board) : 
+ 
+  IF is error 
+    THEN show error ; 
+         clear error 
+  FI ; 
+  IF screen changed 
+    THEN show menu cases 
+  FI ; 
+  IF show keys
+     THEN explain keys; 
+  FI . 
+ 
+show error : 
+  IF less than three lines left 
+    THEN screen changed := TRUE 
+  FI ; 
+  clear free lines ;
+  put error .
+ 
+less than three lines left : 
+  INT VAR x, y; 
+  get cursor (x, y) ; 
+  y >= 22 . 
+ 
+show menu cases : 
+  clear board ; 
+  INT VAR i ; 
+  FOR i FROM 1 UPTO LENGTH menu case list REP 
+    cursor (menu indent, i) ; 
+    IF (menu case list SUB i) <> " " THEN board (menu case list SUB i) FI;
+  PER ;
+  out (hop) ;
+  4 TIMESOUT " " .
+ 
+clear board : 
+  out (hop) ; 
+  FOR i FROM 1 UPTO max number of menu cases REP 
+    out (clear to end of line) ; 
+    out (down) 
+  PER ; 
+  cursor (1, separate line);
+  out (clear to end of line) ; 
+  menu width TIMESOUT "-" ;
+  put date ;
+  put time . 
+ 
+ENDPROC show menu ; 
+ 
+PROC menu out (TEXT CONST menu line) : 
+ 
+  tab cursor ; 
+  INT VAR from := 1, to := pos (menu line, quote) - 1 ; 
+  IF param 1 <> ""
+     THEN WHILE to >= 0 REP 
+            menu outsubtext (menu line, from, to) ; 
+            menu outsubtext (quote, 1, 1) ; 
+            menu outsubtext (param 1, 1, LENGTH param 1) ; 
+            menu outsubtext (quote, 1, 1) ; 
+            from := to + 2 ; 
+            to := pos (menu line, quote, from) - 1 
+          PER ; 
+  FI;
+  menu outsubtext (menu line, from, LENGTH menu line) ; 
+  out (blank) . 
+ 
+tab cursor : 
+  INT VAR x, y; 
+  get cursor (x, y) ; 
+  IF x > menu indent AND x < menu width - 15 
+    THEN cursor ( (x-menu indent+14) DIV 15 * 15 + menu indent, y) 
+  FI . 
+ 
+ENDPROC menu out ; 
+ 
+PROC menu outsubtext (TEXT CONST t, INT CONST from, to) : 
+ 
+  outsubtext (t, from, min (menu width-cursor x, to-from) + from) . 
+ 
+cursor x : 
+  INT VAR x, y ; 
+  get cursor (x, y) ; 
+  x . 
+ 
+ENDPROC menu outsubtext ; 
+
+PROC put date :
+
+  INT VAR x, y;
+  get cursor (x, y);
+  cursor (date pos, separate line);
+  last date := date;
+  out (" ");
+  out (date);
+  out (" ");
+  cursor (x, y);
+
+END PROC put date;
+
+PROC put time :
+
+  INT VAR x, y;
+  get cursor (x, y);
+  cursor (time pos, separate line);
+  out (" ");
+  out (time of day);
+  out (" ");
+  IF last date <> date THEN put date FI;
+  cursor (x, y);
+
+END PROC put time;
+ 
+PROC select menu case (TEXT CONST escape char) : 
+ 
+  enable stop;
+  INT VAR menu index := pos (menu case list, menu case);
+  get default menu case ; 
+  REP 
+    REP UNTIL incharety = "" PER;
+    point to case ;
+    get char ;
+    IF   char = blank OR char = down    THEN menu down 
+    ELIF char = up                      THEN menu up 
+    ELIF char = return                  THEN leave and execute 
+    ELIF char = hop                     THEN leave and show new board 
+    ELIF char = escape char OR 
+         pos (menu case list, char) > 0 THEN menu index := 
+                                                  pos (menu case list, char); 
+                                             menu case := char ; 
+                                             leave and execute 
+    ELSE not allowed key 
+    FI 
+  PER . 
+ 
+get default menu case : 
+  IF LENGTH menu case <> 1 OR menu case = " " OR menu index = 0
+    THEN menu index := 0; 
+         WHILE menu index < LENGTH menu case list 
+         REP menu index INCR 1; 
+             menu case := menu case list SUB menu index; 
+             IF menu case <> " " THEN LEAVE get default menu case FI; 
+         PER; 
+  FI . 
+ 
+get char :
+  REP char := incharety (600) ;
+      put time ;
+  UNTIL char <> "" PER .
+
+menu down : 
+  REP menu index := menu index MOD cases + 1; 
+      menu case  := menu case list SUB menu index; 
+  UNTIL menu case <> " " PER . 
+ 
+menu up : 
+  REP menu index := (menu index - 2) MOD cases + 1; 
+      menu case  := menu case list SUB menu index; 
+  UNTIL menu case <> " " PER . 
+ 
+cases :        LENGTH menu case list . 
+ 
+point to case :
+  4 TIMESOUT left ; 4 TIMESOUT blank ;
+  cursor (menu indent-4, menu index) ; 
+  out ("--> ") .
+ 
+leave and execute : 
+  point to case ;
+  cursor (menu indent, first free line) ; 
+  LEAVE select menu case . 
+ 
+leave and show new board : 
+  next menu ; 
+  show key functions;
+  LEAVE select menu case . 
+ 
+not allowed key : 
+  out (bell) ; 
+  explain keys . 
+ 
+ENDPROC select menu case ; 
+ 
+ 
+PROC explain keys : 
+  clear free lines;
+  putline ("""-->"" - Funktion ausfuehren :      <RETURN>") ; 
+  putline ("andere Funktion anwaehlen :        <UP>  <DOWN>  <BLANK>") ; 
+  out     ("direkt anwaehlen und ausfuehren :") ; 
+  show menu case list ; 
+  putline ("Menutafel neu aufbauen :           <HOP>") ;
+  out (hop) ;
+  4 TIMESOUT " " .
+ 
+show menu case list : 
+  INT VAR i, j := 0; 
+  FOR i FROM 1 UPTO LENGTH menu case list REP 
+    IF j = 8 
+      THEN line ; 33 TIMESOUT blank; j INCR 1;
+    FI ; 
+    show one menu case 
+  PER ; 
+  line . 
+ 
+show one menu case : 
+  IF (menu case list SUB i) > " " 
+    THEN out ("  <") ; out (menu case list SUB i) ; out (">") ; j INCR 1 
+  FI . 
+ 
+END PROC explain keys; 
+ 
+ 
+PROC menu execute (PROC (TEXT CONST) execute) : 
+ 
+  enable stop ; 
+  execute (menu case) 
+ 
+ENDPROC menu execute ; 
+ 
+ 
+TEXT PROC menu param : 
+ 
+  param 1 
+ 
+ENDPROC menu param ; 
+ 
+PROC set menu param (TEXT CONST param) : 
+ 
+  param 1 := param 
+ 
+ENDPROC set menu param ; 
+ 
+TEXT PROC menu param (TEXT CONST prompt) : 
+ 
+  get param (prompt, param 1) ; 
+  param 1 
+ 
+ENDPROC menu param ; 
+ 
+TEXT PROC additional param (TEXT CONST prompt) : 
+ 
+  param 2 := "" ; 
+  get param (prompt, param 2) ; 
+  param 2 
+ 
+ENDPROC additional param ; 
+ 
+PROC additional param (TEXT CONST prompt, TEXT VAR param) : 
+ 
+  get param (prompt, param) ; 
+  param 2 := param;
+ 
+ENDPROC additional param ; 
+ 
+PROC get param (TEXT CONST prompt, TEXT VAR param) : 
+ 
+  cursor (menu indent, first free line) ; 
+  out prompt ; 
+  out (blank) ; 
+  in param ; 
+  cursor (menu indent, first free line) ; 
+  out (clear to end of line) . 
+ 
+out prompt : 
+  INT CONST 
+  prompt length := min (LENGTH prompt, menu width DIV 2 - menu indent) ; 
+  outsubtext (prompt, 1, prompt length) . 
+ 
+in param : 
+  editget (param, 255, menu width - menu indent - prompt length - 2) . 
+ 
+ENDPROC get param ; 
+ 
+ENDPACKET menu handler ; 
+PACKET copy menu DEFINES copy:                (* Copyright (C) 1986 *)
+                                              (* Frank Klapper      *)
+LET haupt menu          = 1,                  (* 11.07.86           *)
+    copy hg menu        = 2,
+    disk copy menu      = 3,
+    disk part copy menu = 4,
+    urlader copy menu   = 5;
+
+LET MENU = STRUCT (TEXT board keys, board);
+ 
+ROW 5 MENU VAR menu;
+
+menu [haupt menu]          := MENU: ("hudtDke"9"",   "  hu dt D k e "9" ");
+menu [copy hg menu]        := MENU: ("lspPLiI"9"",   "  ls pP L iI  "9" ");
+menu [urlader copy menu]   := MENU: ("lLsSpPziI"9"", " lL sS pP z iI "9"");
+menu [disk copy menu]      := MENU: ("lspPL"9"",     "    ls pP L   "9" ");
+menu [disk part copy menu] := MENU: ("lspPL"9"",     "    ls pP L   "9" ");
+
+INT VAR board index;
+
+TEXT VAR kommando := "";
+
+PROC copy:
+  enable stop;
+  start copy worker;
+  board index := haupt menu;
+  next menu (menu [board index].board, "h");
+  menu monitor (PROC (TEXT CONST) menu board,
+                PROC (TEXT CONST) menu operations, ""9"").
+ 
+END PROC copy;
+
+PROC menu board (TEXT CONST input key):
+  SELECT board index OF
+    CASE haupt menu         : main menu board (input key)
+    CASE urlader copy menu  : urlader copy menu board (input key)
+    CASE copy hg menu       : copy hg menu board (input key)
+    CASE disk copy menu     : disk copy menu board (input key)
+    CASE disk part copy menu: disk part copy menu board (input key)
+    OTHERWISE
+  END SELECT.
+
+END PROC menu board;
+ 
+PROC main menu board (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: menu out ("h       EUMEL-Hintergrund kopieren")
+    CASE 2: menu out ("u       EUMEL-Urlader kopieren")
+    CASE 3: menu out ("d       Diskette kopieren")
+    CASE 4: menu out ("t       Teil einer Diskette kopieren")
+    CASE 5: menu out ("D       Diskette dumpen")
+    CASE 6: menu out ("k       Kopierkanal einstellen (zur Zeit " + text (copy channel) + ")")
+    CASE 7: menu out ("e       beliebiges EUMEL-Kommando ausführen")
+    CASE 8: menu out ("TAB     Kopiermenu verlassen")
+    OTHERWISE
+  END SELECT.
+
+END PROC main menu board;
+
+PROC copy hg menu board (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: menu out ("l       EUMEL-Hintergrund von Diskette in Datenraum lesen")
+    CASE 2: menu out ("s       EUMEL-Hintergrund vom Datenraum auf Diskette schreiben")
+    CASE 3: menu out ("p       Prüfsumme über EUMEL-Hintergrunddisketten bilden")
+    CASE 4: menu out ("P       Prüfsummen vergleichen")
+    CASE 5: menu out ("L       Liste der Datenräume, die einen EUMEL-Hintergrund enthalten")
+    CASE 6: menu out ("i       Informationen über EUMEL-Hintergrund auf Diskette")
+    CASE 7: menu out ("I       Informationen über EUMEL-Hintergrund im Datenraum")
+    CASE 8: menu out ("TAB     Hintergrund-Kopiermenu verlassen")
+    OTHERWISE
+  END SELECT.
+
+END PROC copy hg menu board;
+
+PROC urlader copy menu board (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: menu out ("l       Urlader von Diskette in LEEREN Datenraum lesen")
+    CASE 2: menu out ("L       Urlader von Diskette in Datenraum mit EUMEL-HG lesen")
+    CASE 3: menu out ("s       Urlader vom Datenraum auf LEERE Diskette schreiben")
+    CASE 4: menu out ("S       Urlader vom Datenraum auf Diskette mit EUMEL-HG schreiben")
+    CASE 5: menu out ("p       Prüfsumme über Urlader auf Diskette bilden")
+    CASE 6: menu out ("P       Prüfsummen vergleichen")
+    CASE 7: menu out ("z       Liste der Datenräume, die einen EUMEL-Urlader enthalten")
+    CASE 8: menu out ("i       Informationen über EUMEL-Urlader auf Diskette")
+    CASE 9: menu out ("I       Informationen über EUMEL-Urlader im Datenraum")
+    CASE10: menu out ("TAB     Urlader-Kopiermenu verlassen")
+    OTHERWISE
+  END SELECT.
+
+END PROC urlader copy menu board;
+
+PROC disk copy menu board (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: menu out ("l       Diskette in Datenraum lesen")
+    CASE 2: menu out ("s       Datenraum auf Diskette schreiben")
+    CASE 3: menu out ("p       Prüfsumme über Diskette bilden")
+    CASE 4: menu out ("P       Prüfsummen vergleichen")
+    CASE 5: menu out ("L       Liste der Datenräume, die einen Disketteninhalt enthalten können")
+    CASE 6: menu out ("TAB     Disketten-Kopiermenu verlassen")
+    OTHERWISE
+  END SELECT.
+
+END PROC disk copy menu board;
+
+PROC disk part copy menu board (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: menu out ("l       Diskettenbereich in Datenraum lesen")
+    CASE 2: menu out ("s       Datenraum in Diskettenbereich schreiben")
+    CASE 3: menu out ("p       Prüfsumme über Diskettenbereich bilden")
+    CASE 4: menu out ("P       Prüfsummen vergleichen")
+    CASE 5: menu out ("L       Liste der Datenräume, die einen Diskettenbereich enthalten")
+    CASE 6: menu out ("TAB     Disketten-Kopiermenu verlassen")
+    OTHERWISE
+  END SELECT.
+
+END PROC disk part copy menu board;
+
+PROC menu operations (TEXT CONST input key):
+  SELECT board index OF
+    CASE haupt menu         : main menu operations (input key)
+    CASE urlader copy menu  : urlader copy operations (input key)
+    CASE copy hg menu       : copy hg menu operations (input key)
+    CASE disk copy menu     : disk copy menu operations (input key)
+    CASE disk part copy menu: disk part copy menu operations (input key)
+    OTHERWISE
+  END SELECT.
+
+END PROC menu operations;
+ 
+PROC main menu operations (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: copy hg menu aufrufen
+    CASE 2: urlader copy menu aufrufen
+    CASE 3: disk copy menu aufrufen
+    CASE 4: disk part copy menu aufrufen
+    CASE 5: disable stop; show blocks; refresh
+    CASE 6: kopier kanal einstellen
+    CASE 7: eumel kommando ausfuehren
+    CASE 8: stop copy worker
+    OTHERWISE error stop ("noch nicht implementiert")
+  END SELECT.
+
+copy hg menu aufrufen:
+  board index := copy hg menu;
+  next menu (menu [board index].board, "L").
+
+urlader copy menu aufrufen:
+  board index := urlader copy menu;
+  next menu (menu [board index].board, "z").
+
+disk copy menu aufrufen:
+  board index := disk copy menu;
+  next menu (menu [board index].board, "L").
+
+disk part copy menu aufrufen:
+  board index := disk part copy menu;
+  next menu (menu [board index].board, "L").
+
+kopier kanal einstellen:
+  enable stop;
+  TEXT VAR kanal := text (copy channel);
+  put ("Kanalnummer für den Diskettenzugriff:");
+  editget (kanal);
+  IF int (kanal) <> copy channel
+    THEN disable stop;
+         stop copy worker;
+         copy channel (int (kanal));
+         start copy worker;
+         IF is error
+           THEN push (""9"");
+                line;
+                putline (""7"ERROR: " + error message);
+                clear error;
+                pause (100);
+                copy channel (31)
+           ELSE refresh
+         FI;
+         enable stop
+  FI.
+
+eumel kommando ausfuehren:
+  putline ("gib kommando:");
+  editget (kommando);
+  line;
+  do (kommando);
+  IF NOT is error
+    THEN kommando := ""
+  FI;
+  next menu.
+
+END PROC main menu operations;
+
+PROC copy hg menu operations (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: disable stop; hg lesen; refresh
+    CASE 2: disable stop; hg schreiben; refresh
+    CASE 3: disable stop; hg check sum; refresh
+    CASE 4: check summen vergleichen
+    CASE 5: list (some (all, hg type), "EUMEL-Hintergrund-Datenräume"); refresh
+    CASE 6: hg informationen von diskette ausgeben
+    CASE 7: hg informationen von datenraum ausgeben
+    CASE 8: menu verlassen
+    OTHERWISE
+  END SELECT.
+
+menu verlassen:
+  board index := haupt menu;
+  next menu (menu [board index].board, "h").
+
+END PROC copy hg menu operations;
+
+PROC urlader copy operations (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: disable stop; urlader von diskette in leeren datenraum lesen; refresh
+    CASE 2: disable stop; urlader von diskette in hg datenraum lesen; refresh
+    CASE 3: disable stop; urlader von datenraum auf leere diskette schreiben; refresh
+    CASE 4: disable stop; urlader von datenraum auf hg diskette schreiben; refresh
+    CASE 5: disable stop; urlader check sum; refresh
+    CASE 6: check summen vergleichen
+    CASE 7: list (some (all, hg type) + some (all, urlader type), "EUMEL-Urlader-Datenräume"); refresh
+    CASE 8: urlader informationen von diskette ausgeben
+    CASE 9: urlader informationen von datenraum ausgeben
+    CASE10: menu verlassen
+    OTHERWISE
+  END SELECT.
+
+menu verlassen:
+  board index := haupt menu;
+  next menu (menu [board index].board, "u").
+
+END PROC urlader copy operations;
+
+PROC disk copy menu operations (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: disable stop; diskette lesen; refresh
+    CASE 2: disable stop; diskette schreiben; refresh
+    CASE 3: disable stop; diskette check sum; refresh
+    CASE 4: check summen vergleichen
+    CASE 5: list (some (all, disk type), "Datenräume mit Disketteninhalt"); refresh
+    CASE 6: menu verlassen
+    OTHERWISE
+  END SELECT.
+
+menu verlassen:
+  board index := haupt menu;
+  next menu (menu [board index].board, "d").
+
+END PROC disk copy menu operations;
+
+PROC disk part copy menu operations (TEXT CONST input key):
+  SELECT pos (menu [board index].board keys, input key) OF
+    CASE 1: disable stop; disk part lesen; refresh
+    CASE 2: disable stop; disk part schreiben; refresh
+    CASE 3: disable stop; disk part check sum; refresh
+    CASE 4: check summen vergleichen
+    CASE 5: list (some (all, disk type), "Datenräume mit Disketteninhalt"); refresh
+    CASE 6: menu verlassen
+    OTHERWISE
+  END SELECT.
+
+menu verlassen:
+  board index := haupt menu;
+  next menu (menu [board index].board, "t").
+
+END PROC disk part copy menu operations;
+
+PROC refresh:
+  clear free lines;
+  next menu.
+
+END PROC refresh;
+
+END PACKET copy menu;
+
+
diff --git a/devel/debug-ds4/1989/source-disk b/devel/debug-ds4/1989/source-disk
new file mode 100644
index 0000000..a1795f1
--- /dev/null
+++ b/devel/debug-ds4/1989/source-disk
@@ -0,0 +1 @@
+debug/debug-copy-std-ds.img
diff --git a/devel/debug-ds4/1989/src/RUN load ds4 b/devel/debug-ds4/1989/src/RUN load ds4
new file mode 100644
index 0000000..51d9a1f
--- /dev/null
+++ b/devel/debug-ds4/1989/src/RUN load ds4
@@ -0,0 +1,246 @@
+(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *) 
+ 
+(* 
+EUMEL0: 
+modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1 
+3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0 
+3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710 
+32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32666 
+1 16 17 18 32592 17 19 32666 1 22 18 0 32667 2 22 19 0 3090 3091 3092 11284 
+21 28750 32587 32583 1 32512 endc pbase: -256 0 0 0 0 1792 -256 1 0 0 3 256 
+0 5 0 -32768 9999 7 25 0 0 0 4 1 endp 
+*) 
+PACKET ds accesses DEFINES 
+  do, 
+  ds nr, 
+  forget all but not, 
+  set modul start ic, 
+  read ds, 
+  write ds, 
+: 
+INT CONST stdds := 4 + index(myself) * 256;  
+INT PROC read ds (INT CONST drid, add hi, add lo): 
+  EXTERNAL 154 
+END PROC read ds; 
+INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo): 
+  EXTERNAL 154 
+END PROC read ds; 
+PROC write ds (INT CONST drid, add hi, add lo, data): 
+  EXTERNAL 155 
+END PROC write ds; 
+PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data): 
+  EXTERNAL 155 
+END PROC write ds; 
+PROC forget (INT CONST ds): 
+  EXTERNAL 71 
+END PROC forget; 
+OP := (INT VAR left, DATASPACE CONST right): 
+   EXTERNAL 260 
+END OP :=; 
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 
+           INT VAR modul nr, BOOL CONST ins, lst, rt check, ser): 
+  EXTERNAL 256 
+END PROC elan; 
+PROC do (INT CONST modul nr): 
+  INT VAR modul no:= modul nr; 
+  DATASPACE VAR source; 
+  elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE); 
+END PROC do; 
+INT PROC ds nr (TEXT CONST name): 
+  INT VAR nr := old (name); nr 
+END PROC ds nr; 
+PROC forget all but not (INT CONST ds): 
+  INT VAR i, a; 
+  FOR i FROM 5 UPTO 255 REP 
+    a := i + 256 * index (myself); 
+    IF i <> ds MOD 256 THEN 
+      cout (i); forget (a); 
+    FI; 
+  PER 
+END PROC forget all but not; 
+PROC set modul start ic (INT CONST modul nr, ic hi, ic lo): 
+  IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI; 
+  IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN 
+    write ds (stdds, 0, modul nr + 512, ic lo); 
+  ELSE 
+    error stop ("Falsche Modulnummer: " + text (modul nr)); 
+  FI; 
+END PROC set modul start ic; 
+END PACKET ds accesses; 
+PACKET lader DEFINES 
+  lade, 
+: 
+INT CONST stdds := 4 + index (myself) * 256; 
+PROC check task index (TEXT CONST name): 
+  IF index (myself) = index copytask (old(name)) THEN 
+    putline ("Leider haben sie den gleichen Taskindex wie bei der Quelltask erwischt!"); 
+    errorstop("Bitte versuchen sie es mit einer neuen Task!"); 
+  FI; 
+END PROC check task index; 
+INT PROC index copytask (DATASPACE CONST ds): 
+  read ds (ds, 7, 9) 
+END PROC index copytask; 
+PROC get ic (FILE VAR f, INT VAR ic hi, ic lo): 
+  find text (f,"start:"); 
+  get int (f,ic hi); get int (f,ic lo); 
+  IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI; 
+END PROC get ic; 
+PROC get pbase (FILE VAR f, INT VAR ps): 
+  find text (f, "pbase:"); 
+  get int (f, ps); 
+  IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI; 
+END PROC get pbase; 
+PROC get modul (FILE VAR f, INT VAR modul nr): 
+  find text (f, "modul:"); 
+  get int (f, modul nr); 
+END PROC get modul; 
+PROC load code (FILE VAR f): 
+  INT VAR add hi, add lo, code wert; 
+  TEXT VAR code ende; 
+  check end code (f); 
+  get code add (f, add hi, add lo); 
+  REP 
+    get code (f, code wert, code ende); 
+    IF code ende = "end" THEN LEAVE load code FI; 
+    write ds (stdds, add hi, add lo, code wert); 
+    add lo INCR 1; 
+  PER 
+END PROC load code; 
+PROC load pbase (FILE VAR f): 
+  INT VAR  pbase add, pbase wert; 
+  TEXT VAR pbase ende; 
+  check end pbase (f); 
+  get pbase (f, pbase add); 
+  REP 
+    get pbase (f, pbase wert, pbase ende); 
+    IF pbase ende = "end" THEN LEAVE load pbase FI; 
+    write ds (stdds, 0, pbase add, pbase wert); 
+    pbase add INCR 1; 
+  PER 
+END PROC load pbase; 
+INT PROC read pbase var (FILE VAR f, INT CONST index): 
+  INT VAR pbase add; 
+  get pbase (f, pbase add); 
+  read ds (stdds, 0, pbase add+index) 
+END PROC read pbase var; 
+PROC write pbase var (FILE VAR f, INT CONST index, var): 
+  INT VAR pbase add; 
+  get pbase (f, pbase add); 
+  write ds (stdds, 0, pbase add+index, var); 
+END PROC write pbase var; 
+PROC get code add (FILE VAR f, INT VAR add hi, add lo): 
+  find text (f, "code:"); 
+  get int (f, add hi); get int (f, add lo); 
+  IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI; 
+END PROC get code add; 
+PROC get int (FILE VAR f, INT VAR value): 
+  IF eof (f) THEN error stop ("Daten fehlen") FI; 
+  TEXT VAR daten; 
+  get (f, daten); 
+  IF daten = "-32768" THEN 
+    value := -maxint-1; 
+  ELSE 
+    value := int (daten); 
+  ENDIF; 
+END PROC get int; 
+PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ): 
+  IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI; 
+  TEXT VAR daten ; 
+  get (f, daten); 
+  IF daten = "endc" THEN 
+    ende := "end" 
+  ELSE 
+    IF daten = "-32768" THEN 
+      value := -maxint-1; 
+    ELSE 
+      value := int (daten); 
+    ENDIF; 
+    ende := "no end" 
+  FI; 
+END PROC get code; 
+PROC check end code (FILE VAR f): 
+  find text (f, "endc"); 
+END PROC check end code; 
+PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende): 
+  IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI; 
+  TEXT VAR daten ; 
+  get (f, daten); 
+  IF daten = "endp" THEN 
+    ende := "end" 
+  ELSE 
+    IF daten = "-32768" THEN 
+      value := -maxint-1; 
+    ELSE 
+      value := int (daten); 
+    ENDIF; 
+    ende := "no end" 
+  FI; 
+END PROC get pbase; 
+PROC check end pbase (FILE VAR f): 
+  find text (f, "endp"); 
+END PROC check end pbase; 
+PROC find text (FILE VAR f, TEXT CONST suchtext): 
+  TEXT VAR t; 
+  go start (f); 
+  WHILE NOT eof (f) REP 
+    get (f, t); 
+    IF t = suchtext THEN LEAVE find text FI; 
+  PER; 
+  error stop (suchtext + " fehlt") 
+END PROC find text; 
+PROC go start (FILE VAR f): 
+  TEXT VAR t; 
+  reset (f); 
+  WHILE NOT eof (f) REP 
+    get (f, t); 
+    IF t = "EUMEL0:" THEN LEAVE go start FI 
+  PER; 
+  error stop ("EUMEL0-Code nicht gefunden"); 
+END PROC go start; 
+PROC run code (INT VAR ic hi, ic lo, modul nr): 
+  set modul start ic (modul nr, ic hi, ic lo); 
+  do push (modul nr); 
+END PROC run code; 
+PROC do push (INT CONST modul nr): 
+  IF lbase < 30000 THEN 
+    do push (modul nr); 
+  ELSE 
+    do (modul nr); LEAVE do push; 
+  FI; 
+END PROC do push; 
+INT PROC lbase: 
+  pcb (25) 
+END PROC lbase; 
+PROC lade (TEXT CONST datei name): 
+  INT VAR ic hi, ic lo, modul nr; 
+  line; 
+  putline ("Achtung: ALLE bis jetzt insertierten Packete der Task gehen verloren!"); 
+  IF NOT yes ("Wollen sie den Standarddatenraum ersetzen") THEN LEAVE lade FI; 
+  check task index (datei name); 
+  FILE VAR f := sequentialfile (input, dateiname); 
+  get ic (f, ic hi, ic lo); 
+  get modul (f, modul nr); 
+  load code (f); 
+  load pbase (f); 
+  load pbase var (f); 
+  run code (ic hi, ic lo, modul nr); 
+END PROC lade; 
+PROC load pbase var (FILE VAR f): 
+  INT VAR dss, dst; TEXT VAR name := "STD DS4"; 
+  line; 
+  put ("Wie heißt der Quelldatenraum:"); 
+  editget (name); 
+  line; 
+  IF NOT exists (name) THEN errorstop("Datei " + name + " gibt es nicht."); FI; 
+  dst := 4 + 256 * index (myself); 
+  dss := ds nr (name); 
+  write pbase var (f, 1, dss); 
+  write pbase var (f, 2, dst); 
+  forget all but not (dss); 
+END PROC load pbase var; 
+PROC lade: 
+  lade ("RUN load ds4"); 
+END PROC lade; 
+END PACKET lader; 
+lade; 
+
diff --git a/devel/debug-ds4/1989/src/RUN save ds4 b/devel/debug-ds4/1989/src/RUN save ds4
new file mode 100644
index 0000000..1fd542b
--- /dev/null
+++ b/devel/debug-ds4/1989/src/RUN save ds4
@@ -0,0 +1,223 @@
+(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *) 
+ 
+(* 
+EUMEL0: 
+modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1 
+3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0 
+3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710 
+32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32592 
+15 0 32667 2 17 15 0 3087 11279 16 28740 32587 32512 endc pbase: -256 0 0 0 
+0 1792 -256 1 0 0 3 256 0 5 0 -32768 0 32 7 endp 
+*) 
+PACKET ds accesses DEFINES 
+  do, 
+  ds nr, 
+  forget all but not, 
+  set modul start ic, 
+  read ds, 
+  write ds, 
+: 
+INT CONST stdds := 4 + index(myself) * 256;  
+INT PROC read ds (INT CONST drid, add hi, add lo): 
+  EXTERNAL 154 
+END PROC read ds; 
+INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo): 
+  EXTERNAL 154 
+END PROC read ds; 
+PROC write ds (INT CONST drid, add hi, add lo, data): 
+  EXTERNAL 155 
+END PROC write ds; 
+PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data): 
+  EXTERNAL 155 
+END PROC write ds; 
+PROC forget (INT CONST ds): 
+  EXTERNAL 71 
+END PROC forget; 
+OP := (INT VAR left, DATASPACE CONST right): 
+   EXTERNAL 260 
+END OP :=; 
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 
+           INT VAR modul nr, BOOL CONST ins, lst, rt check, ser): 
+  EXTERNAL 256 
+END PROC elan; 
+PROC do (INT CONST modul nr): 
+  INT VAR modul no:= modul nr; 
+  DATASPACE VAR source; 
+  elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE); 
+END PROC do; 
+INT PROC ds nr (TEXT CONST name): 
+  INT VAR nr := old (name); nr 
+END PROC ds nr; 
+PROC forget all but not (INT CONST ds): 
+  INT VAR i, a; 
+  FOR i FROM 5 UPTO 255 REP 
+    a := i + 256 * index (myself); 
+    IF i <> ds MOD 256 THEN 
+      cout (i); forget (a); 
+    FI; 
+  PER 
+END PROC forget all but not; 
+PROC set modul start ic (INT CONST modul nr, ic hi, ic lo): 
+  IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI; 
+  IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN 
+    write ds (stdds, 0, modul nr + 512, ic lo); 
+  ELSE 
+    error stop ("Falsche Modulnummer: " + text (modul nr)); 
+  FI; 
+END PROC set modul start ic; 
+END PACKET ds accesses; 
+PACKET lader DEFINES 
+  lade, 
+: 
+INT CONST stdds := 4 + index (myself) * 256; 
+PROC get ic (FILE VAR f, INT VAR ic hi, ic lo): 
+  find text (f,"start:"); 
+  get int (f,ic hi); get int (f,ic lo); 
+  IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI; 
+END PROC get ic; 
+PROC get pbase (FILE VAR f, INT VAR ps): 
+  find text (f, "pbase:"); 
+  get int (f, ps); 
+  IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI; 
+END PROC get pbase; 
+PROC get modul (FILE VAR f, INT VAR modul nr): 
+  find text (f, "modul:"); 
+  get int (f, modul nr); 
+END PROC get modul; 
+PROC load code (FILE VAR f): 
+  INT VAR add hi, add lo, code wert; 
+  TEXT VAR code ende; 
+  check end code (f); 
+  get code add (f, add hi, add lo); 
+  REP 
+    get code (f, code wert, code ende); 
+    IF code ende = "end" THEN LEAVE load code FI; 
+    write ds (stdds, add hi, add lo, code wert); 
+    add lo INCR 1; 
+  PER 
+END PROC load code; 
+PROC load pbase (FILE VAR f): 
+  INT VAR  pbase add, pbase wert; 
+  TEXT VAR pbase ende; 
+  check end pbase (f); 
+  get pbase (f, pbase add); 
+  REP 
+    get pbase (f, pbase wert, pbase ende); 
+    IF pbase ende = "end" THEN LEAVE load pbase FI; 
+    write ds (stdds, 0, pbase add, pbase wert); 
+    pbase add INCR 1; 
+  PER 
+END PROC load pbase; 
+INT PROC read pbase var (FILE VAR f, INT CONST index): 
+  INT VAR pbase add; 
+  get pbase (f, pbase add); 
+  read ds (stdds, 0, pbase add+index) 
+END PROC read pbase var; 
+PROC write pbase var (FILE VAR f, INT CONST index, var): 
+  INT VAR pbase add; 
+  get pbase (f, pbase add); 
+  write ds (stdds, 0, pbase add+index, var); 
+END PROC write pbase var; 
+PROC get code add (FILE VAR f, INT VAR add hi, add lo): 
+  find text (f, "code:"); 
+  get int (f, add hi); get int (f, add lo); 
+  IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI; 
+END PROC get code add; 
+PROC get int (FILE VAR f, INT VAR value): 
+  IF eof (f) THEN error stop ("Daten fehlen") FI; 
+  TEXT VAR daten; 
+  get (f, daten); 
+  IF daten = "-32768" THEN 
+    value := -maxint-1; 
+  ELSE 
+    value := int (daten); 
+  ENDIF; 
+END PROC get int; 
+PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ): 
+  IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI; 
+  TEXT VAR daten ; 
+  get (f, daten); 
+  IF daten = "endc" THEN 
+    ende := "end" 
+  ELSE 
+    IF daten = "-32768" THEN 
+      value := -maxint-1; 
+    ELSE 
+      value := int (daten); 
+    ENDIF; 
+    ende := "no end" 
+  FI; 
+END PROC get code; 
+PROC check end code (FILE VAR f): 
+  find text (f, "endc"); 
+END PROC check end code; 
+PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende): 
+  IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI; 
+  TEXT VAR daten ; 
+  get (f, daten); 
+  IF daten = "endp" THEN 
+    ende := "end" 
+  ELSE 
+    IF daten = "-32768" THEN 
+      value := -maxint-1; 
+    ELSE 
+      value := int (daten); 
+    ENDIF; 
+    ende := "no end" 
+  FI; 
+END PROC get pbase; 
+PROC check end pbase (FILE VAR f): 
+  find text (f, "endp"); 
+END PROC check end pbase; 
+PROC find text (FILE VAR f, TEXT CONST suchtext): 
+  TEXT VAR t; 
+  go start (f); 
+  WHILE NOT eof (f) REP 
+    get (f, t); 
+    IF t = suchtext THEN LEAVE find text FI; 
+  PER; 
+  error stop (suchtext + " fehlt") 
+END PROC find text; 
+PROC go start (FILE VAR f): 
+  TEXT VAR t; 
+  reset (f); 
+  WHILE NOT eof (f) REP 
+    get (f, t); 
+    IF t = "EUMEL0:" THEN LEAVE go start FI 
+  PER; 
+  error stop ("EUMEL0-Code nicht gefunden"); 
+END PROC go start; 
+PROC run code (INT VAR ic hi, ic lo, modul nr): 
+  set modul start ic (modul nr, ic hi, ic lo); 
+  do (modul nr); 
+END PROC run code; 
+PROC lade (TEXT CONST datei name): 
+  INT VAR ic hi, ic lo, modul nr; 
+  line; 
+  IF NOT yes ("Wollen sie den Standarddatenraum kopieren") THEN LEAVE lade FI; 
+  FILE VAR f := sequentialfile (input, dateiname); 
+  get ic (f, ic hi, ic lo); 
+  get modul (f, modul nr); 
+  load code (f); 
+  load pbase (f); 
+  load pbase var (f); 
+  run code (ic hi, ic lo, modul nr); 
+END PROC lade; 
+PROC load pbase var (FILE VAR f): 
+  INT VAR dss, dst; TEXT VAR name := "STD DS4"; 
+  line; 
+  put ("Wohin soll der Standarddatenraum kopiert werden:"); 
+  editget (name); 
+  line; 
+  IF NOT exists (name) THEN create (name); FI; 
+  dss := 4 + 256 * index (myself); 
+  dst := ds nr (name); 
+  write pbase var (f, 1, dss); 
+  write pbase var (f, 2, dst); 
+END PROC load pbase var; 
+PROC lade: 
+  lade ("RUN save ds4"); 
+END PROC lade; 
+END PACKET lader; 
+lade; 
+
diff --git a/devel/debug/1/source-disk b/devel/debug/1/source-disk
new file mode 100644
index 0000000..e42b22b
--- /dev/null
+++ b/devel/debug/1/source-disk
@@ -0,0 +1 @@
+debug/debug-1_1987-04-24.img
diff --git a/devel/debug/1/src/RUN dez <-> hex b/devel/debug/1/src/RUN dez <-> hex
new file mode 100644
index 0000000..041fcf1
--- /dev/null
+++ b/devel/debug/1/src/RUN dez <-> hex
@@ -0,0 +1,49 @@
+LET hexziffern = "123456789ABCDEF";
+ROW 4 INT CONST faktoren :: ROW 4 INT : (1, 16, 256, 4096);
+
+INT PROC dez (TEXT CONST hex):
+  INT VAR stellen := LENGTH hex;
+  IF stellen > 4
+     OR stellen > 3 AND (hex SUB 1) > "7"
+     THEN errorstop ("Zahl zu groß")
+  FI;
+  INT VAR i :: 0, stelle, ziffpos;
+  TEXT VAR ziffer;
+  FOR stelle FROM 1 UPTO stellen REP
+    ziffer := hex SUB (stellen - stelle + 1);
+    ziffpos := pos (hexziffern, ziffer);
+    IF ziffpos <> 0
+       THEN i INCR ziffpos * faktoren [stelle]
+    ELIF ziffer <> "0"
+       THEN errorstop ("Hexadezimalzahl fehlerhaft")
+    FI
+  PER;
+  i
+END PROC dez;
+{194 + 76 ; kann nicht durch `replace' zu Beginn verkleinert werden }
+TEXT PROC hex (TEXT CONST t dez):
+  IF t dez = "" THEN LEAVE hex WITH "" FI;
+  INT VAR stelle, hex ziffer, dez := int (t dez);
+  TEXT VAR hexzahl := "";
+  FOR stelle FROM 4 DOWNTO 1 REP
+    hexziffer := dez DIV faktoren [stelle];
+    IF hexziffer <> 0
+       THEN hexzahl CAT (hexziffern SUB hexziffer);
+            dez DECR hexziffer * faktoren [stelle]
+       ELSE hexzahl CAT "0"
+    FI
+  PER;
+  hexzahl
+END PROC hex;
+
+putline (""1""4"Dezimalzahlen schlicht, Hexadezimalzahlen mit schließendem ""h"" eingeben");
+line;
+TEXT VAR z;
+REP put ("Zahl:");
+  get (z);
+  IF (z SUB LENGTH z) = "h"
+     THEN put (dez (subtext (z, 1, LENGTH z - 1)))
+     ELSE put (hex (z))
+  FI
+UNTIL z = "" PER
+
diff --git a/devel/debug/1/src/all tracer b/devel/debug/1/src/all tracer
new file mode 100644
index 0000000..1e84b59
--- /dev/null
+++ b/devel/debug/1/src/all tracer
@@ -0,0 +1,10 @@
+gen.trace
+extended instr
+convert
+info
+disa
+trace
+gen.procheads
+gen.bulletin
+trace.dok
+
diff --git a/devel/debug/1/src/convert b/devel/debug/1/src/convert
new file mode 100644
index 0000000..426a5e5
--- /dev/null
+++ b/devel/debug/1/src/convert
@@ -0,0 +1,154 @@
+PACKET convert DEFINES dec, hex, dsget2b, exhilo,    (* Stand: 87-01-13  *)
+                       addc, subc, addl, subl, incl, (* Autor: G. Szalay *)
+                       txt, CT, gethex, integ:
+
+LET dectab = "0123456789", hextab="0123456789abcdef", mask16=15;
+INT VAR number, digit, i;
+TEXT VAR buffer, char;
+INT CONST min 1     := dec ("ffff"),
+          min 2     := dec ("fffe"),
+          minint    := dec ("8000"),
+          maxint    := dec ("7fff"),
+       maxint min 1 := dec ("7ffe");
+
+INT PROC integ (TEXT CONST text): (*only digits allowed*)
+  number := 0;
+  FOR i FROM 1 UPTO LENGTH text REP
+    digit := pos (dectab, text SUB i);
+    IF digit > 0
+    THEN number := number * 10 + digit - 1
+    FI
+  UNTIL digit = 0 PER;
+  number
+END PROC integ;
+
+TEXT PROC hex (INT CONST n):
+  buffer := ""; number := n;
+  FOR i FROM 1 UPTO 4 REP
+    rotate (number,4);
+    digit := number AND mask16;
+    buffer CAT (hextab SUB (digit + 1))
+  PER;
+  buffer
+END PROC hex;
+
+INT PROC dec (TEXT CONST t):
+  IF LENGTH t > 4 THEN leave with message FI;
+  number := 0;
+  FOR i FROM 1 UPTO LENGTH t
+  REP char := t SUB i;
+      digit := pos (hextab, char) - 1;
+      IF digit<0 THEN leave with message FI;
+      rotate (number, 4);
+      number INCR digit
+  PER;
+  number.
+
+  leave with message:
+    error stop ("wrong param for dec");
+    LEAVE dec WITH 0.
+
+END PROC dec;
+
+INT PROC exhilo (INT CONST val):
+  INT VAR ex := val; rotate (ex, 8);
+  ex
+END PROC exhilo;
+
+INT PROC dsget2b (INT CONST drid, off hi, off lo):
+  INT VAR val := dsgetw (drid, off hi, off lo);
+  IF drid <> 1 THEN rotate (val, 8) FI;
+  val
+END PROC dsget2b;
+
+PROC addc (INT CONST a, b, INT VAR sum, BOOL VAR carry):
+  INT VAR s;
+  disable stop;
+  s := a + b;
+  IF a >= 0 AND b >= 0 THEN carry := FALSE
+  ELIF a < 0 AND b < 0 THEN carry := TRUE
+  ELSE carry := s >= 0
+  FI;
+  sum := s;
+  clear error
+END PROC addc;
+
+PROC subc (INT CONST a, b, INT VAR diff, BOOL VAR carry):
+  INT VAR d;
+  disable stop;
+  d := a - b;
+  IF a >= 0 AND b < 0 THEN carry := TRUE
+  ELIF a < 0 AND b >= 0 THEN carry := FALSE
+  ELSE carry := d < 0
+  FI;
+  diff := d;
+  clear error
+END PROC subc;
+
+PROC incl (INT VAR ah, al, INT CONST ainc):
+  BOOL VAR ov;
+  IF ainc = 1
+  THEN IF al = min1 THEN al := 0; ah INCR 1
+       ELIF al = maxint THEN al := minint
+       ELSE al INCR 1
+       FI
+  ELIF ainc = 2
+  THEN IF al = min2 THEN al := 0; ah INCR 1
+       ELIF al = maxint min1 THEN al := minint
+       ELSE al INCR 2
+       FI
+  ELSE addc (al, ainc, al, ov);
+       IF ov THEN addc (ah, 1, ah, ov) FI
+  FI
+END PROC incl;
+
+PROC addl (INT CONST ah, al, bh, bl, INT VAR sumh, suml, BOOL VAR carry):
+  BOOL VAR low carry, high carry;
+  addc (al, bl, suml, low carry);
+  addc (ah, bh, sumh, high carry);
+  IF low carry THEN addc (sumh, 1, sumh, low carry) FI;
+  carry := low carry OR high carry
+END PROC addl;
+
+PROC subl (INT CONST ah, al, bh, bl, INT VAR diffh, diffl, BOOL VAR carry):
+  BOOL VAR low carry, high carry;
+  subc (al, bl, diffl, low carry);
+  subc (ah, bh, diffh, high carry);
+  IF low carry THEN subc (diffh, 1, diffh, low carry) FI;
+  carry := low carry OR high carry
+END PROC subl;
+
+TEXT PROC txt (INT CONST num):
+  IF   num = minint  THEN "-32768"
+  ELIF num < 0       THEN "-" CT txt (-num)
+  ELIF num <= 9      THEN code (num + 48)
+  ELSE                    txt (num DIV 10) CT code (num MOD 10 + 48)
+  FI
+END PROC txt;
+
+TEXT OP CT (TEXT CONST left, right):
+  buffer := left; buffer CAT right; buffer
+END OP CT;
+
+PROC gethex (TEXT VAR hexline):
+  buffer := "";
+  REP inchar (char);
+      SELECT pos (""13""12"0123456789abcdef", char) OF
+        CASE 0: out(""7"")
+        CASE 1: hexline := buffer; out (""13""10""); LEAVE gethex
+        CASE 2: delete last char
+        OTHERWISE buffer CAT char; out (char)
+      ENDSELECT
+  PER.
+
+delete last char:
+  IF buffer = ""
+  THEN out (""7"")
+  ELSE buffer := subtext (buffer, 1, LENGTH buffer - 1);
+       out (""8" "8"")
+  FI.
+
+ENDPROC gethex;
+
+END PACKET convert;
+
diff --git a/devel/debug/1/src/disa b/devel/debug/1/src/disa
new file mode 100644
index 0000000..8819e21
--- /dev/null
+++ b/devel/debug/1/src/disa
@@ -0,0 +1,454 @@
+PACKET dis DEFINES disasm, disa, proc head,   (* Autor: G.Szalay *)
+                   set proc heads:            (* Stand: 87-04-23 *)
+
+LET INSTR = STRUCT (TEXT mnem, INT length, class),
+    clear to eop = ""4"", stdds = 0, no of lines = 4, beep = ""7"";
+INT VAR first word, opcode, cur x, cur y;
+INT CONST right 2 := -2;
+
+ROW 31 INSTR CONST primary list :: ROW 31 INSTR:
+ ( INSTR: ("LN      -    ",1,10),
+   INSTR: ("LN1     -    ",1,10),
+   INSTR: ("MOV     i-   ",2,0),
+   INSTR: ("INC1    I    ",1,0),
+   INSTR: ("DEC1    I    ",1,0),
+   INSTR: ("INC     Ii   ",2,0),
+   INSTR: ("DEC     Ii   ",2,0),
+   INSTR: ("ADD     iiI  ",3,0),
+   INSTR: ("SUB     iiI  ",3,0),
+   INSTR: ("CLEAR   I    ",1,0),
+   INSTR: ("TEST    i    ",1,1),
+   INSTR: ("EQU     ii   ",2,1),
+   INSTR: ("LSEQ    ii   ",2,1),
+   INSTR: ("FMOV    r-   ",2,0),
+   INSTR: ("FADD    rrR  ",3,0),
+   INSTR: ("FSUB    rrR  ",3,0),
+   INSTR: ("FMUL    rrR  ",3,0),
+   INSTR: ("FDIV    rrR  ",3,0),
+   INSTR: ("FLSEQ   rr   ",2,1),
+   INSTR: ("TMOV    t-   ",2,0),
+   INSTR: ("TEQU    tt   ",2,1),
+   INSTR: ("ULSEQ   ii   ",2,1),
+   INSTR: ("DSACC   dE   ",2,0),
+   INSTR: ("REF     a-   ",2,0),
+   INSTR: ("SUBS    vviaE",5,0),
+   INSTR: ("SEL     avE  ",3,0),
+   INSTR: ("PPV     -i   ",2,9),
+   INSTR: ("PP      a    ",1,9),
+   INSTR: ("B       -    ",1,2),
+   INSTR: ("B1      -    ",1,2),
+   INSTR: ("CALL    -    ",1,4) );
+
+ROW 6 INSTR CONST special list :: ROW 6 INSTR:
+ ( INSTR: ("EQUIM   vi   ",2,1),
+   INSTR: ("MOVX    vh-  ",3,0),
+   INSTR: ("GETW    ihI  ",3,0),
+   INSTR: ("MOVI    vI   ",2,0),
+   INSTR: ("PUTW    vhi  ",3,0),
+   INSTR: ("PENTER  v    ",1,8) );
+
+ROW 157 INSTR CONST secondary list :: ROW 157 INSTR:
+ ( INSTR: ("RTN          ",1,7),
+   INSTR: ("RTNT         ",1,7),
+   INSTR: ("RTNF         ",1,7),
+   INSTR: ("RESTART      ",1,0),
+   INSTR: ("STOP         ",1,11),
+   (* INSTR: ("*057F*       ",0,0), *)
+      INSTR: ("LBAS    H    ",2,0),
+   INSTR: ("KE           ",1,12),
+   (* INSTR: ("*077F*       ",0,0), *)
+      INSTR: ("DSGETW  dhhH ",5,0),
+   INSTR: ("BCRD    iI   ",3,0),
+   INSTR: ("CRD     II   ",3,0),
+   INSTR: ("ECWR    Iii  ",4,0),
+   INSTR: ("CWR     IIi  ",4,0),
+   INSTR: ("CTT     iE   ",3,0),
+   INSTR: ("GETC    tII  ",4,1),
+   INSTR: ("FNONBL  ItI  ",4,1),
+   INSTR: ("DREM256 Ii   ",3,0),
+   INSTR: ("AMUL256 Ii   ",3,0),
+   (* INSTR: ("*117F*       ",0,0), *)
+      INSTR: ("DSPUTW  dhhh ",5,0),
+   INSTR: ("ISDIG   i    ",2,1),
+   INSTR: ("ISLD    i    ",2,1),
+   INSTR: ("ISLC    i    ",2,1),
+   INSTR: ("ISUC    i    ",2,1),
+   INSTR: ("GADDR   -iI  ",4,0),
+   INSTR: ("GCADDR  iiI  ",4,1),
+   INSTR: ("ISSHA   a    ",2,1),
+   INSTR: ("SYSG         ",1,0),
+   INSTR: ("GETTAB       ",1,0),
+   INSTR: ("PUTTAB       ",1,0),
+   INSTR: ("ERTAB        ",1,0),
+   INSTR: ("EXEC    -    ",2,5),
+   INSTR: ("PPROC   -    ",2,9),
+   INSTR: ("PCALL   -    ",2,6),
+   INSTR: ("BRCOMP  iv   ",3,3),
+   INSTR: ("MOVXX   vh-  ",4,0),
+   INSTR: ("ALIAS   vdD  ",4,0),
+   INSTR: ("MOVII   vI   ",3,0),
+   INSTR: ("FEQU    rr   ",3,1),
+   INSTR: ("TLSEQ   tt   ",3,1),
+   INSTR: ("FNEG    rR   ",3,0),
+   INSTR: ("NEG     iI   ",3,0),
+   INSTR: ("IMULT   iiI  ",4,0),
+   INSTR: ("MUL     iiI  ",4,0),
+   INSTR: ("DIV     iiI  ",4,0),
+   INSTR: ("MOD     iiI  ",4,0),
+   INSTR: ("ITSUB   tiI  ",4,0),
+   INSTR: ("ITRPL   Tii  ",4,0),
+   INSTR: ("DECOD   tI   ",3,0),
+   INSTR: ("ENCOD   iT   ",3,0),
+   INSTR: ("SUBT1   tiT  ",4,0),
+   INSTR: ("SUBTFT  tiiT ",5,0),
+   INSTR: ("SUBTF   tiT  ",4,0),
+   INSTR: ("REPLAC  Tit  ",4,0),
+   INSTR: ("CAT     Tt   ",3,0),
+   INSTR: ("TLEN    tI   ",3,0),
+   INSTR: ("POS     ttI  ",4,0),
+   INSTR: ("POSF    ttiI ",5,0),
+   INSTR: ("POSFT   ttiiI",6,0),
+   INSTR: ("STRAN   -iitiiI",8,0),
+   INSTR: ("POSIF   tiiiI",6,0),
+   INSTR: ("*3B7F*       ",0,0),
+   INSTR: ("OUT     t    ",2,0),
+   INSTR: ("COUT    i    ",2,0),
+   INSTR: ("OUTF    ti   ",3,0),
+   INSTR: ("OUTFT   tii  ",4,0),
+   INSTR: ("INCHAR  T    ",2,0),
+   INSTR: ("INCETY  T    ",2,0),
+   INSTR: ("PAUSE   i    ",2,0),
+   INSTR: ("GCPOS   II   ",3,0),
+   INSTR: ("CATINP  TT   ",3,0),
+   INSTR: ("NILDS   D    ",2,0),
+   INSTR: ("DSCOPY  Dd   ",3,0),
+   INSTR: ("DSFORG  d    ",2,0),
+   INSTR: ("DSWTYP  di   ",3,0),
+   INSTR: ("DSRTYP  dI   ",3,0),
+   INSTR: ("DSHPSIZ dI   ",3,0),
+   INSTR: ("ESTOP        ",1,11),
+   INSTR: ("DSTOP        ",1,11),
+   INSTR: ("SETERR  i    ",2,0),
+   INSTR: ("ISERR        ",1,1),
+   INSTR: ("CLRERR       ",1,13),
+   INSTR: ("RPCB    iI   ",3,0),
+   INSTR: ("INFOPW  ttI  ",4,0),
+   INSTR: ("TWCPU   pr   ",3,0),
+   INSTR: ("ROTATE  Hi   ",3,0),
+   INSTR: ("IOCNTL  iiiI ",5,0),
+   INSTR: ("BLKOUT  diiiI",6,0),
+   INSTR: ("BLKIN   diiiI",6,0),
+   INSTR: ("BLKNXT  diI  ",4,0),
+   INSTR: ("DSSTOR  dpI  ",4,0),
+   INSTR: ("STORAGE II   ",3,0),
+   INSTR: ("SYSOP   i    ",2,0),
+   INSTR: ("ARITS        ",1,0),
+   INSTR: ("ARITU        ",1,0),
+   INSTR: ("HPSIZE  I    ",2,0),
+   INSTR: ("GARB         ",1,0),
+   INSTR: ("TCREATE ppia ",5,0),
+   INSTR: ("FSLD    iRI  ",4,0),
+   INSTR: ("GEXP    rI   ",3,0),
+   INSTR: ("SEXP    iR   ",3,0),
+   INSTR: ("FLOOR   rR   ",3,0),
+   INSTR: ("RTSUB   tiR  ",4,0),
+   INSTR: ("RTRPL   Tir  ",4,0),
+   INSTR: ("CLOCK   iR   ",3,0),
+   INSTR: ("SETNOW  r    ",2,0),
+   INSTR: ("TRPCB   piI  ",4,0),
+   INSTR: ("TWPCB   pii  ",4,0),
+   INSTR: ("TCPU    pR   ",3,0),
+   INSTR: ("TSTAT   pI   ",3,0),
+   INSTR: ("ACT     p    ",2,0),
+   INSTR: ("DEACT   p    ",2,0),
+   INSTR: ("THALT   p    ",2,0),
+   INSTR: ("TBEGIN  pa   ",3,0),
+   INSTR: ("TEND    p    ",2,0),
+   INSTR: ("SEND    pidI ",5,0),
+   INSTR: ("WAIT    DIP  ",4,0),
+   INSTR: ("SWCALL  piDI ",5,0),
+   INSTR: ("CDBINT  hI   ",3,0),
+   INSTR: ("CDBTXT  hT   ",3,0),
+   INSTR: ("PNACT   P    ",2,0),
+   INSTR: ("PW      hhi  ",4,0),
+   INSTR: ("GW      hhI  ",4,0),
+   INSTR: ("BITXOR  hhH  ",4,0),
+   INSTR: ("SNDWT   piDI ",5,0),
+   INSTR: ("TEXIST  p    ",2,1),
+   INSTR: ("BITAND  hhH  ",4,0),
+   INSTR: ("BITOR   hhH  ",4,0),
+   INSTR: ("SESSION I    ",2,0),
+   INSTR: ("SNDFROM ppiDI",6,0),
+   INSTR: ("DEFCOLL i    ",2,0),
+   INSTR: ("IDENT   iI   ",3,0),
+   INSTR: ("*827F*       ",0,0),
+   INSTR: ("*837F*       ",0,0),
+   INSTR: ("*847F*       ",0,0),
+   INSTR: ("*857F*       ",0,0),
+   INSTR: ("*867F*       ",0,0),
+   INSTR: ("*877F*       ",0,0),
+   INSTR: ("*887F*       ",0,0),
+   INSTR: ("*897F*       ",0,0),
+   INSTR: ("*8a7F*       ",0,0),
+   INSTR: ("*8b7F*       ",0,0),
+   INSTR: ("*8c7F*       ",0,0),
+   INSTR: ("*8d7F*       ",0,0),
+   INSTR: ("*8e7F*       ",0,0),
+   INSTR: ("*8f7F*       ",0,0),
+   INSTR: ("*907F*       ",0,0),
+   INSTR: ("*917F*       ",0,0),
+   INSTR: ("*927F*       ",0,0),
+   INSTR: ("*937F*       ",0,0),
+   INSTR: ("*947F*       ",0,0),
+   INSTR: ("*957F*       ",0,0),
+   INSTR: ("*967F*       ",0,0),
+   INSTR: ("*977F*       ",0,0),
+   INSTR: ("*987F*       ",0,0),
+   INSTR: ("*997F*       ",0,0),
+   INSTR: ("DSGETW  dhhH ",5,0),
+   INSTR: ("DSPUTW  dhhh ",5,0),
+   INSTR: ("LBAS    H    ",2,0) );
+
+
+PROC disa (INT CONST icount h, icount l,
+             TEXT VAR mnemonic, oplist,
+             INT VAR instr length, instr class) :
+  fetch first instr word;
+  fetch opcode;
+  IF   primary THEN process primary
+  ELIF secondary THEN process secondary
+  ELIF longprim THEN process longprim
+  ELSE process special
+  FI;
+  oplist := subtext (mnemonic, 9);
+  mnemonic := subtext (mnemonic, 1, 8).
+
+fetch first instr word:
+  first word := dsgetw (stdds, icount h, icount l).
+
+fetch opcode:
+  opcode := first word;
+  rotate (opcode,8);
+  opcode := opcode AND 255.
+
+primary: (opcode AND 124) <> 124.
+
+secondary: opcode = 127.
+
+longprim: opcode = 255.
+
+process primary:
+  opcode := opcode AND 124;
+  rotate (opcode, right 2);
+  mnemonic := primary list (opcode+1) . mnem;
+  instr length := primary list (opcode+1) . length;
+  instr class := primary list (opcode+1) . class.
+
+process secondary:
+  opcode := first word AND 255;
+  IF opcode <= 156
+  THEN mnemonic := secondary list (opcode+1) . mnem;
+       instr length := secondary list (opcode+1) . length;
+       instr class := secondary list (opcode+1) . class
+  ELSE mnemonic := "wrongopc";
+       instr length := 0; instr class := -1
+  FI.
+
+process longprim:
+  opcode := first word AND 255;
+  IF (opcode AND 124) = opcode
+  THEN rotate (opcode, -2);
+       mnemonic := primary list (opcode+1) . mnem;
+       instr length := primary list (opcode+1) . length + 1;
+       instr class := primary list (opcode+1) . class
+  ELSE mnemonic := "wrongopc";
+       instr length := 0; instr class := -1
+  FI.
+
+process special:
+  IF opcode < 128
+  THEN opcode := (opcode AND 3) + 1
+  ELSE opcode := (opcode AND 3) + 4
+  FI;
+  mnemonic := special list (opcode) .mnem;
+  instr length := special list (opcode) .length;
+  instr class := special list (opcode) . class.
+
+END PROC disa;
+
+(*********************************************************************)
+
+LET max modno = 3071;
+INT VAR word1, modno;
+TEXT VAR buf, mod decr;
+BOOL VAR proc heads file exists := FALSE;
+INITFLAG VAR initflag := FALSE;
+BOUND ROW max modno TEXT VAR proc heads;
+
+PROC set proc heads (TEXT CONST proc heads filename):
+  proc heads file exists := FALSE;
+  IF proc heads filename <> "" AND exists (proc heads filename)
+  THEN proc heads := old (proc heads filename);
+       put (proc heads (max modno)); (*to test type*)
+       proc heads file exists := TRUE
+  FI
+END PROC set proc heads;
+
+TEXT PROC proc head (INT CONST module no):
+  IF NOT initialized (initflag)
+  THEN provide proc heads file
+  FI;
+  INT VAR modno := module no;
+  IF modno >= 10000 THEN modno DECR 10000 FI;
+  IF proc heads file exists AND modno <= max modno
+  THEN IF modno = 0
+       THEN "(* mod no 0 *)"
+       ELSE buf := proc heads (modno);
+            IF subtext (buf, 1, 2) = "+>"
+            THEN mod decr := subtext (buf, 3);
+                 buf := "(* " CT mod decr CT " +> "
+                    CT proc head (modno - integ (mod decr)) CT " *)"
+            FI;
+            buf
+       FI
+  ELSE ""
+  FI.
+
+provide proc heads file:
+  IF NOT exists ("procheads")
+  THEN disable stop;
+       command dialogue (FALSE);
+       fetch ("procheads");
+       IF is error
+       THEN putline ("(*** proc heads file missing ***)");
+            out (beep); clear error
+       ELSE set proc heads ("procheads")
+       FI;
+       command dialogue (TRUE)
+  FI
+ENDPROC proc head;
+
+(***********************************************************************)
+
+INT VAR ic h:=2, ic l:=0, ilen, iclass, i, cmd, maxlines:=12, lines;
+INT CONST mask 8000 := dec ("8000"),
+          mask 7fff := dec ("7fff"),
+          mask 0400 := dec ("0400"),
+          bf mask1  := dec ("0040"),
+       opcode mask0 := dec ("83ff");
+BOOL VAR step mode := TRUE, quit;
+TEXT VAR iname, ioplist, char, input;
+
+PROC disasm :
+  out (""13"");
+  disasm (ic h, ic l)
+
+ENDPROC disasm;
+
+PROC disasm (INT CONST startaddr hi, startaddr lo):
+  ic h := startaddr hi;
+  ic l := startaddr lo;
+  lines := 0;
+  quit := FALSE;
+  REP
+    IF NOT (ic h = 3 OR ic h = 2)
+    THEN out ("*** icount out of code area ***"); line; out (beep);
+         step mode := TRUE
+    ELSE disa (ic h, ic l, iname, ioplist, ilen, iclass);
+         put icount mnemonic and instr words;
+         put proc head for call;
+         line; lines INCR 1;
+         IF iclass = 1 THEN put cond branch instr FI;
+    FI;
+    process command if necessary
+  UNTIL quit PER.
+
+put icount mnemonic and instr words:
+  put icount;
+  out (iname);
+  out (" ");
+  IF ilen > 0
+  THEN IF iclass = 4 THEN word1 := dsgetw (stdds, ic h, ic l) FI;
+       FOR i FROM 1 UPTO ilen REP
+         out (hex (dsget2b (stdds, ic h, ic l))); out (" ");
+         incl (ic h, ic l, 1)
+       PER
+  ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (""7"");
+       incl (ic h, ic l, 1);
+       step mode := TRUE
+  FI.
+
+put cond branch instr:
+  put icount;
+  word1 := dsget2b (stdds, ic h, ic l);
+  IF (word1 AND bf mask1) <> 0
+  THEN out ("BF       ")
+  ELSE out ("BT       ")
+  FI;
+  putline (hex (word1));
+  lines INCR 1;
+  incl (ic h, ic l, 1).
+
+put icount:
+  out (txt (ic h));
+  out (hex (ic l));
+  out (": ").
+
+put proc head for call:
+  IF iclass = 4
+  THEN eval module no;
+       out ("  ");
+       out (proc head (mod no))
+  FI.
+
+eval module no:
+  mod no := word1 AND opcode mask0;
+  IF (mod no AND mask 8000) <> 0
+  THEN mod no := mod no AND mask 7fff OR mask 0400
+  FI.
+
+process command if necessary:
+  IF step mode OR incharety <> "" OR lines >= maxlines
+  THEN process command;
+       lines := 0
+  FI.
+
+process command :
+  REP putline (""15"DISASM: step, more, address, lines, info, or quit"14"");
+      inchar (char);
+      cmd := pos ("smaliq",char);
+      IF cmd > 0
+      THEN SELECT cmd OF
+             CASE 1: step mode := TRUE; point to previous line
+             CASE 2: step mode := FALSE; point to previous line
+             CASE 3: set new ic
+             CASE 4: set new linecount
+             CASE 5: info (stdds, ic h, ic l, no of lines)
+             CASE 6: quit := TRUE
+           ENDSELECT
+      FI
+  UNTIL char <> "i" PER.
+
+point to previous line:
+  get cursor (cur x, cur y); cursor (1, cur y - 1); out (clear to eop).
+
+set new line count:
+  out ("lines="); gethex (buf); maxlines := dec (buf).
+
+set new ic :
+  REP
+    put ("type new ic (20000...3ffff)");
+    gethex (input);
+    input := "0000" CT input;
+    ic l := dec (subtext (input, LENGTH input-3));
+    ic h := dec (subtext (input, LENGTH input-7, LENGTH input-4));
+    IF ic h = 2 OR ic h = 3 THEN LEAVE set new ic FI;
+    out (beep); putline ("*** icount out of code area ***")
+  PER.
+
+ENDPROC disasm;
+
+(* disasm *)      (*for test only*).
+
+END PACKET dis;
+
diff --git a/devel/debug/1/src/extended instr b/devel/debug/1/src/extended instr
new file mode 100644
index 0000000..93b3b9e
--- /dev/null
+++ b/devel/debug/1/src/extended instr
@@ -0,0 +1,25 @@
+(**************************************************************)
+(*   Extended EUMEL0-instructions for TRACE        G.Szalay   *)
+(************************************************* 87-04-03 ***)
+
+PACKET extended instr DEFINES dsgetw, dsputw, local base,
+                              signed arith, unsigned arith:
+
+INT PROC dsgetw (INT CONST drid, adr hi, adr lo):
+  EXTERNAL 154
+ENDPROC dsgetw;
+
+PROC dsputw (INT CONST drid, adr hi, adr lo, word):
+  EXTERNAL 155
+ENDPROC dsputw;
+
+INT PROC local base:
+  EXTERNAL 156
+ENDPROC local base;
+
+PROC signed arith: EXTERNAL 91 ENDPROC signed arith;
+
+PROC unsigned arith: EXTERNAL 92 ENDPROC unsigned arith;
+
+ENDPACKET extended instr;
+
diff --git a/devel/debug/1/src/gen.bulletin b/devel/debug/1/src/gen.bulletin
new file mode 100644
index 0000000..8c5b15b
--- /dev/null
+++ b/devel/debug/1/src/gen.bulletin
@@ -0,0 +1,536 @@
+PACKET eumel coder part 1 m DEFINES bulletin m :   (* Author: U.Bartling *)
+                                                   (* modif'd by G.Szalay*)
+                                                   (* 87-03-31 *)
+
+(**************************************************************************)
+(*                                                                        *)
+(*  This program generates a file "bulletin" containing procedure heads   *)
+(*  and the module numbers, to be used by the debugging packet 'trace'.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+                   (***** Globale Variable *****)
+
+TEXT VAR object name;
+
+FILE VAR bulletin file;
+
+INT VAR hash table pointer, nt link, permanent pointer, param link,
+        index, mode, word, packet link;
+
+BOOL VAR found, end of params;
+
+#page#
+(**************************************************************************)
+(*                                                                        *)
+(*                  1. Interface zum ELAN-Compiler            04.08.1986  *)
+(*                              1.8.0                                     *)
+(*                                                                        *)
+(*   Beschreibung der      Tabellen (-groessen),                          *)
+(*                         internen Vercodung von Typen                   *)
+(*                    und  Kennungen .                                    *)
+(*   Initialisieren und Beenden des Compilers,                            *)
+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+LET  begin of hash table         =     0 ,
+     end of hash table           =  1023 ,
+
+     begin of permanent table    = 22784 ,
+       before first pt entry     = 22784 ,
+       first permanent entry     = 22785 ,
+     end of permanent table      = 32767 ,
+
+     wordlength                  =     1 ,  (* compile  u n d  run time *)
+     two word length             =     2 ,
+     three word length           =     3 ,
+
+     permanent param const             = 10000 ,
+     permanent param var               = 20000 ,
+     permanent proc op                 = 30000 ,
+     permanent type                    = 30000 ,
+     permanent row                     =    10 ,
+     permanent struct                  =    11 ,
+     permanent param proc              =    12 ,
+(*   permanent param proc end marker   =     0 , *)
+     permanent type field              =     0 ,
+
+     ptt limit                         = 10000 ,
+     begin of pt minus ptt limit       = 12784 ,
+
+     void                              =     0 ,
+     int                               =     1 ,
+     real                              =     2 ,
+     string                            =     3 ,
+     bool                              =     5 ,
+     bool result                       =     6 ,
+     dataspace                         =     7 ,
+     row                               =    10 ,
+     struct                            =    11 ,
+
+     const                             =     1 ,
+     var                               =     2 ,
+(*   proc                              =     3 , *)
+(*   denoter                           =     5 , *)
+     bold                              =     2 ;
+
+
+INT CONST permanent packet            :=     -2 ,
+          permanent end               :=     -3 ;
+
+
+
+
+                   (***** Hash/Namenstabelle *****)
+.
+next hash entry :
+     hash table pointer INCR wordlength .
+
+end of hash table reached :
+     hash table pointer > end of hash table .
+
+yet another nt entry :
+     nt link := cdb int (nt link) ;
+     nt link <> 0 . ;
+
+PROC to object (TEXT CONST searched object) :
+     hash ;
+     search nt entry .
+
+hash :
+     hash code := 0 ;
+     FOR index FROM 1 UPTO LENGTH searched object REP
+         addmult cyclic
+     ENDREP .
+
+addmult cyclic :
+     hash code INCR hash code ;
+     IF hash code > end of hash table THEN wrap around FI ;
+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .
+
+wrap around :
+     hash code DECR end of hash table .
+
+hash code : nt link .
+
+search nt entry :
+     found := FALSE ;
+     WHILE yet another nt entry REP
+          read current entry ;
+          IF object name = searched object
+             THEN found := TRUE ;
+                  LEAVE to object
+          FI
+     PER .
+
+read current entry :
+     permanent pointer := cdb int (nt link + wordlength) ;
+     object name := cdb text (nt link + two word length)
+ENDPROC to object ;
+
+
+                 (***** Permanent Tabelle *****)
+.
+next procedure :
+     permanent pointer := cdb int (permanent pointer) . ;
+
+PROC next pt param :
+     mode := cdb int (param link) MOD ptt limit ;
+     param link INCR wordlength ;
+     IF   mode = permanent row    THEN skip over permanent row
+     ELIF mode = permanent struct THEN skip over permanent struct
+     FI ;
+     set end marker if end of list .
+
+skip over permanent row :
+     param link INCR wordlength ;
+     next pt param .
+
+skip over permanent struct :
+     REP
+         next pt param ;
+         mode := cdb int (param link)
+     UNTIL mode = permanent type field PER ;
+     param link INCR wordlength
+ENDPROC next pt param ;
+
+PROC set end marker if end of list :
+     mode := cdb int (param link) ;
+     end of params := mode >= permanent proc op OR mode <= 0
+ENDPROC set end marker if end of list ;
+
+PROC get type and mode (INT VAR type) :
+     mode := cdb int (param link) ;
+     IF mode = permanent param proc THEN type of param proc
+                                    ELSE type of object
+     FI .
+
+type of param proc :
+     param link INCR wordlength ;
+     get type and mode (type) ;
+     mode := permanent param proc .
+
+type of object :
+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;
+                      mode := 0
+                 ELSE type := mode MOD ptt limit ;
+                      mode DECR type ;
+                      translate type if necessary ;
+                      translate mode if necessary
+     FI .
+
+translate type if necessary :
+     IF permanent row or struct THEN translate type FI .
+
+translate type :
+     type := param link - begin of pt minus ptt limit .
+
+translate mode if necessary :
+    IF   mode = permanent param const THEN mode := const
+    ELIF mode = permanent param var   THEN mode := var
+    FI .
+
+permanent row or struct :
+     type = permanent row OR type = permanent struct
+ENDPROC get type and mode ;
+
+
+                 (***** Allgemeine Zugriffsprozeduren *****)
+
+INT PROC cdb int (INT CONST index) :
+   EXTERNAL 116
+ENDPROC cdb int ;
+
+TEXT PROC cdb text (INT CONST index) :
+   EXTERNAL 117
+ENDPROC cdb text ;
+
+#page#
+(**************************************************************************)
+(*                                                                        *)
+(*                 10. Inspector                              01.08.1986  *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+
+INT VAR line number, begin of packet,
+        last packet entry, indentation;
+
+TEXT VAR type and mode, pattern, buffer;
+
+PROC name of type (INT CONST type) :
+            SELECT type OF
+     CASE void              :
+     CASE int               : type and mode CAT "INT"
+     CASE real              : type and mode CAT "REAL"
+     CASE string            : type and mode CAT "TEXT"
+     CASE bool, bool result : type and mode CAT "BOOL"
+     CASE dataspace         : type and mode CAT "DS"
+     CASE row               : type and mode CAT "ROW "
+     CASE struct            : type and mode CAT "STRUCT"
+     OTHERWISE              : complex type
+            ENDSELECT .
+
+complex type :
+     IF type > ptt limit THEN perhaps permanent struct or row
+                         ELSE get complex type
+     FI .
+
+perhaps permanent struct or row :
+     index := type + begin of pt minus ptt limit ;
+     mode := cdb int (index) MOD ptt limit ;
+     IF   mode = permanent row    THEN get permanent row
+     ELIF mode = permanent struct THEN get permanent struct
+                                  ELSE type and mode CAT "-"
+     FI .
+
+get complex type :
+     index := type + begin of permanent table ;
+     IF is complex type THEN get name
+                        ELSE type and mode CAT "-"
+     FI .
+
+is complex type :
+     permanent type definition mode = permanent type .
+
+get name :
+     type and mode CAT cdb text (link to type name + two word length) .
+
+link to type name :
+     cdb int (index + three word length) .
+
+permanent type definition mode :
+     cdb int (index + wordlength) .
+
+get permanent row :
+     INT VAR t;
+     type and mode CAT "ROW " ;
+     type and mode CAT text (cdb int (index + wordlength)) ;
+     type and mode CAT " " ;
+     param link := index + two wordlength ;
+     get type and mode (t) ;
+     name of type (t) .
+
+get permanent struct :
+     type and mode CAT "STRUCT ( ... )"
+ENDPROC name of type ;
+
+
+BOOL PROC not end of chain :
+     permanent pointer <> 0
+ENDPROC not end of chain ;
+
+PROC put specifications (TEXT CONST proc name) :
+     put obj name (proc name) ;
+     to first param ;
+     IF NOT end of params THEN put param list FI ;
+     put result ;
+     write bulletin line (text(cdb int(param link+wordlength),5)) ;
+     writeline .
+
+to first param :
+     param link := permanent pointer + word length ;
+     set end marker if end of list .
+
+put result :
+     INT VAR type;
+     get type and mode (type) ;
+     IF type <> void THEN type and mode := " --> " ;
+                          name of type (type) ;
+                          write bulletin line (type and mode)
+     FI
+ENDPROC put specifications ;
+
+PROC put param list :
+     write bulletin line (" (") ;
+     REP
+         INT VAR type, param mode;
+         get type and mode (type) ;
+         param mode := mode ;
+         put type and mode ;
+         maybe param proc ;
+         next pt param ;
+         IF end of params THEN write bulletin line (")") ;
+                               LEAVE put param list
+         FI ;
+         write bulletin line (", ") ;
+     PER .
+
+put type and mode :
+     type and mode := "" ;
+     name of type (type) ;
+     type and mode CAT name of mode ;
+     write bulletin line (type and mode) .
+
+name of mode :
+     IF   param mode = const THEN " C"
+     ELIF param mode = var   THEN " V"
+                             ELSE " PROC"
+     FI .
+
+maybe param proc :
+     IF mode = permanent param proc THEN put virtual params FI .
+
+put virtual params :
+     skip over result type if complex type ;
+     IF NOT end of virtual params THEN put param list FI.
+
+skip over result type if complex type :
+     next pt param .
+
+end of virtual params :
+    end of params
+ENDPROC put param list ;
+
+PROC to packet (TEXT CONST packet name) :
+     to object ( packet name) ;
+     IF found THEN find start of packet objects FI .
+
+find start of packet objects :
+     last packet entry := 0 ;
+     packet link := before first pt entry ;
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF word < 0 THEN IF   word = permanent packet THEN packet found
+                          ELIF word = permanent end    THEN return
+                          FI
+         FI
+     ENDREP .
+
+packet found :
+     IF cdb int (packet link + wordlength) = nt link
+        THEN last packet entry := packet link FI .
+
+return :
+     IF last packet entry <> 0 THEN found := TRUE ;
+                                    packet link := last packet entry
+                               ELSE found := FALSE
+     FI ;
+     LEAVE to packet
+ENDPROC to packet ;
+
+PROC next packet :
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF   word = permanent packet THEN true return
+         ELIF end of permanents       THEN false return
+         FI ;
+     ENDREP .
+
+true return :
+     found := TRUE ;
+     LEAVE next packet .
+
+false return :
+     found := FALSE ;
+     LEAVE next packet .
+
+end of permanents :
+     word = permanent end OR packet link > end of permanent table
+ENDPROC next packet ;
+
+PROC prep bulletin :
+     IF exists ("bulletin")
+     THEN IF yes("overwrite old file ""bulletin""")
+          THEN command dialogue (FALSE);
+               forget ("bulletin");
+               command dialogue (TRUE);
+               bulletin file := sequential file (output, new ("bulletin"))
+          ELSE bulletin file := sequential file (output, old ("bulletin"))
+          FI
+     ELSE bulletin file := sequential file (output, new ("bulletin"))
+     FI;
+     putline ("GENERATING ""bulletin"" ...");
+     line number := 0 ;
+     buffer := ""
+ENDPROC prep bulletin ;
+
+PROC write bulletin line (TEXT CONST line) :
+  (* IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; *)
+     buffer CAT line
+ENDPROC write bulletin line ;
+
+PROC writeline  :
+     write (bulletin file, buffer) ;
+     line (bulletin file) ;
+     line number INCR 1 ;
+     cout (line number) ;
+     buffer := ""
+ENDPROC writeline ;
+
+PROC writeline (INT CONST times) :
+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;
+                                          writeline
+                                     ELSE index := times
+     FI ;
+     line (bulletin file, index) ;
+     line number INCR index;
+     indentation := 0 ;
+     cout (line number)
+ENDPROC writeline ;
+
+PROC bulletin m (TEXT CONST packet name) :
+     prep bulletin ;
+     scan (packet name) ;
+     next symbol (pattern) ;
+     to packet (pattern) ;
+     IF found THEN list packet
+              ELSE error stop (packet name + " ist kein Paketname")
+     FI .
+
+ENDPROC bulletin m;
+
+PROC list packet :
+     begin of packet := packet link + word length ;
+     find end of packet ;
+     run through nametab and list all packet objects .
+
+find end of packet :
+     last packet entry := begin of packet ;
+     REP
+         last packet entry INCR wordlength ;
+         word := cdb int (last packet entry) ;
+     UNTIL end of packet entries PER .
+
+end of packet entries :
+     word = permanent packet OR word = permanent end .
+
+run through nametab and list all packet objects :
+     hashtable pointer := begin of hashtable ;
+     REP
+         nt link := hashtable pointer ;
+         list objects of current packet in this chain ;
+         next hash entry
+     UNTIL end of hashtable reached ENDREP .
+
+list objects of current packet in this chain :
+     WHILE yet another nt entry REP
+         permanent pointer := cdb int (nt link + wordlength) ;
+         put objects of this name
+     PER .
+
+put objects of this name :
+     IF there is at least one object of this name in the current packet
+       THEN into bulletin FI .
+
+there is at least one object of this name in the current packet :
+     REP
+        IF permanent pointer >= begin of packet AND
+           permanent pointer < last packet entry
+           THEN LEAVE there is at least one object of this name
+                      in the current packet WITH TRUE FI ;
+        next procedure
+     UNTIL permanent pointer = 0 PER ;
+     FALSE .
+
+into bulletin :
+     object name := cdb text (nt link + two word length) ;
+     object names into bulletin (BOOL PROC within packet)
+ENDPROC list packet ;
+
+BOOL PROC within packet :
+     permanent pointer >= begin of packet AND
+     permanent pointer < last packet entry
+ENDPROC within packet ;
+
+PROC object names into bulletin (BOOL PROC link ok) :
+     scan (object name) ;
+     next symbol (object name, mode) ;
+     IF NOT type definition THEN put object definitions FI .
+
+type definition :
+     mode = bold AND no params .
+
+no params :
+     cdb int (permanent pointer + word length) >= permanent type .
+
+put object definitions :
+     WHILE link ok REP
+         put specifications (object name) ;
+         next procedure
+     ENDREP
+ENDPROC object names into bulletin ;
+
+PROC bulletin m:
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         list packet ;
+         next packet
+     UNTIL NOT found PER
+ENDPROC bulletin m;
+
+PROC put obj name (TEXT CONST name) :
+     buffer := name.
+ENDPROC put obj name ;
+
+bulletin m;
+
+ENDPACKET eumel coder part 1 m;
+
diff --git a/devel/debug/1/src/gen.procheads b/devel/debug/1/src/gen.procheads
new file mode 100644
index 0000000..e2ab0ea
--- /dev/null
+++ b/devel/debug/1/src/gen.procheads
@@ -0,0 +1,89 @@
+(**********************************************************************)
+(*                                                                    *)
+(* This program generates/updates a dataspace "procheads" from the    *)
+(* file "bulletin", including the module numbers. "procheads" will    *)
+(* be used by 'trace" and 'disasm" to show the name and the formal    *)
+(* param list of a called procedure.                                  *)
+(*                                                                    *)
+(*                                      GMD-Z2.P/G.Szalay/86-04-06    *)
+(*                                                                    *)
+(**********************************************************************)
+
+LET digits = "1234567890", outname = "procheads",
+    maxno of procs = 3071, first compiled module no = 256;
+FILE VAR infile := sequential file (input, old ("bulletin"));
+TEXT VAR buf, linebuf, entry, answer;
+INT VAR i, j, module no, posit, max module no := 0;
+BOUND ROW maxno of procs TEXT VAR proc heads;
+
+putline ("generating """ + outname + """ ...");
+BOOL VAR oldfile := exists (outname);
+IF oldfile
+THEN ask for action to be taken;
+     IF answer = "r"
+     THEN forget (outname); oldfile := FALSE;
+          proc heads := new (outname)
+     ELSE proc heads := old (outname)
+     FI
+ELSE proc heads := new (outname)
+FI;
+
+IF NOT oldfile THEN init heads FI;
+getline (infile, linebuf);
+FOR i FROM 1 UPTO 1000 REP
+  process line;
+  cout (i);
+  getline (infile, linebuf)
+UNTIL eof (infile) PER;
+process missing heads.
+
+ask for action to be taken:
+  out ("replace or append to old file """+outname+""" (r/a) ? ");
+  REP inchar (answer);
+      IF answer <> "r" AND answer <> "a" THEN out(""7"") FI
+  UNTIL answer = "r" OR answer = "a" PER;
+  putline (answer).
+
+init heads:
+  proc heads (1) := "+>1";
+  FOR i FROM 2 UPTO maxno of procs REP proc heads (i) := "" PER.
+
+process line:
+  fetch module no and entry;
+  IF module no >= first compiled module no
+  THEN IF module no < 10000
+       THEN proc heads (module no) := entry
+       ELSE proc heads (module no - 10000) := entry
+       FI
+  FI.
+
+fetch module no and entry:
+  posit := LENGTH linebuf - 1;
+  WHILE pos (digits, linebuf SUB posit) <> 0
+  REP posit DECR 1 PER;
+  module no := int (subtext (linebuf, posit+1));
+  IF module no < 10000 AND module no > max module no
+  THEN max module no := module no
+  FI;
+  WHILE (linebuf SUB posit) = " " REP posit DECR 1 PER;
+  entry := subtext (linebuf, 1, posit).
+
+process missing heads:
+  putline ("max module no=" + text(max module no));
+  FOR i FROM 1 UPTO max module no REP
+    cout(i);
+    IF proc heads (i) = "" THEN put in offset to last head FI
+  PER.
+
+put in offset to last head:
+  FOR j FROM i-1 DOWNTO 1 REP
+    IF proc heads (j) <> ""
+    THEN IF subtext (proc heads (j), 1, 2) = "+>"
+         THEN proc heads (i) := "+>" + text (i - j
+                                        + int (subtext (proc heads (j), 3)))
+         ELSE proc heads (i) := "+>" + text (i - j)
+         FI;
+         LEAVE put in offset to last head
+    FI
+  PER.
+
diff --git a/devel/debug/1/src/gen.trace b/devel/debug/1/src/gen.trace
new file mode 100644
index 0000000..4dc8c53
--- /dev/null
+++ b/devel/debug/1/src/gen.trace
@@ -0,0 +1,23 @@
+checkoff;
+putline("inserting ""extended instr"" ...");
+insert("extended instr");
+putline("inserting ""convert"" ...");
+insert("convert");
+putline("inserting ""info"" ...");
+insert("info");
+putline("inserting ""disa"" ...");
+insert("disa");
+putline("inserting ""trace"" ...");
+insert("trace");
+putline("inserting ""gen.bulletin"" ...");
+insert("gen.bulletin");
+putline("compiling ""gen.procheads"" ...");
+run("gen.procheads");
+do("set procheads(""procheads"")");
+forget("bulletin",quiet);
+putline("task """+name(myself)+""" is now global manager");
+putline("press any key ...");
+pause; global manager
+
+
+
diff --git a/devel/debug/1/src/info b/devel/debug/1/src/info
new file mode 100644
index 0000000..31099c6
--- /dev/null
+++ b/devel/debug/1/src/info
@@ -0,0 +1,371 @@
+PACKET info DEFINES info:
+
+(**********************************************************************)
+(**                                                                  **)
+(**   M i n i - I N F O        Autor: G. Szalay     Stand: 87-04-03  **)
+(**                                                                  **)
+(**********************************************************************)
+
+LET charset = "1234567890ß'qwertzuiopü+asdfghjklöä#<yxcvbnm,.-
+!""§$%&/()=?`QWERTZUIOPÜ*ASDFGHJKLÖÄ^>YXCVBNM;:_ ",
+    hextab = "0123456789abcdef", stdds = 0,
+    cr = ""13"", cr rubout = ""13""12"",
+    up down left right = ""3""10""8""2"";
+TEXT VAR buf, linebuf, bytes, hexbytes, char,
+         search param := ""255"", search buffer,
+         first byte, hex search param := "ff", search mode := "h";
+INT VAR drid := stdds, adr hi := 2, adr lo := 0, lines := 4,
+        begin hi := adr hi, begin lo := adr lo, first word,
+        saddr hi, saddr lo,
+        no of found bytes, cur xx, cur x, cur y, ymin, ymax,
+        xmin := 9, xmidlo := xmin + 21,
+        xmidhi := xmidlo + 5, xmax := xmidhi + 21,
+        word, byte, i, l;
+INT CONST mask 00ff := dec ("00ff"),
+          mask ff00 := dec ("ff00"),
+          offs mask := dec ("0007"),
+          addr mask := dec ("fff8");
+BOOL VAR found, low byte flag := TRUE, interrupted,
+         area 2 nonchangeable := id (1) <> 4 (*i.e. other than 68000*);
+
+PROC wait for (TEXT CONST chars):
+  inchar (char);
+  WHILE pos (chars, char) = 0
+  REP out (""7""); inchar (char) PER
+END PROC wait for;
+
+PROC info:
+  info (drid, begin hi, begin lo, lines)
+END PROC info;
+
+PROC info (INT CONST start drid, start addr hi, start addr lo, start len):
+  drid := start drid;
+  begin hi := start addr hi;
+  begin lo := start addr lo;
+  lines := start len;
+  line; line; show dump;
+  command loop.
+
+command loop:
+  REP
+    zeige kommandoliste;
+    kommando lesen und ausfuehren
+  PER.
+
+zeige kommandoliste:
+  putline (""15"INFO: more, address, dsid, lines, find, or quit"14"").
+
+kommando lesen und ausfuehren:
+  inchar (char);
+  SELECT pos ("damlfq"3"", char) OF
+    CASE 1: drid command
+    CASE 2: addr command
+    CASE 3: more command
+    CASE 4: len command
+    CASE 5: find command
+    CASE 6: quit command
+    CASE 7: up command
+    OTHERWISE more command
+  END SELECT.
+
+quit command: LEAVE command loop.
+
+drid command:
+  out ("dsid="); gethex (buf); drid := dec (buf);
+  IF drid > 0 AND drid < 4 OR drid > 255
+  THEN beep; drid := stdds
+  ELIF drid = 4
+  THEN drid := stdds
+  FI;
+  found := FALSE;
+  show dump.
+
+len command:
+  out ("lines="); gethex (buf); lines := dec (buf); show dump.
+
+addr command:
+  out ("address=");
+  gethex (buf);
+  IF LENGTH buf < 5
+  THEN begin hi := 0; begin lo := dec (buf)
+  ELSE begin hi := dec (subtext (buf, 1, LENGTH buf - 4));
+       begin lo := dec (subtext (buf, LENGTH buf - 3))
+  FI;
+  low byte flag := TRUE; found := FALSE;
+  show dump.
+
+more command:
+  begin hi := adr hi; begin lo := adr lo;
+  low byte flag := TRUE; found := FALSE;
+  line; show dump.
+
+show dump:
+  interrupted := FALSE;
+  get cursor (cur x, cur y);
+  cursor (1, cur y - 2);
+  out ("---------------------------- dsid=");
+  IF drid = stdds THEN out ("04") ELSE outsubtext (hex (drid), 3) FI;
+  putline (" --------------------");
+  adr hi := begin hi;
+  adr lo := begin lo AND addr mask;
+  FOR l FROM 1 UPTO lines REP
+    buf := "  "; linebuf := " "; bytes := "";
+    out (txt (adr hi)); out (hex (adr lo) CT ":  ");
+    IF adr hi = 8
+    THEN out ("_________e_n_d___o_f___d_a_t_a_s_p_a_c_e_________");
+         line; beep; LEAVE show dump
+    FI;
+    FOR i FROM 1 UPTO 8 REP
+      word := dsgetw (drid, adr hi, adr lo);
+      replace (buf, 1, word); rotate (word, 8); hexbytes := hex (word);
+      IF adr lo <> begin lo
+      THEN outsubtext (hexbytes, 1, 2); out (" ");
+           outsubtext (hexbytes, 3) ; out (" ")
+      ELIF low byte flag
+      THEN out (""8"-"); outsubtext (hexbytes, 1, 2); out ("-");
+           outsubtext (hexbytes, 3); out (" ")
+      ELSE outsubtext (hexbytes, 1, 2); out ("-");
+           outsubtext (hexbytes, 3); out ("-")
+      FI;
+      IF i = 4 THEN out ("  ") FI;
+      bytes CAT buf;
+      incl (adr hi, adr lo, 1)
+    PER;
+    FOR i FROM 1 UPTO 16 REP
+      IF pos (charset, bytes SUB i) = 0 THEN replace (bytes, i, ".") FI
+    PER;
+    out ("   "); outsubtext (bytes, 1, 8);
+    out (" "); outsubtext (bytes, 9); line;
+    IF incharety <> "" THEN interrupted := TRUE; LEAVE show dump FI
+  PER.
+
+up command:
+  IF change not allowed THEN beep; reposit cursor; LEAVE up command FI;
+  get cursor (cur x, cur y);
+  ymax := cur y - 2; ymin := ymax - lines + 1;
+  cur x := xmin + (begin lo AND offs mask) * 6;
+  IF cur x > xmidlo THEN cur x INCR 2 FI;
+  IF NOT low byte flag THEN cur x INCR 3 FI;
+  cur y := ymin;
+  cursor (cur x, cur y);
+  REP inchar (char);
+      IF pos (up down left right, char) > 0 THEN move cursor
+      ELIF pos (hextab, char) > 0 THEN read byte and move cursor
+      ELIF char <> cr THEN beep
+      FI
+  UNTIL char = cr PER;
+  cursor (1, ymax + 2); line; show dump.
+
+change not allowed:
+  interrupted OR area 2 nonchangeable AND area 2 of stdds in window.
+
+area 2 of stdds in window:
+  drid = stdds AND
+  (begin hi = 2 OR
+  begin hi = 1 AND begin lo < 0 AND lines * 8 + begin lo > 0).
+
+read byte and move cursor:
+  out (char); byte := pos (hextab, char) - 1;
+  wait for (hextab);
+  out (char); byte := pos (hextab, char) - 1 + 16 * byte;
+  out (""8""8"");
+  eval cursor address and modify word;
+  char := ""2""; move cursor.
+
+eval cursor address and modify word:
+  adr hi := begin hi; adr lo := begin lo AND addr mask;
+  incl (adr hi, adr lo, ((cur y - ymin)*8 + (cur x - xmin) DIV 6));
+  word := dsgetw (drid, adr hi, adr lo);
+  IF high byte read
+  THEN rotate (byte, 8); word := (word AND mask 00ff) OR byte
+  ELSE word := (word AND mask ff00) OR byte
+  FI;
+  dsputw (drid, adr hi, adr lo, word).
+
+high byte read:
+  cur xx := cur x; IF cur xx > xmidlo THEN cur xx DECR 2 FI;
+  cur xx MOD 6 < 3.
+
+move cursor:
+  SELECT pos (up down left right, char) OF
+    CASE 1: IF cur y = ymin THEN beep ELSE cur y DECR 1 FI
+    CASE 2: IF cur y = ymax THEN beep ELSE cur y INCR 1 FI
+    CASE 3: IF cur x = xmin THEN IF cur y = ymin THEN beep
+                                 ELSE cur y DECR 1; cur x := xmax
+                                 FI
+                            ELIF cur x = xmidhi THEN cur x DECR 5
+                            ELSE cur x DECR 3 FI
+    CASE 4: IF cur x = xmax THEN IF cur y = ymax THEN beep
+                                 ELSE cur y INCR 1; cur x := xmin
+                                 FI
+                            ELIF cur x = xmidlo THEN cur x INCR 5
+                            ELSE cur x INCR 3 FI
+  ENDSELECT;
+  cursor (cur x, cur y).
+
+beep: out (""7"").
+
+reposit cursor: out (""3"").
+
+find command:
+  out ("find: hex, char, or last param? (h/H/c/C/<CR>)");
+  wait for ("hHcC"13"");
+  saddr hi := begin hi; saddr lo := begin lo;
+  IF   char = "c" OR char = "C"
+  THEN out (char); get char string; low byte flag := NOT low byte flag
+  ELIF char = "h" OR char = "H"
+  THEN out (char); get hex string; low byte flag := NOT low byte flag
+  ELSE out (search mode);
+       IF pos ("cC", search mode) > 0
+       THEN out (search param)
+       ELSE out (hex search param)
+       FI;
+       IF NOT found THEN low byte flag := NOT low byte flag
+       ELIF NOT low byte flag OR pos ("CH", search mode) > 0
+       THEN incl (saddr hi, saddr lo, 1)
+       FI
+  FI;
+  out (cr); (*acknowledge CR*)
+  search string;
+  line; show dump.
+
+get char string:
+  search mode := char;
+  search param := "";
+  REP inchar (char);
+      SELECT pos (cr rubout, char) OF
+        CASE 1: IF search param = "" THEN beep ELSE LEAVE get char string FI
+        CASE 2: delete last char
+        OTHERWISE search param CAT char; out (char)
+      ENDSELECT
+  PER.
+
+delete last char:
+  IF search param = ""
+  THEN beep
+  ELSE search param := subtext (search param, 1, LENGTH search param - 1);
+       out (""8" "8"")
+  FI.
+
+get hex string:
+  search mode := char;
+  search param := "";
+  REP wait for (hextab CT cr rubout);
+      SELECT pos (cr rubout, char) OF
+        CASE 1: IF NOT regular hex string THEN beep; char :="" FI
+        CASE 2: delete last char
+        OTHERWISE search param CAT char; out (char)
+      ENDSELECT
+  UNTIL char = cr PER;
+  hex search param := search param;
+  search param := "";
+  FOR i FROM 1 UPTO LENGTH hex search param DIV 2 REP
+    char := hex search param SUB i;
+    word := pos (hextab, hex search param SUB (2*i-1)) - 1;
+    word := word * 16 + pos (hextab, hex search param SUB (2*i)) - 1;
+    search param CAT code (word)
+  PER.
+
+regular hex string:
+  LENGTH search param > 0 AND (LENGTH search param AND 1) = 0.
+
+search string:
+  first byte := search param SUB 1; buf := "  ";
+  IF LENGTH search param > 1 THEN first word := search param ISUB 1 FI;
+  REP IF pos ("ch", search mode) > 0
+      THEN search first byte or word
+      ELSE search first word
+      FI;
+      search rest if any;
+      IF found THEN begin hi := saddr hi; begin lo := saddr lo;
+                    LEAVE search string
+      FI;
+      IF NOT low byte flag THEN incl (saddr hi, saddr lo, 1) FI
+  PER.
+
+search first byte or word:
+  REP
+    IF saddr hi = 8 THEN LEAVE search first byte or word FI;
+    word := dsgetw (drid, saddr hi, saddr lo);
+    replace (buf, 1, word);
+    IF NOT low byte flag AND (buf SUB 1) = first byte
+    THEN IF LENGTH search param = 1
+         THEN low byte flag := TRUE; no of found bytes := 1;
+              LEAVE search first byte or word
+         ELIF (buf SUB 2) = (search param SUB 2)
+         THEN low byte flag := TRUE; no of found bytes := 2;
+              LEAVE search first byte or word
+         ELSE look in high byte
+         FI
+    ELSE look in high byte
+    FI;
+    low byte flag := FALSE;
+    incr search address and provide for interaction
+  PER.
+
+search first word:
+  REP
+    IF saddr hi = 8 THEN LEAVE search first word FI;
+    word := dsgetw (drid, saddr hi, saddr lo);
+    IF LENGTH search param = 1
+    THEN replace (buf, 1, word);
+         IF (buf SUB 1) = first byte
+         THEN low byte flag := TRUE; no of found bytes := 1;
+              LEAVE search first word
+         FI
+    ELSE IF word = first word
+         THEN low byte flag := TRUE; no of found bytes := 2;
+              LEAVE search first word
+         FI
+    FI;
+    incr search address and provide for interaction
+  PER.
+
+look in high byte:
+  IF (buf SUB 2) = first byte
+  THEN low byte flag := FALSE; no of found bytes := 1;
+       LEAVE search first byte or word
+  FI.
+
+incr search address and provide for interaction:
+  incl (saddr hi, saddr lo, 1);
+  IF incharety <> ""
+  THEN cursor (64, 24); out ("--- interrupted"); line; line;
+       begin hi := saddr hi; begin lo := saddr lo;
+       LEAVE search string
+  FI.
+
+search rest if any:
+  found := TRUE;
+  IF LENGTH search param = no of found bytes OR saddr hi = 8
+  THEN LEAVE search rest if any
+  FI;
+  IF low byte flag
+  THEN search buffer := subtext (search param, 3)
+  ELSE search buffer := subtext (search param, 2)
+  FI;
+  adr hi := saddr hi; adr lo := saddr lo;
+  FOR i FROM 1 UPTO (LENGTH search param - no of found bytes) DIV 2 REP
+    incl (adr hi, adr lo, 1);
+    word := dsgetw (drid, adr hi, adr lo);
+    IF (search buffer ISUB i) = word
+    THEN no of found bytes INCR 2
+    ELSE found := FALSE
+    FI
+  UNTIL NOT found PER;
+  IF found AND LENGTH search param > no of found bytes
+  THEN search last byte
+  FI.
+
+search last byte:
+  incl (adr hi, adr lo, 1);
+  word := dsgetw (drid, adr hi, adr lo);
+  replace (buf, 1, word);
+  found := (buf SUB 1) = (search param SUB length (search param)).
+
+END PROC info;
+
+(* info *)      (****)
+
+END PACKET info;
+
diff --git a/devel/debug/1/src/trace b/devel/debug/1/src/trace
new file mode 100644
index 0000000..773b5f2
--- /dev/null
+++ b/devel/debug/1/src/trace
@@ -0,0 +1,1020 @@
+PACKET trace DEFINES trace: 
+ 
+(**************************************************************) 
+(*                                          Autor: G. Szalay  *) 
+(*    E U M E L 0 - T R A C E                                 *) 
+(*                                          Stand: 87-04-23   *) 
+(**************************************************************) 
+ 
+LET packet area = 0, stack area = 1, text opd maxlen = 14, 
+    stdds = 0, info lines = 4, crlf = ""13""10"", 
+    beep = ""7"", carriage return = ""13"", cursor up = ""3"", 
+    std charset = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ123456 
+    7890<>.,:;-_+*!""�$%&/()=?'äÄöÖüÜ#^", 
+    blanks = "                                        ", 
+    startindent = 10, indentincr = 2; 
+BOOL VAR trap set := FALSE, trapped, initial call := TRUE, quit, 
+         single step := FALSE, protocol := FALSE, cond br follows, 
+         prot just started := FALSE, prot stopped := TRUE, 
+         users error := FALSE, users stpdis, prot operands := TRUE, 
+         nontraceable found, errorstop processing := FALSE, 
+         std procs traceable := id (1) = 4 (* processor = 68000 *), 
+         longcall to trace flag; 
+INT VAR  aret hi := 0, aret lo := 0, ic hi, ic lo, ic h, ic l, i, 
+         atrap hi, atrap lo, nail1 hi, nail1 lo, nail2 hi, nail2 lo, 
+         no of nails := 1, saved instr, saved instr w2, 
+         saved1, saved1 w2, saved2, saved2 w2, 
+         call to trace, call2 to trace, length of call to trace,
+         cmd, ilen, iclass, ilen1, iclass1, indentpos, 
+         code addr modif, pbase, lbase, users lbase, 
+         users errcode, users errline, old flags, flags, 
+         module no, word, word1, word2, case, xpos, ypos, 
+         cond br hi, cond br lo, maxlines:=12, lines,
+         opad hiword, opad hi, opad lo, opdds, br param, brcomp index, 
+         ic off, opd ptr, int opd, text opd len, text opd tr len, 
+         heap link, root word 2, no of results:=0, 
+         no of nontraceables := 0, no of long nontraceables := 0, 
+         pproc modno, pproc call, pproc ic lo := 0; 
+ROW 3 INT VAR res ds, res opadh, res opadl; 
+INT CONST lo byte mask  := dec ("00ff"), 
+          hi byte mask  := dec ("ff00"), 
+          branch param mask := dec ("87ff"), 
+          opcode mask0  := dec ("83ff"), 
+          opcode mask1  := dec ("7c00"), 
+          bf mask1      := dec ("0040"), 
+          ln br mask1   := dec ("7800"), 
+          stpdis mask0  := dec ("ffbf"), 
+          stpdis mask1  := dec ("0040"), 
+          aritu mask1   := dec ("0010"), 
+          error mask1   := dec ("0080"), 
+          flags mask1   := dec ("00fc"), 
+          mask 8000     := dec ("8000"), 
+          mask 7fff     := dec ("7fff"), 
+          mask 7ffe     := dec ("7ffe"), 
+          mask 7f00     := dec ("7f00"), 
+          mask 0400     := dec ("0400"), 
+          mask fbff     := dec ("fbff"), 
+          mask 0007     := dec ("0007"), 
+          mask fff8     := dec ("fff8"), 
+          m l t start   := dec ("0200"), 
+          ln opcode     := dec ("0000"), 
+          br opcode     := dec ("7000"), 
+          rtn opcode    := dec ("7f00"), 
+          call opcode   := dec ("7800"), 
+          longcall opcode  := dec ("ff78"), 
+          pproc opcode  := dec ("7f1e"), 
+          estop opcode  := dec ("7f4b"), 
+          dstop opcode  := dec ("7f4c");
+TEXT VAR buf, char, command, iname, iname1, ioplist, ioplist1, opd type, 
+         opd buf, text opd, res types, users errmsg; 
+ 
+ 
+(********* following OPs and PROCs may be used by TRACE only ***********) 
+ 
+PROC put (TEXT CONST a): 
+  out (a); out (" ") 
+ENDPROC put; 
+ 
+PROC putline (TEXT CONST a): 
+  out (a); out (crlf) 
+ENDPROC putline; 
+ 
+ 
+(***********************************************************************) 
+ 
+PROC eval br addr (INT CONST br para hi, br para lo, 
+                   INT VAR br addr hi, br addr lo): 
+  br param := dsgetw (stdds, br para hi, br para lo) 
+           AND branch param mask; 
+  br addr hi := br para hi; 
+  br addr lo := (br para lo AND hi byte mask) 
+             OR (br param AND lo byte mask); 
+  IF NOT br within page 
+  THEN rotate (br param, 8); 
+       br param := br param AND lo byte mask; 
+       rotate (br param, 1);
+       IF br param > 255 
+       THEN br param INCR 1; 
+            br param := br param AND 255 
+       FI; 
+       rotate (br param, 8); 
+       br addr lo INCR br param; 
+       word := br addr lo AND hi byte mask; rotate (word, 8); 
+       IF word >= code addr modif 
+       THEN br addr lo DECR dec("1000")
+       FI 
+  FI.
+ 
+  br within page: 
+    br param = (br param AND lo byte mask). 
+ 
+ENDPROC eval br addr; 
+ 
+ 
+PROC eval opd addr (INT CONST ic offset): 
+  word := dsgetw (stdds, ic hi, ic lo PLUS ic offset); 
+  IF ic offset = 0 
+  THEN word := word AND opcode mask0 
+  FI; 
+  IF global
+  THEN eval global addr
+  ELIF local 
+  THEN eval local addr 
+  ELSE eval ref addr 
+  FI.
+ 
+  global: (word AND mask 8000) = 0. 
+ 
+  local: (word AND 1) = 0. 
+ 
+  eval global addr: 
+    opdds := stdds; 
+    opad hi := packet area; 
+    opad hiword := opad hi;
+    opad lo := pbase PLUS word; 
+    perhaps put opad. 
+ 
+  eval local addr: 
+    opdds := stdds; 
+    opad hi := stack area; 
+    opad hiword := opad hi;
+    word := word AND mask 7ffe; rotate (word, -1); 
+    opad lo := users lbase PLUS word; 
+    perhaps put opad. 
+ 
+  eval ref addr: 
+    eval local addr; 
+    opad hiword := dsgetw (stdds, stack area, opad lo PLUS 1); 
+    opad lo := dsgetw (stdds, stack area, opad lo); 
+    opdds := opad hiword AND hi byte mask; rotate (opdds, 8); 
+    opad hi := opad hiword AND lo byte mask; 
+    perhaps put opad. 
+ 
+perhaps put opad: 
+ (* put("opad=" CT hex(opad hiword) CT hex(opad lo)) *) . (*for tests*) 
+ 
+ENDPROC eval opd addr; 
+ 
+ 
+PROC out int opd: 
+  out (txt (int opd)); 
+  IF int opd < 0 OR int opd > 9 
+  THEN out ("("); out (hex (int opd)); out (")") 
+  FI 
+ENDPROC out int opd; 
+ 
+ 
+PROC fetch text opd: 
+  root word 2 := dsgetw (opdds, opad hi, opad lo PLUS 1); 
+  opd buf := subtext (blanks, 1, text opd maxlen + 2); 
+  IF text on heap 
+  THEN eval text from heap 
+  ELSE eval text from root 
+  FI; 
+  convert nonstd chars; 
+  text opd := """"; 
+  text opd CAT subtext (opd buf, 1, text opd tr len); 
+  text opd CAT """"; 
+  IF text opd len > text opd tr len 
+  THEN text opd CAT "(..."; 
+       text opd CAT txt (text opd len); 
+       text opd CAT "B)" 
+  FI. 
+ 
+text on heap:
+  (root word 2 AND lo byte mask) = 255.
+ 
+eval text from root: 
+  text opd len := root word 2 AND lo byte mask; 
+  text opd tr len := min (text opd len, text opd maxlen); 
+  FOR i FROM 1 UPTO text opd tr len DIV 2 + 1 REP 
+    replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) 
+  PER; 
+  opd buf := subtext (opd buf, 2, text opd tr len + 1). 
+ 
+eval text from heap: 
+  rotate (root word 2, 8); 
+  text opd len := root word 2 AND lo byte mask 
+               OR (dsget2b (opdds, opad hi, opad lo PLUS 2) AND hi byte mask); 
+  text opd tr len := min (text opd len, text opd maxlen); 
+  heap link := dsgetw (opdds, opad hi, opad lo); 
+  rotate (heap link, 15); 
+  opad hi := heap link AND mask 0007; 
+  opad lo := heap link AND mask fff8; 
+  IF opdds = stdds THEN opad lo INCR 2 FI; 
+  FOR i FROM 1 UPTO text opd tr len DIV 2 REP 
+    replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) 
+  PER; 
+  opd buf := subtext (opd buf, 1, text opd tr len). 
+ 
+convert nonstd chars: 
+  i := 1; 
+  WHILE i <= LENGTH opd buf REP 
+    char := opd buf SUB i; 
+    IF pos (std charset, char) = 0 
+    THEN buf := txt (code (char)); 
+         opd buf := subtext (opd buf, 1, i-1) CT 
+                    """" CT buf CT """" CT 
+                    subtext (opd buf, i+1); 
+         i INCR 2 + length (buf); 
+    ELIF char = """" 
+    THEN opd buf := subtext (opd buf, 1, i-1) CT """""" CT 
+                    subtext (opd buf, i+1); 
+         i INCR 2 
+    ELSE i INCR 1 
+    FI 
+  PER; 
+  text opd tr len := LENGTH opd buf. 
+ 
+END PROC fetch text opd; 
+ 
+ 
+INT OP PLUS (INT CONST a, b):
+  unsigned arith;
+  a + b
+ENDOP PLUS;
+
+PROC trace: 
+  ROW 40 INT VAR dummy space for 20 pps; 
+  get return address; 
+  IF initial call 
+  THEN save call to trace 
+  ELSE process regular call 
+  FI. 
+ 
+get return address: 
+  lbase:=local base; 
+  users lbase := dsgetw (stdds, stack area, lbase); 
+  aret lo := dsgetw (stdds, stack area, lbase+1); 
+  word := dsgetw (stdds, stack area, lbase+2); 
+  aret hi := word AND 3; 
+  flags := word AND flags mask1; 
+  ic hi := aret hi; ic lo := aret lo. 
+ 
+save call to trace: 
+  call to trace := dsgetw (stdds, aret hi, aret lo - 1); 
+  IF (call to trace AND opcode mask1) = call opcode 
+  THEN length of call to trace := 1;
+       longcall to trace flag := FALSE 
+  ELSE call2 to trace := call to trace; 
+       call to trace := dsgetw (stdds, aret hi, aret lo - 2); 
+       length of call to trace := 2;
+       longcall to trace flag := TRUE; 
+       putline ("WARNING: call to trace needs 2 words!!!") 
+  FI; 
+  initial call := FALSE. 
+ 
+process regular call: 
+  IF protocol 
+  THEN pull old nails 
+  ELSE indentpos := startindent; cond br follows := FALSE 
+  FI; 
+  get users error state and set modes for trace; 
+  IF NOT errorstop processing 
+  THEN normal processing of instructions 
+  ELSE errorstop processing := FALSE 
+  FI; 
+  handle possible trace errors; 
+  IF NOT protocol THEN restore users error state FI.  
+ 
+normal processing of instructions: 
+  trapped := trap set AND atrap lo = ic lo - length of call to trace
+           AND atrap hi = ic hi;
+  IF protocol THEN postprocess protocol FI; 
+  IF trapped THEN handle trap FI; 
+  IF protocol OR trapped
+  THEN ic lo DECR length of call to trace;
+       update icount on stack
+  FI; 
+  IF trapped OR NOT protocol OR single step OR incharety <> "" 
+     OR lines >= maxlines
+  THEN quit := FALSE; protocol := FALSE; single step := FALSE; lines := 0;
+       REP ask for next action; 
+           execute command 
+       UNTIL quit PER 
+  FI; 
+  IF protocol THEN protocol instruction and set nails FI. 
+ 
+get users error state and set modes for trace: 
+  signed arith; 
+  IF NOT protocol 
+  THEN users error  := (flags AND error mask1) <> 0; 
+       users stpdis := (flags AND stpdis mask1) <> 0; 
+       IF users error 
+       THEN save users error state; clear error; 
+            line; putline ("trace called with user error " CT 
+                            txt (users errcode) CT ": " CT users errmsg) 
+       ELSE disable stop 
+       FI 
+  ELIF is error 
+  THEN IF first occurrence 
+       THEN users error := TRUE; 
+            save users error state; 
+            line; 
+            putline ("trace detected user error " CT 
+                     txt (users errcode) CT ": " CT users errmsg); 
+            IF users stpdis 
+            THEN out ("(stop disabled)") 
+            ELSE errorstop processing := TRUE; stop op; 
+                 IF protocol THEN set nail1 FI 
+            FI 
+       ELSE line; 
+            putline ("trace detected user error " CT 
+                     txt (error code) CT ": " CT error message); 
+            out ("(ignored because of previous error(s)) "); 
+       FI; 
+       clear error 
+  ELSE IF (flags AND stpdis mask1) = 0 
+       THEN set stpdis flag on stack; disable stop 
+       FI 
+  FI. 
+ 
+first occurrence: NOT users error. 
+ 
+save users error state: 
+  users errmsg := error message; 
+  users errline := error line; 
+  users errcode := error code. 
+ 
+handle possible trace errors: 
+  IF is error 
+  THEN line; 
+       putline ("TRACE error " CT txt (error code) 
+                 CT " at line " CT txt (error line) 
+                 CT ": " CT error message); 
+       clear error 
+  FI. 
+ 
+restore users error state: 
+  IF users error 
+  THEN error stop (users errcode, users errmsg); 
+       users error := FALSE 
+  FI; 
+  restore users stpdis flag on stack. 
+ 
+handle trap: 
+  put trap message; 
+  restore instruction; 
+  trap set := FALSE. 
+ 
+put trap message: 
+  putline ("trap at address " CT txt (atrap hi) CT hex (atrap lo)). 
+ 
+restore instruction: 
+  dsputw (stdds, atrap hi, atrap lo, saved instr); 
+  IF longcall to trace flag 
+  THEN dsputw (stdds, atrap hi, atrap lo PLUS 1, saved instr w2) 
+  FI. 
+ 
+postprocess protocol: 
+  IF prot operands THEN protocol result operands FI; 
+  line; lines INCR 1;
+  IF cond br follows THEN protocol cond br op; cond br follows := FALSE FI. 
+ 
+protocol cond br op: 
+  outsubtext (blanks, 1, indentpos); 
+  out (txt (cond br hi)); out (hex (cond br lo)); out (": "); 
+  word := dsget2b (stdds, cond br hi, cond br lo); 
+  IF (word AND bf mask1) <> 0 
+  THEN out ("BF       ") 
+  ELSE out ("BT       ") 
+  FI; 
+  putline (hex (word)); lines INCR 1.
+ 
+pull old nails: 
+  dsputw (stdds, nail1 hi, nail1 lo, saved1); 
+  IF longcall to trace flag 
+  THEN dsputw (stdds, nail1 hi, nail1 lo PLUS 1, saved1 w2) 
+  FI; 
+  IF no of nails = 2 
+  THEN dsputw (stdds, nail2 hi, nail2 lo, saved2); 
+       IF longcall to trace flag 
+       THEN dsputw (stdds, nail2 hi, nail2 lo PLUS 1, saved2 w2) 
+       FI; 
+       no of nails := 1 
+  FI. 
+ 
+update icount on stack: 
+  dsputw (stdds, 1, lbase + 1, ic lo). 
+ 
+ask for next action: 
+  putline (""15"" CT
+          "TRACE: step, more, trap, regs, lines, info, disasm, or quit"14""); 
+  inchar (command). 
+ 
+execute command: 
+  cmd := pos ("tidqmsrl", command); 
+  SELECT cmd OF 
+    CASE 1: set address trap;                        prot stopped := TRUE 
+    CASE 2: info (stdds, ic hi, ic lo, info lines);  prot stopped := TRUE 
+    CASE 3: disasm (ic hi, ic lo);                   prot stopped := TRUE 
+    CASE 4: quit := TRUE;                            prot stopped := TRUE 
+    CASE 5: initialize protocol; single step := FALSE; 
+            quit := TRUE 
+    CASE 6: initialize protocol; single step := TRUE; 
+            quit := TRUE 
+    CASE 7: show registers;                          prot stopped := TRUE 
+    CASE 8: set new line count;                      prot stopped := TRUE
+    OTHERWISE out(beep CT carriage return CT cursor up) 
+  ENDSELECT. 
+ 
+set new line count:
+  out ("lines="); gethex (buf); maxlines := dec (buf).
+
+set address trap: 
+  IF trap set 
+  THEN putline ("current trap address: " CT txt (atrap hi) CT hex (atrap lo));
+       out ("type <CR> to confirm, or ")
+  ELSE out ("type ")
+  FI;
+  out ("new trap addr ("); 
+  IF std procs traceable THEN out ("2") ELSE out ("3") FI; 
+  out ("0000...3ffff), or 0 for no trap:"); 
+  gethex (buf); 
+  IF buf <> "" 
+  THEN IF trap set THEN restore instruction; trap set := FALSE FI; 
+       buf:="0000" CT buf; 
+       atrap hi := dec (subtext (buf, LENGTH buf-7, LENGTH buf-4)); 
+       atrap lo := dec (subtext (buf, LENGTH buf-3)); 
+       IF atrap hi=3 OR atrap hi=2 AND std procs traceable 
+       THEN saved instr := dsgetw (stdds, atrap hi, atrap lo); 
+            dsputw (stdds, atrap hi, atrap lo, call to trace); 
+            IF longcall to trace flag 
+            THEN saved instr w2 := dsgetw (stdds, atrap hi, atrap lo PLUS 1); 
+                 dsputw (stdds, atrap hi, atrap lo PLUS 1, call2 to trace); 
+            FI; 
+            trap set := TRUE 
+       ELIF NOT (atrap hi=0 AND atrap lo=0) 
+       THEN out (beep); putline ("address not in above range") 
+       FI 
+  ELSE IF NOT trap set THEN out (beep); putline ("no trap specified") FI 
+  FI. 
+ 
+initialize protocol: 
+  pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; 
+  code addr modif := dsgetw (stdds, stack area, lbase + 3) 
+                  AND lo byte mask; 
+  set stpdis flag on stack; 
+  prot just started := TRUE; 
+  protocol := TRUE. 
+ 
+set stpdis flag on stack: 
+  word := dsgetw (stdds, stack area, lbase + 2); 
+  dsputw (stdds, stack area, lbase + 2, word OR stpdis mask1). 
+ 
+restore users stpdis flag on stack: 
+  word := dsgetw (stdds, stack area, lbase + 2) AND stpdis mask0; 
+  IF users stpdis THEN word := word OR stpdis mask1 FI; 
+  dsputw (stdds, stack area, lbase + 2, word). 
+ 
+protocol instruction and set nails: 
+  protocol instr; 
+  SELECT iclass OF 
+    CASE 0:  standard ops 
+    CASE 1:  cond branch ops 
+    CASE 2:  branch ops 
+    CASE 3:  comp branch op 
+    CASE 4:  call op 
+    CASE 5:  exec op 
+    CASE 6:  pcall op 
+    CASE 7:  return ops 
+    CASE 8:  penter op 
+    CASE 9:  pp ops 
+    CASE 10: line ops 
+    CASE 11: stop ops 
+    CASE 12: ke op 
+    CASE 13: clrerr op
+    OTHERWISE: wrong ops 
+  ENDSELECT; 
+  IF protocol THEN set nail1 FI. 
+ 
+protocol instr: 
+  word1 := dsgetw (stdds, ic hi, ic lo); 
+  disa (ic hi, ic lo, iname, ioplist, ilen, iclass); 
+  protocol this instr. 
+ 
+protocol this instr: 
+  possibly delete command line; 
+  outsubtext (blanks, 1, indentpos); 
+  ic h := ic hi; ic l := ic lo; 
+  out (txt (ic h)); out (hex (ic l)); out (": "); 
+  out (iname); out (" "); 
+  IF ilen > 0 
+  THEN FOR i FROM 1 UPTO ilen 
+       REP out (hex (dsget2b (stdds, ic h, ic l))); out (" "); 
+           ic l INCR 1 PER 
+  ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (" ") 
+  FI; 
+  IF prot operands THEN protocol operands FI. 
+
+possibly delete command line: 
+  IF prot just started 
+  THEN prot just started := FALSE; 
+       IF prot stopped 
+       THEN prot stopped := FALSE 
+       ELSE delete command line 
+       FI 
+  FI. 
+ 
+delete command line: 
+  get cursor (xpos, ypos); cursor (1, ypos-1); out(""4""). 
+ 
+protocol operands: 
+  out ("  "); 
+  IF (word1 AND mask 7f00) = mask 7f00 
+  THEN ic off := 1 
+  ELSE ic off := 0 
+  FI; 
+  res types := ""; 
+  no of results := 0; 
+  FOR opd ptr FROM 1 UPTO LENGTH ioplist REP 
+    opd type := ioplist SUB opd ptr; 
+    IF opd type <> " " 
+    THEN case := pos ("irtdpahIRTDPEH", opd type); 
+         IF case > 0 
+         THEN eval opd addr (ic off); 
+              SELECT case OF 
+                CASE 1: prot int rd opd 
+                CASE 2: prot real rd opd 
+                CASE 3: prot text rd opd 
+                CASE 4: prot dataspace rd opd 
+                CASE 5: prot task rd opd 
+                CASE 6: prot virt addr 
+                CASE 7: prot hex rd opd 
+                OTHERWISE save res type 
+              ENDSELECT 
+         FI; 
+         ic off INCR 1 
+    FI 
+  UNTIL opd type = " " PER. 
+ 
+save res type: 
+  res types CAT opd type; 
+  no of results INCR 1; 
+  res ds    (no of results) := opdds; 
+  res opadh (no of results) := opad hi; 
+  res opadl (no of results) := opad lo. 
+ 
+protocol result operands: 
+  FOR opd ptr FROM 1 UPTO no of results REP prot this result PER.
+ 
+prot this result: 
+  opdds   := res ds    (opd ptr); 
+  opad hi := res opadh (opd ptr); 
+  opad lo := res opadl (opd ptr); 
+  opd type := res types SUB opd ptr; 
+  SELECT pos ("IRTDPEH", opd type) OF 
+    CASE 1: prot int result 
+    CASE 2: prot real result 
+    CASE 3: prot text result 
+    CASE 4: prot dataspace result 
+    CASE 5: prot task result 
+    CASE 6: prot eva result 
+    CASE 7: prot hex result 
+    OTHERWISE out (opd type CT "(???) ") 
+  ENDSELECT. 
+ 
+prot int rd opd: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out (">"); out int opd; out (" "). 
+ 
+prot int result: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out int opd; out ("> "). 
+ 
+prot hex rd opd: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out (">"); out (hex (int opd)); out (" "). 
+ 
+prot hex result: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out (hex (int opd)); out ("> ").
+ 
+prot real rd opd: 
+  out (">"); 
+  out (hex (dsget2b (opdds, opad hi, opad lo))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); out (" "). 
+ 
+prot real result: 
+  out (hex (dsget2b (opdds, opad hi, opad lo))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); 
+  out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); 
+  out ("> "). 
+ 
+prot text rd opd: 
+  fetch text opd; 
+  out (">"); out (text opd); out (" "). 
+ 
+prot text result: 
+  fetch text opd; 
+  out (text opd); out ("> "). 
+ 
+prot dataspace rd opd: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out (">"); out (hex (int opd)); out (" "). 
+ 
+prot dataspace result: 
+  int opd := dsgetw (opdds, opad hi, opad lo); 
+  out (hex (int opd)); out ("> "). 
+ 
+prot task rd opd: 
+  out (">"); out (hex (dsgetw (opdds, opad hi, opad lo))); 
+  out ("/"); out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out (" "). 
+ 
+prot task result: 
+  out (hex (dsgetw (opdds, opad hi, opad lo))); out ("/"); 
+  out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out ("> "). 
+ 
+prot virt addr: 
+  out (">"); out (hex (opad hiword)); out (hex (opad lo)); out (" "). 
+ 
+prot eva result: 
+  out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); 
+  out (hex (dsgetw (opdds, opad hi, opad lo))); 
+  out (">").  
+ 
+standard ops: 
+  nail1 hi := ic hi; nail1 lo := ic lo PLUS ilen. 
+ 
+set nail1: 
+  saved1 := dsgetw (stdds, nail1 hi, nail1 lo); 
+  dsputw (stdds, nail1 hi, nail1 lo, call to trace); 
+  IF longcall to trace flag 
+  THEN saved1 w2 := dsgetw (stdds, nail1 hi, nail1 lo PLUS 1); 
+       dsputw (stdds, nail1 hi, nail1 lo PLUS 1, call2 to trace) 
+  FI. 
+ 
+set nail2: 
+  saved2 := dsgetw (stdds, nail2 hi, nail2 lo); 
+  dsputw (stdds, nail2 hi, nail2 lo, call to trace); 
+  IF longcall to trace flag 
+  THEN saved2 w2 := dsgetw (stdds, nail2 hi, nail2 lo PLUS 1); 
+       dsputw (stdds, nail2 hi, nail2 lo PLUS 1, call2 to trace) 
+  FI. 
+ 
+cond branch ops: 
+  cond br follows := TRUE; 
+  cond br hi := ic hi; cond br lo := ic lo PLUS ilen; 
+  nail1 hi := cond br hi; nail1 lo := cond br lo PLUS 1; 
+  eval br addr (cond br hi, cond br lo, nail2 hi, nail2 lo); 
+  no of nails := 2; set nail2. 
+ 
+branch ops: 
+  eval br addr (ic hi, ic lo, nail1 hi, nail1 lo). 
+ 
+comp branch op: 
+  eval opd addr (1); 
+  brcomp index := dsgetw (stdds, opad hi, opad lo); 
+  IF brcomp index < 0 OR brcomp index >= dsgetw (stdds, ic hi, ic lo PLUS 2) 
+  THEN brcomp index := -1 
+  FI; 
+  nail1 hi := ic hi; 
+  nail1 lo := ic lo PLUS ilen PLUS brcomp index PLUS 1. 
+ 
+call op: 
+  eval module no; 
+  call or exec. 
+ 
+call or exec: 
+  IF module no < 1280 AND NOT std procs traceable 
+  THEN possibly append proc head; 
+       out (" (*n.t.*)"); 
+       nontraceable found := TRUE 
+  ELSE check for nontraceable 
+  FI; 
+  IF NOT nontraceable found 
+  THEN restore users stpdis flag on stack; 
+       get proc address via module link table; 
+       possibly append proc head; 
+       indentpos INCR indentincr; 
+       nail1 hi := ic hi; nail1 lo := ic lo PLUS 1 (*nail behind head*) 
+  ELIF call to trace found 
+  THEN skip instruction 
+  ELIF possibly call to bool proc 
+  THEN cond branch ops 
+  ELSE standard ops 
+  FI. 
+ 
+eval module no: 
+  IF word1 = longcall opcode
+  THEN module no := dsgetw (stdds, ic hi, ic lo PLUS 1)
+  ELSE module no := word1 AND opcode mask0; 
+       IF (module no AND mask 8000) <> 0 
+       THEN module no := module no AND mask 7fff OR mask 0400 
+       FI
+  FI. 
+ 
+check for nontraceable: 
+  nontraceable found := FALSE; 
+  IF word1 = longcall opcode 
+  THEN word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); 
+       FOR j FROM 1 UPTO no of long nontraceables REP 
+         IF word 2 = call2 to nontraceables (j) 
+         THEN out (names of long nontraceables (j)); 
+              nontraceable found := TRUE 
+         FI 
+       UNTIL nontraceable found PER 
+  ELSE FOR j FROM 1 UPTO no of nontraceables REP 
+         IF word1 = calls to nontraceables (j) 
+         THEN out (names of short nontraceables (j)); 
+              nontraceable found := TRUE 
+         FI 
+       UNTIL nontraceable found PER 
+  FI. 
+ 
+get proc address via module link table: 
+  IF module no < 1280 THEN ic hi := 2 ELSE ic hi := 3 FI; 
+  ic lo := dsgetw (stdds, packet area, m l t start + module no). 
+ 
+possibly append proc head: 
+  out (proc head (module no)). 
+ 
+skip instruction: 
+  ic lo INCR ilen; update icount on stack; 
+  nail1 hi := ic hi; nail1 lo := ic lo. 
+ 
+possibly call to bool proc: 
+  word := dsgetw (stdds, ic hi, ic lo PLUS ilen) AND ln br mask1; 
+  word = ln opcode OR word = br opcode. 
+ 
+exec op: 
+  eval opd addr (1); 
+  module no := dsgetw (stdds, opad hi, opad lo); 
+  call or exec. 
+  
+pcall op: 
+  eval opd addr (1); 
+  IF opad lo = 2 AND NOT std procs traceable 
+  THEN out (" (*n.t.*)"); 
+       nontraceable found := TRUE 
+  ELSE check for nontraceable pproc 
+  FI; 
+  IF NOT nontraceable found 
+  THEN restore users stpdis flag on stack; 
+       possibly append proc head for pproc; 
+       indentpos INCR indentincr; 
+       nail1 hi := opad hi; nail1 lo := opad lo PLUS 1 (*nail behind head*) 
+(*ELIF word1 = call to trace 
+  THEN skip instruction *) 
+  ELIF possibly call to bool proc 
+  THEN cond branch ops 
+  ELSE standard ops 
+  FI. 
+ 
+check for nontraceable pproc: 
+  nontraceable found := FALSE; 
+  IF opad lo = pproc ic lo 
+  THEN FOR j FROM 1 UPTO no of nontraceables REP 
+         IF pproc call = calls to nontraceables (j) 
+         THEN out (names of nontraceables (j)); 
+              nontraceable found := TRUE 
+         FI 
+       UNTIL nontraceable found PER 
+  ELSE nontraceable found := TRUE  (*to be on the secure side*) 
+  FI. 
+ 
+possibly append proc head for pproc: 
+  IF opad lo = pproc ic lo 
+  THEN out (proc head (pproc modno)) 
+  FI. 
+ 
+return ops: 
+  fetch eumel0 regs of caller from users stack; 
+  out ("--> ");
+  put users flags; 
+  IF (old flags AND aritu mask1) <> 0
+  THEN put ("ARITU")
+  ELSE put ("ARITS")
+  FI;
+  IF nontraceable caller 
+  THEN line; putline ("trace ended by returning to nontraceable caller"); 
+       protocol := FALSE; prot stopped := TRUE 
+  ELIF users error AND NOT users stpdis
+  THEN stop op
+  ELSE set nail for return ops 
+  FI. 
+ 
+set nail for return ops: 
+  IF word1 = rtn opcode 
+  THEN nail1 hi := ic hi; nail1 lo := ic lo 
+  ELSE nail1 hi := ic hi; nail1 lo := ic lo PLUS 1; 
+       eval br addr (ic hi, ic lo, nail2 hi, nail2 lo); 
+       no of nails := 2; set nail2 
+  FI. 
+ 
+penter op: 
+  pbase := word1 AND lo byte mask; rotate (pbase, 8); 
+  standard ops. 
+  
+line ops: 
+  standard ops. 
+ 
+stop ops: 
+  IF word1 = estop opcode 
+  THEN users stpdis := FALSE; 
+       IF users error THEN stop op ELSE standard ops FI 
+  ELIF word1 = dstop opcode 
+  THEN users stpdis := TRUE; standard ops 
+  ELSE stop op 
+  FI. 
+ 
+clrerr op:
+  users error := FALSE; standard ops.
+
+ke op: 
+  skip instruction; 
+  line; putline ("INFO: ke"); 
+  info (stdds, ic hi, ic lo, info lines);
+  single step := TRUE.
+
+pp ops: 
+  save modno and ic lo if pproc; 
+  look at next instr; 
+  WHILE iclass1 = 9 REP 
+    ic lo INCR ilen; iname := iname1; ioplist := ioplist1; 
+    ilen := ilen1; iclass := iclass1; 
+    line; lines INCR 1;
+    protocol this instr; 
+    save modno and ic lo if pproc; (*only the first one will be saved!!!*) 
+    look at next instr 
+  PER; 
+  standard ops. 
+ 
+save modno and ic lo if pproc: 
+  IF word1 = pproc opcode 
+  THEN pproc modno := dsgetw (stdds, ic hi, ic lo PLUS 1); 
+       IF pproc modno < 256 
+       THEN putline ("*** this looks like a compiler error ***"); 
+            protocol := FALSE; prot stopped := TRUE; users error := TRUE; 
+            users errcode := 0; users errmsg := ("maybe a compiler error"); 
+            LEAVE normal processing of instructions 
+       ELIF (pproc modno AND mask 0400) <> 0 
+       THEN word := (pproc modno AND mask fbff) OR mask 8000 
+       ELSE word := pproc modno 
+       FI; 
+       pproc call := word OR opcode mask1; 
+       pproc ic lo := dsgetw (stdds, packet area, m l t start + pproc modno) 
+  FI. 
+   
+look at next instr: 
+    word1 := dsgetw (stdds, ic hi, ic lo PLUS ilen); 
+    disa (ic hi, ic lo PLUS ilen, iname1, ioplist1, ilen1, iclass1). 
+ 
+wrong ops: 
+  putline ("**** das kann ich (noch) nicht!!! ***"); 
+  info (stdds, ic hi, ic lo, info lines); 
+  protocol := FALSE. 
+ 
+show registers: 
+  pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; 
+  code addr modif := dsgetw (stdds, stack area, lbase + 3) 
+                  AND lo byte mask; 
+  putline ("----------------- EUMEL0-registers: ------------------"); 
+  put ("icount=" CT txt (ic hi) CT hex (ic lo) CT 
+       " lbase=1" CT hex (users lbase) CT " pbase=" CT hex (pbase)); 
+  put users flags;
+  IF (flags AND aritu mask1) <> 0
+  THEN putline ("ARITU")
+  ELSE putline ("ARITS")
+  FI.
+
+put users flags:
+  IF users stpdis 
+  THEN put ("STPDIS") 
+  ELSE put ("STOPEN") 
+  FI; 
+  IF users error 
+  THEN put ("ERROR") 
+  ELSE put ("NOERR") 
+  FI. 
+ 
+ENDPROC trace; 
+ 
+ 
+PROC stop op: 
+  line; 
+  suppress result protocolling; 
+  REP outsubtext (blanks, 1, indentpos); 
+      fetch eumel0 regs of caller from users stack; 
+      out ("stop/error induced return to addr "); 
+      out (txt (ic hi)); out (hex (ic lo)); 
+      IF users stpdis 
+      THEN putline (" (STPDIS)")
+      ELSE putline (" (STOPEN)") 
+      FI; 
+      lines INCR 1;
+      IF nontraceable caller 
+      THEN putline ("trace ended by returning to nontraceable caller"); 
+           protocol := FALSE; prot stopped := TRUE 
+      ELIF users stpdis 
+      THEN copy stack of disabled caller to tracers stack 
+      ELSE users lbase := dsgetw (stdds, stack area, users lbase) 
+      FI 
+  UNTIL users stpdis OR NOT protocol PER; 
+  nail1 hi := ic hi; nail1 lo := ic lo. 
+ 
+suppress result protocolling: 
+  no of results := 0. 
+ 
+copy stack of disabled caller to tracers stack: 
+  FOR i FROM 1 UPTO 4 REP 
+    word := dsgetw (stdds, stack area, users lbase + i - 1); 
+    dsputw (stdds, stack area, lbase + i - 1, word) 
+  PER. 
+ 
+ENDPROC stop op; 
+ 
+ 
+i n i t i a l i z e   t r a c e. 
+ 
+nontraceable caller: 
+  ic hi = 2 AND NOT std procs traceable 
+   OR (old flags AND aritu mask1) <> 0 AND (flags AND aritu mask1) = 0. 
+ 
+fetch eumel0 regs of caller from users stack: 
+  indentpos DECR indentincr; 
+  ic lo := dsgetw (stdds, stack area, users lbase + 1); 
+  word := dsgetw (stdds, stack area, users lbase + 2); 
+  ic hi := word AND 3; 
+  old flags := word AND flags mask1; 
+  users stpdis := (old flags AND stpdis mask1) <> 0;
+  pbase := word AND hi byte mask; 
+  code addr modif := dsgetw (stdds, stack area, users lbase + 3) 
+                     AND lo byte mask. 
+ 
+initialize trace: 
+  LET maxno of nontraceables = 20; 
+  INT VAR int, j; 
+  TEXT VAR text; 
+  ROW maxno of nontraceables TEXT VAR names of nontraceables; 
+  ROW maxno of nontraceables TEXT VAR names of short nontraceables; 
+  ROW maxno of nontraceables TEXT VAR names of long nontraceables; 
+  ROW maxno of nontraceables INT VAR calls to nontraceables; 
+  ROW maxno of nontraceables INT VAR call2 to nontraceables; 
+
+  putline("initializing ""trace"" ...");
+  names of nontraceables (1) := "disa (I,I,T,T,I,I) (*n.t.*)"; 
+  names of nontraceables (2) := "disasm (I,I) (*n.t.*)"; 
+  names of nontraceables (3) := "info (I,I,I,I) (*n.t.*)";
+  names of nontraceables (4) := "dec (T) (*n.t.*)"; 
+  names of nontraceables (5) := "hex (I) (*n.t.*)"; 
+  names of nontraceables (6) := "dsget2b (I,I,I) (*n.t.*)"; 
+  names of nontraceables (7) := "trace (*ignored*)"; 
+  trace; (* initialize 'call to trace', 'ic hi' and 'ic lo' *) 
+  IF FALSE THEN 
+     disa (int, int, text, text, int, int); 
+     disasm (int, int); 
+     info (int, int, int, int); 
+     int := dec (text); 
+     text := hex (int); 
+     int  := dsget2b (int, int, int); 
+     trace   (****** must be the last one !!! *****) 
+   FI; 
+   FOR j FROM 1 UPTO maxno of nontraceables REP 
+     REP ic lo INCR 1; 
+         word1 := dsgetw (stdds, ic hi, ic lo) 
+     UNTIL call opcode found PER; 
+     IF word1 <> longcall opcode 
+     THEN no of nontraceables INCR 1; 
+          calls to nontraceables (no of nontraceables) := word1; 
+          names of short nontraceables (no of nontraceables) := 
+               names of nontraceables (j)
+     ELSE no of long nontraceables INCR 1; 
+          word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); ic lo INCR 1; 
+          call2 to nontraceables (no of long nontraceables) := word2;
+          names of long nontraceables (no of long nontraceables) := 
+               names of nontraceables (j) 
+     FI 
+   UNTIL call to trace found 
+         OR no of nontraceables = maxno of nontraceables 
+         OR no of long nontraceables = maxno of nontraceables PER; 
+   putline ("""trace"" initialized:");
+   putline ("        " CT txt (no of nontraceables)
+                       CT " nontraceable shortcalls");
+   putline ("        " CT txt (no of long nontraceables)
+                       CT " nontraceable longcalls"); 
+   IF no of nontraceables = maxno of nontraceables 
+      OR no of long nontraceables = maxno of nontraceables 
+   THEN errorstop ("too many nontraceables") 
+   ELSE test trace 
+   FI. 
+ 
+call opcode found: 
+  (word1 AND opcode mask1) = call opcode OR word1 = longcall opcode. 
+ 
+call to trace found: 
+  IF word1 = call to trace 
+  THEN IF longcall to trace flag 
+       THEN word2 = call2 to trace 
+       ELSE TRUE 
+       FI 
+  ELSE FALSE 
+  FI. 
+ 
+test trace:.
+
+END PACKET trace; 
+
diff --git a/devel/debug/1/src/trace.dok b/devel/debug/1/src/trace.dok
new file mode 100644
index 0000000..7de46f8
--- /dev/null
+++ b/devel/debug/1/src/trace.dok
@@ -0,0 +1,387 @@
+#type ("trium8")##limit (13.0)# 
+#start(3.0,1.5)# 
+#pagelength(18.5)# 
+#block# 
+#type("trium36.b")# 
+#free(3.5)# 
+#center#EUMEL 
+#center#DEBUG 
+#type("trium18.b")# 
+#free(1.4)# 
+#center#Version 1 
+#center#87-04-24 
+ 
+#center#G. Szalay 
+#page(1)# 
+#type ("trium8")##limit (13.0)# 
+#head# 
+#center#- % - 
+ 
+ 
+#end# 
+#type ("trium14.b")# 
+#center#E U M E L - D E B U G 
+ 
+#type ("trium12.b")# 
+#center#Task-local Debugging Tools for EUMEL: 
+#center##type("trium12.bc")#info, disasm, #type("trium12.b")#and #type("trium12.bc")#trace 
+ 
+ 
+#b("1.  Features")# 
+ 
+#it("info:")#    display and modification of a dataspace on the users terminal in the conventional dump
+         format; search for a bytestring; 
+ 
+#it("disasm:")#  disassembly of EUMEL-0-code out of the standard dataspace using symbolic opcodes
+         and procedure heads; 
+ 
+#it("trace:")#   tracing of user programs, protocolling of executed instructions and their actual operands,
+         trap at a given code address, single-step-mode, multiple-step-mode (interruptable at
+         any time) 
+ 
+The procedures have no effect outside the task. Especially no other task will be halted by using the
+single-step mode. 
+ 
+ 
+#b("2.  Installation")# 
+ 
+The debugging tools need a suitable system kernel ("Urlader"). They can be used with kernels for
+processors Z80, 8086 and 80286 with versions 190 \#14, 181 \#347 \#1347, 180 \#347 \#1347 and higher,
+and with 68000-kernel version \#3600 and higher. 
+ 
+The archive diskette "trace" contains all necessary files. The commands 
+#inb# 
+   archive ("trace"); 
+   fetchall (archive); 
+   run ("gen.trace") 
+#ine# 
+insert all source files and generate a dataspace "procheads" containing procedure heads of all
+inserted procedures (including the standard ones). Then the current task becomes a local mana­
+ger. Now a son task may be created, in which the debugging tools are available. 
+ 
+The first time when (in a son task) #it("disasm")# or #it("trace")# protocols a CALL-instruction the dataspace
+'procheads' will be fetched from the father task for subsequent usage. If for any reason (e.g. after
+inserting new packets, see below) the user will change or re-install 'procheads'  he has to inform
+the debugging procedures by issuing the command 
+#inb#   set procheads ("procheads") #ine# 
+ 
+Access to the dataspace "procheads" may be suppressed by 
+#inb#   set procheads ("") #ine# 
+ 
+Procedures inserted at a later time by the user should be added to the dataspace "procheads" (in the
+current task!) by typing the commands 
+#inb# 
+   bulletin m ("<packetname>"); 
+   run ("gen.procheads") 
+#ine# 
+ 
+ 
+ 
+#b("3.  Description of the debugging procedures")# 
+ 
+#b1("3.1  PROC info ")# 
+ 
+The standard output is a hexadecimal dump of a dataspace in the following format: 
+ 
+#outb# 
+---------------------------- dsid=xx -------------------- 
+xxxxx: -xx-xx xx xx xx xx xx xx   xx xx xx xx xx xx xx xx  yyyyyyy......... 
+xxxxx:  xx xx xx ...                                       ..... 
+xxxxx:  xx xx ...                                          ... 
+xxxxx:  xx xx xx xx xx xx xx xx   xx xx xx xx xx xx xx xx  .........yyyyyyy 
+#re("INFO: more, address, dsid, lines, find, or quit")# 
+#oute# 
+ 
+ 
+The first line displays the dataspace identifier (4 <= dsid <= ff, dsid=4 identifies the standard
+dataspace). 
+The dump lines begin with the hexadecimal word (!) address of the first word on this line. The order
+of bytes is the same as on EUMEL-'Hintergrund': low byte, high byte. Following the hexadecimal
+display of 16 bytes they will be shown as ascii-characters, too. Non-ascii characters will be
+displayed as '.'. 
+ 
+The last line shows (as with #it("disasm")# and #it("trace")#, too) possible commands which will be recognized by
+their first letter. If a parameter is needed, it has to be typed as a hexadecimal number followed by a
+<CR>. The <RUBOUT> key may be used to delete the last input character(s). 
+Possible commands and their effect: 
+ 
+m (more):     continues displaying at the next higher address 
+ 
+a (address):  specifies a new address 
+ 
+d (dsid):     specifies a new dataspace identifier 
+ 
+l (lines):    specifies a new line count (=window height); this value may be larger than the
+              number of lines of the terminal screen. 
+ 
+f (find):     (tries to) find a hexadecimal or character bytestring. The prompting message 
+#outb# 
+                   find: hex, char, or last param? (h/H/c/C/<CR>) 
+#oute# 
+              may be answered in several ways. Examples: 
+ 
+              #inb#h41<CR>#ine#    looks for a byte 41h, beginning at the actual position, marked by -xx-. 
+ 
+              #inb#Hcafe<CR>#ine#  searches the bytestring 0cafeh, beginning at the actual word address.
+                         Only strings at word addresses will be concerned for a comparison. 
+ 
+              #inb#challo<CR>#ine# searches the character string "hallo", beginning at the actual position. 
+ 
+              #inb#Ca<CR>#ine#     searches the letter "a", which has to be located at a word address.
+                         #inb#H41<CR> #ine#has the same effect. 
+ 
+              #inb#<CR>#ine#       searches the last bytestring explicitly specified in a search command,
+                         beginning #bo("behind")# the marked position. The last parameter will be shown
+                         during the search. 
+ 
+              The search can be interrupted at any time by pressing a key. It may then be conti­
+              nued by a new 'find' command and <CR>. 
+ 
+q (quit):  leaves #it("info")# . 
+ 
+Instead of a command the dataspace can be modified within the displayed area by the key-
+sequence 
+   <UP>                       positions the cursor to the first displayed byte; 
+   <Cursorkey>...             moves the cursor within the hexadecimal display; 
+   <2 hexadecimal digits>...  overwrite the byte under the cursor; 
+   <CR>                       leaves the window. 
+ 
+Note: in the standard dataspace changes within the address range 20000...2ffff are only allowed in
+      conjunction with a 68000-kernel (see also 3.3, note a.). 
+ 
+ 
+ 
+#b1("3.2  PROC disasm ")# 
+ 
+EUMEL-0-code in the address range 20000...3ffff of the standard dataspace will be disassem­
+bled. The code will be listed one instruction per line, using symbolic opcodes and (in case of a CALL
+instruction) procedure heads as found in the dataspace "procheads". 
+ 
+The following example shows the disassembled code of the standard procedure 
+ 
+REAL OP MOD (REAL CONST left, right): 
+  REAL VAR result := left - floor (left/right) * right; 
+  IF result < 0.0 
+     THEN result + abs (right) 
+     ELSE result 
+  FI 
+ENDOP MOD; 
+ 
+#outb# 
+23edd:  LN      2000 
+23ede:  PENTER  15fe 
+23edf:  FDIV    09c4 0d80 2880 
+23ee2:  FLOOR   637f 2880 2880 
+23ee5:  FMUL    28c0 0d80 2880 
+23ee8:  FSUB    09bc 2880 1880 
+23eeb:  FLSEQ   6049 1880 
+23eed:  BT      f700 
+23eee:  PP      0dec 
+23eef:  PP      28ec 
+23ef0:  CALL    5d79   abs (REAL C) --> REAL 
+23ef1:  FADD    18b8 2880 2880 
+23ef4:  REF     28dc 2080 
+23ef6:  B       f970 
+23ef7:  REF     18dc 2080 
+23ef9:  FMOV    21b4 1180 
+23efb:  RTN     007f 
+#re("DISASM: step, more, address, lines, info, or quit")# 
+#oute# 
+ 
+Possible commands: 
+ 
+s (step):     shows the next instruction on the terminal. The command line will be rewritten. 
+ 
+m (more):     shows the next instructions. The output will stop after 'lines' (standard=12) lines. It
+              can be interrupted at any time by pressing any key. The output list terminates, when
+              an invalid opcode has been detected or when the instruction count exceeds 3ffff. 
+ 
+a (address):  specifies a new code address. Disassembly continues at this address. 
+ 
+l (lines):    specifies a new line count; this value may be larger than the number of lines of the
+              terminal screen. 
+ 
+i (info):     calls #it("info")#. The first line of dump contains the first word of the next instruction not yet
+              disassembled. This word will be marked. (After leaving #it("info")# disassembly would
+              continue with this instruction.) 
+ 
+q (quit):     leaves #it("disasm")#. 
+ 
+ 
+#b1("3.3  PROC trace ")# 
+ 
+#it("trace")# allowes controlled execution of subsequent EUMEL-0-code. The effect of the trace-mode
+can be demonstrated by showing the protocol produced by 
+ 
+    #inb#trace; putline ("hallo")<CR> 
+ 
+    #ine##outb##re("TRACE: step, more, trap, regs, lines, info, disasm, or quit")# 
+#oute##inb# 
+    p 
+ 
+#ine##outb# 
+        34afb: PP       006d   >00009000 
+        34afc: CALL     f37a   putline (TEXT C) 
+          28d63: PENTER   38fe 
+          28d64: TEST     c828   >0 
+          28d65: BF       6b70 
+          28d66: OUT      3c7f 0980   >"hallo" hallo 
+          28d68: OUT      3c7f 6c01   >""13""10"" 
+ 
+          28d6a: B        6e70 
+          28d6e: RTN      007f   --> STOPEN NOERR ARITS 
+        34afd: RTN      007f   --> STOPEN NOERR ARITS 
+      20944: RTN      007f   --> STPDIS NOERR ARITU 
+  trace ended by returning to nontraceable caller 
+#oute# 
+ 
+Comments on this output: 
+-  the indentation of the protocol lines shows the call depth. 
+-  in order to get 1 line per instruction as often as possible, some abbreviations are used in the
+   procedure heads: 'C' for 'CONST', 'V' for 'VAR', 'DS' for 'DATASPACE'. 
+-  the first occurrence of the string 'hallo' is part of the protocol. The second one is a result of the
+   execution of the (first) OUT-instruction. The blank line is produced by the second OUT-instruc­
+   tion! 
+-  the flags given with a RTN-instruction reflect the flag settings #bo("after")# execution of the RTN: 
+      STOPEN = stop enabled         STPDIS = stop disabled 
+      NOERR  = no error             ERROR  = error occurred 
+      ARITS  = signed arith mode    ARITU  = unsigned arith mode 
+ 
+ 
+Possible commands: 
+ 
+s (step):    executes and protocols one instruction (=single-step-mode). For reasons of the
+             implementation, consecutive PP-instructions will be executed as one single step. The
+             same holds for instructions followed by a conditional branch (e.g. EQU+BT). 
+ 
+             The protocol contains also actual operand values. Example: 
+#inb# 
+ 
+                 trace;INT VAR a:= 2 + 11 
+#ine##outb# 
+ 
+                 34afb: ADD      001d 0101 5400   >2 >11(000b) 13(000d)> 
+#oute# 
+ 
+             '>' in front of a value indicates input-operand; 
+             '>' behind a value indicates output-operand. (For the instructions MOV, FMOV and
+             TMOV only 1 (output-)operand will be shown.) 
+             INT-objects are shown decimal and (in parentheses) hexadecimal (4 digits). The
+             numbers 0 to 9 will be shown only decimal. 
+             REAL-objects will be shown in the internal representation (e.g. 11.5 as
+             0115000000000082) 
+             TEXT-objects will be shown as text denoters. Non-ascii characters will be converted
+             (see example). For long texts only the first 14 characters will be shown, followed by
+             the (correct) number of characters. 
+             All other objects (TASKs, DATASPACEs and effective virtual addresses) will be shown
+             hexadecimal (4 or 8 digits). 
+ 
+m (more):    executes and protocols up to 'line count' (standard=12) instructions. Execution can be
+             interrupted at any time by any key, and resumed by commands 's' or 'm'. 
+ 
+t (trap):    sets a trap on a code address. As soon as the instruction count reaches the specified
+             value, the message 
+#outb# 
+                trap at address ..... 
+#oute# 
+             will be displayed and the execution stopped. (The instruction at the trap address is the
+             next one to be executed!) At the same time the trap is deleted. 
+ 
+r (regs):    shows the relevant EUMEL-0-registers 'icount' (address of the instruction to be
+             executed next), 'pbase' (=packet base, base address for packet data), 'lbase' (=local
+             base, base address for local data on stack) as well as flag registers
+             (STOPEN/STPDIS, NOERR/ERROR, ARITS/ARITU). 
+ 
+l (lines):   specifies a new line count; this value may be larger than the number of lines of the
+             terminal screen. 
+ 
+i (info):    calls #it("info")#, s. 3.1. The instruction word pointed to by the instruction count is the actual
+             position, marked on the first line. 
+ 
+d (disasm):  calls #it("disasm")#, s. 3.2. Disassembly begins at the next instruction not yet executed. 
+ 
+q (quit):    leaves the trace-mode. However, a trap (see above) may still be in effect! Tracing
+             will be #bo("implicitly")# finished as soon as a RTN-instruction returns to a procedure
+             running in the 'unsigned arithmetic'-mode. (Regularly this is the ELAN-Compiler.) 
+ 
+ 
+#bo("Important Notes ")# 
+ 
+Erroneous use of #it("info")# and #it("trace")# may destruct your task. Therefore read carefully and observe follow­
+ing notes: 
+ 
+a. In order to gain control at proper points of the code area, #it("trace")# temporarily modifies the user code
+   by inserting instructions (CALLs to itself) into it. On EUMEL-hardware based on Z80, 8086, or
+   80286, #it("trace")# does not allow modification of address range 20000...2ffff for reasons of storage
+   management strategy. Therefore calls to procedures occupying this address range will be marked
+   in the protocol by "(*n.t.*)" (for 'nontraceable') and executed normally, i.e. not protocolled. 
+ 
+   WARNING:   execution of a nontraceable procedure cannot be interrupted by <SV> and 'halt'. So
+              be careful! 
+ 
+b. Traps may only be set on the first word of an instruction. In a sequence of consecutive PP-
+   instructions only the first one may be trapped. In the same manner, a conditional branch (BT / BF)
+   following another instruction (e.g. EQU) may not be trapped. 
+ 
+c. On inserting #it("trace")# it may get a module number > 2047. In that case the CALL to #it("trace")# occupies
+   2 words. The user will be informed of this fact at the time just after inserting #it("trace")#: 
+      #outb# 
+      WARNING: call to trace needs 2 words! 
+      #oute# 
+   In this situation special care has to be taken to set a trap, e.g.: 
+ 
+#outb# 
+            LSEQ    xxxx xxxx 
+            BT      xxxx        (*branch on true to address a*) 
+            ... 
+            ... 
+      a-1:  B       xxxx 
+        a:  ... 
+#oute# 
+ 
+   In this example the branch instruction at address 'a-1' may not be trapped because the following
+   instruction (at 'a') would be destroyed by a 2-word-CALL to #it("trace")#. A jump to 'a' would have an
+   undefined effect. So be careful! First inspect the code environment by using #it("disasm")# and then set
+   a trap at a suitable address! 
+ 
+d. In the current version of #it("trace")# a trap will be implicitly deleted as soon as it has become active. If
+   the user wants (e.g. in a loop) to trap a given address again and again, he has to choose a
+   second suitable address, too, and alternately set a trap at these addresses. (A trap may be 
+   #bo("explicitly")# deleted by specifying 0 as trap address.) 
+ 
+e. One may be tempted to trace the ELAN-compiler by writing 
+ #inb# 
+      trace; do ("..........") 
+ #ine# 
+   which seems to work indeed for dozens of lines but at some point it begins to deliver wrong
+   results even with such trivial instructions as an integer ADD. This trouble arises from a storage
+   assignment policy during compilation of the ELAN compiler: temporary storage (e.g. for calculating
+   the value of an expression) will be assigned above the stack top of a procedure if it does not call
+   any other one. An #bo("implicit")# CALL to #it("trace")# causes a further stack frame to be established thus
+   possibly overwriting some temporary values of a compiler procedure. (Of course, the compiler
+   cannot know anything about CALLs inserted by #it("trace")# into the code area!) 
+ 
+f. Errors (e.g. overflow) in user programs will be detected by #it("trace")# at the point of their occurrence
+   and reported in the protocol. However, #it("trace")# has no influence on the error handling, i.e. it does
+   not turn off the error flag by itself, nor causes it an error stop on the users level. (#it("trace")# may be
+   seen as an extension of the virtual EUMEL-0-machine offering some additional features but still
+   fully controlled by the users program.) 
+ 
+g. Each time when the user has control within #it("trace")#, the users code area contains no other patches
+   than a possible CALL at the trap address if specified. 
+ 
+h. The procedures #it("trace, disasm, info")#, and some others used by them are nontraceable. The body of
+   these procedures will not be protocolled. CALLs to them will be marked as nontraceable. Explicit
+   CALLs to #it("trace")# (i.e. in addition to the first call to switch on the trace mode) will be ignored. 
+ 
+i. In trace-mode the EUMEL-0-instruction KE has the same effect as an explicit call to #it("info")#. 
+ 
+j. Protocolling the execution produces output in addition to output programmed by the user. This
+   may lead to unexpected results when the user program specifies cursor positioning. The cursor
+   will always be moved to the position (10,13) instead of the position specified by the user. This is
+   due to the fact that cursor positioning takes place in two steps. One OUT instruction sends the
+   escape character for 'cursor positioning' (=""6""), and a second one sends two bytes containing
+   the coordinate values. The protocol line containing the first OUT will be followed by a lf-cr-
+   sequence (""10""13"") before the next protocol line can be written.  
+
+
diff --git a/devel/debugger/1.8.2/doc/DEBUGGER.PRT b/devel/debugger/1.8.2/doc/DEBUGGER.PRT
new file mode 100644
index 0000000..f5ec838
--- /dev/null
+++ b/devel/debugger/1.8.2/doc/DEBUGGER.PRT
@@ -0,0 +1,2021 @@
+*************************************************************************** 

+***                                                                     *** 

+***                      D o k u m e n t a t i o n                      *** 

+***                          zum EUMEL-Debugger                         *** 

+***                                                                     *** 

+***                      Autor: Michael Staubermann                     *** 

+***                      Stand der Dokumentation: 03.12.86              *** 

+***                      Stand des Debuggers:     01.12.86              *** 

+***                                                                     *** 

+*************************************************************************** 

+ 

+1.     Anwendung des Debuggers 

+1.1    Code Disassembler (Decoder) 

+1.1.1  Datenrepräsentation 

+1.1.2  Datenadressen 

+1.1.3  Codeadressen 

+ 

+1.2    Ablaufverfolgung (Tracer) 

+ 

+2.     Die EUMEL0-Instruktionen 

+2.1    Erläuterung der Instruktionen (Thematisch sortiert) 

+2.2    Alphabetische Liste der Instruktionen 

+ 

+3.     Beschreibung der Pakete 

+3.1    PACKET address 

+3.2    PACKET table routines 

+3.3    PACKET eumel decoder 

+3.4    PACKET tracer 

+ 

+#page# 

+#ub#1.  Anwendung des Debuggers#ue# 

+ 

+Der EUMEL-Debugger ist für die Software-Entwickler und nicht für die

+Anwender dieser Software gedacht. Insbesondere bei der Entwicklung

+systemnaher Software, wie z.B. Compiler, ist der Debugger hilfreich. 

+ 

+(ELAN-)Programme werden wie bisher compiliert (z.B. insertiert), ohne daß

+der Quelltext des Programmes vorher modifiziert werden müßte. Um den

+Sourcetext während der Ablaufverfolgung (Trace) beobachten zu können,

+müßen die Programme mit 'check on' übersetzt werden. 

+ 

+Die sinnvolle Anwendung des Debuggers setzt allerdings Kenntnis der

+EUMEL0-Instruktionen voraus, die im Kapitel 2 erläutert werden (Der Debugger

+setzt die Codierung BIT-A für diese Instruktionen voraus, d.h. er läuft

+zumindest in der interpretativen EUMEL0-Version.).

+ 

+ 

+#ub#1.1  Code Disassembler (Decoder)#ue# 

+ 

+Der Decoder konvertiert die vom Compiler erzeugte Bitcodierung (16 Bit) in

+Mnemonics (Textdarstellung der Instruktionen), die in eine FILE geschrieben,

+bzw. optional auf dem Bildschirm ausgegeben werden können. Die Bitcodierung

+kann zusätzlich ausgegeben werden. 

+Der Decoder wird mit 'decode' aufgerufen. Während der Dekodierung stehen

+folgende Tastenfunktionen zur Verfügung: 

+ 

+Taste Funktion 

+----------------------------------------------------------------------- 

+ ESC  Abbruch der Dekodierung. 

+  e   Echo. Schaltet die parallel Bildschirmausgabe ein/aus. 

+  l   Zeilennummern statt Hexadezimaladressen mitprotokollieren. 

+  a   Hexadezimaladressen statt Zeilennummern mitprotokollieren. 

+  f   Zeigt den Namen und die aktuelle Zeilennummer der Protokollfile. 

+  d   getcommand ; docommand 

+  s   storage info 

+  m   Zeigt die aktuelle Modulnummer an (sinnvoll falls kein Echo) 

+  Q,W Zeilennummern/Hexadressen mitprotokollieren (falls kein Echo) 

+  S   Keine Zeilennummern/Hexadressen ausgeben (läuft auch im Hintergrund) 

+ 

+ 

+#ub#1.1.1  Datenrepräsentation#ue# 

+ 

+INT-Zahlen werden hexadezimal (xxxxH, xxH) oder dezimal dargestellt, 

+TEXTe in Anführungszeichen ("..."), 

+REALs im 20-Stellen scientific-Format, 

+TASK-Objekte durch XX-YYYY/"name" mit XX als Taskindex und YYYY als Version,

+   wenn die Stationsnummer nicht 0 ist, wird sie vor XX als SS- dargestellt. 

+DATASPACE-Objekte werden durch XX-YY repräsentiert (XX ist der eigene

+   Taskindex, YY ist die Datenraumnummer), 

+BOOL-Objekte durch TRUE oder FALSE. 

+Module werden durch ihre Modulnummer, optional auch durch ihre

+   Startadresse, und falls möglich durch ihren Namen repräsentiert. Die

+   Parameterliste wird in den Fällen, wo das Modul in der Permanenttabelle

+   vermerkt ist auch angegeben. 

+Nicht weiter dereferenzierbare Adressen werden durch ein vorgestelltes '@'

+gekennzeichnet (z.B. BOUND-Objekte). 

+In den Fällen, wo es mehrere sinnvolle Darstellungen gibt, werden diese

+durch ein '|' getrennt. 

+ 

+ 

+#ub#1.1.2  Datenadressen#ue# 

+ 

+Zusätzlich zu den globalen Daten (statische Variablen und Denoter) kann auch

+deren Adresse ausgegeben werden. Die Daten werden in einer, ihrem Typ

+entsprechenden, Darstellung ausgegeben. Komplexe oder zusammengesetzte

+Datentypen werden auf Repräsentationen elementarer Datentypen (INT, REAL,

+BOOL, TEXT, DATASPACE, TASK) abgebildet. 

+ 

+Prozeduren, Operatoren und Paketinitialisierungen von Main-Packets werden

+zusammenfassend als Module bezeichnet. Einem Modul gehört ein eigener

+Stackbereich für lokale Daten, Parameter und Rücksprungadresse etc. In

+diesem Bereich stehen entweder die Datenobjekte selbst (z.B. lokale

+Variablen) oder lokale Referenzadressen auf beliebige Objekte (lokale,

+globale Daten, Fremddatenräume und sogar Module). 

+Da die effektiven lokalen Adressen erst während der Runtime bekannt sind,

+findet man im Decoder-Output nur die Adressoffsets relativ zum Stackanfang

+des Moduls. 

+ 

+Datenadressen werden in spitzen Klammern angegeben, Branch-Codeaddressen ohne

+Klammern. Alle Adressen sind Wortaddressen. Der Adresstyp wird durch einen

+Buchstaben nach '<' angezeigt: 

+'G' kennzeichnet eine globale Adresse (Denoter oder statische Variable). Die

+Representation der Daten kann immer angegeben werden (also nicht nur zur

+Runtime). 

+'L' kennzeichnet einen Adressoffset für ein lokales Datenobjekt auf dem

+Stack. Da die lokale Basis, d.h. die Anfangsadresse der Daten des aktuellen

+Moduls, erst bei Runtime feststehen, kann hier weder die effektive

+Datenadresse, noch der Inhalt des Datenobjekts angegeben werden. 

+'LR' kennzeichnet eine lokale Referenzadresse, d.h. auf dem Stack steht

+eine Adresse (32 Bit), die ein Datenobjekt adressiert. Ähnlich wie bei 'L'

+kann auch bei 'LR' erst zur Runtime eine Representation des adressierten

+Datenobjekts angegeben werden. Der Wert nach 'LR' bezeichnet den Offset, der

+zur lokalen Basis addiert werden muß, um die Adresse der Referenzadresse zu

+erhalten. Die niederwertigsten 16 Bit (das erste der beiden Wörter) können

+128KB adressieren. Im höherwertigsten Byte des zweiten Wortes steht die

+Nummer des Datenraumes der eigenen Task, der das adressierte Datenobjekt

+enthält (0 entspricht dem Standarddatenraum). Das niederwertigste Byte des

+zweiten Wortes enthält die Segmentnummer (128KB-Segmente) mit dem

+Wertebereich 0 bis 7 (maximal also 1MB/Datenraum). Im Standarddatenraum

+(Datenraumnummer 4) enthalten die Segmente folgene Tabellen:

+ 

+Segment Tabelle 

+------------------------------------------------- 

+   0    Paketdaten (high 120KB) und Moduladresstabelle

+   1    Stack (low 64K), Heap (high 64K) 

+   2    Codesegment

+   3    Codesegment (120KB) u.a. für eigene Module 

+   4    Compilertabellen temporär 

+   5    Compilertabellen permanent 

+   6    nilsegment für Compiler (FF's) 

+   7    Compiler: Intermediate String 

+ 

+Repräsentationen von Datenobjekten, die in Fremddatenräumen residieren

+(BOUND-Objekte) können zur Zeit noch nicht ausgegeben werden, statt dessen

+wird die Datenraumnummer und die Wortadresse innerhalb dieses Datenraums

+ausgegeben. 

+ 

+ 

+#ub#1.1.3  Codeadressen#ue# 

+ 

+Module werden in der Regel (Ausnahme: Parameterprozeduren) über ihre

+Modulnummer angesprochen, aus der dann die Adresse des Moduls berechnet

+werden kann (mithilfe der Moduladresstabelle). Die Adressen der

+Parameterprozeduren sind vom Typ 'LR' (Local-Reference), kommen nur als

+Parameter auf dem Stack vor und beeinhalten Codesegment und Codeadresse. 

+ 

+Sprungadressen (von Branch-Befehlen) adressieren immer nur das eigene

+Segment und davon auch nur eine Adresse innerhalb eines 8 KB großen

+Bereichs. 

+ 

+ 

+#ub#1.2  Ablaufverfolgung (Tracer)#ue# 

+ 

+Um den eigenen (!) Code im Einzelschrittbetrieb abzuarbeiten, wird der

+Tracer benutzt. Außer den Inhalten der globalen Daten kann man sich die

+Inhalte der Stackobjekte (lokale Variablen) und der aktuellen Parameter

+eines Prozeduraufrufs (auch von Parameterprozeduren) ansehen. Es können

+keine Daten verändert werden! 

+Man hat die Möglichkeit 

+- die Resultate der letzten ausgeführten Instruktion oder 

+- die aktuellen Parameter für den nächsten Instruktionsaufruf 

+zu beobachten. 

+Der Inhalt des Stacks kann sequentiell durchgesehen werden, Error- und

+Disablestop-Zustand können gelöscht werden. 

+Der Einzelschrittablauf kann protokolliert und die entsprechende

+Sourceline parallel zum ausgeführten Code beobachtet werden. 

+Der Einzelschrittbetrieb kann, über Teile des Codes hinweg, ausgeschaltet

+werden, z.B. für häufig durchlaufene Schleifen.

+Für die Repräsentation der Daten und deren Adressen gilt das unter 1.1

+gesagte. 

+Der Tracer wird mit 'trace' aufgerufen. Während der Aktivität des Tracers

+stehen folgende Funktionen zur Verfügung (Nur der erste Buchstabe wird

+getippt): 

+ 

+Abkürzung Funktion 

+-------------------------------------------------------------------------- 

+  Auto    Die Befehle werden im Einzelschrittbetrieb ausgeführt, ohne daß

+          eine Taste gedrückt werden muß. 

+  Bpnt    Der nächste Breakpoint wird an eine vom Benutzer festgelegte

+          Codeadrese gesetzt. Damit können Teile des Codes abgearbeitet

+          werden, ohne daß der Einzelschrittmodus aktiv ist. Nach der

+          Eingabe der Adresse wird der Befehl an dieser Adresse angezeigt.

+          Bestätigt wird die Richtigkeit mit <RETURN> oder 's'. 

+  Clrr    Ein eventuell vorliegender Fehlerzustand wird gelöscht. 

+  Dstp    'disable stop' wird für das untersuchte Modul gesetzt. 

+  Estp    'enable stop' wird für das untersuchte Modul gesetzt. 

+  File    Der Name der kompilierten Quelldatei wird eingestellt. 

+  Go      Der Code wird bis zum Ende abgearbeitet, ohne daß der Tracer

+          aktiviert wird. 

+  Prot    Der Name der Protokollfile wird eingestellt. Die abgearbeiteten

+          Instruktionen werden in dieser File protokolliert. 

+  Rslt    Es wird umgeschaltet, ob die angezeigte Instruktion nach <RETURN>

+          oder 's' abgearbeitet werden soll (Forward-Trace, 'F') oder ob das

+          Ergebnis der letzten ausgeführten Instruktion angezeigt werden soll

+          (Result-Trace, 'R'). Der aktuelle Zustand dieses Switches wird in

+          der ersten Bildschirmzeile durch 'R' oder 'F' gekennzeichnet. 

+          Kurzzeitige Umschaltung, um das Ergebnis der letzten Operation

+          anzusehen, ist auch möglich (zweimal 'r' tippen). 

+  Step/CR Mit <RETURN> oder 's' wird die nächste Instruktion ausgeführt.

+          Dies ist bei Forward-Trace die angezeigte Instruktion. 

+  Term    Bis zur nächst 'höheren' Prozedur der CALL-Sequence, die im

+          'disable stop'-Zustand arbeitet, werden die Module verlassen. In

+          der Regel bedeutet dies ein Programmabbruch. Alle Breakpoints sind

+          anschließend zurückgesetzt. 

+  -       Der Stackpointer auf den sichtbaren Stack (in der ersten

+          Bildschirmzeile) wird um zwei verringert. Er zeigt auf die nächst

+          tiefere Referenzadresse. Der EUMEL-0-Stackpointer wird nicht

+          verändert.

+  +       Der Stackpointer auf den sichtbaren Stack wird um zwei erhöht. 

+  <       Bei der Befehlsausgabe werden die Parameteradressen zusätzlich

+          ausgegeben (in spitzen Klammern).

+  >       Bei der Befehlsausgabe werden keine Parameteradressen ausgegeben,

+          sondern nur die Darstellungen der Parameter (z.B.

+          Variableninhalte) 

+ 

+#page# 

+#ub#2.  EUMEL0-Instruktionen#ue# 

+ 

+ 

+#ub#2.1  Erläuterung der Instruktionen (Thematisch sortiert)#ue# 

+ 

+Nach der Häufigkeit ihres Vorkommens im Code unterscheidet man 3 Klassen von

+Instruktionen: 30 Primärbefehle, 6 Spezialbefehle und z.Zt. 127

+Sekundärbefehle. 

+Die Primärbefehle enthalten im ersten Wort den Opcode (5 Bit) und 11 Bit für

+die erste Parameteradresse d.h. den Wertebereich 0..2047. Liegt die

+Parameteradresse außerhalb dieses Bereichs, dann ersetzt ein

+Umschaltprefix (LONGAddress) die Opcodebits und im lowbyte des

+ersten Wortes wird der Opcode codiert. Die erste Parameteradresse befindet

+sich dann als 16 Bit-Wert im zweiten Wort. 

+Spezialbefehle enthalten im ersten Wort außer dem Opcode (8 Bit) noch einen

+8 Bit-Immediatewert (Bytekonstante). 

+Sekundärebefehle enthalten im ersten Wort nur den Opcode (16 Bit), der aus

+einem Umschaltprefix (ESCape, wird im folgenden weggelassen) und im lowbyte

+dem 8 Bit Sekündaropcode besteht. 

+ 

+Im folgenden werden Datenadressen mit 'd', Immediatewerte mit 'v' (Value),

+Codeadressen mit 'a' und Modulnummern mit 'm' bezeichnet. Die Anzahl dieser

+Buchstaben gibt die Länge der benötigten Opcodebits (DIV 4) an. Ausnahmsweise

+bezeichnet .nn:dd einen 5 Bit Opcode ('nn') und eine 11 Bit Adresse ('dd'). 

+ 

+Der Adresstyp ist in den Bits 14 und 15 codiert: 

+15 14  Typ       Effektive Adresse 

+ 0  0  global    dddd + pbase (pbase wird mit PENTER eingestellt) 

+ 1  0  local     (dddd AND 7FFF) DIV 2 + lbase (lbase wird beim CALL gesetzt) 

+ 1  1  local ref  adr := ((dddd AND 7FFF) DIV 2 + lbase) ; (adr+1, adr)

+ 

+Der Wert eines Wortes an der ersten Parameteradresse wird mit <d1>

+bezeichnet. Ein Datentyp vor der spitzen Klammer gibt seinen Typ an. Für die 

+anderen Parameter gilt entsprechendes (<d2>, <d3>, ...). 

+ 

+ 

+#ub#2.1.1  Datentransportbefehle#ue# 

+ 

+MOV    .08:dd dddd           1 Wort (z.B. INT/BOOL) wird von der linken

+                             Adresse zur rechten Adresse transportiert. 

+                             <d2> := <d1> 

+ 

+FMOV   .34:dd dddd           4 Wörter (z.B. REAL) von linker Adresse zur

+                             rechten Adresse tranportieren (kopiert). 

+                             <d2> := <d1> 

+ 

+TMOV   .4C:dd dddd           Kopiert einen Text von der linken Adresse zur

+                             rechten Adresse. 

+                             TEXT<d2> := TEXT<d1> 

+ 

+MOVi   FC vv dddd            Die Konstante vv (1 Byte) wird als positive

+                             16 Bit-Zahl dem Wort an der Adresse dddd

+                             zugewiesen. 

+                             <d1> := vv 

+ 

+MOVii  7F 23 vvvv dddd       Dem Wort an der Adresse dddd wird die 16-Bit

+                             Konstante vvvv zugewiesen. 

+                             <d1> := vvvv 

+ 

+MOVx   7D vv dddd dddd       Von der linken Adresse zur rechten Adresse

+                             werden vv (max. 255) Wörter transportiert. 

+                             <d2> := <d1> (vv Wörter) 

+ 

+MOVxx  7F 21 vvvv dddd dddd  Von der linken Adresse zur rechten Adresse

+                             werden vvvv (max. 65535) Wörter transportiert. 

+                             <d2> := <d1> (vvvv Wörter) 

+ 

+ 

+#ub#2.1.2  INT-Operationen#ue# 

+ 

+ARITHS 7F 5B                 Schaltet um auf vorzeichenbehaftete

+                             INT-Arithmetik (Normalfall). 

+                             ARITH := Signed 

+ 

+ARITHU 7F 5C                 Schaltet um auf vorzeichenlose 16Bit-Arithmetik

+                             (Compiler). 

+                             ARITH := Unsigned 

+ 

+CLEAR  .24:dd                Dem Wort an der Adresse dd wird 0 zugewiesen. 

+                             <d1> := 0 

+ 

+INC1   .0C:dd                Der Inhalt des Wortes an der Adresse dddd wird

+                             um eins erhöht. 

+                             <d1> := <d1> + 1 

+ 

+DEC1   .10:dd                Der Inhalt des Wortes an der Adresse dddd wird

+                             um eins verringert. 

+                             <d1> := <d1> - 1 

+ 

+INC    .14:dd dddd           Der Inhalt des Wortes an der ersten Adresse wird

+                             zum Inhalt des Wortes an der zweiten Adresse

+                             addiert. 

+                             <d2> := <d2> + <d1> 

+ 

+DEC    .18:dd dddd           Der Inhalt des Wortes an der ersten Adresse wird

+                             vom Inhalt des Wortes an der zweiten Adresse

+                             subtrahiert. 

+                             <d2> := <d2> - <d1> 

+ 

+ADD    .1C:dd dddd dddd      Der Inhalt der Worte der beiden ersten

+                             Adressen wird addiert und bei der dritten

+                             Adresse abgelegt. 

+                             <d3> := <d1> + <d2> 

+ 

+SUB    .20:dd dddd dddd      Der Inhalt des Wortes an der zweiten Adresse

+                             wird vom Inhalt des Wortes an der ersten Adresse

+                             subtrahiert und das Resultat im Wort an der

+                             dritten Adresse abgelegt. 

+                             <d3> := <d1> - <d2> 

+ 

+MUL    7F 29 dddd dddd dddd  Der Wert der Wörter an den beiden ersten

+                             Adressen wird vorzeichenbehaftet multipliziert

+                             und im Wort an der dritten Adresse abgelegt.

+                             Ein Überlauf wird im Falle der vorzeichenlosen

+                             Arithmetik ignoriert (<d3> MOD 65536). 

+                             <d3> := <d1> * <d2> 

+ 

+IMULT  7F 28 dddd dddd dddd  Der Wert der Wörter an den beiden ersten

+                             Adressen wird vorzeichenlos multipliziert und

+                             im Wort an der dritten Adresse abgelegt. 

+                             Falls das Resultat ein Wert größer 65535 wäre,

+                             wird <d3> := FFFFH, sonst 

+                             <d3> := <d1> * <d2> 

+ 

+DIV    7F 2A dddd dddd dddd  Der Wert des Wortes an der ersten Adresse wird

+                             durch den Wert des Wortes an der zweiten

+                             Adresse dividiert und im Wort an der dritten

+                             Adresse abgelegt. Eine Division durch 0 führt

+                             zum Fehler. 

+                             <d3> := <d1> DIV <d2> 

+ 

+MOD    7F 2B dddd dddd dddd  Der Rest der Division (wie bei DIV) wird im

+                             Wort an der dritten Adresse abgelegt. Falls

+                             <d2> = 0 ist, wird ein Fehler ausgelöst. 

+                             <d3> := <d1> MOD <d2>

+ 

+NEG    7F 27 dddd            Der Wert des Wortes an der Adresse dddd wird

+                             arithmetisch negiert (Vorzeichenwechsel). 

+                             <d1> := -<d1> 

+ 

+AND    7F 7C dddd dddd dddd  Der Wert der beiden Wörter an den beiden ersten

+                             Adressen wird bitweise UND-verknüpft und das

+                             Resultat im Wort an der dritten Adresse

+                             abgelegt. 

+                             <d3> := <d1> AND <d2> 

+ 

+OR     7F 7D dddd dddd dddd  Der Wert der beiden Wörter an den beiden ersten

+                             Adressen wird bitweise ODER-verknüpft und das

+                             Resultat im Wort an der dritten Adresse

+                             abgelegt. 

+                             <d3> := <d1> OR <d2> 

+ 

+XOR    7F 79 dddd dddd dddd  Der Wert der beiden Wörter an den beiden ersten

+                             Adressen wird bitweise Exklusiv-ODER-verknüpft

+                             und das Resultat im Wort an der dritten Adresse

+                             abgelegt. 

+                             <d3> := <d1> XOR <d2> 

+ 

+ROTATE 7F 53 dddd dddd       Der Wert an der ersten Adresse wird um soviele

+                             Bits links oder rechts rotiert, wie es der Wert

+                             des zweiten Parameters angibt (positiv =

+                             links). 

+                             IF <d2> < 0 

+                                THEN <d1> := <d1> ROR <d2> 

+                                ELSE <d1> := <d1> ROL <d2> 

+                             FI 

+  

+ 

+#ub#2.1.3  REAL-Operationen#ue#

+ 

+FADD   .38:dd dddd dddd      Die beiden ersten REAL-Werte werden addiert und

+                             das Resultat an der dritten Adresse abgelegt. 

+                             REAL<d3> := REAL<d1> + REAL<d2> 

+ 

+FSUB   .3C:dd dddd dddd      Der zweite REAL-Wert wird vom ersten

+                             subtrahiert und das Resultat an der dritten

+                             Adresse abgelegt. 

+                             REAL<d3> := REAL<d1> + REAL<d2> 

+ 

+FMUL   .40:dd dddd dddd      Die beiden ersten REAL-Werte werden

+                             multipliziert und das Resultat an der dritten

+                             Adresse abgelegt. 

+                             REAL<d3> := REAL<d1> * REAL<d2> 

+ 

+FDIV   .44:dd dddd dddd      Der erste REAL-Wert wird durch den zweiten

+                             dividiert und das Resultat an der dritten

+                             Adresse abgelegt. 

+                             REAL<d3> := REAL<d1> / REAL<d2> 

+ 

+FNEG   7F 26 dddd            Das Vorzeichen des REAL-Wertes an der Adresse

+                             dddd wird gewechselt. 

+                             REAL<d1> := -REAL<d1> 

+ 

+FSLD   7F 60 dddd dddd dddd  Die Mantisse des REAL-Wertes an der zweiten

+                             Adresse wird um ein Digit (4 Bit BCD) nach

+                             links verschoben, Vorzeichen und Exponent

+                             bleiben unverändert. Das vorher höherwertigste

+                             Digit steht danach im Wort an der dritten

+                             Adresse. Das neue niederwertigste Digit wurde

+                             aus dem Wort der ersten Adresse entnommen. 

+                             INT<d3> := digit1<d2> ; 

+                             REAL<d2> := REAL<d2> SLD 1 ; 

+                             digit13<d2> := INT< 1> 

+ 

+GEXP   7F 61 dddd dddd       Der Exponent des REAL-Wertes an der ersten

+                             Adresse wird in das Wort an der zweiten Adresse

+                             gebracht. 

+                             INT<d2> := exp<d1> 

+ 

+SEXP   7F 62 dddd dddd       Der Wert des Wortes an der ersten Adresse wird

+                             in den Exponenten des REAL-Wertes an der zweiten

+                             Adresse gebracht. 

+                             exp<d2> := INT<d1> 

+ 

+FLOOR  7F 63 dddd dddd       Der REAL-Wert an der ersten Adresse wird ohne

+                             Dezimalstellen an der zweiten Adresse abgelegt. 

+                             <d2> := floor<d1> 

+   

+ 

+#ub#2.1.4  TEXT-Operationen#ue# 

+ 

+ITSUB  7F 2D dddd dddd dddd  Aus dem TEXT an der ersten Adresse wird das

+                             Wort, dessen Position durch das Wort an der

+                             zweiten Adresse beschrieben wird, im Wort an

+                             der dritten Adresse abgelegt. 

+                             INT<d3> := TEXT<d1>[INT<d2>,2] (Notation:

+                             t[n,s] bezeichnet das n. Element mit einer

+                             Größe von s Bytes, der Bytekette t an der

+                             Byteposition n*s+1) 

+ 

+ITRPL  7F 2E dddd dddd dddd  In dem TEXT an der ersten Adresse wird das

+                             Wort, dessen Position durch das Wort an der

+                             zweiten Adresse beschrieben wird, durch das Wort

+                             an der dritten Adresse ersetzt. 

+                             TEXT<d1>[INT<d2>,2] := INT<d3> 

+ 

+DECOD  7F 2F dddd dddd       Der dezimale ASCII-Wert des Zeichens im TEXT an

+                             der ersten Adresse wird im Wort an der zweiten

+                             Adresse abgelegt. 

+                             INT<d2> := code (TEXT<d1>) 

+ 

+ENCOD  7F 30 dddd dddd       Dem der TEXT an der zweiten Adresse wird ein

+                             Zeichen zugewiesen, das dem ASCII-Wert im Wort

+                             an der ersten Adresse entspricht. 

+                             TEXT<d2> := code (INT<d1>) 

+ 

+SUBT1  7F 31 dddd dddd dddd  Dem TEXT an der dritten Adresse wird das

+                             Zeichen des TEXTes an der ersten Adresse

+                             zugewiesen, dessen Position durch das Wort an

+                             der zweiten Adresse bestimmt ist. 

+                             TEXT<d3> := TEXT<d1>[INT<d2>, 1] 

+ 

+SUBTFT 7F 32 dddd dddd dddd dddd  Dem TEXT an der vierten Adresse wird ein

+                             Teiltext des TEXTes an der ersten Adresse

+                             zugewiesen, dessen Startposition im Wort an der

+                             zweiten Adresse steht und dessen Endposition im

+                             Wort an der dritten Adresse steht. 

+                             TEXT<d3> := subtext (TEXT<d1>, INT<d2>, INT<d3>) 

+ 

+SUBTF  7F 33 dddd dddd dddd  Dem TEXT an der dritten Adresse wird ein

+                             Teiltext des TEXTes an der ersten Adresse

+                             zugewiesen, der an der durch das Wort an der

+                             zweiten Adresse beschriebenen Position beginnt

+                             und bis zum Ende des Sourcetextes geht. 

+                             TEXT<d3> := subtext (TEXT<d1>, INT<d2>, length

+                             (TEXT<d1>)) 

+ 

+REPLAC 7F 34 dddd dddd dddd  Der TEXT an der ersten Adresse wird ab der

+                             Position, die durch das Wort an der zweiten

+                             Position bestimmt wird, durch den TEXT an der

+                             dritten Adresse ersetzt. 

+                             replace (TEXT<d1>, INT<d2>, TEXT<d3>) 

+ 

+CAT    7F 35 dddd dddd       Der TEXT an der zweiten Adresse wird an das

+                             Ende des TEXTes an der ersten Adresse angefügt. 

+                             TEXT<d1> := TEXT<d1> + TEXT<d2> 

+ 

+TLEN   7F 36 dddd dddd       Die Länge des TEXTes an der ersten Adresse wird

+                             im Wort an der zweiten Adresse abgelegt. 

+                             INT<d2> := length (TEXT<d1>) 

+ 

+POS    7F 37 dddd dddd dddd  Die Position des ersten Auftretens des TEXTes

+                             an der zweiten Adresse, innerhalb des TEXTes an

+                             der ersten Adresse, wird im Wort an der dritten

+                             Adresse abgelegt. 

+                             INT<d3> := pos (TEXT<d1>, TEXT<d2>, 1, length

+                             (TEXT<d1>))

+ 

+POSF   7F 38 dddd dddd dddd dddd 

+                             Die Position des ersten Auftretens des TEXTes

+                             an der zweiten Adresse, innerhalb des TEXTes an

+                             der ersten Adresse, ab der Position die durch

+                             den Inhalt des Wortes an der dritten Adresse

+                             bestimmt ist, wird im Wort an der vierten

+                             Adresse abgelegt. 

+                             INT<d4> := pos (TEXT<d1>, TEXT<d2>, INT<d3>,

+                             length (TEXT<d1>)) 

+ 

+POSFT  7F 39 dddd dddd dddd dddd dddd 

+                             Die Position des ersten Auftretens des TEXTes

+                             an der zweiten Adresse, innerhalb des TEXTes an

+                             der ersten Adresse, ab der Position die durch

+                             den Inhalt des Wortes an der dritten Adresse

+                             bestimmt ist, bis zur Position die durch den

+                             Inhalt des Wortes an der vierten Adresse

+                             bestimmt ist, wird im Wort an der fünften

+                             Adresse abgelegt. 

+                             INT<d5> := pos (TEXT<d1>, TEXT<d2>, INT<d3>,

+                             INT<d4>) 

+ 

+STRANL 7F 3A dddd dddd dddd dddd dddd dddd dddd 

+                             (ROW 256 INT CONST, INT VAR, INT CONST,

+                             TEXT CONST, INT VAR, INT CONST, INT VAR): 

+                             Vereinfachte funktionsweise: 

+                             extension := FALSE ;

+                             FOR INT<d5> FROM INT<d5> UPTO min (INT<d6>,

+                                 length (TEXT<d4>)) WHILE INT<d2> < INT<d3> 

+                             REP 

+                               IF extension 

+                                  THEN extension := FALSE

+                                  ELSE INT<d7>:=ROW<d1>[TEXT<d4>[INT<d5>,1]];

+                                       IF INT<d7> < 0 

+                                          THEN extension := TRUE ; 

+                                               INT<d2> INCR (INT<d7>-8000H)

+                                          ELSE INT<d2> INCR INT<d7> 

+                                       FI 

+                               FI 

+                             PER

+ 

+POSIF  7F 3B dddd dddd dddd dddd dddd 

+                             Die Position des ersten Auftretens des, durch

+                             die beiden Zeichen des TEXTes an der zweiten

+                             und dritten Adresse begrenzten ASCII-Bereichs

+                             (lowchar, highchar), Zeichens innerhalb des

+                             TEXTes an der ersten Adresse, wird ab der

+                             Position, die durch das Wort an der vierten

+                             Adresse beschrieben wird, im Wort an der

+                             fünften Adresse abgelegt. 

+                             INT<d5> := pos (TEXT<d1>, TEXT<d2>, TEXT<d3>,

+                             INT<d4>). 

+ 

+GARB   7F 5F                 Es wird eine Garbagecollection für den

+                             taskeigenen TEXT-Heap durchgeführt. 

+ 

+HPSIZE 7F 5E dddd            Die aktuelle Größe des TEXT-Heaps wird in dem

+                             Wort an der Adresse dddd abgelegt. 

+                             <d1> := heapsize 

+ 

+RTSUB  7F 64 dddd dddd dddd  Aus dem TEXT an der ersten Adresse wird der

+                             REAL-Wert, dessen Position durch das Wort an

+                             der zweiten Adresse beschrieben wird, an der

+                             dritten Adresse abgelegt. 

+                             REAL<d3> := TEXT<d1>[INT<d2>, 8] 

+ 

+RTRPL  7F 65 dddd dddd dddd  In dem TEXT an der ersten Adresse wird der

+                             REAL-Wert, dessen Position durch das Wort an der

+                             zweiten Adresse beschrieben wird, durch den

+                             REAL-Wert an der dritten Adresse ersetzt. 

+                             TEXT<d1>[INT<d2>, 8] := REAL<d3> 

+ 

+ 

+#ub#2.1.5  DATASPACE-Operationen#ue# 

+ 

+DSACC  .58:dd dddd           Die dsid an der ersten Adresse wird auf

+                             Gültigkeit geprüft und an der zweiten Adresse

+                             eine Referenzaddresse abgelegt, die auf das

+                             4. Wort des Datenraumes (den Anfang des

+                             Datenbereichs) zeigt. 

+                             IF valid ds (DS<d1>) 

+                                THEN REF<d2> := DATASPACE<d1>.ds base 

+                                ELSE "falscher DATASPACE-Zugriff" 

+                             FI 

+ 

+ALIAS  7F 22 vvvv dddd dddd  Dem BOUND-Objekt an der dritten Adresse wird

+                             der Datenraum an der zweiten Adresse zugewiesen

+                             (INT-Move). Zuvor wird geprüft, ob dies der

+                             erste Zugriff auf den Datenraum ist. Falls ja,

+                             wird der Datenraumtyp auf 0 gesetzt. Falls ein

+                             Heap aufgebaut werden muß und noch keiner

+                             angelegt wurde, wird die Anfangsadresse des

+                             Heaps auf den Wert vvvv+4 innerhalb des

+                             Datenraumes gesetzt. 

+                             IF DATASPACE<d1>.typ < 0 

+                                THEN DATASPACE<d1>.typ := 0 

+                             FI ; 

+                             IF DATASPACE<d1>.heapanfang < 0 

+                                THEN DATASPACE<d1>.heapanfang := vvvv+4 

+                             FI ;

+                             INT<d2> := INT<d1> 

+ 

+NILDS  7F 45 dddd            Dem Datenraum an der Adresse dddd wird der

+                             'nilspace' zugewiesen. 

+                             INT<d1> := 0 

+ 

+DSCOPY 7F 46 dddd dddd       Dem Datenraum an der ersten Adresse wird eine

+                             Kopie des Datenraumes an der zweiten Adresse

+                             zugewiesen (neue dsid). Es wird ein neuer

+                             Eintrag in die Datenraumverwaltung aufgenommen. 

+                             DATASPACE<d1> := DATASPACE<d2> 

+ 

+DSFORG 7F 47 dddd            Der Datenraum, dessen dsid an der Adresse dddd

+                             steht, wird aus der Datenraumverwaltung

+                             gelöscht. 

+                             forget (DATASPACE<d1>) 

+ 

+DSWTYP 7F 48 dddd dddd       Der Typ des Datenraums, dessen dsid an der

+                             ersten Adresse steht, wird auf den Wert des

+                             Wortes an der zweiten Adresse gesetzt. 

+                             DATASPACE<d1>.typ := INT<d2> ; 

+                             IF DATASPACE<d1>.heapanfang < 0 

+                                THEN DATASPACE<d1>.heapanfang := vvvv+4 

+                             FI 

+ 

+DSRTYP 7F 49 dddd dddd       Der Typ des Datenraums, dessen dsid an der

+                             ersten Adresse steht, wird in dem Wort an der

+                             zweiten Adresse abgelegt. 

+                             INT<d2> := DATASPACE<d1>.typ ;

+                             IF DATASPACE<d1>.heapanfang < 0 

+                                THEN DATASPACE<d1>.heapanfang := vvvv+4 

+                             FI 

+ 

+DSHEAP 7F 4A dddd dddd       Die Endaddresse Textheaps des Datenraums, dessen

+                             dsid an der ersten Adresse steht, in 1kB

+                             Einehiten, wird in dem Wort an der zweiten

+                             Adresse abgelegt. Falls dieser Wert = 1023 oder 

+                             < 96 ist, ist kein Heap vorhanden, anderenfalls

+                             ist seine Größe (in KB): <d2>-96. 

+                             INT<d2> := DATASPACE<d1>.heapende DIV 1024 

+ 

+NXTDSP 7F 4B dddd dddd dddd  Für den Datenraum an der ersten Adresse wird

+                             die Nummer der Seite, die auf die Nummer der

+                             Seite folgt, die in dem Wort an der zweiten Adresse

+                             steht an der zweiten Adresse abgelegt. Falls

+                             keine Seite mehr folt, wird -1 geliefert. 

+                             INT<d2> := nextdspage (DATASPACE<d1>, INT<d2>) 

+ 

+DSPAGS 7F 4C dddd dddd dddd  Für den Datenraum mit der Nummer, die im Wort

+                             an der ersten Adresse steht, und der Task deren

+                             Nummer im Wort an der zweiten Adresse steht,

+                             wird die Anzahl der belegten Seiten im Wort an

+                             der dritten Adresse abgelegt. 

+                             INT<d3> := ds pages (INT<d2>, INT<d1>) 

+ 

+SEND   7F 71 dddd dddd dddd dddd 

+                             Der Datenraum an der dritten Adresse wird der

+                             Task, deren id an der ersten Adresse steht, mit

+                             dem Messagecode der an der zweiten Adresse

+                             steht, gesendet. Der Antwortcode wird im Wort

+                             an der vierten Adresse abgelegt. Vereinfachte 

+                             Semantik: 

+                             send (TASK<d1>, INT<d2>, DATASPACE<d3>, INT<d4>) 

+ 

+WAIT   7F 72 dddd dddd dddd  Die eigene Task geht in einen offenen

+                             Wartezustand, bei dem sie empfangsbereit ist für

+                             einen Datenraum einer anderen Task. Die id der

+                             sendenden Task wird an der ersten Adresse

+                             abgelegt, der Messagecode an der zweiten

+                             Adresse, der gesendete Datenraum an der dritten

+                             Adresse. Vereinfachte Semantik: 

+                             wait (TASK<d1>, INT<d2>, DATASPACE<d3>) 

+ 

+SWCALL 7F 73 dddd dddd dddd dddd 

+                             Der Datenraum an der dritten Adresse wird der

+                             Task, deren id an der ersten Adresse steht, mit

+                             dem Messagecode der an der zweiten Adresse

+                             steht, gesendet bis die Task empfangsbereit ist.

+                             Dann wird auf einen zurückgesandten Datenraum

+                             dieser Task gewartet, der an der dritten

+                             Adresse abgelegt wird. Der zurückgesendete

+                             Messagecode wird an der vierten Adresse

+                             abgelegt. Vereinfachte Semantik: 

+                             REP

+                              send (TASK<d1>, INT<d2>, DATASPACE<d3>,INT<d4>) 

+                             UNTIL INT<d4> <> task busy PER ; 

+                             wait (TASK<d1>, INT<d4>, DATASPACE<d3>) 

+ 

+PPCALL 7F 7A dddd dddd dddd dddd 

+                             Wirkt wie SWCALL, wartet aber nicht bis die

+                             Zieltask empfangsbereit ist, sondern liefert -2

+                             an der vierten Adresse zurück, wenn die Task

+                             nicht empfangsbereit ist. Vereinfachte

+                             Semantik: 

+                             send (TASK<d1>, INT<d2>, DATASPACE<d3>,INT<d4>); 

+                             IF INT<d4> <> task busy 

+                                THEN wait (TASK<d1>, INT<d4>, DATASPACE<d3>) 

+                             FI 

+ 

+SENDFT 7F 7F dddd dddd dddd dddd dddd 

+                             Der Datenraum an der vierten Adresse wird der

+                             Task, deren id an der zweiten Adresse steht,

+                             mit dem Messagecode der an der dritten Adresse

+                             steht, gesendet als ob er von der Task käme,

+                             deren id an der ersten Adresse steht. Der

+                             Antwortcode wird im Wort an der vierten

+                             Adresse abgelegt. Dieser Befehl setzt eine

+                             Priviligierung >= 1 voraus und ist nur wirksam,

+                             wenn die from-Task einer anderen Station

+                             angehört. Vereinfachte Semantik: 

+                             IF station (TASK<d1>) = station (myself)

+                                THEN send (TASK<d2>, INT<d3>, DATASPACE<d4>,

+                                           INT<d5>) 

+                                ELSE save myself := myself ;

+                                     myself := TASK<d1> ; 

+                                     send (TASK<d2>, INT<d3>, DATASPACE<d4>,

+                                           INT<d5>) ; 

+                                     myself := save myself

+                             FI 

+ 

+ 

+#ub#2.1.6  TASK-Operationen#ue# 

+ 

+TWCPU  7F 52 dddd dddd       Die CPU-Zeit der Task, deren Nummer an der

+                             ersten Adresse steht, wird auf den REAL-Wert,

+                             der an der zweiten Adresse steht gesetzt. Dieser

+                             Befehl setzt eine Privilegierung > 1 voraus

+                             (Supervisor). 

+                             pcb(INT<d1>).clock := REAL<d2> 

+ 

+TPBEGIN 7F 5F dddd dddd dddd aaaaaa 

+                             Als Sohn der Task, deren Nummer an der ersten

+                             Adresse steht, wird eine Task eingerichtet,

+                             deren Nummer an der zweiten Adresse steht. Die

+                             neue Task erhält die Privilegierung, deren

+                             Nummer in dem Wort an der dritten Adresse

+                             steht und wird mit der Prozedur gestartet,

+                             deren Code bei der durch den vierten Parameter

+                             übergebenen Refereznadresse beginnt. Dieser

+                             Befehl  setzt eine Privilegierung > 1 voraus

+                             (Supervisor). 

+ 

+TRPCB  7F 68 dddd dddd dddd  Der Wert des Leitblockfeldes der Task

+                             deren Nummer an der ersten Adresse steht und

+                             der Nummer, die in dem Wort an der zweiten

+                             Adresse steht, wird an der dritten Adresse

+                             abgelegt. 

+                             INT<d3> := pcb(INT<d1>, INT<d2>) 

+ 

+TWPCB  7F 69 dddd dddd dddd  Der Wert an der dritten Adresse wird in das

+                             Leitblockfeld mit der Nummer an der zweiten

+                             Adresse der Task übertragen, deren Nummer an der

+                             ersten Adresse steht. Privilegierung: 

+                             0: Nur linenumber-Feld (0), der eigenen Task 

+                             1: linenumber-Feld der eigenen Task und

+                                prio-Feld (5) jeder Task 

+                             2: Alle Felder 

+                             Für den Fall, daß die Privilegierung ok ist

+                             gilt: 

+                             pcb (INT<d1>, INT<d2>) := INT<d3> 

+ 

+TCPU   7F 6A dddd dddd       Die CPU-Zeit der Task, deren Nummer an der

+                             ersten Adresse steht, wird als REAL-Wert an der

+                             zweiten Adresse abgelegt.  

+                             REAL<d2> := pcb (INT<d1>).clock 

+ 

+TSTAT  7F 6B dddd dddd       Der Status (busy, i/o, wait) der Task, deren

+                             Nummer an der ersten Adresse steht, wird im Wort

+                             an der zweiten Adresse abgelegt. 

+                             INT<d2> := pcb (INT<d1>).status 

+ 

+ACT    7F 6C dddd            Die Task mit der Nummer, die an der Adresse dddd

+                             steht wird aktiviert (entblockt). Dieser Befehl

+                             setzt eine Privilegierung >= 1 voraus. 

+                             activate (INT<d1>) 

+ 

+DEACT  7F 6D dddd            Die Task, deren Nummer an der Adresse dddd

+                             steht, wird deaktiviert (geblockt). Dieser

+                             Befehl setzt eine Privilegierung >= 1 voraus. 

+                             deactivate (INT<d1>) 

+ 

+THALT  7F 6E dddd            In der Task, deren Nummer an der Adresse dddd

+                             steht, wird ein Fehler 'halt vom Terminal' 

+                             induziert. Dieser Befehl setzt eine 

+                             Privilegierung > 1 voraus (Supervisor). 

+                             halt process (INT<d1>) 

+ 

+TBEGIN 7F 6F dddd aaaaaa     Eine neue Task wird eingerichtet, deren Nummer

+                             an der ersten Adresse steht. Die Adresse der

+                             Startprozedur wird als Referenzadresse im

+                             zweiten Parameter übergeben. Der Datenraum 4

+                             wird von der aufrufenden Task geerbt. Als

+                             Privilegierung wird 0 eingetragen. 

+                             Dieser Befehl setzt eine Privilegierung > 1

+                             voraus (Supervisor). 

+ 

+TEND   7F 70 dddd            Die Task, deren Nummer an der Adresse dddd

+                             steht, wird gelöscht (alle Datenräume) und aus

+                             der Prozessverwaltung entfernt. Dieser Befehl 

+                             setzt eine Privilegierung > 1 voraus

+                             (Supervisor). 

+ 

+PNACT  7F 76 dddd            Die Nummer der nächsten aktivierten Task

+                             wird aus der Aktivierungstabelle gelesen. Die

+                             Suche beginnt mit dem Wert+1 an der Adresse. Die

+                             Nummer nächsten aktivierten Task wird an dieser

+                             Adresse abgelegt.  

+                             INT<d1> := next active (INT<d1>) 

+ 

+DEFCOL 7F 80 dddd            Die Task an der Adresse wird als Collectortask

+                             (für Datenaustausch zwischen Stationen)

+                             definiert. Dieser Befehl setzt eine

+                             Privilegierung >= 1 voraus. 

+                             TASK collector := TASK<d1> 

+ 

+ 

+#ub#2.1.7  Tests und Vergleiche#ue# 

+ 

+Alle Tests und Vergleiche liefern ein BOOL-Resultat, welches den Opcode des

+nachfolgenden Branch-Befehls bestimmt (Aus LN wird BT aus BR wird BF). 

+ 

+TEST   .28:dd                Liefert TRUE, wenn das Wort an der Adresse 0

+                             ist (Auch für BOOL-Variablen gebraucht: TRUE=0,

+                             FALSE=1). 

+                             FLAG := <d1> = 0 

+ 

+EQU    .2C:dd dddd           Liefert TRUE, wenn die Wörter der beiden

+                             Adressen gleich sind. 

+                             FLAG := <d1> = <d2> 

+ 

+LSEQ   .30:dd dddd           Liefert TRUE, wenn der Wert des Wortes an der

+                             ersten Adresse (vorzeichenbehaftet) kleiner oder

+                             gleich dem Wert des Wortes an der zweiten

+                             Adresse ist. 

+                             FLAG := INT<d1> <= INT<d2> 

+ 

+FLSEQ  .48:dd dddd           Liefert TRUE, wenn der REAL-Wert an der ersten

+                             Adresse kleiner oder gleich dem REAL-Wert an der

+                             zweiten Adresse ist. 

+                             FLAG := REAL<d1> <= REAL<d2> 

+ 

+FEQU   7F 24 dddd dddd       Liefert TRUE, wenn der REAL-Wert an der ersten

+                             Adresse gleich dem REAL-Wert an der zweiten

+                             Adresse ist. 

+                             FLAG := REAL<d1> = REAL<d2> 

+ 

+TLSEQ  7F 25 dddd dddd       Liefert TRUE, wenn der TEXT an der ersten

+                             Adresse kleiner oder gleich dem TEXT an der

+                             zweiten Adresse ist. 

+                             FLAG := TEXT<d1> <= TEXT<d2> 

+ 

+TEQU   .50:dd dddd           Liefert TRUE, wenn der TEXT an der ersten

+                             Adresse gleich dem TEXT an der zweiten Adresse

+                             ist. 

+                             FLAG := TEXT<d1> = TEXT<d2> 

+ 

+ULSEQ  .54:dd dddd           Liefert TRUE, wenn der Wert des Wortes an der

+                             ersten Adresse (vorzeichenlos) kleiner oder

+                             gleich dem Wert des Wortes an der zweiten

+                             Adresse ist. 

+                             FLAG := INT<d1> "<=" INT<d2> 

+ 

+EQUIM  7C vv dddd            Liefert TRUE, wenn der Wert des Wortes an der

+                             Adresse dddd gleich der 8 Bit Konstanten vv

+                             ist. 

+                             FLAG := INT<d1> = vv 

+ 

+ISDIG  7F 12 dddd            Liefert TRUE, wenn der ASCII-Code im Wort an

+                             der Adresse dddd einer Ziffer entspricht. 

+                             FLAG := INT<d1> >= 48 AND INT<d1> <= 57 

+ 

+ISLD   7F 13 dddd            Liefert TRUE, wenn der ASCII-Code im Wort an

+                             der Adresse dddd einer Ziffer oder einem

+                             Kleinbuchstaben entspricht. 

+                             FLAG := INT<d1> >= 48 AND INT<d1> <= 57 OR 

+                                     INT<d1> >= 97 AND INT<d1> <= 122 

+ 

+ISLCAS 7F 14 dddd            Liefert TRUE, wenn der ASCII-Code im Wort an

+                             der Adresse dddd einem Kleinbuchstaben

+                             entspricht. 

+                             FLAG := INT<d1> >= 97 AND INT<d1> <= 122 

+ 

+ISUCAS 7F 15 dddd            Liefert TRUE, wenn der ASCII-Code im Wort an

+                             der Adresse dddd einem Großbuchstaben

+                             entspricht. 

+                             FLAG := INT<d1> >= 65 AND INT<d1> <= 90 

+ 

+ISSHA  7F 18 dddd            Liefert TRUE, wenn der Wert des Wortes an der

+                             Adresse dddd im Bereich 0..2047 liegt, d.h.

+                             eine Kurzadresse ist, die noch zusammen mit dem

+                             Opcode im ersten Wort eines Primärbefehls

+                             untergebracht werden kann. 

+                             FLAG := INT<d1> < 2048 

+ 

+ISERR  7F 4E                 Liefert TRUE, wenn ein Fehlerzustand vorliegt. 

+                             FLAG := ERROR 

+ 

+EXTASK 7F 7B dddd            Liefert TRUE, wenn die Task, deren id an der

+                             Adresse dddd steht, existiert (nicht "dead" und

+                             korrekte Versionsnummer). 

+                             FLAG := TASK<d1>.version =

+                                     pcb (TASK<d1>.nr).version AND 

+                                     pcb (TASK<d1>.nr).status <> dead 

+ 

+ 

+#ub#2.1.8  I/O-Operationen#ue# 

+ 

+OUT    7F 3C dddd            Der Text an der Adresse wird ausgegeben. 

+                             out (TEXT<d1>) 

+ 

+COUT   7F 3D dddd            Falls der Kanal frei ist und die INT-Zahl an

+                             der Adresse dddd positiv ist, wird sie als

+                             Dezimalzahl ausgegeben. 

+                             IF free (channel) 

+                                THEN out (text (INT<d1>, 5) + 5 * ""8"") 

+                             FI 

+ 

+OUTF   7F 3E dddd dddd       Der Text an der ersten Adresse wird ab der

+                             Position, die durch den Wert des Wortes an der

+                             zweiten Adresse bestimmt wird, bis zum Ende

+                             ausgegeben. 

+                             out (subtext (TEXT<d1>, INT<d2>, length

+                             (TEXT<d1>))) 

+ 

+OUTFT  7F 3F dddd dddd dddd  Der Text an der ersten Adresse wird ab der

+                             Position, die durch den Wert an der zweiten

+                             Adresse bestimmt wird, bis zur Position die

+                             durch den Wert an der dritten Adresse bestimmt

+                             wird, ausgegeben. 

+                             out (subtext (TEXT<d1>, INT<d2>, INT<d3>)) 

+ 

+INCHAR 7F 40 dddd            Es wird auf ein Eingabezeichen gewartet,

+                             welches dann im TEXT an der Adresse dddd

+                             abgelegt wird. 

+                             IF zeichen da (channel) 

+                                THEN TEXT<d1> := incharety 

+                                ELSE offener wartezustand (inchar) ; 

+                                     TEXT<d1> := incharety 

+                             FI

+ 

+INCETY 7F 41 dddd            Falls kein Eingabezeichen vorhanden ist, wird

+                             im TEXT an der Adresse dddd niltext geliefert,

+                             sonst das Eingabezeichen. 

+                             IF zeichen da (channel) 

+                                THEN TEXT<d1> := incharety 

+                                ELSE TEXT<d1> := "" 

+                             FI

+ 

+PAUSE  7F 42 dddd            Der Wert an der Adresse dddd bestimmt die

+                             Wartezeit in Zehntelsekunden, die gewartet

+                             werden soll. Die Pause kann durch eine Eingabe

+                             auf dem Kanal abgebrochen werden. 

+                             IF NOT zeichen da (channel) 

+                                THEN modi := INT<d1> ;

+                                     offener wartezustand (pause) 

+                             FI

+ 

+GCPOS  7F 43 dddd dddd       Die Cursorposition wird erfragt. Die x-Position

+                             wird an der ersten Adresse abgelegt, die

+                             y-Position an der zweiten Adresse. 

+                             getcursor (INT<d1>, INT<d2>) 

+ 

+CATINP 7F 44 dddd dddd       Aus dem Eingabepuffer werden alle Zeichen

+                             gelesen und an den TEXT an der ersten Adresse

+                             gehängt, bis entweder der Eingabepuffer leer

+                             ist oder ein Zeichen mit einem Code < 32

+                             gefunden wurde. Im ersten Fall wird niltext an

+                             der zweiten Adresse abgelegt, im zweiten Fall

+                             das Trennzeichen. 

+                             REP 

+                              IF zeichen da (channel) 

+                                 THEN zeichen := incharety ; 

+                                      IF code (zeichen) < 32 

+                                         THEN TEXT<d2> := zeichen 

+                                         ELSE TEXT<d1> CAT zeichen 

+                                      FI 

+                                 ELSE TEXT<d2> := "" ; 

+                                      LEAVE CATINP 

+                              FI 

+                             PER 

+ 

+CONTRL 7F 54 dddd dddd dddd dddd 

+                             Der IO-Controlfunktion mit der Nummer, die

+                             an der ersten Adresse steht, werden die beiden

+                             Parameter übergeben, die an der zweiten und

+                             dritten Adresse stehen. Die Rückmeldung wird

+                             an der vierten Adresse abgelegt. 

+                             IF channel > 0 

+                                THEN iocontrol (INT<d1>, INT<d2>, INT<d3>,

+                                                INT<d4>) 

+                             FI 

+ 

+BLKOUT 7F 55 dddd dddd dddd dddd dddd 

+                             Die Seite des Datenraums, dessen dsid an der

+                             ersten Adresse steht, mit der Seitennummer, die

+                             an der zweiten Adresse steht, wird auf dem

+                             aktuellen Kanal ausgegeben. Als Parameter

+                             werden die Werte an der dritten und vierten

+                             Adresse übergeben. Der Returncode wird an der

+                             fünften Adresse abgelegt. 

+                             IF channel > 0 

+                                THEN blockout (DATASPACE<d1>[INT<d2>, 512],

+                                     INT<d3>, INT<d4>, INT<d5>) 

+                             FI 

+ 

+BLKIN  7F 56 dddd dddd dddd dddd dddd 

+                             Die Seite des Datenraums, dessen dsid an der

+                             ersten Adresse steht, mit der Seitennummer, die

+                             an der zweiten Adresse steht, wird an dem

+                             aktuellen Kanal eingelesen. Als Parameter

+                             werden die Werte an der dritten und vierten

+                             Adresse übergeben. Der Returncode wird an der

+                             fünften Adresse abgelegt. 

+                             IF channel > 0 

+                                THEN blockout (DATASPACE<d1>[INT<d2>, 512],

+                                               INT<d3>, INT<d4>, INT<d5>) 

+                             FI 

+ 

+ 

+#ub#2.1.9  Ablaufsteuerung (Branch und Gosub)#ue# 

+ 

+B      .70:aa bzw. .74:aa    Unbedingter Sprung an die Adresse. 

+                             ICOUNT := aaaa (aaaa gilt nur für den

+                             Debugger/Tracer, da die Adressrechung intern

+                             komplizierter ist) 

+ 

+BF     .70:aa bzw. .74:aa    Wenn der letzte Befehl FALSE lieferte, Sprung an

+                             die Adresse. 

+                             IF NOT FLAG 

+                                THEN ICOUNT := aaaa (aaaa s.o.) 

+                             FI 

+ 

+BT     .00:aa bzw. .04:aa    Wenn der letzte Befehl TRUE lieferte, Sprung an

+                             die Adresse (auch LN-Opcode). 

+                             IF FLAG 

+                                THEN ICOUNT := aaaa (aaaa s.o.) 

+                             FI 

+ 

+BRCOMP 7F 20 dddd vvvv       Wenn das Wort an der Adresse dddd kleiner als 0

+                             oder größer als die Konstante vvvv ist, wird mit

+                             dem auf den BRCOMP-Befehl folgenden Befehl

+                             (i.d.R. ein B-Befehl) fortgefahren. Sonst wird

+                             die Ausführung an der Adresse des

+                             BRCOMP-Befehls + 2 + (dddd) (auch ein B-Befehl)

+                             fortgesetzt. 

+                             IF <d1> >= 0 AND <d1> <= vvvv 

+                                THEN ICOUNT INCR (<d1> + 1) 

+                             FI 

+ 

+GOSUB  7F 05 aaaa            Die aktuelle Codeadresse wird auf den Stack

+                             gebracht und das Programm an der Adresse aaaa

+                             fortgesetzt. 

+                             <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;

+                             LBASE := TOP ; 

+                             ICOUNT := aaaa ; 

+                             CMOD := high (ICOUNT) + 16 

+ 

+GORET  7F 07                 Das Programm wird an der oben auf dem Stack

+                             stehenden Returnadresse fortgesetzt. 

+                             TOP := LBASE ; 

+                             SP := TOP + 4 ; 

+                             (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>

+ 

+ 

+#ub#2.1.10 Modul-Operationen#ue# 

+ 

+PPV    .68:dd                Das Wort an der Adresse wird auf den Stack

+                             gebracht. Dieser Befehl wird vom Compiler nicht

+                             generiert. 

+                             <SP> := INT<d1> ; 

+                             SP INCR 2 

+ 

+PP     .6C:dd                Die Referenzadresse des Objektes wird auf den

+                             Stack gebracht (2 Worte). 

+                             <SP> := REF d1 ; 

+                             SP INCR 2 

+ 

+PPROC  7F 1E mmmm            Die Adresse der Prozedur mit der Modulnummer

+                             mmmm wird als Referenzadresse (Codesegment,

+                             Codeadresse) auf den Stack gebracht. 

+                             <SP> := mod addr (mmmm) ; 

+                             SP INCR 2 

+ 

+HEAD   vvvv (kein Opcode)    Der Speicherplatz für lokale Variablen und

+                             Parameter in diesem Modul wird vermerkt, indem

+                             der Stacktop um vvvv erhoht wird. 

+                             TOP INCR vvvv ; 

+                             SP := TOP + 4 

+ 

+PENTER FE vv                 Die Paketbasis (Basis der globalen Adressen

+                             dieses Moduls) wird auf den Wert vv*256

+                             gesetzt. 

+                             PBASE := vv * 256 

+ 

+CALL   .78:mm                Das Modul mit der Nummer mm wird aufgerufen. 

+                             <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;

+                             LBASE := TOP ; 

+                             ICOUNT := mod addr (mm) ; 

+                             CMOD := high (ICOUNT) + 16 

+ 

+PCALL  7F 1F dddd            Die (Parameter-)Prozedur, deren Startadresse

+                             als Referenzadresse auf dem Stack steht, wird

+                             aufgerufen. 

+                             <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;

+                             LBASE := TOP ; 

+                             ICOUNT := d1 ; 

+                             CMOD := high (ICOUNT) + 16 . 

+ 

+EXEC   7F 1D dddd            Das Modul dessen Nummer in dem Wort an der

+                             Adresse dddd steht, wird aufgerufen. 

+                             <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;

+                             LBASE := TOP ; 

+                             ICOUNT := <d1> ; 

+                             CMOD := high (ICOUNT) + 16 . 

+ 

+RTN    7F 00                 Das Modul wird verlassen, die

+                             Programmausführung setzt an der, auf dem Stack

+                             gesicherten, Adresse fort. 

+                             TOP := LBASE ; 

+                             SP := TOP + 4 ; 

+                             (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP> 

+ 

+RTNT   7F 01                 Das Modul wird verlassen und der BOOL-Wert TRUE

+                             geliefert (für den dem CALL/PCALL folgenden

+                             BT/BF-Befehl). Die Programmausführung setzt an

+                             der, auf dem Stack gesicherten, Adresse fort. 

+                             TOP := LBASE ; 

+                             SP := TOP + 4 ; 

+                             (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>;

+                             FLAG := TRUE 

+ 

+RTNF   7F 02                 Das Modul wird verlassen und der BOOL-Wert

+                             FALSE geliefert (für den dem CALL/PCALL

+                             folgenden BT/BF-Befehl). Die Programmausführung setzt an

+                             der, auf dem Stack gesicherten, Adresse fort. 

+                             TOP := LBASE ; 

+                             SP := TOP + 4 ; 

+                             (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>; 

+                             FLAG := FALSE 

+ 

+ 

+#ub#2.1.10 Datenadressrechnung#ue# 

+ 

+REF    .5C:dd dddd           An der zweiten Adresse wird die Referenzadresse 

+                             der ersten Adresse abgelegt (2 Wört-MOV). 

+                             REF<d2> := d1 

+ 

+SUBS   .60:vv vvvv dddd dddd dddd 

+                             Wenn der Inhalt des Wortes an der dritten

+                             Adresse (ROW-Index) größer oder gleich der

+                             Konstanten vvvv (limit-1) ist, wird "Subscript

+                             Überlauf" gemeldet, falls der ROW-Index kleiner

+                             als eins ist wird "Subscript Ünterlauf"

+                             gemeldet. Andernfalls wird der um eins

+                             verringerte ROW-Index mit der Konstanten vv

+                             (Size eines ROW-Elements) multipliziert,

+                             zur Basisaddresse (vierter Parameter) addiert

+                             und als Referenzadresse an der fünften Adresse

+                             abgelegt. 

+                             IF INT<d1> <= vvvv AND INT<d1> > 0

+                                THEN REF<d3> := d2 + vv * (INT<d1>-1) 

+                                ELSE "Fehler" s.o. 

+                             FI 

+ 

+SEL    .64:dd vvvv dddd      Die Konstante vvvv (Selektor-Offset einer

+                             STRUCT) wird zur Adresse dd addiert und als

+                             Referenzadresse auf dem Stack an der Adresse

+                             dddd abgelegt. 

+                             REF<d2> := vv + d1 

+ 

+CTT    7F 0C dddd dddd       Die Adresse des Strings(!) an der ersten

+                             Adresse wird an der zweiten Adresse als

+                             Referenzadresse (Segment 0, DS 4) abgelegt.

+                             CTT steht für Compiler-Table-Text. 

+                             REF<d2> := REF (0004, INT<d1>) 

+ 

+ 

+#ub#2.1.12 Compiler-Spezialbefehle#ue#

+ 

+PUTW   FD v1v2 dddd dddd     Das lowbyte des Opcode besteht aus den beiden

+                             Nibbles v1 (Segment) und v2 (Wordoffset). Das

+                             Wort an der zweiten dddd-Adresse wird an die

+                             Adresse im Datenraum 4, Segment v1 geschrieben,

+                             die durch den Wert des Wortes an der ersten

+                             dddd-Adresse + v2 bestimmt ist. 

+                             <v1 * 64KW + INT<d1> + v2> := INT<d2> 

+ 

+GETW   7E v1v2 dddd dddd     Das lowbyte des Opcode besteht aus den beiden

+                             Nibble v1 (Segment) und v2 (Wordoffset). Das

+                             Wort im Datenraum 4, Segment v1 an der durch

+                             den Wert des Wortes an der ersten dddd-Adresse

+                             + v2 bestimmten Adresse wird an der zweiten

+                             dddd-Adresse abgelegt. 

+                             INT<d2> := <v1 * 64KW + INT<d1> + v2) 

+ 

+PW     7F 6F dddd dddd dddd  Das Wort an der dritten Adresse wird im

+                             Datenraum 4 an die Adresse geschrieben, die

+                             durch das Segment (erste Adresse) und die

+                             Adresse in diesem Segment (zweite Adresse)

+                             bestimmt ist. 

+                             <INT<d1> * 64KW + INT<d2>> := INT<d3> 

+ 

+GW     7F 70 dddd dddd dddd  Das Wort im Datenraum 4, das durch das Segment

+                             (erste Adresse) und die Adresse in diesem

+                             Segment (zweite Adresse) bestimmt ist, wird an

+                             der dritte Adresse abgelegt. 

+                             INT<d3> := <INT<d1> * 64KW + INT<d2>> 

+ 

+BCRD   7F 08 dddd dddd       Bereitet das Lesen einzelner Zeichen aus dem

+                             Segment 4 des Datenraumes 4 vor (Nametable).

+                             Das Wort an der ersten Adresse enthält die

+                             Startadresse des Strings und zeigt auf das

+                             Längenbyte. Nach dem Ausführen des Befehls

+                             enthält das Wort an der zweiten Adresse das

+                             Längenbyte und der Pointer an der ersten

+                             Adresse zeigt auf das erste Zeichen des Textes.

+                             Das Bit 15 des Pointers ist gesetzt, wenn das

+                             highbyte adressiert wird. 

+                             INT<d2> := length (STRING<d1>) ; 

+                             INT<d1> INCR 1/2 

+ 

+CRD    7F 09 dddd dddd       Liest ein Zeichen aus dem String, dessen Lesen

+                             mit BCRD vorbereitet wurde. Die erste Adresse

+                             enthält einen Stringpointer, der nach jedem

+                             Lesen erhöht wird, die zweite Adresse enthält

+                             nach dem Aufruf des Befehls den Code des 

+                             gelesenen Zeichens. 

+                             INT<d2> := code (STRING<d1>) ; 

+                             INT<d1> INCR 1/2 

+ 

+CWR    7F 0B dddd dddd dddd  Der Hashcode an der ersten Adresse wird mit dem

+                             zu schreibenden Zeichencode (dritte Adresse)

+                             verknüpft und in den Bereich 0..1023 gemapt.

+                             Das Zeichen wird an die Position des Pointers

+                             geschrieben (Bit 15 des Pointers unterscheidet

+                             lowbyte und highbyte). Anschließend wird der

+                             Pointer auf die Adresse des nächsten Zeichens

+                             gesetzt. Der Pointer steht an der zweiten

+                             Adresse. Vor dem Schreiben des ersten Zeichens 

+                             muß der Hashcode auf 0 gesetzt werden. 

+                             INT<d1> INCR INT<d1> ; 

+                             IF INT<d1> > 1023 THEN INT<d1> DECR 1023 FI ; 

+                             INT<d1> := (INT<d1> + INT<d3>) MOD 1024 ; 

+                             STRING<INT<d2>> := code (INT<d3>) ; 

+                             INT<d2> INCR 1/2 

+ 

+ECWR   7F 0A dddd dddd dddd  Das Schreiben eines Strings wird beendet. Dazu

+                             wird an der ersten Adresse der Stringpointer

+                             übergegeben, an der zweiten Adresse wird die

+                             endgültige Stringlänge geliefert. An der

+                             dritten Adresse wird die Adresse des nächsten

+                             freien Platzes nach diesem Stringende

+                             geliefert. 

+ 

+GETC   7F 0D dddd dddd dddd  Dieser Befehl liefert ein BOOL-Result und zwar

+                             TRUE, wenn das Wort an der zweiten Adresse

+                             größer als 0 und kleiner als die Länge des

+                             TEXTes an der ersten Adresse ist. In diesem Fall

+                             wird im Wort an der dritten Adresse der Code

+                             des n. Zeichens des TEXTes geliefert. Die

+                             Position des Zeichens wird durch das Wort an

+                             der zweiten Adresse bestimmt. 

+                             FLAG := INT<d2> > 0 AND INT<d2> <= length

+                             (TEXT<d1>) ; 

+                             INT<d3> := code (TEXT<d1>[INT<d2>, 1]) 

+ 

+FNONBL 7F 0E dddd dddd dddd  Dieser Befehl liefert ein BOOL-Result.

+                             zaehler := INT<d3> ; (* Stringpointer *) 

+                             WHILE TEXT<d2>[zahler, 1] = " " REP 

+                              zaehler INCR 1 

+                             PER ;

+                             IF zaehler > length (TEXT<d2>) 

+                                THEN FLAG := FALSE 

+                                ELSE INT<d1> := code (TEXT<d2>[zaehler, 1]);

+                                     INT<d3> := zaehler + 1 

+                             FI

+ 

+DREM256 7F 0F dddd dddd      Das lowbyte des Wortes an der ersten Adresse

+                             wird in das Wort an der zweiten Adresse

+                             geschrieben, das highbyte des Wortes an der

+                             ersten Adresse ersetzt das gesamte erste Wort. 

+                             INT<d2> := INT<d1> MOD 256 ; 

+                             INT<d1> := INT<d1> DIV 256

+ 

+AMUL256 7F 10 dddd dddd      Umkerung von DREM256. 

+                             INT<d1> := INT<d1> * 256 + INT<d2> 

+ 

+GADDR   7F 16 dddd dddd dddd "Adresswort" mit Adresstyp generieren (z.B.<d1>

+                             = pbase). 

+                             IF INT<d2> >= 0 (* Global *) 

+                                THEN INT<d3> := INT<d2> - INT<d1>

+                             ELIF bit (INT<d2>, 14)    (* Local Ref *) 

+                                THEN INT<d3> := (INT<d2> AND 3FFFH)*2 + 1 

+                                ELSE INT<d3> := (INT<d2> AND 3FFFH)*2

+                                     (* Local *) 

+                             FI 

+ 

+GCADDR  7F 17 dddd dddd dddd Diese Instruktion liefert ein BOOL-Result.

+                             Mit <d2> = 0 wird sie eingesetzt, um die

+                             Zeilennummer im LN-Befehl zu generieren, mit

+                             <d2> <> 0 wird sie eingesetzt, um die Adresse im

+                             Branchbefehl zu generieren. Beide Befehle gibt

+                             es mit zwei Opcodes (00/04 bzw. 70/74). 

+                             byte := high(INT<d1>)-high(INT<d2>) ; 

+                             IF byte < 0 

+                                THEN byte INCR 16 ; (* Bit für LN1 bzw. B1

+                                                    Opcode *) 

+                                     rotate (byte, right) ; 

+                             FI ; 

+                             INT<d3> := byte * 256 + low (INT<d1>) ; 

+                             FALSE, wenn irgendeins der Bits 11..14 = 1 ist 

+ 

+GETTAB  7F 1A                Kopiert den Inhalt der unteren 64KB des

+                             Segments 5 im DS 4 in das Segment 4.

+                             (permanentes Segment --> temporäres Segment) 

+                             DS4: 50000..57FFF --> 40000..47FFF (Wortaddr) 

+ 

+PUTTAB  7F 1B                Kopiert den Inhalt der unteren 64KB des Segments

+                             4 im DS 4 in das Segment 5. (Temporäre Daten

+                             werden permanent) 

+                             DS4: 40000..47FFF --> 50000..57FFF (Wortaddr) 

+ 

+ERTAB   7F 1C                Kopiert den Inhalt des Segments 6 im DS 4

+                             (besteht nur aus FF's) in die Segmente 4 und 7,

+                             d.h. das temporäre Segment (u.a. Symboltabelle)

+                             und das Segment mit Compiler-Intermediatestring

+                             werden gelöscht. 

+                             DS4: 60000..6FDFF --> 40000..4FDFF ; 

+                             DS4: 60000..6FDFF --> 70000..7FDFF 

+ 

+CDBINT  7F 74 dddd dddd      Das Wort mit der Nummer <d1> wird aus dem

+                             Segment 5 gelesen und in <d2> abgelegt. 

+                             INT<d2> := <50000H + INT<d1>> 

+ 

+CDBTXT  7F 74 dddd dddd      Der String(!) an der Adresse <d1> im Segment 5

+                             wird in dem TEXT <d2> abgelegt. 

+                             TEXT<d2> := ctt (<50000H + INT<d1>>) 

+ 

+ 

+#ub#2.1.13 Instruktionen zur Programmsteuerung#ue# 

+ 

+STOP   7F 04                 Alle (aufrufenden) Module werden verlassen, bis

+                             das erste im 'disablestop'-Zustand angetroffen

+                             wird (Ähnlich errorstop ("")) ; 

+                             WHILE ENSTOP REP return PER .

+ 

+                             return: 

+                              TOP := LBASE ; 

+                              SP := TOP + 4 ; 

+                              (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP> 

+ 

+ESTOP  7F 4B                 Der 'enable stop'-Zustand wird eingeschaltet. 

+                             ENSTOP := TRUE 

+ 

+DSTOP  7F 4C                 Der 'disable stop'-Zustand wird eingeschaltet. 

+                             ENSTOP := FALSE 

+ 

+SETERR 7F 4D dddd            Es wird der Fehlerzustand eingeschaltet, das

+                             Wort an der Adresse dddd wird in das pcb-Feld

+                             'error code' gebracht. Falls das Modul im

+                             'enablestop'-Zustand ist, wird das Modul

+                             verlassen.  

+                             IF NOT ERROR 

+                                THEN ERROR := TRUE ; 

+                                     pcb.error line := pcb.line ; 

+                                     pcb.error code := INT<d1> ; 

+                                     WHILE ENSTOP REP return PER 

+                             FI  

+ 

+CLRERR 7F 4F                 Falls der Fehlerzustand vorliegt, wird der

+                             Fehler gelöscht. 

+                             ERROR := FALSE 

+ 

+LN     .00:vv und .04:vv     Die Konstante vv wird in das pcb-Feld

+                             'line number' gebracht (Zur Fehlerbehandlung). 

+                             pcb.line := vv 

+ 

+RPCB   7F 50 dddd dddd       Der Inhalt des pcb-Feldes der eigenen Task mit

+                             der Nummer, die im Wort an der ersten Adresse

+                             steht, wird in das Wort an der zweiten Adresse

+                             gebracht. 

+                             INT<d2> := pcb (myself, INT[<d1>) 

+ 

+CLOCK  7F 66 dddd dddd       Die Systemuhr mit der Nummer, die durch den

+                             Wert des Wortes an der ersten Adresse

+                             spezifiziert wird, wird gelesen und deren

+                             REAL-Wert an der zweiten Adresse abgelegt. 

+                             Wenn <d1> = 0 ist, wird die CPU-Zeit der

+                             eigenen Task geliefert, anderenfalls die

+                             Systemuhr mit der Nummer 1..7 : 

+                             Nummer Funktion 

+                               1    REAL-Time

+                               2    Paging Wait

+                               3    Paging Busy

+                               4    Foreground Tasks cpu-time

+                               5    Background Tasks cpu-time 

+                               6    System cpu-time

+                               7    Reserviert

+ 

+                             IF INT<d1> = 0 

+                                THEN REAL<d2> := pcb.clock 

+                                ELSE REAL<d2> := clock (INT<d1>) 

+                             FI 

+

+ 

+#ub#2.1.14 Systemglobale Instruktionen#ue# 

+ 

+KE     7F 06                 Der EUMEL0-Debugger 'Info' wird aufgerufen,

+                             falls dies ein infofähiges System ist. 

+ 

+SYSG   7F 19                 Sysgen (Nur beim Sysgen-Urlader). 

+ 

+INFOPW 7F 51 dddd dddd dddd  Das bis zu 10 Zeichen lange Infopassword an der

+                             zweiten Adresse (TEXT) wird eingestellt, falls

+                             das alte Infopassword mit dem TEXT an der

+                             ersten Adresse übereinstimmt. In diesem Fall

+                             wird im Wort an der dritten Adresse eine 0

+                             abgelegt, andernfalls eine 1. Dies ist kein

+                             privilegierter Befehl, er funktioniert

+                             allerdings nur, wenn das alte Infopasswort

+                             bekannt ist. 

+                             IF info password = TEXT<d1> 

+                                THEN info password := TEXT<d2> ; 

+                                     INT<d3> := 0 

+                                ELSE INT<d3> := 1 

+                             FI 

+ 

+STORAGE 7F 5A dddd dddd      Die Größe des vorhandene Hintergrundspeichers

+                             in KB wird im Wort an der ersten Adresse

+                             abgelegt, die Größe des benutzten

+                             Hintergrundspeichers an der zweiten Adresse. 

+                             INT<d1> := size ; 

+                             INT<d2> := used 

+ 

+SYSOP  7F 5B dddd            Es wird eine Systemoperation mit der Nummer,

+                             die an der Adresse dddd steht, aufgerufen

+                             (1=Garbage Collection, 11=Savesystem, 4=Shutup,

+                             2=Fixpoint). Dieser Befehl setzt eine

+                             Privilegierung >= 1 voraus. 

+ 

+SETNOW 7F 67 dddd            Die Realtime-Clock (clock(1)) des Systems wird

+                             auf den REAL-Wert an der Adresse dddd gesetzt.

+                             Dieser Befehl setzt eine Privilegierung >= 1

+                             voraus. 

+                             clock (1) := REAL<d1> 

+ 

+SESSION 7F 7E dddd           Der aktuelle Wert des Systemlaufzählers wird

+                             an der Adresse dddd abgelegt. 

+                             INT<d1> := systemlaufzaehler 

+ 

+ID     7F 81 dddd dddd       Der Wert des id-Feldes mit der Nummer, die an

+                             der ersten Adresse steht, wird in das Wort an

+                             der zweiten Adresse geschrieben. Für dei

+                             Nummern der id-Felder gilt: 

+                             Feld    Inhalt 

+                              0      Kleinste HG-Version für EUMEL0 

+                              1      CPU-Type (1=Z80,3=8086,4=68000,5=80286) 

+                              2      Urlader-Version 

+                              3      Reserviert 

+                              4      Lizenznummer des Shards

+                              5      Installationsnummer 

+                              6      Frei für Shard 

+                              7      Frei für Shard 

+                             IF INT<d1> < 4 

+                                THEN INT<d2> := eumel0 id (INT<d1>) 

+                                ELSE INT<d2> := shard id (INT<d1>) 

+                             FI 

+ 

+ 

+#ub#2.1  Alphabetische Liste der Befehle#ue# 

+

+ACT     7F 6C dddd 

+ADD    .1C:dd dddd dddd 

+ALIAS   7F 22 vvvv dddd dddd 

+AMUL256 7F 10 dddd dddd 

+AND     7F 7C dddd dddd dddd 

+ARITHS  7F 5B 

+ARITHU  7F 5C 

+B      .70:aa bzw. .74:aa 

+BCRD    7F 08 dddd dddd 

+BF     .70:aa bzw. .74:aa 

+BLKIN   7F 56 dddd dddd dddd dddd dddd 

+BLKOUT  7F 55 dddd dddd dddd dddd dddd 

+BRCOMP  7F 20 dddd vvvv 

+BT     .00:aa bzw. .04:aa 

+CALL   .78:mm 

+CAT     7F 35 dddd dddd 

+CATINP  7F 44 dddd dddd 

+CDBINT  7F 74 dddd dddd 

+CDBTXT  7F 74 dddd dddd 

+CLEAR  .24:dd 

+CLOCK   7F 66 dddd dddd 

+CLRERR  7F 4F 

+CONTRL  7F 54 dddd dddd dddd dddd 

+COUT    7F 3D dddd 

+CRD     7F 09 dddd dddd 

+CTT     7F 0C dddd dddd 

+CWR     7F 0B dddd dddd dddd 

+DEACT   7F 6D dddd 

+DEC    .18:dd dddd 

+DEC1   .10:dd 

+DECOD   7F 2F dddd dddd 

+DEFCOL  7F 80 dddd 

+DIV     7F 2A dddd dddd dddd 

+DREM256 7F 0F dddd dddd 

+DSACC  .58:dd dddd 

+DSCOPY  7F 46 dddd dddd 

+DSFORG  7F 47 dddd 

+DSHEAP  7F 4A dddd dddd 

+DSPAGS  7F 4C dddd dddd dddd 

+DSRTYP  7F 49 dddd dddd 

+DSTOP   7F 4C 

+DSWTYP  7F 48 dddd dddd 

+ECWR    7F 0A dddd dddd dddd 

+ENCOD   7F 30 dddd dddd 

+EQU    .2C:dd dddd 

+EQUIM   7C vv dddd 

+ERTAB   7F 1C 

+ESTOP   7F 4B 

+EXEC    7F 1D dddd 

+EXTASK  7F 7B dddd 

+FADD   .38:dd dddd dddd 

+FDIV   .44:dd dddd dddd 

+FEQU    7F 24 dddd dddd 

+FLOOR   7F 63 dddd dddd 

+FLSEQ  .48:dd dddd 

+FMOV   .34:dd dddd 

+FMUL   .40:dd dddd dddd 

+FNEG    7F 26 dddd 

+FNONBL  7F 0E dddd dddd dddd 

+FSLD    7F 60 dddd dddd dddd 

+FSUB   .3C:dd dddd dddd 

+GADDR   7F 16 dddd dddd dddd 

+GARB    7F 5F 

+GCADDR  7F 17 dddd dddd dddd 

+GCPOS   7F 43 dddd dddd 

+GETC    7F 0D dddd dddd dddd 

+GETTAB  7F 1A 

+GETW    7E v1v2 dddd dddd 

+GEXP    7F 61 dddd dddd 

+GORET   7F 07 

+GOSUB   7F 05 aaaa 

+GW      7F 70 dddd dddd dddd 

+HEAD    vvvv (kein Opcode) 

+HPSIZE  7F 5E dddd 

+ID      7F 81 dddd dddd 

+IMULT   7F 28 dddd dddd dddd 

+INC    .14:dd dddd 

+INC1   .0C:dd 

+INCETY  7F 41 dddd 

+INCHAR  7F 40 dddd 

+INFOPW  7F 51 dddd dddd dddd 

+ISDIG   7F 11 dddd 

+ISERR   7F 4E 

+ISLCAS  7F 13 dddd 

+ISLD    7F 12 dddd 

+ISSHA   7F 18 dddd 

+ISUCAS  7F 14 dddd 

+ITRPL   7F 2E dddd dddd dddd 

+ITSUB   7F 2D dddd dddd dddd 

+KE      7F 06 

+LN     .00:vv und .04:vv 

+LSEQ   .30:dd dddd 

+MOD     7F 2B dddd dddd dddd 

+MOV    .08:dd dddd 

+MOVi    FC vv dddd 

+MOVii   7F 23 vvvv dddd 

+MOVx    7D vv dddd dddd 

+MOVxx   7F 21 vvvv dddd dddd 

+MUL     7F 29 dddd dddd dddd 

+NEG     7F 27 dddd 

+NILDS   7F 45 dddd 

+NXTDSP  7F 4B dddd dddd dddd 

+OR      7F 7D dddd dddd dddd 

+OUT     7F 3C dddd 

+OUTF    7F 3E dddd dddd 

+OUTFT   7F 3F dddd dddd dddd 

+PAUSE   7F 42 dddd 

+PCALL   7F 1F dddd 

+PENTER  FE vv 

+PNACT   7F 76 dddd 

+POS     7F 37 dddd dddd dddd 

+POSF    7F 38 dddd dddd dddd dddd 

+POSFT   7F 39 dddd dddd dddd dddd dddd 

+POSIF   7F 3B dddd dddd dddd dddd dddd 

+PP     .6C:dd 

+PPCALL  7F 7A dddd dddd dddd dddd 

+PPROC   7F 1E mmmm 

+PPV    .68:dd 

+PUTTAB  7F 1B 

+PUTW    FD v1v2 dddd dddd 

+PW      7F 6F dddd dddd dddd 

+REF    .5C:dd dddd 

+REPLAC  7F 34 dddd dddd dddd 

+ROTATE  7F 53 dddd dddd 

+RPCB    7F 50 dddd dddd 

+RTN     7F 00 

+RTNF    7F 02 

+RTNT    7F 01 

+RTRPL   7F 65 dddd dddd dddd 

+RTSUB   7F 64 dddd dddd dddd 

+SEL    .64:dd vvvv dddd 

+SEND    7F 71 dddd dddd dddd dddd 

+SENDFT  7F 7F dddd dddd dddd dddd dddd 

+SESSION 7F 7E dddd 

+SETERR  7F 4D dddd 

+SETNOW  7F 67 dddd 

+SEXP    7F 62 dddd dddd 

+STOP    7F 04 

+STORAGE 7F 5A dddd dddd 

+STRANL  7F 3A dddd dddd dddd dddd dddd dddd dddd 

+SUB    .20:dd dddd dddd 

+SUBS   .60:vv vvvv dddd dddd dddd 

+SUBT1   7F 31 dddd dddd dddd 

+SUBTF   7F 33 dddd dddd dddd 

+SUBTFT  7F 32 dddd dddd dddd dddd 

+SWCALL  7F 73 dddd dddd dddd dddd 

+SYSG    7F 19 

+SYSOP   7F 5B dddd 

+TBEGIN  7F 6F dddd aaaaaa 

+TCPU    7F 6A dddd dddd 

+TEND    7F 70 dddd 

+TEQU   .50:dd dddd 

+TEST   .28:dd 

+THALT   7F 6E dddd 

+TLEN    7F 36 dddd dddd 

+TLSEQ   7F 25 dddd dddd 

+TMOV   .4C:dd dddd 

+TPBEGIN 7F 5F dddd dddd dddd aaaaaa 

+TRPCB   7F 68 dddd dddd dddd 

+TSTAT   7F 6B dddd dddd 

+TWCPU   7F 52 dddd dddd 

+TWPCB   7F 69 dddd dddd dddd 

+ULSEQ  .54:dd dddd 

+WAIT    7F 72 dddd dddd dddd 

+XOR     7F 79 dddd dddd dddd 

+ 

+#page# 

+#ub#3.  Beschreibung der Pakete#ue# 

+ 

+#ub#3.1  PACKET address#ue# 

+ 

+Mit diesem Paket werden die Operationen für 16 Bit Adressrechnung zur

+Verfügung gestellt. 

+ 

+TEXT PROC hex8 (INT CONST dez) : 

+  Der INT-Parameter (0..255) wird in eine 2-Zeichen Hexdarstellung

+  konvertiert. 

+ 

+ 

+TEXT PROC hex16 (INT CONST dez) : 

+  Der INT-Parameter (0..65535) wird in eine 4-Zeichen

+  Hexdarstellung (ohne Vorzeichen) konvertiert. 

+ 

+ 

+INT PROC integer (TEXT CONST hex) : 

+  Der TEXT-Parameter (1-4 Byte Hexdarstellung, 0..9, a..f/A..F) wird in eine

+  Dezimalzahl konvertiert. 

+ 

+ 

+INT PROC getword (INT CONST segment, address) : 

+  Das Wort an der Adresse 'address' (0..65535) im Segment 'segment' (0..7)

+  wird gelesen. 

+ 

+ 

+PROC putword (INT CONST segment, address, value) : 

+  Der Wert 'value' wird in das Wort an der Adresse 'address' (0..65535) im

+  Segment 'segment' (0..7) geschrieben. 

+ 

+ 

+INT PROC cdbint (INT CONST address) : 

+  Der Wert an der Adresse 'address' (0..32767 sinnvoll) im Segment 5

+  (permanente Compilertabellen) wird gelesen. 

+ 

+ 

+TEXT PROC cdbtext (INT CONST address) : 

+  Der String, der an der Adresse 'address' im Segment 5 (permanente

+  Compilertabellen) beginnt, wird als TEXT gelesen. 

+ 

+ 

+PROC splitword (INT VAR word, lowbyte) : 

+  Das Wort 'word' wird in den höherwertigen und niederwertigen Teil zerlegt.

+  Das highbyte steht nach dieser Operation in 'word', das lowbyte in

+  'lowbyte'. 

+ 

+ 

+PROC makeword (INT VAR word, INT CONST lowbyte) : 

+  word := word * 256 + lowbyte 

+ 

+ 

+BOOL PROC ulseq (INT CONST left, right) : 

+  '<=' für positive INT-Zahlen (0..65535). 

+ 

+ 

+OP INC (INT VAR word) : 

+  'word INCR 1' für positive INT-Zahlen (0..65535), ohne daß ein Überlauf

+  auftritt. 

+ 

+ 

+OP DEC (INT VAR word) : 

+  'word DECR 1' für poistive INT-Zahlen (0..65535), ohne daß ein Unterlauf

+  auftritt. 

+ 

+ 

+INT OP ADD (INT CONST left, right) : 

+  'left + right' für positive INT-Zahlen (0..65535), ohne daß ein Überlauf

+  auftritt. 

+ 

+ 

+INT OP SUB (INT CONST left, right) : 

+  'left - right' für positive INT-Zahlen (0..65535), ohne daß ein Überlauf

+  auftritt. 

+ 

+ 

+INT OP MUL (INT CONST left, right) : 

+  'left * right' für positive INT-Zahlen (0..65535), ohne daß ein Überlauf

+  auftritt. 

+ 

+ 

+#ub#3.2  PACKET table routines#ue# 

+ 

+PROC init module table (TEXT CONST name) : 

+  Ein benannter Datenraum ('name') wird eingerichtet. Dieser enthält die

+  aufbereitete Permanenttabelle für schnelle Zugriffe. Die Datenstruktur

+  beschreibt drei Tabellen (PACKETTABLE, MODULETABLE, TYPETABLE), über die

+  zu einer Modulnummer deren Name und deren Parameter, sowie der zugehörige

+  Paketname gefunden werden kann, wenn sie in der Permanenttabelle steht. 

+  Die TYPETABLE enthält zu jedem TYPE, der in der Permanenttabelle steht,

+  seine Größe in Words. 

+ 

+ 

+PROC add modules : 

+  Module und Typen neu insertierter Pakete werden in die 'module table'

+  aufgenommen. 

+ 

+ 

+PROC dump tables (TEXT CONST name) : 

+  Der Inhalt der geladenen Modultabelle wird in der FILE 'name' ausgedumpt. 

+ 

+ 

+TEXT PROC module name and specifications (INT CONST module number) : 

+  Der Name und die Parameter des Moduls mit der Nummer 'module number'

+  (0..2047) wird als TEXT geliefert. Falls das Modul nicht in der

+  Permanenttabelle steht, wird niltext geliefert. 

+ 

+ 

+TEXT PROC packetname (INT CONST module number) : 

+  Der Name des Pakets, das das Modul mit der Nummer 'module number'

+  definiert, wird als TEXT geliefert. Falls das Modul nicht in der

+  Permanenttabelle steht, wird der Name des letzten vorher insertierten

+  Pakets geliefert (In manchen Fällen also nicht der wahre Paketname). 

+ 

+ 

+INT PROC storage (TEXT CONST typename) : 

+  Aus der Modultabelle wird Größe des TYPEs mit dem Namen 'typname' gelesen.

+  Wenn der Typ nicht in der Permanenttabelle steht, wird 0 geliefert. 

+ 

+ 

+PROC getmodulenumber (INT VAR module number) : 

+  Erfragt eine Modulnummer am Bildschirm. Der Benutzer kann entweder eine

+  Zahl eingeben oder den Namen einer PROC/OP. Wenn mehrere Module mit diesem

+  Namen existieren, wird eine Auswahlliste angeboten. In 'module number'

+  wird die ausgewählte Modulnummer übergeben. 

+   

+ 

+INT PROC codeaddress (INT CONST module number) : 

+  Liefert die Anfangsadresse des Moduls mit der Nummer 'module number'. 

+ 

+ 

+INT PROC codesegment (INT CONST module number) : 

+  Liefert die Nummer des Codesegments, in dem der Code des Moduls mit der

+  Nummer 'module number' steht. 

+ 

+ 

+INT PROC hash (TEXT CONST object name) : 

+  Berechnet den Hashcode des Objekts 'object name', um über die Hashtable,

+  Nametable, Permanenttable die Parameter eines Objekts zu suchen. 

+ 

+ 

+#ub#3.3  PACKET eumel decoder#ue# 

+ 

+#ub#3.3.1  Zugriff auf globale Parameter#ue# 

+ 

+PROC default no runtime : 

+  Bereitet den Decoder darauf vor, daß keine runtime vorliegt, d.h.

+  Stackzugriffe nicht sinnvoll sind. Für Parameter mit lokalen Adressen

+  werden deshalb keine Variableninhalte dargestellt. Bei fast allen

+  Decoderaufrufen mit 'decode'/'decode module' bis auf die 'decode' mit

+  mehr als zwei Parametern, wird 'default no runtime' automatisch aufgerufen. 

+ 

+ 

+PROC set parameters (INT CONST lbase, pbase, line number, c8k) : 

+PROC get parameters (INT VAR lbase, pbase, line number, c8k) : 

+  Einstell- und Informationsprozeduren (für den Tracer). 'lbase' ist die

+  lokale Basis (Stackoffset für dies Modul), 'pbase' ist das highbyte der

+  Paketbasis, 'line number' ist die letzte 'LN'-Zeilennummer, 'c8k' (cmod)

+  wird von EUMEL0 beim Eintritt in ein Modul auf

+  high (Modulstartaddresse + 16KB) gesetzt (für Branch-Befehle). 

+ 

+ 

+PROC pbase (INT CONST pbase highbyte) : 

+INT PROC pbase : 

+  Einstell- und Informationsprozeduren, nicht nur für den Tracer. Die

+  Paketbasis (Globale Daten) wird gesetzt. Dazu wird nur das Highbyte (z.B.

+  nach 'PENTER') übergeben. 

+ 

+ 

+PROC lbase (INT CONST local base) : 

+  Einstellprozedur für den Tracer. Stellt während der runtime die aktuelle

+  Basis ein. Wird der Decoder nicht während runtime betrieben, sollte

+  lbase(-1) eingestellt werden. 

+ 

+ 

+INT PROC line number : 

+  Liefert die letzte, mit 'LN' eingestellte, Zeilennummer. 

+ 

+PROC list filename (TEXT CONST name) : 

+  Stellt den Namens-Prefix der Outputfiles ein. Voreingestellt ist "". An

+  den Filename wird ".n" angehängt, wobei n mit '0' beginnt. 

+

+PROC bool result (BOOL CONST status) : 

+BOOL PROC bool result : 

+  Einstell- und Informationsprozeduren, die für den Tracer benötigt werden.

+  Lieferte der letzte disassemblierte Befehl ein BOOL-Result ? 

+ 

+PROC with object address (BOOL CONST status) : 

+BOOL with object address :

+  Einstell- und Informationsprozeduren, nicht nur für den Tracer. Sollen

+  außer den Darstellungen der Speicherinhalte auch die Parameteradressen (in

+  spitzen Klammern) ausgegeben werden ? 

+ 

+PROC with code words (BOOL CONST status) : 

+BOOL PROC with code words : 

+  Einstell- und Informationsprozeduren, nicht für den Tracer. Sollen ab der

+  80. Spalte in der Outputfile die Hexdarstellungen der dekodierten

+  Codewörter ausgegeben werden ? 

+ 

+ 

+#ub#3.3.2  Aufruf des Disassemblers#ue# 

+ 

+PROC decode : 

+  Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur

+  wird erfragt. Die Modultabelle wird ggf. ergänzt, es wird 'default no

+  runtime' eingestellt. 

+ 

+ 

+PROC decode (INT CONST first module number) : 

+  Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur

+  wird übergeben. Die Modultabelle wird ggf. ergänzt, es wird 'default no

+  runtime' eingestellt. 

+ 

+ 

+PROC decode (INT CONST segment, address) : 

+  Aufruf des Decoders. Die Disassemblierung beginnt in dem

+  Codesegment/Adresse, das/die als Parameter übergeben wird. Die Modultabelle

+  wird ggf. ergänzt, es wird 'default no runtime' eingestellt. 

+ 

+ 

+PROC decode (INT CONST segment, INT VAR address, INT CONST to addr,

+             BOOL CONST only one module) : 

+  Dieser Decoderaufruf setzt kein 'default no runtime', erweitert aber ggf.

+  die Modultabelle. Der bei 'address' beginnende und bei 'to addr' endende

+  Adressbereich im Codesegment 'segment' wird dekodiert. Ist 'only one

+  module' TRUE, wird nur bis zum Ende des aktuellen Moduls dekodiert.

+  'address' zeigt nach dem Prozeduraufruf auf die nächste Instruktion nach

+  'to addr'.

+ 

+ 

+PROC decode (INT CONST segment, INT VAR address, TEXT VAR words,

+             instruction, INT PROC (INT CONST, INT VAR, TEXT VAR) next word)):

+  Diese Prozedur ist das Herz des Decoders. Sie disassembliert eine

+  Instruktion, die im Codesegment 'segment', Adresse 'address' beginnt und

+  legt die mit 'nextword' gelesenen Wörter als Hexdarstellung in 'words' ab.

+  Die dekodierte Instruktion steht dann in 'instruction'. Vor dem Aufruf

+  dieser Prozedur sollte 'words' und 'instruction' niltext zugewiesen werden.

+  Die passende Prozedur 'nextword' wird auch vom 'eumel decoder'

+  herausgereicht. 'address' zeigt nach der Ausführung des Befehls auf die

+  nächste Instruktion. 

+ 

+ 

+PROC decodemodule : 

+  Wie 'decode', nur wird bis nur zum Ende des gewünschten Moduls

+  disassembliert. 

+ 

+ 

+PROC decodemodule (INT CONST module number) : 

+  Wie 'decode', nur wird bis nur zum Ende des gewünschten Moduls

+  disassembliert. 

+ 

+ 

+#ub#3.3.3  Weitere Prozeduren#ue# 

+ 

+PROC nextmoduleheader (INT CONST segment, INT CONST address,

+                       INT VAR header address, module number) : 

+  Diese Prozedur findet ab der angegeben Adresse ('segment'/'address') den

+  Anfang des nächsten Moduls. In 'header address' wird die Startadresse des

+  gefundenen Moduls geliefert (bleibt im Segment 'segment'), in 'module

+  number' die Nummer des gefundenen Moduls. 

+ 

+ 

+INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) : 

+ Diese Prozedur liefert das durch 'segment'/'address' angegeben Wort, hängt

+ die Hexdarstellung dieses Wortes an 'words' an und erhöht 'address' um

+ eins. 

+ 

+ 

+TEXT PROC data representation (INT CONST data addr, segment, address, type):

+  Diese Prozedur liefert die Darstellung des Parameters 'data addr' ggf. mit

+  Adresse (--> with object address).  'segment'/'address' bezeichnet die

+  Position, an der die Instruktion für diesen Parameter steht. 'type' ist

+  ein (durch die Instruktion festgelegter) Typ des Parameters, mit dem die

+  Art der Darstellung gewählt wird (TEXT, REAL, INT, ...). Im Gegensatz zu

+  'object representation' braucht bei dieser Prozedur keine Darstellung

+  vorhanden sein. In diesem Falle wird nur z.B. der Stackoffset '<L n>'

+  ausgegeben. 

+ 

+ 

+TEXT PROC object representation (INT CONST data segment, data address,

+                                           segment, address, type) : 

+  Diese Prozedur wird von 'data representation' aufgerufen und liefert die

+  Darstellung des Parameters. In 'data segment'/'data address' wird die

+  Anfangsadresse der darzustellenden Daten übergeben. Die anderen drei

+  Parameter verhalten sich wie bei 'data representation'. 

+ 

+ 

+TEXT PROC last actual parameter : 

+  Liefert den Wert (nach TEXT konvertiert) des letzten dekodierten aktuellen

+  Parameters (am sinnvollsten während runtime). Diese prozedur wird vom

+  Tracer benutzt. 

+ 

+ 

+#ub#3.4  PACKET tracer#ue# 

+ 

+#ub#3.4.1  Zugriff auf globale Parameter#ue# 

+ 

+ 

+PROC prot file (TEXT CONST filename) :

+TEXT PROC prot file : 

+  Einstell- und Informationsprozeduren für den Namen der Protokollfile.

+  Wird ein 'filename' ungleich niltext eingestellt, dann werden die

+  dekodierten Instruktionen während der Ablaufverfolgung zusätzlich in diese

+  File geschrieben. 

+ 

+ 

+PROC source file (TEXT CONST filename) : 

+TEXT PROC source file : 

+  Einstell- und Informationsprozeduren für den Namen der Quelltextdatei.

+  Wird ein 'filename' ungleich niltext eingestellt, dann wird nach dem

+  Ausführen eines 'LN'-Befehls (LineNumber) die Zeile mit dieser Nummer aus

+  der Quelldatei gelesen und parallel zur dekodierten EUMEL0-Instruktion

+  angezeigt. 

+ 

+ 

+PROC tracer channel (INT CONST) :

+INT PROC tracerchannel : 

+  Einstell- und Informationsprozeduren für den Kanal, an dem das Programm

+  ausgeführt werden soll. Die Ablaufverfolgung bleibt an dem Kanal, an dem

+  die PROC/OP aufgerufen wurde. 

+ 

+ 

+#ub#3.4.2  Aufruf des Tracers#ue# 

+ 

+  Eine PROC/OP, in der ein Breakpoint gesetzt wurde, kann zum Beispiel im

+  Monitor aufgerufen werden. Ab der Adresse, an der der Breakpoint gesetzt

+  wurde, kann die Abarbeitung des Codes verfolgt werden. Das Setzen der

+  Breakpoints geschieht mit 'set breakpoint'. 

+ 

+ 

+PROC trace : 

+  Diese Prozedur erfragt vom Benutzer die PROC/OP, bei der der die

+  Ablaufverfogung beginnen soll. Anschließend muß der Aufruf der PROC/OP

+  eingegeben werden. Der Benutzer wird außerdem nach dem Namen der

+  compilierten Quelldatei, dem Namen der Protokollfile und dem

+  Abarbeitungskanal gefragt. Nachdem alle Angaben gemacht worden sind, wird

+  der PROC/OP-Aufruf mit 'do' ausgeführt. 

+ 

+ 

+PROC set breakpoint : 

+  Die Modultabelle wird ggf. erweitert, der Benutzer wird nach dem Namen

+  einer PROC/OP gefragt, deren Codeabarbeitung verfolgt werden soll. Der Code

+  dieser PROC/OP muß im Codesegment 3 stehen (sonst erfolgt ein 'errorstop').

+  Der Protokoll- und Sourcefilename werden auf niltext gesetzt. 

+ 

+ 

+PROC set breakpoint (INT CONST breakpointnr, address) : 

+  Setzt an der übergebenen Codeadresse im Segment 3 einen Breakpoint der

+  beiden Breakpoints (1 oder 2 als 'breakpointnr'). Der Benuzter ist selbst

+  dafür verantwortlich daß 

+  - dies nicht die Einsprungsadresse eines Moduls ist (HEAD-Instruktion), 

+  - die übergebene Adresse das erste (Opcode-) Wort einer Instruktion ist, 

+  - vor dem Aufruf des Moduls die Paketbasis korrekt gesetzt ist, falls

+    vor der ersten Instruktion mit Parametern kein 'PENTER' ausgeführt wird. 

+ 

+ 

+PROC reset breakpoints : 

+  Die Breakpoints werden zurückgesetzt und der (wegen des Breakpointhandler-

+  CALLs) gesicherte Code wieder an seinen Originalplatz zurückgeschrieben. 

+ 

+ 

+PROC reset breakpoint (INT CONST breakpointnr) : 

+  Es wird nur gezielt der eine Breakpoint mit der Nummer 'breakpointnr'

+  zurückgesetzt. 

+ 

+ 

+PROC list breakpoints : 

+  Der Status, die Adresse und der gesicherte Code (an dieser Adresse) werden 

+  für beide Breakpoints gelistet. 

diff --git a/devel/debugger/1.8.2/src/DEBUGGER.ELA b/devel/debugger/1.8.2/src/DEBUGGER.ELA
new file mode 100644
index 0000000..6b4a429
--- /dev/null
+++ b/devel/debugger/1.8.2/src/DEBUGGER.ELA
@@ -0,0 +1,3151 @@
+(*************************************************************************) 

+(**                                                                     **) 

+(*  EUMEL - Debugger: (C) Michael Staubermann, Oktober/November '86      *) 

+(*  Ab EUMEL 1.7.5.4                                                     *)

+(*  Stand: 01.12.86, 1.8.2: 26.07.88                                     *)

+(*  Noch keine BOUND-Variablen-Zugriffe implementiert                    *)

+(**                                                                     **) 

+(*************************************************************************) 

+ 

+ 

+PACKET address  DEFINES ADD,                      (* 1.7.5  861006 *) 

+                        SUB,                      (* 1.8.0  861022 *)

+                        MUL,                      (* M. Staubermann*)

+                        INC, 

+                        DEC, 

+                        ulseq,

+ 

+                        split word , 

+                        make word , 

+

+                        hex16, 

+                        hex8 , 

+                        integer , 

+ 

+                        cdbint , 

+                        cdbtext , 

+ 

+                        get word , 

+                        put word : 

+ 

+ 

+(*********************** Hex-Konvertierung ********************************) 

+ 

+LET hex digits = "0123456789ABCDEF" ; 

+ 

+PROC paket initialisierung : 

+ (* Paketinitialisierung, wird nur einmal durchlaufen *)

+ INT CONST ulseq addr :: getword (0, 512 + 

+     mod nr (BOOL PROC (INT CONST, INT CONST) ulseq)) ADD 2 ; 

+ IF getword (3, ulseq addr) = integer ("B009") (* bei checkoff LSEQ *) 

+    THEN putword (3, ulseq addr, integer ("D409")) (* ULSEQ <LR 4> *)

+ ELIF getword (3, ulseq addr ADD 1) = integer ("B009") (* bei checkon *) 

+    THEN putword (3, ulseq addr ADD 1, integer ("D409"))  

+ FI 

+ 

+ENDPROC paket initialisierung ; 

+ 

+INT PROC integer (TEXT CONST hex) : 

+ INT VAR summe := 0, i ; 

+ FOR i FROM 1 UPTO min (4, LENGTH hex) REP 

+  rotate (summe, 4) ; 

+  summe INCR digit 

+ PER ; 

+ summe .

+ 

+digit : 

+ TEXT CONST char := hex SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ 

+ENDPROC integer ; 

+ 

+TEXT PROC hex8 (INT CONST wert) : 

+ (hex digits SUB ((wert DIV 16) +1)) +

+ (hex digits SUB ((wert AND 15) +1))

+ 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex16 (INT CONST wert) :

+ TEXT VAR result := "" ; 

+ INT VAR i, w := wert ;

+ FOR i FROM 1 UPTO 4 REP 

+  rotate (w, 4) ; 

+  result CAT (hex digits SUB ((w AND 15)+1))

+ PER ; 

+ result  

+ 

+ENDPROC hex16 ;

+ 

+(***************************** Adressarithmetik ***************************)

+

+PROC arith 15 : 

+ 

+ EXTERNAL 91 

+ 

+ENDPROC arith 15 ; 

+ 

+ 

+PROC arith 16 : 

+ 

+ EXTERNAL 92 

+ 

+ENDPROC arith 16 ; 

+ 

+ 

+OP INC (INT VAR a) : 

+ arith 16 ; 

+ a INCR 1

+ 

+ENDOP INC ; 

+ 

+

+OP DEC (INT VAR a) : 

+ arith 16 ; 

+ a DECR 1

+ 

+ENDOP DEC ; 

+ 

+ 

+INT OP ADD (INT CONST left, right) : 

+ arith 16 ; 

+ left + right  

+ 

+ENDOP ADD ; 

+ 

+INT OP SUB (INT CONST left, right) : 

+ arith16 ; 

+ left - right 

+ 

+ENDOP SUB ; 

+ 

+INT OP MUL (INT CONST left, right) : 

+ arith 16 ; 

+ left * right    (* Multiplikation MOD 65536 im Gegensatz zu IMULT *)

+ 

+ENDOP MUL ; 

+ 

+BOOL PROC ulseq (INT CONST left, right) : 

+ left <= right   (* Muß leider(!!) auf ULSEQ Code gepatcht werden *)

+ENDPROC ulseq ; 

+

+(*************************** Wortoperationen ******************************) 

+ 

+PROC split word (INT VAR word and high byte, low byte) : 

+ 

+ EXTERNAL 15 

+ 

+ENDPROC split word ; 

+ 

+

+PROC make word (INT VAR highbyte and resultword, INT CONST low byte) : 

+ 

+ EXTERNAL 16 

+

+ENDPROC make word ; 

+ 

+ 

+(************************** DS4-Access ***********************************)

+ 

+INT PROC cdbint (INT CONST adr) : 

+ 

+ EXTERNAL 116 

+ 

+ENDPROC cdbint ; 

+ 

+ 

+TEXT PROC cdbtext (INT CONST adr) : 

+ 

+ EXTERNAL 117 

+

+ENDPROC cdbtext ; 

+ 

+ 

+PROC putword (INT CONST segment, adr, value) : 

+ 

+ EXTERNAL 119 

+ 

+ENDPROC put word ; 

+ 

+ 

+INT PROC getword (INT CONST segment, adr) : 

+ 

+ EXTERNAL 120 

+ 

+ENDPROC getword ; 

+ 

+

+INT PROC mod nr (BOOL PROC (INT CONST, INT CONST) proc) : 

+

+ EXTERNAL 35 

+

+ENDPROC mod nr ; 

+

+

+paket initialisierung 

+

+ENDPACKET address ; 

+ 

+(**************************************************************************) 

+ 

+PACKET table routines DEFINES                (* Für eumel decoder 861017 *)

+                                             (* 1.8.0 by M.Staubermann   *)

+                              code segment , 

+                              code address ,

+                              packet name , 

+                              module name and specifications ,

+                              get module number ,

+                              storage , 

+                              hash ,

+                              init module table, 

+                              add modules ,

+                              dump tables :

+ 

+ 

+LET end of hash table                 = 1023 , 

+    begin of permanent table          = 22784 , 

+    begin of pt minus ptt limit       = 12784 ,

+    end of permanent table            = 32767 , 

+ 

+    permanent param const             = 10000 ,

+    permanent param var               = 20000 ,

+    permanent proc op                 = 30000 ,

+    permanent type                    = 30000 ,

+    permanent row                     =    10 ,

+    permanent struct                  =    11 ,

+    permanent param proc              =    12 ,

+    permanent struct end              =     0 ,

+

+    ptt limit                         = 10000 ,

+ 

+    void                              =     0 ,

+    

+    const                             =     1 , 

+    var                               =     2 ,

+

+    sysgenoff module number           = 1280 , 

+    start of module number link table = 512 ,   

+    highest module number 1           = 2048 , 

+    max packets                       = 128 ,

+    max types                         = 64 ;

+ 

+ 

+LET MODULETABLE = ROW highest module number 1 

+                      STRUCT (TEXT name, specifications, INT packet link) , 

+    PACKETTABLE = ROW max packets STRUCT (TEXT name, INT permanent address), 

+    TYPETABLE   = STRUCT (THESAURUS names, ROW max types INT storage),

+    TABLETYPE   = BOUND STRUCT (MODULETABLE module, PACKETTABLE packet,

+                                TYPETABLE types, INT number of packets, 

+                                end of permanent table) ; 

+ 

+TABLETYPE VAR table ; 

+ 

+TEXT VAR type and mode, result ; 

+BOOL VAR end of params ; 

+INT VAR mode, paramlink, index ;

+ 

+(************************* Module- und Packettablezugriff **************) 

+ 

+PROC init module table (TEXT CONST table name) :

+ forget (table name, quiet) ; 

+ table := new (table name) ; 

+ table.number of packets := 0 ; 

+ table.end of permanent table := begin of permanent table ;

+

+ table.types.names := empty thesaurus ;

+ insert (table.types.names, "INT", index) ; 

+ table.types.storage (index) := 1 ; 

+ insert (table.types.names, "REAL", index) ; 

+ table.types.storage (index) := 4 ; 

+ insert (table.types.names, "BOOL", index) ; 

+ table.types.storage (index) := 1 ; 

+ insert (table.types.names, "TEXT", index) ; 

+ table.types.storage (index) := 8 ; 

+ insert (table.types.names, "DATASPACE", index) ; 

+ table.types.storage (index) := 1 ; 

+

+ scan permanent table (table.end of permanent table) ; 

+ scan hash table (begin of permanent table) ; 

+ 

+ENDPROC init module table ; 

+ 

+ 

+PROC add modules :

+ INT CONST old end of permanent table := table.end of permanent table ;

+ IF cdbint (table.end of permanent table) <> -3 

+    THEN scan permanent table (table.end of permanent table) ; 

+         scan hash table (old end of permanent table)

+ FI  

+

+ENDPROC add modules ; 

+ 

+ 

+PROC scan hash table (INT CONST minimum permanent address) : 

+ INT VAR hash table pointer ; 

+ FOR hash table pointer FROM 0 UPTO end of hash table REP 

+  IF cdbint (hash table pointer) <> 0 

+  THEN cout (hash table pointer) ; 

+       list all name table objects with this hash code (hash table pointer,

+                     minimum permanent address)

+  FI 

+ PER 

+ 

+ENDPROC scan hash table ; 

+ 

+ 

+PROC list all name table objects with this hash code (INT CONST link,

+                   minimum permanent address) :

+ TEXT VAR object name ;

+ INT VAR name table pointer := first link word, module nr, 

+         permanent pointer ; 

+ WHILE NOT end of name table chain REPEAT

+  permanent pointer := cdb int (nametable pointer + 1) ;

+  WHILE permanent pointer >= minimum permanent address REP

+   object name := cdbtext (name table pointer + 2) ; 

+   IF permanent type definition 

+    THEN insert (table.types.names, object name, index) ;

+         table.types.storage (index) := cdb int (permanent pointer + 2) 

+    ELSE get specifications (permanent pointer) ; 

+         module nr := cdb int (param link + 1) + 1;

+         table.module (module nr).name := object name ; 

+         table.module (module nr).specifications := result;

+         table.module (module nr).packet link := packetlink(permanentpointer) 

+   FI ; 

+   permanent pointer := cdb int (permanent pointer)

+  PER ; 

+  name table pointer := cdb int (name table pointer)  

+ END REPEAT . 

+ 

+first link word : 

+ cdb int (link) .

+ 

+end of name table chain : 

+ name table pointer = 0 . 

+ 

+permanent type definition : 

+ (object name SUB 1) <= "Z" AND (object name SUB 1) >= "A" AND 

+  cdbint (permanent pointer + 1) = permanent type 

+

+END PROC list all name table objects with this hash code ; 

+ 

+ 

+INT PROC packet link (INT CONST permanent address) : 

+ INT VAR packet pointer ; 

+ FOR packet pointer FROM 1 UPTO table.number of packets REP 

+     IF table.packet (packet pointer).permanent address > permanent address 

+        THEN LEAVE packet link WITH packet pointer -1

+     FI 

+ PER ; 

+ table.number of packets 

+

+ENDPROC packet link ; 

+ 

+

+PROC scan permanent table (INT VAR permanent pointer) : 

+ FOR permanent pointer FROM permanent pointer UPTO end of permanent table 

+     WHILE cdbint (permanent pointer) <> -3 REP 

+  IF cdbint (permanent pointer) = -2 

+     THEN cout (permanent pointer) ;

+          table.number of packets INCR 1 ; 

+          table.packet (table.number of packets).name := 

+               cdbtext (cdbint (permanent pointer +1) +2) ; 

+          table.packet (table.number of packets).permanent address := 

+               permanent pointer

+  FI 

+ PER 

+

+ENDPROC scan permanent table ; 

+ 

+

+PROC dump tables (TEXT CONST file name) : 

+ INT VAR i ; 

+ forget (filename, quiet) ; 

+ FILE VAR f := sequentialfile (output, filename) ; 

+ maxline length (f, 1000) ;

+  

+ putline (f, "PACKETTABLE:") ; 

+ put (f, "End of Permanenttable:") ; 

+ put (f, hex16 (table.end of permanent table)) ; 

+ line (f) ; 

+ putline (f, "Nr. Packetname") ;

+ FOR i FROM 1 UPTO table.number of packets REP 

+  cout (i) ; 

+  put (f, text (i, 3)) ; 

+  put (f, hex16 (table.packet (i).permanent address)) ; 

+  putline (f, table.packet (i).name) 

+ PER ; 

+ line (f, 2) ; 

+ putline (f, "TYPETABLE:") ; 

+ putline (f, " Size Name") ; 

+ index := 0 ; 

+ get (table.types.names, type and mode, index) ; 

+ WHILE index > 0 REP 

+  put (f, text (table.types.storage (index), 5)) ; 

+  putline (f, type and mode) ; 

+  get (table.types.names, type and mode, index) 

+ PER ; 

+ line (f, 2) ; 

+ putline (f, "MODULETABLE:") ; 

+ putline (f, "Modnr.PNr.Name and Parameters") ; 

+ FOR i FROM 1 UPTO highest module number 1 REP 

+  IF table.module (i).packet link <> -1 

+     THEN cout (i) ;

+          put (f, text (i-1, 5)) ; 

+          put (f, text (table.module (i).packet link, 3)) ;

+          put (f, table.module (i).name) ; 

+          putline (f, table.module (i).specifications) ; 

+  FI 

+ PER  

+ 

+ENDPROC dump tables ; 

+ 

+

+INT PROC storage (TEXT CONST typename) : 

+ index := link (table.types.names, typename) ; 

+ IF index = 0 

+    THEN 0 

+    ELSE table.types.storage (index) 

+ FI 

+

+ENDPROC storage ; 

+ 

+ 

+TEXT PROC module name and specifications (INT CONST module number) : 

+ IF LENGTH table.module (module number + 1).name > 0 

+    THEN table.module (module number + 1).name + " " + 

+         table.module (module number + 1).specifications

+    ELSE "" 

+ FI

+

+ENDPROC module name and specifications ; 

+ 

+ 

+TEXT PROC packet name (INT CONST module number) :

+ IF table.module (module number + 1).packet link > 0 

+    THEN table.packet (table.module (module number + 1).packet link).name 

+    ELSE FOR index FROM module number DOWNTO 1 REP

+           IF table.module (index).packet link > 0 

+              THEN LEAVE packet name WITH table.packet (table.module 

+                   (index).packet link).name

+           FI 

+         PER ; 

+         "" 

+ FI

+ 

+ENDPROC packet name ; 

+ 

+

+(************************ Modulnummern ***********************************) 

+ 

+INT PROC code segment (INT CONST module number) : 

+ IF module number < sysgen off module number 

+    THEN 2 

+    ELSE 3 

+ FI 

+

+ENDPROC code segment ; 

+ 

+

+INT PROC code address (INT CONST module number) : 

+ get word (0, start of module number link table + module number) 

+ENDPROC code address ; 

+ 

+

+PROC get module number (INT VAR module number) : 

+ TEXT VAR object ;

+ INT VAR anz objects, name table pointer, permanent pointer ;  

+ put ("Name oder Modulnummer der PROC/OP:") ; 

+ getline (object) ; 

+ changeall (object, " ", "") ;

+ IF object = "" 

+    THEN LEAVE get module number 

+ FI ; 

+ disablestop ; 

+ module number := int (object) ; 

+ IF NOT iserror AND last conversion ok AND module number >= -1 AND 

+                                           module number < 2048

+    THEN LEAVE get module number 

+ FI ; 

+ clear error ; 

+ enablestop ; 

+ anz objects := 0 ; 

+ FILE VAR f := notefile ; 

+ maxlinelength (f, 1000) ; 

+ note ("Modulnummer des gewünschten Objekts merken und ESC q tippen.") ; 

+ noteline ;

+ noteline ;

+ module number := -1 ;

+ scan permanent table chain with object name ; 

+ IF anz objects > 1 

+    THEN note edit ; 

+         put ("Modulnummer der PROC/OP:") ; 

+         get (module number)  

+    ELSE type (""27"q") ; 

+         note edit

+ FI . 

+ 

+scan permanent table chain with object name : 

+ name table pointer := first link word ; 

+ WHILE NOT end of name table chain REP

+  IF cdb text (name table pointer + 2) = object 

+     THEN permanent pointer := cdb int (nametable pointer + 1) ;

+          IF NOT permanent type definition 

+             THEN run through permanent chain 

+          FI ; 

+  FI ; 

+  name table pointer := cdb int (name table pointer)   

+ PER . 

+ 

+run through permanent chain : 

+ WHILE permanent pointer <> 0 REP

+   anz objects INCR 1 ; 

+   cout (anz objects) ;

+   get specifications (permanent pointer) ; 

+   IF anz objects = 1 

+      THEN module number := module nr 

+   FI ;

+   note (text (module nr, 4)) ; 

+   note ("  ") ; 

+   note (object) ; 

+   note (" ") ;

+   note (result) ; 

+   noteline ;

+   permanent pointer := cdbint (permanent pointer)

+ PER . 

+ 

+module nr : 

+ cdb int (param link + 1) . 

+         

+first link word : 

+ cdb int (hash (object)) .

+ 

+end of name table chain : 

+ name table pointer = 0 . 

+ 

+permanent type definition : 

+ (object SUB 1) <= "Z" AND (object SUB 1) >= "A" AND 

+  cdbint (permanent pointer + 1) = permanent type 

+ 

+ENDPROC get module number ; 

+   

+

+(************************* Permanenttabellenzugriffe **********************) 

+ 

+INT PROC hash (TEXT CONST obj name) : 

+ INT VAR i, hash code ; 

+ hash code := 0 ; 

+ FOR i FROM 1 UPTO LENGTH obj name REP 

+  addmult cyclic 

+ PER ; 

+ hash code . 

+ 

+addmult cyclic : 

+ hash code INCR hash code ; 

+ IF hash code > end of hash table THEN wrap around FI ; 

+ hash code := (hash code + code (obj name SUB i)) AND end of hash table . 

+ 

+wrap around : 

+ hash code DECR end of hash table 

+

+ENDPROC hash ; 

+

+

+PROC next pt param :

+ mode := cdb int (param link) MOD ptt limit ;

+ param link INCR 1 ;

+ IF mode = permanent row 

+   THEN skip over permanent row 

+ ELIF mode = permanent struct 

+   THEN skip over permanent struct

+ FI ;

+ set end marker if end of list .

+ 

+skip over permanent row :

+ param link INCR 1 ; (* Skip row size *)

+ next pt param .

+

+skip over permanent struct :

+ mode := cdbint (param link) ; 

+ WHILE mode <> permanent struct end REP 

+   next pt param ;

+   mode := cdbint (param link) 

+ PER ;

+ param link INCR 1   (* skip permanent struct end *) 

+

+ENDPROC next pt param ;

+

+

+PROC set end marker if end of list :

+ mode := cdb int (param link) ;

+ end of params := mode >= permanent proc op OR mode <= 0 

+ 

+ENDPROC set end marker if end of list ;

+

+

+PROC get type and mode (INT VAR type) : 

+ mode := cdb int (param link) ;

+ IF mode = permanent param proc 

+    THEN type of param proc 

+    ELSE type of object

+ FI .

+

+type of param proc : 

+ param link INCR 1 ;

+ get type and mode (type) ;

+ mode := permanent param proc .

+

+type of object :

+ IF mode < 0 

+    THEN type := 2769 + (32767 + mode) ;

+         mode := 0

+    ELSE type := mode MOD ptt limit ;

+         mode DECR type ;

+         translate type if necessary ;

+         translate mode if necessary 

+ FI .

+

+translate type if necessary :

+ IF permanent row or struct THEN translate type FI .

+

+translate type :

+ type := param link - begin of pt minus ptt limit .

+

+translate mode if necessary : 

+ IF mode = permanent param const 

+    THEN mode := const

+ ELIF mode = permanent param var 

+    THEN mode := var

+ FI .

+

+permanent row or struct :

+ type = permanent row OR type = permanent struct

+

+ENDPROC get type and mode ;

+ 

+

+PROC get specifications (INT CONST permanent pointer) : 

+ result := "" ;

+ to first param ;

+ IF NOT end of params THEN put param list FI ;

+ get result . 

+ 

+to first param :

+ param link := permanent pointer + 1 ;

+ set end marker if end of list .

+ 

+get result :

+ INT VAR type;

+ get type and mode (type) ;

+ IF type <> void 

+    THEN type and mode := " --> " ;

+         name of type (type) ;

+         result CAT type and mode 

+ FI

+

+ENDPROC get specifications ;

+

+

+PROC put param list : 

+ result CAT "(" ;

+ REP

+   INT VAR type;

+   get type and mode (type) ;

+   put type and mode ;

+   maybe param proc ;

+   next pt param ;

+   IF end of params 

+      THEN result CAT ")" ;

+           LEAVE put param list 

+   FI ;

+   result CAT ", " ;

+ PER . 

+ 

+put type and mode :

+ INT CONST mode1 :: mode ;

+ type and mode := "" ;

+ name of type (type) ;

+ type and mode CAT name of mode ;

+ result CAT type and mode .

+ 

+name of mode :

+ IF   mode1 = const THEN " CONST"

+ ELIF mode1 = var   THEN " VAR"

+ ELIF type = void   THEN "PROC" 

+                    ELSE " PROC" 

+ FI .

+ 

+maybe param proc :

+ IF mode = permanent param proc THEN put virtual params FI .

+ 

+put virtual params :

+ skip over result type if complex type ;

+ IF NOT end of virtual params 

+    THEN result CAT " " ;

+         put param list 

+ FI .

+ 

+skip over result type if complex type :

+ next pt param .

+ 

+end of virtual params :

+ end of params

+

+ENDPROC put param list ;

+ 

+

+PROC name of type (INT CONST type) :

+ LET int         = 1 ,

+     real        = 2 ,

+     string      = 3 ,

+     bool        = 5 ,

+     bool result = 6 ,

+     dataspace   = 7 ; 

+ 

+ SELECT type OF

+   CASE void        :

+   CASE int         : type and mode CAT "INT"

+   CASE real        : type and mode CAT "REAL"

+   CASE string      : type and mode CAT "TEXT"

+   CASE bool,

+        bool result : type and mode CAT "BOOL"

+   CASE dataspace   : type and mode CAT "DATASPACE"

+   OTHERWISE complex type

+ ENDSELECT .

+ 

+complex type :

+ IF type > ptt limit THEN perhaps permanent struct or row

+                     ELSE get complex type

+ FI .

+ 

+perhaps permanent struct or row :

+ index := type + begin of pt minus ptt limit ;

+ mode := cdb int (index) MOD ptt limit ;

+ IF   mode = permanent row    THEN get permanent row 

+ ELIF mode = permanent struct THEN get permanent struct

+                              ELSE type and mode CAT "-"

+ FI .

+ 

+get complex type :

+ index := type + begin of permanent table ;

+ IF is complex type 

+    THEN get name

+    ELSE type and mode CAT "<HIDDEN>"

+ FI .

+ 

+is complex type :

+ permanent type definition mode = permanent type . 

+ 

+get name :

+ type and mode CAT cdb text (link to type name + 2) .

+ 

+link to type name :

+ cdb int (index + 3) .

+ 

+permanent type definition mode :

+ cdb int (index + 1) .

+

+get permanent row :

+ INT VAR t; 

+ type and mode CAT "ROW " ;

+ type and mode CAT text (cdb int (index + 1)) ;

+ type and mode CAT " " ;

+ param link := index + 2 ;

+ get type and mode (t) ;

+ name of type (t) .

+ 

+get permanent struct :

+ type and mode CAT "STRUCT (" ; 

+ param link := index + 1 ; 

+ WHILE within permanent struct REP 

+  get type and mode (t) ;

+  name of type (t) ; 

+  next pt param ; 

+  IF within permanent struct

+     THEN type and mode CAT ", " 

+  FI 

+ PER ; 

+ type and mode CAT ")" . 

+ 

+within permanent struct :

+ cdbint (param link) <> permanent struct end . 

+ 

+ENDPROC name of type ;

+ 

+ 

+ENDPACKET table routines ; 

+ 

+

+(*************************************************************************)

+ 

+PACKET eumel decoder DEFINES        (* M. Staubermann, März/April 86 *)

+                                    (* 1.8.0 861201 *) 

+                                    (* 1.8.2 880726 *)

+       lbase , 

+       pbase ,

+       set parameters , 

+       get parameters , 

+       default no runtime ,

+       bool result ,

+       line number ,

+       list file name ,

+       last actual parameter ,

+       with code words ,

+       with object address ,

+

+       next word ,

+       next module header ,

+       data representation ,

+       object representation ,

+

+       decode module ,

+       decode : 

+

+

+LET packet data segment  =      0 , 

+    local  data segment  =      1 ,

+    standard dataspace   =      0 , (* ds = 4 *)

+

+    first elan address   = 13 584 , (* codeaddress (273) *)

+    begin of stringtable =  1 024 , 

+    begin of nametable   =  4 096 , 

+    end of nametable     = 22 783 ; 

+ 

+LET try type        =  0 , {?}

+    int addr        = 10 , {I}

+    real addr       = 19 , {R}

+    text addr       = 20 , {S}

+    dataspace addr  =  5 , {D}

+    task addr       = 21 , {T}

+    ref addr        =  1 , {@}

+    mod addr        =  2 , {A}

+    bool addr       =  3 , {B}

+    int value       = 23 , {V}

+    hexbyte value   =  9 , {H}

+    module nr value = 14 ; {M}

+ 

+LET OPN       = STRUCT (TEXT mnemonic, params, BOOL bool result) , 

+    PRIMOP    = ROW  31 OPN ,

+    SPECIALOP = ROW   6 OPN , 

+    ESCOP     = ROW 130 OPN ,

+

+    rtnt opcode = 32513 , 

+    rtnf opcode = 32514 ; 

+ 

+LET hex 3fff  = 16 383 ,

+    hex 03ff  =  1 023 ,

+    hex 0400  =  1 024 , 

+    hex 7c    =    124 ,

+    hex 7f    =    127 , 

+    hex f0    =    240 ,

+    hex fd    =    253 , 

+    hex ff    =    255 ;

+ 

+INT CONST hex 83ff  :: -31745 ,

+          hex ff00  :: -256 ,

+          hex fff8  :: -8 ,

+          minus one :: -1 ;

+ 

+FILE VAR list file ; 

+TEXT VAR file name := "" , 

+         text val := "" ;

+INT VAR file number := 0 ,

+        data base , 

+        ln := minus one ,

+        lbas := minus one ,

+        cmod := minus one ;

+   

+BOOL VAR was bool result , 

+         echo ,

+         with statement line := TRUE ,

+         with object and address := TRUE ;

+ 

+ 

+INT PROC line number : 

+ ln 

+ENDPROC line number ; 

+ 

+

+TEXT PROC last actual parameter : 

+ text val 

+ENDPROC last actual parameter ; 

+ 

+

+PROC pbase (INT CONST i) : 

+ data base := i ; 

+ makeword (data base, 0)

+ENDPROC pbase ; 

+ 

+

+INT PROC pbase : 

+ INT VAR lowbyte, highbyte := data base ; 

+ split word (highbyte, lowbyte) ; 

+ highbyte

+ENDPROC pbase ; 

+ 

+

+PROC lbase (INT CONST i) : 

+ lbas := i 

+ENDPROC lbase ; 

+ 

+

+BOOL PROC bool result : 

+ was bool result 

+ENDPROC bool result ; 

+ 

+

+BOOL PROC with object address : 

+ with object and address 

+ENDPROC with object address ; 

+ 

+

+PROC with object address (BOOL CONST b) : 

+ with object and address := b 

+ENDPROC with object address ; 

+ 

+

+PROC with codewords (BOOL CONST b) : 

+ with statement line := b 

+ENDPROC with codewords ; 

+ 

+

+BOOL PROC with codewords : 

+ with statement line 

+ENDPROC with codewords ; 

+ 

+

+PROC bool result (BOOL CONST b) : 

+ was bool result := b 

+ENDPROC bool result ; 

+ 

+

+PROC list file name (TEXT CONST name) : 

+ file name := name 

+ENDPROC list file name ; 

+ 

+

+PROC set parameters (INT CONST lbase, pbas, line number, codmod) : 

+ lbas := lbase ; 

+ pbase (pbas) ;

+ ln := line number ; 

+ cmod := codmod 

+ENDPROC set parameters ; 

+ 

+

+PROC get parameters (INT VAR lbase, pbas, line number, codmod) :

+ lbase := lbas ; 

+ pbas := pbase ; 

+ line number := ln ; 

+ codmod := cmod 

+ENDPROC get parameters ; 

+ 

+

+PROC default no runtime : 

+ lbas := minus one ; 

+ ln := minus one ; 

+ database := minus one ; 

+ cmod := minus one 

+ENDPROC default no runtime ; 

+ 

+

+PRIMOP CONST primop := PRIMOP :( 

+  OPN :("LN   ", "V",   FALSE),    (* 1 *)

+  OPN :("LN1  ", "V",   FALSE),

+  OPN :("MOV  ", "II",  FALSE), 

+  OPN :("INC1 ", "I",   FALSE), 

+  OPN :("DEC1 ", "I",   FALSE), 

+  OPN :("INC  ", "II",  FALSE), 

+  OPN :("DEC  ", "II",  FALSE), 

+  OPN :("ADD  ", "III", FALSE), 

+  OPN :("SUB  ", "III", FALSE), 

+  OPN :("CLEAR", "I",   FALSE),     (* 10 *)

+  OPN :("TEST ", "I",   TRUE), 

+  OPN :("EQU  ", "II",  TRUE), 

+  OPN :("LSEQ ", "II",  TRUE), 

+  OPN :("FMOV ", "RR",  FALSE), 

+  OPN :("FADD ", "RRR", FALSE), 

+  OPN :("FSUB ", "RRR", FALSE), 

+  OPN :("FMUL ", "RRR", FALSE), 

+  OPN :("FDIV ", "RRR", FALSE), 

+  OPN :("FLSEQ", "RR",  TRUE), 

+  OPN :("TMOV ", "SS",  FALSE), 

+  OPN :("TEQU ", "SS",  TRUE), 

+  OPN :("ULSEQ", "II",  TRUE), 

+  OPN :("DSACC", "D?",  FALSE), 

+  OPN :("REF  ", "?@",  FALSE), 

+  OPN :("SUBS ", "VVI?@", FALSE),  (* 25 *)

+  OPN :("SEL  ", "?V@", FALSE),    (* 26 *)

+  OPN :("PPV  ", "?",   FALSE), 

+  OPN :("PP   ", "?",   FALSE), 

+  OPN :("B    ", "V",   FALSE), 

+  OPN :("B1   ", "V",   FALSE), 

+  OPN :("CALL ", "M",   FALSE)) ;

+ 

+SPECIALOP CONST special op := SPECIALOP :( 

+  OPN :("EQUIM  ", "HI",   TRUE),

+  OPN :("MOVi   ", "HI",   FALSE),

+  OPN :("MOVx   ", "HII",  FALSE), 

+  OPN :("PUTW   ", "HII",  FALSE),

+  OPN :("GETW   ", "HII",  FALSE), 

+  OPN :("PENTER ", "H",    FALSE)) ; (* 7F = ESC, FF = LONGA *)

+ 

+ESCOP CONST esc op := ESCOP :( 

+  OPN :("RTN    ", "",      FALSE),   (* 0 *)

+  OPN :("RTNT   ", "",      FALSE), 

+  OPN :("RTNF   ", "",      FALSE), 

+  OPN :("???????", "",      FALSE),   (* was repair text 1.7.1 *)

+  OPN :("STOP   ", "",      FALSE),   (* TERM *)

+  OPN :("GOSUB  ", "V",     FALSE),   (* 1 ist Branch Address *) 

+  OPN :("KE     ", "",      FALSE), 

+  OPN :("GORET  ", "",      FALSE),

+  OPN :("BCRD   ", "II",    FALSE),   (* begin char read (pointer, length) *) 

+  OPN :("CRD    ", "II",    FALSE),   (* char read (char, pointer) *)

+  OPN :("ECWR   ", "III",   FALSE),   (* end char write (pointer, length, next entry) *) 

+  OPN :("CWR    ", "III",   FALSE),   (* char write (hash code, pointer, char) *) 

+  OPN :("CTT    ", "?S",    FALSE),   (* REF d2:=REF compiler table text <d1>) *)

+  OPN :("GETC   ", "SII",   TRUE),    (* INT <d3> := code (TEXT <d1> SUB INT<d2>), TRUE wenn INT<ds> <= length (TEXT) *) 

+  OPN :("FNONBL ", "ISI",   TRUE),    (* find non blank (char, line, pointer) *) 

+  OPN :("DREM256", "II",    FALSE),   (* <d2> := <d1> MOD 256, <d1> := <d1> DIV 256 *) 

+  OPN :("AMUL256", "II",    FALSE),   (* <d1> := <d1> * 256 + <d2> *) 

+  OPN :("???????", "",      FALSE), 

+  OPN :("ISDIG  ", "I",     TRUE), 

+  OPN :("ISLD   ", "I",     TRUE), 

+  OPN :("ISLCAS ", "I",     TRUE), 

+  OPN :("ISUCAS ", "I",     TRUE), 

+  OPN :("GADDR  ", "III",   FALSE),   (* IF <d2> >= 0 (Global) THEN <d3> := <d2> - <d1> (<d1>=pbase) ELIF bit (<d2>, 14) (Local Ref) THEN <d3> := (<d2> AND $3FFF)*2 + 1 ELSE (Local) <d3> := (<d2> AND $3FFF)*2 FI *)

+  OPN :("GCADDR ", "III",   TRUE), 

+  OPN :("ISSHA  ", "I",     TRUE), 

+  OPN :("SYSG   ", "",      FALSE),   (* 25 *)

+  OPN :("GETTAB ", "",      FALSE), 

+  OPN :("PUTTAB ", "",      FALSE), 

+  OPN :("ERTAB  ", "",      FALSE), 

+  OPN :("EXEC   ", "M",     FALSE),

+  OPN :("PPROC  ", "M",     FALSE),

+  OPN :("PCALL  ", "A",     FALSE),   (* : icount Segment/Address *) 

+  OPN :("BRCOMP ", "IV",    FALSE),

+  OPN :("MOVxx  ", "V??",   FALSE), 

+  OPN :("ALIAS  ", "VDD",   FALSE), 

+  OPN :("MOVii  ", "VI",    FALSE), 

+  OPN :("FEQU   ", "RR",    TRUE), 

+  OPN :("TLSEQ  ", "SS",    TRUE), 

+  OPN :("FNEG   ", "RR",    FALSE), 

+  OPN :("NEG    ", "II",    FALSE),

+  OPN :("IMULT  ", "III",   FALSE), 

+  OPN :("MUL    ", "III",   FALSE), 

+  OPN :("DIV    ", "III",   FALSE), 

+  OPN :("MOD    ", "III",   FALSE), 

+  OPN :("ITSUB  ", "SII",   FALSE), 

+  OPN :("ITRPL  ", "SII",   FALSE), 

+  OPN :("DECOD  ", "SI",    FALSE), 

+  OPN :("ENCOD  ", "IS",    FALSE), 

+  OPN :("SUBT1  ", "SIS",   FALSE), 

+  OPN :("SUBTFT ", "SIIS",  FALSE), 

+  OPN :("SUBTF  ", "SIS",   FALSE), 

+  OPN :("REPLAC ", "SIS",   FALSE), 

+  OPN :("CAT    ", "SS",    FALSE), 

+  OPN :("TLEN   ", "SI",    FALSE), 

+  OPN :("POS    ", "SSI",   FALSE), 

+  OPN :("POSF   ", "SSII",  FALSE),

+  OPN :("POSFT  ", "SSIII", FALSE), 

+  OPN :("STRANL ", "IIISIII", FALSE), 

+  OPN :("POSIF  ", "SSSII", FALSE), 

+  OPN :("???????", "",      FALSE), 

+  OPN :("OUT    ", "S",     FALSE),   (* 60 *)

+  OPN :("COUT   ", "I",     FALSE), 

+  OPN :("OUTF   ", "SI",    FALSE), 

+  OPN :("OUTFT  ", "SII",   FALSE), 

+  OPN :("INCHAR ", "S",     FALSE), 

+  OPN :("INCETY ", "S",     FALSE), 

+  OPN :("PAUSE  ", "I",     FALSE), 

+  OPN :("GCPOS  ", "II",    FALSE), 

+  OPN :("CATINP ", "SS",    FALSE), 

+  OPN :("NILDS  ", "D",     FALSE), 

+  OPN :("DSCOPY ", "DD",    FALSE), 

+  OPN :("DSFORG ", "D",     FALSE), 

+  OPN :("DSWTYP ", "DI",    FALSE), 

+  OPN :("DSRTYP ", "DI",    FALSE), 

+  OPN :("DSHEAP ", "DI",    FALSE), 

+  OPN :("ESTOP  ", "",      FALSE), 

+  OPN :("DSTOP  ", "",      FALSE), 

+  OPN :("SETERR ", "I",     FALSE), 

+  OPN :("ISERR  ", "",      TRUE), 

+  OPN :("CLRERR ", "",      FALSE), 

+  OPN :("RPCB   ", "II",    FALSE), 

+  OPN :("INFOPW ", "SSI",   FALSE),  (* War vorher Writepcb *)

+  OPN :("TWCPU  ", "TR",    FALSE), 

+  OPN :("ROTATE ", "II",    FALSE), 

+  OPN :("CONTRL ", "IIII",  FALSE), 

+  OPN :("BLKOUT ", "DIIII", FALSE), 

+  OPN :("BLKIN  ", "DIIII", FALSE), 

+  OPN :("NXTDSP ", "DII",   FALSE), 

+  OPN :("DSPAGS ", "ITI",   FALSE), 

+  OPN :("STORAGE", "II",    FALSE), 

+  OPN :("SYSOP  ", "I",     FALSE),   (* 90 *)

+  OPN :("ARITHS ", "",      FALSE), 

+  OPN :("ARITHU ", "",      FALSE), 

+  OPN :("HPSIZE ", "I",     FALSE), 

+  OPN :("GARB   ", "",      FALSE), 

+  OPN :("TPBEGIN", "TTIA",  FALSE),   (* 1.8.0: privileged begin *)

+  OPN :("FSLD   ", "IRI",   FALSE), 

+  OPN :("GEXP   ", "RI",    FALSE), 

+  OPN :("SEXP   ", "IR",    FALSE), 

+  OPN :("FLOOR  ", "RR",    FALSE), 

+  OPN :("RTSUB  ", "SIR",   FALSE), 

+  OPN :("RTRPL  ", "SIR",   FALSE), 

+  OPN :("CLOCK  ", "IR",    FALSE), 

+  OPN :("SETNOW ", "R",     FALSE), 

+  OPN :("TRPCB  ", "TII",   FALSE), 

+  OPN :("TWPCB  ", "TII",   FALSE),   (* 105 *)

+  OPN :("TCPU   ", "TR",    FALSE), 

+  OPN :("TSTAT  ", "TI",    FALSE), 

+  OPN :("ACT    ", "T",     FALSE), 

+  OPN :("DEACT  ", "T",     FALSE), 

+  OPN :("THALT  ", "T",     FALSE), 

+  OPN :("TBEGIN ", "TA",    FALSE),   (* seg/addr icount *)

+  OPN :("TEND   ", "T",     FALSE), 

+  OPN :("SEND   ", "TIDI",  FALSE), 

+  OPN :("WAIT   ", "TID",   FALSE), 

+  OPN :("SWCALL ", "TIDI",  FALSE), 

+  OPN :("CDBINT ", "II",    FALSE),   (* 116 *)

+  OPN :("CDBTXT ", "IS",    FALSE),   (* 117 *)

+  OPN :("PNACT  ", "I",     FALSE), 

+  OPN :("PW     ", "III",   FALSE), 

+  OPN :("GW     ", "III",   FALSE), 

+  OPN :("XOR    ", "III",   FALSE), 

+  OPN :("PPCALL ", "TIDI",  FALSE),   (* pingpong call *) 

+  OPN :("EXTASK ", "T",     TRUE), 

+  OPN :("AND    ", "III",   FALSE), 

+  OPN :("OR     ", "III",   FALSE), 

+  OPN :("SESSION", "I",     FALSE), 

+  OPN :("SENDFT ", "TTIDI", FALSE), 

+  OPN :("DEFCOL ", "T",     FALSE), 

+  OPN :("ID     ", "II",    FALSE)) ; (* 129 *)

+

+

+PROC decode : 

+ INT VAR mod nr ; 

+ get module number (mod nr) ; 

+ IF mod nr >= minus one 

+    THEN decode (mod nr) 

+ FI

+ENDPROC decode ; 

+ 

+

+PROC decode module : 

+ INT VAR mod nr ; 

+ get module number (mod nr) ; 

+ IF mod nr >= minus one 

+    THEN decode module (mod nr) 

+ FI

+ENDPROC decode module ; 

+ 

+

+PROC decode module (INT CONST mod nr) :

+ INT VAR address :: code address (mod nr) ;

+ default no runtime ; 

+ decode (code segment (mod nr), address, minus one, TRUE) 

+ENDPROC decode module ; 

+ 

+

+PROC decode (INT CONST mod nr) : 

+ INT VAR address :: code address (mod nr) ;

+ default no runtime ;

+ decode (code segment (mod nr), address, minus one, FALSE) 

+ENDPROC decode ; 

+ 

+

+PROC decode (INT CONST seg, from) : 

+ INT VAR address := from ; 

+ default no runtime ;

+ decode (seg, address, minus one, FALSE) 

+ENDPROC decode ; 

+ 

+

+PROC decode (INT CONST seg, INT VAR addr, INT CONST to addr, 

+             BOOL CONST only one module) : 

+

+ TEXT VAR taste, opcode, codewords, hex addr ; 

+ BOOL VAR addr out := TRUE , 

+          output permitted := TRUE ;

+ INT VAR size, used, mod nr, header address, start address := addr ; 

+

+ add modules ;

+ storage (size, used) ;

+ echo := TRUE ; 

+ file number := 0 ;

+ cmod := minus one ; 

+ init list file ; 

+ next module header (seg, addr, header address, mod nr) ; 

+ was bool result := FALSE ; 

+

+ WHILE ulseq (addr, to addr) REP 

+  protocoll ; 

+  taste := incharety ; 

+  decode one statement ;

+  analyze key ; 

+  IF (addr AND 31) = 0 

+   THEN storage (size, used) ; 

+  FI ; 

+ UNTIL taste = ""27"" OR used > size PER ; 

+

+ IF used > size 

+    THEN list line ("Abbruch wegen Speicherengpass!") 

+ FI .

+ 

+protocoll : 

+  IF output permitted AND NOT echo (* Falls Decoder im Hintergrund laufen soll *) 

+     THEN IF addr out 

+             THEN out (" ") ; 

+                  out (hex16 (addr)) ; 

+                  out (" "8""8""8""8""8""8"") ; 

+             ELSE cout (ln) 

+          FI 

+  FI . 

+  

+analyze key : 

+  SELECT code (taste) OF 

+{l}  CASE 108 : addr out := FALSE  (* Zeilennummern ausgeben *)

+{d}  CASE 100 : get command ("Gib Kommando:") ; do command 

+{f}  CASE 102 : show filename and fileline 

+{a}  CASE 97  : addr out := TRUE  (* Hexaddressen ausgeben *)

+{e}  CASE 101 : echo := NOT echo  (* Bildschirmausgabe zus. *)

+{s}  CASE 115 : storage (size,used) ; out(""13""5"System-Storage: " + text (used) + "  ") 

+{m}  CASE 109 : out (""13""5"Modulnr: " + text (mod nr-1) + "  ") 

+{Q,W}CASE 87,81:output permitted := TRUE (* Läuft nur im Vordergrund *) 

+{S}  CASE 83  : output permitted := FALSE (* Läuft auch im Hintergrund *) 

+{ESC}CASE 27  : IF incharety <> "" 

+                   THEN taste := "" 

+                   ELSE list line ("Abbruch mit ESC") 

+                FI

+                (* Wegen Steuertasten, wie ESC P *)

+ ENDSELECT . 

+ 

+show filename and fileline : 

+ out (""13""5"Filename: " + filename + "." + text (filenumber) + 

+      "  Fileline: " + text (lines (list file)) + "  ") . 

+ 

+decode one statement : 

+ check if module head ; 

+ hex addr  := hex16 (addr) ;

+ codewords := "" ; 

+ opcode    := "" ; 

+ decode (seg, addr, codewords, opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+ hex addr CAT " " ; 

+ hex addr CAT opcode ; 

+ IF with statement line 

+    THEN hex addr CAT " " ;

+         WHILE LENGTH hex addr < 80 REP 

+          hex addr CAT " " 

+         PER ; 

+         hex addr CAT codewords ; 

+ FI ;

+ list line (hex addr) . 

+ 

+check if module head : 

+ IF addr = header address 

+    THEN IF only one module AND addr <> start address 

+            THEN LEAVE decode

+         FI ;

+         list line (" ") ; 

+         list line ("Module " + process module nr (mod nr)) ; 

+         list line (" ") ;

+         IF output permitted AND NOT echo

+            THEN put ("Module:") ; 

+                 cout (mod nr) ; 

+                 8 TIMESOUT ""8""

+         FI ;

+         calculate c8k ;

+         codewords := "" ;

+         hex addr := hex16 (addr) ;

+         hex addr CAT " HEAD        " ; 

+         hex addr CAT text (next word (seg, addr, codewords)) ; 

+         IF with statement line 

+            THEN hex addr CAT " " ; 

+                 WHILE LENGTH hex addr < 80 REP

+                  hex addr CAT " " 

+                 PER ;

+                 hex addr CAT code words ; 

+         FI ;

+         list line (hex addr) ; 

+         next module header (seg, addr, header address, mod nr) ; 

+ FI . 

+ 

+calculate c8k : 

+ INT VAR dummy ;

+ cmod := addr ; 

+ splitword (cmod, dummy) ; 

+ cmod INCR 16 ; 

+ cmod := cmod AND 255 .

+         

+ENDPROC decode ; 

+ 

+

+PROC init list file : 

+ forget (filename + "." + text (filenumber), quiet) ; 

+ list file := sequentialfile (output, filename + "." + text (filenumber)) ; 

+ maxlinelength (list file, 2000) ;

+ list line ("Addr Opcode       Parameter") ; 

+ENDPROC init list file ; 

+ 

+

+PROC list line (TEXT CONST zeile) : 

+ IF lines (list file) > 4000 

+  THEN file number INCR 1 ; 

+       init list file 

+ FI ; 

+ putline (list file, zeile) ; 

+ IF echo THEN outsubtext (zeile, 1, 79) ; line FI 

+ENDPROC list line ; 

+

+

+PROC decode (INT CONST segment, INT VAR address, TEXT VAR words, instruction,

+             INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : 

+ 

+ INT VAR opcode, word, lowbyte, highbyte, 

+         opcode address := address ;

+ BOOL VAR shorta opcode ;

+

+ ln := minus one ; (* Wenn kein LN Befehl vorkam -1 *)

+

+ word := next word (segment, address, words) ;

+ highbyte := word ;

+ split word (highbyte, lowbyte) ; 

+ opcode := highbyte AND hex 7c ;

+ shorta opcode := TRUE ;

+

+ IF opcode = hex 7c AND highbyte <> hex ff

+    THEN esc or special instruction (* Kann kein LONGA sein *) 

+    ELSE IF highbyte = hex ff 

+            THEN longa instruction 

+            ELSE word := word AND hex 83ff

+         FI ; 

+         primaer instruction

+ FI . 

+ 

+esc or special instruction : 

+ IF highbyte = hex 7f 

+    THEN esc instruction

+    ELSE special instruction 

+ FI . 

+ 

+longa instruction : 

+ IF lowbyte = hex ff 

+    THEN instruction CAT "-" ; 

+         LEAVE decode 

+ ELIF lowbyte = hex fd 

+    THEN instruction CAT "Block unlesbar" ; 

+         LEAVE decode 

+ ELSE instruction CAT "LONGA " ; 

+      shorta opcode := FALSE ;

+      opcode := lowbyte ; 

+      word := next word (segment, address, words) ;

+      highbyte := word ; 

+      splitword (highbyte, lowbyte) 

+ FI . 

+ 

+special instruction : 

+ opcode := (highbyte AND 3) * 2 + 1 ; 

+ IF highbyte > hex 7f 

+    THEN opcode INCR 1 

+ FI ; 

+ word := word AND hex ff ;

+ instruction CAT special op (opcode).mnemonic ; 

+ instruction CAT "     " ; (* ESC Ausgleich *)

+ instruction CAT params0 (special op (opcode).params, word, segment, address, 

+             words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+ was bool result := special op (opcode).bool result ; 

+ IF opcode = 6 (* PENTER *) 

+    THEN database := lowbyte ; 

+         makeword (database, 0) ; 

+ FI . 

+ 

+esc instruction : 

+ opcode := lowbyte + 1 ; 

+ IF opcode < 1 OR opcode > 131 

+    THEN instruction CAT "???????" 

+    ELSE instruction CAT "ESC " ; 

+         instruction CAT esc op (opcode).mnemonic ; 

+         instruction CAT " " ;

+         instruction CAT params (esc op (opcode).params, segment, address, 

+                     words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+         was bool result := esc op (opcode).bool result  

+ FI . 

+ 

+primaer instruction : 

+ rotate (opcode, -2) ; 

+ SELECT opcode OF 

+  CASE 0, 1   : process ln 

+  CASE 28, 29 : process br 

+  CASE 30 : process call

+  OTHERWISE 

+   opcode INCR 1 ; 

+   instruction CAT prim op (opcode).mnemonic ; 

+   IF shorta opcode 

+      THEN instruction CAT "       " 

+      ELSE instruction CAT " "

+   FI ;

+   instruction CAT params0 (prim op (opcode).params, word, segment, address, words,

+               INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+   IF opcode = 25 (* SUBS *) 

+      THEN instruction CAT "(ESiz,Lim-1,Idx,Base,Ref) " 

+   ELIF opcode = 26 (* SEL *) 

+      THEN instruction CAT "(Base,Offs,Ref) " 

+   FI ;

+   was bool result := prim op (opcode).bool result ; 

+ ENDSELECT . 

+ 

+process call : 

+ opcode INCR 1 ; 

+ word := word AND hex 03ff ;

+ IF highbyte > hex 7f 

+    THEN word INCR hex 0400 

+ FI ;

+ instruction CAT prim op (opcode).mnemonic ; 

+ IF shorta opcode

+    THEN instruction CAT "       " 

+    ELSE instruction CAT " "

+ FI ;

+ was bool result := FALSE ; (* Wird von params0 ggf überschrieben *) 

+ instruction CAT params0 (prim op (opcode).params, word, segment, address, words,

+             INT PROC (INT CONST, INT VAR, TEXT VAR) next word) . 

+ 

+process ln : 

+ IF shorta opcode 

+    THEN word := short address (lowbyte, highbyte, opcode = 1) 

+ FI ;

+ IF was bool result 

+    THEN instruction CAT "BT   " ; 

+         IF shorta opcode

+            THEN instruction CAT "       " 

+         FI ; 

+         instruction CAT hex16 (branch address)

+    ELSE IF segment = 2 

+            THEN instruction CAT "HEAD "

+            ELSE ln := word ; 

+                 instruction CAT "LN   " 

+         FI ;

+         IF shorta opcode 

+            THEN instruction CAT "       " 

+         FI ; 

+         instruction CAT text (word) 

+ FI ;

+ was bool result := FALSE .

+ 

+process br : 

+  word := short address (lowbyte, highbyte, opcode = 29) ;

+  IF was bool result

+     THEN instruction CAT "BF   " ; 

+     ELSE instruction CAT "B    " ; 

+  FI ;    

+  IF shorta opcode 

+     THEN instruction CAT "       " 

+  FI ; 

+  instruction CAT hex16 (branch address) ;

+  was bool result := FALSE .

+ 

+branch address : 

+ INT VAR high address byte := opcode address ; 

+ split word (high address byte, lowbyte) ;

+ highbyte := word ;

+ split word (highbyte, lowbyte) ;

+ high address byte INCR highbyte ; 

+ IF cmod <> minus one AND high address byte >= cmod 

+    THEN high address byte DECR 16 (* cms = 16 *) 

+ FI ; 

+ make word (high address byte, lowbyte) ; 

+ high address byte . 

+ 

+ENDPROC decode ; 

+ 

+

+INT PROC short address (INT CONST lowbyte, highbyte, BOOL CONST bit12) : 

+ (* Bit 7 des Highbytes in Bit 0 rotieren *) 

+ INT VAR effective address := (highbyte * 2) AND 6 ; 

+ IF highbyte > hex 7f         

+    THEN effective address INCR 1 

+ FI ; 

+ make word (effective address, lowbyte) ; (* high and result, low *)

+ IF bit12 

+    THEN effective address INCR 2048 

+ FI ; 

+ effective address

+

+ENDPROC short address ; 

+ 

+

+INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) : 

+ INT CONST word :: get word (segment, address) ; 

+ INC address ; 

+ words CAT hex16 (word) ; 

+ words CAT " " ; 

+ word

+

+ENDPROC next word ; 

+ 

+

+PROC next module header (INT CONST segment, address, 

+                         INT VAR header address, module number) : 

+ INT VAR first, last, mid ; 

+ IF segment = 2 

+    THEN first := 0 ; 

+         last := 1275 

+    ELSE first := 1282 ; (* 1280/1281 MAIN doagain & runagain modaddr *)

+         last := 2047 

+ FI ; 

+ REP 

+  mid := (first + last) DIV 2 ; 

+  IF ulseq (address, getword (0, 512 + mid)) 

+     THEN last := mid

+     ELSE first := mid + 1

+  FI 

+ UNTIL first = last PER ; 

+ header address := getword (0, 512 + first) ; 

+ module number := first

+

+ENDPROC next module header ; 

+ 

+

+TEXT PROC params (TEXT CONST types, INT CONST segment, INT VAR address, 

+                  TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : 

+ 

+ INT VAR i, param addr, type ; 

+ TEXT VAR result ; 

+ 

+ IF types = "" 

+    THEN LEAVE params WITH ""

+ FI ;

+ result := "" ;

+ FOR i FROM 1 UPTO LENGTH types REP 

+   param addr := next word (segment, address, words) ; 

+   type := code (types SUB i)-63 ;

+   result CAT data representation (param addr, segment, address, type) ; 

+   IF i <> LENGTH types 

+      THEN result CAT ", " 

+   FI ;

+ PER ; 

+ result 

+

+ENDPROC params ; 

+ 

+

+TEXT PROC params0 (TEXT CONST types, INT CONST word, segment, INT VAR address, 

+                   TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : 

+ 

+ INT VAR i, param addr, type ; 

+ TEXT VAR result ; 

+ 

+ IF types = "" 

+    THEN LEAVE params0 WITH ""

+ FI ;

+ result := "" ;

+ param addr := word ; 

+ FOR i FROM 1 UPTO LENGTH types REP 

+   type := code (types SUB i)-63 ;

+   result CAT data representation (param addr, segment, address, type) ; 

+   IF i <> LENGTH types 

+      THEN result CAT ", " ; 

+           param addr := next word (segment, address, words)

+   FI 

+ PER ; 

+ result 

+

+ENDPROC params0 ; 

+ 

+

+TEXT PROC data representation (INT CONST data addr, segment, address, type) : 

+ INT VAR stack offset, ds segment, ds number, ds address ; 

+ TEXT VAR result ;

+ IF is data address

+    THEN IF local data address 

+            THEN stack offset := data addr ;

+                 rotate (stack offset, minus one) ;

+                 stack offset := stack offset AND hex 3fff ; 

+                 IF local reference address OR type = ref addr

+                    THEN get referenced representation

+                    ELSE get representation from stack 

+                 FI 

+            ELSE get representation from packet data

+         FI

+    ELSE object representation (minus one, data addr, segment, address, type)

+ FI . 

+ 

+is data address : 

+ NOT (type = 23 OR type = 9 OR type = 14) .

+ 

+local data address : 

+ data addr < 0 . 

+ 

+local reference address : 

+ (data addr AND 1) = 1 . 

+ 

+is runtime : 

+ lbas <> minus one . 

+ 

+get representation from packet data : 

+ IF with object and address 

+    THEN result := "<G " + hex16 (data addr) + "H>"  

+    ELSE result := ""

+ FI ; 

+ result CAT object representation (packet data segment, data addr ADD data base, 

+                                   segment, address, type) ; 

+ result . 

+ 

+get representation from stack : 

+ result := "<L " + text (stack offset) + ">" ;

+ IF is runtime 

+    THEN IF NOT with object and address 

+            THEN result := "" 

+         FI ;

+         result CAT object representation (local data segment, 

+                    lbas ADD stack offset, segment, address, type) 

+ FI ; 

+ result . 

+ 

+get referenced representation : 

+ IF is runtime 

+    THEN ds address := getword (local data segment, lbas ADD stack offset) ; 

+         ds number  := getword (local data segment, lbas ADD stack offset ADD 1) ; 

+         split word (ds number, ds segment) ; 

+         IF ds number = standard dataspace 

+            THEN IF with object and address 

+                    THEN result := "<LR " + text (stack offset) ; 

+                         result CAT " @" + text (ds segment AND 7) ; 

+                         result CAT hex16 (ds address) + "H>" 

+                    ELSE result := "" 

+                 FI ; 

+                 IF ds segment <= local data segment

+                    THEN result CAT object representation (ds segment, 

+                                    ds address, segment, address, type) 

+                 

+                 ELIF ds segment > 3 (* Illegal! *)

+                    THEN result := "<LR " + text (stack offset) ; 

+                         result CAT " @" + text (ds segment AND 7) ; 

+                         result CAT "!!!" ;

+                         result CAT hex16 (ds address) + "H>" 

+                    ELSE (* PROC-Addresse *)

+                         result CAT object representation (ds segment, 

+                                    ds address, segment, address, mod addr)

+                 FI ; 

+                 result

+            ELSE "<LR " + text (stack offset) + 

+                 " DS:" + hex8 (ds number) + " @" + 

+                 text (ds segment AND 7) + hex16 (ds address) + "H>"

+         FI

+    ELSE "<LR " + text (stack offset) + ">"

+ FI . 

+ 

+ENDPROC data representation ; 

+ 

+

+INT VAR anzahl zeros, anzahl steuerzeichen ; 

+

+TEXT PROC object representation (INT CONST data segment, data address, 

+                                           segment, address, type) : 

+ TEXT VAR t, result ; 

+ INT VAR i, zeichen, highbyte, lowbyte, first word ;

+ SELECT type OF 

+  CASE try type,refaddr: try representation 

+  CASE int addr        : int representation 

+  CASE real addr       : real representation

+  CASE text addr       : text representation 

+  CASE dataspace addr  : dataspace representation

+  CASE task addr       : task representation 

+  CASE mod addr        : module address representation 

+  CASE bool addr       : bool representation

+  CASE int value       : integer value

+  CASE hexbyte value   : integer hexbyte

+  CASE module nr value : module nr representation

+  OTHERWISE "unbek. Typ: " + code (type + 63)

+ ENDSELECT . 

+ 

+module nr representation : 

+ text val := text (data address) ;

+ process module nr (data address) . 

+

+bool representation : 

+ IF getword (data segment, data address) = 0 

+    THEN text val := "TRUE" 

+    ELSE text val := "FALSE" 

+ FI ; 

+ text val . 

+ 

+reference address : 

+ highbyte := getword (data segment, data address ADD 1) ; 

+ splitword (highbyte, lowbyte) ; 

+ result := "@" + hex8 (highbyte) + "-" + hex8 (lowbyte) ; 

+ result CAT hex16 (getword (data segment, data address)) ; 

+ text val := result ; 

+ result . 

+ 

+int representation : 

+ i := get word (data segment, data address) ; 

+ text val := text (i) ;

+ result := text (i) ; 

+ IF i < 0 

+    THEN result CAT "|" ; 

+         result CAT hex16 (i) ; 

+         result CAT "H"

+ ELIF i >= 256 

+    THEN result CAT "|" ; 

+         result CAT hex16 (i) ;

+         result CAT "H" ;

+ FI ;

+ result . 

+

+integer value : 

+ text val := text (data address) ;

+ text (data address) . 

+ 

+integer hexbyte : 

+ text val := text (data address) ;

+ IF (data address AND hex ff00) = 0 

+    THEN hex8 (data address) + "H"  

+    ELSE hex16 (data address) + "H" 

+ FI . 

+ 

+real representation :

+ result := "12345678" ; 

+ FOR i FROM 0 UPTO 3 REP 

+  replace (result, i + 1, get word (data segment, data address ADD i)) 

+ PER ; 

+ disablestop ; 

+ result := compress (text (result RSUB 1, 20)) ;

+ IF iserror 

+    THEN clear error ;

+         result := "undefined REAL"

+ FI ; 

+ text val := result ; 

+ result . 

+ 

+text representation : 

+ t := copied text var (data segment, data address) ; 

+ result := """" ; 

+ anzahl steuerzeichen := 0 ; 

+ anzahl zeros := 0 ; 

+ FOR i FROM 1 UPTO length (t) REP 

+  zeichen := code (t SUB i) ; 

+  IF zeichen = 34 THEN result CAT """""" 

+  ELIF zeichen = 251 OR zeichen > 31 AND zeichen < 127 OR 

+       zeichen > 213 AND zeichen < 224 THEN result CAT code (zeichen) 

+  ELSE result CAT """" ; 

+       result CAT text (zeichen) ; 

+       result CAT """" ; 

+       anzahl steuerzeichen INCR 1 ; 

+       IF zeichen = 0 

+          THEN anzahl zeros INCR 1 

+       FI 

+  FI 

+ PER ; 

+ result CAT """" ; 

+ text val := result ;

+ result . 

+ 

+task representation : 

+ INT CONST index   := get word (data segment, data address) , 

+           version := get word (data segment, data address ADD 1) ; 

+ IF index < 256 

+    THEN result := hex8 (index)  

+    ELSE result := hex16 (index) ; 

+         insertchar (result, "-", 3) 

+ FI ;

+ result CAT "-" ; 

+ result CAT hex16 (version) ; 

+ result CAT "/" ; 

+ result CAT taskname (index, version) ; 

+ text val := result ;

+ result . 

+ 

+dataspace representation : 

+ highbyte := get word (data segment, data address) ; 

+ splitword (highbyte, lowbyte) ; 

+ result := hex8 (highbyte) ; 

+ result CAT "-" ; 

+ result CAT hex8 (lowbyte) ; 

+ IF (highbyte AND lowbyte) = 255

+    THEN result CAT ":not init"

+ ELIF (highbyte OR lowbyte) = 0 

+    THEN result CAT ":nilspace" 

+ FI ; 

+ text val := result ;

+ result . 

+ 

+module address representation : 

+ (* Hier: lowbyte = mod nr, highbyte = mod addr *)

+ next module header (data segment, data address, highbyte, lowbyte) ; 

+ IF highbyte <> data address 

+    THEN linear search (* Adresse muß doch zu finden sein *)

+ FI ;

+ text val := text (lowbyte) ;

+ process module nr (lowbyte) .

+ 

+linear search : 

+ IF data segment = 2

+    THEN FOR i FROM 512 UPTO 767 REP 

+          IF getword (packet data segment, i) = data address

+             THEN lowbyte := i-512 ; 

+                  LEAVE linear search 

+          FI 

+         PER

+    ELSE FOR i FROM 1792 UPTO 3839 REP

+          IF getword (packet data segment, i) = data address

+             THEN lowbyte := i-512 ; 

+                  LEAVE linear search 

+          FI 

+         PER 

+ FI ; (* Moduleaddress nicht gefunden, da stimmt doch was nicht! *)

+ LEAVE module address representation WITH reference address . 

+ 

+try representation : 

+ first word := getword (data segment, data address) ; 

+ result := text (first word) ;

+ IF first word < 0 OR first word >= 256 

+    THEN result CAT "|" ; 

+         result CAT hex16 (first word) ; 

+         result CAT "H"

+ FI ;

+ IF first word = 0 

+    THEN result CAT "|TRUE"

+ ELIF first word = 1 

+    THEN result CAT "|FALSE" 

+ FI ; 

+ IF vorzeichen ok AND nur digits (* real *) 

+    THEN result CAT "|" ; 

+         disablestop ; 

+         TEXT CONST txt :: compress (text (t RSUB 1, 20)) ; 

+         IF is error 

+            THEN clear error  

+            ELSE result CAT txt 

+         FI ; 

+ FI ; 

+ IF within compiler

+    THEN IF first word >= begin of stringtable CAND first word <= end of nametable 

+            THEN string pointer (* first word wird ggf veraendert! *)

+         ELIF first word > 9 AND first word < 32 

+            THEN result CAT "|""""" + text (first word) + """""" (* Char *)

+         ELIF first word = 34 

+            THEN result CAT "|"""""

+         ELIF first word >= 32 AND first word < 127 

+            THEN result CAT "|""" + code (first word) + """" (* Code-Char *)

+         FI ; 

+ ELIF text sinnvoll 

+    THEN result CAT "|" ; 

+         result CAT t  

+ FI ; 

+ text val := result ;

+ result . 

+ 

+text sinnvoll : 

+ keine steuerzeichen AND

+ (getword (data segment, data address ADD 1) AND 255) < 80 . 

+ 

+within compiler : 

+ segment = 2 AND ulseq (address, first elan address-1) . 

+ 

+string pointer : 

+ IF first word >= begin of name table 

+    THEN first word INCR 2 

+ FI ; 

+ IF (cdbint (first word) AND 255) < 100 

+    THEN t := cdbtext (first word) ; 

+         IF pos (t,   ""0"",  ""31"", 1) = 0 CAND 

+            pos (t, ""127"", ""213"", 1) = 0 CAND 

+            pos (t, ""220"", ""255"", 1) = 0

+            THEN result CAT "|""" ; 

+                 result CAT t ; 

+                 result CAT """" 

+         FI 

+ FI . 

+ 

+keine steuerzeichen : 

+ t := object representation (data segment, data address, 

+                             segment, address, text addr) ;

+ anzahl steuerzeichen < 4 AND anzahl zeros < 2 AND 

+ getword (data segment, data address ADD 1) <> minus one . 

+ 

+vorzeichen ok : 

+ (first word AND hex f0) = 0 OR (first word AND hex f0) = 128 . 

+ 

+nur digits : 

+ t := "12345678" ; 

+ FOR i FROM 0 UPTO 3 REP 

+  replace (t, i + 1, get word (data segment, data address ADD i)) 

+ PER ; 

+ IF (first word AND 15) > 9 THEN FALSE 

+ ELSE FOR i FROM 2 UPTO 7 REP 

+       lowbyte := code (t SUB i) ; 

+       IF (lowbyte AND hex f0) > 249 OR (lowbyte AND 15) > 9 

+          THEN LEAVE nur digits WITH FALSE 

+       FI 

+      PER ; 

+      TRUE 

+ FI . 

+ 

+ENDPROC object representation ; 

+ 

+

+TEXT PROC process module nr (INT CONST module number) :

+ TEXT VAR object specification ; 

+ was bool result := modules last word is bool return ; 

+ IF is elan module number 

+    THEN object specification := module name and specifications (module number) ; 

+         IF object specification = "" 

+            THEN object specification := "Hidden: PACKET " ; 

+                 object specification CAT packet name (module number) ; 

+                 IF was bool result 

+                    THEN object specification CAT " --> BOOL"

+                 FI

+            ELSE was bool result := pos (object specification, "--> BOOL") > 0 ;

+         FI 

+ ELIF one of compilers own module numbers 

+    THEN object specification := "CDL (" ; 

+         object specification CAT text ((getword (2, code address (module number)) - 4) DIV 2) ;

+         object specification CAT ")" ;

+         IF was bool result 

+            THEN object specification CAT " --> BOOL" 

+         FI

+ ELIF elan defined internal

+    THEN SELECT module number - 255 OF 

+            CASE 1 : object specification := "compiler (INT CONST, FILE VAR, TEXT CONST, INT VAR, BOOL CONST ins, BOOL CONST lst, BOOL CONST rtc, BOOL CONST ser)"

+            CASE 2 : object specification := "outtext (TEXT CONST, INT CONST)" 

+            CASE 3 : object specification := "outline (INT CONST)" 

+            CASE 4 : object specification := "syntaxerror (TEXT CONST)" 

+            CASE 5 : object specification := ":= (FILE VAR, FILE CONST)" 

+          OTHERWISE  object specification := "INTERNAL " + text (module number) 

+         ENDSELECT 

+ ELSE object specification := "Modulnummer ohne Code!" ; 

+      was bool result := FALSE

+ FI ; 

+ IF with object and address OR one of compilers own module numbers

+    THEN object specification CAT " (" ; 

+         object specification CAT text (module number) ;

+         object specification CAT ":$" ;

+         object specification CAT text (code segment (module number)) ; 

+         object specification CAT hex16 (code address (module number)) ; 

+         object specification CAT ")" ; 

+ FI ;

+ object specification . 

+ 

+modules last word is bool return : 

+ INT CONST last word :: getword (code segment (module number), 

+                                 code address (module number + 1) SUB 1) ; 

+ last word = rtnt opcode OR last word = rtnf opcode .

+ 

+one of compilers own module numbers : 

+ module number < 244 . 

+ 

+elan defined internal : 

+ module number >= 256 AND module number < 272 . 

+ 

+is elan module number : 

+ module number >= 272 . 

+ 

+ENDPROC process module nr ; 

+ 

+

+TEXT PROC copied text var (INT CONST segment, addr) : 

+ TEXT VAR result, t ; 

+ INT VAR laenge, first char, address, heap segment ; 

+ address := addr ADD 1 ;

+ first char := getword (segment, address) ; 

+ splitword (first char, laenge) ;

+ IF laenge = 0 

+    THEN "" 

+ ELIF laenge = 255

+    THEN copy text from heap 

+    ELSE copy text from data segment 

+ FI . 

+ 

+copy text from data segment : 

+ result := code (first char) ; 

+ laenge DECR 1 ;

+ t := "  " ;

+ INC address ;

+ WHILE laenge > 1 REP

+   replace (t, 1, getword (segment, address)) ; 

+   result CAT t ;

+   laenge DECR 2 ; 

+   INC address ; 

+ PER ; 

+ IF laenge = 1

+    THEN result CAT code (getword (segment, address) AND 255) 

+ FI ; 

+ result . 

+ 

+copy text from heap : 

+ address := get word (segment, addr) ; 

+ rotate (address, minus one) ;

+ heap segment := address AND 7 ; 

+ address := address AND hex fff8 ; (* In Vielfachen von 8 *)

+ laenge := getword (segment, addr ADD 2) AND 255 ; 

+ makeword (laenge, first char) ; (* 16 Bit Laenge über Wortgrenze *)

+ laenge := min (laenge, 256) ; (* Mehr ist im Listing nicht sinnvoll *) 

+ IF getword (heap segment, address) = minus one (* Standard DS *) 

+    THEN address INCR 3 ; (* Kann nicht über 8000H Grenze gehen *)

+    ELSE INC address (* Im Frei-Datenraum nur Wort Laenge *)

+ FI ;

+ result := "" ;

+ WHILE laenge > 1 REP

+   result CAT getword (heap segment, address) ;

+   laenge DECR 2 ; 

+   INC address

+ PER ;

+ IF laenge = 1

+    THEN result CAT code (getword (heap segment, address) AND 255) 

+ FI ; 

+ result . 

+ 

+ENDPROC copied text var ; 

+ 

+

+PROC push (INT CONST a, b) : 

+ INT VAR dummy1 := a, dummy2 := b 

+ENDPROC push ; 

+ 

+

+PROC pop (TASK VAR a, INT CONST dummy) : 

+ TASK VAR x ; 

+ a := x 

+ENDPROC pop ; 

+ 

+

+TEXT PROC task name (INT CONST id, vers) : 

+ TASK VAR t ; 

+ IF id = 0 

+    THEN "niltask" 

+    ELSE push (id, vers) ; 

+         pop (t, 0) ; 

+         IF exists (t) 

+            THEN """" + name (t) + """" 

+            ELSE "-" 

+         FI 

+ FI 

+ENDPROC task name ; 

+ 

+

+ENDPACKET eumel decoder ; 

+ 

+

+(**************************************************************************) 

+ 

+PACKET tracer DEFINES                          (* M. Staubermann      *) 

+                                               (* 20.04.86            *)

+                      list breakpoints ,       (* 1.8.0, 861107 15:45 *)

+                      set breakpoint , 

+                      reset breakpoint ,

+                      source file , 

+                      prot file ,

+                      tracer channel ,

+                      trace ,

+                      reset breakpoints : 

+ 

+LET local base field           = 25 , 

+    packet data segment        = 0 , 

+    local data segment         = 1 ,

+    code segment 3             = 3 ,

+ 

+    begin of module nr link table = 512 , 

+ 

+    previous local base offset = 0 , 

+    return address offset      = 1 , 

+    return segment offset      = 2 , 

+    c8k offset                 = 3 , 

+ 

+    opcode mask                = 31744 , 

+ 

+    bt opcode                  = 0 , 

+    btlong opcode              = 1024 , 

+    bf opcode                  = 28672 , 

+    bflong opcode              = 29696 , 

+    br opcode                  = 28672 , 

+    brlong opcode              = 29696 , 

+    brcomp opcode              = 32544 ,

+ 

+    ln opcode                  = 0 , 

+    ln long opcode             = 1024 , 

+    call opcode                = 30720 , 

+    pcall opcode               = 32543 , 

+ 

+    pp opcode                  = 27648 , 

+    ppv opcode                 = 26624 , 

+    pproc opcode               = 32542 ,

+ 

+    rtn opcode                 = 32512 , 

+    rtnt opcode                = 32513 , 

+    rtnf opcode                = 32514 , 

+ 

+    hex 7f00                   = 32512 ;

+

+INT CONST longa opcode        :: -256 ,

+          longa ppv opcode    :: longa opcode + 104 ,

+          longa pp opcode     :: longa opcode + 108 , 

+          hex 83ff            :: -31745 ,

+          minus one           :: -1 ;

+

+LET nr of breakpoints = 2 , (* Max. Anzahl unvorhersehbare Verzweigungen/Branch *)

+    BREAKPOINT = STRUCT (BOOL set, INT address, saved word) ; 

+ 

+ROW nr of breakpoints BREAKPOINT VAR breakpoints ;

+BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, -5, 0) ;

+ 

+FOR actual linenumber FROM 1 UPTO nr of breakpoints REP 

+ breakpoints (actual line number) := init breakpoint 

+PER ; 

+ 

+

+BOOL VAR auto trace := FALSE , 

+         forward trace := TRUE ,

+         source lines neu := TRUE ;

+

+INT VAR previous instruction address ,

+        prot file number ,

+        trace channel := minus one ,

+        actual line number := minus one , 

+        handler module := 339 ; (* Dummy: PROC stop *) 

+ 

+TEXT VAR prot file name := "" ,

+         source line := "" , 

+         source file name := "" ;

+ 

+FILE VAR source, protocoll ; 

+ 

+

+INT PROC tracer channel :

+ trace channel 

+ENDPROC tracer channel ; 

+ 

+

+PROC tracer channel (INT CONST c) : 

+ IF c < 17 AND c > minus one 

+    THEN trace channel := c 

+    ELSE errorstop ("PROC tracer channel: Kanalnummer unzulässig") 

+ FI

+ENDPROC tracer channel ; 

+ 

+

+PROC trace : 

+ TEXT VAR name ;

+ forward trace := TRUE ;

+ set breakpoint ;

+ get command ("PROC/OP-Aufruf eingeben:") ; 

+ out (""13"") ;

+ put ("      Sourcefilename (falls keine Sourcefile RETURN) :") ; 

+ getline (name) ; 

+ source file (name) ;

+ put ("      Protokollfilename (falls kein Protokoll RETURN):") ; 

+ getline (name) ; 

+ prot file (name) ;

+ put ("      Tracekanal (Ausführung an diesem Kanal: RETURN):") ; 

+ name := "0" ; 

+ editget (name) ; 

+ line ; 

+ tracer channel (int (name)) ; 

+ do command  

+ 

+ENDPROC trace ; 

+ 

+

+PROC source file (TEXT CONST file name) : 

+ IF exists (file name) 

+    THEN source := sequentialfile (modify, file name) ; 

+         source file name := file name ;

+         IF actual line number >= 0 CAND actual line number <= lines (source) 

+            THEN toline (source, actual line number) ; 

+                 readrecord (source, source line) 

+            ELSE source line := ""

+         FI

+    ELSE source file name := ""

+ FI

+ 

+ENDPROC source file ; 

+ 

+

+TEXT PROC source file : 

+ source file name 

+ENDPROC source file ; 

+ 

+

+TEXT PROC prot file : 

+ prot file name 

+ENDPROC prot file ; 

+ 

+

+PROC prot file (TEXT CONST file name) : 

+ IF file name = "" 

+    THEN prot file name := "" 

+    ELSE forget (file name, quiet) ;

+         prot file number := 0 ;

+         protocoll := sequentialfile (output, file name) ; 

+         max line length (protocoll, 1000) ;

+         prot file name := file name ;

+ FI

+ENDPROC prot file ;

+ 

+

+PROC protocoll line : 

+ IF prot file name <> "" 

+    THEN line (protocoll) ; 

+         IF lines (protocoll) > 4000 

+            THEN prot file number INCR 1 ; 

+                 TEXT CONST file name :: prot file name + "." + 

+                            text (prot file number) ;

+                 putline (protocoll, "Fortsetzung in Datei " + file name) ; 

+                 forget (file name, quiet) ;

+                 protocoll := sequentialfile (output, file name) ;

+                 max line length (protocoll, 1000)

+         FI

+ FI

+

+ENDPROC protocoll line ; 

+ 

+

+PROC write protocoll (TEXT CONST t) :

+ IF prot file name <> "" 

+    THEN write (protocoll, t) 

+ FI 

+ENDPROC write protocoll ; 

+ 

+

+PROC breakpoint handler : 

+

+ ROW 32 INT VAR offset fuer inter call stack variablen ; 

+ BOOL VAR was bool result ,

+          ueberschrift neu , 

+          code lines neu ; 

+ TEXT VAR key, previous key,

+          old error message ,

+          statement line, opcode, 

+          previous opcode, next opcode ;

+ INT VAR i, x, y ,

+         actual opcode, actual word, op word, next instruction, 

+         following word, saved word,

+         lbas, this local base, st ptr,

+         old channel, old error code, old error line,

+         user address, branch address, address,

+         lowbyte,

+         c8k, packet base,

+         actual instruction address, previous actual address, 

+         next instruction address,

+         return segment, return address, 

+         breakpoint address, breakpoint nr ; 

+

+ determine return address and breakpoint nr ;

+ reset breakpoints ; 

+ getcursor (x, y) ; 

+ next instruction address := breakpoint address ; 

+ IF NOT forward trace AND previous instruction address <> minus one 

+    THEN decode instruction (previous instruction address, previous actual address, 

+                             previous opcode, FALSE) ; 

+    ELSE previous opcode := ""

+ FI ;

+ decode instruction (next instruction address, actual instruction address, 

+                     next opcode, TRUE) ;

+ was bool result := bool result ;

+ IF forward trace 

+    THEN write protocoll (" " + hex16 (actual instruction address) + " ") ;

+         write protocoll (next opcode) ; 

+         protocoll line  

+    ELSE write protocoll ("*" + hex16 (previous actual address) + " ") ; 

+         write protocoll (previous opcode) ; 

+         protocoll line 

+ FI ;

+ actual word      := getword (code segment 3, actual instruction address) ; 

+ actual opcode    := actual word AND opcode mask ;

+ following word   := getword (code segment 3, actual instruction address ADD 1) ; 

+ next instruction := getword (code segment 3, next instruction address) ; 

+ out (""1""10""5""10""5"") ; 

+ IF NOT auto trace 

+    THEN out (""6""6""0"") ;

+         putline ("Auto, Bpnt, Clrr, Dstp, Estp, File, Go, Prot, Rslt, Step(CR), Term, - + < >"5"") ; 

+         putline ("------------------------------------------------------------------------------"5"") ; 

+ FI ;

+ ueberschrift neu := TRUE ; 

+ code lines neu   := TRUE ; 

+ previous key := "" ;

+ REP 

+   kopf schreiben ;

+   IF auto trace 

+      THEN IF incharety = "" 

+              THEN key := "S" 

+              ELSE auto trace := FALSE 

+           FI 

+   FI ; 

+   IF NOT auto trace

+      THEN REP 

+            inchar (key) 

+           UNTIL pos (""13"abcdefgprst +-<>", key) > 0 PER ; 

+           IF key >= "a" 

+              THEN key := code (code (key)-32)

+           FI ;

+           analyze key

+   FI ;

+   previous key := key 

+ UNTIL pos ("GST!", key) > 0 PER ; 

+ IF key <> "T" 

+    THEN execute saved instruction 

+ FI ;

+ IF key = "T" 

+    THEN write protocoll ("      Terminated") ; 

+         protocoll line ;

+         resetbreakpoints ; 

+         term 

+ ELIF key = "G" 

+    THEN write protocoll ("      Go") ; 

+         protocoll line

+ ELIF key = "S" 

+    THEN singlestep 

+ FI ; 

+ previous instruction address := breakpoint address ;

+ cursor (x, y) ; 

+ IF trace channel > 0 

+    THEN IF old channel = 0 

+            THEN break (quiet) 

+            ELSE continue (old channel) 

+         FI 

+ FI ; 

+ IF bit (return segment, 7) 

+    THEN disablestop ; 

+         set line nr (old error line) ; 

+         error stop (old error code, old error message) ; 

+         set line nr (0)

+ FI .

+           

+analyze key : 

+ IF previous key = "B" 

+    THEN IF key = ""13"" OR key = "S" (* Sicherheitsabfrage *) 

+            THEN key := "!" ;         (* Exit-Key *)

+                 write protocoll ("      Skip") ;

+                 protocoll line ;

+                 write protocoll (" " + hex16 (user address) + " ") ; 

+                 write protocoll (opcode) ; 

+                 protocoll line ;

+                 set breakpoint (breakpoint nr, user address)

+            ELSE code lines neu := TRUE

+         FI

+ ELIF key = ""13"" 

+      THEN key := "S" 

+ ELIF key = " " 

+      THEN code lines neu := TRUE ; 

+           source lines neu := TRUE ; 

+           ueberschrift neu := TRUE ; 

+ ELSE SELECT code (key)-43 OF (* Um die Anzahl Branches klein zu halten*)

+       CASE 0 {+}  : stptr := stptr ADD 2 ;

+                     ueberschrift neu := TRUE  

+       CASE 2 {-}  : stptr := stptr SUB 2 ; 

+                     ueberschrift neu := TRUE

+       CASE 17 {<} : with object address (TRUE) ; 

+                     IF forward trace 

+                        THEN decode instruction (breakpoint address,

+                             actual instruction address, next opcode, FALSE) 

+                     ELIF previous instruction address <> minus one 

+                        THEN decode instruction (previous instruction address, 

+                             previous actual address, previous opcode, FALSE) 

+                     FI ;

+                     code lines neu := TRUE

+       CASE 19 {>} : with object address (FALSE) ; 

+                     IF forward trace 

+                        THEN decode instruction (breakpoint address,

+                             actual instruction address, next opcode, FALSE) 

+                     ELIF previous instruction address <> minus one 

+                        THEN decode instruction (previous instruction address, 

+                             previous actual address, previous opcode, FALSE) 

+                     FI ;

+                     code lines neu := TRUE ;

+       CASE 22 {A} : auto trace := TRUE ; 

+                     key := "S" 

+       CASE 23 {B} : get breakpoint address from user

+       CASE 24 {C} : resetbit (return segment, 7) ; 

+                     ueberschrift neu := TRUE

+       CASE 25 {D} : setbit (return segment, 6) ; 

+                     ueberschrift neu := TRUE

+       CASE 26 {E} : resetbit (return segment, 6) ; 

+                     ueberschrift neu := TRUE

+       CASE 27 {F} : out (""6""5""0"Sourcefile:"5"") ; 

+                     editget (source file name) ; 

+                     source file (source file name) ; 

+                     ueberschrift neu := TRUE ;

+                     source lines neu := TRUE

+       CASE 37 {P} : out (""6""5""0"Protokollfile:"5"") ; 

+                     editget (prot file name) ; 

+                     prot file (prot file name)

+       CASE 39 {R} : forward trace := NOT forward trace ; 

+                     IF NOT forward trace AND previous opcode = "" AND 

+                        previous instruction address <> minus one 

+                        THEN decode instruction (previous instruction address, 

+                             previous actual address, previous opcode, FALSE) 

+                     FI ;

+                     ueberschrift neu := TRUE ;

+                     code lines neu := TRUE

+      ENDSELECT

+ FI .

+

+kopf schreiben :

+ out (""6""5""0""5"") ;

+ IF ueberschrift neu 

+    THEN schreibe ueberschrift ; 

+         ueberschrift neu := FALSE

+ FI ; 

+ IF source lines neu

+    THEN schreibe source lines ; 

+         source lines neu := FALSE

+ FI ;

+ IF code lines neu

+    THEN IF forward trace 

+            THEN show decoded opcode (next opcode, 

+                 actual instruction address, TRUE, TRUE) 

+         ELIF previous instruction address <> minus one 

+            THEN show decoded opcode (previous opcode, 

+                 previous actual address, TRUE, TRUE) 

+         ELSE out (""6""5""0"Kein vorhergehender Befehl")

+         FI ; 

+         code lines neu := FALSE

+ FI . 

+

+schreibe ueberschrift : 

+ out (""1"") ;

+ put (breakpoint nr) ;

+ IF forward trace 

+    THEN put ("F") (* forward *)

+    ELSE put ("R") (* result *)

+ FI ;

+ IF bit (return segment, 4) 

+    THEN out ("u") (* ARITHU *)

+    ELSE out ("s") 

+ FI ; 

+ IF bit (return segment, 6) 

+    THEN out ("d") (* Disablestop *)

+    ELSE out ("e") 

+ FI ; 

+ IF bit (return segment, 7) 

+    THEN put ("E") (* iserror *)

+    ELSE put (" ") 

+ FI ; 

+ put ("lbas:") ; put (hex16 (lbas)) ; 

+ out ("stack(") ; out (hex16 (stptr)) ; put ("):") ; 

+ out (hex16 (getword (local data segment, stptr))) ; out ("-") ; 

+ put (hex16 (getword (local data segment, stptr ADD 1))) ; 

+ put ("pbas:") ; put (hex8 (packet base)) ; 

+ put ("c8k:") ;  put (hex8 (c8k)) ; 

+ IF valid source 

+    THEN out ("""") ; outsubtext (source file name, 1, 19) ; put ("""") 

+ FI ; 

+ out (""5"") . 

+

+schreibe source lines : 

+ out (""1""10"") ; 

+ IF valid source AND source line <> "" 

+    THEN put (text (actual line number, 4)) ; 

+         put ("|") ; 

+         outsubtext (source line, 1, 72) ; 

+         out (""5"") ;

+         line ; 

+         IF LENGTH source line <= 72 

+            THEN put (text (actual line number +1, 4)) ; 

+                 put ("|") ; 

+                 toline (source, actual line number +1) ; 

+                 out (subtext (source, 1, 72)) ; 

+                 out (""5"") ;

+                 toline (source, actual line number) ; 

+                 line 

+            ELSE put ("_____|") ; 

+                 outsubtext (source line, 73, 144) ; 

+                 out (""5"") ;

+                 line 

+         FI

+ FI . 

+

+valid source : 

+ exists (source file name) . 

+ 

+get breakpoint address from user : 

+ put ("Nächste Breakpointaddresse (hex) in Segment 3:") ;

+ statement line := hex16 (next instruction address) ;

+ editget (statement line) ; 

+ user address := integer (statement line) ;

+ opcode := "" ; 

+ statement line := "" ;

+ address := user address ; 

+ bool result (FALSE) ;

+ decode (code segment 3, address, statement line,

+         opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+ show decoded opcode (opcode, user address, TRUE, TRUE) ;

+ code lines neu := FALSE .

+

+singlestep : 

+ IF is return opcode

+    THEN set breakpoint behind previous call

+ ELIF was bool result AND NOT is call opcode 

+    THEN set first breakpoint behind branch instruction ; 

+         set second breakpoint at branch address

+ ELIF is bool return opcode 

+    THEN set first breakpoint behind branch instruction at return address ; 

+         set second breakpoint at branch address of branch instruction at 

+         return address  

+ ELIF is brcomp opcode

+    THEN set computed branch breakpoint  

+ ELIF is branch instruction 

+    THEN set breakpoint at branch address 

+ ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND 

+      ask if subroutine trace

+    THEN write protocoll ("      Subroutine Trace") ; 

+         protocoll line ;

+         calculate subroutine segment and address ; 

+         set breakpoint behind next instruction

+ ELSE set breakpoint behind next instruction

+ FI . 

+ 

+ask if subroutine trace : 

+ IF forward trace 

+    THEN yes (""6""5""0"Subroutine Trace") 

+    ELSE show decoded opcode (next opcode, actual instruction address, FALSE, FALSE) ; 

+         yes (""6""6""0"Subroutine Trace"5"") 

+ FI . 

+ 

+is line number : 

+ actual opcode = ln opcode OR (* Kein LONGA, da ln < 4095 *)

+ actual opcode = lnlong opcode . 

+

+is branch instruction : 

+ actual opcode = br opcode OR 

+ actual opcode = brlong opcode . 

+ 

+is conditional branch : 

+ op word = bf opcode OR op word = bflong opcode OR 

+ op word = bt opcode OR op word = btlong opcode .

+

+is brcomp opcode : 

+ actual word = brcomp opcode . 

+ 

+is return opcode : 

+ actual word = rtn opcode . 

+ 

+is bool return opcode : 

+ actual word = rtnt opcode OR 

+ actual word = rtnf opcode . 

+ 

+is call opcode : 

+ actual opcode = call opcode OR 

+ actual word   = pcall opcode .

+   

+read source line : 

+ actual line number := actual word ; 

+ split word (actual line number, lowbyte) ;

+ actual line number := (actual line number * 2) AND 6 ; 

+ IF actual word < 0 

+    THEN actual line number INCR 1 

+ FI ; 

+ IF actual opcode = lnlong opcode

+    THEN actual line number INCR 8 

+ FI ; 

+ makeword (actual line number, lowbyte) ; 

+ actual line number DECR 1 ; 

+ source lines neu := TRUE ;

+ IF valid source 

+    THEN IF lineno (source) = actual line number CAND source line <> "" 

+            THEN (* nichts*) 

+         ELIF actual line number >= 0 AND actual line number <= lines(source) 

+            THEN toline (source, actual line number) ; 

+                 readrecord (source, source line) 

+         ELSE source line := "" 

+         FI 

+    ELSE source line := "" 

+ FI . 

+ 

+set first breakpoint behind branch instruction : 

+ op word := next instruction AND opcode mask ; 

+ IF is conditional branch

+    THEN write protocoll (" ") ;

+         write protocoll (hex16 (next instruction address) + " ") ; 

+         bool result (TRUE) ;

+         statement line := "" ; 

+         opcode := "" ; 

+         address := next instruction address ;

+         decode (code segment 3, next instruction address, statement line, opcode, 

+                 INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+         write protocoll (opcode) ; 

+         protocoll line ;

+         show decoded opcode (opcode, address, FALSE, FALSE) ;

+         IF NOT auto trace

+            THEN pause (20) 

+         FI ;

+         next free breakpoint ;

+         set breakpoint (i, next instruction address) ;

+    ELSE putline ("Interner Fehler: Nach BOOL-Result folgt kein Branch"5""); 

+         LEAVE singlestep 

+ FI . 

+ 

+set second breakpoint at branch address : 

+ calculate branch address ; 

+ next free breakpoint ;

+ set breakpoint (i, branch address) . 

+ 

+set breakpoint at branch address : 

+ next instruction := actual word ; 

+ next instruction address := actual instruction address ; 

+ calculate branch address ; 

+ set breakpoint (breakpoint nr, branch address) . 

+ 

+set first breakpoint behind branch instruction at return address : 

+ IF (getword (local data segment, lbas + return segment offset) AND 7) = code segment 3

+    THEN next instruction address := getword (local data segment, 

+                                     lbas + return address offset) ; 

+         next instruction := getword (code segment 3, next instruction address) ;

+         c8k := getword (local data segment, lbas + c8k offset) AND 255 ; 

+         set first breakpoint behind branch instruction 

+    ELSE putline ("Trace bei Vorwärtssprung beendet."5"") 

+ FI . 

+ 

+set second breakpoint at branch address of branch instruction at return address : 

+ set second breakpoint at branch address . 

+ 

+set computed branch breakpoint :

+ address := following word ; 

+ IF address < 0 (* Local/Local Ref *) 

+    THEN rotate (address, minus one) ; 

+         address := (address AND 16 383) ADD lbas ; 

+         IF bit (following word, 0)

+            THEN branch address := getword (getword (local data segment, 

+                                            address ADD 1) AND 7, 

+                                            getword (local data segment, 

+                                            address))  

+            ELSE branch address := getword (local data segment, address) 

+         FI  

+    ELSE branch address := getword (packet data segment, 

+                                    address ADD packet base)

+ FI ; 

+ IF switch out of range 

+    THEN branch address := actual instruction address ADD 3 

+    ELSE branch address := actual instruction address ADD branch address ADD 4

+ FI ; 

+ set breakpoint (breakpoint nr, branch address) . 

+ 

+switch out of range : 

+ branch address < 0 OR 

+ branch address > getword (code segment 3, actual instruction address ADD 2) .

+

+determine return address and breakpoint nr : 

+ FOR x FROM 1 UPTO 10 REP

+  determine return address ;

+  determine breakpoint nr ; 

+ PER ; 

+ line ;

+ put ("Returnaddresse nicht gefunden:"5"") ; 

+ out (text (return segment AND 3)) ; 

+ putline (hex16 (return address)) ; 

+ list breakpoints ;

+ reset breakpoints ; 

+ enablestop ;

+ errorstop ("Falsche Returnaddresse") . 

+

+determine return address : 

+ fix local base ; (* Fix pcb's: RAM --> Leitblock *)

+ this local base := getword (local data segment, pcb (local base field)) ; 

+ lbas            := getword (local data segment, this local base + 

+                             previous local base offset) ; 

+ c8k             := getword (local data segment, this local base + 

+                             c8k offset) AND 255 ; 

+ return segment  := getword (local data segment, this local base + 

+                             return segment offset) ; 

+ return address  := getword (local data segment, this local base +

+                             return address offset) ; 

+ packet base     := HIGH return segment ; (* Wort besteht aus zwei Teilen!*)

+ set parameters (lbas, packet base, minus one, c8k) ; 

+ stptr := lbas ADD 4 ;

+ DEC return address ; (* auf CALL breakpointhandler (ein Wort zurück) *)

+ IF bit (return segment, 7) (* ISERR *)

+   THEN old error line    := error line ; 

+        old error code    := error code ; 

+        old error message := error message

+ FI ; 

+ clear error ; 

+ enablestop ;

+ IF trace channel > 0 AND trace channel <> channel 

+    THEN old channel := channel ; 

+         disablestop ; 

+         continue (trace channel) ; 

+         clear error ; 

+         enablestop 

+ FI . 

+ 

+determine breakpoint nr : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF breakpoints (i).set CAND 

+     breakpoints (i).address = return address 

+     THEN breakpoint nr := i ; 

+          breakpoint address := breakpoints (i).address ; 

+          saved word         := breakpoints (i).saved word ;

+          LEAVE determine return address and breakpoint nr 

+  FI 

+ PER .

+

+segment 3 module : 

+ IF actual word = pcall opcode 

+    THEN op word := following word ;

+         rotate (op word, minus one) ;

+         op word := (op word AND 16 383) ADD lbas ;

+         LEAVE segment 3 module WITH (getword (local data segment, 

+                                      op word ADD 1) AND 7) = code segment 3

+ ELSE op word := actual word AND 1023 ; 

+      IF actual word < 0 

+         THEN op word INCR 1024 

+      FI ; 

+ FI ; 

+ op word >= 1280 . 

+ 

+calculate subroutine segment and address : 

+ IF actual word = pcall opcode 

+    THEN next instruction address := getword (local data segment, op word) 

+    ELSE next instruction address := getword (packet data segment,

+                          begin of module nr link table + op word)

+ FI ; 

+ INC next instruction address . (* Ab PENTER tracen *)

+ 

+calculate branch address : 

+ branch address := next instruction ; 

+ split word (branch address, low byte) ; 

+ branch address := (branch address * 2) AND 6 ; 

+ IF next instruction < 0 

+    THEN branch address INCR 1 

+ FI ; 

+ IF branch long

+    THEN branch address INCR 8 

+ FI ; 

+ branch address INCR HIGH next instruction address ; 

+ IF branch address >= c8k 

+    THEN branch address DECR 16 

+ FI ; 

+ makeword (branch address, lowbyte) . 

+ 

+branch long : 

+ bit (next instruction, 10) . 

+ 

+execute saved instruction : 

+ putword (local data segment, this local base + return address offset,

+          return address) ; 

+ putword (local data segment, this local base + return segment offset, 

+          return segment) . 

+ 

+

+set breakpoint behind next instruction : 

+ IF is line number THEN read source line FI ; 

+ set breakpoint (breakpoint nr, next instruction address) . 

+ 

+

+set breakpoint behind previous call : 

+ return segment := getword (local data segment, 

+                   lbas + return segment offset) AND 3 ;

+ return address := getword (local data segment, 

+                   lbas + return address offset) ; 

+ IF return segment = code segment 3 

+    THEN set breakpoint (breakpoint nr, return address) 

+    ELSE putline ("Trace bei Rücksprung beendet."5"") 

+ FI . 

+ 

+next free breakpoint : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF NOT breakpoints (i).set

+     THEN LEAVE next free breakpoint 

+  FI 

+ PER ; 

+ putline ("Alle " + text(nr of breakpoints) + " Breakpoints sind belegt"5"") ; 

+ LEAVE singlestep  

+ 

+ENDPROC breakpoint handler ; 

+

+

+PROC show decoded opcode (TEXT CONST opcode, INT CONST address, 

+                          BOOL CONST zweizeilig, oben) : 

+ IF oben 

+    THEN out (""6""3""0"") 

+    ELSE out (""6""5""0"")

+ FI ;

+ put (hex16 (address)) ; 

+ put ("|") ; 

+ outsubtext (opcode, 1, 72) ; 

+ out (""5"") ;

+ line ; 

+ IF zweizeilig 

+    THEN put ("     |") ; 

+         outsubtext (opcode, 73, 144) ; 

+         out (""5"") ;

+         line 

+ FI 

+ 

+ENDPROC show decoded opcode ;

+ 

+

+PROC decode instruction (INT VAR address, actual address, TEXT VAR opcode, 

+                         BOOL CONST var) :

+

+ INT VAR actual word, actual opcode, temp address ; 

+ TEXT VAR statement line := "" ; 

+ opcode := "" ;

+ temp address := address ;

+ actual address := address ; 

+ actual word := getword (code segment 3, temp address) ; 

+ actual opcode := actual word AND opcode mask ;

+ bool result (FALSE) ;

+ IF is param push opcode 

+    THEN opcode := module with actual params (temp address, actual address) ; 

+    ELSE decode (code segment 3, temp address, 

+                 statement line, opcode, 

+                 INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;

+ FI ; 

+ IF var THEN address := temp address FI .

+ 

+is param push opcode : 

+ actual opcode = pp opcode OR 

+ actual word   = pproc opcode OR 

+ actual word   = longa pp opcode OR 

+ actual word   = longa ppv opcode OR 

+ actual opcode = ppv opcode . 

+

+ENDPROC decode instruction ;

+ 

+

+TEXT PROC module with actual params (INT VAR address, actual address) : 

+

+ TEXT VAR result, statement line, symbol, type text ;

+ INT VAR end address, start address := address, module nr, 

+         actual word, actual opcode ;

+ BOOL VAR known paramtypes, was bool result ;

+

+ skip until next call opcode ; 

+ determine module name and module nr ; 

+ collect actual parameters ;

+ perhaps result type ;

+ bool result (was bool result) ;

+ address := end address ;

+ result . 

+ 

+skip until next call opcode : 

+ actual word := getword (code segment 3, address) ; 

+ REP 

+  IF (actual word AND hex 7f00) = hex 7f00 (* LONGA oder ESC *)

+     THEN INC address

+  FI ; 

+  INC address ; 

+  actual word := getword (code segment 3, address) ; 

+  actual opcode := actual word AND opcode mask ;

+ UNTIL is call opcode PER . 

+ 

+determine module name and module nr : 

+ result := "" ; 

+ statement line := "" ; 

+ actual address := address ; (* Addresse des CALL/PCALL Befehls *)

+ decode (code segment 3, address, statement line, result, 

+         INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+ was bool result := bool result ;

+ bool result (FALSE) ;

+ end address := address ;

+ module nr := int (last actual parameter) ; 

+ statement line := module name and specifications (module nr) ; 

+ scan (statement line) ;

+ IF statement line = "" 

+    THEN symbol := "(" ;

+         known paramtypes := FALSE ; 

+         actual word := getword (code segment 3, start address) ; 

+         actual opcode := actual word AND opcode mask ; 

+         IF is call opcode (* Hidden ohen Result und Parameter *) 

+            THEN LEAVE module with actual params WITH result 

+            ELSE result CAT " (" (* Result wird als VAR Parameter betr.*)

+         FI

+     ELSE nextsymbol (symbol) ; (* Skip Name *) 

+          nextsymbol (symbol) ;

+          known paramtypes := TRUE ;

+          IF symbol = "" (* Weder Parameter, noch Result *) 

+             THEN LEAVE module with actual params WITH result 

+          ELIF symbol = "(" 

+             THEN result := subtext (result, 1, pos (result, "(")) ;

+             ELSE result := subtext (result, 1, pos (result, "-->")-2)

+          FI ;

+ FI ;

+ address := start address . (* Rücksetzen auf ersten param push *)

+ 

+collect actual parameters :

+ IF symbol <> "(" 

+    THEN LEAVE collect actual parameters 

+ FI ;

+ REP 

+  nextsymbol (symbol) ;

+  IF symbol = "ROW" 

+     THEN typetext := "ROW..." ;

+          nextsymbol (symbol) ; (* ROW-Size *) 

+          skip until end of type (symbol) ; 

+  ELIF symbol = "STRUCT" 

+     THEN typetext := "STRUCT..." ;

+          nextsymbol (symbol) ;

+          skip over brackets (symbol) ; 

+  ELIF symbol = "<" (* HIDDEN *) 

+     THEN typetext := "<HIDDEN>" ; 

+          nextsymbol (symbol) ; 

+          nextsymbol (symbol) ; 

+          nextsymbol (symbol) ;

+  ELIF symbol <> "PROC" 

+     THEN typetext := symbol ; 

+          nextsymbol (symbol)  

+  FI ; (* symbol jetzt 'PROC', 'CONST' oder 'VAR' *)

+  IF getword (code segment 3, address) = pproc opcode 

+     THEN result CAT "PROC " ; 

+          type text := "" ;

+          decode (code segment 3, address, statement line, type text, 

+                 INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; 

+          result CAT subtext (type text, 13) ;

+          next symbol (symbol) ;

+          IF symbol = "(" THEN skip over brackets (symbol) FI 

+     ELSE IF statement line <> "" (* Keine Hidden PROC *) 

+             THEN result CAT typetext ; 

+                  result CAT " " ; 

+                  result CAT symbol ; (* CONST oder VAR *)

+                  result CAT ":" ;

+                  typetext := ":" + typetext ; (* Für Pos-Suche *) 

+                  nextsymbol (symbol) ; (* Jetzt auf ',' oder ')' *)

+          FI ;

+          IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *)

+             THEN result CAT data representation (getword (code segment 3, 

+                  address ADD 1), code segment 3, address, object type) ; 

+                  INC address

+             ELSE result CAT data representation (getword (code segment 3, address) 

+                  AND hex 83ff, code segment 3, address, object type)  

+          FI ; 

+          INC address

+  FI ; 

+  actual word := getword (code segment 3, address) ; 

+  actual opcode := actual word AND opcode mask ;

+  IF symbol <> ")" AND NOT is call opcode 

+     THEN result CAT ", " 

+  FI  ; 

+ UNTIL symbol = ")" OR is call opcode PER ; 

+ result CAT ")" . 

+ 

+perhaps result type :

+ WHILE symbol <> "" REP nextsymbol (symbol) UNTIL symbol = ">" PER ; (* --> *) 

+ IF symbol <> ""

+    THEN nextsymbol (symbol) ;

+         IF symbol = "ROW" 

+            THEN symbol := "ROW..." ;

+         ELIF symbol = "STRUCT" 

+            THEN symbol := "STRUCT..." ;

+         ELIF symbol = "<" (* HIDDEN *) 

+            THEN symbol := "<HIDDEN>" ; 

+         FI ;

+         type text := ":" ; 

+         type text CAT symbol ; 

+         result CAT " --> " ; 

+         result CAT symbol ;

+         IF symbol = "BOOL" (* BOOl-Result nicht mit PP *)

+            THEN LEAVE perhaps result type

+         FI ;

+         result CAT ":" ;

+         IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *)

+            THEN result CAT data representation (getword (code segment 3, 

+                 address ADD 1), code segment 3, address, object type) ; 

+                 INC address

+            ELSE result CAT data representation (getword (code segment 3, address) 

+                 AND hex 83ff, code segment 3, address, object type)  

+         FI ; 

+         INC address

+ FI . 

+ 

+object type : 

+ IF known paramtypes 

+    THEN INT CONST p := pos (types, type text) ; 

+         IF p = 0 

+            THEN 0 (* Try Type auch bei STRUCT/ROW *) 

+            ELSE code (types SUB (p-1))-63 

+         FI  

+    ELSE 0 (* Try all types *) 

+ FI . 

+ 

+types : 

+ "B:BOOL I:INT R:REAL S:TEXT T:TASK D:DATASPACE D:FILE S:THESAURUS" .

+

+is call opcode : 

+ actual opcode = call opcode OR 

+ actual word   = pcall opcode .

+   

+ENDPROC module with actual params ; 

+ 

+

+PROC skip until end of type (TEXT VAR symbol) : 

+ nextsymbol (symbol) ;

+ IF symbol = "ROW" 

+    THEN nextsymbol (symbol) ; (* ROW-Size *) 

+         skip until end of type (symbol) 

+ ELIF symbol = "STRUCT" 

+    THEN next symbol (symbol) ;

+         skip over brackets (symbol) 

+ ELSE nextsymbol (symbol) (* steht auf ',' oder ')' *) 

+ FI

+ 

+ENDPROC skip until end of type ; 

+ 

+

+PROC skip over brackets (TEXT VAR symbol) : 

+ REP 

+  next symbol (symbol) ; 

+  IF symbol = "(" THEN skip over brackets (symbol) FI 

+ UNTIL symbol = ")" PER ; 

+ nextsymbol (symbol) 

+

+ENDPROC skip over brackets ; 

+ 

+

+INT OP HIGH (INT CONST word) : 

+ INT VAR highbyte := word, lowbyte ;

+ split word (highbyte, lowbyte) ; 

+ highbyte

+ 

+ENDOP HIGH ; 

+ 

+ 

+PROC fix local base : 

+ (* Kein direkter EXTERNAL-Aufruf, da bei 'CALL' lbas auf Stack gelegt wird*)

+ REP UNTIL incharety = "" PER ; (* Damit pause ausgeführt wird *)

+ internal pause (0)             (* ^ War Grund für 'falsche Returnaddresse'*)

+

+ENDPROC fix local base ; 

+ 

+

+PROC reset breakpoints : 

+ INT VAR i ;

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF breakpoints (i).set 

+     THEN reset breakpoint (i) 

+     ELSE breakpoints (i) := init breakpoint 

+  FI 

+ PER 

+ 

+ENDPROC reset breakpoints ; 

+ 

+

+PROC reset breakpoint (INT CONST nr) : 

+ IF nr < 1 OR nr > nr of breakpoints 

+    THEN errorstop ("Unzulaessige Breakpoint Nummer") 

+ ELIF NOT breakpoints (nr).set 

+    THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt")

+ ELSE putword (code segment 3, breakpoints (nr).address, breakpoints (nr).saved word) ; 

+      breakpoints (nr) := init breakpoint 

+ FI 

+ 

+ENDPROC reset breakpoint ; 

+ 

+

+PROC set breakpoint (INT CONST nr, address) : 

+ INT VAR new word ;

+ IF nr < 1 OR nr > nr of breakpoints 

+    THEN errorstop ("Unzulaessige Breakpoint Nummer") 

+ ELIF breakpoints (nr).set 

+    THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt") 

+ ELSE breakpoints (nr).address := address ; 

+      breakpoints (nr).saved word := get word (code segment 3, address) ; 

+      new word := call opcode + (handler module AND 1023) ; 

+      IF handler module >= 1024 

+         THEN setbit (new word, 15)

+      FI ; 

+      putword (code segment 3, address, new word) ; 

+      IF getword (code segment 3, address) <> new word 

+         THEN errorstop ("Addresse Schreibgeschuetzt")

+         ELSE breakpoints (nr).set := TRUE

+      FI 

+ FI 

+ENDPROC set breakpoint ; 

+ 

+

+PROC handlers module nr (INT CONST module nr) : 

+ handler module := module nr 

+ENDPROC handlers module nr ; 

+ 

+

+INT PROC handlers module nr : 

+ handler module

+ENDPROC handlers module nr ; 

+

+

+INT PROC module number (PROC proc) : 

+ 

+ EXTERNAL 35 

+ 

+ENDPROC module number ; 

+ 

+ 

+PROC internal pause (INT CONST time) : 

+ 

+ EXTERNAL 66 

+ 

+ENDPROC internal pause ; 

+ 

+ 

+PROC term : 

+ 

+ EXTERNAL 4 

+

+ENDPROC term ; 

+

+

+PROC set breakpoint : 

+ INT VAR i ;

+ handlers module nr (module number (PROC breakpointhandler)) ; 

+ auto trace := FALSE ;

+ source lines neu := TRUE ; (* Zum Löschen *) 

+ source file ("") ; 

+ prot file ("") ;

+ actual line number := minus one ;

+ previous instruction address := minus one ;

+ with object address (FALSE) ;

+ INT VAR module nr ; 

+ add modules ;

+ get module number (module nr) ; 

+ IF code segment (module nr) <> code segment 3

+    THEN errorstop ("PROC/OP liegt nicht im Codesegment 3") 

+ FI ;

+ naechsten freien breakpoint setzen ; 

+ put ("Breakpoint") ; 

+ put (i) ; 

+ putline ("wurde gesetzt.") . 

+ 

+naechsten freien breakpoint setzen : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF NOT breakpoints (i).set 

+     THEN set breakpoint (i, code address (module nr) ADD 1) ; 

+          LEAVE naechsten freien breakpoint setzen 

+  FI 

+ PER ; 

+ errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt"). 

+ 

+ENDPROC set breakpoint ; 

+ 

+

+PROC list breakpoints : 

+ INT VAR header address, mod nr, i ;

+

+ line ; 

+ putline (" Nr Set Address Word Module") ; 

+ FOR i FROM 1 UPTO nr of breakpoints REP

+  put (text (i, 2)) ; 

+  IF breakpoints (i).set 

+     THEN put (" Y  ")

+     ELSE put (" N  ") 

+  FI ; 

+  out ("3") ; 

+  put (hex16 (breakpoints (i).address)) ; 

+  put (" ") ;

+  put (hex16 (breakpoints (i).saved word)) ; 

+  IF breakpoints (i).set 

+     THEN next module header (code segment 3, breakpoints (i).address, 

+                      header address, mod nr) ; 

+          IF module name and specifications (modnr - 1) = "" 

+             THEN put ("Hidden: PACKET") ; put (packet name (modnr -1)) ; 

+             ELSE put (module name and specifications (modnr -1)) 

+          FI

+  FI ; 

+  line

+ PER 

+ 

+ENDPROC list breakpoints ;

+ 

+ENDPACKET tracer ; 

+

+init module table ("table.module") ; 

+type (""27"q") ; 

+note ("") ;

diff --git a/devel/misc/unknown/src/0DISASS.ELA b/devel/misc/unknown/src/0DISASS.ELA
new file mode 100644
index 0000000..3965e52
--- /dev/null
+++ b/devel/misc/unknown/src/0DISASS.ELA
@@ -0,0 +1,1110 @@
+PACKET eumel 0 code disassembler DEFINES   (* M.Staubermann, März/April 86 *)

+       disass 0 code, 

+(*     disass object, 

+       disass address, 

+       disass module nr, *) 

+       disass 0, 

+       ADD, 

+       hex16, 

+       hex8 , 

+       integer, 

+       denoter, 

+       opcode, 

+       seg, 

+       addr, 

+       end addr,

+       local base , 

+       bool result ,

+       code word line : 

+ 

+LET packet data segment = 0 , 

+    local  data segment = 1 ,

+    first elan address = 13322 , 

+    begin of stringtable = 1024 , 

+    begin of nametable   = 4096 , 

+    end of nametable     = 19455 , 

+    begin of permanent table = 19456 ;

+ 

+INT VAR address, segment, lbas ; 

+ 

+PROC local base (INT CONST i) : 

+ lbas := i (* -1 = lbas unbekannt *)

+ENDPROC local base ; 

+ 

+TEXT PROC code word line : 

+ code words 

+ENDPROC code word line ; 

+ 

+PROC code word line (TEXT CONST text) : 

+ code words := text 

+ENDPROC code word line ; 

+ 

+PROC seg (INT CONST s) : 

+     segment := s 

+ENDPROC seg ; 

+ 

+PROC addr(INT CONST a) : 

+     address := a 

+ENDPROC addr ; 

+ 

+INT PROC addr : 

+    address 

+ENDPROC addr ; 

+ 

+BOOL PROC bool result : 

+ was bool result 

+ENDPROC bool result ; 

+ 

+PROC bool result (BOOL CONST b) : 

+ was bool result := b 

+ENDPROC bool result ; 

+ 

+PROC end addr (INT CONST e) : 

+ end address := e 

+ENDPROC end addr ; 

+ 

+PROC disass 0 code (INT CONST seg, INT VAR addr, PROC (TEXT CONST) writeln) : 

+ TEXT VAR taste ; 

+ BOOL VAR addr out := TRUE , 

+          output permitted := TRUE, 

+          is packet ;

+ INT VAR size, used, mod nr, a, b, m ; 

+ storage (size, used) ;

+ echo := FALSE ; 

+ init list file ; 

+ segment := seg ; 

+ address := addr ; 

+ mod nr := -1 ; 

+ was bool result := FALSE ; 

+ REP 

+  IF output permitted 

+     THEN IF addr out 

+             THEN out (" ") ; 

+                  out (hex16 (address)) ; 

+                  out (" "8""8""8""8""8""8"") ; 

+             ELSE cout (ln) 

+          FI 

+  FI ; 

+  taste := incharety ; 

+  disass one statement ; 

+  SELECT code (taste) OF 

+{l}CASE 108 : addr out := FALSE 

+{d}CASE 100 : get command ("gib kommando:") ; do command 

+{f}CASE 102 : out (""13""5"Filename: "+filename+ "." + text(filenumber)+"  ") 

+{z}CASE 122 : out (""13""5"Fileline: "+text (lines (list file)) + "  ") 

+{a}CASE 97  : addr out := TRUE 

+{e}CASE 101 : echo := NOT echo 

+{s}CASE 115 : storage(size,used);out(""13""5"System-Storage: "+text(used)+"  ") 

+{h}CASE 104 : out (""13""5"Heapsize: " + text (heapsize) + "  ") 

+{m}CASE 109 : out (""13""5"Modulnr: " + text (mod nr) + "  ") 

+{W}CASE 87, 81: output permitted := TRUE 

+{S}CASE 83  : output permitted := FALSE 

+   CASE 27  : IF incharety <> "" THEN taste := "" FI(* Wegen Steuertasten *)

+  ENDSELECT ; 

+  arith 16 ; 

+  address INCR 1 ; 

+  arith 15 ; 

+  IF (address AND 31) = 0 

+   THEN storage (size, used) ; 

+  FI ; 

+  BOOL CONST ende erreicht :: end address <> 0 CAND 

+             real (address) >= real (end address) ; 

+ UNTIL ende erreicht OR taste = ""27"" OR taste = ""129"" OR used > size PER ; 

+ IF used > size

+   THEN writeln ("Abbruch wegen Speicherengpass!") 

+ ELIF taste = ""27"" 

+   THEN writeln ("Abbruch mit ESC") 

+ FI ; 

+ addr := address . 

+ 

+code word : 

+ get word (segment, address) . 

+ 

+disass one statement : 

+ a := address ;

+ divrem 256 (a, b) ; 

+ IF segment = 2 

+  THEN m := pos (segment 2 adresses, ""0"" + code (b) + code (a) + ""0"") ; 

+       IF m <= LENGTH segment 2 adresses - 4 

+          THEN IF code (segment 2 adresses SUB (m + 4)) <= a 

+                  THEN IF code (segment 2 adresses SUB (m + 4)) = a 

+                          THEN is packet := 

+                               code (segment 2 adresses SUB (m + 3)) <= b 

+                          ELSE is packet := TRUE 

+                       FI 

+                  ELSE is packet := FALSE 

+               FI 

+          ELSE is packet := FALSE 

+       FI 

+  ELSE m := pos (segment 3 adresses, ""0"" + code (b) + code (a) + ""0"") ; 

+       IF m <= LENGTH segment 3 adresses - 4 

+          THEN IF code (segment 3 adresses SUB (m + 4)) <= a 

+                  THEN IF code (segment 3 adresses SUB (m + 4)) = a 

+                          THEN is packet := 

+                               code (segment 3 adresses SUB (m + 3)) <= b 

+                          ELSE is packet := TRUE 

+                       FI 

+                  ELSE is packet := FALSE 

+               FI 

+          ELSE is packet := FALSE 

+       FI 

+ FI ; 

+ IF m > 0 AND end address = 0 AND addr <> address

+  THEN taste := ""129"" ; 

+       LEAVE disass one statement

+ ELIF m > 0 

+  THEN m := (m - 1) DIV 3 + 1 ; 

+       IF segment = 2 

+         THEN mod nr := segment 2 modules ISUB m

+         ELSE mod nr := segment 3 modules ISUB m 

+       FI ;

+       writeln (" ") ; 

+       writeln ("Modulnummer " + process module nr (mod nr, is packet)) ; 

+       writeln ("Top of Stack: " + hex16 (codeword)) ; 

+       arith 16 ; 

+       address INCR 1 ;

+       arith 15 ; 

+       writeln (" ") 

+ FI ;

+ codewords := hex16 (address) + " " ; 

+ codewords CAT hex16 (code word) + " " ; 

+ TEXT CONST opc := opcode ; 

+ WHILE length (codewords) < 30 REP 

+  codewords CAT " " 

+ PER ; 

+ writeln (codewords + opc) . 

+ 

+ENDPROC disass 0 code ; 

+ 

+PROC init list file : 

+ forget (filename + "." + text (filenumber), quiet) ; 

+ list file := sequentialfile (output, filename + "." + text (filenumber)) ; 

+ maxlinelength (list file, 9999) ;

+ list line ("Addr Opco Data Data Data Data Opcode Parameter") ; 

+ENDPROC init list file ; 

+ 

+PROC list line (TEXT CONST zeile) : 

+ IF lines (list file) > 4000 

+  THEN file number INCR 1 ; 

+       init list file 

+ FI ; 

+ putline (list file, zeile) ; 

+ IF echo 

+  THEN putline (zeile) 

+ FI 

+ENDPROC list line ; 

+ 

+PROC disass object : 

+ TEXT VAR object name ; 

+ INT VAR nth object , code address ; 

+ put ("Filename:") ; 

+ getline (filename) ; 

+ filenumber := 0 ; 

+ end address := 0 ; 

+ REP 

+  clear error ; 

+  enablestop ; 

+  page ; 

+  put ("Name des zu Disassemblierenden Objekts:") ; 

+  getline (object name) ; 

+  changeall(object name, " ", "") ; 

+  putline ("Bitte Gewuenschtes Objekt von vorne an abzaehlen und ESC q druecken.") ; 

+  pause (5) ; 

+  disablestop ; 

+  help (object name) ; 

+ UNTIL NOT iserror PER ; 

+ enablestop ; 

+ page ; 

+ put ("Nummer des Objekts:") ; 

+ get (nth object) ; 

+ code address := code start (object name, nth object) ; 

+ lbas := -1 ;

+ disass 0 code (code segment, code address, PROC (TEXT CONST) list line) ; 

+ edit (filename + ".0") 

+ENDPROC disass object ; 

+ 

+PROC disass module nr : 

+ INT VAR mod nr , code address ; 

+ end address := 0 ; 

+ put ("Filename:") ; 

+ getline (filename) ; 

+ filenumber := 0 ; 

+ page ; 

+ put ("Modulnummer:") ; 

+ get (mod nr) ; 

+ code address := code start (mod nr) ; 

+ lbas := -1 ;

+ IF code address = -1 

+  THEN putline ("Unbelegte Modulnummer") 

+  ELSE disass 0 code (code segment, code address, PROC (TEXT CONST) listline) ; 

+       edit (filename + ".0") 

+ FI 

+ENDPROC disass module nr ; 

+ 

+PROC disass address : 

+ INT VAR code segment, code address ; 

+ TEXT VAR eingabe ; 

+ put ("Filename:") ; 

+ getline (filename) ; 

+ file number := 0 ; 

+ page ; 

+ put ("Code Segment (2 o. 3):") ; 

+ get (code segment) ; 

+ put ("Startadresse (Hex)   :") ; 

+ getline (eingabe) ; 

+ code address := integer (eingabe) ; 

+ put ("Endadresse   (Hex)   :") ; 

+ getline (eingabe) ; 

+ end address := integer (eingabe) ; 

+ lbas := -1 ;

+ disass 0 code (code segment, code address, PROC (TEXT CONST) listline) ; 

+ edit (filename + ".0") 

+ENDPROC disass address ; 

+ 

+FILE VAR list file ; 

+TEXT VAR file name ;

+INT VAR op data, 

+        file number , 

+        first module line := 200 , 

+        anzahl steuerzeichen, 

+        anzahl zeros, 

+        call data , 

+        long data, 

+        low, 

+        op1, 

+        op 2, 

+        word, 

+        ln := -1, 

+        end address := 0, 

+        high , 

+        data base := 0 ; 

+BOOL VAR echo, was bool result := FALSE ; 

+TEXT VAR code words := "" , 

+         segment 2 modules, 

+         segment 2 adresses, 

+         segment 3 modules,

+         segment 3 adresses;

+ 

+TEXT PROC opcode : 

+ TEXT VAR temp := "  " ; 

+ word := get word (segment, address) ; 

+ op1 := (word AND 31744) DIV 1024 ; 

+ op2 := (word AND 768) DIV 128 ; 

+ low := word AND 255 ; 

+ ln := -1 ; 

+ replace (temp, 1, address) ; 

+ high := code (temp SUB 2) ; 

+ op data := word AND -31745 ; 

+ long data := (word AND 768) * 2 + (word AND 255) ; 

+ call data := word AND 1023 ; 

+ IF word < 0 

+    THEN IF word = -3 

+            THEN LEAVE opcode WITH "Block unlesbar" 

+         ELIF word = -1 

+            THEN LEAVE opcode WITH "" 

+         ELSE long data INCR 256 ; 

+              op2 INCR 1 ; 

+              call data INCR 1024 

+         FI 

+ FI ;

+ IF op1 = 31 AND op2 = 7 

+    THEN op1 := (word AND 127) DIV 4 ; 

+         op2 := (word AND 3) * 2 ; 

+         low := -1 ; 

+         long data := next word ; 

+         call data := long data ; 

+         op data := long data ; 

+         IF (word AND 128) = 128 THEN op2 INCR 1 FI ;

+         "LONGA  " + opc 

+    ELSE opc 

+ FI . 

+ENDPROC opcode ; 

+ 

+TEXT PROC opc : 

+ BOOL CONST previous bool result :: was bool result ; 

+ was bool result := FALSE ; 

+ SELECT op1 OF 

+  CASE  0 : process ln 

+  CASE  1 : process ln long 

+  CASE  2 : "MOV    " + two params   (6,6)

+  CASE  3 : "INC1   " + one param    (1)

+  CASE  4 : "DEC1   " + one param    (1)

+  CASE  5 : "INC    " + two params   (1,1)

+  CASE  6 : "DEC    " + two params   (1,1)

+  CASE  7 : "ADD    " + three params (1,1,1)

+  CASE  8 : "SUB    " + three params (1,1,1)

+  CASE  9 : "CLEAR  " + one param    (6)

+  CASE 10 : was bool result := TRUE ; "TEST   " + one param    (6)

+  CASE 11 : was bool result := TRUE ; "EQU    " + two params   (1,1)

+  CASE 12 : was bool result := TRUE ; "LSEQ   " + two params   (1,1)

+  CASE 13 : "FMOV   " + two params   (2,2)

+  CASE 14 : "FADD   " + three params (2,2,2)

+  CASE 15 : "FSUB   " + three params (2,2,2)

+  CASE 16 : "FMULT  " + three params (2,2,2)

+  CASE 17 : "FDIV   " + three params (2,2,2)

+  CASE 18 : was bool result := TRUE ; "FLSEQ  " + two params   (2,2)

+  CASE 19 : "TMOV   " + two params   (3,3)

+  CASE 20 : was bool result := TRUE ; "TEQU   " + two params   (3,3)

+  CASE 21 : was bool result := TRUE ; "ULSEQ  " + two params   (1,1)

+  CASE 22 : process accds 

+  CASE 23 : "REF    " + two params   (0,0)

+  CASE 24 : process subs 

+  CASE 25 : process sel 

+  CASE 26 : "PPV    " + one param    (0)

+  CASE 27 : "PP     " + one param    (0)

+  CASE 28 : process br

+  CASE 29 : process brlong 

+  CASE 30 : "CALL   " + process module nr (call data, FALSE) 

+  OTHERWISE op 31 

+ ENDSELECT .

+ 

+process ln : 

+ IF previous bool result 

+    THEN "BT     " + branch address 

+    ELSE ln := long data ; 

+         "LN     " + text (long data) 

+ FI . 

+ 

+process ln long : 

+ long data INCR 2048 ;

+ IF previous bool result 

+    THEN "BTLONG " + branch address

+    ELSE ln := long data ; 

+         "LNLONG " + text (long data) 

+ FI . 

+ 

+process br : 

+  IF previous bool result

+     THEN "BF     " + branch address 

+     ELSE "BR     " + branch address 

+  FI . 

+ 

+process brlong : 

+ long data INCR 2048 ; 

+ IF previous bool result 

+    THEN "BFLONG " + branch address 

+    ELSE "BRLONG " + branch address 

+ FI . 

+ 

+process accds : 

+ "ACCDS  (DSid:" + hex16 (op data) + denoter (opdata, 8) + ", BOUND-Result:" + 

+  params ("0") . 

+ 

+process subs : 

+ INT CONST elem len :: long data, limit1 :: next word, index :: next word, 

+           base :: next word, result :: next word ; 

+ "SUBS   (Elem.len:" + text (elem len) + ", Limit:" + text (limit1 + 1) + 

+ ", Index:" + hex16 (index) + denoter (index, 1) + ", Base:" + hex16 (base) + 

+ ", Result:" + hex16 (result) + denoter (result, 0) + ")". 

+ 

+process sel : 

+ INT CONST offset :: next word, result1 :: next word ; 

+ "SEL    (Base:" + hex16 (op data) + ", Offset:" + hex16 (offset) + 

+ ", Result:" + hex16 (result1) + denoter (result1, 0) + ")". 

+ 

+op31 : 

+SELECT op 2 OF 

+ CASE 0 : was bool result := TRUE ; 

+          "IS     (""" + code (low) + """, " + params ("0") (* 7C *) 

+ CASE 1 : "STIM   (" + hex8  (low) + ", " + params ("6")    (* FC *)

+ CASE 2 : "MOVX   (" + hex8  (low) + ", " + params ("66")   (* 7D *)

+ CASE 3 : "PUTW   (" + hex8  (low) + ", " + params ("77")   (* FD *) 

+ CASE 4 : "GETW   (" + hex8  (low) + ", " + params ("77")   (* 7E *)

+ CASE 5 : data base := ((""0"" + code (low)) ISUB 1) ; 

+          "PENTER (" + hex8 (low) +")"                      (* FE *)

+ CASE 6 : "ESC    " + esc code                              (* 7F *) 

+ OTHERWISE"???????"                                         (* FF *)

+ENDSELECT . 

+ 

+ENDPROC opc ; 

+ 

+TEXT PROC branch address : 

+ INT VAR branch byte := long data DIV 256 ; 

+ branch byte := (branch byte + high) AND 15 + (high AND 240) ; 

+ hex8 (branch byte) + hex8 (long data AND 255) 

+ENDPROC branch address ; 

+ 

+INT PROC next word : 

+ arith 16 ; 

+ address INCR 1 ; 

+ arith 15 ; 

+ INT CONST w :: get word (segment, address) ; 

+ codewords CAT hex16 (w) + " " ; 

+ w

+ENDPROC next word ; 

+ 

+TEXT PROC one param (INT CONST type) : 

+ "(" + hex16 (op data) + denoter (op data, type) + ")"

+ENDPROC one param ; 

+ 

+TEXT PROC three params (INT CONST type a, type b, type c) : 

+ INT CONST word b :: next word, word c :: next word ; 

+ "(" + hex16 (op data) + denoter (op data, type a) + ", " + 

+       hex16 (word b) + denoter (word b, type b) + ", " + 

+       hex16 (word c) + denoter (word c, type c) + ")" 

+ENDPROC three params ; 

+ 

+TEXT PROC two params (INT CONST type a, type b) : 

+ INT CONST word b :: next word ; 

+ "(" + hex16 (op data) + denoter (op data, type a) + ", " + 

+       hex16 (word b) + denoter (word b, type b) + ")" 

+ENDPROC two params ; 

+ 

+TEXT PROC denoter (INT CONST offset, type) : 

+ IF offset < 0 AND lbas = -1 THEN LEAVE denoter WITH " <LOCAL>" 

+ ELIF type = 7 THEN LEAVE denoter WITH "" 

+ ELIF type >= 2 AND type <= 5 OR type = 8 THEN 

+      LEAVE denoter WITH " <" + 

+                    data object (offset, data base, type) + ">" 

+ FI ; 

+ INT VAR i, byte, word1, word ; 

+ IF offset < 0 

+    THEN word := get word (local data segment, (offset AND 32767) ADD lbas) 

+    ELSE word := get word (packet data segment, data base ADD offset) 

+ FI ;

+ TEXT VAR x, t := " <" + hex16 (word) ; 

+ IF address < first elan address 

+    THEN IF word >= begin of stringtable CAND word <= end of nametable 

+            THEN string pointer 

+         ELIF word > 9 AND word < 32 

+            THEN t CAT ":""""" + text (word) + """"""

+         ELIF word >= 32 AND word < 127 

+            THEN t CAT ":""" + code (word) + """" 

+         FI ; 

+ FI ; 

+ IF type = 0 COR type = 6 

+   THEN BOOL VAR text sinnvoll := FALSE ,

+                 real sinnvoll := FALSE ,

+                 bool sinnvoll := word = -1 OR word = 0 OR word = 1 ; 

+        IF type = 0 

+           THEN IF offset < 0 

+                   THEN word1 := get word (local data segment, 

+                                 lbas ADD (offset AND 32767) ADD 1) 

+                   ELSE word1 := get word (packet data segment, 

+                                 data base ADD offset ADD 1) ; 

+                FI ; 

+                text sinnvoll := keine steuerzeichen AND (word1 AND 255) < 80 ; 

+                real sinnvoll := vorzeichen ok AND nur digits 

+        FI ; 

+        try type 

+ FI ; 

+ t + ">" . 

+ 

+string pointer : 

+ IF word >= begin of name table 

+    THEN word INCR 2 

+ FI ; 

+ IF (cdbint (word) AND 255) < 100 

+    THEN x := cdbtext (word) ; 

+         IF pos (x, ""0"", ""31"", 1) = 0 CAND 

+            pos (x, ""127"", ""213"", 1) = 0 CAND 

+            pos (x, ""220"", code (255), 1) = 0

+            THEN t CAT ":""" ; 

+                 t CAT x ; 

+                 t CAT """" 

+         FI 

+ FI . 

+ 

+try type : 

+ IF bool sinnvoll 

+    THEN t CAT ":" ; 

+         t CAT data object (offset, data base, 4) 

+ FI ; 

+ IF real sinnvoll 

+    THEN t CAT ":" ; 

+         t CAT x 

+ FI ; 

+ IF text sinnvoll 

+    THEN t CAT ":" ; 

+         t CAT text result 

+ FI . 

+ 

+keine steuerzeichen : 

+ TEXT VAR text result := data object (offset, data base, 3) ;

+ anzahl steuerzeichen < 4 AND anzahl zeros < 2 AND word1 <> -1 . 

+ 

+vorzeichen ok : 

+ (word AND 240) = 0 OR (word AND 240) = 128 . 

+ 

+nur digits : 

+ IF (word AND 15) > 9 THEN FALSE 

+ ELSE x := data object (offset, data base, 2) ; 

+      FOR i FROM 2 UPTO 7 REP 

+       byte := code (x SUB i) ; 

+       IF (byte AND 240) > 249 OR (byte AND 15) > 9 

+          THEN LEAVE nur digits WITH FALSE 

+       FI 

+      PER ; 

+      TRUE 

+ FI . 

+ 

+ENDPROC denoter ; 

+ 

+TEXT PROC esc code : 

+ SELECT low OF 

+  CASE 0  : "RTN " 

+  CASE 1  : "RTNT " 

+  CASE 2  : "RTNF " 

+  CASE 3  : "REPTXT?"

+  CASE 4  : "TERM "

+  CASE 5  : "??????" 

+  CASE 6  : "KE " 

+  CASE 7  : "??????" 

+  CASE 8  : "CRD (" + params ("11")

+  CASE 9  : "BCRD (" + params ("11")

+  CASE 10 : "CWR (" + params ("111")

+  CASE 11 : "ECWR (" + params ("111")

+  CASE 12 : "CTT (" + params ("01") 

+  CASE 13 : was bool result := TRUE ; "GETC (" + params ("311")

+  CASE 14 : was bool result := TRUE ; "FNONBL (" + params ("131")

+  CASE 15 : "DREM256 (" + params ("11")

+  CASE 16 : "AMUL256 (" + params ("11")

+  CASE 17 : "??????" 

+  CASE 18 : was bool result := TRUE ; "ISDIG (" + params ("1")

+  CASE 19 : was bool result := TRUE ; "ISLD (" + params ("1")

+  CASE 20 : was bool result := TRUE ; "ISLCAS (" + params ("1")

+  CASE 21 : was bool result := TRUE ; "ISUCAS (" + params ("1")

+  CASE 22 : "GADDR (" + params ("111") 

+  CASE 23 : was bool result := TRUE ; "GCADDR (" + params ("111") 

+  CASE 24 : was bool result := TRUE ; "ISSHA (" + params ("1")

+  CASE 25 : "SYSGEN " 

+  CASE 26 : "GETTAB " 

+  CASE 27 : "PUTTAB " 

+  CASE 28 : "ERTAB " 

+  CASE 29 : "EXEC " + process module nr (next word, FALSE)

+  CASE 30 : "PPROC " + process module nr (next word, FALSE) 

+  CASE 31 : "PCALL (" + params ("1")

+  CASE 32 : "CASE (" + params ("17")

+  CASE 33 : "MOVXX (" + params ("700") 

+  CASE 34 : "ALIAS (" + params ("088")

+  CASE 35 : "MOVIM (" + params ("76")

+  CASE 36 : was bool result := TRUE ; "FEQU (" + params ("22") 

+  CASE 37 : was bool result := TRUE ; "TLSEQ (" + params ("33")

+  CASE 38 : "FCOMPL (" + params ("22")

+  CASE 39 : "COMPL (" + params ("11")

+  CASE 40 : "IMULT (" + params ("111")

+  CASE 41 : "MULT (" + params ("111") 

+  CASE 42 : "DIV (" + params ("111")

+  CASE 43 : "MOD (" + params ("111")

+  CASE 44 : "ISUB (" + params ("311")

+  CASE 45 : "replace (" + params ("311")

+  CASE 46 : "code (" + params ("31")

+  CASE 47 : "code (" + params ("13")

+  CASE 48 : "SUB (" + params ("313")

+  CASE 49 : "subtext (" + params ("3113")

+  CASE 50 : "subtext (" + params ("313")

+  CASE 51 : "replace (" + params ("313")

+  CASE 52 : "CAT (" + params ("33")

+  CASE 53 : "length (" + params ("31")

+  CASE 54 : "pos (" + params ("331")

+  CASE 55 : "pos (" + params ("3311")

+  CASE 56 : "pos (" + params ("33111")

+  CASE 57 : "stranalyze (" + params ("1113111") 

+  CASE 58 : "pos (" + params ("33311")

+  CASE 59 : "??????" 

+  CASE 60 : "out (" + params ("3")

+  CASE 61 : "cout (" + params ("1")

+  CASE 62 : "outsubtext (" + params ("31")

+  CASE 63 : "outsubtext (" + params ("311")

+  CASE 64 : "inchar (" + params ("3")

+  CASE 65 : "incharety (" + params ("3")

+  CASE 66 : "pause (" + params ("1")

+  CASE 67 : "getcursor (" + params ("11")

+  CASE 68 : "catinput (" + params ("33")

+  CASE 69 : "nilspace (" + params ("8")

+  CASE 70 : ":= DD (" + params ("88")

+  CASE 71 : "forget (" + params ("8")

+  CASE 72 : "typeDI (" + params ("81")

+  CASE 73 : "ItypeD (" + params ("81")

+  CASE 74 : "heapsize (" + params ("81")

+  CASE 75 : "enablestop " 

+  CASE 76 : "disablestop " 

+  CASE 77 : "seterrorstop (" + params ("1")

+  CASE 78 : was bool result := TRUE ; "iserror " 

+  CASE 79 : "clearerror " 

+  CASE 80 : "IpcbI (" + params ("11")

+  CASE 81 : "pcbII (" + params ("11")

+  CASE 82 : "setclock (" + params ("52")

+  CASE 83 : "??????" 

+  CASE 84 : "control (" + params ("1111")

+  CASE 85 : "blockout (" + params ("81111")

+  CASE 86 : "blockin (" + params ("81111")

+  CASE 87 : "nextdspage (" + params ("811")

+  CASE 88 : "IpagesDT (" + params ("851")

+  CASE 89 : "storage (" + params ("11")

+  CASE 90 : "sysop (" + params ("1")

+  CASE 91 : "ARITH15 " 

+  CASE 92 : "ARITH16 " 

+  CASE 93 : "heapsize (" + params ("1")

+  CASE 94 : "collectheapgarbage " 

+  CASE 95 : "??????" 

+  CASE 96 : "FSLD (" + params ("121")

+  CASE 97 : "GEXP (" + params ("21")

+  CASE 98 : "SEXP (" + params ("12")

+  CASE 99 : "floor (" + params ("22")

+  CASE 100: "RSUB (" + params ("312")

+  CASE 101: "replace (" + params ("312")

+  CASE 102: "clock (" + params ("12")

+  CASE 103: "setclock (" + params ("2")

+  CASE 104: "pcb (" + params ("511")

+  CASE 105: "pcb (" + params ("511")

+  CASE 106: "clock (" + params ("52")

+  CASE 107: "status (" + params ("51")

+  CASE 108: "unblock (" + params ("5")

+  CASE 109: "block (" + params ("5")

+  CASE 110: "haltprocess (" + params ("5")

+  CASE 111: "createprocess (" + params ("55")

+  CASE 112: "eraseprocess (" + params ("5")

+  CASE 113: "send (" + params ("5181")

+  CASE 114: "wait (" + params ("518")

+  CASE 115: "call (" + params ("5181")

+  CASE 116: "cdbint (" + params ("11")

+  CASE 117: "cdbtext (" + params ("13")

+  CASE 118: "nextactive (" + params ("1")

+  CASE 119: "PW (" + params ("111")

+  CASE 120: "GW (" + params ("111")

+  CASE 121: "XOR (" + params ("111")

+  CASE 122: "pingpong (" + params ("5181")

+  CASE 123: was bool result := TRUE ; "exists (" + params ("5")

+  CASE 124: "AND (" + params ("111") 

+  CASE 125: "OR (" + params ("111")

+  CASE 126: "session (" + params ("1")

+  CASE 127: "send (" + params ("55181")

+  CASE 128: "definecollector (" + params ("5")

+  CASE 129: "id (" + params ("11")

+  OTHERWISE "??????" 

+ ENDSELECT . 

+ 

+ENDPROC esc code ; 

+ 

+TEXT PROC params (TEXT CONST types) : 

+ INT VAR i , word ; 

+ TEXT VAR t := "" ; 

+  FOR i FROM 1 UPTO LENGTH types REP 

+   word := next word ; 

+   t CAT hex16 (word) ; 

+   t CAT denoter (word, int (types SUB i)) ; 

+   IF i <> LENGTH types THEN t CAT ", " FI 

+ PER ; 

+ t + ") " . 

+ 

+ENDPROC params ; 

+ 

+PROC init module tables : 

+ INT VAR i, j ; 

+ TEXT VAR t := "  " ; 

+ segment 2 modules := "" ; 

+ segment 2 adresses := ""0"" ; 

+ segment 3 modules := "" ; 

+ segment 3 adresses := ""0"" ; 

+ i := -1 ; 

+ REP 

+  i INCR 1 ; 

+  cout (i) ;

+  j := getword (0, i + 512) ; 

+  IF j <> -1 CAND i <> 216 CAND i <> 217 

+   THEN replace (t, 1, i) ; 

+        segment 2 modules CAT t ;

+        replace (t, 1, j) ;

+        segment 2 adresses CAT t + ""0""

+  ELIF i < 256 

+   THEN i := 255 

+  ELIF i < 320 

+   THEN i := 319

+  FI 

+ UNTIL j = -1 CAND i > 320 PER ; 

+ FOR i FROM 1280 UPTO 2047 REP 

+  cout (i) ;

+  j := getword (0, i + 512) ; 

+  IF j <> -1 

+   THEN replace (t, 1, i) ; 

+        segment 3 modules CAT t ; 

+        replace (t, 1, j) ; 

+        segment 3 adresses CAT t + ""0"" 

+  FI 

+ UNTIL j = -1 PER 

+ENDPROC init module tables ; 

+ 

+TEXT PROC process module nr (INT CONST module number, BOOL CONST is packet) : 

+ TEXT VAR object specification , mod nr := text (module number, 5) ; 

+ IF module number < 0 

+ THEN IF lbas = -1 

+         THEN "LOCAL PROC" 

+         ELSE "LOCAL:" + process module nr (getword (local data segment, lbas + (module number AND 32767)), is packet) 

+      FI

+ ELSE 

+ INT VAR code address := code start (module number) ; 

+ IF one of compilers own module numbers 

+    THEN object specification := "CDL" 

+ ELIF elan defined internal

+    THEN SELECT module number OF 

+          CASE 256 : object specification := "compiler (INT CONST, FILE VAR, TEXT CONST, INT VAR, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST)"

+          CASE 257 : object specification := "outtext (TEXT CONST, INT CONST)" 

+          CASE 258 : object specification := "outline (INT CONST)" 

+          CASE 259 : object specification := "syntaxerror (TEXT CONST)" 

+          CASE 260 : object specification := ":= (FILE VAR, FILE CONST)" 

+         ENDSELECT 

+ ELIF exists sorted module number table 

+    THEN object specification := binary search (module number, is packet) 

+ ELIF exists unsorted module number table 

+    THEN FILE VAR f := sequentialfile (modify, "table.hash") ; 

+    to firstrecord (f) ; 

+    WHILE NOT eof (f) CAND subtext (f, 33, 37) <> mod nr REP 

+      cout (lineno (f)) ; 

+      down (f) 

+    PER ; 

+    IF eof (f) AND subtext (f, 33, 37) <> mod nr THEN 

+       IF is packet 

+          THEN object specification := "Paketinitialisierung" 

+          ELSE object specification := "Hidden PROC/OP" 

+       FI 

+    ELSE object specification := compress (subtext (f, 1, 15)) + 

+         specifications (begin of permanent table + int (subtext (f, 22, 25))) 

+    FI 

+ ELIF no elan module number 

+      THEN object specification := "Objekt ohne Modulnummer!" 

+ FI ; 

+  was bool result := pos (object specification , "--> BOOL") <> 0 ; 

+  text (module number) + " $" + hex8 (code segment) + 

+  hex16 (code address) + "  " + object specification 

+ FI . 

+ 

+one of compilers own module numbers : 

+ module number < 256 . 

+ 

+elan defined internal : 

+ module number > 255 AND module number < 261 . 

+ 

+exists sorted module number table : 

+ exists ("table.module") AND module number > 319 . 

+ 

+exists unsorted module number table: 

+ exists ("table.hash") AND module number > 319 . 

+ 

+no elan module number : 

+ module number < 320 . 

+ 

+ENDPROC process module nr ; 

+ 

+TEXT PROC binary search (INT CONST nr, BOOL CONST is packet) : 

+ TEXT VAR record , text nr := text (nr, 5) ; 

+ INT VAR first line, last line , mid , i ;

+ FILE VAR f := sequentialfile (modify, "table.module") ; 

+ first line := first module line ; 

+ last line := lines (f) ; 

+ REP 

+  mid := (first line + last line) DIV 2 ; 

+  to line (f, mid) ; 

+  IF text nr > subtext (f, 33, 37) THEN first line := mid + 1 

+  ELSE last line := mid 

+  FI 

+ UNTIL first line = last line PER ; 

+ to line (f, first line) ;

+ IF subtext (f, 33, 37) = text nr 

+    THEN record := compress (subtext (f, 1, 15)) + 

+      specifications (begin of permanent table + int (subtext (f, 22, 25))) 

+    ELSE is hidden module 

+ FI ; 

+ record . 

+ 

+is hidden module: 

+ IF NOT is packet 

+    THEN to line (f, first line - 1) 

+ FI ; 

+ FOR i FROM int (subtext (f, 22, 25)) + begin of permanent table DOWNTO begin of permanent table 

+  WHILE cdbint (i) <> -2 REP PER ; 

+ IF i <= begin of permanent table 

+    THEN IF is packet 

+            THEN record := "Paketinitialisierung" 

+            ELSE record := "Hidden PROC/OP" 

+         FI 

+    ELSE IF is packet 

+            THEN record := "Paketinitialisierung: " + 

+                           cdbtext (cdbint (i + 1) + 2) 

+            ELSE record := "Hidden PROC/OP (Packet " +

+                           cdbtext (cdbint (i + 1) + 2) + ")" 

+         FI 

+ FI . 

+ 

+ENDPROC binary search ; 

+ 

+TEXT PROC data object (INT CONST address, data base, denoter type) : 

+ TEXT VAR t , result ; 

+ INT VAR i , laenge , zeichen, index, version, segment, new address ; 

+ IF address < 0 AND lbas = -1 

+    THEN LEAVE data object WITH "LOCAL" 

+ ELIF address < 0

+    THEN segment := local data segment ; 

+         new address := (address AND 32767) ADD lbas 

+ ELSE segment := packet data segment ; 

+      new address := data base ADD address 

+ FI ; 

+ SELECT denoter type OF 

+  CASE 1 : int  denoter

+  CASE 2 : real denoter 

+  CASE 3 : text denoter 

+  CASE 4 : bool denoter 

+  CASE 5 : task denoter

+  CASE 8 : dataspace denoter

+  OTHERWISE "DENOTERTYPE(" + text (denoter type) + ")?" 

+ ENDSELECT . 

+ 

+bool denoter : 

+ IF get word (segment, new address) = 0 

+    THEN "TRUE" 

+    ELSE "FALSE" 

+ FI . 

+ 

+int denoter : 

+ hex16 (get word (segment, new address)) . 

+ 

+real denoter : 

+ t := "12345678" ; 

+ FOR i FROM 0 UPTO 3 REP 

+  replace (t, i + 1, get word (segment, new address ADD i)) 

+ PER ; 

+ disablestop ; 

+ t := text (t RSUB 1) ; 

+ IF iserror THEN clearerror ; 

+                 enablestop ; 

+                 "9.999999999999e126" 

+ ELSE enablestop ; 

+      t 

+ FI . 

+ 

+text denoter : 

+ t := copied text var (segment, new address) ; 

+ result := "" ; 

+ anzahl steuerzeichen := 0 ; 

+ anzahl zeros := 0 ; 

+ FOR i FROM 1 UPTO length (t) REP 

+  zeichen := code (t SUB i) ; 

+  IF zeichen = 34 THEN result CAT """""" 

+  ELIF zeichen = 251 OR zeichen > 31 AND zeichen < 127 OR 

+       zeichen > 213 AND zeichen < 224 THEN result CAT code (zeichen) 

+  ELSE result CAT """" ; 

+       result CAT text (zeichen) ; 

+       result CAT """" ; 

+       anzahl steuerzeichen INCR 1 ; 

+       IF zeichen = 0 

+          THEN anzahl zeros INCR 1 

+       FI 

+  FI 

+ PER ; 

+ """" + result + """" . 

+ 

+task denoter : 

+ index := get word (segment, new address) ; 

+ version := get word (segment, new address ADD 1)  ; 

+ hex16 (index) + " " + hex16 (version) + ":" + taskname (index, version) . 

+ 

+dataspace denoter : 

+ result := "  " ; 

+ replace (result, 1, get word (segment, new address)) ; 

+ TEXT CONST two bytes :: hex8 (code (result SUB 2)) + " " + 

+                         hex8 (code (result SUB 1)) ; 

+ IF result = ""255""255"" 

+    THEN two bytes + ":Not Init"

+ ELIF result = ""0""0"" 

+    THEN two bytes + ":nilspace" 

+ ELSE two bytes + ":" + taskname (code (result SUB 2), -1) 

+ FI . 

+ENDPROC data object ; 

+ 

+TEXT PROC copied text var (INT CONST segment, address) : 

+ TEXT VAR result ; 

+ INT VAR i, laenge ; 

+ result := "  " ; 

+ replace (result, 1, getword (segment, address ADD 1)) ; 

+ laenge := code (result SUB 1) ;

+ IF laenge = 0 

+    THEN "" 

+ ELIF laenge = 255

+    THEN INT CONST basis :: -32765 ADD (getword (segment, address)-3) DIV 2 ;

+         laenge := ((result SUB 2) + code ((getword (segment, address

+                                    ADD 2) AND 255))) ISUB 1 ;

+         result := "" ; 

+         FOR i FROM 1 UPTO laenge DIV 2 REP 

+          result CAT "  " ; 

+          replace (result, i, getword (1, basis + i -1)) 

+         PER ; 

+         IF LENGTH result <> laenge 

+            THEN result CAT code (getword (1, basis + laenge DIV 2)) 

+         FI ; 

+         result 

+    ELSE TEXT CONST first char :: result SUB 2 ; 

+         result := "" ; 

+         FOR i FROM 1 UPTO (laenge-1) DIV 2 REP 

+          result CAT "  " ; 

+          replace (result, i, getword (segment, address ADD (i + 1))) ; 

+         PER ; 

+         IF LENGTH result + 1 <> laenge 

+            THEN first char + result + code (getword (segment, address ADD 

+                 ((laenge-1) DIV 2 + 2)) AND 255) 

+            ELSE first char + result 

+         FI 

+ FI 

+ENDPROC copied text var ; 

+ 

+TEXT PROC task name (INT CONST id, vers) : 

+ TEXT VAR result ; 

+ DATASPACE VAR ds := nilspace ; 

+ BOUND STRUCT (INT index, version) VAR t1 := ds ; 

+ BOUND TASK VAR t2 := ds ; 

+ IF id = 0 

+   THEN result := "niltask" 

+   ELSE t1.index := id AND 255 ; 

+        IF vers = -1 

+           THEN t1.version := 0 ; 

+                t1.version := pcb (t2, 10) 

+           ELSE t1.version := vers 

+        FI ; 

+        disablestop ; 

+        IF exists (t2) 

+           THEN result := """" + name (t2) + """" 

+           ELSE result := "-" 

+        FI ; 

+ FI ; 

+ forget (ds) ; 

+ enable stop ; 

+ result 

+ENDPROC task name ; 

+ 

+INT PROC integer (TEXT CONST hex addr) : 

+ INT VAR i ; 

+ REAL VAR summe := 0.0 ; 

+ FOR i FROM 1 UPTO length (hex addr) REP 

+  summe := summe * 16.0 ; 

+  summe INCR real (digit) 

+ PER ; 

+ IF summe > 32767.0 THEN int (summe - 65536.0)

+ ELSE int (summe) 

+ FI. 

+ 

+digit : 

+ TEXT CONST char := hex addr SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ENDPROC integer ; 

+ 

+TEXT PROC hex8 (INT CONST wert) : 

+ hex digit (wert DIV 16) + 

+ hex digit (wert AND 15) 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex16 (INT CONST wert) :

+ TEXT VAR t := "  " ; 

+ replace (t, 1, wert) ; 

+ hex digit (code (t SUB 2) DIV 16) + 

+ hex digit (code (t SUB 2) AND 15) + 

+ hex digit (code (t SUB 1) DIV 16) + 

+ hex digit (code (t SUB 1) AND 15) 

+ENDPROC hex16 ;

+ 

+TEXT PROC hex digit (INT CONST wert) : 

+ IF wert < 10 THEN code (wert + 48) 

+ ELSE code (wert + 55) 

+ FI 

+ENDPROC hex digit ; 

+ 

+INT OP ADD (INT CONST left, right) : 

+ arith 16 ; 

+ INT CONST result :: left + right ; 

+ arith 15 ; 

+ result 

+ENDOP ADD ; 

+ 

+PROC disass0 : 

+TEXT VAR key ; 

+IF exists ("table.module") 

+   THEN FILE VAR f := sequentialfile (modify, "table.module") ; 

+        tofirstrecord (f) ; 

+        down (f, "  322 ") ; 

+        first module line := lineno (f) ; 

+FI ;

+REP

+ page ; 

+ putline ("++++++++++++++++++++++++   EUMEL0 - Code Disassembler   ++++++++++++++++++++") ; 

+ line (3) ; 

+ putline (" 0 ......... Ende") ; 

+ putline (" 1 ......... Objekt nach Name auswaehlen und disassemblieren") ; 

+ putline (" 2 ......... Nach Modulnummer auswaehlen und disassemblieren") ; 

+ putline (" 3 ......... Adressbereich disassemblieren") ; 

+ putline (" 4 ......... Denoter aus Staticarea (Segment 0) ausgeben") ; 

+ putline (" 5 ......... Codestart zur Modulnummer errechnen") ; 

+ putline (" 6 ......... Modultabelle ergaenzen") ;

+ line ; 

+ put ("Wahl:") ; 

+ REP inchar (key) UNTIL key >= "0" AND key <= "6" PER ; 

+ out (key) ; 

+ line (2) ; 

+ SELECT int (key) OF 

+  CASE 0 : LEAVE disass 0 

+  CASE 1 : disass object 

+  CASE 2 : disass module nr 

+  CASE 3 : disass address 

+  CASE 4 : put denoter

+  CASE 5 : convert module number 

+  CASE 6 : erweitere modul tabelle 

+ ENDSELECT

+PER . 

+ 

+erweitere modul tabelle : 

+ INT VAR i, j ;

+ key := "  " ; 

+ FOR i FROM LENGTH segment 3 modules DIV 2 + 1280 UPTO 2047 REP

+  cout (i) ;

+  j := get word (0, 512 + i) ; 

+  IF j <> -1 

+   THEN replace (key, 1, i) ; 

+        segment 3 modules CAT key ; 

+        replace (key, 1, j) ; 

+        segment 3 adresses CAT key + ""0"" ; 

+  FI 

+ UNTIL j = -1 PER. 

+ 

+convert module number : 

+ line (2) ; 

+ INT VAR mod nr ;

+ put ("Modulnummer:") ; 

+ get (mod nr) ; 

+ mod nr := code start (mod nr) ; 

+ IF mod nr = -1 

+  THEN putline ("Unbelegte Modulnummer") 

+  ELSE put ("Adresse:") ; put (hex16 (mod nr)) ; line ; 

+       put ("Segment:") ; put (code segment) ; line 

+ FI ;

+ putline ("- Taste -") ; 

+ pause. 

+ 

+put denoter : 

+ line (2) ; 

+ put ("PENTER(xx) in Hex:") ; 

+ getline (key) ; 

+ INT VAR base :: integer (key), typ ;

+ put ("Offset     in Hex:") ; 

+ getline (key) ; 

+ typ := integer (key) ; 

+ put ("TYPE (INT, REAL, TEXT, BOOL, TASK, DATASPACE):") ; 

+ getline (key) ; 

+ IF key = "INT" THEN typ := 1 

+ ELIF key = "REAL" THEN typ := 2 

+ ELIF key = "TEXT" THEN typ := 3 

+ ELIF key = "BOOL" THEN typ := 4 

+ ELIF key = "TASK" THEN typ := 5 

+ ELIF key = "DATASPACE" THEN typ := 8 

+ ELSE typ := 0

+ FI ; 

+ lbas := -1 ;

+ putline (data object (typ, (""0"" + code (base)) ISUB 1, typ)) ; 

+ putline ("- Taste -") ; 

+ pause . 

+ 

+ENDPROC disass 0 ; 

+ 

+init module tables ;

+disass 0 

+ 

+ENDPACKET eumel 0 code disassembler ; 

diff --git a/devel/misc/unknown/src/ASSEMBLE.ELA b/devel/misc/unknown/src/ASSEMBLE.ELA
new file mode 100644
index 0000000..7675dc4
--- /dev/null
+++ b/devel/misc/unknown/src/ASSEMBLE.ELA
@@ -0,0 +1,387 @@
+(***Assembler fuer 8080,8085,Z80***) 

+

+PROC regh:

+  IF pos(in,"A",4) = (pos(in,",")+1) THEN out(printer,"F");

+ELIF pos(in,"B",4) = (pos(in,",")+1) THEN out(printer,"8");

+ELIF pos(in,"C",4) = (pos(in,",")+1) THEN out(printer,"9");

+ELIF pos(in,"D",4) = (pos(in,",")+1) THEN out(printer,"A");

+ELIF pos(in,"E",4) = (pos(in,",")+1) THEN out(printer,"B");

+ELIF pos(in,"H",4) = (pos(in,",")+1) THEN out(printer,"C");

+ELIF pos(in,"L",4) = (pos(in,",")+1) THEN out(printer,"D");

+ELIF pos(in,"M",4) = (pos(in,",")+1) OR pos(in,"m") = (pos(in,",")+1)

+                                     THEN out(printer,"E") FI

+ENDPROC regh. 

+

+PROC regl:

+  IF pos(in,"A",4) > (pos(in,",")+0) THEN out(printer,"7");

+ELIF pos(in,"B",4) > (pos(in,",")+0) THEN out(printer,"0");

+ELIF pos(in,"C",4) > (pos(in,",")+0) THEN out(printer,"1");

+ELIF pos(in,"D",4) > (pos(in,",")+0) THEN out(printer,"2");

+ELIF pos(in,"E",4) > (pos(in,",")+0) THEN out(printer,"3");

+ELIF pos(in,"H",4) > (pos(in,",")+0) THEN out(printer,"4");

+ELIF pos(in,"L",4) > (pos(in,",")+0) THEN out(printer,"5");

+ELIF pos(in,"M",4) > (pos(in,",")+0) OR pos(in,"m") > (pos(in,",")+0)

+                                     THEN out(printer,"6") FI 

+ENDPROC regl. 

+                                                (*************************)

+                                                (*Autor:M.Staubermann    *)

+BOOL VAR ad,number,falsch;                      (*Version:1.2.2          *)

+ad:=FALSE;                                      (*Datum:7.12.82          *)

+number:=FALSE;                                  (*************************)

+falsch:=FALSE;

+INT VAR count,fehler;

+TEXT VAR hilf,in,startaddresse::"0000";

+hilf:=" ";

+count:=0;

+fehler:=0;

+hilf:=" ";

+commanddialogue(FALSE);

+forget("maschinencode");

+FILE VAR printer:=sequentialfile(output,"maschinencode");

+forget("assemb");

+FILE VAR ass:=sequentialfile(modify,"assemb");

+forget("errors");

+FILE VAR fehlerliste:=sequentialfile(output,"errors");

+commanddialogue(TRUE);

+line;

+putline("        gib assembler kommando :");

+putline("        edit");

+pause(10);

+edit("assemb");

+tofirstrecord(ass);

+putline("        gib assembler kommando :");

+putline("        debug");

+pause(10);

+line;

+put    ("       ");

+put(printer,"Line:  Add:  Code:");

+line(printer);

+hexbeginn;

+

+      REPEAT

+  fehler:=fehler+1;

+  out(printer,text(fehler,4));

+  cout(fehler);

+  out(printer,"  ");

+  hex;

+  readrecord(ass,in);

+  forward(ass);

+  out(printer,"  ");

+  IF pos(in,"NOP") > 0 THEN out(printer,"00");

+ELIF pos(in,"HLT") > 0 THEN out(printer,"76");

+ELIF compress(in)="DI" THEN out(printer,"F3");

+ELIF pos(in,"EI")  > 0 THEN out(printer,"FB");

+ELIF pos(in,"CMC") > 0 THEN out(printer,"3F");

+ELIF pos(in,"CMA") > 0 THEN out(printer,"2F");

+ELIF pos(in,"STC") > 0 THEN out(printer,"37");

+ELIF pos(in,"DAA") > 0 THEN out(printer,"27");

+ELIF pos(in,"RRC") > 0 THEN out(printer,"0F");

+ELIF pos(in,"RLC") > 0 THEN out(printer,"07");

+ELIF pos(in,"RAL") > 0 THEN out(printer,"17");

+ELIF pos(in,"RAR") > 0 THEN out(printer,"1F");

+ELIF pos(in,"XCHG")> 0 THEN out(printer,"EB");

+ELIF pos(in,"XTHL")> 0 THEN out(printer,"E3");

+ELIF pos(in,"SPHL")> 0 THEN out(printer,"F9"); 

+ELIF pos(in,"ADI") > 0 THEN out(printer,"C6");number:=TRUE;

+ELIF pos(in,"ACI") > 0 THEN out(printer,"CE");number:=TRUE;

+ELIF pos(in,"SUI") > 0 THEN out(printer,"D6");number:=TRUE;

+ELIF pos(in,"SBI") > 0 THEN out(printer,"DE");number:=TRUE;

+ELIF pos(in,"ANI") > 0 THEN out(printer,"E6");number:=TRUE;

+ELIF pos(in,"XRI") > 0 THEN out(printer,"EE");number:=TRUE;

+ELIF pos(in,"ORI") > 0 THEN out(printer,"F6");number:=TRUE;

+ELIF pos(in,"CPI") > 0 THEN out(printer,"FE");number:=TRUE;

+ELIF compress(in)="STA"THEN out(printer,"32");ad:=TRUE;

+ELIF compress(in)="LDA"THEN out(printer,"3A");ad:=TRUE;

+ELIF pos(in,"SHLD")> 0 THEN out(printer,"22");ad:=TRUE;

+ELIF pos(in,"LHLD")> 0 THEN out(printer,"2A");ad:=TRUE;

+ELIF pos(in,"PCHL")> 0 THEN out(printer,"E9");

+ELIF pos(in,"JMP") > 0 THEN out(printer,"C3");ad:=TRUE;

+ELIF pos(in,"JC")  > 0 THEN out(printer,"DA");ad:=TRUE;

+ELIF pos(in,"JNC") > 0 THEN out(printer,"D2");ad:=TRUE;

+ELIF pos(in,"JZ")  > 0 THEN out(printer,"CA");ad:=TRUE;

+ELIF pos(in,"JNZ") > 0 THEN out(printer,"C2");ad:=TRUE;

+ELIF compress(in)="JM" THEN out(printer,"FA");ad:=TRUE;

+ELIF compress(in)="JP" THEN out(printer,"F2");ad:=TRUE;

+ELIF pos(in,"JPE") > 0 THEN out(printer,"EA");ad:=TRUE;

+ELIF pos(in,"JPO") > 0 THEN out(printer,"E2");ad:=TRUE;

+ELIF pos(in,"CALL")> 0 THEN out(printer,"CD");ad:=TRUE;

+ELIF pos(in,"OUT") > 0 THEN out(printer,"D3");number:=TRUE; 

+ELIF pos(in,"CC")  > 0 THEN out(printer,"DC");ad:=TRUE;

+ELIF pos(in,"CNC") > 0 THEN out(printer,"D4");ad:=TRUE;

+ELIF pos(in,"CZ")  > 0 THEN out(printer,"CC");ad:=TRUE;

+ELIF pos(in,"CNZ") > 0 THEN out(printer,"C4");ad:=TRUE;

+ELIF pos(in,"CM")  > 0 THEN out(printer,"FC");ad:=TRUE;

+ELIF compress(in)="CP" THEN out(printer,"F4");ad:=TRUE;

+ELIF pos(in,"CPE") > 0 THEN out(printer,"EC");ad:=TRUE;

+ELIF pos(in,"CPO") > 0 THEN out(printer,"E4");ad:=TRUE;

+ELIF pos(in,"RET") > 0 THEN out(printer,"C9");

+ELIF pos(in,"RC")  > 0 THEN out(printer,"D8");

+ELIF pos(in,"RNC") > 0 THEN out(printer,"D0");

+ELIF pos(in,"RZ")  > 0 THEN out(printer,"C8");

+ELIF pos(in,"RNZ") > 0 THEN out(printer,"C0");

+ELIF pos(in,"RM")  > 0 THEN out(printer,"F8");

+ELIF compress(in)="RP" THEN out(printer,"F0");

+ELIF pos(in,"RPE") > 0 THEN out(printer,"E8");

+ELIF pos(in,"RPO") > 0 THEN out(printer,"E0");

+ELIF pos(in,"RST") > 0 AND pos(in,"0") > 3 THEN out(printer,"C7");

+ELIF pos(in,"RST") > 0 AND pos(in,"1") > 3 THEN out(printer,"CF");

+ELIF pos(in,"RST") > 0 AND pos(in,"2") > 3 THEN out(printer,"D7");

+ELIF pos(in,"RST") > 0 AND pos(in,"3") > 3 THEN out(printer,"DF");

+ELIF pos(in,"RST") > 0 AND pos(in,"4") > 3 THEN out(printer,"E7");

+ELIF pos(in,"RST") > 0 AND pos(in,"5") > 3 THEN out(printer,"EF");

+ELIF pos(in,"RST") > 0 AND pos(in,"6") > 3 THEN out(printer,"F7");

+ELIF pos(in,"RST") > 0 AND pos(in,"7") > 3 THEN out(printer,"FF");

+ELIF pos(in,"MOV") > 0 THEN 

+       IF pos(in,"A")   = (pos(in,",")-1) THEN out(printer,"7");regh;

+     ELIF pos(in,"B")   = (pos(in,",")-1) THEN out(printer,"4");regl;

+     ELIF pos(in,"C")   = (pos(in,",")-1) THEN out(printer,"4");regh;

+     ELIF pos(in,"D")   = (pos(in,",")-1) THEN out(printer,"5");regl;

+     ELIF pos(in,"E")   = (pos(in,",")-1) THEN out(printer,"5");regh;

+     ELIF pos(in,"H")   = (pos(in,",")-1) THEN out(printer,"6");regl;

+     ELIF pos(in,"L")   = (pos(in,",")-1) THEN out(printer,"6");regh;

+     ELIF pos(in,"M",4) = (pos(in,",")-1) OR pos(in,"m") = (pos(in,",")-1)

+                                          THEN out(printer,"4");regl FI;

+ELIF pos(in,"MVI") > 0 THEN 

+       IF pos(in,"A")   = (pos(in,",")-1) THEN out(printer,"3E");

+     ELIF pos(in,"B")   = (pos(in,",")-1) THEN out(printer,"06");

+     ELIF pos(in,"C")   = (pos(in,",")-1) THEN out(printer,"0E");

+     ELIF pos(in,"D")   = (pos(in,",")-1) THEN out(printer,"16");

+     ELIF pos(in,"E")   = (pos(in,",")-1) THEN out(printer,"1E");

+     ELIF pos(in,"H")   = (pos(in,",")-1) THEN out(printer,"26");

+     ELIF pos(in,"L")   = (pos(in,",")-1) THEN out(printer,"2E");

+     ELIF pos(in,"M",4) = (pos(in,",")-1) OR pos(in,"m") = (pos(in,",")-1)

+                                          THEN out(printer,"36") FI;

+ELIF pos(in,"LXI")    > 0 THEN ad:=TRUE;

+     IF pos(in,"B")   > 4 THEN out(printer,"01");ad:=TRUE; 

+     ELIF pos(in,"D") > 4 THEN out(printer,"11");ad:=TRUE;

+     ELIF pos(in,"H") > 4 THEN out(printer,"21");ad:=TRUE;

+     ELIF pos(in,"SP")> 4 THEN out(printer,"31");ad:=TRUE FI;

+ELIF pos(in,"PUSH")   > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"C5");

+     ELIF pos(in,"D") > 4 THEN out(printer,"D5");

+     ELIF pos(in,"H",5) > 4 THEN out(printer,"E5");

+     ELIF pos(in,"A") > 4 OR   pos(in,"PSW")> 4 THEN out(printer,"F5") FI;

+ ELIF pos(in,"POP")   > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"C1");

+     ELIF pos(in,"D") > 4 THEN out(printer,"D1");

+     ELIF pos(in,"H") > 4 THEN out(printer,"E1");

+     ELIF pos(in,"A") > 4 OR   pos(in,"PSW")> 4 THEN out(printer,"F1") FI;

+ELIF pos(in,"LDAX")   > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"0A");

+     ELIF pos(in,"D",5) > 4 THEN out(printer,"1A") FI;

+ELIF pos(in,"STAX")   > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"02");

+     ELIF pos(in,"D") > 4 THEN out(printer,"12") FI;

+ELIF pos(in,"INX")    > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"03");

+     ELIF pos(in,"D") > 4 THEN out(printer,"13");

+     ELIF pos(in,"H") > 4 THEN out(printer,"2A");

+     ELIF pos(in,"SP")> 4 THEN out(printer,"3A") FI;

+ELIF pos(in,"DCX")    > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"0B");

+     ELIF pos(in,"D",4)>4 THEN out(printer,"1B");

+     ELIF pos(in,"H") > 4 THEN out(printer,"2B");

+     ELIF pos(in,"SP")> 4 THEN out(printer,"3B") FI;

+ELIF pos(in,"DAD")    > 0 THEN 

+     IF pos(in,"B")   > 4 THEN out(printer,"09");

+     ELIF pos(in,"D",4)>4 THEN out(printer,"19");

+     ELIF pos(in,"H") > 4 THEN out(printer,"29");

+     ELIF pos(in,"SP")> 4 THEN out(printer,"39") FI;

+ELIF pos(in,"ADD")    > 0 THEN out(printer,"8");regl;

+ELIF pos(in,"ADC")    > 0 THEN out(printer,"8");regl;

+ELIF pos(in,"SUB")    > 0 THEN out(printer,"9");regl;

+ELIF pos(in,"SBB")    > 0 THEN out(printer,"9");regl;

+ELIF pos(in,"ANA")    > 0 THEN out(printer,"A");regl;

+ELIF pos(in,"XRA")    > 0 THEN out(printer,"A");regl;

+ELIF pos(in,"ORA")    > 0 THEN out(printer,"B");regl;

+ELIF pos(in,"CMP")    > 0 THEN out(printer,"B");regl;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"A")    > 4 THEN out(printer,"3C") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"B")    > 4 THEN out(printer,"04") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"C")    > 4 THEN out(printer,"0C") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"D")    > 4 THEN out(printer,"14") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"E")    > 4 THEN out(printer,"1C") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"H")    > 4 THEN out(printer,"24") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"L")    > 4 THEN out(printer,"2C") FI;

+ELIF pos(in,"INR")    > 0 THEN 

+     IFpos(in,"M")    > 4 OR pos(in,"m") > 4 THEN out(printer,"34") FI;

+ELIF pos(in, "IN")    > 0 THEN out(printer,"DB"); number:=TRUE;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"A")    > 4 THEN out(printer,"3D") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"B")    > 4 THEN out(printer,"05") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"C",4)  > 4 THEN out(printer,"0D") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"D",4)  > 4 THEN out(printer,"15") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"E")    > 4 THEN out(printer,"1D") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"H")    > 4 THEN out(printer,"25") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"L")    > 4 THEN out(printer,"2D") FI;

+ELIF pos(in,"DCR")    > 0 THEN 

+     IFpos(in,"M")    > 4 OR pos(in,"m") > 4 THEN out(printer,"35") FI;

+ELIF pos(in,"ORG")    > 0 THEN hilf:=compress(subtext(in,4,7));

+                         putline(printer,hilf);

+                         startaddresse:=hilf;

+                         hexbeginn;

+ELIF pos(in,"TITL")   > 0 THEN putline(printer,subtext(in,6));

+ELIF pos(in,"#")      > 0 THEN hilf:=subtext(in,pos(in,"#")+1);

+     out(printer,hilf) ;

+ELSE putline("Fehler erkannt in Zeile "+text(fehler)+" bei '"+in+"' !");

+     out(printer,in);

+     putline(fehlerliste,"Fehler in Zeile "+text(fehler)+" bei: "+in); 

+     count:=count+1;

+     falsch:=TRUE 

+FI;

+line(printer); 

+IF ad THEN ad:=FALSE;

+   fehler:=fehler+1;

+   out(printer,text(fehler,4));

+   cout(fehler);

+   out(printer,"  ");

+   hex;

+   out(printer,"  ");

+   IF pos(in,",") > 3 THEN hilf:=subtext(in,(pos(in,",")+1),(pos(in,",")+4));

+                           fehler:=fehler+1;

+                           out(printer,text(fehler,4));

+                           cout(fehler);

+                           out(printer,"  ");

+                           hex;

+                           out(printer,"  ");

+                           line(printer)

+                      ELSE hilf:=compress(subtext(in,10,15)) FI;

+                            fehler:=fehler+1;

+                            out(printer,text(fehler,4));

+                            cout(fehler);

+                            out(printer,"  ");

+                            hex;

+                            out(printer,"  ");

+                            out(printer,subtext(hilf,3,4));

+                            fehler:=fehler+1;

+                            out(printer,text(fehler,4));

+                            cout(fehler);

+                            out(printer,"  ");

+                            hex;

+                            out(printer,"  ");

+                            out(printer,subtext(hilf,1,2));

+                            line(printer);

+

+ELIF number THEN number:=FALSE;

+                 fehler:=fehler+1;

+                 out(printer,text(fehler,4));

+                 cout(fehler);

+                 out(printer,"  ");

+                 hex;

+                 out(printer,"  ");

+                 IF pos(in,",") > 2 THEN hilf:= subtext(in,

+                                         (pos(in,",") +1),(pos(in,",")+2));

+                                         out(printer,hilf);

+                                         line(printer)

+                 ELSE out(printer,compress(subtext(in,14,21)));

+                      line(printer) FI 

+FI ;

+

+UNTIL compress(in) = "END" OR compress(in) = "end" OR eof(ass) ENDREPEAT;

+

+  IF count<> 0 THEN putline(text(count)+" Fehler erkannt.");

+     falsch:=TRUE

+ELSE putline("  Keine Fehler, "+text(fehler)+" Zeilen.") ;

+     falsch:=FALSE 

+FI;

+putline(8*" "+7*"*"+"  ENDE DER UEBERSETZUNG  "+7*"*"+8*" ");

+pause(20);

+IF falsch THEN edit("errors","assemb") ELSE 

+edit("maschinencode") FI;

+IF yes("Maschinencodelisting") THEN print("maschinencode") FI;

+IF yes("runagain") THEN runagain FI.

+ 

+hexbeginn:

+(*Hexadezimalzaehler*)

+INT VAR a1,a2,a3,a4,subi;

+TEXT VAR a1t,a2t,a3t,a4t,subt,counter;

+a1t:=subtext(startaddresse,1,1);

+a2t:=subtext(startaddresse,2,2);

+a3t:=subtext(startaddresse,3,3);

+a4t:=subtext(startaddresse,4,4).

+

+hex:

+subt:=a1t;

+decoder; 

+a1:=subi;

+

+subt:=a2t;

+decoder;

+a2:=subi;

+ 

+subt:=a3t;

+decoder;

+a3:=subi;

+

+ 

+decoder;

+a4:=subi;

+

+zaehl;

+

+IF a4 = 16 THEN a4:=0;

+   a3:=a3+1 FI;

+

+IF a3 = 16 THEN a3:=0;

+   a2:=a2+1 FI;

+

+IF a2 = 16 THEN a2:=0;

+   a1:=a1+1 FI;

+

+IF a1 = 16 THEN a1:=0;

+   put(printer,"Storageoverflow !") FI;

+

+subi:=a1;

+encode;

+a1t:=subt;

+

+subi:=a2;

+encode;

+a2t:=subt;

+

+subi:=a3;

+encode;

+a3t:=subt;

+

+subi:=a4;

+encode;

+a4t:=subt;

+

+counter:=a1t;

+counter CAT a2t;

+counter CAT a3t;

+counter CAT a4t;

+put(printer,counter). 

+

+zaehl:

+a4:=a4+1.

+

+decoder:

+IF subt ="A" THEN subi:=10;

+ELIF subt ="B" THEN subi:=11;

+ELIF subt ="C" THEN subi:=12;

+ELIF subt ="D" THEN subi:=13;

+ELIF subt ="E" THEN subi:=14;

+ELIF subt ="F" THEN subi:=15 

+ELSE subi:=int(subt) FI.

+

+encode:

+IF subi = 10 THEN subt:="A";

+ELIF subi = 11 THEN subt:="B";

+ELIF subi = 12 THEN subt:="C";

+ELIF subi = 13 THEN subt:="D";

+ELIF subi = 14 THEN subt:="E";

+ELIF subi = 15 THEN subt:="F" 

+ELSE subt:=text(subi) FI.

diff --git a/devel/misc/unknown/src/COPYDS.ELA b/devel/misc/unknown/src/COPYDS.ELA
new file mode 100644
index 0000000..c0bd83c
--- /dev/null
+++ b/devel/misc/unknown/src/COPYDS.ELA
@@ -0,0 +1,294 @@
+LET systemanker = 2 ,      (* Wird bei 'blockin' durch 2 geteilt *) 

+    channel field = 4 ,

+    hg channel  = 0 ; 

+ 

+ROW 256 INT VAR block ;

+INT VAR return ; 

+ 

+PROC pcb (TASK CONST id, INT CONST field, value) : 

+ EXTERNAL 105 

+ENDPROC pcb ; 

+ 

+PROC copy ds (INT CONST task nr, ds nr, TEXT CONST destination) : 

+ DATASPACE VAR ds ; 

+ ROW 8 INT VAR dr eintrag ;

+ INT VAR old channel := channel, link, i, seite ; 

+ 

+ system channel ; 

+ zugriff ueber drdr ; 

+ IF ist nilspace 

+    THEN ds := nilspace 

+ ELIF ist kleindatenraum 

+    THEN lese kleindatenraum 

+ ELSE lese grossdatenraum 

+ FI ; 

+ user channel ; 

+ forget (destination, quiet) ; 

+ copy (ds, destination) ; 

+ forget (ds) . 

+ 

+user channel : 

+ disablestop ;

+ continue (old channel) ; 

+ IF iserror 

+    THEN forget (ds) ; 

+ FI ; 

+ enablestop . 

+ 

+system channel : 

+ break (quiet) ;                           (* Offiziell abmelden *)

+ pcb (myself, channel field, hg channel) . (* Inoffiziell anmelden *)

+ 

+zugriff ueber drdr : 

+ systemanker lesen ; 

+ drdr taskwurzel lesen ; 

+ drdr dataspacewurzel lesen . 

+ 

+erste seite im dreintrag : 

+ link := 8 * (dsnr MOD 32) + 1 ; 

+ FOR i FROM link UPTO link + 7 REP 

+  IF block (i) <> -1 

+     THEN LEAVE erste seite im dreintrag WITH i 

+  FI 

+ PER ; 

+ user channel ; 

+ errorstop ("Der Datenraum existiert nicht (DR-Eintrag = 8 mal FFFF)") ; 0 . 

+ 

+ist nilspace : 

+ block (erste seite im dreintrag) = -255 . 

+ 

+ist kleindatenraum : 

+ block (link) > -255 AND block (link) < 0 . 

+ 

+lese kleindatenraum : 

+ ds := nilspace ;

+ IF seite eins existiert 

+    THEN blockin (ds, 1, block (link + 1)) ; 

+         IF return <> 0 

+            THEN user channel ; 

+                 putline ("Warnung: Seite 1 des Datenraums nicht lesbar: " + 

+                            text (return)) ; 

+                 system channel 

+         FI 

+ FI ; 

+ IF seite zwei existiert 

+    THEN blockin (ds, 2, block (link + 2)) ; 

+         IF return <> 0 

+            THEN user channel ; 

+                 putline ("Warnung: Seite 2 des Datenraums nicht lesbar: " + 

+                            text (return)) ; 

+                 system channel 

+         FI 

+ FI ; 

+ IF mehr als zwei seiten 

+    THEN FOR i FROM 0 UPTO 4 REP

+          IF hoehere seite existiert 

+             THEN blockin (ds, i + basisseite, block (link + i + 3)) ; 

+                  IF return <> 0 

+                     THEN user channel ; 

+                          putline ("Warnung: Seite " + text (i + basisseite)

+                                   + " des Datenraums nicht lesbar: " 

+                                   + text (return)) ; 

+                          system channel 

+                  FI 

+          FI 

+         PER

+ FI . 

+ 

+seite eins existiert : 

+ exists (block (link + 1)) . 

+ 

+seite zwei existiert : 

+ exists (block (link + 2)) . 

+ 

+mehr als zwei seiten : 

+ exists (block (link)) . 

+ 

+hoehere seite existiert : 

+ exists (block (link + i + 3)) . 

+ 

+basisseite : 

+ block (link) AND 255 . 

+ 

+lese grossdatenraum : 

+ ds := nilspace ; 

+ dreintrag kopieren ; 

+ seite := 0 ; 

+ FOR i FROM 1 UPTO 8 REP 

+  IF seitenblocktabelle existiert 

+     THEN seitenblocktabelle lesen ; 

+          seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind 

+     ELSE seite INCR 256 

+  FI 

+ PER . 

+ 

+seitenblocktabelle lesen : 

+ blockin (dr eintrag (i)) ; 

+ IF return <> 0 

+    THEN user channel ; 

+         putline ("Warnung: Seitenblocktabelle " + text (i-1) + 

+                  " des Datenraums nicht lesbar: " + text (return)) ; 

+         putline ("Damit fehlen die Seiten " + text (max (1, seite)) +

+                  " bis " + text (seite + 255)) ; 

+         system channel 

+ FI . 

+ 

+seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind : 

+ FOR link FROM 1 UPTO 256 REP 

+  IF seite vorhanden 

+     THEN blockin (ds, seite, block (link)) ; 

+          IF return <> 0 

+             THEN user channel ; 

+                  putline ("Warnung: Seite " + text (seite) + 

+                           " des Datenraums nicht lesbar: " + text (return)) ; 

+                  system channel 

+          FI ;

+          user channel ; 

+          cout (seite) ; 

+          system channel 

+  FI ; 

+  seite INCR 1 

+ PER . 

+ 

+seite vorhanden : 

+ exists (block (link)) . 

+ 

+seitenblocktabelle existiert : 

+ exists (dreintrag (i)) . 

+ 

+dreintrag kopieren : 

+ FOR i FROM 0 UPTO 7 REP 

+  dreintrag (i + 1) := block (link + i) 

+ PER .

+ 

+systemanker lesen : 

+ blockin (systemanker) ;

+ IF return <> 0 

+    THEN user channel ; 

+         errorstop ("Systemanker nicht lesbar: " + text (return))

+ FI .

+ 

+drdr taskwurzel lesen : 

+ link := block (tasknr DIV 32 + 1) ; 

+ IF link = -1 

+    THEN user channel ; 

+         errorstop ("Die Task existiert nicht") 

+ FI ; 

+ blockin (link) ; 

+ IF return <> 0 

+    THEN user channel ; 

+         errorstop ("Taskwurzel des DRDR nicht lesbar: " + text (return))

+ FI . 

+ 

+drdr dataspacewurzel lesen : 

+ link := block (8 * (tasknr MOD 32) + dsnr DIV 32 + 1) ; 

+ IF NOT exists (link)

+    THEN user channel ; 

+         errorstop ("Der Datenraum (und weitere 31) existiert nicht") 

+ FI ; 

+ blockin (link) ; 

+ IF return <> 0 

+    THEN user channel ; 

+         errorstop ("Dataspacewurzel des DRDR nicht lesbar: " +

+                    text (return)) 

+ FI . 

+ 

+ENDPROC copy ds ; 

+ 

+BOOL PROC exists (INT CONST blocknr) :

+ blocknr <> -1 AND blocknr <> -255

+ENDPROC exists ; 

+ 

+PROC blockin (INT CONST blocknr) : 

+ blockin (block, 0, blocknr DIV 2, return) ; (* ggf COPBIT ausblenden *) 

+ENDPROC blockin ; 

+ 

+PROC blockin (DATASPACE VAR ds, INT CONST page, blocknr) : 

+ blockin (ds, page, 0, blocknr DIV 2, return) (* ggf COPBIT ausblenden *)

+ENDPROC blockin ; 

+ 

+PROC dump (TEXT CONST datei) : 

+ edit dump (datei, FALSE) 

+ENDPROC dump ; 

+ 

+PROC edit dump (TEXT CONST datei, BOOL CONST write access) : 

+ BOUND STRUCT (ROW 252 INT page1, ROW 2047 ROW 256 INT blocks) VAR b ; 

+ b := old (datei) ; 

+ INT VAR blocknr :=  1, i ;

+ TEXT VAR esc char, t ; 

+ BOOL VAR clear := TRUE , modified ; 

+ ROW 256 INT VAR page 1 ;

+ page 1 (1) := 0 ; 

+ page 1 (2) := 0 ; 

+ page 1 (3) := type (old (datei)) ; 

+ page 1 (4) := -1 ;

+ page ; 

+ put ("Info mit 'ESC ?'") ; 

+ dump cursor (4, 3) ;

+ REP 

+  out (""1""5"Datei: """) ; out (datei) ; put ("""") ; 

+  put (", Page:") ; put (text (blocknr, 5)) ; 

+  put (", Dspages:") ; put (text (dspages (old (datei)), 5)) ; 

+  put (", Type:") ; put (type (old (datei))) ; 

+  IF blocknr = 1 

+     THEN FOR i FROM 1 UPTO 252 REP 

+           page1 (i + 4) := b.page1 (i) 

+          PER ; 

+          edit dump (page 1, 1, 256, clear, write access, modified, esc char); 

+          IF modified 

+             THEN FOR i FROM 1 UPTO 252 REP 

+                   b.page1 (i) := page 1 (i + 4) 

+                  PER ; 

+                  type (old (datei), page 1 (3))

+          FI 

+     ELSE edit dump (b.blocks (blocknr), 1, 256, clear, write access, modified, esc char) 

+  FI ;

+  clear := TRUE ;

+  IF esc char = ""1""10"" 

+     THEN blocknr INCR 1 

+  ELIF esc char = ""1""3"" 

+     THEN IF blocknr > 1 

+             THEN blocknr DECR 1 

+             ELSE clear := FALSE ;

+                  out (""1""15"E r s t e   S e i t e "14""5"") 

+          FI 

+  ELIF esc char = ""27"q" 

+     THEN LEAVE edit dump 

+  ELIF esc char = ""27"?" 

+     THEN clear := FALSE ; 

+          putline (""1"ESC:?,p,q,w,F,0; HOP:HOP,LEFT,UP,DOWN,RIGHT; DEL,INS,LEFT,UP,RIGHT") ; 

+  ELIF esc char = ""27"p" 

+     THEN REP 

+           put(""1""5"Neue Pagenr:") ; 

+           t := text (blocknr) ; 

+           editget (t) ; 

+           blocknr := int (t) 

+          UNTIL blocknr >= 0 AND blocknr < 2048 PER 

+  ELSE clear := FALSE 

+  FI ; 

+ PER 

+ENDPROC edit dump ; 

+ 

+INT VAR task index, ds nr ; 

+TEXT VAR task id ; 

+page ; 

+put ("""Taskname"" oder Taskindex:") ; 

+getline (task id) ; 

+IF pos (task id, """") > 0 

+   THEN scan (task id) ; 

+        nextsymbol (task id) ; 

+        task index := index (task (task id))

+   ELSE task index := int (task id) 

+FI ;

+put ("Dataspacenummer in der Task:") ; 

+get (ds nr) ; 

+IF ds nr < 4 

+   THEN errorstop ("Es gibt nur DATASPACE-Nummern >= 4") 

+FI ; 

+IF yes ("Soll vorher ein Fixpoint gesetzt werden") 

+   THEN fixpoint 

+FI ; 

+forget ("new ds", quiet) ; 

+copy ds (task index, ds nr, "new ds") ; 

+putline ("Der kopierte Datenraum steht in der Datei ""new ds""") ; 

+dump ("new ds")

diff --git a/devel/misc/unknown/src/DS4.ELA b/devel/misc/unknown/src/DS4.ELA
new file mode 100644
index 0000000..6ebcf2d
--- /dev/null
+++ b/devel/misc/unknown/src/DS4.ELA
@@ -0,0 +1,268 @@
+PACKET ds 4 access DEFINES ds 4 : 

+ 

+PROC ds 4 : 

+ INT VAR segment, block nr , i , adr , byte ; 

+ TEXT VAR key , eingabe ; 

+ BOOL VAR new headline ; 

+ page ; 

+ put ("Segment:") ; 

+ get (segment) ; 

+ ROW 256 INT VAR space ; 

+ block nr := 0 ; 

+ new headline := FALSE ; 

+ REP 

+  IF new headline THEN out (""1""5"") 

+  ELSE page 

+  FI ; 

+  put (" Segment:") ; put (text(segment,5)) ; (* Cursor 1-16 *) 

+  put (", Block:") ; put (text(block nr,5)) ; (* Cursor 17-31 *) 

+  put (", Wortaddr:") ; out (hex8 (segment)) ; 

+                        put (text(hex16((""0""+code(blocknr))ISUB1),5)) ; 

+  put ("Wahl : + - e s b w a h d o") ; (* ^ Cursor 32 - 51 *) 

+  IF NOT new headline THEN 

+     line ; (* ^ 52 - 77 *)

+     adr := (""0"" + code (block nr)) ISUB 1 ; 

+     FOR i FROM 0 UPTO 255 REP 

+       space (i+1) := get word (segment, i + adr) 

+     PER ; 

+     dump (space) 

+  FI ; 

+  out (""1"") ; 

+  new headline := FALSE ; 

+  inchar (key) ; 

+  out (key) ; 

+  IF key = "+" THEN IF block nr = 255 

+                       THEN block nr := 0 ; 

+                            segment INCR 1 

+                       ELSE block nr INCR 1 

+                    FI

+  ELIF key = "-" THEN IF block nr = 0 AND segment > 0

+                         THEN block nr := 255 ; 

+                              segment DECR 1 

+                      ELIF block nr > 0 THEN block nr DECR 1 

+                      FI

+  ELIF key = "s" THEN cursor (11,1) ;

+                      eingabe := text (segment) ;

+                      editget (eingabe, 1000, 5) ; 

+                      segment := int (eingabe) 

+  ELIF key = "b" THEN cursor (26,1) ; 

+                      eingabe := hex8 (block nr) ;

+                      editget (eingabe, 1000, 5) ; 

+                      block nr := integer (eingabe) 

+  ELIF key = "w" THEN cursor (44,1) ; 

+                      eingabe := hex16 (adr) ; 

+                      edit get (eingabe, 1000, 5) ; 

+                      adr := integer (eingabe) ; 

+                      eingabe := hex16 (get word (segment, adr)) ; 

+                      cursor (32,1) ; 

+                      put (",NeuesWort:") ; 

+                      editget (eingabe, 1000,5) ; 

+                      put word (segment, adr, integer (eingabe)) ; 

+  ELIF key = "d" THEN cursor (32,1) ; 

+                      new headline := TRUE ; 

+                      put (", Dez->Hex:") ; 

+                      REAL VAR r ; 

+                      get (r) ; 

+                      cursor (32,1) ; 

+                      put (", - Taste - Hex:") ; 

+                      IF r < 256.0 AND r >= 0.0 THEN put (hex8 (int(r))) 

+                      ELIF r < 0.0 THEN put (hex16 (int (r))) 

+                      ELIF r < 32768.0 THEN put (hex16 (int(r))) 

+                      ELSE put (hex16 (int (r - 65536.0))) 

+                      FI ; pause

+  ELIF key = "h" THEN cursor (32,1) ; 

+                      new headline := TRUE ; 

+                      put (", Hex->Dez:") ; 

+                      getline (eingabe) ; 

+                      cursor (32,1) ; 

+                      put (", - Taste - Dez:") ; 

+                      put (integer (eingabe)) ; 

+                      IF integer (eingabe) < 0 THEN put (",  Positiv:") ; 

+                         put (positiv (eingabe)) 

+                      FI ; pause 

+  ELIF key = "a" THEN cursor (32,1) ; 

+                      new headline := TRUE ; 

+                      put (", ASCII->Hex (Taste)"5"") ; 

+                      inchar (eingabe) ; 

+                      put (" = ") ; put (hex8 (code (eingabe))) ; 

+                      put ("- Taste -") ; 

+                      pause 

+  ELIF key = "o" THEN cursor (32,1) ; 

+                      new headline := TRUE ; 

+                      put (", Hex->0Opcde:") ; 

+                      getline (eingabe) ; 

+                      cursor (32,1) ; 

+                      put (", - Taste - :") ; 

+                      put (eumel0 opcode (integer (eingabe))) ; 

+                      pause 

+ FI ; 

+ UNTIL key = "e" PER ; 

+ 

+ENDPROC ds 4 ; 

+ 

+PROC dump (ROW 256 INT CONST page) : 

+ INT VAR i,j ,k ;

+ TEXT VAR t := "                        " ;

+ k := 1 ; j := 1 ; 

+ put ("00:") ; 

+ FOR i FROM 1 UPTO 256 WHILE incharety <> ""27""REP

+   put hex16 (page (i)) ; 

+   replace (t, j, ascii (page (i))) ; 

+   j := j + 2 ; 

+   IF ((j-1) MOD 8) = 0 THEN out (" ") FI ;

+   IF k = 22 AND j = 9 THEN j := 25 ; 34 TIMESOUT " " FI ; 

+   IF j = 25 THEN 

+      out (" ") ; out (t) ; 

+      replace (t, 1, "                        ") ;

+      IF k < 22 THEN 

+         line ;

+         out(hex8 (i)); put (":") 

+      FI ;

+      k := k + 1 ; 

+      j := 1 

+  FI ;

+PER ; 

+ENDPROC dump ; 

+ 

+ 

+TEXT PROC ascii (INT CONST wert) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, wert) ; 

+ IF (t SUB 1) < " " OR (t SUB 1) > ""126"" THEN replace (t, 1, ".") FI ; 

+ IF (t SUB 2) < " " OR (t SUB 2) > ""126"" THEN replace (t, 2, ".") FI ;

+ t 

+ENDPROC ascii ; 

+ 

+PROC put hex16 (INT CONST wert) :

+ TEXT VAR t := "  " ; 

+ replace (t, 1, wert) ; 

+ out hex digit (code (t SUB 1) DIV 16) ; 

+ out hex digit (code (t SUB 1) AND 15) ;

+ out hex digit (code (t SUB 2) DIV 16) ; 

+ out hex digit (code (t SUB 2) AND 15) ; 

+ENDPROC put hex16 ;

+ 

+PROC out hex9 (INT CONST wert) : 

+ out hex digit (wert DIV 256) ; 

+ out hex digit (wert DIV 16 AND 15) ; 

+ out hex digit (wert AND 15) 

+ENDPROC out hex9 ; 

+ 

+TEXT PROC hex8 (INT CONST wert) : 

+ hex digit (wert DIV 16) + 

+ hex digit (wert AND 15) 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex16 (INT CONST wert) :

+ TEXT VAR t := "  " ; 

+ replace (t, 1, wert) ; 

+ hex digit (code (t SUB 2) DIV 16) + 

+ hex digit (code (t SUB 2) AND 15) + 

+ hex digit (code (t SUB 1) DIV 16) + 

+ hex digit (code (t SUB 1) AND 15) 

+ENDPROC hex16 ;

+ 

+TEXT PROC hex digit (INT CONST wert) : 

+ IF wert < 10 THEN code (wert + 48) 

+ ELSE code (wert + 55) 

+ FI 

+ENDPROC hex digit ; 

+ 

+PROC out hex digit (INT CONST wert) : 

+ IF wert < 10 THEN out (code (wert + 48)) 

+ ELSE out (code (wert + 55)) 

+ FI 

+ENDPROC out hex digit ; 

+ 

+INT PROC integer (TEXT CONST hex addr) : 

+ INT VAR i ; 

+ REAL VAR summe := 0.0 ; 

+ FOR i FROM 1 UPTO length (hex addr) REP 

+  summe := summe * 16.0 ; 

+  summe INCR real (digit) 

+ PER ; 

+ IF summe > 32767.0 THEN int (summe - 65536.0)

+ ELSE int (summe) 

+ FI. 

+ 

+digit : 

+ TEXT CONST char := hex addr SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ENDPROC integer ; 

+ 

+REAL PROC positiv (TEXT CONST wert) : 

+ INT VAR i ; 

+ REAL VAR summe := 0.0 ; 

+ FOR i FROM 1 UPTO length (wert) REP 

+  summe := summe * 16.0 ; 

+  summe INCR real (digit) 

+ PER ; 

+ summe . 

+ 

+digit : 

+ TEXT CONST char := wert SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ENDPROC positiv ; 

+ 

+TEXT PROC eumel0 opcode (INT CONST word) : 

+ INT VAR op1 := (word AND 31744) DIV 1024 , 

+         op2 := (word AND 768) DIV 128 , 

+         low := word AND 255 , 

+         long data := (word AND 768) * 2 + (word AND 255) ;

+ IF word < 0 THEN op2 INCR 1 ; long data INCR 256 FI ; 

+ SELECT op1 OF 

+  CASE 0 : "LN " + text (low) 

+  CASE 1 : "LN " + text (long data) 

+  CASE 2 : "MOV " 

+  CASE 3 : "INC1 " 

+  CASE 4 : "DEC1 " 

+  CASE 5 : "INC " 

+  CASE 6 : "DEC " 

+  CASE 7 : "ADD " 

+  CASE 8 : "SUB " 

+  CASE 9 : "CLEAR " 

+  CASE 10 : "TEST " 

+  CASE 11 : "EQU " 

+  CASE 12 : "LSEQ " 

+  CASE 13 : "FMOV " 

+  CASE 14 : "FADD " 

+  CASE 15 : "FSUB " 

+  CASE 16 : "FMULT " 

+  CASE 17 : "FDIV " 

+  CASE 18 : "FLSEQ " 

+  CASE 19 : "TMOV " 

+  CASE 20 : "TEQU "

+  CASE 21 : "LSEQU " 

+  CASE 22 : "ACCDS " 

+  CASE 23 : "REF " 

+  CASE 24 : "SUBS " 

+  CASE 25 : "SEL " 

+  CASE 26 : "PPV " 

+  CASE 27 : "PP " 

+  CASE 28 : "BR " + hex8 (low) 

+  CASE 29 : "BR " + hex16 (long data) 

+  CASE 30 : "CALL " 

+  OTHERWISE op 31 

+ ENDSELECT. 

+ 

+op31 : 

+SELECT op 2 OF 

+ CASE 0 : "IS """ + code (low) + """" 

+ CASE 1 : "STIM " + hex8 (low) 

+ CASE 2 : "MOVX " 

+ CASE 3 : "PW " 

+ CASE 4 : "GW " 

+ CASE 5 : "PENTER " + hex8 (low) 

+ CASE 6 : "ESC " + text (low) 

+ CASE 7 : "LONGA " + eumel 0 opcode ((low AND 124) * 256) 

+ OTHERWISE "?????" 

+ENDSELECT 

+ENDPROC eumel 0 opcode 

+ 

+ENDPACKET ds 4 access 

diff --git a/devel/misc/unknown/src/PRIVS.ELA b/devel/misc/unknown/src/PRIVS.ELA
new file mode 100644
index 0000000..dfed695
--- /dev/null
+++ b/devel/misc/unknown/src/PRIVS.ELA
@@ -0,0 +1,485 @@
+PACKET privs DEFINES pcb, 

+                     pages, 

+                     internal pause, 

+                     set error stop, 

+                     sld, 

+                     next active task index, 

+                     create process, 

+                     sysgen off, 

+                 (*  cdb int ,

+                     cdb text , *)

+                     block, 

+                     unblock, 

+                     sys op, 

+                     set clock, 

+                     fixpoint, 

+                     save system,

+                     internal shutup, 

+                     collect garbage blocks, 

+                     send, 

+                     define collector, 

+                     erase process, 

+                     halt process ,

+ 

+                     return false ,

+                     return true ,

+                     term ,

+                     char read ,

+                     begin char read ,

+                     char write ,

+                     end char write ,

+                     get char ,

+                     find non blank ,

+                     div rem 256 ,

+                     add mul 256 ,

+                     is digit ,

+                     is lowercase or digit ,

+                     is lowercase ,

+                     is uppercase ,

+                     gen addr ,

+                     gen code addr ,

+                     is short address,

+                     sysgen ,

+                     get tables ,

+                     put tables ,

+                     erase tables ,

+                     exec ,

+                  (* pproc ,

+                     pcall , *)

+                     case , 

+                     move ,

+                     address ,

+                     alias ,

+                     IMULT ,

+                     arith 15 ,

+                     arith 16 ,

+                     put word ,

+                     get word :

+

+

+PROC pcb (TASK CONST id, INT CONST field, value) :

+

+  EXTERNAL 105

+

+ENDPROC pcb ;

+

+

+PROC pages (DATASPACE CONST ds, TASK CONST id) :

+

+  EXTERNAL 88

+

+ENDPROC pages ;

+

+

+PROC internal pause (INT CONST time limit) :

+

+  EXTERNAL 66

+

+ENDPROC internal pause ;

+

+

+PROC set error stop (INT CONST code) :

+

+  EXTERNAL 77

+

+ENDPROC set error stop ;

+

+

+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :

+

+  EXTERNAL 96

+

+ENDPROC sld ;

+

+

+PROC next active task index (TASK VAR id) : 

+

+  EXTERNAL 118

+

+ENDPROC next active task index ;

+

+

+PROC create process (TASK CONST id, PROC start) :

+

+  create (id, PROC start)

+

+ENDPROC create process ;

+

+

+PROC create (TASK CONST id, PROC start) :

+

+  EXTERNAL 111

+

+ENDPROC create ;

+

+

+PROC sysgen off :

+

+  INT VAR x := 0 ;

+  elan (3, x,x,x,x,x,x,x,x,x,x,x)

+

+ENDPROC sysgen off ;

+

+

+PROC elan (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k) :

+

+  EXTERNAL 256

+

+ENDPROC elan ;

+

+

+INT PROC cdbint (INT CONST adr) :

+

+ EXTERNAL 116

+

+ENDPROC cdbint ;

+

+

+TEXT PROC cdbtext (INT CONST adr) :

+ 

+ EXTERNAL 117

+

+ENDPROC cdbtext ;

+

+

+PROC block (TASK CONST id) :

+

+  EXTERNAL 109

+

+ENDPROC block ;

+

+

+PROC unblock (TASK CONST id) :

+

+  EXTERNAL 108

+

+ENDPROC unblock ;

+

+

+PROC sys op (INT CONST function) :

+

+  EXTERNAL 90

+

+ENDPROC sys op ;

+

+

+PROC set clock (TASK CONST id, REAL CONST value) :

+

+  EXTERNAL 82

+

+ENDPROC set clock ;

+

+

+PROC set clock (REAL CONST value) :

+

+  EXTERNAL 103

+

+ENDPROC set clock ;

+

+

+PROC fixpoint :

+

+  sys op (2)

+

+ENDPROC fixpoint ;

+

+

+PROC collect garbage blocks :

+

+  sys op (1)

+

+ENDPROC collect garbage blocks ;

+

+

+PROC internal shutup :

+

+  sys op (4)

+

+ENDPROC internal shutup ;

+

+

+PROC save system :

+

+  sys op (12)

+

+ENDPROC save system ;

+

+

+PROC send (TASK CONST from, to, INT CONST order, DATASPACE VAR ds,

+           INT VAR receipt) :

+

+  EXTERNAL 127

+

+ENDPROC send ;

+

+

+PROC define collector (TASK CONST task) :

+

+  EXTERNAL 128

+

+ENDPROC define collector ;

+

+

+PROC erase process (TASK CONST id) : 

+

+  EXTERNAL 112

+

+ENDPROC erase process ;

+

+

+PROC halt process (TASK CONST id) :

+

+  EXTERNAL 110

+

+ENDPROC halt process ;

+

+

+(****************************** undokumentiert **************************)

+

+

+BOOL PROC return false :

+

+ EXTERNAL 1

+

+ENDPROC return false ;

+

+

+BOOL PROC return true :

+

+ EXTERNAL 2

+

+ENDPROC return true ;

+

+

+PROC term :

+ 

+  EXTERNAL 4

+

+ENDPROC term ;

+

+

+PROC char read (INT CONST pos) :

+

+ EXTERNAL 8

+

+ENDPROC char read ;

+

+

+INT PROC begin char read (INT VAR pos) :

+ 

+ EXTERNAL 9

+

+ENDPROC begin char read ;

+

+

+PROC char write (INT VAR next, INT CONST char, int) :

+

+ EXTERNAL 10

+

+ENDPROC char write ;

+

+

+PROC end char write (INT VAR a, b, INT CONST char) :

+

+ EXTERNAL 11

+

+ENDPROC end char write ;

+

+

+PROC ctt (INT CONST adr, INT VAR result) :

+

+ EXTERNAL 12

+

+ENDPROC ctt ;

+

+

+BOOL PROC get char (TEXT CONST text, INT VAR pos, char) :

+

+ EXTERNAL 13

+

+ENDPROC get char ;

+

+

+BOOL PROC find non blank (INT VAR non blank char, TEXT CONST string, 

+                          INT VAR pos) : 

+

+ EXTERNAL 14

+

+ENDPROC find non blank ;

+

+

+PROC divrem 256 (INT VAR a, b) :

+

+ EXTERNAL 15

+

+ENDPROC divrem 256 ;

+

+

+PROC addmul 256 (INT VAR a, b) :

+

+ EXTERNAL 16

+

+ENDPROC addmul 256 ;

+

+

+BOOL PROC is digit (INT CONST char) :

+

+ EXTERNAL 18

+

+ENDPROC is digit ;

+

+

+BOOL PROC is lowercase or digit (INT CONST char) :

+

+ EXTERNAL 19

+

+ENDPROC is lowercase or digit ;

+

+

+BOOL PROC is lowercase (INT CONST char) :

+

+ EXTERNAL 20

+

+ENDPROC is lowercase ;

+

+

+BOOL PROC is uppercase (INT CONST char) :

+

+ EXTERNAL 21

+

+ENDPROC is uppercase ;

+

+

+PROC gen addr (INT CONST word1, word2, INT VAR result) :

+

+ EXTERNAL 22

+

+ENDPROC gen addr ;

+

+

+BOOL PROC gen code addr (INT CONST word1, word2, INT VAR result) :

+

+ EXTERNAL 23

+

+ENDPROC gen code addr ;

+

+

+BOOL PROC is short address (INT CONST address) :

+

+ EXTERNAL 24

+

+ENDPROC is short address ;

+

+

+PROC sysgen :

+

+ EXTERNAL 25

+

+ENDPROC sysgen ;

+

+

+PROC get tables : 

+

+ EXTERNAL 26

+

+ENDPROC get tables ;

+

+

+PROC put tables :

+

+ EXTERNAL 27

+

+ENDPROC put tables ;

+

+

+PROC erase tables :

+

+ EXTERNAL 28

+

+ENDPROC erase tables ;

+

+

+PROC exec (INT CONST module number) :

+

+ EXTERNAL 29

+

+ENDPROC exec ;

+

+(*

+PROC pproc (PROC proc) :

+

+ EXTERNAL 30

+

+ENDPROC pproc ;

+

+

+PROC pcall (PROC proc) :

+

+ EXTERNAL 31

+

+ENDPROC pcall ;

+*)

+

+BOOL PROC case (INT CONST switch, limit) :

+

+ EXTERNAL 32

+

+ENDPROC case ;

+ 

+

+PROC move (PROC len, INT VAR from area, to area) :

+

+ EXTERNAL 33

+

+ENDPROC move ;

+

+

+INT PROC alias (DATASPACE CONST ds, INT VAR result) :

+

+ EXTERNAL 34

+

+ENDPROC alias ;

+

+

+INT PROC address (INT CONST object) :

+

+ EXTERNAL 35

+

+ENDPROC address ;

+

+

+INT OP IMULT (INT CONST a, b) :

+

+ EXTERNAL 40

+

+ENDOP IMULT ;

+

+

+PROC arith 15 :

+

+ EXTERNAL 91

+

+ENDPROC arith 15 ;

+

+

+PROC arith 16 :

+

+ EXTERNAL 92 

+

+ENDPROC arith 16 ;

+

+

+PROC put word (INT CONST segment, address, word) : 

+

+ EXTERNAL 119

+

+ENDPROC put word ;

+

+

+INT PROC get word (INT CONST segment, address) :

+

+ EXTERNAL 120

+

+ENDPROC get word 

+

+ENDPACKET privs 

diff --git a/devel/misc/unknown/src/TABINFO.ELA b/devel/misc/unknown/src/TABINFO.ELA
new file mode 100644
index 0000000..e7b374a
--- /dev/null
+++ b/devel/misc/unknown/src/TABINFO.ELA
@@ -0,0 +1,117 @@
+PACKET table info DEFINES table info :       (* Michael Staubermann *) 

+                                             (* 02.12.86            *) 

+LET insert flag addr            = 4654 ,

+

+(*  prev modnr addr             = 4662 , *)

+    cur modnr addr              = 4806 , 

+

+    prev code end addr          = 4775 , 

+    cur code end addr           = 4807 , 

+

+    prev name tab end addr      = 4688 , 

+    cur name tab end addr       = 4693 , 

+

+    prev permanent tab end addr = 4704 ,

+    cur permanent tab end addr  = 4707 , 

+

+    prev denoter end addr       = 4815 , 

+    cur denoter end addr        = 4809 ,

+

+    prev static data end addr   = 4816 , 

+    cur static data end addr    = 4810 , 

+    prev static data begin addr = 4817 , 

+    cur static data begin addr  = 4811 , 

+(*

+    begin of hash table         = 0 , 

+    end of hash table           = 1023 , 

+

+    begin of string table       = 1024 , 

+    end of string table         = 4093 ,

+*)

+    begin of name table         = 4096 , 

+    end of name table           = 22783 , 

+

+    begin of permanent table    = 22784 , 

+    end of permanent table      = 32767 , 

+    

+    begin of code               = 4096 , 

+ 

+    begin of data               = 4096 ; 

+ 

+INT CONST end of code :: -1 , 

+          end of data :: -1 ;

+ 

+BOOL VAR was insert ; 

+ 

+INT PROC getword (INT CONST segment, address) : 

+ EXTERNAL 120 

+ENDPROC getword ; 

+ 

+PROC arith16 : 

+ EXTERNAL 92 

+ENDPROC arith16 ; 

+ 

+INT OP SUB (INT CONST left, right) : 

+ arith 16 ;

+ left - right 

+ENDOP SUB ; 

+ 

+PROC entry (TEXT CONST name, BOOL CONST size, 

+            INT CONST begin, cur, prev, end) : 

+ put (subtext (name + " ....................", 1, 20) + ":") ; 

+ IF size 

+    THEN put (card (end SUB begin)) ; 

+         put (card (end SUB cur)) ; 

+         put (card (cur SUB begin)) ; 

+         put (card (int (positiv (cur SUB begin) / 

+                         positiv (end SUB begin) * 100.0))) ;

+    ELSE put ("                       ") 

+ FI ;

+ IF NOT was insert

+    THEN put (card (prev - cur)) 

+ FI ; 

+ line

+ENDPROC entry ; 

+ 

+PROC table info : 

+ was insert := getword (0, insert flag addr) = 0 ; 

+ line ; 

+ put ("Nächste Modulenr.:") ; 

+ put (getword (0, cur modnr addr)) ; line (2) ; 

+ put ("Name                   Size  Free  Used  Used%") ;

+ IF NOT was insert 

+    THEN put ("LastRun") 

+ FI ; 

+ line ; 

+ entry ("Permanenttable", TRUE, begin of permanent table, 

+        getword (0, cur permanent tab end addr), 

+        getword (0, prev permanent tab end addr), end of permanent table) ; 

+ entry ("Nametable", TRUE, begin of name table, 

+        getword (0, cur name tab end addr), 

+        getword (0, prev name tab end addr), end of name table) ; 

+ entry ("Code", TRUE, begin of code, 

+        getword (0, cur code end addr), 

+        getword (0, prev code end addr), end of code) ; 

+ entry ("Data", TRUE, begin of data, 

+        getword (0, cur static data end addr), 

+        getword (0, prev static data end addr), end of data) ; 

+ line ;

+ENDPROC table info ; 

+ 

+REAL PROC positiv (INT CONST value) : 

+ IF value < 0 

+    THEN real (value) + 65536.0 

+    ELSE real (value) 

+ FI

+ENDPROC positiv ; 

+ 

+TEXT PROC card (INT CONST i) : 

+ IF i = minint 

+    THEN "32768" 

+ ELIF i < 0 

+    THEN subtext (text (real (i) + 65536.0), 1, 5)

+    ELSE text (i, 5)

+ FI 

+ENDPROC card

+ 

+ENDPACKET table info ; 

diff --git a/devel/misc/unknown/src/TRACE.ELA b/devel/misc/unknown/src/TRACE.ELA
new file mode 100644
index 0000000..63c1455
--- /dev/null
+++ b/devel/misc/unknown/src/TRACE.ELA
@@ -0,0 +1,552 @@
+PACKET tracer DEFINES breakpoint handler ,          (* M. Staubermann  *) 

+                      handlers module nr ,          (* 20.04.86        *)

+                      list breakpoints ,

+                      set breakpoint , 

+                      reset breakpoint ,

+                      source file , 

+                      trace ,

+                      reset breakpoints : 

+ 

+LET local base field           = 25 , 

+    packet data segment        = 0 , 

+    local data segment         = 1 ,

+ 

+    begin of module nr link table = 512 , 

+ 

+    previous local base offset = 0 , 

+    return address offset      = 1 , 

+    return segment offset      = 2 , 

+    c8k offset                 = 3 , 

+ 

+    opcode mask                = 31744 , 

+    bt opcode                  = 0 , 

+    btlong opcode              = 1024 , 

+    bf opcode                  = 28672 , 

+    bflong opcode              = 29696 , 

+    br opcode                  = 28672 , 

+    brlong opcode              = 29696 , 

+ 

+    ln opcode                  = 0 , 

+    ln long opcode             = 1024 , 

+    call opcode                = 30720 , 

+    pcall opcode               = 32543 ;

+ 

+LET nr of breakpoints = 2 , 

+    BREAKPOINT = STRUCT (BOOL set, 

+                         INT  segment, 

+                              address, 

+                              saved word) ; 

+ 

+ROW nr of breakpoints BREAKPOINT VAR breakpoints ;

+BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, 3, -5, 0) ;

+ 

+FOR i FROM 1 UPTO nr of breakpoints REP 

+ breakpoints (i) := init breakpoint 

+PER ; 

+ 

+BOOL VAR auto trace := FALSE , 

+         zweizeilig ;

+INT VAR next instruction address ,

+        next instruction segment ,

+        next instruction ,

+        return segment,

+        return address, 

+        breakpoint address , 

+        breakpoint segment , 

+        breakpoint nr ,

+        lbas , 

+        this local base ,

+        branch address , 

+        c8k , 

+        packet base ,

+        op word,

+        saved word ,

+        i, x, y , 

+        actual line number := -1 , 

+        handler module := 395 ; (* PROC stop *) 

+ 

+TEXT VAR key := "" , 

+         previous key := "" , 

+         statement line := "" , 

+         source line := "" , 

+         source file name := "" ;

+ 

+FILE VAR source ; 

+ 

+PROC trace (BOOL CONST b) : 

+ auto trace := b 

+ENDPROC trace ; 

+ 

+PROC source file (TEXT CONST file name) : 

+ IF exists (file name) 

+    THEN source := sequentialfile (modify, file name) 

+ FI ; 

+ IF actual line number >= 0 CAND actual line number <= lines (source) 

+    THEN toline (source, actual line number) ; 

+         readrecord (source, source line) 

+    ELSE source line := ""

+ FI

+ENDPROC source file ; 

+ 

+TEXT PROC source file : 

+ source file name 

+ENDPROC source file ; 

+ 

+PROC breakpoint handler : 

+ determine return address ;

+ determine breakpoint nr ; 

+ reset breakpoints ; 

+ getcursor (x, y) ; 

+ REP 

+   ueberschrift schreiben ;

+   IF auto trace 

+      THEN IF incharety = "" 

+              THEN key := "s" 

+              ELSE auto trace := FALSE 

+           FI 

+   FI ; 

+   IF NOT auto trace 

+      THEN REP 

+            inchar (key) 

+           UNTIL pos (""13"acdefgst", key) > 0 PER ; 

+           IF key = "a" 

+              THEN auto trace := TRUE ; 

+                   key := "s" 

+           ELIF key = "f" 

+              THEN out (""13""5"Sourcefile:") ; 

+                   getline (source file name) ; 

+                   out (""3"") ;

+                   source file (source file name) 

+           ELIF key = ""13"" 

+              THEN key := "s" 

+           FI 

+   FI ; 

+   previous key := key 

+ UNTIL pos ("gst", key) > 0 PER ; 

+ cursor (1, 7) ; 

+ out (""5"") ;

+ IF key <> "t" 

+    THEN execute saved instruction 

+ FI ;

+ IF key = "t" 

+    THEN resetbreakpoints ; 

+         term 

+ ELIF key = "s" 

+    THEN singlestep 

+ FI ; 

+ cursor (x, y) . 

+ 

+ueberschrift schreiben : 

+ feld loeschen ; 

+ put (""1"Breakpoint") ; put (breakpoint nr) ; 

+ put ("lbas:") ; put (hex16 (lbas)) ; 

+ put ("pbas:") ; put (hex8 (packet base)) ; 

+ put ("c8k:") ;  put (hex8 (c8k)) ; 

+ IF valid source 

+    THEN out ("""") ; out (source file name) ; put ("""") 

+ FI ; 

+ line ;

+ IF valid source AND source line <> "" 

+    THEN put (text (actual line number, 5)) ; put ("|") ; 

+         outsubtext (source line, 1, 71) ; 

+         line ; 

+         IF LENGTH source line < 72 

+            THEN put (text (actual line number +1, 5)) ; put ("|") ; 

+                 toline (source, actual line number +1) ; 

+                 out (subtext (source, 1, 71)) ; 

+                 toline (source, actual line number) ; 

+                 line 

+            ELSE put ("______|") ; 

+                 outsubtext (source line, 72, 143) ; 

+                 line 

+         FI

+    ELSE line (2)

+ FI ; 

+ out (text (return segment AND 3)) ; 

+ put (hex16 (return address)) ; 

+ put ("|") ;

+ seg (breakpoint segment) ; 

+ addr (breakpoint address) ; 

+ zweizeilig := TRUE ;

+ disassemble one statement ; 

+ IF auto trace 

+    THEN pause (5) 

+ FI ; 

+ next instruction segment := breakpoint segment ; 

+ next instruction address := addr ADD 1 ; 

+ next instruction := getword (next instruction segment,

+                              next instruction address) ; 

+ line ; 

+ put ("a)uto, s)tep, g)o, t)erm, d)stop, e)stop, c)lrerr, f)ile:") . 

+ 

+feld loeschen : 

+ out (""1"") ; 

+ 7 TIMESOUT ""5""10"" ; 

+ 79 TIMESOUT "-" . 

+ 

+valid source : 

+ exists (source file name) . 

+ 

+disassemble one statement : 

+ statement line := hex16 (get word (breakpoint segment, addr)) ; 

+ statement line CAT " " ; 

+ code word line (statement line) ; 

+(* local base (lbas + offset) ; *) 

+ statement line := opcode ; 

+ local base (-1) ;

+ put (code word line) ; 

+(* i := max (0, 26 - length (code word line)) ; 

+ i TIMESOUT " " ; *) 

+i:=0; i := 71 - LENGTH codeword line - i ; 

+ outsubtext (statement line, 1, i) ; 

+ line ; 

+ IF zweizeilig 

+    THEN put ("      |") ; 

+         outsubtext (statement line, i + 1, i + 72) ; 

+         line 

+ FI ;

+ codeword line ("") . 

+ 

+singlestep : 

+ IF is return opcode

+    THEN set breakpoint behind previous call

+ ELIF bool result 

+    THEN set first breakpoint behind branch instruction ; 

+         set second breakpoint at branch address ;

+         bool result (FALSE) ;

+ ELIF is bool return opcode 

+    THEN set first breakpoint behind branch instruction at return address ; 

+         set second breakpoint at branch address of branch instruction at 

+         return address ; 

+ ELIF is branch instruction 

+    THEN set breakpoint at branch address 

+ ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND

+      yes (""3"Subroutine Trace") 

+    THEN out (""3""13""5"") ; 

+         calculate subroutine segment and address ; 

+         set breakpoint behind next instruction

+ ELSE set breakpoint behind next instruction

+ FI . 

+ 

+is call opcode : 

+ (saved word AND opcode mask) = call opcode OR 

+(* saved word = pcall opcode OR //einbauen, wenn local zugriffe ok sind// *) 

+ saved word = -136 . (* LONGA CALL *) 

+ 

+is line number : 

+ (saved word AND opcode mask) = ln opcode OR 

+ (saved word AND opcode mask) = lnlong opcode . 

+ 

+is branch instruction : 

+ (saved word AND opcode mask) = br opcode OR 

+ (saved word AND opcode mask) = brlong opcode . 

+ 

+is return opcode : 

+ saved word = 32512 . 

+ 

+is bool return opcode : 

+ saved word = 32513 OR saved word = 32514 . 

+ 

+read source line : 

+ actual line number := ((saved word AND 768) * 2) OR (saved word AND 255);

+ IF saved word < 0 

+    THEN actual line number INCR 256 

+ FI ; 

+ IF (saved word AND opcode mask) = lnlong opcode 

+    THEN actual line number INCR 2048 

+ FI ; 

+ actual line number DECR 1 ; 

+ IF valid source 

+    THEN IF lineno (source) = actual line number CAND source line <> "" 

+            THEN (* nichts*) 

+         ELIF actual line number >= 0 AND actual line number <= lines(source) 

+            THEN toline (source, actual line number) ; 

+                 readrecord (source, source line) 

+         ELSE source line := "" 

+         FI 

+    ELSE source line := "" 

+ FI . 

+ 

+set first breakpoint behind branch instruction : 

+ op word := next instruction AND opcode mask ; 

+ IF op word = bf opcode OR op word = bflong opcode OR 

+    op word = bt opcode OR op word = btlong opcode 

+    THEN seg (next instruction segment) ; 

+         addr (next instruction address) ; 

+         out (""3"") ; 

+         out (text (next instruction segment)) ; 

+         put (hex16 (next instruction address)) ; 

+         put ("|") ; 

+         zweizeilig := FALSE ;

+         bool result (TRUE) ;

+         disassemble one statement ; (* Branch instruction *)

+         IF NOT auto trace

+            THEN pause (30) 

+            ELSE pause (5)

+         FI ;

+         next free breakpoint ;

+         set breakpoint (i, next instruction segment,

+                            next instruction address ADD 1) ;

+    ELSE putline (""3""7"Interner Fehler: Nach BOOL-Result folgt kein Branch"); 

+         LEAVE singlestep 

+ FI . 

+ 

+set second breakpoint at branch address : 

+ calculate branch address ; 

+ next free breakpoint ;

+ set breakpoint (i, next instruction segment, branch address) . 

+ 

+set breakpoint at branch address : 

+ next instruction := saved word ; 

+ next instruction address := breakpoint address ; 

+ calculate branch address ; 

+ set breakpoint (breakpoint nr, next instruction segment, branch address) . 

+ 

+set first breakpoint behind branch instruction at return address : 

+ next instruction address := getword (local data segment, 

+                             lbas + return address offset) ; 

+ next instruction segment := getword (local data segment, 

+                             lbas + return segment offset) AND 3 ; 

+ next instruction := getword (next instruction segment,

+                              next instruction address) ;

+ IF next instruction segment = 3 

+    THEN set first breakpoint behind branch instruction 

+    ELSE putline ("Trace beendet.") 

+ FI . 

+ 

+set second breakpoint at branch address of branch instruction at return address : 

+ set second breakpoint at branch address . 

+ 

+determine return address : 

+ pause (0) ;    (* Local Base fixieren *)

+ this local base := getword (local data segment, pcb (local base field)) ; 

+ pause (0) ;

+ lbas            := getword (local data segment, this local base + 

+                             previous local base offset) ; 

+ c8k             := getword (local data segment, this local base + 

+                             c8k offset) AND 255 ; 

+ return segment  := getword (local data segment, this local base + 

+                             return segment offset) ; 

+ return address  := getword (local data segment, this local base + 

+                             return address offset) ; 

+ packet base     := HIGH return segment ; 

+ arith 16 ; 

+ return address DECR 1 ; 

+ arith 15 . 

+ 

+segment 3 module : 

+ IF saved word = -136 (* LONGA CALL *) 

+    THEN op word := getword (breakpoint segment, breakpoint address ADD 1) 

+ ELSE op word := saved word AND 1023 ; 

+      IF saved word < 0 

+         THEN op word INCR 1024 

+      FI ; 

+ FI ; 

+ op word >= 1280 . 

+ 

+calculate subroutine segment and address : 

+ next instruction segment := 3 ; (* Laeuft nur in Segment 3 ! *) 

+ next instruction address := getword (packet data segment,

+                             begin of module nr link table + op word) ADD 1. 

+ 

+determine breakpoint nr : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF breakpoints (i).set CAND 

+     breakpoints (i).segment = (return segment AND 3) CAND 

+     breakpoints (i).address = return address 

+     THEN breakpoint nr := i ; 

+          breakpoint address := breakpoints (i).address ; 

+          breakpoint segment := breakpoints (i).segment ; 

+          saved word         := breakpoints (i).saved word ;

+          LEAVE determine breakpoint nr 

+  FI 

+ PER ;

+ put ("Returnaddresse:") ; 

+ out (text (return segment AND 3)) ; 

+ putline (hex16 (return address)) ; 

+ list breakpoints ;

+ reset breakpoints ; 

+ enablestop ;

+ errorstop ("Falsche Returnaddresse") . 

+ 

+calculate branch address : 

+ IF lowbyte replacement possible 

+    THEN branch address := (next instruction address AND -256) OR 

+                           (next instruction AND 255) ; 

+         LEAVE calculate branch address 

+ FI ; 

+ branch address := next instruction AND 768 ; 

+ IF branch long 

+    THEN branch address INCR 2048 

+ FI ; 

+ branch address INCR branch address ; 

+ IF next instruction < 0 

+    THEN branch address INCR 256 

+ FI ; 

+ arith 16 ;

+ branch address INCR (next instruction address AND -256) ; 

+ IF HIGH branch address >= c8k 

+    THEN branch address DECR 4096 

+ FI ;

+ arith 15 ; 

+ branch address := (branch address AND -256) OR (next instruction AND 255) . 

+ 

+lowbyte replacement possible : 

+ (next instruction AND -32000) = 0 . 

+ 

+branch long : 

+ bit (next instruction, 10) . 

+ 

+execute saved instruction : 

+ perhaps change error flags ; 

+ putword (local data segment, this local base + return address offset,

+          return address) ; 

+ putword (local data segment, this local base + return segment offset, 

+          return segment) . 

+ 

+perhaps change error flags : 

+ IF bit (return segment, 7) AND previous key = "c"

+    THEN reset bit (return segment, 7)

+ FI ; 

+ IF bit (return segment, 6) AND previous key = "e" 

+    THEN reset bit (return segment, 6) 

+ ELIF NOT bit (return segment, 6) AND previous key = "d" 

+    THEN set bit (return segment, 6) 

+ FI . 

+ 

+set breakpoint behind next instruction : 

+ IF is linenumber 

+    THEN read source line 

+ FI ; 

+ set breakpoint (breakpoint nr, next instruction segment, 

+                 next instruction address) . 

+ 

+set breakpoint behind previous call : 

+ return segment := getword (local data segment, 

+                   lbas + return segment offset) AND 3 ;

+ return address := getword (local data segment, 

+                   lbas + return address offset) ; 

+ IF return segment = 3 

+    THEN set breakpoint (breakpoint nr, return segment, return address) 

+    ELSE putline ("Trace beendet.") 

+ FI . 

+ 

+next free breakpoint : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF NOT breakpoints (i).set

+     THEN LEAVE next free breakpoint 

+  FI 

+ PER ; 

+ putline (""3""7"Alle " + text(nr of breakpoints) + " Breakpoints sind belegt") ; 

+ LEAVE singlestep . 

+ 

+ENDPROC breakpoint handler ; 

+ 

+INT OP HIGH (INT CONST word) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, word) ; 

+ code (t SUB 2) 

+ENDOP HIGH ; 

+ 

+PROC reset breakpoints : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF breakpoints (i).set 

+     THEN reset breakpoint (i) 

+     ELSE breakpoints (i) := init breakpoint 

+  FI 

+ PER 

+ENDPROC reset breakpoints ; 

+ 

+PROC reset breakpoint (INT CONST nr) : 

+ IF nr < 1 OR nr > nr of breakpoints 

+    THEN errorstop ("Unzulaessige Breakpoint Nummer") 

+ ELIF NOT breakpoints (nr).set 

+    THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt")

+ ELSE putword (breakpoints (nr).segment, breakpoints (nr).address, 

+               breakpoints (nr).saved word) ; 

+      breakpoints (nr) := init breakpoint 

+ FI 

+ENDPROC reset breakpoint ; 

+ 

+PROC set breakpoint (INT CONST nr, segment, address) : 

+ INT VAR new word ;

+ IF nr < 1 OR nr > nr of breakpoints 

+    THEN errorstop ("Unzulaessige Breakpoint Nummer") 

+ ELIF breakpoints (nr).set 

+    THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt") 

+ ELIF segment < 2 OR segment > 3 

+    THEN errorstop ("Segment " + text (segment) + " ist kein Codesegment") 

+ ELSE breakpoints (nr).segment := segment ; 

+      breakpoints (nr).address := address ; 

+      breakpoints (nr).saved word := get word (segment, address) ; 

+      new word := call opcode + (handler module AND 1023) ; 

+      IF handler module >= 1024 

+         THEN setbit (new word, 15) 

+      FI ; 

+      putword (segment, address, new word) ; 

+      IF getword (segment, address) <> new word 

+         THEN errorstop ("Addresse Schreibgeschuetzt")

+         ELSE breakpoints (nr).set := TRUE

+      FI 

+ FI 

+ENDPROC set breakpoint ; 

+ 

+PROC handlers module nr (INT CONST module nr) : 

+ handler module := module nr 

+ENDPROC handlers module nr ; 

+ 

+INT PROC handlers module nr : 

+ handler module

+ENDPROC handlers module nr ; 

+ 

+PROC set breakpoint : 

+ handlers module nr (module number ("breakpointhandler", 1)) ; 

+ auto trace := FALSE ;

+ source file name := "" ; 

+ actual line number := -1 ;

+ page ; 

+ TEXT VAR object ; 

+ INT VAR object nr ; 

+ put ("Object Name:") ; 

+ getline (object) ; 

+ changeall (object, " ", "") ;

+ putline ("Objekt von Anfang an abzaehlen") ; 

+ pause (5) ; 

+ help (object) ; 

+ put ("Objekt Nr:") ; 

+ get (object nr) ; 

+ INT VAR code address := code start (object, object nr) ADD 1 ; 

+ naechsten freien breakpoint setzen ; 

+ put ("Breakpoint") ; 

+ put (i) ; 

+ putline ("wurde gesetzt.") . 

+ 

+naechsten freien breakpoint setzen : 

+ FOR i FROM 1 UPTO nr of breakpoints REP 

+  IF NOT breakpoints (i).set 

+     THEN set breakpoint (i, code segment, code address) ; 

+          LEAVE naechsten freien breakpoint setzen 

+  FI 

+ PER ; 

+ errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt"). 

+ 

+ENDPROC set breakpoint ; 

+ 

+PROC list breakpoints : 

+ line ; 

+ putline (" No Set  Address Word") ; 

+ FOR i FROM 1 UPTO nr of breakpoints REP

+  put (text (i, 3)) ; 

+  IF breakpoints (i).set 

+     THEN put (" Y  ")

+     ELSE put (" N  ") 

+  FI ; 

+  out (text (breakpoints (i).segment)) ;

+  put (hex16 (breakpoints (i).address)) ; 

+  put(" ") ; 

+  put (hex16 (breakpoints (i).saved word)) ; 

+  line 

+ PER 

+ENDPROC list breakpoints ; 

+ 

+ENDPACKET tracer 

diff --git a/devel/misc/unknown/src/XLIST.ELA b/devel/misc/unknown/src/XLIST.ELA
new file mode 100644
index 0000000..4897dab
--- /dev/null
+++ b/devel/misc/unknown/src/XLIST.ELA
@@ -0,0 +1,143 @@
+PACKET xlist DEFINES xlist :          (* M. Staubermann, 1.8.0 861203 *)

+                                      (* Heapsize korrigiert   870711 *) 

+DATASPACE VAR ds, act ;

+ 

+PROC x list : 

+ ds := nilspace ; 

+ FILE VAR f := sequentialfile (output, ds) ; 

+ headline (f, "Dataspaces:" + text (dataspaces) + 

+              "  Speicher:" + text (storage (myself))) ; 

+ disablestop ;

+ xlist (f) ; 

+ show (f) ; 

+ forget (ds) ; 

+ENDPROC x list ; 

+ 

+PROC x list (FILE VAR f) : 

+ INT VAR i, acttype, heapsiz, seiten ;

+ TEXT VAR name, status ;

+ FILE VAR f2 ;

+ ROW 255 STRUCT (TEXT name, status) VAR names ;

+

+ enablestop ;

+ FOR i FROM 1 UPTO 255 REP 

+  names (i).name := "" ; 

+  names (i).status := "" 

+ PER ; 

+ begin list ; 

+ get list entry (name, status) ; 

+ WHILE name <> "" REP 

+  makeid (old (name)) ; 

+  names (dsnr).name := name ; 

+  names (dsnr).status := status ;

+  get list entry (name, status) 

+ PER ;

+ maxlinelength (f, 1000) ;

+ putline (f, "Datum  Status Ds    kB  Type HeapLines Segs S/L ""Name""/'Headline'");

+ line (f) ;

+ putline (f, "               4 " + text ((pages (4, myself)+1) DIV 2, 5) +

+             "        " + text (heapsize, 3) + "    -    -  -") ; 

+ disablestop ;

+ FOR i FROM 5 UPTO 255 REP 

+  cout (i) ;

+  makeid (i) ;

+  act := reveal ds ; 

+  IF iserror

+   THEN clearerror

+   ELSE name := names (i).name ; 

+        status := names (i).status ; 

+        acttype := type (act) ;

+        names (i).name := "" ; 

+        names (i).status := "" ;

+        put (f,  stat + id + " " + speicher + " " + typ + " " + heap) ;

+        putline (f, zeilen + " " + segmente + " " + sl percent + dsname) ; 

+  FI ; 

+  forget (act) ; 

+  IF iserror THEN puterror ; clearerror FI

+ PER . 

+ 

+dsname : 

+ IF name = "" 

+    THEN IF act type = 1003 

+            THEN " '" + headline (f2) + "'" 

+            ELSE ""

+         FI

+    ELSE " """ + name + """" 

+ FI . 

+ 

+stat : 

+ IF status = "" 

+    THEN "             " 

+    ELSE status 

+ FI . 

+ 

+typ: 

+ text (act type, 5) .

+ 

+id : 

+ text (i, 3) .

+ 

+speicher : 

+ seiten := ds pages (act) ;

+ text ((seiten+1) DIV 2, 5) . 

+ 

+zeilen : 

+ IF act type <> 1003 THEN "   -" 

+ ELSE f2 := sequentialfile (modify, act) ; 

+      text (lines (f2), 4) 

+ FI . 

+ 

+segmente : 

+ IF act type <> 1003 THEN "   -" 

+ ELSE INT CONST segs :: segments (f2) ; 

+      text (segs, 4) 

+ FI . 

+ 

+sl percent: 

+ IF act type <> 1003 THEN " - "

+ ELIF segs = 1 THEN "   " 

+ ELSE text (int (real (segs) * 100.0 / real (lines (f2))+0.5), 2) + "%" 

+ FI . 

+ 

+heap :

+ heapsiz:= heapsize (act) * 2 ;

+ IF heapsiz >= 2046 

+    THEN "   -" 

+ ELIF act type = 1003 

+    THEN IF heapsiz < 192 

+            THEN "   0" 

+            ELSE text ((heapsiz-192) DIV 2, 4)

+         FI 

+ ELSE INT CONST next page :: next ds page (act, seiten) ; 

+      IF next page < 0 

+         THEN "   0" 

+      ELIF heapsiz = next page 

+         THEN "   1" 

+      ELSE text ((heapsiz + 1 - next page) DIV 2, 4)

+      FI 

+ FI .

+

+ENDPROC x list ; 

+ 

+PROC make id (DATASPACE CONST ds) : 

+ BOUND INT VAR i := ds 

+ENDPROC make id ; 

+ 

+INT PROC dsnr : 

+ INT VAR id ; 

+ id AND 255

+ENDPROC dsnr ; 

+ 

+PROC makeid (INT CONST nr) : 

+ INT VAR dsid := nr + 256 * index (myself) 

+ENDPROC makeid ; 

+ 

+DATASPACE PROC reveal ds :

+ DATASPACE VAR ds ; ds 

+ENDPROC reveal ds ;

+ 

+INT PROC pages (INT CONST dsnr, TASK CONST task) : 

+ EXTERNAL 88 

+ENDPROC pages ; 

+ 

+ENDPACKET x list ;

diff --git a/devel/misc/unknown/src/XSTATUS.ELA b/devel/misc/unknown/src/XSTATUS.ELA
new file mode 100644
index 0000000..36abc23
--- /dev/null
+++ b/devel/misc/unknown/src/XSTATUS.ELA
@@ -0,0 +1,188 @@
+PACKET x taskinfo DEFINES x task status ,   (* M.Staubermann 1.8.0, 861009*)

+                          x task info : 

+ 

+INT PROC pcf (TASK CONST t, INT CONST byte) : 

+ TEXT VAR word := "  " ; 

+ replace (word, 1, pcb (t, byte DIV 2 + 17)) ; 

+ IF (byte AND 1) = 0 THEN code (word SUB 1) 

+ ELSE code (word SUB 2) 

+ FI 

+ENDPROC pcf ; 

+ 

+TEXT PROC xstatus (TASK CONST task, INT CONST depth) : 

+  TEXT VAR zeile := ".................." , 

+           task name := name (task) ; 

+  change (zeile, 1, length (task name) + depth , depth * " " + task name) ; 

+  task name := zeile ; 

+  zeile CAT " " + hex16 (pcb (task, 9)) + "-" + hex8 (pcb (task, 10)) ; 

+  IF bit (pcf (task, 5), 7) (* ^ tasknr & version *) 

+     THEN zeile CAT "x" 

+     ELSE zeile CAT " " 

+  FI ; 

+  IF bit (pcf (task, 5), 0) 

+     THEN zeile CAT "h"   (* comflg *)

+     ELSE zeile CAT " "   (* haltprocess liegt an *) 

+  FI ; 

+  zeile CAT status (pcf (task, 6)) ; (* status *)

+  zeile CAT " " + bin (pcf (task, 7), 3, 7) ; (* statusflags rstflg *)

+  INT CONST pcf 11 :: pcf (task, 11) ; 

+  IF bit (pcf 11, 7)           (* iserror *)

+     THEN zeile CAT " e"

+     ELSE zeile CAT " n" 

+  FI ; 

+  IF bit (pcf 11, 6)           (* disablestop *)

+     THEN zeile CAT "d"

+     ELSE zeile CAT "e" 

+  FI ; 

+  IF bit (pcf 11, 5)           (* unbelegt *)

+     THEN zeile CAT "*" 

+     ELSE zeile CAT " " 

+  FI ; 

+  IF bit (pcf 11, 4)           (* arith 16 *)

+     THEN zeile CAT "u"  (* unsigned *)

+     ELSE zeile CAT "s"  (* signed *)

+  FI ; 

+  zeile CAT " " + text (pcf 11 AND 3) ;                    (* codesegment *)

+  zeile CAT hex8 (pcf (task, 10)) + hex8 (pcf (task, 9)) ; (* icount *) 

+  zeile CAT " " + text (pcb (task, 28) AND 15) ;           (* heapsegment *)

+  zeile CAT hex16 (pcb (task, 28) AND -16) ;               (* heaptop *)

+  zeile CAT " " + hex16 (pcb (task, 23)) ;                 (* mod *) 

+  zeile CAT text (pcb (task, 4), 4) ;                      (* channel *) 

+  zeile CAT text (pcb (task, 1), 4) ;                      (* linenr *)

+  zeile CAT text (pcb (task, 2), 4) ;                      (* errorline *)

+  zeile CAT text (pcb (task, 3), 4) ;                      (* errorcode *)

+  zeile CAT text (pcb (task, 7), 4) ;                      (* msgcode *)

+  zeile CAT " " + hex16 (pcb (task, 8)) ;                  (* msgds *)

+  zeile CAT " " + hex16 (pcb (task, 11)) + "-" + hex8 (pcb (task, 12)) ; 

+  zeile CAT " " + hex8 (pcf (task, 29)) ;   (* priv *)

+  zeile CAT " " + hex8 (pcf (task, 14)) ;  (* pbas *)     (* ^ fromid *) 

+  zeile CAT " " + hex8 (pcf (task, 15)) ;   (* c8k *)

+  zeile CAT " " + hex16 (pcb (task, 25)) ;  (* lbas *)

+  zeile CAT " " + hex16 (pcb (task, 26)) ;  (* ltop *)

+  zeile CAT " " + hex16 (pcb (task, 27)) ;  (* ls_top *)

+  zeile CAT text (pcb (task, 6), 3) ;       (* prio *) 

+  zeile CAT " " + hex8 (pcf (task, 28)) ;   (* priclk *) 

+  zeile CAT " " + hex8 (pcf (task, 8)) ;    (* pricnt *)

+  zeile CAT " " + hex16(pcb (task, 17)) + hex16 (pcb (task, 18)) ;

+  zeile CAT " " + hex8 (pcf (task, 4)) ; (* millis *)  (* ^ wstate *) 

+  zeile 

+ENDPROC xstatus ; 

+ 

+TEXT PROC status (INT CONST wert) : 

+ stat + blocked .

+ 

+stat: 

+ SELECT (wert AND 60) DIV 4 OF 

+  CASE 0 : "INTER" 

+  CASE 1 : "OUT  "

+  CASE 2 : "INCHR"

+  CASE 3 : "PAUSE" 

+  CASE 4 : "RTN T"

+  CASE 5 : "RTN F"

+  CASE 6 : "CALL "

+  CASE 7 : "RTN  "

+  CASE 8 : "CHGB1" 

+  CASE 9 : "CHGB2" 

+  CASE 10: "CHGB3" 

+  CASE 15: IF wert = 255 THEN "-DEAD" ELSE "WAIT " FI

+  OTHERWISE "?? "+hex8 (wert AND 252) 

+ ENDSELECT . 

+ 

+blocked: 

+ IF (wert AND 1) = 1 

+    THEN "-B"

+    ELSE "  "

+ FI

+ENDPROC status ; 

+ 

+TEXT PROC hex8 (INT CONST wert) : 

+ hex digit (wert DIV 16) + 

+ hex digit (wert AND 15) 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex16 (INT CONST wert) :

+ TEXT VAR t := "  " ; 

+ replace (t, 1, wert) ; 

+ hex digit (code (t SUB 2) DIV 16) + 

+ hex digit (code (t SUB 2) AND 15) + 

+ hex digit (code (t SUB 1) DIV 16) + 

+ hex digit (code (t SUB 1) AND 15) 

+ENDPROC hex16 ;

+ 

+TEXT PROC hex digit (INT CONST wert) : 

+ "0123456789ABCDEF" SUB (wert+1)

+ENDPROC hex digit ; 

+ 

+TEXT PROC bin (INT CONST wert, from, to) : 

+ INT VAR i ; 

+ TEXT VAR t := "" ; 

+ FOR i FROM to DOWNTO from REP 

+  IF bit (wert, i) THEN t CAT "1" 

+  ELSE t CAT "0" 

+  FI 

+ PER ; 

+ t 

+ENDPROC bin ; 

+ 

+PROC x task info (FILE VAR list file) : 

+ access catalogue ; 

+ put (list file, date) ;

+ put (list file, " ") ; 

+ put (list file, time of day) ; 

+ put (list file, " Size:") ; 

+ INT VAR size, used ; 

+ storage (size, used) ; 

+ put (list file, size) ; 

+ put (list file, "K Used:") ; 

+ put (list file, used) ; 

+ put (list file, "K  ") ; 

+ line (list file) ; 

+ put (list file, "TASK              ") ; 

+ put (list file, "taskid xhstatus rstflg edxa icount hptop mod chn") ; 

+ write (list file, "lin eln ecd mcd mgds fromid prvpbs c8k lbs ltoplstop"); 

+ put (list file, "pripck pct wstate mls") ;

+ line (list file) ; 

+ list tree (list file, supervisor, 0) 

+ENDPROC x task info ; 

+ 

+DATASPACE VAR ds ; 

+PROC x task info : 

+ disable stop ; 

+ ds := nilspace ; 

+ FILE VAR list file := sequentialfile (output, ds) ; 

+ max line length (list file, 1000) ;

+ x task info (list file) ; 

+ edit (list file) ; 

+ forget (ds) ; 

+ENDPROC x task info ; 

+ 

+PROC list tree (FILE VAR list file, TASK CONST first son, INT CONST depth) : 

+ enable stop ; 

+ TASK VAR actual task := first son ; 

+ WHILE NOT isniltask (actual task) REP 

+  list actual task ; 

+  list tree (list file, son (actual task), depth + 1) ; 

+  actual task := brother (actual task) 

+ PER . 

+ 

+list actual task : 

+ putline (list file, x status (actual task, depth)) 

+ 

+ENDPROC list tree ; 

+ 

+PROC x task status (TASK CONST t) : 

+ TEXT VAR zeile := x status (t, 0) ; 

+ line ; 

+ put ("Task:") ; putline (name (t)) ; 

+ putline ("taskid xhstatus rstflg edxa icount hptop mod chn lin eln ecd") ;

+ putline (subtext (zeile, 20, 80)) ; 

+ putline ("mcd mgds fromid prvpbs c8k lbs ltoplstoppripck pct wstate mls") ; 

+ putline (subtext (zeile, 81)) ; 

+ line 

+ENDPROC x task status ; 

+ 

+PROC x task status : 

+ x task status (myself) 

+ENDPROC x task status ; 

+ 

+ENDPACKET x task info ;

diff --git a/devel/misc/unknown/src/Z80.ELA b/devel/misc/unknown/src/Z80.ELA
new file mode 100644
index 0000000..905293c
--- /dev/null
+++ b/devel/misc/unknown/src/Z80.ELA
@@ -0,0 +1,495 @@
+PACKET z80 disassembler DEFINES hex, dez, disassemble, disass , acht :

+ 

+LET max = 4096; (* Anzahl Bytes der ROW DIV 2 *) 

+ 

+BOUND ROW max INT VAR row; 

+ 

+INT VAR next byte, 

+        next word, 

+        byte, 

+        div 8, 

+        and 7, 

+        and f, 

+        div 10; 

+TEXT VAR index; 

+ 

+belegen (0,0,0);

+ 

+INT PROC dez (TEXT CONST wert) : 

+  TEXT VAR zahl := wert; 

+  INT VAR i; 

+  REAL VAR summe := 0.0; 

+  IF (zahl SUB 1) = "!" THEN int(subtext(zahl, 2)) 

+  ELIF (zahl SUB 1) = "%" THEN zahl := subtext(zahl, 2); 

+     FOR i FROM length(zahl) DOWNTO 1 REP 

+       summe INCR (2.0**(length(zahl) - i))* real(number)

+     PER; 

+     IF summe > 32767.0 THEN int (summe - 65536.0) 

+                        ELSE int (summe) 

+     FI 

+  ELSE IF (zahl SUB 1) = "$" THEN zahl := subtext(zahl, 2) FI; 

+     FOR i FROM length(zahl) DOWNTO 1 REP 

+       summe INCR (16.0**(length(zahl) - i))* real(number) 

+     PER; 

+     IF summe > 32767.0 THEN int (summe - 65536.0) 

+                        ELSE int (summe) 

+     FI 

+  FI. 

+ 

+number : 

+  IF (zahl SUB i) > "9" 

+     THEN code( zahl SUB i) -55 

+     ELSE int (zahl SUB i) 

+  FI 

+ENDPROC dez; 

+ 

+PROC disassemble (TEXT CONST source code) : 

+    row := old(source code); 

+    INT VAR counter, start, pc, b1, b2, b3, b4, ende; 

+    TEXT VAR addr; 

+    page;

+    out ("         "15"                    Z80 - DISASSEMBLER                   "14""13""10""10"");

+    out ("Fü r Adressangaben: $ = hex, % = binä r, ! = dezimal."13""10""10""); 

+    out ("Hexadezimale Eingaben mit den Zeichen 0 bis F."13""10""10""); 

+    out ("Disassemblierung mit ESC abbrechen."13""10""10""); 

+    out ("Addresse des ersten Eintrags der Liste:"); 

+    addr:="$0000"; 

+    editget(addr); 

+    start := dez(addr); 

+  REP

+    REP

+    out (""10""13""); 

+    out ("Startaddresse fü r Disassemblierung    :"); 

+    addr:="$0000"; 

+    editget (addr); 

+    pc := dez(addr); 

+    UNTIL positive int (pc) >= positive int (start) PER;

+    REP

+    out (""10""13""); 

+    out ("Endaddresse fü r Disassemblierung      :"); 

+    addr:="$FFFF"; 

+    editget (addr); 

+    out (""10""13""); 

+    ende := dez(addr); 

+    UNTIL positive int (ende) >= positive int (pc) PER; 

+    REP 

+      berechne b1 bis b4; 

+      put (text(hex(pc),4)); 

+      put(""); 

+      dump; 

+      put (" ");

+      disass (b1, b2, b3, b4, pc); 

+      line; 

+    UNTIL isincharety (""27"") OR positiveint (pc) > positive int (ende) PER 

+  UNTIL no ("Noch weitere Bereiche disassemblieren") PER.

+ 

+berechne b1 bis b4 : 

+   counter := pc - start; 

+   b1 := acht (counter ); 

+   b2 := acht (counter + 1); 

+   b3 := acht (counter + 2); 

+   b4 := acht (counter + 3). 

+ 

+dump : 

+   put (                   text(hex(b1),3)+ 

+                           text(hex(b2),3)+

+                           text(hex(b3),3)+ 

+                           text(hex(b4),3));

+   put (""142"" + ascii(b1) + ascii(b2) + ascii(b3) + ascii(b4) + ""143"");

+ 

+ENDPROC disassemble; 

+ 

+TEXT PROC ascii (INT CONST byte) : 

+   IF (byte MOD 128) < 32 OR (byte MOD 128) = 127 THEN "." 

+     ELSE code(byte) 

+   FI 

+ENDPROC ascii; 

+ 

+REAL PROC positive int (INT CONST wert) : 

+     IF wert < 0 THEN real(wert) + 65536.0 

+     ELSE real(wert) 

+     FI 

+ENDPROC positive int; 

+ 

+ 

+INT PROC acht (INT CONST pos) : 

+   IF (pos DIV 2) + 1 > max THEN LEAVE acht WITH 0 FI; 

+   INT CONST word := row (pos DIV 2 + 1); 

+   TEXT VAR w := "  "; 

+   replace (w, 1, word) ;

+   IF  (pos MOD 2) = 1 THEN code(w SUB 1) 

+                       ELSE code(w SUB 2) 

+   FI 

+ENDPROC acht; 

+ 

+TEXT PROC hex (INT CONST zahl) : 

+    IF zahl < 0 

+       THEN digit (((zahl XOR -1) DIV 4096) XOR 15) + 

+            hex   (zahl MOD 4096) 

+    ELIF zahl < 16 

+       THEN digit (zahl) 

+       ELSE hex (zahl DIV 16) + digit (zahl MOD 16) 

+   FI 

+ENDPROC hex; 

+ 

+TEXT PROC digit (INT CONST d) : 

+   IF d < 10 

+      THEN code(d + 48) 

+      ELSE code(d + 55) 

+   FI 

+ENDPROC digit; 

+ 

+PROC belegen (INT CONST b1, b2, b3) : 

+    byte := b1; 

+    next byte := b2; 

+    next word := (code(b3)+code(b2)) ISUB 1; 

+    and 7 := byte AND 7; 

+    and f := byte AND 15; 

+    div 10:= byte DIV 16; 

+    div 8 := byte DIV 8 AND 7; 

+ENDPROC belegen; 

+ 

+PROC counter incr 1 (INT CONST b2, b3, b4) : 

+    byte := b2; 

+    next byte := b3; 

+    next word := (code(b4)+code(b3)) ISUB 1; 

+    and 7 := byte AND 7; 

+    and f := byte AND 15; 

+    div 10:= byte DIV 16; 

+    div 8 := byte DIV 8 AND 7; 

+ENDPROC counter incr 1;

+ 

+PROC counter incr 2 (INT CONST b3, b4) : 

+    byte := b3; 

+    next byte := b4; 

+    next word := b4;

+    and 7 := byte AND 7; 

+    and f := byte AND 15; 

+    div 10:= byte DIV 16; 

+    div 8 := byte DIV 8 AND 7; 

+ENDPROC counter incr 2;

+ 

+PROC disass (INT CONST b1, b2, b3, b4, INT VAR counter): 

+   counter INCR int disass (b1, b2, b3, b4, counter) 

+ENDPROC disass;

+

+TEXT PROC arith log :

+    SELECT div 8 OF 

+       CASE 0 : "ADD" 

+       CASE 1 : "ADC" 

+       CASE 2 : "SUB" 

+       CASE 3 : "SBC" 

+       CASE 4 : "AND" 

+       CASE 5 : "XOR" 

+       CASE 6 : "OR" 

+       CASE 7 : "CP"

+    OTHERWISE "???" 

+  ENDSELECT 

+ 

+ENDPROC arith log; 

+ 

+TEXT PROC reg1 : 

+    SELECT div8 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg1; 

+ 

+TEXT PROC reg2 : 

+    SELECT and7 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg2; 

+ 

+TEXT PROC rp: 

+    SELECT div10 AND 3 OF 

+      CASE 0 : "BC" 

+      CASE 1 : "DE" 

+      CASE 2 : "HL" 

+      CASE 3 : "SP"

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC rp; 

+ 

+ 

+INT PROC bitmanipulation : 

+   SELECT byte DIV 32 OF 

+     CASE 1 : write ("BIT "+text(div8)+","+reg2);2 

+     CASE 2 : write ("RES "+text(div8)+","+reg2);2 

+     CASE 3 : write ("SET "+text(div8)+","+reg2);2 

+     OTHERWISE write("??? $"+hex(next byte));1 

+   ENDSELECT 

+ 

+ENDPROC bitmanipulation;

+ 

+BOOL PROC is special instruction : 

+   byte > 192 AND (and 7 = 3 OR 

+                   and 7 = 6 OR 

+                   and f = 9 ) 

+OR byte < 64  AND (and 7 = 7 OR 

+                   and 7 = 0 OR 

+                   and 7 = 2 ) . 

+ 

+ENDPROC is special instruction; 

+ 

+INT PROC int disass (INT CONST b1, b2, b3, b4, counter) : 

+    belegen (b1, b2, b3); 

+    IF is special instruction 

+       THEN disass special instruction 

+    ELIF div 10 < 4 

+       THEN lower case instruction 

+    ELIF div 10 < 128 

+       THEN ld instruction 

+    ELIF div 10 < 192 

+       THEN arith log instruction 

+    ELSE higher case instruction 

+    FI. 

+ 

+arith log instruction : 

+    write (arith log+" "+reg 2);1 . 

+ 

+ld instruction : 

+  write ("LD "+reg 1+","+reg 2);1 . 

+ 

+condition code : 

+    SELECT div8 OF 

+      CASE 0 : "NZ" 

+      CASE 1 : "Z" 

+      CASE 2 : "NC" 

+      CASE 3 : "C" 

+      CASE 4 : "PO" 

+      CASE 5 : "PE" 

+      CASE 6 : "P" 

+      CASE 7 : "M" 

+      OTHERWISE "???" 

+    ENDSELECT. 

+ 

+lower case instruction : 

+   IF and f = 1 THEN write ("LD "+rp+",$"+hex(next word));3 

+ ELIF and 7 = 3 THEN write ("INC "+rp);1 

+ ELIF and 7 = 4 THEN write ("INC "+reg1);1 

+ ELIF and 7 = 5 THEN write ("DEC "+reg1);1 

+ ELIF and 7 = 6 THEN write ("LD "+reg1+",$"+hex(next byte));2 

+ ELIF and f = 9 THEN write ("ADD HL,"+rp);1 

+ ELIF and f =11 THEN write ("DEC "+rp);1 

+ ELSE write ("??? $"+hex(next byte));1 

+ FI. 

+ 

+higher case instruction : 

+   SELECT and 7 OF 

+      CASE 0 : write ("RET "+condition code);1 

+      CASE 1 : write ("POP "+rp);1 

+      CASE 2 : write ("JP "+condition code+",$"+hex(next word));3 

+      CASE 4 : write ("CALL "+condition code+",$"+hex(next word));3 

+      CASE 5 : write ("PUSH "+rp);1 

+      CASE 7 : write ("RST "+text(div 8));1 

+      OTHERWISE write ("??? $"+hex(next byte));1 

+   ENDSELECT. 

+ 

+ 

+branchaddress : 

+     "$" + hex(counter + displacement) . 

+ 

+displacement : 

+     IF next byte < 128 

+        THEN next byte + 2

+        ELSE next byte - 254 

+     FI. 

+ 

+cb instructions : 

+   counter incr 1 (b2, b3, b4);

+   SELECT div 8 OF 

+     CASE 0 : write ("RCC "+reg2);2 

+     CASE 1 : write ("RRC "+reg2);2 

+     CASE 2 : write ("RL "+reg2);2 

+     CASE 3 : write ("RR "+reg2);2 

+     CASE 4 : write ("SLA "+reg2);2 

+     CASE 5 : write ("SRA "+reg2);2 

+     CASE 6 : write ("SLL "+reg2);2 

+     CASE 7 : write ("SLR "+reg2);2 

+     OTHERWISE bitmanipulation 

+   ENDSELECT . 

+ 

+disass special instruction : 

+   SELECT byte OF 

+     CASE 0  : write ("NOP");1 

+     CASE 2  : write ("LD (BC),A");1 

+     CASE 7  : write ("RLCA");1 

+     CASE 8  : write ("EX AF,AF'");1 

+     CASE 10 : write ("LD A,(BC)");1 

+     CASE 15 : write ("RRCA");1 

+     CASE 16 : write ("DJNZ "+branchaddress);2 

+     CASE 18 : write ("LD (DE),A");1 

+     CASE 23 : write ("RLA");1 

+     CASE 24 : write ("JR "+branchaddress);2 

+     CASE 26 : write ("LD A,(DE)");1 

+     CASE 31 : write ("RRA");1 

+     CASE 32 : write ("JR NZ,"+branchaddress);2 

+     CASE 34 : write ("LD ($"+hex (next word)+"),HL");3 

+     CASE 39 : write ("DAA");1 

+     CASE 40 : write ("JR Z,"+branchaddress);2 

+     CASE 42 : write ("LD HL,($"+hex(next word)+")");3 

+     CASE 47 : write ("CPL");1 

+     CASE 48 : write ("JR NC,"+branchaddress);2 

+     CASE 50 : write ("LD ($"+hex(next word)+"),A");3 

+     CASE 55 : write ("SCF");1 

+     CASE 56 : write ("JR C,"+branchaddress);2 

+     CASE 58 : write ("LD A,($"+hex(next word)+")");3 

+     CASE 63 : write ("CCF");1 

+     CASE 118: write ("HALT");1 

+     CASE 195: write ("JP $"+hex(next word));3 

+     CASE 198: write ("ADD A,$"+hex(next byte));2 

+     CASE 201: write ("RET");1 

+     CASE 203: cb instructions 

+     CASE 205: write ("CALL $"+hex(next word));3 

+     CASE 206: write ("ADC A,$"+hex(next byte));2 

+     CASE 211: write ("OUT ($"+hex(next byte)+")");2 

+     CASE 214: write ("SUB A,$"+hex(next byte));2 

+     CASE 217: write ("EXX");1 

+     CASE 219: write ("IN ($"+hex(next byte)+")");2

+     CASE 221: index := "IX"; dd and fd instructions 

+     CASE 222: write ("SBC A,$"+hex(next byte));2 

+     CASE 227: write ("EX (SP),HL");1 

+     CASE 230: write ("AND $"+hex(next byte));2 

+     CASE 233: write ("JP (HL)");1 

+     CASE 235: write ("EX DE,HL");1 

+     CASE 237: ed instructions 

+     CASE 238: write ("XOR $"+hex(next byte));2 

+     CASE 243: write ("DI");1 

+     CASE 246: write ("OR $"+hex(next byte));2 

+     CASE 249: write ("LD SP,HL");2 

+     CASE 251: write ("EI");1 

+     CASE 253: index := "IY"; dd and fd instructions 

+     CASE 254: write ("CP $"+hex(next byte));2 

+   OTHERWISE write ("??? $"+hex(byte));1 

+   ENDSELECT. 

+ 

+dd and fd instructions : 

+   counter incr 1 (b2, b3, b4); 

+   SELECT byte OF 

+     CASE 33 : write ("LD "+index+",$"+hex(next word));4 

+     CASE 34 : write ("LD ($"+hex(next word)+"),"+index);4 

+     CASE 35 : write ("INC "+index);2 

+     CASE 42 : write ("LD "+index+",($"+hex(next word)+")");4 

+     CASE 43 : write ("DEC "+index);2 

+     CASE 52 : write ("INC ("+index+"+$"+hex(next byte)+")");2 

+     CASE 53 : write ("DEC ("+index+"+$"+hex(next byte)+")");2 

+     CASE 203: dd and fd cb instructions

+     CASE 225: write ("POP "+index);2 

+     CASE 227: write ("EX (SP),"+index);2 

+     CASE 229: write ("PUSH "+index);2 

+     CASE 233: write ("JP ("+index+")");2 

+     CASE 249: write ("LD SP,"+index);2 

+   OTHERWISE calculated dd and fd instructions 

+   ENDSELECT. 

+ 

+calculated dd and fd instructions : 

+     IF andf = 9 THEN write ("ADD "+index+","+rp);2 

+   ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8

+      THEN write ("LD "+reg1+",("+index+"+$"+hex(next byte)+")");3 

+   ELIF div 10 = 7 AND byte <> 118 

+      THEN write ("LD ("+index+"+$"+hex(next byte)+"),"+reg2);3 

+   ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 

+      THEN write (arith log+" ("+index+"+$"+hex(next byte)+")");3 

+   ELSE write ("??? $DD/FD "+hex(byte));2 

+   FI. 

+ 

+dd and fd cb instructions : 

+   counter incr 2 (b4, b3); 

+   IF and7 <> 6 THEN write ("??? $DD/FD "+hex(byte));3 

+   ELSE SELECT div 8 OF 

+          CASE 0 : write ("RLC ("+index+"+$"+hex(next byte)+")");4 

+          CASE 1 : write ("RRC ("+index+"+$"+hex(next byte)+")");4 

+          CASE 2 : write ("RL ("+index+"+$"+hex(next byte)+")");4 

+          CASE 3 : write ("RR ("+index+"+$"+hex(next byte)+")");4 

+          CASE 4 : write ("SLA ("+index+"+$"+hex(next byte)+")");4 

+          CASE 5 : write ("SRA ("+index+"+$"+hex(next byte)+")");4 

+          CASE 6 : write ("SLL ("+index+"+$"+hex(next byte)+")");4 

+          CASE 7 : write ("SRL ("+index+"+$"+hex(next byte)+")");4 

+        OTHERWISE dd and fd bitmanipulation 

+        ENDSELECT 

+   FI. 

+ 

+dd and fd bitmanipulation : 

+   SELECT byte DIV 32 OF 

+     CASE 1 : write ("BIT "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 

+     CASE 2 : write ("RES "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 

+     CASE 3 : write ("SET "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 

+     OTHERWISE write ("??? $DD/FD CB "+hex(next byte)+" "+hex(byte));4 

+   ENDSELECT. 

+ 

+ed instructions : 

+   counter incr 1 (b2, b3, b4);

+   SELECT byte OF 

+     CASE 68 : write ("NEG");2 

+     CASE 69 : write ("RETN");2 

+     CASE 70 : write ("IM 0");2 

+     CASE 71 : write ("LD I,A");2 

+     CASE 77 : write ("RETI");2 

+     CASE 79 : write ("LD R,A");2 

+     CASE 86 : write ("IM 1");2 

+     CASE 87 : write ("LD A,I");2 

+     CASE 94 : write ("IM 2");2 

+     CASE 95 : write ("LD A,R");2 

+     CASE 103: write ("RRD");2 

+     CASE 111: write ("RLD");2 

+     CASE 171: write ("OUTD");2 

+     CASE 163: write ("OUTI");2 

+     CASE 179: write ("OTIR");2 

+     CASE 187: write ("OTDR");2 

+   OTHERWISE calculate ed instruction 

+   ENDSELECT. 

+ 

+ 

+ENDPROC int disass ; 

+ 

+INT PROC calculate ed instruction : 

+     IF and7 = 0 AND is 40 to 7f THEN write ("IN "+reg1+",(C)");2 

+   ELIF and7 = 1 AND is 40 to 7f THEN write ("OUT "+reg1+",(C)");2 

+   ELIF andf = 2 AND is 40 to 7f THEN write ("SBC HL,"+rp);2 

+   ELIF andf = 3 AND is 40 to 7f THEN write ("LD ($"+hex(nextword)+"),"+rp);4

+   ELIF andf =11 AND is 40 to 7f THEN write ("LD "+rp+",($"+hex(nextword)+")");4 

+   ELIF andf =10 AND is 40 to 7f THEN write ("ADC HL,"+rp);2 

+   ELIF div10 = 10 OR div10 = 11 THEN

+          IF and7 = 0 THEN write ("LD"+modification);2 

+        ELIF and7 = 1 THEN write ("CP"+modification);2 

+        ELIF and7 = 2 THEN write ("IN"+modification);2 

+        ELSE write ("??? $ED "+hex(next byte));2 

+        FI 

+   ELSE write ("??? $ED "+hex(next byte));2 

+   FI. 

+ 

+is 40 to 7f : 

+   div 10 < 8 AND div 10 > 3. 

+ 

+modification : 

+   SELECT div8 OF 

+     CASE 0 : "I" 

+     CASE 1 : "D" 

+     CASE 2 : "IR" 

+     CASE 3 : "DR" 

+   OTHERWISE "???" 

+   ENDSELECT. 

+ 

+ENDPROC calculate ed instruction; 

+ 

+ENDPACKET z80 disassembler

+

diff --git a/dialog/ls-DIALOG 1 b/dialog/ls-DIALOG 1
deleted file mode 100644
index b4a2408..0000000
--- a/dialog/ls-DIALOG 1
+++ /dev/null
@@ -1,548 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 1                     ** 
-          **                                                     ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
-PACKET ls dialog 1  DEFINES                  
-       ecke oben  links,  balken oben,
-       ecke oben  rechts, balken rechts,
-       ecke unten links,  balken links,
-       ecke unten rechts, balken unten,
-       waagerecht, senkrecht, kreuz,
-       cursor on, cursor off,
-       clear buffer, clear buffer and count,
-       center, invers, page, page up,
-       out frame, out menuframe, erase frame,
-       std graphic char, ft20 graphic char,
-       ibm graphic char, AREA, :=, fill,
-       areax, areay, areaxsize, areaysize,
-       cursor, get cursor, out, out invers,
-
-       out with beam, out invers with beam,
-       erase, erase invers, erase with beam:
-TYPE AREA = STRUCT (INT x, y, xsize, ysize);
-LET blank     =     " ",
-    mark ein  =  ""15"",
-    mark aus  =  ""14"",
-    cleol     =   ""5"";
-TEXT CONST fehlermeldung :: "Unzulässige Größen!";
-TEXT VAR eol  := "+", eor  := "+", eul  := "+", eur  := "+",
-         bo   := "+", br   := "+", bl   := "+", bu   := "+",
-         waa  := "-", sen  := "|", kr   := "+",
-         cursor sichtbar     :=  "", cursor unsichtbar   :=  "";
-
-TEXT PROC ecke oben  links : eol END PROC ecke oben  links  ;
-TEXT PROC ecke oben  rechts: eor END PROC ecke oben  rechts ;
-TEXT PROC ecke unten links : eul END PROC ecke unten links  ;
-TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;
-TEXT PROC balken oben      : bo  END PROC balken oben       ;
-TEXT PROC balken links     : bl  END PROC balken links      ;
-TEXT PROC balken rechts    : br  END PROC balken rechts     ;
-TEXT PROC balken unten     : bu  END PROC balken unten      ;
-
-TEXT PROC waagerecht       : waa END PROC waagerecht        ;
-TEXT PROC senkrecht        : sen END PROC senkrecht         ;
-TEXT PROC kreuz            : kr  END PROC kreuz             ;
-PROC ecke oben  links  (TEXT CONST t): eol := t END PROC ecke oben  links  ;
-PROC ecke oben  rechts (TEXT CONST t): eor := t END PROC ecke oben  rechts ;
-PROC ecke unten links  (TEXT CONST t): eul := t END PROC ecke unten links  ;
-PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;
-
-PROC balken oben       (TEXT CONST t): bo  := t END PROC balken oben       ;
-PROC balken links      (TEXT CONST t): bl  := t END PROC balken links      ;
-PROC balken rechts     (TEXT CONST t): br  := t END PROC balken rechts     ;
-PROC balken unten      (TEXT CONST t): bu  := t END PROC balken unten      ;
-PROC waagerecht        (TEXT CONST t): waa := t END PROC waagerecht        ;
-PROC senkrecht         (TEXT CONST t): sen := t END PROC senkrecht         ;
-PROC kreuz             (TEXT CONST t): kr  := t END PROC kreuz             ;
-
-PROC std graphic char:
-  ecke oben  links  ("+"); ecke oben  rechts ("+");
-  ecke unten links  ("+"); ecke unten rechts ("+");
-  balken oben       ("+"); balken rechts     ("+");
-  balken links      ("+"); balken unten      ("+");
-  waagerecht        ("-"); senkrecht         ("|");
-  kreuz             ("+");
-  cursor sichtbar   := ""; cursor unsichtbar := ""
-END PROC std graphic char;
-PROC ft20 graphic char:
-  ecke oben  links (""27"R�"27"S"); ecke oben  rechts (""27"RD"27"S");
-  ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");
-
-  balken oben      (""27"RP"27"S"); balken rechts     (""27"RT"27"S");
-  balken links     (""27"RX"27"S"); balken unten      (""27"R\"27"S");
-  waagerecht       (""27"R`"27"S"); senkrecht         (""27"Rd"27"S");
-  kreuz            (""27"Rh"27"S");
-  cursor sichtbar  := ""27"-1"    ; cursor unsichtbar := ""27"-0"    ;
-  ft20 statuszeilen aus
-END PROC ft20 graphic char;
-PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;
-PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;
-
-PROC ibm graphic char:
-  ecke oben  links (""201"");  ecke oben  rechts (""187"");
-  ecke unten links (""200"");  ecke unten rechts (""188"");
-  balken oben      (""203"");  balken rechts     (""185"");
-  balken links     (""204"");  balken unten      (""202"");
-  waagerecht       (""205"");  senkrecht         (""186"");
-  kreuz            (""206"");
-  cursor sichtbar  := ""    ;  cursor unsichtbar := ""
-END PROC ibm graphic char;
-PROC cursor on                : out (cursor sichtbar  ) END PROC cursor on ;
-
-PROC cursor off               : out (cursor unsichtbar) END PROC cursor off;
-PROC cursor on  (TEXT CONST t): cursor sichtbar   := t  END PROC cursor on ;
-PROC cursor off (TEXT CONST t): cursor unsichtbar := t  END PROC cursor off;
-PROC clear buffer:
-  REP UNTIL incharety = "" PER
-END PROC clear buffer;
-INT PROC clear buffer and count (TEXT CONST zeichen):
-  INT  VAR zaehler :: 0;
-  TEXT VAR zeichenkette :: "", ch;
-  IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;
-
-  ermittle die zeichenkette;
-  untersuche auf vorhandene zeichen;
-  zaehler.
-  ermittle die zeichenkette:
-    REP
-      ch := incharety (1);
-      zeichenkette CAT ch
-    UNTIL ch = "" PER.
-  untersuche auf vorhandene zeichen:
-    INT VAR i;
-    FOR i FROM 1 UPTO length (zeichenkette) REP
-      IF pos (subtext (zeichenkette, i), zeichen) = 1
-         THEN zaehler INCR 1
-      FI
-    PER.
-END PROC clear buffer and count;
-TEXT PROC center (INT CONST xsize, TEXT CONST t):
-  TEXT VAR zeile :: compress (t);
-
-  zeile := ((xsize  - length (zeile)) DIV 2) * blank + zeile;
-  zeile CAT (xsize - length (zeile)) * blank;
-  zeile
-END PROC center;
-TEXT PROC center (TEXT CONST t):
-  center (79, t)
-END PROC center;
-TEXT PROC invers (TEXT CONST t):
-  TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;
-  neu
-END PROC invers;
-PROC page (INT CONST x, y, xsize, ysize):
-    INT VAR zeiger;
-    IF x + xsize = 80
-       THEN in einem streich
-       ELSE putze vorsichtig
-    FI;
-    cursor (x, y).
-
-    in einem streich:
-      FOR zeiger FROM y UPTO y + ysize - 1 REP
-        cursor (x, zeiger); out (cleol)
-      PER.
-    putze vorsichtig:
-      FOR zeiger FROM y UPTO y + ysize - 1  REP
-        cursor (x, zeiger); xsize TIMESOUT blank
-      PER.
-END PROC page;
-PROC page (AREA CONST a):
-  page (a.x, a.y, a.xsize, a.ysize)
-END PROC page;
-PROC page up (INT CONST x, y, xsize, ysize):
-    INT VAR zeiger;
-    IF x + xsize = 80
-       THEN in einem streich
-       ELSE putze vorsichtig
-
-    FI.
-    in einem streich:
-      FOR zeiger FROM y + ysize - 1 DOWNTO y REP
-        cursor (x, zeiger); out (cleol)
-      PER.
-    putze vorsichtig:
-      FOR zeiger FROM y + ysize - 1  DOWNTO y REP
-        cursor (x, zeiger); xsize TIMESOUT blank
-      PER.
-END PROC page up;
-PROC page up (AREA CONST a):
-  page up (a.x, a.y, a.xsize, a.ysize)
-END PROC page up;
-PROC out frame (INT CONST x, y, xsize, ysize):
-  INT VAR zeiger;
-  IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR
-     x + xsize > 80  COR y + ysize > 25
-
-     THEN LEAVE out frame
-  FI;
-  male oben;
-  male seiten;
-  male unten.
-  male oben:
-    cursor (x, y);
-    out (ecke oben links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke oben rechts).
-  male seiten:
-    FOR zeiger FROM 1 UPTO ysize - 2 REP
-      cursor (x,             y + zeiger); out (senkrecht);
-      cursor (x + xsize - 1, y + zeiger); out (senkrecht)
-    PER.
-  male unten:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-
-    out (ecke unten rechts)
-END PROC out frame;
-PROC out frame (AREA CONST a):
-  IF    a.x - 1     <  1  OR a.y - 1     <  1
-     OR a.xsize + 2 > 79 OR a.ysize + 2 > 24
-     OR a.x + a.xsize + 1 > 80
-     OR a.y + a.ysize + 1 > 25
-     THEN LEAVE out frame
-  FI;
-  out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2)
-END PROC out frame;
-PROC out menuframe (INT CONST x, y, xsize, ysize):
-  INT VAR i;
-  untersuche angaben;
-  schreibe rahmen.
-  untersuche angaben:
-    IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26
-
-       THEN LEAVE out menuframe
-    FI.
-  schreibe rahmen:
-    IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26
-       THEN zeichne reduzierten rahmen
-       ELSE zeichne vollen rahmen
-    FI.
-  zeichne reduzierten rahmen:
-    zeichne oberlinie;
-    zeichne unterlinie.
-  zeichne oberlinie:
-    cursor (1, 2);
-    79 TIMESOUT waagerecht.
-  zeichne unterlinie:
-    cursor (1, 23);
-    79 TIMESOUT waagerecht.
-  zeichne vollen rahmen:
-    schreibe kopf; schreibe rumpf; schreibe fuss;
-
-    schreibe kopfleiste; schreibe fussleiste.
-  schreibe kopf:
-    cursor (x, y);
-    out (ecke oben links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke oben rechts).
-  schreibe rumpf:
-    FOR i FROM y + 1 UPTO y + ysize - 2 REP
-      cursor (x,             i); out (senkrecht);
-      cursor (x + xsize - 1, i); out (senkrecht)
-    PER.
-  schreibe fuss:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten rechts).
-
-  schreibe kopfleiste:
-    cursor (x, y + 2        ); schreibe balkenlinie.
-  schreibe fussleiste:
-    cursor (x, y + ysize - 3); schreibe balkenlinie.
-  schreibe balkenlinie:
-    out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).
-END PROC out menuframe;
-PROC out menuframe (AREA CONST a):
- out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2)
-END PROC out menuframe;
-PROC erase frame (INT CONST x, y, xsize, ysize):
-  INT VAR zeiger;
-  loesche oben; loesche seiten; loesche unten.
-
-  loesche oben:
-    cursor (x, y); xsize TIMESOUT blank.
-  loesche seiten:
-    FOR zeiger FROM 1 UPTO ysize - 2 REP
-      cursor (x, y + zeiger); out (blank);
-      cursor (x + xsize - 1, y + zeiger); out (blank)
-    PER.
-  loesche unten:
-    cursor (x, y + ysize - 1); xsize TIMESOUT blank.
-END PROC erase frame;
-OP := (AREA VAR ziel, AREA CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-END OP :=;
-PROC fill (AREA VAR ziel, INT CONST a, b, c, d):
-  IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3
-
-     COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25
-     THEN errorstop (fehlermeldung)
-  FI;
-  ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d
-END PROC fill;
-INT PROC areax     (AREA CONST a): a.x      END PROC areax;
-INT PROC areay     (AREA CONST a): a.y      END PROC areay;
-INT PROC areaxsize (AREA CONST a): a.xsize  END PROC areaxsize;
-INT PROC areaysize (AREA CONST a): a.ysize  END PROC areaysize;
-PROC out (TEXT CONST t, INT CONST breite):
-  outtext (t, 1, breite)
-
-END PROC out;
-PROC erase (INT CONST breite):
-  breite TIMESOUT blank
-END PROC erase;
-PROC cursor (AREA CONST a, INT CONST spa, zei):
-  cursor (a.x + spa - 1, a.y + zei - 1)
-END PROC cursor;
-PROC get cursor (AREA CONST a, INT VAR spalte, zeile):
-  INT VAR x, y;
-  get cursor (x, y);
-  spalte := x - a.x + 1; zeile  := y - a.y + 1
-END PROC get cursor;
-PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF text ist zu lang
-     THEN verkuerzte ausgabe
-
-     ELSE out (t)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1
-       THEN LEAVE out
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 1, a.y + zei - 1).
-  text ist zu lang:
-    length (t) > a.xsize - spa + 1.
-  verkuerzte ausgabe:
-    outsubtext (t, 1, a.xsize - spa + 1)
-END PROC out;
-PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-
-     THEN verkuerzte ausgabe
-     ELSE outtext (t, 1, laenge)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1
-       THEN LEAVE out
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 1, a.y + zei - 1).
-  laenge ist zu gross:
-    laenge > a.xsize - spa + 1.
-  verkuerzte ausgabe:
-    outtext (t, 1, a.xsize - spa + 1)
-END PROC out;
-PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE erase (laenge)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1
-       THEN LEAVE erase
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 1, a.y + zei - 1).
-  laenge ist zu gross:
-    laenge > a.xsize - spa + 1.
-  verkuerzte ausgabe:
-    erase (a.xsize - spa + 1)
-END PROC erase;
-PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
-  ueberpruefe cursorangaben; positioniere cursor;
-
-  IF text ist zu lang
-     THEN verkuerzte ausgabe
-     ELSE out (mark ein); out (t); out (blank); out (mark aus)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1
-       THEN LEAVE out invers
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 2, a.y + zei - 1).
-  text ist zu lang:
-    length (t) > a.xsize - spa - 1.
-  verkuerzte ausgabe:
-    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);
-    out (blank); out (mark aus)
-END PROC out invers;
-
-PROC out invers (AREA CONST a, INT CONST spa, zei,
-                 TEXT CONST t, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1
-       THEN LEAVE out invers
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 2, a.y + zei - 1).
-
-  laenge ist zu gross:
-    laenge > a.xsize - spa - 1.
-  verkuerzte ausgabe:
-    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);
-    out (blank); out (mark aus)
-END PROC out invers;
-PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE erase (laenge + 3)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1
-
-       THEN LEAVE erase invers
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 2, a.y + zei - 1).
-  laenge ist zu gross:
-    laenge > a.xsize - spa - 1.
-  verkuerzte ausgabe:
-    erase ( a.xsize - spa + 2).
-END PROC erase invers;
-PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF text ist zu lang
-     THEN verkuerzte ausgabe
-     ELSE out (senkrecht); out (blank); out (blank);
-          out (t);
-          out (blank); out (blank); out (senkrecht)
-
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
-       THEN LEAVE out with beam
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 4, a.y + zei - 1).
-  text ist zu lang:
-    length (t) > a.xsize - spa - 2.
-  verkuerzte ausgabe:
-    out (senkrecht); out (blank); out (blank);
-    outsubtext (t, 1, a.xsize - spa - 2);
-    out (blank); out (blank); out (senkrecht)
-END PROC out with beam;
-PROC out with beam (AREA CONST a, INT CONST spa, zei,
-
-                    TEXT CONST t, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE out (senkrecht); out (blank); out (blank);
-          outtext (t, 1,laenge);
-          out (blank); out (blank); out (senkrecht)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
-       THEN LEAVE out with beam
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 4, a.y + zei - 1).
-
-  laenge ist zu gross:
-    laenge > a.xsize - spa - 2.
-  verkuerzte ausgabe:
-    out (senkrecht); out (blank); out (blank);
-    outsubtext (t, 1, a.xsize - spa - 2);
-    out (blank); out (blank); out (senkrecht)
-END PROC out with beam;
-PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE erase (laenge + 6)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
-
-       THEN LEAVE erase with beam
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 4, a.y + zei - 1).
-  laenge ist zu gross:
-    laenge > a.xsize - spa - 2.
-  verkuerzte ausgabe:
-    erase (a.xsize - spa + 4).
-END PROC erase with beam;
-PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF text ist zu lang
-     THEN verkuerzte ausgabe
-     ELSE out (senkrecht); out (blank); out (mark ein);
-          out (t);
-
-          out (blank); out (mark aus); out (senkrecht)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
-       THEN LEAVE out invers with beam
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 4, a.y + zei - 1).
-  text ist zu lang:
-    length (t) > a.xsize - spa - 2.
-  verkuerzte ausgabe:
-    out (senkrecht); out (blank); out (mark ein);
-    outsubtext (t, 1, a.xsize - spa - 2);
-    out (blank); out (mark aus); out (senkrecht)
-
-END PROC out invers with beam;
-PROC out invers with beam (AREA CONST a, INT CONST spa, zei,
-                           TEXT CONST t, INT CONST laenge):
-  ueberpruefe cursorangaben; positioniere cursor;
-  IF laenge ist zu gross
-     THEN verkuerzte ausgabe
-     ELSE out (senkrecht); out (blank); out (mark ein);
-          outtext (t, 1, laenge);
-          out (blank); out (mark aus); out (senkrecht)
-  FI.
-  ueberpruefe cursorangaben:
-    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1
-
-       THEN LEAVE out invers with beam
-    FI.
-  positioniere cursor:
-    cursor (a.x + spa - 4, a.y + zei - 1).
-  laenge ist zu gross:
-    laenge > a.xsize - spa - 2.
-  verkuerzte ausgabe:
-    out (senkrecht); out (blank); out (mark ein);
-    outsubtext (t, 1, a.xsize - spa - 2);
-    out (blank); out (mark aus); out (senkrecht)
-END PROC out invers with beam;
-END PACKET ls dialog 1;
-
-
diff --git a/dialog/ls-DIALOG 2 b/dialog/ls-DIALOG 2
deleted file mode 100644
index 7fb5d36..0000000
--- a/dialog/ls-DIALOG 2
+++ /dev/null
@@ -1,844 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 2                     ** 
-          **                                                     ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
-PACKET ls dialog 2  DEFINES                  
-       some,
-       one,
-       infix namen,
-       ohne praefix,
-       not empty:
-LET maxentries           = 200;
-LET zeichenstring                           =  ""1""27""3""10""13""12"xo?",
-    oben unten return rubout kreuz kringel  =  ""3""10""13""12"xo",
-    q eins neun h                           =  "q19h";
-LET zurueck    =   ""8"",
-    piep       =   ""7"";
-LET hop        =  1,
-    esc        =  2,
-    oben       =  3,
-    unten      =  4,
-    return     =  5,
-    rubout     =  6,
-
-    kreuz      =  7,
-    kringel    =  8,
-    frage      =  9;
-LET punkt      =  ".",
-    gleich     =  "=",
-    blank      =  " ";
-INT  VAR x,
-         y,
-         xsize,
-         ysize,
-         maxeintraege,
-         anzahl,
-         erste auswahlzeile,
-         virtueller cursor,
-         reeller cursor;
-TEXT VAR kennzeile 1,
-         kennzeile 2,
-         registrierkette :: "";
-BOOL VAR abbruch,
-         auswahlende;
-BOUND ROW max entries TEXT VAR eintrag;
-ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : (
-
-  "Unzulässige Cursorwerte bei der Auswahl",
-  "Fenster für Auswahl zu klein (x < 56 / y < 15)");
-ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : (
-  " Bitte warten... Ich sortiere und räume auf!",
-  " Info: <?>  Fertig: <ESC><q>  Abbrechen: <ESC><h>",
-  " Zum Weitermachen bitte irgendeine Taste tippen!",
-  "Weitere Dateien!",
-  "INFORMATIONEN: Auswahl  mehrerer  Dateien",
-  "INFORMATIONEN: Auswahl  einer Datei",
-  "                       "15"Positionierungen: "14"",
-  "  hoch               : zum vorausgehenden Namen",
-
-  "  runter             : zum folgenden   Namen",
-  "  HOP hoch           : auf den ersten  Namen der Seite",  (***********)
-  "  HOP runter         : auf den letzten Namen der Seite",  (*  bitte  *)
-  "  ESC 1              : auf den ersten  Namen der Liste",  (*  diese  *)
-  "  ESC 9              : auf den letzten Namen der Liste",  (*  Länge  *)
-  "                       "15"Auswahl treffen: "14"",        (*  nicht  *)
-  "  RETURN     / x     : diesen Namen ankreuzen ",          (*  über-  *)
-
-  "  RUBOUT     / o     : Kreuz vor dem Namen loeschen",     (*  schrei-*)
-  "  HOP RETURN / HOP x : alle folgende Namen ankreuzen",    (*  ten!   *)
-  "  HOP RUBOUT / HOP o : alle folgende Kreuze loeschen",    (***********)
-  "                       "15"Auswahl verlassen: "14"",
-  "  ESC q              : Auswahl verlassen",
-  "  ESC h              : Auswahl abbrechen",
-  "  Auswahl   m e h r e r e r   Dateien durch Ankreuzen",
-  "  Auswahl   e i n e r   Datei durch Ankreuzen",
-  " Bitte warten... Ich breche die Auswahl ab!"
-
-  );
-THESAURUS PROC auswahl (THESAURUS CONST t,
-                        BOOL CONST mehrere moeglich,
-                        TEXT CONST t1, t2):
-  werte initialisieren;
-  namen besorgen;
-  bildschirm aufbauen;
-  auswaehlen lassen;
-  abgang vorbereiten.
-  werte initialisieren:
-    THESAURUS VAR ausgabe :: empty thesaurus;
-    DATASPACE VAR ds      := nilspace;
-    eintrag               := ds;
-    kennzeile 1           := t1;
-    kennzeile 2           := t2;
-    abbruch               := FALSE;
-
-    erste auswahlzeile    := y + 7;
-    anzahl                := 0;
-    maxeintraege          := ysize - 11;
-    virtueller cursor     := 1;
-    reeller cursor        := 1.
-  namen besorgen:
-    fische die namen aus dem thesaurus;
-    IF kein eintrag vorhanden
-       THEN LEAVE auswahl WITH ausgabe
-    FI.
-  bildschirm aufbauen:
-    schreibe kopfzeile;
-    gib hinweis aus (kennzeile 1, kennzeile 2);
-    gib erklaerungszeile aus (mehrere moeglich);
-    baue bildschirm auf (1);
-    footnote (x, y, xsize, ysize, hinweis [2]);
-
-    schreibe fusszeile;
-    reellen cursor setzen .
-  schreibe kopfzeile:
-    cursor (x, y);
-    out(ecke oben links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out(ecke oben rechts).
-  schreibe fusszeile:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten rechts).
-  auswaehlen lassen:
-    kreuze an (mehrere moeglich).
-  abgang vorbereiten:
-    IF abbruch
-       THEN change footnote (x, y, xsize, ysize, hinweis [24])
-
-       ELSE change footnote (x, y, xsize, ysize, hinweis [ 1])
-    FI;
-    cursor (x + 1, y + ysize - 1);
-    ausgabe erzeugen;
-    forget (ds);
-    ausgabe.
-  fische die namen aus dem thesaurus:
-    INT VAR zeiger;
-    FOR zeiger FROM 1 UPTO highest entry (t) REP
-      IF name (t, zeiger) <> ""
-         THEN anzahl INCR 1;
-              eintrag [anzahl] := name (t, zeiger)
-      FI
-    PER.
-  kein eintrag vorhanden:
-    anzahl = 0.
-  ausgabe erzeugen:
-    TEXT VAR nummer;
-    WHILE registrierkette <> "" REP
-
-      nummer          := subtext (registrierkette, 1, 3);
-      registrierkette := subtext (registrierkette, 5);
-      insert (ausgabe, eintrag [ int (nummer)])
-    PER.
-END PROC auswahl;
-PROC reellen cursor setzen:
-  cursor (x + 1, erste auswahlzeile + reeller cursor - 1);
-  out (marke (virtueller cursor, TRUE) + (8 * zurueck))
-END PROC reellen cursor setzen;
-PROC baue bildschirm auf (INT CONST anfang):
-  gib kopfzeile aus;
-  gib namenstabelle aus;
-  gib fusszeile aus;
-  loesche ggf restbereich.
-
-  gib kopfzeile aus:
-    cursor (x, erste auswahlzeile - 1); out (senkrecht);
-    IF reeller cursor = virtueller cursor
-       THEN (xsize - 2) TIMESOUT punkt
-       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
-            out (invers (hinweis [4]))
-    FI;
-    out (senkrecht);
-    line.
-  gib namenstabelle aus:
-    INT VAR zeiger, zaehler :: -1;
-    FOR zeiger FROM anfang UPTO grenze REP
-      zaehler INCR 1;
-      cursor (x, erste auswahlzeile + zaehler);
-      out (senkrecht); out (marke (zeiger, FALSE));
-
-      outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);
-      out (senkrecht);
-    PER.
-  gib fusszeile aus:
-    cursor (x, erste auswahlzeile + zaehler + 1);
-    out (senkrecht);
-    IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl)
-       THEN (xsize - 2) TIMESOUT punkt
-       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
-            out (invers (hinweis [4]))
-    FI;
-    out (senkrecht).
-  loesche ggf restbereich:
-    IF zaehler + 1 < maxeintraege
-
-       THEN loesche bildschirmrest
-    FI.
-  loesche bildschirmrest:
-    FOR zeiger FROM restanfang UPTO restende REP
-      cursor (x, zeiger); out (senkrecht);
-                          (xsize - 2) TIMESOUT blank;
-                          out (senkrecht)
-    PER.
-  restanfang:
-    erste auswahlzeile + zaehler + 2.
-  restende:
-    erste auswahlzeile + maxeintraege.
-  grenze:
-    min (anzahl, anfang + max eintraege - 1).
-END PROC baue bildschirm auf;
-TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):
-
-  INT VAR platz := nr (zeiger);
-  IF platz = 0
-     THEN leer
-     ELSE mit zahl
-  FI.
-  mit zahl:
-    IF mit cursor
-       THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "
-       ELSE "   " + (3 - length (text (platz))) * blank + text (platz) + "x "
-    FI.
-  leer:
-    IF mit cursor
-       THEN "==>   o "
-       ELSE "      o "
-    FI.
-END PROC marke;
-INT PROC nr (INT CONST zeiger):
-  IF pos (registrierkette, textstring (zeiger)) = 0
-     THEN 0
-     ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1
-
-  FI
-END PROC nr;
-TEXT PROC textstring (INT CONST nr):
-  text (nr, 3) + "!"
-END PROC textstring;
-PROC info (BOOL CONST mehrere):
-  notiere hinweisueberschrift;
-  notiere positionierhinweise;
-  IF noch platz vorhanden
-     THEN  notiere auswahlmoeglichkeiten auf alter seite
-     ELSE  wechsle auf naechste seite;
-           notiere hinweisueberschrift;
-           notiere auswahlmoeglichtkeiten auf neuer seite
-  FI;
-  stelle alten bildschirmzustand wieder her.
-  notiere hinweisueberschrift:
-
-    cursor (x + 1, y +  1);
-    IF mehrere
-       THEN out (center(xsize - 2, invers (hinweis [5])))
-       ELSE out (center(xsize - 2, invers (hinweis [6])))
-    FI;
-    cursor (x + 1, y +  2); out ("", xsize - 2).
-  notiere positionierhinweise:
-    cursor (x + 1, y +  3); out (hinweis [ 7], xsize - 2);
-    cursor (x + 1, y +  4); out (hinweis [ 8], xsize - 2);
-    cursor (x + 1, y +  5); out (hinweis [ 9], xsize - 2);
-    cursor (x + 1, y +  6); out (hinweis [10], xsize - 2);
-    cursor (x + 1, y +  7); out (hinweis [11], xsize - 2);
-
-    cursor (x + 1, y +  8); out (hinweis [12], xsize - 2);
-    cursor (x + 1, y +  9); out (hinweis [13], xsize - 2).
-  notiere auswahlmoeglichkeiten auf alter seite:
-    cursor (x + 1, y + 10); out ("", xsize - 2);
-    cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);
-    cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);
-    IF mehrere
-       THEN  gib alle auswahlmoeglichkeiten auf der alten seite an
-       ELSE  gib eine auswahlmoeglichkeit   auf der alten seite an
-    FI;
-
-    notiere verlassmoeglichkeiten auf der alten seite;
-    loesche die restlichen zeilen;
-    change footnote (x, y, xsize, ysize, hinweis [3]);
-    cursor in ruhestellung;
-    clear buffer.
-  gib alle auswahlmoeglichkeiten auf der alten seite an:
-    cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);
-    cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);
-    cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).
-  gib eine auswahlmoeglichkeit auf der alten seite an:
-    cursor (x + 1, y + 13); out ("", xsize - 2);
-
-    cursor (x + 1, y + 14); out ("", xsize - 2);
-    cursor (x + 1, y + 15); out ("", xsize - 2).
-  notiere verlassmoeglichkeiten auf der alten seite:
-    cursor (x + 1, y + 16); out ("", xsize - 2);
-    cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);
-    cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);
-    cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).
-  loesche die restlichen zeilen:
-    IF ysize = 24
-       THEN cursor (x + 1, y + 20); out ("", xsize - 2)
-    FI.
-
-  wechsle auf naechste seite:
-    loesche seitenrest;
-    change footnote (x, y, xsize, ysize, hinweis [3]);
-    cursor in ruhestellung;
-    clear buffer;
-    pause.
-  loesche seitenrest:
-    INT VAR zaehler;
-    FOR zaehler FROM 10 UPTO ysize - 4 REP
-      cursor (x + 1, y + zaehler); out ("", xsize - 2)
-    PER.
-  notiere auswahlmoeglichtkeiten auf neuer seite:
-    cursor (x + 1, y +  3); out (hinweis [14], xsize - 2);
-    cursor (x + 1, y +  4); out (hinweis [15], xsize - 2);
-    IF mehrere
-
-       THEN  gib alle auswahlmoeglichkeiten auf der neuen seite an
-       ELSE  gib eine auswahlmoeglichkeit   auf der neuen seite an
-    FI;
-    notiere verlassmoeglichkeiten auf der neuen seite.
-  gib alle auswahlmoeglichkeiten auf der neuen seite an:
-    cursor (x + 1, y +  5); out (hinweis [16], xsize - 2);
-    cursor (x + 1, y +  6); out (hinweis [17], xsize - 2);
-    cursor (x + 1, y +  7); out (hinweis [18], xsize - 2).
-  gib eine auswahlmoeglichkeit auf der neuen seite an:
-    cursor (x + 1, y +  5); out ("", xsize - 2);
-
-    cursor (x + 1, y +  6); out ("", xsize - 2);
-    cursor (x + 1, y +  7); out ("", xsize - 2).
-  notiere verlassmoeglichkeiten auf der neuen seite:
-    cursor (x + 1, y +  8); out ("", xsize - 2);
-    cursor (x + 1, y +  9); out (hinweis [19], xsize - 2);
-    cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);
-    cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);
-    cursor in ruhestellung.
-  cursor in ruhestellung:
-    cursor (x + 1, y + ysize - 2).
-  stelle alten bildschirmzustand wieder her:
-
-    clear buffer;
-    pause;
-    gib hinweis aus (kennzeile 1, kennzeile 2);
-    gib erklaerungszeile aus (mehrere);
-    virtueller cursor := 1;
-    reeller    cursor := 1;
-    baue bildschirm auf (1);
-    change footnote (x, y, xsize, ysize, hinweis [2]);
-    reellen cursor setzen.
-  noch platz vorhanden:
-    (ysize - 4) > 18.
-END PROC info;
-PROC kreuze an (BOOL CONST mehrere):
-  auswahlende := FALSE;
-  REP
-    zeichen lesen; zeichen interpretieren
-  UNTIL auswahlende PER.
-  zeichen lesen:
-
-    TEXT VAR zeichen;
-    getchar (zeichen).
-  zeichen interpretieren:
-    SELECT pos (zeichenstring, zeichen) OF
-      CASE hop      : hop kommando verarbeiten (mehrere)
-      CASE esc      : esc kommando verarbeiten
-      CASE oben     : nach oben
-      CASE unten    : nach unten
-      CASE kreuz    : ankreuzen; evtl aufhoeren
-      CASE return   : ankreuzen weiter; evtl aufhoeren
-      CASE rubout   : auskreuzen weiter
-      CASE kringel  : auskreuzen
-      CASE frage    : info (mehrere)
-
-      OTHERWISE       out (piep)
-    END SELECT.
-  evtl aufhoeren:
-    IF NOT mehrere
-      THEN LEAVE kreuze an
-    FI.
-END PROC kreuze an;
-PROC hop kommando verarbeiten (BOOL CONST mehrere):
-  zweites zeichen lesen;
-  zeichen interpretieren.
-  zweites zeichen lesen:
-    TEXT VAR zweites zeichen;
-    getchar(zweites zeichen).
-  zeichen interpretieren:
-    SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF
-      CASE 1    : hop nach oben
-      CASE 2    : hop nach unten
-
-      CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI
-      CASE 4, 6 : IF mehrere THEN alle darunter loeschen  FI
-      OTHERWISE   out (piep)
-    END SELECT.
-  alle darunter ankreuzen:
-    INT VAR i;
-    FOR i FROM virtueller cursor UPTO anzahl REP
-      IF nr (i) = 0
-         THEN ankreuzen
-      FI
-    PER;
-    bild aktualisieren ;
-    reellen cursor setzen .
-  ankreuzen:
-    registrierkette CAT textstring (i).
-  alle darunter loeschen:
-    INT VAR j, position;
-    FOR j FROM virtueller cursor UPTO anzahl REP
-
-      position := nr (j);
-      IF position > 0
-         THEN rausschmeissen;
-      FI
-    PER;
-    bild aktualisieren;
-    reellen cursor setzen.
-  rausschmeissen:
-   registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +
-                      subtext (registrierkette, (4 * position) + 1).
-  hop nach oben:
-    IF   ganz oben
-         THEN out (piep)
-    ELIF oben auf der seite
-         THEN raufblaettern
-         ELSE top of page
-    FI.
-  ganz oben:
-    virtueller cursor = 1.
-
-  oben auf der seite:
-    reeller cursor = 1.
-  raufblaettern:
-    virtueller cursor DECR max eintraege;
-    virtueller cursor := max (virtueller cursor, 1);
-    baue bildschirm auf (virtueller cursor);
-    reellen cursor setzen.
-  top of page:
-    loesche marke;
-    virtueller cursor DECR (reeller cursor - 1);
-    reeller cursor := 1;
-    reellen cursor setzen.
-  hop nach unten:
-    IF   ganz unten
-         THEN out (piep)
-    ELIF unten auf der seite
-         THEN runterblaettern
-
-         ELSE bottom of page
-    FI.
-  ganz unten:
-    virtueller cursor = anzahl.
-  unten auf der seite:
-    reeller cursor > max eintraege - 1.
-  runterblaettern:
-    INT VAR alter virtueller cursor :: virtueller cursor;
-    virtueller cursor INCR max eintraege;
-    virtueller cursor := min (virtueller cursor, anzahl);
-    reeller cursor    := virtueller cursor - alter virtueller cursor;
-    baue bildschirm auf (alter virtueller cursor + 1);
-    reellen cursor setzen.
-  bottom of page:
-
-    loesche marke;
-    alter virtueller cursor := virtueller cursor;
-    virtueller cursor INCR (max eintraege - reeller cursor);
-    virtueller cursor := min (anzahl, virtueller cursor);
-    reeller cursor INCR (virtueller cursor - alter virtueller cursor);
-    reellen cursor setzen.
-END PROC hop kommando verarbeiten;
-PROC esc kommando verarbeiten:
-  TEXT VAR zweites zeichen;
-  getchar (zweites zeichen);
-  SELECT pos (q eins neun h, zweites zeichen) OF
-    CASE 1 :  auswahlende     := TRUE
-
-    CASE 2 :  zeige anfang
-    CASE 3 :  zeige ende
-    CASE 4 :  abbruch         := TRUE;
-              auswahlende     := TRUE;
-              registrierkette := ""
-    OTHERWISE out (piep)
-  END SELECT.
-  zeige anfang:
-    IF   virtueller cursor = 1
-         THEN out (piep)
-    ELIF virtueller cursor = reeller cursor
-         THEN loesche marke;
-              virtueller cursor := 1;
-              reeller cursor    := 1;
-              reellen cursor setzen
-         ELSE virtueller cursor := 1;
-
-              reeller cursor    := 1;
-              baue bildschirm auf (1);
-              reellen cursor setzen
-    FI.
-  zeige ende:
-    IF   virtueller cursor = anzahl
-         THEN out (piep)
-    ELIF ende auf bildschirm
-         THEN loesche marke;
-              reeller cursor INCR (anzahl - virtueller cursor);
-              virtueller cursor := anzahl;
-              reellen cursor setzen
-         ELSE virtueller cursor := anzahl;
-              reeller cursor    := max eintraege;
-
-              baue bildschirm auf (anzahl - (max eintraege - 1));
-              reellen cursor setzen
-    FI.
-  ende auf bildschirm:
-    (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.
-END PROC esc kommando verarbeiten;
-PROC ankreuzen:
-  INT VAR platz :: nr (virtueller cursor);
-  IF platz <> 0
-     THEN out (piep);
-          LEAVE ankreuzen
-  FI;
-  registrierkette CAT textstring (virtueller cursor);
-  reellen cursor setzen
-END PROC ankreuzen;
-PROC ankreuzen weiter:
-
-  INT VAR platz :: nr (virtueller cursor);
-  IF platz <> 0
-     THEN out (piep);
-          LEAVE ankreuzen weiter
-  FI;
-  registrierkette CAT textstring (virtueller cursor);
-  IF virtueller cursor < anzahl
-     THEN nach unten
-  FI;
-  IF virtueller cursor = anzahl
-    THEN reellen cursor setzen
-  FI
-END PROC ankreuzen weiter;
-PROC auskreuzen weiter:
-  INT VAR position :: nr (virtueller cursor);
-  IF position = 0
-    THEN out (piep);
-         LEAVE auskreuzen weiter
-  FI;
-  rausschmeissen;
-
-  IF virtueller cursor < anzahl
-     THEN nach unten
-     ELSE loesche marke
-  FI;
-  bild aktualisieren;
-  reellen cursor setzen.
-  rausschmeissen:
-    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
-                       subtext (registrierkette, 4 * position + 1).
-END PROC auskreuzen weiter;
-PROC auskreuzen:
-  INT VAR position :: nr (virtueller cursor);
-  IF position = 0
-    THEN out (piep);
-         LEAVE auskreuzen
-  FI;
-  rausschmeissen;
-  loesche marke;
-
-  bild aktualisieren;
-  reellen cursor setzen.
-  rausschmeissen:
-    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
-                       subtext (registrierkette, 4 * position + 1).
-END PROC auskreuzen;
-PROC bild aktualisieren:
-  INT VAR ob, un, i, zaehler :: -1;
-  ob := virtueller cursor - reeller cursor + 1;
-  un := min (ob + max eintraege - 1, anzahl);
-  FOR i FROM ob UPTO un REP
-  zaehler INCR 1;
-  cursor (x + 1, erste auswahlzeile + zaehler);
-  out (marke (i,FALSE)) PER
-
-END PROC bild aktualisieren;
-PROC nach oben:
-  IF noch nicht oben       (*virtuell*)
-     THEN gehe nach oben
-     ELSE out (piep)
-  FI.
-  noch nicht oben:
-    virtueller cursor > 1.
-  gehe nach oben:
-    IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.
-  scroll down:
-    virtueller cursor DECR 1;
-    baue bildschirm auf (virtueller cursor);
-    reellen cursor setzen.
-  cursor up:
-    loesche marke;
-    virtueller cursor DECR 1;
-    reeller cursor DECR 1;
-    reellen cursor setzen
-
-END PROC nach oben;
-PROC nach unten:
-  IF noch nicht unten      (*virtuell*)
-     THEN gehe nach unten
-     ELSE out (piep)
-  FI.
-  noch nicht unten:
-    virtueller cursor < anzahl.
-  gehe nach unten:
-    IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.
-  scroll up:
-    virtueller cursor INCR 1;
-    baue bildschirm auf (virtueller cursor - (max eintraege - 1));
-    reellen cursor setzen.
-  cursor down:
-    loesche marke;
-    virtueller cursor INCR 1;
-    reeller cursor INCR 1;
-
-    reellen cursor setzen
-END PROC nach unten;
-PROC loesche marke:
-  out (marke (virtueller cursor, FALSE))
-END PROC loesche marke;
-PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
-  cursor (x, y + ysize - 3);
-  out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);
-  change footnote (x, y, xsize, ysize, text)
-END PROC footnote;
-PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
-  cursor (x, y + ysize - 2);
-  out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht)
-
-END PROC change footnote;
-PROC gib hinweis aus (TEXT CONST t1, t2):
-  cursor (x, y + 1); out (senkrecht);
-                     out (center (xsize - 2, invers (t1)));
-                     out (senkrecht);
-  cursor (x, y + 2); out (senkrecht);
-                     out ("", xsize - 2);
-                     out (senkrecht);
-  cursor (x, y + 3); out (senkrecht);
-                     out (center (xsize - 2, t2));
-                     out (senkrecht)
-END PROC gib hinweis aus;
-PROC gib erklaerungszeile aus (BOOL CONST mehrere):
-
-  cursor (x, y + 4); out (senkrecht);
-                     out ((xsize - 2) * gleich);
-                     out (senkrecht);
-  cursor (x, y + 5); out (senkrecht);
-                     IF mehrere
-                        THEN out (erklaerungszeile mehrere)
-                        ELSE out (erklaerungszeile eine)
-                     FI;
-                     out (senkrecht).
-  erklaerungszeile mehrere:
-    invers (text 1 + (rest1 * blank)).
-  erklaerungszeile eine:
-    invers (text 2 + (rest2 * blank)).
-
-  text1:
-    hinweis [22].
-  text2:
-    hinweis [23].
-  rest1:                                  (***************************)
-    xsize - length (text1) - 5.           (* durch 'invers' wird ein *)
-                                          (* Blank angehängt und zu- *)
-  rest2:                                  (* sätzlich noch durch     *)
-    xsize - length (text2) - 5.           (* 'relativcenter' - außer-*)
-END PROC gib erklaerungszeile aus;        (* dem nimmt die Markierung*)
-                                          (* selbst eine Position ein*)
-
-                                          (***************************)
-THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):
-  THESAURUS VAR tt :: empty thesaurus;
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-    TEXT VAR eintrag :: name (t,i);
-    IF eintrag enthaelt infix
-       THEN insert (tt, eintrag)
-    FI
-  PER;
-  tt.
-  eintrag enthaelt infix:
-    pos (eintrag, infix) <> 0
-END PROC infix namen;
-THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):
-
-  THESAURUS VAR tt :: empty thesaurus;
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-    TEXT VAR eintrag :: name (t,i);
-    IF eintrag enthaelt infix
-       THEN insert (tt, eintrag)
-    FI
-  PER;
-  tt.
-  eintrag enthaelt infix:
-    type (old (eintrag)) = dateityp.
-END PROC infix namen;
-THESAURUS PROC  infix namen (THESAURUS CONST t,
-                             TEXT CONST infix 1, INT CONST dateityp):
-  THESAURUS VAR tt :: empty thesaurus;
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-
-    TEXT VAR eintrag :: name (t,i);
-    IF eintrag enthaelt infix
-       THEN insert (tt, eintrag)
-    FI
-  PER;
-  tt.
-  eintrag enthaelt infix:
-   (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).
-END PROC infix namen;
-THESAURUS PROC  infix namen (THESAURUS CONST t,
-                             TEXT CONST infix 1, infix 2):
-  THESAURUS VAR tt :: empty thesaurus;
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-    TEXT VAR eintrag :: name (t,i);
-    IF eintrag enthaelt infix
-
-       THEN insert (tt, eintrag)
-    FI
-  PER;
-  tt.
-  eintrag enthaelt infix:
-   (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0)
-END PROC infix namen;
-THESAURUS PROC infix namen (TEXT CONST infix):
-  infix namen (ALL myself, infix)
-END PROC infix namen;
-THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):
-  infix namen (ALL myself, infix 1, infix 2)
-END PROC infix namen;
-THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):
-  THESAURUS VAR t :: empty thesaurus;
-
-  INT VAR zaehler;
-  FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP
-    IF name (thesaurus, zaehler) <> ""
-       AND pos (name (thesaurus, zaehler), praefix) = 1
-       THEN insert (t, subtext (name (thesaurus, zaehler),
-                                  length (praefix) + 1))
-    FI;
-  PER;
-  t
-END PROC ohne praefix;
-BOOL PROC not empty (THESAURUS CONST t):
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-    IF name (t, i) <> ""
-       THEN LEAVE not empty WITH TRUE
-
-    FI
-  PER;
-  FALSE
-END PROC not empty;
-PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):
-  IF   unzulaessige cursorwerte
-       THEN errorstop (fehlermeldung [1])
-  ELIF fenster ist zu klein
-       THEN errorstop (fehlermeldung [2])
-  FI.
-  unzulaessige cursorwerte:
-    (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1
-    COR xsize > 79 COR ysize > 24.
-  fenster ist zu klein:
-   (xsize) < 56 COR (ysize) < 15
-   COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).
-
-END PROC untersuche bildschirmmasszahlen;
-TEXT PROC ggf gekuerzter text (TEXT CONST text):
-   IF length (text) > (xsize - 5)
-      THEN subtext (text, 1, xsize - 7) + ".."
-      ELSE text
-   FI
-END PROC ggf gekuerzter text;
-THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,
-                     THESAURUS CONST t,
-                     TEXT CONST t1, t2):
-  TEXT VAR text 1, text 2;
-  x := spa;
-  y := zei;
-  xsize := breite;
-  ysize := hoehe;
-  text 1 := ggf gekuerzter text (t1);
-
-  text 2 := ggf gekuerzter text (t2);
-  untersuche bildschirmmasszahlen (text 1, text 2);
-  auswahl (t, TRUE, text 1, text 2)
-END PROC some;
-THESAURUS PROC some (INT CONST spa, zei,
-                     THESAURUS CONST t,
-                     TEXT CONST t1, t2):
-  some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)
-END PROC some;
-THESAURUS PROC some (THESAURUS CONST t,
-                     TEXT CONST t1, t2):
-  some (1, 1, 79, 24, t, t1, t2)
-END PROC some;
-TEXT PROC one (INT CONST spa, zei, breite, hoehe,
-
-               THESAURUS CONST t,
-               TEXT CONST t1, t2):
-  TEXT VAR text 1, text 2;
-  x := spa;
-  y := zei;
-  xsize := breite;
-  ysize := hoehe;
-  text 1 := ggf gekuerzter text (t1);
-  text 2 := ggf gekuerzter text (t2);
-  untersuche bildschirmmasszahlen (text 1, text 2);
-  name (auswahl (t, FALSE, text 1, text 2), 1)
-END PROC one;
-TEXT PROC one (INT CONST spa, zei,
-               THESAURUS CONST t,
-               TEXT CONST t1, t2):
-  one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)
-
-END PROC one;
-TEXT PROC one  (THESAURUS CONST t, TEXT CONST t1, t2):
-  one (1, 1, 79, 24, t, t1, t2)
-END PROC one;
-END PACKET ls dialog 2;
-
-
diff --git a/dialog/ls-DIALOG 3 b/dialog/ls-DIALOG 3
deleted file mode 100644
index 2460820..0000000
--- a/dialog/ls-DIALOG 3
+++ /dev/null
@@ -1,416 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 3                     ** 
-          **                                                     ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls dialog 3  DEFINES
-       WINDOW, :=, window,
-       show, page, erase,
-       line, remaining lines,
-       cursor, get cursor,
-       out frame, out menuframe,
-       out, put, putline, editget,
-       get, getline, yes, no,
-       edit, center, stop,
-       area, areax, areay,
-       areaxsize, areaysize:
-LET piep          =      ""7"",
-    cr            =     ""13"";
-LET janeinkette   =   "jJyYnN",
-    blank         =        " ",
-    niltext       =         "";
-TYPE WINDOW = STRUCT (AREA fenster,
-
-                      INT cspalte, czeile, belegbare zeilen,
-                      BOOL fensterende erreicht);
-ROW 3 TEXT CONST aussage :: ROW 3 TEXT : (
-  " 'Window' ungültig!",
-  " (j/n) ?",
-  " Zum Weitermachen bitte irgendeine Taste tippen!"
-  );
-TEXT VAR number word, exit char;
-OP := (WINDOW VAR links, WINDOW CONST rechts):
-  CONCR (links) := CONCR (rechts)
-END OP :=;
-WINDOW PROC window (INT CONST x, y, xsize, ysize):
-  WINDOW VAR w;
-  fill (w.fenster, x, y, xsize, ysize);
-  IF fenster ungueltig (w)
-
-     THEN errorstop (aussage [1])
-  FI;
-  initialize (w);
-  w
-END PROC window;
-PROC initialize (WINDOW VAR w):
-  w.czeile               := 1;
-  w.cspalte              := 1;
-  w.fensterende erreicht := FALSE;
-  w.belegbare zeilen     := areaysize (w.fenster)
-END PROC initialize;
-BOOL PROC fenster ungueltig (WINDOW CONST w):
-  IF     areax     (w.fenster) <  1  COR areax     (w.fenster) > 79
-     COR areay     (w.fenster) <  1  COR areay     (w.fenster) > 24
-     COR areaxsize (w.fenster) <  6  COR areaysize (w.fenster) <  3
-
-     COR areax (w.fenster) + areaxsize (w.fenster) > 80
-     COR areay (w.fenster) + areaysize (w.fenster) > 25
-     THEN TRUE
-     ELSE FALSE
-  FI.
-END PROC fenster ungueltig;
-PROC show (WINDOW VAR w):
-  zeige rahmen;
-  fenster putzen.
-  zeige rahmen:
-    out frame (w.fenster).
-  fenster putzen:
-    page (w).
-END PROC show;
-PROC page (WINDOW VAR w):
-  initialize (w);
-  page (w, FALSE)
-END PROC page;
-PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):
-  IF areax     (w) = 1  AND areay     (w) =  1 AND
-
-     areaxsize (w) = 79 AND areaysize (w) = 24
-     THEN page;
-     ELSE loesche bereich
-  FI.
-  loesche bereich:
-    IF mit rahmen
-       THEN page (areax     (w) - 1, areay     (w) - 1,
-                  areaxsize (w) + 2, areaysize (w) + 2)
-       ELSE page (area (w))
-    FI
-END PROC page;
-PROC erase (WINDOW VAR w):
-  page (w, TRUE)
-END PROC erase;
-PROC line (WINDOW VAR w):
-  w.cspalte := 1;
-  IF w.czeile < w.belegbare zeilen
-     THEN w.czeile INCR 1;
-     ELSE w.czeile  :=  1;
-
-          w.fensterende erreicht := TRUE
-  FI;
-  cursor (w, w.cspalte, w.czeile)
-END PROC line;
-PROC line (WINDOW VAR w, INT CONST anzahl):
-  INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER
-END PROC line;
-INT PROC remaining lines (WINDOW CONST w):
-  INT VAR spalte, zeile;
-  get cursor (w, spalte, zeile);
-  IF spalte = 0 OR zeile = 0
-     THEN 0
-     ELSE w.belegbare zeilen - w.czeile
-  FI
-END PROC remaining lines;
-PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):
-  IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w)
-
-     THEN page (w);
-     ELSE w.cspalte := spalte; w.czeile  := zeile;
-  FI;
-  cursor (w.fenster, w.cspalte, w.czeile)
-END PROC cursor;
-PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):
-  IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster))
-                          OR
-     (w.czeile  < 1) OR (w.czeile  > areaysize (w.fenster))
-     THEN spalte := 0;         zeile := 0
-     ELSE spalte := w.cspalte; zeile := w.czeile
-  FI
-END PROC get cursor;
-PROC out (WINDOW VAR w, TEXT CONST text):
-
-  INT VAR restlaenge;
-  IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster))
-                           AND
-     (w.czeile  >= 1) AND (w.czeile  <= w.belegbare zeilen)
-     THEN putze ggf fenster;
-          cursor (w.fenster, w.cspalte, w.czeile);
-          outtext (text, 1, textende);
-          setze fenstercursor neu;
-          setze ausgabe ggf in naechster zeile fort
-  FI.
-  putze ggf fenster:
-    IF w.fensterende erreicht
-       THEN page (w);
-            w.fensterende erreicht := FALSE
-
-    FI.
-  textende:
-    restlaenge := areaxsize (w.fenster) - w.cspalte + 1;
-    min (length (text), restlaenge).
-  setze fenstercursor neu:
-    IF length (text) >= restlaenge
-       THEN w.cspalte  := 1;
-            w.czeile INCR 1;
-            schlage ggf neue seite auf
-       ELSE w.cspalte INCR length (text)
-    FI.
-  schlage ggf neue seite auf:
-    IF w.czeile > w.belegbare zeilen
-       THEN page (w);
-            w.czeile := 1
-    FI.
-  setze ausgabe ggf in naechster zeile fort:
-
-    IF length (text) > restlaenge
-       THEN out (w, subtext (text, restlaenge + 1))
-    FI.
-END PROC out;
-PROC out frame (WINDOW VAR w):
-  out frame (area (w))
-END PROC out frame;
-PROC out menuframe (WINDOW VAR w):
-  out menu frame (area (w))
-END PROC out menuframe;
-PROC put (WINDOW VAR w, TEXT CONST word):
-  out (w, word); out (w, blank)
-END PROC put;
-PROC put (WINDOW VAR w, INT CONST number):
-  put (w, text (number))
-END PROC put;
-PROC put (WINDOW VAR w, REAL VAR number):
-  put (w, text (number))
-
-END PROC put;
-PROC putline (WINDOW VAR w, TEXT CONST textline):
-  out (w, textline); line (w)
-END PROC putline;
-PROC editget (WINDOW VAR w, TEXT VAR ausgabe,
-              INT CONST max laenge, scroll,
-              TEXT CONST sep, res, TEXT VAR exit char):
-  INT VAR spalte, zeile;
-  ggf zur naechsten zeile;
-  get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);
-  editget (ausgabe, max laenge, min (scroll, restlaenge),
-           sep, res, exitchar);
-  get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).
-
-  ggf zur naechsten zeile:
-    IF restlaenge < 5 THEN line (w) FI.
-  restlaenge:
-    areaxsize (w.fenster) - w.cspalte - 1.
-END PROC editget;
-PROC editget (WINDOW VAR w, TEXT VAR ausgabe):
-   TEXT VAR dummy;
-   editget (w, ausgabe, 79, 79, "", "", dummy)
-END PROC editget;
-PROC get (WINDOW VAR w, TEXT VAR word):
-  INT VAR spa, zei;
-  ggf zur naechsten zeile;
-  get cursor (spa, zei); cursor on; cursor (spa, zei);
-  REP
-    word := "";
-    editget (word, maxtextlength, restlaenge, " ", "", exit char);
-
-    out (w, subtext (word, 1, restlaenge));
-    IF compress (word) <> ""
-       THEN echoe exit char (w)
-    FI
-  UNTIL word <> niltext AND word <> blank PER;
-  get cursor (spa, zei); cursor off; cursor (spa, zei);
-  delete leading blanks.
-  ggf zur naechsten zeile:
-    IF restlaenge < 5 THEN line (w) FI.
-  restlaenge:
-    areaxsize (w.fenster) - w.cspalte - 1.
-  delete leading blanks:
-    WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.
-END PROC get;
-PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):
-
-  INT VAR spa, zei;
-  ggf zur naechsten zeile;
-  get cursor (spa, zei); cursor on; cursor (spa, zei);
-  REP
-    word := "";
-    editget (word, maxtextlength, restlaenge, separator, "", exit char);
-    out (w, subtext (word, 1, restlaenge));
-    echoe exit char (w);
-  UNTIL word <> niltext AND word <> blank PER;
-  get cursor (spa, zei); cursor off; cursor (spa, zei).
-  ggf zur naechsten zeile:
-    IF restlaenge < 5 THEN line (w) FI.
-  restlaenge:
-    areaxsize (w.fenster) - w.cspalte - 1.
-
-END PROC get;
-PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):
-  INT VAR spa, zei;
-  ggf zur naechsten zeile;
-  get cursor (spa, zei); cursor on; cursor (spa, zei);
-  REP
-    word := "";
-    editget (word, maxtextlength, laenge, "", "", exit char);
-    out (w, subtext (word, 1, laenge));
-    echoe exit char (w)
-  UNTIL word <> niltext AND word <> blank PER;
-  get cursor (spa, zei); cursor off; cursor (spa, zei).
-  ggf zur naechsten zeile:
-    IF restlaenge < 5 THEN line (w) FI.
-
-  restlaenge:
-    areaxsize (w.fenster) - w.cspalte - 1.
-  laenge:
-    min (length, restlaenge).
-END PROC get;
-PROC get (WINDOW VAR w, INT VAR number):
-  get (w, number word);
-  number := int (number word)
-END PROC get;
-PROC get (WINDOW VAR w, REAL VAR number):
-  get  (w, number word);
-  number := real (number word)
-END PROC get;
-PROC getline (WINDOW VAR w, TEXT VAR textline):
-  INT VAR spa, zei;
-  ggf zur naechsten zeile;
-  get cursor (spa, zei); cursor on; cursor (spa, zei);
-  REP
-
-    textline := "";
-    editget (textline, maxtextlength, restlaenge, "", "", exit char);
-    out (w, subtext (word, 1, restlaenge));
-    echoe exit char (w);
-  UNTIL textline <> niltext AND textline <> blank PER;
-  get cursor (spa, zei); cursor off; cursor (spa, zei).
-  ggf zur naechsten zeile:
-    IF restlaenge < 5 THEN line (w) FI.
-  restlaenge:
-    areaxsize (w.fenster) - w.cspalte - 1.
-END PROC getline;
-PROC echoe exit char (WINDOW VAR fenster):
-  IF exit char = cr
-     THEN line (fenster)
-
-     ELSE out (fenster, exit char)
-  FI
-END PROC echoe exit char;
-TEXT PROC center (WINDOW CONST w, TEXT CONST text):
-  IF length (text) >= areaxsize (w.fenster)
-     THEN subtext (text, 1, areaxsize (w.fenster))
-     ELSE center  (areaxsize (w.fenster), text)
-  FI
-END PROC center;
-BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):
-  TEXT VAR   zeichen, interne frage :: frage;
-  interne frage CAT aussage [2];
-  wechsel ggf auf neue seite;
-  out (w, interne frage);
-  hole eingabezeichen;
-
-  werte zeichen aus.
-  wechsel ggf auf neue seite:
-    IF remaining lines (w) < 1
-       THEN page (w)
-    FI.
-  hole eingabezeichen:
-    cursor on; clear buffer;
-    REP
-      inchar (zeichen);
-      piepse ggf
-    UNTIL pos (janeinkette, zeichen) > 0 PER;
-    out (w, blank + zeichen);
-    cursor off; line (w).
-  piepse ggf:
-    IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.
-  werte zeichen aus:
-    IF pos (janeinkette, zeichen) < 5
-       THEN TRUE
-       ELSE FALSE
-    FI.
-
-END PROC yes;
-PROC edit (WINDOW VAR w, FILE VAR f):
-  out frame (w.fenster);
-  loesche rechte spalten (w);
-  cursor on;
-  edit (f, areax     (w.fenster),     areay     (w.fenster),
-           areaxsize (w.fenster) - 1, areaysize (w.fenster));
-  cursor off
-END PROC edit;
-PROC edit (WINDOW VAR w, TEXT CONST dateiname):
-  FILE VAR f :: sequential file (modify, dateiname);
-  to line (f, 1);
-  edit (w, f)
-END PROC edit;
-PROC show (WINDOW VAR w, FILE VAR f):
-  out frame (w.fenster);
-  loesche rechte spalten (w);
-
-  open editor (groesster editor + 1, f, FALSE,
-               areax     (w.fenster),     areay     (w.fenster),
-               areaxsize (w.fenster) - 1, areaysize (w.fenster));
-  cursor on;
-  edit (groesster editor, "eqvw19dpgn"9"",
-                          PROC (TEXT CONST) std kommando interpreter);
-  cursor off
-END PROC show;
-PROC show (WINDOW VAR w, TEXT CONST dateiname):
-  FILE VAR f :: sequential file (modify, dateiname);
-  to line (f, 1);
-  show (w, f)
-END PROC show;
-PROC loesche rechte spalten (WINDOW VAR w):
-
-  INT VAR i;
-  FOR i FROM 1 UPTO areaysize (w.fenster) REP
-    cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank)
-  PER
-END PROC loesche rechte spalten;
-BOOL PROC no (WINDOW VAR w, TEXT CONST frage):
-  NOT yes (w, frage)
-END PROC no;
-PROC stop (WINDOW VAR w):
-  stop (w, 2)
-END PROC stop;
-PROC stop (WINDOW VAR w, INT CONST zeilenzahl):
-  INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;
-  out (w, aussage [3]);
-  pause
-END PROC stop;
-AREA PROC area (WINDOW CONST w):
-
-  w.fenster
-END PROC area;
-INT PROC areax (WINDOW CONST w):
-  areax (w.fenster)
-END PROC areax;
-INT PROC areay (WINDOW CONST w):
-  areay (w.fenster)
-END PROC areay;
-INT PROC areaxsize (WINDOW CONST w):
-  areaxsize (w.fenster)
-END PROC areaxsize;
-INT PROC areaysize (WINDOW CONST w):
-  areaysize (w.fenster)
-END PROC areaysize;
-END PACKET ls dialog 3;
-
-
diff --git a/dialog/ls-DIALOG 4 b/dialog/ls-DIALOG 4
deleted file mode 100644
index e1d38c4..0000000
--- a/dialog/ls-DIALOG 4
+++ /dev/null
@@ -1,741 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 4                     ** 
-          **                                                     ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET  ls dialog 4  DEFINES
-       boxinfo,
-       boxnotice,
-       boxalternative,
-       boxyes,
-       boxno,
-       boxanswer,
-       boxone,
-       boxanswerone,
-       boxsome,
-       boxanswersome,
-       out footnote,
-       erase footnote:
-LET mark ein                 =           ""15"",
-    mark aus                 =           ""14"",
-    delimiter                =           ""13"",
-    piep                     =            ""7"",
-    rechts links esc  return = ""2""8""27""13"",
-
-    rechts links null return = ""2""8""0""13"" ,
-    blank                    =              " ",
-    niltext                  =               "",
-    janeintasten             =         "jJyYnN";
-ROW 8 TEXT CONST aussage :: ROW 8 TEXT : (
-" Zum Weitermachen bitte irgendeine Taste tippen!",
-" Ändern: <Pfeile>  Bestätigen: <RETURN>  Abbruch: <ESC> <h>",
-" Ändern: <Pfeile>  Bestätigen: <RETURN>  Ja: <j>  Nein: <n>",
-" Ändern: <Pfeile>  Bestätigen: <RETURN>",
-" Fertig: <RETURN>  Zeigen: <ESC><z>  Abbruch: <ESC><h>",
-
-" Fertig: <RETURN>  Abbruch: <ESC><h>",
-"Ja"13"Nein",
-" Eingabe: "
-);
-PROC boxinfo (WINDOW VAR w, TEXT CONST t,
-              INT CONST position, timelimit,
-              INT VAR x, y, xsize, ysize):
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  schreibe box (w, t, position, timelimit, x, y, xsize, ysize);
-  cursor (w, spa, zei);
-END PROC boxinfo;
-PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,
-                            timelimit, BOOL CONST trennlinie weg):
-  INT VAR x, y, xsize, ysize, spa, zei;
-
-  get cursor (w, spa, zei);
-  schreibe box (w, t, position, timelimit, x, y, xsize, ysize);
-  page up (x, y, xsize, ysize);
-  IF trennlinie weg
-     THEN erase footnote (w, TRUE)
-     ELSE erase footnote (w, FALSE)
-  FI;
-  cursor (w, spa, zei)
-END PROC boxinfo;
-PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):
-  boxinfo (w, t, position, timelimit, TRUE)
-END PROC boxinfo;
-PROC boxinfo (WINDOW VAR w, TEXT CONST t):
-  boxinfo (w, t, 5, maxint, TRUE)
-END PROC boxinfo;
-
-PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,
-                              INT VAR x, y, xsize, ysize):
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  schreibe notiz (w, t, position, x, y, xsize, ysize);
-  cursor (w, spa, zei)
-END PROC boxnotice;
-INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,
-                         auswahlliste, zusatztasten,
-                         INT CONST position, BOOL CONST mit abbruch,
-                         INT VAR x, y, xsize, ysize):
-
-  INT VAR ergebnis, spa, zei;
-  get cursor (w, spa, zei);
-  schreibe alternativen (w, t, auswahlliste, zusatztasten, position,
-                         mit abbruch, x, y, xsize, ysize, ergebnis);
-  cursor (w, spa, zei);
-  ergebnis
-END PROC boxalternative;
-INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,
-                         zusatztasten, INT CONST position,
-                         BOOL CONST mit abbruch, trennlinie weg):
-  INT VAR x, y, xsize, ysize, ergebnis, spa, zei;
-
-  get cursor (w, spa, zei);
-  ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,
-                                 mit abbruch, x, y, xsize, ysize);
-  page up (x, y, xsize, ysize);
-  IF trennlinie weg
-     THEN erase footnote (w, TRUE)
-     ELSE erase footnote (w, FALSE)
-  FI;
-  cursor (w, spa, zei);
-  ergebnis
-END PROC boxalternative;
-INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,
-                         auswahlliste, zusatztasten,
-                         INT CONST position, BOOL CONST mit abbruch):
-
-  boxalternative (w, t, auswahlliste, zusatztasten,
-                        position, mit abbruch, TRUE)
-END PROC boxalternative;
-BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,
-                                INT VAR x, y, xsize, ysize):
-   INT VAR spa, zei;
-   get cursor (w, spa, zei);
-   BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);
-   cursor (w, spa, zei);
-   wert
-END PROC boxyes;
-BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,
-                  INT CONST position, BOOL CONST trennlinie weg):
-
-  INT VAR x, y, xsize, ysize, spa, zei;
-  get cursor (w, spa, zei);
-  BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);
-  page up (x, y, xsize, ysize);
-  IF trennlinie weg
-     THEN erase footnote (w, TRUE)
-     ELSE erase footnote (w, FALSE);
-  FI;
-  cursor (w, spa, zei);
-  wert
-END PROC boxyes;
-BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):
-  boxyes (w, t, position, TRUE)
-END PROC boxyes;
-BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,
-
-                               INT VAR x, y, xsize, ysize):
-   NOT boxyes (w, t, position, x, y, xsize, ysize)
-END PROC boxno;
-BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,
-                 INT CONST position, BOOL CONST trennlinie weg):
-  NOT boxyes (w, t, position, trennlinie weg)
-END PROC boxno;
-BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):
-  boxno (w, t, position)
-END PROC boxno;
-TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
-                     INT CONST position, INT VAR x, y, xsize, ysize):
-
-  INT VAR spa, zei;
-  TEXT VAR wert;
-  get cursor (w, spa, zei);
-  wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);
-  cursor (spa, zei);
-  wert
-END PROC boxanswer;
-TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
-                     INT CONST position, BOOL CONST trennlinie weg):
-  INT VAR x, y, xsize, ysize, spa, zei;
-  get cursor (w, spa, zei);
-  TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,
-                                 x, y, xsize, ysize);
-
-  page up (x, y, xsize, ysize);
-  IF trennlinie weg
-     THEN erase footnote (w, TRUE)
-     ELSE erase footnote (w, FALSE)
-  FI;
-  cursor (w, spa, zei);
-  wert
-END PROC boxanswer;
-TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,
-                                   INT CONST position):
-  boxanswer (w, t, vorgabe, position, TRUE)
-END PROC boxanswer;
-TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,
-                  TEXT CONST text1, text2, BOOL CONST mit reinigung):
-
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  TEXT VAR wert :: one (areax     (w) + 2, areay     (w) + 2,
-                        areaxsize (w) - 4, areaysize (w) - 2,
-                        thesaurus, text1, text2);
-  IF mit reinigung
-     THEN page up (areax     (w) + 2, areay     (w) + 2,
-                   areaxsize (w) - 4, areaysize (w) - 2);
-          erase footnote (w)
-  FI;
-  cursor (w, spa, zei);
-  wert
-END PROC boxone;
-TEXT PROC boxanswerone  (WINDOW VAR w, TEXT CONST text, vorgabe,
-
-                         THESAURUS CONST thesaurus, TEXT CONST t1, t2,
-                         BOOL CONST mit reinigung, trennlinie weg):
-  INT VAR x,y, xsize, ysize, spa, zei;
-  get cursor (w, spa, zei);
-  TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,
-                                 x, y, xsize, ysize);
-  IF wert = ""27"z"
-     THEN lasse auswaehlen
-     ELSE uebernimm den wert
-  FI;
-  cursor (w, spa, zei);
-  wert.
-  lasse auswaehlen:
-    IF mit reinigung
-       THEN wert := boxone (w, thesaurus, t1, t2, TRUE )
-
-       ELSE wert := boxone (w, thesaurus, t1, t2, FALSE)
-    FI.
-  uebernimm den wert:
-    IF mit reinigung
-       THEN page up (x, y, xsize, ysize);
-            entferne ggf die trennlinie
-    FI.
-  entferne ggf die trennlinie:
-    IF trennlinie weg
-       THEN erase footnote (w, TRUE)
-       ELSE erase footnote (w, FALSE)
-    FI.
-END PROC boxanswer one;
-TEXT PROC boxanswerone  (WINDOW VAR w, TEXT CONST text, vorgabe,
-                         THESAURUS CONST thesaurus, TEXT CONST t1, t2,
-
-                         BOOL CONST mit reinigung):
-  boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE)
-END PROC boxanswer one;
-THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,
-                        TEXT CONST text1, text2,
-                        BOOL CONST mit reinigung):
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  THESAURUS VAR wert :: some (areax     (w) + 2, areay     (w) + 2,
-                              areaxsize (w) - 4, areaysize (w) - 2,
-
-                              thesaurus, text1, text2);
-  IF mit reinigung
-     THEN page up (areax     (w) + 2, areay     (w) + 2,
-                   areaxsize (w) - 4, areaysize (w) - 2);
-          erase footnote (w)
-  FI;
-  cursor (w, spa, zei);
-  wert
-END PROC boxsome;
-THESAURUS PROC boxanswersome  (WINDOW VAR w, TEXT CONST text, vorgabe,
-                               THESAURUS CONST thesaurus,
-                               TEXT CONST t1, t2,
-                               BOOL CONST mit reinigung, trennlinie weg):
-
-  THESAURUS VAR ergebnis :: empty thesaurus;
-  INT VAR x, y, xsize, ysize, spa, zei;
-  get cursor (w, spa, zei);
-  TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,
-                                 x, y, xsize, ysize);
-  IF wert = ""27"z"
-     THEN lasse auswaehlen
-     ELSE uebernimm den wert
-  FI;
-  cursor (w, spa, zei);
-  ergebnis.
-  lasse auswaehlen:
-    IF mit reinigung
-       THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE )
-       ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE)
-
-    FI.
-  uebernimm den wert:
-    IF wert <> niltext
-       THEN insert (ergebnis, wert)
-    FI;
-    IF mit reinigung
-       THEN page up (x, y, xsize, ysize);
-            entferne ggf die trennlinie
-    FI.
-  entferne ggf die trennlinie:
-    IF trennlinie weg
-       THEN erase footnote (w, TRUE)
-       ELSE erase footnote (w, FALSE)
-    FI.
-END PROC boxanswer some;
-THESAURUS PROC boxanswersome  (WINDOW VAR w, TEXT CONST text, vorgabe,
-                               THESAURUS CONST thesaurus,
-
-                               TEXT CONST t1, t2,
-                               BOOL CONST mit reinigung):
-  boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE)
-END PROC boxanswersome;
-PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  IF mit trennlinie
-     THEN cursor (w, 1,  areaysize (w) - 1);
-          areaxsize (w) TIMESOUT waagerecht
-  FI;
-  cursor (w, 1,  areaysize (w));
-  outtext (text, 1, areaxsize (w));
-
-  cursor (w, spa, zei)
-END PROC out footnote;
-PROC out footnote (WINDOW VAR w, TEXT CONST t):
-  out footnote (w, TRUE, t)
-END PROC out footnote;
-PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):
-  INT VAR spa, zei;
-  get cursor (w, spa, zei);
-  IF auch trennlinie
-     THEN cursor (w, 1, areaysize (w) - 1);
-          outtext ("", 1, areaxsize (w))
-  FI;
-  cursor (w, 1, areaysize (w));
-  outtext ("", 1, areaxsize (w));
-  cursor (w, spa, zei)
-END PROC erase footnote;
-PROC erase footnote (WINDOW VAR w):
-
-  erase footnote (w, TRUE)
-END PROC erase footnote;
-PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,
-                       INT CONST position, zusatzlaenge,
-                                 mindestbreite, mindesthoehe,
-                       INT VAR x, y, xsize, ysize):
-  ermittle boxbreite und boxhoehe;
-  ermittle rahmenwerte;
-  schreibe boxkopf;
-  schreibe boxrumpf.
-  ermittle boxbreite und boxhoehe:
-    TEXT VAR intern :: t + delimiter;
-    entferne fuehrende delimiter;
-    INT VAR  anfang :: 1,
-
-             ende   :: pos (intern, delimiter, anfang) - 1;
-    xsize := 0;
-    ysize := 0;
-    WHILE ende > 0 REP
-      ysize INCR 1;
-      lege ggf boxbreite fest;
-      bestimme neue positionen
-    PER.
-  entferne fuehrende delimiter:
-    WHILE (intern SUB 1) = delimiter REP
-      intern := subtext (intern, 2)
-    PER.
-  lege ggf boxbreite fest:
-    IF length (subtext (intern, anfang, ende)) > xsize
-       THEN xsize := length (subtext (intern, anfang, ende))
-    FI.
-  bestimme neue positionen:
-
-    anfang := ende + 2;
-    ende   := pos (intern, delimiter, anfang) - 1.
-  ermittle rahmenwerte:
-    schlage notwendige groessen auf;
-    kill ueberlaengen;
-    lege bildschirmpositionen fest.
-  schlage notwendige groessen auf:
-    IF xsize < mindestbreite
-       THEN xsize := mindestbreite
-    FI;
-    IF ysize < mindesthoehe
-       THEN ysize := mindesthoehe
-    FI;
-    ysize INCR zusatzlaenge;
-    ysize INCR 2;  (* Für den Rahmen *)
-    xsize INCR 2.  (* Für den Rahmen *)
-  kill ueberlaengen:
-
-    IF ysize > (areaysize (w) - 4)
-       THEN ysize := areaysize (w) - 4
-    FI;
-    IF xsize > (areaxsize (w) - 4)
-       THEN xsize := areaxsize (w) - 4
-    FI.
-  lege bildschirmpositionen fest:
-    SELECT position OF
-      CASE 1: plazierung links  oben
-      CASE 2: plazierung rechts oben
-      CASE 3: plazierung links  unten
-      CASE 4: plazierung rechts unten
-      OTHERWISE plazierung im zentrum
-    END SELECT.
-  plazierung links oben:
-    x := areax (w) + 2;
-    y := areay (w) + 2.
-
-  plazierung rechts oben:
-    x := areax (w) + areaxsize (w) - xsize - 2;
-    y := areay (w) + 2.
-  plazierung links unten:
-    x := areax (w) + 2;
-    y := areay (w) + areaysize (w) - ysize - 2.
-  plazierung rechts unten:
-    x := areax (w) + areaxsize (w) - xsize - 2;
-    y := areay (w) + areaysize (w) - ysize - 2.
-  plazierung im zentrum:
-    x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;
-    y := areay (w) + ((areaysize (w) - ysize)       DIV 2).
-  schreibe boxkopf:
-
-    cursor (x, y);
-    out (ecke oben links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke oben rechts).
-  schreibe boxrumpf:
-    INT VAR i;
-    intern := t + delimiter;
-    entferne fuehrende delimiter;
-    anfang := 1;
-    ende   := pos (intern, delimiter, anfang) - 1;
-    FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP
-      cursor (x, i);
-      out (senkrecht);
-      outtext (subtext (intern, anfang, ende), 1, xsize - 2);
-      out (senkrecht);
-      anfang := ende + 2;
-
-      ende   := pos (intern, delimiter, anfang) - 1
-    PER
-END PROC schreibe boxtext;
-PROC schreibe boxfuss (WINDOW VAR w,
-                       INT CONST x, y, xsize, ysize, limit):
-  schreibe abschlusszeile;
-  out footnote (w, aussage [1]);
-  cursor in position und warten.
-  schreibe abschlusszeile:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten  rechts).
-  cursor in position und warten:
-    cursor parken (w);
-
-    clear buffer;
-    pause (limit)
-END PROC schreibe boxfuss;
-PROC cursor parken (WINDOW VAR w):
-  cursor (w, 1, 2)
-END PROC cursor parken;
-PROC schreibe box (WINDOW VAR w, TEXT CONST t,
-                   INT CONST position, timelimit,
-                   INT VAR x, y, xsize, ysize):
-  schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);
-  schreibe boxfuss (w, x, y, xsize, ysize, timelimit)
-END PROC schreibe box;
-PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):
-
-  schreibe abschlusszeile;
-  cursor parken (w).
-  schreibe abschlusszeile:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten rechts).
-END PROC schreibe notizfuss;
-PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,
-                     INT VAR x, y, xsize, ysize):
-  schreibe boxtext   (w, t, position, 0, 0, 0, x, y, xsize, ysize);
-  schreibe notizfuss (w, x, y, xsize, ysize)
-END PROC schreibe notiz;
-PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,
-
-                            INT CONST position, BOOL CONST mit abbruch,
-                            INT VAR x, y, xsize, ysize, ergebnis):
-  ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;
-  normiere alternativen;
-  untersuche alternativen;
-  schreibe boxtext (w, textintern, position, 2, altbreite,
-                    0, x, y, xsize, ysize);
-  schreibe alternativenfuss;
-  lasse auswaehlen;
-  liefere ergebnis.
-  textintern:
-    IF sonst = janeintasten
-       THEN TEXT VAR zwischen;
-
-            zwischen := t;
-            kuerze um folgende blanks;
-            zwischen + "? "
-       ELSE t
-    FI.
-  kuerze um folgende blanks:
-    WHILE (zwischen SUB (length (zwischen))) = blank REP
-      zwischen := subtext (zwischen , 1, length (zwischen) - 1)
-    PER.
-  normiere alternativen:
-    TEXT VAR altintern :: altzeile;
-    altintern CAT delimiter.
-  untersuche alternativen:
-    INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,
-            ende :: pos (altintern, delimiter, anfang) - 1;
-
-    WHILE ende > 0 AND altanzahl <= 10 REP
-      trage alternative ein;
-      trage alternativenanfang ein;
-      trage alternativenlaenge ein;
-      setze neue positionen fest
-    PER;
-    ermittle gesamtalternativenbreite.
-  trage alternative ein:
-    altliste [altanzahl].alternat :=
-                               compress (subtext (altintern, anfang, ende)).
-  trage alternativenanfang ein:
-    first INCR 3;
-    altliste [altanzahl].anfang   := first.
-  trage alternativenlaenge ein:
-
-    altliste [altanzahl].laenge   := length (altliste [altanzahl].alternat);
-    first INCR altliste [altanzahl].laenge.
-  setze neue positionen fest:
-    anfang := ende + 2;
-    ende   := pos (altintern, delimiter, anfang) - 1;
-    altanzahl INCR 1.
-  ermittle gesamtalternativenbreite:
-    altanzahl DECR 1;
-    altbreite :=    altliste [altanzahl].anfang;
-    altbreite INCR (altliste [altanzahl].laenge + 3);
-    IF altbreite > areaxsize (w) - 6
-       THEN LEAVE schreibe alternativen
-
-    FI.
-  schreibe alternativenfuss:
-    schreibe leerzeile;
-    schreibe antwortmoeglichkeiten;
-    schreibe abschlusszeile;
-    IF mit abbruch
-       THEN out footnote (w, aussage [2])
-       ELSE beruecksichtige ja nein hinweis
-    FI.
-  schreibe leerzeile:
-    cursor (x, y + ysize - 3);
-    out (senkrecht);
-    (xsize - 2) TIMESOUT blank;
-    out (senkrecht).
-  schreibe antwortmoeglichkeiten:
-    cursor (x, y + ysize - 2);
-    out (senkrecht);
-    einrueckbreite TIMESOUT blank;
-
-    out (antwortleiste);
-    rest TIMESOUT blank;
-    out (senkrecht).
-  einrueckbreite:
-    (xsize - 2 - length (antwortleiste)) DIV 2.
-  antwortleiste:
-    INT VAR zeiger; TEXT VAR ausgabe :: "";
-    FOR zeiger FROM 1 UPTO altanzahl REP
-      ausgabe CAT altliste [zeiger].alternat;
-      ausgabe CAT "   "
-    PER;
-    compress (ausgabe).
-  rest:
-    xsize - 2 - einrueckbreite - length (antwortleiste).
-  schreibe abschlusszeile:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten rechts).
-  beruecksichtige ja nein hinweis:
-     IF sonst = janeintasten
-        THEN out footnote (w, aussage [3])
-        ELSE out footnote (w, aussage [4])
-     FI.
-  lasse auswaehlen:
-    INT VAR altzeiger :: 1;
-    stelle erste alternative invers dar;
-    REP
-      hole eingabe;
-      werte eingabe aus und reagiere
-    UNTIL alternative gefunden PER.
-  stelle erste alternative invers dar:
-    cursor (x + einrueckbreite, y + ysize - 2);
-
-    out (mark ein);
-    out (altliste [altzeiger].alternat); out (blank);
-    out (mark aus);
-    cursor (x + einrueckbreite, y + ysize - 2).
-  hole eingabe:
-    TEXT VAR moegliche, eingabe;
-    IF mit abbruch
-       THEN moegliche := rechts links esc  return + sonst
-       ELSE moegliche := rechts links null return + sonst
-    FI;
-    clear buffer;
-    REP
-      inchar (eingabe);
-      piepse bei unzulaessiger eingabe
-    UNTIL pos (moegliche, eingabe) > 0 PER.
-  piepse bei unzulaessiger eingabe:
-
-    IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.
-  werte eingabe aus und reagiere:
-    SELECT pos (moegliche, eingabe) OF
-      CASE 1: zur naechsten alternative
-      CASE 2: zur vorausgehenden alternative
-      CASE 3: esc kommando verarbeiten
-    END SELECT.
-  zur naechsten alternative:
-    loesche aktuelle alternative;
-    ermittle rechte alternative;
-    stelle neue alternative invers dar.
-  zur vorausgehenden alternative:
-    loesche aktuelle alternative;
-    ermittle linke alternative;
-
-    stelle neue alternative invers dar.
-  loesche aktuelle alternative:
-    cursor (alternativenanfang - 1, y + ysize - 2);
-    out (blank);
-    out (altliste [altzeiger].alternat);
-    out (2 * blank).
-  alternativenanfang:
-    x + einrueckbreite + altliste [altzeiger].anfang.
-  ermittle rechte alternative:
-    IF altzeiger = altanzahl
-       THEN altzeiger :=   1
-       ELSE altzeiger INCR 1
-    FI.
-  ermittle linke alternative:
-    IF altzeiger = 1
-       THEN altzeiger := altanzahl
-
-       ELSE altzeiger DECR 1
-    FI.
-  stelle neue alternative invers dar:
-    cursor (alternativenanfang - 1, y + ysize - 2);
-    out (mark ein);
-    out (altliste [altzeiger].alternat); out (blank);
-    out (mark aus);
-    cursor (alternativenanfang - 1, y + ysize - 2).
-  esc kommando verarbeiten:
-    inchar (eingabe);
-    IF eingabe = "h"
-       THEN ergebnis := 0;
-            LEAVE schreibe alternativen
-       ELSE out (piep); eingabe := ""
-    FI.
-  alternative gefunden:
-    pos (moegliche, eingabe) > 3.
-
-  liefere ergebnis:
-    IF pos (moegliche, eingabe) = 4
-       THEN ergebnis := altzeiger
-       ELSE ergebnis := 100 + pos (sonst, eingabe)
-    FI.
-END PROC schreibe alternativen;
-BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,
-               INT VAR x, y, xsize, ysize):
-  INT VAR ergebnis;
-  schreibe alternativen (w, t, aussage [7], janeintasten, position,
-                         FALSE, x, y, xsize, ysize, ergebnis);
-  SELECT ergebnis OF
-    CASE 2, 105, 106: FALSE
-    OTHERWISE TRUE
-
-  END SELECT.
-END PROC ja;
-TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,
-                        INT CONST position, BOOL CONST mit auswahl,
-                        INT VAR x, y, xsize, ysize):
-  TEXT VAR eingabe :: compress (vorgabe);
-  schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,
-                    x, y, xsize, ysize);
-  schreibe antwortfuss;
-  clear buffer;
-  REP
-    IF eingabe = "break"
-       THEN eingabe := ""
-    FI;
-    lasse eintragen
-
-  UNTIL eingabe <> "break" PER;
-  liefere ergebnis.
-  schreibe antwortfuss:
-    schreibe leerzeile;
-    schreibe eingabezeile;
-    schreibe abschlusszeile;
-    IF mit auswahl
-       THEN out footnote (w, aussage [5])
-       ELSE out footnote (w, aussage [6])
-    FI.
-  schreibe leerzeile:
-    cursor (x, y + ysize - 3);
-    out (senkrecht);
-    (xsize - 2) TIMESOUT blank;
-    out (senkrecht).
-  schreibe eingabezeile:
-    cursor (x, y + ysize - 2);
-    out (senkrecht);
-    out (aussage [8]);
-
-    (xsize - 2 - length (aussage [8])) TIMESOUT blank;
-    out (senkrecht).
-  schreibe abschlusszeile:
-    cursor (x, y + ysize - 1);
-    out (ecke unten links);
-    (xsize - 2) TIMESOUT waagerecht;
-    out (ecke unten rechts).
-  lasse eintragen:
-    TEXT VAR exit :: "";
-    cursor on;
-    cursor (x + length (aussage [8]) + 1, y + ysize - 2);
-    IF mit auswahl
-       THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit)
-       ELSE editget (eingabe, maxtextlength, textlaenge, "", "h",  exit)
-
-    FI;
-    cursor off;
-    IF exit = ""27"h"
-       THEN eingabe := ""
-    ELIF mit auswahl AND (exit = ""27"z")
-       THEN eingabe := ""27"z"
-    ELSE eingabe := compress (eingabe)
-    FI.
-  textlaenge:
-    xsize - 2 - length (aussage [8]).
-  liefere ergebnis:
-    eingabe.
-END PROC hole antwort;
-END PACKET ls dialog 4;
-
-
diff --git a/dialog/ls-DIALOG 5 b/dialog/ls-DIALOG 5
deleted file mode 100644
index 9902098..0000000
--- a/dialog/ls-DIALOG 5
+++ /dev/null
@@ -1,1412 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 5                     ** 
-          **                                                     ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET  ls dialog 5 DEFINES
-       menufootnote, old menufootnote,
-       menuinfo,menualternative,
-       menuyes, menuno, menuone,
-       menusome,menuanswer,
-       menuanswerone, menuanswersome,
-       install menu, handle menu,
-       refresh submenu, deactivate,
-       regenerate menuscreen, activate,
-       write menunotice, erase menunotice,
-       menubasistext, anwendungstext,
-       show menuwindow, menuwindowpage,
-       menuwindowout, menuwindowget,
-       menuwindoweditget, menuwindowedit,
-
-       menuwindowshow, menuwindowline,
-       menuwindowyes, menuwindowno,
-       menuwindowcursor, get menuwindowcursor,
-       remaining menuwindowlines,
-       menuwindowcenter, menuwindowstop,
-       editorinformationen,stdinfoedit,
-       menukartenname, current menuwindow,
-       reset dialog, only intern, ausstieg,
-       direktstart:
-LET systemkuerzel         =  "ls-DIALOG",
-    menutafeltaskname     =  "ls-MENUKARTEN",
-    menutafeltype         =   1954,
-    menutafelpraefix      =  "ls-MENUKARTE:",
-
-    stdmenukartenname     =  "ls-MENUKARTE:Archiv",
-    versionsnummer        =  "1.1",
-    copyright1            =  " (C) 1987/88 Eva Latta-Weber",
-    copyright2            =  " (C) 1988 ERGOS GmbH";
-LET maxmenus              =      6,
-    maxmenutexte          =    300,
-    maxinfotexte          =   2000,
-    maxhauptmenupunkte    =     10,
-    maxuntermenupunkte    =     15,
-    erste untermenuzeile  =      3;
-LET blank                 =    " ",
-    piep                  =  ""7"",
-
-    cleol                 =  ""5"",
-    cleop                 =  ""4"",
-    trennzeilensymbol     =  "###",
-    bleibt leer symbol    =  "***",
-    hauptmenuluecke       =   "  ";
-LET auswahlstring1        =  ""8""2""10""3""13""27"?";
-TYPE MENUPUNKT   = STRUCT (TEXT punktkuerzel,
-                                punktname,
-                                procname,
-                                boxtext,
-                           BOOL aktiv,
-                                angewaehlt),
-
-     EINZELMENU  = STRUCT (INT  belegt,
-                           TEXT ueberschrift,
-                           INT  anfangsposition,
-                                maxlaenge,
-                           ROW  maxuntermenupunkte MENUPUNKT menupunkt,
-                           INT  aktueller untermenupunkt,
-                           TEXT startprozedurname,
-                                leaveprozedurname),
-     MENU        = STRUCT (TEXT menuname,
-                           INT  anzahl hauptmenupunkte,
-
-                           ROW  maxhauptmenupunkte EINZELMENU einzelmenu,
-                           TEXT menueingangsprozedur,
-                                menuausgangsprozedur,
-                                menuinfo,
-                                lizenznummer,
-                                versionsnummer,
-                           INT  hauptmenuzeiger,
-                                untermenuanfang,
-                                untermenuzeiger),
-     INFOTEXT    = STRUCT (INT anzahl infotexte,
-
-                           ROW maxinfotexte TEXT stelle),
-     MENUTEXT    = STRUCT (INT anzahl menutexte,
-                           ROW maxmenutexte TEXT platz),
-     MENULEISTE  = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,
-                           ROW maxmenus MENU menu,
-                           MENUTEXT   menutext,
-                           INFOTEXT   infotext);
-BOUND MENULEISTE VAR menuleiste;
-DATASPACE VAR ds;
-WINDOW VAR menuwindow, schreibfenster, editorinfofenster;
-
-INITFLAG VAR in this task       ::         FALSE;
-INT VAR anzahl offener menus    ::             0;
-INT VAR menunotizx, menunotizxsize,
-        menunotizy, menunotizysize,
-        menunotizposition;
-TEXT VAR angekoppelte menutafel ::            "",
-         permanent footnote     ::            "",
-         menunotiztext;
-BOOL VAR menunotiz ist gesetzt  ::         FALSE,
-         nur interne verwendung ::         FALSE,
-         mit ausstieg          ::          FALSE;
-REAL VAR zeitpunkt              ::     clock (1);
-
-ROW 13 TEXT CONST fehlermeldung  :: ROW 13 TEXT : (
-"Die Task '" + menutafeltaskname + "' existiert nicht!",
-"Die Menukarte '",
-"' existiert nicht in der Task '" + menutafeltaskname + "'!",
-"' hat falschen Typ/Bezeichnung (keine 'MENUKARTE')!",
-"Das Menu '",
-"' ist nicht in der angekoppelten Menukarte!",
-"Zu viele geoeffnete Menus ( > 2 )!",
-"Kein Menu geoeffnet!",
-"Menu enthaelt keine Menupunkte!",
-"Menupunkt ist nicht im Menu enthalten!",
-"Kein Text vorhanden!",
-"Zugriff unmöglich!",
-
-"Einschränkung unzulässig!"
-);
-ROW 1 TEXT CONST vergleichstext :: ROW 1 TEXT : (
-"gibt es nicht"
-);
-ROW 3 TEXT CONST hinweis :: ROW 3 TEXT : (
-"Info:<ESC><?>/<?>  Wahl:<Pfeile>  Ausführen:<RETURN>  Verlassen:<ESC><q>",
-" Zum Weitermachen bitte irgendeine Taste tippen!",
-"Bitte warten ...  Ich räume auf!"
-);
-ROW 3 TEXT CONST infotext :: ROW 3 TEXT : (
-" Für diesen Menupunkt ist (noch) keine "13""13"        Funktion eingetragen!",
-" Möchten Sie dieses Menu tatsächlich verlassen",
-" Leider ist zu diesem Menupunkt "13""13"  kein Info - Text eingetragen!"
-
- );
-PROC install menu (TEXT CONST menutafelname):
-  installmenu (menutafelname, TRUE)
-END PROC install menu;
-PROC install menu (TEXT CONST menutafelname, BOOL CONST mit kennung):
-  TEXT VAR letzter parameter;
-  IF mit kennung
-     THEN zeige menukennung
-  FI;
-  initialisiere menu ggf;
-  IF menutafel noch nicht angekoppelt
-     THEN letzter parameter := std;
-          hole menutafel;
-          kopple menutafel an;
-          last param (letzter parameter)
-  FI.
-  initialisiere menu ggf:
-
-    IF NOT initialized (in this task)
-       THEN angekoppelte menutafel :=    "";
-            anzahl offener menus   :=     0;
-            menunotiz ist gesetzt  := FALSE;
-            nur interne verwendung := FALSE
-    FI.
-  menutafel noch nicht angekoppelt:
-    menutafelname <> angekoppelte menutafel.
-  hole menutafel:
-    IF NOT exists task (menutafeltaskname)
-       THEN bereinige situation; cursor on;
-            errorstop (fehlermeldung [1])
-    FI;
-    disable stop;
-    fetch (menutafelname, /menutafeltaskname);
-
-    IF   is error AND pos (errormessage, vergleichstext [1]) > 0
-         THEN clear error; enable stop;
-              bereinige situation; cursor on;
-              errorstop (fehlermeldung [2] + menutafelname +
-                         fehlermeldung [3])
-    ELIF is error
-         THEN clear error; enable stop;
-              bereinige situation; cursor on;
-              errorstop (errormessage)
-   ELSE enable stop
-    FI.
-  kopple menutafel an:
-    IF type (old (menutafelname)) = menutafeltype
-
-       AND pos (menutafelname,menutafelpraefix) = 1
-       THEN forget (ds);
-            ds                     := old (menutafelname);
-            menuleiste             := ds;
-            angekoppelte menutafel := menutafelname;
-            forget (menutafelname, quiet)
-       ELSE bereinige situation; cursor on;
-            errorstop ("'" + menutafelname + fehlermeldung [4])
-    FI.
-END PROC install menu;
-PROC only intern (BOOL CONST wert):
-  nur interne verwendung := wert
-END PROC only intern;
-
-PROC ausstieg (BOOL CONST wert):
-  mit ausstieg := wert
-END PROC ausstieg;
-TEXT PROC menukartenname:
-  IF NOT initialized (in this task)
-     THEN   angekoppelte menutafel :=    "";
-            anzahl offener menus   :=     0;
-            menunotiz ist gesetzt  := FALSE;
-  FI;
-  angekoppelte menutafel
-END PROC menukartenname;
-PROC handle menu (TEXT CONST menuname):
-  nur interne verwendung := FALSE;
-  mit ausstieg           :=  TRUE;
-  handle menu (menuname, "")
-END PROC handle menu;
-
-PROC handle menu (TEXT CONST menuname, ausstiegsproc):
-  cursor off;
-  IF nur interne verwendung
-     THEN oeffne menu (menuname)
-     ELSE biete menu an
-  FI;
-  lasse menupunkte auswaehlen;
-  IF nur interne verwendung
-     THEN do (ausstiegsproc);
-          anzahl offener menus DECR 1;
-          IF anzahl offener menus < 1 THEN erase menunotice FI;
-          menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
-          menuwindow := window (1,1,79, 24);
-          nur interne verwendung := FALSE;
-
-          mit ausstieg           := TRUE;
-          cursor on
-     ELSE schliesse menu;
-          leere ggf den bildschirm
-  FI.
-  biete menu an:
-    REAL VAR zwischenzeit :: clock (1) - zeitpunkt;
-    IF zwischenzeit < 2.0
-       THEN pause (20 - int (10.0 * zwischenzeit))
-    FI;
-    oeffne menu (menuname).
-  leere ggf den bildschirm:
-    IF anzahl offener menus < 1
-       THEN erase menunotice;
-            page; cursor on
-    FI.
-  lasse menupunkte auswaehlen:
-    TEXT VAR kuerzelkette :: "";
-
-    starte aktuelle untermenuoperationen;
-    REP
-      cursor in warteposition;
-      ermittle aktuelle kuerzelkette;
-      nimm zeichen auf;
-      interpretiere zeichen;
-    UNTIL menu verlassen gewuenscht PER.
-  nimm zeichen auf:
-    TEXT CONST erlaubte zeichen ::auswahlstring1 + kuerzelkette;
-    TEXT VAR eingabezeichen;
-    INT  VAR zeichenposition;
-    REP
-      inchar (eingabezeichen);
-      zeichenposition := pos (erlaubte zeichen, eingabezeichen);
-      piepse ggf
-    UNTIL zeichenposition > 0 PER.
-
-  piepse ggf:
-    IF zeichenposition = 0 THEN out (piep) FI.
-  menu verlassen gewuenscht:
-    zeichenposition = 6 AND (zweites zeichen = "q").
-  interpretiere zeichen:
-    SELECT zeichenposition OF
-      CASE 1: gehe einen hauptmenupunkt nach links
-      CASE 2: gehe einen hauptmenupunkt nach rechts
-      CASE 3: gehe einen untermenupunkt nach unten
-      CASE 4: gehe einen untermenupunkt nach oben
-      CASE 5: fuehre aktuellen menupunkt aus
-      CASE 6: hole esc sequenz
-      CASE 7: zeige erklaerungstext im menu an
-
-      OTHERWISE werte kuerzeleingabe aus
-    END SELECT.
-  gehe einen hauptmenupunkt nach links:
-    INT VAR anzahl schritte :: 1;
-    beende aktuelle untermenuoperationen;
-    loesche aktuelles untermenu auf bildschirm;
-    loesche alte hauptmenumarkierung;
-    anzahl schritte INCR clear buffer and count (""8"");
-    ermittle linke menuposition;
-    stelle aktuellen hauptmenupunkt invers dar;
-    starte aktuelle untermenuoperationen;
-    schreibe aktuelles untermenu auf bildschirm.
-  gehe einen hauptmenupunkt nach rechts:
-
-    anzahl schritte := 1;
-    beende aktuelle untermenuoperationen;
-    loesche aktuelles untermenu auf bildschirm;
-    loesche alte hauptmenumarkierung;
-    anzahl schritte INCR clear buffer and count (""2"");
-    ermittle rechte menuposition;
-    stelle aktuellen hauptmenupunkt invers dar;
-    starte aktuelle untermenuoperationen;
-    schreibe aktuelles untermenu auf bildschirm.
-  loesche alte hauptmenumarkierung:
-    erase invers (area (menuwindow), startpos, 1, ueberschriftlaenge);
-
-    out          (area (menuwindow), startpos, 1, ueberschrifttext).
-  startpos:
-    aktuelles untermenu.anfangsposition.
-  ueberschriftlaenge:
-    length (ueberschrifttext).
-  ueberschrifttext:
-    aktuelles untermenu.ueberschrift.
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  ermittle linke menuposition:
-    INT VAR positionszaehler;
-    FOR positionszaehler FROM 1 UPTO anzahl schritte REP
-
-      drehe die menuposition um einen wert runter
-    PER.
-  ermittle rechte menuposition:
-    FOR positionszaehler FROM 1 UPTO anzahl schritte REP
-      drehe die menuposition um einen wert hoch
-    PER.
-  drehe die menuposition um einen wert runter:
-    IF aktuelles menu.hauptmenuzeiger > 1
-       THEN aktuelles menu.hauptmenuzeiger DECR 1
-       ELSE aktuelles menu.hauptmenuzeiger
-                     := aktuelles menu.anzahl hauptmenupunkte
-    FI.
-  drehe die menuposition um einen wert hoch:
-
-    IF aktuelles menu.hauptmenuzeiger
-         < aktuelles menu.anzahl hauptmenupunkte
-       THEN aktuelles menu.hauptmenuzeiger INCR 1
-       ELSE aktuelles menu.hauptmenuzeiger := 1
-    FI.
-  gehe einen untermenupunkt nach unten:
-    INT VAR naechster aktiver := folgender aktiver untermenupunkt;
-    nimm ummarkierung vor.
-  gehe einen untermenupunkt nach oben:
-    naechster aktiver := vorausgehender aktiver untermenupunkt;
-    nimm ummarkierung vor.
-  nimm ummarkierung vor:
-    IF ueberhaupt aktive menupunkte vorhanden
-
-       THEN demarkiere aktuellen untermenupunkt;
-            gehe zum folgenden untermenupunkt;
-            markiere aktuellen untermenupunkt
-    FI.
-  ueberhaupt aktive menupunkte vorhanden:
-    (aktuelles untermenu.belegt > 0) CAND (naechster aktiver > 0).
-  gehe zum folgenden untermenupunkt:
-    aktuelles menu.untermenuzeiger := naechster aktiver.
-  stelle aktuellen hauptmenupunkt invers dar:
-    out invers (area (menuwindow), startpos, 1, ueberschrifttext).
-  fuehre aktuellen menupunkt aus:
-
-    IF nur interne verwendung AND mit ausstieg
-       THEN kennzeichne als angetickt;
-            disable stop;
-            do (ausstiegsproc);
-            do (menuanweisung);
-            aktueller menupunkt.angewaehlt := FALSE;
-            IF is error THEN put error; clear error FI;
-            enable stop;
-            anzahl offener menus DECR 1;
-            menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
-            menuwindow := window (1,1,79, 24);
-            nur interne verwendung := FALSE;
-
-            cursor on;
-            LEAVE handle menu
-       ELSE kennzeichne als angetickt;
-            fuehre operation aus (menuanweisung);
-            nimm kennzeichnung zurueck
-    FI.
-  kennzeichne als angetickt:
-    aktueller menupunkt.angewaehlt := TRUE;
-    markiere aktuellen untermenupunkt.
-  nimm kennzeichnung zurueck:
-    aktueller menupunkt.angewaehlt := FALSE;
-    markiere aktuellen untermenupunkt.
-  menuanweisung:
-   compress (aktueller menupunkt.procname).
-  aktueller menupunkt:
-
-    aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].
-  hole esc sequenz:
-    TEXT VAR zweites zeichen;
-    inchar (zweites zeichen);
-    SELECT pos ("q?$", zweites zeichen) OF
-      CASE 1: erfrage abbruch
-      CASE 2: zeige menubedienhinweise
-      CASE 3: gib info aus
-      OTHERWISE out (piep)
-    END SELECT.
-  erfrage abbruch:
-    IF menuno (infotext [2], 5)
-       THEN zweites zeichen := "n"  (* gleichgültig, nur nicht 'q'  *)
-    FI.
-  zeige menubedienhinweise:
-
-    INT VAR gewaehlt;
-    REP
-      gewaehlt := menualternative ( alttext, altwahl, altzusatz, 5, FALSE);
-      erfuelle den wunsch
-    UNTIL ausstieg aus bedienhinweisen gewuenscht PER.
-  alttext:
-    menuleiste.menutext.platz [1].
-  altwahl:
-    menuleiste.menutext.platz [2].
-  altzusatz:
-    menuleiste.menutext.platz [3].
-  erfuelle den wunsch:
-    SELECT gewaehlt OF
-      CASE 1,101,106: menuinfo (menuleiste.menutext.platz [4], 5, maxint)
-      CASE 2,102,107: menuinfo (menuleiste.menutext.platz [5], 5, maxint)
-
-      CASE 3,103,108: menuinfo (menuleiste.menutext.platz [6], 5, maxint)
-      CASE 4,104,109: menuinfo (menuleiste.menutext.platz [7], 5, maxint)
-    END SELECT.
-  ausstieg aus bedienhinweisen gewuenscht:
-    gewaehlt = 5 OR gewaehlt = 105 OR gewaehlt = 110.
-  gib info aus:
-    menuinfo (menuleiste.menutext.platz [20]).
-  zeige erklaerungstext im menu an:
-    IF compress (erklaerungstext) = ""
-       THEN menuinfo (infotext [3])
-       ELSE menuinfo (erklaerungstext)
-    FI.
-  erklaerungstext:
-
-    aktueller menupunkt.boxtext.
-  werte kuerzeleingabe aus:
-    naechster aktiver := pos (kuerzelkette, eingabezeichen);
-    nimm ummarkierung vor;
-    fuehre aktuellen menupunkt aus.
-  starte aktuelle untermenuoperationen:
-    ermittle aktuelle kuerzelkette;
-    IF startoperation <> ""
-       THEN fuehre operation aus (startoperation)
-    FI.
-  startoperation:
-    compress (aktuelles untermenu.startprozedurname).
-  ermittle aktuelle kuerzelkette:
-    kuerzelkette := "";
-    INT VAR kuerzelzeiger;
-
-    FOR kuerzelzeiger FROM 1 UPTO aktuelles untermenu.belegt REP
-      IF compress (aktuelles punktkuerzel) = ""
-         THEN kuerzelkette CAT ""0""  { beliebiger Code der Länge 1 }
-         ELSE haenge ggf kuerzel an
-      FI
-    PER.
-  aktuelles punktkuerzel:
-    aktuelles untermenu.menupunkt [kuerzelzeiger].punktkuerzel.
-  haenge ggf kuerzel an:
-    IF betrachteter punkt ist aktiv
-       THEN kuerzelkette CAT aktuelles punktkuerzel
-       ELSE kuerzelkette CAT ""0""
-    FI.
-  betrachteter punkt ist aktiv:
-
-    aktuelles untermenu.menupunkt [kuerzelzeiger].aktiv.
-  beende aktuelle untermenuoperationen:
-    kuerzelkette := "".
-END PROC handle menu;
-PROC oeffne menu (TEXT CONST menuname):
-  cursor off;
-  suche eingestelltes menu;
-  IF menu existiert nicht
-     THEN cursor on;
-          page;
-          errorstop (fehlermeldung [5] + menuname + fehlermeldung [6])
-  FI;
-  anzahl offener menus INCR 1;
-  ggf neue seite aufschlagen;
-  ueberpruefe anzahl offener menus;
-  lege ggf aktuelles menu auf eis;
-
-  initialisiere den menubildschirm;
-  IF NOT nur interne verwendung
-     THEN aktuelles menu.hauptmenuzeiger     := 1;
-          aktuelles menu.untermenuzeiger     := 0;
-          aktuelles menu.untermenuanfang     := 0;
-  FI;
-  show menu;
-  fuehre ggf menueingangsprozedur aus;
-  zeige ggf menukenndaten an.
-  suche eingestelltes menu:
-    INT VAR i, suchzeiger;
-    BOOL VAR gefunden :: FALSE;
-    FOR i FROM 1 UPTO menuleiste.belegt REP
-      IF menuleiste.menu [i].menuname = menuname
-
-         THEN gefunden   := TRUE;
-              suchzeiger := i;
-      FI
-    UNTIL menuleiste.menu [i].menuname = menuname PER.
-  menu existiert nicht:
-    NOT gefunden.
-  ueberpruefe anzahl offener menus:
-    IF anzahl offener menus > 2
-       THEN anzahl offener menus := 0; cursor on;
-            errorstop (fehlermeldung [7])
-    FI.
-  lege ggf aktuelles menu auf eis:
-    IF anzahl offener menus = 2
-       THEN menuleiste.zeigerhintergrund := menuleiste.zeigeraktuell
-    FI;
-    menuleiste.zeigeraktuell := suchzeiger.
-
-  initialisiere den menubildschirm:
-    IF anzahl offener menus = 2
-       THEN menuwindow := window (6, 4, 73, 20)
-       ELSE menuwindow := window (1, 1, 79, 24);
-    FI.
-  fuehre ggf menueingangsprozedur aus:
-    IF aktuelles menu.menueingangsprozedur <> ""
-       THEN fuehre operation aus (aktuelles menu.menueingangsprozedur)
-    FI.
-  ggf neue seite aufschlagen:
-    IF anzahl offener menus = 1 THEN page FI.
-  zeige ggf menukenndaten an:
-    IF anzahl offener menus = 1  AND aktuelles menu.menuinfo <> bleibt leer symbol
-
-       THEN write menunotice (vollstaendiger infotext, 4);
-            pause (100);
-            erase menunotice
-    FI.
-  vollstaendiger infotext:
-    aktuelles menu.menuinfo +
-    aktuelles menu.lizenznummer +
-    aktuelles menu.versionsnummer.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-END PROC oeffne menu;
-PROC show menu:
-  ueberpruefe menudaten;
-  stelle hauptmenuleiste zusammen;
-  zeige hauptmenu an;
-  stelle aktuellen hauptmenupunkt invers dar;
-  schreibe aktuelles untermenu auf bildschirm;
-
-  zeige informationszeile an.
-  ueberpruefe menudaten:
-    IF   anzahl offener menus = 0
-         THEN errorstop (fehlermeldung [8])
-    ELIF aktuelles menu.anzahl hauptmenupunkte < 1
-         THEN errorstop (fehlermeldung [9])
-    FI.
-  stelle hauptmenuleiste zusammen:
-    TEXT VAR hauptmenuzeile :: "";
-    INT VAR zeiger;
-    hauptmenuzeile CAT aktuelles menu.menuname;
-    hauptmenuzeile CAT ":";
-    FOR zeiger FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP
-      haenge hauptmenupunkt an
-
-    PER.
-  haenge hauptmenupunkt an:
-    hauptmenuzeile CAT hauptmenuluecke;
-    hauptmenuzeile CAT hauptmenupunktname.
-  hauptmenupunktname:
-    aktuelles menu.einzelmenu [zeiger].ueberschrift.
-  zeige hauptmenu an:
-    page (menuwindow, TRUE);
-    out menuframe (area (menuwindow));
-    cursor (menuwindow, 1, 1);
-    out (menuwindow, hauptmenuzeile).
-  stelle aktuellen hauptmenupunkt invers dar:
-    cursor (menuwindow, startposition, 1);
-    out (menuwindow, invers (ueberschrifttext)).
-
-  startposition:
-    aktuelles untermenu.anfangsposition - 1.
-  ueberschrifttext:
-    aktuelles untermenu.ueberschrift.
-  zeige informationszeile an:
-    write permanent footnote (hinweis [1]).
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC show menu;
-PROC schreibe aktuelles untermenu auf bildschirm:
-  ermittle linke obere ecke des untermenukastens;
-  wirf untermenu aus;
-
-  show menunotice;
-  cursor in warteposition.
-  ermittle linke obere ecke des untermenukastens:
-    aktuelles menu.untermenuanfang := menumitte - halbe menubreite;
-    achte auf randextrema.
-  menumitte:
-    startposition + (length (ueberschrifttext) DIV 2) - 1.
-  startposition:
-    aktuelles untermenu.anfangsposition.
-  ueberschrifttext:
-    aktuelles untermenu.ueberschrift.
-  halbe menubreite:
-    aktuelles untermenu.maxlaenge DIV 2.
-  achte auf randextrema:
-    gleiche ggf linken  rand aus;
-
-    gleiche ggf rechten rand aus.
-  gleiche ggf linken rand aus:
-    IF aktuelles menu.untermenuanfang < 4
-       THEN aktuelles menu.untermenuanfang := 4
-    FI.
-  gleiche ggf rechten rand aus:
-    IF (aktuelles menu.untermenuanfang + aktuelles untermenu.maxlaenge) >
-       (areaxsize (menuwindow) - 3)
-       THEN aktuelles menu.untermenuanfang
-               := areaxsize (menuwindow) - aktuelles untermenu.maxlaenge - 3
-    FI.
- wirf untermenu aus:
-    IF aktuelles menu.untermenuzeiger = 0
-
-       THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
-    FI;
-    wirf untermenukopfzeile aus;
-    wirf untermenurumpf aus;
-    wirf untermenufusszeile aus;
-    markiere aktuellen untermenupunkt.
-  wirf untermenukopfzeile aus:
-    cursor (menuwindow, spalte, anfangszeile);
-    out (balken oben); striche; out (balken oben).
-  wirf untermenufusszeile aus:
-    cursor (menuwindow, spalte, endezeile);
-    out (ecke unten links); striche; out (ecke unten rechts).
-  spalte:
-
-    aktuelles menu.untermenuanfang - 3.
-  anfangszeile:
-    erste untermenuzeile - 1.
-  endezeile:
-    erste untermenuzeile + aktuelles untermenu.belegt.
-  striche:
-    (aktuelles untermenu.maxlaenge + 5) TIMESOUT waagerecht.
-  wirf untermenurumpf aus:
-    INT VAR laufvar;
-    INT CONST aktuelle punktlaenge :: aktuelles untermenu.maxlaenge + 1;
-    FOR laufvar FROM 1 UPTO aktuelles untermenu.belegt REP
-      wirf eine einzelne menuzeile aus
-    PER.
-  wirf eine einzelne menuzeile aus:
-
-    out with beam (area (menuwindow), menuspalte, menuzeile,
-                   aktueller punktname, laenge).
-  menuspalte:
-    aktuelles menu.untermenuanfang.
-  menuzeile:
-    erste untermenuzeile + laufvar - 1.
-  aktueller punktname:
-    untermenubezeichnung (laufvar).
-  laenge:
-    aktuelle punktlaenge.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC schreibe aktuelles untermenu auf bildschirm;
-
-PROC loesche aktuelles untermenu auf bildschirm:
-  beende aktuelle untermenuoperationen;
-  loesche untermenu auf bildschirm;
-  schreibe balken wieder hin;
-  aktuelles menu.untermenuzeiger := 1.
-  beende aktuelle untermenuoperationen:
-    IF leaveoperation <> ""
-       THEN fuehre operation aus (leaveoperation)
-    FI.
-  leaveoperation:
-    compress (aktuelles untermenu.leaveprozedurname).
-  loesche untermenu auf bildschirm:
-    INT VAR laufvar;
-    FOR laufvar FROM aktuelles untermenu.belegt + 1 DOWNTO 1 REP
-
-      loesche eine einzelne menuzeile
-    PER.
-  loesche eine einzelne menuzeile:
-    erase with beam (area (menuwindow), menuspalte, menuzeile, laenge).
-  menuspalte:
-    aktuelles menu.untermenuanfang.
-  menuzeile:
-    erste untermenuzeile + laufvar - 1.
-  laenge:
-    aktuelles untermenu.maxlaenge + 1.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-  schreibe balken wieder hin:
-
-    cursor (menuwindow, spalte, anfangszeile);
-    (aktuelles untermenu.maxlaenge + 7) TIMESOUT waagerecht.
-  spalte:
-    aktuelles menu.untermenuanfang - 3.
-  anfangszeile:
-    erste untermenuzeile - 1.
-END PROC loesche aktuelles untermenu auf bildschirm;
-PROC markiere aktuellen untermenupunkt:
-  IF aktuelles menu.untermenuzeiger <> 0
-     THEN laufe ggf zum naechsten aktiven menupunkt;
-          out invers with beam (area (menuwindow), menuspalte, menuzeile,
-                                aktueller punktname, laenge)
-
-  FI.
-  laufe ggf zum naechsten aktiven menupunkt:
-    IF NOT aktuelles untermenu.menupunkt [aktuelles menu.untermenuzeiger].aktiv
-       THEN aktuelles menu.untermenuzeiger := folgender aktiver untermenupunkt
-    FI.
-  menuspalte:
-    aktuelles menu.untermenuanfang.
-  menuzeile:
-    erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
-  aktueller punktname:
-    untermenubezeichnung (aktuelles menu.untermenuzeiger).
-  laenge:
-    aktuelles untermenu.maxlaenge + 1.
-  aktuelles menu:
-
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC markiere aktuellen untermenupunkt;
-PROC demarkiere aktuellen untermenupunkt:
-  IF aktuelles menu.untermenuzeiger <> 0
-     THEN erase invers (area (menuwindow), menuspalte, menuzeile, laenge);
-          out (area (menuwindow), menuspalte, menuzeile,
-                                  aktueller punktname, laenge)
-  FI.
-  menuspalte:
-    aktuelles menu.untermenuanfang.
-
-  menuzeile:
-    erste untermenuzeile - 1 + aktuelles menu.untermenuzeiger.
-  aktueller punktname:
-    untermenubezeichnung (aktuelles menu.untermenuzeiger).
-  laenge:
-    aktuelles untermenu.maxlaenge + 1.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC demarkiere aktuellen untermenupunkt;
-INT PROC folgender aktiver untermenupunkt:
-  INT VAR anzahl aktiver menupunkte :: 0;
-
-  untersuche anzahl aktiver menupunkte;
-  IF   kein aktiver menupunkt vorhanden
-       THEN 0
-  ELIF nur ein aktiver menupunkt vorhanden
-       THEN liefere einzigen aktiven menupunkt
-  ELSE liefere naechsten aktiven menupunkt
-  FI.
-  untersuche anzahl aktiver menupunkte:
-    INT VAR zaehler, position;
-    FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
-      IF aktuelles untermenu.menupunkt [zaehler].aktiv
-         THEN anzahl aktiver menupunkte INCR 1;
-              position := zaehler
-
-      FI
-    UNTIL anzahl aktiver menupunkte > 1 PER.
-  kein aktiver menupunkt vorhanden:
-    anzahl aktiver menupunkte = 0.
-  nur ein aktiver menupunkt vorhanden:
-    anzahl aktiver menupunkte = 1.
-  liefere einzigen aktiven menupunkt:
-    position.
-  liefere naechsten aktiven menupunkt:
-    INT VAR interner zeiger;
-    stelle internen zeiger auf den naechsten menupunkt;
-    WHILE NOT punkt ist aktiv REP
-      untersuche naechsten menupunkt
-    PER;
-    ergebnis.
-    stelle internen zeiger auf den naechsten menupunkt:
-
-      IF aktuelles menu.untermenuzeiger = letzter untermenupunkt
-         THEN interner zeiger := 1
-         ELSE interner zeiger := aktuelles menu.untermenuzeiger + 1
-      FI.
-    letzter untermenupunkt:
-      aktuelles untermenu.belegt.
-    punkt ist aktiv:
-      aktuelles untermenu.menupunkt [interner zeiger].aktiv.
-    untersuche naechsten menupunkt:
-      IF interner zeiger = letzter untermenupunkt
-         THEN interner zeiger := 1
-         ELSE interner zeiger INCR 1
-      FI.
-
-    ergebnis:
-      interner zeiger.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC folgender aktiver untermenupunkt;
-INT PROC vorausgehender aktiver untermenupunkt:
-  INT VAR anzahl aktiver menupunkte :: 0;
-  untersuche anzahl aktiver menupunkte;
-  IF   kein aktiver menupunkt vorhanden
-       THEN 0
-  ELIF nur ein aktiver menupunkt vorhanden
-       THEN liefere einzigen aktiven menupunkt
-
-  ELSE liefere vorausgehenden aktiven menupunkt
-  FI.
-  untersuche anzahl aktiver menupunkte:
-    INT VAR zaehler, position;
-    FOR zaehler FROM 1 UPTO aktuelles untermenu.belegt REP
-      IF aktuelles untermenu.menupunkt [zaehler].aktiv
-         THEN anzahl aktiver menupunkte INCR 1;
-              position := zaehler
-      FI
-    UNTIL anzahl aktiver menupunkte > 1 PER.
-  kein aktiver menupunkt vorhanden:
-    anzahl aktiver menupunkte = 0.
-  nur ein aktiver menupunkt vorhanden:
-    anzahl aktiver menupunkte = 1.
-
-  liefere einzigen aktiven menupunkt:
-    position.
-  liefere vorausgehenden aktiven menupunkt:
-    INT VAR interner zeiger;
-    stelle internen zeiger auf vorausgehenden menupunkt;
-    WHILE NOT punkt ist aktiv REP
-      untersuche vorausgehenden menupunkt
-    PER;
-    ergebnis.
-  stelle internen zeiger auf vorausgehenden menupunkt:
-    IF aktuelles menu.untermenuzeiger <= 1
-       THEN interner zeiger := letzter untermenupunkt
-       ELSE interner zeiger := aktuelles menu.untermenuzeiger - 1
-
-    FI.
-  letzter untermenupunkt:
-    aktuelles untermenu.belegt.
-  punkt ist aktiv:
-    aktuelles untermenu.menupunkt [interner zeiger].aktiv.
-  untersuche vorausgehenden menupunkt:
-    IF interner zeiger = 1
-       THEN interner zeiger := letzter untermenupunkt
-       ELSE interner zeiger DECR 1
-    FI.
-  ergebnis:
-    interner zeiger.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-
-END PROC vorausgehender aktiver untermenupunkt;
-PROC cursor in warteposition:
-  cursor (areax (menuwindow), areay (menuwindow) + 1)
-END PROC cursor in warteposition;
-TEXT PROC untermenubezeichnung (INT CONST position):
-  TEXT VAR bezeichnung :: "";
-  bezeichnung CAT kennzeichnung;
-  bezeichnung CAT punktkennung;
-  bezeichnung.
-  kennzeichnung:
-    IF        aktueller menupunkt.aktiv
-         AND  aktueller menupunkt.angewaehlt
-              THEN "*"
-    ELIF      aktueller menupunkt.aktiv
-
-         AND  aktueller menupunkt.punktkuerzel <> ""
-              THEN aktueller menupunkt.punktkuerzel
-    ELIF      aktueller menupunkt.aktiv
-         AND  aktueller menupunkt.punktkuerzel = ""
-              THEN blank
-    ELSE      "-"
-    FI.
-    punktkennung:
-      IF menupunkt ist trennzeile
-         THEN strichellinie
-         ELSE aktueller menupunkt.punktname
-      FI.
-    menupunkt ist trennzeile:
-      aktueller menupunkt.punktname = (blank + trennzeilensymbol).
-    strichellinie:
-
-      (aktuelles untermenu.maxlaenge + 1) * "-".
-    aktueller menupunkt:
-      aktuelles untermenu.menupunkt [position].
-    aktuelles menu:
-      menuleiste.menu [menuleiste.zeigeraktuell].
-    aktuelles untermenu:
-      aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC untermenubezeichnung;
-PROC fuehre operation aus (TEXT CONST operation):
-  disable stop;
-  IF operation = ""
-     THEN menuinfo (infotext [1]);
-          LEAVE fuehre operation aus
-  FI;
-  do (operation);
-
-  IF is error
-     THEN menuinfo (errormessage, 5);
-          clear error
-  FI;
-  old menufootnote;
-  enable stop;
-  cursor off
-END PROC fuehre operation aus;
-PROC veraendere aktivierung (TEXT CONST unterpunkt, BOOL CONST eintrag):
-  INT VAR unterpunktposition :: 0, zeiger;
-  suche unterpunkt;
-  aendere aktivierung.
-  suche unterpunkt:
-    FOR zeiger FROM 1 UPTO untermenuende REP
-      IF untermenupunkt = blank + compress (unterpunkt)
-         THEN unterpunktposition := zeiger;
-              LEAVE suche unterpunkt
-
-      FI
-    PER;
-    LEAVE veraendere aktivierung.
-  untermenuende:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
-  untermenupunkt:
-    aktuelles untermenu.menupunkt [zeiger].punktname.
-  aendere aktivierung:
-    aktuelles untermenu.menupunkt [unterpunktposition].aktiv := eintrag.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC veraendere aktivierung;
-
-PROC veraendere aktivierung (INT CONST punktnummer, BOOL CONST eintrag):
-  IF punktnummer >= 1 AND punktnummer <= untermenuende
-     THEN aktuelles untermenu.menupunkt [punktnummer].aktiv := eintrag
-  FI.
-  untermenuende:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC veraendere aktivierung;
-PROC veraendere anwahl (TEXT CONST unterpunkt, BOOL CONST eintrag):
-
-  INT VAR unterpunktposition :: 0, zeiger;
-  suche unterpunkt;
-  aendere anwahl.
-  suche unterpunkt:
-    FOR zeiger FROM 1 UPTO untermenuende REP
-      IF untermenupunkt = blank + compress (unterpunkt)
-         THEN unterpunktposition := zeiger;
-              LEAVE suche unterpunkt
-      FI
-    PER;
-    enable stop;
-    errorstop (fehlermeldung [10]).
-  untermenuende:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].belegt.
-  untermenupunkt:
-    aktuelles untermenu.menupunkt [zeiger].punktname.
-
-  aendere anwahl:
-    aktuelles untermenu.menupunkt [unterpunktposition].angewaehlt := eintrag.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [aktuelles menu.hauptmenuzeiger].
-END PROC veraendere anwahl;
-PROC activate (TEXT CONST unterpunkt):
-  enable stop;
-  veraendere aktivierung (unterpunkt, TRUE)
-END PROC activate;
-PROC activate (INT CONST punktnummer):
-  enable stop;
-  veraendere aktivierung (punktnummer, TRUE)
-
-END PROC activate;
-PROC deactivate (TEXT CONST unterpunkt):
-  enable stop;
-  veraendere aktivierung (unterpunkt, FALSE)
-END PROC deactivate;
-PROC deactivate (INT CONST punktnummer):
-  enable stop;
-  veraendere aktivierung (punktnummer, FALSE)
-END PROC deactivate;
-PROC select (TEXT CONST unterpunkt):
-  enable stop;
-  veraendere anwahl (unterpunkt, TRUE)
-END PROC select;
-PROC deselect (TEXT CONST unterpunkt):
-  enable stop;
-  veraendere anwahl (unterpunkt, FALSE)
-END PROC deselect;
-
-PROC schliesse menu:
-  IF aktuelles menu.menuausgangsprozedur <> ""
-     THEN menufootnote (hinweis [3]);
-          fuehre operation aus (aktuelles menu.menuausgangsprozedur)
-  FI;
-  anzahl offener menus DECR 1;
-  IF anzahl offener menus = 1
-     THEN aktiviere das auf eis gelegte menu
-  FI.
-  aktiviere das auf eis gelegte menu:
-    menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
-    menuwindow := window (1, 1, 79, 24);
-    show menu.
-  aktuelles menu:
-    menuleiste.menu [menuleiste.zeigeraktuell].
-
-END PROC schliesse menu;
-PROC refresh submenu:
-  schreibe aktuelles untermenu auf bildschirm;
-  show menunotice;
-END PROC refresh submenu;
-PROC regenerate menuscreen:
-  IF   anzahl offener menus = 0
-       THEN errorstop (fehlermeldung [8])
-  ELIF anzahl offener menus = 1
-       THEN page;
-            show menu;
-            show menunotice
-  ELSE zeige erstes menu an;
-       zeige zweites menu an;
-       show menunotice
-  FI.
-  zeige erstes menu an:
-    INT VAR menuzeiger :: menuleiste.zeigeraktuell;
-
-    menuleiste.zeigeraktuell := menuleiste.zeigerhintergrund;
-    menuwindow := window (1, 1, 79, 24);
-    anzahl offener menus := 1;
-    show menu.
-  zeige zweites menu an:
-    menuleiste.zeigeraktuell := menuzeiger;
-    menuwindow := window (6, 4, 73, 20);
-    anzahl offener menus := 2;
-    show menu.
-END PROC regenerate menuscreen;
-PROC menuinfo (TEXT CONST t, INT CONST position, timelimit):
-  boxinfo (menuwindow, t, position, timelimit, FALSE);
-  schreibe aktuelles untermenu auf bildschirm;
-
-  old menufootnote
-END PROC menuinfo;
-PROC menuinfo (TEXT CONST t, INT CONST position):
-  menuinfo (t, position, maxint)
-END PROC menuinfo;
-PROC menuinfo (TEXT CONST t):
-  menuinfo (t, 5, maxint)
-END PROC menuinfo;
-INT PROC menualternative (TEXT CONST t, auswahlliste, zusatztasten,
-                          INT CONST position, BOOL CONST mit abbruch):
-  INT VAR ergebnis :=  boxalternative (menuwindow, t, auswahlliste,
-                       zusatztasten, position, mit abbruch, FALSE);
-
-  schreibe aktuelles untermenu auf bildschirm;
-  old menufootnote;
-  ergebnis
-END PROC menualternative;
-BOOL PROC menuyes (TEXT CONST frage, INT CONST position):
-  BOOL VAR wert := boxyes (menuwindow, frage, position, FALSE);
-  schreibe aktuelles untermenu auf bildschirm;
-  old menufootnote;
-  wert
-END PROC menuyes;
-BOOL PROC menuno (TEXT CONST frage, INT CONST position):
-  NOT menuyes (frage, position)
-END PROC menuno;
-TEXT PROC menuone (THESAURUS CONST thes, TEXT CONST t1, t2,
-                   BOOL CONST mit reinigung):
-
-  TEXT CONST wert :: boxone (menuwindow, thes, t1, t2, mit reinigung);
-  IF mit reinigung
-     THEN schreibe aktuelles untermenu auf bildschirm;
-          old menufootnote
-  FI;
-  wert
-END PROC menuone;
-THESAURUS PROC menusome (THESAURUS CONST thes, TEXT CONST t1, t2,
-                         BOOL CONST mit reinigung):
-  THESAURUS CONST thesaurus :: boxsome (menuwindow, thes, t1, t2,
-                                        mit reinigung);
-  IF mit reinigung
-     THEN schreibe aktuelles untermenu auf bildschirm;
-
-          old menufootnote
-  FI;
-  thesaurus
-END PROC menusome;
-TEXT PROC menuanswer (TEXT CONST t, vorgabe, INT CONST position):
-  TEXT VAR wert :: boxanswer (menuwindow, t, vorgabe, position, FALSE);
-  schreibe aktuelles untermenu auf bildschirm;
-  old menufootnote;
-  wert
-END PROC menuanswer;
-TEXT PROC menuanswerone (TEXT CONST t, vorgabe, THESAURUS CONST thes,
-                          TEXT CONST t1, t2, BOOL CONST mit reinigung):
-  TEXT VAR wert :: boxanswerone (menuwindow, t, vorgabe, thes, t1, t2,
-
-                                             mit reinigung, FALSE)
-  IF mit reinigung
-     THEN schreibe aktuelles untermenu auf bildschirm;
-          old menufootnote
-  FI;
-  wert
-END PROC menuanswer one;
-THESAURUS PROC menuanswersome (TEXT CONST t, vorgabe, THESAURUS CONST thes,
-                               TEXT CONST t1, t2, BOOL CONST mit reinigung):
-  THESAURUS VAR wert :: boxanswersome (menuwindow, t, vorgabe,
-                                       thes, t1, t2, mit reinigung, FALSE)
-
-  IF mit reinigung
-     THEN schreibe aktuelles untermenu auf bildschirm;
-          old menufootnote
-  FI;
-  wert
-END PROC menuanswersome;
-PROC menufootnote (TEXT CONST t):
-  cursor (menuwindow, 1, areaysize (menuwindow) - 1);
-  areaxsize (menuwindow) TIMESOUT waagerecht;
-  cursor (menuwindow, 1, areaysize (menuwindow));
-  outtext (t, 1, areaxsize (menuwindow))
-END PROC menufootnote;
-PROC old menufootnote:
-  menufootnote (permanent footnote)
-END PROC old menufootnote;
-TEXT PROC menubasistext (INT CONST nummer):
-
-  IF   nummer <= 20
-       THEN fehlermeldung [12]
-  ELIF nummer > menuleiste.menutext.anzahl menutexte
-       THEN fehlermeldung [11]
-  ELSE menuleiste.menutext.platz [nummer]
-  FI
-END PROC menubasistext;
-TEXT PROC anwendungstext (INT CONST nummer):
-  IF nummer > menuleiste.infotext.anzahl infotexte
-     THEN fehlermeldung [11]
-     ELSE menuleiste.infotext.stelle [nummer]
-  FI
-END PROC anwendungstext;
-PROC zeige menukennung:
-  IF anzahl offener menus = 0
-     THEN zeige angaben und emblem;
-
-  FI.
-  zeige angaben und emblem:
-    ROW 5 WINDOW VAR w;
-    w [ 1] := window (40,  3, 30, 9);
-    w [ 2] := window (36,  5, 30, 9);
-    w [ 3] := window (30,  7, 30, 9);
-    w [ 4] := window (22,  9, 30, 9);
-    w [ 5] := window (12, 11, 30, 9);
-    page;
-    show (w [1]); out (w [1], center (w [1], invers (systemkuerzel)));
-    show (w [2]); out (w [2], " Version " + versionsnummer);
-    show (w [3]); out (w [3], copyright1);
-    show (w [4]); out (w [4], copyright2);
-    show (w [5]);
-
-    cursor (w [5], 1, 2);out (w [5], "    lll        sssssssss  ");
-    cursor (w [5], 1, 3);out (w [5], "    lll       sss     sss ");
-    cursor (w [5], 1, 4);out (w [5], "    lll       sss         ");
-    cursor (w [5], 1, 5);out (w [5], "    lll        sssssssss  ");
-    cursor (w [5], 1, 6);out (w [5], "    lll               sss ");
-    cursor (w [5], 1, 7);out (w [5], "    lll latta soft    sss ");
-    cursor (w [5], 1, 8);out (w [5], "     lllllllll sssssssss  ");
-    cursor (79, 24);
-
-    zeitpunkt := clock (1);
-END PROC zeige menukennung;
-PROC reset dialog:
- angekoppelte menutafel := "";
- anzahl offener menus   :=  0
-END PROC reset dialog;
-PROC write permanent footnote (TEXT CONST t):
-  permanent footnote := t;
-  cursor (menuwindow, 1, areaysize (menuwindow));
-  outtext (t, 1, areaxsize (menuwindow))
-END PROC write permanent footnote;
-PROC write menunotice (TEXT CONST t, INT CONST position):
-  erase menunotice;
-  boxnotice (menuwindow, t, position, menunotizx,     menunotizy,
-
-                                      menunotizxsize, menunotizysize);
-  menunotiztext         := t;
-  menunotizposition     := position;
-  menunotiz ist gesetzt := TRUE
-END PROC write menunotice;
-PROC show menunotice:
-  IF menunotiz ist gesetzt
-     THEN boxnotice (menuwindow, menunotiztext, menunotizposition,
-                     menunotizx, menunotizy, menunotizxsize, menunotizysize);
-  FI
-END PROC show menunotice;
-PROC erase menunotice:
-  INT VAR spa, zei;
-  get cursor (spa, zei);
-
-  IF menunotiz ist gesetzt
-     THEN page up (menunotizx, menunotizy, menunotizxsize, menunotizysize);
-          menunotiz ist gesetzt := FALSE;
-          cursor (spa, zei)
-  FI
-END PROC erase menunotice;
-PROC initialize menuwindow:
-  schreibfenster := window (areax     (menuwindow) + 1,
-                            areay     (menuwindow) + 3,
-                            areaxsize (menuwindow) - 2,
-                            areaysize (menuwindow) - 4)
-END PROC initialize menuwindow;
-
-PROC show menuwindow:
-  initialize menuwindow;
-  show (schreibfenster);
-END PROC show menuwindow;
-PROC menuwindow page:
-  initialize menuwindow;
-  page (schreibfenster)
-END PROC menuwindow page;
-PROC menuwindowout (TEXT CONST text):
-  out (schreibfenster, text)
-END PROC menuwindow out;
-PROC menuwindowget (TEXT VAR text):
-  get (schreibfenster, text)
-END PROC menuwindowget;
-PROC menuwindoweditget (TEXT VAR text):
-  editget (schreibfenster, text)
-END PROC menuwindoweditget;
-PROC menuwindowedit (TEXT CONST dateiname):
-
-  initialize menuwindow;
-  edit (schreibfenster, dateiname)
-END PROC menuwindowedit;
-PROC menuwindowedit (FILE VAR f):
-  initialize menuwindow;
-  edit (schreibfenster, f)
-END PROC menuwindowedit;
-PROC menuwindowshow (TEXT CONST dateiname):
-  initialize menuwindow;
-  show (schreibfenster, dateiname)
-END PROC menuwindowshow;
-PROC menuwindowshow (FILE VAR f):
-  initialize menuwindow;
-  show (schreibfenster, f)
-END PROC menuwindowshow;
-BOOL PROC menuwindowyes (TEXT CONST frage):
-  yes (schreibfenster, frage)
-
-END PROC menuwindowyes;
-BOOL PROC menuwindowno (TEXT CONST frage):
-  no (schreibfenster, frage)
-END PROC menuwindowno;
-PROC menuwindowline:
-  menuwindowline (1)
-END PROC menuwindowline;
-PROC menuwindowline (INT CONST anzahl):
-  line (schreibfenster, anzahl)
-END PROC menuwindowline;
-PROC menuwindowcursor (INT CONST spa, zei):
-  cursor (schreibfenster, spa, zei)
-END PROC menuwindowcursor;
-PROC get menuwindowcursor (INT VAR spa, zei):
-  get cursor (schreibfenster, spa, zei)
-END PROC get menuwindowcursor;
-
-INT PROC remaining menuwindowlines:
-  remaining lines (schreibfenster)
-END PROC remaining menuwindowlines;
-TEXT PROC menuwindowcenter (TEXT CONST t):
-  center (schreibfenster, t)
-END PROC menuwindowcenter;
-PROC menuwindowstop:
-  menuwindowstop (2)
-END PROC menuwindowstop;
-PROC menuwindowstop (INT CONST anzahl):
-  stop (schreibfenster, anzahl)
-END PROC menuwindowstop;
-WINDOW PROC current menuwindow:
-  initialize menuwindow;
-  schreibfenster
-END PROC current menuwindow;
-PROC stdinfoedit (FILE VAR f, INT CONST oberste zeile):
-
-  IF oberste zeile < 1 OR oberste zeile > 3
-     THEN errorstop (fehlermeldung [13]);
-  FI;
-  garantiere menukarte;
-  cursor (1, oberste zeile); out (cleop);
-  cursor (1, 23); out(79 * waagerecht);
-  cursor (1, 24); outtext (menubasistext (141), 1, 79);
-  editorinfofenster := window (1, oberste zeile + 1, 79, 24 - oberste zeile);
-  kommando auf taste legen ("?", "editorinformationen");
-  command dialogue (FALSE);
-  cursor on; edit (f, 1, oberste zeile, 79, 23 - oberste zeile);
-  command dialogue (TRUE);
-
-  kommando auf taste legen ("?", "").
-  garantiere menukarte:
-    TEXT VAR name := compress (menukartenname);
-    IF name = ""
-       THEN install menu (stdmenukartenname, FALSE)
-    FI.
-END PROC stdinfoedit;
-PROC stdinfoedit (FILE VAR f):
-  stdinfoedit (f, 1)
-END PROC stdinfoedit;
-PROC stdinfoedit (TEXT CONST dateiname, INT CONST oberste zeile):
-  FILE VAR f :: sequential file (modify, dateiname);
-  stdinfoedit (f, oberste zeile);
-END PROC stdinfoedit;
-PROC stdinfoedit (TEXT CONST dateiname):
-
-  stdinfoedit (dateiname, 1)
-END PROC stdinfoedit;
-PROC editorinformationen:
-  BOOL VAR ende gewuenscht :: FALSE; INT VAR z;
-  FOR z FROM startwert UPTO 22 REP
-    cursor (1, z); out (cleol);
-  PER;
-  REP
-    INT VAR erg := boxalternative (editorinfofenster,
-                                   menubasistext (149),
-                                   menubasistext (150),
-                                   menubasistext (151),
-                                   5, FALSE, FALSE);
-    erfuelle den wunsch
-
-  UNTIL ende gewuenscht PER;
-  cursor (2, 23); 77 TIMESOUT waagerecht;
-  cursor (1, 24); outtext (menubasistext (141), 1, 79).
-  startwert:
-    areay (editorinfofenster) + 1.
-  erfuelle den wunsch:
-    SELECT erg OF
-      CASE 1, 101, 109: boxinfo (editorinfofenster, menubasistext (142), 5, maxint, FALSE)
-      CASE 2, 102, 110: boxinfo (editorinfofenster, menubasistext (143), 5, maxint, FALSE)
-      CASE 3, 103, 111: boxinfo (editorinfofenster, menubasistext (144), 5, maxint, FALSE)
-      CASE 4, 104, 112: boxinfo (editorinfofenster, menubasistext (145), 5, maxint, FALSE)
-
-      CASE 5, 105, 113: boxinfo (editorinfofenster, menubasistext (146), 5, maxint, FALSE)
-      CASE 6, 106, 114: boxinfo (editorinfofenster, menubasistext (147), 5, maxint, FALSE)
-      CASE 7, 107, 115: boxinfo (editorinfofenster, menubasistext (148), 5, maxint, FALSE)
-      CASE 8, 108, 116: ende gewuenscht := TRUE
-      OTHERWISE   (*tue nichts*)
-    END SELECT
-END PROC editorinformationen;
-PROC bereinige situation:
-  page;
-  forget (ds);
-  reset dialog
-END PROC bereinige situation;
-
-PROC direktstart (TEXT CONST procname, BOOL CONST autoloeschen):
-  TEXT VAR datname := "Selbststartergenerierungsdatei", letzter := std;
-  kopple archivmenukarte an;
-  schreibe programm;
-  insertiere programm;
-  abkoppeln.
-  kopple archivmenukarte an:
-    install menu (stdmenukartenname, FALSE).
-  schreibe programm:
-    forget (datname, quiet);
-    FILE VAR f :: sequential file (output, datname);
-    putline (f, menubasistext (191));
-    putline (f, "do (""reset dialog; erase menunotice; " + procname + """);");
-
-    putline (f, menubasistext (192));
-    IF autoloeschen
-       THEN putline (f, menubasistext (193))
-       ELSE putline (f, menubasistext (194))
-    FI;
-    putline (f, menubasistext (195));
-    putline (f, menubasistext (196)).
-  insertiere programm:
-     TEXT VAR t := "insert (""" + datname + """)"; do (t).
-  abkoppeln:
-    forget (datname, quiet); last param (letzter);
-    reset dialog;
-    global manager.
-END PROC direktstart;
-END PACKET ls dialog 5;
-
-
diff --git a/dialog/ls-DIALOG 6 b/dialog/ls-DIALOG 6
deleted file mode 100644
index 7d28f7f..0000000
--- a/dialog/ls-DIALOG 6
+++ /dev/null
@@ -1,1186 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 6                     ** 
-          **                 Archiv-/Taskhandling                ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET  ls dialog 6  DEFINES
-       menu archiv notizort setzen,
-       menu archiv grundeinstellung,
-       menu archiv zieltask einstellen,
-       menu archiv zieltask aendern,
-       menu archiv reservieren,
-       menu archiv neue diskette,
-       menu archiv schreiben,
-       menu archiv checken,
-       menu archiv schreibcheck,
-       menu archiv holen,
-       menu archiv loeschen,
-       menu archiv verzeichnis,
-       menu archiv verzeichnis drucken,
-       menu archiv initialisieren,
-
-       menu archiv reservierung aufgeben,
-       archiv:
-LET menukartenname  =  "ls-MENUKARTE:Archiv";
-LET ack             =   0,
-    schreiben       =   1,
-    checken         =   2,
-    schreibcheck    =   3,
-    holen           =   4,
-    loeschen        =   5,
-    list code       =  15,
-    reserve code    =  19;
-BOOL VAR zieltask ist archivmanager   :: TRUE,
-         archiv gehoert mir           :: FALSE,
-         fehlerfall                   :: FALSE,
-         kontakt mit zieltask erfolgt :: FALSE;
-
-TEXT VAR zieltaskname                 :: "ARCHIVE",
-         aktueller archivname         :: "";
-INT VAR stationsnummer                :: station (myself),
-        letzte funktion               :: 11,
-        notizort                      :: 3;
-PROC archiv:
-  install menu (menukartenname, FALSE);
-  handle  menu ("ARCHIV")
-END PROC archiv;
-PROC melde zieltaskerror (TEXT CONST meldung):
-  IF   meldung = menubasistext (47)
-       THEN menuinfo (menubasistext (123))
-  ELIF meldung = menubasistext (46)
-
-       THEN menuinfo (menubasistext (124))
-  ELIF pos (meldung, "inkonsistent") > 0
-       THEN menuinfo (menubasistext (125))
-  ELIF     pos (meldung, "Lesen unmoeglich") > 0
-       COR pos (meldung, "Schreiben unmoeglich") > 0
-       THEN menuinfo (menubasistext (126))
-  ELIF pos (meldung, "Archiv heisst") > 0 AND pos (meldung, "?????") > 0
-       THEN menuinfo (menubasistext (127))
-  ELIF pos (meldung, "Archiv heisst") > 0
-       THEN menuinfo (menubasistext (128))
-  ELIF pos (meldung, "Schreibfehler") > 0 CAND pos (meldung, "Archiv") > 0
-
-       THEN menuinfo (menubasistext (129))
-  ELIF pos (meldung, "Lesefehler") > 0
-       THEN menuinfo (menubasistext (130))
-  ELIF pos (meldung, "Kommando") > 0 AND pos (meldung, "unbekannt") > 0
-       THEN menuinfo (menubasistext (131))
-  ELIF pos (meldung, "falscher Auftrag fuer Task") > 0
-       THEN menuinfo (menubasistext (132))
-  ELIF meldung = menubasistext (41)
-       THEN menuinfo (menubasistext (133))
-  ELIF meldung = menubasistext (42)
-       THEN menuinfo (menubasistext (134))
-
-  ELIF pos (meldung, "Collector") > 0 AND pos(meldung, "fehlt") > 0
-       THEN menuinfo (menubasistext (135))
-  ELIF pos (meldung, "kein Zugriffsrecht auf Task") > 0
-       THEN menuinfo (menubasistext (132))
-  ELIF pos (meldung, "nicht initialisiert") > 0
-       THEN menuinfo (menubasistext (136))
-  ELIF pos (meldung, "ungueltiger Format-Code") > 0
-       THEN menuinfo (menubasistext (137))
-  ELSE menuinfo (invers (meldung))
-  FI
-END PROC melde zieltaskerror;
-PROC menu archiv notizort setzen (INT CONST wert):
-
-   SELECT wert OF
-     CASE 1,2,3,4,5 : notizort := wert
-     OTHERWISE        notizort := 3
-   END SELECT
-END PROC menu archiv notizort setzen;
-PROC menu archiv grundeinstellung (INT CONST ort):
-  menu archiv zieltask aendern ("ARCHIVE", station (myself), TRUE);
-  menu archiv notizort setzen (ort);
-  zieltask anzeigen
-END PROC menu archiv grundeinstellung;
-PROC menu archiv zieltask einstellen:
-  TEXT VAR taskname :: "";
-  INT  VAR stationsnr, auswahl;
-  BOOL VAR ist amanager;
-  erfrage daten;
-
-  kontrolliere daten;
-  menu archiv zieltask aendern (taskname, stationsnr, ist amanager);
-  refresh submenu;
-  zieltask anzeigen.
-  erfrage daten:
-    auswahl := menualternative (menubasistext (51), menubasistext (52),
-                                menubasistext (53), 5, TRUE);
-    SELECT auswahl OF
-      CASE 1, 101 : menu archiv zieltask aendern
-                    ("ARCHIVE",     station (myself), TRUE );
-                    ausstieg
-      CASE 2, 102 : menu archiv zieltask aendern
-
-                    (name (father), station (myself), FALSE);
-                    ausstieg
-      CASE 3, 103 : menu archiv zieltask aendern
-                    ("PUBLIC",      station (myself), FALSE);
-                    ausstieg
-      CASE 4, 104 : handeinstellung
-      OTHERWISE ausstieg
-    END SELECT.
-  ausstieg:
-    refresh submenu;
-    zieltask anzeigen;
-    LEAVE menu archiv zieltask einstellen.
-  handeinstellung:
-    taskname     := menuanswer (menubasistext (81), zieltaskname, 5);
-
-    stationsnr   := int (menuanswer (menubasistext (82),
-                         text (station (myself)), 5));
-    ist amanager := menuyes (menubasistext (83), 5).
-  kontrolliere daten:
-    IF   compress (taskname) = ""
-      OR compress (taskname) = "-"
-      OR taskname = name (myself)
-       THEN menuinfo (menubasistext (64));
-            LEAVE menu archiv zieltask einstellen
-    FI.
-END PROC menu archiv zieltask einstellen;
-PROC menu archiv zieltask aendern (TEXT CONST taskname,
-
-                                   INT  CONST stationsnr,
-                                   BOOL CONST ist archivmanager):
-  menufootnote (menubasistext (21) + menubasistext (23));
-  gib ggf archiv frei;
-  IF ist archivmanager
-     THEN archivmanager einstellen
-     ELSE sonstige task einstellen
-  FI;
-  aktiviere gueltige archivmenupunkte.
-  gib ggf archiv frei:
-    IF archiv gehoert mir
-       THEN archivreservierung aufgeben
-    FI.
-  archivmanager einstellen:
-    zieltask ist archivmanager   := TRUE;
-
-    zieltaskname                 := taskname;
-    stationsnummer               := stationsnr;
-    kontakt mit zieltask erfolgt := FALSE;
-    aktueller archivname         := "";
-    archiv gehoert mir           := FALSE;
-    letzte funktion              := 11.
-  sonstige task einstellen:
-    zieltask ist archivmanager := FALSE;
-    zieltaskname               := taskname;
-    stationsnummer             := stationsnr;
-    aktueller archivname       := "";
-    archiv gehoert mir         := FALSE;
-
-    letzte funktion            := 6.
-END PROC menu archiv zieltask aendern;
-PROC menu archiv reservieren:
-  TEXT VAR archivname :: "", meldung :: "";
-  kontrolliere einstellung;
-  menufootnote (menubasistext (21) + menubasistext (24));
-  versuche archiv zu reservieren (meldung);
-  werte meldung aus;
-  archiv anmelden (archivname, meldung, TRUE);
-  IF archivname = ""
-     THEN behandle archivfehler
-     ELSE aktueller archivname := archivname
-  FI;
-  aktiviere gueltige archivmenupunkte;
-
-  refresh submenu;
-  zieltask anzeigen.
-  kontrolliere einstellung:
-    IF   NOT zieltask ist archivmanager
-         THEN aktiviere gueltige archivmenupunkte;
-              refresh submenu;
-              LEAVE menu archiv reservieren
-    ELIF NOT kontakt mit zieltask erfolgt
-         THEN versuche kontakt herzustellen
-    FI.
-  versuche kontakt herzustellen:
-    TEXT VAR fehler :: "";
-    IF NOT task ist kommunikativ (fehler)
-       THEN melde zieltaskerror (fehler);
-            melde rigoros ab;
-
-            LEAVE menu archiv reservieren
-       ELSE kontakt mit zieltask erfolgt := TRUE
-    FI.
-  werte meldung aus:
-    IF meldung <> ""
-       THEN melde zieltaskerror (meldung);
-            melde rigoros ab;
-            LEAVE menu archiv reservieren
-    FI.
-  behandle archivfehler:
-    melde zieltaskerror (meldung);
-    archivreservierung aufgeben;
-    melde rigoros ab
-END PROC menu archiv reservieren;
-PROC melde rigoros ab:
-  aktueller archivname         := "";
-  archiv gehoert mir           := FALSE;
-
-  kontakt mit zieltask erfolgt := FALSE
-END PROC melde rigoros ab;
-PROC versuche archiv zu reservieren (TEXT VAR fehler):
-  IF NOT kontakt mit zieltask erfolgt
-     THEN fehler := menubasistext (44);
-          archiv gehoert mir := FALSE;
-          LEAVE versuche archiv zu reservieren
-  FI;
-  disable stop;
-  IF eigene station
-     THEN reserve ("beknackter archivename",/zieltaskname )
-     ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname)
-  FI;
-  IF is error
-     THEN fehler := errormessage;
-
-          melde rigoros ab;
-          clear error
-     ELSE archiv gehoert mir := TRUE;
-          fehler             := "";
-  FI;
-  enable stop
-END PROC versuche archiv zu reservieren;
-PROC archiv anmelden (TEXT VAR archivname, fehler, BOOL CONST mit anfrage):
-  ueberpruefe archivbesitz;
-  fuehre archivanmeldung aus.
-  ueberpruefe archivbesitz:
-    IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt
-       THEN fehler := menubasistext (45);
-            melde rigoros ab;
-            LEAVE archiv anmelden
-
-    FI.
-  fuehre archivanmeldung aus:
-    IF mit anfrage
-       THEN frage nach eingelegter diskette und melde an
-       ELSE melde archiv unter richtigem namen an
-    FI.
-  frage nach eingelegter diskette und melde an:
-    IF menuyes (menubasistext (84), 5)
-       THEN menufootnote (menubasistext (21) + menubasistext (25));
-            melde archiv unter richtigem namen an
-       ELSE fehler := menubasistext (46);
-            aktueller archivname := "";
-            LEAVE archiv anmelden
-
-    FI.
-  melde archiv unter richtigem namen an:
-    disable stop;
-    IF eigene station
-       THEN reserve ("beknackter archivename",/zieltaskname);
-            list (/zieltaskname);
-       ELSE reserve ("beknackter archivename", stationsnummer/zieltaskname);
-            list (stationsnummer/zieltaskname)
-    FI;
-    IF is error
-       THEN fehler := errormessage;
-            behandle die fehlermeldung
-       ELSE archivname := "beknackter archivename";
-            fehler     := "";
-            enable stop
-
-   FI.
- behandle die fehlermeldung:
-   IF   subtext (fehler, 1, 14) = menubasistext (61)
-          CAND subtext (fehler, 16, 20) <> menubasistext (62)
-        THEN clear error; enable stop;
-             archivname := subtext (fehler, 16, length (fehler) - 1);
-             melde archiv nun wirklich richtig an;
-             fehler := "";
-             enable stop
-   ELIF subtext (fehler, 1, 14) = menubasistext (61)
-          CAND subtext (fehler, 16, 20) = menubasistext (62)
-        THEN clear error; enable stop;
-
-             archivname := "";
-             fehler     := menubasistext (62)
-   ELSE clear error; enable stop;
-        archivname := ""
-   FI.
-  melde archiv nun wirklich richtig an:
-    IF eigene station
-       THEN reserve (archivname,/zieltaskname);
-       ELSE reserve (archivname, stationsnummer/zieltaskname)
-    FI.
-END PROC archiv anmelden;
-PROC menu archiv neue diskette:
-  ueberpruefe reservierung;
-  melde neue diskette an.
-  ueberpruefe reservierung:
-    IF NOT (archiv gehoert mir AND kontakt mit zieltask erfolgt)
-
-       THEN melde zieltaskerror (menubasistext (47));
-            LEAVE menu archiv neue diskette
-    FI.
-  melde neue diskette an:
-    TEXT VAR archivname :: "", meldung :: "";
-    menufootnote (menubasistext (21) + menubasistext (26));
-    archiv anmelden (archivname, meldung, FALSE);
-    IF archivname = ""
-       THEN behandle archivfehler
-       ELSE aktueller archivname := archivname
-    FI;
-    zieltask anzeigen.
-  behandle archivfehler:
-    melde zieltaskerror (meldung);
-    aktueller archivname := "".
-
-END PROC menu archiv neue diskette;
-PROC menu archiv schreiben:
-  dateioperation  mit zieltask (schreiben);
-  regenerate menuscreen
-END PROC menu archiv schreiben;
-PROC menu archiv checken:
-  dateioperation mit zieltask (checken);
-  regenerate menuscreen
-END PROC menu archiv checken;
-PROC menu archiv schreibcheck:
-  dateioperation mit zieltask (schreibcheck);
-  regenerate menuscreen
-END PROC menu archiv schreibcheck;
-PROC menu archiv holen:
-  dateioperation mit zieltask (holen);
-  regenerate menuscreen
-
-END PROC menu archiv holen;
-PROC menu archiv loeschen:
-  dateioperation mit zieltask (loeschen);
-  regenerate menuscreen
-END PROC menu archiv loeschen;
-PROC dateioperation mit zieltask (INT CONST wahl):
-  ueberpruefe kommunikationsbasis und sinnhaftigkeit;
-  lasse dateien auswaehlen;
-  operiere mit ausgewaehlten dateien.
-  ueberpruefe kommunikationsbasis und sinnhaftigkeit:
-    IF   unzulaessiger zieltaskname
-         THEN LEAVE dateioperation mit zieltask
-    ELIF zieltaskname = name (myself)
-
-         THEN melde zieltaskerror (menubasistext (48));
-              LEAVE dateioperation mit zieltask
-    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
-         THEN melde zieltaskerror (menubasistext (47));
-              LEAVE dateioperation mit zieltask
-    ELIF NOT zieltask ist archivmanager
-         AND (wahl = checken OR wahl = schreibcheck)
-         THEN gib hinweis auf unmoeglich;
-              LEAVE dateioperation mit zieltask
-    ELIF NOT zieltask ist archivmanager
-
-         THEN stelle kontakt mit zieltask her
-    ELIF wahl < schreiben OR wahl > loeschen
-         THEN LEAVE dateioperation mit zieltask
-    FI.
-  stelle kontakt mit zieltask her:
-    TEXT VAR fehler :: "";
-    IF task ist kommunikativ (fehler)
-       THEN kontakt mit zieltask erfolgt := TRUE
-       ELSE melde zieltaskerror (fehler);
-            LEAVE dateioperation mit zieltask
-    FI.
-  gib hinweis auf unmoeglich:
-    menuinfo (menubasistext (121) + taskname + menubasistext (122)).
-
-  taskname:
-    IF eigene station
-       THEN zieltaskname
-       ELSE text (stationsnummer) + "/" + zieltaskname
-    FI.
-  lasse dateien auswaehlen:
-    THESAURUS VAR angekreuzte;
-    disable stop;
-    IF wahl = schreiben  OR wahl = schreibcheck
-       THEN angekreuzte := menusome (ALL myself, operationshinweis,
-                                     ankreuzhinweis, FALSE)
-       ELSE angekreuzte := menusome (zieltaskthesaurus, operationshinweis,
-                                     ankreuzhinweis, FALSE)
-
-    FI;
-    fehlerbehandlung.
-  zieltaskthesaurus:
-    IF eigene station
-       THEN ALL /zieltaskname
-       ELSE ALL (stationsnummer/zieltaskname)
-    FI.
-  ankreuzhinweis:
-    menubasistext (91) + operationskennzeichnung (wahl) + menubasistext (92).
-  operationshinweis:
-    operationsbezeichnung (wahl) + zieltaskhinweis.
-  operiere mit ausgewaehlten dateien:
-    bereite bildschirm vor;
-    steige ggf bei leerem thesaurus aus;
-    IF wahl = schreiben OR wahl = schreibcheck
-       THEN zuerst loeschen
-
-    FI;
-    IF wahl = schreibcheck
-       THEN fehlerfall := FALSE;
-            dateioperation ausfuehren (angekreuzte, schreiben, FALSE);
-            IF NOT fehlerfall
-               THEN dateioperation ausfuehren (angekreuzte, checken, TRUE)
-            FI
-       ELSE dateioperation ausfuehren (angekreuzte, wahl, TRUE)
-    FI.
-  bereite bildschirm vor:
-    show menuwindow.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (angekreuzte)
-       THEN menuwindowline (2);
-            menuwindowout (menubasistext (94));
-
-            menuwindowstop;
-            LEAVE dateioperation mit zieltask
-    FI.
-  zuerst loeschen:
-    menuwindowout (menuwindowcenter (menubasistext (21) + menubasistext (31)));
-    menuwindowline;
-    IF not empty (angekreuzte)
-       THEN disable stop;
-            THESAURUS CONST zu loeschende ::
-                            angekreuzte / zieltaskthesaurus;
-            fehlerbehandlung;
-            biete ggf dateien zum loeschen an
-       ELSE menuwindowpage
-    FI.
-  biete ggf dateien zum loeschen an:
-
-    IF not empty (zu loeschende)
-       THEN menuwindowout (menuwindowcenter (invers (menubasistext (108))));
-            menuwindowline;
-            menuwindowout (menuwindowcenter (menubasistext (109)));
-            menuwindowline (2);
-            dateien rausschmeissen
-       ELSE menuwindowpage
-    FI.
-  dateien rausschmeissen:
-    command dialogue (FALSE);
-    biete dateien einzeln zum loeschen an;
-    menuwindowpage;
-    command dialogue (TRUE).
-  biete dateien einzeln zum loeschen an:
-
-    INT VAR z, index;
-    FOR z FROM 1 UPTO highest entry (zu loeschende) REP
-      disable stop;
-      IF name (zu loeschende, z) <> ""
-         THEN stelle frage und fuehre aus
-      FI;
-      fehlerbehandlung
-    PER.
-  stelle frage und fuehre aus:
-    IF menuwindowyes ("'" + name (zu loeschende, z) + "' "
-                          + menubasistext (111))
-       THEN erase (name (zu loeschende, z), task (zieltaskname))
-       ELSE menuwindowout (menubasistext (110));
-            menuwindowline;
-
-            delete (angekreuzte, name (zu loeschende, z), index);
-            pause (20)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            melde zieltaskerror (errormessage);
-            clear error; enable stop;
-            LEAVE dateioperation mit zieltask
-    FI.
-END PROC dateioperation mit zieltask;
-PROC dateioperation ausfuehren (THESAURUS CONST angekreuzte,
-                                INT CONST wahl,
-                                BOOL CONST mit schlussbemerkung):
-
-  INT VAR spalte :: 1, zeile :: 3, k, anzahl :: 0;
-  menuwindowout (menuwindowcenter (invers (operationsbezeichnung (wahl)
-                                        + zieltaskhinweis)));
-  command dialogue (FALSE);
-  fuehre einzelne operationen aus;
-  command dialogue (TRUE);
-  IF mit schlussbemerkung
-     THEN schreibe schlussbemerkung
-     ELSE menuwindowpage
-  FI.
-  fuehre einzelne operationen aus:
-    FOR k FROM 1 UPTO highest entry (angekreuzte) REP
-      IF name (angekreuzte, k) <> ""
-
-         THEN disable stop;
-              bildschirmausgabe;
-              operation ausfuehren;
-              anzahl INCR 1;
-              fehlerbehandlung
-      FI
-    PER.
-  bildschirmausgabe:
-    spalte := 1;
-    IF remaining menuwindowlines < 2
-       THEN menuwindowpage; zeile := 1
-       ELSE zeile INCR 1
-    FI;
-    menuwindowcursor (spalte, zeile);
-    ergaenzter dateiname.
-  ergaenzter dateiname:
-    INT VAR windowcolumn, windowrow;
-    SELECT wahl OF
-      CASE schreiben : menuwindowout (menubasistext (105) + dateiname)
-
-      CASE checken   : get menuwindowcursor (windowcolumn, windowrow);
-                       menuwindowout (dateiname + menubasistext (106));
-                       menuwindowcursor (windowcolumn, windowrow);
-      CASE holen     : menuwindowout (menubasistext (107) + dateiname)
-    END SELECT.
-  dateiname:
-    " """ + name (angekreuzte, k) + """ ".
-  operation ausfuehren:
-    IF eigene station
-       THEN fuehre eigenstationoperation aus
-       ELSE fuehre fremdstationoperation aus
-    FI.
-
-  fuehre eigenstationoperation aus:
-    SELECT wahl OF
-      CASE schreiben : save  (name (angekreuzte, k), /zieltaskname)
-      CASE checken   : check (name (angekreuzte, k), /zieltaskname);
-                       bestaetige
-      CASE holen     : ueberschreiben erfragen eigene station
-      CASE loeschen  : loeschen erfragen eigene station
-    END SELECT.
-  ueberschreiben erfragen eigene station:
-    IF exists (name (angekreuzte, k))
-       THEN menuwindowline;
-            IF menuwindowyes (dateiname + menubasistext (112))
-
-               THEN zeile INCR 2;
-                    menuwindowline;
-                    forget (name (angekreuzte, k), quiet);
-                    fetch  (name (angekreuzte, k), /zieltaskname)
-            FI
-       ELSE fetch (name (angekreuzte, k), /zieltaskname)
-    FI.
-  loeschen erfragen eigene station:
-    IF menuwindowyes (dateiname + menubasistext (111))
-       THEN erase (name (angekreuzte, k), /zieltaskname)
-    FI.
-  fuehre fremdstationoperation aus:
-    SELECT wahl OF
-      CASE schreiben : save  (name (angekreuzte, k), ziel)
-
-      CASE checken   : check (name (angekreuzte, k), ziel); bestaetige
-      CASE holen     : ueberschreiben erfragen fremde station
-      CASE loeschen  : loeschen erfragen fremde station
-    END SELECT.
-  ueberschreiben erfragen fremde station:
-    IF exists (name (angekreuzte, k))
-       THEN menuwindowline;
-            IF menuwindowyes (dateiname + menubasistext (112))
-               THEN zeile INCR 2;
-                    menuwindowline;
-                    forget (name (angekreuzte, k), quiet);
-
-                    fetch  (name (angekreuzte, k), ziel)
-            FI
-       ELSE fetch (name (angekreuzte, k), ziel)
-    FI.
-  loeschen erfragen fremde station:
-    IF menuwindowyes (dateiname + menubasistext (111))
-       THEN erase (name (angekreuzte, k), ziel)
-    FI.
-  ziel:
-    stationsnummer/zieltaskname.
-  bestaetige:
-    IF NOT is error
-       THEN menuwindowout (dateiname + menubasistext (114))
-    FI.
-  schreibe schlussbemerkung:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-
-       ELSE menuwindowline (2)
-    FI;
-    IF anzahl > 0
-       THEN menuwindowout (menubasistext (93) +
-                           operationskennzeichnung (wahl))
-       ELSE menuwindowout (menubasistext (94))
-    FI;
-    menuwindowstop.
-  fehlerbehandlung:
-    IF is error
-       THEN fehlerfall := TRUE;
-            regenerate menuscreen;
-            melde zieltaskerror (errormessage);
-            clear error; enable stop;
-            LEAVE dateioperation ausfuehren
-    FI.
-END PROC dateioperation ausfuehren;
-
-TEXT PROC operationsbezeichnung (INT CONST nr):
-  SELECT nr OF
-    CASE schreiben    : menubasistext (95)
-    CASE checken      : menubasistext (97)
-    CASE schreibcheck : menubasistext (99)
-    CASE holen        : menubasistext (101)
-    CASE loeschen     : menubasistext (103)
-    OTHERWISE ""
-  END SELECT
-END PROC operationsbezeichnung;
-TEXT PROC operationskennzeichnung (INT CONST nr):
-  SELECT nr OF
-    CASE schreiben    : menubasistext (96)
-    CASE checken      : menubasistext (98)
-
-    CASE schreibcheck : menubasistext (100)
-    CASE holen        : menubasistext (102)
-    CASE loeschen     : menubasistext (104)
-    OTHERWISE ""
-  END SELECT
-END PROC operationskennzeichnung;
-BOOL PROC not empty (THESAURUS CONST t):
-  INT VAR i;
-  FOR i FROM 1 UPTO highest entry (t) REP
-    IF name (t, i) <> ""
-       THEN LEAVE not empty WITH TRUE
-    FI
-  PER;
-  FALSE
-END PROC not empty;
-TEXT PROC zieltaskhinweis:
-  IF   zieltaskname = "ARCHIVE"
-       THEN "(" + menubasistext (78) + ")"
-
-  ELIF zieltaskname = name (father)
-       THEN "(" + menubasistext (79) + ")"
-  ELSE menubasistext (80) + zieltaskname + ")"
-  FI
-END PROC zieltaskhinweis;
-PROC menu archiv verzeichnis:
-  forget("Interne Dateiliste bei Archivoperation", quiet);
-  ueberpruefe kommunikationsbasis;
-  liste dateien der zieltask auf;
-  regenerate menuscreen.
-  ueberpruefe kommunikationsbasis:
-    IF   unzulaessiger zieltaskname
-         THEN LEAVE menu archiv verzeichnis
-    ELIF zieltaskname = name (myself)
-
-         THEN LEAVE ueberpruefe kommunikationsbasis
-    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
-         THEN melde zieltaskerror (menubasistext (47));
-             LEAVE menu archiv verzeichnis
-    ELIF NOT zieltask ist archivmanager
-         THEN stelle kontakt mit zieltask her
-    FI.
-  stelle kontakt mit zieltask her:
-    TEXT VAR fehler :: "";
-    IF task ist kommunikativ (fehler)
-       THEN kontakt mit zieltask erfolgt := TRUE
-       ELSE melde zieltaskerror (fehler);
-
-            LEAVE menu archiv verzeichnis
-    FI.
-  liste dateien der zieltask auf:
-    erstelle liste;
-    gib liste aus;
-    forget ("Interne Dateiliste bei Archivoperation", quiet).
-  erstelle liste:
-    menufootnote (menubasistext (21) + menubasistext (28));
-    FILE VAR f :: sequential file (output, "Interne Dateiliste bei Archivoperation");
-    disable stop;
-    IF eigene station
-       THEN list (f, /zieltaskname)
-       ELSE list (f, stationsnummer/zieltaskname)
-    FI;
-    IF is error
-
-       THEN melde zieltaskerror (errormessage);
-            forget ("Interne Dateiliste bei Archivoperation", quiet);
-            clear error; enable stop;
-            LEAVE menu archiv verzeichnis
-    FI;
-    enable stop.
-  gib liste aus:
-    modify (f);
-    IF NOT (zieltaskname = name (myself))
-       THEN to line (f, 1);
-            insert record (f);
-            notiere kopfzeile;
-            headline (f, menubasistext (43));
-       ELSE entferne eigenen namen aus der liste
-    FI;
-
-    to line (f, 1);
-    cursor on; menuwindowshow (f); cursor off.
-  notiere kopfzeile:
-    IF zieltask ist archivmanager
-       THEN write record (f, headline (f));
-       ELSE write record (f, zieltaskbezeichnung)
-    FI.
-  entferne eigenen namen aus der liste:
-    TEXT VAR zeile :: ""; INT VAR i;
-    FOR i FROM lines (f) DOWNTO 1 REP
-      to line (f, i);
-      read record (f, zeile);
-      IF pos (zeile, "Interne Dateiliste bei Archivoperation") > 0
-         THEN delete record (f);
-
-              LEAVE entferne eigenen namen aus der liste
-      FI
-    PER
-END PROC menu archiv verzeichnis;
-PROC menu archiv verzeichnis drucken:
-  forget ("Interne Dateiliste bei Archivoperation", quiet);
-  ueberpruefe kommunikationsbasis;
-  erstelle listing;
-  drucke listing aus.
-  ueberpruefe kommunikationsbasis:
-    IF   unzulaessiger zieltaskname
-         THEN LEAVE menu archiv verzeichnis drucken
-    ELIF zieltaskname = name (myself)
-         THEN LEAVE ueberpruefe kommunikationsbasis
-
-    ELIF zieltask ist archivmanager AND NOT archiv gehoert mir
-         THEN melde zieltaskerror (menubasistext (47));
-             LEAVE menu archiv verzeichnis drucken
-    ELIF NOT zieltask ist archivmanager
-         THEN stelle kontakt mit zieltask her
-    FI.
-  stelle kontakt mit zieltask her:
-    TEXT VAR fehler :: "";
-    IF task ist kommunikativ (fehler)
-       THEN kontakt mit zieltask erfolgt := TRUE
-       ELSE melde zieltaskerror (fehler);
-            LEAVE menu archiv verzeichnis drucken
-
-    FI.
-  erstelle listing:
-    LET dummy name pos = 18;
-    FILE VAR listfile; INT VAR i; TEXT VAR record :: "";
-    TEXT CONST head :: 70 * "=", end :: 70 * "-";
-    IF menuno (menubasistext (90), 5)
-       THEN LEAVE menu archiv verzeichnis drucken
-    FI;
-    menufootnote (menubasistext (21) + menubasistext (29));
-    disable stop;
-    listfile := sequential file (output, "Interne Dateiliste bei Archivoperation");
-    IF eigene station
-       THEN list (listfile, /zieltaskname)
-       ELSE list (listfile, stationsnummer/zieltaskname)
-
-    FI;
-    IF is error
-       THEN melde zieltaskerror (errormessage);
-            forget ("Interne Dateiliste bei Archivoperation", quiet);
-            clear error; enable stop;
-            LEAVE menu archiv verzeichnis drucken
-    FI;
-    enable stop.
-  drucke listing aus:
-    schreibe dateikopf;
-    loesche dummy names;
-    schreibe fuss;
-    drucke und loesche listing.
-  schreibe dateikopf:
-    modify (listfile);
-    to line (listfile, 1);
-    FOR i FROM 1 UPTO 6 REP insert record (listfile) PER;
-
-    to line (listfile, 1);
-    write record (listfile, "#type (""elanlist"")#"); down (listfile);
-    write record (listfile, "#start (2.5,0.0)##limit (20,5)#"
-                            + "#pagelength (26.0)#"); down (listfile);
-    write record (listfile, head); down (listfile);
-    schreibe erkennungszeile; down (listfile);
-    write record (listfile, "        Listing vom " + date + ",  "
-                            + time of day + " Uhr"); down (listfile);
-    write record (listfile, head).
-
-  schreibe erkennungszeile:
-    IF zieltask ist archivmanager
-       THEN write record (listfile, "Archiv: " + headline (listfile))
-       ELSE write record (listfile, "Task  : " + taskbezeichnung)
-    FI.
-  taskbezeichnung:
-    IF eigene station
-       THEN zieltaskname
-       ELSE text (stationsnummer) + "/" + zieltaskname
-    FI.
-  loesche dummy names:
-    to line (listfile, 8);
-    WHILE NOT eof (listfile) REP
-      read record (listfile, record);
-      IF (record SUB dummy name pos) = "-"
-
-         OR pos (record, "Interne Dateiliste bei Archivoperation") > 0
-         THEN delete record (listfile)
-         ELSE down (listfile)
-      FI
-    PER.
-  schreibe fuss:
-    output (listfile);
-    putline (listfile, end).
-  drucke und loesche listing:
-    menufootnote (menubasistext (21) + menubasistext (30));
-    disable stop;
-    print ("Interne Dateiliste bei Archivoperation");
-    IF is error
-       THEN melde zieltaskerror (errormessage);
-            clear error; enable stop;
-
-            forget ("Interne Dateiliste bei Archivoperation", quiet);
-            LEAVE menu archiv verzeichnis drucken
-    FI;
-    enable stop;
-    forget ("Interne Dateiliste bei Archivoperation", quiet)
-END PROC menu archiv verzeichnis drucken;
-TEXT PROC zieltaskbezeichnung:
-  IF eigene station
-     THEN menubasistext (77) + taskbezeichnung
-     ELSE menubasistext (76) + text (stationsnummer) + "   " +
-          menubasistext (77) + zieltaskname
-  FI.
-  taskbezeichnung:
-    IF   zieltaskname = "ARCHIVE"
-
-         THEN menubasistext (78)
-    ELIF zieltaskname = name (father)
-         THEN menubasistext (79) + " (" + zieltaskname + ")"
-         ELSE zieltaskname
-    FI
-END PROC zieltaskbezeichnung;
-BOOL PROC unzulaessiger zieltaskname:
-  IF compress (zieltaskname) = "" OR compress (zieltaskname) = "-"
-     THEN TRUE
-     ELSE FALSE
-  FI
-END PROC unzulaessiger zieltaskname;
-PROC menu archiv initialisieren:
-  TEXT VAR archivname :: "", meldung :: "";
-  klaere zieltaskart;
-  formatiere ggf;
-
-  initialisiere ggf.
-  klaere zieltaskart:
-    IF NOT zieltask ist archivmanager
-       THEN menuinfo (menubasistext (121) + zieltaskname +
-                      menubasistext (122));
-            LEAVE menu archiv initialisieren
-    FI.
-  formatiere ggf:
-    IF menuyes (menubasistext (85), 5)
-       THEN nimm archiv in beschlag;
-            fuehre formatierung aus
-    FI.
-  nimm archiv in beschlag:
-    stelle archivbesitz sicher;
-    IF aktueller archivname <> ""
-       THEN archivname := aktueller archivname
-
-       ELSE archivname := menubasistext (75)
-    FI;
-    IF eigene station
-       THEN reserve (archivname,/zieltaskname)
-       ELSE reserve (archivname, stationsnummer/zieltaskname)
-    FI;
-    aktueller archivname := archivname;
-    archiv gehoert mir   := TRUE;
-    zieltask anzeigen.
-  stelle archivbesitz sicher:
-    IF NOT archiv gehoert mir OR NOT kontakt mit zieltask erfolgt
-           THEN versuche kommunikation;
-                versuche archiv zu reservieren (meldung);
-                werte meldung aus
-
-    FI.
-  versuche kommunikation:
-    TEXT VAR fehler :: "";
-    IF NOT task ist kommunikativ (fehler)
-       THEN melde zieltaskerror (fehler);
-            melde rigoros ab;
-            LEAVE menu archiv initialisieren
-       ELSE kontakt mit zieltask erfolgt := TRUE
-    FI.
-  werte meldung aus:
-    IF meldung <> ""
-       THEN melde zieltaskerror (meldung);
-            aktueller archivname := "";
-            zieltask anzeigen;
-            LEAVE menu archiv initialisieren
-    FI.
-
-  fuehre formatierung aus:
-    INT VAR auswahl :: menualternative (menubasistext (54),
-                                        menubasistext (55),
-                                        menubasistext (56), 5, TRUE);
-    IF auswahl = 0
-       THEN LEAVE fuehre formatierung aus
-    FI;
-    IF auswahl > 100
-       THEN auswahl DECR 100
-    FI;
-    command dialogue (FALSE);
-    disable stop;
-    menufootnote (menubasistext (21) + menubasistext (27));
-    IF eigene station
-       THEN formatiere auf eigener station
-
-       ELSE formatiere auf fremder station
-    FI;
-    IF is error
-       THEN melde zieltaskerror (errormessage);
-            clear error; enable stop;
-            command dialogue (TRUE);
-            LEAVE formatiere ggf
-       ELSE enable stop;
-            command dialogue (TRUE);
-            aktiviere gueltige archivmenupunkte;
-            refresh submenu;
-            zieltask anzeigen
-    FI.
-  formatiere auf eigener station:
-    IF auswahl < 5
-       THEN format (auswahl, /zieltaskname)
-
-       ELSE format (/zieltaskname)
-    FI.
-  formatiere auf fremder station:
-     IF auswahl < 5
-       THEN format (auswahl, stationsnummer/zieltaskname)
-       ELSE format (stationsnummer/zieltaskname)
-    FI.
-  initialisiere ggf:
-    stelle archivbesitz sicher;
-    archiv anmelden (archivname, meldung, FALSE);
-    IF   archivname <> ""
-         THEN aktueller archivname := archivname;
-              archiv gehoert mir   := TRUE;
-              aktiviere gueltige archivmenupunkte;
-              refresh submenu;
-
-              zieltask anzeigen;
-              frage nach ueberschreiben
-    ELIF meldung = menubasistext (63) OR meldung = menubasistext (62)
-         THEN frage nach initialisieren
-    ELSE melde zieltaskerror (meldung);
-         aktueller archivname := "";
-         zieltask anzeigen;
-         LEAVE menu archiv initialisieren
-    FI.
-  frage nach ueberschreiben:
-    IF menuyes (menubasistext (86) + archivname + menubasistext (87), 5)
-       THEN erfrage neuen namen und initialisiere
-
-       ELSE LEAVE menu archiv initialisieren
-    FI.
-  frage nach initialisieren:
-    IF menuyes (menubasistext (88), 5)
-       THEN erfrage neuen namen und initialisiere
-       ELSE LEAVE menu archiv initialisieren
-    FI.
-  erfrage neuen namen und initialisiere:
-    TEXT VAR neuer name := compress(menuanswer (menubasistext (89),
-                                                aktueller archivname, 5));
-    IF   neuer name <> ""
-         THEN archivname := neuer name
-    ELIF neuer name = "" AND archivname = ""
-
-         THEN archivname := menubasistext (75)
-    FI;
-    command dialogue (FALSE);
-    disable stop;
-    IF eigene station
-       THEN reserve (archivname, /zieltaskname);
-            clear (/zieltaskname)
-       ELSE reserve (archivname, stationsnummer/zieltaskname);
-            clear (stationsnummer/zieltaskname)
-    FI;
-    IF is error
-       THEN melde zieltaskerror (errormessage);
-            clear error; enable stop;
-            command dialogue (TRUE);
-            melde rigoros ab;
-
-            archivreservierung aufgeben;
-            aktiviere gueltige archivmenupunkte;
-            refresh submenu;
-            zieltask anzeigen;
-            LEAVE menu archiv initialisieren
-       ELSE enable stop; command dialogue (TRUE);
-            aktueller archivname := archivname;
-            archiv gehoert mir   := TRUE;
-            aktiviere gueltige archivmenupunkte;
-            refresh submenu;
-            zieltask anzeigen
-    FI
-END PROC menu archiv initialisieren;
-PROC archive (TEXT CONST archive name,task, INT CONST station):
-
-  call (reserve code, archive name, station/task)
-END PROC archive;
-PROC menu archiv reservierung aufgeben:
-  IF archiv gehoert mir
-     THEN menufootnote (menubasistext (21) + menubasistext (22));
-          archivreservierung aufgeben;
-  FI;
-  erase menunotice;
-  old menufootnote
-END PROC menu archiv reservierung aufgeben;
-PROC archivreservierung aufgeben:
-  command dialogue (FALSE);
-  disable stop;
-  IF eigene station
-     THEN release (/zieltaskname)
-     ELSE release (stationsnummer/zieltaskname);
-
-  FI;
-  IF is error
-     THEN clear error
-  FI;
-  enable stop;
-  command dialogue (TRUE);
-  archiv gehoert mir   := FALSE;
-  aktueller archivname := ""
-END PROC archivreservierung aufgeben;
-BOOL PROC eigene station:
-  IF stationsnummer = 0 OR stationsnummer = station (myself)
-     THEN TRUE
-     ELSE FALSE
-  FI
-END PROC eigene station;
-PROC aktiviere gueltige archivmenupunkte:
-  IF   zieltask ist archivmanager AND NOT archiv gehoert mir
-       THEN aktiviere nur grundfunktionen
-
-  ELSE aktiviere alle momentan gueltigen punkte
-  FI.
-  aktiviere alle momentan gueltigen punkte:
-    IF letzte funktion = 11
-       THEN activate (1); activate (2);
-            activate (4); activate (5); activate (6); activate (7); activate (8);
-            activate (10); activate (11);
-            activate (13); activate (14);
-    ELIF letzte funktion = 6
-       THEN deactivate (1); deactivate (2);
-            activate (4); deactivate (5); deactivate (6); activate (7); activate (8);
-
-            activate (10); activate (11);
-            deactivate (13); activate (14);
-    FI.
-  aktiviere nur grundfunktionen:
-     activate (1); deactivate (2);
-     deactivate (4); deactivate (5); deactivate (6); deactivate (7); deactivate (8);
-     deactivate (10); deactivate (11);
-     activate (13); activate (14).
-END PROC aktiviere gueltige archivmenupunkte;
-PROC zieltask anzeigen:
-  IF zieltask ist archivmanager
-     THEN schreibe taskname und archivname
-     ELSE schreibe taskname
-
-  FI.
-  schreibe taskname:
-    write menunotice (menubasistext (59) + ""13"" + name der task, notizort).
-  schreibe taskname und archivname:
-    write menunotice (menubasistext (59) + ""13"" + name der task +
-                      ""13"" + menubasistext (60) + ""13"" + archivname,
-                      notizort).
-  name der task:
-    IF   zieltaskname = "ARCHIVE" AND eigene station
-         THEN " " + menubasistext (71)
-    ELIF zieltaskname = "PUBLIC"  AND eigene station
-         THEN " " + menubasistext (72)
-
-    ELIF zieltaskname = name (father)
-         THEN " " + menubasistext (73)
-    ELSE " " + ggf gekuerzter zieltaskname
-    FI.
-  ggf gekuerzter zieltaskname:
-    TEXT VAR interner name;
-    IF eigene station
-       THEN interner name := zieltaskname;
-       ELSE interner name := text (stationsnummer) + "/" + zieltaskname
-    FI;
-    IF length (interner name) < 20
-       THEN ""15"" + interner name + " "14""
-       ELSE ""15"" + subtext (interner name, 1 , 18) + ".." + " "14""
-    FI.
-
-  archivname:
-    IF NOT archiv gehoert mir OR aktueller archivname = ""
-       THEN " " + menubasistext (74)
-       ELSE " "15"" + ggf gekuerzter archivname + " "14""
-    FI.
-  ggf gekuerzter archivname:
-    IF   eigene station AND length (aktueller archivname) > 20
-         THEN subtext (aktueller archivname, 1, 18) + ".."
-    ELIF NOT eigene station AND length (aktueller archivname) > 17
-         THEN subtext (aktueller archivname, 1, 15) + ".."
-    ELSE aktueller archivname
-    FI.
-
-END PROC zieltask anzeigen;
-BOOL PROC task ist kommunikativ (TEXT VAR  fehler):
-  INT VAR antwort;
-  DATASPACE VAR dummy space := nilspace;
-    IF zieltask ist archivmanager
-       THEN schicke reservierungscode
-       ELSE schicke listcode
-    FI.
-  schicke reservierungscode:
-    disable stop;
-    IF eigene station
-       THEN pingpong (/zieltaskname, reserve code, dummy space, antwort);
-       ELSE pingpong (stationsnummer/zieltaskname, reserve code,
-                      dummy space, antwort)
-
-    FI;
-    werte antwort aus.
-  schicke listcode:
-    disable stop;
-    IF eigene station
-       THEN pingpong (/zieltaskname, list code, dummy space, antwort);
-       ELSE pingpong (stationsnummer/zieltaskname, list code,
-                      dummy space, antwort)
-    FI;
-    werte antwort aus.
-  werte antwort aus:
-    IF is error
-       THEN clear error
-    FI;
-    BOUND TEXT VAR inhalt := dummy space;
-    enable stop;
-    IF   antwort  =   0 THEN fehler := ""
-    ELIF antwort  =  -1 THEN fehler := menubasistext (41)
-
-    ELIF antwort  =  -2 THEN fehler := menubasistext (42)
-    ELSE fehler  := inhalt
-    FI;
-    forget (dummy space);
-    IF antwort = ack
-       THEN kontakt mit zieltask erfolgt := TRUE;  TRUE
-       ELSE kontakt mit zieltask erfolgt := FALSE; FALSE
-    FI
-END PROC task ist kommunikativ;
-END PACKET ls dialog 6;
-
-
diff --git a/dialog/ls-DIALOG 7 b/dialog/ls-DIALOG 7
deleted file mode 100644
index bc43410..0000000
--- a/dialog/ls-DIALOG 7
+++ /dev/null
@@ -1,460 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                     ls-DIALOG 7                     ** 
-          **                    Dateihandling                    ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET  ls dialog 7  DEFINES
-        menu dateien verzeichnis,
-        menu dateien loeschen,
-        menu dateien drucken,
-        menu dateien kopieren,
-        menu dateien umbenennen,
-        menu dateien speicherplatz,
-        menu dateien aufraeumen:
-LET filetype  = 1003,
-    maxlaenge =   60,
-    breite    =   40,
-    niltext   =   "";
-TEXT CONST dateibez :: "Dateiliste bei internen Operationen";
-PROC menu dateien verzeichnis:
-  forget (dateibez, quiet);
-  liste dateien auf;
-
-  regenerate menuscreen.
-  liste dateien auf:
-    erstelle liste;
-    gib liste aus;
-    forget (dateibez, quiet).
-  erstelle liste:
-    menufootnote (menubasistext (21) + menubasistext (28));
-    FILE VAR f :: sequential file (output, dateibez);
-    list (f); modify (f);
-    headline (f, menubasistext (43));
-    to line (f, 1); insert record (f);
-    write record (f, menubasistext (161));
-    entferne eigenen namen aus der liste.
-  entferne eigenen namen aus der liste:
-    TEXT VAR zeile :: ""; INT VAR i;
-
-    FOR i FROM lines (f) DOWNTO 1 REP
-      to line (f, i); read record (f, zeile);
-      IF pos (zeile, dateibez) > 0
-         THEN delete record (f);
-              LEAVE entferne eigenen namen aus der liste
-      FI
-    PER.
-  gib liste aus:
-    to line (f, 1); cursor on; menuwindowshow (f); cursor off
-END PROC menu dateien verzeichnis;
-PROC menu dateien loeschen:
-  lasse dateien auswaehlen;
-  loesche ausgewaehlte dateien;
-  regenerate menuscreen.
-  lasse dateien auswaehlen:
-    IF NOT not empty (ALL myself)
-
-       THEN noch keine datei;
-            LEAVE menu dateien loeschen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    THESAURUS VAR angekreuzte :=
-    menuanswersome ( center (breite, invers (menubasistext(162))) +
-                     menubasistext (163), "", ALL myself,
-                     menubasistext (162), menubasistext (91) +
-                     menubasistext (104) + menubasistext (92), FALSE).
-  loesche ausgewaehlte dateien:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-
-    menuwindowout (menuwindowcenter (invers (menubasistext (162))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operation aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (menubasistext (93) + menubasistext (104));
-    menuwindowstop.
-  fuehre einzelne operation aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (angekreuzte) REP
-      IF   name (angekreuzte, k) = niltext
-           THEN LEAVE fuehre einzelne operation aus
-
-      ELIF NOT exists (name (angekreuzte, k))
-           THEN menuwindowout (" """ + name (angekreuzte, k) + """");
-                menuwindowline;
-                menuwindowout (menubasistext (188)); menuwindowline;
-                LEAVE fuehre einzelne operation aus
-      ELSE disable stop;
-           IF menuwindowyes (" """ + name (angekreuzte, k) + """ "
-                                   + menubasistext (111))
-              THEN forget (name (angekreuzte, k), quiet)
-           FI;
-
-           fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (angekreuzte)
-       THEN menuwindowline (2);
-            menuwindowout (menubasistext (94));
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE menu dateien loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-            LEAVE menu dateien loeschen
-    FI
-END PROC menu dateien loeschen;
-PROC menu dateien drucken:
-  lasse programme auswaehlen;
-  drucke programme;
-  regenerate menuscreen.
-  lasse programme auswaehlen:
-    IF NOT not empty (ALL myself)
-       THEN noch keine datei;
-            LEAVE menu dateien drucken
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-
-    THESAURUS VAR angekreuzte :=
-    menuanswersome ( center (breite, invers (menubasistext(164))) +
-                     menubasistext (163), "", ALL myself,
-                     menubasistext (164), menubasistext (91) +
-                     menubasistext (165) + menubasistext (92), FALSE).
-  drucke programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (menubasistext (164))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-
-    fuehre einzelne operation aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (menubasistext (93) + menubasistext (165));
-    menuwindowstop.
-  fuehre einzelne operation aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (angekreuzte) REP
-      IF   name (angekreuzte, k) = niltext
-           THEN LEAVE fuehre einzelne operation aus
-      ELIF NOT exists (name (angekreuzte, k))
-           THEN menuwindowout (" """ + name (angekreuzte, k) + """");
-
-                menuwindowline;
-                menuwindowout (menubasistext (188)); menuwindowline;
-                LEAVE fuehre einzelne operation aus
-      ELSE disable stop;
-           menuwindowout ( " """ + name (angekreuzte, k) + """ "
-                                 + menubasistext (166));
-           menuwindowline;
-           print (name (angekreuzte, k));
-           fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (angekreuzte)
-
-       THEN menuwindowline (2);
-            menuwindowout (menubasistext (94));
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE menu dateien drucken
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-
-            LEAVE menu dateien drucken
-    FI.
-END PROC menu dateien drucken;
-PROC menu dateien kopieren:
-  ermittle alten dateinamen;
-  erfrage neuen dateinamen;
-  kopiere ggf die datei.
-  ermittle alten dateinamen:
-    IF NOT not empty (ALL myself)
-       THEN noch keine datei;
-            LEAVE menu dateien kopieren
-       ELSE hole den namen
-    FI.
-  hole den namen:
-    TEXT VAR alter name :=
-    menuanswerone ( center (breite, invers (menubasistext(167))) +
-                    menubasistext (163), "", ALL myself,
-
-                    menubasistext (167), menubasistext (168) +
-                    menubasistext (169) + menubasistext (170), TRUE);
-    IF   alter name = niltext
-         THEN LEAVE menu dateien kopieren
-    ELIF NOT exists (alter name)
-         THEN menuinfo (menubasistext (188));
-              LEAVE menu dateien kopieren
-    FI.
-  erfrage neuen dateinamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + menubasistext (171) + bisheriger name
-
-                  + menubasistext (172).
-  ueberschrift:
-    center (maxlaenge, invers (menubasistext (167))) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  kopiere ggf die datei:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (menubasistext (173)));
-              LEAVE menu dateien kopieren
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE menu dateien kopieren
-       ELSE copy (alter name, neuer name)
-
-    FI.
-  mache vorwurf:
-    menuinfo (menubasistext (174)).
-END PROC menu dateien kopieren;
-PROC menu dateien umbenennen:
-  ermittle alten dateinamen;
-  erfrage neuen dateinamen;
-  benenne ggf die datei um.
-  ermittle alten dateinamen:
-    IF NOT not empty (ALL myself)
-       THEN noch keine datei;
-            LEAVE menu dateien umbenennen
-       ELSE hole den namen
-    FI.
-  hole den namen:
-    TEXT VAR alter name :=
-    menuanswerone ( center (breite, invers (menubasistext(175))) +
-
-                    menubasistext (163), "", ALL myself,
-                    menubasistext (175), menubasistext (168) +
-                    menubasistext (176) + menubasistext (170), TRUE);
-    IF   alter name = niltext
-         THEN LEAVE menu dateien umbenennen
-    ELIF NOT exists (alter name)
-         THEN menuinfo (menubasistext (188));
-              LEAVE menu dateien umbenennen
-    FI.
-  erfrage neuen dateinamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-
-     ueberschrift + menubasistext (171) + bisheriger name
-                  + menubasistext (177).
-  ueberschrift:
-    center (maxlaenge, invers (menubasistext (175))) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  benenne ggf die datei um:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (menubasistext (173)));
-              LEAVE menu dateien umbenennen
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE menu dateien umbenennen
-
-       ELSE rename (alter name, neuer name)
-    FI.
-  mache vorwurf:
-    menuinfo (menubasistext (174)).
-END PROC menu dateien umbenennen;
-PROC menu dateien speicherplatz:
-  lasse dateinamen auswaehlen;
-  ermittle den speicherplatz;
-  regenerate menuscreen.
-  lasse dateinamen auswaehlen:
-    IF NOT not empty (ALL myself)
-       THEN noch keine datei;
-            LEAVE menu dateien speicherplatz
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    THESAURUS VAR angekreuzte :=
-
-    menuanswersome ( center (breite, invers (menubasistext(178))) +
-                     menubasistext (163), "", ALL myself,
-                     menubasistext (178), menubasistext (179), FALSE).
-  ermittle den speicherplatz:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (menubasistext (178))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operation aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-
-    menuwindowout (menubasistext (180));
-    menuwindowstop.
-  fuehre einzelne operation aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (angekreuzte) REP
-      IF   name (angekreuzte, k) = niltext
-           THEN LEAVE fuehre einzelne operation aus
-      ELIF NOT exists (name (angekreuzte, k))
-           THEN menuwindowout (" """ + name (angekreuzte, k) + """");
-                menuwindowline;
-                menuwindowout (menubasistext (188)); menuwindowline;
-                LEAVE fuehre einzelne operation aus
-
-      ELSE disable stop;
-           menuwindowout ( " """ + name (angekreuzte, k) + """ "
-                                 + menubasistext (181)
-                                 + speicherplatz (name (angekreuzte, k)));
-           menuwindowline;
-           fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (angekreuzte)
-       THEN menuwindowline (2);
-            menuwindowout (menubasistext (94));
-            menuwindowstop;
-            regenerate menuscreen;
-
-            LEAVE menu dateien speicherplatz
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-            LEAVE menu dateien speicherplatz
-    FI.
-END PROC menu dateien speicherplatz;
-TEXT PROC speicherplatz (TEXT CONST dateiname):
-
-  DATASPACE VAR ds :: old (dateiname);
-  INT CONST platz    :: storage (ds);
-  forget (ds);
-  " " + text (platz) + menubasistext (182)
-END PROC speicherplatz;
-PROC menu dateien aufraeumen:
-  lasse dateinamen auswaehlen;
-  raeume die dateien auf;
-  regenerate menuscreen.
-  lasse dateinamen auswaehlen:
-    IF NOT not empty (ALL myself)
-       THEN noch keine datei;
-            LEAVE menu dateien aufraeumen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    THESAURUS VAR angekreuzte :=
-
-    menuanswersome ( center (breite, invers (menubasistext(183))) +
-                     menubasistext (163), "", ALL myself,
-                     menubasistext (183), menubasistext (91) +
-                     menubasistext (184) + menubasistext (92), FALSE).
-  raeume die dateien auf:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (menubasistext (183))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operation aus;
-
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (menubasistext (93) + menubasistext (184));
-    menuwindowstop.
-  fuehre einzelne operation aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (angekreuzte) REP
-      IF   name (angekreuzte, k) = niltext
-           THEN LEAVE fuehre einzelne operation aus
-      ELIF NOT exists (name (angekreuzte, k))
-           THEN menuwindowout (" """ + name (angekreuzte, k) + """");
-                menuwindowline;
-                menuwindowout (menubasistext (188)); menuwindowline;
-
-                LEAVE fuehre einzelne operation aus
-      ELIF dateityp ist ok
-           THEN disable stop;
-                menuwindowline;
-                menuwindowout ( " """ + name (angekreuzte, k) + """ "
-                                      + menubasistext (185) );
-                menuwindowline; menuwindowout ("   ");
-                reorganize (name (angekreuzte, k));
-                fehlerbehandlung
-      ELSE menuwindowout ( " """ + name (angekreuzte, k) + """ "
-                                 + menubasistext (186))
-
-      FI
-    PER.
-  dateityp ist ok:
-   type (old (name (angekreuzte, k))) = filetype.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (angekreuzte)
-       THEN menuwindowline (2);
-            menuwindowout (menubasistext (94));
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE menu dateien aufraeumen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-            LEAVE menu dateien aufraeumen
-    FI.
-END PROC menu dateien aufraeumen;
-PROC noch keine datei:
-  menuinfo (menubasistext ( 187))
-END PROC noch keine datei;
-END PACKET ls dialog 7;
-
-
diff --git a/dialog/ls-DIALOG-gen b/dialog/ls-DIALOG-gen
deleted file mode 100644
index b5c7867..0000000
--- a/dialog/ls-DIALOG-gen
+++ /dev/null
@@ -1,130 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                      ls-DIALOG                      ** 
-          **                  GENERATORPROGRAMM                  ** 
-          **                     Version 1.2                     ** 
-          **                                                     ** 
-          **                  (Stand: 04.11.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-LET mm taskname = "ls-MENUKARTEN",
-    datei 1     = "ls-DIALOG 1",
-    datei 2     = "ls-DIALOG 2",
-    datei 3     = "ls-DIALOG 3",
-    datei 4     = "ls-DIALOG 4",
-    datei 5     = "ls-DIALOG 5",
-    datei 6     = "ls-DIALOG 6",
-    datei 7     = "ls-DIALOG 7",
-    menukarte   = "ls-MENUKARTE:Archiv";
-PROC stelle existenz des mm sicher:
-  cursor (1, 5); out (""4"");
-  IF NOT exists (task (mm taskname))
-     THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");
-  FI
-
-END PROC stelle existenz des mm sicher;
-PROC vom archiv (TEXT CONST datei):
-  cursor (1,5); out (""4"");
-  out ("  """); out (datei); putline (""" wird geholt.");
-  fetch (datei, archive)
-END PROC vom archiv;
-PROC hole (TEXT CONST datei):
-  IF NOT exists (datei) THEN vom archiv (datei) FI
-END PROC hole;
-PROC in (TEXT CONST datei):
-  hole (datei);
-  cursor (1, 5); out (""4"");
-  out ("  """); out (datei); out (""" wird übersetzt: ");
-  insert (datei);
-  forget (datei, quiet);
-END PROC in;
-
-PROC schicke (TEXT CONST datei):
-  cursor (1, 5); out (""4"");
-  out ("  """); out(datei);
-  out (""" wird zum MENUKARTEN-MANAGER geschickt!");
-  command dialogue (FALSE);
-  save (datei, task (mm taskname));
-  command dialogue (TRUE);
-  forget (datei, quiet)
-END PROC schicke;
-INT VAR size, used;
-BOOL VAR einzeln;
-storage (size, used);
-einzeln := size - used < 500;
-forget ("ls-DIALOG/gen", quiet);
-wirf kopfzeile aus;
-stelle existenz des mm sicher;
-hole die dateien;
-insertiere die dateien;
-
-mache global manager aus der task.
-wirf kopfzeile aus:
-  page;
-  putline ("                      "15"ls-DIALOG - Automatische Generierung "14"").
-hole die dateien:
-  IF     NOT exists (datei 1) COR NOT exists (datei 2)
-     COR NOT exists (datei 3) COR NOT exists (datei 4)
-     COR NOT exists (datei 5) COR NOT exists (datei 6)
-     COR NOT exists (datei 7) COR NOT exists (menukarte)
-     THEN hole dateien vom archiv
-  FI.
-hole dateien vom archiv:
-  cursor (1,3);
-  IF yes ("Ist das Archiv angemeldet und die 'ls-DIALOG' - Diskette eingelegt")
-
-     THEN lese ein
-     ELSE line (2);
-          errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
-  FI.
-lese ein:
-  cursor (1, 3); out (""4"");
-  out ("                      "15"Bitte die Diskette eingelegt lassen! "14"");
-  IF NOT einzeln
-     THEN hole (datei 1);
-          hole (datei 2);
-          hole (datei 3);
-          hole (datei 4);
-          hole (datei 5);
-          hole (datei 6);
-          hole (datei 7);
-          hole (menukarte);
-          cursor (1, 3); out(""4"");
-
-          out ("                     "15"Die Diskette wird nicht mehr benötigt! "14"");
-          release (archive)
-  FI.
-insertiere die dateien:
-  check off;
-  in (datei 1);
-  in (datei 2);
-  in (datei 3);
-  in (datei 4);
-  in (datei 5);
-  in (datei 6);
-  in (datei 7);
-  schicke (menukarte);
-  IF einzeln THEN release (archive) FI;
-  check on.
-mache global manager aus der task:
-  global manager.
-
-
-
-
-
diff --git a/doc/PORT-X86 b/doc/porting-8086/8/doc/Port.8086
index 007ca28..a709a2a 100644
--- a/doc/PORT-X86
+++ b/doc/porting-8086/8/doc/Port.8086
@@ -5,7 +5,7 @@
 #type("triumb36")# 
 #free(4.0)# 
   EUMEL 
-  Portierungshand-
+  Portierungshand­
   buch 
   8086 / 8088 
 #type("triumb18")# 
@@ -23,7 +23,7 @@
 #type("triumb12")#Inhalt 
  
 #a# 
-Teil 1: Einf�hrung                                     #topage("ein")# 
+Teil 1: Einführung                                     #topage("ein")# 
 #free(0.3)# 
         Zweck dieses Handbuchs                         #topage("zweck")# 
         Referenzliteratur                              #topage("reflit")# 
@@ -51,7 +51,7 @@ Teil 3: SHard-Interface Spezifikation                 #topage("shardifc")#
       Hauptspeicher                                   #topage("haupt")# 
       Speicherfehler                                  #topage("memerr")# 
    4. Zeitgeber                                       #topage("zeit")# 
-   5. Kan�le                                          #topage("channel")# 
+   5. Kanäle                                          #topage("channel")# 
    5.1  Stream-IO                                     #topage("stream")# 
         Terminals                                     #topage("term")# 
         Drucker, Plotter                              #topage("druck")# 
@@ -61,11 +61,11 @@ Teil 3: SHard-Interface Spezifikation                 #topage("shardifc")#
         Block-IO zur MS-DOS-Partition                 #topage("bmsdosp")# 
    5.3  IO-Steuerung                                  #topage("iocontrol")# 
         Einstellung serieller Schnittstellen          #topage("v24")# 
-        Flu�kontrolle                                 #topage("fluss")# 
+        Flußkontrolle                                 #topage("fluss")# 
         Kalender                                      #topage("kalender")# 
    6. SHard-Interface Version                         #topage("shdver")# 
    7. ID-Konstanten                                   #topage("ID")# 
-   8. Zus�tzliche Leistungen                          #topage("shdelan")# 
+   8. Zusätzliche Leistungen                          #topage("shdelan")# 
    9. Spezialroutinen                                 #topage("ke")# 
  
 Teil 4: Tips zur Portierung                           #topage("tips")# 
@@ -80,8 +80,8 @@ Anhang A: EUMEL-Debugger "Info"                       #topage("info")#
         Info-Kommandos                                #topage("cmdinf")# 
         Einige Systemadressen                         #topage("sysaddr")# 
         Leitblock                                     #topage("pcb")# 
- 
-#cc("Teil 1: ","Einf�hrung")#
+#page# 
+#cc("Teil 1: ","Einführung")#
 #goalpage("ein")# 
  
  
@@ -89,11 +89,11 @@ Anhang A: EUMEL-Debugger "Info"                       #topage("info")#
 #goalpage("zweck")# 
  
 Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf einem
-neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungshandb�chern
-f�r verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit 8086/ 8088-Prozes-
+neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungshandbüchern
+für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit 8086/ 8088-Prozes­
 soren. 
  
-Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht ben�tigt! 
+Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! 
  
  
  
@@ -115,71 +115,71 @@ Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht ben�tigt!
 #b("Minimale Hardwarevoraussetzungen")#
 #goalpage("hardw")# 
  
-Um das EUMEL-System effizient einsetzen zu k�nnen, sollte die Hardware mindestens
-folgenden Kriterien gen�gen: 
+Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens
+folgenden Kriterien genügen: 
  
           #ib#CPU#ie#              Die 8086-CPU sollte mit mindestens 2.5 MHz (8088: 4.0 MHz)
-                           arbeiten. Falls die Buszugriffe durch einen CRTC o.�. ver-
+                           arbeiten. Falls die Buszugriffe durch einen CRTC o.ä. ver­
                            langsamt werden, sollte die echte 8086/ 8088-Leistung
                            durchschnittlich mindestens einem ungebremsten 2.5 MHz (4.0
                            MHz) System entsprechen. 
                            Seltene Verlangsamungen (z.B. nur bei I/O-Operationen)
-                           spielen bei diesen �berlegungen keine Rolle. 
+                           spielen bei diesen Überlegungen keine Rolle. 
  
-          RAM              Das System sollte �ber mindestens 80 K Byte #ib#Hauptspeicher#ie#
-                           verf�gen, besser sind 128 K als Anfangsausr�stung. 
+          RAM              Das System sollte über mindestens 80 K Byte #ib#Hauptspeicher#ie#
+                           verfügen, besser sind 128 K als Anfangsausrüstung. 
  
           #ib#Hintergrund#ie#      Als Hintergrundmedium sind #ib#Floppy#ie#, #ib#Harddisk#ie# und RAM bzw.
                            ROM denkbar. 
  
-                           Kapazit�t:    > 300 K, besser > 400 K (Single-User) 
+                           Kapazität:    > 300 K, besser > 400 K (Single-User) 
                                          > 750 K, besser > 1000 K (Multi-User) 
  
                            Zugriff:      < 500 ms  (Single-User) 
                                          < 200 ms  (Multi-User) *) 
 #foot# 
 #f#
-*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte gro�en Block gemeint. F�r Platten und Floppies kann man
-sie als Summe der Positionierzeit �ber die halbe Platte und der Zeit einer halben Umdrehung berechnen.#a##end# 
+*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Floppies kann man
+sie als Summe der Positionierzeit über die halbe Platte und der Zeit einer halben Umdrehung berechnen.#a##end# 
  
-          #ib#Archiv#ie#           Als Archivger�t wird meistens eine Floppy eingesetzt. Aber
-                           auch Band oder Kassettenrecorder sind denkbar. Die Anfor-
-                           derungen an Kapazit�t und Geschwindigkeit sind anwen-
+          #ib#Archiv#ie#           Als Archivgerät wird meistens eine Floppy eingesetzt. Aber
+                           auch Band oder Kassettenrecorder sind denkbar. Die Anfor­
+                           derungen an Kapazität und Geschwindigkeit sind anwen­
                            dungsspezifisch. 
  
           #ib#Bildschirm#ie#       Angestrebt werden sollte ein Bildschirm mit 24 Zeilen mit je 80
-                           Zeichen (oder gr��er). Kleinere Bildschirme sind anschlie�bar,
-                           aber mit 40 Zeichen pro Zeile l��t sich nicht mehr komfortabel
+                           Zeichen (oder größer). Kleinere Bildschirme sind anschließbar,
+                           aber mit 40 Zeichen pro Zeile läßt sich nicht mehr komfortabel
                            arbeiten. 
-                           Rollup und freie Cursorpositionierung sind notwendige Vor-
-                           aussetzungen, invers-video ist erw�nscht, aber nicht not-
-                           wendig. Weiterhin werden 'L�schen bis Zeilenende' und 'L�-
-                           schen bis Schirmende' ben�tigt. Lokale Editierfunktionen sind
-                           �berfl�ssig. 
- 
-          #ib#Tastatur#ie#         An Steuertasten sollten mindestens ESC und die vier Cur-
-                           sortasten vorhanden sein. Dabei ist es g�nstig, wenn die
+                           Rollup und freie Cursorpositionierung sind notwendige Vor­
+                           aussetzungen, invers-video ist erwünscht, aber nicht not­
+                           wendig. Weiterhin werden 'Löschen bis Zeilenende' und 'Lö­
+                           schen bis Schirmende' benötigt. Lokale Editierfunktionen sind
+                           überflüssig. 
+ 
+          #ib#Tastatur#ie#         An Steuertasten sollten mindestens ESC und die vier Cur­
+                           sortasten vorhanden sein. Dabei ist es günstig, wenn die
                            Cursortasten ergonomisch als Block bzw. Kreuz angeordnet
-                           sind. EUMEL ben�tigt weitere Steuertasten f�r HOP, RUBIN,
-                           RUBOUT und MARK. Daf�r k�nnen beliebige Tasten der
-                           Tastatur gew�hlt werden. 
+                           sind. EUMEL benötigt weitere Steuertasten für HOP, RUBIN,
+                           RUBOUT und MARK. Dafür können beliebige Tasten der
+                           Tastatur gewählt werden. 
  
  
  
 #b("Systemdurchsatz")#
 #goalpage("durchsatz")# 
  
-Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, h�ngt der System-
+Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­
 durchsatz von 
  
      - CPU Leistung 
-     - Speichergr��e (RAM) 
+     - Speichergröße (RAM) 
      - Geschwindigkeit beim Hintergrundzugriff (Floppy, Harddisk) 
  
 ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging
-(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System-
-leistung dann durch mehr Speicher und/oder eine schnellere Platte in gr��erem Umfang
-steigern. Dabei l��t sich eine langsame Platte teilweise durch mehr RAM und umgekehrt
+(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­
+leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang
+steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt
 wenig RAM durch eine schnelle Platte ausgleichen. 
  
  
@@ -191,39 +191,39 @@ Das EUMEL-System besteht aus mehreren Schichten:
  
  
  
-          EUMEL  2:   Standardpakete, Editor, ... 
+          EUMEL  2:   Standardpakete, Editor, ... 
  
-          EUMEL  1:   ELAN Compiler 
+          EUMEL  1:   ELAN Compiler 
  
-          EUMEL  0:   Basismaschine 
+          EUMEL  0:   Basismaschine 
  
-          EUMEL -1:   SHard 
+          EUMEL -1:   SHard 
  
                   H a r d w a r e 
  
  
-Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (h�here)
+Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere)
 Schichten erweitert werden. 
  
-EUMEL > 0    Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN geschrie-
-             ben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schichten ober-
-             halb der EUMEL-0-Maschine prozessor- und rechnerunabh�ngig, d.h.
+EUMEL > 0    Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN geschrie­
+             ben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schichten ober­
+             halb der EUMEL-0-Maschine prozessor- und rechnerunabhängig, d.h.
              Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. 
  
-#ib#EUMEL 0#ie#      Die sogenannte "EUMEL-0-Maschine" enth�lt alle Basisoperationen und
-             h�ngt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie
-             existiert f�r verschiedene Prozessortypen. Hier wird nur auf den Typ 8086/
+#ib#EUMEL 0#ie#      Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und
+             hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie
+             existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ 8086/
              8088 Bezug genommen. Bei der Portierung auf einen 8086/8088-Rechner
-             wird die 8086/8088-EUMEL-0-Maschine ohne Anpassungen (!) �bernom-
+             wird die 8086/8088-EUMEL-0-Maschine ohne Anpassungen (!) übernom­
              men. 
  
 EUMEL -1     Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und der
-             eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere umfa�t
-             sie alle Routinen zur Ansteuerung peripherer Ger�te (Ger�tetreiber). 
+             eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere umfaßt
+             sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber). 
              Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). 
  
 Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen 8086/8088-
-Rechner angepa�t bzw. neu geschrieben werden mu�. Deshalb besteht der gr��te Teil dieses
+Rechner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil dieses
 Handbuchs aus der Spezifikation des 8086/8088-SHards. 
  
  
@@ -231,30 +231,30 @@ Handbuchs aus der Spezifikation des 8086/8088-SHards.
 #b("Anlieferung des 8086/8088-EUMEL-Systems")#
 #goalpage("anlief")# 
  
-Der Implementierer erh�lt die EUMEL-Software auf Disketten. Dabei stehen folgende
+Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende
 Standardformate zur Wahl: 
  
-          8", 1D, 77 Spuren, 16 Sektoren (#0...#15) � 512 Byte 
+          8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
  
-          5", 2D, 40 Spuren, 9 Sektoren (#1...#9) � 512 Byte *) 
+          5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte *) 
 #foot# 
 #f#
 *)   48 tpi#a##end# 
  
  
-Die Diskettenlieferung enth�lt 
+Die Diskettenlieferung enthält 
  
           - Single-User Hintergrund 
           - Multi-User Hintergrund 
           - Standardarchive 
           - Archive mit weiterer Anwendersoftware 
  
-Dabei enth�lt der Hintergrund auch die EUMEL-0-Software (oft auch als "Urlader" be-
+Dabei enthält der Hintergrund auch die EUMEL-0-Software (oft auch als "Urlader" be­
 zeichnet). 
  
 #on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als Quelle
 beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# 
- 
+#page# 
 #cc("Teil 2: ","Allgemeine Strukturen")#
 #goalpage("allgem")# 
  
@@ -262,15 +262,15 @@ beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")#
 #b("Hintergrund")#
 #goalpage("hg")# 
  
-Der Hintergrund ist in 512 Bytes gro�e Bl�cke unterteilt. Sie werden durch Blocknummern (0,
-1, 2, ...) adressiert. Die physische Ablage der Bl�cke auf dem Hintergrundmedium bleibt dem
-SHard �berlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte darauf achten,
-da� Positionierungen auf logisch "nahe" Bl�cke m�glichst schnell gehen sollten. Deshalb ist
-in der Regel zylinderorientierte Anordnung der oberfl�chenorientierten vorzuziehen. 
+Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern (0,
+1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium bleibt dem
+SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte darauf achten,
+daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen sollten. Deshalb ist
+in der Regel zylinderorientierte Anordnung der oberflächenorientierten vorzuziehen. 
  
-Falls auf dem Hintergrundger�t spezielle Bl�cke z.B. f�r Boot und SHard freigehalten werden
-sollen, mu� das bei der Abbildung der Hintergrundblocknummern auf die Sektoren der Floppy
-bzw. der Harddisk ber�cksichtigt werden. 
+Falls auf dem Hintergrundgerät spezielle Blöcke z.B. für Boot und SHard freigehalten werden
+sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die Sektoren der Floppy
+bzw. der Harddisk berücksichtigt werden. 
  
 Aufbau des Hintergrundes: 
  
@@ -285,17 +285,17 @@ Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#):
  
      Byte        Wert/Aufgabe 
  
-     0...5       "EUMEL-"; Kennzeichen f�r EUMEL-Hintergrund. 
-     6...11      Versionsnummer in druckbaren Zeichen. Sie stellt sicher, da� Urlader und
+     0...5       "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. 
+     6...11      Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß Urlader und
                  Hintergrund kompatibel sind. 
      12          FFh  ; zur Zeit ohne Bedeutung 
-     13          enth�lt Wert 0 , wenn System im Shutupzustand ist. 
-     14..15      Systemlaufz�hler (14=low, 15=high). Wird bei jedem Systemstart um 1
-                 erh�ht. 
+     13          enthält Wert 0 , wenn System im Shutupzustand ist. 
+     14..15      Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1
+                 erhöht. 
      16..35      Reserviert; zur Zeit ohne Bedeutung 
-     36..37      Aus historischen Gr�nden f�r interne Zwecke belegt. 
-     38 .. 69    Hier kann eine Installationsnummer gef�hrt werden. 
-     70 .. 79    Info-Pa�wort 
+     36..37      Aus historischen Gründen für interne Zwecke belegt. 
+     38 .. 69    Hier kann eine Installationsnummer geführt werden. 
+     70 .. 79    Info-Paßwort 
      80...255    Reserviert. 
      256..511    Kann von SHard beliebig verwendet werden. 
  
@@ -304,12 +304,12 @@ Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#):
 #b("Archiv")#
 #goalpage("arch")# 
  
-Wie der Hintergrund sind die Archive in 512 Bytes gro�e Bl�cke unterteilt. Bisher gibt es
+Wie der Hintergrund sind die Archive in 512 Bytes große Blöcke unterteilt. Bisher gibt es
 folgende #dx("Standardformate")#: 
  
  
-     8", 1D, 77 Spuren, 16 Sektoren (#0...#15) � 512 Byte 
-     8", 2D, 77 Spuren, 16 Sektoren (#0...#15) � 512 Byte 
+     8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
+     8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
  
           Block           Seite             Spur             Sektor 
  
@@ -320,7 +320,7 @@ folgende #dx("Standardformate")#:
             n         n DIV (77*16)   n MOD (77*16) DIV 16   n MOD 16 
  
  
-     5", 2D, 40 Spuren, 9 Sektoren (#1...#9) � 512 Byte 
+     5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte 
  
           Block           Seite             Spur             Sektor 
  
@@ -331,7 +331,7 @@ folgende #dx("Standardformate")#:
             n         n DIV (40*9)    n MOD (40*9) DIV 9   n MOD 9 + 1 
  
  
-     5", 2D, 80 Spuren, 9 Sektoren (#1...#9) � 512 Byte 
+     5", 2D, 80 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte 
  
           Block           Seite             Spur             Sektor 
  
@@ -342,7 +342,7 @@ folgende #dx("Standardformate")#:
             n         n DIV (80*9)   n MOD (80*9) DIV 9     n MOD 9 + 1 
  
  
-     5", HD, 80 Spuren, 15 Sektoren (#1...#15) � 512 Byte 
+     5", HD, 80 Spuren, 15 Sektoren (\#1...\#15) � 512 Byte 
  
           Block           Seite             Spur             Sektor 
  
@@ -353,17 +353,17 @@ folgende #dx("Standardformate")#:
             n        n DIV (80*15)   n MOD (80*15) DIV 15   n MOD 15 + 1 
  
  
-Selbstverst�ndlich k�nnen auch andere #ib#Archivformate#ie# implementiert werden, falls das aus
-Hardwaregr�nden notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in der
-Kapazit�t) ergeben. 
+Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus
+Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in der
+Kapazität) ergeben. 
  
-Wenn irgend m�glich sollte aber mindestens eines der oben aufgef�hrten Standardformate
-unterst�tzt werden - evtl. als zus�tzliches Format -, um den Austausch zwischen verschie-
+Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate
+unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen verschie­
 denen Rechnertypen zu vereinfachen. 
  
-#on("i")#Hinweis:  Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfa-
-          chen, sollten m�glichst alle der hardwarem��ig m�glichen Standardformate (min-
-          destens lesend) unterst�tzt werden. Dabei sollte SHard sich automatisch auf das
+#on("i")#Hinweis:  Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfa­
+          chen, sollten möglichst alle der hardwaremäßig möglichen Standardformate (min­
+          destens lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf das
           Format der jeweils eingelegten Floppy einstellen:#off("i")# 
  
  
@@ -379,7 +379,7 @@ denen Rechnertypen zu vereinfachen.
 #f#
 *) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: 
      a) Lesen funktioniert sicher. 
-     b) Schreiben ist unsicher, funktioniert aber h�ufig. 
+     b) Schreiben ist unsicher, funktioniert aber häufig. 
      c) Formatieren funktioniert fast nie. 
 #a# 
 #end# 
@@ -390,18 +390,18 @@ denen Rechnertypen zu vereinfachen.
 #goalpage("speicher")# 
  
 Der #ib#Speicher#ie# wird EUMEL-0 vom SHard in maximal vier Speicherbereichen (M0...M3)
-zugewiesen. M0 mu� immer vorhanden sein, M1, M2 und M3 nur in speziellen Betriebsarten: 
+zugewiesen. M0 muß immer vorhanden sein, M1, M2 und M3 nur in speziellen Betriebsarten: 
  
      #dx("M0")#   #on("b")#allgemeines #ib#RAM#ie(1,", allgemeines")##off("b")# 
-          Dieser Bereich mu� immer vorhanden sein. Bei den meisten Rechnern liegt der
+          Dieser Bereich muß immer vorhanden sein. Bei den meisten Rechnern liegt der
           Urlader nicht in einem ROM, sondern wird von SHard in das RAM geladen. Das
-          geschieht dann an den Anfang von M0. Der Rest wird f�r Tabellen und als Pa-
-          gingbereich benutzt. M0 umfa�t deshalb meistens allen verf�gbaren Speicher, bis
-          auf den Platz f�r SHard, Boot-ROM und Bildwiederholspeicher. 
+          geschieht dann an den Anfang von M0. Der Rest wird für Tabellen und als Pa­
+          gingbereich benutzt. M0 umfaßt deshalb meistens allen verfügbaren Speicher, bis
+          auf den Platz für SHard, Boot-ROM und Bildwiederholspeicher. 
  
      #dx("M1")#   #on("b")#Urlader-#ib#ROM#ie(1,", Urlader")##off("b")# 
           Gibt es nur bei Rechnern, die den Urlader in einem ROM haben. (M0 wird dann
-          nur f�r Tabellen und als Pagingspeicher eingesetzt.) 
+          nur für Tabellen und als Pagingspeicher eingesetzt.) 
  
      #dx("M2")#   #on("b")#Hintergrund-#ib#ROM#ie(1,", Hintergrund")##off("b")# 
           Gibt es nur bei Rechnern, die nicht Floppy oder Festplatte sondern ROM und
@@ -411,36 +411,36 @@ zugewiesen. M0 mu� immer vorhanden sein, M1, M2 und M3 nur in speziellen Betrieb
           Gibt es nur bei Rechnern, die nicht Floppy oder Festplatte sondern ROM und
           RAM oder RAM allein als Hintergrundspeicherverwenden. 
  
-Damit sind drei verschiedene Betriebsarten des EUMEL-Systems m�glich: 
+Damit sind drei verschiedene Betriebsarten des EUMEL-Systems möglich: 
  
      #dx("Normalbetrieb")#:        M0 (> 80 K) 
-                           Hintergrundger�t (Festplatte oder Floppy) 
-                           Archivger�t (Floppy) 
+                           Hintergrundgerät (Festplatte oder Floppy) 
+                           Archivgerät (Floppy) 
  
           Im Normalbetrieb befindet sich der Hintergrund auf einer Festplatte oder Floppy.
-          RAM wird f�r den Urlader und zum Paging eingesetzt. Alle mittleren und gr�-
-          �eren Systeme verwenden den Normalbetrieb. 
+          RAM wird für den Urlader und zum Paging eingesetzt. Alle mittleren und grö­
+          ßeren Systeme verwenden den Normalbetrieb. 
  
  
      #dx("Minibetrieb")#:          M0 (> 80 K) 
                            M3 (mindestens 300 K) 
-                           Archivger�t (Floppy) 
+                           Archivgerät (Floppy) 
  
           Im Minibetrieb wird RAM als Hintergrundspeicher eingesetzt. Dieser wird beim
-          Einschalten �ber das Archivger�t geladen und beim Abschalten ('shutup') wieder
-          zur�ckgeschrieben. 
+          Einschalten über das Archivgerät geladen und beim Abschalten ('shutup') wieder
+          zurückgeschrieben. 
  
  
      #dx("ROM-Betrieb")#:          M0 (> 24 K) 
                            M1 (> 45 K) 
                            M2 (> 170 K) 
                            M3 (> 60 K) 
-                           Archivger�t (Kassettenrecorder oder Floppy) 
+                           Archivgerät (Kassettenrecorder oder Floppy) 
  
           Im ROM-Betrieb stehen Urlader und Standardteil des Hintergrundes im ROM.
-          Der �brige Hintergrund befindet sich im RAM. 
+          Der übrige Hintergrund befindet sich im RAM. 
  
- 
+#page# 
 #cc("Teil 3: SHard ","Interface Spezifikation")#
 #goalpage("shardifc")# 
  
@@ -453,13 +453,13 @@ Damit sind drei verschiedene Betriebsarten des EUMEL-Systems m�glich:
 #goalpage("not")# 
  
 Im folgenden wird zwischen #dx("0-Routinen")#, die dem SHard vom EUMEL-0-System zur
-Verf�gung gestellt werden, und #dx("SHard-Routinen")# unterschieden, die der SHard implemen-
-tieren mu�. Damit dieser Unterschied bei der Spezifikation deutlich wird, werden 0-Routinen
-folgenderma�en aufgef�hrt: 
+Verfügung gestellt werden, und #dx("SHard-Routinen")# unterschieden, die der SHard implemen­
+tieren muß. Damit dieser Unterschied bei der Spezifikation deutlich wird, werden 0-Routinen
+folgendermaßen aufgeführt: 
  
           name       (0-Routine) 
  
-Zus�tzlich werden 0-Routinen grunds�tzlich klein und SHard-Routinen gro� geschrieben. 
+Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrieben. 
  
 8086/8088-Befehle werden wie in "iAPX 86,88 Users Manual" (intel, 1981) notiert: 
  
@@ -476,8 +476,8 @@ Hexadezimale Zahlen werden durch ein nachgestelltes 'h' gekennzeichnet:
 #b("Link-Leisten")#
 #goalpage("leist")# 
  
-Die Verbindung zwischen SHard und Urlader (EUMEL-0) erfolgt �ber zwei Tabellen. In der
-"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verf�gung. Diese
+Die Verbindung zwischen SHard und Urlader (EUMEL-0) erfolgt über zwei Tabellen. In der
+"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese
 Leiste beginnt an der Adresse M0:0 (im Normal- oder Minimodus) bzw. M1:0 (im ROM-
 Modus): 
  
@@ -487,7 +487,7 @@ Modus):
                            db 10 dup (?) 
      10h  eumel0blocks     dw 
      12h  hgver            dw 
-     14h  cputype          dw 3           ; f�r 8086 oder kompatible CPU 
+     14h  cputype          dw 3           ; für 8086 oder kompatible CPU 
      16h  urver            dw 
      18h                   dw 
      1Ah  shdvermin        dw 
@@ -502,13 +502,13 @@ Modus):
      38h  shutup           dd 
      3Ch  info             dd 
  
-Hinweis: Die Segmentteile der 'dd'-Addressen in dieser Link-Leiste sind nat�rlich unde-
-         finiert. Deshalb mu� SHard diese auf M0 bzw. M1 setzen. Dazu ist es mindestens
+Hinweis: Die Segmentteile der 'dd'-Addressen in dieser Link-Leiste sind natürlich unde­
+         finiert. Deshalb muß SHard diese auf M0 bzw. M1 setzen. Dazu ist es mindestens
          beim ROM-Urlader erforderlich, die 0-Leiste in einen von SHard verwalteten
          RAM-Bereich zu kopieren. 
  
  
-F�r die Gegenrichtung mu� SHard der 0-Maschine die "SHard-Leiste" zur Verf�gung stel-
+Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung stel­
 len: 
  
      Adresse 
@@ -539,7 +539,7 @@ len:
  
  
 Dabei ist als 'MxSTART' eine Paragraphenadresse (d.h. Adresse DIV 16) und entsprechend
-als 'MxSIZE' die L�nge des Bereichs als Bytel�nge DIV 16 anzugeben. 
+als 'MxSIZE' die Länge des Bereichs als Bytelänge DIV 16 anzugeben. 
  
  
  
@@ -553,33 +553,33 @@ In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'call' aufzuru
  
 Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. 
  
-Generelle Link-Bedingung (f�r SHard- und 0-Routinen) ist: 
+Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: 
  
-     Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und das F-Re-
-     gister *) - bleiben unver�ndert. 
+     Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und das F-Re­
+     gister *) - bleiben unverändert. 
 #foot# 
 #f#
-*) Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind nat�rlich die Flags, die als Ausgangspara-
-meter in manchen F�llen definiert sind.#a##end# 
+*) Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags, die als Ausgangspara­
+meter in manchen Fällen definiert sind.#a##end# 
  
-Jede SHard-Routine mu� also alle Register (bis auf F), die sie ver�ndert und die keine
+Jede SHard-Routine muß also alle Register (bis auf F), die sie verändert und die keine
 Ausgangsparameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim
 Aufruf von 0-Routinen selbst keine Register zu retten. 
-Das schlie�t auch die Segmentregister mit ein. Um SHard-eigene Daten �ber DS zu adres-
-sieren, mu� SHard also DS sichern, neu laden und zum Schlu� wiederherstellen. Entspre-
-chendes gilt f�r ES. SS darf nicht ver�ndert werden. 
+Das schließt auch die Segmentregister mit ein. Um SHard-eigene Daten über DS zu adres­
+sieren, muß SHard also DS sichern, neu laden und zum Schluß wiederherstellen. Entspre­
+chendes gilt für ES. SS darf nicht verändert werden. 
  
  
 #b("Interrupts")#
 #goalpage("intr")# 
  
 Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von
-EUMEL-0 behandelt. Die entsprechenden Interrupts mu� SHard per 'call' an 0-Routinen
+EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'call' an 0-Routinen
 weiterleiten. 
-Die Register (bis auf AX und F) werden von den aufzurufenden 0-Routinen selbst gesi-
+Die Register (bis auf AX und F) werden von den aufzurufenden 0-Routinen selbst gesi­
 chert. Auch die Segmentregister DS und ES werden von EUMEL-0 geladen. (CS wird
-automatisch durch den "far call" gesetzt, SS darf sowieso nicht ver�ndert werden.) Die
-normale Interrupt-Sequenz im SHard sieht dann folgenderma�en aus: 
+automatisch durch den "far call" gesetzt, SS darf sowieso nicht verändert werden.) Die
+normale Interrupt-Sequenz im SHard sieht dann folgendermaßen aus: 
  
           intadr: push ax 
                   mov  al,<parameter> 
@@ -593,20 +593,20 @@ normale Interrupt-Sequenz im SHard sieht dann folgenderma�en aus:
 #bb("1.  System ","laden")#
 #goalpage("laden")# 
  
-SHard mu� die EUMEL-0-Software vor dem eigentlichen Start an den Anfang der Spei-
+SHard muß die EUMEL-0-Software vor dem eigentlichen Start an den Anfang der Spei­
 cherregion M0 laden. EUMEL-0 befindet sich normalerweise auf dem Hintergrund von Block
-10 ab. Der erste Block (10) enth�lt am Anfang die 0-Leiste. Dort steht an der Stelle 10h die
-Gr��e 'eumel0blocks'. Sie gibt an, wieviel Bl�cke konsekutiv geladen werden m�ssen. Hat
-sie beispielsweise den Wert 80, m�ssen die Bl�cke 10 bis 89 geladen werden. 
+10 ab. Der erste Block (10) enthält am Anfang die 0-Leiste. Dort steht an der Stelle 10h die
+Größe 'eumel0blocks'. Sie gibt an, wieviel Blöcke konsekutiv geladen werden müssen. Hat
+sie beispielsweise den Wert 80, müssen die Blöcke 10 bis 89 geladen werden. 
  
-     Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgef�hrten 0-Routinen na-
-              t�rlich noch nicht benutzen. Insbesondere d�rfen die Laderoutinen nicht
+     Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen na­
+              türlich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht
               'warte' aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff
               beim eigentlichen Systemlauf in der Regel 'warte' verwenden wird. 
  
-     Hinweis: Der erste Block der EUMEL-0-Software (Block 10) enth�lt in den ersten
-              f�nf Bytes den Text "EUMEL", um eine Identifikation durch den SHard-
-              Lader zu erm�glichen. 
+     Hinweis: Der erste Block der EUMEL-0-Software (Block 10) enthält in den ersten
+              fünf Bytes den Text "EUMEL", um eine Identifikation durch den SHard-
+              Lader zu ermöglichen. 
  
 Es wird empfohlen, nach folgendem Verfahren zu laden: 
  
@@ -617,22 +617,22 @@ Es wird empfohlen, nach folgendem Verfahren zu laden:
      ELSE laden unmoeglich 
      FI . 
  
-So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter-
+So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­
 grund (mit EUMEL-0-Urlader) einspielen, indem man ein Hintergrundarchiv vor dem
-Systemstart in das Archivger�t legt. Dann wird EUMEL-0 von dort geladen, so da� man den
-Hintergrund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrundme-
+Systemstart in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den
+Hintergrund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrundme­
 dium kopieren kann.*) 
 #foot# 
 #f#
-*) Kopiervorg�nge (Archiv -> Hintergrund) werden vom EUMEL-0-Urlader erledigt, so da� SHard keine derartigen
-Routinen enthalten mu�.#a##end# 
+*) Kopiervorgänge (Archiv -> Hintergrund) werden vom EUMEL-0-Urlader erledigt, so daß SHard keine derartigen
+Routinen enthalten muß.#a##end# 
  
  
  
 #bb("2.  System","start und -ende")#
 #goalpage("start")# 
  
-SHard mu� alle f�r den Rechner notwendigen (Hardware-) Initialisierungen durchf�hren und
+SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen und
 erst danach die EUMEL-0-Maschine starten ('systemstart'). 
  
      #dx("systemstart")#           (0-Routine) 
@@ -644,50 +644,50 @@ erst danach die EUMEL-0-Maschine starten ('systemstart').
  
           Zweck:           Die EUMEL-0-Maschine wird gestartet. Alle notwendigen
                            Hardwareinitialisierungen (z.B. der Peripheriebausteine)
-                           m�ssen vorher schon geschehen sein. 
+                           müssen vorher schon geschehen sein. 
  
           Hinweis:         Der Stackpointer und die Segmentregister brauchen nicht
                            definiert zu sein, da beim Ansprung alle Interrupts maskiert
-                           sein sollten und somit keine Interrupts auftreten k�nnen.
-                           EUMEL-0 l�dt beim Start CS, SS, SP, DS, ES und l��t In-
+                           sein sollten und somit keine Interrupts auftreten können.
+                           EUMEL-0 lädt beim Start CS, SS, SP, DS, ES und läßt In­
                            terrupts zu (STI). Falls jedoch in dieser Zeit ein "Non Maskable
-                           Interrupt" auftreten kann, mu� SHard SS und SP "vorl�ufig"
+                           Interrupt" auftreten kann, muß SHard SS und SP "vorläufig"
                            laden. 
  
-          MODE:            �ber das MODE-Wort in der SHard-Leiste k�nnen Optionen
+          MODE:            Über das MODE-Wort in der SHard-Leiste können Optionen
                            gesetzt werden: 
  
-                           Bit 0 = 0      EUMEL-0 ist auf dem Hintergrund abge-
+                           Bit 0 = 0      EUMEL-0 ist auf dem Hintergrund abge­
                                           speichert. Der entsprechende Bereich bleibt
-                                          gesch�tzt. (Standard) 
+                                          geschützt. (Standard) 
  
-                           Bit 0 = 1      EUMEL-0 befindet sich nicht auf dem Hin-
+                           Bit 0 = 1      EUMEL-0 befindet sich nicht auf dem Hin­
                                           tergrund. Der entsprechende Bereich steht zur
-                                          freien Verf�gung f�r andere EUMEL-Daten. 
+                                          freien Verfügung für andere EUMEL-Daten. 
                                           (Da die EUMEL-0-Software nur beim
                                           Systemstart geladen wird (read only!), kann es
-                                          bei Ger�ten mit kleinem Hintergrund inter-
-                                          essant sein, diese Bl�cke auf dem Hinter-
-                                          grund anderweitig zu nutzen. Das Systemla-
+                                          bei Geräten mit kleinem Hintergrund inter­
+                                          essant sein, diese Blöcke auf dem Hinter­
+                                          grund anderweitig zu nutzen. Das Systemla­
                                           den kann dann z.B. mit Hilfe einer speziellen
-                                          Urladediskette vom Archivger�t aus erfolgen.) 
+                                          Urladediskette vom Archivgerät aus erfolgen.) 
  
-                           Bit 8 = 0      Beim Systemstart wird der Speicher �berpr�ft.
+                           Bit 8 = 0      Beim Systemstart wird der Speicher überprüft.
                                           (Standard) 
  
                            Bit 8 = 1      Der Speichertest beim Systemstart unterbleibt.
-                                          Man sollte nur bei Rechnern, die beim Ein-
-                                          schalten schon eigene Speichertests durch-
-                                          f�hren, auf den Speichertest des EUMEL
+                                          Man sollte nur bei Rechnern, die beim Ein­
+                                          schalten schon eigene Speichertests durch­
+                                          führen, auf den Speichertest des EUMEL
                                           verzichten. 
  
                            Bit 9 = 0      Beim Systemstart wird die Vortest-Tapete
                                           ausgegeben und man kann durch Eingabe
-                                          eines Zeichens die Vortestmen�s aktivieren (s.
+                                          eines Zeichens die Vortestmenüs aktivieren (s.
                                           Systemhandbuch). (Standard) 
  
-                           Bit 9 = 1      Die Vortest-tapete wird unterdr�ckt. Es gibt
-                                          auch keine M�glichkeit, die Vortestfunktionen
+                           Bit 9 = 1      Die Vortest-tapete wird unterdrückt. Es gibt
+                                          auch keine Möglichkeit, die Vortestfunktionen
                                           aufzurufen. Der Speichertest unterbleibt
                                           ebenfalls. 
  
@@ -698,12 +698,12 @@ erst danach die EUMEL-0-Maschine starten ('systemstart').
           Parameter:       - 
  
           Zweck:           Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt.
-                           Somit k�nnen evtl. notwendige Abschlu�behandlungen durch-
-                           gef�hrt werden. SHard kann mit 'ret' zu EUMEL-0 zur�ck-
-                           kehren, mu� aber nicht. Diese Routine kann z.B. dazu benutzt
+                           Somit können evtl. notwendige Abschlußbehandlungen durch­
+                           geführt werden. SHard kann mit 'ret' zu EUMEL-0 zurück­
+                           kehren, muß aber nicht. Diese Routine kann z.B. dazu benutzt
                            werden, die Hardware auszuschalten oder in ein umgebendes
-                           System zur�ckzukehren (EUMEL als Subsystem). In den mei-
-                           sten F�llen wird die Routine leer implementiert werden, d.h.
+                           System zurückzukehren (EUMEL als Subsystem). In den mei­
+                           sten Fällen wird die Routine leer implementiert werden, d.h.
                            nur aus 'ret' bestehen. 
  
  
@@ -714,14 +714,14 @@ erst danach die EUMEL-0-Maschine starten ('systemstart').
 #b("Hauptspeicher")#
 #goalpage("haupt")# 
  
-Der Hauptspeicher umfa�t die Teile des 8086/8088-Speichers, die EUMEL-0 verwalten
-darf, n�mlich die Bereiche M0, M1, M2 und M3 (siehe S.#topage("speicher")#). M1, M2 und M3 sind dabei nur
-bei speziellen Betriebsarten n�tig. Jeder der vier Bereiche wird in der SHard-Leiste durch
-die Anfagsadresse MxSTART und seine L�nge MxSIZE beschrieben: 
+Der Hauptspeicher umfaßt die Teile des 8086/8088-Speichers, die EUMEL-0 verwalten
+darf, nämlich die Bereiche M0, M1, M2 und M3 (siehe S.#topage("speicher")#). M1, M2 und M3 sind dabei nur
+bei speziellen Betriebsarten nötig. Jeder der vier Bereiche wird in der SHard-Leiste durch
+die Anfagsadresse MxSTART und seine Länge MxSIZE beschrieben: 
  
           MxSTART          Anfang des Bereichs als Paragraphenadresse (Byteadresse DIV
                            16) 
-          MxSIZE           Gr��e des Bereichs in Paragraphen (Bytegr��e DIV 16) 
+          MxSIZE           Größe des Bereichs in Paragraphen (Bytegröße DIV 16) 
  
 Nicht vorhandenen Bereiche werden durch MxSIZE = MxSTART = 0 gekennzeichnet. 
  
@@ -732,22 +732,22 @@ Nicht vorhandenen Bereiche werden durch MxSIZE = MxSTART = 0 gekennzeichnet.
 #b("Speicherfehler")#
 #goalpage("memerr")# 
  
-Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder �hnlichem feststellen
-und an SHard melden kann, sollte das zur Erh�hung der Systemsicherheit genutzt werden. 
+Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen
+und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt werden. 
  
-Wenn SHard (z.B. �ber Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er wenn
-m�glich eine entsprechende Meldung ausgeben und das System brutal anhalten: 
+Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er wenn
+möglich eine entsprechende Meldung ausgeben und das System brutal anhalten: 
  
-          rien ne vas plus:   jmp  rien ne vas plus 
+          rien ne vas plus:   jmp  rien ne vas plus 
  
  
-Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, da� die
-Fehler auf dem Hintergrund festgeschrieben werden und evtl. sp�ter zu Systemfehlern f�h-
+Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die
+Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern füh­
 ren. 
  
 Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL-
-Systems zur�cksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, beh�lt aber
-auf alle F�lle ein konsistentes System. 
+Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält aber
+auf alle Fälle ein konsistentes System. 
  
  
  
@@ -755,56 +755,56 @@ auf alle F�lle ein konsistentes System.
 #bb("4.  ","Zeitgeber")#
 #goalpage("zeit")# 
  
-SHard mu� einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt.
+SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt.
 Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr nicht
-gef�hrt, und die Zeitscheibenlogik f�r das Timesharing f�llt aus. 
+geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. 
  
      #dx("timerinterrupt")#         (0-Routine) 
  
           Eingang:         AL    seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) 
  
-          Zweck:           Wird von EUMEL-0 f�r interne Uhren und f�r das Schedu-
+          Zweck:           Wird von EUMEL-0 für interne Uhren und für das Schedu­
                            ling (Zeitscheibenlogik) verwendet. Es werden keine hohen
-                           Genauigkeitsanforderungen an die Zeitangaben bei #on("i")#einzel-
-                           nen#off("i")# Interrupts gestellt. Um EUMEL-0 eine genaue Real-
-                           zeituhr zu erm�glichen, sollte die so erzeugte Zeitangabe #on("i")#im
-                           Mittel#off("i")# aber m�glichst genau sein, d.h. die Summe der in-
-                           nerhalb einer Minute so �bergebenen Werte sollte zwischen
+                           Genauigkeitsanforderungen an die Zeitangaben bei #on("i")#einzel­
+                           nen#off("i")# Interrupts gestellt. Um EUMEL-0 eine genaue Real­
+                           zeituhr zu ermöglichen, sollte die so erzeugte Zeitangabe #on("i")#im
+                           Mittel#off("i")# aber möglichst genau sein, d.h. die Summe der in­
+                           nerhalb einer Minute so übergebenen Werte sollte zwischen
                            59995 und 60005 liegen. 
  
  
  
-#bb("5.  ","Kan�le")#
+#bb("5.  ","Kanäle")#
 #goalpage("channel")# 
  
 Einiges zum Kanalkonzept: 
  
-Das System kennt die Kan�le 0..32. 
+Das System kennt die Kanäle 0..32. 
  
      Kanal 0 ist der Systemhintergrund. 
-     Die Kan�le 1..15 sind f�r Stream-IO (Terminals, Drucker, ...) vorgesehen. 
+     Die Kanäle 1..15 sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. 
      Kanal 31 ist der Standard-Archivkanal. 
      Kanal 32 ist der Parameterkanal. 
  
-Die Kan�le 2.. 30 k�nnen installationsabh�ngig verf�gbar sein oder auch nicht. Deren Funk-
+Die Kanäle 2.. 30 können installationsabhängig verfügbar sein oder auch nicht. Deren Funk­
 tion ist dann Absprachesache zwischen Installation und SHard. 
  
-Kan�le k�nnen �ber Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..)
-angesprochen werden. Das System erf�hrt �ber IOCONTROL, welche Betriebsart des Kanals
+Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..)
+angesprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des Kanals
 sinnvoll ist. 
  
-#on("i")##on("b")#Achtung:  Alle Kanaloperationen m�ssen grunds�tzlich f�r alle Kan�le (0...32) aufgerufen
-          werden k�nnen. Dabei k�nnen Operationen auf nicht vorhandenen Kan�len und
-          unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert wer-
-          den.#off("b")# (Daf�r werden im folgenden bei jeder SHard-Routine Vorschl�ge gemacht.)#off("i")# 
+#on("i")##on("b")#Achtung:  Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen
+          werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und
+          unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert wer­
+          den.#off("b")# (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# 
  
  
  
 #bb("5.1 ","Stream-IO")#
 #goalpage("stream")# 
  
-�ber Stream-IO wickelt das System die �bliche zeichenorientierte Ein-/Ausgabe auf Ter-
-minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gemacht. 
+Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Ter­
+minals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. 
  
      #dx("inputinterrupt")#        (0-Routine)#goalpage("inp")# 
  
@@ -818,20 +818,20 @@ minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gem
                                  Bit 1 = 1       Es wurde ein BREAK erkannt (bei
                                                  V24). Dieses Ereignis kann nicht
                                                  durch ein Sonderzeichen gemeldet
-                                                 werden, da bei einer 8-bit-�ber-
+                                                 werden, da bei einer 8-bit-Über­
                                                  tragung schon alle Zeichen vergeben
-                                                 sind. Daher wird BREAK hier aufge-
+                                                 sind. Daher wird BREAK hier aufge­
                                                  nommen, obwohl es im eigentlichen
-                                                 Sinne kein Fehler sein mu�. 
-                                 Bit 2 = 1       Das �bergebene Zeichen ist verf�lscht
-                                                 (z.B. Parit�t falsch). 
+                                                 Sinne kein Fehler sein muß. 
+                                 Bit 2 = 1       Das übergebene Zeichen ist verfälscht
+                                                 (z.B. Parität falsch). 
  
           Ausgang:         AL    Zahl der noch freien Bytes im Eingabepuffer von
-                                 EUMEL-0. Die Angabe gilt f�r den Puffer dieses
-                                 Kanals nach Eintrag des �bergebenen Zeichens. 
+                                 EUMEL-0. Die Angabe gilt für den Puffer dieses
+                                 Kanals nach Eintrag des übergebenen Zeichens. 
  
-          Zweck:           SHard mu� EUMEL-0 durch Aufruf dieser Routine mitteilen,
-                           da� eine Eingabe vorliegt. 
+          Zweck:           SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen,
+                           daß eine Eingabe vorliegt. 
  
           Hinweise:        EUMEL-0 puffert die Zeichen. Falls 0 geliefert wird, ist der
                            Puffer voll und EUMEL-0 ignoriert weitere Eingaben, bis
@@ -841,17 +841,17 @@ minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gem
                            Bei Kanalnummern <1 oder >15 wird der Aufruf von
                            EUMEL-0 ignoriert. 
  
-                           Falls die Hardware keine Inputinterrupts zur Verf�gung stellt,
-                           sollte ein Timer benutzt werden, um alle m�glichen Input-
-                           quellen regelm��ig abzufragen. Dabei mu� man allerdings den
-                           goldenen Mittelweg zwischen zu h�ufiger (Systemdurchsatz
-                           sinkt) und zu seltener Abfrage (Zeichen gehen verloren) such-
-                           en. Man sollte dabei nicht nur an die menschliche Tippge-
-                           schwindigkeit sondern auch an die h�chste Baudrate denken,
-                           die man f�r Rechnerkopplungen noch unterst�tzen will. *) 
- 
-                           Falls SHard Flu�kontrolle f�r den Kanal
-                           aus�ben soll, mu� er die R�ckmeldung in AL
+                           Falls die Hardware keine Inputinterrupts zur Verfügung stellt,
+                           sollte ein Timer benutzt werden, um alle möglichen Input­
+                           quellen regelmäßig abzufragen. Dabei muß man allerdings den
+                           goldenen Mittelweg zwischen zu häufiger (Systemdurchsatz
+                           sinkt) und zu seltener Abfrage (Zeichen gehen verloren) such­
+                           en. Man sollte dabei nicht nur an die menschliche Tippge­
+                           schwindigkeit sondern auch an die höchste Baudrate denken,
+                           die man für Rechnerkopplungen noch unterstützen will. *) 
+ 
+                           Falls SHard Flußkontrolle für den Kanal
+                           ausüben soll, muß er die Rückmeldung in AL
                            auswerten. Dabei ist mit einem geeigneten
                            Schwellwert zu arbeiten, da in der Regel die
                            sendende Gegenstelle einer Sendeunterbrechung
@@ -859,15 +859,15 @@ minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gem
  
 #foot# 
 #f#
-*) Eine weitere M�glichkeit, auf manchen Kan�len ohne Interrupts auszukommen, wird bei der IOCONTROL-Funktion
+*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funktion
 "weiter" beschrieben (siehe S.#topage("weiter")#).#a##end# 
  
           Achtung:         #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden.
                            Normalerweise wird das automatisch verhindert, wenn man den
-                           zugeh�rigen Hardwareinterrupt erst nach der 0-Routine
-                           wieder freigibt. Falls das nicht m�glich ist und unter bestimm-
-                           ten Umst�nden das n�chste Zeichen abgeholt werden mu�,
-                           bevor die 0-Routine beendet ist, mu� SHard einen eigenen
+                           zugehörigen Hardwareinterrupt erst nach der 0-Routine
+                           wieder freigibt. Falls das nicht möglich ist und unter bestimm­
+                           ten Umständen das nächste Zeichen abgeholt werden muß,
+                           bevor die 0-Routine beendet ist, muß SHard einen eigenen
                            Puffer implementieren:#off("i")# 
  
                                  hardwareinterrupt: 
@@ -878,7 +878,7 @@ minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gem
                                                  gib hardware interrupt frei ; 
                                                  input interrupt ; 
                                                  disable interrupt ; 
-                                                 WHILE shard puffer enth�lt noch
+                                                 WHILE shard puffer enthält noch
                                                  zeichen REP 
                                                    nimm zeichen aus shard puffer ; 
                                                    enable interrupt ; 
@@ -896,49 +896,49 @@ minals, Druckern, Plottern usw. ab. Stream-IO wird nur f�r die Kan�le 1...15 gem
           Eingang:         AL     Kanalnummer (1...15) 
                            CX     Anzahl auszugebender Zeichen 
                            DS:BX  Adresse der Zeichenkette 
-          Ausgang:         CX     Anzahl der �bernommenen Zeichen 
-                           C-Flag gesetzt <=> alle Zeichen �bernommen 
- 
-          Zweck:           Ausgabe einer Zeichenkette. Diese ist (m�glichst ganz) zwi-
-                           schenzupuffern, denn die Ausf�hrung von OUTPUT sollte kein
-                           Warten auf IO enthalten. Der Ausgabepuffer mu� mindestens
-                           50, besser 100 Zeichen fassen k�nnen. Durch eine Interrupt-
-                           logik oder etwas �quivalentes ist sicherzustellen, da� dieser
+          Ausgang:         CX     Anzahl der übernommenen Zeichen 
+                           C-Flag gesetzt <=> alle Zeichen übernommen 
+ 
+          Zweck:           Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwi­
+                           schenzupuffern, denn die Ausführung von OUTPUT sollte kein
+                           Warten auf IO enthalten. Der Ausgabepuffer muß mindestens
+                           50, besser 100 Zeichen fassen können. Durch eine Interrupt­
+                           logik oder etwas Äquivalentes ist sicherzustellen, daß dieser
                            Puffer parallel zur normalen Verarbeitung ausgegeben wird.
-                           Wenn die auszugebende Zeichenkette nicht vollst�ndig in den
-                           Puffer pa�t, sollten trotzdem so viele Zeichen wie m�glich
-                           �bernommen werden. Im weiteren Verlauf ruft EUMEL-0 dann
+                           Wenn die auszugebende Zeichenkette nicht vollständig in den
+                           Puffer paßt, sollten trotzdem so viele Zeichen wie möglich
+                           übernommen werden. Im weiteren Verlauf ruft EUMEL-0 dann
                            wieder OUTPUT mit dem Rest der Zeichenkette auf. 
  
           Hinweis:         OUTPUT kann mit CX=0 aufgerufen werden. Auch diese leere
-                           Operation mu� mit gesetztem C-Flag quittiert werden. 
+                           Operation muß mit gesetztem C-Flag quittiert werden. 
  
           Achtung:         #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte'
                            aufgerufen werden.#off("i")# 
  
           Vorschlag:       Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig
-                           ist, sollte vorgegaukelt werden, alle Zeichen seien ausgege-
-                           ben (CX unver�ndert und C-Flag gesetzt). 
+                           ist, sollte vorgegaukelt werden, alle Zeichen seien ausgege­
+                           ben (CX unverändert und C-Flag gesetzt). 
  
  
  
 #b("Terminals")#
 #goalpage("term")# 
  
-"Normale" #ib#Terminal#ie(1,", normales")#s k�nnen ohne weitere Unterst�tzung des SHards angeschlossen wer-
+"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen wer­
 den. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie#
-werden von den h�heren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard
-unabh�ngig sind, stehen automatisch alle so angepa�ten Terminaltypen allen EUMEL-
-Anwendern zur Verf�gung! 
+werden von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard
+unabhängig sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL-
+Anwendern zur Verfügung! 
 #foot# 
 #f#
 *) Siehe "EUMEL Benutzerhandbuch, Teil 3: Editor, 5. Zeichencode"#a##end# 
  
-F�r den Anschlu� eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt gear-
-beitet wird, kann man h�ufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). 
+Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt gear­
+beitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). 
  
-N�heres zu Terminaltypen und -anschl�ssen findet man im "EUMEL Systemhandbuch" unter
-den Stichw�rtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. 
+Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch" unter
+den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. 
  
  
  
@@ -946,19 +946,19 @@ den Stichw�rtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#of
 #goalpage("druck")# 
  
 #ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der Regel
-der Rechner aber schneller Zeichen senden als der Drucker drucken kann, m�ssen solche
-Ger�te in der Regel mit Flu�kontrolle angeschlossen werden (siehe S.#topage("fluss")#). 
+der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen solche
+Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). 
  
-Wenn Drucker oder Plotter �ber eine Parallelschnittstelle angeschlossen werden, kann man
-auf diesem Kanal m�glicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist
-dabei, da� 
+Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man
+auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist
+dabei, daß 
  
      a)   der Drucker einen eigenen Puffer hat und 
-     b)   der Puffer "schnell" gef�llt werden kann (< 0.1 ms/Zeichen). 
+     b)   der Puffer "schnell" gefüllt werden kann (< 0.1 ms/Zeichen). 
  
 Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten und
-die Zeichenkette direkt �ber die Parallelschnittstelle an den Drucker �bergeben. Wenn der
-Drucker 'Puffer voll' signalisiert, sollte die Zeichen�bernahme bei OUTPUT abgebrochen
+die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn der
+Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebrochen
 werden. *) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet werden!#off("i")# 
 #foot# 
 #f#
@@ -969,23 +969,23 @@ werden. *) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers
 #b("Exoten")#
 #goalpage("exot")# 
  
-Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, f�r die eine Umsetztabelle
-im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht n�tig ist (Beispiele:
-Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die soweit pro-
-grammierbar sind, da� sie den EUMEL-Zeichencode k�nnen). 
+Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetztabelle
+im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist (Beispiele:
+Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die soweit pro­
+grammierbar sind, daß sie den EUMEL-Zeichencode können). 
  
-F�r solche Terminals mu� in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden.
+Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden.
 Dieser wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch 1.7
 Seite 106) werden direkt dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden
 Besonderheiten: 
  
-Eingabeseitig werden zus�tzlich folgende Codezuordnungen getroffen: 
+Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: 
  
      Code     Funktion 
  
      7        SV   (Aktivierung: 'gib supervisor kommando:') 
      17       STOP (Ausgabe auf diesen Kanal wird gestoppt) 
-     23       WEITER (Ausgabe l�uft wieder weiter) 
+     23       WEITER (Ausgabe läuft wieder weiter) 
      4        INFO (System geht in Debugger, falls Debugoption) 
  
  
@@ -993,27 +993,27 @@ Eingabeseitig werden zus�tzlich folgende Codezuordnungen getroffen:
 #bb("5.2 ","Block-IO")#
 #goalpage("block")# 
  
-�ber Block-IO wickelt das System die Zugriffe zum Pagingmedium und zum Archiv ab.
-Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. f�r Rechnerkopp-
-lung zuzulassen. Die Kanalnummer in Reg. AL unterscheidet diese F�lle. Au�er beim Paging
+Über Block-IO wickelt das System die Zugriffe zum Pagingmedium und zum Archiv ab.
+Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopp­
+lung zuzulassen. Die Kanalnummer in Reg. AL unterscheidet diese Fälle. Außer beim Paging
 (AL=0) wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout' induziert. 
  
-Bei Block-IO wird immer ein 512 Byte gro�er Hauptspeicherbereich mit �bergeben. Dieser
-kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es mu� keine Umpufferung
+Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben. Dieser
+kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Umpufferung
 erfolgen. 
  
-Dieser Hauptspeicherbereich darf nur bei BLOCKIN ver�ndert werden. 
+Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. 
  
-SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zur�ckgeben, wenn die ver-
-langte Operation abgeschlossen ist. Treten w�hrend der Operation Wartezeiten auf, so mu�
+SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die ver­
+langte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so muß
 SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiterlaufen
 lassen kann. 
  
-EUMEL-0 definiert bestimmte Funktionen f�r Hintergrund (Kanal 0) und Archiv (Kanal 31).
-Operationen auf anderen Kan�len kann SHard nach Belieben implementieren und deren
-Leistung seinen Installationen �ber ELAN-Pakete zur Verf�gung stellen. Das System vergibt
-auch in Zukunft f�r den Parameter in Register CX nur positive Werte (Bit 7 von CH = 0).
-Der SHard kann selbst negative Codes einf�hren. 
+EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31).
+Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren
+Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System vergibt
+auch in Zukunft für den Parameter in Register CX nur positive Werte (Bit 7 von CH = 0).
+Der SHard kann selbst negative Codes einführen. 
  
  
      #d("BLOCKIN")#
@@ -1022,18 +1022,18 @@ Der SHard kann selbst negative Codes einf�hren.
                            CX     Parameter 1 
                            DX     Parameter 2 
                            DS:BX  Adresse des Hauptspeicherbereichs 
-          Ausgang:         AL     undefiniert (darf also ver�ndert werden) 
-                           CX     R�ckmeldecode 
-                           DS:BX  darf ver�ndert werden 
+          Ausgang:         AL     undefiniert (darf also verändert werden) 
+                           CX     Rückmeldecode 
+                           DS:BX  darf verändert werden 
  
                            Der Inhalt des Hauptspeicherbereichs (<DS:BX>... <DS:
-                           BX> +511) darf ver�ndert sein. 
+                           BX> +511) darf verändert sein. 
  
-          Zweck:           "Einlesen" von Bl�cken. Die genaue Wirkung h�ngt vom
+          Zweck:           "Einlesen" von Blöcken. Die genaue Wirkung hängt vom
                            Parameter und dem Kanal ab. 
  
           Vorschlag:       Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig
-                           ist, sollte die R�ckmeldung -1 in CX geliefert werden. 
+                           ist, sollte die Rückmeldung -1 in CX geliefert werden. 
  
  
      #d("BLOCKOUT")#
@@ -1042,18 +1042,18 @@ Der SHard kann selbst negative Codes einf�hren.
                            CX     Parameter 1 
                            DX     Parameter 2 
                            DS:BX  Adresse des Hauptspeicherbereichs 
-          Ausgang:         AL     undefiniert (darf also ver�ndert werden) 
-                           CX     R�ckmeldecode 
-                           DS:BX  darf ver�ndert werden 
+          Ausgang:         AL     undefiniert (darf also verändert werden) 
+                           CX     Rückmeldecode 
+                           DS:BX  darf verändert werden 
  
-                           Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# ver�ndert
+                           Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert
                            werden! 
  
-          Zweck:           "Ausgeben" von Bl�cken. Die genaue Wirkung h�ngt vom
+          Zweck:           "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom
                            Parameter und dem Kanal ab. 
  
-          Vorschlag:       Falls der Kanal nicht existiert bzw. BLOCKOUT darauf un-
-                           sinnig ist, sollte die R�ckmeldung -1 in CX geliefert wer-
+          Vorschlag:       Falls der Kanal nicht existiert bzw. BLOCKOUT darauf un­
+                           sinnig ist, sollte die Rückmeldung -1 in CX geliefert wer­
                            den. 
  
  
@@ -1061,18 +1061,18 @@ Der SHard kann selbst negative Codes einf�hren.
  
           Ausgang:         Alle Register undefiniert! 
  
-          Zweck:           Diese Routine ist bei 'blockin' oder 'blockout' dann aufzu-
+          Zweck:           Diese Routine ist bei 'blockin' oder 'blockout' dann aufzu­
                            rufen, wenn SHard im Augenblick nichts zu tun hat. Durch den
-                           Aufruf von 'warte' erhalten andere Systemteile die M�glichkeit,
+                           Aufruf von 'warte' erhalten andere Systemteile die Möglichkeit,
                            weiter zu arbeiten. Ein 'warte' kann bis zu ca. 1/4 Sekunde
                            Zeit aufnehmen. 'warte' darf nicht in Interruptroutinen und
-                           Stream-IO verwendet werden! 'warte' zerst�rt alle Register,
-                           bis auf die Segmentregister CS und SS! SHard mu� davon
-                           ausgehen, da� 'warte' seinerseits andere SHard-Kompo-
+                           Stream-IO verwendet werden! 'warte' zerstört alle Register,
+                           bis auf die Segmentregister CS und SS! SHard muß davon
+                           ausgehen, daß 'warte' seinerseits andere SHard-Kompo­
                            nenten aufruft. 
  
  
-Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht wer-
+Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht wer­
 den: 
  
  
@@ -1143,54 +1143,54 @@ Eingangsparametern versorgt:
                            Der Hauptspeicherbereich (<DS:BX>... <DS:BX>+511) ist
                            auf den angegebenen Block zu schreiben. 
  
-Als R�ckmeldungen sind zu liefern:#goalpage("errcod")# 
+Als Rückmeldungen sind zu liefern:#goalpage("errcod")# 
  
-          0                Operation korrekt ausgef�hrt. 
-          1                Manuell behebbarer Fehler (z.B. Laufwerkt�r offen) 
+          0                Operation korrekt ausgeführt. 
+          1                Manuell behebbarer Fehler (z.B. Laufwerktür offen) 
           2                Permanenter Fehler (z.B. Daten nicht lesbar) 
           3                Versorgungsfehler (zu hohe Blocknummer) 
  
-Zus�tzlich zu der R�ckmeldung mu� bei CX <> 0 in DS:BX die Adresse eines Fehlerstrings
-(L�ngenbyte + Fehlertext) geliefert werden. *) 
+Zusätzlich zu der Rückmeldung muß bei CX <> 0 in DS:BX die Adresse eines Fehlerstrings
+(Längenbyte + Fehlertext) geliefert werden. *) 
 #foot# 
 #f#
-*) Diese Zusatzr�ckmeldung ist nur f�r die BLOCKIN/OUT Aufrufe auf Kanal 0/31 von Bedeutung. Sie wird nur von
+*) Diese Zusatzrückmeldung ist nur für die BLOCKIN/OUT Aufrufe auf Kanal 0/31 von Bedeutung. Sie wird nur von
 EUMEL-0 beim Paging und im Hardwaretest ausgewertet.#a##end# 
  
-#dx("Fehlerwiederholungen")#:      Das EUMEL-System f�hrt von sich aus Fehlerwiederholungen
+#dx("Fehlerwiederholungen")#:      Das EUMEL-System führt von sich aus Fehlerwiederholungen
                            beim Hintergrund- und beim Archivzugriff durch. SHard sollte
                            deshalb im Fehlerfall die Operation nicht selbst wiederholen,
-                           sondern einen Lese/ Schreibfehler zur�ckmelden. So werden
+                           sondern einen Lese/ Schreibfehler zurückmelden. So werden
                            dem EUMEL-System auch Soft-Errors gemeldet. In manchen
-                           F�llen soll vor einem erneuten Lese- oder Schreibversuch der
-                           Arm auf Spur 0 positioniert werden o.�. Um das zu erreichen,
-                           sollte SHard diese "Reparaturaktion" direkt im Anschlu� an den
-                           fehlerhaften Versuch durchf�hren. 
+                           Fällen soll vor einem erneuten Lese- oder Schreibversuch der
+                           Arm auf Spur 0 positioniert werden o.ä. Um das zu erreichen,
+                           sollte SHard diese "Reparaturaktion" direkt im Anschluß an den
+                           fehlerhaften Versuch durchführen. 
  
-#dx("Kontrollesen")#:              Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, mu�
-                           das allerdings vom SHard durchgef�hrt werden. In der Regel
-                           reicht es dazu, den geschriebenen Block "ohne Datentrans-
-                           port" zu lesen, so da� nur CRC �berpr�ft wird. 
+#dx("Kontrollesen")#:              Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, muß
+                           das allerdings vom SHard durchgeführt werden. In der Regel
+                           reicht es dazu, den geschriebenen Block "ohne Datentrans­
+                           port" zu lesen, so daß nur CRC überprüft wird. 
  
-Will SHard weitere Archivlaufwerke zur Verf�gung stellen, so kann er daf�r Kanalnummern
+Will SHard weitere Archivlaufwerke zur Verfügung stellen, so kann er dafür Kanalnummern
 (30,29..) vergeben. Auf ELAN-Ebene kann die archivierende Task durch 'continue (x)' das
 Laufwerk 'x' ansteuern. 
  
 Hinweis:  Das System versucht Hintergrund und Archiv parallel zu betreiben, d.h. wenn
-          SHard bei der Hintergrundbehandlung das UP 'warte' aufruft, kann 'warte' sei-
+          SHard bei der Hintergrundbehandlung das UP 'warte' aufruft, kann 'warte' sei­
           nerseits die Archivbehandlung des SHards aufrufen. Wenn beides z.B. denselben
-          Floppykontroller benutzt, mu� SHard sicherstellen, da� das gut geht (z.B. durch
+          Floppykontroller benutzt, muß SHard sicherstellen, daß das gut geht (z.B. durch
           Semaphoren). 
  
  
 Sollen auch #on("b")#Disketten nach #ib#DIN 66 239#ie##off("b")# auf dem Archivkanal gelesen und geschrieben
-werden k�nnen, m�ssen auf Kanal 31 zus�tzlich Bl�cke mit 'deleted data mark' gelesen und
-geschrieben werden k�nnen. Daf�r kann BLOCKIN (beim Lesen einer Diskette) als weitere
-R�ckmeldung liefern: 
+werden können, müssen auf Kanal 31 zusätzlich Blöcke mit 'deleted data mark' gelesen und
+geschrieben werden können. Dafür kann BLOCKIN (beim Lesen einer Diskette) als weitere
+Rückmeldung liefern: 
  
           4                'Deleted data mark' gelesen. 
  
-Ausgabeseitig wird ein entsprechendes BLOCKOUT ben�tigt: 
+Ausgabeseitig wird ein entsprechendes BLOCKOUT benötigt: 
  
           #on("b")#BLOCKOUT#off("b")#         AL     31 
                            CH     40h 
@@ -1202,19 +1202,19 @@ Ausgabeseitig wird ein entsprechendes BLOCKOUT ben�tigt:
                            mit der Kennung 'deleted data mark' auf den angegebenen
                            Block zu schreiben. 
  
-Anmerkung:  Diese Funktion mu� nur implementiert werden, wenn Disketten nach DIN 66 239
-            beschrieben k�nnen werden sollen. 
+Anmerkung:  Diese Funktion muß nur implementiert werden, wenn Disketten nach DIN 66 239
+            beschrieben können werden sollen. 
  
  
  
 #b("Block-IO zur MS-DOS-Partition")#
 #goalpage("bmsdosp")# 
  
-Auf EUMEL-Rechnern, die mit einer Festplatte ausger�stet sind, kann man einen Teil der
-Platte als MS-DOS-Partition und einen anderen als EUMEL-Partition reservieren. F�r den
-Datenaustausch auf Dateiebene existiert EUMEL-Software, die �ber den Kanal 29 auf die
-MS-DOS-Partition zugreift. Falls SHard dieses unterst�tzen will, mu� er entsprechende
-BLOCKIN/OUT-Operationen zur Verf�gung stellen. Diese entsprechen den Operationen auf
+Auf EUMEL-Rechnern, die mit einer Festplatte ausgerüstet sind, kann man einen Teil der
+Platte als MS-DOS-Partition und einen anderen als EUMEL-Partition reservieren. Für den
+Datenaustausch auf Dateiebene existiert EUMEL-Software, die über den Kanal 29 auf die
+MS-DOS-Partition zugreift. Falls SHard dieses unterstützen will, muß er entsprechende
+BLOCKIN/OUT-Operationen zur Verfügung stellen. Diese entsprechen den Operationen auf
 Kanal 0: 
  
           #on("b")#BLOCKIN#off("b")#          AL     29 
@@ -1225,9 +1225,9 @@ Kanal 0:
  
                            Der angegebene 512-Byte-Block ist in den Hauptspeicher
                            ab <DS:BX> einzulesen. Hier bezieht sich die Blocknummer
-                           auf die MS-DOS-Partition. Dabei mu� Block 0 derjenige
-                           sein, der den Urladesektor der MS-DOS-Partition enth�lt.
-                           (Hier steht der Bios-Parameterblock.) Die weiteren Bl�cke
+                           auf die MS-DOS-Partition. Dabei muß Block 0 derjenige
+                           sein, der den Urladesektor der MS-DOS-Partition enthält.
+                           (Hier steht der Bios-Parameterblock.) Die weiteren Blöcke
                            werden genauso wie in der von MS-DOS verwendeten
                            Numerierung relativ zu diesem Urladesektor adressiert. 
  
@@ -1238,32 +1238,32 @@ Kanal 0:
                            DS:BX  Hauptspeicheradresse 
  
                            Der Hauptspeicherbereich (<DS:BX>... <DS:BX>+511) ist
-                           auf den angegebenen Block zu schreiben. F�r die Blocknu-
+                           auf den angegebenen Block zu schreiben. Für die Blocknu­
                            merierung gilt das oben beschreibenen. 
  
-Als R�ckmeldungen sind zu liefern: 
+Als Rückmeldungen sind zu liefern: 
  
-          0                Operation korrekt ausgef�hrt. 
-          1                Manuell behebbarer Fehler (z.B. Laufwerkt�r offen) 
+          0                Operation korrekt ausgeführt. 
+          1                Manuell behebbarer Fehler (z.B. Laufwerktür offen) 
           2                Permanenter Fehler (z.B. Daten nicht lesbar) 
           3                Versorgungsfehler (zu hohe Blocknummer) 
  
-         Wichtig:          Wird ein Block angesprochen, der nicht zur MS-DOS-Parti-
-                           tion geh�rt, so mu� 'Versorgungsfehler' (3) gemeldet werden. 
+         Wichtig:          Wird ein Block angesprochen, der nicht zur MS-DOS-Parti­
+                           tion gehört, so muß 'Versorgungsfehler' (3) gemeldet werden. 
  
  
-Anmerkung:    Diese Funktionen m�ssen nur implementiert werden, wenn Datenaustausch
-              mit MS-DOS-Partitionen auf Plattenmaschinen unterst�tzt werden soll. 
+Anmerkung:    Diese Funktionen müssen nur implementiert werden, wenn Datenaustausch
+              mit MS-DOS-Partitionen auf Plattenmaschinen unterstützt werden soll. 
  
  
 #bb("5.3 ","IO-Steuerung")#
 #goalpage("iocontrol")# 
  
-Die IO-Steuerung erlaubt Steuerung und Zustandsabfragen der Kan�le. IO-Steuerung wird
-(au�er bei Kanal 0) auch durch 'control' in ELAN induziert. 
+Die IO-Steuerung erlaubt Steuerung und Zustandsabfragen der Kanäle. IO-Steuerung wird
+(außer bei Kanal 0) auch durch 'control' in ELAN induziert. 
  
 Der Funktionscode in CX unterliegt denselben Konventionen wie bei Block-IO, d.h. das
-System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes f�r
+System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes für
 Sonderzwecke vorsehen. 
  
  
@@ -1273,14 +1273,14 @@ Sonderzwecke vorsehen.
                            CX    Funktionscode 1 
                            DX    Funktionscode 2 
                            BX    Funktionscode 3 
-          Ausgang:         CX    R�ckmeldung 
-                           AL    darf ver�ndert werden, in einigen F�llen zus�tzliche
-                                 R�ckmeldung 
-                           C-Flag (in einigen F�llen zus�tzliche Meldung) 
+          Ausgang:         CX    Rückmeldung 
+                           AL    darf verändert werden, in einigen Fällen zusätzliche
+                                 Rückmeldung 
+                           C-Flag (in einigen Fällen zusätzliche Meldung) 
  
-          Zweck:           abh�ngig von 'Funktionscode 1' (s.u.) 
+          Zweck:           abhängig von 'Funktionscode 1' (s.u.) 
  
-Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL: 
+Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: 
  
      #d("IOCONTROL ""typ""")#
       
@@ -1288,19 +1288,19 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
                            CX    1 
           Ausgang:         CX    Kanaltyp 
  
-          Zweck:           Informiert EUMEL-0, welche IO f�r den angegebenen Kanal
-                           sinnvoll ist. Die R�ckmeldung in CX wird bitweise interpre-
+          Zweck:           Informiert EUMEL-0, welche IO für den angegebenen Kanal
+                           sinnvoll ist. Die Rückmeldung in CX wird bitweise interpre­
                            tiert: 
  
                            Bit 0 gesetzt  <=>      'inputinterrupt' kann kommen. 
                            Bit 1 gesetzt  <=>      OUTPUT ist sinnvoll. 
                            Bit 2 gesetzt  <=>      BLOCKIN ist sinnvoll. 
                            Bit 3 gesetzt  <=>      BLOCKOUT ist sinnvol. 
-                           Bit 4 gesetzt  <=>      IOCONTROL "format" ist sinn-
+                           Bit 4 gesetzt  <=>      IOCONTROL "format" ist sinn­
                                                    voll. 
  
-          Hinweis:         #on("i")#Trotz dieser Informationsm�glichkeit wird nicht garantiert, da�
-                           nur sinnvolle Operationen f�r den Kanal aufgerufen werden.#off("i")# 
+          Hinweis:         #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß
+                           nur sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# 
  
  
      #d("IOCONTROL ""frout""")#
@@ -1308,31 +1308,31 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
  
           Eingang:         AL    Kanalnummer (1...15) 
                            CX    2 
-          Ausgang:         CX    Anzahl Zeichen, die n�chster OUTPUT �bernimmt 
+          Ausgang:         CX    Anzahl Zeichen, die nächster OUTPUT übernimmt 
                            C-Flag gesetzt <=> Puffer leer 
  
-          Zweck:           Liefert Information �ber die Belegung des Puffers. Diese
+          Zweck:           Liefert Information über die Belegung des Puffers. Diese
                            Information wird von EUMEL-0 zum Scheduling benutzt. 
  
-          Achtung:         #on("i")#Wenn EUMEL-0 l�ngere Zeit kein OUTPUT gemacht hat,
-                           mu� irgendwann CX > 49 gemeldet werden.#off("i")# 
+          Achtung:         #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat,
+                           muß irgendwann CX > 49 gemeldet werden.#off("i")# 
  
-          Hinweis:         Unter Ber�cksichtigung des oben Gesagten darf "gelogen"
-                           werden. Man kann z.B. immer 50 in CX zur�ckmelden, mu�
+          Hinweis:         Unter Berücksichtigung des oben Gesagten darf "gelogen"
+                           werden. Man kann z.B. immer 50 in CX zurückmelden, muß
                            dann aber schlechtere Nutzung der CPU bei Multi-User-
                            Systemen in Kauf nehmen. 
  
                            Falls auf dem angegebenen Kanal ein Drucker mit eigenem
-                           Puffer �ber Parallelschnittstelle angeschlossen ist (siehe S.#topage("druck")#
+                           Puffer über Parallelschnittstelle angeschlossen ist (siehe S.#topage("druck")#
                            ) und man auf einen SHard-internen Puffer verzichtet hat,
-                           sollte bei 'Druckerpuffer voll' 0 in CX und 'NC' zur�ckge-
-                           meldet werden. Wenn aber Zeichen �bernommen werden
-                           k�nnen, sollte 50 in CX und 'C-Flag gesetzt' gemeldet wer-
+                           sollte bei 'Druckerpuffer voll' 0 in CX und 'NC' zurückge­
+                           meldet werden. Wenn aber Zeichen übernommen werden
+                           können, sollte 50 in CX und 'C-Flag gesetzt' gemeldet wer­
                            den. 
  
-          Vorschlag:       Falls der Kanal nicht existiert oder nicht f�r Stream-IO zur
-                           Verf�gung steht, sollten 200 in CX und C-Flag gesetzt zu-
-                           r�ckgemeldet werden. 
+          Vorschlag:       Falls der Kanal nicht existiert oder nicht für Stream-IO zur
+                           Verfügung steht, sollten 200 in CX und C-Flag gesetzt zu­
+                           rückgemeldet werden. 
  
  
      #d("IOCONTROL ""weiter""")#
@@ -1342,20 +1342,20 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
                            CX    4 
           Ausgang:         - 
  
-          Zweck:           Das System ruft "weiter" f�r den in AL angegebenen Kanal
+          Zweck:           Das System ruft "weiter" für den in AL angegebenen Kanal
                            auf, wenn es wieder Eingabezeichen puffern kann. (siehe
-                           auch: Flu�kontrolle S.#topage("fluss")#) 
+                           auch: Flußkontrolle S.#topage("fluss")#) 
  
           Hinweis:         "weiter" wird von EUMEL-0 auch immer dann aufgerufen,
-                           wenn ein Proze� auf dem angegebenen Kanal auf Eingabe
-                           wartet und keine Zeichen mehr gepuffert sind. Wenn der be-
+                           wenn ein Prozeß auf dem angegebenen Kanal auf Eingabe
+                           wartet und keine Zeichen mehr gepuffert sind. Wenn der be­
                            troffene Kanal von sich aus keine Interrupts erzeugt, kann
                            SHard dies benutzen, um durch Aufruf von 'inputinterrupt' ein
                            Eingabezeichen zuzustellen. 
-                           #on("i")#Diese Betriebsart sollte nicht f�r normale Terminalkan�le
+                           #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle
                            eingesetzt werden. Denn dann wird die SV-Taste nur an
-                           EUMEL-0 zugestellt, wenn ein Proze� auf diesem Kanal auf
-                           Eingabe wartet. Somit sind in dieser Betriebsart CPU-inten-
+                           EUMEL-0 zugestellt, wenn ein Prozeß auf diesem Kanal auf
+                           Eingabe wartet. Somit sind in dieser Betriebsart CPU-inten­
                            sive Endlosschleifen nicht normal abbrechbar!#off("i")# 
  
  
@@ -1363,22 +1363,22 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
       
           Eingang:         AL    Kanalnummer (0...31) 
                            CX    5 
-                           DX    Schl�ssel 
-          Ausgang:         CX    Anzahl Bl�cke MOD 65536 
-                           AL    Anzahl Bl�cke DIV 65536 
+                           DX    Schlüssel 
+          Ausgang:         CX    Anzahl Blöcke MOD 65536 
+                           AL    Anzahl Blöcke DIV 65536 
  
-          Zweck:           EUMEL-0 ruft 'size' auf, um die Anzahl Bl�cke zu erfahren,
-                           die ein Block-IO-Kanal verkraften kann (Gr��e von Hin-
+          Zweck:           EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren,
+                           die ein Block-IO-Kanal verkraften kann (Größe von Hin­
                            tergrund und Archiven). Bei Archivlaufwerken, die mehrere
-                           Formate bearbeiten k�nnen, dient dieser Aufruf auch zum
-                           Einstellen des Formats f�r die folgenden blockin/blockout-
-                           Operationen anhand des Schl�ssels. 
+                           Formate bearbeiten können, dient dieser Aufruf auch zum
+                           Einstellen des Formats für die folgenden blockin/blockout-
+                           Operationen anhand des Schlüssels. 
  
-          Schl�ssel:       0     Wenn m�glich 'erkennend', sonst 'standard'. Im ersten
+          Schlüssel:       0     Wenn möglich 'erkennend', sonst 'standard'. Im ersten
                                  Fall erkennt SHard das Format der eingelegten Diskette
                                  und stellt dieses ein. 
  
-                           Die weiteren Schl�ssel sind stets definierend. Dabei gibt es die
+                           Die weiteren Schlüssel sind stets definierend. Dabei gibt es die
                            EUMEL-Standardformate: 
  
                                  1     5" 2D-40, Sektor 1..9, 512 Bytes 
@@ -1387,7 +1387,7 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
                                  10    8" 1D-77, Sektor 0..15, 512 Bytes 
                                  11    8" 2D-77, Sektor 0..15, 512 Bytes 
  
-                           Zus�tzlich kann man s�mtliche Spezialformate angeben: 
+                           Zusätzlich kann man sämtliche Spezialformate angeben: 
  
                              8192 * laufwerkstyp     1: 8" 
                                                      2: 5" 
@@ -1409,30 +1409,30 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
                                                      1: 256 
                                                      2: 512 
  
-                           +   32 * erster sektor    0: #0 
-                                                     1: #1 
+                           +   32 * erster sektor    0: \#0 
+                                                     1: \#1 
  
                            +        sektoren pro spur   0 ... 31 
  
                            So bezeichnet '8762' das Format 8" 1S-77 Sektor 1..26 a
                            128 Bytes. 
  
-          Anmerkung:       SHard sollte alle physisch m�glichen EUMEL-Standard-
-                           formate unterst�tzen. Von den Spezialformaten sollten die f�r
-                           den Datenaustausch wichtigen Formate ber�cksichtigt werden.
-                           Die EUMEL-Standardformate (1,2,3,10,11) sollten auch �ber
+          Anmerkung:       SHard sollte alle physisch möglichen EUMEL-Standard­
+                           formate unterstützen. Von den Spezialformaten sollten die für
+                           den Datenaustausch wichtigen Formate berücksichtigt werden.
+                           Die EUMEL-Standardformate (1,2,3,10,11) sollten auch über
                            die entsprechenden analytischen Codes erreicht werden. (Z.B.
                            bezeichnen 1 und 21929 dasselbe Format.) Die Numerierung
-                           der Bl�cke ist in jedem Fall seitenorientiert, d.h. entsprechend
+                           der Blöcke ist in jedem Fall seitenorientiert, d.h. entsprechend
                            den Standardformaten (siehe S.#topage("arch")#). 
  
-          Hinweis:         Bei Archiven wird 'size' aufgerufen, nachdem der Archivtr�-
+          Hinweis:         Bei Archiven wird 'size' aufgerufen, nachdem der Archivträ­
                            ger eingelegt wurde. D.h. SHard hat die Gelegenheit, die
-                           Gr��e anhand des eingelegten Archivtr�gers zu bestimmen
+                           Größe anhand des eingelegten Archivträgers zu bestimmen
                            (z.B. ob single- oder doublesided). 
  
           Vorschlag:       Diese Funktion sollte auf nicht vorhandenen und den
-                           Stream-IO-Kan�len 0 liefern. Sie mu� aber mindestens auf
+                           Stream-IO-Kanälen 0 liefern. Sie muß aber mindestens auf
                            Kanal 0 (Hintergrund) und Kanal 31 (Archiv) "echte" Werte
                            liefern. 
  
@@ -1444,17 +1444,17 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
       
           Eingang:         AL    Kanalnummer (0...31) 
                            CX    7 
-                           DX    Schl�ssel 
+                           DX    Schlüssel 
           Ausgang:         CX    Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) 
  
           Zweck:           Dient zum Formatieren einen Mediums. Diese Funktion kann
-                           f�r jeden Kanal leer implementiert sein ('ret'). Sie sollte aber
+                           für jeden Kanal leer implementiert sein ('ret'). Sie sollte aber
                            "formatierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem
                            Kanal die "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls
-                           (bei Diskettenlaufwerken) mehrere Formate m�glich sind,
-                           bestimmt der Schl�ssel das gew�nschte Format. 
+                           (bei Diskettenlaufwerken) mehrere Formate möglich sind,
+                           bestimmt der Schlüssel das gewünschte Format. 
  
-          Schl�ssel:       wie bei IOCONTROL "size" 
+          Schlüssel:       wie bei IOCONTROL "size" 
  
           Achtung:         #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die
                            0-Routine 'warte' aufgerufen werden.#off("i")# 
@@ -1464,34 +1464,34 @@ Das System verlangt folgende Informations- und Steuerleistungen �ber IOCONTROL:
 #b("Konfigurierung serieller Schnittstellen")#
 #goalpage("v24")# 
  
-Bei Kan�len, die hardwarem��ig auf #ib#serielle Schnittstellen#ie# (#ib#V.24#ie#) zur�ckgef�hrt werden, sind
-in der Regel die Gr��en 
+Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib#V.24#ie#) zurückgeführt werden, sind
+in der Regel die Größen 
  
           - #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) 
-          - #ib#Zeichenl�nge#ie# (7 Bits, 8 Bits) 
-          - #ib#Parit�t#ie# (keine, gerade, ungerade) 
+          - #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) 
+          - #ib#Parität#ie# (keine, gerade, ungerade) 
  
-einstellbar. Daf�r mu� SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verf�-
+einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­
 gung stellen. Diese werden in zwei Modi benutzt: 
  
      a) #on("b")#einstellend#off("b")# 
-        L�uft der aufrufende EUMEL-Proze� auf dem privilegierten Steuerkanal (AL = 32),
-        wird der als Parameter mit �bergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte
-        eingestellt, sofern das m�glich ist. 
+        Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (AL = 32),
+        wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte
+        eingestellt, sofern das möglich ist. 
  
      b) #on("b")#abfragend#off("b")# 
-        L�uft der aufrufende EUMEL-Proze� nicht auf Kanal 32 (AL <> 32), wird le-
-        diglich abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die �bergebenen Werte eingestellt
-        werden k�nnte. 
+        Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (AL <> 32), wird le­
+        diglich abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt
+        werden könnte. 
  
-Aufgrund des zweiten Modus k�nnen die h�heren EUMEL-Ebenen dem Anwender bei der
+Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der
 Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das
 nutzt z.B. das Standard-Konfigurationsprogramm aus. 
  
-Hinweis:  Bei einigen Kan�len (z.B. bei einem integrierten Terminal oder einer Parallel-
-          schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen k�nnen sie nur
-          hardwarem��ig vorgenommen werden (Jumper, Dip Switches). In allen diesen
-          F�llen mu� SHard bei allen Einstellungen 'unm�glich' melden. (Standardm��ig
+Hinweis:  Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­
+          schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur
+          hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen
+          Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig
           wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht
           danach gefragt.) 
  
@@ -1501,17 +1501,17 @@ Hinweis:  Bei einigen Kan�len (z.B. bei einem integrierten Terminal oder einer P
           Eingang:         AL    eigener Kanal (1...15 / 32) 
                            CX    8 
                            DX    adressierter Kanal 
-                           BX    Schl�ssel 
-          Ausgang:         CX    R�ckmeldung (0 = ok, 1 = nicht m�glich) 
+                           BX    Schlüssel 
+          Ausgang:         CX    Rückmeldung (0 = ok, 1 = nicht möglich) 
  
-          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru-
-                           fen, wird die angegebene Baudrate f�r den durch Register DX
-                           adressierten Kanal eingestellt, falls das m�glich ist. 
-                           Wird diese Routine auf einem anderen Kanal als 32 aufge-
+          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­
+                           fen, wird die angegebene Baudrate für den durch Register DX
+                           adressierten Kanal eingestellt, falls das möglich ist. 
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
                            rufen, informiert sie den Aufrufer lediglich, ob eine derartige
-                           Einstellung des adressierten Kanals m�glich w�re. 
+                           Einstellung des adressierten Kanals möglich wäre. 
  
-          Schl�ssel:             1       50 Baud 
+          Schlüssel:             1       50 Baud 
                                  2       75 Baud 
                                  3      110 Baud 
                                  4      134.5 Baud 
@@ -1528,13 +1528,13 @@ Hinweis:  Bei einigen Kan�len (z.B. bei einem integrierten Terminal oder einer P
                                 15    19200 Baud 
                                 16    38400 Baud 
  
-          Anmerkung:       In der Regel werden nicht alle Baudraten vom SHard unter-
-                           st�tzt werden. Bei V.24 Schnittstellen sollten aber minde-
-                           stens 2400, 4800 und 9600 Baud zur Verf�gung stehen,
+          Anmerkung:       In der Regel werden nicht alle Baudraten vom SHard unter­
+                           stützt werden. Bei V.24 Schnittstellen sollten aber minde­
+                           stens 2400, 4800 und 9600 Baud zur Verfügung stehen,
                            besser auch 300, 600, 1200 und 19200 Baud. 
  
           Hinweis:         Falls SHard-spezifisch weitere Baudraten implementiert
-                           werden sollen, darf SHard hierf�r negative Schl�sselwerte
+                           werden sollen, darf SHard hierfür negative Schlüsselwerte
                            (Register BX) vergeben. 
  
  
@@ -1543,85 +1543,85 @@ Hinweis:  Bei einigen Kan�len (z.B. bei einem integrierten Terminal oder einer P
           Eingang:         AL    eigener Kanal (1...15 / 32) 
                            CX    9 
                            DX    adressierter Kanal 
-                           BX    Schl�ssel 
-          Ausgang:         CX    R�ckmeldung (0 = ok, 1 = nicht m�glich) 
- 
-          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru-
-                           fen, wird die angegebene Zeichenl�nge (Bits pro Zeichen) und
-                           Parit�t f�r den durch Register DX adressierten Kanal einge-
-                           stellt, falls das m�glich ist. 
-                           Wird diese Routine auf einem anderen Kanal als 32 aufge-
+                           BX    Schlüssel 
+          Ausgang:         CX    Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­
+                           fen, wird die angegebene Zeichenlänge (Bits pro Zeichen) und
+                           Parität für den durch Register DX adressierten Kanal einge­
+                           stellt, falls das möglich ist. 
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
                            rufen, informiert sie den Aufrufer lediglich, ob eine derartige
-                           Einstellung des adressierten Kanals m�glich w�re. 
+                           Einstellung des adressierten Kanals möglich wäre. 
  
  
-          Schl�ssel:       stop * 32 + par * 8 + (bit - 1) 
+          Schlüssel:       stop * 32 + par * 8 + (bit - 1) 
  
                            stop:     0    1 Stopbit 
                                      1    1.5 Stopbits 
                                      2    2 Stopbits 
  
-                           par:      0    keine Parit�t 
-                                     1    ungerade Parit�t 
-                                     2    gerade Parit�t 
+                           par:      0    keine Parität 
+                                     1    ungerade Parität 
+                                     2    gerade Parität 
  
                            bit:      1...8 Bits pro Zeichen 
  
  
           Anmerkung:       In der Regel werden nicht alle Kombinationen vom SHard
-                           unterst�tzt werden. Bei V.24 Schnittstellen sollten aber m�g-
-                           lichst 1 Stopbit, 7 und 8 Bits pro Zeichen und alle drei Pari-
-                           t�tseinstellungen zur Verf�gung stehen. 
+                           unterstützt werden. Bei V.24 Schnittstellen sollten aber mög­
+                           lichst 1 Stopbit, 7 und 8 Bits pro Zeichen und alle drei Pari­
+                           tätseinstellungen zur Verfügung stehen. 
  
           Hinweis:         Falls SHard-spezifisch weitere Einstellungen implementiert
-                           werden sollen, darf SHard hierf�r negative Schl�sselwerte
+                           werden sollen, darf SHard hierfür negative Schlüsselwerte
                            (Register BX) vergeben. 
  
  
  
  
-#b("Flu�kontrolle")#
+#b("Flußkontrolle")#
 #goalpage("fluss")# 
  
-Die stromorientierten Kan�le (1...15) werden nicht nur zum Anschlu� schneller Ger�te (wie
-Terminals) verwendet, sondern auch, um langsame Ger�te (wie Drucker) anzuschlie�en, die
-die Daten u.U. nicht so schnell �bernehmen k�nnen, wie sie der Rechner schickt. Dabei ist
-auf eine geeignete Flu�kontrolle zu achten (nicht schneller senden, als der Andere emp-
+Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie
+Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die
+die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei ist
+auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere emp­
 fangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung. Hier
-ist in der Regel sogar zweiseitige Flu�kontrolle notwendig. 
+ist in der Regel sogar zweiseitige Flußkontrolle notwendig. 
  
-Als Flu�kontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt-
-stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das letztere kann auch bei Parallel-
+Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­
+stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das letztere kann auch bei Parallel­
 schnittstellen eingesetzt werden. 
  
-Zur eingabeseitigen Flu�kontrollsteuerung kann SHard die R�ckmeldung der 0-Routine
+Zur eingabeseitigen Flußkontrollsteuerung kann SHard die Rückmeldung der 0-Routine
 'inputinterrupt' (siehe S.#topage("inp")#), die "stop" signalisieren kann, und die IOCONTROL-Funktion
 "weiter" (siehe S.#topage("weiter")#)verwenden: 
  
-Allersp�testens bei der 'inputinterrupt'-R�ckmeldung AL=0 mu� SHard 
+Allerspätestens bei der 'inputinterrupt'-Rückmeldung AL=0 muß SHard 
 auf der V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XON senden
 (oder 
-weiter einlaufenden Input selbst zwischenpuffern). Dadurch wird bei den meisten Fremd-
+weiter einlaufenden Input selbst zwischenpuffern). Dadurch wird bei den meisten Fremd­
 rechnern ein weiteres Senden unterbrochen, sofern (im ersten Fall) das Signal 'REQUEST
 TO SEND' dort mit dem V.24-Eingang 'CLEAR TO SEND' verbunden ist. Wird von
 EUMEL-0 "weiter" aufgerufen, so kann auf dem ensprechenden Kanal wieder empfangen
-werden (RTS setzen bzw. XON senden). In der Regel wird SHard schon reagieren m�ssen,
-bevor der EUMEL-Puffer g�nzlich gef�llt ist, da die Sendehardware nicht schnell genug
-reagieren kann bzw. da noch sich noch Zeichen in Hardwarepuffern befinden k�nnen. 
+werden (RTS setzen bzw. XON senden). In der Regel wird SHard schon reagieren müssen,
+bevor der EUMEL-Puffer gänzlich gefüllt ist, da die Sendehardware nicht schnell genug
+reagieren kann bzw. da noch sich noch Zeichen in Hardwarepuffern befinden können. 
  
-F�r die ausgabeseitige Flu�kontrolle mu� rechnerseitig ebenfalls das Signal 'CLEAR TO
-SEND' bzw. der Empfang von XOFF/XON ber�cksichtigt werden. Wenn an der Schnittstelle
+Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO
+SEND' bzw. der Empfang von XOFF/XON berücksichtigt werden. Wenn an der Schnittstelle
 das 'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser
-Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend mu� der Empfang
+Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der Empfang
 von XOFF die Ausagbe anhalten und XON sie wieder starten. 
  
 Bemerkung:   Die meisten Systeme enthalten die CTS-Funktion schon in ihrer Hardware, so
-             da� im SHard daf�r keine Vorkehrungen getroffen werden m�ssen. 
+             daß im SHard dafür keine Vorkehrungen getroffen werden müssen. 
  
  
-Zur Einstellung der gew�nschten Flu�kontrolle eines Kanals dient die IOCONTROL-Funk-
-tion "flow". �hnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#einstellend#off("i")# und
-auf allen anderen Kan�len lediglich #on("i")#abfragend#off("i")#. 
+Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL-Funk­
+tion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#einstellend#off("i")# und
+auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. 
  
  
      #d("IOCONTROL ""flow""")#
@@ -1630,14 +1630,14 @@ auf allen anderen Kan�len lediglich #on("i")#abfragend#off("i")#.
                            CX    6 
                            DX    adressierter Kanal 
                            BX    Modus 
-          Ausgang:         CX    R�ckmeldung (0 = ok, 1 = nicht m�glich) 
+          Ausgang:         CX    Rückmeldung (0 = ok, 1 = nicht möglich) 
  
-          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru-
-                           fen, mu� sie den gew�nschten Flu�kontrollmodus f�r den
+          Zweck:           Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­
+                           fen, muß sie den gewünschten Flußkontrollmodus für den
                            adressierten Kanal einstellen. 
                            Dabei sind folgende Modi festgelegt: 
  
-                                 BX= 0     Keine Flu�kontrolle 
+                                 BX= 0     Keine Flußkontrolle 
                                  BX= 1     XON/XOFF    (in beide Richtungen) 
                                  BX= 2     RTS/CTS     (in beide Richtungen) 
                                  BX= 5     XON/XOFF    (nur ausgabeseitig) 
@@ -1646,32 +1646,32 @@ auf allen anderen Kan�len lediglich #on("i")#abfragend#off("i")#.
                                  BX=10     RTS/CTS     (nur eingabeseitig) 
  
                            SHard wird hierdurch informiert, wie er auf "Puffer voll" und
-                           "weiter" reagieren soll. Wenn keine Flu�kontrolle gew�nscht
-                           wird (BX=0), mu� SHard "stop" und "weiter" ignorieren; bei
-                           BX=1 oder BX=9 mu� bei "stop" XOFF und bei "weiter" XON
-                           geschickt werden; bei BX=2 oder BX=10 mu� bei "stop" das
+                           "weiter" reagieren soll. Wenn keine Flußkontrolle gewünscht
+                           wird (BX=0), muß SHard "stop" und "weiter" ignorieren; bei
+                           BX=1 oder BX=9 muß bei "stop" XOFF und bei "weiter" XON
+                           geschickt werden; bei BX=2 oder BX=10 muß bei "stop" das
                            Signal RTS auf low und bei "weiter" wieder auf high gesetzt
                            werden. Mit
                            "stop" ist hierbei das Unterschreiten des
-                           Schwellwertes bei der R�ckmeldung von
+                           Schwellwertes bei der Rückmeldung von
                            "inputinterrupt" gemeint. 
  
-                           Bei BX=1 oder BX=5 m�ssen empfangene XON/XOFF-Zei-
-                           chen, bei BX=2 oder BX=6 das Signal CTS beachtet wer-
+                           Bei BX=1 oder BX=5 müssen empfangene XON/XOFF-Zei­
+                           chen, bei BX=2 oder BX=6 das Signal CTS beachtet wer­
                            den. 
  
-                           Wird diese Routine auf einem anderen Kanal als 32 aufge-
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
                            rufen, informiert sie den Aufrufer lediglich, ob der geforderte
-                           Flu�kontrollmodus auf dem adressierten Kanal einstellbar
-                           w�re. 
+                           Flußkontrollmodus auf dem adressierten Kanal einstellbar
+                           wäre. 
  
-          Hinweis:         Falls SHard-spezifisch weitere Flu�kontrollmodi implemen-
-                           tiert werden sollen, darf SHard hierf�r negative Moduswerte
+          Hinweis:         Falls SHard-spezifisch weitere Flußkontrollmodi implemen­
+                           tiert werden sollen, darf SHard hierfür negative Moduswerte
                            (Register BX) vergeben. 
  
                            "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es
                            ist daher nicht sinnvoll, jedesmal XON zu senden, da dies die Gegenstelle
-                           damit �berfluten w�rde. SHard mu� sich
+                           damit überfluten würde. SHard muß sich
                            merken, ob der Kanal im XOFF-Zustand ist und
                            nur dann bei "weiter" ein XON senden. 
  
@@ -1679,24 +1679,24 @@ auf allen anderen Kan�len lediglich #on("i")#abfragend#off("i")#.
 #b("Kalender")#
 #goalpage("kalender")# 
  
-Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unn�tig. EUMEL holt
+Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL holt
 sich Datum und Uhrzeit dann von SHard. 
  
      #d("IOCONTROL ""calendar""")#
       
           Eingang:         CX    10 
                            DX    (1=Minute, 2=Stunde, 3=Tag, 4=Monat, 5=Jahr)
-                           gew�nscht 
-          Ausgang:         CX    R�ckmeldung 
+                           gewünscht 
+          Ausgang:         CX    Rückmeldung 
  
           Zweck:           Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden
-                           ist, mu� bei jedem Aufruf -1 zur�ckgemeldet werden, bei
-                           eingebauter Uhr jeweils das Gew�nschte (Minute: 0..59,
+                           ist, muß bei jedem Aufruf -1 zurückgemeldet werden, bei
+                           eingebauter Uhr jeweils das Gewünschte (Minute: 0..59,
                            Stunde: 0..23, Tag: 1..7, Monat: 1..12, Jahr: 0..99). Die
-                           R�ckmeldung mu� als BCD-Zahl erfolgen. 
+                           Rückmeldung muß als BCD-Zahl erfolgen. 
  
           Hinweis:         Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus
-                           resultierende Probleme werden auf h�heren Ebenen abge-
+                           resultierende Probleme werden auf höheren Ebenen abge­
                            handelt. 
  
  
@@ -1705,59 +1705,59 @@ sich Datum und Uhrzeit dann von SHard.
 #bb("6.  SHard-","Interface Version")#
 #goalpage("shdver")# 
  
-Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, mu� als 2-By-
-te-Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. F�r das hier beschriebene Interface
-mu� sie den Wert 8 haben. 
+Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als 2-By­
+te-Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene Interface
+muß sie den Wert 8 haben. 
  
-So sind sp�tere Erweiterungen des SHard-Interfaces m�glich, ohne da� alle SHard-Mo-
-duln ge�ndert werden m�ssen. 
+So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard-Mo­
+duln geändert werden müssen. 
  
  
  
 #bb("7.  ","ID-Konstanten")#
 #goalpage("ID")# 
  
-SHard mu� direkt hinter SHDVER vier 2-Byte-Konstanten ablegen. Diese k�nnen von den
-h�heren Ebenen durch die ELAN-Prozedur 
+SHard muß direkt hinter SHDVER vier 2-Byte-Konstanten ablegen. Diese können von den
+höheren Ebenen durch die ELAN-Prozedur 
  
           INT PROC #ib#id#ie# (INT CONST no) 
  
-abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, w�hrend SHard in
-der Leiste die Werte f�r id(4) bis id(7) zur Verf�gung stellen mu�: 
+abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in
+der Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: 
  
           ID4              #ib#Lizenznummer#ie# des SHards *) 
 #foot# 
 #f#
-*) Dieser Wert mu� mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD �bereinstimmen!#a##end# 
+*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen!#a##end# 
  
           ID5              #ib#Installationsnummer#ie# des EUMEL-Anwenders **) 
 #foot# 
 #f#
 **) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender.#a##end# 
  
-          ID6              zur freien Verf�gung 
+          ID6              zur freien Verfügung 
  
-          ID7              zur freien Verf�gung 
+          ID7              zur freien Verfügung 
  
  
  
  
-#bb("8.  ","Zus�tzliche Leistungen")#
+#bb("8.  ","Zusätzliche Leistungen")#
 #goalpage("shdelan")# 
  
-Will der SHard-Implementierer zus�tzliche Leistungen anbieten, die mit den Standardope-
-rationen nicht m�glich sind, kann er weitere Codes f�r BLOCKIN, BLOCKOUT und
-IOCONTROL zur Verf�gung stellen. Um �berdeckungen mit Codes zu vermeiden, die von
-EUMEL-0 intern verwendet oder erst sp�ter eingef�hrt werden, darf SHard f�r zus�tzli-
+Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardope­
+rationen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und
+IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von
+EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzli­
 che Leistungen nur negative Werte als 'Funktionscode 1' verwenden. 
  
  
 Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib# blockout#ie#', '#ib#blockin#ie#'#off("i")#
-und #on("i")#'#ib#control#ie#'#off("i")# zur Verf�gung. 
+und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. 
  
-Ferner steht dem SHard ein Parameterkanal (32) zur Verf�gung. Funktionen, die (im Mul-
-ti-User) nicht jeder Task zur Verf�gung stehen d�rfen, m�ssen �ber diesen Kanal 32 abge-
-wickelt werden und d�rfen nur dort wirken. 
+Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Mul­
+ti-User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32 abge­
+wickelt werden und dürfen nur dort wirken. 
  
  
      PROC blockout (ROW 256 INT CONST para,      (* --> DS:BX *) 
@@ -1775,22 +1775,22 @@ wickelt werden und d�rfen nur dort wirken.
                              funktion3,          (* --> BX *) 
                    INT VAR   antwort)            (* <-- CX *) 
  
-Hinweis: Der SHard darf f�r 'funktion 1' (CX) zus�tzlich zu den hier beschriebenen Stan-
+Hinweis: Der SHard darf für 'funktion 1' (CX) zusätzlich zu den hier beschriebenen Stan­
          dardcodes nur negative Codes vereinbaren. 
  
  
 Beispiel: 
  
-     Gibt eine Task, die durch 'continue (x)' an Kanal 'x' h�ngt, den Befehl 
+     Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl 
  
                            control (-7,1200,13,antwort), 
  
-     so wird IOCONTROL mit (AL='x', CX=-7, BX=13, DX=1200) aufgerufen. Verl��t
-     SHard 'control' mit CX = 1, so enth�lt 'antwort' anschlie�end eine 1. 
+     so wird IOCONTROL mit (AL='x', CX=-7, BX=13, DX=1200) aufgerufen. Verläßt
+     SHard 'control' mit CX = 1, so enthält 'antwort' anschließend eine 1. 
  
  
-Hinweis:  Um die zus�tzlichen Leistungen dem Anwender einfach (und abgesichert) zur
-          Verf�gung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses
+Hinweis:  Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur
+          Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses
           ebenfalls an die Anwender ausliefern. 
  
           Beispiel:        PACKET zusatz DEFINES fanfare, ... : 
@@ -1816,7 +1816,7 @@ Hinweis:  Um die zus�tzlichen Leistungen dem Anwender einfach (und abgesichert)
 #bb("9.  ","Spezialroutinen")#
 #goalpage("ke")# 
  
-Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse ein-
+Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse ein­
 bauen. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird im
 Anhang A (siehe S.#topage("info")#) beschreiben. 
  
@@ -1828,38 +1828,38 @@ Anhang A (siehe S.#topage("info")#) beschreiben.
                            weiter: 
  
           Zweck:           Info wird aufgerufen. Dabei wird 'text' zur Identifikation des
-                           Kontrollereignisses ausgegeben. Der �bergebene Text darf
+                           Kontrollereignisses ausgegeben. Der übergebene Text darf
                            nicht mit 0h beginnen. 
  
-          Hinweis:         Bei Systemen "ohne Info" (nur solche d�rfen an Anwender
+          Hinweis:         Bei Systemen "ohne Info" (nur solche dürfen an Anwender
                            ausgeliefert werden) wird nur der Info-Text ausgegeben und
                            EUMEL-0 angehalten. 
  
-          Achtung:         Da der Info selbst die hier beschriebenen Stream-IO-Routi-
-                           nen benutzt, darf man ihn von diesen Routinen aus (inputin-
+          Achtung:         Da der Info selbst die hier beschriebenen Stream-IO-Routi­
+                           nen benutzt, darf man ihn von diesen Routinen aus (inputin­
                            terrupt, OUTPUT, IOCONTROL "frout", IOCONTROL "weiter")
-                           nicht aufrufen. Wenn die Ein-/Ausgabe auf Terminal 1 inter-
-                           ruptgetrieben l�uft, d�rfen die Interrupts beim Info-Aufruf
-                           nat�rlich nicht gesperrt sein. 
+                           nicht aufrufen. Wenn die Ein-/Ausgabe auf Terminal 1 inter­
+                           ruptgetrieben läuft, dürfen die Interrupts beim Info-Aufruf
+                           natürlich nicht gesperrt sein. 
  
  
-Falls SHard f�r bestimmte Aktionen, die selten durchgef�hrt werden (z.B. Formatieren), viel
-Speicher ben�tigt, kann er diesen dynamisch anfordern und sp�ter wieder freigeben. 
+Falls SHard für bestimmte Aktionen, die selten durchgeführt werden (z.B. Formatieren), viel
+Speicher benötigt, kann er diesen dynamisch anfordern und später wieder freigeben. 
  
      #dx("grab")#              (0-Routine) 
  
           Eingang:         BX    Anfangsadresse des zu reservierenden Bereichs im
-                                 Datensegment von EUMEL-0, mu� auf 512 Byte
+                                 Datensegment von EUMEL-0, muß auf 512 Byte
                                  ausgerichtet sein. 
-                           CX    L�nge des zu reservierenden Bereichs in 512-Byte-
+                           CX    Länge des zu reservierenden Bereichs in 512-Byte-
                                  Kacheln 
-          Ausgang:         CX    R�ckmeldecode 
+          Ausgang:         CX    Rückmeldecode 
  
-          Zweck:           Wenn m�glich wird der zu verlangte Bereich von EUMEL-0
-                           "leergek�mpft" und SHard zur Verf�gung gestellt. 
-                           R�ckmeldecode:  0  ok, Speicher steht zur Verf�gung 
-                                           1  grunds�tzlich nicht m�glich 
-                                           2  augenblicklich nicht m�glich 
+          Zweck:           Wenn möglich wird der zu verlangte Bereich von EUMEL-0
+                           "leergekämpft" und SHard zur Verfügung gestellt. 
+                           Rückmeldecode:  0  ok, Speicher steht zur Verfügung 
+                                           1  grundsätzlich nicht möglich 
+                                           2  augenblicklich nicht möglich 
  
           Achtung:         Der Aufruf von 'grab' wird in der Regel 'warte' und Block-IO
                            auf Kanal 0 induzieren. 
@@ -1870,31 +1870,31 @@ Speicher ben�tigt, kann er diesen dynamisch anfordern und sp�ter wieder freigebe
  
      #dx("free")#              (0-Routine) 
  
-          Eingang:         BX    Anfangsadresse des freizugebenden Bereichs im Da-
-                                 tensegment von EUMEL-0, mu� auf 512 Byte ausge-
+          Eingang:         BX    Anfangsadresse des freizugebenden Bereichs im Da­
+                                 tensegment von EUMEL-0, muß auf 512 Byte ausge­
                                  richtet sein. 
-                           CX    L�nge des zu freizugebenden Bereichs als 'Bytes DIV
+                           CX    Länge des zu freizugebenden Bereichs als 'Bytes DIV
                            512' 
  
-          Zweck:           Der entsprechende Bereich mu� vorher mit 'grab' beschafft
+          Zweck:           Der entsprechende Bereich muß vorher mit 'grab' beschafft
                            worden sein. Hiermit wird er wieder EUMEL-0 zur freien
-                           Verf�gung gestellt. 
+                           Verfügung gestellt. 
  
  
-F�r spezielle Fehlersituationen steht die 0-Routine 'shutup' zur Verf�gung. Damit kann
+Für spezielle Fehlersituationen steht die 0-Routine 'shutup' zur Verfügung. Damit kann
 SHard z.B. bei Netzausfall ein kontrolliertes Systemende erzwingen. Das ist allerdings nur
-sinnvoll, wenn durch Batteriepufferung oder �hnliches sichergestellt ist, da� noch gen�gend
-Zeit bleibt, um alle Seiten auf den Hintergrund zur�ckzuschreiben. 
+sinnvoll, wenn durch Batteriepufferung oder Ähnliches sichergestellt ist, daß noch genügend
+Zeit bleibt, um alle Seiten auf den Hintergrund zurückzuschreiben. 
  
      #dx("shutup")#            (0-Routine) 
  
-          Zweck:           Erzwingt R�ckschreiben aller Seiten und Systemende, d.h.
+          Zweck:           Erzwingt Rückschreiben aller Seiten und Systemende, d.h.
                            entspricht der ELAN-Prozedur 'shutup'. 
  
           Achtung:         Der Aufruf von 'shutup' wird in der Regel 'warte' und
-                           Block-IO auf Kanal 0 induzieren, abschlie�end wird 'sysend'
+                           Block-IO auf Kanal 0 induzieren, abschließend wird 'sysend'
                            aufgerufen. 
- 
+#page# 
 #cc("Teil 4: ","Tips zur Portierung")#
 #goalpage("tips")# 
  
@@ -1903,24 +1903,24 @@ Zeit bleibt, um alle Seiten auf den Hintergrund zur�ckzuschreiben.
 #goalpage("0ver")# 
  
  
-Es wird empfohlen, zuerst eine "0-Version" des SHard zu entwickeln, die m�glichst einfach
-aufgebaut und nicht auf Effizienz und vollst�ndige Ausnutzung der Betriebsmittel ausge-
+Es wird empfohlen, zuerst eine "0-Version" des SHard zu entwickeln, die möglichst einfach
+aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel ausge­
 richtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann den
-Entwurf und die Implementation des eigentlichen SHard erleichtert. Die 0-Version soll-
+Entwurf und die Implementation des eigentlichen SHard erleichtert. Die 0-Version soll­
 te 
  
-     - nur die Kan�le 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, 
+     - nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, 
  
-     - keine Baudraten-, Zeichenl�ngen-, Parit�ts- und Flu�kontrolleinstellungen un-
-       terst�tzen (immer 'nicht m�glich' melden), 
+     - keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen un­
+       terstützen (immer 'nicht möglich' melden), 
  
-     - vorhandene (ROM-) Routinen m�glichst nutzen, ohne sich um Unsch�nes wie "busy
-       wait" beim Floppy- bzw. Plattenzugriff zu gr�men. 
+     - vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie "busy
+       wait" beim Floppy- bzw. Plattenzugriff zu grämen. 
  
 Mit dieser 0-Version sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund
-beim ersten Mal noch leer ist, mu� man das Hintergrund-Archiv (Archivfloppy mit
-EUMEL-0 und h�heren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der
-Vortest sollte sich direkt nach dem Start folgenderma�en auf Terminal 1 melden: 
+beim ersten Mal noch leer ist, muß man das Hintergrund-Archiv (Archivfloppy mit
+EUMEL-0 und höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der
+Vortest sollte sich direkt nach dem Start folgendermaßen auf Terminal 1 melden: 
  
                 E U M E L - Vortest 
  
@@ -1931,39 +1931,39 @@ Vortest sollte sich direkt nach dem Start folgenderma�en auf Terminal 1 melden:
  
           Speichertest: ************ 
  
-Man sollte w�hrend der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. Das
-EUMEL-System mu� dann in das ausf�hrliche Start-Men� �berwechseln. (Andernfalls
+Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. Das
+EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andernfalls
 funktioniert die Eingabe nicht richtig!) 
  
-Als n�chstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese M�g-
-lichkeit wird im Start-Men� angeboten.) Nach dem Ende dieser Operation wird der
-EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf-
-werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund gela-
+Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese Mög­
+lichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der
+EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­
+werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund gela­
 den werden. 
  
-Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung f�r seine Ver-
-wendung ist aber, da� die Terminal Ein-/Ausgabe schon funktioniert. 
+Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine Ver­
+wendung ist aber, daß die Terminal Ein-/Ausgabe schon funktioniert. 
  
 Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den
 Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete
-Terminal in dieser Liste nicht aufgef�hrt wird und auch keinem der aufgef�hrten (in Bezug
+Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug
 auf die Steuercodes) gleicht, kann man z.B. 
  
-     - den neuen Terminaltyp an einem anderen EUMEL-Rechner verf�gbar machen
+     - den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen
        (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, 
  
-     - die notwendigen Umcodierungen per SHard durchf�hren. 
+     - die notwendigen Umcodierungen per SHard durchführen. 
  
 Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil
-Steuerzeichen dort sowieso algorithmisch interpretiert werden m�ssen. In diesem Fall wird
-man direkt die EUMEL-Codes als Grundlage w�hlen, so da� keine Umsetzungen erfor-
+Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird
+man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­
 derlich sind. 
  
 Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzichten. 
  
  
 Im Gegensatz zu der 0-Version sollte man bei der eigentlichen SHard-Implementierung
-darauf achten, die M�glichkeiten der Hardware effizient zu nutzen. Der Testverlauf entspricht
+darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf entspricht
 dann wieder im wesentlichen dem oben beschriebenen Vorgang. 
  
  
@@ -1972,15 +1972,15 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
 #goalpage("fehler")# 
  
  
-     a)   SHard-Routinen zerst�ren Registerinhalte bzw. sichern sie beim Interrupt nicht
-          vollst�ndig. Hierbei sollte man auch an die Segmentregister denken. 
+     a)   SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht
+          vollständig. Hierbei sollte man auch an die Segmentregister denken. 
  
-     b)   'call' bzw. 'ret' ver�ndern den Stackpointer. 
+     b)   'call' bzw. 'ret' verändern den Stackpointer. 
  
-     c)   Fehler bei der Interruptbehandlung f�hren zu Blockaden ("h�ngende Interrupts"). 
+     c)   Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Interrupts"). 
  
-     d)   Cursorpositionierung au�erhalb des Bildschirms bei einem internen Terminal
-          (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das f�hrt dann zu
+     d)   Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal
+          (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu
           wildem Schreiben in den Hauptspeicher. 
  
      e)   'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT,
@@ -1988,41 +1988,41 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
           kann man 'warte' noch nicht beim Systemladen aufrufen!) 
  
      f)   OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation
-          zwischen dem F�llen des Ausgabepuffers durch die Routine OUTPUT und der
+          zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der
           Interruptroutine, die den Puffer leert und ausgibt. 
  
      g)   IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zeichen
-          im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output-Blok-
-          kaden f�hren. 
+          im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output-Blok­
+          kaden führen. 
  
-     h)   Obwohl "frout" einen Wert gr��er als x meldet, nimmt "output" nicht alle x Zei-
+     h)   Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x Zei­
           chen an. 
  
      i)   IOCONTROL "size" meldet falsche Werte. 
  
      j)   IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. 
  
-     k)   BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zur�ck, bevor alle
-          Daten �bertragen sind. (Sofort nach der R�ckgabe geht EUMEL-0 davon aus,
-          da� der Puffer frei ist und anderweitig benutzt werden kann!) 
+     k)   BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor alle
+          Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon aus,
+          daß der Puffer frei ist und anderweitig benutzt werden kann!) 
  
-     l)   F�lschlicherweise wird davon ausgegangen, da� DS oder ES konstant bleiben. 
+     l)   Fälschlicherweise wird davon ausgegangen, daß DS oder ES konstant bleiben. 
  
-     m)   Die Stepping-Rate eines Festplattencontrollers wird falsch eingestellt, bezie-
+     m)   Die Stepping-Rate eines Festplattencontrollers wird falsch eingestellt, bezie­
           hungsweise die Platte wird nicht im 'buffered step mode' betrieben, obwohl
           beschleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem
-          Hintergrund unn�tig verlangsamt. Man bedenke, da� man so einen Fehler leicht
-          �bersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verh�lt.
-          Au�erdem macht sich die Verlangsamung erst bemerkbar, wenn gr��ere Teile des
+          Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht
+          übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält.
+          Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile des
           Hintergrundes benutzt werden. 
  
      n)   Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf
-          einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei �berholt dann
+          einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann
           das zweite Zeichen das erste. 
  
-     o)   Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen Ein-
-          gabezeichen verloren oder werden verf�lscht. In der Regel ist das auf Timing-
-          probleme bei der Interruptbehandlung zur�ckzuf�hren. Interrupts gehen verloren
+     o)   Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen Ein­
+          gabezeichen verloren oder werden verfälscht. In der Regel ist das auf Timing­
+          probleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen verloren
           bzw. die Zeichen werden nicht schnell genug abgeholt. 
  
  
@@ -2031,23 +2031,23 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
 #goalpage("eff")# 
  
      a)   Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf
-          Fehlverhalten von "frout" zur�ckzuf�hren. Auch kostet es in Multi-User- 
-          Systemen sehr viel, wenn OUTPUT immer nur ein Zeichen �bernimmt. (Dann l�uft
-          der ganze Apparat der EUMEL-0-Maschine f�r jedes Zeichen wieder an.) 
+          Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User- 
+          Systemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann läuft
+          der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) 
  
-          Besonders bei der Parallelschnittstelle achte man darauf, da� nicht durch ung-
-          l�ckliches Timing h�ufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf
-          Freiwerden der Parallelschnittstelle dazu f�hren, da� jedes zweite Zeichen abge-
-          lehnt wird, so da� OUTPUT faktisch zeichenweise arbeitet. Andererseits darf
-          nat�rlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. 
+          Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch ung­
+          lückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf
+          Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen abge­
+          lehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf
+          natürlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. 
  
  
      b)   Wenn #on("i")##on("b")#Floppies ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single-User-
           Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek-Vorgang auf
-          den Block zu warten. Im Multi-User sollte das aber wenn irgend m�glich um-
+          den Block zu warten. Im Multi-User sollte das aber wenn irgend möglich um­
           gangen werden, da eine halbe Umdrehung immerhin ca. 100 ms kostet. 
-          Falls nur ein Endeinterrupt nach jeder Floppyoperation zur Verf�gung steht, kann
-          folgendes Verfahren g�nstig sein: 
+          Falls nur ein Endeinterrupt nach jeder Floppyoperation zur Verfügung steht, kann
+          folgendes Verfahren günstig sein: 
  
                seek befehl an controller ; 
                warten auf endeinterrupt ; 
@@ -2058,10 +2058,10 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
  
           Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu,
           ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen
-          Sektor m�glichst nahe ist. Die Zeit, in der die CPU ben�tigt wird, sinkt damit auf
+          Sektor möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf
           ca. 25 ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach, da
-          die 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht ver-
-          wendet werden kann. Alle 'warte auf ...' m�ssen also durch Interrupts realisiert
+          die 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht ver­
+          wendet werden kann. Alle 'warte auf ...' müssen also durch Interrupts realisiert
           werden: 
  
                setze interrupt auf lesen davor ; 
@@ -2083,12 +2083,12 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
                                  UNTIL alles uebertragen ENDREP ; 
                                  melde komplette operation beendet . 
  
-     Hinweis:    Solche Systeme sind �ber V.24 nicht netzf�hig, da sie Eingabezeichen
+     Hinweis:    Solche Systeme sind über V.24 nicht netzfähig, da sie Eingabezeichen
                  verlieren werden. 
  
  
-     c)   Bei der Ansteuerung von #on("i")##on("b")#Harddisks#off("b")##off("i")# sollte man darauf achten, da� die 0-Rou-
-          tine 'warte' nicht �fter als notwendig aufgerufen wird. Sonst wird das Paging
+     c)   Bei der Ansteuerung von #on("i")##on("b")#Harddisks#off("b")##off("i")# sollte man darauf achten, daß die 0-Rou­
+          tine 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging
           zugunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man
           bei vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: 
  
@@ -2102,44 +2102,44 @@ dann wieder im wesentlichen dem oben beschriebenen Vorgang.
                UNTIL fertig PER 
  
           Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die rechte.
-          Bei starker CPU Belastung wird sie deshalb bis zu 100 ms l�nger f�r das Einlesen
-          eines Blocks ben�tigen. 
- 
-          Eine �hnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren
-          unterteilt ist, so da� zu jedem EUMEL-Block zwei Sektoren geh�ren. Wenn
-          m�glich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen
-          werden. Andererseits darf nat�rlich auch nicht l�ngere Zeit CPU-intensiv gewar-
-          tet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschr�nkung zu
+          Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das Einlesen
+          eines Blocks benötigen. 
+ 
+          Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren
+          unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn
+          möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen
+          werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv gewar­
+          tet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung zu
           experimentieren. 
  
- 
+#page# 
 #cc("Anhang A: EUMEL-","Debugger ""Info""")#
 #goalpage("info")# 
  
  
-F�r interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unterschei-
-den sich nur im EUMEL-0-Teil (Urlader). Der SHard-Implementierer erh�lt zum Test
-Hintergr�nde "mit Info" und zur Auslieferung solche "ohne Info". Infof�hige Systeme d�rfen
+Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unterschei­
+den sich nur im EUMEL-0-Teil (Urlader). Der SHard-Implementierer erhält zum Test
+Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige Systeme dürfen
 nur von den SHard-Implementierern verwendet werden. 
  
-     #on("i")##on("b")#Achtung: Infof�hige Systeme d�rfen auf keinen Fall an Anwender ausgeliefert werden,
-              da vermittels Info alle Systemsicherungs- und Datenschutzma�nahmen un-
-              terlaufen werden k�nnen.#off("i")##off("b")# *) 
+     #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert werden,
+              da vermittels Info alle Systemsicherungs- und Datenschutzmaßnahmen un­
+              terlaufen werden können.#off("i")##off("b")# *) 
 #foot# 
 #f#
-*) Ausnahmen von dieser Regel bed�rfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ Bie-
-lefeld) und des jeweiligen Anwenders. Solche System m�ssen immer durch spezielle Schl�sselworte abgesichert werden.#a##end# 
+*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ Bie­
+lefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert werden.#a##end# 
  
  
 #b("Aufruf des Info")#
 #goalpage("aufrinf")# 
  
-Zum Aufruf des Infos gibt es drei M�glichkeiten: 
+Zum Aufruf des Infos gibt es drei Möglichkeiten: 
  
-     a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei-
-        chens w�hrend des Vortests in den ausf�hrlichen Start-Dialog. Durch Eingabe von
-        'I' gelangt man dann in den Info-Modus. #on("i")#(Diese M�glichkeit wird in dem Startmen�
-        nicht aufgef�hrt.)#off("i")# 
+     a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­
+        chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe von
+        'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem Startmenü
+        nicht aufgeführt.)#off("i")# 
  
      b) Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das System
         gestartet wurde und sich eine Task am Terminal mit "gib kommando" gemeldet hat,
@@ -2149,26 +2149,26 @@ Zum Aufruf des Infos gibt es drei M�glichkeiten:
         durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe
         "Systemhandbuch, Konfigurierung") in den Info-Modus. 
  
-Alle diese M�glichkeiten funktionieren nur bei infof�higen Systemen. 
+Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. 
  
-Bei schweren Systemfehlern, die eine Weitermeldung an die h�heren Ebenen des
-EUMEL-Systems unm�glich machen, wird soweit m�glich ebenfalls der Info aufgerufen. Bei
+Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des
+EUMEL-Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen. Bei
 Systemen "ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das System
 angehalten. 
  
-Bevor das System Infokommandos annimmt, mu� mit dem Kommando 'P' ein Pa�wort
+Bevor das System Infokommandos annimmt, muß mit dem Kommando 'P' ein Paßwort
 eingegeben werden. Lediglich dieses Kommando und das Kommando 'g' werden immer
-angenommen. Das Pa�wort kann mit dem Kommando 'yP' eingestellt werden. 
+angenommen. Das Paßwort kann mit dem Kommando 'yP' eingestellt werden. 
  
 #b("Info-Format")#
 #goalpage("forminf")# 
  
-Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom-
+Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­
 mandos werden die drei obersten Zeilen wie folgt aufgebaut: *) 
 #foot# 
 #f#
 *) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h.
-insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchgef�hrt. #a##end# 
+insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchgeführt. #a##end# 
  
 #limit(14.0)# 
 XYY TEXT 
@@ -2179,13 +2179,13 @@ xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx
  
 wobei 
  
-     X den Miniproze� bezeichnet, der den �bergang in den Info veranla�t hat (A=Archiv,
-     E=Elan, L=Lader, M=M�llabfuhr), 
+     X den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat (A=Archiv,
+     E=Elan, L=Lader, M=Müllabfuhr), 
  
-     YY den Maxiproze� (Task) bezeichnet, der gerade durch den Elan-Prozessor bear-
+     YY den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor bear­
      beitet wird (YY ist die hexadezimale Tasknummer), 
  
-     TEXT den Grund f�r den Info-Modus anzeigt, 
+     TEXT den Grund für den Info-Modus anzeigt, 
  
 Die zweite und dritte Zeile zeigen die Inhalte der 8086/8088-Register an. In der untersten
 Zeile erscheint die Eingabeaufforderung 'info:'. 
@@ -2194,7 +2194,7 @@ Zeile erscheint die Eingabeaufforderung 'info:'.
 #b("Info-Kommandos")#
 #goalpage("cmdinf")# 
  
-Info-Kommandos k�nnen in der 'info:'-Zeile mit dem Format 
+Info-Kommandos können in der 'info:'-Zeile mit dem Format 
  
           [<zahl>]<buchstabe> 
  
@@ -2202,19 +2202,19 @@ gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format
  
           <buchstabe> 
  
-wobei dann f�r <zahl> die der Cursorposition entsprechende Dumpadresse (modulo 2**16)
+wobei dann für <zahl> die der Cursorposition entsprechende Dumpadresse (modulo 2**16)
 gesetzt wird (siehe '*cup*'). 
  
 <zahl> ist immer in Hexaform einzugeben. 
  
-'g'    Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge-
+'g'    Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge­
        sperrt. 
  
 'z'    Der Leitblock des angezeigten Maxiprozesses wird dargestellt, falls <zahl> = 0 ist,
-       sonst der Leitblock der Task mit der Nummer <zahl>. (Nur im ELAN-Miniproze�). 
+       sonst der Leitblock der Task mit der Nummer <zahl>. (Nur im ELAN-Miniprozeß). 
  
-'q'    Die Task mit der Nummer <zahl> wird nach dem n�chsten 'g'-Kommando in den
-       Info �berf�hrt. Dies ist n�tig, wenn man sich die Datenr�ume dieser Task anschauen
+'q'    Die Task mit der Nummer <zahl> wird nach dem nächsten 'g'-Kommando in den
+       Info überführt. Dies ist nötig, wenn man sich die Datenräume dieser Task anschauen
        will ('s'). 
  
 's'    Dumps werden auf den Datenraum <zahl> eingestellt. (s:=<zahl>) 
@@ -2225,7 +2225,7 @@ gesetzt wird (siehe '*cup*').
                            2     ES-relativ 
                            3     SS-relativ 
  
-'l'    Dumps werden auf die L�nge <zahl> eingestellt. Desungeachtet kann man einen
+'l'    Dumps werden auf die Länge <zahl> eingestellt. Desungeachtet kann man einen
        versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird
        allerdings '*cup*' gesperrt (siehe unten). 
  
@@ -2239,8 +2239,8 @@ gesetzt wird (siehe '*cup*').
 'k'    Block <zahl> laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf
        den Realdatenraum (s=1). 
  
-'P'    Pa�worteingabe: P<text>*return* 
-       Erst nach diesem Kommando sind die �brigen Kommandos ausf�hrbar. 
+'P'    Paßworteingabe: P<text>*return* 
+       Erst nach diesem Kommando sind die übrigen Kommandos ausführbar. 
  
 'x'    Suchen nach Bytekette: 
  
@@ -2250,8 +2250,8 @@ gesetzt wird (siehe '*cup*').
  
        Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte 'x'-
        Kommando eingestellten Bytekette gesucht. 
-       Das Kommando ist durch *return* abzuschlie�en. 
-       Die Suche beginnt ab Position 'p' und ist auf die L�nge <zahl> Seiten (512
+       Das Kommando ist durch *return* abzuschließen. 
+       Die Suche beginnt ab Position 'p' und ist auf die Länge <zahl> Seiten (512
        Byte-Einheiten) begrenzt (0=unendlich). 
        Eine beliebige Eingabe bricht die Suche vorzeitig ab. 
  
@@ -2259,124 +2259,124 @@ gesetzt wird (siehe '*cup*').
        Es wird der eingestellte Dump ausgegeben (siehe 's','l','p','w'). Bei wmodus (siehe
        'p', 'w') werden Wortadressen ausgegeben. 
  
-'o'    Wie '*return*', jedoch wird zuvor p := p+l  gesetzt (zum Weiterbl�ttern). 
+'o'    Wie '*return*', jedoch wird zuvor p := p+l  gesetzt (zum Weiterblättern). 
  
 'r'    Freigabe der anderen Miniprozesse. 
  
-       Zun�chst werden bei �bergang in den Info alle Miniprozesse gesperrt, um eine Ver-
-       f�lschung der Fehlersituation zu vermeiden. Bei manchen Kommandos an den Info
-       m�ssen aber andere Miniprozesse u.U. aktiv werden (z.B. beim 'k' der Lader). Wenn
+       Zunächst werden bei Übergang in den Info alle Miniprozesse gesperrt, um eine Ver­
+       fälschung der Fehlersituation zu vermeiden. Bei manchen Kommandos an den Info
+       müssen aber andere Miniprozesse u.U. aktiv werden (z.B. beim 'k' der Lader). Wenn
        dies erforderlich ist, meldet der Info: 
-       'paging erforderlich'. Man kann dann 'r' geben und das letzte Infokommando wie-
+       'paging erforderlich'. Man kann dann 'r' geben und das letzte Infokommando wie­
        derholen, oder mit anderen Kommandos fortfahren, falls man den Fehlerzustand noch
        so beibehalten will. 
  
-'y'    Zweitfunktion ausf�hren. 
+'y'    Zweitfunktion ausführen. 
  
 -->    'yP<text>*return*' 
-              Neues Pa�wort einstellen (max. 9 Zeichen). Dieses wird bei 'shutup' (erst
+              Neues Paßwort einstellen (max. 9 Zeichen). Dieses wird bei 'shutup' (erst
               dann!) in Block 0 eingetragen. 
  
 -->    'yt'   Block <zahl> von Archiv lesen. Dient zum Test des Archivs. 
               Es wird eine Kachel freigemacht und der Block mit der Nummer <zahl>
               eingelesen. Der Inhalt wird sofort angezeigt (wie Kommando 'k'). 
  
--->    'yb'   Breakpoint an die Adresse <zahl> setzen. Es wird ein INT3 (f�r Aufruf von
+-->    'yb'   Breakpoint an die Adresse <zahl> setzen. Es wird ein INT3 (für Aufruf von
               Info) abgesetzt. Info verwaltet gleichzeitig bis zu 10 gesetzte Breakpoints. Die
-              Breakpointnummer kann man aus der nach jedem Setzen (und L�schen)
-              angezeigten Breakpoint-Tabelle entnehmen. Breakpoints sind nur im Real-
+              Breakpointnummer kann man aus der nach jedem Setzen (und Löschen)
+              angezeigten Breakpoint-Tabelle entnehmen. Breakpoints sind nur im Real­
               speicher sinnvoll. Ein Aufruf meldet sich mit TEXT= 'break z--xxxx:yyyy' (z
               = Breakpointnummer, xxxx = CS, yyyy = PC beim Aufruf des Breakpoints).
               Wird Info mit 'g' verlassen, so stellt er zuvor die alten 8086/8088-Befehle
-              wieder her und f�hrt sie an ihrem originalen Ort aus. Direkt danach wird der
+              wieder her und führt sie an ihrem originalen Ort aus. Direkt danach wird der
               Breakpoint wieder hergestellt. 
  
--->    'yc'   L�scht den Breakpoint an der Adresse <zahl> und stellt die urspr�ngli-
-              chen Befehle wieder her. In der Breakpoint-Tabelle mu� ein Breakpoint an
+-->    'yc'   Löscht den Breakpoint an der Adresse <zahl> und stellt die ursprüngli­
+              chen Befehle wieder her. In der Breakpoint-Tabelle muß ein Breakpoint an
               dieser Adresse vermerkt sein. 
  
--->    'yw'   Zu anderen Miniproze� wechseln. Nur sinnvoll, wenn ein anderer Mini unter
-              'vor info' aufgef�hrt ist. 
+-->    'yw'   Zu anderen Miniprozeß wechseln. Nur sinnvoll, wenn ein anderer Mini unter
+              'vor info' aufgeführt ist. 
  
 -->    'yl'   Lernmodus ein (wie beim Editor). 
  
 -->    'ye'   Ende Lernmodus. 
  
--->    'ya'   Ausf�hren. Die zwischen 'yl' und 'ye' eingegebenen Zeichen werden dem Info
-              so vorgesetzt, als k�men sie von der Tastatur. 
+-->    'ya'   Ausführen. Die zwischen 'yl' und 'ye' eingegebenen Zeichen werden dem Info
+              so vorgesetzt, als kämen sie von der Tastatur. 
  
-              Achtung: Rekursion ('ya' im Lernmodus) wird nicht abgefangen. Das Ge-
+              Achtung: Rekursion ('ya' im Lernmodus) wird nicht abgefangen. Das Ge­
                         lernte wird nach jedem Kommando, das die ersten drei Zeilen
                         wiederaufbaut (z.B. *return*), in der Zeile vier angezeigt, wobei
-                        f�r Steuerzeichen eine Ersatzdarstellung erscheint (%x mit
-                        x=code (code (zeichen) +code ("A")), also z.B. %M f�r *re-
+                        für Steuerzeichen eine Ersatzdarstellung erscheint (%x mit
+                        x=code (code (zeichen) +code ("A")), also z.B. %M für *re­
                         turn*). 
  
 --> 'y *return*' 
-              Wie *return*, jedoch wird der Dump auch beim Ausf�hren (ya) ausgegeben.
-              (Ein gelerntes *return* f�hrt im Ausf�hrmodus nicht zum Dump). 
+              Wie *return*, jedoch wird der Dump auch beim Ausführen (ya) ausgegeben.
+              (Ein gelerntes *return* führt im Ausführmodus nicht zum Dump). 
  
-'*cup*' *)    (Cursor up). Umschaltung in den Modus zum �ndern in Dumps. 
+'*cup*' *)    (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. 
 #foot# 
 #f#
-*) Falls der Kanal noch nicht konfiguriert ist, mu� man nat�rlich eine Taste bet�tigen, die den EUMEL-Code f�r Cursor
-Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen durchf�hrt, ist
+*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für Cursor
+Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen durchführt, ist
 dieser Modus nicht sehr gut benutzbar.#a##end# 
-              Der Cursor f�hrt in den Dump und kann mit den Cursortasten dort bewegt
+              Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt
               werden. Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des
               Bytes eingetragen, auf dem der Cursor gerade steht. Dies funktioniert auch
-              auf beliebigen Datenr�umen. Info beantragt dann bei der Speicherverwal-
-              tung einen Schreibzugriff f�r die entsprechende Datenraumseite, so da�
-              �nderungen mit der Copy-on-Write-Logik erfolgen, also nur taskspezi-
-              fisch sind (durch 'q' eingestellt). F�r diese Task sind die �nderungen aller-
+              auf beliebigen Datenräumen. Info beantragt dann bei der Speicherverwal­
+              tung einen Schreibzugriff für die entsprechende Datenraumseite, so daß
+              Änderungen mit der Copy-on-Write-Logik erfolgen, also nur taskspezi­
+              fisch sind (durch 'q' eingestellt). Für diese Task sind die Änderungen aller­
               dings dann permanent, da sie auch auf den Hintergrund wirken. 
  
-              Hinweis: Dumpt man mit 'k' einen Block und �ndert dann darin, so sind
-                       diese �nderungen u.U. nur tempor�r, da der Info kein R�ckschrei-
-                       ben des Blockes veranla�t. 
+              Hinweis: Dumpt man mit 'k' einen Block und ändert dann darin, so sind
+                       diese Änderungen u.U. nur temporär, da der Info kein Rückschrei­
+                       ben des Blockes veranlaßt. 
  
-              Achtung: Jede Eingabe, die kein Positionierzeichen und kein g�ltiges Zahl-
+              Achtung: Jede Eingabe, die kein Positionierzeichen und kein gültiges Zahl­
                        zeichen ist, beendet diesen Modus. Das neue Zeichen wird als
-                       Info-Kommando aufgefa�t, wobei <zahl> auf die aktuelle
+                       Info-Kommando aufgefaßt, wobei <zahl> auf die aktuelle
                        Adresse gesetzt wird. 
-                       (F�r 'yc' / 'yb' sinnvoll: Man setzt den Cursor auf die Stelle, an der
-                       ein Break ausgel�st werden soll und gibt 'yc'/'yb'). 
-                       Somit wird dieser �nderungsmodus �blicherweise durch *return*
+                       (Für 'yc' / 'yb' sinnvoll: Man setzt den Cursor auf die Stelle, an der
+                       ein Break ausgelöst werden soll und gibt 'yc'/'yb'). 
+                       Somit wird dieser Änderungsmodus üblicherweise durch *return*
                        beendet. 
  
 #b("Einige Systemadressen")#
 #goalpage("sysaddr")# 
  
-Der Info n�tzt nur wenig, wenn man nicht wei�, was man sich anschauen soll. Wesentliche
-Angaben �ber die Systemstruktur enth�lt das 'Brikett' (interne Systemdokumentation f�r
-Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf imple-
-mentationsabh�ngige Konstanten ein. Diese sind hier aufgef�hrt. 
+Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche
+Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für
+Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf imple­
+mentationsabhängige Konstanten ein. Diese sind hier aufgeführt. 
  
-Ab 1s100h liegt die 'ktab'. Sie enth�lt Informationen, welche Bl�cke an welcher Stelle des
+Ab 1s100h liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des
 Arbeitsspeicher liegen: In der Kachel mit der Adresse 512*i befindet sich der Inhalt des
-Blockes, dessen Nummer in ktab+i, ktab+100h+i steht. Ferner enth�lt die Tabelle, zu
-welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt geh�rt. (Nur rele-
-vant, wenn die Proze�nummer <> 255 ist). 
+Blockes, dessen Nummer in ktab+i, ktab+100h+i steht. Ferner enthält die Tabelle, zu
+welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur rele­
+vant, wenn die Prozeßnummer <> 255 ist). 
  
 Steuerbits:   2**0 :  Inhalt wird gerade transportiert (zum HG oder Archiv). 
               2**1 :  Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die
-                      Kachel (per Software) zur�ckgesetzt. 
+                      Kachel (per Software) zurückgesetzt. 
               2**2 :  Schreiberlaubnis (siehe Brikett). 
-              2**3 :  Inhalt wurde k�rzlich benutzt. Solche Kacheln werden 'weniger stark'
-                      verdr�ngt. 
+              2**3 :  Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger stark'
+                      verdrängt. 
  
  
    ktab       frei           niederwertige Blocknummer 
  
    +80h       frei            frei      Steuerbits 
  
-   +100h      frei           h�herwertige Blocknummer 
+   +100h      frei           höherwertige Blocknummer 
  
-   +180h      frei            frei      Proze�nummer 
+   +180h      frei            frei      Prozeßnummer 
  
-   +200h      frei            frei      drid (proze�spezifisch) 
+   +200h      frei            frei      drid (prozeßspezifisch) 
  
-   +280h      frei            frei      Seitennummer (h�herw.) 
+   +280h      frei            frei      Seitennummer (höherw.) 
  
    +300h      frei            frei      Seitennummer (niederw.) 
  
@@ -2385,48 +2385,48 @@ Steuerbits:   2**0 :  Inhalt wird gerade transportiert (zum HG oder Archiv).
                             -- Beginn der Anforderungen 
  
  
-Der 'Beginn echter Kacheln' h�ngt von der Gr��e der 8086/8088-Teile ('urlader') ab (i.A.
-30h < i < 40h). 
+Der 'Beginn echter Kacheln' hängt von der Größe der 8086/8088-Teile ('urlader') ab (i.A.
+30h < i < 40h). 
  
-'Beginn der Anforderungen' liegt bei i=2. Es handelt sich um Blocknummern von zu laden-
-den Bl�cken. Ist der h�herwertige Teil der Blocknummer gleich FDh, so ist dies keine Anfor-
+'Beginn der Anforderungen' liegt bei i=2. Es handelt sich um Blocknummern von zu laden­
+den Blöcken. Ist der höherwertige Teil der Blocknummer gleich FDh, so ist dies keine Anfor­
 derung. 
  
-Blocknummern > FF00h stehen f�r Bl�cke mit dem Inhalt 512 FFh's und werden nie auf
+Blocknummern > FF00h stehen für Blöcke mit dem Inhalt 512 FFh's und werden nie auf
 dem Hintergrundmedium gespeichert. 
  
  
  
-1sA00h   enth�lt den DR-Eintrag des drdr (siehe Brikett). 
+1sA00h   enthält den DR-Eintrag des drdr (siehe Brikett). 
  
  
-'musta': Das System fordert Checkpoints und M�llabfuhren �ber die Zelle 'musta' an. Diese
+'musta': Das System fordert Checkpoints und Müllabfuhren über die Zelle 'musta' an. Diese
          findet man mit dem Info durch 
  
          xc musta 
  
-         (hierf�r ist der Text 'musta:' vor der Zelle abgesetzt). 
+         (hierfür ist der Text 'musta:' vor der Zelle abgesetzt). 
  
-         Die Zelle selbst enth�lt 
+         Die Zelle selbst enthält 
  
-              FFh   : Keine M�llabfuhr oder Checkpoint 
-              01h   : M�llabfuhr 
+              FFh   : Keine Müllabfuhr oder Checkpoint 
+              01h   : Müllabfuhr 
               02h   : Checkpoint 
               03h   : beides 
               04h   : Systemendecheckpoint 
               0Bh   : System auf Archiv schreiben ('save system') 
-              F0h   : M�llabfuhr und Checkpoint sind geperrt (nur durch Setzen im Info
-                      m�glich) 
+              F0h   : Müllabfuhr und Checkpoint sind geperrt (nur durch Setzen im Info
+                      möglich) 
  
-         Durch Einsetzen der Werte mit dem Info kann die entsprechende Operation ver-
-         anla�t werden. Beim Einsetzen darf der Info nicht im 'r'-Zustand (siehe Eingabe
-         'r') stehen; zum Ausf�hren der Operation mu� 'r' (man bleibt im Info) oder 'g' (Info
+         Durch Einsetzen der Werte mit dem Info kann die entsprechende Operation ver­
+         anlaßt werden. Beim Einsetzen darf der Info nicht im 'r'-Zustand (siehe Eingabe
+         'r') stehen; zum Ausführen der Operation muß 'r' (man bleibt im Info) oder 'g' (Info
          verlassen) gegeben werden. 
  
  
 1s480h-4FFh: 
-         enth�lt die Aktivierungstabelle. Ist (480h+i)=01h, so ist die Task i aktiv. Hin-
-         weis: 4FFh enth�lt immer 01h, ohne da� dieser Zelle eine Task zugeordnet ist. 
+         enthält die Aktivierungstabelle. Ist (480h+i)=01h, so ist die Task i aktiv. Hin­
+         weis: 4FFh enthält immer 01h, ohne daß dieser Zelle eine Task zugeordnet ist. 
  
  
 #b("Leitblock")#
@@ -2436,11 +2436,11 @@ Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Es werden Hexapa
 gefolgt von einer Bezeichnung, ausgegeben. In der folgenden Beschreibung werden die
 Hexapaare durch a,b,c dargestellt. 
  
-     a b c icount          Der virtuelle Befehlsz�hler der Task steht auf (cMOD4)*
+     a b c icount          Der virtuelle Befehlszähler der Task steht auf (cMOD4)*
                            10000h+b*100h+a = <ic> im Datenraum 4 dieser Task.
                            Durch die Eingabefolge: 
                                  4s<ic>w*return* 
-                           kann man sich den Code, der ausgef�hrt werden soll, ansehen. 
+                           kann man sich den Code, der ausgeführt werden soll, ansehen. 
  
                            Bit 2**7 von c zeigt den Fehlerzustand an. 
                            Bit 2**6 von c zeigt 'disable stop' (siehe Benutzerhandbuch)
@@ -2453,10 +2453,10 @@ Hexapaare durch a,b,c dargestellt.
      a b hptop             Der Arbeitsheap geht von 30000h (Byteadr.) bis (aMOD16)*
                            10000h+b* 100h+(aDIV16)*10h (Byteadr!). 
  
-     a b channel           Die Task h�ngt an Kanal 100h*b+a (Terminalnummer). 0 =
+     a b channel           Die Task hängt an Kanal 100h*b+a (Terminalnummer). 0 =
                            kein Terminal angekoppelt. 
  
-     a b taskid            Die Tasknummer der betrachteten Task ist a. (b ist die Ver-
+     a b taskid            Die Tasknummer der betrachteten Task ist a. (b ist die Ver­
                            sionsnummer zum Abdichten von 'send'/ 'wait'). 
  
 Um den Code, auf den der 'icount' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. 
@@ -2467,8 +2467,9 @@ Hinweis: Wenn der Info einen internen Fehler anzeigt, und auch bei 'ke', ist der
          'g' erzwingen. (Der Info stellt wegen 'r' dem Interpreter einen Restart zu, der dann
          beim 'g' den Leitblock aktualisiert und den Befehl erneut aufsetzt). Tritt dabei der
          Fehler nicht wieder auf, handelte es sich um einen transienten Fehler (z.B. der
-         Codeblock war noch im Einlesen und ist jetzt voll da). So etwas kann z.B. passie-
-         ren, wenn der SHard den Abschlu� einer Leseoperation zu fr�h meldet. 
+         Codeblock war noch im Einlesen und ist jetzt voll da). So etwas kann z.B. passie­
+         ren, wenn der SHard den Abschluß einer Leseoperation zu früh meldet. 
+
 
 
 
diff --git a/doc/porting-8086/8/source-disk b/doc/porting-8086/8/source-disk
new file mode 100644
index 0000000..8aeb5a2
--- /dev/null
+++ b/doc/porting-8086/8/source-disk
@@ -0,0 +1 @@
+porting/portdoc-x86-8.img
diff --git a/doc/porting-mc68k/1985.11.26/doc/Port.68000 b/doc/porting-mc68k/1985.11.26/doc/Port.68000
new file mode 100644
index 0000000..0ca6840
--- /dev/null
+++ b/doc/porting-mc68k/1985.11.26/doc/Port.68000
@@ -0,0 +1,2173 @@
+#type ("trium8")##limit (12.0)# 
+#start(2.0,1.5)# 
+#type("triumb36")# 
+#free(4.0)# 
+   EUMEL 
+   Portierungs­ 
+   handbuch 
+   MC68000 
+#type("triumb18")# 
+#free(1.5)# 
+      Stand 26.11.85 
+#page(1)# 
+#type ("trium8")##limit (12.0)# 
+#block# 
+#pagelength(18.4)# 
+#head# 
+#center#- % - 
+ 
+ 
+#end# 
+#type("triumb12")#Inhalt#a# 
+ 
+ 
+ 
+Teil 1: Einführung                                     #topage("ein")# 
+#free(0.3)# 
+        Zweck dieses Handbuchs                         #topage("zweck")# 
+        Referenzliteratur                              #topage("reflit")# 
+        Minimale Hardwarevoraussetzungen               #topage("hardw")# 
+        Systemdurchsatz                                #topage("durchsatz")# 
+        Softwarekomponenten des EUMEL-Systems          #topage("kompo")# 
+        Anlieferung des MC68000-EUMEL-Systems          #topage("anlief")# 
+ 
+Teil 2: Allgemeine Strukturen                          #topage("allgem")# 
+#free(0.3)# 
+        Hintergrund                                    #topage("hg")# 
+        Archiv                                         #topage("arch")# 
+        Hauptspeicher                                 #topage("speicher")# 
+ 
+Teil 3: SHard-Interface Spezifikation                 #topage("shardifc")# 
+#free(0.3)# 
+   0. Vorbemerkungen                                  #topage("vor")# 
+        Zur Notation                                  #topage("not")# 
+        Link-Leisten                                  #topage("leist")# 
+        Allgemeine Link-Bedingungen                   #topage("link")# 
+        Interrupts                                    #topage("intr")# 
+   1. System laden                                    #topage("laden")# 
+   2. Systemstart und -ende                           #topage("start")# 
+   3. Speicherverwaltung                              #topage("spver")# 
+      Hauptspeicher                                   #topage("haupt")# 
+      Speicherfehler                                  #topage("memerr")# 
+   4. Zeitgeber                                       #topage("zeit")# 
+   5. Kanäle                                          #topage("channel")# 
+   5.1  Stream-IO                                     #topage("stream")# 
+        Terminals                                     #topage("term")# 
+        Drucker, Plotter                              #topage("druck")# 
+        Exoten                                        #topage("exot")# 
+   5.2  Block-IO                                      #topage("block")# 
+        Block-IO bei Hintergrund und Archiv           #topage("bhgarch")# 
+   5.3  I/O-Steuerung                                 #topage("iocontrol")# 
+        Konfigurierung serieller Schnittstellen       #topage("v24")# 
+        Flußkontrolle                                 #topage("fluss")# 
+        Kalender                                      #topage("kalender")# 
+   6. SHard-Interface Version                         #topage("shdver")# 
+   7. ID-Konstanten                                   #topage("ID")# 
+   8. Zusätzliche Leistungen                          #topage("shdelan")# 
+   9. Spezialroutinen                                 #topage("ke")# 
+ 
+Teil 4: Tips zur Portierung                           #topage("tips")# 
+#free(0.3)# 
+        Nullversion des SHards                        #topage("0ver")# 
+        Typische Fehler                               #topage("fehler")# 
+        Effizienzprobleme                             #topage("eff")# 
+ 
+Anhang A: EUMEL-Debugger "Info"                       #topage("info")# 
+#free(0.3)# 
+        Aufruf des Infos                              #topage("aufrinf")# 
+        Info-Format                                   #topage("forminf")# 
+        Info-Kommandos                                #topage("cmdinf")# 
+        Einige Systemadressen                         #topage("sysaddr")# 
+        Leitblock                                     #topage("pcb")# 
+ 
+Anhang B: Einige EUMEL-Begriffe                       #topage("glossar")# 
+#page# 
+#cc("Teil 1: ","Einführung")##goalpage("ein")# 
+ 
+ 
+#b("Zweck dieses Handbuchs")##goalpage("zweck")# 
+ 
+Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf
+einem neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungs­
+handbüchern für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit
+MC68000-Prozessoren. 
+ 
+Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! 
+ 
+ 
+ 
+#b("Referenzliteratur")##goalpage("reflit")# 
+ 
+ 
+    "EUMEL Benutzerhandbuch" 
+ 
+    "EUMEL Systemhandbuch" 
+ 
+    "EUMEL Quellcode der insertierten ELAN-Pakete" 
+ 
+    "MC68000 16-bit microprocessor  -  Users Manual" 
+    Motorola, 1982 
+ 
+    "68000 Assembler Reference" 
+    XENIX Group, Microsoft Corp., 1982 
+ 
+    "Anhang zu '68000 Assembler Reference'" 
+    TA Nürnberg, 1984 
+ 
+ 
+Siehe auch die Vorbemerkungen zur Notation in Teil 3 (S. #topage("not")#), sowie die Begriffserklä­
+rungen im Anhang B (S. #topage("glossar")#). 
+ 
+ 
+#b("Minimale Hardwarevoraussetzungen")##goalpage("hardw")# 
+ 
+Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens
+folgenden Kriterien genügen: 
+ 
+    #ib#CPU#ie#           Die MC68000-CPU sollte mit mindestens 8.0 MHz arbeiten. Falls die
+                  Buszugriffe durch einen CRTC o.ä. verlangsamt werden, sollte die
+                  echte MC68000-Leistung durchschnittlich mindestens einem unge­
+                  bremsten 8.0 MHz System entsprechen. 
+                  Seltene Verlangsamungen (z.B. nur bei I/O-Operationen) spielen bei
+                  diesen Überlegungen keine Rolle. 
+ 
+    RAM           Das System sollte über mindestens 256 KByte #ib#Hauptspeicher#ie# verfü­
+                  gen. 
+ 
+    #ib#Hintergrund#ie#   Als Hintergrundmedium sind #ib#Diskette#ie#, #ib#Platte#ie# und RAM bzw. ROM
+                  denkbar. 
+ 
+                  Kapazität: 
+                        > 300 K, besser > 400 K (Single-User) 
+                        > 750 K, besser > 1000 K (Multi-User) 
+ 
+                  Zugriff: *) 
+#foot# 
+#f#*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Disketten kann
+man sie als Summe der Positionierzeit über die halbe Anzahl der Spuren und der Zeit einer halben Umdrehung be­
+rechnen. 
+#a# 
+#end# 
+                        < 500 ms  (Single-User) 
+                        < 200 ms  (Multi-User) 
+ 
+    #ib#Archiv#ie#        Als Archiv wird meistens eine Diskette eingesetzt. Aber auch Band
+                  oder Kassette sind denkbar. Die Anforderungen an Kapazität und
+                  Geschwindigkeit sind anwendungsspezifisch. 
+ 
+    #ib#Bildschirm#ie#    Angestrebt werden sollte ein Bildschirm mit 24 Zeilen zu je 80 Zeichen
+                  (oder größer). Kleinere Bildschirme sind anschließbar, aber mit 40 Zei­
+                  chen pro Zeile läßt sich nicht mehr komfortabel arbeiten. 
+                  Rollup und freie Cursorpositionierung sind notwendige Voraussetzun­
+                  gen, invers-video ist erwünscht, aber nicht notwendig. Weiterhin
+                  werden die Funktionen 'Löschen bis Zeilenende' und 'Löschen bis
+                  Schirmende' benötigt. 
+ 
+    #ib#Tastatur#ie#      An Steuertasten sollten mindestens ESC und die vier Cursortasten
+                  vorhanden sein. Dabei ist es günstig, wenn die Cursortasten ergono­
+                  misch als Block bzw. Kreuz angeordnet sind. EUMEL benötigt weitere
+                  Steuertasten für HOP, RUBIN, RUBOUT und MARK. Dafür können
+                  beliebige, anderweitig nicht benötigte Tasten der Tastatur gewählt
+                  werden. 
+ 
+ 
+ 
+#b("Systemdurchsatz")##goalpage("durchsatz")# 
+ 
+Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­
+durchsatz von 
+ 
+    - CPU Leistung 
+    - Speichergröße (RAM) 
+    - Geschwindigkeit beim Hintergrundzugriff (Diskette, Platte) 
+ 
+ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging
+(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­
+leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang
+steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt
+wenig RAM durch eine schnelle Platte ausgleichen. 
+ 
+ 
+ 
+#b("Softwarekomponenten des EUMEL-Systems")##goalpage("kompo")# 
+ 
+Das EUMEL-System besteht aus mehreren Schichten: 
+ 
+ 
+          EUMEL  2:   Standardpakete, Editor, ... 
+ 
+          EUMEL  1:   ELAN Compiler 
+ 
+          EUMEL  0:   Systemkern (EUMEL-0-Maschine, EUMEL-0) 
+ 
+          EUMEL -1:   SHard 
+ 
+                  H a r d w a r e 
+ 
+ 
+Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere)
+Schichten erweitert werden. 
+ 
+EUMEL > 0    Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN ge­
+             schrieben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schich­
+             ten oberhalb der EUMEL-0-Maschine prozessor- und rechnerunabhän­
+             gig, d.h. Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. 
+ 
+EUMEL   0    Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und
+             hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie
+             existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ
+             MC68000 Bezug genommen. Bei der Portierung auf einen MC68000-
+             Rechner wird die MC68000-EUMEL-0-Maschine ohne Anpassungen (!)
+             übernommen. 
+ 
+EUMEL  -1    Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und
+             der eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere
+             umfaßt sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber).
+             Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). 
+ 
+Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen MC68000-
+Rechner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil
+dieses Handbuchs aus der Spezifikation des MC68000-SHards. 
+ 
+ 
+ 
+#b("Anlieferung des MC68000-EUMEL-Systems")##goalpage("anlief")# 
+ 
+Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende
+Standardformate zur Wahl: 
+ 
+    Diskette 200 (8"), 1D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte 
+ 
+    Diskette 130 (5.25"), 2D, 40 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte *) 
+#foot# 
+#f#*) 48 tpi 
+#a# 
+#end# 
+ 
+ 
+Die Diskettenlieferung **) enthält 
+#foot# 
+#f#**) Zu Inhalt und Zweck der angelieferten Disketten siehe EUMEL Systemhandbuch, Teil 1: System einrichten. 
+#a# 
+#end# 
+ 
+    - Single-User Hintergrund 
+    - Multi-User Hintergrund 
+    - Standardarchive 
+    - ggfs. Archive mit weiterer Anwendersoftware (installationsspezifisch) 
+ 
+Dabei enthält der Hintergrund auch die EUMEL-0-Maschine (oft auch als "Urlader"
+bezeichnet). 
+ 
+#on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als
+Quelle beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# 
+#page# 
+#cc("Teil 2: ","Allgemeine Strukturen")##goalpage("allgem")# 
+ 
+ 
+#b("Hintergrund")##goalpage("hg")# 
+ 
+Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern
+(0, 1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium
+bleibt dem SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte
+darauf achten, daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen
+sollten. Deshalb ist in der Regel zylinderorientierte Anordnung der oberflächenorientierten
+vorzuziehen. 
+ 
+Falls auf dem Hintergrundmedium spezielle Blöcke z.B. für Bootstrap und SHard freige­
+halten werden sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die
+Sektoren der Diskette bzw. der Platte berücksichtigt werden. 
+ 
+Aufbau des Hintergrundes: 
+ 
+    Block  0                Systemetikett 
+ 
+    Block  10...10+k-1      EUMEL-0-Maschine (z.Zt. ist k=200; dieser Wert ist nur
+                            für EUMEL-0 von Bedeutung) 
+ 
+    Block  1...9, 10+k ...  Paging-Bereich 
+ 
+ 
+Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#): 
+ 
+    Byte        Wert/Aufgabe 
+ 
+    0...5       "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. 
+    6...11      Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß System-
+                kern und Hintergrund kompatibel sind. 
+    12          zur Zeit ohne Bedeutung 
+    13          enthält Wert 0 , wenn System im Shutupzustand ist. 
+    14..15      Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1
+                erhöht. 
+    16..35      Reserviert; zur Zeit ohne Bedeutung 
+    36..37      Aus historischen Gründen für interne Zwecke belegt. 
+    38..69      Hier kann eine Installationsnummer geführt werden. 
+    70..79      Info-Paßwort 
+    80          =0 Normalzustand 
+                =1 Kompresslauf erforderlich (System frisch von Archiv geladen) 
+    81...255    Reserviert. 
+    256..511    Kann von SHard beliebig verwendet werden. 
+ 
+ 
+ 
+#b("Archiv")##goalpage("arch")# 
+ 
+Wie der Hintergrund, sind die Archive in 512 Bytes große Blöcke unterteilt *). Bisher gibt
+es folgende #d("Standardformate")#: 
+#foot# 
+#f#*) Der genaue Aufbau der Archivblöcke ist weder für den SHard-Implementierer, noch für den Benutzer von Be­
+deutung. SHard hantiert nur mit Blöcken aufgrund von Blocknummern, unabhängig vom Inhalt der Blöcke. Der Benut­
+zer "sieht" nur Datenräume bzw. Dateien, unabhängig von ihrem Format auf dem Archiv. 
+#a# 
+#end# 
+ 
+ 
+    Diskette 200 (8"), 1D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte 
+    Diskette 200 (8"), 2D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte 
+ 
+      Block       Seite             Spur             Sektor 
+ 
+        0           0                 0                 0 
+       16           0                 1                 0 
+      77*16         1                 0                 0 
+ 
+        n     n DIV (77*16)   n MOD (77*16) DIV 16   n MOD 16 
+ 
+ 
+    Diskette 130 (5.25"), 2D, 40 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte 
+ 
+      Block       Seite             Spur             Sektor 
+ 
+        0           0                 0                 1 
+        9           0                 1                 1 
+      40*9          1                 0                 1 
+ 
+        n     n DIV (40*9)    n MOD (40*9) DIV 9   n MOD 9 + 1 
+ 
+ 
+     Diskette 130 (5.25"), 2D, 80 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte 
+ 
+       Block       Seite             Spur             Sektor 
+ 
+         0           0                 0                 1 
+         9           0                 1                 1 
+       80*9          1                 0                 1 
+ 
+         n     n DIV (80*9)   n MOD (80*9) DIV 9    n MOD 9 + 1 
+ 
+ 
+     Diskette 130 (5.25"), HD, 80 Spuren, 15 Sektoren (\#1...\#15) zu 512 Byte 
+ 
+       Block       Seite             Spur             Sektor 
+ 
+         0           0                 0                 1 
+        15           0                 1                 1 
+       80*15         1                 0                 1 
+ 
+         n   n DIV (80*15)   n MOD (80*15) DIV 15    n MOD 15 + 1 
+ 
+ 
+Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus
+Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in
+der Kapazität) ergeben. 
+ 
+Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate
+unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen ver­
+schiedenen Rechnertypen zu vereinfachen. 
+ 
+#on("i")#Hinweis:  Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfa­
+          chen, sollten möglichst alle hardwaremäßig möglichen Standardformate (min­
+          destens lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf
+          das Format der jeweils eingelegten Diskette einstellen:#off("i")# 
+ 
+ 
+            Laufwerkstyp      Diskettentyp(en) 
+ 
+               8" 1D              8" 1D 
+               8" 2D              8" 2D, 1D 
+ 
+               5" 2D-40           5" 2D-40 
+               5" 2D-80           5" 2D-80, 2D-40 *) 
+               5" HD-80           5" HD-80, 2D-80, 2D-40 *) 
+ 
+#foot# 
+#f#*) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: 
+     a) Lesen funktioniert sicher. 
+     b) Schreiben ist unsicher, funktioniert aber häufig. 
+     c) Formatieren funktioniert fast nie. 
+#a# 
+#end# 
+ 
+ 
+ 
+#b("Hauptspeicher")##goalpage("speicher")# 
+ 
+Der #ib#Speicher#ie# wird EUMEL-0 vom SHard in maximal vier Speicherbereichen (M0...M3)
+zugewiesen. Die Anfangsadresse eines solchen Bereiches muß ein Vielfaches von 512B
+sein. M0 muß immer vorhanden sein, M1, M2 und M3 nur in speziellen Betriebsarten: 
+ 
+     #d("M0")#   #on("b")#allgemeines #ib#RAM#ie(1,", allgemeines")##off("b")# 
+          Dieser Bereich muß immer vorhanden sein. Bei den meisten Rechnern liegt der
+          Systemkern nicht in einem ROM, sondern wird von SHard in das RAM geladen.
+          Das geschieht dann an den Anfang von M0. Der Rest wird für Tabellen und als
+          Pagingbereich benutzt. M0 umfaßt deshalb meistens allen verfügbaren Spei­
+          cher, bis auf den Platz für SHard, Boot-ROM und Bildwiederholspeicher. **) 
+#foot# 
+#f#**) Der im Tabellenspeicher liegende 'ktab' ist für die Verwaltung von max. 2048 Kacheln (=1MB) ausgelegt. Der
+Speicherbedarf des Systemkerns liegt bei 80KB, für Tabellen werden 40KB benötigt. Dies sollte man bei der Angabe
+von M0SIZE berücksichtigen. 
+#a# 
+#end# 
+ 
+     #d("M1")#   #on("b")#Systemkern-#ib#ROM#ie(1,", Systemkern")##off("b")# 
+          Gibt es nur bei Rechnern, die den Systemkern in einem ROM haben. (M0 wird
+          dann nur für Tabellen und als Pagingspeicher eingesetzt.) 
+ 
+     #d("M2")#   #on("b")#Hintergrund-#ib#ROM#ie(1,",Hintergrund")##off("b")# 
+          Gibt es nur bei Rechnern, die nicht Diskette oder Platte sondern ROM und
+          RAM als Hintergrundspeicher verwenden. 
+ 
+     #d("M3")#   #on("b")#Hintergrund-#ib#RAM#ie(1,",Hintergrund")##off("b")# 
+          Gibt es nur bei Rechnern, die nicht Diskette oder Platte sondern ROM und
+          RAM oder RAM allein als Hintergrundspeicher verwenden. 
+ 
+Damit sind drei verschiedene Betriebsarten des EUMEL-Systems möglich: 
+ 
+     #d("Normalbetrieb")#:     M0  (> 256 KB) 
+                        Hintergrundgerät (Platte oder Diskette) 
+                        Archivgerät (Diskette) 
+ 
+          Im Normalbetrieb befindet sich der Hintergrund auf einer Platte oder Diskette
+          RAM wird für den Systemkern und zum Paging eingesetzt. Alle mittleren und
+          größeren Systeme verwenden den Normalbetrieb. 
+ 
+ 
+     #d("Minibetrieb")#:       M0  (> 256 KB) 
+                        M3  (mindestens 300 KB) 
+                        Archivgerät (Diskette) 
+ 
+          Im Minibetrieb wird RAM als Hintergrundspeicher eingesetzt. Dieser wird beim
+          Einschalten über das Archivgerät geladen und beim Abschalten ('shutup')
+          wieder zurückgeschrieben. 
+ 
+ 
+     #d("ROM-Betrieb")#:       M0  (>40 KB) 
+                        M1  (>60 KB) 
+                        M2  (>170 KB) 
+                        M3  (>60 KB) 
+                        Archivgerät (Kassettenrecorder oder Diskettenlaufwerk) 
+ 
+          Im ROM-Betrieb stehen Systemkern und Standardteil des Hintergrundes im
+          ROM. Der übrige Hintergrund befindet sich im RAM. *) 
+#foot# 
+#f#*) Für ROM-Betrieb benötigt man eine Spezialversion des Systemkerns. 
+#a# 
+#end# 
+ 
+#page# 
+#cc("Teil 3: SHard ","Interface Spezifikation")##goalpage("shardifc")# 
+ 
+ 
+#bb("0.  ","Vorbemerkungen")##goalpage("vor")# 
+ 
+ 
+#b("Zur Notation")##goalpage("not")# 
+ 
+Im folgenden wird zwischen #d("0-Routinen")#, die dem SHard vom EUMEL-0-System zur
+Verfügung gestellt werden, und 
+#d("SHard-Routinen")# unterschieden, die der SHard implementieren muß. Damit dieser Unter­
+schied bei der Spezifikation deutlich wird, werden 0-Routinen folgendermaßen aufgeführt: 
+ 
+          name       (0-Routine) 
+ 
+Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrie­
+ben. 
+ 
+MC68000-Befehle werden wie im "Anhang zu '68000 Assembler Reference'", (TA, 1984)
+notiert: 
+ 
+          moveq  \#27,d0 
+          addw   d3,d1 
+ 
+ 
+Hexadezimale Zahlen werden durch ein vorangestelltes '/' gekennzeichnet: 
+ 
+          /12    = 18 
+          /1f    = 31 
+          /ffff  = 65535 
+ 
+ 
+Achtung: Die Übergabe von Integer-Parametern zwischen SHard und EUMEL-0 erfolgt
+         grundsätzlich in den niederwertigen 16 Bits des jeweils angegebenen Daten­
+         registers. 
+ 
+#b("Link-Leisten")##goalpage("leist")# 
+ 
+Die Verbindung zwischen SHard und EUMEL-0 erfolgt über zwei Tabellen. In der
+"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese
+Leiste beginnt an der Adresse M0 (im Normal- oder Minimodus) bzw. M1 (im ROM-
+Modus): 
+ 
+ Adresse  Assemblerbefehl 
+ 
+  M0 + 0  eumel0id:        .ascii "EUMEL jj-mm-tt  " !Kennung mit Datum 
+     +16  eumel0blocks:    .word ...   !Anzahl EUMEL0-Bloecke auf HG 
+     +18  hgver:           .word 173   !HG-Versionsnummer 
+     +20  cputype:         .word 4     !MC68000 oder kompat. CPU 
+     +22  eumel0ver:       .word mmmtt !EUMEL0-Version (mmm=1 --> Jan.84) 
+     +24  shdvermin:       .word 8     !Minimum bzw. Maximum fuer die 
+     +26  shdvermax:       .word 8     ! SHard-Versionsnummer 
+     +28  systemstart:     jmp ...     !Ab hier stehen Sprungbefehle zu 
+     +34  inputinterrupt:  jmp ...     ! den entsprechenden 0-Routinen 
+     +40  timerinterrupt:  jmp ... 
+     +46  warte:           jmp ... 
+     +52  shutup:          jmp ... 
+     +58  info:            jmp ... 
+ 
+ 
+Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung
+stellen: 
+ 
+ Adresse  Assemblerbefehl 
+ 
+SHDID+ 0  SHDID:       .ascii "SHARD jj-mm-tt  " !Kennung mit Datum 
+     +16  SHDVER:      .word 8  !Versionsnummer d. SHard-Schnittstelle 
+     +18  MODE:        .word    !Modusbits: 
+           BITEUDEL   =  0          ! EUMEL-0-Bloecke auf HG freigeben 
+           BITNORMAL  =  1          ! Normalbetrieb 
+           BITMINI    =  2          ! Minibetrieb 
+           BITROM     =  3          ! ROM-Betrieb 
+     +20  ID4:         .word    !ID-Konstanten (s.S. #topage("ID")#) 
+     +22  ID5:         .word    ! dito 
+     +24  ID6:         .word    ! dito 
+     +26  ID7:         .word    ! dito 
+     +28  OUTCHAR:     jmp      !Ab hier stehen Sprungbefehle in die 
+     +34  OUTPUT:      jmp      ! entsprechenden SHard-Routinen 
+     +40  BLOCKIN:     jmp 
+     +46  BLOCKOUT:    jmp 
+     +52  IOCONTROL:   jmp 
+     +58  SYSEND:      jmp 
+     +64  SYSABORT:    jmp 
+     +70  M0START:     .long    !Startadr bzw. 
+     +74  M0SIZE:      .long    ! Länge (in Bytes) des Bereiches M0 
+     +78  M1START:     .long    ! dito f. M1 
+     +82  M1SIZE:      .long 
+     +86  M2START:     .long    ! dito f. M2 
+     +90  M2SIZE:      .long 
+     +94  M3START:     .long    ! dito f. M3 
+     +98  M3SIZE:      .long 
+ 
+ 
+ 
+#b("Allgemeine Link-Bedingungen")##goalpage("link")# 
+ 
+In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'jbsr' aufzurufen: 
+ 
+          jbsr   <routine> 
+ 
+Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. 
+ 
+Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: 
+ 
+     Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und die 'condi­
+     tion code'-Flags im Status Register *) - bleiben unverändert. 
+#foot# 
+#f#*) Condition-Code-Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags,
+die als Ausgangsparameter in manchen Fällen definiert sind. 
+#a# 
+#end# 
+ 
+Jede SHard-Routine muß also alle Register, die sie verändert und die keine Ausgangs­
+parameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim Aufruf von
+0-Routinen selbst keine Register zu retten. 
+ 
+ 
+ 
+#b("Interrupts")##goalpage("intr")# 
+ 
+Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von
+EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'jbsr' an 0-Routinen
+weiterleiten. 
+Die Register (bis auf die Parameterregister) werden von den aufzurufenden 0-Routinen
+selbst gesichert. Die normale Interrupt-Sequenz im SHard sieht dann folgendermaßen
+aus: 
+ 
+      intadr:  movl   d0,(sp)- 
+               movw   <parameter>,d0 
+               jbsr   <routine> 
+               andw   \#/fcff,sr ! interrupt level freigeben 
+               movl   (sp)+,d0 
+               rti 
+ 
+Achtung: SHard muß die Interrupt-Routinen im 'disable-int'-Modus anspringen, d.h. im
+         Status Register muß der korrekte Interrupt-Level gesetzt sein. (MC68000 setzt
+         beim Interrupt schon automatisch die Interrupt-Level-Flags.) 
+ 
+ 
+ 
+ 
+ 
+#bb("1.  System ","laden")##goalpage("laden")# 
+ 
+SHard muß die EUMEL-0-Software vor dem eigentlichen Start an den Anfang des Spei­
+cherbereiches M0 laden. EUMEL-0 befindet sich auf dem Hintergrund von Block 10 ab.
+Der erste Block von EUMEL-0 enthält am Anfang die 0-Leiste. Dort steht an der
+Byteadresse 16 die Größe 'eumel0blocks'. Sie gibt an, wieviel Blöcke konsekutiv geladen
+werden müssen. Hat sie beispielsweise den Wert 80, müssen die Blöcke 10 bis 89 gela­
+den werden. 
+ 
+    Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen natür­
+             lich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht
+             'warte' aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff
+             beim eigentlichen Systemlauf in der Regel 'warte' verwenden wird. 
+ 
+    Hinweis: Der erste Block von EUMEL-0 enthält in den ersten fünf Bytes den Text
+             "EUMEL", um eine Identifikation durch den SHard-Lader zu ermöglichen. 
+ 
+Es wird empfohlen, nach folgendem Verfahren zu laden: 
+ 
+    IF archivgeraet enthaelt diskette AND eumel 0 auf archiv 
+      THEN lade eumel 0 vom archiv 
+    ELIF eumel 0 auf hintergrund 
+      THEN lade eumel 0 vom hintergrund 
+    ELSE laden unmoeglich 
+    FI . 
+ 
+So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­
+grund (mit EUMEL-0) einspielen, indem man ein Hintergrundarchiv vor dem Systemstart
+in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den Hinter­
+grund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrundmedium
+kopieren kann.*) 
+#foot# 
+#f#*) Kopiervorgänge (Archiv -> Hintergrund) werden von EUMEL-0 erledigt, so daß SHard keine derartigen Routinen
+enthalten muß. 
+#a# 
+#end# 
+ 
+ 
+ 
+ 
+#bb("2.  System","start und -ende")##goalpage("start")# 
+ 
+SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen
+und erst danach die EUMEL-0-Maschine starten ('systemstart'). 
+ 
+    #d("systemstart")#           (0-Routine) 
+ 
+       Eingang:      a0 = Adresse der SHard-Leiste 
+ 
+       Aufruf:       jmp systemstart 
+ 
+       Zweck:        Die EUMEL-0-Maschine wird gestartet. Alle notwendigen Hard­
+                     wareinitialisierungen (z.B. der Peripheriebausteine) müssen vorher
+                     schon geschehen sein. 
+ 
+       Hinweis:      SHard muß den Stackpointer (a7) "vorläufig" definieren (etwa 100
+                     Langworte reichen dafür aus), da beim Sprung in EUMEL-0 Inter­
+                     rupts auftreten können. 
+ 
+ 
+ 
+    #d("SYSEND")# 
+ 
+       Parameter:    - 
+ 
+       Zweck:        Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt. Somit
+                     können evtl. notwendige Abschlußbehandlungen durchgeführt
+                     werden. SHard kann mit 'rts' zu EUMEL-0 zurückkehren, muß
+                     aber nicht. Diese Routine kann z.B. dazu benutzt werden, die
+                     Hardware auszuschalten oder in ein umgebendes System zurück­
+                     zukehren (EUMEL als Subsystem). In den meisten Fällen wird die
+                     Routine leer implementiert werden, d.h. nur aus 'rts' bestehen. 
+ 
+ 
+ 
+ 
+#bb("3.  ","Speicherverwaltung")##goalpage("spver")# 
+ 
+ 
+#b("Hauptspeicher")##goalpage("haupt")# 
+ 
+Der Hauptspeicher umfaßt die Teile des MC68000-Speichers, die EUMEL-0 verwalten
+darf. 
+ 
+ 
+ 
+#b("Speicherfehler")##goalpage("memerr")# 
+ 
+Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen
+und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt wer­
+den. 
+ 
+Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er, wenn
+möglich, eine entsprechende Meldung ausgeben und das System anhalten: 
+ 
+       basta: jra basta 
+ 
+ 
+Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die
+Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern
+führen. 
+ 
+Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL-
+Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält
+aber auf alle Fälle ein konsistentes System. 
+ 
+ 
+ 
+ 
+#bb("4.  ","Zeitgeber")##goalpage("zeit")# 
+ 
+SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt.
+Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr
+nicht geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. 
+ 
+    #d("timerinterrupt")#         (0-Routine) 
+ 
+       Eingang:      d0 = seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) 
+ 
+       Zweck:        Wird von EUMEL-0 für interne Uhren und für das Scheduling
+                     (Zeitscheibenlogik) verwendet. Es werden keine hohen Genauig­
+                     keitsanforderungen an die Zeitangaben bei #on("i")#einzelnen#off("i")# Interrupts
+                     gestellt. Um EUMEL-0 eine genaue Realzeituhr zu ermöglichen,
+                     sollte die so erzeugte Zeitangabe #on("i")#im Mittel#off("i")# aber möglichst genau
+                     sein, d.h. die Summe der innerhalb einer Minute so übergebenen
+                     Werte sollte zwischen 59995 und 60005 liegen. 
+ 
+ 
+ 
+ 
+#bb("5.  ","Kanäle")##goalpage("channel")# 
+ 
+Einiges zum Kanalkonzept: 
+ 
+Das System kennt die Kanäle 0..32. 
+ 
+     Kanal 0        ist der Systemhintergrund. 
+     Kanäle 1..15   sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. 
+     Kanal 31       ist der Standard-Archivkanal. 
+     Kanal 32       ist der Parameterkanal. 
+ 
+Die Kanäle 2..30 können installationsabhängig verfügbar sein oder auch nicht. Deren
+Funktion ist dann Absprachesache zwischen Installation und SHard. 
+ 
+Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..)
+angesprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des
+Kanals sinnvoll ist. 
+ 
+#on("i")##on("b")#Achtung:  Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen
+          werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und
+          unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert werden.#off("b")#
+          (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# 
+ 
+ 
+ 
+#bb("5.1 ","Stream-IO")##goalpage("stream")# 
+ 
+Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Ter­
+minals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. 
+ 
+    #d("inputinterrupt")#        (0-Routine)#goalpage("inp")# 
+ 
+       Aufruf:            movl  kanalnummer,(sp)-    !1...15 
+                          movl  zeichen,(sp)-        !rechtsbündig 
+                          jbsr  inputinterrupt 
+                          lea   8(sp),sp             !restore stackpointer 
+ 
+       Zweck:        SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen, daß
+                     eine Eingabe vorliegt. 
+ 
+       Hinweise:     EUMEL-0 puffert die Zeichen. EUMEL-0 signalisiert den Zustand
+                     "Puffer voll" durch IOCONTROL "stop" und ignoriert weitere
+                     Eingaben, bis wieder Platz im Puffer vorhanden ist. (siehe
+                     IOCONTROL "stop" und "weiter", S.#topage("weiter")#) 
+ 
+                     Bei Kanalnummern <1 oder >15 wird der Aufruf von EUMEL-0
+                     ignoriert. 
+ 
+                     Falls die Hardware keine Inputinterrupts zur Verfügung stellt, sollte
+                     ein Timer benutzt werden, um alle möglichen Inputquellen regel­
+                     mäßig abzufragen. Dabei muß man allerdings den goldenen Mittel­
+                     weg zwischen zu häufiger (Systemdurchsatz sinkt) und zu seltener
+                     Abfrage (Zeichen gehen verloren) suchen. Man sollte dabei nicht
+                     nur an die menschliche Tippgeschwindigkeit sondern auch an die
+                     höchste Baudrate denken, die man für Rechnerkopplungen noch
+                     unterstützen will. *) 
+ 
+#foot# 
+#f#*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funk­
+tion "weiter" beschrieben (siehe S.#topage("weiter")#). 
+#a# 
+#end# 
+ 
+Achtung:             #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden. Nor­
+                     malerweise wird das automatisch verhindert, wenn man den
+                     zugehörigen Hardwareinterrupt erst nach der 0-Routine wieder
+                     freigibt. Falls das nicht möglich ist und unter bestimmten Umstän­
+                     den das nächste Zeichen abgeholt werden muß, bevor die
+                     0-Routine beendet ist, muß SHard einen eigenen Puffer imple­
+                     mentieren:#off("i")# 
+ 
+                         hardwareinterrupt: 
+                             IF input interrupt aktiv 
+                             THEN trage zeichen in shard puffer ein; 
+                                  gib hardware interrupt frei 
+                             ELSE input interrupt aktiv := true; 
+                                  gib hardware interrupt frei; 
+                                  input interrupt; 
+                                  disable interrupt; 
+                                  WHILE shard puffer enthaelt noch zeichen 
+                                  REP nimm zeichen aus shard puffer; 
+                                      enable interrupt; 
+                                      input interrupt; 
+                                      disable interrupt 
+                                  PER; 
+                                  input interrupt := false; 
+                                  enable interrupt 
+                             FI. 
+ 
+ 
+    #d("OUTPUT")# 
+ 
+       Eingang:      d0 = Kanalnummer (1...15) 
+                     d2 = Anzahl auszugebender Zeichen 
+                     a0 = Adresse der Zeichenkette 
+       Ausgang:      d2 = Anzahl der übernommenen Zeichen 
+ 
+       Zweck:        Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwischen­
+                     zupuffern, denn die Ausführung von OUTPUT sollte kein Warten
+                     auf IO enthalten. Der Ausgabepuffer muß mindestens 50 Zeichen
+                     fassen können. Durch eine Interruptlogik oder etwas Äquivalentes
+                     ist sicherzustellen, daß dieser Puffer parallel zur normalen Verar­
+                     beitung ausgegeben wird. Wenn die auszugebende Zeichenkette
+                     nicht vollständig in den Puffer paßt, sollten trotzdem so viele
+                     Zeichen wie möglich übernommen werden. Im weiteren Verlauf ruft
+                     EUMEL-0 dann wieder OUTPUT mit dem Rest der Zeichenkette
+                     auf. 
+ 
+ 
+       Achtung:      #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte' auf­
+                     gerufen werden.#off("i")# 
+ 
+       Vorschlag:    Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig ist,
+                     sollte vorgegaukelt werden, alle Zeichen seien ausgegeben (d2
+                     unverändert). 
+ 
+ 
+ 
+    #d("OUTCHAR")# 
+ 
+       Eingang:      d0 = Kanalnummer (1...15) 
+                     d1 = auszugebendes Zeichen 
+ 
+       Zweck:        Ausgabe eines Zeichens. 
+ 
+       Hinweis:      Ob das Zeichen übernommen wird, kann vorher durch einen Aufruf
+                     IOCONTROL "frout" erfragt werden, s. S. #topage("frout")#. 
+ 
+ 
+ 
+#b("Terminals")##goalpage("term")# 
+ 
+"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen
+werden. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie#
+werden von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard
+unabhängig sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL-
+Anwendern zur Verfügung! 
+#foot# 
+#f#*) Siehe "EUMEL Benutzerhandbuch, Teil 3: Editor, 5. Zeichencode" 
+#a# 
+#end# 
+ 
+Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt
+gearbeitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). 
+ 
+Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch"
+unter den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. 
+ 
+ 
+ 
+#bb("Drucker, ","Plotter")##goalpage("druck")# 
+ 
+#ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der
+Regel der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen
+solche Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). 
+ 
+Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man
+auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist
+dabei, daß 
+ 
+    a)   der Drucker einen eigenen Puffer hat und 
+    b)   der Puffer "schnell" gefüllt werden kann (<0.1 ms je Zeichen). 
+ 
+Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten
+und die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn
+der Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebro­
+chen werden. **) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet
+werden!#off("i")# 
+#foot# 
+#f#**) siehe auch IOCONTROL "frout", S.#topage("frout")# 
+#a# 
+#end# 
+ 
+ 
+ 
+#b("Exoten")##goalpage("exot")# 
+ 
+Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetz­
+tabelle im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist
+(Beispiele: Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die
+soweit programmierbar sind, daß sie den EUMEL-Zeichencode können). 
+ 
+Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden.
+Dieser wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch 1.7
+Seite 106) werden direkt dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden
+Besonderheiten: 
+ 
+Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: 
+ 
+    Code   Funktion 
+ 
+    7      SV      (Aktivierung: 'gib supervisor kommando:') 
+    17     STOP    (Ausgabe auf diesen Kanal wird gestoppt) 
+    23     WEITER  (Ausgabe läuft wieder weiter) 
+    4      INFO    (System geht in Debugger, falls Debugoption) 
+ 
+ 
+ 
+#bb("5.2 ","Block-IO")##goalpage("block")# 
+ 
+Über Block-IO wickelt das System die Zugriffe zum Hintergrund und zum Archiv ab.
+Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopp­
+lung zuzulassen. Die Kanalnummer in Reg. d0 unterscheidet diese Fälle. Außer beim
+Paging (d0=0) wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout'
+induziert. 
+ 
+Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben.
+Dieser kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Um­
+pufferung erfolgen. 
+ 
+Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. 
+ 
+SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die
+verlangte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so
+muß SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiter­
+laufen lassen kann. 
+ 
+EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31).
+Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren
+Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System
+vergibt auch in Zukunft für den #ib##on("i")#Funktionscode#ie##off("i")# in Register d1 nur positive Werte (Bit 15
+von d1 = 0). Der SHard kann selbst negative Codes einführen. 
+ 
+ 
+    #d("BLOCKIN")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...32) 
+                     d1 = Funktionscode 1 
+                     d2 = Funktionscode 2 
+                     a0 = Adresse des Hauptspeicherbereichs 
+       Ausgang:      d0 = undefiniert (darf also verändert werden) 
+                     d1 = Rückmeldecode 
+                     a0 = darf verändert werden 
+ 
+                     Der Inhalt des Hauptspeicherbereichs (<a0>... <a0>+511) darf
+                     verändert sein. 
+ 
+       Zweck:        "Einlesen" von Blöcken. Die genaue Wirkung hängt vom Funk­
+                     tionscode und dem Kanal ab. 
+ 
+       Vorschlag:    Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig ist,
+                     sollte die Rückmeldung -1 in d1 geliefert werden. 
+ 
+ 
+    #d("BLOCKOUT")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...32) 
+                     d1 = Funktionscode 1 
+                     d2 = Funktionscode 2 
+                     a0 = Adresse des Hauptspeicherbereichs 
+       Ausgang:      d0 = undefiniert (darf also verändert werden) 
+                     d1 = Rückmeldecode 
+                     a0 = darf verändert werden 
+ 
+                     Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert werden! 
+ 
+       Zweck:        "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom Funk­
+                     tionscode und dem Kanal ab. 
+ 
+       Vorschlag:    Falls der Kanal nicht existiert bzw. BLOCKOUT darauf unsinnig ist,
+                     sollte die Rückmeldung -1 in d1 geliefert werden. 
+ 
+ 
+    #d("warte")#             (0-Routine) 
+ 
+       Ausgang:      Alle Register undefiniert! 
+ 
+       Zweck:        Diese Routine ist bei 'blockin' oder 'blockout' dann aufzurufen,
+                     wenn SHard im Augenblick nichts zu tun hat. Durch den Aufruf von
+                     'warte' erhalten andere Systemteile die Möglichkeit, weiter zu ar­
+                     beiten. Ein 'warte' kann bis zu ca. 1/4 Sekunde Zeit aufnehmen.
+                     'warte' darf nicht in Interruptroutinen und Stream-IO verwendet
+                     werden! 'warte' zerstört alle Register! SHard muß davon ausgehen,
+                     daß 'warte' seinerseits andere SHard-Komponenten aufruft. 
+ 
+ 
+Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht wer­
+den: 
+ 
+ 
+    blockout auf platte : 
+         WHILE platte noch nicht frei REP 
+           warte 
+         ENDREP ; 
+         uebertrage schreibbefehl an controller ; 
+         uebertrage daten an controller . 
+ 
+    blockin von platte : 
+         WHILE platte noch nicht frei REP 
+           warte 
+         ENDREP ; 
+         uebertrage lesebefehl an controller ; 
+         WHILE daten noch nicht gelesen REP 
+           warte 
+         ENDREP ; 
+         hole daten vom controller . 
+ 
+ 
+    blockout auf floppy : 
+         seekbefehl an controller ; 
+         WHILE seek noch nicht fertig REP 
+           warte 
+         ENDREP ; 
+         setze dma auf schreiben block zur floppy ; 
+         schreibbefehl an controller ; 
+         WHILE schreiben noch nicht fertig REP 
+           warte 
+         ENDREP . 
+ 
+    blockin von floppy : 
+         seekbefehl an controller ; 
+         WHILE seek noch nicht fertig REP 
+           warte 
+         ENDREP ; 
+         setze dma auf lesen block von floppy ; 
+         lesebefehl an controller ; 
+         WHILE lesen noch nicht fertig REP 
+           warte 
+         ENDREP . 
+ 
+ 
+ 
+#b("Block-IO bei Hintergrund und Archiv")##goalpage("bhgarch")# 
+ 
+#ib#Hintergrund#ie# (Kanal 0) und #ib#Archiv#ie# (Kanal 31) unterscheiden sich in den Link-Bedingungen
+nur in der Kanalnummer. Die Aufrufe von BLOCKIN und BLOCKOUT werden mit folgenden
+Eingangsparametern versorgt: 
+ 
+    #on("b")#BLOCKIN#off("b")#          d0 = 0 bzw. 31 
+                     d1 = 0 
+                     d2 = Blocknummer 
+                     a0 = Hauptspeicheradresse 
+ 
+                     Der angegebene 512-Byte-Block ist in den Hauptspeicher ab
+                     <a0> einzulesen. 
+ 
+    #on("b")#BLOCKOUT#off("b")#         d0 = 0 bzw. 31 
+                     d1 = 0 
+                     d2 = Blocknummer 
+                     a0 = Hauptspeicheradresse 
+ 
+                     Der Hauptspeicherbereich (<a0>... <a0>+511) ist auf den
+                     angegebenen Block zu schreiben. 
+ 
+Als Rückmeldungen sind zu liefern:#goalpage("errcod")# 
+ 
+               0     Operation korrekt ausgeführt. 
+               1     Manuell behebbarer Fehler (z.B. Laufwerktür offen) 
+               2     Permanenter Fehler (z.B. Daten nicht lesbar) 
+               3     Versorgungsfehler (zu hohe Blocknummer) 
+ 
+ 
+#d("Fehlerwiederholung")#:  Das EUMEL-System führt von sich aus Fehlerwiederholungen beim
+                     Hintergrund- und beim Archivzugriff durch. SHard sollte deshalb
+                     im Fehlerfall die Operation nicht selbst wiederholen, sondern einen
+                     Lese/ Schreibfehler zurückmelden. So werden dem EUMEL-Sy­
+                     stem auch Soft-Errors gemeldet. In manchen Fällen soll vor
+                     einem erneuten Lese- oder Schreibversuch der Arm auf Spur 0
+                     positioniert werden o.ä. Um das zu erreichen, sollte SHard diese
+                     "Reparaturaktion" direkt im Anschluß an den fehlerhaften Versuch
+                     durchführen. 
+ 
+#d("Kontrollesen")#:        Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, muß das
+                     allerdings vom SHard durchgeführt werden. In der Regel reicht es
+                     dazu, den geschriebenen Block "ohne Datentransport" zu lesen,
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes
+für Sonderzwecke vorsehen. 
+ 
+ 
+    #d("IOCONTROL")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...32) 
+                     d1 = Funktionscode 1 
+                     d2 = Funktionscode 2 
+                     d3 = Funktionscode 3 
+       Ausgang:      d1 = Rückmeldung 
+ 
+       Zweck:        abhängig von 'Funktionscode 1' (s.u.) 
+ 
+Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: 
+ 
+ 
+    #d("IOCONTROL ""typ""")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...31) 
+                     d1 = 1 
+       Ausgang:      d1 = Kanaltyp 
+ 
+       Zweck:        Informiert EUMEL-0, welche IO für den angegebenen Kanal
+                     sinnvoll ist. Die Rückmeldung in d1 wird bitweise interpretiert: 
+ 
+                     Bit 0 gesetzt  <=>  'inputinterrupt' kann kommen. 
+                     Bit 1 gesetzt  <=>  OUTPUT ist sinnvoll. 
+                     Bit 2 gesetzt  <=>  BLOCKIN ist sinnvoll. 
+                     Bit 3 gesetzt  <=>  BLOCKOUT ist sinnvoll. 
+                     Bit 4 gesetzt  <=>  IOCONTROL "format" ist sinnvoll. 
+ 
+       Hinweis:      #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß nur
+                     sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# 
+ 
+ 
+    #d("IOCONTROL ""frout""")##goalpage("frout")# 
+ 
+       Eingang:      d0 = Kanalnummer (1...15) 
+                     d1 = 2 
+       Ausgang:      d1 = Anzahl Zeichen, die nächster OUTPUT übernimmt, bzw.
+                          Anzahl der OUTCHAR-Aufrufe, deren Zeichen übernommen
+                          wird. 
+ 
+       Zweck:        Liefert Information über die Belegung des Puffers. Diese Informa­
+                     tion wird von EUMEL-0 zum Scheduling benutzt. 
+ 
+       Achtung:      #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat, muß
+                     irgendwann d1 > 49 gemeldet werden.#off("i")# 
+ 
+       Hinweis:      Unter Berücksichtigung des oben Gesagten darf "gelogen" werden.
+                     Man kann z.B. immer 50 in d1 zurückmelden, muß dann aber
+                     schlechtere Nutzung der CPU bei Multi-User-Systemen in Kauf
+                     nehmen. 
+ 
+                     Falls auf dem angegebenen Kanal ein Drucker mit eigenem Puffer
+                     über Parallelschnittstelle angeschlossen ist (siehe S.#topage("druck")# ) und man
+                     auf einen SHard-internen Puffer verzichtet hat, sollte bei 'Druk­
+                     kerpuffer voll' 0 in d1 zurückgemeldet werden. Wenn aber Zeichen
+                     übernommen werden können, sollte 50 in d1 gemeldet werden 
+ 
+       Vorschlag:    Falls der Kanal nicht existiert oder nicht für Stream-IO zur Verfü­
+                     gung steht, sollten 200 in d1 zurückgemeldet werden. 
+ 
+ 
+    #d("IOCONTROL ""weiter""")##goalpage("weiter")# 
+ 
+       Eingang:      d0 = Kanalnummer (1...15) 
+                     d1 = 4 
+       Ausgang:      - 
+ 
+       Zweck:        Das System ruft "weiter" für den in d0 angegebenen Kanal auf,
+                     wenn es wieder Eingabezeichen puffern kann. (siehe auch: Fluß­
+                     kontrolle S.#topage("fluss")#) 
+ 
+       Hinweis:      "weiter" wird von EUMEL-0 auch immer dann aufgerufen, wenn
+                     ein Prozeß auf dem angegebenen Kanal auf Eingabe wartet und
+                     keine Zeichen mehr gepuffert sind. Wenn der betroffene Kanal von
+                     sich aus keine Interrupts erzeugt, kann SHard diesen Aufruf dazu
+                     benutzen, den Kanal auf mögliche Eingabe abzufragen und ggfs.
+                     das Eingabezeichen durch Aufruf von 'inputinterrupt' EUMEL-0
+                     zuzustellen. 
+                     #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle eingesetzt
+                     werden, weil sie die SV-Taste nur dann an EUMEL-0 zustellt,
+                     wenn ein Prozeß auf diesem Kanal auf Eingabe wartet. Dadurch
+                     wären aber CPU-intensive Endlosschleifen nicht normal abbrech­
+                     bar! #off("i")# 
+ 
+ 
+    #d("IOCONTROL ""size""")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...31) 
+                     d1 = 5 
+                     d2 = Schlüssel 
+       Ausgang:      d1 = Anzahl Blöcke 
+ 
+       Zweck:        EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren, die
+                     ein Block-IO-Kanal verkraften kann (Größe von Hintergrund und
+                     Archiven). Bei Archivlaufwerken, die meherere Formate bearbeiten
+                     können, dient dieser Aufruf auch zum Einstellen des Formats für
+                     die folgenden blockin/blockout-Operationen anhand des Schlüs­
+                     sels. 
+ 
+       Schlüssel:    0    Wenn möglich 'erkennend', sonst 'standard'. Im ersten Fall
+                          erkennt SHard das Format der eingelegten Diskette und stellt
+                          dieses ein. 
+ 
+                     Die weiteren Schlüssel sind stets definierend: 
+ 
+                     1    5.25" 2D-40, Sektor 1..9, 512 Bytes 
+                     2    5.25" 2D-80, Sektor 1..9, 512 Bytes 
+                     3    5.25" HD-80, Sektor 1..15, 512 Bytes 
+                     4    5.25" 1D-80, Sektor 1..9, 512 Bytes 
+                     10   8" 1D-77, Sektor 0..15, 512 Bytes 
+                     11   8" 2D-77, Sektor 0..15, 512 Bytes 
+                     12   8" 1S-77, Sektor 1..26, 128 Bytes 
+                     13   8" 1D-77, Sektor 1..26, 256 Bytes 
+                     14   8" 2D-77, Sektor 1..16, 256 Bytes 
+ 
+       Hinweis:      Bei Archiven wird 'size' aufgerufen, nachdem der Archivträger ein­
+                     gelegt wurde. D.h. SHard hat die Gelegenheit, die Größe anhand
+                     des eingelegten Archivträgers zu bestimmen (z.B. ob single- oder
+                     doublesided). 
+ 
+       Vorschlag:    Diese Funktion sollte auf nicht vorhandenen und den Stream-IO-
+                     Kanälen 0 liefern. Sie muß aber mindestens auf Kanal 0 (Hinter­
+                     grund) und Kanal 31 (Archiv) "echte" Werte liefern. 
+ 
+       Achtung:      #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die
+                     0-Routine 'warte' aufgerufen werden.#off("i")# 
+ 
+ 
+    #d("IOCONTROL ""format""")# 
+ 
+       Eingang:      d0 = Kanalnummer (0...31) 
+                     d1 = 7 
+                     d2 = Schlüssel 
+       Ausgang:      d1 = Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) 
+ 
+       Zweck:        Dient zum Formatieren eines Mediums. Diese Funktion kann für
+                     jeden Kanal leer implementiert sein ('rts'). Sie sollte aber "forma­
+                     tierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem Kanal die
+                     "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls (bei Disketten­
+                     laufwerken) mehrere Formate möglich sind, bestimmt der Schlüssel
+                     das gewünschte Format. 
+ 
+       Schlüssel:    0    Standardformat dieses Rechners 
+                     1    5.25" 2D-40, Sektor 1..9, 512 Bytes 
+                     2    5.25" 2D-80, Sektor 1..9, 512 Bytes 
+                     3    5.25" HD-80, Sektor 1..15, 512 Bytes 
+                     4    5.25" 1D-80, Sektor 1..9, 512 Bytes 
+                     10   8" 1D-77, Sektor 0..15, 512 Bytes 
+                     11   8" 2D-77, Sektor 0..15, 512 Bytes 
+                     12   8" 1S-77, Sektor 1..26, 128 Bytes 
+                     13   8" 1D-77, Sektor 1..26, 256 Bytes 
+                     14   8" 2D-77, Sektor 1..16, 256 Bytes 
+ 
+       Hinweis:      Falls für das Formatieren ein großer Speicherbereich benötigt wird,
+                     sollte das Formatieren von Disketten besser in einem Boot-Dialog
+                     vor dem Start von EUMEL-0 angeboten werden. Denn sonst
+                     müßte der Pagingbereich unnötig eingeschränkt werden. 
+                     Man kann das Formatieren #on("i")#einer Spur#off("i")# CPU-intensiv implementie­
+                     ren (d.h. ohne DMA im Interrupts-Disabled-Modus), wenn man in
+                     Kauf nimmt, daß alle anderen Tasks des EUMEL-Systems in
+                     dieser Zeit "stehen". Dann sollte man aber nach jeder Spur
+                     mehrmals die 0-Routine 'warte' aufrufen. 
+ 
+       Achtung:      #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die
+                     0-Routine 'warte' aufgerufen werden.#off("i")# 
+ 
+ 
+ 
+#b("Konfigurierung serieller Schnittstellen")##goalpage("v24")# 
+ 
+Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib# V.24#ie#) zurückgeführt werden,
+sind in der Regel die Größen 
+ 
+       - #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) 
+       - #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) 
+       - #ib#Parität#ie# (keine, gerade, ungerade) 
+ 
+einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­
+gung stellen. Diese werden in zwei Modi benutzt: 
+ 
+    a) #on("b")#einstellend#off("b")# 
+       Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (d0 = 32),
+       wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte
+       eingestellt, sofern das möglich ist. 
+ 
+    b) #on("b")#abfragend#off("b")# 
+       Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (d0 <> 32), wird lediglich
+       abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt werden
+       könnte. 
+ 
+Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der
+Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das
+nutzt z.B. das Standard-Konfigurationsprogramm aus. 
+ 
+Hinweis:  Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­
+          schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur
+          hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen
+          Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig
+          wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht
+          danach gefragt.) 
+ 
+ 
+    #d("IOCONTROL ""baud""")# 
+ 
+       Eingang:      d0 = eigener Kanal (1...15 / 32) 
+                     d1 = 8 
+                     d2 = 0 
+                     d3 = Schlüssel * 256 + adressierter Kanal 
+       Ausgang:      d1 = Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+       Zweck:        Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, wird
+                     die angegebene Baudrate für den durch Register d3(0..7) adres­
+                     sierten Kanal eingestellt, falls das möglich ist. Wird diese Routine
+                     auf einem anderen Kanal als 32 aufgerufen, informiert sie den
+                     Aufrufer lediglich, ob eine derartige Einstellung des adressierten
+                     Kanals möglich wäre. 
+ 
+       Schlüssel:          1       50 Baud 
+                           2       75 Baud 
+                           3      110 Baud 
+                           4      134.5 Baud 
+                           5      150 Baud 
+                           6      300 Baud 
+                           7      600 Baud 
+                           8     1200 Baud 
+                           9     1800 Baud 
+                          10     2400 Baud 
+                          11     3600 Baud 
+                          12     4800 Baud 
+                          13     7200 Baud 
+                          14     9600 Baud 
+                          15    19200 Baud 
+                          16    38400 Baud 
+ 
+       Anmerkung:    In der Regel werden nicht alle Baudraten vom SHard unterstützt
+                     werden. Bei V.24 Schnittstellen sollten aber mindestens 2400,
+                     4800 und 9600 Baud zur Verfügung stehen, besser auch 300, 600,
+                     1200 und 19200 Baud. 
+ 
+       Hinweis:      Falls SHard-spezifisch weitere Baudraten implementiert werden
+                     sollen, darf SHard hierfür negative Schlüsselwerte in d3(8..15) ver­
+                     geben. 
+ 
+ 
+    #d("IOCONTROL ""bits""")# 
+ 
+       Eingang:      d0 = eigener Kanal (1...15 / 32) 
+                     d1 = 9 
+                     d2 = 0 
+                     d3 = Schlüssel * 256 + adressierter Kanal 
+       Ausgang:      d1 = Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+       Zweck:        Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, wird
+                     die angegebene Zeichenlänge (Bits pro Zeichen) und Parität für
+                     den durch Register d3(0..7) adressierten Kanal eingestellt, falls das
+                     möglich ist. 
+                     Wird diese Routine auf einem anderen Kanal als 32 aufgerufen,
+                     informiert sie den Aufrufer lediglich, ob eine derartige Einstellung
+                     des adressierten Kanals möglich wäre. 
+ 
+ 
+       Schlüssel:    stop * 32 + par * 8 + (bit - 1) 
+ 
+                     stop:     0    1 Stopbit 
+                               1    1.5 Stopbits 
+                               2    2 Stopbits 
+ 
+                     par:      0    keine Parität 
+                               1    ungerade Parität 
+                               2    gerade Parität 
+ 
+                     bit:      1...8 Bits pro Zeichen 
+ 
+ 
+       Anmerkung:    In der Regel werden nicht alle Kombinationen vom SHard unter­
+                     stützt werden. Bei V.24 Schnittstellen sollten aber möglichst 1
+                     Stopbit, 7 und 8 Bits pro Zeichen und alle drei Paritätseinstellun­
+                     gen zur Verfügung stehen. 
+ 
+       Hinweis:      Falls SHard-spezifisch weitere Einstellungen implementiert werden
+                     sollen, darf SHard hierfür negative Schlüsselwerte in d3(8..15) ver­
+                     geben. 
+ 
+ 
+ 
+#b("Flußkontrolle")##goalpage("fluss")# 
+ 
+Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie
+Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die
+die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei
+ist auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere
+empfangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung.
+Hier ist in der Regel sogar zweiseitige Flußkontrolle notwendig. 
+ 
+Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­
+stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das Letztere kann auch bei Parallel­
+schnittstellen eingesetzt werden. 
+ 
+Zur eingabeseitigen Flußkontrollsteuerung kann SHard die IOCONTROL-Funktionen
+"stop" und "weiter" (siehe S.#topage("weiter")#) verwenden: 
+ 
+Nach "stop" muß SHard weiter einlaufenden Input selbst zwischenpuffern oder auf der
+V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XON senden.
+Dadurch wird bei den meisten Fremdrechnern ein weiteres Senden unterbrochen, sofern
+(im ersten Fall) das Signal 'REQUEST TO SEND' dort mit dem V.24-Eingang 'CLEAR TO
+SEND' verbunden ist. Wird von EUMEL-0 "weiter" aufgerufen, so kann auf dem ent­
+sprechenden Kanal wieder empfangen werden (RTS setzen bzw. XON senden). 
+ 
+Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO
+SEND' bzw. der Empfang von XOFF berücksichtigt werden. Wenn an der Schnittstelle das
+'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser
+Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der
+Empfang von XOFF die Ausgabe anhalten und XON sie wieder starten. 
+ 
+Bemerkung:   Die meisten Systeme enthalten diese CTS-Funktion schon in ihrer Hard­
+             ware, so daß im SHard dafür keine Vorkehrungen getroffen werden müs­
+             sen. 
+ 
+ 
+Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL-
+Funktion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#ein­
+stellend#off("i")# und auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. 
+ 
+ 
+    #d("IOCONTROL ""flow""")# 
+ 
+       Eingang:      d0 = eigener Kanal (1...15 / 32) 
+                     d1 = 6 
+                     d2 = 0 
+                     d3 = Modus * 256 + adressierter Kanal 
+       Ausgang:      d1 = Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+       Zweck:        Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, muß
+                     sie den gewünschten Flußkontrollmodus für den adressierten Kanal
+                     einstellen. 
+                     Dabei sind folgende Modi festgelegt: 
+ 
+                          Modus = 0     Keine Flußkontrolle 
+                          Modus = 1     XON/XOFF (in beiden Richtungen) 
+                          Modus = 2     RTS/CTS (in beiden Richtungen) 
+                          Modus = 5     XON/XOFF (nur ausgabeseitig) 
+                          Modus = 6     RTS/CTS (nur ausgabeseitig) 
+                          Modus = 9     XON/XOFF (nur eingabeseitig) 
+                          Modus = 10    RTS/CTS (nur eingabeseitig) 
+ 
+                     SHard wird hierdurch informiert, wie er auf "stop" und "weiter"
+                     reagieren soll. Wenn keine Flußkontrolle gewünscht wird
+                     (Modus=0), muß SHard "stop" und "weiter" ignorieren; bei
+                     Modus=1 oder Modus=9 muß bei "stop" XOFF und bei "weiter"
+                     XON geschickt werden; bei Modus=2 oder Modus=10 muß bei
+                     "stop" das Signal RTS auf low und bei "weiter" wieder auf high
+                     gesetzt werden. Mit "stop" ist hierbei das Unterschreiten des
+                     Schwellwertes bei der Rückmeldung von
+                     "inputinterrupt" gemeint. 
+ 
+                     Bei Modus=1 oder Modus=5 müssen empfangene XON/XOFF­
+                     -Zeichen, bei Modus=2 oder Modus=6 das Signal CTS beachtet
+                     werden. 
+ 
+                     Wird diese Routine auf einem anderen Kanal als 32 aufgerufen,
+                     informiert sie den Aufrufer lediglich, ob der geforderte Flußkontroll­
+                     modus auf dem adressierten Kanal einstellbar wäre. 
+ 
+       Hinweis:      Falls SHard-spezifisch weitere Flußkontrollmodi implementiert
+                     werden sollen, darf SHard hierfür negative Moduswerte in d3(8..15)
+                     vergeben. 
+ 
+                     "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es
+                      ist daher nicht sinnvoll, jedesmal XON zu senden, da dies die Gegenstelle
+                      damit überfluten würde. SHard muß sich
+                      merken, ob der Kanal im XOFF-Zustand ist und
+                      nur dann bei "weiter" ein XON senden. 
+ 
+#b("Kalender")##goalpage("kalender")# 
+ 
+Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL
+holt sich Datum und Uhrzeit dann von SHard. 
+ 
+    #d("IOCONTROL ""calendar""")# 
+ 
+       Eingang:      d1 = 10 
+                     d2 = gewünschte Einheit (1=Minute, 2=Stunde, 3=Tag, 
+                           4=Monat, 5=Jahr) 
+       Ausgang:      d1 = Rückmeldung 
+ 
+       Zweck:        Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden ist,
+                     muß bei jedem Aufruf -1 zurückgemeldet werden, bei eingebauter
+                     Uhr jeweils das Gewünschte (Minute: 0..59, Stunde: 0..23, Tag:
+                     1..31, Monat: 1..12, Jahr: 0..99). 
+ 
+       Hinweis:      Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus re­
+                     sultierenden Probleme werden auf höheren Ebenen abgehandelt. 
+ 
+ 
+ 
+#bb("6.  SHard-","Interface Version")##goalpage("shdver")# 
+ 
+Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als
+2-Byte-Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene
+Interface muß sie den Wert 8 haben. 
+ 
+So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard-
+Moduln geändert werden müssen. 
+ 
+ 
+ 
+ 
+#bb("7.  ","ID-Konstanten")##goalpage("ID")# 
+ 
+SHard muß in der Leiste vier 2-Byte-Konstanten ablegen. Diese können von den höhe­
+ren Ebenen durch die ELAN-Prozedur 
+ 
+       INT PROC #ib#id#ie# (INT CONST no) 
+ 
+abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in
+der Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: 
+ 
+       ID4     #ib#Lizenznummer#ie# des SHards *) 
+#foot# 
+#f#*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen! 
+#a# 
+#end# 
+ 
+       ID5     #ib#Installationsnummer#ie# des EUMEL-Anwenders **) 
+#foot# 
+#f#**) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender. 
+#a# 
+#end# 
+ 
+       ID6     zur freien Verfügung 
+ 
+       ID7     zur freien Verfügung 
+ 
+ 
+ 
+ 
+#bb("8.  ","Zusätzliche Leistungen")##goalpage("shdelan")# 
+ 
+Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardope­
+rationen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und
+IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von
+EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzliche
+Leistungen nur negative Werte als 'Funktionscode 1' verwenden. 
+ 
+ 
+Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib#blockout#ie#', '#ib#blockin#ie#'#off("i")#
+und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. 
+ 
+Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Multi­
+-User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32
+abgewickelt werden und dürfen nur dort wirken. 
+ 
+ 
+     PROC blockout (ROW 256 INT CONST para,      (* --> a0 *) 
+                    INT CONST funktion1,         (* --> d1 *) 
+                              funktion2,         (* --> d2 *) 
+                    INT VAR antwort)             (* <-- d1 *) 
+ 
+     PROC blockin (ROW 256 INT VAR para,         (* --> a0 *) 
+                   INT CONST funktion1,          (* --> d1 *) 
+                             funktion2,          (* --> d2 *) 
+                   INT VAR antwort)              (* <-- d1 *) 
+ 
+     PROC control (INT CONST funktion1,          (* --> d1 *) 
+                             funktion2,          (* --> d2 *) 
+                             funktion3,          (* --> d3 *) 
+                   INT VAR   antwort)            (* <-- d1 *) 
+ 
+Hinweis:   Der SHard darf für 'funktion 1' (d1) zusätzlich zu den hier beschriebenen
+           Standardcodes nur negative Codes vereinbaren. 
+ 
+ 
+Beispiel:  Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl 
+ 
+                  control (-7,1200,13,antwort), 
+ 
+           so wird IOCONTROL mit (d0='x', d1=-7, d2=1200, d3=13) aufgerufen.
+           Verläßt SHard 'control' mit d1 = 1, so enthält 'antwort' anschließend eine 1. 
+ 
+ 
+Hinweis:   Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur
+           Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses
+           ebenfalls an die Anwender ausliefern. 
+ 
+           Beispiel:  PACKET zusatz DEFINES fanfare, ... : 
+ 
+                      PROC fanfare (INT CONST tonhoehe, dauer): 
+ 
+                       IF dauer < 0 
+                         THEN errorstop ("negative dauer") 
+                       ELIF tonhoehe < 16 
+                         THEN errorstop ("infraschall") 
+                       ELIF tonhoehe > 20000 
+                         THEN errorstop ("ultraschall") 
+                       ELSE control (-37, 20000 DIV tonhoehe, 
+                                                        dauer) 
+                       FI 
+ 
+                      ENDPROC fanfare ; 
+ 
+                           . . . 
+ 
+ 
+ 
+ 
+#bb("9.  ","Spezialroutinen")##goalpage("ke")# 
+ 
+Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse ein­
+bauen. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird
+im Anhang A (siehe S.#topage("info")#) beschreiben. 
+ 
+ 
+    #d("info")#                  (0-Routine) 
+ 
+       Aufruf:                movl   \#infomsg,(sp)- 
+                              jbsr   info 
+                              lea    4(sp),sp    ! restore stackpointer 
+                               . 
+                               . 
+                     infomsg: .asciz "text" 
+ 
+       Zweck:        Info wird aufgerufen. Dabei wird 'text' zur Identifikation des Kon­
+                     trollereignisses ausgegeben. #on("i")#Hinter dem übergebenen Text muß
+                     ein Byte /00 stehen (durch '.asciz' sichergestellt)!#off("i")# 
+ 
+       Hinweis:      Bei Systemen "ohne Info" (nur solche dürfen an Anwender aus­
+                     geliefert werden) wird nur der Info-Text ausgegeben und
+                     EUMEL-0 angehalten. 
+ 
+       Achtung:      Da der Info selbst die hier beschriebenen Stream-IO-Routinen
+                     benutzt, darf man ihn von diesen Routinen aus (inputinterrupt,
+                     OUTPUT, OUTCHAR, IOCONTROL "frout", IOCONTROL "stop",
+                     IOCONTROL "weiter") nicht aufrufen. Wenn die Ein-/Ausgabe auf
+                     Terminal 1 interruptgetrieben läuft, dürfen die Interrupts beim Info­
+                     -Aufruf natürlich nicht gesperrt sein. 
+ 
+#page# 
+#cc("Teil 4: ","Tips zur Portierung")##goalpage("tips")# 
+ 
+ 
+#b("Nullversion des SHards")##goalpage("0ver")# 
+ 
+ 
+Es wird empfohlen, zuerst eine "Nullversion" des SHard zu entwickeln, die möglichst
+einfach aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel
+ausgerichtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann
+den Entwurf und die Implementation des eigentlichen SHard erleichtert. Die Nullversion
+sollte 
+ 
+     - nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, 
+ 
+     - keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen un­
+       terstützen (immer 'nicht möglich' melden), 
+ 
+     - vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie
+       "busy wait" beim Disketten- bzw. Plattenzugriff zu grämen. 
+ 
+Mit dieser Nullversion sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund
+                     keitsanforderungen an die Zeitangaben bei #on("i")#einzelnen#off("i")# Interrupts
+höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der Vortest sollte
+sich direkt nach dem Start folgendermaßen auf Terminal 1 melden: 
+ 
+                E U M E L - Vortest 
+
+          Terminals:  1, 
+          RAM-Groesse (gesamt):     ... KB 
+          Pufferbereich:            ... KB 
+          Hintergrund-Speicher:     ... KB 
+ 
+          Speichertest: ************ 
+ 
+Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben.
+Das EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andern­
+falls funktioniert die Eingabe nicht richtig!) 
+ 
+Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese
+Möglichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der
+EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­
+werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund
+geladen werden. 
+ 
+Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine
+Verwendung ist aber, daß die Terminal-Ein-/Ausgabe schon funktioniert. 
+ 
+Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den
+Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete
+Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug
+auf die Steuercodes) gleicht, kann man z.B. 
+ 
+    - den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen
+      (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, 
+ 
+    - die notwendigen Umcodierungen per SHard durchführen. 
+ 
+Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil
+Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird
+man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­
+derlich sind. 
+ 
+Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzich­
+ten. 
+ 
+ 
+Im Gegensatz zu der Nullversion sollte man bei der eigentlichen SHard-Implementierung
+darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf ent­
+spricht dann wieder im wesentlichen dem oben beschriebenen Vorgang. 
+ 
+ 
+ 
+#b("Typische Fehler")##goalpage("fehler")# 
+ 
+ 
+    a)   SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht
+         vollständig. 
+ 
+    b)   'jbsr' bzw. 'rts' verändern den Stackpointer. 
+ 
+    c)   Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Inter­
+         rupts"). 
+ 
+    d)   Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal
+         (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu
+         wildem Schreiben in den Hauptspeicher. 
+ 
+    e)   'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT,
+         IOCONTROL "size" und IOCONTROL "format" aus aufgerufen werden. Ferner
+         kann man 'warte' noch nicht beim Systemladen aufrufen!) 
+ 
+    f)   OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation
+         zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der
+         Interruptroutine, die den Puffer leert und ausgibt. 
+ 
+    g)   IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zeichen
+         im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output-Blok­
+         kaden führen. 
+ 
+    h)   Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x
+         Zeichen an. 
+ 
+    i)   IOCONTROL "size" meldet falsche Werte. 
+ 
+    j)   IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. 
+ 
+    k)   BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor
+         alle Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon
+         aus, daß der Puffer frei ist und anderweitig benutzt werden kann!) 
+ 
+    l)   Die Stepping-Rate eines Plattencontrollers wird falsch eingestellt, beziehungs­
+         weise die Platte wird nicht im 'buffered step mode' betrieben, obwohl sie be­
+         schleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem
+         Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht
+         übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält.
+         Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile
+         des Hintergrundes benutzt werden. 
+ 
+    m)   Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf
+         einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann
+         das zweite Zeichen das erste. 
+ 
+    n)   Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen
+         Eingabezeichen verloren oder werden verfälscht. In der Regel ist das auf
+         Timingprobleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen
+         verloren bzw. die Zeichen werden nicht schnell genug abgeholt. 
+ 
+ 
+ 
+ 
+#b("Effizienzprobleme")##goalpage("eff")# 
+ 
+    a)   Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf
+         Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User-
+         Systemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann
+         läuft der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) 
+ 
+         Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch un­
+         glückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf
+         Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen abge­
+         lehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf na­
+         türlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. 
+ 
+ 
+    b)   Wenn #on("i")##on("b")#Disketten ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single-
+         User-Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek-
+         Vorgang auf den Block zu warten. Im Multi-User sollte das aber wenn irgend
+         möglich umgangen werden, da eine halbe Umdrehung immerhin ca. 100 ms
+         kostet. 
+         Falls nur ein Endeinterrupt nach jeder Diskettenoperation zur Verfügung steht,
+         kann folgendes Verfahren günstig sein: 
+ 
+            seek befehl an controller ; 
+            warten auf endeinterrupt ; 
+            lesebefehl ohne datentransport auf sektor davor ; 
+            warten auf endeinterrupt ; 
+            lese oder schreib befehl auf adressierten sektor ; 
+            cpu intensives warten und datentransport . 
+ 
+         Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu,
+         ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen
+         Sektor möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf
+         ca. 25 ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach,
+         da die 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht
+         verwendet werden kann. Alle 'warte auf ...' müssen also durch Interrupts reali­
+         siert werden: 
+ 
+            setze interrupt auf lesen davor ; 
+            stosse seek an ; 
+            REP 
+              warte 
+            UNTIL komplette operation beendet ENDREP . 
+ 
+               lesen davor : 
+                  setze interrupt auf eigentliche operation ; 
+                  stosse lesen davor an . 
+ 
+               eigentliche operation : 
+                  ignoriere fehler beim datentransport ; 
+                  stosse lesen oder schreiben an ; 
+                  REP 
+                    REP UNTIL bereit ENDREP ; 
+                    uebertrage ein byte 
+                  UNTIL alles uebertragen ENDREP ; 
+                  melde komplette operation beendet . 
+ 
+ 
+    c)   Bei der Ansteuerung von #on("i")##on("b")#Platten#off("b")##off("i")# sollte man darauf achten, daß die 0-Routi­
+         ne 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging
+         zugunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man
+         bei vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: 
+ 
+            beginne seek ;             beginne seek und lesen ; 
+            REP                        REP 
+              warte                      warte 
+            UNTIL fertig PER ;         UNTIL fertig PER 
+            beginne lesen ; 
+            REP 
+              warte 
+            UNTIL fertig PER 
+ 
+         Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die
+         rechte. Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das
+         Einlesen eines Blocks benötigen. 
+ 
+         Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren
+         unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn
+         möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen
+         werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv ge­
+         wartet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung
+         zu experimentieren. 
+ 
+#page# 
+#cc("Anhang A: EUMEL-","Debugger ""Info""")##goalpage("info")# 
+ 
+ 
+Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unter­
+scheiden sich nur im EUMEL-0-Teil (Systemkern). Der SHard-Implementierer erhält
+zum Test Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige
+Systeme dürfen nur von den SHard-Implementierern verwendet werden. 
+ 
+    #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert werden,
+             da vermittels Info alle Systemsicherungs- und Datenschutzmaßnahmen un­
+             terlaufen werden können.#off("i")##off("b")# *) 
+#foot# 
+#f#*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ
+Bielefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert
+werden. 
+#a# 
+#end# 
+ 
+ 
+ 
+#b("Aufruf des Info")##goalpage("aufrinf")# 
+ 
+Zum Aufruf des Infos gibt es drei Möglichkeiten: 
+ 
+    a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­
+       chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe
+       von 'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem
+       Startmenü nicht aufgeführt.)#off("i")# 
+ 
+    b) Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das
+       System gestartet wurde und sich eine Task am Terminal mit "gib kommando"
+       gemeldet hat, kann man durch 'ke *return*' in den Info-Modus gelangen. 
+ 
+    c) Wenn sich am Terminal keine Task befindet, die auf Eingabe wartet, gelangt man
+       durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe
+       "Systemhandbuch, Konfigurierung") in den Info-Modus. 
+ 
+Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. 
+ 
+Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des
+EUMEL-Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen.
+Bei Systemen "ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das
+System angehalten. 
+ 
+ 
+ 
+#b("Info-Format")##goalpage("forminf")# 
+ 
+Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­
+mandos werden die zwei obersten Zeilen wie folgt aufgebaut: *) 
+#foot# 
+#f#*) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h.
+insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchge­
+führt. 
+#a# 
+#end# 
+ 
+Mini: nnnn   text  eeee 
+Maxi: xxxx 
+ 
+ 
+wobei 
+ 
+    #on("b")#nnnn#off("b")#  den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat: INTER
+          (Interpreter), LADER, MUELL (Müllabfuhr) oder ARCHIV, 
+ 
+    #on("b")#xxxx#off("b")#  den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor
+          bearbeitet wird (xxxx ist code (tasknummer + code ("0"))), 
+ 
+    #on("b")#text#off("b")#  den Grund für den Info-Modus anzeigt und 
+ 
+    #on("b")#eeee#off("b")#  eine interne, nur den EUMEL-0-Entwickler interessierende Fehlernummer
+          ist. 
+ 
+In der untersten Zeile erscheint (hinter der Angabe des evtl. angezeigten Datenraumes, der
+Adresse und der Länge) die Eingabeaufforderung 'info:'. 
+ 
+ 
+ 
+#b("Info-Kommandos")##goalpage("cmdinf")# 
+ 
+Info-Kommandos können in der 'info:'-Zeile mit dem Format 
+ 
+          [<zahl>]<buchstabe> 
+ 
+gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format 
+ 
+          <buchstabe> 
+ 
+wobei dann für <zahl> die der Cursorposition entsprechende Dumpadresse (modulo
+2**16) gesetzt wird (siehe '*cup*'). 
+ 
+<zahl> ist immer in Hexaform einzugeben. 
+ 
+'g'    Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge
+       sperrt. 
+ 
+'z'    Der Leitblock des angezeigten Maxiprozesses wird dargestellt. (Nur im Miniprozeß
+       INTER.) 
+ 
+'s'    Dumps werden auf den Datenraum <zahl> eingestellt (s:=<zahl>). Auch der
+       Realspeicher kann hiermit in verschiedenen Modi eingestellt werden: 
+ 
+                 1s    Programmspeicher (absolute Adressen) 
+                ffs    Tabellenspeicher (relativ zum Tabellenanfang) 
+ 
+'l'    Dumps werden auf die Länge <zahl> eingestellt. Desungeachtet kann man einen
+       versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird
+       allerdings '*cup*' gesperrt (siehe unten). 
+ 
+'p'    Dumps werden auf die Byteadresse <zahl> eingestellt (p:= <zahl>; wmodus:=
+       FALSE). 
+ 
+'w'    Dumps werden auf die Wortadresse <zahl> eingestellt. Die vor jeder Dumpzeile
+       ausgegebene Adresse ist dann auch eine Wortadresse. Ein Wort = 2 Bytes
+       (p:=2*<zahl>; wmodus:=TRUE). 
+ 
+'k'    Block <zahl> laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf
+       den Realdatenraum (s:=/ff). 
+ 
+'x'    Suchen nach Bytekette: 
+ 
+-->    xctext 
+-->    xhxx xx ... 
+-->    x 
+ 
+       Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte
+       'x'-Kommando eingestellten Bytekette gesucht. 
+       Das Kommando ist durch *return* abzuschließen. 
+       Die Suche beginnt ab Position 'p' und ist auf die Länge <zahl> Seiten (512
+       Byte-Einheiten) begrenzt (0=unendlich). 
+       Eine beliebige Eingabe bricht die Suche vorzeitig ab. 
+ 
+'*return*' 
+       Es wird der eingestellte Dump ausgegeben (siehe 's', 'l', 'p', 'w'). Bei wmodus
+       (siehe 'p', 'w') werden Wortadressen ausgegeben. 
+ 
+'o'    Wie '*return*', jedoch wird zuvor p := p+l  gesetzt (zum Weiterblättern). 
+ 
+ 
+'*cup*' *)  (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. 
+#foot# 
+#f#*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für
+Cursor Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen
+durchführt, ist dieser Modus nicht sehr gut benutzbar. 
+#a# 
+#end# 
+       Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt werden.
+       Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des Bytes eingetra­
+       gen, auf dem der Cursor gerade steht. Dies funktioniert auch auf beliebigen Da­
+       tenräumen. Info beantragt dann bei der Speicherverwaltung einen Schreibzugriff für
+       die entsprechende Datenraumseite, so daß Änderungen mit der Copy-on-
+       Write-Logik erfolgen, also nur taskspezifisch sind. Für diese Task sind die Ände­
+       rungen allerdings dann permanent, da sie auch auf den Hintergrund wirken. 
+ 
+       Hinweis:  Dumpt man mit 'k' einen Block und ändert dann darin, so sind diese
+                 Änderungen u.U. nur temporär, da der Info kein Rückschreiben des
+                 Blockes veranlaßt. 
+ 
+       Achtung:  Jede Eingabe, die kein Positionierzeichen und kein gültiges Zahlzeichen
+                 ist, beendet diesen Modus. Das neue Zeichen wird als Info-Komman­
+                 do aufgefaßt, wobei <zahl> auf die aktuelle Adresse gesetzt wird. 
+                 Somit wird dieser Änderungsmodus üblicherweise durch *return* been­
+                 det. 
+ 
+ 
+ 
+#b("Einige Systemadressen")##goalpage("sysaddr")# 
+ 
+Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche
+Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für
+Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf
+implementationsabhängige Konstanten ein. Diese sind hier aufgeführt. 
+ 
+Der Tabellenspeicher der EUMEL-0-Maschine wird relativ zu M0START angelegt. Im Info
+kann der Tabellenspeicher durch die Datenraumangabe ffs adressiert werden, z.B. wird
+durch das Kommando ffs1000p der Anfang der 'ktab' gezeigt. 
+ 
+Ab /1000 liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des
+Arbeitsspeichers liegen: In der Kachel mit der Adresse /a000+/200*i befindet sich der
+Inhalt des Blockes, dessen Nummer in <ktab+2*i> steht. Ferner enthält die Tabelle, zu
+welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur
+relevant, wenn die Prozeßnummer <> /ff ist). 
+ 
+    ktab: 
+ 
+   /1000      Blocknummern (je 2 Bytes) 
+   /2000      Prozeßnummern (je 1 Byte) 
+   /2800      drid's (prozeßspezifisch, je 1 Byte) 
+   /3000      Seitennummern (je 2 Bytes) 
+   /4000      Steuerbits (je 1 Byte): 
+ 
+              2**0:  Inhalt wird gerade transportiert (zum HG oder Archiv). 
+              2**1:  Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die
+                     Kachel (per Software) zurückgesetzt. 
+              2**2:  Schreiberlaubnis (siehe Brikett). 
+              2**3:  Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger
+                     stark' verdrängt. 
+ 
+ 
+ 
+/5d50    enthält den 'Laderpool'. Es handelt sich um Blocknummern von zu ladenden
+         Blöcken. Ist der höherwertige Teil der Blocknummer gleich /fd, so ist dies keine
+         Anforderung. 
+ 
+         Blocknummern > /ff00 stehen für Blöcke mit dem Inhalt 512mal /ff und werden
+         nie auf dem Hintergrundmedium gespeichert. 
+ 
+ 
+ 
+/0       enthält den DR-Eintrag des drdr (siehe Brikett). 
+ 
+ 
+ 
+ 
+/5c00.../5cff: 
+         enthält die Aktivierungstabelle. Ist (/5c00+i)=/01, so ist die Task i aktiv. Hin­
+         weis: /5cff enthält immer /01, ohne daß dieser Zelle eine Task zugeordnet ist. 
+ 
+ 
+ 
+#b("Leitblock")##goalpage("pcb")# 
+ 
+Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Die einzelnen Einträge,
+die voneinander durch je 2 Blanks getrennt sind, haben die Form 
+             Bezeichnung=Wert 
+wobei Wert in hexadezimaler Form angegeben ist. In der folgenden Beschreibung steht x,
+y und z für irgendeine Hexadezimalziffer. 
+ 
+    ic=0xxxxx       Der virtuelle Befehlszähler der Task zeigt auf /xxxxx im Datenraum 4
+                    dieser Task. Durch die Eingabefolge: 
+                          4s<xxxxx>w*return* 
+                    kann man sich den Code, der ausgeführt werden soll, ansehen. 
+ 
+    flags=xxyy      Bit /80 von yy zeigt den Fehlerzustand an. 
+                    Bit /40 von yy zeigt 'disable stop' (siehe Benutzerhandbuch) an. 
+                    Bit /10 von yy zeigt vorzeichenlose Arithmetik an (Compilierung). 
+ 
+    lbas=xxxx       Die lokale Basis steht auf /1xxxx im Datenraum 4 (Wortadresse). 
+ 
+    pbas=xx         Die Paketbasis steht auf /xx00 im Datenraum 4 (Wortadresse). 
+ 
+    hptop=xyz3      Der Arbeitsheap geht von /30000 (Byteadresse!) bis /3xyz0 (Byte­
+                    adresse!). 
+ 
+    chan=xx         Die Task hängt an Kanal /xx (Terminalnummer). 
+                    0 <==> kein Terminal angekoppelt. 
+ 
+    task=xxyy,zzzz  Die Tasknummer der betrachteten Task ist /yy. /xx ist die Stations­
+                    nummer im EUMEL-Netz, /zzzz ist die Versionsnummer zum
+                    Abdichten von 'send'/ 'wait'. 
+ 
+Um den Code, auf den der 'ic' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. 
+#page# 
+#cc("Anhang B: Einige ","EUMEL-Begriffe")##goalpage("glossar")# 
+ 
+ 
+#on("bold")#Archiv:#off("bold")# 
+ 
+     Medium (z.B. Diskette, Band, Kassette) zur Speicherung von Datenräumen (Pro­
+     grammen, Daten und Dateien) einer oder mehrerer Tasks außerhalb eines
+     EUMEL-Systems zum Zwecke der Aufbewahrung oder des Datenaustauschs. 
+ 
+     Auch ein ganzer EUMEL-Hintergrund kann (durch 'save system') auf Archiv (z.B. auf
+     eine oder mehrere Disketten) geschrieben werden. Ein solches "Hintergrundarchiv"
+     kann dann zur Erzeugung eines EUMEL-Hintergrundes (im Vortest) dienen. 
+ 
+ 
+#on("bold")#Archivsystem:#off("bold")# 
+ 
+     Programmsystem zur Übertragung von Datenräumen zwischen Archiv und Hinter­
+     grund. 
+ 
+ 
+#on("bold")#EUMEL-0 (EUMEL-0-Maschine, Systemkern):#off("bold")# 
+ 
+     Softwareschicht, aufbauend auf die hardwareabhängige Schicht SHard. EUMEL-0 ist
+     nur vom Prozessor, nicht aber von der jeweiligen Rechnerkonfiguration abhängig. Die
+     durch EUMEL-0 definierte Schnittstelle zu höheren (in ELAN implementierten)
+     Schichten ist auf allen EUMEL-Systemen identisch. EUMEL-0 wird auf dem
+     EUMEL-Hintergrundarchiv angeliefert. 
+ 
+ 
+#on("bold")#Hintergrund (EUMEL-Hintergrund, HG):#off("bold")# 
+ 
+     1. Medium (z.B. Platte, Diskette, RAM) zur Speicherung von Datenräumen (Pro­
+        grammen, Daten und Dateien) aller Tasks eines EUMEL-Systems; 
+     2. Die Gesamtheit der auf diesem Medium gespeicherten Information. 
+ 
+     Die Bezeichnung "Hintergrund" ist im Zusammenhang mit dem Konzept des im
+     EUMEL realisierten Virtuellen Speichers zu sehen. Der Datentransfer zwischen Hin­
+     tergrund und Arbeitsspeicher (RAM) erfolgt ohne Zutun oder Wissen des EUMEL-
+     Benutzers bzw. der Task, der die Daten gehören. 
+
diff --git a/doc/porting-mc68k/1985.11.26/source-disk b/doc/porting-mc68k/1985.11.26/source-disk
new file mode 100644
index 0000000..bf86ccf
--- /dev/null
+++ b/doc/porting-mc68k/1985.11.26/source-disk
@@ -0,0 +1 @@
+porting/portdoc-m68k_eumel-netz-1985-11-26.img
diff --git a/doc/porting-z80/8/doc/Port.Z80 b/doc/porting-z80/8/doc/Port.Z80
new file mode 100644
index 0000000..ed3c80a
--- /dev/null
+++ b/doc/porting-z80/8/doc/Port.Z80
@@ -0,0 +1,2484 @@
+#type ("trium8")##limit (12.0)# 
+#pagelength(19.5)#
+#start(1.5,1.5)# 
+#type("triumb36")# 
+#free(4.0)# 
+  EUMEL 
+  Portierungshandbuch 
+  Z 80 
+#type("triumb18")# 
+#free(1.5)# 
+          Version 8 #page(1)# 
+#type ("trium8")##limit (12.0)# 
+#block# 
+#pagelength(19.5)# 
+#head# 
+#center#- % - 
+ 
+ 
+#end# 
+#type("triumb14")#Inhalt#a# 
+ 
+Teil 1: Einführung                                     #topage("ein")# 
+#free(0.3)# 
+        Zweck dieses Handbuchs                         #topage("zweck")# 
+        Referenzliteratur                              #topage("reflit")# 
+        Minimale Hardwarevoraussetzungen               #topage("hardw")# 
+        Systemdurchsatz                                #topage("durchsatz")# 
+        Softwarekomponenten des EUMEL-Systems          #topage("kompo")# 
+        Anlieferung des Z80-EUMEL-Systems              #topage("anlief")# 
+ 
+Teil 2: Allgemeine Strukturen                          #topage("allgem")# 
+#free(0.3)# 
+        Hintergrund                                    #topage("hg")# 
+        Archiv                                         #topage("arch")# 
+        Hauptspeicher                                 #topage("speicher")# 
+ 
+Teil 3: SHard-Interface Spezifikation                 #topage("shardifc")# 
+#free(0.3)# 
+   0. Vorbemerkungen                                  #topage("vor")# 
+        Zur Notation                                  #topage("not")# 
+        Link-Leisten                                  #topage("leist")# 
+        Allgemeine Link-Bedingungen                   #topage("link")# 
+        Interrupts                                    #topage("intr")# 
+   1. System laden                                    #topage("laden")# 
+   2. Systemstart und -ende                           #topage("start")# 
+   3. Speicherverwaltung                              #topage("spver")# 
+      Hauptspeicher                                   #topage("haupt")# 
+      Schattenspeicher                                #topage("schatt")# 
+      Blocktransfer im Speicher                       #topage("ldir")# 
+      Speicherfehler                                  #topage("memerr")# 
+   4. Zeitgeber                                       #topage("zeit")# 
+   5. Kanäle                                          #topage("channel")# 
+   5.1  Stream-IO                                     #topage("stream")# 
+        Terminals                                     #topage("term")# 
+        Drucker, Plotter                              #topage("druck")# 
+        Exoten                                        #topage("exot")# 
+   5.2  Block-IO                                      #topage("block")# 
+        Block-IO bei Hintergrund und Archiv           #topage("bhgarch")# 
+   5.3  IO-Steuerung                                  #topage("iocontrol")# 
+        Einstellung serieller Schnittstellen          #topage("v24")# 
+        Flußkontrolle                                 #topage("fluss")# 
+        Kalender                                      #topage("kalender")# 
+   6. SHard-Interface Version                         #topage("shdver")# 
+   7. ID-Konstanten                                   #topage("ID")# 
+   8. Zusätzliche Leistungen                          #topage("shdelan")# 
+   9. Spezialroutinen                                 #topage("ke")# 
+ 
+Teil 4: Tips zur Portierung                           #topage("tips")# 
+        0-Version des SHards                          #topage("0ver")# 
+        Effizienzprobleme                             #topage("eff")# 
+        Typische Fehler                               #topage("fehler")# 
+ 
+Anhang A: EUMEL-Debugger "Info"                       #topage("info")# 
+#free(0.3)# 
+        Aufruf des Infos                              #topage("aufrinf")# 
+        Info-Format                                   #topage("forminf")# 
+        Info-Kommandos                                #topage("cmdinf")# 
+        Einige Systemadressen                         #topage("sysaddr")# 
+        Leitblock                                     #topage("pcb")# 
+#page# 
+#cc("Teil 1: ","Einführung")# 
+#goalpage("ein")# 
+ 
+ 
+#b("Zweck dieses Handbuchs")# 
+#goalpage("zweck")# 
+ 
+Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf einem
+neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungshandbüchern
+für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit Z80-Prozessoren. 
+ 
+Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! 
+ 
+ 
+ 
+#b("Referenzliteratur")# 
+#goalpage("reflit")# 
+ 
+ 
+          "EUMEL Benutzerhandbuch" 
+ 
+          "EUMEL Systemhandbuch" 
+ 
+          "EUMEL Quellcode der insertieren ELAN-Pakete" 
+ 
+          "Z80-Assembly Language Programming Manual" 
+          Zilog, 1977 
+ 
+ 
+ 
+#b("Minimale Hardwarevoraussetzungen")# 
+#goalpage("hardw")# 
+ 
+Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens
+folgenden Kriterien genügen: 
+ 
+          #ib#CPU#ie#              Die Z80-CPU sollte mit mindestens 2.5 MHz arbeiten. Falls
+                           die Buszugriffe durch einen CRTC o.ä. verlangsamt werden,
+                           sollte die echte Z80-Leistung durchschnittlich mindestens
+                           einem ungebremsten 2.5 MHz System entsprechen. 
+                           Seltene Verlangsamungen (z.B. nur bei I/O-Operationen)
+                           spielen bei diesen Überlegungen keine Rolle. 
+ 
+          RAM              Das System sollte über mindestens 64 K Byte #ib#Hauptspeicher#ie#
+                           verfügen, besser sind 128 K als Anfangsausrüstung. 
+ 
+          #ib#Hintergrund#ie#      Als Hintergrundmedium sind #ib#Floppy#ie#, #ib#Harddisk#ie# und RAM bzw.
+                           ROM denkbar. 
+ 
+                           Kapazität:    > 300 K, besser > 400 K (Single-User) 
+                                         > 750 K, besser > 1000 K (Multi-User) 
+ 
+                           Zugriff:      < 500 ms  (Single-User) 
+                                         < 200 ms  (Multi-User) *) 
+#foot# 
+#f#*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Floppies kann man
+sie als Summe der Positionierzeit über die halbe Platte und der Zeit einer halben Umdrehung berechnen.#a# 
+#end# 
+ 
+          #ib#Archiv#ie#           Als Archivgerät wird meistens eine Floppy eingesetzt. Aber
+                           auch Band oder Kassettenrecorder sind denkbar. Die An­
+                           forderungen an Kapazität und Geschwindigkeit sind anwen­
+                           dungsspezifisch. 
+ 
+          #ib#Bildschirm#ie#       Angestrebt werden sollte ein Bildschirm mit 24 Zeilen mit je
+                           80 Zeichen (oder größer). Kleinere Bildschirme sind anschließ­
+                           bar, aber mit 40 Zeichen pro Zeile läßt sich nicht mehr kom­
+                           fortabel arbeiten. 
+                           Rollup und freie Cursorpositionierung sind notwendige Vor­
+                           aussetzungen, invers-video ist erwünscht, aber nicht not­
+                           wendig. Weiterhin werden 'Löschen bis Zeilenende' und
+                           'Löschen bis Schirmende' benötigt. Lokale Editierfunktionen
+                           sind überflüssig. 
+ 
+          #ib#Tastatur#ie#         An Steuertasten sollten mindestens ESC und die vier Cursor­
+                           tasten vorhanden sein. Dabei ist es günstig, wenn die Cursor­
+                           tasten ergonomisch als Block bzw. Kreuz angeordnet sind.
+                           EUMEL benötigt weitere Steuertasten für HOP, RUBIN,
+                           RUBOUT und MARK. Dafür können beliebige Tasten der
+                           Tastatur gewählt werden. 
+ 
+ 
+ 
+#b("Systemdurchsatz")# 
+#goalpage("durchsatz")# 
+ 
+Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­
+durchsatz von 
+ 
+     -  CPU Leistung 
+     -  Speichergröße (RAM) 
+     -  Geschwindigkeit beim Hintergrundzugriff (Floppy, Harddisk) 
+ 
+ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging
+(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­
+leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang
+steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt
+wenig RAM durch eine schnelle Platte ausgleichen. 
+ 
+ 
+ 
+#b("Softwarekomponenten des EUMEL-Systems")# 
+#goalpage("kompo")# 
+ 
+Das EUMEL-System besteht aus mehreren Schichten: 
+ 
+ 
+ 
+          EUMEL  2:   Standardpakete, Editor, ... 
+ 
+          EUMEL  1:   ELAN Compiler 
+ 
+          EUMEL  0:   Basismaschine 
+ 
+          EUMEL -1:   SHard 
+ 
+                  H a r d w a r e 
+ 
+ 
+Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere)
+Schichten erweitert werden. 
+ 
+EUMEL > 0    Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN geschrie­
+             ben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schichten ober­
+             halb der EUMEL-0-Maschine prozessor- und rechnerunabhängig, d.h.
+             Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. 
+ 
+#ib#EUMEL 0#ie#      Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und
+             hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie
+             existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ Z80
+             Bezug genommen. Bei der Portierung auf einen Z80-Rechner wird die
+             Z80-EUMEL-0-Maschine ohne Anpassungen (!) übernommen. 
+ 
+EUMEL -1     Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und der
+             eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere umfaßt
+             sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber). 
+             Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). 
+ 
+Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen Z80-Rech­
+ner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil dieses
+Handbuchs aus der Spezifikation des Z80-SHards. 
+ 
+ 
+ 
+#b("Anlieferung des Z80-EUMEL-Systems")# 
+#goalpage("anlief")# 
+ 
+Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende Stan­
+dardformate zur Wahl: 
+ 
+          8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
+ 
+          8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
+ 
+          5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte *) 
+#foot# 
+#f#*)   48 tpi#a# 
+#end# 
+ 
+ 
+Die Diskettenlieferung enthält 
+ 
+          -  Single-User Hintergrund 
+          -  Multi-User Hintergrund 
+          -  Standardarchive 
+          -  Archive mit weiterer Anwendersoftware 
+ 
+Dabei enthält der Hintergrund auch die EUMEL-0-Software (oft auch als "Urlader" be­
+zeichnet). 
+ 
+#on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als Quelle
+beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# 
+#page# 
+#cc("Teil 2: ","Allgemeine Strukturen")# 
+#goalpage("allgem")# 
+ 
+ 
+#b("Hintergrund")# 
+#goalpage("hg")# 
+ 
+Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern (0,
+1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium bleibt dem
+SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte darauf achten,
+daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen sollten. Deshalb ist
+in der Regel zylinderorientierte Anordnung der oberflächenorientierten vorzuziehen. 
+ 
+Falls auf dem Hintergrundgerät spezielle Blöcke z.B. für Boot und SHard freigehalten werden
+sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die Sektoren der Floppy
+bzw. der Harddisk berücksichtigt werden. 
+ 
+Aufbau des Hintergrundes: 
+ 
+     Block  0                Systemetikett 
+ 
+     Block  10...10+k-1      EUMEL-0-Software (Urlader) 
+ 
+     Block  1...9, 10+k ...  Paging-Bereich 
+ 
+ 
+Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#): 
+ 
+     Byte        Wert/Aufgabe 
+ 
+     0...5       "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. 
+     6...11      Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß Urlader und
+                 Hintergrund kompatibel sind. 
+     12          FFh  ; zur Zeit ohne Bedeutung 
+     13          enthält Wert 0 , wenn System im Shutupzustand ist. 
+     14..15      Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1
+                 erhöht. 
+     16..35      Reserviert; zur Zeit ohne Bedeutung 
+     36..37      Aus historischen Gründen für interne Zwecke belegt. 
+     38 .. 69    Hier kann eine Installationsnummer geführt werden. 
+     70 .. 79    Info-Paßwort 
+     80          =0 Normalzustand 
+                 =1 Kompresslauf erforderlich (System frisch von Archiv geladen) 
+     81...255    Reserviert. 
+     256..511    Kann von SHard beliebig verwendet werden. 
+ 
+ 
+ 
+#b("Archiv")# 
+#goalpage("arch")# 
+ 
+Wie der Hintergrund sind die Archive in 512 Bytes große Blöcke unterteilt. Bisher gibt es
+folgende #dx("Standardformate")#: 
+ 
+ 
+     8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
+     8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte 
+ 
+          Block           Seite             Spur             Sektor 
+ 
+            0               0                 0                 0 
+           16               0                 1                 0 
+          77*16             1                 0                 0 
+ 
+            n         n DIV (77*16)   n MOD (77*16) DIV 16   n MOD 16 
+ 
+ 
+     5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte 
+ 
+          Block           Seite             Spur              Sektor 
+ 
+            0               0                 0                 1 
+            9               0                 1                 1 
+          40*9              1                 0                 1 
+ 
+            n         n DIV (40*9)   n MOD (40*9) DIV 9    n MOD 9 + 1 
+ 
+ 
+     5", 2D, 80 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte 
+ 
+          Block           Seite             Spur             Sektor 
+ 
+            0               0                 0                 1 
+            9               0                 1                 1 
+          80*9              1                 0                 1 
+ 
+            n         n DIV (80*9)    n MOD (80*9) DIV 9    n MOD 9 + 1 
+ 
+ 
+     5", HD, 80 Spuren, 15 Sektoren (\#1...\#15) � 512 Byte 
+ 
+          Block           Seite             Spur             Sektor 
+ 
+            0               0                 0                 1 
+           15               0                 1                 1 
+          80*15             1                 0                 1 
+ 
+            n        n DIV (80*15)   n MOD (80*15) DIV 15   n MOD 15 + 1 
+ 
+ 
+Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus
+Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in der
+Kapazität) ergeben. 
+ 
+Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate
+unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen verschie­
+denen Rechnertypen zu vereinfachen. 
+ 
+#on("i")#Hinweis:  Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfachen,
+          sollten möglichst alle der hardwaremäßig möglichen Standardformate (mindestens
+          lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf das Format
+          der jeweils eingelegten Floppy einstellen:#off("i")# 
+ 
+ 
+               Laufwerkstyp      Diskettentyp(en) 
+ 
+                  8" 1D              8" 1D 
+                  8" 2D              8" 2D, 1D 
+ 
+                  5" 2D-40           5" 2D-40 
+                  5" 2D-80           5" 2D-80, 2D-40 *) 
+                  5" HD-80           5" HD-80, 2D-80, 2D-40 *) 
+#foot# 
+#f#*) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: 
+     a) Lesen funktioniert sicher. 
+     b) Schreiben ist unsicher, funktioniert aber häufig. 
+     c) Formatieren funktioniert fast nie. 
+#a# 
+#end# 
+ 
+ 
+ 
+#b("Hauptspeicher")# 
+#goalpage("speicher")# 
+ 
+Die 64 K des direkt vom Z80 adressierbaren #ib#Speicher#ie#s sind folgendermaßen aufgeteilt: 
+ 
+          FFFFh          #corner1("-5.0")# 
+                           Platz für SHard 
+          yyyyh          #box3("T","3","75.0")# 
+                         #corner1("-5.0")# 
+                           Pagingbereich 
+ 
+          xxxxh          #box3("T","3","75.0")# 
+                         #corner1("-5.0")# 
+                           EUMEL 0 
+ 
+          1400h          #box3("T","3","75.0")# 
+                         #corner1("-5.0")# 
+                           Platz für SHard 
+          0000h          #box3("T","3","75.0")# 
+ 
+Möglichst große Teile des SHards (am besten alle) sollten im unteren Adreßbereich (bis
+13FFh) liegen, damit dem Paging viel Speicher zur Verfügung steht. 
+ 
+Der nicht direkt (aber durch Banking oder DMA) erreichbare Teil des #ib#RAM#ie#s wird Schatten­
+speicher (siehe S.#topage("schatt")#) genannt. 
+ 
+ 
+Hinweis:  Falls ein Teil des Hauptspeicher-Adreßraums fest (d.h. auch nach dem Boot­
+          loading nicht ausblendbar) durch ROM belegt ist, muß dieses in einem der beiden
+          SHard-Bereichen liegen. 
+ 
+#page# 
+#cc("Teil 3: SHard ","Interface Spezifikation")# 
+#goalpage("shardifc")# 
+ 
+ 
+#bb("0.  ","Vorbemerkungen")# 
+#goalpage("vor")# 
+ 
+ 
+#b("Zur Notation")# 
+#goalpage("not")# 
+ 
+Im folgenden wird zwischen #dx("0-Routinen")#, die dem SHard vom EUMEL-0-System zur
+Verfügung gestellt werden, und #dx("SHard-Routinen")# unterschieden, die der SHard implementie­
+ren muß. Damit dieser Unterschied bei der Spezifikation deutlich wird, werden 0-Routinen
+folgendermaßen aufgeführt: 
+ 
+          name       (0-Routine) 
+ 
+Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrieben. 
+ 
+Z80-Befehle werden wie in "Z80-Assembly Language Programming Manual" (Zilog, 1977)
+notiert: 
+ 
+          ld  a,27 
+          add a,l 
+ 
+Hexadezimale Zahlen werden durch ein nachgestelltes 'h' gekennzeichnet: 
+ 
+            12h = 18 
+            1Fh = 31 
+          FFFFh = 65535 
+ 
+ 
+#b("Link-Leisten")# 
+#goalpage("leist")# 
+ 
+Die Verbindung zwischen SHard und Urlader (EUMEL-0) erfolgt über zwei Tabellen. In der
+"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese
+Leiste beginnt an der Adresse 1400h: 
+ 
+       1400h               defm  'EUMEL           ' 
+       1410h               defw  eumel0blocks 
+       1412h               defw  hgversion 
+       1414h               defw  1        ; Kennzeichen für Z80-Urlader 
+       1416h               defw  urladerversion 
+       1418h               defw  0        ; reserviert 
+       141ah               defw           ; kleinste unterstützte SHardversion 
+       141ch               defw           ; größte ... 
+       141eh               jp    systemstart 
+                           jp    inputinterrupt 
+                           jp    timerinterrupt 
+                           jp    warte 
+                           jp    grab 
+                           jp    free 
+                           jp    shutup 
+                           jp    info 
+ 
+Diese Leiste wird vom Urlader nach dem Systemstart überschrieben. Der SHard muß daher,
+bevor er nach systemstart springt, die für ihn relevanten Teile (mindestens die Sprungbefehle)
+in einen eigenen Bereich kopieren: 
+ 
+          #ib#eusystemstart#ie#:     jp     0 
+          #ib#euinputinterrupt#ie#:  jp     0 
+          #ib#eutimerinterrupt#ie#:  jp     0 
+          #ib#euwarte#ie#:           jp     0 
+          #ib#eugrab#ie#:            jp     0 
+          #ib#eufree#ie#:            jp     0 
+          #ib#eushutup#ie#:          jp     0 
+          #ib#euinfo#ie#             jp     0 
+ 
+So kann SHard die entsprechenden 0-Routinen vermittels der obigen Vereinbarungen aufru­
+fen: 
+ 
+          jp    eusystemstart 
+          ... 
+          call  euwarte 
+ 
+Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung
+stellen, deren Adresse beim Sprung nach 'systemstart' in HL stehen muß. Die 0-Maschine
+kopiert diese Leiste. SHard darf daher anschliessend den Bereich anderweitig (z.B.
+EA-Puffer) verwenden: 
+ 
+ 
+          #ib#SHDID#ie#:           defm 'SHARD           '   ; 16 Byte 
+          #ib#SHDVER#ie#:          defw 8 
+          #ib#MODE#ie#:            defw 
+          #ib#ID4#ie#:             defw 
+          #ib#ID5#ie#:             defw 
+          #ib#ID6#ie#:             defw 
+          #ib#ID7#ie#:             defw 
+                           defw 
+                           defw 
+          #ib#OUTPUT#ie#:          jp shout 
+          #ib#BLOCKIN#ie#:         jp shbin 
+          #ib#BLOCKOUT#ie#:        jp shbout 
+          #ib#IOCONTROL#ie#:       jp shiocnt 
+          #ib#SYSEND#ie#:          jp shend 
+          #ib#SCHINF#ie#:          jp shsinf 
+          #ib#SCHACC#ie#:          jp shsacc 
+                           defw 
+          #ib#LIMIT#ie#:           defw 
+ 
+ 
+#b("Allgemeine Link-Bedingungen")# 
+#goalpage("link")# 
+ 
+In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'call' aufzurufen: 
+ 
+          call <routine> 
+ 
+Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. 
+ 
+Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: 
+ 
+     Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und das F-Regi­
+     ster *) - bleiben unverändert. 
+#foot# 
+#f#*) Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags, die als Ausgangs­
+parameter in manchen Fällen definiert sind.#a# 
+#end# 
+ 
+Jede SHard-Routine muß also alle Register (bis auf F), die sie verändert und die keine
+Ausgangsparameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim
+Aufruf von 0-Routinen selbst keine Register zu retten. 
+ 
+ 
+#b("Interrupts")# 
+#goalpage("intr")# 
+ 
+Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von
+EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'call' an 0-Routinen
+weiterleiten. Außerhalb des Moduls SHard wird der 'reti'-Befehl nicht verwendet, damit der
+SHard die Kontrolle über die Interruptlevel behält. Die Register (bis auf die Eingangsparame­
+ter) werden von den aufzurufenden 0-Routinen selbst gesichert. Die normale Interrupt-
+Sequenz im SHard sieht dann folgendermaßen aus: 
+ 
+          intadr: push af 
+                  ld a,<parameter> 
+                  call <routine> 
+                  pop af 
+                  reti 
+ 
+Achtung: SHard muß die Interrupt-Routinen im 'disable-int'-Modus anspringen. Dies ist
+         normalerweise schon durch die Hardware gegeben. 
+ 
+Die 0-Routinen geben von sich aus den 'ei'-Befehl. Dies erfolgt im allgemeinen sehr
+frühzeitig (innerhalb der ersten 30 Befehle), um einen interruptgetriebenen Floppytreiber
+zulassen zu können. 
+ 
+ 
+ 
+ 
+#bb("1.  System ","laden")# 
+#goalpage("laden")# 
+ 
+SHard muß die EUMEL-0-Software vor dem eigentlichen Start laden. EUMEL-0 befindet
+sich normalerweise auf dem Hintergrund. Es müssen von Block 10 an eumel-0-blocks
+(siehe 0-Leiste) Blöcke in den Speicher von der Adresse 1400h an aufsteigend geladen
+werden. 
+ 
+     Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen natür­
+              lich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht 'warte'
+              aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff beim
+              eigentlichen Systemlauf in der Regel 'warte' verwenden wird. 
+ 
+     Hinweis: Der erste Block der EUMEL-0-Software (Block 10) enthält in den ersten
+              fünf Bytes den Text "EUMEL", um eine Identifikation durch den SHard-
+              Lader zu ermöglichen. 
+ 
+Es wird empfohlen, nach folgendem Verfahren zu laden: 
+ 
+     IF archivgeraet enthaelt diskette AND eumel 0 auf archiv 
+       THEN lade eumel 0 vom archiv 
+     ELIF eumel 0 auf hintergrund 
+       THEN lade eumel 0 vom hintergrund 
+     ELSE laden unmoeglich 
+     FI . 
+ 
+So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­
+grund (mit EUMEL-0-Urlader) einspielen, indem man ein Hintergrundarchiv vor dem
+Systemstart in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den
+Hintergrund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrund­
+medium kopieren kann.*) 
+#foot# 
+#f#*) Kopiervorgänge (Archiv -> Hintergrund) werden vom EUMEL-0-Urlader erledigt, so daß SHard keine derartigen
+Routinen enthalten muß.#a# 
+#end# 
+ 
+ 
+ 
+#bb("2.  System","start und -ende")# 
+#goalpage("start")# 
+ 
+SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen und
+erst danach die EUMEL-0-Maschine starten ('systemstart'). 
+ 
+     #dx("systemstart")#           (0-Routine) 
+ 
+          Eingang:         HL = Adresse der SHard-Leiste 
+                           Interrupts disabled 
+ 
+          Aufruf:          jp systemstart 
+ 
+          Zweck:           Die EUMEL-0-Maschine wird gestartet. Alle notwendigen
+                           Hardwareinitialisierungen (Interrupt Modus des Z80 und Ini­
+                           tialisierungen der Peripheriebausteine) müssen vorher schon
+                           geschehen sein. 
+ 
+          Hinweis:         Der Stackpointer braucht nicht definiert zu sein, da beim
+                           Ansprung DI-Zustand herrschen sollte und somit keine
+                           Interrupts auftreten können. EUMEL-0 lädt beim Start das
+                           SP-Register und läßt Interrupts zu (EI). Falls jedoch in dieser
+                           Zeit ein "Non Maskable Interrupt" auftreten kann, muß SHard
+                           SP "vorläufig" laden. 
+ 
+          MODE:            Über das MODE-Wort in der SHard-Leiste können Op­
+                           tionen gesetzt werden: 
+ 
+                           Bit 0 = 0      EUMEL-0 ist auf dem Hintergrund abge­
+                                          speichert. Der entsprechende Bereich bleibt
+                                          geschützt. (Standard) 
+ 
+                           Bit 0 = 1      EUMEL-0 befindet sich nicht auf dem Hin­
+                                          tergrund. Der entsprechende Bereich steht
+                                          zur freien Verfügung für andere EUMEL-
+                                          Daten. 
+                                          (Da die EUMEL-0-Software nur beim
+                                          Systemstart geladen wird (read only!), kann
+                                          es bei Geräten mit kleinem Hintergrund
+                                          interessant sein, diese Blöcke auf dem
+                                          Hintergrund anderweitig zu nutzen. Das
+                                          Systemladen kann dann z.B. mit Hilfe einer
+                                          speziellen Urladediskette vom Archivgerät
+                                          aus erfolgen.) 
+ 
+                           Bit 8 = 0      Beim Systemstart wird der Speicher über­
+                                          prüft. (Standard) 
+ 
+                           Bit 8 = 1      Der Speichertest beim Systemstart unter­
+                                          bleibt. Man sollte nur bei Rechnern, die
+                                          beim Einschalten schon eigene Speicher­
+                                          tests durchführen, auf den Speichertest des
+                                          EUMEL verzichten. 
+ 
+                           Bit 9 = 0      Beim Systemstart wird die Vortest-Tapete
+                                          ausgegeben und man kann durch Eingabe
+                                          eines Zeichens die Vortestmenüs aktivieren
+                                          (s. Systemhandbuch). (Standard) 
+ 
+                           Bit 9 = 1      Die Vortest-tapete wird unterdrückt. Es gibt
+                                          auch keine Möglichkeit, die Vortestfunk­
+                                          tionen aufzurufen. Der Speichertest unter­
+                                          bleibt ebenfalls. 
+ 
+ 
+     #dx("SYSEND")# 
+ 
+          Parameter:       - 
+ 
+          Zweck:           Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt.
+                           Somit können evtl. notwendige Abschlußbehandlungen durch­
+                           geführt werden. SHard kann mit 'ret' zu EUMEL-0 zurück­
+                           kehren, muß aber nicht. Diese Routine kann z.B. dazu benutzt
+                           werden, die Hardware auszuschalten oder in ein umgebendes
+                           System zurückzukehren (EUMEL als Subsystem). In den
+                           meisten Fällen wird die Routine leer implementiert werden,
+                           d.h. nur aus 'ret' bestehen. 
+ 
+ 
+#bb("3.  ","Speicherverwaltung")# 
+#goalpage("spver")# 
+ 
+ 
+#b("Hauptspeicher")# 
+#goalpage("haupt")# 
+ 
+Der Hauptspeicher (#ib#RAM#ie#) umfaßt die direkt adressierbaren 64 K des Z80. Da die Anfangs­
+adresse des für EUMEL-0 und Paging verfügbaren Bereichs fest ist (1400h), muß SHard nur
+über die Obergrenze des verfügbaren Bereichs informieren. 
+ 
+     #dx("LIMIT")# 
+ 
+                           Über das LIMIT-Wort in der SHard-Leiste kann sich SHard
+                           noch Bereiche vor dem Speicherende (z.B. für CP/M BIOS)
+                           freihalten. Auf jeden Fall muß CFFFh <= LIMIT gewährleistet
+                           sein, d.h. der Bereich bis CFFFh gehört zum Pagingbereich.
+                           Im Normalfall wird FFFFh geliefert werden. 
+ 
+ 
+ 
+#b("Schattenspeicher")# 
+#goalpage("schatt")# 
+ 
+Das EUMEL-System ist in der Lage, trotz der durch die 16-Bit Adressen gegebenen Ein­
+schränkung auf 64 kB, weiteren Speicher anzuschließen. Dieser wird Schattenspeicher
+genannt. 
+ 
+Der Schattenspeicher (#ib#RAM#ie#) sollte so angeschlossen sein, daß über ein nicht zu großes #ib##on("italic")#
+Fenster#ie##off("italic")# des normalen Adressraumes ( < 4 kB) auf diesen zugegriffen werden kann. Welcher
+Bereich des Schattenspeichers dabei gemeint ist, wird durch die SHard-Routine SCHACC
+mitgeteilt (s.u.). Diese Art des Zugriffs wird Fenstermodus genannt. Das Restsystem nutzt das
+Fenster echt (d.h. ohne den Inhalt in andere Bereiche des normalen Adressraumes zu trans­
+portieren). 
+ 
+Ist ein so kleines Fenster in der Hardware nicht vorgesehen (z.B. 48 kB Bänke bzw. nur
+DMA-Zugriff), so kann auch solcher Schattenspeicher benutzt werden (Transportmodus).
+Wichtig ist dabei, daß EUMEL-0 die oben erwähnten echten Fensterzugriffe unterläßt.
+(Simulation im Transportmodus wäre erheblich zu teuer.) Daher muß EUMEL-0 wissen, in
+welchem Modus der Schattenspeicher ansprechbar ist (SCHINF). 
+ 
+Hinweis:  Wenn möglich sollte der Fenstermodus implementiert werden, da er im Multi-
+          User-Betrieb (ab ca. 3 Teilnehmern) deutliche Effizienzvorteile bietet. 
+ 
+ 
+Das Schattenspeicherinterface gibt es in 2 Modi: 
+ 
+     -  Fenstermodus (Bit 2**15 von BC gesetzt bei SCHINF) 
+     -  Transportmodus (Bit 2**14 von BC gesetzt bei SCHINF) 
+ 
+ 
+#d("Fenstermodus")# 
+ 
+     #dx("SCHINF")#                (im Fenstermodus) 
+ 
+          Ausgang:         BC    2**15 + Schattenspeichergröße (in K) 
+ 
+          Zweck:           EUMEL-0 kann so die Größe des Schattenspeichers und den
+                           gewünschten Modus (hier: Fenstermodus) erfragen. Falls kein
+                           Schattenspeicher vorhanden ist, muß 0 als Größe geliefert
+                           werden. Das Resultat von SCHINF darf sich innerhalb eines
+                           Systemlaufs nicht ändern. 
+ 
+ 
+     #dx("SCHACC")#                (im Fenstermodus) 
+ 
+          Eingang:         HL    Nummer der 1/2K-Seite, die in das Fenster zu schal­
+                                 ten ist. 
+          Ausgang:         HL    Anfangsadresse (im Normaladreßraum) des aktuellen
+                                 Fensters 
+ 
+          Zweck:           Dient zum Zugriff auf den Schattenspeicher über das Fen­
+                           ster. Man beachte, daß mehrere Fenster möglich sind, aber
+                           alle im Adreßbereich des SHards liegen müssen! Die Num­
+                           mern der 1/2K-Seiten des Schattenspeichers liegen immer
+                           im Bereich von 0 bis 2n-1, wobei n die von SCHINF geliefer­
+                           te Größe des Schattenspeichers ist. Daraus folgt, daß
+                           SCHACC nicht aufgerufen wird, falls kein Schattenspeicher
+                           vorhanden ist. 
+ 
+#d("Transportmodus")# 
+ 
+     #dx("SCHINF")#                (im Transportmodus) 
+ 
+          Ausgang:         BC    2**14 + Schattenspeichergröße (in K) 
+ 
+          Zweck:           EUMEL-0 kann so die Größe des Schattenspeichers und den
+                           gewünschten Modus (hier: Transportmodus) erfragen. Falls
+                           kein Schattenspeicher vorhanden ist, muß 0 als Größe gelie­
+                           fert werden. Das Resultat von SCHINF darf sich innerhalb
+                           eines Systemlaufs nicht ändern. 
+ 
+ 
+     #dx("SCHACC")#                (im Transportmodus) 
+ 
+          Eingang:         A = 1  Transport in den Schattenspeicher 
+                           A = 2  Transport aus dem Schattenspeicher 
+                           DE     Nummer der 1/2K Seite im Schattenspeicher 
+                           HL     Adresse im normalen Hauptspeicherbereich 
+ 
+          Zweck:           Es werden jeweils 512 Bytes aus dem Normal- in den
+                           Schattenspeicher (A=1) bzw. aus dem Schattenspeicher in
+                           den normalen Hauptspeicher (A=2) kopiert. 
+                           Die Nummern der 1/2K-Seiten des Schattenspeichers liegen
+                           immer im Bereich von 0 bis 2n-1, wobei n die von SCHINF
+                           gelieferte Größe des Schattenspeichers ist. Daraus folgt, daß
+                           SCHACC nicht aufgerufen wird, falls kein Schattenspeicher
+                           vorhanden ist. 
+ 
+          Eingang:         A = 3 
+                           E      Index (immer geradzahlig: 0,2,4,...254) 
+          Ausgang:         BC     Bereichslänge DIV 3 
+                           HL     Bereichsadresse 
+ 
+          Zweck:           Für den angegebenen Index ist die Adresse eines Haupt­
+                           speicherbereichs und 1/3 der Länge dieses Bereichs zu­
+                           rückzumelden (Anzahl Einträge � 3 Bytes) Es sind also 128
+                           solcher Bereiche zur Verfügung zu stellen. Bei n K Schat­
+                           tenspeicher sollte jeder Bereich größer als 6*n/128 Bytes sein.
+                           Alle Bereiche müssen gleich groß sein. 
+ 
+                           Beispiel: Bei bis zu 256 K sollten 16-Byte-Bereiche
+                                     benutzt werden: 
+ 
+                           shacc3:    ld   l,e 
+                                      ld   h,0 
+                                      add  hl,hl 
+                                      add  hl,hl 
+                                      add  hl,hl 
+                                      ld   bc,schtab 
+                                      add  hl,bc      ; <e> DIV 2 * 16 + schtab 
+                                      ld   bc,5       ; 16 DIV 3 
+                                      ret 
+ 
+                           schtab:    defs 128*16 
+ 
+ 
+ 
+ 
+#b("Blocktransfer im Speicher")# 
+#goalpage("ldir")# 
+ 
+ 
+ 
+#b("Speicherfehler")# 
+#goalpage("memerr")# 
+ 
+Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen
+und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt werden. 
+ 
+Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er wenn
+möglich eine entsprechende Meldung ausgeben und das System brutal anhalten: 
+ 
+          rien#ub# #ue#ne#ub# #ue#vas#ub# #ue#plus:   jr   rien#ub# #ue#ne#ub# #ue#vas#ub# #ue#plus 
+ 
+ 
+Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die
+Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern führen. 
+ 
+Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL-
+Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält aber
+auf alle Fälle ein konsistentes System. 
+ 
+ 
+ 
+ 
+#bb("4.  ","Zeitgeber")# 
+#goalpage("zeit")# 
+ 
+SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt.
+Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr nicht
+geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. 
+ 
+     #dx("timerinterrupt")#        (0-Routine) 
+ 
+          Eingang:         A     seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) 
+ 
+          Zweck:           Wird von EUMEL-0 für interne Uhren und für das Schedu­
+                           ling (Zeitscheibenlogik) verwendet. Es werden keine hohen
+                           Genauigkeitsanforderungen an die Zeitangaben bei #on("i")#einzel­
+                           nen#off("i")# Interrupts gestellt. Um EUMEL-0 eine genaue Real­
+                           zeituhr zu ermöglichen, sollte die so erzeugte Zeitangabe #on("i")#im
+                           Mittel#off("i")# aber möglichst genau sein, d.h. die Summe der inner­
+                           halb einer Minute so übergebenen Werte sollte zwischen
+                           59995 und 60005 liegen. 
+ 
+ 
+ 
+#bb("5.  ","Kanäle")# 
+#goalpage("channel")# 
+ 
+Einiges zum Kanalkonzept: 
+ 
+Das System kennt die Kanäle 0..32. 
+ 
+     Kanal 0 ist der Systemhintergrund. 
+     Die Kanäle 1..15 sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. 
+     Kanal 31 ist der Standard-Archivkanal. 
+     Kanal 32 ist der Parameterkanal. 
+ 
+Die Kanäle 2.. 30 können installationsabhängig verfügbar sein oder auch nicht. Deren Funk­
+tion ist dann Absprachesache zwischen Installation und SHard. 
+ 
+Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..) ange­
+sprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des Kanals
+sinnvoll ist. 
+ 
+#on("i")##on("b")#Achtung:  Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen
+          werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und
+          unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert wer­
+          den.#off("b")# (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# 
+ 
+ 
+ 
+#bb("5.1 ","Stream-IO")# 
+#goalpage("stream")# 
+ 
+Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Termi­
+nals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. 
+ 
+     #dx("inputinterrupt")#        (0-Routine)#goalpage("inp")# 
+ 
+          Eingang:         A     Kanalnummer (1...15) 
+                           B     eingegebenes Zeichen 
+                           C     Fehlerbits: 
+                                 Bit 0 = 1           Mindestens ein Zeichen ging
+                                                     verloren. 
+                                 Bit 1 = 1           Es wurde der BREAK-Zustand
+                                                     (bei V24) erkannt. 
+                                 Bit 2 = 1           Das Zeichen ist u.U. falsch
+                                                     (Paritätsfehler). 
+ 
+          Ausgang:         A     Anzahl Zeichen, die noch übernommen werden kön­
+                                 nen. 
+ 
+          Zweck:           SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen,
+                           daß eine Eingabe vorliegt. 
+ 
+          Hinweise:        EUMEL-0 puffert die Zeichen. Siehe auch IOCONTROL:
+                           "weiter". 
+ 
+                           Bei Kanalnummern <1 oder >15 wird der Aufruf von
+                           EUMEL-0 ignoriert. 
+ 
+                           Falls die Hardware keine Inputinterrupts zur Verfügung stellt,
+                           sollte ein Timer benutzt werden, um alle möglichen Input­
+                           quellen regelmäßig abzufragen. Dabei muß man allerdings den
+                           goldenen Mittelweg zwischen zu häufiger (Systemdurchsatz
+                           sinkt) und zu seltener Abfrage (Zeichen gehen verloren)
+                           suchen. Man sollte dabei nicht nur an die menschliche Tipp­
+                           geschwindigkeit sondern auch an die höchste Baudrate
+                           denken, die man für Rechnerkopplungen noch unterstützen
+                           will. *) 
+#foot# 
+#f#*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funktion
+"weiter" beschrieben (siehe S.#topage("weiter")#).#a# 
+#end# 
+ 
+                           Falls SHard Flußkontrolle für den Kanal ausüben soll, muß er
+                           die Rückmeldung in A auswerten. Dabei ist mit einem geeig­
+                           neten Schwellwert zu arbeiten, da in der Regel die sendende
+                           Gegenstelle einer Sendeunterbrechung nicht sofort Folge
+                           leistet. 
+ 
+          Achtung:         #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden.
+                           Normalerweise wird das automatisch verhindert, wenn man
+                           den zugehörigen Hardwareinterrupt erst nach der 0-Routine
+                           wieder freigibt. Falls das nicht möglich ist und unter bestimm­
+                           ten Umständen das nächste Zeichen abgeholt werden muß,
+                           bevor die 0-Routine beendet ist, muß SHard einen eigenen
+                           Puffer implementieren:#off("i")# 
+ 
+                           hardwareinterrupt: 
+                               IF input interrupt aktiv 
+                                  THEN trage zeichen in shard puffer ein ; 
+                                       gib hardware interrupt frei 
+                                  ELSE input interrupt aktiv := true ; 
+                                       gib hardware interrupt frei ; 
+                                       input interrupt ; 
+                                       disable interrupt ; 
+                                       WHILE shard puffer enthaelt noch zeichen REP 
+                                             nimm zeichen aus shard puffer ; 
+                                             enable interrupt ; 
+                                             input interrupt ; 
+                                             disable interrupt 
+                                       PER ; 
+                                       input interrupt := false ; 
+                                       enable interrupt 
+                               FI . 
+ 
+ 
+     #d("OUTPUT")#
+ 
+          Eingang:         A     Kanalnummer (1...15) 
+                           BC    Anzahl auszugebender Zeichen 
+                           HL    Adresse der Zeichenkette 
+          Ausgang:         BC    Anzahl der übernommenen Zeichen 
+                           C-Flag gesetzt <=> alle Zeichen übernommen 
+ 
+          Zweck:           Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwi­
+                           schenzupuffern, denn die Ausführung von OUTPUT sollte kein
+                           Warten auf IO enthalten. Der Ausgabepuffer muß mindestens
+                           50, besser 100 Zeichen fassen können. Durch eine Inter­
+                           ruptlogik oder etwas Äquivalentes ist sicherzustellen, daß
+                           dieser Puffer parallel zur normalen Verarbeitung ausgegeben
+                           wird. Wenn die auszugebende Zeichenkette nicht vollstän­
+                           dig in den Puffer paßt, sollten trotzdem so viele Zeichen wie
+                           möglich übernommen werden. Im weiteren Verlauf ruft
+                           EUMEL-0 dann wieder OUTPUT mit dem Rest der Zei­
+                           chenkette auf. 
+ 
+          Hinweis:         OUTPUT kann mit BC=0 aufgerufen werden. Auch diese
+                           leere Operation muß mit gesetztem C-Flag quittiert wer­
+                           den. 
+ 
+          Achtung:         #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte'
+                           aufgerufen werden.#off("i")# 
+ 
+          Vorschlag:       Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig
+                           ist, sollte vorgegaukelt werden, alle Zeichen seien ausge­
+                           geben (BC unverändert und C-Flag gesetzt). 
+ 
+ 
+ 
+#b("Terminals")# 
+#goalpage("term")# 
+ 
+"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen wer­
+den. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie# werden
+von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard unabhängig
+sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL-Anwendern zur
+Verfügung! 
+#foot# 
+#f#*) Siehe "EUMEL Benutzerhandbuch"#a# 
+#end# 
+ 
+Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt gear­
+beitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). 
+ 
+Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch"
+unter den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. 
+ 
+ 
+ 
+#bb("Drucker, ","Plotter")# 
+#goalpage("druck")# 
+ 
+#ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der Regel
+der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen solche
+Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). 
+ 
+Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man
+auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist
+dabei, daß 
+ 
+     a)   der Drucker einen eigenen Puffer hat und 
+     b)   der Puffer "schnell" gefüllt werden kann (< 0.1 ms/Zeichen). 
+ 
+Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten und
+die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn der
+Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebrochen
+werden. *) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet werden!#off("i")# 
+#foot# 
+#f#*) siehe auch IOCONTROL "frout", S.#topage("frout")##a# 
+#end# 
+ 
+ 
+ 
+#b("Exoten")# 
+#goalpage("exot")# 
+ 
+Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetztabelle
+im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist (Beispiele:
+Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die soweit
+programmierbar sind, daß sie den EUMEL-Zeichencode können). 
+ 
+Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden. Dieser
+wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch) werden direkt
+dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden Besonderheiten: 
+ 
+Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: 
+ 
+     Code     Funktion 
+ 
+     7        SV      (Aktivierung: 'gib supervisor kommando:') 
+     17       STOP    (Ausgabe auf diesen Kanal wird gestoppt) 
+     23       WEITER  (Ausgabe läuft wieder weiter) 
+     4        INFO    (System geht in Debugger, falls Debugoption) 
+ 
+ 
+ 
+#bb("5.2 ","Block-IO")# 
+#goalpage("block")# 
+ 
+Über Block-IO wickelt das System die Zugriffe zum Pagingmedium und zum Archiv ab.
+Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopplung
+zuzulassen. Die Kanalnummer in Reg. A unterscheidet diese Fälle. Außer beim Paging (A=0)
+wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout' induziert. 
+ 
+Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben. Dieser
+kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Umpufferung
+erfolgen. 
+ 
+Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. 
+ 
+SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die
+verlangte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so muß
+SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiterlaufen
+lassen kann. 
+ 
+EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31).
+Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren
+Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System vergibt
+auch in Zukunft für den #ib##on("italic")#Funktionscode#ie##off("italic")# in Register BC nur positive Werte (Bit 7 von B = 0).
+Der SHard kann selbst negative Codes einführen. 
+ 
+ 
+     #d("BLOCKIN")#
+ 
+          Eingang:         A     Kanalnummer (0...32) 
+                           BC    Funktionscode 1 
+                           DE    Funktionscode 2 
+                           HL    Adresse des Hauptspeicherbereichs 
+          Ausgang:         A     undefiniert (darf also verändert werden) 
+                           BC    Rückmeldecode 
+                           HL    darf verändert werden 
+ 
+                           Der Inhalt des Hauptspeicherbereichs (<HL>... <HL>
+                           +511) darf verändert sein. 
+ 
+          Zweck:           "Einlesen" von Blöcken. Die genaue Wirkung hängt vom
+                           Funktionscode und dem Kanal ab. 
+ 
+          Vorschlag:       Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig
+                           ist, sollte die Rückmeldung -1 in BC geliefert werden. 
+ 
+ 
+     #d("BLOCKOUT")#
+ 
+          Eingang:         A     Kanalnummer (0...32) 
+                           BC    Funktionscode 1 
+                           DE    Funktionscode 2 
+                           HL    Adresse des Hauptspeicherbereichs 
+          Ausgang:         A     undefiniert (darf also verändert werden) 
+                           BC    Rückmeldecode 
+                           HL    darf verändert werden 
+ 
+                           Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert
+                           werden! 
+ 
+          Zweck:           "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom
+                           Funktionscode und dem Kanal ab. 
+ 
+          Vorschlag:       Falls der Kanal nicht existiert bzw. BLOCKOUT darauf un­
+                           sinnig ist, sollte die Rückmeldung -1 in BC geliefert wer­
+                           den. 
+ 
+ 
+     #dx("warte")#                 (0-Routine) 
+ 
+          Ausgang:         Alle Register undefiniert! 
+ 
+          Zweck:           Diese Routine ist bei 'blockin' oder 'blockout' dann aufzu­
+                           rufen, wenn SHard im Augenblick nichts zu tun hat. Durch
+                           den Aufruf von 'warte' erhalten andere Systemteile die
+                           Möglichkeit, weiterzuarbeiten. Ein 'warte' kann bis zu ca. 1/4
+                           Sekunde Zeit aufnehmen. 'warte' darf nicht in Interrupt­
+                           routinen und Stream-IO verwendet werden! 'warte' zerstört
+                           alle Register! SHard muß davon ausgehen, daß 'warte' sei­
+                           nerseits andere SHard-Komponenten aufruft. 
+ 
+ 
+Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht werden: 
+ 
+ 
+     blockout auf platte : 
+          WHILE platte noch nicht frei REP 
+            warte 
+          ENDREP ; 
+          uebertrage schreibbefehl an controller ; 
+          uebertrage daten an controller . 
+ 
+     blockin von platte : 
+          WHILE platte noch nicht frei REP 
+            warte 
+          ENDREP ; 
+          uebertrage lesebefehl an controller ; 
+          WHILE daten noch nicht gelesen REP 
+            warte 
+          ENDREP ; 
+          hole daten vom controller . 
+ 
+ 
+     blockout auf floppy : 
+          seekbefehl an controller ; 
+          WHILE seek noch nicht fertig REP 
+            warte 
+          ENDREP ; 
+          setze dma auf schreiben block zur floppy ; 
+          schreibbefehl an controller ; 
+          WHILE schreiben noch nicht fertig REP 
+            warte 
+          ENDREP . 
+ 
+     blockin von floppy : 
+          seekbefehl an controller ; 
+          WHILE seek noch nicht fertig REP 
+            warte 
+          ENDREP ; 
+          setze dma auf lesen block von floppy ; 
+          lesebefehl an controller ; 
+          WHILE lesen noch nicht fertig REP 
+            warte 
+          ENDREP . 
+ 
+ 
+ 
+#b("Block-IO bei Hintergrund und Archiv")# 
+#goalpage("bhgarch")# 
+ 
+#ib#Hintergrund#ie# (Kanal 0) und #ib#Archiv#ie# (Kanal 31) unterscheiden sich in den Link-Bedingungen nur
+in der Kanalnummer. Die Aufrufe von BLOCKIN und BLOCKOUT werden mit folgenden
+Eingangsparametern versorgt: 
+ 
+          #on("b")#BLOCKIN#off("b")#          A     0 bzw. 31 
+                           B     0 
+                           C     Blocknummer DIV 65536 
+                           DE    Blocknummer MOD 65536 
+                           HL    Hauptspeicheradresse 
+ 
+                           Der angegebene 512-Byte-Block ist in den Hauptspeicher
+                           ab <HL> einzulesen. 
+ 
+          #on("b")#BLOCKOUT#off("b")#         A     0 bzw. 31 
+                           B     0 
+                           C     Blocknummer DIV 65536 
+                           DE    Blocknummer MOD 65536 
+                           HL    Hauptspeicheradresse 
+ 
+                           Der Hauptspeicherbereich (<HL>...<HL>+511) ist auf den
+                           angegebenen Block zu schreiben. 
+ 
+Als Rückmeldungen sind zu liefern:#goalpage("errcod")# 
+ 
+          0                Operation korrekt ausgeführt. 
+          1                Manuell behebbarer Fehler (z.B. Laufwerktür offen) 
+          2                Permanenter Fehler (z.B. Daten nicht lesbar) 
+          3                Versorgungsfehler (zu hohe Blocknummer) 
+ 
+Zusätzlich zu der Rückmeldung muß bei BC <> 0 in HL die Adresse eines Fehlerstrings
+(Längenbyte + Fehlertext) geliefert werden. *) 
+#foot# 
+#f#*) Diese Zusatzrückmeldung ist nur für die BLOCKIN/OUT Aufrufe auf Kanal 0/31 von Bedeutung. Sie wird nur von
+EUMEL-0 beim Paging und im Hardwaretest ausgewertet.#a# 
+#end# 
+ 
+#dx("Fehlerwiederholungen")#:      Das EUMEL-System führt von sich aus Fehlerwiederho­
+                                   lungen beim Hintergrund- und beim Archivzugriff
+                                   durch. SHard sollte deshalb im Fehlerfall die Opera­
+                                   tion nicht selbst wiederholen, sondern einen Lese/
+                                   Schreibfehler zurückmelden. So werden dem
+                                   EUMEL-System auch Soft-Errors gemeldet. In
+                                   manchen Fällen soll vor einem erneuten Lese- oder
+                                   Schreibversuch der Arm auf Spur 0 positioniert
+                                   werden o.ä. Um das zu erreichen, sollte SHard diese
+                                   "Reparaturaktion" direkt im Anschluß an den fehler­
+                                   haften Versuch durchführen. 
+ 
+#dx("Kontrollesen")#:              Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist,
+                                   muß das allerdings vom SHard durchgeführt werden.
+                                   In der Regel reicht es dazu, den geschriebenen
+                                   Block "ohne Datentransport" zu lesen, so daß nur
+                                   CRC überprüft wird. 
+ 
+Will SHard weitere Archivlaufwerke zur Verfügung stellen, so kann er dafür Kanalnummern
+(30,29..) vergeben. Auf ELAN-Ebene kann die archivierende Task durch 'continue (x)' das
+Laufwerk 'x' ansteuern. 
+ 
+Hinweis:  Das System versucht Hintergrund und Archiv parallel zu betreiben, d.h. wenn
+          SHard bei der Hintergrundbehandlung das UP 'warte' aufruft, kann 'warte' seiner­
+          seits die Archivbehandlung des SHards aufrufen. Wenn beides z.B. denselben
+          Floppykontroller benutzt, muß SHard sicherstellen, daß das gut geht (z.B. durch
+          Semaphoren). 
+ 
+ 
+ 
+ 
+#bb("5.3 ","IO-Steuerung")# 
+#goalpage("iocontrol")# 
+ 
+Die IO-Steuerung erlaubt Steuerung und Zustandsabfragen der Kanäle. IO-Steuerung wird
+(außer bei Kanal 0) auch durch 'control' in ELAN induziert. 
+ 
+Der Funktionscode in BC unterliegt denselben Konventionen wie bei Block-IO, d.h. das
+System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes für
+Sonderzwecke vorsehen. 
+ 
+ 
+     #d("IOCONTROL")#
+ 
+          Eingang:         A     Kanalnummer (0...32) 
+                           BC    Funktionscode 1 
+                           DE    Funktionscode 2 
+                           HL    Funktionscode 3 
+          Ausgang:         BC    Rückmeldung 
+                           A     darf verändert werden, in einigen Fällen zusätzliche
+                                 Rückmeldung 
+                           C-Flag (in einigen Fällen zusätzliche Meldung) 
+ 
+          Zweck:           abhängig von 'Funktionscode 1' (s.u.) 
+ 
+Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: 
+ 
+     #d("IOCONTROL ""typ""")#
+ 
+          Eingang:         A     Kanalnummer (0...31) 
+                           BC    1 
+          Ausgang:         BC    Kanaltyp 
+ 
+          Zweck:           Informiert EUMEL-0, welche IO für den angegebenen Kanal
+                           sinnvoll ist. Die Rückmeldung in BC wird bitweise interpre­
+                           tiert: 
+ 
+                           Bit 0 gesetzt  <=>      'inputinterrupt' kann kommen. 
+                           Bit 1 gesetzt  <=>      OUTPUT ist sinnvoll. 
+                           Bit 2 gesetzt  <=>      BLOCKIN ist sinnvoll. 
+                           Bit 3 gesetzt  <=>      BLOCKOUT ist sinnvol. 
+                           Bit 4 gesetzt  <=>      IOCONTROL "format" ist sinn­
+                                                   voll. 
+ 
+          Hinweis:         #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß
+                           nur sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# 
+ 
+ 
+     #dx("IOCONTROL ""frout""")##goalpage("frout")# 
+ 
+          Eingang:         A     Kanalnummer (1...15) 
+                           BC    2 
+          Ausgang:         BC    Anzahl Zeichen, die nächster OUTPUT übernimmt 
+                           C-Flag gesetzt <=> Puffer leer 
+ 
+          Zweck:           Liefert Information über die Belegung des Puffers. Diese
+                           Information wird von EUMEL-0 zum Scheduling benutzt. 
+ 
+          Achtung:         #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat,
+                           muß irgendwann BC > 49 gemeldet werden.#off("i")# 
+ 
+          Hinweis:         Unter Berücksichtigung des oben Gesagten darf "gelogen"
+                           werden. Man kann z.B. immer 50 in BC zurückmelden, muß
+                           dann aber schlechtere Nutzung der CPU bei Multi-User-
+                           Systemen in Kauf nehmen. 
+ 
+                           Falls auf dem angegebenen Kanal ein Drucker mit eigenem
+                           Puffer über Parallelschnittstelle angeschlossen ist (siehe
+                           S.#topage("druck")#) und man auf einen SHard-internen Puffer verzichtet hat,
+                           sollte bei 'Druckerpuffer voll' 0 in BC und 'NC' zurückge­
+                           meldet werden. Wenn aber Zeichen übernommen werden
+                           können, sollte 50 in BC und 'C-Flag gesetzt' gemeldet
+                           werden. 
+ 
+          Vorschlag:       Falls der Kanal nicht existiert oder nicht für Stream-IO zur
+                           Verfügung steht, sollten 200 in BC und C-Flag gesetzt
+                           zurückgemeldet werden. 
+ 
+ 
+ 
+ 
+     #dx("IOCONTROL ""weiter""")##goalpage("weiter")# 
+ 
+          Eingang:         A     Kanalnummer (1...15) 
+                           BC    4 
+          Ausgang:         - 
+ 
+          Zweck:           Das System ruft "weiter" für den in A angegebenen Kanal
+                           auf, wenn es wieder Eingabezeichen puffern kann. 
+ 
+          Hinweis:         "weiter" wird von EUMEL-0 auch immer dann aufgerufen,
+                           wenn ein Prozeß auf dem angegebenen Kanal auf Eingabe
+                           wartet und keine Zeichen mehr gepuffert sind. Wenn der
+                           betroffene Kanal von sich aus keine Interrupts erzeugt, kann
+                           SHard dies benutzen, um durch Aufruf von 'inputinterrupt' ein
+                           Eingabezeichen zuzustellen. 
+                           #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle
+                           eingesetzt werden. Denn dann wird die SV-Taste nur an
+                           EUMEL-0 zugestellt, wenn ein Prozeß auf diesem Kanal auf
+                           Eingabe wartet. Somit sind in dieser Betriebsart CPU-inten­
+                           sive Endlosschleifen nicht normal abbrechbar!#off("i")# 
+ 
+ 
+     #d("IOCONTROL ""size""")#
+ 
+          Eingang:         AL    Kanalnummer (0...31) 
+                           CX    5 
+                           DX    Schlüssel 
+          Ausgang:         CX    Anzahl Blöcke MOD 65536 
+                           AL    Anzahl Blöcke DIV 65536 
+ 
+          Zweck:           EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren,
+                           die ein Block-IO-Kanal verkraften kann (Größe von Hin­
+                           tergrund und Archiven). Bei Archivlaufwerken, die mehrere
+                           Formate bearbeiten können, dient dieser Aufruf auch zum
+                           Einstellen des Formats für die folgenden blockin/blockout-
+                           Operationen anhand des Schlüssels. 
+ 
+          Schlüssel:       0     Wenn möglich 'erkennend', sonst 'standard'. Im ersten
+                                 Fall erkennt SHard das Format der eingelegten Disket­
+                                 te und stellt dieses ein. 
+ 
+                           Die weiteren Schlüssel sind stets definierend. Dabei gibt es
+                           die EUMEL-Standardformate: 
+ 
+                                 1     5" 2D-40, Sektor 1..9, 512 Bytes 
+                                 2     5" 2D-80, Sektor 1..9, 512 Bytes 
+                                 3     5" HD-80, Sektor 1..15, 512 Bytes 
+                                 10    8" 1D-77, Sektor 0..15, 512 Bytes 
+                                 11    8" 2D-77, Sektor 0..15, 512 Bytes 
+ 
+                           Zusätzlich kann man sämtliche Spezialformate angeben: 
+ 
+                             8192 * laufwerkstyp     1:  8" 
+                                                     2:  5" 
+                                                     3:  3" 
+ 
+                           + 4096 * seiten           0:  einseitig 
+                                                     1:  doppelseitig 
+ 
+                           + 1024 * dichte           0:  single 
+                                                     1:  double 
+                                                     2:  high 
+ 
+                           +  256 * spuren           0:  35 
+                                                     1:  40 
+                                                     2:  77 
+                                                     3:  80 
+ 
+                           +   64 * sektorbytes      0:  128 
+                                                     1:  256 
+                                                     2:  512 
+ 
+                           +   32 * erster sektor    0:  \#0 
+                                                     1:  \#1 
+ 
+                           +        sektoren pro spur   0 ... 31 
+ 
+                           So bezeichnet '8762' das Format 8" 1S-77 Sektor 1..26 a
+                           128 Bytes. 
+ 
+          Anmerkung:       SHard sollte alle physisch möglichen EUMEL-Standard­
+                           formate unterstützen. Von den Spezialformaten sollten die für
+                           den Datenaustausch wichtigen Formate berücksichtigt werden.
+                           Die EUMEL-Standardformate (1,2,3,10,11) sollten auch über
+                           die entsprechenden analytischen Codes erreicht werden. (Z.B.
+                           bezeichnen 1 und 21929 dasselbe Format.) Die Numerierung
+                           der Blöcke ist in jedem Fall seitenorientiert, d.h. entsprechend
+                           den Standardformaten (siehe S.#topage("arch")#). 
+ 
+          Hinweis:         Bei Archiven wird 'size' aufgerufen, nachdem der Archivträ­
+                           ger eingelegt wurde. D.h. SHard hat die Gelegenheit, die
+                           Größe anhand des eingelegten Archivträgers zu bestimmen
+                           (z.B. ob single- oder doublesided). 
+ 
+          Vorschlag:       Diese Funktion sollte auf nicht vorhandenen und den
+                           Stream-IO-Kanälen 0 liefern. Sie muß aber mindestens auf
+                           Kanal 0 (Hintergrund) und Kanal 31 (Archiv) "echte" Werte
+                           liefern. 
+ 
+          Achtung:         #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die
+                           0-Routine 'warte' aufgerufen werden.#off("i")# 
+ 
+ 
+     #d("IOCONTROL ""format""")#
+ 
+          Eingang:         A     Kanalnummer (0...31) 
+                           BC    7 
+          Ausgang:         BC    Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) 
+ 
+          Zweck:           Dient zum Formatieren eines Mediums. Diese Funktion kann
+                           für jeden Kanal leer implementiert sein ('ret'). Sie sollte aber
+                           "formatierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem
+                           Kanal die "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls
+                           (bei Diskettenlaufwerken) mehrere Formate möglich sind,
+                           bestimmt der Schlüssel das gewünschte Format. 
+ 
+          Schlüssel:       wie bei IOCONTROL "size" 
+ 
+          Hinweis:         Falls für das Formatieren ein großer Speicherbereich benö­
+                           tigt wird, sollte das Formatieren von Disketten besser in
+                           einem Boot-Dialog vor dem Start von EUMEL-0 angebo­
+                           ten werden. Denn sonst müßte der Pagingbereich unnötig
+                           eingeschränkt werden. 
+                           Man kann das Formatieren einer Spur CPU-intensiv im­
+                           plementieren (d.h. ohne DMA im DI-Modus), wenn man in
+                           Kauf nimmt, daß alle anderen Tasks des EUMEL-Systems in
+                           dieser Zeit "stehen". Dann sollte man aber nach jeder Spur
+                           mehrmals die 0-Routine 'warte' aufrufen. 
+ 
+          Achtung:         #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die
+                           0-Routine 'warte' aufgerufen werden.#off("i")# 
+ 
+ 
+ 
+#b("Konfigurierung serieller Schnittstellen")# 
+#goalpage("v24")# 
+ 
+Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib#V.24#ie#) zurückgeführt werden, sind
+in der Regel die Größen 
+ 
+          -  #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) 
+          -  #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) 
+          -  #ib#Parität#ie# (keine, gerade, ungerade) 
+ 
+einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­
+gung stellen. Diese werden in zwei Modi benutzt: 
+ 
+     a)  #on("b")#einstellend#off("b")# 
+         Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (A = 32),
+         wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte
+         eingestellt, sofern das möglich ist. 
+ 
+     b)  #on("b")#abfragend#off("b")# 
+         Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (A <> 32), wird lediglich
+         abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt werden
+         könnte. 
+ 
+Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der
+Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das
+nutzt z.B. das Standard-Konfigurationsprogramm aus. 
+ 
+Hinweis:   Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­
+           schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur
+           hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen
+           Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig
+           wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht
+           danach gefragt.) 
+ 
+ 
+     #d("IOCONTROL ""baud""")#
+ 
+          Eingang:         A     eigener Kanal (1...15 / 32) 
+                           BC    8 
+                           DE    adressierter Kanal 
+                           HL    Schlüssel 
+          Ausgang:         BC    Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+          Zweck:           Wird diese Routine auf dem Steuerkanal (A=32) aufgerufen,
+                           wird die angegebene Baudrate für den durch Register DE
+                           adressierten Kanal eingestellt, falls das möglich ist. 
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
+                           rufen, informiert sie den Aufrufer lediglich, ob eine derartige
+                           Einstellung des adressierten Kanals möglich wäre. 
+ 
+          Schlüssel:             1       50 Baud 
+                                 2       75 Baud 
+                                 3      110 Baud 
+                                 4      134.5 Baud 
+                                 5      150 Baud 
+                                 6      300 Baud 
+                                 7      600 Baud 
+                                 8     1200 Baud 
+                                 9     1800 Baud 
+                                10     2400 Baud 
+                                11     3600 Baud 
+                                12     4800 Baud 
+                                13     7200 Baud 
+                                14     9600 Baud 
+                                15    19200 Baud 
+                                16    38400 Baud 
+ 
+          Anmerkung:       In der Regel werden nicht alle Baudraten vom SHard un­
+                           terstützt werden. Bei V.24 Schnittstellen sollten aber min­
+                           destens 2400, 4800 und 9600 Baud zur Verfügung stehen,
+                           besser auch 300, 600, 1200 und 19200 Baud. 
+ 
+          Hinweis:         Falls SHard-spezifisch weitere Baudraten implementiert
+                           werden sollen, darf SHard hierfür negative Schlüsselwerte
+                           (Register HL) vergeben. 
+ 
+ 
+     #d("IOCONTROL ""bits""")#
+ 
+          Eingang:         A     eigener Kanal (1...15 / 32) 
+                           BC    9 
+                           DE    adressierter Kanal 
+                           HL    Schlüssel 
+          Ausgang:         BC    Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+          Zweck:           Wird diese Routine auf dem Steuerkanal (A=32) aufgerufen,
+                           wird die angegebene Zeichenlänge (Bits pro Zeichen) und
+                           Parität für den durch Register DE adressierten Kanal einge­
+                           stellt, falls das möglich ist. 
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
+                           rufen, informiert sie den Aufrufer lediglich, ob eine derartige
+                           Einstellung des adressierten Kanals möglich wäre. 
+ 
+ 
+          Schlüssel:       stop * 32 + par * 8 + (bit - 1) 
+ 
+                           stop:     0    1 Stopbit 
+                                     1    1.5 Stopbits 
+                                     2    2 Stopbits 
+ 
+                           par:      0    keine Parität 
+                                     1    ungerade Parität 
+                                     2    gerade Parität 
+ 
+                           bit:      1...8 Bits pro Zeichen 
+ 
+ 
+          Anmerkung:       In der Regel werden nicht alle Kombinationen vom SHard
+                           unterstützt werden. Bei V.24 Schnittstellen sollten aber
+                           möglichst 1 Stopbit, 7 und 8 Bits pro Zeichen und alle drei
+                           Paritätseinstellungen zur Verfügung stehen. 
+ 
+          Hinweis:         Falls SHard-spezifisch weitere Einstellungen implementiert
+                           werden sollen, darf SHard hierfür negative Schlüsselwerte
+                           (Register HL) vergeben. 
+ 
+ 
+ 
+ 
+#b("Flußkontrolle")# 
+#goalpage("fluss")# 
+ 
+Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie
+Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die
+die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei ist
+auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere emp­
+fangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung. Hier
+ist in der Regel sogar zweiseitige Flußkontrolle notwendig. 
+ 
+Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­
+stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das letztere kann auch bei Parallel­
+schnittstellen eingesetzt werden. 
+ 
+Zur eingabeseitigen Flußkontrollsteuerung kann SHard die Rückmeldung der 0-Routine
+'inputinterrupt' (siehe S.#topage("inp")#) und die IOCONTROL-Funktion "weiter" (siehe S.#topage("weiter")#) verwen­
+den: 
+ 
+Unterschreitet die Rückmeldung einen von SHard zu bestimmenden Schwellwert, muß SHard
+auf der V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XOFF senden.
+Dadurch wird bei den meisten Fremdrechnern ein weiteres Senden unterbrochen, sofern (im
+ersten Fall) das Signal 'REQUEST TO SEND' dort mit dem V.24-Eingang 'CLEAR TO
+SEND' verbunden ist. Wird von EUMEL-0 "weiter" aufgerufen, so kann auf dem enspre­
+chenden Kanal wieder empfangen werden (RTS setzen bzw. XON senden). 
+ 
+Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO
+SEND' bzw. der Empfang von XOFF/XON berücksichtigt werden. Wenn an der Schnittstelle
+das 'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser
+Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der Empfang
+von XOFF die Ausagbe anhalten und XON sie wieder starten. 
+ 
+Bemerkung:   Die meisten Systeme enthalten die CTS-Funktion schon in ihrer Hardware,
+             so daß im SHard dafür keine Vorkehrungen getroffen werden müssen. 
+ 
+ 
+Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL-Funk­
+tion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#einstellend#off("i")#
+und auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. 
+ 
+ 
+     #d("IOCONTROL ""flow""")#
+ 
+          Eingang:         A     eigener Kanal (1...15 / 32) 
+                           BC    6 
+                           DE    adressierter Kanal 
+                           HL    Modus 
+          Ausgang:         BC    Rückmeldung (0 = ok, 1 = nicht möglich) 
+ 
+          Zweck:           Wird diese Routine auf dem Steuerkanal (A=32) aufgeru­
+                           fen, muß sie den gewünschten Flußkontrollmodus für den
+                           adressierten Kanal einstellen. 
+                           Dabei sind folgende Modi festgelegt: 
+ 
+                                 HL= 0     Keine Flußkontrolle 
+                                 HL= 1     XON/XOFF    (in beide Richtungen) 
+                                 HL= 2     RTS/CTS     (in beide Richtungen) 
+                                 HL= 5     XON/XOFF    (nur ausgabeseitig) 
+                                 HL= 6     RTS/CTS     (nur ausgabeseitig) 
+                                 HL= 9     XON/XOFF    (nur eingabesetig) 
+                                 HL=10     RTS/CTS     (nur eingabeseitig) 
+ 
+                           Wenn keine Flußkontrolle gewünscht wird (HL=0), muß SHard
+                           "weiter" ignorieren; bei HL=1 oder HL=9 muß bei "stop"
+                           XOFF und bei "weiter", sofern zuletzt XOFF geschickt wurde,
+                           XON geschickt werden; bei HL=2 oder HL=10 muß bei
+                           "stop" das Signal RTS auf low und bei "weiter" wieder auf
+                           high gesetzt werden. Mit "stop" ist hierbei das Unterschreiten
+                           des Schwellwertes bei der Rückmeldung von "inputinterrupt"
+                           gemeint. 
+                           Bei HL=1 oder HL=5 müssen empfangene XON/XOFF-Zei­
+                           chen, bei HL=2 oder HL=6 das Signal CTS beachtet wer­
+                           den. 
+ 
+                           Wird diese Routine auf einem anderen Kanal als 32 aufge­
+                           rufen, informiert sie den Aufrufer lediglich, ob der geforderte
+                           Flußkontrollmodus auf dem adressierten Kanal einstellbar
+                           wäre. 
+ 
+          Hinweis:         Falls SHard-spezifisch weitere Flußkontrollmodi implemen­
+                           tiert werden sollen, darf SHard hierfür negative Moduswerte
+                           (Register HL) vergeben. 
+ 
+                           "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es ist daher
+                           nicht sinnvoll, jedesmal XON zu senden, da dies die Gegen­
+                           stelle damit überfluten würde. SHard muß sich merken, ob der
+                           Kanal im XOFF-Zustand ist und nur dann bei "weiter" ein
+                           XON senden. 
+ 
+#b("Kalender")# 
+#goalpage("kalender")# 
+ 
+Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL holt
+sich Datum und Uhrzeit dann von SHard. 
+ 
+     #d("IOCONTROL ""calendar""")#
+ 
+          Eingang:         CX    10 
+                           DX    (1=Minute, 2=Stunde, 3=Tag, 4=Monat, 5=Jahr)
+                                 gewünscht 
+          Ausgang:         CX    Rückmeldung 
+ 
+          Zweck:           Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden
+                           ist, muß bei jedem Aufruf -1 zurückgemeldet werden, bei
+                           eingebauter Uhr jeweils das Gewünschte (Minute: 0..59,
+                           Stunde: 0..23, Tag: 1..7, Monat: 1..12, Jahr: 0..99). Die Rück­
+                           meldung muß als BCD-Zahl erfolgen. 
+ 
+          Hinweis:         Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus
+                           resultierende Probleme werden auf höheren Ebenen abgehan­
+                           delt. 
+ 
+ 
+ 
+ 
+#bb("6.  SHard-","Interface Version")# 
+#goalpage("shdver")# 
+ 
+Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als 1-Byte-
+Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene Interface muß sie
+den Wert 8 haben. 
+ 
+So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard-
+Moduln geändert werden müssen. 
+ 
+ 
+ 
+#bb("7.  ","ID-Konstanten")# 
+#goalpage("ID")# 
+ 
+SHard muß direkt hinter SHDVER vier 2-Byte-Konstanten ablegen. Diese können von den
+höheren Ebenen durch die ELAN-Prozedur 
+ 
+          INT PROC #ib#id#ie# (INT CONST no) 
+ 
+abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in der
+Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: 
+ 
+          ID4              #ib#Lizenznummer#ie# des SHards *) 
+#foot# 
+#f#*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen!#a# 
+#end# 
+ 
+          ID5              #ib#Installationsnummer#ie# des EUMEL-Anwenders **) 
+#foot# 
+#f#**) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender.#a# 
+#end# 
+ 
+          ID6              zur freien Verfügung 
+ 
+          ID7              zur freien Verfügung 
+ 
+ 
+ 
+ 
+#bb("8.  ","Zusätzliche Leistungen")# 
+#goalpage("shdelan")# 
+ 
+Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardopera­
+tionen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und
+IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von
+EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzliche
+Leistungen nur negative Werte als 'Funktionscode 1' verwenden. 
+ 
+ 
+Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib#blockout#ie#', '#ib#blockin#ie#'#off("i")#
+und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. 
+ 
+Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Multi-
+User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32 abge­
+wickelt werden und dürfen nur dort wirken. 
+ 
+ 
+     PROC blockout (ROW 256 INT CONST para,      (* --> HL *) 
+                    INT CONST funktion1,         (* --> BC *) 
+                              funktion2,         (* --> DE *) 
+                    INT VAR antwort)             (* <-- BC *) 
+ 
+     PROC blockin (ROW 256 INT VAR para,         (* --> HL *) 
+                   INT CONST funktion1,          (* --> BC *) 
+                             funktion2,          (* --> DE *) 
+                   INT VAR antwort)              (* <-- BC *) 
+ 
+     PROC control (INT CONST funktion1,          (* --> BC *) 
+                             funktion2,          (* --> DE *) 
+                             funktion3,          (* --> HL *) 
+                   INT VAR   antwort)            (* <-- BC *) 
+ 
+Hinweis: Der SHard darf für 'funktion 1' (BC) zusätzlich zu den hier beschriebenen Stan­
+         dardcodes nur negative Codes vereinbaren. 
+ 
+ 
+Beispiel: 
+ 
+     Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl 
+ 
+                           control (-7,1200,13,antwort), 
+ 
+     so wird IOCONTROL mit (A='x', BC=-7, HL=13, DE=1200) aufgerufen. Verläßt
+     SHard 'control' mit BC = 1, so enthält 'antwort' anschließend eine 1. 
+ 
+ 
+Hinweis:  Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur
+          Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses
+          ebenfalls an die Anwender ausliefern. 
+ 
+          Beispiel:        PACKET zusatz DEFINES fanfare, ... : 
+ 
+                           PROC fanfare (INT CONST tonhoehe, dauer) : 
+ 
+                             IF dauer < 0 
+                               THEN errorstop ("negative dauer") 
+                             ELIF tonhoehe < 16 
+                               THEN errorstop ("infraschall") 
+                             ELIF tonhoehe > 20000 
+                                THEN errorstop ("ultraschall") 
+                             ELSE control (-37, 20000 DIV tonhoehe, dauer) 
+                             FI 
+ 
+                           ENDPROC fanfare ; 
+ 
+                                 . . . 
+ 
+ 
+ 
+ 
+#bb("9.  ","Spezialroutinen")# 
+#goalpage("ke")# 
+ 
+Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse einbau­
+en. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird im
+Anhang A (siehe S.#topage("info")#) beschreiben. 
+ 
+     #dx("info")#                  (0-Routine) 
+ 
+          Aufruf:            call info 
+                             jr   weiter 
+                             defm ' text' 
+                           weiter: 
+ 
+          Zweck:           Info wird aufgerufen. Dabei wird 'text' zur Identifikation des
+                           Kontrollereignisses ausgegeben. #on("i")#Der übergebene Text muß
+                           mit einem Blank beginnen!#off("i")# 
+ 
+          Hinweis:         Bei Systemen "ohne Info" (nur solche dürfen an Anwender
+                           ausgeliefert werden) wird nur der Info-Text ausgegeben und
+                           EUMEL-0 angehalten. 
+ 
+          Achtung:         Da der Info selbst die hier beschriebenen Stream-IO-Rou­
+                           tinen benutzt, darf man ihn von diesen Routinen aus (input­
+                           interrupt, OUTPUT, IOCONTROL "frout", IOCONTROL
+                           "weiter") nicht aufrufen. Wenn die Ein-/Ausgabe auf Termi­
+                           nal 1 interruptgetrieben läuft, dürfen die Interrupts beim
+                           Info-Aufruf natürlich nicht gesperrt sein. 
+ 
+ 
+Falls SHard für bestimmte Aktionen, die selten durchgeführt werden (z.B. Formatieren), viel
+Speicher benötigt, kann er diesen dynamisch anfordern und später wieder freigeben. 
+ 
+     #dx("grab")#                  (0-Routine) 
+ 
+          Eingang:         HL    Anfangsadresse des zu reservierenden Bereichs im
+                                 Datensegment von EUMEL-0, muß auf 512 Byte
+                                 ausgerichtet sein. 
+                           BC    Länge des zu reservierenden Bereichs in 512-Byte-
+                                 Kacheln 
+          Ausgang:         BC    Rückmeldecode 
+ 
+          Zweck:           Wenn möglich wird der zu verlangte Bereich von EUMEL-0
+                           "leergekämpft" und SHard zur Verfügung gestellt. 
+                           Rückmeldecode:  0  ok, Speicher steht zur Verfügung 
+                                           1  augenblicklich nicht möglich 
+                                           3  grundsätzlich nicht möglich 
+ 
+          Achtung:         Der Aufruf von 'grab' wird in der Regel 'warte' und Block-IO
+                           auf Kanal 0 induzieren. 
+ 
+          Hinweis:         Es wird empfohlen, Speicher ab A000h anzufordern, da diese
+                           Adresse stets im frei einplanbaren Paging-Bereich liegt. 
+ 
+ 
+     #dx("free")#                  (0-Routine) 
+ 
+          Eingang:         HL    Anfangsadresse des freizugebenden Bereichs im
+                                 Datensegment von EUMEL-0, muß auf 512 Byte
+                                 ausgerichtet sein. 
+                           BC    Länge des zu freizugebenden Bereichs in 512-Byte-
+                                 Kacheln 
+ 
+          Zweck:           Der entsprechende Bereich muß vorher mit 'grab' beschafft
+                           worden sein. Hiermit wird er wieder EUMEL-0 zur freien
+                           Verfügung gestellt. 
+ 
+ 
+Für spezielle Fehlersituationen steht die 0-Routine 'shutup' zur Verfügung. Damit kann
+SHard z.B. bei Netzausfall ein kontrolliertes Systemende erzwingen. Das ist allerdings nur
+sinnvoll, wenn durch Batteriepufferung oder Ähnliches sichergestellt ist, daß noch genügend
+Zeit bleibt, um alle Seiten auf den Hintergrund zurückzuschreiben. 
+ 
+     #dx("shutup")#                (0-Routine) 
+ 
+          Zweck:           Erzwingt Rückschreiben aller Seiten und Systemende, d.h.
+                           entspricht der ELAN-Prozedur 'shutup'. 
+ 
+          Achtung:         Der Aufruf von 'shutup' wird in der Regel 'warte' und Block-
+                           IO auf Kanal 0 induzieren. 
+#page# 
+#cc("Teil 4: ","Tips zur Portierung")# 
+#goalpage("tips")# 
+ 
+ 
+#b("0-Version des SHards")# 
+#goalpage("0ver")# 
+ 
+ 
+Es wird empfohlen, zuerst eine "0-Version" des SHard zu entwickeln, die möglichst einfach
+aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel ausge­
+richtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann den
+Entwurf und die Implementation des eigentlichen SHard erleichtert. Die 0-Version sollte 
+ 
+     -  keinen Schattenspeicher kennen (SCHINF meldet 0), 
+ 
+     -  nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, 
+ 
+     -  keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen unter­
+        stützen (immer 'nicht möglich' melden), 
+ 
+     -  vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie
+        "busy wait" beim Floppy- bzw. Plattenzugriff zu grämen. 
+ 
+Mit dieser 0-Version sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund
+beim ersten Mal noch leer ist, muß man das HG-Archiv (Archivfloppy mit EUMEL-0 und
+höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der Vortest sollte sich
+direkt nach dem Start folgendermaßen auf Terminal 1 melden: 
+ 
+                E U M E L - Vortest 
+ 
+          Terminals:  1, 
+          RAM-Groesse (gesamt):     64 kB 
+          Pufferbereich:             ? kB 
+          Hintergrund-Speicher:      ? kB 
+ 
+          Speichertest: ************ 
+ 
+Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. Das
+EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andernfalls
+funktioniert die Eingabe nicht richtig!) 
+ 
+Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese Mög­
+lichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der
+EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­
+werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund geladen
+werden. 
+ 
+Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine Ver­
+wendung ist aber, daß die Terminal Ein-/Ausgabe schon funktioniert. 
+ 
+Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den
+Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete
+Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug auf
+die Steuercodes) gleicht, kann man z.B. 
+ 
+     -  den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen
+        (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, 
+ 
+     -  die notwendigen Umcodierungen per SHard durchführen. 
+ 
+Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil
+Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird
+man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­
+derlich sind. 
+ 
+Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzichten. 
+ 
+ 
+Im Gegensatz zu der 0-Version sollte man bei der eigentlichen SHard-Implementierung
+darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf entspricht
+dann wieder im wesentlichen dem oben beschriebenen Vorgang. 
+ 
+ 
+ 
+#b("Typische Fehler")# 
+#goalpage("fehler")# 
+ 
+ 
+     a)   SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht
+          vollständig. Hierbei sollte man auch an den zweiten Registersatz des Z80-Pro­
+          zessors und an die Register IX und IY denken. 
+ 
+     b)   'call' bzw. 'ret' verändern den Stackpointer. 
+ 
+     c)   Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Interrupts"). 
+ 
+     d)   Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal
+          (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu
+          wildem Schreiben in den Hauptspeicher. 
+ 
+     e)   'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT,
+          IOCONTROL "size" und IOCONTROL "format" aus aufgerufen werden. Ferner
+          kann man 'warte' noch nicht beim Systemladen aufrufen!) 
+ 
+     f)   OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation
+          zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der
+          Interruptroutine, die den Puffer leert und ausgibt. 
+ 
+     g)   IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zei­
+          chen im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output- 
+          Blockaden führen. 
+ 
+     h)   Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x
+          Zeichen an. 
+ 
+     i)   IOCONTROL "size" meldet falsche Werte. 
+ 
+     j)   IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. 
+ 
+     k)   BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor alle
+          Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon aus,
+          daß der Puffer frei ist und anderweitig benutzt werden kann!) 
+ 
+     l)   Einem SIO-Baustein wird nach Ausgabe des letzten Zeichens oder nach Ände­
+          rung des externen Status nicht mitgeteilt, daß keine Interrupts mehr erzeugt
+          werden sollen. (SIOs wiederholen Interrupts so lange, bis man es ihnen explizit
+          verbietet!) 
+ 
+     m)   Die Stepping-Rate eines Festplattencontrollers wird falsch eingestellt, bezie­
+          hungsweise die Platte wird nicht im 'buffered step mode' betrieben, obwohl sie
+          beschleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem
+          Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht
+          übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält.
+          Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile des
+          Hintergrundes benutzt werden. 
+ 
+     n)   Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf
+          einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann
+          das zweite Zeichen das erste. 
+ 
+     o)   Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen Einga­
+          bezeichen verloren oder werden verfälscht. In der Regel ist das auf Timingpro­
+          bleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen verloren bzw.
+          die Zeichen werden nicht schnell genug abgeholt. 
+ 
+ 
+#b("Effizienzprobleme")# 
+#goalpage("eff")# 
+ 
+     a)   Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf
+          Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User-Sy­
+          stemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann läuft
+          der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) 
+ 
+          Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch un­
+          glückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf
+          Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen
+          abgelehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf
+          natürlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. 
+ 
+ 
+     b)   Wenn #on("i")##on("b")#Floppies ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single-
+          User-Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek-
+          Vorgang auf den Block zu warten. Im Multi-User sollte das aber wenn irgend
+          möglich umgangen werden, da eine halbe Umdrehung immerhin ca. 100 ms
+          kostet. 
+          Falls nur ein Endeinterrupt nach jeder Floppyoperation zur Verfügung steht, kann
+          folgendes Verfahren günstig sein: 
+ 
+               seek befehl an controller ; 
+               warten auf endeinterrupt ; 
+               lesebefehl ohne datentransport auf sektor davor ; 
+               warten auf endeinterrupt ; 
+               lese oder schreib befehl auf adressierten sektor ; 
+               cpu intensives warten und datentransport . 
+ 
+          Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu,
+          ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen Sektor
+          möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf ca. 25
+          ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach, da die
+          0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht verwendet
+          werden kann. Alle 'warte auf ...' müssen also durch Interrupts realisiert werden: 
+ 
+               setze interrupt auf lesen davor ; 
+               stosse seek an ; 
+               REP 
+                 warte 
+               UNTIL komplette operation beendet ENDREP . 
+ 
+                           lesen davor : 
+                                 setze interrupt auf eigentliche operation ; 
+                                 stosse lesen davor an . 
+ 
+                           eigentliche operation : 
+                                 ignoriere fehler beim datentransport ; 
+                                 stosse lesen oder schreiben an ; 
+                                 REP 
+                                   REP UNTIL bereit ENDREP ; 
+                                   uebertrage ein byte 
+                                 UNTIL alles uebertragen ENDREP ; 
+                                 melde komplette operation beendet . 
+ 
+ 
+     c)   Bei der Ansteuerung von #on("i")##on("b")#Harddisks#off("b")##off("i")# sollte man darauf achten, daß die 0-Rou­
+          tine 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging zu­
+          gunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man bei
+          vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: 
+ 
+               beginne seek ;             beginne seek und lesen ; 
+               REP                        REP 
+                 warte                      warte 
+               UNTIL fertig PER ;         UNTIL fertig PER 
+               beginne lesen ; 
+               REP 
+                 warte 
+               UNTIL fertig PER 
+ 
+          Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die rechte.
+          Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das Einle­
+          sen eines Blocks benötigen. 
+ 
+          Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren
+          unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn
+          möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen
+          werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv gewar­
+          tet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung zu
+          experimentieren. 
+ 
+#page# 
+#cc("Anhang A: EUMEL-","Debugger ""Info""")# 
+#goalpage("info")# 
+ 
+ 
+Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unterschei­
+den sich nur im EUMEL-0-Teil (Urlader). Der SHard-Implementierer erhält zum Test
+Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige Systeme dürfen
+nur von den SHard-Implementierern verwendet werden. 
+ 
+     #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert wer­
+              den, da vermittels Info alle Systemsicherungs- und Datenschutzmaßnah­
+              men unterlaufen werden können.#off("i")##off("b")# *) 
+#foot# 
+#f#*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ
+Bielefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert werden.#a# 
+#end# 
+ 
+ 
+#b("Aufruf des Info")# 
+#goalpage("aufrinf")# 
+ 
+Zum Aufruf des Infos gibt es drei Möglichkeiten: 
+ 
+     a)  Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­
+         chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe von
+         'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem Start­
+         menü nicht aufgeführt.)#off("i")# 
+ 
+     b)  Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das System
+         gestartet wurde und sich eine Task am Terminal mit "gib kommando" gemeldet
+         hat, kann man durch 'ke *return*' in den Info-Modus gelangen. 
+ 
+     c)  Wenn sich am Terminal keine Task befindet, die auf Eingabe wartet, gelangt man
+         durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe
+         "Systemhandbuch, Konfigurierung") in den Info-Modus. 
+ 
+Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. 
+ 
+Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des EUMEL-
+Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen. Bei Systemen
+"ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das System angehalten. 
+ 
+Bevor das System Infokommandos annimmt, muß mit dem Kommando 'P' ein Paßwort einge­
+geben werden. Lediglich dieses Kommando und das Kommando 'g' werden immer angenom­
+men. Das Paßwort kann mit dem Kommando 'yP' oder mit der ELAN-Prozedur "info
+password" eingestellt werden. 
+ 
+#b("Info-Format")# 
+#goalpage("forminf")# 
+ 
+Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­
+mandos werden die drei obersten Zeilen wie folgt aufgebaut: *) 
+#foot# 
+#f#*) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h.
+insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchgeführt.#a# 
+ 
+#end# 
+ 
+#limit(14.0)# 
+XY TEXT 
+F   A   C   B   E   D   L   H   F   A   C   B   E   D   L   H   IX      SP      IY      PC 
+xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx  xx 
+#limit(12.0)# 
+ 
+wobei 
+ 
+     X den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat (A=Archiv,
+     E=Elan, L=Lader, M=Müllabfuhr), 
+ 
+     Y den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor bear­
+     beitet wird (Y ist code (tasknummer + code ("0"))), 
+ 
+     TEXT den Grund für den Info-Modus anzeigt, 
+ 
+Die zweite und dritte Zeile zeigen die Inhalte der Z80-Register an (beide Registersätze). 
+In der untersten Zeile erscheint die Eingabeaufforderung 'info:'. 
+ 
+ 
+#b("Info-Kommandos")# 
+#goalpage("cmdinf")# 
+ 
+Info-Kommandos können in der 'info:'-Zeile mit dem Format 
+ 
+          [<zahl>]<buchstabe> 
+ 
+gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format 
+ 
+          <buchstabe> 
+ 
+wobei dann für <zahl> die der Cursorposition entsprechende Dumpadresse (modulo 2**16)
+gesetzt wird (siehe '*cup*'). 
+ 
+<zahl> ist immer in Hexaform einzugeben. 
+ 
+'g'    Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge­
+       sperrt. 
+ 
+'z'    Der Leitblock des angezeigten Maxiprozesses wird dargestellt, falls <zahl> = 0 ist,
+       sonst der Leitblock der Task mit der Nummer <zahl>. (Nur im ELAN-Miniprozeß). 
+ 
+'q'    Die Task mit der Nummer <zahl> wird nach dem nächsten 'g'-Kommando in den
+       Info überführt. Dies ist nötig, wenn man sich die Datenräume dieser Task anschauen
+       will ('s'). 
+ 
+'s'    Dumps werden auf den Datenraum <zahl> eingestellt. Ist <zahl>=FF, so wird der
+       Realspeicher eingestellt. (s:=<zahl>) 
+ 
+'l'    Dumps werden auf die Länge <zahl> eingestellt. Desungeachtet kann man einen
+       versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird
+       allerdings '*cup*' gesperrt (siehe unten). 
+ 
+'p'    Dumps werden auf die Byteadresse <zahl> eingestellt (p:=<zahl>; wmodus:=
+       FALSE). 
+ 
+'w'    Dumps werden auf die Wortadresse <zahl> eingestellt. Die vor jeder Dumpzeile
+       ausgegebene Adresse ist dann auch eine Wortadresse. Ein Wort = 2 Bytes. (p:=2*
+       <zahl>; wmodus:=TRUE) 
+ 
+'k'    Block <zahl> laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf
+       den Realdatenraum (s=FF). 
+ 
+'P'    Paßworteingabe: P<text>*return* 
+       Erst nach diesem Kommando sind die übrigen Kommandos ausführbar. 
+ 
+'x'    Suchen nach Bytekette: 
+ 
+-->    xc text 
+-->    xh xx xx ... 
+-->    x 
+ 
+       Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte
+       'x'-Kommando eingestellten Bytekette gesucht. 
+       Das Kommando ist durch *return* abzuschließen. 
+       Die Suche beginnt ab Position 'p' und ist auf die Länge <zahl> Seiten (512 Byte-
+       Einheiten) begrenzt (0=unendlich). 
+       Eine beliebige Eingabe bricht die Suche vorzeitig ab. 
+ 
+'*return*' 
+       Es wird der eingestellte Dump ausgegeben (siehe 's','l','p','w'). Bei wmodus (siehe
+       'p', 'w') werden Wortadressen ausgegeben. 
+ 
+'o'    Wie '*return*', jedoch wird zuvor p := p+l  gesetzt (zum Weiterblättern). 
+ 
+'r'    Freigabe der anderen Miniprozesse. 
+ 
+       Zunächst werden bei Übergang in den Info alle Miniprozesse gesperrt, um eine
+       Verfälschung der Fehlersituation zu vermeiden. Bei manchen Kommandos an den Info
+       müssen aber andere Miniprozesse u.U. aktiv werden (z.B. beim 'k' der Lader). Wenn
+       dies erforderlich ist, meldet der Info: 
+       'paging erforderlich'. Man kann dann 'r' geben und das letzte Infokommando wieder­
+       holen, oder mit anderen Kommandos fortfahren, falls man den Fehlerzustand noch so
+       beibehalten will. 
+ 
+'y'    Zweitfunktion ausführen. 
+ 
+-->    'yP<text>*return*' 
+              Neues Paßwort einstellen (max. 9 Zeichen). Dieses bleibt auch nach 'shutup'
+              gültig. 
+ 
+-->    'yt'   Block <zahl> von Archiv lesen. Dient zum Test des Archivs. 
+              Es wird eine Kachel freigemacht und der Block mit der Nummer <zahl>
+              eingelesen. Der Inhalt wird sofort angezeigt (wie Kommando 'k'). 
+ 
+-->    'yb'   Breakpoint an die Adresse <zahl> setzen. Es wird ein Aufruf an den Info
+              abgesetzt. Nur im Realspeicher sinnvoll. Dieser Aufruf meldet sich mit
+              TEXT= 'test'. Wird er mit 'g' verlassen, so stellt Info zuvor die alten
+              Z80-Befehle wieder her und führt sie an ihrem originalen Ort aus. 
+ 
+-->    'yc'   wie 'yb', jedoch werden die originalen Z80-Befehle an einem anderen Ort
+              (im Info) ausgeführt. Sie dürfen daher z.B. keinen Relativsprung enthalten
+              und keine 'push'/'pop'-Befehle. Dafür bleibt dieser Breakpoint auch nach
+              dem zugehörigen 'g' im Code erhalten. Dieser Breakpoint meldet sich mit
+              TEXT='test 2'. 'yc' darf nicht gegeben werden, wenn der Info im 'test 2'
+              steht (Umhängen verboten). 
+ 
+              #on("i")#Achtung: Die Verwendung von 'yb' und 'yc' ist sehr kritisch durchzuführen.
+                       Zu beachten ist, daß der in den Code eingesetzte Sprung (Z80 jp)
+                       3 Byte belegt.#off("i")# 
+ 
+ 
+-->    'yl'   Lernmodus ein (wie beim Editor). 
+ 
+-->    'ye'   Ende Lernmodus. 
+ 
+-->    'ya'   Ausführen. Die zwischen 'yl' und 'ye' eingegebenen Zeichen werden dem
+              Info so vorgesetzt, als kämen sie von der Tastatur. 
+ 
+              Achtung: Rekursion ('ya' im Lernmodus) wird nicht abgefangen. Das Gelern­
+                        te wird nach jedem Kommando, das die ersten drei Zeilen
+                        wiederaufbaut (z.B. *return*), in der Zeile vier angezeigt, wobei
+                        für Steuerzeichen eine Ersatzdarstellung erscheint (%x mit
+                        x=code (code (zeichen) +code ("A")), also z.B. %M für
+                        *return*). 
+ 
+--> 'y *return*' 
+              Wie *return*, jedoch wird der Dump auch beim Ausführen (ya) ausgege­
+              ben. (Ein gelerntes *return* führt im Ausführmodus nicht zum Dump). 
+ 
+'*cup*' *)    (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. 
+#foot# 
+#f#*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für Cursor
+Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen durchführt, ist
+dieser Modus nicht sehr gut benutzbar.#a# 
+#end# 
+              Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt
+              werden. Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des
+              Bytes eingetragen, auf dem der Cursor gerade steht. Dies funktioniert auch
+              auf beliebigen Datenräumen. Info beantragt dann bei der Speicherverwal­
+              tung einen Schreibzugriff für die entsprechende Datenraumseite, so daß
+              Änderungen mit der Copy-on-Write-Logik erfolgen, also nur taskspezi­
+              fisch sind (durch 'q' eingestellt). Für diese Task sind die Änderungen al­
+              lerdings dann permanent, da sie auch auf den Hintergrund wirken. 
+ 
+              Hinweis: Dumpt man mit 'k' einen Block und ändert dann darin, so sind
+                       diese Änderungen u.U. nur temporär, da der Info kein Rückschrei­
+                       ben des Blockes veranlaßt. 
+ 
+              Achtung: Jede Eingabe, die kein Positionierzeichen und kein gültiges
+                       Zahlzeichen ist, beendet diesen Modus. Das neue Zeichen wird als
+                       Info-Kommando aufgefaßt, wobei <zahl> auf die aktuelle Adres­
+                       se gesetzt wird. 
+                       (Für 'yc' / 'yb' sinnvoll: Man setzt den Cursor auf die Stelle, an
+                       der ein Break ausgelöst werden soll und gibt 'yc'/'yb'). 
+                       Somit wird dieser Änderungsmodus üblicherweise durch *return*
+                       beendet. 
+ 
+#b("Einige Systemadressen")# 
+#goalpage("sysaddr")# 
+ 
+Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche
+Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für
+Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf imple­
+mentationsabhängige Konstanten ein. Diese sind hier aufgeführt. 
+ 
+Ab 1500h liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des
+Arbeitsspeicher liegen: In der Kachel mit der Adresse 512*i befindet sich der Inhalt des
+Blockes, dessen Nummer in ktab+i, ktab+100h+i steht. Ferner enthält die Tabelle, zu
+welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur rele­
+vant, wenn die Prozeßnummer <> 255 ist). 
+ 
+Steuerbits:   2**0 :  Inhalt wird gerade transportiert (zum HG oder Archiv). 
+              2**1 :  Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die
+                      Kachel (per Software) zurückgesetzt. 
+              2**2 :  Schreiberlaubnis (siehe Brikett). 
+              2**3 :  Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger
+                      stark' verdrängt. 
+ 
+ 
+   ktab       frei           niederwertige Blocknummer 
+ 
+   +80h       frei            frei      Steuerbits 
+ 
+   +100h      frei           höherwertige Blocknummer 
+ 
+   +180h      frei            frei      Prozeßnummer 
+ 
+   +200h      frei            frei      drid (prozeßspezifisch) 
+ 
+   +280h      frei            frei      Seitennummer (höherw.) 
+ 
+   +300h      frei            frei      Seitennummer (niederw.) 
+ 
+                           ^          ^ 
+         <-- unbenutzt --> !          +-- Beginn echter Kacheln 
+                           +-- Beginn der Anforderungen 
+ 
+ 
+Der 'Beginn echter Kacheln' hängt von der Größe der Z80-Teile ('urlader') ab (i.A.
+30h < i < 40h). 
+ 
+'Beginn der Anforderungen' liegt bei i=1Fh. Es handelt sich um Blocknummern von zu
+ladenden Blöcken. Ist der höherwertige Teil der Blocknummer gleich FDh, so ist dies keine
+Anforderung. 
+ 
+Blocknummern > FF00h stehen für Blöcke mit dem Inhalt 512 FFh's und werden nie auf dem
+Hintergrundmedium gespeichert. 
+ 
+ 
+ 
+1E2Bh    enthält den DR-Eintrag des drdr (siehe Brikett). 
+ 
+ 
+'musta': Das System fordert Checkpoints und Müllabfuhren über die Zelle 'musta' an. Diese
+         findet man mit dem Info durch 
+ 
+         xc musta 
+ 
+         (hierfür ist der Text 'musta' vor der Zelle abgesetzt). 
+ 
+         Die Zelle selbst enthält 
+ 
+              FFh   : Keine Müllabfuhr oder Checkpoint 
+              01h   : Müllabfuhr 
+              02h   : Checkpoint 
+              03h   : beides 
+              04h   : Systemendecheckpoint 
+              0Bh   : System auf Archiv schreiben ('save system') 
+              F0h   : Müllabfuhr und Checkpoint sind geperrt (nur durch Setzen im Info
+                      möglich) 
+ 
+         Durch Einsetzen der Werte mit dem Info kann die entsprechende Operation veran­
+         laßt werden. Beim Einsetzen darf der Info nicht im 'r'-Zustand (siehe Eingabe 'r')
+         stehen; zum Ausführen der Operation muß 'r' (man bleibt im Info) oder 'g' (Info
+         verlassen) gegeben werden. 
+ 
+ 
+1880h-18FFh: 
+         enthält die Aktivierungstabelle. Ist (1880h+i)=01h, so ist die Task i aktiv. Hin­
+         weis: 18FFh enthält immer 01h, ohne daß dieser Zelle eine Task zugeordnet ist. 
+ 
+ 
+#b("Leitblock")# 
+#goalpage("pcb")# 
+ 
+Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Es werden Hexapaare,
+gefolgt von einer Bezeichnung, ausgegeben. In der folgenden Beschreibung werden die
+Hexapaare durch a,b,c dargestellt. 
+ 
+     a b c icount          Der virtuelle Befehlszähler der Task steht auf (cMOD4)*
+                           10000h+b*100h+a = <ic> im Datenraum 4 dieser Task.
+                           Durch die Eingabefolge: 
+                                 4s<ic>w*return* 
+                           kann man sich den Code, der ausgeführt werden soll, anse­
+                           hen. 
+ 
+                           Bit 2**7 von c zeigt den Fehlerzustand an. 
+                           Bit 2**6 von c zeigt 'disable stop' (siehe Benutzerhandbuch)
+                                    an. 
+                           Bit 2**4 zeigt vorzeichenlose Arithmetik an (Compilierung). 
+ 
+     a b lbas              Die lokale Basis steht auf 10000h+b*100h+c = <lb> im
+                           Datenraum 4 (Wortadresse). 
+ 
+     a b hptop             Der Arbeitsheap geht von 30000h (Byteadr.) bis (aMOD16)*
+                           10000h+b*100h+(aDIV16)*10h (Byteadr!). 
+ 
+     a b channel           Die Task hängt an Kanal 100h*b+a (Terminalnummer). 0 =
+                           kein Terminal angekoppelt. 
+ 
+     a b taskid            Die Tasknummer der betrachteten Task ist a. (b ist die
+                           Versionsnummer zum Abdichten von 'send'/ 'wait'). 
+ 
+Um den Code, auf den der 'icount' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. 
+ 
+ 
+Hinweis: Wenn der Info einen internen Fehler anzeigt, und auch bei 'ke', ist der durch 'z'
+         angezeigte Leitblock u.U. nicht aktualisiert. Man kann dies durch die Eingaben 'r',
+         'g' erzwingen. (Der Info stellt wegen 'r' dem Interpreter einen Restart zu, der dann
+         beim 'g' den Leitblock aktualisiert und den Befehl erneut aufsetzt). Tritt dabei der
+         Fehler nicht wieder auf, handelte es sich um einen transienten Fehler (z.B. der
+         Codeblock war noch im Einlesen und ist jetzt voll da). So etwas kann z.B. passie­
+         ren, wenn der SHard den Abschluß einer Leseoperation zu früh meldet. 
+
diff --git a/doc/porting-z80/8/source-disk b/doc/porting-z80/8/source-disk
new file mode 100644
index 0000000..ff072f3
--- /dev/null
+++ b/doc/porting-z80/8/source-disk
@@ -0,0 +1 @@
+porting/portdoc-z80-8.img
diff --git a/doc/programming/programmierhandbuch.1 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.1
index 24f2b03..24f2b03 100644
--- a/doc/programming/programmierhandbuch.1
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.1
diff --git a/doc/programming/programmierhandbuch.2a b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a
index a204091..a204091 100644
--- a/doc/programming/programmierhandbuch.2a
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a
diff --git a/doc/programming/programmierhandbuch.2b b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b
index c2103ba..c2103ba 100644
--- a/doc/programming/programmierhandbuch.2b
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b
diff --git a/doc/programming/programmierhandbuch.3 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.3
index eade335..eade335 100644
--- a/doc/programming/programmierhandbuch.3
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.3
diff --git a/doc/programming/programmierhandbuch.4 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.4
index 650d945..650d945 100644
--- a/doc/programming/programmierhandbuch.4
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.4
diff --git a/doc/programming/programmierhandbuch.5 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5
index a921572..a921572 100644
--- a/doc/programming/programmierhandbuch.5
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5
diff --git a/doc/programming/programmierhandbuch.5b b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b
index d91bcc9..d91bcc9 100644
--- a/doc/programming/programmierhandbuch.5b
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b
diff --git a/doc/programming/programmierhandbuch.6 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.6
index ce11f6f..ce11f6f 100644
--- a/doc/programming/programmierhandbuch.6
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.6
diff --git a/doc/programming/programmierhandbuch.index b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.index
index f3f4ede..f3f4ede 100644
--- a/doc/programming/programmierhandbuch.index
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.index
diff --git a/doc/programming/programmierhandbuch.inhalt b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt
index 45b3f1f..45b3f1f 100644
--- a/doc/programming/programmierhandbuch.inhalt
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt
diff --git a/doc/programming/programmierhandbuch.titel b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel
index 79b09b0..79b09b0 100644
--- a/doc/programming/programmierhandbuch.titel
+++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel
diff --git a/doc/programmer-manual/1.8.7/source-disk b/doc/programmer-manual/1.8.7/source-disk
new file mode 100644
index 0000000..13e2021
--- /dev/null
+++ b/doc/programmer-manual/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/10_handbuecher.2.img
diff --git a/doc/system/systemhandbuch.1 b/doc/system-manual/1.8.7/doc/systemhandbuch.1
index a8f53bb..a8f53bb 100644
--- a/doc/system/systemhandbuch.1
+++ b/doc/system-manual/1.8.7/doc/systemhandbuch.1
diff --git a/doc/system/systemhandbuch.2 b/doc/system-manual/1.8.7/doc/systemhandbuch.2
index c4772f0..c4772f0 100644
--- a/doc/system/systemhandbuch.2
+++ b/doc/system-manual/1.8.7/doc/systemhandbuch.2
diff --git a/doc/system/systemhandbuch.3 b/doc/system-manual/1.8.7/doc/systemhandbuch.3
index 3c0a482..3c0a482 100644
--- a/doc/system/systemhandbuch.3
+++ b/doc/system-manual/1.8.7/doc/systemhandbuch.3
diff --git a/doc/system/systemhandbuch.4 b/doc/system-manual/1.8.7/doc/systemhandbuch.4
index e511eb5..e511eb5 100644
--- a/doc/system/systemhandbuch.4
+++ b/doc/system-manual/1.8.7/doc/systemhandbuch.4
diff --git a/doc/system-manual/1.8.7/source-disk b/doc/system-manual/1.8.7/source-disk
new file mode 100644
index 0000000..13e2021
--- /dev/null
+++ b/doc/system-manual/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/10_handbuecher.2.img
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1
new file mode 100644
index 0000000..cdeca13
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1
@@ -0,0 +1,924 @@
+                       EUMEL-Benutzerhandbuch 
+ 
+                         TEIL 1: Einführung                         
+ 
+Vorwort          
+ 
+Lieber EUMEL-Nutzer! 
+ 
+Ihnen liegt hier das EUMEL-Benutzerhandbuch zur Public-Domain-Version 1.7.3 
+vor. Es gliedert sich in mehrere Teile. Der erste Teil des Benutzerhandbuchs 
+soll dem zukünftigen Benutzer den "Einstieg" in das EUMEL-System erleichtern. 
+Dazu werden die wichtigsten Eigenschaften des EUMEL-Systems vorgestellt. 
+Danach zeigen wir eine Beispielsitzung. Anschließend werden einige 
+prinzipielle Konzepte des EUMEL-Systems vermittelt. Den Abschluß bildet ein 
+kleines EUMEL-Wörterbuch. 
+ 
+Die übrigen Teile des EUMEL-Benutzerhandbuchs dokumentieren jeweils ein oder 
+mehrere abgeschlossene Einheiten des Systems. Ein EUMEL-Nutzer braucht so nur 
+die ihn interessierenden Teile zu lesen. Ein Programmierer z.B. sollte 
+ 
+   Einführung, Supervisor/Monitor, Editor, ELAN-Compiler und Dateien 
+ 
+durcharbeiten. Für Programmierer, die noch keine Erfahrung mit ELAN besitzen, 
+ist der Teil "Erste Hilfe" gedacht. Weiterhin werden die Teile über Dateien 
+und Standardpakete oft benötigt. Ein Nutzer, der vorwiegend an der Textbe- 
+und verarbeitung interessiert ist, braucht dagegen nur 
+ 
+   Einführung, Supervisor/Monitor, Dateien, Editor und Textkosmetik. 
+ 
+Der OPERATOR/Spooler-Teil ist nur für diejenigen Programmierer gedacht, die 
+ein EUMEL-System betreuen. Weitere Informationen finden System-Programmierer 
+im System-Handbuch bzw. in der Veröffentlichung des Quellcodes. 
+ 
+ 
+1. Eigenschaften des EUMEL-Betriebssystems 
+ 
+Das EUMEL-Betriebssystem (Extendable multi User Microprocessor ELANsystem) 
+ist ein Betriebssystem, das z.Z. für den Einsatz auf Mikroprozessoren vorge- 
+sehen ist. Es weist u.a. folgende Eigenschaften auf: 
+ 
+- Das EUMEL-System ist ein "Time sharing"-Betriebssystem, d.h. mehrere Be- 
+  nutzer können gleichzeitig an einem Rechensystem arbeiten (z.B. Programme 
+  übersetzen, bearbetten (rechnen) oder erstellen (edieren)). Dabei wird die 
+  verfügbare Rechen- und Speicherkapazität zwischen den Benutzer-Prozessen 
+  dynamisch aufgeteilt. 
+ 
+- Jeder Benutzer richtet (mindestens) eine Task ein, in der er sich Programme 
+  und/oder Dateien halten kann, auf die andere Nutzer nicht zugreifen können. 
+  Tasks können von einem Terminal "abgekoppelt" und trotzdem - sofern aus- 
+  reichend freie Rechnerkapazität zur Verfügung steht - als Batch-Auftrag im 
+  Hintergrund weiter bearbeitet werden. 
+ 
+- Das EUMEL-Betriebssystem ist so konzipiert, daß der Sicherheit des Systems 
+  besondere Beachtung geschenkt wurde. Zu diesem Zweck werden in bestimmten 
+  zeitlichen Abständen sogenannte Restart-Punkte auf dem externen Speicher- 
+  medium gesichert. In diesen Sicherungen wird der augenblickliche System- 
+  Zustand konserviert, so daß bei Netzausfall oder eventuellen System-Zu- 
+  sammenbrüchen der Betrieb übergangslos wieder aufgenommen werden kann, mit 
+  der Ausnahme des Verlustes der Daten, die nach dem letzten Restart-Punkt 
+  aufliefen. 
+ 
+- "Tasks" und/oder Dateien können vor dem unbefugten Zugriff durch "Pass- 
+  words" geschützt werden. Ein weitergehender Schutz wird durch die Möglich- 
+  keit von Password-Algorithmen vom EUMEL-System angeboten, so daß den Be- 
+  langen des Datenschutzes Rechnung getragen werden kann. 
+ 
+- Das EUMEL-Betriebssystem ist leicht erweiterbar. Da der Kern des Betriebs- 
+  systems in ELAN geschrieben ist, können Anwender selbst leicht Erweiterun- 
+  gen bzw. lokale Modifikationen in das System ein- bzw. anfügen. Dabei kön- 
+  nen bestimmte Erweiterungen nur bestimmten Benutzern oder Benutzergruppen 
+  zur Verfügung gestellt werden. Da die Programmiersprache ELAN selbst er- 
+  weiterbar ist, ist es möglich, verschiedenen Anwendern oder -gruppen unter- 
+  schiedliche Erweiterungen der Sprache anzubieten. 
+ 
+- In dem EUMEL-Betriebssystem ist eine implizite Dateihierarchie realisiert. 
+  Dies wird erreicht, indem den Tasks Dateien zugeordnet werden. Man kann 
+  Dateien im Taskbaum von "Vater-Tasks" holen oder zu ihnen schicken. Lokale 
+  Dateien werden mit dem Beenden einer Task automatisch gelöscht, während 
+  Dateien, die längerfristig gehalten werden sollen, bei längerlebenden Tasks 
+  gehalten werden müssen. 
+ 
+- Die Kommandosprache ("job control language") des EUMEL-Systems entspricht 
+  der ELAN-Syntax (Prozeduraufrufe). Das befreit den Anwender von der 
+  Schwierigkeit, zwei verschiedenartige Sprachen zu erlernen. Darüber hinaus 
+  können eine oder mehrere Anweisungen der Kommandosprache in ELAN-Programmen 
+  enthalten sein. Z.B. ist es möglich, Kommandos vom Editor ausführen zu 
+  lassen oder den Editor von einem Programm aus aufzurufen. 
+ 
+- Die Dienstprogramme des EUMEL-Systems, wie z.B. der EUMEL-Editor, sind 
+  geräteunabhängig und meist erweiterbar konzipiert. Zudem sind sie auch in 
+  ELAN formuliert, so daß Änderungen und Korrekturen leicht vorgenommen 
+  werden können. 
+ 
+- Das EUMEL-System verwaltet seinen Hauptspeicher nach dem "demand-paging"- 
+  Prinzip. Daten und/oder Programme werden daher in Seiten von 512 Bytes 
+  aufgeteilt. Nur diejenigen Seiten, die zu einem Zeitpunkt wirklich benötigt 
+  werden, befinden sich im Speicher. Dadurch kann sich das EUMEL-System auf 
+  wechselnde Speicherplatz-Anforderungen optimal einstellen. 
+ 
+- Für alle Programme wird reentranter Code erzeugt. Somit können mehrere 
+  Benutzer Code gleichzeitig benutzen ("sharable code"), wobei der Code nur 
+  einmal vorhanden sein muß. Dies ist insbesondere für Dienstprogramme wie 
+  z.B. Compiler, Editor usw. wichtig. 
+ 
+- Dateien können ebenfalls (wie Programme) von mehreren Benutzern gemeinsam 
+  verwendet werden, ohne daß mehrere Kopien davon hergestellt werden müssen 
+  Das System sorgt mit seinen Paging-Fähigkeiten automatisch für das "sharen" 
+  von Dateien. Erfolgt jedoch ein Schreibzugriff, so wird nur für den 
+  schreibenden Benutzer eine Kopie angelegt. 
+ 
+- Das EUMEL-System bietet gute Textbe- und -verarbeitungsmöglichkeiten. 
+  Grundlage dafür ist der bildschirmorientierte Editor (eine Entwicklung der 
+  GMD). Der Editor erlaubt auch ein "multi window editing" und die Ausführung 
+  von beliebigen Kommandos. Zusätzlich gibt es eine Reihe von Programmen zur 
+  "Textkosmetik", die es erlauben, Texte zeilen- und seitenweise zu forma- 
+  tieren. Dabei ist es möglich, unterschiedliche Schriftarten zu verwenden. 
+ 
+ 
+2. Eine kleine Beispielsitzung mit EUMEL 
+ 
+Zum ersten Kennenlernen wird hier ein Beispiel einer EUMEL-Sitzung darge- 
+stellt. Diese Vorlage kann man am Rechner "nachspielen". Da die Reaktion des 
+Systems hier auf dem Papier nur unvollkommen wiedergegeben werden kann, ist 
+diese Beispielsitzung durch "trockenes" Lesen (ohne Rechner) sicherlich etwas 
+schwieriger zu verstehen als durch Nachspielen. 
+ 
+Alle Ausgaben des EUMEL werden mit 
+ 
+----> 
+ 
+gekennzeichnet, alle Benutzereingaben haben 
+ 
+<---- 
+ 
+als Kennzeichen. Spezielle Tasten werden groß geschrieben, z.B. 
+ 
+     RETURN 
+ 
+als Bezeichnung für die RETURN-Taste. 
+ 
+ 
+Anfang                
+ 
+Im Multi-User-System können gleichzeitig mehrere Benutzer aktiv sein. Dabei 
+braucht jeder ein eigenes "Zimmer" im "EUMEL-Haus", in dem er arbeiten kann, 
+ohne andere zu stören. Diese "Zimmer" heißen hier "Tasks" und haben Namen. 
+Zu Beginn muß der Benutzer sich an seinem Bildschirm eine Task erzeugen. Dazu 
+muß er das Betriebssystem aktivieren: 
+ 
+<----              SV 
+ 
+EUMEL meldet sich: EUMEL Version 1.7.3/M 
+ 
+---->              gib supervisor kommando: 
+ 
+Dann muß der Benutzer sich einen Tasknamen ausdenken (z.B. "ottokar") und 
+ein Kommando zum Einrichten einer neuen Task geben: 
+ 
+<----  begin ("ottokar")  RETURN 
+ 
+Daraufhin wird eine neue Task erzeugt, sie meldet sich: 
+ 
+---->  gib kommando: 
+ 
+Jetzt kann die eigentliche Sitzung beginnen. 
+ 
+ 
+Programm erstellen 
+ 
+Wir schreiben ein kleines Programm zur Primzahlberechnung: 
+ 
+<----   edit ("prim")   RETURN 
+ 
+---->   neue datei einrichten (j/n) ? 
+ 
+<----                                  j 
+ 
+Es soll eine neue Datei mit dem Namen 'prim' eingerichtet werden, daher ant- 
+worten wir mit 'j'. Die Datei ist zu Anfang leer. Der Editor zeigt nur die 
+Überschrift, der restliche Bildschirm ist leer. Wir können jetzt unser Pro- 
+gramm eingeben: 
+ 
+     INT VAR zahl := 3 ; 
+     WHILE zahl <= 1000 REP 
+         drucke falls primzahl ; 
+         zahl INCR 2 
+     PER . 
+ 
+     drucke falls primzahl : 
+         INT VAR teiler := 3 ; 
+         WHILE teiler * teiler <= zahl REP 
+             IF teiler gefunden 
+               THEN LEAVE drucke falls primzahl 
+             FI ; 
+             teiler INCR 2 
+         PER ; 
+         put (zahl) ; 
+         line . 
+ 
+     teiler gefunden : 
+         zahl MOD teiler = 0 . 
+ 
+Bei der Eingabe des Programms können wir auch die Funktionstasten benutzen. 
+Die genauen Funktionen sind in den folgenden Teilen des Benutzerhandbuchs 
+erklärt. Für den Anfang gilt aber: Probieren geht über Studieren! 
+ 
+Wir verlassen den Editor: 
+ 
+<----   ESC q 
+ 
+---->  gib kommando: 
+ 
+ 
+Programm übersetzen und ausführen 
+ 
+<----  run   RETURN 
+ 
+---->       ("prim") 
+ 
+Der Dateiname ('prim') wird automatisch ergänzt und das Programm wird vom 
+ELAN-Compiler übersetzt. Dabei erscheinen die Nummern der gerade übersetzten 
+Zeilen in der linken unteren Bildecke. Wenn keine Fehler gefunden wurden, 
+wird das Programm anschließend ausgeführt. Dann sollten die Primzahlen von 
+3 bis 1000 erscheinen. 
+ 
+ 
+Ein fehlerhaftes Programm korrigieren 
+ 
+Falls der ELAN-Compiler Fehler findet, wird das Programm nicht ausgeführt. 
+Das System geht automatisch in den Editor, der jetzt zwei Dateien "parallel" 
+auf dem Bildschirm zeigt. Die obere enthält die Fehlermeldungen, die untere 
+das ELAN-Programm, so daß Korrekturen leicht möglich sind. Dabei kann man gut 
+folgende Editor-Funktionen benutzen (ausprobieren!): 
+ 
+    ESC  ESC  n  RETURN   positioniert auf Zeile n 
+ 
+    HOP  UNTEN 
+                          zum Blättern 
+    HOP  OBEN 
+ 
+    ESC  w                wechselt zur jeweils anderen Datei (z.B. um in der 
+                          Fehlermeldungsdatei weiterzublättern) 
+ 
+Nach Verlassen des Editors (ESC q) kann das Programm wieder gestartet werden. 
+ 
+ 
+Ändern des Programms 
+ 
+<----  edit   RETURN 
+ 
+---->        ("prim") 
+ 
+Auch hier wird der Dateiname zum Kommando 'edit' automatisch ergänzt. Jetzt 
+kann das Programm mit den üblichen Editor-Möglichkeiten verändert werden. 
+Vorschläge: 
+ 
+     - Man ändere den Bereich (Vorsicht: maxint ist 32767). 
+     - Man teste die Teiler bis zur Zahl selbst hoch. 
+     - Man benutze REALs anstelle von INTs. 
+     - Man suche Zwillinge. 
+ 
+An Editor-Möglichkeiten könnte man ausprobieren: 
+ 
+   RUBOUT           löscht ein Zeichen. 
+ 
+   RUBIN            schaltet den Einfügezustand ein. Das nächste RUBIN 
+                    schaltet ihn wieder ab. 
+ 
+   HOP   UNTEN      zum Anfang des Bildschirms oder "blättern nach oben". 
+ 
+   HOP   OBEN       zum Ende des Bildschirms oder "blättern nach unten". 
+ 
+   HOP   RUBOUT     am Zeilenanfang löscht die ganze Zeile. 
+ 
+   HOP   RUBIN      schaltet "Zeilen einfügen" ein. Das nächste HOP RUBIN 
+                    schaltet es wieder aus. 
+ 
+ 
+Datei löschen 
+ 
+<----  forget   RETURN 
+ 
+---->           ("prim") 
+ 
+---->  löschen (j/n) ? 
+ 
+<----                   j 
+ 
+---->  gib kommando: 
+ 
+ 
+Ende einer Sitzung 
+ 
+<----  end  RETURN 
+ 
+---->  task loeschen (j/n) ? 
+ 
+<----                       j 
+ 
+---->  EUMEL     Version 1.7.3 / M 
+ 
+ 
+ 
+3. Einige Eigenschaften des EUMEL-Systems 
+ 
+In diesem Abschnitt werden wir einige Eigenschaften des EUMEL-Systems 
+schildern, die zum korrekten Arbeiten mit dem System wichtig sind. Um das 
+Verständnis zu erleichtern, verwenden wir für einige System-Eigenschaften 
+Modelle, die das Verhalten des Systems an typischen Merkmalen widerspiegeln 
+spiegeln sollen, die aber - wie bei allen Modellen - kein exaktes Abbild 
+darstellen. 
+ 
+ 
+Tasks, Supervisor und Monitor 
+ 
+Zuerst versuchen wir zu erklären, wie sich ein Benutzer im EUMEL-System 
+anmeldet und den Mechanismus, wie man bestimmte Leistungen vom System 
+anfordert (Einige Ideen dieses ersten Abschnittes gehen auf W. Ambros, 
+Rhein-Sieg Gymnasium, St. Augustin, zurück). 
+ 
+Stellen wir uns das EUMEL-System als ein riesiges Verwaltungsgebäude vor, 
+wie es in unseren Städten in den letzten Jahren überall gebaut wurde. Ein 
+Verwaltungsangestellter beginnt frohgemut seinen ersten Arbeitstag. Da das 
+Gebäude so riesig ist, kann er sein Zimmer nicht finden. Aber er ist pfiffig: 
+er fragt einfach den freundlichen Pförtner, der ihn in sein Zimmer führt. 
+ 
+So ist es im EUMEL-System: 
+Wenn man eine Arbeit neu beginnen will, muß man sich beim Supervisor (das ist 
+der Pförtner in unserem Modell) anmelden. Dazu muß man erstmal den Supervisor 
+"wecken" (wie mit einer Klingel): wir drücken die Supervisor-Taste (im 
+folgenden mit SV abgekürzt). Der Supervisor meldet sich dann mit 
+ 
+     gib supervisor kommando : 
+ 
+Nun kann man eine Task anmelden. Das ist ein Zimmer im EUMEL-System, in dem 
+man arbeiten kann, ohne von den anderen Benutzern gestört zu werden. Ist die 
+Task noch nicht vorhanden, wird sie eingerichtet. Dann leitet uns der Super- 
+visor in die angegebene Task. 
+ 
+Der Verwaltungsangestellte ist nun vom Pförtner zu seinem Büro geleitet 
+worden. Dort empfängt ihn der Bürovorsteher: "Was möchten Sie arbeiten?" 
+Unser Angestellter kann nun (z.B.) sagen, daß er etwas schreiben möchte. Der 
+Bürovorsteher führt ihn in einen speziellen Schreibraum, in dem einige 
+spezielle Einrichtungen und Geräte für komfortables Schreiben stehen. 
+ 
+So sieht es im EUMEL-System aus: 
+Nachdem man eine neue Task eingerichtet hat oder eine bereits vorhandene 
+fortsetzen will, gelangt man zum Monitor (das ist unser Bürovorsteher), der 
+sich mit 
+ 
+     gib kommando : 
+ 
+meldet. Nun kann man verschiedene Arbeiten verrichten, wie z.B. den Editor 
+rufen, um einen Text oder ein Programm zu schreiben: 
+ 
+     edit ("meine datei") 
+ 
+In diesem Schreibzimmer kann unser Angestellter irgendetwas schreiben, z.B. 
+ein Programm, einen Liebesbrief, ein Testament oder ganz etwas anderes. Hat 
+er eine Frage oder will er eine besondere Leistung, dann kann unser Ange- 
+stellter den Bürovorsteher aus dem Schreibzimmer rufen. Hat er seine Schreib- 
+arbeit beendet, geht er aus dem Zimmer und trifft dort wiederum auf den auf- 
+merksamen Vorsteher. Ihm kann er nun sagen, daß er das Schriftstück (z.B.) 
+drucken oder von einem Dolmetscher übersetzen lassen will. 
+ 
+Im EUMEL-System: 
+Im Editor schreibt man Texte oder Programme. Während man im Editor ist, kann 
+man besondere Leistungen durch Kommandos anfordern, ohne den Editor zu ver- 
+lassen, z.B. in einer anderen Datei nachschauen oder einen Teiltext in dem 
+geschriebenen Schriftstück suchen. Nachdem die Arbeit beendet ist, verläßt 
+man den Editor (ESC q) und gelangt wiederum in den Monitor. Hier kann man 
+das Schriftstück drucken oder - im Falle eines Programms - übersetzen lassen: 
+ 
+     print ("meine datei") 
+     run   ("meine datei") 
+ 
+Hat das Programm einen Fehler, eröffnet uns der Monitor ein Fenster auf die 
+Datei und zeigt uns gleichzeitig die Fehlermeldungen, so daß wir bequem 
+korrigieren können. 
+ 
+Nachdem unser Angestellter mit seinen Arbeiten fertig ist, kann er dem Vor- 
+steher (Monitor) sagen: 
+ 
+     Ich kündige!  (will nicht mehr weiterarbeiten)  ('end') 
+     Bis Morgen!   (will später weiterarbeiten)      ('break') 
+ 
+Merke: Der Supervisor des EUMEL-Systems regelt die Einrichtung, Zugang und 
+       Löschung von Tasks. In einer Task kann ein Benutzer arbeiten, ohne 
+       von anderen gestört zu werden. Spezielle Tasks sind für allgemeine 
+       Aufgaben vorgesehen, wie z.B. das Drucken und Sichern von Dateien. 
+       Durch den Monitor kann man Kommandos innerhalb einer Task geben. 
+ 
+ 
+Demand Paging 
+ 
+Nun versuchen wir einen zentralen Begriff des EUMEL-Systems zu erklären, das 
+"demand paging". Diese Eigenschaft moderner Rechensysteme sorgt dafür, daß 
+bei (normalerweise immer) beschränkten Speicherkapazitäten eines Rechners 
+Programme bearbeitbar sind, die in ihrer Gesamtgröße nicht in den Speicher 
+des Rechners passen würden. 
+ 
+Nehmen wir wieder den Angestellten, der nun in einem Zimmer (Task) auf einem 
+Tisch das EUMEL-Benutzerhandbuch durcharbeiten will. Stellen wir uns weiter 
+vor, daß er das Benutzerhandbuch nicht rein "sequentiell" lesen will, sondern 
+daß er fortwährend "blättern" muß. Eigentlich muß unser Angestellter mehrere 
+Seiten des Benutzerhandbuchs gleichzeitig lesen. Deshalb kommt er auf die 
+listige Idee, die Seiten, die er dringend benötigt, zu photokopieren und auf 
+seinem Tisch nebeneinander auszubreiten, damit er nicht mehr blättern muß. 
+Leider ist sein Tisch zu klein, um alle photokopierten Seiten darauf auszu- 
+breiten. Durch die Sparbemühungen der Regierung ist es auch aussichtslos, 
+sich um einen größeren Tisch zu bemühen. Aber im Titel für Verbrauchsmaterial 
+ist genügend Geld vorhanden, so daß Papier für den Photokopierer angeschafft 
+werden kann. Außerdem geht das Photokopieren sehr schnell, weil er den Photo- 
+kopierer direkt neben seinen Tisch aufbaut. Darum photokopiert er nur die- 
+jenigen Seiten, die er gerade benötigt und legt diese auf seinen Tisch. 
+Braucht er eine neue Seite aus dem Buch und hat diese auf dem Schreibtisch 
+keinen Platz mehr, so muß er eine auf dem Tisch liegende Seite entfernen. 
+Geschickt wählt sich unser Angestellter eine Seite aus, von der er annimmt, 
+daß er diese nicht so schnell wieder benötigt. 
+ 
+Was macht er nun mit der "alten" Seite? Er könnte die kopierte Seite einfach 
+in das Benutzerhandbuch einordnen. Aber dazu müßte er erstmal in dem Benut- 
+zerhandbuch suchen, was ihm zuviel Mühe macht. Deshalb wirft er diese Seite 
+einfach weg, denn er kann sie ja jederzeit wieder aus dem Handbuch kopieren. 
+ 
+Gerade will er eine Seite wegwerfen, da fällt ihm auf, daß er das "Wegwerf"- 
+Verfahren vielleicht nicht immer anwenden sollte. Seine Notizen, die er sich 
+auf einigen Seiten gemacht hat, würden ja mit weggeworfen und damit ver- 
+nichtet. Deshalb wirft er Seiten mit Notizen nicht weg, sondern tauscht diese 
+Seiten mit den ursprünglichen Seiten im Benutzerhandbuch aus. 
+ 
+Fassen wir zusammen: 
+Jemand arbeitet ein Buch "durch". Er kopiert sich diejenigen Seiten, die er 
+jeweils benötigt. Da sein Tisch zu klein ist, um alle Seiten gleichzeitig 
+auszulegen, kann er immer nur einen Ausschnitt aus dem Buch bearbeiten, was 
+aber ausreicht. Braucht er eine neue Seite, so muß er eine auf dem Tisch 
+liegende Seite "verdrängen". Hat er diese Seite nicht verändert, also mit 
+Notizen versehen, so kann er sie einfach wegwerfen. "Veränderte" Seiten 
+ersetzt er im Buch und bewahrt sie somit auf. 
+ 
+Ähnliches erfolgt auch im EUMEL-System: 
+Der Zentralspeicher (der Tisch in unserem Modell) des Rechners ist meist ge- 
+genüber dem Massenspeicher, der im EUMEL-System auch als "Hintergrund" be- 
+zeichnet wird (Floppy oder Magnetplatte; in unserem Modell das Buch) zu 
+klein, als daß alle Informationen gleichzeitig hineinpassen würden. Darum 
+werden alle Informationen in sogenannte Seiten ("pages") unterteilt, die 
+jeweils 512 Byte (ein Byte entspricht einem Zeichen) groß sind. Wird eine 
+Information benötigt, so wird die betreffende Seite in den Speicher geholt 
+(daher auch der Begriff "demand paging", etwa: Seitenaustausch auf An- 
+forderung). Das geht so lange gut bis der gesamte Platz im Zentralspeicher 
+des Rechners belegt ist. Soll nun eine neue Seite vom Massenspeicher geholt 
+werden, weil die darin enthaltenen Informationen gebraucht werden, muß eine 
+Seite im Zentralspeicher ersetzt werden (Fachwort: die Seite muß "verdrängt" 
+werden). Sie kann überschrieben werden (in unserem Modell wurde sie "wegge- 
+worfen"), wenn keine Veränderungen vorgenommen wurden, d.h. keine Schreibzu- 
+griffe, sondern nur Lesezugriffe auf die Seite erfolgten. Wurde die Seite 
+verändert, so muß sie auf den Hintergrund zurückkopiert werden und dort die 
+ursprüngliche Seite ersetzen. 
+ 
+ 
+Merke: Die Vorteile eines "demand paging" Systems sind nun offensichtlich: 
+       Es ist möglich, bei weitem größere Informationsmengen (Daten und/oder 
+       Programme) zu bearbeiten als diejenige, die eigentlich in den vor- 
+       handenen Speicher passen würde, weil tatsächlich immer nur ein Aus- 
+       schnitt der gesamten Informationsmenge zu einem Zeitpunkt bearbeitet 
+       werden muß. Bei traditionellen Systemen ist dagegen die maximale Größe 
+       von Programmen und Daten durch die physikalische Größe des Zentral- 
+       speichers beschränkt. 
+ 
+ 
+Sharing 
+ 
+Sharing bezeichnet die gemeinsame Nutzung von Seiten ("pages") durch mehr 
+als einen Benutzer. 
+ 
+Zurück zu unserem Angestellten: Dieser ist inzwischen fleißiger geworden und 
+hat das gleiche Verfahren auf mehrere Bücher ausgedehnt, d.h. er kopiert sich 
+diejenigen Seiten aus den Büchern, die er gerade benötigt. Bei der Ver- 
+drängung einer Seite behält er sein altes (nicht sehr umweltfreundliches) 
+Verfahren bei: nur die veränderten Seiten ersetzen die Original-Seiten in den 
+Büchern (werden zurückgelegt), die anderen (nicht veränderten) weggeworfen. 
+ 
+Aber auch andere Angestellte seines Büros haben ihn beobachtet, beneiden ihn 
+um seine "geschickte" Arbeitstechnik und wollen mitarbeiten. Leider steht 
+ihnen gemeinsam nur der eine Tisch zur Verfügung, der zudem in der Zwischen- 
+zeit auch nicht größer geworden ist, weil die Sparmaßnahmen der Regierung 
+noch immer anhalten. Darum müssen sie sich nun den einzigen Tisch teilen, auf 
+dem sie ihre kopierten Seiten auslegen können. 
+ 
+Im Laufe der Arbeit ergibt es sich, daß sie unterschiedliche Seiten der 
+Bücher durcharbeiten müssen, weil sie verschieden schnell arbeiten, aber auch 
+andere Arbeitsgebiete haben. 
+ 
+Durch die unterschiedliche Arbeitsgeschwindigkeit ergibt es sich, daß ein 
+Angestellter z.B. zu einem Zeitpunkt sich intensiv nur mit einer Seite be- 
+schäftigt, ein anderer aber mehrere Seiten quasi gleichzeitig braucht. Aber 
+oft brauchen mehrere Angestellte mehrere Seiten, so daß der verfügbare Platz 
+auf dem Tisch bald etwas zu eng wird. Natürlich "funktioniert" unser Ver- 
+fahren immer noch, aber es ist doch etwas langsam geworden, weil unsere 
+Angestellten mehr mit dem Austausch von Seiten beschäftigt sind, als daß sie 
+noch zu dem Verarbeiten der gelesenen Informationen kommen. Sie überlegen 
+also, wie das Verfahren zu verbessern ist und kommen auf folgenden Trick: 
+kopierte Seiten, die zwei oder mehr Angestellte zur gleichen Zeit bearbeiten 
+wollen, brauchen nur einmal auf dem Tisch zu liegen (schließlich sind unsere 
+Angestellten gewöhnt, in Gruppen zu arbeiten). Diese Rationalisierungs-Idee 
+ist ja offensichtlich, denn schließlich benutzen die Angestellten die Bücher 
+auch gemeinsam. Aber Vorsicht: wenn einer der Angestellten, die gemeinsam 
+eine Seite bearbeiten, sich etwas auf dieser Seite notieren will, darf nicht 
+die gemeinsam auf dem Tisch liegende Seite verwendet werden. In diesem Fall 
+ist es notwendig, vorher eine erneute Kopie zu machen, weil andere Ange- 
+stellte seine Notizen nicht unbedingt mitlesen sollen, also die unveränderte 
+Seite brauchen. 
+ 
+Und das findet im Rechner statt: 
+Das "demand paging" Verfahren funktioniert natürlich nicht nur mit einer 
+Datei und einem Programm, sondern auch mit mehreren Dateien und Programmen, 
+von denen nur diejenigen Seiten in den Zentralspeicher geholt werden, die zu 
+einem Zeitpunkt in den Rechner passen. Aber erst mit mehreren Benutzern des 
+EUMEL-Systems entfaltet das "demand paging" Verfahren seine volle Mächtig- 
+keit, denn alle Benutzer können Programme und/oder Dateien verarbeiten, die 
+in der Gesamtheit nicht in den Speicher passen würden. Dabei wird eine Eigen- 
+schaft des EUMEL-Systems gut genutzt: Alle Programme des EUMEL-Systems (und 
+übrigens alle Programme, die der ELAN-Compiler übersetzt hat) sind reentrant, 
+d.h. können von mehreren Benutzern gleichzeitig gelesen werden, aber brauchen 
+nur einmal im Zentralspeicher vorhanden zu sein. Zwei oder mehr Benutzer 
+können also eine oder mehrere Seiten gemeinsam verwenden (Fachausdruck: 
+"sharen"), sowohl im Zentralspeicher wie auch im Massenspeicher ("Hinter- 
+grund"). Dies gilt nicht nur für Programme, sondern auch für Daten. Erst 
+wenn ein Benutzer eine Veränderung vornimmt, also schreibend auf die Seite 
+zugreift, wird diese Seite (nur für diesen Benutzer!) kopiert (EUMEL-Fachaus- 
+druck: "copy on write"). Alle anderen Benutzer arbeiten mit der unveränderten 
+Seite weiter. Der große Vorteil dieses Verfahrens: eine redundante 
+Speicherung von Daten und Programmen wird vermieden. 
+ 
+Es passiert nun oft, daß ein Benutzer zu einem Zeitpunkt relativ wenig Seiten 
+benötigt: sei es, daß er Daten mit Hilfe des Editors eingibt oder nachdenkt, 
+sei es, daß ein Programm wenig Daten verwendet und selbst sehr kurz ist. Mit 
+anderen Worten: die Anzahl der benötigten Seiten zu einem Zeitpunkt (Fachaus- 
+druck: "working set") für diesen Benutzer ist klein. Dann ist es möglich, daß 
+andere Benutzer zu diesem Zeitpunkt mehr Seiten im Zentralspeicher des Rech- 
+ners haben. Deren "working set" ist also groß. 
+ 
+Merke: Damit wird ein weiterer Vorteil des "demand paging" Verfahrens klar: 
+       Ein "demand paging" System stellt sich automatisch und dynamisch auf 
+       die Anforderungen von Benutzern ein, indem denjenigen Benutzern mehr 
+       Speicher zugeteilt wird, die mehr benötigen und umgekehrt. Aber auch 
+       ein Nachteil wird sichtbar: Benötigen alle Benutzer des Systems viel 
+       Zentralspeicher, dann kann es zu folgender Situation kommen: Benutzer 
+       A benötigt eine neue Seite. Das System verdrängt für diesen Zweck eine 
+       Seite, die Benutzer B gehört. Nachdem Benutzer B an die Reihe kommt, 
+       benötigt er diese Seite wieder. Das System verdrängt eine Seite des 
+       Benutzers A u.s.f.. Eine solche Situation, in der "pages" ständig in 
+       den Speicher kopiert und aus dem Speicher bei einer Seitenverdrängung 
+       auf den Hintergrund geschrieben werden muß (und somit kaum gerechnet 
+       wird), wird als "thrashing" bezeichnet. "thrashing" oder mit anderen 
+       Worten: sehr geringer Verbrauch an Rechenzeit bei gleichzeitig er- 
+       höhtem "paging"-Aufwand ist ein Anzeichen für zu hohe Anforderungen 
+       an das System (Ausweg: Erweiterung des Hauptspeichers oder Be- 
+       schleunigung des Hintergrundmediums (Platte statt Floppy) oder 
+       Reduktion der Anforderungen). 
+ 
+ 
+Datenräume 
+ 
+Datenräume sind die Grundlage für Dateien im EUMEL-System. 
+ 
+Zurück zu unseren Angestellten: 
+Nachdem die Verbesserung vorgenommen wurde, daß sich zwei oder mehr Ange- 
+stellte eine Seite auf dem Tisch "teilen", tritt sofort ein neues Problem 
+auf. Es kann nun nämlich passieren, daß zwei Angestellte eine Original-Seite 
+verändern und beide in dem gleichen Buch ersetzt werden müssen. Es befinden 
+sich somit noch mindestens zwei andere mit Notizen versehene Seiten mit 
+gleicher Seitennummer in einem Buch. Zu allem Unglück wurde die Original- 
+Seite ersetzt, so daß andere Angestellte nur die mit Notizen versehene Seiten 
+erhalten können. Was ist zu tun? Das Verfahren sollte doch beibehalten 
+werden, denn schließlich ist eine totale Abkehr von Arbeitsvorgängen für 
+Verwaltungsangestellte nicht denkbar. 
+ 
+Als erste Idee kommt ihnen in den Sinn, einfach alle Bücher für alle Ange- 
+stellten zu photokopieren. Dann kann es ja nicht zu einer solchen Kollision 
+kommen, daß zwei oder mehr Angestellte eine Seite in einem Buch ersetzen 
+wollen, weil jeder Angestellte seine eigene Kopie besitzt. Um die ver- 
+schiedenen Kopien eines Buches auseinander zu halten, wird von den Ange- 
+stellten verlangt, ihre Buch-Kopie mit einem sinnvollen Namen zu versehen. 
+Dies Verfahren funktioniert auch eine Weile, bis ein strebsamer Angestellter 
+einen Verbesserungsvorschlag macht, der prompt mit DM 5,- honoriert wird: 
+wie bereits mit den Seiten auf dem Tisch geschehen, ist es ja nicht not- 
+wendig, die Bücher zu photokopieren, sondern nur die mit Notizen versehenen 
+in einen Ordner, der entsprechend einer Buch-Kopie angelegt wird, einzu- 
+ordnen. Alle anderen, nicht veränderten Seiten können noch immer gemeinsam 
+benutzt werden. 
+ 
+Und so funktioniert es nun: 
+Bei Arbeitsbeginn finden die Angestellten einen Buchbestand vor. Um mit einem 
+Buch arbeiten zu können, muß ein Angestellter einen Ordner für dieses Buch 
+anlegen, in den die ggf. veränderten Seiten eingeordnet werden. Zu diesem 
+Zweck muß jeder Ordner einen sinnvollen Namen erhalten, damit die Angestell- 
+ten ihre Ordner auch wiederfinden. Am Anfang müssen die Angestellten Seiten 
+der Original-Bücher kopieren. Wird eine solche Seite mit Notizen versehen, 
+also verändert, muß sie bei einer Verdrängung in den entsprechenden Ordner 
+eingefügt werden. Muß ein Angestellter eine neue Seite kopieren, so schaut 
+er erst in seinem Ordner nach, ob sich die entsprechende Seite dort befindet. 
+Damit wird garantiert, daß jeder Angestellte auch immer seine, mit Notizen 
+versehene Seiten erhält. Befindet sich eine gesuchte Seite nicht in dem 
+Ordner (am Arbeitsbeginn ist ein Ordner natürlich immer leer), so kopiert er 
+sich eine Seite aus dem entsprechenden Original-Buch. 
+ 
+In der Zwischenzeit passiert folgendes im Rechner: 
+Eine Sammlung von Daten und/oder Programmen wird im EUMEL-System ein "Daten- 
+raum" ("dataspace") genannt. Erhält ein Datenraum einen Namen, so wird 
+dieser Datenraum eine Datei ("file") genannt. Angenommen, es existiert im 
+System eine Datei mit dem Namen 'Mist', die ein Angestellter mit dem Namen 
+'Krümel Monster' erstellt hat. Ein anderer Benutzer mit dem Namen 'Grobi' 
+will mit dieser Datei arbeiten. Grobi kopiert sich also diese Datei und gibt 
+ihr den Namen 'Grobis Mist'. Durch diese Kopier-Operation wird ein neuer 
+Datenraum angelegt, der aber anfänglich nur Verweise auf den Datenraum ent- 
+hält, der sich unter dem Namen 'Mist' verbirgt. Der Datenraum bzw. die 
+Seiten, die in Datei 'Mist' enthalten sind, werden also "geshared", d.h. von 
+mehreren Benutzern gemeinsam verwendet (in unserem Beispiel von Grobi und 
+Krümel Monster). Es erfolgt also eine logische Kopie, aber keine physika- 
+lische! 
+ 
+Will der Angestellte Grobi nun eine Seite der Datei 'Grobis Mist' verwenden, 
+so erhält er natürlich die entsprechende Seite aus der Datei 'Mist'. Ver- 
+ändert der Angestellte Grobi nun eine Seite, so wird diese veränderte Seite 
+in dem Datenraum vermerkt, der unter dem Namen 'Grobis Mist' ansprechbar ist. 
+Davon merkt der Benutzer 'Krümel Monster' natürlich nichts, denn er arbeitet 
+mit den Seiten seines Datenraums weiter, die unverändert geblieben sind. Aber 
+auch Grobi merkt nichts davon, daß Seiten soweit wie möglich gemeinsam be- 
+nutzt werden. 
+ 
+Merke: Durch das Konzept der Datenräume und Dateien (die nichts anderes sind 
+       als benannte Datenräume), ist es möglich, auch Daten von verschiedenen 
+       Programmen her gemeinsam zu benutzen und somit eine redundante 
+       Speicherung überflüssig zu machen. Programme sind ebenfalls in Daten- 
+       räumen gespeichert, so daß einer gemeinsamen Benutzung von z.B. 
+       Systemprogrammen durch mehrere Nutzer nichts im Wege steht. 
+ 
+ 
+ 
+Fixpunkte 
+ 
+In gewissen Zeitabständen wird der gesamte Systemzustand eines EUMEL-Systems 
+gespeichert ("Fixpunkt"). Bei eventuell auftretenden Störungen kann dadurch 
+immer bei dem letzten Fixpunkt mit der Verarbeitung fortgefahren werden. 
+ 
+Zurück zu unseren Angestellten, die typischerweise dieses komische System 
+weiter benutzen: Es passiert zum ersten Mal ein entsetzliches Unglück: 
+während im Sommer mehrere Fenster geöffnet wurden, betritt der "reitende" 
+Bürobote das Zimmer und alle Seiten werden von den Tischen und aus allen 
+offenen Ordnern herabgeweht. Da unsere Angestellten - wie man sich leicht 
+vorstellen kann - etwas vergeßlich sind, können sie nicht mehr rekon- 
+struieren, welche Seiten auf den Tischen und welche sich in den Büchern bzw. 
+Ordnern befanden. Die Arbeit von mehreren Monaten ist somit verloren! 
+ 
+Deshalb werden Sicherheitsmaßnahmen getroffen: 
+In regelmäßigen Zeitabständen müssen alle Angestellten ihre Arbeit unter- 
+brechen. Dann wird von einem - extra dazu abgestellten - Angestellten Listen 
+angelegt, in denen die Seiten auf dem Tisch, den Ordnern und den Büchern 
+vermerkt wird. Im Falle eines erneuten Unglücks braucht man also nur die 
+letzte dieser Listen zu konsultieren, um eine gesicherte Arbeitssituation 
+herzustellen. Allerdings ist in einem solchen Fall diejenige Arbeit verloren, 
+die in der Zwischenzeit seit der Erstellung der letzten Liste geleistet 
+wurde. Aber das wird ja gerne in Kauf genommen, weil überhaupt weitergemacht 
+werden kann und nicht die gesamte Arbeit verloren ist. 
+ 
+Merke: In gewissen (einstellbaren, typisch: 15 Minuten) Zeitabständen wird 
+       vom EUMEL-System der gesamte Zustand des Systems gesichert. Diese 
+       Sicherung wird "Fixpunkt" genannt. Dazu ist es notwendig, daß die 
+       Verarbeitung der Programme kurz (z.Z. 0.2 Sek.) unterbrochen wird, 
+       was sich jedoch meist nicht besonders störend auswirkt. Damit ist es 
+       aber sichergestellt, daß bei einem Stromausfall, Hardware- oder Soft- 
+       warestörungen immer zu einem Zeitpunkt in der Verarbeitung "aufge- 
+       setzt" werden kann, bei dem nur diejenigen Daten verloren sind, die 
+       seit dem letzten "Fixpunkt" aufliefen. 
+ 
+ 
+ 
+Archiv 
+ 
+Ein weiteres Sicherungsmittel im EUMEL-System ist das Archiv, mit welchem 
+man Dateien (also Daten und/oder Programme) extern zum EUMEL-System 
+speichern kann. 
+ 
+Verlassen wir nun lieber unsere Angestellten. Dieses Modell würden wir sonst 
+übermäßig strapazieren. Wenden wir uns vielmehr einem weiteren Sicherungs- 
+mittel des EUMEL-Systems zu, dem EUMEL-Archiv. Mit Hilfe des EUMEL-Archivs 
+ist es möglich, Dateien auf Floppies zu schreiben und somit außerhalb des 
+EUMEL-Systems aufzubewahren. Es ist nun möglich, mehrere Dateien auf einer 
+Floppy zu speichern. Bloß wie funktioniert das? 
+ 
+Ein gutes Modell des EUMEL-Archivs stellt ein Tonband oder eine Musikkassette 
+dar. Auf diesen werden die Musikstücke (unsere Dateien) nacheinander (Fach- 
+ausdruck: "sequentiell") aufgezeichnet, d.h. neue Musikstücke (Dateien) 
+können immer nur angefügt werden. Ist das Tonband oder die Kassette voll 
+beschrieben, so schaltet das Gerät meist automatisch ab. Im EUMEL-System 
+gibt's in solchen Fällen eine Fehlermeldung. 
+ 
+Unterschiedlich zu einem Tonband ist jedoch, daß im EUMEL-System die Namen 
+der Dateien mit abgespeichert werden und diese Dateien - durch die Angabe 
+des Dateinamens - gezielt vom Archiv gelesen werden können. Bei einem Ton- 
+band oder einer Kassette muß man sich erst alle Musikstücke anhören, bis 
+das Musikstück erreicht ist, welches benötigt wird. Dieses "sequentielle" 
+Überlesen nicht benötigter Dateien erledigt das EUMEL-System "automatisch". 
+ 
+Im EUMEL-System gibt es nun nicht nur die Möglichkeit, eine Datei auf ein 
+Archiv zu schreiben oder von einem Archiv zu lesen, sondern auch mehrere Da- 
+teien mit einem Kommando zu lesen oder zu schreiben. Zusätzlich ist es mög- 
+lich, ein Archiv zu löschen (und dann ggf. neu zu beschreiben), wenn die 
+"archivierten" Dateien nicht mehr benötigt werden. 
+ 
+Nun passiert es oft, daß eine bereits archivierte Datei verändert wird und 
+nochmals auf das Archiv geschrieben werden soll. Aber durch eine Veränderung 
+der Datei hat diese gerade ihren Platzbedarf verändert. Somit könnte die 
+Datei - sofern sie sich vergrössert hat - eine nachfolgende Datei auf dem 
+Archiv u.U. teilweise überschreiben. Deshalb wurde im EUMEL-Archiv folgende 
+Vereinbarung getroffen: Wird eine Datei nochmals auf ein Archiv geschrieben, 
+so wird die Datei, die sich bereits auf dem Archiv befindet, als "ungültig" 
+gekennzeichnet und die neue Version an das Ende angefügt. Nur wenn die alte 
+Datei die letzte auf dem Archiv ist, wird sie von der neuen Version über- 
+schrieben. 
+ 
+Merke: Durch dieses Verfahren kann es zu einer kuriosen Situation kommen: 
+       zwei Dateien werden abwechselnd auf ein Archiv in mehreren Versionen 
+       geschrieben. Obwohl beide Dateien zusammengenommen bei weitem nicht 
+       das Archiv auffüllen würden, kommt es zum Überlauf. In einem solchen 
+       Fall muß man das Archiv löschen (wobei vorher die Dateien ggf. in das 
+       System geholt werden müssen) und beide Dateien erneut auf das Archiv 
+       schreiben. 
+ 
+ 
+ 
+4. Kleines #ib#EUMEL-Wörterbuch 
+ 
+In diesem Wörterbuch werden einige der Begriffe, die häufig in diesem Be- 
+nutzer-Handbuch verwendet werden, erläutert. Bezüge auf weitere Begriffe, 
+die in diesem Wörterbuch stehen, werden mit den Zeichen ">" und "<" ge- 
+klammert. 
+ 
+Anweisung:        Direktive an die Textkosmetik, welche direkt in einen Text 
+                  geschrieben wird. Eine Anweisung muß in "\#" eingefaßt 
+                  werden. Beachte den Unterschied zu einem Kommando. 
+ 
+Archiv:           Ein Programmsystem, um Dateien des EUMEL-Systems auf 
+                  Floppys außerhalb des Systems zu speichern oder von dort 
+                  wieder in das EUMEL-System zu holen. Als Archiv wird auch 
+                  noch ein Speichermedium bezeichnet (in der Regel eine 
+                  Diskette). 
+ 
+Benutzer-Task:    Im Gegensatz zu einer >System-Task< ist eine Benutzer-Task 
+                  eine Task, die von einem Benutzer erzeugt worder ist. Sie 
+                  ist entweder an ein Terminal gekoppelt oder kann unab- 
+                  hängig von einem Terminal im Hintergrund bearbeitet werden. 
+ 
+BOUND:            Attribut von Variablen, das bei einer Deklaration vor die 
+                  Typangabe gesetzt wird. Dient zur Aufprägung eines Daten- 
+                  typs auf einen Datenraum. 
+ 
+DATASPACE:        Eine Datei ohne Namen. 
+ 
+Datenraum:        Siehe >DATASPACE<. 
+ 
+Editor:           Programm zur Eingabe und Veränderung von Texten, Daten und 
+                  Programmen. 
+ 
+ELAN:             Programmiersprache des EUMEL-Systems ("ELementary 
+                  LANguage"). 
+ 
+ELAN-Compiler:    Ein Programm, welches ein korrektes ELAN-Programm in ein 
+                  äquivalentes, ablauffähiges Programm (im >EUMEL0-Code<) 
+                  übersetzt. 
+ 
+EUMEL0-Code:      Maschinensprache des EUMEL-Systems. 
+ 
+EUMEL-Drucker:    Programm zur Ansteuerung von (unterschiedlichen) Druckern. 
+                  Der EUMEL-Drucker wird durch Kommandos gesteuert und er- 
+                  laubt es, unterschiedliche Drucker mit verschiedenartigen 
+                  Leistungen immer gleich anzusprechen. 
+ 
+EUMEL-Standard:   Objekte (also Datentypen, Prozeduren und/oder Operatoren), 
+                  die durch Pakete realisiert werden und standardmässig in 
+                  jedem EUMEL-System verfügbar sind. 
+ 
+Fixpunkt:         Speicherung des aktuellen Systemzustandes in regelmäßigen 
+                  Abständen. Bei Hardware- oder Softwarestörungen kann immer 
+                  bei der letzten Fixpunkt-Sicherung aufgesetzt werden. 
+ 
+Hintergrund-Task: Eine >Task<, die nicht an ein Terminal angekoppelt ist 
+                  (d.h. einem Benutzer nicht direkt zugänglich), aber trotz- 
+                  dem vom System bearbeitet wird oder im Wartezustand ist 
+                  (warten auf einen Auftrag oder eine Ein/Ausgabe-Operation). 
+ 
+Kommando:         Ein ELAN-Programm, welches in der Regel aus einem 
+                  Prozeduraufruf besteht. Ein Kommando kann vom >Monitor< 
+                  oder Editor gegeben werden. Kommandos können ebenfalls in 
+                  Programmen verwandt werden. 
+ 
+Lokale Dateien:   Dateien einer Benutzer-Task. 
+ 
+Manager:          Eine >Task<, die auf Aufträge wartet. Beispiele sind die 
+                  Spool-Task bzw. Datei-Manager. Letzterer wird für die 
+                  Haltung längerfristig benötigter Dateien gebraucht. 
+ 
+Monitor:          Der Monitor steuert die Kommunikation zwischen einem 
+                  Benutzer am Terminal und dem EUMEL-Betriebssystem, nachdem 
+                  der Benutzer sich mit Hilfe des >Supervisors< eine Task 
+                  erschaffen hat. Die Monitor-Kommandos beziehen sich immer 
+                  auf die angekoppelte Benutzer-Task. 
+ 
+paging:           Benötigte Informationen werden in Einheiten ("pages") in 
+                  den Zentralspeicher des Rechners geladen. Somit ist es 
+                  möglich, bei weitem größere Informationsmengen zu ver- 
+                  arbeiten, als auf einmal in den Speicher des Rechners 
+                  passen. 
+ 
+OPERATOR:         >Task<, mit der das EUMEL-System u.a. gestartet, "abge- 
+                  schaltet" und gesichert werden kann. 
+ 
+Scanner:          Programm, um aus einem Text lexikalische Elemente ("Le- 
+                  xeme") herauszublenden. In dem im >EUMEL-Standard< 
+                  implementierten Scanner werden Lexeme nach der ELAN-Syntax 
+                  erkannt, redundante Leerzeichen (nicht in Texten) sowie 
+                  Kommentare überlesen. 
+ 
+Sendungs-Vermittlung: Steuerung der Übermittlung von Informationen zwischen 
+                  verschiedenen >Tasks<. 
+ 
+sharing:          >Datenräume< und/oder >pages< können von mehreren Benutzern 
+                  gleichzeitig benutzt werden. Erst bei einer Schreibopera- 
+                  tion eines Benutzers wird nur für diesen Nutzer eine Kopie 
+                  der Daten angelegt. ("copy on write"). 
+ 
+Spooler:          Systemprogramm des EUMEL-Systems, welches Druckaufträge 
+                  zwischenspeichert, so daß unmittelbar weiter gearbeitet 
+                  werden kann. 
+ 
+Supervisor:       Kern des EUMEL-Betriebssystems auf der ELAN-Ebene zum Ver- 
+                  walten von Tasks. 
+ 
+Supervisor-Kommando: Kommando zur Steuerung (An-/Abkoppeln, Erzeugen, 
+                  Benutzung) einer >Benutzer-Task<. 
+ 
+System-Task:      Eine >Task<, die für Aufrechterhaltung, Betrieb und Steu- 
+                  erung des EUMEL-Systems benötigt und nicht von einem 
+                  Benutzer erzeugt wird, sondern "immer" im >Taskbaum< 
+                  vorhanden ist. 
+ 
+Task:             Eigenständiger Prozeß (Auftrag) im EUMEL-System. 
+ 
+Taskbaum:         Eine baumförmige Anordnung von >Tasks<, in die jede Task 
+                  des EUMEL-Systems eingefügt wird. Dabei hat jede Task 
+                  - mit Ausnahme des >Urvaters< - eine >Vater-Task<, und 
+                  kann weitere Tasks erzeugen ("Söhne"). 
+ 
+Textkosmetik:     Programme des EUMEL-Systems, die die Gestaltung eines 
+                  Textes erlauben. 
+ 
+Urvater:          Wurzel des >Task-Baums< mit dem Namen 'UR'. 
+ 
+Vater-Dateien:    Dateien einer >Vater-Task<. 
+ 
+Vater-Task:       Eine >Task<, die einer Task in direkt aufsteigender Linie 
+                  im >Taskbaum< übergeordnet ist. Es wird dabei zwischen 
+                  einer "unmittelbaren" (die direkt übergeordnete Vater-Task) 
+                  und "mittelbaren" Vater-Tasks (Vater-Tasks, die über die 
+                  unmittelbare Vater-Task erreichbar sind) unterschieden. 
+ 
+ 
+ 
+5. ELAN-Literatur 
+ 
+Bittner, M., Jäckel, J., Jähnichen, S.: 
+     ELAN - Beispielsammlung. 
+     Institut für angewandte Informatik, 
+     Fachbereich 20, TU Berlin, 
+     Berlin, 1979 
+ 
+Hahn, R.: 
+     Höhere Programmiersprachen im Vergleich. 
+     Akademische Verlagsgesellschaft, 
+     Wiesbaden, 1981 
+ 
+Hahn, R., Nienaber, B.: 
+     Probleme lösen mit dem Computer. 
+     Teil 1: Einführung in die algorithmische Problemlösung. 
+     Teil 2: Werkzeuge und Methoden. 
+     Neuer Verlag Bernhard Bruscha, 
+     Tübingen, 1978 
+ 
+Hahn, R., Stock, P.: 
+     ELAN - Handbuch. 
+     Akademische Verlagsgesellschaft, 
+     Wiesbaden, 1979 
+ 
+Hommel, G., Jäckel, J., Jähnichen, S., Kleine, K., Koch, W., Koster, K.: 
+     ELAN - Sprachbeschreibung. 
+     Akademische Verlagsgesellschaft, 
+     Wiesbaden, 1979 
+ 
+Hommel, G., Jähnichen, S., Koch, W.: 
+     SLAN - Eine erweiterbare Sprache zur Unterstützung der strukturierten
+     und modularen Programmierung. 
+     4. GI Fachtagung Programmiersprachen in Erlangen, 
+     Springer Verlag, 1976 
+ 
+Hommel, G., Jähnichen, S., Koster, C.H.A.: 
+     Methodisches Programmieren. 
+     De Gruyter, Berlin, 1983 
+ 
+Klingen, L., Liedtke, J: 
+     Programmieren mit ELAN 
+     Teubner, Stuttgart, 1983 
+ 
+Liedtke, J.: 
+     EUMEL - Ein ELAN-System für Mikroprozessoren. 
+     GMD-Spiegel, 
+     Bonn, 1979 
+ 
+Voila, H.T.: 
+     A new computer routine for the generation of publishable data from
+     nothing. 
+     Computer Quickies 48, 117 (1984) 
+
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10
new file mode 100644
index 0000000..0f3b656
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10
@@ -0,0 +1,771 @@
+                        EUMEL-Benutzerhandbuch 
+ 
+                              TEIL 10: Graphik                      
+ 
+1. Übersicht 
+ 
+Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-Möglichkeiten des 
+EUMEL-Systems. Die Graphik-Pakete gehören nicht zum EUMEL-Standard, sondern 
+sind Anwenderpakete, die im Quellcode ausgeliefert und von jeder Instal- 
+ation in das System aufgenommen werden können. Unter Umständen müssen 
+Programme erstellt werden, die die Anpassungen für spezielle graphische 
+Geräte einer Installation vornehmen. 
+ 
+Das Graphik-System ermöglicht es, durch ELAN-Programme geräteunabhängige 
+Informationen für Zeichnungen ("Graphiken") zu erstellen. Die Graphik 
+erzeugenden Programme brauchen dabei keine gerätespezifischen Größen sowie 
+gerätespezifischen Unterprogramme zu enthalten. Sie befassen sich somit 
+ausschließlich mit der Erzeugung der problemorientierten Information für die 
+Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer 
+Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. 
+erst auf einem Terminal zur Kontrolle und dann auf einem Plotter). 
+ 
+Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Dabei ent- 
+spricht die Y-Achse bei der zweidimensionalen Graphik der Z-Achse (Höhe) bei 
+der dreidimensionalen Graphik. Im dreidimensionalen Fall sind perspektivi- 
+sche, orthografische und schiefwinklige Projektionen mit beliebigen Betrach- 
+tungswinkeln möglich. 
+ 
+Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von 
+Graphiken (Bildern) auf der einen und Darstellung der erzeugten Bilder auf 
+der anderen Seite unterschieden. Für die Erzeugung und Manipulation der 
+Graphiken existiert der Typ PICTURE, für die Darstellung der Bilder gibt es 
+den Typ PICFILE. Dabei müssen Ausschnitt, Maßstab, Betrachtungswinkel und 
+Projektionsart erst bei der Darstellung festgelegt werden. Diese Kon- 
+struktion des Graphik-Systems hat folgende Vorteile: 
+ 
+a) Programme, die Graphik-Informationen erzeugen, sind geräteunabhängig. 
+   Das bedeutet, daß Programmierer sich ausschließlich mit einem logischen 
+   Problem zu befassen brauchen und nicht mit gerätespezifischen Besonder- 
+   heiten. 
+ 
+b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals 
+   dargestellt werden, ohne daß das erzeugende Programm geändert oder neu 
+   gestartet werden muß. Z.B. kann ein Programmierer eine Graphik erst auf 
+   dem Terminal auf Richtigkeit und Größenverhältnisse überprüfen, bevor er 
+   die Zeichnung auf einem Plotter zeichnen läßt. 
+ 
+c) Graphiken können leicht geändert (z.B. vergrößert oder in eine Richtung 
+   gestreckt) werden, ohne daß das erzeugende Programm erneut durchlaufen 
+   werden muß. Zudem können Graphiken aneinander oder übereinander gelegt 
+   werden. 
+ 
+d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht er- 
+   zeugt werden. 
+ 
+e) Der Anschluß von neuen Graphik-Geräten durch Benutzer ist leicht möglich, 
+   ohne daß die Graphik erzeugenden Programme modifiziert werden müssen. 
+ 
+f) Plotter können wie Drucker an einen SPOOLER gehängt werden. 
+ 
+g) Bilder können als PICFILEs gespeichert und versandt werden. 
+ 
+ 
+ 
+Erzeugung von Bildern 
+ 
+Bilder entstehen in Objekten vom Datentyp 
+ 
+     PICTURE 
+ 
+Diese müssen mit der Prozedur 
+ 
+     nilpicture 
+ 
+initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension 
+noch nicht festgelegt ist. Die Dimension eines PICTUREs wird mit dem ersten 
+Schreibzugriff ('move' oder 'draw') festgelegt. Ein PICTURE kann immer nur 
+entweder zwei- oder dreidimensional sein. Außerdem kann einem PICTURE mit 
+der Prozedur 
+ 
+     pen 
+ 
+genau ein virtueller Stift zugeordnet oder der aktuelle Stift erfragt werden. 
+ 
+Die Erzeugung eines Bildes basiert auf dem Modell eines Plotters. Der (vir- 
+tuelle) Zeichenstift kann mit 
+ 
+     move 
+ 
+ohne zu zeichnen an beliebige Stellen gefahren werden (reine Positionierung). 
+Mit 
+ 
+     draw 
+ 
+wird der Stift veranlaßt, eine Linie von der aktuellen zur angegebenen Ziel- 
+position zu zeichnen. 'move' löst also Bewegungen mit gehobenem, 'draw' 
+solche mit gesenktem Stift aus. Um auch 'relatives' Zeichnen zu ermöglichen, 
+existiert die Prozedur 
+ 
+     where 
+ 
+die die aktuelle Stiftposition liefert. 
+ 
+ 
+ 
+Manipulation von Bildern 
+ 
+Erstellte Bilder können als Ganzes manipuliert werden. Die Prozeduren 
+ 
+    translate            (* verschieben            *) 
+    stretch              (* strecken bzw. stauchen *) 
+    rotate               (* drehen                 *) 
+    reflect              (* spiegeln               *) 
+ 
+verändern jeweils das ganze Bild. Es ist aber auch möglich, mehrere Bilder 
+zusammenzufügen. Mit 
+ 
+     CAT 
+ 
+kann ein weiteres Bild angefügt werden. Dabei müssen allerdings beide 
+PICTURE die gleiche Dimension haben. In solchen als ganzes manipulierten 
+Bildern kann man ohne Einschränkung mit 'draw' und 'move' weiterzeichnen. 
+ 
+ 
+ 
+Darstellung 
+ 
+Für die Darstellung der erzeugten Bilder existiert der Typ 
+ 
+     PICFILE 
+ 
+Dieser besteht aus max. 128 PICTUREs, die mit den Prozeduren 
+ 
+     put 
+     get 
+ 
+eingegeben bzw. ausgegeben werden können. PICFILE wird durch Datenräume 
+realisiert, deshalb erfolgt die Assoziation an einen benannten Datenraum 
+ähnlich wie beim FILE. Dafür wird die Prozedur 
+ 
+     picture file 
+ 
+verwandt. Ein neuer PICFILE enthält genau ein leeres PICTURE. Die Darstel- 
+lung der PICFILEs auf Zeichengeräten erfolgt mit der Prozedur 
+ 
+     plot 
+ 
+Da die Graphiken aber in "Weltkoordinaten" erzeugt werden und die spätere 
+Darstellung vollkommen unbeachtet bleibt, müssen gewisse Darstellungspara- 
+meter für die Zeichnung gesetzt werden. Diese Parameter werden im PICFILE 
+abgelegt und gelten jeweils für den gesamten PICFILE. Dadurch ist es möglich, 
+einen PICFILE mit spezifizierter Darstellungsart über einen SPOOLER an einen 
+Plotter zu senden oder die bei der letzten Betrachtung gewählte Darstellung 
+mit in dem PICFILE gespeichert zu halten. Für die Darstellung können den 
+virtuellen Stiften mit der Prozedur 
+ 
+     select pen 
+ 
+reale Stifte zugeordnet werden. Voreingestellt ist für alle virtuellen 
+Stifte: Standardfarbe, Standardstärke, durchgängige Linie. 
+ 
+Indem man einigen virtuellen Stiften den leeren Stift als realen Stift zu- 
+ordnet, kann man einzelne PICTUREs ausblenden. Sowohl bei der Darstellung 
+von zwei- als auch dreidimensionaler Graphik kann die gewählte Zeichenfläche 
+auf dem Endgerät mit der Prozedur 
+ 
+     viewport 
+ 
+festgelegt werden. Voreingestellt ist das Quadrat mit der größtmöglichen 
+Seitenlänge, d.h. der kürzeren Seite der hardwaremäßigen Zeichenfläche. 
+ 
+ 
+ 
+Darstellung zweidimensionaler Graphik 
+ 
+Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt 
+(das 'Fenster') angegeben werden. Mit der Prozedur 
+ 
+     window 
+ 
+wird durch Angabe der minimalen und maximalen X- bzw. Y-Koordinaten ein 
+Fenster definiert. Da das so definierte Fenster auf die ganze (mit 'viewport' 
+definierbare) Zeichenfläche abgebildet wird, ist der Abbildungsmaßstab durch 
+das Zusammenspiel von 'viewport' und 'window' bestimmt. Da bei 'viewport' 
+standardmäßig das maximale Zeichenquadrat voreingestellt ist, wird in diesem 
+Fall durch gleiche X- und Y-Fenstergröße eine winkeltreue Darstellung er- 
+reicht. 
+ 
+ 
+ 
+Darstellung dreidimensionaler Graphik 
+ 
+Im dreidimensionalen Fall wird das Fenster ebenfalls mit 
+ 
+     window 
+ 
+definiert, wobei dann allerdings auch der Bereich der dritten Dimension 
+(Z-Koordinaten) zu berücksichtigen ist. Da die dreidimensionale Graphik auf 
+eine zweidimensionale Fläche projiziert wird, können aber noch weitere Dar- 
+stellungsparameter angegeben werden. Der Betrachtungswinkel wird mit Hilfe 
+der Prozedur 
+ 
+     view 
+ 
+angegeben. Zur Spezifikation der gewünschten Projektionsart gibt es 
+ 
+    orthographic          (* orthographische Projektion       *) 
+    perspective           (* perspektivische Projektion, 
+                             der Fluchtpunkt ist frei wählbar *) 
+    oblique               (* schiefwinklige Projektion        *) 
+ 
+ 
+ 
+Beispiel (Sinuskurve) 
+ 
+  funktion zeichnen; 
+  bild darstellen  . 
+ 
+funktion zeichen : 
+  PICTURE VAR pic :: nilpicture; 
+  REAL VAR x := -pi; 
+  move (pic, x, sin (x)); 
+  REP x INCR 0.1; 
+      draw (pic, x, sin (x)) 
+  UNTIL x >= pi PER  . 
+ 
+bild darstellen : 
+  PICFILE VAR p :: picture file ("sinus"); 
+  window (p, -pi, pi, -1.0, 1.0); 
+  put (p, pic); 
+  plot (p)  . 
+ 
+ 
+ 
+Beispiel (Würfel) 
+ 
+  wuerfel zeichen; 
+  wuerfel darstellen. 
+ 
+wuerfel zeichnen : 
+  zeichne vorderseite; 
+  zeichne rueckseite; 
+  zeichne verbindungskanten. 
+ 
+zeichne vorderseite : 
+  PICTURE VAR vorderseite :: nilpicture; 
+  move (vorderseite, 0.0, 0.0, 0.0); 
+  draw (vorderseite, 1.0, 0.0, 0.0); 
+  draw (vorderseite, 1.0, 0.0, 1.0); 
+  draw (vorderseite, 0.0, 0.0, 1.0); 
+  draw (vorderseite, 0.0, 0.0, 0.0). 
+ 
+zeichne rueckseite : 
+  PICTURE VAR rueckseite :: translate (vorderseite, 0.0, 1.0, 0.0). 
+ 
+zeichne verbindungskanten : 
+  PICTURE VAR verbindungskanten :: nilpicture; 
+  move (verbindungskanten, 0.0, 0.0, 0.0); 
+  draw (verbindungskanten, 0.0, 1.0, 0.0); 
+ 
+  move (verbindungskanten, 1.0, 0.0, 0.0); 
+  draw (verbindungskanten, 1.0, 1.0, 0.0); 
+ 
+  move (verbindungskanten, 1.0, 0.0, 1.0); 
+  draw (verbindungskanten, 1.0, 1.0, 1.0); 
+ 
+  move (verbindungskanten, 0.0, 0.0, 1.0); 
+  draw (verbindungskanten, 0.0, 1.0, 1.0). 
+ 
+wuerfel darstellen : 
+  PICFILE VAR p := picture file ("wuerfel"); 
+  put (p, vorderseite); 
+  put (p, rueckseite); 
+  put (p, verbindungskanten); 
+  window (p, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0); 
+  view (p, 0.0, 40.0, 20.0); 
+  orthographic (p); 
+  plot (p). 
+ 
+ 
+ 
+Beschreibung der Graphik-Prozeduren 
+ 
+Zweidimensionale PICTUREs brauchen weniger Speicherplatz als dreidimensio- 
+nale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen ange- 
+geben. 
+ 
+:= 
+    OP := (PICTURE VAR dest, PICTURE CONST source) 
+    Zweck: Zuweisung 
+ 
+    OP := (PICFILE VAR dest, DATASPACE CONST source) 
+    Zweck: Assoziiert die PICFILE Variable 'dest' mit der DATASPACE CONST 
+           'source' und initialisiert die PICFILE Variable sofern nötig. 
+    Fehlerfall: 
+        * dataspace is no PICFILE 
+          Der anzukoppelnde Datenraum hat einen falschen Typ. 
+ 
+CAT 
+    OP CAT (PICTURE VAR dest, PICTURE CONST source) 
+    Zweck: Aneinanderfügen von zwei PICTURE's. 
+    Fehlerfälle: 
+        * OP CAT: left dimension <> right dimension 
+          Es können nur PICTUREs mit gleicher Dimension angefügt werden. 
+        * OP CAT: Picture overflow 
+          Die beiden PICTURE überschreiten die maximale Größe eines Pictures. 
+ 
+act picture 
+    PICTURE PROC act picture (PICFILE VAR p) 
+    Zweck: Liefert das PICTURE des PICFILEs 'p', auf das mit 'backward' o.ä. 
+           positioniert wurde. 
+ 
+backward 
+    PROC backward (PICFILE VAR p) 
+    Zweck: Positioniert den PICFILE 'p' um ein PICTURE zurück. 
+    Fehlerfall: 
+        * backward at begin of file 
+          Es wurde versucht vor den Anfang des PICFILEs zu positionieren. 
+ 
+draw 
+    PROC draw (PICTURE VAR pic, REAL CONST x, y) 
+    Zweck: Die Prozedur zeichnet in dem (zweidimensionalen) Bild 'pic' eine 
+           Linie von der aktuellen Position zur Position (x, y). 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1927) 
+        * picture is three dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC draw (PICTURE VAR pic, REAL CONST x, y, z) 
+    Zweck: Die Prozedur zeichnet in dem (dreidimensionalen) Bild 'pic' eine 
+           gerade Linie von der aktuellen Position zur Position (x, y, z). 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) 
+        * picture is only two dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC draw (PICTURE VAR pic, TEXT CONST text) 
+    Zweck: Der angegebene Text wird in das Bild 'pic' eingetragen. Der An- 
+           fang ist dabei die aktuelle Stiftposition. Diese wird nicht ver- 
+           ändert. 
+    Fehlerfall: 
+        * picture overflow 
+          Der Text paßt nicht mehr in das PICTURE. 
+ 
+    PROC draw (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height) 
+    Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der 
+           Waagerechten und in der Größe 'height' in das PICTURE 'pic' 
+           eingetragen. Der Anfang ist dabei die aktuelle Stiftposition. 
+           Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picture overflow 
+          Der Text paßt nicht mehr in das PICTURE. 
+ 
+    PROC draw (PICFILE VAR pic, REAL CONST x, y) 
+    Zweck: Die Prozedur zeichnet in dem aktuellen (zweidimensionalen) 
+           PICTURE des PICFILEs 'p' eine gerade Linie. Der (virtuelle) Stift 
+           wird von der aktuellen Position zur Position (x, y) gefahren. 
+           Falls das aktuelle PICTURE zu voll ist, wird automatisch auf das 
+           nächste umgeschaltet. 
+    Fehlerfälle: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTURE) 
+        * picture is threedimensional 
+          Das aktuelle PICTURE ist dreidimensional. 
+ 
+    PROC draw (PICTFILE VAR pic, REAL CONST x, y, z) 
+    Zweck: s. o. 
+    Fehlerfälle: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+        * picfile is only twodimensional 
+          Das aktuelle PICTURE ist zweidimensional. 
+ 
+    PROC draw (PICTFILE VAR pic, TEXT CONST text) 
+    Zweck: Der angegebene Text wird in das aktuelle PICTURE des PICFILEs 'p' 
+           eingetragen. Falls das aktuelle PICTURE zu voll ist, wird auto- 
+           matisch auf das nächste umgeschaltet. Der Anfang ist dabei die 
+           aktuelle Stiftposition. Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+ 
+    PROC draw (PICFILE VAR pic, TEXT CONST text, REAL CONST angle, height) 
+    Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der 
+           Waagerechten und in der Größe 'height' in das aktuelle PICTURE 
+           des PICFILES 'p' eingetragen. Falls das aktuelle PICTURE zu voll 
+           ist, wird automatisch auf das nächste umgeschaltet. Der Anfang ist 
+           dabei die aktuelle Stiftposition. Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+ 
+eof 
+    BOOL PROC eof (PICFILE CONST p) 
+    Zweck: Liefert 'TRUE' wenn hinter das Ende des PICFILEs positioniert 
+           wurde. 
+ 
+extrema 
+    PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max) 
+    Zweck: Die Prozedur liefert die größten und kleinsten X- und Y-Koordi- 
+           naten des PICTUREs 'p'. Diese werden in die Parameter 'x min', 
+           'x max', 'y min' und 'y max' eingetragen. 
+ 
+    PROC extrema (PICTURE CONST p, 
+                          REAL VAR x min, x max, y min, y max, z min, z max) 
+    Zweck: s.o. 
+ 
+    PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) 
+    Zweck: s.o. 
+ 
+    PROC extrema (PICFILE VAR p, 
+                  REAL VAR x min, x max, y min, y max, z min, z max) 
+    Zweck: s.o. 
+ 
+forward 
+    PROC forward (PICFILE VAR p) 
+    Zweck: Positioniert den PICFILE um ein PICTURE weiter. 
+    Fehlerfall: 
+        * picfile overflow 
+          Es sollte hinter das Ende des PICFILEs positioniert werden. 
+ 
+get 
+    PROC get (PICFILE VAR p, PICTURE VAR pic) 
+    Zweck: Liest ein PICTURE aus einem PICFILE und positioniert auf das 
+           Nächste. 
+    Fehlerfall: 
+        * input after end of picfile 
+          Es sollte nach dem Ende des Picfiles gelesen werden. 
+ 
+move 
+    PROC move (PICTURE VAR pic, REAL CONST x, y) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1927 'moves') 
+        * picture is three dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC move (PICTURE VAR pic, REAL CONST x, y, z) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) 
+        * picture is only twodimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC move (PICFILE VAR p, REAL CONST x, y) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. Falls 
+           das aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird auto- 
+           matisch auf das nächste umgeschaltet. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) 
+ 
+    PROC move (PICFILE VAR p, REAL CONST x, y, z) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. Falls 
+           das aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird auto- 
+           matisch auf das nächste umgeschaltet. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) 
+ 
+nilpicture 
+    PICTURE PROC nilpicture 
+    Zweck: Die Prozedure liefert ein leeres PICTURE zur Initialisierung. 
+ 
+oblique 
+    PROC oblique (PICFILE VAR p, REAL CONST a, b) 
+    Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird 'schiefwinklig' als 
+           gewünschte Projektionsart eingestellt. Dabei ist (a, b) der Punkt 
+           in der X-Y-Ebene, auf den der Einheitsvector in Z-Richtung 
+           abgebildet werden soll. 
+ 
+orthographic 
+    PROC orthographic (PICFILE VAR p) 
+    Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird "orthografisch" als 
+           Projektionsart eingestellt. Bei der orthografischen Projektion 
+           wird ein dreidimensionaler Körper mit parallelen Strahlen senk- 
+           recht auf die Projektionsebene abgebildet. 
+ 
+pen 
+    INT PROC pen (PICTURE CONST pic) 
+    Zweck: Liefert die Nummer des 'virtuellen Stifts'. 
+ 
+    PICTURE PROC pen (PICTURE CONST pic, INT CONST pen) 
+    Zweck: Liefert ein PICTURE mit dem Inhalt 'pic' und dem 'virtuellen 
+           Stift' mit der Nummer 'pen'. Möglich sind die Nummern 1 - 16. 
+    Fehlerfälle: 
+        * PROC pen: pen [No] < 1 
+          Der gewünschte Stift ist kleiner als 1. 
+        * PROC pen: pen [No] > 16 
+          Der gewünschte Stift ist größer als 16. 
+ 
+perspective 
+    PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) 
+    Zweck: Bei den dreidimensionalen PICTUREs des PICFILE's 'p' wird 
+           "perspektivisch" als gewünschte Projektionsart eingestellt. Der 
+           Punkt (cx, cy, cz) ist der Fluchtpunkt der Projektion, d.h. alle 
+           Parallelen zur Blickrichtung schneiden sich in diesem Punkt. 
+ 
+pic no 
+    INT PROC pic no (PICFILE CONST p) 
+    Zweck: Liefert die Nummer des aktuellen PICTUREs. 
+ 
+picture file 
+    DATASPACE PROC picture file (TEXT CONST name) 
+    Zweck: Die Prozedur dient zur Assoziation eines benannten Datenraumes 
+           mit einem PICFILE (s. Operator ':='). 
+ 
+plot 
+    PROC plot (TEXT CONST name) 
+    Zweck: Der PICFILE mit dem Namen 'name' wird entspechend der angege- 
+           benen Darstellungsart gezeichnet. Diese Parameter ('perspective', 
+           'orthographic', 'oblique', 'view', 'window' etc.) müssen vorher 
+           eingestellt werden. 
+    Fehlerfall: 
+        * FILE does not exist 
+          Es existiert kein PICFILE mit dem Namen 'name' 
+ 
+    PROC plot (PICFILE VAR p) 
+    Zweck: Der PICFILE 'p' wird entspechend der angegebenen Darstellungsart 
+           gezeichnet. Diese Parameter müssen vorher eingestellt werden. 
+ 
+ 
+           Zweidimensional: 
+ 
+           obligat:      'window'     (zweidimensional) 
+           optional:     'view'       (zweidimensional) 
+                         'select pen' 
+                         'viewport' 
+ 
+           Dreidimensional: 
+ 
+           obligat:      'window'     (dreidimensional) 
+           optional:     'view'       (dreidimensional) 
+                         'orthographic', 'perspective', 'oblique' 
+                         'viewport' 
+                         'select pen' 
+ 
+put 
+    PROC put (PICFILE VAR p, PICTURE CONST pic) 
+    Zweck: Schreibt ein PICTURE in einen PICFILE und positioniert um eins 
+           vor. 
+    Fehlerfall: 
+        * picfile overflow 
+          Der PICFILE ist voll. (z. Z. max. 128 PICTURE) 
+ 
+reset 
+    PROC reset (PICFILE VAR p) 
+    Zweck: Positioniert auf den Anfang eines Picfiles. 
+ 
+rotate 
+    PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha) 
+    Zweck: Das PICTURE 'pic' wird um den Punkt (0, 0) um den Winkel 'alpha' 
+           (im Gradmaß) im mathematisch positiven Sinn gedreht. 
+ 
+    PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha, beta, gamma) 
+    Zweck: Das dreidimensionale PICTURE 'pic' wird um den Winkel 'alpha', 
+           'beta' oder 'gamma' im mathematisch positiven Sinn gedreht. Der 
+           Winkel 'alpha' dreht um die X-Achse, der Winkel 'beta' um die 
+           Y-Achse und 'gamma' um die Z-Achse. Es darf dabei nur jeweils 
+           ein Winkel von 0.0 verschieden sein. Alle Winkel werden im 
+           Gradmaß angegeben. 
+ 
+select pen 
+    PROC select pen (PICFILE VAR p, 
+                                 INT CONST pen, colour, thickness, linetype) 
+    Zweck: Für die Darstellung des Bildes 'p' soll dem "virtuellen Stift" 
+           'pen' ein realer Stift zugeordnet werden, der möglichst die Farbe 
+           'colour' und die Dicke 'thickness' hat und dabei Linien mit dem 
+           Typ 'line type' zeichnet. Es wird die beste Annäherung für das 
+           Ausgabegerät für diese Parameter genommen. Dabei gelten folgende 
+           Vereinbarungen: 
+ 
+           Farbe: negative Farben setzten den Hintergrund, positive Farben 
+                  zeichnen im Vordergrund. 
+ 
+                    0   Löschstift (falls vorhanden) 
+                    1   Standardfarbe des Endgeräts (schwarz oder weiß) 
+                    2   rot 
+                    3   blau 
+                    4   grün 
+                    5   schwarz 
+                    6   weiß > 20   nicht normierte Sonderfarben 
+ 
+           Dicke: 0 
+                  Standardstrichstärke des Endgerätes > 0 
+                  Strichstärke in 1/10 mm 
+ 
+           Typ: 
+                    0   keine sichtbare Linie 
+                    1   durchgängige Linie 
+                    2   gepunktete Linie 
+                    3   kurz gestrichelte Linie 
+                    4   lang gestrichelte Linie 
+                    5   Strichpunktlinie 
+ 
+           Die hier aufgeführten Möglichkeiten müssen nicht an allen 
+           grafischen Endgeräten vorhanden sein. Der geräteabhängige 
+           Graphik-Treiber wählt jeweils die für ihn bestmögliche Annäherung. 
+ 
+    Fehlerfälle: 
+        * pen < 1 
+        * pen > 16 
+ 
+size 
+    INT PROC size (PICFILE CONST p) 
+    Zweck: Liefert die aktuelle Größe eines PICFILEs in Bytes. 
+ 
+stretch 
+    PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc) 
+    Zweck: Das PICTURE 'pic' wird in X-Richtung um den Faktor 'xc', in 
+           Y-Richtung um den Faktor 'yc' gestreckt (bzw. gestaucht). Dabei 
+           bewirkt der Faktor 
+                   c > 1     eine Streckung 
+               0 < c < 1     eine Stauchung 
+                   c < 0     zusätzlich eine Achsenspiegelung 
+ 
+    PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc, zc) 
+    Zweck: Das dreidimensionale PICTURE 'pic' wird entsprechend den 
+           angegeben Faktoren 'xc', 'yc' und 'zc' gestreckt. Wirkung s.o. 
+ 
+translate 
+    PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy) 
+    Zweck: Das PICTURE 'pic' wird um 'dx' und 'dy' verschoben. 
+    Fehlerfall: 
+        * picture is threedimensional 
+          'pic' ist dreidimensional. 
+ 
+    PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy, dz) 
+    Zweck: Das PICTURE 'pic' wird um 'dx', 'dy' und 'dz' verschoben. 
+    Fehlerfall: 
+        * picture is twodimensional 
+          Das PICTURE 'pic' ist zweidimensional 
+ 
+two dimensional 
+    PROC two dimensional (PICFILE VAR p) 
+    Zweck: Setzt als Projektionsart zweidimensional. 
+ 
+view 
+    PROC view (PICFILE VAR p, REAL CONST alpha, phi, theta) 
+    Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne 
+           dargestellt, sondern für die Betrachtung gedreht. Mit der Prozedur 
+           'view' kann diese Betrachtungsrichtung durch die Polarwinkel 'phi' 
+           und 'theta' angegeben werden. Mit dem Winkel 'alpha' kann dann 
+           das Bild um den Mittelpunkt der Zeichenfläche gedreht werden. 
+           Dadurch kann ein Bild auch auf einem Terminal hochkant gestellt 
+           werden. Voreingestellt ist 'phi = 0, theta = 0 und alpha = 0', 
+           d.h. direkt von oben. 
+ 
+           Im Gegensatz zu 'rotate' hat 'view' keine Wirkung auf das eigent- 
+           liche Bild (PICFILE), sondern nur auf die gewählte Darstellung. 
+           So addieren sich zwar aufeinanderfolgende "Rotationen", 'view' 
+           aber geht immer von der Nullstellung aus. Auch kann das Bild 
+           durch eine "Rotation" ganz oder teilweise aus oder in das Dar- 
+           stellungsfenster ('window') gedreht werden. Bei 'view' verändern 
+           sich die Koordinaten der Punkte nicht, d.h. das Fenster wird mit- 
+           gedreht. 
+ 
+viewport 
+    PROC viewport (PICFILE VAR p, 
+                               REAL CONST hormin, hormax, vertmin, vertmax) 
+    Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt 
+           werden soll, wird spezifiziert. Dabei wird sowohl die Größe als 
+           auch die relative Lage der Zeichenfläche definiert. Der linke 
+           untere Eckpunkt der physikalischen Zeichenfläche des Gerätes hat 
+           die Koordinaten (0.0, 0.0). Die definierte Zeichenfläche erstreckt 
+           sich   
+ 
+                'hormin'  - 'hormax'     in der Horizontalen, 
+                'vertmin' - 'vertmax'    in der Vertikalen. 
+ 
+           So liegt der linke untere Eckpunkt dann bei (hormin, vertmin), der 
+           rechte obere bei (hormax, vertmax). 
+ 
+           Damit sowohl geräteunabhängige als auch maßstabsgerechte 
+           Zeichnungen möglich sind, können die Koordinaten in zwei Arten 
+           spezifiziert werden : 
+ 
+           a) Gerätekoordinaten 
+              Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei 
+              hat die kürzere Seite der physikalischen Zeichenfläche defini- 
+              tionsgemäß die Länge 1.0. 
+ 
+           b) absolute Koordinaten 
+              Die Werte werden in cm angegeben. Für die Maximalwerte sind 
+              nur Werte größer als 2.0 möglich. 
+ 
+           Voreingestellt ist 
+ 
+                viewport (0.0, 1.0, 0.0, 1.0), 
+ 
+           d.h. das größtmöglichste Quadrat, beginnend in der linken unteren 
+           Ecke der physikalischen Zeichenfläche. In vielen Fällen wird 
+           diese Einstellung ausreichen, so daß der Anwender kein eigenes 
+           'viewport' definieren muß. 
+ 
+           Der Abbildungsmaßstab wird durch das Zusammenspiel von 'viewport' 
+           und 'window' festgelegt (siehe dort). Dabei ist insbesondere 
+           darauf zu achten, daß winkeltreue Darstellungen nur bei gleichem 
+           X- und Y-Maßstab möglich sind. Da man oft quadratische Fenster 
+           ('window') verwendet, wurde als Standardfall auch ein quadrati- 
+           sches 'viewport' gewählt. 
+ 
+where 
+    PROC where (PICTURE CONST pic, REAL VAR x, y) 
+    Zweck: Die aktuelle Stiftposition wird in 'x' und 'y' eingetragen. 
+    Fehlerfall: 
+        * picture is threedimensional 
+          Das PICTURE 'pic' ist dreidimensional 
+ 
+    PROC where (PICTURE CONST pic, REAL VAR x, y, z) 
+    Zweck: Die aktuelle Stiftposition wird in 'x', 'y' und 'z' eingetragen. 
+    Fehlerfall: 
+        * picture is twodimensional 
+          Das PICTURE 'pic' ist zweidimensional 
+ 
+window 
+    PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) 
+    Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das 
+           darzustellende Fenster definiert. Alle Bildpunkte, deren X-Ko- 
+           ordinaten im Intervall [x min, x max] und deren Y-Koordinaten im 
+           Intervall [y min, y max] liegen, gehören zum definierten Fenster. 
+           Vektoren, die über dieses Fenster hinausgehen, werden abge- 
+           schnitten. Dieses Fenster wird auf die spezifizierte Zeichen- 
+           fläche abgebildet. (Das ist standardmäßig das größtmögliche 
+           Quadrat auf dem ausgewählten Gerät). 
+ 
+           Der Darstellungsmaßstab ergibt sich als 
+ 
+                                x max - x min 
+                  ----------------------------------------- 
+                  horizontale Seitenlänge der Zeichenfläche 
+ 
+                                y max - y min 
+                  ----------------------------------------- 
+                   vertikale Seitenlänge der Zeichenfläche 
+ 
+            Für eine winkeltreue Darstellung müssen X- und Y-Maßstab 
+            gleich sein! Einfach können winkeltreue Darstellung erreicht 
+            werden, wenn das Fenster eine quadratische Form hat. Die 
+            Zeichenfläche ('viewport') ist dementsprechend als Quadrat vor- 
+            eingestellt. 
+ 
+    PROC window (PICFILE VAR p, 
+                 REAL CONST x min, x max, y min, y max, z min, z max) 
+    Zweck: Für die Darstellung eines dreidimensionalen Bildes wird das darzu- 
+           stellende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im
+           Intervall [x min, x max] und deren Y-Koordinaten im Intervall 
+           [y min, y max] und deren Z-Koordinaten im Intervall [z min, z max] 
+           liegen, gehören zum definierten Fenster. Dieses dreidimensionale 
+           Fenster (Quader) wird entsprechend der eingestellten Projektions- 
+           art (orthografisch, perspektivisch oder schiefwinklig) und den 
+           Betrachtungswinkeln (s. 'view') auf die spezifizierte Zeichen- 
+           fläche abgebildet. (Das ist standardmäßig das größtmögliche 
+           Quadrat auf dem ausgewählten Gerät.) Linien, die außerhalb dieses 
+           Quadrates liegen, werden abgeschnitten. 
+ 
+           Anders als im zweidimensionalen Fall ist das Problem der Maßstäbe 
+           nicht mehr nur durch das Zusammenspiel von 'window' und 'view- 
+           port' zu beschreiben. Hier spielen auch Projektionsart und Dar- 
+           stellungswinkel eine Rolle. Falls alle Darstellungswinkel den 
+           Wert 0.0 haben, gilt das für den zweidimensionalen Fall gesagte 
+           für die Ebene (y = 0.0) entsprechend. 
+ 
+write is possible 
+    BOOL PROC write is possible (PICTURE CONST pic, INT CONST space) 
+    Zweck: Liefert 'TRUE', falls 'space' Bytes Platz in 'pic' vorhanden ist. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11
new file mode 100644
index 0000000..cae9c50
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11
@@ -0,0 +1,1072 @@
+                       EUMEL-Benutzerhandbuch 
+ 
+                          TEIL 11: Utilities                         
+ 
+ 
+In diesem Teil werden einige Dienstprogramme aufgeführt. Diese Programme 
+sind bei speziellen Anwendungen nützlich. 
+ 
+ 
+ 
+1. Scanner 
+ 
+Der Scanner zerlegt einen TEXT in Symbole bzw. "Tokens" entsprechend der 
+ELAN-Sprachdefinition. 
+ 
+Der Scanner kann benutzt werden, um festzustellen, welche Art von Symbolen 
+in einem TEXT enthalten sind. Die Repräsentation der Symbole müssen dabei 
+der ELAN-Syntax entsprechen. Folgende #ib#Symbole#ie# kann der Scanner 
+erkennen: 
+ 
+   - "tags", d.h. Namen, 
+   - "bolds", d.h. Schlüsselworte, 
+   - "number", d.h. INT oder REAL Zahlen, 
+   - Operatoren, 
+   - "delimiter", d.h. Begrenzer wie z.B. ";", 
+   - und das Ende des Scan-Textes. 
+ 
+ 
+Der Scanner überliest Kommentare und Leerzeichen zwischen den Symbolen. 
+Der (erste) zu verarbeitende Text muß mit der Prozedur 
+ 
+     scan 
+ 
+in den Scanner "hineingesteckt" werden. Mit der Prozedur 
+ 
+     next symbol 
+ 
+wird das jeweils nächste Symbol des TEXTes geholt. Am Ende wird "end of scan" 
+und als Symbol 'niltext' geliefert. Falls innerhalb eines TEXT-Denoters oder 
+eines Kommentars "end of scan" auftritt, wird "within text" bzw. "within 
+comment" gemeldet. Der Scan-Prozeß kann dann mit dem nächsten zu scannenden 
+TEXT (der nächsten Zeile) fortgesetzt werden. Dafür wird nicht die Prozedur 
+'scan', sondern 
+ 
+     continue scan 
+ 
+verwandt. Sie setzt im letzten Scan-Zustand (z.B. Kommentar oder TEXT- 
+Denoter) wieder auf, so daß auch Folgen von TEXTen (Zeilen) wie z.B. Dateien 
+leicht gescannt werden können. 
+ 
+Mit den Prozeduren 
+ 
+     scan              (* meldet eine Datei zum scannen an *) 
+     next symbol       (* holt die Symbole                 *) 
+ 
+kann man auch eine Datei nach ELAN-Symbolen untersuchen. Beispiel: 
+ 
+     FILE VAR f :: ... 
+     ... 
+     scan (f);          (* beginnt das Scanning in der nächsten Zeile *) 
+     TEXT VAR symbol; 
+     INT VAR type; 
+     REP 
+       next symbol (f, symbol, type); 
+       verarbeite symbol 
+     UNTIL type >= 7 END REP. 
+ 
+Merke: Mit dem Scanner kann man einen ELAN-Text analysieren. 
+ 
+ 
+ 
+Scanner-Kommandos 
+ 
+continue scan 
+     PROC continue scan (TEXT CONST scan text) 
+     Zweck: Das Scanning soll mit 'scan text' fortgesetzt werden. Falls der 
+            Scan-Vorgang beim vorigen 'scan text' innerhalb eines TEXT- 
+            Denoters oder eines Kommentars abgebrochen wurde, wird er jetzt 
+            entsprechend mit dem nächsten 'next symbol' fortgesetzt. Der 
+            erste Teil-Scan einer Folge muß aber stets mit 'scan' einge- 
+            leitet werden! 
+ 
+next symbol 
+     PROC next symbol (TEXT VAR symbol, INT VAR type) 
+     Zweck: Holt das nächste Symbol. In "symbol" steht der TEXT des Symbols, 
+            so z.B. die Ziffern eines INT-Denoters. Bei TEXT-Denotern 
+            werden die führenden und abschließenden Anführungsstriche ab- 
+            geschnitten. Leerzeichen oder Kommentare spielen in "tags" oder 
+            "numbers" keine Rolle. Zwischen Symbolen spielen Leerzeichen 
+            oder Kommentare keine Rolle. In "type" steht eine Kennzeichung 
+            für den Typ des Symbols: 
+ 
+               tag             = 1 , 
+               bold            = 2 , 
+               number          = 3 , 
+               text            = 4 , 
+               operator        = 5 , 
+               delimiter       = 6 , 
+               end of file     = 7 , 
+               within comment  = 8 , 
+               within text     = 9 . 
+ 
+            Wird Scan-Ende innerhalb eines Kommentars gefunden, so wird 
+            'niltext' und 'within comment' geliefert. Wird Scan-Ende inner- 
+            halb eines TEXT-Denoters gefunden, so wird der schon analysierte 
+            Teil des Denoters und 'within text' geliefert. 
+ 
+     PROC next symbol (TEXT VAR symbol) 
+     Zweck: s.o. Es wird aber nur der Text des Symbols (ohne Typ) geliefert. 
+ 
+     PROC next symbol (FILE VAR f, TEXT CONST symbol) 
+     Zweck: arbeitet wie obige Prozeduren, jedoch auf einen FILE. 
+ 
+     PROC next symbol (FILE VAR f, TEXT CONST symbol, INT VAR type) 
+     Zweck: arbeitet wie obige Prozeduren, jedoch auf einen FILE. 
+ 
+scan 
+     PROC scan (TEXT CONST scan text) 
+     Zweck: Meldet einen 'scan text' für den Scanner zur Verarbeitung an. 
+            Die Prozedur 'scan' muß vor dem ersten Aufruf von 'next symbol' 
+            gegeben werden. Im Gegensatz zu 'continue scan' normiert 'scan' 
+            den inneren Zustand des Scanners, d.h. vorherige Scan-Vorgänge 
+            haben keinen Einfluß mehr auf das Scanning. 
+ 
+     PROC scan (FILE VAR f) 
+     Zweck: Wie obige Prozedur, jedoch auf einen FILE. Die zu scannende Zeile 
+            ist die nächste Zeile im FILE 'f' ('scan' macht zuerst ein 'get- 
+            line'). 
+ 
+ 
+ 
+2. Inspector 
+ 
+Der Inspector stellt ein Hilfsmittel bei der Programmentwicklung dar. 
+ 
+Der Inspector informiert über alle 
+ 
+   - insertierten Prozeduren / Operatoren mit dem gleichen Namen 
+   - Prozeduren / Operatoren / Typen, die ein Paket definiert 
+   - bisher insertierten Pakete 
+   - insertierten Prozeduren / Operatoren / Typen. 
+ 
+Mit dem Aufruf von 
+ 
+     help ("name") 
+ 
+wird eine Liste aller Prozeduren / Operatoren, die 'name' heißen, auf dem 
+Bildschirm ausgegeben. Die Liste ist paketweise sortiert unter Angabe des 
+Paketnamens. Die Ausgabe erfolgt mit der Angabe der Parametertypen. Gibt es 
+kein Objekt mit dem angegebenen Namen, so erscheint die Ausgabe 
+ 
+     unbekannt: name 
+ 
+Das Kommando 
+ 
+     bulletin ("paket name") 
+ 
+informiert über alle Objekte, die in der DEFINES-Liste des Pakets mit dem 
+Namen "paket name" stehen. Die Ausgabe erfolgt wie beim list-Kommando. 
+ 
+Eine gesamte Liste aller bisher insertierten Prozeduren/Operatoren/Typen 
+erhält man mit dem Kommando 
+ 
+     bulletin 
+ 
+Bei diesen Funktionen ist (noch) zu beachten, daß Typen immer dem textmäßig 
+vorhergehendem Paket zugeordnet werden. Der Grund hierfür liegt in der 
+Behandlung abstrakter Datentypen im ELAN-Compiler. Eine Korrektur ist für 
+spätere Auslieferungen geplant. 
+ 
+Mit 
+ 
+     packets 
+ 
+werden die Namen aller bisher insertierten Pakete "gelistet". 
+ 
+Merke: Mit 'help' kann man sich über verfügbare Prozeduren/Operatoren in- 
+formieren. 
+ 
+ 
+ 
+Inspector-Kommandos 
+ 
+help 
+     PROC help (TEXT CONST name) 
+     Zweck: Listen aller Prozeduren / Operatoren mit dem Namen "name". Die 
+            Ausgabe erfolgt direkt auf den Bildschirm. 
+ 
+bulletin 
+     PROC bulletin (TEXT CONST paket name) 
+     Zweck: Listen aller in der DEFINES-Liste des Pakets mit dem Namen 
+            "paket name". 
+ 
+      PROC bulletin 
+      Zweck: Es wird eine Liste aller bisher insertierter Objekte erstellt. 
+             Diese Liste ist paketweise sortiert. 
+ 
+packets 
+      PROC packets 
+      Zweck: Auflisten der Namen aller bisher insertierten Pakete. 
+ 
+ 
+ 
+3. Lexikographische Vergleiche 
+ 
+Die üblichen Operatoren für TEXTe arbeiten mit dem der Reihenfolge des EUMEL- 
+Zeichencodes. Hier wird beschrieben, wie man lexikographische Vergleiche 
+nach DIN erhält. 
+ 
+Für TEXT-Vergleiche nach DIN 5007 gibt es die Operatoren 
+ 
+     LEXEQUAL 
+     LEXGREATER 
+     LEXGREATEREQUAL 
+ 
+Diese Operatoren vergleichen zwei TEXTE nach DIN 5007 mit folgenden 
+Bedingungen: 
+ 
+- Die Reihenfolge enspricht 'ABC...Z', wobei große und kleine Buchstaben 
+  gleich behandelt werden. 
+ 
+- Weitere Entsprechungen: 
+  ö = oe, ä = ae, ü = ue 
+  Ö = Oe, Ü = Ue, Ä = Ae, 
+  Ä = ä, Ü = ü, Ö = ö, 
+  ß = ss 
+  Dadurch ist z.B. 
+ 
+     "muß" LEXGREATER "Muster" --> FALSE 
+     "Goethe" LEXEQUAL "Göthe" --> TRUE 
+ 
+- Alle Sonderzeichen (außer " " und "-") werden ignoriert. 
+ 
+- Ein Leerzeichen und ein Bindestrich zwischen Worten werden gleich behan- 
+  delt. Beispiel: 
+ 
+     "EUMEL System" LEXEQUAL "EUMEL-System" --> TRUE 
+ 
+Anmerkung: Diese drei Operatoren sind - sofern die oben erwähnten Zeichen in 
+den Operanden vorkommen - langsamer als die "normalen" TEXT-Vergleiche 
+(=, >, <, usw.). Das liegt daran, daß die Operanden in solchen Fällen 
+umgewandelt werden. 
+ 
+ 
+ 
+Lexikographische Operatoren 
+ 
+LEXEQUAL 
+     BOOL OP LEXEQUAL (TEXT CONST l, r) 
+     Zweck: Lexikographischer Vergleich von 'l' und 'r' auf Gleichheit. 
+ 
+LEXGREATER 
+     BOOL OP LEXGREATER (TEXT CONST l, r) 
+     Zweck: Lexikographischer Vergleich von 'l' und 'r' auf "Grösser". 
+ 
+LEXGREATEREQUAL 
+     BOOL OP LEXGREATEREQUAL (TEXT CONST l, r) 
+     Zweck: Lexikographischer Vergleich von 'l' und 'r' auf "Grösser Gleich". 
+ 
+ 
+ 
+4. Der 'reporter' 
+ 
+Das Programm 'reporter' dient zur Fehlersuche und/oder Lokalisierung von 
+besonders häufig durchlaufenen Programmteilen. Zu diesem Zweck werden in ein 
+Programm Prozeduraufrufe eingefügt, die veranlassen, daß bestimmte Informa- 
+tionen (normalerweise Ablaufinformationen) in eine Datei (die TRACE-Datei) 
+geschrieben werden. 
+ 
+'reporter' ermöglicht 
+ 
+a) Ablaufinformationen ("trace"); 
+b) Häufigkeitszählung ("frequency count"); 
+c) Programmunterbrechung bei Nichterfüllung einer Bedingung ("assertion"). 
+ 
+ 
+ 
+Installation von 'reporter' 
+ 
+Das Programm befindet sich in der Datei 'reporter' und kann wie üblich in- 
+sertiert werden. Jedoch muß es mit 'check off' übersetzt werden, damit keine 
+Zeilennummern für 'reporter' generiert werden. Dies ist notwendig, damit die 
+Zeilennummern des zu testenden Programms nicht mit den Zeilennummern des 
+Programms 'reporter' verwechselt werden können. Beispiel: 
+ 
+     check off; insert ("reporter"); check on 
+ 
+ 
+ 
+Vorbereitungen 
+ 
+Mit dem Kommando 
+ 
+     generate reports ("testdatei") 
+ 
+werden die oben erwähnten Prozeduraufrufe ('report') in  das zu testende 
+Programm, welches in der Datei 'testdatei' steht, geschrieben. Die Prozedur- 
+aufrufe werden nach jedem Prozedur-, Operator- oder Refinement-Kopf 
+eingefügt und erhalten den entsprechenden Namen als Parameter. Diese 
+Prozeduraufrufe werden gekennzeichnet, damit sie von der Prozedur 
+ 
+     eliminate reports ("testdatei") 
+ 
+automatisch wieder entfernt werden können. Beispiel (für die eingefügten 
+Prozeduraufrufe): 
+ 
+    ... 
+    PROC beispiel (INT CONST mist): 
+    ##report ("beispiel");## 
+    ... 
+ 
+ 
+ 
+Automatische Ablaufinformationen 
+ 
+Ist ein Programm mit 'generate reports' mit 'report'-Aufrufen versehen 
+worden, kann es wie gewohnt übersetzt werden. Wird das Programm vom ELAN- 
+Compiler korrekt übersetzt und dann gestartet, wird bei jedem Antreffen 
+eines 'report'-Aufrufs der Parameter (Name der Prozedur, Operator oder 
+Refinement) in eine Datei, die TRACE-Datei geschrieben. Die TRACE-Datei wird 
+beim Programmlauf automatisch von 'reporter' unter dem Namen 'TRACE' einge- 
+richtet. 
+ 
+Mit Hilfe dieser Datei kann der Programmablauf verfolgt werden. Es ist damit 
+auch möglich festzustellen, wo eine "Endlos-Rekursion" auftritt. Die Ablauf- 
+informationen bestehen nur aus den Namen der angetroffenen Prozeduren und 
+Refinements. Trotzdem können die Anzahl der Informationen sehr umfangreich 
+werden. Deshalb gibt es die Möglichkeit, die Erzeugung der Ablaufinforma- 
+tionen ab- bzw. wieder anzuschalten. Dazu gibt es die Möglichkeit, in das zu 
+testende Programm die Prozeduren 
+ 
+     report on 
+     report off 
+ 
+einzufügen und das zu testende Programm mit diesen Prozeduraufrufen (erneut) 
+zu übersetzen. 
+ 
+ 
+ 
+Benutzereigene Ablaufinformationen 
+ 
+Zusätzlich zu den von 'generate reports' eingefügten 'report'-Aufrufen kann 
+ein Benutzer eigene Aufrufe an geeigneten Stellen in ein Programm schreiben. 
+Dafür werden weitere 'report'-Prozeduren zur Verfügung gestellt, die als 
+ersten Parameter ein TEXT-Objekt (meist Name des Objekts oder der Ausdruck 
+selbst) und als zweiten ein INT/REAL/TEXT/ BOOL-Objekt (der zu überprüfende 
+Wert oder Ausdruck) enthalten. Beispiel: 
+ 
+    ... 
+    PROC beispiel (INT CONST mist): 
+    ##report ("beispiel");##     (* automatisch eingefuegte *) 
+    INT VAR mist :: ...; ... 
+    ##report ("mist:", mist);##  (* vom Benutzer per Hand eingefuegt *) 
+    ... 
+ 
+Folgende 'report'-Routinen stehen zur Verfügung, damit man sie "von Hand" in 
+ein zu testendes Programm einfügen kann: 
+ 
+     PROC report on 
+     PROC report off 
+     PROC report (TEXT CONST message) 
+     PROC report (TEXT CONST message,  INT CONST value) 
+     PROC report (TEXT CONST message, REAL CONST value) 
+     PROC report (TEXT CONST message, TEXT CONST value) 
+     PROC report (TEXT CONST message, BOOL CONST value) 
+ 
+Wichtig: Hier - wie bei allen anderen "von Hand eingefügten" Aufrufen - 
+sollte ein Nutzer sich an die Konvention halten, diese in "##" einzuklammern. 
+Mit 'eliminate reports' werden diese Einfügungen automatisch entfernt. 
+Sollen diese Aufrufe aber immer im Programm erhalten bleiben (jedoch nicht 
+wirksam sein), sollten sie 
+ 
+a) vor 'generate reports'-Aufruf mit jeweils '###' eingefaßt werden. 
+   Beispiel: 
+   ### report ("...") ### 
+   So steht das 'report'-Statement in einem Kommentar. 'generate reports' 
+   wandelt '###' --> '####' um, so daß ein solches Statement wirksam wird. 
+   'eliminate reports' wandelt ein '####' --> '###' zurück. 
+ 
+b) nach 'generate reports' in '####' eingefaßt werden. 
+ 
+ 
+ 
+Häufigkeitszählung 
+ 
+Eine Häufigkeitszählung erhält man, in dem man in das zu testende Programm 
+die Aufrufe 
+ 
+     count on 
+     count off 
+ 
+einfügt. Ist die Häufigkeitszählung eingeschaltet, merkt sich 'reporter' die 
+Anzahl der Durchläufe für jede Prozedur bzw. Refinement. Mit der Prozedur 
+ 
+     generate counts ("zu testende datei") 
+ 
+werden die vermerkten Häufigkeiten in das zu testende Programm direkt einge- 
+fügt. Die Häufigkeiten werden wie oben beschrieben gekennzeichnet, so daß sie 
+mit 'eliminate reports' entfernt werden können. 
+ 
+ 
+ 
+Assertions 
+ 
+Zusätzlich zu den oben erwähnten Möglichkeiten bietet 'reporter' noch die 
+Prozedur 
+ 
+     assert 
+ 
+an. Diese Prozedur kann von einem Programmierer an einer Stelle in das zu 
+testende Programm eingefügt werden, an der bestimmte Bedingungen erfüllt sein 
+müssen. Die Prozedur 'assert' steht in zwei Formen zur Verfügung: 
+ 
+     PROC assert (BOOL CONST zusicherung) 
+     PROC assert (TEXT CONST message, BOOL CONST zusicherung) 
+ 
+Ist der Wert von 'zusicherung' nicht TRUE, wird der Programmlauf abgebrochen. 
+ 
+ 
+ 
+'reporter'-Kommandos 
+ 
+count on 
+    PROC count on 
+    Zweck: Schaltet die Häufigkeitszählung ein. 
+ 
+count off 
+    PROC count off 
+    Zweck: Schaltet die Häufigkeitszählung aus. 
+ 
+eliminate reports 
+    PROC eliminate reports (TEXT CONST datei) 
+    Zweck: Entfernt gekennzeichnete 'report'-Aufrufe aus der Datei 'datei'. 
+ 
+generate reports 
+    PROC generate reports (TEXT CONST datei) 
+    Zweck: Fügt 'report'-Aufrufe in die Datei 'datei' ein und kennzeichnet 
+           diese mit '##'. 
+ 
+report on 
+    PROC report on 
+    Zweck: Schaltet die Ablaufinformationen in die Datei 'TRACE' ein. 
+ 
+report off 
+    PROC report off 
+    Zweck: Schaltet die Ablaufinformationen wieder aus. 
+ 
+generate counts 
+    PROC generate counts (TEXT CONST datei) 
+    Zweck: Bringt die Häufigkeitszählung (wie oft eine Prozedur oder Refine- 
+           ment durchlaufen wurde) in die Programmdatei 'datei'. Mit 
+           'eliminate reports' werden diese wieder automatisch entfernt. 
+ 
+assert 
+    PROC assert (TEXT CONST message, BOOL CONST value) 
+    Zweck: Schreibt 'message' und den Wert von 'value' in die TRACE-Datei. 
+           Ist 'value' FALSE, wird angefragt, ob das Programm fortgesetzt 
+           werden soll. 
+ 
+ 
+ 
+5. Referencer 
+ 
+Das Programm 'referencer' erstellt aus einem (syntaktisch korrektem) ELAN- 
+Programm eine Liste, in der jedes Auftreten eines Objekts mit der betref- 
+fenden Zeilennummer verzeichnet ist. 
+ 
+ 'referencer' wird durch 
+ 
+     referencer ("ref datei", "referenz liste") 
+ 
+aufgerufen, wobei die Datei 'referenz liste' nicht existieren darf. 
+'referenz liste' enthält nach Ablauf des Programms die gewünschte Liste, die 
+sogenannte Referenzliste. 
+ 
+Achtung: 'referencer' arbeitet ausschließlich mit Namen und verarbeitet nur 
+wenige syntaktische Konstrukte. Darum ist es nur erlaubt, ein PACKET auf 
+einmal von 'referencer' verarbeiten zu lassen. Verarbeitet man mehrere 
+PACKETs auf einmal, kann es geschehen, daß gleichnamige Objekte in unter- 
+schiedlichen Paketen zu Warnungen (vergl. die unten beschriebenen Überprü- 
+fungen) führen. 
+ 
+In der Referenzliste sind 
+ 
+- alle Objekte mit ihrem Namen (in der Reihenfolge ihres Auftretens im 
+  Programm) 
+ 
+- alle Zeilennummern, in der das Objekt angesprochen wird 
+ 
+- die Zeilennummern, in der das Objekt deklariert wurde ('L' für ein lokales 
+  und 'G' für ein globales Objekt, 'R' für ein Refinement) 
+ 
+verzeichnet. 
+ 
+Die Referenzliste kann u.a. dazu dienen, zu kontrollieren, ob und wie (bzw. 
+wo) ein Objekt angesprochen wird. Dies lohnt sich selbstverständlich nur bei 
+etwas umfangreicheren Programmen (bei "Mini"-Programmen kann man dies sofort 
+sehen). 
+ 
+Bei der Erstellung der Referenzliste nimmt das Programm 'referencer' gleich- 
+zeitig einige Überprüfungen vor, die helfen können, ein Programm zu ver- 
+bessern: 
+ 
+1. Warnung bei mehrzeiligen Kommentaren. 
+ 
+2. Überdeckungsfehler. Wird ein Objekt global (auf PACKET-Ebene) und noch- 
+   mals lokal in einer Prozedur deklariert, ist das globale Objekt nicht mehr 
+   ansprechbar. Überdeckungen sind nach der gültigen Sprachdefinition z.Zt. 
+   noch erlaubt, werden aber bei einer Revision des Sprachstandards verboten 
+   sein. 
+ 
+3. Mehrmaliges Einsetzen von Refinements. Wird ein Refinement mehrmals einge- 
+   setzt (das ist völlig legal), sollte man überlegen, ob sich dieses Refine- 
+   ment nicht zu einer Prozedur umgestalten läßt. 
+ 
+4. Nicht angewandte Refinements. Wird ein Refinement zwar deklariert, aber 
+   nicht "aufgerufen", erfolgt eine Warnung. 
+ 
+5. Nicht angesprochene Daten-Objekte. Werden Daten-Objekte zwar deklariert, 
+   aber im folgenden nicht angesprochen, wird eine Warnung ausgegeben. 
+   Hinweis: Alle Objekte, die nur wenig angesprochen werden, also nur wenige 
+   Zeilennummern in der Referenzliste besitzen, sind verdächtig (Ausnahmen: 
+   importierte Prozeduren, LET-Objekte u.a.m.). 
+ 
+ 
+ 
+'referencer'-Kommandos 
+ 
+referencer 
+    PROC referencer (TEXT CONST check file, dump file) 
+    Zweck: Überprüft 'check file'. In 'dump file' steht nach Abschluß die 
+           Referenzliste. 
+ 
+ 
+ 
+6. Notizen (Notizbuch, Fehlerprotokoll) 
+ 
+Das Notizbuch erlaubt es u.a., Fehlermeldungen zwischenzeitig zu speichern 
+und am Ende einer Verarbeitung die Fehlermeldungen zusammen mit dem bear- 
+beiteten Text im Paralleleditor anzuzeigen. 
+ 
+Das Notizbuch wird eingesetzt, wenn Texte bearbeitet werden, die gewissen 
+Regeln entsprechen müssen (Beispiele: ELAN-Compiler, Textkosmetik usw.). In 
+solchen Fällen ist es nützlich, die Fehlermeldungen zwischenzeitig zu 
+speichern und erst am Ende einer Verarbeitung gesammelt dem Benutzer zusam- 
+men mit dem Quelltext anzuzeigen. Diese Aufgaben übernimmt das Notizbuch. 
+Mit der Prozedur 
+ 
+     note 
+ 
+kann eine Meldung im Notizbuch gespeichert werden. Mit 
+ 
+     note line 
+ 
+wird der Beginn einer neuen Zeile im Notizbuch signalisiert. Das bedeutet, 
+daß ein Programmierer für alle Zeilenvorschübe in der Fehlermeldungsdatei mit 
+dieser Prozedur zu sorgen hat. 
+ 
+Mit der Informationsprozedur 
+ 
+     anything noted 
+ 
+kann man am Ende einer Verarbeitung abfragen, ob Fehlermeldungen gespeichert 
+wurden. Ist das der Fall, kann man den Paralleleditor aufrufen: 
+ 
+     note edit 
+ 
+In der oberen Hälfte werden die Fehlermeldungen dargestellt, in der unteren 
+den zu bearbeitenden Text. Beispiel: 
+ 
+     PROC verarbeite (TEXT CONST datei): 
+       FILE VAR f :: sequential file (input, datei); 
+       verarbeitung; 
+       ende behandlung. 
+ 
+     verarbeitung: 
+       ... 
+       note (fehlermeldung); 
+       note line. 
+ 
+     ende behandlung: 
+       IF anything noted 
+         THEN note edit (f) 
+       FI 
+     END PROC verarbeite 
+ 
+ 
+ 
+Notizbuch-Kommandos 
+ 
+anything noted 
+    BOOL PROC anything noted 
+    Zweck: Informationsprozedur, ob etwas in das Notizbuch geschrieben wurde. 
+ 
+note edit 
+    PROC note edit 
+    Zweck Bewirkt das Anzeigen des Notizbuchs auf vollem Bildschirm. 
+ 
+    PROC note edit (FILE VAR f) 
+    Zweck: Anzeigen des Notizbuchs und der Datei 'f' durch den Parallel- 
+           editor. 
+ 
+note file 
+    FILE PROC note file 
+    Zweck: Assoziierungsprozedur. Liefert das Notizbuch. 
+ 
+note line 
+     PROC note line 
+     Zweck: Zeilenvorschub im Notizbuch. 
+ 
+note 
+     PROC note (TEXT CONST meldung) 
+     Zweck: Schreibt 'meldung' in das Notizbuch. 
+ 
+     PROC note (INT CONST zahl) 
+     Zweck: Schreibt 'zahl' als TEXT in das Notizbuch (analog 'put'). 
+ 
+ 
+ 
+7. Sortier-Programme 
+ 
+Es stehen zwei verschiedene Sortier-Programme zur Verfügung: 'sort' 
+(Sortierung nach ASCII-Reihenfolge) und 'lex sort' (Sortierung nach 
+deutschem Alphabet). 
+ 
+Das Kommando 
+ 
+   sort ("datei") 
+ 
+sortiert 'datei' zeilenweise. Beispiel: 
+ 
+   Eingabe-Datei: 
+      Berta ist eine Frau. 
+      Adam ist ein Mann. 
+      ... 
+   Sortierte Datei: 
+      Adam ist ein Mann. 
+      Berta ist eine Frau. 
+      ... 
+ 
+Dabei werden die Zeilen-Anfänge solange zeichenweise miteinander verglichen, 
+bis ein Unterschied auftritt und dann ggf. umgeordnet. Werden zwei ungleich 
+lange Zeilen (Anzahl Zeichen/Zeile) miteinander verglichen, dann kann man 
+sich die kürzere Zeile mit Leerzeichen auf die Länge der längeren Zeile 
+verlängert denken. 
+ 
+Die Reihenfolge, in der die Zeilen sortiert werden, erfolgt nach dem ASCII- 
+Zeichensatz in aufsteigender Reihenfolge (vergl. TEIL 3; EUMEL-Zeichencode): 
+ 
+    Leerzeichen 
+    einige Sonderzeichen 
+    Ziffern 
+    einige Sonderzeichen 
+    Große Buchstaben 
+    einige Sonderzeichen 
+    kleine Buchstaben 
+    einige Sonderzeichen 
+    Umlaute und ß 
+ 
+Das bedeutet, daß z.B. folgendermaßen sortiert wird: 
+ 
+   Adam 
+   Ball 
+   Zuruf 
+   aber das ist ein Satz 
+   niemals 
+   Überlauf 
+ 
+Um zu erreichen, daß große und kleine Buchstaben gleichwertig behandelt 
+werden, kann man das Kommando 
+ 
+   lex sort ("datei") 
+ 
+geben. In diesem Fall würde die sortierte Datei folgendermaßen aussehen: 
+ 
+   aber das ist ein Satz 
+   Adam 
+   Ball 
+   niemals 
+   Überlauf 
+   Zuruf 
+ 
+Man beachte, daß der Umlaut 'Ü' wie 'Ue' behandelt wird (für die restlichen 
+Umlaute gilt eine analoge Behandlung; ebenso wird 'ß' wie 'ss' behandelt). 
+Weiterhin werden alle Sonderzeichen bei der Sortierreihenfolge ignoriert. 
+ 
+ 
+ 
+Sortier-Kommandos 
+ 
+sort 
+     PROC sort (TEXT CONST datei) 
+     Zweck: Die Prozedur 'sort' sortiert die Datei 'datei' zeilenweise. Die 
+            Sortierung erfolgt nach der Ordnung, die der EUMEL-Zeichencode 
+            vorschreibt. Beispielsweise werden Zeilen ("Sätze"), die mit 
+            Ziffern beginnen, vor Sätzen, die mit Buchstaben anfangen, ein- 
+            geordnet. Sätze, die mit großen Buchstaben beginnen, werden vor 
+            Sätzen mit kleinen Buchstaben einsortiert. Weiterhin werden die 
+            Umlaute und das "ß" nach allen anderen Buchstaben eingeordnet. 
+ 
+     PROC sort (TEXT CONST datei, INT CONST anfang) 
+     Zweck: Sortiert eine Datei wie obige Prozedur, jedoch wird bei der 
+            Sortierung nicht der Anfang eines Satzes beachtet, sondern die 
+            Position 'anfang'. 
+ 
+lex sort 
+     PROC lex sort (TEXT CONST datei) 
+     Zweck: Wie 'sort', jedoch nach (deutscher) lexikographischer Reihen- 
+            folge nach DIN 5007. Bei den Vergleichen werden die Operatoren 
+            LEXEQUAL, LEXGREATER, LEXGREATEREQUAL (vergl. TEIL 11 des 
+            Benutzerhandbuchs) verwandt. Anmerkung: 'lex sort' ist um 
+            einiges langsamer als 'sort'. 
+ 
+     PROC lex sort (TEXT CONST datei, INT CONST anfang) 
+     Zweck: Wie 'lex sort', jedoch wird bei der Sortierung bei 'anfang' 
+            jeder Zeile begonnen. 
+ 
+ 
+ 
+8. Rechnen im Editor: TeCal 
+ 
+Das Programm TeCal (Abkürzung für "Text Calculator") ermöglicht das einfache 
+Rechnen im EUMEL-Editor. 
+ 
+Das Programm TeCal ermöglicht einfache Rechnungen (ähnlich wie mit einem 
+Taschenrechner) unter der Benutzung des Editors. Gleichzeitig stehen dem 
+Benutzer aber alle Fähigkeiten des Editors zur Verfügung. TeCal ermöglicht 
+Rechnungen auf einfache Weise zu erstellen oder Tabellenspalten zu berechnen. 
+ 
+TeCal wird aus dem Editor heraus durch 'ESC t' oder durch das Editor- 
+Kommando 
+ 
+     tecal 
+ 
+aktiviert. (Anmerkung: TeCal ist nicht standardmäßig insertiert). Dadurch 
+wird in der untersten Zeile des Bildschirms eine Informationszeile aufgebaut, 
+in der die (Zwischen-) Ergebnisse einer Rechnung zur Kontrolle festgehalten 
+werden. 
+ 
+Merke: TeCal ermöglicht einfache Rechnungen im EUMEL-Editor. 
+ 
+ 
+ 
+Ein einfaches Beispiel 
+ 
+Angenommen, Prokurist Meier der Firma 'Software Experts' muß eine Rechnung 
+schreiben. Er schreibt u.a.: 
+ 
+     ... 
+     Wir berechnen Ihnen 
+ 
+     1 Manual  'Software Auswahl leicht gemacht'      112.30 DM 
+     1 Manual  'Ohne Fehler programmieren'            300.- 
+ 
+                                           Summe 
+ 
+Nun kann er die TeCal-Funktionen durch 
+ 
+     ESC t 
+ 
+zuschalten. (Natürlich kann TeCal auch schon während des Schreibens einge- 
+schaltet sein, das Editorfenster ist dann nur um eine Zeile (nämlich die 
+TeCal-Informationszeile) kürzer. Zuerst löscht Prokurist Meier eventuell 
+vorhandene Zwischenergebnisse von TeCal (TeCal vergißt eine angefangene 
+Rechnung durch Abschalten nicht!) mit 
+ 
+     ESC C 
+ 
+Das funktioniert wie eine CLEAR-Taste bei einem Taschenrechner, löscht also 
+ggf. vorhandene Werte. In der Informationszeile (die letzte Zeile des Bild- 
+schirms) erscheint darum als Wert '0.0'. 
+ 
+Nun "fährt" er mit dem Cursor auf den ersten Wert ('112.30'). Dabei ist es 
+belanglos, welche Ziffer er "trifft". Dann betätigt er 
+ 
+     ESC L 
+ 
+(für Lesen). Damit erscheint dieser Wert in der Informationszeile. Durch 
+'ESC L' wird versucht, einen Wert von der Stelle aus der Datei zu lesen, die 
+durch den Cursor angezeigt wird. (Gelingt dies nicht, erfolgt in der 
+obersten Zeile eine Fehlermeldung). Dann betätigt er 
+ 
+     ESC + 
+ 
+weil er ja die zwei Werte addieren will. Das Zwischenergebnis in der TeCal- 
+Informationszeile bleibt dadurch unverändert. Jetzt fährt er auf den zweiten 
+Wert und betätigt erneut 'ESC L'. Nun erscheint der zweite Wert in der An- 
+zeige. Um das Ergebnis der Rechnung zu erfahren, betätigt er 
+ 
+     ESC = 
+ 
+Die Summe der zwei Zahlen erscheint nun in der Informationszeile. Nun fährt 
+er mit dem Cursor auf die Stelle, an der die Summe stehen soll und betätigt 
+hier   
+ 
+     ESC S 
+ 
+(für Schreiben). Damit erscheint die eben errechnete Summe (412.30) an dieser 
+Stelle der Datei. 
+ 
+Man bedient TeCal also wie einen Taschenrechner. Man muß allerdings, um die 
+Rechentasten zu bedienen, ESC zuvor drücken. Dies ist notwendig, um die 
+"normalen" Tasten von den TeCal-Tasten zu unterscheiden. 
+ 
+Merke: Mit einigen einfachen Tastendrücken können Berechnungen vorgenommen 
+werden. 'ESC L' liest einen Wert von der aktuellen Cursor-Position, 'ESC S' 
+schreibt den angezeigten TeCal-Wert an die aktuelle Cursor-Position. 'ESC C' 
+löscht alle Werte im TeCal-Rechner. 
+ 
+ 
+ 
+Einige weitere einfache Rechenoperationen 
+ 
+In diesem Abschnitt werden weitere einfache Operationen von TeCal be- 
+schrieben. 
+ 
+Natürlich kann man mit TeCal nicht nur Addieren. Die folgenden Operationen 
+laufen analog 'ESC +': 
+ 
+     ESC -               (Subtrahieren) 
+     ESC *               (Multiplizieren) 
+     ESC /               (Dividieren) 
+ 
+Beispiel: 
+ 
+     ... 
+     Wir berechnen Ihnen 
+ 
+   Artikelbezeichnung               Anzahl  Einzelpreis Summe 
+ 
+   Schraube, verdreht                 27       1.05     28.35 
+ 
+                                                 Gesamt 28.35 
+ 
+Dazu drückt Prokurist Meier folgende Tasten: 
+ 
+    Cursor auf         Taste             TeCal-Anzeige 
+ 
+       27               ESC C                0.00 
+    unverändert         ESC L               27.00 
+    unverändert         ESC *               27.00 
+       1.05             ESC L                1.05 
+    unverändert         ESC =               28.35 
+    unter Summe         ESC S               28.35 
+    in Gesamtzeile      ESC S               28.35 
+ 
+Wie wir sehen, kann Prokurist Meier jederzeit seine Eingaben kontrollieren 
+mit Hilfe der TeCal-Informationszeile. 
+ 
+Anmerkung: 
+ 
+'ESC S' schreibt den aktuellen Wert wie der Dezimal-Tabulator des Editors 
+(vergleiche Kapitel Editor). Die Stelle, an der der Cursor steht, wird beim 
+Schreiben die letzte Stelle vor dem Dezimalpunkt. Ziffern vor dem Dezimal- 
+punkt werden also nach links, Ziffern nach dem Dezimalpunkt nach rechts ge- 
+schrieben. 
+ 
+Merke: ESC mit den Tasten '-', '+', '*' und '/' haben die gewohnte Wirkung. 
+ 
+ 
+ 
+Die Verwendung von Klammern 
+ 
+TeCal erlaubt bei Rechnungen die Eingabe von Klammern. 
+ 
+Beispiel (wir haben hier die Taste ESC fortgelassen): 
+ 
+     2 * (3 + 5) = 16.00 
+ 
+Merke: Klammern können bei Rechnungen beliebig verwendet werden. 
+ 
+ 
+ 
+Der Prozent-Operator 
+ 
+Angenommen, wir wollen 14 Prozent von 200 DM errechnen. Dann können wir wie 
+gewohnt verfahren (für bessere Lesbarkeit zeigen wir hier für 'ESC L' den 
+jeweiligen Wert): 
+ 
+     200 ESC % ESC = 
+ 
+Der Prozent-Operator berechnet immer einen eingestellten Prozentsatz von dem 
+gerade angezeigten Zwischenergebnis. Der eingestellte Prozentsatz wird in der 
+Informationszeile angezeigt. Er läßt sich mit Hilfe des Kommandos 
+ 
+     prozentsatz ('prozentzahl') 
+ 
+verändern. 
+ 
+Was müssen wir machen, um die 14 Prozent von 200 auf den Wert von 200 zu 
+addieren? Ganz einfach: 
+ 
+     200  ESC +  ESC %  ESC = 
+ 
+Wie wir solche Tastensequenzen einfacher erledigen können, zeigen wir in 
+einem späteren Abschnitt. 
+ 
+Merke: Der Prozent-Operator berechnet immer den eingestellten Prozentanteil 
+vom angezeigten Wert. 
+ 
+ 
+ 
+Spaltenweise summieren 
+ 
+Da es beim Schreiben von Rechnungen o.ä. häufig vorkommt, daß eine ganze 
+Zahlenkolonne addiert werden soll, besitzt TeCal eine Sonderfunktion, die es 
+dem Benutzer erspart, mit dem Cursor auf jeden einzelnen Wert zu fahren und 
+'ESC L' sowie 'ESC +' zu drücken. Durch 
+ 
+     ESC V 
+ 
+addiert TeCal zu der Zahl, auf der der Cursor steht alle, die in gerader 
+Linie darüberstehen, solange bis eine Zeile gefunden wird, in der Text oder 
+andere Zeichen stehen, die nicht zu einer Zahl gehören. Leerzeichen führen 
+also nicht zum Abbruch der Rechnung. Nehmen wir an, Prokurist Meier hätte 
+seine Rechnung soweit fertig : 
+ 
+     ... 
+     Wir berechnen Ihnen 
+ 
+   Artikelbezeichnung               Anzahl  Einzelpreis Summe 
+ 
+   Schraube, verdreht                 27       1.05     28.35 
+   Nagel, m. Kopf                     33       0.50     16.50 
+   Hammer, Spezialausführung m. 
+      Eichenholzgriff                  1      44.70     44.70 
+                                                      -------- 
+ 
+Um nun die Gesamtsumme zu berechnen fährt er einfach mit dem Cursor auf die 
+unterste Zahl (44.70) und betätigt ESC V. In der Anzeige steht direkt die 
+Gesamtsumme, die dann mit ESC S unter dem Strich eingetragen werden kann. 
+ 
+Merke: Zahlenkolonnen können mit ESC V summiert werden. 
+ 
+ 
+ 
+Direkte Eingabe 
+ 
+Es kann ein Wert direkt in die Berechnung eingehen, ohne daß er vorher in 
+der Datei stehen muß. 
+ 
+Durch das Betätigen von 
+ 
+     ESC E 
+ 
+erscheint 'gib wert :' in der TeCal-Informationszeile. Nun kann ein Wert 
+(wie im Editor) eingegeben werden, zugelassen ist auch ein ganzer Ausdruck 
+wie z.B.   
+ 
+     (3.00 DM + 5.00 DM) * 365 Tage   -    2,00 DM * 12 Monate 
+ 
+Dabei sind auch Buchstaben erlaubt, die aber überlesen werden. Betätigt man 
+RETURN, wird der Ausdruck ausgewertet und der Wert in die Anzeige über- 
+nommen. Für das oben gezeigte Beispiel steht die Anzeige also anschließend 
+auf 2896. Auf diese Weise kann man auch einfach Zwischenrechnungen machen, 
+ohne daß die verwendeten Zahlen irgendwo in der Datei stehen. Das Ergebnis 
+kann man dann weiter verrechnen, als wäre es mit ESC L aus der Datei gelesen 
+worden. Natürlich kann man es auch direkt mit ESC S in die Datei schreiben. 
+ 
+Merke: Mit ESC E wird ein Wert direkt in TeCal aufgenommen. Durch Eingabe 
+eines ganzen Rechenausdrucks lassen sich leicht auch Rechnungen durchführen, 
+ohne daß die Zahlen in einer Datei stehen. 
+ 
+ 
+ 
+TeCal und Lernen im Editor 
+ 
+Bei sich wiederholenden Rechnungen ist es sinnvoll, Rechenoperationen "zu 
+lernen" und auf eine Taste zu legen. 
+ 
+Angenommen, Prokurist Meier hat häufig Rechnungen zu schreiben und muß des 
+öfteren die Mehrwertsteuer und Bruttopreis unter die jeweiligen Nettopreise 
+schreiben. Zu diesem Zweck kann er die "Lern"-Einrichtung des Editors 
+benutzen (vergl. EUMEL-Benutzerhandbuch: Editor). Beim Lernen "merkt" sich 
+der Editor jeden Tastendruck (also auch TeCal-Operationen). Die gelernten 
+Tasten kann man anschließend mit einem Tastendruck abrufen. Meier kann die 
+Operationen wie folgt vom Editor lernen lassen: 
+ 
+Er fährt mit dem Cursor zuerst auf den Nettopreis, von der die Mehrwertsteuer 
+errechnet werden soll. Dann betätigt er ESC HOP (es erscheint LEARN in der 
+Kopfzeile des Editors). Dann schreibt er die TeCal-Operationen wie oben 
+gezeigt (in diesem Falle also ESC L  ESC +  ESC % ; dann steht der Mehrwert- 
+steuerbetrag in der Anzeige. Er fährt also mit dem Cursor eine Zeile tiefer 
+und betätigt ESC S, dann geht er noch eine Zeile tiefer und gibt ESC = und 
+wiederum ESC S um den Bruttobetrag zu berechnen und zu schreiben. Mit dem 
+abschließenden ESC HOP und einer weiteren Taste (sagen wir mal 'm' als 
+Abkürzung für Mehrwert) beendet er das Lernen. Nun kann er jederzeit die 
+Mehrwertsteuer und Bruttobetrag unter einen gegebenen Nettobetrag schreiben, 
+indem er ESC m betätigt. 
+ 
+Praktischer Tip: 
+ 
+Tabulator-Bewegungen kann man ebenfalls lernen. So ist es z.B. möglich, die 
+Berechnung von Spalten- oder Reihensummen zu erlernen, indem man mit 
+TAB jeweils zu dem nächsten Wert springt. 
+ 
+Merke: Es können beliebige Rechnungen erlernt und auf eine Taste gelegt 
+werden. Die gelernten Rechnungen können mit Hilfe einer Taste abgerufen 
+werden. 
+ 
+ 
+ 
+Benutzung des Merkregisters 
+ 
+Mit 
+ 
+     ESC M 
+ 
+(für Merken) kann man ein gerade angezeigtes (Zwischen-) Ergebnis im 
+Speicher aufbewahren, um es später an anderer Stelle wieder in die Rechnung 
+einzubeziehen. Das geschieht, in dem man dann statt eine Zahl mit ESC L 
+einzulesen 
+ 
+     ESC K 
+ 
+(für Konstante) eingibt. Dadurch wird die Zahl aus dem Merkregister wieder 
+in die Anzeige übertragen, so daß man damit weiterrechnen kann. 
+ 
+Merke: Man kann Zahlen mit ESC M abspeichern und mit ESC K wiederholen. 
+ 
+ 
+ 
+Auskunft über TeCal-Funktionen 
+ 
+Wenn Sie beim Arbeiten mit TeCal noch nicht so sicher sind oder eine Funktion 
+benutzen möchten, die Sie sonst nur selten verwenden und deren genaue 
+Wirkung sie vielleicht wieder vergessen haben, so hilft Ihnen 
+ 
+     ESC ? 
+ 
+weiter. Nach betätigen dieser Tasten meldet sich die TeCal Auskunft mit 
+Funktionstaste drücken oder <?>. Dann geben Sie das Funktionssymbol ein, das 
+Sie erklärt bekommen möchten. Geben Sie z.B. ein C ein, wenn Sie die Wirkung 
+von ESC C wissen möchten. Daraufhin wird ein Text gezeigt, in dem die 
+entsprechende Auskunft steht. In diesem Text können Sie sich wie im Editor 
+bewegen. Wenn Sie den Text gelesen haben, können Sie das Fenster wieder mit 
+ESC Q verlassen. Dadurch wird der alte Zustand vor der Auskunftsfunktion 
+wiederhergestellt. Durch 
+ 
+     ESC ? ? 
+ 
+erklärt sich die Auskunft selbst. Sie bekommen dort unter anderem die Liste 
+aller TeCal-Funktionen gezeigt. 
+ 
+Merke: Mit ESC ? erhält man Auskünfte über TeCal-Funktionen. 
+ 
+ 
+ 
+Einstellen von Nachkommastellen 
+ 
+Durch das Kommando 
+ 
+     kommastellen ('zahl') 
+ 
+wird die Anzahl der angezeigten Nachkommastellen (0-9) eingestellt. Genau so 
+viele Nachkommastellen werden auch bei ESC S oder ESC T geschrieben (intern 
+wird aber jeweils mit höchster Genauigkeit gerechnet). Mit 
+ 
+     ESC R 
+ 
+kann man ein angezeigtes Zwischenergebnis auch intern auf die angezeigte Zahl 
+von Nachkommastellen runden. Beispiel: 
+ 
+     ESC (   1   ESC /   3   ESC )   ESC *   2   ESC= 
+ 
+führt zur Anzeige von 0.67 (bei zwei eingestellten Nachkommastellen). Gibt 
+man jetzt (aber nach ESC ) noch ESC R ein, so wird das Zwischenergebnis von 
+1/3 auf 0.33 gerundet, so daß das Endergebnis 0.66 beträgt. 
+ 
+Merke: Im Kommandomodus kann man durch das Kommando 'kommastellen' die An- 
+zahl der Nachkommastellen einstellen. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12
new file mode 100644
index 0000000..ba5d0c6
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12
@@ -0,0 +1,234 @@
+                   EUMEL-Benutzerhandbuch 
+ 
+                   TEIL 12:  SPOOLER / OPERATOR                    
+ 
+1. Spooler-Übersicht 
+ 
+Ein "Spooler" ist eine Warteschlange von Datenräumen#ie# (Dateien) vor einem 
+"Worker": 
+ 
+           +------------+                 +------------+ 
+   ----->  |            |                 |            | 
+   ----->  |  spooler   |  ------------>  |   worker   | 
+   ----->  |            |                 |            | 
+           +------------+                 +------------+ 
+ 
+Der Spooler puffert Dateien, die von beliebigen Tasks geschickt werden kön- 
+nen, in seiner Warteschlange und gibt sie der Reihe nach dem Worker zur 
+eigentlichen Verarbeitung. Ein typischer Einsatzfall (aber nicht der einzige) 
+für ein solches System ist der EUMEL-Drucker in Multi-User-Systemen. Unab- 
+hängig davon, ob der Drucker gerade aktiv ist und wieviele Dateien noch auf 
+den Ausdruck warten, kann man seine Datei dem Druckspooler schicken und 
+sofort danach weiterarbeiten. 
+ 
+Da jeder Spooler und auch jeder Worker eine eigene Task ist, können Spooler 
+nur im Multi-User-Systemen eingesetzt werden. 
+ 
+Im folgenden wird nur die anwenderseitige Schnittstelle eines Spoolers be- 
+schrieben. 
+ 
+Merke: Ein Spooler puffert Dateien für einen Worker. 
+ 
+ 
+ 
+2. Die Benutzung eines Spoolers 
+ 
+Jeder Spooler im System ist eine eigene Task und hat dementsprechend einen 
+Tasknamen, über den er angesprochen werden kann. So heißt der Druckspooler 
+beispielsweise " PRINTER". 
+ 
+Jede Task kann jedem Spooler durch Aufruf von 'save' eine Datei schicken. 
+Beispiel: 
+ 
+   save ("datei name", task ("spooler name")) 
+ 
+(Vergl. auch TEIL 7). In der Regel ist ein SPOOLER für (mindestens) einen 
+Drucker in einem EUMEL-System vorhanden. Dieser kann über den internen 
+Task-Bezeichner 'print' angesprochen werden. Beispiel: 
+ 
+     save ("datei name", printer) 
+ 
+Eine so übergebene Datei kann man durch 
+ 
+     erase ("datei name", printer) 
+ 
+aus der Warteschlange löschen. (Natürlich nur solange sie sich noch in dieser 
+Warteschlange befindet). Dabei kann man nur auf solche Dateien zugreifen, die 
+aus der eigenen Task stammen. Durch Aufruf von 
+ 
+     list (printer) 
+ 
+wird die aktuelle Warteschlange des angegebenen Spoolers auf dem Terminal 
+angezeigt, so daß man sich über die Anzahl der Dateien und die Position der 
+eigenen Dateien im Spooler informieren kann. 
+ 
+Aufbauend auf diesen allgemeinen Kommandos können weitere für spezielle 
+Spooler programmiert werden. So gibt es für den Spooler 'printer' die Proze- 
+duren 
+ 
+     print     und      print ("datei name") 
+ 
+die im wesentlichen auf 
+ 
+     save ("datei name", printer) 
+ 
+zurückgeführt werden. 
+ 
+Merke: Einem SPOOLER kann man eine (oder mehrere) Dateien mit 'save' 
+schicken. Mit 'list' kann man sich über die Dateien im SPOOLER informieren. 
+Einem Drucker-SPOOLER übergibt man mit 'print' eine Datei. 
+ 
+ 
+ 
+3. Privilegierte Spooler-Kommandos 
+ 
+Gewisse Kommandos können einer #ib#Spooler-Task#ie# direkt im Dialog (ähn- 
+lich wie im 'maintenance'-Zustand eines globalen Datei-Managers) gegeben 
+werden. Dazu muß der Spooler mit 'continue' an ein Terminal geholt werden. 
+Ist der SPOOLER durch ein Paßwort, so sind diese privilegierten Kommandos 
+nicht für jeden Benutzer zugänglich. 
+ 
+break 
+     PROC break 
+     Zweck: Beendet den Dialogzustand des Spoolers. Der Spooler koppelt sich 
+            vom Terminal ab und geht in seinen normalen Verarbeitungsmodus 
+            über. 
+ 
+first 
+     PROC first 
+     Zweck: Vorziehen einer Datei in der Warteschlange auf den ersten Platz. 
+            Alle Dateien von der zweiten an werden im Dialog zum Vorziehen 
+            angeboten. 
+ 
+start 
+     PROC start 
+     Zweck: Die (vorher gestoppte) Worker-Task wird neu kreiert und ge- 
+            startet. 
+ 
+stop 
+     PROC stop 
+     Zweck: Die Worker-Task wird abgebrochen und gelöscht. Damit wird auch 
+            ein von ihr belegetes Terminal wieder frei. 
+ 
+ 
+Hinweis: Die Kommandos 'start/stop' sind gut dazu geeignet, die Verarbeitung 
+         einer Datei durch einen Worker (z.B. Druckoutput) abzubrechen, bei 
+         Hardwareeingriffen zu stoppen oder Worker (wie z.B. Drucker) nur 
+         zeitweise zu betreiben. 
+ 
+Hinweis: Wenn der Worker mit Verzögerung abgebrochen werden soll, kann man 
+         den Spooler an ein Terminal holen und dann so lange mit der Eingabe 
+         von 'stop' warten, bis der Worker mit der gerade bearbeiteten Datei 
+         fertig ist. Der Spooler kann in dieser Zeit nicht von anderen Tasks 
+         oder dem Worker angesprochen werden. 
+ 
+ 
+ 
+4. Der OPERATOR 
+ 
+Im folgenden Abschnitt wird die standardmäßig implementierte Task OPERATOR 
+erläutert. Erweiterungsmöglichkeiten sind im Systemhandbuch beschrieben. Dem 
+OPERATOR stehen gewisse privilegierte Kommandos zur Verfügung. Diese Kom- 
+mandos (System abschalten, fremde Tasks löschen u.a) werden vom "normalen" 
+Benutzer des Multi-User-Systems nicht benötigt. Sie sind nur für den 
+"Operateur" interessant. Es empfiehlt sich, OPERATOR mit einem Paßwort zu 
+versehen, damit die priviligierten Kommandos nicht jedem Benutzer zur Ver- 
+fügung stehen. 
+ 
+ 
+ 
+Einschalten des EUMEL-Systems 
+ 
+Wie ein EUMEL-System eingeschaltet wird, kann hier nicht beschrieben werden, 
+weil dies abhängig von speziellen Rechnern ist (Lage des Ein/Aus-Schalters 
+u.a.m.). Üblicherweise liefern die Hersteller für diesen Zweck bei der Aus- 
+lieferung Anweisungen mit. 
+ 
+Nach Einschalten des Rechnersystems befindet man sich in der Task OPERATOR. 
+Diese Task dient zum kontrollierten Ein- und Ausschalten des EUMEL-Systems. 
+Nach dem Einschalten wird man automatisch von der Task OPERATOR nach dem 
+aktuellen Datum und der Uhrzeit gefragt. Nach Eingabe dieser Werte erfolgt 
+ 
+     gib kommando : 
+ 
+Der Benutzer befindet sich also in der Monitor-Ebene (vergl. dazu auch 
+TEIL 2). Um die Task OPERATOR vom Terminal abzukoppeln, gibt man 
+ 
+     break 
+ 
+Nach Betätigen der SV-Taste erscheint dann 
+ 
+     gib supervisor kommando : 
+ 
+Nun kann man mit 'begin' oder 'continue' eine neue Task einrichten oder mit 
+einer alten Task in der Arbeit fortfahren. 
+ 
+Merke: Nach dem Einschalten gibt man das Datum und die Uhrzeit an. 
+       Dann koppelt man die Task OPERATOR mit 'break' ab. 
+ 
+ 
+ 
+EUMEL-System ausschalten 
+ 
+Nachdem die Arbeiten in der Benutzer-Task beendet wurden, koppelt man die 
+Task mit 
+ 
+     break 
+ 
+vom Terminal ab oder beendet die Task mit 
+ 
+     end 
+ 
+Achtung: Bei 'end' werden alle Dateien der Task gelöscht. 
+ 
+Nach Betätigen der SV-Taste kann nun ein Supervisor-Kommando gegeben 
+werden. Um das EUMEL-System kontrolliert auszuschalten, muß man die Task 
+OPERATOR wieder an das Terminal holen. Das erfolgt mit 
+ 
+     continue ("OPERATOR") 
+ 
+Die OPERATOR-Task meldet sich mit 
+ 
+     gib kommando : 
+ 
+Nun kann man das Kommando 
+ 
+     shutup 
+ 
+geben, welches das System kontrolliert abschließt. 'shutup' garantiert, daß 
+alle Dateien auf dem Hintergrund des EUMEL-Systems gesichert werden. Wird 
+das EUMEL-System ohne 'shutup' ausgeschaltet (z.B. indem der Rechner einfach 
+ausgeschaltet wird), können die Informationen, die seit dem letzten Fixpunkt 
+(üblicherweise 15 Minuten) aufgelaufen sind, verloren sein. 
+ 
+Merke: In der Task OPERATOR wird mit dem Kommando 'shutup' das EUMEL-System 
+kontrolliert abgeschaltet. 
+ 
+ 
+ 
+Übersicht über die #ib#OPERATOR-Kommandos 
+ 
+end 
+   PROC end (TASK CONST task) 
+   Zweck: Löschen der Task 'task'. Hierbei findet keine Paßwortüberprüfung 
+          statt. Darum sollte die Task OPERATOR auch mit einem Paßwort 
+          versehen sein, weil man vom OPERATOR jede Task löschen kann. 
+          Beispiel: 
+ 
+             end (task ("hugo")) (* oder: *) 
+             end (/"hugo") 
+ 
+set date 
+    PROC set date 
+    Zweck: Einstellen des Datums und der Uhrzeit. Das Erfragen der Werte 
+           erfolgt interaktiv. 
+ 
+shutup 
+   PROC shutup 
+   Zweck: Kontrolliertes Herunterfahren des gesamten Systems. Alle Tasks 
+          bleiben mit ihren Daten erhalten. Beim Start des Systems meldet 
+          sich die OPERATOR-Task wieder auf dem gleichen Terminal. Das 
+          Kommando sollte deshalb möglichst nur am Terminal 0 gegeben 
+          werden. Nach dem Start sollte der OPERATOR mit 'break' vom 
+          Terminal abgekoppelt werden. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2
new file mode 100644
index 0000000..c70ddfc
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2
@@ -0,0 +1,628 @@
+                        EUMEL-Benutzerhandbuch 
+ 
+                       TEIL 2: Supervisor/Monitor                   
+ 
+ 
+1. Task-Organisation 
+ 
+In diesem Kapitel wird die Task-Verwaltung und der Task-Baum beschrieben. 
+ 
+Alle Tasks des EUMEL-Systems werden in einen Task-Baum eingebunden. Das be- 
+deutet, daß die Task eines Benutzers automatisch einen "Vater" besitzt, aber 
+auch neue Tasks ("Söhne") erzeugen kann. In einem EUMEL-System gibt es in 
+der Regel zwei spezielle Tasks (#ib#UR#ie# und #ib#SUPERVISOR#ie#). Alle 
+anderen Tasks sind Söhne oder Enkel dieser Tasks. Zum Beispiel: 
+ 
+Die mit großen Buchstaben geschriebenen Tasknamen sind "System"-Tasks; die 
+mit kleinen Buchstaben geschriebenen Tasknamen sind Benutzer-Tasks (dies 
+ist nicht zwingend, sondern Konvention). 
+ 
+- SUPERVISOR: Übernimmt das Einrichten bzw. Löschen von Tasks. 
+ 
+- OPERATOR:   Übernimmt u.a. die Aufgaben für das Ein- bzw. Ausschalten des 
+              EUMEL-Systems. 
+ 
+- ARCHIVE:    Übernimmt die Auslagerung von Dateien auf Archive. 
+ 
+- UR:         Ist der "Urvater" des EUMEL-Systems, enthält u.a. den 
+              ELAN-Compiler. 
+ 
+- PUBLIC:     Enthält Dateien, die längerfristig gehalten werden müssen und 
+              die alle Benutzer des Systems benötigen. 
+ 
+ 
+Der Task-Baum hat folgende Bedeutung: 
+ 
+Eine Task, die sich "unter" einer anderen befindet, ist ein "Sohn" dieser 
+"Vater"-Task. Beispielsweise ist die Task PUBLIC ein Sohn von UR (und UR ist 
+somit Vater von PUBLIC). 
+ 
+Die für eine Task zur Verfügung stehenden Datentypen und Operationen (d.h. 
+die Objekte, die aus insertierten ELAN-Paketen herausgereicht werden), sind 
+durch die direkte aufsteigende Linie im Task-Baum vorgegeben. Die in "Vater- 
+Tasks" insertierten und über die Schnittstelle herausgereichten Objekte 
+stehen in den "Söhnen" automatisch zur Verfügung. Beispielsweise stehen einer 
+Sohn-Task von 'user 1' alle insertierten Objekte aus der 'user 1'-Task zur 
+Verfügung (zusätzlich zu denen, die in UR und PUBLIC insertiert wurden). 
+Somit ist leicht möglich, unterschiedliche Sprachmengen des ELAN-Compilers 
+zur Verfügung zu stellen. Vergl. dazu auch das Kapitel über den ELAN- 
+Compiler.  
+Ähnliches gilt bei Dateien. So ist es erlaubt, Dateien zu direkten Vätern und 
+Söhnen im Taskbaum zu transportieren, aber nicht unmittelbar in "parallele" 
+Tasks. Man kann somit in der 'user 1'-Task Dateien von UR oder PUBLIC be- 
+ziehen, aber nicht von 'user 2' (da diese Task eine "parallele" Task ist). 
+Soll das trotzdem geschehen, so muß eine Datei erst von 'user 1' zu PUBLIC 
+geschickt werden und dann von 'user 2' dort abgeholt werden. Genaueres über 
+solche Operationen findet man im Benutzerhandbuch über die Datenräume. 
+ 
+Einige Tasks sind speziell dafür eingerichtet, Dateien für mehrere Nutzer 
+aufzubewahren. So sind UR und PUBLIC Tasks, die Dateien verwalten, die 
+längerfristig gehalten werden sollen. Solche Tasks werden "Manager"-Tasks 
+genannt. 
+ 
+ 
+2. Supervisor und Tasks 
+ 
+Eine Task ist für einen Benutzer ein "eigener Rechner", in der er Programme 
+bearbeiten lassen und/oder Daten aufbewahren kann, ohne von anderen Nutzern, 
+die gleichzeitig im System arbeiten, gestört zu werden. Der Supervisor er- 
+möglicht u.a. die Einrichtung, Weiterbearbeitung und Beendigung einer Task. 
+ 
+ 
+Überblick 
+ 
+Eine Task ist im EUMEL-System ein selbständiger Prozeß. Zu jedem Program- 
+mierer an einem Terminal gehört eine damit verbundene Task. Für den Benutzer 
+ist diese Task sozusagen ein "eigener Rechner". In einem EUMEL-System sind 
+zur gleichen Zeit noch weitere Tasks vorhanden, so z.B. zum Start und Ab- 
+schalten des Systems (OPERATOR), zur Druckersteuerung (SPOOLER), zur Ver- 
+waltung längerfristig benötigter Dateien u.a.m.. 
+ 
+Der Supervisor ist auf der ELAN-Ebene des EUMEL-Systems der Betriebssystem- 
+kern. Seine Aufgabe ist im wesentlichen die Task-Verwaltung, nämlich die Er- 
+richtung und das Löschen von Tasks. Im einfachsten Fall kommt ein Benutzer 
+des EUMEL-Systems mit dem Supervisor also nur bei den Supervisor-Kommandos 
+in Kontakt, die den Beginn und das Ende einer Task steuern. 
+ 
+Jede Task wird in einen "Taskbaum" eingeordnet. Jede Benutzer-Task ist 
+"Sohn" einer bereits vorhandenen "Vater"-Task und "erbt" von dieser vorüber- 
+setzte Programme. Man kann Dateien zu einer Vater-Task schicken oder von 
+dieser empfangen. 
+ 
+ 
+Eine neue Task beginnen 
+ 
+Mit dem Supervisor-Kommando 'begin' kann eine neue Task eingerichtet werden. 
+ 
+Soll eine neue Arbeit im EUMEL-System begonnen werden, muß eine neue Task 
+eingerichtet werden. Dazu muß das Supervisor-Kommando 'begin' gegeben 
+werden. Jedes Supervisor-Kommando muß durch die Betätigung der SV-Taste 
+eingeleitet werden. Dadurch meldet sich das EUMEL-System mit 
+ 
+     gib supervisor kommando : 
+ 
+Jetzt kann eines der Supervisor-Kommandos gegeben werden. In unserem Fall 
+wollen wir mit dem 'begin'-Kommando eine neue Task einrichten. Beispiel: 
+ 
+     begin ("rainer") 
+ 
+errichtet eine neue Task in dem EUMEL-System mit dem Namen 'rainer'. Die 
+Task meldet sich mit 
+ 
+     gib kommando : 
+ 
+Nun kann ein beliebiges Monitor-Kommando gegeben werden. 
+ 
+Wird eine Task in der geschilderten Weise eingerichtet, ist diese Task im 
+Taskbaum automatisch ein "Sohn" der Task 'PUBLIC'. 'PUBLIC' ist in der Lage, 
+Dateien von der neuen Sohn-Task zu empfangen ('save'-Kommando) oder man kann 
+Dateien von 'PUBLIC' in die Sohn-Task holen ('fetch'-Kommando). Solche Tasks, 
+die Dateien verwalten können, werden 'manager' genannt. 
+ 
+Merke: Nach dem Betätigen der SV-Taste meldet sich der Supervisor. 
+       Mit dem 'begin'-Kommando wird eine neue Task eingerichtet. 
+ 
+ 
+ 
+Eine Task ab- und ankoppeln 
+ 
+Mit dem 'break'- und 'continue'-Kommandos können die Arbeiten in einer Task 
+unterbrochen und später wieder aufgenommen werden. 
+ 
+Soll die Arbeit in einer Task unterbrochen werden, so kann man das (Monitor-) 
+Kommando 
+ 
+     break 
+ 
+geben, welches die Task vom Benutzer-Terminal abkoppelt. Die Task wird dann 
+vom System als "Hintergrund-Task" geführt, bleibt also weiterhin bestehen. 
+Mit dem Supervisor-Kommando 
+ 
+    continue ("meine task") 
+ 
+kann eine solche "abgekoppelte" Task wieder an ein Terminal angekoppelt und 
+die unterbrochenen Arbeiten weitergeführt werden. 
+ 
+Mit 'break' wird eine Task unterbrochen, während durch das 'continue'-Kom- 
+mando die Arbeiten fortgesetzt werden können. 
+ 
+ 
+ 
+Eine Task beenden 
+ 
+Mit dem 'end'-Kommando wird eine Task beendet und gelöscht. 
+ 
+Sind die Arbeiten in einer Task beendet, so sollte sie aus dem System ent- 
+fernt werden. Dies erfolgt mit dem Kommando 
+ 
+    end 
+ 
+Nach einer Rückfrage des Systems wird die Task gelöscht. Beachte, daß mit dem 
+Löschen der Task auch alle in ihr befindlichen Dateien gelöscht werden. 
+ 
+Merke: Mit dem 'end'-Kommando wird eine Task beendet und alle in ihr befind- 
+lichen Daten werden gelöscht. 
+ 
+ 
+ 
+Eine Task als Sohn einer Task einrichten 
+ 
+Mit dem 'begin'-Kommando ist es auch möglich, eine Task als Sohn einer be- 
+stimmten Task einzurichten. Damit die Vater-Task auch Dateien der einzu- 
+richtenden Sohn-Task verwalten kann, muß man sie vorher zu einer 'manager'- 
+Task machen. 
+ 
+In der Regel richtet man seine Task als Sohn von PUBLIC ein. Das erfolgt 
+automatisch, sofern man im 'begin'-Kommando nichts anderes als den neuen 
+Tasknamen angibt. Manchmal ergibt sich aber die Notwendigkeit, eine Task als 
+Sohn einer bestimmten Task einzurichten. Gründe können dafür u.a. sein: 
+ 
+- Man will eine eigene Datei-Hierarchie über mehrere Tasks einrichten. 
+ 
+- Man will ein Programmsystem anderen Benutzern zur Verfügung stellen. 
+ 
+Damit eine Task als Vater für andere, noch einzurichtende Task arbeiten kann, 
+muß man sie zuerst zu einer 'manager'-Task machen. Das erfolgt mit dem 
+Kommando 
+ 
+     global manager 
+ 
+Dies Kommando muß in der Task gegeben werden, die eine Vater-Task werden 
+soll. Damit wird die Task befähigt, Söhne einzurichten und Dateien, die von 
+einem (oder mehreren) Söhnen geschickt werden, zu verwalten. 
+ 
+Durch das 'global manager'-Kommando wird implizit ein 'break'-Kommando ge- 
+geben, so daß der Benutzer in der Supervisor-Ebene landet. Koppelt man nun 
+zu irgendeinem Zeitpunkt diese (zunächst potentielle) Vater-Task wieder an 
+('continue'-Kommando), meldet sich die Task nicht wie gewohnt mit 'gib 
+kommando :', sondern mit 
+ 
+     maintenance : 
+ 
+um anzudeuten, daß es sich um eine 'manager'-Task handelt. 
+ 
+Um eine Sohn-Task "unterhalb" der 'manager'-Task einzurichten, gibt man das 
+'begin'-Kommando, wobei man die Vater-Task mit angibt. Beispiel: 
+ 
+     begin ("rainer", "vatername") 
+ 
+richtet eine neue Task 'rainer' ein, die als Sohn der Vater-Task 'vatername' 
+in den Taskbaum eingeordnet wird. 
+ 
+Merke: Das Kommando 'global manager' macht eine Task zu einer 'manager'-Task. 
+Mit dem 'begin'-Kommando kann man auch eine Task als Sohn einer bestimmten 
+Task einrichten. 
+ 
+ 
+ 
+Ein laufendes Programm unterbrechen 
+ 
+Mit dem Betätigen der SV-Taste und dem Supervisor-Kommando 'halt' kann ein 
+Programm abgebrochen werden. 
+ 
+Soll ein Programm, welches gerade ausgeführt wird, vorzeitig abgebrochen 
+werden, so betätigt man die SV-Taste und gibt das Supervisor-Kommando 
+ 
+    halt 
+ 
+Anschließend kann man wieder ein Monitor-Kommando geben, weil man durch das 
+'halt'-Kommando automatisch wieder in seine Task gelangt. 
+ 
+Merke: Mit dem 'halt'-Kommando wird ein Programm abgebrochen. 
+ 
+ 
+ 
+Eine Task mit Paßwort schützen 
+ 
+Man kann eine Task durch ein Paßwort vor unberechtigtem Zugriff schützen. 
+ 
+Das Kommando 
+ 
+    task password 
+ 
+welches nur im Monitor gegeben werden kann, sorgt dafür, daß eine Task fort- 
+an nur wieder mit einem 'continue'-Kommando 'betreten' werden kann, wenn man 
+vorher das richtige Paßwort angibt. Beispiel: 
+ 
+     task passwort ("mein geburtstag") 
+ 
+Versucht nun ein Benutzer, die mit dem Paßwort geschützte Task mit dem 
+'continue'-Kommando an sein Terminal anzukoppeln, wird er zunächst nach dem 
+'Paßwort' gefragt. Nur unter Angabe des Paßwortes wird die Task angekoppelt. #count("1")#) 
+ 
+Man sollte Paßwörter möglichst behalten! Durch Paßwörter geschützte Tasks 
+kann niemand - außer durch die Angabe des korrekten Paßworts - die Task 
+wieder ankoppeln. Hat man das Paßwort vergessen, kann man nur noch die Task 
+löschen. 
+ 
+Damit ist gewährleistet, daß kein unberechtigter Benutzer an die Dateien und 
+Programme der Task gelangen kann. Es gibt jedoch noch zwei Situationen, die 
+einen unberechtigten Zugang zu Dateien erlauben: 
+ 
+a) Dateien in die Vater-Task schicken: 
+   Transportiert man Dateien in die Vater-Task ('save'-Kommando, vergl. auch 
+   Teil 7: Datei-Verwaltung), können Benutzer auf diese Dateien zugreifen 
+   (sofern sie Zugang zu dieser Task haben). Dies kann man verhindern, in dem 
+   man ein Datei-Paßwort angibt (siehe Teil 7 für die Beschreibung dieser 
+   Paßworte). Man beachte, daß das Paßwort für Dateien und das oben be- 
+   schriebene Paßwort für Tasks nichts miteinander zu tun haben. 
+ 
+b) Dateien werden in eine Sohn-Task geholt: 
+   Ist die Task als Vater-Task eingerichtet (Kommando 'global manager') dann 
+   ist es möglich, von der Sohn-Task Dateien ('fetch'-Kommando) aus der 
+   Vater-Task zu holen, die mit einem Paßwort geschützt ist. Darum muß man 
+   verhindern, daß Unberechtigte Söhne einer mit Paßwort geschützten Task 
+   einrichten können. Das kann man mit dem Kommando 
+ 
+       begin password ("geheim") 
+ 
+   Wird dieses Kommando gegeben, wird man bei dem Versuch, eine Sohn-Task 
+   einzurichten, nach einem Paßwort gefragt. Beachte, daß das 'begin- 
+   password' nichts mit dem Task-Paßwort und Datei-Paßwort zu tun hat. 
+ 
+Merke: Mit dem 'task password'-Kommando wird eine Task durch ein Paßwort 
+geschützt. 
+ 
+ 
+ 
+Informations-Kommandos 
+ 
+(Die Informations-Kommandos können auch vom Monitor aus gegeben werden). 
+ 
+Mit der Informationsprozedur 
+ 
+     task status 
+ 
+können Sie sich über den Zustand einer Task informieren. Beispiele: 
+ 
+     task status            (* informiert über die eigene Task *)                        
+     task status (father)   (* informiert über die Vater-Task *) 
+ 
+'task status' informiert u.a. über die verbrauchte CPU-Zeit der Task, den 
+belegten Speicherplatz (man beachte, daß Dateien mit Vater-Tasks oder Sohn- 
+Tasks werden), den Kanal, an dem die Task angekoppelt ist und dem Zustand 
+der Task (vergl. auch 'task info'). 
+ 
+Mit der Prozedur 
+ 
+     task info 
+ 
+können Sie eine Übersicht über alle in dem System befindlichen Tasks er- 
+halten.
+Mit dem Kommando 
+ 
+     storage info 
+ 
+kann man erfahren, wieviel Speicherplatz auf dem EUMEL-Hintergrund (noch) 
+zur Verfügung steht. 
+ 
+Durch einige Kommandos, die man nur vom Monitor aus geben kann, kann man 
+sich den Namen von Tasks liefern lassen. Die Kommandos 
+ 
+     myself 
+     father 
+ 
+liefern den (internen) Task-Namen. Mit dem Kommando 
+ 
+     name 
+ 
+bekommt man den internen Tasknamen in einen Text gewandelt. Beispiel: 
+ 
+     put (name (myself)) 
+     put (name (father)) 
+ 
+Mit dem Kommando 
+ 
+     rename myself 
+ 
+kann der Task-Name der Benutzer-Task geändert werden. 
+ 
+Merke: Durch die Informations-Kommandos 'storage info' und 'task info' kann 
+man erfahren, wieviel Speicherplatz und welche Tasks in dem EUMEL-System 
+sind. Mit den Kommandos 'myself' und 'father' kann man mehrere Dateien auf 
+einmal manipulieren (vergl. Teil 7). 
+ 
+ 
+ 
+Übersicht über Supervisor- und Task-Kommandos 
+ 
+In diesem Abschnitt werden alle Supervisor- und Task-Kommandos in der ELAN- 
+Notation dargestellt. 
+ 
+Die Supervisor-Kommandos entsprechen - wie alle anderen Kommandos im EUMEL- 
+System - der ELAN-Syntax (Kommando-Namen werden klein geschrieben, Parameter 
+in Klammern, mehrere Parameter durch Kommata getrennt, TEXT-Parameter in 
+Anführungstrichen usw.). Dabei ist jedoch zu beachten, daß diese Kommandos 
+zum Teil nur im Supervisor-Zustand (vorheriges Betätigen der SV-Taste) ge- 
+geben werden können. Die Kommandos 'break', 'end', 'storage info' und 
+'task info' können auch im Monitor gegeben werden. 
+Folgende Supervisor-Kommandos stehen zur Verfügung: 
+ 
+begin 
+     PROC begin (TEXT CONST task name) 
+     Zweck: Richtet eine neue Task als Sohn von PUBLIC ein. 
+ 
+     PROC begin (TEXT CONST task name, father task name) 
+     Zweck: Richtet eine neue Task als Sohn der 'father task name'-Task ein. 
+ 
+begin password 
+     PROC begin password (TEXT CONST geheim) 
+     Zweck: Verhindert das unberechtigte Einrichten einer Sohn-Task. 
+ 
+break 
+     PROC break 
+     Zweck: Die zum Terminal aktuell zugeordnete Task wird abgekoppelt. Sie 
+            wird damit zu einer Hintergrund-Task, d.h. sie wird entweder bis 
+            zu ihrem Ende oder bis zur nächsten angeforderten Terminal-Ein-/ 
+            Ausgabe oder bis zum nächsten 'continue'- Kommando weiter be- 
+            arbeitet. 
+ 
+continue 
+     PROC continue (TEXT CONST task name) 
+     Zweck: Eine im Hintergrund laufende Task wird an das Terminal des 
+            Benutzers angekoppelt. 
+ 
+end 
+     PROC end 
+     Zweck: Die zum Terminal aktuell gehörende Task wird abgebrochen und 
+            gelöscht. Das Kommando ist im Monitor verfügbar. 
+ 
+father 
+     TASK PROC father 
+     Zweck: Liefert den internen Tasknamen. 
+ 
+global manager 
+     PROC global manager 
+     Zweck: Macht eine Task zur 'manager'-Task. Erst nach Aufruf dieser 
+            Prozedur sind Sohn-Tasks möglich. 
+ 
+halt 
+     PROC halt 
+     Zweck: Das laufende Programm der dem Terminal aktuell zugeordneten Task 
+            wird abgebrochen. Im Gegensatz zum 'end'-Kommando wird nur das 
+            laufende Programm abgebrochen, aber die Task wird nicht gelöscht. 
+            Genauer: 
+            Es wird der Fehler 'halt from terminal' induziert. Normalerweise 
+            wird das Programm dadurch wie durch jeden anderen Fehler abge- 
+            brochen. Genaueres findet man im Systemhandbuch unter Fehler- 
+            behandlung. 
+ 
+name 
+     TEXT PROC name (TASK CONST interner name) 
+     Zweck: Wandelt den internen Task-Namen in einen TEXT. 
+ 
+rename myself 
+     PROC rename myself (TEXT CONST neuer name) 
+     Zweck: Umbenennen einer Benutzer-Task. 
+ 
+myself 
+     TASK PROC myself 
+     Zweck: Liefert den internen Task-Namen der Benutzer-Task. 
+ 
+storage info 
+     PROC storage info 
+     Zweck: Informationsprozedur über den verfügbaren Hintergrund-Speicher. 
+ 
+task info 
+    PROC task info 
+    Zweck: Informiert über alle Tasknamen im System unter gleichzeitiger An- 
+           gabe der Vater/Sohn-Beziehungen (Angabe durch Einrückungen). 
+ 
+    PROC task info (INT CONST art) 
+    Zweck: Informiert über alle Tasks im System. Mit 'art' kann man die Art 
+           der Zusatz-Information auswählen. Für 'art' sind zur Zeit 
+           folgende Werte zugelassen: 
+ 
+           1: entspricht 'task info' ohne Parameter, d.h. gibt nur die 
+              Tasknamen unter angabe der Vater/Sohn-Beziehungen aus. 
+ 
+           2: gibt die Tasknamen aus. Zusätzlich erhalten Sie Informationen 
+              über die verbrauchte CPU-Zeit der Task, die Priorität, den 
+              Kanal, an dem die Task angekoppelt ist und den eigentlichen 
+              Taskstatus. Hierbei bedeuten: 
+ 
+              0    -busy-        Task ist aktiv. 
+              1    i/o           Task wartet auf Beendigung des Outputs 
+                                 oder auf Eingabe. 
+              2    wait          Task wartet auf Sendung von einer anderen 
+                                 Task. 
+              4    busy-blocked  Task ist rechenwillig, aber blockiert. 
+              5    i/o -blocked  Task wartet auf I/O, ist aber blockiert. 
+              6    wait-blocked  Task wartet auf Sendung, ist aber blockiert. 
+                                 Achtung: Die Task wird beim Eintreffen einer 
+                                 Sendung automatisch entblockiert. 
+ 
+           3: wie 2, aber zusätzlich wird der belegte Speicher angezeigt. 
+              (Achtung: Prozedur ist aufwendig!). Beachten Sie, daß Dateien 
+              mit Väter/Söhnen "geshared" werden. Beispiel: 
+              Mit 'begin ("sohn", "vater")' wird eine neue Task eingerichtet. 
+              Für 'sohn' wird in diesem Zustand der gleiche belegte Speicher 
+              angezeigt wie für 'vater'. Erst wenn (Datei-)Operationen in 
+              der Sohn- oder Vater-Task vorgenommen werden, wird ein unter- 
+              schiedlicher Speicherplatz angezeigt. 
+ 
+task status 
+    PROC task status 
+    Zweck: Informationsprozedur über den Zustand der eigenen Task. 
+           Informiert u.a. über 
+           - Name der Task, Datum und Uhrzeit; 
+           - verbrauchte CPU-Zeit; 
+           - belegten Speicherplatz; 
+           - Kanal, an den die Task angekoppelt ist; 
+           - Zustand der Task (rechnend u.a.m.); 
+           - Priorität. 
+ 
+    PROC task status (TASK CONST t) 
+    Zweck: Wie obige Prozedur, aber über die Task mit dem internen Task- 
+           namen 't'. Beispiel: task status (father) 
+ 
+task password 
+     PROC password (TEXT CONST geheim) 
+     Zweck: Einstellen eines Paßworts für eine Task im Monitor. Das Kommando 
+            'task password' ist ein Monitor-Kommando. Ist eine Task mit einem 
+            Paßwort geschützt, so wird durch den Supervisor nach dem 
+            'continue'-Kommando das Paßwort angefragt. Nur nach Eingabe des 
+            richtigen Paßworts gelangt man in die gewünschte Task. Das Paß- 
+            wort kann durch nochmaligen Aufruf von 'task password' geändert 
+            werden, z.B., wenn es in regelmäßigen Abständen geändert werden 
+            muß, um personenbezogene Daten zu schützen. 
+ 
+            Es gibt keine Möglichkeit, ein einmal eingestelltes Paßwort in 
+            Erfahrung zu bringen. Sollte das Paßwort vergessen werden, kann 
+            somit die Task nur noch gelöscht werden. 
+ 
+            Wird als Paßwort ein '-'-Zeichen eingegeben, so wird verhindert, 
+            daß die betreffende Task jemals wieder mit dem 'continue'-Kom- 
+            mando angekoppelt werden kann. Dies ist z.B. für Manager-Tasks 
+            sinnvoll. 
+ 
+ 
+ 
+3. Der Monitor 
+ 
+Der EUMEL-Monitor führt den Dialog mit dem Benutzer innerhalb einer Task. In 
+diesem Kapitel werden nur die Ausführung der Kommandos und die Kommando- 
+Arten  beschrieben, während die einzelnen Kommandos selbst in den jeweiligen 
+Kapiteln des Benutzerhandbuchs erläutert werden. 
+ 
+Der Monitor ermöglicht es, Leistungen im Dialog mit Hilfe von Kommandos 
+(ELAN-Prozeduraufrufen) vom EUMEL-Betriebssystem anzufordern. Nach dem 
+Beginn einer Sitzung meldet sich der Monitor mit 
+ 
+     gib kommando : 
+ 
+Danach kann der Benutzer Monitor-Kommandos geben. Erfolgt dabei ein Schreib- 
+fehler, so kann er (wie beim Editor) innerhalb der Zeile positionieren, über- 
+schreiben, löschen, einfügen u.a.m.. Die Ausführung des/der Kommandos wird 
+mit der Taste RETURN ausgelöst. Nach Abschluß einer Kommando-Ausführung er- 
+scheint wieder obige Meldung. Die Tastenfolge ESC k stellt das zuletzt gege- 
+bene Kommando wieder dar. 
+ 
+Monitor-Kommandos müssen gemäß der ELAN-Syntax geschrieben werden (Kommando- 
+Namen werden klein geschrieben, Parameter in Klammern, mehrere Parameter 
+durch Kommata getrennt, TEXT-Parameter in Anführungstrichen usw.). Beispiele: 
+ 
+     edit ("meine datei") 
+     copy ("meine datei", "Duplikat") 
+ 
+Bei den meisten Kommandos mit einem TEXT-Parameter kann der Parameter fort- 
+gelassen werden. Der Monitor versorgt das Kommando immer mit dem zuletzt an- 
+gegebenen Parameter und zeigt dies auch auf dem Bildschirm des Benutzers an. 
+Beispiel: 
+ 
+     edit ("Datei vom 17.4.") 
+ 
+schreibt der Nutzer nun z.B. 
+ 
+     run 
+ 
+und betätigt RETURN, dann ergänzt der Monitor das Kommando: 
+ 
+     run ("Datei vom 17.4.") 
+ 
+Monitor-Kommandos sind einzeilige ELAN-Programme, die dem ELAN-Compiler zur 
+Übersetzung und anschließender Ausführung zugeleitet werden. Darum können 
+die Monitor-Kommandos auch von Programmen aus verwendet werden. Falsch ge- 
+schriebene oder nicht vorhandene Kommandos werden vom ELAN-Compiler mit ent- 
+sprechender Fehlermeldung abgewiesen. Oft benutzte Kommandos werden aus 
+Effizienzgründen vom Monitor selbst interpretiert und ausgeführt. Durch die 
+automatische Überleitung von Kommandos zum ELAN-Compiler ist es möglich 
+ 
+a) einzeilige ELAN-Programme direkt in der Monitor-Ebene ausführen zu 
+   lassen, d.h. ohne das Programm in eine Datei zu schreiben. Beispiel: 
+ 
+     put (sin (0.5)) 
+ 
+b) mehrere Kommandos (ELAN-Anweisungen), durch ";" getrennt, auf einmal zu 
+   schreiben. Beispiele: 
+ 
+     edit ("datei"); lineform ("datei"); print ("datei") 
+     INT VAR i; FOR i FROM 1 UPTO90 REP print ("x") ENDREP 
+ 
+c) eine Erweiterung des Kommando-Vorrats jederzeit vorzunehmen, indem man 
+   die gewünschte Prozedur (in einem PACKET "verpackt") 'insertiert'. 
+ 
+Im folgenden werden die am häufigsten benutzten Kommandos aufgeführt. 
+Genauere Informationen über die einzelnen Kommandos findet man in den 
+entsprechenden Kapiteln des Benutzerhandbuchs. 
+ 
+Informations-Kommandos 
+ 
+     storage info               Belegter externer Speicher 
+     task info                  Zeigt die im System befindlichen Tasks 
+     task status                Zustände der im System befindlichen Tasks 
+ 
+ 
+Verbindung zum Supervisor 
+ 
+     end                        Task und die in ihr befindlichen Dateien 
+                                löschen 
+     break                      Task abkoppeln 
+     task password ("geheim")   Paßwort einstellen 
+ 
+ 
+Editor-Kommandos 
+ 
+     edit ("datei")             Datei editieren 
+     edit ("datei1", "datei2")  Parallel-Editor 
+ 
+ 
+Compiler-Kommandos 
+ 
+     run ("datei")              Übersetzen und ausführen eines ELAN-Programms 
+     run again                  Letztes übersetztes Programm nochmal aus- 
+                                führen 
+     insert ("datei")           Übersetztes Programm eintragen 
+ 
+ 
+Datei-Kommandos 
+ 
+     copy ("datei", "duplikat") Datei kopieren 
+     rename ("alt", "neu")      Datei umbenennen 
+     reorganize ("datei")       Datei "reorganisieren" 
+     fetch      ("datei")       Datei von Vater-Task holen 
+     save       ("datei")       Datei zur Vater-Task schicken 
+     erase      ("datei")       Datei in Vater-Task löschen 
+     forget     ("datei")       Datei in Benutzer-Task löschen 
+     list                       Dateien der Benutzer-Task anzeigen 
+ 
+ 
+Archiv-Kommandos 
+ 
+     archive ("name")           Archiv mit einem Namen reservieren 
+     release   (archive)        Archiv freigeben 
+     clear     (archive)        Löscht ein Archiv 
+     list      (archive)        Dateien des Archivs anzeigen 
+     save all  (archive)        Archiviert alle Dateien einer Task 
+     fetch all (archive)        Holt alle Dateien eines Archivs in eine Task 
+     save  ("datei", archive)   Datei archivieren 
+     fetch ("datei", archive)   Datei vom Archiv holen 
+ 
+ 
+Textkosmetik und Drucker 
+ 
+     lineform ("datei")         Zeilenweises Formatieren 
+     pageform ("datei")         Seitenweises Formatieren 
+     index    ("datei")         Stichwort- und Inhaltsverzeichnis 
+     print    ("datei.p")       Drucken 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3
new file mode 100644
index 0000000..eaf1ed6
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3
@@ -0,0 +1,2097 @@
+                          EUMEL-Benutzerhandbuch 
+ 
+                          TEIL 3: Editor                            
+ 
+Vorwort 
+ 
+Der EUMEL-Editor ist ein Programm zur Bearbeitung von Texten. Er bietet 
+vielfältige Möglichkeiten, um Autoren oder Programmierer bei dem Erstellen, 
+Korrigieren und Gestalten von Manuskripten oder Programmen zu unterstützen. 
+Die größte Hilfe beim Schreiben besteht (durch die Speicherfähigkeit von 
+Computern) aus dem Zugriff auf einmal geschriebene Informationen. Im Gegen- 
+satz zu einer Schreibmaschine können durch den EUMEL-Editor (beliebig oft) 
+Einfügungen vorgenommen, Texte korrigiert, gelöscht und umgeordnet werden. 
+Somit ist das Schreiben von Texten mittels des EUMEL-Systems besonders dann 
+vorteilhaft und zeitsparend, wenn Texte häufig geändert werden oder wenn 
+sie in einer besonders schönen Form gedruckt werden sollen (sofern ein ent- 
+sprechender Drucker zur Verfügung steht). Weiterhin bietet der Editor Hilfen 
+zum Schreiben an, wie z.B. automatischen Wortumbruch am Zeilenende, eine 
+Einrückungsautomatik, "Lernen" von Texten u.a.m.. Zusätzlich kann der Editor 
+in seinen Fähigkeiten erweitert und somit für spezielle Schreibarbeiten an- 
+gepaßt werden. Bei der Entwicklung des Editors wurde besonderer Wert auf 
+einfache Bedienung gelegt: innerhalb von wenigen Minuten kann schon ge- 
+schrieben werden und auf dem Bildschirm sieht man direkt, was mit dem Text 
+passiert. Das Schreiben und die Korrektur werden durch einige wenige, aber 
+leistungsstarke Funktionstasten unterstützt. 
+ 
+Anfänger sollten zumindest das erste Kapitel lesen, bevor mit dem Schreiben 
+begonnen wird. Dort wird geschildert, wie auf einfache Weise Texte ge- 
+schrieben und geändert werden können. Die beschriebenen Tätigkeiten sollte 
+man an einem kleinen Probetext erst einmal ausprobieren. Lesen und an- 
+schließendes Ausprobieren eines der hier beschriebenen Vorgänge beschleunigt 
+stark das Erlernen der Funktionen des Editors. 
+ 
+Weitere Fähigkeiten des Editors werden in den folgenden Kapiteln erläutert. 
+Diese Kapitel sollte man lesen, wenn die ersten Texte geschrieben worden 
+sind. Die dort erklärten Möglichkeiten des Editors kann man dann bei Bedarf 
+nachlesen, erlernen und einsetzen. Im letzten Kapitel werden Programmierern 
+Hinweise gegeben, wie sie die Benutzerschnittstelle des Editors an indivi- 
+duelle Bedürfnisse anpassen können. 
+ 
+Einige Gestaltungsmöglichkeiten für Texte kann man nicht auf dem Terminal 
+"sehen", wie z.B. Proportionalschriften, Fettdruck usw.. Solche Leistungen 
+können durch Anweisungen an die Textkosmetik-Programme und den EUMEL-Drucker 
+angefordert werden. Diese Anweisungen müssen in den Text eingefügt werden. 
+Dazu sollte das Kapitel über die Textkosmetik gelesen werden. 
+ 
+is nämlich alles ohne Radiergummi-Abbildung !!! 
+ 
+ 
+ 
+1. Einführung in die Benutzung des Editors 
+ 
+In diesem Kapitel beschreiben wir das Tastenfeld eines EUMEL-Terminals, weil 
+es hier einige Tasten gibt, die auf einer Schreibmaschine nicht vorhanden 
+sind. Anschließend erklären wir, wie der Editor ein- und ausgeschaltet wird, 
+wie Texte geschrieben und auf einfache Weise korrigiert werden können. Eine 
+kurze Erklärung des Tabulators beendet die Einführung. 
+ 
+ 
+ 
+Das Tastenfeld 
+ 
+In diesem Abschnitt wird das Tastenfeld eines EUMEL-Terminals erklärt. Es 
+wird erläutert, wo sich die Tasten befinden und wie man Umlaute schreibt. 
+ 
+Das Tastenfeld eines EUMEL-Terminals entspricht weitgehend dem einer 
+Schreibmaschine. Wir finden also die Buchstaben a-z und die Ziffern 0-9 auf 
+Tasten. Mit der SHIFT-Taste und gleichzeitigem Drücken einer anderen Taste 
+können die großen Buchstaben und eine Reihe von speziellen anderen Zeichen, 
+die Sonderzeichen genannt werden, geschrieben werden. Die "Zwischenraum- 
+taste" oder Leertaste erzeugt immer ein Leerzeichen. 
+ 
+Nun gibt es in der Praxis zwei unterschiedliche Tastaturen. Zum einen 
+existiert die EDV-Tastatur, die zum Schreiben von Programmen benutzt wird. 
+Sie erkennt man daran, daß keine Umlaute (ä, ü, ö) und kein ß auf den Tasten 
+eingraviert sind. Dafür gibt es Tasten für eckige und geschweifte Klammern. 
+Sollen auf einer solchen Tastatur die Umlaute geschrieben werden, muß man 
+sich eines Tricks bedienen: mit der Taste ESC und nachfolgendem Betätigen 
+einer anderen Taste erhalten wir den entsprechenden Umlaut. 
+Diese Tasten sind standardmäßig vorbelegt, können aber von Benutzern und in 
+Anwenderprogrammen geändert werden. 
+ 
+     ESC a bringt ä, ESC A bringt Ä 
+     ESC u bringt ü, ESC U bringt Ü 
+     ESC o bringt ö, ESC O bringt Ö und 
+     ESC s bringt ß. 
+ 
+In der Regel kann man die Umlaute auf dem Bildschirm eines solchen EDV- 
+Terminals nicht sehen, sondern sie erscheinen als a, u, usw.. Beim Druck 
+eines Textes werden sie aber richtig dargestellt. 
+ 
+Die andere Tastatur entspricht in der Tastenbelegung weitgehend einer deut- 
+schen Schreibmaschine und besitzt Tasten für die Umlaute und ß. Sollen vor- 
+wiegend deutsche Texte geschrieben werden, empfiehlt es sich, solch ein 
+Terminal zu verwenden. 
+ 
+Neben diesen "einfachen" Tasten gibt es noch einige wenige Tasten, die zur 
+Bedienung des Editors (aber auch anderer Programme) notwendig sind. Wo die 
+Tasten auf Ihrem Gerät liegen, hängt von dem jeweiligen Gerätetyp ab. Die 
+Wirkung der Tasten erklären wir in den anschließenden Abschnitten. 
+Es kann sein, daß die Tasten nicht richtig beschriftet sind. Dann sollten Sie 
+den Betreuer ihrer Installation bitten, diese zu beschriften. Zusätzlich zu 
+den hier beschriebenen können sich noch weitere Tasten auf ihrem Terminal 
+befinden, die aber keine besondere Bedeutung für den Editor haben. 
+ 
+Taste          Bedeutung 
+----------------------------------------------------------------------------- 
+SHIFT          Umschalttaste. 
+               Für Großbuchstaben statt Kleinbuchstaben und Sonderzeichen 
+               statt Ziffern. 
+ 
+RETURN         Beginn einer neuen Zeile (Absatz). 
+               Die RETURN-Taste ist oft mit einem geknicktem Pfeil nach 
+               links gekennzeichnet. Im Kommandomodus (also bei "gib 
+               kommando :") wird ein gegebenes Kommando ausgeführt. 
+ 
+LINKS          Tasten für die Positionierung. 
+RECHTS 
+OBEN 
+UNTEN 
+               Positionierung der Schreibmarke (Cursor) in die jeweilige 
+               Richtung (auf den Tasten oft auch durch Pfeile dargestellt). 
+ 
+HOP            "Verstärkertaste": Wirkt als Vorschalttaste. 
+ 
+RUBOUT         Löschtaste. 
+ 
+RUBIN          Ein- bzw. Ausschalten des Einfügezustandes. 
+ 
+TAB            Tabulatortaste. 
+ 
+MARK           Ein- bzw. Ausschalten der Markierung. 
+ 
+ESC            Kommandotaste. 
+ 
+Merke: Das Tastenfeld eines EUMEL-Terminals ist in der Regel wie das einer 
+Schreibmaschine und kann ebenso bedient werden. Umlaute müssen bei EDV- 
+Tastaturen mit Hilfe der Taste ESC geschrieben werden. Einige Spezialtasten 
+werden benutzt, um die Textbearbeitung des Editors zu steuern. 
+ 
+Weitere Kommandotasten: 
+   SV          Supervisor-Taste im Mehrbenutzer-Betrieb ("multi-user"). 
+               Diese Taste bewirkt den Aufruf des Supervisors und ist keine 
+               spezielle Editor-Taste. 
+   STOP        Anhalten eines Programms. 
+               Wird die Taste aus Versehen betätigt (erkennbar daran, daß 
+               der Editor nicht "reagiert"), muß WEITER betätigt werden. 
+   WEITER      Programm soll weiterlaufen. 
+ 
+ 
+ 
+Speicherung von Texten 
+ 
+In diesem Abschnitt wird der Begriff "Datei" erklärt und erläutert, wie 
+unterschiedliche Texte auseinandergehalten werden können. 
+ 
+Das EUMEL-System speichert einmal geschriebene Texte, bis sie vom Benutzer 
+gelöscht werden. In der Regel wird nicht nur ein (langer) Text oder ein Pro- 
+grammtext geschrieben, sondern mehrere und unterschiedliche. Um diese aus- 
+einanderhalten zu können, versehen wir sie jeweils mit einem Namen, der frei 
+gewählt werden kann. Beispiele für Namen: 
+ 
+   "Brief vom 1.8.83" 
+   "1. Kapitel meines Buches" 
+ 
+Eine Sammlung von Zeichen (also im Normalfall unsere geschriebenen Texte), 
+die mit einem Namen versehen worden ist, nennt man eine 'Datei' ('file'). Der 
+Editor erstellt also eine Datei, wenn wir einen Text schreiben. Eine Datei 
+kann bis zu 4 000 Zeilen fassen, wobei eine Zeile bis zu 32 000 Zeichen lang 
+sein darf. 
+ 
+Mit Hilfe des (Datei-) Namens kann man den Text (immer) wieder ansprechen, 
+solange, bis die Datei gelöscht wird. Bei der Bearbeitung einer Datei durch 
+den Editor wirkt sich jede Änderung des Textes auf dem Bildschirm sofort bis 
+in die gespeicherte Datei aus. Eine Datei kann durch Kommandos verarbeitet 
+werden. Eine Auswahl (Vergl. dazu die Beschreibung des Monitors): 
+ 
+edit (Datei bearbeiten), rename (Datei umbenennen), copy (Duplizieren der 
+Datei), to archive (Archivieren), lineform bzw. autoform (Zeilen 
+formatieren), pageform (Seiten formatieren), print (Drucken) usw. 
+ 
+Merke: Ein Text wird im EUMEL-System in einer Datei gehalten. Eine Datei 
+faßt bis zu 4000 Zeilen Text. Eine Datei kann über den Dateinamen ange- 
+sprochen werden, der frei gewählt werden kann. 
+ 
+ 
+ 
+Ein- und Ausschalten des Editors 
+ 
+Hier beschreiben wir, wie der Editor ein- und ausgeschaltet wird und wie 
+der Editor eine Datei einrichtet. Zusätzlich wird das Ausschalten des auto- 
+matischen Wortumbruchs erklärt. 
+ 
+Wenn auf dem Bildschirm die Aufforderung 
+ 
+    gib kommando : 
+ 
+erscheint, befindet man sich in der Monitor-Ebene. Durch 
+ 
+    edit ("dateiname") 
+ 
+kann der EUMEL-Editor eingeschaltet (programmtechnisch: "aufgerufen") 
+werden. Ist die Datei noch nicht vorhanden, d.h. kein Text unter dem ange- 
+gebenen Namen im System gespeichert, folgt eine Anfrage, ob eine neue Datei 
+eingerichtet werden soll. Dies dient zur Kontrolle von Schreibfehlern, die 
+besonders bei ähnlichen Dateinamen auftreten. Man kann dann das Einrichten 
+der Datei ablehnen, den Dateinamen verbessern und das Kommando erneut geben. 
+ 
+Der Editor zeigt jetzt in der obersten Zeile des Bildschirms die Titelzeile, 
+die den Dateinamen und die Zeilennummer enthält, die gerade bearbeitet wird. 
+Im Fall einer bereits beschriebenen Datei zeigt der Editor das zuletzt bear- 
+beitete Textstück. Bei einer neuen Datei ist der Bildschirm unterhalb der 
+Titelzeile leer. Dieser Teil dient als "Schreibfläche". Der Cursor, so nennt 
+man die blinkende Schreibmarke, steht dann direkt unter der Titelzeile. Er 
+zeigt immer die aktuelle Schreibposition an. Jetzt kann sofort mit dem 
+Schreiben begonnen werden, ganz wie mit einer normalen Schreibmaschine. 
+ 
+Beenden der Schreibarbeit und Ausschalten des Editors erfolgt durch Drücken 
+der beiden Tasten 
+ 
+     ESC q 
+ 
+nacheinander. Man befindet sich wieder in der alten Kommando-Ebene. 
+ 
+Es ist aber auch möglich, während der Schreibarbeit (also bei eingeschalte- 
+tem Editor) durch zweimaliges Drücken von ESC in die (Editor) Kommando- 
+Ebene zu gelangen. Nach Abarbeitung des Kommandos gelangt man wieder in den 
+normalen Schreibzustand. 
+ 
+Der Editor ist auf das Schreiben von "normalen" Texten eingestellt. Bei 
+"normalen" Texten soll ein Wort, welches über das Ende einer Zeile gehen 
+würde, automatisch in die nächste Zeile gebracht werden. Dies wird 
+"Wortumbruch" genannt. 
+ 
+Ist kein Wortumbruch erwünscht, so gibt man das Kommando 
+ 
+    word wrap (false) 
+ 
+In diesem Fall schreibt der Editor bis zum Zeilenende und springt dann auto- 
+matisch (u.U. mitten im Wort) auf die nächste Zeile. Der Wortumbruch kann 
+durch 
+ 
+    word wrap (true) 
+ 
+wieder eingeschaltet werden. 
+ 
+Merke: Der Editor wird durch das Kommando 'edit ("name")' aufgerufen und 
+und wird durch ESC q wieder verlassen. Der Cursor zeigt die aktuelle 
+Schreibposition an. Der Editor ist auf automatischen Wortumbruch eingestellt. 
+ 
+ 
+ 
+Schreiben eines Textes 
+ 
+In diesem Abschnitt wird erklärt, wie ein Text geschrieben wird und was es 
+mit Absätzen auf sich hat. 
+ 
+Nach dieser etwas langen Vorrede können wir endlich losschreiben. Wird ein 
+Zeichen geschrieben, rückt der Cursor automatisch nach rechts auf die 
+nächste Schreibstelle. Durch den automatischen Wortumbruch werden ange- 
+fangene Worte, die über ein Zeilenende hinausgehen würden, ohne Silbentren- 
+nung in die nächste Zeile gebracht. 
+Nehmen Sie bitte keine Silbentrennung "per Hand" vor (wie in dieser An- 
+leitung).Eingebrachte Trennstriche gelten als Bindestrich und bleiben somit 
+auch bei Umformatierungen erhalten, was unerwünscht ist. Für diese mühevolle 
+Aufgabe gibt es in der Textkosmetik ein Programm! 
+ 
+Die RETURN-Taste (bei einer Schreibmaschine bedeutet sie "Wagenrücklauf") 
+braucht also nur noch betätigt zu werden, wenn eine Zeile vorzeitig beendet 
+werden soll: also bei einem Absatz oder einer Leerzeile. Der Cursor wird da- 
+bei an den Anfang der nächsten Zeile positioniert. Gleichzeitig erscheint in 
+der vorherigen Zeile am rechten Rand des Bildschirms eine Markierung, die 
+anzeigt, daß hier ein Absatz gemacht wurde. 
+ 
+Diese Absatzkennzeichnung ist wichtig: Sie bedeutet u.a. eine "Grenze" für 
+die Textkosmetik-Programme beim (optimalen) Auffüllen von Zeilen. Für den 
+Drucker bedeutet ein Absatz, keinen rechten Randausgleich (druckertechnisch: 
+"Blocksatz") in dieser Zeile vorzunehmen. 
+Die Absatzkennzeichnung besteht aus einem Leerzeichen in der Datei ("blank"; 
+im Unterschied zur Schreibmaschine ist das Leerzeichen in der EDV auch ein 
+Zeichen und wird gespeichert). Absatzkennzeichen können gelöscht oder auch 
+hinzugefügt werden (wie das gemacht wird, erfahren Sie in den nächsten Ab- 
+schnitten). Ist der Wortumbruch ausgeschaltet, erscheint keine Absatzkenn- 
+zeichnung beim Betätigen der RETURN-Taste. 
+ 
+Darum ist das Betätigen der RETURN-Taste bei Tabellenzeilen und Programm- 
+texten besonders wichtig, denn hier soll ja jede Zeile separat bleiben. 
+ 
+Ein Bildschirm faßt (neben der Titelzeile) üblicherweise 23 Zeilen, die mit 
+Text beschrieben werden können. Ist die letzte Zeile voll und muß eine neue 
+Zeile begonnen werden, "rutscht" der Bildschirminhalt automatisch um eine 
+Zeile nach oben. Damit ist Platz für eine Leerzeile, die nun ebenfalls be- 
+schrieben werden kann usw.. Keine Angst: die so verschwundenen Zeilen sind 
+natürlich nicht "weg". Da ein Bildschirm immer nur eine beschränkte Anzahl 
+von Zeilen hat, kann der Editor nur einen Ausschnitt aus der Datei zeigen. 
+In unserem Fall, wo wir zunächst nur am Ende der Datei schreiben, werden 
+also immer die letzten Zeilen der Datei angezeigt. 
+ 
+Merke: Ist der Wortumbruch eingeschaltet, wird ein angefangenes Wort, das 
+über das Zeilenende gehen würden, an den Anfang der neuen Zeile gebracht. 
+Die RETURN-Taste wird nur bei Absätzen, Tabellenzeilen oder Leerzeilen be- 
+tätigt. In diesem Fall erscheint eine Absatzkennzeichnung am rechten Rand 
+des Bildschirms. Ist der Bildschirm vollgeschrieben, werden beim fort- 
+laufenden Schreiben alle Zeilen um eine Zeile nach oben gerückt. 
+ 
+ 
+ 
+Einrückungen 
+ 
+Hier wird die Einrückungsautomatik erklärt. 
+ 
+Soll ein Text eingerückt werden (wie in den obigen "Merke"-Zeilen) oder bei 
+Aufzählungen, so wird die in der ersten Zeile geschriebene Einrückung auto- 
+matisch in den folgenden Zeilen beibehalten, bis sie durch die Posi- 
+tionierungstasten wieder aufgehoben wird. Es gibt also kein Einrückkommando. 
+Wie der rechte Rand (also die Zeilenbreite) eingestellt wird, erklären wir 
+später. 
+Dies kann für die gesamte Datei (und somit für den gesamten Text) durch ein 
+ein Kommando erfolgen, mit welchem man den Editor auf diese Zeilenbreite 
+einstellt. Um den rechten Rand nur für einige Zeilen zu verändern (wie z.B. 
+bei unseren "Merke"-Zeilen) kann ein 'limit'-Kommando der Textkosmetik 
+verwandt werden. 
+ 
+Merke: Einrückungen werden automatisch beibehalten. 
+ 
+ 
+ 
+Einfaches Positionieren und das Editor-Fenster  
+ 
+Um Korrekturen (Überschreiben, Löschen oder Einfügen) vorzunehmen, muß der 
+Cursor, der die aktuelle Schreibposition anzeigt, bewegt werden können. Bei 
+längeren Texten ist es möglich, den Cursor auch auf Zeilen zu positionieren, 
+die sich (noch nicht) auf dem Bildschirm befinden. Somit zeigt der Editor 
+nicht nur immer das Ende einer Datei, sondern einen beliebigen Ausschnitt, 
+der auf dem Bildschirm im sogenannten Fenster sichtbar ist. 
+ 
+Ist eine Korrektur notwendig, muß der Cursor (blinkende Schreibmarke) auf die 
+Stelle positioniert werden, an der die Korrektur vorgenommen werden soll. 
+Dazu verwenden wir die Positionierungstasten LINKS, RECHTS, OBEN und UNTEN. 
+LINKS und RECHTS bewegen den Cursor innerhalb einer Zeile. Stößt man mit 
+RECHTS an das Ende einer Zeile, wird der Cursor an den Anfang der nachfol- 
+genden Zeile bewegt. (Positionierungen jenseits des linken Randes sind nicht 
+möglich). 
+ 
+Ein Zeilenwechsel kann einfacher mit den Tasten OBEN und UNTEN vorgenommen 
+werden. Die Taste OBEN bewegt den Cursor eine Zeile nach oben, die Taste 
+UNTEN entsprechend eine Zeile tiefer. 
+ 
+Was passiert nun, wenn der untere oder der obere Rand des Bildschirms er- 
+reicht wird und es wird darüber hinaus positioniert? In diesem Fall wird der 
+Text zeilenweise nach oben oder nach unten verschoben und es erscheint die 
+gewünschte Zeile, wobei andere am anderen Rand "verschwinden". Wir sehen 
+also, daß wir mit den Positionierungstasten den Bildschirm als Fenster über 
+die Datei hinweggleiten lassen können (Fachausdrücke: "roll up" oder "roll 
+down"). Den Text selbst können wir uns auf einem langen Band geschrieben 
+vorstellen. Die Zeilennummer, in der der Cursor steht, wird stets in der 
+Titelzeile angezeigt. 
+ 
+Innerhalb einer Zeile ist es etwas anders: Positionieren wir bei einer Zeile, 
+die breiter als der Bildschirm ist, nach rechts, wird das Fenster nur für 
+diese Zeile verschoben (Fachausdruck: "scrolling"). 
+ 
+Merke: Mit Hilfe der vier Positionierungstasten kann man den Cursor auf dem 
+Bildschirm bewegen. Außerdem ist es möglich, das Fenster mittels der 
+Positionierungstasten über den Text zu bewegen. 
+ 
+ 
+ 
+Einfache Korrekturen: Zeichen überschreiben, löschen und einfügen 
+ 
+In diesem Abschnitt wird erklärt, wie einfache Korrekturen durch Über- 
+schreiben von Zeichen, Löschen von Zeichen und Einfügen von Zeichen vorge- 
+nommen werden können. 
+ 
+Es können Korrekturen gleich beim Schreiben vorgenommen werden, indem die 
+zuletzt geschriebenen Zeichen mit der RUBOUT-Taste gelöscht werden. Häufig 
+merkt man aber Schreibfehler erst etwas später, so daß man diese Fehler nicht 
+so leicht korrigieren kann. Für solche Zwecke muß man den Cursor an die Text- 
+stelle bewegen, an dem korrigiert werden soll. Wie man das macht, haben wir 
+im letzten Abschnitt geschildert. 
+ 
+Die einfachste Möglichkeit der Korrektur ist das Überschreiben. Soll z.B. ein 
+Zeichen durch ein anderes ersetzt werden, so positioniert man den Cursor 
+genau über dieses und tippt das richtige Zeichen ein.Das kann natürlich auch 
+mit mehreren Zeichen nacheinander erfolgen. 
+ 
+Will man ein Zeichen löschen, so positioniert man auch hier den Cursor auf 
+dieses Zeichen und betätigt die Taste RUBOUT. Das Zeichen verschwindet und 
+die Restzeile rückt heran. Sollen mehrere Zeichen gelöscht werden, muß die 
+RUBOUT-Taste entsprechend oft gedrückt werden. 
+ 
+Steht der Cursor hinter dem letzten Zeichen der Zeile, wird immer das letzte 
+Zeichen der Zeile gelöscht. Man kann also mit dieser Eigenschaft eine Zeile 
+"von hinten wegradieren". 
+ 
+Fehlende Zeichen kann man genauso einfach einfügen. Man bringt den Cursor 
+auf das Zeichen, vor das eingefügt werden soll. Dann drückt man die Taste 
+RUBIN. Der Editor gelangt in den Einfüge-Zustand, was in der Titelzeile durch 
+RUBIN angezeigt wird. Er fügt alle Zeichen ein, die jetzt getippt werden (an- 
+statt zu überschreiben). Der Teil der Zeile rechts vom Cursor rückt jeweils 
+um entsprechend viele Stellen nach rechts. 
+ 
+Wichtig ist, daß im RUBIN-Zustand der Editor genauso funktioniert wie im 
+Normal-Zustand (natürlich mit der Ausnahme, daß eingefügt statt überschrieben 
+wird). 
+ 
+Ein neuerliches Betätigen der RUBIN-Taste beendet den Einfüge-Zustand. Die 
+RUBIN-Taste wirkt also wie ein Schalter, der den Einfüge-Zustand ein- und 
+ausschaltet. Allerdings kann man nur so viele Zeichen in eine Zeile einfügen, 
+bis das letzte Wort der Zeile an das Zeilenende stößt. Das angefangene Wort 
+wird am Anfang der folgenden Zeile eingefügt, sofern dort noch Platz ist und 
+es nicht offensichtlich ein Absatzende kennzeichnet. Andernfalls wird auto- 
+matisch eine neue Zeile für das angefangene Wort eingefügt. 
+ 
+Im eingeschalteten RUBIN-Zustand können keine Zeichen verloren gehen. Viele 
+Benutzer lassen darum den RUBIN-Zustand immer eingeschaltet, um sich vor dem 
+unbeabsichtigten Überschreiben von Texten zu schützen. Es wird korrigiert, 
+indem man die Verbesserung einfügt und den alten Text löscht. 
+ 
+Merke: Mit Hilfe der Positionierungstasten LINKS, RECHTS, OBEN und UNTEN 
+kann eine Stelle in der Datei ausgewählt werden, an der eine Korrektur vor- 
+genommen werden soll. Die einfachste Korrektur ist das Überschreiben von 
+fehlerhaften Zeichen. Zeichen löschen erfolgt mit der Taste RUBOUT. Mit 
+RUBIN kann der Einfüge-Zustand ein- und ausgeschaltet werden. Im Einfüge-Zu- 
+stand wird nicht überschrieben, sondern es wird vor der Cursor-Position das 
+getippte Zeichen eingefügt. 
+ 
+ 
+ 
+Springen, Zeilen einfügen/löschen mittels HOP-Taste 
+ 
+Bewegungen des Cursors sind mit den Positionierungstasten bei größeren "Ab- 
+ständen" etwas mühsam, ebenso bei umfangreichen Löschungen und Einfügungen. 
+Die "Verstärkertaste" HOP ermöglicht es, diese Operationen auf einfache 
+Weise zu beschleunigen. Mit der HOP-Taste kann man das Fenster über der 
+Datei nicht nur zeilenweise, sondern auch um jeweils eine Fensterlänge ver- 
+schieben. Das nennt man Blättern. 
+ 
+Wird die HOP-Taste vor einer anderen der schon erklärten Funktionstasten 
+gedrückt, verstärkt sie deren Wirkung. Die HOP-Taste ist eine "Präfix"-Taste: 
+sie wird vor (und nicht gleichzeitig, wie z.B. die Umschalttaste SHIFT) einer 
+anderen Taste gedrückt. Zuerst das springende Positionieren: 
+Weitere wichtige Anwendungen der HOP-Taste beschreiben wir in den nächsten 
+Abschnitten. 
+ 
+HOP RECHTS   Sprung an das rechte Zeilenende. 
+             Falls die Zeile länger als das Fenster breit ist, wird seitlich 
+             geblättert. 
+ 
+HOP LINKS    Sprung an den Zeilenanfang (ggf. seitlich blätternd). 
+ 
+HOP OBEN     Sprung auf die erste Zeile des Bildschirms. 
+             Nochmaliges Betätigen dieser Tastenkombination positioniert den 
+             Cursor (und damit das Fenster in der Datei) um ein Fenster 
+             zurück. 
+ 
+HOP UNTEN    Sprung auf die letzte Zeile des Bildschirms. 
+             Das Blättern erfolgt analog HOP OBEN. 
+ 
+HOP RETURN   Macht die aktuelle Zeile zur ersten des Fensters. 
+             Die Zeile, in der sich der Cursor befindet, wird die erste 
+             Zeile des Fensters. 
+ 
+Die HOP-Taste in Verbindung mit RUBIN und RUBOUT wird zum "verstärkten" 
+Löschen und Einfügen verwandt: 
+ 
+HOP RUBIN    Einfügen von Textpassagen: 
+             Ab der aktuellen Position des Cursors verschwindet der rest- 
+             liche Text. Es kann wie bei der anfänglichen Texteingabe fort- 
+             gefahren werden. Die Anzeige REST in der Titelzeile erinnert 
+             daran, daß noch ein Resttext existiert. Dieser erscheint nach 
+             einem neuerlichen Betätigen der beiden Tasten HOP RUBIN wieder 
+             auf dem Bildschirm (die Anzeige REST verschwindet dann wieder). 
+ 
+HOP RUBOUT   Löscht Zeile ab Cursor-Position bis Zeilenende: 
+             Löscht die Zeile rechts vom Cursor. Steht der Cursor am Zeilen- 
+             anfang, wird dementsprechend die ganze Zeile gelöscht und die 
+             Lücke durch Nachrücken der Folgezeilen geschlossen. 
+ 
+Merke: Die HOP-Taste dient in Verbindung mit den Positionierungstasten zum 
+"Springen" oder zum "Blättern" innerhalb der Datei. Vor der Taste RUBOUT ge- 
+drückt, bewirkt sie die Löschung von Zeilen. Mit HOP RUBIN kann man längere 
+Texte in einen Text einfügen. 
+ 
+ 
+ 
+Der Tabulator 
+ 
+Eine weitere wichtige Positionierungshilfe ist die TAB-Taste. Sie wird zum 
+Schreiben von Tabellen benötigt. Wie bei einer Schreibmaschine können Ta- 
+bulatormarken gesetzt bzw. gelöscht werden. 
+ 
+Der Tabulator hat eine wichtige Funktion für das schnelle Positionieren, auch 
+wenn keine Marken eingestellt wurden. Voreingestellte Tabulatormarken sind 
+nämlich der Textanfang einer Zeile (Einrückung; falls vorhanden) und die 
+Stelle direkt hinter dem letzten Zeichen der Zeile. Betätigt man also die 
+Taste TAB, dann springt der Cursor an die nächste dieser voreingestellten 
+Positionen. So kann man schnell an den Anfang oder das Ende einer Zeile mit 
+dem Cursor gelangen (und z.B. am Zeilenende Zeichen "von hinten" löschen 
+oder dort weiterschreiben). 
+ 
+Nun zum Setzen des Tabulators: Er wird gesetzt, indem man den Cursor auf die 
+Zeilenposition bringt, in der die Marke plaziert werden soll. Hier betätigt 
+man nun HOP TAB. Die Tabulatorsetzung kann man in der Titelzeile an einer 
+Markierung ("Dach"-Zeichen) sehen (falls sie im Fensterbereich ist und die 
+aktuelle Zeile nicht seitlich verschoben ist). Betätigt man nun an irgend- 
+einer Position innerhalb einer Zeile die TAB-Taste, wird der Cursor auf die 
+Position der nächsten Tabulatormarkierung (die sich rechts vom Cursor be- 
+findet) oder eine der voreingestellten Positionen bewegt. 
+ 
+Gesetzte Tabulatormarken können gelöscht werden, indem man mit der TAB- 
+Taste die Position der Tabulatormarke einstellt und dann HOP TAB betätigt. 
+Die Marke ist dann gelöscht (das Dach verschwindet in der Titelzeile). 
+ 
+Tabulatormarkierungen hinterlassen keine Spuren in der Datei, sondern dienen 
+nur als Positionierungshilfen. 
+ 
+Werden Tabulatormarken gesetzt (HOP TAB), gelten die voreingestellten Tabu- 
+latormarken (Anfang und Ende einer Zeile) nicht mehr. Dies ist z.B. bei dem 
+Schreiben von Tabellen notwendig. Andererseits möchte man beim Schreiben von 
+"normalen" Text wieder die voreingestellten Tabulatormarken bedienen können. 
+Mit den Tasten 
+ 
+     ESC TAB 
+ 
+kann man die gesetzten Tabulatormarken (erkenntlich an dem "Dach"-Zeichen in 
+der Kopfzeile) verschwinden lassen. Dann gelten wieder die voreingestellten 
+Marken. Erneutes ESC TAB stellt die gesetzten Tabulatormarken wieder her 
+usw. 
+ 
+Merke: Das Einstellen und Löschen von Tabulatormarken erfolgt mit HOP TAB; 
+das Positionieren auf diese mit TAB. Voreingestellte Tabulatormarken sind 
+Zeilenanfang und -ende. ESC TAB wirkt wie ein Umschalter zwischen voreinge- 
+stellten und gesetzten Tabulatormarken. 
+ 
+ 
+ 
+2. Beschreibung weiterer Funktionen 
+ 
+In diesem Kapitel werden weitere Funktionen des Editors beschrieben, die bei 
+dem Erstellen von Texten und Korrekturen sinnvoll einsetzbar sind. Die 
+Kenntnis der hier beschriebenen Funktionen sind für erste Arbeiten nicht 
+notwendig (dafür reicht das erste Kapitel). Man sollte aber dieses Kapitel 
+zumindest überfliegen, damit bei Bedarf die zusätzlichen Möglichkeiten des 
+Editors erlernt und angewandt werden können. 
+ 
+ 
+ 
+Zeilen aufbrechen und Rückumbruch 
+ 
+Um grössere Textpassagen einzufügen, betätigt man HOP RUBIN nacheinander. 
+Diese Tastenfolge kann benutzt werden, um eine Zeile zu spalten (Zeile auf- 
+zubrechen). HOP RUBOUT am Ende einer Zeile macht einen Rückumbruch. 
+ 
+Wie bereits beschrieben, bewirkt HOP RUBIN in einer Zeile, daß der Zeilenrest 
+rechts vom Cursor und alle Zeilen unterhalb der aktuellen Zeile scheinbar 
+verschwinden. REST in der Titelzeile erinnert daran, daß ein Teil der Datei 
+nicht sichtbar ist. 
+ 
+Wird unmittelbar nach HOP RUBIN wiederum HOP RUBIN betätigt, wird der vor- 
+herige Zeilenrest als eigenständige Zeile dargestellt. Es ist damit eine Auf- 
+spaltung einer Zeile in zwei Zeilen vollzogen. 
+ 
+Der umgekehrte Fall, nämlich zwei Zeilen zu einer zusammenzufassen (sog. 
+Rückumbruch), ist durch HOP RUBOUT hinter dem letzten Zeichen einer Zeile 
+möglich. (Hinter das letzte Zeichen einer Zeile kann einfach mit dem 
+Tabulator positioniert werden). 
+ 
+Das Aufbrechen einer Zeile und der Rückumbruch zusammen angewandt stellen 
+also den ursprünglichen Zustand wieder her. Beispiel: Mit HOP RUBIN bricht 
+man eine Zeile auf (der Rest der Zeile und nachfolgende Zeilen verschwinden 
+vom Bildschirm). Erneutes HOP RUBIN stellt den rechten Zeilenteil auf der 
+nächsten Zeile und die nachfolgenden Zeilen auf dem Bildschirm wieder dar. Da 
+der Cursor sich noch immer am rechten Rand der aufgebrochenen Zeile befindet, 
+kann man mit HOP RUBOUT den ursprünglichen rechten Zeilenteil wieder re- 
+kombinieren. 
+ 
+Merke: Zweimaliges HOP RUBIN spaltet eine Zeile auf; HOP RUBOUT hinter dem 
+Ende einer Zeile fügt die nachfolgende Zeile an die aktuelle an (Rück- 
+umbruch). 
+ 
+ 
+ 
+Zahlentabellen schreiben: Dezimaltabulator 
+ 
+Beim Schreiben von Zahlentabellen sollen die Zahlen oft rechtsbündig im Text 
+erscheinen. Dazu bietet der Editor den Dezimaltabulator an. 
+ 
+Für jede Zahlenkolonne wird die gewünschte Position der Einerstelle (also der 
+letzten Stelle) mit Hilfe eines Tabulators eingestellt. Mit TAB wird der 
+Cursor zur jeweils nächsten Tabulatormarke vorgerückt. Werden nun Ziffern 
+geschrieben, so schreibt man nicht - wie gewohnt - nach rechts, sondern die 
+Ziffern werden nach links eingerückt. Etwas genauer: Beim Drücken einer 
+Zifferntaste wird, solange links vor der Zahl noch ein Blank, eine Zahl, "+", 
+"-" oder ein Punkt sichtbar ist, diese gelöscht und die hierdurch neu ent- 
+standene Ziffernfolge rechtsbündig an der Tabulatorposition geschrieben. 
+Zahlenkolonnen können so leicht und rechtsbündig geschrieben werden. 
+Wird eine Proportionalschrift (Schrift, bei der die Zeichen unterschiedliche 
+Breiten haben) verwandt, sollte man zwischen den einzelnen Zahlenkolonnen 
+mindestens zwei Leerzeichen schreiben. Andernfalls bekommt man - auf Grund 
+der unterschiedlicher Zeichenbreiten - keine rechtsbündigen Kolonnen ge- 
+druckt. 
+ 
+         12           12345,78 
+          1               0,23 
+      12345            1234,00 
+ 
+Merke: Ziffern werden bei Einsatz des Tabulators automatisch rechtsbündig ab 
+der Tabulatormarke geschrieben. 
+ 
+Es gibt somit vier nützliche Automatiken: neben dem automatischen Dezimal- 
+tabulator der Wortumbruch, die Einrückautomatik und die Zeileneinfügeauto- 
+matik beim einfügenden Schreiben. 
+ 
+ 
+ 
+Den Editor lernen lassen 
+ 
+Beliebige Folgen von Tastenbetätigungen können gelernt und Tasten zugeordnet 
+werden. Das ist sinnvoll, wenn wiederholt immer die gleichen Tastenbe- 
+tätigungen ausgeführt werden müssen, wie z.B. in Tabellenzeilen etwas ein- 
+fügen oder wenn des öfteren gleiche Texte geschrieben werden müssen, wie 
+z.B. ein Absender, Grußformeln usw. 
+ 
+Der Lernmodus wird durch Betätigen der Tasten ESC HOP eingeschaltet (es 
+erscheint LEARN als Kontrolle in der Titelzeile). Alle Tastenanschläge (auch 
+Tastenanschläge wie RETURN: man kann also auch mehrere Zeilen lernen lassen) 
+werden jetzt gelernt bis zum expliziten Ausschalten des Lernmodus. 
+ 
+Das Beenden oder Ausschalten des Lernmodus erfolgt durch Drücken der drei 
+Tasten ESC HOP 'taste'. Dabei wird die gelernte Tastenanschlagsfolge, auch 
+Lernsequenz genannt, der Taste 'taste' zugeordnet. 
+ 
+Durch späteres Betätigen der Tastenfolge ESC 'taste' kann der gelernte Text 
+an jeder Stelle der Datei geschrieben werden. Beispiel: Ein "Schreiberling" 
+hat jeden Tag 27 mal die Worte 'Hochschulrechenzentrum der Universität 
+Bielefeld' zu tippen. Er läßt diese Worte den Editor lernen mit 
+ 
+   ESC HOP Hochschulrechenzentrum der Universität Bielefeld 
+   ESC HOP b 
+ 
+Die Worte liegen jetzt auf der Taste 'b'. Wird 'b' gedrückt, erscheint ein 
+'b' auf dem Bildschirm. Mit ESC 'b' erscheinen die obigen Worte. ESC ist 
+also notwendig, um das normale 'b' von der Lernsequenz zu unterscheiden. 
+ 
+Bei einigen Terminaltypen gibt es Tasten, die vom EUMEL-System nicht benutzt 
+werden. Bei diesen kann man ESC beim Aufruf der Lernsequenz weglassen. 
+ 
+Welche Tasten dürfen zum Lernen belegt werden? Alle Tasten, außer 
+ 
+- vom System benutzte Tasten, wie SV, CTRL; 
+- vom Editor (je nach Anwendung) vorbelegte Tasten, wie die Tasten q oder 
+  ESC und HOP; 
+- durch Programmierung (siehe dieses Kapitel) fest belegte Tasten. 
+ 
+Praktische Tips: Man sollte die Tastatur nicht mit Lernsequenzen überlasten, 
+weil man sich viele Tasten nicht merken kann. Besser ist es, einige wenige 
+Tasten fest zu belegen und andere für momentane Aufgaben einzusetzen. 
+ 
+Der Einsatz von Lernsequenzen ist besonders sinnvoll zum Schreiben von An- 
+weisungen für die Textkosmetik. Anweisungen wie z.B. 'unterstreichen ein- 
+schalten', Schrifttyp-Anweisung usw. werden zweckmäßigerweise auf Tasten 
+gelegt. 
+ 
+Hat man sich einmal beim Lernen verschrieben, so ist das nicht weiter 
+schlimm: es kann ohne Bedenken korrigiert werden (z.B. mit der Taste RUBOUT). 
+Solche Tastenanschläge werden dann allerdings auch gelernt, was man aber 
+beim Einsetzen der Lernsequenz kaum sieht. 
+ 
+Merke: Tastenanschläge werden mit ESC HOP gelernt und mit ESC HOP 'taste' 
+auf eine Taste gelegt. Mit ESC 'taste' kann die Lernsequenz jederzeit abge- 
+rufen werden. 
+ 
+ 
+ 
+Mehrere Zeilen auf einmal verarbeiten: Markieren 
+ 
+Oft ergibt sich die Notwendigkeit, mehrere Zeilen oder ganze Textpassagen zu 
+löschen oder zu verschieben. Hierbei hilft die Taste MARK, mit der man Texte 
+markieren (also kennzeichnen) kann. Die so markierten Texte können dann auf 
+verschiedene Weisen als Ganzes verarbeitet werden. 
+ 
+Durch Drücken der Taste MARK wird die Markierung eingeschaltet und - bei 
+erneuter Betätigung - wieder ausgeschaltet. Der Anfang der Markierung wird 
+"festgehalten" und man kann nun das Markierende durch die Positionierungs- 
+tasten und die HOP-Taste in Richtung auf das Dateiende verschieben, wobei 
+die dazwischen liegenden Zeichen markiert (in der Regel "video-invertiert" 
+dargestellt) werden. Ein so markierter Text kann mit ESC RUBOUT gelöscht 
+werden. Markieren und löschen mit ESC RUBOUT ist eine bequeme und sichere 
+Löschmethode, da man genau sieht, was gelöscht wird. 
+ 
+Der gelöschte Abschnitt ist aber nicht vollständig gelöscht, sondern er kann 
+an anderer (oder an der gleichen) Stelle im Text durch ESC RUBIN wieder ein- 
+efügt werden. Dies gilt aber nur für den zuletzt gelöschten Text. Auf diese 
+Art kann ein Textabschnitt beliebiger Länge an eine andere Stelle des Textes 
+sicher, schnell und bequem verschoben werden. Zusätzlich ist das nachträg- 
+liche Korrigieren von fehlerhaften Löschungen leicht möglich, weil der Text 
+wieder mit ESC RUBIN leicht reproduziert werden kann. 
+ 
+Mit eingeschalteter Markierung kann auch geschrieben werden. Das markierende 
+Schreiben ist eine besonders vorsichtige Art der Texterstellung, denn der 
+Texteinschub bleibt erst durch Ausschalten der Markierung (MARK) wirklich 
+bestehen. Er kann wieder gelöscht werden (ESC RUBOUT) und an eine andere 
+Stelle gebracht werden (ESC RUBIN). Beim markierenden Schreiben wirkt 
+RUBOUT immer auf das zuletzt geschriebene Zeichen. 
+ 
+Die Markierung kann auch dazu verwendet werden, auf markierte Textabschnitte 
+eigene Benutzerprogramme anzuwenden. 
+ 
+Merke: Die Markierung schaltet man durch die Taste MARK ein und aus. Ein 
+markierter Abschnitt kann gelöscht werden (ESC RUBOUT) und an einer anderen 
+Stelle wieder eingefügt werden (ESC RUBIN). Mit eingeschalteter Markierung 
+kann auch geschrieben werden. Die Markierung dient ebenfalls als Parameter 
+für Textverarbeitungsprogramme. 
+ 
+ 
+ 
+Zwei einfache Kommandos 
+ 
+Einige Operationen kann man nur mühselig mit den bis jetzt beschriebenen 
+Tasten durchführen. Z.B. ist es sehr zeitaufwendig, eine bestimmte Text- 
+stelle zu finden. Andere Operationen sind mit den im vorigen Kapitel be- 
+schriebenen Tasten überhaupt nicht möglich, wie etwa die Zeilenbreite ein- 
+zustellen oder Programme aufzurufen, die die zu editierende Datei ver- 
+arbeiten. Solche Operationen werden durch Kommandos ermöglicht, die man vom 
+Editor aus geben kann. 
+ 
+Durch zweimaliges Betätigen von ESC erfolgt die Aufforderung 
+ 
+     gib kommando : 
+ 
+Es erscheint auf dem Bildschirm eine Kommandozeile, in der der Benutzer 
+Kommandos (d.h. ELAN-Programme) schreiben kann. Durch Betätigen der Taste 
+RETURN wird das Kommando ausgeführt. Beispiel: 
+ 
+     ESC ESC                 (* es erscheint 'gib kommando :' *) 
+     "diese Zeichen" 
+     RETURN 
+ 
+Durch die Angabe eines TEXTes in Anführungstrichen wird nach dem einge- 
+schlossenen TEXT 'diese Zeichen' ab der aktuellen Cursor-Position gesucht. 
+Wird 'diese Zeichen' gefunden, bleibt der Cursor auf dem gesuchten Text 
+stehen. Andernfalls steht der Cursor hinter dem Ende der letzten Zeile der 
+Datei. Weiteres Beispiel: 
+ 
+     ESC ESC 
+     127 
+     RETURN 
+ 
+Durch dieses Kommando wird auf die 127. Zeile positioniert. 
+ 
+Diese beiden häufig benötigten Kommandos haben eine Sonderstellung und 
+werden speziell behandelt, weil sie nicht der allgemeinen ELAN-Syntax ent- 
+sprechen. Darum dürfen sie auch nicht in Verbindung mit anderen Kommandos 
+verwendet werden (siehe nächsten Abschnitt). Alle anderen Kommandos, die wir 
+in den nächsten Abschnitten beschreiben, entsprechen der ELAN-Syntax und 
+sind somit allgemeine Kommandos. 
+ 
+Merke: Kommandos nach man nach zweimaligen Betätigen der ESC-Taste schreiben. 
+Mit RETURN wird die Ausführung des Kommandos ausgelöst. Durch Angabe eines 
+TEXTes wird ab der aktuellen Cursor-Position nach diesem TEXT gesucht. Durch 
+die Angabe einer ganzen Zahl (INT) wird auf die entsprechende Zeilennummer 
+in der Datei positioniert. 
+ 
+ 
+ 
+Beliebige Kommandos 
+ 
+Beliebige Kommandos (siehe Monitor-Beschreibung) und ELAN-Programme sind 
+zulässig. 
+ 
+Die Kommandozeile kann wie eine "normale" Textzeile editiert werden (Posi- 
+tionieren, Überschreiben, Einfügen, Löschen und Markieren). Erzeugt ein 
+Programm eine Ausgabe oder rufen fehlerhafte Kommandos Fehlermeldungen 
+hervor, werden diese in der ersten Zeile des Bildschirms angezeigt. Danach 
+ist man wieder im Editor und kann wie gewohnt arbeiten. 
+ 
+Die oben beschriebenen zwei Spezial-Kommandos kann man nicht mit anderen 
+Kommandos zusammen verbinden (mit ';'). Deshalb gibt es für sie auch eine 
+ELAN-Form, die es erlaubt, sie mit anderen Kommandos zusammen zu verwenden: 
+ 
+a) TEXT suchen ab der aktuellen Cursor-Position (D ist eine Abkürzung für 
+   'DOWN'): 
+ 
+   "diese Zeichen"          (* Spezial-Version    *) 
+   D "diese Zeichen"        (* Allgemeine Version *) 
+ 
+b) Auf eine Zeile Positionieren (T ist eine Abkürzung für TO LINE): 
+ 
+   127                      (* Spezial-Version    *) 
+   T 127                    (* Allgemeine Version *) 
+ 
+Es können mehrere Kommandos in der Kommandozeile angegeben werden. Die ein- 
+zelnen Kommandos müssen in diesem Fall mit ';' voneinander getrennt werden. 
+Beispiel: 
+ 
+     ESC ESC 
+     T 1; D "noch Zeichen" RETURN 
+ 
+Diese zwei Kommandos werden nacheinander ausgeführt. Zuerst wird auf die 
+erste Zeile positioniert und dann (von der ersten Zeile) nach 'noch Zeichen' 
+gesucht. Damit ist es möglich, die Datei nicht nur von der aktuellen Zeile zu 
+durchsuchen, sondern die gesamte Datei. Soll nicht in Richtung auf das Datei- 
+ende, sondern in Richtung auf den Dateianfang (also nach "oben") gesucht 
+werden, kann man das U-Kommando (Abkürzung für UP) verwenden: 
+ 
+     ESC ESC 
+     U "noch'n Text" RETURN 
+ 
+Ein weiteres Kommando ist das C-Kommando (Abkürzung für 'CHANGE'), mit 
+welchem man einen TEXT sucht und diesen dann ersetzen kann. Beispiel: 
+ 
+     ESC ESC 
+     "alte Zeichen" C "neue Zeichen" RETURN 
+ 
+Es wird ab der aktuellen Cursor-Position nach 'alte Zeichen' gesucht. Wird 
+der TEXT gefunden, wird er durch 'neue Zeichen' ersetzt. Der Cursor befindet 
+sich in diesem Fall nach dem ersetzten TEXT. Wird 'alte Zeichen' dagegen 
+nicht in der Datei gefunden, befindet sich der Cursor (wie beim erfolglosen 
+Suchen mit D) am Ende der letzten Zeile der Datei. 
+ 
+Wie alle andern Kommandos kann auch das C-Kommando mit anderen Kommandos 
+verbunden werden. Beispiel: 
+ 
+     ESC ESC 
+     T 500; "Schreibfelher" C "Schreibfehler" RETURN 
+ 
+Hier wird ab der 500. Zeile der Datei nach 'Schreibfelher' gesucht und ggf. 
+ersetzt. Soll ein TEXT nicht nur einmal, sondern bei jedem Auftreten ersetzt 
+werden, benutzt man das CA-Kommando (Abkürzung für CHANGEALL): 
+ 
+     ESC ESC 
+     "dieser alte Text" CA "dieser neue Text" RETURN 
+ 
+Dadurch wird 'dieser alte Text' bei jedem Auftreten ab der aktuellen Cursor- 
+Position durch 'dieser neue Text' ersetzt. 
+ 
+Merke: Mehrere Kommandos werden mit ';' verbunden. 
+ 
+ 
+ 
+Kommandos auf Tasten legen 
+ 
+Oft benutzte Kommandos können auf Tasten gelegt werden. Damit ist es möglich, 
+den Editor auf spezielle Bedürfnisse eines Benutzers zu modifizieren. 
+ 
+Anstatt der Taste RETURN beim Abschluß können oft benutzte Kommandos mit der 
+Drei-Tastenfolge ESC ! 'taste' auf eine Taste gelegt werden. Beispiel: 
+ 
+     ESC ESC       (* es erscheint die Kommandozeile *) 
+     D "Schreibfehler" 
+     ESC ! s       (* das Kommando 'DOWN "Schreibfehler"' ist 
+                      nun auf die Taste 's' gelegt *) 
+ 
+Wird nun die Taste 's' gedrückt, erscheint das Zeichen 's' auf dem Bildschirm.
+Mit ESC s wird das D-Kommando ausgeführt. Natürlich können auch komplizier- 
+tere ziertere Kommandos auf Tasten gelegt werden. 
+ 
+Einige Tasten sind bereits mit Kommandos belegt (man kann sie aber ver- 
+ändern). Will man ein Kommando, welches auf eine Taste gelegt wurde, ver- 
+ändern oder löschen, drückt man im Kommandodialog (!) die Drei-Tastenfolge 
+ESC ? 'taste'. Beispiel: 
+ 
+     ESC ESC             (* in den Kommandodialog gehen *) 
+     ESC ? s             (* es erscheint nun: 'D "Schreibfehler"' *) 
+ 
+Dieses Kommando kann nun z.B. verändert und ausgeführt (durch RETURN) oder 
+wiederum auf die gleiche oder eine andere Taste gelegt werden (durch 
+ESC ! 'taste'). 
+ 
+Die Ausführung eines Kommandos kann meist mit ESC abgebrochen werden, 
+z.B. wenn ein Suchkommando unerwünscht weit reicht. 
+ 
+Merke: Kommandos können auf Tasten gelegt werden (wie beim Lernen). Das 
+letzte Kommando kann durch ESC f wiederholt werden. 
+ 
+ 
+ 
+Die wichtigsten Kommandos zur Textverarbeitung 
+ 
+Einige Kommandos sind speziell für die Textverarbeitung im Editor program- 
+miert. Die wichtigsten werden hier vorgestellt. 
+ 
+Kommando            Bedeutung 
+----------------------------------------------------------------------------- 
+"text"              Text suchen: 
+D "text"            Der zu suchende Text muß in Anführungszeichen geschrieben 
+                    werden (damit werden auch Leerzeichen innerhalb des ge- 
+                    suchten Textes wichtig). Es wird ab der Stelle in der 
+                    Datei in Richtung auf das Dateiende hin gesucht (also 
+                    "nach unten"), an der sich der Cursor befindet. Wird der 
+                    Text gefunden, positioniert der Editor den Cursor direkt 
+                    dahinter. Beispiel: 
+ 
+                       D "Autor" 
+ 
+                    sucht nach dem ersten Auftreten von 'Autor'. Beachte, daß 
+                    bei der Suche nach Zeichen, die man nicht direkt mit der 
+                    Tastatur schreiben kann, der Codewert angegeben werden 
+                    muß (vergl. dazu die EUMEL-Codetabelle). Beispiel: 
+ 
+                       DOWN ""217""    (* sucht ein ä *) 
+                       DOWN "Diesen Text mu"251" man finden" 
+ 
+                    (Ein Codewert innerhalb eines Textes muß in " einge- 
+                    schlossen werden). 
+                    Wird nur ein Text gesucht, kann man auch nur diesen 
+                    angeben. Beispiel: 
+ 
+                       "diesen fehler" 
+ 
+D nummer            (Relatives) Positionieren in Richtung auf das Dateiende. 
+                    Beispiel: 
+ 
+                       D 75 
+ 
+                    positioniert um 75 Zeilen in Richtung auf das Dateiende. 
+ 
+U "text"            Analog D, aber in Richtung auf den Dateianfang ("nach 
+                    oben"). 
+ 
+U nummer            Analog D, aber in Richtung auf den Dateianfang. 
+ 
+nummer              Absolutes Positionieren: 
+T nummer            Durch Angabe einer Zahl, wird auf die entsprechende 
+                    Zeile der Datei positioniert. Beispiel: 
+ 
+                       T 317 
+                       317 
+ 
+                    Ist die Datei bereits vor der Zeile '317' zu Ende, wird 
+                    auf die letzte Zeile der Datei positioniert. 
+ 
+"alt" C "neu"       Suchen und Ersetzen eines Textes: Sucht nach dem Text 
+                    'alt'. Falls vorhanden, wird 'alt' durch 'neu' ersetzt. 
+                    Beispiel: 
+ 
+                       "einfach" C "leicht" 
+ 
+                    ersetzt 'einfach' durch 'leicht'. 
+ 
+"alt" CA "neu"      Suchen aller 'alt' ab der aktuellen Position bis zum 
+                    Dateiende und ersetzen durch 'neu'. 
+ 
+type ("text")       Schreiben eines 'text' durch ein Kommando. Das type-Kom- 
+                    mando wird häufig benutzt, um Zeichen zu schreiben, die 
+                    nicht auf der Tastatur zu finden sind. In diesem Fall muß 
+                    der Codewert des Zeichens angegeben werden (jeweils in 
+                    doppelten "). Beispiel (vergl. auch EUMEL-Codetabelle): 
+ 
+                       type (""251"") 
+ 
+                    schreibt ein ß an die aktuelle Position der Zeile. 
+ 
+Merke: Durch das D- bzw. U-Kommando kann ein Text in der Datei gesucht 
+werden. Mit C kann ein Text gesucht und ersetzt werden. "alt" CA "neu" er- 
+setzt alle 'alt' durch 'neu'. 'type' schreibt ein Zeichen (oder einen Text). 
+Durch T kann auf eine bestimmte Zeile der Datei positioniert werden. 
+ 
+ 
+ 
+Texte aus anderen Dateien einfügen oder in andere Dateien schreiben 
+ 
+Manchmal ist es notwendig, einen Text in eine andere Datei zu schreiben 
+(z.B. wenn man diesen Text noch einmal verwenden will) oder einen Text einer 
+anderen Datei in den zu bearbeitenden Text einzufügen. Die GET- und PUT- 
+Kommandos bieten die Möglichkeit, Texte zwischen Dateien auszutauschen 
+(vergl. auch Paralleleditor). 
+ 
+Das Kommando GET 'dateiname' holt den Text der Datei "dateiname" an die 
+aktuelle Schreibposition. Beispiel: 
+ 
+     GET "absender" 
+ 
+holt den Text 'absender'. Wenn also des öfteren Briefe geschrieben werden, 
+braucht man sich den Absender nur einmalig in die Datei 'absender' zu schrei- 
+ben und kann diesen mit dem Kommando GET (was man auf eine Taste legen kann) 
+u.U. mehrmals an verschiedenen Stellen in die Datei einfügen. 
+ 
+Das Kommando PUT (abgekürzt: P) schreibt einen vorher markierten Text in 
+eine Datei. Beispiel: 
+ 
+     PUT "Tabelle" 
+ 
+schreibt einen markierten Text in die Datei 'Tabelle'. 'Tabelle' wird ggf. 
+eingerichtet. Ist die Datei 'Tabelle' bereits vorhanden, so wird erfragt, ob 
+die Datei gelöscht werden kann, um den markierten Text aufzunehmen (über- 
+schreiben). Andernfalls wird der markierte Text an den bereits vorhandenen 
+Text in 'Tabelle' angefügt. Es ist somit durch mehrmaliges markieren und dem 
+PUT-Kommando möglich, Texte aus einer Datei aufzusammeln und in eine neue 
+Datei zu geben. 
+ 
+Merke: Die GET- und PUT-Kommandos schreiben bzw. holen Texte aus Dateien. 
+ 
+ 
+ 
+Breitere Zeilen bearbeiten 
+ 
+Der Editor ist auf eine Zeilenbreite von 77 Zeichen eingestellt. Oft ist es 
+notwendig, mit einer anderen Zeilenbreite zu schreiben, welches man mit dem 
+LIMIT-Kommando einstellen kann. Aber auch die Positionierung innerhalb einer 
+Zeile wird dadurch etwas anders, weil bei breiteren Zeilen als die Bild- 
+schirmbreite die Zeile nicht auf einmal auf den Bildschirm paßt. In diesem 
+Fall wird gerollt. 
+ 
+Eine andere Zeilenbreite stellt man durch 'limit' ein. Beachte, daß die somit 
+eingestellte Zeilenbreite für die gesamte Datei gilt. Beispiel: 
+(Soll eine veränderte Zeilenbreite nur für einen Abschnitt gelten, muß man 
+eine Textkosmetik-Anweisung einfügen, welches erst nach Anwendung von 
+'lineform' wirkt.) 
+ 
+     limit (180) 
+ 
+Nun kann man wie gewohnt schreiben. Allerdings wird die aktuelle Zeile, in 
+der man sich befindet, nicht wie gewohnt am Bildschirmende umgebrochen, 
+sondern erst an der Spalte 180 (sofern sie nicht vorher durch die RETURN- 
+Taste beendigt wird). Wird über das rechte Bildschirmende hinaus geschrieben, 
+bleibt die Cursor-Position am Ende des Bildschirms erhalten, aber die Zeile 
+wird beim weiteren Schreiben nach links verschoben, "rollt" also nach links 
+(der Anfang der Zeile verschwindet scheinbar nach links). 
+ 
+Mit der Positionierung verhält es sich ähnlich. Wird über den rechten Bild- 
+schirmrand mit RECHTS positioniert, wird die Zeile ebenfalls gerollt. HOP 
+RECHTS dagegen bewirkt ein Blättern nur innerhalb dieser Zeile nach rechts. 
+Analog verläuft es bei verschobener Zeile, wenn nach links (LINKS bzw. HOP 
+LINKS) positioniert wird. 
+ 
+Beim Schreiben von Tabellen kann es sinnvoll sein, das Fenster vorübergehend 
+auf eine andere Anfangsposition (als 1) einzustellen. Das kann mit dem 
+'margin'-Kommando erfolgen. Beispiel: 
+ 
+     margin (50) 
+ 
+Das Fenster des Editors zeigt nun einen Ausschnitt aus der Datei, beginnend 
+ab Spalte 50. In der Titelzeile wird "M50" angezeigt. 
+ 
+Merke: Eine veränderte Zeilenbreite wird mit dem limit-Kommando eingestellt. 
+Wird über den Bildschirmrand positioniert, wird die Zeile gerollt. Mit dem 
+'margin'-Kommando kann spaltenmäßig ein Anfangspunkt des Fensters einge- 
+stellt werden. 
+ 
+ 
+ 
+Paralleles Editieren (Fenstereditor) 
+ 
+Oft ist notwendig, mit mehreren Dateien gleichzeitig zu arbeiten, z.B. wenn 
+aus einer Datei etwas in eine andere kopiert werden muß, wenn Fehler durch 
+die Textkosmetik-Programme oder einen Compiler gefunden werden oder wenn man 
+kurz etwas in einer andern Datei nachschauen will. Zu diesem Zweck bietet der
+Editor die Möglichkeit, zwei (oder mehr) Dateien zur gleichen Zeit zu be- 
+arbeiten. 
+ 
+Um ein neues Editor-Fenster einzuschachteln, betätigt man im Editor 
+ 
+     ESC e 
+ 
+Dies eröffnet ein Fenster auf eine andere Datei, deren Name interaktiv er- 
+fragt wird. Die obere linke Ecke des Fensters befindet sich an der aktuellen 
+Cursor-Position. Dabei darf sich der Cursor nicht zu sehr am rechten oder 
+unteren Rand befinden (weil das Fenster sonst zu klein würde). In diesem 
+"Fenster" auf eine andere Datei kann man genauso arbeiten, wie im "normalen" 
+Editor. ESC q verläßt den aktuellen Fenstereditor (und alle darin einge- 
+schachtelten Fenster). 
+ 
+Mit der Tastenfolge 
+ 
+     ESC w 
+ 
+kann man von einem Fenster in das benachbarte wechseln (zyklisch). Insbeson- 
+dere kann ein markierter Teil einer Datei mit dem Kommando 
+ 
+     ESC p         (* oder: PUT "" *) 
+ 
+in eine temporäre Datei geschrieben und nach ESC w mit 
+ 
+     ESC g         (* oder: GET "" *) 
+ 
+in die andere Datei eingefügt werden. 
+ 
+Betätigt man ESC e ungefähr in der Mitte des Bildschirms, hat man das Fenster 
+auf die neue Datei in der unteren Hälfte des Bildschirms und die "alte" Datei 
+in der oberen Bildschirmhälfte. Dies nennt man "Paralleleditor", weil zwei 
+Dateien zur gleichen Zeit editiert werden können. Der Paralleleditor wird 
+auch von anderen Programmen benutzt, wie z.B. dem ELAN-Compiler, um Fehler- 
+meldungen bequem anzuzeigen. 
+ 
+Das Notizbuch schlägt man mit 
+ 
+     ESC n 
+ 
+auf. In diesem Notizbuch werden Informationen durch die Prozedur 
+ 
+     note 
+ 
+geschrieben. 
+ 
+Merke: Der Fenstereditor wird durch ESC e aufgerufen und mit ESC q verlassen. 
+Mit ESC w kann zwischen Dateien umgeschaltet werden. In jeder Datei stehen 
+die gleichen Funktionen wie im "einfachen" Editor zur Verfügung. Man kann 
+markierte Texte mit PUT bzw. GET von einer Datei in die andere bringen 
+(Kopieren). 
+ 
+ 
+ 
+Arbeiten mit dem Zeileneditor 
+ 
+Der Zeileneditor erlaubt ein Editieren einer Eingabe mit allen Editor- 
+Funktionen. 
+ 
+Der Zeileneditor (auch "Feldeditor" genannt) wird über die Prozedur 
+ 
+     editget 
+ 
+aufgerufen. Durch diese Prozedur kann eine Zeile vom Terminal wie im Editor 
+eingegeben werden, d.h. es können u.a. Einfügungen bzw. Löschungen in der 
+Zeile vorgenommen werden. 'editget' dient darum als Grundlage für alle 'get'- 
+Prozeduren. Beispiel: 
+ 
+     TEXT VAR eingabe :: ""; 
+     put ("Bitte geben Sie einen Wert ein:"); 
+     editget (eingabe); 
+     line 
+ 
+'editget' kann aber auch einen Wert ausgeben, den ein Benutzer ggf. 
+verändern kann. Beispiel: 
+ 
+     TEXT VAR eingabe :: "trium10"); 
+     put ("Bitte Schrifttyp angeben:"); 
+     editget (eingabe); 
+     line 
+ 
+Hier kann ein Benutzer den TEXT 'trium10' verändern oder nur RETURN betäti- 
+gen. 
+ 
+Es gibt noch weitere Versionen von 'editget', bei denen man die Zeilenbreite, 
+reservierte Tasten u.a.m. angeben kann. 
+ 
+Merke: 'editget' ist der Zeileneditor. 
+ 
+ 
+ 
+3. Vorbelegung von Tasten 
+ 
+Wie schon beschrieben, können Lernsequenzen und Kommandos (d.h. ELAN- 
+Programme) Tasten zugeordnet werden. Da einige Funktionen häufig benötigt 
+werden, sind diese standardmäßig bestimmten Tasten zugeordnet. 
+ 
+ 
+ 
+Kommandodialog 
+ 
+ESC ESC        Kommandodialog einschalten. 
+ 
+ESC ! taste    Im Kommandodialog: geschriebenes Kommando auf Taste legen. 
+ 
+ESC ? taste    Im Kommandodialog: Auf 'taste' gelegtes Kommando anzeigen zum 
+               Editieren. 
+ 
+ESC k          Im Kommandodialog: Das zuletzt editierte ELAN-Programm an- 
+               zeigen. 
+ 
+ 
+ 
+Lernen 
+ 
+ESC HOP        Lernen einschalten. 
+ 
+ESC HOP taste  Lernsequenz auf 'taste' legen. 
+ 
+ 
+ 
+Operationen auf Markierungen 
+ 
+ESC RUBOUT     Markiertes "vorsichtig" löschen. 
+ 
+ESC RUBIN      Vorsichtig Gelöschtes einfügen. 
+ 
+ESC p          Markiertes in die Scratch-Datei kopieren (PUT ""), an 
+               schließend löschen (kann mit ESC g an anderer Stelle re- 
+               produziert werden). 
+ 
+ESC d          Duplizieren: Markiertes in die Scratch-Datei kopieren 
+               (PUT ""), anschließend die Markierung abschalten. (Kann mit 
+               ESC g beliebig oft reproduziert werden). 
+ 
+ESC g          MIT ESC p gelöschtes oder mit ESC d dupliziertes an aktuelle 
+               Cursor-Stelle schreiben, d.h. Scratch-Datei an aktueller 
+               Stelle einfügen (GET ""). 
+ 
+ 
+ 
+Weitere Operationen 
+ 
+ESC q          Verlassen des Editors. 
+ 
+ESC e          Fenstereditor einschalten. 
+ 
+ESC n          Notizbuch "aufschlagen". 
+ 
+ESC w          Dateiwechsel beim Fenstereditor. 
+ 
+ESC f          Nochmalige Ausführung des letzten Kommandos 
+ 
+ESC b          Das Fenster wird auf den linken Rand der aktuellen (ggf. 
+               verschobenen) Zeile gesetzt. 
+ 
+ESC RECHTS     Zum nächsten Wortanfang. 
+ 
+ESC LINKS      Zum vorigen Wortanfang. 
+ 
+ESC 1          Zum Anfang der Datei. 
+ 
+ESC 9          Zum Ende der Datei. 
+ 
+ 
+ 
+Zeichen schreiben 
+ 
+ESC a          Schreibt ein ä. 
+ESC A          Schreibt ein Ä. 
+ESC o          Schreibt ein ö. 
+ESC O          Schreibt ein Ö. 
+ESC u          Schreibt ein ü. 
+ESC U          Schreibt ein Ü. 
+ESC s          Schreibt ein ß. 
+ESC (          Schreibt eine [. 
+ESC )          Schreibt eine ]. 
+ESC <          Schreibt eine {. 
+ESC >          Schreibt eine }. 
+ESC \#          Schreibt ein \#, was auch gedruckt werden kann. 
+ESC blank      Schreibt ein (geschütztes) Leerzeichen. 
+ 
+ 
+ 
+4. Komplexere Kommandos (ELAN-Programme) 
+ 
+In diesem Kapitel finden Sie (neben den bereits in den vorherigen Kapiteln 
+beschriebenen) eine Übersicht über die vorgefertigten Kommandos. Weitere 
+können leicht vom Benutzer und Programmierer selbst erstellt werden. 
+ 
+ 
+ 
+Wiederholungen schreiben 
+ 
+In der Programmiersprache ELAN gibt es ein Sprachmittel, um Anweisungen 
+wiederholen zu lassen. Dieses Sprachmittel nennt man Wiederholungsanweisung 
+oder Schleife. Durch dieses Sprachmittel ist es leicht möglich, eine oder 
+mehrere Kommandos mehrmals ausführen zu lassen. 
+ 
+Eine Wiederholung, meist Schleife genannt, wird durch die Worte REP (steht 
+für 'REPEAT', was soviel wie 'wiederhole' heißt) und PER (die Umkehrung von 
+REP) oder END REP gebildet. Alle Anweisungen, die zwischen diesen Worten 
+stehen, werden wiederholt ausgeführt (bis das Ende der Datei erreicht ist). 
+Damit kann man einen Text in der gesamten Datei ändern. (In den folgenden 
+Beispielen schreiben wir die Kommandozeile der besseren Übersichtlichkeit 
+halber in mehreren Zeilen). Beispiel: 
+ 
+     T 1; 
+     WHILE NOT eof REP 
+       "alter text" C "neuer text" 
+     PER 
+ 
+Durch die erste Anweisung wird zur ersten Zeile der Datei positioniert. Dann 
+steht im Programm eine sogenannte "abweisende Schleife", die durch 'WHILE 
+bedingung' eingeleitet wird (die Schleife wird solange ausgeführt, bis die 
+Bedingung nicht mehr erfüllt ist). Die Bedingung besteht hier aus einer Ab- 
+frage auf das Dateiende der bearbeiteten Datei ('eof'). Nach Eintritt in die 
+Schleife wird nach 'alter text' gesucht. Falls gefunden, wird er durch 
+'neuer text' ersetzt. Das Suchen und ersetzen wird solange durchgeführt, bis 
+das Dateiende erreicht wird. Falls 'alter text' nicht gefunden wird, steht 
+man auf dem letzten Zeichen der letzten Zeile der Datei (wie bei einer er- 
+folglosen wiederholten letzten Suche), so daß die nächste WHILE-Überprüfung 
+die Schleife abbricht. 
+ 
+Die meisten der oben beschriebenen Kommandos gibt es nicht nur als Operato- 
+ren, sondern auch als Prozeduren. Beispiele: 
+ 
+     T 1            ==> toline (1) 
+     D "text"       ==> down ("text") 
+     U "text"       ==> up   ("text") 
+     D 17           ==> down (17) 
+     U 18           ==> up   (18) 
+     "alt" C "neu"  ==> change to ("alt", "neu") 
+     "alt" CA "neu" ==> change all ("alt", "neu") 
+ 
+Man kann also das obige Beispiel auch folgendermaßen programmieren: 
+ 
+     toline (1); 
+     WHILE NOT eof REP 
+       change to ("alter text", "neuer text") 
+     PER 
+ 
+Durch dieses zusammengesetzte Editor-Kommando können also ein oder mehrere 
+Worte in der gesamten Datei auf einfache Weise geändert werden. 
+Natürlich kann man das obige Beispiel einfacher schreiben: 
+ 
+     toline (1); change all ("alter text", "neuer text") 
+ 
+Was muß man nun programmieren, um eine Ersetzung nur einmal pro Zeile vor- 
+zunehmen? Erinnern wir uns: nach einer Ersetzung steht der Cursor hinter dem 
+ersetzten Text. Somit finden wir bei der erneuten Suche unter Umständen den 
+Text nochmals in der aktuellen Zeile. Wenn wir nach einer Ersetzung aber um 
+eine Zeile vorwärts positionieren (mit 'down (1)'), kann dies nicht ge- 
+schehen. Leider wird durch die Vorwärts-Positionierung die Position des 
+Cursors nicht verändert. Somit kann die erneute Suche einen Text in der 
+nächsten Zeile verpassen. Man muß also neben der Vorwärts-Positionierung um 
+eine Zeile zusätzlich auch noch an den Anfang der Zeile gehen. Für die 
+Positionierung innerhalb einer Zeile gibt es die Prozedur 
+ 
+     col (17)                 (* Positioniert auf die 17. Spalte 
+                                 der aktuellen Zeile *) 
+ 
+Damit können wir nun eine einmalige Ersetzung in einer Zeile programmieren: 
+ 
+     toline (1); 
+     WHILE NOT eof REP 
+       col (1); 
+       change to ("alter text", "neuer text"); 
+       down (1); 
+     PER 
+ 
+Es wird erst auf die erste Zeile, erste Spalte positioniert. Dann wird 'alter 
+text' gesucht und ggf. durch 'neuer text' ersetzt. Danach wird eine Zeile 
+vorwärts positioniert, wiederum auf Spalte 1. Dadurch ist gewährleistet, daß 
+eine Ersetzung nur einmal pro Zeile vorgenommen wird und immer von der 
+ersten Spalte einer Zeile aus gesucht wird. Dies geschieht solange, bis das 
+Ende der Datei erreicht ist. 
+ 
+Manchmal ergibt sich die Notwendigkeit, in Tabellen in jeder Zeile noch Leer- 
+spalten einzufügen oder zu entfernen. Auch dies kann mit der Schleife leicht 
+erledigt werden: 
+ 
+     toline (1); 
+     WHILE NOT eof REP 
+       col (48); 
+       "" C "   "; 
+       down (1) 
+     PER 
+ 
+Hier werden in jeder Zeile an der Spalte 48 drei Leerzeichen eingefügt. In 
+diesem Fall suchen wir ab der Spaltenposition 48 einen sogenannten "Niltext" 
+("leerer Text"). Dieser Text wird natürlich immer gefunden. Aber man muß 
+hier aufpassen, denn der gesuchte Text sollte in dieser Zeile vorhanden sein, 
+sonst wird in einer der nächsten Zeilen ein TEXT ersetzt, der nicht unbe- 
+dingt an der Spaltenposition 48 steht! 
+ 
+Wie bereits angemerkt, sollten in den zu verändernden Zeilen an der Position 
+48 ein Leerzeichen stehen, sonst wird das C-Kommando fehlerhaft bei dem 
+nächsten TEXT ausgeführt. Das kann man verhindern, indem man folgendes 
+programmiert: 
+ 
+     toline (1); 
+     WHILE NOT eof REP 
+       down (" ");  (* sucht das naechste Blank ab Spalte 48 *) 
+       IF col = 48 
+         THEN change to (" ", "   "); 
+       FI 
+     END REP 
+ 
+Die Prozedur 'col' (ohne Parameter) liefert die aktuelle Spaltenposition 
+innerhalb einer Zeile. 
+ 
+Manchmal soll eine Änderung nur in einem bestimmten Bereich vorgenommen 
+werden. Dazu gibt es die Prozedur 'line no', mit der man die aktuelle Zeilen- 
+nummer erfragen kann. Beispiel: 
+ 
+     toline (50); 
+     WHILE NOT eof REP 
+        aenderungen 
+     UNTIL line no = 100 END REP 
+ 
+In diesem Beispiel werden 'aenderungen' im Zeilenbereich 50 - 100 vorgenom- 
+men. 'line no' liefert die aktuelle Zeilennummer des FILEs, welches gerade 
+vom Editor bearbeitet wird. 
+ 
+Weitere Beispiele: 
+ 
+     (* suchen in Spalte 17: *) 
+     REP 
+       down ("muster") 
+     UNTIL eof OR col = 17 END REP 
+ 
+     (* in Spalte 1 ersetzen: *) 
+     REP 
+       down ("alt"); 
+       IF col = 1 
+         THEN "alt" C "neu" 
+       FI 
+     UNTIL eof END REP 
+ 
+Merke: Eine Wiederholung REP ... PER führt die in ihr enthaltenen An- 
+weisungen wiederholt aus. Eine Abfrage auf das Dateiende der bearbeiteten 
+Datei ist durch 'eof' möglich. 
+ 
+ 
+ 
+Das Notizbuch 
+ 
+Im Notizbuch kann man sich Notizen über den Ablauf von Kommandos machen. 
+ 
+Die Prozedur 
+ 
+     note 
+ 
+schreibt einen INT- oder TEXT-Parameter in eine Zwischendatei. Diese Datei 
+kann man sich mit 
+ 
+     ESC n 
+ 
+anschauen. Beispiel: 
+ 
+     (* ersetzen und notieren: *) 
+     REP 
+       "alt" C "neu"; 
+       note (line no) (* Zeilennummer der Ersetzung notieren *) 
+     UNTIL eof END REP 
+ 
+Merke: Die Prozedur 'note' schreibt in das Notizbuch. Mit ESC n kann man 
+sich das Notizbuch anschauen. 
+ 
+ 
+ 
+Neue Editor-Kommandos bereitstellen 
+ 
+Sollen neue Editor-Kommandos bereitgestellt werden, muß man dem Editor ggf. 
+mitteilen, ob und wie das Fenster auf die Datei auf dem Bildschirm neu ge- 
+schrieben werden muß. 
+ 
+Neue Editor-Kommandos kann man allen Benutzern bereitstellen, in dem ein 
+Programm geschrieben wird. Beispiel: 
+ 
+     PROC datum schreiben: 
+       type (datum). 
+ 
+     datum: 
+       date (clock (1)). (* Siehe auch TEIL 8: Standardpakete *) 
+     END PROC datum schreiben 
+ 
+Diese Prozedur (oder mehrere) muß noch in ein PACKET "gekleidet" und dann 
+insertiert werden. Dann steht 'datum schreiben' allen Benutzern dieser Task 
+oder dessen Sohn-Task zur Verfügung (siehe dazu auch TEIL 5: ELAN-Compiler). 
+ 
+Bei etwas komplizierteren Prozeduren sollte man dem Editor mitteilen, ob und 
+wie er das Fenster auf die Datei auf dem Bildschirm neu schreiben muß. 
+Normalerweise schreibt der Editor nach einem Kommando den gesamten Bild- 
+schirm neu. Dies kann man verhindern, indem man die Prozedur 
+ 
+     nichts neu 
+ 
+aufruft. Sie teilt dem Editor mit, daß das Fenster nicht neu geschrieben 
+werden muß. Weitere Prozeduren teilen dem Editor mit, daß Teile des Fensters 
+neu geschrieben werden müssen: 
+ 
+     satznr neu       (* Zeilennummer links oben *) 
+     ueberschrift neu 
+     zeile neu 
+     abschnitt neu 
+     bild neu 
+ 
+Dabei kann man die Prozeduren in beliebiger Reihenfolge aufrufen, wobei 
+jeweils immer die größte Änderung dominiert. Beispiel: 
+ 
+     nichts neu; 
+     ... 
+     zeile neu; 
+     ... 
+     bild neu; 
+     ... 
+     ueberschrift neu 
+     ... 
+ 
+'bild neu' dominiert über 'zeile neu', 
+'zeile neu' dominiert über 'ueberschrift neu'; 
+'ueberschrift neu' dominiert über 'nichts neu'. 
+ 
+Im obigen Beispiel 'datum schreiben' würde es also ausreichen, am Anfang der 
+Prozedur 'nichts neu' und am Ende 'zeile neu' aufzurufen, damit nur die 
+aktuelle Zeile neu geschrieben wird. 
+ 
+Manchmal ist es notwendig, dem Benutzer bei einer Kommandoverarbeitung neue 
+Zustände direkt anzuzeigen. Dafür gibt es die Prozeduren 
+ 
+     satznr zeigen 
+     ueberschrift zeigen 
+     bild zeigen 
+ 
+Beispiel: 
+ 
+     satznr zeigen (line no) 
+ 
+zeigt bei einer Kommandoverarbeitung die aktuelle Zeilenummer. 
+ 
+Merke: Normalerweise baut der Editor nach einer Kommandoausführung das 
+Fenster auf dem Bildschirm neu auf. Mit 'nichts neu' kann das verhindert 
+werden. Weitere Prozeduren teilen dem Editor mit, welche Fensterteile neu 
+geschrieben werden müssen. Das Schreiben von Fensterteilen kann auch direkt 
+ausgelöst werden. 
+ 
+ 
+ 
+Die ELAN-Notation 
+ 
+Kommandos werden in ELAN-Notation beschrieben. Dabei bedeuten: 
+ 
+OP              Operator. 
+                Der Name des Operators muß mit grossen Buchstaben vor oder 
+                zwischen die Operanden geschrieben werden. Beispiele: 
+                    OP C (TEXT CONST muster, pattern) 
+                    --> "alt" C "neu" 
+ 
+PROC            Prozedur. 
+                Der Name der Prozedur muß klein geschrieben werden. Die 
+                Parameter werden in Klammern angefügt. Beispiele: 
+                    PROC getchar (TEXT VAR zeichen) 
+                    --> getchar (character) 
+                    PROC edit  (TEXT CONST datei, 
+                                INT CONST x, y, xsize, ysize) 
+                    --> edit   ("meine datei", 1, 1, 79, 24) 
+ 
+INT             Ganze Zahl ('Integer'). 
+                Der Wert ist eine ganze Zahl (ohne Dezimalpunkt!). 
+ 
+BOOL            Wahrheitswert ('Boolean'). 
+                Hat zwei Werte: TRUE ('Wahr') und FALSE ('Falsch'). 
+ 
+TEXT            Text. 
+                Muß in Anführungszeichen geschrieben werden. Soll das 
+                '"'-Zeichen in einem Text vorkommen, muß es doppelt 
+                geschrieben werden. 
+ 
+VAR             Veränderbarer Wert. 
+                Wert kann von der Prozedur oder dem Operator verändert 
+                werden. 
+ 
+CONST           Unveränderbarer Wert. 
+                Wert kann von der Prozedur oder dem Operator nicht ver- 
+                ändert werden. 
+ 
+ 
+ 
+Kommando-Übersicht 
+ 
+In dieser Übersicht werden Editor-Kommandos, die in der Regel nur in Pro- 
+grammen verwendet werden, mit (P) gekennzeichnet. "Nicht-Programmierer" 
+brauchen also nur die nicht gekennzeichneten Kommandos zu lesen. Alle hier 
+aufgeführten Kommandos arbeiten auf die vom Editor bearbeitete Datei 
+('editfile'). Einige der Prozeduren stehen auch zur allgemeinen Dateiver- 
+arbeitung zur Verfügung (siehe TEIL 7), allerdings dann mit einem zusätz- 
+lichen FILE-Parameter. 
+ 
+abschnitt neu (P) 
+    PROC abschnitt neu (INT CONST von zeile, bis zeile) 
+    Zweck: Mitteilung an den Editor, daß der entsprechende Abschnitt 
+           auf dem Bildschirm neu geschrieben werden muß. 
+ 
+at (P) 
+    BOOL PROC at (TEXT CONST muster) 
+    Zweck: Feststellen, ob der Editor auf 'muster' steht. Die Cursor- 
+           Position wird dabei nicht verändert. 
+ 
+bild neu (P) 
+    PROC bild neu 
+    Zweck: Mitteilung an den Editor, daß das Bild nach Kommandover- 
+           arbeitung neu geschrieben werden muß. 
+ 
+bild zeigen 
+    PROC bild zeigen 
+    Zweck: Mitteilung an den Editor, daß das Bild sofort neu geschrieben 
+           werden muß. 
+ 
+C 
+    OP C (TEXT CONST muster, pattern) 
+    Zweck: Wie D "muster" mit anschließender Ersetzung desselben durch 
+           'pattern'. 
+ 
+change to (P) 
+    PROC change to (TEXT CONST muster, pattern) 
+    Zweck: Analog C. 
+ 
+    PROC change to (TEXT CONST muster, pattern, INT CONST number) 
+    Zweck: Analog C, aber nur 'number' Zeilen weit. 
+ 
+CA 
+    OP CA (TEXT CONST source, destination) 
+    Zweck: Arbeitet ab der aktuellen Position wie 
+ 
+               WHILE NOT eof REP 
+                 "source" C "destination" 
+               END REP 
+ 
+change all (P) 
+    PROC change all (TEXT CONST source, destination) 
+    Zweck: Analog CA. 
+ 
+col (P) 
+    PROC col (INT CONST pos) 
+    Zweck: Positioniert auf die Spalte 'pos' der aktuellen Zeile. 
+    Beispiel: 
+ 
+                col (37) 
+ 
+           positioniert auf die 37. Spalte der aktuellen Zeile. 
+ 
+    INT PROC col 
+    Zweck: Liefert die aktuelle Position des Cursors innerhalb einer Zeile. 
+ 
+D 
+    OP D (INT CONST n) 
+    Zweck: Positioniert das Fenster n Zeilen vorwärts in Richtung auf das 
+           Dateiende. 
+ 
+    OP D (TEXT CONST muster) 
+    Zweck: Sucht 'muster' vorwärts in Richtung auf das Dateiende. Die Suche 
+           beginnt direkt hinter der aktuellen Cursor-Position. Wird 'muster' 
+           nicht gefunden, steht der Cursor hinter dem letzten Zeichen der 
+           Datei. Wird 'muster' gefunden, steht der Cursor direkt auf dem 
+           ersten Zeichen von 'muster'. 
+ 
+down (P) 
+    PROC down (INT CONST n) 
+    Zweck: Analog D. 
+ 
+    PROC down (TEXT CONST muster) 
+    Zweck: Analog D. 
+ 
+    PROC down (TEXT CONST muster, INT CONST n) 
+    Zweck: Analog D, jedoch geht die Suche nur 'n' Zeilen. 
+ 
+downety (P) 
+    PROC downety (TEXT CONST muster) 
+    Zweck: Im Gegensatz zu 'down' beginnt die Suche mit dem aktuellen Zeiche 
+    n, d.h. der Aufruf führt zu einer leeren Leistung, wenn der Cursor schon 
+    auf 'muster' steht. Deshalb bei der Programmierung vorsichtig verwenden. 
+ 
+    PROC downety (TEXT CONST muster, INT CONST n) 
+    Zweck: Analog 'downety', jedoch geht die Suche nur 'n' Zeilen und 
+           beginnt bei der aktuellen Cursor-Position (siehe oben). 
+ 
+editfile (P) 
+    FILE PROC editfile 
+    Zweck: Liefert die aktuell editierte Datei. 
+ 
+eof 
+    BOOL PROC eof 
+    Zweck: Abfrage auf das Dateiende der zu bearbeitenden Datei. 
+ 
+GET 
+    OP GET (TEXT CONST dateiname) 
+    Zweck: Kopiert den Inhalt der Datei mit dem angegebenen Namen vor die 
+           aktuelle Cursor-Position. Ist die Quelldatei kopiert, wird nur 
+           der markierte Teil kopiert. 
+ 
+    OP G (TEXT CONST dateiname) 
+    Zweck: Wie GET. 
+ 
+len (P) 
+    INT PROC len 
+    Zweck: Liefert die Länge der aktuellen Zeile. 
+ 
+limit 
+    OP limit (INT CONST limit) 
+    Zweck: Setzt die rechte Schreibgrenze auf 'limit'. Beispiel: 
+ 
+                limit (120) 
+ 
+           stellt den Editor auf eine Zeilenlänge von 120 Zeichen. 
+ 
+    INT PROC limit 
+    Zweck: Liefert die eingestellte Zeilenbreite. 
+ 
+line no (P) 
+    INT PROC line no 
+    Zweck: Liefert die aktuelle Zeilennummer der editierten Datei. 
+ 
+margin 
+    PROC margin (INT CONST anfang) 
+    Zweck: Alle Zeilen erscheinen erst ab Spalte 'anfang' im Sichtfenster. 
+           Beispiel: 
+ 
+               margin (50) 
+ 
+           legt das Fenster ab Spalte 50 fest. 
+ 
+    INT PROC margin 
+    Zweck: Liefert den eingestellten linken Rand. 
+ 
+mark (P) 
+    PROC mark (BOOL CONST an) 
+    (Zweck: Schaltet die Markierung an der aktuellen Stelle ein bzw. aus. 
+           Beispiel: 
+ 
+               mark (true)  (* schaltet Markierung an  *) 
+               mark (false) (* schaltet Markierung aus *) 
+ 
+    BOOL PROC mark 
+    Zweck: Liefert TRUE, sofern die Markierung eingeschaltet ist. 
+ 
+nichts neu (P) 
+    PROC nichts neu 
+    Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung das Bild 
+           nicht neu geschrieben werden muß. 
+ 
+note (P) 
+    PROC note (INT CONST wert) 
+    Zweck: Schreibt 'wert' in das Notizbuch. 
+ 
+    PROC note (TEXT CONST message) 
+    Zweck: Schreibt 'message' in das Notizbuch. 
+ 
+pattern found (P) 
+    BOOL PROC pattern found 
+    Zweck: Gibt an, ob der letzte Suchprozeß erfolgreich war. 
+ 
+PUT 
+    OP PUT (TEXT CONST dateiname) 
+    Zweck: Richtet eine Datei mit dem angegebenen Namen ein, kopiert den 
+           markierten Textabschnitt in diese. 
+ 
+    OP P (TEXT CONST dateiname) 
+    Zweck: Wie PUT. 
+ 
+satznr neu (P) 
+    PROC satznr zeigen 
+    Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die 
+           Zeilennummer rechts oben neu geschrieben werden muß. 
+ 
+satznr zeigen (P) 
+    PROC satznr zeigen (INT CONST nr) 
+    Zweck: Mitteilung an den Editor, die Zeilennummer 'nr' sofort neu zu 
+           schreiben. 
+ 
+T 
+    OP T (INT CONST n) 
+    Zweck: Positioniert auf die Zeile 'n'. 
+ 
+toline (P) 
+    PROC toline (INT CONST n) 
+    Zweck: Analog T. 
+ 
+type (P) 
+    PROC type (TEXT CONST t) 
+    Zweck: Trägt 't' in den Eingabestrom ('f kommando') des Editors ein. 
+           Beispiel: 
+ 
+               type (text (sqrt (2.0))) 
+ 
+           fügt an die aktuelle Cursor-Position den Wert 1.41... ein.
+           Beispiel: 
+ 
+               INT VAR i; 
+               FOR i FROM 1 UPTO 10 REP 
+                 type (text (i) + " ") 
+               END REP 
+              (* Ausgabe: 1 2 3 4 5 6 7 8 9 10 *) 
+ 
+U 
+    OP U (INT CONST n) 
+    Zweck: Positioniert das Fenster n Zeilen rückwärts in Richtung auf den 
+           Dateianfang. 
+ 
+    OP U (TEXT CONST muster) 
+    Zweck: Sucht 'muster' rückwärts in Richtung auf den Dateianfang. Die 
+           Suche beginnt links neben der aktuellen Cursor-Position. Vergl. D 
+ 
+ueberschrift neu (P) 
+    PROC ueberschrift neu 
+    Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die 
+           Überschriftszeile neu zu schreiben ist. 
+ 
+ueberschrift zeigen (P) 
+    PROC ueberschrift zeigen 
+    Zweck: Mitteilung an den Editor, daß sofort die Überschriftszeile neu 
+           zu schreiben ist. 
+ 
+up (P) 
+    PROC up (INT CONST n) 
+    Zweck: Analog U. 
+ 
+    PROC up (TEXT CONST muster) 
+    Zweck: Analog U. 
+ 
+    PROC up (TEXT CONST muster, INT CONST n) 
+    Zweck: Analog U, aber nur 'n' Zeilen weit. 
+ 
+uppety (P) 
+    PROC uppety (TEXT CONST muster) 
+    Zweck: Im Gegensatz zu 'up' beginnt die Suche direkt auf der aktuellen 
+           Cursor-Position. Vergl. 'down'. 
+ 
+    PROC uppety (TEXT CONST muster, INT CONST n) 
+    Zweck: Analog 'uppety', aber nur 'n' Zeilen weit. 
+ 
+word (P) 
+    TEXT PROC word 
+    Zweck: Liefert das Wort von der aktuellen Position bis zum nächsten 
+           Blank bzw. Zeilenende. Die Cursor-Position wird nicht verändert. 
+ 
+    TEXT PROC word (TEXT CONST muster) 
+    Zweck: Liefert das Wort von der aktuellen Position bis zum nächsten Auf- 
+           treten von 'muster' (ausschließlich) bzw. Zeilenende. Die Cursor- 
+           Position wird nicht verändert. 
+ 
+    TEXT PROC word (INT CONST laenge) 
+    Zweck: Liefert das Wort von der aktuellen Position in der angegebenen 
+           'laenge' bzw. bis zum Zeilenende. Die Cursor-Position wird nicht 
+           verändert. 
+ 
+word wrap 
+    PROC word wrap (BOOL CONST an) 
+    Zweck: Schaltet den automatischen Wortumbruch an (voreingestellt) bzw. 
+    aus. Beispiel: 
+ 
+             word wrap (true)         (* angeschaltet  *) 
+             word wrap (false)        (* ausgeschaltet *) 
+ 
+zeile neu (P) 
+    PROC zeile neu 
+    Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die 
+           aktuelle Zeile neu zu schreiben ist. 
+ 
+ 
+ 
+5. EUMEL-Zeichensatz 
+ 
+Das EUMEL-System definiert einen Zeichensatz, der gewährleistet, daß Zeichen 
+auf allen Maschinen überall gleich codiert werden. Dadurch ist es z.B. mög- 
+lich, Dateien und Programme ohne Konvertierungen zwischen EUMEL-Systemen 
+unterschiedlicher Hersteller zu übertragen. Der EUMEL-Zeichensatz beruht auf 
+dem ASCII-Zeichensatz (DIN 66 003) mit Erweiterungen. 
+ 
+ 
+ 
+Darstellbare Zeichen 
+ 
+Die genaue Darstellung der einzelnen Zeichen hängt vom Endgerät ab. Die hier 
+aufgeführten Zeichen sind i.A. auf allen Geräten vorhanden. Ein erweiterter 
+Zeichensatz (mit mathematischen, diakritischen und griechischen Zeichen) ist 
+nur auf Spezialgeräten verfügbar und wird deshalb hier nicht angegeben. 
+ 
+Beispiele zum Lesen der Tabelle: 
+ 
+    code (" ") ->  32 
+    code ("m") -> 109 
+ 
+ |3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 
+-+------------------------------------------------------------------- 
+0|   (  2  <  F  P  Z  d  n  x                             k 
+ | 
+1|   )  3  =  G  Q  [  e  o  y                             -        ß 
+ | 
+2|SP *  4  >  H  R  \\  f p  z                              \# 
+ | 
+3|!  +  5  ?  I  S  ]  g  q  {                             SP 
+ | 
+4|"  ,  6  §  J  T  ^  h  r  |                          Ä 
+ | 
+5|\#  -  7  A  K  U  _  i  s  }                          Ö 
+ | 
+6|$  .  8  B  L  V  `  j  t  ~                          Ü 
+ | 
+7|%  /  9  C  M  W  a  k  u                             ä 
+ | 
+8|&  0  :  D  N  X  b  l  v                             ö 
+ | 
+9|'  1  ;  E  O  Y  c  m  w                             ü 
+ 
+Anmerkungen: 
+1) SP bedeutet Leerzeichen ("blank"). 
+2) Die Zeichen 'k', '-' und 'SP' mit den Codes 220, 221, 223 werden für die 
+   Zwecke der Textkosmetik benötigt (Trenn 'k' bei der Umwandlung von 'ck' in 
+   'kk'; Trennzeichen; geschütztes Leerzeichen). 
+3) Das Zeichen '\#' (Code 222) ist druckbar, während das Zeichen '\#' (Code 35) 
+   nicht druckbar ist (Einleitungszeichen für Anweisungen der Textkosmetik 
+   und Drucker). 
+4) Das Zeichen SP (Code 223) wird zur besseren Identifizierung als Unter- 
+streichungsstrich auf dem Terminal dargestellt. Im einem Ausdruck erscheint 
+es als ein Leerzeichen. 
+ 
+ 
+ 
+Steuerzeichen und -tasten 
+ 
+Das EUMEL-System definiert neben den darstellbaren Zeichen auch Steuer- 
+zeichen, die entsprechend der angeschlossenen Geräte ggf. jeweils umcodiert 
+werden. 
+ 
+Das EUMEL-System definiert (Ausgabe-) Steuerzeichen mit ihren (ausgabesei- 
+tigen) Wirkungen. Diese Steuerzeichen sind geräteunabhängig und werden vom 
+EUMEL-System automatisch für die jeweiligen Geräte passend umcodiert. Bei 
+Standard-Geräteschnittstellen ist die Wirkung anderer Steuerzeichen nicht 
+definiert. Für den Anschluß von Druckern, für Datenfernübertragung u.ä. 
+können sogenannte "Transparent"-Schnittstellen verwandt werden. Bei diesen 
+Schnittstellen ist die Wirkung aller Steuerzeichen undefiniert (vom ange- 
+schlossenen Gerät abhängig); es wird aber garantiert, daß alle Zeichen ohne 
+Code-Umsetzung direkt ausgegeben werden. 
+ 
+ 
+ 
+Ausgabesteuerzeichen 
+ 
+Wert  | Bezeichnung  |  Wirkung 
+------+--------------+----------------------------------------- 
+ 0    |   NUL        |  keine Wirkung, Füllzeichen 
+ 1    |   HOME       |  Cursor auf linke obere Ecke des Bildschirms 
+ 2    |   RECHTS     |  Cursor eine Stelle nach rechts 
+ 3    |   OBEN       |  Cursor eine Zeile nach oben 
+ 4    |   CL EOP     |  Löschen von Cursor-Position bis Bildschirmende 
+ 5    |   CL EOL     |  Löschen von Cursor-Position bis Zeilenende 
+ 6    |   CPOS       |  Cursor positionieren, nächstes Ausgabezeichen be- 
+      |              |  stimmt die y-Position (0 <= code (y) <= 23), darauf- 
+      |              |  folgendes Ausgabezeichen die x-Position 
+      |              |  (0 <= code (x) <= 78). 
+ 7    |   BELL       |  akustisches Signal 
+ 8    |   LINKS      |  Cursor eine Stelle nach links 
+10    |   UNTEN      |  Cursor eine Zeile nach unten bzw. 'roll up', falls 
+      |              |  der Cursor schon in der letzten Zeile stand 
+13    |   RETURN     |  Cursor an den Anfang der aktuellen Zeile 
+14    |   ENDMARK    |  Ende des zu markierenden Bereichs 
+15    |   BEGINMARK  |  Anfang des zu markierenden Bereichs 
+ 
+ 
+ 
+Eingabe-Steuertasten 
+ 
+Für die Eingabeseite sind im EUMEL ebenfalls Steuertasten definiert. Diese 
+Tasten sollten am angeschlossenen Gerät vorhanden sein oder bereitgestellt 
+werden (z.B. durch Überkleben von Tasten) oder müssen mit Hilfe der 
+CONTROL-Taste simuliert werden. Das EUMEL-System führt entsprechend der 
+folgenden Tabelle evtl. notwendige Umcodierungen der Eingabe durch. Weitere 
+vorhandene Spezialtasten erzeugen gerätespezifische Codes. Bei der "Transpa- 
+rent"-Schnittstelle werden - symmetrisch zur Ausgabeseite - alle hereinkom- 
+menden Zeichen ohne Code-Umsetzung weitergereicht. 
+ 
+Wert  | Bezeichnung 
+------+------------ 
+ 1    |   HOP 
+ 2    |   RECHTS 
+ 3    |   OBEN 
+ 8    |   LINKS 
+ 9    |   TAB 
+10    |   UNTEN 
+11    |   RUBIN 
+12    |   RUBOUT 
+13    |   RETURN 
+16    |   MARK 
+27    |   ESC 
+ 
+ 
+ 
+6. Der Editor als Unterprogramm 
+ 
+Um eine Anpassung der Benutzerschnittstelle an spezielle Bedürfnisse vor- 
+nehmen zu können, werden einige noch nicht erläuterte ELAN-Prozeduren zur 
+Verfügung gestellt. Mit diesen kann für jede Anwendung ein Spezialprogramm 
+zur Verfügung gestellt werden, das den Editor als Unterprogramm aufruft. Für 
+den "normalen" Editor-Benutzer ist dieses Kapitel somit nicht weiter von 
+Interesse. 
+ 
+ 
+ 
+Tastenverwaltung 
+ 
+kommando auf taste legen 
+    PROC kommando auf taste legen (TEXT CONST taste, elan programm) 
+    Zweck: Belegt die Taste 'taste' mit dem ELAN-Programm 'elan programm'. 
+           Beispiel: 
+ 
+               kommando auf taste legen 
+                   ("v", "edit (""meine datei"")") 
+ 
+           belegt die Taste 'v' mit der 'edit'-Prozedur. 
+ 
+kommando auf taste 
+    TEXT PROC kommando auf taste (TEXT CONST taste) 
+    Zweck: Liefert den Quelltext des auf die Taste 'taste' gelegten ELAN-Pro- 
+           gramms oder niltext, wenn diese nicht entsprechend belegt ist. 
+ 
+lernsequenz auf taste legen 
+    PROC lernsequenz auf taste legen (TEXT CONST taste, lernsequenz) 
+    Zweck: Belegt die Taste 'taste' mit den Zeichen 'lernsequenz'. Beispiel: 
+ 
+               lernsequenz auf taste legen ("a", ""217"") 
+ 
+           belegt die Taste 'a' mit dem 'ä'. 
+ 
+lernsequenz auf taste 
+    TEXT PROC lernsequenz auf taste (TEXT CONST taste) 
+    Zweck: Liefert die auf 'taste' gelegte Tastenanschlagsfolge 
+           oder niltext, wenn diese nicht entsprechend belegt ist. 
+ 
+taste enthaelt kommando 
+    BOOL PROC taste enthaelt kommando (TEXT CONST taste) 
+    Zweck: Liefert TRUE, wenn 'taste' mit einem ELAN-Programm belegt ist. 
+ 
+std tastenbelegung 
+    PROC std tastenbelegung 
+    Zweck: Belegt die Tasten mit der Standardbelegung. 
+ 
+ 
+ 
+Aufruf des Editors, Zeilen- und Fenstereditors 
+ 
+edit 
+     PROC edit 
+     Zweck: a) Im Monitor: 
+               Ruft den Editor mit den zuletzt verwandten Dateinamen auf. 
+            b) Im Editor: 
+               Der Dateiname wird erfragt. 
+            Für jedes 'edit' gilt: 
+            Wurde der 'edit' zum ersten mal aufgerufen, nimmt das Fenster 
+            den  gesamten Bildschirm ein. Bei erneuten 'edit'-Aufruf wird 
+            ein Fenster nach rechts unten ab aktuellen Cursor-Punkt eröffnet. 
+ 
+    PROC edit (TEXT CONST datei) 
+    Zweck: Ruft den Editor mit 'datei' auf. 
+ 
+    PROC edit (TEXT CONST datei, x, y, xsize, ysize) 
+    Zweck: Wie obiger 'edit'-Aufruf, jedoch kann das Fenster, in der 'datei' 
+           editierbar ist, gesetzt werden. Die Parameter definieren ein 
+           Editor-Fenster mit der linken oberen Ecke auf den Bildschirmkoor- 
+           dinaten 'x' und 'y' und einer Zeilenbreite 'xsize' und 'ysize' 
+           Zeilen. Wird der Editor mit 'edit ("datei")' aufgerufen, wird 
+           implizit 'edit ("datei", 1, 1, 79, 24)' aufgerufen. 
+ 
+    PROC edit (FILE VAR f) 
+    Zweck: Vergl. obige 'edit'-Prozedur. 
+ 
+    PROC edit (THESAURUS CONST t) 
+    Zweck: Editieren aller in dem Thesaurus 't' enthaltenen Dateien nachein- 
+           ander. Beispiel: 
+ 
+              edit (ALL myself) 
+ 
+    PROC edit (FILE VAR f, INT CONST x, y, xsize, ysize) 
+    Zweck: Vergl. obige 'edit'-Prozedur. 
+ 
+editget 
+    PROC editget (TEXT VAR editsatz) 
+    Zweck: Eingabe mit Editiermöglichkeit von 'editsatz' vom Terminal an der 
+           aktuellen Bildschirmposition. 'editsatz' wird ausgegeben. Die 
+           Eingabe wird mit RETURN beendet. Im Gegensatz zu 'get' ist hier 
+           auch eine leere Eingabe (RETURN) erlaubt. 
+ 
+    PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge, 
+                  TEXT CONST sep, res, TEXT VAR exit char) 
+    Zweck: Wie oben. Dabei bedeuten: 
+ 
+    editsatz:   TEXT, der zum Editieren ausgegeben wird. 
+    editlimit:  Einstellung des 'limit's der Zeile (max. Anzahl von Zeichen). 
+                Bei obiger 'editget'-Prozedur wird 'editlimit' mit 
+                'maxtextlength' aufgerufen. 
+    editlaenge: Breite des Zeilenfensters, bevor gerollt wird (bei leerer 
+                Zeile ist dies 77). 
+    sep:        Zeichen, bei denen die Eingabe (zusätzlich zu RETURN) 
+                beendet werden soll. 
+    res:        Angabe von reservierten Tasten. Wird einer dieser Tasten mit 
+                ESC betätigt, wird die Eingabe beendet. In 
+    exit char:  steht dann ESC und das Zeichen, mit dem der Editor verlassen 
+                wurde. 
+ 
+    PROC editget (TEXT VAR editsatz, INT CONST editlimit, 
+                  TEXT VAR exit char) 
+    Zweck: Siehe oben. 
+ 
+    PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, 
+                  TEXT VAR exit char) 
+    Zweck: Siehe oben. 
+ 
+show 
+   PROC show (FILE VAR f) 
+   Zweck: Zeigt eine Datei 'f' auf dem Bildschirm. Wie beim Editor kann mit 
+          Hilfe der Positionierungstasten UNTEN bzw. OBEN oder HOP UNTEN bzw. 
+          HOP OBEN oder HOP RETURN "geblättert" werden. Die Datei 'f' muß 
+          deshalb mit der Verarbeitungsart 'modify' assoziiert worden sein. 
+          Soll die Prozedur 'show' verlassen werden, müssen - wie beim Editor 
+          - die zwei Tasten ESC und q betätigt werden. Die Datei kann nicht 
+          schreibend verändert werden. 
+ 
+   PROC show (TEXT CONST filename) 
+   Zweck: Wie obige Prozedur. 
+ 
+ 
+ 
+Zeichen verarbeiten 
+ 
+getchar 
+    PROC getchar (TEXT VAR zeichen) 
+    Zweck: Holt das nächste Eingabezeichen von der Tastatur. 
+ 
+is incharety 
+    BOOL PROC is incharety (TEXT CONST zeichen) 
+    Zweck: Ist das nächste Eingabezeichen der Tastatur 'zeichen', liefert 
+           'is incharety' TRUE. In diesem Fall wird 'zeichen' von der Eingabe 
+           verschluckt. Ist das nächste Zeichen von der Tastatur nicht 'zei- 
+           chen', liefert 'is incharety' FALSE. Die Eingabe bleibt unver- 
+           ändert. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4
new file mode 100644
index 0000000..ecca7e6
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4
@@ -0,0 +1,2306 @@
+                       EUMEL-Benutzerhandbuch 
+ 
+                   TEIL 4: Textkosmetik und Druck                  
+ 
+TEIL 4: Textkosmetik und Druck 
+ 
+ 
+Vorwort 
+ 
+Die Textkosmetik-Programme des EUMEL-Systems bieten eine einfach zu er- 
+lernende und zu bedienende Möglichkeit, Texte für den endgültigen Druck zu 
+gestalten (Programmtechnisch: #ib#formatieren#ie#). Die Textkosmetik ermög- 
+licht zusätzlich, Texte in einer Art und Weise zu manipulieren, die auf 
+preiswerten Terminals zur Zeit nicht darstellbar ist, wie z.B. verschieden- 
+artige Schriften. "Nebenbei" erledigt die Textkosmetik aufwendige Routine- 
+arbeiten, wie z.B. Seitennumerierung und die Plazierung von Fußnoten. 
+ 
+Die Textkosmetik-Programme bearbeiten Dateien, die durch den EUMEL-Editor 
+erstellt wurden. Darum sollte man sich zuerst mit dem EUMEL-Editor vertraut 
+machen. 
+ 
+Für die meisten Aufgaben ist kein Benutzereingriff erforderlich, darum sind 
+die Programme so konstruiert, daß sie durch in den Text eingefügte Anweisun- 
+gen gesteuert werden. Einige Arbeiten erfordern den Benutzereingriff, wie 
+z.B. die Kontrolle von Silbentrennungen bei fremdsprachigen Texten und die 
+Plazierungen von Seitenenden. Diese Arbeiten werden auf einfache Weise 
+interaktiv vorgenommen. Die Form der Anweisung ist für die Textkosmetik und 
+den EUMEL-Drucker gleich und entspricht der ELAN-Syntax. Man beachte den 
+Unterschied zwischen einem Kommando und einer Text-Anweisung: während ein 
+Kommando direkt ausgeführt wird, wird eine im Text eingebettete Text-Anwei- 
+sung (im weiteren kurz "#ib#Anweisung#ie#" genannt) erst nach dem Aufruf von 
+Textkosmetik-und Drucker-Programmen wirksam. 
+ 
+Die Wirkungsweise der Textkosmetik-Anweisungen ist leicht zu erlernen und 
+kann vor allen Dingen stufenweise erfolgen. Deshalb ein guter Rat für An- 
+fänger: Lesen Sie diesen Teil des Benutzer-Handbuchs erst oberflächlich, so 
+daß Sie ungefähr Bescheid wissen, welche Möglichkeiten die Textkosmetik-Pro- 
+gramme bieten. Dann können Sie diejenigen Teile der Textkosmetik auswählen 
+und bei Bedarf anwenden, die sie für Ihre spezielle Anwendung benötigen. 
+ 
+Zum Schluß noch eine Warnung: Die Regeln, Konventionen und Wirkungsweisen 
+des EUMEL-Systems und der Textkosmetik-Programme muß ein Nutzer beherrschen, 
+will er das System gut nutzen. Der Lernaufwand erfordert etwas Zeit und Mühe, 
+der aber bei der Benutzung einer jeden Maschine erforderlich ist. Soll nur 
+ein kurzer Brief geschrieben werden, ist man mit einer Schreibmaschine 
+besser bedient. Beherrscht man dagegen die Benutzung des EUMEL-Systems 
+einigermaßen, so kann auch die Erstellung eines kurzen Briefes schneller 
+erfolgen als auf einer Schreibmaschine. 
+ 
+ 
+ 
+1. Einführung in die Benutzung der Textkosmetik 
+ 
+In diesem Kapitel wird eine Übersicht über die verfügbaren Programme der 
+Textkosmetik gegeben. 
+ 
+ 
+ 
+Schreiben, Gestalten und Drucken von Texten 
+ 
+Im EUMEL-System unterscheiden wir zwischen drei Stufen einer Textbehandlung: 
+Erstellung, Gestaltung und Druck. Die Trennung in verschiedene Arbeitsstufen 
+hat den Vorteil, daß man sich zu einem Zeitpunkt nur auf einen Arbeits- 
+schritt konzentrieren muß. 
+ 
+ 
+a) Texterstellung bzw. Textbearbeitung 
+ 
+Das Schreiben von Texten wird mit Hilfe des Editors erledigt. In dieser Stufe 
+der Texterstellung kann ein Benutzer sich ausschließlich auf das Schreiben 
+und die inhaltliche Korrektheit seines Textes konzentrieren. Wird ein Text 
+ohne Anweisungen gedruckt, dann erscheint er so, wie er mit dem Editor ge- 
+schrieben wurde. Bei der Erstellung des Textes können bereits Textkosmetik- 
+Anweisungen in den Text eingefügt werden. 
+ 
+Texte sollten im 'Fließtext'-Modus erstellt werden, d.h. Worte, die über 
+Zeilengrenzen gehen würden, werden ohne Silbentrennung vom Editor in die 
+nächste Zeile gebracht. 
+ 
+ 
+b) Textkosmetik bzw. Textgestaltung 
+ 
+Nachdem ein Text geschrieben wurde, kann man ihn mit Textkosmetik-Programmen 
+gestalten, ohne ihn inhaltlich zu verändern. Dies kann auch vor oder nach 
+eventuellen Korrekturen erfolgen. Die Textkosmetik bietet zur Zeit drei 
+Programme an, die je nach Bedarf eingesetzt werden können: 
+ 
+I)   'autoform/lineform' formatiert einen Text zeilenweise und vollzieht 
+     eine Silbentrennung. Weiterhin erlaubt 'autoform/lineform' die Verwen- 
+     dung unterschiedlicher Schrifttypen und Schrifthöhen. 
+ 
+II)  'pageform' gestattet die Formatierung eines Textes in Seiten (drucktech- 
+     nisch: "Paginieren"). Es ist mit 'pageform' u.a. möglich, die Seiten- 
+     einteilung zu bestimmen, eine Seite in Spalten zu formatiern ("Zeitungs- 
+     format"), Zeilen am Anfang bzw. Ende jeder Seite einfügen zu lassen, 
+     eine Seitennummerierung zu erhalten und Fußnoten zu gestalten. 
+ 
+III) 'index' erlaubt die Erstellung von Stichwort- und Inhaltsverzeichnissen. 
+ 
+ 
+c) Drucken 
+ 
+Zu jedem Zeitpunkt der Textbehandlung kann gedruckt werden. Um Drucker mit 
+unterschiedlichen Eigenschaften betreiben zu können, wurde der (Fachausdruck: 
+"virtuelle") EUMEL-Drucker als Schnittstelle zwischen dem EUMEL-System und 
+(echten) Druckern geschaffen. Der EUMEL-Drucker beachtet die gleichen An- 
+weisungen wie die Textkosmetik-Programme und noch einige zusätzliche, die 
+nur für die Druckaufbereitung notwendig sind. Spezielle Druckleistungen, wie 
+z.B. verschiedenartige Schrifttypen, können nur auf besonderen Druckern er- 
+zeugt werden. Verfügt ein Drucker nicht über eine bestimmte Hardware-Eigen- 
+schaft, wird die vom Benutzer geforderte Leistung ignoriert. Somit ist es 
+möglich, Probedrucke für Korrekturen auch auf preiswerten Druckern herzu- 
+stellen. 
+ 
+Merke: Der EUMEL-Editor übernimmt die Texterstellung; 'lineform' formatiert 
+zeilenweise; 'pageform' formatiert seitenweise; 'index' erstellt Stich- und 
+Inhaltsverzeichnisse; der EUMEL-Drucker ist eine Software-Anpassung an 
+unterschiedliche Ausgabe-Geräte. 
+ 
+ 
+ 
+Anweisungen für die Textkosmetik und den Drucker 
+ 
+In diesem Abschnitt wird beschrieben, wie Anweisungen für die Textkosmetik- 
+Programme in einen Text eingefügt werden. 
+ 
+Die Ausführung von 'lineform', 'pageform', 'index' und EUMEL-Drucker wird 
+mit Hilfe von Anweisungen gesteuert, die man in den Text an geeigneter 
+Stelle einfügt. Anweisungen haben die Form 
+ 
+    #kommando# 
+ 
+Beachte, daß jede Anweisung von #-Zeichen eingeschlossen sein muß, damit 
+die Anweisung vom eigentlichen Text unterschieden werden kann. Beispiele: 
+ 
+    #page#   (* aber auch z.B.: # page   # *) 
+    #free (3.0)# 
+    #type ("elitedeutsch")# 
+ 
+Das "#"-Zeichen darf nur für Anweisungen verwandt werden, also sonst nicht 
+im Text vorkommen. (Wird das "#"-Zeichen benötigt, muß das Zeichen mit ESC # 
+geschrieben werden. Vergl. auch die Tastenbelegung in der Editor-Beschrei- 
+bung). 
+ 
+Die von '#'-Zeichen eingeschlossenen Anweisungen sind so konstruiert, daß 
+sie - wie alle anderen Kommandos im EUMEL-System auch - der ELAN-Syntax 
+entsprechen (u.a. müssen sie klein geschrieben werden; Parameter in runden 
+Klammern; mehrere Parameter werden durch Kommata getrennt; TEXT-Parameter 
+in Anführungsstrichen; REAL-Parameter mit Dezimalpunkt usw.). Leerzeichen 
+spielen (außer in TEXT-Parametern) keine Rolle und können zur besseren Les- 
+barkeit beliebig verwandt werden. 
+ 
+Man beachte den Unterschied zwischen einer Anweisung und einem Kommando: 
+während es nur eine beschränkte Anzahl von Anweisungen gibt, die nur von den 
+Textkosmetik-Programmen ausgeführt werden (also sonst nicht in Programmen 
+oder Monitor benutzt werden können), kann ein Benutzer ein Kommando in der 
+Regel in einem Programm, im Editor oder im Monitor verwenden. Hinzu kommt, 
+daß neben dem vom EUMEL-System zur Verfügung gestellten Kommandos in der 
+Regel noch installationsspezifische und/oder benutzereigene Kommandos gibt. 
+ 
+Anweisungen dürfen im allgemeinen überall auf einer Zeile stehen (wie z.B. 
+in der nächsten Zeile). #on("underline")#Ausnahmen#off("underline")# werden 
+bei der Beschreibung der Anweisungen speziell erwähnt. Alle Anweisungen 
+werden zum frühest möglichen Zeitpunkt ausgeführt, haben also u.U. bereits 
+Auswirkungen auf die Zeile, in der sie stehen. 
+ 
+Die Zeichen, aus denen eine Anweisung besteht, werden bei der Formatierung 
+einer Zeile oder Seite nicht mitgezählt und vom EUMEL-Drucker nicht gedruckt. 
+Eine Zeile, die nur aus Anweisungen besteht, wird ebenso behandelt. 
+ 
+Merke: Anweisungen steuern die Verarbeitung der Textkosmetik-Programme. Sie 
+müssen in '#'-Zeichen eingeschlossen sein und dürfen in der Regel überall 
+auf einer Zeile stehen. Sie werden an der Stelle ausgeführt, an der sie 
+stehen. 
+ 
+ 
+ 
+Aufruf der Textkosmetik-Programme 
+ 
+In diesem Abschnitt wird beschrieben, wie die Textkosmetik-Programme 
+aktiviert werden. 
+ 
+Die Textkosmetik-Programme werden durch Kommandos aktiviert (d.h. in der 
+'gib kommando:'-Ebene). Die Aktivierung (Fachausdruck: "Aufruf") erfolgt - 
+ebenso wie beim Editor - durch den Namen des Programms und die Angabe 
+der Datei. Beispiele: 
+ 
+   autoform ("meine datei") 
+   lineform ("text1"); 
+   pageform ("1. Kapitel") 
+   index    ("Buch.p") 
+ 
+Das Programm 'pageform' erzeugt aus der Eingabedatei eine Druckdatei, die 
+entsprechend umgeformt wird (Fußnoten werden an die richtige Stelle plaziert, 
+Seitenummern eingesetzt u.a.m.). Diese Druckdatei bekommt den Namen der 
+angegebenen Eingabedatei mit dem Zusatz '.p'. Beispiel: 'pageform ("text")' 
+erzeugt eine Datei 'text.p'. Es ist auch erlaubt, 'pageform' durch die Angabe 
+eines zweiten Parameters mitzuteilen, wie die Druckdatei heißen soll: 
+ 
+   pageform ("mein text", "erste Druckdatei") 
+ 
+Ähnlich verhält es sich mit dem Programm 'index', welches bis zu 9 Stichwort- 
+bzw. Inhaltsverzeichnisse erstellen kann. Da in den Verzeichnissen die 
+Seitennummern aufgeführt werden, kann 'index' nur Druckdateien bearbeiten. 
+Beispiel: 
+ 
+   index ("handbuch.p") 
+ 
+Das Programm 'index' erstellt die angeforderten Verzeichnisse in Dateien, 
+die mit dem Zusatz '.i<nummer>' gekennzeichnet werden. Beispiele (für den 
+obigen Aufruf): 
+ 
+   'Handbuch.i1', 'Handbuch.i2' 
+ 
+usw.. 
+ 
+Merke: Die Textkosmetik-Programme werden durch Kommandos aufgerufen mit der 
+Angabe der Dateinamen als Parameter. 
+ 
+ 
+ 
+Vorzeitiger Abbruch und Fehlermeldungen 
+ 
+Alle Textkosmetik-Programme können vorzeitig vom Benutzer abgebrochen werden. 
+Eventuelle Fehlermeldungen werden durch den Paralleleditor angezeigt. 
+ 
+Durch die Taste SV und das Supervisor-Kommando 'halt' können die Textkosme- 
+tik-Programme jederzeit vorzeitig abgebrochen werden. Die Eingabedatei steht 
+dann unverändert zur Verfügung. Ein vorzeitiger Abbruch kann notwendig sein, 
+wenn ein Programm mit einer falschen Datei aufgerufen wurde oder zu viele 
+Fehler gemeldet wurden. 
+ 
+Alle Textkosmetik-Programme melden Fehler, wenn eine oder mehrere Anweisun- 
+gen falsch benutzt werden. Die Fehlermeldungen werden auf dem Bildschirm 
+angezeigt. Bei Beendigung eines Programms wird - falls Fehler entdeckt 
+wurden - die Fehlermeldungen im oberen Fenster des Paralleleditors angezeigt, 
+während im unteren Fenster die Eingabedatei zur Korrektur angeboten wird. 
+ 
+Merke: Vorzeitiger Abbruch eines Programms durch SV und 'halt'. (Die Eingabe- 
+datei steht unverändert zur Verfügung.) Fehlermeldungen werden im Parallel- 
+editor angezeigt. 
+ 
+ 
+ 
+2. Zeilenweises formatieren: 'autoform/lineform' 
+ 
+Die Programme 'autoform' oder 'lineform' formatieren einen Text zeilenweise 
+(ggf. mit Silbentrennung), unter Berücksichtigung von Schrifttyp und Zeilen- 
+breite. 
+ 
+ 
+ 
+Eine Datei formatieren: 'autoform/lineform'-Kommando 
+ 
+Die Programme 'lineform/autoform' werden unter Angabe der Datei aufgerufen. 
+Beispiel: 
+ 
+     lineform ("meine datei") 
+     autoform ("Brief vom 24.12.") 
+ 
+ 
+ 
+Unterschied von 'autoform' und 'lineform' 
+ 
+Zur Zeilenformatierung werden zwei Programme angeboten, die sich nur in der 
+Art der Behandlung von Silbentrennungen unterscheiden: 
+ 
+a) autoform: 
+   Zeilenformatierung mit automatischer Silbentrennung. 'autoform' sollte 
+   nur bei deutschen Texten eingesetzt werden, weil die Silbentrennung bei 
+   fremdsprachigen Texten nach anderen Regeln erfolgen muß. 
+ 
+b) lineform: 
+   Zeilenformatierung mit Silbentrennung "per Hand", wobei (nach deutschen 
+   Trennregeln) ein sinnvoller Trennvorschlag gemacht wird. Die Trennstelle 
+   kann interaktiv soweit verschoben werden, wie das zu trennende Wort noch 
+   auf die Zeile paßt. 
+ 
+Merke: 'autoform' nimmt eine automatische Silbentrennung vor, während 
+'lineform' die #ib#Silbentrennung "per Hand"#ie# erlaubt.  
+ 
+ 
+ 
+Übersicht über 'autoform'/'lineform' 
+ 
+'autoform'/'lineform' formatieren eine Datei zeilenweise. Dabei werden 
+Zeilen möglichst vollständig aufgefüllt. 
+ 
+'autoform'/'lineform' haben im wesentlichen vier Aufgaben: 
+ 
+a) Auffüllen von Zeilen: 
+   'autoform'/'lineform' können besonders gut nach Korrekturen eingesetzt 
+   werden, bei denen - nach Einfügungen oder Löschungen - nicht vollstän- 
+   dige oder zu lange Zeilen in der Datei stehen bleiben können. 
+ 
+b) Erstellen von Zeilen mit unterschiedlichen Schrifttypen: 
+   Werden in einer Datei mehrere Schriftarten ('type'-Anweisung) verwandt, 
+   berechnen 'autoform'/'lineform' nach der eingestellten Zeilenbreite die 
+   Anzahl Zeichen, die auf eine Zeile passen. 
+ 
+c) Erstellen von unterschiedlichen Zeilenlängen: 
+   Manchmal ist es notwendig, die Breite von Zeilen zu verändern ('limit'- 
+   Anweisung). Dies wird von 'autoform'/'lineform' berücksichtigt. 
+ 
+d) Silbentrennung: 
+   Automatische ('autoform') und interaktive Silbentrennung ('lineform'). 
+   Sofern notwendig, werden Silbentrennungen rückgängig gemacht. 
+ 
+'autoform'/'lineform' beachten nur wenige Anweisungen: 
+ 
+Anweisung        Zweck 
+ 
+     limit       Zeilenbreite einstellen 
+     off         Schrifttyp-Modifikation ausstellen 
+     on          Schrifttyp-Modifikation einstellen 
+     type        Schrifttyp einstellen 
+ 
+ 
+'autoform'/'lineform' akzeptieren als Eingabe eine Datei und verändern diese. 
+Dafür wird eine (interne) Zwischendatei benötigt. Deshalb ist darauf zu 
+achten, daß noch ausreichend Platz auf dem System ist, der jedoch nur 
+zwischenzeitig für den Formatierungsschritt benötigt wird. 
+ 
+'autoform'/'lineform' fragen nach ihrem Aufruf an, auf welche Zeilenbreiten 
+und mit welchem Schrifttyp die Datei formatiert werden soll. Diese Informa- 
+ionen werden von 'autoform'/'lineform' in Form von 'limit'- und 'type'-An- 
+weisungen in der Datei vermerkt, so daß die Anfragen bei weiteren Datei- 
+Bearbeitungen entfallen. 
+ 
+Bei Zeilen, die länger als die angegebene Zeilenbreite sind, werden die- 
+jenigen Worte, die über die Zeilenbreite hinausgehen, in die nächste Zeile 
+umgebrochen. Kürzere Zeilen werden aus der nachfolgenden Zeile bis zur 
+Zeilenbreite aufgefüllt. Worte werden jedoch nicht über Absatzgrenzen hinweg 
+verschoben. Deshalb ist vor Anwendung von 'lineform' darauf zu achten, daß 
+Absätze richtig markiert wurden. Fehlende Markierungen sollte man nachträg- 
+lich einfügen (RETURN am Ende einer Zeile), andernfalls werden Zeilen über 
+Absatzgrenzen zusammen gezogen. Dies gilt insbesondere für Tabellenzeilen. 
+ 
+Einrückungen (Leerzeichen am Anfang einer Zeile) werden von 'autoform'/'line- 
+form' ebenfalls bei der Formatierung von Zeilen eingehalten. 
+Dabei behandelt die Prozedur 'autoform'/'lineform' Einrückungen in einem 
+speziellen Fall nicht so, wie ein Benutzer es erwarten würde. Bei ein- 
+zeiligen Absätzen wird - falls die Zeile länger als das eingestellte Limit 
+ist und der "überschüssige" Teil in eine neue Zeile umgebrochen werden muß 
+- die Einrückung der aktuellen Zeile beibehalten. Das ist meist das 
+"richtige" Verhalten, während es bei Aufzählungen falsch ist, weil die 
+zweite Zeile einer Aufzählung oft eingerückt wird. Beispiel: 
+ 
+          - Diese Zeile war zu lang und wurde unter 
+          das "-"-Zeichen umgebrochen. 
+ 
+Man sollte daher - nach Verarbeitungsende - die Datei nach solchen Fällen 
+durchsuchen. 
+ 
+Merke: 'autoform'/'lineform' vervollständigen zu kurze Zeilen oder brechen 
+zu lange Zeilen um. Dabei werden Absätze beachtet. 
+ 
+ 
+ 
+Interaktive Silbentrennung mit 'lineform' 
+ 
+'lineform' trennt Silben interaktiv. 'lineform' sollte deshalb für fremd- 
+sprachige Texte angewandt werden. 
+ 
+Paßt ein Wort nicht mehr ganz auf eine Zeile, dann wird dieses Wort inter- 
+aktiv zur Trennung angeboten. Die Umgebung dieses Wortes wird zur Er- 
+leichterung des Trennvorgangs mit angezeigt. Das Trennzeichen erscheint an 
+einer sinnvollen Stelle im zu trennenden Wort. Beispiel: 
+ 
+       Text vor dem Trennwort; das 
+       Trenn-wort steht mit nachfolgendem Text in dieser Zeile 
+ 
+Der Benutzer hat die Möglichkeit, das Trennzeichen mit Hilfe der Positionie- 
+rungstasten innerhalb des "Trennbereichs" (das ist der markierte Bereich, der 
+noch auf die Zeile passen würde), zu verschieben. An der gewünschten Trenn- 
+position (der Wortteil, der noch auf die Zeile kommen soll, steht links vom 
+Trennstrich) kann die RETURN-Taste betätigt werden. RETURN zeigt dem Pro- 
+gramm 'lineform' an, daß an dieser Stelle die Trennung erfolgen soll. 'line- 
+form' fügt an den ersten Teil des Wortes das "-"-Zeichen an und schreibt den 
+abgetrennten Wortteil in die nächste Zeile. 
+Hinweis: Das Trennzeichen "-" hat einen anderen Code als der "normale" 
+Bindestrich (vergl. dazu die Codetabelle), da Trennungen ggf. bei erneuten 
+Änderungen wieder rückgängig gemacht werden müssen. 
+ 
+Es stehen folgende Operationen bei der interaktiven Trennung zur Verfügung: 
+ 
+     Taste      Bedeutung 
+ 
+     RETURN        Trennen. 
+     LINKS         Trennstelle um ein Zeichen nach links verschieben. 
+     RECHTS        Trennstelle um ein Zeichen nach rechts verschieben. 
+     HOP LINKS     Trennstelle vor das Wort setzen (das Wort wird an dieser 
+                   Position nicht getrennt). 
+     HOP RECHTS    Trennstelle in die ursprüngliche Position setzen. 
+     BLANK         Trennzeichen wird von "-" auf " " umgeschaltet. 
+                   Dies kann verwandt werden, um Worte, die nicht zusammen 
+                   geschrieben werden sollen, beim Trennvorgang in zwei 
+                   Worte aufzuspalten. 
+     -             Schaltet das Trennzeichen von Leerzeichen (" ") wieder auf 
+                   den Trennstrich ("-") um. 
+ 
+Zwei Sonderbedingungen sind bei der interaktiven Trennung noch zu beachten: 
+ 
+ - Bei Worten mit Bindestrich wird die Trennstelle hinter dem Bindestrich als 
+   Leerzeichen angezeigt. Die Trennstelle vor dem Bindestrich wird bei 
+   weiterem Positionieren nach links übersprungen. Das verhindert, daß Worte 
+   mit führendem Bindestrich im Text erscheinen. 
+ 
+ - Bei einer Trennposition zwischen den Zeichen "ck" wird das Zeichen "c" in 
+   ein "k" umgewandelt. Beispiel: 
+ 
+     Druk-ker                 
+Hinweis: Das umgewandelte "k" hat einen anderen Code als das "normale" 
+"k" (vergl. dazu die Codetabelle). Das ist notwendig, um bei späteren 
+Änderungen solche Trennungen wieder rückgängig machen zu können. 
+ 
+Sofern für die Zeilenformatierung notwendig, macht die Prozedur 'lineform' 
+bereits erfolgte Trennungen rückgängig (das Trennzeichen wird entfernt und 
+die Wortteile wieder zusammengefügt), wenn sich das getrennte Wort nicht mehr 
+am Zeilenende (etwa durch Korrekturen oder Veränderungen der Zeilenbreite) 
+befinden sollte. 
+ 
+Merke: 'lineform' bietet Worte zur Silbentrennung an. Die "Trennstelle" kann 
+durch den Nutzer verschoben werden. 
+ 
+ 
+ 
+Automatische Silbentrennung mit 'autoform' 
+ 
+'autoform' arbeitet wie 'lineform', nur werden die Silbentrennungen auto- 
+matisch vorgenommen. 
+ 
+Ist eine Silbentrennung bei der Formatierung notwendig, übernimmt 'autoform' 
+diese automatisch und gibt diese zur Kontrolle auf dem Bildschirm aus. Die 
+automatische Silbentrennung arbeitet mit einer hohen Trenngüte; allerdings 
+nur für deutsche Texte. Trotzdem kann es vorkommen, daß einige Trennungen 
+(insbesondere bei Fremdworten) falsch vorgenommen werden. In diesem Fall 
+muß man diese nachträglich mit dem Editor korrigieren. Dabei sollte man das 
+oben erwähnte Trennzeichen verwenden (ESC -). 
+ 
+ 
+Wenige oder viele Silbentrennungen: Trennpunkt einstellen 
+ 
+Viele Silbentrennungen in einem Text erschweren das Lesen. Würde man nun 
+keine Silbentrennungen vornehmen, wird der rechte Rand stark "ausgefranst" 
+oder beim Blocksatz ("rechter Randausgleich") müssen viele Zwischenräume 
+zwischen den Worten eingefügt werden. Durch das Kommando 
+ 
+     hyphenation width (prozentuale angabe) 
+ 
+kann der Trennpunkt, ab dem die Silbentrennung einsetzen soll, eingestellt 
+werden. Die Angabe erfolgt in Prozenten der Zeilenbreite. Beispielsweise 
+stellt 'hyphenation width (5)' den Trennpunkt auf 5% der Zeilenbreite ein 
+(Voreingestellt ist 7). Bei einer Angabe von 20 werden sehr wenige Worte zur 
+Silbentrennung angeboten, während bei einer Angabe von '3' ungefähr jede 
+dritte Zeile eine Silbentrennung versucht wird. Die Einstellung des Trenn- 
+punktes bestimmt also, ab wann ein Wort zur Silbentrennung untersucht wird. 
+Andererseits bestimmt die Einstellung auch, wieviel Zwischenraum zwischen 
+Worten eingefügt werden muß, um einen rechten Randausgleich zu erzielen. 
+ 
+Merke: 'hyphenation width' bestimmt, an welchem Punkt Worte zur Silbentren- 
+nung angeboten werden. 
+ 
+ 
+Mit unterschiedlichen Schriften schreiben: 'type' 
+ 
+Unterschiedliche Schrifttypen#ie# werden mit der 'type'-Anweisung ange- 
+fordert. 
+ 
+Es ist möglich, mit 'lineform' verschiedenartige Schrifttypen (kurz Typen 
+genannt) verarbeiten zu lassen. Jeder Typ hat - neben dem speziellen Aus- 
+sehen der Zeichen - die Eigenschaft, daß jedes Zeichen eine bestimmte Breite 
+und Höhe hat. 
+ 
+Es gibt zwei Arten von Schriften: bei äquidistanten Schriften sind alle 
+Zeichen gleich breit (wie bei einer "normalen" Schreibmaschine). Proportio- 
+nalschrift findet man in gedruckten Büchern. Hier haben unterschiedliche 
+Zeichen auch unterschiedliche Breiten. Die Zeichen ".", "i", "!" sind z.B. 
+schmaler als die Zeichen "w", "o", "m" usw. 
+ 
+Mit der Anweisung 
+ 
+    type ("schriftname") 
+ 
+kann auf einen anderen Schrifttyp umgeschaltet werden (auch mehrmals inner- 
+halb einer Zeile). Dieser Typ gilt solange, bis wieder ein neue 'type'-An- 
+weisung gegeben wird. Beispiel: 
+ 
+   \#type("basker12")\#Jetzt schreiben wir in einer Schrift. Und jetzt 
+   schalten wir um auf\#type ("modern12")\# noch eine andere Schrift. 
+ 
+Welche Schriftarten zur Verfügung stehen, hängt natürlich von dem verfügbaren 
+Drucker ab. Sie können die Schrifttypen bei Ihrer EUMEL-Installation er- 
+fragen.   
+Schrifttypen können modifiziert gedruckt werden (vergl. dazu den nächsten Ab- 
+schnitt). Durch die Angabe einer 'type'-Anweisung werden alle Modifikationen 
+ausgeschaltet. 
+ 
+Merke: Eine 'type'-Anweisung gibt einen gewünschten Schrifttyp an. 
+ 
+ 
+ 
+Kursiv, fett, unterstrichen, revers drucken: 'on/off' 
+ 
+Mit der 'on'- und 'off'-Anweisung ist es möglich, einen Schrifttyp zu modi-f 
+izieren. Die Schrift wird zwar nicht gewechselt, aber verändert gedruckt. 
+Zur Zeit ist unterstrichen, fett, kursiv und der Druck von weiß auf schwarz 
+möglich (abhängig vom eingesetzten Drucker). 
+ 
+Die 'on'/'off'-Anweisung wirkt wie ein Schalter, der die gewünschte Schrift- 
+typ-Modifikation ein- bzw. ausschaltet. Beispiel: 
+ 
+... Das EUMEL-System ermöglicht es, 
+\#on("italic")\#kursiv\#off("italic")\# 
+und 
+\#on("underline")\#unterstrichen\#off("underline")\# 
+und 
+\#on("bold")\#fett\#off("bold")\# 
+und 
+\#on("revers")\#revers\#off("revers")\# 
+zu schreiben. 
+ 
+Die Anweisung 'on' schaltet die Modifikation ein, 'off' schaltet sie aus. 
+Folgende Modifikationen sind z.Zt. implementiert: 
+ 
+     bold         (Fettdruck) 
+     italic       (Kursivdruck) 
+     underline    (Unterstreichung) 
+     revers       (Weiß auf Schwarz) 
+ 
+Dabei ist folgendes zu beachten: 
+ 
+a) Ein 'type'-Anweisung schaltet eine Modifikation immer aus. 
+ 
+b) Eine Modifikation sollte nicht über einen Absatz gehen ('lineform' er- 
+   zeugt eine Warnung). Somit ist es gewährleistet, daß das Ausschalten 
+   einer Modifikation nicht vergessen wird. 
+ 
+c) Nicht alle Drucker können die hier angegebenen Modifikationen auch 
+   drucken. Bitte erkundigen Sie sich bei Ihrer Installation. 
+ 
+d) Welche Modifikationen gleichzeitig eingeschaltet werden können, ist 
+   ebenfalls druckerabhängig. 
+ 
+Merke: Die Anweisungen 'on' und 'off' schalten eine Modifikation an- und aus. 
+ 
+ 
+ 
+Gesperrt schreiben 
+ 
+Wird ein Wort g e s p e r r t geschrieben, muß natürlich verhindert werden, 
+daß dieses Wort beim Formatieren getrennt wird. Andere Worte, wie z.B. in 
+Formeln, sollten ebenfalls zusammen auf eine Zeile geschrieben werden (z.B. 
+'sin (x)'). 
+ 
+Dies kann man erreichen, indem man nicht das Leerzeichen zwischen die Zeichen 
+schreibt, denn das Leerzeichen bedeutet für 'autoform'/'lineform' immer das 
+Ende eines Wortes. Man nimmt stattdessen ESC blank. ESC blank erscheint auf 
+dem Bildschirm zur besseren Identifizierung als Unterstreichungsstrich (oder 
+invers:  ) Beim Drucken wird jedoch wieder ein Leerzeichen produziert. 
+Beispiel: 
+ 
+     g_e_s_p_e_r_r_t     (auf dem Terminal) 
+     g e s p e r r t     (auf Papier) 
+ 
+Wir nennen dieses Leerzeichen auch "geschütztes Leerzeichen". 
+ 
+Merke: G e s p e r r t wird mit dem geschützten Leerzeichen geschrieben. 
+ 
+ 
+ 
+Tabellen und Aufzählungen schreiben 
+ 
+Aufzählungen und Tabellen werden automatisch richtig formatiert und gedruckt, 
+wenn man sich an einige einfache Regeln hält. 
+ 
+Verwendet man eine Proportionalschrift beim Tabellenschreiben, so sind die 
+Spalten in der Regel unterschiedlich breit, selbst wenn eine gleiche Anzahl 
+Zeichen in jeder Spalte geschrieben wird. Dies kann man durch das Schreiben 
+von einem "Doppelblank" vermeiden. Beispiel: 
+ 
+    nnnnn | zweite Spalte 
+    mmmmm | steht nicht untereinander 
+ 
+aber mit Doppelblank: 
+ 
+     nnnn   |  zweite Spalte 
+     mmmm   |  stehen jetzt untereinander 
+ 
+Das Doppelblank dient 'lineform/autoform' und dem Drucker als Zeichen, daß 
+die Positionen speziell berechnet ('lineform') und beim Druck berücksichtigt 
+werden müssen. In seltenen Fällen (insbesondere beim Einsatz von Schriftypen, 
+die in der Größe stark voneinander abweichen) kann es vorkommen, daß diese 
+Tabellenautomatik nicht funktioniert und Spalten übereinander gedruckt 
+werden. In solchen Fällen muß man die Anzahl der trennenden Doppelblanks 
+erhöhen.  
+ 
+Praktischer Tip: 
+Beachte, daß für das Funktionieren der "Tabellenautomatik" bei proportionalen 
+Schriften es erforderlich ist, das jede Tabellenzeile eine Absatzzeile ist. 
+Man sollte diese Zeilen vor dem Druck daraufhin überprüfen oder durch 'line- 
+form/autoform' die Datei bearbeiten lassen. Sollte durch die zeilenweise 
+Formatierung einmal zwei Zeilen zusammengezogen sein (wegen fehlender Absatz- 
+kennzeichnung), kann man diese leicht mit dem Editor wieder "auseinander- 
+brechen" (zweimaliges HOP RUBIN). 
+ 
+Ähnliches gilt bei Aufzählungen. Beispiel: 
+ 
+   1) Das ist die erste Aufzählung. 
+      Dieser Satz wird bündig gedruckt. 
+   2) Hier auch. 
+ 
+Auch in solchen Fällen wird der gedruckte Text in der Regel richtig einge- 
+rückt. Die Aufzählungsautomatik wirkt nur nach einem Absatz und bei Propor- 
+tionalschriften. Die Regeln sind etwas kompliziert, so daß sie hier nicht 
+einzeln aufgeführt werden (siehe S. #topage("block")# unter dem Kommando 
+'block'). Trifft man auf einen der seltenen Fälle, wo die Einrückungsautoma- 
+tik nicht funktioniert, kann man immer das Doppelblank der Tabellenautomatik 
+verwenden. 
+ 
+Merke: Die Tabellen- und die Aufzählungsautomatik sorgen dafür, daß Tabellen- 
+spalten und Aufzählungen bündig gedruckt werden. 
+ 
+ 
+ 
+Zeilenbreite einstellen: 'limit' 
+ 
+Mit der 'limit'-Anweisung kann die Zeilenbreite eingestellt werden. 
+ 
+Die 'limit'-Anweisung gibt (in cm) an, wie breit die Zeile sein soll. Be- 
+achte, daß die Angabe der Zeilenbreite nichts mit dem LIMIT-Kommando des 
+Editors zu tun hat. Dieses gibt an, wieviel Zeichen einer äquidistanten 
+Schrift beim Schreiben auf eine Bildschirmzeile passen sollen. 
+ 
+Die Zeilenbreite wird zusammen mit dem Schrifttyp beim erstmaligen Aufruf von 
+'autoform'/'lineform' interaktiv erfragt und als 'limit'-Anweisung (zusammen 
+mit der 'type'-Anweisung) in die erste Zeile der Datei eingetragen. Es kann 
+in einer Datei mehrmals verändert werden. Die Zeilenbreite gilt immer ab der 
+Zeile, in der die 'limit'-Anweisung steht. Beispiel: 
+ 
+            \#limit(10.0)\#Mit der 'limit'-Anwei­
+            sung kann man Paragraphen in einem
+            anderen Format leicht gestalten.
+            Die rechte Schreibgrenze wird durch
+            die 'limit'-Anweisung eingestellt,
+            während der linke Rand durch eine
+            entsprechende Einrückung gestaltet
+            wird. \#limit(13.5)\# 
+ 
+Man beachte, daß als Parameter in der 'limit'-Anweisung eine Zahl mit Dezi- 
+malpunkt angegeben werden muß. 
+ 
+Die folgende Tabelle gibt sinnvolle 'limit'-Einstellungen für die am 
+häufigsten verwandten Papiergrößen an: 
+ 
+ 
+       Format       'limit'           Verbleibender 
+                  (Zeilenbreite)         Rand 
+ 
+      DIN A4          16.0 cm          je 2.65 cm 
+ 
+      DIN A5          12.0 cm          je 1.42 cm 
+ 
+      DIN A4 quer     25.0 cm          je 2.35 cm 
+ 
+Merke: Die 'limit'-Anweisung stellt die Zeilenbreite in cm ein, während das 
+'LIMIT'-Kommando des Editors die Zeilenbreite in Anzahl Zeichen angibt. 
+ 
+ 
+ 
+3. Seitenweises formatieren: 'pageform' 
+ 
+'pageform' formatiert eine Datei seitenweise, wobei Routinearbeiten, wie 
+etwa die Plazierung von Fußnoten, Seitennummerierung usw. ebenfalls von 
+'pageform' erledigt werden. 
+ 
+ 
+ 
+Eine Datei in Seiten teilen: 'pageform'-Kommando 
+ 
+Das Programm 'pageform' wird mit dem Kommando 
+ 
+     pageform ("Buch") 
+ 
+aufgerufen. 'pageform' erzeugt aus der Eingabedatei (hier: 'Buch') eine 
+Druckdatei, deren Name durch ein angehängtes '.p' gebildet wird (in unserem 
+Beispiel: 'Buch.p'). 
+ 
+ 
+Übersicht über die Arbeitsweise von 'pageform' 
+ 
+'pageform' erzeugt aus einer Eingabedatei eine Druckdatei, wobei z.B. Fuß- 
+noten und Seitennummern an den richtigen Stellen eingefügt werden. 
+ 
+'pageform' akzeptiert als Eingabe eine Datei und produziert eine neue Datei, 
+die "Druckdatei". Die Druckdatei besteht aus der Eingabedatei mit ggf. neu 
+eingefügten Zeilen. Die eingesetzten Zeilen stammen aus 'head'-, 'bottom' 
+oder 'footnote'-Anweisungen. Dadurch erhöht sich die Zeilenanzahl der Datei 
+(bis zu 15%). 
+ 
+Durch 'pageform' ist es möglich, am Anfang und am Ende jeder Seite Zeilen 
+einfügen zu lassen. Solche Textzeilen aus Kopf- bzw. Fußbereichen sowie 
+Zeilen aus Fußnoten werden in der Druckdatei in jede Seite an entsprechender 
+Stelle eingefügt. 
+ 
+Es ist möglich, in Kopf- oder Fußzeilen Seitennummern aufzunehmen. Diese Sei- 
+tennummern werden von 'pageform' bei Seitenwechseln automatisch erhöht und
+an eine vom Benutzer gekennzeichnete Stelle eingesetzt. Fußnoten können auch 
+durch Nummern gekennzeichnet werden. Querverweise sind ebenfalls möglich. 
+ 
+'pageform' berechnet die Anzahl von Zeilen, die auf eine Seite passen sollen, 
+aus den Angaben für die Seitenlänge, eingestellten Zeilenvorschub und even- 
+tuelle Kopf-, Fuß- und Fußnotenzeilen. Bei der Berechnung wird von der je- 
+weiligen Schrifthöhe des eingestellten Schriftyps ('type'-Anweisung) ausge- 
+gangen. Dann zeigt 'pageform' das errechnete Seitenende auf dem Bildschirm 
+an. Das Seitenende kann interaktiv verschoben werden, um es an eine ge- 
+wünschte Stellen zu plazieren oder es können Leerzeilen eingefügt/gelöscht 
+werden, um Seiten gleich lang zu machen. Zusätzlich ist es auch möglich, 
+Seiten in Spalten ("Zeitungsdruck") aufzuteilen und diese interaktiv zu 
+formatieren. 
+ 
+     Anweisungs-Übersicht 
+ 
+     bottom           Fußzeilen                     *) 
+     bottomeven          "                          *) 
+     bottomodd           "                          *) 
+     columns          Spaltenformatieren 
+     columnsend       Spalten ausschalten 
+     count            Zähler erhöhen und einsetzen 
+     end              Beendet 'head', 'bottom' und  *) 
+                      'foot'-Bereiche 
+     foot             Fußnote                       *) 
+     free             Zeilen freilassen             *) 
+     goalpage         Seitenverweis (Ziel) 
+     head             Kopfzeilen                    *) 
+     headeven            "                          *) 
+     headodd             "                          *) 
+     linefeed         Zeilenabstand                 *) 
+     page             Neue Seite anfangen           *) 
+     pagelength       Seitenlänge setzen 
+     pagenr           Seitennummer bzw. -zeichen 
+     setcount         Zähler setzen 
+     topage           Seitenverweis (Ursprung) 
+     value            Wert des Zählers einsetzen 
+ 
+*) Diese Anweisungen dürfen nur allein oder als letztes auf einer Zeile stehen. 
+ 
+ 
+Merke: 'pageform' erlaubt nicht nur eine Seitenformatierung, sondern auch 
+Spaltenformatierung, Fußnoten-Plazierung, Kopf- und/oder Fußzeilen, Seiten- 
+numerierung und Querverweise. 'pageform' erzeugt eine neue Datei, die 
+"Druckdatei" mit dem Namen der Eingabedatei, an den ".p" angefügt wird. 
+ 
+ 
+ 
+Seitenende interaktiv verschieben#ie# mit 'pageform' 
+ 
+In diesem Abschnitt wird beschrieben, welche interaktiven Möglichkeiten 
+'pageform' bietet, um Seiten zu gestalten. 
+ 
+Auf dem Bildschirm wird das von 'pageform' errechnete jeweilige Seitenende 
+unter Angabe der aktuellen Seitennummer angezeigt. Das Seitenende erscheint 
+ungefähr in der Mitte des Bildschirmes und wird durch eine von 'pageform' ge- 
+kennzeichnete Zeile markiert, die auch - nach erfolgter Seitenformatierung - 
+in der Druckdatei zu sehen ist. (Der EUMEL-Drucker druckt diese Zeile nicht.) 
+Beispiel: 
+ 
+\#page\#\#--------------------- Ende Seite 1 ---\# 
+ 
+Über der Markierung erscheinen die letzten Zeilen der bereits verarbeiteten 
+Seite, darunter Zeilen der nächsten Seite. Es ist nun mit Hilfe der Positio- 
+nierungstasten möglich, die Markierung und damit das Seitenende nach "oben 
+zu verschieben". Somit kann vermieden werden, daß logisch zusammengehörender 
+Text auseinandergerissen wird und z.B. "Waisenkinder"  entstehen (letzte 
+Zeile eines Abschnittes kommt noch auf die neue Seite). 
+ 
+Bei der interaktiven Seitenformatierung kann die Markierung nicht über das 
+errechnete Ende einer Seite nach "unten" oder über das vorherige, bereits 
+verarbeitete Seitenende nach "oben" verschoben werden. Die Markierung kann 
+auch nicht in einen Fußnotenbereich plaziert werden, weil Fußnoten sinn- 
+vollerweise nicht geteilt werden sollten. 
+ 
+Entstehen Leerzeilen bei der Seitenformatierung am Anfang einer Seite (z.B. 
+durch Plazierung des Seitenendes zwischen zwei Absätzen), so werden diese 
+von 'pageform' automatisch aus der Druckdatei entfernt. Will man Leerzeilen 
+am Anfang einer Seite#ie#, dann sollte das 'free' in Verbindung mit der 
+'page'-Anweisung verwandt werden. 
+ 
+Zusätzlich ist es möglich, Leerzeilen in eine Seite der Druckdatei einzu- 
+fügen und/oder beliebige Zeilen zu löschen (vergl. b)). 
+ 
+Folgende Operationen stehen bei der interaktiven Seitenformatierung zur 
+Verfügung: 
+ 
+a) Seitenende verschieben: 
+ 
+'pageform' berechnet das "rechnerische" Seitenende und zeigt dieses auf dem 
+Bildschirm durch die Markierung an. Die Markierung kann interaktiv verschoben 
+werden: 
+ 
+       Taste                  Bedeutung 
+ 
+      RETURN          Seitenende an diese Stelle plazieren. 
+      OBEN            Seitenende eine Zeile nach oben verschieben. 
+      UNTEN           Seitenende eine Zeile nach unten verschieben 
+                      (wenn vorher nach "oben" verschoben). 
+      HOP OBEN        Seitenende um einen Bildschirm nach oben verschieben. 
+      HOP UNTEN       Seitenende um einen Bildschirm nach unten verschieben. 
+ 
+b) Leerzeilen einfügen und/oder Zeilen löschen 
+ 
+Ergeben die Berechnungen von 'pageform', daß der bearbeitete Text nicht 
+richtig auf der Seite plaziert ist, können in die Seite (der Druckdatei!) 
+Leerzeilen eingefügt und/ oder Zeilen gelöscht werden. Dies kann beispiels- 
+weise sinnvoll sein, wenn durch die Löschung einer Zeile ein Absatz noch auf 
+die Seite passen würde oder durch die Einfügung von Leerzeilen ein Absatz 
+auf der letzten Zeile der Seite endet. Oft ist es auch sinnvoll, daß alle 
+Seiten gleich lang sind. In diesem Fall sollten vor Kapiteln und Absätzen 
+Leerzeilen eingefügt oder gelöscht werden. 
+ 
+Um Leerzeilen einzufügen und/oder Zeilen zu löschen, muß die Markierung (wie 
+unter a) beschrieben) an die Stelle plaziert werden, an der die Änderung 
+vorgenommen werden soll. Abschließend berechnet 'pageform' die Seite erneut. 
+ 
+       Taste                  Bedeutung 
+ 
+      HOP RUBIN       Leerzeilen einfügen. 
+                      Anstatt der Markierung können durch (u.U. mehrmaliges) 
+                      RETURN Leerzeilen eingefügt werden. HOP RUBIN beendet 
+                      den Vorgang (wie Zeileneinfügen im Editor). 
+ 
+      HOP RUBOUT      Zeile löschen. 
+                      Die Zeile unmittelbar oberhalb der Markierung wird 
+                      gelöscht. 
+ 
+'page'-Anweisung bestätigen/löschen 
+ 
+Wird von der Prozedur 'pageform' eine 'page'-Anweisung angetroffen, so wird 
+das so gewünschte Seitenende auf dem Bildschirm des Benutzers angezeigt. Die 
+'page'-Anweisung kann entweder bestätigt oder gelöscht werden. 
+ 
+       Taste                  Bedeutung 
+ 
+      RETURN          Seitenende bestätigen. 
+ 
+      RUBOUT          'page'-Anweisung ignorieren. Die Prozedur 'pageform' 
+                      bearbeitet in diesem Fall die Datei weiter, als ob 
+                      keine 'page'-Anweisung angetroffen wurde. 
+ 
+Merke: Ein Seitenende wird von 'pageform' auf dem Bildschirm angezeigt. Dies 
+kann man mit den Positionierungstasten verschieben. Es können in die Seite 
+Leerzeilen eingefügt oder Zeilen gelöscht werden. Eine 'page'-Anweisung kann 
+man bestätigen oder löschen. 
+ 
+ 
+ 
+Seitenlänge einstellen: 'pagelength' 
+ 
+'pageform' ist auf eine Seitenlänge von 25.0 cm eingestellt (entspricht 
+einem DINA4-Schreibfeld). Ist eine andere Seitenlänge erwünscht, muß die 
+'pagelength'-Anweisung in den Text eingefügt werden. 
+ 
+Beispiel: 
+ 
+   \#pagelength (20.0)\# 
+ 
+stellt die Seitenlänge auf 20 cm ein. Man beachte, daß der Dezimalpunkt bei 
+der Seitenlänge mit angegeben werden muß. 
+ 
+Die folgende Tabelle gibt die Seitenlänge für die am häufigsten gewählten 
+Papiergrößen an: 
+ 
+       Format     Seitenlänge       oberer und 
+                   (in cm)          unterer Rand 
+ 
+      DIN A4        25.0              je 2.35 cm 
+ 
+      DIN A5        18.0              je 2.15 cm 
+ 
+      DIN A4 quer   18.0              je 2.15 cm 
+ 
+Merke: Mit der 'pagelength'-Anweisung kann die Seitenlänge (in cm) einge- 
+tellt werden. 
+ 
+ 
+ 
+Zeilenabstand einstellen: 'linefeed' 
+ 
+Die 'linefeed'-Anweisung stellt einen Zeilenvorschub relativ zu der Schrift- 
+höhe des eingestellten Schrifttyps ein. 
+ 
+'pageform' berechnet die Anzahl Zeilen/Seite immer in Abhängigkeit vom einge- 
+stellten Schrifttyp. Hat man z.B. eine Schrift gewählt, die doppelt so hoch 
+wie z.B. eine Schreibmaschinenschrift ist, bekommt man auch entsprechend 
+weniger Zeilen auf eine Seite. Um diesen Berechnungsvorgang braucht sich ein 
+Nutzer in der Regel nicht zu kümmern. 
+ 
+Anders verhält es sich, wenn ein anderer Zeilenvorschub als der "normale" 
+Abstand zwischen Zeilen vorgenommen werden soll. In diesem Fall muß man wis- 
+sen, daß die "Höhe" einer Zeile sich aus der Schrifttypgröße errechnet plus 
+(ca.) 10%, welches den Abstand zwischen den Zeilen darstellt. 
+ 
+Soll nun ein anderer Abstand eingestellt werden, wird die 'linefeed'-An- 
+weisung eingesetzt. Der Parameter gibt an, um wieviel eine Zeilenhöhe erhöht 
+oder verringert werden soll. Beispiel: 
+ 
+   \#linefeed (2.0)\# 
+ 
+Nach Antreffen dieser Anweisung wird die Zeilenhöhe durch 2 * eingestellte 
+Schrifttypgröße errechnet. Es wird also der Zeilenabstand zwischen den Zeilen 
+entsprechend vergrößert, da die Schriftgröße gleich bleibt. Dies entspricht 
+dem zweizeiligen Schreiben bei einer Schreibmaschine (wenn man davon absieht, 
+daß hier auch unterschiedliche Schrifthöhen berücksichtigt werden). Ein 
+1 1/2 zeiliges Schreiben wäre mit 
+ 
+   \#linefeed (1.5)\# 
+ 
+einzustellen. 
+ 
+   \#linefeed (0.5)\# 
+ 
+stellt die Zeilenhöhe = 1/2 * eingestellte Schrifthöhe ein, so daß die Zeilen 
+teilweise ineinander gedruckt werden. Bei 'linefeed (0.0)' werden Zeilen 
+übereinander gedruckt (druckerabhängig). 
+ 
+Man beachte, daß die Angabe in der 'linefeed'-Anweisung relativ erfolgt. Bei 
+allen anderen Anweisungen der Textkosmetik werden Angabe in Zentimeter ver- 
+langt. Die 'linefeed'-Anweisung bildet somit eine Ausnahme (von der Regel). 
+ 
+Merke: Wieviel Zeilen auf eine Seite passen, ist von den Höhen der einge- 
+stellten Schrifttypen abhängig. Diese Berechnung erfolgt automatisch durch 
+'pageform'. Die 'linefeed'-Anweisung stellt einen Zeilenvorschub relativ zum 
+eingestellten Schrifttyp ein. 
+ 
+ 
+ 
+Platz freihalten: 'free' 
+ 
+Mit der 'free'-Anweisung kann man einen zusammenhängenden Teil auf einer 
+Seite freihalten. 
+ 
+Die 'free'-Anweisung wird an solchen Stellen im Text eingesetzt, an denen - 
+nach dem Druck - Zeichnungen, Tabellen und ähnliches eingeklebt werden sol- 
+len. Es wird der in der 'free'-Anweisung angebene Platz freigehalten. Bei- 
+spiel: 
+ 
+\#free (2.0)\# 
+hält zwei Zentimeter frei. Paßt der angeforderte Platz nicht mehr auf die 
+Seite, so wird der angeforderte Platz auf der nächsten Seite reserviert 
+('pageform' plaziert das Seitenende vor die 'free'-Anweisung). 
+ 
+Merke: Die 'free'-Anweisung hält einen Platz auf dem Papier frei (Angabe in 
+cm). 
+ 
+ 
+ 
+Neue Seite beginnen: 'page' 
+ 
+An einigen Stellen im Text, z.B. zu Beginn eines neuen Kapitels, soll unbe- 
+ingt eine neue Seite angefangen werden. 
+ 
+Dies erreicht - wie bereits erwähnt - man mit der 'page'-Anweisung. 'page- 
+form' meldet im diesem Fall, nach wieviel cm auf der Seite die Anweisung an- 
+getroffen wurde. Man kann nun mit RETURN das Seitenende bestätigen, oder die 
+Anweisung (in der Druckdatei) löschen. Im letzteren Fall berechnet 'page- 
+form' die Seite neu (als ob die 'page'-Anweisung nicht dagewesen wäre). 
+ 
+Gleichzeitig ist es möglich, mit Hilfe der 'page'-Anweisungs eine neue Sei- 
+tennummer#ie# für die neue Seite einzustellen (vergl. die nächsten Ab- 
+chnitte). 
+ 
+Merke: Die 'page'-Anweisung bewirkt eine neue Seite und muß beim Formatieren 
+bestätigt werden. 
+ 
+ 
+ 
+Kopf- und Fußzeilen: 'head/bottom' 
+ 
+Mit den 'head'- und #ib#'bottom'-Anweisung#ie#en ist es möglich, Zeilen am 
+Anfang und Ende jeder Seite einfügen zu lassen. 
+ 
+Zeilen am Anfang ("Kopfzeilen") und Ende ("Fußzeilen") jeder Seite werden 
+nur einmal geschrieben und mit Anweisungen gekennzeichnet. Diese Zeilen fügt 
+'pageform' dann an den entsprechenden Stellen ein. Beispiel: 
+ 
+\#head\# 
+                Unser EUMEL-Benutzerhandbuch 
+ 
+\#end\# 
+ 
+Diese zwei Zeilen (also die zwischen den 'head'- und 'end'-Anweisungen ein- 
+geschlossenen Zeilen) werden unverändert von 'pageform' an den Anfang jeder 
+Seite in die Druckdatei plaziert. Man beachte, daß zweckmäßigerweise (minde- 
+stens) eine Leerzeile nach einer solchen Kopfzeile in den 'head'-Bereich ein- 
+gefügt werden sollte, um die Kopfzeile von dem eigentlichen Text der Seite zu 
+trennen. 
+ 
+Entsprechendes gilt für Fußzeilen, die zwischen 'bottom' und 'end' einge- 
+chlossen werden müssen: 
+ 
+\#bottom\# 
+                   Autor: I. Listig 
+\#end\# 
+ 
+Praktischer Tip: Man füge nach einer Schriftzeile mindestens eine Leerzeile 
+ein (in einem 'head') bzw. vor der Schriftzeile (in einem 'bottom'), um den 
+eigentlichen Text von den Kopf- bzw. Fußzeilen abzuheben. 
+ 
+'pageform' zählt die Seiten, beginnend mit der Seitennummer '1'. (Wie man 
+Seitennummern in die Kopf- und Fußzeilen bekommt, verraten wir im nächsten 
+Abschnitt). Es ist nun möglich, getrennte Kopf- und Fußzeilen für gerade und 
+ungerade Seiten zu gestalten (wie in diesem Benutzerhandbuch). Dies erfolgt 
+mit den Anweisungen 'headeven' und 'headodd' für Seiten mit geraden und un- 
+geraden Seitennummern; ('bottomeven' und 'bottomodd' dito). 
+ 
+Diese Anweisungen müssen ebenfalls jeweils mit einer 'end'-Anweisung be- 
+endet werden. 
+ 
+Es ist möglich, Kopf- und Fußzeilen mehrmals innerhalb einer Datei zu 
+wechseln, um unterschiedliche Beschriftungen zu erhalten (z.B. kapitelweise). 
+Dies ist jedoch nur sinnvoll, wenn dies auf einer neuen Seite erfolgt, also 
+unmittelbar nach einer 'page'-Anweisung in den Text eingefügt wird. Beispiel: 
+ 
+    \#page\# 
+    \#head\# 
+              Neuer Seiten Kopf 
+ 
+    \#end\# 
+ 
+"Fußzeilen" sollen überall gleiches Aussehen haben, unabhängig davon, welche 
+Anweisungen im restlichen Text gegeben werden. Darum werden die bei der De- 
+finition einer Fußzeile aktuellen Werte für 
+ 
+  limit 
+  type 
+  linefeed 
+ 
+bei dem Einsetzen der Zeilen berücksichtigt. Es ist somit erlaubt, einen 
+anderen Schrifttyp (z.B. als der restliche Text) für Fußzeilen zu verwenden, 
+indem die 'type'-Anweisung innerhalb des 'bottom'-Bereiches gegeben wird. 
+Beachte, daß nach 'head'-, 'bottom' und auch 'foot'-Bereiche die o.a. Kom- 
+mandos nicht automatisch zurückgestellt werden. Darum sollte vor der 'end'- 
+Anweisung wieder auf den im übrigen Text verwandten Schrifttyp zurückge- 
+stellt werden. Gleiches gilt für die 'limit'- und 'linefeed'-Anweisung. 
+Beispiel: 
+ 
+     \#bottom\# 
+     \#type ("besonders schoen")\# 
+                        Autor: I. Listig 
+ 
+     (Schriftyp zurückstellen): \#type ("normal")\# \#end\# 
+ 
+Merke: Kopf- und Fußzeilen können durch die Anweisungen 'head' bzw. 'bottom' 
+oder 'headeven', 'headodd' bzw. 'bottomeven', 'bottomodd' definiert werden. 
+Die Zeilen müssen jeweils durch die 'end'-Anweisung beendet werden. 
+ 
+ 
+ 
+Seiten numerieren 
+ 
+In den Kopf- und Fußzeilen steht das '%'-Zeichen für die aktuelle Seiten- 
+nummer. 
+ 
+Erscheint das '%'-Zeichen innerhalb eines Kopf- oder Fußbereiches, wird von 
+'pageform' beim Einsetzen dieser Zeilen auf jeder Seite die aktuelle Seiten- 
+nummer#ie# eingesetzt (sind mehrere '%'-Zeichen vorhanden, wird die Seiten- 
+nummer mehrmals eingesetzt). Beispiel: 
+ 
+\#head\# 
+                 Seite: - % - 
+ 
+\#end\# 
+ 
+Durch einen Fußbereich kann man die Seitennummern auch am Ende einer Seite 
+haben. Man beachte, daß sich bei mehrstelligen Seitennummern durch das Ein- 
+setzen die Zeilenlänge vergrößert. 
+ 
+Manchmal ist es notwendig und sinnvoll, einen Text in mehreren Dateien zu 
+halten. Bei einer Folgedatei muß die Seitennummer dann neu gesetzt werden. 
+Das erfolgt mit der 'page'-Anweisung. Beispiel: 
+ 
+\#page (4)\# 
+ 
+vollzieht eine neue Seite. Die Seitennummer der neuen Seite ist '4'. 
+ 
+Bei einigen Spezialanwendungen benötigt man mehr als eine Seitennummer. 
+Beispielsweise soll ein Text nicht nur absolut, sondern auch jede Seite in 
+jedem Kapitel separat durchgezählt werden. Eine andere Anwendung ist die 
+Benennung einer Folgeseite, wie in diesem Beispiel: 
+ 
+\#page (4711)\# 
+\#head\# 
+               Mein Buch         Seite: % 
+ 
+\#end\# 
+\#pagenr ("$", 4712)\# 
+\#bottom\# 
+ 
+               Nächste Seite: $ 
+\#end\# 
+ 
+Durch die 'pagenr'-Anweisung gibt man ein neues "Seitenzeichen" (hier: '$') 
+und den Anfangwert für diese Seitennummer (hier: '4712'), der ebenfalls wie 
+das '%'-Seitenzeichen von 'pageform' bei jeder neuen Seite um '1' erhöht und 
+ggf. in die Kopf- und Fußzeilen eingesetzt wird. Es sind zwei zusätzliche 
+Seitenzeichen (neben dem '%') möglich. 
+ 
+Merke: In den Kopf- und Fußzeilen wird ein '%'-Zeichen von 'pageform' durch 
+die aktuelle Seitennummer ersetzt. Die Seitennummer kann durch das 'page'- 
+Anweisung neu gesetzt werden. 
+ 
+ 
+ 
+Fußnoten schreiben: 'foot' 
+ 
+Fußnoten werden direkt im Text durch die Anweisungen 'foot' und 'end' ge- 
+kennzeichnet. Die Fußnoten plaziert 'pageform' an das Ende einer Seite. 
+ 
+Fußnoten werden vom Benutzer direkt in den Text geschrieben, am besten nach 
+einem Absatz. Die Fußnote wird von 'pageform' an das Ende einer Seite, ggf. 
+vor Fußzeilen plaziert. Für die Kennzeichnung von Fußnoten und die ent- 
+sprechende Markierung im Text ist der Benutzer selbst zuständig. Allerdings 
+wird von 'pageform' bei dem Einsetzen einer Fußnote am Ende einer Seite 
+Unterstreichungsstriche vor die Fußnoten eingefügt, damit Fußnoten vom 
+"normalen" Text abgehoben werden. 
+ 
+\#foot\# 
+*) Das ist die erste Anmerkung auf dieser Seite. 
+\#end\# 
+ 
+Mehrere Fußnoten innerhalb einer Seite werden von 'pageform' in der Reihen- 
+folge ihres Auftretens gesammelt und am Ende der Seite plaziert. Für eine 
+entsprechende Trennung der Fußnoten voneinander (z.B. durch Leerzeilen) hat 
+der Benutzer selbst zu sorgen. 
+ 
+Man sollte eine Fußnote unmittelbar hinter den Absatz schreiben, in der die 
+Markierung für die Fußnote erscheint, denn u.U. paßt die Fußnote nicht mehr 
+auf die aktuelle Seite und muß somit von 'pageform' auf die nächste Seite 
+gebracht werden. 'pageform' geht davon aus, daß die Kennzeichnung der Fuß- 
+note in der Zeile unmittelbar vor der Fußnote steht und bringt diese Zeile 
+ebenfalls auf die neue Seite. 
+ 
+Merke: Fußnoten werden direkt hinter einem Absatz in den Text mittels der 
+Anweisungen 'foot' und 'end' geschrieben, die 'pageform' an das Ende der 
+Seite einfügt. Die Kennzeichnung der Fußnoten hat der Benutzer selbst vorzu- 
+nehmen oder man kann sie mit Hilfe von 'count'- und 'value'-Anweisungen 
+durchnumerieren (siehe nächsten Abschnitt). 
+ 
+ 
+ 
+Fußnoten numerieren: Zählen lassen 
+ 
+Bei vielen Fußnoten in einem Text ist es nicht möglich, die Fußnoten beim 
+Schreiben des Textes entsprechend zu beschriften. Für diesen Fall und um auf 
+die Fußnote im Text nochmals Bezug nehmen zu können, bietet 'pageform' die 
+Möglichkeit an, die Fußnoten zu numerieren. 
+ 
+Durch die 'count'-Anweisung wird 'pageform' veranlaßt, einen internen Zähler 
+(beginnend bei dem Wert 0) zu erhöhen und diesen Wert anstatt der 'count'- 
+Anweisungen in den Text einzusetzen. Beispiel: 
+ 
+\#count\# 
+ 
+setzt den Wert 1 anstatt der Anweisung ein (Anmerkung: trifft 'lineform' auf 
+eine 'count'-Anweisung, so wird die Zeile berechnet, als ob drei Ziffern 
+anstatt der Anweisung ständen). Jede weitere 'count'-Anweisung erhöht den 
+internen Zähler und der Zählerwert wird wiederum eingesetzt: 
+ 
+\#count\# 
+ 
+setzt den Wert 2 ein usw. Dadurch ist es möglich, beliebige Textteile 
+(Kapitel, mathematische Sätze u.a.m.) fortlaufend zu numerieren, ohne auf 
+die Numerierung beim Schreiben und Ändern des Textes zu achten. 
+ 
+Mit der 'value'-Anweisung kann man den letzten erreichten count-Wert noch- 
+mals einsetzen. Das ist insbesondere für Fußnoten sinnvoll einsetzbar. 
+Beispiel: 
+ 
+     Bla Bla Bla (\#count\#) 
+     \#foot\# 
+     Eine Fußnote 
+     \#end\# 
+     ... 
+ 
+Das Resultat würde folgendermaßen aussehen: 
+ 
+     Bla Bla Bla (3) 
+     .... 
+ 
+     _____ 
+     (3) Eine Fußnote 
+ 
+Man beachte, daß in diesem Fall die 'value'-Anweisung der 'count'-Anweisung 
+folgen muß, ohne das eine weitere 'count'-Anweisung dazwischen steht. Das 
+liegt - wie bereits erwähnt - daran, daß die 'value'-Anweisung immer den 
+letzten 'count' Wert einsetzt. 
+ 
+Das kann man umgehen, indem die 'count'- und 'value'-Anweisungen mit einem 
+TEXT-Parameter versehen werden, der als Kennzeichnung dient. Beispiel: 
+ 
+     \#count ("Merk1")\# 
+ 
+arbeitet ebenso wie 'count' ohne Parameter (setzt also hier den Wert 4 ein), 
+aber zusätzlich vermerkt 'pageform' den aktuellen Zählerwert neben dem Kenn- 
+zeichen. Nun ist es mit der 'value'-Anweisung möglich, den vermerkten Zähler- 
+wert durch Angabe des Kennzeichens an beliebigen Stellen im Text zu reprodu- 
+zieren (auch wenn der interne Zähler weitergezählt wurde). Beispiel: 
+ 
+     \#count\#\#count\# 
+     \#value("Merk1")\# 
+ 
+Die ersten zwei 'count'-Anweisungen produzieren - wie beschrieben - die 
+Werte 5 bzw. 6. Die 'value'-Anweisung dagegen setzt den vermerkten Wert 4 
+ein. 
+ 
+Dies ist insbesondere sinnvoll, wenn man im Text auf eine Fußnote verweisen 
+will. Beispiel: 
+ 
+     Bla Bla. Siehe auch Anmerkung (\#value ("Waldschrat")\#). Bla 
+     ... 
+     ... 
+     Bla Bla Bla (\#count ("Waldschrat")\#) 
+     \#foot\# 
+     (\#value ("Waldschrat")\#) Waldschrate kommen in vier Farben vor: 
+                              Rot, schwarz, grün und blau/gelb. 
+     \#end\# 
+ 
+Manchmal ist es notwendig (ebenso wie bei der Seitennummer), den internen 
+Zähler neu zu setzen. Beispiel: 
+ 
+   \#setcount (13)\#\#count ("aha!")\# 
+ 
+produziert den Wert 13. 
+ 
+Merke: Die 'count'-Anweisung setzt einen internen Zähler in die Druckdatei 
+ein. Durch die #ib#'value'-Anweisung#ie# werden gespeicherte Werte einge- 
+setzt, was man bei Fußnoten ausnutzen kann. 
+ 
+ 
+ 
+Querverweise mit 'topage'/'goalpage' 
+ 
+Mit den Anweisungen 'topage' und 'goalpage' sind Querverweise möglich, die 
+von 'pageform' in die Druckdatei eingefügt werden. 
+ 
+Mit Hilfe von Querverweisen soll auf andere Stellen im Text verwiesen werden, 
+was nur bei längeren Texten üblich ist. Um dem Leser die mühselige Suche 
+nach der Textstelle zu ersparen, gibt man in der Regel die Seitennummer an. 
+Leider steht die Seitennummer vor der Fertigstellung des Textes meist noch 
+nicht fest. Auch in diesem Fall kann 'pageform' helfen. Die 'topage'- An- 
+weisung verweist auf eine andere Seite im Text, an der sich eine Anweisung 
+'goalpage' befinden muß. Anstatt der Anweisung 'topage' wird die Seitennum- 
+mer der Seite eingesetzt, auf der sich 'goalpage' befindet. Damit jedes 
+'topage' auch (sein) entsprechendes 'goalpage' findet, wird bei beiden An- 
+weisungen ein TEXT-Parameter angegeben. Beispiel: 
+ 
+   Man schreibt: ... siehe auch auf Seite \#topage("verweis1")\# 
+   ... 
+   Auf einer anderen Seite befindet sich \#goalpage("verweis1")\# 
+ 
+Nach 'Seite' wird die entsprechende Seitennummer eingesetzt. 
+ 
+Es ist möglich, mehrmals auf die gleiche (Ziel-) Seite zu verweisen, man muß 
+nur darauf achten, daß immer das gleiche Merkmal (TEXT-Parameter) verwandt 
+wird. 
+ 
+Merke: Mit den 'topage'- und 'goalpage'-Anweisungen sind Seitenquerverweise 
+möglich. Für 'topage' wird die Seitennummer eingesetzt, auf der 'goalpage' 
+steht. 
+ 
+ 
+ 
+Formatierung von Spalten: 'columns' 
+ 
+Mit der 'columns'-Anweisung ist es möglich, einen Text in Spalten zu forma- 
+tieren ("Zeitungsdruck"). 
+ 
+Durch die Angabe der 'columns'-Anweisung wird 'pageform' aufgefordert, den 
+Text in Spalten zu formatieren. Die Spaltenbreite muß der Benutzer mit der 
+'limit'-Anweisung einstellen. Beispiel: 
+ 
+   \#limit (18.0)\# 
+   ... 
+   \#columns (2, 2.0)\#\#limit (8.0)\# 
+   ... 
+ 
+Anfangs schreibt der Benutzer mit einer Zeilenbreite von 18 cm. Dann fordert 
+er mit der 'columns'-Anweisung zweispaltigen Druck an (zwischen den Spalten 
+soll 2 cm Abstand sein). Somit muß die 'limit'-Anweisung auf 8 cm einge- 
+stellt werden. 
+ 
+Die interaktive Spaltenformatierung wird von 'pageform' wie gewohnt vorgenom- 
+men. Auf dem Bildschirm erscheint nun das Spaltenende, wobei die Nummer der 
+Spalte angezeigt wird. Fußnoten werden spaltenweise eingeordnet und müssen 
+somit die gleiche Zeilenbreite haben, wie die restlichen Spalten. 
+ 
+'pageform' erzeugt in der Druckdatei die Spalten hintereinander. Das folgende 
+Beispiel zeigt einen Ausschnitt aus der Druckdatei mit Kopf- und Fußzeilen 
+bei einem zweispaltigen Druck: 
+ 
+   head-Zeilen 
+   xx 
+   xx 
+   xx 
+   bottom-Zeilen 
+   \#page\#\#------- Ende Seite 1 Spalte 1 ----\# 
+   xx 
+   xx 
+   xx 
+   \#page\#\#------- Ende Seite 1 Spalte 2 ----\# 
+ 
+Die zweite Spalte erscheint also ohne Kopf- und Fußzeilen, die jedoch bei der 
+Berechnung berücksichtigt werden. Man beachte, daß die Kopf- und Fußzeilen 
+über die Spalten gehen können. Dies erreicht man durch geeignete 'limit'- 
+Anweisungen in den genannten Bereichen. Hochwertige Drucker plazieren die 
+zweite Spalte im Druckbild neben die erste. Bei preiswerteren Druckern muß 
+man die Spalten nebeneinander kleben. 
+ 
+Es ist zwar prinzipiell möglich, die Spalten in der Druckdatei nebeneinander 
+zu schreiben. Jedoch hätte das Druckerprogramm Schwierigkeiten, diese neben- 
+einander zu drucken, ohne daß z.B. ein Schrifttypwechsel in einer Spalte 
+Auswirkungen auf eine Benachbarte hat. Praktischer Tip: Bei Druckern mit 
+"Traktorführung" kann man erst alle ersten Spalten drucken, dann das Papier 
+"von Hand" zurückdrehen und die zweiten Spalten drucken usw. 
+ 
+Alle Anweisungen funktionieren beim spaltenweisen Formatieren wie üblich. Die 
+'free'-Anweisung z.B. hält entsprechenden Platz in einer Spalte frei. Eine 
+Ausnahme bildet die 'page'-Anweisung. Sie vollzieht hier ein Spaltenende. Die 
+'page'-Anweisung mit einem Parameter (welcher die Seitennummer der nächsten 
+Seite angibt), vollzieht dagegen ein Seitenende. 
+ 
+Die 'columns end'-Anweisung beendet die spaltenweise Formatierung. Es ist 
+zweckmäßig, unmittelbar vor der 'columns'- und hinter der 'columns end'- 
+Anweisung eine 'page'-Anweisung zu schreiben. 
+ 
+Überschriften (bzw. Textblöcke) über mehrere Spalten hinweg sind nur in der 
+ersten Seite direkt hinter der 'columns'-Anweisung möglich. Beispiel: 
+ 
+   \#page\# 
+   \#limit (18.0)\# 
+   HEAD 
+   Breite Überschrift 
+   \#columns (2, ...)\#\#limit (8.0)\# 
+   XX 
+   XX 
+   XX 
+   Bottom 
+   \#page\#\#------- Ende Seite 1 Spalte 1 ----\# 
+   XX 
+   XX 
+   XX 
+   \#page\#\#------- Ende Seite 1 Spalte 2 ----\# 
+ 
+Die Zeilen für die zweispaltige Überschrift werden berücksichtigt. Dies gilt 
+jedoch nur unmittelbar hinter der 'columns'-Anweisung. Will man diesen Effekt 
+nochmals haben, beendet man mit 'columns end', schreibt die 'page'-Anweisung, 
+die breite Überschrift und schaltet die 'columns'-Anweisung wieder ein usw. 
+ 
+Merke: Die Anweisungen 'columns'- und 'columns end' bewirken ein spalten- 
+weises Formatieren des Textes durch 'pageform'. Die Spaltenbreite ('limit'- 
+Anweisung) hat der Benutzer selbst einzustellen. 
+ 
+ 
+ 
+4. Stichwortverzeichnisse erstellen: 'index'-Kommando 
+ 
+Das Programm 'index' kann Stichwort- und Inhaltsverzeichnisse erstellen. 
+Stichwortverzeichnisse#ie# können sortiert werden. Mehrere Stichwortver- 
+zeichnisse können durch 'index merge' zusammengeführt werden. 
+ 
+ 
+ 
+Übersicht über die Arbeitsweise von 'index' 
+ 
+Durch den Aufruf von 
+ 
+     index ("datei.p") 
+ 
+werden durch Indexanweisungen gekennzeichnete Worte in Dateien, den soge- 
+nannten Indexdateien, gespeichert. 
+ 
+Anweisung                  Zweck 
+ 
+  ib                   Anfang Index 
+                       (folgende Worte werden bis zur 'ie'-Anweisung in den 
+                       Index übernommen) 
+  ie                   Ende eines Index 
+ 
+Solche Verzeichnisse von Worten werden im EUMEL-System allgemein als Index 
+bezeichnet. Nachdem eine oder mehrere Indexdateien aus einer Druckdatei 
+erstellt sind, werden die Indexdateien auf Anfrage alphabetisch sortiert. 
+Bei einem Inhaltsverzeichnis sollte man die Sortierung natürlich ablehnen. 
+ 
+Nach der Sortierung werden gleiche Einträge automatisch zusammengefaßt und 
+die entsprechenden Seitennummern nacheinander aufgeführt. 
+ 
+Praktischer Tip: Will man nur eine Sortierung, aber keine Zusammenfassung 
+von Einträgen, dann lehnt man die Sortieranfrage ab. Anschließend kann man 
+die Indexdatei mit 'lex sort ("indexdatei namen")' sortieren. Hierbei 
+bleiben gleiche Einträge erhalten. 
+ 
+Das Programm 
+ 
+     index merge ("index.i1", "index.i2") 
+ 
+erlaubt es, zwei durch 'index' erzeugte Verzeichnisse zusammenzuführen. 
+'index' kann ebenfalls benutzt werden, um ein Inhaltsverzeichnis und/oder 
+ein Verzeichnis aller Abbildungen zu erstellen oder Literaturhinweise zu 
+überprüfen. 
+ 
+Die Worte, die durch 'index' in einen Index übernommen werden sollen, müssen 
+in der Eingabedatei (der Druckdatei aus 'pageform') für 'index' durch An- 
+weisungen gekennzeichnet werden. Die Form der Anweisungen entspricht der 
+ELAN-Syntax (analog den Anweisungen für 'lineform', 'pageform' und EUMEL- 
+Drucker). Solche #ib(1,"ff")#Indexanweisungen#ie# werden von den anderen 
+Textbe- und -verarbeitungs Programmen ('lineform', 'pageform', EUMEL- 
+Drucker) ignoriert. Man kann also bei dem Schreiben mit dem Editor gleich 
+festlegen, welche Worte in einen Index aufgenommen werden sollen. 
+ 
+ 
+ 
+Worte kennzeichnen: 'ib'/'ie' 
+ 
+Da in einem Index - neben dem eigentlichen Worteintrag - die Seitennummer 
+enthalten sein soll, arbeitet das Programm 'index' nur mit einer Druckdatei, 
+d.h. einer Ausgabedatei von 'pageform'. Die Indexworte werden in Indexda- 
+teien gesammelt. Die Indexdateien erhalten den Namen der zu bearbeitenden 
+Datei, an den ".i" und die Nummer des Index angefügt wird. Beispiel: 
+ 
+  ... Hier wird eine Eigenschaft des \#ib(1)\#EUMEL-Systems\#ie(1)\# beschrieben. 
+ 
+(Die durch die Anweisungen 'ib' und 'ie' gekennzeichneten Worte werden mit 
+der dazugehörigen Seitennummer in die erste Indexdatei geschrieben.) 
+ 
+Die Einträge in einer Indexdatei werden von den Seitennummern durch min- 
+destens drei Punkte getrennt. 
+ 
+Werden diese nicht gewünscht, kann man sie leicht mit dem Editor entfernen. 
+Beachte, daß man nur bei einer äquidistanten Schrift ein rechtsbündiges 
+Verzeichnis erhalten kann. 
+ 
+Es gibt die Möglichkeit, bis zu neun unterschiedliche Indexdateien zu er- 
+stellen, z.B. durch 
+ 
+     \#ib (1)\# und \#ie (1)\# 
+ 
+gekennzeichnete Worte gehen in die Indexdatei mit der Nummer 1, durch 
+ 
+     \#ib (9)\# und \#ie (9)\# 
+ 
+gekennzeichnete Worte gehen in die Indexdatei mit der Nummer 9. Als Erleich- 
+terung für diejenigen, die nur einen Index erstellen müssen, dürfen die 'ib'- 
+und 'ie'-Anweisungen ohne Parameter benutzt werden, welches gleichbedeutend 
+ist mit 'ib(1)' und 'ie(1)'. 
+ 
+Die durch 'ib'- und 'ie'-Anweisungen gekennzeichneten Worte können auch über 
+Zeilengrenzen (mit Silbentrennungen) gehen. Beispiel: 
+ 
+     .... \#ib\#schöne Index-An- 
+     weisungen\#ie\# ... 
+ 
+'index' zieht getrennte Worte zusammen (hier: 'schöne Index-Anweisungen'). 
+Will man einige Worte in verschiedenen Indexdateien haben, darf man die 'ib'- 
+und 'ie'-Anweisungen auch "schachteln". Dies kann man besonders bei Kapitel- 
+überschriften nutzen. Beispiel (vergl. auch die Überschrift dieses Ab- 
+schnitts): 
+ 
+     \#ib(9)\#Worte kennzeichnen: '\#ib\#ib\#ie\#'/'\#ib\#ie\#ie\#'\#ie(9)\# 
+ 
+In diesem Beispiel wird das Inhaltsverzeichnis in die Indexdatei '9' ge- 
+bracht, während der "allgemeine" Index in der Indexdatei '1' gesammelt wird. 
+ 
+ 
+ 
+Nebeneinträge erzeugen 
+ 
+Es ist möglich, an die Seitennummer eines Eintrags einen beliebigen Text 
+anfügen zu lassen. Beispiele: 
+ 
+  EUMEL-System ... 27ff. 
+  Monitor ........ 13(Def.) 
+  EUMEL-Editor ... 2(Kap.4) 
+ 
+Dies wird durch die generische Form der 'ib'-Anweisung ermöglicht: 
+ 
+  ... der \#ib(1,"(Kap.4)")\#EUMEL-Editor\#ie\# ist gut geeignet, 
+  Texte zu erstellen ... 
+ 
+(erzeugt den letzten obigen Eintrag). 
+ 
+An einen Eintrag kann ein weiterer TEXT angefügt werden, um etwa Unterein- 
+träge zu bilden: 
+ 
+  EUMEL-System .............. 27 
+  EUMEL-System, kapitales ... 28 
+  EUMEL-System, schönes ..... 29 
+ 
+Das wird ebenfalls durch eine andere Form der 'ie'-Anweisung ermöglicht: 
+ 
+  ... ist das \#ib\#EUMEL-System\#ie(1,", schönes")\# wirklich ein
+  schönes System ... 
+ 
+(erzeugt den letzten obigen Eintrag). 
+ 
+Nach der Erstellung einer Indexdatei können - nach interaktiver Anfrage - die 
+Einträge sortiert werden. Die Sortierung erfolgt alphabetisch nach DIN 5007, 
+Abschnitt 1 und 3.2 (Umlaute werden "richtig" eingeordnet). 
+ 
+Wie bereits erwähnt, kann 'index' vielseitig eingesetzt werden: 
+ 
+a) Erstellung von Stichwortverzeichnissen: 
+   Wie bereits beschrieben. 
+ 
+b) Erstellung von Inhaltsverzeichnissen: 
+   Kapitelüberschriften mit eigenen Indexanweisungen klammern und durch 
+   'index' wie beschrieben verarbeiten. Beispiel: 
+ 
+      \#ib(8)\#9.1.3 Das abenteuerliche Leben von Micky Maus unter 
+      besonderer Berücksichtigung seiner Geburtsstadt Entenhausen\#ie(8)\# 
+ 
+   Dann ist man sicher, daß das Inhaltsverzeichnis bezüglich Seitennummern 
+   und Kapitelüberschriften korrekt ist. 
+ 
+c) Erstellung von Abbildungsverzeichnissen: 
+   Abbildungsüber- bzw. -unterschriften wie Inhaltsverzeichnisse verarbeiten. 
+ 
+d) Überprüfung von Literaturhinweisen auf Vollständigkeit: 
+   Man klammert alle Literaturhinweise mit extra Indexanweisungen (Beispiel: 
+   \#ib(9)\#/Meier82/\#ie(9)\#) und überprüft dann mit Hilfe dieser Indexdatei 
+   die Literaturverweise. Dann ist man sicher, daß alle Literaturverweise im 
+   Text auch in der Literaturaufstellung stehen. 
+ 
+ 
+ 
+Indexdateien zusammenführen: 'index merge' 
+ 
+Durch das Programm 'index merge' kann eine Indexdatei in eine zweite "einge- 
+mischt" werden. Es ist somit möglich, einen Index zu erstellen, der sich über 
+mehrere Dateien erstreckt, indem man 'index' die Druckdateien dieser Dateien 
+bearbeiten läßt und anschließend die entstandenen Indexdateien mit 'index 
+merge ' zusammenfaßt. Indexdateien können ggf. mit dem Editor bzw. 'lineform' 
+und/ oder 'pageform' bearbeitet und anschließend gedruckt werden. Beispiel: 
+ 
+     index merge ("1.kapitel.i1", "2.kapitel.i1") 
+ 
+Hier wird die Indexdatei des '1.kapitel' in die Indexdatei des '2.kapitel' 
+eingeordnet und auf Wunsch sortiert. 
+ 
+Beachte, daß 'index' und 'index merge' Kommandos und keine Anweisungen sind. 
+ 
+Merke: 'index' verarbeitet eine Druckdatei (Zusatz: ".p") und erzeugt eine 
+oder mehrere Indexdateien (Zusatz: ".i<nummer>"). Die in einen Index zu 
+übernehmenden Worte müssen im Text durch die 'ib'- und 'ie'-Anweisungen 
+eingefaßt sein. 
+ 
+ 
+ 
+5. Drucken: 'print' 
+ 
+Der EUMEL-Drucker, der mit dem Kommando 'print' angesprochen wird, ist eine 
+Software-Schnittstelle zu einem angeschlossenem Drucker. In diesem Kapitel 
+wird erklärt, wie man mit dem EUMEL-Drucker eine Datei druckt und welche 
+speziellen Anweisungen den Drucker steuern. 
+ 
+Jeder Drucker erbringt "hardwaremäßig" unterschiedliche Leistungen (z.B. 
+Randausgleich, Unterstreichung). Diese Leistungen werden durch Eingabe 
+spezieller Zeichenfolgen veranlaßt, die zwar genormt sind, aber von den Druk- 
+kerherstellern nicht eingehalten werden oder unterschiedlich interpretiert 
+werden. 
+ 
+Um vom EUMEL-System unterschiedliche Drucker auf gleiche Weise ansprechen 
+zu können, wurde eine Software-Schnittstelle geschaffen, die EUMEL-Drucker 
+genannt wird. Der EUMEL-Drucker akzeptiert eine Datei und veranlaßt, daß 
+diese in geeigneter Weise gedruckt wird. Weiterhin beachtet der EUMEL- 
+Drucker die Anweisungen der Textkosmetik. Die Form der Anweisungen der 
+Textkosmetik und des EUMEL-Druckers sind gleich. 
+ 
+ 
+ 
+Eine Datei drucken: 'print'-Kommando 
+ 
+Mit dem Kommando 
+ 
+      print 
+ 
+kann dem EUMEL-Drucker eine Datei zum Drucken übergeben werden. Beispiel: 
+ 
+      print ("Drucker Beschreibung") 
+ 
+In der Regel ist im EUMEL-System (Multi-User) ein "Spooler" installiert, so 
+daß sofort mit der Arbeit fortgefahren werden kann. Der EUMEL-Drucker ar- 
+beitet in diesem Fall parallel zu anderen Arbeiten des Nutzers. 
+ 
+ 
+ 
+Anweisungen für den EUMEL-Drucker 
+ 
+Ein Text (eine Datei) kann vom Drucker auch ohne Anweisungen gedruckt 
+werden, etwa für Probedrucke. Für diesen Fall hat der Drucker vernünftige 
+Voreinstellungen. Für einen "normalen" Text braucht ein Benutzer keine spe- 
+ziellen Druckeranweisungen in den zu druckenden Text einzufügen, denn die 
+Anweisungen für die Textkosmetik reichen zur Druckersteuerung aus. Nur wenn 
+besondere Leistungen verlangt werden, wie z.B. Blocksatz oder den gedruckten 
+Text an eine bestimmte Stelle zu plazieren, sind Druckeranweisungen notwen- 
+dig. 
+ 
+Werden vom Drucker Leistungen verlangt, die hardwaremäßig nicht vorhanden 
+sind, so sorgt der EUMEL-Drucker dafür, daß eine möglichst äquivalente 
+Leistung erbracht wird. Wird beispielsweise ein nicht vorhandener Schrifttyp 
+angefordert, wird mit dem Standard-Schrifttyp der jeweiligen Installation 
+gedruckt. 
+ 
+Damit ist es möglich, einen Text auf einem Drucker zu drucken, der den ge- 
+forderten Typ nicht kennt und der eigentlich für einen anderen Drucker 
+bestimmt ist. 
+ 
+Wie bereits erwähnt, beachtet der EUMEL-Drucker die gleichen Anweisungen wie 
+die Textkosmetik-Programme. Eine 'type'-Anweisung beispielsweise, welches 
+einen bestimmten Schrifttyp anfordert, wird also auch vom EUMEL-Drucker als 
+Befehlsfolge an den angeschlossenen Hardware-Drucker übergeben (sofern der 
+Schrifttyp auf dem Drucker realisierbar ist). Wie die Anweisungen ge- 
+schrieben werden müssen, wird in der Beschreibung der Textkosmetik ge- 
+schildert. 
+ 
+Anweisungen werden nicht gedruckt. Besteht eine Zeile nur aus Anweisungen, 
+so wird diese Zeile vom EUMEL-Drucker nicht gedruckt. Im Gegensatz zu den 
+Programmen der Textkosmetik werden unbekannte oder fehlerhafte Anweisungen 
+vom EUMEL-Drucker ohne Fehlermeldung "verschluckt". Alle Anweisungen werden 
+zum frühest möglichen Zeitpunkt ausgeführt, haben also u.U. bereits Aus- 
+wirkungen auf die Zeile, in der sie stehen. 
+ 
+Einige Anweisungen sind speziell nur für den EUMEL-Drucker vorhanden. 
+Diese werden in diesem Kapitel erklärt bzw. werden in der Anweisungs-Über- 
+sicht mit aufgeführt. 
+ 
+Neben den "normalen" Anweisungen, die nur in "\#"-Zeichen eingeschlossen 
+werden, gibt es noch zwei andere Formen: 
+ 
+a) Kommentar-Anweisungen: 
+   Werden in "\#-" und "\#"-Zeichen eingeschlossen. Solche Anweisungen 
+   werden ignoriert. Beispiel: 
+ 
+        \#---- Ende der Seite 1 ---\# 
+ 
+b) Spezielle Druckeranweisungen: 
+   Werden in "\#/" und "\#"-Zeichen eingefaßt. Die von diesen Anweisungs- 
+   Zeichen eingeschlossenen Druckerbefehlen werden unverändert (ohne die 
+   "\#/" und "\#"-Zeichen) an den Drucker weitergereicht. Beispiel: 
+ 
+        \#/C05\#                    (* C05 geht an den Drucker *) 
+ 
+   Solche Anweisungen werden manchmal benötigt, um spezielle Druckereigen- 
+   schaften auszunutzen, die schwer oder garnicht im EUMEL-Drucker reali- 
+   sierbar sind. 
+ 
+Anmerkung: Diese Anweisungen werden, wie die normalen Anweisungen auch, bei 
+der Berechnung einer Zeile nicht berücksichtigt und nicht gedruckt. 
+ 
+Merke: Der EUMEL-Drucker übernimmt die Anpassung an spezielle Hardware- 
+Drucker. Er beachtet die gleichen Anweisungen wie die Textkosmetik-Programme. 
+Zusätzlich gibt es noch einige wenige spezielle Druckeranweisungen. 
+ 
+ 
+ 
+Blocksatz drucken: 'block' 
+ 
+Die Anweisung 'block' bewirkt einen Blocksatz beim Druck. 
+ 
+Fügt man in den Text (meist am Anfang einer Datei) die Anweisung 
+ 
+     \#block\# 
+ 
+ein, druckt der Drucker ab dieser Stelle alle Zeilen, die nicht mit einem 
+Absatzkennzeichen versehen sind, im Blocksatz. Dies heißt, daß durch Ver- 
+größern der Wortabstände alle Zeilen an der gleichen Position enden (rechter 
+Randausgleich). Preiswerte Drucker können dies nur durch Einfügen ganzer 
+Leerzeichen zwischen den Worten vornehmen, was sich oft beim Lesen störend 
+bemerkbar macht. Bei qualitativ hochwertigen Druckern wird dagegen der 
+Blocksatz durch Einfügen kleinerer Abstände zwischen den Worten oder sogar 
+zwischen den Zeichen erreicht. 
+ 
+Merke: Die Anweisung 'block' bewirkt den Blocksatz beim Druck. 
+ 
+ 
+Schreibfeld verschieben: 'start' 
+ 
+Durch die Anweisung 'start' ist es möglich, das Schreibfeld beim Druck auf 
+dem Papier an eine andere Stelle zu plazieren. 
+ 
+Der EUMEL-Drucker plaziert das Schreibfeld auf einem Drucker automatisch der- 
+art, daß ein genügender Rand verbleibt. Diese Voreinstellung ist natürlich 
+abhängig vom Drucker und der Installation. Mit der 'start'-Anweisung kann 
+die automatische Einstellung verändert werden. Beispiel: 
+ 
+     \#start (1.0, 2.0)\# 
+ 
+legt die linke, obere Ecke des Schreibfeldes fest (vom linken Rand 1 cm, vom 
+oberen Rand 2 cm). 
+ 
+Merke: Die 'start'-Anweisung legt den linken oberen Rand des Schreibfeldes 
+fest. 
+ 
+ 
+ 
+Zentrieren 
+ 
+Mit dem '#ib#center#ie#'-Kommando kann man eine Zeile in der Mitte der Zeile 
+drucken lassen. 
+ 
+Das 'center'-Kommando zentriert die Schrift einer Zeile. Beispiel: 
+ 
+\#center\#Diese Zeile ist zentriert 
+ 
+Dies Kommando ist nur bei Proportionalschriften sinnvoll einzusetzen, da man 
+bei einer äquidistanten Schrift man direkt auf dem Bildschirm sehen kann, 
+wie der Text auf einer Zeile plaziert ist. 
+ 
+Merke: 'center' zentriert eine Zeile beim Drucken. 
+ 
+ 
+ 
+6. Textkosmetik-Makros 
+ 
+Makros dienen als Abkürzung für immer wiederkehrende Textteile und/oder 
+Kommandos. 
+ 
+Textkosmetik-Makros kommen zum Einsatz bei 
+ 
+- immer wiederkehrenden Textteilen; 
+ 
+- immer wiederkehrenden Anweisungssequenzen; 
+ 
+- bei der Erstellung von Manuskripten, deren endgültige Form man anfänglich 
+  noch nicht weiß oder die man noch ändern will. 
+ 
+Die Definition von einem oder mehreren Makros wird mit dem Editor vorgenom- 
+men. Diese Makro-Datei wird dann geladen. Von diesem Augenblick an "kennen" 
+'lineform'/'autoform' und 'pageform' die Makros (d.h. die Textzeilen und/ 
+oder Anweisungen, die sich unter dem dem Makronamen "verbergen"). 
+ 
+'lineform'/'autoform' beachten die Anweisungen, die in den Makros enthalten 
+sind. Man beachte, daß die Anweisungen und Textzeilen, die in den Makros ent- 
+halten sind, nicht in der Datei erscheinen. Erst 'pageform' setzt diese in 
+die Druckdatei ein. 
+ 
+ 
+Ein Beispiel 
+ 
+Hier wird ein einfaches Beispiel für einen Briefkopf gezeigt. 
+ 
+Angenommen, die Firma 'Meier' schreibt mit dem EUMEL-System ihre Geschäfts- 
+briefe. Sie hat einen Drucker zur Verfügung, mit dem man auch die Briefköpfe 
+erstellen kann. Für den Briefkopf schreibt die Junior-Chefin ein Makro'kopf' 
+in eine Datei 'macro definitionen': 
+ 
+  \#*kopf\# 
+  \#type("fett und gross")\#  Firma Meier 
+  \#type("fett")\#            Gemischtwaren in kleinen Mengen 
+  \#type("klein")\#           Straße 
+                            Stadt 
+  \#type ("normal")\# 
+  \#*macro end\# 
+ 
+Der Name des Makros ist 'kopf'. Man beachte, daß eine Makro-Definition mit 
+dem Namen des Makros beginnen müssen. Der Makroname muß mit einem '*' 
+gekennzeichnet werden, um ihn von "normalen" Text-Anweisungen unterscheiden 
+zu können. Jedes Makro wird mit einer 'macro end'-Anweisung beendet 
+(es dürfen mehrere Makros hintereinander in die Datei geschrieben werden). 
+ 
+Nun muß die Junior-Chefin das so definierte Makro 'laden': 
+ 
+   load macros ("macro defintionen") 
+ 
+Zur Kontrolle kann sie sich die "geladenen" Makros in einen Datei ausgeben 
+lassen: 
+ 
+   list macros ("kontroll datei") 
+ 
+Nun kann die Junior-Chefin ihrem Sekretär sagen, daß er von jetzt ab ein 
+neues Kommando zur Verfügung hat, welches einen Briefkopf in jeden Brief 
+drucken kann (mit dem Namen 'kopf'). Der Sekretär schreibt also nun 
+folgenden Brief: 
+ 
+\#kopf\# 
+ 
+Sehr geehrte Frau .... 
+usw. 
+ 
+Nachdem er mit 'lineform' den Brief zeilenweise formatiert hat, kontrolliert 
+er die formatierte Datei. Hier hat sich noch nichts verändert, die neue An- 
+weisung 'kopf' steht unverändert in der Datei. ('lineform' beachtet zwar 
+alle Anweisungen und Textzeilen eines Makros, setzt diese jedoch nicht in 
+die Datei ein). 
+ 
+Nun formatiert der Sekretär die Datei, welche den Brief enthält, mit 'page- 
+form'. In der Druckdatei ist nun die Anweisung 'kopf' verschwunden, dafür 
+stehen aber nun die Zeilen des Makrorumpfes ('pageform' setzt die Zeilen des 
+Makros in die Druckdatei ein): 
+ 
+  \#type("fett und gross")\#  Firma Meier 
+  \#type("fett")\#            Gemischtwaren in kleinen Mengen 
+  \#type("klein")\#           Straße 
+                            Stadt 
+  \#type ("normal")\# 
+ 
+ 
+  Sehr geehrte Frau ... 
+  usw. 
+ 
+Merke: Makros sind bei der Verwendung von wenigen Text- und/oder Anweisungs- 
+folgen nützlich, die immer in der gleichen Form benötigt werden. 
+ 
+ 
+Ein Beispiel mit Makro-Parametern 
+ 
+Unsere Junior-Chefin fällt nun auf, daß sie ihr Makro noch etwas verbessern 
+kann. Sie will noch das Datum mit in den Briefkopf aufnehmen. Somit editiert 
+sie ihre Makro-Datei folgendermaßen (man beachte die '$'-Zeichen): 
+ 
+  \#*kopf ($1)\# 
+  \#type("fett und gross")\#  Firma Meier 
+  \#type("fett")\#            Gemischtwaren in kleinen Mengen 
+  \#type("klein")\#           Straße 
+                            Stadtname 
+  \#type ("normal")\# 
+ 
+                                        Stadtname, den $1 
+  \#*macro end\# 
+ 
+Damit hat sie dem 'kopf'-Makro einem Parameter gegeben ('$1'; die Parameter 
+werden numeriert. Ein zweiter Parameter würde '$2' heißen usw.). 
+ 
+Der Sekretär muß nun die Anweisung 'kopf' mit dem jeweiligen Datum in einen 
+Brief schreiben: 
+ 
+   \#kopf ("9.1.1984")\# 
+ 
+'pageform' setzt nun das angegebene Datum direkt hinter 'Stadtname, den' in 
+den Briefkopf ein (in der Druckdatei). Beachte, daß nur TEXT-Denoter als 
+aktuelle Parameter eines Makros erlaubt sind. 
+ 
+Merke: Durch die Makro-Parameter ist es also möglich, immer wiederkehrende 
+Textteile in Schriftstücke einsetzen zu lassen, die sich nur in Kleinigkei- 
+ten unterscheiden. 
+ 
+ 
+Ein Beispiel für Manuskripte 
+ 
+Hier wird gezeigt, wie man mit Makros Anweisungen formulieren kann, die aus- 
+sagen, um was es sich bei einem Text handelt und nicht, wie es behandelt 
+werden soll. 
+ 
+Bei Manuskripten für Artikel, Bücher und Manuals weiß ein Autor oft vorher 
+nicht, in welchem Format das Manuskript gedruckt werden wird. Zu diesem 
+Zweck ist es ebenfalls nützlich, die Makros zu verwenden. Beispiel: 
+ 
+   \#*kapitel anfang ($1)\# 
+   \#free (2.0)\# 
+   \#type ("gross und fett")\#\#ib (9)\#$1\#ie (9)\#\#type ("normal")\# 
+ 
+   \#*macro end\# 
+ 
+In diesem Beispiel wird ein Makro für den Anfang eines Kapitels definiert. 
+Zwischen zwei Kapiteln soll hier zwei cm Zwischenraum bleiben, die Kapitel- 
+Überschrift (als Parameter) wird in einer grösseren Schrift gedruckt. Zu- 
+sätzlich wird die Überschrift in den 9. Index aufgenommen für ein Inhalts- 
+verzeichnis. Nach der Überschrift wird eine Leerzeile eingeschoben, bevor 
+der "richtige" Text anfängt. 
+ 
+Ein(e) Anwender(in) dieses Makros schreibt also z.B. folgende Anweisung: 
+ 
+   \#kapitel anfang ("Ein Beispiel fuer Manuskripte")\# 
+ 
+(Beachte, daß die Kapitel-Überschrift nicht länger als eine Textzeile sein 
+darf. Das liegt daran, das 'lineform'/'autoform' zwar die Zeile bearbeitet, 
+aber nicht in den Text einsetzt. 'pageform' setzt also die unveränderte 
+-  nicht aufgebrochene Textzeile - ein). 
+ 
+Man kann nun Makros für die meisten Textstrukturen definieren. Schreibkräfte 
+brauchen dann in der Regel die meisten der Text-Anweisungen nicht zu kennen, 
+sondern nur noch eine Anzahl von einfachen Makro-Anweisungen. 
+ 
+Die Makro-Definitionen können jederzeit geändert werden, um wechselnden 
+Bedürfnissen angepaßt zu werden (z.B. wenn ein Verlag ein bestimmtes 
+Schreibformat verbindlich vorschreibt). In diesem Fall brauchen nicht alle 
+Text-Dateien geändert zu werden, sondern nur die Makro-Definitionen. 
+ 
+Ein weiterer Vorteil einer solchen Vorgehensweise ist, daß die Makro-Anwei- 
+sungen in diesem Fall angeben, was eine bestimmte Text-Struktur ist, und 
+nicht, wie die Struktur behandelt werden soll. 
+ 
+Anmerkung: 
+In eine Makro-Definition sollte man ggf. 'limit'-, 'type'- und 'linefeed'- 
+Angaben einsetzen, um die Makros unabhängig von der Aufrufstelle zu machen. 
+Ggf. sollte man die Datei vorher mit 'lineform' bearbeiten, um Trennungen 
+vorzunehmen. 
+ 
+Merke: Makros dienen zur flexiblen Behandlung von Text-Strukturen, indem 
+Makros definiert werden, die angeben, um was es sich dabei handelt. 
+ 
+ 
+ 
+Beschreibung der Makro-Kommandos 
+ 
+Mit dem Kommando 
+ 
+   load macros ("macro datei") 
+ 
+kann eine Datei, in denen die Makro-Definitionen enthalten sind, in den 
+Makro-Speicher des Textsystems geladen werden. Ist dies fehlerfrei erfolgt, 
+kann man 'lineform'/'autoform' Dateien übergeben, die die definierten Makro- 
+Anweisungen "kennen" und befolgen. 'pageform' setzt bei Antreffen einer 
+Makro-Anweisung den Makrorumpf in die Ausgabe-Datei ein. 
+ 
+Die Definition eines Makros erfolgt mit dem Makronamen, der von Anweisungs- 
+zeichen eingeschlossen ist. Um Makro-Anweisungen von "normalen" Textkosmetik- 
+Anweisungen zu unterscheiden, müssen diese nach dem ersten Anweisungszeichen 
+mit einem '*' gekennzeichnet werden. Beispiel: 
+ 
+   \#*macro eins\# 
+   Makrorumpf mit "normalen" Kommandos, wie z.B. 
+      \#type ("x")\# 
+   \#*macro end\# 
+ 
+Der Aufruf eines Makros, welcher z.B. in einer von 'lineform' zu bearbeiten- 
+den Datei steht, unterscheidet sich nicht von einer "normalen" Textanweisung. 
+Beispiel: 
+ 
+   ... \#macro eins\# ... 
+ 
+Hat das Makro Parameter (bei der Definition mit '$'-Zeichen durchnumeriert), 
+müssen beim Aufruf TEXT-Parameter eingesetzt werden (also in Anführungs- 
+strichen). Beispiel: 
+ 
+   \#*macro zwei ($1)\# 
+   ... $1 ... 
+   \#*macro end\# 
+ 
+   (* Aufruf: *) 
+ 
+   \#macro zwei ("ein einzusetzender Text")\# 
+ 
+Anmerkung: 
+Bei Makros gibt es keine generischen Anweisungen. Makros, die gleiche Namen 
+haben, aber sich durch die Anzahl der Parameter unterscheiden, sind also 
+nicht erlaubt. 
+ 
+Beachten Sie ferner, daß Makro-Texte so verwendet werden, wie diese mit 
+'load macros' geladen werden. Beispiel: 
+ 
+   \#*a\# 
+   \#on("underline")\# 
+   \#*macro end\# 
+ 
+   \#*b\# 
+   \#off("underline")\# 
+   \#*macro end\# 
+ 
+Betätigt man in der Makro-Datei nach jeder Zeile die RETURN-Taste (Absatz), 
+dann erhält man bei folgender Verwendung Fehlermeldungen von 'lineform': 
+ 
+    ... \#a\#zu unterstreichender Text\#b\# ... 
+ 
+weil hier Mitten im Satz Absätze erscheinen und 'lineform' bei jedem Absatz 
+prüft, ob noch Modifikationen "offen" sind. In solchen Anwendungen sollte 
+man also Makros ohne Absätze speichern. 
+ 
+ 
+ 
+7. Anweisungs-Übersicht 
+ 
+* block 
+  Zweck: Blocksatz (rechter Randausgleich). Der Text einer Zeile wird durch 
+         Vergrößern der Wortlücken auf die Zeilenlänge, die durch das 
+         'limit'-Kommando eingestellt ist, verlängert. Es gelten folgende 
+         Bedingungen: 
+         a) Leerzeichen werden nicht verbreitert bei 
+            - Zeilen mit Absatzzeichen; 
+            - Mehrfache Leerzeichen; 
+            - führende Leerzeichen (Einrückung); 
+            - ein Leerzeichen hinter dem ersten Wort einer Zeile, wenn es auf 
+              die Zeichen "]", ")", ".", "-", ":" endet. 
+         b) Einrückungen werden äquidistant berechnet (Anzahl Zeichen * 
+            Breite eines "Standard-Blanks"). Dies gilt nur für Proportional- 
+            schriften und vor einer Absatzzeile. Es gilt als Einrückung: 
+            - "Spiegelstrich" (Bindestrich und Leerzeichen am Anfang der 
+              Zeile); 
+            - Doppelpunkt als Ende des ersten Wortes (Position < 20); 
+            - Schliessende Klammer oder Punkt als Ende des ersten Wortes, 
+              wenn eine Ziffer davor steht (Position < 7); 
+         c) Tabellen werden auch äquidistant berechnet. Dies gilt ebenfalls 
+            nur für Proportionalschriften und vor einer Absatzzeile. Es gilt 
+            als Teil einer Tabelle: 
+            - Position des letzten Mehrfachblank. 
+ 
+* bottom 
+  Zweck: Erzeugen von "Fußzeilen" am Ende jeder Seite in der Druckdatei für 
+         Untertitel und Seitennummern. Die Textzeilen zwischen den Anwei- 
+         sungen 'bottom' und 'end' werden von 'pageform' am Ende jeder Seite 
+         eingesetzt. 
+ 
+* bottom even 
+  Zweck: Definition von Fußzeilen für Seiten mit geraden Seitennummern. Es 
+         gilt das unter 'bottom' gesagte. 
+ 
+* bottom odd 
+  Zweck: Definition von Fußzeilen für Seiten mit ungeraden Seitennummern. Es 
+         gilt das bei 'bottom' gesagte. 
+ 
+* center 
+  Zweck: Zentrieren einer Zeile (Absatzzeile). 
+ 
+* columns (INT CONST anzahl, REAL CONST luecke) 
+  Zweck: Einschalten der Spaltenformatierung. 
+ 
+* columnsend 
+  Zweck: Ausschalten der Spaltenformatierung. 
+ 
+* count 
+  Zweck: Erhöhung eines internen Zählers und Einsetzen des Wertes anstatt 
+         der Anweisung in die Druckdatei. 
+ 
+* count (TEXT CONST merkmal) 
+  Zweck: Wie obiges 'count', jedoch wird der Wert des Zählers vermerkt, so 
+         daß er mit 'value' wieder erfragt werden kann. 
+ 
+* end 
+  Zweck: Beendet die Defintion von 'head', 'bottom' oder Fußnotenbereichen. 
+ 
+* foot 
+  Zweck: Definieren von Fußnoten. Es werden die aktuellen Werte von 'limit', 
+         'linefeed' und 'type' für die Fußnote verwendet (vergl. 'bottom'- 
+         Anweisung). 
+ 
+* free (REAL CONST freier platz) 
+  Zweck: Es werden 'freier platz' cm freigehalten. 
+ 
+* goalpage (TEXT CONST merkmal) 
+  Zweck: (Ziel-) Verweis für Seitenquerverweise in Verbindung mit der Anwei- 
+         sung 'topage'. 'merkmal' muß mit dem Parameter des entsprechenden 
+         'topage' übereinstimmen. 
+ 
+* head 
+  Zweck: Definieren von Kopfzeilen, die von 'pageform' am Anfang jeder Seite 
+         eingefügt werden. Es gilt das unter 'bottom' gesagte. 
+ 
+* head even 
+  Zweck: Definieren von Kopfzeilen für Seiten mit geraden Seitennummern. Es 
+         gilt das unter 'bottom' gesagte. 
+ 
+* head odd 
+  Zweck: Definieren von Kopfzeilen für Seiten mit ungeraden Seitennummern. 
+         Es gilt das unter 'bottom' gesagte. 
+ 
+* ib 
+  Zweck: Arbeitet wie 'ib (1)', man darf aber den Parameter weglassen. 
+ 
+* ib (INT CONST index nummer) 
+  Zweck: Indexanfang einer oder mehrerer Indexworte bis zur entsprechenden 
+         'ie'-Anweisung. Die Worte zwischen 'ib' und 'ie' werden in die 
+         Indexdatei geschrieben. 'index nummer' gibt die Indexdatei an. 
+ 
+* ib (INT CONST index nummer, TEXT CONST seitennummer zusatz) 
+  Zweck: Indexanfang mit Zusatztext für die Seitennummer. Das oben gesagte 
+         gilt entsprechend. 'seitennummer zusatz' wird unmittelbar hinter 
+         die Seitennummer angefügt. 'seitennummer zusatz' muß in jeder 'ib'- 
+         Anweisung neu gesetzt werden. 
+ 
+* ie 
+  Zweck: Arbeitet wie 'ie (1)', man darf aber den Parameter weglassen. 
+ 
+* ie (INT CONST index nummer) 
+  Zweck: Abschluß eines Index. Ein Index darf nicht über Absatz- und Seiten- 
+         grenzen gehen. Ein Index über mehr als zwei Zeilen ist ebenfalls 
+         aus Sicherheitsgründen (vergessene Abschlußanweisung) nicht erlaubt. 
+         
+* ie (INT CONST index nummer, TEXT CONST index zusatz) 
+  Zweck: Es wird 'index zusatz' an die durch die Index-Anweisungen einge- 
+         faßten Worte angefügt. Beispiel: 
+ 
+            \#ib (1)\#EUMEL-System\#ie(1, ", kapitales")\# ist 
+            schön. 
+ 
+         Erscheint als 'EUMEL-System, kapitales ... 4' in der Indexdatei. 
+         Diese Anweisung dient also dazu, auch Sub-Indizes zu ermöglichen. 
+ 
+* limit (REAL CONST wert) 
+  Zweck: Einstellen einer neuen Zeilenbreite in cm. Die Zeilenbreite gilt 
+         solange, bis sie durch ein erneute 'limit'-Anweisung verändert wird. 
+ 
+* linefeed (REAL CONST wert) 
+  Zweck: Einstellen eines neuen Zeilenvorschubs in Abhängigkeit vom einge- 
+         stellten Schrifttyp. 
+ 
+* material (TEXT CONST mat) 
+  Zweck: Angabe von installationsspezifischen Merkmalen für den Drucker. 
+ 
+* off (TEXT CONST modification) 
+  Zweck: Abschalten einer Modifikation. 
+ 
+* on (TEXT CONST modification) 
+  Zweck: Einschalten einer Modifikation. Folgende Modifikationen sind zur 
+         Zeit möglich: 
+              bold        (Fettdruck) 
+              italic      (Kursivdruck) 
+              underline   (Unterstreichung) 
+              revers      (Weiß auf Schwarz) 
+ 
+* page 
+  Zweck: Anfang einer neuen Seite. 'page' muß als letztes auf einer Zeile 
+         stehen. 
+ 
+* page (INT CONST nr) 
+  Zweck: Anfang einer neuen Seite mit 'nr' Seitennummer. 
+ 
+* page length (REAL CONST cm) 
+  Zweck: Einstellen der Seitenlänge in cm. 
+ 
+* page nr (TEXT CONST seitennr zeichen, start) 
+  Zweck: Einstellen eines neuen Seitennr-Zeichens und Anfangwerts bzw. 
+         setzen der Seitennummer des bereits vorhandenen Seitenzeichens 
+         ("%"). Neben dem vorhandenen "%"-Zeichen können zwei zusätzliche 
+         (beliebige, aber von den "\#"-Zeichen unterschiedliche) Seiten- 
+         zeichen definiert werden. 
+ 
+* papersize (REAL CONST width, length) 
+  Zweck: Angabe der Papiergröße des Druckers in cm. 
+ 
+* print (INT CONST von, bis) 
+  Zweck: Teilausdruck einer Datei. Der Drucker verarbeitet die Datei, bis er 
+         an die Seite 'von' angelangt ist. Dann druckt er die Seiten bis 
+         einschließlich 'bis'. Beachte, daß der EUMEL-Drucker die Seiten 
+         immer ab 1 durchzählt (und eine eventuelle Seitennumerierung nicht 
+         beachtet). 
+ 
+* start (REAL CONST x, y) 
+  Zweck: Legt den linken, oberen Eckpunkt des Schreibfeldes fest. Die 
+         Angaben erfolgen in cm. 
+ 
+* topage (TEXT CONST merkmal) 
+  Zweck: Verweis auf eine Seite mit der Anweisung 'goalpage' und dem 
+         gleichen 'merkmal'. Für 'topage' wird die Seitennummer von 
+         'goalpage' eingesetzt. 
+ 
+* type (TEXT CONST schrifttyp name) 
+  Zweck: Einstellen eines anderen Schrifttyps. Die verfügbaren Schriftarten 
+         und deren Namen sind installationsspezifisch und deshalb hier nicht 
+         beschrieben. 
+ 
+* value 
+  Zweck: Einsetzen des letzten 'count' Wertes. 
+ 
+* value (TEXT CONST merkmal) 
+  Zweck: Erfragen des mit 'count' gespeicherten Zählerwertes für 'merkmal' 
+         und Einsetzen dieses Wertes durch 'pageform' in die Druckdatei. 
+ 
+ 
+ 
+7. Kommando-Übersicht 
+ 
+autoform 
+    PROC autoform 
+    Zweck: Aufruf von 'autoform' unter Verwendung des letzten eingestellten 
+           Dateinamens. 
+ 
+    PROC autoform (TEXT CONST datei) 
+    Zweck: 'lineform' mit automatischer Silbentrennung. Nur die vorgenomme- 
+           nen Trennungen werden auf dem Bildschirm angezeigt. 
+ 
+    PROC autoform  (FILE VAR f, TEXT CONST type name, REAL CONST width) 
+    Zweck: Wie oben, jedoch auf einer Datei. 
+ 
+index 
+    PROC index (TEXT CONST eingabe datei) 
+    Zweck: Erstellen von Indexdateien aus einer Druckdatei wie beschrieben. 
+           Eine Indexdatei erhält den Namen der zu bearbeitenden Datei mit 
+           dem Zusatz ".i" und der entsprechenden Indexnummer. Hat das 
+           Programm 'index' die Druckdatei bearbeitet, werden die in die 
+           Indexdatei geschriebenen Einträge alphabetisch sortiert (nach 
+           Anfrage). Gleiche Einträge werden zusammengezogen: ein gleich- 
+           lautender Eintrag wird entfernt, seine Seitennummer wird jedoch 
+           an den bereits vorhandenen mit einem Komma aggefügt. 
+ 
+           Die Sortierung entspricht DIN 5007: 
+           - Die Sortierreihenfolge enspricht 'ABC...Z', wobei große und 
+             kleine Buchstaben gleich behandelt werden. 
+           - Weitere Entsprechungen: 
+             ö = oe, ä = ae, ü = ue 
+             Ö = Oe, Ü = Ue, Ä = Ae, Ä = ä, Ü = ü, Ö = ö, ß = ss 
+             Dadurch wird z.B. 'muß' vor 'Muster' einsortiert und 'Goethe' 
+             ist gleich 'Göthe'. 
+           - Alle Sonderzeichen (außer " " und "-") werden ignoriert. 
+           - Ein Leerzeichen und ein Bindestrich zwischen Worten werden 
+             gleich behandelt. Beispiel: 
+ 
+             'EUMEL System' und 'EUMEL-System' sind also gleich. 
+ 
+           Es sind z.Z. max. neun unterschiedliche Indexdateien vorgesehen. 
+           Der Name einer Indexdatei ergibt sich aus dem Namen der zu bear- 
+           beitenden Druckdatei, wobei '.p' durch '.i' mit der entsprechen- 
+           den Ziffer ersetzt wird. Beispiel (für Indizes mit 
+           'index nummer' = 1, z.B. \#ib\# ... \#ie\#): 
+ 
+                skript.p  --> skript.i1 
+ 
+index merge 
+    PROC index merge (TEXT CONST von, hinzu) 
+    Zweck: Einmischen der Indizes der Indexdatei 'von' in die Indexdatei 
+           'hinzu'. Beide Indexdateien müssen vorhanden sein. Dabei wird 
+           'von' vor dem ersten Satz von 'hinzu' eingefügt und anschließend 
+           ggf. sortiert. 
+ 
+list macros 
+   PROC list macros (TEXT CONST datei) 
+   Zweck: Ausgabe der "geladenen" Makros in die Datei 'datei'. 'datei' darf 
+          vorher nicht existieren, wird also von 'list macros' eingerichtet. 
+          Die "geladenen" Makros bleiben unberührt. Man kann die mit 'list 
+          macros' in die Datei 'datei' geschriebenen Makro-Definitionen ggf. 
+          verändern und erneut mit 'load macros' laden. 
+   Fehlerfall: 
+      * file already exists 
+        Ausgabe-Datei 'datei' ist bereits vorhanden. 
+ 
+lineform 
+    PROC lineform 
+    Zweck: Der zuletzt verwandte Dateiname wird benutzt. Beispiel: 
+ 
+              edit ("test") 
+              ... 
+              lineform  (* wird zu 'lineform ("test") *) 
+ 
+    PROC lineform (TEXT CONST dateiname) 
+    Zweck: Formatieren einer Datei zeilenweise. 
+ 
+    PROC lineform  (FILE VAR f, TEXT CONST type name, REAL CONST width) 
+    Zweck: Aufruf von 'lineform' von einem Programm. 
+ 
+load macros 
+   PROC load macros (TEXT CONST datei) 
+   Zweck: Lädt Makro-Definitionen in den Makro-Speicher des Textsystems. Die 
+          Definitionen müssen in der Datei 'datei' enthalten sein (mit dem 
+          Editor erstellen). Es können mehrere Definitionen in der Datei ent- 
+          halten sein. Um den Makro-Speicher zu leeren, übergibt man eine 
+          leere 'datei'. 
+ 
+          Eine Makro-Definition besteht aus einem 
+          - Makro-Kopf: 
+            Muß alleine auf einer Zeile stehen. Der Makro-Kopf fängt mit 
+            '\#*'-Zeichen an und wird mit '\#' beendet. Beispiel: \#*ein macro\# 
+            Der Name eines Macros muß (wie alle andern Anweisungen auch) 
+            mit kleinen Buchstaben geschrieben werden. Leerzeichen spielen 
+            keine Rolle. 
+            Eventuelle Parameter müssen in Klammern (bei mehreren durch 
+            Kommata getrennt) und mit einem $-Zeichen numeriert werden. 
+            Beispiel: 
+               \#*macro1 ($1)\# 
+               \#*macro 2 ($1, $2)\# 
+ 
+          - Makro-Rumpf: 
+            Besteht aus beliebig vielen Text-Zeilen, die Kommandos enthalten 
+            können. Parameter (also das $-Zeichen mit anschließender Nummer) 
+            werden bei Aufruf eines Makros ersetzt. In einem Makro-Rumpf 
+            darf keine Makro-Anweisung erscheinen, die noch nicht definiert 
+            wurde (sog. "Vorwärts-Referenzen"). 
+ 
+          - Makro-Ende: 
+            besteht aus der Anweisung 
+               \#*macro end\# 
+            und muß wie der Makro-Kopf alleine auf einer Zeile stehen. 
+ 
+   Fehlerfälle: 
+     * file does not exists 
+       Die Eingabe-Datei 'datei' ist nicht vorhanden. 
+     * macro store overflow (number lines) 
+       Es passen zur Zeit nicht mehr als 1 000 Zeilen in den Makro-Speicher. 
+     * macro store overflow (number macros) 
+       Es passen zur Zeit nicht mehr als 100 Makro-Defintionen in den 
+       Makro-Speicher. 
+ 
+pageform 
+    PROC pageform 
+    Zweck: Wie beschrieben, jedoch ohne Parameter. Die zuletzt benutzte 
+           Datei wird bearbeitet. Für die Druckdatei wird dieser Dateiname, 
+           an den ".p" angehängt wird, eingesetzt. Beispiel: 
+ 
+              edit ("test") 
+              ... 
+              pageform  (* wird zu 'pageform ("test", "test.p")' 
+                           ergaenzt *) 
+ 
+     PROC pageform (TEXT CONST dateiname) 
+     Zweck: Wie beschrieben, wobei der Parameter für die Druckdatei ergänzt 
+            wird (an 'dateiname' wird '.p' angehängt). Beispiel: 
+ 
+               pageform ("test") 
+               (* wird zu 'pageform ("test", "test.p")' ergaenzt *) 
+ 
+     PROC pageform (TEXT CONST dateiname, druckdatei) 
+     Zweck: Wie oben. 
+ 
+print 
+     PROC print (TEXT CONST datei) 
+     Zweck: Druck der Datei 'datei' unter Berücksichtigung von Anweisungen. 
+ 
+
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5
new file mode 100644
index 0000000..d59b147
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5
@@ -0,0 +1,667 @@
+                     EUMEL-Benutzerhandbuch 
+ 
+ 
+                      TEIL 5: ELAN-Compiler                         
+ 
+ 
+Der ELAN-Compiler im EUMEL-System 
+ 
+In diesem Kapitel wird die Benutzung des ELAN-Compilers im EUMEL-System be- 
+schrieben. Es enthält Angaben, welche Einschränkungen bzw. Erweiterungen 
+gegenüber dem Sprachstandard existieren. Eine Einführung in die Programmier- 
+sprache ELAN wird hier nicht gegeben. 
+ 
+ 
+ 
+1. Einführung 
+ 
+Der im EUMEL-System eingesetzte ELAN-Compiler wurde von J. Liedtke und 
+U. Bartling am HRZ Bielefeld in den Jahren 1975/76 erstellt und in den 
+folgenden Jahren erweitert und der Sprachbeschreibung angepaßt. Der gleiche 
+ELAN-Compiler wird auch auf verschiedenen Großrechnern (TR440, IBM, SIEMENS) 
+eingesetzt. 
+ 
+Den ELAN-Compiler kann man sich als aus zwei Teilen bestehend vorstellen. 
+Einmal gibt es den "eigentlichen" ELAN-Compiler, der ein ELAN-Programm in 
+eine Maschinensprache (im EUMEL-System der sogenannte EUMEL0-Code) übersetzt. 
+Zum anderen verwaltet der ELAN-Compiler übersetzte Moduln (in ELAN Packets 
+genannt). 
+ 
+In einem Packet können Prozeduren, Datentypen und/oder Operatoren definiert 
+werden. Ist ein solches Packet vorübersetzt (im EUMEL-System wird dieser 
+Vorgang 'insertieren' genannt), stehen diese Objekte zur Benutzung zur Ver- 
+fügung. Durch Packets kann man somit die Sprache ELAN erweitern. 
+ 
+Weitere Informationen über die Programmiersprache ELAN finden Sie in den 
+folgenden Büchern: 
+ 
+Hommel / Jähnichen / Koster: 
+Methodisches Programmieren 
+W. de Gruyter, Berlin, 1983 
+ 
+Klingen / Liedtke: 
+Programmieren mit ELAN 
+Teubner, Stuttgart, 1983 
+ 
+In der Regel sind in einem EUMEL-System die Standard-Packets bereits in- 
+sertiert (Ausnahmen: Datentypen #ib#VECTOR#ie# und #ib#MATRIX#ie#). Zusätz- 
+lich sind weitere Packets vorübersetzt, die Kommandos zur Verfügung stellen. 
+Welche weiteren Packets insertiert werden, kann jede EUMEL-Installation und 
+jeder Nutzer entscheiden. Somit kann man sein System auf spezielle 
+Anwendungen zuschneiden. 
+ 
+ 
+ 
+2. Übersetzen mit dem ELAN-Compiler 
+ 
+In diesem Abschnitt wird erklärt, wie Programme mit dem ELAN-Compiler über- 
+setzt oder vorübersetzt werden können. 
+ 
+ 
+ 
+Einfaches Übersetzen: 'run'-Kommando 
+ 
+Mit dem 'run'-Kommando kann ein ELAN-Programm übersetzt und ausgeführt 
+werden. 
+ 
+Das 'run'-Kommando (vergl. auch die Kommandos in der Beschreibung des 
+Monitors) übersetzt ein in einer Datei befindliches ELAN-Programm. Beispiel: 
+ 
+     run ("mein programm") 
+ 
+übersetzt das ELAN-Programm, welches in der Datei 'mein programm' enthalten 
+ist. (Wie man ELAN-Programme schreibt, ist u.a. im Editor-Kapitel beschrie- 
+ben). 
+ 
+Der Fortschritt der Übersetzung wird durch laufende Nummern auf dem Bild- 
+schirm des Benutzers angezeigt, die die gerade verarbeiteten Zeilennummern 
+anzeigen. Da der ELAN-Compiler ein Zwei-Paß Compiler ist, werden alle 
+Zeilen (mindestens) zweimal überprüft. 
+ 
+Ist das Programm syntaktisch korrekt, d.h. hat der ELAN-Compiler keine 
+Fehler gefunden, wird eine Ende-Meldung abgesetzt, die den Speicherumfang 
+des übersetzten Programms enthält. Die Ende-Meldung entfällt, wenn die Task 
+an kein Terminal angekoppelt ist. 
+ 
+Nach der Ende-Meldung wird das Programm unmittelbar ausgeführt (ein Binder 
+ist im EUMEL-System nicht notwendig). 
+ 
+Merke: Das Kommando 'run' übersetzt ein in einer Datei befindliches Programm 
+und führt fehlerfreie Programme aus. 
+ 
+ 
+ 
+Korrektur von Fehlern 
+ 
+In diesem Abschnitt wird beschrieben, wie (syntaktische bzw. semantische) 
+Fehler korrigiert werden können. 
+ 
+Entdeckt der ELAN-Compiler Fehler, so meldet er sie dem Benutzer unter An- 
+Angabe der Zeilennummer. Die zwei Pässe des Compilers sind so konstruiert, 
+daß sie unterschiedliche Fehler entdecken. Ist bereits im ersten Paß ein 
+Fehler entdeckt worden, wird der zweite Paß nicht gestartet. Somit kann es 
+vorkommen, daß man glaubt, alle Fehler beseitigt zu haben und dann werden 
+wieder (andere) Fehler durch den zweiten Paß gemeldet ... 
+ 
+Fehlermeldungen und Quelldatei werden nach Abschluß der Übersetzung durch 
+den Paralleleditor angezeigt. Vergl. dazu auch die Beschreibung des Editors. 
+ 
+Merke: Eventuelle Fehler und das zu korrigierende Programm werden durch den 
+Paralleleditor angezeigt. So kann man das fehlerhafte Programm bequem ver- 
+ändern. 
+ 
+ 
+Nochmalige Ausführung eines Programms: 'run again' 
+ 
+Mit 'run again' kann das zuletzt fehlerfrei übersetzte Programm nochmals 
+ausgeführt werden. 
+ 
+Ist ein Programm fehlerfrei übersetzt worden, so kann man es mit dem Komman- 
+do 'run again' (beispielsweise mit anderen Eingabedaten) nochmals ausführen. 
+ 
+Merke: Das Kommando 'run again' führt das zuletzt übersetzte Programm noch- 
+mals aus. 
+ 
+ 
+ 
+Übersetzen von Kommandos 
+ 
+Auch Kommandos werden in der Regel vom ELAN-Compiler übersetzt. 
+ 
+Der ELAN-Compiler wird nicht nur für Programme eingesetzt, sondern auch als 
+Übersetzer für die EUMEL-Kommandosprache (in anderen Systemen "job control 
+language", abgekürzt JCL genannt) und für Kommandos, die man im Editor geben 
+kann. Jedes Kommando der EUMEL-Kommandosprache ist ein kleines ELAN-Programm, 
+welches in der Regel aus einem Prozeduraufruf besteht. Einige häufig be- 
+nutzte Kommandos werden der Effizienz halber über einen Kommando-Interpreter 
+abgewickelt. Beispiel: 
+ 
+     edit ("mein erstes Programm") 
+ 
+Natürlich ist es möglich, mehrere Kommandos oder ein richtiges, einzeiliges 
+Programm als Kommando zu verwenden. Beispiele: 
+ 
+     put (17 * 4) 
+ 
+     INT VAR i; FOR i FROM 1 UPTO 100 REP put ("i") PER 
+ 
+     edit ("datei"); lineform ("datei"); print ("datei") 
+ 
+     INT VAR i; FOR i FROM 1 UPTO 10 REP print ("d") END REP 
+ 
+Mit vorübersetzten Prozeduren (siehe auch das Kommando 'insert') ist es 
+möglich, eine eigene Kommandosprache zusammenzustellen. 
+ 
+Merke: Der ELAN-Compiler wird auch für die Übersetzung und Ausführung von 
+Kommandos benutzt. 
+ 
+ 
+ 
+Vorübersetzen: 'insert' 
+ 
+Das Kommando 'insert' übersetzt ein in einer Datei befindliches ELAN-Pro- 
+gramm und trägt dieses in den Tabellenspeicher des Compilers ein. 
+ 
+Mit dem Kommando 'insert' kann ein ELAN-Programm (d.h. ein Packet oder eine 
+Packetfolge) in den Tabellenspeicher (eine Art "Compilerdatenbank") des 
+ELAN-Compilers eingetragen werden. Die in den Packets enthaltenen Objekte 
+stehen nach Abschluß der Übersetzung zur Verfügung. Beispiel: 
+ 
+Die Datei 'mein druck' enthalte folgendes Programm: 
+ 
+     PACKET mein druck DEFINES drucke: 
+ 
+     PROC drucke (TEXT CONST datei): 
+       edit (datei); 
+       lineform (datei); 
+       pageform (datei); 
+       print (datei) 
+     END PROC drucke; 
+ 
+     END PACKET drucke; 
+ 
+Mit dem Kommando 
+ 
+     insert ("mein druck") 
+ 
+wird das Packet 'drucke' in die Tabellen des ELAN-Compilers aufgenommen. 
+Nun kann (als Kommando oder in einem Programm) der Prozeduraufruf 'drucke' 
+verwandt werden. 
+ 
+Man beachte, daß der Nutzer beim Einrichten seiner Task alle insertierten Ob- 
+jekte der Vater-Task erhält. Insertiert der Benutzer in seiner Task weitere 
+Packets, so sind diese nur ihm verfügbar (oder ggf. seinen Sohn-Tasks). Es 
+ist somit möglich, Tasks mit unterschiedlichem Sprachumfang einzurichten. 
+ 
+Einmal insertierte Packets können nicht mehr aus den Compilertabellen ent- 
+fernt werden. Man kann also nur die Task löschen (bitte vorher alle Dateien 
+archivieren oder bei der Vater-Task aufheben (siehe Kommando: 'save')). 
+ 
+Das Kommando 'insert' arbeitet auch mit einem Thesaurus (vergl. dazu auch 
+den Teil über Dateien). Beispiel: 
+ 
+     insert (ALL myself) 
+ 
+insertiert alle Dateien der Benutzer-Task in Reihenfolge. 
+ 
+Merke: Das Kommando 'insert' übersetzt die in einer Datei enthaltene Packet- 
+folge und trägt diese in die Tabellen des Compilers ein. 
+ 
+ 
+ 
+Programme von einem Programm übersetzen lassen 
+ 
+Manchmal ist es notwendig, daß ein Programm den ELAN-Compiler zur Über- 
+setzung und Ausführung eines Programms aufrufen muß. 
+ 
+Natürlich kann man auch die Kommandos 'run' oder 'insert' von einem Programm 
+aus aufrufen. Leider müssen die zu übersetzenden Programme in einer Datei 
+enthalten sein. Will man jedoch nur eine Anweisung übersetzen und ausführen 
+lassen und nicht den "Umweg" über eine Datei gehen (wie z.B. die Kommandos 
+im Monitor oder Editor), so kann man die Prozedur '#ib#do#ie#' verwenden. 
+Beispiel: 
+ 
+     ... 
+     get (eingabe); 
+     do (eingabe); 
+     ... 
+ 
+Findet der ELAN-Compiler bei der Übersetzung eines Textes der Prozedur 'do'
+einen Fehler, so wird dieser Fehler über 'errorstop' gemeldet (vergl. dazu 
+auch das Kapitel über die Fehlerbehandlung im System-Handbuch) und die Über- 
+setzung bei der ersten Fehlermeldung abgebrochen. In diesem Fall kann ein 
+Nutzer den Fehler durch eine #ib#Fängerebene#ie# leicht selbst behandeln. 
+ 
+Merke: Die Prozedur 'do' übersetzt (kleinere) ELAN-Programme von einem Pro- 
+gramm aus. 
+ 
+ 
+ 
+Kommandos zur Steuerung des ELAN-Compilers 
+ 
+In diesem Abschnitt beschreiben wir die Kommandos für die Steuerung des 
+ELAN-Compilers#ie#. Ebenso wie die Kommandos zur Übersetzung eines Programms 
+müssen die Kommandos zur Steuerung des Compilers vom Monitor gegeben werden. 
+ 
+Mit dem Kommando 
+ 
+     prot ("datei name") 
+ 
+wird das Listing des ELAN-Compilers eingeschaltet und in die angegebene 
+Datei ausgegeben. Mit 
+ 
+     prot off 
+ 
+wird es wieder ausgeschaltet. 'prot off' ist voreingestellt. 
+ 
+Normalerweise werden Zeilennummern des Quellprogramms im übersetzten Pro- 
+gramm mitgeführt, so daß bei einem Fehler zusätzlich zur Fehlermeldung auch 
+die Nummer der Zeile ausgegeben werden kann, in der der Fehler aufgetreten 
+ist. Mit dem Kommando 
+ 
+     check off 
+ 
+kann die Generierung von Zeilenummern für das Objektprogramm abgeschaltet 
+werden. Durch die Angabe dieses Kommandos wird weniger Code für das 
+Programm erzeugt. Mit 
+ 
+     check on 
+ 
+wird die Generierung von Zeilennummern durch den Compiler wieder einge- 
+schaltet. 'check on' ist voreingestellt. Mit der Prozedur 
+ 
+     check 
+ 
+die ein boolesches Resultat liefert, kann in einem Programm abgefragt werden, 
+ob der 'check'-Zustand ein- oder ausgeschaltet ist. Beispiel: 
+ 
+     IF check THEN check off FI 
+ 
+Merke: Die Kommandos 'check on' bzw. 'check off' schalten das Einfügen von 
+Zeilennummern in den erzeugten Code ein bzw. aus. 
+ 
+ 
+ 
+3. Abweichungen gegenüber dem Sprachstandard 
+ 
+Der im HRZ Bielefeld entwickelte ELAN-Compiler weist einige Abweichungen 
+gegenüber dem Sprachstandard auf, wie er in der Sprachbeschreibung formu- 
+liert ist. Es existieren einige Einschränkungen, die einen Programmierer 
+jedoch nicht weiter behindern. Die Spracherweiterungen wurden meist speziell 
+für das EUMEL-System geschaffen. Weitere Abweichungen gegenüber dem aktuellen 
+Sprachstandard, die aber in der nächsten Sprachbeschreibung enthalten sein 
+werden, sind in einem weiteren Abschnitt aufgeführt. 
+ 
+ 
+ 
+Einschränkungen gegenüber dem Sprachstandard 
+ 
+   * Das "row display" wurde nicht implementiert. Der Grund dafür liegt in 
+     dem unverhältnismäßig hohen Aufwand, dieses Sprachmittel bei der gegen- 
+     wärtigen Compiler-Struktur zu implementieren. Abhilfe: Man verwende den 
+     Konstruktor. Beispiel: 
+ 
+        ROW 5 INT VAR vektor; 
+        vektor := [1, 2, 3, 4, 5];   (* nicht möglich       *) 
+        vektor := ROW 5 INT :(1, 2, 3, 4, 5); (* Ersatz: Konstruktor *) 
+ 
+   * Einige alternative Darstellungen von Symbolen können nicht verwendet 
+     werden. Diese sind: 
+ 
+        "&"-Zeichen für "AND", 
+        "/="-Zeichen für "<>", 
+        "%"- und "//"-Zeichen für "DIV". 
+ 
+   * Eine Typ-Definition muß einer Deklaration immer textuell vorangehen. 
+     Beispiel: 
+ 
+        TYPE QUADRAT = ...                   (* erlaubt *) 
+        QUADRAT VAR rundes quadrat; 
+        ... 
+        PUNKT VAR meiner;                    (* verboten *) 
+        TYPE PUNKT = ... 
+ 
+     Es ist jedoch erlaubt, einen Typ in einer Typ-Definition zu verwenden, 
+     der textuell erst später definiert wird. Beispiel: 
+ 
+        TYPE PERSON = STRUCT (TEXT name, vorname, ADRESSE wohnort); 
+        TYPE ADRESSE = ... 
+ 
+     Diese Einschränkung ("defined before applied") gilt nur für Typen, 
+     nicht für Datenobjekte u.ä.. Selbstverständlich ist 
+ 
+        otto := 0; 
+        INT VAR otto; 
+        ... 
+ 
+     erlaubt (aber kein besonders schöner Programmierstil)! 
+ 
+   * Die Operatoren AND und OR können nicht redefiniert werden, sofern einer 
+     ihrer Operanden vom Typ BOOL ist. 
+ 
+ 
+ 
+Implementationsbedingte Einschränkungen 
+ 
+   * Es sind bis zu 32 000 Zeichen in einem TEXT zugelassen. Hat ein TEXT 
+     bis 13 Zeichen, so wird er vollständig auf dem Stack untergebracht. 
+     TEXTe mit mehr als 13 Zeichen werden auf dem Heap gespeichert. Die 
+     Benutzung des Heaps bedeutet unter Umständen eine Verlangsamung eines 
+     Programms. Darum ist 
+ 
+max text length = 32 000 
+ 
+   * Die Anzahl der Zeichen in einem TEXT-Denoter (Angabe eines TEXTes in 
+     einem Programm) ist auf 254 Zeichen beschränkt. 
+ 
+   * INT-Werte werden in sechzehn Bit dargestellt (einschließlich Vor- 
+     zeichen). Das bedeutet, daß 
+ 
+        maxint = 32 767 
+        minint = - 32 768 
+ 
+     ist. 
+ 
+   * REAL-Werte werden intern mit einer Mantisse von 13 Stellen abgespei- 
+     chert, von denen die ersten sieben Stellen bei der Ausgabe dargestellt 
+     werden. Das bedeutet, daß 
+ 
+        maxreal = 9.999999999999e126 
+ 
+     ist. 
+ 
+   * Die lexikographische Reihenfolge von Zeichen entspricht dem ASCII-Code 
+     (vergl. dazu die Code-Tabelle). 
+ 
+   * Weiterhin sieht der ASCII-Code noch eine Anzahl von Steuerzeichen vor, 
+     die jedoch von Herstellern leider nicht immer gleich interpretiert 
+     werden. Diese Zeichen sind im EUMEL-System teilweise normiert und 
+     können verwandt werden. Die verfügbaren Steuerzeichen sind ebenfalls im 
+     EUMEL-Taschenbuch aufgeführt. 
+ 
+   * Die Initialisierung von Paketen (genauer: die Initialisierung von 
+     Datenobjekten, die in vorübersetzten PACKETs außerhalb von Prozeduren 
+     deklariert wurden) wird nur einmal, während der Übersetzung, durchge- 
+     führt. Werden mehrere Pakete hintereinander (aus einer Datei) übersetzt, 
+     dürfen die Prozeduren 'run', 'run again', 'insert' und 'do', die wieder 
+     den ELAN-Compiler aufrufen, nur bei der Ausführung des letzten Packets 
+     verwandt werden, weil der ELAN-Compiler nicht rekursiv benutzbar ist. 
+ 
+ 
+ 
+Erweiterungen gegenüber dem Standard 
+ 
+   * Einem Datenobjekt, das an einen #ib#Datenraum#ie# gebunden werden soll, 
+     wird bei der Deklaration das Schlüsselwort #ib#BOUND#ie# vorangestellt. 
+     Damit wird dem ELAN-Compiler mitgeteilt, daß er für ein solches Objekt 
+     keinen Speicherplatz reservieren muß. Die Assoziation mit einem Daten- 
+     raum erfolgt bei der Deklaration mit Hilfe der Initialisierung. 
+     Beispiel: 
+ 
+        BOUND INT VAR objekt :: old ("hugo"); 
+        (* eine bereits errichtete Datei wird unter dem Namen "hugo" benutzt. 
+        "objekt" ist jetzt an die Datei mit dem Namen "hugo" "gebunden" *) 
+ 
+ 
+ 
+Vorweggenommene Implementation des nächsten Standards 
+ 
+In diesem Abschnitt sind Erweiterungen/Einschränkungen des ELAN-Compilers 
+hinsichtlich der aktuellen ELAN-Sprachbeschreibung aufgeführt, die in der 
+nächsten Sprachbeschreibung mit aufgenommen werden. 
+ 
+   * ASCII-Zeichen, die nicht unmittelbar dargestellt werden können, können 
+     in TEXT-Denotern angegeben werden, sofern sie in Anführungszeichen 
+     eingeschlossen werden. Beispiele: 
+ 
+        ""13"" 
+ 
+     ist ein TEXT-Denoter, der nur CR (carriage return) enthält. 
+ 
+        "Jetzt erfolgt ein Zeilenwechsel "13""10"" 
+ 
+     Hier wird nach der Ausgabe des Textes ein "Wagenrücklauf" ('CR', 
+     Code = 13) und einen Zeilenvorschub ('LF', Code = 10) erzeugt. 
+ 
+        ""1""4"" 
+ 
+     positioniert in die linke obere Ecke eines Bildschirms (Code = 1) und 
+     löscht den Bildschirm (Code = 4). 
+ 
+   * Im aktuellen Standard wurde die #ib#Reihenfolge der Auswertung von 
+     Operanden#ie# nicht definiert. Nunmehr wird zusätzlich nicht garantiert, 
+     daß alle Operanden ausgewertet werden, wenn dies nicht notwendig ist. 
+     Beispiel: 
+ 
+        IF f (x) > 0 AND x <> 0  THEN ... FI 
+ 
+     Hier muß beispielsweise 'f (x)' nicht ausgewertet werden, wenn 'x = 0' 
+     ist. 
+ 
+   * Die booleschen Operatoren CAND und COR stehen zusätzlich zur Verfügung. 
+     Wirkung: 
+ 
+        a CAND b        :<==>   IF a THEN b ELSE FALSE FI 
+ 
+        a COR b         :<==>   IF a THEN TRUE ELSE b FI 
+ 
+     Beispiel: 
+ 
+        IF element vorhanden 
+          THEN verarbeite element 
+        FI. 
+ 
+     element vorhanden: 
+        index > 0 CAND liste (index) > 0. 
+ 
+   * Prozeduren als Parameter. Beispiel: 
+ 
+        (* Deklaration: *) 
+         PROC draw (REAL PROC (REAL CONST) funktion, 
+                    REAL CONST von, bis, delta) 
+        (* Aufruf: *) 
+        draw (REAL PROC (REAL CONST) sin, -pi, pi, 0.1) 
+ 
+     Die obige Form von Prozedur-Parametern wird als "Langform" bezeichnet. 
+     Die Langform muß verwandt werden, wenn generische aktuelle Parameter 
+     benutzt werden. Eine "Kurzform" reicht aus, wenn der aktuelle Prozedur- 
+     Parameter keine generischen Prozedur ist, d.h. eindeutig über den 
+     Prozedurnamen (und nicht noch über die Datentypen seiner Parameter) 
+     identifiziert werden kann. Die Kurzform unterscheidet sich von der 
+     Langform nur beim Aufruf, bei dem eventuelle Resultate und die Daten- 
+     typen der Parameter nicht mit angegeben werden müssen. Beispiel: 
+ 
+        (* Aufruf obiger Prozedur bei nichtgenerischer aktueller Prozedur 
+        'sin' *) 
+        draw (PROC sin, -pi, pi, 0.1) 
+ 
+   * In Paketen sind auch außerhalb von Prozeduren Refinements zugelassen. 
+     In solchen "Paket-Refinements" dürfen nur Paket-Objekte angesprochen 
+     werden. Insbesondere ist es erlaubt, auch im letzten Paket ('main 
+     packet') neben Prozeduren auch Refinements in beliebiger Reihenfolge zu 
+     benutzen. Beispiel: 
+ 
+        PROC kommando erkennung: 
+           ... 
+        END PROC kommando erkennung; 
+ 
+        PROC kommando ausführung: 
+           ... 
+        END PROC kommando ausführung; 
+ 
+        datei assoziieren; 
+        saetze lesen und bearbeiten; 
+        ende behandlung. 
+ 
+        datei assoziieren: 
+           FILE VAR f :: sequential file ...; 
+           ... 
+        saetze lesen und bearbeiten: 
+           ... 
+        ende behandlung: 
+           put ("Ende der Bearbeitung"). 
+ 
+     Dies ist die Schreibweise, die wir empfehlen. Will man aber Refinements 
+     auch zwischen Prozeduren deklarieren, wird es etwas komplizierter. 
+     Beispiel: 
+ 
+        PROC a: 
+        END PROC a; 
+        ref;         (* Refinement Aufruf *) 
+        PROC b: 
+        END PROC b; 
+                     (* Achtung: Semikolon, Punkt vor dem Refinement *) 
+       .ref: . ;     (* Punkt, Semikolon nach dem Refinement *) 
+        PROC c: 
+        END PROC c 
+ 
+     Paket-Refinements dürfen auch von Prozeduren benutzt werden, allerdings 
+     sind dann auch die Sichtbarkeitsregeln zu beachten. D.h. die Paket- 
+     Refinements, die in Prozeduren verwandt werden, dürfen dann auch nur 
+     Paket-Objekte ansprechen. Die Aufnahme eines Refinements in das Inter- 
+     face ist verboten. 
+ 
+ 
+ 
+4. Interne Fehlermeldungen des Compilers
+ 
+Interne Fehlermeldungen des Compilers#ie# erfolgen, wenn der ELAN-Übersetzer 
+an implementationsbedingte Einschränkungen stößt. 
+ 
+  Interne Fehlermeldungen erfolgen in der Form: 
+ 
+    COMPILER ERROR: <zahl> 
+ 
+wobei <zahl> folgende Werte annehmen kann: 
+ 
+<zahl>   Bedeutung und eventuelle Abhilfe: 
+ 
+ 101      name table overflow: 
+          Die Anzahl der Namen im Programm ist zu groß oder es wurden die 
+          Anführungstriche eines TEXT-Denoters vergessen. Keine Abhilfe. 
+ 
+ 102      symbol table overflow: 
+          Die Anzahl der deklarierten Objekte ist zu groß. 
+          Abhilfe: Programm in Pakete unterteilen. 
+ 
+ 103      intermediate string overflow: 
+          Abhilfe: Programm in Pakete unterteilen. 
+ 
+ 104      permanent table overflow 
+          Zu viele Pakete insertiert. 
+          Abhilfe: Keine (neue Task beginnen). 
+ 
+ 106      packet address overflow: 
+          Insgesamt zu viele Adressen in Paketen ( > 64K ), d.h. ein Daten- 
+          objekt ist zu groß. 
+          Keine Abhilfe. 
+ 
+ 107      local data overflow: 
+          Ein Datenobjekt in einer Prozedur ist zu groß ( > 32K ). 
+          Abhilfe: 
+          Datenobjekt in mehrere unterteilen. 
+ 
+ 204      compiler stack overflow: 
+          Keine Abhilfe. 
+ 
+ 301      too many modules: 
+          Zu viele Pakete, Prozeduren und Operatoren ( > 2048 ). 
+          Keine Abhilfe. 
+ 
+ 303      applied table overflow: 
+          siehe 304 
+ 
+ 304      too many labels: 
+          In dem gerade übersetzten Modul (Prozedur, Operator oder Paket- 
+          rumpf) werden vom Compiler zu viele Marken benötigt (mehr als 
+          2000). Marken werden z.B. für die Codegenerierung von Auswahl 
+          (IF ...) und Wiederholung (REP ...) gebraucht. Insbesondere bei 
+          SELECT-Anweisungen werden 'casemax - casemin + 2' Marken 
+          benötigt, wobei 'casemax' der INT-Wert des maximalen, 'casemin' 
+          der des minimalen CASE-Wertes ist. Dieser Fehler ist somit fast 
+          immer auf zu viele und/oder zu weit gespannte SELECT-Anweisungen 
+          zurückzuführen. 
+          Abhilfe: SELECT-Anweisungen über mehrere Prozeduren verteilen oder 
+          Spannweiten verringern. 
+ 
+ 305      code overflow: 
+          Der insgesamt erzeugte Code ist zu umfangreich ( > 256K ). 
+          Keine Abhilfe. 
+ 
+ 306      packet data overflow: 
+          Insgesamt zu viele Datenobjekte in den Paketen ( > 128K ). 
+          Keine Abhilfe. 
+ 
+ 307      local data overflow: 
+          Zu viele (lokale) Datenobjekte in einer Prozedur ( > 32K ). 
+          Abhilfe: Prozedur in mehrere unterteilen, so daß die Datenobjekte 
+          sich über mehrere Prozeduren verteilen. 
+ 
+ 308      module code overflow: 
+          Ein Modul (Prozedur, Operator oder Paket-Initialisierungsteil) ist 
+          zu groß ( > 7.5 KB Code). 
+          Abhilfe: In mehrere Prozeduren oder Pakete zerlegen. 
+ 
+Anmerkung: Fehlermeldungen, die hier nicht aufgeführt sind, weisen in der 
+Regel auf ein fehlerhaftes Arbeiten des ELAN-Compilers hin. In diesem Fall 
+bitten wir um die Einsendung des Programms (Listing, Quelldatei auf Diskette 
+bei umfangreichen Programmen) und entsprechender Fehlermeldung. 
+ 
+ 
+ 
+5. Übersicht über die Compiler-Kommandos 
+ 
+check 
+   BOOL PROC check 
+   Zweck: Informationsprozedur. 
+ 
+   PROC check on 
+   Zweck: Einschalten der Generierung von Zeilennummern durch den 
+          ELAN-Compiler. Voreingestellt ist 'check on'. 
+ 
+   PROC check off 
+   Zweck: Ausschalten der Generierung von Zeilennummern durch den 
+          ELAN-Compiler. 
+ 
+do 
+   PROC do (TEXT CONST program) 
+   Zweck: Übersetzen und Ausführen von 'program' von einem Programm aus. 
+ 
+insert 
+   PROC insert 
+   Zweck: Insertieren eines oder mehrerer PACKETs. Der Programmtext muß sich 
+          in einer Datei befinden. Der Dateiname ist der zuletzt benutzte 
+          Dateiname. 
+ 
+   PROC insert (TEXT CONST dateiname) 
+   Zweck: Wie oben. Der Programmtext wird aus der Datei mit dem Namen 
+          'dateiname' geholt. 
+ 
+   PROC insert (THESAURUS CONST t) 
+   Zweck: Insertieren aller PACKETs, die in den Dateien des Thesaurus 't' 
+          enthalten sind. 
+ 
+prot 
+   BOOL PROC prot 
+   Zweck: Informationsprozedur, ob 'prot' eingeschaltet ist. 
+ 
+   PROC prot (TEXT CONST dateiname) 
+   Zweck: Einschalten des Compilerlistings auf dem Bildschirm. Das Listing 
+          wird gleichzeitig in die Datei 'dateiname' geschrieben. 
+ 
+prot off 
+   PROC prot off 
+   Zweck: Ausschalten des Listings. 
+ 
+run 
+   PROC run 
+   Zweck: Übersetzen und Ausführen eines ELAN-Programms. Der Programmtext 
+          muß sich in einer Datei befinden. Der Dateiname ist der zuletzt 
+          benutzte Dateiname. 
+ 
+   PROC run (TEXT CONST dateiname) 
+   Zweck: Wie oben. Der Programmtext wird aus der Datei mit dem Namen 
+          'dateiname' geholt. 
+ 
+
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a
new file mode 100644
index 0000000..1ee80ec
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a
@@ -0,0 +1,1590 @@
+                     EUMEL-Benutzerhandbuch 
+ 
+ 
+                     TEIL 6: Erste Hilfe in ELAN                    
+ 
+ 
+Vorwort 
+ 
+Dieser Teil des EUMEL-Handbuchs ist keine "Einführung in die Programmierung 
+mit ELAN", sondern ist als Begleitmaterial für einen ELAN-Kurs gedacht. 
+Zudem beschreibt das Skript nicht die vollständige Sprache; dafür ist die 
+Sprachbeschreibung und das Handbuch vorgesehen. Folgende ELAN-Bücher sind 
+z.Zt. erhältlich: 
+ 
+Klingen / Liedtke: 
+Programmieren mit ELAN 
+Teubner, Stuttgart, 1982 
+ 
+Jähnichen u.a.: 
+Systematisches Programmieren mit ELAN 
+W. de Gruyter, 1982 
+ 
+Wir haben in dieses Skript auch einige Aufgaben mit aufgenommen, die An- 
+fänger auf jeden Fall lösen sollten. Die Aufgaben dienen aber nur dazu, das 
+erlernte Wissen über ELAN zu überprüfen und sind keine eigentlichen Program- 
+mieraufgaben, die es im begleitenden Kurs geben sollte. Es gibt zwei Arten 
+von Aufgaben: 
+ 
+a) HSG (Hätten Sie's gewußt?): Aufgaben, die das bis dahin Gelernte über- 
+   prüfen sollen. 
+b) TSW (Trau', Schau', wem!): Aufgaben mit Programmen, die Fehler enthalten 
+   können. Alle Programme dieses Skripts sind übrigens von der Art TSW. 
+ 
+Es ist auch sinnvoll und notwendig, möglichst viele Programme dieses Skripts 
+direkt auf dem Terminal zu probieren und zu verändern. Auf diese Weise wird 
+ein Anfänger auch mit den Fehlermeldungen des ELAN-Compilers vertraut. 
+ 
+ 
+ 
+Das erste Programm 
+ 
+Gleich am Anfang einer Programmierlaufbahn haben Anfänger eine schwierige 
+Hürde zu nehmen: das erste Programm "zum Laufen" zu bringen. Das wird einem 
+Anfänger meist nicht leicht gemacht: schließlich hat er mit dem Betriebs- 
+system eines Computers zu kämpfen. Ein #ib#Betriebssystem#ie# sorgt u.a. für 
+die Steuerung so unterschiedlicher Peripheriegeräte wie Drucker, Lochkarten- 
+leser, Magnetplatten und -bänder usw. Zusätzlich hat es dafür Sorge zu 
+tragen, daß Informationen sicher gespeichert werden und nicht unbeabsichtigt 
+verändert werden können. Letztendlich hat ein Betriebsystem die Aufgabe, die 
+Aufträge von Benutzern ("jobs") - und das können mehrere auf einmal sein - 
+sicher und effizient bearbeiten zu lassen. Um mit einem Betriebsystem 
+"sprechen" zu können, ist meist eine eigene Sprache vorhanden, die Kommando- 
+sprache ("job control language", abgekürzt: JCL). 
+ 
+Eine Kommandosprache kann - auf Grund der vielfältigen Aufgaben, die mit 
+ihrer Hilfe formuliert werden müssen - mehr oder weniger kompliziert sein. 
+Zusätzlich sind Kommandosprachen sehr unterschiedlich: aus leicht einsichti- 
+gen Gründen wollen sich Hersteller nicht auf eine Kommandosprache einigen. 
+Deshalb können wir die Anweisungen in einer speziellen Kommandosprache hier 
+nicht angeben; man erfragt diese am besten. Auf jeden Fall muß etwas getan 
+werden, um ein Programm auf einem Rechner "zum Laufen" zu bringen. 
+ 
+Wie bereits erwähnt, beschränken wir uns hier auf die eigentlichen Programme. 
+Um den Mechanismus mit den Anweisungen an das Betriebsystem von Anfang 
+an kennen zu lernen, denken wir uns ein sehr einfaches Programm aus, das wir 
+bearbeiten lassen wollen. 
+ 
+Programm 1: 
+ 
+     put ("Hallo: mein erstes Programm") 
+ 
+Dieses Programm muß nun dem Rechner zur Bearbeitung übergeben werden. 
+Auch hier treffen wir auf Unterschiede bei den verschiedenen Rechensystemen: 
+bei einigen Rechnern muß ein solches Programm (mit Anweisungen der 
+Kommandosprache) auf Lochkarten übertragen werden, bei anderen dagegen 
+tippt man das Programm direkt an einem Sichtgerät ("Terminal") ein. Die 
+Ausgabe erfolgt dann über einen Schnelldrucker oder auch über das Sichtgerät. 
+Um von Geräten bestimmter Installationen zu abstrahieren, nennen wir im 
+folgenden das Eingabemedium #ib#Eingabegerät#ie# und das Gerät, auf dem die 
+Resultate erscheinen, dementsprechend Ausgabegerät. 
+ 
+Aufgabe (TSW): 
+ 
+  Versuchen Sie, Programm 1 auf dem Rechner Ihrer Installation zu "rechnen". 
+Übungsziel: Umgang mit dem Betriebsystem 
+ 
+ 
+Das Ergebnis unseres ersten Programms ist nun das Erscheinen des Textes: 
+'Hallo: mein erstes Programm'. Was ist hier passiert? Da ein Rechner ein 
+ELAN-Programm meist nicht direkt ausführen kann, muß es in eine Form 
+gebracht werden, die der Rechner "versteht". Diese Form ist wiederum eine 
+(sehr andersartige und - für Menschen - nicht leicht verständliche) Sprache, 
+die Maschinensprache. Man muß also ein ELAN-Programm übersetzen. Dies wird 
+von einem Programm (und nicht etwa einer festverdrahteten Schaltung) vorge- 
+nommen, einem  Übersetzer. Eine bestimmte Art von Übersetzer heißt Compiler; 
+er übersetzt ein Programm als Ganzes (im Gegensatz zu einem Interpreter, der 
+nur einzelne Anweisungen übersetzt und anschließend ausführt). Darum sind 
+bei ELAN-Programmen, die meist durch Compiler übersetzt ("kompiliert") 
+werden, zwei Phasen zu unterscheiden: 
+ 
+a) Übersetzungsphase: 
+ 
+   In dieser Phase wird ein ELAN-Programm (man spricht von Quellprogramm 
+   bzw. "source program") in ein äquivalentes Maschinenprogramm (Objektpro- 
+   gramm) transformiert. Dabei überprüft der Übersetzer das Quellprogramm 
+   auf eventuelle Fehler (Anweisungen, die nicht der ELAN-Sprachbeschreibung 
+   entsprechen). Bei solchen Fehlern, die ein Compiler entdecken kann, 
+   spricht man von syntaktischen Fehlern oder von Fehlern zur Übersetzungs- 
+   zeit. 
+ 
+b) Bearbeitungsphase: 
+ 
+   In dieser Phase ("run time") wird das übersetzte (Maschinen-) Programm 
+   abgearbeitet. Auch hier können Fehler auftreten (z.B. wenn auf einen Wert 
+   vom Programm zugegriffen wird, der noch gar nicht berechnet wurde). 
+   Solche Fehler nennt man Laufzeitfehler. 
+ 
+Haben wir das erste Programm so geschrieben, wie oben angegeben, dürften 
+keine Fehler entdeckt werden und das Programm wird (hoffentlich korrekt, d.h. 
+mit den geforderten Ergebnissen) beendet. Was für ein Programm haben wir nun 
+geschrieben bzw. was haben wir vom Rechner verlangt? 
+ 
+Das Wort 'put' bezeichnet eine Prozedur. Eine Prozedur ist ein Algorithmus 
+(hier mit Parametern): eine bestimmte Sammlung von Anweisungen und unter 
+Umständen Daten. Eine solche Prozedur können wir in einem Programm unter 
+einem Namen (nämlich 'put') ansprechen und ausführen lassen. Man spricht 
+dann von dem Aufruf einer Prozedur, wenn ein Prozedurname geschrieben wird. 
+Von einer Prozedur brauchen wir nur zu wissen, was die Prozedur macht, aber 
+gottseidank nicht, wie sie es macht. 
+ 
+Eine Prozedur wie 'put' ist vorgefertigt und einfach benutzbar, wobei wir 
+später sehen werden, wie man solche Prozeduren selber schreiben kann. Die 
+Prozedur 'put' hat einen Parameter, nämlich den in Klammern geschriebenen 
+Text, der auf dem Ausgabegerät ausgegeben werden soll. Wir können eine 
+solche Prozedur auch mit anderen Parametern versehen und mehrmals aufrufen: 
+ 
+Programm 2: 
+ 
+     put ("Programm:"); 
+     put (2) 
+ 
+Mit dem zweiten Programm ist es uns gelungen, ein Programm mit zwei Anwei- 
+sungen zu schreiben (dabei ist der Parameter bei dem ersten Aufruf der 
+'put'-Prozedur ein Text, beim zweiten Parameter eine ganze Zahl). 
+ 
+ELAN ist eine formatfreie Sprache, d.h. Anweisungen können so auf eine Zeile 
+verteilt werden, wie es uns gefällt und zweckmäßig erscheint. 
+ 
+Programm 3: 
+ 
+     put ("mein"); put (3); put (".Programm") 
+ 
+Man kann also eine oder mehrere Anweisungen auf eine Zeile schreiben oder 
+eine Anweisung über mehrere Zeilen. Das setzt jedoch voraus, daß die Anwei- 
+sungen voneinander getrennt werden (schließlich muß der Übersetzer erkennen 
+können, wo eine Anweisung anfängt und aufhört). Das ist besonders notwendig, 
+weil man in Namen in ELAN beliebig Leerzeichen zur besseren Lesbarkeit 
+verwenden kann. 
+ 
+ 
+Programm 4: 
+ 
+     p u t ( "aha"); 
+     put ("aha") 
+ 
+Beide Anweisungen bewirken also das Gleiche. 
+ 
+Die Trennung von Anweisungen erfolgt in ELAN durch das Trennsymbol 
+Semikolon. Es bedeutet soviel wie: "führe die nächste Anweisung aus". Aus 
+diesem Grund darf hinter der letzten Anweisung eines Programms kein Semiko- 
+lon geschrieben werden (es folgt ja auch keine Anweisung mehr). 
+ 
+Der Aufruf einer Prozedur (wie z.B. 'put') verlangt von unserem Rechner im- 
+mer eine Leistung. Wollen wir aber in einem Programm eine Bemerkung schrei- 
+ben  (z.B. um uns etwas zu merken), dann können wir einen Kommentar schrei- 
+ben, der vom Übersetzer überlesen und somit keinen Einfluß auf die Aus- 
+führung eines Programms hat. Ein Kommentar in ELAN wird durch die Zeichen 
+(* und *) eingeschlossen und darf über mehrere Zeilen gehen. Kommentare sind 
+in ELAN aber nur in wenigen Fällen notwendig, weil wir Programme durch 
+andere Mittel gut lesbar machen können. 
+ 
+ 
+ 
+Ziel der Programmierung 
+ 
+Was wollen wir eigentlich mit dem Programmieren von Computern erreichen? 
+Häufig wiederkehrende und somit oft langweilige Tätigkeiten oder solche, die 
+besonders schnell erledigt werden müssen, sollen von dem "Werkzeug Computer 
+erledigt werden. Gehaltsberechnungen, Unterstützung beim Schreiben von 
+Texten, Katalogsysteme für Bibliotheken, Steuerung von Walzstraßen usw. sind 
+typische Aufgaben für Computer. 
+ 
+Bei der Programmierung wird also versucht, Objekte (wie z.B. Geld bei einer 
+Gehaltsberechnung) und Prozesse (wie z.B. die Simulation von Wirtschaftsab- 
+läufen) der realen Welt mit Hilfe von Programmen in einem Computer nachzu- 
+bilden und nach bestimmten Vorstellungen so zu verändern, daß man "brauch- 
+bare" Ergebnisse erlangt. In einem Programm sind Befehle an einen Rechner 
+für eine solche Abbildung enthalten. Die Befehle in einem Programm werden 
+Anweisungen genannt. Ein Programmierer muß also folgendes tun: 
+ 
+1. Abbilden von Objekten und Prozessen der realen Welt in ein Programm. 
+   Dabei müssen die Bedingungen der Aufgabe beachtet werden. Was das Pro- 
+   gramm Programm leisten soll, wird darum in einer Spezifikation festgelegt. 
+ 
+2. Einbringen des Programms in einen Rechner und Bearbeitung desselben. Die 
+   Formulierung von Anweisungen in einem Programm erfolgt in einer bestimmten 
+   Sprache, nämlich einer Programmiersprache. 
+ 
+3. Interpretation der Ergebnisse. 
+ 
+ 
+ 
+Das Konzept des Datentyps 
+ 
+Befassen wir uns vorerst nur mit Objekten. Sicherlich gibt es sehr viele Ob- 
+jekte in unserer Welt. Einige von ihnen haben aber gleiche Eigenschaften: 
+ 
+- Fahrzeuge (Autos, Mofas, Dreiräder) bringen uns von Ort A nach Ort B. 
+ 
+- Geld (Münzen, Geldscheine, Murmeln, Franc, DM) erlaubt es, etwas zu kaufen. 
+ 
+- Schreibgeräte (Bleistift, Kugelschreiber, Schreibmaschine) sind die Werk- 
+  zeuge von Leuten, die etwas zu schreiben haben. 
+ 
+- ... 
+ 
+Es ist also möglich, einige Objekte der realen Welt in Klassen zusammenzu- 
+fassen. Eine solche Zusammenfassung kann hinsichtlich gleicher Eigenschaften 
+bzw. gleicher Operationen, die für solche Objekte zugelassen sind, erfolgen. 
+Eine Klasse von Objekten mit gleichen Eigenschaften wird in Programmier- 
+sprachen Datentyp genannt. Dabei hat ein Datentyp immer einen Namen, der die 
+Klasse von Objekten sinnvoll kennzeichnet. Als ein Datenobjekt wird ein 
+Exemplar eines Datentyps (also ein spez. Objekt einer Klasse) bezeichnet. 
+ 
+Datentypen sind in ELAN ein zentrales Konzept. Jedes der in einem ELAN- 
+Programm verwandten Datenobjekte hat einen Datentyp; somit kann man Daten- 
+typen auch als Eigenschaften von Datenobjekten ansehen. Für jeden Datentyp 
+sind nur spezielle Operationen sinnvoll. Z.B. sind für einen Datentyp 
+"UBoot" die Operationen "erstellen", "tauchen", "auftauchen", "versenken" 
+und "lieber nicht verwenden" sinnvoll, aber nicht die Operation "+" wie bei 
+ganzen Zahlen. Man kann nun Übersetzern die Aufgabe überlassen zu überprüfen, 
+ob stets die richtige Operation auf einen Datentyp angewandt wird. 
+ 
+Aufgabe (HSG): 
+ 
+     Was ist ein Datentyp? Welche Funktion erfüllen Datentypen? 
+Übungsziel: Datentyp-Konzept 
+ 
+Einige Datentypen spielen bei der Programmierung eine besondere Rolle, weil 
+sie häufig benötigt werden. In ELAN sind das die Datentypen für 
+ 
+- ganze Zahlen. Dieser Datentyp wird INT (für "integer") genannt. 
+ 
+- reelle Zahlen (REAL). 
+ 
+- Zeichen und Zeichenfolgen (TEXT). 
+ 
+- Wahrheitswerte (BOOL). 
+ 
+Diese Typen werden in ELAN elementare Datentypen genannt. Für effiziente 
+Rechnungen mit elementaren Datentypen gibt es in den meisten Rechnern 
+spezielle Schaltungen, so daß die Hervorhebung und besondere Rolle, die 
+sie in Programmiersprachen spielen, gerechtfertigt ist. Zudem hat man 
+Werte-Darstellungen innerhalb von Programmen für die elementaren Datentypen 
+vorgesehen, was wir im nächsten Abschnitt erklären wollen. 
+ 
+Im weiteren Teil dieses Skripts werden wir uns zunächst auf die Behandlung 
+der elementaren Datentypen beschränken. Das bedeutet für den Programmierer, 
+daß er alle Objekte der realen Welt mit Hilfe der elementaren Datentypen in 
+den Computer abbilden muß. Das kann manchmal sehr schwierig sein (wie bilden 
+wir z.B. Personen oder UBoote mit den elementaren Datentypen ab?). Später 
+werden wir dann Möglichkeiten kennenlernen, neue - problemgerechte - 
+Datentypen in ELAN zu formulieren. 
+ 
+ 
+ 
+Denoter (Werte-Repräsentationen) elementarer Datentypen 
+ 
+Wenn wir mit Objekten elementarer Datentypen arbeiten, müssen wir die 
+Möglichkeit haben, Werte in ein Programm zu schreiben. Leider kann man einen 
+Wert "an sich" in einem Programm nicht direkt angeben. Schreiben wir z.B. 
+4711, dann meinen wir zwar einen INT-Wert, haben aber die Ziffern 4, 7, 1 und 
+1 geschrieben. Der eigentliche Wert wird in unserem Kopf oder - für unsere 
+Zwecke - in einem Rechner gebildet. 
+ 
+Die Werte-Darstellungen oder Werte-Repräsentationen, die in ELAN "Denoter" 
+genannt werden, sind für jeden Datentyp unterschiedlich. Wie bereits erwähnt, 
+haben alle Datenobjekte in ELAN (also auch Denoter) nur einen - vom Über­ 
+setzer feststellbaren - Datentyp. Aus der Form eines Denoters ist also der 
+Datentyp erkennbar: 
+ 
+- INT-Denoter: 
+  Bestehen aus einer Aneinanderreihung von Ziffern. Beispiele: 
+ 
+    17, 007, 32767, 0 
+ 
+  Führende Nullen spielen bei der Bildung des Wertes keine Rolle (sie werden 
+  vom ELAN-Compiler überlesen). Negative INT-Denoter gibt es nicht (wie 
+  negative Werte-Darstellungen in einem Programm geschrieben werden, lernen 
+  wir bei den Ausdrücken). 
+ 
+- REAL-Denoter: 
+  Hier gibt es zwei Formen. Die erste besteht aus zwei INT-Denotern, die 
+  durch einen Dezimalpunkt getrennt werden. Beispiele: 
+ 
+     0.314159, 17.28 
+ 
+  Der Dezimalpunkt wird analog der deutschen Schreibweise als Komma 
+  verwendet. Negative REAL-Denoter gibt es wiederum nicht. 
+ 
+  Eine zweite Form wird kurioserweise als "wissenschaftliche Notation" be- 
+  zeichnet. Sie findet dann Verwendung, wenn sehr große oder Zahlen, die 
+  nahe bei Null liegen, dargestellt werden müssen. Beispiele: 
+ 
+     3.0 e5, 3.0e-5 
+ 
+  Der (INT-) Denoter hinter dem Buchstaben e gibt an, wie viele Stellen der 
+  Dezimalpunkt nach rechts (positive Werte) oder nach links zu verschieben 
+  ist. Dieser Wert wird Exponent, der Teil vor dem Buchstaben e Mantisse 
+  genannt.   
+ 
+- TEXT-Denoter: 
+  TEXT-Denoter werden in Anführungszeichen eingeschlossen. Beispiele: 
+ 
+     "Das ist ein TEXT-Denoter" 
+     "Jetzt ein Text-Denoter ohne ein Zeichen: ein leerer Text" 
+     "" 
+ 
+  Beachte, daß das Leerzeichen ebenfalls ein Zeichen ist. Soll ein An- 
+  führungszeichen in einem TEXT erscheinen (also gerade das Zeichen, welches 
+  einen TEXT-Denoter beendet), so muß es doppelt geschrieben werden: 
+ 
+     "Ein TEXT mit dem ""-Zeichen" 
+     "Ein TEXT-Denoter nur mit dem ""-Zeichen:" 
+     """" 
+ 
+  Manchmal sollen Zeichen in einem TEXT-Denoter enthalten sein, die auf dem 
+  Eingabegerät nicht zur Verfügung stehen. In diesem Fall kann der Code- 
+  Wert des Zeichens angegeben werden: 
+ 
+     ""32"" 
+ 
+  bedeutet z.B. das (ASCII-) Leerzeichen. Der Code-Wert eines Zeichens er- 
+  gibt sich aus einer Code-Tabelle (installationsspezifisch), in der jedem 
+  Zeichen eine ganze Zahl zugeordnet ist. 
+ 
+- BOOL-Denoter: 
+  Es gibt nur zwei BOOL-Denoter: TRUE (für "wahr") und FALSE (für "falsch"). 
+ 
+Nun wird auch klar, was für Parameter wir in den obigen Programmen verwandt 
+haben. Es waren natürlich TEXT- bzw. INT-Denoter. 
+ 
+ 
+Aufgabe (TSW): 
+ 
+     Welche der folgenden Denotationen ist falsch? 
+ 
+     a) 1.                  e) 1 . 0       i) 007 
+     b) -1                  f) ""          j) "Ein "Getuem" stellt sich vor" 
+     c) """                 g) """"       
+     d) "das ist ein text"  h) TRUE        k) 1.0 e 37 
+ 
+Übungsziel: Lernen von Denotationen 
+ 
+ 
+ 
+ELAN-Datenobjekte 
+ 
+Wie bereits erwähnt, wollen wir mit Hilfe von Programmen Datenobjekte so 
+verändern, daß wir erwünschte Ergebnisse erhalten. Meist wird zu dieser Ver- 
+änderung von Datenobjekten "Rechnen" gesagt, obwohl - wie wir gleich sehen 
+werden - nicht nur numerische Objekte manipuliert werden. Die Veränderung 
+der Datenobjekte findet zur "Laufzeit" (nicht zur Übersetzungszeit) im 
+Rechner statt. Die Darstellung eines Werts in einem Rechner zur Laufzeit 
+eines Programms wird #ib#Repräsentation#ie# genannt. Wenn es eindeutig ist, 
+daß es sich nur um die Repräsentation im Rechner handelt, sprechen wir kurz 
+von Werten.  
+Da also ein Datenobjekt wechselnde Werte annehmen kann, brauchen wir eine 
+Möglichkeit, es in einem Programm anzusprechen, egal welchen Wert das Objekt 
+zu einem Zeitpunkt beinhaltet. Zu diesem Zweck können wir einem Datenobjekt 
+einen Namen geben (wie z.B. einen Personennamen, hinter dem sich eine wirk­ 
+liche Person "verbirgt"). Wenn wir also den Namen des Datenobjekts in ein 
+Programm schreiben, dann meinen wir (meist) den Wert des Datenobjekts, den 
+es zu diesem Zeitpunkt besitzt. 
+ 
+Nun sollen die zu behandelnden Datenobjekte ja auch neue Werte erhalten. In 
+diesem Fall müssen wir die Speicherstelle finden, in die der neue Wert ge- 
+bracht werden soll. Für diesen Zweck benutzen wir ebenfalls den Namen, zu- 
+sätzlich zu der Angabe einer Operation, durch die das Objekt einen neuen 
+Wert erhalten soll. Diese Operation (Wert "schreiben") nennen wir Zuweisung. 
+Der Zuweisungs-Befehl wird ':=' geschrieben. Beispiel: 
+ 
+     a := 5 
+ 
+Bedeutet, daß das Datenobjekt mit dem Namen 'a' den Wert '5' erhält. 
+ 
+Von manchen Datenobjekten wissen wir, daß wir ihnen nur einmal einen Wert 
+geben wollen. Sie sollen also nicht verändert werden. Oder wir wissen, daß 
+in einem Programmbereich ein Datenobjekt nicht verändert werden soll. Um ein 
+unbeabsichtigtes Verändern zu verhindern, wird in ELAN dem Namen eines 
+Datenobjekts ein zusätzlicher Schutz mitgegeben: das Zugriffsrecht oder 
+Accessrecht. Es besteht aus der Angabe der Worte VAR (für Lesen und Ver- 
+ändern) oder CONST (für ausschließliches Lesen). 
+ 
+ 
+ 
+Die Deklaration (Vereinbarung) von Datenobjekten 
+ 
+Wollen wir ein Datenobjekt in einem Programm verwenden, so müssen wir dem 
+Übersetzer mitteilen, welchen Datentyp und welches Accessrecht das Objekt 
+haben soll. Das dient u.a. dazu, nicht vereinbarte Namen (z.B. verschriebene) 
+vom Übersetzer entdecken zu lassen. Weiterhin ist aus dem bei der Deklaration 
+angegebenen Datentyp zu entnehmen, wieviel Speicherplatz für das Objekt zur 
+Laufzeit zu reservieren ist. Beispiel: 
+ 
+INT VAR mein datenobjekt 
+ 
+Zuerst wird der Datentyp, dann das Accessrecht und schließlich der Name des 
+Datenobjekts angegeben. Wie werden nun Namen in ELAN formuliert? 
+ 
+Das erste Zeichen eines Namens muß immer ein kleiner Buchstabe sein. Danach 
+dürfen beliebig viele kleine Buchstaben, aber auch Ziffern folgen. Zur bes- 
+seren Lesbarkeit können (wie bei den obigen Prozedurnamen) Leerzeichen in 
+einem Namen erscheinen, die aber nicht zum Namen zählen. Beispiele: 
+ 
+     name1 
+     n a m e 1 
+     x27 
+     gehalts konto 
+     das ist ein langer name 
+ 
+Verschiedene Datenobjekte mit gleichem Datentyp und Accessrecht dürfen in 
+einer Deklaration angegeben werden (durch Kommata trennen). Mehrere Dekla- 
+rationen werden - genauso wie Anweisungen - durch das Trennsymbol 
+voneinander getrennt. Beispiele: 
+ 
+     INT VAR mein wert, dein wert, unser wert; 
+     BOOL VAR listen ende; 
+     TEXT VAR zeile, wort 
+ 
+ 
+ 
+Die Initialisierung von Datenobjekten 
+ 
+Um mit den so vereinbarten Datenobjekten arbeiten zu können, muß man ihnen 
+eine Wert geben. Hat ein Datenobjekt noch keinen Wert erhalten, so sagt man, 
+sein Wert sei undefiniert. Das versehentliche Arbeiten mit undefinierten 
+Werten ist eine beliebte Fehlerquelle. Deshalb wird von Programmierern 
+streng darauf geachtet, diese Fehlerquelle zu vermeiden. Eine Wertgebung an 
+ein Datenobjekt kann (muß aber nicht) bereits bei der Deklaration erfolgen, 
+was man in ELAN Initialisierung nennt. Beispiele: 
+ 
+     INT CONST gewuenschtes gehalt :: 12 000; 
+     TEXT VAR zeile :: ""; 
+     REAL CONST pi :: 3.14159; 
+     BOOL VAR bereits sortiert :: TRUE 
+ 
+Allerdings: für mit CONST vereinbarte Datenobjekte ist die Initialisierung 
+die einzige Möglichkeit, ihnen einen Wert zu geben. 
+ 
+Die Initialisierung erfolgt mit Hilfe des '::'-Symbols. Anschließend folgt 
+der Wert, den das Datenobjekt erhalten soll. (In den Beispielen haben wir 
+nur Denoter geschrieben. Es sind aber auch allgemeinere Ausdrücke erlaubt.). 
+Es ist nun möglich, mit der oben erwähnten 'put'-Prozedur auch den Wert von 
+Datenobjekten ausgeben zu lassen. 
+ 
+ 
+Programm 5: 
+ 
+     INT VAR nummer :: 5; 
+     TEXT CONST bemerkung :: ".Programm"; 
+     put (nummer); 
+     put (bemerkung) 
+ 
+Beachte dabei, daß bei der Aufführung eines Namens in diesem Fall immer der 
+Wert des Datenobjekts gemeint ist. Auch die 'put'-Prozedur druckt nicht etwa 
+den Namen des Datenobjekts oder die Adresse der Speicherstelle, sondern 
+ebenfalls den Wert. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Welche Aufgabe erfüllen Deklarationen? Was heißt: "Eine Variable hat 
+     einen undefinierten Wert"? Was ist eine Initialisierung? Was ist ein 
+     CONST-Datenobjekt? Warum müssen CONST-Datenobjekte initialisiert 
+     werden? 
+Übungsziel: Verständnis von Deklarationen und Accessrecht 
+ 
+ 
+ 
+Schlüsselworte 
+ 
+Einige Worte haben in ELAN eine feste Bedeutung und können somit nicht - 
+wie etwa Namen - frei gewählt werden. Solche Worte werden bei den meisten 
+ELAN-Übersetzern mit großen Buchstaben geschrieben, wie z.B. VAR, CONST, 
+INT oder REAL u.a.m. Wie wir später sehen werden, besteht die Möglichkeit, 
+neue Schlüsselworte einzuführen. Halten wir vorläufig fest, daß feste 
+Bestandteile der Sprache (wie z.B. CONST oder VAR) und Datentypen (wie INT 
+oder REAL) Schlüsselworte sind, also mit großen Buchstaben geschrieben 
+werden.              
+ 
+ 
+ 
+Ausdrücke 
+ 
+Nun wäre es natürlich schlecht, wenn Programmierer nicht mehr machen könnten, 
+als Werte ausgeben. Als erste Stufe von etwas komplexeren "Rechnungen" 
+dürfen Ausdrücke gebildet werden. Ausdrücke sind eine Zusammenstellung von 
+Datenobjekten (Denoter, VAR- oder CONST-Objekte) und Operatoren. Schauen wir 
+uns dazu erst ein Programm an: 
+ 
+ 
+Programm 6: 
+ 
+     INT CONST wert 1 :: 1, 
+               wert 2 :: 2, 
+               wert 3 :: 3; 
+ 
+     put (wert1 + wert2); 
+     put (wert2 - wert1); 
+     put (wert2 * wert3); 
+     put (wert3 DIV wert2); 
+     put (wert2 ** wert3) 
+ 
+In diesem Programm werden drei Datenobjekte initialisiert. Anschließend 
+werden jeweils die Werte von zwei Objekten addiert (Operatorzeichen: '+'), 
+subtrahiert ('-'), multipliziert ('*'), dividiert (ganzzahlige Division ohne 
+Rest: 'DIV') und potenziert ('**'). Dies sind Operatoren, die zwei Operanden 
+haben: man nennt sie dyadische Operatoren. Die monadischen Operatoren da- 
+gegen haben nur einen Operanden. Beispiel: 
+ 
+     put ( - wert1) 
+ 
+Operatoren in ELAN werden - wie wir an den obigen Beispielen sehen - durch 
+ein oder zwei spezielle Zeichen oder durch große Buchstaben (in den Fällen, 
+in denen kein "vernünftiges" Zeichen mehr zur Verfügung steht) als Schlüssel- 
+wort dargestellt. 
+ 
+Als Operanden (also die Datenobjekte, auf die ein Operator "wirken" soll) 
+eines Operators darf ein VAR- oder CONST-Datenobjekt, aber auch ein Denoter 
+verwendet werden. Das Resultat eines Operators (also das Ergebnis einer 
+Berechnung) ist bei den obigen Ausdrücken wieder vom Datentyp INT mit dem 
+Accessrecht CONST. Darum ist es erlaubt, solch einen Ausdruck wiederum als 
+Operanden zu verwenden. Praktisch bedeutet dies, daß wir mehrere Operatoren 
+und Datenobjekte zusammen in einem Ausdruck haben dürfen. 
+ 
+ 
+Programm 7: 
+ 
+     INT CONST wert 1 :: 1, 
+               wert 2 :: 2, 
+               wert 3 :: 3; 
+ 
+     put (wert2 + 3 - wert2 * wert3); 
+     put (- wert2 * wert3) 
+ 
+Nun haben wir eine Schwierigkeit: Der Ausdruck in der ersten 'put'-Anweisung 
+ist mehrdeutig, d.h. kann - je nach Reihenfolge der Auswertung - unter- 
+schiedliche Ergebnisse als Resultat liefern. Beispiel: 
+ 
+     a) (wert2 + 3 = 5) - (wert2 * wert3 = 6) = -1 
+     b) ((wert2 + 3 = 5) - wert2 = 3) * 3 = 9 
+ 
+Es kommt also auf die Reihenfolge der Auswertung von Operatoren an. Diese 
+kann man durch die Angabe von Klammern steuern. Beispiel: 
+ 
+     (a + b) * (a + b) 
+ 
+Es wird jeweils erst 'a + b' ausgewertet und dann erst die Multiplikation 
+durchgeführt. In ELAN ist es erlaubt, beliebig viel Klammernpaare zu ver- 
+wenden (Regel: die innerste Klammer wird zuerst ausgeführt). Es ist sogar 
+zulässig, Klammern zu verwenden, wo keine notwendig sind, denn überflüssige 
+Klammernpaare werden überlesen. Beispiel: 
+ 
+     ((a - b)) * 3 * ((c + d) * (c - d)) 
+ 
+Somit können wir beliebig komplizierte Ausdrücke formulieren. (Was man aber 
+vermeiden sollte, weil sie leicht zu Fehlern führen. Stattdessen kann man 
+einen komplizierten Ausdrücke in mehrere (einfachere) zerlegen.) 
+ 
+Um solche Ausdrücke einfacher zu behandeln und sie so ähnlich schreiben zu 
+können, wie man es in der Mathematik gewohnt ist, wird in Programmiersprachen 
+die Reihenfolge der Auswertung von Operatoren festgelegt. In ELAN wurden 
+neun Ebenen, Prioritäten genannt, festgelegt: 
+ 
+ 
+Priorität               Operatoren 
+ 
+   9                     alle monadischen Operatoren 
+   8                     ** 
+   7                     *, /, DIV, MOD 
+   6                     +, - 
+   5                     =, <>, <, <=, >, >= 
+   4                     AND 
+   3                     OR 
+   2                     alle übrigen, nicht in dieser Tabelle aufgeführten 
+                         dyadischen Operatoren 
+   1                     := 
+ 
+ 
+(Die bis jetzt noch nicht erwähnten Operatoren in der Tabelle werden wir in 
+den weiteren Abschnitten besprechen.) 
+ 
+Operatoren mit der höchsten Priorität werden zuerst ausgeführt, dann die mit 
+der nächst höheren Priorität usw. Operatoren mit gleicher Priorität werden 
+von links nach rechts ausgeführt. Dadurch ergibt sich die gewohnte Abarbei- 
+tungsfolge wie beim Rechnen. Beispiel: 
+ 
+     -2 + 3 * 2 ** 3 
+ 
+     a) -2 
+     b) 2 ** 3 
+     c) 3 * (2 ** 3) 
+     d) ((-2)) + (3 * (2 ** 3)) 
+ 
+Wie bereits erwähnt, ist es immer erlaubt, Klammern zu setzen. Ist man sich 
+also über die genaue Abarbeitungsfolge nicht im Klaren, so kann man Klammern 
+verwenden. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Welche INT-Werte ergeben sich? 
+ 
+     a)  14 DIV 4      e) -14 DIV -4 
+     b)  + 14 DIV 4    f) 2 * 3 DIV 2 ** 2 * 4 
+     c) -14 DIV 4      g) 2 ** 3 ** 4 
+     d)  14 DIV -4     h) 3 + 4 * 2 + 3 
+ 
+Übungsziel: Arithmetische Ausdrücke 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Bilden Sie für folgende mathematische Formeln entsprechende ELAN- 
+     Ausdrücke: 
+ 
+           a               b              a+b 
+        a) - c         d) a          g) - --- 
+           b                               c 
+ 
+ 
+           a+b              b           a   c 
+        b) ---         e) -a         h) - * - 
+           c+d                          b   d 
+ 
+ 
+           a+b             -b                c 
+        c) --- e       f) a          i) (a*b) 
+           c+d 
+ 
+Übungsziel: Arithmetische Ausdrücke formulieren 
+ 
+ 
+ 
+Generische Operatoren und Prozeduren 
+ 
+Bis jetzt wurden nur Ausdrücke mit INT-Operanden verwendet. Wie sieht es 
+jetzt mit REALs aus? 
+ 
+ 
+Programm 8: 
+ 
+     put (1.0 + 2.0); 
+     put (2.0 - 1.0); 
+     put (2.0 * 3.0); 
+     put (3.0 / 2.0); 
+     put (2.0 ** 3.0) 
+ 
+Man beachte die Unterschiede zum Programm 7: Wir müssen nun REAL-Denoter 
+verwenden (mit INT-Denotern zu arbeiten wäre ein Fehler). Der Divisions- 
+Operator hat sich nun von 'DIV' zu '/' gewandelt. Die Ergebnisse sind nun 
+nicht INT-, sondern REAL-Werte. Für die Reihenfolge der Auswertung der 
+Operatoren sowie die Verwendung von Klammern gilt das für INT-Ausdrücke 
+gesagte. 
+ 
+Wir haben den '+'-Operator in zwei verschiedenen Formen gesehen: in Programm 
+7 mit Operanden vom Datentyp INT, ein INT-Resultat liefernd, und in Programm 
+8 das gleiche mit REALs. Es liegen also zwei verschiedene Operatoren vor, 
+die aber den gleichen Namen (Zeichen: '+') haben. 
+ 
+In ELAN ist es somit möglich, unterschiedlichen Operatoren (aber auch Proze- 
+duren) gleiche Namen zu geben. Solche Operatoren werden generische Opera- 
+toren genannt. Ein ELAN-Compiler wählt den richtigen Operator aufgrund der 
+Datentypen der Operanden aus. Oft werden die verfügbaren Operatoren wie folgt 
+dokumentiert: 
+ 
+     INT OP + (INT CONST links, rechts) 
+ 
+Diese Form nennt man einen "Operator-Kopf". Sie wird in ELAN-Programmen bei 
+der Definition von Operatoren benötigt. Dabei steht OP für "OPERATOR". Die 
+Angabe des Datentyps davor gibt den Datentyp des Resultats des Operators an. 
+Zwischen 'OP' und der öffnenden Klammer steht der Name des Operators (hier: 
+'+'). In den Klammern werden die Datentypen und das Accessrecht der 
+Operanden angegeben. CONST bedeutet hier: der Operand darf vom Operator 
+nicht verändert werden, während bei VAR (was normalerweise ja nicht sein 
+sollte!) ein Operand bei der Abarbeitung eines Operators verändert werden 
+kann. 
+ 
+Damit wir solche Definitionen besser beherrschen, geben wir noch weitere 
+Beispiele an: 
+ 
+     INT  OP - (INT CONST operand) 
+     REAL OP / (INT CONST l, r) 
+ 
+Bei dem ersten Operator handelt es sich um den monadischen Operator '-' für 
+INT-Operanden (z.B.: 'INT VAR a :: 1; put (-a)'), während es sich bei dem 
+zweiten Operator um eine Divisions-Operator handelt, der jedoch ein REAL- 
+Resultat liefert (z.B.: 'put (3 / 2)' liefert 1.5). Der MOD-Operator liefert 
+den Rest einer Division: 
+ 
+     INT  OP MOD (INT CONST  l, r) 
+     REAL OP MOD (REAL CONST l, r) 
+ 
+Die Beschreibung von generischen Prozeduren verläuft analog. Beispiele: 
+ 
+     PROC put (INT CONST wert) 
+     PROC put (REAL CONST wert) 
+ 
+Hier wird das Wort 'OP' durch 'PROC' (für 'PROCEDURE') ersetzt. Die Angaben 
+in Klammern bezeichnen nun nicht Operanden, sondern Parameter. 
+ 
+Über die verfügbaren Operatoren und Prozeduren für INT- und REAL-Datenob- 
+jekte kann man sich im ELAN-Handbuch oder im EUMEL-Benutzerhandbuch infor- 
+mieren. Einige - aber nicht alle - der Operatoren und Prozeduren (auch für 
+andere Datentypen) werden wir erklären, wenn wir sie in Programmen benötigen. 
+ 
+ 
+ 
+Die Zuweisung 
+ 
+Ein spezieller Operator ist die Zuweisung (Zeichen: ':='). Dieser Operator 
+hat immer die geringste Priorität, wird also immer als letzter eines Aus- 
+drucks ausgeführt. Die Zuweisung wird verwendet, um einer Variablen einen 
+neuen Wert zu geben. Beispiel: 
+ 
+     a := b 
+ 
+Hier wird der Wert von 'b' der Variablen 'a' zugewiesen. Der vorher vor- 
+handene Wert von 'a' geht dabei verloren. Man sagt auch, der Wert wird über- 
+schrieben. Auf der rechten Seite (also als rechter Operand) des ':=' 
+Operators darf auch ein Ausdruck stehen. Beispiel: 
+ 
+     a := b + c 
+ 
+Hier wird das Resultat von 'b + c' an die Variable 'a' zugewiesen. Man be- 
+achte dabei die Prioritäten der Operatoren '+' (Priorität 6) und ':=' (Pri- 
+orität 1): die Addition wird vor der Zuweisung ausgeführt. Die Auswertung 
+von Zuweisungen mit Ausdrücken muß immer so verlaufen, da die Zuweisung 
+stets die niedrigste Priorität aller Operatoren hat. 
+ 
+Schauen wir uns zum besseren Verständnis die Definitionen des (natürlich 
+auch generischen) Operators ':=' an: 
+ 
+     OP := (INT  VAR ziel, INT  CONST quelle) 
+     OP := (REAL VAR ziel, REAL CONST quelle) 
+     OP := (TEXT VAR ziel, TEXT CONST quelle) 
+     OP := (BOOL VAR ziel, BOOL CONST quelle) 
+ 
+Der Operator ':=' liefert also kein Resultat (man sagt auch, er liefert 
+keinen Wert) und verlangt als linken Operanden ein VAR-Datenobjekt (an den 
+der Wert der rechten Seite zugewiesen werden soll). Der Wert des linken 
+Operanden wird also verändert. Für den rechten Operanden ist durch CONST 
+sichergestellt, daß er nur gelesen wird. 
+ 
+Oft kommt es vor, daß ein Objekt auf der linken und rechten Seite des Zuwei- 
+sungsoperators erscheint, z.B. wenn ein Wert erhöht werden soll. Beispiele: 
+ 
+     a := a + 1; 
+     a := a + 17 
+ 
+Hier wird der "alte", aktuelle Wert von 'a' genommen, um '1' erhöht und dem 
+Objekt 'a' zugewiesen. Man beachte, daß hier in einer Anweisung ein Datenob- 
+jekt unterschiedliche Werte zu unterschiedlichen Zeitpunkten haben kann. 
+ 
+In solchen Fällen darf man den Operator INCR verwenden: 
+ 
+     a INCR 1; 
+     a INCR 17 
+ 
+Analoges gilt für den Operator DECR, bei dem ein Wert von einer Variable 
+subtrahiert wird. Also: 
+ 
+     OP INCR (INT  VAR ziel, INT  CONST dazu) 
+     OP INCR (REAL VAR ziel, REAL CONST dazu) 
+ 
+     OP DECR (INT  VAR ziel, INT  CONST abzug) 
+     OP DECR (REAL VAR ziel, REAL CONST abzug) 
+ 
+Schauen wir uns folgendes Programm an, bei dem zwei Werte vertauscht werden: 
+ 
+ 
+Programm 9: 
+ 
+     INT VAR a, b, x; 
+ 
+     get (a); 
+     get (b); 
+     x := a; 
+     a := b; 
+     b := x; 
+     put (a); 
+     put (b) 
+ 
+Wie wir an diesem Beispiel sehen, existieren nicht nur 'put'-Prozeduren, 
+sondern auch 'get'-Prozeduren, die einen Wert vom Eingabemedium einlesen. 
+Es gibt folgende 'get'- Prozeduren (die 'put'-Prozeduren führen wir der 
+Vollständigkeit halber auch mit auf): 
+ 
+     PROC get (INT  VAR wert) 
+     PROC get (REAL VAR wert) 
+     PROC get (TEXT VAR wert) 
+ 
+     PROC put (INT  CONST wert) 
+     PROC put (REAL CONST wert) 
+     PROC put (TEXT CONST wert) 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Was versteht man unter Generizität? 
+     Übungsziel: Generizitäts-Begriff 
+ 
+ 
+ 
+Refinements 
+ 
+Bevor wir die Operationen für TEXTe und BOOLs besprechen, wollen wir eine 
+weitere wichtige Eigenschaft von ELAN diskutieren, nämlich die Namensgebung. 
+Namen für Datenobjekte haben wir bereits kennengelernt. In ELAN ist es eben- 
+falls möglich, Namen für Ausdrücke oder eine bzw. mehrere Anweisungen zu 
+vergeben. 
+ 
+ 
+Programm 10: 
+ 
+     INT VAR a, b, x; 
+     einlesen von a und b; 
+     vertauschen von a und b; 
+     vertauschte werte ausgeben. 
+ 
+     einlesen von a und b: 
+        get (a); 
+        get (b). 
+ 
+     vertauschen von a und b: 
+        x := a; 
+        a := b; 
+        b := x. 
+ 
+     vertauschte werte ausgeben: 
+        put (a); 
+        put (b). 
+ 
+Dies ist das gleiche Programm wie das 9. Beispielprogramm. Für den Namen 
+'einlesen von a und b' werden die Anweisungen 'get (a); get (b)' vom 
+ELAN-Übersetzer eingesetzt. Man kann also die ersten vier Zeilen des 
+Programms als eigentliches Programm ansehen, wobei die Namen durch die 
+betreffenden Anweisungen ersetzt werden. Eine solche Konstruktion wird in 
+ELAN Refinement genannt. Was wird dadurch erreicht? 
+ 
+Durch die sinnvolle Verwendung von Refinements wird ein Programm im Programm 
+und nicht in einer separaten Beschreibung dokumentiert. Weiterhin kann ein 
+Programm "von oben nach unten" ("top down") entwickelt werden: wir haben das 
+obige - zugegeben einfache - Beispielprogramm in drei Teile zerlegt und 
+diese durch Namen beschrieben. Bei der Beschreibung von Aktionen durch Namen 
+sagen wir, was wir machen wollen und nicht wie, denn wir brauchen uns auf 
+dieser Stufe der Programmentwicklung um die Realisierung der Refinements 
+(noch) keine Sorgen zu machen. Das erfolgt erst, wenn wir genauer definieren 
+müssen, wie das Refinement programmiert werden muß. Dabei können wir 
+wiederum Refinements verwenden usw., bis wir auf eine Ebene "herunterge- 
+stiegen" sind, bei dem eine (jetzt: Teil-) Problemlösung sehr einfach ist 
+und wir sie direkt hinschreiben können. Wir beschäftigen uns also an jedem 
+Punkt der Problemlösung nur mit einem Teilaspekt des gesamten Problems. 
+Zudem sieht man - wenn die Refinements einigermaßen vernünftig verwendet 
+werden - dem Programm an, wie die Problemlösung entstanden ist. 
+ 
+Die Verwendung von Refinements hat also eine Anzahl von Vorteilen. Schauen 
+wir uns deshalb an, wie die Refinements formal verwandt werden müssen. Das 
+"Hauptprogramm" wird durch einen Punkt abgeschlossen, falls ein Refinement 
+folgt. Ein Refinement besteht aus der Nennung des Refinement-Namens, der 
+von einem Doppelpunkt gefolgt sein muß. In einem Refinement kann eine 
+Anweisung oder mehrere - durch Semikolon getrennt - stehen. Das Refinement 
+wird durch einen Punkt abgeschlossen. 
+ 
+Refinements können auch dort verwendet werden, wo ein Wert erwartet wird, 
+z.B. in einem Ausdruck oder einer 'put'-Anweisung. In diesem Fall muß das 
+Refinement natürlich einen Wert liefern. Wie macht man das? Eine Möglichkeit 
+ist, daß im Refinement ein Ausdruck geschrieben wird, der einen Wert als 
+Resultat liefert. 
+ 
+ 
+Programm 11: 
+ 
+     INT VAR a :: 1, b :: 2, c :: 3; 
+     put (resultat). 
+ 
+     resultat: 
+        (a * b + c) ** 3. 
+ 
+Eine Zuweisung liefert - wie bereits erwähnt - kein Resultat. Es ist auch 
+erlaubt, ein Refinement mit mehreren Anweisungen zu schreiben, das einen Wert 
+liefert. Allgemeine Regel: die letzte Anweisung eines Refinements bestimmt, 
+ob ein Refinement einen Wert liefert - und wenn ja, von welchen Datentyp. 
+ 
+ 
+ 
+BOOLesche Operationen 
+ 
+Für BOOLesche Datenobjekte gibt es einige Operatoren: 
+ 
+     BOOL OP AND (BOOL CONST links, rechts) 
+     BOOL OP OR  (BOOL CONST links, rechts) 
+     BOOL OP NOT (BOOL CONST operand) 
+ 
+Der Operator AND liefert als Resultat die logische "und"-Verknüpfung (nur 
+wenn beide Operanden den Wert TRUE haben ist das Resultat TRUE, sonst FALSE), 
+OR ist das logische "oder" (nur wenn beide Operanden FALSE liefern, ist das 
+Resultat FALSE, sonst TRUE) und die logische Negation NOT (als Resultat wird 
+das "Gegenteil" geliefert). 
+ 
+Ebenfalls wichtig sind die Vergleichs-Operatoren, die zwar keine BOOLeschen 
+Operanden erwarten, aber ein BOOLesches Resultat liefern: 
+ 
+     BOOL OP =  (INT CONST links, rechts) 
+     BOOL OP <> (INT CONST links, rechts) 
+     BOOL OP <  (INT CONST links, rechts) 
+     BOOL OP <= (INT CONST links, rechts) 
+     BOOL OP >  (INT CONST links, rechts) 
+     BOOL OP >= (INT CONST links, rechts) 
+ 
+Diese Operatoren: = (gleich), <> (ungleich), < (kleiner), <= (kleiner 
+gleich), > (größer), >= (größer gleich) gibt es auch noch für Operanden vom 
+Datentyp REAL und TEXT. Da die Vergleichs-Operatoren ein BOOLesches Resultat 
+liefern, kann man sie in BOOLeschen Ausdrücken verwenden. Zu beachten ist 
+dabei die Priorität der Operatoren: die Vergleiche werden immer vor den 
+Operatoren AND bzw. OR ausgeführt. 
+ 
+ 
+Programm 12: 
+ 
+     BOOL CONST kaufen; 
+     kaufen := will ich AND NOT zu teuer. 
+ 
+     will ich: 
+        TEXT VAR produktname; 
+        get (produktname); 
+        produktname = "muesli" OR produktname = "vollkornbrot". 
+ 
+     zu teuer: 
+        INT VAR preis; 
+        get (preis); 
+        preis > 20. 
+ 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Welche BOOL-Werte ergeben sich? 
+ 
+     a) TRUE AND FALSE              e) TRUE AND TRUE OR TRUE 
+     b) TRUE OR FALSE               f) 10 < 3 AND 17 > 4 
+     c) TRUE AND NOT FALSE          g) 17 + 4 = 21 OR TRUE 
+     d) NOT TRUE AND FALSE          h) TRUE AND FALSE OR TRUE 
+ 
+     Übungsziel: Boolesche Ausdrücke 
+ 
+ 
+ 
+Abfragen 
+ 
+BOOLesche Ausdrücke werden in einer speziellen Anweisung verwandt, der 
+Abfrage: 
+ 
+ 
+Programm 13: 
+ 
+     INT VAR a, b; 
+     get (a); get (b); 
+     IF a > b 
+       THEN vertausche a und b 
+     END IF; 
+     put (a); put (b). 
+ 
+     vertausche a und b: 
+        INT CONST x :: a; 
+        a := b; 
+        b := x. 
+ 
+Das Refinement im THEN-Teil der bedingten Anweisung wird nur durchgeführt, 
+wenn der BOOLesche Ausdruck ('a > b') den Wert TRUE liefert. Liefert er den 
+Wert FALSE, wird die Anweisung, die der bedingten Anweisung folgt (nach END 
+IF), ausgeführt. Programm 13 kann etwas anders geschrieben werden: 
+ 
+ 
+Programm 14: 
+ 
+     INT VAR a, b; 
+     get (a); get (b); 
+     IF a > b 
+       THEN put (a); 
+            put (b) 
+       ELSE put (b); 
+            put (a) 
+     END IF. 
+ 
+Der THEN-Teil wird wiederum ausgeführt, wenn die BOOLesche Bedingung 
+erfüllt ist. Liefert sie dagegen FALSE, wird der ELSE-Teil ausgeführt. 
+ 
+Die bedingte Anweisung gibt uns also die Möglichkeit, abhängig von einer 
+Bedingung eine oder mehrere Anweisungen ausführen zu lassen. Dabei können 
+im THEN- bzw. ELSE-Teil wiederum bedingte Anweisungen enthalten sein usw. 
+Solche geschachtelten bedingten Anweisungen sollte man jedoch vermeiden, 
+weil sie leicht zu Fehlern führen können (statt dessen durch Refinements 
+realisieren). Man beachte auch die Einrückungen, die man machen sollte, um 
+die "Zweige" besonders kenntlich zu machen. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+       a) In welcher Reihenfolge werden Operatoren ausgewertet? 
+       b) Reihenfolge der Auswertung von: a + b + c 
+       c) INT VAR a, b, c; 
+          ... 
+          IF NOT a = 0 AND b = 0 THEN... 
+          ergibt einen syntaktischen Fehler. Welchen? 
+       d) Wie wird der BOOLesche Ausdruck ausgewertet? 
+          INT VAR a :: 0, b :: 4; 
+          ... 
+          IF a = 0 AND b DIV a > 0 
+       e) Warum ist 
+            BOOL VAR ende :: TRUE; 
+            ... 
+            IF ende = TRUE 
+              THEN... 
+          Unsinn? 
+ 
+       Übungsziel: Reihenfolge der Auswertung von Ausdrücken 
+ 
+Bei Abfrageketten kann das ELIF-Konstrukt eingesetzt werden. (ELIF ist eine 
+Zusammenziehung der Worte ELSE und IF). Anstatt 
+ 
+     ... 
+     IF bedingung1 
+       THEN aktion1 
+       ELSE IF bedingung2 
+              THEN aktion2 
+              ELSE aktion3 
+            END IF 
+     END IF; 
+     ... 
+ 
+kann man besser 
+ 
+     ... 
+     IF bedingung1 
+       THEN aktion1 
+     ELIF bedingung2 
+       THEN aktion2 
+       ELSE aktion3 END IF; 
+     ... 
+ 
+schreiben. 
+ 
+Die bedingte Anweisung kann auch einen Wert liefern. In diesem Fall muß der 
+ELSE-Teil vorhanden sein und jeder Zweig den gleichen Datentyp liefern 
+(jeweils die letzte Anweisung muß einen Wert liefern). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Was berechnen folgende (Teil-) Programme? 
+ 
+     a) INT VAR a; 
+        get (a); 
+        put (wert). 
+ 
+        wert: 
+          IF a < 0 
+             THEN -a 
+             ELSE a 
+          END IF. 
+ 
+     b) INT VAR brutto, netto; 
+        get (brutto); 
+        berechne gehalt; 
+        put ("mein gehalt:"); 
+        put (netto). 
+ 
+        berechne gehalt: 
+          IF jahresverdienst > 30 000 (* zu wenig? *) 
+            THEN sonderabgabe 
+          END IF; 
+          netto := brutto - brutto DIV 100 * 20. 
+ 
+        jahresverdienst: 
+          brutto * 12. 
+ 
+        sonderabgabe: 
+          brutto := brutto - brutto DIV 100 * 30 
+ 
+     c) INT VAR x; 
+        ... 
+        put (signum). 
+ 
+        signum: 
+          IF x > 0 
+             THEN 1 
+             ELSE kleiner gleich 
+          END IF. 
+ 
+        kleiner gleich: 
+           IF x = 0 
+              THEN 0 
+              ELSE -1 
+           END IF. 
+ 
+ 
+ 
+TEXTe 
+ 
+TEXT-Denoter haben wir bereits kennengelernt. Im folgenden Programm stellen 
+wir die Wirkung einiger TEXT-Operationen vor. 
+ 
+ 
+Programm 15: 
+ 
+     TEXT VAR a, b, c; 
+     a := "ELAN"; 
+     b := "-Programm"; 
+     c := a + b; 
+     put (c) 
+ 
+Der Operator 
+ 
+     TEXT OP + (TEXT CONST links, rechts) 
+ 
+liefert als Ergebnis einen TEXT, bei dem an den linken der rechte Operand 
+angefügt wurde (Fachausdruck: "Konkatenation"). Weitere Operatoren: 
+ 
+     TEXT OP CAT (TEXT VAR ziel, TEXT CONST dazu) 
+     TEXT OP *   (INT CONST i, TEXT CONST a) 
+     TEXT OP SUB (TEXT CONST t, INT CONST pos) 
+ 
+Der Operator CAT fügt an einen TEXT einen zweiten an ('a CAT b' wirkt wie 
+'a := a + b'). Mit dem '*'-Operator kann man einen TEXT vervielfältigen 
+(Beispiel: 17 * "--"), während man mit SUB ein Zeichen aus einem TEXT her- 
+ausholen kann (Beispiel: "ELAN" SUB 3 liefert "A"). 
+ 
+Die meisten TEXT-Operationen sind als Prozeduren realisiert, weil mehr als 
+zwei Operanden benötigt werden. Die Wirkung einiger Operationen geben wir in 
+kurzen Kommentaren an: 
+ 
+     TEXT PROC subtext (TEXT CONST t, INT CONST von) 
+     (* rechter Teiltext von 't' von der Position 'von' bis Ende *) 
+ 
+     TEXT PROC subtext (TEXT CONST t, INT CONST von, bis) 
+     (* Teiltext von 't' von der Position 'von' bis 'bis' *) 
+ 
+     PROC change (TEXT VAR t, TEXT CONST old, new) 
+     (* Ersetzung von 'old' in 'new' im TEXT 't' *) 
+ 
+     INT PROC length (TEXT CONST t) 
+     (* Anzahl Zeichen von 't' *) 
+ 
+     INT PROC pos (TEXT CONST t, muster) 
+     (* Die Position des ersten Auftretens von 'muster' in 't' *) 
+ 
+Die Vergleichs-Operatoren für TEXTe arbeiten bei dem Vergleich nach der 
+alphabetischen Reihenfolge ('"a" < "b"' liefert TRUE). Dabei definiert ELAN 
+nur die Reihenfolge innerhalb der kleinen und großen Buchstaben und Ziffern. 
+Das Leerzeichen ("#ib#blank#ie#") ist jedoch stets das "kleinste" Zeichen. 
+Wie diese "Zeichenblöcke" und die restlichen Zeichen angeordnet sind, wurde 
+nicht spezifiziert. Ob '"a" < "Z"' TRUE oder FALSE liefert, wurde also nicht 
+festgelegt und ist somit rechnerspezifisch. Anmerkung: Im EUMEL-Betriebs- 
+system wird der ASCII-Zeichencode, DIN 66 003 mit Erweiterungen verwandt. 
+Die folgenden Vergleiche sind alle TRUE: 
+ 
+     "otto" = "otto" 
+     "a" < "z" 
+     "Adam" < "Eva" 
+     "hallo" < "hallu" 
+     "hallo" < "hallo " 
+     length ("ha") = 2 
+     subtext ("ELAN-Programmierung", 14) = "ierung" 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Gib die Realisierung von folgenden vorgegebenen Prozeduren und Opera- 
+     toren an: 
+     a) TEXT PROC subtext (TEXT CONST t, INT CONST von)  durch 
+        TEXT PROC subtext (TEXT CONST t, INT CONST von, bis) 
+     b) OP CAT (TEXT VAR a, TEXT CONST b)  durch ':=' und '+' 
+     c) TEXT OP SUB (TEXT CONST t, INT CONST p)  durch 'subtext' 
+ 
+     Übungsziel: Lernen einiger vorgegebener TEXT-Operationen 
+ 
+ 
+ 
+Die Wiederholungs-Anweisung 
+ 
+Wiederholungs-Anweisungen ermöglichen es uns, Anweisungen wiederholt - meist 
+in Abhängigkeit von einer Bedingung - ausführen zu lassen. Darum wird die 
+Wiederholungs-Anweisung oft auch #ib#Schleife#ie# genannt, die in ihr ent- 
+haltenen Anweisungen #ib#Schleifenrumpf#ie#. Die Schleife von ELAN baut auf 
+einem Basis-Konstrukt auf: 
+ 
+     REP 
+       anweisungen 
+     END REP 
+ 
+Diese Anweisungsfolge realisiert eine sogenannte "Endlosschleife", weil nicht 
+spezifiziert wird, wann die Schleife beendet werden soll. 
+ 
+Bei der abweisenden Schleife wird die Abbruchbedingung an den Anfang der 
+Schleife geschrieben: 
+ 
+     WHILE boolesche bedingung REP 
+       anweisungen 
+     END REP 
+ 
+Bei jedem erneuten Durchlauf durch die Schleife wird überprüft, ob der 
+BOOLesche Ausdruck den Wert TRUE liefert. Ist das nicht der Fall, wird mit 
+der nächsten, auf die Schleife folgenden Anweisung mit der Bearbeitung fort- 
+gefahren. Die Schleife wird abweisende Schleife genannt, weil der Schleifen- 
+rumpf nicht ausgeführt wird, wenn die Bedingung vor Eintritt in die Schleife 
+bereits FALSE liefert. 
+ 
+Anders verhält es bei der nicht abweisenden Schleife: 
+ 
+     REP 
+        anweisungen 
+     UNTIL boolesche Bedingung END REP 
+ 
+Hier wird der Schleifenrumpf auf jeden Fall einmal bearbeitet. Am Ende des 
+Rumpfes wird die BOOLesche Bedingung abgefragt. Liefert diese den Wert FALSE, 
+wird die Schleife erneut abgearbeitet. Liefert die Bedingung den Wert TRUE, 
+wird die Schleife abgebrochen und mit der ersten Anweisung hinter der 
+Schleife in der Bearbeitung fortgefahren. 
+ 
+Bei beiden Arten der Wiederholungs-Anweisung ist es wichtig, daß Elemente 
+der BOOLeschen Bedingung in der Schleife verändert werden, damit das 
+Programm terminieren kann, d.h. die Schleife abgebrochen wird. 
+ 
+Eine Endlos-Schleife wird bei der Zählschleife meist nicht vorkommen: 
+ 
+     FOR i FROM anfangswert UPTO endwert REP 
+        anweisungen 
+     END REP 
+ 
+Zählschleifen werden eingesetzt, wenn die genaue Anzahl der Schleifendurch- 
+läufe bekannt ist. Hier wird eine Laufvariable verwendet (in unserem Bei- 
+spiel 'i': sie muß mit INT VAR deklariert werden), die die INT-Werte von 
+'anfangswert' bis 'endwert' in Schritten von '1' durchläuft. Diese Schleife 
+zählt "aufwärts". Wird anstatt UPTO das Schlüsselwort DOWNTO verwendet, wird 
+mit Schritten von -1 "abwärts" gezählt. Beispiel: 
+ 
+     FOR i FROM endwert DOWNTO anfangswert REP 
+        ... 
+ 
+Für ein Beispielprogramm stellen wir uns die Aufgabe, aus TEXTen das Auf- 
+treten des Buchstabens "e" herauszufinden. Die TEXTe sollen vom Eingabe- 
+medium solange eingelesen werden, bis wir den TEXT "00" eingeben. 
+ 
+ 
+Programm 16: 
+ 
+     INT VAR anzahl e :: 0; 
+     TEXT VAR wort; 
+     REP 
+        get (wort); 
+        zaehle e im wort 
+     UNTIL wort = "00" END REP; 
+     put (anzahl e). 
+ 
+     zaehle e im wort: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO length (wort) REP 
+           IF das i te zeichen ist e 
+             THEN anzahl e INCR 1 
+           END IF 
+        END REP. 
+ 
+     das i te zeichen ist e: 
+        (wort SUB i) = "e". 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Die Klammern in dem letzten Refinement sind notwendig. Warum? 
+ 
+Bevor wir ein Programm einem Rechner zur Bearbeitung übergeben, sollten wir 
+uns davon überzeugen, daß das Programm wirklich das leistet, was es soll. 
+Eine der wichtigsten Bedingungen ist die Terminierung eines Programms, d.h. 
+das Programm darf nicht in eine Endlosschleife geraten. Unser Beispielpro- 
+gramm terminiert, wenn beide Schleifen terminieren: die obere Schleife 
+terminiert durch das Endekriterium, während die zweite Schleife automatisch 
+durch die Zählschleife begrenzt wird. Das Programm wird also auf jeden Fall 
+beendet (kann in keine Endlosschleife geraten), falls das Endekriterium ein- 
+gegeben wird.  
+Interessant sind dabei immer "Grenzfälle", wie z.B. die Eingabe eines 
+"leeren Textes", sehr lange TEXTe usw. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Welche Fehler befinden sich in den folgenden Programmteilen? 
+     a) INT VAR i; 
+        FOR i FROM 1 UPTO i REP 
+          tue irgendwas 
+        END REP 
+ 
+     b) BOOL CONST noch werte :: TRUE; 
+        INT VAR i; 
+        WHILE noch werte REP 
+          get (i); 
+          ... 
+          IF i = O 
+             THEN noch werte := FALSE 
+          END IF 
+        END REP 
+ 
+     c) INT VAR anz berechnungen :: 1; 
+        REP 
+          lies eingabe wert; 
+          berechnung; 
+          drucke ausgabewert 
+        UNTIL anz berechnungen > 10 END REP. 
+ 
+     d) INT VAR anz berechnungen; 
+        WHILE anz berechnungen <= 10 REP 
+          lies eingabewert; 
+          berechnung; 
+          drucke ausgabewert; 
+          anz berechnungen INCR 1 
+       END REP. 
+ 
+    e) INT VAR n := 1, summe; 
+       summe der ersten 100 zahlen. 
+ 
+       summe der ersten 100 zahlen: 
+       WHILE n < 100 REP 
+         summe := summe + n; 
+         n INCR 1 
+       END REP. 
+      (* Achtung: 2 Fehler! (Vorwarnen ist feige) *) 
+ 
+    f) INT VAR n := 1; 
+       REP 
+         INT VAR summe := 0; 
+         summe := summe + n; 
+         n INCR 1 
+       UNTIL n = 100 END REP 
+       (* Achtung: 2 Fehler! *) 
+ 
+       Übungsziel: Arbeiten mit Schleifen 
+ 
+ 
+Das Programm 16 können wir etwas besser formulieren. Dazu wollen wir uns 
+aber eine etwas andere Aufgabe stellen: wie viele Leerzeichen sind in einem 
+Text? Zur Lösung dieser Aufgabe sollten wir den Text nicht wortweise ein- 
+lesen, sondern zeilenweise. Dazu verwenden wir die Prozedur  
+ 
+     PROC get (TEXT VAR t, INT CONST max length) 
+ 
+die einen TEXT 't' mit maximal 'max length' Zeichen einliest. Auf dem 
+EUMEL-System gibt es dafür auch die Prozedur 'getline'. 
+ 
+ 
+Programm 17: 
+ 
+     INT VAR anzahl blanks :: 0; 
+     REP 
+        lies zeile ein; 
+        zaehle blanks 
+     UNTIL zeile hat endekriterium END REP. 
+ 
+     lies zeile ein: 
+        TEXT VAR zeile; 
+        get (zeile, 80). 
+ 
+     zaehle blanks: 
+        INT VAR von :: 1; 
+        WHILE zeile hat ab von ein blank REP 
+           anzahl blanks INCR 1; 
+           von auf blank position setzen 
+        END REP. 
+ 
+     zeile hat ab von ein blank: 
+        pos (zeile, " ", von) > 0. 
+ 
+     von auf blank position setzen: 
+        von := pos (zeile, " ", von). 
+ 
+     zeile hat endekriterium: 
+        pos (zeile, "00") > 0. 
+ 
+ 
+Aufgabe (TSW): 
+ 
+     Das Programm 17 enthält (mindestens) zwei Fehler. Finden Sie diese bitte 
+     heraus. 
+ 
+     Übungsziel: Finden von Programmierfehlern. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+    a) Welche Werte liefern folgende Ausdrücke für die Textvariable 
+          TEXT VAR t :: "Das ist mein Text" 
+         a1) pos (t, "ist") 
+         a2) pos (t, "ist", 5) 
+         a3) length (t) 
+         a4) subtext (t, 14) 
+         a5) subtext (t, 14, 17) 
+ 
+    b) Welche Werte liefern folgende Ausdrücke für die Textkonstanten 
+         TEXT CONST text :: "ELAN-Programm", 
+                    alphabet :: "abcde...xyz" 
+         b1) 3 * text 
+         b2) length ("mein" + text + 3 * "ha") 
+         b3) 3 * "ha" < text 
+         b4) pos (text, alphabet SUB 1) 
+         b5) pos (text, subtext (alphabet, 7, 7)) 
+ 
+    c) Schreibe in anderer Form: 
+         c1) subtext (text, 7, 7) 
+         c2) change (text, "alt", "neu") 
+         c3) INT VAR laenge :: length (text); 
+             IF subtext (text, laenge, laenge) =... 
+         c4) IF NOT (text = "aha") 
+               THEN aktion 1 
+               ELSE aktion 2 
+             END IF 
+ 
+     Übungsziel: TEXT-Ausdrücke und Prozeduren 
+ 
+ 
+ 
+Die Repräsentation von Datentypen 
+ 
+Wie bereits erwähnt, sind Datentypen Klassen von Objekten der realen Umwelt. 
+Die Objekte eines Datentyps müssen in den Speicher eines Rechners abgebildet 
+werden. Die Darstellung eines Objekts im Rechner wird Repräsentation genannt. 
+Aus organisatorischen Gründen versucht man, immer feste, gleich große Ein- 
+heiten für die Objekte eines Datentyps zu verwenden. Durch die Begrenzung auf 
+feste Speicherplatzeinheiten ist der Wertebereich beschränkt. Diese Grenzen 
+hat man beim Programmieren zu beachten. 
+ 
+Beim Datentyp BOOL spielt die Repräsentation nur insoweit eine Rolle, daß 
+man die zwei möglichen Werte mehr oder weniger speicheraufwendig realisieren 
+kann. Eine Einschränkung des Wertebereichs gibt es nicht. 
+ 
+Bei INTs ist jedoch eine Einschränkung des Wertebereichs gegeben. Für die 
+Repräsentation von INTs sind Einheiten von 16, 32 Bit u.a.m. gebräuchlich. 
+Es existiert die Möglichkeit, den größten INT-Wert mit Hilfe von 
+ 
+     maxint 
+ 
+zu erfragen. Z.B. ist 'maxint' für EUMEL-Systeme z.Zt. 32 767. Der kleinste 
+INT-Wert ist oft nicht ' - maxint' (im EUMEL-System kann er unter 'minint' 
+angesprochen werden). Übersteigt ein Wert 'maxint', gibt es eine Fehler- 
+meldung 'overflow', im andern Fall 'underflow'. 
+ 
+REALs sind noch schwieriger. Durch die endliche Darstellung der Mantisse 
+treten "Lücken" zwischen zwei benachbarten REALs auf. Deshalb ist bei Ver- 
+wendung von REALs immer mit Repräsentationsfehlern zu rechnen. Dieses Thema 
+der "Rundungsfehler" wollen wir hier jedoch nicht weiter vertiefen. Auf 
+jeden Fall gibt es aber auch einen größten REAL-Wert 
+ 
+     maxreal 
+ 
+Bei TEXTen gibt es zwei Repräsentations-Schwierigkeiten. Einerseits werden 
+TEXTe durch "irgendeinen" Code im Rechner repräsentiert, der z.B. bei Ver- 
+gleichen verwendet wird. ELAN-Compiler auf Rechenanlagen mit unterschied- 
+lichen Zeichencodes können daher unterschiedliche Ergebnisse liefern. 
+Andererseits ist in ELAN nicht definiert, wie viele Zeichen maximal in einen 
+TEXT passen, was ebenfalls vom Rechner bzw. von einem ELAN-Compiler abhängt. 
+Auf dem EUMEL-System kann die maximale Anzahl Zeichen eines TEXTs durch 
+'maxtext length' erfragt werden. Sie ist z.Z. '32 000'. 
+ 
+ 
+ 
+Ein- und Ausgabe 
+ 
+Wie Datenobjekte - auf einfache Weise - auf einem Ausgabemedium ausgegeben 
+werden können, haben wir bereits geschildert (Prozedur 'put'). Die Ausgabe 
+erfolgt solange auf einer Zeile, bis ein auszugebender Wert nicht mehr auf 
+eine Zeile paßt. In diesem Fall wird die Ausgabe in die nächste Zeile pla- 
+ziert. Zwischen den einzelnen Werten auf einer Zeile wird jeweils ein Blank 
+Zwischenraum gelassen, um die Ausgaben voneinander zu trennen. Mit folgenden 
+Prozeduren kann man die Ausgabe flexibel gestalten: 
+ 
+     PROC line                       (* bewirkt einen Zeilenvorschub *) 
+ 
+     PROC line (INT CONST anzahl)    (* bewirkt 'anzahl' Zeilenvorschübe *) 
+ 
+     PROC page                       (* bewirkt einen Seitenvorschub auf 
+                                        einem Drucker oder löscht den Bild- 
+                                        schirm und positioniert in die linke 
+                                        obere Ecke *) 
+ 
+     PROC putline (TEXT CONST zeile) (* gibt 'zeile' auf dem Bildschirm aus 
+                                        und positioniert auf die nächste 
+                                        neue Zeile *) 
+ 
+     PROC cursor (INT CONST reihe, spalte) (* Positioniert die Schreibmarke 
+                                              auf dem Bildschirm in die an- 
+                                              gegebene Position *) 
+ 
+Die Prozedur 'get' holt Eingaben vom Eingabemedium. Ein Element der Eingabe 
+wird dabei durch ein Blank vom nächsten getrennt. Einige weitere Eingabe- 
+Prozeduren: 
+ 
+     PROC get (TEXT VAR t, TEXT CONST delimiter) (* die nächste Eingabe wird 
+                                                    nicht von einem Blank 
+                                                    begrenzt, sondern durch 
+                                                    'delimiter' *) 
+ 
+     TEXT PROC get                    (* dient zum Initialisieren *) 
+ 
+     PROC inchar (TEXT VAR zeichen)   (* wartet solange, bis ein Zeichen vom 
+                                         Bildschirm eingegeben wird *) 
+ 
+     TEXT PROC incharety              (* Versucht ein Zeichen vom Bildschirm 
+                                         zu lesen. Ist kein Zeichen vor- 
+                                         handen, wird "" geliefert *) 
+ 
+     PROC editget (TEXT VAR line)     (* Bei der Eingabe kann 'line' editiert 
+                                         werden *) 
+ 
+     PROC get cursor (INT VAR zeile, spalte) (* Informationsprozedur, wo die 
+                                                Schreibmarke aktuell steht *) 
+ 
+ 
+ 
+Konvertierungen 
+ 
+Manchmal ist es notwendig, eine Datentyp-Wandlung für ein Objekt vorzunehmen. 
+Die Wandlungen von einem INT- bzw. einen REAL-Wert in einen TEXT und umge- 
+kehrt sind relativ unkritisch: 
+ 
+     TEXT PROC text (INT  CONST value) 
+     TEXT PROC text (REAL CONST value) 
+     INT  PROC int  (TEXT CONST number) 
+     REAL PROC real (TEXT CONST number) 
+ 
+Aber bei der folgenden Prozedur 'int' gehen im allgemeinen Fall Informationen 
+verloren (es wird abgeschnitten): 
+ 
+     INT  PROC int  (REAL CONST value) 
+     REAL PROC real (INT  CONST value) 
+ 
+Zusätzlich steht eine Informationsprozedur 'last conversion ok' zur Ver- 
+fügung, die den Wert TRUE liefert, falls die letzte Konversion fehlerfrei 
+war: 
+ 
+     BOOL PROC last conversion ok 
+ 
+Solche Abfragen sind notwendig, weil die Konversionsroutinen bei falschen 
+Parameterwerten (z.B. 'int (maxreal)') nicht mit einer Fehlermeldung ab- 
+brechen. Als Beispiel zeigen wir ein Programm zum Einlesen von Werten, von 
+denen man  nicht weiß, ob sie INT oder REAL sind. Darum kann auch nicht die 
+'get'-Prozedur für INT oder REAL verwandt werden: 
+ 
+ 
+Programm 18: 
+ 
+     TEXT VAR eingabe element; 
+     REP 
+        get (eingabe element); 
+        wert nach intwert oder realwert bringen; 
+        berechnung 
+     UNTIL ende ENDREP. 
+ 
+     wert nach intwert oder realwert bringen: 
+     IF pos (eingabe element, ".") > 0 
+       THEN REAL VAR realwert :: real (eingabe element) 
+       ELSE INT  VAR intwert  :: int  (eingabe element) 
+     END IF; 
+     IF NOT last conversion ok 
+       THEN put ("Fehler bei Konvertierung:" + eingabe element); 
+            line 
+     END IF. 
+ 
+     berechnung: 
+     ... 
+ 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b
new file mode 100644
index 0000000..7fdaf39
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b
@@ -0,0 +1,1425 @@
+                     EUMEL-Benutzerhandbuch 
+ 
+ 
+                     TEIL 6: Erste Hilfe in ELAN                     
+ 
+Prozeduren 
+ 
+Prozeduren werden verwendet, wenn 
+ 
+- Anweisungen und Datenobjekte unter einem Namen zusammengefaßt werden 
+  sollen ("Abstraktion"). 
+ 
+- gleiche Anweisungen von mehreren Stellen eines Programms verwandt werden 
+  sollen (Codereduktion) u.U. mit verschieden Datenobjekten (Parameter); 
+ 
+- wenn Datenobjekte nur kurzfristig benötigt werden (dynamische Speicherver- 
+  waltung) und diese nicht von dem gesamten Programm angesprochen werden 
+  sollen (lokale, globale Datenobjekte); 
+ 
+Im folgenden Programm stellen wir ein Fragment vor, in dem zwei Werte ver- 
+tauscht werden. In der einen (linken) Lösung wird ein Refinement, in der 
+anderen eine Prozedur verwandt. 
+ 
+Programm 19: 
+ 
+     ...                            PROC vertausche a und b: 
+     IF a > b                          INT CONST x :: a; 
+       THEN vertausche a und b         a := b; 
+     END IF;                           b := x 
+     ...                            END PROC vertausche a und b; 
+     vertausche a und b;            ... 
+     ...                            IF a > b 
+                                      THEN vertausche a und b 
+     vertausche a und b:            END IF; 
+        INT CONST x :: a;           ... 
+        a := b;                     vertausche a und b; 
+        b := x.                     ... 
+ 
+Beim ersten Hinsehen leisten beide Programme das Gleiche. Es gibt jedoch 
+drei wichtige Unterschiede: 
+ 
+1) Das Refinement 'vertausche a und b' wird zweimal (vom ELAN-Compiler) 
+   eingesetzt, d.h. der Code ist zweimal vorhanden. Die Prozedur dagegen ist 
+   vom Code nur einmal vorhanden, wird aber zweimal - durch das Aufführen 
+   des Prozedurnamens - aufgerufen. 
+ 
+2) Die Variable 'x' ist in der linken Programmversion während des gesamten 
+   Ablauf des Programms vorhanden. Solche Datenobjekte nennt man statische 
+   Datenobjekte oder auch (aus Gründen, die erst etwas später offensichtlich 
+   werden) Paket-Objekte. Das Datenobjekt 'x' der rechten Version dagegen 
+   ist nur während der Bearbeitung der Prozedur vorhanden. Solche Daten- 
+   objekte, die nur kurzfristig Speicher belegen, werden dynamische Daten- 
+   objekte genannt. 
+ 
+   Prozeduren sind also ein Mittel, um die Speicherbelegung zu beeinflussen, 
+   was besonders bei großen Datenobjekten notwendig ist. 
+ 
+3) 'x' kann in der linken Programmversion - obwohl sie in einem Refinement 
+   deklariert wurde - von jeder Stelle des Programms angesprochen werden. 
+   Solche Datenobjekte werden globale Datenobjekte genannt. Das Datenobjekt 
+   'x' der Prozedur dagegen kann nur innerhalb der Prozedur angesprochen 
+   werden, sie ist also ein lokales Datenobjekt hinsichtlich der Prozedur. 
+   Innerhalb der Prozedur dürfen globale Datenobjekte (also Objekte, die 
+   außerhalb von Prozeduren deklariert wurden) angesprochen werden. 
+ 
+   Eine Prozedur in ELAN bildet im Gegensatz zu Refinements einen eigenen 
+   Gültigkeitsbereich hinsichtlich Datenobjekten und Refinements, die inner- 
+   halb der Prozedur deklariert werden. Prozeduren sind somit ein Mittel, um 
+   die in ihr deklarierten Datenobjekte hinsichtlich der Ansprechbarkeit 
+   nach Außen "abzuschotten". 
+ 
+Prozeduren wie die in Programm 19 werden mit dem Schlüsselwort PROC, dem 
+Namen der Prozedur und einem Doppelpunkt eingeleitet. Dies nennt man den 
+Prozedurkopf. Der Prozedurkopf entspricht den Definitionen, die wir bereits 
+in vorigen Abschnitten dieses Skripts gegeben haben. Nach dem Prozedurkopf 
+folgt der Prozedurrumpf, der Datenobjekt-Deklarationen, Anweisungen und 
+Refinements enthalten kann. Abgeschlossen wird die Prozedur durch END PROC 
+und dem Prozedurnamen. 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     a) Erkläre den Unterschied zwischen einer Prozedur und einem Refinement. 
+     b) Was sind globale bzw. lokale Datenobjekte? 
+Übungsziel: Begriffe, die mit Prozeduren zusammenhängen 
+ 
+ 
+Aufgabe (TSW): 
+ 
+     Gegeben sei folgendes Programmfragment: 
+        INT VAR a, b; 
+        ... (*1*) 
+        PROC x: 
+           INT VAR x1; 
+           ... (*2*) 
+        END PROC x; 
+        TEXT VAR t; 
+        PROC y: 
+           REAL VAR y1 
+           ... (*3*) 
+        END PROC y; 
+        ... (*4*) 
+ 
+     1.) Welche Objekte (einschließlich Prozeduren) sind an den Punkten 
+           (*1*) : 
+           (*2*) : 
+           (*3*) : 
+           (*4*) : 
+         ansprechbar? 
+ 
+     2.) Welche Datenobjekte sind in der Prozedur 'y' 
+         global: 
+         lokal: 
+Übungsziel: Globale und lokale Objekte 
+ 
+ 
+Prozeduren mit Parametern erlauben es, gleiche Anweisungen mit unterschied- 
+lichen Datenobjekten auszuführen: 
+ 
+ 
+Programm 20: 
+ 
+     PROC vertausche (INT VAR a, b): 
+        INT VAR x :: a; 
+        a := b; 
+        b := x 
+     END PROC vertausche; 
+ 
+     INT VAR eins :: 1, 
+             zwei :: 2, 
+             drei :: 3; 
+     vertausche (eins, zwei); 
+     vertausche (zwei, drei); 
+     vertausche (eins, zwei); 
+     put (eins); put (zwei); put (drei) 
+ 
+Die Datenobjekte 'a' und 'b' der Prozedur 'vertausche' werden formale Para- 
+meter genannt. Sie stehen als Platzhalter für die bei einem Prozeduraufruf 
+einzusetzenden aktuellen Parameter (in unserem Beispiel die Datenobjekte 
+'eins', 'zwei' und 'drei'). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Welche Werte werden in dem Programm 20 ausgedruckt? 
+Übungsziel: Arbeiten mit Prozeduren und Parameter-Mechanismus. 
+ 
+ 
+Parameter werden im Prozedurkopf nach dem Prozedurnamen in Klammern mit 
+Datentyp und Accessrecht angegeben. Dabei bedeutet CONST, daß auf den 
+Parameter nur lesend zugegriffen wird, während auf einen VAR-Parameter auch 
+z.B. eine Zuweisung angewandt werden kann. CONST-Parameter sind also 
+Eingabe-Parameter, während VAR-Parameter Ein-/Ausgabe-Parameter realisieren. 
+ 
+Bei den aktuellen Parametern ist folgendes zu beachten: 
+ 
+a) Wird ein VAR-Parameter in der Definition der Prozedur vorgeschrieben (wie 
+   z.B. im Programm 20), darf kein Ausdruck als aktueller Parameter "überge- 
+   ben" werden, weil an einen Ausdruck nichts zugewiesen werden kann. 
+   Gegenbeispiel: 
+ 
+     vertausche ( eins * zwei, drei) 
+ 
+   Ausdrücke haben - wie bereits erwähnt - das Accessrecht CONST. 
+ 
+b) Wird ein CONST-Parameter verlangt, dann darf in diesem Fall ein Ausdruck 
+   als aktueller Parameter geschrieben werden. Aber auch ein VAR-Datenobjekt 
+   darf angegeben werden. In diesem Fall wird eine Wandlung des Accessrechts 
+   (CONSTing) vorgenommen: der aktuelle Parameter erhält sozusagen für die 
+   Zeit der Abarbeitung der Prozedur das Accessrecht CONST. 
+ 
+Es ist auch möglich, Prozeduren als Parameter zu definieren, worauf wir aber 
+hier nicht eingehen wollen. 
+ 
+Eine Werte liefernde Prozedur erhält man, wenn der Prozedurrumpf einen Wert 
+liefert, d.h. die letzte ausführbare Anweisung des Prozedurrumpfes muß einen 
+Wert liefern (analog Werte liefernde Refinements) und der zu liefernde 
+Datentyp vor den Prozedurkopf geschrieben wird. 
+ 
+ 
+Programm 21: 
+ 
+     INT PROC max (INT CONST a, b): 
+        IF a > b 
+          THEN a 
+          ELSE b 
+        END IF 
+     END PROC max; 
+ 
+     put (max (3, 4)) 
+ 
+(In unserem Beispiel liefert die IF-Anweisung einen Wert. Das erfolgt da- 
+durch, daß beide Zweige der Anweisung einen Wert liefern.) 
+ 
+ 
+ 
+Neudefinierte Operatoren 
+ 
+Neue, zusätzliche Operatoren können in ELAN wie Prozeduren definiert werden. 
+Es ist nur notwendig, bei der Definition das Wort PROC gegen OP zu vertau- 
+schen. Es sind aber auch nur 1 oder 2 Parameter bei Operatoren erlaubt. 
+ 
+ 
+Programm 22a: 
+ 
+     TEXT OP * (INT CONST mal, TEXT CONST t): 
+        INT  VAR zaehler :: mal; 
+        TEXT VAR ergebnis :: ""; 
+        WHILE zaehler > 0 REP 
+          ergebnis := ergebnis + t; 
+          zaehler := zaehler - 1 
+        END REP; 
+        ergebnis 
+     END OP *; 
+ 
+Dieser Operator vervielfältigt TEXTe ( 2 * "ha" liefert "haha"). Der Name 
+des Operators ist '*'. Man kann als Operatornamen die vorhandenen, bereits 
+benutzten Sonderzeichen verwenden. In diesem Fall bekommt der neudefinierte 
+Operator die gleiche Priorität wie der bereits vorhandene oder ein Schlüssel- 
+wort. 
+ 
+Der "Aufruf" eines Operators unterscheidet sich von einer Prozedur durch die 
+infix-Schreibweise. Im übrigen gilt das für Prozeduren Gesagte. 
+ 
+ 
+ 
+Optimierungen 
+ 
+Optimierungen werden vorgenommen, wenn man mit den Laufzeiten bzw. Speicher- 
+bedarf eines Programms nicht zufrieden ist. Kleinere, lokale Optimierungen 
+sind meist nicht sinnvoll und notwendig und bringen mehr Fehler, als Ver- 
+besserungen: 
+ 
+ 
+Programm 22b: 
+ 
+     TEXT OP * (INT CONST mal, TEXT CONST t): 
+        INT  VAR i; 
+        TEXT VAR ergebnis :: ""; 
+        FOR i FROM 1 UPTO mal REP 
+          ergebnis CAT t 
+        END REP; 
+        ergebnis 
+     END OP *; 
+ 
+Wir haben hier die WHILE-Schleife durch eine Zählschleife und 'ergebnis := 
+ergebnis + t' durch 'ergebnis CAT t' ersetzt. Dies ist nur eine minimale 
+Optimierung (wenn sie überhaupt etwas einbringt). Leider sind solche 
+"Optimierungen" sehr häufig anzutreffen. Besser ist es, eine Lösung zu 
+finden, die algorithmisch oder von den Datenstrukturen her prinzipiell 
+besser ist. Wir haben dies für das Programm 22 getan. Lösungsidee: jeweilige 
+Verdopplung eines Zwischentextes ("Russische Multiplikation"). 
+ 
+ 
+Programm 22c: 
+ 
+     TEXT OP * (INT CONST mal, TEXT CONST t): 
+        INT  VAR zaehler :: mal; 
+        TEXT VAR einer :: "", 
+                 dopplung :: t; 
+        IF fehlerhafter aufruf 
+          THEN LEAVE * WITH "" 
+          ELSE verdopplung 
+        END IF; 
+        dopplung + einer. 
+ 
+        fehlerhafter aufruf: 
+          zaehler < 1. 
+ 
+        verdopplung: 
+          WHILE zaehler > 1 REP 
+            IF zaehler ist ungerade 
+              THEN einer CAT t 
+            END IF; 
+            dopplung CAT dopplung; 
+            zaehler := zaehler DIV 2 
+          END REP. 
+ 
+        zaehler ist ungerade: 
+          zaehler MOD 2 = 1. 
+ 
+     END OP *; 
+ 
+ 
+In diesem Programm wurde eine Anweisung verwendet (LEAVE), die wir im 
+folgenden Abschnitt erklären wollen. 
+ 
+ 
+ 
+Das LEAVE-Konstrukt 
+ 
+Das LEAVE-Konstrukt wird verwendet, um eine benannte Anweisung (Refinement, 
+Prozedur oder Operator) vorzeitig zu verlassen. Es ist auch möglich, mehr- 
+fach geschachtelte Refinements zu verlassen. Durch eine (optionale) 
+WITH-Angabe kann auch ein wertelieferndes Refinement verlassen werden. 
+ 
+ 
+ 
+Reihungen 
+ 
+Wir haben bis jetzt bereits zusammengesetzte algorithmische Objekte kennen- 
+gelernt, die man unter einem Namen als Ganzes ansprechen kann (Prozeduren). 
+Die gleiche Möglichkeit gibt es auch bei Datenobjekten, wobei wir gleich- 
+artige oder ungleichartige Objekte zu einem Objekt zusammenfassen können. 
+Zuerst zu der Zusammenfassung gleichartiger Datenobjekte, die in ELAN eine 
+Reihung (ROW) genannt wird. Die einzelnen Objekte einer Reihung werden 
+Elemente genannt. Beispiel (Deklaration einer Reihung von 10 INT-Elementen): 
+ 
+     ROW 10 INT VAR feld 
+ 
+Die Angabe hinter dem Schlüsselwort ROW muß ein INT-Denoter sein (oder 
+durch ein LET definierter Name). Dabei ist ROW 10 INT ein (neuer, von den 
+elementaren unterschiedlicher) Datentyp, für den keine Operationen definiert 
+sind, außer der Zuweisung. Das Accessrecht (VAR in unserem Beispiel) und der 
+Name ('feld') gilt - wie bei den elementaren Datentypen - für diesen neuen 
+Datentyp, also für alle 10 Elemente. 
+ 
+Warum gibt es keine Operationen außer der Zuweisung? Das wird uns sehr 
+schnell einsichtig, wenn wir uns vorstellen, daß es ja sehr viele Datentypen 
+(zusätzlich zu den elementaren) gibt, weil Reihungen von jedem Datentyp 
+gebildet werden können: 
+ 
+     ROW 1 INT             ROW 1 REAL 
+     ROW 2 INT             ROW 2 REAL 
+     :                     : 
+     ROW maxint INT        ROW maxint REAL 
+ 
+     ROW 1 TEXT            ROW 1 BOOL 
+     ROW 2 TEXT            ROW 2 BOOL 
+     :                     : 
+     ROW maxint TEXT       ROW maxint BOOL 
+ 
+Für die elementaren INT-, REAL-, BOOL- und TEXT-Datentypen sind 
+unterschiedliche Operationen definiert. Man müßte nun für jeden dieser 
+zusammengesetzten Datentypen z.B. auch 'get'- und 'put'-Prozeduren 
+schreiben, was allein vom Schreibaufwand sehr aufwendig wäre. Das ist der 
+Grund dafür, daß es keine vorgegebene Operationen auf zusammengesetzte 
+Datentypen gibt. 
+ 
+Zugegebenermaßen könnte man mit solchen Datentypen, die nur über eine Opera- 
+tion verfügen (Zuweisung), nicht sehr viel anfangen, wenn es nicht eine wei- 
+tere vorgegebene Operation gäbe, die #ib#Subskription#ie#. Sie erlaubt es, 
+auf die Elemente einer Reihung zuzugreifen und den Datentyp der Elemente 
+"aufzudecken". Beispiel: 
+ 
+     feld [3] 
+ 
+bezieht sich auf das dritte Element der Reihung 'feld' und hat den Datentyp 
+INT. Für INT-Objekte haben wir aber einige Operationen, mit denen wir 
+arbeiten können. Beispiele: 
+ 
+     feld [3] := 7; 
+     feld [4] := feld [3] + 4; 
+     ... 
+ 
+Eine Subskription "schält" also vom Datentyp ein ROW ab und liefert ein 
+Element der Reihung. Die Angabe der Nummer des Elements in der Reihung nennt 
+man Subskript (in unserem Fall '3'). Der Subskript wird in ELAN in eckigen 
+Klammern angegeben, um eine bessere Unterscheidung zu den runden Klammern in 
+Ausdrücken zu erreichen. Ein subskribiertes ROW-Datenobjekt kann also über- 
+all da verwendet werden, wo ein entsprechender Datentyp benötigt wird (Aus- 
+nahme: Schleifenvariable). Als Beispiel zeigen wir zwei Prozeduren, die eine 
+Reihung einlesen bzw. ausgeben: 
+ 
+ 
+Programm 23: 
+ 
+     PROC get (ROW 10 INT VAR feld): 
+        INT VAR i; 
+        FOR i FROM 1 UPTO 10 REP 
+          put (i); put ("tes Element bitte:"); 
+          get (feld [i]); 
+          line 
+        END REP 
+     END PROC get; 
+ 
+     PROC put (ROW 10 INT CONST feld): 
+        INT VAR i; 
+        FOR i FROM 1 UPTO 10 REP 
+          put (i); put ("tes Element ist:"); 
+          put (feld [i]); 
+          line 
+        END REP 
+     END PROC put 
+ 
+ 
+Wie bereits erwähnt, ist es erlaubt, Reihungen überall dort zu verwenden, wo 
+auch die elementaren Datentypen verwandt werden können, also auch als 
+Parameter. Zudem haben wir die generischen Eigenschaften von Prozeduren in 
+ELAN bei der Benennung der Prozeduren benutzt. 
+ 
+Diese beiden Prozeduren benutzen wir gleich im nächsten Programm, welches 
+10 Werte einliest und die Summe berechnet: 
+ 
+ 
+Programm 24: 
+ 
+     ROW 10 INT VAR werte; 
+     lies werte ein; 
+     summiere sie; 
+     drucke die summe und einzelwerte. 
+ 
+     lies werte ein: 
+        get (werte). 
+ 
+     summiere sie: 
+        INT VAR summe :: 0, i; 
+        FOR i FROM 1 UPTO 10 REP 
+          summe INCR werte [i] 
+        END REP. 
+ 
+     drucke die summe und einzelwerte: 
+        put (werte); 
+        line; 
+        put ("Summe:"); put (summe). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Wie kann man vermeiden, daß 'summe > maxint' ("overflow"-Bedingung) 
+     wird? 
+ 
+ 
+Oft benötigt man die Werte einer Reihung sortiert. Das Programm 25 zeigt 
+einen (sehr dummen und ineffizienten) Sortieralgorithmus: 
+ 
+ 
+Programm 25: 
+ 
+     ROW 10 INT VAR wert; 
+     lies die werte ein; 
+     sortiere in eine zweite liste; 
+     drucke die zweite liste. 
+ 
+     lies die werte ein: 
+        get (wert). 
+ 
+     sortiere in eine zweite liste: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO 10 REP 
+          suche kleinstes element aus der werte liste; 
+          bringe dieses in die zweite liste; 
+          entferne es aus der werte liste 
+        END REP. 
+ 
+     suche kleinstes element aus der werte liste: 
+     INT VAR kleinstes element :: maxint, position kleinstes element :: 0, k; 
+        FOR k FROM 1 UPTO 10 REP 
+          IF wert [k] < kleinstes element 
+            THEN kleinstes element := wert [k]; 
+                 position kleinstes element := k 
+          END IF 
+        END REP. 
+ 
+     bringe dieses in die zweite liste: 
+        ROW 10 INT VAR liste2; 
+        liste2 [i] := kleinstes element. 
+ 
+     entferne es aus der werte liste: 
+        wert [position kleinstes element] := maxint. 
+ 
+     drucke die zweite liste: 
+        put (liste2). 
+ 
+Anmerkung: Bei diesem einfachen Sortieralgorithmus (der übrigens "lineare 
+Auswahl" heißt), wurde der Wert 'maxint' als zulässiger Wert ausgeschlossen. 
+Der  Algorithmus ist ziemlich der schlechteste, den wir uns ausdenken können. 
+Einmal braucht er den doppelten Speicherplatz für die zu sortierende Liste, 
+andererseits sind für N Werte N*N Durchläufe durch die Liste notwendig (man 
+sagt, der Algorithmus ist von der Ordnung N Quadrat). 
+ 
+Da es möglich ist, von jedem Datentyp eine Reihung zu bilden, kann man 
+natürlich auch von einer Reihung eine Reihung bilden: 
+ 
+     ROW 5 ROW 10 INT VAR matrix 
+ 
+Für eine "doppelte" Reihung gilt das für "einfache" Reihungen gesagte. 
+Wiederum existieren keine Operationen für dieses Datenobjekt (außer der 
+Zuweisung), jedoch ist es durch Subskription möglich, auf die Elemente zuzu- 
+greifen: 
+ 
+     matrix [3] 
+ 
+liefert ein Datenobjekt mit dem Datentyp ROW 10 INT, für den wir bereits in 
+Programm 23 die Prozeduren 'get' und 'put' geschrieben haben, die wir 
+verwenden können: 
+ 
+     get (matrix [4]) 
+ 
+Subskribieren wir jedoch 'matrix' nochmals, so erhalten wir ein INT: 
+ 
+     matrix [2] [8] 
+ 
+(jede Subskription "schält" von Außen ein ROW vom Datentyp ab). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     a) Geben Sie Datentyp, Accessrecht und Name der folgenden Datenobjekte 
+        an: 
+           ROW 17 INT CONST alpha; 
+           ROW 3 ROW 4 TEXT VAR matrix; 
+           ... 
+           beta [3] := 7; 
+           gamma [4] := gamma [5] 
+ 
+     b) Was führt zu Fehlern? Wenn ja, warum? 
+           ROW 17 INT VAR alpha; 
+           ROW 3 ROW 4 TEXT VAR beta, gamma; 
+           ROW 4 ROW 3 TEXT CONST delta; 
+           INT VAR x :: 7; 
+           ROW x BOOL VAR y; 
+           get (alpha); 
+           get (beta [7]); 
+           FOR x FROM 1 UPTO 3 REP 
+             get (beta [x]) 
+           END REP; 
+           beta := delta; 
+           delta [1] [2] := "mist"; 
+           beta := gamma; 
+           beta [3] := gamma [3]; 
+           get (beta [1] [1]); 
+           gamma [1] [5] := beta [1] [1] + "ELAN" 
+           x := alpha [3]; 
+           x := 20; 
+           alpha [x] := alpha [3] + 7 
+Übungsziel: Umgang mit Reihungen 
+ 
+ 
+ 
+Strukturen 
+ 
+Strukturen sind Datenverbunde wie Reihungen, aber die Komponenten können 
+ungleichartige Datentypen haben. Die Komponenten von Strukturen heißen 
+Felder (bei Reihungen: Elemente) und der Zugriff auf ein Feld Selektion 
+(Reihungen: Subskription). Eine Struktur ist - genauso wie bei Reihungen - 
+ein eigener Datentyp, der in einer Deklaration angegeben werden muß. 
+Beispiel: 
+ 
+     STRUCT (TEXT name, INT alter) VAR ich 
+ 
+Wiederum existieren keine Operationen auf Strukturen außer der Zuweisung und 
+der Selektion, die es erlaubt, Komponenten aus einer Struktur herauszulösen: 
+ 
+     ich . name 
+     ich . alter 
+ 
+Die erste Selektion liefert einen TEXT-, die zweite ein INT-Datenobjekt. Mit 
+diesen (selektierten) Datenobjekten kann - wie gewohnt - gearbeitet werden 
+(Ausnahme: nicht als Schleifenvariable). 
+ 
+Zum Datentyp einer Struktur gehören auch die Feldnamen: 
+ 
+     STRUCT (TEXT produkt name, INT artikel nr) VAR erzeugnis 
+ 
+ist ein anderer Datentyp als im ersten Beispiel dieses Abschnitts. Für 
+Strukturen - genauso wie bei Reihungen - kann man sich neue Operationen 
+definieren. Im folgenden Programm definieren wir für eine Struktur, die 
+Personen beschreibt, die Operationen 'put', 'get' und den dyadischen 
+Operator HEIRATET. Anschließend werden drei Paare verHEIRATET. 
+ 
+ 
+Programm 26a: 
+ 
+     PROC get (STRUCT (TEXT name, vorname, INT alter) VAR p): 
+        put ("bitte Nachname:"); get ( p.name); 
+        put ("bitte Vorname:");  get ( p.vorname); 
+        put ("bitte Alter:");    get ( p.alter); 
+        line 
+     END PROC get; 
+ 
+     PROC put (STRUCT (TEXT name, vorname, INT alter) CONST p): 
+        put (p.vorname); put (p.name); 
+        put ("ist"); 
+        put (p.alter); 
+        put ("Jahre alt"); 
+        line 
+     END PROC put; 
+ 
+     OP HEIRATET 
+        (STRUCT (TEXT name, vorname, INT alter) VAR w, 
+         STRUCT (TEXT name, vorname, INT alter) CONST m): 
+        w.name := m.name 
+     END OP HEIRATET; 
+ 
+     ROW 3 STRUCT (TEXT name, vorname, INT alter) VAR frau, mann; 
+ 
+     personendaten einlesen; 
+     heiraten lassen; 
+     paardaten ausgeben. 
+ 
+     personendaten einlesen: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO 3 REP 
+          get (frau [i]); 
+          get (mann [i]) 
+        END REP. 
+ 
+     heiraten lassen: 
+        FOR i FROM 1 UPTO 3 REP 
+          frau [i] HEIRATET mann [i] 
+        END REP. 
+ 
+     paardaten ausgeben: 
+        FOR i FROM 1 UPTO 3 REP 
+          put (frau [i]); 
+          put ("hat geheiratet:"); line; 
+          put (mann [i]); line 
+        END REP. 
+ 
+Reihungen und Strukturen dürfen miteinander kombiniert werden, d.h. es darf 
+eine Reihung in einer Struktur erscheinen oder es darf eine Reihung von einer 
+Struktur vorgenommen werden. Selektion und Subskription sind in diesen Fällen 
+in der Reihenfolge vorzunehmen, wie die Datentypen aufgebaut wurden (von 
+außen nach innen). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     In ELAN heissen 
+        a1) Datenverbunde gleichartiger Komponenten: 
+        a2) Datenverbunde ungleichartiger Komponenten: 
+        b1) die Komponenten eines ROWs: 
+        b2) die Komponenten eines STRUCTs: 
+        c1) die Zugriffe auf die Komponenten eines ROWs: 
+        c2) die Zugriffe auf die Komponenten eines STRUCTs: 
+Übungsziel: Begriffe von ROWs und STRUCTs kennenlernen 
+ 
+ 
+ 
+LET-Konstrukt 
+ 
+Wie wir in Programm 26 gesehen haben, ist die Verwendung von Strukturen 
+oder auch Reihungen manchmal schreibaufwendig. Mit dem LET-Konstrukt darf 
+man Datentypen (und Denotern) einen Namen geben. Dieser Name steht als 
+Abkürzung und verringert so die Schreibarbeit. Zusätzlich wird durch die 
+Namensgebung die Lesbarkeit des Programms erhöht. Beispiel: 
+ 
+ 
+Programm 26b: 
+ 
+     LET PERSON = STRUCT (TEXT name, vorname, INT alter); 
+ 
+     PROC get (PERSON VAR p): 
+        put ("bitte Nachname:"); get ( p.name); 
+        put ("bitte Vorname:");  get ( p.vorname); 
+        put ("bitte Alter:");    get ( p.alter); 
+        line 
+     END PROC get; 
+ 
+     PROC put (PERSON CONST p): 
+        put (p.vorname); put (p.name); put ("ist"); 
+        put (p.alter);   put ("Jahre alt"); line 
+     END PROC put; 
+ 
+     OP HEIRATET (PERSON VAR f, PERSON CONST m): 
+        f.name := m.name 
+     END OP HEIRATET; 
+ 
+     ROW 3 PERSON VAR mann, frau; 
+     ... 
+ 
+Überall wo der abzukürzende Datentyp verwandt werden kann, kann PERSON 
+benutzt werden. Wohlgemerkt: PERSON ist kein neuer Datentyp, sondern nur ein 
+Name, der für STRUCT (....) steht. Der Zugriff auf die Komponenten des 
+abgekürzten Datentyps bleibt erhalten (was bei abstrakten Datentypen, die wir 
+etwas später erklären, nicht mehr der Fall ist). 
+ 
+Neben der Funktion der Abkürzung von Datentypen kann das LET-Konstrukt 
+auch für die Namensgebung für die Denoter verwandt werden. Beispiele: 
+ 
+     LET pi = 3.14159; 
+     LET blank = " "; 
+     LET anzahl = 27 
+ 
+Der Einsatz von LET-Namen für INT-Denoter macht es möglich, Programme 
+leicht zu ändern: 
+ 
+ 
+Programm 26c: 
+ 
+     LET anzahl paare = 3; 
+     ROW anzahl paare PERSON VAR frau, mann; 
+ 
+     personendaten einlesen; 
+     heiraten lassen; 
+     paardaten ausgeben. 
+ 
+     personendaten einlesen: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO anzahl paare REP 
+          get (frau [i]); 
+          get (mann [i]) 
+        END REP. 
+     ... 
+ 
+Ebenso wie die Abkürzung von Datentypen (LET PERSON = STRUCT (...)) wird 
+im obigen Beispiel für den Namen 'anzahl paare' bei jedem Auftreten der 
+Denoter '3' vom ELAN-Compiler eingesetzt. Um nun (z.B.) 27 Paare "heiraten" 
+zu lassen, brauchen wir nur die LET-Anweisung in '27' zu verändern... 
+(Scheidungen erfordern etwas mehr Aufwand). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Was ist falsch? 
+        LET anz = 5, 
+            max = 5*5, 
+            MAT = ROW anz ROW anz TEXT; 
+ 
+        PROC get (MAT CONST m): 
+           FOR i FROM 1 UPTO max REP 
+             get (m [i]) 
+           END REP 
+        END PROC get; 
+ 
+        MAT VAR x,y; 
+        get (x); 
+        x := y + 1 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Schreibe ein Programm, das mit den Deklarationen 
+        LET anz = 5, 
+            VEC = ROW anz INT, 
+            MAT = ROW anz VEC; 
+     folgende Prozeduren realisiert: 
+        PROC get (VEC VAR v) 
+        PROC get (MAT VAR m) 
+        PROC put (VEC CONST v) 
+        PROC put (MAT CONST m) 
+        INT PROC reihensumme (VEC CONST v) 
+Übungsziel: Reihungen als Parameter 
+ 
+ 
+ 
+Denoter für Datenverbunde: Konstruktoren 
+ 
+Denoter für die elementaren Datentypen haben wir kennengelernt. Oft ergibt 
+sich auch die Notwendigkeit (z.B. bei Initialisierungen), Datenverbunde in 
+einem Programm Werte zu geben. Das kann durch normale Zuweisungen erfolgen. 
+Beispiel: 
+ 
+     LET PERSON = STRUCT (TEXT name, vorname, INT alter); 
+ 
+     PERSON VAR mann; 
+ 
+     mann.name := "meier"; 
+     mann.vorname := "egon"; 
+     mann.alter := 27 
+ 
+Aber man möchte auch Denoter für Datenverbunde z.B. in Ausdrücken verwenden, 
+was durch die Konstruktoren ermöglicht wird. Beispiel: 
+ 
+     LET PERSON = STRUCT (TEXT name, vorname, INT alter); 
+ 
+     PERSON VAR mann, frau; 
+ 
+     frau := PERSON : ( "niemeyer", "einfalt", 65); 
+     frau HEIRATET PERSON : ( "meier", "egon", 27) 
+ 
+Ein Konstruktor ist also ein Mechanismus, um ein Datenobjekt eines Datenver- 
+bundes in einem Programm zu notieren. Ein Konstruktor besteht aus der Angabe 
+des Datentyps (der auch durch einen LET-Namen abgekürzt sein darf), einem 
+Doppelpunkt und den in Klammern eingefaßten Komponenten (hier Denoter). 
+Besteht eine der Komponenten wiederum aus einem Datenverbund, muß inner- 
+halb des Konstruktors wiederum ein Konstruktor eingesetzt werden usw. Kon- 
+struktoren sind natürlich für Reihungen auch möglich: 
+ 
+     ROW 7 INT VAR feld; 
+     feld := ROW 7 INT : ( 1, 2, 3, 4, 5, 6, 7); 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Geben Sie Datentyp, Accessrecht und Name der folgenden Datenobjekte an: 
+        STRUCT (INT alter, TEXT name) VAR mensch; 
+        STRUCT (INT jahrgang, ROW 2 TEXT lage) CONST wein; 
+        ROW 100 STRUCT (PERSON p, NUMMER n) VAR betriebsangehoeriger; 
+        STRUCT (INT anz terminals, STRUCT (TEXT systemname, INT version) art) 
+                                                         CONST betriebsystem; 
+        mensch := ...; 
+        betriebsangehoeriger [2] := ...; 
+        betriebsangehoeriger [2]. n := NUMMER: (...); 
+        betriebsystem.art.systemname := "EUMEL"; 
+        wein.lage := ROW 2 TEXT: ("Loire", "Frankreich"); 
+        wein.lage [1] := "Kroever Nacktarsch"; 
+Übungsziel: Umgang mit Strukturen. 
+ 
+ 
+ 
+Rekursive Prozeduren und Operatoren 
+ 
+Alle Prozeduren und Operatoren dürfen in ELAN rekursiv sein. 
+ 
+ 
+Programm 27: 
+ 
+     INT PROC fakultaet (INT CONST n): 
+        IF n > 0 
+          THEN fakultaet (n-1) * n 
+          ELSE 1 
+        END IF 
+     END PROC fakultaet 
+ 
+Dieses Beispiel ist aber (leider) kein gutes Beispiel für eine Rekursion, 
+denn das Programm kann leicht in eine iterative Version umgewandelt werden: 
+ 
+ 
+Programm 28: 
+ 
+     INT PROC fakultaet (INT CONST n): 
+        INT VAR prod :: 1, i; 
+        FOR i FROM 2 UPTO n REP 
+          prod := prod * i 
+        END REP; 
+        prod 
+     END PROC fakultaet 
+ 
+Die Umwandlung von einem rekursiven Programm in ein iteratives ist übrigens 
+immer möglich, jedoch oft nicht so einfach wie in diesem Fall. Beispiel 
+(Ackermann-Funktion): 
+ 
+ 
+Programm 29: 
+ 
+     INT PROC acker (INT CONST m, n): 
+        IF m = 0 
+          THEN n + 1 
+        ELIF n = 0 
+          THEN acker (m-1, 0) 
+          ELSE acker (m - 1, acker (m, n - 1)) 
+        ENDIF 
+     END PROC acker 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     a) Beschreibe die Unterschiede zwischen Iteration und Rekursion. Worauf 
+        muß man bei Rekursionen achten? 
+     b) Wie groß ist der Wert von 'acker (2, 2)'? Hilfreicher Tip: stelle 
+        dabei eine Tabelle auf! 
+     c) Zudem enthält die Programmierung der Ackermann-Funktion (mindestens) 
+        einen Fehler. Welchen? 
+Übungsziel: Umgang mit Rekursion 
+ 
+ 
+Das eigentliche Einsatzgebiet von rekursiven Algorithmen liegt aber bei den 
+'backtrack'-Verfahren. Diese werden eingesetzt, wenn eine exakte algorithmi- 
+sche Lösung nicht bekannt ist oder nicht gefunden werden kann und man ver- 
+schiedene Versuche machen muß, um zu einem Ziel (oder Lösung) zu gelangen. 
+ 
+Als Beispielprogramm zeigen wir das Spiel "Maus sucht Käse". In einem Laby- 
+rinth (realisiert durch eine Reihung von einer Reihung), das mit Hindernis- 
+sen bestückt ist, wurde ein Käse versteckt. Eine sehr dumme Maus sucht 
+systematisch die umliegenden Felder (in allen vier Himmelsrichtungen) nach 
+dem Käse ab. Ist sie auf einem neuen Feld und ist das Feld frei, sucht sie 
+erneut. Felder, auf denen sie bereits war, werden von ihr markiert. Da die 
+Maus sehr kurzsichtig ist und nicht richtig riechen kann, bemerkt sie den 
+Käse erst, wenn sie sozusagen mit allen vier Pfoten in ihm gelandet ist 
+(analog bei Hindernissen, die nicht überklettert werden können). Damit die 
+Maus nicht aus dem Labyrinth entfliehen kann, wird der Rand als Hindernis 
+angesehen. 
+ 
+ 
+(Teil-) Programm 30: 
+ 
+     PROC suche weg (INT CONST x, y): 
+        IF labyrinth [x] [y] = kaese 
+          THEN kaese gefunden 
+        ELIF labyrinth [x] [y] = frei 
+          THEN suche weiter 
+        END IF. 
+ 
+        suche weiter: 
+           labyrinth [x] [y] := markiert; 
+           INT VAR richtung; 
+           FOR richtung FROM osten UPTO sueden REP 
+             versuche diese richtung 
+           END REP; 
+           labyrinth [x] [y] := frei. 
+ 
+        versuche diese richtung: 
+           IF richtung = osten 
+             THEN suche weg (x + 1, y) 
+           ELIF richtung = norden 
+             THEN suche weg (x, y + 1) 
+           ... 
+ 
+ 
+ 
+Dateien 
+ 
+Dateien werden benötigt, wenn 
+ 
+- Daten über die Abarbeitungszeit eines Programms aufbewahrt werden sollen; 
+- der Zeitpunkt oder Ort der Datenerfassung nicht mit dem Zeitpunkt oder Ort 
+  der Datenverarbeitung übereinstimmt; 
+- die gesamte Datenmenge nicht auf einmal in den Zentralspeicher eines 
+  Rechners paßt; 
+- die Anzahl und/oder Art der Daten nicht von vornherein bekannt sind. 
+ 
+Eine Datei ("file") ist eine Zusammenfassung von Daten, die auf Massenspei- 
+chern aufbewahrt wird. Dateien sind in bestimmten Informationsmengen, den 
+Sätzen ("records") organisiert. 
+ 
+In ELAN gibt es zwei Arten von Dateien: 
+ 
+a) FILE: sequentielle Dateien. Die Sätze können nur sequentiell gelesen bzw. 
+   geschrieben werden. Eine Positionierung ist nur zum nächsten Satz möglich. 
+b) DIRFILE: indexsequentielle Dateien. Die Positionierung erfolgt direkt mit 
+   Hilfe eines Schlüssels ("key") oder Index, kann aber auch sequentiell 
+   vorgenommen werden. 
+ 
+   Wichtig: 
+   DIRFILEs sind auf dem EUMEL-System nicht implementiert! Deswegen wird 
+   auf diesen Dateityp hier nicht weiter eingegangen. 
+ 
+Dateien werden normalerweise von dem #ib#Betriebsystem#ie# eines Rechners 
+aufbewahrt und verwaltet. Somit ist eine Verbindung von einem ELAN-Programm, 
+in dem eine Datei unter einem Namen - wie jedes andere Datenobjekt auch - 
+angesprochen werden soll, und dem Betriebsystem notwendig. Dies erfolgt durch 
+sogenannte Assoziierungsprozeduren. Beispiele: 
+ 
+     FILE VAR meine datei :: sequential file (output, "xyz"); 
+     FILE CONST eine andere datei :: sequential file (input, "abc") 
+ 
+Die Assoziierungsprozedur heißt 'sequential file' für FILEs. Der erste 
+Parameter einer Assoziierungsprozedur gibt immer die sogenannte Betriebs- 
+richtung ("TRANSPUTDIRECTION") an. Es gibt folgende Betriebsrichtungen: 
+ 
+   input       nur Lesen der Datei 
+   output      nur Schreiben der Datei 
+ 
+   Anmerkung: 
+   Im EUMEL-System gibt es noch die Betriebsrichtung 'modify', die es er- 
+   laubt, beliebig zu positionieren, Sätze zu löschen und/oder einzufügen 
+   usw. Dafür gibt es keine DIRFILEs. Siehe dazu auch das Kapitel über 
+   Dateien in diesem Benutzerhandbuch. 
+ 
+Der zweite Parameter einer Assoziierungsprozedur gibt an, unter welchem 
+Namen die Datei in dem Betriebsystem bekannt ist. Mit Hilfe dieses Namens 
+wird die Datei an das Datenobjekt gekoppelt, das bei der FILE-Deklaration im 
+Programm erzeugt wurde. 
+ 
+Welche Operationen sind nun für Dateien zugelassen? Wir beschreiben die 
+wichtigsten für die beiden Dateiarten und Betriebsrichtungen getrennt: 
+ 
+a) FILE mit 'input' (nur lesen): 
+ 
+   PROC getline (FILE CONST f, TEXT VAR zeile) 
+   PROC get (FILE CONST f, TEXT VAR t) 
+   PROC get (FILE CONST f, REAL VAR r) 
+   PROC get (FILE CONST f, INT VAR i) 
+   BOOL PROC eof (FILE CONST f) 
+   (* Abfrageprozedur auf das Ende eines FILEs (letzter Satz) *) 
+ 
+   Als Beispiel zeigen wir ein Programm, welches eine Datei liest und auf 
+   dem Ausgabemedium ausgibt. 
+ 
+ 
+   Programm 31: 
+ 
+     FILE CONST f :: sequential file (input, "datei1"); 
+     TEXT VAR satz; 
+     WHILE NOT eof (f) REP 
+        getline (f, satz); 
+        put (satz); line 
+     END REP. 
+ 
+b) FILE mit 'output' (nur schreiben): 
+ 
+   PROC putline (FILE VAR f, TEXT CONST zeile) 
+   PROC put     (FILE VAR f, TEXT CONST t) 
+   PROC put     (FILE VAR f, REAL CONST r) 
+   PROC put     (FILE VAR f, INT  CONST i) 
+   PROC line    (FILE VAR f, INT  CONST zeilenzahl) 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     a) Das Arbeiten mit Dateien ist manchmal notwendig, weil ... 
+     b) Wenn man mit Dateien in ELAN arbeitet, sind Assoziierungsprozeduren 
+        notwendig. 
+        b1) Wie heißen diese? 
+        b2) Was gibt man in diesen an? 
+     c) Welche Betriebsrichtungen gibt es bei FILES und was bewirken sie? 
+Übungsziel: Datei-Begriffe 
+ 
+ 
+Aufgabe (TSW): 
+ 
+     Welche Fehler befinden sich in den folgenden Programmfragmenten? 
+     a) FILE VAR f :: sequential file (input, "MIST"); 
+        TEXT VAR zeile; 
+        REP 
+          getline (f, zeile); 
+          ... 
+        UNTIL eof (f) END REP 
+ 
+     b) FILE VAR f :: sequential file (output, "NOCHMAL"); 
+        TEXT VAR zeile; 
+        REP 
+          getline (f, zeile); 
+          put (zeile) 
+        UNTIL eof (f) END REP 
+ 
+     c) FILE VAR f :: sequential file (input, "VERDAMMT"), 
+                 g :: sequential file (input, "DAEMLICH"); 
+        TEXT VAR zeile; 
+        kopiere g in f. 
+ 
+        kopiere g in f: 
+        FOR i FROM 1 UPTO 100 REP 
+          getline (g, zeile); 
+          putline (f, zeile) 
+        UNTIL eof (g) END REP. 
+Übungsziel: Arbeiten mit Dateien 
+ 
+ 
+ 
+Programmstruktur 1 
+ 
+Bis jetzt haben wir noch nicht vollständig erklärt, wie ein ELAN-Programm 
+formal als Ganzes aufgebaut sein muß, d.h. wie und in welcher Reihenfolge 
+die Anweisungen, Refinements, Prozeduren und Deklarationen geschrieben 
+werden müssen. 
+ 
+Ein ELAN-Programm kann aus mehreren Moduln (Bausteinen) aufgebaut sein, 
+die in ELAN PACKETs genannt werden. Das letzte PACKET wird "main packet" 
+genannt, weil in diesem das eigentliche Benutzerprogramm (Hauptprogramm) 
+enthalten ist. In diesem Abschnitt wollen wir uns nur mit dem Aufbau eines 
+solchen PACKETs beschäftigen. Wir werden dabei nicht alle Möglichkeiten 
+besprechen, sondern nur die wichtigsten Anwendungen beschreiben, mit einer 
+Empfehlung, in welcher Reihenfolge die Elemente geschrieben werden sollten. 
+ 
+Ein "main packet" kann aus folgenden Elementen bestehen: 
+ 
+a) Deklarationen und Anweisungen. Diese müssen nicht in einer bestimmten 
+   Reihenfolge im Programm erscheinen, sondern es ist möglich, erst in dem 
+   Augenblick zu deklarieren, wenn z.B. eine neue Variable benötigt wird. Es 
+   ist jedoch gute Programmierpraxis, die meisten Deklarationen an den 
+   Anfang eines Programms (außer z.B. Datenobjekte, die nur lokal oder 
+   kurzfristig benötigt werden, wie Hilfsvariablen oder Laufvariablen) zu 
+   plazieren. 
+ 
+     <Deklarationen> ; 
+     <Anweisungen> 
+ 
+b) Deklarationen, Refinements und Anweisungen. In diesem Fall ist es notwen- 
+   dig, die Refinements hintereinander zu plazieren. Refinement-Aufrufe 
+   und/oder Anweisungen sollten textuell vorher erscheinen. Die Refinements 
+   werden durch einen Punkt von den Aufrufen getrennt: 
+ 
+     <Deklarationen> ; 
+     <Refinement-Aufrufe und/oder Anweisungen> . 
+     <Refinements> 
+ 
+   Innerhalb der Refinements sind Anweisungen und/oder Deklarationen möglich. 
+ 
+c) Deklarationen, Prozeduren und Anweisungen. Werden Prozeduren vereinbart, 
+   sollte man sie nach den Deklarationen plazieren. Danach sollten die 
+   Anweisungen folgen: 
+ 
+     <Deklarationen> ; 
+     <Prozeduren> ; 
+     <Anweisungen> 
+ 
+   Mehrere (parallele) Prozeduren werden durch ";" voneinander getrennt. In 
+   diesem Fall sind die Datenobjekte aus den Deklarationen außerhalb von 
+   Prozeduren statisch, d.h. während der gesamten Laufzeit des Programm 
+   vorhanden. Solche Datenobjekte werden auch PACKET-Daten genannt.Im 
+   Gegensatz dazu sind die Datenobjekte aus Deklarationen in Prozeduren 
+   dynamische Datenobjekte, die nur während der Bearbeitungszeit der 
+   Prozedur existieren. Innerhalb einer Prozedur dürfen wiederum Refinements 
+   verwendet werden. Ein Prozedur-Rumpf hat also den formalen Aufbau wie 
+   unter a) oder b) geschildert. 
+ 
+   Die Refinements und Datenobjekte, die innerhalb einer Prozedur deklariert 
+   wurden, sind lokal zu dieser Prozedur, d.h. können von außerhalb nicht 
+   angesprochen werden. 
+ 
+d) Deklarationen, Prozeduren, Anweisungen und PACKET-Refinements. 
+   Zusätzlich zu der Möglichkeit c) ist es erlaubt, neben den Anweisungen 
+   außerhalb einer Prozedur auch Refinements zu verwenden: 
+ 
+     <Deklarationen> ; 
+     <Prozeduren> ; 
+     <Anweisungen> . 
+     <Refinements> 
+ 
+   Diese Refinements können nun in Anweisungen außerhalb der Prozeduren 
+   benutzt werden oder auch durch die Prozeduren (im letzteren Fall spricht 
+   man analog zu globalen PACKET-Daten auch von PACKET-Refinements oder 
+   globalen Refinements). In PACKET-Refinements dürfen natürlich keine 
+   Datenobjekte verwandt werden, die lokal zu einer Prozedur sind. 
+ 
+ 
+ 
+Moduln (PACKETs) 
+ 
+PACKETs sind in ELAN eine Zusammenfassung von Datenobjekten, Prozeduren/ 
+Operatoren und Datentypen. Man kann sich ein PACKET als ein 'main packet' 
+mit Zusätzen vorstellen. PACKETs können separat übersetzt werden, so 
+daß der "Zusammenbau" eines umfangreichen Programms aus mehreren PACKETs 
+möglich ist. 
+ 
+Elemente eines PACKETs (Prozeduren/Operatoren, Datentypen) können außerhalb 
+des PACKETs nur angesprochen werden, wenn sie in der Schnittstelle des 
+PACKETs, die auch "interface" genannt wird, aufgeführt wird. Mit anderen 
+Worten: es können alle Elemente eines PACKETs von außen nicht angesprochen 
+werden, sofern sie nicht über die Schnittstelle "nach außen gereicht" wird. 
+Damit wird gewährleistet, daß mehrere Programmierer an einem gemeinsamen 
+Projekt arbeiten können und daß eine gemeinsame Benutzung (oder Störung) von 
+Programmteilen nur über die in den Schnittstellen von PACKETs aufgeführten 
+Objekte erfolgen kann. 
+ 
+Im Gegensatz zu einer Prozedur kann ein PACKET nicht aufgerufen werden (nur 
+die Elemente der Schnittstelle können benutzt werden). Beispiel: 
+ 
+ 
+Programm 32: 
+ 
+     PACKET fuer eine prozedur DEFINES swap: 
+ 
+     PROC swap (INT VAR a, b): 
+        INT CONST x :: a; 
+        b := a; 
+        a := x 
+     END PROC swap 
+ 
+     END PACKET fuer eine prozedur 
+ 
+Dies ist ein PACKET, das eine Tausch-Prozedur für INT-Datenobjekte bereit- 
+stellt. Das PACKET kann übersetzt werden und dem ELAN-Compiler bekannt 
+gemacht werden (EUMEL: "insertieren"). Ist das geschehen, kann man 'swap' 
+wie alle anderen Prozeduren (z.B. 'put', 'get') in einem Programm verwenden. 
+Tatsächlich werden die meisten Prozeduren und Operatoren (aber auch einige 
+Datentypen), die in ELAN zur Verfügung stehen, nicht durch den ELAN-Compiler 
+realisiert, sondern durch solche PACKETs. Um solche Objekte einigermaßen 
+zu standardisieren, wurde in der ELAN-Sprachbeschreibung festgelegt, welche 
+Datentypen, Prozeduren und Operatoren in jedem ELAN-System vorhanden 
+sein müssen. Solche PACKETs werden Standard-Pakete genannt. Jeder Installa- 
+tion - aber auch jedem Benutzer - steht es jedoch frei, zu den Standard- 
+Paketen zusätzliche PACKETs mit in den Compiler aufzunehmen und damit den 
+ELAN-Sprachumfang zu erweitern. 
+ 
+Ein ELAN-PACKET beginnt mit dem PACKET-Schlüsselwort. Danach folgt der Name 
+des PACKETs (der am Ende des PACKETs hinter END PACKET wieder erscheinen 
+muß), gefolgt von der DEFINES-Liste. In dieser Schnittstelle werden die Ob- 
+jekte angegeben, die nachfolgenden PACKETs zur Verfügung gestellt werden 
+sollen. 
+ 
+In der Schnittstelle werden Prozeduren/Operatoren nur mit ihrem Namen ange- 
+geben. Weiterhin können Datentypen und mit CONST vereinbarte Datenobjekte 
+in der Schnittstelle aufgeführt werden, aber keine VAR-Datenobjekte, weil 
+diese sonst über PACKET-Grenzen hinweg verändert werden könnten. 
+ 
+Im obigen Programm 32 haben wir ein PACKET in der Funktion als spracher- 
+weiterndes Instrument gezeigt. Im folgenden Beispiel zeigen wir ein Programm, 
+in dem das PACKET-Konzept verwandt wird, um Datenobjekte vor unbefugten 
+Zugriff zu schützen. 
+ 
+ 
+Programm 33: 
+ 
+     PACKET stack handling DEFINES push, pop, init stack: 
+ 
+     LET max = 1000; 
+     ROW max INT VAR stack; 
+     INT VAR stack pointer; 
+ 
+     PROC init stack: 
+        stack pointer := 0 
+     END PROC init stack; 
+ 
+     PROC push (INT CONST dazu wert): 
+        stack pointer INCR 1; 
+        IF stack pointer > max 
+          THEN errorstop ("stack overflow") 
+          ELSE stack [stack pointer] := dazu wert 
+        END IF 
+     END PROC push; 
+ 
+     PROC pop (INT VAR von wert): 
+        IF stack pointer = 0 
+          THEN errorstop ("stack empty") 
+          ELSE von wert := stack [stack pointer]; 
+               stack pointer DECR 1 
+        END IF 
+     END PROC pop 
+ 
+     END PACKET stack handling; 
+ 
+Nun kann man den Stack über die Prozeduren 'init stack', 'push' und 'pop' 
+benutzen (in einem 'main packet'). 
+ 
+ 
+Programm 34: 
+ 
+     init stack; 
+     werte einlesen und pushen; 
+     werte poppen und ausgeben. 
+ 
+     werte einlesen und pushen: 
+        INT VAR anzahl :: 0, wert; 
+        REP 
+           get (wert); 
+           push (wert); 
+           anzahl INCR 1 
+        UNTIL ende kriterium END REP. 
+ 
+     werte poppen und ausgeben: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO anzahl REP 
+           pop (wert); 
+           put (wert) 
+        END REP. 
+ 
+Die Datenobjekte 'stack' und 'stack pointer' haben nur Gültigkeit innerhalb 
+des PACKETs 'stack handling'. Anweisungen wie z.B. 
+ 
+     put (stack [3]); 
+     stack [27] := 5 
+ 
+außerhalb des PACKETs 'stack handling' sind also verboten und werden vom 
+ELAN-Compiler entdeckt. 
+ 
+Ein PACKET bietet also auch einen gewissen Schutz vor fehlerhafter Verwen- 
+dung von Programmen und Datenobjekten. Wichtig ist weiterhin, daß die Reali- 
+sierung des Stacks ohne weiteres geändert werden kann, ohne daß Benutzer- 
+programme im 'main packet' geändert werden müssen, sofern die Schnittstelle 
+nicht verändert wird. Beispielsweise kann man sich entschließen, den Stack 
+nicht durch eine Reihung, sondern durch eine gekettete Liste zu realisieren. 
+Davon bleibt ein Benutzerprogramm unberührt. 
+ 
+Die letzte Funktion von PACKETs ist die Realisierung von abstrakten Daten- 
+typen. Dazu müssen wir uns aber zuvor die Möglichkeiten anschauen, neue 
+Datentypen zu definieren. 
+ 
+ 
+ 
+Die Definition neuer Datentypen 
+ 
+Im Gegensatz zur LET-Vereinbarung, bei der lediglich ein neuer Name für 
+einen bereits vorhandenen Datentyp eingeführt wurde und bei der somit auch 
+keine neuen Operationen definiert werden müssen (weil die Operationen für 
+den abzukürzenden Datentyp verwandt werden können), wird durch eine TYPE- 
+Vereinbarung ein gänzlich neuer Datentyp eingeführt. Im Gegensatz zu 
+Strukturen und Reihungen stehen für solche Datentypen noch nicht einmal die 
+Zuweisung zur Verfügung. Beispiel: 
+ 
+     TYPE PERSON = STRUCT (TEXT name, vorname, INT alter) 
+ 
+Ein solcher Datentyp kann wie auch alle anderen Datentypen verwandt werden 
+(Deklarationen, Parameter, Werte liefernde Prozeduren, als Komponenten in 
+Reihungen und Strukturen usw.). 
+ 
+Der neudefinierte Datentyp wird abstrakter Datentyp genannt. Er kann mit 
+Hilfe eines PACKETs (vergl. nächsten Abschnitt) anderen Programmteilen zur 
+Verfügung gestellt werden. Die rechte Seite der TYPE-Vereinbarung wird 
+"konkreter Typ", "Realisierung des Datentyps" oder Feinstruktur genannt. 
+ 
+Um neue Operatoren und/oder Prozeduren für einen abstrakten Datentyp zu 
+schreiben, ist es möglich, auf die Komponenten des Datentyps (also auf die 
+Feinstruktur) mit Hilfe des Konkretisierers zuzugreifen. Der Konkretisierer 
+arbeitet ähnlich wie die Subskription oder Selektion: er ermöglicht eine 
+typmäßige Umbetrachtung vom abstrakten Typ zum Datentyp der Feinstruktur. 
+Beispiel: 
+ 
+     TYPE MONAT = INT; 
+ 
+     PROC put (MONAT CONST m): 
+        put ( CONCR (m)) 
+     END PROC put; 
+ 
+Der Konkretisierer ist bei Feinstrukturen notwendig, die von elementarem 
+Datentyp sind. Besteht dagegen die Feinstruktur aus Reihungen oder Struk- 
+turen, dann wird durch eine Selektion oder Subskription eine implizite Kon- 
+kretisierung vorgenommen. Beispiel: 
+ 
+     TYPE LISTE = ROW 100 INT; 
+ 
+     LISTE VAR personal nummer; 
+     ... 
+     personal nummer [3] := ... 
+     (* das gleiche wie *) 
+     CONCR (personal nummer) [3] := ... 
+ 
+Denoter für neudefinierte Datentypen werden mit Hilfe des Konstruktors 
+gebildet: 
+ 
+     TYPE GEHALT = INT; 
+ 
+     GEHALT VAR meins :: GEHALT : (1 000 000); 
+ 
+Besteht die Feinstruktur aus einem Datenverbund, muß der Konstruktor u.U. 
+mehrfach geschachtelt angewandt werden: 
+ 
+     TYPE KOMPLEX = ROW 2 REAL; 
+ 
+     KOMPLEX CONST x :: KOMPLEX : ( ROW 2 REAL : ( 1.0, 2.0)); 
+ 
+ 
+ 
+Abstrakte Datentypen 
+ 
+Auf die Feinstruktur über den Konkretisierer eines neudefinierten Datentyps 
+darf nur in dem PACKET zugegriffen werden, in dem der Datentyp definiert 
+wurde. Der Konstruktor kann ebenfalls nur in dem typdefinierenden PACKET 
+verwandt werden. 
+ 
+Wird der Datentyp über die Schnittstelle des PACKETs anderen Programmteilen 
+zur Benutzung zur Verfügung gestellt, so müssen Operatoren und/oder Proze- 
+duren für den Datentyp ebenfalls "herausgereicht" werden. Da dann der neude- 
+finierte Datentyp genauso wie alle anderen Datentypen verwandt werden kann, 
+aber die Komponenten nicht zugänglich sind, spricht man von abstrakten 
+Datentypen. 
+ 
+Welche Operationen sollten für einen abstrakten Datentyp zur Verfügung 
+stehen? Obwohl das vom Einzelfall abhängt, werden meistens folgende 
+Operationen und Prozeduren definiert: 
+ 
+- 'get'- und 'put'-Prozeduren. 
+- Zuweisung (auch für die Initialisierung notwendig). 
+- Denotierungs-Prozedur (weil kein Konstruktor für den abstrakten Datentyp 
+  außerhalb des definierenden PACKETs zur Verfügung steht) 
+ 
+ 
+Programm 35: 
+ 
+     PACKET widerstaende DEFINES WIDERSTAND, REIHE, PARALLEL, :=, get, put: 
+ 
+     TYPE WIDERSTAND = INT; 
+ 
+     OP := (WIDERSTAND VAR l, WIDERSTAND CONST r): 
+        CONCR (l) := CONCR (r) 
+     END OP :=; 
+ 
+     PROC get (WIDERSTAND VAR w): 
+        INT VAR i; 
+        get (i); 
+        w := WIDERSTAND : (i) 
+     END PROC get; 
+ 
+     PROC put (WIDERSTAND CONST w): 
+        put (CONCR (w)) 
+     END PROC put; 
+ 
+     WIDERSTAND OP REIHE (WIDERSTAND CONST l, r): 
+        WIDERSTAND : ( CONCR (l) + CONCR (r)) 
+     END OP REIHE; 
+ 
+     WIDERSTAND OP PARALLEL (WIDERSTAND CONST l, r): 
+       WIDERSTAND : 
+         ((CONCR (l) * CONCR (r)) DIV (CONCR (l) + CONCR (r))) 
+     END OP PARALLEL 
+ 
+     END PACKET widerstaende 
+ 
+Dieses Programm realisiert den Datentyp WIDERSTAND und mit den Operationen 
+eine Fachsprache, mit dem man nun leicht WIDERSTANDs-Netzwerke berechnen 
+kann, wie z.B. folgendes: 
+ 
+ 
+                              +--- R4 ---+ 
+                              |          | 
+        +--- R1 ---+          +--- R5 ---+ 
+        |          |          |          | 
+     ---+          +--- R3 ---+          +--- 
+        |          |          |          | 
+        +--- R2 ---+          +--- R6 ---+ 
+                              |          | 
+                              +--- R7 ---+ 
+ 
+Zur Berechnung des Gesamtwiderstandes kann nun folgendes Programm 
+geschrieben werden: 
+ 
+     ROW 7 WIDERSTAND VAR r; 
+     widerstaende einlesen; 
+     gesamtwiderstand berechnen; 
+     ergebnis ausgeben. 
+ 
+     widerstaende einlesen: 
+        INT VAR i; 
+        FOR i FROM 1 UPTO 7 REP 
+           put ("bitte widerstand R"); put (i); put (":"); 
+           get (r [i]); 
+        END REP. 
+ 
+     gesamtwiderstand berechnen: 
+        WIDERSTAND CONST rgesamt :: (r [1] PARALLEL r [2]) REIHE 
+          r [3] REIHE (r [4] PARALLEL r [5] PARALLEL r [6] 
+          PARALLEL r [7]). 
+ 
+     ergebnis ausgeben: 
+        line; 
+        put (rgesamt). 
+ 
+ 
+Aufgabe (HSG): 
+ 
+     Was ist ein Modul? Was ist ein Interface? Was ist der Unterschied 
+     zwischen einem PACKET und einer Prozedur? 
+     Die Realisierung von WIDERSTAND durch INTs ist nicht in allen Fällen 
+     befriedigend. Warum? (Beachte besonders die Realisierung des OP 
+     PARALLEL). 
+     Wenn man bei der Typ-Vereinbarung von WIDERSTAND INT gegen REAL 
+     austauschen würde, wo müßte man noch Änderungen vornehmen? Sind 
+     insbesondere Änderungen im Benutzer-Programm (hier im 'main packet') 
+     notwendig? 
+Übungsziel: PACKET-Begriff 
+ 
+ 
+ 
+Programmstruktur 2 
+ 
+Nun können wir auch erklären, wie ein ELAN-Programm mit mehreren PACKETs 
+aussieht. Ein Programm besteht aus einer Folge von PACKETs, dem ein 'main 
+packet' folgt. Es ist auch möglich, PACKETs vorübersetzen zu lassen, so daß 
+es für einen Nutzer so aussieht, als ob er nur ein 'main packet' übersetzen 
+läßt. Tatsächlich sind zumindest die Standard-Packets vorübersetzt vorhanden. 
+
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7
new file mode 100644
index 0000000..1aadc5f
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7
@@ -0,0 +1,2469 @@
+                     EUMEL-Benutzerhandbuch 
+ 
+          TEIL 7: Dateien, Datei-Verwaltung und Datenräume         
+ 
+1. Übersicht 
+ 
+Dateien dienen zur Aufnahme von Informationen, die auch über die Bearbei- 
+tungszeit eines Programms erhalten bleiben (können). Dateien werden als 
+Objekte in einer Task gehalten. Sie bleiben solange erhalten, bis sie expli- 
+zit gelöscht ('forget'-Kommando) oder die Task beendet wird ('end'-Kommando). 
+ 
+Dateien kann man an andere Tasks schicken ('save'-Kommando) oder von anderen 
+Tasks holen ('fetch'-Kommando). Mit diesen (hier vorgestellten) Kommandos 
+ist der Transport von Dateien jedoch nur in direkter Linie des Task-Baums 
+möglich, also an einen "Vater" oder einen "Sohn". Damit ist automatisch eine 
+Datei-Hierarchie im EUMEL-System realisiert. 
+ 
+Alle Datei-Arten des EUMEL-Systems basieren auf Datenräumen. Ein Datenraum 
+ist ein Speicherplatz, der 1 MByte Daten speichern kann und vom EUMEL-System 
+verwaltet wird. Datenräume können gelöscht, kopiert usw. werden. Mit Hilfe 
+Mit Hilfe von Datenräumen werden alle Datei-Arten des EUMEL-Systems reali- 
+siert, indem einem Datenraum eine Struktur (Datentyp) aufgeprägt wird. Da- 
+durch wird es Benutzern des EUMEL-Systems ermöglicht, auf einfache Weise 
+neben den bereits vorhandenen Datei-Arten (FILEs für die Speicherung von 
+Texten, PICFILEs für die Speicherung von Bildinformationen, u.a.m.) 
+spezielle Dateien zu konstruieren. 
+ 
+Die wichtigste Datei-Art, mit der ein Benutzer in Berührung kommt, ist die 
+sequentielle Datei, genannt FILE. Ein FILE kann nur TEXTe aufnehmen und hat 
+z.Zt. ein Fassungsvermögen von 4000 Zeilen (Sätze). Insgesamt darf ein FILE 
+1 MByte aufnehmen. Eine Datei-Zeile (Satz) kann bis zu 32 000 Zeichen auf- 
+nehmen. 
+ 
+FILEs können in einer von drei Betriebsrichtungen bearbeitet werden: 
+- "input":   nur Lesen. 
+- "output":  nur Schreiben. 
+- "modify":  Lesen/Schreiben und zusätzlich beliebiges Positionieren, Ein- 
+             fügen und Löschen von Sätzen. 
+ 
+'input'-Dateien sind also Eingabedateien, 'output'- sind Ausgabedateien und 
+'modify'-Dateien kann man verändern. Insbesondere die 'modify'-Dateien eig- 
+nen sich, um andere Datei-Arten leicht zu realisieren (z.B. indexsequentiel- 
+le Dateien). 
+ 
+Eine Datei kann auf einen bestimmten Zeilenbereich eingeschränkt werden. Ein 
+solches Segment kann selbst wie eine Datei von einem Programm behandelt 
+werden. 
+ 
+ 
+ 
+2. Datei-Kommandos 
+ 
+Dateien werden in der Regel in einer Benutzer-Task gehalten. Die Kommandos 
+für die Behandlung von Dateien in einer Benutzer-Task werden hier vorge- 
+stellt. Dann wird erklärt, wie Dateien zu einer übergeordneten Task ge- 
+schickt oder geholt werden können. 
+ 
+ 
+ 
+Datei-Kommandos für Benutzer-Tasks 
+ 
+Im Monitor-Dialog kann man Dateien kopieren, löschen und einen anderen Namen 
+geben. 
+ 
+Mit dem Kommando 
+ 
+     edit ("dateiname") 
+ 
+wird eine Text-Datei im Monitor-Dialog (implizit) eingerichtet, wenn es sich 
+um einen noch nicht vorhandenen 'dateiname' handelt (vergl. auch die Editor- 
+Beschreibung). 
+ 
+Welche Dateien in der Benutzer-Task vorhanden sind, kann mit dem Kommando 
+ 
+     list 
+ 
+erfragt werden. 'list' zeigt auf dem Bildschirm die Dateinamen der Benutzer- 
+Task. Vor jedem Namen steht ein Datum, welches anzeigt, an welchem Tag die 
+Datei zuletzt von einem Programm bearbeitet wurde. Ein 'a' hinter dem Datum 
+kennzeichnet Dateien, die nach einer Archivierung nicht bearbeitet wurden. 
+ 
+Ein Duplizieren einer Datei kann mit 
+ 
+     copy ("alte datei", "neue datei") 
+ 
+erreicht werden, wobei eine Kopie von 'alter datei' angelegt wird, die den 
+Namen 'neue datei' erhält. Man beachte, daß es sich um eine logische (und 
+vorerst um keine physikalische) Kopie handelt. Erst bei Schreibzugriffen 
+werden Seiten " entshared" ("copy-on-write"). Ein Umbenennen einer Datei 
+kann mit   
+ 
+     rename ("alter datei name", "neuer datei name") 
+ 
+erfolgen. Mit 
+ 
+     forget ("dateiname") 
+ 
+kann eine Datei gelöscht werden. 
+ 
+Wurde in einer Datei editiert, kann durch Löschen oder Einfügen von Zeilen 
+der interne Verwaltungsaufwand hoch werden, so daß Positionierungen nicht 
+mehr effizient vor sich gehen. Mit dem Kommando 
+ 
+     reorganize ("dateiname") 
+ 
+wird die Datei so organisiert, als wenn sie neu erstellt wäre (gilt nur für 
+Text-Dateien). Sie braucht dann in der Regel auch etwas weniger Speicher- 
+platz.  
+ 
+ 
+Merke: Das Kommando 'rename' gibt einer Datei einen anderen Namen, 'copy' 
+dupliziert eine Datei. Mit 'list' kann man sich anzeigen lassen, welche 
+Dateien in der Task vorhanden sind. 
+ 
+ 
+ 
+Datei-Kommandos für Vater-Tasks 
+ 
+Man kann Dateien von einer Vater-Task holen oder an eine Vater-Task schicken, 
+um sie dort längerfristig zu speichern. Auch wenn die Benutzer-Task gelöscht 
+wird, bleiben alle Dateien, die bei einer Vater-Task gespeichert (also 
+"gerettet") sind, erhalten. Andere Sohn-Tasks können sich Dateien bei einer 
+Vater-Task abholen. 
+ 
+Auf Dateien einer Benutzer-Task können andere Nutzer aus anderen Tasks in 
+der Regel nicht zugreifen. Manchmal ist es jedoch notwendig, daß mehrere 
+Nutzer Dateien gemeinsam benutzen oder eine Datei eine Task "überleben" soll. 
+In solchen Fällen muß man Dateien bei einem Vater aufbewahren. 
+ 
+Mit der Prozedur 
+ 
+     global manager 
+ 
+kann die Benutzer-Task zu einem Datei-Manager gemacht werden. Erst nach 
+Aufruf dieser Prozedur können Söhne dieser Task eingerichtet werden. 
+ 
+Von einer Benutzer-Task kann eine Datei mit 
+ 
+     save ("Buch 1") 
+ 
+der direkten Vater-Task übergeben werden, wobei 'buch 1' in der Benutzer- 
+Task erhalten bleibt. 'save' wirkt also wie ein Transport einer Kopie der 
+angegebenen Datei in die Vater-Task. Achtung: ist eine Datei 'Buch 1' in der 
+Vater-Task bereits vorhanden, wird diese ohne Warnung überschrieben. 
+ 
+Analog zu der 'forget'-Prozedur für Dateien einer Benutzer-Task können 
+Dateien einer unmittelbaren Vater-Task mit 
+ 
+     erase ("datei name") 
+ 
+gelöscht werden. Soll eine Datei von einer Vater-Task in eine Benutzer-Task 
+geholt werden, so benutzt man die Prozedur 
+ 
+     fetch ("datei") 
+ 
+Nach Aufruf dieser Prozedur wird eine Kopie der angegebenen Datei in der 
+Benutzer-Task angelegt. Ist bereits eine Datei 'datei' in der Benutzer-Task 
+vorhanden, so erfolgt eine Fehlermeldung. 
+ 
+Mit 'save', 'fetch' und 'erase' ist es möglich, daß zwei oder mehr Benutzer 
+eine Datei alternierend bearbeiten. In diesem Fall müssen sich die Benutzer 
+als Söhne einer gemeinsamen Vater-Task einrichten und die Datei mit 'fetch' 
+jeweils in die Benutzer-Task holen. Um zu verhindern, daß ein anderer Be- 
+nutzer zur gleichen Zeit mit der Datei arbeitet, wird sie jeweils mit 'erase' 
+bei der Vater-Task gelöscht. Nach Beendigung der Arbeiten muß die Datei dann 
+wieder mit 'save' in die Vater-Task transportiert werden. Dann steht sie 
+wieder anderen Benutzern zur Verarbeitung zur Verfügung. Beispiel: 
+ 
+     fetch  ("datei"); erase ("datei");    (* Datei vom Vater holen und dort 
+                                              loeschen *) 
+     edit   ("datei");                     (* Datei bearbeiten *) 
+     save   ("datei");                     (* Datei zur Vater-Task bringen *) 
+     forget ("datei")                      (* Datei in Benutzer-Task 
+                                              loeschen *) 
+ 
+Mit den Prozeduren 
+ 
+     save all 
+     fetch all 
+ 
+kann man alle Dateien einer Benutzer-Task in die direkte Vater-Task schicken 
+oder von dort holen. 
+ 
+Merke:
+       * * * * * * * * * * 
+       *                 * 
+       *         <-+     *  Vater-Task 
+       *     |     |     * 
+       * * * | * * | * * * 
+             |     | 
+           fetch  save 
+             |     | 
+       * * * | * * | * * * 
+       *     |     |     * 
+       *     ->edit|     *  Benutzer-Task 
+       *                 * 
+       * * * * * * * * * * 
+ 
+ 
+ 
+Ansprechen von anderen Tasks 
+ 
+Sollen Dateien in andere als die direkte Vater-Task transportiert oder von 
+anderen Tasks geholt werden, muß man den internen Task-Bezeichner angeben. 
+ 
+Es gibt einige Prozeduren, mit denen man den internen Task-Bezeichner einer 
+Task bekommt. Solch eine Prozedur ist 
+ 
+     father 
+ 
+Prozeduren, mit denen man Dateien transportieren kann, liegen auch in einer 
+Version vor, bei denen man den internen Task-Bezeichner angeben kann. 
+Beispiel: 
+ 
+     save  ("datei", father)        (* wie: save  ("datei") *) 
+     erase ("datei", father)        (* wie: erase ("datei") *) 
+     fetch ("datei", father)        (* wie: fetch ("datei") *) 
+ 
+Weitere Prozeduren, die einen internen Task-Bezeichner liefern, sind: 
+ 
+     myself 
+     printer 
+     public 
+     archive 
+ 
+Anmerkung: Zur Prozedur 'archive' siehe auch das nächste Kapitel; zu 'print' 
+siehe auch SPOOLER. Dadurch kann man Dateien auch zu anderen als der 
+Vater-Task transportieren, holen oder löschen. Beispiele: 
+ 
+     erase ("datei", public)     (* Loescht 'datei' in Task 'PUBLIC' *) 
+     fetch ("datei", public)     (* Holt 'datei' aus der Task "PUBLIC" *) 
+     save  ("datei", public)     (* Kopiert 'datei' in die Task 'PUBLIC' *) 
+     save  ("datei", printer)    (* Uebergibt 'datei' dem Spooler und 
+                                    druckt die Datei *) 
+     list  (father)              (* Listet Dateien der Vater-Task *) 
+ 
+Bei komplizierten "Verwandschafts-Verhältnisse" von Tasks ist es einfacher, 
+eine Task mit Hilfe des Task-Namens anzusprechen. Das erfolgt mit Hilfe der 
+Prozedur 'task'. Beispiel: 
+ 
+     save ("datei", task ("hugo")) 
+ 
+'task' liefert den internen Task-Bezeichner von 'hugo'. Die Umkehr-Prozedur 
+zu 'task' ist 'name': 
+ 
+     put (name (myself)) 
+ 
+schreibt den Namen der Task, in der man sich gerade befindet, auf den Bild- 
+schirm. 
+ 
+Durch die Prozedur 'father', die einen internen Task-Bezeichner als 
+Parameter erwartet, kann man an die Vater-Task einer Task gelangen. 
+Beispiel: 
+ 
+     save ("datei", father (father)) 
+ 
+Hier wird die Datei 'datei' an die Vater-Task der Vater-Task geschickt (also 
+zur "Großvater-Task"). 
+ 
+Mit dem Operator         / 
+ 
+kann man aus einem Tasknamen den internen Tasknamen erhalten. '/' kann über- 
+all dort eingesetzt werden, wo ein interner Taskname verlangt wird. Beispiel: 
+ 
+     task status (/"meine task") 
+ 
+ 
+Merke: Mit den internen Task-Bezeichner kann man mit anderen Tasks als der 
+Vater-Task kommunizieren. 
+ 
+ 
+ 
+Kommandos für mehrere Dateien 
+ 
+Durch die vom EUMEL-System bereitgestellten Task-Variablen und Datei-Ver- 
+zeichnisse (Thesaurus, Plural: Thesauren) ist es möglich, mehrere Dateien 
+mit einem Kommando zu behandeln. 
+ 
+Sollen alle Dateien einer Task zu einer anderen transportiert werden (mit 
+'save') oder alle Dateien geholt werden, kann man 'save all' und 'fetch all' 
+auch mit einem internen Task-Bezeichner versehen. Beispiele: 
+ 
+     save all  (public) 
+     fetch all (public) 
+ 
+Damit werden alle Dateien der Benutzer-Task zu der Task 'PUBLIC' geschickt 
+oder von dort geholt. 
+ 
+Die internen Tasknamen wie z.B. 'myself', 'father', 'public' usw. werden 
+auch bei dem Einsatz eines Thesaurus benutzt. Was ist ein "Thesaurus"? 
+ 
+Das EUMEL-System hält sich die Dateinamen einer Task des Taskbaums in einer 
+internen Liste. Die Namens-Liste wird Thesaurus (laut Duden: ein 
+"systematisch geordnetes Verzeichnis") genannt. 
+ 
+Der Operator  ALL  liefert den Thesaurus einer Task. Beispiel: 
+ 
+     ALL father 
+     ALL myself 
+ 
+liefert jeweils den Thesaurus der Vater- oder der eigenen Task. Solche 
+Thesauren kann man als Parameter der meisten der oben erwähnten Kommandos 
+verwenden: 
+ 
+     save   (ALL myself)    (* kopiert alle Dateien in die Vater-Task; 
+                               arbeitet wie 'save all' *) 
+     forget (ALL myself)    (* loescht alle Dateien der Benutzer-Task *) 
+     fetch  (ALL father)    (* holt alle Dateien der Vater-Task; 
+                               arbeitet wie 'fetch all' *) 
+ 
+Der Operator  SOME  dagegen bietet einen Thesaurus vorher zum Editieren an, 
+um Dateinamen zu streichen (HOP RUBOUT). Beispiele: 
+ 
+     fetch  (SOME father)   (* holt die nicht gestrichenen Dateien *) 
+     save   (SOME myself)   (* kopiert die nicht gestrichenen Dateien *) 
+     forget (SOME myself)   (* loescht die nicht gestrichenen Dateien *) 
+ 
+Es ist auch möglich, aus den Thesauren mehrerer Tasks einen neuen Thesaurus 
+zu bilden: 
+ 
+     -           (* Differenzmenge    *) 
+     /           (* Schnittmenge      *) 
+     +           (* Vereinigungsmenge *) 
+ 
+Beispiel: 
+ 
+     fetch (ALL father - ALL myself) 
+ 
+holt alle Dateien der Vater-Task, die nicht bereits in der Benutzer-Task 
+sind. 
+ 
+ 
+Merke: Mit den Operatoren 'ALL' und 'SOME' kann man mehrere Dateien mit 
+einem Kommando behandeln. 
+ 
+ 
+ 
+Datei-Schutz durch Paßworte und Verschlüsselung 
+ 
+Dateien können vor unbefugtem Zugriff mit Hilfe von Paßworten und/oder der 
+Verschlüsselung der Informationen geschützt werden. 
+ 
+ 
+ 
+Paßworte 
+ 
+Paßworte für Dateien dienen zur Verhinderung von unbefugtem Zugriff auf 
+Dateien, die bei einer Vater-Task gespeichert werden. (Die Dateien der 
+Benutzer-Task können durch ein Task-Paßwort geschützt werden). Dabei sollte 
+man bedenken, daß Paßworte bekannt werden können. 
+ 
+Der Paßwort-Schutz ist im EUMEL-System etwas sicherer als in anderen 
+Betriebssystemen, weil Paßworte nur selten angegeben werden müssen und 
+daher nicht so leicht bekannt werden können (z.B. durch "über die Schulter 
+schauen"). Die Kommandozeile wird zudem bei der Angabe eines Paßworts nach 
+dem Betätigen der RETURN-Taste gelöscht. 
+ 
+Paßworte werden nur im Verkehr mit Vater-Tasks eingesetzt. Lokale Benutzer- 
+Dateien brauchen nicht gesondert gesichert zu werden, da man ein Paßwort 
+auf die Benutzer-Task legen kann oder die zu sichernden Dateien aus dem 
+System nehmen kann. Ein Paßwort kann mit der Prozedur 
+ 
+     enter password ("schreibpasswort / lesepasswort") 
+ 
+angegeben oder ein bereits eingestelltes Paßwort kann mit dieser Prozedur 
+überschrieben werden. Voreingestellt ist kein Paßwort. Nachdem ein Benutzer 
+die 'enter password'-Prozedur angegeben hat, wird jeder Datei-Verkehr mit 
+einer Vater-Task mit Hilfe dieses Paßworts überprüft. Unzulässige Zugriffe 
+durch Benutzer anderer Tasks auf Dateien einer Vater-Task werden abgewiesen. 
+ 
+Ein Paßwort hat eine eigene Syntax. Es besteht aus zwei Teilen, die leer 
+sein können und die durch ein "/"-Zeichen voneinander getrennt sind. Der 
+erste Teil ist das Schreib-Paßwort, der zweite das Lese-Paßwort. Wird kein 
+Lese-Paßwort angegeben, gilt das Schreib-Paßwort auch für das Lesen. Ist 
+also kein "/"-Zeichen im Paßwort-String vorhanden, so wird das Schreib- 
+Paßwort sozusagen gedoppelt. Beispiele: 
+ 
+    enter password ("")             (* kein Paßwort *) 
+    enter password ("hugo")         (* 'hugo' gilt fuer das Schreiben und 
+                                       Lesen *) 
+    enter password ("egon/meier")   (* 'egon' fuers Schreiben, 'meier' fuers 
+                                       Lesen *) 
+ 
+Zusätzlich kann das "-"-Zeichen in dem Teil des Paßworts angegeben werden, 
+für den ein Zugriff nicht erlaubt sein soll. Beispiel: 
+ 
+   enter password ("-/nurlesen")    (* Schreibzugriff nicht erlaubt, 
+                                       Lese-Passwort ist 'nurlesen' *) 
+ 
+Das Lese-Paßwort gilt für die Prozedur 
+ 
+     fetch 
+ 
+während das Schreib-Paßwort für die Prozeduren 
+ 
+     save 
+     erase 
+ 
+gilt. Sofern die betreffende Datei durch ein Paßwort geschützt ist, ist 
+folgendes zu beachten: 
+ 
+a) fetch: 
+   Will ein Benutzer mit der Prozedur 'fetch' eine Datei in seine Benutzer- 
+   Task holen, so wird sein aktuell eingestelltes Paßwort (nur Lese-Teil) 
+   und das Paßwort der Datei überprüft. Stimmen diese nicht überein, so wird 
+   der 'fetch'-Zugriff auf eine Datei der Vater-Task abgewiesen. 
+ 
+b) save: 
+   Bei einem Transport in eine Vater-Task mit Hilfe der Prozedur 'save' sind 
+   zwei Fälle zu unterscheiden: 
+ 
+      - Datei ist in der Vater-Task noch nicht vorhanden: Diese Datei wird 
+        in der Vater-Task mit dem aktuellen Paßwort des Benutzers einge- 
+        tragen. 
+ 
+      - Datei ist in der Vater-Task bereits vorhanden und soll durch die 
+        neue Datei ersetzt werden: Es wird überprüft, ob das aktuelle 
+        Schreib-Paßwort des Benutzers mit dem der gleichnamigen Datei in der 
+        Vater-Task übereinstimmt. Ist dies nicht der Fall, wird die Datei 
+        nicht in der Vater-Task eingetragen. 
+ 
+c) erase: 
+   Soll eine Datei der Vater-Task gelöscht werden, wird überprüft, ob das 
+   aktuelle Schreib-Paßwort mit dem der zu löschenden Datei in der Vater- 
+   Task übereinstimmt. Ist dies nicht der Fall, wird die Lösch-Operation 
+   abgewiesen. 
+ 
+ 
+Merke: Dateien können bei der Sicherung in einer Vater-Task vor unbefugtem 
+Zugriff durch Paßworte geschützt werden. 
+ 
+ 
+ 
+Dateien verschlüsseln 
+ 
+Zusätzlich zu einem Paßwort kann man eine Datei vor unbefugtem Zugriff 
+schützen, indem sie verschlüsselt wird. 
+ 
+Mit den Prozeduren 
+ 
+     crypt 
+     decrypt 
+ 
+kann eine Datei ver- oder entschlüsselt werden (Datenschutz für einzelne 
+Dateien). Dabei ist es möglich, eine Datei mehrfach zu verschlüsseln (man 
+muß die Verschlüsselung dann allerdings auch mehrfach rückgängig machen). 
+Beispiel: 
+ 
+     crypt ("datei", "schluessel") 
+ 
+verschlüsselt 'datei' mit 'schluessel'. Die Entschlüsselung erfolgt, indem 
+man die Prozedur 'decrypt' auf 'datei' anwendet und den gleichen Schlüssel 
+zur Entschlüsselung benutzt. Beispiel: 
+ 
+     decrypt ("datei", "schluessel") 
+ 
+Den Text des Schlüssels (hier: 'schluessel') sollte man sich also unbedingt 
+merken, sonst kann die Datei nicht mehr entschluesselt werden. 
+ 
+Merke: Dateien werden durch 'crypt' und 'decrypt' ver- und entschlüsselt. 
+ 
+ 
+ 
+3. Das Archiv 
+ 
+Dateien werden im EUMEL-System auf Systemträgern gespeichert. Mit dem Archiv 
+können Dateien vom System auf externe Speichermedien (normalerweise 
+Disketten) gebracht und von diesen ins System geholt werden. 
+ 
+Das EUMEL-Archiv hat folgende Aufgaben: 
+ 
+a) Das Archiv wird als Sicherheitsbereich benutzt, indem man von wichtigen 
+   Dateien Kopien anlegt und diese außerhalb des EUMEL-Systems speichert. 
+ 
+b) Man kann das Archiv-System aber auch benutzen, um Dateien, die nur selten 
+   oder in größeren Zeitabständen benötigt werden, zu kopieren ("archi- 
+   vieren") und im EUMEL-System zu löschen. Falls diese Dateien wieder 
+   gebraucht werden, können sie wieder in das EUMEL-System geholt werden. 
+   Damit wird erreicht, daß im EUMEL-System nur die wirklich notwendigen 
+   Dateien stehen. 
+ 
+c) Sollen Dateien von einer EUMEL-Installation auf eine andere übertragen 
+   werden, so kann man ebenfalls Archive verwenden. 
+ 
+d) Bei Versionswechsel des EUMEL-Systems sind Archive die einzige Möglich- 
+   keit, Dateien in die neue Systemversion einzuspielen. Dabei wird garan- 
+   tiert, daß zumindest Archive der letzten Version gelesen werden können. 
+ 
+Merke: Durch das Archiv können Dateien außerhalb des Systems gesichert 
+werden. 
+ 
+ 
+ 
+Das Archiv reservieren 
+ 
+Soll archiviert werden, muß man das dem Archiv-System mitteilen, damit nicht 
+ein anderer Benutzer zur gleichen Zeit auf das Archiv zugreift. Dieser 
+Vorgang wird "reservieren" genannt. 
+ 
+Archiv-Disketten haben aus Sicherheitsgründen einen Namen. Dieser Name muß 
+bei der Anmeldung einer Archivierung angegeben werden. Die Anmeldung einer 
+Archivierung und gleichzeitige Reservierung erfolgt mit  
+ 
+     archive ("name") 
+ 
+Der Archiv-Name wird bei folgenden Archiv-Operationen zur Überprüfung mit 
+dem eingelegten Archiv verwandt. 
+ 
+Wichtig: Eine Diskette sollte erst nach dem 'archive'-Kommando in das 
+Laufwerk geschoben werden, d.h. erst dann, wenn das Archiv-System reserviert 
+ist. Sonst kann es geschehen, daß ein anderer Benutzer auf dieser Diskette 
+archiviert. 
+ 
+Archivierungen erfolgen durch die schon beschriebenen Transportkommandos 
+'save' und 'fetch'. Dabei wird als Zieltask 'archive' angegeben. Beispiel: 
+ 
+     save  ("mein buch", archive) 
+     fetch ("kapitel 1", archive) 
+     save all  (archive) 
+     fetch all (archive) 
+ 
+Das Archiv bleibt für den Nutzer solange reserviert, wie er Archivierungs- 
+operationen vollzieht. Dann sollte er das Archiv wieder für andere Benutzer 
+mit der Prozedur 
+ 
+   release (archive) 
+ 
+freigeben. 
+ 
+Leitet ein Nutzer innerhalb von fünf Minuten nach der letzten Archiv- 
+Operation keine neue ein und meldet sich ein anderer Nutzer mit 'archive' 
+bei dem Archiv-System an, so wird dem ersten Nutzer die Archiv-Berechtigung 
+entzogen, um Blockaden zu verhindern. Wenn der erste Nutzer eine erneute 
+Archiv-Operation versucht, erhält er eine Fehlermeldung. Dadurch kann ein 
+Nutzer das Archiv längere Zeit (ohne 'release') benutzen, ohne den Betrieb 
+zu stören, da andere Nutzer bei Bedarf jederzeit eingeschoben werden. 
+ 
+Wichtig: Muß die Archiv-Floppy gewechselt werden (weil etwa von einer 
+Diskette eine Datei gelesen wurde und diese auf eine andere geschrieben 
+werden soll), muß erneut das 'archive'-Kommando gegeben werden. Dies ist 
+notwendig, um das Verzeichnis aller auf der Diskette befindlichen Dateien 
+der neuen Diskette zu lesen. 
+ 
+Merke: Mit 'archive' wird die Archiv-Verwaltung für einen Nutzer reserviert, mit 'release' wieder freigegeben. Mit 'archive' wird 
+gleichzeitig ein Archiv-Name eingestellt, der bei Archiv-Operationen mit dem 
+auf der Diskette gespeicherten Archiv-Namen verglichen wird. 
+ 
+ 
+ 
+Archiv löschen und einen Namen geben 
+ 
+Bevor ein Archiv-Diskette benutzt werden kann, muß sie den mit 'archive' 
+eingestellten Namen bekommen. 
+ 
+Bei der Erstbenutzung eines Archivs muß dieses mit einem Namen versehen 
+werden. Als Archiv-Name wird der mit 'archive' eingestellte Name verwandt. 
+Dies erfolgt mit der Prozedur 
+ 
+     clear (archive) 
+ 
+Gleichzeitig werden alle Dateien, die sich eventuell vorher auf dem Archiv- 
+Träger befanden, gelöscht. Somit wird 'clear' auch für das Löschen von 
+Archiven verwendet. 
+ 
+ 
+Merke: Mit 'clear' wird die Archiv-Diskette gelöscht und gleichzeitig der 
+mit 'archive' eingestellte Name gegeben. 
+ 
+ 
+ 
+Einfache Archiv-Operationen 
+ 
+In diesem Abschnitt werden einfache Archiv-Operationen beschrieben. 
+ 
+Mit den Prozeduren 
+ 
+     save  ("datei", archive) 
+     fetch ("datei", archive) 
+     erase ("datei", archive) 
+ 
+kann jeweils eine Datei auf die Archiv-Diskette ('save') und von dem Archiv 
+in das EUMEL-System kopiert ('fetch') oder auf dem Archiv gelöscht ('erase') 
+werden. Dabei bedeutet 'datei' die zu kopierende Datei und 'archive' der 
+interne Task-Name für die Archiv-Verwaltung. Bei den ersten zwei Kommandos 
+ist zu beachten, daß die Datei, die auf das Archiv geschrieben (bei 'save') 
+oder die in die Benutzer-Task geholt werden soll (bei 'fetch'), immer 
+kopiert wird. Dateien bleiben also im "Ursprung" immer erhalten. 
+ 
+Ist eine Datei gleichen Namens bereits auf der Archiv-Diskette (bei 'save') 
+oder in der Benutzer-Task (bei 'fetch') vorhanden, wird von der Archiv-Ver- 
+waltung angefragt, ob diese Datei überschrieben werden darf. Es kann somit 
+nicht zu einem unbeabsichtigten Löschen von Dateien kommen. 
+ 
+Mit dem Kommando 
+ 
+     list (archive) 
+ 
+erhält man (wie bei dem "normalen" 'list'-Kommando) ein Namens-Verzeichnis 
+aller Dateien, die sich auf der eingelegten Archiv-Diskette befinden. 
+ 
+ 
+Merke: Nachdem ein Archiv mit 'archive' reserviert wurde, kann mit 'save' 
+eine Datei auf das Archiv geschrieben und mit 'fetch' eine Datei von dem 
+Archiv in die Benutzer-Task kopiert werden. 
+ 
+ 
+ 
+Archiv-Operationen für mehrere Dateien 
+ 
+Hier wird beschrieben, wie man mehrere Dateien auf einmal auf ein Archiv 
+schreibt oder von einem Archiv liest. 
+ 
+Mit den Kommandos 
+ 
+     save  all (archive) 
+     fetch all (archive) 
+ 
+werden alle Dateien der Benutzer-Task auf das Archiv geschrieben bzw. von 
+dort geholt. 
+ 
+Zusätzlich ist es möglich, die Operatoren 'ALL' und 'SOME' auf ein Archiv 
+anzuwenden. Wie bereits geschildert, liefern diese Operatoren einen 
+Thesaurus der angegebenen Task: 'ALL' liefert alle Dateinamen, während man 
+bei 'SOME' eine Auswahl treffen kann. Damit ist es möglich, alle oder einige 
+Dateien der Benutzer-Task auf eine Archiv-Diskette zu kopieren oder von der 
+Archiv-Diskette in die Benutzer-Task zu holen: 
+ 
+     fetch (SOME archive, archive)   (* zeigt die Namen der Dateien der 
+                                        Archiv-Diskette. Die nicht ge- 
+                                        strichenen Dateien werden in die 
+                                        Benutzer-Task geholt *) 
+     save  (SOME myself, archive)    (* zeigt die Namen der Dateien der 
+                                        Benutzer-Task. Die nicht ge- 
+                                        strichenen Dateien werden auf die 
+                                        Archiv-Diskette kopiert *) 
+     save  (ALL archive, archive)    (* sichert alle Dateien der Benutzer- 
+                                        Task, die sich schon auf dem Archiv 
+                                        befinden (alte Version). Das 
+                                        Kommando ist für Sicherungs- 
+                                        Disketten gedacht, bei dem man immer 
+                                        die gleichen Dateien auf dem Archiv 
+                                        haben will  *) 
+ 
+Durch die Thesaurus-Operatoren '-' (Differenzmenge), '/' (Schnittmenge) und 
+'+' (Vereinigungsmenge) kann man kompliziertere Wirkungen erzielen. 
+Beispiele: 
+ 
+ save (ALL myself - ALL archive, archive)  (* Schreibt alle Dateien der 
+                                              Benutzer-Task auf das Archiv, 
+                                              die nicht bereits auf dem 
+                                              Archiv stehen *) 
+ save (ALL myself - ALL father - ALL archive, archive) 
+                                           (* Schreibt alle Dateien der 
+                                              Benutzer-Task auf das Archiv, 
+                                              mit Ausnahme der Dateien, die 
+                                              längerfristig in der Vater- 
+                                              Task gespeichert sind und die 
+                                              nicht bereits auf dem Archiv 
+                                              stehen *) 
+ fetch (ALL archive - ALL myself)          (* Holt alle Dateien vom Archiv, 
+                                              die sich nicht bereits in der 
+                                              Benutzer-Task befinden *) 
+ 
+Werden mehrere Dateien mittels eines Thesaurus bearbeitet, kann man nach 
+einer Unterbrechung der Bearbeitung (d.h. Fehlermeldung) die Operation wieder 
+aufsetzen. Dazu liefert das Kommando 
+ 
+     remainder 
+ 
+den "Rest"-Thesaurus. Er enthält alle nicht bearbeiteten Dateinamen. 
+Beispiel: 
+ 
+     save (SOME myself, archive)  (* Unterbrechung, z.B. durch einen vom 
+                                     Programm erzeugten 'errorstop' oder SV 
+                                     und 'halt' *) 
+     save (remainder, archive)    (* bearbeitet die restlichen Dateien *) 
+ 
+ 
+Merke: Mit 'save all' bzw. 'fetch all' kann man alle Dateien einer Benutzer- 
+Task archivieren bzw. alle Dateien eines Archivs in die Benutzer-Task holen. 
+Mit den Operatoren SOME und ALL sind weitere Operationen möglich. 
+ 
+ 
+ 
+Fehlermeldungen des Archivs 
+ 
+Bei Archiv-Operationen kann es zu Fehlersituationen kommen. 
+ 
+Versucht man eine Datei vom Archiv zu lesen, kann es vorkommen, daß das 
+Archiv-System 
+ 
+     Lese-Fehler (Archiv) 
+ 
+meldet und den Lese-Vorgang abbricht. Dies kann auftreten, wenn die Floppy 
+beschädigt oder aus anderen Gründen nicht lesbar ist (z.B. nicht justierte 
+Disketten-Geräte). In einem solchen Fall vermerkt das Archiv-System intern, 
+daß die Datei nicht korrekt gelesen werden kann. Das sieht man z.B. beim 
+'list (archive)'. Dort ist der betreffende Datei-Name mit dem Zusatz 'mit 
+Lese-Fehler' gekennzeichnet. Um diese Datei trotzdem zu lesen, muß man sie 
+im Datei-Namen mit dem Zusatz 'mit Lese-Fehler' versehen. Beispiel: 
+ 
+     fetch ("dateiname mit Lese-Fehler") 
+ 
+Die Datei wird in diesem Fall trotz Lese-Fehler (Informationsverlust!) vom 
+Archiv gelesen. 
+ 
+Um solche Fälle möglichst zu vermeiden, sieht das EUMEL-System die 
+Möglichkeit vor, Archive bzw. Archiv-Dateien nach beschreiben zu prüfen. Das 
+erfolgt mit dem Kommando 
+ 
+     check ("dateiname", archive)    (* oder *) 
+     check (ALL archive, archive)    (* fuer alle Archiv-Dateien *) 
+ 
+Durch dieses Kommando werden eventuelle Lese-Fehler gemeldet. 
+ 
+Weitere Fehlermeldungen des Archivs: 
+ 
+* Lesen unmöglich (Archiv)       Archiv-Floppy nicht eingelegt oder die Tür 
+                                 des Laufwerks ist nicht geschlossen. 
+ 
+* Schreiben unmöglich (Archiv)   Floppy ist schreibgeschützt. 
+ 
+* Archiv nicht angemeldet        Archiv wurde nicht angemeldet 
+                                 ('archive ("name")' geben). 
+ 
+* Lese-Fehler (Archiv)           Siehe obige Beschreibung. 
+ 
+* Schreibfehler (Archiv)         Die Floppy kann nicht (mehr) beschrieben 
+                                 werden. Andere Floppy verwenden. 
+ 
+* Speicherengpass                Im System ist nicht mehr genügend Platz, um 
+                                 eine Datei vom Archiv zu laden. 
+                                 Ggf. Dateien löschen. 
+ 
+* RERUN beim Archiv-Zugriff      Das System wurde bei einer Archiv-Operation 
+                                 durch Ausschalten bzw. Reset unterbrochen. 
+ 
+* ... gibt es nicht              Die Datei ... gibt es nicht auf dem Archiv. 
+ 
+* Archiv heißt ...               Die eingelegte Floppy hat einen anderen als 
+                                 den eingestellten Archiv-Namen. 
+ 
+* Archiv wird von Task ... benutzt   Das Archiv wurde von einem anderen 
+                                     Benutzer reserviert. 
+ 
+* ... kann nicht geschrieben werden (Archive voll)    Das Archiv ist voll. 
+                                                      Neue Archiv-Floppy 
+                                                      benutzen. 
+ 
+* Archiv inkonsistent            Die eingelegte Floppy hat nicht die Struk- 
+                                 tur einer Archiv-Floppy ('clear (archive)' 
+                                 vergessen). 
+ 
+* save/erase wegen Lese-Fehler verboten    Bei Archiven mit Lese-Fehler sind 
+                                           Schreiboperationen verboten, weil 
+                                           ein Erfolg nicht garantiert 
+                                           werden kann. 
+ 
+ 
+ 
+4. FILEs in Programmen 
+ 
+Die bisher geschilderten Kommandos gelten für alle Datei-Arten. In diesem 
+Kapitel wird der Standard Datei-Typ FILE beschrieben. Eine Datei von Daten- 
+typ FILE ist eine sequentielle Datei, die das Lesen und Schreiben von Daten 
+in strikter Aufeinanderfolge von Sätzen erlaubt (Betriebsrichtungen 'input' 
+und 'output'). Die Betriebsrichtung 'modify' erlaubt das gleichzeitige Lesen 
+und Schreiben sowie beliebiges Positionieren. 
+ 
+ 
+ 
+Deklaration, Assoziierung und Betriebsrichtungen 
+ 
+Für ELAN-Programme gibt es standardmäßig den Datentyp FILE. FILEs müssen 
+deklariert werden. Die Kopplung einer FILE VAR im Programm mit einer Datei 
+erfolgt durch eine Assoziierungsprozedur. Bei der Assoziierung muß man an- 
+geben, wie die Datei bearbeitet werden soll. 
+ 
+Dateien müssen in einem ELAN-Programm - wie alle anderen Objekte auch - 
+deklariert werden. Beispiel: 
+ 
+     FILE VAR f :: ... 
+ 
+Mit der Deklaration wird dem ELAN-Compiler der Name der Datei-Variablen 
+bekannt gemacht. Dabei ist zu beachten, daß im EUMEL-System alle FILEs mit 
+VAR deklariert werden müssen, denn jede Lese/Schreib-Operation verändert 
+einen FILE. FILE CONST Objekte sind also nicht erlaubt. Ähnlich wie bei 
+anderen Datenobjekten werden FILEs initialisiert. In der Regel erfolgt dies 
+mit einer Assoziierungsprozedur. Beispiele: 
+ 
+     FILE VAR meine datei :: sequential file (output, "daten")        
+     ... 
+     (* oder: *) 
+     TEXT VAR datei name; 
+     put ("Dateiname bitte:"); get (datei name); 
+     FILE VAR f :: sequential file (input, datei name); 
+ 
+Die Assoziierungsprozedur 'sequential file' hat die Aufgabe, eine in einem 
+Programm deklarierte FILE VAR mit einer bereits vorhandenen oder noch einzu- 
+richtenden Datei (abhängig von der Betriebsrichtung, siehe unten) des 
+EUMEL-Systems zu koppeln. Den Dateinamen gibt man als zweiten Parameter 
+an. Dadurch können ELAN-Programme geschrieben werden, die Dateien 
+bearbeiten, deren Namen man beim Erstellen des Programms noch nicht kennt. 
+ 
+Der erste Parameter gibt die sog. Betriebsrichtung an. Sie bestimmt, in 
+welcher Weise die assoziierte Datei bearbeitet wird. Es gibt folgende drei 
+Betriebsarten: 
+ 
+a) input: 
+   Die Datei kann vom Programm nur gelesen werden. Durch 'input' wird bei 
+   der Assoziierung automatisch auf den ersten Satz der Datei positioniert. 
+   Ist die zu lesende Datei nicht vorhanden, wird ein Fehler gemeldet. 
+ 
+b) output: 
+   Die Datei kann vom Programm nur beschrieben werden. Durch 'output' wird 
+   bei der Assoziierung automatisch hinter den letzten Satz der Datei 
+   positioniert (bei einer leeren Datei also auf den ersten Satz). Ist die 
+   Datei vor der Assoziierung nicht vorhanden, wird sie automatisch einge- 
+   richtet. 
+ 
+c) modify: 
+   Die Datei kann vom Programm in beliebiger Weise gelesen und beschrieben 
+   werden. Im Gegensatz zu den Betriebsrichtungen 'input' und 'output', bei 
+   denen ausschließlich ein rein sequentielles Lesen oder Schreiben erlaubt 
+   ist, kann bei 'modify' beliebig positioniert, gelöscht, eingefügt und neu 
+   geschrieben werden. Hier ist nicht definiert, auf welchen Satz der Datei 
+   man nach erfolgter Assoziierung steht. Die Datei wird automatisch einge- 
+   richtet, wenn sie vor der Assoziierung nicht vorhanden war. 
+ 
+Anmerkung: 
+In jeder Betriebsrichtung sind nur bestimmte Operationen zugelassen. Z.B. 
+sind bei 'input' keine Schreib-Prozeduren erlaubt. Vergl. dazu die nächsten 
+Abschnitte. 
+ 
+Neben der Betriebsrichtung 'input', 'output' oder 'modify' muß bei 
+'sequential file' als zweiter Parameter der Name der zu bearbeitenden Datei 
+angegeben werden. Beispiel: 
+ 
+     TEXT VAR datei name, zeile; 
+     put ("Bitte Name der zu bearbeitenden Datei eingeben:"); 
+     get (datei name); 
+     FILE VAR f :: sequential file (input, dateiname); 
+     ... 
+     getline (f, zeile); 
+     ... 
+ 
+Hier wird der Name der zu bearbeitenden Datei zuerst eingelesen. Diese Datei 
+wird mit 'f' in der Betriebsrichtung 'input' assoziiert, d.h. würde man z.B. 
+die Prozedur 
+ 
+     putline (f, irgendein text) 
+ 
+an einer Stelle im Programm verwenden, wird ein Fehler gemeldet. Die Be- 
+triebsrichtung hilft also, Fehler bei der Programmierung zu vermeiden. 
+ 
+Mit den Prozeduren 
+ 
+     modify (f) 
+     input  (f) 
+     output (f) 
+ 
+kann die Betriebsrichtung von Dateien geändert werden. 
+ 
+Dateien brauchen im EUMEL-System vor Programmende nicht geschlossen zu 
+werden, da sie vom System immer konsistent gehalten werden. 
+ 
+Merke: Die Betriebsrichtung gibt an, wie man eine Datei bearbeiten will. 
+'input' steht für Lesen, 'output' für Schreiben und 'modify' für Verändern. 
+Jede Datei muß vor einer Benutzung mit 'sequential file' assoziiert werden. 
+Die Assoziierungsprozedur stellt die Kopplung zwischen dem Programm und dem 
+EUMEL-Betriebssystem her. 
+ 
+ 
+ 
+Operationen der Betriebsrichtung 'output' 
+ 
+In der Betriebsrichtung 'output' sind nur Schreib-Operationen gestattet. 
+'output' ist also für das Bearbeiten von Ausgabedateien vorgesehen. 
+ 
+Mit den Prozeduren 
+ 
+     put 
+ 
+können INT-, REAL- und TEXT-Werte in eine Datei geschrieben werden. Die 
+Prozedur 
+ 
+     line 
+ 
+sorgt dafür, daß eine neue Zeile in der Datei begonnen wird. Beispiel: 
+ 
+     FILE VAR f :: sequential file (output, "daten"); 
+     put (f, "Daten:"); 
+     line (f); 
+     schreibe daten. 
+ 
+     schreibe daten: 
+     INT VAR intwert; 
+     REAL VAR textwert; 
+     put ("bitte Daten eingeben (INT, REAL):"); 
+     REP 
+       get (intwert); 
+       put (f, intwert); 
+       get (realwert); 
+       put (f, realwert); 
+       line (f); 
+     UNTIL yes ("fertig") END REP. 
+ 
+Durch die Assoziierungsprozedur mit der Betriebsrichtung 'output' wird 
+hinter den letzten Satz der Datei positioniert, bei einer leeren Datei also 
+auf den ersten Satz. In dem ersten Satz in unserem Beispiel wird also 
+'Daten:' geschrieben. Durch die Prozedur 'line' geht man auf den nächsten 
+Satz. Dann werden jeweils ein INT- und ein REAL-Wert in eine Datei-Zeile 
+geschrieben, bis die Frage 'fertig' mit 'j' beantwortet wird. 
+ 
+Die 'put'-Prozeduren schreiben die Werte jeweils in die aktuelle Datei-Zeile. 
+Zwischen den Werten wird von den 'put'-Prozeduren jeweils ein Leerzeichen 
+eingefügt. Im Gegensatz zu den 'put'-Prozeduren schreibt die Prozedur 'write' 
+einen TEXT ohne ein anschließendes Leerzeichen in die aktuelle Datei-Zeile. 
+Beispiel: 
+ 
+     ... 
+     write (f, "meine Daten:"); 
+     write (f, " "); 
+     write (f, text (17 + 4)); 
+     (* das Gleiche wie: put (f, "meine Daten:"); put (f, 17 + 4)   *) 
+ 
+Auf eine neue Datei-Zeile kann auf zwei verschiedene Arten positioniert 
+werden: 
+ 
+a) Prozedur 'line': 
+   Diese darf auch mit einem Parameter angegeben werden, der die Anzahl 
+   Zeilen angibt. Beispiel: 
+ 
+        line (f);    (* positioniert auf die naechste Zeile  *) 
+        line (f, 1)  (* das Gleiche                          *) 
+        line (f, 4)  (* Vier Zeilen weiter; dazwischen sind 3 Leerzeilen *) 
+ 
+b) Überschreiten der Zeilengrenze: 
+   Eine Datei-Zeile kann (voreingestellt) 77 Zeichen aufnehmen. Wird bei 
+   einer Schreib-Operation diese Grenze überschritten, wird der auszugebende 
+   Wert auf die nächste Zeile plaziert. Mit der Prozedur 'max line length' 
+   kann die eingestellte Datei-Zeilenlänge gelesen oder verändert werden. 
+   Beispiel: 
+ 
+        FILE VAR f :: sequential file (output, "meine daten"); 
+        put (max line length (f));    (* ergibt 77 *) 
+        max line length (f, 132); 
+        put (max line length (f))     (* ergibt 132 *) 
+ 
+   Ist die Länge des auszugebenden Textes größer als die verbleibende 
+   Zeilenbreite, wird der Text auf der nächsten Zeile ausgegeben. 
+ 
+Die 'putline'-Prozedur bietet die Möglichkeit, eine ganze Datei-Zeile auf 
+einmal auszugeben. Eine Positionierung auf die nächste Datei-Zeile ('line') 
+braucht dabei nicht vorgenommen werden. Beispiel: 
+ 
+     TEXT VAR zeile :: ""; 
+     ... 
+     zeile := ...; 
+     putline (f, zeile); 
+     ... 
+ 
+Merke: In der Betriebsrichtung 'output' kann in eine Datei geschrieben 
+werden. Dazu stehen die Prozeduren 'put', 'write' und 'putline' zur Verfü- 
+gung. Die Prozedur 'line' positioniert auf die nächste Zeile der Ausgabe- 
+datei. Mit 'max line length' kann die Länge einer Datei-Zeile verändert oder 
+erfragt werden. 
+ 
+ 
+ 
+Operationen der Betriebsrichtung 'input' 
+ 
+In der Betriebsrichtung 'input' sind nur Lese-Operationen gestattet. 'input' 
+ist also für das Bearbeiten von Eingabedateien vorgesehen. 
+ 
+Analog der Betriebsrichtung 'output' sind bei 'input' 'get'-Prozeduren vor- 
+handen, die INT-, REAL- oder TEXT-Werte aus einer Datei lesen. Beispiel: 
+ 
+     FILE VAR f :: sequential file (input, "Betriebszeiten"); 
+     REAL VAR zeiten; 
+     zeiten einlesen und berechnen. 
+ 
+     zeiten einlesen und berechnen: 
+        REP 
+          get (f, zeiten); 
+          IF zeiten = 0.0 
+            THEN LEAVE zeiten einlesen und berechnen 
+          FI; (* siehe auch 'eof'-Prozedur *) 
+          berechne 
+        END REP. 
+ 
+     berechne: 
+        ... 
+ 
+Die 'get'-Prozeduren positionieren automatisch auf die nächste Zeile, sofern 
+keine Werte mehr in der aktuellen Zeile vorhanden sind. Mit der Prozedur 
+'line' kann explizit auf die nächste Zeile positioniert werden. Damit können 
+die restlichen Daten einer Zeile überschlagen werden. Für die 'get'-Proze- 
+duren gilt, daß jeder zu lesende Wert entweder beim nächsten Leerzeichen 
+oder beim Zeilenende aufhört. Beispiel: 
+ 
+     FILE VAR f :: sequential file (input, "text"); 
+     TEXT VAR wort; 
+     lese worte. 
+ 
+     lese worte: 
+        REP 
+          get (f, wort); (* Lesen eines Worts ohne Leerzeichen *) 
+          put (wort);    (* Schreiben eines Worts mit Leerzeichen *) 
+          IF wort = "Ende" 
+            THEN LEAVE lese worte 
+          FI 
+        END REP. 
+ 
+ 
+Trennzeichen ("separator") zwischen den Worten sind also Leerzeichen, welche 
+nicht eingelesen werden. Manchmal sollen jedoch Daten eingelesen werden, die 
+durch andere Zeichen als dem Leerzeichen voneinander getrennt sind. Eine 
+Möglichkeit, solche Daten zu behandeln, bietet die 'getline'-Prozedur. Sie 
+liest (analog 'putline') eine ganze Zeile und positioniert auf die nächste 
+Zeile. Dann kann man mit Hilfe von TEXT-Prozeduren solche Zeilen 'per Hand' 
+auseinandernehmen. Als Beispiel zeigen wir ein Programm, welches den zweiten 
+Wert einer Zeile lesen soll. Die Werte werden durch Kommata voneinander 
+getrennt: 
+ 
+     FILE VAR eingabe datei :: sequential file (input, "daten"); 
+     TEXT VAR zeile, wert; 
+     lese jeweils zweiten wert; 
+     verarbeite wert. 
+ 
+     lese jeweils zweiten wert: 
+        REP 
+          getline (f, zeile); 
+          IF zeile = "Ende" 
+            THEN LEAVE lese jeweils zweiten wert 
+          FI; 
+          extrahiere zweiten wert 
+        END REP. 
+ 
+     extrahiere zweiten wert: 
+        wert := subtext (zeile, anfang, ende). 
+ 
+     anfang: 
+        pos (zeile, ",") + 1. 
+ 
+     ende: 
+        pos (zeile, ",", anfang) + 1. 
+ 
+     verarbeite wert: 
+        ... 
+ 
+Diese (etwas umständliche) Methode ist immer dann angebracht, wenn Zeilen 
+unterschiedlich untersucht werden müssen. Eine einfachere Möglichkeit, die 
+in vielen Fällen angewandt werden kann, bietet eine andere Form der 'get'- 
+Prozedur, bei der man das oder die Trennzeichen angeben kann. Beispiel: 
+ 
+     ... 
+     extrahiere zweiten wert: 
+        get (f, wert, ",");       (* ersten Wert der Zeile ueberlesen *) 
+        get (f, wert, ",").       (* hier der richtige zweite Wert    *) 
+ 
+Hier wird also das Trennzeichen mit angegeben (dritter Parameter). Eine 
+andere Methode müssen wir anwenden, wenn Daten nicht durch ein Trennzeichen 
+unterschieden werden, sondern nur durch ihre Länge definiert sind. Beispiel: 
+ 
+     ... 
+     lese fuenfstellige werte: 
+        REP 
+          get (f, wort, 5); 
+          verarbeite wert 
+          ... 
+        END REP. 
+ 
+Bei dieser 'get'-Prozedur wird die Länge des einzulesenden Textes als 
+dritter Parameter angegeben. Man beachte, daß die letzten zwei 'get'-Proze- 
+duren nur TEXTe einlesen. Entsprechende Typwandlungen hat der Programmierer 
+vorzunehmen. 
+ 
+Merke: Die Betriebsrichtung 'input' erlaubt nur Lesen aus einer Eingabedatei. 
+Für diesen Zweck gibt es die Prozeduren 'get', 'getline' und 'line'. 
+ 
+ 
+ 
+Operationen der Betriebsrichtung 'modify' 
+ 
+Die Betriebsrichtung 'modify' erlaubt das Lesen und Schreiben von Informa- 
+tionen auf Dateien. Zusätzlich ist beliebiges Positionieren auf Dateien 
+erlaubt. 'modify' ist also für Dateien gedacht, die man gleichzeitig als 
+Ausgabe- und Eingabedateien behandeln will. 
+ 
+Die Betriebsrichtung 'modify' erlaubt ein Ändern einer Datei ("updating"), 
+wobei die sequentielle Natur der Datei erhalten bleibt. 
+ 
+Eine Datei der Betriebsrichtung 'modify' muß ebenso mit 'sequential file' 
+assoziiert werden, wie bei den zwei anderen Betriebsrichtungen. Während bei 
+'input' auf den ersten bzw. bei 'output' auf den letzten Satz der Datei 
+positioniert wird, ist bei 'modify' nicht definiert, auf welchem Satz der 
+Datei nach erfolgter Assoziierung positioniert wird. Man muß also die erste 
+Positionierung explizit vornehmen. Für die Zwecke der Positionierung gibt es 
+die Prozeduren 
+ 
+     to line          (* auf eine bestimmte Zeile            *) 
+     col              (* auf eine Spalte innerhalb der Zeile *) 
+     down             (* eine Zeile vorwaerts                *) 
+     up               (* eine Zeile zurueck                  *) 
+ 
+Neben diesen Positionierungsprozeduren gibt es die Informationsprozeduren: 
+ 
+     lines             (* Anzahl Zeilen in der Datei *) 
+     line no           (* aktuelle Zeilennummer      *) 
+     eof               (* Dateiende?                 *) 
+ 
+Beispiele: 
+ 
+     down (f);        (* wie: to line (f, line no (f) + 1)   *) 
+                      (*                    Nicht über eof   *) 
+     up   (f);        (* wie: to line (f, line no (f) - 1)   *) 
+                      (*                Nicht über Zeile 1   *) 
+ 
+Mit der Prozedur 
+ 
+     read record 
+ 
+kann der Satz, auf den aktuell positioniert wurde, gelesen werden. Mit 
+ 
+     write record 
+ 
+kann sein Inhalt geschrieben werden (also auch "überschreiben"). Mit den 
+Prozeduren 
+ 
+     insert record 
+     delete record 
+ 
+kann eine Zeile vor der aktuellen eingefügt (Position ist dann die einge- 
+fügte Zeile) oder der aktuelle Satz gelöscht werden (Position ist dann der 
+nächste Satz). Beispiele: 
+ 
+     FILE VAR f :: sequential file (modify, "meine daten") 
+     TEXT VAR zeile, neue zeile; 
+     to line (f, 1); 
+     read record (f, zeile);  (* erste Zeile lesen         *) 
+     ... 
+     insert record (f);       (* neue erste Zeile          *) 
+     write record  (f, neue zeile); 
+     down (f);                (* auf die 2. Zeile, die vorher die 1. war *) 
+     delete record (f);       (* diese loeschen, so dass die 
+                                 Zeilenzahl wieder stimmt  *) 
+ 
+Das nächste Beispiel zeigt, wie hinter den letzten Satz einer Datei eine 
+Zeile eingefügt werden kann (hier wird ausgenutzt, daß man in der Betriebs- 
+richtung 'modify' hinter den letzten Satz der Datei positioniert werden 
+kann):   
+ 
+    FILE VAR f :: sequential file (modify, "test"); 
+    to line (f, lines (f));   (* auf die letzte Zeile      *) 
+    down (f); 
+    insert record (f); 
+    write record (f, "neue letzte Zeile"); 
+    ... 
+ 
+Mit 'down' bzw. 'up' kann man auch um einige Zeilen auf einmal vorwärts oder 
+rückwärts positionieren. Beispiele: 
+ 
+     down (f, 17)             (* 17 Zeilen vorwaerts   *) 
+     up   (f, 13)             (* 13 zeilen rueckwaerts *) 
+ 
+Merke: In der Betriebsrichtung 'modify' können Dateien gelesen und/oder ge- 
+schrieben werden ('read record' oder 'write record'). Positionierungen kön- 
+nen mit 'down', 'up' oder 'to line' vorgenommen werden. 
+ 
+ 
+ 
+Manipulationen von FILEs 
+ 
+FILEs können im EUMEL-System auch als Einheiten behandelt werden. Dazu 
+stehen die bereits erläuterten Prozeduren zur Verfügung, die wir hier der 
+Vollständigkeit halber nochmals aufführen. 
+ 
+Mit der Prozedur 
+ 
+     exists 
+ 
+kann erfragt werden, ob eine Datei bereits existiert. Beispiel: 
+ 
+     TEXT VAR name; 
+     REP 
+       erfrage name; 
+     UNTIL exists (name) END REP; 
+     ... 
+ 
+     erfrage name: 
+       put ("Dateiname bitte:"); 
+       get (name); 
+       line. 
+ 
+Weitere Prozeduren: 
+ 
+    forget                          (* Datei löschen *) 
+    rename                          (* umbenennen    *) 
+    copy                            (* kopieren      *) 
+ 
+Für Programmierer ist eine Version der 'forget'-Prozedur interessant, die 
+eine Datei ohne Kontroll-Anfrage löscht. Beispiel: 
+ 
+     forget ("meine scratch datei", quiet) 
+ 
+Merke: Mit 'exists' kann erfragt werden, ob ein FILE bereits existiert. 
+ 
+ 
+ 
+Texte Suchen 
+ 
+Mit den Prozeduren 'down' und 'up' kann man (ebenso wie im Editor) auch nach 
+Texten suchen. 
+ 
+Die Prozeduren 'down' bzw. 'up' suchen einen Text in der Datei. Beispiele: 
+ 
+     down (f, "dieser text") 
+     up (f, "noch'n text") 
+ 
+Diese Prozeduren suchen direkt auf der Dateistruktur. Wird der gesuchte Text 
+gefunden, steht man direkt auf dem gesuchten Text. Wird der Text nicht 
+gefunden, steht man auf dem ersten (bei 'up') oder hinter dem letzten (bei 
+'down') Zeichen der Datei. Die Position innerhalb der Zeile nach einer Suche 
+kann mit 
+ 
+     col (f) 
+ 
+abgefragt werden. Um die Suche auf einen Bereich zu beschränken, kann man 
+'down' bzw. 'up' mit einem weiterem Parameter versehen, der die max. Anzahl 
+von Zeilen angibt. Beispiel: 
+ 
+     FILE VAR f :: ... 
+     ... 
+     INT VAR akt zeilennr :: line no (f); 
+     down (f, "pattern", 100); 
+     (* sucht in den naechsten 100 Zeilen nach 'pattern' *) 
+     IF line no (f) <> akt zeilen nr + 100 
+       THEN gefunden 
+       ELSE nicht gefunden 
+     FI; 
+     ... 
+ 
+Achtung: 'down' bzw. 'up' beginnen die Suche immer mit dem nächsten Zeichen 
+in Suchrichtung, so daß man mehrmals hintereinander suchen kann, ohne in 
+eine Endlosschleife zu geraten (Erinnerung: wird ein Text gefunden, ist die 
+Position innerhalb der Zeile das erste Zeichen des gesuchten Begriffs). 
+ 
+Mit den Prozeduren (gleiche Parameterversorgung wie 'down' und 'up') 
+ 
+     downety 
+     uppety 
+ 
+beginnt man mit der Suche immer auf der aktuellen Position. Darum sollte man 
+diese Prozeduren mit Vorsicht verwenden. Mit der Prozedur 
+ 
+     pattern found 
+ 
+kann man anfragen, ob die letzte Suchoperation erfolgreich war oder nicht. 
+Beispiel: 
+ 
+     FILE VAR f :: ... 
+     ... 
+     INT VAR akt zeilennr :: line no (f); 
+     down (f, "pattern", 100); 
+     (* sucht in den naechsten 100 Zeilen nach 'pattern' *) 
+     IF pattern found THEN gefunden 
+       ELSE nicht gefunden 
+     FI; 
+     ... 
+ 
+Mit der Prozedur 
+ 
+     at 
+ 
+kann man anfragen, ob man auf einem gewünschten Wort steht. Beispiel: 
+ 
+     IF at (f, "pattern") 
+       THEN .. 
+     FI 
+ 
+Die Prozedur 
+ 
+     word 
+ 
+liefert das aktuelle Wort der aktuellen Position einer Zeile. Beispiele: 
+ 
+     TEXT VAR dieses wort :: word (f); 
+     (* Zeichenkette von der aktuellen Position bis zum nächsten Blank oder 
+     Zeilenende *) 
+     dieses wort := word (f, "<"); 
+     (* Zeichenkette (Wort) von der aktuellen Position bis zum Zeichen '<' 
+     oder Zeilenende *) 
+     dieses wort := word (f, 13); 
+     (* Zeichenkette (Wort) mit der Laenge 13 *) 
+ 
+Merke: Die Prozeduren 'down' und 'up' suchen einen Text innerhalb einer 
+Datei. Mit 'at' kann man anfragen, ob man auf dem gesuchten Begriff steht. 
+'word' liefert das aktuelle Wort. 
+ 
+ 
+ 
+FILE-Ausschnitte 
+ 
+Hier wird erklärt, wie man mehrere Zeilen aus einer Datei auf einmal löschen 
+und/oder verschieben und wie man nur einen Ausschnitt einer Datei zugänglich 
+machen kann. 
+ 
+Den einfachsten Zugang zu Datei-Abschnitten erhält ein Programmierer durch 
+einige Anwendungsprozeduren, die u.a. auch im Editor verwandt werden. Dort 
+gibt es die Möglichkeit, einen markierten Bereich "vorsichtig" zu löschen 
+und u.U. an anderer Stelle wieder einzufügen (ESC RUBOUT und ESC RUBIN). 
+Solche Prozeduren stehen auch einem Programmierer zur Verfügung. Beispiel: 
+ 
+     FILE VAR f :: .... 
+     .... 
+     remove (f, 100);       (* entfernt 100 Zeilen von der aktuellen 
+                               Position rueckwaerts (!) aus der Datei 'f' *) 
+     to line (27);          (* zum Beispiel *) 
+     re insert (f)          (* fuegt die "vorsichtig" geloeschten Zeilen vor 
+                               (!) die Zeile 27 ein *) 
+ 
+Die Prozedur 
+ 
+     remove 
+ 
+löscht also eine angebbare Anzahl von Zeilen in der Datei (rückwärts von der 
+aktuellen Zeilennummer ab) und schreibt diesen Datei-Abschnitt in einen 
+internen Puffer. Man beachte, daß sich dabei natürlich die Zeilennummer der 
+Datei ändert. Die entfernten Zeilen können aus dem internen Puffer an einer 
+anderen Stelle durch 
+ 
+     reinsert 
+ 
+genau einmal wieder eingefügt werden. Sollen jedoch die mit 'remove' ent- 
+fernten Zeilen wirklich gelöscht und nicht mehr an anderer Stelle eingesetzt 
+werden, dann kann man die Prozedur 
+ 
+     clear removed 
+ 
+verwenden. Beispiel: 
+ 
+     ... 
+     remove (f, 50);        (* loescht vorsichtig *) 
+     clear removed (f);     (* und endgueltig     *) 
+     ... 
+ 
+Durch solche Löschungen oder Einfügungen entstehen Datei-Segmente. 
+Innerhalb eines Segments kann direkt positioniert werden. Werden jedoch 
+Löschungen oder Einfügungen vorgenommen (Sätze werden ein- oder ausgekettet), 
+muß erst zu einem entsprechenden Segment positioniert und dann innerhalb des 
+Segments auf den entsprechenden Satz positioniert werden. Das kann - je nach 
+Anzahl der Segmente - zeitaufwendig sein. Deshalb existiert die Prozedur 
+ 
+     segments 
+ 
+mit der man feststellen kann, wieviel Datei-Segmente in der Datei existieren. 
+(Sind es "zu viele", kann man die Datei "reorganisieren"). 
+ 
+Diese und die folgenden Prozeduren nutzen eine vom EUMEL-System bereitge- 
+stellte Möglichkeit, Ausschnitte aus Dateien wie eigenständige Dateien zu 
+behandeln. Beispiel: 
+ 
+    FILE VAR f :: ... 
+    ... 
+    FRANGE VAR alter bereich; 
+    set range (f, 200, 1, alter bereich); 
+        (* Datei mit 200 Zeilen von der Spalte 1 der aktuellen Zeile *) 
+    edit (f);                          (* Zeilen 1-200 editieren *) 
+    set range (f, alter bereich);      (* Datei zuruecksetzen *) 
+    ... 
+ 
+Von dem Beispiel-Programm wird die Datei 'f' bearbeitet. Die FRANGE-Variable 
+dient hier dazu, sich den ursprünglichen Bereich der Datei 'f' (der auch 
+schon eingeschränkt sein kann), zu merken. Mit der Prozedur 'set range' wird 
+die Datei 'f' auf 200 Zeilen eingeschränkt (von der aktuellen Zeile 200 
+Zeilen rückwärts). Mit der Prozedur 'edit' kann nun der Benutzer unseres 
+Programms die (eingeschränkte) Datei beliebig editieren. Ihm steht am Anfang 
+Zeilen 1 bis 200 zur Verfügung; die "ausgeblendeten" Datei-Teile kann er 
+nicht verändern. Mit dem zweiten Aufruf von 'set range' wird der einge- 
+schränkte (und u.U. veränderte) Datei-Bereich aufgehoben, so daß hier wieder 
+alle ursprünglichen Datei-Zeilen zur Verfügung stehen. 
+ 
+Solche Beschränkungen können natürlich mehrmals geschachtelt vorgenommen 
+werden. Um nach Ablauf solcher Programmteile sicher wieder die ursprüngliche 
+Datei (mit allen ihren Zeilen) zur Verfügung zu haben, gibt es die Prozedur 
+ 
+     reset range (f) 
+ 
+Sie setzt die Datei 'f' auf den größtmöglichen Bereich zurück. 
+ 
+Merke: Mit 'remove' und 'reinsert' können Zeilen gelöscht und/oder ver- 
+schoben werden. Mit dem Datentyp FRANGE und den Prozeduren 'set range' 
+können Dateien eingeschränkt werden. 
+ 
+ 
+ 
+5. Datenräume 
+ 
+Die bis jetzt behandelten Dateien können nur TEXTe aufnehmen (bei einigen 
+Schreib-/Lese-Operationen werden Daten in Texte umgewandelt, z.B. bei 'get' 
+und 'put'). Damit ist gewährleistet, daß alle Programme im EUMEL-System 
+(Editor, Drucker, Compiler, Benutzer-Programme usw.) auf gleiche Art und 
+Weise auf Dateien zugreifen können, unabhängig davon, welche Daten wirklich 
+gespeichert sind. Der folgende Abschnitt zeigt, wie man mit Dateien umgeht, 
+die nicht vom Standardtyp FILE sind. 
+ 
+ 
+ 
+Konzept des Datenraums 
+ 
+Standarddateien (FILEs) können nur Texte aufnehmen, da sie ja hauptsächlich 
+für die Kommunikation mit dem Menschen (vorwiegend mit Hilfe des Editors bzw. 
+Ein-/Ausgabe) gedacht sind. Will man Zahlen in einen FILE ausgeben, so 
+müssen diese zuvor in Texte umgewandelt werden. Hierfür stehen Standard- 
+prozeduren zur Verfügung (z.B. 'put (f, 17)'). 
+ 
+Will man aber Dateien zur Kommunikation zwischen Programmen verwenden, die 
+große Zahlenmengen austauschen, verursachen die Umwandlungen von Zahlen 
+in TEXTe und umgekehrt unnötigen Rechenaufwand. Daher wurden in EUMEL� die 
+Datenräume eingef�hrt, die es gestatten, beliebige Strukturen (Typen) in 
+Dateien zu speichern. Solche Datenräume kann man weder mit dem Editor noch 
+mit dem Standarddruckprogramm (print) bearbeiten, da diese ja den Typ des in 
+der Datei gespeicherten Objektes nicht kennen. 
+ 
+Einen Datenraum kann man sich als eine Sammlung von Daten vorstellen (u.U. 
+leer), die ausschließlich von einem Programm her behandelt wird. Man kann 
+einem Datenraum durch ein Programm einen Datentyp "aufprägen". Meist handelt 
+es sich um Reihungen, weil die Benutzung von Datenräumen erst bei größeren 
+Datenmengen lohnt. Nach einem solchen "Aufpräge"-Vorgang kann der Datenraum 
+wie ein "normaler" Datentyp behandelt werden, mit dem Unterschied, daß die 
+Daten in einem Datenraum (d.h. Datei) gespeichert werden. Somit können nach- 
+folgende Programme auf die im Datenraum gespeicherten Daten zugreifen, so- 
+fern sie den gleichen Datentyp auf den Datenraum aufprägen. 
+ 
+Merke: Ein Datenraum ist eine Sammlung von Daten. Er kann ausschließlich 
+durch ein Programm (und z.B. nicht durch den Editor) behandelt werden. 
+Programme können Datenräumen Datentypen aufprägen und sie dann mit den ver- 
+fügbaren Operationen dieses Datentyps manipulieren. 
+ 
+ 
+Ein Beispiel 
+ 
+Diesen etwas komplizierten Vorgang wollen wir an Hand eines Beispiels 
+Schritt für Schritt erklären. 
+ 
+Angenommen, Programmierer Meier hat ein Gehaltsprogramm zu erstellen. Er 
+überlegt sich, das Programm in (mindestens) zwei Moduln (PACKETs) zu er- 
+stellen: 
+ 
+a) Berechnung der Gehaltssumme aus den Arbeitszeiten (also Bruttogehalt) und 
+   dann 
+b) Endgültige Berechnung der Gehälter durch Abzug von Steuern usw. 
+ 
+Das Programm aus a) erstellt also eine Gehaltsliste für alle Beschäftigten 
+des Betriebs. Die Gehaltsliste soll ebenfalls von Modul b) genutzt werden. 
+ 
+Meier entschließt sich, die Gehaltsliste in einem Datenraum zu speichern. 
+Das hat neben der effizienteren Bearbeitung noch den Vorteil, daß man die 
+Gehaltsliste - ohne Programmierkenntnisse zu besitzen - nicht mit dem Editor 
+bearbeiten kann (Datenschutz). 
+ 
+Dem ELAN-Compiler muß Meier also mitteilen, daß die Reihung für die 
+Gehaltsliste (oder irgendein anderer Datentyp) nicht im Speicherbereich des 
+Programms, sondern in einem Datenraum gespeichert werden soll. Dies erfolgt 
+mit dem Schlüsselwort BOUND, welches dem Datentyp bei der Deklaration 
+vorangestellt wird. Beispiel: 
+ 
+     BOUND ROW 1000 REAL VAR gehaltsliste 
+ 
+Dieses BOUND-Objekt muß Meier noch mit einer Datei verbinden, man spricht 
+von "ankoppeln". Die Ankopplung erfolgt durch den Operator ':='. Dies kann 
+man gleich bei der Initialisierung vornehmen. Beispiel: 
+ 
+     BOUND ROW 1000 REAL VAR gehaltsliste := new ("hugo") 
+ 
+Die Prozedur 'new' kreiert dabei einen leeren Datenraum (hier mit dem Namen 
+'hugo'), der mit Hilfe der Zuweisung (hier: Initialisierung) an die Variable 
+'gehaltsliste' gekoppelt wird. 
+ 
+Nun kann Meier mit der 'gehaltsliste' arbeiten wie mit allen anderen Feldern 
+auch, mit dem Unterschied, daß die Daten, die er in 'gehaltsliste' speichert, 
+eigentlich im Datenraum 'hugo' gespeichert sind. Beispiele: 
+ 
+     gehaltsliste [5] := 10 000.0;           (* Traumgehalt *) 
+     gehaltsliste [index] INCR 200.0;        (* usw.        *) 
+ 
+Meier kann auch Prozeduren schreiben, die auf der Gehaltsliste arbeiten. 
+Beispiel: 
+ 
+     PROC sort (ROW 1000 REAL VAR liste): 
+     ... 
+     END PROC sort; 
+     ... 
+     sort (gehaltsliste); 
+     ... 
+ 
+Man beachte, daß der formale Parameter der Prozedur 'sort' nicht mit BOUND 
+spezifiziert werden darf (BOUND wird nur bei der Deklaration des Objekts 
+angegeben). Das ist übrigens ein weiterer wichtiger Vorteil von BOUND-Objek- 
+ten: man kann alle Prozeduren des EUMEL-Systems auch für BOUND-Objekte 
+verwenden, nur die Datentypen müssen natürlich übereinstimmen. 
+ 
+Nach der Bearbeitung des Moduls a) ist Meier nun sicher, daß seine Brutto- 
+daten in dem Datenraum 'hugo' stehen. Meier braucht (genauso wie bei FILEs) 
+den Datenraum nicht zu schließen. Im zweiten Modul muß Meier nun erneut ein 
+BOUND-Objekt deklarieren. 
+Deshalb deklariert Meier nun 
+ 
+     BOUND ROW 1000 REAL VAR nettoliste :: old ("hugo"); 
+ 
+Hier muß Meier nun die Prozedur 'old' verwenden, weil der Datenraum bereits 
+aus dem ersten Modul existiert. Nun kann Meier weiter programmieren, bis er 
+letztendlich den Datenraum löscht: 
+ 
+     forget ("hugo") 
+ 
+Merke: Ein Datenobjekt eines beliebigen Datentyps kann mit einem vorange- 
+stellten BOUND deklariert werden und an einen Datenraum gekoppelt werden. 
+Der Datentyp ist dann auf den Datenraum aufgeprägt und man kann mit ihm 
+arbeiten wie mit allen anderen Objekten dieses Datentyps. 
+ 
+ 
+ 
+Datenräume als Datentyp 
+ 
+Datenräume können auch als eigener Datentyp (DATASPACE) in einem Programm 
+behandelt werden. Somit können Datenräume (als Ganzes) ohne Kenntnis eines 
+eventuell (vorher oder später) aufgeprägten Typs verwandt werden. 
+ 
+Als Operationen auf DATASPACE-Objekten sind nur Transporte, Löschen und 
+Initialisieren zugelassen. 
+ 
+     DATASPACE VAR ds :: old ("daten"); 
+ 
+Der Zuweisungsoperator bewirkt eine Kopie des Datenraums vom rechten auf 
+den linken Operanden. Des weiteren gibt es eine DATASPACE Konstante 'nil- 
+space', die eine leere Datenraum repräsentiert. Mit diesem Wert initialisiert 
+der Datei-Manager Dateien, die neu kreiert werden. 
+ 
+Eine neuer Datenraum kann durch 
+ 
+     new ("name") 
+ 
+eingerichtet werden. 'new' liefert gleichzeitig einen Datenraum und wird 
+deshalb für Initialisierungen verwandt. Beispiel: 
+ 
+     DATASPACE VAR datenraum :: new ("name1");   (* Kopie ! *) 
+ 
+Ein bereits vorhandener Datenraum in der Benutzer-Task kann mit 
+ 
+     old ("datei") 
+ 
+erneut benutzt werden. 'old' liefert (wie 'new') einen DATASPACE, so daß 
+'old' ebenfalls zur Initialisierung benutzt werden kann. Die Prozedur 
+ 
+     nilspace 
+ 
+liefert einen leeren Datenraum. 
+ 
+Für Datenräume gelten zusätzlich einige der Prozeduren wie für FILEs, u.a.: 
+ 
+     forget 
+     fetch 
+     save 
+     rename 
+ 
+Ausgenommen davon sind Prozeduren, die einen TEXT-File voraussetzen, wie 
+z.B. 'crypt' und 'decrypt', 'put', 'putline' usw. 
+ 
+Abschließend soll hier noch auf häufig gemachte Fehler hingewiesen werden: 
+ 
+Wenn man an ein DATASPACE-Objekt zuweist (z.B.: DATASPACE VAR ds := 
+new ("mein datenraum")) so erhält man, wie oben erwähnt, eine Kopie des 
+Datenraums in 'ds'. Koppelt man jetzt 'ds' an ein BOUND-Objekt an und führt 
+Änderungen durch, so wirken diese nur auf die Kopie und nicht auf die Quelle 
+(d.h. im Beispiel, daß die Datenraum 'hugo' nicht verändert wird, hier also 
+leer bleibt). Für Änderungen in den vom Datei-Manager verwalteten Dateien 
+ist also stets direkt anzukoppeln, wie es im Beispiel gezeigt wurde. 
+ 
+Wenn man ein DATASPACE-Objekt benutzt, ohne den Datei-Manager zu verwenden, 
+so muß man selbst dafür sorgen, daß dieses Objekt nach seiner Benutzung 
+wieder gelöscht wird. Das Löschen geschieht durch die Prozedur 'forget'. 
+Ferner ist zu beachten, daß vor der Ankopplung an ein BOUND-Objekt das 
+DATASPACE-Objekt initialisiert wird (im Normalfall mit 'nilspace'). Beispiel: 
+ 
+     DATASPACE VAR ds :=  nilspace; 
+     BOUND ROW 1000 REAL VAR real feld := ds; 
+     .... 
+     real feld [index] := wert; 
+     .... 
+     forget (ds) (* Datei löschen, damit der Platz wieder verwendet wird *) 
+ 
+Ein automatisches Löschen von DATASPACE-Objekten erfolgt auch nicht bei 
+Programmende (sonst könnten sie ihre Funktion als Datei nicht erfüllen). 
+Erst beim Löschen einer Task werden alle ihr gehörenden DATASPACE-Objekte 
+freigegeben. Verboten ist weiterhin folgendes: 
+ 
+     BOUND X ...; 
+ 
+wobei 'X' mit BOUND deklariert wurde oder ein DATASPACE ist. 
+ 
+Merke: Datenräume können durch 'new' erschaffen werden. Mit 'old' kann ein 
+bereits vorhandener Datenraum angesprochen werden. Im Übrigen gelten auch 
+einige der für FILEs vorhandenen Operationen. 
+ 
+ 
+ 
+Datei-Typen definieren 
+ 
+Durch die Datenräume und die Datentyp-Definition von ELAN ist es für 
+Programmierer relativ einfach, neue Datei-Datentypen zu definieren. 
+ 
+In der Regel reicht der Datentyp FILE für "normale" Anwendungen aus, jedoch 
+kann es manchmal sinnvoll und notwendig sein, neue Datei-Typen für spezielle 
+Aufgaben zu definieren. 
+ 
+In diesem Abschnitt zeigen wir an dem Beispiel DIRFILE (welcher zwar im 
+ELAN-Standard definiert, aber nicht im EUMEL-System realisiert ist), wie ein 
+neuer Datei-Datentyp definiert wird: 
+ 
+     PACKET dirfiles DEFINES DIRFILE, :=, dirfile, getline, ...: 
+ 
+     LET maxsize = 1000; 
+ 
+     TYPE DIRFILE = BOUND ROW maxsize TEXT; 
+     (* DIRFILE besteht aus TEXTen; Zugriff erfolgt ueber einen 
+        Schluessel, der den Index auf die Reihung darstellt *) 
+ 
+     OP := (DIRFILE VAR dest, DATASPACE CONST space): 
+       CONCR (dest) := space 
+     END OP :=; 
+ 
+     DATASPACE PROC dirfile (TEXT CONST name): 
+       IF exists (name) 
+         THEN old (name) 
+         ELSE new (name) 
+       FI 
+     END PROC dirfile; 
+ 
+     PROC getline (DIRFILE CONST df, INT CONST index, TEXT VAR record): 
+       IF index <= 0 
+         THEN errorstop ("access before first record") 
+       ELIF index > maxsize 
+         THEN errorstop ("access after last record") 
+         ELSE record := df [index] 
+       FI 
+     END PROC getline; 
+ 
+     PROC putline (DIRFILE CONST df, INT CONST index, TEXT VAR record): 
+       ... 
+     END PROC putline; 
+ 
+     ... 
+     END PACKET dirfiles; 
+ 
+Die Prozedur 'dirfile' ist die Assoziierungsprozedur für DIRFILEs (analog 
+'sequential file' bei FILEs). 'dirfile' liefert entweder einen bereits vor- 
+handenen Datenraum oder richtet einen neuen ein. Um eine Initialisierung mit 
+der 'dirfile'-Prozedur vornehmen zu können, braucht man auch einen Zu- 
+weisungsoperator, der den Datenraum an den DIRFILE-Datentyp koppelt. 
+ 
+Zugriffe auf einen DIRFILE sind nun relativ einfach zu schreiben. Im obigen 
+Beispiel wird nur die Prozedur 'getline' gezeigt. 
+ 
+Nun ist es möglich, Programme zu schreiben, die den DIRFILE-Datentyp 
+benutzen. Beispiel: 
+ 
+     DIRFILE VAR laeufer :: 
+           dirfile ("Nacht von Borgholzhausen"); 
+     INT VAR nummer; 
+     TEXT VAR name; 
+ 
+     REP 
+       put ("Startnummer bitte:"); 
+       get (nummer); 
+       line; 
+       put ("Name des Laeufers:"); 
+       get (name); 
+       putline (laeufer, nummer, name); 
+       line 
+     UNTIL no ("weiter") END REP; 
+     ... 
+ 
+Merke: Neue Datei-Typen für spezielle Anwendungen kann man leicht selbst 
+programmieren. 
+ 
+ 
+ 
+6. Beschreibung der Prozeduren 
+ 
+In diesem Abschnitt werden alle Operationen, die für Dateien zur Verfügung 
+stehen, aufgeführt. Dabei werden die Operationen für FILEs und Datenräume 
+mit (F) gekennzeichnet. 
+ 
++ 
+   THESAURUS OP + (THESAURUS CONST left, right) 
+   Zweck: Vereinigungsmenge von 'left' und 'right'. 
+ 
+   THESAURUS OP + (THESAURUS VAR left, TEXT CONST name) 
+   Zweck: Nimmt den TEXT 'name' in den Thesaurus 'left' auf. Beispiel: 
+ 
+             save (SOME father + "hugo", archive) 
+ 
+- 
+   THESAURUS OP - (THESAURUS CONST left, right) 
+   Zweck: Differenzmenge von 'left' und 'right'. 
+ 
+   THESAURUS OP - (THESAURUS VAR left, TEXT CONST name) 
+   Zweck: Liefert einen Thesaurus aus left, aber ohne den Eintrag 'name'. 
+          Beispiel: 
+ 
+             save (ALL myself - "hugo", archive) 
+ 
+/ 
+   THESAURUS OP / (THESAURUS CONST left, right) 
+   Zweck: Schnittmenge von 'left' und 'right'. 
+ 
+   TASK OP / (TEXT CONST task name) 
+   Zweck: Liefert aus einem Tasknamen den internen Tasknamen. '/' kann über- 
+          all dort eingesetzt werden, wo ein interner Taskname verlangt wird. 
+ 
+ALL 
+   THESAURUS OP ALL (TASK CONST task) 
+   Zweck: Liefert einen Thesaurus, der alle Dateinamen der angegebenen Task 
+          enthält (auch der Benutzer-Task: 'myself'). 
+ 
+   THESAURUS OP ALL (TEXT CONST file name) 
+   Zweck: Liefert einen Thesaurus, der die in 'file name' vorhandenen Datei- 
+          namen (jede Zeile ein Name) enthält. 
+ 
+at (F) 
+   BOOL PROC at (FILE VAR f, TEXT CONST word) 
+   Zweck: Abfrage, ob man auf 'word' in der Datei 'f' positioniert ist. 
+          Beispiel: 
+ 
+            ... 
+            down (f, "muster") 
+            IF at (f, "muster") 
+              THEN gefunden 
+              ELSE nicht gefunden 
+            FI; 
+            ... 
+ 
+archive 
+   PROC archive (TEXT CONST archive name) 
+   Zweck: Anmeldung von Archiv-Operationen. 'archive name' wird zur Über- 
+          prüfung für alle folgenden Archiv-Operationen verwandt, um die 
+          unberechtigte Benutzung eines Archivs zu verhindern. Die Anmeldung 
+          wird abgelehnt, wenn ein anderer Nutzer das Archiv belegt hat. 
+ 
+   TASK PROC archive 
+   Zweck: Liefert den internen Task-Bezeichner für die Verwendung in 
+          Datei-Kommandos. Beispiel: 
+ 
+              save ("datei", archive) 
+ 
+brother 
+   TASK PROC brother (TASK CONST task) 
+   Zweck: Liefert den internen Task-Bezeichner der angegebenen "Bruder"- 
+          Task. 
+ 
+check 
+   PROC check (TEXT CONST dateiname, TASK CONST task) 
+   Zweck: Überprüft, ob die Datei 'dateiname' auf dem Archiv lesbar ist. 
+          Beispiel: 
+ 
+             check ("meine datei", archive) 
+ 
+   PROC check (THESAURUS CONST t, TASK CONST task) 
+   Zweck: Überprüft, ob die in dem Thesaurus 't' enthaltenen Dateien auf dem 
+          Archiv lesbar sind. Beispiel: 
+ 
+             check (ALL archive, archive) 
+ 
+clear 
+   PROC clear (TASK CONST task) 
+   Zweck: Löscht alle Dateien der Task 'task'. Ist z.Z. nur für die Task 
+          'ARCHIVE' implementiert. 
+ 
+clear removed (F) 
+   PROC clear removed (FILE VAR f) 
+   Zweck: Löscht die mit 'remove' "vorsichtig" gelöschten Zeilen aus der 
+          Datei 'f' endgültig. 
+ 
+close (F) 
+   PROC close (FILE VAR file) 
+   Zweck: Schließen der Datei 'file'. Im EUMEL-System ist der Aufruf von 
+          'close' nicht notwendig. 'close' wurde nur aufgenommen, um die 
+          Kompatibilität zu Standard zu wahren. 
+ 
+col (F) 
+   PROC col (FILE VAR f, INT CONST position) 
+   Zweck: Positionierung auf die Spalte 'position' innerhalb der aktuellen 
+          Zeile. 
+ 
+   INT PROC col (FILE CONST f) 
+   Zweck: Liefert die aktuelle Position innerhalb der aktuellen Zeile. 
+ 
+copy (F) 
+   PROC copy (TEXT CONST source, destination) 
+   Zweck: Kopiert die Datei 'source' in eine neue Datei mit dem Namen 
+          'destination' in der Benutzer-Task. 
+   Fehlerfälle: 
+        * destination file already exists 
+          Eine Datei mit dem Namen 'destination' existiert bereits. 
+        * source file does not exist 
+          Die Ursprungsdatei mit dem Namen 'source' ist nicht vorhanden. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- 
+          schritten. 
+ 
+   PROC copy (DATASPACE CONST ds, TEXT CONST destination) 
+   Zweck: Eintragen eines unbenannten DATASPACE in die Datei-Verwaltung. 
+   Fehlerfälle: 
+        * destination file already exists 
+          Eine Datei mit dem Namen 'destination' existiert bereits. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- 
+          schritten. 
+ 
+create 
+   PROC create (TEXT CONST name) 
+   Zweck: Erschafft einen neuen Datenraum in der Benutzer-Task. 
+   Fehlerfälle: 
+        * file already exists 
+          Eine Datei mit dem Namen 'name' existiert bereits in der Benutzer- 
+          Task. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- 
+          schritten. 
+ 
+crypt (F) 
+   PROC crypt (TEXT CONST name, parole) 
+   Zweck: Verschlüsseln des Inhaltes der Datei 'name' mit Hilfe des Textes 
+          'parole' für Zwecke des Datenschutzes. Die Verschlüsselung ist 
+          umso besser (bzw. umso schwieriger zu "knacken"), je länger der 
+          Text 'parole' ist. Die Datei kann mit der Prozedur 'decrypt' 
+          wieder entschlüsselt werden. 
+ 
+          Eine Datei kann mehrfach verschlüsselt werden. Dabei gilt bei 
+          einer Entschlüsselung das Klammerungsprinzip. Es muß also genau so 
+          oft entschlüsselt werden, wie anfangs verschlüsselt wurde. Dabei 
+          ist auf die richtige Angabe der 'parole'n zu achten. Beispiel: 
+ 
+               crypt ("hugo", "verschluesselung1"); 
+               crypt ("hugo", "verschluesselung2"); 
+               ... 
+               decrypt ("hugo", "verschluesselung2"); 
+               decrypt ("hugo", "verschluesselung1") 
+ 
+          Achtung: 'crypt' und 'decrypt' sind nicht standardmäßig insertiert. 
+ 
+decrypt (F) 
+   PROC decrypt (TEXT CONST name, parole) 
+   Zweck: Entschlüsselt die Datei 'name' mit Hilfe der angegebenen 'parole'. 
+          Dabei ist darauf zu achten, daß die gleiche 'parole' anzugeben 
+          ist, die verwendet wurde, um die Datei zu verschlüsseln (sonst 
+          wirkt 'decrypt' wie ein erneuter Aufruf von 'crypt').Beim mehr- 
+          fachen Ver- und Entschlüsseln ist das Klammerungsprinzip zu be- 
+          achten (dazu vergl. 'crypt'). 
+ 
+delete record (F) 
+   PROC delete record (FILE VAR file) 
+   Zweck: Der aktuelle Satz der Datei 'file' wird gelöscht. Der folgende 
+          Satz wird der aktuelle Satz. Die Datei 'file' muß mit der Verar- 
+          beitungsart 'modify' assoziiert worden sein. 
+ 
+do 
+   PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) 
+   Zweck: Ruft 'operate' mit allen im 'thesaurus' enthaltenen Dateinamen 
+          nacheinander auf. Man beachte, daß bei Prozedur-Parametern der 
+          Name der Prozedur hinter dessen Parametern geschrieben wird. 
+          Beispiel: 
+ 
+            do (PROC (TEXT CONST) reorganize, ALL myself) 
+ 
+   PROC do (PROC (TEXT CONST, TASK CONST) operate, 
+            THESAURUS CONST thesaurus, TASK CONST task) 
+   Zweck: S.o.. Dabei ist zu beachten, daß 'task' als zweiter Parameter in 
+          der Prozedur 'operate' eingesetzt wird. Beispiel: 
+ 
+           do (PROC (TEXT CONST, TASK CONST) save, 
+               SOME myself, father) 
+           (* enspricht: *) 
+           save (SOME myself, father) 
+ 
+down (F) 
+   PROC down (FILE VAR f) 
+   Zweck: Positionieren um eine Zeile vorwärts in der Datei 'f'. 
+ 
+   PROC down (FILE VAR f, INT CONST number) 
+   Zweck: Positionieren um 'number' Zeilen vorwärts in der Datei 'f'. 
+ 
+   PROC down (FILE VAR f, TEXT CONST pattern) 
+   Zweck: Suche nach 'pattern' in der Datei 'f'. Wird 'pattern' gefunden, 
+          ist die Position das erste Zeichen von 'pattern'. Andernfalls 
+          steht man hinter dem letzten Zeichen der Datei. Achtung: 'down' 
+          sucht vom nächsten Zeichen rechts ab, so daß wiederholtes Suchen 
+          keine Endlosschleife ergibt. 
+ 
+   PROC down (FILE VAR f, TEXT CONST pattern, INT CONST number) 
+   Zweck: Wie obiges 'down', aber maximal nur 'number'-Zeilen weit. 
+ 
+downety (F) 
+   PROC downety (FILE VAR f, TEXT CONST pattern) 
+   Zweck: Suche nach 'pattern' in der Datei 'f'. Wird 'pattern' gefunden, 
+          ist die Position das erste Zeichen von 'pattern'. Andernfalls 
+          steht man auf dem letzten Zeichen der Datei. Achtung: 'downety' 
+          sucht (im Gegensatz zu 'down') vom aktuellen Zeichen. 
+ 
+   PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST number) 
+   Zweck: Wie obiges 'downety', aber maximal nur 'number'-Zeilen weit. 
+ 
+enter password 
+   PROC enter password (TEXT CONST password) 
+   Zweck: Einstellen eines Paßwortes in der Benutzer-Task für den Datei- 
+          Verkehr mit einer Vater-Task. Der Parameter 'password' kann dabei 
+          aus zwei Teilen bestehen, die durch ein "/"-Zeichen getrennt 
+          werden müssen. Der erste Teil bedeutet das schreib-Passwort,  
+          während der TEXT nach dem "/"-Zeichen das Lese-Paßwort beinhaltet. 
+          Enthält der Parameter 'password' kein "/"-Zeichen, gilt der ange- 
+          gebene TEXT sowohl für das Schreib- wie auch für das Lese-Paßwort. 
+          Im Schreib- bzw. Lese-Teil des Paßworts kann man das "-"-Zeichen 
+          angeben, um eine Datei vor überschreibendem oder lesendem Zugriff 
+          zu schützen. 
+ 
+          Die Paßwort-Überprüfung findet statt bei 
+ 
+               - fetch  (Überprüfung der Lese-Berechtigung) 
+               - save   (Überprüfung der Schreib-Berechtigung) 
+               - erase  (Überprüfung der Schreib-Berechtigung) 
+ 
+eof (F) 
+   BOOL PROC eof (FILE CONST file) 
+   Zweck: Informationsprozedur auf das Ende eines FILEs. Liefert den Wert 
+          TRUE, sofern hinter den letzten Satz eines FILEs positioniert 
+          wurde.   
+ 
+erase 
+   PROC erase (TEXT CONST name) 
+   Zweck: Löscht eine Datei mit dem Namen 'name' in der unmittelbaren 
+          Vater-Task. 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Eine Datei mit dem Namen 'name' existiert in der unmittelbaren 
+          Vater-Task nicht. 
+        * wrong password 
+          Es wurde mit der Prozedur 'enter password' nicht das richtige 
+          Paßwort angegeben. 
+ 
+   PROC erase (TEXT CONST name, TASK CONST task) 
+   Zweck: Löscht eine Datei mit dem Namen 'name' in der Task 'task'. Bei- 
+          spiel: 
+ 
+            erase ("meine datei", father) 
+ 
+   PROC erase (THESAURUS CONST thesaurus) 
+   Zweck: Löscht die im 'thesaurus' angegebenen Dateien in der Vater-Task. 
+          Beispiel (löscht alle Dateien in der Vater-Task, die in der Benut- 
+          zer-Task vorhanden sind): 
+ 
+             erase (ALL myself) 
+ 
+   PROC erase (THESAURUS CONST thesaurus, TASK CONST manager) 
+   Zweck: S.o.. 
+ 
+exists (F) 
+   BOOL PROC exists (TEXT CONST name) 
+   Zweck: Informationsprozedur zur Abfrage der Existenz einer Datei in der 
+          Benutzer-Task. Beispiel: 
+ 
+             IF exists ("dateiname") 
+               THEN FILE VAR f :: sequential file ...; 
+               ELSE errorstop ("Datei existiert nicht") 
+             FI 
+ 
+father 
+   TASK PROC father 
+   Zweck: Liefert den internen Task-Bezeichner der Vater-Task der Benutzer- 
+          Task. Beispiel: 
+ 
+             save ("datei", father) 
+ 
+   TASK PROC father (TASK CONST task) 
+   Zweck: Liefert den internen Task-Bezeichner von 'task'. Beispiel: 
+ 
+          save ("datei", father (father))    (* Kopiert 'datei' zum "Opa" *) 
+ 
+fetch 
+   PROC fetch (TEXT CONST name) 
+   Zweck: Einbringen einer Datei in die Benutzer-Task von dem "direkten" 
+          Vater im Taskbaum. 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Die Datei existiert bei dem Vater nicht. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- 
+          schritten. 
+        * wrong password 
+          Es wurde mit der Prozedur 'enter password' nicht das richtige 
+          Paßwort angegeben. 
+ 
+   PROC fetch (TEXT CONST name, TASK CONST task) 
+   Zweck: Kopieren einer Datei in die Benutzer-Task von 'task'. Beispiel: 
+ 
+            fetch ("datei", public) 
+ 
+   PROC fetch (THESAURUS CONST thesaurus) 
+   Zweck: Holt alle im 'thesaurus' enthaltenen Dateien von der Vater-Task. 
+ 
+   PROC fetch (THESAURUS CONST thesaurus, TASK CONST manager) 
+   Zweck: Holt alle im 'thesaurus' enthaltenen Dateien von der 'manager'- 
+          Task. 
+ 
+forget (F) 
+   PROC forget (TEXT CONST name) 
+   Zweck: Löschen einer Datei mit dem Namen 'name' in der Benutzer-Task. 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Die Datei mit dem Namen 'name' existiert nicht in der Benutzer- 
+          Task. 
+ 
+   PROC forget (DATASPACE VAR ds) 
+   Zweck: Löschen des Datenraums 'ds'. 
+ 
+   PROC forget (THESAURUS CONST thesaurus) 
+   Zweck: Löscht die im 'thesaurus' enthaltenen Dateinamen in der Benutzer- 
+          Task. Beispiel: 
+ 
+            forget (SOME myself) 
+ 
+   PROC forget (TEXT CONST file name, QUIET CONST q) 
+   Zweck: Löschen der Datei 'file name' ohne Anfrage. Als zweiter Parameter 
+          muß 'quiet' übergeben werden. Beispiel: 
+ 
+            forget ("hugo", quiet) 
+ 
+get (F) 
+   PROC get (FILE VAR f, INT VAR number) 
+   Zweck: Lesen eines INT-Wertes 'number' von der Datei 'f'. 
+ 
+   PROC get (FILE VAR f, REAL VAR number) 
+   Zweck: Lesen eines REAL-Wertes 'number' von der Datei 'f'. 
+ 
+   PROC get (FILE VAR f, TEXT VAR text) 
+   Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f'. 
+ 
+   PROC get (FILE VAR f, TEXT VAR text, TEXT CONST delimiter) 
+   Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f', bis das Zeichen 
+          'delimiter' angetroffen wird. Ein eventueller Zeilenwechsel in der 
+          Datei  wird dabei nicht übergangen. 
+ 
+   PROC get (FILE VAR f, TEXT VAR text, INT CONST maxlength) 
+   Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f' mit 'maxlength' 
+          Zeichen. Ein eventueller Zeilenwechsel in der Datei wird dabei 
+          nicht übergangen. 
+ 
+getline (F) 
+   PROC get line (FILE VAR file, TEXT VAR record) 
+   Zweck: Lesen einer Zeile 'record' von einer sequentiellen Datei 'file'. 
+          Die Datei muß mit 'input' assoziiert sein (vergl. 'sequential 
+          file'). 
+  Fehlerfälle: 
+        * file not open 
+          Die Datei 'file' ist gegenwärtig nicht assoziiert. 
+        * input after end of file 
+          Es wurde versucht, über die letzte Zeile einer Datei zu lesen. 
+        * input access to output file 
+          Es wurde versucht, von einem mit 'output' assoziierten FILE zu 
+          lesen.   
+ 
+global manager 
+   PROC global manager 
+   Zweck: Durch den Aufruf der Prozedur wird die Benutzer-Task zu einem 
+          Datei-Manager. Danach können Söhne dieser Task eingerichtet 
+          werden. 
+ 
+input (F) 
+   PROC input (FILE VAR f) 
+   Zweck: Ändern der Verarbeitungsart von 'modify' oder 'output' in 'input'. 
+          Dabei wird auf den ersten Satz der Datei positioniert. 
+ 
+   TRANSPUTDIRECTION CONST input 
+   Zweck: Assoziierung in Zusammenhang mit der Prozedur 'sequential file' 
+          einer sequentiellen Datei mit der 'TRANSPUTDIRECTION' 'input' (nur 
+          lesen). 
+ 
+insert record (F) 
+   PROC insert record (FILE VAR file) 
+   Zweck: Es wird ein leerer Satz in die Datei 'file' vor die aktuelle 
+          Position eingefügt. Dieser Satz kann anschließend mit 'write 
+          record' beschrieben werden (d.h. der neue Satz ist jetzt der 
+          aktuelle Satz). Die Datei 'file' muß mit der Verarbeitungsart 
+          'modify' assoziiert worden sein. 
+ 
+line no (F) 
+   INT PROC line no (FILE CONST file) 
+   Zweck: Liefert die aktuelle Zeilennummer. 
+ 
+line (F) 
+   PROC line (FILE VAR file) 
+   Zweck: Positionierung auf die nähhste Zeile der Datei 'file'. Die Datei 
+          'file' darf mit 'output' oder 'input' assoziiert sein. Wird ver- 
+          sucht, über das Ende eines mit 'input' assoziierten FILEs zu 
+          positionieren, wird keine Aktion vorgenommen. 
+ 
+   PROC line (FILE VAR file, INT CONST lines) 
+   Zweck: Positionierung auf 'lines' nächste Zeilen der Datei 'file'. Die 
+          Datei 'file' darf mit 'output' oder 'input' assoziiert sein. Wird 
+          versucht, über das Ende eines mit 'input' assoziierten FILEs zu 
+          positionieren, wird keine Aktion vorgenommen. Ist 'lines' <= 0, 
+          wird keine Aktion durchgeführt. 
+ 
+lines (F) 
+   PROC lines (FILE VAR f) 
+   Zweck: Liefert die Anzahl der Zeilen der Datei 'f'. 
+ 
+list 
+   PROC list 
+   Zweck: Listet alle Dateien der Benutzer-Task mit Namen und Datum des 
+          letzten Zugriffs auf dem Terminal auf. 
+ 
+   PROC list (FILE VAR f) 
+   Zweck: Schreibt alle Dateien der Benutzer-Task mit Namen und Datum der 
+          letzten Änderung in die Datei 'f'. 
+ 
+   PROC list (TASK CONST task) 
+   Zweck: Listet alle Dateien der angegebenen 'task' mit Namen und Datum der 
+          letzten Änderung auf dem Terminal auf. Beispiel: 
+ 
+            list (father) 
+ 
+max line length (F) 
+   INT PROC max line length (FILE CONST file) 
+   Zweck: Informationsprozedur über die Anzahl von Zeichen in einer Zeile 
+          der Datei 'file'. Standardmäßig sind die Anzahl der Zeichen einer 
+          Zeile wie beim Editor 77 Zeichen. 
+ 
+   PROC max line length (FILE VAR file, INT CONST number) 
+   Zweck: Setzen der Anzahl von Zeichen einer Zeile in dem FILE 'file'. 
+ 
+modify (F) 
+   TRANSPUTDIRECTION CONST modify 
+   Zweck: Diese Betriebsrichtung erlaubt das Vorwärts- und Rückwärts-Posi- 
+          tionieren und das beliebige Einfügen und Löschen von Sätzen. 
+          'modify' wird für die Assoziierungsprozedur 'sequential file' 
+          benötigt.   
+ 
+   PROC modify (FILE VAR f) 
+   Zweck: Ändern der Betriebsrichtung von 'input' oder 'output' in die Be- 
+          triebsrichtung 'modify'. 
+ 
+myself 
+   TASK PROC myself 
+   Zweck: Liefert den internen Task-Bezeichner der Benutzer-Task. Beispiel: 
+ 
+            save (ALL myself, father) 
+ 
+name 
+   TEXT PROC name (TASK CONST task) 
+   Zweck: Liefert den TEXT-Namen von 'task'. Beispiel: 
+ 
+             put (name (myself)) 
+ 
+new (F) 
+   DATASPACE PROC new (TEXT CONST name) 
+   Zweck: Richtet eine neue Datei in der Benutzer-Task ein. 
+   Fehlerfälle: 
+        * file already exists 
+          Die Datei mit dem Namen 'name' existiert bereits in der Benutzer- 
+          Task. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien in der Benutzer-Task ist über- 
+          schritten. 
+ 
+nilspace (F) 
+   DATASPACE CONST nilspace 
+   Zweck: Liefert einen leeren Datenraum. 
+ 
+old (F) 
+   DATASPACE PROC old (TEXT CONST name) 
+   Zweck: Eine bereits vorhandene Datei der Benutzer-Task wird erneut zur 
+          Bearbeitung angemeldet. 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Die Datei mit dem Namen 'name' ist nicht in der Benutzer-Task 
+          vorhanden. 
+ 
+output (F) 
+   PROC output (FILE VAR file) 
+   Zweck: Ändern der Verarbeitungsart von 'input' oder 'modify' in 'output'. 
+          Dabei wird hinter den letzten Satz der Datei positioniert. 
+ 
+   TRANSPUTDIRECTION CONST output 
+   Zweck: In Verbindung mit der Prozedur 'sequential file' kann eine Datei 
+          assoziiert werden mit der Betriebsrichtung 'output' (nur 
+          schreiben). 
+ 
+pattern found 
+   BOOL PROC pattern found 
+   Zweck: Liefert TRUE, sofern die letzte Suchoperation (siehe 'down' und 
+          'up') erfolgreich war, sonst FALSE. 
+ 
+printer 
+   TASK PROC printer 
+   Zweck: Liefert den internen TASK-Bezeichner der SPOOLer-Task für den 
+          Drucker. Beispiel: 
+ 
+            save ("datei", printer) 
+ 
+public 
+   TASK PROC public 
+   Zweck: Liefert den internen Task-Bezeichner von "PUBLIC". Beispiel: 
+ 
+             fetch ("datei", public) 
+ 
+put (F) 
+   PROC put (FILE VAR f, INT CONST number) 
+   Zweck: Ausgabe eines INT-Wertes 'number' in die Datei 'f'. Dabei wird ein 
+          Leerzeichen an die Ausgabe angefügt. 
+ 
+   PROC put (FILE VAR f, REAL CONST number) 
+   Zweck: Ausgabe eines REAL-Wertes 'number' in die Datei 'f'. Dabei wird 
+          ein Leerzeichen an die Ausgabe angefügt. 
+ 
+   PROC put (FILE VAR f, TEXT CONST text) 
+   Zweck: Ausgabe eines TEXT-Wertes 'text' in die Datei 'f'. Dabei wird ein 
+          Leerzeichen an die Ausgabe angefügt. 
+ 
+putline (F) 
+   PROC putline (FILE VAR file, TEXT CONST record) 
+   Zweck: Ausgabe eines TEXTes 'record' in die Datei 'file'. 'file' muß mit 
+          'output' assoziiert sein. 
+   Fehlerfälle: 
+        * file not open 
+          Die Datei 'file' ist gegenwärtig nicht assoziiert. 
+        * output access to input file 
+          Es wurde versucht, auf einen mit 'input' assoziierten FILE zu 
+          schreiben. 
+ 
+read record (F) 
+   PROC read record (FILE CONST file, TEXT VAR record) 
+   Zweck: Liest den aktuellen Satz der Datei 'file' in den TEXT 'record'. 
+          Die Position wird dabei nicht verändert. Die Datei 'file' muß mit 
+          der Verarbeitungsart 'modify' assoziiert worden sein. 
+ 
+reinsert (F) 
+   PROC reinsert (FILE VAR f) 
+   Zweck: Einfügen von "vorsichtig gelöschten" Zeilen (vergl. 'remove') an 
+          der aktuellen Position. 
+ 
+release 
+   PROC release (TASK CONST task) 
+   Zweck: Aufgabe der Reservierung des Archivs. Ein implizites 'release' 
+          wird automatisch fünf Minuten nach der letzten Archiv-Operation 
+          gegeben, sofern ein 'archive' eines anderen Nutzers vorliegt. 
+          Beispiel: 
+ 
+             release (archive) 
+ 
+rename (F) 
+   PROC rename (TEXT CONST oldname, newname) 
+   Zweck: Umbenennen einer Datei von 'oldname' in 'newname'. 
+ 
+remainder 
+   THESAURUS PROC remainder 
+   Zweck: Liefert nach der Unterbrechung einer Thesaurus-Operation den 
+          "Rest"-Thesaurus. 
+ 
+reorganize (F) 
+   PROC reorganize (TEXT CONST filename) 
+   Zweck: Reorganisiert eine Datei. Die durch eventuelles Einfügen und 
+          Löschen entstandene Lücken werden eliminiert und die Anordung der 
+          Sätze der Datei wird linearisiert. 
+ 
+reset (F) 
+   PROC reset (FILE VAR file) 
+   Zweck: Positionieren in einem FILE auf den Anfang (bei mit 'input' asso- 
+          ziierten FILEs) oder auf das Ende (bei mit 'output' assoziierten 
+          FILEs).   
+ 
+reset range (F) 
+   PROC reset range (FILE VAR file) 
+   Zweck: Setzt alle Einschränkungen auf 'file' zurück. Siehe auch 'set 
+          range'. 
+ 
+remove (F) 
+   PROC remove (FILE VAR f, INT CONST anzahl) 
+   Zweck: Löscht eine 'anzahl' von Zeilen "vorsichtig" aus der Datei 'f', 
+          die mit 'reinsert' an anderer Stelle wieder eingesetzt werden 
+          können. 
+ 
+save 
+   PROC save (TEXT CONST datei) 
+   Zweck: Datei 'datei' wird an die unmittelbare Vater-Task übertragen. 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Eine Datei mit dem Namen 'datei' existiert nicht in der Benutzer- 
+          Task. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien in 'task' ist überschritten. 
+        * wrong password 
+          Es wurde mit der Prozedur 'enter password' nicht das richtige 
+          Paßwort angegeben. 
+ 
+   PROC save (TEXT CONST name, TASK CONST task) 
+   Zweck: Datei mit dem Namen 'name' in Task 'task' kopieren. Beispiel: 
+ 
+            save ("meine datei", father) 
+ 
+   Fehlerfälle: 
+        * ... gibt es nicht 
+          Eine Datei mit dem Namen 'name' existiert nicht in der Benutzer- 
+          Task. 
+        * directory overflow 
+          Die Anzahl der zulässigen Dateien in der angegebenen task ist 
+          überschritten. 
+        * wrong password 
+          Es wurde mit der Prozedur 'enter password' nicht das richtige 
+          Paßwort angegeben. 
+ 
+   PROC save (THESAURUS CONST thesaurus) 
+   Zweck: Kopiert die Dateien, die in 'thesaurus' enthalten sind, in die 
+          Vater-Task. Beispiel: 
+ 
+            save (SOME myself) 
+ 
+   PROC save (THESAURUS CONST thesaurus, TASK CONST manager) 
+   Zweck: Kopiert die Dateien, die in 'thesaurus' enthalten sind, in Task 
+          'manager'. 
+ 
+segments (F) 
+   INT PROC segments (FILE CONST f) 
+   Zweck: Liefert die Anzahl der Datei-Segmente von 'f'. Nach 'reorganize' 
+          besteht 'f' aus einem Segment. Einfügungen oder Löschungen 
+          erhöhen die Segmentanzahl. 
+ 
+sequential file (F) 
+   FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, DATASPACE VAR ds) 
+   Zweck: Assoziierung einer sequentiellen Datei mit dem Dataspace 'ds' und 
+          der Betriebsrichtung 'TRANSPUTDIRECTION' (vergl. 'modify', 'input' 
+          bzw. 'output'). Diese Prozedur dient zur Assoziierung eines tempo- 
+          rären Datenraums in der Benutzer-Task, der nach der Beendigung 
+          des Programmlaufs nicht mehr zugriffsfähig ist (weil der Name des 
+          Datenraums nicht mehr ansprechbar ist). Somit muß der Datenraum 
+          explizit vom Programm gelöscht werden. 
+ 
+   FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) 
+   Zweck: Assoziierung einer sequentiellen Datei mit dem Namen 'name' und 
+          der Betriebsrichtung 'TRANSPUTDIRECTION' (vergl. 'input' bzw. 
+          'output'). Existiert der FILE bereits, dann wird mit 'input' auf 
+          den Anfang des FILEs, bei 'output' hinter den letzten Satz der 
+          Datei positioniert. Existiert dagegen der FILE noch nicht und ist 
+          die TRANSPUTDIRECTION 'output', wird ein neuer FILE eingerichtet. 
+   Fehlerfall: 
+        * input file not existing 
+          Es wurde versucht, einen nicht vorhandenen FILE mit 'input' zu 
+          assoziieren. 
+ 
+set range (F) 
+   PROC set range (FILE VAR f, INT CONST anz, INT CONST column, FRANGE VAR b) 
+   Zweck: Schränkt die Datei 'f' auf 'anz' Zeilen beginnend bei der Position 
+          'column' der aktuellen Zeile. Der "alte" Datei-Bereich wird in 'b' 
+          gespeichert. 
+ 
+   PROC set range (FILE VAR f, FRANGE VAR b) 
+   Zweck: Setzt die Datei 'f' auf die in 'b' gespeicherten Bereich zurück. 
+ 
+son 
+   TASK PROC son (TASK CONST task) 
+   Zweck: Liefert den internen Task-Bezeichner der Sohn-Task. Beispiel: 
+ 
+             put (name (son (myself))) 
+ 
+SOME 
+   THESAURUS OP SOME (THESAURUS CONST thesaurus) 
+   Zweck: Bietet den angegebenen 'thesaurus' zum Editieren an. Dabei können 
+          nicht erwünschte Namen gestrichen werden. 
+ 
+   THESAURUS OP SOME (TASK CONST task) 
+   Zweck: Bietet einen THESAURUS von 'task' zum Editieren an. 
+ 
+   THESAURUS OP SOME (TEXT CONST file name) 
+   Zweck: Bietet einen 'thesaurus', der aus 'file name' gebildet wird, zum 
+          editieren an. 
+ 
+to line (F) 
+   PROC to line (FILE VAR f, INT CONST number) 
+   Zweck: Positionierung auf die Zeile 'number'. Nur erlaubt in der 
+          Betriebsrichtung 'modify'. 
+ 
+task 
+   TASK PROC task (TEXT CONST task name) 
+   Zweck: Liefert den internen Task-Bezeichner von 'task name'. Beispiel: 
+ 
+             save ("datei", task ("PUBLIC")) 
+ 
+             (* das gleiche wie:   *) 
+ 
+             save ("datei", public) 
+ 
+type (F) 
+   INT PROC type (DATASPACE CONST ds) 
+   Zweck: Liefert den frei wählbaren (INT-) Schlüssel des Datenraums 'ds'. 
+          Wurde der Datenraum noch nie angekoppelt, so liefert die Prozedur 
+          'type' einen Wert < 0, erfolgte eine Ankopplung und hat ein 
+          Programmierer für den Datenraum 'ds' noch keinen anderen Schlüssel 
+          festgelegt, so liefert 'type' den Wert '0'. 
+ 
+   PROC type (DATASPACE CONST ds, INT CONST type) 
+   Zweck: Setzt den frei wählbaren Schlüssel 'type' für den Datenraum 'ds' 
+          (vergl. obige Prozedur 'type'). 
+ 
+up (F) 
+   PROC up (FILE VAR f) 
+   Zweck: Positionieren um eine Zeile rückwärts in der Datei 'f'. 
+ 
+   PROC up (FILE VAR f, INT CONST number) 
+   Zweck: Positionieren um 'number' Zeilen rückwärts in der Datei 'f'. 
+ 
+   PROC up (FILE VAR f, TEXT CONST pattern) 
+   Zweck: Suche nach 'pattern' rückwärts in der Datei 'f'. Wird 'pattern' 
+          gefunden, ist die Position das erste Zeichen von 'pattern'. 
+          Andernfalls steht man auf dem ersten Zeichen der Datei. Achtung: 
+          'down' sucht vom nächsten Zeichen links ab, so daß wiederholtes 
+          Suchen keine Endlosschleife ergibt. 
+ 
+   PROC up (FILE VAR f, TEXT CONST pattern, INT CONST number) 
+   Zweck: Wie obiges 'up', aber maximal nur 'number'-Zeilen weit. 
+ 
+uppety (F) 
+   PROC uppety (FILE VAR f, TEXT CONST pattern) 
+   Zweck: Suche nach 'pattern' rückwärts in der Datei 'f'. Wird 'pattern' 
+          gefunden, ist die Position das erste Zeichen von 'pattern'. 
+          Andernfalls steht man auf dem ersten Zeichen der Datei. Achtung: 
+          'uppety' sucht (im Gegensatz zu 'up') vom aktuellen Zeichen. 
+ 
+   PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST number) 
+   Zweck: Wie obiges 'uppety', aber maximal nur 'number'-Zeilen weit. 
+ 
+word (F) 
+    TEXT PROC word (FILE CONST f) 
+    Zweck: Liefert das aktuelle Wort (bis zum nächsten Leerzeichen oder 
+           Zeilenende). 
+ 
+    TEXT PROC word (FILE CONST f, TEXT CONST sep) 
+    Zweck: Liefert einen Text von der aktuellen Position bis zum nächsten 
+           'sep-Zeichen oder Zeilenende. 
+ 
+    TEXT CONST word (FILE CONST f, INT CONST len) 
+    Zweck: Liefert einen Text von der aktuellen Position mit der Länge 'len' 
+           bzw. bis zum Zeilenende. 
+ 
+write (F) 
+   PROC write (FILE VAR f, TEXT CONST text) 
+   Zweck: Schreibt 'text' in die Datei 'f' (analog 'put (f, text)'), aber 
+          ohne Trennblank. 
+ 
+write record (F) 
+   PROC write record (FILE VAR file, TEXT CONST record) 
+   Zweck: Schreibt einen Satz in die Datei 'file' an die aktuelle Position. 
+          Dieser Satz muß bereits vorhanden sein, d.h. mit 'write record' 
+          kann keine leere Datei beschrieben werden, sondern es wird der 
+          Satz an der aktuellen Position überschrieben. Die Position in der 
+          Datei wird nicht verändert. Die Datei 'file' muß mit der Verar- 
+          beitungsart 'modify' assoziiert worden sein. 
+ 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8
new file mode 100644
index 0000000..16e4d07
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8
@@ -0,0 +1,1345 @@
+                        EUMEL-Benutzerhandbuch 
+ 
+                        TEIL 8: Standardpakete                      
+ 
+ 
+1. Übersicht 
+ 
+Hier werden die im EUMEL-System verfügbaren Prozeduren und Operatoren aufge- 
+führt, die nicht bereits in anderen Teilen des Benutzerhandbuchs beschrieben 
+wurden. 
+ 
+Die meisten der hier beschriebenen Objekte werden nicht vom ELAN-Compiler, 
+sondern von vorübersetzten Moduln (PACKETs) realisiert (vergl. dazu auch den 
+Quellcode). Die in diesem Teil beschriebenen Prozeduren und Operatoren 
+weisen einige wenige Modifikationen, aber beträchtliche Erweiterungen gegen- 
+über dem Standard auf, um sie für die Zwecke des EUMEL-Systems anzupassen. 
+Hier werden nur diejenigen Objekte aufgeführt, die bei einer System-Aus- 
+lieferung dem EUMEL-System beigefügt sind. Jeder Installation ist es frei- 
+gestellt, diesen "EUMEL-Standard" zu erweitern oder zu modifizieren. 
+ 
+Die Operationen des EUMEL-Standards lassen sich in verschiedene Klassen - 
+je nach Aufgabenbereich - ordnen. 
+ 
+ 
+ 
+Ein-/Ausgabe 
+ 
+Die Ein-/Ausgabe erfolgt im EUMEL-System in der Regel auf dem Terminal des 
+Benutzers. Sie kann aber auch in einen File umgeleitet werden. 
+ 
+Die Ein-/Ausgabe eines Programms erfolgt in der Regel auf dem Terminal des 
+Benutzers, welches einem Prozeß zugeordnet ist. Die Eingabe vom Bildschirm 
+kann man mit den Prozeduren 
+ 
+     get 
+ 
+programmieren, welche INT, REAL und TEXT-Werte einlesen. Bei der Eingabe 
+kann der Eingabetext editiert werden (Zeichen löschen, einfügen, über- 
+schreiben oder Lernsequenzen abrufen). Die Ausgabe erfolgt mit den Proze- 
+duren   
+ 
+     put 
+ 
+(für INT-, REAL- und TEXT-Werte). Von den 'put'-Prozeduren wird ein Leer- 
+zeichen an eine Ausgabe angefügt, um diese von der vorhergehenden zu trennen. 
+Zusätzlich existiert die 
+ 
+     write 
+ 
+Prozedur, welche an die Ausgabe kein Leerzeichen anfügt. Mit 
+ 
+     line 
+ 
+kann man eine Positionierung auf eine neue Zeile bei der Ein-/Ausgabe er- 
+wirken. Mit 
+ 
+     getline 
+     putline 
+ 
+kann eine ganze Zeile eingelesen bzw. ausgegeben werden. 
+ 
+Wie bereits erwähnt, erfolgt die Ein-/Ausgabe in der Regel auf dem Terminal 
+des Benutzers. Es ist jedoch möglich, die Ein-/Ausgabe dieser Prozeduren 
+"umzuleiten". Diese Umleitung erfolgt in eine oder von einer Datei. Dazu 
+gibt es die Prozeduren 
+ 
+     online               (* liefert TRUE, wenn die Task an ein Terminal 
+                             gekoppelt ist *) 
+     sysout ("name")      (* Ausgabe erfolgt in die Datei 'name'. 'sysout 
+                             ("")' schaltet auf das Terminal zurück *) 
+     sysout               (* Liefert den Namen der eingestellten 'sysout'- 
+                             Datei. Wird "" geliefert, ist man an ein 
+                             Terminal gekoppelt *) 
+     sysin ("name")       (* Umschaltung der Eingabe vom Terminal auf die 
+                             Datei 'name'. sysin ("")' schaltet auf das 
+                             Terminal zurück *) 
+     sysin                (* Liefert den Namen der eingestellten 'sysin'- 
+                             Datei. Wird "" geliefert, ist man an ein 
+                             Terminal gekoppelt *) 
+ 
+Wie bereits erwähnt, ist die Umschaltung nur für die Prozeduren 'get' und 
+'put'/'write', sowie 'getline' und 'putline' und die Prozedur 'line' möglich. 
+(Die folgenden Prozeduren haben immer eine Wirkung auf das Benutzer- 
+Terminal). Die Prozedur 
+ 
+     out 
+ 
+schreibt wie 'write' einen Text auf den Bildschirm (läßt sich aber nicht 
+"umleiten"). 
+ 
+     cout 
+ 
+schreibt einen INT-Wert an die aktuelle Cursor-Position auf den Bildschirm 
+und positioniert anschließend auf diese Position wieder zurück. Diese 
+Prozedur wird vorwiegend für Kontroll-Ausgaben (z.B. Zeilennummern) benutzt. 
+Ist die Task nicht angekoppelt, geht die Ausgabe ins "Leere"; das Programm 
+der Task läuft also weiter (im Gegensatz zu 'put' auf den Bildschirm). Mit 
+der Prozedur   
+ 
+     cursor 
+ 
+kann - neben der Möglichkeit des Arbeitens mit Steuerzeichen - auf eine 
+bestimmte Position des Bildschirms positioniert werden. Mit 
+ 
+     get cursor 
+ 
+kann die aktuelle Position des Cursors auf dem Terminal des Benutzers er- 
+fragt werden. Mit Hilfe der Prozedur 
+ 
+     inchar 
+ 
+kann ein Zeichen vom Bildschirm gelesen werden. Der Prozeß wartet solange, 
+bis ein Zeichen eingegeben wird. Dagegen wird bei 
+ 
+     incharety 
+ 
+niltext geliefert, wenn kein Zeichen eingegeben wurde. Eine weitere 'inchare- 
+ty'-Prozedur wartet zusätzlich noch eine angebbare Zeitdauer, ob ein Zeichen 
+eingegeben wird. Der Operator 
+ 
+     TIMESOUT 
+ 
+stellt einen TEXT mehrfach auf dem Bildschirm dar. Die Prozedur 
+ 
+     page 
+ 
+positioniert auf einen "neuen Bildschirm": der Bildschirm wird gelöscht und 
+der Cursor befindet sich anschließend in der linken oberen Ecke des Bild- 
+schirms. 
+ 
+ 
+ 
+Manipulation von Texten 
+ 
+Ein Text kann im EUMEL-System bis zu 32 000 Zeichen haben. Für TEXTe 
+stehen neben der Zuweisung die Vergleichsoperatoren 
+ 
+     = , < , <= , > , >= , <> 
+ 
+zur Verfügung. Dabei ist die lexikographische Reihenfolge der Zeichen (vergl. 
+EUMEL-Zeichensatz) zu beachten. Zur Verkettung zweier TEXTe ist der 
+ 
+     + 
+ 
+Operator vorhanden. Der Operator 
+ 
+     * 
+ 
+nimmt eine Vervielfachung eines TEXTes vor. Der Operator 
+ 
+     CAT 
+ 
+konkateniert den linken mit dem rechten Operanden und weist das Resultat dem 
+linken Operanden zu. Die Prozeduren 
+ 
+     pos 
+ 
+liefern die Position des ersten Auftretens eines TEXTes oder einer 
+Zeichenklasse in einem anderen TEXT. Die Prozeduren 
+ 
+     code 
+ 
+konvertieren ein Zeichen in einen INT-Wert und umgekehrt (vergl. dazu den 
+EUMEL-Zeichensatz) und dienen z.B. zur Behandlung von Zeichen, die nicht 
+auf einer Tastatur zu finden sind. Die Prozedur 
+ 
+     compress 
+ 
+schneidet führende und nachfolgende Leerzeichen eines TEXTs ab, während 
+ 
+     delete char              (* ein Zeichen loeschen  *) 
+     insert char              (* ein Zeichen einfuegen *) 
+ 
+ein Zeichen einfügt bzw. löscht. Mit 
+ 
+     change 
+ 
+kann bei dem erstmaligen Auftreten eines Teiltextes in einem TEXT dieser 
+ersetzt werden. Mit 
+ 
+     change all 
+ 
+kann jedesmal, wenn ein Teiltext in einem TEXT auftritt, dieser durch einen 
+anderen Text ersetzt werden. 
+ 
+     LENGTH           (* oder *) 
+     length 
+ 
+liefert die Länge (d.h. die Anzahl der Zeichen in einem TEXT einschließlich 
+der Leerzeichen) eines TEXTes. Mit 
+ 
+     replace 
+ 
+kann eine Ersetzung eines Teiltextes erzielt werden. Im Gegensatz zu 
+'replace' kann sich bei 'change' die Länge des Textes ändern. Mit 
+ 
+     SUB 
+     subtext 
+ 
+kann ein Zeichen ('SUB') oder ein Teiltext ('subtext') aus einem Text geholt 
+werden. 
+ 
+TEXTe werden im EUMEL-System über einen Heap realisiert, d.h. nicht wie 
+andere Objekte auf einem Stack. Das hat u.a. zur Folge, daß TEXT-"Leichen" 
+auf dem Heap nicht automatisch beseitigt werden. Darum kann der benötigte 
+Speicherplatz durch TEXT-Operationen anwachsen. Der Heap kann nun von 
+unnötigem Speicherplatz durch die Prozedur 
+ 
+     collect heap garbage 
+ 
+bereinigt werden. Die Größe des Heaps (in KB) kann durch die Prozedur 
+ 
+     heap size 
+ 
+erfragt werden. Übrigens überprüft der Standard-Monitor nach jedem Kommando 
+die Heap-Größe und veranlaßt eine Bereinigung des Heaps, wenn dieser um 
+mindestens 4 KB gewachsen ist. 
+ 
+ 
+ 
+Mathematische Operationen 
+ 
+Folgende mathematische Prozeduren bzw. Operatoren stehen im EUMEL zur Zeit 
+zur Verfügung (manche Prozeduren stehen in mehr als einer Version zur 
+Verfügung, z.B. die sin-Prozedur für Radiant und Winkelgrad): 
+ 
+     **                  (* Exponentiation                            *) 
+     abs                 (* Absolutbetrag                             *) 
+     arctan              (* Arcus Tangens-Funktion                    *) 
+     cos                 (* Kosinus-Funktion                          *) 
+     e                   (* Eulersche Zahl (2.718282)                 *) 
+     pi                  (* Die Zahl pi (3.141593)                    *) 
+     exp                 (* Exponential-Funktion                      *) 
+     floor               (* REAL mit abgeschnittenen Nachkommastellen *) 
+     frac                (* Nachkommastellen eines REALs              *) 
+     random, 
+     initialize random   (* Zufallszahlen                             *) 
+     ln, log2, log10     (* Logarithmus-Funktionen                    *) 
+     max, min            (* Minimum bzw. Maximum zweier Werte         *) 
+     MOD                 (* Modulo-Funktion                           *) 
+     round               (* Rundung                                   *) 
+     sign                (* Vorzeichen feststellen                    *) 
+     sin                 (* Sinus-Funktion                            *) 
+     sqrt                (* Wurzel-Funktion                           *) 
+     tan                 (* Tangens-Funktion                          *) 
+ 
+ 
+ 
+Konvertierungs-Operationen 
+ 
+Mit den Prozeduren 
+ 
+     text 
+ 
+kann aus einem INT- bzw. REAL-Wert ein TEXT, während mit 
+ 
+     int 
+ 
+aus einem REAL- bzw. TEXT-Wert ein INT und mit 
+ 
+     real 
+ 
+aus einem INT- bzw. TEXT-Wert ein REAL gemacht werden kann. Mit 
+ 
+     last conversion ok 
+ 
+kann abgefragt werden, ob die letzte Umwandlung ohne Fehler bzw. fehlerhaft 
+vorgenommen wurde. Mit 
+ 
+     decimal exponent 
+ 
+kann der Exponent eines REAL-Wertes ausgeblendet werden. 
+ 
+ 
+ 
+Kommando-Dialog 
+ 
+Die Prozeduren für den Kommando-Dialog dienen zur bequemen Programmierung 
+von interaktiven Anfragen an einen Benutzer eines Programms. (Diese 
+Prozeduren werden u.a. auch vom Monitor verwendet). Der Kommando-Dialog 
+ist im Normalfall eingeschaltet. Mit der Prozedur 
+ 
+     command dialogue 
+ 
+kann man den Kommando-Dialog ein- bzw. ausschalten. Mit der Prozedur 
+ 
+     say 
+ 
+kann - sofern der Kommando-Dialog eingeschaltet ist - ein Text auf dem 
+Bildschirm ausgegeben werden. Sofern der Kommando-Dialog eingeschaltet ist, 
+schreibt die Prozedur 
+ 
+     yes 
+ 
+einen Text auf den Bildschirm des Benutzers. An den Text wird '(j/n) ?' 
+angefügt. Die Prozedur 'yes' liefert den Wert TRUE, sofern der Benutzer auf 
+die Frage mit dem Zeichen "j" antwortet und den Wert FALSE, sofern die 
+Antwort "n" lautete. Die Prozedur 
+ 
+     no 
+ 
+arbeitet wie 'NOT yes'. 
+ 
+ 
+ 
+Verschiedenes 
+ 
+Mit den Prozeduren 
+ 
+     stop 
+     errorstop 
+ 
+kann ein Abbruch (letztere mit Meldung; vergl. Fehlerbehandlung im System- 
+handbuch) erreicht werden. Die Prozedur 
+ 
+     clock 
+ 
+liefert Zeitwerte als REAL-Wert, nämlich die verbrauchte CPU-Zeit einer Task 
+oder die aktuelle Uhrzeit (inklusive Datum). Die Prozedur 
+ 
+     time of day 
+ 
+liefert die aktuelle Uhrzeit. Mit den Konvertierungsprozeduren 
+ 
+     date 
+     time 
+ 
+können die Werte der Prozedur 'clock' in eine lesbare Form gebracht werden. 
+Mit der Prozedur 
+ 
+     pause 
+ 
+kann eine bestimmte Zeitdauer gewartet werden, ohne den Prozessor zu be- 
+lasten. Die Wartezeit wird abgebrochen, wenn die Zeitgrenze erreicht ist 
+oder sobald ein Zeichen am Terminal des Benutzers eingegeben wurde. Dieses 
+Zeichen wird nicht verarbeitet. 
+ 
+ 
+ 
+2. Die EUMEL-Standardpakete 
+ 
+Die elementaren Datentypen BOOL, INT, REAL, TEXT und die entsprechenden Zu- 
+weisungsoperatoren werden hier nicht angegeben. 
+ 
+= 
+   BOOL OP = (INT CONST a, b) 
+   Zweck: Vergleich. 
+ 
+   BOOL OP = (REAL CONST a, b) 
+   Zweck: Vergleich. 
+ 
+   BOOL OP = (TEXT CONST left, right) 
+   Zweck: Vergleich von zwei Texten auf Gleichheit (Texte mit ungleichen 
+          Längen sind immer ungleich). 
+ 
+< 
+   BOOL OP < (INT CONST a, b) 
+   Zweck: Vergleich auf kleiner. 
+ 
+   BOOL OP < (REAL CONST a, b) 
+   Zweck: Vergleich auf kleiner. 
+ 
+   BOOL OP < (TEXT CONST left, right) 
+   Zweck: Vergleich zweier Texte auf kleiner ('left' kommt lexikographisch 
+          vor 'right'). 
+ 
+> 
+   BOOL OP > (INT CONST a, b) 
+   Zweck: Vergleich auf größer. 
+ 
+   BOOL OP > (REAL CONST a, b) 
+   Zweck: Vergleich auf größer. 
+ 
+   BOOL OP > (TEXT CONST left, right) 
+   Zweck: Vergleich zweier Texte auf größer ('left' kommt lexikographisch 
+          nach 'right'). 
+ 
+<= 
+   BOOL OP <= (INT CONST a, b) 
+   Zweck: Vergleich auf kleiner gleich. 
+ 
+   BOOL OP <= (REAL CONST a, b) 
+   Zweck: Vergleich auf kleiner gleich. 
+ 
+   BOOL OP <= (TEXT CONST left, right) 
+   Zweck: Vergleich von zwei Texten auf kleiner gleich ('left' kommt 
+          lexikographisch vor oder ist gleich 'right'). 
+ 
+>= 
+   BOOL OP >= (INT CONST a, b) 
+   Zweck: Vergleich auf größer gleich. 
+ 
+   BOOL OP >= (REAL CONST a, b) 
+   Zweck: Vergleich auf größer gleich. 
+ 
+   BOOL OP >= (TEXT CONST left, right) 
+   Zweck: Vergleich zweier Texte auf größer gleich ('left' kommt lexiko- 
+          graphisch nach oder ist gleich 'right'). 
+ 
+<> 
+   BOOL OP <> (INT CONST a, b) 
+   Zweck: Vergleich auf Ungleichheit. 
+ 
+   BOOL OP <> (REAL CONST a, b) 
+   Zweck: Vergleich auf Ungleichheit. 
+ 
+   BOOL OP <> (TEXT CONST left, right) 
+   Zweck: Vergleich von zwei Texten auf Ungleichheit (Texte mit ungleichen 
+          Längen sind stets ungleich). 
+ 
++ 
+   INT OP + (INT CONST a) 
+   Zweck: Monadischer Operator (Vorzeichen, ohne Wirkung). 
+ 
+   REAL OP + (REAL CONST a) 
+   Zweck: Monadischer Operator (Vorzeichen, ohne Wirkung). 
+ 
+   INT OP + (INT CONST a, b) 
+   Zweck: Addition. 
+ 
+   REAL OP + (REAL CONST a, b) 
+   Zweck: Addition. 
+ 
+   TEXT OP + (TEXT CONST left, right) 
+   Zweck: Verkettung der Texte 'left' und 'right' in dieser Reihenfolge. Die 
+          Länge des Resultats ergibt sich aus der Addition der Längen der 
+          Operanden. 
+ 
+- 
+   INT OP - (INT CONST a) 
+   Zweck: Vorzeichen-Umkehrung. 
+ 
+   REAL OP - (REAL CONST a) 
+   Zweck: Vorzeichen-Umkehrung. 
+ 
+   INT OP - (INT CONST a, b) 
+   Zweck: Subtraktion. 
+ 
+   REAL OP - (REAL CONST a, b) 
+   Zweck: Subtraktion. 
+ 
+* 
+   INT OP * (INT CONST a, b) 
+   Zweck: Multiplikation. 
+ 
+   REAL OP * (REAL CONST a, b) 
+   Zweck: Multiplikation. 
+ 
+   TEXT OP * (INT CONST times, TEXT CONST source) 
+   Zweck: 'times' fache Erstellung von 'source' und Verkettung. Dabei muß 
+ 
+              times >= 0 
+ 
+          sein, sonst wird 'niltext' geliefert. 
+ 
+/ 
+   REAL OP / (REAL CONST a, b) 
+   Zweck: Division. 
+   Fehlerfall: 
+       * Division durch 0 
+ 
+** 
+   INT OP ** (INT CONST arg, exp) 
+   Zweck: Exponentiation mit 'exp' >= 0 
+   Fehlerfälle: 
+      * INT OP ** : negative exponent 
+          Ein negativer Exponent ist nicht zugelassen. 
+      * 0 ** 0 is not defined 
+          'arg' und 'exp' dürfen nicht beide 0 sein. 
+ 
+   REAL OP ** (REAL CONST arg, exp) 
+   Zweck: Exponentiation. 
+   Fehlerfälle: 
+      * hoch mit negativer basis 
+          Der 'exp' muß >= 0.0 sein. 
+      * 0**0 geht nicht 
+          'arg' und 'exp' dürfen nicht gleichzeitig 0.0 sein. 
+ 
+   REAL OP ** (REAL CONST arg, INT CONST exp) 
+   Zweck: Exponentiation. 
+   Fehlerfall: 
+      * 0.0 ** 0 geht nicht 
+ 
+abs 
+   INT PROC abs (INT CONST argument) 
+   Zweck: Absolutbetrag eines INT-Wertes. 
+ 
+   INT OP ABS (INT CONST argument) 
+   Zweck: Absolutbetrag eines INT-Wertes. 
+ 
+   REAL PROC abs (REAL CONST value) 
+   Zweck: Absolutbetrag eines REAL-Wertes. 
+ 
+   REAL OP ABS (REAL CONST value) 
+   Zweck: Absolutbetrag eines REAL-Wertes. 
+ 
+AND 
+   BOOL OP AND (BOOL CONST a, b) 
+   Zweck: Logisches und. 
+ 
+arctan 
+   REAL PROC arctan (REAL CONST x) 
+   Zweck: Arcus Tangens-Funktion. Liefert einen Wert in Radiant. 
+ 
+arctand 
+   REAL PROC arctand (REAL CONST x) 
+   Zweck: Arcus Tangens-Funktion. Liefert einen Wert in Grad. 
+ 
+CAT 
+   OP CAT (TEXT VAR left, TEXT CONST right) 
+   Zweck: Hat die gleiche Wirkung wie 
+ 
+              left := left + right 
+ 
+          Hinweis: Der Operator 'CAT' hat eine geringere Heap-Belastung als 
+          die Operation mit expliziter Zuweisung. 
+ 
+change 
+   PROC change (TEXT VAR destination, TEXT CONST old, new) 
+   Zweck: Ersetzung des (Teil-) TEXTes 'old' in 'destination' durch 'new' bei 
+          dem erstmaligen Auftreten. Ist 'old' nicht in 'source' vorhanden, 
+          so wird keine Meldung abgesetzt (Abweichung vom Standard). Beachte, 
+          daß sich dabei die Länge von 'destination' verändern kann. 
+          Beispiel: 
+ 
+              TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; 
+              change (mein text, "Ben", "N"); (* EUMEL-Nutzerhandbuch *) 
+ 
+PROC change (TEXT VAR destination, INT CONST from, to, TEXT CONST new) 
+   Zweck: Der TEXT 'new' wird in den TEXT 'destination' anstatt des TEXTes, 
+          der zwischen 'from' und 'to' steht, eingesetzt. Beachte, daß sich 
+          dabei die Länge von 'destination' ändern kann. Beispiel: 
+ 
+              TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; 
+              change (mein text, 7, 9, "N");   (* wie oben *) 
+ 
+change all 
+   PROC change all (TEXT VAR destination, TEXT CONST old, new) 
+   Zweck: Der Teiltext 'old' wird durch 'new' in 'destination' ersetzt. Im 
+          Unterschied zur 'change'-Prozedur findet die Ersetzung nicht nur 
+          bei dem erstmaligen Auftreten von 'old' statt, sondern so oft, wie 
+          'old' in 'destination' vorhanden ist. Beispiel: 
+ 
+ 
+              TEXT VAR x :: "Das ist ein Satz"; 
+              change all (x, " ", "");     (* DasisteinSatz *) 
+ 
+clock 
+   REAL PROC clock (INT CONST index) 
+   Zweck: Datum und Uhrzeit werden vom EUMEL-System für alle Tasks geführt. 
+          Neben einer Uhr ('Realzeituhr'), die das Datum und die aktuelle 
+          Uhrzeit enthält, wird eine Uhr für die von der Task verbrauchte 
+          CPU-Zeit geführt ('CPU-Zeituhr'). Beide Zeiten werden vom System 
+          als REALs realisiert. Die Prozedur 'clock' liefert die aktuellen 
+          Werte dieser Uhren. Bei 'index = 0' wird die akkumulierte CPU-Zeit 
+          der Task, bei 'index = 1' der Wert der Realzeituhr geliefert. 
+ 
+          Mit den REAL-Werten der Uhren kann ohne weiteres gerechnet werden, 
+          jedoch sind nur Werte > 0 definiert. Die REAL-Werte der Realzeit- 
+          uhr beginnen beim 1.1.1900 um 0 Uhr. Es sind nur Werte für dieses 
+          Jahrhundert zugelassen. Werte der Realzeituhr in lesbarer Form 
+          kann man durch die Konvertierungsprozeduren 'date' (für den 
+          aktuellen Tag) und 'time of day' (Uhrzeit) erhalten. 
+ 
+          Um die benötigte CPU-Zeit eines Programms zu berechnen, muß man 
+          die CPU-Zeituhr zweimal abfragen. Um solche Zeiten in lesbarer 
+          Form zu erhalten, kann man die Konvertierungsprozedur 'time' 
+          verwenden. Beispiel: 
+ 
+              REAL CONST anfang :: clock (0); 
+              berechnungen; 
+              REAL CONST ende   :: clock (0); 
+              put ("benoetigte CPU-Zeit:"); 
+              put (time (ende - anfang)) 
+ 
+code 
+   TEXT PROC code (INT CONST code) 
+   Zweck: Wandelt einen INT-Wert 'code' in ein Zeichen um. 'code' muß 
+ 
+              1 <= code <= 254 
+ 
+          sein. 
+ 
+   INT PROC code (TEXT CONST text) 
+   Zweck: Wandelt ein Zeichen 'text' in einen INT-Wert um. Ist 
+ 
+              LENGTH text <> 1 
+ 
+          dann wird der Wert -1 geliefert (also bei mehr als ein Zeichen 
+          oder niltext). 
+ 
+collect heap garbage 
+   PROC collect heap garbage 
+   Zweck: Bereinigung des Heaps von nicht mehr benötigten TEXTen. 
+ 
+command dialogue 
+   PROC command dialogue (BOOL CONST status) 
+   Zweck: Ein- bzw. Ausschalten des Kommando-Dialogs. Ist der Kommando- 
+          dialog eingeschaltet, dann funktionieren z.B. die Prozeduren 'yes' 
+          bzw. 'no' und ein Aufruf der Prozedur 'errorstop' liefert eine 
+          Fehlermeldung auf dem Terminal. Ist der Kommandodialog ausge- 
+          schaltet, wird z.B. durch die Prozedur 'yes' kein Text ausgegeben 
+          (es wird TRUE geliefert) und errorstop erzeugt keine Fehler- 
+          meldungen. 
+ 
+   BOOL PROC command dialogue 
+   Zweck: Liefert den Wert TRUE, wenn der Kommando-Dialog eingeschaltet 
+          ist, andernfalls FALSE. 
+ 
+compress 
+   TEXT PROC compress (TEXT CONST text) 
+   Zweck: Liefert den TEXT 'text' ohne führende und nachfolgende Leerzeichen. 
+ 
+cos 
+   REAL PROC cos (REAL CONST x) 
+   Zweck: Kosinus-Funktion. 'x' muß in Radiant angegeben werden. 
+ 
+cosd 
+   REAL PROC cosd (REAL CONST x) 
+   Zweck: Cosinus-Funktion. 'x' muß in Winkelgrad angegeben werden. 
+ 
+cout 
+   PROC cout (INT CONST number) 
+   Zweck: Schreibt 'number' an die aktuelle Cursor-Position auf den Bild- 
+          schirm. Anschließend wird an diese Position wieder zurück positio- 
+          niert. 'number' muß > 0 sein. Paßt 'number' nicht mehr auf die 
+          Zeile, so ist die Wirkung von 'cout' nicht definiert. 'cout' gibt 
+          den Wert von 'number' nur aus, wenn genügend freie Kanal-Kapazität 
+          für diese Ausgabe vorhanden ist. Das hat zur Folge, daß Programme 
+          nicht auf die Beendigung einer Ausgabe von 'number' warten müssen 
+          und ggf. Ausgaben überschlagen werden. 
+ 
+cursor 
+   PROC cursor (INT CONST column, row) 
+   Zweck: Positioniert den Cursor auf dem Bildschirm, wobei 'column' die 
+          Spalte und 'row' die Zeile angibt. Die zulässigen Bereiche von 
+          'column' und 'row' sind geräteabhängig. Zur Zeit gilt auf allen 
+          EUMEL-Geräten  
+ 
+              1 <= column <= 80 
+              1 <= row <= 24 
+ 
+date 
+   TEXT PROC date (REAL CONST time) 
+   Zweck: Konvertierungsprozedur für das Datum, welches sich aus dem Aufruf 
+          der Prozedur 'clock (1)' ergibt. Das Datum wird in der Form 
+          'tt.mm.jj' geliefert. Beispiel: 
+ 
+              put (date (clock (1)))  (* z.B.: 24.12.82 *) 
+ 
+ 
+   REAL PROC date (TEXT CONST datum) 
+   Zweck: Konvertierungsprozedur für ein Datum in der Form 'tt.mm.jj'. 
+          Liefert einen REAL-Wert, wie ihn die Prozedur 'clock (1)' liefern 
+          würde. Beispiel: 
+ 
+              put (date ("24.12.82")) (* 6.270670e10 *) 
+ 
+   TEXT PROC date 
+   Zweck: Liefert das Tagesdatum. Wirkt wie 'date (clock (1))', ist jedoch 
+          erheblich schneller. 
+ 
+day 
+   REAL CONST day 
+   Zweck: Liefert die Anzahl der Sekunden eines Tages (86 400.0). 
+ 
+decimal exponent 
+   INT PROC decimal exponent (REAL CONST mantisse) 
+   Zweck: Liefert aus einem REAL-Wert den dezimalen Exponenten als INT-Wert. 
+ 
+DECR 
+   OP DECR (INT VAR left, INT CONST right) 
+   Zweck: Wirkt wie left := left - right 
+ 
+   OP DECR (REAL VAR left, REAL CONST right) 
+   Zweck: Wirkt wie left := left - right 
+ 
+delete char 
+   PROC delete char (TEXT VAR string, INT CONST delete pos) 
+   Zweck: Löscht ein Zeichen aus dem Text 'string' an der Position 'delete 
+          pos'. Für 
+ 
+              delete pos <= 0 
+ 
+          oder 
+ 
+              delete pos > LENGTH string 
+ 
+          wird keine Aktion vorgenommen. 
+ 
+DIV 
+   INT OP DIV (INT CONST a, b) 
+   Zweck: INT-Division. 
+   Fehlerfall: 
+      * DIV by 0 
+          Division durch Null. 
+ 
+e 
+   REAL CONST e 
+   Zweck: Eulersche Zahl (2.718282). 
+ 
+errorstop 
+   PROC errorstop (TEXT CONST error message) 
+   Zweck: Abbruch unter Ausgabe einer Fehlermeldung (vergl. Fehlerbehand- 
+          lung). 
+ 
+exp 
+   REAL PROC exp (REAL CONST z) 
+   Zweck: Exponentialfunktion. 
+ 
+floor 
+   REAL PROC floor (REAL CONST real) 
+   Zweck: Schneidet die Nachkommastellen des REAL-Wertes 'real' ab. 
+ 
+frac 
+   REAL PROC frac (REAL CONST z) 
+   Zweck: Liefert die Stellen eines REAL-Wertes hinter dem Dezimalpunkt. 
+ 
+get 
+   PROC get (INT VAR number) 
+   Zweck: Einlesen eines INT-Wertes vom Bildschirm. Der einzulesende INT- 
+          Wert kann bei der Eingabe vom Terminal editiert werden. Die 
+          Eingabe kann vom Benutzer-Terminal so umgeleitet werden, daß sie 
+          von einer Datei aus erfolgt (vergl. 'sysin'). 
+ 
+   PROC get (REAL VAR value) 
+   Zweck: Einlesen eines REAL-Wertes vom Bildschirm. Der einzulesende 
+          REAL-Wert kann bei der Eingabe vom Terminal editiert werden. Die 
+          Eingabe kann vom Benutzer-Terminal so umgeleitet werden, daß sie 
+          von einer Datei aus erfolgt (vergl. 'sysin'). 
+ 
+   PROC get (TEXT VAR word) 
+   Zweck: Liest einen Text in die Variable 'word' mit maximal 255 Zeichen. 
+          Es werden solange Zeichen vom Terminal gelesen, bis ein Leer- 
+          zeichen oder ein Positionierungszeichen eingegeben wird. Dabei 
+          werden führende Leerzeichen übergeben. Der einzulesende Text kann 
+          bei der Eingabe editiert werden. Eine leere Eingabe ist nicht 
+          erlaubt. Die Eingabe kann vom Benutzer-Terminal so umgeleitet 
+          werden, daß sie von einer Datei aus erfolgt (vergl. 'sysin'). 
+ 
+   PROC get (TEXT VAR word, INT CONST laenge) 
+   Zweck: Liest einen Text vom Bildschirm mit der Länge 'laenge' oder bis 
+          ein Positionierungszeichen angetroffen wird. Der einzulesende Wert 
+          kann bei der Eingabe editiert werden. Dabei gilt: 
+ 
+              1 <= laenge <= 255 
+ 
+   PROC get (TEXT VAR word, TEXT CONST separator) 
+   Zweck: Liest einen Text vom Bildschirm, bis ein Zeichen 'separator' ange- 
+          troffen oder ein Positionierungszeichen eingegeben wird. Der ein- 
+          zulesende Text kann bei der Eingabe editiert werden. 
+ 
+get cursor 
+   PROC get cursor (INT VAR x, y) 
+   Zweck: Erfragung der aktuellen Cursor-Position. Die Koordinaten des Cur- 
+          sors werden in 'x' und 'y' geliefert. Die aktuelle Cursor-Position 
+          ist nach Ausgabe von 'HOME' (Code = 1) oder einer Positionierung 
+          des Cursors mit der Prozedur 'cursor' stets definiert. Die Proze- 
+          dur 'get cursor' liefert jedoch undefinierte Werte, wenn über den 
+          rechten Rand einer Zeile hinausgeschrieben wurde (die Wirkung 
+          einer solchen Operation hängt von der Hardware eines Terminals ab). 
+ 
+getline 
+   PROC get line (TEXT VAR line) 
+   Zweck: Das System wartet auf eine Zeile vom Bildschirm (max. 255 Zeichen). 
+          Eine leere Eingabe ist nicht möglich. Die Eingabe kann vom Benut- 
+          zer-Terminal so umgeleitet werden, daß sie von einer Datei aus 
+          erfolgt (vergl. 'sysin'). 
+ 
+heap size 
+   INT PROC heap size 
+   Zweck: Informationsprozedur für die Größe (in KB) des TEXT-Heaps. 
+ 
+hour 
+   REAL CONST hour 
+   Zweck: Liefert die Anzahl der Sekunden einer Stunde (3600.0). 
+ 
+inchar 
+   PROC inchar (TEXT VAR character) 
+   Zweck: Wartet solange, bis ein Zeichen von der Tastatur eingegeben wird, 
+          und schreibt dieses Zeichen in die Variable 'character'. 
+ 
+incharety 
+   TEXT PROC incharety 
+   Zweck: Versucht, ein Zeichen von der Tastatur zu lesen. Wurde kein 
+          Zeichen eingegeben, wird niltext geliefert. 
+ 
+   TEXT PROC incharety (INT CONST time limit) 
+   Zweck: Versucht, ein Zeichen vom Bildschirm zu lesen. Dabei wird maximal 
+          eine 'time limit' lange Zeit auf das Zeichen gewartet (gemessen in 
+          Zehntel-Sekunden). 
+ 
+INCR 
+   OP INCR (INT VAR left, INT CONST right) 
+   Zweck: Wirkt wie left := left + right 
+ 
+   OP INCR (REAL VAR left, REAL CONST right) 
+   Zweck: Wirkt wie left := left + right 
+ 
+initialize random 
+   PROC initialize random (INT CONST value) 
+   Zweck: Initialisieren der 'random'-Prozedur, um nicht reproduzierbare 
+          Zufallszahlen zu bekommen. Diese 'init random'-Prozedur gilt für 
+          den "INT-Random Generator". 
+ 
+   PROC initialize random (REAL CONST z) 
+   Zweck: Initialisieren der 'random'-Prozedur mit verschiedenen Werten für 
+          'z', um nicht reproduzierbare Zufallszahlen zu bekommen. Diese 
+          Prozedur gilt für den "REAL-Random Generator". 
+ 
+insert char 
+   PROC insert char (TEXT VAR string, TEXT CONST char, INT CONST insert pos) 
+   Zweck: Fügt ein Zeichen 'char' in den Text 'string' an der Position 
+          'insert pos' ein. Für 
+ 
+              insert pos > LENGTH string + 1 
+ 
+          wird keine Aktion vorgenommen. Daher ist es möglich, mit dieser 
+          Prozedur auch am Ende eines Textes (Position: LENGTH string + 1) 
+          ein Zeichen anzufügen. 
+ 
+int 
+   INT PROC int (REAL CONST a) 
+   Zweck: Konvertierungsprozedur. 
+ 
+   INT PROC int (TEXT CONST number) 
+   Zweck: Umwandlung eines Textes in einen INT-Wert. Der Text 'number' darf 
+          ein "+"- oder "-"-Zeichen vor den Ziffern enthalten. Führende 
+          Blanks werden überlesen. Enthält 'number' an einer Position ein 
+          Zeichen, das nicht umgewandelt werden kann, so wird die Umwand- 
+          lung gestoppt und der bis dahin umgewandelte Wert (bzw. der Wert 0) 
+          geliefert. 
+ 
+last conversion ok 
+   BOOL PROC last conversion ok 
+   Zweck: Liefert den Wert TRUE, sofern die letzte Konvertierungsprozedur 
+          nicht auf einen Fehler bei der Umwandlung gestoßen ist, andernfalls 
+          FALSE. 
+ 
+length 
+   INT PROC length (TEXT CONST text) 
+   Zweck: Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. 
+ 
+LENGTH 
+   INT OP LENGTH (TEXT CONST text) 
+   Zweck: Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. 
+ 
+line 
+   PROC line 
+   Zweck: Es wird zum Anfang einer neuen Zeile positioniert. 
+ 
+   PROC line (INT CONST number) 
+   Zweck: Es werden 'number' Zeilenwechsel vorgenommen. 
+ 
+ln 
+   REAL PROC ln (REAL CONST x) 
+   Zweck: Natürlicher Logarithmus. 
+   Fehlerfall: 
+      * ln mit nicht positiver Zahl 
+          Nur echt positive Argumente sind zulässig. 
+ 
+log2 
+   REAL PROC log2 (REAL CONST z) 
+   Zweck: Logarithmus zur Basis 2. 
+   Fehlerfall: 
+      * log2 mit negativer zahl 
+          Nur echt positive Argumente sind zulässig. 
+ 
+log10 
+   REAL PROC log10 (REAL CONST x) 
+   Zweck: Logarithmus zur Basis 10. 
+   Fehlerfall: 
+      * log10 mit negativer zahl 
+          Nur echt positive Argumente sind zulässig. 
+ 
+max 
+   INT PROC max (INT CONST first, second) 
+   Zweck: Liefert den Größten der beiden INT-Werte. 
+ 
+   REAL PROC max (REAL CONST first, second) 
+   Zweck: Liefert den Größten der beiden REAL-Werte. 
+ 
+maxint 
+   INT CONST maxint 
+   Zweck: Größter INT-Wert im EUMEL-System (32 767). 
+ 
+maxreal 
+   REAL CONST maxreal 
+   Zweck: Größter REAL-Wert im EUMEL-System (9.999999999999e126). 
+ 
+max text length 
+   INT CONST max text length 
+   Zweck: Maximale Anzahl von Zeichen in einem TEXT (32 000). 
+ 
+min 
+   INT PROC min (INT CONST first, second) 
+   Zweck: Liefert den Kleinsten der beiden INT-Werte. Beispiele: 
+ 
+              min (3.0,  2.0) ==> 2.0 
+              min (-2.0, 3.0) ==> -2.0 
+ 
+   REAL PROC min (REAL CONST first, second) 
+   Zweck: Liefert den Kleinsten der beiden REAL-Werte. 
+ 
+MOD 
+   INT OP MOD (INT CONST left, right) 
+   Zweck: Liefert den Rest einer INT-Division. Beispiele: 
+ 
+             3 MOD 2 ==> 1 
+            -3 MOD 2 ==> 1 
+ 
+   Fehlerfall: 
+      * DIV by 0 
+          Division durch 0 ist verboten. 
+ 
+   REAL OP MOD (REAL CONST left, right) 
+   Zweck: Modulo-Funktion für REALs (liefert den Rest). Beispiele: 
+ 
+             5.0 MOD 2.0 ==> 1.0 
+             4.5 MOD 4.0 ==> 0.5 
+ 
+no 
+   BOOL PROC no (TEXT CONST question) 
+   Zweck: Wirkt wie 
+ 
+              NOT yes 
+ 
+NOT 
+   BOOL OP NOT (BOOL CONST a) 
+   Zweck: Logische Negation. 
+ 
+online 
+   BOOL PROC online 
+   Zweck: Liefert TRUE, wenn die Task mit einem Terminal gekoppelt ist. 
+ 
+OR 
+   BOOL OP OR (BOOL CONST a, b) 
+   Zweck: Logisches oder. 
+ 
+out 
+   PROC out (TEXT CONST text) 
+   Zweck: Ausgabe eines Textes auf dem Bildschirm. Im Unterschied zu 'put' 
+          wird kein Blank an den ausgegebenen Text angefügt. 'out' kann 
+          nicht umgeleitet werden (vergl. 'sysout'). 
+ 
+out subtext 
+   PROC out subtext (TEXT CONST source, INT CONST from) 
+   Zweck: Ausgabe eines Teiltextes von 'source' von der Position 'from' bis 
+          Textende. Es wird keine Aktion vorgenommen für 
+ 
+              from > LENGTH source 
+ 
+   PROC out subtext (TEXT CONST source, INT CONST from, to) 
+   Zweck: Ausgabe eines Teiltextes von 'source' von der Position 'from' bis 
+          zur Position 'to'. Für 
+ 
+              to > LENGTH source 
+ 
+          wird für die fehlenden Zeichen Leerzeichen (blanks) ausgegeben. 
+ 
+page 
+   PROC page 
+   Zweck: Es wird zum Anfang einer neuen Seite positioniert (hier: linke 
+          obere Ecke des Bildschirms, wobei der Bildschirm gelöscht wird). 
+ 
+pause 
+   PROC pause (INT CONST time limit) 
+   Zweck: Wartet 'time limit' in Zehntel-Sekunden. Bei negativen Werten ist 
+          die Wirkung nicht definiert. Die Wartezeit wird nicht nur durch 
+          das  Erreichen der Grenze abgebrochen, sondern auch durch die 
+          Eingabe eines beliebigen Zeichens. 
+ 
+pi 
+   REAL CONST pi 
+   Zweck: Die Zahl pi (3.141593). 
+ 
+pos 
+   INT PROC pos (TEXT CONST source, pattern) 
+   Zweck: Liefert die erste Position des ersten Zeichens von 'pattern' in 
+          'source', falls 'pattern' gefunden wird. Wird 'pattern' nicht 
+          gefunden oder ist 'pattern' niltext, so wird der Wert '0' ge- 
+          liefert. Beispiel: 
+ 
+               TEXT VAR t1 :: "abcdefghijk...xyz", 
+                        t2 :: "cd"; 
+               ... pos (t1, t2) ... (* liefert 3 *) 
+               ... pos (t2, t1) ... (* liefert 0 *) 
+ 
+   INT PROC pos (TEXT CONST source, pattern, INT CONST from) 
+   Zweck: Wie obige Prozedur, jedoch wird erst ab der Position 'from' ab 
+          gesucht. Dabei gilt folgende Einschränkung: 
+ 
+               length (pattern) < 255 
+ 
+INT PROC pos (TEXT CONST source, low char, high char, INT CONST from) 
+   Zweck: Liefert die Position des ersten Zeichens 'x' in 'source' ab der 
+          Position 'from', so daß 
+ 
+              low char <= x <= high char 
+ 
+          'low char' und 'high char' müssen TEXTe der Länge 1 sein. Wird 
+          kein Zeichen in 'source' in dem Bereich zwischen 'low char' und 
+          'high char' gefunden, wird der Wert '0' geliefert. Beispiel: 
+ 
+         (* Suche nach dem ersten Zeichen <> blank nach einer Leerspalte *) 
+         TEXT VAR zeile :: "BlaBla       Hier gehts weiter"; 
+         INT VAR pos erstes blank :: pos (zeile, " "), 
+          ende leerspalte  :: pos (zeile, ""33"", ""254"", pos erstes blank); 
+ 
+put 
+   PROC put (INT CONST number) 
+   Zweck: Ausgabe eines INT-Wertes auf dem Bildschirm. Anschließend wird 
+          ein Leerzeichen ausgegeben. Die Ausgabe kann umgeleitet werden 
+          (vergl. 'sysout'). 
+ 
+   PROC put (REAL CONST real) 
+   Zweck: Ausgabe eines REAL-Wertes auf dem Bildschirm. Anschließend wird 
+          ein Leerzeichen ausgegeben. Die Ausgabe kann umgeleitet werden 
+          (vergl. 'sysout') 
+ 
+   PROC put (TEXT CONST text) 
+   Zweck: Ausgabe eines Textes auf dem Bildschirm. Nach der Ausgabe von 
+          'text' wird ein Blank ausgegeben, um nachfolgenden Ausgaben auf 
+          der gleichen Zeile voneinander zu trennen. Hardwareabhängig sind 
+          die Aktionen, wenn eine Ausgabe über eine Zeilengrenze (hier: 
+          Bildschirmzeile) vorgenommen wird. Meist wird die Ausgabe auf der 
+          nächsten Zeile fortgesetzt. Die Ausgabe kann umgeleitet werden 
+          (vergl. 'sysout'). 
+ 
+putline 
+   PROC putline (TEXT CONST text) 
+   Zweck: Ausgabe von 'text' auf dem Bildschirm. Nach der Ausgabe wird auf 
+          den Anfang der nächsten Zeile positioniert. Gibt man TEXTe nur mit 
+          'putline' aus, so ist gesichert, daß jede Ausgabe auf einer neuen 
+          Zeile beginnt. Hardwareabhängig sind die Aktionen, wenn eine Aus- 
+          gabe über eine Zeilengrenze (hier: Bildschirmzeile) vorgenommen 
+          wird. Meist wird die Ausgabe auf der nächsten Zeile fortgesetzt. 
+          Die Ausgabe kann umgeleitet werden (vergl. 'sysout'). 
+ 
+random 
+   INT PROC random (INT CONST lower bound, upper bound) 
+   Zweck: Pseudo-Zufallszahlen-Generator im Intervall 'upper bound' und 
+          'lower bound' einschließlich. Es handelt sich hier um den "INT 
+          Random Generator". 
+ 
+   REAL PROC random 
+   Zweck: Pseudo-Zufallszahlen-Generator im Intervall 0 und 1. Es handelt 
+          sich hier um den "REAL Random Generator". 
+ 
+real 
+   REAL PROC real (INT CONST a) 
+   Zweck: Konvertierungsprozedur. 
+ 
+   REAL PROC real (TEXT CONST text) 
+   Zweck: Konvertierung eines TEXTes 'text' in einen REAL-Wert. Achtung: Zur 
+          Zeit werden keine Überprüfungen vorgenommen, d.h. in dem TEXT 
+          muß ein REAL-Wert stehen. 
+ 
+replace 
+   PROC replace (TEXT VAR destination, INT CONST position, TEXT CONST source) 
+   Zweck: Ersetzung eines Teiltextes in 'destination' durch 'source' an der 
+          Position 'position' in 'destination'. Es muß gelten 
+ 
+              1 <= position <= LENGTH destination 
+ 
+          d.h. 'position' muß innerhalb von 'destination' liegen und 'source' 
+          muß  von der Position 'position' ab in 'destination' einsetzbar 
+          sein. Dabei bleibt die Länge von 'destination' unverändert. 
+ 
+round 
+   REAL PROC round (REAL CONST real, INT CONST digits) 
+   Zweck: Runden eines REAL-Wertes auf 'digits' Stellen. Für positive Werte 
+          wird auf Nachkommastellen gerundet. Beispiel: 
+ 
+              round (3.14159, 3) 
+ 
+          liefert '3.142'. Für negative 'digits'-Werte wird auf Vorkomma- 
+          stellen gerundet. Beispiel: 
+ 
+              round (123.456, -2) 
+ 
+          liefert '100.0'. Abweichung vom Standard: Es wird mit 'digits'- 
+          Ziffern gerundet. 
+ 
+say 
+   PROC say (TEXT CONST message) 
+   Zweck: Sofern der Kommando-Dialog eingeschaltet ist (vergl. 'command 
+          dialogue'), wird der TEXT 'message' an die augenblickliche Cursor- 
+          Position geschrieben. 
+ 
+sign 
+   INT PROC sign (INT CONST argument) 
+   Zweck: Feststellen des Vorzeichens eines INT-Wertes. Folgende Werte 
+          werden geliefert: 
+ 
+              argument > 0     ==> 1 
+              argument = 0     ==> 0 
+              argument < 0     ==> -1 
+ 
+   INT OP SIGN (INT CONST argument) 
+   Zweck: Feststellen des Vorzeichens eines INT-Wertes. 
+ 
+   INT PROC sign (REAL CONST number) 
+   Zweck: Feststellen des Vorzeichens eines REAL-Wertes. 
+ 
+   INT OP SIGN (REAL CONST number) 
+   Zweck: Feststellen des Vorzeichens eines REAL-Wertes. 
+ 
+sin 
+   REAL PROC sin (REAL CONST x) 
+   Zweck: Sinus-Funktion. 'x' muß in Radiant (Bogenmaß) angegeben werden. 
+ 
+sind 
+   REAL PROC sind (REAL CONST x) 
+   Zweck: Sinus-Funktion. 'x' muß im Winkelgrad angegeben werden. 
+ 
+smallreal 
+   REAL PROC smallreal 
+   Zweck: Kleinster darstellbarer REAL-Wert im EUMEL-System für den 
+ 
+              1.0 - smallreal <> 1.0 
+              1.0 + smallreal <> 1.0 
+ 
+          gilt (1.0E-12). 
+ 
+sqrt 
+   REAL PROC sqrt (REAL CONST z) 
+   Zweck: Wurzel-Funktion. 
+   Fehlerfall: 
+      * sqrt von negativer Zahl 
+          Das Argument muß größer gleich 0.0 sein. 
+ 
+stop 
+   PROC stop 
+   Zweck: Abbruch (vergl. Fehlerbehandlung). 
+ 
+SUB 
+   TEXT OP SUB (TEXT CONST text, INT CONST pos) 
+   Zweck: Liefert ein Zeichen aus 'text' an der Position 'pos'. Entspricht 
+ 
+              subtext (text, pos, pos) 
+ 
+          Anmerkung: Effizienter als obiger Prozedur-Aufruf. Für 
+ 
+              pos <= 0 
+              pos > LENGTH text 
+ 
+          wird niltext geliefert. 
+ 
+subtext 
+   TEXT PROC subtext (TEXT CONST source, INT CONST from) 
+   Zweck: Teiltext von 'source', der bei der Position 'from' anfängt. Die 
+          Länge des Resultats ergibt sich also zu 
+ 
+              LENGTH source - from + 1 
+ 
+          d.h. von der Position 'from' bis zum Ende von 'source'. 'from' muß 
+          innerhalb von 'source' liegen. Ist from < 1, dann wird 'source' 
+          geliefert. Falls from > LENGTH source ist, wird niltext geliefert. 
+ 
+   TEXT PROC subtext (TEXT CONST source, ITT CONST from, to) 
+   Zweck: Teiltext von 'source' von der Position 'from' bis einschließlich 
+          der Position 'to'. Die Länge des Resultats ist also  
+ 
+              from - to + 1 
+ 
+          Dabei muß gelten 
+ 
+              1 <= from <= to <= LENGTH source 
+ 
+          d.h. die Positionen 'from' und 'to' müssen in dieser Reihenfolge 
+          innerhalb von 'source' liegen. Ist 
+ 
+              to >= LENGTH source 
+ 
+          wird 'subtext (source, from)' ausgeführt. Für die Bedingungen für 
+          'from' siehe vorstehende Beschreibung von 'subtext'. 
+ 
+sysin 
+   PROC sysin (TEXT CONST file name) 
+   Zweck: Eingabe-Routinen ('get', 'getline' und 'line') lesen nicht mehr 
+          vom Benutzer-Terminal, sondern aus der Datei 'file name'. 
+ 
+   TEXT PROC sysin 
+   Zweck: Liefert den Namen der eingestellten 'sysin'-Datei. "" bezeichnet 
+          das Benutzer-Terminal. 
+ 
+sysout 
+   PROC sysout (TEXT CONST file name) 
+   Zweck: Ausgabe-Routinen ('put', 'putline', 'write', 'line') gehen nicht 
+          mehr zum Benutzer-Terminal, sondern in die Datei 'file name'. 
+ 
+   TEXT PROC sysout 
+   Zweck: Liefert den Namen der eingestellten 'sysout'-Datei. "" bezeichnet 
+          das Benutzer-Terminal. 
+ 
+tan 
+   REAL PROC tan (REAL CONST x) 
+   Zweck: Tangens-Funktion. 'x' muß in Radiant angegeben werden. 
+ 
+tand 
+   REAL PROC tand (REAL CONST x) 
+   Zweck: Tangens-Funktion. 'x' muß in Winkelgrad angegeben werden. 
+ 
+text 
+   TEXT PROC text (INT CONST number) 
+   Zweck: Umwandlung eines INT-Wertes in einen Text. Negative Werte werden 
+          mit einem "-"-Zeichen geliefert. 
+ 
+   TEXT PROC text (INT CONST number, laenge) 
+   Zweck: Umwandlung eines INT-Wertes 'number' in einen Text mit der Länge 
+          'laenge'. Für 
+ 
+              LENGTH (text (number)) < laenge 
+ 
+          werden die Ziffern rechtsbündig in einen Text mit der Länge 
+          'laenge' eingetragen. Fehlende Ziffern der gewünschten 'laenge' 
+          werden im TEXT vorne mit Leerzeichen aufgefüllt. Für 
+ 
+              LENGTH (text (number)) > laenge 
+ 
+          wird ein Text mit der Länge 'laenge' geliefert, der mit 
+          "*"-Zeichen gefüllt ist. 
+ 
+   TEXT PROC text (REAL CONST real) 
+   Zweck: Konvertierung eines REAL-Wertes in einen TEXT. Ggf. wird der TEXT 
+          in Exponenten-Darstellung geliefert. 
+ 
+   TEXT PROC text (REAL CONST real, laenge) 
+   Zweck: Siehe oben. 'laenge' gibt die Anzahl von Zeichen an. 
+ 
+   TEXT PROC text (REAL CONST real, INT CONST laenge, fracs) 
+   Zweck: Konvertierung eines REAL-Wertes in einen TEXT. Dabei gibt 'laenge' 
+          die Länge des Resultats einschließlich des Dezimalpunktes und 
+          'fracs' die Anzahl der Dezimalstellen an. Kann der REAL-Wert nicht 
+          wie gewünscht dargestellt werden, wird 
+ 
+              laenge * "*" 
+ 
+          geliefert. 
+ 
+   TEXT PROC text (TEXT CONST source, INT CONST laenge) 
+   Zweck: Teiltext aus 'source' mit der Länge 'laenge', beginnend bei der 
+          Position 1 von 'source'. Es muß gelten 
+ 
+              1 <= laenge <= LENGTH source 
+ 
+          d.h. der gewünschte Teiltext muß aus 'source' ausblendbar sein. 
+          Wenn 
+ 
+              laenge > LENGTH source 
+ 
+          die Länge des gewünschten Resultats ist größer als die Länge von 
+          'source' ist, wird der zu liefernde TEXT mit der an 'laenge' 
+          fehlenden Zeichen mit Leerzeichen aufgefüllt. 
+ 
+   TEXT PROC text (TEXT CONST source, INT CONST laenge, from) 
+   Zweck: Teiltext aus 'source' mit der Länge 'laenge', beginnend an der 
+          Position 'from' in dem TEXT 'source'. Entspricht 
+ 
+              text (subtext (source, from, LENGTH source), laenge) 
+ 
+          Es muß 
+ 
+              laenge >= 0 
+              1 <= from <= LENGTH source 
+ 
+          gelten, d.h. 'from' muß eine Position angeben, die innerhalb von 
+          'source' liegt. Für 
+ 
+              laenge > LENGTH source - from + 1 
+ 
+          also wenn die angegebene Länge 'laenge' größer ist als der auszu- 
+          blendende Text, wird das Resultat rechts mit Leerzeichen aufge- 
+          füllt. Wenn 
+ 
+              laenge < LENGTH source - from + 1 
+ 
+          d.h. wenn die angegebene Länge kleiner ist als der Teiltext von 
+          'from' bis zum letzten Zeichen von 'source', wird das Resultat mit 
+          der Länge 
+ 
+              LENGTH source - from + 1 
+ 
+          geliefert. 
+ 
+time 
+   TEXT PROC time (REAL CONST time) 
+   Zweck: Konvertierungsprozedur für die Zeiten der CPU-Zeituhr. Liefert die 
+          Zeiten in der Form 'hh:mm:ss.s'. Vergl. dazu 'clock'. 
+ 
+   TEXT PROC time (REAL CONST value, INT CONST laenge) 
+   Zweck: Konvertiert die Zeit in externe Darstellung. Für die 'laenge'- 
+          Werte ergibt sich: 
+ 
+              laenge = 10              (*   hh:mm:ss.s *) 
+              laenge = 12              (*  hhh:mm:ss.s *) 
+ 
+REAL PROC time (TEXT CONST time) 
+   Zweck: Konvertierungsprozedur für Texte der CPU-Zeituhr in REAL-Werte. 
+ 
+time of day 
+   TEXT PROC time of day (REAL CONST time) 
+   Zweck: Konvertierungsprozedur für REALs, wie sie die Realzeituhr 
+          liefert. Es wird die Tageszeit in der Form 'hh:mm' geliefert. 
+          Beispiel: 
+ 
+              put (time of day (clock (1)))  (* z.B.: 17:25 *) 
+ 
+ 
+   TEXT PROC time of day 
+   Zweck: Liefert die aktuelle Tageszeit. Entspricht 
+ 
+              time of day (clock (1)) 
+ 
+TIMESOUT 
+   OP TIMESOUT (INT CONST times, TEXT CONST text) 
+   Zweck: Ausgabe eines TEXTes 'text' 'times'mal. An die Ausgabe wird im 
+          Gegensatz zu 'put' kein Leerzeichen angefügt. Es wird kein Text 
+          ausgegeben für 
+ 
+              times < 1 
+ 
+write 
+   PROC write (TEXT CONST text) 
+   Zweck: Gibt 'text' ohne Trennblank aus ('put' mit Trennblank). Läßt sich 
+          im Gegensatz zu 'out' in eine Datei umleiten (vergl. 'sysout'). 
+ 
+XOR 
+   BOOL OP XOR (BOOL CONST a, b) 
+   Zweck: Exklusives oder. 
+ 
+yes 
+   BOOL PROC yes (TEXT CONST question) 
+   Zweck: Sofern der Kommando-Dialog (vergl. 'command dialogue') einge- 
+          schaltet ist, wird der TEXT 'question' auf dem Bildschirm des 
+          Benutzers geschrieben. Der TEXT 'question' wird dabei mit einem 
+          Fragezeichen ergänzt. Der Benutzer kann nun am Terminal mit den 
+          Zeichen 'j' oder 'n' antworten (oder: 'J', 'N', 'y', 'n', 'Y', 
+          'N'). Nach Eingabe eines dieser Zeichen wird von der Prozedur 
+          'yes' auf eine neue Zeile positioniert. Die Prozedur 'yes' liefert 
+          den Wert TRUE bei der Eingabe von 'j' und den Wert FALSE bei der 
+          Eingabe von 'n'. Ist der Kommando-Dialog nicht eingeschaltet, 
+          liefert die Prozedur 'yes' den Wert TRUE. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9
new file mode 100644
index 0000000..318dd06
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9
@@ -0,0 +1,936 @@
+                      EUMEL-Benutzerhandbuch 
+ 
+                    TEIL 9: Standard-Datentypen                     
+ 
+1. VECTOR und MATRIX 
+ 
+Vektoren und Matrizen enthalten Elemente vom Datentyp REAL. Für beide Daten- 
+typen sind die üblichen Operatoren definiert. Im Unterschied zu "normalen" 
+'ROW n REAL' bzw. 'ROW n ROW m REAL' brauchen die Anzahl der Elemente, die 
+sich in einem Vektor bzw. in einer Matrix befinden, nicht bereits zur Über- 
+setzungszeit deklariert, sondern können "dynamisch" zur Laufzeit eines ELAN- 
+Programms festgelegt werden. Somit ist es möglich, eine zur Übersetzungszeit 
+noch unbekannte Anzahl von REAL-Elementen zu bearbeiten und dabei nur soviel 
+Speicherplatz wie notwendig zu verwenden. Bei beiden Datentypen ist die 
+maximale Anzahl von Elementen jeweils 4 000. 
+ 
+Bei VECTOR und MATRIX ist auf die üblichen Rundungsfehler bei der Verwendung 
+von REALs zu achten, die bei umfangreicheren Rechnungen unvermeidlich ent- 
+stehen. Rundungsfehler durch Ein- bzw. Ausgaberoutinen können z.Zt. im 
+EUMEL-System jedoch nicht vorkommen, weil REAL-Werte dezimal im Rechner 
+abgespeichert werden (13 Stellen, von denen jedoch nur 7 ausgegeben werden). 
+ 
+ 
+ 
+VECTOR 
+ 
+Folgende VECTOR-Operationen stehen zur Verfügung: 
+ 
+vector         Erzeugung eines VECTOR-Objekts 
+get            Eingabe der Elemente vom Terminal 
+put            Ausgabe der Elemente auf das Terminal 
+replace        Ersetzung eines Elementes eines VECTORs 
+SUB            Zugriff auf ein REAL-Element eines VECTORs 
+LENGTH         Anzahl der Elemente eines VECTORs 
+length         dito 
+NORM           Euklidische Norm 
+ + 
+ - 
+ * 
+ / 
+ := 
+ = 
+ <> 
+ 
+ 
+ 
+Beschreibung der VECTOR-Operationen 
+ 
+Aus Optimierungsgründen (Heapbelastung) wurde der Datentyp INITVECTOR ge- 
+schaffen. Dieser wird im VECTOR-Paket intern gehalten (wird nicht über das 
+Interface herausgereicht) und kann somit nicht in einer Deklaration benutzt 
+werden. INITVECTOR wird nur für die Operationen 
+ 
+     := 
+     vector 
+ 
+verwendet. Bei Verwendung eines Datenobjekts vom Datentyp INITVECTOR wird 
+nicht soviel Speicherplatz wie bei einem Objekt vom Datentyp VECTOR benötigt. 
+ 
+= 
+     BOOL OP = (VECTOR CONST a, b) 
+     Zweck: Vergleich zweier Vektoren. Der Operator liefert FALSE, wenn die 
+            Anzahl der Elemente von 'a' und 'b' ungleich ist oder wenn zwei 
+            Elemente mit gleichem Index ungleich sind. Beispiel: 
+ 
+                 VECTOR VAR x :: vector (10, 1.0), 
+                            y :: vector (15, 2.0), 
+                            z :: vector (10, 1.0); 
+                 ... x = y ... (* FALSE *) 
+                 ... x = z ... (* TRUE  *) 
+ 
+<> 
+    BOOL OP <> (VECTOR CONST a, b) 
+     Zweck: Vergleich zweier Vektoren auf Ungleichheit (NOT (a = b)). 
+ 
+:= 
+     OP := (VECTOR VAR ziel, VECTOR CONST quelle) 
+     Zweck: Zuweisung. Nach der Zuweisung gilt auch 
+ 
+                 length (quelle) = length (ziel) 
+ 
+            d.h. der linke Operand besitzt nach der Zuweisung genauso viele 
+            Elemente wie 'quelle', unabhängig davon, ob 'ziel' vor der Zu- 
+            weisung mehr oder weniger Elemente als 'quelle' besaß. Beispiel: 
+ 
+                 VECTOR VAR y :: vector (10, 1.0), 
+                            z :: vector (15, 2.0); 
+                 ... 
+                 y := z; (* length (y) liefert nun 15 ! *) 
+ 
+     OP := (VECTOR VAR ziel, INITVECTOR CONST quelle) 
+     Zweck: Dient zur Initialisierung eines VECTORs. Beispiel: 
+ 
+                 VECTOR VAR x :: vector (17); 
+ 
+            'vector' erzeugt ein Objekt vom Datentyp INITVECTOR. Dieses 
+            Objekt braucht nicht soviel Speicherplatz wie ein VECTOR-Objekt. 
+            Dadurch wird vermieden, daß nach erfolgter Zuweisung nicht ein 
+            durch 'vector' erzeugtes Objekt auf dem Heap unnötig Speicher- 
+            platz verbraucht. 
+ 
++ 
+     VECTOR OP + (VECTOR CONST a) 
+     Zweck: Monadisches '+' für VECTOR. Keine Auswirkung. 
+ 
+     VECTOR OP + (VECTOR CONST a, b) 
+     Zweck: Elementweise Addition der Vektoren 'a' und 'b'. Beispiel: 
+ 
+                 VECTOR VAR x, (* 'x' hat undefinierte Laenge *) 
+                            a :: vector (10, 1.0), 
+                            b :: vector (10, 2.0); 
+                 ... 
+                 x := a + b; (* 'x' hat nun 10 Elemente mit Werten '3.0' *) 
+     Fehlerfall: 
+          * VECTOR OP + : LENGTH a <> LENGTH b 
+            'a' und 'b' haben nicht die gleiche Anzahl von Elementen. 
+ 
+- 
+     VECTOR OP - (VECTOR CONST a) 
+     Zweck: Monadisches '-'. 
+ 
+     VECTOR OP - (VECTOR CONST a, b) 
+     Zweck: Elementweise Subtraktion der Vektoren 'a' und 'b'. 
+     Fehlerfall: 
+          * VECTOR OP - : LENGTH a <> LENGTH b 
+            'a' und 'b' haben nicht die gleiche Anzahl von Elementen. 
+ 
+* 
+     REAL OP * (VECTOR CONST a, b) 
+     Zweck: Skalarprodukt zweier Vektoren. Liefert die Summe der element- 
+            weisen Multiplikation der Vektoren 'a' und 'b'. Beachte even- 
+            tuelle Rundungsfehler! Beispiel: 
+ 
+                 REAL VAR a; 
+                 VECTOR VAR b :: vector (10, 2.0), 
+                            c :: vector (10, 2.0); 
+                 ... 
+                 a := b * c; (* 40.0 *) 
+     Fehlerfall: 
+          * REAL OP * : LENGTH a <> LENGTH b 
+            'a' und 'b' haben nicht die gleiche Anzahl von Elementen. 
+ 
+     VECTOR OP * (VECTOR CONST a, REAL CONST s) 
+     Zweck: Multiplikation des Vektors 'a' mit dem Skalar 's'. 
+ 
+     VECTOR OP * (REAL CONST s, VECTOR CONST a) 
+     Zweck: Multiplikation des Skalars 's' mit dem Vektor 'a'. 
+ 
+/ 
+     VECTOR OP / (VECTOR CONST a, REAL CONST s) 
+     Zweck: Division des Vektors 'a' durch den Skalar 's'. Beispiel: 
+ 
+                VECTOR VAR a, (* 'a' hat undefinierte Laenge *) 
+                           b :: vector (10, 4.0); 
+                ... 
+                a := b / 2.0; 
+                (* 'a' hat nun 10 Elemente mit Werten '2.0' *) 
+ 
+get 
+     PROC get (VECTOR VAR a, INT CONST l) 
+     Zweck: Einlesen der Elemente von 'a' vom Terminal, wobei 'l' die Anzahl 
+            der Elemente angibt. 
+     Fehlerfall: 
+          * PROC get : size <= 0 
+            Die angeforderte Elementanzahl 'l' muß > 0 sein. 
+ 
+length 
+     INT PROC length (VECTOR CONST a) 
+     Zweck: Liefert die Anzahl der Elemente von 'a'. Beispiel: 
+ 
+                 VECTOR VAR a :: vector (10, 1.0), 
+                            b :: vector (15, 2.0); 
+                 ... 
+                 ... length (a) ... (* 10 *) 
+                 ... length (b) ... (* 15 *) 
+ 
+LENGTH 
+     INT OP LENGTH (VECTOR CONST a) 
+     Zweck: Liefert die Anzahl der Elemente von 'a'. 
+ 
+NORM 
+     REAL OP NORM (VECTOR CONST v) 
+     Zweck: Euklidische Norm (Wurzel aus der Summe der Quadrate der Elemente). 
+ 
+put 
+     PROC put (VECTOR CONST v) 
+     Zweck: Ausgabe der Werte der Elemente von 'v' auf dem Terminal. 
+ 
+replace 
+     PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) 
+     Zweck: Zuweisung des i-ten Elementes von 'v' mit dem Wert von 'r'. 
+            Beispiel: 
+ 
+                 VECTOR VAR v :: ...; 
+                 ... 
+                 replace (v, 13, 3.14); 
+                 (* Das 13. Element von 'v' bekommt den Wert '3.14' *) 
+     Fehlerfälle: 
+          * PROC replace : subscript overflow 
+            Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors (i > 
+            LENGTH v). 
+          * PROC replace : subscript underflow 
+            Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors 
+            (i < 1). 
+ 
+SUB 
+     REAL OP SUB (VECTOR CONST v, INT CONST i) 
+     Zweck: Liefert das 'i'-te Element von 'v'. 
+     Fehlerfälle: 
+          * OP SUB : subscript overflow 
+            Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors (i > 
+            LENGTH v). 
+          * OP SUB : subscript underflow 
+            Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors 
+            (i < 1). 
+ 
+vector 
+     INITVECTOR PROC vector (INT CONST l) 
+     Zweck: Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt 
+            benötigt nicht soviel Speicherplatz wie ein VECTOR-Objekt. Die 
+            Elemente werden mit dem Wert '0.0' initialisiert. 
+     Fehlerfall: 
+          * PROC vector : size <= 0 
+            Die angeforderte Elementanzahl 'l' muß > 0 sein. 
+ 
+     INITVECTOR PROC vector (INT CONST l, REAL CONST value): 
+     Zweck: Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt 
+            benötigt nicht soviel Speicherplatz wie ein VECTOR-Objekt. Die 
+            Elemente werden mit dem Wert 'value' initialisiert. Beispiel: 
+ 
+                 VECTOR VAR v := vector (17, 3.14159); 
+                 (* 'v' hat 17 Elemente mit den Wert '3.14159' *) 
+      Fehlerfall: 
+          * PROC vector : size <= 0 
+            Die angeforderte Elementanzahl 'l' muß > 0 sein. 
+ 
+ 
+ 
+MATRIX 
+ 
+Folgende Operationen stehen für MATRIX zur Verfügung: 
+ 
+matrix           Erzeugung eines MATRIX-Objekts 
+idn              Erzeugung einer Einheitsmatrix 
+put              Ausgabe der MATRIX auf dem Terminal 
+get              Eingabe der Matrix vom Terminal 
+replace row      Ersetzung einer Zeile 
+replace column   Ersetzung einer Spalte 
+replace element  Ersetzung eines Elements 
+row              Liefert einen VECTOR (Zeile einer MATRIX) 
+column           Liefert einen VECTOR (Spalte einer MATRIX) 
+sub              Liefert ein REAL-Elemement 
+COLUMNS          Anzahl Spalten 
+ROWS             Anzahl Zeilen 
+INV              Inverse 
+DET              Determinante 
+TRANSP           Transponierte 
+transp           Transponierte (speicherfreundlich) 
+ + 
+ - 
+ * 
+ := 
+ = 
+ <> 
+ 
+ 
+ 
+Beschreibung der MATRIX-Operationen 
+ 
+Aus Optimierungsgründen (Heapbelastung) wurde der Datentyp INITMATRIX 
+geschaffen. Dieser wird im MATRIX-Paket intern gehalten (wird nicht über das 
+Interface herausgereicht) und kann somit nicht in einer Deklaration benutzt 
+werden. INITMATRIX wird nur für die Operationen 
+ 
+     := 
+     idn 
+     matrix 
+ 
+verwendet. Bei Verwendung eines Objekts vom Datentyp INITMATRIX wird nicht 
+der Speicherplatz für eine MATRIX benötigt. 
+ 
++ 
+     MATRIX OP + (MATRIX CONST m) 
+     Zweck: Monadisches '+'. Keine Auswirkungen. 
+ 
+     MATRIX OP + (MATRIX CONST l, r) 
+     Zweck: Addition zweier Matrizen. Die Anzahl der Reihen und der Spalten 
+            muß gleich sein. Beispiel: 
+ 
+                MATRIX VAR a :: matrix (3, 43, 1.0), 
+                            b :: matrix (3, 43, 2.0), 
+                            summe; 
+                summe := a + b; 
+                (* Alle Elemente haben den Wert '3.0' *) 
+     Fehlerfälle: 
+          * MATRIX OP + : COLUMNS l <> COLUMNS r 
+            Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. 
+          * MATRIX OP + : ROWS l <> ROWS r 
+            Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. 
+ 
+- 
+     MATRIX OP - (MATRIX CONST m) 
+     Zweck: Monadisches Minus. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4, 10.0) 
+                 a := - a; (* Alle Elemente haben den Wert '-10.0' *) 
+ 
+     MATRIX OP - (MATRIX CONST l, r) 
+     Zweck: Subtraktion zweier Matrizen. Die Anzahl der Reihen und Spalten 
+            muß gleich sein. 
+     Fehlerfälle: 
+          * MATRIX OP - : COLUMNS l <> COLUMNS r 
+            Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. 
+          * MATRIX OP - : ROWS l <> ROWS r 
+            Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. 
+ 
+* 
+     MATRIX OP * (REAL CONST r, MATRIX CONST m) 
+     Zweck: Multiplikation einer Matrix 'm' mit einem Skalar 'r'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4, 2.0); 
+                 ... 
+                 a := 3 * a; (* Alle Elemente haben den Wert '6.0' *) 
+ 
+     MATRIX OP * (MATRIX CONST m, REAL CONST r) 
+     Zweck: Multiplikation einer Matrix 'm' mit einem Skalar 'r'. 
+ 
+     MATRIX OP * (MATRIX CONST l, r) 
+     Zweck: Multiplikation zweier Matrizen. Die Anzahl der Spalten von 'l' 
+            und die Anzahl der Zeilen von 'r' müssen gleich sein. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4, 2.0), 
+                            b :: matrix (4, 2, 3.0), 
+                            produkt; 
+                 produkt := a * b; 
+                 (* Alle Elemente haben den Wert '24.0' *) 
+     Fehlerfall: 
+          * MATRIX OP * : COLUMNS l <> ROWS r 
+            Die Anzahl der Spalten von 'l' muß mit der Anzahl der Zeilen 
+            von 'r' übereinstimmen. 
+ 
+     VECTOR OP * (VECTOR CONST v, MATRIX CONST m) 
+     Zweck: Multiplikation des Vektors 'v' mit der Matrix 'm'. 
+     Fehlerfall: 
+          * VECTOR OP * : LENGTH v <> ROWS m 
+            Die Anzahl der Elemente von 'v' stimmt nicht mit den Anzahl der 
+            Zeilen von 'm' überein. 
+ 
+     VECTOR OP * (MATRIX CONST m, VECTOR CONST v) 
+     Zweck: Multiplikation der Matrix 'm' mit dem Vektor 'v'. 
+     Fehlerfall: 
+          * VECTOR OP * : COLUMNS m <> LENGTH v 
+            Die Anzahl der Spalten von 'm' stimmt nicht mit der Anzahl der 
+            Elementen von 'v' überein. 
+ 
+= 
+     BOOL OP = (MATRIX CONST l, r) 
+     Zweck: Vergleich zweier Matrizen. Der Operator '=' liefert FALSE, wenn 
+            die Anzahl Spalten oder Reihen der Matrizen 'l' und 'r' ungleich 
+            ist und wenn mindestens ein Element mit gleichen Indizes der zwei 
+            Matrizen ungleiche Werte haben. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 3), 
+                            b :: matrix (3, 3, 1.0), 
+                            c :: matrix (4, 4); 
+                 ... a = b ... 
+                 (* FALSE wegen ungleicher Werte   *) 
+                 ... a = c ... 
+                 (* FALSE wegen ungleicher Groesse *) 
+                 ... b = c ... 
+                 (* FALSE wegen ungleicher Groesse *) 
+ 
+<> 
+     BOOL OP <> (MATRIX CONST l, r) 
+     Zweck: Vergleich der Matrizen 'l' und 'r' auf Ungleichheit. 
+ 
+:= 
+     OP := (MATRIX VAR l, MATRIX CONST r) 
+     Zweck: Zuweisung von 'r' auf 'l'. Die MATRIX 'l' bekommt u.U. eine neue 
+            Anzahl von Elementen. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4, 0.0), 
+                            b :: matrix (5, 5, 3.0); 
+                 ... 
+                 a := b; (* 'a' hat jetzt 5 x 5 Elemente *) 
+ 
+     OP := (MATRIX VAR l, INITMATRIX CONST r) 
+     Zweck: Dient zur Initialisierung einer Matrix. Beispiel: 
+ 
+                 MATRIX VAR x :: matrix (17, 4); 
+ 
+            'matrix' erzeugt ein Objekt vom Datentyp INITMATRIX. Dieses 
+            Objekt braucht nicht soviel Speicherplatz wie ein MATRIX-Objekt. 
+            Dadurch wird vermieden, daß nach erfolgter Zuweisung nicht ein 
+            durch 'matrix' erzeugtes Objekt auf dem Heap unnötig Speicher- 
+            platz verbraucht. 
+ 
+column 
+     VECTOR PROC column (MATRIX CONST m, INT CONST i) 
+     Zweck: Die 'i'-te Spalte von 'm' wird als VECTOR mit 'ROWS m' Elementen 
+            geliefert. Beispiel: 
+ 
+                 MATRIX CONST a :: matrix (3, 4); 
+                 VECTOR VAR b   :: column (a, 1); 
+               (* 'b' hat drei Elemente mit den Werten '0.0' *) 
+     Fehlerfälle: 
+          * PROC column : subscript overflow 
+            Der Index 'i' liegt außerhalb der Matrix 'm' (i > COLUMNS m). 
+          * PROC column : subscript underflow 
+            Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). 
+ 
+COLUMNS 
+     INT OP COLUMNS (MATRIX CONST m) 
+     Zweck: Liefert die Anzahl der Spalten von 'm'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4), 
+                            b :: matrix (7, 10); 
+                 put (COLUMNS a); (* 4 *) 
+                 put (COLUMNS b); (* 10 *) 
+ 
+DET 
+     REAL OP DET (MATRIX CONST m) 
+     Zweck: Es wird der Wert der Determinanten von 'm' geliefert. 
+     Fehlerfall: 
+          * OP DET : no square matrix 
+            Die Matrix ist nicht quadratisch, d.h. ROWS m <> COLUMNS m 
+ 
+get 
+     PROC get (MATRIX VAR m, INT CONST rows, columns) 
+     Zweck: Einlesen von Werten für die Matrix 'm' vom Terminal mit 'rows'- 
+            Zeilen und 'columns'-Spalten. 
+ 
+idn 
+     INITMATRIX PROC idn (INT CONST size) 
+     Zweck: Erzeugen einer Einheitsmatrix vom Datentyp INITMATRIX. Beispiel: 
+ 
+                 MATRIX VAR a :: idn (10); 
+                 (* Erzeugt eine Matrix mit 10 x 10 Elementen, 
+                    deren Werte '0.0' sind, mit der Ausnahme der 
+                    Diagonalelemente, die den Wert '1.0' haben. *) 
+     Fehlerfall: 
+          * PROC idn : size <= 0 
+            Die angeforderte 'size' Anzahl Spalten oder Zeilen muß > 0 sein. 
+ 
+INV 
+     MATRIX OP INV (MATRIX CONST m) 
+     Zweck: Liefert als Ergebnis die Inverse von 'm' (Achtung: starke Run- 
+            dungsfehler möglich). 
+     Fehlerfälle: 
+          * OP INV : no square matrix 
+            Die Matrix 'm' ist nicht quadratisch, d.h. ROWS m <> COLUMNS m 
+          * OP INV : singular matrix 
+            Die Matrix ist singulär. 
+ 
+matrix 
+     INITMATRIX PROC matrix (INT CONST rows, columns) 
+     Zweck: Erzeugen eines Datenobjekts vom Datentyp INITMATRIX mit 'rows' 
+            Zeilen und 'columns' Spalten. Alle Elemente werden mit dem Wert 
+            '0.0' initialisiert. Beispiel: 
+ 
+                MATRIX CONST :: matrix (3, 3); 
+     Fehlerfälle: 
+          * PROC matrix : rows <= 0 
+            Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. 
+          * PROC matrix : columns <= 0 
+            Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. 
+ 
+     INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) 
+     Zweck: Erzeugen eines Datenobjekts vom Datentyp MATRIX mit 'rows' 
+            Zeilen und 'columns' Spalten. Alle Elemente der erzeugten MATRIX 
+            werden mit dem Wert 'value' initialisiert. Beispiel: 
+ 
+                 MATRIX CONST :: matrix (3, 3, 3.14); 
+     Fehlerfälle: 
+          * PROC matrix : rows <= 0 
+            Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. 
+          * PROC matrix : columns <= 0 
+            Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. 
+ 
+put 
+     PROC put (MATRIX CONST m) 
+     Zweck: Ausgabe der Werte einer Matrix auf dem Terminal. 
+ 
+replace column 
+     PROC replace column (MATRIX VAR m, INT CONST column index, 
+                          VECTOR CONST column value) 
+     Zweck: Ersetzung der durch 'column index' definierten Spalte in der 
+            MATRIX 'm' durch den VECTOR 'column value'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 5, 1.0); 
+                 VECTOR VAR b :: vector (3, 2.0); 
+                 ... 
+                 replace column (a, 2, b); 
+                 (* Die zweite Spalte von 'a' wird durch die Werte von 'b' 
+                 ersetzt *) 
+     Fehlerfälle: 
+          * PROC replace column : LENGTH columnvalue <> ROWS m 
+            Die Anzahl der Zeilen der MATRIX 'm' stimmt nicht mit der Anzahl 
+            der Elemente von 'columnvalue' überein. 
+          * PROC replace column : column subscript overflow 
+            Der Index 'columnindex' liegt außerhalb von 'm' 
+            (columnindex > COLUMNS m). 
+          * PROC sub : column subscript underflow 
+            Der Index 'columnindex' liegt außerhalb von 'm' 
+            (columnindex < 1). 
+ 
+replace element 
+     PROC replace element (MATRIX VAR m , INT CONST row, column, 
+                           REAL CONST value) 
+     Zweck: Ersetzung eines Elementes von 'm' in der 'row'-ten Zeile und 
+            'column'-ten Spalte durch den Wert 'value'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (5, 5); 
+                 ... 
+                 replace element (1, 1, 3.14159); 
+     Fehlerfälle: 
+          * PROC replace element : row subscript overflow 
+            Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). 
+          * PROC replace element : row subscript underflow 
+            Der Index 'row' liegt außerhalb von 'm' (row < 1). 
+          * PROC replace element : column subscript overflow 
+            Der Index 'column' liegt außerhalb von 'm' (column > COLUMNS m). 
+          * PROC replace element : row subscript underflow 
+            Der Index 'column' liegt außerhalb von 'm' (column < 1). 
+ 
+replace row 
+     PROC replace row (MATRIX VAR m, INT CONST rowindex, 
+                       VECTOR CONST rowvalue) 
+     Zweck: Ersetzung der Reihe 'rowindex' in der MATRIX 'm' durch den 
+            VECTOR 'rowvalue'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 5, 1.0); 
+                 VECTOR VAR b :: vector (5, 2.0); 
+                 ... 
+                 replace row (a, 2, b); 
+                 (* Die 2. Reihe von 'a' wird durch Werte von 'b' ersetzt *) 
+     Fehlerfälle: 
+          * PROC replace row : LENGTH rowvalue <> COLUMNS m 
+            Die Anzahl der Spalten der MATRIX 'm' stimmt nicht mit der Anzahl 
+            der Elemente von 'rowvalue' überein. 
+          * PROC replace row : row subscript overflow 
+            Der Index 'rowindex' liegt außerhalb von 'm'  (rowindex > ROWS m). 
+          * PROC sub : row subscript underflow 
+            Der Index 'rowindex' liegt außerhalb von 'm' (rowindex < 1). 
+ 
+row 
+     VECTOR PROC row (MATRIX CONST m, INT CONST i) 
+     Zweck: Die 'i'-te Reihe von 'm' wird als VECTOR mit 'COLUMNS m' 
+            Elementen geliefert. Beispiel: 
+ 
+                 MATRIX CONST a :: matrix (3, 4); 
+                 VECTOR VAR b   :: row (a, 1); 
+               (* 'b' hat vier Elemente mit den Werten '0.0'*) 
+     Fehlerfälle: 
+          * PROC row : subscript overflow 
+            Der Index 'i' liegt außerhalb der Matrix 'm' (i > ROWS m). 
+          * PROC row : subscript underflow 
+            Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). 
+ 
+ROWS 
+     INT OP ROWS (MATRIX CONST m) 
+     Zweck: Liefert die Anzahl der Zeilen von 'm'. Beispiel: 
+ 
+                 MATRIX VAR a :: matrix (3, 4), 
+                            b :: matrix (7, 10); 
+                 ... 
+                 put (ROWS a); (* 3 *) 
+                 put (ROWS b); (* 7 *) 
+ 
+sub 
+     REAL PROC sub (MATRIX CONST m, INT CONST row, column) 
+     Zweck: Liefert den Wert eines Elementes von 'm', welches durch die 
+            Indizes 'row' und 'column' bestimmt wird. Beispiel: 
+ 
+                 MATRIX VAR m :: matrix (5, 10, 1.0); 
+                 put (sub (m, 3, 7)); 
+     Fehlerfälle: 
+          * PROC sub : row subscript overflow 
+            Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). 
+          * PROC sub : row subscript underflow 
+            Der Index 'row' liegt außerhalb von 'm' (row < 1). 
+          * PROC sub : column subscript overflow 
+            Der Index 'column' liegt außerhalb von 'm' (column > ROWS m). 
+          * PROC sub : row subscript underflow 
+            Der Index 'column' liegt außerhalb von 'm' (column < 1). 
+ 
+TRANSP 
+     MATRIX OP TRANSP (MATRIX CONST m) 
+     Zweck: Liefert als Ergebnis die transponierte Matrix 'm'. 
+ 
+transp 
+     PROC transp (MATRIX VAR m) 
+     Zweck: Transponieren der Matrix 'm', wobei kaum zusätzlicher Speicher- 
+            platz benötigt wird. 
+ 
+ 
+ 
+2. COMPLEX 
+ 
+Das COMPLEX-Paket ist im ausgelieferten Standard-System noch nicht vorüber- 
+setzt, sondern wird im Quellcode ausgeliefert und kann so bei Bedarf von 
+jeder EUMEL-Installation in die implementationsabhängigen Standard-Pakete 
+aufgenommen werden. 
+ 
+Folgende Operationen stehen für COMPLEX zur Verfügung: 
+ 
+put             Ausgabe auf dem Terminal 
+get             Eingabe auf dem Terminal 
+complex zero    Denotierungsprozedur 
+complex one     dito 
+complex i       dito 
+complex         dito 
+real part       Realteil eines komplexen Werts 
+imag part       Imaginärteil eines komplexen Werts 
+phi             Winkel in der Polardarstellung (Radiant) 
+dphi            dito, in Winkelgrad 
+CONJ            Konjugiert komplexer Wert 
+sqrt            Wurzelfunktion 
+ + 
+ - 
+ * 
+ / 
+ := 
+ = 
+ <> 
+ 
+ 
+ 
+Beschreibung der COMPLEX-Operationen 
+ 
+= 
+     BOOL OP = (COMPLEX CONST a, b) 
+     Zweck: Vergleich von 'a' und 'b' auf Gleichheit. 
+ 
+:= 
+     OP := (COMPLEX VAR a, COMPLEX CONST b) 
+     Zweck: Zuweisung. 
+ 
+<> 
+     BOOL OP <> (COMPLEX CONST a, b) 
+     Zweck: Vergleich von 'a' und 'b' auf Ungleichheit. 
+ 
++ 
+     COMPLEX OP + (COMPLEX CONST a, b) 
+     Zweck: Summe von 'a' und 'b'. 
+ 
+- 
+     COMPLEX OP - (COMPLEX CONST a, b) 
+     Zweck: Differenz von 'a' und 'b'. 
+ 
+* 
+     COMPLEX OP * (COMPLEX CONST a, b) 
+     Zweck: Multiplikation von 'a' mit 'b'. 
+ 
+/ 
+     COMPLEX OP / (COMPLEX CONST a, b) 
+     Zweck: Division von 'a' mit 'b'. 
+ 
+ABS 
+     REAL OP ABS (COMPLEX CONST x) 
+     Zweck: REAL-Betrag von 'x'. 
+ 
+complex 
+     COMPLEX PROC complex (REAL CONST re, im) 
+     Zweck: Denotierungsprozedur. Angabe in kartesischen Koordinaten. 
+ 
+complex i 
+     COMPLEX PROC complex i 
+     Zweck: Denotierungsprozedur für den komplexen Wert '0.0 + i 1.0'. 
+ 
+complex one 
+     COMPLEX PROC complex one 
+     Zweck: Denotierungsprozedur für den komplexen Wert '1.0 + i 0.0'. 
+ 
+complex zero 
+     COMPLEX PROC complex zero 
+     Zweck: Denotierungsprozedur für den komplexen Wert '0.0 + i 0.0'. 
+ 
+CONJ 
+     COMPLEX OP CONJ (COMPLEX CONST number) 
+     Zweck: Liefert den konjugiert komplexen Wert von 'number'. 
+ 
+dphi 
+     REAL PROC dphi (COMPLEX CONST x) 
+     Zweck: Winkel von 'x' (Polardarstellung). 
+ 
+get 
+     PROC get (COMPLEX VAR a) 
+     Zweck: Einlesen eines komplexen Wertes vom Bildschirm in der Form 
+            zweier REAL-Denoter. Die Eingabe kann editiert werden. 
+ 
+imag part 
+     REAL PROC imag part (COMPLEX CONST number) 
+     Zweck: Liefert den Imaginärteil des komplexen Wertes 'number'. 
+ 
+phi 
+     REAL PROC phi (COMPLEX CONST x) 
+     Zweck: Winkel von 'x' (Polardarstellung) in Radiant. 
+ 
+put 
+     PROC put (COMPLEX CONST a) 
+     Zweck: Ausgabe eines komplexen Wertes auf dem Bildschirm in Form zweier 
+            REAL-Werte. Hinter jedem REAL-Wert wird ein Leerzeichen angefügt. 
+            
+real part 
+     REAL PROC real part (COMPLEX CONST number) 
+     Zweck: Liefert den Real-Teil des komplexen Wertes 'number'. 
+ 
+sqrt 
+     COMPLEX PROC sqrt (COMPLEX CONST x) 
+     Zweck: Wurzelfunktion für komplexe Werte. 
+ 
+ 
+ 
+3. LONGINT 
+ 
+LONGINT ist ein Datentyp, für den (fast) alle Prozeduren und Operatoren des 
+Datentyps INT implementiert wurden. LONGINT unterscheidet sich von INT 
+dadurch, daß erheblich größere Werte darstellbar sind. 
+ 
+Für den Datentyp LONGINT stehen folgende Operationen zur Verfügung: 
+ 
+get              Eingabe vom Terminal 
+put              Ausgabe vom Terminal 
+ABS, abs         Absolutbetrag 
+INCR, DECR       Addition und Zuweisung bzw. Subtraktion und Zuweisung 
+DIV              Division ohne Rest 
+int, text        Konvertierungen 
+longint          dito 
+max, min         Maximum bzw. Minimum zweier LONGINTs 
+MOD              Modulo-Funktion 
+random           Zufallszahlen 
+sign             Vorzeichen 
+ < 
+ > 
+ <= 
+ <> 
+ = 
+ - 
+ + 
+ * 
+ ** 
+ 
+ 
+ 
+Beschreibung der LONGINT-Operationen 
+ 
+< 
+     BOOL OP < (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf kleiner. 
+ 
+> 
+     BOOL OP > (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf größer. 
+ 
+<= 
+     BOOL OP <= (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf kleiner gleich. 
+ 
+>= 
+     BOOL OP >= (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf größer gleich. 
+ 
+<> 
+     BOOL OP <> (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf Ungleichheit. 
+ 
+= 
+     BOOL OP = (LONGINT CONST left, right) 
+     Zweck: Vergleichen zweier LONGINTs auf Gleichheit. 
+ 
+- 
+     LONGINT OP - (LONGINT CONST argument) 
+     Zweck: Vorzeichenumkehrung. 
+ 
+     LONGINT OP - (LONGINT CONST left, right) 
+     Zweck: Subtraktion zweier LONGINTs. 
+ 
++ 
+     LONGINT OP + (LONGINT CONST argument) 
+     Zweck: Monadischer Operator. Ohne Wirkung. 
+ 
+     LONGINT OP + (LONGINT CONST left, right) 
+     Zweck: Addition zweier LONGINTs. 
+ 
+* 
+     LONGINT OP * (LONGINT CONST left, right) 
+     Zweck: Multiplikation von zwei LONGINTs. 
+ 
+** 
+     LONGINT OP ** (LONGINT CONST argument, exponent) 
+     Zweck: Exponentiation zweier LONGINTs mit positivem Exponenten. 
+     Fehlerfälle : 
+          * LONGINT OP ** : negative exponent 
+            Der 'exponent' muß >= 0 sein. 
+          * 0 ** 0 is not defined 
+            'argument' und 'exponent' dürfen nicht gleich 0 sein. 
+ 
+ 
+     LONGINT OP ** (LONGINT CONST argument, INT CONST exponent) 
+     Zweck: Exponentiation eines LONGINT mit positiven INT Exponenten. 
+     Fehlerfälle : 
+          * LONGINT OP ** : negative exponent 
+            Der 'exponent' muß >= 0 sein. 
+          * 0 ** 0 is not defined 
+           'argument' und 'exponent' dürfen nicht gleich 0 sein. 
+ 
+ABS 
+     LONGINT OP ABS (LONGINT CONST argument) 
+     Zweck: Absolutbetrag eines LONGINT. 
+ 
+abs 
+     LONGINT PROC abs (LONGINT CONST argument) 
+     Zweck: Absolutbetrag eines LONGINT. 
+ 
+DECR 
+     OP DECR (LONGINT VAR resultat, LONGINT CONST ab) 
+     Zweck: resultat := resultat - ab 
+ 
+DIV 
+     LONGINT OP DIV (LONGINT CONST left, right) 
+     Zweck: Division zweier LONGINTs. 
+     Fehlerfall : 
+          * divide by zero 
+            'right' muß <> 0 sein. 
+ 
+get 
+     PROC get (LONGINT VAR zahl) 
+     Zweck: Eingabe eines LONGINTs vom Terminal. 
+ 
+     PROC get (FILE VAR file, LONGINT VAR zahl) 
+     Zweck: Einlesen von 'zahl' aus der sequentiellen Datei 'file'. Die 
+            Datei muß mit 'input' assoziiert sein (vergl. 'sequential file'). 
+     Fehlerfälle : 
+          * file not open 
+            Die Datei 'file' ist gegenwärtig nicht assoziiert. 
+          * input after end of file 
+            Es wurde versucht, über die letzte Zeile einer Datei zu lesen. 
+          * input access to output file 
+            Es wurde versucht, von einem mit 'output' assoziierten FILE zu 
+            lesen. 
+ 
+INCR 
+     LONGINT OP INCR (LONGINT VAR resultat, LONGINT CONST dazu) 
+     Zweck: resultat := resultat + dazu 
+ 
+int 
+     INT PROC int (LONGINT CONST longint) 
+     Zweck: Konvertierung von LONGINT nach INT. 
+     Fehlerfall : 
+          * integer overflow 
+            'longint' ist größer als 'maxint'. 
+ 
+longint 
+     LONGINT PROC longint (INT CONST int) 
+     Zweck: Konvertierung von 'int' nach LONGINT. 
+ 
+     LONGINT PROC longint (TEXT CONST text) 
+     Zweck: Konvertierung von 'text' nach LONGINT. 
+ 
+max 
+     LONGINT PROC max (LONGINT CONST left, right) 
+     Zweck: Liefert das Maximum zweier LONGINTs. 
+ 
+min 
+     LONGINT PROC min (LONGINT CONST left, right) 
+     Zweck: Liefert das Minimum zweier LONGINTs. 
+ 
+MOD 
+     LONGINT OP MOD (LONGINT CONST left, right) 
+     Zweck: Modulo-Funktion für LONGINTs. Der Rest einer LONGINT-Division 
+            wird ermittelt. 
+     Fehlerfall : 
+          * text (left) + 'MOD 0' 
+            'right' muß ungleich null sein. 
+ 
+put 
+     PROC put (LONGINT CONST longint) 
+     Zweck: Ausgabe eines LONGINTs auf dem Bildschirm. Anschließend wird 
+            ein Leerzeichen ausgegeben. Hardwareabhängig sind die Aktionen, 
+            wenn eine Ausgabe über die Bildschirmzeilengrenze vorgenommen 
+            wird. Meist wird jedoch die Ausgabe auf der nächsten Zeile fort- 
+            gesetzt. 
+ 
+     PROC put (FILE VAR file, LONGINT CONST zahl) 
+     Zweck: Ausgabe von 'zahl' in die sequentielle Datei 'file'. 'file' muß 
+            mit 'output' assoziiert sein. 
+     Fehlerfälle : 
+          * file not open 
+            Die Datei 'file' ist gegenwärtig nicht assoziiert. 
+          * output access to input file 
+            Es wurde versucht, auf einem mit 'input' assoziierten FILE zu 
+            schreiben. 
+ 
+random 
+     LONGINT PROC random (LONGINT CONST lower bound, upper bound) 
+     Zweck: Pseudo-Zufallszahlen-Generator im Intervall 'lower bound' und 
+            'upper bound' einschließlich. Es handelt sich hier um den 
+            'LONGINT Random Generator'. 
+ 
+SIGN 
+     INT OP SIGN (LONGINT CONST longint) 
+     Zweck: Feststellen des Vorzeichens von 'longint'. Liefert: 
+ 
+                      0 wenn 'longint' = 0, 
+                      1 wenn 'longint' > 0, 
+                     -1 wenn 'longint' < 0. 
+ 
+sign 
+     INT PROC sign (LONGINT CONST longint) 
+     Zweck: Feststellen des Vorzeichens von 'longint'. Liefert: 
+ 
+                      0 wenn 'longitt' = 0, 
+                      1 wenn 'longint' > 0, 
+                     -1 wenn 'longint' < 0. 
+ 
+text 
+     TEXT PROC text (LONGINT CONST longint) 
+     Zweck: Konvertierung von 'longint' nach TEXT. 
+ 
+     TEXT PROC text (LONGINT CONST longint, INT CONST laenge) 
+     Zweck: Konvertierung von 'longint' nach TEXT. Die Anzahl der Zeichen 
+            soll 'laenge' betragen. Für 
+ 
+                LENGTH (text (longint)) < laenge 
+ 
+            werden die Zeichen rechtsbündig in einen Text mit der Länge 
+            'laenge' eingetragen. Ist der daraus entstehende TEXT kleiner 
+            als 'laenge', werden die an 'laenge' fehlenden Zeichen im TEXT 
+            mit Leerzeichen aufgefüllt. Für 
+ 
+                 LENGTH (text (longint)) > length 
+ 
+            wird ein Text mit der Länge 'length' geliefert, der mit 
+            '*'-Zeichen gefüllt ist. 
+
diff --git a/doc/user-manual/1.7.3-pd/doc/source-disk b/doc/user-manual/1.7.3-pd/doc/source-disk
new file mode 100644
index 0000000..f769920
--- /dev/null
+++ b/doc/user-manual/1.7.3-pd/doc/source-disk
@@ -0,0 +1 @@
+173_publicdomain/03_benutzerhandbuch.img
diff --git a/doc/user/benutzerhandbuch.1 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.1
index 7c8fec7..7c8fec7 100644
--- a/doc/user/benutzerhandbuch.1
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.1
diff --git a/doc/user/benutzerhandbuch.2 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.2
index 0153fae..0153fae 100644
--- a/doc/user/benutzerhandbuch.2
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.2
diff --git a/doc/user/benutzerhandbuch.3 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.3
index eb1c762..eb1c762 100644
--- a/doc/user/benutzerhandbuch.3
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.3
diff --git a/doc/user/benutzerhandbuch.4 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.4
index c13a091..c13a091 100644
--- a/doc/user/benutzerhandbuch.4
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.4
diff --git a/doc/user/benutzerhandbuch.5a b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5a
index 1e907f0..1e907f0 100644
--- a/doc/user/benutzerhandbuch.5a
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5a
diff --git a/doc/user/benutzerhandbuch.5b b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5b
index 748e398..748e398 100644
--- a/doc/user/benutzerhandbuch.5b
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5b
diff --git a/doc/user/benutzerhandbuch.5c b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5c
index 010cacd..010cacd 100644
--- a/doc/user/benutzerhandbuch.5c
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5c
diff --git a/doc/user/benutzerhandbuch.5d b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5d
index 8a61f29..8a61f29 100644
--- a/doc/user/benutzerhandbuch.5d
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5d
diff --git a/doc/user/benutzerhandbuch.5e b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5e
index d515c6a..d515c6a 100644
--- a/doc/user/benutzerhandbuch.5e
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5e
diff --git a/doc/user/benutzerhandbuch.6 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.6
index 5e035d2..5e035d2 100644
--- a/doc/user/benutzerhandbuch.6
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.6
diff --git a/doc/user/benutzerhandbuch.anhang b/doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang
index 5a58f95..5a58f95 100644
--- a/doc/user/benutzerhandbuch.anhang
+++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang
diff --git a/doc/user-manual/1.8.7/doc/source-disk b/doc/user-manual/1.8.7/doc/source-disk
new file mode 100644
index 0000000..97500ef
--- /dev/null
+++ b/doc/user-manual/1.8.7/doc/source-disk
@@ -0,0 +1 @@
+grundpaket/09_handbuecher.1.img
diff --git a/hamster/ls-Herbert und Robbi 1 b/hamster/ls-Herbert und Robbi 1
deleted file mode 100644
index 9b3ff72..0000000
--- a/hamster/ls-Herbert und Robbi 1
+++ /dev/null
@@ -1,984 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                ls-Herbert und Robbi 1               ** 
-          **                                                     ** 
-          **                     Version 1.1                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls herbert und robbi 1  DEFINES
-       sei ein hamster, ist hamster,
-       sei ein roboter, ist roboter,
-       landschaft, arbeitsfeld,
-       vor, links um, nimm, gib,
-       korn da, werkstueck da,
-       backen leer, behaelter leer,
-       vorn frei, lauf,
-       hamsterinter, roboterinter,
-       geschwindigkeit, taste,
-       befehlssatz erweitern,
-       befehlssatz ist erweitert,
-       drucke landschaft,
-       hamster druckerstart einstellen,
-       hamster drucker xstart,
-
-       hamster drucker ystart,
-       hamster landschaftsschrifttyp einstellen,
-       hamster landschaftsschrifttyp,
-       druckereinstellung fuer flaechenausdruck,
-       landschaftsauskunftstext,
-       testauskunftstext 1, testauskunftstext 2,
-       befehlsauskunftstext, laufauskunftstext,
-       kommandomodus, hamstermodus,
-       zeige landschaft, lege landschaft ab:
-TYPE LOCATION          = STRUCT (INT x, y);
-LET  menukarte         =  "ls-MENUKARTE:Herbert und Robbi",
-     richtung          =  ""3""8""10""2"",
-
-     erscheinungsform  =           "A<V>",
-     praefix           =       "Flaeche:",
-     flaechentype      =             1007,
-     neutral           =                0,
-     erzeuge           =                1,
-     hamsterlauf       =                2,
-     interaktiv        =                3,
-     kommandostufe     =               99,
-     west              =            ""8"",
-     ost               =            ""2"",
-     cleol             =            ""5"",
-     piep              =            ""7"",
-
-     mark ein          =           ""15"",
-     mark aus          =           ""14"",
-     escape            =           ""27"",
-     blank             =              " ",
-     niltext           =               "",
-     hindernis         =              "#",
-     korn              =              "o",
-     hinderniskachel   =             "##",
-     blankkachel       =             " .",
-     kornkachel        =             " o",
-     protokollname     =      "PROTOKOLL";
-LET    max x           =               40,
-
-       max y           =               23;
-LET    FLAECHE         =  ROW max x ROW max y INT;
-LET    LANDSCHAFT      =  STRUCT (INT xpos, ypos, blickrichtung,
-                                      anzahl koerner, FLAECHE flaeche);
-LET    HAMSTER         =  STRUCT (LOCATION stelle, INT koerner, form);
-BOUND LANDSCHAFT VAR aktuelle landschaft;
-FLAECHE VAR land;
-HAMSTER VAR hamster;
-FILE VAR protokoll;
-INT  CONST besetzt                 ::             -1,
-           frei                    ::              0;
-
-TEXT CONST kornsymbole             ::
-  "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
-INT CONST maxkornzahl              ::   LENGTH kornsymbole;
-BOOL VAR   hamster eingestellt     ::           TRUE,
-           befehlssatz erweitert   ::          FALSE;
-TEXT VAR   eingabezeichen          ::        niltext,
-           archivlandschaftsname   ::        niltext,
-           hinderniszeichen        ::           "\#\#",
-           schrifttyp              ::        niltext;
-INT  VAR   verzoegerungsfaktor     ::              5,
-
-           modus                   ::  kommandostufe,
-           a, b, c, d;
-REAL VAR   xstart                  ::            0.0,
-           ystart                  ::            0.0;
-WINDOW VAR fenster                 ::  window (1, 1, 79, 24);
-INITFLAG VAR in this task          ::  FALSE;
-OP := (LOCATION VAR l, LOCATION CONST r):
-   l.x := r.x; l.y := r.y
-END OP :=;
-PROC initialize hamstersystem:
-  IF NOT initialized (in this task)
-     THEN install menu (menukarte);
-  FI
-END PROC initialize hamstersystem;
-
-PROC sei ein hamster:
-  hamster eingestellt := TRUE
-END PROC sei ein hamster;
-BOOL PROC ist hamster:
-   hamster eingestellt
-END PROC ist hamster;
-PROC sei ein roboter:
-  hamster eingestellt := FALSE
-END PROC sei ein roboter;
-BOOL PROC ist roboter:
-   NOT hamster eingestellt
-END PROC ist roboter;
-PROC hole landschaft (TEXT CONST name):
-   aktuelle landschaft := old (praefix + name);
-   land                := aktuelle landschaft.flaeche;
-   hamster.form        := aktuelle landschaft.blickrichtung;
-
-   hamster.stelle.x    := aktuelle landschaft.xpos;
-   hamster.stelle.y    := aktuelle landschaft.ypos;
-   hamster.koerner     := aktuelle landschaft.anzahl koerner
-END PROC hole landschaft;
-PROC lege landschaft ab (TEXT CONST name):
-   IF exists (praefix + name)
-      THEN forget (praefix + name, quiet)
-   FI;
-   aktuelle landschaft                := new (praefix + name);
-   aktuelle landschaft.flaeche        := land;
-   aktuelle landschaft.blickrichtung  := hamster.form;
-   aktuelle landschaft.xpos           := hamster.stelle.x;
-
-   aktuelle landschaft.ypos           := hamster.stelle.y;
-   aktuelle landschaft.anzahl koerner := hamster.koerner;
-   type( old(praefix + name), flaechentype)
-END PROC lege landschaft ab;
-PROC hamstermodus:
-   modus := neutral
-END PROC hamstermodus;
-PROC kommandomodus:
-   modus := kommandostufe
-END PROC kommandomodus;
-PROC erzeugemodus:
-   modus := erzeuge
-END PROC erzeugemodus;
-PROC intermodus:
-   modus := interaktiv
-END PROC intermodus;
-PROC laufmodus:
-   modus := hamsterlauf
-
-END PROC laufmodus;
-BOOL PROC vorn frei:
-  kontrolliere modus;
-  LOCATION VAR hier :: hamster.stelle;
-  SELECT hamster.form OF
-    CASE 1: IF hamster.stelle.y < 2       THEN protestiere FI;
-            hier.y DECR 1
-    CASE 2: IF hamster.stelle.x < 2       THEN protestiere FI;
-            hier.x DECR 1
-    CASE 3: IF hamster.stelle.y >= max y  THEN protestiere FI;
-            hier.y INCR 1
-    CASE 4: IF hamster.stelle.x >= max x  THEN protestiere FI;
-            hier.x INCR 1
-    OTHERWISE modus := kommandostufe;
-
-              IF ist hamster
-                 THEN errorstop(nachricht( 7))
-                 ELSE errorstop(nachricht(14))
-              FI
-  END SELECT;
-  IF modus = erzeuge
-     THEN TRUE
-     ELSE land[hier.x] [hier.y] <> besetzt
-  FI
-END PROC vorn frei;
-BOOL PROC korn da:
-  kontrolliere modus;
-  kornzahl > 0
-END PROC korn da;
-INT PROC kornzahl:
-  land [hamster.stelle.x] [hamster.stelle.y]
-END PROC kornzahl;
-BOOL PROC werkstueck da:
-  korn da
-END PROC werkstueck da;
-BOOL PROC backen leer:
-
-  kontrolliere modus;
-  hamster.koerner <= 0 AND (modus = hamsterlauf OR modus = interaktiv)
-END PROC backen leer;
-BOOL PROC behaelter leer:
-  backen leer
-END PROC behaelter leer;
-PROC protestiere:
-  IF modus = erzeuge
-     THEN out(piep); eins zurueck
-     ELSE verzoegere 10 mal; zeige("X"); verzoegere 10 mal;
-          kommandomodus;
-          IF ist hamster
-             THEN errorstop(nachricht( 6))
-             ELSE errorstop(nachricht(13))
-          FI;
-  FI.
-  eins zurueck:
-
-    SELECT hamster.form OF
-      CASE 1:   hamster.stelle.y INCR 1
-      CASE 2:   hamster.stelle.x INCR 1
-      CASE 3:   hamster.stelle.y DECR 1
-      CASE 4:   hamster.stelle.x DECR 1
-      OTHERWISE kommandomodus;
-                IF ist hamster
-                   THEN errorstop(nachricht( 7))
-                   ELSE errorstop(nachricht(14))
-                FI;
-     END SELECT.
-  verzoegere 10 mal:
-    INT VAR j;
-    FOR j FROM 1 UPTO 10 REP
-      verzoegere
-    PER
-END PROC protestiere;
-
-PROC verzoegere:
-  IF modus <> hamsterlauf
-     THEN LEAVE verzoegere
-  FI;
-  eingabezeichen := incharety (verzoegerungsfaktor);
-  IF   eingabezeichen = escape
-       THEN kommandomodus;
-            IF ist hamster
-               THEN errorstop(nachricht( 4))
-               ELSE errorstop(nachricht(11))
-            FI
-  ELIF eingabezeichen = "-" THEN verlangsame
-  ELIF eingabezeichen = "+" THEN beschleunige
-  ELIF eingabezeichen = "?" THEN boxinfo (fenster, laufauskunftstext,
-                                                   5, maxint, a, b, c, d);
-
-                                 cursor on; zeige landschaft
-  ELIF pos ("0123456789", eingabezeichen) > 0
-        THEN geschwindigkeit (int (eingabezeichen))
-  FI.
-  verlangsame:
-    IF   verzoegerungsfaktor > 31 THEN  (* lass es dabei *)
-    ELIF verzoegerungsfaktor < 1
-         THEN verzoegerungsfaktor INCR 1
-         ELSE verzoegerungsfaktor INCR verzoegerungsfaktor
-    FI.
-  beschleunige:
-    IF verzoegerungsfaktor < 1
-       THEN verzoegerungsfaktor := -1
-       ELSE verzoegerungsfaktor := verzoegerungsfaktor DIV 2
-
-    FI
-END PROC verzoegere;
-PROC geschwindigkeit (INT CONST faktor):
-  SELECT faktor OF
-    CASE 0 :  verzoegerungsfaktor := 20000;
-    CASE 1 :  verzoegerungsfaktor :=    50;
-    CASE 2 :  verzoegerungsfaktor :=    20;
-    CASE 3 :  verzoegerungsfaktor :=    10;
-    CASE 4 :  verzoegerungsfaktor :=     8;
-    CASE 5 :  verzoegerungsfaktor :=     5;
-    CASE 6 :  verzoegerungsfaktor :=     2;
-    CASE 7 :  verzoegerungsfaktor :=     1;
-    CASE 8 :  verzoegerungsfaktor :=     0;
-    CASE 9 :  verzoegerungsfaktor :=    -1;
-
-    OTHERWISE (*belasse es dabei*)
-  END SELECT
-END PROC geschwindigkeit;
-PROC vor:
-  kontrolliere modus;
-  IF vorn frei
-     THEN zeige(kachel);
-          bilde neue hamsterkoordinaten;
-          zeige(erscheinungsform SUB hamster.form);
-          verzoegere
-     ELSE modus := kommandostufe;
-          zeige("X");
-          IF ist hamster
-             THEN errorstop(nachricht(1))
-             ELSE errorstop(nachricht(8))
-          FI
-  FI.
-  kachel:
-    INT CONST z :: land [hamster.stelle.x] [hamster.stelle.y];
-
-    IF   z = besetzt THEN hinderniskachel
-    ELIF z = frei    THEN blankkachel
-                     ELSE kornkachel
-    FI.
-  bilde neue hamsterkoordinaten:
-    SELECT hamster.form OF
-      CASE 1    :hamster.stelle.y DECR 1
-      CASE 2    :hamster.stelle.x DECR 1
-      CASE 3    :hamster.stelle.y INCR 1
-      CASE 4    :hamster.stelle.x INCR 1
-      OTHERWISE  modus:=kommandostufe;
-                 IF ist hamster
-                    THEN errorstop(nachricht( 7))
-                    ELSE errorstop(nachricht(14))
-
-                 FI
-    END SELECT.
-END PROC vor;
-PROC nimm:
-  kontrolliere modus;
-  IF korn da
-     THEN variiere kornzahl (-1);
-          IF kornzahl < 1 THEN zeige (ost + blank) FI
-     ELSE modus := kommandostufe;
-          zeige("X");
-          IF ist hamster
-             THEN errorstop(nachricht(2))
-             ELSE errorstop(nachricht(9))
-          FI
-  FI;
-  verzoegere
-END PROC nimm;
-PROC gib:
-  kontrolliere modus;
-  IF backen leer
-     THEN modus := kommandostufe;
-          zeige ("X");
-
-          IF ist hamster
-             THEN errorstop(nachricht( 3))
-             ELSE errorstop(nachricht(10))
-          FI
-     ELSE variiere kornzahl (+1);
-          zeige(ost + korn)
-  FI;
-  verzoegere
-END PROC gib;
-PROC links um:
-  kontrolliere modus;
-  hamster.form := hamster.form MOD 4 + 1;
-  (* da hamster.form der Werte 1,2,3,4 faehig ist und linksdreht *)
-  zeige (subjekt);
-  verzoegere.
-  subjekt:
-    erscheinungsform SUB hamster.form.
-END PROC links um;
-PROC variiere kornzahl (INT CONST delta):
-
-  IF delta * delta <> 1
-     THEN LEAVE variiere kornzahl
-  FI;   (* als delta kommen nur +1 und -1 vor *)
-  INT VAR k;
-  IF kornzahl = -1 AND delta = 1
-     THEN k := 1
-     ELSE k := kornzahl + delta
-  FI;
-  IF k <= 0
-     THEN land [hamster.stelle.x] [hamster.stelle.y] := frei
-     ELSE land [hamster.stelle.x] [hamster.stelle.y] := min (k,maxkornzahl)
-  FI;
-  IF modus = hamsterlauf OR modus = interaktiv
-     THEN hamster.koerner DECR delta
-  FI
-END PROC variiere kornzahl;
-PROC kontrolliere modus:
-
-  initialize hamstersystem;
-  SELECT modus OF
-    CASE neutral    : erzeugemodus;
-                      landschaft;
-                      laufmodus
-    CASE erzeuge,
-         interaktiv,
-         hamsterlauf: (* nichts *)
-    OTHERWISE         kommandomodus;
-                      line;
-                      IF ist hamster
-                         THEN sage(anwendungstext (21));pause(20);
-                              errorstop(nachricht( 5))
-                         ELSE sage(anwendungstext (22));pause(20);
-
-                              errorstop(nachricht(12))
-                      FI
-  END SELECT
-END PROC kontrolliere modus;
-PROC zeige (TEXT CONST was):
-   cursor (2 * hamster.stelle.x - 1, hamster.stelle.y);
-   IF hamster.stelle.x >= max x  AND hamster.stelle.y > max y
-      THEN out ((was SUB 1)); out(west)
-      ELSE out(was); (LENGTH was) TIMESOUT west
-   FI.
-END PROC zeige;
-PROC sage (TEXT CONST aussage):
-   cursor(1,24); out(aussage + cleol)
-END PROC sage;
-TEXT PROC nachricht (INT CONST nummer):
-
-   inv (text (anwendungstext (nummer), 65)) + piep
-END PROC nachricht;
-TEXT PROC inv (TEXT CONST text):
-  TEXT VAR aus :: mark ein + text + blank + mark aus;
-  aus
-END PROC inv;
-PROC zeige landschaft:
-  initialize hamstersystem;
-  INT VAR y;
-  FOR y FROM 1 UPTO max y REP
-     setze zeile zusammen;
-     cursor (1,y); out (zeile)
-  PER;
-  cursor(1,24); out(cleol);
-  IF modus = interaktiv
-     THEN gib befehlszeile aus
-  FI;
-  zeige hamster; cursor on.
-  setze zeile zusammen:
-    TEXT VAR zeile :: niltext;
-
-    INT VAR x;
-    FOR x FROM 1 UPTO max x REP
-       zeile CAT kachel
-    PER.
-  kachel:
-    INT CONST z :: land [x] [y];
-    IF   z = besetzt THEN hinderniskachel
-    ELIF z = frei    THEN blankkachel
-                     ELSE kornkachel
-    FI.
-   gib befehlszeile aus:
-     cursor(1,1); write(cleol); write (anwendungstext (62))
-END PROC zeige landschaft;
-PROC zeige hamster:
-   zeige (erscheinungsform SUB hamster.form)
-END PROC zeige hamster;
-PROC landschaft (TEXT CONST kandidat):
-
-  initialize hamstersystem;
-  archivlandschaftsname := kandidat;
-  IF   exists (praefix + kandidat)
-         CAND type (old (praefix + kandidat)) = flaechentype
-       THEN behandle existierende landschaft
-  ELIF exists (praefix + kandidat)
-       THEN forget (praefix + kandidat, quiet);
-            behandle neue landschaft
-  ELSE behandle neue landschaft
-  FI.
-  behandle existierende landschaft:
-    hole landschaft (kandidat);
-    SELECT modus OF
-      CASE hamsterlauf,
-           interaktiv,
-
-           neutral       : zeige landschaft;
-                           laufmodus
-      CASE erzeuge       : modifiziere eventuell
-      CASE kommandostufe : modifiziere landschaft
-      OTHERWISE            errorstop (anwendungstext (15))
-    END SELECT.
-  behandle neue landschaft:
-    SELECT modus OF
-      CASE hamsterlauf,
-           interaktiv,
-           neutral,
-           erzeuge       : erschaffe landschaft;
-                           modifiziere landschaft;
-                           zeige landschaft;
-
-                           laufmodus
-      CASE kommandostufe : erschaffe landschaft;
-                           modifiziere landschaft;
-      OTHERWISE            errorstop (anwendungstext (15))
-    END SELECT.
-  modifiziere eventuell:
-    IF ist hamster
-       THEN IF boxyes (fenster, anwendungstext (41), 5, a, b, c, d)
-               THEN cursor on; modifiziere landschaft
-            FI
-       ELSE IF boxyes (fenster, anwendungstext (42), 5, a, b, c, d)
-               THEN cursor on; modifiziere landschaft
-
-            FI
-    FI;
-    zeige landschaft.
-  erschaffe landschaft:
-    INT VAR j;
-    FOR j FROM 1 UPTO max y REP
-      INT VAR k;
-      FOR k FROM 1 UPTO max x REP
-        land [k] [j] := frei
-      PER
-    PER;
-    hamster.form     :=   4;
-    hamster.stelle.x :=  20;
-    hamster.stelle.y :=  12;
-    hamster.koerner  :=   0.
-END PROC landschaft;
-PROC landschaft:
-  initialize hamstersystem;
-  IF ist hamster
-     THEN landschaft (erfragter landschaftsname (anwendungstext (36)))
-
-     ELSE landschaft (erfragter landschaftsname (anwendungstext (37)))
-  FI
-END PROC landschaft;
-TEXT PROC erfragter landschaftsname (TEXT CONST satz):
-  TEXT VAR landschaftsname :: archivlandschaftsname;
-  REP
-    page; line (3); out (satz + cleol); line (2);
-    editget (landschaftsname);
-    landschaftsname := compress (landschaftsname);
-    IF landschaftsname = niltext
-       THEN line (2); out (anwendungstext (18) + piep);
-            line (2); out (anwendungstext (38)); pause
-    FI
-
-  UNTIL landschaftsname <> niltext PER;
-  landschaftsname
-END PROC erfragter landschaftsname;
-PROC arbeitsfeld (TEXT CONST kandidat):
-  landschaft (kandidat)
-END PROC arbeitsfeld;
-PROC arbeitsfeld:
-  landschaft
-END PROC arbeitsfeld;
-PROC modifiziere landschaft:
-  INT CONST modalibi :: modus;
-  erzeugemodus;
-  zeige landschaft;
-  informiere;
-  zeige hamster;
-  nimm ein eingabezeichen;
-  WHILE nicht endewunsch REP
-    erfuelle fortschreibungswunsch;
-    nimm ein eingabezeichen
-  PER;
-
-  erfrage koernerzahl;
-  lege landschaft ab (archivlandschaftsname);
-  modus := modalibi.
-  nimm ein eingabezeichen:
-    inchar (eingabezeichen).
-  nicht endewunsch:
-    pos ("hH", eingabezeichen) = 0.
-  erfuelle fortschreibungswunsch:
-    INT CONST r :: pos (richtung, eingabezeichen)
-    IF   r > 0
-         THEN IF hamster.form = r
-                 THEN vor
-                 ELSE hamster.form := r;
-                      zeige hamster
-              FI
-    ELIF eingabezeichen = "?" THEN boxinfo (fenster, landschaftsauskunftstext,
-
-                                                     5, maxint, a, b, c, d);
-                                   cursor on; zeige landschaft; informiere
-    ELIF eingabezeichen = "k" THEN kopiere landschaft;
-                                   zeige landschaft; informiere
-    ELIF eingabezeichen = "g" THEN gib
-    ELIF eingabezeichen = "n" THEN IF korn da THEN nimm ELSE out (piep) FI
-    ELIF eingabezeichen = "z" THEN zeige (text (kornzahl, 2))
-    ELIF eingabezeichen = hindernis
-         THEN  land [hamster.stelle.x] [hamster.stelle.y] := besetzt; vor
-
-    ELIF eingabezeichen = blank
-         THEN  land [hamster.stelle.x] [hamster.stelle.y] := frei;    vor
-    ELSE out (piep)
-    FI.
-    kopiere landschaft:
-      TEXT VAR kopie;
-      IF NOT not empty (alle landschaften)
-         THEN IF ist hamster
-                 THEN boxinfo (fenster, anwendungstext (196), 5, maxint)
-                 ELSE boxinfo (fenster, anwendungstext (197), 5, maxint)
-              FI
-         ELSE lasse original auswaehlen
-      FI.
-    lasse original auswaehlen:
-
-      IF ist hamster
-         THEN kopie := boxone (fenster, alle landschaften,
-                               anwendungstext (23), anwendungstext (24),
-                               FALSE)
-         ELSE kopie := boxone (fenster, alle landschaften,
-                               anwendungstext (25), anwendungstext (26),
-                               FALSE)
-      FI;
-      cursor on; hole landschaft (kopie).
-    alle landschaften:
-      ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
-
-    erfrage koernerzahl:
-      TEXT VAR eingabe; BOOL VAR ist ok; INT VAR zahl;
-      cursor (1,23); 79 TIMESOUT waagerecht;
-      REP
-        ist ok := TRUE;
-        IF ist hamster
-           THEN eingabe := boxanswer (fenster, anwendungstext (43),
-                                               text (hamster.koerner),
-                                               5, a, b, c, d)
-           ELSE eingabe := boxanswer (fenster, anwendungstext (44),
-                                               text (hamster.koerner),
-
-                                               5, a, b, c, d)
-        FI;
-        disable stop;
-        IF eingabe = "" THEN eingabe := "0" FI;
-        zahl := int (eingabe);
-        IF zahl < 0 OR zahl > maxint THEN ist ok := FALSE FI;
-        IF is error THEN ist ok := FALSE; clear error FI;
-        enable stop;
-      UNTIL last conversion ok AND ist ok PER;
-      cursor on;
-      hamster.koerner := zahl.
-    informiere:
-      cursor (1,1);
-      IF ist hamster
-         THEN out (anwendungstext (27))
-
-         ELSE out (anwendungstext (28))
-      FI
-END PROC modifiziere landschaft;
-PROC lauf (TEXT CONST dateiname):
-  initialize hamstersystem;
-  IF NOT exists (dateiname)
-     THEN errorstop (anwendungstext (16) + dateiname + anwendungstext (17))
-  FI;
-  hamstermodus;
-  disable stop;
-  run (dateiname);
-  kommandomodus;
-  cursor (1, 24);
-  IF is error
-     THEN IF length (errormessage) > 1
-             THEN sage (errormessage); pause;
-          FI
-     ELSE sage (anwendungstext (29)); pause; konserviere landschaft
-
-  FI;
-  clear error;
-  enable stop
-END PROC lauf;
-PROC lauf:
-  lauf (last param)
-END PROC lauf;
-PROC konserviere landschaft:
-  TEXT VAR neuer landschaftsname;
-  IF ist hamster
-     THEN stelle landschaftsfrage
-     ELSE stelle arbeitsfeldfrage
-  FI; cursor on.
-  stelle landschaftsfrage:
-    IF boxyes (fenster, anwendungstext (45), 5)
-       THEN bewahre landschaft auf
-    FI.
-  stelle arbeitsfeldfrage:
-    IF boxyes (fenster, anwendungstext (46), 5)
-       THEN bewahre landschaft auf
-
-    FI.
-  bewahre landschaft auf:
-    neuer landschaftsname := archivlandschaftsname + ".x";
-    lege landschaft ab (neuer landschaftsname);
-    gib hinweis auf neuen namen.
-  gib hinweis auf neuen namen:
-    IF ist hamster
-       THEN boxinfo (fenster, anwendungstext (30)
-                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
-       ELSE boxinfo (fenster, anwendungstext (31)
-                     + inv (neuer landschaftsname), 5, maxint, a, b, c, d)
-    FI
-END PROC konserviere landschaft;
-
-PROC hamsterinter (TEXT CONST landschaftsname):
-  initialize hamstersystem;
-  sei ein hamster;
-  steuere interaktiv (landschaftsname);
-  cursor on
-END PROC hamsterinter;
-PROC hamsterinter:
-  initialize hamstersystem;
-  hamsterinter (erfragter landschaftsname (anwendungstext (39)))
-END PROC hamsterinter;
-PROC roboterinter (TEXT CONST landschaftsname):
-  initialize hamstersystem;
-  sei ein roboter;
-  steuere interaktiv (landschaftsname);
-  cursor on
-END PROC roboterinter;
-PROC roboterinter:
-
-  initialize hamstersystem;
-  roboterinter (erfragter landschaftsname (anwendungstext (40)))
-END PROC roboterinter;
-PROC steuere interaktiv (TEXT CONST landschaftsname):
-  forget (protokollname, quiet);
-  protokoll := sequential file (output, protokollname);
-  intermodus;
-  landschaft (landschaftsname);
-  TEXT VAR befehl :: niltext, letzter befehl :: niltext;
-  REP
-    arbeiten
-  PER.
-  arbeiten:
-    intermodus;
-    hole befehl;
-    fuehre befehl aus.
-  hole befehl:
-    TEXT VAR befehlszeichen;
-
-    TEXT CONST befehlskette :: "vlngpeVLNGPE";
-    INT VAR befehlsposition;
-    zeige (hamsterform);
-    cursor (1,24);
-    IF ist hamster
-       THEN out (cleol + anwendungstext (32) + letzter befehl)
-       ELSE out (cleol + anwendungstext (33) + letzter befehl)
-    FI;
-    cursor(24,24);
-    inchar (befehlszeichen);
-    befehlsposition := pos(befehlskette,befehlszeichen);
-    IF befehlsposition = 0
-       THEN out(piep);
-            LEAVE arbeiten
-    FI;
-    SELECT befehlsposition OF
-
-      CASE 1, 7: befehl := "vor";
-                           out("vor");
-                           letzter befehl := "vor"
-      CASE 2, 8: befehl := "links um";
-                           out("links um");
-                           letzter befehl := "links um"
-      CASE 3, 9: befehl := "nimm";
-                           out("nimm");
-                           letzter befehl := "nimm"
-      CASE 4,10: befehl := "gib";
-                           out("gib");
-                           letzter befehl := "gib"
-
-      CASE 5,11: out("protokoll");
-                 letzter befehl := "protokoll";
-                 FILE VAR p :: sequential file (modify,protokollname);
-                 headline(p, protokollname + "  (Verlassen: <ESC><q>)");
-                 cursor on; show(p); cursor off;
-                 zeige landschaft; befehl := "";
-                 output(protokoll);
-                 LEAVE arbeiten
-      CASE 6,12: out("ende"); kommandomodus; befehl := "";
-                 LEAVE steuere interaktiv
-
-    END SELECT.
-   hamsterform:
-     erscheinungsform SUB hamster.form.
-   fuehre befehl aus:
-     BOOL VAR korrekt;
-     disable stop;
-     do (befehl);
-     cursor (1,24);
-     korrekt := NOT is error;
-     IF is error
-        THEN IF errormessage > ""
-                THEN out (inv (text (errormessage, 65)) + piep);
-                     pause(30);
-             FI;
-             clear error
-     FI;
-     IF korrekt AND befehl <> ""
-        THEN protokolliere (befehl)
-     FI;
-     enable stop;
-
-END PROC steuere interaktiv;
-PROC protokolliere (TEXT CONST befehl):
-  putline (protokoll, befehl + ";")
-END PROC protokolliere;
-PROC drucke landschaft (TEXT CONST landschaftsname):
-  initialize hamstersystem;
-  ROW max y TEXT VAR drucklandschaft;
-  BOUND LANDSCHAFT VAR al;
-  INT VAR i, hamsterx, hamstery;
-  TEXT VAR hamsterzeichen;
-  landschaftsdatei holen;
-  drucklandschaft erzeugen;
-  hamster in drucklandschaft einsetzen;
-  druckdatei erzeugen;
-  disable stop;
-  TEXT VAR datname := std;
-
-  do ("print (""druckdatei"")");
-  IF is error
-      THEN menuinfo (inv (errormessage));
-           clear error;
-  FI;
-  last param (datname);
-  enable stop;
-  druckdatei loeschen;
-  cursor on.
-  landschaftsdatei holen:
-    IF exists (praefix + landschaftsname) AND
-       (type (old (praefix + landschaftsname)) = flaechentype)
-       THEN hole landschaft;
-       ELSE LEAVE drucke landschaft
-    FI.
-  hole landschaft:
-    al             := old (praefix + landschaftsname);
-    hamsterx       := al.xpos;
-
-    hamstery       := al.ypos;
-    hamsterzeichen := erscheinungsform SUB al.blickrichtung.
-  drucklandschaft erzeugen:
-    TEXT VAR zeile; INT VAR  x;
-    FOR i FROM 1 UPTO max y REP
-        zeile := "";
-        FOR x FROM 1 UPTO maxx REP
-            zeile erzeugen
-        PER;
-        drucklandschaft[i] :=  zeile
-    PER.
-  zeile erzeugen:
-    INT CONST zeichen :: al.flaeche [x] [i];
-    IF   zeichen = besetzt THEN zeile CAT hinderniszeichen
-    ELIF zeichen = frei    THEN zeile CAT " ."
-
-                           ELSE zeile CAT " o"
-    FI.
-  hamster in drucklandschaft einsetzen:
-    change (drucklandschaft [hamstery], hamsterx*2-1, hamsterx*2-1,
-            hamsterzeichen).
-  druckdatei erzeugen:
-    FILE VAR p::sequential file(output, "druckdatei");
-    INT VAR blankzahl;
-    line(p);
-    putline(p,"#type (""" + schrifttyp + """)#");
-    putline(p,"#start(" + text(xstart) + "," + text(ystart) + ")#");
-    putline(p,"#limit(20.8)#");
-    blankzahl := ( 80 - (8 + length (landschaftsname))) DIV 2;
-
-    putline(p, blankzahl * " " + praefix + landschaftsname + " ");
-    putline(p, "  ");
-    FOR i FROM 1 UPTO maxy REP
-      putline(p, drucklandschaft[i] + " ")
-    PER.
-  druckdatei loeschen:
-    forget("druckdatei", quiet)
-END PROC drucke landschaft;
-PROC drucke landschaft:
-  initialize hamstersystem;
-  IF ist hamster
-     THEN drucke landschaft (erfragter landschaftsname (anwendungstext (36)))
-     ELSE drucke landschaft (erfragter landschaftsname (anwendungstext (37)))
-  FI;
-  cursor on
-
-END PROC drucke landschaft;
-PROC druckereinstellung fuer flaechenausdruck:
-  initialize hamstersystem;
-  page;
-  IF ist hamster
-     THEN putline (center (invers (anwendungstext (71))))
-     ELSE putline (center (invers (anwendungstext (72))))
-  FI;
-  line (3);
-  put (anwendungstext (73));
-  editget (schrifttyp);
-  line (2);
-  schrifttyp := compress (schrifttyp);
-  putline (anwendungstext (74));
-  putline (anwendungstext (75)); line (2);
-  putline (anwendungstext (76) + text (xstart) + "," + text (ystart) +
-
-           anwendungstext (77)); line;
-  put (anwendungstext (78)); get (xstart); line;
-  put (anwendungstext (79)); get (ystart); line (2);
-  IF yes (anwendungstext (80) + hinderniszeichen + anwendungstext (81))
-     THEN line;
-          put (anwendungstext (82)); inchar (hinderniszeichen); line (2);
-          hinderniszeichen CAT hinderniszeichen;
-          IF hinderniszeichen = "##"
-             THEN hinderniszeichen := "\#\#"
-          FI
-  FI;
-  line;
-  put (anwendungstext (83))
-END PROC druckereinstellung fuer flaechenausdruck;
-
-PROC hamster druckerstart einstellen (REAL CONST xpos, ypos):
-  xstart := xpos; ystart := ypos
-END PROC hamster druckerstart einstellen;
-REAL PROC hamster drucker xstart:
-  xstart
-END PROC hamster drucker xstart;
-REAL PROC hamster drucker ystart:
-  ystart
-END PROC hamster drucker ystart;
-PROC hamster landschaftsschrifttyp einstellen (TEXT CONST typ):
-  schrifttyp := typ
-END PROC hamster landschaftsschrifttyp einstellen;
-TEXT PROC hamster landschaftsschrifttyp:
-  schrifttyp
-END PROC hamster landschaftsschrifttyp;
-
-PROC drucke arbeitsfeld (TEXT CONST arbeitsfeldname):
-  drucke landschaft (arbeitsfeldname)
-END PROC drucke arbeitsfeld;
-PROC drucke arbeitsfeld:
-  drucke landschaft
-END PROC drucke arbeitsfeld;
-TEXT PROC taste:
-  eingabezeichen
-END PROC taste;
-TEXT PROC landschaftsauskunftstext:
-  initialize hamstersystem;
-  IF ist hamster
-     THEN anwendungstext (52)
-     ELSE anwendungstext (53)
-  FI
-END PROC landschaftsauskunftstext;
-TEXT PROC laufauskunftstext:
-  initialize hamstersystem;
-
-  anwendungstext (51)
-END PROC  laufauskunftstext;
-TEXT PROC befehlsauskunftstext:
-  initialize hamstersystem;
-  IF ist hamster
-     THEN anwendungstext (54)
-     ELSE anwendungstext (55)
-  FI
-END PROC befehlsauskunftstext;
-TEXT PROC testauskunftstext 1:
-  initialize hamstersystem;
-  IF befehlssatz erweitert
-     THEN langer testauskunftstext
-     ELSE kurzer testauskunftstext
-  FI.
-  kurzer testauskunftstext:
-    IF ist hamster
-       THEN anwendungstext (56)
-       ELSE anwendungstext (57)
-
-    FI.
-  langer testauskunftstext:
-    IF ist hamster
-       THEN anwendungstext (58)
-       ELSE anwendungstext (60)
-    FI.
-END PROC testauskunftstext 1;
-TEXT PROC testauskunftstext 2:
-  initialize hamstersystem;
-  IF befehlssatz erweitert
-     THEN eintragung
-     ELSE niltext
-  FI.
-  eintragung:
-    IF ist hamster
-       THEN anwendungstext (59)
-       ELSE anwendungstext (61)
-    FI
-END PROC testauskunftstext 2;
-PROC befehlssatz erweitern (BOOL CONST status):
-  befehlssatz erweitert := status
-
-END PROC befehlssatz erweitern;
-BOOL PROC befehlssatz ist erweitert:
-  befehlssatz erweitert
-END PROC befehlssatz ist erweitert;
-END PACKET ls herbert und robbi 1;
-
-
diff --git a/hamster/ls-Herbert und Robbi 2 b/hamster/ls-Herbert und Robbi 2
deleted file mode 100644
index a8ce067..0000000
--- a/hamster/ls-Herbert und Robbi 2
+++ /dev/null
@@ -1,139 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **               ls-Herbert und Robbi 2                ** 
-          **                                                     ** 
-          **                     Version 1.1                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls herbert und robbi 2  DEFINES
-       rechts frei,
-       links frei,
-       hinten frei,
-       korn vorn,    werkstueck vorn,
-       korn links,   werkstueck links,
-       korn rechts,  werkstueck rechts,
-       korn hinten,  werkstueck hinten:
-BOOL PROC rechts frei:
-  rechts um;
-  IF vorn frei
-     THEN links um; TRUE
-     ELSE links um; FALSE
-  FI
-END PROC rechts frei;
-BOOL PROC links frei:
-  links um;
-  IF vorn frei
-     THEN rechts um; TRUE
-     ELSE rechts um; FALSE
-
-  FI
-END PROC links frei;
-BOOL PROC hinten frei:
-  kehrt;
-  IF vorn frei
-     THEN kehrt; TRUE
-     ELSE kehrt; FALSE
-  FI
-END PROC hinten frei;
-BOOL PROC korn vorn:
-  IF vorn frei
-     THEN untersuche feld vor dir
-     ELSE FALSE
-  FI.
-  untersuche feld vor dir:
-    vor;
-    IF korn da
-       THEN mache vorwaertsgehen rueckgaengig; TRUE
-       ELSE mache vorwaertsgehen rueckgaengig; FALSE
-    FI.
-  mache vorwaertsgehen rueckgaengig:
-    kehrt; vor; kehrt
-END PROC korn vorn;
-
-BOOL PROC korn links:
-  links um;
-  IF vorn frei
-     THEN untersuche feld links
-     ELSE rechts um; FALSE
-  FI.
-  untersuche feld links:
-    vor;
-    IF korn da
-       THEN mache linkswende rueckgaengig; TRUE
-       ELSE mache linkswende rueckgaengig; FALSE
-    FI.
-  mache linkswende rueckgaengig:
-    kehrt; vor; links um
-END PROC korn links;
-BOOL PROC korn rechts:
-  rechts um;
-  IF vorn frei
-     THEN untersuche feld rechts
-     ELSE links um; FALSE
-  FI.
-  untersuche feld rechts:
-
-    vor;
-    IF korn da
-       THEN mache rechtswende rueckgaengig; TRUE
-       ELSE mache rechtswende rueckgaengig; FALSE
-    FI.
-  mache rechtswende rueckgaengig:
-    kehrt; vor; rechts um
-END PROC korn rechts;
-BOOL PROC korn hinten:
-  kehrt;
-  IF vorn frei
-     THEN untersuche feld hinter dir
-     ELSE kehrt; FALSE
-  FI.
-  untersuche feld hinter dir:
-    vor;
-    IF korn da
-       THEN mache kehrtwende rueckgaengig; TRUE
-       ELSE mache kehrtwende rueckgaengig; FALSE
-    FI.
-
-  mache kehrtwende rueckgaengig:
-    kehrt; vor
-END PROC korn hinten;
-PROC kehrt:
-  links um; links um
-END PROC kehrt;
-PROC rechts um:
-  links um; links um; links um
-END PROC rechts um;
-BOOL PROC werkstueck vorn:
-  korn vorn
-END PROC werkstueck vorn;
-BOOL PROC werkstueck links:
-  korn links
-END PROC werkstueck links;
-BOOL PROC werkstueck rechts:
-  korn rechts
-END PROC werkstueck rechts;
-BOOL PROC werkstueck hinten:
-  korn hinten
-END PROC werkstueck hinten;
-END PACKET ls herbert und robbi 2;
-
-befehlssatz erweitern (TRUE)
-
-
diff --git a/hamster/ls-Herbert und Robbi 3 b/hamster/ls-Herbert und Robbi 3
deleted file mode 100644
index 7a1da20..0000000
--- a/hamster/ls-Herbert und Robbi 3
+++ /dev/null
@@ -1,929 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **               ls-Herbert und Robbi 3                ** 
-          **                                                     ** 
-          **                     Version 1.1                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls herbert und robbi 3  DEFINES
-  hamsterbefehlsauskunft,
-  hamsterlaufauskunft,
-  hamsterlandschaftsauskunft,
-  hamsterlandschaft verzeichnis,
-  hamsterlandschaft neu erstellen,
-  hamsterlandschaft ansehen,
-  hamsterlandschaft drucken,
-  hamsterlandschaft kopieren,
-  hamsterlandschaft umbenennen,
-  hamsterlandschaft loeschen,
-  hamsterprogramm verzeichnis,
-  hamsterprogramm neu erstellen,
-  hamsterprogramm ansehen,
-  hamsterprogramm kopieren,
-  hamsterprogramm umbenennen,
-
-  hamsterprogramm loeschen,
-  hamsterprogramm drucken,
-  hamster laufen lassen,
-  hamsterinteraktiv laufen lassen,
-  hamster, roboter:
-LET  menukarte       = "ls-MENUKARTE:Herbert und Robbi",
-     praefix         = "Flaeche:",
-     flaechentype    =       1007,
-     niltext         =         "",
-     maxlaenge       =         60,
-     maxnamenslaenge =         50;
-TEXT VAR flaechenname :: "",
-         programmname :: "";
-INITFLAG VAR in this task :: FALSE;
-PROC initialize hamster:
-
-  IF NOT initialized (in this task)
-     THEN flaechenname := "";
-          programmname := ""
-  FI
-END PROC initialize hamster;
-PROC hamster:
-  sei ein hamster;
-  initialize hamster;
-  install menu (menukarte);
-  handle  menu ("HAMSTER")
-END PROC hamster;
-PROC roboter:
-  sei ein roboter;
-  initialize  hamster;
-  install menu (menukarte);
-  handle  menu ("ROBOTER");
-END PROC roboter;
-PROC hamsterlaufauskunft:
-  menuinfo (laufauskunftstext)
-END PROC hamsterlaufauskunft;
-PROC hamsterlandschaftsauskunft:
-
-  menuinfo (landschaftsauskunftstext)
-END PROC hamsterlandschaftsauskunft;
-PROC hamsterbefehlsauskunft:
-  menuinfo (befehlsauskunftstext);
-  menuinfo (testauskunftstext 1);
-  IF testauskunftstext 2 <> ""
-     THEN menuinfo (testauskunftstext 2)
-  FI
-END PROC hamsterbefehlsauskunft;
-PROC hamsterlandschaft verzeichnis:
-  THESAURUS VAR landschaften ::
-  ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-  forget ("Interne Thesaurusdateiliste", quiet);
-  FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");
-
-  f FILLBY landschaften;
-  headline (f, anwendungstext (204)); modify (f);
-  to line (f, 1); insert record (f); write record (f, kenntext);
-  to line (f, 2); insert record (f);
-  to line (f, 1); menuwindowshow (f);
-  forget ("Interne Thesaurusdateiliste", quiet);
-  regenerate menuscreen.
-  kenntext:
-    IF ist hamster THEN anwendungstext (121) ELSE anwendungstext (151) FI.
-END PROC hamsterlandschaft verzeichnis;
-PROC hamsterprogramm verzeichnis:
-  THESAURUS VAR programme :: ALL myself - infix namen (ALL myself, praefix, flaechentype);
-
-  forget ("Interne Thesaurusdateiliste", quiet);
-  FILE VAR f :: sequential file (output, "Interne Thesaurusdateiliste");
-  f FILLBY programme;
-  headline (f, anwendungstext (204)); modify (f);
-  to line (f, 1); insert record (f); write record (f, anwendungstext (181));
-  to line (f, 2); insert record (f);
-  to line (f, 1); menuwindowshow (f);
-  forget ("Interne Thesaurusdateiliste", quiet);
-  regenerate menuscreen
-END PROC hamsterprogramm verzeichnis;
-PROC hamsterlandschaft neu erstellen:
-
-  hole flaechenname;
-  kontrolliere den flaechennamen;
-  kommandomodus;
-  landschaft (flaechenname);
-  regenerate menuscreen.
-  hole flaechenname:
-    IF ist hamster
-       THEN flaechenname := menuanswer (anwendungstext (101) +
-                                        anwendungstext (102), "", 5)
-       ELSE flaechenname := menuanswer (anwendungstext (131) +
-                                        anwendungstext (132), "", 5)
-    FI.
-  kontrolliere den flaechennamen:
-    IF   flaechenname = niltext
-
-         THEN LEAVE hamsterlandschaft neu erstellen
-    ELIF length (flaechenname) > maxnamenslaenge
-         THEN meckere zu langen namen an;
-              flaechenname := niltext;
-              LEAVE hamsterlandschaft neu erstellen
-    ELIF exists (praefix + flaechenname)
-         THEN meckere existierende flaeche an;
-              LEAVE hamsterlandschaft neu erstellen
-    FI
-END PROC hamsterlandschaft neu erstellen;
-PROC hamsterprogramm neu erstellen:
-  hole programmname;
-  kontrolliere den programmnamen;
-
-  command dialogue (FALSE);
-  cursor on;
-  stdinfoedit (programmname);
-  cursor off;
-  command dialogue (TRUE);
-  regenerate menuscreen.
-  hole programmname:
-    programmname := menuanswer (anwendungstext (161) +
-                                anwendungstext (162), "", 5).
-  kontrolliere den programmnamen:
-    IF   programmname = niltext
-         THEN LEAVE hamsterprogramm neu erstellen
-    ELIF length (programmname) > maxnamenslaenge
-         THEN meckere zu langen namen an;
-              programmname := niltext;
-
-              LEAVE hamsterprogramm neu erstellen
-    ELIF exists (programmname)
-         THEN meckere existierendes programm an;
-              LEAVE hamsterprogramm neu erstellen
-    FI
-END PROC hamsterprogramm neu erstellen;
-PROC hamsterlandschaft ansehen:
-  IF flaechenname <> niltext CAND exists (praefix + flaechenname)
-     THEN frage nach dieser flaeche
-     ELSE lasse flaeche auswaehlen
-  FI;
-  kommandomodus;
-  landschaft (flaechenname);
-  regenerate menuscreen.
-  frage nach dieser flaeche:
-
-    IF menuno (ueberschrift + text 1 + name + text 2, 5)
-       THEN lasse flaeche auswaehlen
-    FI.
-  ueberschrift:
-    IF ist hamster
-       THEN center (maxlaenge, invers (anwendungstext (105))) + ""13""13""
-       ELSE center (maxlaenge, invers (anwendungstext (135))) + ""13""13""
-   FI.
-  text 1:
-    IF ist hamster THEN anwendungstext (103) ELSE anwendungstext (133) FI.
-  name:
-    ""13""13" " + invers (flaechenname) + ""13""13"".
-  text 2:
-    IF ist hamster THEN anwendungstext (104) ELSE anwendungstext (134) FI.
-
-  lasse flaeche auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-    IF NOT not empty (verfuegbare)
-       THEN noch keine flaeche;
-            LEAVE hamsterlandschaft ansehen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    IF ist hamster
-       THEN flaechenname := menuone (verfuegbare, anwendungstext (105),
-                                     anwendungstext (106), FALSE)
-       ELSE flaechenname := menuone (verfuegbare, anwendungstext (135),
-
-                                     anwendungstext (136), FALSE)
-    FI;
-    IF flaechenname = niltext
-       THEN regenerate menuscreen;
-            LEAVE hamsterlandschaft ansehen
-    FI.
-END PROC hamsterlandschaft ansehen;
-PROC hamsterprogramm ansehen:
-  IF programmname <> niltext CAND exists (programmname)
-     THEN frage nach diesem programm
-     ELSE lasse programm auswaehlen
-  FI;
-  cursor on;
-  stdinfoedit (programmname);
-  cursor off;
-  regenerate menuscreen.
-  frage nach diesem programm:
-
-    IF menuno (ueberschrift + anwendungstext (163) + name
-                            + anwendungstext (164), 5)
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers (anwendungstext (165))) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare  := ALL myself - infix namen (ALL myself, praefix, flaechentype);
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-
-            LEAVE hamsterprogramm ansehen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    programmname := menuone (verfuegbare, anwendungstext (165),
-                             anwendungstext (166), FALSE);
-    IF programmname = niltext
-       THEN regenerate menuscreen;
-            LEAVE hamsterprogramm ansehen
-    FI.
-END PROC hamsterprogramm ansehen;
-PROC hamsterlandschaft drucken:
-  lasse flaechen auswaehlen;
-  drucke flaechen;
-  regenerate menuscreen.
-  lasse flaechen auswaehlen:
-
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-    IF NOT not empty (verfuegbare)
-       THEN noch keine flaeche;
-            LEAVE hamsterlandschaft drucken
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    IF ist hamster
-       THEN verfuegbare := menusome (verfuegbare, anwendungstext (107),
-                                     anwendungstext (108), FALSE)
-       ELSE verfuegbare := menusome (verfuegbare, anwendungstext (137),
-
-                                     anwendungstext (138), FALSE)
-    FI.
-  drucke flaechen:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (bezeichnung)));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (schlussbemerkung);
-    menuwindowstop.
-  bezeichnung:
-    IF ist hamster THEN anwendungstext (107) ELSE anwendungstext (137) FI.
-
-  schlussbemerkung:
-    IF ist hamster THEN anwendungstext (110) ELSE anwendungstext (140) FI.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              menuwindowout ( " """ + name (verfuegbare, k) + """ "
-                                    + anwendungstext (201));
-              menuwindowline;
-              drucke landschaft (name (verfuegbare, k));
-              fehlerbehandlung
-
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            IF ist hamster
-               THEN menuwindowout (anwendungstext (109))
-               ELSE menuwindowout (anwendungstext (139))
-            FI;
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE hamsterlandschaft drucken
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-            LEAVE hamsterlandschaft drucken
-    FI.
-END PROC hamsterlandschaft drucken;
-PROC hamsterprogramm drucken:
-  lasse programme auswaehlen;
-  drucke programme;
-  regenerate menuscreen.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
-
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE hamsterprogramm drucken
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, anwendungstext (167),
-                             anwendungstext (168), FALSE).
-  drucke programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (anwendungstext (167))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (anwendungstext (170));
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              menuwindowout ( " """ + name (verfuegbare, k) + """ "
-                                    + anwendungstext (201));
-              menuwindowline;
-
-              print (name (verfuegbare, k));
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (anwendungstext (169));
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE hamsterprogramm drucken
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-            LEAVE hamsterprogramm drucken
-    FI.
-END PROC hamsterprogramm drucken;
-PROC hamsterlandschaft kopieren:
-  ermittle alten flaechennamen;
-  erfrage neuen flaechennamen;
-  kopiere ggf die flaeche.
-  ermittle alten flaechennamen:
-    IF NOT not empty (bestand)
-       THEN noch keine flaeche;
-            LEAVE hamsterlandschaft kopieren
-
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);
-    IF alter name = niltext
-       THEN LEAVE hamsterlandschaft kopieren
-    FI.
-  bestand:
-    ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
-  text1:
-    IF ist hamster THEN anwendungstext (111) ELSE anwendungstext (141) FI.
-  text2:
-    IF ist hamster THEN anwendungstext (112) ELSE anwendungstext (142) FI.
-  erfrage neuen flaechennamen:
-
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
-  ueberschrift:
-    IF ist hamster
-       THEN center (maxlaenge, invers (anwendungstext (111))) + ""13""13""
-       ELSE center (maxlaenge, invers (anwendungstext (141))) + ""13""13""
-    FI.
-  hinweis auf alt:
-    IF ist hamster THEN anwendungstext (113) ELSE anwendungstext (143) FI.
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-
-  aufforderung:
-    anwendungstext (202).
-  kopiere ggf die flaeche:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (anwendungstext (192)));
-              LEAVE hamsterlandschaft kopieren
-    ELIF exists (praefix + neuer name)
-         THEN mache vorwurf;
-              LEAVE hamsterlandschaft kopieren
-       ELSE copy (praefix + alter name, praefix + neuer name)
-    FI.
-  mache vorwurf:
-    IF ist hamster
-       THEN menuinfo (anwendungstext (193))
-       ELSE menuinfo (anwendungstext (194))
-
-    FI.
-END PROC hamsterlandschaft kopieren;
-PROC hamsterprogramm kopieren:
-  ermittle alten programmnamen;
-  erfrage neuen programmnamen;
-  kopiere ggf das programm.
-  ermittle alten programmnamen:
-    IF NOT not empty (bestand)
-       THEN noch kein programm;
-            LEAVE hamsterprogramm kopieren
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, anwendungstext (171),
-                                     anwendungstext (172), TRUE);
-
-    IF alter name = niltext
-       THEN LEAVE hamsterprogramm kopieren
-    FI.
-  bestand:
-    ALL myself - infix namen (ALL myself, praefix, flaechentype).
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + anwendungstext (173) + bisheriger name
-                  + anwendungstext (202).
-  ueberschrift:
-    center (maxlaenge, invers (anwendungstext (171))) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-
-  kopiere ggf das programm:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (anwendungstext (192)));
-              LEAVE hamsterprogramm kopieren
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE hamsterprogramm kopieren
-       ELSE copy (alter name, neuer name)
-    FI.
-  mache vorwurf:
-    menuinfo (anwendungstext (195)).
-END PROC hamsterprogramm kopieren;
-PROC hamsterlandschaft umbenennen:
-  ermittle alten flaechennamen;
-  erfrage neuen flaechennamen;
-
-  benenne ggf die flaeche um.
-  ermittle alten flaechennamen:
-    IF NOT not empty (bestand)
-       THEN noch keine flaeche;
-            LEAVE hamsterlandschaft umbenennen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, text1, text2, TRUE);
-    IF alter name = niltext
-       THEN LEAVE hamsterlandschaft umbenennen
-    FI.
-  bestand:
-    ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix).
-  text1:
-    IF ist hamster THEN anwendungstext (114) ELSE anwendungstext (144) FI.
-
-  text2:
-    IF ist hamster THEN anwendungstext (115) ELSE anwendungstext (145) FI.
-  erfrage neuen flaechennamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
-  ueberschrift:
-    IF ist hamster
-       THEN center (maxlaenge, invers (anwendungstext (114))) + ""13""13""
-       ELSE center (maxlaenge, invers (anwendungstext (144))) + ""13""13""
-    FI.
-  hinweis auf alt:
-    IF ist hamster THEN anwendungstext (116) ELSE anwendungstext (146) FI.
-
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  aufforderung:
-    IF ist hamster THEN anwendungstext (117) ELSE anwendungstext (147) FI.
-  benenne ggf die flaeche um:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (anwendungstext (192)));
-              LEAVE hamsterlandschaft umbenennen
-    ELIF exists (praefix + neuer name)
-         THEN mache vorwurf;
-              LEAVE hamsterlandschaft umbenennen
-    ELSE rename (praefix + alter name, praefix + neuer name);
-
-         flaechenname := neuer name
-    FI.
-  mache vorwurf:
-    IF ist hamster
-       THEN menuinfo (anwendungstext (193))
-       ELSE menuinfo (anwendungstext (194))
-    FI.
-END PROC hamsterlandschaft umbenennen;
-PROC hamsterprogramm umbenennen:
-  ermittle alten programmnamen;
-  erfrage neuen programmnamen;
-  benenne ggf das programm um.
-  ermittle alten programmnamen:
-    IF NOT not empty (bestand)
-       THEN noch kein programm;
-            LEAVE hamsterprogramm umbenennen
-       ELSE biete auswahl an
-
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, anwendungstext (174),
-                                     anwendungstext (175), TRUE);
-    IF alter name = niltext
-       THEN LEAVE hamsterprogramm umbenennen
-    FI.
-  bestand:
-    ALL myself - infix namen (ALL myself, praefix, flaechentype).
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + anwendungstext (176) + bisheriger name
-                  + anwendungstext (177).
-
-  ueberschrift:
-    center (maxlaenge, invers (anwendungstext (174))) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  benenne ggf das programm um:
-    IF   neuer name = niltext
-         THEN menuinfo (invers (anwendungstext (192)));
-              LEAVE hamsterprogramm umbenennen
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE hamsterprogramm umbenennen
-       ELSE rename (alter name, neuer name);
-            programmname := neuer name
-
-    FI.
-  mache vorwurf:
-    menuinfo (anwendungstext (195)).
-END PROC hamsterprogramm umbenennen;
-PROC hamsterlandschaft loeschen:
-  lasse flaechen auswaehlen;
-  loesche flaechen;
-  regenerate menuscreen.
-  lasse flaechen auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-    IF NOT not empty (verfuegbare)
-       THEN noch keine flaeche;
-            LEAVE hamsterlandschaft loeschen
-       ELSE biete auswahl an
-
-    FI.
-  biete auswahl an:
-    IF ist hamster
-       THEN verfuegbare := menusome (verfuegbare, anwendungstext (118),
-                                     anwendungstext (119), FALSE)
-       ELSE verfuegbare := menusome (verfuegbare, anwendungstext (148),
-                                     anwendungstext (149), FALSE)
-    FI.
-  loesche flaechen:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (bezeichnung)));
-    menuwindowline (2);
-
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (schlussbemerkung);
-    menuwindowstop.
-  bezeichnung:
-    IF ist hamster THEN anwendungstext (118) ELSE anwendungstext (148) FI.
-  schlussbemerkung:
-    IF ist hamster THEN anwendungstext (120) ELSE anwendungstext (150) FI.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-
-         THEN disable stop;
-              IF menuwindowyes (" """ + name (verfuegbare, k) + """ "
-                                      + anwendungstext (203))
-                 THEN forget (praefix + name (verfuegbare, k), quiet)
-              FI;
-              fehlerbehandlung
-      FI
-    PER;
-    flaechenname := "".
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            IF ist hamster
-               THEN menuwindowout (anwendungstext (109))
-
-               ELSE menuwindowout (anwendungstext (139))
-            FI;
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE hamsterlandschaft loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-            clear error; enable stop;
-
-            LEAVE hamsterlandschaft loeschen
-    FI.
-END PROC hamsterlandschaft loeschen;
-PROC hamsterprogramm loeschen:
-  lasse programme auswaehlen;
-  loesche programme;
-  regenerate menuscreen.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ALL myself - infix namen (ALL myself, praefix, flaechentype);
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE hamsterprogramm loeschen
-       ELSE biete auswahl an
-    FI.
-
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, anwendungstext (178),
-                             anwendungstext (179), FALSE).
-  loesche programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (anwendungstext (178))));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (anwendungstext (180));
-
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              IF menuwindowyes (" """ + name (verfuegbare, k) + """ "
-                                      + anwendungstext (203))
-                 THEN forget (name (verfuegbare, k), quiet)
-              FI;
-              fehlerbehandlung
-      FI
-    PER;
-    programmname := "".
-  steige ggf bei leerem thesaurus aus:
-
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (anwendungstext (169));
-            menuwindowstop;
-            regenerate menuscreen;
-            LEAVE hamsterprogramm loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (invers (errormessage));
-
-            clear error; enable stop;
-            LEAVE hamsterprogramm loeschen
-    FI.
-END PROC hamsterprogramm loeschen;
-PROC hamsterinteraktiv laufen lassen:
-  frage nach neuer flaeche;
-  cursor on;
-  IF ist hamster
-     THEN hamsterinter (flaechenname)
-     ELSE roboterinter (flaechenname)
-  FI;
-  programmname := "PROTOKOLL";
-  cursor off;
-  regenerate menuscreen.
-  frage nach neuer flaeche:
-    IF menuyes (ueberschrift + fragetext, 5)
-       THEN lasse flaeche auswaehlen
-       ELSE weise auf landschaftsgestaltung hin;
-
-            LEAVE hamsterinteraktiv laufen lassen
-    FI.
-  ueberschrift:
-    IF ist hamster
-       THEN center (laenge, invers (anwendungstext (122))) + ""13""13""
-       ELSE center (laenge, invers (anwendungstext (152))) + ""13""13""
-    FI.
-  fragetext:
-    IF ist hamster
-       THEN center (laenge, anwendungstext (123))
-       ELSE center (laenge, anwendungstext (153))
-    FI.
-  laenge:
-    IF ist hamster
-       THEN max (length (anwendungstext (122)),
-                 length (anwendungstext (123))) + 5
-
-       ELSE max (length (anwendungstext (152)),
-                 length (anwendungstext (153))) + 5
-    FI.
-  lasse flaeche auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-    IF ist hamster
-       THEN flaechenname := menuone (verfuegbare, anwendungstext (122),
-                                     anwendungstext (106), FALSE)
-       ELSE flaechenname := menuone (verfuegbare, anwendungstext (152),
-                                     anwendungstext (136), FALSE)
-
-    FI;
-    IF flaechenname = niltext
-       THEN weise auf landschaftsgestaltung hin;
-            regenerate menuscreen;
-            LEAVE hamsterinteraktiv laufen lassen
-    FI.
-  weise auf landschaftsgestaltung hin:
-    WINDOW VAR mfenster := current menuwindow;
-    IF ist hamster
-       THEN boxinfo (mfenster, anwendungstext (124), 5, maxint)
-       ELSE boxinfo (mfenster, anwendungstext (154), 5, maxint)
-    FI.
-END PROC hamsterinteraktiv laufen lassen;
-PROC hamster laufen lassen:
-
-  programmname ermitteln;
-  BOOL VAR namen eingesetzt :: FALSE;
-  untersuche programmdatei auf flaechennamen;
-  page;
-  geschwindigkeit (5);
-  cursor on;
-  lauf (programmname);
-  cursor off;
-  IF namen eingesetzt
-     THEN entferne flaechennamen aus programmdatei
-  FI;
-  regenerate menuscreen.
-  programmname ermitteln:
-    IF programmname <> niltext CAND exists (programmname)
-       THEN frage nach diesem programm
-       ELSE lasse programm auswaehlen
-    FI.
-  frage nach diesem programm:
-
-    IF menuno (ueberschrift + anwendungstext (163) + name + anwendungstext (164), 5)
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    IF ist hamster
-       THEN center (maxlaenge, invers (anwendungstext (125))) + ""13""13""
-       ELSE center (maxlaenge, invers (anwendungstext (155))) + ""13""13""
-    FI.
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare  := ALL myself - infix namen (ALL myself, praefix, flaechentype);
-
-    IF ist hamster
-       THEN programmname := menuone (verfuegbare, anwendungstext (125),
-                                     anwendungstext (166), TRUE)
-       ELSE programmname := menuone (verfuegbare, anwendungstext (155),
-                                     anwendungstext (166), TRUE)
-    FI;
-    IF programmname = niltext
-       THEN LEAVE hamster laufen lassen
-    FI.
-  untersuche programmdatei auf flaechennamen:
-    FILE VAR a :: sequential file (modify, programmname);
-    TEXT VAR zeile;
-
-    to line (a, 1);
-    REP
-      read record (a, zeile);
-      zeile := compress (zeile);
-      IF NOT eof (a) THEN down (a) FI
-    UNTIL zeile <> "" OR eof (a) PER;
-    IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0
-       THEN ermittle flaechennamen;
-            setze flaechennamen in datei ein
-    FI.
-  ermittle flaechennamen:
-    IF flaechenname <> ""
-       THEN frage nach altem flaechennamen
-       ELSE lasse flaeche auswaehlen
-    FI.
-  frage nach altem flaechennamen:
-
-    IF ist hamster
-       THEN frage nach alter landschaft
-       ELSE frage nach altem arbeitsfeld
-    FI.
-  frage nach alter landschaft:
-    IF menuno (ueberschrift + anwendungstext (103)
-                    + fname + anwendungstext (104), 5)
-       THEN lasse flaeche auswaehlen
-    FI.
-  frage nach altem arbeitsfeld:
-    IF menuno (ueberschrift + anwendungstext (133)
-                    + fname + anwendungstext (134), 5)
-       THEN lasse flaeche auswaehlen
-    FI.
-  fname:
-    ""13""13" " + invers (flaechenname) + ""13""13"".
-
-  lasse flaeche auswaehlen:
-    verfuegbare := ohne praefix (infix namen (ALL myself, praefix, flaechentype), praefix);
-    IF ist hamster
-       THEN flaechenname := menuone (verfuegbare, anwendungstext (125),
-                                     anwendungstext (106), FALSE)
-       ELSE flaechenname := menuone (verfuegbare, anwendungstext (155),
-                                     anwendungstext (136), FALSE)
-    FI;
-    IF flaechenname = niltext
-       THEN regenerate menuscreen;
-            landschaftsfehler anzeigen;
-
-            LEAVE hamster laufen lassen
-    FI.
-  landschaftsfehler anzeigen:
-    IF ist hamster
-       THEN menuinfo (anwendungstext (124))
-       ELSE menuinfo (anwendungstext (154))
-    FI.
-  setze flaechennamen in datei ein:
-    to line (a, 1);
-    zeile := "landschaft (""" + flaechenname + """);";
-    insert record (a);
-    write record (a, zeile);
-    namen eingesetzt := TRUE.
-  entferne flaechennamen aus programmdatei:
-    FILE VAR b :: sequential file (modify, programmname);
-
-    to line (b, 1);
-    REP
-      read record (b, zeile);
-      IF pos (zeile, "landschaft") = 0 AND pos (zeile, "arbeitsfeld") = 0
-         THEN IF NOT eof (b) THEN down (b) FI
-      FI
-    UNTIL zeile <> "" OR eof (b) PER;
-    IF pos (zeile, "landschaft") > 0 OR pos (zeile, "arbeitsfeld") > 0
-       THEN delete record (b)
-    FI
-END PROC hamster laufen lassen;
-PROC meckere zu langen namen an:
-  menuinfo (anwendungstext (191))
-END PROC meckere zu langen namen an;
-PROC meckere existierende flaeche an:
-
-  IF ist hamster
-     THEN menuinfo (anwendungstext (193))
-     ELSE menuinfo (anwendungstext (194))
-  FI
-END PROC meckere existierende flaeche an;
-PROC meckere existierendes programm an:
-  menuinfo (anwendungstext (195))
-END PROC meckere existierendes programm an;
-PROC noch keine flaeche:
-  IF ist hamster
-     THEN menuinfo (anwendungstext (196))
-     ELSE menuinfo (anwendungstext (197))
-  FI
-END PROC noch keine flaeche;
-PROC noch kein programm:
-  menuinfo (anwendungstext (198))
-
-END PROC noch kein programm;
-END PACKET ls herbert und robbi 3;
-
-
diff --git a/hamster/ls-Herbert und Robbi-gen b/hamster/ls-Herbert und Robbi-gen
deleted file mode 100644
index 6104fe3..0000000
--- a/hamster/ls-Herbert und Robbi-gen
+++ /dev/null
@@ -1,142 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                 ls-Herbert und Robbi                ** 
-          **                  GENERATORPROGRAMM                  ** 
-          **                     Version 1.1                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                          *) 
- 
-LET mm taskname = "ls-MENUKARTEN",
-    datei1      = "ls-Herbert und Robbi 1",
-    datei2      = "ls-Herbert und Robbi 2",
-    datei3      = "ls-Herbert und Robbi 3",
-    menukarte   = "ls-MENUKARTE:Herbert und Robbi";
-PROC stelle existenz des mm sicher:
-  cursor (1, 5); out (""4"");
-  IF NOT exists (task (mm taskname))
-     THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!");
-  FI
-END PROC stelle existenz des mm sicher;
-PROC vom archiv (TEXT CONST datei):
-  cursor (1,5); out (""4"");
-
-  out ("  """); out (datei); putline (""" wird geholt.");
-  fetch (datei, archive)
-END PROC vom archiv;
-PROC hole (TEXT CONST datei):
-  IF NOT exists (datei) THEN vom archiv (datei) FI
-END PROC hole;
-PROC in (TEXT CONST datei):
-  hole (datei);
-  cursor (1, 5); out (""4"");
-  out ("  """); out (datei); out (""" wird übersetzt: ");
-  insert (datei);
-  forget (datei, quiet);
-END PROC in;
-PROC schicke (TEXT CONST datei):
-  cursor (1, 5); out (""4"");
-  out ("  """); out(datei);
-  out (""" wird zum MENUKARTEN-MANAGER geschickt!");
-
-  command dialogue (FALSE);
-  save (datei, task (mm taskname));
-  command dialogue (TRUE);
-  forget (datei, quiet)
-END PROC schicke;
-INT VAR size, used;
-BOOL VAR einzeln, mit erweiterung :: FALSE;
-storage (size, used);
-einzeln := size - used < 500;
-forget ("ls-Herbert und Robbi/gen", quiet);
-wirf kopfzeile aus;
-stelle existenz des mm sicher;
-hole die dateien;
-insertiere die dateien;
-mache global manager aus der task.
-wirf kopfzeile aus:
-  page;
-  putline ("              "15"ls-Herbert und Robbi - Automatische Generierung "14"");
-
-  line (2);
-  putline ("  Bitte beantworten Sie noch die folgende Frage:");
-  line;
-  put("  Sollen neben den 'Standardtests' auch die folgenden 'Tests':");
-  line (2);
-  putline("          Für den Hamster:                   Für den Roboter:");
-  putline("           links frei                         links frei");
-  putline("           rechts frei                        rechts frei");
-  putline("           hinten frei                        hinten frei");
-  putline("           korn vorn                          werkstueck vorn");
-
-  putline("           korn links                         werkstueck links");
-  putline("           korn rechts                        werkstueck rechts");
-  putline("           korn hinten                        werkstueck hinten");
-  line;
-  IF yes("  zur Verfügung gestellt werden")
-     THEN mit erweiterung := TRUE
-  FI.
-hole die dateien:
-  IF     NOT exists (datei 1)
-     COR NOT exists (datei 3)
-     COR NOT exists (menukarte)
-     THEN hole dateien vom archiv; LEAVE hole die dateien
-
-  FI;
-  IF mit erweiterung AND NOT exists (datei 2)
-     THEN hole dateien vom archiv
-  FI.
-hole dateien vom archiv:
-  cursor (1,3); out (""4"");
-  IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt")
-     THEN lese ein
-     ELSE line (2);
-          errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
-  FI.
-lese ein:
-  cursor (1, 3); out (""4"");
-  out ("                   "15"Bitte die Diskette eingelegt lassen! "14"");
-  IF NOT einzeln
-     THEN  hole (datei 1);
-
-           hole (datei 3);
-           hole (menukarte);
-           IF mit erweiterung
-              THEN hole (datei 2)
-           FI;
-           cursor (1, 3); out(""4"");
-           out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");
-           release (archive)
-  FI.
-insertiere die dateien:
-  check off;
-  cursor (1, 3); out(""4"");
-  out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");
-  in (datei 1);
-  IF mit erweiterung
-     THEN in (datei 2)
-
-  FI;
-  in (datei 3);
-  schicke (menukarte);
-  IF einzeln THEN release (archive) FI;
-  check on.
-mache global manager aus der task:
-  global manager.
-
-
diff --git a/doc/basic/basic handbuch.1 b/lang/basic/1.8.7/doc/basic handbuch.1
index 2e604cb..2e604cb 100644
--- a/doc/basic/basic handbuch.1
+++ b/lang/basic/1.8.7/doc/basic handbuch.1
diff --git a/doc/basic/basic handbuch.2 b/lang/basic/1.8.7/doc/basic handbuch.2
index 1379e9e..1379e9e 100644
--- a/doc/basic/basic handbuch.2
+++ b/lang/basic/1.8.7/doc/basic handbuch.2
diff --git a/doc/basic/basic handbuch.3 b/lang/basic/1.8.7/doc/basic handbuch.3
index 14cb499..14cb499 100644
--- a/doc/basic/basic handbuch.3
+++ b/lang/basic/1.8.7/doc/basic handbuch.3
diff --git a/doc/basic/basic handbuch.index b/lang/basic/1.8.7/doc/basic handbuch.index
index 4ac7e16..4ac7e16 100644
--- a/doc/basic/basic handbuch.index
+++ b/lang/basic/1.8.7/doc/basic handbuch.index
diff --git a/lang/basic/1.8.7/source-disk b/lang/basic/1.8.7/source-disk
new file mode 100644
index 0000000..c87f56d
--- /dev/null
+++ b/lang/basic/1.8.7/source-disk
@@ -0,0 +1 @@
+informatikpaket/02_basic.img
diff --git a/basic/BASIC.Administration b/lang/basic/1.8.7/src/BASIC.Administration
index 6df6854..6df6854 100644
--- a/basic/BASIC.Administration
+++ b/lang/basic/1.8.7/src/BASIC.Administration
diff --git a/basic/BASIC.Compiler b/lang/basic/1.8.7/src/BASIC.Compiler
index d4e4c21..d4e4c21 100644
--- a/basic/BASIC.Compiler
+++ b/lang/basic/1.8.7/src/BASIC.Compiler
diff --git a/basic/BASIC.Runtime b/lang/basic/1.8.7/src/BASIC.Runtime
index 854002a..854002a 100644
--- a/basic/BASIC.Runtime
+++ b/lang/basic/1.8.7/src/BASIC.Runtime
diff --git a/lang/basic/1.8.7/src/eumel coder 1.8.1 b/lang/basic/1.8.7/src/eumel coder 1.8.1
new file mode 120000
index 0000000..5fead18
--- /dev/null
+++ b/lang/basic/1.8.7/src/eumel coder 1.8.1
@@ -0,0 +1 @@
+../../../../system/eumel-coder/1.8.1/src/eumel coder 1.8.1
\ No newline at end of file
diff --git a/basic/eumel0 codes b/lang/basic/1.8.7/src/eumel0 codes
index 226014c..226014c 100644
--- a/basic/eumel0 codes
+++ b/lang/basic/1.8.7/src/eumel0 codes
diff --git a/basic/gen.BASIC b/lang/basic/1.8.7/src/gen.BASIC
index 9690ae6..9690ae6 100644
--- a/basic/gen.BASIC
+++ b/lang/basic/1.8.7/src/gen.BASIC
diff --git a/doc/dynamo/dynamo handbuch b/lang/dynamo/1.8.7/doc/dynamo handbuch
index 4012973..4012973 100644
--- a/doc/dynamo/dynamo handbuch
+++ b/lang/dynamo/1.8.7/doc/dynamo handbuch
diff --git a/doc/dynamo/dynamo handbuch.index b/lang/dynamo/1.8.7/doc/dynamo handbuch.index
index af77d79..af77d79 100644
--- a/doc/dynamo/dynamo handbuch.index
+++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.index
diff --git a/doc/dynamo/dynamo handbuch.inhalt b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt
index 2d1b1f3..2d1b1f3 100644
--- a/doc/dynamo/dynamo handbuch.inhalt
+++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt
diff --git a/lang/dynamo/1.8.7/source-disk b/lang/dynamo/1.8.7/source-disk
new file mode 100644
index 0000000..e61107d
--- /dev/null
+++ b/lang/dynamo/1.8.7/source-disk
@@ -0,0 +1 @@
+informatikpaket/01_sprachen.img
diff --git a/lang/dynamo/1.8.7/src/"15"TAB1"14" b/lang/dynamo/1.8.7/src/"15"TAB1"14"
new file mode 100644
index 0000000..ce88e03
--- /dev/null
+++ b/lang/dynamo/1.8.7/src/"15"TAB1"14"
diff --git a/dynamo/dyn.33 b/lang/dynamo/1.8.7/src/dyn.33
index a17bd55..a17bd55 100644
--- a/dynamo/dyn.33
+++ b/lang/dynamo/1.8.7/src/dyn.33
diff --git a/dynamo/dyn.abnahme b/lang/dynamo/1.8.7/src/dyn.abnahme
index e8c100d..e8c100d 100644
--- a/dynamo/dyn.abnahme
+++ b/lang/dynamo/1.8.7/src/dyn.abnahme
diff --git a/dynamo/dyn.bev b/lang/dynamo/1.8.7/src/dyn.bev
index 5b759d3..5b759d3 100644
--- a/dynamo/dyn.bev
+++ b/lang/dynamo/1.8.7/src/dyn.bev
diff --git a/dynamo/dyn.cob b/lang/dynamo/1.8.7/src/dyn.cob
index eabb1b8..eabb1b8 100644
--- a/dynamo/dyn.cob
+++ b/lang/dynamo/1.8.7/src/dyn.cob
diff --git a/lang/dynamo/1.8.7/src/dyn.const b/lang/dynamo/1.8.7/src/dyn.const
new file mode 100644
index 0000000..c42ad1c
--- /dev/null
+++ b/lang/dynamo/1.8.7/src/dyn.const
diff --git a/dynamo/dyn.delaytest b/lang/dynamo/1.8.7/src/dyn.delaytest
index c475433..c475433 100644
--- a/dynamo/dyn.delaytest
+++ b/lang/dynamo/1.8.7/src/dyn.delaytest
diff --git a/dynamo/dyn.errors b/lang/dynamo/1.8.7/src/dyn.errors
index 64a4f27..64a4f27 100644
--- a/dynamo/dyn.errors
+++ b/lang/dynamo/1.8.7/src/dyn.errors
diff --git a/dynamo/dyn.forest b/lang/dynamo/1.8.7/src/dyn.forest
index 5075925..5075925 100644
--- a/dynamo/dyn.forest
+++ b/lang/dynamo/1.8.7/src/dyn.forest
diff --git a/dynamo/dyn.forst7 b/lang/dynamo/1.8.7/src/dyn.forst7
index d767a50..d767a50 100644
--- a/dynamo/dyn.forst7
+++ b/lang/dynamo/1.8.7/src/dyn.forst7
diff --git a/dynamo/dyn.gekoppeltependel b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel
index 3f2a961..3f2a961 100644
--- a/dynamo/dyn.gekoppeltependel
+++ b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel
diff --git a/dynamo/dyn.grashasenfuchs b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs
index 046a1e1..046a1e1 100644
--- a/dynamo/dyn.grashasenfuchs
+++ b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs
diff --git a/dynamo/dyn.help b/lang/dynamo/1.8.7/src/dyn.help
index e4f82c0..e4f82c0 100644
--- a/dynamo/dyn.help
+++ b/lang/dynamo/1.8.7/src/dyn.help
diff --git a/dynamo/dyn.inserter b/lang/dynamo/1.8.7/src/dyn.inserter
index 4b0b9d5..4b0b9d5 100644
--- a/dynamo/dyn.inserter
+++ b/lang/dynamo/1.8.7/src/dyn.inserter
diff --git a/dynamo/dyn.mac b/lang/dynamo/1.8.7/src/dyn.mac
index 03a0f9f..03a0f9f 100644
--- a/dynamo/dyn.mac
+++ b/lang/dynamo/1.8.7/src/dyn.mac
diff --git a/dynamo/dyn.mehreredelays b/lang/dynamo/1.8.7/src/dyn.mehreredelays
index 6eac8fe..6eac8fe 100644
--- a/dynamo/dyn.mehreredelays
+++ b/lang/dynamo/1.8.7/src/dyn.mehreredelays
diff --git a/dynamo/dyn.natchez b/lang/dynamo/1.8.7/src/dyn.natchez
index e62c70d..e62c70d 100644
--- a/dynamo/dyn.natchez
+++ b/lang/dynamo/1.8.7/src/dyn.natchez
diff --git a/dynamo/dyn.oszillator b/lang/dynamo/1.8.7/src/dyn.oszillator
index 3f1e815..3f1e815 100644
--- a/dynamo/dyn.oszillator
+++ b/lang/dynamo/1.8.7/src/dyn.oszillator
diff --git a/dynamo/dyn.plot b/lang/dynamo/1.8.7/src/dyn.plot
index fe1228a..fe1228a 100644
--- a/dynamo/dyn.plot
+++ b/lang/dynamo/1.8.7/src/dyn.plot
diff --git a/dynamo/dyn.plot+ b/lang/dynamo/1.8.7/src/dyn.plot+
index db04dfc..db04dfc 100644
--- a/dynamo/dyn.plot+
+++ b/lang/dynamo/1.8.7/src/dyn.plot+
diff --git a/dynamo/dyn.print b/lang/dynamo/1.8.7/src/dyn.print
index 36ea279..36ea279 100644
--- a/dynamo/dyn.print
+++ b/lang/dynamo/1.8.7/src/dyn.print
diff --git a/dynamo/dyn.proc b/lang/dynamo/1.8.7/src/dyn.proc
index a291a48..a291a48 100644
--- a/dynamo/dyn.proc
+++ b/lang/dynamo/1.8.7/src/dyn.proc
diff --git a/dynamo/dyn.quadrat b/lang/dynamo/1.8.7/src/dyn.quadrat
index fdd553a..fdd553a 100644
--- a/dynamo/dyn.quadrat
+++ b/lang/dynamo/1.8.7/src/dyn.quadrat
diff --git a/dynamo/dyn.rts b/lang/dynamo/1.8.7/src/dyn.rts
index c46684a..c46684a 100644
--- a/dynamo/dyn.rts
+++ b/lang/dynamo/1.8.7/src/dyn.rts
diff --git a/dynamo/dyn.ruestungswettlauf b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf
index 7b7c6b1..7b7c6b1 100644
--- a/dynamo/dyn.ruestungswettlauf
+++ b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf
diff --git a/dynamo/dyn.simon b/lang/dynamo/1.8.7/src/dyn.simon
index b911159..b911159 100644
--- a/dynamo/dyn.simon
+++ b/lang/dynamo/1.8.7/src/dyn.simon
diff --git a/dynamo/dyn.std b/lang/dynamo/1.8.7/src/dyn.std
index a87b66d..a87b66d 100644
--- a/dynamo/dyn.std
+++ b/lang/dynamo/1.8.7/src/dyn.std
diff --git a/dynamo/dyn.steifedgl b/lang/dynamo/1.8.7/src/dyn.steifedgl
index b168fcd..b168fcd 100644
--- a/dynamo/dyn.steifedgl
+++ b/lang/dynamo/1.8.7/src/dyn.steifedgl
diff --git a/dynamo/dyn.tool b/lang/dynamo/1.8.7/src/dyn.tool
index 65769d8..65769d8 100644
--- a/dynamo/dyn.tool
+++ b/lang/dynamo/1.8.7/src/dyn.tool
diff --git a/dynamo/dyn.vec b/lang/dynamo/1.8.7/src/dyn.vec
index 0554215..0554215 100644
--- a/dynamo/dyn.vec
+++ b/lang/dynamo/1.8.7/src/dyn.vec
diff --git a/dynamo/dyn.wachstum b/lang/dynamo/1.8.7/src/dyn.wachstum
index 9f97bb9..9f97bb9 100644
--- a/dynamo/dyn.wachstum
+++ b/lang/dynamo/1.8.7/src/dyn.wachstum
diff --git a/dynamo/dyn.wasseröko b/lang/dynamo/1.8.7/src/dyn.wasseröko
index fe05881..fe05881 100644
--- a/dynamo/dyn.wasseröko
+++ b/lang/dynamo/1.8.7/src/dyn.wasseröko
diff --git a/dynamo/dyn.welt-forrester b/lang/dynamo/1.8.7/src/dyn.welt-forrester
index c3f9789..c3f9789 100644
--- a/dynamo/dyn.welt-forrester
+++ b/lang/dynamo/1.8.7/src/dyn.welt-forrester
diff --git a/dynamo/dyn.wohnen b/lang/dynamo/1.8.7/src/dyn.wohnen
index 4e9b8b4..4e9b8b4 100644
--- a/dynamo/dyn.wohnen
+++ b/lang/dynamo/1.8.7/src/dyn.wohnen
diff --git a/dynamo/dyn.workfluc b/lang/dynamo/1.8.7/src/dyn.workfluc
index 8016449..8016449 100644
--- a/dynamo/dyn.workfluc
+++ b/lang/dynamo/1.8.7/src/dyn.workfluc
diff --git a/dynamo/dyn.wurzel b/lang/dynamo/1.8.7/src/dyn.wurzel
index 7f8e6e0..7f8e6e0 100644
--- a/dynamo/dyn.wurzel
+++ b/lang/dynamo/1.8.7/src/dyn.wurzel
diff --git a/dynamo/out.world b/lang/dynamo/1.8.7/src/out.world
index 39859ce..39859ce 100644
--- a/dynamo/out.world
+++ b/lang/dynamo/1.8.7/src/out.world
diff --git a/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const
new file mode 100644
index 0000000..d38858b
--- /dev/null
+++ b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const
diff --git a/lang/dynamo/1.8.7/src/stabileruestung.const b/lang/dynamo/1.8.7/src/stabileruestung.const
new file mode 100644
index 0000000..9d64330
--- /dev/null
+++ b/lang/dynamo/1.8.7/src/stabileruestung.const
diff --git a/lang/lisp/1.7.2/src/lisp.1 b/lang/lisp/1.7.2/src/lisp.1
new file mode 100644
index 0000000..0d3857f
--- /dev/null
+++ b/lang/lisp/1.7.2/src/lisp.1
@@ -0,0 +1,1305 @@
+PACKET lisp heap and oblist management              (* Autor: J.Durchholz *) 

+                                                    (* Datum: 09.05.1984  *) 

+    DEFINES                                         (* Version 1.7.2      *) 

+                                                    (* hey 25.2.83 *) 

+  initialize lisp system, 

+  dump lisp heap, 

+  lisp storage, 

+  collect lisp heap garbage, 

+  SYM, 

+  :=, 

+  nil, 

+  pname, 

+  head, 

+  set head, 

+  tail, 

+  set tail, 

+  cons, 

+  eq, 

+  equal, 

+  null, 

+  atom, 

+  is named atom, 

+  begin oblist dump, 

+  next atom, 

+  new atom, 

+  create atom, 

+  delete atom, 

+  begin property list dump, 

+  next property, 

+  add property, 

+  alter property, 

+  property, 

+  delete property, 

+  property exists, 

+  add flag, 

+  flag, 

+  delete flag, 

+  text, 

+  is text, 

+  character, 

+  is character, 

+  sym character, 

+  int 1, 

+  int 2, 

+  is int pair, 

+  sym: 

+ 

+ 

+(* NOTE: All internal routines are prefixed by x *) 

+ 

+ 

+(***************************** heap management ****************************) 

+ 

+LET 

+    max size = 32767, 

+    NODE = STRUCT (INT status, 

+                       head, tail); 

+LET HEAP = STRUCT (INT size, 

+                   ROW max size NODE node); 

+ 

+ 

+BOUND HEAP VAR heap; 

+ 

+ 

+PROC initialize lisp system (DATASPACE CONST ds): 

+  IF type (ds) < 0 THEN 

+    heap := ds; 

+    x initialize oblist and heap size; 

+    create atom ("NIL"); 

+    create atom ("PNAME"); 

+  ELSE 

+    heap := ds 

+  FI 

+END PROC initialize lisp system; 

+ 

+ 

+PROC dump lisp heap (FILE VAR f): 

+  put line (f, "Groesse :" + text (CONCR (heap).size)); 

+  line (f); 

+  put (CONCR (heap).size); 

+  BOOL VAR is char := FALSE; 

+  INT VAR i; 

+  FOR i FROM 1 UPTO CONCR (heap).size REP 

+    cout (i); 

+    dump ith node 

+  PER. 

+ 

+dump ith node: 

+  put (f, text (i, 6)); 

+  put (f, status); 

+  put (f, head); 

+  put (f, tail); 

+  line (f). 

+ 

+status: 

+  SELECT ith node.status OF 

+    CASE atomic             : "ATOMIC............" 

+    CASE non atomic         : "NON ATOMIC........" 

+    CASE oblist bone        : "OBLIST BONE......." 

+    CASE property indicator : "PROPERTY INDICATOR" 

+    CASE property root      : "PROPERTY ROOT....." 

+    CASE flag indicator     : "FLAG INDICATOR...." 

+    CASE text data          : "TEXT DATA........." 

+    CASE character data     : is char := TRUE; "CHARACTER DATA...." 

+    CASE int data           : "INT DATA.........." 

+    OTHERWISE                 "????." + text (ith node.status, 6) + ".????" 

+  END SELECT. 

+ 

+head: 

+  maybe a code + text (ith node.head, 6). 

+ 

+maybe a code: 

+  IF is char THEN 

+    is char := FALSE; 

+    IF ith node.head > 31 AND 128 > ith node.head THEN 

+      " " + code (ith node.head) + " " 

+    ELSE 

+      "   " 

+    FI 

+  ELSE 

+    "   " 

+  FI. 

+ 

+tail: 

+  text (ith node.tail, 6). 

+ 

+ith node: 

+  CONCR (heap).node (i). 

+ 

+END PROC dump lisp heap; 

+ 

+ 

+PROC lisp storage (INT VAR size, used): 

+  size := max size; 

+  used := CONCR (heap).size 

+END PROC lisp storage; 

+ 

+ 

+PROC collect lisp heap garbage: 

+  mark all used nodes; 

+  transfer all used high address nodes to unused low address nodes; 

+  adjust all pointers to cleared high address area and unmark all nodes; 

+  adjust size. 

+ 

+mark all used nodes: 

+  INT VAR i; 

+  FOR i FROM 2 UPTO 28 REP 

+    x mark (i) 

+  PER. 

+ 

+transfer all used high address nodes to unused low address nodes: 

+  INT VAR high address :: CONCR (heap).size + 1, 

+          low address :: 0; 

+  REP 

+    find next lower used high address node; 

+    IF no used high address node found THEN 

+      LEAVE transfer all used high address nodes to unused low address nodes 

+    FI; 

+    find next higher unused low address node; 

+    IF no unused low address node found THEN 

+      LEAVE transfer all used high address nodes to unused low address nodes 

+    FI; 

+    transfer high address node to low address node 

+  PER. 

+ 

+find next lower used high address node: 

+  REP 

+    high address DECR 1 

+  UNTIL high address node marked PER. 

+ 

+high address node marked: 

+  high address node.status < 0. 

+ 

+no used high address node found: 

+  low address = high address. 

+ 

+find next higher unused low address node: 

+  REP 

+    low address INCR 1 

+  UNTIL low address node not marked OR low address = high address PER. 

+ 

+low address node not marked: 

+  low address node.status > 0. 

+ 

+no unused low address node found : 

+  low address = high address. 

+ 

+transfer high address node to low address node: 

+  low address node.status := high address node.status; 

+  low address node.head := high address node.head; 

+  low address node.tail := high address node.tail; 

+  high address node.head := low address. 

+ 

+adjust all pointers to cleared high address area and unmark all nodes: 

+  (* 'high address' should now point to the last node of the used area   *) 

+  FOR low address FROM 1 UPTO high address REP 

+    unmark low address node; 

+    SELECT low address node.status OF 

+      CASE oblist bone: adjust head

+      CASE atomic, 

+           non atomic, 

+           property indicator, 

+           property root, 

+           flag indicator: adjust head; adjust tail 

+      CASE text data, character data: adjust tail 

+      CASE int data: 

+      OTHERWISE x lisp error ("Status " + text (low address node.status) + 

+                              " gefunden bei pointer Justage") 

+    END SELECT 

+  PER. 

+ 

+unmark low address node: 

+  low address node.status := - low address node.status. 

+ 

+adjust head: 

+  IF low address node.head > high address THEN 

+    low address node.head := node (low address node.head).head 

+  FI. 

+ 

+adjust tail: 

+  IF low address node.tail > high address THEN 

+    low address node.tail := node (low address node.tail).head 

+  FI. 

+ 

+adjust size: 

+  CONCR (heap).size := high address. 

+ 

+low address node: 

+  node (low address). 

+ 

+high address node: 

+  node (high address). 

+ 

+node: 

+  CONCR (heap).node. 

+ 

+END PROC collect lisp heap garbage; 

+ 

+ 

+PROC x mark (INT CONST ptr): 

+  IF node not yet marked THEN 

+    mark node; 

+    SELECT - ptr node.status OF 

+      CASE oblist bone: x mark (ptr node.head) 

+      CASE atomic, 

+           non atomic, 

+           property indicator, 

+           property root, 

+           flag indicator: x mark (ptr node.head); x mark (ptr node.tail) 

+      CASE text data, character data: x mark (ptr node.tail) 

+      CASE int data: 

+      OTHERWISE error stop ("Status " + text (- ptr node.status) + 

+                            " gefunden beim Markieren") 

+    END SELECT 

+  FI. 

+ 

+ 

+node not yet marked: 

+  ptr node.status > 0. 

+ 

+mark node: 

+  ptr node.status := - ptr node.status. 

+ 

+ptr node: 

+  CONCR (heap).node (ptr) 

+ 

+END PROC x mark; 

+ 

+ 

+TYPE SYM = INT; 

+ 

+ 

+OP := (SYM VAR left, SYM CONST right): 

+  CONCR (left) := CONCR (right) 

+END OP :=; 

+ 

+ 

+LET atomic = 1, 

+    non atomic = 2, 

+    oblist bone = 3, 

+    property indicator = 4, 

+    property root = 5, 

+    flag indicator = 6, 

+    text data = 7, 

+    character data = 8, 

+    int data = 9; 

+ 

+SYM CONST nil :: SYM :(35),   (* 'x initialize oblist and heap size' will *) 

+          pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME  *) 

+                              (* at node 44                               *) 

+ 

+ 

+(***************************** basic functions ****************************) 

+ 

+ 

+SYM PROC head (SYM CONST sym): 

+  SELECT status of sym OF 

+    CASE atomic: error stop ("Atome haben keinen head"); nil 

+    CASE non atomic: SYM :(head of sym) 

+    CASE oblist bone, 

+         property indicator, 

+         property root, 

+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 

+                                         text (status of sym)); 

+                             nil 

+    CASE text data, 

+         character data, 

+         int data       : error stop ("Daten haben keinen head"); nil 

+    OTHERWISE x lisp error ("Illegaler Status " + text (status of sym));

+              nil 

+  END SELECT. 

+ 

+status of sym: 

+  sym node.status. 

+ 

+head of sym: 

+  sym node.head. 

+ 

+sym node: 

+  CONCR (heap).node (CONCR (sym)) 

+ 

+END PROC head; 

+ 

+ 

+SYM PROC x head (SYM CONST sym): 

+  SYM :(CONCR (heap).node (CONCR (sym)).head) 

+END PROC x head; 

+ 

+ 

+PROC set head (SYM CONST sym, new head): 

+  SELECT status of sym OF 

+    CASE atomic: errorstop ("Atome haben keinen head") 

+    CASE non atomic: head of sym := CONCR (new head) 

+    CASE oblist bone, 

+         property indicator, 

+         property root, 

+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 

+                                         text (status of sym)) 

+    CASE text data, 

+         character data, 

+         int data        : error stop ("Daten haben keinen head") 

+    OTHERWISE x lisp error ("Illegaler Status " + text (status of sym))

+  END SELECT. 

+ 

+status of sym: 

+  sym node.status. 

+ 

+head of sym: 

+  sym node.head. 

+ 

+sym node: 

+  CONCR (heap).node (CONCR (sym)). 

+ 

+END PROC set head; 

+ 

+ 

+PROC x set head (SYM CONST sym, new head): 

+  CONCR (heap).node (CONCR (sym)).head := CONCR (new head) 

+END PROC x set head; 

+ 

+ 

+SYM PROC tail (SYM CONST sym): 

+  SELECT status of sym OF 

+    CASE atomic: error stop ("Atome haben keinen tail"); nil 

+    CASE non atomic: SYM :(tail of sym) 

+    CASE oblist bone, 

+         property indicator, 

+         flag indicator    : x lisp error ("Versteckter Knoten:" + 

+                                         text (status of sym)); 

+                             nil 

+    CASE text data, 

+         character data, 

+         int data        : error stop ("Daten haben keinen tail"); nil 

+    OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym)); 

+              nil 

+  END SELECT. 

+ 

+status of sym: 

+  sym node.status. 

+ 

+tail of sym: 

+  sym node.tail. 

+ 

+sym node: 

+  CONCR (heap).node (CONCR (sym)). 

+ 

+END PROC tail; 

+ 

+ 

+SYM PROC x tail (SYM CONST sym): 

+  SYM :(CONCR (heap).node (CONCR (sym)).tail) 

+END PROC x tail; 

+ 

+ 

+PROC set tail (SYM CONST sym, new tail): 

+  SELECT status of sym OF 

+    CASE atomic: error stop ("Atome haben keinen tail") 

+    CASE non atomic: tail of sym := CONCR (new tail) 

+    CASE oblist bone, 

+         property indicator, 

+         property root, 

+         flag indicator    : x lisp error ("Versteckter Knoten, Type: " + 

+                                         text (status of sym)) 

+    CASE text data, 

+         character data, 

+         int data       : error stop ("Daten tails sind unveraenderbar")

+    OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym)) 

+  END SELECT. 

+ 

+status of sym: 

+  sym node.status. 

+ 

+tail of sym: 

+  sym node.tail. 

+ 

+sym node: 

+  CONCR (heap).node (CONCR (sym)). 

+ 

+END PROC set tail; 

+ 

+ 

+PROC x set tail (SYM CONST sym, new tail): 

+  CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail) 

+END PROC x set tail; 

+ 

+ 

+SYM PROC cons (SYM CONST head, tail): 

+  SYM VAR result; 

+  search free node; 

+  result node.status := non atomic; 

+  result node.head := CONCR (head); 

+  result node.tail := CONCR (tail); 

+  result. 

+ 

+search free node: 

+  IF CONCR (heap).size = max size THEN 

+    error stop ("LISP Heap Ueberlauf"); 

+    LEAVE cons WITH nil 

+  ELSE 

+    CONCR (heap).size INCR 1; 

+    CONCR (result) := CONCR (heap).size; cout(CONCR(result))

+  FI. 

+ 

+result node: 

+  CONCR (heap).node (CONCR (result)). 

+ 

+END PROC cons; 

+ 

+ 

+BOOL PROC eq (SYM CONST sym 1, sym 2): 

+  CONCR (sym 1) = CONCR (sym 2) 

+END PROC eq; 

+ 

+ 

+BOOL PROC equal (SYM CONST sym 1, sym 2): 

+  eq (sym 1, sym 2) COR have same value. 

+ 

+have same value: 

+  IF sym 1 node.status <> sym 2 node.status THEN 

+    FALSE 

+  ELSE 

+    SELECT sym 1 node.status OF 

+      CASE atomic: FALSE 

+      CASE non atomic: equal (head (sym 1), head (sym 2)) CAND 

+                       equal (tail (sym 1), tail (sym 2)) 

+      CASE oblist bone, 

+           property indicator, 

+           property root, 

+           flag indicator: x lisp error ("Versteckter Knoten, Type: " + 

+                                         text (x status (sym 1))); FALSE 

+      CASE text data: equal texts 

+      CASE character data: sym 1 node.head = sym 2 node.head 

+      CASE int data: sym 1 node.head = sym 2 node.head AND 

+                     sym 1 node.tail = sym 2 node.tail 

+      OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1)));

+                              FALSE 

+    END SELECT 

+  FI. 

+ 

+equal texts: 

+  equal length CAND equal character sequence. 

+ 

+equal length: 

+  eq (x head (sym 1), x head (sym 2)). 

+ 

+equal character sequence: 

+  SYM VAR actual sym 1 character :: sym 1, 

+          actual sym 2 character :: sym 2; 

+  INT VAR i; 

+  FOR i FROM 1 UPTO sym 1 node. head REP 

+    actual sym 1 character := x tail (actual sym 1 character); 

+    actual sym 2 character := x tail (actual sym 2 character); 

+    IF eq (actual sym 1 character, actual sym 2 character) THEN 

+      LEAVE equal character sequence WITH TRUE 

+    FI; 

+    IF x status (actual sym 1 character) <> character data OR 

+       x status (actual sym 2 character) <> character data    THEN 

+      x lisp error ("Ungueltiges Zeichen im text"); 

+      LEAVE equal character sequence WITH FALSE 

+    FI; 

+    IF CONCR (x head (actual sym 1 character)) <> 

+       CONCR (x head (actual sym 2 character))    THEN 

+      LEAVE equal character sequence WITH FALSE 

+    FI 

+  PER; 

+  TRUE. 

+ 

+sym 1 node: 

+  CONCR (heap).node (CONCR (sym 1)). 

+ 

+sym 2 node: 

+  CONCR (heap).node (CONCR (sym 2)). 

+ 

+END PROC equal; 

+ 

+ 

+BOOL PROC null (SYM CONST sym): 

+  CONCR (sym) = CONCR (nil) 

+END PROC null; 

+ 

+ 

+BOOL PROC atom (SYM CONST sym): 

+  SELECT x status (sym) OF 

+    CASE atomic, 

+         text data, 

+         character data, 

+         int data:       TRUE 

+    CASE non atomic: FALSE 

+    CASE oblist bone, 

+         property indicator, 

+         property root, 

+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 

+                                         text (x status (sym))); TRUE 

+    OTHERWISE x lisp error ("Illegaler Status " + 

+                             text (x status (sym))); TRUE

+  END SELECT 

+END PROC atom; 

+ 

+ 

+BOOL PROC is named atom (SYM CONST sym): 

+  x status (sym) = atomic 

+END PROC is named atom; 

+ 

+ 

+(*------------------- internal heap management routines ------------------*) 

+ 

+ 

+SYM PROC x new node (INT CONST status, head, tail): 

+  IF CONCR (heap).size = max size THEN 

+    error stop ("LISP Heap Ueberlauf"); nil 

+  ELSE 

+    CONCR (heap).size INCR 1; 

+    new node.status := status; 

+    new node.head := head; 

+    new node.tail := tail; 

+    SYM :(CONCR (heap).size) 

+  FI. 

+ 

+new node: 

+  node (CONCR (heap).size). 

+ 

+node: 

+  CONCR (heap).node. 

+ 

+END PROC x new node; 

+ 

+ 

+INT PROC x status (SYM CONST sym): 

+  CONCR (heap).node (CONCR (sym)).status 

+END PROC x status; 

+ 

+ 

+(**************************** oblist management ***************************) 

+ 

+ 

+(* Oblist organization: 

+ 

+(NOTE: 

+ 

+                                 +-----------------+ 

+                                 l     <status>    l 

+ All nodes are represented as    +--------+--------+    in all comments 

+                                 l <head> l <tail> l    of this packet. 

+                                 +--------+--------+ 

+ 

+END OF NOTE) 

+ 

+ 

+The 'oblist' (object list) is organized as follows: 

+ 

+  +-------------+ 

+  l oblist bone l 

+  +------+------+  +--> list of all atoms whose print names begin with "@" 

+  l   o  l XXXX l  l 

+  +---+--+------+  l 

+      +------------+ 

+  +-------------+ 

+  l oblist bone l 

+  +------+------+  +--> list of all atoms whose print names begin with "A" 

+  l   o  l XXXX l  l 

+  +---+--+------+  l 

+      +------------+ 

+            . 

+            . 

+            . 

+ 

+  +-------------+ 

+  l oblist bone l 

+  +------+------+  +--> list of all atoms whose print names begin with "Z" 

+  l   o  l XXXX l  l 

+  +---+--+------+  l 

+      +------------+ 

+ 

+ 

+These nodes with status 'oblist bone' form the oblist skeleton. As long as

+the lisp heap exists, they are stored contiguously in nodes 2 - 28; they

+cannot be changed directly by the user. This way of storing the oblist

+skeleton allows a hashing scheme to be applied when searching for an atom

+with a given name. The hash width of 27 is the smallest one thas distributes

+all atoms according to their character; with a smaller hash size, two or

+more lists would be merged, with the effect that some of the atom lists

+would contain atoms beginning with different characters.

+ 

+ 

+The list of all atoms whose print names begin with a certain character

+is organized as follows: 

+ 

+  +-------------+ 

+  l    atomic   l 

+  +------+------+ 

+  l   o  l  o---+--> property list of first atom 

+  +---+--+------+ 

+      l 

+      V 

+  +-------------+ 

+  l    atomic   l 

+  +------+------+ 

+  l   o  l  o---+--> property list of 2nd atom 

+  +---+--+------+ 

+      l 

+      V 

+      . 

+      . 

+      . 

+ 

+      l 

+      V 

+  +-------------+ 

+  l    atomic   l 

+  +------+------+ 

+  l   o  l  o---+--> property list of last atom 

+  +---+--+------+ 

+      l 

+      V 

+    oblist bone where the atom list began 

+ 

+ 

+These lists cannot be acessed directly by the user, too. 

+*) 

+ 

+ 

+ 

+PROC x initialize oblist and heap size: 

+  node (1).status := text data; 

+  node (1).head := 32 (* blank *); 

+  node (1).tail := 1; 

+  INT VAR i; 

+  FOR i FROM 2 UPTO 28 REP 

+    node (i).status := oblist bone; 

+    node (i).head := i 

+  PER; 

+  CONCR (heap).size := 28. 

+ 

+node: 

+  CONCR (heap).node. 

+ 

+END PROC x initialize oblist and heap size; 

+ 

+ 

+(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*) 

+ 

+ 

+SYM VAR actual oblist bone :: SYM :(0), 

+        actual atom :: SYM :(0); 

+ 

+ 

+PROC begin oblist dump: 

+  actual oblist bone := SYM :(2); 

+  actual atom := SYM :(2) 

+END PROC begin oblist dump; 

+ 

+ 

+SYM PROC next atom: 

+  actual atom := x head (actual atom); 

+  WHILE no more atoms in this atom list REP 

+    try next oblist bone 

+  PER; 

+  actual atom. 

+ 

+no more atoms in this atom list: 

+  (* NIL is given as last atom when 'next atom' is called repeatedly, so *) 

+  (* it can serve as a terminator. So NIL "does not count" if it is      *) 

+  (* encountered during one of the calls.                                *) 

+  IF null (actual atom) THEN 

+    actual atom := x head (actual atom) 

+  FI; 

+  eq (actual atom, actual oblist bone). 

+ 

+try next oblist bone: 

+  IF actual oblist bone is last oblist bone THEN 

+    actual atom := SYM :(2); 

+    LEAVE next atom WITH nil 

+  FI; 

+  CONCR (actual oblist bone) INCR 1; 

+  actual atom := x head (actual oblist bone). 

+ 

+actual oblist bone is last oblist bone: 

+  CONCR (actual oblist bone) = 28. 

+ 

+END PROC next atom; 

+ 

+ 

+(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*) 

+ 

+ 

+SYM VAR predecessor, result; 

+  (* Variables used for communication between the internal search        *) 

+  (* procedures and the procedures calling them.                         *) 

+ 

+ 

+SYM PROC atom (TEXT CONST name): 

+  x search atom (name); 

+  IF atom not already existing THEN 

+    nil 

+  ELSE 

+    result 

+  FI. 

+ 

+atom not already existing: 

+  x status (result) = oblist bone. 

+ 

+END PROC atom; 

+ 

+ 

+SYM PROC new atom (TEXT CONST name): 

+  x search atom (name); 

+  IF atom not already existing THEN 

+    x create new atom (name); 

+  FI; 

+  result. 

+ 

+atom not already existing: 

+  x status (result) = oblist bone. 

+ 

+END PROC new atom; 

+ 

+ 

+PROC create atom (TEXT CONST name): 

+  x search atom (name); 

+  IF atom already existing THEN 

+    error stop ("Atom " + name + " existiert bereits") 

+  ELSE 

+    x create new atom (name) 

+  FI. 

+ 

+atom already existing: 

+  x status (result) <> oblist bone. 

+ 

+END PROC create atom; 

+ 

+ 

+PROC delete atom (SYM CONST atom): 

+  IF is named atom (atom) THEN 

+    IF null (atom) OR eq (atom, pname) THEN 

+      error stop ("Dies Atom darf nicht geloescht werden") 

+    ELSE 

+      search predecessor; 

+      delete atom from atom list 

+    FI 

+  ELSE 

+    error stop ("Nur benannte Atome können geloescht werden") 

+  FI. 

+ 

+search predecessor: 

+  predecessor := x head (atom); 

+  WHILE NOT eq (x head (predecessor), atom) REP 

+    predecessor := x head (predecessor) 

+  PER. 

+ 

+delete atom from atom list: 

+  x set head (predecessor, x head (atom)). 

+ 

+END PROC delete atom; 

+ 

+ 

+PROC x search atom (TEXT CONST name): 

+  CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2; 

+  (* This formula places the list of atoms beginning with "@" at the     *) 

+  (* first oblist bone, the list of atoms beginning with "A" at the      *) 

+  (* at the second one, and so on. (See also the big comment in lines    *) 

+  (* 600 - 700)                                                          *) 

+  REP 

+    predecessor := result; 

+    result := x head (predecessor); 

+  UNTIL end of atom list reached COR right atom found PER. 

+ 

+end of atom list reached: 

+  x status (result) = oblist bone. 

+ 

+right atom found: 

+  SYM VAR actual character node := property (result, pname); 

+  IF NOT is text (actual character node) THEN 

+    x lisp error ("Namen erwartet"); 

+    LEAVE right atom found WITH FALSE 

+  FI; 

+  IF CONCR (x head (actual character node)) <> length (name) THEN 

+    FALSE 

+  ELSE 

+    INT VAR i; 

+    FOR i FROM 1 UPTO length (name) REP 

+      to next character node; 

+      check wether is character data node; 

+      check wether character matches; 

+    PER; 

+    TRUE 

+  FI. 

+ 

+to next character node: 

+  actual character node := x tail (actual character node). 

+ 

+check wether is character data node: 

+  IF x status (actual character node) <> character data THEN 

+    x lisp error ("Zeichenkette erwartet"); 

+    LEAVE right atom found WITH FALSE 

+  FI. 

+ 

+check wether character matches: 

+  IF code (name SUB i) <> CONCR (x head (actual character node)) THEN 

+    LEAVE right atom found WITH FALSE 

+  FI. 

+ 

+END PROC x search atom; 

+ 

+ 

+PROC x create new atom (TEXT CONST name): 

+  (* It is necessary that 'x search atom' has been executed before        *) 

+  (* calling 'x create new atom' because this procedure relies on the     *) 

+  (* value of 'predecessor'.                                              *) 

+  enable stop; 

+  SYM CONST sym name :: sym (name); 

+  IF CONCR (heap).size + 3 > max size THEN 

+    error stop ("LISP Heap Ueberlauf") 

+  FI; 

+  result := newly created atom; 

+  x set head (predecessor, result). 

+ 

+newly created atom: 

+  x new node (atomic, CONCR (oblist bone node), CONCR (property list)). 

+ 

+oblist bone node: 

+  x head (predecessor). 

+ 

+property list: 

+  x new node (property indicator, CONCR (pname), property root node). 

+ 

+property root node: 

+  CONCR (x new node (property root, CONCR (sym name), CONCR (nil))). 

+ 

+END PROC x create new atom; 

+ 

+ 

+(************************* property list handling *************************) 

+ 

+(* 

+The property lists consist of chained units of the structure 

+ 

+  +--------------------+   +---------------+ 

+  l property indicator l   l property root l 

+  +----------+---------+   +-------+-------+ 

+  l    o     l    o----+-->l   o   l   o---+--> . . . 

+  +----+-----+---------+   +---+---+-------+ 

+       l                       l 

+       V                       V 

+  property id              property 

+ 

+ 

+or 

+ 

+  +----------------+ 

+  l flag indicator l 

+  +--------+-------+ 

+  l   o    l   o---+--> . . . 

+  +---+----+-------+ 

+      l 

+      V 

+   flag id 

+ 

+ 

+ 

+The property lists cannot be altered or read directly, too. 

+ 

+For property list handling there exist procedures that insert, change, read

+and delete properties resp. flags. Thus, the only thing that can be done

+with any property of an atom without using these special procedures, is

+comparing to or 'cons'ing with some other S-expression. 

+At any given time the property list of any atom (including 'NIL') contains

+the property 'PNAME' giving the print name of the atom, stored as a list of

+characters. This special property cannot be altered, overwritten by 'add

+property' or deleted.

+*) 

+ 

+ 

+(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*) 

+ 

+ 

+SYM VAR actual property list node :: nil; 

+ 

+ 

+PROC begin property list dump (SYM CONST atom): 

+  actual property list node := x tail (atom) 

+END PROC begin property list dump; 

+ 

+ 

+PROC next property (SYM VAR property id, property): 

+  IF null (actual property list node) THEN 

+    property id := nil; 

+    property := nil 

+  ELSE 

+    SELECT x status (actual property list node) OF 

+      CASE flag indicator: get flag id 

+      CASE property indicator: get property id and property 

+      OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: " 

+                              + text (x status (actual property list node))) 

+    END SELECT 

+  FI. 

+ 

+get flag id: 

+  property id := x head (actual property list node); 

+  actual property list node := x tail (actual property list node); 

+  property := nil. 

+ 

+get property id and property: 

+  property id := x head (actual property list node); 

+  actual property list node := x tail (actual property list node); 

+  IF x status (actual property list node) = property root THEN 

+    property := x head (actual property list node); 

+    actual property list node := x tail (actual property list node) 

+  ELSE 

+    x lisp error ("Eigenschaftswurzel erwartet, nicht:" + 

+                text (x status (actual property list node))); 

+    property := nil 

+  FI. 

+ 

+END PROC next property; 

+ 

+ 

+(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*) 

+ 

+ 

+SYM VAR last atom :: SYM :(0), 

+        p list predecessor, 

+        p list result; 

+ 

+ 

+PROC add property (SYM CONST atom, property id, property): 

+  IF eq (property id, pname) THEN 

+    errorstop ("Der PNAME eines Atoms darf nicht versteckt sein") 

+  ELSE 

+    IF CONCR (heap).size + 2 > max size THEN 

+      error stop ("LISP Heap Ueberlauf"); 

+      LEAVE add property 

+    FI; 

+    x set tail (atom, new property plus old property list); 

+    IF eq (atom, last atom) AND 

+       eq (property id, x head (p list result)) THEN 

+      p list predecessor := atom; 

+      p list result := x tail (atom) 

+    FI 

+  FI. 

+ 

+new property plus old property list: 

+  x new node (property indicator, 

+        CONCR (property id), CONCR (property root plus old property list)). 

+ 

+property root plus old property list: 

+  x new node (property root, CONCR (property), CONCR (old property list)). 

+ 

+old property list: 

+  x tail (atom) 

+ 

+END PROC add property; 

+ 

+ 

+PROC alter property (SYM CONST atom, property id, new property): 

+  IF eq (property id, pname) THEN 

+    error stop ("Namen kann man nicht aendern") 

+  ELSE 

+    x search property id (atom, property id); 

+    IF null (p list result) THEN 

+      error stop ("Eigenschaft existiert nicht") 

+    ELSE 

+      x set head (x tail (p list result), new property) 

+    FI 

+  FI 

+END PROC alter property; 

+ 

+ 

+SYM PROC property (SYM CONST atom, property id): 

+  x search property id (atom, property id); 

+  IF null (p list result) THEN 

+    nil 

+  ELSE 

+    x head (x tail (p list result)) 

+  FI 

+END PROC property; 

+ 

+ 

+PROC delete property (SYM CONST atom, property id): 

+  IF eq (property id, pname) THEN 

+    errorstop ("Der Name eines Atoms darf nicht geloescht werden") 

+  ELSE 

+    x search property id (atom, property id); 

+    IF NOT null (p list result) THEN 

+      x set tail (p list predecessor, x tail (x tail (p list result))); 

+      last atom := SYM :(0) 

+    FI 

+  FI 

+END PROC delete property; 

+ 

+ 

+BOOL PROC property exists (SYM CONST atom, property id): 

+  x search property id (atom, property id); 

+  NOT null (p list result) 

+END PROC property exists; 

+ 

+ 

+PROC x search property id (SYM CONST atom, property id): 

+  IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN 

+    LEAVE x search property id 

+  FI; 

+  last atom := atom; 

+  p list predecessor := atom; 

+  REP 

+    p list result := x tail (p list predecessor); 

+    IF end of property list THEN 

+      last atom := SYM :(0); 

+      LEAVE x search property id 

+    FI; 

+    SELECT x status (p list result) OF 

+      CASE flag indicator: p list predecessor := p list result 

+      CASE property indicator: check wether property root node follows; 

+                               IF correct property id found THEN 

+                                 LEAVE x search property id 

+                               ELSE 

+                                 p list predecessor := xtail (p list result) 

+                               FI 

+      CASE property root: xlisperror("Unordentliche Eigenschaftwurzel"); 

+                          p list result := nil; 

+                          last atom := SYM :(0); 

+                          LEAVE x search property id 

+      OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " + 

+                              text (x status (p list result))); 

+                p list result := nil; 

+                last atom := SYM :(0); 

+                LEAVE x search property id 

+    END SELECT 

+  PER. 

+ 

+end of property list: 

+  null (p list result). 

+ 

+check wether property root node follows: 

+  IF x status (x tail (p list result)) <> property root THEN 

+    x lisp error ("Eigenschaftswurzel erwartet"); 

+    p list result := nil; 

+    last atom := SYM :(0); 

+    LEAVE x search property id 

+  FI. 

+ 

+correct property id found: 

+  eq (x head (p list result), property id). 

+ 

+END PROC x search property id; 

+ 

+ 

+(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*) 

+ 

+ 

+PROC add flag (SYM CONST atom, flag id): 

+  enable stop; 

+  x set tail (atom, new flag plus old property list). 

+ 

+new flag plus old property list: 

+  x new node (flag indicator, CONCR (flag id), old property list). 

+ 

+old property list: 

+  CONCR (x tail (atom)) 

+ 

+END PROC add flag; 

+ 

+ 

+BOOL PROC flag (SYM CONST atom, flag id): 

+  x search flag id (atom, flag id); 

+  NOT null (result) 

+END PROC flag; 

+ 

+ 

+PROC delete flag (SYM CONST atom, flag id): 

+  x search flag id (atom, flag id); 

+  IF NOT (is error COR null (result)) THEN 

+    x set tail (predecessor, x tail (result)) 

+  FI 

+END PROC delete flag; 

+ 

+ 

+PROC x search flag id (SYM CONST atom, flag id): 

+  predecessor := atom; 

+  REP 

+    result := x tail (predecessor); 

+    IF end of property list THEN 

+      LEAVE x search flag id 

+    FI; 

+    SELECT x status (result) OF 

+      CASE property root, property indicator: predecessor := result 

+      CASE flag indicator: IF correct flag id found THEN 

+                             LEAVE x search flag id 

+                           ELSE 

+                             predecessor := result 

+                           FI 

+      OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" + 

+                              text (x status (result))); 

+                result := nil; 

+                LEAVE x search flag id 

+    END SELECT 

+  PER. 

+ 

+end of property list: 

+  null (result). 

+ 

+correct flag id found: 

+  eq (x head (result), flag id). 

+ 

+END PROC x search flag id; 

+ 

+ 

+(****** Conversion of non-LISP data to LISP structures and vice versa *****) 

+ 

+ 

+TEXT PROC text (SYM CONST sym): 

+  IF is text (sym) THEN 

+    TEXT VAR result := ""; 

+    SYM VAR actual node :: sym; 

+    INT VAR i; 

+    FOR i FROM 1 UPTO CONCR (x head (sym)) REP 

+      actual node := x tail (actual node); 

+      result CAT actual character 

+    PER; 

+    result 

+  ELSE 

+    error stop ("ist kein text"); 

+    "" 

+  FI. 

+ 

+actual character: 

+  IF x status (actual node) <> character data THEN 

+    x lisp error ("Zeichenfolge erwartet"); 

+    LEAVE text WITH result 

+  FI; 

+  code (CONCR (x head (actual node))). 

+ 

+END PROC text; 

+ 

+ 

+BOOL PROC is text (SYM CONST sym): 

+  x status (sym) = text data 

+END PROC is text; 

+ 

+ 

+SYM PROC sym (TEXT CONST text): 

+  SYM VAR result :: x new node (text data, 

+                                length (text), CONCR (nil)), 

+          actual character node :: result; 

+  INT VAR length of text; 

+  ignore blanks at end of text;

+  INT VAR i; 

+  FOR i FROM 1 UPTO length of text REP 

+    x set tail (actual character node, new next character node); 

+    actual character node := x tail (actual character node) 

+  PER; 

+  result. 

+ 

+ignore blanks at end of text: 

+  FOR length of text FROM length (text) DOWNTO 0 REP 

+    IF (text SUB length of text) <> " " THEN 

+      LEAVE ignore blanks at end of text 

+    FI 

+  PER; 

+  length of text := 0. 

+ 

+new next character node: 

+  x new node (character data, code (text SUB i), 1). 

+ 

+END PROC sym; 

+ 

+ 

+INT PROC character (SYM CONST sym): 

+  IF x status (sym) = character data THEN 

+    CONCR (x head (sym)) 

+  ELSE 

+    error stop ("ist kein Charakter"); 

+    -1 

+  FI 

+END PROC character; 

+ 

+ 

+BOOL PROC is character (SYM CONST sym): 

+  x status (sym) = character data 

+END PROC is character; 

+ 

+ 

+SYM PROC sym character (INT CONST char): 

+  x new node (character data, char MOD 256, 1) 

+END PROC sym character; 

+ 

+ 

+INT PROC int 1 (SYM CONST sym): 

+  IF x status (sym) = int data THEN 

+    CONCR (x head (sym)) 

+  ELSE 

+    error stop ("ist keine Zahl"); 

+    -1 

+  FI 

+END PROC int 1; 

+ 

+ 

+INT PROC int 2 (SYM CONST sym): 

+  IF x status (sym) = int data THEN 

+    CONCR (x tail (sym)) 

+  ELSE 

+    error stop ("ist keine Zahl"); 

+    -1 

+  FI 

+END PROC int 2; 

+ 

+ 

+BOOL PROC is int pair (SYM CONST sym): 

+  x status (sym) = int data 

+END PROC is int pair; 

+ 

+ 

+SYM PROC sym (INT CONST int 1, int 2): 

+  x new node (int data, int 1, int 2) 

+END PROC sym; 

+ 

+ 

+(********************* internal error routine *****************************) 

+ 

+ 

+PROC x lisp error (TEXT CONST error message): 

+  error stop (""13"LISP SYSTEM FEHLER: " + error message ) 

+END PROC x lisp error; 

+ 

+ 

+END PACKET lisp heap and oblist management; 

+ 

+ 

+ 

+PACKET name                                         (* Autor: J.Durchholz *) 

+                                                    (* Datum: 15.06.1982  *) 

+    DEFINES                                         (* Version 1.1.1      *) 

+ 

+  name: 

+ 

+TEXT PROC name (SYM CONST sym): 

+  IF is named atom (sym) THEN 

+    text (property (sym, pname)) 

+  ELSE 

+    ""15"IST_KEIN_ATOM"14"" 

+  FI 

+END PROC name; 

+ 

+ 

+END PACKET name; 

+ 

+ 

+ 

+PACKET lisp storage info                            (* Autor: J.Durchholz *) 

+                                                    (* Datum: 23.08.1982  *) 

+    DEFINES                                         (* Version 1.1.1      *) 

+ 

+  lisp storage info: 

+ 

+ 

+PROC lisp storage info: 

+  INT VAR size, used; 

+  lisp storage (size, used); 

+  out (""13""10"      "); 

+  put (used); 

+  put ("Knoten von"); 

+  put (size); 

+  put line ("Knoten des LISP-Heaps sind belegt!") 

+END PROC lisp storage info; 

+ 

+ 

+END PACKET lisp storage info; 

diff --git a/lang/lisp/1.7.2/src/lisp.2 b/lang/lisp/1.7.2/src/lisp.2
new file mode 100644
index 0000000..956aa5c
--- /dev/null
+++ b/lang/lisp/1.7.2/src/lisp.2
@@ -0,0 +1,550 @@
+PACKET character buffer                            (* Autor : J.Durchholz *) 

+                                                   (* Datum : 09.05.1984  *) 

+    DEFINES                                        (* Version 1.7.2       *) 

+                                      (* 21.2.83. hey 293, 450,97,361 *)

+  get char, 

+  line nr, 

+  init char buffer: 

+ 

+ 

+TEXT VAR buffer; 

+INT VAR pointer, 

+        line; 

+ 

+ 

+INT PROC line nr: 

+  line 

+END PROC line nr; 

+ 

+ 

+PROC init char buffer: 

+  buffer := ""; 

+  pointer := 1; 

+  line := 0; 

+END PROC init char buffer; 

+ 

+ 

+PROC get char (FILE VAR f, TEXT VAR char): 

+  IF buffer empty THEN 

+    try to find nonempty line and put it into buffer; 

+    char := " "; 

+    pointer := 1 

+  ELSE 

+    char := buffer SUB pointer; 

+    pointer INCR 1 

+  FI. 

+ 

+buffer empty: 

+  pointer > length (buffer). 

+ 

+try to find nonempty line and put it into buffer: 

+  REP 

+    IF eof (f) THEN 

+      char := ""; 

+      LEAVE get char 

+    FI; 

+    get line (f, buffer); 

+    line INCR 1 

+  UNTIL buffer <> "" PER. 

+ 

+END PROC get char; 

+ 

+ 

+END PACKET character buffer; 

+ 

+ 

+ 

+ 

+PACKET lisp io                                      (* Autor: J.Durchholz *) 

+                                                    (* Datum: 10.09.1982  *) 

+    DEFINES                                         (* Version 4.1.3      *) 

+ 

+  put, 

+  verbose lisp output, 

+  get, 

+  get all: 

+ 

+ 

+BOOL VAR verbose :: FALSE; 

+ 

+ 

+PROC verbose lisp output (BOOL CONST b): 

+  verbose := b 

+END PROC verbose lisp output; 

+ 

+BOOL PROC verbose lisp output: 

+  verbose 

+END PROC verbose lisp output; 

+ 

+ 

+PROC put (FILE VAR f, SYM CONST sym): 

+  IF atom (sym) THEN 

+    put atom 

+  ELSE 

+    put structure 

+  FI. 

+ 

+put atom: 

+  IF is named atom (sym) THEN 

+    put (f, name (sym)) 

+  ELIF is int pair (sym) THEN 

+    put (f, int 1 (sym)) 

+  ELIF is text (sym) THEN 

+    IF verbose THEN 

+      TEXT VAR buffer :: text (sym); 

+      change all (buffer, """", """"""); 

+      buffer CAT """"; 

+      put (f, """" + buffer) 

+    ELSE 

+      write (f, text (sym)) 

+    FI 

+  ELIF is character (sym) THEN 

+    IF verbose THEN 

+      buffer := "'"; 

+      buffer CAT code (character (sym)); 

+      buffer CAT "'"; 

+      put (f, buffer) 

+    ELSE 

+      write (f, code (character (sym))) 

+    FI 

+  ELSE 

+    put (f, ""15"UNBEKANNTER_ATOM_TYP"14"") 

+  FI. 

+ 

+put structure: 

+  put (f, "("); 

+  SYM VAR actual node := sym; 

+  REP 

+    put (f, head (actual node)); 

+    actual node := tail (actual node) 

+  UNTIL atom (actual node) PER; 

+  IF NOT null (actual node) THEN 

+    put (f, "."); 

+    put (f, actual node) 

+  FI; 

+  put (f, ")"). 

+ 

+END PROC put; 

+ 

+ 

+PROC put (SYM CONST sym): 

+  IF atom (sym) THEN 

+    put atom 

+  ELSE 

+    put structure 

+  FI. 

+ 

+put atom: 

+  IF is named atom (sym) THEN 

+    put (name (sym)) 

+  ELIF is int pair (sym) THEN 

+    put (int 1 (sym)) 

+  ELIF is text (sym) THEN 

+    IF verbose THEN 

+      TEXT VAR buffer :: text (sym); 

+      change all (buffer, """", """"""); 

+      buffer CAT """"; 

+      put ("""" + buffer) 

+    ELSE 

+      write (text (sym)) 

+    FI 

+  ELIF is character (sym) THEN 

+    IF verbose THEN 

+      buffer := "'"; 

+      buffer CAT code (character (sym)); 

+      buffer CAT "'"; 

+      put (buffer) 

+    ELSE 

+      out (code (character (sym))) 

+    FI 

+  ELSE 

+    put (""15"UNBEKANNTER_ATOM_TYP"14"") 

+  FI. 

+ 

+put structure: 

+  put ("("); 

+  SYM VAR actual node := sym; 

+  REP 

+    put (head (actual node)); 

+    actual node := tail (actual node) 

+  UNTIL atom (actual node) PER; 

+  IF NOT null (actual node) THEN 

+    put ("."); 

+    put (actual node) 

+  FI; 

+  put (")"). 

+ 

+END PROC put; 

+ 

+ 

+PROC get (FILE VAR f, SYM VAR s): 

+  initialize scanner (f); 

+  IF NOT get s expression (s) THEN 

+    error ("LISP-Ausdruck erwartet") 

+  FI; 

+  scanner postprocessing (f) 

+END PROC get; 

+ 

+ 

+(**************************** parser for 'get' ****************************) 

+ 

+ 

+LET end of file type = 0, 

+    name type = 1, 

+    text type = 2, 

+    character type = 3, 

+    int type = 4, 

+    other char type = 5; 

+ 

+ 

+BOOL PROC get s expression (SYM VAR s): 

+  (* The boolean result indicates wether the error has not occurred that  *) 

+  (* 'get next symbol' was called, but then the symbol was not expected   *) 

+  (* and thus could not be processed.                                     *) 

+  get next symbol; 

+  SELECT symbol type OF 

+    CASE end of file type: FALSE 

+    CASE name type: s := new atom (symbol); TRUE 

+    CASE text type: s := sym (symbol); TRUE 

+    CASE character type: s := sym character (code (symbol)); TRUE 

+    CASE int type: s := sym (int (symbol), -1); TRUE 

+    CASE other char type: get structure 

+    OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " + 

+                     text (symbol type)); TRUE 

+  END SELECT. 

+ 

+get structure: 

+  IF symbol <> "(" THEN 

+    FALSE 

+  ELSE 

+    get list; 

+    IF symbol type <> other char type OR symbol <> ")" THEN 

+      error (">> ) << erwartet"); 

+      FALSE 

+    ELSE 

+      TRUE 

+    FI 

+  FI. 

+ 

+get list: 

+  SYM VAR father, son; 

+  IF get s expression (son) THEN 

+    get list elements; 

+  ELSE 

+    s := nil 

+  FI. 

+ 

+get list elements: 

+  father := cons (son, nil); 

+  s := father; 

+  WHILE get s expression (son) REP 

+    set tail (father, cons (son, nil)); 

+    father := tail (father) 

+  PER; 

+  IF symbol type = other char type AND symbol = "." THEN 

+    IF get s expression (son) THEN 

+      set tail (father, son); 

+      get next symbol 

+    ELSE 

+      error ("LISP-Ausdruck nach dem Punkt erwartet") 

+    FI 

+  FI. 

+ 

+END PROC get s expression; 

+ 

+ 

+(********************* scanner for 'get x espression' *********************) 

+ 

+ 

+FILE VAR infile; 

+ 

+ 

+PROC initialize scanner (FILE CONST f): 

+  infile := f; 

+  no input errors := TRUE; 

+  init char buffer; 

+  get char (infile, actual char) 

+END PROC initialize scanner; 

+ 

+ 

+PROC scanner postprocessing (FILE VAR f): 

+  f := infile 

+END PROC scanner postprocessing; 

+ 

+ 

+TEXT VAR symbol; INT VAR symbol type; 

+ 

+ 

+PROC get next symbol: 

+  skip blanks; 

+  IF actual char = "" THEN 

+    symbol := "DATEIENDE"; 

+    symbol type := end of file type 

+  ELIF is letter THEN 

+    get name 

+  ELIF is digit or sign THEN 

+    get integer 

+  ELIF is double quote THEN 

+    get text 

+  ELIF is single quote THEN 

+    get character 

+  ELSE 

+    get other char 

+  FI .

+ 

+is letter: 

+  IF "a" <= actual char AND actual char <= "z" THEN 

+    actual char := code (code (actual char) - code ("a") + code ("A")); 

+    TRUE 

+  ELSE 

+    "@" <= actual char AND actual char <= "Z" 

+  FI. 

+ 

+get name: 

+  symbol type := name type; 

+  symbol := actual char; 

+  REP 

+    get char (infile, actual char); 

+    IF is neither letter nor digit THEN 

+      LEAVE get name 

+    FI; 

+    symbol CAT actual char 

+  PER. 

+ 

+is neither letter nor digit: 

+  NOT (is letter OR is digit OR is underscore). 

+ 

+is digit: 

+  "0" <= actual char AND actual char <= "9". 

+ 

+is underscore: 

+  actual char = "_". 

+ 

+is digit or sign: 

+  is digit OR actual char = "+" OR actual char = "-". 

+ 

+get integer: 

+  symbol type := int type; 

+  IF actual char = "+" THEN 

+    get char (infile, actual char); 

+    skip blanks; 

+    symbol := actual char 

+  ELIF actual char = "-" THEN 

+    symbol := "-"; 

+    get char (infile, actual char); 

+    skip blanks; 

+    symbol CAT actual char 

+  ELSE 

+    symbol := actual char 

+  FI; 

+  REP 

+    get char (infile, actual char); 

+    IF NOT is digit THEN 

+      LEAVE get integer 

+    FI; 

+    symbol CAT actual char 

+  PER. 

+ 

+is double quote: 

+  actual char = """". 

+ 

+get text: 

+  symbol := ""; 

+  symbol type := text type; 

+  REP 

+    get char (infile, actual char); 

+    IF is double quote THEN 

+      get char (infile, actual char); 

+      IF NOT is double quote THEN LEAVE get text 

+      FI 

+    ELIF actual char = ""    THEN LEAVE get text  (*hey*)

+    FI; 

+    symbol CAT actual char 

+  PER. 

+ 

+is single quote: 

+  actual char = "'". 

+ 

+get character: 

+  symbol type := character type; 

+  get char (infile, symbol); 

+  get char (infile, actual char); 

+  IF actual char <> "'" THEN 

+    error (">> ' << erwartet") 

+  ELSE 

+    get char (infile, actual char) 

+  FI. 

+ 

+get other char: 

+  symbol type := other char type; 

+  symbol := actual char; 

+  get char (infile, actual char). 

+ 

+END PROC get next symbol; 

+ 

+ 

+TEXT VAR actual char; 

+ 

+ 

+PROC skip blanks: 

+  INT VAR comment depth :: 0; 

+  WHILE is comment OR actual char = " " REP 

+    get char (infile, actual char) 

+  PER. 

+ 

+is comment: 

+  IF actual char = "{" THEN 

+    comment depth INCR 1; 

+    TRUE 

+  ELIF actual char = "}" THEN 

+    IF comment depth = 0 THEN 

+      error (">> { << fehlt") 

+    ELSE 

+      comment depth DECR 1 

+    FI; 

+    TRUE 

+  ELSE 

+    IF comment depth > 0 THEN 

+      IF actual char = "" THEN 

+        error ("DATEIENDE im Kommentar"); 

+        FALSE 

+      ELSE 

+        TRUE 

+      FI 

+    ELSE 

+      FALSE 

+    FI 

+  FI. 

+ 

+END PROC skip blanks; 

+ 

+ 

+BOOL VAR no input errors; 

+FILE VAR errors; 

+ 

+ 

+PROC error (TEXT CONST error message): 

+  out ("FEHLER in Zeile "); 

+  out (text (line nr)); 

+  out (" bei >> "); 

+  out (symbol); 

+  out (" << : "); 

+  out (error message); 

+  line; 

+  IF no input errors THEN 

+    no input errors := FALSE; 

+    errors := notefile; modify(errors);

+    headline (errors, "Einlesefehler"); output(errors)

+  FI; 

+  write (errors, "FEHLER in Zeile "); 

+  write (errors, text (line nr)); 

+  write (errors, " bei >> "); 

+  write (errors, symbol); 

+  write (errors, " << : "); 

+  write (errors, error message); 

+  line (errors) 

+END PROC error; 

+ 

+ 

+PROC get (SYM VAR sym):     (*hey*)

+  disable stop; 

+  FILE VAR in  :: sequential file (modify, "LISP INPUT"), 

+           out :: notefile; modify (out);

+  headline (out,"LISP OUTPUT");

+  headline (in, "LISP INPUT");

+  editable (out,in); output(out);

+  input (in); 

+  get (in, sym); 

+  WHILE NOT no input errors AND NOT is error REP 

+    modify (errors);

+    headline (errors, " LISP-Fehlermeldungen"); 

+    headline (in, " Bitte KORREKTEN LISP-Ausdruck"); 

+    editable (errors, in); 

+    headline (errors, "notebook"); 

+    output (errors);

+    input (in); 

+    get (in, sym) 

+  PER; 

+END PROC get; 

+ 

+ 

+PROC editable (FILE VAR a,b):   (*hey*)

+  enable stop; edit (a,b); to line (a,lines(a)); remove(a,lines(a))

+END PROC editable;

+ 

+PROC edit (FILE VAR a,b):

+  open editor (1, b, write acc, 1, 1, 79, 24);

+  open editor (2, a, write acc, 1,13, 79, 12);

+  edit (1)

+  END PROC edit;

+ 

+LET write acc = TRUE;

+ 

+PROC get all (FILE VAR f, SYM VAR sym): 

+  get (f, sym); 

+  skip blanks; 

+  IF NOT eof (infile) THEN 

+    error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen") 

+  FI 

+END PROC get all; 

+ 

+ 

+END PACKET lisp io; 

+ 

+ 

+ 

+PACKET lisp integer                                 (* Autor: J.Durchholz *) 

+                                                    (* Datum: 30.08.1982  *) 

+    DEFINES                                         (* Version 1.1.2      *) 

+ 

+  sum, 

+  difference, 

+  product, 

+  quotient,

+  remainder:

+ 

+SYM PROC sum (SYM CONST summand list): 

+  INT VAR result := 0; 

+  SYM VAR list rest := summand list; 

+  WHILE NOT atom (list rest) REP 

+    result INCR int 1 (head (list rest)); 

+    list rest := tail (list rest) 

+  PER; 

+  IF NOT null (list rest) THEN 

+    error stop ("Summandenliste endet falsch") 

+  FI ;

+  sym (result, -1) 

+END PROC sum; 

+ 

+ 

+SYM PROC difference (SYM CONST minuend, subtrahend): 

+  sym (int 1 (minuend) - int 1 (subtrahend), -1) 

+END PROC difference; 

+ 

+ 

+SYM PROC product (SYM CONST factor list): 

+  INT VAR result := 1; 

+  SYM VAR list rest := factor list; 

+  WHILE NOT atom (list rest) REP 

+    result := result * int 1 (head (list rest)); 

+    list rest := tail (list rest) 

+  PER; 

+  IF NOT null (list rest) THEN 

+    error stop ("Faktorenliste endet falsch") 

+  FI; 

+  sym (result, -1) 

+END PROC product; 

+ 

+ 

+SYM PROC quotient (SYM CONST dividend, divisor): 

+  sym (int 1 (dividend) DIV int 1 (divisor), -1) 

+END PROC quotient; 

+ 

+ 

+SYM PROC remainder(SYM CONST dividend, divisor): 

+  sym (int 1 (dividend) MOD int 1 (divisor), -1) 

+END PROC remainder;

+ 

+ 

+END PACKET lisp integer; 

+ 

diff --git a/lang/lisp/1.7.2/src/lisp.3 b/lang/lisp/1.7.2/src/lisp.3
new file mode 100644
index 0000000..dfde6db
--- /dev/null
+++ b/lang/lisp/1.7.2/src/lisp.3
@@ -0,0 +1,142 @@
+PACKET lisp                     (* Autor: J.Durchholz , P. Heyderhoff *)

+                                (* Datum: 09.05.1984  *)

+    DEFINES                     (* Version 1.7.2      *)

+ 

+  start lisp system,

+  lisp heap,

+  insert lisp,

+  run lisp,

+  run lisp again,

+  lisp:

+ 

+SYM VAR run again pointer :: nil;

+DATASPACE VAR insert heap :: nil space;

+ 

+PROC start lisp system (DATASPACE CONST heap):

+  enable stop;

+  initialize lisp system (heap);

+  forget (insert heap);

+  insert heap := heap

+END PROC start lisp system;

+ 

+ 

+PROC start lisp system (DATASPACE CONST heap, FILE VAR f):

+  start lisp system (heap);

+  input (f);

+  WHILE NOT eof (f) REP

+    TEXT VAR name;

+    get (f, name);

+    SYM CONST s :: new atom (name);

+    get (f, name);

+    SYM CONST property name :: new atom (name);

+    IF NOT null (property name) THEN

+      SYM VAR property;

+      get (f, property);

+      add property (s, property name, property)

+    FI;

+  PER

+END PROC start lisp system;

+ 

+ 

+PROC start lisp system (FILE VAR f):

+  create lisp system (f, insert heap)

+END PROC start lisp system;

+ 

+ 

+DATASPACE PROC lisp heap:

+  insert heap

+END PROC lisp heap;

+ 

+ 

+DATASPACE VAR run heap :: nil space;

+ 

+ 

+PROC insert lisp:

+  insert lisp (last param)

+END PROC insert lisp;

+ 

+ 

+PROC insert lisp (TEXT CONST file name):

+  interpret (insert heap, file name)

+END PROC insert lisp;

+ 

+ 

+PROC run lisp:

+  run lisp (last param)

+END PROC run lisp;

+ 

+ 

+PROC run lisp (TEXT CONST file name):

+  forget (run heap);

+  run heap := insert heap;

+  interpret (run heap, file name)

+END PROC run lisp;

+ 

+ 

+DATASPACE VAR do heap :: nil space,

+              do file :: nil space;

+ 

+ 

+ 

+PROC interpret (DATASPACE CONST heap, TEXT CONST file name):

+  enable stop;

+  FILE VAR f :: sequential file (input, file name);

+  interpret (heap, f)

+END PROC interpret;

+ 

+ 

+PROC interpret (DATASPACE CONST heap, FILE VAR f):

+  initialize lisp system (heap);

+  get (f, run again pointer);

+  add property (new atom ("program"), new atom ("APVAL"), run again pointer);

+  put (evalquote (run again pointer))

+END PROC interpret;

+ 

+PROC run lisp again:

+  put (evalquote (run again pointer))

+END PROC run lisp again;

+ 

+ 

+PROC get ausdruck:

+  enable stop; get (ausdruck)

+END PROC get ausdruck;

+ 

+SYM VAR ausdruck; 

+ 

+PROC lisp:

+ 

+(* HAUPT TESTPROGRAMM FUER LISP      Heyderhoff    25.1.83   *)

+IF NOT exists ("LISP HEAP") THEN 

+  FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap"); 

+  create lisp system (bootstrap, new ("LISP HEAP")); 

+  verbose lisp output (TRUE);

+FI; 

+FILE VAR out :: notefile; output (out);

+SYM VAR work;

+command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE);

+(* bildlaenge(23); *) (* EUMEL 1.65 *)

+disable stop; 

+REP 

+  get (ausdruck); 

+  IF is error THEN 

+    handle error 

+  ELSE 

+    output (out); 

+    work := evalquote (ausdruck);

+    IF is error THEN  handle error 

+    ELSE put (out, work)

+    FI 

+  FI 

+PER .

+ 

+handle error: 

+  IF text (error message, 18) = "halt from terminal" THEN 

+    enable stop 

+  ELSE 

+    put (out, error message);

+    put (     error message); pause(20);

+    clear error; 

+  FI .

+END PROC lisp;

+END PACKET lisp;

+ 

diff --git a/lang/lisp/1.7.2/src/lisp.4 b/lang/lisp/1.7.2/src/lisp.4
new file mode 100644
index 0000000..f36706d
--- /dev/null
+++ b/lang/lisp/1.7.2/src/lisp.4
@@ -0,0 +1,766 @@
+PACKET lisp heap maintenance                        (* Autor: J.Durchholz *) 

+                                                    (* Datum: 09.05.1984  *) 

+    DEFINES                                         (* Version 1.7.2      *) 

+                                                    (* Testhilfe          *) 

+  create lisp system,                  (* hey, 02.3.83 : 121,334,542,732 *) 

+  dump oblist: 

+ 

+ 

+PROC create lisp system (FILE VAR f, DATASPACE CONST new heap): 

+  initialize lisp system (new heap); 

+  input (f); 

+  WHILE NOT eof (f) REP 

+    TEXT VAR name; 

+    get (f, name); 

+    SYM CONST s :: new atom (name); 

+    get (f, name); 

+    SYM CONST property name :: new atom (name); 

+    IF NOT null (property name) THEN 

+      SYM VAR property; 

+      get (f, property); 

+      add property (s, property name, property) 

+    FI 

+  PER 

+END PROC create lisp system; 

+ 

+ 

+PROC dump oblist (FILE VAR f): 

+  begin oblist dump; 

+  REP 

+    SYM CONST actual atom :: next atom; 

+    put line (f, name (actual atom)); 

+    dump property list 

+  UNTIL null (actual atom) PER. 

+ 

+dump property list: 

+  begin property list dump (actual atom); 

+  REP 

+    SYM VAR id, value; 

+    next property (id, value); 

+    write (f, "  "); 

+    write (f, name (id)); 

+    write (f, " "); 

+    write (f, name (value)); 

+    line (f) 

+  UNTIL null (id) AND null (value) PER. 

+ 

+END PROC dump oblist; 

+ 

+ 

+PROC dump oblist: 

+  begin oblist dump; 

+  REP 

+    SYM CONST actual atom :: next atom; 

+    put line (name (actual atom)); 

+    dump property list 

+  UNTIL null (actual atom) PER. 

+ 

+dump property list: 

+  begin property list dump (actual atom); 

+  REP 

+    SYM VAR id, value; 

+    next property (id, value); 

+    out ("  "); 

+    out (name (id)); 

+    out (" "); 

+    put line (name (value)); 

+  UNTIL null (id) AND null (value) PER. 

+ 

+END PROC dump oblist; 

+ 

+ 

+END PACKET lisp heap maintenance; 

+ 

+ 

+ 

+PACKET lisp interpreter                             (* Autor: J.Durchholz *) 

+                                                    (* Datum: 27.12.1982  *) 

+    DEFINES                                         (* Version 3.1.7      *) 

+  evalquote,

+  apply, 

+  eval, 

+  try: 

+ 

+ 

+(* SYM-objects used by the interpreter. They all point to constant structure

+ within the heap. As their address may change during garbage collection,

+ it must be possible to correct the references to them made by the

+ SYM-objects. That is the reason why they are declared VAR instead of CONST*)

+SYM VAR lambda constant, 

+        label constant, 

+        quote constant, 

+        function constant, 

+        indefinite constant, 

+        apval constant, 

+        true constant, 

+        false constant; 

+ 

+SYM VAR errors; 

+BOOL VAR trace :: FALSE; 

+ 

+PROC initialize constants: 

+  lambda constant := new atom ("LAMBDA"); 

+  label constant := new atom ("LABEL"); 

+  quote constant := new atom ("QUOTE"); 

+  function constant := new atom ("FUNCTION"); 

+  indefinite constant := new atom ("INDEFINITE"); 

+  apval constant := new atom ("APVAL"); 

+  true constant := new atom ("T"); 

+  false constant := new atom ("F"); 

+  errors := new atom ("ERRORS") 

+END PROC initialize constants; 

+ 

+ 

+SYM PROC evalquote (SYM CONST expr):     (*hey*)

+  enable stop; 

+  initialize constants; 

+  x apply ( head (expr), quote (tail (expr)), nil )

+END PROC evalquote;

+ 

+ 

+SYM PROC quote (SYM CONST x):

+  IF eq (x,nil) THEN nil

+  ELSE set head (x, new head); set tail (x, quote (tail(x))); x

+  FI .

+new head:

+  cons (quote constant, cons (head(x), nil) )

+END PROC quote;

+ 

+ 

+SYM PROC apply (SYM CONST function, argument list, alist): 

+  enable stop; 

+  initialize constants; 

+  x apply (function, argument list, alist) 

+END PROC apply; 

+ 

+ 

+SYM PROC x apply (SYM CONST function, argument list, alist): 

+  IF trace THEN line;

+    put ("a p p l y :"); put (function); line;

+    put ("arguments :"); put (argument list); line;

+  FI;

+  SYM VAR new alist; 

+  initialize for alist insertion; 

+  reduce actual fn to lambda expression; 

+  insert parameter evaluated argument pairs in reversed order in new alist; 

+  function body evaluation. 

+ 

+reduce actual fn to lambda expression: 

+  SYM VAR actual fn :: function; 

+  REP 

+    IF is named atom (actual fn) THEN 

+      get function from property list of actual fn 

+                                           or from functional alist entry 

+    ELIF atom (actual fn) THEN 

+      error stop ("Eine Funktion darf kein unbenanntes Atom sein") 

+    ELSE 

+      IF eq (head (actual fn), lambda constant) THEN 

+        LEAVE reduce actual fn to lambda expression 

+      ELIF eq (head (actual fn), label constant) THEN 

+        get function from label expression and update alist 

+      ELSE 

+        error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck") 

+      FI 

+    FI 

+  PER. 

+ 

+get function from property list of actual fn or from functional alist entry: 

+  IF property exists (actual fn, function constant) THEN 

+    get function from property list of actual fn 

+  ELSE 

+    get function from functional alist entry 

+  FI. 

+ 

+get function from property list of actual fn: 

+  actual fn := property (actual fn, function constant). 

+ 

+get function from functional alist entry: 

+  SYM VAR actual alist entry; 

+  begin alist retrieval; 

+  REP 

+    IF end of alist THEN 

+      error stop ("Die Funktion " + name (actual fn) + 

+                  " ist nicht definiert") 

+    FI; 

+    search for next functional alist entry; 

+  UNTIL eq (head (actual functional alist entry), actual fn) PER; 

+  actual fn := tail (actual functional alist entry). 

+ 

+get function from label expression and update alist: 

+  actual fn := tail (actual fn); 

+  IF atom (actual fn) COR 

+     (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR 

+     NOT null (tail (tail (actual fn)))                           THEN 

+    error stop ("Ungueltiger LABEL-Ausdruck") 

+  FI; 

+  SYM VAR new alist entry; 

+  prepare new functional alist entry; 

+  set head (new alist entry, head (actual fn)); 

+  actual fn := head (tail (actual fn)); 

+  set tail (new alist entry, actual fn). 

+ 

+insert parameter evaluated argument pairs in reversed order in new alist: 

+  actual fn := tail (actual fn); 

+  IF atom (actual fn) THEN 

+    error stop ("Ungueltiger LAMBDA-Ausdruck") 

+  FI; 

+  SYM VAR parameter list rest :: head (actual fn), 

+          argument list rest :: argument list; 

+  actual fn := tail (actual fn); 

+  WHILE NOT null (parameter list rest) REP 

+    add next parameter argument pair to alist 

+  PER; 

+  check wether no arguments are left over. 

+ 

+add next parameter argument pair to alist: 

+  IF atom (parameter list rest) THEN 

+    error stop ("Parameterliste endet falsch") 

+  FI; 

+  SYM VAR param pointer :: head (parameter list rest); 

+  parameter list rest := tail (parameter list rest); 

+  IF is named atom (param pointer) AND NOT null (param pointer) THEN 

+    add parameter evaluated argument pair to alist; 

+    advance argument list rest 

+  ELIF atom (param pointer) THEN 

+    error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") 

+  ELSE 

+    IF eq (head (param pointer), indefinite constant) THEN 

+      check wether is last param; 

+      advance param pointer; 

+      IF eq (head (param pointer), quote constant) THEN 

+        advance param pointer; 

+        move param pointer to parameter; 

+        add parameter indefinite quoted argument pair to alist 

+      ELSE 

+        move param pointer to parameter; 

+        add parameter indefinite evaluated argument pair to alist 

+      FI; 

+      argument list rest := nil 

+    ELIF eq (head (param pointer), quote constant) THEN 

+      advance param pointer; 

+      move param pointer to parameter; 

+      add parameter quoted argument pair to alist; 

+      advance argument list rest 

+    ELIF eq (head (param pointer), function constant) THEN 

+      advance param pointer; 

+      move param pointer to parameter; 

+      add parameter functional argument pair to alist; 

+      advance argument list rest 

+    ELSE 

+      error stop ("Ungueltiger Parameter") 

+    FI 

+  FI. 

+ 

+advance param pointer: 

+  param pointer := tail (param pointer); 

+  IF atom (param pointer) THEN 

+    error stop ("Ungueltiger Parameter") 

+  FI. 

+ 

+move param pointer to parameter: 

+  IF NOT null (tail (param pointer)) THEN 

+    error stop ("Ungueltiger Parameter") 

+  FI; 

+  param pointer := head (param pointer); 

+  IF NOT atom (param pointer) OR null (param pointer) THEN 

+    error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") 

+  FI. 

+ 

+advance argument list rest: 

+  argument list rest := tail (argument list rest). 

+ 

+add parameter evaluated argument pair to alist: 

+  prepare new alist entry; 

+  set head (new alist entry, param pointer); 

+  set tail (new alist entry, x eval (actual argument, alist)). 

+ 

+check wether is last param: 

+  IF NOT null (parameter list rest) THEN 

+    error stop ("Ein INDEFINITE-Parameter muss der letzte sein") 

+  FI. 

+ 

+add parameter indefinite quoted argument pair to alist: 

+  prepare new alist entry; 

+  set head (new alist entry, param pointer); 

+  set tail (new alist entry, argument list rest); 

+  WHILE NOT atom (argument list rest) REP 

+    argument list rest := tail (argument list rest) 

+  PER; 

+  IF NOT null (argument list rest) THEN 

+    error stop ("Argumentliste endet falsch") 

+  FI. 

+ 

+add parameter indefinite evaluated argument pair to alist: 

+  prepare new alist entry; 

+  set head (new alist entry, param pointer); 

+  last evaluated argument := new alist entry; 

+  WHILE NOT atom (argument list rest) REP 

+    set tail (last evaluated argument, 

+              cons (x eval (head (argument list rest), alist), nil)); 

+    last evaluated argument := tail (last evaluated argument); 

+    advance argument list rest 

+  PER; 

+  IF NOT null (argument list rest) THEN 

+    error stop ("Argumentliste endet falsch") 

+  FI. 

+ 

+last evaluated argument: 

+  param pointer. 

+(* The value of param pointer is not used further, so the *) 

+(* variable can be "reused" in this manner. *) 

+ 

+add parameter quoted argument pair to alist: 

+  prepare new alist entry; 

+  set head (new alist entry, param pointer); 

+  set tail (new alist entry, actual argument). 

+ 

+add parameter functional argument pair to alist: 

+  prepare new functional alist entry; 

+  set head (new alist entry, param pointer); 

+  set tail (new alist entry, actual argument). 

+ 

+actual argument: 

+  IF atom (argument list rest) THEN 

+    IF null (argument list rest) THEN 

+      error stop ("Zuwenig Argumente") 

+    ELSE 

+      error stop ("Argumentliste endet falsch") 

+    FI 

+  FI; 

+  head (argument list rest). 

+ 

+check wether no arguments are left over: 

+  IF NOT null (argument list rest) THEN 

+    error stop ("Zuviele Argumente") 

+  FI. 

+ 

+function body evaluation: 

+  IF is int pair (actual fn) THEN 

+    predefined function evaluation 

+  ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN 

+    error stop ("Ungueltiger LAMBDA-Ausdruck"); nil 

+  ELSE 

+    x eval (head (actual fn), new alist) 

+  FI. 

+ 

+predefined function evaluation: 

+  SELECT int 1 (actual fn) OF 

+    CASE 0: call eval cond 

+    CASE 1: call begin oblist dump 

+    CASE 2: call next atom 

+    CASE 3: call add property 

+    CASE 4: call alter property 

+    CASE 5: call delete property 

+    CASE 6: call property exists 

+    CASE 7: call property 

+    CASE 8: call add flag 

+    CASE 9: call flag 

+    CASE 10: call delete flag 

+    CASE 11: call begin property list dump 

+    CASE 12: call next property 

+    CASE 13: call apply 

+    CASE 14: call eval 

+    CASE 15: call try 

+    CASE 16: give association list 

+    CASE 17: call error stop 

+    CASE 18: call head 

+    CASE 19: call set head 

+    CASE 20: call tail 

+    CASE 21: call set tail 

+    CASE 22: call cons 

+    CASE 23: call eq 

+    CASE 24: call get sym 

+    CASE 25: call put sym 

+    CASE 26: call null 

+    CASE 27: call is atom 

+    CASE 28: call is named atom 

+    CASE 29: call get named atom 

+    CASE 30: call put named atom 

+    CASE 31: call is text 

+    CASE 32: call get text 

+    CASE 33: call put text 

+    CASE 34: call is character 

+    CASE 35: call get character 

+    CASE 36: call put character 

+    CASE 37: call is int 

+    CASE 38: call get int 

+    CASE 39: call put int 

+    CASE 40: call sum 

+    CASE 41: call difference 

+    CASE 42: call product 

+    CASE 43: call quotient 

+    CASE 44: call remainder

+    CASE 45: call equal 

+    CASE 46: call trace

+    CASE 47: call define

+    CASE 48: call set

+    OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer" 

+                          + text (int 1 (actual fn)) ); nil 

+  END SELECT. 

+ 

+call eval cond: 

+  x eval condition (arg 1, alist). 

+ 

+call begin oblist dump: 

+  begin oblist dump; nil. 

+ 

+call next atom: 

+  next atom. 

+ 

+call add property: 

+  add property (arg 3, arg 2, arg 1); arg 1. 

+ 

+call alter property: 

+  alter property (arg 3, arg 2, arg 1); arg 1. 

+ 

+call delete property: 

+  delete property (arg 2, arg 1); nil. 

+ 

+call property exists: 

+  IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI. 

+ 

+call property: 

+  property (arg 2, arg 1). 

+ 

+call add flag: 

+  add flag (arg 2, arg 1); nil. 

+ 

+call flag: 

+  IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI. 

+ 

+call delete flag: 

+  delete flag (arg 2, arg 1); nil. 

+ 

+call begin property list dump: 

+  begin property list dump (arg 1); nil. 

+ 

+call next property: 

+  SYM VAR s1, s2; next property (s1, s2); cons (s1, s2). 

+ 

+call apply: 

+  x apply (arg 3, arg 2, arg 1). 

+ 

+call eval: 

+  x eval (arg 2, arg 1). 

+ 

+call try: 

+  x try (arg 4, arg 3, arg 2, arg 1). 

+ 

+give association list: 

+  alist. 

+ 

+call error stop: 

+  error stop (text (arg 1)); nil. 

+ 

+call head: 

+  head (arg 1). 

+ 

+call set head: 

+  set head (arg 2, arg 1); arg 2. 

+ 

+call tail: 

+  tail (arg 1). 

+ 

+call set tail: 

+  set tail (arg 2, arg 1); arg 2. 

+ 

+call cons: 

+  cons (arg 2, arg 1). 

+ 

+call eq: 

+  IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI. 

+ 

+call get sym: 

+  get (s1); s1. 

+ 

+call put sym: 

+  put (arg 1); arg 1. 

+ 

+call null: 

+  IF null (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call is atom: 

+  IF atom (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call is named atom: 

+  IF is named atom (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call get named atom: 

+  TEXT VAR t; get (t); new atom (t). 

+ 

+call put named atom: 

+  put (name (arg 1)); arg 1. 

+ 

+call is text: 

+  IF is text (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call get text: 

+  get (t); sym (t). 

+ 

+call put text: 

+  put (text (arg 1)); arg 1. 

+ 

+call is character: 

+  IF is character (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call get character: 

+  inchar (t); sym character (code (t)). 

+ 

+call put character: 

+  out (code (character (arg 1))); arg 1. 

+ 

+call is int: 

+  IF is int pair (arg 1) THEN true constant ELSE false constant FI. 

+ 

+call get int: 

+  INT VAR i; get (i); sym (i, -1). 

+ 

+call put int: 

+  put (int 1 (arg 1)); arg 1. 

+ 

+call sum: 

+  sum (arg 1). 

+ 

+call difference: 

+  difference (arg 2, arg 1). 

+ 

+call product: 

+  product (arg 1). 

+ 

+call quotient: 

+  quotient (arg 2, arg 1). 

+ 

+call remainder:

+  remainder(arg 2, arg 1). 

+ 

+call equal:

+  IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI.

+ 

+call trace:

+  trace := NOT trace;

+  IF trace THEN true constant ELSE false constant FI . 

+ 

+call define:     (*hey*) 

+  define (arg 1) . 

+ 

+call set:         (*hey*) 

+  add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 . 

+ 

+arg 1: 

+  tail (head (new alist)). 

+ 

+arg 2: 

+  tail (head (tail (new alist))). 

+ 

+arg 3: 

+  tail (head (tail (tail (new alist)))). 

+ 

+arg 4: 

+  tail (head (tail (tail (tail (new alist))))). 

+ 

+END PROC x apply; 

+ 

+SYM PROC define (SYM CONST x):   (*hey*) 

+  IF   eq (x, nil) THEN nil 

+  ELSE add property (new atom (name (head (head (x)))), 

+                     function constant, tail (head (x)) ); 

+       cons (head (head (x)), define (tail (x)) ) 

+  FI . 

+END PROC define; 

+ 

+SYM VAR old alist :: nil;

+ 

+SYM PROC eval (SYM CONST expression, alist): 

+  enable stop; 

+  initialize constants; 

+  x eval (expression, alist) 

+END PROC eval; 

+ 

+ 

+SYM PROC x eval (SYM CONST expression, alist):   (*hey*)

+  IF trace THEN line;

+    put ("e v a l   :"); put (expression); line;

+    IF NOT equal (alist, old alist) THEN

+    put ("bindings  :"); old alist := alist; put (alist); line FI

+  FI;

+  IF atom (expression) THEN 

+    IF is named atom (expression) THEN 

+      value from property list of expression or from alist entry 

+    ELSE 

+      expression 

+    FI 

+  ELSE 

+    x apply (head (expression), tail (expression), alist) 

+  FI. 

+ 

+value from property list of expression or from alist entry: 

+  IF property exists (expression, apval constant) THEN 

+    value from property list of expression 

+  ELSE 

+    value from alist entry 

+  FI. 

+ 

+value from property list of expression: 

+  property (expression, apval constant). 

+ 

+value from alist entry: 

+  SYM VAR actual alist entry; 

+  begin alist retrieval; 

+  REP 

+    IF end of alist THEN 

+      error stop ("Das Atom " + name (expression) + " hat keinen Wert") 

+    FI; 

+    search for next alist entry 

+  UNTIL eq (head (actual alist entry), expression) PER; 

+  tail (actual alist entry). 

+ 

+END PROC x eval; 

+ 

+ 

+SYM PROC try (SYM CONST expression list, alist, 

+                        error output, break possible): 

+  enable stop; 

+  initialize constants; 

+  x try (expression list, alist, error output, break possible) 

+END PROC try; 

+ 

+ 

+SYM PROC x try (SYM CONST expression list, alist, 

+                          error output, break possible): 

+  BOOL CONST output :: bool (error output), 

+             halt enabled :: bool (break possible); 

+  SYM VAR expr list rest :: expression list; 

+  REP 

+    IF null (expr list rest) THEN 

+      LEAVE x try WITH nil 

+    ELIF atom (expr list rest) THEN 

+      error stop ("Ausdrucksliste fuer 'try' endet falsch") 

+    ELSE 

+      try evaluation of actual expression 

+    FI; 

+    expr list rest := tail (expr list rest) 

+  PER; 

+  nil. 

+ 

+try evaluation of actual expression: 

+  disable stop; 

+  SYM VAR result :: x eval (head (expr list rest), alist); 

+  IF is error THEN 

+    IF error message = "halt from terminal" AND halt enabled THEN 

+      enable stop 

+    ELIF output THEN 

+      put error 

+    FI; 

+    add property (errors, apval constant, sym (error message)); 

+    clear error 

+  ELSE 

+    LEAVE x try WITH result 

+  FI; 

+  enable stop. 

+ 

+END PROC x try; 

+ 

+ 

+SYM PROC x eval condition (SYM CONST pair list, alist): 

+  enable stop; 

+  SYM VAR cond pair list rest :: pair list; 

+  REP 

+    IF atom (cond pair list rest) THEN 

+      error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden") 

+    FI; 

+    check wether is correct pair; 

+    IF true condition found THEN 

+      LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist) 

+    FI; 

+    cond pair list rest := tail (cond pair list rest) 

+  PER; 

+  nil. 

+ 

+check wether is correct pair: 

+  IF atom (actual pair) COR 

+     atom (tail (actual pair)) COR 

+     NOT null (tail (tail (actual pair))) THEN 

+    error stop ("Ungueltiges Paar im bedingten Ausdruck") 

+  FI. 

+ 

+true condition found: 

+  bool (x eval (head (actual pair), alist)). 

+ 

+actual pair: 

+  head (cond pair list rest). 

+ 

+END PROC x eval condition; 

+ 

+ 

+BOOL PROC bool (SYM CONST sym): 

+  IF eq (sym, true constant) THEN 

+    TRUE 

+  ELIF eq (sym, false constant) THEN 

+    FALSE 

+  ELSE 

+    error stop ("'T' oder 'F' erwartet"); TRUE 

+  FI 

+END PROC bool; 

+ 

+ 

+(******* a-list handling refinements used in 'x apply' and 'x eval' *******) 

+ 

+(* declared within 'x apply' and 'x eval': 'actual alist entry'           *) 

+ 

+. 

+ 

+initialize for alist insertion: 

+  new alist := alist. 

+ 

+begin alist retrieval: 

+  SYM VAR actual alist pos :: alist. 

+ 

+search for next alist entry: 

+  WHILE NOT end of alist REP 

+    IF atom (actual alist pos) THEN 

+      error stop ("Bindeliste endet falsch") 

+    FI; 

+    actual alist entry := head (actual alist pos); 

+    actual alist pos := tail (actual alist pos); 

+  UNTIL is non functional alist entry PER. 

+ 

+is non functional alist entry: 

+  NOT is functional alist entry. 

+ 

+search for next functional alist entry: 

+  WHILE NOT end of alist REP 

+    IF atom (actual alist pos) THEN 

+      error stop ("Bindeliste endet falsch") 

+    FI; 

+    actual alist entry := head (actual alist pos); 

+    actual alist pos := tail (actual alist pos); 

+  UNTIL is functional alist entry PER; 

+  actual alist entry := tail (actual alist entry). 

+ 

+is functional alist entry: 

+  check wether is alist entry; 

+  null (head (actual alist entry)). 

+ 

+check wether is alist entry: 

+  IF atom (actual alist entry) THEN 

+    error stop ("Bindelisteneintrag ist kein Paar") 

+  FI. 

+ 

+end of alist: 

+  null (actual alist pos). 

+ 

+actual functional alist entry: 

+  actual alist entry. 

+ 

+prepare new alist entry: 

+  new alist := cons (cons (nil, nil), new alist); 

+  new alist entry := head (new alist). 

+ 

+prepare new functional alist entry: 

+  new alist := cons (cons (nil, cons (nil, nil)), new alist); 

+  new alist entry := tail (head (new alist)). 

+ 

+ 

+END PACKET lisp interpreter; 

+ 

+ 

diff --git a/lang/lisp/1.7.2/src/lisp.bootstrap b/lang/lisp/1.7.2/src/lisp.bootstrap
new file mode 100644
index 0000000..f28aae8
--- /dev/null
+++ b/lang/lisp/1.7.2/src/lisp.bootstrap
@@ -0,0 +1,117 @@
+NIL                      APVAL 

+NIL 

+T                        APVAL 

+T 

+F                        APVAL 

+F 

+COND                     FUNCTION 

+(LAMBDA ((INDEFINITE QUOTE X)) . 0) 

+BEGINOBLISTDUMP        FUNCTION 

+(LAMBDA () . 1) 

+NEXTATOM                FUNCTION 

+(LAMBDA () . 2) 

+ADDPROPERTY             FUNCTION 

+(LAMBDA (X X X) . 3) 

+ALTERPROPERTY           FUNCTION 

+(LAMBDA (X X X) . 4) 

+DELETEPROPERTY          FUNCTION 

+(LAMBDA (X X) . 5) 

+PROPERTYEXISTS          FUNCTION 

+(LAMBDA (X X) . 6) 

+PROPERTY                 FUNCTION 

+(LAMBDA (X X) . 7) 

+ADDFLAG                 FUNCTION 

+(LAMBDA (X X) . 8) 

+FLAG                     FUNCTION 

+(LAMBDA (X X) . 9) 

+DELETEFLAG              FUNCTION 

+(LAMBDA (X X) . 10) 

+BEGINPROPERTYLISTDUMP FUNCTION 

+(LAMBDA (X) . 11) 

+NEXTPROPERTY            FUNCTION 

+(LAMBDA () . 12) 

+APPLY                    FUNCTION 

+(LAMBDA (X X X) . 13) 

+EVAL                     FUNCTION 

+(LAMBDA (X X) . 14) 

+TRY                      FUNCTION 

+(LAMBDA (X X X X) . 15) 

+ASSOCIATIONLIST         FUNCTION 

+(LAMBDA () . 16) 

+ERRORSTOP               FUNCTION 

+(LAMBDA (X) . 17) 

+HEAD                     FUNCTION 

+(LAMBDA (X) . 18) 

+SETHEAD                 FUNCTION 

+(LAMBDA (X X) . 19) 

+TAIL                     FUNCTION 

+(LAMBDA (X) . 20) 

+SETTAIL                 FUNCTION 

+(LAMBDA (X X) . 21) 

+CONS                     FUNCTION 

+(LAMBDA (X X) . 22) 

+EQ                       FUNCTION 

+(LAMBDA (X X) . 23) 

+GET                      FUNCTION 

+(LAMBDA () . 24) 

+PUT                      FUNCTION 

+(LAMBDA (X) . 25) 

+NULL                     FUNCTION 

+(LAMBDA (X) . 26) 

+ATOM                     FUNCTION 

+(LAMBDA (X) . 27) 

+NAMEDATOM               FUNCTION 

+(LAMBDA (X) . 28) 

+GETATOM                 FUNCTION 

+(LAMBDA () . 29) 

+PUTATOM                 FUNCTION 

+(LAMBDA (X) . 30) 

+TEXT                     FUNCTION 

+(LAMBDA (X) . 31) 

+GETTEXT                 FUNCTION 

+(LAMBDA () . 32) 

+PUTTEXT                 FUNCTION 

+(LAMBDA (X) . 33) 

+CHARACTER                FUNCTION 

+(LAMBDA (X) . 34) 

+GETCHARACTER            FUNCTION 

+(LAMBDA () . 35) 

+PUTCHARACTER            FUNCTION 

+(LAMBDA (X) . 36) 

+INT                      FUNCTION 

+(LAMBDA (X). 37) 

+GETINT                  FUNCTION 

+(LAMBDA () . 38) 

+PUTINT                  FUNCTION 

+(LAMBDA (X) . 39) 

+SUM                      FUNCTION 

+(LAMBDA ((INDEFINITE X)) . 40) 

+DIFFERENCE               FUNCTION 

+(LAMBDA (X X). 41) 

+PRODUCT                  FUNCTION 

+(LAMBDA ((INDEFINITE X)). 42) 

+QUOTIENT                 FUNCTION 

+(LAMBDA (X X).43) 

+REMAINDER                FUNCTION 

+(LAMBDA (X X).44) 

+EQUAL                    FUNCTION 

+(LAMBDA (X X) . 45) 

+TRACE                    FUNCTION 

+(LAMBDA () . 46 ) 

+DEFINE                   FUNCTION 

+(LAMBDA ((INDEFINITE X)) . 47 ) 

+SET                      FUNCTION 

+(LAMBDA (X X) . 48 ) 

+QUOTE                    FUNCTION 

+(LAMBDA ((QUOTE X)) X) 

+LIST                     FUNCTION 

+(LAMBDA ((INDEFINITE X)) X) 

+DO                       FUNCTION 

+(LAMBDA ((INDEFINITE X)) NIL) 

+PUTLIST                 FUNCTION 

+(LAMBDA ((INDEFINITE X)) 

+  (COND 

+    ((NULL X) NIL) 

+    (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X)))) 

+  ) 

+) 

diff --git a/doc/lisp/lisp handbuch b/lang/lisp/1.8.7/doc/lisp handbuch
index 022c561..022c561 100644
--- a/doc/lisp/lisp handbuch
+++ b/lang/lisp/1.8.7/doc/lisp handbuch
diff --git a/lang/lisp/1.8.7/source-disk b/lang/lisp/1.8.7/source-disk
new file mode 100644
index 0000000..e61107d
--- /dev/null
+++ b/lang/lisp/1.8.7/source-disk
@@ -0,0 +1 @@
+informatikpaket/01_sprachen.img
diff --git a/lang/lisp/1.8.7/src/"15"TAB2"14" b/lang/lisp/1.8.7/src/"15"TAB2"14"
new file mode 100644
index 0000000..654b374
--- /dev/null
+++ b/lang/lisp/1.8.7/src/"15"TAB2"14"
diff --git a/lisp/lisp.1 b/lang/lisp/1.8.7/src/lisp.1
index 32a9c27..32a9c27 100644
--- a/lisp/lisp.1
+++ b/lang/lisp/1.8.7/src/lisp.1
diff --git a/lisp/lisp.2 b/lang/lisp/1.8.7/src/lisp.2
index 28e6924..28e6924 100644
--- a/lisp/lisp.2
+++ b/lang/lisp/1.8.7/src/lisp.2
diff --git a/lisp/lisp.3 b/lang/lisp/1.8.7/src/lisp.3
index a93463c..a93463c 100644
--- a/lisp/lisp.3
+++ b/lang/lisp/1.8.7/src/lisp.3
diff --git a/lisp/lisp.4 b/lang/lisp/1.8.7/src/lisp.4
index 0733dcd..0733dcd 100644
--- a/lisp/lisp.4
+++ b/lang/lisp/1.8.7/src/lisp.4
diff --git a/lisp/lisp.bootstrap b/lang/lisp/1.8.7/src/lisp.bootstrap
index 37efbde..37efbde 100644
--- a/lisp/lisp.bootstrap
+++ b/lang/lisp/1.8.7/src/lisp.bootstrap
diff --git a/doc/prolog/prolog handbuch b/lang/prolog/1.8.7/doc/prolog handbuch
index ea7c6a5..ea7c6a5 100644
--- a/doc/prolog/prolog handbuch
+++ b/lang/prolog/1.8.7/doc/prolog handbuch
diff --git a/lang/prolog/1.8.7/source-disk b/lang/prolog/1.8.7/source-disk
new file mode 100644
index 0000000..e61107d
--- /dev/null
+++ b/lang/prolog/1.8.7/source-disk
@@ -0,0 +1 @@
+informatikpaket/01_sprachen.img
diff --git a/prolog/calc b/lang/prolog/1.8.7/src/calc
index 0ed11af..0ed11af 100644
--- a/prolog/calc
+++ b/lang/prolog/1.8.7/src/calc
diff --git a/prolog/family b/lang/prolog/1.8.7/src/family
index 8419cc6..8419cc6 100644
--- a/prolog/family
+++ b/lang/prolog/1.8.7/src/family
diff --git a/prolog/permute b/lang/prolog/1.8.7/src/permute
index 54f8fee..54f8fee 100644
--- a/prolog/permute
+++ b/lang/prolog/1.8.7/src/permute
diff --git a/prolog/prieks b/lang/prolog/1.8.7/src/prieks
index 372ec9d..372ec9d 100644
--- a/prolog/prieks
+++ b/lang/prolog/1.8.7/src/prieks
diff --git a/prolog/prolog b/lang/prolog/1.8.7/src/prolog
index 7ac2e6a..7ac2e6a 100644
--- a/prolog/prolog
+++ b/lang/prolog/1.8.7/src/prolog
diff --git a/prolog/prolog installation b/lang/prolog/1.8.7/src/prolog installation
index cc674fa..cc674fa 100644
--- a/prolog/prolog installation
+++ b/lang/prolog/1.8.7/src/prolog installation
diff --git a/prolog/puzzle b/lang/prolog/1.8.7/src/puzzle
index 648beb6..648beb6 100644
--- a/prolog/puzzle
+++ b/lang/prolog/1.8.7/src/puzzle
diff --git a/prolog/quicksort b/lang/prolog/1.8.7/src/quicksort
index 79276c0..79276c0 100644
--- a/prolog/quicksort
+++ b/lang/prolog/1.8.7/src/quicksort
diff --git a/prolog/standard b/lang/prolog/1.8.7/src/standard
index bc983ca..bc983ca 100644
--- a/prolog/standard
+++ b/lang/prolog/1.8.7/src/standard
diff --git a/prolog/sum b/lang/prolog/1.8.7/src/sum
index e1b6b13..e1b6b13 100644
--- a/prolog/sum
+++ b/lang/prolog/1.8.7/src/sum
diff --git a/prolog/thesaurus b/lang/prolog/1.8.7/src/thesaurus
index 4694981..4694981 100644
--- a/prolog/thesaurus
+++ b/lang/prolog/1.8.7/src/thesaurus
diff --git a/prolog/topographie b/lang/prolog/1.8.7/src/topographie
index c0924cf..c0924cf 100644
--- a/prolog/topographie
+++ b/lang/prolog/1.8.7/src/topographie
diff --git a/menugenerator/ls-Menu-Generator 1 b/menugenerator/ls-Menu-Generator 1
deleted file mode 100644
index 4dea777..0000000
--- a/menugenerator/ls-Menu-Generator 1
+++ /dev/null
@@ -1,376 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                 ls-Menu-Generator 1                 ** 
-          **                                                     ** 
-          **                     Version 1.0                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls menu generator 1 DEFINES
-       textprozedur,
-       textzeile:
-LET maxzeilenzahl     =   14,
-    maxzeichenzahl    =   65,
-    zentrierkennung   =  "%",
-    beginmarkkennung  =  "$",
-    endmarkkennung    =  "&",
-    unblockkennung    =  "�",
-    blank             =  " ",
-    dateikennung      = ".a";
-LET dateieintrag      = "#type (""10"")##limit (16.5)#",
-    stdfonttabelle    = "fonttab.ls-Menu-Generator";
-ROW 3 TEXT CONST fehlermeldung :: ROW 3 TEXT : (
-"existiert nicht!",
-
-""15"Text ist zu lang - bitte kürzen! "14"",
-""15"Zeilenformatierung mit <ESC> abgebrochen! "14""
-);
-ROW 6 TEXT CONST hinweis :: ROW 6 TEXT : (
-"Bitte warten ...",
-"Zulässige    Zeilenzahl: ",
-"Tatsächliche Zeilenzahl: ",
-"Textlänge ist in Ordnung!",
-"Textprozedur ist erstellt!",
-"Textzeile ist erstellt!"
-);
-PROC textprozedur (TEXT CONST dateiname, prozedurname):
-  BOOL VAR mit fehler;
-  formatiere (dateiname, mit fehler);
-  IF mit fehler
-     THEN errorstop (fehlermeldung [3])
-  FI;
-
-  bereite den text auf (dateiname);
-  erzeuge textprozedur (dateiname, prozedurname);
-  out (""7""); out (hinweis [5]);
-  last param (dateiname + dateikennung)
-END PROC textprozedur;
-PROC textzeile (TEXT CONST dateiname):
-  BOOL VAR mit fehler;
-  formatiere (dateiname, mit fehler);
-  IF mit fehler
-     THEN errorstop (fehlermeldung [3])
-  FI;
-  bereite den text auf (dateiname);
-  erzeuge textzeile    (dateiname);
-  out (""7""); out (hinweis [6]);
-  last param (dateiname + dateikennung)
-
-END PROC textzeile;
-PROC gib wartehinweis:
-  page;
-  out (hinweis [1])
-END PROC gib wartehinweis;
-PROC formatiere (TEXT CONST dateiname, BOOL VAR mit fehler):
-  TEXT VAR fonttabelle, zeileninhalt;
-  kontrolliere existenz;
-  stelle fonttabelle ein;
-  schreibe font in die datei;
-  zeilenformatierung;
-  entferne ggf font aus der datei;
-  stelle fonttabelle zurueck;
-  streiche restleerzeilen weg;
-  untersuche ggf datei auf korrektheit.
-  kontrolliere existenz:
-    IF NOT exists (dateiname)
-
-       THEN page; errorstop ("'" + dateiname + "' " + fehlermeldung [1])
-    FI.
-  stelle fonttabelle ein:
-    gib wartehinweis;
-    fonttabelle := fonttable;
-    fonttable (stdfonttabelle).
-  schreibe font in die datei:
-    FILE VAR datei :: sequential file (modify, dateiname);
-    to line (datei, 1);
-    insert record (datei);
-    write record (datei, dateieintrag + blank).
-  zeilenformatierung:
-    disable stop;
-    lineform (dateiname);
-    IF is error
-       THEN clear error;
-
-            mit fehler := TRUE
-       ELSE mit fehler := FALSE
-    FI;
-    enable stop.
-  entferne ggf font aus der datei:
-    to line (datei, 1);
-    read record (datei, zeileninhalt);
-    IF pos (zeileninhalt, dateieintrag) > 0
-       THEN delete record (datei)
-    FI.
-  stelle fonttabelle zurueck:
-    fonttable (fonttabelle).
-  streiche restleerzeilen weg:
-    REP
-      streiche ggf letzte zeile
-    UNTIL zeile ist nicht leer PER.
-  streiche ggf letzte zeile:
-    to line (datei, lines (datei));
-
-    read record (datei, zeileninhalt);
-    IF compress (zeileninhalt) = ""
-       THEN delete record (datei)
-    FI.
-  zeile ist nicht leer:
-    compress (zeileninhalt) <> "".
-  untersuche ggf datei auf korrektheit:
-    IF NOT mit fehler
-       THEN untersuche zeilenzahl
-    FI.
-  untersuche zeilenzahl:
-    IF lines (datei) > maxzeilenzahl
-       THEN page;
-            out (hinweis [2] + text (maxzeilenzahl)); line;
-            out (hinweis [3] + text (lines (datei))); line (2);
-            errorstop (fehlermeldung [2])
-
-       ELSE page;
-            out (hinweis [4])
-    FI.
-END PROC formatiere;
-PROC bereite den text auf (TEXT CONST dateiname):
-  INT  VAR zaehler;
-  TEXT VAR zeileninhalt;
-  FILE VAR f :: sequential file (modify, dateiname);
-  gib wartehinweis;
-  vernichte ggf aufbereitete datei;
-  richte datei neu ein;
-  uebertrage die zeilen.
-  vernichte ggf aufbereitete datei:
-    IF exists (dateiname + dateikennung)
-       THEN forget (dateiname + dateikennung, quiet)
-    FI.
-  richte datei neu ein:
-
-    FILE VAR aus :: sequential file (output, dateiname + dateikennung).
-  uebertrage die zeilen:
-    FOR zaehler FROM 1 UPTO lines (f) REP
-      bereite eine zeile auf
-    PER.
-  bereite eine zeile auf:
-    to line (f, zaehler);
-    read record (f, zeileninhalt);
-    ersetze alle gaensefuesschen;
-    haenge ggf absatzmarke an;
-    behandle zeile;
-    putline (aus, zeileninhalt).
-  ersetze alle gaensefuesschen:
-    change all (zeileninhalt, """", "'").
-  haenge ggf absatzmarke an:
-    IF (zeileninhalt SUB (length (zeileninhalt))) = blank
-
-       THEN IF (zeileninhalt SUB 1) <> zentrierkennung
-               THEN zeileninhalt CAT unblockkennung
-            FI
-    FI.
-  behandle zeile:
-    IF   zeile soll zentriert werden
-         THEN zentriere zeile
-    ELIF zeile ist leerzeile
-         THEN kennzeichne leerzeile
-    ELSE blocke zeile auf stdlaenge
-    FI.
-  zeile soll zentriert werden:
-    (zeileninhalt SUB 1) = zentrierkennung.
-  zeile ist leerzeile:
-    compress (zeileninhalt) = "".
-  zentriere zeile:
-    zeileninhalt := subtext (zeileninhalt, 2);
-
-    zeileninhalt := anfangsblanks + zeileninhalt;
-    zeilenabschluss.
-  anfangsblanks:
-    ((maxzeichenzahl - length (zeileninhalt)) DIV 2) * blank.
-  zeilenabschluss:
-    ersetze markierungszeichen;
-    setze 13.
-  ersetze markierungszeichen:
-    change all (zeileninhalt, beginmarkkennung, """15""");
-    change all (zeileninhalt, endmarkkennung,    """14""").
-  setze 13:
-    zeileninhalt CAT " ""13""".
-  kennzeichne leerzeile:
-    zeileninhalt := """13""".
-  blocke zeile auf stdlaenge:
-
-    IF zeile darf nicht geblockt werden
-       THEN ersetze endezeichen
-       ELSE fuehre blockung aus
-    FI.
-  zeile darf nicht geblockt werden:
-    (zeileninhalt SUB length (zeileninhalt)) = unblockkennung.
-  ersetze endezeichen:
-    zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 1);
-    ersetze markierungszeichen;
-    setze 13.
-  fuehre blockung aus:
-    ROW maxzeichenzahl INT VAR leerzeichen;
-    INT VAR gezaehlte blanks, zu verteilende blanks;
-    ordne anfangswerte zu;
-
-    verteile blanks gleichmaessig;
-    verteile blanks zufaellig;
-    baue zeile zusammen;
-    ersetze markierungszeichen;
-    setze 13.
-  ordne anfangswerte zu:
-    bestimme blankanzahl in der zeile;
-    bestimme zu verteilende blanks;
-    initialisiere die reihung.
-  bestimme blankanzahl in der zeile:
-    gezaehlte blanks := 0;
-    INT VAR zeiger;
-    FOR zeiger FROM 1 UPTO length (zeileninhalt) REP
-      IF (zeileninhalt SUB zeiger) = blank
-         THEN gezaehlte blanks INCR 1
-
-      FI
-    PER.
-  bestimme zu verteilende blanks:
-    zu verteilende blanks := maxzeichenzahl - length (zeileninhalt).
-  initialisiere die reihung:
-    FOR zeiger FROM 1 UPTO gezaehlte blanks REP
-      leerzeichen [zeiger] := 1
-    PER.
-  verteile blanks gleichmaessig:
-    WHILE (zu verteilende blanks DIV gezaehlte blanks) > 0 REP
-      schlag je ein blank auf;
-      zu verteilende blanks DECR gezaehlte blanks
-    PER.
-  schlag je ein blank auf:
-    FOR zeiger FROM 1 UPTO gezaehlte blanks REP
-
-      leerzeichen [zeiger] INCR 1
-    PER.
-  verteile blanks zufaellig:
-    FOR zeiger FROM 1 UPTO zu verteilende blanks REP
-      leerzeichen [random (1, gezaehlte blanks)] INCR 1
-    PER.
-  baue zeile zusammen:
-    TEXT VAR zwischen        := zeileninhalt;
-    INT  VAR aktuelles blank := 0;
-    zeileninhalt             := "";
-    FOR zeiger FROM 1 UPTO length (zwischen) REP
-      TEXT VAR aktuelles zeichen :: (zwischen SUB zeiger);
-      IF aktuelles zeichen = blank
-         THEN aktuelles blank INCR 1;
-
-              zeileninhalt CAT (leerzeichen [aktuelles blank] * blank)
-         ELSE zeileninhalt CAT aktuelles zeichen
-      FI
-    PER
-END PROC bereite den text auf;
-PROC erzeuge textprozedur (TEXT CONST dateiname, prozedurname):
-  mache aus den zeilen einzeltexte;
-  entferne ueberfluessige restzeilen;
-  erstelle eine textprozedur.
-  mache aus den zeilen einzeltexte:
-    INT  VAR zeiger;
-    FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
-    FOR zeiger FROM 1 UPTO lines (ausdatei) REP
-
-      bearbeite eine zeile
-    PER.
-  bearbeite eine zeile:
-    TEXT VAR zeileninhalt;
-    to line (ausdatei, zeiger);
-    read record (ausdatei, zeileninhalt);
-    zeileninhalt := """ " + zeileninhalt + """ +";
-    change all (zeileninhalt, "­", "-");
-    write record (ausdatei, zeileninhalt).
-  entferne ueberfluessige restzeilen:
-    REP
-      entferne ggf eine zeile
-    UNTIL zeileninhalt <> """   ""13"""" +" PER;
-    entferne return aus letzter zeile.
-  entferne ggf eine zeile:
-
-    IF compress (zeileninhalt) = """   ""13"""" +"
-       THEN delete record (ausdatei)
-    FI.
-  entferne return aus letzter zeile:
-    to line (ausdatei, lines (ausdatei));
-    read record (ausdatei, zeileninhalt);
-    zeileninhalt := subtext (zeileninhalt, 1, length (zeileninhalt) - 6);
-    write record (ausdatei, zeileninhalt).
-  erstelle eine textprozedur:
-    schreibe procanfang;
-    schreibe procende.
-  schreibe procanfang:
-    to line (ausdatei, 1);
-    insert record (ausdatei);
-
-    write record (ausdatei, "TEXT PROC " + prozedurname + ":").
-  schreibe procende:
-    to line (ausdatei, lines (ausdatei) + 1);
-    insert record (ausdatei);
-    write record (ausdatei, "END PROC " + prozedurname + ";").
-END PROC erzeuge textprozedur;
-PROC erzeuge textzeile (TEXT CONST dateiname):
-  entferne ueberfluessige restzeilen;
-  entferne return aus letzter zeile;
-  erstelle eine textzeile.
-  entferne ueberfluessige restzeilen:
-    TEXT VAR zeileninhalt;
-    INT VAR zeiger;
-
-    FILE VAR ausdatei :: sequential file (modify, dateiname + dateikennung);
-    REP
-      entferne ggf eine zeile
-    UNTIL compress (zeileninhalt) <> """13""" PER.
-  entferne ggf eine zeile:
-    to line (ausdatei, lines (ausdatei));
-    read record (ausdatei, zeileninhalt);
-    IF compress (zeileninhalt) = """13"""
-       THEN delete record (ausdatei)
-    FI.
-  entferne return aus letzter zeile:
-    to line (ausdatei, lines (ausdatei));
-    read record (ausdatei, zeileninhalt);
-    change all (zeileninhalt, """13""", "");
-
-    write record (ausdatei, zeileninhalt).
-  erstelle eine textzeile:
-    haenge die zeilen aneinander;
-    fasse zeile in gaensefuesschen;
-    schreibe einzelzeile in ausgabedatei.
-  haenge die zeilen aneinander:
-    TEXT VAR zeile :: "";
-    FOR zeiger FROM 1 UPTO lines (ausdatei) REP
-      to line (ausdatei, zeiger);
-      read record (ausdatei, zeileninhalt);
-      zeile CAT (" " + zeileninhalt)
-    PER.
-  fasse zeile in gaensefuesschen:
-    zeile := """" + zeile + """";
-    change all (zeile, "­","-").
-
-  schreibe einzelzeile in ausgabedatei:
-    forget (dateiname + dateikennung, quiet);
-    FILE VAR fertig :: sequential file (modify, dateiname + dateikennung);
-    to line (fertig, 1);
-    insert record (fertig);
-    write record (fertig, zeile)
-END PROC erzeuge textzeile;
-END PACKET ls menu generator 1;
-
-
diff --git a/menugenerator/ls-Menu-Generator 2 b/menugenerator/ls-Menu-Generator 2
deleted file mode 100644
index e38fc7e..0000000
--- a/menugenerator/ls-Menu-Generator 2
+++ /dev/null
@@ -1,698 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                 ls-Menu-Generator 2                 ** 
-          **                                                     ** 
-          **                     Version 1.0                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-PACKET ls menu generator 2 DEFINES
-            oeffne menukarte,
-            oeffne menu,
-            oberbegriff,
-            menufunktion,
-            trennlinie,
-            schliesse menu,
-            schliesse menukarte,
-            testinstallation:
-LET menutafeltype         = 1954,
-    kennung               = "ls - Menu - Generator",
-    mm taskname           = "ls-MENUKARTEN",
-    menutafelpraefix      = "ls-MENUKARTE:",
-    menu grundtext        = "ls-MENUBASISTEXTE",
-    zwischenablagename    = "MENU-ZWISCHENABLAGEDATEI INTERN";
-
-LET maxmenus              =    6,
-    maxmenutexte          =  300,
-    maxinfotexte          = 2000,
-    maxhauptmenupunkte    =   10,
-    maxuntermenupunkte    =   15,
-    maxmenubreite         =   71;   (* Breite der Hauptmenüzeile - 2 *)
-LET blank                 =    " ",
-    cleop                 =  ""4"",
-    piep                  =  ""7"",
-    trennzeilensymbol     =  "###",
-    bleibt leer symbol    =  "***",
-    hauptmenuluecke       =  "  ";
-LET dummyname             =  "Dummy für Anwendertexte",
-
-    install finished      =  "Installation abgeschlossen!",
-    card finished         =  "Menukartengenerierung abgeschlossen!",
-    filetype              =  1003;
-TYPE MENUPUNKT   = STRUCT (TEXT punktkuerzel,
-                                punktname,
-                                procname,
-                                boxtext,
-                           BOOL aktiv,
-                                angewaehlt),
-     EINZELMENU  = STRUCT (INT  belegt,
-                           TEXT ueberschrift,
-
-                           INT  anfangsposition,
-                                maxlaenge,
-                           ROW  maxuntermenupunkte MENUPUNKT menupunkt,
-                           INT  aktueller untermenupunkt,
-                           TEXT startprozedurname,
-                                leaveprozedurname),
-     MENU        = STRUCT (TEXT menuname,
-                           INT  anzahl hauptmenupunkte,
-                           ROW  maxhauptmenupunkte EINZELMENU einzelmenu,
-
-                           TEXT menueingangsprozedur,
-                                menuausgangsprozedur,
-                                menuinfo,
-                                lizenznummer,
-                                versionsnummer,
-                           INT  hauptmenuzeiger,
-                                untermenuanfang,
-                                untermenuzeiger),
-     INFOTEXT    = STRUCT (INT anzahl infotexte,
-                           ROW maxinfotexte TEXT stelle),
-
-     MENUTEXT    = STRUCT (INT anzahl menutexte,
-                           ROW maxmenutexte TEXT platz),
-     MENULEISTE  = STRUCT (INT belegt, zeigeraktuell, zeigerhintergrund,
-                           ROW maxmenus MENU menu,
-                           MENUTEXT   menutext,
-                           INFOTEXT   infotext);
-ROW 14 TEXT CONST aussage :: ROW 14 TEXT : (
-"ACHTUNG - Eine Menukarte mit diesem Namen existiert bereits - ACHTUNG",
-"Kann die bereits existierende Menukarte gelöscht werden",
-
-"Dann kann keine neue Menukarte mit diesem Namen erstellt werden!",
-"Zum Weitermachen bitte irgendeine Taste tippen!",
-"Sollen auch Anwendungstexte in die Menukarte aufgenommen werden",
-"Auswahl der Datei, in der die Anwendungstexte stehen.",
-"Bitte die gewünschte Datei ankreuzen!",
-"Durchgang 1 von 2 Durchgängen - in Arbeit ist Zeile: ",
-"Durchgang 2 von 2 Durchgängen - in Arbeit ist Zeile: ",
-"",
-"Einlesen von Texten aus Datei : ",
-"Bearbeitet  wird Menu         : ",
-"Eingetragen wird Oberbegriff  : ",
-
-"Eingetragen wird Menufunktion : "
-);
-ROW 22 TEXT CONST fehlermeldung :: ROW 22 TEXT : (
-"Ohne die Datei '",
-"' "13""10""10"         ist die Menuerstellung "15"unmöglich "14"!!",
-"Hier muß unbedingt eine Datei angekreuzt werden!",
-"Ausgewählte Datei hat falschen Typ (<> 1003) )",
-"Zu viele Anwendungstexte in der Datei ",
-"Anführungszeichen fehlt am Anfang oder Ende der Zeile ",
-"Anführungszeichen fehlt irgendwo in Zeile ",
-"Die angegebene Datei existiert nicht!",
-"Menukarte noch nicht geöffnet ('oeffne menukarte' fehlt)! ",
-
-"Vorausgehendes Menu nicht geschlossen! ",
-"Zu viele Menus in der Menukarte (> " + text (maxmenus) + ")!",
-"Menuname ist mehrfach vorhanden!",
-"Menu noch nicht geoeffnet ('oeffne menu' fehlt)!",
-"Zu viele Oberbegriffe in einem Menu (> " + text (maxhauptmenupunkte) + ")!",
-"Die Kopfzeile ist zu lang (> " + text (maxmenubreite)  + ")!",
-"Menupunkt-Kürzel ist länger als ein Zeichen!",
-"Menupunkt-Kürzel kommt mehrfach vor (nicht eindeutig)!",
-"Menupunkt-Bezeichnung ist zu lang!",
-"Zu viele (> " + text (maxuntermenupunkte) + ") Menupunkte in einem Pull-Down-Menu!",
-
-"Menukarte '",
-"' gibt es nicht in dieser Task!",
-"' hat falsche(n) Typ/Bezeichnung"
-);
-TEXT VAR menuinfotextdateiname,
-         aktueller menudateiname;
-BOOL VAR menuleiste ist bereit :: FALSE,
-         menu ist geoeffnet    :: FALSE;
-BOUND MENULEISTE VAR menuleiste;
-BOUND MENUTEXT   VAR basistexte;
-BOUND MENU       VAR aktuelles menu;
-DATASPACE VAR ds;
-OP := (MENUTEXT VAR ziel, MENUTEXT VAR quelle):
-  INT VAR z;
-  ziel.anzahl menutexte := quelle.anzahl menutexte;
-  FOR z FROM 1 UPTO quelle.anzahl menutexte REP
-
-    ziel.platz [z] := quelle.platz [z]
-  PER
-END OP :=;
-OP := (MENU VAR ziel, MENU CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (EINZELMENU VAR ziel, EINZELMENU CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (MENUPUNKT VAR ziel, MENUPUNKT CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-END OP :=;
-PROC oeffne menukarte (TEXT CONST menukartenname):
-  gib bildschirmhinweis aus;
-  ueberpruefe voraussetzungen;
-  erfrage den namen der datei mit den anwendertexten;
-
-  erstelle neue menuleiste.
-  gib bildschirmhinweis aus:
-    page; out (center (invers (kennung))).
-  ueberpruefe voraussetzungen:
-    ueberpruefe ob basistexte vorhanden sind;
-    ueberpruefe ob menukarte schon vorhanden ist.
-  ueberpruefe ob basistexte vorhanden sind:
-    IF NOT exists (menu grundtext)
-       THEN gib hinweis und brich ab
-    FI.
-  gib hinweis und brich ab:
-    disable stop;
-    fetch (menu grundtext, /mm taskname);
-    IF is error
-       THEN clear error;
-            enable stop;
-
-            cursor (1, 4); out (cleop);
-            errorstop (fehlermeldung [1] + menu grundtext + fehlermeldung [2])
-       ELSE clear error;
-            enable stop
-    FI.
-  ueberpruefe ob menukarte schon vorhanden ist:
-    IF exists (menukarte)
-       THEN gib hinweis auf vorhandene menukarte;
-            frage ob die alte karte geloescht werden darf
-    FI.
-  menukarte:
-    menutafelpraefix + menukartenname.
-  gib hinweis auf vorhandene menukarte:
-    cursor (1, 4); out (cleop);
-
-    cursor (1, 4); out (center (menukarte));
-    cursor (1, 6); out (center (invers (aussage [1]))).
-  frage ob die alte karte geloescht werden darf:
-    cursor (2, 9);
-    IF yes (aussage [2])
-       THEN forget (menukarte, quiet)
-       ELSE weiterarbeit ist unmoeglich
-    FI.
-  weiterarbeit ist unmoeglich:
-    cursor (1, 12); out (center (invers (aussage [3])));
-    cursor (2, 15); out (aussage [4]);
-    cursor (2, 16); pause; page;
-    errorstop ("").
-  erfrage den namen der datei mit den anwendertexten:
-
-    cursor (1, 4); out (cleop);
-    IF yes (aussage [5])
-       THEN biete dateiauswahl an
-       ELSE erzeuge dateidummy
-    FI.
-  biete dateiauswahl an:
-    menuinfotextdateiname := one (2, 6, 77, 19, ALL myself,
-                                  aussage [6], aussage [7]);
-    ueberpruefe den dateinamen;
-    ueberpruefe den dateityp.
-  ueberpruefe den dateinamen:
-    IF compress (menuinfotextdateiname) = ""
-       THEN page; errorstop (fehlermeldung [3])
-    FI.
-  ueberpruefe den dateityp:
-
-    IF datei hat falschen typ
-       THEN page; errorstop (fehlermeldung [4])
-    FI.
-  datei hat falschen typ:
-    ds := old (menuinfotextdateiname);
-    IF type (ds) <> filetype
-       THEN forget (ds); TRUE
-       ELSE forget (ds); FALSE
-    FI.
-  erzeuge dateidummy:
-    forget (dummyname, quiet);
-    FILE VAR datei :: sequential file (modify, dummyname);
-    to line (datei, 1);
-    menuinfotextdateiname := dummyname.
-  erstelle neue menuleiste:
-    INT  VAR zeiger;
-    TEXT VAR zeileninhalt;
-
-    initialisiere werte;
-    aktueller menudateiname  := menukarte;
-    menuleiste               := new (aktueller menudateiname);
-    type (old (aktueller menudateiname), menutafeltype);
-    menuleiste.belegt        := 0;
-    menuleiste ist bereit    := TRUE;
-    trage menubasistexte ein;
-    trage anwendungstexte ein.
-  initialisiere werte:
-    menuleiste ist bereit  := FALSE;
-    menu ist geoeffnet     := FALSE.
-  trage menubasistexte ein:
-    basistexte             := old (menu grundtext);
-
-    menuleiste.menutext    := basistexte.
-  trage anwendungstexte ein:
-    konvertiere (menuinfotextdateiname, zwischenablagename,
-                 menuleiste.infotext.anzahl infotexte);
-    ueberpruefe anwendungstextanzahl;
-    trage anwendungstexte in die menuleiste.
-  ueberpruefe anwendungstextanzahl:
-    IF menuleiste.infotext.anzahl infotexte > maxinfotexte
-       THEN forget (zwischenablagename,      quiet);
-            forget (aktueller menudateiname, quiet);
-            errorstop (fehlermeldung [5] + "'" + menuinfotextdateiname + "'")
-
-    FI.
-  trage anwendungstexte in die menuleiste:
-    gib hinweis auf anwendungstexteintrag;
-    FILE VAR ein :: sequential file (input, zwischenablagename);
-    FOR zeiger FROM 1 UPTO menuleiste.infotext.anzahl infotexte REP
-      getline (ein, zeileninhalt);
-      menuleiste.infotext.stelle [zeiger] := zeileninhalt;
-      cout (zeiger)
-    PER;
-    forget (zwischenablagename, quiet);
-    forget (dummyname         , quiet).
-  gib hinweis auf anwendungstexteintrag:
-    cursor (1, 7); out (aussage [9]).
-
-END PROC oeffne menukarte;
-PROC konvertiere (TEXT CONST eingabedatei, ausgabedatei,
-                  INT  VAR   anzahl konvertierter saetze):
-  loesche ausgabedatei;
-  untersuche eingabedatei;
-  konvertiere saetze.
-  loesche ausgabedatei:
-    IF exists (ausgabedatei)
-       THEN forget (ausgabedatei, quiet)
-    FI.
-  untersuche eingabedatei:
-    IF NOT exists (eingabedatei)
-       THEN errorstop (fehlermeldung [8])
-    FI.
-  konvertiere saetze:
-    gib hinweis;
-    konvertiere satzweise.
-
-  gib hinweis:
-    cursor (1, 4); out (cleop);
-    cursor (1, 4); out (aussage [11] + "'" + eingabedatei + "'");
-    cursor (1, 6); out (aussage [ 8]);
-    anzahl konvertierter saetze := 0.
-  konvertiere satzweise:
-    TEXT VAR zeileninhalt :: "";
-    FILE VAR eingabe :: sequential file (input, eingabedatei);
-    WHILE NOT eof (eingabe) REP
-      behandle eine dateizeile
-    PER;
-    optimiere ausgabedatei.
-  behandle eine dateizeile:
-    getline (eingabe, zeileninhalt);
-    anzahl konvertierter saetze INCR 1;
-
-    cout (anzahl konvertierter saetze);
-    untersuche zeile;
-    wandle die zeile um;
-    FILE VAR aus :: sequential file (output, ausgabedatei);
-    write (aus, textausgabe).
-  untersuche zeile:
-    zeileninhalt := compress (zeileninhalt);
-    IF zeileninhalt = ""
-       THEN zeileninhalt := """"""
-    FI;
-    IF    (zeileninhalt SUB 1)                     <> """"
-       OR (zeileninhalt SUB length (zeileninhalt)) <> """"
-       THEN bereite abgang vor;
-            errorstop (fehlermeldung [6] + text (anzahl konvertierter saetze))
-
-    FI.
-  wandle die zeile um:
-    TEXT VAR textausgabe :: "", codekette;
-    zeileninhalt := subtext (zeileninhalt, 2, length (zeileninhalt) - 1);
-    WHILE gaensefuesschenposition > 0 REP
-        textausgabe CAT subtext (zeileninhalt, 1, gaensefuesschenposition - 1);
-        zeileninhalt := subtext (zeileninhalt, gaensefuesschenposition);
-        codekette    := subtext (zeileninhalt, 1, pos (zeileninhalt, """", 2));
-        IF   codekette =  """7"""
-             THEN textausgabe CAT  ""7""
-
-        ELIF codekette =  """5"""
-             THEN textausgabe CAT  ""5""
-        ELIF codekette =  """4"""
-             THEN textausgabe CAT  ""4""
-        ELIF codekette =  """10"""
-             THEN textausgabe CAT ""10""
-        ELIF codekette = """13"""
-             THEN textausgabe CAT ""13""
-        ELIF codekette = """14"""
-             THEN textausgabe CAT ""14""
-        ELIF codekette = """15"""
-             THEN textausgabe CAT ""15""
-        ELIF codekette = """"""
-             THEN textausgabe CAT """"
-
-        ELSE errorstop (fehlermeldung [7] +
-                        text (anzahl konvertierter saetze))
-        FI;
-        zeileninhalt := subtext (zeileninhalt, 1 + length (codekette))
-      PER;
-      textausgabe CAT zeileninhalt.
-    gaensefuesschenposition:
-      pos (zeileninhalt, """").
-    bereite abgang vor:
-      forget (ausgabedatei, quiet);
-      line (2).
-  optimiere ausgabedatei:
-    FILE VAR ausgabe :: sequential file (modify, ausgabedatei);
-    WHILE lines (ausgabe) > 0 CAND letzter satz ist leer REP
-
-      to line (ausgabe, lines (ausgabe));
-      delete record (ausgabe);
-      anzahl konvertierter saetze DECR 1;
-      cout (anzahl konvertierter saetze )
-    PER.
-  letzter satz ist leer:
-   TEXT VAR satz;
-   to line (ausgabe,lines (ausgabe));
-   read record (ausgabe, satz);
-   IF compress (satz) = "" OR compress (satz) = ""13""
-      THEN TRUE
-      ELSE FALSE
-   FI.
-END PROC konvertiere;
-PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc,
-                             itext, ltext, vtext):
-
-  gib hinweis auf geoeffnetes menu;
-  ueberpruefe auf ungereimtheiten;
-  nimm eintragungen in datenraum vor.
-  gib hinweis auf geoeffnetes menu:
-    cursor (1, 4); out (cleop);
-    out (aussage [12]); out (invers (name));
-    cursor (1, 6).
-  ueberpruefe auf ungereimtheiten:
-    pruefe auf bereits geoeffnete menuliste;
-    pruefe auf noch geoeffnetes menu;
-    pruefe auf noch freie menuplaetze;
-    pruefe auf schon vorhandenen menunamen.
-  pruefe auf bereits geoeffnete menuliste:
-    IF NOT menuleiste ist bereit
-
-       THEN bereinige eintragungen (9)
-    FI.
-  pruefe auf noch geoeffnetes menu:
-    IF menu ist geoeffnet
-       THEN bereinige eintragungen (10)
-    FI.
-  pruefe auf noch freie menuplaetze:
-    IF menuleiste.belegt = maxmenus
-       THEN bereinige eintragungen (11)
-    FI.
-  pruefe auf schon vorhandenen menunamen:
-    IF menuname schon vorhanden
-       THEN bereinige eintragungen (12)
-    FI.
-  menuname schon vorhanden:
-    INT VAR i;
-    FOR i FROM 1 UPTO menuleiste.belegt REP
-
-      untersuche einzelnen menunamen
-    PER;
-    FALSE.
-  untersuche einzelnen menunamen:
-    IF menuleiste.menu [i].menuname = compress (name)
-       THEN LEAVE menuname schon vorhanden WITH TRUE
-    FI.
-  nimm eintragungen in datenraum vor:
-    forget (ds);
-    ds                                  := nilspace;
-    aktuelles menu                      := ds;
-    init (aktuelles menu);
-    aktuelles menu.menuname             := compress (name);
-    aktuelles menu.menueingangsprozedur := compress (einstiegsproc);
-
-    aktuelles menu.menuausgangsprozedur := compress (ausstiegsproc);
-    IF itext <> ""
-        THEN aktuelles menu.menuinfo          := itext;
-             aktuelles menu.lizenznummer      := ltext;
-             aktuelles menu.versionsnummer    := vtext
-        ELSE aktuelles menu.menuinfo          := bleibt leer symbol;
-             aktuelles menu.lizenznummer      := "";
-             aktuelles menu.versionsnummer    := ""
-    FI;
-    menu ist geoeffnet      := TRUE.
-END PROC oeffne menu;
-
-PROC oeffne menu (TEXT CONST name, einstiegsproc, ausstiegsproc):
-  oeffne menu (name, einstiegsproc, ausstiegsproc, "", "", "")
-END PROC oeffne menu;
-PROC oeffne menu (TEXT CONST name):
-  oeffne menu (name, "", "", "", "", "")
-END PROC oeffne menu;
-PROC bereinige eintragungen (INT CONST nummer):
-  forget (ds);
-  forget (aktueller menudateiname, quiet);
-  menuleiste ist bereit := FALSE;
-  menu ist geoeffnet    := FALSE;
-  errorstop (fehlermeldung [nummer])
-END PROC bereinige eintragungen;
-
-PROC init (MENU VAR m):
-  m.menuname                         := "";
-  m.hauptmenuzeiger                  := 1;
-  m.untermenuanfang                  := 0;
-  m.untermenuzeiger                  := 0;
-  m.menueingangsprozedur             := "";
-  m.menuausgangsprozedur             := "";
-  m.menuinfo                         := "";
-  m.versionsnummer                   := "";
-  m.anzahl hauptmenupunkte           := 0;
-  belege hauptmenupunkte.
-  belege hauptmenupunkte:
-    INT VAR i;
-    FOR i FROM 1 UPTO maxhauptmenupunkte REP
-
-      aktuelles einzelmenu.belegt                     :=   0;
-      aktuelles einzelmenu.ueberschrift               :=  "";
-      aktuelles einzelmenu.anfangsposition            :=   0;
-      aktuelles einzelmenu.maxlaenge                  :=   0;
-      aktuelles einzelmenu.aktueller untermenupunkt   :=   1;
-      aktuelles einzelmenu.startprozedurname          :=  "";
-      aktuelles einzelmenu.leaveprozedurname          :=  "";
-      belege untermenuepunkte
-    PER.
-   belege untermenuepunkte:
-
-     INT VAR j;
-     FOR j FROM 1 UPTO maxuntermenupunkte REP
-       aktueller menupunkt.punktkuerzel := "";
-       aktueller menupunkt.punktname    := "";
-       aktueller menupunkt.procname     := "";
-       aktueller menupunkt.boxtext      := "";
-       aktueller menupunkt.aktiv        := TRUE;
-       aktueller menupunkt.angewaehlt   := FALSE
-     PER.
-   aktuelles einzelmenu: m.einzelmenu [i].
-   aktueller menupunkt: aktuelles einzelmenu.menupunkt [j].
-END PROC init;
-PROC oberbegriff (TEXT CONST punktname, startprocname, leaveprocname):
-
-  gib hinweis auf oberbegriff;
-  untersuche ob menu geoeffnet und bereit ist;
-  untersuche oberbegriffe;
-  trage neuen oberbegriff ein;
-  notiere die anfangsposition;
-  notiere start und leaveprozedur;
-  erhoehe die anzahl der oberbegriffe.
-  gib hinweis auf oberbegriff:
-    cursor (1, 6); out (cleop);
-    cursor (1, 6); out (aussage [13]); out (invers (punktname)); line.
-  untersuche ob menu geoeffnet und bereit ist:
-    IF NOT menuleiste ist bereit
-       THEN bereinige eintragungen ( 9)
-
-    FI;
-    IF NOT menu ist geoeffnet
-       THEN bereinige eintragungen (13)
-    FI.
-  untersuche oberbegriffe:
-    IF zu viele oberbegriffe
-       THEN bereinige eintragungen (14)
-    FI;
-    IF gesamtlaenge > maxmenubreite
-       THEN bereinige eintragungen (15)
-    FI.
-  zu viele oberbegriffe:
-    aktuelles menu.anzahl hauptmenupunkte = maxhauptmenupunkte.
-  gesamtlaenge:
-    gesamtlaenge ohne letzten punkt + length (compress (punktname)).
-  gesamtlaenge ohne letzten punkt:
-    length (hauptmenuzeile).
-
-  hauptmenuzeile:
-    INT VAR zaehler;
-    TEXT VAR zeile :: "";
-    schreibe menunamen;
-    schreibe oberbegriffe;
-    zeile.
-  schreibe menunamen:
-    IF aktuelles menu. menuname <> ""
-       THEN zeile CAT aktuelles menu.menuname;
-            zeile CAT ":"
-    FI.
-  schreibe oberbegriffe:
-    FOR zaehler FROM 1 UPTO aktuelles menu.anzahl hauptmenupunkte REP
-      zeile CAT hauptmenuluecke;
-      zeile CAT aktuelles menu. einzelmenu [zaehler].ueberschrift
-    PER;
-    zeile CAT hauptmenuluecke.
-
-  trage neuen oberbegriff ein:
-    neuer menupunkt.ueberschrift     := compress (punktname).
-  notiere die anfangsposition:
-    neuer menupunkt.anfangsposition  := gesamtlaenge ohne letzten punkt + 1.
-  notiere start und leaveprozedur:
-    neuer menupunkt.startprozedurname := compress (startprocname);
-    neuer menupunkt.leaveprozedurname := compress (leaveprocname).
-  neuer menupunkt:
-    aktuelles menu.einzelmenu [aktuelles menu.anzahl hauptmenupunkte + 1].
-  erhoehe die anzahl der oberbegriffe:
-
-    aktuelles menu.anzahl hauptmenupunkte INCR 1.
-END PROC oberbegriff;
-PROC oberbegriff (TEXT CONST punktname):
-  oberbegriff (punktname, "", "")
-END PROC oberbegriff;
-PROC menufunktionseintrag (TEXT CONST kuerzel,
-                                      punktbezeichnung,
-                                      prozedurname,
-                                      infotext,
-                           BOOL CONST ist aktiv):
-  gib hinweis auf menufunktionseintrag;
-  trage menupunkt ein;
-  organisiere menu neu.
-
-  gib hinweis auf menufunktionseintrag:
-    line;
-    out (aussage [14]);
-    out ("'" + kuerzelzeichen  + "' - " + punktname).
-  kuerzelzeichen:
-    IF kuerzel = "" THEN " " ELSE kuerzel FI.
-  punktname:
-    IF punktbezeichnung = trennzeilensymbol
-       THEN "----------"
-       ELSE punktbezeichnung
-    FI.
-  trage menupunkt ein:
-    ueberpruefe das kuerzel;
-    ueberpruefe die punktbreite;
-    ueberpruefe die eintragsnummer;
-    aktuelles menu.einzelmenu [stelle].belegt INCR 1;
-
-    aktueller menupunkt.punktkuerzel  := compress (kuerzel);
-    aktueller menupunkt.punktname     := normierter menupunkt;
-    aktueller menupunkt.procname      := compress (prozedurname);
-    aktueller menupunkt.boxtext       := infotext;
-    aktueller menupunkt.aktiv         := ist aktiv;
-    aktueller menupunkt.angewaehlt    := FALSE.
-  aktueller menupunkt:
-    aktuelles untermenu.menupunkt [aktuelles untermenu.belegt].
-  aktuelles untermenu:
-    aktuelles menu.einzelmenu [stelle].
-
-  stelle:
-    aktuelles menu.anzahl hauptmenupunkte.
-  normierter menupunkt:
-    blank + compress (punktbezeichnung).
-  ueberpruefe das kuerzel:
-    TEXT VAR kurz :: compress (kuerzel);
-    IF   kuerzel ist zu lang
-         THEN bereinige eintragungen (16)
-    ELIF kuerzel ist schon vorhanden
-         THEN bereinige eintragungen (17)
-    FI.
-  kuerzel ist zu lang:
-    length (kurz) > 1.
-  kuerzel ist schon vorhanden:
-    (length (kurz) = 1) AND (pos (vorhandene kuerzel, kurz) > 0).
-
-  vorhandene kuerzel:
-    TEXT VAR liste :: "";
-    INT VAR zeiger;
-    FOR zeiger FROM 1 UPTO aktuelles untermenu.belegt REP
-      liste CAT aktuelles untermenu.menupunkt [zeiger].punktkuerzel
-    PER;
-    liste.
-  ueberpruefe die punktbreite:
-    IF length (compress (punktbezeichnung)) > maxmenubreite - 10
-       THEN bereinige eintragungen (18)
-    FI.
-  ueberpruefe die eintragsnummer:
-    IF aktuelles untermenu.belegt = maxuntermenupunkte
-       THEN bereinige eintragungen (19)
-
-    FI.
-  organisiere menu neu:
-    IF neue punktlaenge > aktuelles untermenu.maxlaenge
-       THEN aktuelles untermenu.maxlaenge := neue punktlaenge
-    FI.
-  neue punktlaenge:
-    length (aktueller menupunkt.punktname).
-END PROC menufunktionseintrag;
-PROC menufunktion (TEXT CONST kuerzel, punktbezeichnung,
-                              prozedurname, infotext):
-  menufunktionseintrag (kuerzel, punktbezeichnung, prozedurname, infotext,
-                        TRUE)
-END PROC menufunktion;
-
-PROC trennlinie:
-  menufunktionseintrag ("", trennzeilensymbol, "", "", FALSE)
-END PROC trennlinie;
-PROC schliesse menu:
-  menuleiste. belegt INCR 1;
-  menuleiste.menu [menuleiste.belegt] := aktuelles menu;
-  menu ist geoeffnet                  := FALSE
-END PROC schliesse menu;
-PROC schliesse menukarte:
-  forget (ds);
-  page; out (piep); put (card finished)
-END PROC schliesse menukarte;
-PROC testinstallation (TEXT CONST kartenname):
-  ueberpruefe menukarte;
-  nimm installation vor.
-
-  ueberpruefe menukarte:
-    IF   NOT exists (kartenname)
-         THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [21])
-    ELIF    (pos (kartenname, menutafelpraefix) <> 1)
-         OR (type (old (kartenname)) <> menutafeltype)
-         THEN errorstop (fehlermeldung [20] + kartenname + fehlermeldung [22])
-    FI.
-  nimm installation vor:
-    TEXT CONST neuer kartenname
-                    :: kartenname + "  von Task '" + name (myself) + "'";
-    command dialogue (FALSE);
-
-    rename (kartenname, neuer kartenname);
-    save (neuer kartenname,task (mmtaskname));
-    forget (neuer kartenname, quiet);
-    reset dialog;
-    install menu (neuer kartenname, FALSE);
-    fetch (neuer kartenname, task (mmtaskname));
-    rename (neuer kartenname, kartenname);
-    command dialogue (TRUE);
-    page; out (piep); put (install finished)
-END PROC testinstallation;
-END PACKET ls menu generator 2;
-
-
diff --git a/menugenerator/ls-Menu-Generator-gen b/menugenerator/ls-Menu-Generator-gen
deleted file mode 100644
index ca26366..0000000
--- a/menugenerator/ls-Menu-Generator-gen
+++ /dev/null
@@ -1,112 +0,0 @@
-(* 
-        
-          ********************************************************* 
-          ********************************************************* 
-          **                                                     ** 
-          **                  ls-Menu-Generator                  ** 
-          **                  GENERATORPROGRAMM                  ** 
-          **                     Version 1.0                     ** 
-          **                                                     ** 
-          **                  (Stand: 30.03.88)                  ** 
-          **                                                     ** 
-          **                                                     ** 
-          **         Autor: Wolfgang Weber, Bielefeld            ** 
-          **                                                     ** 
-          **                                                     ** 
-          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
-          **                                                     ** 
-          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
-          **                                                     ** 
-          ********************************************************* 
-          ********************************************************* 
- 
-                                                                           *) 
- 
-LET mm taskname =  "ls-MENUKARTEN",
-    datei 1     =  "Generatordatei: Archivmenu",
-    datei 2     =  "ls-MENUBASISTEXTE",
-    datei 3     =  "ls-Menu-Generator 1",
-    datei 4     =  "ls-Menu-Generator 2";
-PROC stelle existenz des mm sicher:
-  cursor (1, 5); out (""4"");
-  IF NOT exists (task (mm taskname))
-     THEN errorstop ("Unbedingt erst den 'MENUKARTEN-MANAGER' generieren!");
-  FI
-END PROC stelle existenz des mm sicher;
-PROC vom archiv (TEXT CONST datei):
-  cursor (1,5); out (""4"");
-
-  out ("  """); out (datei); putline (""" wird geholt.");
-  fetch (datei, archive)
-END PROC vom archiv;
-PROC hole (TEXT CONST datei):
-  IF NOT exists (datei) THEN vom archiv (datei) FI
-END PROC hole;
-PROC in (TEXT CONST datei):
-  hole (datei);
-  cursor (1, 5); out (""4"");
-  out ("  """); out (datei); out (""" wird übersetzt: ");
-  insert (datei);
-  forget (datei, quiet);
-END PROC in;
-PROC schicke (TEXT CONST datei):
-  cursor (1, 5); out (""4"");
-  out ("  """); out(datei);
-  out (""" wird zum MENUKARTEN-MANAGER geschickt!");
-
-  command dialogue (FALSE);
-  save (datei, task (mm taskname));
-  command dialogue (TRUE);
-  forget (datei, quiet)
-END PROC schicke;
-INT VAR size, used;
-BOOL VAR einzeln;
-storage (size, used);
-einzeln := size - used < 500;
-forget ("ls-Menu-Generator/gen", quiet);
-wirf kopfzeile aus;
-stelle existenz des mm sicher;
-hole die dateien;
-insertiere die dateien;
-mache global manager aus der task.
-wirf kopfzeile aus:
-  page;
-  putline ("                  "15"ls-Menu-Generator - Automatische Generierung "14"").
-
-hole die dateien:
-  IF     NOT exists (datei 1) COR NOT exists (datei 2)
-     COR NOT exists (datei 3) COR NOT exists (datei 4)
-     THEN hole dateien vom archiv
-  FI.
-hole dateien vom archiv:
-  cursor (1,3);
-  say ("Ist das Archiv angemeldet und die "); line;
-  IF yes ("'ls-Menu-Generator'-Diskette eingelegt")
-     THEN lese ein
-     ELSE line (2);
-          errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
-  FI.
-lese ein:
-  cursor (1, 3); out (""4"");
-  out ("                      "15"Bitte die Diskette eingelegt lassen! "14"");
-
-  IF NOT einzeln
-     THEN hole (datei 1);
-          hole (datei 2);
-          hole (datei 3);
-          hole (datei 4);
-          cursor (1, 3); out(""4"");
-          out ("                     "15"Die Diskette wird nicht mehr benötigt! "14"");
-          release (archive)
-  FI.
-insertiere die dateien:
-  check off;
-  schicke (datei 2);
-  in (datei 3);
-  in (datei 4);
-  IF einzeln THEN release (archive) FI;
-  check on.
-mache global manager aus der task:
-  global manager.
-
-
diff --git a/mp-bap/ls-MP BAP 1 b/mp-bap/ls-MP BAP 1
deleted file mode 100644
index 9fa1a4b..0000000
--- a/mp-bap/ls-MP BAP 1
+++ /dev/null
@@ -1,1346 +0,0 @@
-PACKET ls mp bap 1  DEFINES                (*******************************) 
-                                           (*                             *) 
-       stdvoreinstellung der parameter,    (*         ls-MP BAP 1         *) 
-       werkstueckdefinition,               (*         Version 1.1         *) 
-       tastendefinition,                   (*                             *) 
-       phasendefinition,                   (*   (c) 1987, 1988            *) 
-       bewertungsschluessel,               (*       by Eva Latta-Weber    *) 
-       werkstueckaufhaenger,               (*          Bielefeld          *) 
-       tastenbezeichnung,                  (*                             *) 
-       piepse,                             (*******************************) 
-                                            
-       mp bap einstellung anzeigen,         
-       mp bap standardwerte,                
-       mp bap breite des werkstuecks, 
-       mp bap hoehe  des werkstuecks, 
-       mp bap invers normal, 
-       mp bap zeichensatz, 
-       mp bap fehlerzeichen, 
-       mp bap tastenbelegung, 
-       mp bap anzahl arbeitsphasen, 
-       mp bap dauer einer arbeitsphase, 
-       mp bap pausendauer, 
-       mp bap wertungsschluessel: 
- 
-LET maxspalten         =            70,
-    maxzeilen          =            14,
-    kleinster wert     =             1,
-    oben unten return  = ""3""10""13"",
-    punkt              =           "+",
-    punkt und zurueck  =        "+"8"",
-    piep               =         ""7"",
-    blank              =           " ";
-INT  VAR aktuelle werkstueckbreite,
-         aktuelle werkstueckhoehe,
-         kleinster aktueller zeichencode,
-         groesster aktueller zeichencode,
-         aktuelle anzahl der arbeitsphasen,
-
-         aktuelle arbeitsphasendauer in minuten,
-         aktuelle pausendauer in minuten;
-TEXT VAR aktuelles fehlerzeichen,
-         nach rechts,
-         nach links,
-         nach oben,
-         nach unten,
-         ausbesserung,
-         naechstes;
-BOOL VAR inversdarstellung;
-ROW 11 REAL VAR bewertung;
-WINDOW VAR w1, w2, w3, w4;
-PROC stdvoreinstellung der parameter:
-  aktuelle werkstueckbreite               :=     15;
-  aktuelle werkstueckhoehe                :=     12;
-  kleinster aktueller zeichencode         :=     65;
-
-  groesster aktueller zeichencode         :=     90;
-  aktuelle anzahl der arbeitsphasen       :=      3;
-  aktuelle arbeitsphasendauer in minuten  :=     10;
-  aktuelle pausendauer in minuten         :=      2;
-  aktuelles fehlerzeichen                 :=    "F";
-  nach rechts                             :=  ""2"";
-  nach links                              :=  ""8"";
-  nach oben                               :=  ""3"";
-  nach unten                              := ""10"";
-  ausbesserung                            :=  ""1"";
-
-  naechstes                               := ""27"";
-  inversdarstellung                       :=  FALSE;
-  bewertung := ROW 11 REAL : (0.0, 0.1, 0.2, 0.3, 0.4, 0.5,
-                                   0.6, 0.7, 0.8, 0.9, 1.0)
-END PROC stdvoreinstellung der parameter;
-PROC werkstueckdefinition (INT VAR breite, hoehe, kleinster, groesster,
-                           TEXT VAR fzeichen, BOOL VAR invers):
-  breite        := aktuelle werkstueckbreite;
-  hoehe         := aktuelle werkstueckhoehe;
-
-  kleinster     := kleinster aktueller zeichencode;
-  groesster     := groesster aktueller zeichencode;
-  fzeichen      := aktuelles fehlerzeichen;
-  invers        := inversdarstellung
-END PROC werkstueckdefinition;
-PROC tastendefinition (TEXT VAR rechts, links, hoch, runter, aus, nach):
-  rechts        := nach rechts;
-  links         := nach links;
-  hoch          := nach oben;
-  runter        := nach unten;
-  aus           := ausbesserung;
-  nach          := naechstes
-END PROC tastendefinition;
-
-PROC phasendefinition (INT VAR aphasenzahl, aphasendauer, pausendauer):
-  aphasenzahl   := aktuelle anzahl der arbeitsphasen;
-  aphasendauer  := aktuelle arbeitsphasendauer in minuten;
-  pausendauer   := aktuelle pausendauer in minuten
-END PROC phasendefinition;
-PROC bewertungsschluessel (ROW 11 REAL VAR schluessel):
-  INT VAR zeiger;
-  FOR zeiger FROM 1 UPTO 11 REP
-    schluessel [zeiger] := bewertung [zeiger]
-  PER
-END PROC bewertungsschluessel;
-PROC mp bap einstellung anzeigen:
-  aktuellen parameterzustand anzeigen;
-
-  regenerate menuscreen
-END PROC mp bap einstellung anzeigen;
-PROC mp bap standardwerte:
-  standardwerte einstellen;
-  regenerate menuscreen
-END PROC mp bap standardwerte;
-PROC mp bap breite des werkstuecks:
-  breite des werkstuecks einstellen;
-  regenerate menuscreen
-END PROC mp bap breite des werkstuecks;
-PROC mp bap hoehe des werkstuecks:
-  hoehe des werkstuecks einstellen;
-  regenerate menuscreen
-END PROC mp bap hoehe des werkstuecks;
-PROC mp bap invers normal:
-  werkstueckdarstellung einstellen;
-
-  regenerate menuscreen
-END PROC mp bap invers normal;
-PROC mp bap zeichensatz:
-  zeichensatz einstellen;
-  regenerate menuscreen
-END PROC mp bap zeichensatz;
-PROC mp bap fehlerzeichen:
-  fehlerzeichen veraendern;
-  regenerate menuscreen
-END PROC mp bap fehlerzeichen;
-PROC mp bap tastenbelegung:
-  tastaturbelegung einstellen;
-  regenerate menuscreen
-END PROC mp bap tastenbelegung;
-PROC mp bap anzahl arbeitsphasen:
-  anzahl der arbeitsphasen festlegen;
-  regenerate menuscreen
-END PROC mp bap anzahl arbeitsphasen;
-
-PROC mp bap dauer einer arbeitsphase:
-  dauer einer arbeitsphase festlegen;
-  regenerate menuscreen
-END PROC mp bap dauer einer arbeitsphase;
-PROC mp bap pausendauer:
-  pausendauer festlegen;
-  regenerate menuscreen
-END PROC mp bap pausendauer;
-PROC mp bap wertungsschluessel:
-  wertungsschluessel veraendern;
-  regenerate menuscreen
-END PROC mp bap wertungsschluessel;
-PROC aktuellen parameterzustand anzeigen:
-  zeige die fenster;
-  fuelle die fenster mit inhalt;
-  gib hinweis aus.
-
-  zeige die fenster:
-    w1 := window ( 2,  2, 37, 20);
-    w2 := window (41,  2, 38, 20);
-    w3 := window ( 1,  1, 79, 24);
-    page; show (w1); show (w2).
-  fuelle die fenster mit inhalt:
-    zeige inhalt fenster 1;
-    zeige inhalt fenster 2.
-  zeige inhalt fenster 1:
-    zeige eingestellte parameter an (w1).
-  zeige inhalt fenster 2:
-    gib bewertungsschluessel aus (w2).
-  gib hinweis aus:
-    out footnote (w3, anwendungstext (2)); pause.
-END PROC aktuellen parameterzustand anzeigen;
-
-PROC zeige eingestellte parameter an (WINDOW VAR w):
-  zeige ueberschrift;
-  zeige werkstueckdefinition;
-  zeige tastenbelegung;
-  zeige simulationszeiten.
-  zeige ueberschrift:
-    cursor (w, 1,  1); out (w, center (w, invers (anwendungstext ( 1)))).
-  zeige werkstueckdefinition:
-    cursor (w, 2,  3); out (w, anwendungstext ( 6));
-                       out (w, text (aktuelle werkstueckbreite, 3));
-                       out (w, anwendungstext (28));
-    cursor (w, 2,  4); out (w, anwendungstext ( 7));
-
-                       out (w, text (aktuelle werkstueckhoehe,  3));
-                       out (w, anwendungstext (28));
-    cursor (w, 2,  5); out (w, anwendungstext ( 8));
-                        IF inversdarstellung
-                           THEN out (w, anwendungstext (29))
-                           ELSE out (w, anwendungstext (30))
-                        FI;
-    cursor (w, 2,  6); out (w, anwendungstext ( 9));
-                       out (w, zeichensatz);
-    cursor (w, 2,  7); out (w, anwendungstext (10));
-
-                       out (blank + aktuelles fehlerzeichen).
-  zeige tastenbelegung:
-    cursor (w, 2,  9); out (w, anwendungstext (11));
-                       out (w, tastenbezeichnung (nach rechts));
-    cursor (w, 2, 10); out (w, anwendungstext (12));
-                       out (w, tastenbezeichnung (nach links));
-    cursor (w, 2, 11); out (w, anwendungstext (13));
-                       out (w, tastenbezeichnung (nach oben));
-    cursor (w, 2, 12); out (w, anwendungstext (14));
-                       out (w, tastenbezeichnung (nach unten));
-
-    cursor (w, 2, 13); out (w, anwendungstext (15));
-                       out (w, tastenbezeichnung (ausbesserung));
-    cursor (w, 2, 14); out (w, anwendungstext (16));
-                       out (w, tastenbezeichnung (naechstes)).
-  zeige simulationszeiten:
-    cursor (w, 2, 16); out (w, anwendungstext (17));
-                       out (w, text (aktuelle anzahl der arbeitsphasen, 4));
-    cursor (w, 2, 17); out (w, anwendungstext (18));
-                       out (w, text (aktuelle arbeitsphasendauer in minuten, 4));
-
-                       out (w, anwendungstext (51));
-    cursor (w, 2, 18); out (w, anwendungstext (19));
-                       out (w, text (aktuelle pausendauer in minuten, 4));
-                       out (w, anwendungstext (51));
-    cursor (w, 2, 20); out (w, anwendungstext ( 5));
-                       out (w, gesamtdauerangabe).
-  zeichensatz:
-    blank + code (kleinster aktueller zeichencode) + "..." +
-            code (groesster aktueller zeichencode) + " ("  +
-            text (groesster aktueller zeichencode
-
-                   - kleinster aktueller zeichencode + 1, 2) +
-            anwendungstext (28) + ")".
-  gesamtdauerangabe:
-    text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).
-  arbeitsdauer:
-      aktuelle anzahl der arbeitsphasen
-    * aktuelle arbeitsphasendauer in minuten.
-  pausendauer:
-      (aktuelle anzahl der arbeitsphasen - 1)
-    * aktuelle pausendauer in minuten.
-END PROC zeige eingestellte parameter an;
-PROC gib bewertungsschluessel aus (WINDOW VAR w):
-  zeichne koordinatenkreuz;
-
-  trage messwerte ein.
-  zeichne koordinatenkreuz:
-    cursor (w, 1,  1); out (w, center (w, invers (anwendungstext ( 4))));
-    cursor (w, 2,  3); out (w, anwendungstext (20));
-    cursor (w, 2,  4); out (w, anwendungstext (21));
-    cursor (w, 2,  6); out (w, anwendungstext (23));
-    cursor (w, 2,  7); out (w, anwendungstext (22));
-    cursor (w, 2,  8); out (w, anwendungstext (22));
-    cursor (w, 2,  9); out (w, anwendungstext (22));
-    cursor (w, 2, 10); out (w, anwendungstext (22));
-
-    cursor (w, 2, 11); out (w, anwendungstext (24));
-    cursor (w, 2, 12); out (w, anwendungstext (22));
-    cursor (w, 2, 13); out (w, anwendungstext (22));
-    cursor (w, 2, 14); out (w, anwendungstext (22));
-    cursor (w, 2, 15); out (w, anwendungstext (22));
-    cursor (w, 2, 16); out (w, anwendungstext (25));
-    cursor (w, 2, 17); out (w, anwendungstext (26));
-    cursor (w, 2, 19); out (w, anwendungstext (27)).
-  trage messwerte ein:
-    INT CONST abszisse :: 16, ordinate :: 2;
-
-    INT VAR nr;
-    FOR nr FROM 1 UPTO 11 REP
-      zeichne einen punkt
-    PER.
-  zeichne einen punkt:
-    cursor (w, ordinate + 3 * nr, abszisse - nachkommastelle); out (punkt).
-  nachkommastelle:
-    int(bewertung [nr] * 10.0).
-END PROC gib bewertungsschluessel aus;
-PROC standardwerte einstellen:
-  zeige fenster;
-  zeige eingestellte parameter an (w1);
-  gib information aus;
-  hole bestaetigung ein.
-  zeige fenster:
-    w1 := window ( 2,  2, 37, 20);
-    w2 := window (41, 10, 37, 12);
-
-    w3 := window (41,  2, 37,  6);
-    page; show (w1); show (w2); show (w3).
-  gib information aus:
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3); out (w2, anwendungstext (67));
-    cursor (w2, 2, 4); out (w2, anwendungstext (68));
-    cursor (w2, 2, 7); out (w2, anwendungstext (69));
-    cursor (w2, 2, 9); out (w2, anwendungstext (70));
-    cursor (w2, 2,10); out (w2, anwendungstext (71));
-    cursor (w2, 2,11); out (w2, anwendungstext (72));
-
-    cursor (w2, 2,12); out (w2, anwendungstext (73)).
-  hole bestaetigung ein:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (66))));
-    cursor (w3, 2, 3);
-    IF yes (w3, anwendungstext (66))
-       THEN stdvoreinstellung der parameter;
-            gib positive rueckmeldung
-    FI.
-  gib positive rueckmeldung:
-    page (w1);
-    zeige eingestellte parameter an (w1);
-    cleop  (w3, 2, 3); out (anwendungstext (221));
-    cursor (w3, 2, 5); out (anwendungstext (  3));
-
-    pause.
-END PROC standardwerte einstellen;
-PROC breite des werkstuecks einstellen:
-  zeige die fenster;
-  hinweise an den benutzer ausgeben;
-  werkstueck zeigen (w3);
-  erfrage veraenderung;
-  REP
-    neuen wert vom bildschirm holen
-  UNTIL benutzer ist einverstanden PER.
-  zeige die fenster:
-    w1 := window ( 2, 2, 26, 6);
-    w2 := window (30, 2, 48, 6);
-    w3 := window (2, 9, 77, 16);
-    page; show (w1); show (w2).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-
-    cursor (w1, 2, 3); out (w1, anwendungstext (53));
-                       out (w1, text (kleinster wert, 3));
-    cursor (w1, 2, 4); out (w1, anwendungstext (54));
-                       out (w1, text (maxspalten,     3));
-    cursor (w1, 2, 6); out (w1, anwendungstext (55));
-                       out (w1, text (aktuelle werkstueckbreite, 3)).
-  erfrage veraenderung:
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (57))));
-    cursor (w2, 2, 3);
-    IF no (anwendungstext (216))
-
-       THEN LEAVE breite des werkstuecks einstellen
-    FI.
-  neuen wert vom bildschirm holen:
-    cleop  (w2, 2, 3); out (w2, anwendungstext (58));
-    cursor (w2, 2, 4); out (w2, anwendungstext (59));
-    cursor (w2, 2, 6); out (w2, anwendungstext (60));
-    aktuelle werkstueckbreite := ermittelter wert (1, maxspalten,
-                                                aktuelle werkstueckbreite).
-  benutzer ist einverstanden :
-    gib aktuelle infos aus;
-    hole bestaetigung.
-  gib aktuelle infos aus:
-
-    hinweise an den benutzer ausgeben;
-    werkstueck zeigen (w3);
-    cleop (w2, 1, 3).
-  hole bestaetigung:
-    cursor (w2, 2, 3);
-    IF yes (w2, anwendungstext (62))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC breite des werkstuecks einstellen;
-PROC hoehe des werkstuecks einstellen:
-  fenster zeigen;
-  hinweise an den benutzer ausgeben;
-  werkstueck zeigen (w3);
-  erfrage veraenderung;
-  REP
-    neuen wert vom bildschirm holen
-  UNTIL benutzer ist einverstanden PER.
-
-  fenster zeigen:
-    w1 := window ( 2, 2, 26, 6);
-    w2 := window (30, 2, 48, 6);
-    w3 := window (2, 9, 77, 16);
-    page; show (w1); show (w2).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-    cursor (w1, 2, 3); out (w1, anwendungstext (53));
-                       out (w1, text (kleinster wert, 3));
-    cursor (w1, 2, 4); out (w1, anwendungstext (54));
-                       out (w1, text (maxzeilen,      3));
-    cursor (w1, 2, 6); out (w1, anwendungstext (55));
-
-                       out (w1, text (aktuelle werkstueckhoehe, 3)).
-  erfrage veraenderung:
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (63))));
-    cursor (w2, 2, 3);
-    IF no (anwendungstext (217))
-       THEN LEAVE hoehe des werkstuecks einstellen
-    FI.
-  neuen wert vom bildschirm holen:
-    cleop  (w2, 2, 3); out (w2, anwendungstext (58));
-    cursor (w2, 2, 4); out (w2, anwendungstext (59));
-    cursor (w2, 2, 6); out (w2, anwendungstext (64));
-    aktuelle werkstueckhoehe := ermittelter wert (1, maxzeilen,
-
-                                                  aktuelle werkstueckhoehe).
-  benutzer ist einverstanden :
-    gib aktuelle infos aus;
-    hole bestaetigung.
-  gib aktuelle infos aus:
-    hinweise an den benutzer ausgeben;
-    werkstueck zeigen (w3);
-    cleop (w2, 1, 3).
-  hole bestaetigung:
-    cursor (w2, 2, 3);
-    IF yes (w2, anwendungstext (65))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC hoehe des werkstuecks einstellen;
-PROC werkstueckdarstellung einstellen:
-  fenster zeigen;
-
-  hinweise an den benutzer ausgeben;
-  werkstueck zeigen (w3);
-  REP
-    bestaetigung einholen;
-    hinweise an den benutzer ausgeben;
-    werkstueck zeigen (w3)
-  UNTIL benutzer ist einverstanden PER.
-  fenster zeigen:
-    w1 := window ( 2,  2, 28,  6);
-    w2 := window (32,  2, 46,  6);
-    w3 := window ( 2,  9, 77, 16);
-    page; show (w1); show (w2).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-    cursor (w1, 2, 3); out (w1, anwendungstext (74));
-
-                       out (w1, anwendungstext (76));
-    cursor (w1, 2, 4); out (w1, anwendungstext (74));
-                       out (w1, anwendungstext (77));
-    cursor (w1, 2, 6); out (w1, anwendungstext (75));
-                       IF inversdarstellung
-                          THEN out (w1, anwendungstext (77))
-                          ELSE out (w1, anwendungstext (76))
-                       FI.
-  bestaetigung einholen:
-    page (w2);
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (89))));
-
-    cursor (w2, 2, 3);
-    IF yes (w2, anwendungstext (78))
-       THEN veraendere darstellungsart
-       ELSE LEAVE werkstueckdarstellung einstellen
-    FI.
-  veraendere darstellungsart:
-    IF inversdarstellung
-       THEN inversdarstellung := FALSE
-       ELSE inversdarstellung := TRUE
-    FI.
-  benutzer ist einverstanden:
-    cleop (w2, 1, 3);
-    cursor (w2, 2, 3);
-    IF yes (w2, anwendungstext (99))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC werkstueckdarstellung einstellen;
-
-PROC zeichensatz einstellen:
-  zeige fenster;
-  gib eingestellten zeichensatz an;
-  gib bedienhinweise aus;
-  erfrage neueinstellung;
-  REP
-    erfrage das neue fehlerzeichen;
-    ermittle das kleinste zeichen;
-    ermittle das groesste zeichen;
-    page (w1);
-    gib eingestellten zeichensatz an
-  UNTIL benutzer ist einverstanden PER.
-  zeige fenster:
-    w1 := window ( 2,  2, 28, 22);
-    w2 := window (32, 10, 46, 14);
-    w3 := window (32,  2, 46,  6);
-    page; show (w1); show (w2); show (w3).
-
-  gib eingestellten zeichensatz an:
-    cursor (w1, 1, 1);
-    out (w1, center (w1, invers (anwendungstext (79))));
-    gib zeichenkette aus (w1, kleinster aktueller zeichencode,
-                              groesster aktueller zeichencode,
-                              code (aktuelles fehlerzeichen)).
-  gib bedienhinweise aus:
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3); out (w2, anwendungstext (80));
-    cursor (w2, 2, 4); out (w2, anwendungstext (81));
-
-    cursor (w2, 2, 5); out (w2, anwendungstext (82));
-    cursor (w2, 2, 6); out (w2, anwendungstext (83));
-    cursor (w2, 2, 8); out (w2, anwendungstext (84));
-    cursor (w2, 2, 9); out (w2, anwendungstext (85));
-    cursor (w2, 2,10); out (w2, anwendungstext (86));
-    cursor (w2, 2,12); out (w2, anwendungstext (87));
-    cursor (w2, 2,13); out (w2, anwendungstext (88)).
-  erfrage neueinstellung:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (90))));
-    cursor (w3, 2, 3);
-
-    IF no (w3, anwendungstext (91))
-       THEN LEAVE zeichensatz einstellen
-    FI.
-  erfrage das neue fehlerzeichen:
-    gib vollstaendigen zeichensatz aus;
-    gib fehlerzeicheninformationen aus;
-    REP
-      lasse fehlerzeichen eingeben
-    UNTIL fehlerzeichen ist ok PER.
-  gib vollstaendigen zeichensatz aus:
-    page (w1); page (w2); page (w3);
-    cursor (w1, 1, 1);
-    out (w1, center (w1, invers (anwendungstext (92))));
-    gib zeichenkette aus (w1, 33, 126, 0).
-  gib fehlerzeicheninformationen aus:
-
-    cursor (w2, 1, 1);
-    out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3);  out (w2, anwendungstext (95));
-    cursor (w2, 2, 4);  out (w2, anwendungstext (96));
-    cursor (w2, 2, 6);  out (w2, anwendungstext (97)).
-  lasse fehlerzeichen eingeben:
-    cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (100))));
-    cursor (w3, 2, 3);
-    out (w3, anwendungstext (101));
-    cursor on; inchar (aktuelles fehlerzeichen); cursor off;
-    IF fehlerzeichen ist ok
-
-       THEN out (w3, aktuelles fehlerzeichen);
-            markiere das fehlerzeichen im ersten fenster;
-       ELSE lege beschwerde ein
-    FI.
-  fehlerzeichen ist ok:
-        code (aktuelles fehlerzeichen) >=  33
-    AND code (aktuelles fehlerzeichen) <= 126.
-  markiere das fehlerzeichen im ersten fenster:
-    positioniere cursor in zeichenkette (w1, 33, code (aktuelles fehlerzeichen));
-    out (w1, invers (aktuelles fehlerzeichen)).
-  lege beschwerde ein:
-    piepse;
-    cursor (w2, 2, 8); out (w2, anwendungstext (102));
-
-    cursor (w2, 2,10); out (w2, anwendungstext (103));
-    cursor (w2, 2,11); out (w2, anwendungstext (104));
-    cursor (w2, 2,12); out (w2, anwendungstext (105));
-    cursor (w2, 2,13); out (w2, anwendungstext (106));
-    cursor (w2, 2,14); out (w2, anwendungstext (107)).
-  ermittle das kleinste zeichen:
-    page (w2); page (w3);
-    gib kleinste zeichencode informationen aus;
-    lasse den vorbereich festlegen.
-  ermittle das groesste zeichen:
-    lasse den nachbereich festlegen.
-  gib kleinste zeichencode informationen aus:
-
-    cursor (w2, 1, 1);
-    out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3); out (w2, anwendungstext (111));
-    cursor (w2, 2, 4); out (w2, anwendungstext (112));
-    cursor (w2, 2, 5); out (w2, anwendungstext (113));
-    cursor (w2, 2, 6); out (w2, anwendungstext (114));
-    cursor (w2, 2, 8); out (w2, anwendungstext (115));
-    cursor (w2, 2, 9); out (w2, anwendungstext (116));
-    cursor (w2, 2,10); out (w2, anwendungstext (117));
-    cursor (w2, 2,11); out (w2, anwendungstext (118));
-
-    cursor (w2, 2,13); out (w2, anwendungstext (119));
-    cursor (w2, 2,14); out (w2, anwendungstext (120)).
-  lasse den vorbereich festlegen:
-    INT VAR s, z; page (w3); cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (121))));
-    cursor (w3, 2, 3); out (w3, anwendungstext (122));
-    cursor (w3, 2, 4); out (w3, anwendungstext (123));
-    cursor (w3, 2, 5); out (w3, anwendungstext (125));
-    get cursor (s, z); cursor on;
-    kleinster aktueller zeichencode := code (aktuelles fehlerzeichen);
-
-    groesster aktueller zeichencode := code (aktuelles fehlerzeichen);
-    kleinster aktueller zeichencode := eingabe mit intervallanzeige ( w1, 33,
-                                       code (aktuelles fehlerzeichen),
-                                       kleinster aktueller zeichencode, s, z);
-    cursor off.
-  lasse den nachbereich festlegen:
-    cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (121))));
-    cursor (w3, 2, 3); out (w3, anwendungstext (122));
-    cursor (w3, 2, 4); out (w3, anwendungstext (124));
-
-    cursor (w3, 2, 5); out (w3, anwendungstext (125));
-    get cursor (s, z); cursor on;
-    groesster aktueller zeichencode := eingabe mit intervallanzeige ( w1,
-                                       code (aktuelles fehlerzeichen), 126,
-                                       groesster aktueller zeichencode, s, z);
-    cursor off.
-  benutzer ist einverstanden:
-    page (w3); cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (90))));
-    cursor (w3, 2, 3);
-    IF yes (w3, anwendungstext (126))
-
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC zeichensatz einstellen;
-PROC fehlerzeichen veraendern:
-  fenster zeigen;
-  gib eingestellten zeichensatz an;
-  gib bedienhinweise aus;
-  erfrage neueinstellung;
-  REP
-    lasse fehlerzeichen einstellen
-  UNTIL benutzer ist einverstanden PER.
-  fenster zeigen:
-    w1 := window ( 2,  2, 28, 22);
-    w2 := window (32, 10, 46, 14);
-    w3 := window (32,  2, 46,  6);
-    page; show (w1); show (w2); show (w3).
-  gib eingestellten zeichensatz an:
-
-    cursor (w1, 1, 1);
-    out (w1, center (w1, invers (anwendungstext (79))));
-    gib zeichenkette aus (w1, kleinster aktueller zeichencode,
-                              groesster aktueller zeichencode,
-                              code (aktuelles fehlerzeichen)).
-  gib bedienhinweise aus:
-    cursor (w2, 1, 1);
-    out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3); out (w2, anwendungstext (131));
-    cursor (w2, 2, 4); out (w2, anwendungstext (132));
-    cursor (w2, 2, 5); out (w2, anwendungstext (133));
-
-    cursor (w2, 2, 7); out (w2, anwendungstext (134));
-    cursor (w2, 2, 8); out (w2, anwendungstext (135));
-    cursor (w2, 2, 9); out (w2, anwendungstext (136)).
-  erfrage neueinstellung:
-    cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (130))));
-    cursor (w3, 2, 3);
-    IF no (w3, anwendungstext (137))
-       THEN LEAVE fehlerzeichen veraendern
-    FI.
-  lasse fehlerzeichen einstellen:
-    INT VAR s, z, fehlercode :: code (aktuelles fehlerzeichen);
-    page (w3); cursor (w3, 1, 1);
-
-    out (w3, center (w3, invers (anwendungstext (138))));
-    cursor (w3, 2, 3); out (w3, anwendungstext (139));
-    cursor (w3, 2, 4); out (w3, anwendungstext (140));
-    cursor (w3, 2, 5); out (w3, anwendungstext (141));
-    get cursor (s, z); cursor on;
-    fehlercode := eingabe mit elementanzeige (w1,
-                                              kleinster aktueller zeichencode,
-                                              groesster aktueller zeichencode,
-                                              fehlercode, s, z);
-
-    cursor off;
-    aktuelles fehlerzeichen := code (fehlercode).
-  benutzer ist einverstanden:
-    page (w3); cursor (w3, 1, 1);
-    out (w3, center (w3, invers (anwendungstext (130))));
-    cursor (w3, 2, 3);
-    IF yes (w3, anwendungstext (142))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC fehlerzeichen veraendern;
-PROC tastaturbelegung einstellen:
-  ROW 6 TEXT VAR tastenname, taste;
-  fenster zeigen;
-  REP
-    tastaturneubelegung vornehmen
-  UNTIL benutzer ist einverstanden PER.
-
-  fenster zeigen:
-    w1 := window ( 2,  2, 28, 10);
-    w2 := window ( 2, 14, 28, 10);
-    w3 := window (32, 10, 46, 14);
-    w4 := window (32,  2, 46,  6);
-    page; show (w1); show (w2); show (w3); show (w4).
-  tastaturneubelegung vornehmen:
-    alte tastenbelegung einlesen;
-    tastenbelegung anzeigen;
-    bedienhinweise ausgeben;
-    veraenderung erfragen;
-    neue tastenbelegung erfragen;
-    hinweis zur bewertung und stand ausgeben.
-  alte tastenbelegung einlesen:
-    INT VAR z1;
-
-    FOR z1 FROM 1 UPTO 6 REP
-      tastenname [z1] := anwendungstext (z1 + 10)
-    PER;
-    taste [1] := nach rechts;
-    taste [2] := nach links;
-    taste [3] := nach oben;
-    taste [4] := nach unten;
-    taste [5] := ausbesserung;
-    taste [6] := naechstes;
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (151)))).
-  tastenbelegung anzeigen:
-    INT VAR cspa, czei;
-    cursor (w1, 2, 3); out (w1, tastenname [1]);
-                       out (w1, tastenbezeichnung (taste [1]));
-
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
-    cursor (w1, 2, 4); out (w1, tastenname [2]);
-                       out (w1, tastenbezeichnung (taste [2]));
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
-    cursor (w1, 2, 5); out (w1, tastenname [3]);
-                       out (w1, tastenbezeichnung (taste [3]));
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
-    cursor (w1, 2, 6); out (w1, tastenname [4]);
-
-                       out (w1, tastenbezeichnung (taste [4]));
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
-    cursor (w1, 2, 8); out (w1, tastenname [5]);
-                       out (w1, tastenbezeichnung (taste [5]));
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei);
-    cursor (w1, 2,10); out (w1, tastenname [6]);
-                       out (w1, tastenbezeichnung (taste [6]));
-                       get cursor (w1, cspa, czei); cleol (w1, cspa, czei).
-
-  bedienhinweise ausgeben:
-    cursor (w2, 1, 1); out (center (w2, invers (anwendungstext (152))));
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (52))));
-    cursor (w3, 2, 3); out (w3, anwendungstext (153));
-    cursor (w3, 2, 4); out (w3, anwendungstext (154));
-    cursor (w3, 2, 6); out (w3, anwendungstext (155));
-    cursor (w3, 2, 7); out (w3, anwendungstext (156));
-    cursor (w3, 2, 8); out (w3, anwendungstext (157));
-    cursor (w3, 2, 9); out (w3, anwendungstext (158));
-
-    cursor (w3, 2,11); out (w3, anwendungstext (159));
-    cursor (w3, 2,12); out (w3, anwendungstext (160));
-    cursor (w3, 2,13); out (w3, anwendungstext (161));
-    cursor (w3, 2,14); out (w3, anwendungstext (162)).
-  veraenderung erfragen:
-    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
-    cursor (w4, 2, 3);
-    IF no (w4, anwendungstext (164))
-       THEN LEAVE tastaturbelegung einstellen
-    FI.
-  neue tastenbelegung erfragen:
-    INT VAR z2; page (w4);
-
-    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
-    cursor (w4, 2, 3); out (w4, anwendungstext (165));
-    FOR z2 FROM 1 UPTO 6 REP
-      gib tastenhinweis;
-      hole tastatureingabe;
-      tastenbelegung anzeigen
-    PER.
-  gib tastenhinweis:
-    cleol (w4, 2, 5); out (w4, tastenname [z2]).
-  hole tastatureingabe:
-    INT VAR s, z; get cursor (w4, s, z);
-    cursor on; inchar (taste [z2]); cursor off;
-    cursor (w4, s, z); out (w4, tastenbezeichnung (taste [z2])).
-
-  hinweis zur bewertung und stand ausgeben:
-    IF neue tastenbelegung ist ok
-       THEN akzeptiere
-       ELSE akzeptiere nicht
-    FI.
-  neue tastenbelegung ist ok:
-    INT VAR zeiger; TEXT VAR tastenkette :: "";
-    FOR zeiger FROM 1 UPTO 6 REP
-      IF pos (tastenkette, taste [zeiger]) > 0
-         THEN LEAVE neue tastenbelegung ist ok WITH FALSE
-         ELSE tastenkette CAT taste [zeiger]
-      FI
-    PER;
-    TRUE.
-  akzeptiere:
-    cursor (w2, 3, 4);
-    out (w2, anwendungstext (166));
-
-    cursor (w2, 7, 6);
-    out (w2, anwendungstext (167)).
-  akzeptiere nicht:
-    cursor (w2, 3, 3); out (w2, anwendungstext (168));
-    cursor (w2, 3, 4); out (w2, anwendungstext (169));
-    cursor (w2, 3, 6); out (w2, anwendungstext (170));
-    cursor (w2, 3, 7); out (w2, anwendungstext (171));
-    cursor (w2, 3, 9); out (w2, anwendungstext (172));
-    cursor (w2, 5,10); out (w2, anwendungstext (173)).
-  benutzer ist einverstanden:
-    page (w4);
-    cursor (w4, 1, 1); out (w4, center (w4, invers (anwendungstext (163))));
-
-    IF neue tastenbelegung ist ok
-       THEN gib hinweis auf abspeicherung
-       ELSE frage nach neueingabe
-    FI.
-  gib hinweis auf abspeicherung:
-    cursor (w4, 3, 3); out (w4, anwendungstext (174));
-    neue tastenbelegung festschreiben;
-    cursor (w4, 3, 5); out (w4, anwendungstext (  2));
-    cursor on; pause; cursor off;
-    TRUE.
-  neue tastenbelegung festschreiben:
-    nach rechts   := taste [1];
-    nach links    := taste [2];
-    nach oben     := taste [3];
-    nach unten    := taste [4];
-
-    ausbesserung  := taste [5];
-    naechstes     := taste [6].
-  frage nach neueingabe:
-    cursor (w4, 2, 3);
-    IF yes (w4, anwendungstext (175))
-       THEN cleop (w2, 1, 3); FALSE
-       ELSE alte tastenbelegung einlesen;
-            tastenbelegung anzeigen;
-            cleop  (w4, 2, 3); out (w4, anwendungstext (176));
-            cursor (w4, 3, 5); out (w4, anwendungstext (  2));
-            cursor on; pause; cursor off;
-            TRUE
-    FI.
-END PROC tastaturbelegung einstellen;
-
-PROC simulationszeiten anzeigen (WINDOW VAR w):
-  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (181))));
-  cursor (w, 2, 3); out (w, anwendungstext (17));
-                    out (w, text (aktuelle anzahl der arbeitsphasen, 4));
-  cursor (w, 2, 4); out (w, anwendungstext (18));
-                    out (w, text (aktuelle arbeitsphasendauer in minuten, 4));
-                    out (w, anwendungstext (51));
-  cursor (w, 2, 5); out (w, anwendungstext (19));
-                    out (w, text (aktuelle pausendauer in minuten, 4));
-
-                    out (w, anwendungstext (51));
-  cursor (w, 2, 7); out (w, anwendungstext ( 5));
-                       out (w, gesamtdauerangabe).
-  gesamtdauerangabe:
-    text ( arbeitsdauer + pausendauer, 4) + anwendungstext (51).
-  arbeitsdauer:
-      aktuelle anzahl der arbeitsphasen
-    * aktuelle arbeitsphasendauer in minuten.
-  pausendauer:
-      (aktuelle anzahl der arbeitsphasen - 1)
-    * aktuelle pausendauer in minuten.
-END PROC simulationszeiten anzeigen;
-PROC anzahl der arbeitsphasen festlegen:
-
-  INT CONST minwert :: 2, maxwert :: 20;
-  zeige fenster;
-    hinweise an den benutzer ausgeben;
-    simulationszeiten anzeigen (w2);
-    erfrage veraenderung;
-  REP
-    neuen wert vom bildschirm holen
-  UNTIL benutzer ist einverstanden PER.
-  zeige fenster:
-    w1 := window ( 2,  2, 28,  6);
-    w2 := window (22, 12, 37,  7);
-    w3 := window (32,  2, 47,  6);
-    page; show (w1); show (w2); show (w3).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-
-    cursor (w1, 2, 3); out (w1, anwendungstext (53));
-                       out (w1, text (minwert, 2));
-    cursor (w1, 2, 4); out (w1, anwendungstext (54));
-                       out (w1, text (maxwert, 2));
-    cursor (w1, 2, 6); out (w1, anwendungstext (55));
-                       out (w1, text (aktuelle anzahl der arbeitsphasen, 2)).
-  erfrage veraenderung:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (182))));
-    cursor (w3, 2, 3);
-    IF no (anwendungstext (218))
-
-       THEN LEAVE anzahl der arbeitsphasen festlegen
-    FI.
-  neuen wert vom bildschirm holen:
-    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));
-    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
-    cursor (w3, 2, 6); out (w3, anwendungstext (183));
-    aktuelle anzahl der arbeitsphasen := ermittelter wert (minwert, maxwert,
-                                         aktuelle anzahl der arbeitsphasen).
-  benutzer ist einverstanden:
-    hinweise an den benutzer ausgeben;
-    simulationszeiten anzeigen (w2);
-
-    cleop (w3, 2, 3);
-    IF yes (w3, anwendungstext (184))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC anzahl der arbeitsphasen festlegen;
-PROC dauer einer arbeitsphase festlegen:
-  INT CONST minwert :: 1, maxwert :: 60;
-  zeige fenster;
-  hinweise an den benutzer ausgeben;
-  simulationszeiten anzeigen (w2);
-  erfrage veraenderung;
-  REP
-    neuen wert vom bildschirm holen
-  UNTIL benutzer ist einverstanden PER.
-  zeige fenster:
-    w1 := window ( 2,  2, 28,  6);
-    w2 := window (22, 12, 37,  7);
-
-    w3 := window (32,  2, 47,  6);
-    page; show (w1); show (w2); show (w3).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-    cursor (w1, 2, 3); out (w1, anwendungstext (53));
-                       out (w1, text (minwert, 2));
-                       out (w1, anwendungstext (51));
-    cursor (w1, 2, 4); out (w1, anwendungstext (54));
-                       out (w1, text (maxwert, 2));
-                       out (w1, anwendungstext (51));
-
-    cursor (w1, 2, 6); out (w1, anwendungstext (55));
-                       out (w1, text (aktuelle arbeitsphasendauer in minuten, 2));
-                       out (w1, anwendungstext (51)).
-  erfrage veraenderung:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (187))));
-    cursor (w3, 2, 3);
-    IF no (anwendungstext (219))
-       THEN LEAVE dauer einer arbeitsphase festlegen
-    FI.
-  neuen wert vom bildschirm holen:
-    INT VAR spa, zei;
-    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));
-
-    cursor (w3, 2, 3); out (w3, anwendungstext ( 58));
-    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
-    cursor (w3, 2, 6); out (w3, anwendungstext (188));
-    get cursor (w3, spa, zei);
-    cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));
-    cursor (w3, spa, zei);
-    aktuelle arbeitsphasendauer in minuten
-                               := ermittelter wert (minwert, maxwert,
-                                  aktuelle arbeitsphasendauer in minuten).
-  benutzer ist einverstanden:
-
-    hinweise an den benutzer ausgeben;
-    simulationszeiten anzeigen (w2);
-    cleop (w3, 2, 3);
-    IF yes (w3, anwendungstext (189))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC dauer einer arbeitsphase festlegen;
-PROC pausendauer festlegen:
-  INT CONST minwert :: 1, maxwert :: 30;
-  zeige fenster;
-  hinweise an den benutzer ausgeben;
-  simulationszeiten anzeigen (w2);
-  erfrage veraenderung;
-  REP
-    neuen wert vom bildschirm holen
-  UNTIL benutzer ist einverstanden PER.
-
-  zeige fenster:
-    w1 := window ( 2,  2, 28,  6);
-    w2 := window (22, 12, 37,  7);
-    w3 := window (32,  2, 47,  6);
-    page; show (w1); show (w2); show (w3).
-  hinweise an den benutzer ausgeben:
-    cursor (w1, 1, 1); out (w1, center (w1, invers (anwendungstext (52))));
-    cursor (w1, 2, 3); out (w1, anwendungstext (53));
-                       out (w1, text (minwert, 2));
-                       out (w1, anwendungstext (51));
-    cursor (w1, 2, 4); out (w1, anwendungstext (54));
-
-                       out (w1, text (maxwert, 2));
-                       out (w1, anwendungstext (51));
-    cursor (w1, 2, 6); out (w1, anwendungstext (55));
-                       out (w1, text (aktuelle pausendauer in minuten, 2));
-                       out (w1, anwendungstext (51)).
-  erfrage veraenderung:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (191))));
-    cursor (w3, 2, 3);
-    IF no (anwendungstext (220))
-       THEN LEAVE pausendauer festlegen
-    FI.
-
-  neuen wert vom bildschirm holen:
-    INT VAR spa, zei;
-    cleop  (w3, 2, 3); out (w3, anwendungstext ( 58));
-    cursor (w3, 2, 4); out (w3, anwendungstext ( 59));
-    cursor (w3, 2, 6); out (w3, anwendungstext (192));
-    get cursor (w3, spa, zei);
-    cursor (w3, spa + 3, zei); out (w3, anwendungstext (51));
-    cursor (w3, spa, zei);
-    aktuelle pausendauer in minuten
-                               := ermittelter wert (minwert, maxwert,
-                                          aktuelle pausendauer in minuten).
-
-  benutzer ist einverstanden:
-    hinweise an den benutzer ausgeben;
-    simulationszeiten anzeigen (w2);
-    cleop (w3, 2, 3);
-    IF yes (w3, anwendungstext (193))
-       THEN TRUE
-       ELSE FALSE
-    FI.
-END PROC pausendauer festlegen;
-PROC wertungsschluessel veraendern:
-  INT CONST abszisse :: 16, ordinate :: 2;
-  zeige fenster;
-  gib bewertungsschluessel aus (w1);
-  gib informationen aus;
-  stelle frage nach veraenderung;
-  REP
-    neueinstellung
-  UNTIL benutzer ist einverstanden PER.
-
-  zeige fenster:
-    w1 := window ( 2,  2, 38, 22);
-    w2 := window (42, 10, 37, 14);
-    w3 := window (42,  2, 37,  6);
-    page; show (w1); show (w2); show (w3).
-  gib informationen aus:
-    cursor (w2, 1, 1); out (w2, center (w2, invers (anwendungstext (52))));
-    cursor (w2, 2, 3); out (w2, anwendungstext (195));
-    cursor (w2, 2, 4); out (w2, anwendungstext (196));
-    cursor (w2, 2, 6); out (w2, anwendungstext (197));
-    cursor (w2, 2, 7); out (w2, anwendungstext (198));
-    cursor (w2, 2, 8); out (w2, anwendungstext (199));
-
-    cursor (w2, 2,11); out (w2, anwendungstext (200));
-    cursor (w2, 2,12); out (w2, anwendungstext (201));
-    cursor (w2, 2,13); out (w2, anwendungstext (202)).
-  stelle frage nach veraenderung:
-    cursor (w3, 1, 1); out (w3, center (w3, invers (anwendungstext (205))));
-    cursor (w3, 2, 3);
-    IF no (anwendungstext (206))
-       THEN LEAVE wertungsschluessel veraendern
-       ELSE gib hinweis auf linkes fenster
-    FI.
-  gib hinweis auf linkes fenster:
-    cleop  (w3, 2, 3); out (w3, anwendungstext (211));
-
-    cursor (w3, 2, 4); out (w3, anwendungstext (212));
-    cursor (w3, 2, 5); out (w3, anwendungstext (213)).
-  neueinstellung:
-    INT VAR zeiger;
-    cursor an;
-    FOR zeiger FROM 1 UPTO 11 REP
-      gehe auf aktuelle punktposition;
-      lasse verschieben
-    PER;
-    cursor aus.
-  gehe auf aktuelle punktposition:
-    cursor (w1, ordinate + 3 * zeiger, abszisse - nachkommastelle).
-  nachkommastelle:
-    int (bewertung [zeiger] * 10.0).
-  lasse verschieben:
-    TEXT VAR eingabezeichen; INT VAR position;
-
-    REP
-      inchar (eingabezeichen);
-      position := pos (oben unten return, eingabezeichen);
-      fuehre angemessene reaktion aus
-    UNTIL position = 3 PER.
-  fuehre angemessene reaktion aus:
-    SELECT position OF
-      CASE 1: steige auf
-      CASE 2: steige ab
-      CASE 3: (* tue nichts *)
-      OTHERWISE piepse
-    END SELECT.
-  steige auf:
-    IF bewertung [zeiger] < 1.0
-       THEN loesche alten punkt;
-            bewertung [zeiger] INCR 0.1;
-            schreibe neuen punkt
-
-       ELSE piepse
-    FI.
-  steige ab:
-    IF bewertung [zeiger] > 0.0
-       THEN loesche alten punkt;
-            bewertung [zeiger] DECR 0.1;
-            schreibe neuen punkt
-       ELSE piepse
-    FI.
-  loesche alten punkt:
-    INT VAR tabspalte, tabzeile;
-    gehe auf aktuelle punktposition;
-    get cursor (w1, tabspalte, tabzeile);
-    IF tabspalte = ordinate + 3 OR tabzeile = abszisse
-       THEN out (w1, "|")
-       ELSE out (w1, blank)
-    FI.
-  schreibe neuen punkt:
-    gehe auf aktuelle punktposition;
-
-    out (w1, punkt und zurueck).
-  benutzer ist einverstanden:
-    cleop (w3, 2, 3);
-    IF yes (w3, anwendungstext (207))
-       THEN TRUE
-       ELSE gib hinweis auf linkes fenster;
-            FALSE
-    FI.
-END PROC wertungsschluessel veraendern;
-PROC cleol (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):
-  cursor (w, cursorspalte, cursorzeile);
-  IF remaining lines (w) > 1
-     THEN out (w, (areaxsize (w) - cursorspalte + 1) * blank)
-     ELSE out (w, (areaxsize (w) - cursorspalte) * blank)
-
-  FI;
-  cursor (w, cursorspalte, cursorzeile)
-END PROC cleol;
-PROC cleop (WINDOW VAR w, INT CONST cursorspalte, cursorzeile):
-  cleol (w, cursorspalte, cursorzeile);
-  INT VAR i;
-  FOR i FROM 1 UPTO remaining lines (w) REP
-    cleol (w, 1, cursorzeile + i)
-  PER;
-  cursor  (w, cursorspalte, cursorzeile)
-END PROC cleop;
-PROC cursor an:
-  INT VAR spalte, zeile;
-  get cursor (spalte, zeile); cursor on; cursor (spalte, zeile)
-END PROC cursor an;
-PROC cursor aus:
-  INT VAR spalte, zeile;
-
-  get cursor (spalte, zeile); cursor off; cursor (spalte, zeile)
-END PROC cursor aus;
-INT PROC eingabe mit intervallanzeige (WINDOW VAR w, INT CONST minwert,
-                                       maxwert, anfangswert, cursorspalte,
-                                       cursorzeile):
-  BOOL VAR ist aufsteigend :: minwert = anfangswert;
-  INT  VAR aktueller wert  :: anfangswert, alter wert, eingelesener wert;
-  REP
-    hole position aus vorgabe (oben unten return, eingelesener wert);
-    SELECT eingelesener wert OF
-
-      CASE 1: erniedrige aktuellen wert wenn moeglich
-      CASE 2: erhoehe aktuellen wert wenn moeglich
-    END SELECT
-  UNTIL eingelesener wert = 3 PER;
-  aktueller wert.
-  erniedrige aktuellen wert wenn moeglich:
-    IF aktueller wert > minwert
-       THEN alter wert := aktueller wert;
-            aktueller wert DECR 1;
-            IF ist aufsteigend
-               THEN loesche alte markierung
-               ELSE markiere neues zeichen
-            FI
-       ELSE piepse
-    FI.
-  erhoehe aktuellen wert wenn moeglich:
-
-    IF aktueller wert < maxwert
-       THEN alter wert := aktueller wert;
-            aktueller wert INCR 1;
-            IF ist aufsteigend
-               THEN markiere neues zeichen
-               ELSE loesche alte markierung
-            FI
-       ELSE piepse
-    FI.
-  loesche alte markierung:
-    positioniere cursor in zeichenkette (w, 33, alter wert);
-    out (w, code (alter wert) + "  ");
-    cursor (cursorspalte, cursorzeile).
-  markiere neues zeichen:
-    positioniere cursor in zeichenkette (w, 33, aktueller wert);
-
-    out (w, invers (code (aktueller wert)));
-    cursor (cursorspalte, cursorzeile).
-END PROC eingabe mit intervallanzeige;
-INT PROC eingabe mit elementanzeige (WINDOW VAR w, INT CONST minwert,
-                                     maxwert, anfangswert,
-                                     cursorspalte, cursorzeile):
-  INT VAR aktueller wert :: anfangswert, alter wert, eingelesener wert;
-  REP
-    hole position aus vorgabe (oben unten return, eingelesener wert);
-    SELECT eingelesener wert OF
-
-      CASE 1: erniedrige aktuellen wert wenn moeglich
-      CASE 2: erhoehe aktuellen wert wenn moeglich
-    END SELECT
-  UNTIL eingelesener wert = 3 PER;
-  aktueller wert.
-  erniedrige aktuellen wert wenn moeglich:
-    IF aktueller wert > minwert
-       THEN alter wert := aktueller wert;
-            aktueller wert DECR 1;
-            loesche alte markierung;
-            markiere neues zeichen
-       ELSE piepse
-    FI.
-  erhoehe aktuellen wert wenn moeglich:
-    IF aktueller wert < maxwert
-
-       THEN alter wert := aktueller wert;
-            aktueller wert INCR 1;
-            loesche alte markierung;
-            markiere neues zeichen
-       ELSE piepse
-    FI.
-  loesche alte markierung:
-    positioniere cursor in zeichenkette (w, minwert, alter wert);
-    out (w, code (alter wert) + "  ");
-    cursor (cursorspalte, cursorzeile).
-  markiere neues zeichen:
-    positioniere cursor in zeichenkette (w, minwert, aktueller wert);
-    out (w, invers (code (aktueller wert)));
-
-    cursor (cursorspalte, cursorzeile).
-END PROC eingabe mit elementanzeige;
-PROC werkstueck zeigen (WINDOW VAR w):
-  INT VAR zaehler, spalte, zeile;
-  page (w);
-  werkstueckaufhaenger (spalte, zeile);
-  schreibe werkstueck zeilenweise.
-  schreibe werkstueck zeilenweise:
-    FOR zaehler FROM 1 UPTO aktuelle werkstueckhoehe REP
-      positioniere den cursor;
-      bastle eine zeile;
-      gib eine zeile aus
-    PER.
-  positioniere den cursor:
-    cursor (w, spalte,  zeile + zaehler - 1).
-
-  bastle eine zeile:
-    TEXT VAR zeileninhalt := "";
-    INT VAR z;
-    FOR z FROM 1 UPTO aktuelle werkstueckbreite REP
-      zeileninhalt CAT code (random (kleinster aktueller zeichencode,
-                                     groesster aktueller zeichencode))
-    PER.
-  gib eine zeile aus:
-    IF inversdarstellung
-       THEN out (w, invers (zeileninhalt))
-       ELSE out (w, zeileninhalt)
-    FI.
-END PROC werkstueck zeigen;
-PROC werkstueckaufhaenger (INT VAR spalte, zeile):
-  spalte := ((maxspalten - aktuelle werkstueckbreite) DIV 2) + 3;
-
-  zeile  := ((maxzeilen  - aktuelle werkstueckhoehe ) DIV 2) + 2;
-  IF inversdarstellung THEN spalte DECR 1 FI
-END PROC werkstueckaufhaenger;
-PROC gib zeichenkette aus (WINDOW VAR w,
-                           INT CONST kleinster, groesster, markiertes):
-  INT VAR zaehler;
-  FOR zaehler FROM kleinster UPTO groesster REP
-    positioniere cursor in zeichenkette (w, kleinster, zaehler);
-    IF zaehler = markiertes
-       THEN out (w, invers (code (zaehler)))
-       ELSE out (w, code (zaehler))
-
-    FI
-  PER
-END PROC gib zeichenkette aus;
-PROC positioniere cursor in zeichenkette (WINDOW VAR w,
-                                          INT CONST mincode, position):
-  cursor (w, 4 + ((position - mincode) DIV 19) * 5,
-             3 + ((position - mincode) MOD 19))
-END PROC positioniere cursor in zeichenkette;
-TEXT PROC tastenbezeichnung (TEXT CONST zeichen):
-  IF code (zeichen) >= 33 AND code (zeichen) <= 126
-     THEN "<" + zeichen + ">"
-     ELSE umgesetzter code
-  FI.
-  umgesetzter code:
-
-    SELECT code (zeichen) OF
-      CASE   1: anwendungstext (31)
-      CASE   2: anwendungstext (32)
-      CASE   3: anwendungstext (33)
-      CASE   8: anwendungstext (34)
-      CASE   9: anwendungstext (35)
-      CASE  10: anwendungstext (36)
-      CASE  11: anwendungstext (37)
-      CASE  12: anwendungstext (38)
-      CASE  13: anwendungstext (39)
-      CASE  16: anwendungstext (40)
-      CASE  27: anwendungstext (41)
-      CASE  32: anwendungstext (42)
-      CASE 214: anwendungstext (43)
-
-      CASE 215: anwendungstext (44)
-      CASE 216: anwendungstext (45)
-      CASE 217: anwendungstext (46)
-      CASE 218: anwendungstext (47)
-      CASE 219: anwendungstext (48)
-      CASE 251: anwendungstext (49)
-      OTHERWISE anwendungstext (50)
-  END SELECT
-END PROC tastenbezeichnung;
-INT PROC ermittelter wert (INT CONST minimum, maximum, startwert):
-  INT VAR aktueller wert, eingelesener wert;
-  cursor an;
-  aktueller wert := startwert;
-  REP
-    gib dreistellig aus und positioniere zurueck (aktueller wert, FALSE);
-
-    hole position aus vorgabe (oben unten return, eingelesener wert);
-    SELECT eingelesener wert OF
-      CASE 1: erhoehe aktuellen wert wenn moeglich
-      CASE 2: erniedrige aktuellen wert wenn moeglich
-    END SELECT
-  UNTIL eingelesener wert = 3 PER;
-  cursor aus;
-  aktueller wert.
-  erhoehe aktuellen wert wenn moeglich:
-    IF aktueller wert < maximum
-       THEN aktueller wert INCR 1
-       ELSE piepse
-    FI.
-  erniedrige aktuellen wert wenn moeglich:
-    IF aktueller wert > minimum
-
-       THEN aktueller wert DECR 1
-       ELSE piepse
-    FI.
-END PROC ermittelter wert;
-PROC gib dreistellig aus und positioniere zurueck (INT CONST wert,
-                                                   BOOL CONST mit wertwandel):
-  INT VAR spalte, zeile; get cursor (spalte, zeile);
-  IF mit wertwandel
-     THEN out ("'" + code (wert) + "'")
-     ELSE out (text (wert, 3))
-  FI;
-  cursor (spalte, zeile);
-END PROC gib dreistellig aus und positioniere zurueck;
-PROC hole position aus vorgabe (TEXT CONST vorgabe, INT VAR position):
-
-  TEXT VAR eingabezeichen; INT VAR spa, zei;
-  REP
-    get cursor (spa, zei); inchar (eingabezeichen); cursor (spa, zei);
-    position := pos (vorgabe, eingabezeichen);
-    IF position = 0 THEN piepse; cursor (spa, zei) FI
-  UNTIL position > 0 PER
-END PROC hole position aus vorgabe;
-PROC piepse:
-  INT VAR spa, zei; get cursor (spa, zei); out (piep); cursor (spa, zei)
-END PROC piepse;
-END PACKET ls mp bap 1;
-stdvoreinstellung der parameter
-
-
diff --git a/mp-bap/ls-MP BAP 2 b/mp-bap/ls-MP BAP 2
deleted file mode 100644
index 4ae047c..0000000
--- a/mp-bap/ls-MP BAP 2
+++ /dev/null
@@ -1,1396 +0,0 @@
-PACKET ls mp bap 2  DEFINES                (*******************************) 
-                                           (*                             *) 
-  materialpruefung, mp,                    (*         ls-MP BAP 2         *) 
-  bildschirmarbeitsplatz, bap,             (*         Version 1.1         *) 
-                                           (*                             *) 
-  mp bap simulation ausfuehren,            (*   (c) 1987, 1988            *) 
-  mp bap auswertung auf bildschirm,        (*       by Eva Latta-Weber    *) 
-  mp bap drucken von auswertungen,         (*          Bielefeld          *) 
-                                           (*                             *) 
-  mp bap protokollumfang festlegen,        (*******************************) 
-  mp bap kurzauswertung, 
- 
-  druckereinstellung fuer protokolldatei, 
-  stddruckereinstellung fuer protokolldatei: 
- 
- 
- 
-LET maxeintraege             =                    800, 
-    protokolldateipraefix    =       "ls-Protokoll: ", 
-    menukarte                =  "ls-MENUKARTE:MP-BAP", 
-    menubezeichnung          =                  "BAP", 
-    auswertdateipostfix      =        " - Auswertung", 
-    protokolldateityp        =                   1955, 
-    maxspalten               =                     70, 
-    maxzeilen                =                     14,
-    blank                    =                    " ",
-    trenn                    =                    "|",
-    werkstueckendekennung    =                      1,
-    pausenendekennung        =                      2,
-    simulationsendekennung   =                      3,
-    markierung ein           =                 ""15"",
-    markierung aus           =                " "14"",
-    stdschrifttyp            =                     "",
-
-    stdxstart                =                    0.0,
-    stdystart                =                    0.0,
-    stdfeldbreite            =                   21.0,
-    stdfeldlaenge            =                   29.5;
-LET  KONTROLLTABELLE = STRUCT (INT  letzter eintrag,
-                                    breite, hoehe,
-                                    kleinster code, groesster code,
-                                    anzahl aphasen, aphasendauer,
-                                    pausendauer,
-
-                               TEXT datum, uhrzeit, fehlerzeichen,
-                                    nach rechts, nach links,
-                                    nach oben, nach unten,
-                                    ausbesserung, naechstes,
-                               BOOL inversdarstellung,
-                               ROW  11 REAL bewertung,
-                               ROW maxeintraege KONTROLLE tabelle),
-     KONTROLLE       = STRUCT (INT  eintragskennung,
-                                    produktionsfehler,
-
-                                    anzahl korrekturen,
-                                    anzahl bedienfehler,
-                               REAL anfang, ende, differenz),
-     WERKSTUECK      = ROW maxspalten ROW maxzeilen INT;
-INT  VAR breite, hoehe, kleinster code, groesster code,
-         anzahl aphasen, aphasendauer, pausendauer,
-         eckspalte, eckzeile, x, y, xsize, ysize;
-TEXT VAR fehlerzeichen, nach rechts, nach links, nach oben, nach unten,
-         ausbesserung, naechstes, datum, uhrzeit;
-
-TEXT VAR protokollschrifttyp :: stdschrifttyp;
-REAL VAR xstart              :: stdxstart,
-         ystart              :: stdystart,
-         schreibfeldbreite   :: stdfeldbreite,
-         schreibfeldlaenge   :: stdfeldlaenge;
-ROW 11 REAL VAR bewertung;
-BOOL VAR inversdarstellung,
-         kontrolldatei zur vatertask ::  TRUE,
-         mit kurzprotokoll           ::  TRUE,
-         mit anmerkungen             ::  TRUE,
-         auswertung geht zum drucker :: FALSE;
-WERKSTUECK VAR werkstueck;
-
-PROC bildschirmarbeitsplatz:
-  kontrolldatei zur vatertask := FALSE;
-  install menu (menukarte);
-  handle menu  (menubezeichnung);
-END PROC bildschirmarbeitsplatz;
-PROC bap:
-  bildschirmarbeitsplatz
-END PROC bap;
-PROC materialpruefung:
-  TEXT VAR benutzerkennung :: "", protokollname, alter dateiname :: std;
-  install menu (menukarte, FALSE);
-  kontrolldatei zur vatertask := TRUE;
-  ermittle eingestellte parameter;
-  bereite den bildschirm vor;
-  ermittle die benutzerkennung;
-  gib benutzerhinweise aus;
-
-  arbeitsplatzsimulation ausfuehren (benutzerkennung, protokollname);
-  forget (protokollname, quiet);
-  last param (alter dateiname).
-  bereite den bildschirm vor:
-    WINDOW VAR w :: window ( 2, 10, 77, 14);
-    page;
-    show (w);
-    out (w, center (w, anwendungstext (400))).
-  ermittle die benutzerkennung:
-    benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));
-    IF benutzerkennung = ""
-       THEN cursor on; page;
-            LEAVE materialpruefung
-    FI.
-
-  gib benutzerhinweise aus:
-    boxinfo (w, anwendungstext (402));
-    boxinfo (w, anwendungstext (403));
-    boxinfo (w, anwendungstext (404));
-    gib bedieninformationen aus (2);
-    boxinfo (w, anwendungstext (405));
-    boxinfo (w, anwendungstext (406));
-    boxinfo (w, anwendungstext (407));
-    boxinfo (w, anwendungstext (408)).
-END PROC materialpruefung;
-PROC mp:
-  materialpruefung
-END PROC mp;
-PROC mp bap simulation ausfuehren:
-  TEXT VAR benutzerkennung :: "", dateiname;
-
-  kontrolldatei zur vatertask := FALSE;
-  ermittle eingestellte parameter;
-  bereite den bildschirm vor;
-  ermittle die benutzerkennung;
-  arbeitsplatzsimulation ausfuehren (benutzerkennung, dateiname);
-  regenerate menuscreen.
-  bereite den bildschirm vor:
-    WINDOW VAR w :: window (2,2,77,22);
-    page;
-    out (w, center (w, anwendungstext (399))).
-  ermittle die benutzerkennung:
-    benutzerkennung := compress (boxanswer (w, anwendungstext (401), "", 5));
-    IF benutzerkennung = ""
-
-       THEN regenerate menuscreen;
-            LEAVE mp bap simulation ausfuehren
-    FI.
-END PROC mp bap simulation ausfuehren;
-PROC mp bap auswertung auf bildschirm:
-  auswertung geht zum drucker := FALSE;
-  lasse protokolldateien auswaehlen;
-  werte protokolldateien aus;
-  regenerate menuscreen.
-  lasse protokolldateien auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := infix namen (ALL myself, protokolldateipraefix,
-                                            protokolldateityp);
-
-    IF NOT not empty (verfuegbare)
-       THEN noch kein protokoll
-       ELSE biete auswahl an
-    FI.
-  noch kein protokoll:
-    regenerate menuscreen;
-    menuinfo (anwendungstext (424));
-    LEAVE mp bap auswertung auf bildschirm.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, anwendungstext (421),
-                             anwendungstext (422), FALSE).
-  werte protokolldateien aus:
-    INT VAR k;
-    steige ggf bei leerem thesaurus aus;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              gib hinweis auf auswertung;
-              simulationsauswertung (name (verfuegbare, k), TRUE);
-              forget (name (verfuegbare, k) + auswertdateipostfix, quiet);
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN regenerate menuscreen;
-            menuinfo (anwendungstext (423));
-            LEAVE mp bap auswertung auf bildschirm
-
-    FI.
-  gib hinweis auf auswertung:
-    page;
-    WINDOW VAR fenster :: window ( 2, 2, 77, 22);
-    show (fenster);
-    cursor (fenster, 1,  9); out (fenster, center (fenster, name (verfuegbare, k)));
-    cursor (fenster, 1, 12); out (fenster, center (anwendungstext (274))).
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo (invers (errormessage));
-            clear error; enable stop;
-            LEAVE mp bap auswertung auf bildschirm
-    FI.
-
-END PROC mp bap auswertung auf bildschirm;
-PROC mp bap drucken von auswertungen:
-  auswertung geht zum drucker := TRUE;
-  lasse protokolldateien auswaehlen;
-  werte protokolldateien aus;
-  regenerate menuscreen.
-  lasse protokolldateien auswaehlen:
-    THESAURUS VAR verfuegbare;
-    verfuegbare := infix namen (ALL myself, protokolldateipraefix,
-                                            protokolldateityp);
-    IF NOT not empty (verfuegbare)
-       THEN noch kein protokoll
-       ELSE biete auswahl an
-
-    FI.
-  noch kein protokoll:
-    regenerate menuscreen;
-    menuinfo (anwendungstext (424));
-    LEAVE mp bap drucken von auswertungen.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, anwendungstext (425),
-                             anwendungstext (422), FALSE).
-  werte protokolldateien aus:
-    INT VAR k;
-    steige ggf bei leerem thesaurus aus;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              gib hinweis auf auswertung;
-
-              simulationsauswertung (name (verfuegbare, k), FALSE);
-              print (name (verfuegbare, k) + auswertdateipostfix);
-              forget (name (verfuegbare, k) + auswertdateipostfix, quiet);
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN regenerate menuscreen;
-            menuinfo (anwendungstext (423));
-            LEAVE mp bap drucken von auswertungen
-    FI.
-  gib hinweis auf auswertung:
-
-    page;
-    WINDOW VAR fenster :: window ( 2, 2, 77, 22);
-    show (fenster);
-    cursor (fenster, 1,  9); out (fenster, center (fenster, name (verfuegbare, k)));
-    cursor (fenster, 1, 12); out (fenster, center (anwendungstext (270))).
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo (invers (errormessage));
-            clear error; enable stop;
-            LEAVE mp bap drucken von auswertungen
-    FI.
-END PROC mp bap drucken von auswertungen;
-
-PROC mp bap protokollumfang festlegen:
-  page;
-  zeige aktuellen protokollumfang an;
-  gib erlaeuterungen zum protokollumfang;
-  frage nach umfangsaenderung;
-  regenerate menuscreen
-END PROC mp bap protokollumfang festlegen;
-PROC mp bap kurzauswertung:
-  page;
-  zeige aktuelle kurzauswertungseinstellung an;
-  gib erlaeuterungen zur kurzauswertung;
-  frage nach kurzauswertungsaenderung;
-  regenerate menuscreen
-END PROC mp bap kurzauswertung;
-PROC druckereinstellung fuer protokolldatei (TEXT CONST schrifttyp,
-
-                                             REAL CONST linker rand,
-                                                        oberer rand,
-                                                        feldbreite,
-                                                        feldlaenge):
-  protokollschrifttyp := schrifttyp;
-  xstart              := linker rand;
-  ystart              := oberer rand;
-  schreibfeldbreite   := feldbreite;
-  schreibfeldlaenge   := feldlaenge;
-END PROC druckereinstellung fuer protokolldatei;
-
-PROC stddruckereinstellung fuer protokolldatei:
-  protokollschrifttyp := stdschrifttyp;
-  xstart              := stdxstart;
-  ystart              := stdystart;
-  schreibfeldbreite   := stdfeldbreite;
-  schreibfeldlaenge   := stdfeldlaenge
-END PROC stddruckereinstellung fuer protokolldatei;
-                 (********************************)
-PROC arbeitsplatzsimulation ausfuehren (TEXT CONST kennung,
-                                        TEXT VAR   dateiname):
-  ermittle eingestellte parameter;
-
-  lege datei mit kennung an (kennung, dateiname);
-  cursor on;
-  fuehre simulation durch (dateiname);
-  schicke ggf protokolldatei zur vatertask;
-  gib ggf kurzprotokoll aus.
-  schicke ggf protokolldatei zur vatertask:
-    IF kontrolldatei zur vatertask
-       THEN command dialogue (FALSE);
-            save (dateiname);
-            command dialogue (TRUE)
-    FI.
-  gib ggf kurzprotokoll aus:
-    IF mit kurzprotokoll
-       THEN kurzauswertung auf bildschirm (dateiname)
-       ELSE page; put (anwendungstext (271))
-
-    FI.
-END PROC arbeitsplatzsimulation ausfuehren;
-PROC ermittle eingestellte parameter:
-  werkstueckdefinition (breite, hoehe, kleinster code, groesster code,
-                        fehlerzeichen, inversdarstellung);
-  tastendefinition     (nach rechts, nach links, nach oben, nach unten,
-                        ausbesserung, naechstes);
-  phasendefinition     (anzahl aphasen, aphasendauer, pausendauer);
-  bewertungsschluessel (bewertung);
-END PROC ermittle eingestellte parameter;
-PROC lege datei mit kennung an (TEXT CONST kennung, TEXT VAR datname):
-
-  BOUND KONTROLLTABELLE VAR tab;
-  TEXT VAR interner name :: protokolldateipraefix;
-  interner name CAT kennung;
-  lege neue datei an;
-  type (old (datname), protokolldateityp).
-  lege neue datei an:
-    INT VAR i :: 0; TEXT VAR bezeichnung;
-    REP
-      i INCR 1;
-      bezeichnung := interner name + " /" + text (i)
-    UNTIL NOT exists (bezeichnung) PER;
-    tab := new (bezeichnung);
-    initialisiere tabelle;
-    datname := bezeichnung.
-  initialisiere tabelle:
-    tab.letzter eintrag := 0.
-
-END PROC lege datei mit kennung an;
-PROC fuehre simulation durch (TEXT CONST dateiname):
-  BOUND KONTROLLTABELLE VAR tab :: old (dateiname);
-  TEXT CONST moegliche eingabezeichen :: nach rechts  + nach links +
-                                         nach oben    + nach unten +
-                                         ausbesserung + naechstes;
-  treffe vorbereitungen;
-  trage grunddaten in tabelle;
-  simuliere.
-  treffe vorbereitungen:
-     initialisierungen;
-     WINDOW VAR fenster :: window (  1,  9, 79, 16);
-
-     page;
-     gib bedieninformationen aus (2);
-     werkstueckaufhaenger (eckspalte, eckzeile);
-     weise auf arbeitsbeginn hin;
-     beginn der arbeitsphase      :=               clock (1);
-     beginn der bearbeitung       := beginn der arbeitsphase;
-     arbeitsphasenlaenge          := real (aphasendauer * 60).
-  initialisierungen:
-    INT  VAR eintragzaehler        :: 0,
-             arbeitsphasenzaehler  :: 1,
-             werkstueckzaehler     :: 0,
-             bedienfehlerzaehler   :: 0,
-
-             korrekturzaehler      :: 0,
-             produktionsfehler,
-             cursorspalte relativ,
-             cursorzeile  relativ;
-    REAL VAR beginn der arbeitsphase,
-             beginn der bearbeitung,
-             arbeitsphasenlaenge,
-             arbeitsphasenueberziehung,
-             pausenueberziehung.
-  weise auf arbeitsbeginn hin:
-    page (fenster);
-    boxinfo (fenster, anwendungstext (252), 5, maxint);
-    clear buffer.
-  trage grunddaten in tabelle:
-    tab.datum               := date;
-
-    tab.uhrzeit             := time of day;
-    tab.breite              := breite;
-    tab.hoehe               := hoehe;
-    tab.kleinster code      := kleinster code;
-    tab.groesster code      := groesster code;
-    tab.anzahl aphasen      := anzahl aphasen;
-    tab.aphasendauer        := aphasendauer;
-    tab.pausendauer         := pausendauer;
-    tab.fehlerzeichen       := fehlerzeichen;
-    tab.nach rechts         := nach rechts;
-    tab.nach links          := nach links;
-    tab.nach oben           := nach oben;
-
-    tab.nach unten          := nach unten;
-    tab.ausbesserung        := ausbesserung;
-    tab.naechstes           := naechstes;
-    tab.inversdarstellung   := inversdarstellung;
-    tab.bewertung           := bewertung;
-    eintragzaehler          := 1.
-  simuliere:
-    REP
-      gib holehinweis;
-      hole werkstueck  (werkstueck, produktionsfehler);
-      zeige werkstueck (werkstueck, fenster);
-      lasse werkstueck bearbeiten
-    UNTIL simulationsende erreicht PER.
-  gib holehinweis:
-
-    page (fenster);
-    cursor (fenster, 2, 3); out (fenster, anwendungstext (253)).
-  lasse werkstueck bearbeiten:
-    initialisiere den relativcursor;
-    setze cursor;
-    clear buffer;
-    bearbeite das werkstueck.
-  initialisiere den relativcursor:
-    cursorspalte relativ := 1;
-    cursorzeile relativ  := 1.
-  setze cursor:
-    IF inversdarstellung
-       THEN cursor (fenster, eckspalte + cursorspalte relativ,
-                             eckzeile  + cursorzeile  relativ - 1);
-
-       ELSE cursor (fenster, eckspalte + cursorspalte relativ - 1,
-                             eckzeile  + cursorzeile  relativ - 1);
-    FI.
-  bearbeite das werkstueck:
-    BOOL VAR werkstueck voll bearbeitet :: FALSE;
-    REP
-      hole eingabe und werte aus
-    UNTIL werkstueck voll bearbeitet PER.
-  hole eingabe und werte aus:
-    TEXT VAR eingabezeichen := incharety (100);
-    SELECT eingabezeichenposition OF
-      CASE 1: wenn moeglich nach rechts
-      CASE 2: wenn moeglich nach links
-
-      CASE 3: wenn moeglich nach oben
-      CASE 4: wenn moeglich nach unten
-      CASE 5: wenn moeglich ausbessern
-      CASE 6: beende werkstueckbearbeitung
-      OTHERWISE entscheide ob gepiepst wird
-    END SELECT.
-  eingabezeichenposition:
-    pos (moegliche eingabezeichen, eingabezeichen).
-  wenn moeglich nach rechts:
-    IF cursorspalte relativ < breite
-       THEN cursorspalte relativ INCR 1;
-            setze cursor
-       ELSE registriere bedienfehler
-    FI.
-  wenn moeglich nach links:
-
-    IF cursorspalte relativ > 1
-       THEN cursorspalte relativ DECR 1;
-            setze cursor
-       ELSE registriere bedienfehler
-    FI.
-  wenn moeglich nach oben:
-    IF cursorzeile relativ > 1
-       THEN cursorzeile relativ DECR 1;
-            setze cursor
-       ELSE registriere bedienfehler
-    FI.
-  wenn moeglich nach unten:
-    IF cursorzeile relativ < hoehe
-       THEN cursorzeile relativ INCR 1;
-            setze cursor
-       ELSE registriere bedienfehler
-    FI.
-
-  wenn moeglich ausbessern:
-    IF werkstueck [cursorspalte relativ][cursorzeile relativ] = code (fehlerzeichen)
-       THEN werkstueck [cursorspalte relativ][cursorzeile relativ] := code (blank);
-            korrekturzaehler INCR 1;
-            get cursor (fenster, x, y);
-            out (fenster, blank);
-            cursor (fenster, x, y);
-       ELSE registriere bedienfehler
-    FI.
-  registriere bedienfehler:
-    piepse; bedienfehlerzaehler INCR 1.
-  entscheide ob gepiepst wird:
-    IF eingabezeichen <> "" THEN piepse FI.
-
-  beende werkstueckbearbeitung:
-    IF   simulationsende erreicht
-         THEN trage simulationsende in tabelle ein
-    ELIF arbeitsphasenende erreicht
-         THEN trage werkstueckdaten in tabelle ein;
-              ermittle ueberziehung der arbeitsphase;
-              lege eine pause ein
-    ELSE trage werkstueckdaten in tabelle ein
-    FI;
-    werkstueck voll bearbeitet := TRUE.
-  lege eine pause ein:
-    nimm pausendaten;
-    weise auf pausenanfang hin;
-    pausiere;
-    weise auf pausenende hin;
-
-    registriere pausenueberziehung.
-  nimm pausendaten:
-    REAL VAR pausenanfang :: clock (1),
-             pausenende   :: pausenanfang + real (pausendauer * 60);.
-  weise auf pausenanfang hin:
-    page (fenster);
-    boxnotice (fenster, anwendungstext (255), 5, x, y, xsize, ysize).
-  pausiere:
-    REP
-      pause (int ((pausenende - clock (1)) * 10.0))
-    UNTIL clock (1) >= pausenende PER.
-  weise auf pausenende hin:
-    page (fenster);
-    pausenanfang := clock (1);
-    piepse;
-
-    clear buffer;
-    boxinfo (fenster, anwendungstext (256), 5, maxint);
-    pausenende   := clock (1).
-  registriere pausenueberziehung:
-    pausenueberziehung := pausenende - pausenanfang;
-    trage pausenueberziehung in tabelle ein.
-  trage werkstueckdaten in tabelle ein:
-    REAL VAR bearbeitungsende :: clock (1);
-    tab.tabelle [eintragzaehler].eintragskennung    := werkstueckendekennung;
-    tab.tabelle [eintragzaehler].produktionsfehler  := produktionsfehler;
-    tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;
-
-    tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;
-    tab.tabelle [eintragzaehler].anfang             := beginn der bearbeitung;
-    tab.tabelle [eintragzaehler].ende               := bearbeitungsende;
-    tab.tabelle [eintragzaehler].differenz          := bearbeitungszeit;
-    erhoehe eintragzaehler;
-    beginn der bearbeitung := clock (1);
-    werkstueckzaehler INCR 1;
-    bedienfehlerzaehler := 0;
-    korrekturzaehler    := 0.
-  trage pausenueberziehung in tabelle ein:
-
-    tab.tabelle [eintragzaehler].eintragskennung    := pausenendekennung;
-    tab.tabelle [eintragzaehler].produktionsfehler  := 0;
-    tab.tabelle [eintragzaehler].anzahl korrekturen := 0;
-    tab.tabelle [eintragzaehler].anzahl bedienfehler:= 0;
-    tab.tabelle [eintragzaehler].anfang             := pausenanfang;
-    tab.tabelle [eintragzaehler].ende               := pausenende;
-    tab.tabelle [eintragzaehler].differenz          := pausenueberziehung;
-    erhoehe eintragzaehler;
-    arbeitsphasenzaehler    INCR 1;
-
-    beginn der bearbeitung  := clock (1);
-    beginn der arbeitsphase := clock (1);
-    bearbeitungslaenge bestimmen.
-  trage simulationsende in tabelle ein:
-    bearbeitungsende := clock (1);
-    tab.tabelle [eintragzaehler].eintragskennung    := simulationsendekennung;
-    tab.tabelle [eintragzaehler].produktionsfehler  := produktionsfehler;
-    tab.tabelle [eintragzaehler].anzahl korrekturen := korrekturzaehler;
-    tab.tabelle [eintragzaehler].anzahl bedienfehler:= bedienfehlerzaehler;
-
-    tab.tabelle [eintragzaehler].anfang             := beginn der bearbeitung;
-    tab.tabelle [eintragzaehler].ende               := bearbeitungsende;
-    tab.tabelle [eintragzaehler].differenz          := bearbeitungszeit;
-    tab.letzter eintrag                             := eintragzaehler.
-  bearbeitungszeit:
-    bearbeitungsende - beginn der bearbeitung.
-  erhoehe eintragzaehler:
-    IF eintragzaehler < maxeintraege
-       THEN eintragzaehler INCR 1
-       ELSE trage simulationsende in tabelle ein;
-
-            errorstop (anwendungstext (254))
-    FI.
-  ermittle ueberziehung der arbeitsphase:
-    arbeitsphasenueberziehung := clock (1) - beginn der arbeitsphase
-                                           - arbeitsphasenlaenge.
-  bearbeitungslaenge bestimmen:
-    arbeitsphasenlaenge := real (aphasendauer * 60)
-                                - arbeitsphasenueberziehung
-                                - pausenueberziehung.
-  arbeitsphasenende erreicht:
-    clock (1) - beginn der arbeitsphase >= arbeitsphasenlaenge.
-
-  simulationsende erreicht:
-    arbeitsphasenzaehler = anzahl aphasen AND arbeitsphasenende erreicht.
-END PROC fuehre simulation durch;
-PROC gib bedieninformationen aus (INT CONST zeile):
-  WINDOW VAR f1 :: window ( 2, zeile, 35, 6),
-             f2 :: window (40, zeile, 39, 6);
-  show (f1); show (f2);
-  cursor (f1, 2, 1); out (f1, anwendungstext (11));
-                     out (f1, tastenbezeichnung ( nach rechts));
-  cursor (f1, 2, 2); out (f1, anwendungstext (12));
-                     out (f1, tastenbezeichnung ( nach links));
-
-  cursor (f1, 2, 3); out (f1, anwendungstext (13));
-                     out (f1, tastenbezeichnung ( nach oben));
-  cursor (f1, 2, 4); out (f1, anwendungstext (14));
-                     out (f1, tastenbezeichnung ( nach unten));
-  cursor (f1, 2, 5); out (f1, anwendungstext (15));
-                     out (f1, tastenbezeichnung ( ausbesserung));
-  cursor (f1, 2, 6); out (f1, anwendungstext (16));
-                     out (f1, tastenbezeichnung ( naechstes));
-  cursor (f2, 2, 1); out (f2, anwendungstext (17));
-
-                     out (f2, text (anzahl aphasen, 4));
-  cursor (f2, 2, 2); out (f2, anwendungstext (18));
-                     out (f2, text (aphasendauer,   4));
-                     out (f2, anwendungstext (51));
-  cursor (f2, 2, 3); out (f2, anwendungstext (19));
-                     out (f2, text (pausendauer,    4));
-                     out (f2, anwendungstext (51));
-  cursor (f2, 2, 4); out (f2, anwendungstext ( 5));
-                     out (f2, text (gesamtzeit,      4));
-                     out (f2, anwendungstext (51));
-
-  cursor (f2, 2, 6); out (f2, anwendungstext (251));
-                     out (f2, 3 * blank);
-                     out (f2, fehlerzeichen).
-END PROC gib bedieninformationen aus;
-INT PROC gesamtzeit:
-  anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer
-END PROC gesamtzeit;
-PROC hole werkstueck (WERKSTUECK VAR w, INT VAR anzahl fehler):
-  INT VAR spaltenzaehler, zeilenzaehler;
-  anzahl fehler := 0;
-  FOR zeilenzaehler FROM 1 UPTO hoehe REP
-    ermittle eine zeile
-  PER.
-
-  ermittle eine zeile:
-    FOR spaltenzaehler FROM 1 UPTO breite REP
-      ermittle eine position;
-      ggf fehler registrieren
-    PER.
-  ermittle eine position:
-    w [spaltenzaehler][zeilenzaehler] := zufallscode.
-  zufallscode:
-    random (kleinster code, groesster code).
-  ggf fehler registrieren:
-    IF w [spaltenzaehler][zeilenzaehler] = code (fehlerzeichen)
-       THEN anzahl fehler INCR 1
-    FI.
-END PROC hole werkstueck;
-PROC zeige werkstueck (WERKSTUECK CONST w, WINDOW VAR f):
-
-  INT VAR spaltenzaehler, zeilenzaehler;
-  page (f);
-  FOR zeilenzaehler FROM 1 UPTO hoehe REP
-    zeige eine zeile
-  PER.
-  zeige eine zeile:
-    cursor (f, eckspalte, eckzeile + zeilenzaehler - 1);
-    ggf invers einschalten;
-    FOR spaltenzaehler FROM 1 UPTO breite REP
-      out (f, code (w [spaltenzaehler][zeilenzaehler]))
-    PER;
-    ggf invers ausschalten.
-  ggf invers einschalten:
-    IF inversdarstellung THEN out (f, markierung ein) FI.
-  ggf invers ausschalten:
-    IF inversdarstellung THEN out (f, markierung aus) FI.
-
-END PROC zeige werkstueck;
-PROC kurzauswertung auf bildschirm (TEXT CONST dateiname):
-  WINDOW VAR fenster :: window (  2, 10, 77, 13);
-  show (fenster);
-  clear buffer;
-  notiere ueberschrift;
-  notiere ergebnis.
-  notiere ueberschrift:
-    cursor (fenster, 1, 1);
-    out (fenster, center (fenster, anwendungstext (275)));
-    cursor (fenster, 1, 2);
-    out (fenster, center (fenster, anwendungstext (276))).
-  notiere ergebnis:
-    BOUND KONTROLLTABELLE CONST k := old (dateiname);
-    ermittle die simulationsdaten;
-
-    notiere gesamtzahl werkstuecke;
-    notiere zeichengesamtzahl;
-    notiere bedienfehler;
-    notiere benoetigte zeit;
-    notiere gesamtausbesserungsrate;
-    notiere gesamtbewertungsfaktor;
-    notiere gesamtbewertungszahl mit pausenueberziehung;
-    cursor (1, 24); out (anwendungstext (2));
-    pause.
-  ermittle die simulationsdaten:
-    INT  VAR z, anzahl zeichen pro werkstueck,
-             anzahl werkstuecke        ::   0,
-             anzahl bedienfehler       ::   0,
-             anzahl produktionsfehler  ::   0,
-
-             anzahl korrekturen        ::   0;
-    REAL VAR gesamtzahl zeichen, anteil korrekturen,
-             gesamtzeit                :: 0.0,
-             pausenueberzug            :: 0.0;
-    FOR z FROM 1 UPTO k.letzter eintrag REP
-      IF   k.tabelle [z].eintragskennung = werkstueckendekennung
-           THEN anzahl werkstuecke       INCR 1;
-                anzahl bedienfehler      INCR k.tabelle [z].anzahl bedienfehler;
-                anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;
-
-                anzahl korrekturen       INCR k.tabelle [z].anzahl korrekturen;
-                gesamtzeit               INCR k.tabelle [z].differenz;
-      ELIF k.tabelle [z].eintragskennung = pausenendekennung
-           THEN pausenueberzug           INCR k.tabelle [z].differenz;
-      FI
-    PER;
-    anzahl zeichen pro werkstueck := k.breite * k.hoehe;
-    gesamtzahl zeichen            :=   real (anzahl werkstuecke)
-                                     * real (anzahl zeichen pro werkstueck);
-
-    IF anzahl produktionsfehler = 0
-       THEN anteil korrekturen    := 1.0
-       ELSE anteil korrekturen    :=   real (anzahl korrekturen)
-                                     / real (anzahl produktionsfehler)
-    FI.
-  notiere gesamtzahl werkstuecke:
-    cursor (fenster, 12, 4); out (fenster, anwendungstext (277));
-                             out (fenster, text (anzahl werkstuecke, 8)).
-  notiere zeichengesamtzahl:
-    cursor (fenster, 12, 5); out (fenster, anwendungstext (278));
-                             out (fenster, zahl aus zeichenkette).
-
-  zahl aus zeichenkette:
-    subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).
-  notiere bedienfehler:
-    cursor (fenster, 12, 6); out (fenster, anwendungstext (279));
-                             out (fenster, text (anzahl bedienfehler, 8)).
-  notiere benoetigte zeit:
-    cursor (fenster, 12, 7); out (fenster, anwendungstext (280));
-                             out (fenster, text (gesamtzeit,         8, 2)).
-  notiere gesamtausbesserungsrate:
-    cursor (fenster, 12, 9); out (fenster, anwendungstext (281));
-
-                             out (fenster, text (anteil korrekturen, 8, 2)).
-  notiere gesamtbewertungsfaktor:
-    cursor (fenster, 12,10); out (fenster, anwendungstext (282));
-                             out (fenster, text (bewertungsfaktor, 8, 2)).
-  bewertungsfaktor:
-    bewertungsmasszahl (anteil korrekturen).
-  notiere gesamtbewertungszahl mit pausenueberziehung:
-    cursor (fenster, 12, 12); out (fenster, (anwendungstext (283)));
-                              out (fenster, text (gesamtwertung,   8, 2));
-
-    cursor (fenster, 12, 13); out (fenster, (anwendungstext (284)));
-                              out (fenster, 8 * "=").
-  gesamtwertung:
-    IF gesamtzeit = 0.0
-       THEN 0.0
-       ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug)
-                               * bewertungsfaktor
-    FI.
-END PROC kurzauswertung auf bildschirm;
-PROC simulationsauswertung (TEXT CONST dateiname, BOOL CONST mit zeigen):
-  TEXT CONST auswertdatei :: dateiname + auswertdateipostfix;
-  ermittle die kenndaten aus der protokolldatei (dateiname);
-
-  notiere ueberschrift 1               (auswertdatei);
-  notiere die kenndaten der simulation (auswertdatei);
-  notiere die werkstueckkenndaten      (auswertdatei);
-  notiere ein beispielwerkstueck       (auswertdatei);
-  notiere ueberschrift 2               (auswertdatei);
-  notiere gesamtergebnisse             (auswertdatei, dateiname);
-  notiere ueberschrift 3               (auswertdatei);
-  notiere tabellenkopf                 (auswertdatei);
-  notiere einzelne werkstueckdaten     (auswertdatei, dateiname);
-
-  notiere ggf die anmerkungen;
-  zeige ggf auswertung auf bildschirm.
-  notiere ggf die anmerkungen:
-    IF mit anmerkungen
-       THEN notiere anmerkungen        (auswertdatei);
-    FI.
-  zeige ggf auswertung auf bildschirm:
-    IF mit zeigen
-       THEN cursor on; show (auswertdatei); cursor off
-    FI.
-END PROC simulationsauswertung;
-PROC ermittle die kenndaten aus der protokolldatei (TEXT CONST dateiname):
-  BOUND KONTROLLTABELLE CONST k := old (dateiname);
-  breite                    := k.breite;
-
-  hoehe                     := k.hoehe;
-  kleinster code            := k.kleinster code;
-  groesster code            := k.groesster code;
-  fehlerzeichen             := k.fehlerzeichen;
-  inversdarstellung         := k.inversdarstellung;
-  nach rechts               := k.nach rechts;
-  nach links                := k.nach links;
-  nach oben                 := k.nach oben;
-  nach unten                := k.nach unten;
-  ausbesserung              := k.ausbesserung;
-  naechstes                 := k.naechstes;
-
-  anzahl aphasen            := k.anzahl aphasen;
-  aphasendauer              := k.aphasendauer;
-  pausendauer               := k.pausendauer;
-  datum                     := k.datum;
-  uhrzeit                   := k.uhrzeit;
-  bewertung                 := k.bewertung;
-END PROC ermittle die kenndaten aus der protokolldatei;
-PROC notiere ueberschrift 1 (TEXT CONST auswertdatei):
-  IF exists (auswertdatei)
-     THEN forget (auswertdatei, quiet)
-  FI;
-  FILE VAR f :: sequential file (output, auswertdatei);
-
-  IF auswertung geht zum drucker
-     THEN schreibe druckeranweisungen
-  FI;
-  putline (f, center (auswertdatei));
-  putline (f, center (length (auswertdatei) * "="));
-  put (f, anwendungstext (272)); put (f, datum); put (f, 26 * blank);
-  put (f, anwendungstext (273)); putline (f, uhrzeit);
-  line (f);
-  putline (f, center (anwendungstext (291)));
-  putline (f, center (length (anwendungstext (291)) * "=")).
-  schreibe druckeranweisungen:
-    write (f, "#type (""");
-    write (f, protokollschrifttyp);
-
-    write (f, """)##limit (");
-    write (f, text (schreibfeldbreite));
-    write (f, ")##pagelength (");
-    write (f, text (schreibfeldlaenge));
-    write (f, ")##start (");
-    write (f, text (xstart));
-    write (f, ",");
-    write (f, text (ystart));
-    write (f, ")#"); line (f).
-END PROC notiere ueberschrift 1;
-PROC notiere ueberschrift 2 (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-  putline (f, center (anwendungstext (285)));
-  putline (f, center (length (anwendungstext (285)) * "="))
-
-END PROC notiere ueberschrift 2;
-PROC notiere ueberschrift 3 (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-  line (f, 2);
-  putline (f, center (anwendungstext (311)));
-  putline (f, center (length (anwendungstext (311)) * "="));
-  line (f)
-END PROC notiere ueberschrift 3;
-PROC notiere die kenndaten der simulation (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-  ROW 6 TEXT VAR ausgabe;
-  bestuecke ausgabezeilen;
-  schreibe ausgabezeilen.
-
-  bestuecke ausgabezeilen:
-    ausgabe [1] :=   anwendungstext (11)
-                   + gleichlang (tastenbezeichnung (nach rechts ), 23)
-                   + anwendungstext (17)
-                   + text (anzahl aphasen,   4);
-    ausgabe [2] :=   anwendungstext (12)
-                   + gleichlang (tastenbezeichnung (nach links  ), 23)
-                   + anwendungstext (18)
-                   + text (aphasendauer,     4) + anwendungstext (51);
-    ausgabe [3] :=   anwendungstext (13)
-
-                   + gleichlang (tastenbezeichnung (nach oben   ), 23)
-                   + anwendungstext (19)
-                   + text (pausendauer,      4) + anwendungstext (51);
-    ausgabe [4] :=   anwendungstext (14)
-                   + gleichlang (tastenbezeichnung (nach unten  ), 23)
-                   + anwendungstext ( 5)
-                   + text (simulationsdauer, 4) + anwendungstext (51);
-    ausgabe [5] :=   anwendungstext (15)
-                   + gleichlang (tastenbezeichnung (ausbesserung), 23);
-
-    ausgabe [6] :=   anwendungstext (16)
-                   + gleichlang (tastenbezeichnung (naechstes   ), 23)
-                   + anwendungstext (251)
-                   + (3 * blank) + fehlerzeichen.
-  simulationsdauer:
-    anzahl aphasen * aphasendauer + (anzahl aphasen - 1) * pausendauer.
-  schreibe ausgabezeilen:
-    INT VAR i;
-    FOR i FROM 1 UPTO 6 REP
-      putline (f, ausgabe [i])
-    PER;
-    line (f).
-END PROC notiere die kenndaten der simulation;
-PROC notiere die werkstueckkenndaten (TEXT CONST auswertdatei):
-
-  FILE VAR f :: sequential file (output, auswertdatei);
-  ROW 4 TEXT VAR ausgabe;
-  bestuecke ausgabezeilen;
-  schreibe ausgabezeilen.
-  bestuecke ausgabezeilen:
-    ausgabe [1] :=  anwendungstext (292) + text (breite,        4) +
-                    anwendungstext (296);
-    ausgabe [2] :=  anwendungstext (293) + text (hoehe,          4) +
-                    anwendungstext (296);
-    ausgabe [3] :=  anwendungstext (294) + text (breite * hoehe, 4) +
-                    anwendungstext (296);
-
-    ausgabe [4] :=  anwendungstext (295) + zeichenumfang.
-  zeichenumfang:
-    " " + code (kleinster code) + " ... " + code (groesster code) +
-    " (" + text (groesster code - kleinster code + 1, 3) +
-    anwendungstext (296) + ")".
-  schreibe ausgabezeilen:
-    INT VAR i;
-    FOR i FROM 1 UPTO 4 REP putline (f, ausgabe [i]) PER;
-    line (f).
-END PROC notiere die werkstueckkenndaten;
-PROC notiere ein beispielwerkstueck (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-
-  WERKSTUECK VAR beispiel;
-  INT VAR beispielfehler;
-  hole werkstueck (beispiel, beispielfehler);
-  notiere ueberschrift;
-  notiere werkstueckzeilen;
-  notiere werkstueckleerzeilen.
-  notiere ueberschrift:
-    putline (f, center (anwendungstext (297)));
-    putline (f, center (length (anwendungstext (297)) * "-")).
-  notiere werkstueckzeilen:
-    INT VAR bs, bz;
-    FOR bz FROM 1 UPTO hoehe REP
-      notiere eine zeile
-    PER.
-  notiere eine zeile:
-    TEXT VAR beispielzeile :: "";
-
-    konstruiere beispielzeile;
-    gib beispielzeile aus.
-  konstruiere beispielzeile:
-    beispielzeile CAT (((80 - breite) DIV 2) * blank);
-    FOR bs FROM 1 UPTO breite REP
-      beispielzeile CAT code (beispiel [bs][bz])
-    PER.
-  gib beispielzeile aus:
-    putline (f, beispielzeile).
-  notiere werkstueckleerzeilen:
-    line (f, maxzeilen - hoehe + 1).
-END PROC notiere ein beispielwerkstueck;
-PROC notiere gesamtergebnisse (TEXT CONST auswertdatei, protokolldatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-
-  BOUND KONTROLLTABELLE CONST k :: old (protokolldatei);
-  ermittle die simulationsdaten;
-    notiere gesamtzahl werkstuecke;
-    notiere anzahl zeichen pro werkstueck;
-    notiere zeichengesamtzahl;
-    notiere bedienfehler;
-    notiere produktionsfehlerzahl;
-    notiere fehlerkorrekturen;
-    notiere gesamtzeit mit pausenueberziehung;
-    notiere zeichenzahl pro sekunde mit;
-    notiere gesamtausbesserungsrate;
-    notiere gesamtbewertungsfaktor  mit;
-    notiere gesamtbewertungszahl    mit;
-
-    notiere gesamtzeit ohne pausenueberziehung;
-    notiere zeichenzahl pro sekunde ohne;
-    notiere gesamtbewertungszahl    ohne.
-  ermittle die simulationsdaten:
-    INT  VAR z, anzahl zeichen pro werkstueck,
-             anzahl werkstuecke        ::   0,
-             anzahl bedienfehler       ::   0,
-             anzahl produktionsfehler  ::   0,
-             anzahl korrekturen        ::   0;
-    REAL VAR gesamtzahl zeichen, anteil korrekturen,
-             gesamtzeit                :: 0.0,
-
-             pausenueberzug            :: 0.0;
-    FOR z FROM 1 UPTO k.letzter eintrag REP
-      IF   k.tabelle [z].eintragskennung = werkstueckendekennung
-           THEN anzahl werkstuecke       INCR 1;
-                anzahl bedienfehler      INCR k.tabelle [z].anzahl bedienfehler;
-                anzahl produktionsfehler INCR k.tabelle [z].produktionsfehler;
-                anzahl korrekturen       INCR k.tabelle [z].anzahl korrekturen;
-                gesamtzeit               INCR k.tabelle [z].differenz;
-
-      ELIF k.tabelle [z].eintragskennung = pausenendekennung
-           THEN pausenueberzug           INCR k.tabelle [z].differenz;
-      FI
-    PER;
-    anzahl zeichen pro werkstueck := k.breite * k.hoehe;
-    gesamtzahl zeichen            :=   real (anzahl werkstuecke)
-                                     * real (anzahl zeichen pro werkstueck);
-    IF anzahl produktionsfehler = 0
-       THEN anteil korrekturen    := 1.0
-       ELSE anteil korrekturen    :=   real (anzahl korrekturen)
-
-                                     / real (anzahl produktionsfehler)
-    FI.
-  notiere gesamtzahl werkstuecke:
-    put (f, anwendungstext (277)); putline (f, text (anzahl werkstuecke, 8)).
-  notiere anzahl zeichen pro werkstueck:
-    put (f, anwendungstext (286)); putline (f, text (breite * hoehe,     8)).
-  notiere zeichengesamtzahl:
-    put (f, anwendungstext (278)); putline (f, zahl aus zeichenkette);
-    line (f).
-  zahl aus zeichenkette:
-    subtext (text (gesamtzahl zeichen, 9, 0), 1, 8).
-
-  notiere produktionsfehlerzahl:
-    put (f, anwendungstext (287)); putline (f, text (anzahl produktionsfehler, 8)).
-  notiere fehlerkorrekturen:
-    put (f, anwendungstext (288)); putline (f, text (anzahl korrekturen, 8)).
-  notiere bedienfehler:
-    put (f, anwendungstext (279)); putline (f, text (anzahl bedienfehler,8));
-    line (f).
-  notiere gesamtzeit mit pausenueberziehung:
-    put (f, anwendungstext (301)); put (f, text (gesamtzeit mit, 8, 1));
-    putline (f, anwendungstext (300)).
-
-  gesamtzeit mit:
-    gesamtzeit + pausenueberzug.
-  notiere zeichenzahl pro sekunde mit:
-    put (f, anwendungstext (302));
-    putline (f, text (zeichenpro sec mit, 8, 1));
-    line (f).
-  zeichen pro sec mit:
-    IF gesamtzeit + pausenueberzug > 0.0
-       THEN gesamtzahl zeichen / (gesamtzeit + pausenueberzug)
-       ELSE 0.0
-    FI.
-  notiere gesamtausbesserungsrate:
-    put (f, anwendungstext (281)); putline (f, text (anteil korrekturen, 8, 1)).
-  notiere gesamtbewertungsfaktor mit:
-
-    put (f, anwendungstext (282)); putline (f, text (bewertungsfaktor, 8, 1));
-    line (f).
-  bewertungsfaktor:
-    bewertungsmasszahl (anteil korrekturen).
-  notiere gesamtbewertungszahl mit:
-    put (f, (anwendungstext (283))); putline (f, text (gesamtwertung mit,   8, 1));
-    put (f, (anwendungstext (284))); putline (f, 8 * "=").
-  gesamtwertung mit:
-    IF gesamtzeit = 0.0
-       THEN 0.0
-       ELSE gesamtzahl zeichen / (gesamtzeit + pausenueberzug)
-                               * bewertungsfaktor
-
-    FI.
-  notiere gesamtzeit ohne pausenueberziehung:
-    put (f, anwendungstext (303)); put (f, text (gesamtzeit, 8, 1));
-    putline (f, anwendungstext (300)).
-  notiere zeichenzahl pro sekunde ohne:
-    put (f, anwendungstext (302));
-    putline (f, text (zeichenpro sec ohne, 8, 1)).
-  zeichen pro sec ohne:
-    IF gesamtzeit > 0.0
-       THEN gesamtzahl zeichen / gesamtzeit
-       ELSE 0.0
-    FI.
-  notiere gesamtbewertungszahl ohne:
-    put (f, (anwendungstext (304))); putline (f, text (gesamtwertung ohne,   8, 1));
-
-    put (f, (anwendungstext (284))); putline (f, 8 * "=").
-  gesamtwertung ohne:
-    IF gesamtzeit = 0.0
-       THEN 0.0
-       ELSE gesamtzahl zeichen / gesamtzeit * bewertungsfaktor
-    FI.
-END PROC notiere gesamtergebnisse;
-PROC notiere tabellenkopf (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-  putline (f, anwendungstext (312));
-  putline (f, anwendungstext (313));
-  putline (f, anwendungstext (314));
-  putline (f, anwendungstext (315));
-  putline (f, anwendungstext (316));
-
-  putline (f, anwendungstext (317));
-  putline (f, anwendungstext (318));
-END PROC notiere tabellenkopf;
-PROC notiere einzelne werkstueckdaten (TEXT CONST auswertdatei, dateiname):
-  BOUND KONTROLLTABELLE CONST k :: old (dateiname);
-  FILE VAR f :: sequential file (output, auswertdatei);
-  INT  VAR zeiger, werkstuecknummer :: 0;
-  TEXT VAR ausgabezeile :: "";
-  FOR zeiger FROM 1 UPTO k.letzter eintrag REP
-   notiere bearbeitungszeile
-  PER.
-  notiere bearbeitungszeile:
-    IF   k.tabelle [zeiger].eintragskennung = werkstueckendekennung
-
-         THEN werkstuecknummer INCR 1;
-              schreibe werkstueckzeile
-    ELIF k.tabelle [zeiger].eintragskennung = pausenendekennung
-         THEN schreibe pausenzeile
-    ELIF k.tabelle [zeiger].eintragskennung = simulationsendekennung
-         THEN werkstuecknummer INCR 1;
-              schreibe abschluss
-    ELSE putline (f, 75 * "?")
-    FI.
-  schreibe werkstueckzeile:
-    konstruiere ausgabezeile;
-    putline (f, ausgabezeile).
-  konstruiere ausgabezeile:
-    ausgabezeile := "";
-
-    ausgabezeile CAT text (werkstuecknummer, 5);
-    ausgabezeile CAT 2 * blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (k.tabelle [zeiger].anzahl bedienfehler, 5);
-    ausgabezeile CAT 3 * blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (k.tabelle [zeiger].produktionsfehler,   6);
-    ausgabezeile CAT 2 * blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (k.tabelle [zeiger].anzahl korrekturen,  6);
-    ausgabezeile CAT 2 * blank;
-    ausgabezeile CAT trenn;
-
-    ausgabezeile CAT text (k.tabelle [zeiger].differenz,  6, 1);
-    ausgabezeile CAT blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (zeichen pro zeiteinheit,  6, 1);
-    ausgabezeile CAT blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (einzelausbesserungsrate,  6, 1);
-    ausgabezeile CAT blank;
-    ausgabezeile CAT trenn;
-    ausgabezeile CAT text (bewertungsmasszahl (einzelausbesserungsrate), 6, 1);
-    ausgabezeile CAT blank;
-    ausgabezeile CAT trenn;
-
-    ausgabezeile CAT text (endbewertungszahl, 6, 1);
-    ausgabezeile CAT blank.
-  zeichen pro zeiteinheit:
-    real (breite * hoehe) / k.tabelle [zeiger].differenz.
-  einzelausbesserungsrate:
-    IF k.tabelle [zeiger].produktionsfehler = 0
-       THEN 0.0
-       ELSE   real (k.tabelle [zeiger].anzahl korrekturen)
-            / real (k.tabelle [zeiger].produktionsfehler )
-    FI.
-  endbewertungszahl:
-    real (breite * hoehe) / k.tabelle [zeiger].differenz
-                          * bewertungsmasszahl (einzelausbesserungsrate).
-
-  schreibe pausenzeile:
-    line (f);
-    put     (f, anwendungstext (320));
-    put     (f, text (k.tabelle [zeiger].differenz, 6, 1));
-    putline (f, anwendungstext (300));
-    line (f).
-  schreibe abschluss:
-    putline (f, anwendungstext (318));
-    putline (f, anwendungstext (319));
-    line (f);
-    konstruiere ausgabezeile;
-    ausgabezeile := "(" +
-                    subtext (ausgabezeile, 2, length (ausgabezeile) - 1) +
-                    ")";
-    putline (f, ausgabezeile).
-
-END PROC notiere einzelne werkstueckdaten;
-PROC notiere anmerkungen (TEXT CONST auswertdatei):
-  FILE VAR f :: sequential file (output, auswertdatei);
-  line (f);
-  schreibe kopf;
-  schreibe hinweis auf letztes werkstueck;
-  schreibe hinweis auf bedienfehler;
-  erlaeutere bewertungsschluessel;
-  stelle bewertungsschluessel graphisch dar;
-  schreibe rest.
-  schreibe kopf:
-    putline (f, center (anwendungstext (325)));
-    putline (f, center (length (anwendungstext (325)) * "="));
-    line (f).
-
-  schreibe hinweis auf letztes werkstueck:
-    INT VAR i;
-    FOR i FROM 326 UPTO 337 REP
-      putline (f, anwendungstext (i))
-    PER;
-    line (f).
-  schreibe hinweis auf bedienfehler:
-    FOR i FROM 339 UPTO 341 REP
-      putline (f, anwendungstext (i))
-    PER;
-    line (f).
-  erlaeutere bewertungsschluessel:
-    FOR i FROM 343 UPTO 372 REP
-      putline (f, anwendungstext (i))
-    PER.
-  stelle bewertungsschluessel graphisch dar:
-    putline (f, anwendungstext (374));
-    putline (f, anwendungstext (375));
-
-    ermittle die startposition;
-    zeichne diagramm;
-    trage werte ein.
-  ermittle die startposition:
-    modify (f);
-    INT VAR zeilenpos :: lines (f) + 2, spaltenpos :: 18.
-  zeichne diagramm:
-    cursor (f, spaltenpos, zeilenpos     , anwendungstext (20));
-    cursor (f, spaltenpos, zeilenpos +  1, anwendungstext (21));
-    cursor (f, spaltenpos, zeilenpos +  3, anwendungstext (23));
-    cursor (f, spaltenpos, zeilenpos +  4, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos +  5, anwendungstext (22));
-
-    cursor (f, spaltenpos, zeilenpos +  6, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos +  7, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos +  8, anwendungstext (24));
-    cursor (f, spaltenpos, zeilenpos +  9, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos + 10, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos + 11, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos + 12, anwendungstext (22));
-    cursor (f, spaltenpos, zeilenpos + 13, anwendungstext (25));
-
-    cursor (f, spaltenpos, zeilenpos + 14, anwendungstext (26));
-    cursor (f, spaltenpos, zeilenpos + 15, anwendungstext (27)).
-  trage werte ein:
-    zeilenpos INCR 13;
-    INT VAR bwzeiger;
-    FOR bwzeiger FROM 1 UPTO 11 REP
-      cursor (f, spaltenpos + 3 * bwzeiger, zeilenpos - konkreter wert, "+")
-    PER.
-  konkreter wert:
-    int (bewertung [bwzeiger] * 10.0).
-  schreibe rest:
-    output (f);
-    line (f, 2);
-    FOR i FROM 377 UPTO 387 REP
-      putline (f, anwendungstext (i))
-
-    PER;
-    haenge an jede zeile ein blank an.
-  haenge an jede zeile ein blank an:
-    TEXT VAR inhalt;
-    INT  VAR zeilenzeiger;
-    modify (f);
-    FOR zeilenzeiger FROM 1 UPTO lines (f) REP
-      to line (f, zeilenzeiger);
-      read record (f, inhalt);
-      inhalt CAT blank;
-      write record (f, inhalt)
-    PER;
-    to line (f,1).
-END PROC notiere anmerkungen;
-PROC cursor (FILE VAR f, INT CONST spa, zei, TEXT CONST text):
-  positioniere an zeile;
-  positioniere an spalte;
-
-  gib text an position aus.
-  positioniere an zeile:
-    IF zeile noch nicht vorhanden
-       THEN schaffe zeile und gehe dorthin
-       ELSE to line (f,zei)
-    FI.
-  zeile noch nicht vorhanden:
-    zei > lines (f).
-  schaffe zeile und gehe dorthin:
-    INT VAR zaehler 1;
-    IF lines (f) = 0
-       THEN to line (f,lines (f));
-            insert record (f);
-    FI;
-    FOR zaehler 1 FROM lines (f)  UPTO zei REP
-      to line (f,lines (f));
-      down (f);insert record (f)
-    PER;
-
-    to line(f,zei).
-  positioniere an spalte:
-    TEXT VAR alter satz :: "", neuer satz :: "", restsatz ::"";
-    INT VAR satzlaenge;
-    read record (f,alter satz);
-    satzlaenge := length (alter satz);
-    IF satzlaenge = 0
-       THEN neuer satz CAT (spa -1) * " "
-    ELIF satzlaenge >= spa
-       THEN neuer satz := subtext(alter satz,1,spa-1);
-            restsatz   := subtext(alter satz, spa + length (text));
-       ELSE neuer satz := alter satz;
-            neuer satz CAT (spa - satzlaenge - 1) * " "
-
-    FI.
-  gib text an position aus:
-   neuer satz CAT text;
-   IF restsatz <> ""
-      THEN neuer satz CAT restsatz
-   FI;
-   write record(f,neuer satz).
- END PROC cursor;
-TEXT PROC gleichlang (TEXT CONST text, INT CONST laenge):
-  TEXT VAR intern :: compress (text);
-  INT  VAR anzahl :: laenge - length (intern);
-  IF anzahl < 0
-     THEN subtext (intern, 1, laenge)
-     ELSE intern + (anzahl * blank)
-  FI
-END PROC gleichlang;
-REAL PROC bewertungsmasszahl (REAL CONST wert):
-  REAL VAR interner wert := round (wert, 1);
-
-  IF interner wert > wert
-     THEN interner wert DECR 0.1
-  FI;
-  interpoliere.
-  interpoliere:
-    REAL VAR unterer wert, oberer wert;
-    unterer wert := interner wert;
-    IF unterer wert = 1.0
-       THEN oberer wert := 1.0
-       ELSE oberer  wert := unterer wert + 0.1
-    FI;
-    unterer wert := bewertung (int (unterer wert * 10.0) + 1);
-    oberer  wert := bewertung (int (oberer  wert * 10.0) + 1);
-    unterer wert + (oberer wert - unterer wert) * faktor.
-  faktor:
-    frac (wert * 10.0).
-
-END PROC bewertungsmasszahl;
-PROC zeige aktuellen protokollumfang an:
-  WINDOW VAR w :: window (2, 2, 34,  5);
-  show (w);
-  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));
-  IF mit anmerkungen
-     THEN cursor (w, 2, 4); out (w, anwendungstext (432))
-     ELSE cursor (w, 2, 4); out (w, anwendungstext (433));
-  FI.
-END PROC zeige aktuellen protokollumfang an;
-PROC gib erlaeuterungen zum protokollumfang:
-  WINDOW VAR f :: window ( 2, 9, 77, 15);
-  show (f);
-  cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (434))));
-
-  cursor (f, 5, 3); out (f, anwendungstext (435));
-  cursor (f, 5, 4); out (f, anwendungstext (436));
-  cursor (f, 5, 5); out (f, anwendungstext (437));
-  cursor (f, 5, 6); out (f, anwendungstext (438));
-  cursor (f, 5, 8); out (f, anwendungstext (439));
-  cursor (f, 5, 9); out (f, anwendungstext (440));
-  cursor (f, 5,10); out (f, anwendungstext (441));
-  cursor (f, 5,11); out (f, anwendungstext (442));
-  cursor (f, 5,13); out (f, anwendungstext (443));
-  cursor (f, 5,14); out (f, anwendungstext (444));
-
-END PROC gib erlaeuterungen zum protokollumfang;
-PROC frage nach umfangsaenderung:
-  WINDOW VAR fenster :: window (38, 2, 41, 5);
-  show (fenster);
-  cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (451))));
-  cursor (fenster, 4, 3); out (fenster, anwendungstext (452));
-  cursor (fenster, 4, 4);
-  IF yes (fenster, anwendungstext (453))
-     THEN  mit anmerkungen := NOT mit anmerkungen
-  FI.
-END PROC frage nach umfangsaenderung;
-PROC zeige aktuelle kurzauswertungseinstellung an:
-
-  WINDOW VAR w :: window ( 2, 2, 34,  5);
-  show (w);
-  cursor (w, 1, 1); out (w, center (w, invers (anwendungstext (431))));
-  IF mit kurzprotokoll
-     THEN cursor (w, 7, 4); out (w, anwendungstext (461));
-     ELSE cursor (w, 7, 4); out (w, anwendungstext (462));
-  FI.
-END PROC zeige aktuelle kurzauswertungseinstellung an;
-PROC gib erlaeuterungen zur kurzauswertung:
-  WINDOW VAR f :: window ( 2, 9, 77, 15);
-  show (f);
-  cursor (f, 1, 1); out (f, center (f, invers (anwendungstext (463))));
-
-  cursor (f, 5, 3); out (f, anwendungstext (464));
-  cursor (f, 5, 4); out (f, anwendungstext (465));
-  cursor (f, 5, 5); out (f, anwendungstext (466));
-  cursor (f, 5, 6); out (f, anwendungstext (467));
-  cursor (f, 5, 8); out (f, anwendungstext (468));
-  cursor (f, 5, 9); out (f, anwendungstext (469));
-  cursor (f, 5,10); out (f, anwendungstext (470));
-  cursor (f, 5,11); out (f, anwendungstext (471));
-  cursor (f, 5,13); out (f, anwendungstext (472));
-  cursor (f, 5,14); out (f, anwendungstext (473));
-
-END PROC gib erlaeuterungen zur kurzauswertung;
-PROC frage nach kurzauswertungsaenderung:
-  WINDOW VAR fenster :: window (38, 2, 41, 5);
-  show (fenster);
-  cursor (fenster, 1, 1); out (fenster, center (fenster, invers (anwendungstext (481))));
-  cursor (fenster, 5, 3); out (fenster, anwendungstext (482));
-  cursor (fenster, 5, 4);
-  IF yes (fenster, anwendungstext (483))
-     THEN  mit kurzprotokoll := NOT mit kurzprotokoll
-  FI.
-END PROC frage nach kurzauswertungsaenderung;
-END PACKET ls mp bap 2;
-
-
diff --git a/mp-bap/ls-MP BAP-gen b/mp-bap/ls-MP BAP-gen
deleted file mode 100644
index 40df0b4..0000000
--- a/mp-bap/ls-MP BAP-gen
+++ /dev/null
@@ -1,100 +0,0 @@
-                                             (*****************************) 
-                                             (*                           *) 
-                                             (*         ls-MP BAP         *) 
-                                             (*     GENERATORPROGRAMM     *) 
-                                             (*                           *) 
-                                             (* (c) 1987  (01.09.87)      *) 
-                                             (*     by Eva Latta          *) 
-                                             (*        Bielefeld          *) 
-                                             (*****************************) 
-LET mm taskname   = "ls-MENUKARTEN", 
-    eigener name  = "ls-MP BAP/gen", 
-    datei1        = "ls-MP BAP 1", 
-    datei2        = "ls-MP BAP 2", 
-    menukarte     = "ls-MENUKARTE:MP-BAP"; 
- 
-PROC stelle existenz des mm sicher: 
-  cursor (1, 5); out (""4""); 
-  IF NOT exists (task (mm taskname)) 
-     THEN errorstop ("Unbedingt erst den 'MENUKARTEN MANAGER' generieren!"); 
-  FI 
-END PROC stelle existenz des mm sicher; 
- 
-PROC vom archiv (TEXT CONST datei): 
-  cursor (1,5); out (""4""); 
-  out ("  """); out (datei); putline (""" wird geholt.");
-  fetch (datei, archive)
-END PROC vom archiv;
-PROC hole (TEXT CONST datei):
-  IF NOT exists (datei) THEN vom archiv (datei) FI
-END PROC hole;
-PROC in (TEXT CONST datei):
-  hole (datei);
-  cursor (1, 5); out (""4"");
-  out ("  """); out (datei); out (""" wird übersetzt: ");
-  insert (datei);
-  forget (datei, quiet);
-END PROC in;
-PROC schicke (TEXT CONST datei):
-  cursor (1, 5); out (""4"");
-  out ("  """); out(datei);
-  out (""" wird zum MENUKARTEN-MANAGER geschickt!");
-
-  command dialogue (FALSE);
-  save (datei, task (mm taskname));
-  command dialogue (TRUE);
-  forget (datei, quiet)
-END PROC schicke;
-INT VAR size, used;
-BOOL VAR einzeln;
-storage (size, used);
-einzeln := size - used < 500;
-forget (eigener name, quiet);
-wirf kopfzeile aus;
-stelle existenz des mm sicher;
-hole die dateien;
-insertiere die dateien;
-mache global manager aus der task.
-wirf kopfzeile aus:
-  page;
-  putline ("                  "15"ls-MP BAP  -  Automatische Generierung "14"").
-
-hole die dateien:
-  IF     NOT exists (datei 1)
-     COR NOT exists (datei 2)
-     COR NOT exists (menukarte)
-     THEN hole dateien vom archiv; LEAVE hole die dateien
-  FI.
-hole dateien vom archiv:
-  cursor (1,3); out (""4"");
-  IF yes ("Ist das Archiv angemeldet und die Diskette eingelegt")
-     THEN lese ein
-     ELSE line (2);
-          errorstop ("Ohne die Diskette kann ich das System nicht generieren!")
-  FI.
-lese ein:
-  cursor (1, 3); out (""4"");
-  out ("                   "15"Bitte die Diskette eingelegt lassen! "14"");
-
-  IF NOT einzeln
-     THEN  hole (datei 1);
-           hole (datei 2);
-           hole (menukarte);
-           cursor (1, 3); out(""4"");
-           out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");
-           release (archive)
-  FI.
-insertiere die dateien:
-  check off;
-  cursor (1, 3); out(""4"");
-  out ("                  "15"Die Diskette wird nicht mehr benötigt! "14"");
-  in (datei 1);
-  in (datei 2);
-  schicke (menukarte);
-  IF einzeln THEN release (archive) FI;
-
-  check on.
-mache global manager aus der task:
-  global manager.
-
-
diff --git a/prozess/ls-Prozess 1 für AKTRONIC-Adapter b/prozess/ls-Prozess 1 für AKTRONIC-Adapter
deleted file mode 100644
index d49d9d2..0000000
--- a/prozess/ls-Prozess 1 für AKTRONIC-Adapter
+++ /dev/null
@@ -1,557 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 1                     ** 
-         **                                                      ** 
-         **            Anpassung für AKTRONIC-Adapter            ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 26.01.90)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls prozess 1 DEFINES                   
-       run pdv,
-       run pdv again,
-       initialisiere interface,
-       schalte alles aus,
-       ausgeben,
-       eingabe,
-       warte,
-       abbruch gewuenscht,
-       tue nichts,
-       trage kanaldaten ein,
-       beende kanaldaten eintragen,
-       hole spannungsbereich,
-       letzte ausgabe,
-       pruefe kanal,
-       pruefe abbruch,
-       teste interface,
-       oeffne interface,
-       schliesse interface,
-       nicht belegt,
-       digital aus,
-       analog aus,
-
-       digital ein,
-       analog ein,
-       kanalbreite,
-       ganzzahl obergrenze,
-       adapterart,
-    (* ------------------------- *)
-       kanalkoppler,
-       interface kanal,
-       oeffne interface direkt,
-       schliesse interface direkt,
-       initialisiere interface direkt,
-       direkt ausgeben,
-       direkt eingabe:
-(******** A N P A S S U N G  A N  A K T R O N I C - A D A P T E R ********)
-LET interface test  code = ""240"",
-    interface open  code = ""176"",
-
-    interface close code = ""176"",
-    adresse 0 code       = ""176"",
-    interface write code =    64  ,
-    interface read  code =   192  ;
-TEXT CONST adapterart :: "AKTRONIC-Adapter";
-TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):
-  IF   es ist ein ausgabekanal
-       THEN code (interface write code + device + faktor * steuerungscode)
-  ELIF es ist ein eingabekanal
-       THEN lesecode in abhaengigkeit von der taktzahl
-       ELSE ""
-  FI.
-  es ist ein ausgabekanal:
-
-    kanal [kanalnummer].betriebsart < 0.
-  es ist ein eingabekanal:
-    kanal [kanalnummer].betriebsart > 0.
-  device:
-    IF steckplatznummer < 3
-       THEN 16
-       ELSE 32
-    FI.
-  faktor:
-    IF steckplatznummer MOD 2 = 0
-       THEN 4
-       ELSE 1
-    FI.
-  steckplatznummer:
-    IF kanalnummer < 10
-       THEN 1
-       ELSE kanalnummer DIV 10
-    FI.
-  lesecode in abhaengigkeit von der taktzahl:
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1: code fuer digital oder analog eingang
-
-      CASE 2: code fuer kombi e1
-      CASE 3: code fuer kombi e2
-    OTHERWISE "" END SELECT.
-  code fuer digital oder analog eingang:
-    IF kanal [kanalnummer].betriebsart = analog ein
-       THEN kanal [kanalnummer].taktzahl := 2;  (* ad wandler muss hier *)
-            lesecode + lesecode                 (* 2x gelesen werden!   *)
-       ELSE lesecode
-    FI.
-  lesecode  :  code (interface read code + device + faktor * steuerungscode).
-  code fuer kombi e1:
-    kanal [kanalnummer].taktzahl INCR 1; (* bei Analogport1 der Kombikarte *)
-
-    adresse 0 code + (3 * lesecode).     (* sind hier 3 Takte     noetig ! *)
-  code fuer kombi e2:
-    kanal [kanalnummer].taktzahl DECR 1;     (* hier nur 2 Takte noetig ! *)
-    adresse 0 code + lesecode + lesecode.
-END PROC interface anpassung;
-(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************)
-LET       max kanalanzahl          =   49,
-          initcode                 =   50,
-          endcode                  =   51,
-          alles aus code           =   52,
-
-          endezeichen              =  "q",
-          abbruchzeichen           =  "h",
-          esc                      =  ""27"";
-INT CONST analog aus               ::  -2,            (* Betriebsarten *)
-          digital aus              ::  -1,
-          nicht belegt             ::   0,
-          digital ein              ::   1,
-          analog  ein              ::   2,
-          kanalbreite              ::   8,
-          ganzzahl obergrenze      ::   2 ** kanalbreite,
-          configuration error code ::  -1,
-
-          kanal besetzt code       ::  -3,
-          interface error code     ::  -4,
-          not init code            ::  -5;
-INT VAR   interfacechannel         ::   2,
-          dummy;
-TEXT VAR  meldung                  ::  "";
-BOOL VAR  kanaldaten sind eingetragen :: FALSE,
-          endezeichen gegeben         :: FALSE,
-          programm mit pdv gestartet  :: FALSE,
-          fehler zu melden            :: FALSE;
-TASK VAR  interface task              :: niltask;
-DATASPACE VAR  ds :: nilspace;
-
-TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),
-     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);
-ROW max kanalanzahl INT      VAR vorherige ausgabe;
-ROW max kanalanzahl KANAL    VAR kanal;
-ROW max kanalanzahl SPANNUNG VAR spannung;
-ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :
-  ("Interface ist noch nicht konfiguriert!",
-   "Interface-Task ist besetzt!",
-   "Interface-Kanal ist belegt!",
-   "Interface meldet sich nicht!",
-   "Interface kann nicht geöffnet werden!");
-
-PROC run pdv:
-  run pdv (last param)
-END PROC run pdv;
-PROC run pdv (TEXT CONST programmname):
-  enable stop;
-  last param (programmname);
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run (programmname);
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv;
-PROC run pdv again:
-
-  enable stop;
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run again;
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv again;
-PROC melde programmende:
-  page;
-  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");
-  pause;
-  schalte alles aus
-END PROC melde programmende;
-
-PROC initialisiere interface:
-  enable stop;
-  pruefe abbruch;
-  IF programm mit pdv gestartet
-     THEN schalte alles aus
-     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!")
-  FI
-END PROC initialisiere interface;
-PROC schalte alles aus:
-  INT VAR k;
-  FOR k FROM 1 UPTO max kanalanzahl REP
-    vorherige ausgabe [k] := 0
-  PER;
-  forget (ds); ds := nilspace;
-  call (interface task, alles aus code, ds, dummy)
-END PROC schalte alles aus;
-PROC ausgeben (INT CONST kanalnummer, wert):
-
-  merke wert;
-  gib wert aus.
-  merke wert:
-    vorherige ausgabe [kanalnummer] := wert.
-  gib wert aus:
-    call (interface task, 256 * kanalnummer + wert, ds, dummy).
-END PROC ausgeben;
-INT PROC eingabe (INT CONST kanalnummer):
-  INT VAR eingabewert;
-  call (interface task, kanalnummer, ds, eingabewert);
-  eingabewert
-END PROC eingabe;
-PROC warte (REAL CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (int (sekunden * 10.0 + 0.5));
-  IF eingabe = esc
-
-     THEN untersuche naechstes zeichen
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-PROC warte (INT CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (sekunden * 10);
-  IF eingabe = esc
-     THEN untersuche naechstes zeichen
-
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-BOOL PROC abbruch gewuenscht:
-  pruefe abbruch;
-  BOOL VAR entscheidung :: endezeichen gegeben;
-  endezeichen gegeben := FALSE;
-  entscheidung
-END PROC abbruch gewuenscht;
-PROC tue nichts:
-
-  pruefe abbruch
-END PROC tue nichts;
-PROC trage kanaldaten ein (INT CONST  kanalnummer,
-                           ROW 2 REAL CONST spannungsbereich,
-                           ROW 3 INT  CONST kanalparameter):
-   spannung [kanalnummer].minimalwert := spannungsbereich [1];
-   spannung [kanalnummer].maximalwert := spannungsbereich [2];
-   kanal [kanalnummer].betriebsart    := kanalparameter   [1];
-   kanal [kanalnummer].taktzahl       := kanalparameter   [2];
-   kanal [kanalnummer].steuercode     := interface anpassung
-
-                                         (kanalnummer, kanalparameter [3])
-END PROC trage kanaldaten ein;
-PROC beende kanaldaten eintragen:
-  loesche interface task;
-  begin (PROC kanal koppler, interface task);
-  kanaldaten sind eingetragen := TRUE.
-  loesche interface task:
-    disable stop;
-    end (interface task);
-    IF is error
-       THEN clear error
-    FI;
-    enable stop.
-END PROC beende kanaldaten eintragen;
-PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):
-
-  u min := spannung [kanalnummer].minimalwert;
-  u max := spannung [kanalnummer].maximalwert
-END PROC hole spannungsbereich;
-INT PROC letzte ausgabe (INT CONST kanalnummer):
-  vorherige ausgabe [kanalnummer]
-END PROC letzte ausgabe;
-PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):
-  pruefe abbruch;
-  pruefe kanalnummer;
-  pruefe betriebsart.
-  pruefe kanalnummer:
-    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl
-       THEN errorstop ("Kanalnummer " + text (kanalnummer) +
-
-                        " ist unzulaessig !")
-    FI.
-  pruefe betriebsart:
-    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart
-       THEN errorstop ("An Kanal " + text (kanalnummer) +
-                          " keine " +  wunsch + " moeglich!")
-    FI.
-  wunsch:
-    IF   gewuenschte betriebsart = analog aus
-         THEN "Analog-Ausgabe"
-    ELIF gewuenschte betriebsart = digital aus
-         THEN "Digital-Ausgabe"
-    ELIF gewuenschte betriebsart = digital ein
-         THEN "Digital-Eingabe"
-
-    ELIF gewuenschte betriebsart = analog ein
-         THEN "Analog-Eingabe"
-         ELSE "Ein- oder Ausgabe"
-    FI.
-END PROC pruefe kanal;
-PROC pruefe abbruch:
-  IF incharety = esc
-     THEN pruefe weiter
-  FI.
-  pruefe weiter:
-    TEXT CONST zeichen :: incharety (30);
-    IF   zeichen = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF zeichen = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-
-    FI.
-END PROC pruefe abbruch;
-PROC oeffne interface (INT VAR status):
-  enable stop;
-  forget (ds); ds := nilspace;
-  IF kanaldaten sind eingetragen
-     THEN pingpong (interfacetask, initcode, ds, status)
-     ELSE status := configuration error code
-  FI;
-  IF status > 0 THEN status DECR maxint FI;
-  forget (ds); ds := nilspace
-END PROC oeffne interface;
-PROC schliesse interface:
-  enable stop;
-  forget (ds); ds := nilspace;
-  pingpong (interface task, end code, ds, dummy);
-  forget (ds); ds := nilspace
-
-END PROC schliesse interface;
-PROC teste interface:
-  INT VAR test;
-  oeffne interface (test);
-  IF test < 0
-     THEN errorstop (fehlermeldung [min (5, abs (test))])
-     ELSE fehler zu melden           := FALSE;
-          endezeichen gegeben        := FALSE
-  FI
-END PROC teste interface;
-PROC fehlerbehandlung:
-  meldung := errormessage;
-  IF meldung <> ""
-     THEN meldung CAT fehlerzeile;
-          fehler zu melden := TRUE
-  FI;
-  clear error;
-  initialisiere interface.
-  fehlerzeile:
-
-    IF errorline = 0
-       THEN ""
-       ELSE " (bei Zeile " + text (errorline) + ")"
-    FI.
-END PROC fehlerbehandlung;
-(********************  EIN-/AUSGABE AM INTERFACE-KANAL ********************)
-PROC kanalkoppler:
-  IF name (myself) <> "-"
-     THEN errorstop ("Unzulässiges Kommando!")
-     ELSE warte auf anrufe
-  FI.
-  warte auf anrufe:
-    TASK      VAR absender;
-    TEXT      VAR dummy;
-    INT       VAR codenummer, antwort;
-    disable stop;
-    REP forget (ds);
-        wait (ds, codenummer, absender);
-
-        IF codenummer = initcode
-           THEN kopple an interface kanal;
-                IF interface ist betriebsbereit
-                   THEN bearbeite weitere auftraege
-                   ELSE gib negative rueckmeldung
-                FI;
-                gib kanal frei
-           ELSE antwort := not init code;
-                gib negative rueckmeldung
-        FI
-    PER.
- kopple an interface kanal:
-  continue (interface channel);
-  IF is error
-     THEN clear error;
-          antwort := kanal besetzt code
-
-     ELSE oeffne interface direkt (antwort)
-  FI.
- interface ist betriebsbereit:  antwort = 0.
- gib negative rueckmeldung:     send (absender, antwort, ds).
- gib kanal frei:
-   break (quiet);
-   send  (absender, 0, ds, antwort);
-   collect heap garbage.
- bearbeite weitere auftraege:
-   REP   call (absender, antwort, ds, codenummer);
-         IF   codenummer > 255
-              THEN sende wert an interface
-         ELIF codenummer <  50
-              THEN hole wert von interface
-         ELIF codenummer = alles aus code
-
-              THEN initialisiere interface direkt
-         FI
-   UNTIL codenummer = endcode PER;
-   IF is error THEN clear error FI;
-   schliesse interface direkt.
-  sende wert an interface:
-    out (kanal [codenummer DIV 256].steuercode);
-    out (code (codenummer)).
-  hole wert von interface:
-    out (kanal [codenummer].steuercode);
-    SELECT kanal [codenummer].taktzahl OF
-      CASE 1 :  antwort := erstes  zeichen
-      CASE 2 :  antwort := zweites zeichen
-      CASE 3 :  antwort := drittes zeichen
-
-      OTHERWISE antwort := -1
-    END SELECT.
-    erstes zeichen:
-      code (incharety (1)).
-    zweites zeichen:
-      dummy := incharety (1);
-      code (incharety (1)).
-    drittes zeichen:
-      dummy := incharety (1);
-      dummy := incharety (1);
-      code (incharety (1)).
-END PROC kanalkoppler;
-PROC interface kanal (INT CONST kanalnummer):
-  enable stop;
-  IF kanalnummer < 1 OR kanalnummer > 24
-     THEN errorstop ("Unzulaessige Kanalnummer")
-     ELSE interface channel := kanalnummer
-
-  FI
-END PROC interface kanal;
-INT PROC interface kanal:
-  interface channel
-END PROC interface kanal;
-PROC oeffne interface direkt (INT VAR status):
-  leere puffer;
-  out (interface test code);
-  IF antwort <> ""
-     THEN status := 0;
-          out (interface open code)
-     ELSE status := interface error code
-  FI.
-  leere puffer:
-    REP  UNTIL incharety = "" PER.
-  antwort: incharety (1).
-END PROC oeffne interface direkt;
-PROC schliesse interface direkt:
-  out (interface close code)
-
-END PROC schliesse interface direkt;
-PROC initialisiere interface direkt:
-  schalte alles aus.
-  schalte alles aus:
-    INT VAR kanalnummer, kanalbetriebsart;
-    FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-        kanalbetriebsart := kanal [kanalnummer].betriebsart;
-        IF   kanalbetriebsart = digital aus
-             THEN direkt ausgeben (kanalnummer, 0)
-        ELIF kanalbetriebsart = analog aus
-             THEN direkt ausgeben (kanalnummer, gewandelte nullspannung)
-        FI
-
-    PER.
-  gewandelte nullspannung:
-    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).
-    u max :  spannung [kanalnummer].maximalwert.
-    u min :  spannung [kanalnummer].minimalwert.
-END PROC initialisiere interface direkt;
-PROC direkt ausgeben (INT CONST kanalnummer, wert):
- out (kanal [kanalnummer].steuercode);
- out (code (wert))
-END PROC direkt ausgeben;
-INT PROC direkt eingabe (INT CONST kanalnummer):
-  gib lesecode aus;
-  erhaltene antwort.
-  gib lesecode aus:
-
-    out (kanal [kanalnummer].steuercode).
-  erhaltene antwort:
-    TEXT VAR dummy;
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1 :  erstes  zeichen
-      CASE 2 :  zweites zeichen
-      CASE 3 :  drittes zeichen
-      OTHERWISE -1
-    END SELECT.
-    erstes zeichen:
-      code (incharety (1)).
-    zweites zeichen:
-      dummy := incharety (1);
-      code (incharety (1)).
-    drittes zeichen:
-      dummy := incharety (1);
-      dummy := incharety (1);
-      code (incharety (1)).
-
-END PROC direkt eingabe;
-PROC initialisiere die kanaele:
-  INT VAR kanalnummer;
-  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);
-      vorherige ausgabe [kanalnummer] := 0
-  PER.
-  keine spannung:
-    ROW 2 REAL : (0.0, 0.0).
-  leere karte:
-    ROW 3 INT : (nicht belegt, 0, 0).
-END PROC initialisiere die kanaele;
-initialisiere die kanaele;
-END PACKET ls prozess 1
-
-
diff --git a/prozess/ls-Prozess 1 für MUFI als Endgerät b/prozess/ls-Prozess 1 für MUFI als Endgerät
deleted file mode 100644
index 3408230..0000000
--- a/prozess/ls-Prozess 1 für MUFI als Endgerät
+++ /dev/null
@@ -1,550 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 1                     ** 
-         **                                                      ** 
-         **           Anpassung für  MUFI als Endgerät           ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 26.01.90)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls prozess 1 DEFINES 
-       run pdv,
-       run pdv again,
-       initialisiere interface,
-       schalte alles aus,
-       ausgeben,
-       eingabe,
-       warte,
-       abbruch gewuenscht,
-       tue nichts,
-       trage kanaldaten ein,
-       beende kanaldaten eintragen,
-       hole spannungsbereich,
-       letzte ausgabe,
-       pruefe kanal,
-       pruefe abbruch,
-       teste interface,
-       oeffne interface,
-       schliesse interface,
-       nicht belegt,
-       digital aus,
-       analog aus,
-
-       digital ein,
-       analog ein,
-       kanalbreite,
-       ganzzahl obergrenze,
-       adapterart,
-    (* ------------------------- *)
-       kanalkoppler,
-       interface kanal,
-       oeffne interface direkt,
-       schliesse interface direkt,
-       initialisiere interface direkt,
-       direkt ausgeben,
-       direkt eingabe:
-(******************** A N P A S S U N G  A N  M U F I ********************)
-LET interface test  code = ""27""27"10",
-    interface okay  code = ""27""27"00",
-
-    interface open  code = ""27""27"1A18",
-    interface close code = ""25""27""27"13",
-    adresse 0 code       = ""61"",
-    leertakt  code       = ""62"",
-    interface write code =   80  ,
-    interface read  code =   64  ,
-    erwartete zeichen    =    4  ;
-TEXT CONST adapterart   :: "MUFI als Endgerät";
-TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):
-  IF   es ist ein ausgabekanal
-       THEN code (interface write code + device + 4 * steuerungscode)
-  ELIF es ist ein eingabekanal
-
-       THEN lesecode in abhaengigkeit von der taktzahl
-       ELSE ""
-  FI.
-  es ist ein ausgabekanal:
-    kanal [kanalnummer].betriebsart < 0.
-  es ist ein eingabekanal:
-    kanal [kanalnummer].betriebsart > 0.
-  device:
-    IF kanalnummer < 10
-       THEN 0
-       ELSE kanalnummer DIV 10  -  1
-    FI.
-  lesecode in abhaengigkeit von der taktzahl:
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1: lesecode
-      CASE 2: adresse 0 code + lesecode + lesecode
-      CASE 3: adresse 0 code + lesecode + zwei weitere takte
-
-    OTHERWISE "" END SELECT.
-  lesecode  :  code (interface read code + device + 4 * steuerungscode).
-  zwei weitere takte:
-    IF leertakt code = ""
-       THEN lesecode + lesecode
-       ELSE kanal [kanalnummer].taktzahl DECR 1;
-            leertakt code + lesecode
-    FI.
-END PROC interface anpassung;
-(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************)
-LET       max kanalanzahl          =   49,
-          initcode                 =   50,
-          endcode                  =   51,
-
-          alles aus code           =   52,
-          endezeichen              =  "q",
-          abbruchzeichen           =  "h",
-          esc                      =  ""27"";
-INT CONST analog aus               ::  -2,            (* Betriebsarten *)
-          digital aus              ::  -1,
-          nicht belegt             ::   0,
-          digital ein              ::   1,
-          analog  ein              ::   2,
-          kanalbreite              ::   8,
-          ganzzahl obergrenze      ::   2 ** kanalbreite,
-
-          configuration error code ::  -1,
-          kanal besetzt code       ::  -3,
-          interface error code     ::  -4,
-          not init code            ::  -5;
-INT VAR   interfacechannel         ::   2,
-          dummy;
-TEXT VAR  meldung                  ::  "";
-BOOL VAR  kanaldaten sind eingetragen :: FALSE,
-          endezeichen gegeben         :: FALSE,
-          programm mit pdv gestartet  :: FALSE,
-          fehler zu melden            :: FALSE;
-TASK VAR  interface task              :: niltask;
-
-DATASPACE VAR  ds :: nilspace;
-TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),
-     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);
-ROW max kanalanzahl INT      VAR vorherige ausgabe;
-ROW max kanalanzahl KANAL    VAR kanal;
-ROW max kanalanzahl SPANNUNG VAR spannung;
-ROW 5 TEXT CONST fehlermeldung :: ROW 5 TEXT :
-  ("Interface ist noch nicht konfiguriert!",
-   "Interface-Task ist besetzt!",
-   "Interface-Kanal ist belegt!",
-   "Interface meldet sich nicht!",
-   "Interface kann nicht geöffnet werden!");
-
-PROC run pdv:
-  run pdv (last param)
-END PROC run pdv;
-PROC run pdv (TEXT CONST programmname):
-  enable stop;
-  last param (programmname);
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run (programmname);
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv;
-PROC run pdv again:
-
-  enable stop;
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run again;
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv again;
-PROC melde programmende:
-  page;
-  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");
-  pause;
-  schalte alles aus
-END PROC melde programmende;
-
-PROC initialisiere interface:
-  enable stop;
-  pruefe abbruch;
-  IF programm mit pdv gestartet
-     THEN schalte alles aus
-     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!")
-  FI
-END PROC initialisiere interface;
-PROC schalte alles aus:
-  INT VAR k;
-  FOR k FROM 1 UPTO max kanalanzahl REP
-    vorherige ausgabe [k] := 0
-  PER;
-  forget (ds); ds := nilspace;
-  call (interface task, alles aus code, ds, dummy)
-END PROC schalte alles aus;
-PROC ausgeben (INT CONST kanalnummer, wert):
-
-  merke wert;
-  gib wert aus.
-  merke wert:
-    vorherige ausgabe [kanalnummer] := wert.
-  gib wert aus:
-    call (interface task, 256 * kanalnummer + wert, ds, dummy).
-END PROC ausgeben;
-INT PROC eingabe (INT CONST kanalnummer):
-  INT VAR eingabewert;
-  call (interface task, kanalnummer, ds, eingabewert);
-  eingabewert
-END PROC eingabe;
-PROC warte (REAL CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (int (sekunden * 10.0 + 0.5));
-  IF eingabe = esc
-
-     THEN untersuche naechstes zeichen
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-PROC warte (INT CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (sekunden * 10);
-  IF eingabe = esc
-     THEN untersuche naechstes zeichen
-
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-BOOL PROC abbruch gewuenscht:
-  pruefe abbruch;
-  BOOL VAR entscheidung :: endezeichen gegeben;
-  endezeichen gegeben := FALSE;
-  entscheidung
-END PROC abbruch gewuenscht;
-PROC tue nichts:
-
-  pruefe abbruch
-END PROC tue nichts;
-PROC trage kanaldaten ein (INT CONST  kanalnummer,
-                           ROW 2 REAL CONST spannungsbereich,
-                           ROW 3 INT  CONST kanalparameter):
-   spannung [kanalnummer].minimalwert := spannungsbereich [1];
-   spannung [kanalnummer].maximalwert := spannungsbereich [2];
-   kanal [kanalnummer].betriebsart    := kanalparameter   [1];
-   kanal [kanalnummer].taktzahl       := kanalparameter   [2];
-   kanal [kanalnummer].steuercode     := interface anpassung
-
-                                         (kanalnummer, kanalparameter [3])
-END PROC trage kanaldaten ein;
-PROC beende kanaldaten eintragen:
-  loesche interface task;
-  begin (PROC kanal koppler, interface task);
-  kanaldaten sind eingetragen := TRUE.
-  loesche interface task:
-    disable stop;
-    end (interface task);
-    IF is error
-       THEN clear error
-    FI;
-    enable stop.
-END PROC beende kanaldaten eintragen;
-PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):
-
-  u min := spannung [kanalnummer].minimalwert;
-  u max := spannung [kanalnummer].maximalwert
-END PROC hole spannungsbereich;
-INT PROC letzte ausgabe (INT CONST kanalnummer):
-  vorherige ausgabe [kanalnummer]
-END PROC letzte ausgabe;
-PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):
-  pruefe abbruch;
-  pruefe kanalnummer;
-  pruefe betriebsart.
-  pruefe kanalnummer:
-    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl
-       THEN errorstop ("Kanalnummer " + text (kanalnummer) +
-
-                        " ist unzulaessig !")
-    FI.
-  pruefe betriebsart:
-    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart
-       THEN errorstop ("An Kanal " + text (kanalnummer) +
-                          " keine " +  wunsch + " moeglich!")
-    FI.
-  wunsch:
-    IF   gewuenschte betriebsart = analog aus
-         THEN "Analog-Ausgabe"
-    ELIF gewuenschte betriebsart = digital aus
-         THEN "Digital-Ausgabe"
-    ELIF gewuenschte betriebsart = digital ein
-         THEN "Digital-Eingabe"
-
-    ELIF gewuenschte betriebsart = analog ein
-         THEN "Analog-Eingabe"
-         ELSE "Ein- oder Ausgabe"
-    FI.
-END PROC pruefe kanal;
-PROC pruefe abbruch:
-  IF incharety = esc
-     THEN pruefe weiter
-  FI.
-  pruefe weiter:
-    TEXT CONST zeichen :: incharety (30);
-    IF   zeichen = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF zeichen = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-
-    FI.
-END PROC pruefe abbruch;
-PROC oeffne interface (INT VAR status):
-  enable stop;
-  forget (ds); ds := nilspace;
-  IF kanaldaten sind eingetragen
-     THEN pingpong (interfacetask, initcode, ds, status)
-     ELSE status := configuration error code
-  FI;
-  IF status > 0 THEN status DECR maxint FI;
-  forget (ds); ds := nilspace
-END PROC oeffne interface;
-PROC schliesse interface:
-  enable stop;
-  forget (ds); ds := nilspace;
-  pingpong (interface task, end code, ds, dummy);
-  forget (ds); ds := nilspace
-
-END PROC schliesse interface;
-PROC teste interface:
-  INT VAR test;
-  oeffne interface (test);
-  IF test < 0
-     THEN errorstop (fehlermeldung [min (5, abs (test))])
-     ELSE fehler zu melden           := FALSE;
-          endezeichen gegeben        := FALSE
-  FI
-END PROC teste interface;
-PROC fehlerbehandlung:
-  meldung := errormessage;
-  IF meldung <> ""
-     THEN meldung CAT fehlerzeile;
-          fehler zu melden := TRUE
-  FI;
-  clear error;
-  initialisiere interface.
-  fehlerzeile:
-
-    IF errorline = 0
-       THEN ""
-       ELSE " (bei Zeile " + text (errorline) + ")"
-    FI.
-END PROC fehlerbehandlung;
-(********************  EIN-/AUSGABE AM INTERFACE-KANAL ********************)
-PROC kanalkoppler:
-  IF name (myself) <> "-"
-     THEN errorstop ("Unzulässiges Kommando!")
-     ELSE warte auf anrufe
-  FI.
-  warte auf anrufe:
-    TASK      VAR absender;
-    TEXT      VAR dummy;
-    INT       VAR codenummer, antwort;
-    disable stop;
-    REP forget (ds);
-        wait (ds, codenummer, absender);
-
-        IF codenummer = initcode
-           THEN kopple an interface kanal;
-                IF interface ist betriebsbereit
-                   THEN bearbeite weitere auftraege
-                   ELSE gib negative rueckmeldung
-                FI;
-                gib kanal frei
-           ELSE antwort := not init code;
-                gib negative rueckmeldung
-        FI
-    PER.
- kopple an interface kanal:
-  continue (interface channel);
-  IF is error
-     THEN clear error;
-          antwort := kanal besetzt code
-
-     ELSE oeffne interface direkt (antwort)
-  FI.
- interface ist betriebsbereit:  antwort = 0.
- gib negative rueckmeldung:     send (absender, antwort, ds).
- gib kanal frei:
-   break (quiet);
-   send  (absender, 0, ds, antwort);
-   collect heap garbage.
- bearbeite weitere auftraege:
-   REP   call (absender, antwort, ds, codenummer);
-         IF   codenummer > 255
-              THEN sende wert an interface
-         ELIF codenummer <  50
-              THEN hole wert von interface
-         ELIF codenummer = alles aus code
-
-              THEN initialisiere interface direkt
-         FI
-   UNTIL codenummer = endcode PER;
-   IF is error THEN clear error FI;
-   schliesse interface direkt.
-  sende wert an interface:
-    out (kanal [codenummer DIV 256].steuercode);
-    out (code (codenummer)).
-  hole wert von interface:
-    out (kanal [codenummer].steuercode);
-    SELECT kanal [codenummer].taktzahl OF
-      CASE 1 :  antwort := erstes  zeichen
-      CASE 2 :  antwort := zweites zeichen
-      CASE 3 :  antwort := drittes zeichen
-
-      OTHERWISE antwort := -1
-    END SELECT.
-    erstes zeichen:
-      code (incharety (1)).
-    zweites zeichen:
-      dummy := incharety (1);
-      code (incharety (1)).
-    drittes zeichen:
-      dummy := incharety (1);
-      dummy := incharety (1);
-      code (incharety (1)).
-END PROC kanalkoppler;
-PROC interface kanal (INT CONST kanalnummer):
-  enable stop;
-  IF kanalnummer < 1 OR kanalnummer > 24
-     THEN errorstop ("Unzulaessige Kanalnummer")
-     ELSE interface channel := kanalnummer
-
-  FI
-END PROC interface kanal;
-INT PROC interface kanal:
-  interface channel
-END PROC interface kanal;
-PROC oeffne interface direkt (INT VAR status):
-  leere puffer;
-  out (interface test code);
-  fange antwort;
-  IF antwort = interface okay code
-     THEN status := 0;
-          out (interface open code)
-     ELSE status := interface error code
-  FI.
-  leere puffer:
-    REP  UNTIL incharety = "" PER.
-  fange antwort:
-    INT  VAR zaehler;
-    TEXT VAR antwort :: "";
-    FOR zaehler FROM 1 UPTO erwartete zeichen REP
-
-      antwort CAT incharety (1)
-    PER.
-END PROC oeffne interface direkt;
-PROC schliesse interface direkt:
-  out (interface close code)
-END PROC schliesse interface direkt;
-PROC initialisiere interface direkt:
-  schalte alles aus.
-  schalte alles aus:
-    INT VAR kanalnummer, kanalbetriebsart;
-    FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-        kanalbetriebsart := kanal [kanalnummer].betriebsart;
-        IF   kanalbetriebsart = digital aus
-             THEN direkt ausgeben (kanalnummer, 0)
-
-        ELIF kanalbetriebsart = analog aus
-             THEN direkt ausgeben (kanalnummer, gewandelte nullspannung)
-        FI
-    PER.
-  gewandelte nullspannung:
-    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).
-    u max :  spannung [kanalnummer].maximalwert.
-    u min :  spannung [kanalnummer].minimalwert.
-END PROC initialisiere interface direkt;
-PROC direkt ausgeben (INT CONST kanalnummer, wert):
- out (kanal [kanalnummer].steuercode);
- out (code (wert))
-END PROC direkt ausgeben;
-
-INT PROC direkt eingabe (INT CONST kanalnummer):
-  gib lesecode aus;
-  erhaltene antwort.
-  gib lesecode aus:
-    out (kanal [kanalnummer].steuercode).
-  erhaltene antwort:
-    TEXT VAR dummy;
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1 :  erstes  zeichen
-      CASE 2 :  zweites zeichen
-      CASE 3 :  drittes zeichen
-      OTHERWISE -1
-    END SELECT.
-    erstes zeichen:
-      code (incharety (1)).
-    zweites zeichen:
-      dummy := incharety (1);
-      code (incharety (1)).
-
-    drittes zeichen:
-      dummy := incharety (1);
-      dummy := incharety (1);
-      code (incharety (1)).
-END PROC direkt eingabe;
-PROC initialisiere die kanaele:
-  INT VAR kanalnummer;
-  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);
-      vorherige ausgabe [kanalnummer] := 0
-  PER.
-  keine spannung:
-    ROW 2 REAL : (0.0, 0.0).
-  leere karte:
-    ROW 3 INT : (nicht belegt, 0, 0).
-END PROC initialisiere die kanaele;
-
-initialisiere die kanaele;
-END PACKET ls prozess 1
-
-
diff --git a/prozess/ls-Prozess 1 für MUFI im Terminalkanal b/prozess/ls-Prozess 1 für MUFI im Terminalkanal
deleted file mode 100644
index 712b8a2..0000000
--- a/prozess/ls-Prozess 1 für MUFI im Terminalkanal
+++ /dev/null
@@ -1,506 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 1                     ** 
-         **                                                      ** 
-         **         Anpassung für  MUFI im Terminalkanal         ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 26.01.90)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET altes incharety DEFINES old incharety: 
-TEXT PROC old incharety:
-  incharety
-END PROC old incharety;
-TEXT PROC old incharety (INT CONST timelimit):
-  incharety (timelimit)
-END PROC old incharety;
-END PACKET altes incharety;
-PACKET ls prozess 1 DEFINES
-       run pdv,
-       run pdv again,
-       initialisiere interface,
-       ausgeben,
-       eingabe,
-       warte,
-       abbruch gewuenscht,
-       tue nichts,
-       trage kanaldaten ein,
-       beende kanaldaten eintragen,
-       hole spannungsbereich,
-       letzte ausgabe,
-
-       pruefe kanal,
-       pruefe abbruch,
-       teste interface,
-      schalte alles aus,
-       oeffne interface,
-       schliesse interface,
-       nicht belegt,
-       digital aus,
-       analog aus,
-       digital ein,
-       analog ein,
-       kanalbreite,
-       ganzzahl obergrenze,
-       adapterart,
-       incharety,
-       inchar,
-       pause:
-(******************** A N P A S S U N G  A N  M U F I ********************)
-LET mufikennung       = ""31""31"",
-    erwartete zeichen =        4  ;
-
-TEXT CONST adapterart           :: "MUFI im Terminalkanal",
-           interface test  code :: ""27""27"10",
-           interface okay  code :: ""27""27"00",
-           interface open  code :: ""27""27"1C" + hex (mufikennung),
-           interface close code :: mufikennung  + "1C" + hex (""27""27""),
-           adresse 0 code       :: mufikennung + "3D",
-           leertakt  code       :: mufikennung + "3E",
-           interface write code :: mufikennung + "5" ,
-           interface read  code :: mufikennung + "4" ;
-
-TEXT VAR   puffer :: "";
-ROW 256 TEXT CONST hexcode :: ROW 256 TEXT : (
-"00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F",
-"10","11","12","13","14","15","16","17","18","19","1A","1B","1C","1D","1E","1F",
-"20","21","22","23","24","25","26","27","28","29","2A","2B","2C","2D","2E","2F",
-"30","31","32","33","34","35","36","37","38","39","3A","3B","3C","3D","3E","3F",
-"40","41","42","43","44","45","46","47","48","49","4A","4B","4C","4D","4E","4F",
-"50","51","52","53","54","55","56","57","58","59","5A","5B","5C","5D","5E","5F",
-
-"60","61","62","63","64","65","66","67","68","69","6A","6B","6C","6D","6E","6F",
-"70","71","72","73","74","75","76","77","78","79","7A","7B","7C","7D","7E","7F",
-"80","81","82","83","84","85","86","87","88","89","8A","8B","8C","8D","8E","8F",
-"90","91","92","93","94","95","96","97","98","99","9A","9B","9C","9D","9E","9F",
-"A0","A1","A2","A3","A4","A5","A6","A7","A8","A9","AA","AB","AC","AD","AE","AF",
-"B0","B1","B2","B3","B4","B5","B6","B7","B8","B9","BA","BB","BC","BD","BE","BF",
-"C0","C1","C2","C3","C4","C5","C6","C7","C8","C9","CA","CB","CC","CD","CE","CF",
-
-"D0","D1","D2","D3","D4","D5","D6","D7","D8","D9","DA","DB","DC","DD","DE","DF",
-"E0","E1","E2","E3","E4","E5","E6","E7","E8","E9","EA","EB","EC","ED","EE","EF",
-"F0","F1","F2","F3","F4","F5","F6","F7","F8","F9","FA","FB","FC","FD","FE","FF");
-TEXT PROC interface anpassung (INT CONST kanalnummer, steuerungscode):
-  LET  hexzeichen = "0123456789ABCDEF";
-  IF   es ist ein ausgabekanal
-       THEN interface write code
-            + (hexzeichen SUB (device + 4 * steuerungscode))
-  ELIF es ist ein eingabekanal
-
-       THEN lesecode in abhaengigkeit von der taktzahl
-       ELSE ""
-  FI.
-  es ist ein ausgabekanal:
-    kanal [kanalnummer].betriebsart < 0.
-  es ist ein eingabekanal:
-    kanal [kanalnummer].betriebsart > 0.
-  device:
-    IF kanalnummer < 10
-       THEN 1
-       ELSE kanalnummer DIV 10
-    FI.
-  lesecode in abhaengigkeit von der taktzahl:
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1: lesecode
-      CASE 2: adresse 0 code + lesecode + lesecode
-      CASE 3: adresse 0 code + lesecode + zwei weitere takte
-
-    OTHERWISE "" END SELECT.
-  lesecode:
-    interface read code + (hexzeichen SUB (device + 4 * steuerungscode)).
-  zwei weitere takte:
-    IF leertakt code = ""
-       THEN lesecode + lesecode
-       ELSE kanal [kanalnummer].taktzahl DECR 1;
-            leertakt code + lesecode
-    FI.
-END PROC interface anpassung;
-PROC ausgeben (INT CONST kanalnummer, wert):
-  merke wert;
-  gib wert aus.
-  merke wert:
-   vorherige ausgabe [kanalnummer] := wert.
-  gib wert aus:
-    out (kanal [kanalnummer].steuercode);
-
-    out (hexcode [wert + 1]).
-END PROC ausgeben;
-INT PROC eingabe (INT CONST kanalnummer):
-  gib lesecode aus;
-  erhaltene antwort.
-  gib lesecode aus:
-    out (kanal [kanalnummer].steuercode).
-  erhaltene antwort:
-    TEXT VAR dummy;
-    SELECT kanal [kanalnummer].taktzahl OF
-      CASE 1 :  erste  sendung
-      CASE 2 :  zweite sendung
-      CASE 3 :  dritte sendung
-      OTHERWISE -1
-    END SELECT.
-    erste sendung:
-      fange mufikennung;
-      dezimalwert (old incharety (1), old incharety (1)).
-
-    zweite sendung:
-      fange mufikennung;
-      dummy := old incharety (1);
-      dummy := old incharety (1);
-      erste sendung.
-    dritte sendung:
-      fange mufikennung;
-      dummy := old incharety (1);
-      dummy := old incharety (1);
-      zweite sendung.
-    fange mufikennung:
-      puffer CAT old incharety;
-      REP puffer CAT old incharety
-      UNTIL pos (puffer, mufikennung) > 0 PER;
-      puffer := subtext (puffer, 1, length (puffer) - 2).
-END PROC eingabe;
-(************ H A R D W A R E U N A B H Ä N G I G E R  T E I L ************)
-
-LET       max kanalanzahl          =   49,
-          endezeichen              =  "q",
-          abbruchzeichen           =  "h",
-          esc                      =  ""27"";
-INT CONST analog aus               ::  -2,            (* Betriebsarten *)
-          digital aus              ::  -1,
-          nicht belegt             ::   0,
-          digital ein              ::   1,
-          analog  ein              ::   2,
-          kanalbreite              ::   8,
-          ganzzahl obergrenze      ::   2 ** kanalbreite,
-
-          configuration error code ::  -1,
-          interface error code     ::  -4;
-TEXT VAR  meldung                  ::  "";
-BOOL VAR  kanaldaten sind eingetragen :: FALSE,
-          endezeichen gegeben         :: FALSE,
-          programm mit pdv gestartet  :: FALSE,
-          fehler zu melden            :: FALSE;
-TYPE KANAL     = STRUCT (INT  betriebsart, taktzahl, TEXT steuercode),
-     SPANNUNG  = STRUCT (REAL minimalwert, maximalwert);
-ROW max kanalanzahl INT      VAR vorherige ausgabe;
-
-ROW max kanalanzahl KANAL    VAR kanal;
-ROW max kanalanzahl SPANNUNG VAR spannung;
-PROC run pdv:
-  run pdv (last param)
-END PROC run pdv;
-PROC run pdv (TEXT CONST programmname):
-  enable stop;
-  last param (programmname);
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run (programmname);
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv;
-PROC run pdv again:
-  enable stop;
-  programm mit pdv gestartet := TRUE;
-  teste interface;
-  disable stop;
-  run again;
-  IF is error
-     THEN fehlerbehandlung
-     ELSE melde programmende
-  FI;
-  schliesse interface;
-  programm mit pdv gestartet := FALSE;
-  enable stop;
-  IF fehler zu melden
-     THEN errorstop (meldung)
-  FI
-END PROC run pdv again;
-PROC melde programmende:
-  page;
-  menufootnote ("Programmende! Zum Weitermachen bitte irgendeine Taste tippen.");
-
-  pause;
-  schalte alles aus
-END PROC melde programmende;
-PROC initialisiere interface:
-  enable stop;
-  pruefe abbruch;
-  IF programm mit pdv gestartet
-     THEN schalte alles aus
-     ELSE errorstop ("PDV-Programme müssen mit 'run pdv' gestartet werden!")
-  FI
-END PROC initialisiere interface;
-PROC schalte alles aus:
-  INT VAR kanalnummer, kanalbetriebsart;
-  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-      kanalbetriebsart := kanal [kanalnummer].betriebsart;
-      IF   kanalbetriebsart = digital aus
-
-           THEN ausgeben (kanalnummer, 0)
-      ELIF kanalbetriebsart = analog aus
-           THEN ausgeben (kanalnummer, gewandelte nullspannung)
-      FI
-  PER.
-  gewandelte nullspannung:
-    int(- real (ganzzahl obergrenze) * u min / (u max - u min) + 0.5).
-    u max :  spannung [kanalnummer].maximalwert.
-    u min :  spannung [kanalnummer].minimalwert.
-END PROC schalte alles aus;
-PROC warte (REAL CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (int (sekunden * 10.0 + 0.5));
-
-  IF eingabe = esc
-     THEN untersuche naechstes zeichen
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-PROC warte (INT CONST sekunden):
-  TEXT VAR eingabe;
-  pruefe abbruch;
-  eingabe := incharety (sekunden * 10);
-  IF eingabe = esc
-
-     THEN untersuche naechstes zeichen
-  FI.
-  untersuche naechstes zeichen:
-    eingabe := incharety (30);
-    IF   eingabe = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF eingabe = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC warte;
-TEXT PROC incharety:
-  IF puffer = ""
-     THEN old incharety
-     ELSE erstes zeichen von puffer
-  FI.
-  erstes zeichen von puffer:
-    TEXT CONST zeichen :: puffer SUB 1;
-
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC incharety;
-TEXT PROC incharety (INT CONST timelimit):
-  IF puffer = ""
-     THEN old incharety (timelimit)
-     ELSE erstes zeichen von puffer
-  FI.
-  erstes zeichen von puffer:
-    TEXT CONST zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC incharety;
-PROC inchar (TEXT VAR character):
-  REP character := incharety
-  UNTIL character <> "" PER
-END PROC inchar;
-PROC pause:
-  TEXT VAR dummy;
-  inchar (dummy)
-
-END PROC pause;
-PROC pause (INT CONST timelimit):
-  TEXT VAR dummy := incharety (timelimit)
-END PROC pause;
-BOOL PROC abbruch gewuenscht:
-  pruefe abbruch;
-  BOOL VAR entscheidung :: endezeichen gegeben;
-  endezeichen gegeben := FALSE;
-  entscheidung
-END PROC abbruch gewuenscht;
-PROC tue nichts:
-  pruefe abbruch
-END PROC tue nichts;
-PROC trage kanaldaten ein (INT CONST  kanalnummer,
-                           ROW 2 REAL CONST spannungsbereich,
-                           ROW 3 INT  CONST kanalparameter):
-
-   spannung [kanalnummer].minimalwert := spannungsbereich [1];
-   spannung [kanalnummer].maximalwert := spannungsbereich [2];
-   kanal [kanalnummer].betriebsart    := kanalparameter   [1];
-   kanal [kanalnummer].taktzahl       := kanalparameter   [2];
-   kanal [kanalnummer].steuercode     := interface anpassung
-                                         (kanalnummer, kanalparameter [3])
-END PROC trage kanaldaten ein;
-PROC beende kanaldaten eintragen:
-  kanaldaten sind eingetragen := TRUE
-END PROC beende kanaldaten eintragen;
-
-PROC hole spannungsbereich (INT CONST kanalnummer, REAL VAR  u min, u max):
-  u min := spannung [kanalnummer].minimalwert;
-  u max := spannung [kanalnummer].maximalwert
-END PROC hole spannungsbereich;
-INT PROC letzte ausgabe (INT CONST kanalnummer):
-  vorherige ausgabe [kanalnummer]
-END PROC letzte ausgabe;
-PROC pruefe kanal (INT CONST kanalnummer, gewuenschte betriebsart):
-  pruefe abbruch;
-  pruefe kanalnummer;
-  pruefe betriebsart.
-  pruefe kanalnummer:
-    IF kanalnummer < 1 OR kanalnummer > max kanalanzahl
-
-       THEN errorstop ("Kanalnummer " + text (kanalnummer) +
-                        " ist unzulaessig !")
-    FI.
-  pruefe betriebsart:
-    IF gewuenschte betriebsart <> kanal [kanalnummer].betriebsart
-       THEN errorstop ("An Kanal " + text (kanalnummer) +
-                          " keine " +  wunsch + " moeglich!")
-    FI.
-  wunsch:
-    IF   gewuenschte betriebsart = analog aus
-         THEN "Analog-Ausgabe"
-    ELIF gewuenschte betriebsart = digital aus
-         THEN "Digital-Ausgabe"
-
-    ELIF gewuenschte betriebsart = digital ein
-         THEN "Digital-Eingabe"
-    ELIF gewuenschte betriebsart = analog ein
-         THEN "Analog-Eingabe"
-         ELSE "Ein- oder Ausgabe"
-    FI.
-END PROC pruefe kanal;
-PROC pruefe abbruch:
-  TEXT VAR zeichen :: incharety;
-  IF zeichen = esc
-     THEN pruefe weiter
-  FI.
-  pruefe weiter:
-    zeichen := incharety (30);
-    IF   zeichen = endezeichen
-         THEN endezeichen gegeben := TRUE
-    ELIF zeichen = abbruchzeichen
-         THEN errorstop ("Programm-Abbruch durch <ESC><"
-
-                             + abbruchzeichen + ">!")
-    FI.
-END PROC pruefe abbruch;
-PROC oeffne interface (INT VAR status):
-  enable stop;
-  IF kanaldaten sind eingetragen
-     THEN teste interface funktion
-     ELSE status := configuration error code
-  FI.
-  teste interface funktion:
-    leere puffer;
-    out (interface test code);
-    fange antwort;
-    IF antwort = interface okay code
-       THEN status := 0;
-            out (interface open code)
-       ELSE status := interface error code
-
-    FI.
-  leere puffer:
-    puffer := "";
-    REP  UNTIL old incharety = "" PER.
-  fange antwort:
-    INT  VAR zaehler;
-    TEXT VAR antwort :: "";
-    FOR zaehler FROM 1 UPTO erwartete zeichen REP
-      antwort CAT old incharety (1)
-    PER.
-END PROC oeffne interface;
-PROC schliesse interface:
-  enable stop;
-  out (interface close code)
-END PROC schliesse interface;
-(*********************  H I L F S P R O Z E D U R E N *********************)
-PROC teste interface:
-  INT VAR test;
-
-  warte etwas;
-  oeffne interface (test);
-  IF test < 0
-     THEN errorstop (fehlermeldung)
-     ELSE endezeichen gegeben        := FALSE;
-          fehler zu melden           := FALSE
-  FI.
-  warte etwas:
-    pause (1); pause (1); pause (1); pause (1); pause (1).
-  fehlermeldung:
-    IF   test = configuration error code
-         THEN "Interface ist noch nicht konfiguriert!"
-    ELIF test = interface error code
-         THEN "Interface meldet sich nicht!"
-         ELSE "Interface kann nicht geöffnet werden!"
-
-    FI.
-END PROC teste interface;
-PROC fehlerbehandlung:
-  meldung := errormessage;
-  IF meldung <> ""
-     THEN meldung CAT fehlerzeile;
-          fehler zu melden := TRUE
-  FI;
-  clear error;
-  initialisiere interface.
-  fehlerzeile:
-    IF errorline = 0
-       THEN ""
-       ELSE " (bei Zeile " + text (errorline) + ")"
-    FI.
-END PROC fehlerbehandlung;
-INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):
-  16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).
-  hexzeichen: "123456789ABCDEF".
-
-END PROC dezimalwert;
-TEXT PROC hex (TEXT CONST zwei zeichen):
-  hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2))
-END PROC hex;
-TEXT PROC hex (INT CONST wert):
-  (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).
-  hexzeichen: "0123456789ABCDEF".
-END PROC hex;
-PROC initialisiere die kanaele:
-  INT VAR kanalnummer;
-  FOR kanalnummer FROM 1 UPTO max kanalanzahl REP
-      trage kanaldaten ein (kanalnummer, keine spannung, leere karte);
-      vorherige ausgabe [kanalnummer] := 0
-
-  PER.
-  keine spannung:
-    ROW 2 REAL : (0.0, 0.0).
-  leere karte:
-    ROW 3 INT : (nicht belegt, 0, 0).
-END PROC initialisiere die kanaele;
-initialisiere die kanaele
-END PACKET ls prozess 1
-
-
diff --git a/prozess/ls-Prozess 2 b/prozess/ls-Prozess 2
deleted file mode 100644
index 3b8d407..0000000
--- a/prozess/ls-Prozess 2
+++ /dev/null
@@ -1,238 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 2                     ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 06.06.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls prozess 2 DEFINES                   
-       wert an analogausgang ausgeben,
-       spannungswert ausgeben,
-       bitsymbol ausgeben,
-       bitmuster ausgeben,
-       dezimalwert ausgeben,
-       bitmuster gleich,
-       bit ist gesetzt,
-       wert von analogeingang,
-       spannungswert,
-       bitsymbol,
-       bitmuster,
-       dezimalwert:
-LET    eins   = "I",
-       null   = "O",
-       invers = "T",
-       egal   = "X";
-REAL CONST maximalwert :: real (ganzzahl obergrenze - 1);
-(********************* A U S G A B E - B E F E H L E *********************)
-
-PROC wert an analogausgang ausgeben (INT CONST kanal, wert):
-  pruefe kanal (kanal, analog aus);
-  ausgeben (kanal, wert MOD ganzzahlobergrenze)
-END PROC wert an analogausgang ausgeben;
-PROC spannungswert ausgeben (INT  CONST kanal, REAL CONST wert):
-  pruefe kanal (kanal, analog aus);
-  pruefe spannungswert;
-  ausgeben (kanal, gewandelte spannung).
-  pruefe spannungswert:
-    REAL VAR u min, u max;
-    hole spannungsbereich (kanal, u min, u max);
-    IF wert < u min OR wert > u max
-       THEN errorstop ("Der Spannungswert " + text (wert) +
-
-                       " ist nicht zulaessig!")
-    FI.
-  gewandelte spannung:
-    int (((wert - u min) * maximalwert) / (u max - u min) + 0.5).
-END PROC spannungswert ausgeben;
-PROC bitsymbol ausgeben (INT  CONST kanal, bitnummer, TEXT CONST zeichen):
-  pruefe kanal (kanal, digital aus);
-  pruefe bitnummer (bitnummer);
-  ausgeben (kanal, relativer dezimalwert (zeichen, bitnummer, kanal))
-END PROC bitsymbol ausgeben;
-PROC bitmuster ausgeben (INT  CONST kanal, TEXT CONST zeichenkette):
-
-  pruefe kanal (kanal, digital aus);
-  ausgeben (kanal, relativer dezimalwert (zeichenkette, kanal))
-END PROC bitmuster ausgeben;
-PROC dezimalwert ausgeben (INT CONST kanal, wert):
-  pruefe kanal (kanal, digital aus);
-  ausgeben (kanal, wert MOD ganzzahl obergrenze)
-END PROC dezimalwert ausgeben;
-(********************* E I N G A B E - B E F E H L E *********************)
-BOOL PROC bitmuster gleich (INT CONST kanal, TEXT CONST zeichenkette):
-  INT CONST eingabewert :: dezimalwert (kanal);
-
-  pruefe zeichenkette;
-  eingabe passt zur zeichenkette.
-  pruefe zeichenkette:
-    IF length (zeichenkette) <> kanalbreite
-       THEN errorstop ("Das Bitmuster '" + zeichenkette +
-                       "' hat eine unzulaessige Laenge!")
-    FI.
-  eingabe passt zur zeichenkette:
-   INT VAR stelle;
-   BOOL VAR abweichung gefunden :: FALSE;
-   FOR stelle FROM 1 UPTO kanalbreite REP
-     teste bit an dieser stelle
-   UNTIL abweichung gefunden PER;
-   NOT abweichung gefunden.
- teste bit an dieser stelle:
-
-   TEXT CONST einzelbit :: zeichenkette SUB stelle;
-   IF   einzelbit = eins
-        THEN teste eingabebit auf eins
-   ELIF einzelbit = null
-        THEN teste eingabebit auf null
-   ELIF einzelbit = egal
-        THEN eingabebit ist beliebig
-   ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +
-                   "Bitsymbol in '" + zeichenkette + "'!")
-   FI.
- teste eingabebit auf eins:
-   IF NOT bit (eingabewert, kanalbreite - stelle)
-      THEN abweichung gefunden := TRUE
-   FI.
-
- teste eingabebit auf null:
-   IF bit (eingabewert, kanalbreite - stelle)
-      THEN abweichung gefunden := TRUE
-   FI.
- eingabebit ist beliebig:
-   .
-END PROC bitmuster gleich;
-BOOL PROC bit ist gesetzt (INT CONST kanal, bitnummer):
-  pruefe kanal (kanal, digital ein);
-  pruefe bitnummer (bitnummer);
-  IF bit (eingabe (kanal), bitnummer)
-     THEN TRUE
-     ELSE FALSE
-  FI
-END PROC bit ist gesetzt;
-INT PROC wert von analogeingang (INT CONST kanal):
-  pruefe kanal (kanal, analog ein);
-
-  eingabe (kanal)
-END PROC wert von analogeingang;
-REAL PROC spannungswert (INT CONST kanal):
-  INT CONST dezimalwert :: wert von analogeingang (kanal);
-  REAL  VAR u min, u max;
-  hole spannungsbereich (kanal, u min, u max);
-  round (real (dezimalwert) * (u max - u min) / maximalwert + u min, 3)
-END PROC spannungswert;
-TEXT PROC bitsymbol (INT CONST kanal, bitnummer):
-  pruefe kanal (kanal, digital ein);
-  pruefe bitnummer (bitnummer);
-  IF bit (eingabe (kanal), bitnummer)
-     THEN eins
-
-     ELSE null
-  FI
-END PROC bitsymbol;
-TEXT PROC bitmuster (INT CONST kanal):
-  TEXT VAR   zeichenkette :: "";
-  INT  CONST wert         :: dezimalwert (kanal);
-  wandle wert;
-  zeichenkette.
-  wandle wert:
-    INT VAR zeiger;
-    FOR zeiger FROM kanalbreite - 1 DOWNTO 0 REP
-      IF bit (wert, zeiger)
-         THEN zeichenkette CAT eins
-         ELSE zeichenkette CAT null
-      FI
-    PER.
-END PROC bitmuster;
-INT PROC dezimalwert (INT CONST kanal):
-  pruefe kanal (kanal, digital ein);
-
-  eingabe (kanal)
-END PROC dezimalwert;
-(******************** H I L F S - P R O Z E D U R E N ********************)
-INT PROC relativer dezimalwert (TEXT CONST zeichenkette, INT CONST kanal):
-   INT VAR wert := letzte ausgabe (kanal);
-   pruefe zeichenkette auf korrekte laenge;
-   veraendere alten wert;
-   wert.
-   pruefe zeichenkette auf korrekte laenge:
-     IF length (zeichenkette) <> kanalbreite
-        THEN errorstop ("Bitmuster '" + zeichenkette + "' hat "
-                                      + "unzulaessige Laenge!")
-
-     FI.
-   veraendere alten wert:
-     INT VAR zeiger;
-     FOR zeiger FROM 1 UPTO kanalbreite REP
-       veraendere dieses bit
-     PER.
-   veraendere dieses bit:
-     TEXT CONST einzelbit :: zeichenkette SUB zeiger;
-     IF   einzelbit = eins   THEN setze bit
-     ELIF einzelbit = null   THEN loesche bit
-     ELIF einzelbit = invers THEN invertiere bit
-     ELIF einzelbit = egal   THEN lasse bit
-     ELSE errorstop ("'" + einzelbit + "' ist unzulaessiges " +
-                     "Bitsymbol in '" + zeichenkette + "'!")
-
-     FI.
-   setze bit:
-     set bit (wert, kanalbreite - zeiger).
-   loesche bit:
-     reset bit (wert, kanalbreite - zeiger).
-   invertiere bit:
-     IF bit (wert, kanalbreite - zeiger)
-        THEN loesche bit
-        ELSE setze bit
-     FI.
-   lasse bit:
-     .
-  END PROC relativer dezimalwert;
-INT PROC relativer dezimalwert (TEXT CONST bitzeichen,
-                                INT  CONST bitnummer, kanal):
-    INT VAR wert :: letzte ausgabe (kanal);
-    IF   bitzeichen = eins   THEN setze bit
-
-    ELIF bitzeichen = null   THEN loesche bit
-    ELIF bitzeichen = invers THEN invertiere bit
-    ELIF bitzeichen = egal   THEN lasse bit
-    ELSE errorstop ("'" + bitzeichen + "' ist ein unzulaessiges " +
-                                       "Bitsymbol!")
-    FI;
-    wert.
-   setze bit:
-     set bit (wert, bitnummer).
-   loesche bit:
-     reset bit (wert, bitnummer).
-   invertiere bit:
-     IF bit (wert, bitnummer)
-        THEN loesche bit
-        ELSE setze bit
-     FI.
-   lasse bit:
-
-     .
-END PROC relativer dezimalwert;
-PROC pruefe bitnummer (INT CONST bitnummer):
-  IF bitnummer < 0  OR  bitnummer > kanalbreite - 1
-     THEN errorstop ("Bitnummer " + text (bitnummer) +
-                     " ist nicht zulaessig!")
-  FI
-END PROC pruefe bitnummer
-END PACKET ls prozess 2
-
-
diff --git a/prozess/ls-Prozess 4 b/prozess/ls-Prozess 4
deleted file mode 100644
index 59a1493..0000000
--- a/prozess/ls-Prozess 4
+++ /dev/null
@@ -1,595 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 4                     ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 26.01.90)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls prozess 4 DEFINES 
-           pdv befehlsuebersicht anzeigen,
-           pdv ausgabebefehle anzeigen,
-           pdv eingabebefehle anzeigen,
-           pdv testbefehle anzeigen,
-           pdv weitere befehle anzeigen,
-           pdv bitmuster erlaeutern,
-           pdv symbole erlaeutern,
-           pdv digital analog werte,
-           pdv programm neu erstellen,
-           pdv programm ansehen,
-           pdv programm starten,
-           pdv programm wiederholen,
-           pdv dateien verzeichnis,
-
-           pdv datei kopieren,
-           pdv datei umbenennen,
-           pdv dateien loeschen,
-           pdv dateien drucken,
-           init pdv,
-           pdv:
-LET  menukarte       = "ls-MENUKARTE:Prozess",
-     niltext         =         "",
-     maxlaenge       =         45,
-     maxnamenslaenge =         35;
-WINDOW VAR w :: window (1, 3, 79, 19);
-TEXT   VAR programmname :: "";
-BOOL   VAR noch kein programm gelaufen :: TRUE;
-PROC pdv:
-  init pdv;
-  install menu (menukarte, FALSE);
-
-  handle menu  ("PDV")
-END PROC pdv;
-PROC init pdv:
-  programmname := "";
-  noch kein programm gelaufen := TRUE;
-  cursor off;
-END PROC init pdv;
-PROC pdv befehlsuebersicht anzeigen:
-  menuinfo (anwendungstext (20))
-END PROC pdv befehlsuebersicht anzeigen;
-PROC pdv ausgabebefehle anzeigen:
-  INT VAR i;
-  REP
-    i := menualternative (anwendungstext (1), anwendungstext (3),
-                          anwendungstext (4), 5, TRUE);
-    SELECT i OF
-      CASE 1, 101: menuinfo (anwendungstext (21))
-
-      CASE 2, 102: menuinfo (anwendungstext (22))
-      CASE 3, 103: menuinfo (anwendungstext (23))
-      CASE 4, 104: menuinfo (anwendungstext (24))
-      CASE 5, 105: menuinfo (anwendungstext (25))
-    END SELECT
-  UNTIL i = 6 OR i = 106 PER;
-END PROC pdv ausgabebefehle anzeigen;
-PROC pdv eingabebefehle anzeigen:
-  INT VAR i;
-  REP
-    i := menualternative (anwendungstext (2), anwendungstext (3),
-                          anwendungstext (4), 5, TRUE);
-    SELECT i OF
-      CASE 1, 101: menuinfo (anwendungstext (31))
-
-      CASE 2, 102: menuinfo (anwendungstext (32))
-      CASE 3, 103: menuinfo (anwendungstext (33))
-      CASE 4, 104: menuinfo (anwendungstext (34))
-      CASE 5, 105: menuinfo (anwendungstext (35))
-    END SELECT
-  UNTIL i = 6 OR i = 106 PER;
-END PROC pdv eingabebefehle anzeigen;
-PROC pdv testbefehle anzeigen:
-  INT VAR i;
-  REP
-    i := menualternative (anwendungstext (5), anwendungstext (7),
-                          anwendungstext (8), 5, TRUE);
-    SELECT i OF
-      CASE 1, 101: menuinfo (anwendungstext (41))
-
-      CASE 2, 102: menuinfo (anwendungstext (42))
-    END SELECT
-  UNTIL i = 3 OR i = 103 PER;
-END PROC pdv testbefehle anzeigen;
-PROC pdv weitere befehle anzeigen:
-  INT VAR i;
-  REP
-    i := menualternative (anwendungstext (6), anwendungstext (7),
-                          anwendungstext (8), 5, TRUE);
-    SELECT i OF
-      CASE 1, 101: menuinfo (anwendungstext (43))
-      CASE 2, 102: menuinfo (anwendungstext (44))
-    END SELECT
-  UNTIL i = 3 OR i = 103 PER;
-END PROC pdv weitere befehle anzeigen;
-
-PROC pdv bitmuster erlaeutern:
-  menuinfo (anwendungstext (46))
-END PROC pdv bitmuster erlaeutern;
-PROC pdv symbole erlaeutern:
-  menuinfo (anwendungstext (47))
-END PROC pdv symbole erlaeutern;
-PROC pdv digital analog werte:
-  menuinfo (anwendungstext (48))
-END PROC pdv digital analog werte;
-PROC pdvdateien verzeichnis:
-  disable stop;
-  forget ("Verzeichnis der Dateien", quiet);
-  THESAURUS VAR programme :: ALL myself;
-  FILE VAR f ::
-  sequential file (output, "Verzeichnis der Dateien");
-
-  f FILLBY programme;
-  modify (f);
-  to line (f, 1); insert record (f);
-  menufootnote ("Verlassen: <ESC> <q>");
-  cursor on;
-  show (w, f);
-  cursor off;
-  forget ("Verzeichnis der Dateien", quiet);
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop
-END PROC pdvdateien verzeichnis;
-PROC pdvprogramm neu erstellen:
-  hole programmname;
-
-  kontrolliere den programmnamen;
-  command dialogue (FALSE);
-  cursor on;
-  disable stop;
-  stdinfoedit (programmname, 3);
-  cursor off;
-  command dialogue (TRUE);
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers (errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop.
-  hole programmname:
-    programmname := "";
-    programmname := menuanswer (ausgabe, programmname, 5).
-  ausgabe:
-    center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""
-
-                 + " Bitte den Namen für das Programm "13""13"".
-  kontrolliere den programmnamen:
-    IF   programmname = niltext
-         THEN LEAVE pdvprogramm neu erstellen
-    ELIF length (programmname) > maxnamenslaenge
-         THEN meckere zu langen namen an;
-              programmname := niltext;
-              LEAVE pdvprogramm neu erstellen
-    ELIF exists (programmname)
-         THEN meckere existierendes programm an;
-              LEAVE pdvprogramm neu erstellen
-    FI.
-END PROC pdvprogramm neu erstellen;
-
-PROC pdvprogramm ansehen:
-  IF programmname <> niltext CAND exists (programmname)
-     THEN frage nach diesem programm
-     ELSE lasse programm auswaehlen
-  FI;
-  cursor on;
-  disable stop;
-  stdinfoedit (programmname, 3);
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop.
-  frage nach diesem programm:
-    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name
-
-              + " Soll mit diesem Programm gearbeitet werden", 5)
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare :: ALL myself;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE pdvprogramm ansehen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-
-    programmname := menuone (verfuegbare, "Programm ansehen/ändern",
-                             "Bitte das gewünschte Programm ankreuzen!",
-                              FALSE);
-    IF programmname = niltext
-       THEN menu bildschirm;
-            LEAVE pdvprogramm ansehen
-    FI.
-END PROC pdvprogramm ansehen;
-PROC pdvdateien drucken:
-  lasse programme auswaehlen;
-  drucke programme;
-  menu bildschirm.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare :: ALL myself;
-    IF NOT not empty (verfuegbare)
-
-       THEN noch kein programm;
-            LEAVE pdvdateien drucken
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, "Dateien drucken",
-                   "Bitte die Dateien ankreuzen, die gedruckt werden sollen!",
-                    FALSE).
-  drucke programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers ("Dateien drucken")));
-    menuwindowline (2);
-    command dialogue (FALSE);
-
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (" Alle ausgewählten Dateien wurden gedruckt!");
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              menuwindowout ( " """ + name (verfuegbare, k) +
-                              """ wird gedruckt!");
-              menuwindowline;
-
-              print (name (verfuegbare, k));
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde keine Datei ausgewählt!");
-            menuwindowstop;
-            menu bildschirm;
-            LEAVE pdvdateien drucken
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen; out (""7"");
-            menuinfo  (" " + invers (errormessage));
-            clear error; enable stop;
-            LEAVE pdvdateien drucken
-       ELSE enable stop
-    FI.
-END PROC pdvdateien drucken;
-PROC pdvdatei kopieren:
-  ermittle alten programmnamen;
-  erfrage neuen programmnamen;
-  kopiere ggf das programm.
-  ermittle alten programmnamen:
-    IF NOT not empty (ALL myself)
-       THEN noch kein programm;
-
-            LEAVE pdvdatei kopieren
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone (ALL myself, "Datei kopieren",
-            "Bitte die Datei ankreuzen, das kopiert werden soll!",FALSE);
-    menu bildschirm;
-    IF alter name = niltext
-       THEN LEAVE pdvdatei kopieren
-    FI.
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + " Name der 'alten' Datei: " + bisheriger name
-
-                  + " Bitte den Namen für die Kopie: ".
-  ueberschrift:
-    center (maxlaenge, invers ("Datei kopieren")) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  kopiere ggf das programm:
-    IF   neuer name = niltext
-         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
-              LEAVE pdvdatei kopieren
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE pdvdatei kopieren
-       ELSE copy (alter name, neuer name)
-
-    FI.
-  mache vorwurf:
-    menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).
-END PROC pdvdatei kopieren;
-PROC pdvdatei umbenennen:
-  ermittle alten programmnamen;
-  erfrage neuen programmnamen;
-  benenne ggf das programm um.
-  ermittle alten programmnamen:
-    IF NOT not empty (ALL myself)
-       THEN noch kein programm;
-            LEAVE pdvdatei umbenennen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( ALL myself, "Datei umbenennen",
-
-        "Bitte die Datei ankreuzen, die umbenannt werden soll!", FALSE);
-    menu bildschirm;
-    IF alter name = niltext
-       THEN LEAVE pdvdatei umbenennen
-    FI.
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + " Bisheriger  Dateiname: " + bisheriger name
-                  + " Zukünftiger Dateiname: ".
-  ueberschrift:
-    center (maxlaenge, invers ("Datei umbenennen")) + ""13""13"".
-  bisheriger name:
-
-    ""13""13" " + invers (alter name) + ""13""13"".
-  benenne ggf das programm um:
-    IF   neuer name = niltext
-         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
-              LEAVE pdvdatei umbenennen
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE pdvdatei umbenennen
-       ELSE rename (alter name, neuer name);
-            programmname := neuer name
-    FI.
-  mache vorwurf:
-    menuinfo (" " + invers ("Eine Datei mit diesem Namen gibt es bereits!")).
-
-END PROC pdvdatei umbenennen;
-PROC pdvdateien loeschen:
-  lasse programme auswaehlen;
-  loesche programme;
-  menu bildschirm.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare :: ALL myself;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE pdvdateien loeschen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, "Dateien löschen",
-    "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).
-
-  loesche programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers ("Dateien löschen")));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen")
-                 THEN forget (name (verfuegbare, k), quiet)
-              FI;
-              fehlerbehandlung
-      FI
-    PER;
-    programmname := "".
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde keine Datei ausgewählt!");
-            menuwindowstop;
-
-            menu bildschirm;
-            LEAVE pdvdateien loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen; out (""7"");
-            menuinfo  (" " + invers (errormessage));
-            clear error; enable stop;
-            LEAVE pdvdateien loeschen
-       ELSE enable stop
-    FI.
-END PROC pdvdateien loeschen;
-
-PROC pdvprogramm starten:
-  programmname ermitteln;
-  bildschirm vorbereiten;
-  cursor on;
-  disable stop;
-  warnings off;
-  check on;
-  run pdv (programmname);
-  noch kein programm gelaufen := FALSE;
-  cursor off;
-  IF is error
-     THEN fehler ggf melden;
-          clear error
-     ELSE regenerate menuscreen
-  FI;
-  enable stop.
-  bildschirm vorbereiten:
-    cursor (17, 2); out (waagerecht);
-    cursor (38, 2); out (waagerecht);
-    cursor ( 1, 3); out (""4"");
-    menufootnote ("Programmabbruch: <ESC><h>");
-
-    cursor (1, 5);
-    out ("Das Programm wird übersetzt.  Zeilen-Nr.: ").
-  fehler ggf melden:
-    IF errormessage <> ""
-       THEN fehler melden
-    FI.
-  fehler melden:
-    IF   pos (errormessage, "'halt' vom Terminal") > 0
-       THEN regenerate menuscreen;
-            out (""7""); menuinfo (" "15"'halt' vom Terminal "14"")
-    ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0
-       THEN regenerate menuscreen;
-            out (""7""); menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14"")
-
-    ELIF pos (errormessage, "(bei Zeile") > 0 AND exists (programmname)
-       THEN programm mit fehler im notebook zeigen;
-            regenerate menuscreen
-       ELSE regenerate menuscreen;
-            out (""7""); menuinfo  (" " + invers ("FEHLER: "
-                                        + subtext (errormessage, 1, 61)))
-    FI.
-  programm mit fehler im notebook zeigen:
-    noteline;
-    note ("FEHLER: " + errormessage);
-    INT VAR n; FOR n FROM 1 UPTO 9 REP noteline PER;
-    note (""15"Verlassen: <ESC><q> "14"");
-
-    FILE VAR p :: sequential file (modify, programmname);
-    to line (p, max (1, fehlerzeile));
-    col (1);
-    clear error;
-    out (""7"");
-    cursor on;
-    noteedit (p);
-    cursor off.
-  fehlerzeile:
-    int (subtext (errormessage, zahlposition)).
-    zahlposition: pos (errormessage, "(bei Zeile") + 10.
-  programmname ermitteln:
-    IF programmname <> niltext CAND exists (programmname)
-       THEN frage nach diesem programm
-       ELSE lasse programm auswaehlen
-    FI.
-  frage nach diesem programm:
-
-    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +
-               name + " Soll mit diesem Programm gearbeitet werden", 5)
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers ("Programm starten")) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare :: ALL myself;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE pdvprogramm starten
-
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    programmname := menuone (verfuegbare, "Programm starten",
-                    "Bitte das gewünschte Programm ankreuzen!", FALSE);
-    IF programmname = niltext
-       THEN menubildschirm;
-            LEAVE pdv programm starten
-    FI.
-END PROC pdvprogramm starten;
-PROC pdv programm wiederholen:
-  bildschirm vorbereiten;
-  cursor on;
-  disable stop;
-  IF noch kein programm gelaufen
-     THEN errorstop ("Eine Wiederholung ist nicht moeglich!")
-
-     ELSE run pdv again
-  FI;
-  cursor off;
-  regenerate menuscreen;
-  IF is error
-     THEN zeige fehler;
-          clear error
-  FI;
-  enable stop.
-  bildschirm vorbereiten:
-    cursor (17, 2); out (waagerecht);
-    cursor (38, 2); out (waagerecht);
-    cursor ( 1, 3); out (""4"");
-    menufootnote ("Programmabbruch: <ESC><h>");
-    cursor (1,3).
-  zeige fehler:
-    out (""7"");
-    IF errormessage = "'run again' nicht moeglich"
-       THEN menuinfo (" "15"Eine Wiederholung ist nicht moeglich! "14"")
-
-    ELIF pos (errormessage, "'halt' vom Terminal") > 0
-       THEN menuinfo (" "15"'halt' vom Terminal "14"")
-    ELIF pos (errormessage, "Programm-Abbruch durch <ESC><h>") > 0
-       THEN menuinfo (" "15"Programm-Abbruch durch <ESC><h> "14"")
-       ELSE menuinfo (" " + invers ("FEHLER: "
-                          + subtext (errormessage, 1, 61)))
-    FI.
-END PROC pdv programm wiederholen;
-PROC meckere zu langen namen an:
-  menuinfo (" " + invers ("Hier dürfen Namen höchstens "
-                + text (max namenslaenge)
-
-                + " Zeichen lang sein!"))
-END PROC meckere zu langen namen an;
-PROC meckere existierendes programm an:
-  menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!"))
-END PROC meckere existierendes programm an;
-PROC noch kein programm:
-  menuinfo (" " + invers ("Es existiert noch kein Programm!"))
-END PROC noch kein programm;
-PROC menu bildschirm:
-  cursor (1, 2);
-  out (5 * waagerecht);
-  cursor (1, 3);
-  out (""4"");
-  cursor (1,23);
-  out (79 * waagerecht);
-
-  refresh submenu
-END PROC menu bildschirm
-END PACKET ls prozess 4
-
-
diff --git a/prozess/ls-Prozess 5 b/prozess/ls-Prozess 5
deleted file mode 100644
index a9b5028..0000000
--- a/prozess/ls-Prozess 5
+++ /dev/null
@@ -1,829 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                     ls-Prozess 5                     ** 
-         **                                                      ** 
-         **                     Version 1.02                     ** 
-         **                                                      ** 
-         **                  (Stand : 26.01.90)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **         Autoren: Bruno Pollok, Bielefeld             ** 
-         **                  Wolfgang Weber, Bielefeld           ** 
-         **                                                      ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls prozess 5 DEFINES 
-       pdv konfiguration zugelassen,
-       pdv konfiguration evtl aktivieren,
-       pdv konfiguration zeigen,
-       pdv kanal konfigurieren,
-       pdv interfaceausgabe testen,
-       pdv interfaceeingabe testen:
-LET max steckplaetze     =  4,
-    max portanzahl       =  4,
-    anzahl kartensorten  =  5,
-    betriebsart          =  1,
-    keine karte          =  1,
-    ea karte             =  2,
-    kombi                =  3,
-    da karte             =  4,
-    ad karte             =  5,
-
-    compact              =  6,
-    einzel               =  7,
-    mehrfach             =  8;
-LET testfenster x        = 11,
-    testfenster y        =  5,
-    testfenster xsize    = 59,
-    testfenster ysize    = 15;
-WINDOW VAR testfenster   :: window (testfenster x,     testfenster y,
-                                    testfenster xsize, testfenster ysize);
-INT    VAR steckplatzart :: 0;
-BOOL   VAR mit konfigurationsmoeglichkeit :: TRUE;
-TASK   VAR konfigurationsmanager          :: niltask;
-
-ROW max steckplaetze INT VAR kartenart :: ROW max steckplaetze INT :
-                                          (keine karte, keine karte,
-                                           keine karte, keine karte);
-LET SPANNUNG = ROW 2 REAL,
-    PORT     = ROW 3 INT,
-    KARTE    = ROW max portanzahl PORT;
-ROW anzahl kartensorten KARTE CONST karte :: ROW anzahl kartensorten KARTE :
-(* ---------------------------------------------------------------------- *)
-(   KARTE : (
-(* ---------------------------------------------------------------------- *)
-
-(*         *)       PORT : (nicht belegt, 0, 0),        (*     Port 1     *)
-(*  leere  *)       PORT : (nicht belegt, 0, 0),        (*     Port 2     *)
-(*  Karte  *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *)
-(*         *)       PORT : (nicht belegt, 0, 0)),       (*     Port 4     *)
-(*----------------------------------------------------------------------- *)
-    KARTE : (
-(* ---------------------------------------------------------------------- *)
-(*         *)       PORT : (digital ein,  1, 3),        (*     Port 1     *)
-
-(*   E/A   *)       PORT : (digital aus,  1, 1),        (*     Port 2     *)
-(*  Karte  *)       PORT : (digital ein,  1, 3),        (*     Port 3     *)
-(*         *)       PORT : (digital aus,  1, 1)),       (*     Port 4     *)
-(*----------------------------------------------------------------------- *)
-    KARTE : (
-(* ---------------------------------------------------------------------- *)
-(*         *)       PORT : (analog  ein,  2, 2),        (*     Port 1     *)
-(*  Kombi  *)       PORT : (analog  ein,  3, 2),        (*     Port 2     *)
-
-(*  Karte  *)       PORT : (digital ein,  1, 3),        (*     Port 3     *)
-(*         *)       PORT : (digital aus,  1, 1 )),      (*     Port 4     *)
-(*----------------------------------------------------------------------- *)
-    KARTE : (
-(* ---------------------------------------------------------------------- *)
-(*         *)       PORT : (analog  aus,  1, 1),        (*     Port 1     *)
-(*   D/A   *)       PORT : (analog  aus,  1, 3),        (*     Port 2     *)
-(* Wandler *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *)
-
-(*         *)       PORT : (nicht belegt, 0, 0)),       (*     Port 4     *)
-(*----------------------------------------------------------------------- *)
-    KARTE : (
-(* ---------------------------------------------------------------------- *)
-(*         *)       PORT : (analog  ein,  1, 1),        (*     Port 1     *)
-(*   A/D   *)       PORT : (analog  ein,  1, 3),        (*     Port 2     *)
-(* Wandler *)       PORT : (nicht belegt, 0, 0),        (*     Port 3     *)
-(*         *)       PORT : (nicht belegt, 0, 0))        (*     Port 4     *)
-
-(*----------------------------------------------------------------------- *)
-                                                                           );
-PROC pdv konfiguration zugelassen (BOOL CONST wahrheitswert):
-  teste berechtigung;
-  mit konfigurationsmoeglichkeit := wahrheitswert;
-  IF mit konfigurationsmoeglichkeit
-     THEN konfigurationsmanager := niltask
-     ELSE konfigurationsmanager := myself
-  FI.
-  teste berechtigung:
-    enable stop;
-    IF NOT (konfigurationsmanager = niltask  OR
-
-            konfigurationsmanager = myself)
-       THEN errorstop ("Befehl ist nur in Task '" +
-                        name (konfigurationsmanager) + "' zugelassen!")
-    FI.
-END PROC pdv konfiguration zugelassen;
-PROC pdv konfiguration evtl aktivieren:
-  IF mit konfigurationsmoeglichkeit
-     THEN activate (3)
-     ELSE deactivate (3)
-  FI
-END PROC pdv konfiguration evtl aktivieren;
-PROC pdv kanal konfigurieren:
-  TEXT CONST info   ::  "  "15"Auswahl der Steckplatzart "14" "13""13""
-
-                      + "     c  Compactbox             "13""
-                      + "     e  Einzelsteckplatz       "13""
-                      + "     m  Mehrfachsteckplatz     ",
-             liste  :: "Compact"13"Einzel"13"Mehrfach",
-             tasten :: "cemCEM";
-   INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);
-   SELECT auswahl OF
-     CASE 1, 101, 104 :  trage compactbox ein;
-                         zeige kanalbelegung (0)
-     CASE 2, 102, 105 :  trage einzelplatzbelegung ein;
-
-                         zeige kanalbelegung (0)
-     CASE 3, 103, 106 :  bearbeite die steckplaetze einzeln
-   END SELECT;
-   beende kanaldaten eintragen.
-   trage compactbox ein:
-     steckplatzart := compact;
-     trage steckplatzbelegung ein (1, kombi);
-     trage steckplatzbelegung ein (2, keine karte);
-     trage steckplatzbelegung ein (3, keine karte);
-     trage steckplatzbelegung ein (4, keine karte).
-   trage einzelplatzbelegung ein:
-     steckplatzart := einzel;
-     trage steckplatzbelegung ein (1, ermittelte kartenart (0));
-
-     trage steckplatzbelegung ein (2, keine karte);
-     trage steckplatzbelegung ein (3, keine karte);
-     trage steckplatzbelegung ein (4, keine karte).
-   bearbeite die steckplaetze einzeln:
-     INT VAR platz;
-     steckplatzart := mehrfach;
-     FOR platz FROM 1 UPTO max steckplaetze REP
-       trage steckplatzbelegung ein (platz, ermittelte kartenart (platz));
-       zeige kanalbelegung (platz * 10)
-     PER.
-END PROC pdv kanal konfigurieren;
-PROC pdv konfiguration zeigen:
-  SELECT steckplatzart OF
-
-    CASE compact  : zeige kanalbelegung (0)
-    CASE einzel   : zeige kanalbelegung (0)
-    CASE mehrfach : zeige belegung einzelner steckplaetze
-    OTHERWISE       noch nicht konfiguriert
-  END SELECT.
-  noch nicht konfiguriert:
-    menuinfo ("                  "15"Warnung: "14"           "13""13""13""
-            + " Das Interface wurde noch nicht konfiguriert! "13""13""
-            + "  In diesem Zustand sind weder Eingaben noch  "13""
-            + "     Ausgaben über das Interface möglich.     "13"").
-
-  zeige belegung einzelner steckplaetze:
-    TEXT CONST info   ::
-                      "   "15"Eingestellt: Mehrfachsteckplatz "14" "13""13""
-                    + "         1   Info Steckplatz 1         "13""
-                    + "         2   Info Steckplatz 2         "13""
-                    + "         3   Info Steckplatz 3         "13""
-                    + "         4   Info Steckplatz 4         "13""13""
-                    + "         z   Zurück ins Hauptmenü      ",
-               liste  :: "1"13"2"13"3"13"4"13"z",
-
-               tasten :: "1234zZ";
-   INT VAR auswahl;
-   REP auswahl := menualternative (info, liste, tasten, 5, FALSE);
-     SELECT auswahl OF
-       CASE 1, 101 :  zeige kanalbelegung (10)
-       CASE 2, 102 :  zeige kanalbelegung (20)
-       CASE 3, 103 :  zeige kanalbelegung (30)
-       CASE 4, 104 :  zeige kanalbelegung (40)
-     END SELECT
-   UNTIL (auswahl = 5) OR (auswahl > 104) PER
-END PROC pdv konfiguration zeigen;
-PROC pdv interfaceausgabe testen:
-  gestalte testfenster ("Ausgabetest");
-
-  disable stop;
-  teste interface;
-  IF NOT is error
-     THEN teste interface ausgabe
-  FI;
-  IF is error
-     THEN fehlerbehandlung
-     ELSE schliesse interface;
-          enable stop;
-          beseitige testfenster;
-          refresh submenu
-  FI.
-  fehlerbehandlung:
-    TEXT VAR meldung :: errormessage;
-    clear error;
-    schalte alles aus;
-    schliesse interface;
-    enable stop;
-    cursor off;
-    regenerate menuscreen;
-    menuinfo (" " + invers (meldung)).
-END PROC pdv interfaceausgabe testen;
-
-PROC pdv interfaceeingabe testen:
-  gestalte testfenster ("Eingabetest");
-  disable stop;
-  teste interface;
-  IF NOT is error
-     THEN teste interface eingabe
-  FI;
-  IF is error
-     THEN fehlerbehandlung
-     ELSE schliesse interface;
-          enable stop;
-          beseitige testfenster;
-          refresh submenu
-  FI.
-  fehlerbehandlung:
-    TEXT VAR meldung :: errormessage;
-    clear error;
-    schalte alles aus;
-    schliesse interface;
-    enable stop;
-    cursor off;
-
-    regenerate menuscreen;
-    menuinfo (" " + invers (meldung)).
-END PROC pdv interfaceeingabe testen;
-PROC beseitige testfenster:
-  INT VAR z;
-  FOR z FROM testfenster y + testfenster ysize DOWNTO testfenster y - 1 REP
-    cursor (testfenster x - 1, z);
-    out (""5"")
-  PER
-END PROC beseitige testfenster;
-PROC gestalte testfenster (TEXT CONST funktionsart):
-  show (testfenster);
-  cursor (testfenster x - 1, testfenster y + testfenster ysize - 2);
-  out (balken links + (testfenster xsize * waagerecht) + balken rechts);
-
-  cursor (testfenster, 1, 2);
-  out (testfenster, center (testfenster, invers (funktionsart)))
-END PROC gestalte testfenster;
-PROC testfensterfussnote (TEXT CONST meldung):
-  cursor (testfenster, 2, testfenster ysize);
-  out (testfenster, meldung)
-END PROC testfensterfussnote;
-PROC teste interfaceausgabe:
-  INT  VAR kanalnummer, steckplatz, port;
-  TEXT VAR nummer :: "";
-  enable stop;
-  REP hole kanalnummer;
-      teste ausgabe an kanal
-  PER.
-  hole kanalnummer:
-    SELECT steckplatzart OF
-
-      CASE compact  :  kanalnummer := 4; steckplatz := 1; port := 4
-      CASE einzel   :  kanalnummer muss evtl erfragt werden
-      CASE mehrfach :  kanalnummer muss erfragt werden
-    OTHERWISE errorstop ("Interface ist noch nicht konfiguriert!")
-    END SELECT;
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Ausgabe an Kanal " + text (kanalnummer) + klammer +
-                       kanalbeschreibung (steckplatz, port));
-    IF steckplatzart = mehrfach
-       THEN cursor (testfenster, 25, 6);
-
-            out (testfenster, "in Steckplatz " + text (steckplatz))
-    FI;
-    out (testfenster, ")").
-    klammer:
-      IF kanalnummer < 10
-         THEN "  (= "
-         ELSE " (= "
-      FI.
-  kanalnummer muss evtl erfragt werden:
-    SELECT kartenart [1] OF
-      CASE kombi   :  kanalnummer := 4; steckplatz := 1; port := 4
-      CASE eakarte :  kanalnummer := 2; steckplatz := 1; port := 2
-      CASE dakarte :  frage nach kanalnummer auf da karte;
-                      steckplatz  := 1; port := kanalnummer
-
-    OTHERWISE errorstop ("Keine Ausgabe an " + kartenname + " möglich!")
-    END SELECT.
-  kartenname:
-    IF kartenart [1] = ad karte
-       THEN "A/D-Karte"
-       ELSE "leeren Steckplatz"
-    FI.
-  frage nach kanalnummer auf da karte:
-    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");
-    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Ausgabe - Kanal (1 oder 2): ");
-    cursor on;
-    REP inchar (nummer)
-    UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;
-
-    cursor off;
-    IF nummer = ""27""
-       THEN LEAVE teste interface ausgabe
-       ELSE kanalnummer := int (nummer)
-    FI.
-    esc q gedrueckt:
-      (nummer = ""27"") AND (incharety (20) = "q").
-  kanalnummer muss erfragt werden:
-    TEXT VAR exit char;
-    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");
-    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Ausgabe - Kanal:");
-    cursor on;
-    REP cursor (testfenster, 19, 5);
-
-        editget (testfenster, nummer, 4, 4, "", "q", exit char)
-    UNTIL (exit char = ""27"q") OR ausgabekanal eingegeben PER;
-    cursor off;
-    IF exit char = ""27"q"
-       THEN LEAVE teste interface ausgabe
-    FI.
-  ausgabekanal eingegeben:
-    kanalnummer := abs (int (nummer));
-    steckplatz  := kanalnummer DIV 10;
-    port        := kanalnummer MOD 10;
-    IF steckplatz = 0 THEN steckplatz := 1 FI;
-    cursor (testfenster, 2, 7);
-    IF   (kanalnummer < 1) OR (kanalnummer > 49)
-
-         THEN out (testfenster, "Unzulässige Kanalnummer!          "); FALSE
-    ELIF (port = 0) OR (port > max portanzahl) OR kein ausgabeport
-         THEN out (testfenster, "Dies ist kein Ausgabe-Kanal!      "); FALSE
-         ELSE out (testfenster, "                                  "); TRUE
-    FI.
-    kein ausgabeport:
-      (port betriebsart <> digital aus) AND (port betriebsart <> analog aus).
-      port betriebsart: karte [sorte][port][betriebsart].
-      sorte           : kartenart [steckplatz].
-
-  teste ausgabe an kanal:
-    TEXT VAR wert;
-    cursor (testfenster, 1, 8);
-    out (testfenster, testfenster xsize * "-");
-    cursor (testfenster, 2, 11);
-    out (testfenster, "Ausgabewert: ");
-    testfenster fussnote ("Bitte einen Wert zwischen 0 und 255 eingeben!");
-    menufootnote ("'Werte ausgeben' beenden: <ESC><q>");
-    cursor on;
-    REP cursor (testfenster, 15, 11);
-        wert := "0";
-        editget (testfenster, wert, 4, 4, "", "qh", exit char);
-        IF exit char = return
-
-           THEN ausgeben (kanalnummer, int (wert) MOD ganzzahlobergrenze)
-        ELIF exit char = ""27"h"
-           THEN errorstop ("Programm-Abbruch durch <ESC><h>!")
-        FI
-    UNTIL exitchar = ""27"q" PER;
-    cursor off;
-    IF (steckplatzart = mehrfach) OR (kartenart [1] = da karte)
-       THEN cursor (testfenster, 1, 5);
-            out (testfenster, (2 * testfenster xsize) * " ");
-            cursor (testfenster, 2, 11);
-            out (testfenster, "                       ");
-
-            testfenster fussnote ((testfenster xsize - 2) * " ")
-       ELSE LEAVE teste interfaceausgabe
-    FI.
-    return: ""13"".
-END PROC teste interfaceausgabe;
-PROC teste interfaceeingabe:
-  INT  VAR kanalnummer, steckplatz, port;
-  TEXT VAR nummer :: "";
-  enable stop;
-  REP hole kanalnummer;
-      teste eingabe vom kanal
-  PER.
-  hole kanalnummer:
-    IF   steckplatzart = 0
-         THEN errorstop ("Interface ist noch nicht konfiguriert!")
-         ELSE kanalnummer erfragen
-
-    FI;
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Eingabe von Kanal " + text (kanalnummer) + klammer +
-                       kanalbeschreibung (steckplatz, port));
-    IF steckplatzart = mehrfach
-       THEN cursor (testfenster, 26, 6);
-            out (testfenster, "in Steckplatz " + text (steckplatz))
-    FI;
-    out (testfenster, ")").
-    klammer:
-      IF kanalnummer < 10
-         THEN "  (= "
-         ELSE " (= "
-      FI.
-  kanalnummer erfragen:
-    SELECT steckplatzart OF
-
-      CASE compact  : drei kanaele anbieten;
-                      steckplatz := 1; port := kanalnummer
-      CASE einzel   : zwei oder drei kanaele anbieten;
-                      steckplatz := 1; port := kanalnummer
-      CASE mehrfach : alle kanaele moeglich
-    END SELECT.
-  drei kanaele anbieten:
-    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");
-    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Eingabe - Kanal (1, 2 oder 3): ");
-
-    cursor on;
-    REP inchar (nummer)
-    UNTIL (pos ("123", nummer) > 0) OR esc q gedrueckt PER;
-    cursor off;
-    IF nummer = ""27""
-       THEN LEAVE teste interface eingabe
-       ELSE kanalnummer := int (nummer)
-    FI.
-    esc q gedrueckt:
-      (nummer = ""27"") AND (incharety (20) = "q").
-  zwei oder drei kanaele anbieten:
-    SELECT kartenart [1] OF
-      CASE kombi    : drei kanaele anbieten
-      CASE ad karte : zwei kanaele anbieten
-      CASE ea karte : kanalnummer := 1
-
-    OTHERWISE errorstop ("Eingabe bei " + kartenname + " nicht möglich!")
-    END SELECT.
-    kartenname:
-      IF kartenart [1] = da karte
-         THEN "D/A-Karte"
-         ELSE "leerem Steckplatz"
-      FI.
-  zwei kanaele anbieten:
-    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");
-    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Eingabe - Kanal (1 oder 2): ");
-    cursor on;
-    REP inchar (nummer)
-    UNTIL (pos ("12", nummer) > 0) OR esc q gedrueckt PER;
-
-    cursor off;
-    IF nummer = ""27""
-       THEN LEAVE teste interface eingabe
-       ELSE kanalnummer := int (nummer)
-    FI.
-  alle kanaele moeglich:
-    TEXT VAR exit char;
-    menufootnote ("Zurück zum Hauptmenü: <ESC><q>");
-    testfensterfussnote ("Bitte eine Kanalnummer eingeben!");
-    cursor (testfenster, 2, 5);
-    out (testfenster, "Eingabe - Kanal:");
-    cursor on;
-    REP cursor (testfenster, 19, 5);
-        editget (testfenster, nummer, 4, 4, "", "q", exit char)
-    UNTIL (exit char = ""27"q") OR eingabekanal eingegeben PER;
-
-    cursor off;
-    IF exit char = ""27"q"
-       THEN LEAVE teste interface eingabe
-    FI.
-  eingabekanal eingegeben:
-    kanalnummer := abs (int (nummer));
-    steckplatz  := kanalnummer DIV 10;
-    port        := kanalnummer MOD 10;
-    IF steckplatz = 0 THEN steckplatz := 1 FI;
-    cursor (testfenster, 2, 7);
-    IF   (kanalnummer < 1) OR (kanalnummer > 49)
-         THEN out (testfenster, "Unzulässige Kanalnummer!          "); FALSE
-    ELIF (port = 0) OR (port > max portanzahl) OR kein eingabeport
-
-         THEN out (testfenster, "Dies ist kein Eingabe-Kanal!      "); FALSE
-         ELSE out (testfenster, "                                  "); TRUE
-    FI.
-    kein eingabeport:
-      (port betriebsart <> digital ein) AND (port betriebsart <> analog ein).
-      port betriebsart: karte [sorte][port][betriebsart].
-      sorte           : kartenart [steckplatz].
-  teste eingabe vom kanal:
-    cursor (testfenster, 1, 8);
-    out (testfenster, testfenster xsize * "-");
-    cursor (testfenster, 2, 11);
-
-    out (testfenster, "Eingelesener Wert: ");
-    testfenster fussnote ("                                             ");
-    menufootnote ("'Werte einlesen' beenden: <ESC><q>");
-    REP cursor (testfenster, 21, 11);
-        out (text (eingabe (kanalnummer), 3));
-        warte (0.1)
-    UNTIL abbruch gewuenscht PER;
-    IF (steckplatzart = einzel) AND (kartenart [1] = ea karte)
-       THEN LEAVE teste interfaceeingabe
-       ELSE cursor (testfenster, 1, 5);
-            out (testfenster, (2 * testfenster xsize) * " ");
-
-            cursor (testfenster, 2, 11);
-            out (testfenster, "                       ")
-    FI.
-END PROC teste interfaceeingabe;
-TEXT PROC kanalbeschreibung (INT CONST steckplatz, port):
-  IF steckplatzart = compact
-     THEN port auf compactbox
-     ELSE port auf steckkarte
-  FI.
-  port auf compactbox:
-    portbeschreibung + " der Compact-Box".
-  port auf steckkarte:
-    SELECT kartenart [steckplatz] OF
-      CASE kombi    : portbeschreibung + " der Kombi-Karte"
-      CASE ea karte : portbeschreibung + " der E/A-Karte"
-
-      CASE da karte : portbeschreibung + " der D/A-Karte"
-      CASE ad karte : portbeschreibung + " der A/D-Karte"
-    OTHERWISE ""
-    END SELECT.
-  portbeschreibung:
-    SELECT 2 + karte [kartenart [steckplatz]][port][betriebsart] OF
-      CASE 1 : "Digitalausgang"
-      CASE 3 : "Digitaleingang"
-      CASE 0 : "Analogausgang " + text (port)
-      CASE 4 : "Analogeingang " + text (port)
-    OTHERWISE ""
-    END SELECT.
-END PROC kanalbeschreibung;
-PROC trage steckplatzbelegung ein (INT CONST steckplatz, art):
-
-  INT VAR port;
-  kartenart [steckplatz] := art;
-  klaere spannungsbereiche;
-  FOR port FROM 1 UPTO max portanzahl REP
-    trage kanaldaten ein (kanalnummer, spannungsbereich, portdaten);
-    IF steckplatz = 1
-       THEN trage kanaldaten ein (port, spannungsbereich, portdaten)
-    FI
-  PER.
-  kanalnummer:  port  +  10 * steckplatz.
-  portdaten  :  karte [kartenart [steckplatz]][port].
-  spannungsbereich:
-    IF   port = 1
-         THEN bereich von e1
-    ELIF port = 2
-         THEN bereich von e2
-
-         ELSE SPANNUNG : (0.0, 0.0)
-    FI.
-  klaere spannungsbereiche:
-    SPANNUNG VAR bereich von e1, bereich von e2;
-    SELECT kartenart [steckplatz] OF
-      CASE kombi    : spannungsbereich 0 bis 5 volt
-      CASE da karte : setze spannungsbereiche
-      CASE ad karte : erfrage adkarte schalterstellungen
-    OTHERWISE alles auf 0 setzen
-    END SELECT.
-  spannungsbereich 0 bis 5 volt:
-    bereich von e1 := SPANNUNG : (0.0, 5.0);
-    bereich von e2 := SPANNUNG : (0.0, 5.0).
-  setze spannungsbereiche:
-
-    bereich von e1 := SPANNUNG : (-5.0, 5.0);
-    bereich von e2 := SPANNUNG : ( 0.0, 5.0).
-  alles auf 0 setzen:
-    bereich von e1 := SPANNUNG : (0.0, 0.0);
-    bereich von e2 := SPANNUNG : (0.0, 0.0).
-erfrage adkarte schalterstellungen:
-  REP
-   hole schalterstellung
-  UNTIL schalterstellung sinnvoll PER;
-  bestimme spannungsbereiche (schalterzustand, bereich von e1, bereich von e2).
-  hole schalterstellung:
-    TEXT VAR schalterzustand := menuanswer (infotext, "00000000", 5).
-  infotext:
-
-    ueberschrift
-    + "  Bitte die aktuelle Schalterstellung eintragen: "13""13""
-    + "  Es bedeutet :  1  -  Schalterstellung 'on'     "13""
-    + "                 0  -  Schalterstellung 'off'    "13""13""
-    + " Nummer : 12345678 "13""
-    + "          |||||||| ".
- ueberschrift:
-   IF steckplatzart = mehrfach
-      THEN " "15"Angabe der Schalterstellungen auf der A/D-Karte "14""13""
-         + " "15"                in Steckplatz "
-         + text (steckplatz) + ":                "14""13""13""
-
-      ELSE " "15"Angabe der Schalterstellungen auf der A/D-Karte: "14""13""13""
-   FI.
- schalterstellung sinnvoll:
-   (length (schalterzustand) = 8) AND nur nullen und einsen.
- nur nullen und einsen:
-   BOOL VAR ok := TRUE; INT VAR m;
-   FOR m FROM 1 UPTO 8 REP
-     IF NOT ((schalterzustand SUB m) = "1" OR (schalterzustand SUB m ) = "0")
-        THEN ok := FALSE
-     FI
-   PER;
-   ok.
-END PROC trage steckplatzbelegung ein;
-INT PROC ermittelte kartenart (INT CONST steckplatz):
-  TEXT CONST info e ::  "     "15"Angabe der Interfacekarte: "14"    "13""13""
-
-                      + "     k   Kombikarte              "13""
-                      + "     e   E / A - Karte           "13""
-                      + "     d   D / A - Wandler - Karte "13""
-                      + "     a   A / D - Wandler - Karte "13""
-                      + "     0   Keine Steckkarte        ",
-             info m ::  "  "15"Angabe der Interfacekarte für Steckplatz "
-                      + text (steckplatz) + ": "14" "13""13""
-                      + "             k   Kombikarte              "13""
-
-                      + "             e   E / A - Karte           "13""
-                      + "             d   D / A - Wandler - Karte "13""
-                      + "             a   A / D - Wandler - Karte "13""
-                      + "             0   Keine Steckkarte        ",
-             liste  :: "Kombi"13"E/A"13"D/A"13"A/D"13"Keine",
-             tasten :: "keda0KEDA";
-   INT VAR auswahl := menualternative (infotext, liste, tasten, 5, FALSE);
-   SELECT auswahl OF
-     CASE 1, 101, 106 :  kombi
-
-     CASE 2, 102, 107 :  eakarte
-     CASE 3, 103, 108 :  dakarte
-     CASE 4, 104, 109 :  adkarte
-     OTHERWISE           keine karte
-   END SELECT.
-   infotext:
-     IF steckplatz = 0
-        THEN info e
-        ELSE info m
-     FI.
-END PROC ermittelte kartenart;
-PROC zeige kanalbelegung (INT  CONST steckplatz):
-   ROW 4 TEXT VAR kanalnummer;
-   kanalnummer [1] := text (steckplatz + 1, 2);
-   kanalnummer [2] := text (steckplatz + 2, 2);
-   kanalnummer [3] := text (steckplatz + 3, 2);
-
-   kanalnummer [4] := text (steckplatz + 4, 2);
-   IF steckplatzart = compact
-      THEN zeige compactboxbelegung
-      ELSE zeige steckplatz mit karte
-   FI.
-  zeige steckplatz mit karte:
-    SELECT kartenart [steckplatznummer] OF
-      CASE kombi  : zeige steckplatz mit kombi
-      CASE eakarte: zeige steckplatz mit eakarte
-      CASE dakarte: zeige steckplatz mit dakarte
-      CASE adkarte: zeige steckplatz mit adkarte
-      OTHERWISE     zeige steckplatz ohne karte
-    END SELECT.
-
-  steckplatznummer:
-    IF steckplatz = 0
-       THEN 1
-       ELSE steckplatz DIV 10
-    FI.
-  zeige compactboxbelegung:
-    menuinfo (
-      "              "15"Eingestellt: Compactbox "14"         "13""13""
-    + "                 Belegung der Kanäle:               "13""13""13""
-    + kanalnummeranzeige kombikarte).
-  zeige steckplatz mit kombi:
-    menuinfo (ueberschrift + " mit Kombikarte: "14"    "13""13""
-    + "                Belegung der Kanäle:               "13""13""13""
-    + kanalnummeranzeige kombikarte).
-
-  zeige steckplatz mit eakarte:
-    menuinfo (ueberschrift + " mit E / A - Karte: "14"    "13""13""
-    + "                Belegung der Kanäle:               "13""13""13""
-    + kanalnummeranzeige eakarte).
-  zeige steckplatz mit dakarte:
-    menuinfo (ueberschrift + " mit D / A - Karte: "14"    "13""13""
-    + "                Belegung der Kanäle:               "13""13""
-    + kanalnummeranzeige dakarte).
-  zeige steckplatz mit adkarte:
-    hole spannungsbereiche;
-    menuinfo ("     " + ueberschrift + " mit A / D - Karte: "14""13""13""
-
-    + "           Zwei analoge Eingänge stehen zur Verfügung:   "13""13""
-    + kanalnummeranzeige adkarte).
-  hole spannungsbereiche:
-    SPANNUNG VAR e1 bereich, e2 bereich;
-    hole spannungsbereich (steckplatz + 1, e1 bereich [1], e1 bereich [2]);
-    hole spannungsbereich (steckplatz + 2, e2 bereich [1], e2 bereich [2]).
-  zeige steckplatz ohne karte:
-    IF steckplatz = 0
-       THEN menuinfo (
-            "    "15"Einzelsteckplatz ohne Steckkarte: "14"   "13""13""13""
-          + " Es sind weder Ein- noch Ausgaben möglich! "13"")
-
-       ELSE menuinfo (
-            "        "15"Steckplatz "
-          + text (steckplatz DIV 10) + " ohne Steckkarte: "14""13""13""13""
-          + " Es sind hier weder Ein- noch Ausgaben möglich! "13"")
-    FI.
-  ueberschrift:
-    IF steckplatz = 0
-       THEN "         "15"Einzelsteckplatz"
-       ELSE "           "15"Steckplatz " + text (steckplatz DIV 10)
-    FI.
-  kanalnummeranzeige kombikarte:
-      "     "15"Kanal " + kanalnummer [1]
-                             + ": "14"  Analogeingang 1 (E1) "13""13""
-
-    + "     "15"Kanal " + kanalnummer [2]
-                             + ": "14"  Analogeingang 2 (E2) "13""13""
-    + "     "15"Kanal " + kanalnummer [3]
-                             + ": "14"  Digitaleingang       "13""13""
-    + "     "15"Kanal " + kanalnummer [4]
-                             + ": "14"  Digitalausgang       "13"".
-  kanalnummeranzeige eakarte:
-    "     "15"Kanal " + kanalnummer [1]
-    + ": "14"  Digitaleingang "13""13""
-    + "     "15"Kanal " + kanalnummer [2]
-    + ": "14"  Digitalausgang "13""13""
-
-    + "   ( "15"Kanal " + kanalnummer [3]
-    + ": "14"  Digitaleingang (= Kanal " + kanalnummer [1] + ") )"13""13""
-    + "   ( "15"Kanal " + kanalnummer [4]
-    + ": "14"  Digitalausgang (= Kanal " + kanalnummer [2] + ") )"13"".
-  kanalnummeranzeige adkarte:
-      "  "15"Kanal " + kanalnummer [1]
-                     + ": "14" (E1)  Spannungsbereich  " + bereich1 + ""13""13""
-    + "  "15"Kanal " + kanalnummer [2]
-                     + ": "14" (E2)  Spannungsbereich  " + bereich2 + ""13"".
-
-  bereich1:
-    IF e1 bereich [1] = 0.0
-       THEN "  0.000 V  -  +" + text (e1 bereich [2], 6, 3) + " V  "
-       ELSE text (e1 bereich [1], 7, 3) + " V  -  +" + text (e1 bereich [2], 6, 3) + " V  "
-    FI.
-  bereich2:
-    IF e2 bereich [1] = 0.0
-       THEN "  0.000 V  -  +" + text (e2 bereich [2], 6, 3) + " V"
-       ELSE text (e2 bereich [1], 7, 3) + " V  -  +" + text (e2 bereich [2], 6, 3) + " V"
-    FI.
-  kanalnummeranzeige dakarte:
-      "  Die Karte stellt einen Analogausgang zur Verfügung, "13""
-
-    + "  der auf zwei Arten angesprochen werden kann:        "13""13""13""
-    + "     "15"Kanal " + kanalnummer [1]
-                               + ": "14"  Spannungsbereich  -5 V  -  +5 V "13""13""
-    + "     "15"Kanal " + kanalnummer [2]
-                               + ": "14"  Spannungsbereich   0 V  -  +5 V "13"".
-END PROC zeige kanalbelegung;
-PROC bestimme spannungsbereiche (TEXT CONST schalterstellung,
-                                 SPANNUNG VAR bereich von e1,
-                                 SPANNUNG VAR bereich von e2):
-
-  bestimme bereich von e1;
-  bestimme bereich von e2.
-  bestimme bereich von e1:
-    IF   schalter 3 geschlossen
-         THEN umax1 :=  0.25
-    ELIF schalter 2 geschlossen
-         THEN umax1 :=  2.5
-    ELIF schalter 1 geschlossen
-         THEN umax1 := 25.0
-         ELSE umax1 :=  0.0
-    FI;
-    IF schalter 8 geschlossen
-       THEN symmetrische spannungsmessung ueber e1
-       ELSE asymmetrische spannungsmessung ueber e1
-    FI.
-    schalter 1 geschlossen:  (schalterstellung SUB 1) = on.
-
-    schalter 2 geschlossen:  (schalterstellung SUB 2) = on.
-    schalter 3 geschlossen:  (schalterstellung SUB 3) = on.
-    schalter 8 geschlossen:  (schalterstellung SUB 8) = on.
-    umin1:  bereich von e1 [1].
-    umax1:  bereich von e1 [2].
-  symmetrische spannungsmessung ueber e1:
-    umax1 := umax1 / 2.0;
-    umin1 := - umax1.
-  asymmetrische spannungsmessung ueber e1:
-    umin1 := 0.0.
-  bestimme bereich von e2:
-    IF   schalter 6 geschlossen
-         THEN umax2 :=  0.25
-    ELIF schalter 5 geschlossen
-
-         THEN umax2 :=  2.5
-    ELIF schalter 4 geschlossen
-         THEN umax2 := 25.0
-         ELSE umax2 :=  0.0
-    FI;
-    IF schalter 7 geschlossen
-       THEN symmetrische spannungsmessung ueber e2
-       ELSE asymmetrische spannungsmessung ueber e2
-    FI.
-    schalter 4 geschlossen:  (schalterstellung SUB 4) = on.
-    schalter 5 geschlossen:  (schalterstellung SUB 5) = on.
-    schalter 6 geschlossen:  (schalterstellung SUB 6) = on.
-    schalter 7 geschlossen:  (schalterstellung SUB 7) = on.
-
-    umin2:  bereich von e2 [1].
-    umax2:  bereich von e2 [2].
-  symmetrische spannungsmessung ueber e2:
-    umax2 := umax2 / 2.0;
-    umin2 := - umax2.
-  asymmetrische spannungsmessung ueber e2:
-    umin2 := 0.0.
-  on:  "1".
-END PROC bestimme spannungsbereiche
-END PACKET ls prozess 5
-
-
diff --git a/system/at/1.8.7/source-disk b/system/at/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/at/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/at/AT Generator b/system/at/1.8.7/src/AT Generator
index d3bfd6d..d3bfd6d 100644
--- a/at/AT Generator
+++ b/system/at/1.8.7/src/AT Generator
diff --git a/at/AT Utilities b/system/at/1.8.7/src/AT Utilities
index 760e728..760e728 100644
--- a/at/AT Utilities
+++ b/system/at/1.8.7/src/AT Utilities
diff --git a/at/AT install b/system/at/1.8.7/src/AT install
index 11f9b55..11f9b55 100644
--- a/at/AT install
+++ b/system/at/1.8.7/src/AT install
diff --git a/system/at/unknown/src/AT Generator b/system/at/unknown/src/AT Generator
new file mode 100644
index 0000000..ef98535
--- /dev/null
+++ b/system/at/unknown/src/AT Generator
@@ -0,0 +1,134 @@
+(*************************************************************************)

+(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig.                     ***)

+(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***)

+(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***)

+(***                                                                   ***)

+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)

+(*************************************************************************)

+

+LET ack = 0,

+    nak = 1;

+ 

+cl eop (1, 4);

+erzeuge collector;

+erzeuge archive manager;

+erzeuge operator;

+erzeuge configurator;

+loesche collector;

+forget ("AT Generator", quiet);

+break.

+

+loesche collector :

+   end (/"colly");

+   put ("Collector gelöscht.");

+   line (2).

+

+erzeuge collector :

+   put line ("Generating 'Collector'...");

+   begin ("colly", PROC generate collector, t);

+   warte auf meldung;

+   IF answer = nak THEN end (/"colly");

+                        errorstop (meldung)

+   FI.

+   TASK VAR t.

+

+erzeuge archive manager :

+   put line ("Generating 'ARCHIVE'...");

+   end (/"ARCHIVE");

+   begin ("ARCHIVE", PROC archive manager, t).

+

+erzeuge operator :

+   put line ("Generating 'OPERATOR'...");

+   end (/"OPERATOR");

+   begin ("OPERATOR", PROC monitor, t).

+ 

+erzeuge configurator :

+   put line ("Generating 'configurator'...");

+   end (/"configurator");

+   begin ("configurator", PROC generate configurator, t); 

+   warte auf meldung;

+   IF answer = nak THEN errorstop (meldung) FI.

+ 

+warte auf meldung : 

+   DATASPACE VAR ds; INT VAR answer; 

+   wait (ds, answer, t);

+   BOUND TEXT VAR m := ds;

+   TEXT VAR meldung := m;

+   forget (ds).

+ 

+PROC generate collector :

+

+   disable stop;

+   fetch all (/"configurator");

+   DATASPACE VAR ds := nilspace;

+   BOUND TEXT VAR m := ds; m := "";

+   send (father, mess, ds);

+   forget (ds);

+   free global manager.

+ 

+mess : IF is error THEN m := error message;

+                        nak

+                   ELSE ack FI.

+

+END PROC generate collector;

+

+PROC generate configurator :

+

+   disable stop;

+   fetch all (/"colly");

+   DATASPACE VAR ds := nilspace; 

+   BOUND TEXT VAR m := ds; m := "";

+   send (father, mess, ds);

+   forget (ds);

+   enable stop;

+   new configuration;

+   setup;

+   global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 

+                   configuration manager with time).

+

+mess : IF is error THEN m := error message;

+                        nak

+                   ELSE ack FI.

+

+END PROC generate configurator;

+

+TEXT PROC inverse (TEXT CONST t):

+  ""15"" + t + " " + ""14""

+END PROC inverse;

+

+PROC put center (TEXT CONST t):

+   put center (t, 80)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t):

+   put center (zeile, t, 80)

+END PROC put center;

+

+PROC put center (TEXT CONST t, INT CONST gesamtbreite):

+   INT VAR cy;

+   get cursor (cy, cy);

+   put center (cy, t, gesamtbreite)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):

+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);

+   put (t).

+END PROC put center;

+

+PROC cl eol: 

+  out (""5"") 

+END PROC cl eol;

+

+PROC cl eop: 

+  out (""4"") 

+END PROC cl eop; 

+ 

+PROC cl eol (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eol 

+END PROC cl eol; 

+ 

+PROC cl eop (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eop 

+END PROC cl eop; 

diff --git a/system/at/unknown/src/AT Utilities b/system/at/unknown/src/AT Utilities
new file mode 100644
index 0000000..bfdee15
--- /dev/null
+++ b/system/at/unknown/src/AT Utilities
@@ -0,0 +1,601 @@
+(*************************************************************************)

+(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und        ***)

+(*** Booten in anderen Partitionen benötigt wird.                      ***)

+(***                                                                   ***)

+(*** Zusammengestellt und geändert : Werner Sauerwein, GMD             ***)

+(***                         Stand : 17.07.86                          ***)

+(*************************************************************************)

+

+PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)

+                          high byte,    (* Martin Schönbeck, Spenge *)

+                          low word,     (* Stand: 13.09.85          *)

+                          high word: 

+ 

+INT PROC high byte (INT CONST value):

+ 

+    TEXT VAR x := "  ";

+    replace (x, 1, value);

+    code (x SUB 2)

+

+END PROC high byte;

+

+INT PROC low byte (INT CONST value):

+ 

+    TEXT VAR x := "  ";

+    replace (x, 1, value);

+    code (x SUB 1)

+

+END PROC low byte; 

+ 

+INT PROC high word (REAL CONST double precission int):

+

+    int (double precission int / 65536.0)

+

+END PROC high word;

+

+INT PROC low word (REAL CONST double precission int): 

+ 

+    string of low bytes ISUB 1.

+

+string of low bytes:

+    code (int (double precission int MOD 256.0)) +

+    code (int ((double precission int MOD 65536.0) / 256.0)). 

+ 

+END PROC low word; 

+END PACKET splitting;

+

+PACKET basic block io DEFINES

+ 

+  read block,

+  write block:

+

+PROC read block (DATASPACE VAR ds,

+                 INT CONST ds page no, 

+                 INT CONST block no,

+                 INT VAR return code):

+  read block; 

+  retry if read error.

+ 

+read block: 

+  block in (ds, ds page no, 0, block no, return code).

+ 

+retry if read error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    read block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN block in (ds, ds page no, 0, 0, return code) 

+  FI. 

+ 

+END PROC read block;

+ 

+PROC write block (DATASPACE CONST ds,

+                 INT CONST ds page no, 

+                 INT CONST block no,

+                 INT VAR return code):

+  write block; 

+  retry if write error. 

+ 

+write block: 

+  block out (ds, ds page no, 0, block no, return code).

+ 

+retry if write error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    write block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN disable stop;

+         DATASPACE VAR dummy ds := nilspace;

+         block in (dummy ds, 2, 0, 0, return code);

+         forget (dummy ds);

+         enable stop

+  FI. 

+ 

+END PROC write block; 

+

+PROC read block (DATASPACE VAR ds, INT CONST ds page,

+                 REAL CONST archive block):

+

+   enable stop;

+   read block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht gelesen werden");

+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+

+END PROC read block;

+

+PROC write block (DATASPACE CONST ds, INT CONST ds page,

+                  REAL CONST archive block):

+

+   enable stop;

+   write block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht geschrieben werden");

+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+

+END PROC write block;

+

+PROC read block (DATASPACE VAR ds,

+                 INT CONST ds page no, 

+                 REAL CONST block no,

+                 INT VAR return code):

+  read block; 

+  retry if read error.

+ 

+read block: 

+  block in (ds, ds page no, high word (block no),

+                             low word (block no), return code).

+ 

+retry if read error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    read block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN block in (ds, ds page no, 0, 0, return code) 

+  FI. 

+ 

+END PROC read block;

+ 

+PROC write block (DATASPACE CONST ds,

+                 INT CONST ds page no, 

+                 REAL CONST block no,

+                 INT VAR return code):

+  write block; 

+  retry if write error. 

+ 

+write block: 

+  block out (ds, ds page no, high word (block no),

+                              low word (block no), return code).

+ 

+retry if write error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    write block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN disable stop;

+         DATASPACE VAR dummy ds := nilspace;

+         block in (dummy ds, 2, 0, 0, return code);

+         forget (dummy ds);

+         enable stop

+  FI. 

+ 

+END PROC write block; 

+END PACKET basic block io;

+

+(**************************************************************************)

+

+PACKET part DEFINES activate :             (* Copyright (C) 1985       *)

+                                           (* Martin Schönbeck, Spenge *)

+                                           (* Stand      : 02.02.86    *)

+                                           (* Changed by : W.Sauerwein *)

+                                           (* Stand      : 04.07.86    *)

+    LET fd channel           = 28;

+

+ROW 256 INT VAR boot block;

+INT VAR boot block session := session - 1;

+

+PROC get boot block:

+ 

+    IF boot block session <> session

+       THEN hole aktuellen boot block

+    FI.

+

+hole aktuellen boot block:

+    disable stop;

+    DATASPACE VAR dummy ds := nilspace;

+    BOUND STRUCT (ALIGN dummy, 

+                  ROW 256 INT block) VAR partition table := dummy ds; 

+    get external block (dummy ds, 2, 0, fd channel); 

+    IF NOT is error

+        THEN transfer data to boot block

+    FI; 

+    forget (dummy ds). 

+ 

+transfer data to boot block:

+    IF not valid boot block

+        THEN try to get valid boot block from file

+    FI;

+    boot block := partition table. block;

+    boot block session := session.

+

+not valid boot block:

+    partition table. block [256] <> boot indicator OR

+    it is an old boot block of eumel.

+

+boot indicator: -21931.

+

+it is an old boot block of eumel:

+    partition table. block [1] = 1514.

+

+try to get valid boot block from file:

+    forget (dummy ds);

+    partition table := old ("bootblock");

+    IF is error THEN LEAVE transfer data to boot block FI.

+ 

+END PROC get boot block;

+

+PROC put boot block:

+ 

+    IF boot block ist uptodate

+        THEN schreibe block auf platte

+        ELSE errorstop ("boot block nicht uptodate")

+    FI.

+

+boot block ist uptodate:

+    boot block session = session.

+

+schreibe block auf platte:

+    disable stop;

+    DATASPACE VAR dummy ds := nilspace;

+    BOUND STRUCT (ALIGN dummy, 

+                  ROW 256 INT block) VAR partition table := dummy ds; 

+    transfer data to dataspace;

+    put external block (dummy ds, 2, 0, fd channel); 

+    forget (dummy ds). 

+ 

+transfer data to dataspace:

+    partition table. block := boot block.

+

+END PROC put boot block;

+

+INT PROC partition type (INT CONST partition):

+

+    low byte (boot block [entry (partition) + 2])

+

+END PROC partition type;

+

+PROC activate (INT CONST part type):

+

+    IF partition type exists AND is possible type

+         THEN deactivate all partitions and

+              activate desired partition

+         ELSE errorstop ("Gewünschte Partitionart gibt es nicht")

+    FI.

+

+is possible type:

+   part type > 0 AND

+   part type < 256.

+

+partition type exists:

+    INT VAR partition;

+    FOR partition FROM 1 UPTO 4 REP

+         IF partition type (partition) = part type 

+             THEN LEAVE partition type exists WITH TRUE

+         FI;

+    PER;

+    FALSE.

+

+deactivate all partitions and activate desired partition:

+    FOR partition FROM 1 UPTO 4 REP

+         deactivate this partition;

+         IF partition type (partition) = part type

+              THEN activate partition

+         FI

+    PER;

+    put boot block.

+

+deactivate this partition:

+    set bit (boot block [entry (partition)], 7);

+    (* first setting needed, because reset bit does xor *)

+    reset bit (boot block [entry (partition)], 7).

+

+activate partition:

+    set bit (boot block [entry (partition)], 7)

+

+END PROC activate;

+

+INT PROC entry (INT CONST partition):

+

+    get boot block;

+    256 - 5 * 8 + (partition * 8)

+

+END PROC entry;

+

+PROC get external block (DATASPACE VAR ds, INT CONST ds page,

+                                             archive block, get channel):

+

+   INT VAR old channel := channel; 

+   continue (get channel);

+   disable stop;

+   read block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht gelesen werden");

+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+   continue (old channel).

+

+END PROC get external block;

+

+PROC put external block (DATASPACE CONST ds, INT CONST ds page,

+                                             archive block, get channel):

+

+   INT VAR old channel := channel; 

+   continue (get channel);

+   disable stop;

+   write block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht geschrieben werden");

+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+   continue (old channel).

+

+END PROC put external block;

+END PACKET part;

+ 

+(**************************************************************************)

+

+PACKET hw clock DEFINES hw clock:        (* Copyright (C) 1985       *)

+                                         (* Martin Schönbeck, Spenge *)

+LET clock length  = 7,                   (* Stand: 06.11.85          *)

+    clock command = 4;

+

+BOUND STRUCT (ALIGN dummy,

+              ROW clock length INT clock field) VAR clock data;

+

+REAL PROC hw clock:

+ 

+    disable stop;

+    get clock;

+    hw date + hw time.

+

+get clock:

+    DATASPACE VAR ds := nilspace;

+    clock data := ds;

+    INT VAR return code, actual channel := channel;

+    go to shard channel;

+    blockin (ds, 2, -clock command, 0, return code);

+    IF actual channel = 0 THEN break (quiet)

+                          ELSE continue (actual channel)

+    FI;

+    IF return code <> 0 

+        THEN errorstop ("Keine Hardware Uhr vorhanden");

+    FI;

+    put clock into text;

+    forget (ds).

+

+put clock into text:

+    TEXT VAR clock text := clock length * "  ";

+    INT VAR i;

+    FOR i FROM 1 UPTO clock length REP

+         replace (clock text, i, clock data. clock field [i]);

+    PER.

+

+go to shard channel:

+    INT VAR retry;

+    FOR retry FROM 1 UPTO 20 REP

+        continue (32);

+        IF is error

+            THEN clear error;

+                 pause (30)

+        FI;

+    UNTIL channel = 32 PER.

+

+hw date:

+    date (day + "." + month + "." + year).

+

+day:    subtext (clock text, 7, 8).

+

+month:  subtext (clock text, 5, 6).

+

+year:   subtext (clock text, 1, 4).

+

+hw time:

+    time (hour + ":" + minute + ":" + second).

+

+hour:   subtext (clock text, 9, 10).

+

+minute: subtext (clock text, 11, 12).

+

+second: subtext (clock text, 13, 14).

+

+END PROC hw clock;

+END PACKET hw clock

+

+(**************************************************************************)

+

+PACKET old shutup DEFINES old shutup,       (* Copyright (C) 1985       *)

+                          old save system:  (* Martin Schönbeck, Spenge *)

+                                            (* Stand: 06.11.85          *)

+PROC old shutup : shutup END PROC old shutup;

+

+PROC old save system : save system END PROC old save system;

+END PACKET old shutup;

+

+PACKET new shutup DEFINES shutup,

+                          ms dos,

+                          save system,

+                          generate ms dos manager,

+                          generate shutup manager:

+

+LET ack = 0;

+

+PROC shutup:

+ 

+    system down (PROC old shutup)

+

+END PROC shutup;

+

+PROC shutup (INT CONST new system):

+ 

+    IF new system <> 0

+         THEN prepare for new system

+    FI;

+    system down (PROC old shutup).

+

+prepare for new system:

+    activate (new system);

+    prepare for rebooting.

+

+prepare for rebooting:

+    INT VAR old channel := channel;

+    continue (32);

+    INT VAR dummy;

+    control (-5, 0, 0, dummy);

+    break (quiet);

+    continue (old channel).

+

+END PROC shutup;

+

+PROC ms dos:

+

+    shutup (1)

+

+END PROC ms dos;

+

+PROC save system:

+ 

+    IF yes ("Leere Floppy eingelegt")

+       THEN system down (PROC old save system)

+    FI

+

+END PROC save system;

+

+PROC system down (PROC operation):

+

+   BOOL VAR dialogue :: command dialogue;

+   command dialogue (FALSE);

+   operation;

+   command dialogue (dialogue);

+   IF command dialogue

+      THEN wait for configurator;

+           show date;

+   FI.

+

+show date:

+   page;

+   line (2); 

+   put ("      Heute ist der"); putline (date);

+   put ("      Es ist"); put (time of day); putline ("Uhr");

+   line (2).

+

+END PROC system down;

+

+DATASPACE VAR ds := nilspace;

+

+PROC wait for configurator:

+

+   INT VAR i, receipt;

+   FOR i FROM 1 UPTO 20 WHILE configurator exists REP

+      pause (30);

+      forget (ds);

+      ds := nilspace;

+      ping pong (configurator, ack, ds, receipt)

+   UNTIL receipt >= 0 PER.

+

+configurator exists:

+   disable stop;

+   TASK VAR configurator := task ("configurator");

+   clear error;

+   NOT is niltask (configurator).

+

+END PROC wait for configurator;

+

+PROC generate shutup manager:

+ 

+     generate shutup manager ("shutup", 0);

+

+END PROC generate shutup manager;

+

+PROC generate ms dos manager:

+ 

+     generate shutup manager ("ms dos", 1);

+

+END PROC generate ms dos manager;

+

+PROC generate shutup manager (TEXT CONST name, INT CONST new system):

+ 

+     TASK VAR son;

+     shutup question := name;

+     new system for manager := new system;

+     begin (name, PROC shutup manager, son)

+

+END PROC generate shutup manager;

+

+INT VAR new system for manager;

+TEXT VAR shutup question;

+

+PROC shutup manager:

+

+     disable stop;

+     command dialogue (TRUE);

+     REP 

+        break;

+        line ;

+        IF yes (shutup question)

+            THEN clear error;

+                 shutup (new system for manager);

+                 pause (300);

+        FI;

+     PER

+

+END PROC shutup manager;

+END PACKET new shutup

+

+(**************************************************************************)

+

+PACKET config manager with time DEFINES configuration manager ,

+                                        configuration manager with time :

+                                      (* Copyright (C) 1985       *)

+INT VAR old session := 0;             (* Martin Schönbeck, Spenge *)

+                                      (* Stand: 06.11.85          *)

+PROC configuration manager: 

+ 

+   configurate;

+   break;

+   global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 

+                      configuration manager with time) 

+ 

+END PROC configuration manager; 

+ 

+PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, 

+                                      phase, TASK CONST order task): 

+ 

+    IF old session <> session

+      THEN

+        disable stop;

+        set clock (hw clock); 

+        set clock (hw clock); (* twice, to avoid all paging delay *) 

+        IF is error THEN IF online THEN put error; clear error; pause (100)

+                                   ELSE errorstop (error message)

+        FI FI;

+        old session := session;

+        set autonom;

+    FI; 

+    configuration manager (ds, order, phase, order task); 

+

+END PROC configuration manager with time; 

+END PACKET config manager with time;

diff --git a/system/at/unknown/src/AT install b/system/at/unknown/src/AT install
new file mode 100644
index 0000000..c02b514
--- /dev/null
+++ b/system/at/unknown/src/AT install
@@ -0,0 +1,92 @@
+(*************************************************************************)

+(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***)

+(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen   ***)

+(*** kann. Startet den "AT Generator".                                 ***)

+(***                                                                   ***)

+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)

+(*************************************************************************)

+

+erste bildschirmmeldung;

+IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !")

+                  ELSE hole dateien vom archiv;

+                       insertiere alle pakete;

+                       put line ("Running ""AT Generator""...");

+                       run ("AT Generator")

+FI;

+forget ("AT install", quiet).

+

+ich bin single : (pcb (9) AND 255) <= 1.

+

+insertiere alle pakete :

+   insert and say ("AT Utilities").

+

+erste bildschirmmeldung :

+   page;

+   put center (" Generator für AT-spezifische Software gestartet."); line;

+   put center ("--------------------------------------------------");

+   line (2).

+

+hole dateien vom archiv :

+   TEXT VAR datei;

+   datei := "AT Utilities";             hole wenn noetig;

+   datei := "AT Generator";             hole wenn noetig;

+   release (archive);

+   line.

+

+hole wenn noetig :

+   IF NOT exists (datei) THEN

+      put line ("Loading """ + datei + """...");

+      fetch (datei, archive)

+   FI.

+

+PROC insert and say (TEXT CONST datei) :

+

+   INT VAR cx, cy;

+   put line ("Inserting """ + datei + """...");

+   get cursor (cx, cy);

+   insert (datei);

+   cl eop (cx, cy); line;

+   forget (datei, quiet).

+

+END PROC insert and say;

+

+TEXT PROC inverse (TEXT CONST t):

+  ""15"" + t + " " + ""14""

+END PROC inverse;

+

+PROC put center (TEXT CONST t):

+   put center (t, 80)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t):

+   put center (zeile, t, 80)

+END PROC put center;

+

+PROC put center (TEXT CONST t, INT CONST gesamtbreite):

+   INT VAR cy;

+   get cursor (cy, cy);

+   put center (cy, t, gesamtbreite)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):

+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);

+   put (t).

+END PROC put center;

+

+PROC cl eol: 

+  out (""5"") 

+END PROC cl eol;

+

+PROC cl eop: 

+  out (""4"") 

+END PROC cl eop; 

+ 

+PROC cl eol (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eol 

+END PROC cl eol; 

+ 

+PROC cl eop (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eop 

+END PROC cl eop; 

diff --git a/system/base/1.7.5/source-disk b/system/base/1.7.5/source-disk
new file mode 100644
index 0000000..5708023
--- /dev/null
+++ b/system/base/1.7.5/source-disk
@@ -0,0 +1 @@
+175_src/source-code-1.7.5.img
diff --git a/system/base/1.7.5/src/advertising b/system/base/1.7.5/src/advertising
new file mode 100644
index 0000000..45f73ef
--- /dev/null
+++ b/system/base/1.7.5/src/advertising
@@ -0,0 +1,35 @@
+(* ------------------- VERSION 1     06.03.86 ------------------- *)
+PACKET advertising DEFINES                    (* Autor: J.Liedtke *)
+ 
+  eumel must advertise :
+
+
+LET myself id field = 9 ;
+
+
+PROC eumel must advertise :
+
+  IF online AND channel <= 15
+    THEN out (""1""4"") ;
+         IF station is not zero
+           THEN out (""15"Station: ") ;
+                out (text (station number)) ;
+                out (" "14"")
+         FI ;
+         cursor (60,1) ;
+         out (""15"Terminal: ") ;
+         out (text (channel)) ;
+         out (" "14"") ;
+         cursor (22,5) ;
+   (*    out ("E U M E L    Pilot-Version /M"13""10""10""10"")   *)
+         out ("E U M E L    Version 1.7.5.10 /M+ "13""10""10""10"")
+  FI .
+
+station is not zero :  pcb (myself id field) >= 256 .
+
+station number      :  pcb (myself id field) DIV 256 .
+
+ENDPROC eumel must advertise ;
+ 
+ENDPACKET advertising ;
+
diff --git a/system/base/1.7.5/src/basic transput b/system/base/1.7.5/src/basic transput
new file mode 100644
index 0000000..5608bb1
--- /dev/null
+++ b/system/base/1.7.5/src/basic transput
@@ -0,0 +1,177 @@
+
+PACKET basic transput DEFINES
+                      out ,
+                      outsubtext ,
+                      outtext ,
+                      TIMESOUT ,
+                      cout ,
+                      display ,
+                      inchar ,
+                      incharety ,
+                      cat input ,
+                      pause ,
+                      cursor ,
+                      get cursor ,
+                      channel ,
+                      online ,
+                      control ,
+                      blockout ,
+                      blockin :
+ 
+ 
+
+LET channel field  = 4 ,
+    blank times 64 =
+    "                                                                " ;
+
+LET BLOCKIO = STRUCT (ALIGN page align, ROW 256 INT buffer) ,
+              buffer page = 2 ;
+
+BOUND BLOCKIO VAR block io ;
+DATASPACE VAR block io ds ;
+INITFLAG VAR this packet := FALSE ;
+
+
+PROC out (TEXT CONST text ) : 
+ EXTERNAL 60 
+ENDPROC out ; 
+ 
+PROC outsubtext ( TEXT CONST source, INT CONST from ) : 
+ EXTERNAL 62 
+END PROC outsubtext; 
+ 
+PROC outsubtext (TEXT CONST source, INT CONST from, to) : 
+ EXTERNAL 63 
+END PROC outsubtext;
+
+PROC outtext ( TEXT CONST source, INT CONST from, to ) : 
+  out subtext (source, from, to) ; 
+  INT VAR trailing ;
+  IF from <= LENGTH source 
+    THEN trailing := to - LENGTH source 
+    ELSE trailing := to + 1 - from 
+  FI ;
+  IF trailing > 0 
+    THEN trailing TIMESOUT " " 
+  FI 
+ENDPROC outtext ;
+
+OP TIMESOUT (INT CONST times, TEXT CONST text) : 
+
+  IF text = " "
+    THEN fast timesout blank
+    ELSE timesout
+  FI .
+
+fast timesout blank :
+  INT VAR i := 0 ;
+  WHILE i + 64 < times REP
+    out (blank times 64) ;
+    i INCR 64
+  PER ;
+  outsubtext (blank times 64, 1, times - i) .
+
+timesout :
+  FOR i FROM 1 UPTO times REP 
+    out(text) 
+  ENDREP .
+
+ENDOP TIMESOUT ;
+ 
+PROC display (TEXT CONST text) :
+  IF online
+    THEN out (text)
+  FI
+ENDPROC display ;
+
+PROC inchar (TEXT VAR character ) :
+ EXTERNAL 64
+ENDPROC inchar ;
+ 
+TEXT PROC incharety :
+ EXTERNAL 65
+END PROC incharety ;
+ 
+TEXT PROC incharety (INT CONST time limit) :
+ internal pause (time limit) ;
+ incharety
+ENDPROC incharety ;
+ 
+PROC pause (INT CONST time limit) :
+ internal pause (time limit) ;
+ TEXT CONST dummy := incharety
+ENDPROC pause ;
+ 
+PROC pause :
+ TEXT VAR dummy; inchar (dummy)
+ENDPROC pause ;
+
+PROC internal pause (INT CONST time limit) :
+ EXTERNAL 66
+ENDPROC internal pause ;
+
+PROC cat input (TEXT VAR t, esc char) :
+ EXTERNAL 68
+ENDPROC cat input ;
+
+ 
+PROC cursor (INT CONST x, y) :
+ out (""6"") ;
+ out (code(y-1)) ;
+ out (code(x-1)) ;
+ENDPROC cursor ;
+ 
+PROC get cursor (INT VAR x, y) :
+  EXTERNAL 67
+ENDPROC get cursor ;
+ 
+PROC cout (INT CONST number) :
+  EXTERNAL 61
+ENDPROC cout ;
+
+
+INT PROC channel :
+  pcb (channel field)
+ENDPROC channel ;
+
+BOOL PROC online :
+  pcb (channel field) <> 0
+ENDPROC online ;
+ 
+
+PROC control (INT CONST code1, code2, code3, INT VAR return code) :
+  EXTERNAL 84
+ENDPROC control ;
+
+PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2,
+               INT VAR return code) :
+
+  access block io ds ;
+  block io.buffer := block ;
+  blockout (block io ds, buffer page, code1, code2, return code) .
+
+access block io ds :
+  IF NOT initialized (this packet)
+    THEN block io ds := nilspace
+  FI ;
+  block io := block io ds .
+
+ENDPROC blockout ;
+
+PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2,
+              INT VAR return code) :
+
+  access block io ds ;
+  blockin (block io ds, buffer page, code1, code2, return code) ;
+  block := block io.buffer .
+
+access block io ds :
+  IF NOT initialized (this packet)
+    THEN block io ds := nilspace
+  FI ;
+  block io := block io ds .
+
+ENDPROC blockin ;
+
+ENDPACKET basic transput ;
+
diff --git a/system/base/1.7.5/src/bits b/system/base/1.7.5/src/bits
new file mode 100644
index 0000000..e9e84e7
--- /dev/null
+++ b/system/base/1.7.5/src/bits
@@ -0,0 +1,78 @@
+
+PACKET bits DEFINES
+
+    AND ,
+    OR ,
+    XOR ,
+    bit ,
+    lowest reset ,
+    lowest set ,
+    reset bit ,
+    rotate ,
+    set bit :
+
+LET bits per int = 16 ;
+
+ROW bits per int INT VAR bit mask := ROW bits per int INT:
+    (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1) ;
+
+PROC rotate (INT VAR bits, INT CONST number of bits) :
+  EXTERNAL 83
+ENDPROC rotate ;
+
+INT OP AND (INT CONST left, right) :
+  EXTERNAL 124
+ENDOP AND ;
+
+INT OP OR (INT CONST left, right) :
+  EXTERNAL 125
+ENDOP OR ;
+
+INT OP XOR (INT CONST left, right) :
+  EXTERNAL 121
+ENDOP XOR ;
+
+BOOL PROC bit (INT CONST bits, bit no) :
+
+  (bits AND bit mask (bit no+1)) <> 0
+
+ENDPROC bit ;
+
+PROC set bit (INT VAR bits, INT CONST bit no) :
+
+  bits := bits OR bit mask (bit no+1)
+
+ENDPROC set bit ;
+
+PROC reset bit (INT VAR bits,INT CONST bit no) :
+
+  bits := bits XOR (bits AND bit mask (bit no+1))
+
+ENDPROC reset bit ;
+
+INT PROC lowest set (INT CONST bits) :
+
+  INT VAR mask index ;
+  FOR mask index FROM 1 UPTO 16 REP
+    IF (bits AND bit mask (mask index)) <> 0
+      THEN LEAVE lowest set WITH mask index - 1
+    FI
+  PER ;
+  -1
+
+ENDPROC lowest set ;
+
+INT PROC lowest reset (INT CONST bits) :
+
+  INT VAR mask index ;
+  FOR mask index FROM 1 UPTO bits per int REP
+    IF (bits AND bit mask (mask index)) = 0
+      THEN LEAVE lowest reset WITH mask index - 1
+    FI
+  PER ;
+  -1
+
+ENDPROC lowest reset ;
+
+ENDPACKET bits ;
+
diff --git a/system/base/1.7.5/src/bool b/system/base/1.7.5/src/bool
new file mode 100644
index 0000000..5bf1e65
--- /dev/null
+++ b/system/base/1.7.5/src/bool
@@ -0,0 +1,16 @@
+ 
+PACKET bool DEFINES  XOR, true, false :
+ 
+BOOL CONST true := TRUE ,
+           false:= FALSE ;
+
+BOOL OP XOR (BOOL CONST left, right) :
+ 
+  IF left THEN NOT right
+          ELSE right
+  FI
+ 
+ENDOP XOR ;
+ 
+ENDPACKET bool ;
+
diff --git a/system/base/1.7.5/src/command dialogue b/system/base/1.7.5/src/command dialogue
new file mode 100644
index 0000000..3011187
--- /dev/null
+++ b/system/base/1.7.5/src/command dialogue
@@ -0,0 +1,123 @@
+
+PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)
+                                               (* Stand:  25.11.83 *)
+       command dialogue ,
+       say ,
+       yes ,
+       no ,
+       param position ,
+       last param ,
+       std ,
+       QUIET ,
+       quiet :
+ 
+
+LET up      = ""3"" ,
+    right   = ""2"" ,
+    cr lf   = ""13""10"" ,
+    param pre  = " (""" ,
+    param post = """)"13""10"" ;
+ 
+
+TEXT VAR std param := "" ;
+ 
+BOOL VAR dialogue flag := TRUE ;
+
+INT VAR param x := 0 ;
+
+
+TYPE QUIET = INT ;
+
+QUIET PROC quiet :
+  QUIET:(0)
+ENDPROC quiet ;
+
+ 
+BOOL PROC command dialogue :
+  dialogue flag
+ENDPROC command dialogue ;
+ 
+PROC command dialogue (BOOL CONST status) :
+  dialogue flag := status
+ENDPROC command dialogue ;
+ 
+ 
+BOOL PROC yes (TEXT CONST question) :
+ 
+  IF dialogue flag
+    THEN ask question
+    ELSE TRUE
+  FI .
+ 
+ask question :
+  out (question) ;
+  skip previous input chars ;
+  out (" (j/n) ? ") ;
+  get answer ;
+  IF correct answer
+    THEN out (answer) ;
+         out (cr lf) ;
+         positive answer
+    ELSE out (""7"") ;
+         LENGTH question + 9 TIMESOUT ""8"" ;
+         yes (question)
+  FI .
+ 
+get answer :
+  TEXT VAR answer ;
+  inchar (answer) .
+ 
+correct answer :
+  pos ("jnyJNY", answer) > 0 .
+ 
+positive answer :
+  pos ("jyJY", answer) > 0 .
+
+skip previous input chars :
+  REP UNTIL incharety = "" PER .
+ 
+ENDPROC yes ;
+ 
+BOOL PROC no (TEXT CONST question) :
+ 
+  NOT yes (question)
+ 
+ENDPROC no ;
+ 
+PROC say (TEXT CONST message) :
+ 
+  IF dialogue flag
+    THEN out (message)
+  FI
+ 
+ENDPROC say ;
+ 
+PROC param position (INT CONST x) :
+ 
+  param x := x
+
+ENDPROC param position ;
+
+TEXT PROC last param :
+ 
+  IF param x > 0 AND online
+    THEN out (up) ;
+         param x TIMESOUT right ;
+         out (param pre) ;
+         out (std param) ;
+         out (param post)
+  FI ;
+  std param .
+ 
+ENDPROC last param ;
+ 
+PROC last param (TEXT CONST new) :
+  std param := new
+ENDPROC last param ;
+
+TEXT PROC std :
+  std param
+ENDPROC std ;
+
+ENDPACKET command dialogue ;
+
diff --git a/system/base/1.7.5/src/command handler b/system/base/1.7.5/src/command handler
new file mode 100644
index 0000000..756382b
--- /dev/null
+++ b/system/base/1.7.5/src/command handler
@@ -0,0 +1,290 @@
+(* ------------------- VERSION 2     05.05.86 ------------------- *)
+PACKET command handler DEFINES                (* Autor: J.Liedtke *)
+
+       get command , 
+       analyze command , 
+       do command , 
+       command error ,
+       cover tracks :
+ 
+ 
+LET cr lf        = ""4""13""10"" ,
+    esc k        = ""27"k" ,
+    command pre  = ""4""13"      " ,
+    command post = ""13""10"      " ,
+ 
+    max command length = 2010 ,
+
+    tag type = 1 ,
+    texttype = 4 ,
+    eof type = 7 ;
+ 
+ 
+TEXT VAR command handlers own command line := "" ,
+         previous command line := "" ,
+         symbol ,
+         procedure ,
+         pattern ,
+         error note := "" ;
+ 
+INT VAR  symbol type ;
+
+ 
+PROC get command (TEXT CONST command text) :
+
+  get command (command text, command handlers own command line)
+
+ENDPROC get command ;
+
+PROC get command (TEXT CONST command text, TEXT VAR command line) :
+
+  set line nr (0) ;
+  error protocoll ;
+  get command from console .
+ 
+error protocoll :
+  IF is error
+    THEN put error ;
+         clear error
+    ELSE command line := "" ;
+  FI .
+ 
+get command from console :
+  normalize cursor ;
+  REP
+    out (command pre) ;
+    out (command text) ;
+    out (command post) ;
+    editget command
+  UNTIL command line <> "" PER ;
+  param position (LENGTH command line) ;
+  out (command post) .
+ 
+editget command :
+  TEXT VAR exit char ;
+  REP
+    get cursor (x, y) ;
+    editget (command line, max command length, x size - x,
+             "", "k", exit char) ;
+    ignore halt errors during editget ;
+    break quiet if command line is too long ;
+    IF exit char = esc k
+      THEN cursor to begin of command input ;
+           command line := previous command line
+    ELIF LENGTH command line > 1
+      THEN previous command line := command line ;
+           LEAVE editget command
+    ELSE   LEAVE editget command
+    FI
+  PER .
+
+normalize cursor :
+  INT VAR x, y;
+  out (crlf) ;
+  get cursor (x, y) ;
+  cursor (x, y) .
+ 
+ignore halt errors during editget :
+  IF is error
+    THEN clear error
+  FI .
+
+break quiet if command line is too long :
+  IF command line is too long
+    THEN command line := "break (quiet)"
+  FI .
+
+command line is too long :
+  LENGTH command line = max command length .
+
+cursor to begin of command input :
+  out (command pre) .
+
+ENDPROC get command ;
+ 
+
+PROC analyze command ( TEXT CONST command list,
+                       INT CONST permitted type, 
+                       INT VAR command index, number of params, 
+                       TEXT VAR param 1, param 2) :
+
+  analyze command (command list, command handlers own command line,
+                   permitted type, command index,
+                   number of params, param 1, param 2)
+
+ENDPROC analyze command ;
+
+PROC analyze command ( TEXT CONST command list, command line,
+                       INT CONST permitted type, 
+                       INT VAR command index, number of params, 
+                       TEXT VAR param 1, param 2) :
+
+  error note := "" ;
+  scan (command line) ;
+  next symbol ;
+  IF symbol type <> tag type AND symbol <> "?"
+    THEN error ("Name ungueltig") ;
+         impossible command
+  ELIF pos (command list, symbol) > 0
+    THEN procedure name ;
+         parameter list pack option ;
+         nothing else in command line ;
+         decode command
+    ELSE impossible command
+  FI .
+ 
+procedure name :
+  procedure := symbol ;
+  next symbol .
+ 
+parameter list pack option :
+  number of params := 0 ;
+  param 1 := "" ;
+  param 2 := "" ;
+  IF symbol = "("
+    THEN next symbol ;
+         parameter list ;
+         IF symbol <> ")" AND error note = ""
+           THEN error (") fehlt")
+         FI
+  ELIF symbol type <> eof type
+    THEN error ("( fehlt")
+  FI .
+ 
+parameter list :
+  parameter (param 1, number of params, permitted type) ;
+  IF symbol = ","
+    THEN next symbol ;
+         parameter (param 2, number of params, permitted type) ;
+  FI .
+ 
+nothing else in command line :
+  next symbol ;
+  IF symbol <> ""
+    THEN error ("Kommando zu schwierig")
+  FI .
+
+decode command :
+  command index := index (command list, procedure, number of params) .
+ 
+impossible command :
+  command index := 0 .
+ 
+ENDPROC analyze command ;
+ 
+PROC parameter (TEXT VAR param, INT VAR number of params,
+                INT CONST permitted type) :
+ 
+  IF symbol type = text type OR symbol type = permitted type
+    THEN param := symbol ;
+         number of params INCR 1 ;
+         next symbol
+    ELSE error ("Parameter ist kein TEXT ("" fehlt)")
+  FI
+ 
+ENDPROC parameter ;
+ 
+INT PROC index (TEXT CONST list, procedure, INT CONST params) :
+ 
+  pattern := procedure ;
+  pattern CAT ":" ;
+  IF procedure name found
+    THEN get colon pos ;
+         get dot pos ;
+         get end pos ;
+         get command index ;
+         get param index ;
+         IF param index >= 0
+           THEN command index + param index
+           ELSE - command index
+         FI
+    ELSE 0
+  FI .
+ 
+procedure name found :
+  INT VAR index pos := pos (list, pattern) ;
+  WHILE index pos > 0 REP
+    IF index pos = 1  COR  (list SUB index pos - 1) <= "9"
+      THEN LEAVE procedure name found WITH TRUE 
+    FI ;
+    index pos := pos (list, pattern, index pos + 1) 
+  PER ;
+  FALSE .
+ 
+get param index :
+  INT CONST param index :=
+            pos (list, text (params), dot pos, end pos) - dot pos - 1 .
+ 
+get command index :
+  INT CONST command index :=
+            int ( subtext (list, colon pos + 1, dot pos - 1) ) .
+ 
+get colon pos :
+  INT CONST colon pos := pos (list, ":", index pos) .
+ 
+get dot pos :
+  INT CONST dot pos := pos (list, ".", index pos) .
+ 
+get end pos :
+  INT CONST end pos := dot pos + 4 .
+ 
+ENDPROC index ;
+ 
+PROC do command :
+
+  do (command handlers own command line)
+
+ENDPROC do command ;
+
+PROC error (TEXT CONST message) :
+ 
+  error note := message ;
+  scan ("") ;
+  procedure := "-"
+ 
+ENDPROC error ;
+ 
+PROC command error :
+
+  disable stop ;
+  IF error note <> ""
+    THEN errorstop (error note) ;
+         error note := ""
+  FI ;
+  enable stop
+
+ENDPROC command error ;
+
+
+PROC next symbol :
+ 
+  next symbol (symbol, symbol type)
+ 
+ENDPROC next symbol ;
+ 
+
+PROC cover tracks :
+
+  cover tracks (command handlers own command line) ;
+  cover tracks (previous command line) ;
+  erase buffers of compiler and do packet .
+
+erase buffers of compiler and do packet :
+  do (command handlers own command line) .
+
+ENDPROC cover tracks ;
+
+PROC cover tracks (TEXT VAR secret) :
+
+  INT VAR i ;
+  FOR i FROM 1 UPTO LENGTH secret REP
+    replace (secret, i, " ")
+  PER ;
+  WHILE LENGTH secret < 13 REP
+    secret CAT " "
+  PER
+
+ENDPROC cover tracks ;
+
+ENDPACKET command handler ;
+
diff --git a/system/base/1.7.5/src/dataspace b/system/base/1.7.5/src/dataspace
new file mode 100644
index 0000000..3045a53
--- /dev/null
+++ b/system/base/1.7.5/src/dataspace
@@ -0,0 +1,74 @@
+(* ------------------- VERSION 3     22.04.86 ------------------- *)
+PACKET dataspace DEFINES 
+
+    := ,
+    nilspace ,
+    forget ,
+    type ,
+    heap size ,
+    storage ,
+    ds pages ,
+    next ds page ,
+    blockout ,
+    blockin ,
+    ALIGN :
+
+
+LET myself id field   = 9 ,
+    lowest ds number  = 4 ,
+    highest ds number = 255 ;
+
+TYPE ALIGN = ROW 252 INT ;
+
+OP := (DATASPACE VAR dest, DATASPACE CONST source ) : 
+  EXTERNAL 70
+ENDOP := ;
+ 
+DATASPACE PROC nilspace : 
+  EXTERNAL 69
+ENDPROC nilspace ;
+ 
+PROC forget (DATASPACE CONST dataspace ) :
+  EXTERNAL 71
+ENDPROC forget ;
+ 
+PROC type (DATASPACE CONST ds, INT CONST type) :
+  EXTERNAL 72
+ENDPROC type ;
+ 
+INT PROC type (DATASPACE CONST ds) :
+  EXTERNAL 73
+ENDPROC type ;
+ 
+INT PROC heap size (DATASPACE CONST ds) :
+  EXTERNAL 74
+ENDPROC heap size ;
+
+INT PROC storage (DATASPACE CONST ds) :
+  (ds pages (ds) + 1) DIV 2
+ENDPROC storage ;
+
+INT PROC ds pages (DATASPACE CONST ds) :
+  pages (ds, pcb (myself id field))
+ENDPROC ds pages ;
+
+INT PROC pages (DATASPACE CONST ds, INT CONST task nr) :
+  EXTERNAL 88
+ENDPROC pages ;
+
+INT PROC next ds page (DATASPACE CONST ds, INT CONST page nr) :
+  EXTERNAL 87
+ENDPROC next ds page ;
+
+PROC blockout (DATASPACE CONST ds, INT CONST page nr, code1, code2,
+               INT VAR return code) :
+  EXTERNAL 85
+ENDPROC blockout ;
+
+PROC blockin (DATASPACE VAR ds, INT CONST page nr, code1, code2,
+              INT VAR return code) :
+  EXTERNAL 86
+ENDPROC blockin ;
+
+ENDPACKET dataspace ;
+
diff --git a/system/base/1.7.5/src/date handling b/system/base/1.7.5/src/date handling
new file mode 100644
index 0000000..66da110
--- /dev/null
+++ b/system/base/1.7.5/src/date handling
@@ -0,0 +1,303 @@
+PACKET date handling DEFINES date, time,        (*  Autor: H. Indenbirken  *)
+                             time of day,       (*  Stand:  02.06.1986 (wk)*)
+                             month, day , year ,
+                             hour ,
+                             minute,
+                             second :
+
+LET middle yearlength = 31557380.0,
+    weeklength =    604800.0,
+    daylength  =     86400.0,
+    hours      =      3600.0,
+    minutes    =        60.0,
+    seconds    =         1.0;
+
+
+(* Tage bis zum Jahr 01.01.1900: 693970.25   5.995903e10   Sekunden        *)
+(* Dieser Tag ist ein Montag                                               *)
+
+REAL VAR begin of today := 0.0 , end of today := 0.0 ;
+
+TEXT VAR today , result ;
+
+
+ROW 12 REAL CONST previous days :: ROW 12 REAL : (0.0, 2678400.0, 5097600.0,
+                                           7776000.0, 10368000.0, 13046400.0,
+                                          15638400.0, 18316800.0, 20995200.0,
+                                          23587200.0, 26265600.0, 28857600.0);
+ 
+REAL PROC day: day length END PROC day;
+REAL PROC hour: hours     END PROC hour;
+REAL PROC minute: minutes END PROC minute;
+REAL PROC second: seconds END PROC second;
+
+TEXT PROC date :
+
+  IF clock (1) < begin of today OR end of today <= clock (1)
+  THEN begin of today := clock (1) ;
+       end of today := floor (begin of today/daylength)*daylength+daylength;
+       today := date (begin of today)
+  FI ;
+  today
+ 
+ENDPROC date ;
+
+TEXT PROC date (REAL CONST datum):
+  INT VAR year :: int (datum/middle yearlength),
+          day  :: int (((datum - datum MOD daylength) MOD middle yearlength) / daylength) + 1;
+
+correct kalendary day;
+ 
+  calculate month and correct day;
+  result := daytext;
+  result CAT monthtext;
+  result CAT yeartext;
+  change all (result, " ", "0") ;
+  result .
+
+correct kalendary day:
+  IF day >= 60 AND NOT leapyear 
+  THEN day INCR 1 FI  .
+
+leapyear:
+  IF year MOD 100 = 0 
+    THEN year MOD 400 = 0
+    ELSE year MOD 4 = 0 
+  FI.
+
+calculate month and correct day:
+  INT VAR month;
+  IF day > 182
+  THEN IF day > 274
+       THEN IF day > 305
+            THEN IF day > 335
+                 THEN month := 12;
+                      day DECR 335
+                 ELSE month := 11;
+                      day DECR 305
+                 FI
+            ELSE month := 10;
+                 day DECR 274
+            FI
+       ELSE IF day > 213
+            THEN IF day > 244
+                 THEN month := 9;
+                      day DECR 244
+                 ELSE month := 8;
+                      day DECR 213
+                 FI
+            ELSE month := 7;
+                 day DECR 182
+            FI
+       FI 
+  ELSE IF day > 91
+       THEN IF day > 121
+            THEN IF day > 152
+                 THEN month := 6;
+                      day DECR 152
+                 ELSE month := 5;
+                      day DECR 121
+                 FI
+            ELSE month := 4;
+                 day DECR 91
+            FI
+       ELSE IF day > 31
+            THEN IF day > 60
+                 THEN month := 3;
+                      day DECR 60
+                 ELSE month := 2;
+                      day DECR 31
+                 FI
+            ELSE month := 1 FI
+       FI 
+  FI  .
+
+daytext :
+  text (day, 2) + "."   .
+
+monthtext :
+  text (month,2) + "."   .
+
+yeartext:
+  IF 1900 <= year AND year < 2000
+    THEN text (year - 1900, 2)
+    ELSE text (year, 4)
+  FI   .
+
+END PROC date;
+
+TEXT PROC day (REAL CONST datum):
+  SELECT int ((datum MOD weeklength)/daylength) OF
+  CASE 1: "Donnerstag"
+  CASE 2: "Freitag"
+  CASE 3: "Samstag"
+  CASE 4: "Sonntag"
+  CASE 5: "Montag"
+  CASE 6: "Dienstag"
+  OTHERWISE "Mittwoch" ENDSELECT  .
+END PROC day;
+
+TEXT PROC month (REAL CONST datum):
+  SELECT int (subtext (date (datum), 4, 5)) OF
+  CASE  1: "Januar"
+  CASE  2: "Februar"
+  CASE  3: "März"
+  CASE  4: "April"
+  CASE  5: "Mai"
+  CASE  6: "Juni"
+  CASE  7: "Juli"
+  CASE  8: "August"
+  CASE  9: "September"
+  CASE 10: "Oktober"
+  CASE 11: "November"
+  OTHERWISE "Dezember" ENDSELECT  .
+
+END PROC month;
+
+TEXT PROC year (REAL CONST datum) :
+
+  TEXT VAR buffer := subtext (date (datum), 7) ;
+  IF LENGTH buffer = 2
+    THEN "19" + buffer
+    ELSE buffer
+  FI .
+
+ENDPROC year ;
+
+TEXT PROC time of day :
+  time of day (clock (1))
+ENDPROC time of day ;
+
+TEXT PROC time of day (REAL CONST value) :
+  subtext (time (value MOD daylength), 1, 5)
+ENDPROC time of day ;
+
+TEXT PROC time (REAL CONST value) :
+  time (value,10)
+ENDPROC time ;
+
+TEXT PROC time (REAL CONST value, INT CONST length) :
+  result := "" ;
+  IF length > 7
+    THEN result CAT hour ;
+         result CAT ":" 
+  FI ;
+  result CAT minute ;
+  result CAT ":" ;
+  result CAT rest ;
+  change all (result, " ", "0") ;
+  result .
+
+hour :
+  text (int (value/hours), length-8) .
+
+minute :
+  text (int (value/minutes MOD 60.0), 2)  .
+
+rest :
+  text (value MOD minutes, 4, 1) .
+
+END PROC time ; 
+
+REAL PROC date (TEXT CONST datum) :
+  split and check datum;
+  real (day no)*daylength +
+  previous days [month no] + calendary day +
+  floor (real (year no)*middleyearlength / daylength)*daylength  .
+
+split and check datum:
+  INT CONST day no :: first no;
+  IF NOT last conversion ok 
+  THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI;
+
+  INT CONST month no :: second no;
+  IF NOT last conversion ok OR month no < 1 OR month no > 12
+  THEN errorstop ("inkorrekte Datumsangabe (Monat) : " + datum) FI;
+
+  INT CONST year no :: third no + century;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Jahr) : " + datum) FI;
+
+  IF day no < 1 OR day no > size of month
+  THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI  .
+
+century:
+  IF (length (datum) - second pos) <= 2
+  THEN 1900
+  ELSE 0 FI  .
+
+size of month:
+  SELECT month no OF
+  CASE 1, 3, 5, 7, 8, 10, 12: 31
+  CASE 4, 6, 9, 11: 30
+  OTHERWISE february size ENDSELECT  .
+
+february size:
+  IF leapyear
+  THEN 29
+  ELSE 28 FI  .
+
+calendary day:
+  IF month no > 2 AND leapyear 
+  THEN daylength
+  ELSE 0.0 FI  .
+
+leapyear:
+  year no MOD 4 = 0  AND year no MOD 400 <> 0  .
+
+first no:
+  INT CONST first pos :: pos (datum, ".");
+  int (subtext (datum, 1, first pos-1))  .
+
+second no:
+  INT CONST second pos :: pos (datum, ".", first pos+1);
+  int (subtext (datum, first pos + 1, second pos-1))  .
+
+third no:
+  int (subtext (datum, second pos + 1))  .
+
+END PROC date;
+
+REAL PROC time (TEXT CONST time) :
+  split and check time;
+  hour + min + sec  .
+
+split and check time:
+  REAL CONST hour :: hour no * hours;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Stunde) : " + time) FI;
+
+  REAL CONST min  :: min no * minutes;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Minute) : " + time) FI;
+
+  REAL CONST sec :: sec no;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Sekunde) : " + time) FI;
+
+  set conversion (hour ok AND min ok AND sec ok)  .
+ 
+hour no:
+  INT CONST hour pos :: pos (time, ":");
+  real (subtext (time, 1, hour pos-1))  .
+
+min no:
+  INT VAR min pos :: pos (time, ":", hour pos+1);
+  IF min pos = 0 
+    THEN real (subtext (time, hour pos + 1, LENGTH time))
+    ELSE real (subtext (time, hour pos + 1, min pos-1)) 
+  FI .
+
+sec no:
+  IF min pos = 0
+    THEN 0.0
+    ELSE real (subtext (time, min pos + 1)) 
+  FI .
+
+hour ok: 0.0 <= hour AND hour < daylength  .
+min ok:  0.0 <= min  AND min  < hours  .
+sec ok:  0.0 <= sec  AND sec  < minutes  .
+END PROC time;
+ 
+END PACKET datehandling
+
diff --git a/system/base/1.7.5/src/editor b/system/base/1.7.5/src/editor
new file mode 100644
index 0000000..62af2db
--- /dev/null
+++ b/system/base/1.7.5/src/editor
@@ -0,0 +1,2959 @@
+PACKET editor paket DEFINES                           (*  EDITOR   121   *)
+       (**********)                                   (*  19.07.85 -bk-  *)
+                                                      (*  10.09.85 -ws-  *)
+                                                      (*  25.04.86 -sh-  *)
+        edit, editget,                                (*  06.06.86 -wk-  *)
+        quit, quit last,                              (*  04.06.86 -jl-  *)
+        push, type,
+        word wrap, margin,
+        write permission,
+        set busy indicator,
+        two bytes,
+        is kanji esc, 
+        within kanji,
+        rubin mode,
+        is editget,
+        getchar,                      nichts neu,
+        getcharety,                   satznr neu,
+        is incharety,                 ueberschrift neu,
+        get window,                   zeile neu,
+        get editcursor,               abschnitt neu,
+        get editline,                 bildabschnitt neu,
+        put editline,                 bild neu,
+        aktueller editor,             alles neu,
+        groesster editor,             satznr zeigen,
+        open editor,                  ueberschrift zeigen,
+        editfile,                     bild zeigen:
+
+
+LET     hop            = ""1"",       right          = ""2"",
+        up char        = ""3"",       clear eop      = ""4"",
+        clear eol      = ""5"",       cursor pos     = ""6"",
+        piep           = ""7"",       left           = ""8"",
+        down char      = ""10"",      rubin          = ""11"",
+        rubout         = ""12"",      cr             = ""13"",
+        mark key       = ""16"",      abscr          = ""17"",
+        inscr          = ""18"",      dezimal        = ""19"",
+        backcr         = ""20"",      esc            = ""27"",
+        dach           = ""94"",      blank          = " ";
+ 
+
+LET     no output      = 0,           out zeichen    = 1,
+        out feldrest   = 2,           out feld       = 3,
+        clear feldrest = 4;
+ 
+LET     FELDSTATUS = STRUCT (INT  stelle, alte stelle, rand, limit,
+                                  anfang, marke, laenge, verschoben,
+                             BOOL einfuegen, fliesstext, write access,
+                             TEXT tabulator);
+FELDSTATUS VAR feldstatus;
+ 
+TEXT VAR begin mark := ""15"",
+         end mark   := ""14"";
+ 
+TEXT VAR separator := "", kommando := "", audit := "", zeichen := "",
+         satzrest := "", merksatz := "", alter editsatz := "";
+ 
+INT  VAR kommando zeiger := 1, umbruchstelle, umbruch verschoben,
+         zeile, spalte, output mode := no output, postblanks := 0,
+         min schreibpos, max schreibpos, cpos, absatz ausgleich;
+
+BOOL VAR lernmodus := FALSE, separator eingestellt := FALSE,
+         invertierte darstellung := FALSE, absatzmarke steht,
+         cursor diff := FALSE, editget modus := FALSE,
+         two byte mode := FALSE, std fliesstext := TRUE;.
+ 
+schirmbreite : x size - 1 . 
+schirmhoehe  : y size . 
+maxbreite    : schirmbreite - 2 .
+maxlaenge    : schirmhoehe - 1 . 
+marklength   : mark size .;
+
+initialisiere editor; 
+ 
+.initialisiere editor :
+  anfang := 1; zeile := 0; verschoben := 0; tabulator := "";
+  einfuegen := FALSE; fliesstext := TRUE; zeileneinfuegen := FALSE;
+  marke := 0; bildmarke := 0; feldmarke := 0.;
+
+(********************************  editget  ********************************)
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge,
+              TEXT CONST sep, res, TEXT VAR exit char) :
+  IF editlaenge < 1 THEN errorstop ("Fenster zu klein") FI; 
+  separator := ""13""; separator CAT sep;
+  separator eingestellt := TRUE;
+  TEXT VAR reservierte editget tasten := ""11""12"" ;
+  reservierte editget tasten CAT res ;
+  disable stop;
+  absatz ausgleich := 0; exit char := ""; get cursor;
+  FELDSTATUS CONST alter feldstatus := feldstatus;
+  feldstatus := FELDSTATUS : (1, 1, spalte - 1, editlimit,
+                              1, 0, editlaenge, 0,
+                              FALSE, FALSE, TRUE, "");
+  konstanten neu berechnen;
+  output mode := out feld;
+  feld editieren;
+  zeile verlassen;
+  feldstatus := alter feldstatus;
+  konstanten neu berechnen;
+  separator := "";
+  separator eingestellt := FALSE .
+ 
+feld editieren :
+  REP
+    feldeditor (editsatz, reservierte editget tasten);
+    IF   is error
+    THEN kommando zeiger := 1; kommando := ""; LEAVE feld editieren
+    FI ;
+    TEXT VAR t, zeichen; getchar (zeichen);
+    IF   zeichen ist separator
+    THEN exit char := zeichen; LEAVE feld editieren
+    ELIF zeichen = hop
+    THEN feldout (editsatz, stelle); getchar (zeichen)
+    ELIF zeichen = mark key
+    THEN output mode := out feld
+    ELIF zeichen = abscr
+    THEN exit char := cr; LEAVE feld editieren
+    ELIF zeichen = esc
+    THEN getchar (zeichen); auf exit pruefen;
+         IF   zeichen = rubout                                       (*sh*)
+         THEN IF   marke > 0
+              THEN merksatz := subtext (editsatz, marke, stelle - 1);
+                   change (editsatz, marke, stelle - 1, "");
+                   stelle := marke; marke := 0; konstanten neu berechnen
+              FI
+         ELIF zeichen = rubin
+         THEN t := subtext (editsatz, 1, stelle - 1);
+              t CAT merksatz;
+              satzrest := subtext (editsatz, stelle);
+              t CAT satzrest;
+              stelle INCR LENGTH merksatz;
+              merksatz := ""; editsatz := t
+         ELIF zeichen ist kein esc kommando                          (*wk*)
+                       AND
+              kommando auf taste (zeichen) <> ""
+         THEN editget kommando ausfuehren
+         FI ;
+         output mode := out feld
+    FI
+  PER .
+ 
+zeichen ist kein esc kommando :                                      (*wk*)
+  pos (hop + left + right, zeichen) = 0 .
+
+zeile verlassen :
+  IF   marke > 0 OR verschoben <> 0
+  THEN stelle DECR verschoben; verschoben := 0; feldout (editsatz, 0)
+  ELSE cursor (rand + 1 + min (LENGTH editsatz, editlaenge), zeile)
+  FI .
+ 
+zeichen ist separator : pos (separator, zeichen) > 0 .
+ 
+auf exit pruefen :
+  IF   pos (res, zeichen) > 0
+  THEN exit char := esc + zeichen; LEAVE feld editieren
+  FI .
+ 
+editget kommando ausfuehren :
+  editget zustaende sichern ;
+  do (kommando auf taste (zeichen)) ;
+  alte editget zustaende wieder herstellen ;
+  IF stelle < marke THEN stelle := marke FI;
+  konstanten neu berechnen .
+
+editget zustaende sichern :                                          (*wk*)
+  BOOL VAR alter editget modus := editget modus;
+  FELDSTATUS VAR feldstatus vor do kommando := feldstatus ;
+  INT VAR zeile vor do kommando := zeile ;
+  TEXT VAR separator vor do kommando := separator ;
+  BOOL VAR separator eingestellt vor do kommando := separator eingestellt ;
+  editget modus := TRUE ;
+  alter editsatz := editsatz .
+
+alte editget zustaende wieder herstellen :
+  editget modus := alter editget modus ;
+  editsatz := alter editsatz;
+  feldstatus := feldstatus vor do kommando ;
+  zeile := zeile vor do kommando ;
+  separator := separator vor do kommando ;
+  separator eingestellt := separator eingestellt vor do kommando .
+
+END PROC editget;
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, TEXT VAR exit char) :
+  editget (editsatz, editlimit, x size - x cursor, "", "", exit char)
+END PROC editget;                                       (* 05.07.84 -bk- *)
+ 
+PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, TEXT VAR exit char) :
+  editget (editsatz, max text length, x size - x cursor, sep, res, exit char)
+END PROC editget;                                       (* 05.07.84 -bk- *)
+ 
+PROC editget (TEXT VAR editsatz) :
+  TEXT VAR exit char;                                   (* 05.07.84 -bk- *)
+  editget (editsatz, max text length, x size - x cursor, "", "", exit char)
+END PROC editget;
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge) :
+  TEXT VAR exit char;
+  editget (editsatz, editlimit, editlaenge, "", "", exit char)
+ENDPROC editget;
+
+(*******************************  feldeditor  ******************************)
+
+TEXT VAR reservierte feldeditor tasten ;                             (*jl*)
+
+PROC feldeditor (TEXT VAR satz, TEXT CONST res) :
+  enable stop;
+  reservierte feldeditor tasten := ""1""2""8"" ;
+  reservierte feldeditor tasten CAT res;
+  absatzmarke steht := (satz SUB LENGTH satz) = blank;
+  alte stelle merken;
+  cursor diff bestimmen und ggf ausgleichen;
+  feld editieren;
+  absatzmarke updaten .
+ 
+alte stelle merken : alte stelle := stelle .
+ 
+cursor diff bestimmen und ggf ausgleichen :
+  IF   cursor diff
+  THEN stelle INCR 1; cursor diff := FALSE
+  FI ;
+  IF   stelle auf zweitem halbzeichen
+  THEN stelle DECR 1; cursor diff := TRUE
+  FI .
+
+feld editieren :
+  REP
+    feld optisch aufbereiten;
+    kommando annehmen und ausfuehren
+  PER .
+ 
+absatzmarke updaten :
+  IF   absatzmarke soll stehen
+  THEN IF NOT absatzmarke steht THEN absatzmarke schreiben (TRUE) FI
+  ELSE IF     absatzmarke steht THEN absatzmarke schreiben (FALSE) FI
+  FI .
+ 
+absatzmarke soll stehen : (satz SUB LENGTH satz) = blank .
+ 
+feld optisch aufbereiten :
+  stelle korrigieren;
+  verschieben wenn erforderlich;
+  randausgleich fuer doppelzeichen;
+  output mode behandeln;
+  ausgabe verhindern .
+ 
+randausgleich fuer doppelzeichen :
+  IF   stelle = max schreibpos CAND stelle auf erstem halbzeichen 
+  THEN verschiebe (1)
+  FI .
+
+stelle korrigieren :
+  IF stelle auf zweitem halbzeichen THEN stelle DECR 1 FI .
+
+stelle auf erstem halbzeichen  : within kanji (satz, stelle + 1) .
+
+stelle auf zweitem halbzeichen : within kanji (satz, stelle) .
+
+output mode behandeln :
+  SELECT output mode OF
+    CASE no output      : im markiermode markierung anpassen
+    CASE out zeichen    : zeichen ausgeben; LEAVE output mode behandeln
+    CASE out feldrest   : feldrest neu schreiben
+    CASE out feld       : feldout (satz, stelle)
+    CASE clear feldrest : feldrest loeschen
+  END SELECT;
+  schreibmarke positionieren (stelle) .
+ 
+ausgabe verhindern : output mode := no output .
+ 
+im markiermode markierung anpassen :
+  IF markiert THEN markierung anpassen FI .
+
+markierung anpassen :
+  IF   stelle > alte stelle
+  THEN markierung verlaengern
+  ELIF stelle < alte stelle
+  THEN markierung verkuerzen
+  FI .
+ 
+markierung verlaengern :
+  invers out (satz, alte stelle, stelle, "", end mark) .
+ 
+markierung verkuerzen :
+  invers out (satz, stelle, alte stelle, end mark, "") .
+ 
+zeichen ausgeben :
+  IF   NOT markiert
+  THEN out (zeichen)
+  ELIF mark refresh line mode
+  THEN feldout (satz, stelle); schreibmarke positionieren (stelle)
+  ELSE out (begin mark); markleft; out (zeichen); out (end mark); markleft
+  FI .
+ 
+markleft : 
+  marklength TIMESOUT left .
+ 
+feldrest neu schreiben :
+  IF   NOT markiert
+  THEN feldrest unmarkiert neu schreiben
+  ELSE feldrest markiert neu schreiben
+  FI ; 
+  WHILE postblanks > 0 CAND x cursor <= rand + laenge REP
+    out (blank); postblanks DECR 1
+  PER ; postblanks := 0 .
+ 
+feldrest unmarkiert neu schreiben :
+  schreibmarke positionieren (alte stelle);
+  out subtext mit randbehandlung (satz, alte stelle, stelle am ende) .
+ 
+feldrest markiert neu schreiben :
+  markierung verlaengern; out subtext mit randbehandlung
+                          (satz, stelle, stelle am ende - 2 * marklength) .
+ 
+kommando annehmen und ausfuehren :
+  kommando annehmen; kommando ausfuehren .
+ 
+kommando annehmen :
+  getchar (zeichen); kommando zurueckweisen falls noetig .
+
+kommando zurueckweisen falls noetig :
+  IF   NOT write access CAND zeichen ist druckbar
+  THEN benutzer warnen; kommando ignorieren
+  FI .
+
+benutzer warnen : out (piep) .
+
+kommando ignorieren :
+  zeichen := ""; LEAVE kommando annehmen und ausfuehren . 
+
+kommando ausfuehren :
+  neue satzlaenge bestimmen;
+  alte stelle merken;
+  IF   zeichen ist separator
+  THEN feldeditor verlassen
+  ELIF zeichen ist druckbar
+  THEN fortschreiben
+  ELSE funktionstasten behandeln
+  FI .
+ 
+neue satzlaenge bestimmen : INT VAR satzlaenge := LENGTH satz .
+
+feldeditor verlassen :
+  IF NOT absatzmarke steht THEN blanks abschneiden FI;               (*sh*)
+  push (zeichen); LEAVE feld editieren .
+
+blanks abschneiden :
+  INT VAR letzte non blank pos := satzlaenge;
+  WHILE letzte non blank pos > 0 CAND (satz SUB letzte non blank pos) = blank REP 
+    letzte non blank pos DECR 1
+  PER; satz := subtext (satz, 1, letzte non blank pos) .
+
+zeichen ist druckbar : zeichen >= blank .
+ 
+zeichen ist separator :
+  separator eingestellt CAND pos (separator, zeichen) > 0 .
+ 
+fortschreiben :
+  zeichen in satz eintragen;
+  IF is kanji esc (zeichen) THEN kanji zeichen schreiben FI;
+  bei erreichen von limit ueberlauf behandeln .
+ 
+zeichen in satz eintragen :
+  IF   hinter dem satz
+  THEN satz mit leerzeichen auffuellen und zeichen anfuegen
+  ELIF einfuegen
+  THEN zeichen vor aktueller position einfuegen
+  ELSE altes zeichen ersetzen
+  FI .
+ 
+hinter dem satz : stelle > satzlaenge .
+ 
+satz mit leerzeichen auffuellen und zeichen anfuegen :
+  satz AUFFUELLENMIT blank;
+  zeichen anfuegen;
+  output mode := out zeichen .
+ 
+zeichen anfuegen   : satz CAT zeichen; neue satzlaenge bestimmen .
+zeichen ignorieren : benutzer warnen; LEAVE kommando ausfuehren .
+ 
+zeichen vor aktueller position einfuegen :
+  insert char (satz, zeichen, stelle);
+  neue satzlaenge bestimmen;
+  output mode := out feldrest .
+ 
+altes zeichen ersetzen :
+  replace (satz, stelle, zeichen);
+  IF   stelle auf erstem halbzeichen
+  THEN output mode := out feldrest; replace (satz, stelle + 1, blank)
+  ELSE output mode := out zeichen 
+  FI .
+
+kanji zeichen schreiben :
+  alte stelle merken;
+  stelle INCR 1; getchar (zeichen);
+  IF   zeichen < ""64"" THEN zeichen := ""64"" FI;
+  IF   hinter dem satz
+  THEN zeichen anfuegen
+  ELIF einfuegen
+  THEN zeichen vor aktueller position einfuegen
+  ELSE replace (satz, stelle, zeichen)
+  FI ;
+  output mode := out feldrest .
+
+bei erreichen von limit ueberlauf behandeln :                        (*sh*)
+  IF   satzlaenge kritisch
+  THEN in naechste zeile falls moeglich
+  ELSE stelle INCR 1
+  FI .
+
+satzlaenge kritisch :
+  IF   stelle >= satzlaenge
+  THEN satzlaenge = limit
+  ELSE satzlaenge = limit + 1
+  FI .
+
+in naechste zeile falls moeglich :
+  IF   fliesstext AND umbruch moeglich OR NOT fliesstext AND stelle >= satzlaenge
+  THEN in naechste zeile
+  ELSE stelle INCR 1
+  FI .
+
+umbruch moeglich :
+  INT CONST st := stelle; stelle := limit;
+  INT CONST ltzt wortanf := letzter wortanfang (satz);
+  stelle := st; einrueckposition (satz) < ltzt wortanf .
+
+in naechste zeile :
+  IF   fliesstext 
+  THEN ueberlauf und oder umbruch 
+  ELSE ueberlauf ohne umbruch 
+  FI . 
+ 
+ueberlauf und oder umbruch : 
+  INT VAR umbruchpos := 1; 
+  umbruchposition bestimmen; 
+  loeschposition bestimmen; 
+  IF   stelle = satzlaenge 
+  THEN ueberlauf mit oder ohne umbruch
+  ELSE umbruch mit oder ohne ueberlauf
+  FI . 
+ 
+umbruchposition bestimmen : 
+  umbruchstelle := stelle; 
+  stelle := satzlaenge; 
+  umbruchpos := max (umbruchpos, letzter wortanfang (satz)); 
+  stelle := umbruchstelle . 
+ 
+loeschposition bestimmen : 
+  INT VAR loeschpos := umbruchpos;
+  WHILE davor noch blank REP loeschpos DECR 1 PER . 
+ 
+davor noch blank : 
+  loeschpos > ganz links CAND (satz SUB (loeschpos - 1)) = blank . 
+ 
+ganz links : max (1, marke) .
+ 
+ueberlauf mit oder ohne umbruch :
+  IF   zeichen = blank OR loeschpos = ganz links 
+  THEN stelle := 1; ueberlauf ohne umbruch 
+  ELSE ueberlauf mit umbruch
+  FI .
+
+ueberlauf ohne umbruch : push (cr) .
+
+ueberlauf mit umbruch :
+  ausgabe verhindern;
+  umbruchkommando aufbereiten; 
+  auf loeschposition positionieren . 
+ 
+umbruchkommando aufbereiten : 
+  zeichen := hop + rubout + inscr;
+  satzrest := subtext (satz, umbruchpos);
+  zeichen CAT satzrest;
+  IF   stelle ist im umgebrochenen teil
+  THEN insert char (zeichen, backcr, max (stelle - umbruchpos + 1, 0) + 4); 
+       zeichen CAT backcr
+  FI ;
+  push (zeichen) .
+ 
+stelle ist im umgebrochenen teil : stelle >= loeschpos . 
+ 
+auf loeschposition positionieren : stelle := loeschpos .
+ 
+umbruch mit oder ohne ueberlauf :
+  umbruchposition anpassen; 
+  IF   stelle ist im umgebrochenen teil 
+  THEN umbruch mit ueberlauf 
+  ELSE umbruch ohne ueberlauf 
+  FI . 
+ 
+umbruchposition anpassen : 
+  IF   zeichen = blank 
+  THEN umbruchpos := stelle + 1; 
+       umbruchposition bestimmen; 
+       neue loeschposition bestimmen 
+  FI . 
+ 
+neue loeschposition bestimmen : 
+  loeschpos := umbruchpos; 
+  WHILE davor noch blank AND stelle noch nicht erreicht REP loeschpos DECR 1 PER . 
+ 
+stelle noch nicht erreicht : loeschpos > stelle + 1 .
+
+umbruch mit ueberlauf : ueberlauf mit umbruch . 
+ 
+umbruch ohne ueberlauf : 
+  zeichen := inscr; 
+  satzrest := subtext (satz, umbruchpos); 
+  zeichen CAT satzrest;
+  zeichen CAT up char + backcr; 
+  umbruchstelle INCR 1; umbruch verschoben := verschoben;
+  satz := subtext (satz, 1, loeschpos - 1); 
+  schreibmarke positionieren (loeschpos); feldrest loeschen; 
+  output mode := out feldrest;
+  push (zeichen) . 
+ 
+funktionstasten behandeln :
+  SELECT pos (kommandos, zeichen) OF
+    CASE c hop     : hop kommandos behandeln
+    CASE c esc     : esc kommandos behandeln
+    CASE c right   : nach rechts oder ueberlauf
+    CASE c left    : wenn moeglich ein schritt nach links
+    CASE c tab     : zur naechsten tabulator position
+    CASE c dezimal : dezimalen schreiben
+    CASE c rubin   : einfuegen umschalten
+    CASE c rubout  : ein zeichen loeschen
+    CASE c abscr, c inscr, c down : feldeditor verlassen
+    CASE c up      : eine zeile nach oben                            (*sh*)
+    CASE c cr      : ggf absatz erzeugen 
+    CASE c mark    : markieren umschalten
+    CASE c backcr  : zurueck zur umbruchstelle
+    OTHERWISE      : sondertaste behandeln
+  END SELECT .
+ 
+kommandos :
+  LET c hop     =  1,                 c right   =  2,
+      c up      =  3,                 c left    =  4,
+      c tab     =  5,                 c down    =  6,
+      c rubin   =  7,                 c rubout  =  8,
+      c cr      =  9,                 c mark    = 10,
+      c abscr   = 11,                 c inscr   = 12,
+      c dezimal = 13,                 c esc     = 14, 
+      c backcr  = 15; 
+
+  ""1""2""3""8""9""10""11""12""13""16""17""18""19""27""20"" .
+ 
+dezimalen schreiben : IF write access THEN dezimaleditor (satz) FI .
+
+zurueck zur umbruchstelle: 
+  IF   umbruch stelle > 0 THEN stelle := umbruch stelle FI;
+  IF   verschoben <> umbruch verschoben 
+  THEN verschoben := umbruch verschoben; output mode := out feld 
+  FI . 
+ 
+hop kommandos behandeln :
+  TEXT VAR zweites zeichen; getchar (zweites zeichen);
+  zeichen CAT zweites zeichen;
+  SELECT pos (hop kommandos, zweites zeichen) OF
+    CASE h hop    : nach links oben
+    CASE h right  : nach rechts blaettern
+    CASE h left   : nach links blaettern
+    CASE h tab    : tab position definieren oder loeschen
+    CASE h rubin  : zeile splitten
+    CASE h rubout : loeschen oder rekombinieren
+    CASE h cr, h up, h down : feldeditor verlassen
+    OTHERWISE     : zeichen ignorieren
+  END SELECT .
+ 
+hop kommandos :
+  LET h hop    = 1,                   h right  = 2,
+      h up     = 3,                   h left   = 4,
+      h tab    = 5,                   h down   = 6,
+      h rubin  = 7,                   h rubout = 8,
+      h cr     = 9;
+ 
+  ""1""2""3""8""9""10""11""12""13"" .
+ 
+nach links oben :
+  stelle := max (marke, anfang) + verschoben; feldeditor verlassen .
+ 
+nach rechts blaettern :
+  INT CONST rechter rand := stelle am ende - markierausgleich;
+  IF   stelle ist am rechten rand
+  THEN stelle INCR laenge - 2 * markierausgleich + ausgleich fuer doppelzeichen
+  ELSE stelle := rechter rand
+  FI ;
+  IF satzlaenge <= limit THEN stelle := min (stelle, limit) FI;
+  alte einrueckposition mitziehen .
+ 
+stelle ist am rechten rand :
+  stelle auf erstem halbzeichen CAND stelle = rechter rand - 1
+                                COR  stelle = rechter rand .
+
+ausgleich fuer doppelzeichen : stelle - rechter rand .
+
+nach links blaettern :
+  INT CONST linker rand := stelle am anfang;
+  IF   stelle = linker rand
+  THEN stelle DECR laenge - 2 * markierausgleich
+  ELSE stelle := linker rand
+  FI ;
+  stelle := max (ganz links, stelle);
+  alte einrueckposition mitziehen .
+ 
+tab position definieren oder loeschen :
+  IF   stelle > LENGTH tabulator
+  THEN tabulator AUFFUELLENMIT right; tabulator CAT dach
+  ELSE replace (tabulator, stelle, neues tab zeichen)
+  FI ;
+  feldeditor verlassen .
+ 
+neues tab zeichen :
+  IF (tabulator SUB stelle) = right THEN dach ELSE right FI .
+ 
+zeile splitten :
+  IF write access THEN feldeditor verlassen ELSE zeichen ignorieren FI .
+ 
+loeschen oder rekombinieren :
+  IF   NOT write access
+  THEN zeichen ignorieren
+  ELIF hinter dem satz
+  THEN zeilen rekombinieren
+  ELIF auf erstem zeichen
+  THEN ganze zeile loeschen
+  ELSE zeilenrest loeschen
+  FI .
+ 
+zeilen rekombinieren : feldeditor verlassen .
+auf erstem zeichen   : stelle = 1 .
+ganze zeile loeschen : satz := ""; feldeditor verlassen .
+ 
+zeilenrest loeschen :
+  change (satz, stelle, satzlaenge, ""); 
+  output mode := clear feldrest .
+ 
+esc kommandos behandeln :
+  getchar (zweites zeichen); 
+  zeichen CAT zweites zeichen;
+  auf exit pruefen;
+  SELECT pos (esc kommandos, zweites zeichen) OF
+    CASE e hop   : lernmodus umschalten
+    CASE e right : zum naechsten wort
+    CASE e left  : zum vorigen wort
+    OTHERWISE    : belegte taste ausfuehren 
+  END SELECT .
+ 
+auf exit pruefen :
+  IF pos (res, zweites zeichen) > 0 THEN feldeditor verlassen FI .
+ 
+esc kommandos :
+  LET e hop      =  1,
+      e right    =  2,
+      e left     =  3;
+ 
+  ""1""2""8"" .
+ 
+lernmodus umschalten :
+  IF lernmodus THEN lernmodus ausschalten ELSE lernmodus einschalten FI;
+  feldeditor verlassen .
+ 
+lernmodus ausschalten :
+  lernmodus := FALSE;
+  belegbare taste erfragen;
+  audit := subtext (audit, 1, LENGTH audit - 2);
+  IF   taste = hop 
+  THEN (* lernsequenz nicht auf taste legen *)          (* 16.08.85 -ws- *)
+  ELSE lernsequenz auf taste legen (taste, audit)
+  FI ;
+  audit := "" .
+ 
+belegbare taste erfragen :
+  TEXT VAR taste; getchar (taste);
+  WHILE taste ist reserviert REP
+    benutzer warnen; getchar (taste)
+  PER .
+ 
+taste ist reserviert :                                  (* 16.08.85 -ws- *)
+  taste <> hop CAND pos (reservierte feldeditor tasten, taste) > 0 .
+ 
+lernmodus einschalten : audit := ""; lernmodus := TRUE .
+ 
+zum vorigen wort :
+  IF   stelle > 1
+  THEN stelle DECR 1; stelle := letzter wortanfang (satz);
+       alte einrueckposition mitziehen;
+       IF (satz SUB stelle) <> blank THEN LEAVE zum vorigen wort FI
+  FI ;
+  feldeditor verlassen .
+ 
+zum naechsten wort :
+  IF kein naechstes wort THEN feldeditor verlassen FI .
+ 
+kein naechstes wort :
+  BOOL VAR im alten wort := TRUE;
+  INT VAR i;
+  FOR i FROM stelle UPTO satzlaenge REP
+    IF   im alten wort
+    THEN im alten wort := (satz SUB i) <> blank
+    ELIF (satz SUB i) <> blank
+    THEN stelle := i; LEAVE kein naechstes wort WITH FALSE
+    FI
+  PER;
+  TRUE .
+ 
+belegte taste ausfuehren :
+  IF   ist kommando taste
+  THEN feldeditor verlassen
+  ELSE gelerntes ausfuehren
+  FI .
+ 
+ist kommando taste : taste enthaelt kommando (zweites zeichen) .
+ 
+gelerntes ausfuehren :
+  push (lernsequenz auf taste (zweites zeichen)) .                   (*sh*)
+ 
+nach rechts oder ueberlauf :
+  IF   fliesstext COR stelle < limit OR satzlaenge > limit 
+  THEN nach rechts
+  ELSE auf anfang der naechsten zeile
+  FI .
+ 
+nach rechts :
+  IF stelle auf erstem halbzeichen THEN stelle INCR 2 ELSE stelle INCR 1 FI;
+  alte einrueckposition mitziehen .
+
+auf anfang der naechsten zeile : push (abscr) .
+
+nach links : stelle DECR 1; alte einrueckposition mitziehen .
+
+alte einrueckposition mitziehen :
+  IF   satz ist leerzeile
+  THEN alte einrueckposition := stelle
+  ELSE alte einrueckposition := min (stelle, einrueckposition (satz))
+  FI .
+
+satz ist leerzeile :
+  satz = "" OR satz = blank . 
+
+wenn moeglich ein schritt nach links :
+  IF   stelle = ganz links
+  THEN zeichen ignorieren
+  ELSE nach links
+  FI .
+ 
+zur naechsten tabulator position :
+  bestimme naechste explizite tabulator position;
+  IF   tabulator gefunden
+  THEN explizit tabulieren
+  ELIF stelle <= satzlaenge
+  THEN implizit tabulieren
+  ELSE auf anfang der naechsten zeile
+  FI .
+ 
+bestimme naechste explizite tabulator position :
+  INT VAR tab position := pos (tabulator, dach, stelle + 1);
+  IF   tab position > limit AND satzlaenge <= limit
+  THEN tab position := 0
+  FI .
+ 
+tabulator gefunden : tab position <> 0 .
+ 
+explizit tabulieren : stelle := tab position; push (dezimal) .
+ 
+implizit tabulieren :
+  tab position := einrueckposition (satz);
+  IF   stelle <  tab position
+  THEN stelle := tab position
+  ELSE stelle := satzlaenge + 1
+  FI .
+ 
+einfuegen umschalten :
+  IF NOT write access THEN zeichen ignorieren FI;                    (*sh*)
+  einfuegen := NOT einfuegen;
+  IF einfuegen THEN einfuegen optisch anzeigen FI;
+  feldeditor verlassen .
+ 
+einfuegen optisch anzeigen :
+  IF   markiert
+  THEN out (begin mark); markleft; out (dach left); warten;
+       out (end mark); markleft
+  ELSE out (dach left); warten;
+       IF   stelle auf erstem halbzeichen
+       THEN out text (satz, stelle, stelle + 1)
+       ELSE out text (satz, stelle, stelle)
+       FI
+  FI .
+ 
+markiert  : marke > 0 .
+dach left : ""94""8"" .
+ 
+warten :
+  TEXT VAR t := incharety (2);
+  kommando CAT t; IF lernmodus THEN audit CAT t FI .
+ 
+ein zeichen loeschen :
+  IF   NOT write access THEN zeichen ignorieren FI;                  (*sh*)
+  IF   zeichen davor soll geloescht werden
+  THEN nach links oder ignorieren
+  FI ;
+  IF   NOT hinter dem satz THEN aktuelles zeichen loeschen FI .
+ 
+zeichen davor soll geloescht werden :
+  hinter dem satz COR markiert .
+ 
+nach links oder ignorieren :
+  IF   stelle > ganz links
+  THEN nach links                                                    (*sh*)
+  ELSE zeichen ignorieren
+  FI .
+ 
+aktuelles zeichen loeschen :
+  stelle korrigieren; alte stelle merken;
+  IF   stelle auf erstem halbzeichen
+  THEN delete char (satz, stelle);
+       postblanks INCR 1
+  FI ;
+  delete char (satz, stelle);
+  postblanks INCR 1;
+  neue satzlaenge bestimmen;
+  output mode := out feldrest .
+
+eine zeile nach oben :                                               (*sh*)
+  IF   NOT absatzmarke steht CAND NOT ist teil eines umbruchkommandos 
+  THEN blanks abschneiden
+  FI ;
+  push (zeichen); LEAVE feld editieren .
+
+ist teil eines umbruchkommandos : (kommando SUB kommandozeiger) = backcr .
+
+ggf absatz erzeugen :                                                (*sh*)
+  IF   write access
+  THEN IF   NOT absatzmarke steht THEN blanks abschneiden FI;
+       IF   stelle > LENGTH satz AND fliesstext AND NOT absatzmarke steht
+       THEN satz CAT blank
+       FI 
+  FI ; push (zeichen); LEAVE feld editieren .
+
+markieren umschalten :
+  IF   markiert
+  THEN marke := 0;      maxschreibpos INCR marklength; cpos DECR marklength
+  ELSE marke := stelle; maxschreibpos DECR marklength; cpos INCR marklength;
+       verschieben wenn erforderlich
+  FI ;
+  feldeditor verlassen .
+ 
+sondertaste behandeln : push (esc + zeichen) .
+END PROC feldeditor;
+ 
+PROC dezimaleditor (TEXT VAR satz) :
+  INT VAR dezimalanfang := stelle;
+  zeichen einlesen;
+  IF dezimalstartzeichen CAND ueberschreibbar THEN dezimalen schreiben FI;
+  push (zeichen) .
+ 
+zeichen einlesen    : TEXT VAR zeichen; getchar (zeichen) .
+dezimalzeichen      : pos (dezimalen, zeichen) > 0 AND nicht separator .
+dezimalstartzeichen : pos (startdezimalen, zeichen) > 0 AND nicht separator .
+dezimalen           : "0123456789" .
+startdezimalen      : "+-0123456789" .
+nicht separator     : pos (separator, zeichen) = 0 .
+ 
+ueberschreibbar :
+  dezimalanfang > LENGTH satz OR
+  pos (ueberschreibbare zeichen, satz SUB dezimalanfang) > 0 .
+ 
+ueberschreibbare zeichen : " ,.+-0123456789" . 
+ 
+dezimalen schreiben :
+  REP
+    dezimale in satz eintragen;
+    dezimalen zeigen;
+    zeichen einlesen;
+    dezimalanfang DECR 1
+  UNTIL dezimaleditor beendet PER;
+  stelle INCR 1 .
+ 
+dezimale in satz eintragen :
+  IF   dezimalanfang > LENGTH satz
+  THEN satz AUFFUELLENMIT blank; satz CAT zeichen
+  ELSE delete char (satz, dezimalanfang); insert char (satz, zeichen, stelle)
+  FI .
+ 
+dezimalen zeigen :
+  INT VAR min dezimalschreibpos := max (min schreibpos, dezimalanfang);
+  IF markiert THEN markiert zeigen ELSE unmarkiert zeigen FI;
+  schreibmarke positionieren (stelle) .
+ 
+markiert : marke > 0 .
+ 
+markiert zeigen :
+  invers out (satz, min dezimalschreibpos, stelle, "", end mark);
+  out (zeichen) .
+ 
+unmarkiert zeigen :
+  schreibmarke positionieren (min dezimalschreibpos);
+  out subtext (satz, min dezimalschreibpos, stelle) .
+ 
+dezimaleditor beendet :
+  NOT dezimalzeichen OR
+  dezimalanfang < max (min schreibpos, marke) OR
+  NOT ueberschreibbar .
+END PROC dezimaleditor;
+
+BOOL PROC is editget :
+  editget modus
+END PROC is editget ;
+
+PROC get editline (TEXT VAR editline, INT VAR editpos, editmarke) :
+  IF   editget modus
+  THEN editline := alter editsatz;
+       editpos := stelle
+  FI ;
+  editmarke := marke
+END PROC get editline;
+
+PROC put editline (TEXT CONST editline, INT CONST editpos, editmarke) :
+  IF   editget modus
+  THEN alter editsatz := editline;
+       stelle := max (editpos, 1);
+       marke := max (editmarke, 0)
+  FI 
+END PROC put editline;
+
+BOOL PROC within kanji (TEXT CONST satz, INT CONST stelle) :
+  count directly prefixing kanji esc bytes;
+  number of kanji esc bytes is odd .
+ 
+count directly prefixing kanji esc bytes :
+  INT VAR pos := stelle - 1, kanji esc bytes := 0; 
+  WHILE pos > 0 CAND is kanji esc (satz SUB pos) REP
+    kanji esc bytes INCR 1; pos DECR 1
+  PER .
+
+number of kanji esc bytes is odd :
+  (kanji esc bytes AND 1) <> 0 .
+END PROC within kanji;
+
+BOOL PROC is kanji esc (TEXT CONST char) :                           (*sh*)
+  two byte mode CAND
+  (char >= ""129"" AND char <= ""159"" OR char >= ""224"" AND char <= ""239"")
+END PROC is kanji esc;
+ 
+BOOL PROC two bytes : two byte mode END PROC two bytes; 
+
+PROC two bytes (BOOL CONST new mode) :
+  two byte mode := new mode
+END PROC two bytes;
+
+PROC outtext (TEXT CONST source, INT CONST from, to) :
+  out subtext mit randbehandlung (source, from, to);
+  INT VAR trailing;
+  IF   from <= LENGTH source
+  THEN trailing := to - LENGTH source
+  ELSE trailing := to - from + 1
+  FI ; trailing TIMESOUT blank
+END PROC outtext;
+
+PROC out subtext mit randbehandlung (TEXT CONST satz, INT CONST von, bis) :
+  IF   von > bis
+  THEN
+  ELIF bis >= LENGTH satz COR NOT within kanji (satz, bis + 1)
+  THEN out subtext mit anfangsbehandlung (satz, von, bis)
+  ELSE out subtext mit anfangsbehandlung (satz, von, bis - 1); out (blank)
+  FI
+END PROC out subtext mit randbehandlung;
+
+PROC out subtext mit anfangsbehandlung (TEXT CONST satz, INT CONST von, bis) :
+  IF   von > bis
+  THEN
+  ELIF von = 1 COR NOT within kanji (satz, von)
+  THEN out subtext (satz, von, bis)
+  ELSE out (blank); out subtext (satz, von + 1, bis)
+  FI
+END PROC out subtext mit anfangsbehandlung;
+
+PROC get cursor   :  get cursor (spalte, zeile)     END PROC get cursor;
+
+INT PROC x cursor :  get cursor; spalte             END PROC x cursor;
+ 
+BOOL PROC write permission :   write access   END PROC write permission; 
+ 
+PROC push (TEXT CONST ausfuehrkommando) :
+  IF   ausfuehrkommando = ""                                         (*sh*)
+  THEN
+  ELIF kommando = ""
+  THEN kommando := ausfuehrkommando
+  ELIF (kommando SUB kommando zeiger - 1) = ausfuehrkommando
+  THEN kommando zeiger DECR 1
+  ELIF replace moeglich 
+  THEN kommando zeiger DECR laenge des ausfuehrkommandos; 
+       replace (kommando, kommando zeiger, ausfuehrkommando) 
+  ELSE insert char (kommando, ausfuehrkommando, kommando zeiger)
+  FI . 
+ 
+replace moeglich : 
+  INT CONST laenge des ausfuehrkommandos := LENGTH ausfuehrkommando; 
+  kommando zeiger > laenge des ausfuehrkommandos . 
+END PROC push;
+ 
+PROC type (TEXT CONST ausfuehrkommando) :
+  kommando CAT ausfuehrkommando
+END PROC type;
+ 
+INT PROC stelle am anfang : anfang + verschoben END PROC stelle am anfang;
+ 
+INT PROC stelle am ende   : stelle am anfang+laenge-1 END PROC stelle am ende;
+ 
+INT PROC markierausgleich : SIGN marke * marklength END PROC markierausgleich;
+ 
+PROC verschieben wenn erforderlich :
+  IF   stelle > max schreibpos
+  THEN verschiebe (stelle - max schreibpos)
+  ELIF stelle < min schreibpos
+  THEN verschiebe (stelle - min schreibpos)
+  FI
+END PROC verschieben wenn erforderlich;
+ 
+PROC verschiebe (INT CONST i) :
+  verschoben     INCR i;
+  min schreibpos INCR i;
+  max schreibpos INCR i;
+  cpos           DECR i;
+  output mode := out feld; 
+  schreibmarke positionieren (stelle)                   (* 11.05.85 -ws- *)
+END PROC verschiebe;
+ 
+PROC konstanten neu berechnen :
+  min schreibpos := anfang + verschoben;
+  IF   min schreibpos < 0                               (* 17.05.85 -ws- *)
+  THEN min schreibpos DECR verschoben; verschoben := 0 
+  FI ; 
+  max schreibpos := min schreibpos + laenge - 1 - markierausgleich;
+  cpos := rand + laenge - max schreibpos
+END PROC konstanten neu berechnen;
+ 
+PROC schreibmarke positionieren (INT CONST sstelle) :
+  cursor (cpos + sstelle, zeile)
+END PROC schreibmarke positionieren;
+ 
+PROC simple feldout (TEXT CONST satz, INT CONST dummy) :
+  (* PRECONDITION : NOT markiert AND verschoben = 0 *)
+  (*                AND feldrest schon geloescht    *)
+  schreibmarke an feldanfang positionieren;
+  out subtext mit randbehandlung (satz, anfang, anfang + laenge - 1);
+  IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI .
+ 
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+END PROC simple feldout;
+ 
+PROC feldout (TEXT CONST satz, INT CONST sstelle) :
+  schreibmarke an feldanfang positionieren;
+  feld ausgeben;
+  feldrest loeschen;
+  IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI . 
+
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+ 
+feld ausgeben :
+  INT VAR von := anfang + verschoben, bis := von + laenge - 1;
+  IF   nicht markiert
+  THEN unmarkiert ausgeben
+  ELIF markiertes nicht sichtbar
+  THEN unmarkiert ausgeben
+  ELSE markiert ausgeben
+  FI .
+ 
+nicht markiert : marke <= 0 .
+
+markiertes nicht sichtbar :
+  bis DECR marklength * (1 + SIGN sstelle); marke > bis + 1 .
+ 
+unmarkiert ausgeben :
+  out subtext mit randbehandlung (satz, von, bis) . 
+ 
+markiert ausgeben :
+  INT VAR smarke := max (von, marke);
+  out text (satz, von, smarke - 1); out (begin mark);
+  verschiedene feldout modes behandeln .
+ 
+verschiedene feldout modes behandeln :
+  IF   sstelle = 0
+  THEN out subtext mit randbehandlung (satz, smarke, bis); out (end mark)
+  ELSE out text (satz, smarke, zeilenrand); out (end mark);          (*sh*)
+       out subtext mit randbehandlung (satz, sstelle, bis)
+  FI .
+ 
+zeilenrand : min (bis, sstelle - 1) . 
+END PROC feldout;
+ 
+PROC absatzmarke schreiben (BOOL CONST schreiben) :
+  IF   fliesstext AND nicht markiert
+  THEN cursor (rand + 1 + laenge, zeile);
+       out (absatzmarke) ;
+       absatzmarke steht := TRUE
+  FI .
+ 
+nicht markiert : marke <= 0 .
+ 
+absatzmarke :
+  IF   NOT schreiben
+  THEN "  "
+  ELIF marklength > 0
+  THEN ""15""14""
+  ELSE ""15" "14" "
+  FI .
+END PROC absatzmarke schreiben;
+ 
+PROC invers out (TEXT CONST satz, INT CONST von, bis, TEXT CONST pre, post) :
+  IF   mark refresh line mode
+  THEN feldout (satz, stelle)
+  ELSE schreibmarke positionieren (von);
+       out (begin mark); markleft; out (pre);
+       out text (satz, von, bis - 1); out (post)
+  FI .
+
+markleft : 
+  marklength TIMESOUT left .
+ 
+END PROC invers out;
+ 
+PROC feldrest loeschen :
+  IF   rand + laenge < maxbreite COR invertierte darstellung
+  THEN INT VAR x; get cursor (x, zeile);
+       (rand + laenge - x + 1 + absatz ausgleich) TIMESOUT blank;    (*sh*)
+       cursor (x, zeile)
+  ELSE out (clear eol); absatzmarke steht := FALSE
+  FI 
+END PROC feldrest loeschen;
+ 
+OP AUFFUELLENMIT (TEXT VAR satz, TEXT CONST fuellzeichen) :
+  INT VAR i;
+  FOR i FROM stelle - LENGTH satz DOWNTO 2 REP
+    satz CAT fuellzeichen
+  PER 
+END OP AUFFUELLENMIT;
+ 
+INT PROC einrueckposition (TEXT CONST satz) :                        (*sh*)
+  IF   fliesstext AND satz = blank
+  THEN anfang
+  ELSE max (pos (satz, ""33"", ""254"", 1), 1)
+  FI
+END PROC einrueckposition;
+ 
+INT PROC letzter wortanfang (TEXT CONST satz) :                      (*sh*)
+  INT CONST ganz links := max (1, marke);
+  BOOL VAR noch nicht im neuen wort := TRUE;
+  INT  VAR i;
+  FOR i FROM stelle DOWNTO ganz links REP
+      IF   noch nicht im neuen wort
+      THEN noch nicht im neuen wort := char = blank
+      ELIF is kanji esc (char)
+      THEN LEAVE letzter wortanfang WITH i 
+      ELIF nicht mehr im neuen wort
+      THEN LEAVE letzter wortanfang WITH i + 1
+      FI
+  PER ;
+  ganz links .
+
+char : satz SUB i .
+
+nicht mehr im neuen wort : char = blank COR within kanji (satz, i) .
+END PROC letzter wortanfang;
+
+PROC getchar (TEXT VAR zeichen) :
+  IF   kommando = ""
+  THEN inchar (zeichen); IF lernmodus THEN audit CAT zeichen FI
+  ELSE zeichen := kommando SUB kommando zeiger;
+       kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ;
+       IF   LENGTH kommando - kommando zeiger < 3
+       THEN kommando CAT inchety
+       FI
+  FI .
+END PROC getchar;
+
+TEXT PROC inchety : 
+  IF   lernmodus
+  THEN TEXT VAR t := incharety; audit CAT t; t
+  ELSE incharety
+  FI
+END PROC inchety;
+ 
+BOOL PROC is incharety (TEXT CONST muster) :
+  IF   kommando = ""
+  THEN TEXT CONST t := inchety;
+       IF t = muster THEN TRUE ELSE kommando := t; FALSE FI
+  ELIF (kommando SUB kommando zeiger) = muster
+  THEN kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ;
+       TRUE
+  ELSE FALSE
+  FI
+END PROC is incharety;
+ 
+TEXT PROC getcharety :
+  IF   kommando = ""
+  THEN inchety
+  ELSE TEXT CONST t := kommando SUB kommando zeiger;
+       kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ; t
+  FI
+END PROC getcharety;
+ 
+PROC get editcursor (INT VAR x, y) :                                 (*sh*)
+  IF actual editor > 0 THEN aktualisiere bildparameter FI;
+  x := rand - (anfang + verschoben - 1 - markierausgleich) + stelle;
+  y := zeile .
+
+  aktualisiere bildparameter :
+    INT VAR old x, old y; get cursor (old x, old y);
+    dateizustand holen; bildausgabe steuern; satznr zeigen;
+    fenster zeigen; zeile := bildrand + zeilennr; cursor (old x, old y) .
+END PROC get editcursor;
+
+(************************* Zugriff auf Feldstatus *************************).
+
+stelle       : feldstatus.stelle .
+alte stelle  : feldstatus.alte stelle .
+rand         : feldstatus.rand .
+limit        : feldstatus.limit .
+anfang       : feldstatus.anfang .
+marke        : feldstatus.marke .
+laenge       : feldstatus.laenge .
+verschoben   : feldstatus.verschoben .
+einfuegen    : feldstatus.einfuegen .
+fliesstext   : feldstatus.fliesstext .
+write access : feldstatus.write access .
+tabulator    : feldstatus.tabulator .
+
+(***************************************************************************)
+
+LET undefinierter bereich =  0,     nix            =  1,
+    bildzeile             =  2,     akt satznr     =  2,
+    abschnitt             =  3,     ueberschrift   =  3,
+    bild                  =  4,     fehlermeldung  =  4;
+ 
+LET BILDSTATUS = STRUCT (INT feldlaenge, kurze feldlaenge,
+                             bildrand, bildlaenge, kurze bildlaenge,
+                             ueberschriftbereich, bildbereich,
+                             erster neusatz, letzter neusatz,
+                             old zeilennr, old lineno, old mark lineno,
+                        BOOL zeileneinfuegen, old line update,
+                        TEXT satznr pre, ueberschrift pre,
+                             ueberschrift text, ueberschrift post, old satz,
+                        FRANGE old range,
+                        FILE file),
+    EDITSTATUS = STRUCT (FELDSTATUS feldstatus, BILDSTATUS bildstatus),
+    max editor = 10,
+    EDITSTACK  = ROW max editor EDITSTATUS;
+ 
+BILDSTATUS VAR bildstatus ;
+EDITSTACK VAR editstack;
+ 
+ROW max editor INT VAR einrueckstack;
+
+BOOL VAR markiert;
+TEXT VAR filename, tab, bildsatz, bildzeichen, fehlertext,
+         akt bildsatz ;
+INT  VAR zeilennr, satznr, bildanfang, bildmarke, feldmarke,
+         actual editor := 0, max used editor := 0,
+         letzer editor auf dieser datei,
+         alte einrueckposition := 1;
+
+INT PROC aktueller editor :  actual editor  END PROC aktueller editor;
+ 
+INT PROC groesster editor : max used editor END PROC groesster editor;
+
+(******************************  bildeditor  *******************************)
+
+PROC bildeditor (TEXT CONST res, PROC (TEXT CONST) kommando interpreter) :
+  evtl fehler behandeln;
+  enable stop;
+  TEXT VAR reservierte tasten := ""11""12""27"bf" ;
+  reservierte tasten CAT res ;
+  INT CONST my highest editor := max used editor;
+  laenge := feldlaenge;
+  konstanten neu berechnen;
+  REP
+    markierung justieren;
+    altes feld nachbereiten;
+    feldlaenge einstellen;
+    ueberschrift zeigen;
+    fenster zeigen ;
+    zeile bereitstellen;
+    zeile editieren;
+    kommando ausfuehren
+  PER .
+ 
+evtl fehler behandeln :
+  IF   is error
+  THEN fehlertext := errormessage;
+       IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+       clear error
+  ELSE fehlertext := ""
+  FI .
+ 
+markierung justieren :
+  IF   bildmarke > 0
+  THEN IF   satznr <= bildmarke
+       THEN bildmarke := satznr;
+            stelle := max (stelle, feldmarke);
+            marke := feldmarke
+       ELSE marke := 1
+       FI
+  FI . 
+ 
+zeile bereitstellen : IF hinter letztem satz THEN insert record (file) FI .
+hinter letztem satz : lineno (file) > lines (file) .
+ 
+altes feld nachbereiten : 
+  IF   old line update AND lineno (file) <> old lineno 
+  THEN IF   verschoben <> 0 
+       THEN verschoben := 0; konstanten neu berechnen;
+       FI ;
+       INT CONST alte zeilennr := old lineno - bildanfang + 1;
+       IF   alte zeilennr > 0 AND alte zeilennr <= aktuelle bildlaenge 
+       THEN INT CONST m := marke;
+            IF   lineno (file) < old lineno
+            THEN marke := 0
+            ELIF old lineno = bildmarke
+            THEN marke := min (feldmarke, LENGTH old satz + 1)
+            ELSE marke := min (marke,     LENGTH old satz + 1)
+            FI ;
+            zeile := bildrand + alte zeilennr;
+            feldout (old satz, 0); marke := m 
+       FI
+  FI ;
+  old line update := FALSE; old satz := "" .
+
+feldlaenge einstellen : 
+  INT CONST alte laenge := laenge;
+  IF   zeilennr > kurze bildlaenge
+  THEN laenge := kurze feldlaenge
+  ELSE laenge := feldlaenge
+  FI ; 
+  IF   laenge <> alte laenge
+  THEN konstanten neu berechnen
+  FI .
+ 
+zeile editieren :
+  zeile := bildrand + zeilennr;
+  exec (PROC (TEXT VAR, TEXT CONST) feldeditor, file, reservierte tasten);
+  old lineno := satznr;
+  IF   markiert oder verschoben
+  THEN old line update := TRUE; read record (file, old satz)
+  FI .
+ 
+markiert oder verschoben : markiert COR verschoben <> 0 .
+ 
+kommando ausfuehren : 
+  getchar (bildzeichen);
+  SELECT pos (kommandos, bildzeichen) OF
+    CASE x hop   : hop kommando verarbeiten
+    CASE x esc   : esc kommando verarbeiten
+    CASE x up    : zum vorigen satz
+    CASE x down  : zum folgenden satz
+    CASE x rubin : zeicheneinfuegen umschalten
+    CASE x mark  : markierung umschalten
+    CASE x cr    : eingerueckt mit cr                  (*  08.06.85 -ws- *) 
+    CASE x inscr : eingerueckt zum folgenden satz
+    CASE x abscr : zum anfang des folgenden satzes
+  END SELECT .
+ 
+kommandos :
+  LET x hop   = 1,                    x up    = 2,
+      x down  = 3,                    x rubin = 4,
+      x cr    = 5,                    x mark  = 6,
+      x abscr = 7,                    x inscr = 8,
+      x esc   = 9;
+ 
+  ""1""3""10""11""13""16""17""18""27"" .
+ 
+zeicheneinfuegen umschalten :
+  rubin segment in ueberschrift eintragen;
+  neu (ueberschrift, nix) .
+ 
+rubin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 9, rubin segment) .
+ 
+rubin segment :
+  IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+hop kommando verarbeiten :
+  getchar (bildzeichen);
+  read record (file, bildsatz);
+  SELECT pos (hop kommandos, bildzeichen) OF
+    CASE y hop    : nach oben
+    CASE y cr     : neue seite
+    CASE y up     : zurueckblaettern
+    CASE y down   : weiterblaettern
+    CASE y tab    : put tabs (file, tabulator); neu (ueberschrift, nix)
+    CASE y rubout : zeile loeschen
+    CASE y rubin  : zeileneinfuegen umschalten
+  END SELECT .
+ 
+hop kommandos :
+  LET y hop    = 1,                   y up     = 2,
+      y tab    = 3,                   y down   = 4,
+      y rubin  = 5,                   y rubout = 6,
+      y cr     = 7;
+ 
+  ""1""3""9""10""11""12""13"" .
+ 
+zeileneinfuegen umschalten :
+  zeileneinfuegen := NOT zeileneinfuegen;
+  IF   zeileneinfuegen
+  THEN zeile aufspalten; logisches eof setzen
+  ELSE leere zeile am ende loeschen; logisches eof loeschen
+  FI ; restbild zeigen .
+ 
+zeile aufspalten :
+  IF   stelle <= LENGTH bildsatz OR stelle = 1
+  THEN loesche ggf trennende blanks und spalte zeile
+  FI .
+ 
+loesche ggf trennende blanks und spalte zeile:          (* 26.06.84 -bk- *) 
+  INT VAR first non blank pos := stelle; 
+  WHILE first non blank pos <= length (bildsatz) CAND 
+        (bildsatz SUB first non blank pos) = blank REP 
+    first non blank pos INCR 1 
+  PER ; 
+  split line and indentation;                                        (*sh*)
+  first non blank pos := stelle - 1;
+  WHILE first non blank pos >= 1 CAND
+        (bildsatz SUB first non blank pos) = blank REP 
+    first non blank pos DECR 1 
+  PER;
+  bildsatz := subtext (bildsatz, 1, first non blank pos); 
+  write record (file, bildsatz) .
+ 
+split line and indentation : 
+  split line (file, first non blank pos, TRUE) .
+
+logisches eof setzen :
+  down (file); col (file, 1);
+  set range (file, 1, 1, old range); up (file) .
+ 
+leere zeile am ende loeschen :
+  to line (file, lines (file));
+  IF len (file) = 0 THEN delete record (file) FI;
+  to line (file, satznr) .
+ 
+logisches eof loeschen :
+  col (file, stelle); set range (file, old range) .
+ 
+restbild zeigen :
+  erster neusatz := satznr;
+  letzter neusatz := bildanfang + bildlaenge - 1;
+  rest segment in ueberschrift eintragen;
+  neu (ueberschrift, abschnitt) .
+ 
+rest segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 25, rest segment) .
+ 
+rest segment :
+  IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+esc kommando verarbeiten :
+  getchar (bildzeichen);
+  eventuell zeichen zurueckweisen;                      (* 04.05.85 -ws- *)
+  IF   taste ist reserviert
+  THEN belegte taste ausfuehren
+  ELSE fest vordefinierte esc funktion
+  FI ; ende nach quit .
+ 
+eventuell zeichen zurueckweisen :                       (* 04.05.85 -ws- *)
+  IF   NOT write access CAND NOT erlaubte taste
+  THEN benutzer warnen; LEAVE kommando ausfuehren 
+  FI .
+
+erlaubte taste     : pos (zulaessige zeichen, bildzeichen) > 0 . 
+zulaessige zeichen : res + ""1""2""8""27"bfq" . 
+benutzer warnen    : out (piep) . 
+
+ende nach quit :
+  IF max used editor < my highest editor THEN LEAVE bildeditor FI .
+ 
+taste ist reserviert : pos (res, bildzeichen) > 0 .
+ 
+fest vordefinierte esc funktion :
+  read record (file, bildsatz); 
+  SELECT pos (esc kommandos, bildzeichen) OF
+    CASE z hop    : lernmodus umschalten
+    CASE z esc    : kommandodialog versuchen
+    CASE z left   : zum vorigen wort
+    CASE z right  : zum naechsten wort
+    CASE z b      : bild an aktuelle zeile angleichen
+    CASE z f      : belegte taste ausfuehren
+    CASE z rubout : markiertes vorsichtig loeschen
+    CASE z rubin  : vorsichtig geloeschtes einfuegen
+    OTHERWISE     : belegte taste ausfuehren
+  END SELECT .
+ 
+esc kommandos :
+  LET z hop     =  1,                 z right   =  2,
+      z left    =  3,                 z rubin   =  4,
+      z rubout  =  5,                 z esc     =  6,
+      z b       =  7,                 z f       =  8;
+
+  ""1""2""8""11""12""27"bf" .
+ 
+zum vorigen wort :
+  IF   vorgaenger erlaubt
+  THEN vorgaenger; read record (file, bildsatz);
+       stelle := LENGTH bildsatz + 1; push (esc + left)
+  FI .
+ 
+vorgaenger erlaubt :
+  satznr > max (1, bildmarke) .
+
+zum naechsten wort :
+  IF nicht auf letztem satz THEN weitersuchen wenn nicht gefunden FI .
+ 
+nicht auf letztem satz : line no (file) < lines (file) .
+ 
+weitersuchen wenn nicht gefunden :
+  nachfolgenden satz holen;
+  IF   (nachfolgender satz SUB anfang) = blank
+  THEN push (abscr + esc + right)
+  ELSE push (abscr)
+  FI .
+ 
+nachfolgenden satz holen :
+  down (file); read record (file, nachfolgender satz); up (file) .
+ 
+bild an aktuelle zeile angleichen :
+  anfang INCR verschoben; verschoben := 0;
+  margin segment in ueberschrift eintragen;
+  neu (ueberschrift, bild) .
+ 
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+belegte taste ausfuehren :
+  kommando analysieren (bildzeichen, PROC(TEXT CONST) kommando interpreter) .
+ 
+kommandodialog versuchen:
+  IF   fenster ist zu schmal fuer dialog
+  THEN kommandodialog ablehnen
+  ELSE kommandodialog fuehren
+  FI .
+ 
+fenster ist zu schmal fuer dialog : laenge < 20 .
+ 
+kommandodialog ablehnen :
+  fehlertext := "zu schmal fuer ESC ESC"; neu (fehlermeldung, nix) .
+ 
+kommandodialog fuehren:
+  INT VAR x0, x1, x2, x3, y;
+  get cursor (x0, y);
+  cursor (rand + 1, bildrand + zeilennr);
+  get cursor (x1, y);
+  out (begin mark); out (monitor meldung);
+  get cursor (x2, y);
+  (laenge - LENGTH monitor meldung - marklength) TIMESOUT blank;
+  get cursor (x3, y);
+  out (end mark); out (blank);
+  kommandozeile editieren;
+  ueberschrift zeigen;
+  absatz ausgleich := 2;                                             (*sh*)
+  IF kommandotext = "" THEN LEAVE kommandodialog fuehren FI;
+  kommando auf taste legen ("f", kommandotext);
+  kommando analysieren ("f", PROC(TEXT CONST) kommando interpreter);
+  IF   fehlertext <> ""
+  THEN push (esc + esc + esc + "k")
+  ELIF markiert 
+  THEN zeile neu 
+  FI .
+ 
+kommandozeile editieren :
+  TEXT VAR kommandotext := "";
+  cursor (x1, y); out (begin mark);
+  disable stop;
+  darstellung invertieren; 
+  editget schleife;
+  darstellung invertieren; 
+  enable stop;
+  cursor (x3, y); out (end mark);
+  exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+  cursor (x0, y) .
+ 
+darstellung invertieren :
+  TEXT VAR dummy := begin mark; begin mark := end mark; end mark := dummy;
+  invertierte darstellung := NOT invertierte darstellung .
+ 
+editget schleife :
+  TEXT VAR exit char;
+  REP
+    cursor (x2, y);
+    editget (kommandotext, max textlength, rand + laenge - x cursor,
+             "", "k?!", exit char);
+    neu (ueberschrift, nix);
+    IF   exit char = ""27"k"
+    THEN kommando text := kommando auf taste ("f")
+    ELIF exit char = ""27"?"
+    THEN TEXT VAR taste; getchar (taste);
+         kommando text := kommando auf taste (taste)
+    ELIF exit char = ""27"!"
+    THEN getchar (taste);
+         IF   ist reservierte taste
+         THEN set busy indicator;                                    (*sh*)
+              out ("FEHLER: """ + taste + """ ist reserviert"7"")
+         ELSE kommando auf taste legen (taste, kommandotext);
+              kommandotext := ""; LEAVE editget schleife
+         FI 
+    ELSE LEAVE editget schleife
+    FI
+  PER .
+ 
+ist reservierte taste : pos (res, taste) > 0 .
+monitor meldung       : "gib kommando : " .
+ 
+neue seite : bildanfang := satznr; zeilennr := 1; neu (akt satznr, bild) .
+ 
+weiterblaettern :
+  INT CONST akt bildlaenge := aktuelle bildlaenge;
+  IF   nicht auf letztem satz
+  THEN erster neusatz := satznr;
+       IF   zeilennr >= akt bildlaenge
+       THEN bildanfang INCR akt bildlaenge; neu (akt satznr, bild)
+       FI ;
+       satznr := min (lines (file), bildanfang + akt bildlaenge - 1);
+       letzter neusatz := satznr;
+       toline (file, satznr);
+       stelle DECR verschoben;
+       neu (akt satznr, nix);
+       zeilennr := satznr - bildanfang + 1;
+       IF markiert THEN neu (nix, abschnitt) FI;
+       einrueckposition bestimmen
+  FI .
+ 
+zurueckblaettern :
+  IF   vorgaenger erlaubt
+  THEN IF   zeilennr <= 1
+       THEN bildanfang := max (1, bildanfang - aktuelle bildlaenge);
+            neu (akt satznr, bild)
+       FI ;
+       nach oben; einrueckposition bestimmen
+  FI .
+ 
+zeile loeschen :
+  IF   stelle = 1
+  THEN delete record (file);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  ELSE zeilen rekombinieren
+  FI .
+ 
+zeilen rekombinieren :
+  IF   nicht auf letztem satz
+  THEN aktuellen satz mit blanks auffuellen;
+       delete record (file);
+       nachfolgenden satz lesen;
+       bildsatz CAT nachfolgender satz ohne fuehrende blanks;
+       write record (file, bildsatz);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  FI .
+ 
+aktuellen satz mit blanks auffuellen :
+  bildsatz AUFFUELLENMIT blank .
+ 
+nachfolgenden satz lesen :
+  TEXT VAR nachfolgender satz;
+  read record (file, nachfolgender satz) .
+ 
+nachfolgender satz ohne fuehrende blanks :
+  satzrest := subtext (nachfolgender satz,
+     einrueckposition (nachfolgender satz)); satzrest .
+ 
+zeile aufsplitten :
+  nachfolgender satz := "";
+  INT VAR i;
+  FOR i FROM 2 UPTO min (stelle, einrueckposition (bildsatz)) REP
+    nachfolgender satz CAT blank
+  PER;
+  satzrest := subtext (bildsatz, naechste non blank position);
+  nachfolgender satz CAT satzrest;
+  bildsatz := subtext (bildsatz, 1, stelle - 1);
+  write record (file, bildsatz);
+  down (file); insert record (file);
+  write record (file, nachfolgender satz); up (file) .
+ 
+naechste non blank position :
+  INT VAR non blank pos := stelle;
+  WHILE (bildsatz SUB non blank pos) = blank REP
+    non blank pos INCR 1
+  PER; non blank pos .
+ 
+zum vorigen satz :
+  IF vorgaenger erlaubt THEN vorgaenger; einrueckposition bestimmen FI .
+ 
+zum folgenden satz :                                    (* 12.09.85 -ws- *)
+  IF nachfolger erlaubt THEN nachfolger; einrueckposition bestimmen 
+                        ELSE col (file, len (file) + 1); neu (nix, nix)
+  FI .
+
+einrueckposition bestimmen :                            (* 27.08.85 -ws- *)
+  read record (file, akt bildsatz);
+  INT  VAR neue einrueckposition := einrueckposition (akt bildsatz);
+  IF   akt bildsatz ist leerzeile
+  THEN alte einrueckposition := max (stelle, neue einrueckposition)
+  ELSE alte einrueckposition := min (stelle, neue einrueckposition)
+  FI .
+
+akt bildsatz ist leerzeile :
+  akt bildsatz = "" OR akt bildsatz = blank . 
+
+zum anfang des folgenden satzes :
+  IF nachfolger erlaubt THEN nachfolger; stelle := anfang FI .
+ 
+nachfolger erlaubt :
+  write access COR nicht auf letztem satz .
+ 
+eingerueckt mit cr : 
+  IF NOT nachfolger erlaubt THEN LEAVE eingerueckt mit cr FI;        (*sh*)
+  read record (file, bildsatz); 
+  INT VAR epos := einrueckposition (bildsatz);
+  nachfolger; col (file, 1); 
+  IF   eof (file) 
+  THEN IF   LENGTH bildsatz <= epos 
+       THEN stelle := alte einrueckposition 
+       ELSE stelle := epos 
+       FI 
+  ELSE read record (file, bildsatz); 
+       stelle := einrueckposition (bildsatz); 
+       IF   bildsatz ist leerzeile                     (* 29.08.85 -ws- *)
+       THEN stelle := alte einrueckposition;
+            aktuellen satz mit blanks auffuellen
+       FI
+  FI ; 
+  alte einrueckposition := stelle . 
+ 
+bildsatz ist leerzeile :
+  bildsatz = "" OR bildsatz = blank . 
+
+eingerueckt zum folgenden satz :                                     (*sh*)
+  IF NOT nachfolger erlaubt OR NOT write access
+    THEN LEAVE eingerueckt zum folgenden satz
+  FI; 
+  alte einrueckposition merken; 
+  naechsten satz holen; 
+  neue einrueckposition bestimmen; 
+  alte einrueckposition := stelle . 
+ 
+alte einrueckposition merken : 
+  read record (file, bildsatz);
+  epos := einrueckposition (bildsatz);
+  auf aufzaehlung pruefen;
+  IF epos > LENGTH bildsatz THEN epos := anfang FI.
+ 
+auf aufzaehlung pruefen :
+  BOOL CONST aufzaehlung gefunden :=
+       ist aufzaehlung CAND vorher absatzzeile CAND wort folgt;
+  IF   aufzaehlung gefunden THEN epos := anfang des naechsten wortes FI .
+
+ist aufzaehlung :
+  INT CONST wortende := pos (bildsatz, blank, epos, epos + 20) - 1;
+  SELECT pos ("-*).:" , bildsatz SUB wortende) OF
+    CASE 1,2 : wortende =  epos 
+    CASE 3,4 : wortende <= epos + 7
+    CASE 5   : TRUE
+    OTHERWISE: FALSE
+  ENDSELECT .
+ 
+vorher absatzzeile :
+  IF   satznr = 1
+  THEN TRUE
+  ELSE up (file);
+       INT  CONST vorige satzlaenge := len (file);
+       BOOL CONST vorher war absatzzeile :=
+       subtext (file, vorige satzlaenge, vorige satzlaenge) = blank;
+       down (file); vorher war absatzzeile
+  FI .
+ 
+wort folgt : 
+  INT CONST anfang des naechsten wortes :=
+  pos (bildsatz, ""33"", ""254"", wortende + 1); 
+  anfang des naechsten wortes > wortende .
+ 
+naechsten satz holen : 
+  nachfolger; col (file, 1);
+  IF   eof (file) 
+  THEN bildsatz := ""
+  ELSE IF   neue zeile einfuegen erforderlich 
+       THEN insert record (file); bildsatz := ""; 
+            letzter neusatz := bildanfang + bildlaenge - 1 
+       ELSE read record (file, bildsatz);
+            letzter neusatz := satznr;
+            ggf trennungen zurueckwandeln und umbruch indikator einfuegen 
+       FI ;
+       erster neusatz := satznr;
+       neu (nix, abschnitt)
+  FI . 
+ 
+neue zeile einfuegen erforderlich :
+  BOOL CONST war absatz := war absatzzeile;
+  war absatz COR neuer satz ist zu lang .
+ 
+war absatzzeile : 
+  INT VAR wl := pos (kommando, up backcr, kommando zeiger); 
+  wl = 0 COR (kommando SUB (wl - 1)) = blank . 
+ 
+neuer satz ist zu lang : laenge des neuen satzes >= limit .
+
+laenge des neuen satzes : 
+  IF   len (file) > 0 
+  THEN len (file) + wl 
+  ELSE wl + epos 
+  FI . 
+ 
+up backcr : ""3""20"" .
+ 
+ggf trennungen zurueckwandeln und umbruch indikator einfuegen :
+  LET trenn k      = ""220"",
+      trenn strich = ""221"";
+  TEXT VAR umbruch indikator;
+  IF   letztes zeichen ist trenn strich
+  THEN entferne trenn strich;
+       IF   letztes zeichen = trenn k
+       THEN wandle trenn k um
+       FI ;
+       umbruch indikator := up backcr 
+  ELIF letztes umgebrochenes zeichen ist kanji 
+  THEN umbruch indikator := up backcr
+  ELSE umbruch indikator := blank + up backcr
+  FI ;
+  change (kommando, wl, wl+1, umbruch indikator) . 
+ 
+letztes umgebrochenes zeichen ist kanji : within kanji (kommando, wl-1) .
+ 
+letztes zeichen ist trenn strich :
+  TEXT CONST last char := letztes zeichen;
+  last char = trenn strich COR
+  last char = "-" CAND wl > 2 CAND (kommando SUB (wl-2)) <> blank .
+ 
+letztes zeichen       : kommando SUB (wl-1) .
+entferne trenn strich : delete char (kommando, wl-1); wl DECR 1 .
+wandle trenn k um     : replace (kommando, wl-1, "c") .
+loesche indikator     : delete char (kommando, wl) . 
+ 
+neue einrueckposition bestimmen : 
+  IF   aufzaehlung gefunden CAND bildsatz ist leerzeile 
+  THEN stelle := epos
+  ELIF NOT bildsatz ist leerzeile  
+  THEN stelle := einrueckposition (bildsatz)
+  ELIF war absatz COR auf letztem satz
+  THEN stelle := epos
+  ELSE down (file); read record (file, nachfolgender satz);
+       up   (file); stelle := einrueckposition (nachfolgender satz)
+  FI ; 
+  IF   ist einfuegender aber nicht induzierter umbruch 
+  THEN loesche indikator;
+       umbruchstelle := stelle + wl - kommando zeiger - anzahl der stz;
+       umbruchverschoben := 0
+  FI . 
+ 
+auf letztem satz : NOT nicht auf letztem satz .
+
+ist einfuegender aber nicht induzierter umbruch :
+  wl := pos (kommando, backcr, kommando zeiger); 
+  wl > 0 CAND (kommando SUB (wl - 1)) <> up char . 
+ 
+anzahl der stz : 
+  TEXT CONST umgebrochener anfang := subtext (kommando, kommando zeiger, wl-1); 
+  INT VAR anz := 0, anf := pos (umgebrochener anfang, ""1"", ""31"", 1);
+  WHILE anf > 0 REP 
+    anz INCR 1; anf := pos (umgebrochener anfang, ""1"", ""31"", anf + 1) 
+  PER; anz .
+ 
+markiertes vorsichtig loeschen :
+  IF   write access CAND markiert
+  THEN clear removed (file);
+       IF   nur im satz markiert
+       THEN behandle einen satz
+       ELSE behandle mehrere saetze
+       FI
+  FI .
+ 
+nur im satz markiert : line no (file) = bildmarke .
+ 
+behandle einen satz :
+  insert record (file);
+  satzrest := subtext (bildsatz, marke, stelle - 1);
+  write record (file, satzrest);
+  remove (file, 1);
+  change (bildsatz, marke, stelle - 1, "");
+  stelle := marke;
+  marke := 0; bildmarke := 0; feldmarke := 0;
+  markiert := FALSE; mark (file, 0, 0);
+  konstanten neu berechnen;
+  IF   bildsatz = ""
+  THEN delete record (file);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  ELSE write record (file, bildsatz);
+       neu (nix, bildzeile)
+  FI .
+ 
+behandle mehrere saetze :
+  erster neusatz := bildmarke;
+  letzter neusatz := bildanfang + bildlaenge - 1;
+  zeile an aktueller stelle auftrennen;
+  ersten markierten satz an markieranfang aufspalten;
+  markierten bereich entfernen;
+  bild anpassen .
+ 
+zeile an aktueller stelle auftrennen :
+  INT VAR markierte saetze := line no (file) - bildmarke + 1;
+  IF   nicht am ende der zeile
+  THEN IF   nicht am anfang der zeile
+       THEN zeile aufsplitten
+       ELSE up (file); markierte saetze DECR 1
+       FI
+  FI .
+ 
+nicht am anfang der zeile : stelle > 1 .
+nicht am ende der zeile   : stelle <= LENGTH bildsatz .
+ 
+ersten markierten satz an markieranfang aufspalten :
+  to line (file, line no (file) - (markierte saetze - 1));
+  read record (file, bildsatz);
+  stelle := feldmarke;
+  IF   nicht am anfang der zeile
+  THEN IF   nicht am ende der zeile 
+       THEN zeile aufsplitten
+       ELSE markierte saetze DECR 1
+       FI ;
+       to line (file, line no (file) + markierte saetze)
+  ELSE to line (file, line no (file) + markierte saetze - 1)
+  FI ;
+  read record (file, bildsatz) .
+ 
+markierten bereich entfernen :
+  zeilen nr := line no (file) - markierte saetze - bildanfang + 2;
+  remove (file, markierte saetze);
+  marke := 0; bildmarke := 0; feldmarke := 0;
+  markiert := FALSE; mark (file, 0, 0); 
+  konstanten neu berechnen;
+  stelle := 1 .
+ 
+bild anpassen :
+  satz nr := line no (file);
+  IF   zeilen nr <= 1
+  THEN bildanfang := line no (file); zeilen nr := 1;
+       neu (akt satznr, bild)
+  ELSE neu (akt satznr, abschnitt)
+  FI . 
+ 
+vorsichtig geloeschtes einfuegen :
+  IF   NOT write access OR removed lines (file) = 0
+  THEN LEAVE vorsichtig geloeschtes einfuegen
+  FI ;
+  IF   nur ein satz
+  THEN in aktuellen satz einfuegen
+  ELSE aktuellen satz aufbrechen und einfuegen
+  FI .
+ 
+nur ein satz : removed lines (file) = 1 .
+ 
+in aktuellen satz einfuegen :
+  reinsert (file);
+  read record (file, nachfolgender satz);
+  delete record (file);
+  TEXT VAR t := bildsatz;
+  bildsatz := subtext (t, 1, stelle - 1);
+  aktuellen satz mit blanks auffuellen;                              (*sh*)
+  bildsatz CAT nachfolgender satz;
+  satzrest := subtext (t, stelle);
+  bildsatz CAT satzrest;
+  write record (file, bildsatz);
+  stelle INCR LENGTH nachfolgender satz;
+  neu (nix, bildzeile) .
+ 
+aktuellen satz aufbrechen und einfuegen :
+  INT CONST alter bildanfang := bildanfang;
+  old lineno := satznr;
+  IF   stelle = 1
+  THEN reinsert (file);
+       read record (file, bildsatz)
+  ELIF stelle > LENGTH bildsatz
+  THEN down (file);
+       reinsert (file);
+       read record (file, bildsatz)
+  ELSE INT VAR von := stelle;
+       WHILE (bildsatz SUB von) = blank REP von INCR 1 PER;
+       satzrest := subtext (bildsatz, von, LENGTH bildsatz);
+       INT VAR bis := stelle - 1;
+       WHILE (bildsatz SUB bis) = blank REP bis DECR 1 PER;
+       bildsatz := subtext (bildsatz, 1, bis);
+       write record (file, bildsatz);
+       down (file);
+       reinsert (file);
+       read record (file, bildsatz);
+       nachfolgender satz := einrueckposition (bildsatz) * blank;
+       nachfolgender satz CAT satzrest;
+       down (file); insert record (file);
+       write record (file, nachfolgender satz); up (file)
+  FI ;
+  stelle := max (1, LENGTH bildsatz);                   (* 22.06.84 -bk- *)
+  satz nr := line no (file);
+  zeilennr INCR satznr - old lineno;
+  zeilennr := min (zeilennr, aktuelle bildlaenge);
+  bildanfang := satznr - zeilennr + 1;
+  IF   bildanfang veraendert 
+  THEN abschnitt neu (bildanfang, 9999) 
+  ELSE abschnitt neu (old lineno, 9999) 
+  FI ;
+  neu (akt satznr, nix).
+ 
+bildanfang veraendert : bildanfang <> alter bildanfang . 
+ 
+lernmodus umschalten :
+  learn segment in ueberschrift eintragen; neu (ueberschrift, nix) .
+ 
+learn segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 19, learn segment) .
+ 
+learn segment :
+  IF lernmodus THEN "LEARN" ELSE "....." FI .
+ 
+markierung umschalten :
+  IF markiert THEN markierung ausschalten ELSE markierung einschalten FI .
+ 
+markierung einschalten :
+  bildmarke := satznr; feldmarke := marke; markiert := TRUE;
+  mark (file, bildmarke, feldmarke);
+  neu (nix, bildzeile) .
+ 
+markierung ausschalten :
+  erster neusatz := max (bildmarke, bildanfang);
+  letzter neusatz := satznr;
+  bildmarke := 0; feldmarke := 0; markiert := FALSE;
+  mark (file, 0, 0);
+  IF   erster neusatz = letzter neusatz
+  THEN neu (nix, bildzeile)
+  ELSE neu (nix, abschnitt)
+  FI .
+END PROC bildeditor;
+ 
+PROC neu (INT CONST ue bereich, b bereich) :
+  ueberschriftbereich := max (ueberschriftbereich, ue bereich);
+  bildbereich := max (bildbereich, b bereich)
+END PROC neu;
+ 
+ 
+PROC nach oben :
+  letzter neusatz := satznr;
+  satznr := max (bildanfang, bildmarke);
+  toline (file, satznr);
+  stelle DECR verschoben;
+  zeilennr := satznr - bildanfang + 1;
+  erster neusatz := satznr;
+  IF   markiert
+  THEN neu (akt satznr, abschnitt)
+  ELSE neu (akt satznr, nix)
+  FI
+END PROC nach oben;
+ 
+INT PROC aktuelle bildlaenge :
+  IF stelle - stelle am anfang < kurze feldlaenge
+    AND feldlaenge > 0
+  THEN bildlaenge                                                    (*wk*)
+  ELSE kurze bildlaenge
+  FI
+END PROC aktuelle bildlaenge;
+ 
+PROC vorgaenger :
+  up (file); satznr DECR 1;
+  marke := 0; stelle DECR verschoben;
+  IF   zeilennr = 1
+  THEN bildanfang DECR 1; neu (ueberschrift, bild)
+  ELSE zeilennr DECR 1; neu (akt satznr, nix);                       (*sh*)
+       IF markiert THEN neu (nix, bildzeile) FI
+  FI 
+END PROC vorgaenger;
+ 
+PROC nachfolger :
+  down (file); satznr INCR 1;
+  stelle DECR verschoben;
+  IF   zeilennr = aktuelle bildlaenge
+  THEN bildanfang INCR 1;
+       IF   rollup erlaubt
+       THEN rollup
+       ELSE neu (ueberschrift, bild)
+       FI
+  ELSE neu (akt satznr, nix); zeilennr INCR 1                        (*sh*)
+  FI ;
+  IF   markiert THEN neu (nix, bildzeile) FI .
+ 
+rollup erlaubt :
+  kurze bildlaenge = maxlaenge AND kurze feldlaenge = maxbreite .
+ 
+rollup :
+  out (down char);
+  IF   bildzeichen = inscr
+  THEN neu (ueberschrift, nix)
+  ELIF is cr or down CAND (write access COR nicht auf letztem satz)  (*sh*)
+  THEN neu (nix, bildzeile)
+  ELSE neu (ueberschrift, bildzeile)
+  FI .
+ 
+is cr or down :
+  IF kommando = "" THEN kommando := inchety FI;
+  kommando char = down char COR kommando char = cr .
+ 
+kommando char : kommando SUB kommando zeiger .
+
+nicht auf letztem satz : line no (file) < lines (file) . 
+END PROC nachfolger;
+ 
+BOOL PROC next incharety is (TEXT CONST muster) :
+  INT CONST klen := LENGTH kommando - kommando zeiger + 1,
+            mlen := LENGTH muster;
+  INT VAR i; FOR i FROM 1 UPTO mlen - klen REP kommando CAT inchety PER;
+  subtext (kommando, kommando zeiger, kommando zeiger + mlen - 1) = muster
+END PROC next incharety is;
+ 
+PROC quit last:                                         (* 22.06.84 -bk- *) 
+  IF   actual editor > 0 AND actual editor < max used editor 
+  THEN verlasse alle groesseren editoren 
+  FI . 
+ 
+verlasse alle groesseren editoren : 
+  open editor (actual editor + 1); quit .
+END PROC quit last; 
+ 
+PROC quit : 
+  IF actual editor > 0 THEN verlasse aktuellen editor FI .
+ 
+verlasse aktuellen editor :
+  disable stop;
+  INT CONST aktueller editor := actual editor;
+  in innersten editor gehen; 
+  REP 
+    IF zeileneinfuegen THEN hop rubin simulieren FI;
+    ggf bildschirmdarstellung korrigieren;
+    innersten editor schliessen 
+  UNTIL aktueller editor > max used editor PER; 
+  actual editor := max used editor . 
+ 
+in innersten editor gehen : open editor (max used editor) . 
+ 
+hop rubin simulieren : 
+  zeileneinfuegen := FALSE; 
+  leere zeilen am dateiende loeschen;                                (*sh*)
+  ggf bildschirmdarstellung korrigieren;
+  logisches eof loeschen . 
+ 
+innersten editor schliessen : 
+  max used editor DECR 1; 
+  IF   max used editor > 0 
+  THEN open editor (max used editor);
+       bildeinschraenkung aufheben 
+  FI . 
+ 
+logisches eof loeschen :
+  col (file, stelle); set range (file, old range) .
+ 
+leere zeilen am dateiende loeschen :                    (* 15.08.85 -ws- *)
+  satz nr := line no (file) ; 
+  to line (file, lines (file)) ;
+  WHILE lines (file) > 1 AND bildsatz ist leerzeile REP 
+    delete record (file); 
+    to line (file, lines (file)) 
+  PER;
+  toline (file, satznr) .
+
+bildsatz ist leerzeile :
+  TEXT VAR bildsatz;
+  read record (file, bildsatz);
+  ist leerzeile .
+
+ist leerzeile :
+  bildsatz = "" OR bildsatz = blank . 
+
+ggf bildschirmdarstellung korrigieren :
+  satz nr DECR 1;                             (* für Bildschirmkorrektur *)
+  IF   satznr > lines (file)
+  THEN zeilen nr DECR satz nr - lines (file);
+       satz nr := lines (file); 
+       dateizustand retten
+  FI . 
+
+bildeinschraenkung aufheben :
+  laenge := feldlaenge;
+  kurze feldlaenge := feldlaenge;
+  kurze bildlaenge := bildlaenge;
+  neu (nix, bild) .
+END PROC quit;
+ 
+PROC nichts neu       : neu (nix,          nix)  END PROC nichts neu;
+ 
+PROC satznr neu       : neu (akt satznr,   nix)  END PROC satznr neu;
+ 
+PROC ueberschrift neu : neu (ueberschrift, nix)  END PROC ueberschrift neu;
+ 
+PROC zeile neu :
+  INT CONST zeile := line no (file);
+  abschnitt neu (zeile, zeile)
+END PROC zeile neu;
+ 
+PROC abschnitt neu (INT CONST von satznr, bis satznr) :
+  IF   von satznr <= bis satznr
+  THEN erster neusatz  := min (erster neusatz, von satznr);
+       letzter neusatz := max (letzter neusatz, bis satznr);
+       neu (nix, abschnitt)
+  ELSE abschnitt neu (bis satznr, von satznr) 
+  FI
+END PROC abschnitt neu;
+ 
+PROC bildabschnitt neu (INT CONST von zeile, bis zeile) :            (*sh*)
+  IF   von zeile <= bis zeile 
+  THEN erster neusatz  := max (1, von zeile + bildanfang - 1); 
+       letzter neusatz := min (bildlaenge, bis zeile + bildanfang - 1); 
+       IF   von zeile < 1
+       THEN neu (ueberschrift, abschnitt)
+       ELSE neu (nix         , abschnitt) 
+       FI
+  ELSE bildabschnitt neu (bis zeile, von zeile) 
+  FI 
+END PROC bildabschnitt neu; 
+ 
+PROC bild neu : neu (nix, bild) END PROC bild neu;                   (*sh*)
+ 
+PROC bild neu (FILE VAR f) :
+  INT CONST editor no := abs (editinfo (f)) DIV 256;
+  IF   editor no > 0 AND editor no <= max used editor
+  THEN IF   editor no = actual editor
+       THEN bild neu
+       ELSE editstack (editor no).bildstatus.bildbereich := bild
+       FI
+  FI
+END PROC bild neu; 
+ 
+PROC alles neu :
+  neu (ueberschrift, bild);
+  INT VAR i;
+  FOR i FROM 1 UPTO max used editor REP
+    editstack (i).bildstatus.bildbereich := bild;
+    editstack (i).bildstatus.ueberschriftbereich := ueberschrift
+  PER
+END PROC alles neu;
+ 
+PROC satznr zeigen :
+  out (satznr pre); out (text (text (lineno (file)), 4))
+END PROC satznr zeigen;
+ 
+PROC ueberschrift zeigen :
+  SELECT ueberschriftbereich OF
+    CASE akt satznr    : satznr zeigen;
+                         ueberschriftbereich := nix
+    CASE ueberschrift  : ueberschrift schreiben;
+                         ueberschriftbereich := nix
+    CASE fehlermeldung : fehlermeldung schreiben;
+                         ueberschriftbereich := ueberschrift
+  END SELECT
+END PROC ueberschrift zeigen;
+ 
+PROC fenster zeigen :
+  SELECT bildbereich OF
+    CASE bildzeile :
+         zeile := bildrand + zeilennr;
+         IF   line no (file) > lines (file)
+         THEN feldout ("", stelle)
+         ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle)
+         FI
+    CASE abschnitt :
+         bild ausgeben
+    CASE bild :
+         erster neusatz := 1;
+         letzter neusatz := 9999;
+         bild ausgeben
+    OTHERWISE :
+         LEAVE fenster zeigen
+  END SELECT;
+  erster neusatz := 9999;
+  letzter neusatz := 0;
+  bildbereich := nix 
+END PROC fenster zeigen ;
+ 
+PROC bild ausgeben :
+  BOOL CONST schreiben ist ganz einfach := NOT markiert AND verschoben = 0;
+  INT  CONST save marke := marke,
+             save verschoben := verschoben,
+             save laenge := laenge,
+             act lineno := lineno (file),
+             von := max (1, erster neusatz - bildanfang + 1);
+  INT   VAR  bis := min (letzter neusatz - bildanfang + 1, bildlaenge);
+  IF kurze feldlaenge <= 0 THEN bis := min (bis, kurze bildlaenge) FI;
+  IF von > bis THEN LEAVE bild ausgeben FI;
+  verschoben := 0;
+  IF   markiert
+  THEN IF   mark lineno (file) < bildanfang + von - 1
+       THEN marke := anfang
+       ELSE marke := 0
+       FI
+  FI ;
+  abschnitt loeschen und neuschreiben;
+  to line (file, act lineno);
+  laenge := save laenge;
+  verschoben := save verschoben;
+  marke := save marke .
+ 
+markiert : mark lineno (file) > 0 .
+ 
+abschnitt loeschen und neuschreiben :
+  abschnitt loeschen;
+  INT VAR line number := bildanfang + von - 1;
+  to line (file, line number);
+  abschnitt schreiben .
+ 
+abschnitt loeschen :
+  cursor (rand + 1, bildrand + von);
+  IF   bildrest darf komplett geloescht werden
+  THEN out (clear eop)
+  ELSE zeilenweise loeschen
+  FI .
+ 
+bildrest darf komplett geloescht werden :
+  bis = maxlaenge AND kurze bildlaenge = maxlaenge
+                  AND kurze feldlaenge = maxbreite .
+ 
+zeilenweise loeschen :
+  INT VAR i;
+  FOR i FROM von UPTO bis REP
+    check for interrupt;
+    feldlaenge einstellen;
+    feldrest loeschen;
+    IF i < bis THEN out (down char) FI
+  PER .
+ 
+feldlaenge einstellen :
+  IF   ganze zeile sichtbar
+  THEN laenge := feldlaenge
+  ELSE laenge := kurze feldlaenge
+  FI .
+ 
+ganze zeile sichtbar : i <= kurze bildlaenge .
+ 
+abschnitt schreiben :
+  INT CONST last line := lines (file);
+  FOR i FROM von UPTO bis
+  WHILE line number <= last line REP
+    check for interrupt;
+    feldlaenge einstellen;
+    zeile schreiben;
+    down (file);
+    line number INCR 1
+  PER .
+ 
+check for interrupt :
+  kommando CAT inchety;
+  IF   kommando <> "" 
+  THEN IF   zeilen nr = 1 CAND up command CAND vorgaenger erlaubt
+       THEN LEAVE abschnitt loeschen und neuschreiben
+       ELIF zeilen nr = bildlaenge CAND down command CAND nicht letzter satz
+       THEN LEAVE abschnitt loeschen und neuschreiben
+       FI
+  FI .
+ 
+vorgaenger erlaubt :
+  satznr > max (1, bildmarke) .
+
+up command : next incharety is (""3"") COR next incharety is (""1""3"") .
+ 
+down command :
+  next incharety is (""10"") CAND bildlaenge < maxlaenge
+  COR next incharety is (""1""10"") .
+ 
+nicht letzter satz : act lineno < lines (file) .
+ 
+zeile schreiben :
+  zeile := bildrand + i;
+  IF   schreiben ist ganz einfach
+  THEN exec (PROC (TEXT CONST, INT CONST) simple feldout, file, 0)
+  ELSE zeile kompliziert schreiben
+  FI ;
+  IF   line number = old lineno THEN old line update := FALSE FI .
+ 
+zeile kompliziert schreiben :
+  IF   line number = mark lineno (file) THEN marke := mark col (file) FI;
+  IF   line number = act lineno
+  THEN verschoben := save verschoben; 
+       exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+       verschoben := 0; marke := 0
+  ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, 0);
+       IF line number = mark lineno (file) THEN marke := anfang FI
+  FI .
+END PROC bild ausgeben;
+ 
+PROC bild zeigen :                                                   (* wk *)
+
+  dateizustand holen ;
+  ueberschrift zeigen ;
+  bildausgabe steuern ;
+  bild neu ;
+  fenster zeigen ;
+  oldline no := satznr ;
+  old line update := FALSE ;
+  old satz := "" ;
+  old zeilennr := satznr - bildanfang + 1 ;
+  dateizustand retten .
+
+ENDPROC bild zeigen ;
+
+PROC ueberschrift initialisieren :                                   (*sh*)
+  satznr pre  :=
+       cursor pos + code (bildrand - 1) + code (rand + feldlaenge - 6);
+  ueberschrift pre :=
+       cursor pos + code (bildrand - 1) + code (rand) + mark anf; 
+  ueberschrift text := ""; INT VAR i;
+  FOR i FROM 16 UPTO feldlaenge REP ueberschrift text CAT "." PER;
+  ueberschrift post :=  blank + mark end + "Zeile     " + mark anf; 
+  ueberschrift post CAT blank + mark end + "  ";
+  filename := headline (file);
+  filename := subtext (filename, 1, feldlaenge - 24);
+  insert char (filename, blank, 1); filename CAT blank;
+  replace (ueberschrift text, filenamepos, filename);
+  rubin segment in ueberschrift eintragen;
+  margin segment in ueberschrift eintragen;
+  rest segment in ueberschrift eintragen;
+  learn segment in ueberschrift eintragen .
+ 
+filenamepos    : (LENGTH ueberschrift text - LENGTH filename + 3) DIV 2 .
+mark anf       : begin mark + mark ausgleich. 
+mark end       :  end  mark + mark ausgleich.
+mark ausgleich : (1 - sign (max (mark size, 0))) * blank .
+
+rubin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 9, rubin segment) .
+ 
+rubin segment :
+  IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+rest segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 25, rest segment) .
+ 
+rest segment :
+  IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+learn segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 19, learn segment) .
+ 
+learn segment :
+  IF lernmodus THEN "LEARN" ELSE "....." FI .
+ 
+END PROC ueberschrift initialisieren;
+ 
+PROC ueberschrift schreiben :
+  replace (ueberschrift post, satznr pos, text (text (lineno (file)), 4));
+  out (ueberschrift pre); out (ueberschrift text); out (ueberschrift post);
+  get tabs (file, tab);
+  IF   pos (tab, dach) > 0
+  THEN out (ueberschrift pre);
+       out subtext (tab, anfang + 1, anfang + feldlaenge - 1);
+       cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+  FI .
+
+  satznr pos : IF mark size > 0 THEN 9 ELSE 10 FI .                  (*sh*)
+END PROC ueberschrift schreiben;
+ 
+PROC fehlermeldung schreiben :
+  ueberschrift schreiben;
+  out (ueberschrift pre);
+  out ("FEHLER: ");
+  out subtext (fehlertext, 1, feldlaenge - 21);
+  out (blank);
+  out (piep);
+  cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+END PROC fehlermeldung schreiben;
+ 
+PROC set busy indicator : 
+  cursor (rand + 2, bildrand) 
+END PROC set busy indicator; 
+ 
+PROC kommando analysieren (TEXT CONST taste,
+                           PROC (TEXT CONST) kommando interpreter) :
+  disable stop;
+  bildausgabe normieren;
+  zustand in datei sichern;
+  editfile modus setzen;
+  kommando interpreter (taste);
+  editfile modus zuruecksetzen;
+  IF actual editor <= 0 THEN LEAVE kommando analysieren FI;
+  absatz ausgleich := 2;                                             (*sh*)
+  konstanten neu berechnen;
+  neues bild bei undefinierter benutzeraktion;
+  evtl fehler behandeln;
+  zustand aus datei holen; 
+  bildausgabe steuern . 
+ 
+editfile modus setzen :
+  BOOL VAR alter editget modus := editget modus ;
+  editget modus := FALSE .
+
+editfile modus zuruecksetzen :
+  editget modus := alter editget modus .
+
+evtl fehler behandeln :
+  IF   is error
+  THEN fehlertext := errormessage;
+       IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+       clear error
+  ELSE fehlertext := ""
+  FI .
+ 
+zustand in datei sichern :
+  old zeilennr := zeilennr;
+  old mark lineno := bildmarke;
+  dateizustand retten .
+ 
+zustand aus datei holen :
+  dateizustand holen;
+  IF   letzer editor auf dieser datei <> actual editor
+  THEN zurueck auf alte position; neu (ueberschrift, bild) 
+  FI .
+ 
+zurueck auf alte position :
+  to line (file, old lineno);
+  col (file, alte stelle);
+  IF   fliesstext
+  THEN editinfo (file,   old zeilennr)
+  ELSE editinfo (file, - old zeilennr)
+  FI ; dateizustand holen .
+ 
+bildausgabe normieren :
+  bildbereich := undefinierter bereich;
+  erster neusatz := 9999;
+  letzter neusatz := 0 .
+ 
+neues bild bei undefinierter benutzeraktion :
+  IF bildbereich = undefinierter bereich THEN alles neu FI .
+END PROC kommando analysieren;
+ 
+PROC bildausgabe steuern :
+  IF   markiert
+  THEN IF   old mark lineno = 0
+       THEN abschnitt neu (bildmarke, satznr);
+            konstanten neu berechnen
+       ELIF stelle veraendert                                        (*sh*)
+       THEN zeile neu 
+       FI
+  ELIF old mark lineno > 0
+  THEN abschnitt neu (old mark lineno, (max (satznr, old lineno)));
+       konstanten neu berechnen
+  FI ;
+  IF   satznr <> old lineno
+  THEN neu (akt satznr, nix);
+       neuen bildaufbau bestimmen
+  ELSE zeilennr := old zeilennr 
+  FI ;
+  zeilennr := min (min (zeilennr, satznr), aktuelle bildlaenge);
+  bildanfang := satznr - zeilennr + 1 .
+
+stelle veraendert : stelle <> alte stelle . 
+
+neuen bildaufbau bestimmen :
+  zeilennr := old zeilennr + satznr - old lineno;
+  IF   1 <= zeilennr AND zeilennr <= aktuelle bildlaenge
+  THEN im fenster springen
+  ELSE bild neu aufbauen
+  FI .
+ 
+im fenster springen : 
+  IF markiert THEN abschnitt neu (old lineno, satznr) FI .
+ 
+bild neu aufbauen :
+  neu (nix, bild); zeilennr := max (1, aktuelle bildlaenge DIV 2) .
+END PROC bildausgabe steuern;
+
+PROC word wrap (BOOL CONST b) :
+  IF   actual editor = 0
+  THEN std fliesstext := b
+  ELSE fliesstext in datei setzen
+  FI .
+ 
+fliesstext in datei setzen :
+  fliesstext := b;
+  IF fliesstext veraendert THEN editinfo (file, - editinfo (file)) FI;
+  neu (ueberschrift, bild) .
+ 
+fliesstext veraendert :
+  fliesstext AND editinfo (file) < 0 OR
+  NOT fliesstext AND editinfo (file) > 0 .
+END PROC word wrap;
+ 
+BOOL PROC word wrap :                                                (*sh*)
+  IF   actual editor = 0
+  THEN std fliesstext 
+  ELSE fliesstext 
+  FI 
+END PROC word wrap;
+
+INT PROC margin :   anfang   END PROC margin;
+ 
+PROC margin (INT CONST i) :                                          (*sh*)
+  IF   anfang <> i CAND i > 0 AND i < 16001 
+  THEN anfang := i; neu (ueberschrift, bild);
+       margin segment in ueberschrift eintragen
+  ELSE IF i >= 16001 OR i < 0
+         THEN errorstop ("ungueltige Anfangsposition (1 - 16000)")
+       FI
+  FI .
+
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+END PROC margin;
+ 
+BOOL PROC rubin mode :   rubin mode (actual editor)   END PROC rubin mode;
+
+BOOL PROC rubin mode (INT CONST editor nr) :                         (*sh*)
+  IF   editor nr < 1 OR editor nr > max used editor
+  THEN errorstop ("Editor nicht eroeffnet")
+  FI ;
+  IF   editor nr = actual editor
+  THEN einfuegen
+  ELSE editstack (editor nr).feldstatus.einfuegen 
+  FI
+END PROC rubin mode;
+
+PROC edit (INT CONST i, TEXT CONST res,
+           PROC (TEXT CONST) kommando interpreter) :
+  edit (i, i, i, res, PROC (TEXT CONST) kommando interpreter)
+END PROC edit;
+ 
+PROC edit (INT CONST von, bis, start, TEXT CONST res,
+           PROC (TEXT CONST) kommando interpreter) :
+  disable stop;
+  IF   von < bis
+  THEN edit (von+1, bis, start, res, PROC (TEXT CONST) kommando interpreter);
+       IF max used editor < von THEN LEAVE edit FI;
+       open editor (von)
+  ELSE open editor (start)
+  FI ;
+  absatz ausgleich := 2;
+  bildeditor (res, PROC (TEXT CONST) kommando interpreter);
+  cursor (1, schirmhoehe);
+  IF   is error
+  THEN kommando zeiger := 1; kommando := ""; quit
+  FI ;
+  IF   lernmodus CAND actual editor = 0 THEN warnung ausgeben FI .   (*sh*)
+
+  warnung ausgeben : 
+    out (clear eop); out ("WARNUNG: Lernmodus nicht ausgeschaltet"13""10"") .
+END PROC edit;
+ 
+PROC dateizustand holen :
+  modify (file);
+  get tabs (file, tabulator);
+  zeilennr und fliesstext und letzter editor aus editinfo decodieren;
+  limit := max line length (file);
+  stelle := col (file);
+  markiert := mark (file);
+  IF   markiert
+  THEN markierung holen
+  ELSE keine markierung
+  FI ;
+  satz nr := lineno (file);
+  IF   zeilennr > aktuelle bildlaenge                                (*sh*)
+  THEN zeilennr := min (satznr, aktuelle bildlaenge); bild neu
+  ELIF zeilennr > satznr
+  THEN zeilennr := min (satznr, aktuelle bildlaenge)
+  FI ; zeilennr := max (zeilennr, 1);
+  bildanfang := satz nr - zeilennr + 1 .
+ 
+zeilennr und fliesstext und letzter editor aus editinfo decodieren :
+  zeilennr := edit info (file);
+  IF   zeilennr = 0
+  THEN zeilennr := 1;
+       fliesstext := std fliesstext
+  ELIF zeilennr > 0
+  THEN fliesstext := TRUE
+  ELSE zeilennr := - zeilennr;
+       fliesstext := FALSE
+  FI ;
+  letzer editor auf dieser datei := zeilennr DIV 256;
+  zeilennr := zeilennr MOD 256 .
+ 
+markierung holen :
+  bildmarke := mark lineno (file);
+  feldmarke := mark col (file);
+  IF   line no (file) <= bildmarke
+  THEN to line (file, bildmarke);
+       marke := feldmarke;
+       stelle := max (stelle, feldmarke)
+  ELSE marke := 1
+  FI .
+ 
+keine markierung :
+  bildmarke := 0;
+  feldmarke := 0;
+  marke     := 0 .
+END PROC dateizustand holen;
+ 
+PROC dateizustand retten :
+  put tabs (file, tabulator);
+  IF   fliesstext
+  THEN editinfo (file,    zeilennr + actual editor * 256)
+  ELSE editinfo (file, - (zeilennr + actual editor * 256))
+  FI ;
+  max line length (file, limit);
+  col (file, stelle);
+  IF   markiert
+  THEN mark (file, bildmarke, feldmarke)
+  ELSE mark (file, 0, 0)
+  FI 
+END PROC dateizustand retten;
+ 
+PROC open editor (FILE CONST new file, BOOL CONST access) :
+  disable stop; quit last;
+  neue bildparameter bestimmen;
+  open editor (actual editor + 1, new file, access, x, y, x len, y len). 
+ 
+neue bildparameter bestimmen :
+  INT VAR x, y, x len, y len;
+  IF   actual editor > 0
+  THEN teilbild des aktuellen editors
+  ELSE volles bild
+  FI .
+ 
+teilbild des aktuellen editors :
+  get editcursor (x, y); bildgroesse bestimmen;
+  IF   fenster zu schmal                                             (*sh*)
+  THEN enable stop; errorstop ("Fenster zu klein")
+  ELIF fenster zu kurz
+  THEN verkuerztes altes bild nehmen
+  FI .
+
+bildgroesse bestimmen :
+  x len := rand + feldlaenge - x + 3;
+  y len := bildrand + bildlaenge - y + 1 .
+ 
+fenster zu schmal : x > schirmbreite - 17 .
+fenster zu kurz   : y > schirmhoehe  -  1 .
+
+verkuerztes altes bild nehmen :
+  x := rand + 1; y := bildrand + 1;
+  IF fenster zu kurz THEN enable stop; errorstop ("Fenster zu klein") FI;
+  x len := feldlaenge + 2;
+  y len := bildlaenge;
+  kurze feldlaenge := 0;
+  kurze bildlaenge := 1 . 
+
+volles bild :
+  x := 1; y := 1; x len := schirmbreite; y len := schirmhoehe .
+END PROC open editor;
+ 
+PROC open editor (INT CONST editor nr,
+                  FILE CONST new file, BOOL CONST access,
+                  INT CONST x start, y, x len start, y len) :
+  INT VAR x := x start,
+  x len := x len start;
+  IF   editor nr > max editor
+  THEN errorstop ("zu viele Editor-Fenster")
+  ELIF editor nr > max used editor + 1 OR editor nr < 1
+  THEN errorstop ("Editor nicht eroeffnet")
+  ELIF fenster ungueltig
+  THEN errorstop ("Fenster ungueltig")
+  ELSE neuen editor stacken
+  FI .
+ 
+fenster ungueltig :
+  x < 1  COR  x > schirmbreite  COR  y < 1  COR  y > schirmhoehe  COR
+  x len - 2 <= 15  COR  y len - 1 < 1  COR
+  x + x len - 1 > schirmbreite  COR  y + y len - 1 > schirmhoehe .
+ 
+neuen editor stacken :
+  disable stop;
+  IF   actual editor > 0 AND ist einschraenkung des alten bildes
+  THEN dateizustand holen;
+       aktuelles editorbild einschraenken;
+       arbeitspunkt in das restbild positionieren;
+       abgrenzung beruecksichtigen
+  FI ;
+  aktuellen zustand retten;
+  neuen zustand setzen;
+  neues editorbild zeigen;
+  actual editor := editor nr;
+  IF   actual editor > max used editor
+  THEN max used editor := actual editor
+  FI .
+ 
+ist einschraenkung des alten bildes :
+  x > rand      CAND  x + x len = rand + feldlaenge + 3  CAND
+  y > bildrand  CAND  y + y len = bildrand + bildlaenge + 1 .
+ 
+aktuelles editorbild einschraenken :
+  kurze feldlaenge := x - rand - 3;
+  kurze bildlaenge := y - bildrand - 1 .
+
+arbeitspunkt in das restbild positionieren :
+  IF   stelle > 3
+  THEN stelle DECR 3; alte stelle := stelle
+  ELSE WHILE zeilennr > 1 AND zeilennr > kurze bildlaenge REP
+         vorgaenger
+       PER; old lineno := satznr 
+  FI .
+ 
+abgrenzung beruecksichtigen :
+  IF   x - rand > 1
+  THEN balken malen;
+       x INCR 2;
+       x len DECR 2
+  FI .
+ 
+balken malen :
+  INT VAR i;
+  FOR i FROM 0 UPTO y len-1 REP
+    cursor (x, y+i); out (kloetzchen)                                (*sh*)
+  PER .
+ 
+kloetzchen : IF mark size > 0 THEN ""15""14"" ELSE ""15" "14" " FI .
+
+aktuellen zustand retten :
+  IF   actual editor > 0
+  THEN dateizustand retten;
+       editstack (actual editor).feldstatus := feldstatus;
+       editstack (actual editor).bildstatus := bildstatus;
+       einrueckstack (actual editor) := alte einrueckposition
+  FI .
+ 
+neuen zustand setzen :
+  FRANGE VAR frange;
+  feldstatus := FELDSTATUS :
+    (1, 1, x-1, 0, 1, 0, x len-2, 0, FALSE, TRUE, access, "");
+  bildstatus := BILDSTATUS :
+    (x len-2, x len-2, y, y len-1, y len-1, ueberschrift, bild, 
+     0, 0, 1, 0, 0, FALSE, FALSE, "", "", "", "", "", frange, new file);
+  alte einrueckposition := 1;
+  dateizustand holen;
+  ueberschrift initialisieren .
+ 
+neues editorbild zeigen :
+  ueberschrift zeigen; fenster zeigen
+END PROC open editor;
+ 
+PROC open editor (INT CONST i) :
+  IF   i < 1 OR i > max used editor
+  THEN errorstop ("Editor nicht eroeffnet")
+  ELIF actual editor <> i
+  THEN switch editor
+  FI .
+ 
+switch editor :
+  aktuellen zustand retten;
+  actual editor := i;
+  neuen zustand setzen;
+  IF   kein platz mehr fuer restfenster
+  THEN eingeschachtelte editoren vergessen;
+       bildeinschraenkung aufheben
+  ELSE neu (nix, nix)
+  FI .
+
+aktuellen zustand retten :
+  IF   actual editor > 0
+  THEN editstack (actual editor).feldstatus := feldstatus;
+       editstack (actual editor).bildstatus := bildstatus;
+       einrueckstack (actual editor) := alte einrueckposition;
+       dateizustand retten
+  FI .
+ 
+neuen zustand setzen :
+  feldstatus := editstack (i).feldstatus;
+  bildstatus := editstack (i).bildstatus;
+  alte einrueckposition := einrueckstack (i);
+  dateizustand holen .
+
+kein platz mehr fuer restfenster :
+  kurze feldlaenge < 1 AND kurze bildlaenge < 1 .
+ 
+eingeschachtelte editoren vergessen :
+  IF actual editor < max used editor
+    THEN open editor (actual editor + 1) ;
+         quit
+  FI ;
+  open editor (i) .
+
+bildeinschraenkung aufheben :
+  laenge := feldlaenge;
+  kurze feldlaenge := feldlaenge;
+  kurze bildlaenge := bildlaenge;
+  neu (ueberschrift, bild) .
+END PROC open editor;
+ 
+FILE PROC editfile :
+  IF   actual editor = 0 OR editget modus
+  THEN errorstop ("Editor nicht eroeffnet")
+  FI ; file
+END PROC editfile;
+
+PROC get window (INT VAR x, y, x size, y size) :
+  x := rand + 1;
+  y := bildrand;
+  x size := feldlaenge + 2;
+  y size := bildlaenge + 1
+ENDPROC get window;
+
+(************************* Zugriff auf Bildstatus *************************).
+
+feldlaenge          : bildstatus.feldlaenge .
+kurze feldlaenge    : bildstatus.kurze feldlaenge .
+bildrand            : bildstatus.bildrand .
+bildlaenge          : bildstatus.bildlaenge .
+kurze bildlaenge    : bildstatus.kurze bildlaenge .
+ueberschriftbereich : bildstatus.ueberschriftbereich .
+bildbereich         : bildstatus.bildbereich .
+erster neusatz      : bildstatus.erster neusatz .
+letzter neusatz     : bildstatus.letzter neusatz .
+old zeilennr        : bildstatus.old zeilennr .
+old lineno          : bildstatus.old lineno .
+old mark lineno     : bildstatus.old mark lineno .
+zeileneinfuegen     : bildstatus.zeileneinfuegen .
+old line update     : bildstatus.old line update .
+satznr pre          : bildstatus.satznr pre .
+ueberschrift pre    : bildstatus.ueberschrift pre .
+ueberschrift text   : bildstatus.ueberschrift text .
+ueberschrift post   : bildstatus.ueberschrift post .
+old satz            : bildstatus.old satz .
+old range           : bildstatus.old range .
+file                : bildstatus.file .
+
+END PACKET editor paket;
+
diff --git a/system/base/1.7.5/src/elan do interface b/system/base/1.7.5/src/elan do interface
new file mode 100644
index 0000000..72026a7
--- /dev/null
+++ b/system/base/1.7.5/src/elan do interface
@@ -0,0 +1,57 @@
+
+PACKET elan do interface DEFINES                  (*Autor: J.Liedtke *)
+                                                  (*Stand: 08.11.85  *)
+    do ,
+    no do again :
+ 
+ 
+LET no ins = FALSE ,
+    no lst = FALSE ,
+    no check = FALSE ,
+    no sermon = FALSE ,
+    compile line mode = 2 ,
+    do again mode = 4 ,
+    max command length = 2000 ;
+
+
+INT VAR do again mod nr := 0 ;
+TEXT VAR previous command := "" ;
+
+DATASPACE VAR ds ;
+
+ 
+PROC do (TEXT CONST command) :
+
+  enable stop ;
+  IF LENGTH command > max command length
+    THEN errorstop ("Kommando zu lang")
+  ELIF do again mod nr <> 0 AND command = previous command
+    THEN do again
+    ELSE previous command := command ;
+         compile and execute
+  FI .
+
+do again :
+  elan (do again mode, ds, "", do again mod nr,
+        no ins, no lst, no check, no sermon) .
+
+compile and execute :
+  elan (compile line mode, ds, command, do again mod nr,
+        no ins, no lst, no check, no sermon) .
+
+ENDPROC do ;
+ 
+PROC no do again :
+
+  do again mod nr := 0 
+
+ENDPROC no do again ;
+ 
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 
+           INT VAR start module number,
+           BOOL CONST ins, lst, rt check, ser) :
+  EXTERNAL 256
+ENDPROC elan ;
+
+ENDPACKET elan do interface ;
+
diff --git a/system/base/1.7.5/src/error handling b/system/base/1.7.5/src/error handling
new file mode 100644
index 0000000..34db65d
--- /dev/null
+++ b/system/base/1.7.5/src/error handling
@@ -0,0 +1,142 @@
+
+PACKET error handling DEFINES
+ 
+    enable stop ,
+    disable stop ,
+    is error ,
+    clear error ,
+    errormessage ,
+    error code ,
+    error line ,
+    put error ,
+    errorstop ,
+    stop :
+ 
+ 
+LET cr lf            = ""13""10"" ,
+    line nr field    = 1 ,
+    error line field = 2 ,
+    error code field = 3 ,
+    syntax error code= 100 ,
+
+    error pre        = ""7""13""10""5"FEHLER : " ;
+
+
+TEXT VAR errortext := "" ;
+ 
+ 
+PROC enable stop :
+  EXTERNAL 75
+ENDPROC enable stop ;
+
+PROC disable stop :
+  EXTERNAL 76
+ENDPROC disable stop ;
+
+PROC set error stop (INT CONST code) :
+  EXTERNAL 77
+ENDPROC set error stop ;
+ 
+BOOL PROC is error : 
+  EXTERNAL 78
+ENDPROC is error ; 
+ 
+PROC clear error :
+  EXTERNAL 79
+ENDPROC clear error ;
+
+PROC select error message :
+
+  SELECT error code OF
+    CASE 1 : error text := "'halt' vom Terminal"
+    CASE 2 : error text := "Stack-Ueberlauf"
+    CASE 3 : error text := "Heap-Ueberlauf"
+    CASE 4 : error text := "INT-Ueberlauf"
+    CASE 5 : error text := "DIV durch 0"
+    CASE 6 : error text := "REAL-Ueberlauf"
+    CASE 7 : error text := "TEXT-Ueberlauf"
+    CASE 8 : error text := "zu viele DATASPACEs"
+    CASE 9 : error text := "Ueberlauf bei Subskription"
+    CASE 10: error text := "Unterlauf bei Subskription"
+    CASE 11: error text := "falscher DATASPACE-Zugriff"
+    CASE 12: error text := "INT nicht initialisiert"
+    CASE 13: error text := "REAL nicht initialisiert"
+    CASE 14: error text := "TEXT nicht initialisiert"
+    CASE 15: error text := "nicht implementiert"
+    CASE 16: error text := "Block unlesbar"
+    CASE 17: error text := "Codefehler"
+  END SELECT 
+
+ENDPROC select error message ;
+
+TEXT PROC error message : 
+ 
+  select error message ;
+  error text
+ 
+ENDPROC error message ;
+ 
+INT PROC error code :
+
+  pcb (error code field) 
+
+ENDPROC error code ;
+
+INT PROC error line :
+ 
+  IF is error
+    THEN pcb (error line field)
+    ELSE 0
+  FI
+ 
+ENDPROC error line ;
+ 
+PROC syntax error (TEXT CONST message) :
+
+  INTERNAL 259 ;
+  errorstop (syntax error code, message) .
+
+ENDPROC syntax error ;
+
+PROC errorstop (TEXT CONST message) :
+
+  errorstop (0, message) ;
+
+ENDPROC errorstop ;
+
+PROC errorstop (INT CONST code, TEXT CONST message) :
+
+  IF NOT is error
+    THEN error text := message ;
+         set error stop (code)
+  FI
+
+ENDPROC errorstop ;
+ 
+PROC put error :
+ 
+  IF is error
+    THEN select error message ;
+         IF error text <> ""
+           THEN put error message
+         FI
+  FI .
+ 
+put error message :
+  out (error pre) ;
+  out (error text) ;
+  IF error line > 0
+    THEN out (" bei Zeile "); out (text (error line)) ;
+  FI ; 
+  out (cr lf) .
+
+ENDPROC put error ;
+ 
+PROC stop :
+
+  errorstop ("stop")
+
+ENDPROC stop ;
+
+ENDPACKET error handling ;
+
diff --git a/system/base/1.7.5/src/eumel coder part 1 b/system/base/1.7.5/src/eumel coder part 1
new file mode 100644
index 0000000..83974f7
--- /dev/null
+++ b/system/base/1.7.5/src/eumel coder part 1
@@ -0,0 +1,866 @@
+PACKET eumel coder part 1                          (* Autor: U. Bartling *) 
+       DEFINES run, run again, 
+               insert,
+               prot, prot off,
+               check, check on, check off,
+               warnings, warnings on, warnings off, 
+
+               help, bulletin, packets 
+               : 
+ 
+(**************************************************************************)
+(*                                                                        *) 
+(*                         E U M E L  -  C O D E R                        *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(*   Zur Beschreibung des Coders siehe                                    *) 
+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 
+(*                                                                        *) 
+(*   Stand der Dokumentation  : 13.02.1986                                *) 
+(*   Stand der Implementation : 16.04.1986                                *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+                   (***** Globale Variable *****) 
+
+TEXT VAR object name;
+ 
+FILE VAR bulletin file; 
+ 
+INT VAR hash table pointer, nt link, permanent pointer, param link,
+        index, mode, word;
+ 
+BOOL VAR found, end of params;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  1. Interface zum ELAN-Compiler            10.04.1986  *) 
+(*                              1.7.5.4                                   *)
+(*                                                                        *) 
+(*   Beschreibung der      Tabellen (-groessen),                          *) 
+(*                         internen Vercodung von Typen                   *) 
+(*                    und  Kennungen .                                    *) 
+(*   Initialisieren und Beenden des Compilers,                            *) 
+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+LET  begin of hash table         =     0 ,
+     end of hash table           =  1023 ,
+ 
+     begin of permanent table    = 22784 ,
+       before first pt entry     = 22784 ,
+       first permanent entry     = 22785 ,
+     end of permanent table      = 32767 , 
+
+     wordlength                  =     1 ,  (* compile  u n d  run time *)
+     two word length             =     2 ,
+     three word length           =     3 ,
+ 
+     permanent param const             = 10000 ,
+     permanent param var               = 20000 ,
+     permanent proc op                 = 30000 ,
+     permanent type                    = 30000 ,
+     permanent row                     =    10 ,
+     permanent struct                  =    11 ,
+     permanent param proc              =    12 ,
+(*   permanent param proc end marker   =     0 , *)
+     permanent type field              =     0 ,
+
+     ptt limit                         = 10000 ,
+     begin of pt minus ptt limit       = 12784 ,
+ 
+     void                              =     0 ,
+     int                               =     1 ,
+     real                              =     2 ,
+     string                            =     3 ,
+     bool                              =     5 ,
+     bool result                       =     6 ,
+     dataspace                         =     7 ,
+     row                               =    10 ,
+     struct                            =    11 ,
+
+     const                             =     1 , 
+     var                               =     2 ,
+(*   proc                              =     3 , *)
+(*   denoter                           =     5 , *)
+     bold                              =     2 ,
+ 
+     ins                               = TRUE ,
+     no ins                            = FALSE ,
+     no lst                            = FALSE ,
+     sermon                            = TRUE  ,
+     no sermon                         = FALSE ,
+ 
+     run again mode                    =     0 ,
+     compile file mode                 =     1 ,
+
+     warning message                   =     2 , 
+     error message                     =     4 ,
+ 
+     point line                        = "..............." ;
+ 
+INT CONST permanent packet            :=     -2 ,
+          permanent end               :=     -3 ;
+
+
+INT  VAR run again mod nr             :=     0 ;
+ 
+ 
+                     (***** Start/Ende *****)
+ 
+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 
+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :
+  EXTERNAL 256
+ENDPROC elan ;
+ 
+                   (***** Hash/Namenstabelle *****) 
+.
+next hash entry :
+     hash table pointer INCR wordlength .
+
+end of hash table reached :
+     hash table pointer > end of hash table .
+
+yet another nt entry :
+     nt link := cdb int (nt link) ;
+     nt link <> 0 . ;
+ 
+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 
+    EXTERNAL 10031
+ENDPROC declare object ; 
+ 
+PROC to object (TEXT CONST searched object) : 
+     hash ;
+     search nt entry .
+
+hash :
+     hash code := 0 ;
+     FOR index FROM 1 UPTO LENGTH searched object REP
+         addmult cyclic
+     ENDREP .
+
+addmult cyclic :
+     hash code INCR hash code ;
+     IF hash code > end of hash table THEN wrap around FI ;
+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .
+
+wrap around :
+     hash code DECR end of hash table .
+
+hash code : nt link .
+
+search nt entry :
+     found := FALSE ;
+     WHILE yet another nt entry REP
+          read current entry ;
+          IF object name = searched object 
+             THEN found := TRUE ;
+                  LEAVE to object
+          FI
+     PER .
+
+read current entry :
+     permanent pointer := cdb int (nt link + wordlength) ;
+     object name := cdb text (nt link + two word length)
+ENDPROC to object ;
+
+
+                 (***** Permanent Tabelle *****) 
+.
+next procedure :
+     permanent pointer := cdb int (permanent pointer) . ;
+
+PROC next pt param :
+     mode := cdb int (param link) MOD ptt limit ;
+     param link INCR wordlength ;
+     IF   mode = permanent row    THEN skip over permanent row 
+     ELIF mode = permanent struct THEN skip over permanent struct
+     FI ;
+     set end marker if end of list .
+
+skip over permanent row :
+     param link INCR wordlength ;
+     next pt param .
+
+skip over permanent struct :
+     REP
+         next pt param ;
+         mode := cdb int (param link)
+     UNTIL mode = permanent type field PER ;
+     param link INCR wordlength
+ENDPROC next pt param ;
+
+PROC set end marker if end of list :
+     mode := cdb int (param link) ;
+     end of params := mode >= permanent proc op OR mode <= 0 
+ENDPROC set end marker if end of list ;
+
+PROC get type and mode (INT VAR type) : 
+     mode := cdb int (param link) ;
+     IF mode = permanent param proc THEN type of param proc
+                                    ELSE type of object
+     FI .
+
+type of param proc : 
+     param link INCR wordlength ;
+     get type and mode (type) ;
+     mode := permanent param proc .
+
+type of object :
+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;
+                      mode := 0
+                 ELSE type := mode MOD ptt limit ;
+                      mode DECR type ;
+                      translate type if necessary ;
+                      translate mode if necessary 
+     FI .
+
+translate type if necessary :
+     IF permanent row or struct THEN translate type FI .
+
+translate type :
+     type := param link - begin of pt minus ptt limit .
+
+translate mode if necessary : 
+    IF   mode = permanent param const THEN mode := const
+    ELIF mode = permanent param var   THEN mode := var
+    FI .
+
+permanent row or struct :
+     type = permanent row OR type = permanent struct
+ENDPROC get type and mode ;
+ 
+
+                 (***** Allgemeine Zugriffsprozeduren *****) 
+
+INT PROC cdb int (INT CONST index) :
+   EXTERNAL 116
+ENDPROC cdb int ;
+
+TEXT PROC cdb text (INT CONST index) :
+   EXTERNAL 117
+ENDPROC cdb text ;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 10. Inspector                              16.04.1986  *)
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+INT VAR line number, pattern length, packet link,
+        begin of packet, last packet entry, indentation;
+
+TEXT VAR bulletin name, type and mode, pattern, buffer;
+ 
+DATASPACE VAR bulletin ds :: nilspace ;
+
+.packet name :
+     cdb text (cdb int(packet link + wordlength) + two word length) .
+
+.within editor :
+    aktueller editor > 0 .  ;
+
+PROC name of type (INT CONST type) :
+            SELECT type OF
+     CASE void              :
+     CASE int               : type and mode CAT "INT"
+     CASE real              : type and mode CAT "REAL"
+     CASE string            : type and mode CAT "TEXT"
+     CASE bool, bool result : type and mode CAT "BOOL"
+     CASE dataspace         : type and mode CAT "DATASPACE"
+     CASE row               : type and mode CAT "ROW "
+     CASE struct            : type and mode CAT "STRUCT"
+     OTHERWISE              : complex type
+            ENDSELECT .
+
+complex type :
+     IF type > ptt limit THEN perhaps permanent struct or row
+                         ELSE get complex type
+     FI .
+
+perhaps permanent struct or row :
+     index := type + begin of pt minus ptt limit ;
+     mode := cdb int (index) MOD ptt limit ;
+     IF   mode = permanent row    THEN get permanent row 
+     ELIF mode = permanent struct THEN get permanent struct
+                                  ELSE type and mode CAT "-"
+     FI .
+
+get complex type :
+     index := type + begin of permanent table ;
+     IF is complex type THEN get name
+                        ELSE type and mode CAT "-"
+     FI .
+
+is complex type :
+     permanent type definition mode = permanent type .
+
+get name :
+     type and mode CAT cdb text (link to type name + two word length) .
+
+link to type name :
+     cdb int (index + three word length) .
+
+permanent type definition mode :
+     cdb int (index + wordlength) .
+
+get permanent row :
+     INT VAR t; 
+     type and mode CAT "ROW " ;
+     type and mode CAT text (cdb int (index + wordlength)) ;
+     type and mode CAT " " ;
+     param link := index + two wordlength ;
+     get type and mode (t) ;
+     name of type (t) .
+ 
+get permanent struct :
+     type and mode CAT "STRUCT ( ... )" 
+ENDPROC name of type ;
+
+PROC help (TEXT CONST proc name) :
+     prep bulletin ;
+     prep help ;
+     scan (object name) ;
+     next symbol (pattern) ;
+     packet link := end of permanent table ;
+     IF function = 0 THEN standard help
+                     ELSE asterisk help
+     FI .
+
+prep help :
+     object name := compress (proc name) ;
+     INT VAR function :: 0 ;
+     INT CONST l :: LENGTH object name ;
+     IF l > 1 AND object name <> "**"
+        THEN IF (object name SUB l) = "*"
+               THEN function INCR 2 ;
+                    delete char (object name, l)
+             FI ;
+             IF (object name SUB 1) = "*"
+               THEN function INCR 1 ;
+                    delete char (object name, 1)
+             FI ;
+             IF another asterisk THEN wrong function FI
+     FI.
+
+another asterisk :
+     pos (object name, "*") <> 0 .
+
+wrong function :
+     errorstop ("unzulaessige Sternfunktion") .
+
+standard help :
+     to object (pattern) ;
+     IF found THEN display
+              ELSE error stop ("unbekannt: " + proc name)
+     FI .
+
+display :
+     WHILE permanent pointer <> 0 REP
+         put name of packet if necessary ;
+         put specifications (pattern) ;
+         next procedure
+     ENDREP ;
+     show bulletin file .
+ 
+put name of packet if necessary :
+     IF new packet THEN packet link := permanent pointer ;
+                        find begin of packet ;
+                        writeline (2) ;
+                        write packet name
+     FI .
+
+find begin of packet :
+     REP 
+         packet link DECR wordlength
+     UNTIL begin of packet found PER .
+
+begin of packet found :
+     cdb int (packet link) = permanent packet .
+
+new packet :
+     permanent pointer < packet link .
+
+asterisk help :
+     hash table pointer := begin of hash table ;
+     pattern length := LENGTH pattern - 1 ;
+     REP
+        list all objects in current hash table chain ;
+        next hash entry
+     UNTIL end of hash table reached ENDREP ;
+     show bulletin file .
+
+list all objects in current hash table chain :
+     nt link := hash table pointer ;
+     WHILE yet another nt entry REP
+        permanent pointer := cdb int (nt link + wordlength) ;
+        object name := cdb text (nt link + two word length) ;
+        IF matching THEN into bulletin FI
+     PER .
+
+matching :
+     INT CONST p :: pos (object name, pattern) ;
+     SELECT function OF
+         CASE 1 :   p <> 0 AND p = LENGTH object name - pattern length
+         CASE 2 :   p = 1
+         CASE 3 :   p <> 0
+         OTHERWISE  FALSE
+     ENDSELECT .
+
+into bulletin :
+     object names into bulletin (BOOL PROC not end of chain)
+ENDPROC help ;
+ 
+BOOL PROC not end of chain :
+     permanent pointer <> 0 
+ENDPROC not end of chain ;
+
+PROC write packet name :
+     indentation := 0 ;
+     write line ;
+     write bulletin line ("PACKET ") ;
+     indentation := 7 ;
+     object name := packet name ;
+     write bulletin line (object name) ;
+     write bulletin line (":") ;
+     writeline (2)
+ENDPROC write packet name ;
+
+PROC put specifications (TEXT CONST proc name) :
+     put obj name (proc name) ;
+     to first param ;
+     IF NOT end of params THEN put param list FI ;
+     put result ;
+     writeline .
+ 
+to first param :
+     param link := permanent pointer + word length ;
+     set end marker if end of list .
+
+put result :
+     INT VAR type;
+     get type and mode (type) ;
+     IF type <> void THEN type and mode := "  --> " ;
+                          name of type (type) ;
+                          write bulletin line (type and mode)
+     FI
+ENDPROC put specifications ;
+
+PROC put param list : 
+     write bulletin line (" (") ;
+     REP
+         INT VAR type, param mode;
+         get type and mode (type) ;
+         param mode := mode ;
+         put type and mode ;
+         maybe param proc ;
+         next pt param ;
+         IF end of params THEN write bulletin line (")") ;
+                               LEAVE put param list 
+         FI ;
+         write bulletin line (", ") ;
+     PER .
+
+put type and mode :
+     type and mode := "" ;
+     name of type (type) ;
+     type and mode CAT name of mode ;
+     write bulletin line (type and mode) .
+
+name of mode :
+     IF   param mode = const THEN " CONST"
+     ELIF param mode = var   THEN " VAR"
+                             ELSE " PROC"
+     FI .
+
+maybe param proc :
+     IF mode = permanent param proc THEN put virtual params FI .
+
+put virtual params :
+     skip over result type if complex type ;
+     IF NOT end of virtual params THEN put param list FI.
+
+skip over result type if complex type :
+     next pt param .
+
+end of virtual params :
+    end of params
+ENDPROC put param list ;
+
+PROC next packet :
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF   word = permanent packet THEN true return
+         ELIF end of permanents       THEN false return
+         FI ;
+     ENDREP .
+
+true return :
+     found := TRUE ;
+     LEAVE next packet .
+
+false return :
+     found := FALSE ;
+     LEAVE next packet .
+
+end of permanents :
+     word = permanent end OR packet link > end of permanent table 
+ENDPROC next packet ;
+
+PROC prep bulletin :
+     forget (bulletin ds) ;
+     bulletin ds := nilspace ;
+     bulletin file := sequential file (output, bulletin ds) ;
+     line number := 0 ;
+     buffer := ""
+ENDPROC prep bulletin ;
+
+PROC show bulletin file :
+     IF within editor THEN ueberschrift neu FI ;
+     DATASPACE VAR local ds :: bulletin ds ;
+     FILE VAR local file :: sequential file (modify, local ds) ;
+     show (local file) ;
+     forget (local ds)
+ENDPROC show bulletin file ;
+
+PROC write bulletin line (TEXT CONST line) :
+     IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ;
+     buffer CAT line
+ENDPROC write bulletin line ;
+
+PROC writeline  :
+     write (bulletin file, buffer) ;
+     line (bulletin file) ;
+     line number INCR 1 ;
+     cout (line number) ;
+     buffer := indentation * " "
+ENDPROC writeline ;
+
+PROC writeline (INT CONST times) :
+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;
+                                          writeline
+                                     ELSE index := times
+     FI ;
+     line (bulletin file, index) ;
+     line number INCR index;
+     indentation := 0 ;
+     cout (line number)
+ENDPROC writeline ;
+ 
+PROC bulletin (TEXT CONST packet name) :
+     prep bulletin ;
+     scan (packet name) ;
+     next symbol (pattern) ;
+     to packet ; 
+     IF found THEN list packet ;
+                   show bulletin file
+              ELSE error stop (packet name + " ist kein Paketname")
+     FI . 
+ 
+to packet :
+     last packet entry := 0 ;
+     get nametab link of packet name ;
+     packet link := before first pt entry ;
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF word < 0 THEN IF   word = permanent packet THEN packet found
+                          ELIF word = permanent end    THEN return
+                          FI
+         FI
+     ENDREP .
+
+get nametab link of packet name :
+     to object (pattern) ;
+     IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ;
+                       LEAVE to packet
+     FI .
+
+packet found :
+     IF cdb int (packet link + wordlength) = nt link
+        THEN last packet entry := packet link FI .
+
+return : 
+     IF last packet entry <> 0 THEN found := TRUE ;
+                                    packet link := last packet entry
+                               ELSE found := FALSE
+     FI ;
+     LEAVE to packet
+ENDPROC bulletin ;
+ 
+PROC list packet :
+     begin of packet := packet link + word length ;
+     write packet name ; 
+     find end of packet ;
+     run through nametab and list all packet objects .
+ 
+find end of packet :
+     last packet entry := begin of packet ;
+     REP
+         last packet entry INCR wordlength ;
+         word := cdb int (last packet entry) ;
+     UNTIL end of packet entries PER .
+
+end of packet entries :
+     word = permanent packet OR word = permanent end .
+
+run through nametab and list all packet objects :
+     hashtable pointer := begin of hashtable ;
+     REP
+         nt link := hashtable pointer ;
+         list objects of current packet in this chain ;
+         next hash entry
+     UNTIL end of hashtable reached ENDREP .
+
+list objects of current packet in this chain :
+     WHILE yet another nt entry REP 
+         permanent pointer := cdb int (nt link + wordlength) ;
+         put objects of this name
+     PER .
+
+put objects of this name :
+     IF there is at least one object of this name in the current packet
+       THEN into bulletin FI .
+
+there is at least one object of this name in the current packet :
+     REP
+        IF permanent pointer >= begin of packet AND
+           permanent pointer < last packet entry
+           THEN LEAVE there is at least one object of this name
+                      in the current packet WITH TRUE FI ;
+        next procedure
+     UNTIL permanent pointer = 0 PER ;
+     FALSE .
+
+into bulletin :
+     object name := cdb text (nt link + two word length) ;
+     object names into bulletin (BOOL PROC within packet)
+ENDPROC list packet ;
+
+BOOL PROC within packet :
+     permanent pointer >= begin of packet AND 
+     permanent pointer < last packet entry
+ENDPROC within packet ;
+
+PROC object names into bulletin (BOOL PROC link ok) :
+     scan (object name) ;
+     next symbol (object name, mode) ;
+     IF type definition THEN put type definition
+                        ELSE put object definitions
+     FI .
+
+type definition :
+     mode = bold AND no params .
+
+no params :
+     cdb int (permanent pointer + word length) >= permanent type .
+
+put type definition :
+     put obj name (object name) ;
+     write bulletin line ("TYPE ") ;
+     writeline (1) .
+
+put object definitions :
+     WHILE link ok REP
+         put specifications (object name) ;
+         next procedure
+     ENDREP 
+ENDPROC object names into bulletin ;
+ 
+PROC bulletin :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         list packet ;
+         write line (4) ;
+         next packet
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC bulletin ;
+
+PROC put obj name (TEXT CONST name) :
+     buffer := "      " ;
+     bulletin name := point line ;
+     change (bulletin name, 1, end of line or name, name) ;
+     buffer CAT bulletin name ;
+     indentation := LENGTH buffer + 1 .
+
+end of line or name :
+     min (LENGTH name, LENGTH bulletin name)
+ENDPROC put obj name ;
+
+PROC packets :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         object name := packet name ;
+         put obj name (object name) ;
+         write line ;
+         next packet 
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC packets ;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 11. ELAN Run-Interface                     09.01.1986  *) 
+(*                                                                        *) 
+(*   Uebersetzen von ELAN-Programmen                                      *) 
+(*   Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler           *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+ 
+BOOL VAR list option     := FALSE ,
+         check option    :=  TRUE ,
+         warning option  := FALSE , 
+         listing enabled := FALSE ;
+
+FILE VAR listing file ;
+
+TEXT VAR listing file name := "" ;
+ 
+ 
+PROC run (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, no ins)
+END PROC run;
+ 
+PROC run :
+  run (last param)
+ENDPROC run ;
+ 
+PROC run again :
+  IF run again mod nr <> 0
+    THEN elan (run again mode, bulletin file, "", run again mod nr, 
+               no ins, no lst, check option, no sermon)
+    ELSE errorstop ("'run again' nicht moeglich")
+  FI
+ENDPROC run again ;
+ 
+PROC insert (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, ins)
+ENDPROC insert ;
+ 
+PROC insert :
+  insert (last param)
+ENDPROC insert ;
+ 
+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :
+  FILE VAR source := sequential file (modify, file name) ;
+  IF listing enabled
+    THEN open listing file
+  FI ;
+
+  disable stop ;
+  no do again ;
+  elan (compile file mode, source, "" , run again mod nr,
+        insert option, list option, check option, sermon) ;
+ 
+  IF anything noted AND command dialogue
+    THEN ignore halt during compiling ;
+         note edit (source) ;
+         last param (file name) ; 
+         errorstop ("")
+  FI .
+
+ignore halt during compiling :
+  IF is error
+    THEN put error ;
+         clear error ;
+         pause (5)
+  FI .
+
+open listing file :
+  listing file := sequential file (output, listing file name) ;
+  max line length (listing file, 130)
+
+ENDPROC run elan ;
+
+PROC out text (TEXT CONST text, INT CONST out type) :
+  INTERNAL 257 ; 
+  IF online
+    THEN out (text)
+  FI ;
+  IF out type = error message OR (warning option AND out type = warning message) 
+    THEN note (text) ; 
+  FI ;
+  IF listing enabled
+    THEN write (listing file, text)
+  FI
+ENDPROC out text ;
+
+PROC out line (INT CONST out type) :
+  INTERNAL 258 ; 
+  IF online
+    THEN out (""13""10"")
+  FI ;
+  IF out type = error message
+       OR (warning option AND out type = warning message)
+    THEN note line
+  ELIF listing enabled
+    THEN line (listing file)
+  FI
+ENDPROC out line ;
+
+PROC prot (TEXT CONST file name) :
+  list option := TRUE ;
+  listing file name := file name ;
+  listing enabled := TRUE
+ENDPROC prot ;
+ 
+PROC prot off :
+  list option := FALSE ;
+  listing enabled := FALSE
+ENDPROC prot off ;
+
+BOOL PROC prot :
+  list option
+ENDPROC prot ;
+ 
+PROC check on :
+  check option := TRUE
+ENDPROC check on ;
+ 
+PROC check off :
+  check option := FALSE
+ENDPROC check off ;
+ 
+BOOL PROC check :
+  check option
+ENDPROC check ;
+
+PROC warnings on :                    
+  warning option := TRUE    
+ENDPROC warnings on ;    
+ 
+PROC warnings off : 
+  warning option := FALSE 
+ENDPROC warnings off ; 
+ 
+BOOL PROC warnings : 
+  warning option 
+ENDPROC warnings ; 
+ 
+ENDPACKET eumel coder part 1 ;
+
diff --git a/system/base/1.7.5/src/file b/system/base/1.7.5/src/file
new file mode 100644
index 0000000..530dcb3
--- /dev/null
+++ b/system/base/1.7.5/src/file
@@ -0,0 +1,2122 @@
+(* ------------------- VERSION 35     02.06.86 ------------------- *)
+PACKET file handling DEFINES     (* Autoren: J.Liedtke, D.Martinek *)
+       (***********) 
+ 
+       FILE,
+       :=,
+       sequential file,
+       reorganize,
+       input,
+       output,
+       modify,
+       close,
+       putline,
+       getline,
+       put,
+       get,
+       write ,
+       line,
+       reset,
+       down,
+       up,
+       downety,
+       uppety,
+       pattern found,
+       to first record,
+       to line,
+       to eof,
+       insert record,
+       delete record,
+       read record,
+       write record,
+       is first record,
+       eof,
+       line no,
+       FRANGE,
+       set range,
+       reset range ,
+       remove,
+       clear removed,
+       reinsert,
+       max line length,
+       edit info,
+       line type ,
+       copy attributes ,
+       headline,
+       put tabs,
+       get tabs,
+       col,
+       word,
+       at,
+       removed lines,
+       exec,
+       pos ,
+       len ,
+       subtext ,
+       change ,
+       lines ,
+       segments ,
+       mark ,
+       mark line no ,
+       mark col ,
+       set marked range ,
+       split line ,
+       concatenate line ,
+       prefix ,
+       sort ,
+       lexsort :
+
+
+(**********************************************************************)
+(*                                                                    *)
+(*  Terminologie:                                                     *)
+(*                                                                    *)
+(*                                                                    *)
+(*     ATOMROW       Menge aller Atome eines FILEs.                   *)
+(*                   Die einzelnen Atome haben zwar eine Position     *)
+(*                   im Row, aber in dieser Betrachtung keine         *)
+(*                   logische Reihenfolge.                            *)
+(*                                                                    *)
+(*     ATOM          Basiselement, kann eine Zeile der Datei und die  *)
+(*                   zugehoerige Verwaltungsinformation aufnehmen     *)
+(*                                                                    *)
+(*     CHAIN         Zyklisch geschlossene Kette von Segmenten.       *)
+(*                                                                    *)
+(*     SEGMENT       Teilbereich des Atomrows, enthaelt 1 oder mehr   *)
+(*                   zusammenhaengende Atoms.                         *)
+(*                   Jedes Segment hat ein Vorgaenger- und ein        *)
+(*                   Nachfolgersegment.                               *)
+(*                   Jedes Segment enthaelt einen logisch zumsammen-  *)
+(*                   haengenden Teile einer Sequence.                 *)
+(*                                                                    *)
+(*     SEQUENCE      Logische Folge von Lines.                        *)
+(*                   Jede Sequence ist Teil einer Chain oder besteht  *)
+(*                   vollstaendig daraus:                             *)
+(*                                                                    *)
+(*                        SEG1--SEG2--SEG3--SEG4--SEG5                *)
+(*                          :----sequence----:                        *)
+(*                                                                    *)
+(*                   Die 'Reihenfolge' ebenso wie die 'Anzahl' der    *)
+(*                   Lines ist eine wesentliche Eigenschaft einer     *)
+(*                   Sequence.                                        *)
+(*                                                                    *)
+(*     LINE          Ein Atom als Element ein Sequence betrachtet.    *)
+(*                                                                    *)
+(*                                                                    *)
+(**********************************************************************)
+(*                                                                    *)
+(* Eigenschaften:                                                     *)
+(*                                                                    *)
+(*     Folgende Mengen bilden eine Zerlegung (im math. Sinn) einer    *)
+(*     gesamten Datei:                                                *)
+(*                        used segment chain                          *)
+(*                        scratch segment chain                       *)
+(*                        free segment chain                          *)
+(*                        unused tail                                 *)
+(*                                                                    *)
+(*     Fuer jedes X aus (used, scratch, free) gelten:                 *)
+(*                                                                    *)
+(*     'X sequence' ist echte Teilmenge von 'X segment chain'.        *)
+(*                                                                    *)
+(*                       (Daraus folgt, es gibt keine leere 'chain'.) *)
+(*                                                                    *)
+(*     'X segment chain' ist zyklisch gekettet.                       *)
+(*                                                                    *)
+(*     Alle Atome von 'X segment chain' haben definierten Inhalt.     *)
+(*                                                                    *)
+(**********************************************************************)
+ 
+ 
+LET file size    = 4075 ,
+    nil          = 0 ,
+ 
+    free root    = 1 ,
+    scratch root = 2 ,
+    used root    = 3 ,
+    first unused = 4 ;
+ 
+ 
+LET SEQUENCE = STRUCT (INT index, segment begin, segment end,
+                       INT line no, lines),
+    SEGMENT  = STRUCT (INT succ, pred, end),
+    ATOM     = STRUCT (SEGMENT seg, INT type, TEXT line),
+    ATOMROW  = ROW filesize ATOM,
+ 
+    LIST     = STRUCT (SEQUENCE used, INT prefix lines, postfix lines,
+                       SEQUENCE scratch, free, INT unused tail,
+                       INT mode, col, limit, edit info, mark line, mark col,
+                       ATOMROW atoms);
+ 
+TYPE FILE = BOUND LIST ;
+ 
+TYPE FRANGE = STRUCT (INT pre, post, BOOL pre was split, post was split);
+
+
+OP := (FRANGE VAR left, FRANGE CONST right):
+  CONCR (left) := CONCR (right)
+ENDOP := ;
+
+
+OP := (FILE VAR left, FILE CONST right):
+  EXTERNAL 260
+END OP :=;
+
+
+PROC becomes (INT VAR a, b) :
+  INTERNAL 260  ;
+  a := b
+END PROC becomes;
+ 
+ 
+PROC initialize (FILE VAR f) :
+ 
+   f.used     := SEQUENCE : (used root, used root, used root, 1, 0);
+   f.prefix lines  := 0;
+   f.postfix lines := 0;
+   f.free     := SEQUENCE : (free root, free root, free root, 1, 0);
+   f.scratch  := SEQUENCE : (scratch root, scratch root, scratch root, 1, 0);
+   f.unused tail := first unused;
+
+   f.limit := 77;
+   f.edit info := 0;
+   f.col := 1 ;
+   f.mark line := 0 ;
+   f.mark col := 0 ;
+
+   INT VAR i;
+   FOR i FROM 1 UPTO 3 REP
+     root (i).seg  := SEGMENT : (i, i, i);
+     root (i).line := ""
+   PER;
+   put tabs (f, "") .
+ 
+root : f.atoms .
+ 
+END PROC initialize;
+ 
+ 
+(**********************************************************************)
+(*                                                                    *)
+(*        Segment Handler         (SEGMENTs & CHAINs)                 *)
+(*                                                                    *)
+(**********************************************************************)
+
+INT PROC segs (SEQUENCE CONST s, ATOMROW CONST atom) :
+
+  INT VAR number of segments := 0 ,
+  actual segment := s.segment begin ;
+  REP
+    number of segments INCR 1 ;
+    actual segment := atom (actual segment).seg.succ
+  UNTIL actual segment = s.segment begin PER ;
+  number of segments .
+
+ENDPROC segs ;
+
+ 
+PROC next segment (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  disable stop;
+  s.line no INCR (s.segment end - s.index + 1);
+  INT CONST new segment index := actual segment.succ;
+  s.segment begin := new segment index;
+  s.segment end   := new segment.end;
+  s.index         := new segment index .
+
+actual segment :  atom (s.segment begin).seg .
+new segment :     atom (new segment index).seg .
+ 
+END PROC next segment;
+ 
+ 
+PROC previous segment (SEQUENCE VAR s, ATOMROW CONST atom) :
+
+  disable stop;
+  s.line no DECR (s.index - s.segment begin + 1);
+  INT CONST new segment index := actual segment.pred;
+  s.segment begin := new segment index;
+  s.segment end   := new segment.end;
+  s.index         := s.segment end .
+ 
+actual segment :  atom (s.segment begin).seg .
+new segment :     atom (new segment index).seg .
+ 
+END PROC previous segment;
+ 
+ 
+PROC split segment (SEQUENCE VAR s, ATOMROW VAR atom) :
+
+  disable stop;
+  IF not at segment top
+    THEN split segment at actual position
+  FI .
+
+split segment at actual position :
+  INT CONST pred index   := s.segment begin,
+            actual index := s.index,
+            succ index   := pred.succ;
+
+  actual.pred  := pred index;
+  actual.succ  := succ index;
+  actual.end   := s.segment end;
+ 
+  pred.succ    := actual index;
+  pred.end     := actual index - 1;
+ 
+  succ.pred    := actual index;
+ 
+  s.segment begin := actual index .
+ 
+not at segment top : s.index > s.segment begin .
+
+pred   : atom (pred index).seg .
+ 
+actual : atom (actual index).seg .
+ 
+succ   : atom (succ index).seg .
+ 
+END PROC split segment;
+ 
+
+PROC join segments (ATOMROW VAR atom,
+                    INT CONST first index, INT VAR second index) :
+ 
+  disable stop;
+  IF first seg.end + 1 = second index
+    THEN attach second to first segment
+    ELSE link first to second segment
+  FI .
+ 
+attach second to first segment :
+  first seg.end  := second seg.end;
+  INT VAR successor of second := second seg.succ;
+  IF successor of second = second index
+    THEN first seg.succ := first index
+    ELSE join segments (atom, first index, successor of second)
+  FI;
+  second index := first index .
+ 
+link first to second segment :
+  first seg.succ  := second index;
+  second seg.pred := first index .
+ 
+first seg :  atom (first index).seg .
+second seg : atom (second index).seg .
+ 
+END PROC join segments;
+ 
+ 
+PROC delete segments (SEQUENCE VAR from, ATOMROW VAR atom,
+                      INT CONST first index, last index, lines) :
+ 
+  determine surrounding segments and new atom index;
+  join surrounding segments;
+  update sequence descriptor .
+ 
+determine surrounding segments and new atom index :
+  INT VAR pred index   := first seg.pred,
+          actual index := last seg.succ;
+  from.index := actual index .
+ 
+join surrounding segments :
+  join segments (atom, pred index, actual index) .
+ 
+update sequence descriptor :
+  from.segment begin := actual index;
+  from.segment end := actual seg.end;
+  from.lines DECR lines .
+ 
+actual seg :  atom (actual index).seg .
+first seg :   atom (first index).seg .
+last seg :    atom (last index).seg .
+ 
+END PROC delete segments;
+ 
+ 
+PROC insert segments (SEQUENCE VAR into, ATOMROW VAR atom,
+                      INT CONST first index, last index, lines) :
+ 
+  join into sequence and new segments;
+  update sequence descriptor .
+ 
+join into sequence and new segments :
+  INT VAR actual index := into.index,
+          pred index   := actual seg.pred;
+  join segments (atom, last index, actual index);
+  actual index := first index;
+  join segments (atom, pred index, actual index) .
+ 
+update sequence descriptor :
+  into.index := first index;
+  into.segment begin := actual index;
+  into.segment end := actual seg.end;
+  into.lines INCR lines .
+ 
+actual seg :  atom (actual index).seg .
+ 
+END PROC insert segments;
+ 
+ 
+PROC next atom (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  IF s.line no <= s.lines
+    THEN to next atom
+    ELSE errorstop ("'down' nach Dateiende")
+  FI .
+ 
+to next atom :
+  disable stop;
+  IF s.index = s.segment end
+    THEN next segment (s, atom)
+    ELSE s.index INCR 1;
+         s.line no INCR 1
+  FI
+ 
+END PROC next atom;
+ 
+ 
+PROC next atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) :
+ 
+  INT CONST destination line := min (s.line no + times, s.lines + 1);
+  jump upto destination segment;
+  position within destination segment .
+ 
+jump upto destination segment :
+  WHILE s.line no + length of actual segments tail < destination line REP
+    next segment (s, atom);
+  PER .
+ 
+position within destination segment :
+  disable stop;
+  s.index INCR (destination line - s.line no);
+  s.line no := destination line .
+ 
+length of actual segments tail :   s.segment end - s.index .
+ 
+END PROC next atoms;
+ 
+ 
+PROC previous atom (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  IF s.line no > 1
+    THEN to previous atom
+    ELSE errorstop ("'up' am Dateianfang")
+  FI .
+ 
+to previous atom :
+  disable stop;
+  IF s.index = s.segment begin
+    THEN previous segment (s, atom)
+    ELSE s.index DECR 1;
+         s.line no DECR 1
+  FI
+ 
+END PROC previous atom;
+ 
+ 
+PROC previous atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) :
+ 
+  INT CONST destination line := max (1, s.line no - times);
+  jump back to destination segment;
+  position within destination segment .
+ 
+jump back to destination segment :
+  WHILE s.line no - length of actual segments head > destination line REP
+    previous segment (s, atom);
+  PER .
+ 
+position within destination segment :
+  disable stop;
+  s.index DECR (s.line no - destination line);
+  s.line no := destination line .
+ 
+length of actual segments head :   s.index - s.segment begin .
+ 
+END PROC previous atoms;
+
+
+TEXT VAR pre, pat, pattern0;
+INT VAR last search line ;
+
+PROC search down (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                  INT CONST max lines, INT VAR column) :
+
+  INT CONST start col := column ,
+            start line := s.lineno ;
+  last search line := min (s.lines, s.lineno + max lines) ;
+  pre:= somefix (pattern) ;
+  pattern0 := pattern ** 0 ;
+  down in atoms (s, atom, pre, column); 
+  IF NOT (last search succeeded CAND like pattern)
+    THEN try again
+  FI; 
+  last search succeeded := TRUE ;
+  column := matchpos (0) . 
+ 
+try again: 
+  WHILE s.line no < last search line
+    REP next atom (s, atom) ;
+        column := 1 ; 
+        down in atoms (s, atom, pre, column); 
+        IF last search succeeded CAND like pattern
+          THEN LEAVE try again
+        FI
+    PER; 
+    column := 1 + LENGTH record; 
+    last search succeeded := FALSE ;
+    LEAVE search down. 
+
+like pattern :
+  correct position ;
+  pat := any (column-1) ;
+  pat CAT any ;
+  pat CAT pattern0 ;
+  pat CAT any ;
+  record LIKE pat .
+
+correct position :
+  IF s.lineno = start line
+    THEN column := start col
+    ELSE column := 1
+  FI .
+
+record : atom (s.index).line .
+
+ENDPROC search down ;
+
+PROC down in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                    INT VAR column) :
+ 
+  last search succeeded := FALSE ;
+  search forwards in actual line ;
+  IF NOT found AND s.line no < last search line
+    THEN search in following lines
+  FI ;
+  IF found
+    THEN last search succeeded := TRUE
+    ELSE set column behind last char
+  FI .
+
+set column behind last char :
+  column := LENGTH atom (s.index).line + 1 .
+
+search forwards in actual line :
+  IF pattern <> ""
+    THEN column := pos (atom (s.index).line, pattern, column)
+  ELIF column > LENGTH atom (s.index).line
+    THEN column := 0
+  FI .
+
+search in following lines :
+  next atom (s, atom) ;
+  IF pattern = ""
+    THEN column := 1 ;
+         LEAVE search in following lines
+  FI ;
+  REP
+    search forwards through segment ;
+    update file position forwards ;
+    IF found OR s.line no = last search line
+      THEN LEAVE search in following lines
+      ELSE next segment (s, atom)
+    FI
+  PER .
+
+search forwards through segment :
+  INT VAR search index := s.index ,
+  last index := min (s.segment end, s.index+(last search line-s.line no));
+  REP
+    column := pos (atom (search index).line, pattern) ;
+    IF found OR search index = last index
+      THEN LEAVE search forwards through segment
+    FI ;
+    search index INCR 1
+  PER .
+
+update file position forwards :
+  disable stop ;
+  s.line no INCR (search index - s.index) ;
+  s.index := search index ;
+  enable stop .
+
+found :  column > 0 .
+
+ENDPROC down in atoms ;
+
+TEXT PROC prefix (TEXT CONST pattern) : 
+ 
+  INT VAR invalid char pos := pos (pattern, ""0"", ""31"", 1) ; 
+  SELECT invalid char pos OF  
+    CASE 0    : pattern 
+    CASE 1    : ""                                              
+    OTHERWISE : subtext (pattern, 1, invalid char pos - 1) 
+  ENDSELECT . 
+ 
+ENDPROC prefix ; 
+
+PROC search up (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                INT CONST max lines, INT VAR column) :
+
+     last search line := max (1, s.lineno - max lines) ;
+     pre:= prefix (pattern);
+     pattern0 := pattern ** 0;
+     remember start point ;
+     up in atoms (s, atom, pre, column); 
+     IF   NOT (last search succeeded CAND last pattern in line found)
+     THEN try again 
+     FI; 
+     last search succeeded := TRUE ;
+     column := matchpos (0) . 
+ 
+  try again: 
+     WHILE s.lineno > last search line OR column > 1
+     REP   previous atom (s, atom); 
+           column := LENGTH record ;
+           up in atoms (s, atom, pre, column); 
+           IF last search succeeded CAND last pattern in line found
+             THEN LEAVE try again
+           FI 
+     PER; 
+     column := 1; 
+     last search succeeded := FALSE ;
+     LEAVE search up. 
+
+  remember start point :
+     INT VAR c:= column, r:= s.lineno;.
+
+  last pattern in line found :
+    column := 2 ;
+    WHILE like pattern CAND right of start REP
+      column := matchpos (0) +1
+    PER ;
+    column DECR 1 ;
+    like pattern CAND right of start .
+
+  like pattern :
+     pat := any (column-1) ;
+     pat CAT any ;
+     pat CAT pattern0 ;
+     pat CAT any ;
+     record LIKE pat .
+
+  right of start : (r > s.lineno COR c >= matchpos(0)) .
+  record         : atom (s.index).line .
+
+ENDPROC search up ;
+
+PROC up in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                  INT VAR column) :
+
+  last search succeeded := FALSE ;
+  search backwards in actual line ;
+  IF NOT found AND s.line no > last search line
+    THEN search in preceeding lines
+  FI ;
+  IF found
+    THEN last search succeeded := TRUE
+    ELSE column := 1
+  FI .
+
+search backwards in actual line :
+  IF pattern = ""
+    THEN LEAVE search backwards in actual line
+  FI ;
+  INT VAR last pos , new pos := 0 ;
+  REP
+    last pos := new pos ;
+    new pos := pos (atom (s.index).line, pattern, last pos+1) ;
+  UNTIL new pos = 0 OR new pos > column PER ;
+  column := last pos .
+
+search in preceeding lines :
+  previous atom (s, atom) ;
+  IF pattern = ""
+    THEN column := LENGTH atom (s.index).line + 1 ;
+         last search succeeded := TRUE ;
+         LEAVE search in preceeding lines
+  FI ;
+  REP
+    search backwards through segment ;
+    update file position backwards ;
+    IF found OR s.line no = last search line
+      THEN LEAVE search in preceeding lines
+      ELSE previous segment (s, atom)
+    FI
+  PER .
+
+search backwards through segment :
+  INT VAR search index := s.index ,
+  last index := max (s.segment begin, s.index-(s.line no-last search line));
+  REP
+    new pos := 0 ;
+    REP
+      column := new pos ;
+      new pos := pos (atom (search index).line, pattern, column+1) ;
+    UNTIL new pos = 0 PER ;
+    IF found OR search index = last index
+      THEN LEAVE search backwards through segment
+    FI ;
+    search index DECR 1
+  PER .
+
+update file position backwards :
+  disable stop ;
+  s.line no DECR (s.index - search index) ;
+  s.index := search index ;
+  enable stop .
+
+found :  column > 0 .
+
+ENDPROC up in atoms ;
+
+BOOL VAR last search succeeded ;
+
+BOOL PROC pattern found :
+  last search succeeded
+ENDPROC pattern found ;
+
+
+
+PROC delete atom (SEQUENCE VAR used, free, ATOMROW VAR atom) :
+ 
+  disable stop;
+  IF used.line no <= used.lines
+    THEN delete actual atom
+    ELSE errorstop ("'delete' am Dateiende")
+  FI .
+ 
+delete actual atom :
+  position behind actual free segment;
+  split segment (used, atom);
+  INT VAR actual index := used.index;
+  cut off tail of actual used segment;
+  delete segments (used, atom, actual index, actual index, 1);
+  insert segments (free, atom, actual index, actual index, 1) .
+ 
+position behind actual free segment :
+  IF free.line no <= free.lines
+    THEN next segment (free, atom)
+  FI .
+ 
+cut off tail of actual used segment :
+  IF actual index <> used.segment end
+    THEN used.index INCR 1;
+         split segment (used, atom);
+         used.index DECR 1 
+  FI .
+ 
+END PROC delete atom;
+ 
+ 
+PROC insert atom (SEQUENCE VAR used, free,INT VAR unused, ATOMROW VAR atom) :
+ 
+  disable stop;
+  split segment (used, atom);
+  IF free.lines > 0
+    THEN insert new atom from free sequence
+  ELIF unused <= file size
+    THEN insert new atom from unused tail
+  ELSE   errorstop ("FILE-Ueberlauf")
+  FI .
+ 
+insert new atom from free sequence :
+  get a free segments head;
+  make this atom to actual segment;
+  transfer from free to used chain .
+ 
+get a free segments head :
+  IF actual free segment is root segment
+    THEN previous segment (free, atom)
+  FI;
+  position to actual segments head .
+ 
+position to actual segments head :
+  INT VAR actual index := free.segment begin;
+  free.line no DECR (free.index - actual index);
+  free.index := actual index .
+ 
+make this atom to actual segment :
+  IF free.segment end > actual index
+    THEN free.index INCR 1;
+         split segment (free, atom);
+         free.index DECR 1
+  FI .
+ 
+transfer from free to used chain :
+  delete segments (free, atom, actual index, actual index, 1);
+  insert segments (used, atom, actual index, actual index, 1);
+  atom (actual index).line := "" .
+ 
+insert new atom from unused tail :
+  actual index := unused;
+  atom (actual index).seg := 
+                      SEGMENT:(actual index, actual index, actual index);
+  atom (actual index).line := "";
+  insert segments (used, atom, actual index, actual index, 1);
+  unused INCR 1 .
+ 
+actual free segment is root segment :    free.segment begin = free root .
+ 
+END PROC insert atom;
+ 
+ 
+PROC insert next (SEQUENCE VAR used, free, INT VAR unused, ATOMROW VAR atom,
+                  TEXT CONST record) :
+ 
+  IF used.line no > used.lines
+    THEN insert atom (used, free, unused, atom)
+  ELIF actual position before unused nonempty atomrow part
+    THEN forward and insert atom by simple extension of used atomrow part
+    ELSE next atom (used, atom);
+         insert atom (used, free, unused, atom)
+  FI;
+  atom (used.index).line := record .
+ 
+forward and insert atom by simple extension of used atomrow part :
+  used.line no INCR 1;
+  used.lines INCR 1;
+  used.index INCR 1;
+  used.segment end INCR 1;
+  atom (used.segment begin).seg.end INCR 1;
+  unused INCR 1 .
+ 
+actual position before unused nonempty atomrow part :
+  used.index = unused - 1 AND unused part not empty .
+ 
+unused part not empty :  unused <= file size .
+ 
+END PROC insert next;
+ 
+ 
+PROC transfer subsequence (SEQUENCE VAR source, dest, 
+                           ATOMROW VAR atom, INT CONST size) :
+ 
+  IF size > 0
+    THEN INT VAR subsequence size := min (size, source.line no);
+         mark begin of source part;
+         mark end of source part;
+         split destination sequence;
+         transfer part
+  FI .
+ 
+mark begin of source part :
+  previous atoms (source, atom, subsequence size - 1);
+  split segment (source, atom);
+  INT CONST first := source.segment begin .
+ 
+mark end of source part :
+  next atoms (source, atom, subsequence size - 1);
+  INT CONST last := source.segment begin;
+  next atom (source, atom);
+  split segment (source, atom) .
+ 
+split destination sequence :
+  split segment (dest, atom) .
+ 
+transfer part :
+  disable stop;
+  delete segments (source, atom, first, last, subsequence size);
+  source.line no DECR subsequence size;
+  insert segments (dest, atom, first, last, subsequence size);
+  next atoms (dest, atom, subsequence size - 1) .
+ 
+END PROC transfer subsequence;
+ 
+
+
+(********************************************************************)
+(*****                                                          *****)
+(*****                  FILE handler                            *****)
+(*****                                                          *****)
+(********************************************************************)
+
+
+ 
+LET file type    = 1003 ,
+    file type 16 = 1002 ,
+
+    closed       = 0,
+    inp          = 1,
+    outp         = 2,
+    mod          = 3,
+    end          = 4,
+
+    max limit    = 16000,
+    super limit  = 16001;
+
+ 
+TYPE TRANSPUTDIRECTION = INT;
+ 
+ 
+TRANSPUTDIRECTION PROC input :
+  TRANSPUTDIRECTION : (inp)
+END PROC input;
+ 
+ 
+TRANSPUTDIRECTION PROC output :
+  TRANSPUTDIRECTION : (outp)
+END PROC output;
+ 
+ 
+TRANSPUTDIRECTION PROC modify :
+  TRANSPUTDIRECTION : (mod)
+END PROC modify;
+ 
+ 
+FILE VAR result file;
+ 
+ 
+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,
+                            DATASPACE CONST ds) :
+  IF   type (ds) = file type
+  THEN result := ds
+  ELIF type (ds) < 0
+  THEN result := ds; type (ds, file type); initialize (result file)
+  ELSE enable stop; errorstop ("Datenraum hat falschen Typ")
+  FI;
+  reset (result file, mode);
+  result file .
+ 
+result : CONCR (result file) .
+
+END PROC sequential file;
+
+
+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) :
+
+  IF   exists (name)
+  THEN get dataspace if file
+  ELIF CONCR (mode) <> inp
+  THEN get new file space
+  ELSE errorstop (""""+name+""" gibt es nicht") ; enable stop
+  FI;
+  update status if necessary;
+  reset (result file, mode);
+  result file .
+
+get dataspace if file :
+  IF type (old (name)) = file type 16
+    THEN reorganize (name)
+  FI ;
+  result := old (name, file type) ;
+  IF is 170 file
+    THEN result.col := 1 ;
+         result.mark line := 0 ;
+         result.mark col  := 0
+  FI .
+
+is 170 file : result.mark col < 0 .
+
+get new file space :
+  result := new (name);
+  IF   NOT is error
+  THEN type (old (name), file type); initialize (result file)
+  FI .
+
+update status if necessary :
+  IF   CONCR (mode) <> inp
+  THEN status (name, ""); headline (result file, name)
+  FI .
+ 
+result : CONCR (result file) .
+ 
+END PROC sequential file;
+ 
+ 
+PROC reset (FILE VAR f) :
+
+  IF f.mode = end
+    THEN reset (f, input)
+    ELSE reset (f, TRANSPUTDIRECTION:(f.mode))
+  FI .
+
+ENDPROC reset ;
+
+PROC reset (FILE VAR f, TRANSPUTDIRECTION CONST mode) :
+
+  IF f.mode <> mod OR new mode <> mod
+    THEN f.mode := new mode ;
+         initialize file index 
+  FI .
+
+initialize file index :
+  IF new mode = outp
+    THEN to line without check (f, f.used.lines);
+         col := super limit
+    ELSE to line without check (f, 1);
+         col := 1 ;
+         IF new mode = inp AND file is empty
+           THEN f.mode := end
+         FI
+  FI .
+ 
+file is empty : f.used.lines = 0 .
+ 
+new mode  : CONCR (mode) .
+
+col :   CONCR (CONCR (f)).col .
+ 
+END PROC reset;
+ 
+ 
+PROC input (FILE VAR f) :
+ 
+  reset (f, input) .
+ 
+END PROC input;
+ 
+ 
+PROC output (FILE VAR f) :
+ 
+  reset (f, output)
+ 
+END PROC output;
+ 
+ 
+PROC modify (FILE VAR f) :
+ 
+  reset (f, modify)
+
+END PROC modify;
+ 
+ 
+PROC close (FILE VAR f) :
+ 
+  f.mode := closed .
+
+END PROC close;
+ 
+ 
+PROC check mode (FILE CONST f, INT CONST mode) :
+ 
+  IF f.mode = mode
+    THEN LEAVE check mode
+    ELIF f.mode = closed
+    THEN errorstop ("Datei zu!")
+    ELIF f.mode = mod
+    THEN errorstop ("unzulaessiger Zugriff auf modify-FILE")
+    ELIF mode = mod
+    THEN errorstop ("Zugriff nur auf modify-FILE zulaessig")
+    ELIF f.mode = end
+    THEN errorstop ("Leseversuch nach Dateiende")
+    ELIF mode = inp
+    THEN errorstop ("Leseversuch auf output-FILE")
+    ELIF mode = outp
+    THEN errorstop ("Schreibversuch auf input-FILE")
+  FI .
+ 
+END PROC check mode;
+ 
+ 
+PROC to line without check (FILE VAR f, INT CONST destination line) :
+ 
+  INT CONST distance := destination line - f.used.line no;
+  IF   distance > 0
+    THEN next atoms (f.used, f.atoms, distance)
+  ELIF distance < 0
+    THEN previous atoms (f.used, f.atoms, - distance)
+  FI .
+ 
+END PROC to line without check;
+ 
+ 
+PROC to line (FILE VAR f, INT CONST destination line) :
+ 
+  check mode (f, mod);
+  to line without check (f, destination line)
+ 
+END PROC to line;
+ 
+ 
+PROC to first record (FILE VAR f) :
+ 
+  to line (f, 1)
+ 
+END PROC to first record;
+ 
+ 
+PROC to eof (FILE VAR f) :
+ 
+  to line (f, f.used.lines + 1) .
+ 
+END PROC to eof;
+ 
+ 
+PROC putline (FILE VAR f, TEXT CONST word) :
+ 
+  write (f, word);
+  col := super limit .
+ 
+col : CONCR (CONCR (f)).col .
+ 
+END PROC putline;
+ 
+ 
+PROC delete record (FILE VAR f) :
+ 
+  check mode (f, mod);
+  delete atom (f.used, f.free, f.atoms) .
+ 
+END PROC delete record;
+ 
+ 
+PROC insert record (FILE VAR f) :
+ 
+  check mode (f, mod);
+  insert atom (f.used, f.free, f.unused tail, f.atoms) .
+ 
+END PROC insert record;
+ 
+ 
+PROC down (FILE VAR f) :
+ 
+  check mode (f, mod);
+  next atom (f.used, f.atoms) .
+ 
+END PROC down ;
+ 
+PROC up (FILE VAR f) :
+ 
+  check mode (f, mod);
+  previous atom (f.used, f.atoms) .
+ 
+END PROC up ;
+
+PROC down (FILE VAR f, INT CONST n) :
+
+  to line (f, lineno (f) + n)
+
+ENDPROC down ;
+
+PROC up (FILE VAR f, INT CONST n) :
+
+  to line (f, lineno (f) - n)
+
+ENDPROC up ;
+
+ 
+PROC write record (FILE VAR f, TEXT CONST record) :
+ 
+  check mode (f, mod);
+  IF   not at eof
+    THEN f.atoms (f.used.index).line := record
+    ELSE errorstop ("'write' nach Dateiende")
+  FI .
+ 
+not at eof :  f.used.line no <= f.used.lines .
+ 
+END PROC write record;
+ 
+ 
+PROC read record (FILE CONST f, TEXT VAR record) :
+ 
+  check mode (f, mod);
+  record := f.atoms (f.used.index).line .
+ 
+END PROC read record;
+ 
+ 
+PROC line (FILE VAR f) :
+ 
+  IF   mode = end
+    THEN errorstop ("Leseversuch nach Dateiende")
+    ELIF mode = inp
+    THEN next atom (f.used, f.atoms); col := 1; check eof
+    ELIF mode = outp
+    THEN IF col <= max limit
+           THEN col := super limit
+           ELSE append empty line
+         FI
+  FI .
+ 
+append empty line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, "") .
+ 
+col : CONCR (CONCR (f)).col .
+ 
+mode : CONCR (CONCR (f)).mode .
+ 
+check eof :
+  IF eof (f) THEN mode := end FI .
+ 
+END PROC line;
+ 
+ 
+PROC line (FILE VAR f, INT CONST lines) :
+ 
+  INT VAR i; FOR i FROM 1 UPTO lines REP line (f) PER
+ 
+END PROC line;
+ 
+
+PROC getline (FILE VAR f, TEXT VAR text) :
+
+  check mode (f, inp);
+  text := subtext (record, f.col);
+  IF f.used.line no >= f.used.lines
+    THEN f.mode := end ;
+         set end of file
+    ELSE to next line ;
+         f.col := 1
+  FI .
+
+to next line :
+  next atom (f.used, f.atoms) .
+
+set end of file :
+  f.col := LENGTH record + 1 .
+
+record : f.atoms (f.used.index).line .
+
+END PROC getline;
+ 
+ 
+BOOL PROC is first record (FILE CONST f) :
+ 
+  check mode (f, mod);
+  f.used.line no = 1 .
+ 
+END PROC is first record;
+ 
+ 
+BOOL PROC eof (FILE CONST f) :
+ 
+  IF   line no < lines THEN FALSE
+  ELIF line no = lines THEN col > LENGTH record
+  ELSE                      TRUE
+  FI .
+
+line no :  f.used.line no .
+lines   :  f.used.lines .
+col     :  f.col .
+record  :  f.atoms (f.used.index).line .
+ 
+END PROC eof;
+ 
+ 
+INT PROC line no (FILE CONST f) :
+ 
+  f.used.line no .
+ 
+END PROC line no;
+
+
+PROC line type (FILE VAR f, INT CONST t) :
+
+  f.atoms (f.used.index).type := t .
+
+ENDPROC line type ;
+
+INT PROC line type (FILE CONST f) :
+
+  f.atoms (f.used.index).type .
+
+ENDPROC line type ;
+ 
+ 
+PROC put (FILE VAR f, TEXT CONST word) :
+ 
+  check mode (f, outp);
+  IF col + LENGTH word > f.limit
+    THEN append new line
+    ELSE record CAT word
+  FI;
+  record CAT " ";
+  col := LENGTH record + 1 .
+ 
+append new line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, word) .
+ 
+record : f.atoms (f.used.index).line .
+col :    f.col .
+ 
+END PROC put;
+
+ 
+PROC put (FILE VAR f, INT CONST value) :
+ 
+  put (f, text (value))
+ 
+END PROC put;
+ 
+ 
+PROC put (FILE VAR f, REAL CONST real) :
+ 
+  put (f, text (real))
+ 
+END PROC put;
+ 
+ 
+PROC write (FILE VAR f, TEXT CONST word) :
+ 
+  check mode (f, outp);
+  IF col + LENGTH word - 1 > f.limit
+    THEN append new line
+    ELSE record CAT word
+  FI;
+  col := LENGTH record + 1 .
+ 
+append new line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, word) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+END PROC write;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word, TEXT CONST separator) :
+ 
+  check mode (f, inp);
+  skip separators;
+  IF word found
+    THEN get word
+    ELSE try to find word in next line
+  FI .
+ 
+skip separators :
+  INT CONST separator length := LENGTH separator;
+  WHILE is separator REP col INCR separator length PER .
+
+is separator : 
+  subtext (record, col, col + separator length - 1) = separator .
+ 
+word found : col <= LENGTH record .
+ 
+get word :
+  INT VAR end of word := pos (record, separator, col) - 1;
+  IF separator found
+    THEN get text upto separator
+    ELSE get rest of record
+  FI .
+ 
+separator found : end of word >= 0 .
+ 
+get text upto separator :
+  word := subtext (record, col, end of word);
+  col := end of word + separator length + 1;
+  IF col > LENGTH record THEN line (f) FI .
+ 
+get rest of record :
+  word := subtext (record, col); line (f) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+try to find word in next line :
+  line (f); IF eof (f) THEN word := "" ELSE get (f, word, separator) FI .
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word, INT CONST max length) :
+ 
+  check mode (f, inp);
+  IF word is only a part of record
+    THEN get text of certain length
+    ELSE get rest of record
+  FI .
+ 
+word is only a part of record :
+  col <= LENGTH record - max length .
+ 
+get text of certain length :
+  word := text (record, max length, col);
+  col INCR max length .
+
+get rest of record :
+  word := subtext (record, col); line (f) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word) :
+ 
+  get (f, word, " ")
+ 
+END PROC get;
+ 
+ 
+TEXT VAR number word;
+ 
+ 
+PROC get (FILE VAR f, INT VAR number) :
+ 
+  get (f, number word);
+  number := int (number word)
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, REAL VAR number) :
+ 
+  get (f, number word);
+  number := real (number word)
+ 
+END PROC get;
+ 
+ 
+TEXT VAR split record ;
+INT VAR indentation ;
+
+PROC split line (FILE VAR f, INT CONST split col) :
+
+  split line (f, split col, TRUE)
+
+ENDPROC split line ;
+
+PROC split line (FILE VAR f, INT CONST split col, BOOL CONST note indentation ) :
+
+  IF note indentation 
+    THEN get indentation 
+    ELSE indentation := 0
+  FI ;
+  get split record ;
+  insert split record and indentation ;
+  cut off old record .
+
+get indentation :
+  indentation := pos (actual record,""33"",""254"",1) - 1 ;
+  IF indentation < 0 OR indentation >= split col
+    THEN indentation := split col - 1
+  FI .
+
+get split record :
+  split record := subtext (actual record, split col, max limit) .
+
+insert split record and indentation :
+  down (f) ;
+  insert record (f) ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO indentation REP
+    actual record CAT " "
+  PER ; 
+  actual record CAT split record ;
+  up (f) .
+
+cut off old record :
+  actual record := subtext (actual record, 1, split col-1) .
+
+actual record : f.atoms (f.used.index).line .
+
+ENDPROC split line ;
+
+PROC concatenate line (FILE VAR f, BOOL CONST delete blanks) :
+
+  down (f) ;
+  split record := actual record ;
+  IF delete blanks
+    THEN delete leading blanks
+  FI ;
+  delete record (f) ;
+  up (f) ;
+  actual record CAT split record .
+
+delete leading blanks :
+  INT CONST non blank col := pos (split record, ""33"", ""254"", 1) ;
+  IF non blank col > 0
+    THEN split record := subtext (split record, non blank col)
+  FI .
+
+actual record :  f.atoms (f.used.index).line .
+
+ENDPROC concatenate line ;
+
+PROC concatenate line (FILE VAR f) :
+  concatenate line (f, TRUE)
+ENDPROC concatenate line ;
+
+PROC reorganize :
+ 
+  reorganize (last param)
+ 
+END PROC reorganize;
+ 
+ 
+TEXT VAR file record ;
+
+PROC reorganize (TEXT CONST file name) :
+ 
+  enable stop ;
+  FILE VAR input file, output file;
+  DATASPACE VAR scratch space;
+  INT CONST type of dataspace := type (old (file name)) ;
+  INT VAR counter;
+ 
+  last param (file name);
+  IF type of dataspace = file type
+    THEN reorganize new to new
+  ELIF type of dataspace = file type 16
+    THEN reorganize old to new
+    ELSE errorstop ("Datenraum hat falschen Typ")
+  FI;
+  replace file space by scratch space .
+ 
+reorganize new to new :
+  input  file := sequential file (input, file name);
+  disable stop ;
+  scratch space := nilspace ;
+  output file := sequential file (output, scratch space);
+  copy attributes (input file, output file) ;
+
+  FOR counter FROM 1 UPTO 9999
+  WHILE NOT eof (input file) REP
+    cout (counter);
+    getline (input file, file record);
+    putline (output file, file record);
+    check for interrupt
+  PER .
+ 
+reorganize old to new :
+  LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT record);
+  LET OLDFILE = BOUND ROW 4075 OLDRECORD;
+  LET dateianker = 2, freianker = 1;
+  INT VAR index := dateianker;
+ 
+  OLDFILE VAR old file := old (file name);
+  disable stop;
+  scratch space := nilspace;
+  output file := sequential file (output, scratch space);
+  get old attributes ;
+ 
+  say ("Datei wird in 1.7-Format gewandelt: ") ;
+
+  FOR counter FROM 1 UPTO 9999
+  WHILE NOT end of old file REP
+    cout (counter);
+    index := next record;
+    file record := record of old file ;
+    IF pos (file record, ""128"", ""250"", 1) > 0
+      THEN change special chars
+    FI ;
+    putline (output file, file record);
+    check for interrupt
+  PER .
+ 
+get old attributes :
+  get old headline ;
+  get old limit and tabs .
+
+get old headline :
+  headline (output file, old file (dateianker).record) .
+
+get old limit and tabs :
+  file record := old file (freianker).record ;
+  max line length (output file, int (subtext (file record, 11, 15))) ;
+  put tabs (output file, subtext (file record, 16)) .
+
+change special chars :
+  change all (file record, ""193"", ""214"") (* Ae *) ;
+  change all (file record, ""207"", ""215"") (* Oe *) ;
+  change all (file record, ""213"", ""216"") (* Ue *) ;
+  change all (file record, ""225"", ""217"") (* ae *) ;
+  change all (file record, ""239"", ""218"") (* oe *) ;
+  change all (file record, ""245"", ""219"") (* ue *) ;
+  change all (file record, ""235"", ""220"") (* k  *) ;
+  change all (file record, ""173"", ""221"") (* -  *) ;
+  change all (file record, ""163"", ""222"") (* fis   *) ;
+  change all (file record, ""160"", ""223"") (* blank *) ;
+  change all (file record, ""194"", ""251"") (* eszet *) .
+
+end of old file :      next record = dateianker .
+
+next record :          old file (index).succ .
+ 
+record of old file :   old file (index).record .
+ 
+check for interrupt :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN errorstop ("Speicherengpass")
+  FI ;
+  IF is error
+    THEN forget (scratch space) ; LEAVE reorganize
+  FI .
+ 
+replace file space by scratch space :
+  headline (output file, file name);
+  forget (file name, quiet) ;
+  type (scratch space, file type);
+  copy (scratch space, file name);
+  forget (scratch space) .
+
+END PROC reorganize;
+
+
+PROC set range (FILE VAR f, INT CONST start line, start col,
+                FRANGE VAR old range) :
+
+  check mode (f, mod);
+  IF valid restriction parameters
+    THEN prepare last line ;
+         prepare first line ;
+         save old range ;
+         set new range
+    ELSE errorstop ("FRANGE ungueltig")
+  FI .
+
+valid restriction parameters :
+  start line > 0 AND start col > 0 AND start before or at actual point .
+
+start before or at actual point :
+  start line < line no (f)  OR
+  start line = line no (f) AND start col <= col (f) .
+
+prepare last line :
+  INT VAR last line ;
+  IF col (f) > 1
+    THEN split line (f, col(f), FALSE)
+  FI .
+
+prepare first line :
+  IF start col > 1
+    THEN split start line ;
+  FI .
+
+split start line :
+  INT VAR old line no := line no (f) ;
+  to line (f, start line) ;
+  split line (f, start col, FALSE) ;
+  to line (f, old line no + 1) .
+
+save old range :
+  old range.pre := f.prefix lines ;
+  old range.post:= f.postfix lines .
+
+set new range :
+  get pre lines ;
+  get post lines ;
+  disable stop ;
+  f.prefix lines INCR pre lines ;
+  f.postfix lines INCR post lines ;
+  f.used.lines DECR (post lines + pre lines) ;
+  f.used.line no DECR pre lines .
+
+get pre lines :
+  INT VAR pre lines ;
+  IF start col = 1
+    THEN old range.pre was split := FALSE ;
+         pre lines := start line - 1
+    ELSE old range.pre was split := TRUE ;
+         pre lines := start line
+  FI .
+
+get post lines :
+  INT VAR post lines ;
+  IF col (f) = 1
+    THEN old range.post was split := FALSE ;
+         post lines := lines (f) - line no (f) + 1
+    ELSE old range.post was split := TRUE ;
+         post lines := lines (f) - line no (f)
+  FI .
+
+END PROC set range;
+
+
+PROC set range (FILE VAR f, FRANGE VAR new range) :
+
+  check mode (f, mod);
+  INT CONST pre add  := prefix - new range.pre,
+            post add := postfix - new range.post;
+  IF pre add < 0 OR post add < 0
+    THEN errorstop ("FRANGE ungueltig")
+    ELSE set new range;
+         undo splitting if necessary ;
+         make range var invalid
+  FI .
+ 
+set new range :
+  disable stop;
+  prefix DECR pre add;
+  postfix DECR post add;
+  used.line no INCR pre add;
+  used.lines INCR (pre add + post add) .
+
+undo splitting if necessary :
+  IF new range.pre was split
+    THEN concatenate first line
+  FI ;
+  IF new range.post was split
+    THEN concatenate last line
+  FI .
+
+concatenate first line :
+  INT VAR old line := line no (f) ;
+  to line (f, pre add) ;
+  concatenate line (f, FALSE) ;
+  to line (f, old line - 1) .
+
+concatenate last line :
+  old line := line no (f) ;
+  to line (f, lines (f) - post add) ;
+  concatenate line (f, FALSE) ;
+  to line (f, old line) .
+
+make range var invalid :
+  new range.pre := maxint .
+ 
+used :    f.used .
+prefix :  f.prefix lines .
+postfix : f.postfix lines .
+ 
+END PROC set range;
+ 
+PROC reset range (FILE VAR f) :
+
+  FRANGE VAR complete ;
+  complete.pre := 0 ;
+  complete.post:= 0 ;
+  complete.pre was split := FALSE ;
+  complete.post was split:= FALSE ;
+  set range (f, complete)
+
+ENDPROC reset range ;
+
+PROC remove (FILE VAR f, INT CONST size) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.used, f.scratch, f.atoms, size) .
+ 
+END PROC remove;
+ 
+ 
+PROC clear removed (FILE VAR f) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.scratch, f.free, f.atoms, f.scratch.lines) .
+ 
+END PROC clear removed;
+ 
+ 
+PROC reinsert (FILE VAR f) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.scratch, f.used, f.atoms, f.scratch.lines) .
+ 
+END PROC reinsert;
+
+
+PROC copy attributes (FILE CONST source file, FILE VAR dest file) :
+
+  dest.limit                     := source.limit ;
+  dest.atoms (free root).line    := source.atoms (free root).line ;
+  dest.atoms (scratch root).line := source.atoms (scratch root).line ;
+  dest.edit info                 := source.edit info .
+
+dest   : CONCR (CONCR (dest file)) .
+source : CONCR (CONCR (source file)) .
+
+ENDPROC copy attributes ;
+ 
+ 
+INT PROC max line length (FILE CONST f) :
+ 
+  f.limit .
+ 
+END PROC max line length;
+ 
+ 
+PROC max line length (FILE VAR f, INT CONST new limit) :
+ 
+  IF new limit > 0 AND new limit <= max limit
+    THEN f.limit := new limit
+  FI .
+ 
+END PROC max line length;
+ 
+ 
+TEXT PROC headline (FILE CONST f) :
+ 
+  f.atoms (free root).line .
+
+END PROC headline;
+ 
+ 
+PROC headline (FILE VAR f, TEXT CONST head) :
+ 
+  f.atoms (free root).line := head .
+ 
+END PROC headline;
+ 
+ 
+PROC get tabs (FILE CONST f, TEXT VAR tabs) :
+ 
+  tabs := f.atoms (scratch root).line .
+ 
+END PROC get tabs;
+ 
+ 
+PROC put tabs (FILE VAR f, TEXT CONST tabs) :
+ 
+  f.atoms (scratch root).line := tabs .
+ 
+END PROC put tabs;
+
+ 
+INT PROC edit info (FILE CONST f) :
+ 
+  f.edit info .
+ 
+END PROC edit info;
+ 
+ 
+PROC edit info (FILE VAR f, INT CONST info) : 
+ 
+  f.edit info := info .
+ 
+END PROC edit info;
+ 
+ 
+INT PROC lines (FILE CONST f) :
+ 
+  f.used.lines .
+ 
+END PROC lines;
+ 
+ 
+INT PROC removed lines (FILE CONST f) :
+ 
+  f.scratch.lines .
+ 
+END PROC removed lines;
+
+
+INT PROC segments (FILE CONST f) :
+
+  segs(f.used,f.atoms) + segs(f.scratch,f.atoms) + segs(f.free,f.atoms) - 2 .
+
+ENDPROC segments ;
+
+
+INT PROC col (FILE CONST f) :
+
+  f.col
+
+ENDPROC col ;
+
+PROC col (FILE VAR f, INT CONST new column) :
+
+  IF new column > 0
+    THEN f.col := new column
+  FI
+
+ENDPROC col ;
+
+TEXT PROC word (FILE CONST f) :
+
+  word (f, " ")
+
+ENDPROC word ;
+
+TEXT PROC word (FILE CONST f, TEXT CONST delimiter) :
+
+  INT VAR del pos := pos (f, delimiter, col (f)) ;
+  IF del pos = 0
+    THEN del pos := len (f) + 1
+  FI ;
+  subtext (f, col (f), del pos - 1)
+
+ENDPROC word ;
+
+TEXT PROC word (FILE CONST f, INT CONST max length) :
+
+  subtext (f, col (f), col (f) + max length - 1)
+
+ENDPROC word ;
+
+BOOL PROC at (FILE CONST f, TEXT CONST word) :
+
+  pat := any (column-1) ;
+  pat CAT word ;
+  pat CAT any ;
+  record LIKE pat .
+
+column : f.col .
+record : f.atoms (f.used.index).line .
+
+ENDPROC at ;
+
+ 
+PROC exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR f, TEXT CONST t) :
+ 
+  proc (record, t) .
+ 
+record : f.atoms (f.used.index).line .
+ 
+END PROC exec;
+ 
+ 
+PROC exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST i) :
+ 
+  proc (record, i) .
+
+record : f.atoms (f.used.index).line .
+ 
+END PROC exec;
+ 
+INT PROC pos (FILE CONST f, TEXT CONST pattern, INT CONST i) :
+ 
+  pos (record, pattern, i) .
+ 
+record : f.atoms (f.used.index).line .
+ 
+END PROC pos ;
+
+PROC down (FILE VAR f, TEXT CONST pattern) :
+
+  down (f, pattern, file size)
+
+ENDPROC down ;
+
+PROC down (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col + 1 ;
+  search down (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC down ;
+
+PROC downety (FILE VAR f, TEXT CONST pattern) :
+ 
+  downety (f, pattern, file size)
+
+ENDPROC downety ;
+
+PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col ;
+  search down (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC downety ;
+
+PROC up (FILE VAR f, TEXT CONST pattern) :
+
+  up (f, pattern, file size)
+
+ENDPROC up ;
+
+PROC up (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col - 1 ;
+  search up (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC up ;
+
+PROC uppety (FILE VAR f, TEXT CONST pattern) :
+
+  uppety (f, pattern, file size)
+
+ENDPROC uppety ;
+
+PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col ;
+  search up (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC uppety ;
+
+
+INT PROC len (FILE CONST f) :
+
+  length (record) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC len ;
+
+TEXT PROC subtext (FILE CONST f, INT CONST from, to) :
+
+  subtext (record, from, to) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC subtext ;
+
+PROC change (FILE VAR f, INT CONST from, to, TEXT CONST new) :
+
+  check mode (f, mod) ;
+  change (record, from, to, new) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC change ;
+
+ 
+BOOL PROC mark (FILE CONST f) :
+
+  f.mark line > 0
+
+ENDPROC mark ;
+
+PROC mark (FILE VAR f, INT CONST line no, col) :
+
+  IF line no > 0
+    THEN f.mark line := line no + f.prefix lines ;
+         f.mark col  := col
+    ELSE f.mark line := 0 ;
+         f.mark col  := 0
+  FI 
+
+ENDPROC mark ;
+
+INT PROC mark line no (FILE CONST f) :
+
+  IF f.mark line = 0
+    THEN 0
+    ELSE max (1, f.mark line - f.prefix lines)
+  FI
+
+ENDPROC mark line no ;
+
+INT PROC mark col (FILE CONST f) :
+
+  IF f.mark line = 0
+    THEN 0
+  ELIF f.mark line <= f.prefix lines
+    THEN 1
+  ELSE f.mark col
+  FI
+
+ENDPROC mark col ;
+
+PROC set marked range (FILE VAR f, FRANGE VAR old range) :
+
+  IF mark (f)
+    THEN set range (f, mark line no (f), mark col (f), old range)
+    ELSE old range := previous range of file
+  FI .
+
+previous range of file :
+  FRANGE : (f.prefix lines, f.postfix lines, FALSE, FALSE) .
+
+ENDPROC set marked range ;
+
+
+(*****************************************************************)
+
+                                                  (* Autor: P.Heyderhoff *) 
+                                                  (* Stand: 11.10.83     *) 
+ 
+BOUND LIST VAR datei; 
+INT  VAR sortierstelle, sortanker;
+BOOL VAR ascii sort;
+TEXT VAR median, tausch , links, rechts;
+ 
+PROC sort (TEXT CONST dateiname) : 
+     sort (dateiname, 1)
+END PROC sort; 
+ 
+PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : 
+     ascii sort := TRUE ;
+     sortierstelle := sortieranfang; sortiere (dateiname)
+END PROC sort; 
+ 
+PROC lex sort (TEXT CONST dateiname) :
+     lex sort (dateiname, 1)
+ENDPROC lex sort ;
+
+PROC lex sort (TEXT CONST dateiname, INT CONST sortieranfang) :
+     ascii sort := FALSE ;
+     sortierstelle := sortieranfang; sortiere (dateiname)
+ENDPROC lex sort ;
+
+PROC sortiere (TEXT CONST dateiname) :
+
+  reorganize file if necessary ;
+  sort file .
+
+reorganize file if necessary :
+  FILE VAR f := sequential file (modify, dateiname) ;
+  IF segments (f) > 1
+    THEN reorganize (dateiname)
+  FI .
+
+sort file :
+  f := sequential file (modify, dateiname) ;
+  INT CONST sortende := lines (f) + 3 ;
+  sortanker := 1 + 3 ;
+  datei := old (dateiname) ;
+  quicksort(sortanker, sortende) .
+
+END PROC sortiere; 
+ 
+PROC quicksort ( INT CONST anfang, ende ) : 
+     IF   anfang < ende 
+     THEN INT VAR p,q; 
+          spalte    (anfang, ende, p, q); 
+          quicksort (anfang, q); 
+          quicksort (p, ende)    FI 
+END PROC quicksort; 
+ 
+PROC spalte (INT CONST anfang, ende, INT VAR p, q): 
+     fange an der seite an und waehle den median; 
+     ruecke p und q so dicht wie moeglich zusammen; 
+     hole ggf median in die mitte . 
+ 
+   fange an der seite an und waehle den median : 
+     p := anfang; q := ende ; 
+     INT CONST m :: (p + q) DIV 2 ; 
+     median := subtext(datei m, sortierstelle) . 
+ 
+   ruecke p und q so dicht wie moeglich zusammen : 
+     REP schiebe p und q so weit wie moeglich auf bzw ab; 
+         IF p < q THEN vertausche die beiden FI 
+     UNTIL p > q END REP . 
+ 
+   vertausche die beiden : 
+     tausch := datei p; datei p := datei q; datei q := tausch; 
+     p INCR 1; q DECR 1 . 
+ 
+   schiebe p und q so weit wie moeglich auf bzw ab : 
+     WHILE p kann groesser werden REP p INCR 1 END REP; 
+     WHILE q kann kleiner  werden REP q DECR 1 END REP . 
+ 
+   p kann groesser werden : 
+     IF p <= ende 
+       THEN links := subtext (datei p, sortierstelle) ;
+            IF ascii sort
+              THEN median >= links
+              ELSE median LEXGREATEREQUAL links
+            FI
+       ELSE FALSE 
+     FI . 
+ 
+   q kann kleiner werden : 
+     IF q >= anfang 
+       THEN rechts := subtext(datei q, sortierstelle) ;
+            IF ascii sort
+              THEN rechts >= median 
+              ELSE rechts LEXGREATEREQUAL median
+            FI
+       ELSE FALSE 
+     FI . 
+ 
+   hole ggf median in die mitte : 
+     IF   m < q THEN vertausche m und q 
+     ELIF m > p THEN vertausche m und p FI . 
+ 
+   vertausche m und q : 
+     tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . 
+ 
+   vertausche m und p : 
+     tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . 
+ 
+   datei m :  datei.atoms (m).line . 
+   datei p :  datei.atoms (p).line . 
+   datei q :  datei.atoms (q).line . 
+ 
+END PROC spalte; 
+
+END PACKET file handling;
+
diff --git a/system/base/1.7.5/src/functions b/system/base/1.7.5/src/functions
new file mode 100644
index 0000000..9f338ff
--- /dev/null
+++ b/system/base/1.7.5/src/functions
@@ -0,0 +1,760 @@
+PACKET  editor functions  DEFINES                     (* FUNCTIONS - 052 *)
+        (**************)                              (*  17.07.85 -bk-  *)
+                                                      (*  10.09.85 -ws-  *)
+        edit,                                         (*  25.04.86 -sh-  *)
+        show,                                         (*  27.05.86 -wk-  *)
+        U, 
+        D,
+        T,
+        up,
+        down,
+        downety,
+        uppety,
+        to line,
+        PUT,
+        GET,
+        P,
+        G,
+        limit,
+        len,
+        eof,
+        C,
+        change to,
+        CA,
+        change all,
+        lines,
+        line no,
+        col,
+        mark,
+        at,
+        word,
+        std kommando interpreter,
+        note,
+        note line,
+        note edit,
+        anything noted,
+        note file:
+ 
+ 
+LET     marker       = "^",
+        ersatzmarker = "'",
+        schritt      = 50,
+        file size    = 4072,
+        write acc    = TRUE,
+        read acc     = FALSE;
+ 
+LET     bold         = 2,
+        integer      = 3,
+        string       = 4,
+        end of file  = 7;
+ 
+LET     std res      = "eqvw19dpgn"9"";
+ 
+FILE VAR edfile;
+BOOL VAR from scratchfile :: FALSE;
+TEXT VAR kommandotext, tabulator, zeile;
+ 
+
+PROC std kommando interpreter (TEXT CONST taste) :
+  enable stop ; 
+  edfile := editfile;
+  set busy indicator; 
+  SELECT pos (std res, taste) OF
+    CASE 1 (*e*)  : edit 
+    CASE 2 (*q*)  : quit
+    CASE 3 (*v*)  : quit last
+    CASE 4 (*w*)  : open editor (next editor)
+    CASE 5 (*1*)  : toline (1); col (1)
+    CASE 6 (*9*)  : toline (lines); col (len+1)
+    CASE 7 (*d*)  : d case 
+    CASE 8 (*p*)  : p case 
+    CASE 9 (*g*)  : g case 
+    CASE 10(*n*)  : note edit
+    CASE 11(*tab*): change tabs
+    OTHERWISE     : echtes kommando analysieren
+  END SELECT . 
+ 
+d case :
+  IF   mark
+  THEN PUT ""; mark (FALSE); from scratchfile := TRUE
+  ELSE textzeile auf taste legen
+  FI .
+
+p case :
+  IF   mark                                                          (*sh*)
+  THEN IF   write permission 
+       THEN PUT ""; push(""27""12""); from scratchfile := TRUE
+       ELSE out (""7"")
+       FI
+  ELSE textzeile auf taste legen
+  FI .
+
+g case :
+  IF   write permission                                              (*sh*)
+  THEN IF   from scratchfile 
+       THEN GET "" 
+       ELSE IF is editget
+              THEN push (lernsequenz auf taste ("g")); nichts neu
+            FI
+       FI
+  ELSE out (""7"")
+  FI .
+
+textzeile auf taste legen : 
+  read record (edfile, zeile); 
+  zeile := subtext (zeile, col);
+  lernsequenz auf taste legen ("g", zeile);
+  from scratchfile := FALSE; zeile neu . 
+
+next editor :
+  (aktueller editor MOD groesster editor) + 1 .
+ 
+change tabs :
+  get tabs (edfile, tabulator) ;
+  IF   pos (tabulator, marker) <> 0
+  THEN change all (tabulator, marker, ersatzmarker)
+  ELSE change all (tabulator, ersatzmarker, marker)
+  FI ;
+  put tabs (edfile, tabulator) ;
+  ueberschrift neu .
+ 
+echtes kommando analysieren :
+  kommandotext := kommando auf taste (taste);
+  IF   kommandotext = ""
+  THEN nichts neu; LEAVE std kommando interpreter
+  FI ;
+  scan (kommandotext);
+  TEXT VAR s1; INT VAR t1; next symbol (s1, t1);
+  TEXT VAR s2; INT VAR t2; next symbol (s2, t2);
+  IF   t1 = integer AND t2 = end of file THEN toline (int (s1))
+  ELIF t1 = string  AND t2 = end of file THEN down (s1)
+  ELIF perhaps simple up or down         THEN
+  ELIF perhaps simple changeto           THEN
+  ELSE do (kommandotext)
+  FI . 
+ 
+perhaps simple up or down :
+  IF   t1 = bold
+  THEN TEXT VAR s3; INT VAR t3; next symbol (s3, t3);
+       IF   t3 <> end of file THEN FALSE
+       ELIF s1 = "U"          THEN perhaps simple up
+       ELIF s1 = "D"          THEN perhaps simple down
+                              ELSE FALSE
+       FI
+  ELSE FALSE
+  FI .
+ 
+perhaps simple up :
+  IF   t2 = string  THEN up (s2);       TRUE 
+  ELIF t2 = integer THEN up (int (s2)); TRUE 
+                    ELSE                FALSE 
+  FI . 
+ 
+perhaps simple down : 
+  IF   t2 = string  THEN down (s2);       TRUE 
+  ELIF t2 = integer THEN down (int (s2)); TRUE 
+                    ELSE                  FALSE 
+  FI .
+ 
+perhaps simple changeto : 
+  IF   t1 = string AND s2 = "C" AND t3 is string AND t4 is eof 
+  THEN s1 C s3; TRUE 
+  ELSE FALSE 
+  FI . 
+ 
+t3 is string : 
+  next symbol (s3, t3); 
+  t3 = string . 
+
+t4 is eof : 
+  TEXT VAR s4; INT VAR t4; 
+  next symbol (s4, t4); 
+  t4 = end of file . 
+END PROC std kommando interpreter; 
+
+ 
+PROC edit (FILE VAR f) : 
+  enable stop; 
+  IF aktueller editor > 0                                            (*wk*)
+    THEN ueberschrift neu
+  FI ;
+  open editor (f, write acc);
+  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+ 
+PROC edit (FILE VAR f, INT CONST x, y, x size, y size) :
+  enable stop;
+  open editor (groesster editor + 1, f, write acc, x, y, x size, y size);
+  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+
+PROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter) :
+  enable stop;
+  open editor (f, write acc);
+  edit (groesster editor, res, PROC(TEXT CONST) kdo interpreter)
+END PROC edit;
+ 
+ 
+PROC edit :
+  IF   aktueller editor > 0
+  THEN dateiname einlesen;
+       edit (dateiname)
+  ELSE edit (last param)
+  FI .
+ 
+dateiname einlesen :
+  INT VAR x, y; get editcursor (x, y);
+  IF x < x size - 17                                                 (*sh*)
+  THEN cursor (x, y);
+       out (""15"Dateiname:"14"");
+       (x size-14-x) TIMESOUT " ";
+       (x size-14-x) TIMESOUT ""8"";
+       TEXT VAR dateiname := std;
+       editget (dateiname);
+       trailing blanks entfernen; 
+       quotes entfernen
+  ELSE errorstop ("Fenster zu klein")
+  FI .
+ 
+trailing blanks entfernen: 
+  INT VAR i := LENGTH dateiname; 
+  WHILE (dateiname SUB i) = " " REP i DECR 1 PER; 
+  dateiname := subtext (dateiname, 1, i) . 
+ 
+quotes entfernen :
+  IF   (dateiname SUB 1) = """" AND (dateiname SUB LENGTH dateiname) = """"
+  THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1)
+  FI .
+END PROC edit;
+ 
+ 
+PROC edit (TEXT CONST filename) :
+  IF   filename <> ""
+  THEN edit named file
+  ELSE errorstop ("Name ungueltig")
+  FI . 
+ 
+edit named file :
+  last param (filename);
+  IF   exists (filename) COR yes ("""" + filename + """ neu einrichten")
+  THEN IF aktueller editor > 0 THEN ueberschrift neu FI;             (*sh*)
+       FILE VAR f := sequential file (modify, filename);
+       headline (f, filename); edit (f); last param (filename)
+  ELSE errorstop ("")
+  FI .
+END PROC edit;
+ 
+ 
+PROC edit (TEXT CONST filename, INT CONST x, y, x size, y size) :
+  last param (filename);
+  IF exists (filename) COR yes ("""" + filename + """ neu einrichten")
+  THEN FILE VAR f := sequential file (modify, filename);
+       headline (f, filename); edit (f, x, y, x size, y size);
+       last param (filename)
+  ELSE errorstop ("")
+  FI
+END PROC edit;
+ 
+ 
+PROC edit (INT CONST i) :
+  edit (i, std res, PROC (TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+ 
+PROC show (FILE VAR f) :
+  enable stop; 
+  open editor (f, read acc);
+  edit(groesster editor, std res, PROC(TEXT CONST) std kommando interpreter);
+END PROC show;
+ 
+
+PROC show (TEXT CONST filename) :                                    (*sh*)
+  last param (filename);
+  IF   exists (filename)
+  THEN FILE VAR f := sequential file (modify, filename);
+       show (f); last param (filename)
+  ELSE errorstop ("""" + filename + """ gibt es nicht") 
+  FI
+END PROC show; 
+
+ 
+PROC show :
+  show (last param)
+END PROC show;
+ 
+ 
+DATASPACE VAR local space;
+INT  VAR zeilenoffset;
+TEXT VAR kopierzeile;
+ 
+ 
+OP PUT (TEXT CONST filename) :
+  nichts neu;
+  IF   mark 
+  THEN markierten bereich in datei schreiben
+  FI .
+ 
+markierten bereich in datei schreiben :
+  disable stop;
+  zieldatei vorbereiten;
+  quelldatei oeffnen;
+  IF   noch genuegend platz in der zieldatei                         (*sh*)
+  THEN zeilenweise kopieren
+  ELSE errorstop ("FILE-Ueberlauf")
+  FI ;
+  quelldatei schliessen;
+  zieldatei schliessen;
+  set busy indicator .
+
+zieldatei vorbereiten :
+  FRANGE VAR ganze zieldatei;
+  IF exists (filename) THEN forget (filename); ueberschrift neu FI;
+  FILE VAR destination;
+  IF   filename = ""
+  THEN forget (local space); local space := nilspace;
+       destination := sequential file (output, local space)
+  ELSE destination := sequential file (modify, filename) ;
+       INT CONST groesse der zieldatei := lines (destination);       (*sh*)
+       set marked range (destination, ganze zieldatei) ;
+       output (destination)
+  FI .
+
+quelldatei oeffnen :
+  zeilenoffset := mark line no (edfile) - 1;
+  INT CONST old line := line no, old col := col;
+  FRANGE VAR ganze datei;
+  set range (edfile, mark lineno (edfile), mark col (edfile), ganze datei);
+  input (edfile) .
+ 
+noch genuegend platz in der zieldatei :
+  lines + groesse der zieldatei < file size .
+
+zeilenweise kopieren :
+  enable stop;
+  satznr neu;
+  INT VAR zeile;
+  FOR zeile FROM 1 UPTO lines (edfile) REP
+    getline (edfile, kopierzeile);
+    putline (destination, kopierzeile);
+    satznr zeigen
+  PER .
+ 
+quelldatei schliessen :
+  modify (edfile);
+  set range (edfile, ganze datei);
+  to line (old line);
+  col (old col) .
+ 
+zieldatei schliessen :
+  IF   filename <> ""
+  THEN INT CONST last line written := line no (destination) ;
+       modify (destination) ;
+       to line (destination, last line written) ;
+       col (destination, len (destination) + 1) ;
+       bild neu (destination) ;
+       set range (destination, ganze zieldatei)
+  FI .
+END OP PUT;
+
+ 
+OP P (TEXT CONST filename) :
+  PUT filename
+END OP P ;
+
+
+OP GET (TEXT CONST filename) :                                       (*sh*)
+  IF   NOT write permission
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  quelldatei oeffnen;
+  IF   nicht mehr genuegend platz im editfile 
+  THEN quelldatei schliessen; errorstop ("FILE-Ueberlauf")
+  FI ;
+  disable stop;
+  zieldatei oeffnen;
+  zeilenweise kopieren ;
+  zieldatei schliessen;
+  quelldatei schliessen;
+  set busy indicator .
+
+quelldatei oeffnen :
+  FILE VAR source;
+  FRANGE VAR ganze quelldatei;
+  IF   filename = ""
+  THEN source := sequential file (input, local space)
+  ELSE IF NOT exists (filename) 
+       THEN errorstop ("""" + filename + """ gibt es nicht")
+       FI ;
+       source := sequential file (modify, filename); 
+       INT CONST old line := line no (source),
+                 old col  := col (source);
+       set marked range (source, ganze quelldatei);
+       input (source)
+  FI .
+ 
+nicht mehr genuegend platz im editfile :
+  lines (source) + lines >= file size .
+
+zeilenweise kopieren :
+  enable stop;
+  satznr neu;
+  INT VAR zeile;
+  FOR zeile FROM 1 UPTO lines (source) REP
+    getline (source, kopierzeile);
+    putline (edfile, kopierzeile);
+    satznr zeigen
+  PER .
+ 
+zieldatei oeffnen :
+  zeilenoffset := line no - 1;
+  leere datei in editfile einschachteln;
+  output (edfile) .
+ 
+leere datei in editfile einschachteln :
+  INT CONST range start col := col;
+  FRANGE VAR ganze datei;
+  set range (edfile, line no, col, ganze datei);
+  IF lines = 1 THEN delete record (edfile) FI .
+ 
+quelldatei schliessen :
+  IF   filename <> ""
+  THEN modify (source);
+       set range (source, ganze quelldatei);
+       to line (source, old line);
+       col (source, old col)
+  FI .
+ 
+zieldatei schliessen :
+  modify (edfile);
+  to line (lines);
+  col (range start col);
+  set range (edfile, ganze datei);
+  abschnitt neu (zeilenoffset + 1, lines) .
+END OP GET;
+
+ 
+OP G (TEXT CONST filename) :
+  GET filename
+END OP G;
+ 
+ 
+INT PROC len :
+  len (edfile)
+END PROC len;
+ 
+ 
+PROC col (INT CONST stelle) :
+  nichts neu; col (edfile, stelle)
+END PROC col;
+ 
+ 
+INT PROC col :
+  col (edfile)
+END PROC col;
+ 
+ 
+PROC limit (INT CONST limit) :
+  nichts neu; max line length (edfile, limit)
+END PROC limit;
+ 
+ 
+INT PROC limit :
+  max line length (edfile)
+END PROC limit;
+ 
+ 
+INT PROC lines :
+  lines (edfile)
+END PROC lines;
+ 
+ 
+INT PROC line no :
+  line no (edfile)
+END PROC line no;
+ 
+ 
+PROC to line (INT CONST satz nr) :
+  satznr neu;
+  edfile := editfile; 
+  IF   satz nr > lines 
+  THEN toline (edfile, lines); col (len + 1)
+  ELSE to line (edfile, satz nr)
+  FI
+END PROC to line;
+ 
+ 
+OP T (INT CONST satz nr) :
+  to line (satz nr)
+END OP T;
+ 
+ 
+PROC down (INT CONST anz) :
+  nichts neu; down (edfile, anz)
+END PROC down;
+ 
+ 
+OP D (INT CONST anz) :
+  down (anz)
+END OP D;
+ 
+ 
+PROC up (INT CONST anz) :
+  nichts neu; up (edfile, anz)
+END PROC up;
+ 
+ 
+OP U (INT CONST anz) :
+  up (anz)
+END OP U;
+ 
+ 
+PROC down (TEXT CONST muster) :
+  nichts neu;
+  REP
+    down (muster, schritt - line no MOD schritt);
+    IF   pattern found
+    THEN LEAVE down
+    ELSE satznr zeigen
+    FI
+  UNTIL eof PER
+END PROC down;
+ 
+ 
+OP D (TEXT CONST muster) :
+  down (muster)
+END OP D;
+ 
+ 
+PROC down (TEXT CONST muster, INT CONST anz) :
+  nichts neu; down (edfile, muster, anz)
+END PROC down;
+ 
+ 
+PROC up (TEXT CONST muster) :
+  nichts neu;
+  REP
+    up (muster, (line no - 1) MOD schritt + 1);
+    IF   pattern found
+    THEN LEAVE up
+    ELSE satznr zeigen
+    FI
+  UNTIL line no = 1 PER
+END PROC up;
+ 
+ 
+OP U (TEXT CONST muster) :
+  up (muster)
+END OP U;
+ 
+ 
+PROC up (TEXT CONST muster, INT CONST anz) :
+  nichts neu; up (edfile, muster, anz)
+END PROC up;
+ 
+ 
+PROC downety (TEXT CONST muster) :
+  nichts neu;
+  IF   NOT at (muster)
+  THEN down (muster)
+  FI
+END PROC downety;
+ 
+
+PROC downety (TEXT CONST muster, INT CONST anz) :
+  nichts neu; downety (edfile, muster, anz)
+END PROC downety;
+ 
+
+PROC uppety (TEXT CONST muster) :
+  nichts neu;
+  IF   NOT at (muster)
+  THEN up (muster)
+  FI
+END PROC uppety;
+
+ 
+PROC uppety (TEXT CONST muster, INT CONST anz) :
+  nichts neu; uppety (edfile, muster, anz)
+END PROC uppety;
+
+ 
+OP C (TEXT CONST old, new) :
+  change to (old, new)
+END OP C;
+ 
+OP C (TEXT CONST replacement) : 
+  IF   NOT write permission                                          (*sh*)
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  IF   at (edfile, match(0))
+  THEN zeile neu; change (edfile, matchpos(0), matchend(0), replacement)
+  FI
+END OP C; 
+ 
+PROC change to (TEXT CONST old, new) :
+  IF   NOT write permission                                          (*sh*)
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  nichts neu;
+  REP
+    downety (old, schritt - line no MOD schritt);
+    IF   pattern found
+    THEN change (edfile, matchpos(0), matchend(0), new);
+         col (col + LENGTH new); zeile neu;
+         LEAVE changeto
+    ELSE satznr zeigen
+    FI
+  UNTIL eof PER 
+END PROC change to;
+ 
+ 
+OP CA (TEXT CONST old, new) :
+  change all (old, new)
+END OP CA;
+ 
+
+PROC change all (TEXT CONST old, new) :
+  WHILE NOT eof REP old C new PER
+END PROC change all;
+ 
+ 
+BOOL PROC eof :
+  eof (edfile)
+END PROC eof;
+ 
+ 
+BOOL PROC mark :
+  mark (edfile)
+END PROC mark;
+ 
+ 
+PROC mark (BOOL CONST mark on) :
+  nichts neu;
+  IF   mark on
+  THEN mark (edfile, line no, col)
+  ELSE mark (edfile, 0, 0)
+  FI
+END PROC mark;
+ 
+ 
+BOOL PROC at (TEXT CONST pattern) :
+  at (edfile, pattern)
+END PROC at;
+ 
+TEXT PROC word :
+  word (edfile)
+END PROC word;
+
+ 
+TEXT PROC word (TEXT CONST sep) :
+  word (edfile, sep)
+END PROC word;
+
+ 
+TEXT PROC word (INT CONST len) :
+ word (edfile, len)
+END PROC word;
+ 
+ 
+LET no access = 0,
+    edit access = 1,
+    output access = 2;
+ 
+INT VAR last note file mode;
+FILE VAR notebook; 
+INITFLAG VAR this packet := FALSE;
+DATASPACE VAR note ds;
+ 
+ 
+PROC note (TEXT CONST text) :
+  access note file (output access);
+  write (notebook, text)
+END PROC note;
+ 
+
+PROC note (INT CONST number) :
+  access note file (output access);
+  put (notebook, number)
+END PROC note;
+ 
+
+PROC note line :
+  access note file (output access);
+  line (notebook)
+END PROC note line;
+ 
+
+BOOL PROC anything noted :
+  access note file (no access);
+  last note file mode = output access
+END PROC anything noted;
+ 
+
+FILE PROC note file :
+  access note file (output access);
+  notebook
+END PROC note file;
+ 
+
+PROC note edit (FILE VAR context) :                                  (*sh*)
+  access note file (edit access);
+  make notebook erasable;
+  IF aktueller editor = 0
+    THEN open editor (1, context, write acc, 1, 1, x size - 1, y size)
+  FI ;
+  get window size;
+  IF   window large enough
+  THEN include note editor;
+       edit (aktueller editor-1, aktueller editor, aktueller editor-1,
+             std res, PROC (TEXT CONST) std kommando interpreter)
+  FI .
+ 
+get window size : 
+  INT VAR x, y, windows x size, windows y size; 
+  get window (x, y, windows x size, windows y size) .
+ 
+window large enough :
+  windows y size > 4 .
+ 
+include note editor :
+  open editor (aktueller editor + 1, notebook, write acc,
+               x, y + (windows y size + 1) DIV 2,
+               windows x size, windows y size DIV 2) .
+ 
+make notebook erasable :
+  last note file mode := edit access .
+END PROC note edit;
+ 
+
+PROC note edit :
+  access note file (edit access);
+  make notebook erasable;
+  edit (notebook) .
+ 
+make notebook erasable :
+  last note file mode := edit access .
+END PROC note edit;
+ 
+ 
+PROC access note file (INT CONST new mode) :
+  disable stop;
+  initialize note ds if necessary;
+  IF   last note file mode < new mode
+  THEN forget (note ds);
+       note ds := nilspace;
+       notebook := sequential file (output, note ds);
+       headline (notebook, "notebook");
+       last note file mode := new mode
+  FI .
+ 
+initialize note ds if necessary :
+  IF   NOT initialized (this packet)
+  THEN note ds := nilspace;
+       last note file mode := no access
+  FI .
+END PROC access note file;
+
+END PACKET editor functions;
+
diff --git a/system/base/1.7.5/src/init b/system/base/1.7.5/src/init
new file mode 100644
index 0000000..471a717
--- /dev/null
+++ b/system/base/1.7.5/src/init
@@ -0,0 +1,251 @@
+ "run again impossible"
+ "recursive run"
+ "                              " 
+ " Compiler Error : " 
+"              "
+"                                    |" 
+" Fehler entdeckt  " 
+"Keine Fehler gefunden,  "
+" " 
+"       *******  ENDE DER UEBERSETZUNG  *******" 
+"FEHLER bei >> " 
+" <<  " 
+"weiter bei "
+"TEXTende (Anfuehrungszeichen) fehlt irgendwo"
+"Kommentarende fehlt irgendwo" 
+"nach dem Hauptprogramm darf kein Paket folgen"
+"ungueltiger Name fuer ein DEFINES-Objekt" 
+"':' fehlt"
+"nach ENDPACKET folgt nicht der Paketname" 
+"ENDPACKET fehlt" 
+"CONST oder VAR fehlt" 
+"ungueltiger Name"
+" ',' in Deklarationsliste fehlt"
+"ist nicht der PROC Name"
+"fehlerhaftes Ende des Hauptprogramms"
+"ENDPROC fehlt" 
+"PROC/OP Schachtelung unzulaessig" 
+"OP darf kein Parameter sein"
+"steht mehrfach im PACKET Interface" 
+" ist mehrfach deklariert" 
+"ist schon als Datenobjekt deklariert"
+"ist schon als PROC/OP deklariert" 
+"')' nach Parameterliste erwartet" 
+"Standard-Schluesselwort kann nicht redefiniert werden"
+"ungueltig als BOLD" 
+"'(' fehlt"
+"CONST bzw VAR nicht bei Strukturfeldern" 
+"'=' fehlt" 
+"Schluesselwort wird im Paket schon andersartig verwandt"
+"Datentyp fehlt" 
+"ungueltiger OP Name"
+"OP muss monadisch oder dyadisch sein" 
+"ist nicht der OP Name" 
+"ENDOP fehlt" 
+"Name nach ENDPROC fehlt" 
+"Name nach ENDOP fehlt" 
+"';' fehlt"
+"END END ist Unsinn"
+"Dieses END... kenne ich nicht"
+"ROW Groesse ist kein INT" 
+"ROW Groesse ist kein Denoter"
+"Ein ROW muss mindestens ein Element haben"
+"ROW Groesse fehlt" 
+"Parameter kann man nicht initialisieren"
+"Konstanten muessen initialisiert werden"
+"'::' verwenden"
+"')' fehlt" 
+"Exponent fehlt"
+"Undefinierter Typ" 
+"Rekursiv definierter Typ" 
+"Mehrfach definierter Selektor" 
+"Variable bzw. Abkuerzung in der Paket-Schnittstelle" 
+"undefinierte ROW Groesse"
+"Typ Deklarationen nur im Paketrumpf" 
+"CONST bzw. VAR ohne Zusammenhang" 
+"ist nicht deklariert, steht aber in der Paket-Schnittstelle" 
+"ist nicht deklariert"
+"unbekanntes Kommando"
+"THIS IS NO CORRECT EXTERNAL NUMBER." 
+"Schluesselwort unzulaessig"
+"Name erwartet" 
+"Denoter erwartet"
+"ENDPROC ohne Zusammenhang"
+"ENDOP ohne Zusammenhang"
+"Refinement ohne Zusammenhang"
+"Delimiter zwischen Paket-Refinement und Deklaration fehlt"
+"unzulaessiges Selektor-Symbol (kein Name)"
+"BOUND Schachtelungen unzulaessig"
+"BOUND-Objekte unzulaessig als Parameter"
+"Textende fehlt" 
+"TEXT-Denoter zu lang"
+
+"Denoter-Wert wird fuer diese Maschine zu gross" 
+"Compiler-Fehler, wenden Sie sich an Ihren Systemberater!"
+"ist ein zusammenhangloses Schluesselwort"
+"'::' nur fuer Initialisierungen, sonst ':='"
+"welches Objekt soll verlassen werden?"
+"du bist gar nicht innerhalb dieses Refinements"
+"nur die eigene PROC / OP kann verlassen werden"
+"THEN fehlt"
+"FI fehlt"
+"BOOL-Ausdruck erwartet" 
+"ELSE-Teil ist notwendig, da ein Wert geliefert wird"
+"INT-Ausdruck erwartet"
+"OF fehlt"
+"Keine Typanpassung moeglich"
+"CASE-Label fehlt"
+"mindestens eine CASE-Anweisung geben"
+"CASE-Label ist zu gross (skipped)" 
+"mehrfach definiertes CASE-Label"
+"ungueltiges Zeichen nach CASE-Label" 
+"OTHERWISE-Teil fehlt"
+"END SELECT fehlt" 
+"rekursiver Aufruf eines Refinements"
+" wird nicht benutzt" 
+"';' oder Operator ('+','-',...) fehlt"
+"undefinierter monadischer Operator" 
+"undefinierter dyadischer Operator" 
+"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" 
+"fuer diesen Typ nicht definierter Selektor" 
+"INT,REAL,BOOL,TEXT koennen nicht selektiert werden"
+"bei ROWs nur Subscription"
+"nicht selektierbar" 
+"unzulaessiger Index fuer Subscription"
+"'[' ohne Zusammenhang"
+"']' ohne Zusammenhang"
+"']' nach Subscription fehlt"
+"ungueltig zwischen Anweisungen"
+"nur die letzte Anweisung eines Abschnitts darf einen Wert liefern"
+"Der Paketrumpf kann keinen Wert liefern" 
+"anstelle des letzten Symbols wurde ein Operand erwartet" 
+"Der Schleifenrumpf darf keinen Wert liefern"
+"die Laufvariable muss eine INT VAR sein"
+"wird schon in einer aeusseren Schleife als Laufvariable benutzt"
+"FROM erwartet"
+"UPTO bzw DOWNTO fehlt"
+"REPEAT fehlt"
+"END REP fehlt"
+"die Konstante darf nicht veraendert werden"
+"in einer FOR-Schleife darf die Laufvariable nicht veraendert werden"
+"falscher Typ des Resultats" 
+"ist CONST, es wird aber ein VAR Parameter verlangt"
+"unbekannte Prozedur"
+"Parameter-Prozedur liefert falsches Resultat" 
+"Anzahl bzw. Typen der Parameter sind falsch"
+"unbekannte Parameter-Prozedur" 
+"aktuelle Parameter-Prozedur hat CONST-, formale hat VAR-Parameter"
+"Kein Konstruktor moeglich, da die Feinstruktur hier unbekannt ist"
+"zu wenig Felder angegeben"
+"zu viele Felder angegeben"
+"unzulaessiger Trenner zwischen Feldern"
+"Feld hat falschen Typ"
+"falsche Element-Anzahl im ROW-Konstruktor" 
+"Dieser Typ kann nicht noch mehr konkretisiert werden"
+"BOUND-Objekt zu gross"
+
+"Warnung in Zeile "
+"   Zeile "
+"in Zeile "
+" <----+---> " 
+" TYPE undefiniert "
+" MODE undefiniert "
+"Parameter spezifiziert: "
+"Parameter Typ(en) sind: "
+" B Code, "
+" B Paketdaten generiert"
+"Operand: "
+"Operanden: "
+", "
+"erwartet "
+"gefunden "
+" "
+ 
+(* 001 *)    END
+(* 002 *)    ENDPACKET 
+(* 003 *)    ENDOP
+(* 004 *)    ENDOPERATOR
+(* 005 *)    ENDPROC 
+(* 006 *)    ENDPROCEDURE 
+(* 007 *)    PACKET
+(* 008 *)    OP 
+(* 009 *)    OPERATOR 
+(* 010 *)    PROC 
+(* 011 *)    PROCEDURE 
+(* 012 *)    FI 
+(* 013 *)    ENDIF
+(* 014 *)    ENDREP
+(* 015 *)    ENDREPEAT 
+(* 016 *)    PER 
+(* 017 *)    ELIF 
+(* 018 *)    ELSE
+(* 019 *)    UNTIL 
+(* 020 *)    CASE
+(* 021 *)    OTHERWISE
+(* 022 *)    ENDSELECT
+(* 023 *)    INTERNAL
+(* 024 *)    DEFINES
+(* 025 *)    LET 
+(* 026 *)    TYPE
+(* 027 *)    INT
+(* 028 *)    REAL
+(* 029 *)    DATASPACE
+(* 030 *)    TEXT
+(* 031 *)    BOOL
+(* 032 *)    BOUND
+(* 033 *)    ROW
+(* 034 *)    STRUCT
+(* 035 *)    CONST 
+(* 036 *)    VAR 
+(* 037 INIT CONTROL *)    INTERNAL
+(* 038 *)     CONCR
+(* 039 *)     REP
+(* 040 *)     REPEAT
+(* 041 *)     SELECT
+(* 042 *)     EXTERNAL
+(* 043 *)     IF
+(* 044 *)     THEN 
+(* 045 *)     OF
+(* 046 *)     FOR
+(* 047 *)     FROM
+(* 048 *)     UPTO 
+(* 049 *)     DOWNTO
+(* 050 *)     WHILE
+(* 051 *)     LEAVE
+(* 052 *)     WITH
+(* 053 *)     TRUE
+(* 054 *)     FALSE
+(* 055 *)     ::  SBL  :=  INCR  DECR 
+(* 056 *)     + - * / DIV MOD
+              **
+              AND
+              CAND
+              OR
+              COR
+              NOT
+              =  <>  >  >= < <= 
+(*040  *)     MAIN 
+(*043*)  ENDOFFILE 
+ 
+PACKET a :
+
+PROC out (TEXT CONST t) :
+  EXTERNAL 60
+ENDPROC out ;
+
+PROC out text (TEXT CONST t, INT CONST typ) :
+  INTERNAL 257 ;
+  IF typ = typ
+    THEN out (t)
+  FI
+ENDPROC out text ;
+
+PROC out line (INT CONST typ) :
+  INTERNAL 258 ;
+  IF typ = typ
+    THEN out (""13""10"")
+  FI
+ENDPROC out line ;
+
+ENDPACKET a ; 
+
diff --git a/system/base/1.7.5/src/integer b/system/base/1.7.5/src/integer
new file mode 100644
index 0000000..aefb77f
--- /dev/null
+++ b/system/base/1.7.5/src/integer
@@ -0,0 +1,265 @@
+(* -------------------   STAND :        23.10.85 --------------------*)
+PACKET integer DEFINES text, int, MOD,
+                       sign, SIGN, abs, ABS, **, min, max, minint, maxint,
+                       random, initialize random ,
+                       last conversion ok, set conversion :
+ 
+INT PROC minint : -32767 - 1 ENDPROC minint ;
+
+INT PROC maxint : 32767 ENDPROC maxint ;
+ 
+ 
+TEXT PROC text (INT CONST number) : 
+ 
+  IF   number =  minint THEN "-32768"
+  ELIF number <  0      THEN "-" + text(-number) 
+  ELIF number <= 9      THEN code (number + 48) 
+                        ELSE text (number DIV 10) + digit 
+  FI . 
+ 
+digit : 
+  code ( number MOD 10 + 48 ) . 
+ 
+ENDPROC text ;
+ 
+TEXT PROC text (INT CONST number, length) : 
+ 
+  TEXT VAR result := text (number) ;
+  INT CONST number length := LENGTH result ;
+  IF number length < length 
+    THEN (length - number length) * " " + result 
+  ELIF number length > length 
+    THEN length * "*" 
+  ELSE   result 
+  FI 
+ 
+ENDPROC text ;
+ 
+INT PROC int (TEXT CONST number) : 
+ 
+  skip blanks and sign ;
+  get value ;
+  result . 
+ 
+skip blanks and sign : 
+  BOOL VAR number is positive ;
+  INT VAR pos := 1 ;
+  skip blanks ;
+  IF (number SUB pos) = "-"
+    THEN number is positive := FALSE ;
+         pos INCR 1
+  ELIF (number SUB pos) = "+"
+    THEN number is positive := TRUE ;
+         pos INCR 1
+  ELSE   number is positive := TRUE
+  FI . 
+ 
+get value : 
+  INT VAR value ;
+  get first digit ;
+  WHILE is digit REP 
+    value := value * 10 + digit ; 
+    pos INCR 1 
+  PER ;
+  set conversion ok result .
+
+get first digit :
+  IF is digit
+    THEN value := digit ;
+         pos INCR 1
+    ELSE set conversion (FALSE) ;
+         LEAVE int WITH 0
+  FI .
+ 
+is digit : 0 <= digit AND digit <= 9 . 
+ 
+digit : code (number SUB pos) - 48 .
+ 
+result : 
+  IF number is positive
+    THEN   value 
+    ELSE - value 
+  FI .
+ 
+set conversion ok result :
+  skip blanks ;
+  conversion ok := (pos > LENGTH number) .
+ 
+skip blanks :
+  WHILE (number SUB pos) = " " REP
+    pos INCR 1
+  PER .
+ 
+ENDPROC int ;
+ 
+INT OP MOD (INT CONST left, right) : 
+ 
+  EXTERNAL 43
+ 
+ENDOP MOD ;
+
+INT PROC sign (INT CONST argument) : 
+ 
+  IF argument < 0 THEN -1 
+  ELIF argument > 0 THEN 1 
+  ELSE 0 
+  FI 
+ 
+ENDPROC sign ; 
+ 
+INT OP SIGN (INT CONST argument) : 
+  sign (argument) 
+ENDOP SIGN ;
+ 
+INT PROC abs (INT CONST argument) : 
+ 
+  IF argument > 0 THEN argument 
+  ELSE - argument 
+  FI 
+ 
+ENDPROC abs ;
+ 
+INT OP ABS (INT CONST argument) : 
+  abs (argument) 
+ENDOP ABS ;
+ 
+INT OP ** (INT CONST arg, exp) : 
+ 
+  INT VAR x := arg , z := 1 ,
+          counter := exp ;
+ 
+  IF exp = 0 
+    THEN LEAVE ** WITH 1
+  ELIF exp < 0
+    THEN LEAVE ** WITH 1 DIV arg
+  FI ;
+ 
+  WHILE counter >= 2 REP 
+    calculate new x and z ;
+    counter := counter DIV 2 ;
+  ENDREP ;
+  z * x . 
+ 
+calculate new x and z : 
+  IF counter is not even 
+    THEN z := z * x 
+  FI ;
+  x := x * x . 
+ 
+counter is not even : 
+  counter MOD 2 = 1 . 
+ 
+ENDOP ** ;
+ 
+INT PROC min (INT CONST first, second) : 
+ 
+  IF first < second THEN first ELSE second FI 
+ 
+ENDPROC min ;
+ 
+INT PROC max (INT CONST first, second) : 
+ 
+  IF first > second THEN first ELSE second FI 
+ 
+ENDPROC max ; 
+ 
+ 
+ 
+BOOL VAR conversion ok := TRUE ;
+ 
+BOOL PROC last conversion ok :
+  conversion ok
+ENDPROC last conversion ok ;
+ 
+PROC set conversion (BOOL CONST success) :
+  conversion ok := success
+ENDPROC set conversion ;
+ 
+ 
+ 
+(*******************************************************************)
+(*                                                                 *)
+(*                                        Autor: A. Flammenkamp    *)
+(*       RANDOM GENERATOR                                          *)
+(*                                                                 *)
+(*                         x    :=  4095 * x  MOD (4095*4096+4093) *)
+(*                          n+1             n                      *)
+(*                                                                 *)
+(*                         Periode: 2**24-4  >  16.0e6             *)
+(*                                                                 *)
+(*       Beachte:  x = 4096 * x1 + x0,  0 <= x0,x1 < 4096          *)
+(*                                                                 *)
+(*******************************************************************)
+
+
+INT VAR high := 1, low := 0 ;
+
+PROC initialize random (INT CONST start) :
+
+  low := start MOD 4096 ;
+  IF start < 0
+    THEN high := 256 + 16 + start DIV 4096 ;
+         IF low <> 0 THEN high DECR 1 FI
+    ELSE high := 256 + start DIV 4096
+  FI
+
+ENDPROC initialize random ;
+
+INT PROC random (INT CONST lower bound, upper bound) :
+
+  compute new random value ;
+  normalize high ;
+  normalize low ;
+  map into interval .
+
+compute new random value :
+  (*  (high,low) := (low-high , 3*high-low) *)
+  high := low - high ;
+  low INCR low - 3 * high .
+
+normalize high :
+  IF high < 0
+    THEN high INCR 4096 ; low DECR 3
+  FI .
+
+normalize low :
+  (*  high INCR low DIV 4096 ;
+      low := low MOD 4096
+  *)
+  IF low >= 4096 THEN low overflow
+  ELIF low < 0   THEN low underflow
+  FI .
+
+low overflow :
+  IF low >= 8192
+    THEN low DECR 8192 ; high INCR 2
+    ELSE low DECR 4096 ; high INCR 1 ; post normalization
+  FI .
+
+post normalization :
+  (*  IF (high,low) >= (4095,4093)
+        THEN (high,low) DECR (4095,4093)
+      FI
+  *)
+  IF high >= 4095
+    THEN IF    low >= 4093 THEN high DECR 4095 ; low DECR 4093
+         ELIF high  = 4096 THEN high := 0      ; low INCR 3
+         FI
+  FI .
+
+low underflow :
+  low INCR 4096 ; high DECR 1 .
+
+map into interval :
+  INT VAR number := high MOD 16 - 8 ;
+  number INCR 4095 * number + low ;
+  IF lower bound <= upper bound
+    THEN lower bound + number MOD (upper bound - lower bound + 1)
+    ELSE upper bound + number MOD (lower bound - upper bound + 1)
+  FI .
+
+ENDPROC random ;
+
+
+ENDPACKET integer ;
+
diff --git a/system/base/1.7.5/src/local manager b/system/base/1.7.5/src/local manager
new file mode 100644
index 0000000..48d024b
--- /dev/null
+++ b/system/base/1.7.5/src/local manager
@@ -0,0 +1,373 @@
+(* ------------------- VERSION 2     24.02.86 ------------------- *)
+PACKET local manager                         (* Autor: J.Liedtke  *) 
+ 
+  DEFINES 
+          create,        (* neue lokale Datei einrichten *) 
+          new,           (* 'create' und Datei liefern   *) 
+          old,           (* bestehende Datei liefern     *) 
+          forget,        (* lokale Datei loeschen        *) 
+          exists,        (* existiert Datei (lokal) ?    *) 
+          status,        (* setzt und liefert Status     *)
+          rename,        (* Umbenennung                  *) 
+          copy ,         (* Datenraum in Datei kopieren  *) 
+          enter password,(* Passwort einfuehren          *)
+          write password ,
+          read password ,
+          write permission ,
+          read permission ,
+          begin list ,
+          get list entry ,
+          all :
+
+ 
+ 
+LET size = 200 ,
+    nil  = 0 ;
+
+INT VAR index ; 
+ 
+TEXT VAR system write password := "" ,
+         system read password := "" ,
+         actual password ;
+
+INITFLAG VAR this packet := FALSE ;
+
+DATASPACE VAR password space ;
+
+BOUND ROW size STRUCT (TEXT write, read) VAR passwords ;
+ 
+ 
+THESAURUS VAR dir := empty thesaurus ;
+
+ROW size STRUCT (DATASPACE ds,
+                 BOOL protected,
+                 TEXT status) VAR crowd ;
+ 
+
+PROC initialize if necessary :
+
+  IF NOT initialized (this packet)
+    THEN system write password := "" ;
+         system read password := "" ;
+         dir := empty thesaurus ;
+         password space := nilspace ;
+         passwords := password space 
+  FI
+
+ENDPROC initialize if necessary ;
+
+ 
+ 
+PROC create (TEXT CONST name) : 
+ 
+IF exists (name )
+  THEN error (name, "existiert bereits") ; 
+       index := nil 
+  ELSE insert and initialize entry 
+FI . 
+ 
+insert and initialize entry : 
+  disable stop ;
+  insert (dir, name, index) ; 
+  IF index <> nil 
+    THEN crowd (index).ds := nilspace ;
+         IF is error
+           THEN delete (dir, name, index) ;
+                LEAVE create 
+         FI ;
+         status (name, "") ;
+         crowd (index).protected := FALSE
+  ELIF NOT is error
+    THEN errorstop ("zu viele Dateien")
+  FI . 
+ 
+ENDPROC create ; 
+ 
+DATASPACE PROC new (TEXT CONST name) : 
+ 
+  create (name) ; 
+  IF index <> nil 
+    THEN crowd (index).ds 
+    ELSE nilspace 
+  FI 
+ 
+ENDPROC new ; 
+ 
+DATASPACE PROC old (TEXT CONST name) : 
+ 
+  initialize if necessary ;
+  index := link (dir, name) ;
+  IF index = 0
+    THEN error (name, "gibt es nicht") ;
+         nilspace
+    ELSE space
+  FI .
+
+space : crowd (index).ds .
+ 
+ENDPROC old ; 
+ 
+DATASPACE PROC old (TEXT CONST name, INT CONST expected type) :
+
+  initialize if necessary ;
+  index := link (dir, name) ;
+  IF index = 0
+    THEN error (name, "gibt es nicht") ;
+         nilspace
+  ELIF type (space) <> expected type
+    THEN errorstop ("Datenraum hat falschen Typ") ;
+         nilspace
+    ELSE space
+  FI .
+
+space : crowd (index).ds .
+
+ENDPROC old ;
+
+BOOL PROC exists (TEXT CONST name) : 
+ 
+  initialize if necessary ;
+  dir CONTAINS name 
+ 
+ENDPROC exists ; 
+ 
+PROC forget (TEXT CONST name ) : 
+ 
+  initialize if necessary ;
+  say ("""") ;
+  say (name) ;
+  IF   NOT exists (name)   THEN say (""" existiert nicht") 
+  ELIF yes (""" loeschen") THEN forget (name, quiet)
+  FI .
+ 
+ENDPROC forget ;
+
+PROC forget (TEXT CONST name, QUIET CONST q) :
+  
+  initialize if necessary ;
+  disable stop ;
+  delete (dir, name, index) ; 
+  IF index <> nil 
+    THEN forget ( crowd (index).ds ) ;
+         crowd (index).status := ""
+  FI .
+ 
+ENDPROC forget ; 
+ 
+PROC forget :
+ 
+  BOOL VAR status := command dialogue ;
+  command dialogue (TRUE) ;
+  forget (last param) ;
+  command dialogue (status)
+ 
+ENDPROC forget ;
+ 
+PROC status (TEXT CONST name, status text) :
+ 
+  initialize if necessary ;
+  INT VAR index := link (dir, name) ; 
+  IF index > 0 
+    THEN crowd (index).status := date + " " + text (status text, 4)
+  FI 
+ 
+ENDPROC status ; 
+ 
+TEXT PROC status (TEXT CONST name) :
+ 
+  initialize if necessary ;
+  INT VAR index := link (dir, name) ;
+  IF index > 0
+    THEN crowd (index).status
+    ELSE ""
+  FI
+ 
+ENDPROC status ;
+ 
+PROC status (INT CONST pos, TEXT CONST status pattern) :
+ 
+  initialize if necessary ;
+  INT VAR index := 0 ;
+  WHILE index < highest entry (dir) REP
+    index INCR 1 ;
+    replace (actual status, pos , status pattern)
+  PER .
+ 
+actual status : crowd (index).status .
+ 
+ENDPROC status ;
+ 
+PROC copy (DATASPACE CONST source, TEXT CONST dest name) : 
+ 
+  IF exists (dest name)
+    THEN error (dest name, "existiert bereits") 
+    ELSE copy file
+  FI .
+ 
+copy file :
+  disable stop ;
+  create ( dest name ) ;
+  INT VAR index := link (dir, dest name) ;
+  IF index > nil
+    THEN forget (crowd (index).ds) ;
+         crowd (index).ds := source 
+  FI 
+ 
+ENDPROC copy ; 
+ 
+PROC copy (TEXT CONST source name, dest name) :
+ 
+  copy (old (source name), dest name)
+ 
+ENDPROC copy ;
+ 
+PROC rename (TEXT CONST old name, new name) : 
+ 
+  IF exists (new name)
+    THEN error (new name, "existiert bereits")
+  ELIF exists (old name)
+    THEN rename (dir, old name, new name) ;
+         last param (new name)
+  ELSE   error (old name, "gibt es nicht")
+  FI .
+ 
+ENDPROC rename ;
+ 
+ 
+PROC begin list :
+ 
+  initialize if necessary ;
+  index := 0
+ 
+ENDPROC begin list ;
+ 
+PROC get list entry (TEXT VAR entry, status text) :
+ 
+  get (dir, entry, index) ;
+  IF found 
+    THEN status text := crowd (index).status ;
+    ELSE status text := "" ;
+  FI .
+ 
+found : index > 0 .
+ 
+ENDPROC get list entry ;
+ 
+ 
+TEXT PROC write password :
+ 
+  system write password
+ 
+ENDPROC write password ;
+ 
+TEXT PROC read password :
+ 
+  system read password
+ 
+ENDPROC read password ;
+ 
+
+PROC enter password (TEXT CONST password) :
+ 
+  initialize if necessary ;
+  say (""3""5"") ;
+  INT CONST slash pos := pos (password, "/") ;
+  IF slash pos = 0
+    THEN system write password := password ;
+         system read password  := password
+    ELSE system write password := subtext (password, 1, slash pos-1) ;
+         system read password  := subtext (password, slash pos+1)
+  FI .
+ 
+ENDPROC enter password ;
+ 
+PROC enter password (TEXT CONST file name, write pass, read pass) :
+ 
+  INT CONST index := link (dir, file name) ;
+  IF index > 0
+    THEN set protect password
+  FI .
+
+set protect password :
+  IF write pass = "" AND read pass = ""
+    THEN crowd (index).protected := FALSE
+    ELSE crowd (index).protected := TRUE ;
+         passwords (index).write := write pass ;
+         passwords (index).read  := read pass
+  FI .
+ 
+ENDPROC enter password ;
+ 
+INT PROC password index (TEXT CONST file name) :
+
+  initialize if necessary ;
+  INT CONST index := link (dir, file name) ;
+  IF index > 0 CAND crowd (index).protected
+    THEN index
+    ELSE 0
+  FI
+
+ENDPROC password index ;
+
+BOOL PROC read permission (TEXT CONST name, supply password) :
+ 
+  (****************************************************************) 
+  (*  for reasons of data security the password check algorithm   *)
+  (*  must not copy parts of the file password into variables     *)
+  (*  located in the standard dataspace!                          *)
+  (****************************************************************)
+
+  access file password ;
+  file has no password COR (supply password <> "-" AND read password match) .
+
+read password match :
+  file password.read = supply password OR file password.read = "" .
+
+access file password :
+  INT CONST pw index := password index (name) .
+
+file password :  passwords (pw index) .
+
+file has no password :  pw index = 0 .
+
+ENDPROC read permission ;
+ 
+BOOL PROC write permission (TEXT CONST name, supply password) :
+ 
+  (****************************************************************) 
+  (*  for reasons of data security the password check algorithm   *)
+  (*  must not copy parts of the file password into variables     *)
+  (*  located in the standard dataspace!                          *)
+  (****************************************************************)
+
+  access file password ;
+  file has no password COR (supply password <> "-" AND write password match).
+
+write password match :
+  file password.write = supply password OR file password.write = "" .
+
+access file password :
+  INT CONST pw index := password index (name) .
+
+file password :  passwords (pw index) .
+
+file has no password :  pw index = 0 .
+
+ENDPROC write permission ;
+ 
+THESAURUS PROC all :
+
+  initialize if necessary ;
+  THESAURUS VAR result := dir ; (*ueberfluessig ab naechstem Compiler *)
+  result
+
+ENDPROC all ;
+
+PROC error (TEXT CONST file name, error text) :
+
+  errorstop ("""" + file name + """ " + error text)
+
+ENDPROC error ;
+
+ENDPACKET local manager ;
+
diff --git a/system/base/1.7.5/src/local manager 2 b/system/base/1.7.5/src/local manager 2
new file mode 100644
index 0000000..8f70301
--- /dev/null
+++ b/system/base/1.7.5/src/local manager 2
@@ -0,0 +1,41 @@
+ 
+PACKET local manager part 2 DEFINES            (* Autor: J.Liedtke *)
+                                               (* Stand: 25.02.85  *)
+  list :
+ 
+ 
+TEXT VAR file name, status text;
+
+
+PROC list :
+ 
+  disable stop ;
+  DATASPACE VAR ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  headline (list file, "list") ;
+  list (list file) ;
+  show (list file) ;
+  forget (ds) .
+ 
+ENDPROC list ;
+ 
+PROC list (FILE VAR f) :
+ 
+  enable stop ;
+  begin list ;
+  putline (f, "") ;
+  REP
+    get list entry (file name, status text) ;
+    IF file name = ""
+      THEN LEAVE list
+    FI ;
+    write (f, status text + "  """ ) ;
+    write (f, file name) ;
+    write (f, """") ;
+    line (f)
+  PER .
+ 
+ENDPROC list ;
+ 
+ENDPACKET local manager part 2 ;
+
diff --git a/system/base/1.7.5/src/mathlib b/system/base/1.7.5/src/mathlib
new file mode 100644
index 0000000..c726495
--- /dev/null
+++ b/system/base/1.7.5/src/mathlib
@@ -0,0 +1,268 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET mathlib DEFINES sqrt, **, exp, ln, log2, log10, e, pi,
+                       sin, cos, tan, sind, cosd, tand,
+                       arctan, arctand, random, initializerandom :
+ 
+LET  pii   =  3.141592653589793238462,
+     pi2   =  1.570796326794896619231,
+     pi3   =  1.047197551196597746154,
+     pi6   =  0.523598775598298873077,
+     pi4   =  1.273239544735162686151,
+     ln2   =  0.693147180559945309417,
+     lg2   =  0.301029995663981195213,
+     ln10  =  2.302585092994045684018,
+     lge   =  0.434294481903251827651,
+     ei    =  2.718281828459045235360,
+     pi180 = 57.295779513082320876798,
+     sqrt3 =  1.732050807568877293527,
+     sqr3  =  0.577350269189625764509,
+     sqr3p2=  3.732050807568877293527,
+     sqr3m2=  0.267949192431122706473,
+     sqr2  =  0.707106781186547524400;
+
+REAL VAR rdg::0.4711; 
+ 
+REAL PROC pi:   pii     END PROC pi; 
+REAL PROC e :   ei      END PROC e; 
+ 
+REAL PROC  ln  ( REAL CONST x ): 
+     log2(x) * ln2
+END PROC ln; 
+ 
+REAL PROC log10( REAL CONST x ): 
+     log2(x) * lg2 
+END PROC log10; 
+
+REAL PROC log2 ( REAL CONST z ): 
+ REAL VAR t, summe::0.0, x::z;
+ IF   x=1.0  THEN 0.0
+ ELIF x>0.0  THEN normal
+             ELSE errorstop("log2: " + text (x,20)); 0.0   FI. 
+
+normal: 
+  IF   x >= 0.5   THEN  normalise downwards 
+                  ELSE  normalise upwards      FI; 
+  IF   x < sqr2   THEN  summe := summe - 0.75; t := trans8
+                  ELSE  summe := summe - 0.25; t := trans2  FI;
+  summe + reihenentwicklung. 
+ 
+ normalise downwards: 
+  WHILE  x >= 8.0 REP    x := 0.0625 * x;  summe:=summe+4.0  PER; 
+  WHILE  x >= 1.0 REP    x :=    0.5 * x;  summe:=summe+1.0  PER. 
+ 
+ normalise upwards: 
+  WHILE x<=0.0625 REP    x :=   16.0 * x;  summe:=summe-4.0  PER; 
+  WHILE x<= 0.5   REP    x :=    2.0 * x;  summe:=summe-1.0  PER. 
+ 
+ trans8: (x - 0.5946035575013605)/(x + 0.5946035575013605). 
+ trans2: (x - 0.8408964152537145)/(x + 0.8408964152537145).
+ 
+ reihenentwicklung:  x := t * t;         t * 0.06405572387119384648 * 
+  ((((((3.465*x+4.095)*x+5.005)*x+6.435)*x+9.009)*x+15.015)*x+45.045)
+END PROC log2;
+ 
+REAL PROC sqrt ( REAL CONST z ): 
+  REAL VAR y0, y1, x::z; 
+  INT  VAR p :: decimal exponent(x) DIV 2; 
+  IF   p <= -64  THEN 0.0
+  ELIF x < 0.0  THEN errorstop("sqrt: " + text (x,20)); 0.0
+                ELSE nontrivial    FI. 
+ 
+ nontrivial: 
+  set exp (decimal exponent (x) -p-p, x);
+  IF x<10.0 THEN x := 5.3176703 - 40.760905/( 8.408065 + x )
+            ELSE x := 16.81595  - 1288.973 /( 84.08065 + x )  FI; 
+  y0 := x;
+  set exp (decimal exponent (x) + p, y0);
+  y1 := 0.5 * ( y0 + z/y0 ); 
+  y0 := 0.5 * ( y1 + z/y1 ); 
+  y1 := 0.5 * ( y0 + z/y0 ); 
+        0.5 * ( y1 + z/y1 ) 
+END PROC sqrt; 
+ 
+REAL PROC exp ( REAL CONST z ): 
+ REAL VAR x::z, a::1.0;  BOOL VAR negativ :: x<0.0;
+ IF   negativ        THEN x := -x  FI;
+ IF   x>292.42830676 
+   THEN IF NOT negativ THEN errorstop ("REAL-Ueberlauf") FI ; 0.0
+ ELIF x<=0.0001 
+   THEN ( 0.5*z + 1.0 ) * z + 1.0
+   ELSE approx 
+ FI.
+ 
+ approx: 
+ IF x > ln10 
+ THEN x := lge*x; 
+      a := 1.0;
+      set exp (int(x), a);
+      x := frac(x)*ln10
+ FI;
+ IF x >= 2.0   THEN a := 7.389056098930650227230*a; x := x-2.0   FI;
+ IF x >= 1.0   THEN a := 2.718281828459045235360*a; x := x-1.0   FI;
+ IF x >= 0.5   THEN a := 1.648721270700128146848*a; x := x-0.5   FI;
+ IF x >= 0.25  THEN a := 1.284025416687741484073*a; x := x-0.25  FI;
+ IF x >= 0.125 THEN a := 1.133148453066826316829*a; x := x-0.125 FI;
+ IF x >= 0.0625THEN a := 1.064494458917859429563*a; x := x-0.0625FI;
+ a:=a/50.4*(((((((0.01*x+0.07)*x+0.42)*x+2.1)*x+8.4)*x+25.2)*x+50.4)*x+50.4);
+ IF negativ THEN 1.0/a ELSE a FI .
+
+ENDPROC exp ;
+
+REAL PROC tan (REAL CONST x): 
+  IF x < 0.0 THEN - tg( -x * pi4)
+             ELSE   tg(  x * pi4)  FI
+END PROC tan; 
+ 
+REAL PROC tand (REAL CONST x): 
+  IF x < 0.0 THEN - tg( -x / 45.0)
+             ELSE   tg(  x / 45.0) FI
+END PROC tand; 
+ 
+REAL PROC tg (REAL CONST x ): 
+  REAL VAR q::floor(x), s::x-q; INT VAR n;
+  q := q - floor(0.25*q) * 4.0 ; 
+  IF q < 2.0
+  THEN IF q < 1.0
+       THEN n:=0;
+       ELSE n:=1; s := 1.0 - s FI
+  ELSE IF q < 3.0
+       THEN n:=2;
+       ELSE n:=3; s := 1.0 - s FI
+  FI;
+  q := s * s;
+  q := (((((((((-5.116186989653120e-11*q-5.608325022830701e-10)*q- 
+  9.526170109403018e-9)*q-1.517906721393745e-7)*q-2.430939946375515e-6)*q- 
+  3.901461426385464e-5)*q-6.324811612385572e-4)*q-1.076606829172646e-2)*q- 
+  0.2617993877991508)*q+pi4); 
+
+  SELECT n OF
+  CASE 0 : s/q
+  CASE 1 : q/s
+  CASE 2 : -q/s
+  OTHERWISE : -s/q ENDSELECT  .
+
+END PROC tg;
+
+REAL PROC sin ( REAL CONST x ): 
+  REAL VAR y, r, q;
+  IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI;
+  y := y * pi4;
+  r := floor(y);
+  sincos( q+r , y-r )
+END PROC sin; 
+ 
+REAL PROC sind ( REAL CONST x ): 
+  REAL VAR y, r, q; 
+  IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI;
+  y := y / 45.0;
+  r := floor(y);
+  sincos( q+r , y-r )
+END PROC sind; 
+ 
+REAL PROC cos ( REAL CONST x ): 
+  REAL VAR y, q; 
+  IF x < 0.0 THEN y := -x ELSE y := x FI;
+  y := y * pi4;
+  q := floor(y); 
+  sincos( q+2.0, y-q )
+END PROC cos; 
+ 
+REAL PROC cosd ( REAL CONST x ): 
+  REAL VAR y, q; 
+  IF x < 0.0 THEN y := -x ELSE y := x FI;
+  y := y / 45.0;
+  q := floor(y);
+  sincos( q+2.0, y-q )
+END PROC cosd; 
+ 
+REAL PROC sincos ( REAL CONST q, y ): 
+ REAL VAR r :: q - floor( 0.125*q + 0.1 ) * 8.0;
+ IF r >= 4.0 THEN IF r >= 6.0 THEN IF r >= 7.0 THEN - sin approx(1.0-y)
+                                               ELSE - cos approx(y)  FI
+                              ELSE IF r >= 5.0 THEN - cos approx(1.0-y)
+                                               ELSE - sin approx(y)  FI FI
+             ELSE IF r >= 2.0 THEN IF r >= 3.0 THEN   sin approx(1.0-y)
+                                               ELSE   cos approx(y)  FI
+                              ELSE IF r >= 1.0 THEN   cos approx(1.0-y)
+                                               ELSE   sin approx(y)  FI FI FI
+END PROC sincos; 
+ 
+REAL PROC sin approx ( REAL CONST x ): 
+ REAL VAR z::x*x; 
+ x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.3133616216672568
+ e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1)*
+ z+0.7853981633974483)
+END PROC sin approx; 
+ 
+REAL PROC cos approx ( REAL CONST x ): 
+ REAL VAR z::x*x; 
+ ((((((-0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e-7
+ )*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1)
+ *z-0.3084251375340425)*z+1.0
+END PROC cos approx; 
+ 
+REAL PROC arctan ( REAL CONST y ): 
+ REAL VAR f, z, x; BOOL VAR neg :: y < 0.0;
+ IF   neg   THEN x := -y ELSE x := y FI;
+ IF   x>1.0 THEN f := a ELSE f := -b; neg := NOT neg FI;
+ z := x * x;
+ x := x/(((((((0.0107090276046822*z-0.01647757182108040)*z 
+      +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z 
+      -0.0888888888888888)*z+0.3333333333333333)*z+1.0);
+ IF   neg   THEN  x - f  ELSE  f - x  FI.
+
+ a:IF x>sqr3p2 THEN x := 1.0/x; pi2 ELSE x := 4.0/(sqrt3+x+x+x)-sqr3; pi3 FI.
+ b:IF x<sqr3m2 THEN   0.0           ELSE x := sqrt3 - 4.0/(sqrt3+x);  pi6 FI
+END PROC arctan; 
+ 
+REAL PROC arctand ( REAL CONST x ): 
+  arctan(x) * pi180
+END PROC arctand; 
+ 
+REAL OP ** ( REAL CONST b, e ): 
+ IF b=0.0 
+   THEN IF e=0.0 THEN 1.0 ELSE 0.0 FI
+ ELIF b < 0.0 
+   THEN errorstop("("+text(b,20)+") ** "+text(e)); (-b) ** e
+ ELSE   exp( e * log2( b ) * ln2 )
+ FI
+END OP **;
+ 
+REAL OP ** ( REAL CONST a, INT CONST b ) : 
+
+  REAL VAR p := 1.0 ,
+           r := a ;
+  INT VAR  n := ABS b ,
+           m ; 
+  IF (a = 0.0 OR a = -0.0) 
+    THEN IF b = 0
+           THEN 1.0
+           ELSE 0.0
+         FI
+    ELSE WHILE n>0 REP
+           m := n DIV 2 ;
+           IF m + m = n
+             THEN n := m ;
+                  r := r*r 
+             ELSE n DECR 1 ;
+                  p := p*r
+           FI
+         END REP ; 
+         IF b>0
+           THEN p
+           ELSE 1.0 / p
+         FI
+  FI .
+
+END OP ** ; 
+ 
+REAL PROC random: 
+  rdg:=rdg+pii;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg
+END PROC random; 
+ 
+PROC initializerandom ( REAL CONST z ): 
+  rdg := frac(z) 
+END PROC initializerandom; 
+ 
+END PACKET mathlib; 
+
diff --git a/system/base/1.7.5/src/pattern match b/system/base/1.7.5/src/pattern match
new file mode 100644
index 0000000..f6190d8
--- /dev/null
+++ b/system/base/1.7.5/src/pattern match
@@ -0,0 +1,768 @@
+PACKET pattern match DEFINES                     (* Author: P.Heyderhoff *) 
+                                                 (* Date:   09.06.1986   *) 
+    -, 
+    OR, 
+    **, 
+    any, 
+    notion, 
+    bound, 
+    match, 
+    matchpos, 
+    matchend, 
+    somefix, 
+    UNLIKE, 
+    LIKE : 
+ 
+(*------- Operation codes of the internal intermeadiate language: --------*) 
+ 
+LET 
+    z        = ""0"", 
+    stopz    = ""1""0"", 
+    closez   = ""2""0"", 
+    closor   = ""2""0""3""0"", 
+    or       = ""3"", 
+    oralpha  = ""3""5"", 
+    open2    = ""4""0""4""0"", 
+    alpha    = ""5"", 
+    alphaz   = ""5""0"", 
+    lenz     = ""6""0"", 
+    nilz     = ""6""0""0""0""7""0"",      (* =    any (0)     *) 
+    starz    = ""7""0"", 
+    star     = ""8""0""2""7""0""1""0"",   (* =    any ** 1    *) 
+    powerz   = ""8""0"", 
+    powerz0  = ""8""0""1"", 
+    notionz  = ""9""0"", 
+    fullz    = ""10""0"", 
+    boundz   = ""11""0""; 
+(*------------------------------------------------------------------------*) 
+ 
+LET undefined = 0,                                   (* fixleft value     *) 
+    forcer    = 0,                                   (* vaHue parameter   *) 
+    delimiter = " !""#$%&'()*+,-./:;<=>?§^_`­";      (* for 'PROC notion' *) 
+ 
+TEXT OP - (TEXT CONST alphabet ): 
+     p:= ""; 
+     INT VAR j; 
+     FOR j FROM 0 UPTO 255 
+     REP IF   pos(alphabet,code(j)) = 0 
+         THEN p CAT code(j) 
+         FI 
+     PER; 
+     p 
+  ENDOP -; 
+ 
+TEXT OP OR (TEXT CONST a, b): 
+     open2 + notnil (a) + closor + notnil (b) + closez 
+  ENDOP OR; 
+ 
+TEXT OP ** (TEXT CONST p, INT CONST x): 
+     powerz + code (1+x) + notnil (p) + stopz 
+  ENDOP **; 
+ 
+TEXT CONST any:= starz; 
+ 
+TEXT PROC any (INT CONST n): 
+     TEXT VAR t:= "  "; 
+     replace (t, 1, ABSn); 
+     lenz + t + starz 
+  ENDPROC any; 
+ 
+TEXT PROC any (TEXT CONST a): alphaz + a + starz ENDPROC any; 
+ 
+TEXT PROC any (INT CONST n, TEXT CONST a): 
+     TEXT VAR t:= "  "; 
+     replace (t, 1, ABSn); 
+     lenz + t + alphaz + a + starz  
+  ENDPROC any; 
+ 
+TEXT PROC notion (TEXT CONST t): notionz + notnil(t) + stopz ENDPROC notion; 
+ 
+TEXT PROC notnil (TEXT CONST t): 
+     IF   t = "" 
+     THEN nilz 
+     ELSE t 
+     FI 
+  ENDPROC notnil; 
+ 
+TEXT CONST bound := boundz; 
+ 
+TEXT PROC full (TEXT CONST t): fullz + t + stopz ENDPROC full; 
+ 
+TEXT PROC match (INT CONST x): 
+     subtext (p, matchpos(x), matchend(x)) 
+  ENDPROC match; 
+ 
+INT PROC matchpos (INT CONST x): mapos (1 + x MOD 256) ENDPROC matchpos; 
+ 
+INT PROC matchend (INT CONST x): maend (1 + x MOD 256) - 1 
+ ENDPROC matchend; 
+ 
+(*----------------- GLOBAL VARIABLES: -----------------------------------*) 
+ 
+ROW  256 INT VAR 
+                 (* Table of match registers. Each entry consists of two *) 
+                 (* pointers, which points to the TEXT object 't'        *) 
+     mapos,      (* points to the beginning of the match                 *) 
+     maend;      (* points to the position after the end of match        *) 
+ 
+INT  VAR ppos, tpos,   (* workpositions in pattern 'p' and text 't'      *) 
+         floatpos,     (* accumulation of all pending floatlengths       *) 
+         failpos,      (* result of 'PROC in alpha'                      *) 
+         plen, tlen,   (* length of pattern 'p' and length of text 't'   *) 
+         skipcount,    (* for track forward skipping                     *) 
+         multi, vari;  (* for handling of nonexclusive alternatives      *) 
+ 
+TEXT VAR p,            (* the pattern to be find  or some result         *) 
+         stack,        (* stack of pending assignments                   *) 
+         alphabet:=""; (* result of 'PROC find alpha', reset to nil      *) 
+                       (* after its usage by 'find any'                  *) 
+ 
+BOOL VAR fix,          (* text position is fixed and not floating        *) 
+         no vari;      (* not variing the order of alternatives          *) 
+ 
+TEXT PROC somefix (TEXT CONST pattern): 
+  
+     (* delivers the first text occuring unconditionally in the pattern *) 
+ 
+     p:= pattern; 
+     INT VAR j:= 1, n:= 0, k, len:= LENGTH p; 
+     REP 
+         SELECT text( subtext (p, j, j+1), 2) ISUB 1 OF 
+         CASE 1,3,7,9,10,11: j INCR 2 
+         CASE 2:             j INCR 2; n DECR 1 (* condition closed *) 
+         CASE 4:             j INCR 2; n INCR 1 (* condition opened *) 
+         CASE 5:             j := pos (p, starz, j+2) + 2 
+         CASE 6:             j INCR 4 
+         CASE 8:             j INCR 3 
+         OTHERWISE   k:= pos(p, z, j+1) - 1; 
+                     IF k <= 0 THEN k:= 1+len FI; 
+                     IF   star found
+                     THEN change (p, starpos, starpos, star);
+                          len:= LENGTH p;
+                          k:= starpos
+                     FI; 
+                     IF n =  0 CAND ( p SUB k ) <> or CAND k > j
+                     THEN LEAVE somefix WITH subtext(p,j,k-1) 
+                     ELSE j:=k 
+                     FI 
+         ENDSELECT 
+     UNTIL j > len 
+     PER; 
+     "" .
+
+  star found:   
+     INT VAR starpos:= pos (p, "*", j);
+     starpos > 0 CAND starpos <= k .
+     
+  ENDPROC somefix; 
+ 
+PROC skip (TEXT CONST p, BOOL CONST upto or): 
+ 
+     (* skips 'ppos' upto the end of the opened nest, n = nesting level *) 
+ 
+     INT VAR n:= 0; 
+     REP 
+         SELECT text (subtext (p, ppos, ppos+1), 2) ISUB 1 OF 
+         CASE 1,2:    IF   n = 0 
+                      THEN LEAVE skip 
+                      FI; 
+                      ppos INCR 2; 
+                      nDECR1 
+         CASE 3:      IF   n = 0 CAND upto or 
+                      THEN LEAVE skip 
+                      FI; 
+                      ppos INCR 2 
+         CASE 7:      ppos INCR 2 
+         CASE 4,9,10,11: ppos INCR 2; 
+                      n INCR 1 
+         CASE 5:      ppos:= pos (p, starz, ppos+2) + 2 
+         CASE 6:      ppos INCR 4 
+         CASE 8:      ppos INCR 3; 
+                      n INCR 1 
+         OTHERWISE    ppos:= pos(p, z, ppos+1) - 1; 
+                      IF   ppos < 0 
+                      THEN ppos:= plen; 
+                           LEAVE skip 
+                      FI 
+         ENDSELECT 
+     PER 
+  ENDPROC skip; 
+ 
+BOOL OP UNLIKE (TEXT CONST t, p): NOT ( t LIKE p ) ENDOP UNLIKE; 
+ 
+BOOL OP LIKE (TEXT CONST t, pattern): 
+     init; 
+     BOOL CONST found:= find (t,1,1, fixresult, floatresult); 
+     save; 
+     found. 
+ 
+  init:    no vari:= TRUE; 
+           vari:= 0; 
+           tlen:= 1 + LENGTH t; 
+           p:= full (pattern); 
+           IF   pos (p, bound) > 0 
+           THEN 
+                IF   subtext (p, 14, 15) = bound 
+                THEN p:= subtext (p, 1, 8) + powerz0 + subtext (p, 16) 
+                FI; 
+                plen:= LENGTH p - 7;  
+                IF   subtext (p, plen, plen+1) = bound  
+                THEN p:= subtext (p, 1, plen - 1) + stopz + stopz 
+                FI; 
+           FI; 
+           plen:= LENGTH p + 1; 
+           INT VAR fixresult, floatresult; 
+           tpos:= 1; 
+           floatpos:= 0; 
+           stack:= ""; 
+           alphabet:= ""; 
+           fix:= TRUE; 
+           skipcount:= 0; 
+           multi:= 0. 
+ 
+  save:    p:= t 
+ 
+  ENDOP LIKE; 
+ 
+(*-------- Realisation of the pattern matching algorithms 'find' --------*) 
+ 
+BOOL PROC find 
+     (TEXT CONST t, INT CONST unit, from, INT VAR fixleft, floatlen): 
+ 
+     initialize; 
+     BOOL CONST found:= pattern unit; 
+     SELECT next command * unit OF 
+            CASE 0,1,2:         found 
+            CASE 3:             next; 
+                                find alternative 
+            OTHERWISE           find concatenation 
+     ENDSELECT . 
+ 
+  find alternative: 
+     IF   found 
+     THEN save left position; 
+          backtrack; 
+          IF   find pattern CAND better 
+          THEN note multiplicity 
+          ELSE back to first one 
+          FI 
+     ELSE backtrack multi 
+     FI. 
+ 
+  better:               permutation XOR more left. 
+ 
+  permutation:          vari MOD 2 = 1. 
+ 
+  save left position:   j:= fixleft. 
+ 
+  more left:            j > fixleft. 
+ 
+  backtrack multi:      multi:= 2 * backmulti + 1; 
+                        vari:= backvari DIV 2; 
+                        find pattern. 
+ 
+  note multiplicity:    multi:= 2 * multi + 1; 
+                        vari:= vari DIV 2; 
+                        TRUE. 
+ 
+  back to first one:    backtrack; 
+                        IF   find first subpattern 
+                        THEN skip (p, FALSE); 
+                             note multiplicity 
+                        ELSE errorstop ("pattern"); 
+                             FALSE 
+                        FI. 
+ 
+  find concatenation: 
+     IF   found 
+     THEN IF ppos=plen COR find pattern COR track forward 
+          COR ( multi > backmulti CAND vari = 0 CAND find variation ) 
+          THEN TRUE 
+          ELSE backtrack; FALSE 
+          FI 
+     ELSE skip (p, TRUE); FALSE 
+     FI. 
+ 
+  track forward:                   (* must be performed before variation *) 
+     j:=0; 
+     last multi:= multi; 
+     last vari:= vari; 
+     WHILE skipcount = 0 
+     REP   IF tlen = tpos 
+           THEN LEAVE track forward WITH FALSE 
+           FI; 
+           backtrack; 
+           j INCR 1; 
+           skipcount:= j 
+     UNTIL find first subpattern CAND find pattern 
+     PER; 
+     j:= skipcount; 
+     skipcount:=0; 
+     j=0. 
+ 
+  find variation: 
+     multi:= last multi; 
+     vari:= last vari; 
+     FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 
+     REP backtrack with variation; 
+         IF   find first subpattern CAND find pattern 
+         THEN vari:=0; 
+              LEAVE find variation WITH TRUE 
+         FI 
+     PER; 
+     FALSE. 
+ 
+  backtrack with variation: 
+     backtrack; 
+     vari:= k. 
+ 
+  find pattern: 
+     find (t, 1, ppos+forcer, fixresult, floatresult) CAND keep result. 
+ 
+  find first subpattern: 
+     find (t, 0, from, fixresult, floatresult) CAND keep result . 
+ 
+  initialize: 
+     INT  VAR   j, 
+                k, 
+                fixresult, 
+                floatresult, 
+                last multi, 
+                last vari; 
+     BOOL CONST backfix:= fix; 
+     TEXT CONST backstack:= stack; 
+     floatlen:= 0; 
+     INT  CONST back:= tpos, 
+                backfloat:= floatpos, 
+                backskip:= skipcount, 
+                backmulti:= multi, 
+                backvari:= vari; 
+     fixleft:= fixleft0. 
+ 
+  fixleft0: IF fix THEN back ELSE undefined FI. 
+ 
+  backtrack: 
+     fix:= backfix; 
+     tpos:= back; 
+     fixleft:= fixleft0; 
+     floatlen:= 0; 
+     floatpos:= backfloat; 
+     stack:= backstack; 
+     skipcount:= backskip; 
+     multi:= backmulti; 
+     vari:= backvari. 
+ 
+  keep result: 
+     IF   fixleft = undefined 
+     THEN IF   fixresult = undefined 
+          THEN floatlen INCR floatresult 
+          ELSE fixleft  := fixresult - floatlen; 
+               floatpos DECR floatlen; 
+               floatlen:= 0 
+          FI 
+     FI; 
+     TRUE. 
+ 
+  pattern unit: 
+     init ppos; 
+     SELECT command OF 
+            CASE 1,2:   find end 
+            CASE 3:     find nil 
+            CASE 4:     find choice 
+            CASE 5:     find alphabet 
+            CASE 6:     find fixlength any 
+            CASE 7:     find varlength any 
+            CASE 8:     find and store match 
+            CASE 9:     find notion 
+            CASE 10:    find full 
+            CASE 11:    next; find nil 
+            OTHERWISE   find plain text                     END SELECT. 
+ 
+  init ppos:    ppos:= from + 2. 
+ 
+  command:      text (subtext (p, from, from+1), 2) ISUB 1. 
+ 
+  next command: text (subtext (p, ppos, ppos+1), 2) ISUB 1. 
+ 
+  next:         ppos INCR 2. 
+ 
+  find end:     ppos DECR 2; 
+                fixleft:= tpos; 
+                LEAVE find WITH TRUE; 
+                TRUE. 
+ 
+  find nil:     ppos DECR 2; 
+                fixleft:= tpos; 
+                TRUE. 
+ 
+  find choice:  IF   find pattern 
+                THEN next; TRUE 
+                ELSE next; FALSE 
+                FI. 
+ 
+  find plain text: find text upto next command; 
+                   IF   fix        THEN allow fix position only 
+                   ELIF text found THEN allow variable position 
+                                   ELSE allow backtrack 
+                   FI. 
+ 
+  find text upto next command: 
+     ppos:= pos (p, z, from + 1); 
+     IF   ppos = 0 
+     THEN ppos:= plen 
+     ELSE ppos DECR 1 
+     FI; 
+     IF   star found
+     THEN change (p, starpos, starpos, star);
+          plen:= 1 + LENGTH p;
+          ppos:= starpos
+     FI;     
+     tpos:= pos (t, subtext (p, from, ppos - 1), tpos). 
+ 
+  star found:
+     INT VAR starpos:= pos (p, "*", from);
+     starpos > 0 CAND starpos <= ppos .
+
+  text found: 
+     WHILE skipcount > 0 CAND tpos > 0 
+     REP   skipcount DECR 1; 
+           tpos:= pos (t, subtext(p,from,ppos-1), tpos+1) 
+     PER; 
+     tpos > 0 .
+ 
+  allow fix position only: 
+     IF   tpos = back 
+     THEN tpos INCR (ppos-from); TRUE 
+     ELSE tpos:= back; 
+          from = ppos 
+     FI. 
+ 
+  allow variable position: 
+     IF   alphabet = "" COR in alpha (t, back, tpos)  
+     THEN fix it; 
+          tpos INCR (ppos-from); 
+          TRUE 
+     ELSE tpos:= back; 
+          FALSE 
+     FI. 
+ 
+  allow backtrack: 
+     tpos:= back; 
+     IF   from = ppos 
+     THEN fix it; 
+          TRUE 
+     ELSE FALSE 
+     FI . 
+ 
+  find alphabet: 
+     j:= pos (p, starz, ppos); 
+     alphabet:= subtext (p, ppos, j-1); 
+     ppos := j; 
+     TRUE. 
+ 
+  find fixlength any: 
+     get length value; 
+     find alpha attribut; 
+     IF   alphabet = "" 
+     THEN find any with fix length 
+     ELSE find any in alphabet with fix length 
+     FI. 
+ 
+  get length value: 
+     floatlen:= subtext(p, ppos, ppos+1) ISUB 1;
+     ppos INCR 4. 
+ 
+  find alpha attribut: 
+     IF (p SUB (ppos-2)) = alpha CAND find alphabet 
+     THEN next 
+     FI. 
+ 
+  find any with fix length: 
+     tpos INCR floatlen; 
+     IF   tpos > tlen 
+     THEN tpos:= back; 
+          floatlen:=0; 
+          FALSE 
+     ELSE IF   fix THEN floatlen:= 0 
+          ELIF floatlen = 0 
+          THEN fix it                         (* unlike niltext 6.6. *) 
+          ELSE floatpos INCR floatlen 
+          FI; 
+          TRUE 
+     FI. 
+ 
+  find any in alphabet with fix length: 
+     IF   first character in alpha 
+     THEN IF NOT fix THEN fix it FI; 
+          set fix found 
+     ELSE set fix not found 
+     FI. 
+ 
+  first character in alpha: 
+    (fix COR advance) CAND in alpha (t, tpos, tpos+floatlen). 
+ 
+  advance: 
+     FOR tpos FROM back UPTO tlen 
+     REP IF   pos (alphabet, t SUB tpos) > 0 
+         THEN LEAVE advance WITH TRUE 
+         FI 
+     PER; 
+     FALSE. 
+ 
+  fix it: 
+     fixleft:= back-floatpos; 
+     make fix (back); 
+     fixleft:= tpos. 
+ 
+  set fix found: 
+     tpos INCR floatlen; 
+     floatlen:= 0; 
+     alphabet:= ""; 
+     TRUE. 
+ 
+  set fix not found:    tpos:= back; 
+                        alphabet:= ""; 
+                        floatlen:= 0; 
+                        FALSE. 
+ 
+  find varlength any:   IF   alphabet = "" 
+                        THEN really any 
+                        ELSE find varlength any in alphabet 
+                        FI. 
+ 
+  really any:           IF   fix 
+                        THEN fix:= FALSE; 
+                             fixleft:= tpos 
+                        ELIF floatpos = 0 
+                        THEN fixleft:= tpos                  (* 6.6. *) 
+                        FI; 
+                        TRUE . 
+ 
+  find varlength any in alphabet: 
+                        IF fix THEN fixleft := tpos FI; 
+                        IF   fix CAND pos (alphabet, t SUB tpos) > 0 
+                        COR  NOT fix CAND advance 
+                        THEN IF NOT fix THEN fix it FI; 
+                             set var found 
+                        ELSE set var not found 
+                        FI. 
+ 
+  set var found:        tpos:= end of varlength any; 
+                        alphabet:= ""; 
+                        TRUE. 
+  set var not found:    tpos:= back; 
+                        alphabet:= ""; 
+                        FALSE. 
+  end of varlength any: IF   NOT in alpha(t,tpos,tlen) 
+                        THEN failpos 
+                        ELSE tlen 
+                        FI. 
+ 
+  find and store match: get register name; 
+                        IF  find pattern 
+                        THEN next; 
+                             store; 
+                             TRUE 
+                        ELSE next; 
+                             FALSE 
+                        FI. 
+ 
+  store:                IF   fix 
+                        THEN mapos (reg):= fixleft; 
+                             maend (reg):= tpos 
+                        ELSE stack CAT code(floatlen) + 
+                                       code(floatpos) + code(fixleft) + c 
+                        FI. 
+ 
+  get register name:    TEXT CONST c:= p SUB (ppos); 
+                        INT  VAR reg:= code (c); 
+                        ppos INCR 1. 
+ 
+  find notion:    float notion; 
+                  exhaust notion . 
+ 
+  float notion:   j:= back; 
+                  REP IF   find pattern 
+                      THEN IF   is notion (t, fixleft) 
+                           THEN LEAVE find notion WITH TRUE 
+                           ELIF backfix 
+                           THEN LEAVE float notion 
+                           ELSE go ahead FI 
+                      ELIF j=back 
+                      THEN next; 
+                           LEAVE find notion WITH FALSE 
+                      ELSE LEAVE float notion 
+                      FI 
+                  PER. 
+ 
+  go ahead:       j INCR 1; 
+                  IF simple THEN j:= max (tpos, j) FI; 
+                  notion backtrack. 
+ 
+  simple:         k:= from; 
+                  REP k := pos (p, z, k+2); 
+                      IF   k > ppos-3 
+                      THEN LEAVE simple WITH TRUE 
+                      ELIF pos (oralpha, p SUB k-1) > 0 
+                      THEN LEAVE simple WITH FALSE 
+                      FI 
+                  PER; 
+                  FALSE. 
+ 
+  notion backtrack: tpos:= j; 
+                  fix:= backfix; 
+                  fixleft:= fixleft0; 
+                  floatlen:= 0; 
+                  floatpos:= backfloat + tpos - back; 
+                  stack:= backstack; 
+                  ppos:= from + 2 . 
+ 
+  exhaust notion: IF   notion expansion 
+                  COR  multi > backmulti 
+                  CAND no vari 
+                  CAND notion variation 
+                  THEN TRUE 
+                  ELSE backtrack; FALSE 
+                  FI. 
+ 
+  notion expansion: j:= 0; 
+                  multi:= last multi; 
+                  vari:= last vari; 
+                  WHILE skipcount = 0 
+                  REP skip and try PER; 
+                  j:= skipcount; 
+                  skipcount:= 0; 
+                  j = 0. 
+ 
+  skip and try:   backtrack; 
+                  j INCR 1; 
+                  skipcount:=j; 
+                  ppos:= from + 2; 
+                  IF   find pattern 
+                  THEN IF    is notion (t, fixleft) 
+                       THEN  LEAVE find notion WITH TRUE 
+                       FI 
+                  ELSE next; LEAVE find notion WITH FALSE 
+                  FI . 
+ 
+  notion variation: no vari:= FALSE; 
+                  last multi:= multi; 
+                  last vari:= vari; 
+                  FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 
+                  REP backtrack with variation; 
+                      IF   find first subpattern 
+                      THEN no vari:= TRUE; 
+                           LEAVE find notion WITH TRUE 
+                      FI 
+                  PER; 
+                  no vari:= TRUE; 
+                  FALSE. 
+ 
+  find full: 
+    find pattern CAND (end of line COR exhaust line). 
+ 
+  end of line: 
+    next; 
+    IF   fix 
+    THEN tpos = tlen 
+    ELSE tpos:= tlen; 
+         make fix (1); 
+         TRUE 
+    FI. 
+ 
+  exhaust line: 
+    IF   full expansion COR multi > 0 CAND no vari CAND full variation 
+    THEN TRUE ELSE backtrack; 
+         FALSE 
+    FI. 
+ 
+  full expansion: 
+     j:=0; 
+     last multi:= multi; 
+     last vari:= vari; 
+     WHILE skipcount = 0 
+     REP   IF tlen = tpos 
+           THEN LEAVE full expansion WITH FALSE 
+           FI; 
+           backtrack; 
+           j INCR 1; 
+           skipcount:= j; 
+           ppos:=from + 2 
+     UNTIL find pattern CAND tpos=tlen 
+     PER; 
+     j:= skipcount; 
+     skipcount:=0; 
+     j=0. 
+ 
+  full variation: 
+    no vari:= FALSE; 
+    multi:= last multi; 
+    vari:= last vari; 
+    FOR k FROM 1 UPTO multi 
+    REP backtrack with variation; 
+        IF   find first subpattern 
+        THEN no vari:= TRUE; 
+             LEAVE find WITH TRUE 
+        FI 
+    PER; 
+    no vari:= TRUE; 
+    FALSE. 
+ 
+ ENDPROC find; 
+ 
+BOOL PROC is notion (TEXT CONST t, INT CONST fixleft): 
+     ppos INCR 2; 
+     (    NOT  fix 
+          COR  tpos = tlen 
+          COR  pos (delimiter, t SUB tpos)   > 0 
+          COR  pos (delimiter, t SUB tpos-1) > 0 
+          COR  (t SUB tpos)  <= "Z" 
+          CAND (t SUB tpos-1) > "Z"   ) 
+     CAND (    fixleft <= 1 
+          COR  pos (delimiter, t SUB fixleft-1) > 0 
+          COR  pos (delimiter, t SUB fixleft)   > 0 
+          COR  (t SUB fixleft)    > "Z" 
+          CAND (t SUB fixleft-1) <= "Z"   ) 
+ 
+ END PROC is notion; 
+ 
+PROC make fix (INT CONST back): 
+     WHILE stack not empty 
+     REP  INT VAR reg:= code (stack SUB top), 
+                  pos:= code (stack SUB top-1), 
+                  len:= code (stack SUB top-3), 
+                  dis:= code (stack SUB top-2) - floatpos; 
+          maend(reg):= min (tpos + dis, tlen);              (* 6.6. *) 
+          mapos(reg):= pos or fix or float; 
+          stack:= subtext (stack,1,top-4) 
+     PER; 
+     fix:= TRUE; 
+     floatpos:= 0 . 
+ 
+     stack not empty: INT VAR top:= LENGTH stack; 
+                      top > 0. 
+ 
+     pos or fix or float: 
+          IF   pos = undefined 
+          THEN IF len = 0 
+               THEN min (back + dis, tlen) 
+               ELSE maend(reg) - len 
+               FI 
+          ELSE pos 
+          FI. 
+ 
+ ENDPROC make fix; 
+ 
+BOOL PROC in alpha (TEXT CONST t, INT CONST from, to): 
+     FOR failpos FROM from UPTO to - 1 
+     REP IF   pos (alphabet, t SUB failpos) = 0 
+         THEN LEAVE in alpha WITH FALSE 
+         FI 
+     PER; 
+     TRUE 
+  ENDPROC in alpha; 
+ 
+TEXT PROC notion (TEXT CONST t, INT CONST r): notion (t) ** r ENDPROC notion; 
+ 
+ENDPACKET pattern match; 
+
diff --git a/system/base/1.7.5/src/pcb control b/system/base/1.7.5/src/pcb control
new file mode 100644
index 0000000..9bf0e2d
--- /dev/null
+++ b/system/base/1.7.5/src/pcb control
@@ -0,0 +1,79 @@
+
+PACKET pcb and init control DEFINES         (* Autor: J.Liedtke *)
+                                            (* Stand: 25.08.84  *)
+  session ,
+  pcb ,
+  set line nr ,
+  clock ,
+  INITFLAG ,
+  := ,
+  initialized ,
+  storage ,
+  id ,
+  ke :
+
+
+LET line number field     = 1 ,
+    myself id field       = 9 ;
+
+TYPE INITFLAG = INT ;
+
+
+INT PROC session :
+  EXTERNAL 126
+ENDPROC session ;
+
+INT PROC pcb (INT CONST field) :
+  EXTERNAL 80
+ENDPROC pcb ;
+
+PROC write pcb (INT CONST task nr, field, value) :
+  EXTERNAL 105
+ENDPROC write pcb ;
+
+PROC set line nr (INT CONST value) :
+  write pcb (pcb (myself id field), line number field, value)
+ENDPROC set line nr ;
+
+
+OP := (INITFLAG VAR flag, BOOL CONST flagtrue) :
+
+  IF flagtrue
+    THEN CONCR (flag) := myself no
+    ELSE CONCR (flag) := 0
+  FI .
+
+myself no :   pcb (myself id field) AND 255 .
+
+ENDOP := ;
+
+BOOL PROC initialized (INITFLAG VAR flag) :
+
+  IF CONCR (flag) = myself no
+    THEN TRUE
+    ELSE CONCR (flag) := myself no ;
+         FALSE
+  FI .
+
+myself no :   pcb (myself id field) AND 255 .
+
+ENDPROC initialized ;
+
+REAL PROC clock (INT CONST nr) :
+  EXTERNAL 102
+ENDPROC clock ;
+
+PROC storage (INT VAR size, used) :
+  EXTERNAL 89
+ENDPROC storage ;
+
+INT PROC id (INT CONST no) :
+  EXTERNAL 129
+ENDPROC id ;
+
+PROC ke :
+  EXTERNAL 6
+ENDPROC ke ;
+
+ENDPACKET pcb and init control ;
+
diff --git a/system/base/1.7.5/src/real b/system/base/1.7.5/src/real
new file mode 100644
index 0000000..3e3c651
--- /dev/null
+++ b/system/base/1.7.5/src/real
@@ -0,0 +1,442 @@
+(* ------------------- VERSION 6     05.05.86 ------------------- *)
+PACKET real DEFINES                           (* Autor: J.Liedtke *) 
+ 
+   text , 
+   int ,
+   real ,
+   round ,
+   floor , 
+   frac ,
+   decimal exponent ,
+   set exp ,
+   INCR ,
+   DECR ,
+   abs , 
+   ABS , 
+   sign ,
+   SIGN ,
+   MOD ,
+   min ,
+   max ,
+   max real ,
+   small real :
+ 
+LET mantissa length = 13 ,
+    digit zero index = 1 ,
+    digit nine index = 10 ;
+INT CONST 
+    decimal point index := -1 ; 
+
+TEXT VAR mantissa ;
+
+ROW 10 REAL VAR real digit ;
+ 
+INT VAR i ; REAL VAR d := 0.0 ;
+FOR i FROM 1 UPTO 10 REP
+  real digit (i) := d ;
+  d := d + 1.0
+PER ;
+ 
+REAL PROC max real : 9.999999999999e126 ENDPROC max real ;
+ 
+REAL PROC small real : 1.0e-12 ENDPROC small real ;
+ 
+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :
+  EXTERNAL 96
+ENDPROC sld ; 
+ 
+INT PROC decimal exponent (REAL CONST mantissa) : 
+  EXTERNAL 97
+ENDPROC decimal exponent ; 
+
+PROC set exp (INT CONST exponent, REAL VAR number) : 
+  EXTERNAL 98
+ENDPROC set exp ;
+ 
+REAL PROC tenpower (INT CONST exponent) :
+  REAL VAR result := 1.0 ;
+  set exp (exponent, result) ;
+  result
+ENDPROC tenpower ;
+
+REAL PROC floor (REAL CONST real) : 
+  EXTERNAL 99
+ENDPROC floor ; 
+ 
+REAL PROC round (REAL CONST real, INT CONST digits) : 
+ 
+  REAL VAR result := real ;
+  IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length)
+    THEN round result ;
+  FI ;
+  result .
+
+round result :
+  set exp (decimal exponent (result) + digits, result) ;
+  IF result >= 0.0
+    THEN result := floor (result + 0.5)
+    ELSE result := floor (result - 0.5)
+  FI ;
+  IF result <> 0.0
+    THEN set exp (decimal exponent (result) - digits, result)
+  FI .
+
+ENDPROC round ; 
+ 
+TEXT VAR result ;
+ 
+TEXT PROC text (REAL CONST real) : 
+ 
+  REAL VAR value := rounded to seven digits ; 
+  IF value = 0.0 
+    THEN "0.0" 
+    ELSE 
+      process sign ; 
+      get mantissa (value) ; 
+      INT CONST exponent := decimal exponent (value) ; 
+      get short mantissa ; 
+      IF exponent > 7 OR exponent < LENGTH short mantissa - 7 
+        THEN scientific notation 
+        ELSE short notation 
+      FI 
+    FI . 
+ 
+rounded to seven digits : 
+  round ( real * tenpower( -decimal exponent(real) ) , 6 ) 
+        * tenpower ( decimal exponent(real) ) . 
+ 
+process sign : 
+  IF value < 0.0 
+    THEN result := "-" ; 
+         value := - value 
+    ELSE result := "" 
+  FI . 
+ 
+get short mantissa : 
+  INT VAR i := 7 ; 
+  WHILE (mantissa SUB i) = "0" REP 
+    i DECR 1 
+  UNTIL i=1 END REP ; 
+  TEXT CONST short mantissa := subtext (mantissa, 1, i) . 
+ 
+scientific notation : 
+  result CAT (mantissa SUB 1) ; 
+  result CAT "." ; 
+  result CAT subtext (mantissa, 2, 7) ; 
+  result + "e" + text (exponent) . 
+ 
+short notation : 
+  IF exponent < 0
+    THEN result + "0." + (-exponent - 1) * "0" + short mantissa
+    ELSE result CAT subtext (short mantissa, 1, exponent+1) ; 
+         result CAT (exponent+1 - LENGTH short mantissa) * "0" ; 
+         result CAT "." ; 
+         result CAT subtext (short mantissa, exponent+2) ;
+         IF LENGTH short mantissa < exponent + 2 
+           THEN result + "0"
+           ELSE result
+         FI
+  FI . 
+ 
+ENDPROC text ; 
+ 
+PROC get mantissa (REAL CONST number) :
+
+  REAL VAR real mantissa := number ;
+  mantissa := "" ;
+  INT VAR i , digit ;
+  FOR i FROM 1 UPTO mantissa length REP
+    sld (0, real mantissa, digit) ;
+    mantissa CAT code (digit + 48)
+  PER ;
+
+ENDPROC get mantissa ;
+
+TEXT PROC text (REAL CONST real, INT CONST length) :
+
+  INT CONST mantissa length := min (length - 7, 13) ;
+  IF mantissa length > 0
+    THEN construct scientific notation
+    ELSE result := length * "*"
+  FI ;
+  result .
+
+construct scientific notation :
+  REAL VAR value := rounded real ;
+  IF value = 0.0
+    THEN result := subtext (" 0.0                ", 1, length) 
+    ELSE process sign ;
+         process mantissa ;
+         process exponent
+  FI .
+
+rounded real :
+  round (real * tenpower ( -decimal exponent (real)) , mantissa length - 1)
+  * tenpower (decimal exponent (real)) .
+
+process sign :
+  IF value < 0.0
+    THEN result := "-"
+    ELSE result := "+"
+  FI .
+
+process mantissa :
+  get mantissa (value) ;
+  result CAT (mantissa SUB 1) ;
+  result CAT "." ;
+  result CAT subtext (mantissa, 2, mantissa length) .
+
+process exponent :
+  IF decimal exponent (value) >= 0
+    THEN result CAT "e+"
+    ELSE result CAT "e-"
+  FI ;
+  result CAT text (ABS decimal exponent (value), 3) ;
+  change all (result, " ", "0") .
+
+ENDPROC text ;
+
+TEXT PROC text (REAL CONST real, INT CONST length, fracs) :
+ 
+  REAL VAR value := round (real, fracs) ;
+  INT VAR  exponent  := decimal exponent (value) ;
+           IF value = 0.0 THEN exponent := 0 FI ;
+  INT VAR  floors    := exponent + 1 ,
+           floor length := length - fracs - 1 ;
+           IF value < 0.0 THEN floor length DECR 1 FI ;
+ 
+  IF value too big
+    THEN length * "*"
+    ELSE transformed value
+  FI .
+ 
+transformed value :
+  process leading blanks and sign ;
+  get mantissa (value) ;
+  result CAT subtext (mantissa, 1, floors) ;
+  IF LENGTH mantissa < floors
+    THEN result CAT (floors - LENGTH mantissa) * "0"
+  FI ;
+  result CAT "." ;
+  IF exponent < 0
+    THEN result CAT (-floors) * "0" ;
+         result CAT subtext (mantissa, 1, length - LENGTH result)
+    ELSE result CAT subtext (mantissa, floors+1, floors + fracs)
+  FI ;
+  IF LENGTH result < length
+    THEN result CAT (length - LENGTH result) * "0"
+  FI ;
+  result .
+ 
+process leading blanks and sign :
+  result := (floor length - max(floors,0)) * " " ;
+  IF value < 0.0
+    THEN result CAT "-" ;
+         value := - value
+  FI .
+ 
+value too big :
+  floors > floor length .
+ 
+ENDPROC text ;
+ 
+REAL PROC real (TEXT CONST text) : 
+ 
+  skip leading blanks ;
+  sign ; 
+  mantissa part ; 
+  exponent ; 
+  result .
+ 
+skip leading blanks :
+  INT VAR pos := 1 ;
+  skip blanks .
+ 
+skip blanks :
+  WHILE (text SUB pos) = " " REP
+    pos INCR 1
+  PER .
+ 
+sign : 
+  BOOL VAR negative ; 
+  IF (text SUB pos) = "-" 
+    THEN negative := TRUE ; 
+         pos INCR 1
+  ELIF (text SUB pos) = "+" 
+    THEN negative := FALSE ; 
+         pos INCR 1
+  ELSE   negative := FALSE
+  FI . 
+ 
+mantissa part: 
+  REAL VAR value ;
+  INT VAR exponent pos := 0 ;
+  get first digit ;
+  WHILE pos <= LENGTH text REP 
+    digit := code (text SUB pos) - 47 ; 
+    IF digit >= digit zero index AND digit <= digit nine index
+      THEN value := value * 10.0 + real digit (digit) ;
+           pos INCR 1 
+    ELIF digit = decimal point index AND exponent pos = 0
+      THEN pos INCR 1 ;
+           exponent pos := pos
+    ELSE LEAVE mantissa part 
+    FI 
+  END REP . 
+ 
+get first digit :
+  INT VAR digit := code (text SUB pos) - 47 ;
+  IF digit = decimal point index
+    THEN pos INCR 1 ;
+         exponent pos := pos ;
+         digit := code (text SUB pos) - 47
+  FI ;
+  IF digit >= digit zero index AND digit <= digit nine index
+    THEN value := real digit (digit) ;
+         pos INCR 1
+    ELSE set conversion (FALSE) ;
+         LEAVE real WITH 0.0
+  FI .
+
+exponent : 
+  INT VAR exp ;
+  IF exponent pos > 0
+    THEN exp := exponent pos - pos
+    ELSE exp := 0
+  FI ;
+  IF (text SUB pos) = "e" 
+    THEN exp INCR int (subtext(text,pos+1)) 
+    ELSE no more nonblank chars permitted
+  FI . 
+ 
+no more nonblank chars permitted :
+  skip blanks ;
+  IF pos > LENGTH text
+    THEN set conversion (TRUE)
+    ELSE set conversion (FALSE)
+  FI .
+ 
+result : 
+  value := value * tenpower (exp) ; 
+  IF negative 
+    THEN - value 
+    ELSE value 
+  FI . 
+ 
+ENDPROC real ; 
+ 
+ 
+REAL PROC abs (REAL CONST value) : 
+ 
+  IF value >= 0.0 
+    THEN  value 
+    ELSE -value 
+  FI 
+ 
+ENDPROC abs ; 
+ 
+REAL OP ABS (REAL CONST value) : 
+ 
+  abs (value) 
+ 
+ENDOP ABS ; 
+ 
+INT PROC sign (REAL CONST value) :
+ 
+  IF   value < 0.0 THEN -1
+  ELIF value = 0.0 THEN  0
+  ELSE                   1
+  FI
+ 
+ENDPROC sign ;
+ 
+INT OP SIGN (REAL CONST value) :
+ 
+  sign (value)
+ 
+ENDOP SIGN ;
+ 
+REAL OP MOD (REAL CONST left, right) :
+ 
+  REAL VAR result := left - floor (left/right) * right ;
+  IF result < 0.0
+    THEN result + abs (right)
+    ELSE result
+  FI
+ 
+ENDOP MOD ;
+ 
+REAL PROC frac (REAL CONST value) :
+ 
+  value - floor (value)
+ 
+ENDPROC frac ;
+ 
+REAL PROC max (REAL CONST a, b) :
+ 
+  IF a > b THEN a ELSE b FI
+ 
+ENDPROC max ;
+ 
+REAL PROC min (REAL CONST a, b) :
+ 
+  IF a < b THEN a ELSE b FI
+ 
+ENDPROC min ;
+ 
+OP INCR (REAL VAR dest, REAL CONST increment) :
+ 
+  dest := dest + increment
+ 
+ENDOP INCR ;
+ 
+OP DECR (REAL VAR dest, REAL CONST decrement) : 
+ 
+  dest := dest - decrement
+ 
+ENDOP DECR ;
+ 
+INT PROC int (REAL CONST value) :
+ 
+  IF value = minint value
+    THEN minint
+    ELSE compute int result ;
+         IF value < 0.0
+           THEN - result
+           ELSE   result
+         FI
+  FI .
+
+compute int result :
+  INT VAR result := 0, digit ,i ;
+  REAL VAR mantissa := value ;
+ 
+  FOR i FROM 0 UPTO decimal exponent (value) REP
+    sld (0, mantissa, digit) ;
+    result := result * 10 + digit 
+  PER .
+
+minint value :  - 32768.0 .
+minint       :  - 32767 - 1 .
+ 
+ENDPROC int ;
+ 
+REAL PROC real (INT CONST value) :
+ 
+  IF value < 0
+    THEN - real (-value)
+  ELIF value < 10
+    THEN real digit (value+1)
+    ELSE split value into head and last digit ;
+         real (head) * 10.0 + real digit (last digit+1)
+  FI .
+ 
+split value into head and last digit :
+  INT CONST
+  head := value DIV 10 ,
+  last digit := value - head * 10 .
+ 
+ENDPROC real ;
+ 
+ENDPACKET real ;
+
diff --git a/system/base/1.7.5/src/scanner b/system/base/1.7.5/src/scanner
new file mode 100644
index 0000000..35a632c
--- /dev/null
+++ b/system/base/1.7.5/src/scanner
@@ -0,0 +1,325 @@
+(* ------------------- VERSION 4     14.05.86 ------------------- *)
+PACKET scanner DEFINES                 (* Autor: J.Liedtke        *)
+ 
+       scan , 
+       continue scan ,
+       next symbol :
+ 
+ 
+LET tag     = 1 ,
+    bold    = 2 , 
+    number  = 3 ,
+    text    = 4 ,
+    operator= 5 ,
+    delimiter = 6 , 
+    end of file = 7 , 
+    within comment = 8 ,
+    within text    = 9 ;
+
+LET digit 0       = 48 ,
+    digit 9       = 57 ,
+    upper case a  = 65 ,
+    upper case z  = 90 ,
+    lower case a  = 97 ,
+    lower case z  = 122;
+
+
+TEXT VAR line := "" , 
+         char := "" ,
+         chars:= "" ;
+ 
+INT VAR  position  := 0 ,
+         comment depth ;
+BOOL VAR continue text ;
+ 
+ 
+PROC scan (TEXT CONST scan text) : 
+ 
+  comment depth := 0 ;
+  continue text := FALSE ;
+  continue scan (scan text)
+ 
+ENDPROC scan ;
+ 
+PROC continue scan (TEXT CONST scan text) :
+ 
+  line := scan text ;
+  position  := 0 ;
+  nextchar 
+ 
+ENDPROC continue scan ;
+
+PROC next symbol (TEXT VAR symbol) : 
+ 
+  INT VAR type ;
+  next symbol (symbol, type) 
+ 
+ENDPROC next symbol ;
+ 
+PROC next symbol (TEXT VAR symbol, INT VAR type) : 
+ 
+  skip blanks ;
+  IF   is begin comment          THEN process comment
+  ELIF comment depth > 0         THEN comment depth DECR 1 ;
+                                      process comment
+  ELIF is quote OR continue text THEN process text 
+  ELIF is lower case letter      THEN process tag 
+  ELIF is upper case letter      THEN process bold 
+  ELIF is digit                  THEN process number
+  ELIF is delimiter              THEN process delimiter
+  ELIF is niltext                THEN eof
+  ELSE process operator 
+  FI . 
+ 
+ 
+process comment :
+  read comment ;
+  IF comment depth = 0
+    THEN next symbol (symbol, type)
+    ELSE type := within comment ;
+         symbol := ""
+  FI .
+ 
+process tag : 
+  type := tag ;
+  assemble chars (lower case a, lower case z) ;
+  symbol := chars ;
+  REP 
+    skip blanks ;
+    IF is lower case letter
+      THEN assemble chars (lower case a, lower case z)
+    ELIF is digit
+      THEN assemble chars (digit 0, digit 9)
+    ELSE   LEAVE process tag
+    FI ;
+    symbol CAT chars
+  PER ;
+  nextchar .
+ 
+process bold : 
+  type := bold ;
+  assemble chars (upper case a, upper case z) ;
+  symbol := chars .
+ 
+process number :
+  type := number ;
+  assemble chars (digit 0, digit 9) ;
+  symbol := chars ;
+  IF char = "." AND ahead char is digit
+    THEN process fraction ;
+         IF char = "e"
+           THEN process exponent
+         FI
+  FI .
+
+ahead char is digit :
+  digit 0 <= code (ahead char) AND code (ahead char) <= digit 9 .
+
+process fraction :
+  symbol CAT char ;
+  nextchar ;
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT chars .
+
+process exponent :
+  symbol CAT char ;
+  nextchar ;
+  IF char = "+" OR char = "-"
+    THEN symbol CAT char ;
+         nextchar
+  FI ;
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT chars .
+ 
+process text : 
+  type := text ;
+  symbol := "" ;
+  IF continue text
+    THEN continue text := FALSE
+    ELSE next char
+  FI ;
+  WHILE not end of text REP 
+    assemble chars (35, 254) ;
+    symbol CAT chars ;
+    IF NOT is quote
+      THEN symbol CAT char ;
+           nextchar
+    FI
+  ENDREP . 
+ 
+not end of text : 
+  IF is niltext 
+    THEN continue text := TRUE ; type := within text ; FALSE
+  ELIF is quote 
+    THEN end of text or exception
+  ELSE TRUE 
+  FI . 
+ 
+end of text or exception :
+  next char ;
+  IF is quote
+    THEN get quote ;        TRUE
+  ELIF is digit
+    THEN get special char ; TRUE
+  ELSE   FALSE
+  FI .
+ 
+get quote :
+  symbol CAT char ;
+  nextchar .
+
+get special char :
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT code (int (chars) ) ;
+  nextchar .
+ 
+process delimiter : 
+  type := delimiter ;
+  symbol := char ;
+  nextchar . 
+ 
+process operator : 
+  type := operator ; 
+  symbol := char ;
+  nextchar ;
+  IF symbol = ":" 
+    THEN IF char = "=" OR char = ":" 
+           THEN symbol := ":=" ;
+                nextchar 
+           ELSE type := delimiter 
+         FI 
+  ELIF is relational double char 
+    THEN symbol CAT char ;
+         nextchar 
+  ELIF symbol = "*" AND char = "*" 
+    THEN symbol := "**" ; 
+         next char 
+  FI .
+ 
+eof : 
+  type := end of file ;
+  symbol := "" .
+ 
+is lower case letter : 
+     lower case a <= code (char) AND code (char) <= lower case z . 
+ 
+is upper case letter : 
+     upper case a <= code (char) AND code (char) <= upper case z .
+ 
+is digit :
+     digit 0 <= code (char) AND code (char) <= digit 9 . 
+ 
+is delimiter : pos ( "()[].,;" , char ) > 0 . 
+ 
+is relational double char : 
+  TEXT VAR double := symbol + char ; 
+  double = "<>" OR double = "<=" OR double = ">=" . 
+ 
+is quote : char = """" .
+ 
+is niltext : char = "" . 
+ 
+is begin comment : char = "{" OR char = "(" AND ahead char = "*" .
+ 
+ENDPROC next symbol ;
+ 
+PROC next char : 
+ 
+  position INCR 1 ;
+  char := line SUB position
+ 
+ENDPROC next char ;
+ 
+PROC skip blanks :
+ 
+  position := pos (line, ""33"", ""254"", position) ;
+  IF position = 0
+    THEN position := LENGTH line + 1
+  FI ;
+  char := line SUB position .
+
+ENDPROC skip blanks ;
+ 
+TEXT PROC ahead char : 
+ 
+  line SUB position+1 
+ 
+ENDPROC ahead char ; 
+
+PROC assemble chars (INT CONST low, high) :
+
+  INT CONST begin := position ;
+  position behind valid text ;
+  chars := subtext (line, begin, position-1) ;
+  char := line SUB position .
+
+position behind valid text :
+  position := pos (line, ""32"", code (low-1), begin) ;
+  IF position = 0
+    THEN position := LENGTH line + 1
+  FI ;
+  INT CONST higher pos := pos (line, code (high+1), ""254"", begin) ;
+  IF higher pos <> 0 AND higher pos < position
+    THEN position := higher pos
+  FI .
+
+ENDPROC assemble chars ;
+
+ 
+PROC read comment : 
+ 
+  TEXT VAR last char ; 
+  comment depth INCR 1 ;
+  REP 
+    last char := char ; 
+    nextchar ; 
+    IF is begin comment
+      THEN read comment
+    FI ;
+    IF char = ""
+      THEN LEAVE read comment
+    FI
+  UNTIL is end comment PER ; 
+  comment depth DECR 1 ;
+  next char ;
+  skip blanks .
+ 
+is end comment :
+  char = "}" OR char = ")" AND last char = "*" .
+ 
+is begin comment :
+  char = "{" OR char = "(" AND ahead char = "*" .
+ 
+ENDPROC read comment ;
+ 
+
+PROC scan (FILE VAR f) :
+
+  getline (f, line) ;
+  scan (line)
+
+ENDPROC scan ; 
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol) :
+
+  INT VAR type ;
+  next symbol (f, symbol, type)
+
+ENDPROC next symbol ;
+
+TEXT VAR scanned ;
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type) :
+
+  next symbol (symbol, type) ;
+  WHILE type >= 7 AND NOT eof (f) REP
+    getline (f, line) ;
+    continue scan (line) ;
+    next symbol (scanned, type) ;
+    symbol CAT scanned
+  PER .
+
+ENDPROC next symbol ;
+
+ENDPACKET scanner ;
+
diff --git a/system/base/1.7.5/src/screen b/system/base/1.7.5/src/screen
new file mode 100644
index 0000000..7e64961
--- /dev/null
+++ b/system/base/1.7.5/src/screen
@@ -0,0 +1,33 @@
+
+PACKET screen description DEFINES
+
+     xsize, ysize, marksize, mark refresh line mode :
+
+
+INT VAR xs := 80, ys := 24, ms := 1;
+
+INT PROC xsize: xs END PROC xsize;
+
+INT PROC ysize: ys END PROC ysize;
+
+INT PROC marksize: ms END PROC marksize;
+
+PROC xsize (INT CONST i): xs := i END PROC xsize;
+
+PROC ysize (INT CONST i): ys := i END PROC ysize;
+
+PROC marksize (INT CONST i): ms := i END PROC marksize;
+
+ 
+BOOL VAR line mode := FALSE; 
+ 
+BOOL PROC mark refresh line mode:
+  line mode
+END PROC mark refresh line mode;
+ 
+PROC mark refresh line mode (BOOL CONST b): 
+  line mode := b 
+END PROC mark refresh line mode; 
+ 
+END PACKET screen description ;
+
diff --git a/system/base/1.7.5/src/std transput b/system/base/1.7.5/src/std transput
new file mode 100644
index 0000000..94c51db
--- /dev/null
+++ b/system/base/1.7.5/src/std transput
@@ -0,0 +1,264 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET std transput DEFINES 
+ 
+    sysout ,
+    sysin ,
+    put ,
+    putline ,
+    line ,
+    page ,
+    write ,
+    get ,
+    getline , 
+    get secret line :
+ 
+ 
+LET cr              = ""13"" ,
+    cr lf           = ""13""10"" ,
+    home clear      = ""1""4"" ,
+    esc             = ""27"" ,
+    rubout          = ""12"" ,
+    bell            = ""7"" ,
+    back blank back = ""8" "8"" ,
+    del line cr lf  = ""5""13""10"" ;
+
+TEXT VAR number word , exit char ;
+
+BOOL VAR console output := TRUE, console input := TRUE ;
+
+FILE VAR outfile, infile ;
+TEXT VAR outfile name := "", infile name := "" ;
+
+
+PROC sysout (TEXT CONST file name) :
+
+  outfile name := file name ;
+  IF file name = ""
+    THEN console output := TRUE
+    ELSE outfile := sequential file (output, file name) ;
+         console output := FALSE
+  FI
+
+ENDPROC sysout ;
+
+TEXT PROC sysout :
+  outfile name
+ENDPROC sysout ;
+
+PROC sysin (TEXT CONST file name) :
+
+  infile name := file name ;
+  IF file name = ""
+    THEN console input := TRUE
+    ELSE infile := sequential file (input, file name) ;
+         console input := FALSE
+  FI
+
+ENDPROC sysin ;
+
+TEXT PROC sysin :
+  infile name
+ENDPROC sysin ;
+
+
+PROC put (TEXT CONST word) :
+
+  IF console output
+    THEN out (word) ; out (" ")
+    ELSE put (outfile, word)
+  FI
+
+ENDPROC put ;
+
+PROC put (INT CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC put (REAL CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC putline (TEXT CONST textline) :
+
+  IF console output
+    THEN out (textline) ; out (cr lf)
+    ELSE putline (outfile, textline)
+  FI
+
+ENDPROC putline ;
+
+PROC line :
+
+  IF console output
+    THEN out (cr lf)
+    ELSE line (outfile)
+  FI 
+
+ENDPROC line ;
+
+PROC line (INT CONST times) :
+
+  INT VAR i ;
+  FOR i FROM 1 UPTO times REP
+    line
+  PER
+
+ENDPROC line ;
+
+PROC page :
+
+  IF console output
+    THEN out (home clear)
+  FI
+
+ENDPROC page ;
+
+PROC write (TEXT CONST word) :
+
+  IF console output 
+    THEN out (word)
+    ELSE write (outfile, word)
+  FI
+
+ENDPROC write ;
+
+
+PROC get (TEXT VAR word) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word)
+  FI .
+
+get from console :
+  REP
+    word := "" ;
+    editget (word, " ", "", exit char) ;
+    echoe exit char
+  UNTIL word <> "" AND word <> " " PER ;
+  delete leading blanks .
+ 
+delete leading blanks :
+  WHILE (word SUB 1) = " " REP
+    word := subtext (word,2)
+  PER .
+ 
+ENDPROC get ;
+ 
+PROC get (TEXT VAR word, TEXT CONST separator) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, separator)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, separator, "", exit char) ;
+  echoe exit char .
+
+ENDPROC get ;
+ 
+PROC echoe exit char :
+ 
+  IF exit char = ""13""
+    THEN out (""13""10"")
+    ELSE out (exit char)
+  FI
+ 
+ENDPROC echoe exit char ;
+ 
+PROC get (INT VAR number) :
+
+  get (number word) ;
+  number := int (number word)
+
+ENDPROC get ;
+
+PROC get (REAL VAR number) :
+
+  get (number word) ;
+  number := real (number word) 
+
+ENDPROC get ;
+
+PROC get (TEXT VAR word, INT CONST length) :
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, length)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, length, exit char) ;
+  echoe exit char .
+ 
+ENDPROC get ;
+ 
+PROC getline (TEXT VAR textline) : 
+
+  IF console input
+    THEN get from console
+    ELSE getline (infile, textline)
+  FI .
+
+get from console :
+  textline := "" ;
+  editget (textline, "", "", exit char) ;
+  echoe exit char
+ 
+ENDPROC getline ;
+ 
+PROC get secret line (TEXT VAR textline) :
+
+  TEXT VAR char ;
+  textline := "" ;
+  get start cursor position ;
+  get line very secret ;
+  IF char = esc
+    THEN get line little secret
+  FI ;
+  cursor to start position ;
+  out (del line cr lf) .
+
+get line very secret :
+  REP
+    inchar (char) ;
+    IF char = esc OR char = cr
+      THEN LEAVE get line very secret
+    ELIF char = rubout
+      THEN delete last char
+    ELIF char >= " "
+      THEN textline CAT char ;
+           out (".")
+    ELSE   out (bell)
+    FI
+  PER .
+
+delete last char :
+  IF LENGTH textline = 0
+    THEN out (bell)
+    ELSE out (back blank back) ;
+         delete char (textline, LENGTH textline)
+  FI .
+
+get line little secret :
+  cursor to start position ;
+  editget (textline, "", "", exit char) .
+
+get start cursor position :
+  INT VAR x, y; 
+  get cursor (x, y) .
+
+cursor to start position :
+  cursor (x, y) .
+
+ENDPROC get secret line ;
+
+ENDPACKET std transput ;
+
diff --git a/system/base/1.7.5/src/tasten b/system/base/1.7.5/src/tasten
new file mode 100644
index 0000000..752303b
--- /dev/null
+++ b/system/base/1.7.5/src/tasten
@@ -0,0 +1,113 @@
+
+PACKET  tasten verwaltung  DEFINES                                (* #009 *)
+        (***************) 
+ 
+        lernsequenz auf taste legen, 
+        lernsequenz auf taste, 
+        kommando auf taste legen,
+        kommando auf taste,
+        taste enthaelt kommando,
+        std tastenbelegung :
+ 
+ 
+
+LET kommandoidentifikation = ""0"" ,
+    esc = ""27"" ,
+    niltext = "" ,
+    hop right left up down cr tab rubin rubout mark esc
+            = ""1""2""8""3""10""13""9""11""12""16""27"" ;
+ 
+ 
+ROW 256 TEXT VAR belegung;
+INT VAR i; FOR i FROM 1 UPTO 256 REP belegung (i) := "" PER;
+ 
+std tastenbelegung;
+ 
+ 
+PROC lernsequenz auf taste legen (TEXT CONST taste, lernsequenz) :
+ 
+  belege (belegung (code (taste) + 1), taste, lernsequenz)
+ 
+ENDPROC lernsequenz auf taste legen ;
+ 
+PROC belege (TEXT VAR tastenpuffer, TEXT CONST taste, lernsequenz) :
+  tastenpuffer := lernsequenz ;
+  verhindere rekursives lernen .
+ 
+verhindere rekursives lernen :
+  loesche alle folgen esc taste aber nicht esc esc taste ;
+  IF taste ist freies sonderzeichen
+    THEN change all (tastenpuffer, taste, niltext)
+  FI .
+ 
+loesche alle folgen esc taste aber nicht esc esc taste :
+  INT VAR i := pos (tastenpuffer, esc + taste) ;
+  WHILE i > 0 REP
+    IF ist esc esc taste
+      THEN i INCR 1
+      ELSE change (tastenpuffer, i, i+1, niltext)
+    FI ;
+    i := pos (tastenpuffer, esc + taste, i)
+  PER .
+ 
+ist esc esc taste :
+  (tastenpuffer SUB i-1) = esc AND (tastenpuffer SUB i-2) <> esc .
+ 
+taste ist freies sonderzeichen :
+  taste < ""32"" AND
+  pos (hop right left up down cr tab rubin rubout mark esc, taste) = 0 .
+ 
+END PROC belege ;
+ 
+ 
+TEXT PROC lernsequenz auf taste (TEXT CONST taste) :
+  IF   taste enthaelt kommando (taste)
+  THEN ""
+  ELSE belegung (code (taste) + 1)
+  FI
+END PROC lernsequenz auf taste;
+ 
+ 
+PROC kommando auf taste legen (TEXT CONST taste, kommando) :
+ 
+  belegung (code (taste) + 1) := kommandoidentifikation;
+  belegung (code (taste) + 1) CAT kommando
+ 
+END PROC kommando auf taste legen;
+ 
+ 
+TEXT PROC kommando auf taste (TEXT CONST taste) :
+  IF   taste enthaelt kommando (taste)
+  THEN subtext (belegung (code (taste) + 1), 2)
+  ELSE ""
+  FI
+END PROC kommando auf taste;
+ 
+ 
+BOOL PROC taste enthaelt kommando (TEXT CONST taste) :
+  (belegung (code (taste) + 1) SUB 1) = kommandoidentifikation
+END PROC taste enthaelt kommando;
+ 
+ 
+PROC std tastenbelegung:
+  lernsequenz auf taste legen ("(", ""91"");
+  lernsequenz auf taste legen (")", ""93"");
+  lernsequenz auf taste legen ("<", ""123"");
+  lernsequenz auf taste legen (">", ""125"");
+  lernsequenz auf taste legen ("A", ""214"");
+  lernsequenz auf taste legen ("O", ""215"");
+  lernsequenz auf taste legen ("U", ""216"");
+  lernsequenz auf taste legen ("a", ""217"");
+  lernsequenz auf taste legen ("o", ""218"");
+  lernsequenz auf taste legen ("u", ""219"");
+  lernsequenz auf taste legen ("k", ""220"");
+  lernsequenz auf taste legen ("-", ""221"");
+  lernsequenz auf taste legen ("#", ""222"");
+  ler�sequenz auf taste legen (" ", ""223"");
+  lernsequenz auf taste legen ("B", ""251"");
+  lernsequenz auf taste legen ("s", ""251"");
+END PROC std tastenbelegung;
+ 
+ 
+END PACKET tasten verwaltung;
+
diff --git a/system/base/1.7.5/src/text b/system/base/1.7.5/src/text
new file mode 100644
index 0000000..4c659cf
--- /dev/null
+++ b/system/base/1.7.5/src/text
@@ -0,0 +1,391 @@
+(* ------------------- VERSION 3     06.03.86 ------------------- *)
+PACKET text DEFINES
+ 
+            max text length ,
+            SUB ,
+            subtext ,
+            text ,
+            length , LENGTH ,
+            CAT ,
+            + ,
+            * ,
+            replace ,
+            change ,
+            change all ,
+            compress ,
+            pos ,
+            code ,
+            ISUB ,
+            RSUB ,
+            delete char ,
+            insert char ,
+            delete int ,
+            insert int ,
+            heap size ,
+            collect heap garbage ,
+            stranalyze ,
+            LEXEQUAL ,
+            LEXGREATER ,
+            LEXGREATEREQUAL :
+
+ 
+ 
+TEXT VAR text buffer , tail buffer ;
+ 
+INT CONST max text length := 32000 ;
+ 
+TEXT OP SUB (TEXT CONST text, INT CONST pos ) :
+ EXTERNAL 48
+END OP SUB ;
+ 
+TEXT PROC subtext (TEXT CONST source, INT CONST from, to ):
+ EXTERNAL 49 
+ENDPROC subtext ;
+ 
+TEXT PROC subtext (TEXT CONST source, INT CONST from ) : 
+ EXTERNAL 50 
+ENDPROC subtext ; 
+ 
+INT PROC code (TEXT CONST text) :
+ EXTERNAL 46
+END PROC code ;
+ 
+TEXT PROC code (INT CONST code) :
+ EXTERNAL 47 
+ENDPROC code ;
+
+INT OP ISUB (TEXT CONST text, INT CONST index) :
+ EXTERNAL 44
+ENDOP ISUB ;
+ 
+PROC replace (TEXT VAR text, INT CONST index, value) :
+ EXTERNAL 45
+ENDPROC replace ;
+
+REAL OP RSUB (TEXT CONST text, INT CONST index) :
+ EXTERNAL 100
+ENDOP RSUB ;
+
+PROC replace (TEXT VAR text, INT CONST index, REAL CONST code) :
+ EXTERNAL 101
+ENDPROC replace ;
+ 
+ 
+PROC replace (TEXT VAR dest, INT CONST pos, TEXT CONST source) : 
+ EXTERNAL 51 
+ENDPROC replace ; 
+ 
+TEXT PROC text (TEXT CONST source, INT CONST length ) : 
+
+  IF length < LENGTH source 
+     THEN text buffer := subtext (source,1,length) 
+     ELSE text buffer := source ;
+          mit blanks auffuellen 
+  FI ; 
+  text buffer .
+ 
+mit blanks auffuellen : 
+  INT VAR i ;
+  FOR i FROM 1 UPTO length - LENGTH source REP
+    text buffer CAT " "
+  PER .
+
+ENDPROC text ; 
+ 
+TEXT PROC text (TEXT CONST source, INT CONST length, from) : 
+  text ( subtext (source, from) , length ) 
+ENDPROC text ; 
+ 
+OP CAT (TEXT VAR right, TEXT CONST left ) :
+ EXTERNAL 52 
+ENDOP CAT ;
+ 
+TEXT OP + (TEXT CONST left, right) : 
+ text buffer := left ;
+ text buffer CAT right ; 
+ text buffer
+ENDOP + ; 
+ 
+TEXT OP * (INT CONST times, TEXT CONST source ) : 
+
+  text buffer := "" ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO times REP
+    text buffer CAT source
+  PER ;
+  text buffer
+
+ENDOP * ;
+ 
+INT PROC length (TEXT CONST text ) : 
+ EXTERNAL 53 
+ENDPROC length ; 
+ 
+INT OP LENGTH (TEXT CONST text ) : 
+ EXTERNAL 53 
+ENDOP LENGTH ;
+ 
+INT PROC pos (TEXT CONST source, pattern) : 
+ EXTERNAL 54 
+ENDPROC pos ; 
+ 
+INT PROC pos (TEXT CONST source, pattern, INT CONST from) : 
+ EXTERNAL 55 
+ENDPROC pos ;
+
+INT PROC pos (TEXT CONST source, pattern, INT CONST from, to) :
+ EXTERNAL 56 
+ENDPROC pos ;
+ 
+INT PROC pos (TEXT CONST source, low, high, INT CONST from) :
+ EXTERNAL 58
+ENDPROC pos ;
+
+TEXT PROC compress (TEXT CONST text) : 
+ 
+  INT VAR begin, end ;
+ 
+  search first non blank ;
+  search last non blank ;
+  text buffer := subtext (text, begin, end) ;
+  text buffer .
+ 
+search first non blank : 
+  begin := 1 ;
+  WHILE (text SUB begin) = " " REP
+    begin INCR 1
+  PER .
+ 
+search last non blank : 
+  end := LENGTH text ;
+  WHILE (text SUB end) = " " REP
+    end DECR 1
+  PER .
+ 
+ENDPROC compress ;
+ 
+PROC change (TEXT VAR destination, INT CONST from, to, TEXT CONST new) :
+ 
+  IF LENGTH new = to - from + 1 AND to <= LENGTH destination
+    THEN replace (destination, from, new)
+    ELSE change via buffer
+  FI .
+
+change via buffer :
+  text buffer := subtext (destination, 1, from-1) ;
+  text buffer CAT new ;
+  tail buffer := subtext (destination, to + 1) ;
+  text buffer CAT tail buffer ;
+  destination := text buffer
+ 
+ENDPROC change ;
+ 
+PROC change (TEXT VAR destination, TEXT CONST old, new) :
+ 
+  INT CONST position := pos (destination, old) ;
+  IF position > 0
+    THEN change (destination, position, position + LENGTH old -1, new)
+  FI
+ 
+ENDPROC change ;
+ 
+PROC change all (TEXT VAR destination, TEXT CONST old, new) :
+ 
+  INT VAR position := pos (destination, old) ;
+  IF LENGTH old = LENGTH new
+    THEN change by replace
+    ELSE change by change
+  FI .
+
+change by replace :
+  WHILE position > 0 REP
+    replace (destination, position, new) ;
+    position := pos (destination, old, position + LENGTH new)
+  PER .
+
+change by change :
+  WHILE position > 0 REP
+    change (destination, position, position + LENGTH old - 1 , new) ;
+    position := pos (destination, old, position + LENGTH new)
+  PER .
+ 
+ENDPROC change all ;
+ 
+PROC delete char (TEXT VAR string, INT CONST delete pos) : 
+ 
+  IF delete pos > 0
+    THEN tail buffer := subtext (string, delete pos + 1) ;
+         string := subtext (string, 1, delete pos - 1) ;
+         string CAT tail buffer
+  FI
+ 
+END PROC delete char ; 
+ 
+PROC insert char (TEXT VAR string, TEXT CONST char,
+                  INT CONST insert pos) : 
+ 
+  IF insert pos > 0 AND insert pos <= LENGTH string + 1
+    THEN tail buffer := subtext (string, insert pos) ;
+         string := subtext (string, 1, insert pos - 1) ;
+         string CAT char ;
+         string CAT tail buffer
+  FI
+ 
+END PROC insert char ; 
+ 
+INT PROC heap size :
+  EXTERNAL 93
+ENDPROC heap size ;
+
+PROC collect heap garbage :
+  EXTERNAL 94
+ENDPROC collect heap garbage ;
+
+PROC stranalyze (ROW 256 INT CONST table, INT VAR sum, INT CONST max sum,
+                 TEXT CONST string, INT VAR index, INT CONST to,
+                 INT VAR exit code) :
+  EXTERNAL 57
+ENDPROC stranalyze ;
+
+(*******************************************************************)
+(* lexikographische Vergleiche                                     *)
+(* Nach DIN 5007, Abschnitt 1 und Abschnitt 3.2 (Bindestrich)      *)
+(* Autor: Rainer Hahn, Jochen Liedtke                              *)
+(* Stand: 1.7.4 (Jan. 1985)                                        *)
+(*******************************************************************)
+LET first umlaut = ""214"" ,
+    umlauts      = ""214""215""216""217""218""219""251"" ;
+
+ 
+TEXT VAR left letter, right letter; 
+ 
+BOOL OP LEXEQUAL (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter = right letter 
+ 
+ENDOP LEXEQUAL ; 
+ 
+BOOL OP LEXGREATER (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter > right letter 
+ 
+ENDOP LEXGREATER ; 
+ 
+BOOL OP LEXGREATEREQUAL (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter >= right letter 
+ 
+ENDOP LEXGREATEREQUAL ; 
+ 
+PROC compare (TEXT CONST left, right) :
+ 
+  to begin of lex relevant text ; 
+  REP 
+    get left letter ; 
+    get right letter 
+  UNTIL NOT letter match OR both ended PER . 
+ 
+to begin of lex relevant text : 
+  INT VAR 
+  left pos  := pos (left, ""65"",""254"", 1) , 
+  right pos := pos (right,""65"",""254"", 1) ;
+  IF left pos = 0
+    THEN left pos := LENGTH left + 1
+  FI ;
+  IF right pos = 0
+    THEN right pos := LENGTH right + 1
+  FI .
+
+get left letter :
+  left letter := left SUB left pos ;
+  left pos INCR 1 .
+
+get right letter :
+  right letter := right SUB right pos ;
+  right pos INCR 1 .
+
+letter match :
+  IF left letter = right letter
+    THEN TRUE
+    ELSE dine (left, left letter, left pos) ;
+         dine (right, right letter, right pos) ;
+         IF exactly one letter is double letter
+           THEN expand other letter
+         FI ;
+         left letter = right letter
+  FI .
+
+exactly one letter is double letter :
+  LENGTH left letter <> LENGTH right letter.
+
+expand other letter :
+  IF LENGTH left letter = 1
+    THEN left letter CAT (left SUB left pos) ;
+         left pos INCR 1
+    ELSE right letter CAT (right SUB right pos) ;
+         right pos INCR 1
+  FI .
+
+both ended : left letter = "" .
+
+ENDPROC compare ;
+
+PROC dine (TEXT CONST string, TEXT VAR char, INT VAR string pos) :
+
+  skip non letter chars ;
+  IF is capital letter
+    THEN translate to small letter
+  ELIF char >= first umlaut
+    THEN translate umlaut
+  FI .
+
+skip non letter chars :
+  WHILE NOT (is letter OR end of string) REP
+    char := string SUB string pos ;
+    string pos INCR 1
+  PER .
+
+translate to small letter :
+  char := code (code (char) + 32) .
+
+translate umlaut :
+  SELECT pos (umlauts, char) OF
+    CASE 1,4 : char := "ae"
+    CASE 2,5 : char := "oe"
+    CASE 3,6 : char := "ue"
+    CASE 7   : char := "ss"
+  ENDSELECT .
+
+is capital letter : 
+  INT VAR char code := code (char) ;
+  65 <= char code AND char code <= 90 .
+
+is letter :
+  char code := code (char) OR 32 ;
+  (97 <= char code AND char code <= 122)  OR  char code >= 128 .
+
+end of string : char = "" .
+
+ENDPROC dine ;
+
+OP CAT (TEXT VAR result, INT CONST number) :
+    result CAT "  ";
+    replace (result, LENGTH result DIV 2, number);
+END OP CAT;
+ 
+PROC insert int (TEXT VAR result, INT CONST insert pos, number) :
+    INT VAR pos := insert pos * 2 - 1; 
+    change  (result, pos, pos - 1, "  ");
+    replace (result, insert pos, number);
+END PROC insert int;
+ 
+PROC delete int (TEXT VAR result, INT CONST delete pos) :
+    INT VAR pos := delete pos * 2;
+    change  (result, pos - 1, pos, "")
+END PROC delete int; 
+ 
+ENDPACKET text ;
+
diff --git a/system/base/1.7.5/src/texter errors b/system/base/1.7.5/src/texter errors
new file mode 100644
index 0000000..9c4383d
--- /dev/null
+++ b/system/base/1.7.5/src/texter errors
@@ -0,0 +1,284 @@
+(* ------------------- VERSION 66 vom 06.03.86 -------------------- *)
+PACKET texter errors and common DEFINES
+   only command line,
+   skip input,
+   char pos move,
+   begin of this char,
+   number chars,
+   display and pause,
+   report text processing error,
+   report text processing warning:
+
+(* Programm zur zentralen Haltung aller Fehlermeldungen der Textkosmetik
+   Autor: Rainer Hahn
+   Stand: 1.7.1 Febr. 1984
+          1.7.3 Juli    "
+          1.7.4 Febr. 1985
+ *)
+
+LET escape = ""27"";
+
+TEXT VAR fehlerdummy;
+
+BOOL PROC only command line (TEXT CONST zeile):
+INT VAR anfang, ende;
+LET kommando zeichen = "#";
+  IF pos (zeile, kommando zeichen) = 1
+    THEN ende := pos (zeile, kommando zeichen, 2); 
+         IF ende > 0
+           THEN zaehle kommandos durch;
+                LEAVE only command line WITH richtiges kommandoende
+         FI
+  FI;
+  FALSE.
+ 
+zaehle kommandos durch:
+  WHILE ende + 1 = pos (zeile, kommando zeichen, ende +1) REP
+    anfang := pos (zeile, kommando zeichen, ende + 1);
+    ende   := pos (zeile, kommando zeichen, anfang + 1)
+  END REP.
+ 
+richtiges kommandoende:
+  ende > 0 AND
+     (ende = length (zeile) OR (ende = length (zeile) - 1 AND absatzzeile)).
+ 
+absatzzeile:
+  (zeile SUB length (zeile)) = " ". 
+END PROC only command line;
+
+PROC skip input:
+  REP
+    TEXT CONST zeichen :: incharety;
+    IF zeichen = escape
+      THEN errorstop ("Abbruch durch ESC")
+    FI
+  UNTIL zeichen = "" END REP
+END PROC skip input;
+
+PROC char pos move (TEXT CONST ein text, INT VAR zpos, INT CONST richtung):
+  zpos INCR richtung;
+  IF within kanji (ein text, zpos)
+    THEN zpos INCR richtung
+  FI
+END PROC char pos move;
+
+PROC begin of this char (TEXT CONST ein text, INT VAR zpos):
+  IF zpos < 1 OR zpos > length (ein text)
+    THEN display and pause (7)
+    ELSE suche zeichenposition
+  FI.
+
+suche zeichenposition:
+  IF within kanji (ein text, zpos)
+    THEN zpos DECR 1
+  FI.
+END PROC begin of this char;
+
+INT PROC number chars (TEXT CONST ein text, INT CONST von pos, bis pos):
+  INT VAR index :: von pos, anz :: 0;
+  WHILE index <= bis pos REP
+   IF index > length (ein text) OR index > bis pos
+     THEN display and pause (5); LEAVE number chars WITH 0
+   FI;
+   IF is kanji esc (ein text SUB index)
+     THEN index INCR 2
+     ELSE index INCR 1
+   FI;
+   anz INCR 1
+ END REP;
+ anz
+END PROC number chars;
+
+PROC display and pause (INT CONST nr):
+  line ; put ("LINER ERROR"); put (nr); pause
+END PROC display and pause;
+
+PROC report text processing error (INT CONST error nr,
+                                  INT CONST line nr,
+                                  TEXT VAR  message, 
+                                  TEXT CONST addition):
+ 
+  einfache meldung aufbauen; 
+  meldung in fehlerdatei ausgeben. 
+ 
+einfache meldung aufbauen: 
+  message := "FEHLER Zeile ";
+  message CAT text (line nr);
+  message CAT ": ";
+  message CAT simple message;
+  message CAT " ";
+  message CAT addition.
+ 
+meldung in fehlerdatei ausgeben: 
+  note (message);
+  note line;
+  fehlerdummy := "   >>> ";
+  fehlerdummy CAT zusatz;
+  note (fehlerdummy);
+  note line.
+ 
+simple message:
+  SELECT error nr OF
+  CASE 1: "Unbekannter Schriftyp ignoriert:"
+  CASE 2: "#-Zeichen fehlt"
+  CASE 3: "foot in Fußnote (ignoriert)"
+  CASE 4: "cm-Angabe fehlt (REAL) (ignoriert):"
+  CASE 5: "INT-Parameter erwartet (ignoriert):"
+  CASE 6: "(versuchte) Trennung in Macro-Text"
+  CASE 7: "ie-Anweisung fehlt bei Seitenende"
+  CASE 8: "Unbekannte Anweisung (ignoriert):"
+  CASE 9: "Nicht kompilierbares Programm:"
+  CASE 10: "Einrückung (Leerzeichen am Zeilenanfang) zu groß"
+  CASE 11: "Anweisung hier nicht erlaubt (ignoriert):"
+  CASE 12: "Tabellen-Position liegt innerhalb eines b pos:"
+  CASE 13: "free-Wert > Textteil der Seite (ignoriert)"
+  CASE 14: "Mehr als 1 Zeichen in pagenr (ignoriert)"
+  CASE 15: "Macro innerhalb eines Macros definiert (ignoriert):"
+  CASE 16: "Mehr als drei Seitenzeichen"
+  CASE 17: "Mehr als zehn Zeilen im Index"
+  CASE 18: "Index Parameter inkorrekt (ignoriert): "
+  CASE 19: "Hinter Anweisung darf nichts mehr stehen (ignoriert):"
+  CASE 20: "Doppelter Index ignoriert:"
+  CASE 21: "ib(..) fehlt:"
+  CASE 22: "Inkorrekte Anweisung:"
+  CASE 23: "2 Byte Zeichen ohne zweites Zeichen am Zeilenende"
+  CASE 24: "free-Wert größer Seitenlänge (ignoriert):"
+  CASE 25: "Seitenende in head, bottom oder foot-Bereich plaziert"
+  CASE 26: "Anzahl columns < 2 ignoriert"
+  CASE 27: "INT-Parameter <= 0 ignoriert:"
+  CASE 28: "Kein Textzeichen vor oder hinter b"
+  CASE 29: "Nochmaliges columns ohne columns end (ignoriert)"
+  CASE 30: "set count-Parameter inkorrekt (ignoriert):"
+  CASE 31: "end ohne vorangehendes head, bottom oder foot"
+  CASE 32: "Max. Anzahl von Tabellen-Positionen überschritten"
+  CASE 33: "Macro-Aufruf oder -Definition in einem Macro (ignoriert):"
+  CASE 34: "counter nicht initialisiert (ignoriert):"
+  CASE 35: "store counter Kennung bereits vorhanden (ignoriert):"
+  CASE 36: "Spaltenbreite > limit"
+  CASE 37: "Zentimeter-Angabe in limit = 0 (ignoriert)"
+  CASE 38: "Zentimeter-Angabe inkorrekt (ignoriert):"
+  CASE 39: "Zentimeter-Angabe > als eingestelltes limit (ignoriert):"
+  CASE 40: "Makro-Definition (ignoriert):"
+  CASE 41: "Nochmaliges table ohne table end (ignoriert)"
+  CASE 42: "pos bereits hier gesetzt (ignoriert):"
+  CASE 43: "Druckposition (pos) nicht vorhanden:"
+  CASE 44: "Text breiter als Spalte bei:"
+  CASE 45: "rpos überschreibt vorherige Spalte bei:"
+  CASE 46: "cpos überschreibt vorherige Spalte bei:"
+  CASE 47: "dpos überschreibt vorherige Spalte bei:"
+  CASE 48: "Geblockter Text breiter als Spalte bei:"
+  CASE 49: "table end fehlt"
+  CASE 50: "Zentrierzeichen für dpos fehlt bei:"
+  CASE 51: "e-Anweisung ohne vorangehendes d oder u"
+  CASE 52: "fehlendes e auf dieser Zeile"
+  CASE 53: "Wort mit Exponent oder Index zu lang"
+  CASE 54: "Modifikation bereits angeschaltet bei on:"
+  CASE 55: "Modifikation nicht angeschaltet bei off:"
+  CASE 56: "Index bereits angeschaltet bei ib:"
+  CASE 57: "Index nicht angeschaltet bei ie:"
+  CASE 58: "Inkorrekte direkte Drucker-Anweisung (TEXT-Denoter):"
+  CASE 59: "tableend ohne vorangehendes table"
+  CASE 60: "put counter fehlt für:"
+  CASE 61: "store counter fehlt für:"
+  OTHERWISE ""
+  ENDSELECT.
+ 
+zusatz:
+  SELECT error nr OF
+  CASE 1: "type-Anweisung korrigieren"
+  CASE 2: "Bitte Einfügen"
+  CASE 3: "Geschachtelte Fußnoten sind nicht möglich"
+  CASE 4: "Beispiel: limit(16.0)"
+  CASE 5: "Beispiele: page(4), pagenr(""%"",4)"
+  CASE 6: "Trennung erscheint nicht im Ausdruck!"
+  CASE 7: "Index in Indexdatei ggf. vervollständigen"
+  CASE 10: "für Zeilenbreite (limit): Leerzeichen entfernen"
+  CASE 11: "(In head-, bottom- und foot-Bereichen)"
+  CASE 13: "Parameterwert verkleinern"
+  CASE 14: "Beispiel: pagenr(""$"",5)"
+  CASE 15: "Macros kontrollieren und ggf. neu laden"
+  CASE 16: "sind z.Z. nicht zugelassen"
+  CASE 17: "ie(..) vergessen?"
+  CASE 18: "1.Parameter gibt die Index-Nummer (1-10) an. Beispiel: ie(9)"
+  CASE 19: "Anweisung muß alleine oder am Zeilenende stehen"
+  CASE 24: "in einem head, bottom oder foot-Bereich"
+  CASE 25: "Vor oder hinter den Bereich plazieren"
+  CASE 26: "1.Parameter in columns korrigieren"
+  CASE 27: "Beispiel: page(20)"
+  CASE 29: "page und columnsend vorher einfügen"
+  CASE 30: "Beispiele: setcount(0); setcount(27)"
+  CASE 31: "end ggf. entfernen" 
+  CASE 34: "Bitte set counter einfuegen"
+  CASE 37: "Muß positiv sein"
+  CASE 38: "Beispiel: limit(16.0)"
+  CASE 40: "pos-Anweisungen vor table plazieren"
+  CASE 41: "tableend vergessen?"
+  CASE 42: "Bitte pos-Anweisungen überprüfen"
+  CASE 43: "in clear pos-Anweisung"
+  CASE 48: "Ggf. lineform über die Spalte"
+  CASE 49: "Bitte vor Dateiende einfügen"
+  CASE 51, 52: "Bitte u und d-Anweisungen kontrollieren"
+  CASE 53: "e-Anweisung vergessen?"
+  CASE 54, 55, 56, 57: "Anweisung in angegebener Zeilennummer überprüfen"
+  CASE 60: "Bitte store counter Anweisungen überprüfen"
+  OTHERWISE "Bitte Korrigieren"
+  END SELECT.
+END PROC report text processing error;
+
+PROC report text processing warning (INT CONST error nr,
+                                     INT CONST line nr,
+                                     TEXT VAR  message, 
+                                     TEXT CONST addition):
+ 
+  einfache meldung aufbauen; 
+  meldung in fehlerdatei ausgeben. 
+ 
+einfache meldung aufbauen: 
+  message := "WARNUNG Zeile ";
+  message CAT text (line nr);
+  message CAT ": ";
+  message CAT simple message;
+  message CAT " ";
+  message CAT addition.
+ 
+meldung in fehlerdatei ausgeben: 
+  note (message);
+  note line;
+  fehlerdummy := "   >>> ";
+  fehlerdummy CAT zusatz;
+  note (fehlerdummy);
+  note line.
+ 
+simple message:
+  SELECT error nr OF
+  CASE 1, 2: ""
+  CASE 3: "Nicht referenziert:"
+  CASE 4: "Ziel-Referenz fehlt:"
+  CASE 5: "Modifikation bei Dateiende nicht ausgeschaltet:"
+  CASE 6: "Index bei Dateiende nicht ausgeschaltet:"
+  CASE 7: "Nicht getrenntes Wort zu lang für Zeilenbreite:"
+  CASE 8: "Umschaltung auf gleichen Schrifttyp:"
+  CASE 9: "Kennzeichen schon vorhanden (Duplikat ignoriert):"
+  CASE 10: "Tabellenzeile breiter als limit"
+  CASE 11: "Mehr Spalten als Tabellen-Positionen bei:"
+  CASE 12: "Überschreibung nach"
+  CASE 13: "Leerzeichen vor:"
+  CASE 14: "Weniger Spalten als Tabellen-Positionen"
+  CASE 15: "counter mit dieser Kennung bereits initialisiert:"
+  OTHERWISE ""
+  ENDSELECT.
+ 
+zusatz:
+  SELECT error nr OF
+  CASE 3: "topage oder value fehlt"
+  CASE 4: "goalpage oder value fehlt" 
+  CASE 7: "Bitte nachträglich trennen!" 
+  CASE 8: "Schrifttyp wurde darum nicht verändert!"
+  CASE 9: "count und goalpage überprüfen"
+  CASE 12: "Bitte fehlende Leerzeichen einfügen"
+  CASE 13: "erzeugt ggf. zusätzliche Leerzeile"
+  OTHERWISE "Bitte überprüfen"
+  END SELECT.
+END PROC report text processing warning;
+END PACKET texter errors and common;
+
diff --git a/system/base/1.7.5/src/thesaurus b/system/base/1.7.5/src/thesaurus
new file mode 100644
index 0000000..5ef7251
--- /dev/null
+++ b/system/base/1.7.5/src/thesaurus
@@ -0,0 +1,332 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET thesaurus handling                (* Autor: J.Liedtke      *)
+ 
+       DEFINES     THESAURUS , 
+                   := , 
+                   empty thesaurus , 
+                   insert,          (* fuegt ein Element ein *) 
+                   delete,          (* loescht ein Element falls vorhanden*) 
+                   rename,          (* aendert ein Element falls vorhanden*)
+                   CONTAINS ,       (* stellt fest, ob enthalten *)
+                   link ,           (* index in thesaurus        *) 
+                   name ,           (* name of entry             *)
+                   get ,            (* get next entry ("" is eof)*)
+                   highest entry :  (* highest valid index of thes*)
+
+
+TYPE THESAURUS = TEXT ;
+ 
+LET thesaurus size = 200 ,
+    nil = 0 ,
+    niltext = "" ,
+    max name length = 80 ,
+
+    begin entry char = ""0"" ,
+    end entry char   = ""1"" ,
+
+    nil entry        = ""0""1"" ,
+    nil name         = "" ,
+
+    quote            = """" ;
+
+TEXT VAR entry ;
+INT VAR  cache index := 0 ,
+         cache pos ;
+
+
+PROC access (THESAURUS CONST thesaurus, TEXT CONST name) :
+
+  construct entry ;
+  IF NOT cache identifies entry
+    THEN search through thesaurus list
+  FI ;
+  IF entry found
+    THEN cache index := code (list SUB (cache pos - 1))
+    ELSE cache index := 0
+  FI .
+
+construct entry :
+  entry := begin entry char ;
+  entry CAT name ;
+  decode invalid chars (entry, 2) ;
+  entry CAT end entry char .
+
+search through thesaurus list :
+  cache pos := pos (list, entry) .
+
+cache identifies entry :
+  cache pos <> 0 AND
+  pos (list, entry, cache pos, cache pos + LENGTH entry) = cache pos .
+
+entry found :  cache pos > 0 .
+
+list :  CONCR (thesaurus) .
+
+ENDPROC access ;
+
+PROC access (THESAURUS CONST thesaurus, INT CONST index) :
+
+  IF cache identifies index
+    THEN cache index := index ;
+         construct entry
+    ELSE cache pos := pos (list, code (index) + begin entry char) ;
+         IF entry found
+           THEN cache pos INCR 1 ;
+                cache index := index ;
+                construct entry
+           ELSE cache index := 0 ;
+                entry := niltext
+         FI
+  FI .
+
+construct entry :
+  entry := subtext (list, cache pos, pos (list, end entry char, cache pos)) .
+
+cache identifies index :
+  subtext (list, cache pos-1, cache pos) = code (index) + begin entry char .
+
+entry found :  cache pos > 0 .
+
+list :    CONCR (thesaurus) .
+
+ENDPROC access ;
+
+
+
+THESAURUS PROC empty thesaurus :
+
+  THESAURUS : (""1"")
+
+ENDPROC empty thesaurus ; 
+ 
+ 
+OP := (THESAURUS VAR dest, THESAURUS CONST source ) : 
+ 
+  CONCR (dest) := CONCR (source) .
+
+ENDOP := ; 
+ 
+TEXT VAR insert name ;
+
+PROC insert (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : 
+ 
+  insert name := name ;
+  decode invalid chars (insert name, 1) ;
+  IF insert name = "" OR LENGTH insert name > max name length
+    THEN index := nil ; errorstop ("Name unzulaessig")
+    ELSE insert element
+  FI .
+ 
+insert element :
+  search free entry ;
+  IF   entry found 
+    THEN insert into directory 
+    ELSE add entry to directory if possible
+  FI .
+
+search free entry :
+  access (thesaurus, nil name) .
+
+insert into directory :
+  change (list, cache pos + 1, cache pos, insert name) ;
+  index := cache index .
+
+add entry to directory if possible :
+  INT CONST next free index := code (list SUB LENGTH list) ;
+  IF next free index <= thesaurus size
+    THEN add entry to directory
+    ELSE directory overflow
+  FI .
+
+add entry to directory :
+  list CAT begin entry char ;
+  cache pos := LENGTH list ;
+  cache index := next free index ;
+  list CAT insert name ;
+  list CAT end entry char + code (next free index + 1) ;
+  index := cache index .
+
+directory overflow :
+  index := nil .
+
+entry found :   cache index > 0 .
+
+list :          CONCR (thesaurus) .
+
+ENDPROC insert ; 
+ 
+PROC decode invalid chars (TEXT VAR name, INT CONST start pos) :
+
+  INT VAR invalid char pos := pos (name, ""0"", ""31"", start pos) ;
+  WHILE invalid char pos > 0 REP
+    change (name, invalid char pos, invalid char pos, decoded char) ;
+    invalid char pos := pos (name, ""0"", ""31"", invalid char pos)
+  PER .
+
+decoded char :  quote + text(code(name SUB invalid char pos)) + quote.
+
+ENDPROC decode invalid chars ;
+
+PROC insert (THESAURUS VAR thesaurus, TEXT CONST name) :
+
+  INT VAR index ;
+  insert (thesaurus, name, index) ;
+  IF index = nil AND NOT is error
+    THEN errorstop ("THESAURUS-Ueberlauf")
+  FI .
+
+ENDPROC insert ;
+
+PROC delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : 
+ 
+  access (thesaurus, name) ;
+  index := cache index ;
+  delete (thesaurus, index) .
+
+ENDPROC delete ;
+
+PROC delete (THESAURUS VAR thesaurus, INT CONST index) :
+
+  access (thesaurus, index) ;
+  IF entry found
+    THEN delete entry
+  FI .
+
+delete entry :
+  IF is last entry of thesaurus
+    THEN cut off as much as possible
+    ELSE set to nil entry
+  FI .
+
+set to nil entry :
+  change (list, cache pos, cache pos + LENGTH entry - 1, nil entry) . 
+
+cut off as much as possible :
+  WHILE predecessor is also nil entry REP
+    set cache to this entry
+  PER ;
+  list := subtext (list, 1, cache pos - 1) ;
+  erase cache .
+
+predecessor is also nil entry :
+  subtext (list, cache pos - 3, cache pos - 2) = nil entry .
+
+set cache to this entry :
+  cache pos DECR 3 .
+
+erase cache :
+  cache pos := 0 ;
+  cache index := 0 .
+
+is last entry of thesaurus :
+  pos (list, end entry char, cache pos) = LENGTH list - 1 .
+
+list :     CONCR (thesaurus) .
+
+entry found :   cache index > nil .
+
+ENDPROC delete ;
+
+ 
+BOOL OP CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name ) : 
+ 
+  IF   name = niltext OR LENGTH name > max name length
+    THEN FALSE
+    ELSE access (thesaurus, name) ; entry found
+  FI . 
+ 
+entry found :   cache index > nil . 
+ 
+ENDOP CONTAINS ; 
+ 
+PROC rename (THESAURUS VAR thesaurus, TEXT CONST old, new) :
+ 
+  rename (thesaurus, link (thesaurus, old), new)
+
+ENDPROC rename ;
+
+PROC rename (THESAURUS VAR thesaurus, INT CONST index, TEXT CONST new) :
+
+  insert name := new ;
+  decode invalid chars (insert name, 1) ;
+  IF insert name = "" OR LENGTH insert name > max name length 
+    THEN errorstop ("Name unzulaessig")
+    ELSE change to new name
+  FI .
+ 
+change to new name :
+  access (thesaurus, index) ;
+  IF cache index <> 0 AND entry <> ""
+    THEN change (list, cache pos + 1, cache pos + LENGTH entry - 2, insert name)
+  FI .
+
+list :    CONCR (thesaurus) .
+
+ENDPROC rename ;
+ 
+INT PROC link (THESAURUS CONST thesaurus, TEXT CONST name) : 
+ 
+  access (thesaurus, name) ;
+  cache index .
+
+ENDPROC link ; 
+ 
+TEXT PROC name (THESAURUS CONST thesaurus, INT CONST index) : 
+ 
+  access (thesaurus, index) ;
+  subtext (entry, 2, LENGTH entry - 1) .
+
+ENDPROC name ;
+
+PROC get (THESAURUS CONST thesaurus, TEXT VAR name, INT VAR index) :
+
+  identify index ;
+  REP
+    to next entry
+  UNTIL end of list COR valid entry found PER .
+
+identify index :
+  IF index = 0
+    THEN cache index := 0 ;
+         cache pos   := 1
+    ELSE access (thesaurus, index)
+  FI .
+
+to next entry :
+  cache pos := pos (list, begin entry char, cache pos + 1) ;
+  IF cache pos > 0
+    THEN get entry
+    ELSE get nil entry
+  FI .
+
+get entry :
+  cache index INCR 1 ;
+  index := cache index ;
+  name := subtext (list, cache pos + 1, end entry pos - 1) .
+
+get nil entry :
+  cache index := 0 ;
+  cache pos := 0 ;
+  index := 0 ;
+  name := "" .
+
+end entry pos :     pos (list, end entry char, cache pos) .
+
+end of list :       index = 0 .
+
+valid entry found : name <> "" .
+
+list :              CONCR (thesaurus) .
+
+ENDPROC get ;
+
+INT PROC highest entry (THESAURUS CONST thesaurus) :              (*840813*)
+
+  code (list SUB LENGTH list) - 1 .
+
+list :   CONCR (thesaurus) .
+
+ENDPROC highest entry ;
+
+ENDPACKET thesaurus handling ;
+
diff --git a/system/base/unknown/src/SPOLMAN5.ELA b/system/base/unknown/src/SPOLMAN5.ELA
new file mode 100644
index 0000000..99d4ec2
--- /dev/null
+++ b/system/base/unknown/src/SPOLMAN5.ELA
@@ -0,0 +1,1003 @@
+PACKET queue handler DEFINES enter into que,

+                             exists in que,

+                             all in que,

+                             erase from que, 

+                             erase last top of que,

+                             get top of que, 

+                             restore ,

+                             list que, 

+                             info, killer,first, 

+                             que status, 

+                             que empty,

+                             set entry types,

+                             change entry types,

+                             initialize que:

+ 

+ 

+LET que size    = 100, 

+ 

+    empty       =   0, 

+    used        =   1,

+    blocked     =   2, 

+    nil         =   0,

+    user  error =  99,

+    unused char =   ""0"", 

+    used char   =   ""1"", 

+    blocked char=   ""2"", 

+    ENTRY       = STRUCT(TEXT title, TASK origin, TEXT origin name, 

+                         DATASPACE space, INT storage,    acc code ) ; 

+ 

+ROW que size ENTRY VAR que ; 

+ 

+TEXT VAR status list; 

+BOOL VAR n ok := FALSE; 

+INT  VAR top of que,

+         first que entry, 

+         last que entry,

+         index ;

+ 

+.entry: que[index]. ;

+ 

+PROC initialize que : 

+  FOR index FROM 1 UPTO que size REP 

+    forget( entry.space ); 

+    entry.acc code := empty

+  END REP ; 

+  first que entry := nil;

+  last que entry  := nil; 

+  top of que      := nil;

+  index           := nil; 

+  status list     := que size * unused char; 

+END PROC initialize que ; 

+ 

+initialize que ; 

+

+(****************** Interne Queue-Zugriffsoperationen **********************)

+ 

+INT PROC next (INT CONST pre) : 

+  pre MOD que size + 1 

+END PROC next ; 

+ 

+PROC block (INT CONST entry number) : 

+  que [entry number].acc code := blocked; 

+  replace (status list,entry number,blocked char); 

+ENDPROC block; 

+ 

+PROC unblock (INT CONST entry number) : 

+  que [entry number].acc code := used; 

+  replace (status list,entry number,used char); 

+ENDPROC unblock; 

+ 

+PROC to next que entry: 

+  REP 

+    IF index = last que entry OR index = nil

+      THEN index := nil ; LEAVE to next que entry 

+    FI ;

+    index := next(index)

+  UNTIL entry.acc code <> empty PER 

+END PROC to next que entry ; 

+ 

+PROC to first que entry : 

+  index := first que entry 

+END PROC to first que entry ; 

+ 

+PROC search que entry (TEXT CONST title, TASK CONST origin) : 

+ 

+  check if index identifies entry ;

+  IF last que entry = nil 

+    THEN index := nil 

+    ELSE index := last que entry ; 

+         REPEAT 

+           IF is wanted entry 

+             THEN LEAVE search que entry 

+           FI ; 

+           IF index = first que entry 

+             THEN index := nil 

+             ELSE index DECR 1 ; 

+                  IF index = 0 

+                    THEN index := que size 

+                  FI 

+           FI 

+         UNTIL index = nil PER 

+  FI. 

+ 

+is wanted entry: 

+ 

+  entry.acc code <> empty CAND 

+  entry.title    =  title CAND 

+ (entry.origin   =  origin OR 

+  origin = niltask ).

+ 

+check if index identifies entry: 

+ 

+  IF index <> nil CAND is wanted entry 

+    THEN LEAVE search que entry 

+  FI 

+ 

+END PROC search que entry ; 

+ 

+PROC exec erase :

+ 

+    forget (entry.space) ; entry.acc code := empty ; 

+    replace (status list,index,unused char); 

+    try to cut off queue ends. 

+ 

+try to cut off queue ends: 

+ 

+  WHILE first entry is not valid REP 

+    check if que empty ; 

+    first que entry := next(first que entry) 

+  END REP ; 

+  WHILE last entry is not valid REP 

+    make index invalid if necessary ; 

+    last que entry DECR 1 ; 

+    IF last que entry = 0 

+      THEN last que entry := que size 

+    FI 

+  END REP . 

+ 

+first entry is not valid: 

+     que [first que entry].acc code = empty. 

+ 

+last entry is not valid: 

+     que [last que entry].acc code = empty. 

+ 

+check if que empty: 

+     IF first que entry = last que entry 

+       THEN first que entry := nil ;

+            last que entry  := nil ; 

+            index := nil ; 

+            LEAVE try to cut off queue ends

+     FI.

+

+make index invalid if necessary: 

+     IF index = last que entry 

+       THEN index := nil 

+     FI. 

+ 

+END PROC exec erase ;

+ 

+PROC exec first: 

+  IF next (last que entry) = first que entry 

+    THEN errorstop ("Queue ist voll - vorziehen unmoeglich") 

+  ELIF index = top of que 

+    THEN errorstop ("Auftrag wird bereits bearbeitet") 

+  ELIF entry.acc code = empty 

+    THEN errorstop ("undefinierter Queue-Eintrag. /exec first") 

+    ELSE first que entry DECR 1 ; 

+         IF first que entry = 0 

+           THEN first que entry := que size 

+         FI ; 

+         que[first que entry] := que[index] ; 

+         replace (status list,first que entry,code (entry.acc code)); 

+         exec erase 

+  FI 

+END PROC exec first ; 

+ 

+PROC erase last top of que: 

+  IF top of que <> nil 

+    THEN index := top of que; exec erase;

+         top of que := nil 

+  FI 

+END PROC erase last top of que;

+ 

+ 

+(******************  Behandlung von DATASPACE-typen  ***********************)

+ 

+LET semicolon = ";" , 

+    colon     = ":" , 

+    quote     = """"; 

+TEXT VAR entry types ::   ""   ; 

+ 

+BOOL PROC no permitted type (DATASPACE CONST ds) : 

+  TEXT CONST type nr :: semicolon + text(type(ds)) + colon; 

+  INT  CONST t pos   :: pos (entry types,type nr) ; 

+  entry types <> "" CAND t pos = 0 

+END PROC no permitted type ; 

+ 

+TEXT PROC record of que entry: 

+  IF entry.acc code = empty 

+    THEN errorstop ("undefinierter Queue-Eintrag. /record");"" 

+    ELSE TEXT VAR record :: "" ; 

+         record CAT storage in k ; 

+         record CAT type of entry ; 

+         record CAT name of entry ; 

+         record CAT origin of entry ; 

+         IF entry.acc code = blocked THEN record CAT "- blocked -" FI;

+         record

+  FI. 

+ 

+storage in k: 

+ 

+  text (entry.storage,3) + " K  ". 

+ 

+type of entry: 

+ 

+  IF entry types = "" 

+    THEN 12 * "?" 

+    ELSE TEXT CONST type nr :: semicolon + text(type(entry.space)) + colon ; 

+         INT CONST semi colon pos :: pos (entry types, type nr), 

+                   start type     :: semi colon pos + LENGTH type nr , 

+                   end type       :: pos(entrytypes,semicolon,starttype)-1; 

+         IF semi colon pos = 0 

+           THEN 12 * "?" 

+           ELSE text( subtext(entry types, starttype, endtype),12)

+         FI 

+  FI. 

+ 

+name of entry: 

+ 

+  text (quote+ entry.title +quote, 20) .

+ 

+origin of entry: 

+ 

+  IF entry.origin = niltask 

+    THEN 20 * " "

+    ELSE text (" TASK: "+entry.origin name,20) 

+  FI 

+ 

+END PROC record of que entry ;

+ 

+PROC set entry types (TEXT CONST t) : 

+  check if void ;

+  IF first char is no semicolon

+    THEN entry types := semicolon

+    ELSE entry types := "" 

+  FI;

+  entry types CAT t ; 

+  IF last char is no semicolon

+    THEN entry types CAT semicolon 

+  FI.

+

+check if void: 

+  IF t = "" 

+    THEN entry types := ""; 

+         LEAVE set entry types 

+  FI. 

+ 

+first char is no semicolon: 

+  (t SUB 1) <> semicolon. 

+ 

+last char is no semicolon: 

+  (t SUB length(t)) <> semicolon 

+ 

+END PROC set entry types ; 

+ 

+PROC change entry types: 

+  TEXT VAR t :: entry types;

+  line;putline("Entrytypes :");

+  editget(t); 

+  set entry types (t) 

+END PROC change entry types; 

+ 

+ 

+(************************ Std Zugriffe auf Queue ***************************)

+ 

+ 

+PROC erase from que (TEXT CONST title, TASK CONST origin) : 

+  search que entry (title, origin) ; 

+  IF index = nil 

+    THEN errorstop ("Auftrag existiert nicht. /erase")

+  ELIF index = top of que 

+    THEN errorstop (user error, "Dieser Auftrag wird bereits bearbeitet") 

+    ELSE exec erase 

+  FI 

+END PROC erase from que ; 

+ 

+BOOL PROC exists in que (TEXT CONST title, TASK CONST origin) : 

+  search que entry (title, origin) ; 

+  index <> nil 

+END PROC exists in que ; 

+ 

+PROC info (BOOL CONST b) : n ok := b ENDPROC info; 

+ 

+THESAURUS PROC all in que (TASK CONST origin) : 

+ 

+  THESAURUS VAR result := empty thesaurus ; 

+  to first que entry ; 

+  WHILE index <> 0 REP 

+    IF entry.origin = origin OR origin = niltask 

+      THEN insert (result, entry.title)

+    FI ; 

+    to next que entry

+  END REP ; 

+  result 

+ 

+END PROC all in que ; 

+ 

+PROC enter into que (TEXT CONST title, TASK CONST origin, 

+                     DATASPACE CONST space ):

+ 

+  IF next(last que entry) = first que entry 

+    THEN errorstop ("Queue zu voll")

+  ELIF no permitted type (space)  OR title = ""

+    THEN errorstop (user error, "Auftrag wird nicht angenommen")

+    ELSE last que entry := next(last que entry); 

+         index := last que entry;

+         entry := ENTRY: 

+            ( title, origin,task name, space, storage(space), used ) ; 

+         IF first que entry = nil 

+           THEN first que entry := 1 

+         FI ; 

+         replace (status list,last que entry,used char); 

+  FI. 

+ 

+task name : 

+  TEXT VAR name of task :: name (origin); 

+  IF name of task = "stemmer" AND n ok THEN "stemmi" ELSE name of task FI. 

+ 

+END PROC enter into que ; 

+ 

+PROC get top of que (DATASPACE VAR top space) : 

+  forget (top space) ;

+  IF que empty 

+    THEN errorstop ("kein Auftrag vorhanden. /get") 

+    ELSE erase last top of que; 

+         top of que := first que entry; 

+         IF que [top of que].acc code = blocked THEN 

+            wrap around if necessary

+         ELSE top space := que [first que entry].space ; FI; 

+  FI . 

+ 

+wrap around if necessary : 

+ 

+  IF entry is allowed to be printed THEN 

+     give it to spool manager 

+  ELSE enter into end of queue FI. 

+ 

+entry is allowed to be printed : 

+  pos (status list,used char) = nil. 

+ 

+give it to spool manager : 

+  top space := que [first que entry].space; 

+  que [first que entry].acc code := used. 

+ 

+enter into end of queue : 

+  top space := que [first que entry].space; 

+  enter into que (que [first que entry].title,que [first que entry].origin 

+                  ,top space); 

+  index := first que entry; 

+  IF entry.acc code = blocked THEN block (index) FI; 

+  get top of que (top space). 

+ 

+END PROC get top of que ; 

+ 

+PROC restore:

+  top of que := nil 

+END PROC restore ; 

+ 

+BOOL PROC que empty:                         (* 'top of que' gilt nicht *)

+  first que entry = last que entry AND 

+  top of que      = last que entry. 

+END PROC que empty ; 

+ 

+PROC que status (INT VAR size, TEXT VAR top title, 

+                 TASK VAR top origin, TEXT VAR top origin name ): 

+ 

+  size := last que entry - first que entry ;  (* geloeschte Eintraege *)

+  IF size < 0                                 (* zaehlen mit !!       *)

+    THEN size INCR que size                   (* (aber nicht 'top' )  *)

+  FI ; 

+  IF top of que <> nil 

+    THEN top title       := que [top of que].title ; 

+         top origin      := que [top of que].origin ; 

+         top origin name := que [top of que].origin name

+    ELSE size INCR 1 ; 

+         top title       := "" ; 

+         top origin      := niltask ;

+         top origin name := "" 

+  FI 

+END PROC que status ;

+

+TEXT VAR sep :: 79 * "_", record :: "", 

+         ask :: "editieren (e),kopieren (k),loeschen (l)," + 

+                "vorziehen (v),duplizieren (d),"13""10"" + 

+                "print --> quickprint (q),blockieren (b),freigeben (f)," + 

+                "weiter (w) ? "; 

+ 

+PROC info : 

+ 

+     to first que entry; 

+     WHILE index <> nil REP 

+       record := record of que entry; 

+       WHILE index <> top of que REPEAT 

+         ask user what to do; 

+         out (input char); 

+         exec command

+       UNTIL command index = 1 PER; 

+       to next que entry; 

+     PER. 

+ 

+ask user what to do : 

+ 

+     out (""13""10"");out (sep);out (""13""10""13""10""); 

+     out (record); 

+     out (""13""10""10"");out (ask); 

+     INT VAR command index; TEXT VAR input char; 

+     REPEAT 

+       inchar (input char); 

+       command index := pos ("w eklvdqbf",input char); 

+     UNTIL command index > 0 PER. 

+ 

+exec command : 

+ 

+     SELECT command index OF 

+      CASE 3 : INT VAR old dataspace type := type (entry.space); 

+               type (entry.space,1003); 

+               FILE VAR f :: sequentialfile (modify,entry.space); 

+               edit (f); line (2); 

+               type (entry.space,old dataspace type) 

+      CASE 4 : forget (entry.title,quiet); 

+               copy (entry.space,entry.title); 

+               type (old (entry.title),1003) 

+      CASE 5 : exec erase ;command index := 1 

+      CASE 6 : exec first ;command index := 1

+      CASE 7 : INT VAR dummy no := index; 

+               enter into que (que [dummy no].title,que [dummy no].origin, 

+                               que [dummy no].space) 

+      CASE 8 : type (entry.space,1103) ;record := record of que entry; 

+      CASE 9 : block (index) ;record := record of que entry;

+      CASE 10: unblock (index); record := record of que entry; 

+     ENDSELECT. 

+ 

+ENDPROC info; 

+ 

+PROC list que (FILE VAR f, DATASPACE VAR ds) : 

+  open listfile ;

+  to first que entry ; 

+  WHILE index <> nil REP 

+    TEXT VAR record :: record of que entry ; 

+    IF index = top of que 

+      THEN record := text(record,60) ; 

+           record CAT ""15"wird bearbeitet"14""

+    FI ;

+    putline (f,record) ;

+    to next que entry

+  END REP.

+ 

+open listfile:

+ 

+  forget (ds) ; 

+  ds := nilspace ; 

+  f := sequentialfile (output,ds) ; 

+  headline (f, name(myself) + " - Queue") ; 

+  line (f)

+

+END PROC list que ; 

+ 

+PROC killer : info ENDPROC killer; 

+PROC first  : info ENDPROC first; 

+ 

+END PACKET queue handler ; 

+ 

+(***************************************************************************)

+(*   Programm zur Verwaltung einer Servertask                              *)

+(*        (benutzt 'queue handler')                                        *)

+(*        Autor: A.Vox                                                     *)

+(*        Stand: 3.6.85                                                    *)

+(*                                                                         *)

+(***************************************************************************)

+PACKET spool manager DEFINES server status, 

+                             server modus, 

+                             server task, 

+                             server channel, 

+                             server routine, 

+                             server fail msg, 

+ 

+                             log edit, 

+                             logline, 

+                             logfilename,

+                             check, 

+                             feed server if hungry, 

+                             check if server vanished, 

+ 

+                             spool manager, 

+                             get title and origin, 

+

+                             start, 

+                             stop, 

+                             pause, 

+                             spool info, 

+                             list, 

+                             spool maintenance: 

+ 

+ 

+     LET user error = 99;

+ 

+     LET { Status: }       { Modus: }

+         init = 0,         active  = 0,

+         work = 1,         paused  = 1, 

+         wait = 2,         stopped = 2,

+         dead = 3;

+ 

+     LET cmd form feed             = ""12""; 

+ 

+INT VAR status :: init,

+        modus  :: stopped;

+ 

+TASK VAR server  :: niltask; 

+TEXT VAR routine :: "", 

+         fail msg:: ""; 

+INT VAR channel  :: 0;

+(************ Globale Variablen fuer alle 'que status'-Aufrufe ************) 

+ 

+INT  VAR que size; 

+TEXT VAR actual title, 

+         actual origin name; 

+TASK VAR actual origin; 

+ 

+ 

+(*********** Zugriffsoperationen auf wichtige Paketvariablen **************)

+ 

+TASK PROC  servertask    : server       END PROC servertask; 

+INT  PROC  serverstatus  : status       END PROC serverstatus; 

+INT  PROC  servermodus   : modus        END PROC servermodus; 

+TEXT PROC  serverroutine : routine      END PROC serverroutine; 

+TEXT PROC  serverfailmsg : fail msg     END PROC serverfailmsg;

+INT  PROC  serverchannel : channel      END PROC serverchannel; 

+ 

+PROC serverroutine (TEXT CONST neu): 

+  routine := neu 

+END PROC serverroutine; 

+ 

+PROC serverfailmsg (TEXT CONST neu): 

+  failmsg := neu 

+END PROC serverfailmsg; 

+ 

+PROC serverchannel (INT CONST neu): 

+  channel := neu 

+END PROC serverchannel; 

+ 

+(************************* Basic Spool Routines ***************************) 

+ 

+TEXT CONST logfilename :: "Vorkommnisse"; 

+FILE VAR logfile; 

+ 

+TEXT VAR fail title  :: "" ;

+TASK VAR fail origin :: niltask ; 

+REAL VAR fail time   :: 0.0 ; 

+ 

+PROC logline (TEXT CONST mess): 

+  logfile := sequential file(output, logfilename) ; 

+  clear file if too large ; 

+  put(logfile, date);

+  put(logfile, time of day); 

+  put(logfile, " : ");

+  putline(logfile, mess) 

+END PROC logline ; 

+ 

+PROC log edit: 

+  enable stop ; 

+  IF NOT exists(logfilename) 

+    THEN errorstop ("keine Eintragungen vorhanden") 

+    ELSE logfile := sequentialfile(modify,logfilename) ; 

+         position to actual page; 

+         edit(logfile);

+         line (2); 

+         forget (logfilename); 

+  FI. 

+ 

+position to actual page: 

+ 

+  INT CONST begin of last page :: lines(logfile)-22 ; 

+  logfile := sequential file(modify,logfilename); 

+  IF begin of last page < 1 

+    THEN toline(logfile,1) 

+    ELSE toline(logfile,begin of last page) 

+  FI

+ 

+END PROC logedit; 

+ 

+PROC clear file if too large: 

+  IF lines(logfile) > 1000 

+    THEN modify (logfile) ; 

+         toline (logfile, 900) ; 

+         remove (logfile, 900) ; 

+         clear removed (logfile) ;

+         output (logfile) 

+  FI 

+END PROC clear file if too large ; 

+ 

+PROC end server (TEXT CONST mess): 

+  access catalogue; 

+  IF exists (server) CAND son(myself) = server 

+    THEN end(server) 

+  FI; 

+  failtime := clock(1); 

+  que status (que size, fail title, fail origin, actual origin name) ; 

+  logline (mess) ; 

+  IF fail title <> "" 

+    THEN logline(""""+fail title+""" von Task: "+actual origin name) 

+    ELSE logline("kein Auftrag betroffen") 

+  FI ; 

+  status := dead ; 

+  server := niltask 

+END PROC end server; 

+ 

+PROC check (TEXT CONST title, TASK CONST origin): 

+  check if server vanished ; 

+  IF less than 3 days ago AND 

+     was failure          AND 

+     title matches        AND 

+     origin matches 

+    THEN fail origin := myself ; 

+         errorstop (user error, """"+fail title+""" abgebrochen")

+  FI. 

+ 

+less than 3 days ago: 

+  clock(1) < fail time + 3.0 * day. 

+ 

+origin matches: 

+  (origin = fail origin OR origin = niltask). 

+ 

+title matches: 

+  (title  = fail title  OR title  = ""). 

+ 

+was failure: 

+  fail title <> ""

+ 

+END PROC check ; 

+ 

+PROC start server: 

+  begin (PROC server start,server) ; 

+  status := init 

+END PROC start server; 

+ 

+PROC server start: 

+  disable stop ; 

+  IF channel <> 0 

+    THEN continue (channel) ; 

+  FI ;

+  command dialogue (FALSE) ; 

+  out (cmd form feed); 

+  do (routine) ; 

+  IF is error 

+    THEN call(logline code, "Server-Fehler :",father); 

+         call(logline code, error message, father) ; 

+         call(logline code, "Zeile: " + text(errorline) +

+                            " Code: " + text(errorcode)  ,father) 

+    ELSE call(logline code, "Ende des Server-Programms erreicht",father) 

+  FI ; 

+  IF online 

+    THEN out (fail msg) 

+  FI ; 

+  call (terminate code,fail msg, father) ;

+  end (myself) 

+END PROC server start ;

+ 

+PROC check if server vanished: 

+  IF NOT (server = nil task) CAND NOT exists (server) 

+    THEN end server ("Server gestorben :") ; 

+         start server 

+  FI 

+END PROC check if server vanished; 

+ 

+ 

+(*************************** Manager Routines *****************************)

+ 

+   LET ack              = 0,

+       second phase ack = 5,

+       not existing nak = 6,

+ 

+       begin code       = 4, 

+       fetch code       = 11, 

+       save code        = 12,

+       exists code      = 13, 

+       erase code       = 14, 

+       list code        = 15, 

+       all code         = 17, 

+       clear code       = 18, 

+       release code     = 20, 

+       check code       = 22, 

+ 

+       terminate code   = 25, 

+       logline code     = 26, 

+       get title code   = 27, 

+ 

+       continue code    = 100; 

+ 

+ 

+DATASPACE VAR packet space ; 

+INT VAR reply ; 

+BOUND STRUCT(TEXT f name,a,b) VAR msg ; 

+.f name: msg.f name. ; 

+ 

+TEXT VAR save title :: "";

+FILE VAR listfile; 

+ 

+PROC get title and origin (TEXT VAR title, origin): 

+  forget (packet space) ; 

+  packet space := nilspace ; 

+  call (father, get title code, packet space, reply) ;

+  IF reply = ack 

+    THEN msg := packet space ; 

+         title := msg.f name ; 

+         origin := msg.a ; 

+         forget (packet space)

+    ELSE forget (packet space) ; 

+         errorstop ("'get title' nicht erfolgreich. Antwort="+text(reply)) 

+  FI 

+END PROC get title and origin; 

+ 

+PROC feed server if hungry:

+  check if server vanished ; 

+  IF status = wait AND NOT que empty 

+    THEN get top of que (packet space) ; 

+         send (server, ack, packet space, reply) ; 

+         forget (packet space) ;

+         IF reply = ack 

+           THEN status := work 

+           ELSE restore ; 

+                end server ("Server nimmt keinen Auftrag an") ; 

+                start server 

+         FI 

+  FI 

+ENDPROC feed server if hungry;

+ 

+PROC server request (DATASPACE VAR ds, INT CONST order, phase) : 

+ 

+  enable stop ; 

+  msg := ds ; 

+  SELECT order OF 

+    CASE terminate code: terminate 

+    CASE logline code:   logline (f name)   ;send(server, ack, ds)

+    CASE get title code: send title 

+    OTHERWISE 

+      IF order = fetch code CAND f name = "-" 

+        THEN send top of que 

+        ELSE freemanager (ds,order,phase,server) 

+      FI 

+  END SELECT ; 

+  forget(ds). 

+ 

+terminate: 

+  end server ("Server terminiert :") ; 

+  start server.

+ 

+send title: 

+  forget (ds) ; 

+  ds := nilspace ; 

+  msg := ds ; 

+  que status (que size, msg.f name, actual origin, msg.a) ; 

+  send (server, ack, ds).

+ 

+send top of que: 

+  status := wait ; 

+  erase last top of que ;

+  IF modus = active 

+    THEN feed server if hungry

+  FI 

+ 

+END PROC server request; 

+ 

+PROC spool manager(DATASPACE VAR ds, INT CONST order, phase, 

+                   TASK CONST order task) : 

+ 

+  IF ordertask < myself 

+    THEN server request (ds,order,phase) 

+  ELIF ordertask = supervisor

+    THEN system request 

+  ELSE spool command (ds,order,phase,order task) 

+  FI; 

+  check storage; 

+  error protocol. 

+ 

+check storage: 

+  INT VAR size, used; 

+  storage(size,used); 

+  IF used > size 

+    THEN logline("Speicher-Engpass :"); 

+         initialize que; 

+         logline("Queue geloescht !!"); 

+         stop 

+  FI. 

+ 

+error protocol: 

+  IF is error AND error code <> user error 

+    THEN logline ("Spool-Fehler :") ; 

+         logline (errormessage) ; 

+         logline ("   Zeile: " + text(errorline) + 

+                  "   Code: "  + text(errorcode) ) 

+  FI. 

+ 

+system request: 

+  IF order > continue code 

+    THEN call (supervisor,order,ds,reply) ; 

+         forget(ds) ; 

+         IF reply = ack 

+           THEN spool maintenance 

+         FI 

+  FI 

+ 

+END PROC spool manager; 

+ 

+PROC spool command (DATASPACE VAR ds, INT CONST order, phase, 

+                    TASK CONST order task): 

+ 

+  enable stop ; 

+  check if server vanished ;

+  msg := ds ; 

+  SELECT order OF 

+    CASE begin code : special begin 

+    CASE fetch code:  y get logfile 

+    CASE save code :  y save 

+    CASE exists code: y exists 

+    CASE erase code:  y erase 

+    CASE list code:   y list 

+    CASE all code:    y all 

+    CASE release code, 

+         clear code:  y restart 

+    CASE check code:  y check 

+    OTHERWISE errorstop (user error, "Kein Kommando fuer SPOOLER") 

+  END SELECT. 

+ 

+special begin : 

+   INT VAR dummy; 

+   call (public,begin code,ds,dummy); 

+   send (order task,ack,ds). 

+ 

+y get logfile: 

+  forget(ds) ; 

+  ds := old(logfilename) ; 

+  send (ordertask, ack, ds). 

+ 

+y erase: 

+  IF NOT exists in que (f name,ordertask) 

+    THEN manager message(""""+f name+""" steht nicht in der Queue")

+  ELIF phase = 1 

+    THEN manager question (""""+f name+""" aus der Queue loeschen") 

+    ELSE erase from que (f name,ordertask) ; 

+         send (ordertask, ack, ds) 

+  FI. 

+ 

+y save: 

+  IF phase = 1 

+    THEN save title := f name ; 

+         send (order task,second phase ack,ds); 

+    ELSE enter into que (save title, ordertask, ds) ; 

+         IF modus = active 

+           THEN feed server if hungry

+         FI ; 

+         send (order task,ack,ds); 

+  FI. 

+ 

+y list: 

+  list que (listfile,ds) ; 

+  send (ordertask, ack, ds). 

+ 

+y all: 

+  forget(ds) ; 

+  ds := nilspace ; 

+  BOUND THESAURUS VAR all names := ds ; 

+  all names := all in que (ordertask) ; 

+  send (ordertask, ack, ds). 

+ 

+y exists: 

+  IF exists in que (f name,ordertask) 

+    THEN send (ordertask, ack, ds) 

+    ELSE send (ordertask, not existing nak, ds) 

+  FI. 

+ 

+y check: 

+  check (f name,ordertask) ; 

+  questatus (que size, actual title, actual origin, actual origin name) ; 

+  IF there is a title   AND

+     is actual origin   AND 

+     is actual title 

+    THEN manager message (""""+f name+""" wird soeben bearbeitet") 

+  ELIF exists in que (f name,ordertask) 

+    THEN manager message (""""+f name+""" steht noch in der Queue") 

+    ELSE errorstop (usererror, """"+f name+""" steht nicht in der Queue") 

+  FI. 

+ 

+  there is a title:  actual title <> "" .

+  is actual origin:  ordertask = actual origin .

+  is actual title : (f name = "" OR f name = actual title) . 

+ 

+y restart: 

+  questatus (que size, actual title, actual origin, actual origin name) ;

+  IF actual origin = ordertask 

+    THEN IF phase = 1 

+           THEN manager question (""""+actual title+""" unterbrechen") 

+           ELSE end server ("unterbrochen durch Auftraggeber :") ; 

+                start server ; 

+                IF order = clear code 

+                  THEN restore 

+                  ELSE erase last top of que

+                FI ; 

+                manager message ("Auftrag unterbrochen") 

+         FI

+    ELSE errorstop (usererror, "kein eigener Auftrag") 

+  FI

+

+END PROC spool command ; 

+ 

+PROC start: 

+  IF modus = stopped 

+    THEN start server ; 

+         modus := active; 

+         message ("Server aktiviert") 

+  ELIF modus = paused 

+    THEN modus := active ; 

+         message ("'Pause'-Modus zurueckgesetzt") ; 

+         feed server if hungry

+    ELSE message ("Server bereits aktiv") 

+  FI 

+END PROC start; 

+ 

+PROC stop: 

+  IF modus <> stopped 

+    THEN end server ("Gestoppt :"); 

+         modus := stopped ;

+         status := init ; 

+         message ("Server gestoppt") 

+    ELSE message ("Server bereits gestoppt") 

+  FI 

+END PROC stop; 

+ 

+PROC pause: 

+  IF modus = active 

+    THEN modus := paused ; 

+         message ("'Pause'-Modus gesetzt")

+  ELIF modus = paused 

+    THEN message ("'Pause'-Modus bereits gesetzt")

+    ELSE errorstop ("Server ist gestoppt") 

+  FI 

+END PROC pause; 

+ 

+PROC message (TEXT CONST mess): 

+  say(""13""10"") ; 

+  say(mess) ; 

+  say(""13""10"") 

+END PROC message ; 

+ 

+PROC list: 

+  list que(listfile,packet space) ; 

+  show(listfile) 

+END PROC list; 

+ 

+PROC spool maintenance: 

+  command dialogue (TRUE);

+  IF exists(logfilename) 

+    THEN logedit 

+  FI; 

+  WHILE online REP

+    get command ("gib spool kommando :") ;

+    do command 

+  END REP ; 

+  command dialogue (FALSE) ; 

+  break ; 

+  set autonom 

+END PROC spool maintenance ;

+ 

+PROC spoolinfo: 

+  check if server vanished ;

+  que status (que size, actual title, actual origin, actual origin name) ; 

+  line(2) ; 

+  putline("Queue :") ; 

+  put("Auslastung :");put(que size); line;

+  IF actual title <> "" 

+    THEN put("Aktueller Auftrag :");putline(actual title); 

+         put("         von Task :");putline(actual origin name) 

+  FI ; 

+  line ; 

+  putline("Server :"); 

+  put("Status :"); 

+  SELECT status OF 

+    CASE init : putline("initialisiert") 

+    CASE work : putline("arbeitet") 

+    CASE wait : putline("wartet")

+    OTHERWISE   putline("gestorben")

+  END SELECT ;

+  put("Modus  :"); 

+  SELECT modus OF 

+    CASE active : putline("aktiv") 

+    CASE paused : putline("pausierend") 

+    OTHERWISE     putline("gestoppt") 

+  END SELECT ; 

+  put("Kanal  :");put(pcb(server,4));

+  line(2) 

+END PROC spool info 

+ 

+END PACKET spool manager; 

+ 

diff --git a/system/base/unknown/src/STD.ELA b/system/base/unknown/src/STD.ELA
new file mode 100644
index 0000000..047db9a
--- /dev/null
+++ b/system/base/unknown/src/STD.ELA
@@ -0,0 +1,220 @@
+PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)

+                                               (* Stand:  26.04.82 *)

+       command dialogue ,

+       say ,

+       yes ,

+       no ,

+       param position ,

+       last param :

+ 

+ 

+LET up      = ""3"" ,

+    right   = ""2"" ,

+    param pre  = " (""" ,

+    param post = """)"13""10"" ;

+

+TEXT VAR std param := "" ;

+ 

+BOOL VAR dialogue flag := TRUE ;

+

+INT VAR param x := 0 ;

+ 

+ 

+BOOL PROC command dialogue :

+  dialogue flag

+ENDPROC command dialogue ;

+ 

+PROC command dialogue (BOOL CONST status) :

+  dialogue flag := status

+ENDPROC command dialogue ;

+ 

+ 

+BOOL PROC yes (TEXT CONST question) :

+ 

+  IF dialogue flag

+    THEN ask question

+    ELSE TRUE

+  FI .

+ 

+ask question :

+  put (question) ;

+  skip previous input chars ;

+  put ("(j/n) ?") ;

+  get answer ;

+  IF correct answer

+    THEN putline (answer) ;

+         positive answer

+    ELSE out (""7"") ;

+         LENGTH question + 9 TIMESOUT ""8"" ;

+         yes (question)

+  FI .

+ 

+get answer :

+  TEXT VAR answer ;

+  inchar (answer) .

+ 

+correct answer :

+  pos ("jnyJNY", answer) > 0 .

+ 

+positive answer :

+  pos ("jyJY", answer) > 0 .

+

+skip previous input chars :

+  REP UNTIL incharety = "" PER .

+ 

+ENDPROC yes ;

+ 

+BOOL PROC no (TEXT CONST question) :

+ 

+  NOT yes (question)

+ 

+ENDPROC no ;

+ 

+PROC say (TEXT CONST message) :

+ 

+  IF dialogue flag

+    THEN out (message)

+  FI

+ 

+ENDPROC say ;

+ 

+PROC param position (INT CONST x) :

+ 

+  param x := x

+

+ENDPROC param position ;

+

+TEXT PROC last param :

+ 

+  IF param x > 0

+    THEN out (up) ;

+         param x TIMESOUT right ;

+         out (param pre) ;

+         out (std param) ;

+         out (param post)

+  FI ;

+  std param

+ 

+ENDPROC last param ;

+ 

+PROC last param (TEXT CONST new) :

+  std param := new

+ENDPROC last param ;

+

+ENDPACKET command dialogue ;

+

+

+PACKET input DEFINES                         (* Stand: 01.05.81 *)

+ 

+    get ,

+    getline , 

+    get secret line :

+ 

+ 

+LET cr              = ""13"" ,

+    esc             = ""27"" ,

+    rubout          = ""12"" ,

+    bell            = ""7"" ,

+    back blank back = ""8" "8"" ,

+    del line cr lf  = ""5""13""10"" ;

+

+PROC get (TEXT VAR word) : 

+ 

+  REP

+    get (word, " ")

+  UNTIL word <> "" AND word <> " " PER ;

+  delete leading blanks .

+ 

+delete leading blanks :

+  WHILE (word SUB 1) = " " REP

+    word := subtext (word,2)

+  PER .

+ 

+ENDPROC get ;

+ 

+PROC get (TEXT VAR word, TEXT CONST separator) : 

+ 

+  word := "" ;

+  feldseparator (separator) ;

+  editget (word) ;

+  feldseparator ("") ;

+  echoe last char

+ 

+ENDPROC get ;

+ 

+PROC echoe last char :

+ 

+  TEXT CONST last char := feldzeichen ;

+  IF last char = ""13""

+    THEN out (""13""10"")

+    ELSE out (last char)

+  FI

+ 

+ENDPROC echoe last char ;

+ 

+PROC get (TEXT VAR word, INT CONST length) :

+ 

+  word := "" ;

+  feldseparator ("") ;

+  editget (word, length, length) ;

+  echoe last char 

+ 

+ENDPROC get ;

+ 

+PROC getline (TEXT VAR line ) : 

+ 

+  line := "" ;

+  feldseparator ("") ;

+  editget (line) ;

+  echoe last char

+ 

+ENDPROC getline ;

+ 

+PROC get secret line (TEXT VAR line) :

+

+  TEXT VAR char ;

+  line := "" ;

+  get start cursor position ;

+  get line very secret ;

+  IF char = esc

+    THEN get line little secret

+  FI ;

+  cursor to start position ;

+  out (del line cr lf) .

+

+get line very secret :

+  REP

+    inchar (char) ;

+    IF char = esc OR char = cr

+      THEN LEAVE get line very secret

+    ELIF char = rubout

+      THEN delete last char

+    ELIF char >= " "

+      THEN line CAT char ;

+           out (".")

+    ELSE   out (bell)

+    FI

+  PER .

+

+delete last char :

+  IF LENGTH line = 0

+    THEN out (bell)

+    ELSE out (back blank back) ;

+         delete char (line, LENGTH line)

+  FI .

+

+get line little secret :

+  feldseparator ("") ;

+  cursor to start position ;

+  editget (line) .

+

+get start cursor position :

+  INT VAR x, y; 

+  get cursor (x, y) .

+

+cursor to start position :

+  cursor (x, y) .

+

+ENDPROC get secret line ;

+

+ENDPACKET input ;

diff --git a/system/base/unknown/src/STDPLOT.ELA b/system/base/unknown/src/STDPLOT.ELA
new file mode 100644
index 0000000..be55e33
--- /dev/null
+++ b/system/base/unknown/src/STDPLOT.ELA
@@ -0,0 +1,365 @@
+PACKET std plot DEFINES                         (* J. Liedtke 06.02.81 *)

+                                                (* H.Indenbirken, 19.08.82 *)

+  transform,

+  set values,

+

+  clear ,

+  begin plot ,

+  end plot ,

+  dir move,

+  dir draw ,

+  pen,

+  pen info :

+ 

+LET pen down    = "*"8"" ,

+    y raster = 43,

+    display hor  = 78.0,

+    display vert = 43.0;

+ 

+INT CONST up         :=  1 ,

+          right      :=  1 ,

+          down       := -1 ,

+          left       := -1 ;

+ 

+REAL VAR h min limit :: 0.0, h max limit :: display hor,

+         v min limit :: 0.0, v max limit :: display vert,

+         h :: display hor/2.0, v :: display vert/2.0,

+         size hor :: 23.5, size vert :: 15.5;

+

+ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :

+                          (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

+ROW 5 ROW 5 REAL VAR result;

+INT VAR i, j;

+

+ROW 5 ROW 5 REAL OP * (ROW 5 ROW 5 REAL CONST l, r) :

+  ROW 5 ROW 5 REAL VAR erg;

+  FOR i FROM 1 UPTO 5

+  REP FOR j FROM 1 UPTO 5

+      REP erg [i] [j] := zeile i mal spalte j

+      PER

+  PER;

+  erg  .

+

+zeile i mal spalte j :

+  INT VAR k;

+  REAL VAR summe :: 0.0;

+  FOR k FROM 1 UPTO 5

+  REP summe INCR zeile i * spalte j PER;

+  summe  .

+

+zeile i :  l [i] [k]  .

+

+spalte j : r [k] [j]  .

+

+END OP *;

+ 

+PROC set values (ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 3 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) :

+  norm p;

+  set views;

+  calc two dim extrema;

+  calc limits;

+  calc result values  .

+

+norm p :

+  p := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (1.0/dx,    0.0,    0.0, 0.0, 0.0),

+  ROW 5 REAL : (   0.0, 1.0/dy,    0.0, 0.0, 0.0),

+  ROW 5 REAL : (   0.0,    0.0, 1.0/dz, 0.0, 0.0),

+  ROW 5 REAL : (   0.0,    0.0,    0.0, 1.0, 0.0),

+  ROW 5 REAL : (size [1][1]/dx,  size [2][1]/dy,

+                size [3][1]/dz, 0.0, 1.0))  .

+

+dx : size [1][2] - size [1][1]  .

+dy : size [2][2] - size [2][1]  .

+dz : size [3][2] - size [3][1]  .

+

+set views :

+  REAL VAR sin a := sind (angles [1]),  cos a := cosd (angles [1]),

+           sin p := sind (angles [2]),  cos p := cosd (angles [2]),

+           sin t := sind (angles [3]),  cos t := cosd (angles [3]),

+           norm a :: oblique [1] * p [1][1],

+           norm b :: oblique [2] * p [2][2],

+           norm cx :: perspective [1] * p [1][1],

+           norm cy :: perspective [2] * p [2][2],

+           norm cz :: perspective [3] * p [3][3];

+

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (cos p*cos t, -sin p, cos p*sin t, 0.0, 0.0),

+  ROW 5 REAL : (sin p*cos t,  cos p, sin p*sin t, 0.0, 0.0),

+  ROW 5 REAL : (     -sin t,    0.0,       cos t, 0.0, 0.0),

+  ROW 5 REAL : (        0.0,    0.0,         0.0, 1.0, 0.0),

+  ROW 5 REAL : (        0.0,    0.0,         0.0, 0.0, 1.0));

+  p := p*result;

+

+ 

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (     1.0,      0.0, 0.0,     0.0, 0.0),

+  ROW 5 REAL : (     0.0,      1.0, 0.0,     0.0, 0.0),

+  ROW 5 REAL : (  norm a,   norm b, 0.0, norm cz, 0.0),

+  ROW 5 REAL : (-norm cx, -norm cy, 0.0,     1.0, 0.0),

+  ROW 5 REAL : (     0.0,      0.0, 0.0,     0.0, 1.0));

+  p := p * result;

+

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (cos a,-sin a, 0.0, 0.0, 0.0),

+  ROW 5 REAL : (sin a, cos a, 0.0, 0.0, 0.0), 

+  ROW 5 REAL : (  0.0,   0.0, 1.0, 0.0, 0.0),

+  ROW 5 REAL : (  0.0,   0.0, 0.0, 1.0, 0.0),

+  ROW 5 REAL : (  0.0,   0.0, 0.0, 0.0, 1.0));

+  p := p * result  .

+

+calc two dim extrema :

+  REAL VAR max x :: - max real, min x :: max real,

+           max y :: - max real, min y :: max real, x, y;

+

+  transform (size [1][1], size [2][1], size [3][1], x, y);

+  extrema;

+  transform (size [1][2], size [2][1], size [3][1], x, y);

+  extrema;

+  transform (size [1][2], size [2][2], size [3][1], x, y);

+  extrema;

+  transform (size [1][1], size [2][2], size [3][1], x, y);

+  extrema;

+  transform (size [1][1], size [2][1], size [3][2], x, y);

+  extrema;

+  transform (size [1][2], size [2][1], size [3][2], x, y);

+  extrema;

+  transform (size [1][2], size [2][2], size [3][2], x, y);

+  extrema;

+  transform (size [1][1], size [2][2], size [3][2], x, y);

+  extrema  .

+

+extrema :

+  min x := min (min x, x);

+  max x := max (max x, x);

+ 

+  min y := min (min y, y);

+  max y := max (max y, y) .

+ 

+calc limits :

+  IF all limits smaller than 2

+  THEN prozente

+  ELSE zentimeter FI  .

+

+all limits smaller than 2 :

+  limits [1][2] < 2.0 AND limits [2][2] < 2.0  .

+

+prozente :

+  h min limit := limits [1][1] * display hor * (size vert/size hor);

+  h max limit := limits [1][2] * display hor * (size vert/size hor);

+ 

+  v min limit := limits [2][1] * display vert;

+  v max limit := limits [2][2] * display vert  .

+ 

+zentimeter : 

+  h min limit := display hor * (limits [1][1]/size hor);

+  h max limit := display hor * (limits [1][2]/size hor);

+ 

+  v min limit := display vert * (limits [2][1]/size vert);

+  v max limit := display vert * (limits [2][2]/size vert)  .

+

+calc result values :

+  REAL VAR sh := (h max limit - h min limit) / (max x - min x),

+           sv := (v max limit - v min limit) / (max y - min y),

+           dh := h min limit - min x*sh,

+           dv := v min limit - min y*sv;

+

+  result := ROW 5 ROW 5 REAL :

+           (ROW 5 REAL : ( sh, 0.0, 0.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0,  sv, 0.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),

+            ROW 5 REAL : ( dh,  dv, 0.0, 0.0, 1.0));

+  p := p * result  .

+ 

+END PROC set values;

+ 

+PROC transform (REAL CONST x, y, z, REAL VAR h, v) :

+  REAL CONST w :: 1.0/(x*p [1][4] + y*p [2][4] + z*p [3][4] + p [4][4]);

+

+  h := (x*p [1][1]+y*p [2][1]+z*p [3][1]+p [4][1])*w + p [5][1];

+  v := (x*p [1][2]+y*p [2][2]+z*p [3][2]+p [4][2])*w + p [5][2];

+END PROC transform;

+

+(**************************  Eigentliches plot *************************)

+INT VAR x pos := 0 ,

+        y pos := 0 ,

+        new x pos ,

+        new y pos ;

+ 

+ROW 24 TEXT VAR display;

+clear ;

+ 

+PROC clear :

+

+  INT VAR i;

+  display (1) := 79 * " " ;

+  FOR i FROM 2 UPTO 24

+  REP display [i] := display [1]

+  PER;

+  out (""6""2""0""4"")

+ 

+END PROC clear ;

+ 

+PROC begin plot :

+

+  cursor (x pos + 1,  24 - (y pos) DIV 2 )

+ 

+ENDPROC begin plot ;

+ 

+PROC end plot :

+ 

+ENDPROC end plot ;

+ 

+PROC dir move (REAL CONST x, y, z) :

+  transform (x, y, z, h, v);

+  move (round (h), round (v))

+

+END PROC dir move;

+

+PROC move (INT CONST x val, y val) :

+ 

+  x pos := x val;

+  y pos := y val

+

+ENDPROC move ;

+ 

+PROC dir draw (REAL CONST x, y, z) :

+  transform (x, y, z, h, v);

+  draw (round (h), round (v))

+

+END PROC dir draw;

+

+PROC draw (INT CONST x val, y val) :

+

+  new x pos := x val;

+  new y pos := y val;

+

+  plot vector (new x pos - x pos, new y pos - y pos) ;

+ 

+END PROC draw ;

+ 

+PROC dir draw (TEXT CONST text, REAL CONST angle, height) :

+  out (""6"");

+  out (code (23 - (y pos DIV 2)));

+  out (code (x pos));

+

+  out (text)

+ 

+END PROC dir draw;

+ 

+INT VAR act no :: 1, act thickness :: 1, act line type :: 1;

+

+PROC pen (INT CONST no, thickness, line type) :

+  act no := no;

+  act thickness := thickness;

+  act line type := line type

+ 

+ENDPROC pen ;

+

+PROC pen info (INT VAR no, thickness, line type) :

+  no := act no;

+  thickness := act thickness;

+  line type := act line type

+

+END PROC pen info;

+ 

+PROC plot vector (INT CONST dx , dy) :

+ 

+  IF dx >= 0

+    THEN IF   dy >  dx THEN vector (y pos, x pos, dy, dx, up, right)

+         ELIF dy >   0 THEN vector (x pos, y pos, dx, dy, right, up)

+ 

+         ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down)

+         ELSE               vector (y pos, x pos, -dy, dx, down, right)

+         FI

+    ELSE IF   dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left)

+         ELIF dy >   0 THEN vector (x pos, y pos, -dx, dy, left, up)

+ 

+         ELIF dy >  dx THEN vector (x pos, y pos, -dx, -dy, left, down)

+         ELSE               vector (y pos, x pos, -dy, -dx, down, left)

+         FI

+  FI .

+ 

+ENDPROC plot vector ;

+ 

+PROC vector (INT VAR x pos, y pos; INT CONST dx, dy, right, up) :

+

+  prepare first step ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO dx REP

+    do one step

+  PER .

+ 

+prepare first step :

+  point;

+  INT VAR old error := 0 ,

+          up right error := dy - dx ,

+          right error    := dy .

+ 

+do one step :

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error) .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+ENDPROC vector ;

+ 

+ 

+PROC point :

+  INT CONST line :: y pos DIV 2;

+  BOOL CONST above :: (y pos MOD 2) = 1;

+  TEXT CONST point :: display [line+1] SUB (x pos+1),

+             new point :: calculated point;

+ 

+  replace (display [line+1], x pos+1, new point);

+  out (""6"") ;

+  out (code (23-line)) ;

+  out (code (x pos)) ;

+  out (new point) .

+ 

+calculated point :

+  IF above

+  THEN IF point = "," OR point = "|"

+       THEN "|"

+       ELSE "'" FI

+  ELSE IF point = "'" OR point = "|"

+       THEN "|"

+       ELSE "," FI

+  FI

+ 

+END PROC point;

+ 

+REAL CONST real max int := real (max int);

+INT PROC round (REAL CONST x) :

+  IF x > real max int

+  THEN max int

+  ELIF x < 0.0

+  THEN 0

+  ELSE int (x + 0.5) FI

+

+END PROC round;

+

+ENDPACKET std plot ;

diff --git a/system/base/unknown/src/bildeditor b/system/base/unknown/src/bildeditor
new file mode 100644
index 0000000..c84a300
--- /dev/null
+++ b/system/base/unknown/src/bildeditor
@@ -0,0 +1,722 @@
+ 

+PACKET  b i l d e d i t o r  DEFINES              (* Autor: P.Heyderhoff   *)

+        (*****************)                       (* Stand: 06.02.82       *)

+                                                  (* Vers.: 1.6.0          *)

+        bildeditor,                               (* test des bildeditors, *)

+        schreiberlaubnis,

+        zeile unveraendert,

+        feldanfangsmarke,

+        bildmarksatz,

+        bildeinfuegen,

+        bildneu,

+        bildzeile,

+        bildmarke,

+        bildstelle,

+        bildlaenge,

+        bildmaxlaenge,

+        bildsatz,

+        bildrand :

+ 

+ 

+LET anker = 2, freianker = 1, satzmax = 4075,

+    DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index,

+                                fortsetzung, TEXT inhalt);

+ 

+INT VAR stelle   :: anker, marke  :: 0, satz   :: 1, zeile :: 1,

+        zeilen :: 0, maxlaenge :: 23, laenge :: maxlaenge, rand :: 0,

+        marksatz :: 0, alte feldstelle :: 1, alte feldmarke :: 0;

+ 

+TEXT VAR kommando :: "", teil :: "", zeichen :: "";

+ 

+BOOL VAR neu :: TRUE, zeileneu :: TRUE, ueberschriftneu :: FALSE,

+         einfuegen :: FALSE, schreiben erlaubt :: TRUE; 

+ 

+LET hop mark rubout up down cr          = ""1""16""12""3""10""13"",

+    hop cr mark down up right rubin     = ""1""13""16""10""3""2""11"",

+    hop rubin rubout down up cr tab esc = ""1""11""12""10""3""13""9""27"",

+    blank = " ", hop = ""1"", clear eop = ""4"", clear eol = ""5"",

+    left = ""8"", right = ""2"", up = ""3"", down = ""10"", bell = ""7"",

+    tab = ""9"", cr = ""13"", escape = ""27"", begin mark = ""15"",

+    end mark = ""14"", hoechstes steuerzeichen = ""31"", escape q = ""27"q",

+    rubin = ""11"", mark = ""16"", down clear eol = ""10""5"";

+ 

+(******************  z u g r i f f s p r o z e d u r e n  ******************)

+ 

+BOOL PROC schreiberlaubnis :

+  schreiben erlaubt

+END PROC schreiberlaubnis;

+ 

+PROC schreiberlaubnis (BOOL CONST b) :

+  schreiben erlaubt := b

+END PROC schreiberlaubnis;

+ 

+BOOL PROC bildneu :

+  neu

+END PROC bildneu;

+ 

+PROC bildneu (BOOL CONST b) :

+  neu := b

+END PROC bildneu;

+ 

+PROC bildeinfuegen (BOOL CONST b):

+  einfuegen := b

+END PROC bildeinfuegen;

+ 

+INT PROC bildmarke :

+  marke

+END PROC bildmarke;

+ 

+PROC bildmarke (INT CONST i) :

+  marke := i

+END PROC bildmarke;

+ 

+INT PROC feldanfangsmarke :

+  alte feldmarke

+END PROC feldanfangsmarke;

+ 

+PROC feldanfangsmarke (INT CONST i) :

+  alte feldmarke := i

+END PROC feldanfangsmarke;

+ 

+INT PROC bildstelle :

+  stelle

+END PROC bildstelle;

+ 

+PROC bildstelle (INT CONST i) :

+  stelle := i

+END PROC bildstelle;

+ 

+INT PROC bildmarksatz :

+  marksatz

+END PROC bildmarksatz;

+ 

+PROC bildmarksatz (INT CONST i) :

+  marksatz := i

+END PROC bildmarksatz;

+ 

+INT PROC bildsatz :

+  satz

+END PROC bildsatz;

+ 

+PROC bildsatz (INT CONST i) :

+  satz := i

+END PROC bildsatz;

+ 

+INT PROC bildzeile :

+  zeile

+END PROC bildzeile;

+ 

+PROC bildzeile (INT CONST i) :

+  zeile := min (i, laenge)

+END PROC bildzeile;

+ 

+INT PROC bildlaenge :

+  laenge

+END PROC bildlaenge;

+ 

+PROC bildlaenge (INT CONST i) :

+  laenge := i

+END PROC bildlaenge;

+ 

+PROC bildmaxlaenge (INT CONST i) : 

+  maxlaenge := i 

+END PROC bildmaxlaenge; 

+ 

+INT PROC bildrand :

+  rand

+END PROC bildrand;

+ 

+PROC bildrand (INT CONST i) :

+  rand := i

+END PROC bildrand;

+ 

+INT PROC max (INT CONST a, b) :

+  IF a > b THEN a ELSE b FI

+END PROC max;

+ 

+PROC zeile unveraendert :

+  zeileneu := FALSE

+END PROC zeile unveraendert;

+ 

+ 

+(**************************  b i l d e d i t o r  **************************)

+ 

+PROC bildeditor (DATEI VAR datei) :

+ 

+     INTERNAL 293 ; 

+ 

+  INT  VAR j;

+ 

+  kommando := feldkommando;

+  IF   neu

+  THEN bild ausgeben (datei) 

+  ELIF zeileneu

+  THEN satz ausgeben (datei); ueberschriftneu := TRUE 

+  ELSE feldposition; zeileneu := TRUE

+  FI;

+  REPEAT

+    IF   neu             THEN bild ausgeben (datei) 

+    ELIF ueberschriftneu THEN ueberschrift  (datei) 

+    FI ;

+    IF   stelle = anker

+         THEN IF   schreiben erlaubt

+              THEN satz erzeugen (datei, stelle); (* gestrichen z:=z *)

+                   satz ausgeben (datei)

+              ELSE feldkommando (escape q); out(bell); LEAVE bildeditor 

+              FI

+    FI ;

+    feldbearbeitung; 

+    IF   zeichen <> escape THEN kommandoausfuehrung FI

+  UNTIL  zeichen =  escape

+  END REPEAT; 

+  feldkommando (kommando) .

+ 

+feldbearbeitung :

+  feldkommando (kommando); 

+  IF   schreiben erlaubt

+  THEN feldeditor (inhalt); kommando := feldkommando

+  ELSE teil := inhalt; feldeditor (teil);

+       IF   teil <> inhalt

+       THEN kommando := escape q; kommando CAT teil

+       ELSE kommando := feldkommando

+       FI

+  FI;

+  zeichen := kommando SUB 1;

+  feldnachbehandlung .

+ 

+ 

+feldnachbehandlung :

+  IF   inhalt = ""

+  THEN IF   schreiben erlaubt

+       THEN IF   zeichen > hoechstes steuerzeichen

+            THEN inhalt   := subtext (kommando, 1, feldlimit);

+                 kommando := subtext (kommando, feldlimit+1);

+                 feldout (inhalt); zeichen := cr

+  FI   FI   FI . 

+ 

+kommandoausfuehrung :

+  delete char (kommando, 1);

+  IF   marke > 0

+  THEN bildmarkeditor (datei) 

+  ELSE 

+    SELECT pos (hop cr mark down up right rubin, zeichen) OF

+    CASE 1: 

+      zeichen := kommando SUB 1; delete char (kommando, 1);

+      SELECT pos (hop rubin rubout down up cr tab esc, zeichen) OF

+      CASE 1: oben links

+      CASE 2: IF   schreiben erlaubt

+              THEN zeilen einfuegen  ELSE out (bell) FI

+      CASE 3: IF   schreiben erlaubt

+              THEN zeile ausfuegen   ELSE out (bell) FI

+      CASE 4: weiterblaettern

+      CASE 5: zurueckblaettern

+      CASE 6: neue seite

+      CASE 7: ueberschriftneu := TRUE

+      CASE 8: lernmodus umschalten

+      OTHERWISE zeichen := ""; out (bell)

+      END SELECT

+    CASE 2: neue zeile

+    CASE 3: markieren beginnen

+    CASE 4: naechster satz

+    CASE 5: vorgaenger (datei)

+    CASE 6: feldposition (feldanfang); naechster satz

+    CASE 7: ueberschriftneu := TRUE;

+    OTHERWISE

+      IF   zeichen > hoechstes steuerzeichen

+      THEN IF schreiben erlaubt THEN ueberlauf FI

+      ELSE insert char (kommando, zeichen, 1);

+           insert char (kommando, escape,  1)

+      FI

+    END SELECT

+  FI . 

+ 

+oben links :

+  ueberschriftneu := TRUE;

+  WHILE zeile > 1 REP vorgaenger (datei) PER;

+  feldposition (feldanfang) .

+ 

+zeile ausfuegen : 

+  IF   feldstelle = 1

+  THEN satz loeschen (datei); 

+       IF   stelle = anker THEN vorgaenger (datei) FI

+  ELSE zeilen rekombinieren

+  FI .

+ 

+zeilen einfuegen :

+  ueberschriftneu := TRUE;

+  IF   einfuegen 

+  THEN einfuegen := FALSE;

+       IF inhalt = ""     THEN satz loeschen (datei) FI;

+       IF zeilen < laenge THEN bild ausgeben (datei) FI 

+  ELSE einfuegen := TRUE; 

+       IF   logischer satzanfang

+       THEN satz erzeugen (datei, stelle);

+            IF zeilen >= zeile THEN bildrest loeschen FI;

+            zeilen := zeile; satz ausgeben (datei)

+       ELSE IF   feldstelle <= LENGTH inhalt

+            THEN zeile auftrennen

+            FI;

+            IF   zeile < zeilen 

+            THEN nachfolger (datei); bildrest loeschen; 

+                 vorgaenger (datei); zeilen := zeile

+            FI ; feldposition

+       FI

+  FI .

+ 

+logischer satzanfang :

+  FOR j FROM feldanfang UPTO feldstelle - 1

+  REP IF   (inhalt SUB j) = "" 

+      THEN LEAVE logischer satzanfang WITH TRUE

+      ELIF (inhalt SUB j) <> " "

+      THEN LEAVE logischer satzanfang WITH FALSE

+      FI

+  END REP; TRUE . 

+ 

+zeilen rekombinieren :

+  IF   eof (datei) THEN

+  ELSE inhalt CAT (feldstelle-1-LENGTH inhalt) * " ";

+       inhalt CAT datei (datei (stelle).nachfolger).inhalt;

+       stelle := datei (stelle).nachfolger;

+       satz loeschen (datei, stelle); 

+       stelle := datei (stelle).vorgaenger;

+       bildausgeben (datei)

+  FI .

+ 

+zeile auftrennen :

+  marke  := stelle; (feldende-feldstelle+1) TIMESOUT " "; 

+  stelle := datei (stelle).nachfolger;

+  satz erzeugen (datei, stelle);

+  inhalt := subtext (datei (datei (stelle).vorgaenger).inhalt, feldstelle);

+  stelle := marke; marke := 0; 

+  inhalt := subtext (inhalt, 1, feldstelle-1) .

+ 

+weiterblaettern :

+  ueberschriftneu := TRUE;

+  IF   eof (datei)

+  THEN out (bell)

+  ELSE IF   zeile = laenge

+       THEN nachfolger (datei); zeile := 1; bild ausgeben (datei)

+       ELIF einfuegen

+       THEN IF zeile = zeilen THEN bild ausgeben (datei) FI

+       FI;

+       WHILE zeile < zeilen AND stelle <> anker 

+       REP nachfolger (datei) END REP;

+       IF   stelle = anker

+       THEN vorgaenger (datei) 

+  FI   FI .

+ 

+zurueckblaettern :

+  ueberschriftneu := TRUE;

+  IF   satz > 1

+  THEN IF   zeile = 1

+       THEN vorgaenger (datei); zeile := laenge

+       FI;

+       WHILE zeile > 1 AND satz > 1

+       REP vorgaenger (datei) PER;

+       zeile := 1

+  FI .

+ 

+ueberlauf :

+  insert char (kommando, zeichen, 1);

+  feldposition (feldanfang); feld einruecken (inhalt); nachfolger (datei);

+  satz erzeugen (datei, stelle); 

+  inhalt := ""0"" ;                    (* 12.01.81 *)

+  IF   zeile <= zeilen OR neu

+  THEN bild ausgeben (datei) ELSE satz ausgeben (datei)

+  FI ;

+  inhalt := "" .

+ 

+lernmodus umschalten :

+  feldlernmodus (NOT feldlernmodus);

+  ueberschriftneu := TRUE; 

+  IF   feldlernmodus 

+  THEN feldaudit (""); zeichen := ""

+  ELSE insert char (kommando, escape, 1);

+       insert char (kommando, hop, 1)

+  FI.

+ 

+neue seite :

+  feldstelle (feldanfang); zeile := 1; neu := TRUE . 

+ 

+neue zeile : 

+  BOOL VAR wirklich einfuegen := einfuegen;

+  IF   feldstelle > LENGTH inhalt OR feldstelle >= feldende

+  THEN feldposition (feldanfang); feld einruecken (inhalt); nachfolger(datei)

+  ELIF einfuegen AND logischer satzanfang

+  THEN feldposition (feldanfang); feldeinruecken (inhalt)

+  ELSE feldposition (feldanfang); nachfolger (datei);

+       wirklich einfuegen := FALSE

+  FI;

+  IF   stelle = anker THEN

+  ELIF wirklich einfuegen

+  THEN satz erzeugen (datei, stelle);

+       IF   zeile <= zeilen OR neu

+       THEN bild ausgeben (datei)

+       ELSE satz ausgeben (datei)

+       FI

+  ELIF neu THEN

+  ELSE IF   zeile > zeilen

+       THEN satz ausgeben (datei)

+       FI;

+       FOR j FROM feldanfang UPTO min (feldstelle, LENGTH inhalt)

+       REP  IF   (inhalt SUB j) <> blank

+            THEN feldposition (j); LEAVE neue zeile FI 

+       PER 

+  FI . 

+ 

+naechster satz :

+  nachfolger (datei);

+  IF   neu 

+  THEN IF   stelle = anker

+       THEN IF   datei (datei (stelle).vorgaenger).inhalt = ""

+            THEN stelle := datei (stelle).vorgaenger; satz DECR 1;

+                 neu := FALSE

+       FI   FI

+  ELIF zeile <= zeilen THEN

+  ELIF stelle = anker  THEN

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+markieren beginnen :

+  IF   feldstelle <= min (LENGTH inhalt, feldende)

+  THEN feldmarke (feldstelle); marke := stelle; 

+       marksatz := satz; satz ausgeben (datei);

+       alte feldmarke := feldmarke

+  ELSE out (bell)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildeditor;

+ 

+ 

+(********************  b i l d - m a r k e d i t o r  **********************)

+ 

+PROC bildmarkeditor (DATEI VAR datei) :

+  INT  VAR j, k;

+ 

+  IF   zeichen  = right OR zeichen = tab

+  THEN zeichen := down;

+       feldposition (feldanfang)

+  FI;

+  SELECT pos (hop mark rubout up down cr, zeichen) OF

+    CASE 1: zeichen := kommando SUB 1; delete char (kommando, 1);

+            IF   zeichen = up

+            THEN rueckblaetternd demarkieren

+            ELIF zeichen = down

+            THEN weiterblaetternd markieren

+            ELSE out (bell)

+            FI;

+            zeichen := ""

+    CASE 2: markieren beenden

+    CASE 3: IF schreiben erlaubt

+            THEN markiertes loeschen

+            ELSE out (bell)

+            FI

+    CASE 4: zeile demarkieren

+    CASE 5,6: zeile markieren

+    OTHERWISE insert char (kommando, zeichen, 1);

+              insert char (kommando, escape,  1)

+  END SELECT;

+  IF   marke > 0

+  THEN IF   stelle = marke

+       THEN feldmarke (alte feldmarke)

+       ELSE feldmarke (feldanfang)

+       FI

+  FI .

+ 

+markieren beenden :

+  feldmarke (0); alte feldmarke := 0; 

+  IF   marke = stelle

+  THEN satz ausgeben (datei); ueberschriftneu := TRUE; 

+       marke := 0;

+  ELSE marke := 0; neu := TRUE

+  FI .

+ 

+markiertes loeschen :

+  IF   stelle = marke

+  THEN satzausschnitt loeschen

+  ELSE letzten satz bis stelle loeschen;

+       ersten satz ab marke loeschen;

+       alle zwischensaetze loeschen;

+       IF   zeile <= 1 

+       THEN zeile := 1

+       FI;

+       feldstelle (feldanfang); feldmarke (0);

+       alte feldmarke := 0; marke := 0; neu := TRUE 

+  FI . 

+ 

+satzausschnitt loeschen :

+  inhalt := subtext (inhalt, 1, feldmarke-1) + subtext (inhalt, feldstelle);

+  feldstelle (feldmarke); feldmarke (0); marke := 0; 

+  IF   inhalt = ""

+  THEN satz loeschen (datei)

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+letzten satz bis stelle loeschen :

+  IF   feldstelle > LENGTH inhalt

+  THEN satz loeschen (datei, stelle)

+  ELIF feldstelle > feldanfang

+  THEN inhalt := subtext (inhalt, feldstelle)

+  FI .

+ 

+ersten satz ab marke loeschen :

+  INT CONST altstelle := stelle;

+  stelle := marke;

+  IF   alte feldmarke = 1

+  THEN satz loeschen (datei, stelle);

+       satz DECR 1; zeile DECR 1

+  ELSE IF   alte feldmarke <= LENGTH inhalt

+       THEN inhalt := text (inhalt, alte feldmarke-1)

+       FI;

+       stelle := datei (stelle).nachfolger

+  FI .

+ 

+alle zwischensaetze loeschen :

+  WHILE stelle <> altstelle

+  REP satzloeschen (datei, stelle);

+      satz DECR 1; zeile DECR 1

+  PER .

+ 

+zeile markieren : 

+  IF   zeichen = cr

+  THEN feldstelle (feldanfang)

+  FI;

+  IF   eof (datei) 

+  THEN feldstelle (feldende)

+  ELSE nachfolger (datei)

+  FI;

+  markierung justieren (datei);

+  satz ausgeben (datei) . 

+ 

+zeile demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE zeile demarkieren

+  FI;

+  feldmarke (0); satz ausgeben (datei);

+  vorgaenger (datei);

+  markierung justieren (datei);

+  satz ausgeben (datei) .

+ 

+weiterblaetternd markieren :

+  IF zeile >= laenge THEN zeile := 0 FI; out (hop); 

+  WHILE NOT eof (datei)

+  REP nachfolger (datei) UNTIL zeile = laenge PER;

+  IF   eof (datei)

+  THEN feldstelle (feldende); 

+  FI;

+  neu := TRUE .

+ 

+rueckblaetternd demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE rueckblaetternd demarkieren

+  FI;

+  FOR j FROM 1 UPTO laenge 

+  WHILE stelle <> marke

+  REP vorgaenger (datei) PER;

+  neu := TRUE .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildmarkeditor;

+ 

+PROC markierung justieren (DATEI CONST datei) :

+  IF   feldstelle > LENGTH inhalt

+  THEN feldstelle (min (feldende, LENGTH inhalt) + 1)

+  FI;

+  IF   stelle =  marke

+  THEN feldmarke (alte feldmarke);

+       IF   feldstelle < feldmarke

+       THEN feldstelle (feldmarke)

+       FI

+  ELSE feldmarke (feldanfang)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC markierung justieren;

+ 

+PROC vorgaenger (DATEI VAR datei) :

+  IF   eof (datei) 

+  THEN IF   inhalt = "" THEN satz loeschen (datei)

+  FI   FI ; 

+  stelle := datei (stelle).vorgaenger; satz DECR 1;

+  IF   stelle = anker

+  THEN out (bell); stelle := datei (anker).nachfolger;

+       satz := 1; zeile := 1

+  ELIF zeile > 1

+  THEN out (up); zeile DECR 1

+  ELSE neu := TRUE

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC vorgaenger;

+ 

+PROC nachfolger (DATEI CONST datei) :

+  stelle := datei (stelle).nachfolger; satz INCR 1; zeile INCR 1;

+  IF   zeile <= laenge 

+  THEN out (down) 

+  ELIF laenge <> maxlaenge 

+  THEN neu := TRUE ; zeile := laenge

+  FI 

+END PROC nachfolger;

+ 

+PROC  bild ausgeben (DATEI VAR datei) :

+ 

+  IF marke > 0 THEN markierung justieren (datei) FI;

+  alte feldstelle := feldstelle; feldstelle (feldende+1);

+  INT VAR altstelle :: stelle, altsatz  :: satz,

+          altzeile  :: zeile,  altmarke :: feldmarke;

+  ueberschrift (datei); 

+  IF   marke > 0 OR neu

+  THEN zurueck zur ersten zeile;

+       cursor (1, rand+2) FI; 

+  IF   (rand+laenge) = maxlaenge THEN out (clear eop) FI;

+  WHILE zeile <= laenge AND stelle <> anker

+  REP zeile schreiben PER; 

+  feldstelle (alte feldstelle);

+  feldmarke (altmarke);

+  zeilen := zeile - 1;

+  IF   zeile > laenge 

+  THEN zeile := laenge; feldposition

+  ELSE bildrest loeschen

+  FI;

+  (zeile - altzeile) TIMESOUT up;

+  zeile := altzeile; satz := altsatz; stelle := altstelle;

+  neu   := FALSE .

+ 

+zurueck zur ersten zeile :

+  IF   eof (datei) 

+  THEN WHILE inhalt = "" AND datei(stelle).vorgaenger <> anker

+       REP vorgaenger (datei) END REP;

+       altstelle := stelle; altsatz := satz; altzeile := zeile;

+  FI;

+  WHILE zeile > 1 AND datei (stelle).vorgaenger <> anker

+  REP IF   stelle = marke

+      THEN feldmarke (0)

+      FI;

+      vorgaenger (datei)

+  PER;

+  altzeile DECR (zeile-1); zeile := 1 .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+zeile schreiben :

+   IF stelle = marke     THEN feldmarke  (alte feldmarke)  FI;

+   IF stelle = altstelle THEN feldstelle (alte feldstelle) FI;

+   feldout (inhalt);

+   IF   stelle = altstelle

+   THEN feldmarke (0)

+   ELIF feldmarke > feldanfang

+   THEN feldmarke (feldanfang)

+   FI;

+   zeile INCR 1;

+   IF   zeile <= laenge

+   THEN stelle := datei (stelle).nachfolger;

+        satz INCR 1; out (down)

+   FI .

+ 

+END PROC bild ausgeben;

+ 

+PROC ueberschrift (DATEI CONST datei) : 

+  cursor (feldrand+1, rand+1); out(begin mark);

+  INT CONST punkte :: 

+  (feldende-feldanfang-13-length(datei(anker).inhalt)) DIV 2;

+  punkte TIMESOUT "."; out (" ", datei(anker).inhalt, " .");

+  cursor (feldrand+3, rand+1);

+  IF   feldeinfuegen

+  THEN out ("RUBIN"2""2"")

+  ELSE out (""2""2""2""2""2""2""2"") FI;

+  IF   einfuegen

+  THEN out ("INS")

+  ELSE out (""2""2""2"") FI;

+  IF   feldlernmodus THEN out ("..LEARN.") FI;

+  cursor (feldrand+feldende-feldanfang-9-punkte, rand+1);

+  punkte TIMESOUT ".";

+  out (" zeile     ", end mark, "  ");

+  cursor (feldrand+feldende-feldanfang-2, rand+1) ;

+  IF   satz <= zeile THEN out("1")

+  ELSE out (text (satz-zeile+1))  FI;

+  cursor (feldrand+2, rand+1);

+  feldtab (tabulator);

+  outsubtext (tabulator, feldanfang+1, min (feldende, LENGTH tabulator));

+  cursor (1, rand+zeile+1); feldposition;

+  ueberschriftneu := FALSE 

+ 

+END PROC ueberschrift;

+ 

+TEXT VAR tabulator;

+ 

+PROC satz ausgeben (DATEI VAR datei) : 

+  IF   zeile > laenge

+  THEN roll up

+  ELIF zeile > zeilen

+  THEN zeilen INCR 1

+  FI;

+  feldout (datei (stelle).inhalt); feldposition .

+roll up :

+  out (down); cursor (1, rand + zeile); zeile DECR 1 .

+END PROC satz ausgeben;

+ 

+PROC satz loeschen (DATEI VAR datei) :

+  satz loeschen (datei, stelle); zeilen DECR 1;

+  IF   zeile > zeilen

+  THEN bildrest loeschen;

+       IF stelle <> anker THEN satz ausgeben (datei) FI

+  ELSE bild ausgeben (datei)

+  FI

+END PROC satz loeschen;

+ 

+PROC bildrest loeschen :

+  out (cr); feldrand TIMESOUT right;

+  IF   (rand+laenge) = maxlaenge

+  THEN out (clear eop)

+  ELSE out (up);

+       (laenge-zeile+1) TIMESOUT (down clear eol);

+       (laenge-zeile)   TIMESOUT up

+  FI;

+  feldposition

+END PROC bildrest loeschen;

+ 

+BOOL PROC eof (DATEI CONST datei) :

+  datei (stelle).nachfolger = anker

+END PROC eof;

+ 

+(*************************** schrott *************************************)

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+(************************** testprogramm ***********************************)

+(*

+PROC test des bildeditors :

+ 

+  IF   NOT exists ("test")

+  THEN FILE VAR file 1 := sequential file (modify, "test"); close (file 1)

+  FI ;

+  DATASPACE VAR ds := old ("test");

+  BOUND DATEI VAR datei := ds ;

+  feldwortweise (NOT feldwortweise);

+  bildneu (TRUE); bildmarke (0); 

+  bildstelle (CONCR(datei) (anker).nachfolger); bildsatz (1);

+  feldmarke (0); feldseparator (""); feldstelle (1) ;

+  REP b i l d   e d i t o r  (CONCR (datei));

+      out (""7""); feldkommando ("") 

+  UNTIL (feldkommando SUB 1) = ""27""

+  PER;

+ 

+END PROC test des bildeditors;

+*)

+END PACKET bildeditor;

diff --git a/system/base/unknown/src/command handler b/system/base/unknown/src/command handler
new file mode 100644
index 0000000..3e06280
--- /dev/null
+++ b/system/base/unknown/src/command handler
@@ -0,0 +1,239 @@
+ 

+PACKET command handler DEFINES                (* Autor: J.Liedtke *)

+                                              (* Stand:  29.02.82 *)

+       command handler ,

+       do command ,

+       command error ,

+       set command :

+ 

+ 

+LET esc          = ""27"" ,

+    esc k        = ""27"k" ,

+    cr lf        = ""4""13""10"" ,

+    command pre  = ""4""13"      " ,

+    command post =    ""13""10"      " ,

+ 

+    tag type = 1 ,

+    texttype = 4 ,

+    eof type = 7 ;

+ 

+ 

+TEXT VAR command line := "" ,

+         previous command line := "" ,

+         symbol ,

+         procedure ,

+         pattern ,

+         error note := "" ;

+ 

+INT VAR  symbol type ,

+         allowed type := 0 ;

+ 

+ 

+PROC set command (TEXT CONST command, INT CONST type) :

+

+  param position (0) ;

+  command line := command ;

+  allowed type := type

+ 

+ENDPROC set command ;

+ 

+PROC do command :

+ 

+  do (command line)

+

+ENDPROC do command ;

+

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2,

+                       TEXT CONST command text ) :

+ 

+prepare and get command ;

+command handler (command list,command index,number of params,param1,param2).

+ 

+prepare and get command :

+  set line nr (0) ;

+  error protocoll ;

+  get command from console .

+ 

+error protocoll :

+  IF is error

+    THEN put error ;

+         clear error

+    ELSE command line := "" ;

+  FI .

+ 

+get command from console :

+  INT VAR x, y;

+  out (crlf) ;

+  get cursor (x, y) ;

+  cursor (x, y) ;

+  REP

+    out (command pre) ;

+    out (command text) ;

+    out (command post) ;

+    editget command

+  UNTIL command line <> "" PER ;

+  param position (LENGTH command line) ;

+  out (command post) .

+ 

+editget command :

+  feldaudit ("") ;

+  feldlernmodus (FALSE) ;

+  REP

+    feldtabulator ("") ;

+    feldseparator (esc) ;

+    editget (command line) ;

+    ignore halt errors during editget ;

+    IF feldzeichen = esc k

+      THEN command line := previous command line

+      ELSE previous command line := command line ;

+           LEAVE editget command

+    FI

+  PER .

+

+ignore halt errors during editget :

+  IF is error

+    THEN clear error

+  FI .

+

+ENDPROC command handler ;

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2) :

+ 

+  scan (command line) ;

+  next symbol ;

+  IF pos (command list, symbol) > 0

+    THEN procedure name ;

+         parameter list pack option ;

+         nothing else in command line ;

+         decode command

+    ELSE impossible command

+  FI .

+ 

+procedure name :

+  IF symbol type = tag type OR symbol = "?"

+    THEN procedure := symbol ;

+         next symbol

+    ELSE error ("incorrect procedure name")

+  FI .

+ 

+parameter list pack option :

+  number of params := 0 ;

+  param 1 := "" ;

+  param 2 := "" ;

+  IF symbol = "("

+    THEN next symbol ;

+         parameter list ;

+         IF symbol <> ")"

+           THEN error (") expected")

+         FI

+  ELIF symbol type <> eof type

+    THEN error ("( expected")

+  FI .

+ 

+parameter list :

+  parameter (param 1, number of params) ;

+  IF symbol = ","

+    THEN next symbol ;

+         parameter (param 2, number of params) ;

+  FI ;

+  IF symbol <> ")"

+    THEN error (") expected")

+  FI .

+ 

+nothing else in command line :

+  next symbol ;

+  IF symbol <> ""

+    THEN error ("command too complex")

+  FI .

+

+decode command :

+  command index := index (command list, procedure, number of params) .

+ 

+impossible command :

+  command index := 0 .

+ 

+ENDPROC command handler ;

+ 

+PROC parameter (TEXT VAR param, INT VAR number of params) :

+ 

+  IF symbol type = text type OR symbol type = allowed type

+    THEN param := symbol ;

+         number of params INCR 1 ;

+         next symbol

+    ELSE error ("parameter is no text denoter ("" missing!)")

+  FI

+ 

+ENDPROC parameter ;

+ 

+INT PROC index (TEXT CONST list, procedure, INT CONST params) :

+ 

+  pattern := procedure ;

+  pattern CAT ":" ;

+  INT CONST index pos := pos (list, pattern) ;

+  IF procedure name found

+    THEN get colon pos ;

+         get dot pos ;

+         get end pos ;

+         get command index ;

+         get param index ;

+         IF param index >= 0

+           THEN command index + param index

+           ELSE - command index

+         FI

+    ELSE 0

+  FI .

+ 

+procedure name found :

+  index pos > 0  AND  (list SUB index pos - 1) <= "9"  .

+ 

+get param index :

+  INT CONST param index :=

+            pos (list, text (params), dot pos, end pos) - dot pos - 1 .

+ 

+get command index :

+  INT CONST command index :=

+            int ( subtext (list, colon pos + 1, dot pos - 1) ) .

+ 

+get colon pos :

+  INT CONST colon pos := pos (list, ":", index pos) .

+ 

+get dot pos :

+  INT CONST dot pos := pos (list, ".", index pos) .

+ 

+get end pos :

+  INT CONST end pos := dot pos + 4 .

+ 

+ENDPROC index ;

+ 

+PROC error (TEXT CONST message) :

+ 

+  error note := message ;

+  scan ("") ;

+  procedure := "-"

+ 

+ENDPROC error ;

+ 

+PROC command error :

+

+  disable stop ;

+  IF error note <> ""

+    THEN errorstop (error note) ;

+         error note := ""

+  FI ;

+  enable stop

+

+ENDPROC command error ;

+

+

+PROC next symbol :

+ 

+  next symbol (symbol, symbol type)

+ 

+ENDPROC next symbol ;

+ 

+iNDPACKET command handler ;

diff --git a/system/base/unknown/src/dateieditorpaket b/system/base/unknown/src/dateieditorpaket
new file mode 100644
index 0000000..8aedb2d
--- /dev/null
+++ b/system/base/unknown/src/dateieditorpaket
@@ -0,0 +1,743 @@
+ 

+PACKET  d a t e i e d i t o r  paket  DEFINES     (* Autor: P.Heyderhoff *)

+        (*******************)                     (* Stand: 19.02.82     *)

+                                                  (* Vers.: 1.6.0        *)

+        define escape ,

+        dateieditor :

+ 

+LET satzmax = 4075, dateianker = 2, left = ""8"", escape = ""27"",

+    hop = ""1"", right = ""2"", hoechstes steuerzeichen = ""31"", 

+    clear = ""1""4"", hop and mark = ""1""15"", code f = "f",

+    clear line mark = ""5""14"", bell = ""7"", freianker = 1, down = ""10"",

+    begin mark = ""15"", end mark = ""14"", escape escape = ""27""27"",

+    clear eol and mark = ""5""15"";

+ 

+LET DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index,

+                                    fortsetzung, TEXT inhalt);

+FOR j FROM 1 UPTO 127 REP escapefkt (j) := "" PER;

+INT  VAR j, haltzeile :: satzmax, symboltyp, typ,

+         zahlwert, stelle, satz, marke, maxbildlaenge :: 23;

+FILE VAR sekundaerfile ;

+TEXT VAR zeichen :: "", ersatz   :: "", kommando :: "",

+         symbol  :: "", textwert :: "", lernsequenz::"";

+BOOL VAR war fehler, boolwert;

+LET op1namen = 

+";+;-;BEGIN;COL;GET;HALT;LIMIT;MARK;PUT;IF;NOT;REPEAT;WRITE;SIZE"; 

+LET b =  5, c = 11, g = 15, h = 19, l = 24, m = 30,

+    p = 35, i = 39, n = 42, r = 46, w = 53, s=59;

+LET op2namen = "&+&-&*&/&;&CHANGETO;&OR"; 

+LET plus = 1, minus = 3, mal = 5, durch = 7, semicolon = 9,

+    changecode = 11, or = 21;

+LET proznamen = ";col;row;halt;limit;mark;len;eof;";

+LET pcol =  1, prow  =  5, phalt =  9, plimit = 14, pmark = 20,

+    plen = 25, peof  = 29;

+LET void      =  0,    (* keine angabe des typs      *)

+    tag       =  1,    (* typ: lower case letter     *)

+    bold      =  2,    (* typ: upper case letter     *)

+    integer   =  3,    (* typ: digit                 *)

+    texttyp   =  4,    (* typ: quote                 *)

+    operator  =  5,    (* typ: operator +-*=<> ** := *)

+    delimiter =  6,    (* typ: delimiter ( ) , ; .   *)

+    eol       =  7,    (* typ: niltext, Zeilenende   *)

+    bool      =  8;    (* typ: boolean               *)

+LET varimax   = 10;

+INT VAR freivar :: 1;

+ROW varimax INT  VAR varzahlwert, vartyp;

+ROW varimax TEXT VAR vartextwert, varname;

+FOR j FROM 1 UPTO varimax

+REP vartextwert (j) := ""; varname (j) := "" PER;

+ 

+ROW 127 TEXT VAR escapefkt;

+ 

+ 

+(*************************  d a t e i e d i t o r  *************************)

+ 

+PROC dateieditor (DATEI VAR datei) :

+ 

+  INTERNAL 295 ;

+ 

+  REP   datei editieren

+  UNTIL (feldkommando SUB 1) <> escape

+  PER .

+ 

+datei editieren :

+  war fehler := FALSE ;

+  zeichen := feldkommando SUB 2;

+  IF   zeichen = "q" OR zeichen = "w"

+  THEN LEAVE dateieditor

+  ELIF zeichen = escape

+  THEN kommando ermitteln

+  ELSE tastenkommando ermitteln ;    (* Li 19.1.82 *)

+       abbruchtest;

+       feldkommando (subtext (feldkommando, 3))

+  FI;

+  a u s f u e h r e n .

+ 

+tastenkommando ermitteln :

+  IF zeichen > ""0"" AND zeichen < ""128""

+    THEN kommando := escapefkt (code (zeichen)) (* Li 06.01.82 *)

+    ELSE kommando := ""

+  FI .

+

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+kommando ermitteln :

+  IF   (feldkommando SUB 1) = hop

+  THEN lernsequenz auf taste legen;

+       feldkommando (subtext (feldkommando, 4));

+       LEAVE datei editieren

+  FI;

+  feldkommando (subtext (feldkommando, 3));

+  kommando := ""; dialog; analysieren .

+ 

+dialog:

+  REP   kommandodialog;

+        IF   (feldzeichen SUB 1) <> escape OR kommando <> "?"

+        THEN LEAVE dialog

+        ELIF (feldzeichen SUB 2) > ""0"" THEN   (* Li 19.02.82 *)

+        kommando := escapefkt (code (feldzeichen SUB 2) MOD 128 )

+        ELSE kommando := ""

+        FI

+  PER .

+ 

+lernsequenz auf taste legen :

+  lernsequenz := feldaudit;

+  lernsequenz := subtext (lernsequenz, 1, LENGTH lernsequenz - 3);

+  INT CONST lerncode := code (feldkommando SUB 3) MOD 128 ;

+  escapefkt (lerncode) := "W""" ;

+  escapefkt (lerncode) CAT lernsequenz ;          (* Li 5.1.81 *)

+  escapefkt (lerncode) CAT """" .

+ 

+kommandodialog :

+  INT CONST feldlaenge :: max (feldende-feldanfang-21, 6) ;

+  cursor (feldrand+1, bildrand+bildzeile+1);

+  out (begin mark, "gib editor kommando: "); 

+  feldlaenge TIMESOUT "."; out(end mark);

+  bildneu (TRUE);

+  cursor (feldrand+23, bildrand+bildzeile+1); feldseparator (escape);

+  editget (kommando, 255, feldlaenge); feldseparator ("") .

+ 

+analysieren :

+  IF   (feldzeichen SUB 1) = escape AND (feldzeichen SUB 2) > ""0"" (*02.82*)

+  THEN escapefkt (code (feldzeichen SUB 2) MOD 128) := kommando; (* Li 5.1.*)

+       LEAVE datei editieren

+  ELIF kommando = ""

+  THEN LEAVE datei editieren

+  ELIF (kommando SUB 1) = "?"

+  THEN kommandos erklaeren;

+       LEAVE datei editieren

+  ELIF pos ("quit", kommando) = 1

+  THEN feldkommando (escape escape);

+       LEAVE dateieditor

+  ELSE escapefkt (code (code f)) := kommando 

+  FI .

+ 

+ausfuehren : 

+  haltzeile := satzmax;

+  IF   kommando = ""

+  THEN zeile unveraendert

+  ELSE scan (kommando); nextsymbol;

+       IF   a u s d r u c k  (datei)

+       THEN IF symboltyp <> eol THEN fehler bearbeiten FI

+       FI;

+       IF war fehler THEN inchar (zeichen)  (* warten *)  FI

+   FI .

+ 

+kommandos erklaeren : 

+  out (clear); 

+  putline ("kommandos fuer den benutzer :"); line;

+  putline ("quit      : beendet das editieren");

+  putline ("  n       : positioniert auf zeile n");

+  putline ("+ n       : blaettert n zeilen vorwaerts");

+  putline ("- n       : blaettert n zeilen rueckwaerts");

+  putline (" ""z""      : sucht angegebene zeichenkette ");

+  putline ("""muster"" CHANGETO ""ersatz"" :");

+  putline ("            muster wird durch ersatz ersetzt"); 

+  putline ("HALT   n  : sieht anhalten des suchens in zeile n vor");

+  putline ("GET   ""d"" : kopiert datei d und markiert");

+  putline ("PUT   ""d"" : schreibt markierten abschnitt in datei d");

+  putline ("LIMIT  n  : setzt schreibende auf spalte n");

+  putline ("BEGIN  n  : setzt feldanfang auf spalte n");

+  putline ("SIZE   n  : setzt bildlaenge auf n"); line;

+  putline ("?ESCx     : zeigt kommando auf escapetaste x");

+  inchar (zeichen) .

+ 

+END PROC dateieditor; 

+ 

+PROC define escape (TEXT CONST cmd char, kommando) :

+  escapefkt (code (cmd char) MOD 128) := kommando

+END PROC define escape ;

+ 

+ 

+(********************  h i l f s - p r o z e d u r e n  ********************)

+ 

+PROC fehler bearbeiten :

+  IF NOT war fehler

+  THEN war fehler := TRUE; bildneu (TRUE);

+       out (""2""2""2"  kommandofehler bei ",symbol," erkannt.");

+       out (clear line mark)

+  FI

+END PROC fehler bearbeiten;

+ 

+BOOL PROC fehler : fehler bearbeiten; FALSE END PROC fehler;

+ 

+BOOL PROC klammerzu :

+  IF   symbol = ")"

+  THEN nextsymbol; TRUE

+  ELSE fehler

+  FI

+END PROC klammerzu;

+ 

+PROC nextsymbol :

+  nextsymbol (symbol, symboltyp);

+  IF symboltyp = eol THEN symbol := "kommandoende" FI

+END PROC nextsymbol;

+ 

+PROC eof (DATEI VAR datei) :

+  boolwert := (bildstelle = dateianker); typ := void

+END PROC eof;

+ 

+PROC nachsatz (DATEI CONST datei) :

+  stelle := datei (stelle).nachfolger;

+  satz INCR 1; protokoll

+END PROC nachsatz;

+ 

+PROC vorsatz  (DATEI CONST datei) :

+  stelle := datei (stelle).vorgaenger;

+  satz DECR 1; protokoll

+END PROC vorsatz;

+ 

+ 

+PROC protokoll :

+  cout (satz) ;

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+END PROC protokoll;

+ 

+ 

+(*******************  s p r i n g e n  und  s u c h e n  *******************)

+ 

+PROC row (DATEI VAR datei) : 

+  IF ziel voraus THEN vorwaerts springen ELSE rueckwaerts springen FI;

+  bildsatz (satz); bildstelle (stelle); typ := void; bildneu (TRUE) .

+ 

+ziel voraus :

+  satz := bildsatz; stelle := bildstelle;

+  IF   zahlwert > satz

+  THEN TRUE

+  ELIF zahlwert <= satz DIV 2 AND bildmarke = 0

+  THEN stelle := datei (dateianker).nachfolger; satz := 1; TRUE

+  ELSE FALSE

+  FI .

+ 

+vorwaerts springen :

+  IF zahlwert <= 0

+    THEN fehler bearbeiten

+  FI ;

+  WHILE stelle <> dateianker AND satz < zahlwert

+  REP nachsatz (datei) UNTIL war fehler PER;

+  IF   stelle = dateianker AND satz > 1 

+  THEN vorsatz (datei);

+       feldstelle (LENGTH (datei (stelle).inhalt)+1)

+  FI .

+ 

+rueckwaerts springen :

+  WHILE stelle <> bildmarke  AND satz > zahlwert

+  REP vorsatz (datei) UNTIL war fehler PER .

+ 

+END PROC row;

+ 

+PROC search (DATEI VAR datei) :

+  stelle := bildstelle;

+  IF textwert <> "" THEN contextadressierung FI;

+  typ := void .

+ 

+contextadressierung : 

+  j := feldstelle - 1; satz := bildsatz;

+  WHILE noch nicht gefunden REP nachsatz (datei) UNTIL war fehler PER;

+  IF    stelle = dateianker

+  THEN  vorsatz (datei);

+        feldstelle (LENGTH (datei (stelle).inhalt)+1)

+  ELIF  j > 0

+  THEN  feldstelle ((LENGTH textwert)+j)

+  FI;

+  IF    bildstelle <> stelle

+  THEN  bildstelle (stelle); bildsatz (satz); bildneu (TRUE)

+  FI .

+ 

+noch nicht gefunden : 

+  j := pos (datei (stelle).inhalt, textwert, j+1); 

+  j = 0 AND stelle <> dateianker AND satz < haltzeile .

+ 

+END PROC search; 

+ 

+ 

+(********************  vom file holen, in file bringen  ********************)

+ 

+PROC vom file holen (DATEI VAR datei, TEXT VAR textwert) :

+  stelle := bildstelle; satz := bildsatz;

+  IF   datei eroeffnung korrekt

+  THEN IF stelle = dateianker THEN satz erzeugen (datei, stelle) FI;

+       zeile auftrennen; file kopieren; kopiertes markieren;

+       bildstelle (stelle); bildsatz (satz); bildmarke (marke)

+  FI ; textwert := "" .

+ 

+datei eroeffnung korrekt :

+  IF   textwert = ""

+  THEN sekundaerfile := sequential file (input); NOT eof (sekundaerfile)

+  ELIF exists (textwert)

+  THEN sekundaerfile := sequential file (input, textwert);

+       NOT eof (sekundaerfile) 

+  ELSE FALSE

+  FI .

+ 

+file kopieren : 

+  INT VAR altstelle;

+  FOR j FROM 0 UPTO satzmax WHILE NOT eof (sekundaerfile) 

+  REP nachsatz (datei); altstelle := stelle;

+      satz erzeugen (datei, stelle);

+      IF stelle = altstelle THEN LEAVE file kopieren FI; 

+      getline (sekundaerfile, inhalt)

+  UNTIL war fehler

+  PER .

+ 

+zeile auftrennen : 

+  marke := stelle; bildmarksatz (satz);

+  nachsatz (datei); satz erzeugen (datei, stelle);

+  inhalt := subtext (datei (marke).inhalt, feldstelle);

+  vorsatz (datei); inhalt := text (inhalt, feldstelle-1) . 

+ 

+kopiertes markieren : 

+  nachsatz (datei);

+  IF inhalt = "" THEN satz loeschen (datei, stelle) FI;

+  vorsatz (datei);

+  IF   datei (marke).inhalt = "" 

+  THEN satz loeschen (datei, marke); satz DECR 1;

+  ELSE marke := datei (marke).nachfolger; bildmarksatz (bildmarksatz+1)

+  FI; 

+  feldmarke (feldanfang); feldanfangsmarke (feldanfang);

+  feldstelle (1+LENGTH inhalt); bildneu (TRUE) .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC vom file holen; 

+ 

+PROC in file bringen ( DATEI VAR datei, TEXT VAR textwert) :

+  neuen sekundaerfile erzeugen;

+  marke := bildstelle; stelle := bildmarke; satz := bildmarksatz;

+  IF   stelle = marke 

+  THEN IF   feldmarke <> feldstelle

+       THEN putline (sekundaerfile,

+                     subtext (inhalt, feldmarke, feldstelle-1)) 

+       FI

+  ELSE IF   feldanfangsmarke <= LENGTH inhalt

+       THEN putline (sekundaerfile, subtext (inhalt, feldanfangsmarke))

+       FI;  schreiben;

+       IF   feldstelle > feldanfang 

+       THEN putline (sekundaerfile, subtext (inhalt, 1, feldstelle-1)) 

+       FI

+  FI .

+ 

+schreiben: 

+  REP nachsatz (datei);

+      IF stelle = marke OR war fehler THEN LEAVE schreiben FI;

+      putline (sekundaerfile, inhalt) 

+  PER .

+ 

+neuen sekundaerfile erzeugen : 

+  IF   textwert = ""

+    THEN sekundaerfile := sequential file (output) ;

+    ELSE IF   exists (textwert) 

+         THEN forget (textwert)

+         FI;

+         IF   exists (textwert)

+         THEN LEAVE in file bringen

+         FI;

+         sekundaerfile := sequential file (output, textwert)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC in file bringen; 

+ 

+ 

+(*************************  i n t e r p r e t e r  *************************)

+ 

+BOOL PROC primary (DATEI VAR datei) : 

+ 

+  SELECT symboltyp OF

+    CASE integer :

+         IF   LENGTH symbol <= 4            (* Li 20.01.82 *)

+         THEN zahlwert := int (symbol);

+              typ := symboltyp;

+              nextsymbol; TRUE

+         ELSE fehler

+         FI

+    CASE texttyp :

+         textwert := symbol; typ := symboltyp; nextsymbol; TRUE

+    CASE delimiter :

+         IF   symbol = "("

+         THEN nextsymbol;

+              IF ausdruck (datei) THEN klammerzu ELSE fehler FI

+         ELSE fehler

+         FI

+    CASE tag :

+         INT CONST pcode :: pos (proznamen, ";" + symbol + ";");

+         IF   pcode = 0

+         THEN is variable

+         ELSE nextsymbol; prozedurieren

+         FI

+    CASE bold, operator :

+         INT CONST op1code :: pos (op1namen, ";" + symbol);

+         IF   op1code = 0

+         THEN fehler

+         ELIF op1code = r                   (* Li 12.01.81 *)

+         THEN wiederholung (datei)

+         ELSE nextsymbol ;

+              IF primary (datei)

+              THEN operieren 

+              ELSE fehler

+              FI

+         FI

+     OTHERWISE : fehler

+   END SELECT .

+ 

+is variable : 

+  INT  VAR var :: 1;

+  WHILE varname (var) <> symbol AND var <> freivar REP var INCR 1 PER;

+  IF   var = freivar

+  THEN varname (var) := symbol; nextsymbol;

+       IF   symbol = ":="

+       THEN deklarieren

+       ELSE LEAVE is variable WITH fehler

+       FI

+  ELSE nextsymbol

+  FI;

+  IF symbol = ":=" THEN nextsymbol; assignieren ELSE dereferenzieren FI .

+ 

+dereferenzieren :

+  typ := vartyp (var); zahlwert := varzahlwert (var);

+  textwert := vartextwert (var); TRUE .

+ 

+assignieren :

+  IF   primary (datei)

+  THEN IF   typ = integer

+       THEN varzahlwert (var) := zahlwert

+       ELIF typ = texttyp

+       THEN vartextwert (var) := textwert

+       ELSE fehler bearbeiten

+       FI;

+       vartyp (var) := typ; typ := void

+  ELSE fehler bearbeiten

+  FI;

+  NOT war fehler .

+ 

+deklarieren :

+  IF   freivar = varimax

+  THEN fehler bearbeiten

+  ELSE freivar INCR 1

+  FI .

+ 

+prozedurieren :

+  typ := integer;

+  SELECT pcode OF 

+    CASE pcol   : zahlwert := feldstelle

+    CASE plen   : zahlwert := LENGTH (datei (bildstelle).inhalt)

+    CASE prow   : zahlwert := bildsatz

+    CASE phalt  : zahlwert := haltzeile

+    CASE plimit : zahlwert := feldlimit

+    CASE pmark  : zahlwert := bildmarke

+    CASE peof   : eof (datei) 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+operieren :

+  SELECT op1code OF

+    CASE plus  : zahlwert INCR bildsatz; row (datei)

+    CASE minus : zahlwert := bildsatz - zahlwert; row (datei)

+    CASE b     : begin

+    CASE c     : col 

+    CASE g     : get 

+    CASE h     : halt 

+    CASE l     : limit 

+    CASE m     : mark

+    CASE p     : put

+    CASE i     : if 

+    CASE w     : write

+    CASE s     : size 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  typ := void; TRUE .

+ 

+begin : 

+  zahlwert := zahlwert MOD 180;

+  feldende (feldende+zahlwert-feldanfang); feldanfang (zahlwert) .

+ 

+col :

+  zahlwert := zahlwert MOD 256; feldstelle (zahlwert) .

+ 

+get : 

+  IF   bildmarke <= 0 AND schreiberlaubnis

+  THEN vom file holen (datei, textwert)

+  FI .

+ 

+halt :

+  haltzeile := zahlwert .

+ 

+limit :

+  zahlwert := zahlwert MOD 256; feldlimit (zahlwert) .

+ 

+mark :

+  IF   zahlwert = 0

+  THEN bildmarke (0); feldmarke (0); bildneu (TRUE) 

+  ELSE bildmarke (bildstelle); feldmarke (feldstelle);

+       bildmarksatz (bildsatz)

+  FI .

+ 

+put : 

+  IF bildmarke > 0 THEN in file bringen (datei, textwert) FI .

+ 

+if : 

+  IF   bedingung (datei) 

+  THEN IF   boolwert 

+       THEN IF   pos ("THEN", symbol) = 1 

+            THEN nextsymbol;

+                 IF   ausdruck (datei)

+                 THEN skip elseteil

+                 ELSE fehler bearbeiten

+                 FI 

+            ELSE fehler bearbeiten

+            FI

+       ELSE skip thenteil; 

+            IF   j = 1

+            THEN elseteil

+            ELIF j <> 5

+            THEN fehler bearbeiten

+            FI

+       FI

+  ELSE fehler bearbeiten

+  FI .

+ 

+elseteil :

+  IF   ausdruck (datei)

+  THEN IF symbol = "FI" THEN nextsymbol ELSE fehler bearbeiten FI

+  FI .

+ 

+skip elseteil : 

+  WHILE symboltyp <> eol AND pos ("FI", symbol) <> 1 REP nextsymbol PER; 

+  nextsymbol .

+ 

+skip thenteil : 

+  WHILE (symboltyp <> eol) AND nicht elsefi REP nextsymbol PER; 

+  nextsymbol .

+ 

+nicht elsefi : 

+  j := pos ("ELSEFI", symbol); j = 0 . 

+ 

+write :

+  feldkommando (textwert); zeile unveraendert .

+ 

+size :

+  IF   bildlaenge > maxbildlaenge

+  THEN maxbildlaenge := bildlaenge

+  FI;

+  bildlaenge (max (1, min (zahlwert, maxbildlaenge)));

+  bildzeile  (min (bildzeile, bildlaenge)); 

+  bildrand (0); bildneu (TRUE); page .

+ 

+END PROC primary; 

+ 

+ 

+(***********  w i e d e r h o l u n g ,   b e d i n g u n g  ***************)

+ 

+BOOL PROC wiederholung (DATEI VAR datei) : 

+ 

+  fix scanner ;              (* Li 12.01.81 *)

+  wiederholt interpretieren;

+  skip endrep; typ := void;

+  NOT war fehler .

+ 

+wiederholt interpretieren :

+  REP reset scanner; nextsymbol;           (* 12.01.81 *)

+      WHILE ausdruck (datei) REP UNTIL until PER; abbruchtest

+  UNTIL ende der wiederholung

+  PER .

+ 

+until : 

+  IF   pos ("UNTIL", symbol) = 1

+  THEN nextsymbol;

+       IF   primary (datei) THEN FI;

+       IF   bedingung (datei) 

+       THEN IF   boolwert

+            THEN LEAVE wiederholt interpretieren;TRUE

+            ELSE TRUE

+            FI

+       ELSE fehler

+       FI

+  ELSE TRUE

+  FI .

+ 

+ende der wiederholung :

+  IF war fehler

+    THEN TRUE

+  ELIF datei (stelle).nachfolger = dateianker

+    THEN feldstelle > LENGTH (datei (stelle).inhalt)

+  ELSE FALSE

+  FI .

+ 

+skip endrep :

+  WHILE pos ("ENDREPEAT", symbol) <> 1 AND symboltyp <> eol 

+  REP nextsymbol PER;

+  nextsymbol .

+ 

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+END PROC wiederholung; 

+ 

+BOOL PROC bedingung (DATEI VAR datei) : 

+  INT VAR relator; 

+  relator := pos ("=><<=>=<>", symbol); 

+  IF   relator = 0

+  THEN fehler

+  ELSE IF typ = texttyp THEN relator INCR 8 FI;

+       nextsymbol; 

+       INT VAR operandtyp :: typ, operandzahlwert :: zahlwert; 

+       TEXT VAR operandtextwert :: textwert; 

+       IF   primary (datei) THEN FI; 

+       IF   operandtyp <> typ

+       THEN fehler

+       ELSE boolwert := vergleich; typ := bool; TRUE 

+       FI

+  FI .

+ 

+vergleich : 

+  SELECT relator OF 

+    CASE  1 : operandzahlwert =  zahlwert 

+    CASE  2 : operandzahlwert >  zahlwert 

+    CASE  3 : operandzahlwert <  zahlwert 

+    CASE  4 : operandzahlwert <= zahlwert 

+    CASE  6 : operandzahlwert >= zahlwert 

+    CASE  8 : operandzahlwert <> zahlwert 

+    CASE  9 : operandtextwert =  textwert 

+    CASE 10 : operandtextwert >  textwert 

+    CASE 11 : operandtextwert <  textwert 

+    CASE 12 : operandtextwert <= textwert 

+    CASE 14 : operandtextwert >= textwert 

+    CASE 16 : operandtextwert <> textwert 

+    OTHERWISE fehler

+  END SELECT .

+ 

+END PROC bedingung; 

+ 

+(****************************  a u s d r u c k  ****************************)

+ 

+BOOL PROC ausdruck (DATEI VAR datei) : 

+  INT VAR opcode, operandtyp, operandzahlwert;

+  TEXT VAR operandtextwert;

+  IF   primary (datei)

+  THEN BOOL VAR war operation :: TRUE;

+       WHILE operator AND war operation

+       REP IF   primary (datei)

+           THEN war operation := operator verarbeiten

+           ELSE war operation := FALSE

+           FI

+       PER;

+       war operation

+  ELSE fehler

+  FI .

+ 

+operator :

+  IF   kommandoende

+  THEN IF   typ = integer

+       THEN row (datei)

+       ELIF typ = texttyp

+       THEN search (datei)

+       FI

+  FI;

+  opcode := pos (op2namen, "&" + symbol);

+  IF   opcode = 0

+  THEN FALSE

+  ELSE nextsymbol; operandtyp := typ;

+       operandzahlwert := zahlwert;

+       operandtextwert := textwert;

+       NOT war fehler

+  FI .

+ 

+operator verarbeiten :

+  SELECT opcode OF

+    CASE plus :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert + zahlwert

+         ELSE textwert := operandtextwert + textwert

+         FI

+    CASE minus : 

+         zahlwert := operandzahlwert - zahlwert

+    CASE mal :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert * zahlwert

+         ELSE textwert := operandzahlwert * textwert

+         FI

+    CASE durch :

+         zahlwert := operandzahlwert DIV zahlwert

+    CASE changecode : 

+         change

+    CASE semicolon : 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+change : 

+  IF   bildmarke <= 0 AND schreiberlaubnis AND bildstelle <> dateianker

+  THEN ersatz := textwert; textwert := operandtextwert; search (datei);

+       INT VAR fstelle :: feldstelle;

+       IF   textwert = "" AND ersatz <> "" AND fstelle > LENGTH inhalt 

+       THEN inhalt := text (inhalt, fstelle-1)

+       FI;

+       IF   subtext (inhalt, fstelle-LENGTH textwert, fstelle-1) = textwert 

+       THEN fstelle := fstelle - LENGTH textwert; 

+            FOR j FROM 1 UPTO LENGTH ersatz 

+            REP IF   j <=  LENGTH textwert 

+                THEN replace     (inhalt, fstelle, ersatz SUB j) 

+                ELSE insert char (inhalt, ersatz SUB j, fstelle)

+                FI;

+                fstelle INCR 1

+            PER;

+            FOR j FROM 1+LENGTH ersatz UPTO LENGTH textwert 

+            REP delete char (inhalt, fstelle) PER;

+       FI;

+       feldstelle (fstelle); typ := void

+  ELSE fehler bearbeiten

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+kommandoende :

+  SELECT pos (";FIELSEENDREPEATUNTIL", symbol) OF

+    CASE 1,2,4,8,17 : TRUE

+    OTHERWISE symboltyp = eol

+  END SELECT .

+ 

+END PROC ausdruck;

+ 

+(************************** schrott ****************************************)

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+END PACKET dateieditorpaket;

diff --git a/system/base/unknown/src/editor b/system/base/unknown/src/editor
new file mode 100644
index 0000000..63f2f19
--- /dev/null
+++ b/system/base/unknown/src/editor
@@ -0,0 +1,210 @@
+ 

+PACKET editor DEFINES                          (* Autor: P.Heyderhoff *) 

+                                               (* Stand: 26.04.82     *) 

+    edit ,                                     (* Vers.: 1.6.3        *)

+    show ,

+    editmode :

+ 

+FILE VAR file 1, file 2 ;

+ 

+PROC edit (FILE VAR file) :

+  x edit (file) ;

+ENDPROC edit ;

+ 

+PROC edit (FILE VAR file 1, file 2) :

+  x edit (file 1, file 2 )

+ENDPROC edit ;

+ 

+PROC edit (TEXT CONST file name) :

+  last param (file name) ;

+  IF exists (file name)

+    THEN edit 1 (file name)

+  ELIF yes ("neue datei einrichten")

+    THEN edit 1 (file name)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

+PROC edit :

+  edit (last param)

+ENDPROC edit ;

+ 

+PROC edit 1 (TEXT CONST name) :

+  file 1 := sequential file (modify, name) ;

+  IF NOT is error

+    THEN edit (file 1)

+  FI

+ENDPROC edit 1 ;

+ 

+PROC edit (TEXT CONST file name 1, file name 2) :

+  IF exists (file name 1)

+    THEN edit 2 (file name 1, file name 2)

+  ELIF yes ("erste datei neu einrichten")

+    THEN edit 2 (file name 1, file name 2)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

+PROC edit 2 (TEXT CONST file name 1, file name 2) :

+  file 1 := sequential file (modify, file name 1) ;

+  IF exists (file name 2)

+    THEN file 2 := sequential file (modify, file name 2) ;

+         edit (file 1, file 2)

+  ELIF yes ("zweite datei neu einrichten")

+    THEN file 2 := sequential file (modify, file name 2) ;

+         edit (file 1, file 2)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit 2 ;

+ 

+PROC show (FILE VAR file) :

+  schreiberlaubnis (FALSE) ;

+  edit (file) ;

+  schreiberlaubnis (TRUE)

+ENDPROC show ;

+ 

+PROC show (TEXT CONST file name) :

+  IF exists (file name)

+    THEN file 1 := sequential file (modify, file name) ;

+         show (file 1) ;

+    ELSE errorstop ("file does not exist")

+  FI

+ENDPROC show ;

+ 

+PROC editmode :

+  feldwortweise (NOT feldwortweise) ;

+  say ("      ") ;

+  IF feldwortweise

+    THEN say ("Fließtext"13""10"")

+    ELSE say ("kein Umbruch"13""10"")

+  FI .

+

+ENDPROC editmode ;

+

+ 

+(******************************  e d i t o r  ******************************)

+ 

+LET DATEI = ROW 4075 STRUCT (INT nachfolger, vorgaenger, index,

+                            fortsetzung, TEXT inhalt),

+    freianker = 1, dateianker = 2, satzmax = 4075,

+    bottom = ""6""23""0"" , escape = ""27"", escape w = ""27"w";

+ 

+BOOL VAR war kein wechsel ;

+TEXT VAR tabulator :: 77*" ";

+ 

+ 

+PROC editor (DATEI VAR datei) : 

+  enable stop ;

+  grundzustand;

+  zustand aus datei holen ; 

+ 

+  REP b i l d   e d i t o r  (datei);

+      d a t e i e d i t o r  (datei)

+  UNTIL (feldkommando SUB 1) = escape

+  PER;

+  war kein wechsel := (feldkommando SUB 2) <> "w";

+  feldkommando (subtext (feldkommando, 3));

+ 

+  IF schreiberlaubnis THEN zustand in datei retten FI;

+  schreiberlaubnis (TRUE);

+  out (bottom) .

+ 

+grundzustand :

+  bildneu (TRUE); bildeinfuegen (FALSE); bildmarke (0);

+  feldmarke (0); feldseparator (""); feldstelle(1);

+  feldeinfuegen (FALSE).

+ 

+zustand in datei retten : 

+  inhalt :=  text (bildstelle, 5);

+  inhalt CAT text (bildsatz,   5);

+  inhalt CAT text (bildzeile,  5);

+  inhalt CAT text (feldlimit,  5);

+  feldtab (tabulator);

+  inhalt CAT tabulator .

+ 

+zustand aus datei holen :

+  INT CONST satz nr := int (subtext (inhalt, 1, 5)) ;

+  IF satz nr > 0

+    THEN bildstelle (satz nr)

+    ELSE bildstelle (datei (dateianker).nachfolger)

+  FI ;

+  bildsatz   (int (subtext (inhalt, 6, 10)));

+  bildzeile  (int (subtext (inhalt, 11, 15)));

+  feldlimit  (int (subtext (inhalt, 16, 20)));

+  tabulator := subtext (inhalt, 21) ; 

+  feldtabulator (tabulator) .

+ 

+inhalt :

+  datei (freianker).inhalt . 

+ 

+END PROC editor;

+ 

+PROC y edit (DATEI VAR datei) :

+  editor (datei);

+  close

+END PROC y edit;

+ 

+LET begin mark = ""15"", endmark blank = ""14"  ";

+ 

+PROC y edit (DATEI VAR erste datei, zweite datei) :

+  INT CONST alte laenge := bildlaenge - 1;

+  INT VAR laenge := alte laenge DIV 2, flen := feldende - feldanfang + 2;

+  bildlaenge (laenge); feldkommando (escape w);

+  zweimal editieren;

+  bildlaenge (alte laenge + 1); bildrand (0);

+  close .

+ 

+zweimal editieren:

+  page;

+  REP cursor (  1, laenge + 2); out (begin mark);

+      cursor(flen, laenge + 2); out (endmark blank); 

+      bildrand (0); editor (erste datei); laenge anpassen;

+      IF war kein wechsel THEN LEAVE zweimal editieren FI;

+      bildrand (alte laenge + 1 - laenge); 

+      editor (zweite datei); laenge anpassen

+  UNTIL war kein wechsel

+  PER .

+ 

+laenge anpassen :

+  laenge := bildlaenge;

+  IF laenge = 1 THEN laenge := 2 FI;

+  IF   laenge <= alte laenge - 2

+  THEN laenge := alte laenge - laenge

+  ELSE laenge := 2

+  FI ; bildlaenge (laenge) .

+END PROC y edit;

+ 

+(**************** schrott ***********************)

+ 

+PROC x edit (FILE VAR f) :

+  EXTERNAL 296

+ENDPROC x edit ;

+ 

+PROC x edit (FILE VAR f1, f2) :

+  EXTERNAL 297

+ENDPROC x edit ;

+ 

+LET FDATEI= STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+PROC x edit (FDATEI VAR f1) :

+  INTERNAL 296 ;

+  y edit (CONCR (f1.f))

+ENDPROC x edit ; 

+ 

+PROC x edit (FDATEI VAR f1, f2) :

+  INTERNAL 297 ;

+  y edit (CONCR (f1.f), CONCR (f2.f))

+ENDPROC x edit ;

+ 

+PROC dateieditor (DATEI VAR d) :

+  EXTERNAL 295

+ENDPROC dateieditor ;

+ 

+PROC bildeditor (DATEI VAR d) :

+  EXTERNAL 293

+ENDPROC bildeditor ;

+ 

+ENDPACKET editor ;

diff --git a/system/base/unknown/src/elan b/system/base/unknown/src/elan
new file mode 100644
index 0000000..744003d
--- /dev/null
+++ b/system/base/unknown/src/elan
@@ -0,0 +1,245 @@
+ 

+PACKET local manager part 2 DEFINES            (* Autor: J.Liedtke *)

+                                               (* Stand: 29.04.80  *)

+  list ,

+  file names :

+ 

+ 

+FILE VAR list file ;

+TEXT VAR file name, status text;

+ 

+PROC list :

+ 

+  list file := sequential file (output) ;

+  headline (list file, "list") ;

+  list (list file) ;

+  show (list file) ;

+  close

+ 

+ENDPROC list ;

+ 

+PROC list (FILE VAR f) :

+ 

+  begin list ;

+  putline (f, "") ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE list

+    FI ;

+    out (f, status text + "  """ ) ;

+    out (f, file name) ;

+    out (f, """") ;

+    line (f)

+  PER

+ 

+ENDPROC list ;

+ 

+PROC file names (FILE VAR f) :

+ 

+  begin list ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE file names

+    FI ;

+    putline (f, file name)

+  PER

+ 

+ENDPROC file names ;

+

+ENDPACKET local manager part 2 ;

+ 

+ 

+PACKET elan DEFINES                               (*Autor: J.Liedtke *)

+                                                  (*Stand: 01.05.82  *)

+    do ,

+    run ,

+    run again ,

+    insert ,

+    prot ,

+    prot off ,

+    check on ,

+    check off :

+ 

+ 

+LET newinit option = FALSE ,

+    ins = TRUE ,

+    no ins = FALSE ,

+    lst = TRUE ,

+    no lst = FALSE ,

+    compiler dump option = FALSE ,

+    sys option = TRUE ,

+    stop at first error = TRUE ,

+    multiple error analysis = FALSE ,

+    sermon = TRUE ,

+    no sermon = FALSE ,

+

+    run again mode = 0 ,

+    compile file mode = 1 ,

+    compile line mode = 2 ,

+

+    error message = 4 ;

+

+BOOL VAR list option := FALSE ,

+         check option := TRUE ,

+         errors occurred ;

+

+INT VAR run again mod nr := 0 ;

+DATASPACE VAR ds ;

+

+FILE VAR error file, source file ;

+ 

+ 

+PROC do (TEXT CONST command) :

+

+  INT VAR dummy mod ;

+  run again mod nr := 0 ;

+  errors occurred := FALSE ;

+  elan (compile line mode, ds, command, dummy mod,

+        newinit option, no ins, compiler dump option, no lst, sys option,

+        check option, stop at first error, no sermon) ;

+  IF errors occurred

+    THEN forget (ds) ;

+         errorstop ("")

+  FI

+ 

+ENDPROC do ;

+ 

+ 

+PROC run (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, no ins)

+ 

+END PROC run;

+ 

+PROC run :

+ 

+  run (last param)

+ 

+ENDPROC run ;

+ 

+PROC run again :

+ 

+  IF run again mod nr > 0

+    THEN INT VAR mod := run again mod nr ;

+         elan (run again mode, ds, "", run again mod nr,

+               newinit option, no ins, compiler dump option, no lst, 

+               sys option, check option, stop at first error, no sermon)

+    ELSE errorstop ("run again impossible")

+  FI

+ 

+ENDPROC run again ;

+ 

+PROC insert (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, ins)

+ 

+ENDPROC insert ;

+ 

+PROC insert :

+ 

+  insert (last param)

+ 

+ENDPROC insert ;

+ 

+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :

+

+  IF exists (file name)

+    THEN compile and execute

+    ELSE errorstop ("file does not exist")

+  FI .

+

+compile and execute :

+  disable stop ;

+  errors occurred := FALSE ;

+  elan (compile file mode, old (file name, 1002), "" , run again mod nr,

+        newinit option, insert option, compiler dump option, list option,

+        sys option, check option, multiple error analysis, sermon) ;

+ 

+  IF errors occurred

+    THEN ignore halt during compiling ;

+         errors occurred := FALSE ;

+         enable stop ;

+         source file := sequential file (modify, file name) ;

+         modify (error file) ;

+         edit (error file, source file) ;

+         forget (ds)

+  FI .

+

+ignore halt during compiling :

+  IF is error

+    THEN put error ;

+         clear error ;

+         pause (5)

+  FI .

+

+ENDPROC run elan ;

+

+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 

+           INT VAR start module number,

+           BOOL CONST newinit, ins, dump, lst, sys, rt check, error1, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+

+PROC out text (TEXT CONST text, INT CONST out type) :

+

+  INTERNAL 257 ;

+  out (text) ;

+  IF out type = error message 

+    THEN access error file ;

+         out (error file, text)

+  FI .

+ 

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out text ;

+

+PROC out line (INT CONST out type) :

+

+  INTERNAL 258 ;

+  out (""13""10"") ;

+  IF out type = error message

+    THEN access error file ;

+         line (error file)

+  FI .

+

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out line ;

+

+PROC open error file :

+

+  errors occurred := TRUE ;

+  forget (ds) ;

+  ds := nilspace ;

+  error file := sequential file (output, ds) ;

+  headline (error file, "errors")

+

+ENDPROC open error file ;

+

+PROC prot :

+  list option := TRUE

+ENDPROC prot ;

+ 

+PROC prot off :

+  list option := FALSE

+ENDPROC prot off ;

+ 

+PROC check on :

+  check option := TRUE

+ENDPROC check on ;

+ 

+PROC check off :

+  check option := FALSE

+ENDPROC check off ;

+ 

+ENDPACKET elan ;

diff --git a/system/base/unknown/src/feldeditor b/system/base/unknown/src/feldeditor
new file mode 100644
index 0000000..4156111
--- /dev/null
+++ b/system/base/unknown/src/feldeditor
@@ -0,0 +1,747 @@
+ 

+PACKET  f e l d e d i t o r  DEFINES              (* Autor: P.Heyderhoff *)

+        (*****************)                       (* Stand: 12.04.82     *)

+                                                  (* Vers.: 1.6.0        *)

+        editget,

+        feldeditor,

+        feldout,

+        feldposition,

+        feldeinruecken,

+        feldtab,

+        feldtabulator,

+        feldseparator,

+        feldmarke,

+        feldstelle,

+        feldwortweise,

+        feldanfang,

+        feldende,

+        feldrand,

+        feldlimit,

+        feldaudit,

+        feldzeichen,

+        feldkommando,

+        feldeinfuegen,

+        feldlernmodus,

+        is incharety,

+        getchar,

+        min :

+ 

+ 

+TEXT VAR tabulator :: "", separator :: "", fzeichen ::"",

+         kommando  :: "", audit     :: "";

+ 

+INT  VAR fmarke  ::  0, fstelle :: 1, frand :: 0, limit :: 77,

+         fanfang ::  1, dyn fanfang :: fanfang,  flaenge, fj,

+         fende   :: 77, dyn fende   :: fende, dezimalen :: 0;

+ 

+BOOL VAR wortweise      :: FALSE, feinfuegen :: FALSE,

+         blankseparator :: FALSE, lernmodus  :: FALSE,

+         war absatz; 

+ 

+LET blank = " ", hop=""1"", right=""2"", up=""3"", clear eop=""4"",

+    clear eol=""5"", bell=""7"", left=""8"", tab=""9"", down=""10"",

+    rubin=""11"", rubout=""12"", cr=""13"", mark=""16"", escape=""27"",

+    hoechstes steuerzeichen=""31"", dach=""94"", end mark=""14"", begin

+    mark=""15"", clear=""1""4"", hop tab=""1""9"", hop rubin=""1""11"",

+    hop rubout=""1""12"", hop cr=""1""13"", cr down=""13""10"",

+    right left tab rubout escape = ""2""8""9""12""27"", hop escape=""1""27"",

+    left left=""8""8"", left endmark=""8""14"", endmark left=""14""8"",

+    left right=""8""2"", blank left=" "8"",

+    blank left rubout=" "8""12"", absatzmarke=""15""14"", 

+    hop esc right left tab rubin rubout cr = ""1""27""2""8""9""11""12""13"",

+    hop esc right left tab down cr         = ""1""27""2""8""9""10""13"";

+ 

+(***************************  p r o z e d u r e n  *************************)

+ 

+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editfende):

+ 

+  disable stop ;  (* J.Liedtke 10.02.82 *)

+

+  INT CONST altflaenge :: LENGTH editsatz, altfrand :: frand,

+            altfmarke  :: fmarke, altfstelle :: fstelle,

+            altfanfang :: fanfang, altfende  :: fende, altlimit :: limit;

+  BOOL CONST altwortweise :: wortweise, altfeinfuegen :: feinfuegen;

+  fmarke := 0; fstelle := 1; fanfang := 1; dyn fanfang := 1; 

+  fende  := editfende MOD 256; dyn fende := fende;

+  limit  := editlimit MOD 256; wortweise := FALSE;

+  feinfuegen := FALSE; 

+  INT VAR x, y; get cursor (x,y); frand := x-1; 

+  out (editsatz);   cursor (x,y); 

+  REP

+    feldeditor (editsatz);

+    IF   (kommando SUB 1) = escape OR (kommando SUB 1) = hop 

+    THEN delete char (kommando, 1)

+    FI;

+    delete char (kommando, 1) 

+  UNTIL fzeichen = cr OR (fzeichen SUB 1) = separator OR is error

+  PER;

+  cursor (x + 1 + editflaenge - dyn fanfang, y); 

+  fmarke := altfmarke;  fstelle := altfstelle; fanfang := altfanfang;

+  dyn fanfang := fanfang; fende := altfende; dyn fende := fende;

+  limit := altlimit;  wortweise := altwortweise; frand := altfrand;

+  feinfuegen := altfeinfuegen . 

+ 

+editflaenge :

+  min (dyn fende, flaenge) .

+ 

+END PROC editget;

+ 

+PROC editget (TEXT VAR editsatz) :

+  INT VAR x, y; get cursor (x,y);

+  editget (editsatz, 255, fende-fanfang+2+frand-x)

+END PROC editget;

+ 

+PROC feldout (TEXT CONST satz) :

+  INT VAR x, y;

+  flaenge := min (fende, LENGTH satz);

+  out (cr);

+  frand TIMESOUT right; feldrest loeschen (fanfang);

+  IF   fmarke > 0

+  THEN outsubtext (satz, fanfang, fmarke-1); out (begin mark);

+       outsubtext (satz, fmarke, min (fstelle-1,flaenge));

+       out (end mark); outsubtext (satz, fstelle, flaenge);

+  ELIF absatzmarke noetig (satz) 

+  THEN get cursor (x,y); outsubtext (satz, fanfang, flaenge); 

+       cursor (x + fende + 1 - fanfang, y); out (absatzmarke)

+  ELSE outsubtext (satz, fanfang, flaenge)

+  FI

+END PROC feldout;

+ 

+ 

+PROC feld einruecken (TEXT CONST satz) :

+ 

+  IF   fstelle = fanfang

+  THEN fstelle := neue einrueckposition;

+       (fstelle-fanfang) TIMESOUT right

+  FI .

+ 

+neue einrueckposition :

+  INT VAR suchindex;

+  FOR suchindex FROM fanfang UPTO min (LENGTH satz, fende)

+  REP  IF   (satz SUB suchindex) <> blank

+       THEN LEAVE neue einrueckposition WITH suchindex

+       FI

+  PER;

+  fanfang .

+ 

+END PROC feld einruecken;

+ 

+TEXT PROC feldzeichen :

+  fzeichen

+END PROC feldzeichen;

+ 

+TEXT PROC feldkommando :

+  kommando

+END PROC feldkommando;

+ 

+PROC feldkommando (TEXT CONST t) :

+  kommando := t

+END PROC feldkommando;

+ 

+PROC feldtab (TEXT VAR t) :

+  t := tabulator

+END PROC feldtab;

+ 

+PROC feldtabulator (TEXT CONST t) :

+  tabulator := t

+END PROC feldtabulator;

+ 

+TEXT PROC feldseparator :

+  separator

+END PROC feldseparator;

+ 

+PROC feldseparator (TEXT CONST t) :

+  separator := t; blankseparator := t = blank

+END PROC feldseparator;

+ 

+TEXT PROC feldaudit :

+  audit

+END PROC feldaudit;

+ 

+PROC feldaudit (TEXT CONST a) :

+  audit := a

+END PROC feldaudit;

+ 

+BOOL PROC feldlernmodus :

+  lernmodus

+END PROC feldlernmodus;

+ 

+PROC feldlernmodus (BOOL CONST b) :

+  lernmodus := b 

+END PROC feldlernmodus;

+ 

+BOOL PROC feldeinfuegen :

+  feinfuegen

+END PROC feldeinfuegen;

+ 

+PROC feldeinfuegen (BOOL CONST b):

+  feinfuegen := b

+END PROC feldeinfuegen;

+ 

+BOOL PROC feldwortweise :

+  wortweise

+END PROC feldwortweise;

+ 

+PROC feldwortweise (BOOL CONST b) :

+  wortweise := b

+END PROC feldwortweise;

+ 

+INT PROC feldmarke :

+  fmarke

+END PROC feldmarke;

+ 

+PROC feldmarke (INT CONST i) :

+  fmarke  := i MOD 256

+END PROC feldmarke;

+ 

+INT PROC feldstelle :

+  fstelle

+END PROC feldstelle;

+ 

+PROC feldstelle (INT CONST i) :

+  fstelle := i MOD 256

+END PROC feldstelle;

+ 

+INT PROC feldanfang :

+  fanfang

+END PROC feldanfang;

+ 

+PROC feldanfang (INT CONST i) :

+  fanfang := i MOD 256; dyn fanfang := fanfang

+END PROC feldanfang;

+ 

+INT PROC feldende :

+  fende

+END PROC feldende;

+ 

+PROC feldende (INT CONST i) :

+  fende := i MOD 256; dyn fende := fende

+END PROC feldende;

+ 

+INT PROC feldrand :

+  frand

+END PROC feldrand;

+ 

+PROC feldrand (INT CONST i) :

+  frand := i MOD 256

+END PROC feldrand;

+ 

+INT PROC feldlimit :

+  limit

+END PROC feldlimit;

+ 

+PROC feldlimit (INT CONST i) :

+  limit := i MOD 256

+END PROC feldlimit;

+ 

+PROC feldposition :

+  INT VAR x, y;

+  IF   fstelle <= fende

+  THEN IF   fstelle < fanfang

+       THEN fstelle := fanfang;

+            IF fanfang > fende

+            THEN fende := fanfang; dyn fende := fanfang

+            FI

+       FI

+  ELSE fstelle := fende;

+       IF   fanfang > fende

+       THEN fanfang := fende; dyn fanfang := fende

+       FI

+  FI;

+  get cursor(x,y); cursor(1+frand+fstelle-fanfang+fmarke oder fstelle, y). 

+ 

+fmarke oder fstelle :

+  IF fmarke > 0 THEN 1 ELSE 0 FI .

+ 

+END PROC feldposition;

+ 

+PROC feldposition (INT CONST i) :

+  fstelle := i; feldposition

+END PROC feldposition;

+ 

+BOOL PROC absatzmarke noetig (TEXT CONST satz) : 

+ 

+  IF   wortweise

+  THEN (satz SUB LENGTH satz) = blank 

+  ELSE FALSE

+  FI

+END PROC absatzmarke noetig;

+ 

+PROC zeile neu schreiben (TEXT CONST satz) :

+  INT VAR x,y; get cursor (x,y);

+  flaenge := min (dyn fende, LENGTH satz);

+  cursor (1+frand, y);

+  feldrest loeschen (dyn fanfang);

+  outsubtext (satz, dyn fanfang, flaenge);

+  cursor (x,y)

+END PROC zeile neu schreiben;

+ 

+PROC feldrest loeschen (INT CONST fstelle):

+  INT VAR x,y;

+  IF   frand + fende <= 76

+  THEN get cursor (x,y); (1 + dyn fende - fstelle) TIMESOUT blank;

+       cursor (x,y)

+  ELSE out (clear eol); war absatz := FALSE 

+  FI

+END PROC feldrest loeschen;

+ 

+TEXT OP SUBB (TEXT CONST t, INT CONST i) :

+  IF i <= LENGTH t THEN t SUB i ELSE blank FI

+END OP SUBB;

+ 

+INT PROC min (INT CONST a, b):

+  IF a < b THEN a ELSE b FI

+END PROC min;

+ 

+BOOL PROC is incharety (TEXT CONST muster) :

+ 

+  fzeichen := incharety; 

+  IF   fzeichen = ""

+  THEN FALSE

+  ELSE IF   lernmodus 

+       THEN audit CAT fzeichen;

+            IF fzeichen = """" THEN audit CAT fzeichen

+       FI   FI ;

+       IF   fzeichen = muster 

+       THEN kommando := ""; TRUE

+       ELSE kommando CAT fzeichen; FALSE

+  FI   FI

+END PROC is incharety; 

+ 

+PROC getchar (TEXT VAR fzeichen) :

+ 

+  IF   kommando = ""

+  THEN inchar (fzeichen)

+  ELSE fzeichen := kommando SUB 1;

+       delete char (kommando, 1);

+       kommando CAT incharety

+  FI;

+  IF   lernmodus

+  THEN audit CAT fzeichen;

+       IF   fzeichen = """"

+       THEN audit CAT fzeichen

+       FI

+  FI .

+END PROC getchar;

+ 

+ 

+(**************************  f e l d e d i t o r  **************************)

+ 

+PROC feldeditor (TEXT VAR satz) :

+

+  enable stop ; (* J. Liedtke 10.02.82 *)

+

+  INT VAR x, y;

+  BOOL VAR inkompetent :: FALSE; war absatz := absatzmarke noetig (satz);

+  IF   fstelle <= fende 

+  THEN IF fstelle < fanfang THEN feldposition FI

+  ELSE feldposition

+  FI;

+  flaenge := min (fende, LENGTH satz);

+ 

+  REP  e i n g a b e  UNTIL inkompetent PER;

+ 

+  blanks abschneiden;

+  IF dyn fanfang <> fanfang THEN zurechtruecken FI;

+  IF   NOT war absatz AND absatzmarke noetig (satz) 

+  THEN absatzmarke schreiben

+  ELIF war absatz AND NOT absatzmarke noetig (satz)

+  THEN absatzmarke loeschen

+  FI .

+ 

+absatzmarke schreiben : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (absatzmarke);

+  cursor (x,y) .

+ 

+absatzmarke loeschen : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out ("  ");

+  cursor (x,y) .

+ 

+zurechtruecken :

+  fstelle DECR (dyn fanfang - fanfang);

+  dyn fanfang := fanfang; dyn fende := fende;

+  zeile neu schreiben (satz) .

+ 

+blanks abschneiden :

+  flaenge := LENGTH satz;

+  FOR fj FROM flaenge DOWNTO 0 WHILE (satz SUB fj) = blank

+  REP delete char (satz, fj) PER;

+  IF fj < flaenge THEN satz CAT blank FI .

+ 

+eingabe :

+  IF   fmarke <= 0

+  THEN s c h r e i b e d i t o r;

+       IF   ueberlaufbedingung

+       THEN ueberlauf

+       ELSE a u s f u e h r e n

+       FI

+  ELSE m a r k e d i t o r

+  FI .

+ 

+ueberlaufbedingung :

+  IF   fstelle <= dyn fende

+  THEN IF   fstelle <= limit

+       THEN FALSE

+       ELSE fzeichen > hoechstes steuerzeichen

+       FI

+  ELSE TRUE

+  FI .

+ 

+ueberlauf :

+  IF   fstelle > limit

+  THEN IF   wortweise OR fstelle > LENGTH satz

+       THEN ueberlauf in naechste zeile; LEAVE ueberlauf

+       FI

+  FI;

+  IF   fstelle >  dyn fende

+  THEN fstelle := dyn fende; out (left);

+       zeile um eins nach links verschieben

+  FI .

+ 

+ueberlauf in naechste zeile :

+  IF   wortweise

+  THEN umbrechen

+  ELSE out (bell); kommando := cr

+  FI;

+  inkompetent := TRUE .

+ 

+umbrechen :

+  IF   LENGTH satz > limit

+  THEN kommando CAT  subtext (satz, limit+1);

+       FOR fj FROM LENGTH satz DOWNTO fstelle

+       REP kommando CAT left PER;

+       satz := subtext (satz, 1, limit)

+  FI;

+  fj := limit;

+  zeichen zuruecknehmen;

+  (fstelle-fj) TIMESOUT left; fstelle := fj; feldrest loeschen (fstelle);

+  IF kommando = "" THEN kommando := blank left rubout FI;

+  blanks loeschen.

+ 

+blanks loeschen: 

+  REP   fj DECR 1;

+        IF (satz SUB fj) <> blank THEN LEAVE blanks loeschen FI;

+        delete char (satz, fj)

+  PER .

+ 

+zeichen zuruecknehmen: 

+  REP   fzeichen := satz SUB fj; delete char (satz, fj);

+        IF fzeichen = blank THEN LEAVE zeichen zuruecknehmen FI;

+        insert char (kommando, fzeichen, 1);

+        IF fj = fanfang     THEN LEAVE zeichen zuruecknehmen FI;

+        fj DECR1

+  PER.

+ 

+ausfuehren :

+  dezimalen := 0;

+  SELECT pos (hop esc right left tab rubin rubout cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             SELECT pos (right left tab rubout escape, fzeichen) OF

+               CASE 1 : zum rechten frand

+               CASE 2 : zum linken  frand

+               CASE 3 : tabulator setzen

+               CASE 4 : zeile loeschen

+               CASE 5 : bei lernmodus ein zeichen lesen

+               OTHERWISE hop return

+             END SELECT

+    CASE 2 : escape aktion

+    CASE 3 : nach rechts

+    CASE 4 : nach links

+    CASE 5 : nach tabulator

+    CASE 6 : feinfuegen umschalten

+    CASE 7 : ausfuegen

+    CASE 8 : ggf absatz erzeugen; return

+    OTHERWISE return

+  END SELECT .

+ 

+ggf absatz erzeugen : 

+  IF   wortweise

+  THEN IF   fstelle > LENGTH satz

+       THEN IF   (satz SUB LENGTH satz) <> blank

+            THEN satz CAT blank; fstelle INCR 1

+            FI

+       FI

+  FI .

+ 

+nach rechts :

+  IF   fstelle < dyn fende AND (fstelle < limit OR fstelle < flaenge)

+  THEN out (right); fstelle INCR1

+  ELIF LENGTH satz > dyn fende

+  THEN zeile um eins nach links verschieben

+  ELSE return

+  FI .

+ 

+nach links :

+  IF   fstelle > dyn fanfang

+  THEN out (left); fstelle DECR1

+  ELIF dyn fanfang = fanfang

+  THEN out (bell)

+  ELSE zeile um eins nach rechts verschieben

+  FI .

+ 

+bei lernmodus ein zeichen lesen :

+  IF   lernmodus

+  THEN getchar (fzeichen); return;

+       fzeichen := escape

+  FI;

+  hop return; fzeichen := hop escape .

+ 

+zeile um eins nach links  verschieben :

+  dyn fanfang INCR 1; dyn fende INCR 1;

+  fstelle := dyn fende; zeile neu schreiben (satz) .

+ 

+zeile um eins nach rechts verschieben :

+  dyn fanfang DECR 1; dyn fende DECR 1;

+  fstelle := dyn fanfang; zeile neu schreiben (satz) .

+ 

+feinfuegen umschalten :

+  IF   feinfuegen

+  THEN feinfuegen := FALSE

+  ELSE feinfuegen := TRUE; get cursor (x,y); out (dach);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y); pause (1); 

+       feldrest loeschen (fstelle);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y) 

+  FI;

+  return .

+ 

+ausfuegen :

+  IF   flaenge < dyn fanfang OR fstelle > flaenge

+  THEN IF   fstelle = flaenge + 1 AND fstelle > dyn fanfang 

+       THEN fstelle := flaenge; out (left)

+       ELSE out (bell);

+            LEAVE ausfuegen

+       FI

+  FI;

+  ausfuegeoperation; delete char (satz, fstelle);

+  flaenge := min (dyn fende, LENGTH satz) .

+ 

+ausfuegeoperation :

+  get cursor (x,y); outsubtext (satz, fstelle+1, flaenge+1);

+  out (blank); cursor (x,y) .

+ 

+zum linken frand :

+  IF   fstelle > fanfang

+  THEN get cursor (x,y); cursor (1+frand, y); 

+       IF   dyn fanfang = fanfang

+       THEN fstelle := fanfang

+       ELSE verschieben an linken frand

+       FI

+  FI .

+ 

+zum rechten frand :

+  fj := min (dyn fende, limit); get cursor (x,y);

+  IF   LENGTH satz >  fj

+  THEN IF   fstelle >= LENGTH satz

+       THEN out (bell)

+       ELIF LENGTH satz > dyn fende

+       THEN verschieben an rechten frand

+       ELSE cursor (x + LENGTH satz - fstelle, y);

+            fstelle := LENGTH satz

+       FI

+  ELIF fstelle < fj

+  THEN cursor (x + fj-fstelle, y); fstelle := fj

+  FI .

+ 

+verschieben an linken  frand :

+  dyn fanfang := fanfang; dyn fende := fende;

+  fstelle := fanfang; zeile neu schreiben (satz).

+ 

+verschieben an rechten frand :

+  (dyn fende - fstelle) TIMESOUT right;

+  dyn fanfang INCR (LENGTH satz - dyn fende); dyn fende := LENGTH satz;

+  fstelle := dyn fende; zeile neu schreiben (satz).

+ 

+nach tabulator :

+  fj := pos (tabulator, "^", fstelle+1);

+  IF   fj = 0

+  THEN IF   (satz SUB fstelle) = blank AND fstelle = fanfang

+       THEN IF   satz = blank 

+            THEN fstelle INCR 1; out (right)

+            ELSE out (blank left); feld einruecken (satz);

+            FI;

+            LEAVE nach tabulator

+       ELIF flaenge < dyn fende AND fstelle <= flaenge

+       THEN fj := flaenge + 1

+       FI

+  ELSE dezimalen := 1

+  FI;

+  IF   fj > 0 AND fj <= dyn fende

+  THEN outsubtext (satz, fstelle, fj-1); fstelle := fj

+  ELSE (fstelle-dyn fanfang) TIMESOUT left;

+       fstelle := dyn fanfang; insert char (kommando, down, 1)

+  FI .

+ 

+tabulator setzen :

+  IF   (tabulator SUB fstelle) = "^"

+  THEN fzeichen := right

+  ELSE fzeichen := "^"

+  FI;

+  WHILE fstelle > LENGTH tabulator

+  REP  tabulator CAT right PER;

+  replace (tabulator, fstelle, fzeichen);

+  insert char (kommando,   tab, 1);

+  insert char (kommando, hop, 1);

+  inkompetent := TRUE .

+ 

+zeile loeschen :

+  IF   fstelle = 1 

+  THEN satz := ""; feldrest loeschen (fstelle); hop return

+  ELIF fstelle <= flaenge

+  THEN REP delete char (satz, LENGTH satz)

+       UNTIL fstelle > LENGTH satz

+       PER;

+       flaenge := fstelle - 1; feldrest loeschen (fstelle)

+  ELSE hop return

+  FI .

+ 

+(***********************  s c h r e i b e d i t o r  ***********************)

+ 

+schreibeditor :

+  REP   getchar (fzeichen);

+        IF   fzeichen <= hoechstes steuerzeichen THEN LEAVE schreibeditor

+        ELIF separator bedingung                 THEN LEAVE schreibeditor

+        ELSE f o r t s c h r e i b e n           FI 

+  PER .

+ 

+separatorbedingung :

+  IF   blankseparator

+  THEN IF   flaenge + 2 <= fstelle

+       THEN insert char (kommando, fzeichen, 1);

+            fzeichen := blank

+       FI

+  FI;

+  fzeichen = separator .

+ 

+fortschreiben :

+  IF   dezimalen > 0 THEN dezimaltabulator FI;

+  out (fzeichen);

+  IF   fstelle > flaenge

+  THEN anhaengen

+  ELIF dezimalen = 0 AND feinfuegen

+  THEN insert char (satz, fzeichen, fstelle)

+  ELSE replace     (satz, fstelle, fzeichen)

+  FI;

+  flaenge := min (dyn fende, LENGTH satz);

+  fstelle INCR 1;

+  IF   feinfuegen AND dezimalen = 0 AND fstelle <= flaenge

+  THEN zeilenrest neu schreiben

+  FI;

+  IF   fstelle > dyn fende

+  OR   fstelle > limit AND (wortweise OR fstelle > flaenge)

+  THEN LEAVE schreibeditor

+  FI .

+ 

+zeilenrest neu schreiben :

+  get cursor (x,y); outsubtext (satz, fstelle, flaenge); cursor (x,y) .

+ 

+dezimaltabulator :

+  IF   fzeichen < "0" OR fzeichen > "9"

+  THEN dezimalen := 0

+  ELIF dezimalen = 1

+  THEN IF   (satz SUB fstelle) = blank OR fstelle > flaenge

+       THEN dezimalen := 2

+       ELSE dezimalen := 0

+       FI

+  ELIF (satz SUB fstelle-dezimalen) = blank

+  THEN replace (satz, fstelle-dezimalen,

+                subtext (satz, fstelle-dezimalen+1, fstelle-1)) ;

+       dezimalen TIMESOUT left;

+       outsubtext (satz, fstelle-dezimalen, fstelle-2);

+       dezimalen INCR 1; fstelle DECR 1

+  ELSE dezimalen := 0

+  FI .

+ 

+anhaengen :

+  FOR fj FROM flaenge+2 UPTO fstelle

+  REP satz CAT blank PER;

+  satz CAT fzeichen .

+ 

+ 

+(**************************  m a r k e d i t o r  **************************)

+ 

+markeditor :

+  getchar (fzeichen);

+  SELECT pos (hop esc right left tab down cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             IF   fzeichen = right THEN markierung maximal

+             ELIF fzeichen = left  THEN markierung minimal

+             ELSE hop return

+             FI

+    CASE 2 : escape aktion

+    CASE 3 : markierung verlaengern

+    CASE 4 : markierung verkuerzen

+    CASE 5 : markierung bis tab verlaengern

+    CASE 6,7 : zeilenrest markieren

+    OTHERWISE IF   fzeichen <= hoechstes steuerzeichen

+              THEN return

+              ELSE out (bell)

+              FI

+  END SELECT .

+ 

+markierung verlaengern :

+  IF   fstelle <= flaenge

+  THEN out (satz SUB fstelle, end mark left); fstelle INCR 1

+  ELSE return

+  FI .

+ 

+markierung maximal :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge); out (end mark left);

+       fstelle := flaenge + 1

+  FI .

+ 

+zeilenrest markieren :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge);

+       out (end mark left);

+       (flaenge-fstelle+2) TIMESOUT left

+  FI;

+  return .

+ 

+markierung verkuerzen :

+  IF   fstelle > fmarke

+  THEN fstelle DECR 1;

+       out (left end mark, satz SUBB fstelle, left left)

+  ELSE out (bell)

+  FI .

+ 

+markierung minimal :

+  IF   fstelle > fmarke

+  THEN (fstelle-fmarke) TIMESOUT left; out (end mark);

+       outsubtext (satz, fmarke, fstelle-1);

+       (fstelle-fmarke+1) TIMESOUT left; fstelle := fmarke

+  FI .

+ 

+markierung bis tab verlaengern :

+  fj := pos (tabulator, "^", fstelle + 1);

+  IF   fj = 0

+  THEN fj := flaenge - fstelle + 1; IF fj <= 0 THEN return FI

+  ELSE fj DECR fstelle

+  FI;

+  IF   fj > 0

+  THEN outsubtext (satz, fstelle, min (fstelle+fj-1, flaenge));

+       out (end mark left)

+  FI;

+  fstelle INCR fj;

+  IF fstelle > (dyn fende+1) THEN return FI .

+ 

+ 

+(******************* allgemein verwendete refinements *********************)

+ 

+return :

+  insert char (kommando, fzeichen, 1);

+  inkompetent := TRUE .

+ 

+hop return :

+  return; insert char (kommando, hop, 1) .

+ 

+escape aktion :

+  getchar (fzeichen); return;

+  insert char (kommando, escape, 1);

+  insert char (fzeichen, escape, 1) .

+ 

+END PROC feldeditor;

+ 

+END PACKET feldeditor;

diff --git a/system/base/unknown/src/file b/system/base/unknown/src/file
new file mode 100644
index 0000000..e556bec
--- /dev/null
+++ b/system/base/unknown/src/file
@@ -0,0 +1,810 @@
+ 

+PACKET file DEFINES                            (* Autor: J.Liedtke *)

+                                               (* Stand: 30.04.82  *)

+       FILE ,

+       := ,

+       input ,

+       output ,

+       modify ,

+       sequential file ,

+       getline ,

+       putline ,

+       line ,

+       reset ,

+       eof ,

+       put ,

+       get ,

+       page ,

+       out ,

+       eop ,

+       close ,

+       max line length ,

+       max page length ,

+       read record , 

+       write record , 

+       forward , 

+       backward , 

+       delete record , 

+       insert record , 

+       to first record ,

+       to eof , 

+       is first record , 

+       headline ,

+       copy attributes ,

+       reorganize ,

+       feldeditor ,

+       feldout ,

+       feldeinruecken ,

+       pos ,

+       change ,

+       subtext ,

+       sort :

+ 

+ 

+ 

+TYPE FILE = STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+TYPE TRANSPUTDIRECTION = INT ;

+ 

+LET closed = 1 ,

+    in     = 2 ,

+    outp   = 3 ,

+    mod    = 4 ,

+    end    = 5 ,

+    escape = ""27"" ,

+

+    nullzustand    = "    0    1    1" ,

+

+    max length = 15 000 ;    (*  < maxint/2 because 2 * maxlength possible*)

+

+ 

+TRANSPUTDIRECTION PROC input :

+  TRANSPUTDIRECTION : ( in )

+ENDPROC input ;

+ 

+TRANSPUTDIRECTION PROC output :

+  TRANSPUTDIRECTION : ( outp )

+ENDPROC output ;

+ 

+TRANSPUTDIRECTION PROC modify :

+  TRANSPUTDIRECTION : ( mod )

+ENDPROC modify ;

+ 

+LET DATEI = ROW 4075 STRUCT (

+                INT nachfolger, vorgaenger, index, fortsetzung,

+                TEXT inhalt ) ;

+ 

+LET anker = 2 ,

+    freianker = 1 ;

+ 

+TEXT VAR number word ;

+

+FILE VAR result file ;

+ 

+DATASPACE VAR scratch space ;

+close ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode) :

+ 

+  IF CONCR (mode) = outp

+    THEN close

+  FI ;

+  sequential file (mode, scratch space)

+ 

+ENDPROC sequential file ;

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           DATASPACE VAR ds) :

+ 

+  IF type (ds) = 1002

+    THEN result file.f := ds

+  ELIF type (ds) < 0

+    THEN result file.f := ds ;

+         type (ds, 1002) ;

+         datei initialisieren (CONCR (result file.f))

+  ELSE   errorstop ("dataspace has wrong type") ;

+         result file.f := scratch space

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+ENDPROC sequential file ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           TEXT CONST name ) :

+ 

+  IF exists (name)

+    THEN get dataspace if file

+  ELIF CONCR (mode) <> in

+    THEN get new file space

+  ELSE errorstop ("input file not existing") ;

+       result file.f := scratch space

+  FI ;

+  IF CONCR (mode) <> in

+    THEN status (name, "") ;

+         headline (result file, name)

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+get new file space :

+  result file.f := new (name) ;

+  IF NOT is error

+    THEN type (old (name), 1002) ;

+         datei initialisieren ( CONCR (result file.f) )

+  FI .

+ 

+get dataspace if file :

+  result file.f := old (name, 1002) .

+ 

+ENDPROC sequential file ;

+ 

+INT PROC max line length (FILE CONST file) :

+ 

+  int (subtext (zustand, 16, 20)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+

+ENDPROC max line length ;

+ 

+PROC max line length (FILE VAR file, INT CONST length) :

+ 

+  replace (zustand, 16, text (length,5)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+ 

+ENDPROC max line length ;

+ 

+PROC headline (FILE VAR file, TEXT CONST head) :

+ 

+  CONCR (file.f)(anker).inhalt := head

+ 

+ENDPROC headline ;

+ 

+TEXT PROC headline (FILE VAR file) :

+ 

+  CONCR (file.f)(anker).inhalt

+ 

+ENDPROC headline ;

+ 

+PROC copy attributes (FILE CONST source, FILE VAR dest) :

+

+  dest attributes := source attributes ;

+  reset edit status (dest) ;

+  dest headline   := source headline .

+

+dest attributes :   CONCR (dest.f) (freianker).inhalt .

+source attributes : CONCR (source.f) (freianker).inhalt .

+

+dest headline :     CONCR (dest.f) (anker).inhalt .

+source headline :   CONCR (source.f) (anker).inhalt .

+

+ENDPROC copy attributes ;

+

+

+PROC input (FILE VAR file) :

+ 

+  file.mode := in ;

+  reset (file)

+ 

+ENDPROC input ;

+ 

+PROC output (FILE VAR file) :

+ 

+  file.mode := outp ;

+  reset (file)

+ 

+ENDPROC output ;

+ 

+PROC modify (FILE VAR file) :

+ 

+  file.mode := mod ;

+  reset (file)

+ 

+ENDPROC modify ;

+ 

+ 

+PROC putline (FILE VAR file, TEXT CONST record) :

+ 

+  check mode (file, outp) ;

+  line (file) ;

+  CONCR (file.f)(file.index).inhalt := record ;

+  file.pointer := max length

+ 

+ENDPROC putline ;

+ 

+ 

+PROC getline (FILE VAR file, TEXT VAR record) :

+ 

+  check mode (file, in) ;

+  line (file) ;

+  record := CONCR (file.f)(file.index).inhalt ;

+  file.pointer := max length

+ 

+ENDPROC getline ;

+ 

+ 

+PROC line (FILE VAR file) :

+ 

+  file.index := CONCR (file.f) (file.index).nachfolger ;

+  file.pointer  := 0 ;

+  IF file.mode = in

+    THEN check eof

+  ELIF file.mode = outp

+    THEN satz erzeugen (CONCR (file.f), file.index) ;

+         CONCR (file.f)(file.index).inhalt := "" ;

+         perhaps implicit page feed

+  FI .

+ 

+check eof :

+  IF eof

+    THEN file.mode := end

+  FI .

+ 

+eof : CONCR (file.f)(file.index).nachfolger = anker .

+ 

+perhaps implicit page feed :

+  file.line counter INCR 1 ;

+  IF file.line counter = file.max page length

+    THEN page (file)

+  FI .

+ 

+ENDPROC line ;

+ 

+PROC check mode (FILE CONST file, INT CONST mode) :

+ 

+  IF file.mode = mode

+      THEN LEAVE check mode

+  ELIF file.mode = closed

+      THEN errorstop ("file not open")

+  ELIF file.mode = mod

+      THEN errorstop ("operation not in transputdirection 'modify'")

+  ELIF mode = mod

+      THEN errorstop ("operation only in transputdirection 'modify'")

+  ELIF file.mode = end

+      THEN IF eof (file) THEN errorstop ("input after end of file") FI

+  ELIF mode = in

+      THEN errorstop ("input access to output file")

+  ELIF mode = outp

+      THEN errorstop ("output access to input file")

+  FI

+ 

+ENDPROC check mode ;

+ 

+PROC reset (FILE VAR file) :

+ 

+  file.pointer := max length ;

+  file.line counter := 0 ;

+  file.edit status unchanged := TRUE ;

+  initialize file index ;

+  set correct file mode .

+ 

+initialize file index :

+  IF file.mode = outp

+    THEN file.index := last record

+    ELSE file.index := anker

+  FI .

+ 

+set correct file mode :

+  IF file.mode = end

+    THEN file.mode := in

+  FI ;

+  IF file.mode = in AND empty file

+    THEN file.mode := end

+  FI .

+ 

+last record : CONCR (file.f) (anker).vorgaenger .

+ 

+empty file  : CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC reset ;

+ 

+BOOL PROC eof (FILE CONST file) :

+ 

+  IF file.mode = end

+    THEN end of record

+  ELIF file.mode = mod

+    THEN file.index = anker

+    ELSE FALSE

+  FI .

+ 

+end of record :

+  file.pointer >= length (CONCR (file.f)(file.index).inhalt) .

+ 

+ENDPROC eof ;

+ 

+PROC line (FILE VAR file, INT CONST lines) :

+ 

+  check mode (file, outp) ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO lines REP

+    line (file)

+  PER

+ 

+ENDPROC line ;

+ 

+PROC page (FILE VAR file) :

+ 

+  file.line counter := 0 ;

+  putline (file, "#page")

+ 

+ENDPROC page ;

+ 

+BOOL PROC eop (FILE CONST file) :

+ 

+  CONCR (file.f)(file.index).inhalt = "#page"

+ 

+ENDPROC eop ;

+ 

+PROC put (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  put word (CONCR (file.f)(file.index).inhalt, word, file.pointer)

+ 

+ENDPROC put ;

+ 

+PROC put word (TEXT VAR record, TEXT CONST word, INT VAR pointer) :

+ 

+  IF pointer > 0

+    THEN record CAT " " ;

+  FI ;

+  record CAT word ;

+  pointer := LENGTH record

+ 

+ENDPROC put word ;

+ 

+PROC put (FILE VAR f, INT CONST value) :

+ 

+  put (f, text (value) )

+ 

+ENDPROC put ;

+ 

+PROC put (FILE VAR f, REAL CONST real) :

+ 

+  put (f, text (real) )

+ 

+ENDPROC put ;

+ 

+PROC out (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  record CAT word ;

+  file.pointer INCR LENGTH word .

+ 

+record : CONCR (file.f)(file.index).inhalt .

+ 

+ENDPROC out ;

+ 

+PROC get (FILE VAR file, TEXT VAR word, TEXT CONST separator) :

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, separator)

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR file, TEXT VAR word, INT CONST max length) :

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, "")

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR file, TEXT VAR word) :

+ 

+  check mode (file, in) ;

+  next word (file, CONCR (file.f)(file.index).inhalt, word)

+ 

+ENDPROC get ;

+ 

+PROC next word (FILE VAR file, TEXT CONST record, TEXT VAR word) :

+ 

+  get next non blank char ;

+  IF char found

+    THEN get word (record, word, file.pointer, max length, " ")

+  ELIF last line of file

+    THEN word := "" ;

+         file.pointer := max length

+    ELSE line (file) ;

+         get (file, word)

+  FI .

+ 

+get next non blank char :

+  TEXT VAR char ;

+  REP

+    file.pointer INCR 1 ;

+    char := record SUB file.pointer

+  UNTIL char <> " " PER ;

+  file.pointer DECR 1 .

+ 

+char found :  char <> "" .

+ 

+last line of file :

+  CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC next word ;

+ 

+PROC get (FILE VAR f, INT VAR number) :

+ 

+  get (f, number word) ;

+  number := int (number word)

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR f, REAL VAR number) :

+ 

+  get (f, number word) ;

+  number := real (number word)

+ 

+ENDPROC get ;

+ 

+PROC get word (TEXT CONST record, TEXT VAR word, INT VAR pointer,

+               INT CONST max length, TEXT CONST separator) :

+ 

+  INT VAR end of word := pos (record, separator, pointer+1) - 1 ;

+  IF end of word < 0

+    THEN end of word := pointer + max length

+  FI ;

+  word := subtext (record, pointer+1, end of word) ;

+  pointer := end of word + 1

+ 

+ENDPROC get word ;

+ 

+PROC close (FILE VAR file) :

+ 

+  file.mode := closed

+ 

+ENDPROC close ;

+ 

+PROC close :

+ 

+  disable stop ;

+  forget (scratch space) ;

+  scratch space := nilspace

+ 

+ENDPROC close ;

+ 

+INT PROC max page length (FILE CONST file) :

+  file.max page length

+ENDPROC max page length ;

+ 

+PROC max page length (FILE VAR file, INT CONST length) :

+  file.max page length := length

+ENDPROC max page length

+ 

+ 

+PROC read record (FILE CONST file, TEXT VAR record) : 

+ 

+  check mode (file, mod) ;

+  record := CONCR (file.f) (file.index).inhalt 

+ 

+ENDPROC read record ; 

+ 

+PROC write record (FILE VAR file, TEXT CONST record) : 

+ 

+  check mode (file, mod) ;

+  CONCR (file.f) (file.index).inhalt := record 

+ 

+ENDPROC write record ; 

+ 

+PROC forward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.index <> anker 

+    THEN file.index := CONCR (file.f) (file.index).nachfolger 

+    ELSE errorstop ("forward at eof") 

+  FI 

+ 

+ENDPROC forward ; 

+ 

+PROC backward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (file.index).vorgaenger ; 

+  IF file.index = anker 

+    THEN to first record (file) ; 

+         errorstop ("backward at first record") 

+  FI 

+ 

+ENDPROC backward ; 

+ 

+PROC delete record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz loeschen (CONCR (file.f), file.index) 

+ 

+ENDPROC delete record ; 

+ 

+PROC insert record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz erzeugen (CONCR (file.f), file.index) 

+ 

+ENDPROC insert record ; 

+ 

+PROC to first record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC to first record ; 

+ 

+PROC to eof (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := anker 

+ 

+ENDPROC to eof ; 

+ 

+BOOL PROC is first record (FILE CONST file) : 

+ 

+  file.index = CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC is first record ; 

+ 

+PROC reset edit status (FILE VAR file) :

+ 

+  replace (zustand, 1, nullzustand) ;

+  file.edit status unchanged := FALSE .

+ 

+zustand :  CONCR (file.f)(freianker).inhalt .

+ 

+ENDPROC reset edit status ;

+ 

+ 

+FILE VAR scratch , file ;

+TEXT VAR record ;

+ 

+LET esc = ""27"" ;

+ 

+PROC reorganize (TEXT CONST file name) :

+ 

+  IF exists (file name)

+    THEN last param (file name) ;

+         reorganize file

+    ELSE errorstop ("file does not exist")

+  FI .

+ 

+reorganize file :

+  scratch := sequential file (output) ;

+  headline (scratch, file name) ;

+  IF format 15

+    THEN set to 16 file type ; 

+         file := sequential file (input, file name)

+    ELSE file := sequential file (input, file name) ;

+         copy attributes (file, scratch) 

+  FI ;

+ 

+  disable stop ;

+

+  INT VAR counter := 0 ;

+  WHILE NOT eof (file) REP

+    getline (file, record) ;

+    putline (scratch, record) ;

+    counter INCR 1 ;

+    cout (counter) ;

+    IF is incharety (escape) OR is error

+      THEN close ;

+           LEAVE reorganize

+    FI

+  PER ;

+  forget file ;

+  copy (scratch space, file name) ;

+  close .

+ 

+forget file :

+  BOOL CONST old status := command dialogue ;

+  command dialogue (FALSE) ;

+  forget (file name) ;

+  command dialogue (old status) .

+ 

+format 15 :  type (old (file name)) = 1001 .

+

+set to 16 file type :

+  type (old (file name), 1002) .

+

+ENDPROC reorganize ;

+ 

+PROC reorganize :

+ 

+  reorganize (last param)

+ 

+ENDPROC reorganize ;

+ 

+PROC feldout (FILE CONST file, TEXT CONST satz) :

+ 

+  feldout ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldout ;

+ 

+PROC feldeinruecken (FILE CONST file, TEXT CONST satz) :

+ 

+  feldeinruecken ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeinruecken ;

+ 

+PROC feldeditor (FILE VAR file, TEXT CONST satz) :

+ 

+  feldeditor ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeditor ;

+ 

+INT PROC pos (FILE CONST file, TEXT CONST pattern, INT CONST from) :

+ 

+  pos ( CONCR (file.f) (file.index).inhalt, pattern, from )

+ 

+ENDPROC pos ;

+ 

+PROC change (FILE VAR file, INT CONST from, to, TEXT CONST new) :

+ 

+  change ( CONCR (file.f) (file.index).inhalt, from, to, new )

+ 

+ENDPROC change ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from, to) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from, to ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+(*  sortieren sequentieller Dateien                  Autor: P.Heyderhoff *) 

+                                                  (* Stand: 14.11.80     *) 

+ 

+BOUND DATEI VAR datei; 

+INT  VAR sortierstelle, sortanker, byte;

+TEXT VAR median, tausch ;

+ 

+PROC sort (TEXT CONST dateiname) : 

+     sortierstelle := feldanfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : 

+     sortierstelle := sortieranfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, feldname) :

+     IF   exists (dateiname)

+     THEN datei := old (dateiname); 

+          IF   CONCR(datei) (freianker).nachfolger <> freianker 

+          THEN reorganize (dateiname) 

+          FI ; 

+          sortanker := 3;

+          IF   feldname = ""

+          THEN byte := 0

+          ELSE feldname in feldnummer uebersetzen

+          FI;

+          quicksort(sortanker, CONCR(datei)(freianker).fortsetzung-1) 

+     FI .

+feldname in feldnummer uebersetzen :

+    byte := pos (CONCR(datei) (sortanker).inhalt, feldname);

+    IF   byte > 0

+    THEN byte := pos (CONCR(datei) (sortanker).inhalt, code(255-byte))

+    FI;

+    IF   byte = 0 

+    THEN errorstop ("sort: feldname"); LEAVE sort

+    FI ; sortanker INCR 1 .

+ END PROC sort; 

+ 

+PROC quicksort ( INT CONST anfang, ende ) : 

+     IF   anfang < ende 

+     THEN INT VAR p,q; 

+          spalte    (anfang, ende, p, q); 

+          quicksort (anfang, q); 

+          quicksort (p, ende)    FI 

+ END PROC quicksort; 

+ 

+PROC spalte (INT CONST anfang, ende, INT VAR p, q): 

+     fange an der seite an und waehle den median; 

+     ruecke p und q so dicht wie moeglich zusammen; 

+     hole ggf median in die mitte . 

+ 

+   fange an der seite an und waehle den median : 

+     p := anfang; q := ende ; 

+     INT CONST m :: (p + q) DIV 2 ; 

+     median := subtext(datei m, merkmal m) . 

+ 

+   ruecke p und q so dicht wie moeglich zusammen : 

+     REP schiebe p und q so weit wie moeglich auf bzw ab; 

+         IF p < q THEN vertausche die beiden FI 

+     UNTIL p > q END REP . 

+ 

+   vertausche die beiden : 

+     tausch := datei p; datei p := datei q; datei q := tausch; 

+     p INCR 1; q DECR 1 . 

+ 

+   schiebe p und q so weit wie moeglich auf bzw ab : 

+     WHILE p kann groesser werden REP p INCR 1 END REP; 

+     WHILE q kann kleiner  werden REP q DECR 1 END REP . 

+ 

+   p kann groesser werden : 

+     IF p <= ende THEN subtext (datei p, merkmal p) <= median ELSE FALSE FI . 

+ 

+   q kann kleiner werden : 

+     IF q >= anfang THEN subtext(datei q,merkmal q) >= median ELSE FALSE FI . 

+ 

+   hole ggf median in die mitte : 

+     IF   m < q THEN vertausche m und q 

+     ELIF m > p THEN vertausche m und p FI . 

+ 

+   vertausche m und q : 

+     tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . 

+ 

+   vertausche m und p : 

+     tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . 

+ 

+   merkmal m :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei m SUB byte) FI .

+ 

+   merkmal p :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei p SUB byte) FI .

+ 

+   merkmal q :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei q SUB byte) FI .

+ 

+   datei m :  CONCR(datei)(m).inhalt . 

+   datei p :  CONCR(datei)(p).inhalt . 

+   datei q :  CONCR(datei)(q).inhalt . 

+ 

+END PROC spalte; 

+ 

+ 

+(*********** schrott ************)

+ 

+OP := (FILE VAR a, FILE CONST b) :

+  EXTERNAL 294

+ENDOP := ;

+ 

+PROC becomes (ROW 8 INT VAR a, b) :

+  INTERNAL 294 ;

+  a := b

+ENDPROC becomes ;

+ 

+PROC datei initialisieren (DATEI VAR datei) : 

+  EXTERNAL 290 ;

+END  PROC datei initialisieren; 

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+ENDPACKET file ;

diff --git a/system/base/unknown/src/init b/system/base/unknown/src/init
new file mode 100644
index 0000000..02b8e74
--- /dev/null
+++ b/system/base/unknown/src/init
@@ -0,0 +1,250 @@
+ " Compiler Error : " 

+"              "

+"               |" 

+" Fehler entdeckt  " 

+"Keine Fehler gefunden,  "

+" Sekunden CPU-Zeit verbraucht"

+"       *******  ENDE DER UEBERSETZUNG  *******" 

+"FEHLER bei >> " 

+" <<  " 

+"weiter bei "

+"   ("      ")  " 

+"EOF im Programm" 

+"EOF beim Skippen" 

+"EOF im TEXT Denoter" 

+"EOF im Kommentar" 

+"' nach Bold fehlt"

+"das MAIN PACKET muss das letzte sein" 

+"ungueltiger Name fuer ein Interface Objekt" 

+"':' fehlt"

+"nach ENDPACKET folgt nicht der Paketname" 

+"ENDPACKET fehlt" 

+"CONST oder VAR fehlt" 

+"ungueltiger Name"

+" ',' in Deklarationsliste fehlt"

+"ist nicht der PROC Name"

+"fehlerhaftes Endes des MAIN PACKET" 

+"ENDPROC fehlt" 

+"PROC/OP Schachtelung unzulaessig" 

+"OP darf kein Parameter sein"

+"steht mehrfach im PACKET Interface" 

+"Mehrfachdeklaration" 

+"ist schon als Datenobjekt deklariert"

+"ist schon als PROC/OP deklariert" 

+"')' nach Parameterliste erwartet" 

+"Standard-Schluesselwort kann nicht redefiniert werden"

+"ungueltig als BOLD" 

+"'(' fehlt"

+"CONST bzw VAR nicht bei Strukturfeldern" 

+"'=' fehlt" 

+"Schluesselwort wird im Paket schon andersartig verwandt"

+"Dieser Typ ist schon definiert" 

+"ungueltiger Deklarierer" 

+"ungueltiger OP Name"

+"OP muss monadisch oder dyadisch sein" 

+"ist nicht der OP Name" 

+"ENDOP fehlt" 

+"Name nach ENDPROC fehlt" 

+"Name nach ENDOP fehlt" 

+"END END ist Unsinn"

+"Diese END... kenne ich nicht"

+"ROW Groesse ist kein INT" 

+"ROW Groesse ist kein Denoter"

+"Ein ROW muss mindestens ein Element haben"

+"ROW Groesse fehlt" 

+"Parameter kann man nicht initialisieren"

+"Konstanten muessen initialisert werden"

+"'::' verwenden"

+"')' fehlt" 

+"Nachkommastellen fehlen" 

+"Exponent fehlt"

+"Undefinierter Typ" 

+"Rekursiv definierter Typ" 

+"Mehrfach definierter Selektor" 

+"VARs koennen aus dem Paket nicht herausgereicht werden" 

+"NO SHORTHAND DECLARATION IN THIS SCOPE FOR ROW SIZE DENOTER."

+"Typ Deklarationen nur im Paketrumpf" 

+"CONST bzw. VAR ohne Zusammenhang" 

+"ist nicht deklariert, steht aber in der Paket-Schnittstelle" 

+"ist nicht deklariert"

+"Typ ist schon deklariert" 

+"THIS IS NO CORRECT EXTERNAL NUMBER." 

+" EXTERNAL und INTERNAL unzulaessig"

+"Name erwartet" 

+"Denoter erwartet"

+"ENDPROC ohne Zusammenhang"

+"ENDOP ohne Zusammenhang"

+"Refinement ohne Zusammenhang"

+"Delimiter zwischen Paket-Refinement und Deklaration fehlt"

+"unzulaessiges Selektor-Symbol (kein Name)"

+"BOUND Schachtelungen unzulaessig"

+"Textende fehlt" 

+

+"Denoter-Wert wird fuer diese Maschine zu gross" 

+"NOBODY SHOULD EVER WRITE THAT, Uli ! " 

+"ist ein zusammenhangloses Schluesselwort"

+"'::' nur fuer Initialisierungen, sonst ':='"

+"welches Objekt soll verlassen werden?"

+"du bist gar nicht innerhalb dieses Refinements"

+"nur die eigene PROC / OP kann verlassen werden"

+"THEN fehlt"

+"FI fehlt"

+"BOOL - Ausdruck erwartet" 

+"ELSE - Teil ist notwendig, da ein Wert geliefert wird"

+"Mit ELIF kann kein IF-Statement beginnen"

+"INT - Ausdruck erwartet"

+"OF fehlt"

+"Keine Typanpassung moeglich"

+"CASE - Label fehlt"

+"CASE - Label ist zu gross (skipped)" 

+"mehrfach definiertes CASE-Label"

+"ungueltiges Zeichen nach CASE-Label" 

+" OTHERWISE PART fehlt"

+"END SELECT fehlt" 

+"DEAR USER, PLEASE BE REMINDED OF NOT CALLING REFINEMENTS RECURSIVLY !"

+"Dieses Refinement wird nicht benutzt" 

+"Zwischen diesen Symbolen fehlt ein Operator oder ein ';'"

+"undefinierter monadischer Operator" 

+"undefinierter dyadischer Operator" 

+"Operator vor '(' fehlt" 

+"kann nicht redefiniert werden" 

+"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" 

+"fuer diesen Typ nicht definierter Selektor" 

+"Primitive Typen koennen nicht selektiert werden"

+"bei ROWs nur Subscription"

+"ungueltiger Selectand" 

+"unzulaessiger Index fuer Subscription"

+"'[' ohne Zusammenhang"

+"']' ohne Zusammenhang"

+"']' nach Subscription fehlt"

+"',' ungueltig zwischen UNITs"

+"':' ungueltig zwischen UNITs"

+"';' fehlt"

+"nur die letzte UNIT einer SECTION darf einen Wert liefern"

+"Der Paketrumpf kann keinen Wert liefern" 

+"anstelle des letzten Symbols wurde ein Operand erwartet" 

+"Der Schleifenrumpf darf keinen Wert liefern"

+"INT VAR erwartet"

+"wird schon in einer aeusseren Schleife als Laufvariable benutzt"

+"FROM erwartet"

+"UPTO bzw DOWNTO fehlt"

+"REPEAT fehlt"

+"END REP fehlt"

+"UNTIL ohne Zusammenhang"

+"Die Konstante darf nicht mit ':=' veraendert werden"

+"In einer FOR-Schleife darf die Laufvariable nicht veraendert werden"

+"falscher Typ des Resultats" 

+"ist CONST, es wird aber ein VAR Parameter verlangt"

+"unbekannte Prozedur"

+"Parameter-Prozedur liefert falsches Resultat" 

+"Es gibt keine Prozedur mit diesen Parametern"

+"unbekannte Parameter-Prozedur" 

+"VIRTUAL PARAM MODE INCONSISTENCE" 

+"INCONSISTENCE BETWEEN THE PARAMETERS OF THE ACTUAL AND THE FORMAL PARAM PROC

+EDURE "

+"nicht deklariertes Objekt"

+"THIS OBJECT IS USED OUTSIDE IT'S RANGE"

+"Kein TYPE DISPLAY moeglich, da die Feinstruktur hier unbekannt ist"

+"zu wenig Felder angegeben"

+"zu viele Felder angegeben"

+"unzulaessiger Trenner zwischen Feldern"

+"Dies Feld hat einen falschen Typ"

+"THIS ROW DISPLAY DOES NOT HAVE THE CORRECT NUMBER OF ELEMENTS." 

+"Dieser Typ kann nicht noch mehr konkretisiert werden"

+

+"Warnung in Zeile"

+"   Zeile "

+"in Zeile "

+"<----+--->" 

+" TYPE undefiniert "

+" MODE undefiniert "

+"Parameter spezifiziert "

+"Parameter Typ(en) sind "

+" B Code, "

+" B Paketdaten generiert"

+"Operandentyp"

+"Typ des linken Operanden "

+"Typ des rechten Operanden "

+"erwartet "

+"gefunden "

+ "NULL   1TEST   1NOT    2INCR   1DECR 

+ 1MOV2   2MOV8   2MOVS   2EQI    2LSEQI

+ 2EQR    2LSEQR  2COMPLI 2COMPLR 2ADDI 

+ 3SUBI   3MULTI  3DIVI   3ADDR   3SUBR 

+ 3MULTR  3DIVR   3AND    2OR     2BRANCH

+8BTRUE  8BFALSE 8ACCDS  2ALIAS  5RETURN

+0MOVE   3CASE   3SUBS   5SUBS2  4SUBS8

+ 4SUBS16 4SEL    3BSTL   6ESTL   7HEAD 

+ 1PACKET 1BOOL   1NBOOL  1" 

+ 

+(*000  *)    END    INTERNAL   BOUND 

+(*001  *)    PACKET 

+(*002  *)    ENDPACKET 

+(*003  *)    DEFINES 

+(*003 A*)    LET 

+(*004  *)    PROCEDURE 

+(*005  *)    PROC 

+(*006  *)    ENDPROC 

+(*006A *)    ENDPROCEDURE 

+(*007  *)    OPERATOR 

+(*008  *)    OP 

+(*009  *)    ENDOP 

+(*009A *)    ENDOPERATOR 

+(*010  *)    TYPE 

+(*011  *)    INT 

+(*012  *)    REAL 

+(*013  *)    DATASPACE 

+(*015  *)    TEXT 

+(*016  *)    BOOL 

+(*017  *)    CONST 

+(*018  *)    VAR 

+(* INIT CONTROL *)  INTERNAL 

+(*019  *)    ROW 

+(*0191 *)    STRUCT CONCR 

+(*0193*)   ACTUAL 

+(*020  *)    REP 

+(*020A *)    REPEAT 

+(*021  *)    ENDREP 

+(*021A *)    ENDREPEAT PER 

+(*022  *)    SELECT 

+(*023  *)    ENDSELECT 

+(*0235 *)    EXTERNAL 

+(*024 *)     IF    (*024A *)   ENDIF 

+(*021  *)     THEN 

+(*022  *)     ELIF 

+(*023  *)     ELSE 

+(*024  *)     FI 

+(*026  *)     OF 

+(*026A *)     CASE 

+(*027  *)     OTHERWISE 

+(*029  *)     FOR 

+(*030  *)     FROM 

+(*031  *)     UPTO 

+(*032  *)     DOWNTO 

+(*034  *)     UNTIL 

+(*035  *)     WHILE 

+(*036  *)     LEAVE   WITH 

+(*0361 *)     TRUE 

+(*362 *)    FALSE 

+(*038  *)     :: SBL = := INCR DECR 

+(*039  *)     + - * / DIV MOD ** AND CAND OR COR NOT   <> > >= < <= 

+(*040  *)     MAIN 

+(*043*)  ENDOFFILE 

+ 

+PACKET a :

+

+PROC out (TEXT CONST t) :

+  EXTERNAL 60

+ENDPROC out ;

+

+PROC out text (TEXT CONST t, INT CONST typ) :

+  INTERNAL 257 ;

+  out (t)

+ENDPROC out text ;

+

+PROC out line (INT CONST typ) :

+  INTERNAL 258 ;

+  out (""13""10"")

+ENDPROC out line ;

+

+ENDPACKET a ; 

diff --git a/system/base/unknown/src/integer b/system/base/unknown/src/integer
new file mode 100644
index 0000000..0e1d19d
--- /dev/null
+++ b/system/base/unknown/src/integer
@@ -0,0 +1,134 @@
+ 

+PACKET integer DEFINES 

+               sign, SIGN, abs, ABS, **, min, max, maxint,

+               get, random, initialize random :

+ 

+INT PROC maxint : 32767 ENDPROC maxint ;

+ 

+INT PROC sign (INT CONST argument) : 

+ 

+  IF argument < 0 THEN -1 

+  ELIF argument > 0 THEN 1 

+  ELSE 0 

+  FI 

+ 

+ENDPROC sign ; 

+ 

+INT OP SIGN (INT CONST argument) : 

+  sign (argument) 

+ENDOP SIGN ;

+ 

+INT PROC abs (INT CONST argument) : 

+ 

+  IF argument > 0 THEN argument 

+  ELSE - argument 

+  FI 

+ 

+ENDPROC abs ;

+ 

+INT OP ABS (INT CONST argument) : 

+  abs (argument) 

+ENDOP ABS ;

+ 

+INT OP ** (INT CONST arg, exp) : 

+ 

+  INT VAR x := arg , z := 1 ,

+          counter := exp ;

+ 

+  IF exp < 0 THEN errorstop ("INT OP ** : negative exponent") FI ;

+  IF arg = 0 AND exp = 0 

+    THEN errorstop (" 0 ** 0 is not defined") 

+  FI ;

+  IF exp = 0 THEN x := 1 FI ;

+ 

+  WHILE counter >= 2 REP 

+    calculate new x and z ;

+    counter := counter DIV 2 ;

+  ENDREP ;

+  z * x . 

+ 

+calculate new x and z : 

+  IF counter is not even 

+    THEN z := z * x 

+  FI ;

+  x := x * x . 

+ 

+counter is not even : 

+  counter MOD 2 = 1 . 

+ 

+ENDOP ** ;

+ 

+INT PROC min (INT CONST first, second) : 

+ 

+  IF first < second THEN first ELSE second FI 

+ 

+ENDPROC min ;

+ 

+INT PROC max (INT CONST first, second) : 

+ 

+  IF first > second THEN first ELSE second FI 

+ 

+ENDPROC max ; 

+ 

+ 

+PROC get (INT VAR number) :

+ 

+  get (word) ;

+  number := int (word) 

+ 

+ENDPROC get ;

+ 

+TEXT VAR word := "" ;

+ 

+ 

+ 

+(************************************************)

+(***                                          ***)

+(***          generator     32 650            ***)

+(***                                          ***)

+(************************************************)

+ 

+(*  INT-Zufallsgenerator mit Periode 32650      *)  (*Autor: Bake    *)

+                                                    (*Gymnasium Aspe *)

+ 

+INT VAR   z1 ::  14,   (* fuer den generator mit periode   25 *)

+          z2 :: 345;   (* fuer den generator mit periode 1306 *)

+ 

+ 

+     INT PROCEDURE   random   (INT CONST ugrenze, ogrenze) :

+   (*******************************************************)

+ 

+generator 25;

+generator 1306;

+(zufallszahl MOD intervallgroesse) + ugrenze.

+ 

+(* Durch MOD wird bei grosser 'intervallgroesse' der vordere

+   Bereich doppelt ueberdeckt, also keine Gleichverteilung. heinrichs 

+   24.04.81 *)

+

+

+     generator 25 :

+z1 := (11 * z1 + 18) MOD 25

+(* erster generator. liefert alle zahlen zwischen 0 und 24. *).

+ 

+     generator 1306 :

+z2 := (24 * z2 + 23) MOD 1307

+(* zweiter generator. liefert alle zahlen zwischen 0 und 1305. *).

+ 

+     zufallszahl : 

+z1 + z2 * 25  (* diese zahl liegt zwischen 0 und 32 649 *).

+ 

+     intervallgroesse :   ogrenze - ugrenze + 1

+ 

+END PROC   random ;

+ 

+ 

+  PROCEDURE   initialize random   (INT CONST wert) :

+(**************************************************)

+ 

+z1 := wert MOD 25;

+z2 := wert MOD 1306

+ 

+END PROC   initialize random ;

+ 

+ENDPACKET integer ; 

diff --git a/system/base/unknown/src/mathlib b/system/base/unknown/src/mathlib
new file mode 100644
index 0000000..be44ff6
--- /dev/null
+++ b/system/base/unknown/src/mathlib
@@ -0,0 +1,359 @@
+ 

+PACKET mathlib DEFINES sqrt,**,exp,ln,log2,log10,sin,cos, 

+                       tan,arctan,sind,cosd,tand,arctand,e,pi,

+                       random,initializerandom :

+ 

+ 

+REAL VAR rdg::0.4711; 

+ 

+REAL PROC pi: 

+   3.141592653589793. 

+END PROC pi; 

+ 

+REAL PROC e: 

+  2.718281828459045. 

+END PROC e; 

+ 

+REAL PROC ln(REAL CONST x): 

+LET ln2= 0.6931471805599453; 

+log2(x)*ln2. 

+END PROC ln; 

+ 

+REAL PROC log2(REAL CONST z): 

+INT VAR k::0,p::0; 

+REAL VAR m::0.0,x::z,t::0.0,summe::0.0; 

+IF   x>0.0 

+THEN normal 

+ELSE errorstop("log2 mit negativer zahl");4711.4711 

+FI. 

+normal: 

+ IF   x>=0.5 

+ THEN normalise downwards 

+ ELSE normalise upwards 

+  FI; 

+  IF   x>=0.1 AND x< 0.7071067811865475 THEN 

+       t:=(x-0.5946035575013605)/(x+0.5946035575013605); 

+       summe:=reihenentwicklung (t) - 0.75 

+  FI; 

+  IF  x>=0.7071067811865475 AND x < 1.0 THEN 

+      t:=(x - 0.8408964152537145)/(x+0.8408964152537145); 

+      summe:= reihenentwicklung(t)-0.25 

+  FI; 

+  summe-real(p - 4*k). 

+ 

+ normalise downwards: 

+  WHILE  x>= 16.0 REP 

+    x:=x/16.0;k:=k+1; 

+  END REP; 

+  WHILE  x>=0.5 REP 

+    x:=x/2.0;p:=p-1; 

+  END REP. 

+ 

+ normalise upwards: 

+  WHILE x<=0.0625 REP 

+    x:=x*16.0;k:=k-1; 

+  END REP; 

+  WHILE x<= 0.5 REP 

+    x:=x*2.0;p:=p+1; 

+  END REP. 

+ 

+END PROC log2; 

+ 

+REAL PROC reihenentwicklung(REAL CONST x):

+  REAL VAR i::39.0,s::1.0/39.0; 

+  LET ln2=0.6931471805599453; 

+  WHILE i>1.0 REP 

+    i:=i-2.0;s:=s*x*x + 1.0/i; 

+  END REP; 

+  s*2.0*x/ln2. 

+END PROC reihenentwicklung; 

+ 

+REAL PROC log10(REAL CONST x): 

+  LET lg2=0.301029995664; 

+  log2(x)*lg2. 

+END PROC log10; 

+ 

+REAL PROC sqrt(REAL CONST z): 

+  REAL VAR y0,y1,x::z; 

+  INT VAR p::0; 

+  BOOL VAR q::FALSE; 

+  IF   x<0.0 

+  THEN errorstop("sqrt von negativer zahl");0.0

+  ELSE correct 

+  FI. 

+ 

+ correct: 

+  IF   x=0.0 

+  THEN 0.0 

+  ELSE nontrivial 

+  FI. 

+ 

+ nontrivial: 

+  IF   x<0.01 

+  THEN small 

+  ELSE notsmall 

+  FI. 

+ 

+ 

+ notsmall: 

+  IF   x>1.0 

+  THEN big 

+  ELSE normal 

+  FI. 

+ 

+ small: 

+  WHILE x<0.01 REP 

+    p:=p-1;x:=x*100.0; 

+  END REP; 

+  normal. 

+ 

+ big: 

+  WHILE x>=1.0 REP

+    p:=p+1;x:=x/100.0; 

+  END REP; 

+  normal. 

+ 

+ normal: 

+  IF   x<0.1 

+  THEN x:=x*10.0;q:=TRUE 

+  FI; 

+  y0:=10.0**p*(1.681595-1.288973/(0.8408065+x)); 

+  IF   q 

+  THEN y0:=y0/3.162278 

+  FI; 

+  y1:=(y0+z/y0)/2.0; 

+  y0:=(y1+z/y1)/2.0; 

+  y1:=(y0+z/y0)/2.0; 

+  (y1-z/y1)/2.0+z/y1. 

+ 

+END PROC sqrt; 

+ 

+REAL PROC exp(REAL CONST z): 

+  REAL VAR c,d,x::z, a, b ; 

+  IF   x<-180.2187 

+  THEN 0.0 

+  ELIF x<0.0 

+  THEN 1.0/exp(-x) 

+  ELIF x=0.0 

+  THEN 1.0 

+  ELSE x:=x/0.6931471805599453;approx 

+  FI. 

+ 

+ approx: 

+  a:=floor(x/4.0)+1.0; 

+  b:=floor(4.0*a-x); 

+  c:=(4.0*a-b-x)*16.0; 

+  d:=(c -floor(c))/16.0; 

+  d:=d*0.6931471805599453; 

+  ( (16.0 POWER a) / (2.0 POWER b) / (1.044273782427419 POWER c ))* 

+  ((((((0.135910788320380e-2*d-0.8331563191293753e-2)*d 

+  +0.4166661437490328e-1)*d-0.1666666658727157)*d+0.4999999999942539)*d 

+  - 0.9999999999999844)*d+1.0). 

+ 

+ENDPROC exp ; 

+ 

+REAL OP POWER (REAL CONST basis, exponent) : 

+ 

+  IF floor (exponent) = 0.0 

+    THEN 1.0 

+    ELSE power 

+  FI . 

+ 

+power : 

+  REAL VAR counter := floor (abs (exponent)) - 1.0 , 

+           result  := basis ; 

+  WHILE counter > 0.0 REP 

+    result := result * basis ; 

+    counter := counter - 1.0 

+  PER ; 

+  IF exponent > 0.0 

+    THEN result 

+    ELSE 1.0 / result 

+  FI . 

+ 

+ENDOP POWER ; 

+ 

+REAL PROC tan (REAL CONST x): 

+  REAL VAR p; 

+  p:=1.273239544735168*ABSx; 

+  tg(p)*sign(x). 

+END PROC tan; 

+ 

+REAL PROC tand(REAL CONST x): 

+  REAL VAR p; 

+  p:=0.02222222222222222*ABSx; 

+  tg(p)*sign(x). 

+END PROC tand; 

+ 

+REAL PROC tg(REAL CONST x): 

+  REAL VAR r,s,u,q; 

+  q:=floor(x);r:=x-q; 

+  IF q = floor(q/2.0) * 2.0 

+  THEN s:=r 

+  ELSE s:=(1.0-r) 

+  FI; 

+  q:= q - floor(q/4.0) * 4.0 ; 

+  u:=s*s; 

+  s:=s*0.785398163397448; 

+  s:=s/(((((((((-0.4018243865271481e-10*u-0.4404768172667185e-9)*u- 

+  0.748183650813680e-8)*u-0.119216115119129e-6)*u-0.1909255769212821e-5)*u- 

+0.3064200638849133e-4)*u-0.4967495424202482e-3)*u-0.8455650263333471e-2)*u- 

+  0.2056167583560294)*u+1.0); 

+  IF   q=0.0 

+  THEN s 

+  ELIF q=3.0 

+  THEN -s 

+  ELIF q=1.0 

+  THEN 1.0/s 

+  ELSE -1.0/s 

+  FI . 

+ 

+END PROC tg;

+ 

+REAL PROC sin(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sin; 

+ 

+REAL PROC sind(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABSx/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sind; 

+ 

+ 

+REAL PROC cos(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cos; 

+ 

+REAL PROC cosd(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cosd; 

+ 

+ 

+REAL PROC sincos(INT VAR q,REAL VAR r): 

+  SELECT q MOD 8 + 1 OF 

+  CASE 1 : sin approx(r) 

+  CASE 2 : cos approx (1.0-r) 

+  CASE 3 : cos approx(r) 

+  CASE 4 : sin approx(1.0-r) 

+  CASE 5 : - sin approx(r) 

+  CASE 6 : - cos approx(1.0-r) 

+  CASE 7 : - cos approx(r) 

+  CASE 8 : - sin approx(1.0-r) 

+  OTHERWISE 0.0 

+  END SELECT 

+END PROC sincos; 

+ 

+REAL PROC sin approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.313361621667256

+8

+e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1 

+)*z+0.7853981633974483). 

+END PROC sin approx; 

+ 

+REAL PROC cos approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  (((((( -0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e

+-7)*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1

+)*z-0.3084251375340425)*z+1.0. 

+END PROC cos approx; 

+ 

+REAL PROC arctan(REAL CONST x): 

+REAL VAR z::x*x; 

+IF   x<0.0 THEN -arctan(-x) 

+ELIF x>1.0 THEN 3.141592653589792/2.0-arctan(1.0/x) 

+ELIF x*1.0e16>2.67949192431e15   THEN pi/6.0+arctan(1.732050807568877-4.0 

+/(x+1.732050807568877)) 

+ELSE  x/(((((((0.0107090276046822*z-0.01647757182108040)*z 

+      +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z 

+      -0.0888888888888888)*z+0.3333333333333333)*z+1.0)FI. 

+END PROC arctan; 

+ 

+REAL PROC arctand(REAL CONST x): 

+  arctan(x)/3.1415926589793*180.0. 

+END PROC arctand; 

+ 

+ 

+BOOL PROC even(INT CONST number): 

+ (number DIV 2)*2=number. 

+END PROC even; 

+ 

+REAL OP **(REAL CONST base,exponent): 

+  IF   base<0.0 

+  THEN errorstop("hoch mit negativer basis") 

+  FI; 

+  IF   base=0.0 

+  THEN test exponent 

+  ELSE

+      exp(exponent*ln(base)) 

+  FI. 

+ 

+ test exponent: 

+  IF   exponent=0.0 

+  THEN errorstop("0**0 geht nicht");4711.4711 

+  ELSE 0.0 

+  FI. 

+ 

+END OP **; 

+ 

+ 

+REAL PROC sign(REAL CONST number): 

+  IF   number >0.0  THEN 1.0 

+  ELIF number <0.0  THEN -1.0 

+  ELSE 0.0 

+  FI. 

+END PROC sign ;

+ 

+REAL OP **(REAL CONST a,INT CONST b): 

+REAL VAR p::1.0,r::a;INT VAR n::ABS b; 

+WHILE n>0 REP 

+  IF   n MOD 2=0 

+  THEN n:=n DIV 2;r:=r*r 

+  ELSE n DECR 1;p:=p*r 

+  FI; 

+END REP; 

+IF   b>0 

+THEN p 

+ELSE 1.0/p 

+FI. 

+END OP **; 

+ 

+ 

+ 

+REAL PROC random: 

+rdg:=rdg+pi;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg. 

+END PROC random; 

+ 

+ 

+PROC initializerandom(REAL CONST z): 

+ rdg:=z; 

+END PROC initializerandom; 

+ 

+END PACKET mathlib; 

diff --git a/system/base/unknown/src/real b/system/base/unknown/src/real
new file mode 100644
index 0000000..a2ab9c3
--- /dev/null
+++ b/system/base/unknown/src/real
@@ -0,0 +1,378 @@
+ 

+PACKET real DEFINES                            (* Autor: J.Liedtke *) 

+                                               (* Stand: 30.04.80  *) 

+   text , 

+   int ,

+   real ,

+   round ,

+   floor , 

+   frac ,

+   INCR ,

+   DECR ,

+   abs , 

+   ABS , 

+   sign ,

+   SIGN ,

+   MOD ,

+   min ,

+   max ,

+   put , 

+   get , 

+   max real ,

+   small real :

+

+LET mantissa length = 13 ;

+

+TEXT VAR mantissa ;

+

+ROW 10 REAL VAR real digit ;

+ 

+INT VAR i ; REAL VAR d := 0.0 ;

+FOR i FROM 1 UPTO 10 REP

+  real digit (i) := d ;

+  d := d + 1.0

+PER ;

+ 

+REAL PROC max real : 9.999999999999e126 ENDPROC max real ;

+ 

+REAL PROC small real : 1.0e-12 ENDPROC small real ;

+ 

+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :

+  EXTERNAL 96 

+ENDPROC sld ; 

+ 

+INT PROC decimal exponent (REAL CONST mantissa) : 

+  EXTERNAL 97 

+ENDPROC decimal exponent ; 

+ 

+PROC set exp (INT CONST exponent, REAL VAR number) : 

+  EXTERNAL 98 

+ENDPROC set exp ; 

+ 

+REAL PROC tenpower (INT CONST exponent) :

+  REAL VAR result := 1.0 ;

+  set exp (exponent, result) ;

+  result

+ENDPROC tenpower ;

+

+REAL PROC floor (REAL CONST real) : 

+  EXTERNAL 99 

+ENDPROC floor ; 

+ 

+REAL PROC round (REAL CONST real, INT CONST digits) : 

+ 

+  REAL VAR result := real ;

+  IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length)

+    THEN round result ;

+  FI ;

+  result .

+

+round result :

+  set exp (decimal exponent (result) + digits, result) ;

+  IF result >= 0.0

+    THEN result := floor (result + 0.5)

+    ELSE result := floor (result - 0.5)

+  FI ;

+  set exp (decimal exponent (result) - digits, result) .

+

+ENDPROC round ; 

+ 

+TEXT VAR result ;

+ 

+TEXT PROC text (REAL CONST real) : 

+ 

+  REAL VAR value := rounded to seven digits ; 

+  IF value = 0.0 

+    THEN "0.0" 

+    ELSE 

+      process sign ; 

+      get mantissa (value) ; 

+      INT CONST exponent := decimal exponent (value) ; 

+      get short mantissa ; 

+      IF exponent > 7 OR exponent < LENGTH short mantissa - 7 

+        THEN scientific notation 

+        ELSE short notation 

+      FI 

+    FI . 

+ 

+rounded to seven digits : 

+  round ( real * tenpower( -decimal exponent(real) ) , 6 ) 

+        * tenpower ( decimal exponent(real) ) . 

+ 

+process sign : 

+  IF value < 0.0 

+    THEN result := "-" ; 

+         value := - value 

+    ELSE result := "" 

+  FI . 

+ 

+get short mantissa : 

+  INT VAR i := 7 ; 

+  WHILE (mantissa SUB i) = "0" REP 

+    i DECR 1 

+  UNTIL i=1 END REP ; 

+  TEXT CONST short mantissa := subtext (mantissa, 1, i) . 

+ 

+scientific notation : 

+  result CAT (mantissa SUB 1) ; 

+  result CAT "." ; 

+  result CAT subtext (mantissa, 2, 7) ; 

+  result + "e" + text (exponent) . 

+ 

+short notation : 

+  result CAT subtext (short mantissa, 1, exponent+1) ; 

+  result CAT (exponent+1 - LENGTH short mantissa) * "0" ; 

+  result CAT "." ; 

+  IF exponent < 0 

+    THEN result + (-exponent-1) * "0" + short mantissa 

+    ELSE result + subtext (short mantissa, exponent+2) 

+  FI . 

+ 

+ENDPROC text ; 

+ 

+PROC get mantissa (REAL CONST number) :

+

+  REAL VAR real mantissa := number ;

+  mantissa := "" ;

+  INT VAR i , digit ;

+  FOR i FROM 1 UPTO mantissa length REP

+    sld (0, real mantissa, digit) ;

+    mantissa CAT code (digit + 48)

+  PER ;

+

+ENDPROC get mantissa ;

+

+PROC put (REAL CONST real) : 

+ 

+  put (text (real) ) 

+ 

+ENDPROC put ; 

+ 

+TEXT PROC text (REAL CONST real, INT CONST length, fracs) :

+ 

+  REAL VAR value := round (real, fracs) ;

+  INT VAR  exponent  := decimal exponent (value) ;

+           IF value = 0.0 THEN exponent := 0 FI ;

+  INT VAR  floors    := exponent + 1 ,

+           floor length := length - fracs - 1 ;

+           IF value < 0.0 THEN floor length DECR 1 FI ;

+ 

+  IF value too big

+    THEN length * "*"

+    ELSE transformed value

+  FI .

+ 

+transformed value :

+  process leading blanks and sign ;

+  get mantissa (value) ;

+  result CAT subtext (mantissa, 1, floors) ;

+  IF LENGTH mantissa < floors

+    THEN result CAT (floors - LENGTH mantissa) * "0"

+  FI ;

+  result CAT "." ;

+  IF exponent < 0

+    THEN result CAT (-floors) * "0" ;

+         result CAT subtext (mantissa, 1, length - LENGTH result)

+    ELSE result CAT subtext (mantissa, floors+1, floors + fracs)

+  FI ;

+  IF LENGTH result < length

+    THEN result CAT (length - LENGTH result) * "0"

+  FI ;

+  result .

+ 

+process leading blanks and sign :

+  result := (floor length - max(floors,0)) * " " ;

+  IF value < 0.0

+    THEN result CAT "-" ;

+         value := - value

+  FI .

+ 

+value too big :

+  floors > floor length .

+ 

+ENDPROC text ;

+ 

+REAL PROC real (TEXT CONST text) : 

+ 

+  skip leading blanks ;

+  sign ; 

+  mantissa part ; 

+  exponent ; 

+  check correct conversion ;

+  result . 

+ 

+skip leading blanks :

+  INT VAR pos := 1 ;

+  skip blanks .

+ 

+skip blanks :

+  WHILE (text SUB pos) = " " REP

+    pos INCR 1

+  PER .

+ 

+sign : 

+  BOOL VAR negative ; 

+  IF (text SUB pos) = "-" 

+    THEN negative := TRUE ; 

+         pos INCR 1

+  ELIF (text SUB pos) = "+" 

+    THEN negative := FALSE ; 

+         pos INCR 1

+  ELSE   negative := FALSE

+  FI . 

+ 

+mantissa part: 

+  REAL VAR value := 0.0 ; 

+  INT VAR exponent pos := 0 ;

+  WHILE pos <= LENGTH text REP 

+    TEXT VAR digit := text SUB pos ; 

+    IF digit <= "9" AND digit >= "0" 

+      THEN value := value * 10.0 + real digit (code (digit) - 47) ;

+           pos INCR 1 

+    ELIF digit = "." 

+      THEN pos INCR 1 ;

+           exponent pos := pos

+    ELSE LEAVE mantissa part 

+    FI 

+  END REP . 

+ 

+exponent : 

+  INT VAR exp ;

+  IF exponent pos > 0

+    THEN exp := exponent pos - pos

+    ELSE exp := 0

+  FI ;

+  IF (text SUB pos) = "e" 

+    THEN exp INCR int (subtext(text,pos+1)) 

+  FI . 

+ 

+check correct conversion :

+  skip blanks ;

+  IF pos > LENGTH text

+    THEN set conversion (TRUE)

+    ELSE set conversion (FALSE)

+  FI .

+ 

+result : 

+  value := value * tenpower (exp) ; 

+  IF negative 

+    THEN - value 

+    ELSE value 

+  FI . 

+ 

+ENDPROC real ; 

+ 

+TEXT VAR word ;

+ 

+PROC get (REAL VAR value) : 

+ 

+  get (word) ; 

+  value := real (word) 

+ 

+ENDPROC get ; 

+ 

+REAL PROC abs (REAL CONST value) : 

+ 

+  IF value >= 0.0 

+    THEN  value 

+    ELSE -value 

+  FI 

+ 

+ENDPROC abs ; 

+ 

+REAL OP ABS (REAL CONST value) : 

+ 

+  abs (value) 

+ 

+ENDOP ABS ; 

+ 

+INT PROC sign (REAL CONST value) :

+ 

+  IF   value < 0.0 THEN -1

+  ELIF value = 0.0 THEN  0

+  ELSE                   1

+  FI

+ 

+ENDPROC sign ;

+ 

+INT OP SIGN (REAL CONST value) :

+ 

+  sign (value)

+ 

+ENDOP SIGN ;

+ 

+REAL OP MOD (REAL CONST left, right) :

+ 

+  REAL VAR result := left - floor (left/right) * right ;

+  IF left < 0.0

+    THEN result + abs (right)

+    ELSE result

+  FI

+ 

+ENDOP MOD ;

+ 

+REAL PROC frac (REAL CONST value) :

+ 

+  value - floor (value)

+ 

+ENDPROC frac ;

+ 

+REAL PROC max (REAL CONST a, b) :

+ 

+  IF a > b THEN a ELSE b FI

+ 

+ENDPROC max ;

+ 

+REAL PROC min (REAL CONST a, b) :

+ 

+  IF a < b THEN a ELSE b FI

+ 

+ENDPROC min ;

+ 

+OP INCR (REAL VAR dest, REAL CONST increment) :

+ 

+  dest := dest + increment

+ 

+ENDOP INCR ;

+ 

+OP DECR (REAL VAR dest, REAL CONST decrement) : 

+ 

+  dest := dest - decrement

+ 

+ENDOP DECR ;

+ 

+INT PROC int (REAL CONST value) :

+ 

+  INT VAR result := 0, digit ,i ;

+  REAL VAR mantissa := value ;

+ 

+  FOR i FROM 0 UPTO decimal exponent (value) REP

+    sld (0, mantissa, digit) ;

+    result := result * 10 + digit 

+  PER ;

+ 

+  IF value < 0.0

+    THEN - result

+    ELSE   result

+  FI

+ 

+ENDPROC int ;

+ 

+REAL PROC real (INT CONST value) :

+ 

+  IF value < 0

+    THEN - real (-value)

+  ELIF value < 10

+    THEN real digit (value+1)

+    ELSE split value into head and last digit ;

+         real (head) * 10.0 + real digit (last digit+1)

+  FI .

+ 

+split value into head and last digit :

+  INT CONST

+  head := value DIV 10 ,

+  last digit := value - head * 10 .

+ 

+ENDPROC real ;

+ 

+ENDPACKET real ; 

diff --git a/system/base/unknown/src/scanner b/system/base/unknown/src/scanner
new file mode 100644
index 0000000..ed04699
--- /dev/null
+++ b/system/base/unknown/src/scanner
@@ -0,0 +1,255 @@
+ 

+PACKET scanner DEFINES                (* Autor: J.Liedtke        *)

+                                      (* Stand: 30.12.81         *)

+       scan , 

+       continue scan ,

+       next symbol , 

+       fix scanner ,

+       reset scanner :

+ 

+ 

+LET tag     = 1 ,

+    bold    = 2 , 

+    integer = 3 ,

+    text    = 4 ,

+    operator= 5 ,

+    delimiter = 6 , 

+    end of file = 7 , 

+    within comment = 8 ,

+    within text    = 9 ;

+ 

+ 

+TEXT VAR line := "" , 

+         char := "" ; 

+ 

+INT VAR  position  := 0 ,

+         reset position ,

+         comment depth ;

+BOOL VAR continue text ;

+ 

+ 

+PROC scan (TEXT CONST scan text) : 

+ 

+  comment depth := 0 ;

+  continue text := FALSE ;

+  continue scan (scan text)

+ 

+ENDPROC scan ;

+ 

+PROC continue scan (TEXT CONST scan text) :

+ 

+  line := scan text ;

+  position  := 0 ;

+  next non blank char ;

+  reset position := position

+ 

+ENDPROC continue scan ;

+

+PROC fix scanner :

+

+  reset position := position

+

+ENDPROC fix scanner ;

+

+PROC reset scanner :

+

+  position := reset position ;

+  char := line SUB position

+

+ENDPROC reset scanner ;

+ 

+PROC next symbol (TEXT VAR symbol) : 

+ 

+  INT VAR type ;

+  next symbol (symbol, type) 

+ 

+ENDPROC next symbol ;

+ 

+PROC next symbol (TEXT VAR symbol, INT VAR type) : 

+ 

+  skip blanks ;

+  symbol := "" ;

+  IF   is niltext THEN eof

+  ELIF is comment THEN process comment

+  ELIF is text THEN process text 

+  ELIF is lower case letter THEN process tag 

+  ELIF is upper case letter THEN process bold 

+  ELIF is digit THEN process integer

+  ELIF is delimiter THEN process delimiter

+  ELSE  process operator 

+  FI . 

+ 

+skip blanks : 

+  IF char = " " 

+    THEN next non blank char 

+  FI . 

+ 

+ 

+process comment :

+  read comment ;

+  IF comment depth = 0

+    THEN next symbol (symbol, type)

+    ELSE type := within comment

+  FI .

+ 

+process tag : 

+  type := tag ;

+  REP 

+    symbol CAT char ;

+    next non blank char 

+  UNTIL NOT (is lower case letter OR is digit) ENDREP .

+ 

+process bold : 

+  type := bold ;

+  REP 

+    symbol CAT char ; 

+    next char 

+  UNTIL NOT is upper case letter ENDREP .

+ 

+process integer :

+  type := integer ;

+  REP 

+    symbol CAT char ; 

+    next non blank char 

+  UNTIL NOT (is digit OR char = ".") ENDREP . 

+ 

+process text : 

+  type := text ;

+  IF continue text

+    THEN continue text := FALSE

+    ELSE next char

+  FI ;

+  WHILE not end of text REP 

+    symbol CAT char ;

+    next char 

+  ENDREP . 

+ 

+not end of text : 

+  IF is niltext 

+    THEN continue text := TRUE ; type := within text ; FALSE

+  ELIF is quote 

+    THEN end of text or exception

+  ELSE TRUE 

+  FI . 

+ 

+end of text or exception :

+  next char ;

+  IF is quote

+    THEN TRUE

+  ELIF is digit

+    THEN get special char ; TRUE

+  ELSE FALSE

+  FI .

+ 

+get special char :

+  TEXT VAR special symbol ;

+  next symbol (special symbol) ;

+  char := code ( int (special symbol ) ) .

+ 

+process delimiter : 

+  type := delimiter ;

+  symbol := char ;

+  next non blank char . 

+ 

+process operator : 

+  type := operator ; 

+  symbol := char ;

+  nextchar ;

+  IF symbol = ":" 

+    THEN IF char = "=" OR char = ":" 

+           THEN symbol := ":=" ;

+                nextchar 

+           ELSE type := delimiter 

+         FI 

+  ELIF is relational double char 

+    THEN symbol CAT char ;

+         nextchar 

+  ELIF symbol = "*" AND char = "*" 

+    THEN symbol := "**" ; 

+         next char 

+  FI .

+ 

+eof : 

+  type := end of file ;

+  symbol := "" .

+ 

+is lower case letter :  char lies in (97, 122) . 

+ 

+is upper case letter :  char lies in (65, 90) . 

+ 

+is digit :  char lies in (48, 57) . 

+ 

+is delimiter : pos ( "()[].,;" , char ) > 0 AND char <> "" . 

+ 

+is relational double char : 

+  TEXT VAR double := symbol + char ; 

+  double = "<>" OR double = "<=" OR double = ">=" . 

+ 

+is text : is quote OR continue text .

+ 

+is quote : char = """" .

+ 

+is niltext : char = "" . 

+ 

+is comment :

+  IF comment depth = 0

+    THEN char = "{" OR char = "(" AND ahead char = "*"

+    ELSE comment depth DECR 1 ; TRUE

+  FI .

+ 

+ENDPROC next symbol ;

+ 

+PROC next char : 

+ 

+  position INCR 1 ;

+  char := line SUB position

+ 

+ENDPROC next char ;

+ 

+PROC next non blank char : 

+ 

+  REP 

+   position INCR 1 

+  UNTIL (line SUB position) <> " " ENDREP ;

+  char := line SUB position

+ 

+ENDPROC next non blank char ; 

+ 

+TEXT PROC ahead char : 

+ 

+  line SUB position+1 

+ 

+ENDPROC ahead char ; 

+ 

+BOOL PROC char lies in (INT CONST lower bound, upper bound) : 

+ 

+  lower bound <= code(char) AND code(char) <= upper bound 

+ 

+ENDPROC char lies in ;

+ 

+PROC read comment : 

+ 

+  TEXT VAR last char ; 

+  comment depth INCR 1 ;

+  REP 

+    last char := char ; 

+    nextchar ; 

+    IF is begin comment

+      THEN read comment

+    FI ;

+    IF char = ""

+      THEN LEAVE read comment

+    FI

+  UNTIL is end comment PER ; 

+  comment depth DECR 1 ;

+  next nonblank char . 

+ 

+is end comment :

+  char = "}" OR char = ")" AND last char = "*" .

+ 

+is begin comment :

+  char = "{" OR char = "(" AND ahead char = "*" .

+ 

+ENDPROC read comment ;

+ 

+ENDPACKET scanner ;

diff --git a/system/base/unknown/src/stdescapeset b/system/base/unknown/src/stdescapeset
new file mode 100644
index 0000000..0c69ea7
--- /dev/null
+++ b/system/base/unknown/src/stdescapeset
@@ -0,0 +1,31 @@
+PACKET  std escape set                              (* Autor: P.Heyderhoff *)

+        (************)                              (* Stand: 20.01.1981   *)

+                                                    (* Vers.: 1.5.5        *)

+DEFINES std escape set :

+ 

+PROC std escape set : 

+ 

+  define escape ("p", "IFmark>0THEN PUT"""";W""""12""""FI") ;

+  define escape ("g", "GET"""";M0") ;

+  define escape ("d", "IFmark>0THEN PUT"""";M0ELSE GET"""";M0FI");

+  define escape ("B", "W""""194""""") ;

+  define escape ("A", "W""""193""""") ;

+  define escape ("O", "W""""207""""") ;

+  define escape ("U", "W""""213""""") ;

+  define escape ("a", "W""""225""""") ;

+  define escape ("o", "W""""239""""") ;

+  define escape ("u", "W""""245""""") ;

+  define escape ("z", "C1;""""C(((limit-len)/2)*"" "")") ;

+  define escape ("l", "i:=col;C1;M1;Ci;W""""12""""") ;

+  define escape ("h", "S11") ;

+  define escape ("v", "S23") ;

+  define escape ("1", "1;C1"); 

+  define escape ("9", "9999;C(len+1)");

+  define escape (""2"", """ """);

+  define escape (""10"","+1;R Clen;"" ""Ucol>lenE");

+  define escape (""3"", "R-1;Hrow;Clen;"" ""Ucol>lenE"); 

+  define escape (""8"", "COL(col-10)");

+ 

+ENDPROC std escape set ;

+ 

+ENDPACKET std escape set ; 

diff --git a/doc/dos/dos-dat-handbuch b/system/dos/1.8.7/doc/dos-dat-handbuch
index a1e4fd4..a1e4fd4 100644
--- a/doc/dos/dos-dat-handbuch
+++ b/system/dos/1.8.7/doc/dos-dat-handbuch
diff --git a/system/dos/1.8.7/source-disk b/system/dos/1.8.7/source-disk
new file mode 100644
index 0000000..cc5ebe0
--- /dev/null
+++ b/system/dos/1.8.7/source-disk
@@ -0,0 +1 @@
+187_ergos/04_dos.img
diff --git a/dos/block i-o b/system/dos/1.8.7/src/block i-o
index 554fcca..554fcca 100644
--- a/dos/block i-o
+++ b/system/dos/1.8.7/src/block i-o
diff --git a/system/dos/1.8.7/src/bpb ds b/system/dos/1.8.7/src/bpb ds
new file mode 100644
index 0000000..dabf721
--- /dev/null
+++ b/system/dos/1.8.7/src/bpb ds
diff --git a/dos/dir.dos b/system/dos/1.8.7/src/dir.dos
index 08456b5..08456b5 100644
--- a/dos/dir.dos
+++ b/system/dos/1.8.7/src/dir.dos
diff --git a/dos/disk descriptor.dos b/system/dos/1.8.7/src/disk descriptor.dos
index 0b0d7fc..0b0d7fc 100644
--- a/dos/disk descriptor.dos
+++ b/system/dos/1.8.7/src/disk descriptor.dos
diff --git a/dos/dos hd inserter b/system/dos/1.8.7/src/dos hd inserter
index 24be82b..24be82b 100644
--- a/dos/dos hd inserter
+++ b/system/dos/1.8.7/src/dos hd inserter
diff --git a/dos/dos inserter b/system/dos/1.8.7/src/dos inserter
index 2f70b28..2f70b28 100644
--- a/dos/dos inserter
+++ b/system/dos/1.8.7/src/dos inserter
diff --git a/dos/dump b/system/dos/1.8.7/src/dump
index 5138162..5138162 100644
--- a/dos/dump
+++ b/system/dos/1.8.7/src/dump
diff --git a/dos/eu disk descriptor b/system/dos/1.8.7/src/eu disk descriptor
index 5a61367..5a61367 100644
--- a/dos/eu disk descriptor
+++ b/system/dos/1.8.7/src/eu disk descriptor
diff --git a/dos/fat.dos b/system/dos/1.8.7/src/fat.dos
index 2890b1a..2890b1a 100644
--- a/dos/fat.dos
+++ b/system/dos/1.8.7/src/fat.dos
diff --git a/dos/fetch b/system/dos/1.8.7/src/fetch
index 7cb7571..7cb7571 100644
--- a/dos/fetch
+++ b/system/dos/1.8.7/src/fetch
diff --git a/dos/fetch save interface b/system/dos/1.8.7/src/fetch save interface
index 27b4925..27b4925 100644
--- a/dos/fetch save interface
+++ b/system/dos/1.8.7/src/fetch save interface
diff --git a/dos/get put interface.dos b/system/dos/1.8.7/src/get put interface.dos
index 1d6de92..1d6de92 100644
--- a/dos/get put interface.dos
+++ b/system/dos/1.8.7/src/get put interface.dos
diff --git a/dos/insert.dos b/system/dos/1.8.7/src/insert.dos
index 14f98cd..14f98cd 100644
--- a/dos/insert.dos
+++ b/system/dos/1.8.7/src/insert.dos
diff --git a/dos/konvert b/system/dos/1.8.7/src/konvert
index c5c4c43..c5c4c43 100644
--- a/dos/konvert
+++ b/system/dos/1.8.7/src/konvert
diff --git a/dos/manager-M.dos b/system/dos/1.8.7/src/manager-M.dos
index e27c513..e27c513 100644
--- a/dos/manager-M.dos
+++ b/system/dos/1.8.7/src/manager-M.dos
diff --git a/dos/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos
index 23885e6..23885e6 100644
--- a/dos/manager-S.dos
+++ b/system/dos/1.8.7/src/manager-S.dos
diff --git a/dos/name conversion.dos b/system/dos/1.8.7/src/name conversion.dos
index e72d838..e72d838 100644
--- a/dos/name conversion.dos
+++ b/system/dos/1.8.7/src/name conversion.dos
diff --git a/dos/open b/system/dos/1.8.7/src/open
index 518c4b8..518c4b8 100644
--- a/dos/open
+++ b/system/dos/1.8.7/src/open
diff --git a/dos/save b/system/dos/1.8.7/src/save
index 7e67e91..7e67e91 100644
--- a/dos/save
+++ b/system/dos/1.8.7/src/save
diff --git a/system/dos/1.8.7/src/shard interface b/system/dos/1.8.7/src/shard interface
new file mode 100644
index 0000000..20d9b76
--- /dev/null
+++ b/system/dos/1.8.7/src/shard interface
@@ -0,0 +1,20 @@
+; ';' in Spalte 1 kennzeichnet eine Kommentarzeile
+; alle Werte müssen durch Blanks getrennt werden
+;
+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen
+;                         negativ für seitenorientiertes Lesen
+;
+;size     heads   tracks    first sectors  last sector
+;=====================================================
+320        1       40         1              8
+360        1       40         1              9
+640       -2       40         1              8
+720       -2       40         1              9
+800        2       40         1             10
+1440      -2       80         1              9
+1600       2       80         1             10
+2400      -2       80         1             15
+1232       1       77         0             15
+2464      -2       77         0             15
+; END OF FILE
+
diff --git a/system/dos/1986/doc/DSKDOS.ELA b/system/dos/1986/doc/DSKDOS.ELA
new file mode 100644
index 0000000..69bc714
--- /dev/null
+++ b/system/dos/1986/doc/DSKDOS.ELA
@@ -0,0 +1,967 @@
+#type ("17.klein")# 

+prefix of extended fcb:

+

+ offset  size  name

+     -7     1     flag byte          255

+     -6     5     reserved

+     -1     1     attribute byte     2=hidden file, 4=system file

+

+normal fcb format:

+

+ offset  size  name

+      0     1     drive number       0=default (for open), 1=A, 2=B

+      1     8     filename           8 chars, left aligned and padded

+                                     (if necessary) with blanks

+      9     3     extension          3 chars, left aligned and padded

+                                     (if necessary) with blanks

+     12     2     current block      pointer to the block of 128 records

+                                     containing the current record

+                                     (0 after open)

+     14     2     record size        logical record size in bytes

+                                     (128 after open, changed eventually)

+     16     4     file size          file size in bytes (1. byte low)

+     20     2     date of last write 20:mmmddddd 21:yyyyyyym

+     22     2     time of last write 22:mmmsssss 23:hhhhhmmm

+     24     8     reserved

+     32     1     current record     pointer to one of the 128 records in

+                                     the block (not initialized by open)

+                                     must be set before sequential read/write

+     33     4     relative record    pointer to selected record

+                                     (counting from the beginning of file by 0)

+                                     not initialized by open

+                                     must be set before sequential read/write

+                                     record size less than

+                                     64 bytes: both words used

+                                     else only first 3 bytes

+

+fields of directory entry:

+

+ offset  size  name

+      0     8  filename           8 chars, left aligned and padded

+                                  (if necessary) with blanks

+                                  special use of first byte:

+                                  0  : end of allocated directory

+                                  229: free directory entry

+      8     3  extension          3 chars, left aligned and padded

+                                  (if necessary) with blanks

+     11     1  attributes          1: read only file

+                                   2: hidden file

+                                   4: system file

+                                   8: entry is the volume's id

+                                  16: entry is subdirectory's name

+                                  32: archive bit (set, when written to)

+     12    10  reserved

+     22     2  time of last write 22:mmmsssss 23:hhhhhmmm

+     24     2  date of last write 24:mmmddddd 25:yyyyyyym

+     26     2  reserved

+     28     4  file size          file size in bytes (1. byte low)

+

+directory structure:

+

+ - the root directory has a fixed number of entries

+ - entries that represent a subdirectory have a special attribute in their

+   entry set

+ - the subdirectories are themselves files which records are of the same type

+   as those in the root directory

+ - the number of entries in subdirectories are not limited

+ - the length of a path to a subdirectory is not limited

+

+application of the directory entry fields on subdirectory entries:

+

+ volume id    : present at root, only one entry has this attribute

+ directory    : the directory entry represents itself an directory

+ read only    : meaningless

+ archive      : meaningless

+ hidden/system: prevents directories from beeing found, function $3B

+                will still work

+

+ms-dos interrupts:

+

+ $20 : program terminate

+     call:

+           CS: segment address

+     terminates process, returns control to parent process,

+     file handles are closed, disk cache cleaned, file buffers flushed

+     programm terminate, alt-c and critical error addresses are restored

+     new programs should use function $4C

+ $21 : function request

+     call:

+           AH: function number

+           other registers dependent on function

+ $22 to $24 :

+     address locations for msdos use

+     can be changed by function $25

+ $22 : terminate address

+ $23 : alt-c exit address

+     address of an alt-c routine

+ $24 : fatal error abort address

+     address of the error handler

+     BP:SI can contain further information

+     not called if error occurs during absolute disk operations (int $25,$26)

+ $25 : absolute disk read

+     call:

+           AL: drive number

+           DS:BX: disk transfer address

+           CX: number of sectors

+           DX: beginning relative sector

+     return:

+             CF: 0=successful

+                 1=unsuccessful

+             AL: error code if unsuccessful

+ $26 : absolute disk write

+     call:

+           AL: drive number

+           DS:BX: disk transfer address

+           CX: number of sectors

+           DX: beginning relative sector

+     return:

+             CF: 0=successful

+                 1=unsuccessful

+             AL: error code if unsuccessful

+ $27 : terminate but stay resident

+     call:

+           CS:DX: first byte following the code

+     new programms should use function $31

+

+ms-dos function requests:

+

+ $00 : terminate program

+     call:

+           AH: $00

+           CS: segment of programm prefix

+ $01 : read keyboard and echo

+     call:

+           AH: $01

+     return:

+             AL: character typed

+     waits for input, echos and returns it

+     alt-c will call interrupt

+ $02 : display character

+     call:

+           AH: $02

+           DL: character to be displayed

+     alt-c will call interrupt

+ $03 : auxiliary input

+     call:

+           AH: $03

+     return:

+             AL: character from auxiliary device

+     waits for input, alt-c will call interrupt

+ $04 : auxiliary output

+     call:

+           AH: $04

+           DL: character to output

+     alt-c will call interrupt

+ $05 : print character

+     call:

+           AH: $05

+           DL: character for printer

+     alt-c will call interrupt

+ $06 : direct console i/o

+     call:

+           AH: $06

+           DL: $FF: check for keyboard input

+               otherwise: display DL on screen

+     return:

+             ZF: 0=no char available

+                 1=char was read

+             AL: char if read

+ $07 : direct konsole input

+     call:

+           AH: $07

+     return:

+             AL: character from keyboard

+     waits for character

+ $08 : read keyboard

+     call:

+           AH: $08

+     return:

+             AL: character from keyboard

+     waits for character, alt-c will call interrupt

+ $09 : display string

+     call:

+           AH: $09

+           DS:DX: string, ending with '$'

+ $0A : buffered keyboard input

+     call:

+           AH: $0A

+           DS:DX: input buffer

+                  byte 1: maximum number of chars in buffer (with CR)

+                       2: actual number of chars in buffer (set by function)

+                       3-n: must be at least as long as the max

+     waits for chars, allows editing, ignores overflow,

+     alt-c will call interrupt

+ $0B : check keyboard status

+     call:

+           AH: $0B

+     return:

+             AL:   0=no chars in type-ahead buffer

+                 255=chars available

+ $0C : flush buffer and read keyboard

+     call:

+           AH: $0C

+           AL: $01,$06,$07,$08 or $0A: corresponding function is called

+               other values: no further processing

+     return:

+             AL: 0=type ahead buffer was flushed, no processing performed

+ $0D : disk reset

+     call:

+           AH: $0D

+     all disk buffers are flushed, no directory updates performed

+ $0E : select disk

+     call:

+           AH: $0E

+           DL: drive number, 1=A, 2=B, ..

+     return:

+             AL: number of logical drives

+ $0F : open file

+     call:

+           AH: $0F

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     if drive code was 0, it is set to the default

+                     current block is set to 0

+                     record size is set to 128

+                     file size, time and date of last modification are set

+                     from directory

+                     the default record size must be set, if not 128

+                     before performing a sequential (random) operation,

+                     current record (relative record) field must be set

+                 255=no directory entry found

+

+ $10 : close file

+     call:

+           AH: $10

+           DS:DX: opened fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found

+ $11 : search for first entry

+     call:

+           AH: $11

+           DS:DX: unopened fcb

+     return:

+               0=directory entry found

+                 fcb (normal or extended) is created

+                 at the disk transfer address

+             255=no directory entry found

+     to search for hidden or system files, the fcb must be extended

+     see notes on search attributes

+ $12 : search for next entry

+     call:

+           AH: $12

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     fcb (normal or extended) is created

+                     at the disk transfer address

+                 255=no directory entry found

+     the fcb must be one used previously in a call to $11

+ $13 : delete file

+     call:

+           AH: $13

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found

+     deletes all files with matching names

+ $14 : sequential read

+     call:

+           AH: $14

+           DS:DX: opened fcb

+     return:

+             AL: 0=read completed successfully

+                 1=eof, no data in the record

+                 2=dta too small, not enough space to read without exceeding

+                   the segment boundaries, read cancelled

+                 3=eof, partial record was read and padded to the record

+                   length with zeros

+     the record pointed to by the current block and current record

+     is loaded to the disk transfer address and the fields are incremented

+ $15 : sequential write

+     call:

+           AH: $15

+           DS:DX: opened fcb

+     return:

+             AL: 0=write completed successfully

+                 1=disk full, write canceled

+                 2=dta too small to write one record without exceeding the

+                   segment boundaries, write canceled

+     the record pointed to by the current block and current record

+     are written from the disk transfer address and the fields are incremented

+ $16 : create file

+     call:

+           AH: $16

+           DS:DX: unopened fcb

+     return:

+             AL:   0=empty directory entry found

+                 255=no empty entry available and file didn't exist before

+     if the file does already exist, it is made a zero length file

+     else it is created if an empty entry is found

+ $17 : rename file

+     call:

+           AH: $17

+           DS:DX: modified fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found or destination already exists

+     the fcb must contain the search file name and another file name

+     at offset $11

+ $19 : current disk

+     call:

+           AH: $19

+     return:

+             AL: selected drive (0=A, 1=B, .. )

+ $1A : set disk transfer address

+     call:

+           AH: $1A

+           DS:DX: disk transfer address

+     default is $80 in the psp

+ $21 : random read

+     call:

+           AH: $21

+           DS:DX: opened fcb

+     return:

+             0=read completed successfully

+             1=eof, no data read

+             2=dta too small, read canceled

+             3=eof, partial record, padded with zeros

+     the current block and current record fields are set to match the

+     relative record field, then the record is loaded

+ $22 : random write

+     call:

+           AH: $22

+           DS:DX: opened fcb

+     return:

+             AL: 0=write completed successfully

+                 1=disk full

+                 2=dta too small, read canceled

+ $23 : file size

+     call:

+           AH: $23

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     the relative record field is set to the number

+                     of records in the file

+                 255=no directory entry found

+     the record size field must be set

+ $24 : set relative record

+     call:

+           AH: $24

+           DS:DX: opened fcb

+     the relative record field is set to the same record as the current block

+     an the current record field

+ $25 : set vector

+     call:

+           AH: $25

+           AL: interrupt number

+           DS:DX: interrupt handling routine

+ $27 : random block read

+     call:

+           AH: $27

+           DS:DX: opened fcb

+           CX: number of blocks to read

+     return:

+             AL: 0=read completed successfully

+                 1=eof, no data read

+                 2=end of segment, read canceled

+                 3=eof, partial record, padded with zeros

+             CX: number of blocks read

+     the reading starts at the relative record

+     the current block, current record and relative record field are updated

+ $28 : random block write

+     call:

+           AH: $28

+           DS:DX: opened fcb

+           CX: number of records to write

+               0=set file size

+                 the file size field of thedirectory entry is set to the number

+                 of records specified by the relative record field

+     return:

+             AL: 0=write completed successfully

+                 1=disk full, no records written

+                 2=end of dta-segment, read canceled

+             CX: number of blocks written

+     the writing starts at the relative record

+     the current block, current record and relative record field are updated

+ $29 : parse file name

+     call:

+           AH: $29

+           AL: controls parsing

+               bit 0: if file separators are encountered

+                      (: . ; , = + / " [ ] \ < ] | blank tab)

+                     0: all parsing stops

+                     1: leading separators are ignored

+               bit 1: if the string does not contain a drive letter

+                     0: the fcb drive number is set to 0 (default)

+                     1: the fcb drive number is not changed

+               bit 2: if the string does not contain a filename

+                     0: the fcb filename is set to 8 blanks

+                     1: the fcb filename is not changed

+               bit 3: if the string does not contain an extension

+                     0: the fcb extension is set to three blanks

+                     1: the fcb extension is not changed

+           DS:SI: string to parse

+                  filename terminators include all filename separators

+                  plus any control character

+           ES:DI: if the string contained a valid filename,

+                  it points to an unopened fcb

+                  else ES:DI+1 points to a blank

+     return:

+             AL:   0=no wild card characters

+                   1=wild card characters used

+                 255=drive letter invalid

+             DS:SI: first byte past string that was parsed

+                    if the filename contains an asterisk,

+                    all folowing letters are set to question mark

+             ES:DI: unopened fcb

+                    if filename is found, an unopened fcb is created here

+ $2A : get date

+     call:

+           AH: $2A

+     return:

+             CX: year (1980-2099)

+             DH: month (1-12)

+             DL: day (1-31)

+             AL: day of week (0=sun, .., 6=sat)

+ $2B : set date

+     call:

+           AH: $2B

+           CX: year (1980-2099)

+           DH: month (1-12)

+           DL: day (1-31)

+     return:

+             AL:   0=date was valid

+                 255=date was invalid

+ $2C : get time

+     call:

+           AH: $2C

+     return:

+             CH: hour (0-23)

+             CL: minutes (0-59)

+             DH: seconds (0-59)

+             DL: hundredths (0-99)

+ $2D : set time

+     call:

+           AH: $2D

+           CH: hour (0-23)

+           CL: minutes (0-59)

+           DH: seconds (0-59)

+           DL: hundredths (0-99)

+     return:

+             AL:   0=time was valid

+                 255=time was invalid

+ $2E : set/reset verify flag

+     call:

+           AH: $2E

+           AL: 0=do not verify

+               1=verify

+ $2F : get disk transfer address

+     call:

+           AH: $2F

+     return:

+             ES:BX: points to disk transfer address

+ $30 : get dos version number

+     call:

+           AH: $30

+     return:

+             AL: major version number

+             AH: minor version number

+ $31 : keep process

+     call:

+           AH: $31

+           AL: exit code

+           DX: memory size in paragraphs

+     attemts to set the initial allocation block to a specific size

+     in paragraphs, will not free up other allocation blocks belonging

+     to that process, the exit code is available via function $4D

+ $33 : alt-c check

+     call:

+           AH: $33

+           AL: function

+               0=request current state

+               1=set state

+           DL: if setting

+               0=off

+               1=on

+     return:

+             AL: 255=al parameter was not in range 0..1

+             DL: if requesting current state

+                 0=off

+                 1=on

+     if check is on, every system call executes the check,

+     else only the device operations

+ $35 : get interrupt vector

+     call:

+           AH: $35

+           AL: interrupt number

+     return:

+             ES:BX: pointer to interrupt routine

+ $36 : get disk free space

+     call:

+           AH: $36

+           DL: drive (0=default, .....)

+     return:

+             BX: available clusters

+             DX: clusters per drive

+             CX: bytes per sector

+             AX: $FFFF=drive number invalid

+                 otherwise sectors per cluster

+ $38 : return country-dependent information

+     call:

+           AH: $38

+           DS:DX: pointer to 32 byte memory area

+                  area format:

+                  size     name

+                  2        date/time format

+                           0=usa standard    h:m:s m/d/y

+                           1=europe standard h:m:s d/m/y

+                           2=japan standard  y/m/d h:m:s

+                  5 asciz  currency symbol

+                  2 asciz  thousands separator

+                  2 asciz  decimal separator

+                  2 asciz  date separator

+                  2 asciz  time separator

+                  1        bit field

+                           bit 0: 0=currency symbol precedes amount

+                                  1=symbol comes after amount

+                           bit 1: 0=symbol immediately precedes the amount

+                                  1=space between symbol and amount

+                  1        currency places

+                           figures after decimal point of currency amounts

+                  1        time format

+                           0=12 hour time

+                           1=24 hour time

+                  4        case mapping call

+                           FAR procedure performs country-specific

+                           lower- to uppercase mapping

+                  2 asciz  data list separator

+                  if dx=-1 and the country code in AL is found,

+                  the current country is set accordingly

+

+           AL: function code

+               0=current country

+               or country code (usually international telephone prefix)

+               must be 0 in msdos 2.0 (only fully implemented after 2.01)

+     return:

+             CARRY: 1

+                    AX: 2=file not found

+             CARRY: 0

+                    DS:DX: filled with country data

+ $39 : create subdirectory

+     call:

+           AH: $39

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+                        5=access denied

+                          no room in parent,

+                          directory already exists or device was specified

+             CARRY: 0=no error

+ $3A : remove a directory entry

+     call:

+           AH: $3A

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX:  3=path not found

+                         5=access denied

+                           directory not empty, not a directory, root directory

+                        16=current directory

+             CARRY: 0=no error

+ $3B : change the current directory

+     call:

+           AH: $3B

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+             CARRY: 0=no error

+ $3C : create a file

+     call:

+           AH: $3C

+           DS:DX: pointer to pathname

+           CX: file attribute

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+                        4=too many open files

+                          file was created, but no room for handle

+                        5=access denied

+                          uncreatable attribute (directory or volume id),

+                          a file with a more inklusive attribute set exists,

+                          or a directory with the same name exists

+             CARRY: 0

+                    AX is handle number

+                    handle is open for read/write

+     creates a new file or truncates existing to length 0

+ $3D : open a file

+     call:

+           AH: $3D

+           DS:DX: pointer to pathname (asciz)

+           AL: access

+               0=open for reading

+               1=open for writing

+               2=open for both

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                         4=too many open files

+                           no file handles available

+                         5=access denied

+                           attempted to open a directory, volume id or

+                           a read only file for writing

+                        12=invalid access

+                           AL was not in range 0..2

+             CARRY: 0

+                    AX is handle number

+     read/write pointer is set to the first byte of the file

+     and the record size is set to 1

+     the returned file handle must be used in subsequent operations

+ $3E : close a file handle

+     call:

+           AH: $3E

+           BX: file handle

+     return:

+             CARRY: 1

+                    6=invalid handle (not currently open)

+             CARRY: 0=no error

+     the associated file is closed, buffers are flushed

+ $3F : read from file/device

+     call:

+           AH: $3F

+           DS:DX: pointer to buffer

+           CX: bytes to read

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 5=access denied

+                          not opened for read

+                        6=invalid handle (not currently open)

+             CARRY: 0

+                    AX: number of bytes read

+                        0=eof

+ $40 : write to file/device

+     call:

+           AH: $40

+           DS:DX: pointer to buffer

+           CX: bytes to write

+               if 0, the file size is set to the current position

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 5=access denied

+                        6=invalid handle

+             CARRY: 0

+                    AX: number of bytes written

+                        is error if not the same number as requested

+ $41 : delete a directory entry

+     call:

+           AH: $41

+           DS:DX: pointer to pathname

+     return:

+             CARRY: 1

+                    AX: 2=file not found

+                        5=access denied

+                          directory or read only

+             CARRY: 0=no error

+ $42 : move file pointer

+     call:

+           AH: $42

+           CX:DX: distance to move, in bytes

+           AL: method of moving

+               0=move pointer to offset from beginning of file

+               1=move to offset from current location

+               2=move to offset from eof

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                          AL not in range 0..2

+                        6=invalid handle

+             CARRY 0:

+                   DX:AX: new pointer location

+     moves the read/write file pointer

+ $43 : change attributes

+     call:

+           AH: $43

+           DS:DX: pointer to pathname (asciz)

+           AL: function

+               0=return in CX

+               1=set to CX

+           CX: if AL=1

+               attribute to be set

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                          AL not in range 0..1

+                        3=path not found

+                        5=access denied

+                          CX contained attributes that can not be changed

+                             (directory, volume id)

+             CARRY: 0

+                    if AL=0

+                    CX: attributes

+ $44 : i/o control for devices

+     call:

+           AH: $44

+           BX: handle

+           BL: (for calls AL=4, 5) drive: 0=default, ..

+           DS:DX: data or buffer

+           CX: bytes to read or write

+           AL: function code

+               calls 0,1: bits of DX (DH must be 0 on a set call)

+                          0:    iscin

+                          1:    iscot

+                          2:    isnul

+                          3:    isclk

+                          4:    specl

+                          5:    raw

+                          6:    eof

+                          7:    isdev

+                          8-13: reserved

+                          14:   ctrl

+                          15:   res

+                          if isdev=0 then channel is a disk file

+                             eof: 0=channel has been written

+                             bits 0-5 are block device number for the channel

+                                  (0=a, 1=b, ..)

+                          if isdev=1 then channel is device

+                             eof  : 0=end of file on input

+                             raw  : 0=this device is cooked

+                                    1=device in raw mode

+                             isclk: 1=clock

+                             isnul: 1=nul

+                             iscot: 1=console output

+                             iscin: 1=console input

+                             specl: 1=device is special

+                             ctrl : 0=device can not do control strings

+                                      via calls 2,3

+                                    1=can do control

+               0=get device information (returned in DX)

+               1=set device information (according to DX)

+               calls 2,5: arbitrary control strings sent or received

+                          to or from a device

+                          call syntax is the same as in read/write calls,

+                          except for 4 and 5, which take drive number in BL

+                          instead of a handle in BX

+                          an invalid function error is returned, if

+                          the ctrl bit is 0

+               2=read CX number of bytes to DS:DX from device control channel

+               3=write CX number of bytes from DS:DX to device control channel

+               4=read CX number of bytes to DS:DX from device control channel

+                 drive number in BL (0=default, ..)

+               5=write CX number of bytes from DS:DX to device control channel

+                 drive number in BL (0=default, ..)

+               calls 6,7: check, if a file handle is ready for i/o

+                          intended for status of handles associated with

+                          devices, but checks of file handles are allowed

+                          and defined: input: always ready (255), until eof

+                                              then always not ready (0)

+                                       output: always ready

+               6=get input status

+               7=get output status

+     return:

+             CARRY: 1

+                    AX:  1=invalid function

+                         5=access denied

+                         6=invalid handle

+                        13=invalid data

+             CARRY: 0

+                    AL: 2,3,4,5

+                    AX: count transferred

+                    AL: 6,7

+                          0=not ready

+                        255=ready

+     sets or gets device information associated with an open handle

+     or sends or receives a control string to or from a device handle or device

+     if the function is used for files, only functions 0,6,7 are defined

+ $45 : duplicate a file handle

+     call:

+           AH: $45

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 4=too many files open

+                        6=invalid handle

+             CARRY: 0

+                    AX: new file handle

+     retruns a new handle that refers to the same file

+ $46 : force a duplicate of a handle

+     call:

+           AH: $46

+           BX: existing file handle

+           CX: new file handle

+     return:

+             CARRY: 1

+                    AX: 4=too many open files

+                        6=invalid handle

+             CARRY: 0=no error

+     CX then refers to the same file as BX, eventually, CX is closed first

+ $47 : return text of current directory

+     call:

+           AH: $47

+           DS:SI: pointer to 64 byte area

+           DL: drive number (0=default, ..)

+     return:

+             CARRY: 1

+                    AX: 15=invalid drive

+             CARRY: 0=no error

+     the path name does not contain the leading separators

+ $48 : allocate memory

+     call:

+           AH: $48

+           BX: size of memory to be allocated

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        8=not enough memory

+                    BX: maximum size that could be allocated

+             CARRY: 0

+                    AX:0: pointer to the allocated memory

+ $49 : free allocated memory

+     call:

+           AH: $49

+           ES: segment address of memory area to be freed

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        9=invalid block

+                          the block was not allocated by $49

+             CARRY: 0=no error

+     returns a piece of memory to the system pool that was allocated with $49

+ $4A : modify allocated memory blocks

+     call:

+           AH: $4A

+           ES: segment address of memory area

+           BX: requested memory area

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        8=not enough memory

+                        9=invalid block

+                          the block was not allocated by $49

+                    BX: maximum size possible

+             CARRY: 0=no error

+     attempts to grow or shrink an allocated block

+ $4B : load and execute a program

+     call:

+           AH: $4B

+           DS:DX: pointer to pathname (asciz)

+           ES:BX: pointer to parameter block

+                  for AL=0:

+                  size    name

+                  2       segment address of environment

+                  4       pointer to command line at $80

+                  4       pointer to default fcb to be passed at $5C

+                  4       pointer to default fcb to be passed at $6C

+                  for AL=3:

+                  size    name

+                  2       segment address where file will be loaded

+                  2       relocation factor to be applied to the image

+           AL: 0=load and execute

+               3=load (overlay)

+     return:

+             CARRY: 1

+                    AX:  1=invalid function

+                           AL was not in range 0,3

+                         2=file not found

+                         8=not enough memory

+                        10=bad environment

+                           larger than 32K

+                        11=bad format

+                           EXE file contained inconsistent information

+             CARRY: 0=no error

+     all open files of a parent are copied to the child process

+     also inherited is an environment (block of text strings less than 32K)

+     a zero environment address causes the child to inherit then parents

+     environment unchanged

+ $4C : terminate process

+     call:

+           AH: $4C

+           AL: return code

+ $4D : retrieve then return code of a child

+     call:

+           AH: $4D

+     return:

+             AX: exit code

+                 high byte: 0=terminate/abort

+                            1=alt-c

+                            2=hard error

+                            3=terminate and stay resident

+     returns code only once

+ $4E : find match file

+     call:

+           AH: $4E

+           DS:DX: pointer to pathname

+           CX: search attributes

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                        18=no more files

+             CARRY: 0=no error

+     data block is written to current dma address:

+      size    name

+      21      reserved for subsequent calls

+       1      attribute found

+       2      time

+       2      date

+       2      low(size)

+       2      high(size)

+      13      packed name

+     subsequent calls: see $4F

+ $4F : step through a directory matching files

+     call:

+           AH: $4F

+     return:

+             CARRY: 1

+                    AX: 18=no more files

+             CARRY: 0=no error

+     only used for subsequent calls after $4E

+     dma address must point to the parablock

+ $54 : return current setting of verify after write flag

+     call:

+           AH: $54

+     return:

+             current verify flag value

+ $56 : move a directory entry

+     call:

+           AH: $56

+           DS:DX: pointer to pathname of existing file

+           ES:DI: pointer to new pathname

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                         5=access denied

+                           path is directory or new file exists

+                           or directory entry could not be created

+                        17=not same device

+             CARRY: 0=no error

+     attempts to rename a file in the directory of one device

+ $57 : get/set date/time of file

+     call:

+           AH: $57

+           AL: 0=get date and time

+               1=set date and time

+           BX: file handle

+           CX: if AL=1

+               time to be set

+           DX: if AL=1

+               date to be set

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                        6=invalid handle

+             CARRY: 0=no error

+                    CX: if AL=0

+                        time

+                    DX: if AL=0

+                        date

+     date and time are not recorded until file is closed

+

diff --git a/system/dos/1986/src/252 b/system/dos/1986/src/252
new file mode 100644
index 0000000..b4369b6
--- /dev/null
+++ b/system/dos/1986/src/252
diff --git a/system/dos/1986/src/253 b/system/dos/1986/src/253
new file mode 100644
index 0000000..c7a4494
--- /dev/null
+++ b/system/dos/1986/src/253
diff --git a/system/dos/1986/src/254 b/system/dos/1986/src/254
new file mode 100644
index 0000000..f71eeb6
--- /dev/null
+++ b/system/dos/1986/src/254
diff --git a/system/dos/1986/src/255 b/system/dos/1986/src/255
new file mode 100644
index 0000000..d21b649
--- /dev/null
+++ b/system/dos/1986/src/255
diff --git a/system/dos/1986/src/COND.TXT b/system/dos/1986/src/COND.TXT
new file mode 100644
index 0000000..02cb949
--- /dev/null
+++ b/system/dos/1986/src/COND.TXT
@@ -0,0 +1,5 @@
+FLOPPY = TRUE

+HDU    = FALSE

+TEST   = FALSE

+DOS    = TRUE

+CPM    = FALSE

diff --git a/system/dos/1986/src/block i-o b/system/dos/1986/src/block i-o
new file mode 100644
index 0000000..4336746
--- /dev/null
+++ b/system/dos/1986/src/block i-o
@@ -0,0 +1,104 @@
+PACKET disk block io DEFINES                    (* Copyright (C) 1986 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  read disk block,

+  read disk cluster, 

+  write disk block,

+  write disk cluster,

+  io error,

+  first non dummy ds page:

+ 

+INT CONST first non dummy ds page := 2;

+

+INT VAR error;

+

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST ds page no, 

+                      INT CONST block no,

+                      INT VAR error):

+  check rerun;

+  read block (ds, ds page no, eublock (block no), error). 

+ 

+END PROC read disk block;

+ 

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST ds page no, 

+                      INT CONST block no):

+  check rerun;

+  read block (ds, ds page no, eublock (block no), error); 

+  IF error <> 0 

+    THEN io error (error)

+  FI. 

+ 

+END PROC read disk block;

+ 

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST block no):

+  read disk block (ds, first non dummy ds page, block no)

+

+END PROC read disk block; 

+

+PROC read disk cluster (DATASPACE VAR ds, 

+                        INT CONST first ds page no,

+                        INT CONST cluster no): 

+  INT VAR i;

+  FOR i FROM 0 UPTO sectors per cluster - 1 REP

+    read disk block (ds, first ds page no + i, block no + i)

+  PER.

+ 

+block no:

+  first block no of cluster (cluster no).

+ 

+END PROC read disk cluster; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST ds page no, 

+                       INT CONST block no,

+                       INT VAR error):

+  check rerun;

+  write block (ds, ds page no, 0,eu block (block no), error). 

+ 

+END PROC write disk block; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST ds page no, 

+                       INT CONST block no):

+  check rerun;

+  write block (ds, ds page no, 0, eu block (block no), error); 

+  IF error <> 0 

+    THEN io error (error)

+  FI. 

+ 

+END PROC write disk block; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST block no): 

+  write disk block (ds, first non dummy ds page, block no)

+

+END PROC write disk block; 

+

+PROC write disk cluster (DATASPACE CONST ds, 

+                        INT CONST first ds page no,

+                        INT CONST cluster no): 

+  INT VAR i;

+  FOR i FROM 0 UPTO sectors per cluster - 1 REP

+    write disk block (ds, first ds page no + i, block no + i)

+  PER.

+ 

+block no:

+  first block no of cluster (cluster no).

+ 

+END PROC write disk cluster; 

+ 

+PROC io  error (INT CONST error code):

+  SELECT error code OF 

+    CASE 1: errorstop ("Laufwerk nicht betriebsbereit") 

+    CASE 2: errorstop ("Schreib-/Lesefehler") 

+    CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+    CASE 4: errorstop ("Block nicht lesbar")

+    OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+  END SELECT. 

+

+END PROC io error; 

+ 

+END PACKET disk block io;

diff --git a/system/dos/1986/src/cluster b/system/dos/1986/src/cluster
new file mode 100644
index 0000000..ef2720b
--- /dev/null
+++ b/system/dos/1986/src/cluster
@@ -0,0 +1,109 @@
+PACKET cluster DEFINES                       (* Copyright (C) 1986 *)

+                                             (* Frank Klapper      *)

+                                             (* 19.03.86           *)

+

+  CLUSTER, 

+  :=, 

+  text,

+  text 32,            (* typical dir entry *)

+  write text,

+  write text 32,

+  reduce cluster buffer:

+ 

+LET max cluster size = 8192;   (* 8192 * 8 = 64 KB *)

+

+TYPE CLUSTER = BOUND STRUCT (ALIGN dummy, 

+                             ROW max cluster size REAL cluster row); 

+ 

+TEXT VAR string;

+INT VAR string length;

+ 

+INT VAR sector no, eight byte pos, index;

+

+reduce cluster buffer;

+

+.reals per sector:        sector size DIV 8.

+.reals per std eu sector: 512 DIV 8.

+

+PROC reduce cluster buffer:

+  string := 32 * "*";

+  string length := 32.

+

+END PROC reduce cluster buffer;

+

+OP := (CLUSTER VAR cluster, DATASPACE VAR ds):

+  CONCR (cluster) := ds 

+ 

+END OP :=; 

+ 

+TEXT PROC text (CLUSTER CONST cluster, INT CONST from, to):

+  init string;

+  FOR sector no FROM 0 UPTO sectors per cluster - 1 REP

+    get text of sector

+  PER;

+  subtext (string, from, to).

+ 

+init string:

+  IF string length < cluster size

+    THEN string := cluster size * "*";

+         string length := cluster size

+  FI.

+

+get text of sector:

+  FOR eight byte pos FROM 1 UPTO reals per sector REP

+    replace (string, string index, cluster.cluster row [row index]) 

+  PER.

+

+string index:

+  reals per sector * sector no + eight byte pos.

+

+row index:

+  reals per std eu sector * sector no + eight byte pos.

+

+END PROC text;

+

+TEXT PROC text 32 (CLUSTER CONST cluster, INT CONST part):

+  FOR index FROM 1 UPTO 4 REP

+    replace (string, index, cluster.cluster row [index + 4 * part])

+  PER;

+  subtext (string, 1, 32).

+ 

+END PROC text 32;

+

+PROC write text (CLUSTER VAR cluster,

+                 TEXT CONST string):

+  IF LENGTH string < cluster size

+    THEN execute write text (cluster, text (string, cluster size))

+    ELSE execute write text (cluster, string)

+  FI.

+

+END PROC write text;

+

+PROC execute write text (CLUSTER VAR cluster,

+                         TEXT CONST string):

+  FOR sector no FROM 0 UPTO sectors per cluster - 1 REP

+    write text of sector

+  PER.

+

+write text of sector:

+  FOR eight byte pos FROM 1 UPTO reals per sector REP

+    cluster.cluster row [row index] := string RSUB (string index) 

+  PER.

+

+row index:

+  reals per std eu sector * sector no + eight byte pos.

+

+string index:

+  reals per sector * sector no + eight byte pos.

+

+

+END PROC execute write text;

+

+PROC write text 32 (CLUSTER VAR cluster, TEXT CONST string, INT CONST part):

+  FOR index FROM 1 UPTO 4 REP

+    cluster.cluster row [index + 4 * part] := string RSUB (index)

+  PER;

+

+END PROC write text 32;

+

+END PACKET cluster;

diff --git a/system/dos/1986/src/disk descriptor.dos.fd b/system/dos/1986/src/disk descriptor.dos.fd
new file mode 100644
index 0000000..9de8cf0
--- /dev/null
+++ b/system/dos/1986/src/disk descriptor.dos.fd
@@ -0,0 +1,290 @@
+PACKET dos disk DEFINES                       (* Copyright (C) 1985, 86 *)

+                                              (* Frank Klapper          *)

+  first fat byte,                             (* 30.05.86               *)

+  begin of fat,

+  number of fat sectors, 

+  number of fat entrys, 

+  number of fat copies,

+  begin of dir,

+  number of dir sectors,

+  begin of data area,

+  sectors per cluster,

+  cluster size,

+  sector size,

+

+  eublock,

+  first block no of cluster,

+

+  reset disk attributes,

+  set disk attributes:

+ 

+LET dir entrys per block    = 16,

+    first non dummy ds page = 2;

+

+LET DOSDISK = STRUCT (INT sectors per cluster,

+                          number of reserved sectors,

+                          number of fats,

+                          number of dir sectors,

+                          first fat byte,

+                          number of fat sectors,

+                          heads,

+                          sectors per track,

+                          tracks,

+                          number of fat entrys,

+                     REAL size);

+

+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);

+

+INT CONST sector size :: 512;

+

+TEXT VAR bpb := 32 * " ";

+

+INITFLAG VAR bpb ds used := FALSE;

+

+DATASPACE VAR bpb ds;

+

+BLOCK VAR bpb block;

+

+DOSDISK VAR disk format;

+BOUND DOSDISK VAR format table;

+

+INT VAR eu sectors,

+        xbegin of data area;

+

+INT PROC eublock (INT CONST nr):

+(*COND FLOPPY*)

+  IF page format

+    THEN head * eu sectors per head + trac * eu sectors + sector

+    ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector

+  FI.

+

+page format:

+  eu heads < 0.

+

+sector:

+  nr MOD disk format.sectors per track.

+

+trac: 

+  (nr DIV disk format.sectors per track) DIV disk format.heads.

+

+head:

+  (nr DIV disk format.sectors per track) MOD disk format.heads.

+

+eu sectors per head:

+  eu sectors * eu tracks.

+

+(*ENDCOND*)

+(*COND HDU

+  nr

+

+ENDCOND*)

+

+END PROC eublock;

+

+INT PROC first block no of cluster (INT CONST cluster no):

+  IF cluster no < 2

+    THEN error stop ("interner Fehler")

+  FI;

+  begin of data area + (cluster no - 2) * sectors per cluster.

+

+END PROC first block no of cluster;

+

+INT PROC first fat byte:

+  disk format.first fat byte

+

+END PROC first fat byte;

+ 

+INT PROC number of fat copies:

+  disk format.number of fats

+

+END PROC number of fat copies;

+

+INT PROC number of fat sectors:

+  disk format.number of fat sectors 

+

+END PROC number of fat sectors;

+

+INT PROC number of fat entrys:

+  disk format.number of fat entrys

+

+END PROC number of fat entrys;

+

+INT PROC number of dir sectors:

+  disk format.number of dir sectors 

+

+END PROC number of dir sectors;

+

+INT PROC begin of fat (INT CONST no):

+  disk format.number of reserved sectors + no * disk format.number of fat sectors

+

+END PROC begin of fat;

+

+INT PROC begin of dir:

+  disk format.number of reserved sectors + 

+  disk format.number of fats * disk format.number of fat sectors

+ 

+END PROC begin of dir;

+

+INT PROC begin of data area:

+  xbegin of data area

+

+END PROC begin of data area;

+

+INT PROC sectors per cluster:

+  disk format.sectors per cluster 

+

+END PROC sectors per cluster;

+

+INT PROC cluster size:

+  disk format.sectors per cluster * 512

+

+END PROC cluster size;

+

+PROC set disk attributes (INT CONST first fat byte):

+  enable stop;

+(*COND FLOPPY*)

+  get bios parameter block; 

+  IF is valid bpb

+    THEN load disk data from bpb

+    ELSE load disk disk data from ds

+  FI;

+  eu sectors := eu last sector - eu first sector +1;

+(*ENDCOND*)

+  xbegin of data area := disk format.number of reserved sectors +

+        disk format.number of fats * disk format.number of fat sectors +

+        disk format.number of dir sectors; 

+(*COND FLOPPY*)

+  test compatibility 

+ 

+.is valid bpb:

+  first fat byte < 252 OR code (bpb SUB 22) = first fat byte.

+

+load disk disk data from ds:

+  IF exists (text (first fat byte))

+    THEN format table := old (text (first fat byte));

+         copy values

+    ELSE error stop ("DOS-Diskettenformat nicht implementiert")

+  FI.

+

+copy values:

+  disk format.sectors per cluster        := format table.sectors per cluster; 

+  disk format.number of reserved sectors := format table.number of reserved sectors; 

+  disk format.number of fats             := format table.number of fats;

+  disk format.size                       := format table.size;

+  disk format.number of dir sectors      := format table.number of dir sectors;

+  disk format.first fat byte             := format table.first fat byte;

+  disk format.number of fat sectors      := format table.number of fat sectors;

+  disk format.heads                      := format table.heads;

+  disk format.sectors per track          := format table.sectors per track;

+  disk format.tracks                     := format table.tracks;

+  disk format.number of fat entrys       := format table.number of fat entrys.

+

+test compatibility:

+  IF disk format.sectors per track > eu sectors

+    OR eu tracks <> disk format.tracks

+    OR abs (eu heads) < disk format.heads

+    OR disk format.number of reserved sectors <> 1

+    THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")

+  FI; 

+(*ENDCOND*)

+ 

+END PROC set disk attributes;

+

+PROC reset disk attributes:

+(*COND FLOPPY*)

+  disk format.sectors per cluster        := 1;

+  disk format.number of reserved sectors := 1;

+  disk format.number of fats             := 1;

+  disk format.size                       := real (eu size);

+  disk format.number of dir sectors      := 4;

+  disk format.first fat byte             := 255;

+  disk format.number of fat sectors      := 1;

+  disk format.heads                      := eu heads;

+  disk format.sectors per track          := eu tracks;

+  disk format.tracks                     := eu sectors;

+  disk format.number of fat entrys       := 100.

+

+(*ENDCOND*)

+(*COND HDU

+  get bios parameter block; 

+  load disk data from bpb (248).

+

+ENDCOND*)

+

+END PROC reset disk attributes;

+

+PROC get bios parameter block:

+  init bpb ds;

+  read bpb;

+  copy bpb block to bpb text.

+

+init bpb ds:

+  IF NOT initialized (bpb ds used)

+    THEN bpb ds := nilspace;

+         bpb block := bpb ds

+  FI.

+

+read bpb:

+  INT VAR error;

+  read block (bpb ds, first non dummy ds page, 0, error);

+  IF error <> 0

+    THEN SELECT error OF 

+           CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") 

+           CASE 2: errorstop ("Schreib-/Lesefehler") 

+           CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+           OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+         END SELECT

+  FI.

+

+copy bpb block to bpb text:

+  replace (bpb, 1, bpb block. block row [1]);

+  replace (bpb, 2, bpb block. block row [2]);

+  replace (bpb, 3, bpb block. block row [3]); 

+  replace (bpb, 4, bpb block. block row [4]).

+

+END PROC get bios parameter block;

+

+PROC load disk data from bpb:

+  disable stop;

+  enable load disk data from bpb;

+  IF is error

+    THEN clear error;

+         enable stop;

+         error stop ("Bios-Parameterblock ungültig")

+  FI.

+

+END PROC load disk data from bpb;

+

+PROC enable load disk data from bpb:

+  disk format.sectors per cluster        := code (bpb SUB 14);

+  disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);

+  disk format.number of fats             := code (bpb SUB 17);

+  disk format.number of dir sectors      := dir entrys DIV dir entrys per block; 

+  disk format.size                       := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));

+  disk format.first fat byte             := code (bpb SUB 22);

+  disk format.number of fat sectors      := code (bpb SUB 24) * 256 + code (bpb SUB 23); 

+  disk format.heads                      := dos heads;

+  disk format.sectors per track          := code (bpb SUB 26) * 256 + code (bpb SUB 25);

+  disk format.tracks                     :=

+        int(disk format.size / real(disk format.sectors per track * disk format.heads));

+  disk format.number of fat entrys       := fat entrys.

+ 

+dir entrys:

+  code (bpb SUB 19) * 256 + code (bpb SUB 18).

+

+dos heads:

+  code (bpb SUB 28) * 256 + code (bpb SUB 27).

+

+fat entrys:

+  data clusters + 2.

+

+data clusters:

+  int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).

+

+no of table sectors:

+  disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +

+  disk format.number of dir sectors. 

+

+END PROC enable load disk data from bpb;

+

+END PACKET dos disk;

diff --git a/system/dos/1986/src/disk descriptor.dos.hd b/system/dos/1986/src/disk descriptor.dos.hd
new file mode 100644
index 0000000..0627b62
--- /dev/null
+++ b/system/dos/1986/src/disk descriptor.dos.hd
@@ -0,0 +1,290 @@
+PACKET dos disk DEFINES                       (* Copyright (C) 1985, 86 *)

+                                              (* Frank Klapper          *)

+  first fat byte,                             (* 30.05.86               *)

+  begin of fat,

+  number of fat sectors, 

+  number of fat entrys, 

+  number of fat copies,

+  begin of dir,

+  number of dir sectors,

+  begin of data area,

+  sectors per cluster,

+  cluster size,

+  sector size,

+

+  eublock,

+  first block no of cluster,

+

+  reset disk attributes,

+  set disk attributes:

+ 

+LET dir entrys per block    = 16,

+    first non dummy ds page = 2;

+

+LET DOSDISK = STRUCT (INT sectors per cluster,

+                          number of reserved sectors,

+                          number of fats,

+                          number of dir sectors,

+                          first fat byte,

+                          number of fat sectors,

+                          heads,

+                          sectors per track,

+                          tracks,

+                          number of fat entrys,

+                     REAL size);

+

+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);

+

+INT CONST sector size :: 512;

+

+TEXT VAR bpb := 32 * " ";

+

+INITFLAG VAR bpb ds used := FALSE;

+

+DATASPACE VAR bpb ds;

+

+BLOCK VAR bpb block;

+

+DOSDISK VAR disk format;

+BOUND DOSDISK VAR format table;

+

+INT VAR eu sectors,

+        xbegin of data area;

+

+INT PROC eublock (INT CONST nr):

+(*COND FLOPPY

+  IF page format

+    THEN head * eu sectors per head + trac * eu sectors + sector

+    ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector

+  FI.

+

+page format:

+  eu heads < 0.

+

+sector:

+  nr MOD disk format.sectors per track.

+

+trac: 

+  (nr DIV disk format.sectors per track) DIV disk format.heads.

+

+head:

+  (nr DIV disk format.sectors per track) MOD disk format.heads.

+

+eu sectors per head:

+  eu sectors * eu tracks.

+

+ENDCOND*)

+(*COND HDU*)

+  nr

+

+(*ENDCOND*)

+

+END PROC eublock;

+

+INT PROC first block no of cluster (INT CONST cluster no):

+  IF cluster no < 2

+    THEN error stop ("interner Fehler")

+  FI;

+  begin of data area + (cluster no - 2) * sectors per cluster.

+

+END PROC first block no of cluster;

+

+INT PROC first fat byte:

+  disk format.first fat byte

+

+END PROC first fat byte;

+ 

+INT PROC number of fat copies:

+  disk format.number of fats

+

+END PROC number of fat copies;

+

+INT PROC number of fat sectors:

+  disk format.number of fat sectors 

+

+END PROC number of fat sectors;

+

+INT PROC number of fat entrys:

+  disk format.number of fat entrys

+

+END PROC number of fat entrys;

+

+INT PROC number of dir sectors:

+  disk format.number of dir sectors 

+

+END PROC number of dir sectors;

+

+INT PROC begin of fat (INT CONST no):

+  disk format.number of reserved sectors + no * disk format.number of fat sectors

+

+END PROC begin of fat;

+

+INT PROC begin of dir:

+  disk format.number of reserved sectors + 

+  disk format.number of fats * disk format.number of fat sectors

+ 

+END PROC begin of dir;

+

+INT PROC begin of data area:

+  xbegin of data area

+

+END PROC begin of data area;

+

+INT PROC sectors per cluster:

+  disk format.sectors per cluster 

+

+END PROC sectors per cluster;

+

+INT PROC cluster size:

+  disk format.sectors per cluster * 512

+

+END PROC cluster size;

+

+PROC set disk attributes (INT CONST first fat byte):

+  enable stop;

+(*COND FLOPPY

+  get bios parameter block; 

+  IF is valid bpb

+    THEN load disk data from bpb

+    ELSE load disk disk data from ds

+  FI;

+  eu sectors := eu last sector - eu first sector +1;

+ENDCOND*)

+  xbegin of data area := disk format.number of reserved sectors +

+        disk format.number of fats * disk format.number of fat sectors +

+        disk format.number of dir sectors; 

+(*COND FLOPPY

+  test compatibility 

+ 

+.is valid bpb:

+  first fat byte < 252 OR code (bpb SUB 22) = first fat byte.

+

+load disk disk data from ds:

+  IF exists (text (first fat byte))

+    THEN format table := old (text (first fat byte));

+         copy values

+    ELSE error stop ("DOS-Diskettenformat nicht implementiert")

+  FI.

+

+copy values:

+  disk format.sectors per cluster        := format table.sectors per cluster; 

+  disk format.number of reserved sectors := format table.number of reserved sectors; 

+  disk format.number of fats             := format table.number of fats;

+  disk format.size                       := format table.size;

+  disk format.number of dir sectors      := format table.number of dir sectors;

+  disk format.first fat byte             := format table.first fat byte;

+  disk format.number of fat sectors      := format table.number of fat sectors;

+  disk format.heads                      := format table.heads;

+  disk format.sectors per track          := format table.sectors per track;

+  disk format.tracks                     := format table.tracks;

+  disk format.number of fat entrys       := format table.number of fat entrys.

+

+test compatibility:

+  IF disk format.sectors per track > eu sectors

+    OR eu tracks <> disk format.tracks

+    OR abs (eu heads) < disk format.heads

+    OR disk format.number of reserved sectors <> 1

+    THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")

+  FI; 

+ENDCOND*)

+ 

+END PROC set disk attributes;

+

+PROC reset disk attributes:

+(*COND FLOPPY

+  disk format.sectors per cluster        := 1;

+  disk format.number of reserved sectors := 1;

+  disk format.number of fats             := 1;

+  disk format.size                       := real (eu size);

+  disk format.number of dir sectors      := 4;

+  disk format.first fat byte             := 255;

+  disk format.number of fat sectors      := 1;

+  disk format.heads                      := eu heads;

+  disk format.sectors per track          := eu tracks;

+  disk format.tracks                     := eu sectors;

+  disk format.number of fat entrys       := 100.

+

+ENDCOND*)

+(*COND HDU*)

+  get bios parameter block; 

+  load disk data from bpb.

+

+(*ENDCOND*)

+

+END PROC reset disk attributes;

+

+PROC get bios parameter block:

+  init bpb ds;

+  read bpb;

+  copy bpb block to bpb text.

+

+init bpb ds:

+  IF NOT initialized (bpb ds used)

+    THEN bpb ds := nilspace;

+         bpb block := bpb ds

+  FI.

+

+read bpb:

+  INT VAR error;

+  read block (bpb ds, first non dummy ds page, 0, error);

+  IF error <> 0

+    THEN SELECT error OF 

+           CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") 

+           CASE 2: errorstop ("Schreib-/Lesefehler") 

+           CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+           OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+         END SELECT

+  FI.

+

+copy bpb block to bpb text:

+  replace (bpb, 1, bpb block. block row [1]);

+  replace (bpb, 2, bpb block. block row [2]);

+  replace (bpb, 3, bpb block. block row [3]); 

+  replace (bpb, 4, bpb block. block row [4]).

+

+END PROC get bios parameter block;

+

+PROC load disk data from bpb:

+  disable stop;

+  enable load disk data from bpb;

+  IF is error

+    THEN clear error;

+         enable stop;

+         error stop ("Bios-Parameterblock ungültig")

+  FI.

+

+END PROC load disk data from bpb;

+

+PROC enable load disk data from bpb:

+  disk format.sectors per cluster        := code (bpb SUB 14);

+  disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);

+  disk format.number of fats             := code (bpb SUB 17);

+  disk format.number of dir sectors      := dir entrys DIV dir entrys per block; 

+  disk format.size                       := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));

+  disk format.first fat byte             := code (bpb SUB 22);

+  disk format.number of fat sectors      := code (bpb SUB 24) * 256 + code (bpb SUB 23); 

+  disk format.heads                      := dos heads;

+  disk format.sectors per track          := code (bpb SUB 26) * 256 + code (bpb SUB 25);

+  disk format.tracks                     :=

+        int(disk format.size / real(disk format.sectors per track * disk format.heads));

+  disk format.number of fat entrys       := fat entrys.

+ 

+dir entrys:

+  code (bpb SUB 19) * 256 + code (bpb SUB 18).

+

+dos heads:

+  code (bpb SUB 28) * 256 + code (bpb SUB 27).

+

+fat entrys:

+  data clusters + 2.

+

+data clusters:

+  int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).

+

+no of table sectors:

+  disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +

+  disk format.number of dir sectors. 

+

+END PROC enable load disk data from bpb;

+

+END PACKET dos disk;

diff --git a/system/dos/1986/src/disk manager b/system/dos/1986/src/disk manager
new file mode 100644
index 0000000..5711ee7
--- /dev/null
+++ b/system/dos/1986/src/disk manager
@@ -0,0 +1,245 @@
+PACKET disk manager DEFINES                 (* Copyright (C) 1986 *)

+                                            (* Frank Klapper      *)

+  disk fetch,                               (* 07.05.86           *)

+  disk check,

+  disk save first phase,

+  disk save second phase,

+  disk clear,

+  disk format,

+  disk erase,

+  disk exists,

+  disk list,

+  disk all,

+  disk reserve,

+  disk free:

+

+LET ascii        = 1,

+    ascii german = 2,

+    transparent  = 3,

+    ebcdic       = 4,

+    row text     = 5,

+    ds           = 6,

+    atari st     = 10;

+

+TEXT VAR file name;

+

+INT VAR mode := 0;

+TEXT VAR mode extension;

+

+REAL VAR last access time := 0.0;

+

+PROC disk fetch (TEXT CONST name, DATASPACE VAR file ds):

+  enable stop;

+  access disk;

+  file name  := adapted name (name, TRUE);

+  IF dir contains (file name)

+    THEN do fetch

+    ELSE errorstop ("die Datei """ + file name + """ gibt es nicht")

+  FI;

+  last access time := clock (1).

+

+do fetch:

+  SELECT mode OF 

+    CASE ascii, ascii german, atari st, ebcdic, transparent: fetch filemode (file ds, filename, mode)

+    CASE row text   : fetch row textmode (file ds, filename)

+    CASE ds         : fetch dsmode       (file ds, filename)

+    OTHERWISE error stop ("Unzul�ssige Betriebsart")

+  END SELECT.

+

+END PROC disk fetch;

+

+PROC disk check (TEXT CONST name):

+  enable stop;

+  access disk;

+  file name := adapted name (name, TRUE);

+  IF dir contains (file name)

+    THEN disable stop;

+         check file (file name);

+         IF is error

+           THEN clear error;

+                error stop ("Fehler beim Pr�flesen der Datei """ + file name + """")

+         FI;

+    ELSE error stop ("""" + file name + """ gibt es nicht")

+  FI;

+  last access time := clock (1).

+

+END PROC disk check;

+

+PROC disk save first phase (TEXT CONST name, BOOL VAR overwrite question):

+  enable stop;

+  overwrite question := FALSE;

+  access disk;

+  file name := adapted name (name, FALSE); 

+  IF dir contains (file name)

+     THEN overwrite question := TRUE

+  FI;

+  last access time := clock (1).

+

+END PROC disk save first phase;

+

+PROC disk save second phase (DATASPACE CONST file ds): 

+  enable stop;

+  access disk;

+  erase file if necessary;

+  do save;

+  last access time := clock (1).

+

+erase file if necessary:

+  IF dir contains (file name)

+    THEN erase table entrys (file name)

+  FI.

+

+do save:

+  SELECT mode OF 

+    CASE ascii, ascii german,atari st, ebcdic, transparent: save filemode (file ds, filename, mode)

+    CASE row text   : save row textmode (file ds, filename)

+    CASE ds         : save dsmode       (file ds, filename)

+    OTHERWISE error stop ("Unzul�ssige Betriebsart")

+  END SELECT.

+

+END PROC disk save second phase;

+

+(* DOS bekommt die Tabellenparameter von der Diskette

+   CPM bekommt die Tabellenparameter �ber 'reserve'   *)

+

+PROC disk clear:

+  enable stop;

+(*COND DOS*)

+  access disk;

+(*ENDCOND*)

+(*COND CPM

+  open eu disk;

+  open action;

+ENDCOND*)

+  format disk;

+  last access time := clock (1).

+

+END PROC disk clear;

+

+PROC disk erase (TEXT CONST name):

+  enable stop;

+  access disk;

+  file name := adapted name (name, TRUE); 

+  IF NOT dir contains (file name)

+    THEN errorstop ("die Datei """ + file name + """ gibt es nicht")

+    ELSE erase table entrys (file name);

+  FI;

+  last access time := clock (1).

+

+END PROC disk erase;

+ 

+BOOL PROC disk exists (TEXT CONST name):

+  enable stop;

+  access disk;

+  last access time := clock (1);

+  dir contains (adapted name (name, TRUE)).

+

+END PROC disk exists;

+

+PROC disk list (DATASPACE VAR list ds):

+  enable stop;

+  access disk;

+  dir list (list ds);

+  last access time := clock (1).

+

+END PROC disk list;

+

+THESAURUS PROC disk all:

+  enable stop;

+  access disk;

+  last access time := clock (1);

+  dir all.

+

+END PROC disk all;

+

+PROC disk format:

+

+(*COND DOS*)

+  error stop ("nicht implementiert")

+(*ENDCOND*)

+

+(*COND CPM

+  enable stop;

+  open eu disk;

+  open action;

+  format archive (eu disk format no);

+  format disk;

+  last access time := clock (1).

+ENDCOND*)

+

+END PROC disk format;

+

+PROC disk reserve (TEXT CONST reserve string):

+  enable stop;

+  close action;

+  last access time := clock (1);

+  get mode.

+ 

+get mode:

+  TEXT VAR mode text;

+  IF pos (reserve string, ":") = 0

+    THEN mode text := reserve string;

+         mode extension := ""

+    ELSE mode text := subtext (reserve string, 1, pos (reserve string, ":") - 1);

+         mode extension := subtext (reserve string, pos (reserve string, ":") + 1)

+  FI;

+  prepare modetext;

+  IF mode text = "FILEASCII"

+    THEN mode := ascii

+  ELIF mode text = "FILEASCIIGERMAN"

+    THEN mode := asciigerman

+  ELIF mode text = "FILEATARIST"

+    THEN mode := atari st

+  ELIF modetext = "FILEEBCDIC"

+    THEN mode := ebcdic

+  ELIF modetext = "FILETRANSPARENT"

+    THEN mode := transparent

+  ELIF mode text = "ROWTEXT"

+    THEN mode := row text

+  ELIF mode text = "DS"

+    THEN mode := ds

+   ELSE error stop ("Unzul�ssige Betriebsart")

+  FI.

+

+prepare modetext:

+  change all (mode text, " ", "");

+  INT VAR i;

+  FOR i FROM 1 UPTO LENGTH mode text REP

+    IF is lower case

+      THEN replace (mode text, i, upper case char)

+    FI

+  PER.

+

+is lower case:

+  code (mode text SUB i) > 96 AND code (mode text SUB i) < 123.

+

+upper case char:

+  code (code (mode text SUB i) - 32).

+

+END PROC disk reserve;

+

+PROC disk free:

+  disable stop;

+  close action;

+  close disk;

+  reduce cluster buffer.

+

+END PROC disk free;

+

+PROC access disk:

+  IF action closed COR (last access more than two seconds ago CAND disk changed)

+    THEN open disk archive

+  FI.

+

+open disk archive:

+  close action;

+  open eu disk;

+  open disk (mode extension);

+  open action.

+

+last access more than two seconds ago:

+  abs (clock (1) - last access time) > 2.0.

+

+END PROC access disk;

+

+END PACKET disk manager;

diff --git a/system/dos/1986/src/eu disk descriptor.fd b/system/dos/1986/src/eu disk descriptor.fd
new file mode 100644
index 0000000..cd00175
--- /dev/null
+++ b/system/dos/1986/src/eu disk descriptor.fd
@@ -0,0 +1,102 @@
+PACKET eu disk DEFINES                          (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  load shard interface table,

+  open eu disk,

+  eu size,

+  eu heads,

+  eu tracks,

+  eu first sector,

+  eu last sector:

+

+LET table length = 15,

+ 

+    size field         = 1,

+    head field         = 2,

+    track field        = 3,

+    first sector field = 4,

+    last  sector field = 5;

+

+ROW table length ROW 5 INT VAR format table;

+

+INT VAR table top,

+        table pointer;

+

+PROC open eu disk:

+  enable stop;

+  init check rerun;

+(*COND FLOPPY*)

+  INT VAR blocks := archive blocks;

+  search format table entry;

+(*ENDCOND*)

+.

+

+(*COND FLOPPY*)

+search format table entry:

+  table pointer := 1;

+  WHILE format table [table pointer][size field] <> blocks REP

+    table pointer INCR 1;

+    IF table pointer > table top

+      THEN error stop ("Diskettenformat nicht implementiert")

+    FI

+  PER.

+(*ENDCOND*)

+

+END PROC open eu disk;

+

+PROC load shard interface table:

+  FILE VAR f := sequential file (input, "shard interface");

+  TEXT VAR line;

+  table top := 0;

+  WHILE NOT eof (f) REP

+    get line (f, line);

+    IF (line SUB 1) <> ";"

+      THEN load line

+    FI

+  PER.

+

+load line:

+  table top INCR 1;

+  IF table top > table length

+    THEN error stop ("Shard Interface Tabelle zu groß")

+  FI;

+  INT VAR blank pos := 1;

+  format table [table top][size field]         := next int;

+  format table [table top][head field]         := next int;

+  format table [table top][track field]        := next int; 

+  format table [table top][first sector field] := next int;

+  format table [table top][last  sector field] := next int.

+

+next int:

+  line := compress (subtext (line, blank pos)) + " ";

+  blank pos := pos (line, " ");

+  int (subtext (line, 1, blank pos - 1)).

+

+END PROC load shard interface table;

+ 

+INT PROC eu size:

+  format table [table pointer][size field]

+

+END PROC eu size;

+

+INT PROC eu heads:

+  format table [table pointer][head field]

+

+END PROC eu heads;

+

+INT PROC eu tracks:

+  format table [table pointer][track field]

+

+END PROC eu tracks;

+

+INT PROC eu first sector:

+  format table [table pointer][first sector field]

+

+END PROC eu first sector;

+

+INT PROC eu last sector:

+  format table [table pointer][last sector field]

+

+END PROC eu last sector;

+

+END PACKET eu disk;

diff --git a/system/dos/1986/src/eu disk descriptor.hd b/system/dos/1986/src/eu disk descriptor.hd
new file mode 100644
index 0000000..caeef66
--- /dev/null
+++ b/system/dos/1986/src/eu disk descriptor.hd
@@ -0,0 +1,102 @@
+PACKET eu disk DEFINES                          (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  load shard interface table,

+  open eu disk,

+  eu size,

+  eu heads,

+  eu tracks,

+  eu first sector,

+  eu last sector:

+

+LET table length = 15,

+ 

+    size field         = 1,

+    head field         = 2,

+    track field        = 3,

+    first sector field = 4,

+    last  sector field = 5;

+

+ROW table length ROW 5 INT VAR format table;

+

+INT VAR table top,

+        table pointer;

+

+PROC open eu disk:

+  enable stop;

+  init check rerun;

+(*COND FLOPPY

+  INT VAR blocks := archive blocks;

+  search format table entry;

+ENDCOND*)

+.

+

+(*COND FLOPPY

+search format table entry:

+  table pointer := 1;

+  WHILE format table [table pointer][size field] <> blocks REP

+    table pointer INCR 1;

+    IF table pointer > table top

+      THEN error stop ("Diskettenformat nicht implementiert")

+    FI

+  PER.

+ENDCOND*)

+

+END PROC open eu disk;

+

+PROC load shard interface table:

+  FILE VAR f := sequential file (input, "shard interface");

+  TEXT VAR line;

+  table top := 0;

+  WHILE NOT eof (f) REP

+    get line (f, line);

+    IF (line SUB 1) <> ";"

+      THEN load line

+    FI

+  PER.

+

+load line:

+  table top INCR 1;

+  IF table top > table length

+    THEN error stop ("Shard Interface Tabelle zu groß")

+  FI;

+  INT VAR blank pos := 1;

+  format table [table top][size field]         := next int;

+  format table [table top][head field]         := next int;

+  format table [table top][track field]        := next int; 

+  format table [table top][first sector field] := next int;

+  format table [table top][last  sector field] := next int.

+

+next int:

+  line := compress (subtext (line, blank pos)) + " ";

+  blank pos := pos (line, " ");

+  int (subtext (line, 1, blank pos - 1)).

+

+END PROC load shard interface table;

+ 

+INT PROC eu size:

+  format table [table pointer][size field]

+

+END PROC eu size;

+

+INT PROC eu heads:

+  format table [table pointer][head field]

+

+END PROC eu heads;

+

+INT PROC eu tracks:

+  format table [table pointer][track field]

+

+END PROC eu tracks;

+

+INT PROC eu first sector:

+  format table [table pointer][first sector field]

+

+END PROC eu first sector;

+

+INT PROC eu last sector:

+  format table [table pointer][last sector field]

+

+END PROC eu last sector;

+

+END PACKET eu disk;

diff --git a/system/dos/1986/src/eumel-ebcdic + sub b/system/dos/1986/src/eumel-ebcdic + sub
new file mode 100644
index 0000000..5a571cb
--- /dev/null
+++ b/system/dos/1986/src/eumel-ebcdic + sub
@@ -0,0 +1,550 @@
+PACKET eumel ebcdic DEFINES                    (* Copyright (c) 1986 *)

+                                               (* Frank Klapper      *)

+                                               (* 19.02.86           *)

+  ebcdic to eumel with substitution,

+  eumel to ebcdic with substitution:

+

+TEXT VAR bild;

+

+PROC eumel to ebcdic with substitution (TEXT VAR string):

+  bild := "";

+  INT VAR pos;

+  FOR pos FROM 1 UPTO LENGTH string REP

+    bild CAT conversion

+  PER;

+  string := bild.

+

+conversion:

+  SELECT code (string SUB pos) OF

+    CASE   0: "{"240""240""240"{"

+    CASE   1: "{"240""240""241"{"

+    CASE   2: "{"240""240""242"{"

+    CASE   3: "{"240""240""243"{"

+    CASE   4: "{"240""240""244"{"

+    CASE   5: "{"240""240""245"{"

+    CASE   6: "{"240""240""246"{"

+    CASE   7: "{"240""240""247"{"

+    CASE   8: "{"240""240""248"{"

+    CASE   9: "{"240""240""249"{"

+    CASE  10: "%"

+    CASE  11: "{"240""241""241"{"

+    CASE  12: ""12""

+    CASE  13: ""13""

+    CASE  14: "{"240""241""244"{"

+    CASE  15: "{"240""241""245"{"

+    CASE  16: "{"240""241""246"{"

+    CASE  17: "{"240""241""247"{"

+    CASE  18: "{"240""241""248"{"

+    CASE  19: "{"240""241""249"{"

+    CASE  20: "{"240""242""240"{"

+    CASE  21: "{"240""242""241"{"

+    CASE  22: "{"240""242""242"{"

+    CASE  23: "{"240""242""243"{"

+    CASE  24: "{"240""242""244"{"

+    CASE  25: "{"240""242""245"{"

+    CASE  26: "{"240""242""246"{"

+    CASE  27: "{"240""242""247"{"

+    CASE  28: "{"240""242""248"{"

+    CASE  29: "{"240""242""249"{"

+    CASE  30: "{"240""243""240"{"

+    CASE  31: "{"240""243""241"{"

+    CASE  32: "@"

+    CASE  33: "O" 

+    CASE  34: ""

+    CASE  35: "{"

+    CASE  36: "{"240""243""246"{"

+    CASE  37: "l"

+    CASE  38: "P" 

+    CASE  39: "}"

+    CASE  40: "M" 

+    CASE  41: "]" 

+    CASE  42: "\" 

+    CASE  43: "N" 

+    CASE  44: "k"

+    CASE  45: "`" 

+    CASE  46: "K" 

+    CASE  47: "a" 

+    CASE  48: ""240""

+    CASE  49: ""241""

+    CASE  50: ""242""

+    CASE  51: ""243""

+    CASE  52: ""244""

+    CASE  53: ""245""

+    CASE  54: ""246""

+    CASE  55: ""247""

+    CASE  56: ""248""

+    CASE  57: ""249""

+    CASE  58: "z"

+    CASE  59: "^" 

+    CASE  60: "L" 

+    CASE  61: "~"

+    CASE  62: "n"

+    CASE  63: "o"

+    CASE  64: "|"

+    CASE  65: "�"

+    CASE  66: "�"

+    CASE  67: "�"

+    CASE  68: "�"

+    CASE  69: "�"

+    CASE  70: "�"

+    CASE  71: "�"

+    CASE  72: "�"

+    CASE  73: "�"

+    CASE  74: "�"

+    CASE  75: "�"

+    CASE  76: "�"

+    CASE  77: "�"

+    CASE  78: "�"

+    CASE  79: "�"

+    CASE  80: "�"

+    CASE  81: "�"

+    CASE  82: "�"

+    CASE  83: ""226""

+    CASE  84: ""227""

+    CASE  85: ""228""

+    CASE  86: ""229""

+    CASE  87: ""230""

+    CASE  88: ""231""

+    CASE  89: ""232""

+    CASE  90: ""233""

+    CASE  91: "J"

+    CASE  92: ""224""

+    CASE  93: "Z"

+    CASE  94: "{"240""249""244"{"

+    CASE  95: "m"

+    CASE  96: "y"

+    CASE  97: "�"

+    CASE  98: "�"

+    CASE  99: "�"

+    CASE 100: "�"

+    CASE 101: "�"

+    CASE 102: "�"

+    CASE 103: "�"

+    CASE 104: "�"

+    CASE 105: "�"

+    CASE 106: "�"

+    CASE 107: "�"

+    CASE 108: "�"

+    CASE 109: "�"

+    CASE 110: "�"

+    CASE 111: "�"

+    CASE 112: "�"

+    CASE 113: "�"

+    CASE 114: "�"

+    CASE 115: "�"

+    CASE 116: "�"

+    CASE 117: "�"

+    CASE 118: "�"

+    CASE 119: "�"

+    CASE 120: "�"

+    CASE 121: "�"

+    CASE 122: "�"

+    CASE 123: "�"

+    CASE 124: "{"241""242""244"{"

+    CASE 125: "�"

+    CASE 126: "�"

+    CASE 127: "{"241""242""247"{"

+    CASE 128: "{"241""242""248"{"

+    CASE 129: "{"241""242""249"{"

+    CASE 130: "{"241""243""240"{"

+    CASE 131: "{"241""243""241"{"

+    CASE 132: "{"241""243""242"{"

+    CASE 133: "{"241""243""243"{"

+    CASE 134: "{"241""243""244"{"

+    CASE 135: "{"241""243""245"{"

+    CASE 136: "{"241""243""246"{"

+    CASE 137: "{"241""243""247"{"

+    CASE 138: "{"241""243""248"{"

+    CASE 139: "{"241""243""249"{"

+    CASE 140: "{"241""244""240"{"

+    CASE 141: "{"241""244""241"{"

+    CASE 142: "{"241""244""242"{"

+    CASE 143: "{"241""244""243"{"

+    CASE 144: "{"241""244""244"{"

+    CASE 145: "{"241""244""245"{"

+    CASE 146: "{"241""244""246"{"

+    CASE 147: "{"241""244""247"{"

+    CASE 148: "{"241""244""248"{"

+    CASE 149: "{"241""244""249"{"

+    CASE 150: "{"241""245""240"{"

+    CASE 151: "{"241""245""241"{"

+    CASE 152: "{"241""245""242"{"

+    CASE 153: "{"241""245""243"{"

+    CASE 154: "{"241""245""244"{"

+    CASE 155: "{"241""245""245"{"

+    CASE 156: "{"241""245""246"{"

+    CASE 157: "{"241""245""247"{"

+    CASE 158: "{"241""245""248"{"

+    CASE 159: "{"241""245""249"{"

+    CASE 160: "{"241""246""240"{"

+    CASE 161: "{"241""246""241"{"

+    CASE 162: "{"241""246""242"{"

+    CASE 163: "{"241""246""243"{"

+    CASE 164: "{"241""246""244"{"

+    CASE 165: "{"241""246""245"{"

+    CASE 166: "{"241""246""246"{"

+    CASE 167: "{"241""246""247"{"

+    CASE 168: "{"241""246""248"{"

+    CASE 169: "{"241""246""249"{"

+    CASE 170: "{"241""247""240"{"

+    CASE 171: "{"241""247""241"{"

+    CASE 172: "{"241""247""242"{"

+    CASE 173: "{"241""247""243"{"

+    CASE 174: "{"241""247""244"{"

+    CASE 175: "{"241""247""245"{"

+    CASE 176: "{"241""247""246"{"

+    CASE 177: "{"241""247""247"{"

+    CASE 178: "{"241""247""248"{"

+    CASE 179: "{"241""247""249"{"

+    CASE 180: "{"241""248""240"{"

+    CASE 181: "{"241""248""241"{"

+    CASE 182: "{"241""248""242"{"

+    CASE 183: "{"241""248""243"{"

+    CASE 184: "{"241""248""244"{"

+    CASE 185: "{"241""248""245"{"

+    CASE 186: "{"241""248""246"{"

+    CASE 187: "{"241""248""247"{"

+    CASE 188: "{"241""248""248"{"

+    CASE 189: "{"241""248""249"{"

+    CASE 190: "{"241""249""240"{"

+    CASE 191: "{"241""249""241"{"

+    CASE 192: "{"241""249""242"{"

+    CASE 193: "{"241""249""243"{"

+    CASE 194: "{"241""249""244"{"

+    CASE 195: "{"241""249""245"{"

+    CASE 196: "{"241""249""246"{"

+    CASE 197: "{"241""249""247"{"

+    CASE 198: "{"241""249""248"{"

+    CASE 199: "{"241""249""249"{"

+    CASE 200: "{"242""240""240"{"

+    CASE 201: "{"242""240""241"{"

+    CASE 202: "{"242""240""242"{"

+    CASE 203: "{"242""240""243"{"

+    CASE 204: "{"242""240""244"{"

+    CASE 205: "{"242""240""245"{"

+    CASE 206: "{"242""240""246"{"

+    CASE 207: "{"242""240""247"{"

+    CASE 208: "{"242""240""248"{"

+    CASE 209: "{"242""240""249"{"

+    CASE 210: "{"242""241""240"{"

+    CASE 211: "{"242""241""241"{"

+    CASE 212: "{"242""241""242"{"

+    CASE 213: "{"242""241""243"{"

+    CASE 214: "{"242""241""244"{"

+    CASE 215: "{"242""241""245"{"

+    CASE 216: "{"242""241""246"{"

+    CASE 217: "{"242""241""247"{"

+    CASE 218: "{"242""241""248"{"

+    CASE 219: "{"242""241""249"{"

+    CASE 220: "�"

+    CASE 221: "`" 

+    CASE 222: "{"

+    CASE 223: "@"

+    CASE 224: "{"242""242""244"{"

+    CASE 225: "{"242""242""245"{"

+    CASE 226: "{"242""242""246"{"

+    CASE 227: "{"242""242""247"{"

+    CASE 228: "{"242""242""248"{"

+    CASE 229: "{"242""242""249"{"

+    CASE 230: "{"242""243""240"{"

+    CASE 231: "{"242""243""241"{"

+    CASE 232: "{"242""243""242"{"

+    CASE 233: "{"242""243""243"{"

+    CASE 234: "{"242""243""244"{"

+    CASE 235: "{"242""243""245"{"

+    CASE 236: "{"242""243""246"{"

+    CASE 237: "{"242""243""247"{"

+    CASE 238: "{"242""243""248"{"

+    CASE 239: "{"242""243""249"{"

+    CASE 240: "{"242""244""240"{"

+    CASE 241: "{"242""244""241"{"

+    CASE 242: "{"242""244""242"{"

+    CASE 243: "{"242""244""243"{"

+    CASE 244: "{"242""244""244"{"

+    CASE 245: "{"242""244""245"{"

+    CASE 246: "{"242""244""246"{"

+    CASE 247: "{"242""244""247"{"

+    CASE 248: "{"242""244""248"{"

+    CASE 249: "{"242""244""249"{"

+    CASE 250: "{"242""245""240"{"

+    CASE 251: "{"242""245""241"{"

+    CASE 252: "{"242""245""242"{"

+    CASE 253: "{"242""245""243"{"

+    CASE 254: "{"242""245""244"{"

+    CASE 255: "{"242""245""245"{"

+    OTHERWISE ""

+  END SELECT.

+

+END PROC eumel to ebcdic with substitution;

+

+PROC ebcdic to eumel with substitution (TEXT VAR string):

+  bild := "";

+  INT VAR pos;

+  FOR pos FROM 1 UPTO LENGTH string REP

+    bild CAT conversion

+  PER;

+  string := bild.

+

+conversion:

+  SELECT code (string SUB pos) OF

+    CASE   0: "#000#"

+    CASE   1: "#001#"

+    CASE   2: "#002#"

+    CASE   3: "#003#"

+    CASE   4: "#004#"

+    CASE   5: "#005#"

+    CASE   6: "#006#"

+    CASE   7: "#007#"

+    CASE   8: "#008#"

+    CASE   9: "#009#"

+    CASE  10: "#010#"

+    CASE  11: "#011#"

+    CASE  12: "#012#"

+    CASE  13: "#013#"

+    CASE  14: "#014#"

+    CASE  15: "#015#"

+    CASE  16: "#016#"

+    CASE  17: "#017#"

+    CASE  18: "#018#"

+    CASE  19: "#019#"

+    CASE  20: "#020#"

+    CASE  21: "#021#"

+    CASE  22: "#022#"

+    CASE  23: "#023#"

+    CASE  24: "#024#"

+    CASE  25: "#025#"

+    CASE  26: "#026#"

+    CASE  27: "#027#"

+    CASE  28: "#028#"

+    CASE  29: "#029#"

+    CASE  30: "#030#"

+    CASE  31: "#031#"

+    CASE  32: "#032#"

+    CASE  33: "#033#"

+    CASE  34: "#034#"

+    CASE  35: "#035#"

+    CASE  36: "#036#"

+    CASE  37: "#037#"

+    CASE  38: "#038#"

+    CASE  39: "#039#"

+    CASE  40: "#040#"

+    CASE  41: "#041#"

+    CASE  42: "#042#"

+    CASE  43: "#043#"

+    CASE  44: "#044#"

+    CASE  45: "#045#"

+    CASE  46: "#046#"

+    CASE  47: "#047#"

+    CASE  48: "#048#"

+    CASE  49: "#049#"

+    CASE  50: "#050#"

+    CASE  51: "#051#"

+    CASE  52: "#052#"

+    CASE  53: "#053#"

+    CASE  54: "#054#"

+    CASE  55: "#055#"

+    CASE  56: "#056#"

+    CASE  57: "#057#"

+    CASE  58: "#058#"

+    CASE  59: "#059#"

+    CASE  60: "#060#"

+    CASE  61: "#061#"

+    CASE  62: "#062#"

+    CASE  63: "#063#"

+    CASE  64: "#064#"

+    CASE  65: "#065#"

+    CASE  66: "#066#"

+    CASE  67: "#067#"

+    CASE  68: "#068#"

+    CASE  69: "#069#"

+    CASE  70: "#070#"

+    CASE  71: "#071#"

+    CASE  72: "#072#"

+    CASE  73: "#073#"

+    CASE  74: "["

+    CASE  75: "."

+    CASE  76: "<"

+    CASE  77: "("

+    CASE  78: "+"

+    CASE  79: "!"

+    CASE  80: "&"

+    CASE  81: "#081#"

+    CASE  82: "#082#"

+    CASE  83: "#083#"

+    CASE  84: "#084#"

+    CASE  85: "#085#"

+    CASE  86: "#086#"

+    CASE  87: "#087#"

+    CASE  88: "#088#"

+    CASE  89: "#089#"

+    CASE  90: "]"

+    CASE  91: "$"

+    CASE  92: "*"

+    CASE  93: ")"

+    CASE  94: ";"

+    CASE  95: "^"

+    CASE  96: "-"

+    CASE  97: "/"

+    CASE  98: "#098#"

+    CASE  99: "#099#"

+    CASE 100: "#100#"

+    CASE 101: "#101#"

+    CASE 102: "#102#"

+    CASE 103: "#103#"

+    CASE 104: "#104#"

+    CASE 105: "#105#"

+    CASE 106: "|"

+    CASE 107: ","

+    CASE 108: "%"

+    CASE 109: "_"

+    CASE 110: ">"

+    CASE 111: "?"

+    CASE 112: "#112#"

+    CASE 113: "#113#"

+    CASE 114: "#114#"

+    CASE 115: "#115#"

+    CASE 116: "#116#"

+    CASE 117: "#117#"

+    CASE 118: "#118#"

+    CASE 119: "#119#"

+    CASE 120: "#120#"

+    CASE 121: "`"

+    CASE 122: ":"

+    CASE 123: "#"

+    CASE 124: "@"

+    CASE 125: "'"

+    CASE 126: "="

+    CASE 127: """"

+    CASE 128: "#128#"

+    CASE 129: "a"

+    CASE 130: "b"

+    CASE 131: "c"

+    CASE 132: "d"

+    CASE 133: "e"

+    CASE 134: "f"

+    CASE 135: "g"

+    CASE 136: "h"

+    CASE 137: "i"

+    CASE 138: "#138#"

+    CASE 139: "#139#"

+    CASE 140: "#140#"

+    CASE 141: "#141#"

+    CASE 142: "#142#"

+    CASE 143: "#143#"

+    CASE 144: "#144#"

+    CASE 145: "j"

+    CASE 146: "k"

+    CASE 147: "l"

+    CASE 148: "m"

+    CASE 149: "n"

+    CASE 150: "o"

+    CASE 151: "p"

+    CASE 152: "q"

+    CASE 153: "r"

+    CASE 154: "#154#"

+    CASE 155: "#155#"

+    CASE 156: "#156#"

+    CASE 157: "#157#"

+    CASE 158: "#158#"

+    CASE 159: "#159#"

+    CASE 160: "#160#"

+    CASE 161: "~"

+    CASE 162: "s"

+    CASE 163: "t"

+    CASE 164: "u"

+    CASE 165: "v"

+    CASE 166: "w"

+    CASE 167: "x"

+    CASE 168: "y"

+    CASE 169: "z"

+    CASE 170: "#170#"

+    CASE 171: "#171#"

+    CASE 172: "#172#"

+    CASE 173: "#173#"

+    CASE 174: "#174#"

+    CASE 175: "#175#"

+    CASE 176: "#176#"

+    CASE 177: "#177#"

+    CASE 178: "#178#"

+    CASE 179: "#179#"

+    CASE 180: "#180#"

+    CASE 181: "#181#"

+    CASE 182: "#182#"

+    CASE 183: "#183#"

+    CASE 184: "#184#"

+    CASE 185: "#185#"

+    CASE 186: "#186#"

+    CASE 187: "#187#"

+    CASE 188: "#188#"

+    CASE 189: "#189#"

+    CASE 190: "#190#"

+    CASE 191: "#191#"

+    CASE 192: "{"

+    CASE 193: "A"

+    CASE 194: "B"

+    CASE 195: "C"

+    CASE 196: "D"

+    CASE 197: "E"

+    CASE 198: "F"

+    CASE 199: "G"

+    CASE 200: "H"

+    CASE 201: "I"

+    CASE 202: "#202#"

+    CASE 203: "#203#"

+    CASE 204: "#204#"

+    CASE 205: "#205#"

+    CASE 206: "#206#"

+    CASE 207: "#207#"

+    CASE 208: "}"

+    CASE 209: "J"

+    CASE 210: "K"

+    CASE 211: "L"

+    CASE 212: "M"

+    CASE 213: "N"

+    CASE 214: "O"

+    CASE 215: "P"

+    CASE 216: "Q"

+    CASE 217: "R"

+    CASE 218: "#218#"

+    CASE 219: "#219#"

+    CASE 220: "#220#"

+    CASE 221: "#221#"

+    CASE 222: "#222#"

+    CASE 223: "#223#"

+    CASE 224: "\"

+    CASE 225: "#225#"

+    CASE 226: "S"

+    CASE 227: "T"

+    CASE 228: "U"

+    CASE 229: "V"

+    CASE 230: "W"

+    CASE 231: "X"

+    CASE 232: "Y"

+    CASE 233: "Z"

+    CASE 234: "#234#"

+    CASE 235: "#235#"

+    CASE 236: "#236#"

+    CASE 237: "#237#"

+    CASE 238: "#238#"

+    CASE 239: "#239#"

+    CASE 240: "0"

+    CASE 241: "1"

+    CASE 242: "2"

+    CASE 243: "3"

+    CASE 244: "4"

+    CASE 245: "5"

+    CASE 246: "6"

+    CASE 247: "7"

+    CASE 248: "8"

+    CASE 249: "9"

+    CASE 250: "#250#"

+    CASE 251: "#251#"

+    CASE 252: "#252#"

+    CASE 253: "#253#"

+    CASE 254: "#254#"

+    CASE 255: "#255#"

+    OTHERWISE ""

+  END SELECT.

+END PROC ebcdic to eumel with substitution;

+

+END PACKET eumel ebcdic;

diff --git a/system/dos/1986/src/fat and dir.dos.fd b/system/dos/1986/src/fat and dir.dos.fd
new file mode 100644
index 0000000..35cf118
--- /dev/null
+++ b/system/dos/1986/src/fat and dir.dos.fd
@@ -0,0 +1,1190 @@
+PACKET dos fat and dir DEFINES               (* Copyright (C) 1985, 86 *)

+                                             (* Frank Klapper          *)

+  open disk,                                 (* 30.05.86               *)

+  close disk,

+  format disk,

+  disk changed,

+  open fetch,

+  next fetch cluster no,

+  open save,

+  next save cluster no,

+  close save,

+  erase table entrys,

+(*COND TEST

+  dump fat,

+ENDCOND*)

+  dir all,

+  dir list,

+  dir contains:

+

+LET fat row size            = 16384,     (* 32 KB *)

+    max fat blocks          = 25,

+    first fat entry no      = 2,

+    last entry of fat chain = 4088,

+    dir entrys per block    = 16, 

+    max dir entrys          = 1600,      (* 100 KB *)

+    archive byte            = " ";

+ 

+LET FAT   = BOUND STRUCT (ALIGN dummy,

+                          ROW 256 INT block row,

+                          ROW fat row size INT fat row); 

+

+LET LOCATION = STRUCT (INT msdos block no,

+                           block entry no),

+

+    FILEENTRY = STRUCT (TEXT date and time,

+                        REAL size,

+                        INT first cluster, 

+                        LOCATION location),

+

+    DIRENTRY = INT,

+

+    FILELIST = STRUCT (THESAURUS thes,

+                       ROW max dir entrys FILEENTRY entry,

+                       INT no of entrys),

+

+    DIRLIST = STRUCT (THESAURUS thes,

+                      ROW max dir entrys DIRENTRY entry,

+                      INT no of entrys),

+

+    FREELIST = STRUCT (ROW max dir entrys LOCATION stack,

+                       INT stacktop,

+                       LOCATION begin of free area,

+                                end of dir,

+                       INT dir chain root),

+ 

+    DIR = BOUND STRUCT (FILELIST filelist,

+                        DIRLIST dirlist, 

+                        FREELIST freelist,

+                        TEXT disklabel,

+                             path);

+ 

+INITFLAG VAR this packet := FALSE;

+

+DATASPACE VAR fat space,

+              dir ds, 

+              block ds; 

+ 

+BOOL VAR dataspaces open;

+ 

+FAT VAR fat struct;

+ROW max fat blocks BOOL VAR write access;

+INT VAR first possible available fat entry;

+

+DIR VAR dir;

+ 

+CLUSTER VAR block;

+

+INT VAR akt file cluster no,

+        first file cluster no;

+BOOL VAR no cluster saved;

+TEXT VAR save name;

+

+INT VAR count;

+

+TEXT VAR convert buffer := "  ",

+         name,

+         dir entry;

+

+.fat:

+  fat struct.fat row.

+

+PROC open disk (TEXT CONST subdir path):

+  disable stop;

+  enable open disk (subdir path);

+  IF is error

+    THEN close action

+  FI

+

+END PROC open disk;

+

+PROC enable open disk (TEXT CONST subdir path):

+  enable stop;

+  init dataspaces;

+  open fat;

+  open dir.

+ 

+open fat:

+  reset disk attributes;

+  read first fat block;

+  set disk attributes (fat byte (0));

+  read other fat blocks;

+  define write access table (FALSE);

+  first possible available fat entry := first fat entry no.

+

+read first fat block:

+  read fat block (0, FALSE).

+

+read other fat blocks:

+  INT VAR block no;

+  FOR block no FROM 1 UPTO number of fat sectors - 1 REP

+     read fat block (block no, FALSE)

+  PER.

+

+open dir:

+  init dir struct (subdir path, -1);

+  load main dir blocks;

+  load subdirs if necessary.

+

+load main dir blocks:

+  BOOL VAR last block;

+  store end of dir (loc (end of main dir, dir entrys per block - 1));

+  FOR block no FROM begin of dir UPTO end of main dir REP

+    load dir block (block no, last block);

+    UNTIL last block

+  PER. 

+

+end of main dir:

+  begin of dir + number of dir sectors - 1.

+

+load subdirs if necessary: 

+  TEXT VAR path := subdir path;

+  WHILE path <> "" REP

+    load next subdir if possible

+  PER.

+

+load next subdir if possible:

+  INT VAR cluster no;

+  get next subdir name;

+  get first cluster no of subdir table;

+  clear dir entrys (cluster no);

+  WHILE cluster no >= 0 REP

+    load subdir entrys of cluster;

+    cluster no := next fetch cluster no

+    UNTIL last block 

+  PER.

+

+get next subdir name:

+  TEXT VAR subdir name;

+  IF (path SUB 1) <> "\"

+    THEN error stop ("ungültige Pfadbezeichnung")

+  FI;

+  INT VAR backslash pos := pos (path, "\", "\", 2);

+  IF backslash pos = 0

+    THEN subdir name := subtext (path, 2);

+         path := ""

+    ELSE subdir name := subtext (path, 2, backslash pos - 1);

+         path := subtext (path, backslash pos)

+  FI;

+  subdir name := adapted name (subdir name, TRUE).

+

+get first cluster no of subdir table:

+  IF dir thes CONTAINS subdir name

+    THEN open fetch subdir (subdir name, cluster no);

+    ELSE error stop ("Subdirectory existiert nicht")

+  FI.

+

+load subdir entrys of cluster:

+  store end of dir (loc (last block no of cluster, dir entrys per block - 1));

+  FOR block no FROM 0 UPTO (sectors per cluster - 1) REP

+    load dir block (first block no of cluster (cluster no) + block no, last block)

+    UNTIL last block

+  PER.

+

+last block no of cluster:

+  first block no of cluster (cluster no) + sectors per cluster - 1.

+

+END PROC enable open disk;

+

+PROC init dataspaces:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF NOT dataspaces open

+   THEN disable stop;

+         dataspaces open := TRUE;

+         fat space  := nilspace;

+         dir   ds   := nilspace;

+         block ds   := nilspace;

+         fat struct := fat space;

+         dir        := dir ds; 

+         block      := block ds 

+  FI.

+

+END PROC init dataspaces;

+

+PROC init dir struct (TEXT CONST path string, INT CONST root):

+  clear dir entrys (root);

+  dir.path := path string;

+  dir.disk label := "". 

+

+END PROC init dir struct;

+

+PROC clear dir entrys (INT CONST root):

+  init file list;

+  init dir list;

+  init free list (root).

+

+init file list:

+  dir.file list.thes := empty thesaurus;

+  dir.file list.no of entrys := 0.

+

+init dir list:

+  dir.dir list.thes := empty thesaurus;

+  dir.dir list.no of entrys := 0. 

+

+END PROC clear dir entrys;

+

+PROC close disk:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF dataspaces open 

+    THEN forget (dir ds);

+         forget (block ds);

+         forget (fat space);

+         dataspaces open := FALSE

+  FI.

+

+END PROC close disk;

+

+(*COND FLOPPY*)

+PROC format disk:

+  enable stop;

+  init dataspaces;

+  format fat;

+  format dir.

+

+format fat:

+  write first four fat bytes;

+  write other fat bytes;

+  define write access table (TRUE);

+  copy fat to disk.

+

+write first four fat bytes:

+  fat [1] := word (first fat byte, 255);

+  fat [2] := word (255, 0).

+

+write other fat bytes:

+  FOR count FROM 3 UPTO fat length REP

+    fat [count] := 0

+  PER.

+

+fat length:

+  INT VAR len := number of fat entrys + number of fat entrys DIV 2

+                       + number of fat entrys MOD 2;

+  len DIV 2 + len MOD 2.

+ 

+format dir:

+  init dir struct ("", -1);

+  store begin of free area (loc (begin of dir, 0));

+  store end of dir (loc (end of dir, dir entrys per block - 1));

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM begin of dir UPTO end of dir REP

+    write disk block (block ds, count);

+  PER.

+

+end of dir:

+  begin of dir + number of dir sectors - 1. 

+

+END PROC format disk;

+(*ENDCOND*)

+

+(*COND HDU

+PROC disk clear:

+  error stop ("nicht implementiert")

+

+END PROC disk clear;

+

+PROC format disk:

+  error stop ("nicht implementiert")

+

+END PROC format disk;

+ENDCOND*)

+

+INT PROC word (INT CONST low byte, high byte):

+  convert buffer := code (low byte) + code (high byte);

+  convert buffer ISUB 1.

+

+END PROC word;

+ 

+BOOL PROC disk changed:

+(*COND FLOPPY*)

+  disable stop;

+  NOT first fat block ok COR is error     (* must be COR *)

+(*ENDCOND*)

+(*COND HDU

+  FALSE

+ENDCOND*)

+

+END PROC disk changed;

+

+BOOL PROC first fat block ok:

+  enable stop;

+  read fat block (0, TRUE);

+  FOR count FROM 1 UPTO 256 REP

+    compare word

+  PER; 

+  TRUE.

+

+compare word:

+  IF fat struct.fat row [count] <> fat struct.block row [count] 

+    THEN LEAVE first fat block ok WITH FALSE

+  FI. 

+

+END PROC first fat block ok;

+

+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):

+  enable stop;

+  first cluster no := dir.file list.entry [link index].first cluster;

+  size             := dir.file list.entry [link index].size;

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (file thes, name).

+

+END PROC open fetch;

+ 

+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):

+  first cluster no := dir.dir list.entry [link index];

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (dir thes, subdir name).

+

+END PROC open fetch subdir;

+

+INT PROC next fetch cluster no:

+  enable stop;

+  akt file cluster no := fat entry (akt file cluster no);

+  IF akt file cluster no < 4088  (*ff8h *)

+    THEN akt file cluster no

+    ELSE -1

+  FI.

+

+END PROC next fetch cluster no; 

+

+PROC open save (TEXT CONST file name):

+  enable stop;

+  save name := file name;

+  IF dir full

+    THEN error stop ("Directory voll")

+  FI;

+  IF dir thes CONTAINS file name

+    THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")

+  FI;

+  IF file thes CONTAINS file name

+    THEN error stop ("Datei mit gleichem Namen existiert bereits")

+  FI;

+  no cluster saved := TRUE.

+

+END PROC open save;

+

+INT PROC next save cluster no:

+  enable stop;

+  IF no cluster saved

+    THEN akt file cluster no   := available fat entry;

+         first file cluster no := akt file cluster no;

+         no cluster saved := FALSE

+    ELSE INT VAR old cluster no := akt file cluster no;

+         akt file cluster no := available fat entry;

+         write fat entry (old cluster no, akt file cluster no)

+  FI;

+  write fat entry (akt file cluster no, last entry of fat chain);

+  akt file cluster no.

+

+END PROC next save cluster no;

+

+PROC close save (REAL CONST size):

+  enable stop;

+  IF no cluster saved

+    THEN insert dir entry (save name, 4088, 0.0)

+    ELSE copy fat to disk;

+         insert dir entry (save name, first file cluster no, size)

+  FI.

+

+END PROC close save;

+

+PROC erase table entrys (TEXT CONST name):

+  enable stop;

+  INT VAR first file cluster := first cluster;

+  delete dir entry (name);

+  erase fat chain (first file cluster);

+  copy fat to disk.

+

+first cluster:

+  dir.file list.entry [link index].first cluster.

+ 

+link index:

+  link (file thes, name).

+

+END PROC erase table entrys;

+

+INT PROC fat entry (INT CONST entry no):

+  fix bytes;

+  construct value.

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+construct value:

+  IF entry no MOD 2 = 0

+    THEN (right byte MOD 16) * 256 + left byte 

+    ELSE right byte * 16 + left byte DIV 16

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+

+END PROC fat entry;

+

+INT PROC available fat entry:

+  FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP

+    IF is available entry (count)

+      THEN first possible available fat entry := count;

+           LEAVE available fat entry WITH count

+    FI;

+  PER;

+  close action; error stop ("MS-DOS Datentraeger voll"); maxint.

+

+END PROC available fat entry;

+

+BOOL PROC is available entry (INT CONST entry no):

+  is zero entry.

+

+is zero entry:

+  IF entry no MOD 2 = 0

+    THEN (left byte = 0) CAND ((right byte MOD 16) = 0)

+    ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+ 

+first byte no:

+  entry no + entry no DIV 2.

+ 

+END PROC is available entry;

+

+PROC erase fat chain (INT CONST first entry):

+  INT VAR akt  entry no := first entry,

+          entry         := fat entry (akt entry no);

+  WHILE akt entry no not last chain entry no  REP

+    erase akt entry;

+    akt entry no := entry;

+    entry := fat entry (akt entry no)

+  PER;

+  erase akt entry.

+

+akt entry no not last chain entry no:

+  (entry < last entry of fat chain) AND (entry > 1).

+

+erase akt entry:

+  write fat entry (akt entry no, 0).

+

+END PROC erase fat chain; 

+

+PROC write fat entry (INT CONST entry no, value):

+  fix bytes;

+  remark write access (fat block of first  byte);

+  remark write access (fat block of second byte);

+  write value;

+  update first possible available entry. 

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+fat block of first byte:

+  first byte no DIV 512.

+

+fat block of second byte:

+  second byte no DIV 512.

+

+write value:

+  IF even entry no

+    THEN write fat byte (first  byte no, value MOD 256);

+         write fat byte (second byte no,

+                        (right byte DIV 16) * 16 + value DIV 256)

+    ELSE write fat byte (first byte no,

+                         (left byte MOD 16) + 16 * (value MOD 16));

+         write fat byte (second byte no, value DIV 16)

+  FI.

+

+even entry no:

+  entry no MOD 2 = 0.

+

+second byte no:

+  first byte no + 1.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (second byte no).

+

+update first possible available entry:

+  IF value = 0

+    THEN first possible available fat entry := 

+         min (first possible available fat entry, entry no)

+  FI.

+

+END PROC write fat entry; 

+

+INT PROC fat byte (INT CONST no): 

+  replace (convert buffer, 1, word); 

+  IF even byte no

+    THEN code (convert buffer SUB 1)

+    ELSE code (convert buffer SUB 2)

+  FI. 

+ 

+even byte no:

+  no MOD 2 = 0.

+

+word: 

+  fat [no DIV 2 + 1]. 

+

+END PROC fat byte; 

+ 

+PROC write fat byte (INT CONST byte no, new value):

+  read old word;

+  change byte;

+  write new word.

+

+read old word: 

+  replace (convert buffer, 1, word).

+

+write new word:

+  word := convert buffer ISUB 1.

+

+word:

+  fat [byte no DIV 2 + 1].

+

+change byte:

+  replace (convert buffer, byte pos, code (new value)).

+

+byte pos:

+  byte no MOD 2 + 1.

+

+END PROC write fat byte;

+

+PROC copy fat to disk:

+  INT VAR block no;

+  FOR block no FROM 0 UPTO number of fat sectors - 1 REP

+    IF was write access (block no)

+      THEN write fat block (block no)

+    FI

+  PER.

+

+END PROC copy fat to disk;

+

+PROC write fat block (INT CONST fat block no):

+  INT VAR fat copy no;

+  INT VAR return code;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies -1 REP

+    write disk block (fat space, ds page no, block no, return code);

+    IF return code > 0

+      THEN close action

+    FI

+  PER;

+  remark no write access (block no);

+  enable stop.

+

+ds page no:

+  first non dummy ds page + fat block no + 1.

+

+block no:

+  begin of fat (fat copy no) + fat block no.

+

+END PROC write fat block;

+

+PROC read fat block (INT CONST fat block, BOOL CONST test block):

+  INT VAR fat copy no;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP

+    clear error;

+    read disk block (fat space, ds page no, fat block no)

+    UNTIL NOT is error

+  PER;

+  IF is error

+    THEN close action

+  FI;

+  enable stop.

+

+ds page no:

+  IF test block

+    THEN first non dummy ds page

+    ELSE fat block + first non dummy ds page + 1

+  FI.

+

+fat block no:

+  begin of fat (fat copy no) + fat block.

+

+END PROC read fat block;

+

+PROC define write access table (BOOL CONST status):

+  FOR count FROM 1 UPTO number of fat sectors REP

+    write access [count] := status

+  PER.

+

+END PROC define write access table;

+

+PROC remark write access (INT CONST fat block no):

+  write access [fat block no + 1] := TRUE

+

+END PROC remark write access;

+

+PROC remark no write access (INT CONST fat block no):

+  write access [fat block no + 1] := FALSE

+

+END PROC remark no write access;

+

+BOOL PROC was write access (INT CONST fat block no):

+  write access [fat block no + 1]

+

+END PROC was write access;

+

+(*COND TEST

+PROC dump fat:                                                     

+  IF NOT exists ("fat dump")                                       

+    THEN open file                                                 

+  FI;                                                              

+  DATASPACE VAR ds := nilspace;                                    

+  FILE VAR in := sequential file (input, "fat dump"),              

+           out := sequential file (output, ds);                    

+  INT VAR i;                                                       

+  TEXT VAR line;                                                   

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    dump fat entry                                                 

+  PER;                                                             

+  forget ("fat dump", quiet);                                      

+  copy (ds, "fat dump");                                           

+  forget (ds).                                                     

+                                                                   

+open file:                                                         

+  in := sequential file (output, "fat dump");                      

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    putline (in, text (i, 4) + ": ")                               

+  PER.                                                             

+                                                                   

+dump fat entry:                                                    

+  cout (i);                                                        

+  getline (in, line);                                              

+  putline (out, line + "  " + text (fat entry (i), 4)).            

+                                                                   

+END PROC dump fat;                                                 

+ENDCOND*)

+

+PROC load dir block (INT CONST block no, BOOL VAR last block): 

+  last block := FALSE;

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  INT VAR entry no,

+          thes index;

+  FOR entry no FROM 0 UPTO dir entrys per block - 1 REP 

+    dir entry := text 32 (block, entry no);

+    process entry

+  PER.

+

+process entry:

+  SELECT pos (""0"."229"", dir entry SUB 1) OF

+    CASE 1: end of dir search

+    CASE 2: main dir entry

+    CASE 3: free entry

+    OTHERWISE file entry

+  END SELECT.

+

+end of dir search:

+  last block := TRUE;

+  store begin of free area (loc (block no, entry no));

+  LEAVE load dir block.

+

+main dir entry:

+  (* no operation *).

+

+free entry:

+  store in free list (loc (block no, entry no)).

+

+file entry:

+  SELECT code (dir entry SUB 12) OF

+    CASE  8: volume label

+    CASE 16: sub dir entry

+    OTHERWISE dos file entry

+  END SELECT.

+

+volume label:

+  dir.disk label := text (dir entry, 1, 11).

+

+sub dir entry:

+  dir.dir list.no of entrys INCR 1;

+  insert (dir thes, name, thes index);

+  dir list entry := first cluster no.

+

+dos file entry:

+  IF dir.file list.no of entrys >= max dir entrys

+    THEN error stop ("Directorytabelle voll")

+  FI;

+  dir.file list.no of entrys INCR 1;

+  insert (file thes, name, thes index);

+  file list entry.first cluster           := first cluster no;

+  file list entry.date and time           := dos date + "  " + dos time;

+  file list entry.size                    := dos storage;

+  file list entry.location.msdos block no := block no;

+  file list entry.location.block entry no := entry no.

+ 

+name:

+  IF name post <> ""

+    THEN name pre + "." + name post

+    ELSE name pre

+  FI.

+

+name pre:

+  compress (subtext (dir entry, 1, 8)).

+

+name post:

+  compress (subtext (dir entry, 9, 11)).

+

+file list entry:

+  dir.file list.entry [thes index].

+

+dir list entry:

+  dir.dir list.entry [thes index].

+

+first cluster no:

+  code (dir entry SUB 27) + 256 * code (dir entry SUB 28).

+

+dos storage:

+  real (code (dir entry SUB 29)) +

+  real (code (dir entry SUB 30)) * 256.0 +

+  real (code (dir entry SUB 31)) * 65536.0 +

+  real (code (dir entry SUB 32)) * 16777216.0.

+

+dos date:

+  day + "." + month + "." + year. 

+ 

+day: 

+  IF code (dir entry SUB 25) MOD 32 < 10 

+    THEN "0" + text (code (dir entry SUB 25) MOD 32) 

+    ELSE text (code (dir entry SUB 25) MOD 32)

+  FI. 

+ 

+month:

+  INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+year:

+  text (80 + code (dir entry SUB 26) DIV 2, 2).

+

+dos time:

+  hour + ":" + minute. 

+ 

+hour: 

+  dummy := code (dir entry SUB 24) DIV 8; 

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+minute: 

+  dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); 

+  IF dummy < 10 

+    THEN "0" + text (dummy)

+    ELSE text (dummy) 

+  FI. 

+ 

+END PROC load dir block; 

+ 

+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):

+  (* name must be a dos name *)

+  LOCATION VAR ins pos := free location;

+  TEXT VAR akt date := date (clock (1)),

+           akt time := time of day (clock (1));

+  write disk entry;

+  write dir struct entry.

+

+write disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  prepare name;

+  dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +

+               dos date + starting cluster + storage;

+  write text 32 (block, dir entry, ins pos.block entry no);

+  write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+prepare name:

+  TEXT VAR name pre, name post;

+  IF point pos > 0

+    THEN name pre  := subtext (name, 1, point pos - 1);

+         name post := subtext (name, point pos + 1);

+         name pre  CAT (8 - LENGTH name pre)  * " ";

+         name post CAT (3 - LENGTH name post) * " "

+    ELSE name pre  := name + (8 - LENGTH name) * " ";

+         name post := "   "

+  FI.

+ 

+point pos:

+  pos (name, "."). 

+ 

+dos time:

+  code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).

+

+hour:

+  int (subtext (akt time, 1, 2)).

+

+minute:

+  int (subtext (akt time, 4, 5)).

+

+dos date:

+   code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).

+

+day: 

+  int (subtext (akt date, 1, 2)).

+

+month:

+  int (subtext (akt date, 4, 5)).

+

+year:

+  int (subtext (akt date, 7, 8)).

+

+starting cluster:

+  code (start cluster MOD 256) + code (start cluster DIV 256).

+

+storage:

+  code (int (round (256.0 * frac (used storage / 256.0), 0))) +

+  code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +

+  code (int (floor (used storage / 65536.0))) +

+  code (0).          (* maximal 16384 K *********************************)

+

+write dir struct entry:

+  INT VAR thes link;

+  insert (file thes, name, thes link);

+  file list entry.location      := ins pos; 

+  file list entry.first cluster := start cluster;

+  file list entry.date and time := akt date + "  " + akt time;

+  file list entry.size          := used storage.

+

+file list entry:

+  dir.filelist.entry [thes link].

+

+END PROC insert dir entry;

+

+PROC delete dir entry (TEXT CONST name):

+  LOCATION VAR del pos;

+  get del pos;

+  erase dir struct entry;

+  erase disk entry;

+  store in free list (del pos).

+

+get del pos:

+  del pos := dir.filelist.entry [link index].location.

+

+link index:

+  link (file thes, name).

+

+erase dir struct entry:

+  INT VAR i;

+  delete (file thes, name, i).

+

+erase disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  dir entry := text 32 (block, del pos.block entry no);

+  replace (dir entry, 1, ""229"");

+  write text 32 (block, dir entry, del pos.block entry no);

+  write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+END PROC delete dir entry;

+ 

+.

+file thes:

+  dir.filelist.thes.

+

+dir thes:

+  dir.dir list.thes.

+

+(*********************** dir information ******************************)

+

+THESAURUS PROC dir all: 

+  file thes.

+ 

+END PROC dir all; 

+ 

+BOOL PROC dir contains (TEXT CONST name): 

+  file thes CONTAINS name

+

+END PROC dir contains;

+ 

+PROC dir list (DATASPACE VAR ds):

+  enable stop;

+  open list file;

+  list files;

+  list dirs;

+  write list head.

+

+open list file:

+  forget (ds);

+  ds := nilspace;

+  FILE VAR list file := sequential file (output, ds);

+  putline (list file, "").

+ 

+list files: 

+  INT VAR number := 0;

+  get (file thes, name, number);

+  WHILE number > 0 REP

+    generate file list line;

+    get (file thes, name, number)

+  PER.

+

+generate file list line:

+  write (list file, centered name);

+  write (list file, "  ");

+  write (list file, text (act file entry.size, 11, 0));

+  write (list file, " Bytes belegt      ");

+  write (list file, act file entry.date and time); 

+(*COND TEST

+  write (list file, "  +++  "); 

+  write (list file, text (act file entry.first cluster)); 

+ENDCOND*)

+  line (list file).

+

+list dirs:

+  number := 0;

+  get (dir thes, name, number);

+  WHILE number > 0 REP

+    generate dir list line;

+    get (dir thes, name, number)

+  PER.

+

+generate dir list line:

+  write (list file, centered name);

+  write (list file, "   <DIR>");

+(*COND TEST

+  write (list file, "  +++  ");                                 

+  write (list file, text (dir.dir list.entry [number]));  

+ENDCOND*)

+  line (list file).

+

+centered name:

+  INT VAR point pos := pos (name, ".");

+  IF point pos > 0

+    THEN name pre + "." + name post

+    ELSE text (name, 12)

+  FI.

+

+name pre:

+  text (subtext (name, 1, point pos - 1), 8).

+

+name post:

+  text (subtext (name, point pos + 1, point pos + 4), 3).

+ 

+act file entry:

+  dir.file list.entry [number].

+

+write list head:

+  head line (list file, head).

+

+head:

+  "DOS" + disk label string + path string.

+

+disk label string:

+  IF dir.disk label <> ""

+    THEN ": " + dir.disk label

+    ELSE ""

+  FI.

+

+path string:

+  IF dir.path <> ""

+    THEN "     PATH: " + dir.path

+    ELSE ""

+  FI.

+

+END PROC dir list;

+ 

+(************ free list handling ******************************************)

+LOCATION PROC loc (INT CONST block, entry):

+  LOCATION : (block, entry) 

+

+END PROC loc;

+

+BOOL OP > (LOCATION CONST l, r):

+  l.msdos block no > r.msdos block no

+  OR ((l.msdos block no = r.msdos block no) AND 

+      (l.block entry no > r.block entry no)     )

+

+END OP >;

+

+OP INCR (LOCATION VAR l):

+  IF l.block entry no = dir entrys per block -1

+    THEN l.block entry no := 0;

+         l.msdos block no INCR 1

+    ELSE l.block entry no INCR 1

+  FI.

+

+END OP INCR;

+

+PROC init free list (INT CONST dir root):

+  dir.freelist.stacktop := 0;

+  dir.freelist.begin of free area.msdos block no := maxint;

+  dir.freelist.end of dir.msdos block no := -1;

+  dir.freelist.dir chain root := dir root.

+

+END PROC init free list;

+ 

+BOOL PROC dir full:

+  stack empty AND free area empty AND NOT expansion alloweded.

+

+stack empty:

+  dir.freelist.stacktop < 1.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC dir full;

+

+PROC store in free list (LOCATION CONST free):

+  dir.freelist.stacktop INCR 1;

+  dir.freelist.stack [top] := free.

+

+top:

+  dir.freelist.stacktop.

+

+END PROC store in free list;

+

+PROC store begin of free area (LOCATION CONST begin):

+  dir.freelist.begin of free area := begin

+

+END PROC store begin of free area;

+

+PROC store end of dir (LOCATION CONST end):

+  dir.freelist.end of dir := end

+

+END PROC store end of dir;

+

+LOCATION PROC free location:

+  LOCATION VAR result;

+  IF dir.freelist.stacktop > 0

+    THEN pop

+    ELIF NOT free area empty

+    THEN first of free area

+    ELIF expansion alloweded

+    THEN allocate new dir space;

+         result := free location

+    ELSE error stop ("Directorytabelle voll")

+  FI;

+  result.

+

+pop:

+  result := dir.freelist.stack [top];

+  top DECR 1.

+

+top:

+  dir.freelist.stack top.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+first of free area:

+  result := dir.freelist.begin of free area;

+  INCR dir.freelist.begin of free area.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC free location; 

+

+PROC allocate new dir space:

+  enable stop;

+  INT VAR new cluster no := available fat entry;

+  IF new cluster no < 0

+    THEN error stop ("MS-DOS Datentraeger voll")

+  FI;

+  INT VAR last entry no;

+  search last entry of fat chain;

+  write fat entry (new cluster no, 4095);

+  write fat entry (last entry no, new cluster no);

+  copy fat to disk;

+  store begin of free area (loc (first new block, 0));

+  store end of dir (loc (last new block, dir entrys per block - 1));

+  init new dir cluster.

+

+search last entry of fat chain:

+  last entry no := dir.freelist.dir chain root;

+  WHILE fat entry (last entry no) < last entry of fat chain REP

+    last entry no := fat entry (last entry no)

+  PER.

+

+init new dir cluster:

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM first new block UPTO last new block REP

+    write disk block (block ds, count);

+  PER.

+

+first new block:

+  firstblock no of cluster (new cluster no).

+

+last new block:

+  first block no of cluster (new cluster no) + sectors per cluster - 1.

+

+END PROC allocate new dir space; 

+

+(*COND TEST

+PROC dump freelist:

+  command dialogue (FALSE);

+  FILE VAR f := sequential file (output, "freelistdump");

+  INT VAR i;

+  putline (f, "STACKTOP: " + text (fl.stacktop));

+  putline (f, "STACK:");

+  FOR i FROM 1 UPTO 16 * number of dir sectors REP

+    putline (f, "   " + text (i, 4) + ":  " +

+                text (fl.stack [i].msdos block no) + ", " +

+                text (fl.stack [i].block entry no))

+  PER; 

+  line (f);

+  putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + 

+            ", "  + text (fl.begin of free area.block entry no));

+  putline (f, "END   OF DIR:  " + text (fl.end of dir.msdos block no) + 

+            ", "  + text (fl.end of dir.block entry no)).

+

+fl:

+  dir.freelist.

+

+END PROC dump free list;

+ENDCOND*)

+

+END PACKET dos fat and dir;

diff --git a/system/dos/1986/src/fat and dir.dos.hd b/system/dos/1986/src/fat and dir.dos.hd
new file mode 100644
index 0000000..2612b25
--- /dev/null
+++ b/system/dos/1986/src/fat and dir.dos.hd
@@ -0,0 +1,1190 @@
+PACKET dos fat and dir DEFINES               (* Copyright (C) 1985, 86 *)

+                                             (* Frank Klapper          *)

+  open disk,                                 (* 30.05.86               *)

+  close disk,

+  format disk,

+  disk changed,

+  open fetch,

+  next fetch cluster no,

+  open save,

+  next save cluster no,

+  close save,

+  erase table entrys,

+(*COND TEST

+  dump fat,

+ENDCOND*)

+  dir all,

+  dir list,

+  dir contains:

+

+LET fat row size            = 16384,     (* 32 KB *)

+    max fat blocks          = 25,

+    first fat entry no      = 2,

+    last entry of fat chain = 4088,

+    dir entrys per block    = 16, 

+    max dir entrys          = 1600,      (* 100 KB *)

+    archive byte            = " ";

+ 

+LET FAT   = BOUND STRUCT (ALIGN dummy,

+                          ROW 256 INT block row,

+                          ROW fat row size INT fat row); 

+

+LET LOCATION = STRUCT (INT msdos block no,

+                           block entry no),

+

+    FILEENTRY = STRUCT (TEXT date and time,

+                        REAL size,

+                        INT first cluster, 

+                        LOCATION location),

+

+    DIRENTRY = INT,

+

+    FILELIST = STRUCT (THESAURUS thes,

+                       ROW max dir entrys FILEENTRY entry,

+                       INT no of entrys),

+

+    DIRLIST = STRUCT (THESAURUS thes,

+                      ROW max dir entrys DIRENTRY entry,

+                      INT no of entrys),

+

+    FREELIST = STRUCT (ROW max dir entrys LOCATION stack,

+                       INT stacktop,

+                       LOCATION begin of free area,

+                                end of dir,

+                       INT dir chain root),

+ 

+    DIR = BOUND STRUCT (FILELIST filelist,

+                        DIRLIST dirlist, 

+                        FREELIST freelist,

+                        TEXT disklabel,

+                             path);

+ 

+INITFLAG VAR this packet := FALSE;

+

+DATASPACE VAR fat space,

+              dir ds, 

+              block ds; 

+ 

+BOOL VAR dataspaces open;

+ 

+FAT VAR fat struct;

+ROW max fat blocks BOOL VAR write access;

+INT VAR first possible available fat entry;

+

+DIR VAR dir;

+ 

+CLUSTER VAR block;

+

+INT VAR akt file cluster no,

+        first file cluster no;

+BOOL VAR no cluster saved;

+TEXT VAR save name;

+

+INT VAR count;

+

+TEXT VAR convert buffer := "  ",

+         name,

+         dir entry;

+

+.fat:

+  fat struct.fat row.

+

+PROC open disk (TEXT CONST subdir path):

+  disable stop;

+  enable open disk (subdir path);

+  IF is error

+    THEN close action

+  FI

+

+END PROC open disk;

+

+PROC enable open disk (TEXT CONST subdir path):

+  enable stop;

+  init dataspaces;

+  open fat;

+  open dir.

+ 

+open fat:

+  reset disk attributes;

+  read first fat block;

+  set disk attributes (fat byte (0));

+  read other fat blocks;

+  define write access table (FALSE);

+  first possible available fat entry := first fat entry no.

+

+ read first fat block:

+  read fat block (0, FALSE).

+

+read other fat blocks:

+  INT VAR block no;

+  FOR block no FROM 1 UPTO number of fat sectors - 1 REP

+     read fat block (block no, FALSE)

+  PER.

+

+open dir:

+  init dir struct (subdir path, -1);

+  load main dir blocks;

+  load subdirs if necessary.

+

+load main dir blocks:

+  BOOL VAR last block;

+  store end of dir (loc (end of main dir, dir entrys per block - 1));

+  FOR block no FROM begin of dir UPTO end of main dir REP

+    load dir block (block no, last block);

+    UNTIL last block

+  PER. 

+

+end of main dir:

+  begin of dir + number of dir sectors - 1.

+

+load subdirs if necessary: 

+  TEXT VAR path := subdir path;

+  WHILE path <> "" REP

+    load next subdir if possible

+  PER.

+

+load next subdir if possible:

+  INT VAR cluster no;

+  get next subdir name;

+  get first cluster no of subdir table;

+  clear dir entrys (cluster no);

+  WHILE cluster no >= 0 REP

+    load subdir entrys of cluster;

+    cluster no := next fetch cluster no

+    UNTIL last block 

+  PER.

+

+get next subdir name:

+  TEXT VAR subdir name;

+  IF (path SUB 1) <> "\"

+    THEN error stop ("ungültige Pfadbezeichnung")

+  FI;

+  INT VAR backslash pos := pos (path, "\", "\", 2);

+  IF backslash pos = 0

+    THEN subdir name := subtext (path, 2);

+         path := ""

+    ELSE subdir name := subtext (path, 2, backslash pos - 1);

+         path := subtext (path, backslash pos)

+  FI;

+  subdir name := adapted name (subdir name, TRUE).

+

+get first cluster no of subdir table:

+  IF dir thes CONTAINS subdir name

+    THEN open fetch subdir (subdir name, cluster no);

+    ELSE error stop ("Subdirectory existiert nicht")

+  FI.

+

+load subdir entrys of cluster:

+  store end of dir (loc (last block no of cluster, dir entrys per block - 1));

+  FOR block no FROM 0 UPTO (sectors per cluster - 1) REP

+    load dir block (first block no of cluster (cluster no) + block no, last block)

+    UNTIL last block

+  PER.

+

+last block no of cluster:

+  first block no of cluster (cluster no) + sectors per cluster - 1.

+

+END PROC enable open disk;

+

+PROC init dataspaces:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF NOT dataspaces open

+   THEN disable stop;

+         dataspaces open := TRUE;

+         fat space  := nilspace;

+         dir   ds   := nilspace;

+         block ds   := nilspace;

+         fat struct := fat space;

+         dir        := dir ds; 

+         block      := block ds 

+  FI.

+

+END PROC init dataspaces;

+

+PROC init dir struct (TEXT CONST path string, INT CONST root):

+  clear dir entrys (root);

+  dir.path := path string;

+  dir.disk label := "". 

+

+END PROC init dir struct;

+

+PROC clear dir entrys (INT CONST root):

+  init file list;

+  init dir list;

+  init free list (root).

+

+init file list:

+  dir.file list.thes := empty thesaurus;

+  dir.file list.no of entrys := 0.

+

+init dir list:

+  dir.dir list.thes := empty thesaurus;

+  dir.dir list.no of entrys := 0. 

+

+END PROC clear dir entrys;

+

+PROC close disk:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF dataspaces open 

+    THEN forget (dir ds);

+         forget (block ds);

+         forget (fat space);

+         dataspaces open := FALSE

+  FI.

+

+END PROC close disk;

+

+(*COND FLOPPY

+PROC format disk:

+  enable stop;

+  init dataspaces;

+  format fat;

+  format dir.

+

+format fat:

+  write first four fat bytes;

+  write other fat bytes;

+  define write access table (TRUE);

+  copy fat to disk.

+

+write first four fat bytes:

+  fat [1] := word (first fat byte, 255);

+  fat [2] := word (255, 0).

+

+write other fat bytes:

+  FOR count FROM 3 UPTO fat length REP

+    fat [count] := 0

+  PER.

+

+fat length:

+  INT VAR len := number of fat entrys + number of fat entrys DIV 2

+                       + number of fat entrys MOD 2;

+  len DIV 2 + len MOD 2.

+ 

+format dir:

+  init dir struct ("", -1);

+  store begin of free area (loc (begin of dir, 0));

+  store end of dir (loc (end of dir, dir entrys per block - 1));

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM begin of dir UPTO end of dir REP

+    write disk block (block ds, count);

+  PER.

+

+end of dir:

+  begin of dir + number of dir sectors - 1. 

+

+END PROC format disk;

+ENDCOND*)

+

+(*COND HDU*)

+PROC disk clear:

+  error stop ("nicht implementiert")

+

+END PROC disk clear;

+

+PROC format disk:

+  error stop ("nicht implementiert")

+

+END PROC format disk;

+(*ENDCOND*)

+

+INT PROC word (INT CONST low byte, high byte):

+  convert buffer := code (low byte) + code (high byte);

+  convert buffer ISUB 1.

+

+END PROC word;

+ 

+BOOL PROC disk changed:

+(*COND FLOPPY

+  disable stop;

+  NOT first fat block ok COR is error     (* must be COR *)

+ENDCOND*)

+(*COND HDU*)

+  FALSE

+(*ENDCOND*)

+

+END PROC disk changed;

+

+BOOL PROC first fat block ok:

+  enable stop;

+  read fat block (0, TRUE);

+  FOR count FROM 1 UPTO 256 REP

+    compare word

+  PER; 

+  TRUE.

+

+compare word:

+  IF fat struct.fat row [count] <> fat struct.block row [count] 

+    THEN LEAVE first fat block ok WITH FALSE

+  FI. 

+

+END PROC first fat block ok;

+

+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):

+  enable stop;

+  first cluster no := dir.file list.entry [link index].first cluster;

+  size             := dir.file list.entry [link index].size;

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (file thes, name).

+

+END PROC open fetch;

+ 

+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):

+  first cluster no := dir.dir list.entry [link index];

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (dir thes, subdir name).

+

+END PROC open fetch subdir;

+

+INT PROC next fetch cluster no:

+  enable stop;

+  akt file cluster no := fat entry (akt file cluster no);

+  IF akt file cluster no < 4088  (*ff8h *)

+    THEN akt file cluster no

+    ELSE -1

+  FI.

+

+END PROC next fetch cluster no; 

+

+PROC open save (TEXT CONST file name):

+  enable stop;

+  save name := file name;

+  IF dir full

+    THEN error stop ("Directory voll")

+  FI;

+  IF dir thes CONTAINS file name

+    THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")

+  FI;

+  IF file thes CONTAINS file name

+    THEN error stop ("Datei mit gleichem Namen existiert bereits")

+  FI;

+  no cluster saved := TRUE.

+

+END PROC open save;

+

+INT PROC next save cluster no:

+  enable stop;

+  IF no cluster saved

+    THEN akt file cluster no   := available fat entry;

+         first file cluster no := akt file cluster no;

+         no cluster saved := FALSE

+    ELSE INT VAR old cluster no := akt file cluster no;

+         akt file cluster no := available fat entry;

+         write fat entry (old cluster no, akt file cluster no)

+  FI;

+  write fat entry (akt file cluster no, last entry of fat chain);

+  akt file cluster no.

+

+END PROC next save cluster no;

+

+PROC close save (REAL CONST size):

+  enable stop;

+  IF no cluster saved

+    THEN insert dir entry (save name, 4088, 0.0)

+    ELSE copy fat to disk;

+         insert dir entry (save name, first file cluster no, size)

+  FI.

+

+END PROC close save;

+

+PROC erase table entrys (TEXT CONST name):

+  enable stop;

+  INT VAR first file cluster := first cluster;

+  delete dir entry (name);

+  erase fat chain (first file cluster);

+  copy fat to disk.

+

+first cluster:

+  dir.file list.entry [link index].first cluster.

+ 

+link index:

+  link (file thes, name).

+

+END PROC erase table entrys;

+

+INT PROC fat entry (INT CONST entry no):

+  fix bytes;

+  construct value.

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+construct value:

+  IF entry no MOD 2 = 0

+    THEN (right byte MOD 16) * 256 + left byte 

+    ELSE right byte * 16 + left byte DIV 16

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+

+END PROC fat entry;

+

+INT PROC available fat entry:

+  FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP

+    IF is available entry (count)

+      THEN first possible available fat entry := count;

+           LEAVE available fat entry WITH count

+    FI;

+  PER;

+  close action; error stop ("MS-DOS Datentraeger voll"); maxint.

+

+END PROC available fat entry;

+

+BOOL PROC is available entry (INT CONST entry no):

+  is zero entry.

+

+is zero entry:

+  IF entry no MOD 2 = 0

+    THEN (left byte = 0) CAND ((right byte MOD 16) = 0)

+    ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+ 

+first byte no:

+  entry no + entry no DIV 2.

+ 

+END PROC is available entry;

+

+PROC erase fat chain (INT CONST first entry):

+  INT VAR akt  entry no := first entry,

+          entry         := fat entry (akt entry no);

+  WHILE akt entry no not last chain entry no  REP

+    erase akt entry;

+    akt entry no := entry;

+    entry := fat entry (akt entry no)

+  PER;

+  erase akt entry.

+

+akt entry no not last chain entry no:

+  (entry < last entry of fat chain) AND (entry > 1).

+

+erase akt entry:

+  write fat entry (akt entry no, 0).

+

+END PROC erase fat chain; 

+

+PROC write fat entry (INT CONST entry no, value):

+  fix bytes;

+  remark write access (fat block of first  byte);

+  remark write access (fat block of second byte);

+  write value;

+  update first possible available entry. 

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+fat block of first byte:

+  first byte no DIV 512.

+

+fat block of second byte:

+  second byte no DIV 512.

+

+write value:

+  IF even entry no

+    THEN write fat byte (first  byte no, value MOD 256);

+         write fat byte (second byte no,

+                        (right byte DIV 16) * 16 + value DIV 256)

+    ELSE write fat byte (first byte no,

+                         (left byte MOD 16) + 16 * (value MOD 16));

+         write fat byte (second byte no, value DIV 16)

+  FI.

+

+even entry no:

+  entry no MOD 2 = 0.

+

+second byte no:

+  first byte no + 1.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (second byte no).

+

+update first possible available entry:

+  IF value = 0

+    THEN first possible available fat entry := 

+         min (first possible available fat entry, entry no)

+  FI.

+

+END PROC write fat entry; 

+

+INT PROC fat byte (INT CONST no): 

+  replace (convert buffer, 1, word); 

+  IF even byte no

+    THEN code (convert buffer SUB 1)

+    ELSE code (convert buffer SUB 2)

+  FI. 

+ 

+even byte no:

+  no MOD 2 = 0.

+

+word: 

+  fat [no DIV 2 + 1]. 

+

+END PROC fat byte; 

+ 

+PROC write fat byte (INT CONST byte no, new value):

+  read old word;

+  change byte;

+  write new word.

+

+read old word: 

+  replace (convert buffer, 1, word).

+

+write new word:

+  word := convert buffer ISUB 1.

+

+word:

+  fat [byte no DIV 2 + 1].

+

+change byte:

+  replace (convert buffer, byte pos, code (new value)).

+

+byte pos:

+  byte no MOD 2 + 1.

+

+END PROC write fat byte;

+

+PROC copy fat to disk:

+  INT VAR block no;

+  FOR block no FROM 0 UPTO number of fat sectors - 1 REP

+    IF was write access (block no)

+      THEN write fat block (block no)

+    FI

+  PER.

+

+END PROC copy fat to disk;

+

+PROC write fat block (INT CONST fat block no):

+  INT VAR fat copy no;

+  INT VAR return code;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies -1 REP

+    write disk block (fat space, ds page no, block no, return code);

+    IF return code > 0

+      THEN close action

+    FI

+  PER;

+  remark no write access (block no);

+  enable stop.

+

+ds page no:

+  first non dummy ds page + fat block no + 1.

+

+block no:

+  begin of fat (fat copy no) + fat block no.

+

+END PROC write fat block;

+

+PROC read fat block (INT CONST fat block, BOOL CONST test block):

+  INT VAR fat copy no;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP

+    clear error;

+    read disk block (fat space, ds page no, fat block no)

+    UNTIL NOT is error

+  PER;

+  IF is error

+    THEN close action

+  FI;

+  enable stop.

+

+ds page no:

+  IF test block

+    THEN first non dummy ds page

+    ELSE fat block + first non dummy ds page + 1

+  FI.

+

+fat block no:

+  begin of fat (fat copy no) + fat block.

+

+END PROC read fat block;

+

+PROC define write access table (BOOL CONST status):

+  FOR count FROM 1 UPTO number of fat sectors REP

+    write access [count] := status

+  PER.

+

+END PROC define write access table;

+

+PROC remark write access (INT CONST fat block no):

+  write access [fat block no + 1] := TRUE

+

+END PROC remark write access;

+

+PROC remark no write access (INT CONST fat block no):

+  write access [fat block no + 1] := FALSE

+

+END PROC remark no write access;

+

+BOOL PROC was write access (INT CONST fat block no):

+  write access [fat block no + 1]

+

+END PROC was write access;

+

+(*COND TEST

+PROC dump fat:                                                     

+  IF NOT exists ("fat dump")                                       

+    THEN open file                                                 

+  FI;                                                              

+  DATASPACE VAR ds := nilspace;                                    

+  FILE VAR in := sequential file (input, "fat dump"),              

+           out := sequential file (output, ds);                    

+  INT VAR i;                                                       

+  TEXT VAR line;                                                   

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    dump fat entry                                                 

+  PER;                                                             

+  forget ("fat dump", quiet);                                      

+  copy (ds, "fat dump");                                           

+  forget (ds).                                                     

+                                                                   

+open file:                                                         

+  in := sequential file (output, "fat dump");                      

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    putline (in, text (i, 4) + ": ")                               

+  PER.                                                             

+                                                                   

+dump fat entry:                                                    

+  cout (i);                                                        

+  getline (in, line);                                              

+  putline (out, line + "  " + text (fat entry (i), 4)).            

+                                                                   

+END PROC dump fat;                                                 

+ENDCOND*)

+

+PROC load dir block (INT CONST block no, BOOL VAR last block): 

+  last block := FALSE;

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  INT VAR entry no,

+          thes index;

+  FOR entry no FROM 0 UPTO dir entrys per block - 1 REP 

+    dir entry := text 32 (block, entry no);

+    process entry

+  PER.

+

+process entry:

+  SELECT pos (""0"."229"", dir entry SUB 1) OF

+    CASE 1: end of dir search

+    CASE 2: main dir entry

+    CASE 3: free entry

+    OTHERWISE file entry

+  END SELECT.

+

+end of dir search:

+  last block := TRUE;

+  store begin of free area (loc (block no, entry no));

+  LEAVE load dir block.

+

+main dir entry:

+  (* no operation *).

+

+free entry:

+  store in free list (loc (block no, entry no)).

+

+file entry:

+  SELECT code (dir entry SUB 12) OF

+    CASE  8: volume label

+    CASE 16: sub dir entry

+    OTHERWISE dos file entry

+  END SELECT.

+

+volume label:

+  dir.disk label := text (dir entry, 1, 11).

+

+sub dir entry:

+  dir.dir list.no of entrys INCR 1;

+  insert (dir thes, name, thes index);

+  dir list entry := first cluster no.

+

+dos file entry:

+  IF dir.file list.no of entrys >= max dir entrys

+    THEN error stop ("Directorytabelle voll")

+  FI;

+  dir.file list.no of entrys INCR 1;

+  insert (file thes, name, thes index);

+  file list entry.first cluster           := first cluster no;

+  file list entry.date and time           := dos date + "  " + dos time;

+  file list entry.size                    := dos storage;

+  file list entry.location.msdos block no := block no;

+  file list entry.location.block entry no := entry no.

+ 

+name:

+  IF name post <> ""

+    THEN name pre + "." + name post

+    ELSE name pre

+  FI.

+

+name pre:

+  compress (subtext (dir entry, 1, 8)).

+

+name post:

+  compress (subtext (dir entry, 9, 11)).

+

+file list entry:

+  dir.file list.entry [thes index].

+

+dir list entry:

+  dir.dir list.entry [thes index].

+

+first cluster no:

+  code (dir entry SUB 27) + 256 * code (dir entry SUB 28).

+

+dos storage:

+  real (code (dir entry SUB 29)) +

+  real (code (dir entry SUB 30)) * 256.0 +

+  real (code (dir entry SUB 31)) * 65536.0 +

+  real (code (dir entry SUB 32)) * 16777216.0.

+

+dos date:

+  day + "." + month + "." + year. 

+ 

+day: 

+  IF code (dir entry SUB 25) MOD 32 < 10 

+    THEN "0" + text (code (dir entry SUB 25) MOD 32) 

+    ELSE text (code (dir entry SUB 25) MOD 32)

+  FI. 

+ 

+month:

+  INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+year:

+  text (80 + code (dir entry SUB 26) DIV 2, 2).

+

+dos time:

+  hour + ":" + minute. 

+ 

+hour: 

+  dummy := code (dir entry SUB 24) DIV 8; 

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+minute: 

+  dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); 

+  IF dummy < 10 

+    THEN "0" + text (dummy)

+    ELSE text (dummy) 

+  FI. 

+ 

+END PROC load dir block; 

+ 

+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):

+  (* name must be a dos name *)

+  LOCATION VAR ins pos := free location;

+  TEXT VAR akt date := date (clock (1)),

+           akt time := time of day (clock (1));

+  write disk entry;

+  write dir struct entry.

+

+write disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  prepare name;

+  dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +

+               dos date + starting cluster + storage;

+  write text 32 (block, dir entry, ins pos.block entry no);

+  write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+prepare name:

+  TEXT VAR name pre, name post;

+  IF point pos > 0

+    THEN name pre  := subtext (name, 1, point pos - 1);

+         name post := subtext (name, point pos + 1);

+         name pre  CAT (8 - LENGTH name pre)  * " ";

+         name post CAT (3 - LENGTH name post) * " "

+    ELSE name pre  := name + (8 - LENGTH name) * " ";

+         name post := "   "

+  FI.

+ 

+point pos:

+  pos (name, "."). 

+ 

+dos time:

+  code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).

+

+hour:

+  int (subtext (akt time, 1, 2)).

+

+minute:

+  int (subtext (akt time, 4, 5)).

+

+dos date:

+   code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).

+

+day: 

+  int (subtext (akt date, 1, 2)).

+

+month:

+  int (subtext (akt date, 4, 5)).

+

+year:

+  int (subtext (akt date, 7, 8)).

+

+starting cluster:

+  code (start cluster MOD 256) + code (start cluster DIV 256).

+

+storage:

+  code (int (round (256.0 * frac (used storage / 256.0), 0))) +

+  code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +

+  code (int (floor (used storage / 65536.0))) +

+  code (0).          (* maximal 16384 K *********************************)

+

+write dir struct entry:

+  INT VAR thes link;

+  insert (file thes, name, thes link);

+  file list entry.location      := ins pos; 

+  file list entry.first cluster := start cluster;

+  file list entry.date and time := akt date + "  " + akt time;

+  file list entry.size          := used storage.

+

+file list entry:

+  dir.filelist.entry [thes link].

+

+END PROC insert dir entry;

+

+PROC delete dir entry (TEXT CONST name):

+  LOCATION VAR del pos;

+  get del pos;

+  erase dir struct entry;

+  erase disk entry;

+  store in free list (del pos).

+

+get del pos:

+  del pos := dir.filelist.entry [link index].location.

+

+link index:

+  link (file thes, name).

+

+erase dir struct entry:

+  INT VAR i;

+  delete (file thes, name, i).

+

+erase disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  dir entry := text 32 (block, del pos.block entry no);

+  replace (dir entry, 1, ""229"");

+  write text 32 (block, dir entry, del pos.block entry no);

+  write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+END PROC delete dir entry;

+ 

+.

+file thes:

+  dir.filelist.thes.

+

+dir thes:

+  dir.dir list.thes.

+

+(*********************** dir information ******************************)

+

+THESAURUS PROC dir all: 

+  file thes.

+ 

+END PROC dir all; 

+ 

+BOOL PROC dir contains (TEXT CONST name): 

+  file thes CONTAINS name

+

+END PROC dir contains;

+ 

+PROC dir list (DATASPACE VAR ds):

+  enable stop;

+  open list file;

+  list files;

+  list dirs;

+  write list head.

+

+open list file:

+  forget (ds);

+  ds := nilspace;

+  FILE VAR list file := sequential file (output, ds);

+  putline (list file, "").

+ 

+list files: 

+  INT VAR number := 0;

+  get (file thes, name, number);

+  WHILE number > 0 REP

+    generate file list line;

+    get (file thes, name, number)

+  PER.

+

+generate file list line:

+  write (list file, centered name);

+  write (list file, "  ");

+  write (list file, text (act file entry.size, 11, 0));

+  write (list file, " Bytes belegt      ");

+  write (list file, act file entry.date and time); 

+(*COND TEST

+  write (list file, "  +++  "); 

+  write (list file, text (act file entry.first cluster)); 

+ENDCOND*)

+  line (list file).

+

+list dirs:

+  number := 0;

+  get (dir thes, name, number);

+  WHILE number > 0 REP

+    generate dir list line;

+    get (dir thes, name, number)

+  PER.

+

+generate dir list line:

+  write (list file, centered name);

+  write (list file, "   <DIR>");

+(*COND TEST

+  write (list file, "  +++  ");                                 

+  write (list file, text (dir.dir list.entry [number]));  

+ENDCOND*)

+  line (list file).

+

+centered name:

+  INT VAR point pos := pos (name, ".");

+  IF point pos > 0

+    THEN name pre + "." + name post

+    ELSE text (name, 12)

+  FI.

+

+name pre:

+  text (subtext (name, 1, point pos - 1), 8).

+

+name post:

+  text (subtext (name, point pos + 1, point pos + 4), 3).

+ 

+act file entry:

+  dir.file list.entry [number].

+

+write list head:

+  head line (list file, head).

+

+head:

+  "DOS" + disk label string + path string.

+

+disk label string:

+  IF dir.disk label <> ""

+    THEN ": " + dir.disk label

+    ELSE ""

+  FI.

+

+path string:

+  IF dir.path <> ""

+    THEN "     PATH: " + dir.path

+    ELSE ""

+  FI.

+

+END PROC dir list;

+ 

+(************ free list handling ******************************************)

+LOCATION PROC loc (INT CONST block, entry):

+  LOCATION : (block, entry) 

+

+END PROC loc;

+

+BOOL OP > (LOCATION CONST l, r):

+  l.msdos block no > r.msdos block no

+  OR ((l.msdos block no = r.msdos block no) AND 

+      (l.block entry no > r.block entry no)     )

+

+END OP >;

+

+OP INCR (LOCATION VAR l):

+  IF l.block entry no = dir entrys per block -1

+    THEN l.block entry no := 0;

+         l.msdos block no INCR 1

+    ELSE l.block entry no INCR 1

+  FI.

+

+END OP INCR;

+

+PROC init free list (INT CONST dir root):

+  dir.freelist.stacktop := 0;

+  dir.freelist.begin of free area.msdos block no := maxint;

+  dir.freelist.end of dir.msdos block no := -1;

+  dir.freelist.dir chain root := dir root.

+

+END PROC init free list;

+ 

+BOOL PROC dir full:

+  stack empty AND free area empty AND NOT expansion alloweded.

+

+stack empty:

+  dir.freelist.stacktop < 1.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC dir full;

+

+PROC store in free list (LOCATION CONST free):

+  dir.freelist.stacktop INCR 1;

+  dir.freelist.stack [top] := free.

+

+top:

+  dir.freelist.stacktop.

+

+END PROC store in free list;

+

+PROC store begin of free area (LOCATION CONST begin):

+  dir.freelist.begin of free area := begin

+

+END PROC store begin of free area;

+

+PROC store end of dir (LOCATION CONST end):

+  dir.freelist.end of dir := end

+

+END PROC store end of dir;

+

+LOCATION PROC free location:

+  LOCATION VAR result;

+  IF dir.freelist.stacktop > 0

+    THEN pop

+    ELIF NOT free area empty

+    THEN first of free area

+    ELIF expansion alloweded

+    THEN allocate new dir space;

+         result := free location

+    ELSE error stop ("Directorytabelle voll")

+  FI;

+  result.

+

+pop:

+  result := dir.freelist.stack [top];

+  top DECR 1.

+

+top:

+  dir.freelist.stack top.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+first of free area:

+  result := dir.freelist.begin of free area;

+  INCR dir.freelist.begin of free area.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC free location; 

+

+PROC allocate new dir space:

+  enable stop;

+  INT VAR new cluster no := available fat entry;

+  IF new cluster no < 0

+    THEN error stop ("MS-DOS Datentraeger voll")

+  FI;

+  INT VAR last entry no;

+  search last entry of fat chain;

+  write fat entry (new cluster no, 4095);

+  write fat entry (last entry no, new cluster no);

+  copy fat to disk;

+  store begin of free area (loc (first new block, 0));

+  store end of dir (loc (last new block, dir entrys per block - 1));

+  init new dir cluster.

+

+search last entry of fat chain:

+  last entry no := dir.freelist.dir chain root;

+  WHILE fat entry (last entry no) < last entry of fat chain REP

+    last entry no := fat entry (last entry no)

+  PER.

+

+init new dir cluster:

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM first new block UPTO last new block REP

+    write disk block (block ds, count);

+  PER.

+

+first new block:

+  firstblock no of cluster (new cluster no).

+

+last new block:

+  first block no of cluster (new cluster no) + sectors per cluster - 1.

+

+END PROC allocate new dir space; 

+

+(*COND TEST

+PROC dump freelist:

+  command dialogue (FALSE);

+  FILE VAR f := sequential file (output, "freelistdump");

+  INT VAR i;

+  putline (f, "STACKTOP: " + text (fl.stacktop));

+  putline (f, "STACK:");

+  FOR i FROM 1 UPTO 16 * number of dir sectors REP

+    putline (f, "   " + text (i, 4) + ":  " +

+                text (fl.stack [i].msdos block no) + ", " +

+                text (fl.stack [i].block entry no))

+  PER; 

+  line (f);

+  putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + 

+            ", "  + text (fl.begin of free area.block entry no));

+  putline (f, "END   OF DIR:  " + text (fl.end of dir.msdos block no) + 

+            ", "  + text (fl.end of dir.block entry no)).

+

+fl:

+  dir.freelist.

+

+END PROC dump free list;

+ENDCOND*)

+

+END PACKET dos fat and dir;

diff --git a/system/dos/1986/src/fetch b/system/dos/1986/src/fetch
new file mode 100644
index 0000000..ad00ab6
--- /dev/null
+++ b/system/dos/1986/src/fetch
@@ -0,0 +1,333 @@
+PACKET fetch DEFINES                   (* Copyright (C) 1985 *)

+                                       (* Frank Klapper      *)

+                                       (* 07.05.86           *) 

+  fetch filemode, 

+  fetch rowtextmode,

+  fetch dsmode, 

+  check file:

+

+LET       ascii        = 1,

+          ascii german = 2,

+          transparent  = 3,

+          ebcdic       = 4,

+          atari st     = 10;

+

+LET row text mode length = 4000,

+    row text type        = 1000,

+

+    ctrl z         = ""26"", 

+    tab            = ""9"",

+    page cmd       = "#page#";

+

+CLUSTER VAR cluster;

+

+DATASPACE VAR cluster space;

+

+BOUND STRUCT (INT size,

+              ROW row text mode length TEXT cluster row) VAR cluster struct;

+

+INT VAR next cluster no;

+REAL VAR file rest;

+

+FILE VAR file;

+

+PROC fetch filemode (DATASPACE VAR file space, 

+                     TEXT CONST name, INT CONST code type):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled fetch filemode (file space, name, code type);

+  forget (cluster space).

+ 

+END PROC fetch filemode; 

+ 

+PROC enabled fetch filemode (DATASPACE VAR file space, 

+                             TEXT CONST name,

+                             INT CONST code type):

+  enable stop;

+  initialize fetch filemode;

+  open fetch (name, file rest, next cluster no);

+  WHILE (next cluster no >= 0) AND (file rest > 0.0) REP

+    get text of act cluster;

+    write lines;

+(***************************************)

+    IF lines (file) > 3950

+      THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES K�NNEN DATEN FEHLEN <<<");

+           LEAVE enabled fetch filemode

+    FI;

+(***************************************)

+  PER;

+  write last line if necessary. 

+ 

+initialize fetch filemode:

+  REAL VAR real cluster size := real (cluster size);

+  TEXT VAR buffer := "";

+  forget (file space);

+  file space := nilspace;

+  file := sequential file (output, file space);

+  init cr lf ff const.

+ 

+init cr lf ff const:

+  TEXT VAR cr, lf, ff;

+  SELECT codetype OF 

+    CASE ascii, ascii german, atari st: cr := ""13""; lf := ""10""; ff := ""12""

+    CASE transparent: cr := ""13""; lf := ""10""; ff := ""12""

+    CASE ebcdic: cr := ""13""; lf := "%"; ff := ""12""

+  END SELECT;

+  TEXT CONST select buffer := cr + lf + ff;

+  TEXT CONST min line end char := code (min (code (cr), min (code (lf), code (ff)))),

+             max line end char := code (max (code (cr), max (code (lf), code (ff)))).

+

+get text of act cluster:

+  fetch next cluster (cluster space, first non dummy ds page);

+  buffer CAT text (cluster, 1, valid buffer length);

+  file rest DECR real cluster size;

+  IF seven bit code

+    THEN cancel bit 8

+  FI;

+  IF ctrl z end

+    THEN test ctrl z

+  FI;

+  INT CONST bufferlength := LENGTH buffer.

+

+ctrl z end:

+  (code type = ascii) OR (code type = ascii german).

+

+seven bit code:

+  code type = ascii OR code type = ascii german.

+

+valid buffer length:

+  int (min (file rest, real cluster size)).

+

+cancel bit 8:

+  INT VAR set pos := pos (buffer, "�", ""255"", 1);

+  WHILE set pos > 0 REP

+    replace (buffer, set pos, seven bit char);

+    set pos := pos (buffer, "�", ""255"", set pos + 1)

+  PER.

+

+seven bit char:

+  code (code (buffer SUB set pos) AND 127).

+

+test ctrl z:

+  IF pos (buffer, ctrl z) > 0

+    THEN file rest := 0.0;

+         buffer := subtext (buffer, 1, pos (buffer, ctrl z) - 1)

+  FI.

+

+write lines:

+  INT VAR begin pos := 1, end pos;

+  next cr lf ff pos;

+  WHILE end pos > 0 REP

+    execute char and get new pos pointer;

+    next cr lf ff pos

+  PER;

+  compress buffer.

+

+next cr lf ff pos:

+  end pos := pos (buffer, min line end char, max line end char, begin pos);

+  WHILE no line end char REP

+    end pos := pos (buffer, min line end char, max line end char, end pos + 1)

+  PER.

+

+no line end char:

+  (end pos > 0) AND (pos (select buffer, buffer SUB end pos) = 0).

+

+compress buffer:

+  buffer := subtext (buffer, begin pos).

+

+execute char and get new pos pointer:

+  SELECT pos (select buffer, buffer SUB end pos) OF

+    CASE 1: execute cr

+    CASE 2: execute lf

+    CASE 3: execute ff

+  END SELECT.

+

+execute cr: 

+  IF (end pos = bufferlength) AND (file rest > 0.0)

+    THEN compress buffer;

+         LEAVE write lines

+  FI;

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  IF (buffer SUB (end pos + 1)) = lf 

+    THEN begin pos := end pos + 2

+    ELSE begin pos := end pos + 1

+  FI.

+ 

+execute ff:

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  putline (file, page cmd);

+  begin pos := end pos + 1.

+

+execute lf: 

+  IF (end pos = bufferlength) AND (file rest > 0.0)

+    THEN compress buffer;

+         LEAVE write lines

+  FI;

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  IF (buffer SUB (end pos + 1)) = cr 

+    THEN begin pos := end pos + 2

+    ELSE begin pos := end pos + 1

+  FI.

+ 

+write last line if necessary:

+  IF buffer <> ""

+    THEN end pos := LENGTH buffer + 1;

+         write line (subtext (buffer, begin pos, end pos - 1), code type)

+  FI.

+

+END PROC enabled fetch filemode;

+

+PROC write line (TEXT CONST line, INT CONST code type):

+  TEXT VAR result;

+  SELECT code type OF

+    CASE ascii: ascii conversion

+    CASE ascii german: ascii german conversion

+    CASE atari st: atari st conversion

+    CASE transparent: putline (file, line)

+    CASE ebcdic: ebcdic conversion

+  END SELECT.

+

+ascii conversion:

+  expand tabs;

+  replace steuerzeichen;

+  putline (file, result).

+

+ascii german conversion:

+  expand tabs;

+  replace steuerzeichen;

+  replace ascii german umlaute;

+  putline (file, result).

+

+atari st conversion:

+  expand tabs;

+  replace steuerzeichen;

+  replace atari st umlaute;

+  putline (file, result).

+

+replace ascii german umlaute:

+  change all (result, "[", "�");

+  change all (result, "\", "�");

+  change all (result, "]", "�");

+  change all (result, "{", "�");

+  change all (result, "|", "�");

+  change all (result, "}", "�");

+  change all (result, "~", "�").

+

+replace atari st umlaute:

+  change all (result, ""142"", "�");

+  change all (result, ""153"", "�");

+  change all (result, ""154"", "�");

+  change all (result, ""132"", "�");

+  change all (result, ""148"", "�");

+  change all (result, ""129"", "�");

+  change all (result, ""158"", "�").

+

+expand tabs:

+  result := line;

+  INT VAR tab pos := pos (result, tab);

+  WHILE tab pos > 0 REP

+    expand tab;

+    tab pos := pos (result, tab)

+  PER.

+

+expand tab:

+  result := subtext (result, 1, tab pos - 1) + (8 - ((tab pos - 1)) MOD 8) * " "

+          + subtext (result, tab pos + 1).

+

+replace steuerzeichen:

+  INT VAR position := pos (result, ""0"", ""31"", 1);

+  WHILE position > 0 REP

+    TEXT VAR char := result SUB position;

+    change all (result, char, "#" + int code + "#");

+    position := pos (result, ""0"", ""31"", position)

+  PER.

+

+ebcdic conversion:

+  result := line;

+  ebcdic to eumel with substitution (result);

+  putline (file, result).

+ 

+int code: 

+  (3 - LENGTH text (code (char))) * "0" + text (code (char)).

+

+END PROC write line;

+

+PROC fetch rowtextmode (DATASPACE VAR file space,

+                        TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled fetch rowtextmode (file space, name);

+  forget (cluster space).

+ 

+END PROC fetch rowtextmode;

+ 

+PROC enabled fetch rowtextmode (DATASPACE VAR file space,

+                               TEXT CONST name):

+  enable stop; 

+  open fetch (name, file rest, next cluster no);

+  initialize fetch rowtext mode;

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (cluster space, first non dummy ds page);

+    cluster struct.size INCR 1;

+    IF file rest < real cluster size

+     THEN cluster struct.cluster row [cluster struct.size]

+                         := text (cluster, 1, int (file rest));

+          file rest := 0.0

+     ELSE cluster struct.cluster row [cluster struct.size] := text (cluster, 1, cluster size); 

+          file rest DECR real cluster size

+     FI

+  PER. 

+ 

+initialize fetch row text mode:

+  forget (file space);

+  file space := nilspace;

+  cluster struct := file space;

+  type (file space, row text type);

+  REAL VAR real cluster size := real (cluster size);

+  cluster struct.size := 0.

+

+END PROC enabled fetch rowtext mode;

+

+PROC fetch ds mode (DATASPACE VAR ds, TEXT CONST name):

+  enable stop;

+  open fetch (name, file rest, next cluster no);

+  init fetch dsmode;

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (ds, ds block no);

+     ds block no INCR sectors per cluster;

+  PER. 

+ 

+init fetch dsmode:

+  forget (ds);

+  ds := nilspace;

+  INT VAR ds block no := 2.

+

+END PROC fetch ds mode;

+

+PROC check file (TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled check file (name);

+  forget (cluster space).

+ 

+END PROC check file;

+ 

+PROC enabled check file (TEXT CONST name):

+  enable stop;

+  open fetch (name, file rest, next cluster no);

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (cluster space, first non dummy ds page)

+  PER. 

+ 

+END PROC enabled check file;

+

+PROC fetch next cluster (DATASPACE VAR fetch space, INT CONST first page):

+  read disk cluster (fetch space, first page, next cluster no);

+  next cluster no := next fetch cluster no.

+

+END PROC fetch next cluster;

+

+END PACKET fetch;

diff --git a/system/dos/1986/src/files.dos b/system/dos/1986/src/files.dos
new file mode 100644
index 0000000..0dd792f
--- /dev/null
+++ b/system/dos/1986/src/files.dos
@@ -0,0 +1,23 @@
+eumel-ebcdic + sub 

+open 

+block i/o 

+cluster 

+name conversion 

+eu disk descriptor.fd 

+disk descriptor.dos.fd 

+fat and dir.dos.fd 

+eu disk descriptor.hd 

+disk descriptor.dos.hd 

+fat and dir.dos.hd 

+fetch 

+save 

+disk manager 

+manager/M.dos.fd 

+manager/M.dos.hd

+table thes.dos 

+252 

+253 

+254 

+255 

+shard interface 

+

diff --git a/system/dos/1986/src/gen.dos b/system/dos/1986/src/gen.dos
new file mode 100644
index 0000000..5493272
--- /dev/null
+++ b/system/dos/1986/src/gen.dos
@@ -0,0 +1,99 @@
+(* 28.02.88, DOS Inserter HD/FD *) 

+TASK VAR fd, hd ; 

+IF NOT exists ("files.dos") THEN fetch ("files.dos", archive) FI ; 

+IF highest entry (ALL "files.dos" - all) > 0 

+   THEN fetch (ALL "files.dos" - all, archive) ; 

+FI ; 

+forget ("files.dos", quiet) ; 

+forget ("gen.dos", quiet) ; 

+release (archive) ; 

+ins ("eumel-ebcdic + sub") ; 

+ins ("open") ; 

+ins ("name conversion") ; 

+begin ("FD", PROC fd start, fd) ; 

+begin ("HD", PROC hd start, hd) ; 

+globalmanager ; 

+ 

+PROC ins (TEXT CONST name) : 

+ insert (name) ; 

+ forget (name, quiet) 

+ENDPROC ins ; 

+ 

+PROC hd start : 

+ command dialogue (FALSE) ; 

+ 

+ fetch ("eu disk descriptor.hd") ; 

+ erase ("eu disk descriptor.hd") ; 

+ fetch ("disk descriptor.dos.hd") ; 

+ erase ("disk descriptor.dos.hd") ; 

+ fetch ("cluster") ; 

+ fetch ("block i/o") ; 

+ fetch ("fat and dir.dos.hd") ; 

+ erase ("fat and dir.dos.hd") ; 

+ fetch ("fetch") ; 

+ fetch ("save") ; 

+ fetch ("disk manager") ; 

+ fetch ("manager/M.dos.hd") ; 

+ erase ("manager/M.dos.hd") ;  (* fetch beendet signalieren *) 

+ 

+ IF NOT exists ("manager/M.dos.fd", father) (* FD auch fertig ? *)

+    THEN erase ("block i/o") ; 

+         erase ("cluster") ; 

+         erase ("fetch") ; 

+         erase ("save") ; 

+         erase ("disk manager")

+ FI ; 

+ 

+ ins ("eu disk descriptor.hd") ; 

+ ins ("disk descriptor.dos.hd") ; 

+ ins ("cluster") ; 

+ ins ("block i/o") ; 

+ ins ("fat and dir.dos.hd") ; 

+ ins ("fetch") ; 

+ ins ("save") ; 

+ ins ("disk manager") ; 

+ ins ("manager/M.dos.hd") ; 

+ do ("dos manager") 

+ENDPROC hd start ; 

+ 

+PROC fd start : 

+ disablestop ;

+ command dialogue (FALSE) ; 

+ fetch ("table thes.dos") ; 

+ erase ("table thes.dos") ; 

+ fetch (ALL "table thes.dos") ; 

+ erase (ALL "table thes.dos") ; 

+ fetch ("eu disk descriptor.fd") ; 

+ erase ("eu disk descriptor.fd") ; 

+ fetch ("disk descriptor.dos.fd") ; 

+ erase ("disk descriptor.dos.fd") ; 

+ fetch ("cluster") ; 

+ fetch ("block i/o") ; 

+ fetch ("fat and dir.dos.fd") ; 

+ erase ("fat and dir.dos.fd") ; 

+ fetch ("fetch") ; 

+ fetch ("save") ; 

+ fetch ("disk manager") ; 

+ fetch ("manager/M.dos.fd") ; 

+ erase ("manager/M.dos.fd") ;  (* fetch beendet signalieren *) 

+ 

+ IF NOT exists ("manager/M.dos.hd", father) (* HD auch fertig ? *)

+    THEN erase ("block i/o") ;

+         erase ("cluster") ; 

+         erase ("fetch") ; 

+         erase ("save") ; 

+         erase ("disk manager")

+ FI ; 

+ 

+ ins ("eu disk descriptor.fd") ; 

+ ins ("disk descriptor.dos.fd") ; 

+ ins ("cluster") ; 

+ ins ("block i/o") ; 

+ ins ("fat and dir.dos.fd") ; 

+ ins ("fetch") ; 

+ ins ("save") ; 

+ ins ("disk manager") ; 

+ ins ("manager/M.dos.fd") ; 

+ do ("dos manager") 

+ENDPROC fd start ; 

+ 

diff --git a/system/dos/1986/src/manager-M.dos.fd b/system/dos/1986/src/manager-M.dos.fd
new file mode 100644
index 0000000..1c59e01
--- /dev/null
+++ b/system/dos/1986/src/manager-M.dos.fd
@@ -0,0 +1,198 @@
+PACKET dos manager multi DEFINES                     (* Copyright (C) 1985 *)

+                                                     (* Frank Klapper      *)

+  provide channel,                                   (* 25.03.86           *)

+  dos manager:

+ 

+LET std archive channel = 31,

+

+    ack              = 0,

+    second phase ack = 5,

+    false code       = 6,

+

+    fetch code       = 11,

+    save code        = 12,

+    exists code      = 13,

+    erase code       = 14,

+    list code        = 15,

+    all code         = 17,

+    clear code       = 18,

+    reserve code     = 19,

+    free code        = 20,

+    check read code  = 22,

+

+    quote            = """";

+

+BOUND STRUCT (TEXT name, pass) VAR msg;

+

+TASK VAR order task;

+

+INT VAR dos channel;

+

+REAL VAR last access time := 0.0;

+

+TASK VAR disk owner := niltask; 

+

+PROC provide channel (INT CONST channel):

+  dos channel := channel

+

+END PROC provide channel;

+

+(*COND FLOPPY*)

+provide channel (std archive channel);

+(*ENDCOND*)

+

+(*COND HDU

+provide channel (29) 

+ENDCOND*)

+

+PROC dos manager:

+  dos manager (dos channel)

+

+END PROC dos manager;

+

+PROC dos manager (INT CONST channel):

+(*COND FLOPPY*)

+  load shard interface table;

+(*ENDCOND*)

+  dos channel := channel;

+  task password ("-");

+  global manager

+        (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) 

+

+END PROC dos manager;

+

+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,

+                  TASK CONST from task):

+  enable stop;

+  order task := from task;

+  msg := ds;

+  IF NOT (order task = disk owner) AND 

+     order code <> free code AND order code <> reserve code

+    THEN errorstop ("DOS nicht angemeldet")

+  FI;

+  SELECT order code OF 

+    CASE fetch code     : fetch file 

+    CASE save code      : save file

+    CASE erase code     : erase file

+    CASE clear code     : clear disk

+    CASE exists code    : exists file

+    CASE list code      : list disk

+    CASE all code       : deliver directory

+    CASE reserve code   : reserve

+    CASE free code      : free

+    CASE check read code: check

+    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))

+  END SELECT.

+

+fetch file:

+  disk fetch (msg.name, ds);

+  manager ok (ds).

+

+check:

+  disk check (msg.name);

+  manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). 

+

+save file:

+  IF phase = 1

+    THEN save first phase

+    ELSE save second phase

+  FI.

+

+save first phase:

+  BOOL VAR overwrite question;

+  disk save first phase (msg.name, overwrite question);

+  IF overwrite question

+    THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")

+    ELSE send (order task, second phase ack, ds)

+  FI.

+

+save second phase:

+  disable stop;

+  disk save second phase (ds);

+  forget (ds) ;

+  ds := nilspace ;

+  enable stop;

+  manager ok (ds).

+

+clear disk: 

+  IF NOT (from task = disk owner)

+    THEN error stop ("DOS nicht angemeldet")

+  FI;

+  IF phase = 1

+    THEN manager question ("Diskette loeschen")

+    ELSE disk clear;

+         manager ok (ds)

+  FI.

+

+erase file:

+  IF disk exists (msg.name)

+    THEN IF phase = 1

+           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")

+           ELSE disk erase (msg.name);

+                manager ok (ds)

+         FI

+    ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")

+  FI.

+ 

+exists file:

+  IF disk exists (msg.name)

+    THEN manager ok (ds)

+    ELSE send (order task, false code, ds)

+  FI.

+

+list disk:

+  disk list (ds);

+  manager ok (ds).

+

+deliver directory:

+  forget (ds);

+  ds := nilspace;

+  BOUND THESAURUS VAR all names := ds;

+  all names := disk all;

+  manager ok (ds).

+

+reserve:

+  IF reserve or free permitted

+    THEN do continue channel;

+         disk owner := from task;

+         disk reserve (msg.name);

+         manager ok (ds)

+    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")

+  FI.

+

+do continue channel:

+  IF channel <> dos channel

+    THEN continue channel (dos channel)

+  FI.

+

+reserve or free permitted :

+  from task = disk owner OR last access more than five minutes ago

+  OR disk owner = niltask OR NOT

+  (exists (disk owner) OR station(disk owner) <> station (myself)).

+

+last access more than five minutes ago :

+  abs (last access time - clock (1)) > 300.0.

+

+free: 

+  IF reserve or free permitted

+    THEN disk free;

+         disk owner := niltask;

+         break (quiet);

+         manager ok (ds)

+    ELSE manager message ("DOS nicht angemeldet")

+  FI.

+

+END PROC dos manager;

+

+PROC manager ok (DATASPACE VAR ds):

+  send (order task, ack, ds);

+  last access time := clock (1).

+

+END PROC manager ok;

+

+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):

+  text (quote + adapted name (name, status) + quote, 14)

+

+END PROC expanded name;

+

+END PACKET dos manager multi;

diff --git a/system/dos/1986/src/manager-M.dos.hd b/system/dos/1986/src/manager-M.dos.hd
new file mode 100644
index 0000000..70d9d9a
--- /dev/null
+++ b/system/dos/1986/src/manager-M.dos.hd
@@ -0,0 +1,198 @@
+PACKET dos manager multi DEFINES                     (* Copyright (C) 1985 *)

+                                                     (* Frank Klapper      *)

+  provide channel,                                   (* 25.03.86           *)

+  dos manager:

+ 

+LET std archive channel = 31,

+

+    ack              = 0,

+    second phase ack = 5,

+    false code       = 6,

+

+    fetch code       = 11,

+    save code        = 12,

+    exists code      = 13,

+    erase code       = 14,

+    list code        = 15,

+    all code         = 17,

+    clear code       = 18,

+    reserve code     = 19,

+    free code        = 20,

+    check read code  = 22,

+

+    quote            = """";

+

+BOUND STRUCT (TEXT name, pass) VAR msg;

+

+TASK VAR order task;

+

+INT VAR dos channel;

+

+REAL VAR last access time := 0.0;

+

+TASK VAR disk owner := niltask; 

+

+PROC provide channel (INT CONST channel):

+  dos channel := channel

+

+END PROC provide channel;

+

+(*COND FLOPPY

+provide channel (std archive channel);

+ENDCOND*)

+

+(*COND HDU*)

+provide channel (29) 

+(*ENDCOND*)

+

+PROC dos manager:

+  dos manager (dos channel)

+

+END PROC dos manager;

+

+PROC dos manager (INT CONST channel):

+(*COND FLOPPY

+  load shard interface table;

+ENDCOND*)

+  dos channel := channel;

+  task password ("-");

+  global manager

+        (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) 

+

+END PROC dos manager;

+

+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,

+                  TASK CONST from task):

+  enable stop;

+  order task := from task;

+  msg := ds;

+  IF NOT (order task = disk owner) AND 

+     order code <> free code AND order code <> reserve code

+    THEN errorstop ("DOS nicht angemeldet")

+  FI;

+  SELECT order code OF 

+    CASE fetch code     : fetch file 

+    CASE save code      : save file

+    CASE erase code     : erase file

+    CASE clear code     : clear disk

+    CASE exists code    : exists file

+    CASE list code      : list disk

+    CASE all code       : deliver directory

+    CASE reserve code   : reserve

+    CASE free code      : free

+    CASE check read code: check

+    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))

+  END SELECT.

+

+fetch file:

+  disk fetch (msg.name, ds);

+  manager ok (ds).

+

+check:

+  disk check (msg.name);

+  manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). 

+

+save file:

+  IF phase = 1

+    THEN save first phase

+    ELSE save second phase

+  FI.

+

+save first phase:

+  BOOL VAR overwrite question;

+  disk save first phase (msg.name, overwrite question);

+  IF overwrite question

+    THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")

+    ELSE send (order task, second phase ack, ds)

+  FI.

+

+save second phase:

+  disable stop;

+  disk save second phase (ds);

+  forget (ds) ;

+  ds := nilspace ;

+  enable stop;

+  manager ok (ds).

+

+clear disk: 

+  IF NOT (from task = disk owner)

+    THEN error stop ("DOS nicht angemeldet")

+  FI;

+  IF phase = 1

+    THEN manager question ("Diskette loeschen")

+    ELSE disk clear;

+         manager ok (ds)

+  FI.

+

+erase file:

+  IF disk exists (msg.name)

+    THEN IF phase = 1

+           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")

+           ELSE disk erase (msg.name);

+                manager ok (ds)

+         FI

+    ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")

+  FI.

+ 

+exists file:

+  IF disk exists (msg.name)

+    THEN manager ok (ds)

+    ELSE send (order task, false code, ds)

+  FI.

+

+list disk:

+  disk list (ds);

+  manager ok (ds).

+

+deliver directory:

+  forget (ds);

+  ds := nilspace;

+  BOUND THESAURUS VAR all names := ds;

+  all names := disk all;

+  manager ok (ds).

+

+reserve:

+  IF reserve or free permitted

+    THEN do continue channel;

+         disk owner := from task;

+         disk reserve (msg.name);

+         manager ok (ds)

+    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")

+  FI.

+

+do continue channel:

+  IF channel <> dos channel

+    THEN continue channel (dos channel)

+  FI.

+

+reserve or free permitted :

+  from task = disk owner OR last access more than five minutes ago

+  OR disk owner = niltask OR NOT

+  (exists (disk owner) OR station(disk owner) <> station (myself)).

+

+last access more than five minutes ago :

+  abs (last access time - clock (1)) > 300.0.

+

+free: 

+  IF reserve or free permitted

+    THEN disk free;

+         disk owner := niltask;

+         break (quiet);

+         manager ok (ds)

+    ELSE manager message ("DOS nicht angemeldet")

+  FI.

+

+END PROC dos manager;

+

+PROC manager ok (DATASPACE VAR ds):

+  send (order task, ack, ds);

+  last access time := clock (1).

+

+END PROC manager ok;

+

+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):

+  text (quote + adapted name (name, status) + quote, 14)

+

+END PROC expanded name;

+

+END PACKET dos manager multi;

diff --git a/system/dos/1986/src/name conversion b/system/dos/1986/src/name conversion
new file mode 100644
index 0000000..3cdc202
--- /dev/null
+++ b/system/dos/1986/src/name conversion
@@ -0,0 +1,77 @@
+PACKET name conversion DEFINES                  (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+  adapted name:                                 (* 20.02.86           *)

+

+LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&@!(){}",

+    lower case chars = "abcdefghijklmnopqrstuvwxyz";

+

+TEXT VAR name pre,

+         name post,

+         new, 

+         char;

+

+INT VAR point pos,

+        count;

+

+TEXT PROC adapted name (TEXT CONST eu name, BOOL CONST read modus):

+  enable stop;

+  point pos := pos (eu name, ".");

+  IF name extension exists

+    THEN changed name with extension

+    ELSE changed name without extension

+  FI.

+

+name extension exists:

+  point pos > 0.

+

+changed name with extension:

+  name pre  := compress (subtext (eu name, 1, point pos - 1));

+  name post := compress (subtext (eu name, point pos + 1));

+  IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3

+    THEN error

+  FI;

+  IF LENGTH name post = 0

+    THEN new name (name pre, read modus)

+    ELSE new name (name pre, read modus) + "."

+       + new name (name post, read modus)

+  FI.

+

+changed name without extension:

+  IF LENGTH eu name > 8 OR LENGTH euname < 1

+    THEN error

+  FI;

+  new name (eu name, read modus).

+

+error:

+  errorstop ("Unzulässiger Name").

+

+END PROC adapted name;

+

+TEXT PROC new name (TEXT CONST old name, BOOL CONST read modus):

+  new := "";

+  FOR count FROM 1 UPTO LENGTH old name REP

+    convert char

+  PER;

+  new.

+

+convert char:

+  char := old name SUB count;

+  IF is lower case char

+    THEN new CAT (upper case chars SUB string pos)

+  ELIF is upper case char OR read modus

+    THEN new CAT char

+  ELSE error stop ("Unzulässiger Name")

+  FI.

+

+is lower case char:

+  pos (lower case chars, char) > 0.

+

+is upper case char:

+  pos (upper case chars, char) > 0. 

+

+string pos:

+  pos (lower case chars, char).

+

+END PROC new name; 

+ 

+END PACKET name conversion;

diff --git a/system/dos/1986/src/open b/system/dos/1986/src/open
new file mode 100644
index 0000000..92e81e9
--- /dev/null
+++ b/system/dos/1986/src/open
@@ -0,0 +1,51 @@
+PACKET open DEFINES                             (* Copyright (C) 1986 *)

+                                                (* Frank Klapper      *)

+  open  action,                                 (* 20.03.86           *)

+  close action,

+  action opened,

+  action closed,

+  init check rerun,

+  check rerun:

+

+BOOL VAR open;

+INT VAR old session;

+

+INITFLAG VAR packet := FALSE;

+

+PROC open action:

+  open := TRUE

+

+END PROC open action;

+

+PROC close action:

+  open := FALSE

+

+END PROC close action;

+

+BOOL PROC action opened:

+  IF NOT initialized (packet)

+    THEN close action

+  FI;

+  open

+

+END PROC action opened;

+

+BOOL PROC action closed:

+  NOT action opened

+

+END PROC action closed;

+

+PROC init check rerun:

+  old session := session

+

+END PROC init check rerun;

+

+PROC check rerun:

+  IF session <> old session

+    THEN close action;

+         error stop ("Diskettenzugriff im RERUN")

+  FI.

+

+END PROC check rerun;

+

+END PACKET open;

diff --git a/system/dos/1986/src/save b/system/dos/1986/src/save
new file mode 100644
index 0000000..903cfaa
--- /dev/null
+++ b/system/dos/1986/src/save
@@ -0,0 +1,273 @@
+PACKET save DEFINES                   (* Copyright (C) 1985 *)

+                                      (* Frank Klapper      *)

+                                      (* 07.05.86           *)

+  save filemode, 

+  save rowtextmode,

+  save dsmode: 

+

+LET       ascii        = 1,

+          ascii german = 2,

+          transparent  = 3,

+          ebcdic       = 4,

+          atari st     = 10;

+

+LET ascii ctrl z = ""26"";

+

+LET row text mode length = 4000;

+

+CLUSTER VAR cluster;

+

+DATASPACE VAR cluster space;

+

+BOUND STRUCT (INT size,

+              ROW row text mode length TEXT cluster row) VAR cluster struct;

+

+REAL VAR storage;

+TEXT VAR cr lf, ff;

+TEXT VAR buffer;

+

+PROC save filemode (DATASPACE CONST file space, 

+                    TEXT CONST name,

+                    INT CONST code type):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enable save filemode (file space, name, code type);

+  buffer := "";

+  forget (cluster space).

+

+END PROC save filemode;

+ 

+PROC enable save filemode (DATASPACE CONST file space, 

+                           TEXT CONST name,

+                           INT CONST code type):

+  enable stop;

+  open save (name);

+  init save filemode;

+  INT VAR line no;

+  FOR line no FROM 1 UPTO lines (file) REP

+    to line (file, line no);

+    buffer cat file line;

+    WHILE LENGTH buffer >= cluster size REP

+      copy buffer to cluster;

+      write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+      remember rest

+    PER

+  PER;

+  cat ctrl z if necessary;

+  write rest;

+  close save (storage).

+

+init save filemode:

+  storage := 0.0;

+  FILE VAR file := sequential file (modify, file space);

+  SELECT code type OF

+    CASE ascii, ascii german, atari st, transparent: cr lf := ""13""10""; ff := ""12""

+    CASE ebcdic: cr lf := ""13"%"; ff := ""12""

+  END SELECT;

+  buffer := "".

+

+buffer cat file line:

+  exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type).

+ 

+copy buffer to cluster:

+  write text (cluster, buffer);

+  storage INCR real (min (cluster size, LENGTH buffer)).

+

+remember rest:

+  buffer := subtext (buffer, cluster size + 1).

+

+write rest:

+  WHILE buffer <> ""

+    REP copy buffer to cluster; 

+        write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+        remember rest

+  PER.

+ 

+cat ctrl z if necessary:

+  IF code type <> ebcdic

+    THEN buffer CAT ascii ctrl z

+  FI.

+

+END PROC enable save filemode; 

+ 

+PROC cat adapted line (TEXT VAR line, INT CONST code type):

+  IF subtext (line, 1, 6) = "#page#" 

+      THEN buffer CAT ff;

+           LEAVE cat adapted line

+  FI;

+  SELECT code type OF

+    CASE transparent: (* no operation *)

+    CASE ascii:        change eumel print chars; ascii change

+    CASE ascii german: change eumel print chars; ascii german change

+    CASE atari st:     change eumel print chars; atari st change

+    CASE ebcdic:       change eumel print chars; eumel to ebcdic with substitution (line)

+  END SELECT;

+  buffer CAT line;

+  buffer CAT cr lf.

+

+change eumel print chars:

+  INT VAR char pos := pos (line, ""220"", ""223"", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, std char);

+    char pos := pos (line, ""220"", ""223"", char pos + 1)

+  PER.

+

+std char:

+  SELECT code (line SUB char pos) OF

+    CASE 220: "k"

+    CASE 221: "-"

+    CASE 222: "#"

+    CASE 223: " "

+    OTHERWISE ""

+  END SELECT.

+

+ascii change: 

+  change all (line, ""251"", "#251#");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+ascii german change: 

+  char pos := pos (line, "[", "]", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "[", "]", char pos + 1)

+  PER;

+  char pos := pos (line, "{", "}", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "{", "}", char pos + 1)

+  PER;

+  change all (line, ""251"", "~");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, umlaut in ascii german);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+atari st change: 

+  change all (line, "ß", ""158"");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, umlaut in atari st);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+ersatzdarstellung:

+  TEXT VAR char code := text (code  (line SUB char pos));

+  "#" + (3 - LENGTH char code) * "0" + char code + "#".

+

+umlaut in ascii german:

+  SELECT code (line SUB char pos) OF 

+    CASE 214: "["

+    CASE 215: "\"

+    CASE 216: "]"

+    CASE 217: "{"

+    CASE 218: "|"

+    CASE 219: "}"

+    OTHERWISE ""

+  END SELECT.

+

+umlaut in atari st:

+  SELECT code (line SUB char pos) OF 

+    CASE 214: ""142""

+    CASE 215: ""153""

+    CASE 216: ""154""

+    CASE 217: ""132""

+    CASE 218: ""148""

+    CASE 219: ""129""

+    OTHERWISE ""

+  END SELECT.

+

+END PROC cat adapted line;

+

+PROC save rowtextmode (DATASPACE CONST space,

+                       TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enable save rowtext mode (space, name);

+  forget (cluster space).

+

+END PROC save rowtextmode;

+

+PROC enable save rowtextmode (DATASPACE CONST space,

+                              TEXT CONST name):

+  enable stop;

+  open save (name);

+  init save row textmode;

+  WHILE line no < cluster struct.size REP

+    fill buffer;

+    copy buffer to cluster;

+    write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+    remember rest

+  PER;

+  write rest;

+  close save (storage).

+

+init save rowtextmode:

+  storage := 0.0;

+  cluster struct  := space;

+  INT VAR line no := 0;

+  TEXT VAR buffer := "".

+

+fill buffer:

+  WHILE line no < cluster struct.size AND NOT buffer full REP

+    line no INCR 1;

+    buffer CAT cluster struct.cluster row [line no]

+  PER.

+

+buffer full:

+  LENGTH buffer >= cluster size.

+

+copy buffer to cluster:

+  write text (cluster, buffer);

+  storage INCR real (min (cluster size, LENGTH buffer)).

+

+remember rest:

+  buffer := subtext (buffer, cluster size + 1).

+

+write rest:

+  WHILE buffer <> ""

+    REP copy buffer to cluster; 

+        write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+        remember rest

+  PER.

+

+END PROC enable save rowtextmode;

+ 

+PROC save ds mode (DATASPACE CONST ds,

+                   TEXT CONST name):

+  disable stop;

+  enable save ds mode (ds, name).

+

+END PROC save ds mode;

+

+PROC enable save ds mode (DATASPACE CONST ds,

+                          TEXT CONST name):

+  enable stop;

+  open save (name);

+  INT VAR page no := first non dummy ds page;

+  get last allocated ds page; 

+  WHILE page no <= last allocated ds page REP

+    write disk cluster (ds, page no, next save cluster no);

+    page no INCR sectors per cluster

+  PER;

+  close save (size).

+

+get last allocated ds page:

+  INT VAR last allocated ds page := -1, 

+          i;

+  FOR i FROM 1 UPTO ds pages (ds) REP

+    last allocated ds page := next ds page (ds, last allocated ds page) 

+  PER.

+

+size:

+  real (last allocated ds page - first non dummy ds page + 1) * 512.0.

+

+END PROC enable save ds mode;

+

+END PACKET save;

diff --git a/system/dos/1986/src/shard interface b/system/dos/1986/src/shard interface
new file mode 100644
index 0000000..c7fdac5
--- /dev/null
+++ b/system/dos/1986/src/shard interface
@@ -0,0 +1,19 @@
+; ';' in Spalte 1 kennzeichnet eine Kommentarzeile

+; alle Werte müssen durch Blanks getrennt werden

+;

+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen

+;                         negativ für seitenorientiertes Lesen

+;

+;size     heads   tracks    first sectors  last sector

+;=====================================================

+320        1       40         1              8

+360        1       40         1              9

+640       -2       40         1              8

+720       -2       40         1              9

+800        2       40         1             10

+1440      -2       80         1              9

+1600       2       80         1             10

+2400      -2       80         1             15

+1232       1       77         0             15

+2464      -2       77         0             15

+; END OF FILE

diff --git a/system/dos/1986/src/table thes.dos b/system/dos/1986/src/table thes.dos
new file mode 100644
index 0000000..8b254cf
--- /dev/null
+++ b/system/dos/1986/src/table thes.dos
@@ -0,0 +1,5 @@
+shard interface

+252

+253

+254

+255

diff --git a/system/eumel-coder/1.8.0/src/eumel coder 1.8.0 b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0
new file mode 100644
index 0000000..d9f489f
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0
@@ -0,0 +1,2594 @@
+PACKET eumel coder                                 (* Autor: U. Bartling *) 

+       DEFINES coder on, coder off,

+               declare, define, apply, identify,

+               :=, =,

+               dump,

+ 

+               LABEL,

+               gosub, goret,

+               complement condition code,

+

+               ADDRESS ,

+               GLOB, LOC, REF, DEREF,

+               ref length,

+               +, 

+               adjust,

+               is global, is local, is ref,

+ 

+               DTYPE, 

+               type class, type name,

+               void type, int type, real type, text type, bool type, 

+               dataspace type, undefined type, 

+               row type, struct type, proc type, end type,

+ 

+               OPN, 

+               set length of local storage, 

+               begin module, end module, 

+               is proc, is eumel 0 instruction,

+               address, operation,

+               nop, 

+               init op codes,

+               mnemonic, 

+

+               parameter,

+               next param,

+               NEXTPARAM, 

+               access , 

+               dtype , 

+               param address,

+               same type ,

+ 

+               reserve storage, 

+               allocate denoter , 

+               allocate variable, 

+               data allocation by coder ,

+               data allocation by user,

+ 

+               run, run again, 

+               insert,

+               prot, prot off,

+               check, check on, check off,

+

+               help, bulletin, packets :

+

+(**************************************************************************)

+(*                                                                        *) 

+(*                         E U M E L  -  C O D E R                        *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(*   Zur Beschreibung des Coders siehe                                    *) 

+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 

+(*                                                                        *) 

+(*   Stand der Dokumentation  : 13.02.1986                                *) 

+(*   Stand der Implementation : 21.03.1986                                *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+                   (***** Globale Variable *****) 

+

+TEXT VAR object name;

+ 

+FILE VAR bulletin file; 

+ 

+INT VAR memory management mode, global address offset, hash table pointer,

+        nt link, permanent pointer, param link, index, mode, field pointer,

+        word, number of errors := 0 ;

+ 

+BOOL VAR found, end of params;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  1. Interface zum ELAN-Compiler            12.03.1986  *) 

+(*                              1.7.5.4                                   *)

+(*                                                                        *) 

+(*   Beschreibung der      Tabellen (-groessen),                          *) 

+(*                         internen Vercodung von Typen                   *) 

+(*                    und  Kennungen .                                    *) 

+(*   Initialisieren und Beenden des Compilers,                            *) 

+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+LET  begin of hash table         =     0 ,

+     end of hash table           =  1023 ,

+ 

+     begin of permanent table    = 22784 ,

+       before first pt entry     = 22784 ,

+       first permanent entry     = 22785 ,

+     end of permanent table      = 32767 , 

+

+     wordlength                  =     1 ,  (* compile  u n d  run time *)

+     two word length             =     2 ,

+     three word length           =     3 ,

+     four word length            =     4 ,

+ 

+     permanent param const             = 10000 ,

+     permanent param var               = 20000 ,

+     permanent proc op                 = 30000 ,

+     permanent type                    = 30000 ,

+     permanent row                     =    10 ,

+     permanent struct                  =    11 ,

+     permanent param proc              =    12 ,

+(*   permanent param proc end marker   =     0 , *)

+     permanent type field              =     0 ,

+

+     ptt limit                         = 10000 ,

+     begin of pt minus ptt limit       = 12784 ,

+     offset to row size                = 12785 ,

+ 

+     void                              =     0 ,

+     int                               =     1 ,

+     real                              =     2 ,

+     string                            =     3 ,

+     bool                              =     5 ,

+     bool result                       =     6 ,

+     dataspace                         =     7 ,

+     undefined                         =     9 ,

+     row                               =    10 ,

+     struct                            =    11 ,

+     end                               =     0 ,

+

+     const                             =     1 , 

+     var                               =     2 ,

+(*   proc                              =     3 , *)

+(*   denoter                           =     5 , *)

+     bold                              =     2 ,

+ 

+     ins                               = TRUE ,

+     no ins                            = FALSE ,

+     no lst                            = FALSE ,

+     sermon                            = TRUE  ,

+     no sermon                         = FALSE ,

+ 

+     run again mode                    =     0 ,

+     compile file mode                 =     1 ,

+     prep coder mode                   =     5 , 

+

+     warning message                   =     2 , 

+     error message                     =     4 ,

+ 

+     point line                        = "..............." ;

+ 

+INT CONST permanent packet            :=     -2 ,

+          permanent end               :=     -3 ;

+

+BOOL VAR coder active                 := FALSE ; 

+

+INT  VAR run again mod nr             :=     0 ;

+ 

+ 

+                     (***** Start/Ende *****)

+ 

+LET invalid coder off = "CODER not active" ;

+

+PROC coder on (INT CONST data allocation mode) : 

+    mark coder on ; 

+    init memory management ; 

+    init opn section ; 

+    init compiler .

+ 

+mark coder on :

+    coder active := TRUE .

+

+init memory management :

+    memory management mode := data allocation mode ;

+    prep pbase (global address offset) .

+ 

+init compiler :

+    no do again ;

+    elan (prep coder mode, bulletin file, "", run again mod nr,

+          no ins, no lst, check option, no sermon)

+

+ENDPROC coder on;

+ 

+PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) :

+    IF coder active 

+       THEN mark coder off ; 

+            end coder (insert, sermon, start mod nr if no insert)

+       ELSE errorstop (invalid coder off)

+    FI .

+ 

+start mod nr if no insert :

+    IF insert THEN run again mod nr := 0

+              ELSE run again mod nr := start proc.mod nr

+    FI ;

+    run again mod nr .

+

+mark coder off :

+    reset memory management mode ;

+    init opn section ;

+    coder active := FALSE

+ENDPROC coder off ; 

+ 

+PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) :

+    EXTERNAL 10021

+ENDPROC end coder ; 

+

+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 

+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+ 

+                   (***** Hash/Namenstabelle *****) 

+.

+next hash entry :

+     hash table pointer INCR wordlength .

+

+end of hash table reached :

+     hash table pointer > end of hash table .

+

+yet another nt entry :

+     nt link := cdb int (nt link) ;

+     nt link <> 0 . ;

+ 

+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 

+    EXTERNAL 10031

+ENDPROC declare object ; 

+ 

+PROC to object (TEXT CONST searched object) : 

+     hash ;

+     search nt entry .

+

+hash :

+     hash code := 0 ;

+     FOR index FROM 1 UPTO LENGTH searched object REP

+         addmult cyclic

+     ENDREP .

+

+addmult cyclic :

+     hash code INCR hash code ;

+     IF hash code > end of hash table THEN wrap around FI ;

+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .

+

+wrap around :

+     hash code DECR end of hash table .

+

+hash code : nt link .

+

+search nt entry :

+     found := FALSE ;

+     WHILE yet another nt entry REP

+          read current entry ;

+          IF object name = searched object 

+             THEN found := TRUE ;

+                  LEAVE to object

+          FI

+     PER .

+

+read current entry :

+     permanent pointer := cdb int (nt link + wordlength) ;

+     object name := cdb text (nt link + two word length)

+ENDPROC to object ;

+

+

+                 (***** Permanent Tabelle *****) 

+.

+next procedure :

+     permanent pointer := cdb int (permanent pointer) . ;

+

+PROC next pt param :

+     mode := cdb int (param link) MOD ptt limit ;

+     param link INCR wordlength ;

+     IF   mode = permanent row    THEN skip over permanent row 

+     ELIF mode = permanent struct THEN skip over permanent struct

+     FI ;

+     set end marker if end of list .

+

+skip over permanent row :

+     param link INCR wordlength ;

+     next pt param .

+

+skip over permanent struct :

+     REP

+         next pt param ;

+         mode := cdb int (param link)

+     UNTIL mode = permanent type field PER ;

+     param link INCR wordlength

+ENDPROC next pt param ;

+

+PROC set end marker if end of list :

+     mode := cdb int (param link) ;

+     end of params := mode >= permanent proc op OR mode <= 0 

+ENDPROC set end marker if end of list ;

+

+PROC get type and mode (INT VAR type) : 

+     mode := cdb int (param link) ;

+     IF mode = permanent param proc THEN type of param proc

+                                    ELSE type of object

+     FI .

+

+type of param proc : 

+     param link INCR wordlength ;

+     get type and mode (type) ;

+     mode := permanent param proc .

+

+type of object :

+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;

+                      mode := 0

+                 ELSE type := mode MOD ptt limit ;

+                      mode DECR type ;

+                      translate type if necessary ;

+                      translate mode if necessary 

+     FI .

+

+translate type if necessary :

+     IF permanent row or struct THEN translate type FI .

+

+translate type :

+     type := param link - begin of pt minus ptt limit .

+

+translate mode if necessary : 

+    IF   mode = permanent param const THEN mode := const

+    ELIF mode = permanent param var   THEN mode := var

+    FI .

+

+permanent row or struct :

+     type = permanent row OR type = permanent struct

+ENDPROC get type and mode ;

+ 

+

+                 (***** Allgemeine Zugriffsprozeduren *****) 

+

+INT PROC cdb int (INT CONST index) :

+   EXTERNAL 116

+ENDPROC cdb int ;

+

+TEXT PROC cdb text (INT CONST index) :

+   EXTERNAL 117

+ENDPROC cdb text ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  2. Spruenge und Marken                    07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps LABEL                                       *) 

+(*                                                                        *) 

+(*   Deklaration, Definition und Applikation von Marken                   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE LABEL = INT ; 

+

+BOOL VAR invers :: FALSE ; 

+ 

+PROC declare (LABEL VAR label) : 

+    CONCR (label) := 0

+ENDPROC declare ; 

+ 

+PROC define (LABEL VAR label) : 

+    EXTERNAL 10084

+ENDPROC define ; 

+ 

+PROC complement condition code : 

+    invers := TRUE

+ENDPROC complement condition code ; 

+ 

+PROC apply (LABEL VAR label) : 

+    EXTERNAL 10149 

+ENDPROC apply ; 

+ 

+PROC apply (LABEL VAR label, BOOL CONST condition) : 

+    IF condition xor invers THEN branch true (label) 

+                            ELSE branch false (label)

+    FI ;

+    invers := FALSE .

+

+condition xor invers : 

+    IF condition THEN NOT invers

+                 ELSE invers

+    FI

+ENDPROC apply ; 

+ 

+OP := (LABEL VAR global label, local label) : (* EQUATE ! *)

+    EXTERNAL 10014 

+ENDOP := ; 

+ 

+TEXT PROC dump (LABEL CONST label) : 

+    "LAB " + text (CONCR (label)) 

+ENDPROC dump ; 

+ 

+PROC gosub (LABEL VAR label) : 

+    EXTERNAL 10015 

+ENDPROC gosub ; 

+ 

+PROC goret : 

+    s0 (q goret code) 

+ENDPROC goret ; 

+ 

+PROC branch true (LABEL VAR label) : 

+    EXTERNAL 10028

+ENDPROC branch true ; 

+ 

+PROC branch false (LABEL VAR label) : 

+    EXTERNAL 10029

+ENDPROC branch false ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  3. Datenaddressen                         21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps ADDRESS                                     *) 

+(*                                                                        *) 

+(*   Aufbau von Datenaddressen (Vercodung)                                *) 

+(*   Fortschalten und Ausrichten von Adressen                             *) 

+(*   Bereitstellen der Fehlermeldung "address overflow" (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+TYPE ADDRESS = STRUCT (INT kind, value) ; 

+ 

+LET global                 = 0 , 

+    local                  = 1 , 

+    ref mask               = 2 , 

+    global ref             = 2 , 

+    local ref              = 3 , 

+    module nr              = 4 ,

+    immediate value        = 5 ,

+ 

+    eumel0 stack offset    = 4 ,

+    local address limit    = 16 384 ,

+ 

+    illegal ref operation  = "REF not allowed" , 

+    deref on non ref       = "DEREF on non-ref address" ,

+    global ref not allowed = "GLOBAL REF not allowed" , 

+    unknown kind           = "Unknown address kind" , 

+    address overflow       = "Address Overflow" , 

+    illegal plus operation = "+ not allowed" ;

+ 

+ADDRESS VAR result addr;

+ 

+INT CONST ref length :: 2 ;

+

+OP := (ADDRESS VAR l, ADDRESS CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+ADDRESS OP GLOB (INT CONST address level) : 

+    result addr.kind  := global ; 

+    result addr.value := address level ; 

+    IF memory management mode = data allocation by user

+       THEN result addr.value INCR global address offset

+    FI ;

+    result addr

+ENDOP GLOB ;

+

+ADDRESS OP LOC (INT CONST address level) : 

+    result addr.kind  := local ;

+    result addr.value := address level + eumel0 stack offset ; 

+    result addr

+ENDOP LOC ; 

+ 

+ADDRESS OP REF (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    IF   result addr.kind = local  THEN result addr.kind INCR ref mask

+    ELIF result addr.kind = global THEN errorstop (global ref not allowed)

+                                   ELSE errorstop (illegal ref operation)

+    FI ;

+    result addr 

+ENDOP REF ; 

+ 

+ADDRESS OP DEREF (ADDRESS CONST ref address) : 

+    CONCR (result addr) := CONCR (ref address) ;

+    IF is not local ref THEN errorstop (deref on non ref) FI ; 

+    result addr.kind DECR ref mask ; 

+    result addr .

+ 

+is not local ref :

+    result addr.kind <> local ref

+ENDOP DEREF ;

+ 

+INT OP REPR (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    SELECT result addr.kind OF 

+        CASE global     :

+        CASE local      : set bit (result addr.value, 15) 

+        CASE global ref : errorstop (global ref not allowed)

+        CASE local ref  : prep local ref 

+        OTHERWISE errorstop (unknown kind)

+    ENDSELECT ; 

+    result addr.value .

+ 

+prep local ref : 

+    IF address limit exceeded THEN errorstop (address overflow) FI ;

+    set bit (result addr.value, 14) ; 

+    set bit (result addr.value, 15) .

+

+address limit exceeded :

+    result addr.value < eumel0 stack offset OR

+    result addr.value > local address limit

+ENDOP REPR ; 

+ 

+BOOL PROC is ref (ADDRESS CONST addr) : 

+    addr.kind = local ref

+ENDPROC is ref ; 

+ 

+BOOL PROC is global (ADDRESS CONST addr) : 

+    addr.kind = global 

+ENDPROC is global ; 

+ 

+BOOL PROC is local (ADDRESS CONST addr) : 

+    addr.kind = local 

+ENDPROC is local ; 

+ 

+ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : 

+    CONCR (result addr) := CONCR (addr) ; 

+    SELECT result addr.kind OF 

+        CASE global : inc global

+        CASE local  : inc local

+        OTHERWISE     errorstop (illegal plus operation) 

+    ENDSELECT ; 

+    result addr .

+ 

+inc global : 

+    result addr.value INCR offset ; 

+    IF result addr.value < 0 THEN errorstop (address overflow) FI .

+ 

+inc local : 

+    result addr.value INCR offset ; 

+    IF result addr.value < eumel 0 stack offset OR

+       result addr.value > local address limit

+       THEN errorstop (address overflow)

+    FI

+ENDOP + ; 

+ 

+PROC adjust (ADDRESS VAR addr, INT CONST adjust length) :

+    IF is local or global THEN adjust to length FI . 

+ 

+is local or global :

+    addr.kind <= local .

+

+adjust to length :

+    mode := addr.value MOD adjust length ;

+    IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI

+ENDPROC adjust ;

+

+TEXT PROC dump (ADDRESS CONST addr) : 

+    kind + text (addr.value) . 

+ 

+kind : 

+    SELECT addr.kind OF 

+        CASE global          : "GLOBAL " 

+        CASE local           : "LOCAL " 

+        CASE immediate value : "IMMEDIATE "

+        CASE module nr       : "PARAM PROC "

+        CASE global ref      : "GLOBAL REF " 

+        CASE local ref       : "LOCAL REF " 

+        OTHERWISE "undef. Addr:" 

+    ENDSELECT 

+ENDPROC dump; 

+

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  4. Datentypen   Teil I                    03.12.1985  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps DTYPE                                       *) 

+(*                                                                        *) 

+(*   Interne Repraesentation der primitiven Datentypen                    *) 

+(*   Identifikation von DTYPEs                                            *)

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+TYPE DTYPE = INT ; 

+ 

+OP := (DTYPE VAR l, DTYPE CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+BOOL OP = (DTYPE CONST l, r) : 

+    CONCR (l) = CONCR (r)

+ENDOP = ; 

+ 

+DTYPE PROC void type :      DTYPE :(void)      ENDPROC  void type ; 

+ 

+DTYPE PROC int  type :      DTYPE :(int )      ENDPROC  int type ; 

+ 

+DTYPE PROC real type :      DTYPE :(real)      ENDPROC  real type ; 

+ 

+DTYPE PROC text type :      DTYPE :(string)    ENDPROC  text type ; 

+ 

+DTYPE PROC bool type :      DTYPE :(bool)      ENDPROC  bool type ; 

+ 

+DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; 

+ 

+DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; 

+ 

+DTYPE PROC row type  :      DTYPE :(row)       ENDPROC row type ; 

+ 

+DTYPE PROC struct type :    DTYPE :(struct)    ENDPROC struct type ; 

+ 

+DTYPE PROC proc type :   DTYPE :(permanent param proc) ENDPROC proc type ; 

+ 

+DTYPE PROC end type  :      DTYPE :(end)       ENDPROC end type ; 

+ 

+INT PROC type class (DTYPE CONST type) : 

+    SELECT type id OF 

+        CASE int, real, bool, string, dataspace, undefined : 1 

+        CASE void   : 0 

+        CASE row    : 3 

+        CASE struct : 4 

+        CASE permanent param  proc : 5 

+        OTHERWISE     pt type 

+    ENDSELECT . 

+

+pt type :

+    IF type id > ptt limit THEN permanent row or struct

+                           ELSE abstract type

+    FI .

+

+abstract type : 2 .

+

+permanent row or struct :

+    mode := cdbint (type link into pt) MOD ptt limit ; 

+    IF   mode = struct THEN 4

+    ELIF mode = row    THEN 3

+                       ELSE 2

+    FI .

+ 

+type link into pt :

+    type id + begin of pt minus ptt limit .

+

+type id : CONCR (type)

+ENDPROC type class ; 

+ 

+PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : 

+    SELECT type pos OF 

+          CASE 1   : size := 0; align := 0; type id := void 

+          CASE 6   : size := 1; align := 1; type id := int 

+          CASE 10  : size := 4; align := 4; type id := real 

+          CASE 15  : size := 8; align := 4; type id := string

+          CASE 20  : size := 1; align := 1; type id := bool 

+          CASE 25  : size := 1; align := 1; type id := dataspace

+          OTHERWISE  search for type in permanent table 

+    ENDSELECT . 

+ 

+type pos : 

+    enclose in delimiters ;

+    pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . 

+ 

+enclose in delimiters :

+    object name := "." ;

+    object name CAT name ;

+    object name CAT "." .

+

+search for type in permanent table : 

+    to object (name) ;

+    IF NOT found THEN size := 0; align := 0; type id := undefined 

+                 ELSE size := cdbint (permanent pointer + two wordlength) ;

+                      type id := permanent pointer - begin of permanent table ;

+                      IF   size < two wordlength  THEN align := 1

+                      ELIF size < four wordlength THEN align := 2

+                                                  ELSE align := 4

+                      FI

+    FI . 

+ 

+type id : CONCR (type)

+ENDPROC identify ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  5. Operationen  Teil I                    21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps OPN                                         *) 

+(*   Primitive Operationen (:=  etc.)                                     *) 

+(*   Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ;

+ 

+LET proc op    = 0 ,

+    param proc = 1 ,

+    eumel 0    = 2 , 

+    nil        = 3 , 

+ 

+    param proc at non ref = "PARAM PROC at non-ref address" ,

+    proc op expected      = "PROC expected" ;

+ 

+OPN VAR eumel0 opn;

+eumel0 opn.kind := eumel0 ;

+eumel0 opn.top of stack := 0 ;

+

+eumel0 opn.mod nr := q pp ;

+OPN CONST pp       :: eumel0 opn ,

+          nop code :: OPN :(nil, 0, 0) ;

+

+THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; 

+ 

+PROC init op codes (FILE VAR eumelcodes) : 

+    eumel 0 opcodes := empty thesaurus ;

+    WHILE NOT eof (eumelcodes) REP

+       getline (eumelcodes, object name) ;

+       delete trailing blanks ;

+       IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name)

+          THEN insert (eumel 0 opcodes, object name)

+       FI

+    PER .

+

+delete trailing blanks :

+    WHILE (object name SUB LENGTH object name) = " " REP

+       object name := subtext (object name, 1, LENGTH object name - 1)

+    PER

+ENDPROC init op codes ; 

+

+ADDRESS PROC address (OPN CONST opn) :

+    IF opn.kind <> proc op THEN errorstop (proc op expected) FI ;

+    result addr.kind  := module nr ; 

+    result addr.value := opn.mod nr ;

+    result addr

+ENDPROC address ;

+ 

+OPN PROC operation (ADDRESS CONST addr) : 

+    IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; 

+    OPN VAR opn ;

+    opn.kind := param proc ; 

+    opn.mod nr :=addr.value ; 

+    opn.top of stack := 0 ; 

+    opn 

+ENDPROC operation ; 

+ 

+TEXT PROC mnemonic (OPN CONST op code) : 

+    name (eumel 0 opcodes, op code.mod nr)

+ENDPROC mnemonic ;

+ 

+OPN PROC nop : 

+    nop code

+ENDPROC nop ; 

+ 

+OP := (OPN VAR r, OPN CONST l) : 

+    CONCR (r) := CONCR (l) 

+ENDOP := ; 

+ 

+BOOL PROC is proc (OPN CONST operation) : 

+    operation.kind = proc op

+ENDPROC is proc ; 

+ 

+BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : 

+    link (eumel 0 opcodes, op code name) <> 0

+ENDPROC is eumel 0 instruction ; 

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  6. Parameterfeld                          10.01.1986  *) 

+(*                                                                        *) 

+(*   Bereitstellen des Parameterfeldes                                    *) 

+(*   Schreiben und Lesen von Eintraegen im Parameterfeld                  *) 

+(*   Fortschalten von Zeigern in das Parameterfeld                        *) 

+(*   Bereitstellen der Konstanten 'size of param field' (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+LET PARAMDESCRIPTOR = STRUCT (DTYPE type,   INT access, 

+                              ADDRESS addr, OPN push opn) , 

+ 

+    size of param field   = 100 ,

+    param field exceeded  = "Param Field Overflow",

+    param nr out of range = "Illegal Param Number" ;

+ 

+ROW size of param field PARAMDESCRIPTOR VAR param field ;

+ 

+ 

+                      (***** Schreiben *****) 

+ 

+PROC test param pos (INT CONST param nr) : 

+    IF param nr < 1 OR param nr > size of param field

+       THEN errorstop (param nr out of range)

+    FI 

+ENDPROC test param pos ; 

+ 

+PROC declare (INT CONST param nr, DTYPE CONST type) : 

+    test param pos (param nr) ; 

+    enter type . 

+ 

+enter type :

+    CONCR (param field [param nr].type) := CONCR (type) 

+ENDPROC declare ; 

+ 

+PROC declare (INT CONST param nr, access) : 

+    test param pos (param nr) ; 

+    enter access . 

+

+enter access :

+    param field [param nr].access := access 

+ENDPROC declare ; 

+ 

+PROC define (INT CONST param nr, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter address . 

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) 

+ENDPROC define ; 

+ 

+PROC define (INT CONST param nr, value) : 

+    result addr.kind  := immediate value ;

+    result addr.value := value ;

+    define (param nr, result addr) 

+ENDPROC define ; 

+ 

+PROC apply (INT CONST param nr, OPN CONST opn) : 

+    test param pos (param nr) ; 

+    enter push opn . 

+ 

+enter push opn : 

+    CONCR (param field [param nr].push opn) := CONCR (opn) 

+ENDPROC apply ; 

+ 

+PROC parameter (INT CONST param nr, DTYPE CONST type, 

+                INT CONST access, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter type ; 

+    enter access ; 

+    enter address ; 

+    enter pp as default . 

+ 

+enter type : 

+    CONCR (param field [param nr].type) := CONCR (type) .

+

+enter access :

+    param field [param nr].access := access .

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) .

+

+enter pp as default :

+    CONCR (param field [param nr].push opn) := CONCR (pp) 

+ENDPROC parameter ; 

+ 

+ 

+                       (***** Lesen *****) 

+ 

+ADDRESS PROC param address (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].addr 

+ENDPROC param address ; 

+ 

+DTYPE PROC dtype (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].type 

+ENDPROC dtype ; 

+ 

+INT PROC access (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].access 

+ENDPROC access ; 

+ 

+ 

+                      (***** Fortschalten *****) 

+ 

+OP NEXTPARAM (INT VAR param nr) : 

+   test param pos (param nr) ; 

+   IF long entry THEN read until end FI ; 

+   param nr INCR 1 .

+ 

+long entry : 

+    type class (param field [param nr].type) > 2 . 

+ 

+read until end : 

+    REP 

+        param nr INCR 1 ; 

+        NEXTPARAM param nr 

+    UNTIL end marker read or end of field PER . 

+ 

+end marker read or end of field :

+    param nr > size of param field OR

+    CONCR (param field [param nr].type) = end 

+ENDOP NEXTPARAM ; 

+ 

+INT PROC next param (INT CONST p) : 

+    index := p ; 

+    NEXTPARAM index ; 

+    index

+ENDPROC next param ; 

+ 

+TEXT PROC dump (INT CONST p) : 

+   IF p > 0 AND p <= 100 THEN dump entry (param field (p)) 

+                         ELSE param nr out of range 

+    FI 

+ENDPROC dump ; 

+ 

+TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : 

+    object name := dump (id.type) ; 

+    object name CAT text (id.access) ; 

+    object name CAT dump (id.addr) ; 

+    object name CAT dump (id.push opn) ;

+    object name

+ENDPROC dump entry ; 

+

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  7. Datentypen   Teil II                   20.01.1986  *) 

+(*                                                                        *) 

+(*   Deklaration neuer Datentypen                                         *) 

+(*   Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+DTYPE VAR pt type ;

+

+PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : 

+    entry into name table ; 

+    put next permanent (permanent type) ; 

+    put next permanent (size) ; 

+    put next permanent (nt link) ;

+    mark no offsets of text elements . 

+ 

+entry into name table : 

+    declare object (name, nt link, CONCR (type)) . 

+ 

+mark no offsets of text elements : 

+    put next permanent (0) 

+ENDPROC declare ; 

+ 

+BOOL PROC same type (INT CONST param 1, param 2) : 

+    INT CONST left type :: CONCR (param field [param 1].type) ;

+    IF left type = right type

+       THEN same fine structure if there is one

+       ELSE left type = undefined OR right type = undefined

+    FI .

+ 

+right type : CONCR (param field [param 2].type) . 

+ 

+same fine structure if there is one : 

+    IF   left type = row    THEN compare row 

+    ELIF left type = struct THEN compare struct 

+                            ELSE TRUE 

+    FI . 

+ 

+compare row : 

+    equal sizes AND same type (param1 + 1, param2 + 1) . 

+ 

+equal sizes : 

+    param field [param1+1].access = param field [param2+1].access .

+ 

+compare struct : 

+    INT VAR p1 :: param1+1, p2 :: param2+1 ; 

+    REP 

+       IF   NOT same type (p1, p2) THEN LEAVE same type WITH FALSE 

+       ELIF end type found         THEN LEAVE same type WITH TRUE

+       FI ;

+       NEXTPARAM p1 ;

+       NEXTPARAM p2

+    UNTIL end of field PER ;

+    FALSE .

+

+end type found :

+    CONCR (param field [p1].type) = end .

+

+end of field : 

+    p1 > size of param field OR p2 > size of param field 

+ENDPROC same type ;

+ 

+BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : 

+    field pointer := param nr ;

+    CONCR (pt type) := CONCR (type) ;

+    equal types 

+ENDPROC same type ;

+

+BOOL PROC equal types : 

+    identical types OR one type is undefined .

+

+one type is undefined :

+    type of actual field = undefined OR CONCR(pt type) = undefined .

+

+identical types :

+    SELECT type class (pt type) OF 

+        CASE 0, 1, 2 : type of actual field = CONCR (pt type)

+        CASE 3       : perhaps equal rows

+        CASE 4       : perhaps equal structs

+        OTHERWISE      FALSE

+    ENDSELECT .

+

+perhaps equal rows :

+    is row AND equal row sizes AND equal row types . 

+ 

+is row :

+    type of actual field = row .

+

+perhaps equal structs : 

+    is struct AND same type fields . 

+ 

+is struct :

+    type of actual field = struct .

+

+equal row sizes :

+    pt row size = row size within param field . 

+

+equal row types :

+    same type (field pointer + 1, pt row type) .

+

+pt row size :

+    cdb int (CONCR(pt type) + offset to row size) .

+

+pt row type :

+    CONCR (pt type) INCR 2 ;

+    pt type .

+

+row size within param field :

+    param field [field pointer].access .

+ 

+same type fields :

+    field pointer INCR 1 ;

+    CONCR (pt type) INCR 1 ;

+    REP

+        IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ;

+        IF type of actual field = end 

+             THEN LEAVE same type fields WITH TRUE 

+        FI ; 

+        NEXTPARAM field pointer

+    UNTIL end of field PER ;

+    FALSE .

+

+end of field :

+    field pointer > size of param field .

+

+type of actual field :

+    CONCR (param field [field pointer].type) .

+ENDPROC equal types ;

+

+BOOL PROC is not void bool or undefined (DTYPE CONST dtype) :

+    type <> void AND type <> bool AND type <> undefined .

+

+type : CONCR (dtype)

+ENDPROC is not void bool or undefined ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  8. Operationen  Teil II                   07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition der Opcodes                                               *) 

+(*   Deklaration, Definition, Identifikation und Applikation              *) 

+(*   Eroeffnen und Schliessen eines Moduls                                *)

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+LET module not opened  = "Module not opened" , 

+    define missing     = "DEFINE missing" ,

+    wrong nr of params = "Wrong Nr. of Params:" , 

+    illegal kind       = "Opcode expected" ,

+    nested module      = "Nested Modules" ,

+    no mod nr          = "Param Proc expected" ,

+    no immediate value = "Value expected" ,

+    type error         = "Type Error" ,

+ 

+    q ln              =  1 ,

+    q move            =  2 ,    q move code             =  2 048 ,

+    q inc1            =  3 ,    q inc1 code             =  3 072 ,

+    q dec1            =  4 ,    q dec1 code             =  4 096 ,

+    q inc             =  5 ,    q inc code              =  5 120 ,

+    q dec             =  6 ,    q dec code              =  6 144 ,

+    q add             =  7 ,    q add code              =  7 168 ,

+    q sub             =  8 ,    q sub code              =  8 192 ,

+    q clear           =  9 ,    q clear code            =  9 216 ,

+    q test            = 10 , 

+    q equ             = 11 ,    q equ code              = 11 264 , 

+    q lsequ           = 12 ,    q lsequ code            = 12 288 , 

+    q fmove           = 13 ,    q fmove code            = 13 312 , 

+    q fadd            = 14 ,    q fadd code             = 14 336 , 

+    q fsub            = 15 ,    q fsub code             = 15 360 , 

+    q fmult           = 16 ,    q fmult code            = 16 384 , 

+    q fdiv            = 17 ,    q fdiv code             = 17 408 ,

+    q flsequ          = 18 ,    q flsequ code           = 18 432 ,

+    q tmove           = 19 ,    q tmove code            = 19 456 ,

+    q tequ            = 20 ,    q tequ code             = 20 480 , 

+    q accds           = 21 ,    q access ds code        = 22 528 , 

+    q ref             = 22 ,    q ref code              = 23 552 ,

+    q subscript       = 23 ,    q subscript code        = 24 576 , 

+    q select          = 24 ,    q select code           = 25 600 ,

+    q ppv             = 25 , 

+    q pp              = 26 , 

+    q make false      = 27 , (* q make false code       = 65 513 *)

+    q movex           = 28 ,

+(*  q longa subs                q longa subs code       = 65 376 *) 

+    q return          = 29 ,    q return code           = 32 512 ,

+    q true return     = 30 ,    q true return code      = 32 513 ,

+    q false return    = 31 ,    q false return code     = 32 514 ,

+                                q goret code            = 32 519 ,

+    q esc mult        = 32 ,    q esc mult code         = 32 553 ,

+    q esc div         = 33 ,    q esc div code          = 32 554 , 

+    q esc mod         = 34 ,    q esc mod code          = 32 555 , 

+    q pproc           = 35 , 

+    q compl int       = 36 ,    q compl int code        = 32 551 ,

+    q compl real      = 37 ,    q compl real code       = 32 550 ,

+(*  q alias ds        = 38 , *) 

+    q movim           = 39 ,    q esc movim code        = 32 547 ,

+    q fequ            = 40 ,    q fequ code             = 32 548 ,

+    q tlsequ          = 41 ,    q tlsequ code           = 32 549 ,

+(*  q case            = 42 , *)

+    q plus            = 43 ,

+    q minus           = 44 ,

+    q mult            = 45 ,

+    q int div         = 46 ,

+    q real div        = 47 ,

+    q equal           = 48 ,

+    q lessequal       = 49 ;

+ 

+INT CONST q make false code :: - 1 022 , 

+          q longa subs code :: -   159 ;

+ 

+

+                   (***** Deklaration *****) 

+ 

+PROC declare (OPN VAR operation) : 

+    operation.kind := proc op ;

+    get module nr (operation.mod nr) ; 

+    operation.top of stack := 0 

+ENDPROC declare ; 

+ 

+PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : 

+    declare (operation) ;

+    entry into name and pt table if necessary ; 

+    enter params ; 

+    enter result ; 

+    enter module number . 

+ 

+entry into name and pt table if necessary : 

+    declare object (name, nt link, permanent pointer) . 

+ 

+enter params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO params REP

+       enter param (param field [field pointer]) ;

+       NEXTPARAM field pointer 

+    PER .

+ 

+enter result : 

+    enter param (param field[field pointer].type, permanent proc op) .

+ 

+enter module number : 

+    put next permanent (operation.mod nr)

+ENDPROC declare ; 

+ 

+PROC enter param (PARAMDESCRIPTOR CONST param) :

+    IF   param.access = const 

+         THEN enter param (param.type, permanent param const)

+    ELIF param.access = var 

+         THEN enter param (param.type, permanent param var)

+    ELSE errorstop ("Unknown Access")

+    FI

+ENDPROC enter param ;

+

+PROC enter param (DTYPE CONST type, INT CONST permanent mode) :

+    SELECT type class (type) OF

+        CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode)

+        OTHERWISE      errorstop ("Illegal Type")

+    ENDSELECT

+ENDPROC enter param ;

+

+

+                    (***** Definition *****) 

+ 

+PROC define (OPN VAR opn) : 

+    IF NOT module open THEN errorstop (module not opened)

+                       ELSE proc head (opn.mod nr, opn.top of stack)

+    FI 

+ENDPROC define ; 

+ 

+PROC set length of local storage (OPN VAR opn, INT CONST size) :

+    IF   size < 0 OR size > local address limit

+         THEN errorstop (address overflow)

+    ELIF opn.top of stack = 0

+         THEN errorstop (define missing)

+    ELIF opn.kind <> proc op

+         THEN errorstop (proc op expected)

+    FI ;

+    set length (opn.top of stack, size + eumel0 stack offset)

+ENDPROC set length of local storage ; 

+ 

+PROC define (OPN VAR operation, INT CONST size) : 

+    define (operation) ; 

+    set length of local storage (operation, size)

+ENDPROC define ; 

+ 

+ 

+                 (***** Identifikation *****) 

+ 

+INT VAR counter, result index, result type repr;

+ 

+PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation,

+               BOOL VAR object exists) :

+    find result entry ; 

+    to object (name) ;

+    IF found  THEN first fit and leave if found FI ; 

+    IF eumel0 THEN identify eumel0 instruction 

+              ELSE yield undefined operation 

+    FI .

+ 

+find result entry : 

+    result index := first; 

+    counter := 0 ;

+    WHILE counter < params REP 

+        NEXTPARAM result index ; 

+        counter INCR 1

+    PER ;

+    check on param field exceeded .

+

+check on param field exceeded :

+    IF result index > size of param field

+       THEN errorstop (param field exceeded) 

+    FI .

+ 

+yield undefined operation :

+    declare (result index, undefined type) ;

+    apply (result index, nop) ;

+    object exists := FALSE .

+ 

+first fit and leave if found :

+    WHILE yet another procedure exists REP 

+        check one procedure and leave if match ; 

+        next procedure 

+    PER . 

+ 

+yet another procedure exists : 

+    permanent pointer <> 0 . 

+ 

+check one procedure and leave if match: 

+    param link := permanent pointer + wordlength ; 

+    set end marker if end of list ;

+    counter := params ; 

+    field pointer := 1 ;

+    REP

+       IF   end of params AND counter = 0 

+            THEN procedure found

+       ELIF end of params OR  counter = 0 

+            THEN LEAVE check one procedure and leave if match 

+            ELSE check next param 

+       FI 

+   PER . 

+ 

+check next param : 

+    get type and mode (CONCR(pt type)) ;

+    IF same types THEN set param mode ; 

+                       counter DECR 1 ; 

+                       field pointer INCR 1 ;

+                       next pt param

+                  ELSE LEAVE check one procedure and leave if match 

+    FI . 

+ 

+same types : (* inline version ! *)

+    equal types .

+ 

+set param mode : 

+    param field [field pointer].access := mode . 

+ 

+procedure found : 

+    get result ; 

+    operation.kind   := proc op ; 

+    operation.mod nr := module number ; 

+    operation.top of stack := 0 ;

+    object exists := TRUE ;

+    LEAVE identify . 

+ 

+get result : 

+    get type and mode (result type) ; 

+    declare (result index, mode) .

+ 

+module number :

+    cdbint (param link + 1) . 

+

+result type :

+    CONCR (param field [result index].type) .

+ 

+eumel0 : 

+    eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; 

+    eumel0 opn.mod nr <> 0 .

+ 

+identify eumel 0 instruction : 

+    init result type with void ; 

+    CONCR (operation) := CONCR (eumel0 opn) ;

+    object exists := check params and set result ;

+    declare (result index, DTYPE:(result type repr)) ;

+    declare (result index, const) .

+

+init result type with void :

+    result type repr := void . 

+ 

+check params and set result :

+    SELECT operation.mod nr OF

+       CASE q return, q false return, q true return : no params 

+       CASE q inc1, q dec1          : one int param yielding void 

+       CASE q pproc, q pp, q ln     : one param yielding void

+       CASE q test                  : one param yielding bool

+       CASE q clear, q ppv          : one int or bool param yielding void 

+       CASE q make false            : one bool param yielding void 

+       CASE q move                  : two int or bool params yielding void 

+       CASE q compl int, q inc, q dec : two int params yielding void

+       CASE q compl real, q fmove   : two real params yielding void 

+       CASE q equ, q lsequ          : two int params yielding bool 

+       CASE q fequ, q flsequ        : two real params yielding bool 

+       CASE q tequ, q tlsequ        : two text params yielding bool

+       CASE q tmove                 : two text params yielding void

+       CASE q accds, q ref          : two params yielding void

+       CASE q add, q sub, q esc mult,

+            q esc div, q esc mod    : three int params yielding void

+       CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void

+       CASE q select, q movex       : three params 

+       CASE q subscript             : five params 

+       CASE q plus, q minus, q mult : two intreals yielding intreal

+       CASE q int div               : two int params yielding int 

+       CASE q real div              : two real params yielding real

+       CASE q equal, q lessequal    : two intrealtexts yielding bool

+       OTHERWISE                      FALSE

+    ENDSELECT .

+ 

+no params : 

+    params = 0 . 

+

+one int param yielding void : 

+    p1 void (int type, first, params) .

+

+one param yielding void :

+    params = 1 . 

+

+one param yielding bool :

+    IF params = 1 THEN result type repr := bool ; 

+                       TRUE 

+                  ELSE FALSE

+    FI .

+ 

+one int or bool param yielding void :

+    p1 void (int type, first, params) OR p1 void (bool type, first, params) . 

+

+one bool param yielding void :

+    p1 void (bool type, first, params) . 

+ 

+two int or bool params yielding void : 

+    p2 (int  type, first, params, void) OR

+    p2 (bool type, first, params, void) .

+

+two int params yielding void :

+    p2 (int type, first, params, void) .

+

+two real params yielding void :

+    p2 (real type, first, params, void) .

+

+two text params yielding void :

+    p2 (text type, first, params, void) .

+

+two int params yielding bool :

+    p2 (int type, first, params, bool) .

+

+two real params yielding bool :

+    p2 (real type, first, params, bool) .

+

+two text params yielding bool :

+    p2 (text type, first, params, bool) .

+

+two params yielding void :

+    params = 2 . 

+

+three int params yielding void :

+    p3 void (int type, first, params) .

+

+three real params yielding void :

+    p3 void (real type, first, params) .

+

+three params :

+    params = 3 .

+

+five params : 

+    params = 5 . 

+

+two intreals yielding intreal :

+    two int params yielding int OR two real params yielding real .

+

+two intrealtexts yielding bool :

+    two int params yielding bool OR two real params yielding bool OR

+    two text params yielding bool .

+

+two int params yielding int :

+    p2 (int type, first, params, int) .

+

+two real params yielding real :

+    p2 (real type, first, params, real)

+ENDPROC identify ; 

+ 

+BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 1 AND param type is requested plain type . 

+ 

+param type is requested plain type :

+    CONCR (param field [first].type) = CONCR (requested type) 

+ 

+ENDPROC p1 void ;

+ 

+BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr,

+              INT CONST result type) :

+    IF param nr = 2 AND param types equal requested plain type

+       THEN result type repr := result type ;

+            TRUE

+       ELSE FALSE

+    FI .

+ 

+param types equal requested plain type :

+    CONCR (param field [first]  .type) = CONCR (requested type) AND 

+    CONCR (param field [first+1].type) = CONCR (requested type)

+

+ENDPROC p2 ;

+ 

+BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 3 AND param types ok .

+ 

+param types ok :

+    FOR index FROM first UPTO first+2 REP

+       IF different param types THEN LEAVE p3 void WITH FALSE FI 

+    PER ;

+    TRUE .

+ 

+different param types :

+    CONCR (param field [index].type) <> CONCR (requested type)

+ENDPROC p3 void; 

+

+

+                   (***** Applikation *****) 

+ 

+INT VAR address representation, left repr, right repr, result repr;

+

+PROC apply (INT CONST first, nr of params, OPN CONST opn) : 

+    IF NOT module open THEN errorstop (module not opened) FI ;

+    SELECT opn.kind OF 

+        CASE eumel 0    : generate eumel0 instruction 

+        CASE proc op    : call operation 

+        CASE param proc : call param proc

+        CASE nil        :

+        OTHERWISE         errorstop (illegal kind) 

+    ENDSELECT .

+ 

+call operation :

+    push params if necessary (first, nr of params, opn.mod nr) ; 

+    call (opn.mod nr) .

+ 

+call param proc : 

+    result addr.kind := local ref ;

+    result addr.value := opn.mod nr ;

+    address representation := REPR result addr ;

+    push params if necessary (first, nr of params, address representation) ;

+    call param (address representation) .

+

+generate eumel0 instruction : 

+    SELECT real nr of params OF 

+        CASE 0 : p0 instruction 

+        CASE 1 : apply p1 (opn, first addr) 

+        CASE 2 : apply p2 (opn, first addr, second addr)

+        CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) 

+        CASE 5 : subscript operation

+        OTHERWISE errorstop (wrong nr of params + text (nr of params)) 

+    ENDSELECT . 

+ 

+real nr of params :

+    IF operator denotation THEN nr of params + 1

+                           ELSE nr of params

+    FI .

+

+operator denotation :

+    opn.mod nr >= q plus .

+

+p0 instruction :

+    IF   opn.mod nr = q return       THEN s0 (q return code) 

+    ELIF opn.mod nr = q true return  THEN s0 (q true return code)

+    ELIF opn.mod nr = q false return THEN s0 (q false return code)

+                                     ELSE errorstop (wrong nr of params +

+                                                     mnemonic (opn)) 

+    FI .

+ 

+subscript operation :

+    IF opn.mod nr = q subscript 

+       THEN subscription

+       ELSE errorstop (wrong nr of params + text (nr of params))

+    FI .

+

+subscription :

+    ADDRESS CONST element length :: param field [first+2].addr ,

+                  limit          :: param field [first+3].addr ;

+    check on immediates ;

+    IF element length.value < 1024

+       THEN s0 (q subscript code + element length.value)

+       ELSE s0 (q longa subs code) ;

+            s0 (element length.value)

+    FI ;

+    s3 (limit.value - 1, subs index, base addr, subs result) .

+

+check on immediates :

+    IF element length.kind <> immediate value OR

+       limit.kind <> immediate value

+       THEN errorstop (no immediate value)

+    FI .

+

+subs index  : REPR param field [first+1].addr .

+

+base addr   : REPR param field [first].addr .

+

+subs result : REPR param field [first+4].addr .

+

+first addr : 

+    param field [first].addr .

+ 

+left type :

+    param field [first].type .

+

+second addr : 

+    param field [nextparam (first)].addr .

+ 

+third addr : 

+    param field [nextparam(nextparam(first))].addr

+ENDPROC apply ;

+ 

+PROC push params if necessary (INT CONST first, nr of params, mod nr) : 

+    init param push (mod nr) ;

+    IF nr of params > 0 THEN push params ;

+                             push result if there is one 

+    FI . 

+ 

+push params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO nr of params REP 

+        apply p1 (push code, param addr) ; 

+        NEXTPARAM field pointer

+    PER . 

+ 

+push code : 

+    param field [field pointer].push opn . 

+ 

+param addr :

+    param field [field pointer].addr . 

+ 

+push result if there is one : 

+    IF push result necessary 

+       THEN push result address (REPR param field [field pointer].addr)

+    FI . 

+

+push result necessary :

+    param field [field pointer].push opn.kind <> nil AND 

+    is not void bool or undefined (param field [field pointer].type) 

+ENDPROC push params if necessary ;

+

+PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : 

+    IF   opn.mod nr = q ln    THEN generate line number 

+    ELIF opn.mod nr = q pproc THEN push module nr

+                              ELSE gen p1 instruction

+    FI .

+

+gen p1 instruction : 

+    address representation := REPR addr ;

+    SELECT opn.mod nr OF 

+        CASE q inc1  : t1 (q inc1 code, address representation)

+        CASE q dec1  : t1 (q dec1 code, address representation)

+        CASE q clear : t1 (q clear code,address representation)

+        CASE q test  : test bool object (address representation)

+        CASE q pp    : push param (address representation)

+        CASE q make false : s1 (q make false code, address representation)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+

+generate line number :

+    IF addr.kind = immediate value THEN mark line (addr.value)

+                                   ELSE errorstop (no immediate value)

+    FI .

+

+push module nr : 

+    IF addr.kind = module nr THEN push param proc (addr.value)

+                             ELSE errorstop (no mod nr)

+    FI

+ENDPROC apply p1; 

+ 

+PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): 

+    left repr := REPR left addr ;

+    IF opn.mod nr = q movim THEN move immediate

+                            ELSE gen p2 instruction 

+    FI . 

+ 

+gen p2 instruction : 

+    right repr := REPR right addr ;

+    SELECT opn.mod nr OF 

+        CASE q move       : t2 (q move code, right repr, left repr)

+        CASE q inc        : t2 (q inc code, right repr, left repr) 

+        CASE q dec        : t2 (q dec code, right repr, left repr) 

+        CASE q equ        : compare (q equ code, left repr, right repr) 

+        CASE q lsequ      : compare (q lsequ code, left repr, right repr) 

+        CASE q fmove      : t2 (q fmove code, right repr, left repr)

+        CASE q flsequ     : compare (q flsequ code, left repr, right repr) 

+        CASE q tmove      : t2 (q tmove code, right repr, left repr)

+        CASE q tequ       : compare (q tequ code, left repr, right repr) 

+        CASE q compl int  : s2 (q compl int code, left repr, right repr)

+        CASE q compl real : s2 (q compl real code, left repr, right repr)

+        CASE q fequ       : compare (q fequ code, left repr, right repr) 

+        CASE q tlsequ     : compare (q tlsequ code, left repr, right repr) 

+        CASE q accds      : t2 (q access ds code, left repr, right repr)

+        CASE q ref        : t2 (q ref code, left repr, right repr) 

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+ 

+move immediate :

+    IF right addr.kind = immediate value 

+       THEN s0 (q esc movim code) ;

+            s1 (left repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI

+ENDPROC apply p2; 

+ 

+PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, 

+               ADDRESS CONST left addr, right addr, result addr ):

+    left repr   := REPR left addr ; 

+    result repr := REPR result addr ;

+    IF   opn.mod nr = q select THEN gen select instruction

+    ELIF opn.mod nr = q movex  THEN gen long move

+                               ELSE gen p3 instruction

+    FI .

+

+gen p3 instruction :

+    right repr  := REPR right addr ; 

+    SELECT opn.mod nr OF 

+        CASE q add                : int add

+        CASE q sub                : int sub

+        CASE q fadd               : real add 

+        CASE q fsub               : real sub 

+        CASE q fmult              : real mult 

+        CASE q fdiv, q real div   : real div 

+        CASE q esc mult           : int mult 

+        CASE q esc div, q int div : int div 

+        CASE q esc mod            : int mod 

+        CASE q plus               : int real add

+        CASE q minus              : int real sub

+        CASE q mult               : int real mult

+        CASE q equal, q lessequal : compare (comp code, left repr, right repr)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT . 

+ 

+gen select instruction :

+    IF right addr.kind = immediate value 

+       THEN t1 (q select code, left repr) ;

+            s1 (right addr.value, result repr)

+       ELSE errorstop (no immediate value)

+    FI .

+

+gen long move :

+    IF right addr.kind = immediate value

+       THEN long move (left repr, result repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI .

+

+int add   : compute (q add code, left repr, right repr, result repr) . 

+ 

+int sub   : compute (q sub code, left repr, right repr, result repr) . 

+ 

+real add  : compute (q fadd code, left repr, right repr, result repr) . 

+ 

+real sub  : compute (q fsub code, left repr, right repr, result repr) . 

+ 

+real mult : compute (q fmult code, left repr, right repr, result repr) . 

+ 

+real div  : compute (q fdiv code, left repr, right repr, result repr) . 

+ 

+int mult  : s3 (q esc mult code, left repr, right repr, result repr) . 

+ 

+int div   : s3 (q esc div code, left repr, right repr, result repr) . 

+ 

+int mod   : s3 (q esc mod code, left repr, right repr, result repr) .

+ 

+int real add : 

+    IF left type = int THEN int add

+                       ELSE real add

+    FI . 

+ 

+int real sub :

+    IF left type = int THEN int sub 

+                       ELSE real sub

+    FI .

+

+int real mult :

+    IF left type = int THEN int mult

+                       ELSE real mult

+    FI . 

+

+comp code : 

+    SELECT left type OF

+        CASE int    : IF opn.mod nr = q equal THEN q equ  ELSE q lsequ  FI 

+        CASE real   : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI

+        CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI

+        OTHERWISE errorstop (type error); q equ

+    ENDSELECT .

+

+left type : CONCR (left dtype)

+

+ENDPROC apply p3; 

+ 

+

+                      (***** Modul *****) 

+ 

+BOOL VAR module open ;

+

+.init opn section : 

+    module open := FALSE .;

+

+PROC begin module : 

+    IF module open THEN errorstop (nested module) 

+                   ELSE begin modul ; 

+                        module open := TRUE 

+    FI 

+ENDPROC begin module ; 

+ 

+PROC end module : 

+    IF NOT module open

+       THEN errorstop (module not opened) 

+       ELSE end modul ;

+            module open := FALSE

+    FI

+ENDPROC end module ; 

+

+TEXT PROC dump (OPN CONST operation) : 

+    IF   operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) 

+    ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation)

+                                  ELSE " undef. Opn" 

+    FI 

+ENDPROC dump ; 

+ 

+PROC begin modul :

+    EXTERNAL 10072

+ENDPROC begin modul ; 

+ 

+PROC end modul :

+    EXTERNAL 10011

+ENDPROC end modul ; 

+ 

+PROC proc head (INT VAR mod nr, top of stack) :

+    EXTERNAL 10012

+ENDPROC proc head ; 

+ 

+PROC set length (INT CONST top of stack, size) : 

+    EXTERNAL 10013

+ENDPROC set length ; 

+ 

+PROC get module nr (INT VAR module nr) : 

+    EXTERNAL 10016

+ENDPROC get module nr ; 

+ 

+PROC compute (INT CONST op code, l addr, r addr, result address) :

+    EXTERNAL 10017

+ENDPROC compute ; 

+ 

+PROC compare (INT CONST op code, l addr, r addr) :

+    EXTERNAL 10018

+ENDPROC compare ; 

+ 

+PROC long move (INT CONST to, from, length) :

+    EXTERNAL 10019

+ENDPROC long move ;

+

+PROC put next permanent (INT CONST permanent value) : 

+    EXTERNAL 10020

+ENDPROC put next permanent ; 

+ 

+PROC call (INT CONST mod nr) : 

+    EXTERNAL 10022

+ENDPROC call ; 

+ 

+PROC call param (INT CONST mod nr) : 

+    EXTERNAL 10023

+ENDPROC call param ; 

+ 

+PROC push param (INT CONST addr) : 

+    EXTERNAL 10024

+ENDPROC push param ; 

+ 

+PROC push param proc (INT CONST mod nr) : 

+    EXTERNAL 10025

+ENDPROC push param proc ; 

+ 

+PROC init param push (INT CONST mod nr) : 

+    EXTERNAL 10026

+ENDPROC init param push ; 

+ 

+PROC push result address (INT CONST addr) : 

+    EXTERNAL 10027

+ENDPROC push result address ; 

+ 

+PROC test bool object (INT CONST addr) : 

+    EXTERNAL 10187

+ENDPROC test bool object ; 

+ 

+PROC mark line (INT CONST line number) : 

+    EXTERNAL 10030

+ENDPROC mark line ; 

+ 

+PROC s0 (INT CONST op code) : 

+    EXTERNAL 10038

+ENDPROC s0 ; 

+ 

+PROC s1 (INT CONST op code, addr) : 

+    EXTERNAL 10039

+ENDPROC s1 ; 

+ 

+PROC s2 (INT CONST op code , addr1, addr2) : 

+    EXTERNAL 10040

+ENDPROC s2 ; 

+ 

+PROC s3 (INT CONST op code, addr1, addr2, addr3) : 

+    EXTERNAL 10041

+ENDPROC s3 ; 

+ 

+PROC t1 (INT CONST op code, addr) : 

+    EXTERNAL 10042

+ENDPROC t1 ; 

+ 

+PROC t2 (INT CONST op code, addr1, addr2) : 

+    EXTERNAL 10043

+ENDPROC t2 ; 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  9. Speicherverwaltung                     21.03.1986  *) 

+(*                                                                        *) 

+(*   Ablage der Paketdaten                                                *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR address value;

+ 

+INT CONST data allocation by coder  := 1 , 

+          data allocation by user   := 2 ; 

+

+LET not initialized      = 0 ,

+    wrong mm mode        = "Wrong MM Mode" ,

+    define on non global = "Define for GLOB only" ,

+    text too long        = "TEXT too long" ;

+ 

+TEXT VAR const buffer :: point line ;

+

+.reset memory management mode :

+     memory management mode := not initialized . ;

+ 

+PROC reserve storage (INT CONST size) : 

+    IF memory management mode <> data allocation by user 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (address value, size) ; 

+    memory management mode := not initialized

+ENDPROC reserve storage ; 

+ 

+PROC allocate variable (ADDRESS VAR addr, INT CONST size) : 

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (addr.value, size) ;

+    addr.kind := global

+ENDPROC allocate variable ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, INT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate int denoter (addr.value) ;

+    put data word (value, addr.value) ;

+    addr.kind := global

+ENDPROC allocate denoter ; 

+

+PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate real denoter (addr.value) ;

+    addr.kind := global ;

+    define (addr, value)

+ENDPROC allocate denoter ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; 

+    addr.kind := global ;

+    skip heaplink; 

+    define (addr, value) ; 

+    reset heaplink .

+ 

+skip heaplink : 

+    addr.value INCR 1 .

+

+reset heaplink :

+    addr.value DECR 1

+ENDPROC allocate denoter ; 

+ 

+PROC define (ADDRESS CONST addr, INT CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    put data word (value, addr.value) 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, REAL CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    replace (const buffer, 1, value) ; 

+    address value := addr.value ;

+    FOR index FROM 1 UPTO 4 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, TEXT CONST value) : 

+    IF   addr.kind <> global THEN errorstop (define on non global) 

+    ELIF LENGTH value > 255  THEN errorstop (text too long)

+    FI ; 

+    address value := addr.value ;

+    const buffer := code (LENGTH value) ; 

+    const buffer CAT value ; 

+    const buffer CAT " " ;

+    FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER ; 

+    const buffer := point line

+ENDPROC define ; 

+ 

+PROC prep pbase (INT VAR offset) : 

+    EXTERNAL 10032 

+ENDPROC prep pbase; 

+ 

+PROC allocate var (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10033

+ENDPROC allocate var ; 

+ 

+PROC allocate int denoter (INT VAR addr) : 

+    EXTERNAL 10034

+ENDPROC allocate int denoter ;

+ 

+PROC allocate real denoter (INT VAR addr) : 

+    EXTERNAL 10035 

+ENDPROC allocate real denoter ;

+

+PROC allocate text denoter (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10036 

+ENDPROC allocate text denoter ;

+ 

+PROC put data word (INT CONST value, INT CONST addr) :

+    EXTERNAL 10037

+ENDPROC put data word ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 10. Inspector                              08.01.1986  *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR line number, pattern length, packet link,

+        begin of packet, last packet entry, indentation;

+

+TEXT VAR bulletin name, type and mode, pattern, buffer;

+ 

+DATASPACE VAR bulletin ds :: nilspace ;

+

+.packet name :

+     cdb text (cdb int(packet link + wordlength) + two word length) .

+

+.within editor :

+    aktueller editor > 0 .  ;

+

+TEXT PROC type name (DTYPE CONST type) : 

+    type and mode := "" ; 

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC type name ; 

+ 

+TEXT PROC dump (DTYPE CONST type) :

+    type and mode := "TYPE " ;

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC dump ;

+

+PROC name of type (INT CONST type) :

+            SELECT type OF

+     CASE void              :

+     CASE int               : type and mode CAT "INT"

+     CASE real              : type and mode CAT "REAL"

+     CASE string            : type and mode CAT "TEXT"

+     CASE bool, bool result : type and mode CAT "BOOL"

+     CASE dataspace         : type and mode CAT "DATASPACE"

+     OTHERWISE              : complex type

+            ENDSELECT .

+

+complex type :

+     IF type > ptt limit THEN perhaps permanent struct or row

+                         ELSE get complex type

+     FI .

+

+perhaps permanent struct or row :

+     index := type + begin of pt minus ptt limit ;

+     mode := cdb int (index) MOD ptt limit ;

+     IF   mode = permanent row    THEN get permanent row 

+     ELIF mode = permanent struct THEN get permanent struct

+                                  ELSE type and mode CAT "-"

+     FI .

+

+get complex type :

+     index := type + begin of permanent table ;

+     IF is complex type THEN get name

+                        ELSE type and mode CAT "-"

+     FI .

+

+is complex type :

+     permanent type definition mode = permanent type .

+

+get name :

+     type and mode CAT cdb text (link to type name + two word length) .

+

+link to type name :

+     cdb int (index + three word length) .

+

+permanent type definition mode :

+     cdb int (index + wordlength) .

+

+get permanent row :

+     INT VAR t; 

+     type and mode CAT "ROW " ;

+     type and mode CAT text (cdb int (index + wordlength)) ;

+     type and mode CAT " " ;

+     param link := index + two wordlength ;

+     get type and mode (t) ;

+     name of type (t) .

+ 

+get permanent struct :

+     type and mode CAT "STRUCT ( ... )" 

+ENDPROC name of type ;

+

+PROC help (TEXT CONST proc name) :

+     prep bulletin ;

+     prep help ;

+     scan (object name) ;

+     next symbol (pattern) ;

+     packet link := end of permanent table ;

+     IF function = 0 THEN standard help

+                     ELSE asterisk help

+     FI .

+

+prep help :

+     object name := compress (proc name) ;

+     INT VAR function :: 0 ;

+     INT CONST l :: LENGTH object name ;

+     IF l > 1 AND object name <> "**"

+        THEN IF (object name SUB l) = "*"

+               THEN function INCR 2 ;

+                    delete char (object name, l)

+             FI ;

+             IF (object name SUB 1) = "*"

+               THEN function INCR 1 ;

+                    delete char (object name, 1)

+             FI ;

+             IF another asterisk THEN wrong function FI

+     FI.

+

+another asterisk :

+     pos (object name, "*") <> 0 .

+

+wrong function :

+     errorstop ("unzulaessige Sternfunktion") .

+

+standard help :

+     to object (pattern) ;

+     IF found THEN display

+              ELSE error stop ("unbekannt: " + proc name)

+     FI .

+

+display :

+     WHILE permanent pointer <> 0 REP

+         put name of packet if necessary ;

+         put specifications (pattern) ;

+         next procedure

+     ENDREP ;

+     show bulletin file .

+ 

+put name of packet if necessary :

+     IF new packet THEN packet link := permanent pointer ;

+                        find begin of packet ;

+                        writeline (2) ;

+                        write packet name

+     FI .

+

+find begin of packet :

+     REP 

+         packet link DECR wordlength

+     UNTIL begin of packet found PER .

+

+begin of packet found :

+     cdb int (packet link) = permanent packet .

+

+new packet :

+     permanent pointer < packet link .

+

+asterisk help :

+     hash table pointer := begin of hash table ;

+     pattern length := LENGTH pattern - 1 ;

+     REP

+        list all objects in current hash table chain ;

+        next hash entry

+     UNTIL end of hash table reached ENDREP ;

+     show bulletin file .

+

+list all objects in current hash table chain :

+     nt link := hash table pointer ;

+     WHILE yet another nt entry REP

+        permanent pointer := cdb int (nt link + wordlength) ;

+        object name := cdb text (nt link + two word length) ;

+        IF matching THEN into bulletin FI

+     PER .

+

+matching :

+     INT CONST p :: pos (object name, pattern) ;

+     SELECT function OF

+         CASE 1 :   p <> 0 AND p = LENGTH object name - pattern length

+         CASE 2 :   p = 1

+         CASE 3 :   p <> 0

+         OTHERWISE  FALSE

+     ENDSELECT .

+

+into bulletin :

+     object names into bulletin (BOOL PROC not end of chain)

+ENDPROC help ;

+ 

+BOOL PROC not end of chain :

+     permanent pointer <> 0 

+ENDPROC not end of chain ;

+

+PROC write packet name :

+     indentation := 0 ;

+     write line ;

+     write bulletin line ("PACKET ") ;

+     indentation := 7 ;

+     object name := packet name ;

+     write bulletin line (object name) ;

+     write bulletin line (":") ;

+     writeline (2)

+ENDPROC write packet name ;

+

+PROC put specifications (TEXT CONST proc name) :

+     put obj name (proc name) ;

+     to first param ;

+     IF NOT end of params THEN put param list FI ;

+     put result ;

+     writeline .

+ 

+to first param :

+     param link := permanent pointer + word length ;

+     set end marker if end of list .

+

+put result :

+     INT VAR type;

+     get type and mode (type) ;

+     IF type <> void THEN type and mode := "  --> " ;

+                          name of type (type) ;

+                          write bulletin line (type and mode)

+     FI

+ENDPROC put specifications ;

+

+PROC put param list : 

+     write bulletin line (" (") ;

+     REP

+         INT VAR type;

+         get type and mode (type) ;

+         put type and mode ;

+         maybe param proc ;

+         next pt param ;

+         IF end of params THEN write bulletin line (")") ;

+                               LEAVE put param list 

+         FI ;

+         write bulletin line (", ") ;

+     PER .

+

+put type and mode :

+     type and mode := "" ;

+     name of type (type) ;

+     type and mode CAT name of mode ;

+     write bulletin line (type and mode) .

+

+name of mode :

+     IF   mode = const THEN " CONST"

+     ELIF mode = var   THEN " VAR"

+                       ELSE " PROC"

+     FI .

+

+maybe param proc :

+     IF mode = permanent param proc THEN put virtual params FI .

+

+put virtual params :

+     skip over result type if complex type ;

+     IF NOT end of virtual params THEN put param list FI.

+

+skip over result type if complex type :

+     next pt param .

+

+end of virtual params :

+    end of params

+ENDPROC put param list ;

+

+PROC next packet :

+     REP

+         packet link INCR wordlength ;

+         word := cdb int (packet link) ;

+         IF   word = permanent packet THEN true return

+         ELIF end of permanents       THEN false return

+         FI ;

+     ENDREP .

+

+true return :

+     found := TRUE ;

+     LEAVE next packet .

+

+false return :

+     found := FALSE ;

+     LEAVE next packet .

+

+end of permanents :

+     word = permanent end OR packet link > end of permanent table 

+ENDPROC next packet ;

+

+PROC prep bulletin :

+     forget (bulletin ds) ;

+     bulletin ds := nilspace ;

+     bulletin file := sequential file (output, bulletin ds) ;

+     line number := 0 ;

+     buffer := ""

+ENDPROC prep bulletin ;

+

+PROC show bulletin file :

+     IF within editor THEN ueberschrift neu FI ;

+     DATASPACE VAR local ds :: bulletin ds ;

+     FILE VAR local file :: sequential file (modify, local ds) ;

+     edit (local file) ;

+     forget (local ds)

+ENDPROC show bulletin file ;

+

+PROC write bulletin line (TEXT CONST line) :

+     IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ;

+     buffer CAT line

+ENDPROC write bulletin line ;

+

+PROC writeline  :

+     write (bulletin file, buffer) ;

+     line (bulletin file) ;

+     line number INCR 1 ;

+     cout (line number) ;

+     buffer := indentation * " "

+ENDPROC writeline ;

+

+PROC writeline (INT CONST times) :

+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;

+                                          writeline

+                                     ELSE index := times

+     FI ;

+     line (bulletin file, index) ;

+     line number INCR index;

+     indentation := 0 ;

+     cout (line number)

+ENDPROC writeline ;

+ 

+PROC bulletin (TEXT CONST packet name) :

+     prep bulletin ;

+     scan (packet name) ;

+     next symbol (pattern) ;

+     to packet ; 

+     IF found THEN list packet ;

+                   show bulletin file

+              ELSE error stop (packet name + " ist kein Paketname")

+     FI . 

+ 

+to packet :

+     last packet entry := 0 ;

+     get nametab link of packet name ;

+     packet link := before first pt entry ;

+     REP

+         packet link INCR wordlength ;

+         word := cdb int (packet link) ;

+         IF word < 0 THEN IF   word = permanent packet THEN packet found

+                          ELIF word = permanent end    THEN return

+                          FI

+         FI

+     ENDREP .

+

+get nametab link of packet name :

+     to object (pattern) ;

+     IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ;

+                       LEAVE to packet

+     FI .

+

+packet found :

+     IF cdb int (packet link + wordlength) = nt link

+        THEN last packet entry := packet link FI .

+

+return : 

+     IF last packet entry <> 0 THEN found := TRUE ;

+                                    packet link := last packet entry

+                               ELSE found := FALSE

+     FI ;

+     LEAVE to packet

+ENDPROC bulletin ;

+ 

+PROC list packet :

+     begin of packet := packet link + word length ;

+     write packet name ; 

+     find end of packet ;

+     run through nametab and list all packet objects .

+ 

+find end of packet :

+     last packet entry := begin of packet ;

+     REP

+         last packet entry INCR wordlength ;

+         word := cdb int (last packet entry) ;

+     UNTIL end of packet entries PER .

+

+end of packet entries :

+     word = permanent packet OR word = permanent end .

+

+run through nametab and list all packet objects :

+     hashtable pointer := begin of hashtable ;

+     REP

+         nt link := hashtable pointer ;

+         list objects of current packet in this chain ;

+         next hash entry

+     UNTIL end of hashtable reached ENDREP .

+

+list objects of current packet in this chain :

+     WHILE yet another nt entry REP 

+         permanent pointer := cdb int (nt link + wordlength) ;

+         put objects of this name

+     PER .

+

+put objects of this name :

+     IF there is at least one object of this name in the current packet

+       THEN into bulletin FI .

+

+there is at least one object of this name in the current packet :

+     REP

+        IF permanent pointer >= begin of packet AND

+           permanent pointer < last packet entry

+           THEN LEAVE there is at least one object of this name

+                      in the current packet WITH TRUE FI ;

+        next procedure

+     UNTIL permanent pointer = 0 PER ;

+     FALSE .

+

+into bulletin :

+     object name := cdb text (nt link + two word length) ;

+     object names into bulletin (BOOL PROC within packet)

+ENDPROC list packet ;

+

+BOOL PROC within packet :

+     permanent pointer >= begin of packet AND 

+     permanent pointer < last packet entry

+ENDPROC within packet ;

+

+PROC object names into bulletin (BOOL PROC link ok) :

+     scan (object name) ;

+     next symbol (object name, mode) ;

+     IF type definition THEN put type definition

+                        ELSE put object definitions

+     FI .

+

+type definition :

+     mode = bold AND no params .

+

+no params :

+     cdb int (permanent pointer + word length) >= permanent type .

+

+put type definition :

+     put obj name (object name) ;

+     write bulletin line ("TYPE ") ;

+     writeline (1) .

+

+put object definitions :

+     WHILE link ok REP

+         put specifications (object name) ;

+         next procedure

+     ENDREP 

+ENDPROC object names into bulletin ;

+ 

+PROC bulletin :

+     prep bulletin ;

+     packet link := first permanent entry ;

+     REP

+         list packet ;

+         write line (4) ;

+         next packet

+     UNTIL NOT found PER ;

+     show bulletin file

+ENDPROC bulletin ;

+

+PROC put obj name (TEXT CONST name) :

+     buffer := "      " ;

+     bulletin name := point line ;

+     change (bulletin name, 1, end of line or name, name) ;

+     buffer CAT bulletin name ;

+     indentation := LENGTH buffer + 1 .

+

+end of line or name :

+     min (LENGTH name, LENGTH bulletin name)

+ENDPROC put obj name ;

+

+PROC packets :

+     prep bulletin ;

+     packet link := first permanent entry ;

+     REP

+         object name := packet name ;

+         put obj name (object name) ;

+         write line ;

+         next packet 

+     UNTIL NOT found PER ;

+     show bulletin file

+ENDPROC packets ;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 11. ELAN Run-Interface                     09.01.1986  *) 

+(*                                                                        *) 

+(*   Uebersetzen von ELAN-Programmen                                      *) 

+(*   Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler           *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+BOOL VAR list option     := FALSE ,

+         check option    :=  TRUE ,

+         listing enabled := FALSE ;

+

+FILE VAR listing file ;

+

+TEXT VAR listing file name := "" ;

+ 

+ 

+PROC run (TEXT CONST file name) : 

+  enable stop ;

+  IF NOT exists (file name)

+    THEN errorstop ("""" + file name + """ gibt es nicht")

+  FI ;

+  last param (file name) ;

+  run elan (file name, no ins)

+END PROC run;

+ 

+PROC run :

+  run (last param)

+ENDPROC run ;

+ 

+PROC run again :

+  IF run again mod nr <> 0

+    THEN elan (run again mode, bulletin file, "", run again mod nr, 

+               no ins, no lst, check option, no sermon)

+    ELSE errorstop ("'run again' nicht moeglich")

+  FI

+ENDPROC run again ;

+ 

+PROC insert (TEXT CONST file name) : 

+  enable stop ;

+  IF NOT exists (file name)

+    THEN errorstop ("""" + file name + """ gibt es nicht")

+  FI ;

+  last param (file name) ;

+  run elan (file name, ins)

+ENDPROC insert ;

+ 

+PROC insert :

+  insert (last param)

+ENDPROC insert ;

+ 

+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :

+  FILE VAR source := sequential file (modify, file name) ;

+  IF listing enabled

+    THEN open listing file

+  FI ;

+

+  disable stop ;

+  no do again ;

+  elan (compile file mode, source, "" , run again mod nr,

+        insert option, list option, check option, sermon) ;

+ 

+  IF anything noted AND command dialogue

+    THEN ignore halt during compiling ;

+         note edit (source) ;

+         errorstop ("")

+  FI .

+

+ignore halt during compiling :

+  IF is error

+    THEN put error ;

+         clear error ;

+         pause (5)

+  FI .

+

+open listing file :

+  listing file := sequential file (output, listing file name) ;

+  max line length (listing file, 130)

+

+ENDPROC run elan ;

+(*

+PROC out text (TEXT CONST text, INT CONST out type) :

+  INTERNAL 257 ; 

+  IF online

+    THEN out (text)

+  FI ;

+  IF out type = error message 

+    THEN note (text) ; 

+         number of errors INCR 1 

+    ELIF out type = warning message 

+        THEN note (text) 

+  FI ;

+  IF listing enabled

+    THEN write (listing file, text)

+  FI

+ENDPROC out text ;

+ 

+PROC out line (INT CONST out type) :

+  INTERNAL 258 ; 

+  IF online

+    THEN out (""13""10"")

+  FI ;

+  IF out type = error message OR out type = warning message

+    THEN note line

+  ELIF listing enabled

+    THEN line (listing file)

+  FI

+ENDPROC out line ;

+*)

+PROC prot (TEXT CONST file name) :

+  list option := TRUE ;

+  listing file name := file name ;

+  listing enabled := TRUE

+ENDPROC prot ;

+ 

+PROC prot off :

+  list option := FALSE ;

+  listing enabled := FALSE

+ENDPROC prot off ;

+

+BOOL PROC prot :

+  list option

+ENDPROC prot ;

+ 

+PROC check on :

+  check option := TRUE

+ENDPROC check on ;

+ 

+PROC check off :

+  check option := FALSE

+ENDPROC check off ;

+ 

+BOOL PROC check :

+  check option

+ENDPROC check ;

+

+ENDPACKET eumel coder ; 

diff --git a/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod
new file mode 100644
index 0000000..6914548
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod
@@ -0,0 +1,2043 @@
+PACKET eumel coder                                 (* Autor: U. Bartling *) 

+       DEFINES coder on, coder off,                (* 1.8.0-Korr. M.St. *) 

+               declare, define, apply, identify,   (* 21.11.86 *)

+               :=, =,                              (* EXTERNAL 10...Nummern*)

+               dump,                               (* und coderon-flags *)

+                                                   (* inspector/coder1 weg *)

+               LABEL,

+               gosub, goret,

+               complement condition code,

+

+               ADDRESS ,

+               GLOB, LOC, REF, DEREF,

+               ref length,

+               +, 

+               adjust,

+               is global, is local, is ref,

+ 

+               DTYPE, 

+               type class, type name,

+               void type, int type, real type, text type, bool type, 

+               dataspace type, undefined type, 

+               row type, struct type, proc type, end type,

+ 

+               OPN, 

+               set length of local storage, 

+               begin module, end module, 

+               is proc, is eumel 0 instruction,

+               address, operation,

+               nop, 

+               init op codes,

+               mnemonic, 

+

+               parameter,

+               next param,

+               NEXTPARAM, 

+               access , 

+               dtype , 

+               param address,

+               same type ,

+ 

+               reserve storage, 

+               allocate denoter , 

+               allocate variable, 

+               data allocation by coder ,

+               data allocation by user :

+

+(**************************************************************************)

+(*                                                                        *) 

+(*                         E U M E L  -  C O D E R                        *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(*   Zur Beschreibung des Coders siehe                                    *) 

+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 

+(*                                                                        *) 

+(*   Stand der Dokumentation  : 13.02.1986                                *) 

+(*   Stand der Implementation : 21.03.1986                                *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+                   (***** Globale Variable *****) 

+

+TEXT VAR object name;

+ 

+FILE VAR bulletin file; 

+ 

+INT VAR memory management mode, global address offset,

+        nt link, permanent pointer, param link, index, mode, field pointer;

+ 

+BOOL VAR found, end of params;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  1. Interface zum ELAN-Compiler            12.03.1986  *) 

+(*                              1.7.5.4                                   *)

+(*                                                                        *) 

+(*   Beschreibung der      Tabellen (-groessen),                          *) 

+(*                         internen Vercodung von Typen                   *) 

+(*                    und  Kennungen .                                    *) 

+(*   Initialisieren und Beenden des Compilers,                            *) 

+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+LET  begin of hash table         =     0 ,

+     end of hash table           =  1023 ,

+ 

+     begin of permanent table    = 22784 ,

+(*     before first pt entry     = 22784 , *)

+(*     first permanent entry     = 22785 , *)

+(*   end of permanent table      = 32767 , *)

+

+     wordlength                  =     1 ,  (* compile  u n d  run time *)

+     two word length             =     2 ,

+     three word length           =     3 ,

+     four word length            =     4 ,

+ 

+     permanent param const             = 10000 ,

+     permanent param var               = 20000 ,

+     permanent proc op                 = 30000 ,

+     permanent type                    = 30000 ,

+     permanent row                     =    10 ,

+     permanent struct                  =    11 ,

+     permanent param proc              =    12 ,

+(*   permanent param proc end marker   =     0 , *)

+     permanent type field              =     0 ,

+

+     ptt limit                         = 10000 ,

+     begin of pt minus ptt limit       = 12784 ,

+     offset to row size                = 12785 ,

+ 

+     void                              =     0 ,

+     int                               =     1 ,

+     real                              =     2 ,

+     string                            =     3 ,

+     bool                              =     5 ,

+     bool result                       =     6 ,

+     dataspace                         =     7 ,

+     undefined                         =     9 ,

+     row                               =    10 ,

+     struct                            =    11 ,

+     end                               =     0 ,

+

+     const                             =     1 , 

+     var                               =     2 ,

+(*   proc                              =     3 , *)

+(*   denoter                           =     5 , *)

+(*   bold                              =     2 , *)

+ 

+     ins                               = TRUE ,

+     no ins                            = FALSE ,

+     no lst                            = FALSE ,

+     sermon                            = TRUE  ,

+     no sermon                         = FALSE ,

+

+(*   run again mode                    =     0 , *)

+(*   compile file mode                 =     1 , *)

+     prep coder mode                   =     5 , 

+ 

+(*   warning message                   =     2 , *) 

+(*   error message                     =     4 , *) 

+

+     point line                        = "..............." ;

+(* 

+INT CONST permanent packet            :=     -2 ,

+          permanent end               :=     -3 ;

+*)

+BOOL VAR coder active                 := FALSE ; 

+

+INT  VAR run again mod nr             :=     0 ;

+ 

+ 

+                     (***** Start/Ende *****)

+ 

+LET invalid coder off = "CODER not active" ;

+

+PROC coder on (INT CONST data allocation mode) : 

+    mark coder on ; 

+    init memory management ; 

+    init opn section ; 

+    init compiler .

+ 

+mark coder on :

+    coder active := TRUE .

+

+init memory management :

+    memory management mode := data allocation mode ;

+    prep pbase (global address offset) .

+ 

+init compiler :

+    no do again ;

+    elan (prep coder mode, bulletin file, "", run again mod nr,

+          no ins, prot, check, no sermon) (* prot, check f.test, M.St. *)

+

+ENDPROC coder on;

+ 

+PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) :

+    IF coder active 

+       THEN mark coder off ; 

+            end coder (insert, sermon, start mod nr if no insert)

+       ELSE errorstop (invalid coder off)

+    FI .

+ 

+start mod nr if no insert :

+    IF insert THEN run again mod nr := 0

+              ELSE run again mod nr := start proc.mod nr

+    FI ;

+    run again mod nr .

+

+mark coder off :

+    reset memory management mode ;

+    init opn section ;

+    coder active := FALSE

+ENDPROC coder off ; 

+ 

+PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) :

+    EXTERNAL 10021

+ENDPROC end coder ; 

+

+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 

+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+ 

+                   (***** Hash/Namenstabelle *****) 

+

+. yet another nt entry :

+     nt link := cdb int (nt link) ;

+     nt link <> 0 . ;

+ 

+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 

+    EXTERNAL 10031

+ENDPROC declare object ; 

+ 

+PROC to object (TEXT CONST searched object) : 

+     hash ;

+     search nt entry .

+

+hash :

+     hash code := 0 ;

+     FOR index FROM 1 UPTO LENGTH searched object REP

+         addmult cyclic

+     ENDREP .

+

+addmult cyclic :

+     hash code INCR hash code ;

+     IF hash code > end of hash table THEN wrap around FI ;

+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .

+

+wrap around :

+     hash code DECR end of hash table .

+

+hash code : nt link .

+

+search nt entry :

+     found := FALSE ;

+     WHILE yet another nt entry REP

+          read current entry ;

+          IF object name = searched object 

+             THEN found := TRUE ;

+                  LEAVE to object

+          FI

+     PER .

+

+read current entry :

+     permanent pointer := cdb int (nt link + wordlength) ;

+     object name := cdb text (nt link + two word length)

+ENDPROC to object ;

+

+

+                 (***** Permanent Tabelle *****) 

+.

+next procedure :

+     permanent pointer := cdb int (permanent pointer) . ;

+

+PROC next pt param :

+     mode := cdb int (param link) MOD ptt limit ;

+     param link INCR wordlength ;

+     IF   mode = permanent row    THEN skip over permanent row 

+     ELIF mode = permanent struct THEN skip over permanent struct

+     FI ;

+     set end marker if end of list .

+

+skip over permanent row :

+     param link INCR wordlength ;

+     next pt param .

+

+skip over permanent struct :

+     REP

+         next pt param ;

+         mode := cdb int (param link)

+     UNTIL mode = permanent type field PER ;

+     param link INCR wordlength

+ENDPROC next pt param ;

+

+PROC set end marker if end of list :

+     mode := cdb int (param link) ;

+     end of params := mode >= permanent proc op OR mode <= 0 

+ENDPROC set end marker if end of list ;

+

+PROC get type and mode (INT VAR type) : 

+     mode := cdb int (param link) ;

+     IF mode = permanent param proc THEN type of param proc

+                                    ELSE type of object

+     FI .

+

+type of param proc : 

+     param link INCR wordlength ;

+     get type and mode (type) ;

+     mode := permanent param proc .

+

+type of object :

+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;

+                      mode := 0

+                 ELSE type := mode MOD ptt limit ;

+                      mode DECR type ;

+                      translate type if necessary ;

+                      translate mode if necessary 

+     FI .

+

+translate type if necessary :

+     IF permanent row or struct THEN translate type FI .

+

+translate type :

+     type := param link - begin of pt minus ptt limit .

+

+translate mode if necessary : 

+    IF   mode = permanent param const THEN mode := const

+    ELIF mode = permanent param var   THEN mode := var

+    FI .

+

+permanent row or struct :

+     type = permanent row OR type = permanent struct

+ENDPROC get type and mode ;

+ 

+

+                 (***** Allgemeine Zugriffsprozeduren *****) 

+

+INT PROC cdb int (INT CONST index) :

+   EXTERNAL 116

+ENDPROC cdb int ;

+

+TEXT PROC cdb text (INT CONST index) :

+   EXTERNAL 117

+ENDPROC cdb text ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  2. Spruenge und Marken                    07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps LABEL                                       *) 

+(*                                                                        *) 

+(*   Deklaration, Definition und Applikation von Marken                   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE LABEL = INT ; 

+

+BOOL VAR invers :: FALSE ; 

+ 

+PROC declare (LABEL VAR label) : 

+    CONCR (label) := 0

+ENDPROC declare ; 

+ 

+PROC define (LABEL VAR label) : 

+    EXTERNAL 10083

+ENDPROC define ; 

+ 

+PROC complement condition code : 

+    invers := TRUE

+ENDPROC complement condition code ; 

+ 

+PROC apply (LABEL VAR label) : 

+    EXTERNAL 10148 

+ENDPROC apply ; 

+ 

+PROC apply (LABEL VAR label, BOOL CONST condition) : 

+    IF condition xor invers THEN branch true (label) 

+                            ELSE branch false (label)

+    FI ;

+    invers := FALSE .

+

+condition xor invers : 

+    IF condition THEN NOT invers

+                 ELSE invers

+    FI

+ENDPROC apply ; 

+ 

+OP := (LABEL VAR global label, local label) : (* EQUATE ! *)

+    EXTERNAL 10014 

+ENDOP := ; 

+ 

+TEXT PROC dump (LABEL CONST label) : 

+    "LAB " + text (CONCR (label)) 

+ENDPROC dump ; 

+ 

+PROC gosub (LABEL VAR label) : 

+    EXTERNAL 10015 

+ENDPROC gosub ; 

+ 

+PROC goret : 

+    s0 (q goret code) 

+ENDPROC goret ; 

+ 

+PROC branch true (LABEL VAR label) : 

+    EXTERNAL 10028

+ENDPROC branch true ; 

+ 

+PROC branch false (LABEL VAR label) : 

+    EXTERNAL 10029

+ENDPROC branch false ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  3. Datenaddressen                         21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps ADDRESS                                     *) 

+(*                                                                        *) 

+(*   Aufbau von Datenaddressen (Vercodung)                                *) 

+(*   Fortschalten und Ausrichten von Adressen                             *) 

+(*   Bereitstellen der Fehlermeldung "address overflow" (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+TYPE ADDRESS = STRUCT (INT kind, value) ; 

+ 

+LET global                 = 0 , 

+    local                  = 1 , 

+    ref mask               = 2 , 

+    global ref             = 2 , 

+    local ref              = 3 , 

+    module nr              = 4 ,

+    immediate value        = 5 ,

+ 

+    eumel0 stack offset    = 4 ,

+    local address limit    = 16 384 ,

+ 

+    illegal ref operation  = "REF not allowed" , 

+    deref on non ref       = "DEREF on non-ref address" ,

+    global ref not allowed = "GLOBAL REF not allowed" , 

+    unknown kind           = "Unknown address kind" , 

+    address overflow       = "Address Overflow" , 

+    illegal plus operation = "+ not allowed" ;

+ 

+ADDRESS VAR result addr;

+ 

+INT CONST ref length :: 2 ;

+

+OP := (ADDRESS VAR l, ADDRESS CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+ADDRESS OP GLOB (INT CONST address level) : 

+    result addr.kind  := global ; 

+    result addr.value := address level ; 

+    IF memory management mode = data allocation by user

+       THEN result addr.value INCR global address offset

+    FI ;

+    result addr

+ENDOP GLOB ;

+

+ADDRESS OP LOC (INT CONST address level) : 

+    result addr.kind  := local ;

+    result addr.value := address level + eumel0 stack offset ; 

+    result addr

+ENDOP LOC ; 

+ 

+ADDRESS OP REF (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    IF   result addr.kind = local  THEN result addr.kind INCR ref mask

+    ELIF result addr.kind = global THEN errorstop (global ref not allowed)

+                                   ELSE errorstop (illegal ref operation)

+    FI ;

+    result addr 

+ENDOP REF ; 

+ 

+ADDRESS OP DEREF (ADDRESS CONST ref address) : 

+    CONCR (result addr) := CONCR (ref address) ;

+    IF is not local ref THEN errorstop (deref on non ref) FI ; 

+    result addr.kind DECR ref mask ; 

+    result addr .

+ 

+is not local ref :

+    result addr.kind <> local ref

+ENDOP DEREF ;

+ 

+INT OP REPR (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    SELECT result addr.kind OF 

+        CASE global     :

+        CASE local      : set bit (result addr.value, 15) 

+        CASE global ref : errorstop (global ref not allowed)

+        CASE local ref  : prep local ref 

+        OTHERWISE errorstop (unknown kind)

+    ENDSELECT ; 

+    result addr.value .

+ 

+prep local ref : 

+    IF address limit exceeded THEN errorstop (address overflow) FI ;

+    set bit (result addr.value, 14) ; 

+    set bit (result addr.value, 15) .

+

+address limit exceeded :

+    result addr.value < eumel0 stack offset OR

+    result addr.value > local address limit

+ENDOP REPR ; 

+ 

+BOOL PROC is ref (ADDRESS CONST addr) : 

+    addr.kind = local ref

+ENDPROC is ref ; 

+ 

+BOOL PROC is global (ADDRESS CONST addr) : 

+    addr.kind = global 

+ENDPROC is global ; 

+ 

+BOOL PROC is local (ADDRESS CONST addr) : 

+    addr.kind = local 

+ENDPROC is local ; 

+ 

+ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : 

+    CONCR (result addr) := CONCR (addr) ; 

+    SELECT result addr.kind OF 

+        CASE global : inc global

+        CASE local  : inc local

+        OTHERWISE     errorstop (illegal plus operation) 

+    ENDSELECT ; 

+    result addr .

+ 

+inc global : 

+    result addr.value INCR offset ; 

+    IF result addr.value < 0 THEN errorstop (address overflow) FI .

+ 

+inc local : 

+    result addr.value INCR offset ; 

+    IF result addr.value < eumel 0 stack offset OR

+       result addr.value > local address limit

+       THEN errorstop (address overflow)

+    FI

+ENDOP + ; 

+ 

+PROC adjust (ADDRESS VAR addr, INT CONST adjust length) :

+    IF is local or global THEN adjust to length FI . 

+ 

+is local or global :

+    addr.kind <= local .

+

+adjust to length :

+    mode := addr.value MOD adjust length ;

+    IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI

+ENDPROC adjust ;

+

+TEXT PROC dump (ADDRESS CONST addr) : 

+    kind + text (addr.value) . 

+ 

+kind : 

+    SELECT addr.kind OF 

+        CASE global          : "GLOBAL " 

+        CASE local           : "LOCAL " 

+        CASE immediate value : "IMMEDIATE "

+        CASE module nr       : "PARAM PROC "

+        CASE global ref      : "GLOBAL REF " 

+        CASE local ref       : "LOCAL REF " 

+        OTHERWISE "undef. Addr:" 

+    ENDSELECT 

+ENDPROC dump; 

+

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  4. Datentypen   Teil I                    03.12.1985  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps DTYPE                                       *) 

+(*                                                                        *) 

+(*   Interne Repraesentation der primitiven Datentypen                    *) 

+(*   Identifikation von DTYPEs                                            *)

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+TYPE DTYPE = INT ; 

+ 

+OP := (DTYPE VAR l, DTYPE CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+BOOL OP = (DTYPE CONST l, r) : 

+    CONCR (l) = CONCR (r)

+ENDOP = ; 

+ 

+DTYPE PROC void type :      DTYPE :(void)      ENDPROC  void type ; 

+ 

+DTYPE PROC int  type :      DTYPE :(int )      ENDPROC  int type ; 

+ 

+DTYPE PROC real type :      DTYPE :(real)      ENDPROC  real type ; 

+ 

+DTYPE PROC text type :      DTYPE :(string)    ENDPROC  text type ; 

+ 

+DTYPE PROC bool type :      DTYPE :(bool)      ENDPROC  bool type ; 

+ 

+DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; 

+ 

+DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; 

+ 

+DTYPE PROC row type  :      DTYPE :(row)       ENDPROC row type ; 

+ 

+DTYPE PROC struct type :    DTYPE :(struct)    ENDPROC struct type ; 

+ 

+DTYPE PROC proc type :   DTYPE :(permanent param proc) ENDPROC proc type ; 

+ 

+DTYPE PROC end type  :      DTYPE :(end)       ENDPROC end type ; 

+ 

+INT PROC type class (DTYPE CONST type) : 

+    SELECT type id OF 

+        CASE int, real, bool, string, dataspace, undefined : 1 

+        CASE void   : 0 

+        CASE row    : 3 

+        CASE struct : 4 

+        CASE permanent param  proc : 5 

+        OTHERWISE     pt type 

+    ENDSELECT . 

+

+pt type :

+    IF type id > ptt limit THEN permanent row or struct

+                           ELSE abstract type

+    FI .

+

+abstract type : 2 .

+

+permanent row or struct :

+    mode := cdbint (type link into pt) MOD ptt limit ; 

+    IF   mode = struct THEN 4

+    ELIF mode = row    THEN 3

+                       ELSE 2

+    FI .

+ 

+type link into pt :

+    type id + begin of pt minus ptt limit .

+

+type id : CONCR (type)

+ENDPROC type class ; 

+ 

+PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : 

+    SELECT type pos OF 

+          CASE 1   : size := 0; align := 0; type id := void 

+          CASE 6   : size := 1; align := 1; type id := int 

+          CASE 10  : size := 4; align := 4; type id := real 

+          CASE 15  : size := 8; align := 4; type id := string

+          CASE 20  : size := 1; align := 1; type id := bool 

+          CASE 25  : size := 1; align := 1; type id := dataspace

+          OTHERWISE  search for type in permanent table 

+    ENDSELECT . 

+ 

+type pos : 

+    enclose in delimiters ;

+    pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . 

+ 

+enclose in delimiters :

+    object name := "." ;

+    object name CAT name ;

+    object name CAT "." .

+

+search for type in permanent table : 

+    to object (name) ;

+    IF NOT found THEN size := 0; align := 0; type id := undefined 

+                 ELSE size := cdbint (permanent pointer + two wordlength) ;

+                      type id := permanent pointer - begin of permanent table ;

+                      IF   size < two wordlength  THEN align := 1

+                      ELIF size < four wordlength THEN align := 2

+                                                  ELSE align := 4

+                      FI

+    FI . 

+ 

+type id : CONCR (type)

+ENDPROC identify ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  5. Operationen  Teil I                    21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps OPN                                         *) 

+(*   Primitive Operationen (:=  etc.)                                     *) 

+(*   Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ;

+ 

+LET proc op    = 0 ,

+    param proc = 1 ,

+    eumel 0    = 2 , 

+    nil        = 3 , 

+ 

+    param proc at non ref = "PARAM PROC at non-ref address" ,

+    proc op expected      = "PROC expected" ;

+ 

+OPN VAR eumel0 opn;

+eumel0 opn.kind := eumel0 ;

+eumel0 opn.top of stack := 0 ;

+

+eumel0 opn.mod nr := q pp ;

+OPN CONST pp       :: eumel0 opn ,

+          nop code :: OPN :(nil, 0, 0) ;

+

+THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; 

+ 

+PROC init op codes (FILE VAR eumelcodes) : 

+    eumel 0 opcodes := empty thesaurus ;

+    WHILE NOT eof (eumelcodes) REP

+       getline (eumelcodes, object name) ;

+       delete trailing blanks ;

+       IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name)

+          THEN insert (eumel 0 opcodes, object name)

+       FI

+    PER .

+

+delete trailing blanks :

+    WHILE (object name SUB LENGTH object name) = " " REP

+       object name := subtext (object name, 1, LENGTH object name - 1)

+    PER

+ENDPROC init op codes ; 

+

+ADDRESS PROC address (OPN CONST opn) :

+    IF opn.kind <> proc op THEN errorstop (proc op expected) FI ;

+    result addr.kind  := module nr ; 

+    result addr.value := opn.mod nr ;

+    result addr

+ENDPROC address ;

+ 

+OPN PROC operation (ADDRESS CONST addr) : 

+    IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; 

+    OPN VAR opn ;

+    opn.kind := param proc ; 

+    opn.mod nr :=addr.value ; 

+    opn.top of stack := 0 ; 

+    opn 

+ENDPROC operation ; 

+ 

+TEXT PROC mnemonic (OPN CONST op code) : 

+    name (eumel 0 opcodes, op code.mod nr)

+ENDPROC mnemonic ;

+ 

+OPN PROC nop : 

+    nop code

+ENDPROC nop ; 

+ 

+OP := (OPN VAR r, OPN CONST l) : 

+    CONCR (r) := CONCR (l) 

+ENDOP := ; 

+ 

+BOOL PROC is proc (OPN CONST operation) : 

+    operation.kind = proc op

+ENDPROC is proc ; 

+ 

+BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : 

+    link (eumel 0 opcodes, op code name) <> 0

+ENDPROC is eumel 0 instruction ; 

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  6. Parameterfeld                          10.01.1986  *) 

+(*                                                                        *) 

+(*   Bereitstellen des Parameterfeldes                                    *) 

+(*   Schreiben und Lesen von Eintraegen im Parameterfeld                  *) 

+(*   Fortschalten von Zeigern in das Parameterfeld                        *) 

+(*   Bereitstellen der Konstanten 'size of param field' (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+LET PARAMDESCRIPTOR = STRUCT (DTYPE type,   INT access, 

+                              ADDRESS addr, OPN push opn) , 

+ 

+    size of param field   = 100 ,

+    param field exceeded  = "Param Field Overflow",

+    param nr out of range = "Illegal Param Number" ;

+ 

+ROW size of param field PARAMDESCRIPTOR VAR param field ;

+ 

+ 

+                      (***** Schreiben *****) 

+ 

+PROC test param pos (INT CONST param nr) : 

+    IF param nr < 1 OR param nr > size of param field

+       THEN errorstop (param nr out of range)

+    FI 

+ENDPROC test param pos ; 

+ 

+PROC declare (INT CONST param nr, DTYPE CONST type) : 

+    test param pos (param nr) ; 

+    enter type . 

+ 

+enter type :

+    CONCR (param field [param nr].type) := CONCR (type) 

+ENDPROC declare ; 

+ 

+PROC declare (INT CONST param nr, access) : 

+    test param pos (param nr) ; 

+    enter access . 

+

+enter access :

+    param field [param nr].access := access 

+ENDPROC declare ; 

+ 

+PROC define (INT CONST param nr, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter address . 

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) 

+ENDPROC define ; 

+ 

+PROC define (INT CONST param nr, value) : 

+    result addr.kind  := immediate value ;

+    result addr.value := value ;

+    define (param nr, result addr) 

+ENDPROC define ; 

+ 

+PROC apply (INT CONST param nr, OPN CONST opn) : 

+    test param pos (param nr) ; 

+    enter push opn . 

+ 

+enter push opn : 

+    CONCR (param field [param nr].push opn) := CONCR (opn) 

+ENDPROC apply ; 

+ 

+PROC parameter (INT CONST param nr, DTYPE CONST type, 

+                INT CONST access, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter type ; 

+    enter access ; 

+    enter address ; 

+    enter pp as default . 

+ 

+enter type : 

+    CONCR (param field [param nr].type) := CONCR (type) .

+

+enter access :

+    param field [param nr].access := access .

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) .

+

+enter pp as default :

+    CONCR (param field [param nr].push opn) := CONCR (pp) 

+ENDPROC parameter ; 

+ 

+ 

+                       (***** Lesen *****) 

+ 

+ADDRESS PROC param address (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].addr 

+ENDPROC param address ; 

+ 

+DTYPE PROC dtype (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].type 

+ENDPROC dtype ; 

+ 

+INT PROC access (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].access 

+ENDPROC access ; 

+ 

+ 

+                      (***** Fortschalten *****) 

+ 

+OP NEXTPARAM (INT VAR param nr) : 

+   test param pos (param nr) ; 

+   IF long entry THEN read until end FI ; 

+   param nr INCR 1 .

+ 

+long entry : 

+    type class (param field [param nr].type) > 2 . 

+ 

+read until end : 

+    REP 

+        param nr INCR 1 ; 

+        NEXTPARAM param nr 

+    UNTIL end marker read or end of field PER . 

+ 

+end marker read or end of field :

+    param nr > size of param field OR

+    CONCR (param field [param nr].type) = end 

+ENDOP NEXTPARAM ; 

+ 

+INT PROC next param (INT CONST p) : 

+    index := p ; 

+    NEXTPARAM index ; 

+    index

+ENDPROC next param ; 

+ 

+TEXT PROC dump (INT CONST p) : 

+   IF p > 0 AND p <= 100 THEN dump entry (param field (p)) 

+                         ELSE param nr out of range 

+    FI 

+ENDPROC dump ; 

+ 

+TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : 

+    object name := dump (id.type) ; 

+    object name CAT text (id.access) ; 

+    object name CAT dump (id.addr) ; 

+    object name CAT dump (id.push opn) ;

+    object name

+ENDPROC dump entry ; 

+

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  7. Datentypen   Teil II                   20.01.1986  *) 

+(*                                                                        *) 

+(*   Deklaration neuer Datentypen                                         *) 

+(*   Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+DTYPE VAR pt type ;

+

+PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : 

+    entry into name table ; 

+    put next permanent (permanent type) ; 

+    put next permanent (size) ; 

+    put next permanent (nt link) ;

+    mark no offsets of text elements . 

+ 

+entry into name table : 

+    declare object (name, nt link, CONCR (type)) . 

+ 

+mark no offsets of text elements : 

+    put next permanent (0) 

+ENDPROC declare ; 

+ 

+BOOL PROC same type (INT CONST param 1, param 2) : 

+    INT CONST left type :: CONCR (param field [param 1].type) ;

+    IF left type = right type

+       THEN same fine structure if there is one

+       ELSE left type = undefined OR right type = undefined

+    FI .

+ 

+right type : CONCR (param field [param 2].type) . 

+ 

+same fine structure if there is one : 

+    IF   left type = row    THEN compare row 

+    ELIF left type = struct THEN compare struct 

+                            ELSE TRUE 

+    FI . 

+ 

+compare row : 

+    equal sizes AND same type (param1 + 1, param2 + 1) . 

+ 

+equal sizes : 

+    param field [param1+1].access = param field [param2+1].access .

+ 

+compare struct : 

+    INT VAR p1 :: param1+1, p2 :: param2+1 ; 

+    REP 

+       IF   NOT same type (p1, p2) THEN LEAVE same type WITH FALSE 

+       ELIF end type found         THEN LEAVE same type WITH TRUE

+       FI ;

+       NEXTPARAM p1 ;

+       NEXTPARAM p2

+    UNTIL end of field PER ;

+    FALSE .

+

+end type found :

+    CONCR (param field [p1].type) = end .

+

+end of field : 

+    p1 > size of param field OR p2 > size of param field 

+ENDPROC same type ;

+ 

+BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : 

+    field pointer := param nr ;

+    CONCR (pt type) := CONCR (type) ;

+    equal types 

+ENDPROC same type ;

+

+BOOL PROC equal types : 

+    identical types OR one type is undefined .

+

+one type is undefined :

+    type of actual field = undefined OR CONCR(pt type) = undefined .

+

+identical types :

+    SELECT type class (pt type) OF 

+        CASE 0, 1, 2 : type of actual field = CONCR (pt type)

+        CASE 3       : perhaps equal rows

+        CASE 4       : perhaps equal structs

+        OTHERWISE      FALSE

+    ENDSELECT .

+

+perhaps equal rows :

+    is row AND equal row sizes AND equal row types . 

+ 

+is row :

+    type of actual field = row .

+

+perhaps equal structs : 

+    is struct AND same type fields . 

+ 

+is struct :

+    type of actual field = struct .

+

+equal row sizes :

+    pt row size = row size within param field . 

+

+equal row types :

+    same type (field pointer + 1, pt row type) .

+

+pt row size :

+    cdb int (CONCR(pt type) + offset to row size) .

+

+pt row type :

+    CONCR (pt type) INCR 2 ;

+    pt type .

+

+row size within param field :

+    param field [field pointer].access .

+ 

+same type fields :

+    field pointer INCR 1 ;

+    CONCR (pt type) INCR 1 ;

+    REP

+        IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ;

+        IF type of actual field = end 

+             THEN LEAVE same type fields WITH TRUE 

+        FI ; 

+        NEXTPARAM field pointer

+    UNTIL end of field PER ;

+    FALSE .

+

+end of field :

+    field pointer > size of param field .

+

+type of actual field :

+    CONCR (param field [field pointer].type) .

+ENDPROC equal types ;

+

+BOOL PROC is not void bool or undefined (DTYPE CONST dtype) :

+    type <> void AND type <> bool AND type <> undefined .

+

+type : CONCR (dtype)

+ENDPROC is not void bool or undefined ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  8. Operationen  Teil II                   07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition der Opcodes                                               *) 

+(*   Deklaration, Definition, Identifikation und Applikation              *) 

+(*   Eroeffnen und Schliessen eines Moduls                                *)

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+LET module not opened  = "Module not opened" , 

+    define missing     = "DEFINE missing" ,

+    wrong nr of params = "Wrong Nr. of Params:" , 

+    illegal kind       = "Opcode expected" ,

+    nested module      = "Nested Modules" ,

+    no mod nr          = "Param Proc expected" ,

+    no immediate value = "Value expected" ,

+    type error         = "Type Error" ,

+ 

+    q ln              =  1 ,

+    q move            =  2 ,    q move code             =  2 048 ,

+    q inc1            =  3 ,    q inc1 code             =  3 072 ,

+    q dec1            =  4 ,    q dec1 code             =  4 096 ,

+    q inc             =  5 ,    q inc code              =  5 120 ,

+    q dec             =  6 ,    q dec code              =  6 144 ,

+    q add             =  7 ,    q add code              =  7 168 ,

+    q sub             =  8 ,    q sub code              =  8 192 ,

+    q clear           =  9 ,    q clear code            =  9 216 ,

+    q test            = 10 , 

+    q equ             = 11 ,    q equ code              = 11 264 , 

+    q lsequ           = 12 ,    q lsequ code            = 12 288 , 

+    q fmove           = 13 ,    q fmove code            = 13 312 , 

+    q fadd            = 14 ,    q fadd code             = 14 336 , 

+    q fsub            = 15 ,    q fsub code             = 15 360 , 

+    q fmult           = 16 ,    q fmult code            = 16 384 , 

+    q fdiv            = 17 ,    q fdiv code             = 17 408 ,

+    q flsequ          = 18 ,    q flsequ code           = 18 432 ,

+    q tmove           = 19 ,    q tmove code            = 19 456 ,

+    q tequ            = 20 ,    q tequ code             = 20 480 , 

+    q accds           = 21 ,    q access ds code        = 22 528 , 

+    q ref             = 22 ,    q ref code              = 23 552 ,

+    q subscript       = 23 ,    q subscript code        = 24 576 , 

+    q select          = 24 ,    q select code           = 25 600 ,

+    q ppv             = 25 , 

+    q pp              = 26 , 

+    q make false      = 27 , (* q make false code       = 65 513 *)

+    q movex           = 28 ,

+(*  q longa subs                q longa subs code       = 65 376 *) 

+    q return          = 29 ,    q return code           = 32 512 ,

+    q true return     = 30 ,    q true return code      = 32 513 ,

+    q false return    = 31 ,    q false return code     = 32 514 ,

+                                q goret code            = 32 519 ,

+    q esc mult        = 32 ,    q esc mult code         = 32 553 ,

+    q esc div         = 33 ,    q esc div code          = 32 554 , 

+    q esc mod         = 34 ,    q esc mod code          = 32 555 , 

+    q pproc           = 35 , 

+    q compl int       = 36 ,    q compl int code        = 32 551 ,

+    q compl real      = 37 ,    q compl real code       = 32 550 ,

+(*  q alias ds        = 38 , *) 

+    q movim           = 39 ,    q esc movim code        = 32 547 ,

+    q fequ            = 40 ,    q fequ code             = 32 548 ,

+    q tlsequ          = 41 ,    q tlsequ code           = 32 549 ,

+(*  q case            = 42 , *)

+    q plus            = 43 ,

+    q minus           = 44 ,

+    q mult            = 45 ,

+    q int div         = 46 ,

+    q real div        = 47 ,

+    q equal           = 48 ,

+    q lessequal       = 49 ;

+ 

+INT CONST q make false code :: - 1 022 , 

+          q longa subs code :: -   159 ;

+ 

+

+                   (***** Deklaration *****) 

+ 

+PROC declare (OPN VAR operation) : 

+    operation.kind := proc op ;

+    get module nr (operation.mod nr) ; 

+    operation.top of stack := 0 

+ENDPROC declare ; 

+ 

+PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : 

+    declare (operation) ;

+    entry into name and pt table if necessary ; 

+    enter params ; 

+    enter result ; 

+    enter module number . 

+ 

+entry into name and pt table if necessary : 

+    declare object (name, nt link, permanent pointer) . 

+ 

+enter params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO params REP

+       enter param (param field [field pointer]) ;

+       NEXTPARAM field pointer 

+    PER .

+ 

+enter result : 

+    enter param (param field[field pointer].type, permanent proc op) .

+ 

+enter module number : 

+    put next permanent (operation.mod nr)

+ENDPROC declare ; 

+ 

+PROC enter param (PARAMDESCRIPTOR CONST param) :

+    IF   param.access = const 

+         THEN enter param (param.type, permanent param const)

+    ELIF param.access = var 

+         THEN enter param (param.type, permanent param var)

+    ELSE errorstop ("Unknown Access")

+    FI

+ENDPROC enter param ;

+

+PROC enter param (DTYPE CONST type, INT CONST permanent mode) :

+    SELECT type class (type) OF

+        CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode)

+        OTHERWISE      errorstop ("Illegal Type")

+    ENDSELECT

+ENDPROC enter param ;

+

+

+                    (***** Definition *****) 

+ 

+PROC define (OPN VAR opn) : 

+    IF NOT module open THEN errorstop (module not opened)

+                       ELSE proc head (opn.mod nr, opn.top of stack)

+    FI 

+ENDPROC define ; 

+ 

+PROC set length of local storage (OPN VAR opn, INT CONST size) :

+    IF   size < 0 OR size > local address limit

+         THEN errorstop (address overflow)

+    ELIF opn.top of stack = 0

+         THEN errorstop (define missing)

+    ELIF opn.kind <> proc op

+         THEN errorstop (proc op expected)

+    FI ;

+    set length (opn.top of stack, size + eumel0 stack offset)

+ENDPROC set length of local storage ; 

+ 

+PROC define (OPN VAR operation, INT CONST size) : 

+    define (operation) ; 

+    set length of local storage (operation, size)

+ENDPROC define ; 

+ 

+ 

+                 (***** Identifikation *****) 

+ 

+INT VAR counter, result index, result type repr;

+ 

+PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation,

+               BOOL VAR object exists) :

+    find result entry ; 

+    to object (name) ;

+    IF found  THEN first fit and leave if found FI ; 

+    IF eumel0 THEN identify eumel0 instruction 

+              ELSE yield undefined operation 

+    FI .

+ 

+find result entry : 

+    result index := first; 

+    counter := 0 ;

+    WHILE counter < params REP 

+        NEXTPARAM result index ; 

+        counter INCR 1

+    PER ;

+    check on param field exceeded .

+

+check on param field exceeded :

+    IF result index > size of param field

+       THEN errorstop (param field exceeded) 

+    FI .

+ 

+yield undefined operation :

+    declare (result index, undefined type) ;

+    apply (result index, nop) ;

+    object exists := FALSE .

+ 

+first fit and leave if found :

+    WHILE yet another procedure exists REP 

+        check one procedure and leave if match ; 

+        next procedure 

+    PER . 

+ 

+yet another procedure exists : 

+    permanent pointer <> 0 . 

+ 

+check one procedure and leave if match: 

+    param link := permanent pointer + wordlength ; 

+    set end marker if end of list ;

+    counter := params ; 

+    field pointer := 1 ;

+    REP

+       IF   end of params AND counter = 0 

+            THEN procedure found

+       ELIF end of params OR  counter = 0 

+            THEN LEAVE check one procedure and leave if match 

+            ELSE check next param 

+       FI 

+   PER . 

+ 

+check next param : 

+    get type and mode (CONCR(pt type)) ;

+    IF same types THEN set param mode ; 

+                       counter DECR 1 ; 

+                       field pointer INCR 1 ;

+                       next pt param

+                  ELSE LEAVE check one procedure and leave if match 

+    FI . 

+ 

+same types : (* inline version ! *)

+    equal types .

+ 

+set param mode : 

+    param field [field pointer].access := mode . 

+ 

+procedure found : 

+    get result ; 

+    operation.kind   := proc op ; 

+    operation.mod nr := module number ; 

+    operation.top of stack := 0 ;

+    object exists := TRUE ;

+    LEAVE identify . 

+ 

+get result : 

+    get type and mode (result type) ; 

+    declare (result index, mode) .

+ 

+module number :

+    cdbint (param link + 1) . 

+

+result type :

+    CONCR (param field [result index].type) .

+ 

+eumel0 : 

+    eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; 

+    eumel0 opn.mod nr <> 0 .

+ 

+identify eumel 0 instruction : 

+    init result type with void ; 

+    CONCR (operation) := CONCR (eumel0 opn) ;

+    object exists := check params and set result ;

+    declare (result index, DTYPE:(result type repr)) ;

+    declare (result index, const) .

+

+init result type with void :

+    result type repr := void . 

+ 

+check params and set result :

+    SELECT operation.mod nr OF

+       CASE q return, q false return, q true return : no params 

+       CASE q inc1, q dec1          : one int param yielding void 

+       CASE q pproc, q pp, q ln     : one param yielding void

+       CASE q test                  : one param yielding bool

+       CASE q clear, q ppv          : one int or bool param yielding void 

+       CASE q make false            : one bool param yielding void 

+       CASE q move                  : two int or bool params yielding void 

+       CASE q compl int, q inc, q dec : two int params yielding void

+       CASE q compl real, q fmove   : two real params yielding void 

+       CASE q equ, q lsequ          : two int params yielding bool 

+       CASE q fequ, q flsequ        : two real params yielding bool 

+       CASE q tequ, q tlsequ        : two text params yielding bool

+       CASE q tmove                 : two text params yielding void

+       CASE q accds, q ref          : two params yielding void

+       CASE q add, q sub, q esc mult,

+            q esc div, q esc mod    : three int params yielding void

+       CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void

+       CASE q select, q movex       : three params 

+       CASE q subscript             : five params 

+       CASE q plus, q minus, q mult : two intreals yielding intreal

+       CASE q int div               : two int params yielding int 

+       CASE q real div              : two real params yielding real

+       CASE q equal, q lessequal    : two intrealtexts yielding bool

+       OTHERWISE                      FALSE

+    ENDSELECT .

+ 

+no params : 

+    params = 0 . 

+

+one int param yielding void : 

+    p1 void (int type, first, params) .

+

+one param yielding void :

+    params = 1 . 

+

+one param yielding bool :

+    IF params = 1 THEN result type repr := bool ; 

+                       TRUE 

+                  ELSE FALSE

+    FI .

+ 

+one int or bool param yielding void :

+    p1 void (int type, first, params) OR p1 void (bool type, first, params) . 

+

+one bool param yielding void :

+    p1 void (bool type, first, params) . 

+ 

+two int or bool params yielding void : 

+    p2 (int  type, first, params, void) OR

+    p2 (bool type, first, params, void) .

+

+two int params yielding void :

+    p2 (int type, first, params, void) .

+

+two real params yielding void :

+    p2 (real type, first, params, void) .

+

+two text params yielding void :

+    p2 (text type, first, params, void) .

+

+two int params yielding bool :

+    p2 (int type, first, params, bool) .

+

+two real params yielding bool :

+    p2 (real type, first, params, bool) .

+

+two text params yielding bool :

+    p2 (text type, first, params, bool) .

+

+two params yielding void :

+    params = 2 . 

+

+three int params yielding void :

+    p3 void (int type, first, params) .

+

+three real params yielding void :

+    p3 void (real type, first, params) .

+

+three params :

+    params = 3 .

+

+five params : 

+    params = 5 . 

+

+two intreals yielding intreal :

+    two int params yielding int OR two real params yielding real .

+

+two intrealtexts yielding bool :

+    two int params yielding bool OR two real params yielding bool OR

+    two text params yielding bool .

+

+two int params yielding int :

+    p2 (int type, first, params, int) .

+

+two real params yielding real :

+    p2 (real type, first, params, real)

+ENDPROC identify ; 

+ 

+BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 1 AND param type is requested plain type . 

+ 

+param type is requested plain type :

+    CONCR (param field [first].type) = CONCR (requested type) 

+ 

+ENDPROC p1 void ;

+ 

+BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr,

+              INT CONST result type) :

+    IF param nr = 2 AND param types equal requested plain type

+       THEN result type repr := result type ;

+            TRUE

+       ELSE FALSE

+    FI .

+ 

+param types equal requested plain type :

+    CONCR (param field [first]  .type) = CONCR (requested type) AND 

+    CONCR (param field [first+1].type) = CONCR (requested type)

+

+ENDPROC p2 ;

+ 

+BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 3 AND param types ok .

+ 

+param types ok :

+    FOR index FROM first UPTO first+2 REP

+       IF different param types THEN LEAVE p3 void WITH FALSE FI 

+    PER ;

+    TRUE .

+ 

+different param types :

+    CONCR (param field [index].type) <> CONCR (requested type)

+ENDPROC p3 void; 

+

+

+                   (***** Applikation *****) 

+ 

+INT VAR address representation, left repr, right repr, result repr;

+

+PROC apply (INT CONST first, nr of params, OPN CONST opn) : 

+    IF NOT module open THEN errorstop (module not opened) FI ;

+    SELECT opn.kind OF 

+        CASE eumel 0    : generate eumel0 instruction 

+        CASE proc op    : call operation 

+        CASE param proc : call param proc

+        CASE nil        :

+        OTHERWISE         errorstop (illegal kind) 

+    ENDSELECT .

+ 

+call operation :

+    push params if necessary (first, nr of params, opn.mod nr) ; 

+    call (opn.mod nr) .

+ 

+call param proc : 

+    result addr.kind := local ref ;

+    result addr.value := opn.mod nr ;

+    address representation := REPR result addr ;

+    push params if necessary (first, nr of params, address representation) ;

+    call param (address representation) .

+

+generate eumel0 instruction : 

+    SELECT real nr of params OF 

+        CASE 0 : p0 instruction 

+        CASE 1 : apply p1 (opn, first addr) 

+        CASE 2 : apply p2 (opn, first addr, second addr)

+        CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) 

+        CASE 5 : subscript operation

+        OTHERWISE errorstop (wrong nr of params + text (nr of params)) 

+    ENDSELECT . 

+ 

+real nr of params :

+    IF operator denotation THEN nr of params + 1

+                           ELSE nr of params

+    FI .

+

+operator denotation :

+    opn.mod nr >= q plus .

+

+p0 instruction :

+    IF   opn.mod nr = q return       THEN s0 (q return code) 

+    ELIF opn.mod nr = q true return  THEN s0 (q true return code)

+    ELIF opn.mod nr = q false return THEN s0 (q false return code)

+                                     ELSE errorstop (wrong nr of params +

+                                                     mnemonic (opn)) 

+    FI .

+ 

+subscript operation :

+    IF opn.mod nr = q subscript 

+       THEN subscription

+       ELSE errorstop (wrong nr of params + text (nr of params))

+    FI .

+

+subscription :

+    ADDRESS CONST element length :: param field [first+2].addr ,

+                  limit          :: param field [first+3].addr ;

+    check on immediates ;

+    IF element length.value < 1024

+       THEN s0 (q subscript code + element length.value)

+       ELSE s0 (q longa subs code) ;

+            s0 (element length.value)

+    FI ;

+    s3 (limit.value - 1, subs index, base addr, subs result) .

+

+check on immediates :

+    IF element length.kind <> immediate value OR

+       limit.kind <> immediate value

+       THEN errorstop (no immediate value)

+    FI .

+

+subs index  : REPR param field [first+1].addr .

+

+base addr   : REPR param field [first].addr .

+

+subs result : REPR param field [first+4].addr .

+

+first addr : 

+    param field [first].addr .

+ 

+left type :

+    param field [first].type .

+

+second addr : 

+    param field [nextparam (first)].addr .

+ 

+third addr : 

+    param field [nextparam(nextparam(first))].addr

+ENDPROC apply ;

+ 

+PROC push params if necessary (INT CONST first, nr of params, mod nr) : 

+    init param push (mod nr) ;

+    IF nr of params > 0 THEN push params ;

+                             push result if there is one 

+    FI . 

+ 

+push params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO nr of params REP 

+        apply p1 (push code, param addr) ; 

+        NEXTPARAM field pointer

+    PER . 

+ 

+push code : 

+    param field [field pointer].push opn . 

+ 

+param addr :

+    param field [field pointer].addr . 

+ 

+push result if there is one : 

+    IF push result necessary 

+       THEN push result address (REPR param field [field pointer].addr)

+    FI . 

+

+push result necessary :

+    param field [field pointer].push opn.kind <> nil AND 

+    is not void bool or undefined (param field [field pointer].type) 

+ENDPROC push params if necessary ;

+

+PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : 

+    IF   opn.mod nr = q ln    THEN generate line number 

+    ELIF opn.mod nr = q pproc THEN push module nr

+                              ELSE gen p1 instruction

+    FI .

+

+gen p1 instruction : 

+    address representation := REPR addr ;

+    SELECT opn.mod nr OF 

+        CASE q inc1  : t1 (q inc1 code, address representation)

+        CASE q dec1  : t1 (q dec1 code, address representation)

+        CASE q clear : t1 (q clear code,address representation)

+        CASE q test  : test bool object (address representation)

+        CASE q pp    : push param (address representation)

+        CASE q make false : s1 (q make false code, address representation)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+

+generate line number :

+    IF addr.kind = immediate value THEN mark line (addr.value)

+                                   ELSE errorstop (no immediate value)

+    FI .

+

+push module nr : 

+    IF addr.kind = module nr THEN push param proc (addr.value)

+                             ELSE errorstop (no mod nr)

+    FI

+ENDPROC apply p1; 

+ 

+PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): 

+    left repr := REPR left addr ;

+    IF opn.mod nr = q movim THEN move immediate

+                            ELSE gen p2 instruction 

+    FI . 

+ 

+gen p2 instruction : 

+    right repr := REPR right addr ;

+    SELECT opn.mod nr OF 

+        CASE q move       : t2 (q move code, right repr, left repr)

+        CASE q inc        : t2 (q inc code, right repr, left repr) 

+        CASE q dec        : t2 (q dec code, right repr, left repr) 

+        CASE q equ        : compare (q equ code, left repr, right repr) 

+        CASE q lsequ      : compare (q lsequ code, left repr, right repr) 

+        CASE q fmove      : t2 (q fmove code, right repr, left repr)

+        CASE q flsequ     : compare (q flsequ code, left repr, right repr) 

+        CASE q tmove      : t2 (q tmove code, right repr, left repr)

+        CASE q tequ       : compare (q tequ code, left repr, right repr) 

+        CASE q compl int  : s2 (q compl int code, left repr, right repr)

+        CASE q compl real : s2 (q compl real code, left repr, right repr)

+        CASE q fequ       : compare (q fequ code, left repr, right repr) 

+        CASE q tlsequ     : compare (q tlsequ code, left repr, right repr) 

+        CASE q accds      : t2 (q access ds code, left repr, right repr)

+        CASE q ref        : t2 (q ref code, left repr, right repr) 

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+ 

+move immediate :

+    IF right addr.kind = immediate value 

+       THEN s0 (q esc movim code) ;

+            s1 (left repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI

+ENDPROC apply p2; 

+ 

+PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, 

+               ADDRESS CONST left addr, right addr, result addr ):

+    left repr   := REPR left addr ; 

+    result repr := REPR result addr ;

+    IF   opn.mod nr = q select THEN gen select instruction

+    ELIF opn.mod nr = q movex  THEN gen long move

+                               ELSE gen p3 instruction

+    FI .

+

+gen p3 instruction :

+    right repr  := REPR right addr ; 

+    SELECT opn.mod nr OF 

+        CASE q add                : int add

+        CASE q sub                : int sub

+        CASE q fadd               : real add 

+        CASE q fsub               : real sub 

+        CASE q fmult              : real mult 

+        CASE q fdiv, q real div   : real div 

+        CASE q esc mult           : int mult 

+        CASE q esc div, q int div : int div 

+        CASE q esc mod            : int mod 

+        CASE q plus               : int real add

+        CASE q minus              : int real sub

+        CASE q mult               : int real mult

+        CASE q equal, q lessequal : compare (comp code, left repr, right repr)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT . 

+ 

+gen select instruction :

+    IF right addr.kind = immediate value 

+       THEN t1 (q select code, left repr) ;

+            s1 (right addr.value, result repr)

+       ELSE errorstop (no immediate value)

+    FI .

+

+gen long move :

+    IF right addr.kind = immediate value

+       THEN long move (left repr, result repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI .

+

+int add   : compute (q add code, left repr, right repr, result repr) . 

+ 

+int sub   : compute (q sub code, left repr, right repr, result repr) . 

+ 

+real add  : compute (q fadd code, left repr, right repr, result repr) . 

+ 

+real sub  : compute (q fsub code, left repr, right repr, result repr) . 

+ 

+real mult : compute (q fmult code, left repr, right repr, result repr) . 

+ 

+real div  : compute (q fdiv code, left repr, right repr, result repr) . 

+ 

+int mult  : s3 (q esc mult code, left repr, right repr, result repr) . 

+ 

+int div   : s3 (q esc div code, left repr, right repr, result repr) . 

+ 

+int mod   : s3 (q esc mod code, left repr, right repr, result repr) .

+ 

+int real add : 

+    IF left type = int THEN int add

+                       ELSE real add

+    FI . 

+ 

+int real sub :

+    IF left type = int THEN int sub 

+                       ELSE real sub

+    FI .

+

+int real mult :

+    IF left type = int THEN int mult

+                       ELSE real mult

+    FI . 

+

+comp code : 

+    SELECT left type OF

+        CASE int    : IF opn.mod nr = q equal THEN q equ  ELSE q lsequ  FI 

+        CASE real   : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI

+        CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI

+        OTHERWISE errorstop (type error); q equ

+    ENDSELECT .

+

+left type : CONCR (left dtype)

+

+ENDPROC apply p3; 

+ 

+

+                      (***** Modul *****) 

+ 

+BOOL VAR module open ;

+

+.init opn section : 

+    module open := FALSE .;

+

+PROC begin module : 

+    IF module open THEN errorstop (nested module) 

+                   ELSE begin modul ; 

+                        module open := TRUE 

+    FI 

+ENDPROC begin module ; 

+ 

+PROC end module : 

+    IF NOT module open

+       THEN errorstop (module not opened) 

+       ELSE end modul ;

+            module open := FALSE

+    FI

+ENDPROC end module ; 

+

+TEXT PROC dump (OPN CONST operation) : 

+    IF   operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) 

+    ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation)

+                                  ELSE " undef. Opn" 

+    FI 

+ENDPROC dump ; 

+ 

+PROC begin modul :

+    EXTERNAL 10071

+ENDPROC begin modul ; 

+ 

+PROC end modul :

+    EXTERNAL 10011

+ENDPROC end modul ; 

+ 

+PROC proc head (INT VAR mod nr, top of stack) :

+    EXTERNAL 10012

+ENDPROC proc head ; 

+ 

+PROC set length (INT CONST top of stack, size) : 

+    EXTERNAL 10013

+ENDPROC set length ; 

+ 

+PROC get module nr (INT VAR module nr) : 

+    EXTERNAL 10016

+ENDPROC get module nr ; 

+ 

+PROC compute (INT CONST op code, l addr, r addr, result address) :

+    EXTERNAL 10017

+ENDPROC compute ; 

+ 

+PROC compare (INT CONST op code, l addr, r addr) :

+    EXTERNAL 10018

+ENDPROC compare ; 

+ 

+PROC long move (INT CONST to, from, length) :

+    EXTERNAL 10019

+ENDPROC long move ;

+

+PROC put next permanent (INT CONST permanent value) : 

+    EXTERNAL 10020

+ENDPROC put next permanent ; 

+ 

+PROC call (INT CONST mod nr) : 

+    EXTERNAL 10022

+ENDPROC call ; 

+ 

+PROC call param (INT CONST mod nr) : 

+    EXTERNAL 10023

+ENDPROC call param ; 

+ 

+PROC push param (INT CONST addr) : 

+    EXTERNAL 10024

+ENDPROC push param ; 

+ 

+PROC push param proc (INT CONST mod nr) : 

+    EXTERNAL 10025

+ENDPROC push param proc ; 

+ 

+PROC init param push (INT CONST mod nr) : 

+    EXTERNAL 10026

+ENDPROC init param push ; 

+ 

+PROC push result address (INT CONST addr) : 

+    EXTERNAL 10027

+ENDPROC push result address ; 

+ 

+PROC test bool object (INT CONST addr) : 

+    EXTERNAL 10186

+ENDPROC test bool object ; 

+ 

+PROC mark line (INT CONST line number) : 

+    EXTERNAL 10030

+ENDPROC mark line ; 

+ 

+PROC s0 (INT CONST op code) : 

+    EXTERNAL 10038

+ENDPROC s0 ; 

+ 

+PROC s1 (INT CONST op code, addr) : 

+    EXTERNAL 10039

+ENDPROC s1 ; 

+ 

+PROC s2 (INT CONST op code , addr1, addr2) : 

+    EXTERNAL 10040

+ENDPROC s2 ; 

+ 

+PROC s3 (INT CONST op code, addr1, addr2, addr3) : 

+    EXTERNAL 10041

+ENDPROC s3 ; 

+ 

+PROC t1 (INT CONST op code, addr) : 

+    EXTERNAL 10042

+ENDPROC t1 ; 

+ 

+PROC t2 (INT CONST op code, addr1, addr2) : 

+    EXTERNAL 10043

+ENDPROC t2 ; 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  9. Speicherverwaltung                     21.03.1986  *) 

+(*                                                                        *) 

+(*   Ablage der Paketdaten                                                *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR address value;

+ 

+INT CONST data allocation by coder  := 1 , 

+          data allocation by user   := 2 ; 

+

+LET not initialized      = 0 ,

+    wrong mm mode        = "Wrong MM Mode" ,

+    define on non global = "Define for GLOB only" ,

+    text too long        = "TEXT too long" ;

+ 

+TEXT VAR const buffer :: point line ;

+

+.reset memory management mode :

+     memory management mode := not initialized . ;

+ 

+PROC reserve storage (INT CONST size) : 

+    IF memory management mode <> data allocation by user 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (address value, size) ; 

+    memory management mode := not initialized

+ENDPROC reserve storage ; 

+ 

+PROC allocate variable (ADDRESS VAR addr, INT CONST size) : 

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (addr.value, size) ;

+    addr.kind := global

+ENDPROC allocate variable ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, INT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate int denoter (addr.value) ;

+    put data word (value, addr.value) ;

+    addr.kind := global

+ENDPROC allocate denoter ; 

+

+PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate real denoter (addr.value) ;

+    addr.kind := global ;

+    define (addr, value)

+ENDPROC allocate denoter ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; 

+    addr.kind := global ;

+    skip heaplink; 

+    define (addr, value) ; 

+    reset heaplink .

+ 

+skip heaplink : 

+    addr.value INCR 1 .

+

+reset heaplink :

+    addr.value DECR 1

+ENDPROC allocate denoter ; 

+ 

+PROC define (ADDRESS CONST addr, INT CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    put data word (value, addr.value) 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, REAL CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    replace (const buffer, 1, value) ; 

+    address value := addr.value ;

+    FOR index FROM 1 UPTO 4 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, TEXT CONST value) : 

+    IF   addr.kind <> global THEN errorstop (define on non global) 

+    ELIF LENGTH value > 255  THEN errorstop (text too long)

+    FI ; 

+    address value := addr.value ;

+    const buffer := code (LENGTH value) ; 

+    const buffer CAT value ; 

+    const buffer CAT " " ;

+    FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER ; 

+    const buffer := point line

+ENDPROC define ; 

+ 

+PROC prep pbase (INT VAR offset) : 

+    EXTERNAL 10032 

+ENDPROC prep pbase; 

+ 

+PROC allocate var (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10033

+ENDPROC allocate var ; 

+ 

+PROC allocate int denoter (INT VAR addr) : 

+    EXTERNAL 10034

+ENDPROC allocate int denoter ;

+ 

+PROC allocate real denoter (INT VAR addr) : 

+    EXTERNAL 10035 

+ENDPROC allocate real denoter ;

+

+PROC allocate text denoter (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10036 

+ENDPROC allocate text denoter ;

+ 

+PROC put data word (INT CONST value, INT CONST addr) :

+    EXTERNAL 10037

+ENDPROC put data word ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 10. Inspector                              08.01.1986  *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+TEXT VAR type and mode ;

+ 

+TEXT PROC type name (DTYPE CONST type) : 

+    type and mode := "" ; 

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC type name ; 

+ 

+TEXT PROC dump (DTYPE CONST type) :

+    type and mode := "TYPE " ;

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC dump ;

+

+PROC name of type (INT CONST type) :

+            SELECT type OF

+     CASE void              :

+     CASE int               : type and mode CAT "INT"

+     CASE real              : type and mode CAT "REAL"

+     CASE string            : type and mode CAT "TEXT"

+     CASE bool, bool result : type and mode CAT "BOOL"

+     CASE dataspace         : type and mode CAT "DATASPACE"

+     OTHERWISE              : complex type

+            ENDSELECT .

+

+complex type :

+     IF type > ptt limit THEN perhaps permanent struct or row

+                         ELSE get complex type

+     FI .

+

+perhaps permanent struct or row :

+     index := type + begin of pt minus ptt limit ;

+     mode := cdb int (index) MOD ptt limit ;

+     IF   mode = permanent row    THEN get permanent row 

+     ELIF mode = permanent struct THEN get permanent struct

+                                  ELSE type and mode CAT "-"

+     FI .

+

+get complex type :

+     index := type + begin of permanent table ;

+     IF is complex type THEN get name

+                        ELSE type and mode CAT "-"

+     FI .

+

+is complex type :

+     permanent type definition mode = permanent type .

+

+get name :

+     type and mode CAT cdb text (link to type name + two word length) .

+

+link to type name :

+     cdb int (index + three word length) .

+

+permanent type definition mode :

+     cdb int (index + wordlength) .

+

+get permanent row :

+     INT VAR t; 

+     type and mode CAT "ROW " ;

+     type and mode CAT text (cdb int (index + wordlength)) ;

+     type and mode CAT " " ;

+     param link := index + two wordlength ;

+     get type and mode (t) ;

+     name of type (t) .

+ 

+get permanent struct :

+     type and mode CAT "STRUCT ( ... )" 

+ENDPROC name of type ;

+

+ENDPACKET eumel coder ; 

diff --git a/system/eumel-coder/1.8.0/src/eumel0 codes b/system/eumel-coder/1.8.0/src/eumel0 codes
new file mode 100644
index 0000000..428f71e
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel0 codes
@@ -0,0 +1,50 @@
+LN 

+MOVE 

+INC1 

+DEC1 

+INC 

+DEC 

+ADD 

+SUB 

+CLEAR 

+TEST 

+EQU 

+LSEQU 

+FMOVE 

+FADD 

+FSUB 

+FMULT 

+FDIV 

+FLSEQU 

+TMOVE 

+TEQU 

+ACCDS 

+REF 

+SUBSCRIPT 

+SELECT 

+PPV 

+PP 

+MAKE_FALSE 

+MOVEX 

+RETURN 

+TRUE_RETURN 

+FALSE_RETURN 

+ESC_MULT 

+ESC_DIV 

+ESC_MOD 

+PPROC 

+COMPL_INT 

+COMPL_REAL 

+ALIAS_DS 

+MOVIM 

+FEQU 

+TLSEQU 

+CASE 

++ 

+- 

+* 

+DIV 

+/ 

+= 

+<= 

+

diff --git a/system/eumel-coder/1.8.1/source-disk b/system/eumel-coder/1.8.1/source-disk
new file mode 100644
index 0000000..972580b
--- /dev/null
+++ b/system/eumel-coder/1.8.1/source-disk
@@ -0,0 +1 @@
+debug/eumel-coder-1.8.1.img
diff --git a/basic/eumel coder 1.8.1 b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1
index 0047067..0047067 100644
--- a/basic/eumel coder 1.8.1
+++ b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1
diff --git a/system/eumel0-z80/data/EUMEL0.DS b/system/eumel0-z80/data/EUMEL0.DS
new file mode 100644
index 0000000..8b53d98
--- /dev/null
+++ b/system/eumel0-z80/data/EUMEL0.DS
diff --git a/system/eumel0-z80/src/DISEUMEL.ELA b/system/eumel0-z80/src/DISEUMEL.ELA
new file mode 100644
index 0000000..b1039dc
--- /dev/null
+++ b/system/eumel0-z80/src/DISEUMEL.ELA
@@ -0,0 +1,607 @@
+PROC arith 16 : 

+ 

+ EXTERNAL 92

+ 

+ENDPROC arith 16 ; 

+ 

+BOOL OP ULSEQ (INT CONST left, right) : 

+ 

+ (left MINUS right) <= 0

+ 

+ENDOP ULSEQ ; 

+ 

+LET max words minus 1 = 32767 ; (* = max : 64K *) 

+ 

+TEXT VAR source name , instr, parameter , t ; 

+INT VAR addr , start addr, end addr , file nr , laenge, i , offset ;

+FILE VAR source file ; 

+

+BOUND STRUCT (ALIGN align, ROW max words minus 1 INT word) VAR space ; 

+

+TEXT VAR a, b, c;

+BOOL VAR screen mode := yes ("Bildschirmausgabe zusaetzlich") ; 

+put ("Startaddr:") ; 

+getline (a) ; 

+put ("Endaddr  :") ; 

+getline (b) ; 

+put ("Offset   :") ; 

+getline (c) ;

+resource ("eumel0", "eumel0.prt", a, b, c) ;

+edit ("eumel0.prt") ; 

+ 

+ 

+PROC resource (TEXT CONST code space name, source file name, 

+               TEXT CONST from, to, offs) : 

+ 

+ space := old (code space name) ; 

+ start addr := integer (from) ;

+ end addr   := integer (to) ; 

+ offset     := integer (offs) ; 

+ source name := source file name ; 

+ file nr := 1 ; 

+ forget (source name, quiet) ; 

+ source file := sequential file (output, source name) ; 

+ 

+ source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT") ; 

+ put tabs (source file, 40 * ""2"" + "^") ; 

+ addr := start addr ; 

+ line ; 

+ WHILE addr ULSEQ end addr REP 

+  IF online THEN out (hex16 (addr)) ; 

+                 out (""13"") ; 

+  FI ; 

+  source put (hex16 (addr)) ; 

+  disass ; 

+  FOR i FROM 1 UPTO laenge REP 

+   source put (hex8 (zugriff (addr PLUS (i-1)))) 

+  PER ; 

+  FOR i FROM laenge UPTO 3 REP

+   source put ("  ") 

+  PER ; 

+  t := "" ; 

+  FOR i FROM 1 UPTO laenge REP 

+   t CAT ascii (zugriff (addr PLUS (i-1))) 

+  PER ; 

+  source put (t, 5) ; 

+  source put (instr, 5) ; 

+  source put (parameter, 10) ; 

+  source line ; 

+  addr := addr PLUS laenge ; 

+ PER ; 

+ENDPROC resource ; 

+ 

+INT OP PLUS (INT CONST left, right) : 

+ arith16 ;

+ left + right  

+ENDOP PLUS ; 

+ 

+INT OP MINUS (INT CONST left, right) : 

+ arith16 ; 

+ left - right 

+ENDOP MINUS ; 

+ 

+PROC source line : 

+ check file overflow ; 

+ line (source file) ; 

+ IF screen mode AND online THEN line FI 

+ENDPROC source line ; 

+ 

+PROC source put (TEXT CONST text) : 

+ put (source file, text) ; 

+ IF screen mode AND online THEN put (text) FI

+ENDPROC source put ; 

+ 

+PROC source out (TEXT CONST text) : 

+ write (source file, text) ; 

+ IF screen mode AND online THEN write (text) FI

+ENDPROC source out ; 

+ 

+PROC source putline (TEXT CONST text) : 

+ check file overflow ;

+ putline (source file, text) ; 

+ IF screen mode AND online THEN putline (text) FI

+ENDPROC source putline ; 

+ 

+PROC source put (TEXT CONST text, INT CONST laenge) : 

+ source put (text + (laenge - length (text)) * " ") ; 

+ENDPROC source put ; 

+ 

+PROC check file overflow : 

+ TEXT VAR new name ; 

+ IF lines (source file) > 4000 THEN 

+    file nr INCR 1 ; 

+    new name := source name + "." + text (file nr) ; 

+    line (source file) ; 

+    putline (source file," - Fortsetzung in Datei """ + new name + """ -"); 

+    IF screen mode AND online THEN putline ("New FILE:" + new name) FI ; 

+    modify (source file) ; 

+    to first record (source file) ; 

+    forget (new name, quiet) ; 

+    source file := sequentialfile (output, new name) ; 

+    source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; 

+    put tabs (source file, 40 * ""2"" + "^") 

+ FI 

+ENDPROC check file overflow ; 

+ 

+TEXT PROC hex16 (INT CONST nr) : 

+ INT VAR i, var := nr ;

+ TEXT VAR result := "" ;

+ FOR i FROM 1 UPTO 4 REP

+  rotate (var, 4) ; 

+  result CAT hex4 (var AND 15) 

+ PER ; 

+ result 

+ENDPROC hex16 ; 

+ 

+TEXT PROC hex8 (INT CONST nr) : 

+ hex4 (nr DIV 16) + hex4 (nr AND 15) 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex4 (INT CONST nr) : 

+ "0123456789ABCDEF" SUB (nr+1)

+ENDPROC hex4 ; 

+ 

+TEXT PROC ascii (INT CONST nr) : 

+ IF nr < 32 OR nr > 126 THEN "." 

+ ELSE code (nr) 

+ FI 

+ENDPROC ascii ; 

+ 

+INT PROC zugriff (INT CONST adr) : 

+ TEXT VAR t := "  " ; 

+ INT VAR index := offset PLUS adr MINUS startaddr ;

+ rotate (index, -1) ; (* Signed DIV 2 *)

+ index := index AND maxint ;

+ BOOL CONST low byte :: ((adr MINUS start addr) AND 1) = 0 ; 

+ replace (t, 1, space.word (index PLUS 1)) ;

+ IF low byte THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC zugriff ; 

+ 

+INT PROC integer (TEXT CONST hex addr) : 

+ INT VAR i, summe := 0 ; 

+ FOR i FROM 1 UPTO length (hex addr) REP 

+  rotate (summe, 4) ; 

+  summe INCR digit

+ PER ; 

+ summe . 

+ 

+digit : 

+ TEXT CONST char := hex addr SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ENDPROC integer ; 

+ 

+INT VAR byte, 

+        div 8, 

+        and 7, 

+        and f, 

+        div 10, 

+        int addr ; 

+ 

+TEXT VAR index, c byte ; 

+ 

+TEXT PROC arith log :

+    SELECT div 8 OF 

+       CASE 0 : "ADD" 

+       CASE 1 : "ADC" 

+       CASE 2 : "SUB" 

+       CASE 3 : "SBC" 

+       CASE 4 : "AND" 

+       CASE 5 : "XOR" 

+       CASE 6 : "OR" 

+       CASE 7 : "CP"

+    OTHERWISE "???" 

+  ENDSELECT 

+ 

+ENDPROC arith log; 

+ 

+TEXT PROC reg1 : 

+    SELECT div8 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg1; 

+ 

+TEXT PROC reg2 : 

+    SELECT and7 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg2; 

+ 

+TEXT PROC rp: 

+    SELECT div10 AND 3 OF 

+      CASE 0 : "BC" 

+      CASE 1 : "DE" 

+      CASE 2 : "HL" 

+      CASE 3 : IF byte > 127 THEN "AF" 

+               ELSE "SP" FI 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC rp; 

+ 

+ 

+PROC bitmanipulation : 

+   parameter := text (div8) + "," + reg2 ; 

+   laenge := 2 ; 

+   SELECT byte DIV 64 OF 

+     CASE 1 : instr := "BIT" 

+     CASE 2 : instr := "RES"

+     CASE 3 : instr := "SET" 

+     OTHERWISE laenge := 1 ; 

+               parameter := "" 

+   ENDSELECT 

+ 

+ENDPROC bitmanipulation;

+ 

+ 

+PROC disass : 

+    laenge := 1 ; 

+    instr := "" ; 

+    parameter := "" ; 

+    int addr := addr ; 

+    byte := zugriff (int addr) ; 

+    c byte := code (byte) ; 

+    and 7 := byte AND 7 ; 

+    and f := byte AND 15 ; 

+    div 10:= byte DIV 16 ; 

+    div 8 := (byte DIV 8) AND 7 ; 

+    IF is special instruction 

+       THEN disass special instruction 

+    ELIF div 10 < 4 

+       THEN lower case instruction 

+    ELIF byte < 128 

+       THEN ld instruction 

+    ELIF byte < 192 

+       THEN arith log instruction 

+    ELSE higher case instruction 

+    FI. 

+ 

+is special instruction : 

+ pos (special instruction codes, c byte) > 0 . 

+ 

+special instruction codes : 

+  ""0""2""7""8""10""15""16""18""23""24""26""31""32""34""39""40""42""47""48""50

+  ""55""56""58""63""118""195""198""201""203""205""206""211""214""217""219

+  ""221""222""227""230""233""235""237""238""243""246""249""251""253""254"". 

+ 

+arith log instruction : 

+    instr := arith log ; 

+    parameter := reg 2 . 

+ 

+ld instruction : 

+  instr := "LD" ; 

+  parameter := reg 1 + "," + reg 2 . 

+ 

+condition code : 

+    SELECT div8 OF 

+      CASE 0 : "NZ" 

+      CASE 1 : "Z" 

+      CASE 2 : "NC" 

+      CASE 3 : "C" 

+      CASE 4 : "PO" 

+      CASE 5 : "PE" 

+      CASE 6 : "P" 

+      CASE 7 : "M" 

+      OTHERWISE "??" 

+    ENDSELECT. 

+ 

+lower case instruction : 

+   IF and f = 1 THEN instr := "LD" ; 

+                     parameter := rp + "," + next word ; 

+                     laenge := 3 

+ ELIF and f = 3 THEN instr := "INC" ; 

+                     parameter := rp ; 

+ ELIF and 7 = 4 THEN instr := "INC" ; 

+                     parameter := reg1

+ ELIF and 7 = 5 THEN instr := "DEC" ; 

+                     parameter := reg1 

+ ELIF and 7 = 6 THEN instr := "LD" ; 

+                     parameter := reg1 + "," + next byte ; 

+                     laenge := 2 

+ ELIF and f = 9 THEN instr := "ADD" ; 

+                     parameter := "HL," + rp ; 

+ ELIF and f =11 THEN instr := "DEC" ; 

+                     parameter := rp 

+ FI. 

+ 

+higher case instruction : 

+   SELECT and 7 OF 

+      CASE 0 : instr := "RET" ; 

+               parameter := condition code 

+      CASE 1 : instr := "POP" ; 

+               parameter := rp 

+      CASE 2 : instr := "JP" ; 

+               parameter := condition code + "," + next word ; 

+               laenge := 3 

+      CASE 4 : instr := "CALL" ; 

+               parameter := condition code + "," + next word ; 

+               laenge := 3 

+      CASE 5 : instr := "PUSH" ; 

+               parameter := rp 

+      CASE 7 : instr := "RST" ; 

+               parameter := hex8 (8 * div 8) 

+   ENDSELECT. 

+ 

+ 

+branchaddress : 

+     hex16 (addr PLUS displacement) . 

+ 

+displacement : 

+     IF zugriff (int addr PLUS 1) < 128 

+        THEN zugriff (int addr PLUS 1) + 2

+        ELSE zugriff (int addr PLUS 1) - 254 

+     FI. 

+ 

+cb instructions : 

+   byte := zugriff (addr PLUS 1) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   laenge := 2 ; 

+   parameter := reg 2 ; 

+   IF byte < 64 THEN 

+      SELECT div 8 OF 

+        CASE 0 : instr := "RLC" 

+        CASE 1 : instr := "RRC" 

+        CASE 2 : instr := "RL" 

+        CASE 3 : instr := "RR" 

+        CASE 4 : instr := "SLA" 

+        CASE 5 : instr := "SRA" 

+        CASE 6 : instr := "" ; parameter := "" ; laenge := 1 

+        CASE 7 : instr := "SLR" 

+        OTHERWISE laenge := 1 ; parameter := "" 

+      ENDSELECT 

+   ELSE 

+      bitmanipulation 

+   FI . 

+ 

+ 

+disass special instruction : 

+   SELECT byte OF 

+     CASE 0  : instr := "NOP" 

+     CASE 2  : instr := "LD" ; parameter := "(BC),A" 

+     CASE 7  : instr := "RLCA" 

+     CASE 8  : instr := "EX" ; parameter := "AF,AF'" 

+     CASE 10 : instr := "LD" ; parameter := "A,(BC)" 

+     CASE 15 : instr := "RRCA" 

+     CASE 16 : instr := "DJNZ" ; parameter := branchaddress ;     laenge:=2 

+     CASE 18 : instr := "LD" ; parameter := "(DE),A" 

+     CASE 23 : instr := "RLA" 

+     CASE 24 : instr := "JR" ; parameter := branchaddress ;       laenge:=2 

+     CASE 26 : instr := "LD" ; parameter := "A,(DE)" 

+     CASE 31 : instr := "RRA" 

+     CASE 32 : instr := "JR" ; parameter := "NZ," + branchaddress;laenge:=2 

+     CASE 34 : instr := "LD" ; parameter := "("+nextword+"),HL";  laenge:=3 

+     CASE 39 : instr := "DAA" 

+     CASE 40 : instr := "JR" ; parameter := "Z," + branchaddress; laenge:=2 

+     CASE 42 : instr := "LD" ; parameter := "HL,("+nextword+")";  laenge:=3 

+     CASE 47 : instr := "CPL" 

+     CASE 48 : instr := "JR" ; parameter := "NC," + branchaddress;laenge:=2 

+     CASE 50 : instr := "LD" ; parameter := "("+nextword+"),A";   laenge:=3 

+     CASE 55 : instr := "SCF" 

+     CASE 56 : instr := "JR" ; parameter := "C," + branchaddress; laenge:=2 

+     CASE 58 : instr := "LD" ; parameter := "A,("+nextword+")";   laenge:=3 

+     CASE 63 : instr := "CCF" 

+     CASE 118: instr := "HALT" 

+     CASE 195: instr := "JP" ; parameter := next word ;           laenge:=3 

+     CASE 198: instr := "ADD" ; parameter := "A,"+next byte;      laenge:=2 

+     CASE 201: instr := "RET" 

+     CASE 203: cb instructions 

+     CASE 205: instr := "CALL" ; parameter := next word; laenge := 3 

+     CASE 206: instr := "ADC" ; parameter := "A," + next byte ; laenge := 2 

+     CASE 211: instr := "OUT" ; parameter := "("+next byte+"),A";laenge:=2 

+     CASE 214: instr := "SUB" ; parameter := "A,"+next byte;laenge := 2 

+     CASE 217: instr := "EXX" 

+     CASE 219: instr := "IN" ; parameter := "A,(" + next byte+")";laenge := 2

+     CASE 221: index := "IX"; dd and fd instructions 

+     CASE 222: instr := "SBC" ; parameter := "A," + next byte ;laenge := 2 

+     CASE 227: instr := "EX"; parameter := "(SP),HL" 

+     CASE 230: instr := "AND" ; parameter := next byte; laenge := 2 

+     CASE 233: instr := "JP" ; parameter := "(HL)" 

+     CASE 235: instr := "EX" ; parameter := "DE,HL" 

+     CASE 237: ed instructions 

+     CASE 238: instr := "XOR" ; parameter := next byte ; laenge := 2 

+     CASE 243: instr := "DI" 

+     CASE 246: instr := "OR" ; parameter := next byte ; laenge := 2 

+     CASE 249: instr := "LD" ; parameter := "SP,HL" 

+     CASE 251: instr := "EI" 

+     CASE 253: index := "IY"; dd and fd instructions 

+     CASE 254: instr := "CP" ; parameter := next byte ; laenge := 2 

+   ENDSELECT. 

+ 

+ENDPROC disass ; 

+ 

+PROC dd and fd instructions : 

+   laenge := 2 ; 

+   int addr := addr PLUS 1 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   SELECT byte OF 

+     CASE 33 : instr := "LD" ; parameter := index+","+next word;laenge:=4 

+     CASE 34 : instr := "LD" ; parameter:="("+next word+"),"+index;laenge:=4 

+     CASE 35 : instr := "INC" ; parameter := index 

+     CASE 42 : instr := "LD" ; parameter:=index+",("+next word+")";laenge:=4 

+     CASE 43 : instr := "DEC" ; parameter := index 

+     CASE 52 : instr := "INC";parameter:="("+index+"+"+nextbyte+")";laenge:=3

+     CASE 53 : instr := "DEC";parameter:="("+index+"+"+nextbyte+")";laenge:=3;

+     CASE 54 : instr := "LD" ; parameter :="("+index+"+"+next byte+"),"+ 

+                               hex8(zugriff (addr PLUS 3));laenge := 4 

+     CASE 203: dd and fd cb instructions

+     CASE 225: instr := "POP" ; parameter := index 

+     CASE 227: instr := "EX" ; parameter := "(SP)," + index 

+     CASE 229: instr := "PUSH" ; parameter := index 

+     CASE 233: instr := "JP" ; parameter := "(" + index + ")" 

+     CASE 249: instr := "LD" ; parameter := "SP," + index 

+   OTHERWISE calculated dd and fd instructions 

+   ENDSELECT. 

+ 

+calculated dd and fd instructions : 

+   parameter := "(" + index + "+" + next byte + ")" ; 

+   laenge := 3 ; 

+     IF andf = 9 THEN instr := "ADD" ; parameter := index+","+rp;laenge:=2 

+   ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8

+      THEN instr := "LD" ; parameter := reg1 + "," + parameter 

+   ELIF div 10 = 7 AND byte <> 118 

+      THEN instr := "LD" ; parameter CAT "," + reg2 

+   ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 

+      THEN instr := arith log 

+   ELSE laenge := 1 ; 

+        parameter := ""

+   FI. 

+ 

+dd and fd cb instructions : 

+   int addr := addr PLUS 3 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   IF byte < 64 AND and7 = 6 THEN 

+        laenge := 4 ; 

+        parameter := "("+index + "+" + hex8 (zugriff (addr PLUS 2)) + ")" ; 

+        SELECT div 8 OF 

+          CASE 0 : instr := "RLC"

+          CASE 1 : instr := "RRC"

+          CASE 2 : instr := "RL" 

+          CASE 3 : instr := "RR"

+          CASE 4 : instr := "SLA"

+          CASE 5 : instr := "SRA"

+          CASE 7 : instr := "SRL"

+        OTHERWISE instr := "" ; parameter := "" ;laenge := 1

+        ENDSELECT 

+   ELIF and7 = 6 THEN laenge := 4 ; parameter := "(" + index + "+" 

+                                    + hex8 (zugriff (addr PLUS 2)) + ")" ; 

+                      dd and fd bitmanipulation

+   ELSE laenge := 1 ; 

+        parameter := ""

+   FI. 

+ 

+dd and fd bitmanipulation : 

+   parameter := text (div8) + "," + parameter ;

+   SELECT byte DIV 64 OF 

+     CASE 1 : instr := "BIT"

+     CASE 2 : instr := "RES" 

+     CASE 3 : instr := "SET" 

+     OTHERWISE laenge := 1 ; 

+               parameter := "" 

+   ENDSELECT. 

+ 

+ENDPROC dd and fd instructions ; 

+ 

+PROC ed instructions : 

+   int addr := addr PLUS 1 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   laenge := 2 ; 

+   SELECT byte OF 

+     CASE 52 : instr := "TST" ; parameter := "(HL)" 

+     CASE 68 : instr := "NEG" 

+     CASE 69 : instr := "RETN" 

+     CASE 70 : instr := "IM" ; parameter := "0" 

+     CASE 71 : instr := "LD" ; parameter := "I,A" 

+     CASE 77 : instr := "RETI" 

+     CASE 79 : instr := "LD" ; parameter := "R,A" 

+     CASE 86 : instr := "IM" ; parameter := "1" 

+     CASE 87 : instr := "LD" ; parameter := "A,I" 

+     CASE 94 : instr := "IM" ; parameter := "2"

+     CASE 95 : instr := "LD" ; parameter := "A,R" 

+     CASE 100: instr := "TST" ; parameter := next byte ; laenge := 3

+     CASE 103: instr := "RRD" 

+     CASE 111: instr := "RLD" 

+     CASE 116: instr := "TSTIO" ; parameter := next byte ; laenge := 3 

+     CASE 118: instr := "SLP" 

+     CASE 131: instr := "OTIM" 

+     CASE 139: instr := "OTDM" 

+     CASE 147: instr := "OTIMR" 

+     CASE 155: instr := "OTDMR" 

+     CASE 171: instr := "OUTD" 

+     CASE 163: instr := "OUTI" 

+     CASE 179: instr := "OTIR" 

+     CASE 187: instr := "OTDR" 

+   OTHERWISE calculate ed instruction 

+   ENDSELECT. 

+ 

+calculate ed instruction : 

+  IF is 40 to 7f THEN 

+        IF and7 = 0 THEN instr := "IN" ; parameter := reg1 + ",(C)" 

+      ELIF and7 = 1 THEN instr := "OUT" ; parameter := "(C)," + reg1 

+      ELIF andf = 2 THEN instr := "SBC" ; parameter := "HL," + rp 

+      ELIF andf = 3 THEN instr := "LD" ; parameter := "("+nextword+"),"+rp; 

+                         laenge := 4 

+      ELIF andf =11 THEN instr := "LD" ; parameter := rp+",("+nextword+")"; 

+                         laenge := 4

+      ELIF andf =10 THEN instr := "ADC" ; parameter := "HL," + rp 

+      ELIF andf =12 THEN instr := "MLT" ; parameter := rp 

+      ELSE laenge := 1

+      FI 

+  ELIF byte < 64 THEN 

+        IF and7 = 0 THEN instr := "IN0" ; parameter := reg1 + ",(" + next

+                         byte + ")" ; laenge := 3 

+      ELIF and7 = 1 THEN instr := "OUT0" ; parameter := "(" + next word +

+                         ")," + reg1 ; laenge := 3 

+      ELIF and7 = 4 THEN instr := "TST" ; parameter := reg1 

+      ELSE laenge := 1 

+      FI 

+  ELIF div10 = 10 OR div10 = 11 THEN 

+          IF and7 = 0 THEN instr := "LD" + modification 

+        ELIF and7 = 1 THEN instr := "CP" + modification

+        ELIF and7 = 2 THEN instr := "IN" + modification 

+        ELSE laenge := 1

+        FI 

+   ELSE laenge := 1

+   FI. 

+ 

+is 40 to 7f : 

+   div 10 < 8 AND div 10 > 3. 

+ 

+modification : 

+   SELECT div8 - 4 OF

+     CASE 0 : "I" 

+     CASE 1 : "D" 

+     CASE 2 : "IR" 

+     CASE 3 : "DR" 

+   OTHERWISE "???" 

+   ENDSELECT. 

+ 

+ENDPROC ed instructions ; 

+

+TEXT PROC next word : 

+ hex8 (zugriff (int addr PLUS 2)) + hex8 (zugriff (int addr PLUS 1))

+ENDPROC next word ;

+ 

+TEXT PROC next byte : 

+ hex8 (zugriff (int addr PLUS 1))

+ENDPROC next byte

+

diff --git a/system/eumel0-z80/src/eumel0.prt.1 b/system/eumel0-z80/src/eumel0.prt.1
new file mode 100644
index 0000000..244dcbe
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.1
@@ -0,0 +1,3948 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT

+

+1400 45          E     LD    B,L        ; "EUMEL           " (16 chars) 

+1401 55          U     LD    D,L        

+1402 4D          M     LD    C,L        

+1403 45          E     LD    B,L        

+1404 4C          L     LD    C,H        

+1405 20 20             JR    NZ,1427    

+1407 20 20             JR    NZ,1429    

+1409 20 20             JR    NZ,142B    

+140B 20 20             JR    NZ,142D    

+140D 20 20             JR    NZ,142F    

+140F 20 

+1410 3A 00                              ; eumel0blocks (58) 

+1412 D6 06       ..    SUB   A,06       ; mind. hgversion (1750) ID(0)

+1414 01 00                              ; cputype: z80 (1)       ID(1) 

+                                        ; 3=8086, 4=68000, 5=80286

+1416 65 00       ..e   LD    BC,6500    ; urladerversion (101)   ID(2)

+1418 00 00                              ; reserviert (0)         ID(3)

+141A 05 00                              ; mind shard version (5)

+141C 08 00       .     NOP              ; max shard version (8)

+                                        ; ----------- 175 Leiste ---------

+141E C3 D4 28    ..(   JP    28D4       ; Systemstart 175

+1421 C3 71 1F    .q.   JP    1F71       ; inputinterrupt

+1424 C3 35 6E    .5n   JP    6E35       ; timerinterrupt

+1427 C3 E2 6D    ..m   JP    6DE2       ; EUMEL0 Warte aufruefen

+142A C3 5B 5E    .[^   JP    5E5B       ; grab Blocks

+142D C3 21 60    .!`   JP    6021       ; free Blocks

+1430 C3 1C 29    ..)   JP    291C       ; Shutup ausfuehren

+1433 C3 09 29    ..)   JP    2909       ; Info " shard" Ansprungaddresse

+1436 00          .     NOP              ; 1500 00 7F FF

+1437 15          .     DEC   D          ; etc. wie 1.7.3

+1438 FF          .     RST   38         

+1439 7F          .     LD    A,A        

+143A 00          .     NOP              

+143B 80          .     ADD   B          

+143C 15          .     DEC   D          

+143D 02          .     LD    (BC),A     

+143E 7F          .     LD    A,A        

+143F 00          .     NOP              

+1440 00          .     NOP              

+1441 16 FD       ..    LD    D,FD       

+1443 7F          .     LD    A,A        

+1444 00          .     NOP              

+1445 80          .     ADD   B          

+1446 16 FF       ..    LD    D,FF       

+1448 7F          .     LD    A,A        

+1449 00          .     NOP              

+144A 00          .     NOP              

+144B 17          .     RLA              

+144C 00          .     NOP              

+144D 7F          .     LD    A,A        

+144E 01 80 18    ...   LD    BC,1880    

+1451 FF          .     RST   38         

+1452 7F          .     LD    A,A        

+1453 00          .     NOP              

+1454 00          .     NOP              

+1455 19          .     ADD   HL,DE      

+1456 00          .     NOP              

+1457 FF          .     RST   38         

+1458 04          .     INC   B          

+1459 00          .     NOP              

+145A 00          .     NOP              

+145B 31 37 35    175   LD    SP,3537    ; "175 hwtest   7 (!)"

+145E 20 68        h    JR    NZ,14C8    

+1460 77          w     LD    (HL),A     

+1461 74          t     LD    (HL),H     

+1462 65          e     LD    H,L        

+1463 73          s     LD    (HL),E     

+1464 74          t     LD    (HL),H     

+1465 20 20             JR    NZ,1487    

+1467 20 37        7    JR    NZ,14A0    

+1469 20 28        (    JR    NZ,1493    

+146B 21 29       !).   LD    HL,CD29    

+146D CD EB 6D          CALL  6DEB       ;---- EUMEL0-Ram Tabellen init ---

+1470 2A 36 14    *6.   LD    HL,(1436)  

+1473 E5          .     PUSH  HL         

+1474 21 36 14    !6.   LD    HL,1436    

+1477 97          .     SUB   A          

+1478 5E          ^     LD    E,(HL)     

+1479 23          #     INC   HL         

+147A 56          V     LD    D,(HL)     

+147B 14          .     INC   D          

+147C 15          .     DEC   D          

+147D 28 09       (.    JR    Z,1488     

+147F 23          #     INC   HL         

+1480 01 03 00    ...   LD    BC,0003    

+1483 ED B0       ..    LDIR             

+1485 3C          <     INC   A          

+1486 18 F0       ..    JR    1478       

+1488 D1          .     POP   DE         

+1489 62          b     LD    H,D        

+148A 6B          k     LD    L,E        

+148B 23          #     INC   HL         

+148C 4E          N     LD    C,(HL)     

+148D 23          #     INC   HL         

+148E 46          F     LD    B,(HL)     

+148F 2B          +     DEC   HL         

+1490 EB          .     EX    DE,HL      

+1491 ED B0       ..    LDIR             

+1493 3D          =     DEC   A          

+1494 20 F3        .    JR    NZ,1489    ; Miniprozess endlosschleife

+1496 C3 A0 6D    ..m   JP    6DA0       ; ====== Allgemeiner Systemstart ===

+1499 31 00 A1    1..   LD    SP,A100    ; Stackpointer vorlaefig setzen

+149C CD A0 28    ..(   CALL  28A0       ; Limit holen

+149F ED 53 3D 1D .S=.  LD    (1D3D),DE  

+14A3 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  

+14A7 CD FE 6D    ..m   CALL  6DFE       

+14AA FB          .     EI               

+14AB 3A 6E 28    :n(   LD    A,(286E)   ; Vortest durchfuehren ?

+14AE CB 4F       .O    BIT   1,A        

+14B0 C2 BF 15    ...   JP    NZ,15BF    

+14B3 21 AF 82    !..   LD    HL,82AF    ; "EUMEL-Vortest"

+14B6 CD CA 6E    ..n   CALL  6ECA       ; Text ausgeben

+14B9 3E 02       >.    LD    A,02       ; Terminalkanaele anzeigen

+14BB F5          .     PUSH  AF         

+14BC CD 71 1E    .q.   CALL  1E71       ; Typ erfragen

+14BF 38 16       8.    JR    C,14D7     

+14C1 F1          .     POP   AF         

+14C2 F5          .     PUSH  AF         

+14C3 16 00       ..    LD    D,00       

+14C5 5F          _     LD    E,A        

+14C6 21 1B 1D    !..   LD    HL,1D1B    

+14C9 FE 0A       ..    CP    0A         

+14CB 30 01       0.    JR    NC,14CE    

+14CD 23          #     INC   HL         

+14CE CD 00 4E    ..N   CALL  4E00       

+14D1 21 19 1D    !..   LD    HL,1D19    

+14D4 CD CA 6E    ..n   CALL  6ECA       

+14D7 F1          .     POP   AF         

+14D8 3C          <     INC   A          

+14D9 FE 21       .!    CP    21         ; 31 Kanaele

+14DB 38 DE       8.    JR    C,14BB     

+14DD CD E0 1C    ...   CALL  1CE0       

+14E0 CD 8A 28    ..(   CALL  288A       

+14E3 22 11 1D    "..   LD    (1D11),HL  

+14E6 ED 43 0F 1D .C..  LD    (1D0F),BC  

+14EA CB B8       ..    RES   7,B        

+14EC CB 70       .p    BIT   6,B        

+14EE 50          P     LD    D,B        

+14EF 59          Y     LD    E,C        

+14F0 28 03       (.    JR    Z,14F5     

+14F2 01 00 00    ...   LD    BC,0000    

+14F5 CB 21       .!    SLA   C          

+14F7 CB 10       ..    RL    B          

+14F9 ED 43 0D 1D .C..  LD    (1D0D),BC  

+14FD CB B2       ..    RES   6,D        

+14FF 21 40 00    !@.   LD    HL,0040    

+1502 19          .     ADD   HL,DE      

+1503 EB          .     EX    DE,HL      

+1504 21 00 85    !..   LD    HL,8500    

+1507 CD 00 4E    ..N   CALL  4E00       

+150A 21 E8 84    !..   LD    HL,84E8    

+150D CD CA 6E    ..n   CALL  6ECA       

+1510 CD A0 28    ..(   CALL  28A0       

+1513 21 97 82    !..   LD    HL,8297    

+1516 EB          .     EX    DE,HL      

+1517 B7          .     OR    A          

+1518 ED 52       .R    SBC   HL,DE      

+151A CB 3C       .<    SLR   H          

+151C CB 3C       .<    SLR   H          

+151E 5C          \     LD    E,H        

+151F 16 00       ..    LD    D,00       

+1521 21 70 85    !p.   LD    HL,8570    

+1524 CD 00 4E    ..N   CALL  4E00       

+1527 21 57 85    !W.   LD    HL,8557    

+152A CD CA 6E    ..n   CALL  6ECA       

+152D 97          .     SUB   A          

+152E 01 05 00    ...   LD    BC,0005    

+1531 11 00 00    ...   LD    DE,0000    

+1534 CD A8 28    ..(   CALL  28A8       

+1537 CB 28       .(    SRA   B          

+1539 CB 19       ..    RR    C          

+153B 59          Y     LD    E,C        

+153C 50          P     LD    D,B        

+153D 21 1F 85    !..   LD    HL,851F    

+1540 3E E7       >.    LD    A,E7       

+1542 93          .     SUB   E          

+1543 3E 03       >.    LD    A,03       

+1545 9A          .     SBC   D          

+1546 38 01       8.    JR    C,1549     

+1548 23          #     INC   HL         

+1549 CD 00 4E    ..N   CALL  4E00       

+154C 21 08 85    !..   LD    HL,8508    

+154F CD CA 6E    ..n   CALL  6ECA       

+1552 3A 6E 28    :n(   LD    A,(286E)   

+1555 CB 47       .G    BIT   0,A        

+1557 20 0C        .    JR    NZ,1565    

+1559 21 DD 82    !..   LD    HL,82DD    

+155C CD CA 6E    ..n   CALL  6ECA       

+155F CD F0 17    ...   CALL  17F0       

+1562 CD E0 1C    ...   CALL  1CE0       

+1565 01 00 00    ...   LD    BC,0000    

+1568 ED A1       ..    CPI              

+156A EA 68 15    .h.   JP    PE,1568    

+156D 3E 01       >.    LD    A,01       

+156F CD 06 1F    ...   CALL  1F06       

+1572 38 4B       8K    JR    C,15BF     

+1574 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  ; ----- Menue ausgeben --------

+1578 97          .     SUB   A          

+1579 32 30 1D    20.   LD    (1D30),A   

+157C 21 EE 82    !..   LD    HL,82EE    ; Menuetext

+157F CD CA 6E    ..n   CALL  6ECA       ; Ausgeben

+1582 CD 9B 1C    ...   CALL  1C9B       ; AUf Taste warten

+1585 FE 31       .1    CP    31         ; "1" Systemstart

+1587 28 36       (6    JR    Z,15BF     

+1589 FE 32       .2    CP    32         ; "2" Neuen HG laden

+158B CA 16 16    ...   JP    Z,1616     

+158E FE 33       .3    CP    33         ; "3" Hardwaretest

+1590 CA 9D 16    ...   JP    Z,169D     

+1593 FE 34       .4    CP    34         ; "4" neuen Urlader vom Archiv

+1595 28 35       (5    JR    Z,15CC     

+1597 FE 53       .S    CP    53         ; "S" Systemstart ohne Block 0

+1599 CA 6D 14    .m.   JP    Z,146D     ; Zur Miniprozess Schleife

+159C FE 49       .I    CP    49         ; "I" Info aufrufen

+159E 20 D4        .    JR    NZ,1574    

+15A0 DD 21 31 1D .!1.  LD    IX,1D31    

+15A4 CD C0 1A    ...   CALL  1AC0       

+15A7 21 46 A0    !F.   LD    HL,A046    

+15AA 11 19 7D    ..}   LD    DE,7D19    

+15AD 01 0A 00    ...   LD    BC,000A    

+15B0 ED B0       ..    LDIR             

+15B2 CD 1F 70    ..p   CALL  701F       ; Info aufrufen 

+15B5 18 06       ..    JR    15BD       ; " start"

+15B7 20 73        s    JR    NZ,162C    

+15B9 74          t     LD    (HL),H     

+15BA 61          a     LD    H,C        

+15BB 72          r     LD    (HL),D     

+15BC 74          t     LD    (HL),H     

+15BD 18 B5       ..    JR    1574       ; ------- Vortest Ende -----------

+15BF DD 21 31 1D .!1.  LD    IX,1D31    ; Systemstart

+15C3 CD C0 1A    ...   CALL  1AC0       ; Block 0 laden

+15C6 CD 66 1C    .f.   CALL  1C66       ; Etikett testen

+15C9 C3 6D 14    .m.   JP    146D       ; Zur Miniprozess Schleife

+15CC DD 21 36 1D .!6.  LD    IX,1D36    ;-- Neuen Urlader laden ------

+15D0 CD 9F 1A    ...   CALL  1A9F       

+15D3 21 0A 00    !..   LD    HL,000A    

+15D6 22 32 1D    "2.   LD    (1D32),HL  

+15D9 22 37 1D    "7.   LD    (1D37),HL  

+15DC CD 03 16    ...   CALL  1603       

+15DF DD 21 31 1D .!1.  LD    IX,1D31    

+15E3 CD 03 16    ...   CALL  1603       

+15E6 ED 4B 10 A0 .K..  LD    BC,(A010)  

+15EA 21 3A 00    !:.   LD    HL,003A    

+15ED 37          7     SCF              

+15EE ED 42       .B    SBC   HL,BC      

+15F0 30 08       0.    JR    NC,15FA    

+15F2 21 44 00    !D.   LD    HL,0044    

+15F5 22 3B 1D    ";.   LD    (1D3B),HL  

+15F8 18 4E       .N    JR    1648       

+15FA 21 D4 85    !..   LD    HL,85D4    

+15FD CD CA 6E    ..n   CALL  6ECA       

+1600 C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+1603 CD F2 1A    ...   CALL  1AF2       

+1606 21 00 A0    !..   LD    HL,A000    

+1609 11 2A 1D    .*.   LD    DE,1D2A    

+160C 01 05 00    ...   LD    BC,0005    

+160F CD 92 1C    ...   CALL  1C92       

+1612 C2 74 15    .t.   JP    NZ,1574    ; Zum Vortest Menue

+1615 C9          .     RET              ;-------- Neuen HG vom ARchiv ----

+1616 21 C9 84    !..   LD    HL,84C9    ; "ALten HG ueberschreiben (j/n) ?"

+1619 CD CA 6E    ..n   CALL  6ECA       

+161C CD 9B 1C    ...   CALL  1C9B       

+161F FE 79       .y    CP    79         ; "y" oder

+1621 28 05       (.    JR    Z,1628     

+1623 FE 6A       .j    CP    6A         ; "j" erlaubt

+1625 C2 74 15    .t.   JP    NZ,1574    

+1628 DD 21 31 1D .!1.  LD    IX,1D31    ; Ueberschreiben

+162C CD 9F 1A    ...   CALL  1A9F       

+162F CD C0 1A    ...   CALL  1AC0       

+1632 DD 21 36 1D .!6.  LD    IX,1D36    

+1636 CD 9F 1A    ...   CALL  1A9F       

+1639 CD C0 1A    ...   CALL  1AC0       

+163C CD 66 1C    .f.   CALL  1C66       

+163F 2A 24 A0    *$.   LD    HL,(A024)  

+1642 29          )     ADD   HL,HL      

+1643 29          )     ADD   HL,HL      

+1644 29          )     ADD   HL,HL      

+1645 22 3B 1D    ";.   LD    (1D3B),HL  

+1648 CD B6 1C    ...   CALL  1CB6       

+164B DD 21 31 1D .!1.  LD    IX,1D31    

+164F CD D1 1B    ...   CALL  1BD1       

+1652 DD 21 36 1D .!6.  LD    IX,1D36    

+1656 CD F2 1A    ...   CALL  1AF2       

+1659 DD 21 31 1D .!1.  LD    IX,1D31    

+165D CD 08 1C    ...   CALL  1C08       

+1660 CD BA 1B    ...   CALL  1BBA       

+1663 2A 3B 1D    *;.   LD    HL,(1D3B)  

+1666 ED 5B 32 1D .[2.  LD    DE,(1D32)  

+166A B7          .     OR    A          

+166B ED 52       .R    SBC   HL,DE      

+166D CA 8F 16    ...   JP    Z,168F     

+1670 DD 21 36 1D .!6.  LD    IX,1D36    

+1674 CD BA 1B    ...   CALL  1BBA       

+1677 20 CF        .    JR    NZ,1648    

+1679 21 43 84    !C.   LD    HL,8443    

+167C CD CA 6E    ..n   CALL  6ECA       

+167F CD 9B 1C    ...   CALL  1C9B       

+1682 FE 79       .y    CP    79         ; "y" oder

+1684 28 04       (.    JR    Z,168A     

+1686 FE 6A       .j    CP    6A         ; "j" erlaubt

+1688 20 EF        .    JR    NZ,1679    

+168A CD 9F 1A    ...   CALL  1A9F       

+168D 18 B9       ..    JR    1648       

+168F CD E0 1C    ...   CALL  1CE0       

+1692 CD E0 1C    ...   CALL  1CE0       

+1695 21 B5 84    !..   LD    HL,84B5    

+1698 CD CA 6E    ..n   CALL  6ECA       

+169B 18 FE       ..    JR    169B       

+169D 3E 01       >.    LD    A,01       ; ------ Hardwaretest

+169F 32 30 1D    20.   LD    (1D30),A   

+16A2 21 6C 83    !l.   LD    HL,836C    

+16A5 CD CA 6E    ..n   CALL  6ECA       ; Hardwaretest Menue

+16A8 21 00 00    !..   LD    HL,0000    

+16AB 22 F3 1C    "..   LD    (1CF3),HL  

+16AE CD 9B 1C    ...   CALL  1C9B       

+16B1 FE 31       .1    CP    31         ; "1" Speichertest

+16B3 CA C6 16    ...   JP    Z,16C6     

+16B6 FE 32       .2    CP    32         ; "2" Kanaltest

+16B8 CA 7C 17    .|.   JP    Z,177C     

+16BB FE 33       .3    CP    33         

+16BD 28 12       (.    JR    Z,16D1     ; "3" HG Test

+16BF FE 34       .4    CP    34         ; "4" Archivtest

+16C1 28 14       (.    JR    Z,16D7     

+16C3 C3 74 15    .t.   JP    1574       

+16C6 CD C2 1C    ...   CALL  1CC2       ; ----Speichertest

+16C9 CD F0 17    ...   CALL  17F0       

+16CC CD B6 1C    ...   CALL  1CB6       

+16CF 18 F5       ..    JR    16C6       ; Wiederholen

+16D1 DD 21 31 1D .!1.  LD    IX,1D31    ; ------- HG Test

+16D5 18 04       ..    JR    16DB       

+16D7 DD 21 36 1D .!6.  LD    IX,1D36    ; -------- Archivtest

+16DB 21 C1 83    !..   LD    HL,83C1    

+16DE CD CA 6E    ..n   CALL  6ECA       

+16E1 CD 9B 1C    ...   CALL  1C9B       

+16E4 FE 31       .1    CP    31         ; "1" Lesetest

+16E6 28 0C       (.    JR    Z,16F4     

+16E8 FE 32       .2    CP    32         ; "2" Schreiblesetest

+16EA 28 21       (!    JR    Z,170D     

+16EC FE 33       .3    CP    33         ; "3" Positioniertest

+16EE CA 60 17    .`.   JP    Z,1760     

+16F1 C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+16F4 CD C2 1C    ...   CALL  1CC2       

+16F7 CD E0 1C    ...   CALL  1CE0       

+16FA CD 9F 1A    ...   CALL  1A9F       

+16FD CD B6 1C    ...   CALL  1CB6       

+1700 CD D1 1B    ...   CALL  1BD1       

+1703 CD F2 1A    ...   CALL  1AF2       

+1706 CD BA 1B    ...   CALL  1BBA       

+1709 20 F2        .    JR    NZ,16FD    

+170B 18 E7       ..    JR    16F4       

+170D CD C2 1C    ...   CALL  1CC2       

+1710 CD E0 1C    ...   CALL  1CE0       

+1713 CD 9F 1A    ...   CALL  1A9F       

+1716 CD B6 1C    ...   CALL  1CB6       

+1719 CD D1 1B    ...   CALL  1BD1       

+171C CD F2 1A    ...   CALL  1AF2       

+171F 21 00 A0    !..   LD    HL,A000    

+1722 11 00 A2    ...   LD    DE,A200    

+1725 01 00 02    ...   LD    BC,0200    

+1728 ED B0       ..    LDIR             

+172A 3E 55       >U    LD    A,55       

+172C CD 31 1C    .1.   CALL  1C31       

+172F 3E AA       >.    LD    A,AA       

+1731 CD 31 1C    .1.   CALL  1C31       

+1734 21 00 A2    !..   LD    HL,A200    

+1737 11 00 A0    ...   LD    DE,A000    

+173A 01 00 02    ...   LD    BC,0200    

+173D ED B0       ..    LDIR             

+173F CD 08 1C    ...   CALL  1C08       

+1742 3E 55       >U    LD    A,55       

+1744 CD 59 1C    .Y.   CALL  1C59       

+1747 CD ED 1B    ...   CALL  1BED       

+174A 21 00 A0    !..   LD    HL,A000    

+174D 11 00 A2    ...   LD    DE,A200    

+1750 01 00 02    ...   LD    BC,0200    

+1753 CD 92 1C    ...   CALL  1C92       

+1756 C4 27 1C    .'.   CALL  NZ,1C27    

+1759 CD BA 1B    ...   CALL  1BBA       

+175C 20 B8        .    JR    NZ,1716    

+175E 18 AD       ..    JR    170D       

+1760 CD C2 1C    ...   CALL  1CC2       

+1763 CD E0 1C    ...   CALL  1CE0       

+1766 CD 9F 1A    ...   CALL  1A9F       

+1769 CD B6 1C    ...   CALL  1CB6       

+176C CD C0 1A    ...   CALL  1AC0       

+176F CD D1 1B    ...   CALL  1BD1       

+1772 CD F2 1A    ...   CALL  1AF2       

+1775 CD BA 1B    ...   CALL  1BBA       

+1778 20 EF        .    JR    NZ,1769    

+177A 18 E4       ..    JR    1760       

+177C CD C2 1C    ...   CALL  1CC2       

+177F CD E0 1C    ...   CALL  1CE0       

+1782 CD B6 1C    ...   CALL  1CB6       

+1785 3E 20       >     LD    A,20       

+1787 32 30 85    20.   LD    (8530),A   

+178A 3E 02       >.    LD    A,02       

+178C F5          .     PUSH  AF         

+178D 5F          _     LD    E,A        

+178E CD 71 1E    .q.   CALL  1E71       

+1791 38 53       8S    JR    C,17E6     

+1793 F1          .     POP   AF         

+1794 F5          .     PUSH  AF         

+1795 CD 59 1E    .Y.   CALL  1E59       

+1798 FE 1E       ..    CP    1E         

+179A 38 20       8     JR    C,17BC     

+179C 16 00       ..    LD    D,00       

+179E 21 31 85    !1.   LD    HL,8531    

+17A1 36 20       6     LD    (HL),20    

+17A3 2B          +     DEC   HL         

+17A4 CD 00 4E    ..N   CALL  4E00       

+17A7 21 28 85    !(.   LD    HL,8528    

+17AA 4E          N     LD    C,(HL)     

+17AB 23          #     INC   HL         

+17AC 06 00       ..    LD    B,00       

+17AE F1          .     POP   AF         

+17AF F5          .     PUSH  AF         

+17B0 59          Y     LD    E,C        

+17B1 CD 88 21    ..!   CALL  2188       

+17B4 38 06       8.    JR    C,17BC     

+17B6 09          .     ADD   HL,BC      

+17B7 7B          {     LD    A,E        

+17B8 91          .     SUB   C          

+17B9 4F          O     LD    C,A        

+17BA 18 F2       ..    JR    17AE       

+17BC F1          .     POP   AF         

+17BD F5          .     PUSH  AF         

+17BE CD 06 1F    ...   CALL  1F06       

+17C1 38 23       8#    JR    C,17E6     

+17C3 5F          _     LD    E,A        

+17C4 16 00       ..    LD    D,00       

+17C6 21 20 20    !     LD    HL,2020    

+17C9 22 55 85    "U.   LD    (8555),HL  

+17CC 21 54 85    !T.   LD    HL,8554    

+17CF CD 00 4E    ..N   CALL  4E00       

+17D2 F1          .     POP   AF         

+17D3 F5          .     PUSH  AF         

+17D4 5F          _     LD    E,A        

+17D5 16 00       ..    LD    D,00       

+17D7 21 42 85    !B.   LD    HL,8542    

+17DA 36 20       6     LD    (HL),20    

+17DC 2B          +     DEC   HL         

+17DD CD 00 4E    ..N   CALL  4E00       

+17E0 21 34 85    !4.   LD    HL,8534    

+17E3 CD CA 6E    ..n   CALL  6ECA       

+17E6 F1          .     POP   AF         

+17E7 3C          <     INC   A          

+17E8 FE 20       .     CP    20         

+17EA DA 8C 17    ...   JP    C,178C     

+17ED C3 7C 17    .|.   JP    177C       

+17F0 CD A0 28    ..(   CALL  28A0       

+17F3 15          .     DEC   D          

+17F4 21 DE 85    !..   LD    HL,85DE    

+17F7 22 E7 1C    "..   LD    (1CE7),HL  

+17FA EB          .     EX    DE,HL      

+17FB B7          .     OR    A          

+17FC ED 52       .R    SBC   HL,DE      

+17FE 22 E9 1C    "..   LD    (1CE9),HL  

+1801 EB          .     EX    DE,HL      

+1802 CB 3A       .:    SLR   D          

+1804 CB 1B       ..    RR    E          

+1806 21 03 00    !..   LD    HL,0003    

+1809 CD 3D 4D    .=M   CALL  4D3D       

+180C CB 23       .#    SLA   E          

+180E CB 12       ..    RL    D          

+1810 ED 53 EB 1C .S..  LD    (1CEB),DE  

+1814 21 DE 85    !..   LD    HL,85DE    

+1817 11 3F 1D    .?.   LD    DE,1D3F    

+181A B7          .     OR    A          

+181B ED 52       .R    SBC   HL,DE      

+181D 22 ED 1C    "..   LD    (1CED),HL  

+1820 EB          .     EX    DE,HL      

+1821 21 03 00    !..   LD    HL,0003    

+1824 CD 3D 4D    .=M   CALL  4D3D       

+1827 ED 53 EF 1C .S..  LD    (1CEF),DE  

+182B 21 FF FF    !..   LD    HL,FFFF    

+182E 22 F1 1C    "..   LD    (1CF1),HL  

+1831 2A E7 1C    *..   LD    HL,(1CE7)  

+1834 CD 12 19    ...   CALL  1912       

+1837 21 00 00    !..   LD    HL,0000    

+183A 5C          \     LD    E,H        

+183B E5          .     PUSH  HL         

+183C CD C9 19    ...   CALL  19C9       

+183F 30 0D       0.    JR    NC,184E    

+1841 CD 12 19    ...   CALL  1912       

+1844 E1          .     POP   HL         

+1845 7C          |     LD    A,H        

+1846 C6 40       .@    ADD   A,40       

+1848 67          g     LD    H,A        

+1849 30 01       0.    JR    NC,184C    

+184B 1C          .     INC   E          

+184C 18 ED       ..    JR    183B       

+184E E1          .     POP   HL         ; Testmuster fuer Speichertest

+184F 11 01 55    ..U   LD    DE,5501    

+1852 CD 22 19    .".   CALL  1922       

+1855 11 02 55    ..U   LD    DE,5502    

+1858 CD 22 19    .".   CALL  1922       

+185B 11 00 AA    ...   LD    DE,AA00    

+185E CD 22 19    .".   CALL  1922       

+1861 11 01 55    ..U   LD    DE,5501    

+1864 CD 7A 19    .z.   CALL  197A       

+1867 11 01 AA    ...   LD    DE,AA01    

+186A CD 22 19    .".   CALL  1922       

+186D 11 02 55    ..U   LD    DE,5502    

+1870 CD 7A 19    .z.   CALL  197A       

+1873 11 00 AA    ...   LD    DE,AA00    

+1876 CD 7A 19    .z.   CALL  197A       

+1879 11 01 AA    ...   LD    DE,AA01    

+187C CD 7A 19    .z.   CALL  197A       

+187F 11 00 55    ..U   LD    DE,5500    

+1882 CD 22 19    .".   CALL  1922       

+1885 11 00 55    ..U   LD    DE,5500    

+1888 CD 7A 19    .z.   CALL  197A       

+188B 11 02 AA    ...   LD    DE,AA02    

+188E CD 22 19    .".   CALL  1922       

+1891 11 02 AA    ...   LD    DE,AA02    

+1894 CD 7A 19    .z.   CALL  197A       

+1897 2A E9 1C    *..   LD    HL,(1CE9)  

+189A ED 5B ED 1C .[..  LD    DE,(1CED)  

+189E B7          .     OR    A          

+189F ED 52       .R    SBC   HL,DE      

+18A1 38 5D       8]    JR    C,1900     

+18A3 F3          .     DI               

+18A4 21 3F 1D    !?.   LD    HL,1D3F    

+18A7 ED 5B E7 1C .[..  LD    DE,(1CE7)  

+18AB CD 1B 1A    ...   CALL  1A1B       

+18AE 11 01 55    ..U   LD    DE,5501    

+18B1 CD 07 1A    ...   CALL  1A07       

+18B4 11 02 55    ..U   LD    DE,5502    

+18B7 CD 07 1A    ...   CALL  1A07       

+18BA 11 00 AA    ...   LD    DE,AA00    

+18BD CD 07 1A    ...   CALL  1A07       

+18C0 11 01 55    ..U   LD    DE,5501    

+18C3 CD 11 1A    ...   CALL  1A11       

+18C6 11 01 AA    ...   LD    DE,AA01    

+18C9 CD 07 1A    ...   CALL  1A07       

+18CC 11 02 55    ..U   LD    DE,5502    

+18CF CD 11 1A    ...   CALL  1A11       

+18D2 11 00 AA    ...   LD    DE,AA00    

+18D5 CD 11 1A    ...   CALL  1A11       

+18D8 11 01 AA    ...   LD    DE,AA01    

+18DB CD 11 1A    ...   CALL  1A11       

+18DE 11 00 55    ..U   LD    DE,5500    

+18E1 CD 07 1A    ...   CALL  1A07       

+18E4 11 00 55    ..U   LD    DE,5500    

+18E7 CD 11 1A    ...   CALL  1A11       

+18EA 11 02 AA    ...   LD    DE,AA02    

+18ED CD 07 1A    ...   CALL  1A07       

+18F0 11 02 AA    ...   LD    DE,AA02    

+18F3 CD 11 1A    ...   CALL  1A11       

+18F6 2A E7 1C    *..   LD    HL,(1CE7)  

+18F9 11 3F 1D    .?.   LD    DE,1D3F    

+18FC CD 1B 1A    ...   CALL  1A1B       

+18FF FB          .     EI               

+1900 CD E0 1C    ...   CALL  1CE0       

+1903 3A E6 1C    :..   LD    A,(1CE6)   

+1906 B7          .     OR    A          

+1907 C8          .     RET   Z          

+1908 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  

+190C CD E0 1C    ...   CALL  1CE0       

+190F C3 2B 18    .+.   JP    182B       

+1912 06 05       ..    LD    B,05       

+1914 97          .     SUB   A          

+1915 57          W     LD    D,A        

+1916 77          w     LD    (HL),A     

+1917 7E          ~     LD    A,(HL)     

+1918 BA          .     CP    D          

+1919 C4 31 1A    .1.   CALL  NZ,1A31    

+191C 3C          <     INC   A          

+191D 20 F6        .    JR    NZ,1915    

+191F 10 F3       ..    DJNZ  1914       

+1921 C9          .     RET              

+1922 2A E7 1C    *..   LD    HL,(1CE7)  

+1925 ED 4B EB 1C .K..  LD    BC,(1CEB)  

+1929 CD 51 19    .Q.   CALL  1951       

+192C 26 00       &.    LD    H,00       

+192E 6B          k     LD    L,E        

+192F 1E 00       ..    LD    E,00       

+1931 E5          .     PUSH  HL         

+1932 CD C9 19    ...   CALL  19C9       

+1935 30 0F       0.    JR    NC,1946    

+1937 7D          }     LD    A,L        

+1938 72          r     LD    (HL),D     

+1939 C6 03       ..    ADD   A,03       

+193B 6F          o     LD    L,A        

+193C 30 FA       0.    JR    NC,1938    

+193E E1          .     POP   HL         

+193F 6F          o     LD    L,A        

+1940 24          $     INC   H          

+1941 20 EE        .    JR    NZ,1931    

+1943 1C          .     INC   E          

+1944 18 EB       ..    JR    1931       

+1946 CD 6D 19    .m.   CALL  196D       

+1949 21 0B 1D    !..   LD    HL,1D0B    

+194C CD CA 6E    ..n   CALL  6ECA       

+194F E1          .     POP   HL         

+1950 C9          .     RET              

+1951 D5          .     PUSH  DE         

+1952 79          y     LD    A,C        

+1953 B7          .     OR    A          

+1954 28 01       (.    JR    Z,1957     

+1956 04          .     INC   B          

+1957 79          y     LD    A,C        

+1958 48          H     LD    C,B        

+1959 47          G     LD    B,A        

+195A 7A          z     LD    A,D        

+195B 16 00       ..    LD    D,00       

+195D 19          .     ADD   HL,DE      

+195E 11 03 00    ...   LD    DE,0003    

+1961 77          w     LD    (HL),A     

+1962 19          .     ADD   HL,DE      

+1963 10 FC       ..    DJNZ  1961       

+1965 0D          .     DEC   C          

+1966 20 F9        .    JR    NZ,1961    

+1968 D1          .     POP   DE         

+1969 CD 6D 19    .m.   CALL  196D       

+196C C9          .     RET              

+196D F5          .     PUSH  AF         

+196E C5          .     PUSH  BC         

+196F 3E 00       >.    LD    A,00       

+1971 06 64       .d    LD    B,64       

+1973 ED 4F       .O    LD    R,A        

+1975 10 FC       ..    DJNZ  1973       

+1977 C1          .     POP   BC         

+1978 F1          .     POP   AF         

+1979 C9          .     RET              

+197A 2A E7 1C    *..   LD    HL,(1CE7)  

+197D ED 4B EB 1C .K..  LD    BC,(1CEB)  

+1981 CD A1 19    ...   CALL  19A1       

+1984 26 00       &.    LD    H,00       

+1986 6B          k     LD    L,E        

+1987 5C          \     LD    E,H        

+1988 E5          .     PUSH  HL         

+1989 CD C9 19    ...   CALL  19C9       

+198C 30 B8       0.    JR    NC,1946    

+198E 7E          ~     LD    A,(HL)     

+198F BA          .     CP    D          

+1990 C4 31 1A    .1.   CALL  NZ,1A31    

+1993 7D          }     LD    A,L        

+1994 C6 03       ..    ADD   A,03       

+1996 6F          o     LD    L,A        

+1997 30 F5       0.    JR    NC,198E    

+1999 E1          .     POP   HL         

+199A 6F          o     LD    L,A        

+199B 24          $     INC   H          

+199C 20 EA        .    JR    NZ,1988    

+199E 1C          .     INC   E          

+199F 18 E7       ..    JR    1988       

+19A1 D5          .     PUSH  DE         

+19A2 79          y     LD    A,C        

+19A3 B7          .     OR    A          

+19A4 28 01       (.    JR    Z,19A7     

+19A6 04          .     INC   B          

+19A7 79          y     LD    A,C        

+19A8 48          H     LD    C,B        

+19A9 47          G     LD    B,A        

+19AA 7A          z     LD    A,D        

+19AB 16 00       ..    LD    D,00       

+19AD 19          .     ADD   HL,DE      

+19AE 11 FF FF    ...   LD    DE,FFFF    

+19B1 ED 53 F1 1C .S..  LD    (1CF1),DE  

+19B5 57          W     LD    D,A        

+19B6 7E          ~     LD    A,(HL)     

+19B7 BA          .     CP    D          

+19B8 C4 31 1A    .1.   CALL  NZ,1A31    

+19BB 7D          }     LD    A,L        

+19BC C6 03       ..    ADD   A,03       

+19BE 6F          o     LD    L,A        

+19BF 30 01       0.    JR    NC,19C2    

+19C1 24          $     INC   H          

+19C2 10 F2       ..    DJNZ  19B6       

+19C4 0D          .     DEC   C          

+19C5 20 EF        .    JR    NZ,19B6    

+19C7 D1          .     POP   DE         

+19C8 C9          .     RET              

+19C9 E5          .     PUSH  HL         

+19CA 6C          l     LD    L,H        

+19CB 63          c     LD    H,E        

+19CC 24          $     INC   H          

+19CD 22 F1 1C    "..   LD    (1CF1),HL  

+19D0 25          %     DEC   H          

+19D1 D5          .     PUSH  DE         

+19D2 55          U     LD    D,L        

+19D3 CB 3C       .<    SLR   H          

+19D5 CB 1D       ..    RR    L          

+19D7 E5          .     PUSH  HL         

+19D8 ED 4B 0D 1D .K..  LD    BC,(1D0D)  

+19DC B7          .     OR    A          

+19DD ED 42       .B    SBC   HL,BC      

+19DF E1          .     POP   HL         

+19E0 30 08       0.    JR    NC,19EA    

+19E2 CD EE 19    ...   CALL  19EE       

+19E5 7A          z     LD    A,D        

+19E6 E6 01       ..    AND   01         

+19E8 B4          .     OR    H          

+19E9 37          7     SCF              

+19EA D1          .     POP   DE         

+19EB E1          .     POP   HL         

+19EC 67          g     LD    H,A        

+19ED C9          .     RET              

+19EE 3A 10 1D    :..   LD    A,(1D10)   

+19F1 CB 7F       ..    BIT   7,A        

+19F3 C2 8D 28    ..(   JP    NZ,288D    

+19F6 CB 3C       .<    SLR   H          

+19F8 CB 1D       ..    RR    L          

+19FA 7D          }     LD    A,L        

+19FB 2A 11 1D    *..   LD    HL,(1D11)  

+19FE 30 02       0.    JR    NC,1A02    

+1A00 CB CC       ..    SET   1,H        

+1A02 2E 00       ..    LD    L,00       

+1A04 C3 8D 28    ..(   JP    288D       

+1A07 21 3F 1D    !?.   LD    HL,1D3F    

+1A0A ED 4B EF 1C .K..  LD    BC,(1CEF)  

+1A0E C3 51 19    .Q.   JP    1951       

+1A11 21 3F 1D    !?.   LD    HL,1D3F    

+1A14 ED 4B EF 1C .K..  LD    BC,(1CEF)  

+1A18 C3 A1 19    ...   JP    19A1       

+1A1B ED 4B ED 1C .K..  LD    BC,(1CED)  

+1A1F ED B0       ..    LDIR             

+1A21 2B          +     DEC   HL         

+1A22 1B          .     DEC   DE         

+1A23 ED 4B ED 1C .K..  LD    BC,(1CED)  

+1A27 1A          .     LD    A,(DE)     

+1A28 ED A9       ..    CPD              

+1A2A 20 FE        .    JR    NZ,1A2A    

+1A2C 1B          .     DEC   DE         

+1A2D EA 27 1A    .'.   JP    PE,1A27    

+1A30 C9          .     RET              

+1A31 F5          .     PUSH  AF         

+1A32 C5          .     PUSH  BC         

+1A33 D5          .     PUSH  DE         

+1A34 E5          .     PUSH  HL         

+1A35 42          B     LD    B,D        

+1A36 4F          O     LD    C,A        

+1A37 ED 5B F1 1C .[..  LD    DE,(1CF1)  

+1A3B CB 7A       .z    BIT   7,D        

+1A3D 28 25       (%    JR    Z,1A64     

+1A3F E5          .     PUSH  HL         

+1A40 EB          .     EX    DE,HL      

+1A41 2A E7 1C    *..   LD    HL,(1CE7)  

+1A44 B7          .     OR    A          

+1A45 ED 52       .R    SBC   HL,DE      

+1A47 E1          .     POP   HL         

+1A48 38 16       8.    JR    C,1A60     

+1A4A E5          .     PUSH  HL         

+1A4B C5          .     PUSH  BC         

+1A4C 11 3F 1D    .?.   LD    DE,1D3F    

+1A4F 2A E7 1C    *..   LD    HL,(1CE7)  

+1A52 CD 1B 1A    ...   CALL  1A1B       

+1A55 C1          .     POP   BC         

+1A56 E1          .     POP   HL         

+1A57 FB          .     EI               

+1A58 3E 00       >.    LD    A,00       

+1A5A CD 66 1A    .f.   CALL  1A66       

+1A5D C3 08 19    ...   JP    1908       

+1A60 3E 00       >.    LD    A,00       

+1A62 18 02       ..    JR    1A66       

+1A64 7A          z     LD    A,D        

+1A65 63          c     LD    H,E        

+1A66 F5          .     PUSH  AF         

+1A67 3E 01       >.    LD    A,01       

+1A69 32 E6 1C    2..   LD    (1CE6),A   

+1A6C 11 D2 85    ...   LD    DE,85D2    

+1A6F 79          y     LD    A,C        

+1A70 CD F5 1C    ...   CALL  1CF5       

+1A73 11 CA 85    ...   LD    DE,85CA    

+1A76 78          x     LD    A,B        

+1A77 CD F5 1C    ...   CALL  1CF5       

+1A7A F1          .     POP   AF         

+1A7B 11 BE 85    ...   LD    DE,85BE    

+1A7E CD F5 1C    ...   CALL  1CF5       

+1A81 7C          |     LD    A,H        

+1A82 CD F5 1C    ...   CALL  1CF5       

+1A85 7D          }     LD    A,L        

+1A86 CD F5 1C    ...   CALL  1CF5       

+1A89 21 B0 85    !..   LD    HL,85B0    

+1A8C CD CA 6E    ..n   CALL  6ECA       

+1A8F 3E 01       >.    LD    A,01       

+1A91 CD 06 1F    ...   CALL  1F06       

+1A94 38 F9       8.    JR    C,1A8F     

+1A96 FE 0D       ..    CP    0D         

+1A98 20 F5        .    JR    NZ,1A8F    

+1A9A E1          .     POP   HL         

+1A9B D1          .     POP   DE         

+1A9C C1          .     POP   BC         

+1A9D F1          .     POP   AF         

+1A9E C9          .     RET              

+1A9F DD 7E 00    .~.   LD    A,(IX+00)  

+1AA2 01 05 00    ...   LD    BC,0005    

+1AA5 DD E5       ..    PUSH  IX         

+1AA7 D5          .     PUSH  DE         

+1AA8 11 00 00    ...   LD    DE,0000    

+1AAB CD A8 28    ..(   CALL  28A8       

+1AAE D1          .     POP   DE         

+1AAF DD E1       ..    POP   IX         

+1AB1 DD 71 03    .q.   LD    (IX+03),C  

+1AB4 DD 70 04    .p.   LD    (IX+04),B  

+1AB7 DD 36 01 00 .6..  LD    (IX+01),00 

+1ABB DD 36 02 00 .6..  LD    (IX+02),00 

+1ABF C9          .     RET              

+1AC0 21 00 A0    !..   LD    HL,A000    

+1AC3 11 00 00    ...   LD    DE,0000    

+1AC6 01 00 00    ...   LD    BC,0000    

+1AC9 DD 7E 00    .~.   LD    A,(IX+00)  

+1ACC DD E5       ..    PUSH  IX         

+1ACE CD 7E 28    .~(   CALL  287E       

+1AD1 DD E1       ..    POP   IX         

+1AD3 0C          .     INC   C          

+1AD4 0D          .     DEC   C          

+1AD5 C8          .     RET   Z          

+1AD6 21 00 A0    !..   LD    HL,A000    

+1AD9 DD 7E 00    .~.   LD    A,(IX+00)  

+1ADC 01 00 00    ...   LD    BC,0000    

+1ADF DD E5       ..    PUSH  IX         

+1AE1 CD 7E 28    .~(   CALL  287E       

+1AE4 DD E1       ..    POP   IX         

+1AE6 0C          .     INC   C          

+1AE7 0D          .     DEC   C          

+1AE8 C8          .     RET   Z          

+1AE9 21 A4 84    !..   LD    HL,84A4    

+1AEC CD CA 6E    ..n   CALL  6ECA       

+1AEF C3 74 15    .t.   JP    1574       

+1AF2 21 00 A0    !..   LD    HL,A000    

+1AF5 06 40       .@    LD    B,40       

+1AF7 3E 1E       >.    LD    A,1E       

+1AF9 77          w     LD    (HL),A     

+1AFA 23          #     INC   HL         

+1AFB 10 FC       ..    DJNZ  1AF9       

+1AFD DD 5E 01    .^.   LD    E,(IX+01)  

+1B00 DD 56 02    .V.   LD    D,(IX+02)  

+1B03 3E 14       >.    LD    A,14       

+1B05 F5          .     PUSH  AF         

+1B06 21 00 A0    !..   LD    HL,A000    

+1B09 01 00 00    ...   LD    BC,0000    

+1B0C DD 7E 00    .~.   LD    A,(IX+00)  

+1B0F DD E5       ..    PUSH  IX         

+1B11 CD 7E 28    .~(   CALL  287E       

+1B14 21 00 A0    !..   LD    HL,A000    

+1B17 06 40       .@    LD    B,40       

+1B19 3E 1E       >.    LD    A,1E       

+1B1B BE          .     CP    (HL)       

+1B1C 20 05        .    JR    NZ,1B23    

+1B1E 23          #     INC   HL         

+1B1F 10 FA       ..    DJNZ  1B1B       

+1B21 0E 1E       ..    LD    C,1E       

+1B23 DD E1       ..    POP   IX         

+1B25 F1          .     POP   AF         

+1B26 0D          .     DEC   C          

+1B27 F2 32 1B    .2.   JP    P,1B32     

+1B2A FE 14       ..    CP    14         

+1B2C C8          .     RET   Z          

+1B2D 21 27 84    !'.   LD    HL,8427    

+1B30 18 4C       .L    JR    1B7E       

+1B32 FE 0A       ..    CP    0A         

+1B34 20 14        .    JR    NZ,1B4A    

+1B36 D5          .     PUSH  DE         

+1B37 F5          .     PUSH  AF         

+1B38 21 00 A0    !..   LD    HL,A000    

+1B3B DD 7E 00    .~.   LD    A,(IX+00)  

+1B3E 11 00 00    ...   LD    DE,0000    

+1B41 DD E5       ..    PUSH  IX         

+1B43 CD 7E 28    .~(   CALL  287E       

+1B46 DD E1       ..    POP   IX         

+1B48 F1          .     POP   AF         

+1B49 D1          .     POP   DE         

+1B4A 3D          =     DEC   A          

+1B4B 20 B8        .    JR    NZ,1B05    

+1B4D 21 FD FF    !..   LD    HL,FFFD    ; -3 ist Markierung f. defekten Bl.

+1B50 22 00 A0    "..   LD    (A000),HL  

+1B53 21 00 A0    !..   LD    HL,A000    

+1B56 11 02 A0    ...   LD    DE,A002    

+1B59 01 FE 01    ...   LD    BC,01FE    

+1B5C ED B0       ..    LDIR             

+1B5E 21 31 84    !1.   LD    HL,8431    

+1B61 3A 30 1D    :0.   LD    A,(1D30)   

+1B64 B7          .     OR    A          

+1B65 20 17        .    JR    NZ,1B7E    

+1B67 CD CA 6E    ..n   CALL  6ECA       

+1B6A 21 77 85    !w.   LD    HL,8577    

+1B6D CD CA 6E    ..n   CALL  6ECA       

+1B70 CD 9B 1C    ...   CALL  1C9B       

+1B73 FE 6E       .n    CP    6E         

+1B75 CA 74 15    .t.   JP    Z,1574     

+1B78 CD E0 1C    ...   CALL  1CE0       

+1B7B C3 F2 1A    ...   JP    1AF2       

+1B7E 3A 30 1D    :0.   LD    A,(1D30)   

+1B81 B7          .     OR    A          

+1B82 28 1B       (.    JR    Z,1B9F     

+1B84 CD A6 1B    ...   CALL  1BA6       

+1B87 21 68 84    !h.   LD    HL,8468    

+1B8A CD CA 6E    ..n   CALL  6ECA       

+1B8D CD 9B 1C    ...   CALL  1C9B       

+1B90 F5          .     PUSH  AF         

+1B91 CD E0 1C    ...   CALL  1CE0       

+1B94 F1          .     POP   AF         

+1B95 FE 79       .y    CP    79         

+1B97 28 02       (.    JR    Z,1B9B     

+1B99 FE 6A       .j    CP    6A         

+1B9B CC 08 1C    ...   CALL  Z,1C08     

+1B9E C9          .     RET              

+1B9F CD A6 1B    ...   CALL  1BA6       

+1BA2 CD E0 1C    ...   CALL  1CE0       

+1BA5 C9          .     RET              

+1BA6 E5          .     PUSH  HL         

+1BA7 21 91 85    !..   LD    HL,8591    

+1BAA DD 7E 00    .~.   LD    A,(IX+00)  

+1BAD B7          .     OR    A          

+1BAE 28 03       (.    JR    Z,1BB3     

+1BB0 21 95 85    !..   LD    HL,8595    

+1BB3 CD CA 6E    ..n   CALL  6ECA       

+1BB6 E1          .     POP   HL         

+1BB7 C3 CA 6E    ..n   JP    6ECA       

+1BBA DD 5E 01    .^.   LD    E,(IX+01)  

+1BBD DD 56 02    .V.   LD    D,(IX+02)  

+1BC0 DD 6E 03    .n.   LD    L,(IX+03)  

+1BC3 DD 66 04    .f.   LD    H,(IX+04)  

+1BC6 13          .     INC   DE         

+1BC7 DD 73 01    .s.   LD    (IX+01),E  

+1BCA DD 72 02    .r.   LD    (IX+02),D  

+1BCD B7          .     OR    A          

+1BCE ED 52       .R    SBC   HL,DE      

+1BD0 C9          .     RET              

+1BD1 DD 5E 01    .^.   LD    E,(IX+01)  

+1BD4 DD 56 02    .V.   LD    D,(IX+02)  

+1BD7 21 20 20    !     LD    HL,2020    

+1BDA 22 26 1D    "&.   LD    (1D26),HL  

+1BDD 22 28 1D    "(.   LD    (1D28),HL  

+1BE0 21 25 1D    !%.   LD    HL,1D25    

+1BE3 CD 00 4E    ..N   CALL  4E00       

+1BE6 21 22 1D    !".   LD    HL,1D22    

+1BE9 CD CA 6E    ..n   CALL  6ECA       

+1BEC C9          .     RET              

+1BED DD 5E 01    .^.   LD    E,(IX+01)  

+1BF0 DD 56 02    .V.   LD    D,(IX+02)  

+1BF3 21 00 A0    !..   LD    HL,A000    

+1BF6 01 00 00    ...   LD    BC,0000    

+1BF9 DD 7E 00    .~.   LD    A,(IX+00)  

+1BFC DD E5       ..    PUSH  IX         

+1BFE CD 7E 28    .~(   CALL  287E       

+1C01 DD E1       ..    POP   IX         

+1C03 78          x     LD    A,B        

+1C04 B1          .     OR    C          

+1C05 20 20             JR    NZ,1C27    

+1C07 C9          .     RET              

+1C08 06 05       ..    LD    B,05       

+1C0A C5          .     PUSH  BC         

+1C0B 21 00 A0    !..   LD    HL,A000    

+1C0E DD 5E 01    .^.   LD    E,(IX+01)  

+1C11 DD 56 02    .V.   LD    D,(IX+02)  

+1C14 01 00 00    ...   LD    BC,0000    

+1C17 DD 7E 00    .~.   LD    A,(IX+00)  

+1C1A DD E5       ..    PUSH  IX         

+1C1C CD 81 28    ..(   CALL  2881       

+1C1F DD E1       ..    POP   IX         

+1C21 79          y     LD    A,C        

+1C22 B0          .     OR    B          

+1C23 C1          .     POP   BC         

+1C24 C8          .     RET   Z          

+1C25 10 E3       ..    DJNZ  1C0A       

+1C27 21 08 84    !..   LD    HL,8408    

+1C2A CD A6 1B    ...   CALL  1BA6       

+1C2D CD E0 1C    ...   CALL  1CE0       

+1C30 C9          .     RET              

+1C31 F5          .     PUSH  AF         

+1C32 CD 59 1C    .Y.   CALL  1C59       

+1C35 CD 08 1C    ...   CALL  1C08       

+1C38 3E 0F       >.    LD    A,0F       

+1C3A CD 59 1C    .Y.   CALL  1C59       

+1C3D CD ED 1B    ...   CALL  1BED       

+1C40 F1          .     POP   AF         

+1C41 21 00 A0    !..   LD    HL,A000    

+1C44 01 00 02    ...   LD    BC,0200    

+1C47 ED A1       ..    CPI              

+1C49 20 04        .    JR    NZ,1C4F    

+1C4B EA 92 1C    ...   JP    PE,1C92    

+1C4E C9          .     RET              

+1C4F 21 16 84    !..   LD    HL,8416    

+1C52 CD CA 6E    ..n   CALL  6ECA       

+1C55 CD E0 1C    ...   CALL  1CE0       

+1C58 C9          .     RET              

+1C59 21 00 A0    !..   LD    HL,A000    

+1C5C 11 01 A0    ...   LD    DE,A001    

+1C5F 01 FF 01    ...   LD    BC,01FF    

+1C62 77          w     LD    (HL),A     

+1C63 ED B0       ..    LDIR             

+1C65 C9          .     RET              ; ---- Korrekten Block 0 testen

+1C66 21 00 A0    !..   LD    HL,A000    

+1C69 11 2A 1D    .*.   LD    DE,1D2A    ; "EUMEL-"

+1C6C 01 06 00    ...   LD    BC,0006    

+1C6F CD 92 1C    ...   CALL  1C92       

+1C72 20 12        .    JR    NZ,1C86    ; "HG-ungueltig"

+1C74 21 09 A0    !..   LD    HL,A009    

+1C77 11 86 82    ...   LD    DE,8286    ; 

+1C7A 01 02 00    ...   LD    BC,0002    

+1C7D CD 92 1C    ...   CALL  1C92       ; Versionsnummer

+1C80 C8          .     RET   Z          

+1C81 21 93 84    !..   LD    HL,8493    ; "Falsche Version"

+1C84 18 03       ..    JR    1C89       

+1C86 21 85 84    !..   LD    HL,8485    

+1C89 CD CA 6E    ..n   CALL  6ECA       

+1C8C CD 9B 1C    ...   CALL  1C9B       

+1C8F C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+1C92 1A          .     LD    A,(DE)     ; Zeichenkette vergleichen

+1C93 13          .     INC   DE         

+1C94 ED A1       ..    CPI              

+1C96 C0          .     RET   NZ         

+1C97 EA 92 1C    ...   JP    PE,1C92    

+1C9A C9          .     RET              ;----------- Auf Taste warten > A --

+1C9B 3E 01       >.    LD    A,01       ; Kanal 1

+1C9D CD 06 1F    ...   CALL  1F06       ; Auf Taste warten

+1CA0 38 F9       8.    JR    C,1C9B     ; Warten!

+1CA2 FE 1B       ..    CP    1B         ; ESC

+1CA4 CA 74 15    .t.   JP    Z,1574     ; Zum Vortest Menue

+1CA7 FE 20       .     CP    20         ; 

+1CA9 D8          .     RET   C          ; < Blank zurueck

+1CAA 32 1E 1D    2..   LD    (1D1E),A   

+1CAD F5          .     PUSH  AF         

+1CAE 21 1D 1D    !..   LD    HL,1D1D    ; CRLF

+1CB1 CD CA 6E    ..n   CALL  6ECA       ; ausgeben

+1CB4 F1          .     POP   AF         

+1CB5 C9          .     RET              ;----- incharety an Kanal 1

+1CB6 3E 01       >.    LD    A,01       

+1CB8 CD 06 1F    ...   CALL  1F06       ; 

+1CBB D8          .     RET   C          ; Wenn nichts da ist

+1CBC FE 1B       ..    CP    1B         

+1CBE CA 74 15    .t.   JP    Z,1574     ; ESC --> Zum Vortest Menue

+1CC1 C9          .     RET              ; -------- Zaehlpuffer loeschen

+1CC2 21 20 20    !     LD    HL,2020    

+1CC5 22 AA 85    "..   LD    (85AA),HL  

+1CC8 22 AC 85    "..   LD    (85AC),HL  

+1CCB ED 5B F3 1C .[..  LD    DE,(1CF3)  

+1CCF 13          .     INC   DE         

+1CD0 ED 53 F3 1C .S..  LD    (1CF3),DE  

+1CD4 21 A9 85    !..   LD    HL,85A9    

+1CD7 CD 00 4E    ..N   CALL  4E00       ; Dezimal -- ASCII Konvertiereung

+1CDA 21 9D 85    !..   LD    HL,859D    ; Puffer ausgeben

+1CDD C3 CA 6E    ..n   JP    6ECA       

+1CE0 21 16 1D    !..   LD    HL,1D16    ; CRLF ausgeben

+1CE3 C3 CA 6E    ..n   JP    6ECA

+1CE6 00          .     NOP              

+1CE7 00          .     NOP              

+1CE8 00          .     NOP              

+1CE9 00          .     NOP              

+1CEA 00          .     NOP              

+1CEB 00          .     NOP              

+1CEC 00          .     NOP              

+1CED 00          .     NOP              

+1CEE 00          .     NOP              

+1CEF 00          .     NOP              

+1CF0 00          .     NOP              

+1CF1 00          .     NOP              

+1CF2 00          .     NOP              

+1CF3 00          .     NOP              

+1CF4 00          .     NOP              

+1CF5 F5          .     PUSH  AF         ;- Byte in A Hex --> (DE),(DE+1)

+1CF6 0F          .     RRCA             

+1CF7 0F          .     RRCA             

+1CF8 0F          .     RRCA             

+1CF9 0F          .     RRCA             

+1CFA CD FE 1C    ...   CALL  1CFE       

+1CFD F1          .     POP   AF         

+1CFE E6 0F       ..    AND   0F         

+1D00 C6 30       .0    ADD   A,30       

+1D02 FE 3A       .:    CP    3A         

+1D04 38 02       8.    JR    C,1D08     

+1D06 C6 07       ..    ADD   A,07       

+1D08 12          .     LD    (DE),A     

+1D09 13          .     INC   DE         

+1D0A C9          .     RET              ; ------ Zeichentexte ------

+1D0B 01 2A 00    .*.   LD    BC,002A    ; "*" Laenge 1

+1D0E 00          .     NOP              

+1D0F 00          .     NOP              

+1D10 00          .     NOP              

+1D11 00          .     NOP              

+1D12 00          .     NOP              

+1D13 00          .     NOP              

+1D14 01 20 02    . .   LD    BC,0220    ; Blank

+1D17 0A          .     LD    A,(BC)     ; CRLF

+1D18 0D          .     DEC   C          

+1D19 03          .     INC   BC         ; ", 1"

+1D1A 2C          ,     INC   L          

+1D1B 20 31        1    JR    NZ,1D4E    

+1D1D 04          .     INC   B          ; Blank, CR, LF,LF

+1D1E 20 0D        .    JR    NZ,1D2D    

+1D20 0A          .     LD    A,(BC)     

+1D21 0A          .     LD    A,(BC)     

+1D22 07          .     RLCA             ; CR, "#     "

+1D23 0D          .     DEC   C          

+1D24 23          #     INC   HL         

+1D25 20 20             JR    NZ,1D47    

+1D27 20 20             JR    NZ,1D49    

+1D29 20 45        E    JR    NZ,1D70    ; "EUMEL-" HG Kennzeichen

+1D2B 55          U     LD    D,L        

+1D2C 4D          M     LD    C,L        

+1D2D 45          E     LD    B,L        

+1D2E 4C          L     LD    C,H        

+1D2F 2D          -     DEC   L          

+1D30 00          .     NOP              

+1D31 00          .     NOP              ; Harddisk Descriptor

+1D32 00          .     NOP              

+1D33 00          .     NOP              

+1D34 00          .     NOP              

+1D35 00          .     NOP              

+1D36 1F          .     RRA              ; Floppy Descriptor

+1D37 00          .     NOP              

+1D38 00          .     NOP              

+1D39 00          .     NOP              

+1D3A 00          .     NOP              

+1D3B 00          .     NOP              

+1D3C 00          .     NOP              

+1D3D 00          .     NOP              

+1D3E 00          .     NOP              

+1D3F FF          .     RST   38         ; ====== Ende des nichtresidenten

+1D40 FF          .     RST   38         ; EUMEL0 Teils ==================

+1D41 FF          .     RST   38         

+1D42 FF          .     RST   38         

+1D43 FF          .     RST   38         

+1D44 FF          .     RST   38         

+1D45 FF          .     RST   38         

+1D46 FF          .     RST   38         

+1D47 FF          .     RST   38         

+1D48 FF          .     RST   38         

+1D49 FF          .     RST   38         

+1D4A FF          .     RST   38         

+1D4B FF          .     RST   38         

+1D4C FF          .     RST   38         

+1D4D FF          .     RST   38         

+1D4E FF          .     RST   38         

+1D4F FF          .     RST   38         

+1D50 FF          .     RST   38         

+1D51 FF          .     RST   38         

+1D52 FF          .     RST   38         

+1D53 FF          .     RST   38         

+1D54 FF          .     RST   38         

+1D55 FF          .     RST   38         

+1D56 FF          .     RST   38         

+1D57 FF          .     RST   38         

+1D58 FF          .     RST   38         

+1D59 FF          .     RST   38         

+1D5A FF          .     RST   38         

+1D5B FF          .     RST   38         

+1D5C FF          .     RST   38         

+1D5D FF          .     RST   38         

+1D5E FF          .     RST   38         

+1D5F FF          .     RST   38         

+1D60 FF          .     RST   38         

+1D61 FF          .     RST   38         

+1D62 FF          .     RST   38         

+1D63 FF          .     RST   38         

+1D64 FF          .     RST   38         

+1D65 FF          .     RST   38         

+1D66 FF          .     RST   38         

+1D67 FF          .     RST   38         

+1D68 FF          .     RST   38         

+1D69 FF          .     RST   38         

+1D6A FF          .     RST   38         

+1D6B FF          .     RST   38         

+1D6C FF          .     RST   38         

+1D6D FF          .     RST   38         

+1D6E FF          .     RST   38         

+1D6F FF          .     RST   38         

+1D70 FF          .     RST   38         

+1D71 FF          .     RST   38         

+1D72 FF          .     RST   38         

+1D73 FF          .     RST   38         

+1D74 FF          .     RST   38         

+1D75 FF          .     RST   38         

+1D76 FF          .     RST   38         

+1D77 FF          .     RST   38         

+1D78 FF          .     RST   38         

+1D79 FF          .     RST   38         

+1D7A FF          .     RST   38         

+1D7B FF          .     RST   38         

+1D7C FF          .     RST   38         

+1D7D FF          .     RST   38         

+1D7E FF          .     RST   38         

+1D7F FF          .     RST   38         

+1D80 FF          .     RST   38         

+1D81 FF          .     RST   38         

+1D82 FF          .     RST   38         

+1D83 FF          .     RST   38         

+1D84 FF          .     RST   38         

+1D85 FF          .     RST   38         

+1D86 FF          .     RST   38         

+1D87 FF          .     RST   38         

+1D88 FF          .     RST   38         

+1D89 FF          .     RST   38         

+1D8A FF          .     RST   38         

+1D8B FF          .     RST   38         

+1D8C FF          .     RST   38         

+1D8D FF          .     RST   38         

+1D8E FF          .     RST   38         

+1D8F FF          .     RST   38         

+1D90 FF          .     RST   38         

+1D91 FF          .     RST   38         

+1D92 FF          .     RST   38         

+1D93 FF          .     RST   38         

+1D94 FF          .     RST   38         

+1D95 FF          .     RST   38         

+1D96 FF          .     RST   38         

+1D97 FF          .     RST   38         

+1D98 FF          .     RST   38         

+1D99 FF          .     RST   38         

+1D9A FF          .     RST   38         

+1D9B FF          .     RST   38         

+1D9C FF          .     RST   38         

+1D9D FF          .     RST   38         

+1D9E FF          .     RST   38         

+1D9F FF          .     RST   38         

+1DA0 FF          .     RST   38         

+1DA1 FF          .     RST   38         

+1DA2 FF          .     RST   38         

+1DA3 FF          .     RST   38         

+1DA4 FF          .     RST   38         

+1DA5 FF          .     RST   38         

+1DA6 FF          .     RST   38         

+1DA7 FF          .     RST   38         

+1DA8 FF          .     RST   38         

+1DA9 FF          .     RST   38         

+1DAA FF          .     RST   38         

+1DAB FF          .     RST   38         

+1DAC FF          .     RST   38         

+1DAD FF          .     RST   38         

+1DAE FF          .     RST   38         

+1DAF FF          .     RST   38         

+1DB0 FF          .     RST   38         

+1DB1 FF          .     RST   38         

+1DB2 FF          .     RST   38         

+1DB3 FF          .     RST   38         

+1DB4 FF          .     RST   38         

+1DB5 FF          .     RST   38         

+1DB6 FF          .     RST   38         

+1DB7 FF          .     RST   38         

+1DB8 FF          .     RST   38         

+1DB9 FF          .     RST   38         

+1DBA FF          .     RST   38         

+1DBB FF          .     RST   38         

+1DBC FF          .     RST   38         

+1DBD FF          .     RST   38         

+1DBE FF          .     RST   38         

+1DBF FF          .     RST   38         

+1DC0 FF          .     RST   38         

+1DC1 FF          .     RST   38         

+1DC2 FF          .     RST   38         

+1DC3 FF          .     RST   38         

+1DC4 FF          .     RST   38         

+1DC5 FF          .     RST   38         

+1DC6 FF          .     RST   38         

+1DC7 FF          .     RST   38         

+1DC8 FF          .     RST   38         

+1DC9 FF          .     RST   38         

+1DCA FF          .     RST   38         

+1DCB FF          .     RST   38         

+1DCC FF          .     RST   38         

+1DCD FF          .     RST   38         

+1DCE FF          .     RST   38         

+1DCF FF          .     RST   38         

+1DD0 FF          .     RST   38         

+1DD1 FF          .     RST   38         

+1DD2 FF          .     RST   38         

+1DD3 FF          .     RST   38         

+1DD4 FF          .     RST   38         

+1DD5 FF          .     RST   38         

+1DD6 FF          .     RST   38         

+1DD7 FF          .     RST   38         

+1DD8 FF          .     RST   38         

+1DD9 FF          .     RST   38         

+1DDA FF          .     RST   38         

+1DDB FF          .     RST   38         

+1DDC FF          .     RST   38         

+1DDD FF          .     RST   38         

+1DDE FF          .     RST   38         

+1DDF FF          .     RST   38         

+1DE0 FF          .     RST   38         

+1DE1 FF          .     RST   38         

+1DE2 FF          .     RST   38         

+1DE3 FF          .     RST   38         

+1DE4 FF          .     RST   38         

+1DE5 FF          .     RST   38         

+1DE6 FF          .     RST   38         

+1DE7 FF          .     RST   38         

+1DE8 FF          .     RST   38         

+1DE9 FF          .     RST   38         

+1DEA FF          .     RST   38         

+1DEB FF          .     RST   38         

+1DEC FF          .     RST   38         

+1DED FF          .     RST   38         

+1DEE FF          .     RST   38         

+1DEF FF          .     RST   38         

+1DF0 FF          .     RST   38         

+1DF1 FF          .     RST   38         

+1DF2 FF          .     RST   38         

+1DF3 FF          .     RST   38         

+1DF4 FF          .     RST   38         

+1DF5 FF          .     RST   38         

+1DF6 FF          .     RST   38         

+1DF7 FF          .     RST   38         

+1DF8 FF          .     RST   38         

+1DF9 FF          .     RST   38         

+1DFA FF          .     RST   38         

+1DFB FF          .     RST   38         

+1DFC FF          .     RST   38         

+1DFD FF          .     RST   38         

+1DFE FF          .     RST   38         

+1DFF FF          .     RST   38         

+1E00 FF          .     RST   38         ; ======= Residenter EUMEL0 =======

+1E01 FF          .     RST   38         ; DR EIntrag des DRDR

+1E02 FF          .     RST   38         

+1E03 FF          .     RST   38         

+1E04 FF          .     RST   38         

+1E05 FF          .     RST   38         

+1E06 FF          .     RST   38         

+1E07 FF          .     RST   38         

+1E08 FF          .     RST   38         

+1E09 FF          .     RST   38         

+1E0A FF          .     RST   38         

+1E0B FF          .     RST   38         

+1E0C FF          .     RST   38         

+1E0D FF          .     RST   38         

+1E0E FF          .     RST   38         

+1E0F FF          .     RST   38         ; ---------- 173 Leiste ---------

+1E10 C3 DF 28    ..(   JP    28DF       ; systemstart 173

+1E13 C3 71 1F    .q.   JP    1F71       ; inputinterrupt

+1E16 C3 35 6E    .5n   JP    6E35       ; timerinterrupt

+1E19 C3 E2 6D    ..m   JP    6DE2       ; warte

+1E1C C3 22 1E    .".   JP    1E22       ; frei eumel0 (nur 173)

+1E1F C3 1F 70    ..p   JP    701F       ; info (Text uebergeben)

+1E22 3A 6D 28    :m(   LD    A,(286D)   ;----------- frei eumel0 ---------

+1E25 CB C7       ..    SET   0,A        ; MODE Bit 0 setzen

+1E27 32 6D 28    2m(   LD    (286D),A   

+1E2A C9          .     RET              ;--------------------------------

+1E2B FF          .     RST   38         

+1E2C FF          .     RST   38         

+1E2D FF          .     RST   38         

+1E2E FF          .     RST   38         

+1E2F FF          .     RST   38         

+1E30 FF          .     RST   38         

+1E31 FF          .     RST   38         

+1E32 FF          .     RST   38         

+1E33 FF          .     RST   38         

+1E34 FF          .     RST   38         

+1E35 FF          .     RST   38         

+1E36 FF          .     RST   38         

+1E37 FF          .     RST   38         

+1E38 FF          .     RST   38         

+1E39 FF          .     RST   38         

+1E3A FF          .     RST   38         

+1E3B FF          .     RST   38         

+1E3C FF          .     RST   38         

+1E3D FF          .     RST   38         

+1E3E FF          .     RST   38         

+1E3F FF          .     RST   38         

+1E40 FF          .     RST   38         

+1E41 FF          .     RST   38         

+1E42 FF          .     RST   38         

+1E43 FF          .     RST   38         

+1E44 FF          .     RST   38         

+1E45 FF          .     RST   38         

+1E46 FF          .     RST   38         

+1E47 FF          .     RST   38         

+1E48 FF          .     RST   38         

+1E49 FF          .     RST   38         

+1E4A FF          .     RST   38         

+1E4B 74          t     LD    (HL),H     ; "trmnet  10 (!)"

+1E4C 72          r     LD    (HL),D     

+1E4D 6D          m     LD    L,L        

+1E4E 6E          n     LD    L,(HL)     

+1E4F 65          e     LD    H,L        

+1E50 74          t     LD    (HL),H     

+1E51 20 20             JR    NZ,1E73    

+1E53 31 30 20    10    LD    SP,2030    

+1E56 28 21       (!    JR    Z,1E79     

+1E58 29          )     ADD   HL,HL      ;---------- intern frout ---------

+1E59 FE 11       ..    CP    11

+1E5B D0          .     RET   NC         

+1E5C E5          .     PUSH  HL         

+1E5D CD EB 23    ..#   CALL  23EB       

+1E60 CB 5E       .^    BIT   3,(HL)     

+1E62 E1          .     POP   HL         

+1E63 28 02       (.    JR    Z,1E67     

+1E65 97          .     SUB   A          ; Ist Stop-Taste gedrueckt

+1E66 C9          .     RET              

+1E67 C5          .     PUSH  BC         ; Weiter gedrueckt

+1E68 01 02 00    ...   LD    BC,0002    ; IOCONTROL frout

+1E6B CD A8 28    ..(   CALL  28A8       

+1E6E 79          y     LD    A,C        

+1E6F C1          .     POP   BC         

+1E70 C9          .     RET              ;-------- intern typ --------------

+1E71 32 B8 26    2.&   LD    (26B8),A   

+1E74 C5          .     PUSH  BC         

+1E75 01 01 00    ...   LD    BC,0001    ; IOCONTROL typ

+1E78 CD A8 28    ..(   CALL  28A8       

+1E7B 79          y     LD    A,C        

+1E7C E6 03       ..    AND   03         

+1E7E FE 03       ..    CP    03         

+1E80 C1          .     POP   BC         

+1E81 3A B8 26    :.&   LD    A,(26B8)   

+1E84 C9          .     RET              ; ---------- cursorpos --> BC ---

+1E85 FE 11       ..    CP    11         

+1E87 D0          .     RET   NC         

+1E88 E5          .     PUSH  HL         

+1E89 CD EB 23    ..#   CALL  23EB       ; Kanaltabellenaddresse

+1E8C 01 02 00    ...   LD    BC,0002    

+1E8F 09          .     ADD   HL,BC      

+1E90 4E          N     LD    C,(HL)     

+1E91 23          #     INC   HL         

+1E92 46          F     LD    B,(HL)     

+1E93 E1          .     POP   HL         

+1E94 B7          .     OR    A          

+1E95 C9          .     RET              ;----------------------------------

+1E96 DD 7E 04    .~.   LD    A,(IX+04)  ; Grosser Puffer leer ?

+1E99 D6 01       ..    SUB   A,01       

+1E9B 30 0B       0.    JR    NC,1EA8    

+1E9D DD 7E 0B    .~.   LD    A,(IX+0B)  

+1EA0 D6 01       ..    SUB   A,01       

+1EA2 30 04       0.    JR    NC,1EA8    

+1EA4 CD E4 1E    ...   CALL  1EE4       ; IOCONTROL weiter

+1EA7 37          7     SCF              

+1EA8 C1          .     POP   BC         

+1EA9 DD E1       ..    POP   IX         

+1EAB E1          .     POP   HL         

+1EAC C9          .     RET              ;---------------------------------

+1EAD FE 11       ..    CP    11         

+1EAF 3F          ?     CCF              

+1EB0 D8          .     RET   C          

+1EB1 E5          .     PUSH  HL         

+1EB2 DD E5       ..    PUSH  IX         

+1EB4 C5          .     PUSH  BC         

+1EB5 32 AC 26    2.&   LD    (26AC),A   

+1EB8 CD FA 23    ..#   CALL  23FA       

+1EBB 3A A9 26    :.&   LD    A,(26A9)   

+1EBE B7          .     OR    A          

+1EBF 28 11       (.    JR    Z,1ED2     

+1EC1 F5          .     PUSH  AF         

+1EC2 97          .     SUB   A          

+1EC3 32 A9 26    2.&   LD    (26A9),A   

+1EC6 F1          .     POP   AF         

+1EC7 28 09       (.    JR    Z,1ED2     

+1EC9 CD 1F 70    ..p   CALL  701F       

+1ECC 18 04       ..    JR    1ED2       

+1ECE 20 69        i    JR    NZ,1F39    ; Info aufrufen

+1ED0 6E          n     LD    L,(HL)     ; " int"

+1ED1 74          t     LD    (HL),H     

+1ED2 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+1ED6 CB 6E       .n    BIT   5,(HL)     

+1ED8 20 BC        .    JR    NZ,1E96    ; Grosser Puffer

+1EDA DD 7E 04    .~.   LD    A,(IX+04)  ; Kleiner Puffer leer ?

+1EDD FE 07       ..    CP    07         

+1EDF 28 15       (.    JR    Z,1EF6     

+1EE1 B7          .     OR    A          

+1EE2 18 51       .Q    JR    1F35       

+1EE4 3A AC 26    :.&   LD    A,(26AC)   ;---------- intern weiter --------

+1EE7 01 04 00    ...   LD    BC,0004    ; IOCONTROL weiter

+1EEA C3 A8 28    ..(   JP    28A8       

+1EED C5          .     PUSH  BC         ;---------- intern stop -----------

+1EEE 01 03 00    ...   LD    BC,0003    

+1EF1 CD A8 28    ..(   CALL  28A8       ; IOCONTORL stop

+1EF4 C1          .     POP   BC         

+1EF5 C9          .     RET              ;----------------------------------

+1EF6 CD E4 1E    ...   CALL  1EE4       ; CALL weiter

+1EF9 DD 7E 04    .~.   LD    A,(IX+04)  ;

+1EFC FE 07       ..    CP    07         

+1EFE 28 03       (.    JR    Z,1F03     ; Puffer leer ?

+1F00 B7          .     OR    A          

+1F01 18 32       .2    JR    1F35       ; Routine mit CLC verlassen 

+1F03 37          7     SCF              

+1F04 18 2F       ./    JR    1F35       ; ROutine mit SEC verlassen

+1F06 CD AD 1E    ...   CALL  1EAD       ;---------------------------------

+1F09 D8          .     RET   C          

+1F0A E5          .     PUSH  HL         

+1F0B DD E5       ..    PUSH  IX         

+1F0D C5          .     PUSH  BC         

+1F0E DD 2A AD 26 .*.&  LD    IX,(26AD)  

+1F12 DD 7E 07    .~.   LD    A,(IX+07)  

+1F15 DD CB 00 6E ...n  BIT   5,(IX+00)  

+1F19 20 1F        .    JR    NZ,1F3A    

+1F1B 2A AD 26    *.&   LD    HL,(26AD)  

+1F1E 01 07 00    ...   LD    BC,0007    

+1F21 09          .     ADD   HL,BC      

+1F22 D5          .     PUSH  DE         

+1F23 54          T     LD    D,H        

+1F24 5D          ]     LD    E,L        

+1F25 23          #     INC   HL         

+1F26 01 0F 00    ...   LD    BC,000F    

+1F29 F3          .     DI               

+1F2A ED B0       ..    LDIR             

+1F2C DD 35       .5    DEC   (IX+04)    

+1F2E 04          .     INC   B          

+1F2F DD 35       .5    DEC   (IX+05)    

+1F31 05          .     DEC   B          

+1F32 FB          .     EI               

+1F33 D1          .     POP   DE         

+1F34 B7          .     OR    A          

+1F35 C1          .     POP   BC         

+1F36 DD E1       ..    POP   IX         

+1F38 E1          .     POP   HL         

+1F39 C9          .     RET              

+1F3A 67          g     LD    H,A        ; Pufferaddresse

+1F3B DD 6E 0C    .n.   LD    L,(IX+0C)  ; Pufferaddresse 

+1F3E CD 81 5A    ..Z   CALL  5A81       

+1F41 DD 7E 05    .~.   LD    A,(IX+05)  ; Lowbyte Schreibzeiger

+1F44 3C          <     INC   A          

+1F45 DD 77 05    .w.   LD    (IX+05),A

+1F48 20 03        .    JR    NZ,1F4D    

+1F4A DD 34       .4    INC   (IX+0A)    ; Highbyte Schreibzeiger

+1F4C 0A          .     LD    A,(BC)     

+1F4D 6F          o     LD    L,A        

+1F4E DD 7E 0A    .~.   LD    A,(IX+0A)  

+1F51 E6 01       ..    AND   01         

+1F53 84          .     ADD   H          

+1F54 67          g     LD    H,A        

+1F55 7E          ~     LD    A,(HL)     

+1F56 F5          .     PUSH  AF         

+1F57 CD 8C 5A    ..Z   CALL  5A8C       

+1F5A F3          .     DI               

+1F5B DD 6E 04    .n.   LD    L,(IX+04)  ; Jetzt darf kein Inputinter. komm.

+1F5E DD 66 0B    .f.   LD    H,(IX+0B)  

+1F61 2B          +     DEC   HL         

+1F62 DD 74 0B    .t.   LD    (IX+0B),H  

+1F65 DD 75 04    .u.   LD    (IX+04),L  

+1F68 FB          .     EI               

+1F69 7D          }     LD    A,L        

+1F6A B7          .     OR    A          

+1F6B CC E4 1E    ...   CALL  Z,1EE4     ; CALL weiter

+1F6E F1          .     POP   AF         

+1F6F 18 C3       ..    JR    1F34       ;=========== inputinterrupt =======

+1F71 FE 11       ..    CP    11         ; B=Eingabezeichen

+1F73 D0          .     RET   NC         ; C=Errorbits

+1F74 DD E5       ..    PUSH  IX         

+1F76 E5          .     PUSH  HL         

+1F77 F5          .     PUSH  AF         

+1F78 CD EB 23    ..#   CALL  23EB       ; Kanaltabelleaddresse

+1F7B E5          .     PUSH  HL         

+1F7C DD E1       ..    POP   IX         

+1F7E CB B9       ..    RES   7,C        ; 

+1F80 CB A9       ..    RES   5,C        ; Pufferoverflowbit

+1F82 DD 7E 01    .~.   LD    A,(IX+01)  

+1F85 B1          .     OR    C          ; Mit Bits vom Shard verodern 

+1F86 DD 77 01    .w.   LD    (IX+01),A  

+1F89 CB 7F       ..    BIT   7,A        

+1F8B 28 0A       (.    JR    Z,1F97     

+1F8D E5          .     PUSH  HL         

+1F8E DD CB 01 F6 ....  SET   6,(IX+01)  

+1F92 21 A9 26    !.&   LD    HL,26A9    

+1F95 34          4     INC   (HL)       

+1F96 E1          .     POP   HL         

+1F97 DD CB 01 FE ....  SET   7,(IX+01)  

+1F9B CB 6E       .n    BIT   5,(HL)     ; Grosser Puffer ?

+1F9D 28 6F       (o    JR    Z,200E     

+1F9F DD 7E 0B    .~.   LD    A,(IX+0B)  ; ja

+1FA2 FE 01       ..    CP    01         

+1FA4 38 0E       8.    JR    C,1FB4     ; < 1 (=0) : Nicht voll

+1FA6 20 3A        :    JR    NZ,1FE2    ; > 1 (=2) : Voll

+1FA8 DD 7E 04    .~.   LD    A,(IX+04)  ; = 180 ,

+1FAB FE 80       ..    CP    80         ; Puffer 3/4b voll Hysterese Stop

+1FAD 20 05        .    JR    NZ,1FB4    

+1FAF F1          .     POP   AF         

+1FB0 F5          .     PUSH  AF         

+1FB1 CD ED 1E    ...   CALL  1EED       ; CALL stop

+1FB4 DD 34       .4    INC   (IX+04)    

+1FB6 04          .     INC   B          

+1FB7 20 03        .    JR    NZ,1FBC    

+1FB9 DD 34       .4    INC   (IX+0B)    

+1FBB 0B          .     DEC   BC         

+1FBC DD 66 07    .f.   LD    H,(IX+07)  

+1FBF DD 6E 0C    .n.   LD    L,(IX+0C)  

+1FC2 78          x     LD    A,B        

+1FC3 C5          .     PUSH  BC         

+1FC4 F5          .     PUSH  AF         

+1FC5 CD 81 5A    ..Z   CALL  5A81       

+1FC8 DD 7E 08    .~.   LD    A,(IX+08)  

+1FCB 3C          <     INC   A          

+1FCC DD 77 08    .w.   LD    (IX+08),A  

+1FCF 6F          o     LD    L,A        

+1FD0 20 03        .    JR    NZ,1FD5    

+1FD2 DD 34       .4    INC   (IX+09)    

+1FD4 09          .     ADD   HL,BC      

+1FD5 DD 7E 09    .~.   LD    A,(IX+09)  

+1FD8 E6 01       ..    AND   01         

+1FDA 84          .     ADD   H          

+1FDB 67          g     LD    H,A        

+1FDC F1          .     POP   AF         

+1FDD 77          w     LD    (HL),A     

+1FDE CD 8C 5A    ..Z   CALL  5A8C       

+1FE1 C1          .     POP   BC         

+1FE2 DD CB 01 EE ....  SET   5,(IX+01)  ; Pufferoverflow setzen

+1FE6 F1          .     POP   AF         

+1FE7 21 AB 26    !.&   LD    HL,26AB    

+1FEA CB B6       ..    RES   6,(HL)     

+1FEC DD CB 01 BE ....  RES   7,(IX+01)  

+1FF0 FB          .     EI               

+1FF1 DD CB 00 6E ...n  BIT   5,(IX+00)  ; Gro�er Puffer ?

+1FF5 20 09        .    JR    NZ,2000    

+1FF7 3E 17       >.    LD    A,17       ; Pufferende-Lesezeiger

+1FF9 DD 96 04    ...   SUB   (IX+04)    ; Platz im Puffer

+1FFC E1          .     POP   HL         

+1FFD DD E1       ..    POP   IX         

+1FFF C9          .     RET              ;----------- Ende von inputinterr.

+2000 DD 7E 0B    .~.   LD    A,(IX+0B)  

+2003 B7          .     OR    A          

+2004 3E FF       >.    LD    A,FF       

+2006 28 F4       (.    JR    Z,1FFC     

+2008 97          .     SUB   A          

+2009 DD 96 04    ...   SUB   (IX+04)    

+200C 18 EE       ..    JR    1FFC       

+200E F1          .     POP   AF         ;------ kleiner Puffer ------------

+200F F5          .     PUSH  AF         

+2010 CD 95 26    ..&   CALL  2695       ; Typtabellennummer

+2013 FE 7E       .~    CP    7E         ; psi ?

+2015 20 29        )    JR    NZ,2040    

+2017 78          x     LD    A,B        ; info-Taste

+2018 FE 04       ..    CP    04         

+201A 28 18       (.    JR    Z,2034       

+201C FE 07       ..    CP    07         ; SV-Call

+201E 28 1A       (.    JR    Z,203A     

+2020 FE 11       ..    CP    11         ; Stop

+2022 28 0A       (.    JR    Z,202E     

+2024 FE 17       ..    CP    17         ; Weiter

+2026 20 18        .    JR    NZ,2040    

+2028 DD CB 00 9E ....  RES   3,(IX+00)  ; Weiter gedrueckt

+202C 18 B8       ..    JR    1FE6       

+202E DD CB 00 DE ....  SET   3,(IX+00)  ; Stop gedrueckt

+2032 18 B2       ..    JR    1FE6       

+2034 F1          .     POP   AF         ; info-taste gedrueckt 

+2035 CD 33 6F    .3o   CALL  6F33       

+2038 18 AD       ..    JR    1FE7       

+203A F1          .     POP   AF         ; SV-Call gedrueckt

+203B CD 93 4C    ..L   CALL  4C93       ; SV-Call zustellen

+203E 18 A7       ..    JR    1FE7       

+2040 C5          .     PUSH  BC         ; nicht psi als tabelle

+2041 DD 7E 05    .~.   LD    A,(IX+05)  ; Schreibzeiger >= 16H ? 

+2044 FE 16       ..    CP    16         

+2046 D2 F2 20    ..    JP    NC,20F2    ; Pufferoverflow setzen

+2049 21 AB 26    !.&   LD    HL,26AB    

+204C CB F6       ..    SET   6,(HL)     

+204E 4F          O     LD    C,A        

+204F 06 00       ..    LD    B,00       

+2051 DD E5       ..    PUSH  IX         

+2053 E1          .     POP   HL         

+2054 09          .     ADD   HL,BC      

+2055 C1          .     POP   BC         

+2056 70          p     LD    (HL),B     

+2057 23          #     INC   HL         

+2058 36 FF       6.    LD    (HL),FF    

+205A DD 34       .4    INC   (IX+05)    ; Schreibzeiger

+205C 05          .     DEC   B          

+205D FE 0E       ..    CP    0E         

+205F 20 0E        .    JR    NZ,206F    

+2061 F1          .     POP   AF         

+2062 F5          .     PUSH  AF         

+2063 CD 95 26    ..&   CALL  2695       

+2066 CB 7E       .~    BIT   7,(HL)     

+2068 28 05       (.    JR    Z,206F     

+206A F1          .     POP   AF         

+206B F5          .     PUSH  AF         

+206C CD ED 1E    ...   CALL  1EED       

+206F F1          .     POP   AF         

+2070 F5          .     PUSH  AF         

+2071 CD 95 26    ..&   CALL  2695       

+2074 FE 7E       .~    CP    7E         

+2076 D2 EB 20    ..    JP    NC,20EB    

+2079 CD 1F 24    ..$   CALL  241F       

+207C D5          .     PUSH  DE         

+207D C5          .     PUSH  BC         

+207E 01 80 01    ...   LD    BC,0180    

+2081 09          .     ADD   HL,BC      

+2082 E5          .     PUSH  HL         

+2083 EB          .     EX    DE,HL      

+2084 DD E5       ..    PUSH  IX         

+2086 E1          .     POP   HL         

+2087 DD 4E 04    .N.   LD    C,(IX+04)  

+208A 06 00       ..    LD    B,00       

+208C 09          .     ADD   HL,BC      

+208D 1A          .     LD    A,(DE)     ; Zeichen an Lesezeigerposition holen

+208E 13          .     INC   DE         

+208F 3C          <     INC   A          

+2090 F5          .     PUSH  AF         

+2091 20 04        .    JR    NZ,2097    

+2093 1A          .     LD    A,(DE)     ; Zeichen = FF ?

+2094 3C          <     INC   A          

+2095 28 38       (8    JR    Z,20CF     

+2097 E5          .     PUSH  HL         

+2098 EB          .     EX    DE,HL      

+2099 1A          .     LD    A,(DE)     

+209A ED A1       ..    CPI              

+209C 20 24        $    JR    NZ,20C2    

+209E 13          .     INC   DE         

+209F 3C          <     INC   A          

+20A0 20 F7        .    JR    NZ,2099    

+20A2 E1          .     POP   HL         

+20A3 F1          .     POP   AF         

+20A4 3D          =     DEC   A          

+20A5 FE 11       ..    CP    11         ; Weiter

+20A7 CA 1C 21    ..!   JP    Z,211C     

+20AA FE 04       ..    CP    04         ; Info

+20AC 28 56       (V    JR    Z,2104     

+20AE FE 07       ..    CP    07         ; SV-Call

+20B0 28 5E       (^    JR    Z,2110     

+20B2 FE 17       ..    CP    17         ; Stop

+20B4 CA 22 21    ."!   JP    Z,2122     

+20B7 77          w     LD    (HL),A     ; Anderer Eingabecode

+20B8 DD 34       .4    INC   (IX+04)    ; Lese-Zeiger weitersetzen

+20BA 04          .     INC   B          

+20BB 23          #     INC   HL         

+20BC CD 2F 21    ./!   CALL  212F       

+20BF E1          .     POP   HL         

+20C0 18 1B       ..    JR    20DD       

+20C2 3C          <     INC   A          

+20C3 28 1C       (.    JR    Z,20E1     

+20C5 7E          ~     LD    A,(HL)     

+20C6 23          #     INC   HL         

+20C7 3C          <     INC   A          

+20C8 20 FB        .    JR    NZ,20C5    

+20CA EB          .     EX    DE,HL      

+20CB E1          .     POP   HL         

+20CC F1          .     POP   AF         

+20CD 18 BE       ..    JR    208D       

+20CF F1          .     POP   AF         

+20D0 E1          .     POP   HL         

+20D1 DD 34       .4    INC   (IX+04)    

+20D3 04          .     INC   B          

+20D4 DD 7E 04    .~.   LD    A,(IX+04)  ; Lesezeiger = Schreibzeiger ?

+20D7 DD BE 05    ...   CP    (IX+05)    

+20DA C2 82 20    ..    JP    NZ,2082    

+20DD C1          .     POP   BC         

+20DE D1          .     POP   DE         

+20DF 18 0D       ..    JR    20EE       

+20E1 3E 02       >.    LD    A,02       

+20E3 32 AB 26    2.&   LD    (26AB),A   

+20E6 E1          .     POP   HL         

+20E7 F1          .     POP   AF         

+20E8 E1          .     POP   HL         

+20E9 18 F2       ..    JR    20DD       

+20EB DD 34       .4    INC   (IX+04)    ; Zeiger weitersetzen

+20ED 04          .     INC   B          

+20EE F1          .     POP   AF         

+20EF C3 E7 1F    ...   JP    1FE7       

+20F2 DD CB 01 EE ....  SET   5,(IX+01)  ; Bit 5 : Puffer overflow

+20F6 DD 7E 04    .~.   LD    A,(IX+04)  ; Schreibzeiger := Lesezeiger

+20F9 DD 77 05    .w.   LD    (IX+05),A  

+20FC 3E 03       >.    LD    A,03       

+20FE 32 AB 26    2.&   LD    (26AB),A   

+2101 C1          .     POP   BC         

+2102 18 EA       ..    JR    20EE       ;-------------- Info-Taste --------

+2104 CD 2F 21    ./!   CALL  212F       

+2107 E1          .     POP   HL         

+2108 C1          .     POP   BC         

+2109 D1          .     POP   DE         

+210A F1          .     POP   AF         

+210B CD 33 6F    .3o   CALL  6F33       

+210E 18 DF       ..    JR    20EF       ;--------------- SV-Call ---------

+2110 CD 2F 21    ./!   CALL  212F       

+2113 E1          .     POP   HL         

+2114 C1          .     POP   BC         

+2115 D1          .     POP   DE         

+2116 F1          .     POP   AF         

+2117 CD 93 4C    ..L   CALL  4C93       

+211A 18 D3       ..    JR    20EF       ;-------------- Weiter-Taste ------

+211C DD CB 00 DE ....  SET   3,(IX+00)  ; Weiterbit setzen 

+2120 18 04       ..    JR    2126       ;-------------- Stop-Taste --------

+2122 DD CB 00 9E ....  RES   3,(IX+00)  ; 

+2126 CD 2F 21    ./!   CALL  212F       

+2129 E1          .     POP   HL         

+212A C1          .     POP   BC         

+212B D1          .     POP   DE         

+212C F1          .     POP   AF         

+212D 18 C0       ..    JR    20EF       

+212F DD 7E 04    .~.   LD    A,(IX+04)  ; Schreibzeiger := Lesezeiger

+2132 DD 77 05    .w.   LD    (IX+05),A  

+2135 3E FF       >.    LD    A,FF       ; Puffer bis zum Ende mit FF fuellen

+2137 77          w     LD    (HL),A     

+2138 23          #     INC   HL         

+2139 7B          {     LD    A,E        

+213A BD          .     CP    L          

+213B 20 F8        .    JR    NZ,2135    

+213D C9          .     RET              ; ------ Test ob Puffer overflow

+213E F5          .     PUSH  AF         

+213F E5          .     PUSH  HL         

+2140 21 B2 26    !.&   LD    HL,26B2    

+2143 CB 7E       .~    BIT   7,(HL)     

+2145 28 02       (.    JR    Z,2149     

+2147 86          .     ADD   (HL)       

+2148 77          w     LD    (HL),A     

+2149 3A AB 26    :.&   LD    A,(26AB)   

+214C 3D          =     DEC   A          

+214D FA 85 21    ..!   JP    M,2185     

+2150 32 AB 26    2.&   LD    (26AB),A   

+2153 20 30        0    JR    NZ,2185    

+2155 DD E5       ..    PUSH  IX         

+2157 D5          .     PUSH  DE         

+2158 C5          .     PUSH  BC         

+2159 11 18 00    ...   LD    DE,0018    

+215C 3E 01       >.    LD    A,01       ; Beginne mit Kanal 1

+215E CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle --> HL

+2161 06 10       ..    LD    B,10       ; Fuer 16 Kanaele

+2163 E5          .     PUSH  HL         

+2164 DD E1       ..    POP   IX         

+2166 DD CB 00 6E ...n  BIT   5,(IX+00)  ; Gro�er Puffer

+216A 20 11        .    JR    NZ,217D    ; kein overflow

+216C F3          .     DI               

+216D DD 7E 05    .~.   LD    A,(IX+05)  ; Schreibzeiger >= 16H ? 

+2170 FE 16       ..    CP    16         

+2172 38 05       8.    JR    C,2179     

+2174 3E 13       >.    LD    A,13       ; zuruecksetzen auf 13

+2176 DD 77 05    .w.   LD    (IX+05),A  

+2179 DD 77 04    .w.   LD    (IX+04),A  

+217C FB          .     EI               

+217D DD 19       ..    ADD   IX,DE      ; Next entry

+217F 10 E5       ..    DJNZ  2166       

+2181 C1          .     POP   BC         

+2182 D1          .     POP   DE         

+2183 DD E1       ..    POP   IX         

+2185 E1          .     POP   HL         

+2186 F1          .     POP   AF         

+2187 C9          .     RET              ;----------- OUTPUT ------------

+2188 FE 11       ..    CP    11         

+218A D2 7B 28    .{(   JP    NC,287B    

+218D F5          .     PUSH  AF         

+218E DD E5       ..    PUSH  IX         

+2190 32 AC 26    2.&   LD    (26AC),A   

+2193 E5          .     PUSH  HL         

+2194 CD 95 26    ..&   CALL  2695       

+2197 D2 3A 22    .:"   JP    NC,223A    

+219A 32 B1 26    2.&   LD    (26B1),A   

+219D 3A AC 26    :.&   LD    A,(26AC)   

+21A0 CD FA 23    ..#   CALL  23FA       

+21A3 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+21A7 7E          ~     LD    A,(HL)     

+21A8 E6 0B       ..    AND   0B         

+21AA 28 24       ($    JR    Z,21D0     

+21AC CB 5F       ._    BIT   3,A        

+21AE 20 0C        .    JR    NZ,21BC    

+21B0 CB 47       .G    BIT   0,A        

+21B2 28 13       (.    JR    Z,21C7     

+21B4 3A AC 26    :.&   LD    A,(26AC)   

+21B7 CD 59 1E    .Y.   CALL  1E59       

+21BA 38 09       8.    JR    C,21C5     

+21BC E1          .     POP   HL         

+21BD DD E1       ..    POP   IX         

+21BF F1          .     POP   AF         

+21C0 01 00 00    ...   LD    BC,0000    

+21C3 B7          .     OR    A          

+21C4 C9          .     RET              

+21C5 CB 86       ..    RES   0,(HL)     

+21C7 3A B2 26    :.&   LD    A,(26B2)   

+21CA CB 7F       ..    BIT   7,A        

+21CC 20 EE        .    JR    NZ,21BC    

+21CE CB 8E       ..    RES   1,(HL)     

+21D0 E1          .     POP   HL         

+21D1 D5          .     PUSH  DE         

+21D2 E5          .     PUSH  HL         

+21D3 3A B1 26    :.&   LD    A,(26B1)   

+21D6 CD 1F 24    ..$   CALL  241F       

+21D9 54          T     LD    D,H        

+21DA 5D          ]     LD    E,L        

+21DB E1          .     POP   HL         

+21DC E5          .     PUSH  HL         

+21DD C5          .     PUSH  BC         

+21DE 78          x     LD    A,B        

+21DF B1          .     OR    C          

+21E0 20 08        .    JR    NZ,21EA    

+21E2 C1          .     POP   BC         

+21E3 E1          .     POP   HL         

+21E4 D1          .     POP   DE         

+21E5 DD E1       ..    POP   IX         

+21E7 F1          .     POP   AF         

+21E8 37          7     SCF              

+21E9 C9          .     RET              

+21EA E5          .     PUSH  HL         

+21EB 7E          ~     LD    A,(HL)     

+21EC 2A AD 26    *.&   LD    HL,(26AD)  

+21EF CB 56       .V    BIT   2,(HL)     

+21F1 28 0F       (.    JR    Z,2202     

+21F3 CB 66       .f    BIT   4,(HL)     

+21F5 CA 07 23    ..#   JP    Z,2307     

+21F8 CB A6       ..    RES   4,(HL)     

+21FA 23          #     INC   HL         

+21FB 23          #     INC   HL         

+21FC 77          w     LD    (HL),A     

+21FD E1          .     POP   HL         

+21FE 23          #     INC   HL         

+21FF 0B          .     DEC   BC         

+2200 18 DC       ..    JR    21DE       

+2202 E1          .     POP   HL         

+2203 E5          .     PUSH  HL         

+2204 C5          .     PUSH  BC         

+2205 3A B1 26    :.&   LD    A,(26B1)   

+2208 FE 7E       .~    CP    7E         

+220A 28 35       (5    JR    Z,2241     

+220C E5          .     PUSH  HL         

+220D 6E          n     LD    L,(HL)     

+220E 26 00       &.    LD    H,00       

+2210 19          .     ADD   HL,DE      

+2211 7E          ~     LD    A,(HL)     

+2212 3C          <     INC   A          

+2213 20 38        8    JR    NZ,224D    

+2215 E1          .     POP   HL         

+2216 ED A1       ..    CPI              

+2218 EA 0C 22    .."   JP    PE,220C    

+221B C1          .     POP   BC         

+221C E1          .     POP   HL         

+221D C5          .     PUSH  BC         

+221E 3A AC 26    :.&   LD    A,(26AC)   

+2221 CD 7B 28    .{(   CALL  287B       

+2224 F5          .     PUSH  AF         

+2225 DD 7E 03    .~.   LD    A,(IX+03)  ; xpos INCR C

+2228 81          .     ADD   C          

+2229 DD 77 03    .w.   LD    (IX+03),A  

+222C F1          .     POP   AF         

+222D D2 CE 23    ..#   JP    NC,23CE    

+2230 09          .     ADD   HL,BC      

+2231 E3          .     EX    (SP),HL    

+2232 B7          .     OR    A          

+2233 ED 42       .B    SBC   HL,BC      

+2235 44          D     LD    B,H        

+2236 4D          M     LD    C,L        

+2237 E1          .     POP   HL         

+2238 18 A4       ..    JR    21DE       

+223A E1          .     POP   HL         

+223B DD E1       ..    POP   IX         

+223D F1          .     POP   AF         

+223E C3 7B 28    .{(   JP    287B       

+2241 3E 0D       >.    LD    A,0D       

+2243 BE          .     CP    (HL)       

+2244 30 08       0.    JR    NC,224E    

+2246 ED A1       ..    CPI              

+2248 EA 43 22    .C"   JP    PE,2243    

+224B 18 CE       ..    JR    221B       

+224D E1          .     POP   HL         

+224E 7E          ~     LD    A,(HL)     

+224F E1          .     POP   HL         

+2250 E5          .     PUSH  HL         

+2251 B7          .     OR    A          

+2252 ED 42       .B    SBC   HL,BC      

+2254 28 06       (.    JR    Z,225C     

+2256 44          D     LD    B,H        

+2257 4D          M     LD    C,L        

+2258 E1          .     POP   HL         

+2259 E3          .     EX    (SP),HL    

+225A 18 C2       ..    JR    221E       

+225C F5          .     PUSH  AF         

+225D 3A AC 26    :.&   LD    A,(26AC)   

+2260 C5          .     PUSH  BC         

+2261 01 02 00    ...   LD    BC,0002    ; IOCONTROL frout

+2264 CD A8 28    ..(   CALL  28A8       

+2267 79          y     LD    A,C        

+2268 C1          .     POP   BC         

+2269 FE 10       ..    CP    10         

+226B DA E6 23    ..#   JP    C,23E6     

+226E F1          .     POP   AF         

+226F CD 79 22    .y"   CALL  2279       

+2272 C1          .     POP   BC         

+2273 E1          .     POP   HL         

+2274 0B          .     DEC   BC         

+2275 23          #     INC   HL         

+2276 C3 DE 21    ..!   JP    21DE       ;-------- cursor mitfuehren ------

+2279 FE 06       ..    CP    06         

+227B CA FF 22    .."   JP    Z,22FF     

+227E 38 54       8T    JR    C,22D4     

+2280 FE 08       ..    CP    08         ; Left

+2282 28 15       (.    JR    Z,2299     

+2284 FE 07       ..    CP    07         ; Bell: Keine Veraenderung

+2286 28 5B       ([    JR    Z,22E3     

+2288 FE 0A       ..    CP    0A         ; LF

+228A 28 12       (.    JR    Z,229E     

+228C DD 34       .4    INC   (IX+03)    ; Alles andere wie right 

+228E 03          .     INC   BC         

+228F FE 0D       ..    CP    0D         ; CR

+2291 20 50        P    JR    NZ,22E3    

+2293 DD 36 03 00 .6..  LD    (IX+03),00 

+2297 18 4A       .J    JR    22E3       

+2299 DD 35       .5    DEC   (IX+03)    

+229B 03          .     INC   BC         

+229C 18 45       .E    JR    22E3       

+229E F5          .     PUSH  AF         

+229F DD 7E 02    .~.   LD    A,(IX+02)  ; ypos des cursors

+22A2 DD BE 06    ...   CP    (IX+06)    ; max. ypos (wird mit ysize ges.) 

+22A5 28 03       (.    JR    Z,22AA     

+22A7 DD 34       .4    INC   (IX+02)    ; ypos +1

+22A9 02          .     LD    (BC),A     

+22AA F1          .     POP   AF         

+22AB 18 36       .6    JR    22E3       

+22AD E5          .     PUSH  HL         

+22AE 23          #     INC   HL         

+22AF CD 5F 23    ._#   CALL  235F       

+22B2 E1          .     POP   HL         

+22B3 7E          ~     LD    A,(HL)     

+22B4 B7          .     OR    A          

+22B5 C8          .     RET   Z          

+22B6 2A AD 26    *.&   LD    HL,(26AD)  

+22B9 CB C6       ..    SET   0,(HL)     

+22BB CB CE       ..    SET   1,(HL)     

+22BD 3E 81       >.    LD    A,81       

+22BF 32 B2 26    2.&   LD    (26B2),A   

+22C2 C3 E0 23    ..#   JP    23E0       

+22C5 DD 36 02 00 .6..  LD    (IX+02),00 

+22C9 DD 36 03 00 .6..  LD    (IX+03),00 

+22CD 18 14       ..    JR    22E3       

+22CF DD 34       .4    INC   (IX+03)    

+22D1 03          .     INC   BC         

+22D2 18 0F       ..    JR    22E3       

+22D4 FE 01       ..    CP    01         ; Home ?

+22D6 28 ED       (.    JR    Z,22C5     

+22D8 FE 02       ..    CP    02         ; Right ?

+22DA 28 F3       (.    JR    Z,22CF     

+22DC FE 03       ..    CP    03         ; Up

+22DE 20 03        .    JR    NZ,22E3    

+22E0 DD 35       .5    DEC   (IX+02)    ; ypos-1 

+22E2 02          .     LD    (BC),A     

+22E3 6F          o     LD    L,A        

+22E4 3A B1 26    :.&   LD    A,(26B1)   

+22E7 FE 7E       .~    CP    7E         

+22E9 20 04        .    JR    NZ,22EF    

+22EB 7D          }     LD    A,L        

+22EC C3 B8 23    ..#   JP    23B8       

+22EF 26 00       &.    LD    H,00       

+22F1 19          .     ADD   HL,DE      

+22F2 7E          ~     LD    A,(HL)     

+22F3 FE 80       ..    CP    80         

+22F5 DA B8 23    ..#   JP    C,23B8     

+22F8 D6 80       ..    SUB   A,80       

+22FA 62          b     LD    H,D        

+22FB 6F          o     LD    L,A        

+22FC 24          $     INC   H          

+22FD 18 AE       ..    JR    22AD       ;---------- cursor (x,y) ----------

+22FF 2A AD 26    *.&   LD    HL,(26AD)  

+2302 CB D6       ..    SET   2,(HL)     

+2304 CB E6       ..    SET   4,(HL)     

+2306 C9          .     RET              ;---------------------------------

+2307 23          #     INC   HL         

+2308 23          #     INC   HL         

+2309 23          #     INC   HL         

+230A 77          w     LD    (HL),A     

+230B 3A B1 26    :.&   LD    A,(26B1)   

+230E FE 7E       .~    CP    7E         ; psi ?

+2310 20 11        .    JR    NZ,2323    

+2312 3E 06       >.    LD    A,06       ; Code 6

+2314 CD B8 23    ..#   CALL  23B8       

+2317 2B          +     DEC   HL         

+2318 7E          ~     LD    A,(HL)     ; y pos 

+2319 CD B8 23    ..#   CALL  23B8       

+231C 23          #     INC   HL         

+231D 7E          ~     LD    A,(HL)     ; x pos  

+231E CD B8 23    ..#   CALL  23B8       

+2321 18 31       .1    JR    2354       

+2323 14          .     INC   D          

+2324 1A          .     LD    A,(DE)     

+2325 15          .     DEC   D          

+2326 3C          <     INC   A          

+2327 20 0E        .    JR    NZ,2337    

+2329 DD 7E 03    .~.   LD    A,(IX+03)  ; alte xpos

+232C D6 50       .P    SUB   A,50       ; 80 Spalten Umbruch

+232E 38 07       8.    JR    C,2337     

+2330 DD CB 02 F6 ....  SET   6,(IX+02)  

+2334 DD 77 03    .w.   LD    (IX+03),A  

+2337 C5          .     PUSH  BC         

+2338 21 06 00    !..   LD    HL,0006    ; Cursorstringcode = 6

+233B 19          .     ADD   HL,DE      

+233C 7E          ~     LD    A,(HL)     ; Ist immer ein outstring

+233D CB BF       ..    RES   7,A        

+233F 24          $     INC   H          ; Outstringpage

+2340 6F          o     LD    L,A        

+2341 2C          ,     INC   L          ; keine wartezeit

+2342 CD 5F 23    ._#   CALL  235F       ; prestring ausgeben

+2345 23          #     INC   HL         

+2346 CD 6C 23    .l#   CALL  236C       ; x/y pos ausgeben

+2349 CD 5F 23    ._#   CALL  235F       ; midstring ausgeben

+234C 23          #     INC   HL         

+234D CD 6C 23    .l#   CALL  236C       ; x/y pos ausgeben

+2350 CD 5F 23    ._#   CALL  235F       ; poststring ausgeben

+2353 C1          .     POP   BC         ; naechstes zeichen interpretieren

+2354 2A AD 26    *.&   LD    HL,(26AD)  

+2357 CB 96       ..    RES   2,(HL)     

+2359 E1          .     POP   HL         

+235A 23          #     INC   HL         

+235B 0B          .     DEC   BC         

+235C C3 DE 21    ..!   JP    21DE       ; string ausgeben (mit 0 am ende)

+235F 06 46       .F    LD    B,46       ; max 70 zeichen

+2361 7E          ~     LD    A,(HL)     

+2362 B7          .     OR    A          

+2363 28 06       (.    JR    Z,236B     

+2365 CD B8 23    ..#   CALL  23B8       ; char out

+2368 23          #     INC   HL         

+2369 10 F6       ..    DJNZ  2361       

+236B C9          .     RET              ;----------- x/y pos out --------- 

+236C 7E          ~     LD    A,(HL)     ; zeichen "x" oder "y" 

+236D E5          .     PUSH  HL         

+236E 2A AD 26    *.&   LD    HL,(26AD)  ; zeiger auf x pos (26ad)+2

+2371 23          #     INC   HL         

+2372 23          #     INC   HL         

+2373 FE 79       .y    CP    79         ; "y" Kennzeichen

+2375 28 01       (.    JR    Z,2378     

+2377 23          #     INC   HL         ; ypos 

+2378 46          F     LD    B,(HL)     ; neue position --> B

+2379 FD E5       ..    PUSH  IY         

+237B 14          .     INC   D          ; 

+237C D5          .     PUSH  DE         

+237D FD E1       ..    POP   IY         

+237F 15          .     DEC   D          

+2380 FE 79       .y    CP    79         ; "y" Kennzeichen

+2382 28 02       (.    JR    Z,2386     

+2384 FD 23       .#    INC   IY         

+2386 FD 7E 02    .~.   LD    A,(IY+02)  ; Offset + pos

+2389 80          .     ADD   B          

+238A FD CB 00 56 ...V  BIT   2,(IY+00)  ; Keine Konvertierung

+238E 20 0C        .    JR    NZ,239C     

+2390 FD CB 00 46 ...F  BIT   0,(IY+00)  ; Dezimale ASCII-Ausgabe

+2394 20 0E        .    JR    NZ,23A4    

+2396 FE 0C       ..    CP    0C         ; Elbit Cursor

+2398 38 02       8.    JR    C,239C     

+239A C6 04       ..    ADD   A,04       ; ywert

+239C CD B8 23    ..#   CALL  23B8       ; Byte ausgeben

+239F FD E1       ..    POP   IY         

+23A1 E1          .     POP   HL         

+23A2 23          #     INC   HL         

+23A3 C9          .     RET              ;--------- Dezimal ausgeben -------

+23A4 D5          .     PUSH  DE         

+23A5 5F          _     LD    E,A        

+23A6 16 00       ..    LD    D,00       

+23A8 21 A4 26    !.&   LD    HL,26A4    ; Zwischenspeicheraddresse

+23AB CD 00 4E    ..N   CALL  4E00       ; String uebertragen

+23AE 41          A     LD    B,C        ; Laengebyte

+23AF 21 A4 26    !.&   LD    HL,26A4    ; Startaddresse des Strings

+23B2 CD 61 23    .a#   CALL  2361       ; String ausgeben

+23B5 D1          .     POP   DE         

+23B6 18 E7       ..    JR    239F       ; Return

+23B8 E5          .     PUSH  HL         

+23B9 C5          .     PUSH  BC         

+23BA 21 AA 26    !.&   LD    HL,26AA    

+23BD 77          w     LD    (HL),A     

+23BE 01 01 00    ...   LD    BC,0001    

+23C1 3A AC 26    :.&   LD    A,(26AC)   

+23C4 CD 7B 28    .{(   CALL  287B       

+23C7 78          x     LD    A,B        

+23C8 B1          .     OR    C          

+23C9 28 F3       (.    JR    Z,23BE     

+23CB C1          .     POP   BC         

+23CC E1          .     POP   HL         

+23CD C9          .     RET              

+23CE E1          .     POP   HL         

+23CF B7          .     OR    A          

+23D0 ED 42       .B    SBC   HL,BC      

+23D2 E3          .     EX    (SP),HL    

+23D3 C1          .     POP   BC         

+23D4 B7          .     OR    A          

+23D5 ED 42       .B    SBC   HL,BC      

+23D7 44          D     LD    B,H        

+23D8 4D          M     LD    C,L        

+23D9 E1          .     POP   HL         

+23DA D1          .     POP   DE         

+23DB DD E1       ..    POP   IX         

+23DD F1          .     POP   AF         

+23DE B7          .     OR    A          

+23DF C9          .     RET              

+23E0 C1          .     POP   BC         

+23E1 E1          .     POP   HL         

+23E2 2B          +     DEC   HL         

+23E3 C1          .     POP   BC         

+23E4 18 EC       ..    JR    23D2       

+23E6 E1          .     POP   HL         

+23E7 E1          .     POP   HL         

+23E8 C1          .     POP   BC         

+23E9 18 E7       ..    JR    23D2       ;----- Zeiger auf Kanaltabelle

+23EB D5          .     PUSH  DE         

+23EC C5          .     PUSH  BC         

+23ED 21 B1 26    !.&   LD    HL,26B1    

+23F0 47          G     LD    B,A        

+23F1 11 18 00    ...   LD    DE,0018    ; 24 Bytes lang ein entry

+23F4 19          .     ADD   HL,DE      

+23F5 10 FD       ..    DJNZ  23F4       

+23F7 C1          .     POP   BC         

+23F8 D1          .     POP   DE         

+23F9 C9          .     RET              

+23FA CD EB 23    ..#   CALL  23EB       

+23FD 22 AD 26    ".&   LD    (26AD),HL  

+2400 C9          .     RET              ;--------- Typtabellennummeraddr->HL

+2401 FE 7E       .~    CP    7E         ; psi

+2403 C8          .     RET   Z          

+2404 FE 05       ..    CP    05         ; Tabellennummer >= 5 ?

+2406 38 0E       8.    JR    C,2416     

+2408 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+240B 18 09       ..    JR    2416       ; " lst ovfl"

+240D 20 6C        l    JR    NZ,247B    

+240F 73          s     LD    (HL),E     

+2410 74          t     LD    (HL),H     

+2411 20 6F        o    JR    NZ,2482    

+2413 76          v     HALT             

+2414 66          f     LD    H,(HL)     

+2415 6C          l     LD    L,H        

+2416 21 B3 26    !.&   LD    HL,26B3

+2419 85          .     ADD   L          

+241A 6F          o     LD    L,A        

+241B 30 01       0.    JR    NC,241E    

+241D 24          $     INC   H          

+241E C9          .     RET              ;------ Addresse der Typtabelle --

+241F CD 01 24    ..$   CALL  2401       

+2422 66          f     LD    H,(HL)     

+2423 2E 00       ..    LD    L,00       

+2425 C9          .     RET              ;--Typt.Block reservieren -------

+2426 E5          .     PUSH  HL         

+2427 D5          .     PUSH  DE         

+2428 CD 42 5E    .B^   CALL  5E42       ; Block freimachen

+242B 7D          }     LD    A,L        

+242C 87          .     ADD   A          ; * 2

+242D D1          .     POP   DE         

+242E E1          .     POP   HL         

+242F 77          w     LD    (HL),A     ; Pufferaddresse (Block)eintragen

+2430 C9          .     RET              

+2431 F1          .     POP   AF         

+2432 01 FF FF    ...   LD    BC,FFFF    ; Returncode -1

+2435 C9          .     RET              ; ---- 173/175 Shard-IOCONTROL ----- 

+2436 F5          .     PUSH  AF         

+2437 3A 6B 28    :k(   LD    A,(286B)   ; Shardversion 

+243A FE 06       ..    CP    06         ; 173 Shard

+243C 38 F3       8.    JR    C,2431     ; < 6 : control geht nicht

+243E FE 08       ..    CP    08         

+2440 30 0A       0.    JR    NC,244C    ; >= 8 : keine Registerverlagerung

+2442 F1          .     POP   AF         ; 173: Register umdrehen

+2443 61          a     LD    H,C        ; H = Schl�ssel (>=8: HL=Schl�ssel)

+2444 42          B     LD    B,D        ; BC = Funktionsnummer

+2445 4B          K     LD    C,E        ; L war schon addressierter Kanal

+2446 11 00 00    ...   LD    DE,0000    ; DE = Funktionscode 1 (nicht in <8)

+2449 C3 A8 28    ..(   JP    28A8       ; IOCONTROL an Shard geben

+244C F1          .     POP   AF         ; --- 175 Shard-IOCONTROL ---------- 

+244D C5          .     PUSH  BC         

+244E 42          B     LD    B,D        ; Funktionsnummer nach BC

+244F 4B          K     LD    C,E        

+2450 54          T     LD    D,H        ; Code 1 nach DE

+2451 5D          ]     LD    E,L        

+2452 E1          .     POP   HL         ; Code 2 nach HL

+2453 C3 A8 28    ..(   JP    28A8       ; ---- CONTROL (DE,HL,BC,res BC) ----

+2456 CB 7A       .z    BIT   7,D        

+2458 20 F3        .    JR    NZ,244D    

+245A F5          .     PUSH  AF         

+245B 7B          {     LD    A,E        ; Control 6: flow (kanal.

+245C FE 06       ..    CP    06         

+245E CA 24 25    .$%   JP    Z,2524     

+2461 FE 08       ..    CP    08         ; Control 8: baud (kanal,schlssl,res)

+2463 28 D2       (.    JR    Z,2437     

+2465 FE 09       ..    CP    09         ; Control 9: bits (kanal,schlssl,res)

+2467 28 CE       (.    JR    Z,2437     

+2469 FE 0A       ..    CP    0A         ; Control 10: calendar (field,0,bcd)

+246B 28 1B       (.    JR    Z,2488     

+246D FE 0C       ..    CP    0C         ; Control 12: xmiterror (0,0,err)

+246F 20 1E        .    JR    NZ,248F    ;--------- IOCONTROL 12 ----------

+2471 0E 3F       .?    LD    C,3F

+2473 3A 6B 28    :k(   LD    A,(286B)   

+2476 FE 08       ..    CP    08         ; Shard Version >= 8 ?

+2478 30 02       0.    JR    NC,247C    

+247A 0E 20       .     LD    C,20       ; Nur Puffer uebergelaufen

+247C F1          .     POP   AF         

+247D CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle 

+2480 23          #     INC   HL         

+2481 7E          ~     LD    A,(HL)     

+2482 A1          .     AND   C          

+2483 4F          O     LD    C,A        

+2484 06 00       ..    LD    B,00       

+2486 70          p     LD    (HL),B     

+2487 C9          .     RET              ; ----- IOCONTROL calendar ---------

+2488 3A 6B 28    :k(   LD    A,(286B)   

+248B FE 08       ..    CP    08         ; Shard Vers >= 8 ? 

+248D 38 A2       8.    JR    C,2431     ; nein, Return -1

+248F F1          .     POP   AF         ; ------ 

+2490 FE 20       .     CP    20         ; Parameterkanal ?

+2492 28 0E       (.    JR    Z,24A2     

+2494 F5          .     PUSH  AF         ; Kein Parameterkanal

+2495 7B          {     LD    A,E        

+2496 FE 05       ..    CP    05         ; Funktion 5: size

+2498 28 04       (.    JR    Z,249E     

+249A FE 07       ..    CP    07         ; Funktion 7: format

+249C 20 AE        .    JR    NZ,244C    

+249E F1          .     POP   AF         

+249F C3 2A 64    .*d   JP    642A       ; �bergeben an PROZ ARCH

+24A2 7B          {     LD    A,E        ; Am Parameterkanal

+24A3 FE 01       ..    CP    01         ; Funktion 1: typtab(kanal,typnr,res)

+24A5 28 65       (e    JR    Z,250C     

+24A7 FE 02       ..    CP    02         ; Funktion 2: inbuffsize(kanal,size,res)

+24A9 28 06       (.    JR    Z,24B1     

+24AB FE 0B       ..    CP    0B         ; Funktion 11: ysize(kanal,ysize,res)

+24AD CA 3C 25    .<%   JP    Z,253C     

+24B0 C9          .     RET              ;--- CONTROL inputbuffersize ------

+24B1 7D          }     LD    A,L        ; Funktion 2 :

+24B2 FE 11       ..    CP    11         

+24B4 D0          .     RET   NC         ; Kanal < 17 ?

+24B5 CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle berechnen 

+24B8 78          x     LD    A,B        ; > 255 ?

+24B9 FE 01       ..    CP    01         

+24BB 30 22       0"    JR    NC,24DF    

+24BD CB 6E       .n    BIT   5,(HL)     ; inputbuffersize < 256

+24BF C8          .     RET   Z          ; schon eingestellt

+24C0 DD E5       ..    PUSH  IX         

+24C2 E5          .     PUSH  HL         

+24C3 DD E1       ..    POP   IX         

+24C5 DD 66 07    .f.   LD    H,(IX+07)  ; 7 = Blockaddresse

+24C8 DD 6E 0C    .n.   LD    L,(IX+0C)  

+24CB CD 0B 5E    ..^   CALL  5E0B       ; Alten Pufferblock freigeben

+24CE F3          .     DI               

+24CF DD 36 00 00 .6..  LD    (IX+00),00 ; Jetzt kleiner Puffer ohne Flussk.

+24D3 DD 36 04 07 .6..  LD    (IX+04),07 ; Zeiger auf Pufferanfang

+24D7 FB          .     EI               

+24D8 DD 36 05 07 .6..  LD    (IX+05),07 

+24DC DD E1       ..    POP   IX         

+24DE C9          .     RET              ;---- Grosser Puffer --------------

+24DF CB 6E       .n    BIT   5,(HL)     

+24E1 C0          .     RET   NZ         ; war schon > 255 eingestellt

+24E2 DD E5       ..    PUSH  IX         

+24E4 E5          .     PUSH  HL         

+24E5 CD 18 5E    ..^   CALL  5E18       ; Block freimachen fuer Puffer

+24E8 DD E1       ..    POP   IX         

+24EA F3          .     DI               

+24EB DD CB 00 EE ....  SET   5,(IX+00)  ; Grosser Puffer

+24EF DD 74 07    .t.   LD    (IX+07),H  ; Pufferaddresse setzen

+24F2 DD 75 0C    .u.   LD    (IX+0C),L  

+24F5 97          .     SUB   A          ; Puffer leeren

+24F6 DD 77 04    .w.   LD    (IX+04),A  ; Lese- und Schreibzeiger jetzt 16Bit

+24F9 DD 77 08    .w.   LD    (IX+08),A  ; Auf Blockanfang

+24FC DD 77 05    .w.   LD    (IX+05),A  

+24FF DD 77 0B    .w.   LD    (IX+0B),A  

+2502 DD 77 09    .w.   LD    (IX+09),A  

+2505 DD 77 0A    .w.   LD    (IX+0A),A  

+2508 FB          .     EI               

+2509 DD E1       ..    POP   IX         

+250B C9          .     RET              ;------ CONTROL typtabelle -------

+250C 79          y     LD    A,C        ; Typtabelle einstellen

+250D FE FE       ..    CP    FE         ; >= 254: psi o. transparent

+250F 30 05       0.    JR    NC,2516    ; 

+2511 FE 05       ..    CP    05         

+2513 D2 3F 26    .?&   JP    NC,263F    ; >= 5: falsche Nummer

+2516 7D          }     LD    A,L        

+2517 FE 11       ..    CP    11         

+2519 D2 5A 26    .Z&   JP    NC,265A    

+251C CD 95 26    ..&   CALL  2695       ; Kanaltyptabellenaddresse holen 

+251F 71          q     LD    (HL),C     ; Nummer eintragen

+2520 01 00 00    ...   LD    BC,0000    ; ok

+2523 C9          .     RET              ;------ IOCONTROL flow ----------

+2524 F1          .     POP   AF         ; Eigener Kanal

+2525 C5          .     PUSH  BC         

+2526 E5          .     PUSH  HL         

+2527 CD 36 24    .6$   CALL  2436       ; Shard IOCONTROL flow

+252A E1          .     POP   HL         

+252B D1          .     POP   DE         

+252C 7D          }     LD    A,L        ; Addressierter Kanal

+252D FE 11       ..    CP    11         ; > 16: fertig

+252F D0          .     RET   NC         

+2530 CD 95 26    ..&   CALL  2695       ; Tytabellennummer holen --> A

+2533 CB BE       ..    RES   7,(HL)     ; Erstmal keine Flu�kontrolle setzen

+2535 7B          {     LD    A,E        

+2536 B7          .     OR    A          

+2537 28 02       (.    JR    Z,253B     ; Wenn Flu�kontrolle, dann in Typ-

+2539 CB FE       ..    SET   7,(HL)     ; tabellennummer vermerken

+253B C9          .     RET              ;------- IOCONTROL ysize ----------- 

+253C 7D          }     LD    A,L        ; Addressierter Kanal

+253D FE 11       ..    CP    11         ; > 16: fertig

+253F D0          .     RET   NC         

+2540 CD EB 23    ..#   CALL  23EB       ; Addresse der Kanaltabelle holen 

+2543 DD E5       ..    PUSH  IX         

+2545 E5          .     PUSH  HL         

+2546 DD E1       ..    POP   IX         

+2548 0D          .     DEC   C          ; ysize-1 (=ymax f. y=0..ymax)

+2549 DD 46 06    .F.   LD    B,(IX+06)  ; Return = alte ysize

+254C 04          .     INC   B          ; ymax + 1 = ysize

+254D DD 71 06    .q.   LD    (IX+06),C  

+2550 DD E1       ..    POP   IX         

+2552 48          H     LD    C,B        ; Nur Werte 0..255

+2553 06 00       ..    LD    B,00       

+2555 C9          .     RET              ;----------------------------------

+2556 CB 7C       .|    BIT   7,H        

+2558 C2 DE 63    ..c   JP    NZ,63DE    

+255B 32 AC 26    2.&   LD    (26AC),A   

+255E 7C          |     LD    A,H        

+255F B5          .     OR    L          

+2560 20 06        .    JR    NZ,2568    

+2562 3A AC 26    :.&   LD    A,(26AC)   

+2565 C3 DE 63    ..c   JP    63DE        

+2568 7C          |     LD    A,H        

+2569 E6 FE       ..    AND   FE         

+256B FE 02       ..    CP    02         

+256D 28 08       (.    JR    Z,2577     

+256F C3 5E 26    .^&   JP    265E       

+2572 01 01 02    ...   LD    BC,0201    

+2575 E1          .     POP   HL         

+2576 C9          .     RET              

+2577 78          x     LD    A,B        

+2578 B1          .     OR    C          

+2579 C8          .     RET   Z          

+257A 25          %     DEC   H          

+257B 25          %     DEC   H          

+257C E5          .     PUSH  HL         

+257D 09          .     ADD   HL,BC      

+257E 7C          |     LD    A,H        

+257F D6 02       ..    SUB   A,02       

+2581 38 05       8.    JR    C,2588     

+2583 20 ED        .    JR    NZ,2572    

+2585 B5          .     OR    L          

+2586 20 EA        .    JR    NZ,2572    

+2588 3A AC 26    :.&   LD    A,(26AC)   

+258B CD FA 23    ..#   CALL  23FA       

+258E E1          .     POP   HL         

+258F 19          .     ADD   HL,DE      

+2590 DD E5       ..    PUSH  IX         

+2592 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+2596 DD CB 00 6E ...n  BIT   5,(IX+00)  

+259A 28 5E       (^    JR    Z,25FA     

+259C C5          .     PUSH  BC         

+259D E5          .     PUSH  HL         

+259E DD 66 0B    .f.   LD    H,(IX+0B)  

+25A1 DD 6E 04    .n.   LD    L,(IX+04)  

+25A4 B7          .     OR    A          

+25A5 ED 42       .B    SBC   HL,BC      

+25A7 DA 13 26    ..&   JP    C,2613     

+25AA DD 66 07    .f.   LD    H,(IX+07)  

+25AD DD 6E 0C    .n.   LD    L,(IX+0C)  

+25B0 CD 81 5A    ..Z   CALL  5A81       

+25B3 ED 43 AF 26 .C.&  LD    (26AF),BC  

+25B7 DD 6E 05    .n.   LD    L,(IX+05)  

+25BA DD 7E 0A    .~.   LD    A,(IX+0A)  

+25BD E6 01       ..    AND   01         

+25BF 84          .     ADD   H          

+25C0 67          g     LD    H,A        

+25C1 D1          .     POP   DE         

+25C2 C1          .     POP   BC         

+25C3 C5          .     PUSH  BC         

+25C4 23          #     INC   HL         

+25C5 7D          }     LD    A,L        

+25C6 B7          .     OR    A          

+25C7 20 06        .    JR    NZ,25CF    

+25C9 CB 44       .D    BIT   0,H        

+25CB 20 02        .    JR    NZ,25CF    

+25CD 25          %     DEC   H          

+25CE 25          %     DEC   H          

+25CF ED A0       ..    LDI              

+25D1 EA C5 25    ..%   JP    PE,25C5    

+25D4 2B          +     DEC   HL         

+25D5 DD 75 05    .u.   LD    (IX+05),L  

+25D8 DD 74 0A    .t.   LD    (IX+0A),H  

+25DB ED 4B AF 26 .K.&  LD    BC,(26AF)  

+25DF CD 8C 5A    ..Z   CALL  5A8C       

+25E2 C1          .     POP   BC         

+25E3 F3          .     DI               

+25E4 DD 66 0B    .f.   LD    H,(IX+0B)  

+25E7 DD 6E 04    .n.   LD    L,(IX+04)  

+25EA B7          .     OR    A          

+25EB ED 42       .B    SBC   HL,BC      

+25ED DD 74 0B    .t.   LD    (IX+0B),H  

+25F0 DD 75 04    .u.   LD    (IX+04),L  

+25F3 FB          .     EI               

+25F4 01 00 00    ...   LD    BC,0000    

+25F7 DD E1       ..    POP   IX         

+25F9 C9          .     RET              ;----------------------------------

+25FA 3A AC 26    :.&   LD    A,(26AC)   

+25FD CD AD 1E    ...   CALL  1EAD       

+2600 DC 1A 26    ..&   CALL  C,261A     

+2603 DD E1       ..    POP   IX         

+2605 3A AC 26    :.&   LD    A,(26AC)   

+2608 CD 06 1F    ...   CALL  1F06       

+260B D8          .     RET   C          

+260C 77          w     LD    (HL),A     

+260D ED A1       ..    CPI              

+260F EA 05 26    ..&   JP    PE,2605    

+2612 C9          .     RET              

+2613 CD 1A 26    ..&   CALL  261A       

+2616 E1          .     POP   HL         

+2617 C1          .     POP   BC         

+2618 18 E9       ..    JR    2603       

+261A 2A AD 26    *.&   LD    HL,(26AD)  

+261D 7E          ~     LD    A,(HL)     

+261E EE 40       .@    XOR   40         

+2620 77          w     LD    (HL),A     

+2621 CB 77       .w    BIT   6,A        

+2623 C8          .     RET   Z          

+2624 21 00 00    !..   LD    HL,0000    

+2627 C3 1A 6C    ..l   JP    6C1A

+262A CB 7C       .|    BIT   7,H        

+262C C2 25 64    .%d   JP    NZ,6425    

+262F 32 AC 26    2.&   LD    (26AC),A   

+2632 F5          .     PUSH  AF         

+2633 7C          |     LD    A,H        

+2634 B5          .     OR    L          

+2635 20 2B        +    JR    NZ,2662    

+2637 F1          .     POP   AF         

+2638 FE 20       .     CP    20         

+263A C2 25 64    .%d   JP    NZ,6425    

+263D 18 04       ..    JR    2643       

+263F 01 02 00    ...   LD    BC,0002    ; Nummer der Typtabelle falsch

+2642 C9          .     RET              

+2643 79          y     LD    A,C        

+2644 FE 05       ..    CP    05         

+2646 30 F7       0.    JR    NC,263F    

+2648 CD 01 24    ..$   CALL  2401       

+264B 7E          ~     LD    A,(HL)     

+264C B7          .     OR    A          

+264D CC 26 24    .&$   CALL  Z,2426     

+2650 67          g     LD    H,A        

+2651 2E 00       ..    LD    L,00       

+2653 EB          .     EX    DE,HL      

+2654 01 00 02    ...   LD    BC,0200    ; Typtabelle in Bereich uebertragen

+2657 ED B0       ..    LDIR             

+2659 C9          .     RET              

+265A 01 03 00    ...   LD    BC,0003    

+265D C9          .     RET              

+265E 01 01 00    ...   LD    BC,0001    

+2661 C9          .     RET              

+2662 F1          .     POP   AF         

+2663 7C          |     LD    A,H        

+2664 E6 FE       ..    AND   FE         

+2666 FE 02       ..    CP    02         

+2668 28 02       (.    JR    Z,266C     

+266A 18 F2       ..    JR    265E       

+266C 78          x     LD    A,B        

+266D B1          .     OR    C          

+266E C8          .     RET   Z          

+266F C5          .     PUSH  BC         

+2670 E5          .     PUSH  HL         

+2671 01 02 00    ...   LD    BC,0002    

+2674 3A AC 26    :.&   LD    A,(26AC)   

+2677 CD A8 28    ..(   CALL  28A8       ; IOCONTROL frout

+267A 21 1C 00    !..   LD    HL,001C    ; 28 Zeichen

+267D ED 42       .B    SBC   HL,BC      ; Anzahl uebernommener Zeichen

+267F D4 1A 26    ..&   CALL  NC,261A    

+2682 E1          .     POP   HL         

+2683 C1          .     POP   BC         

+2684 25          %     DEC   H          

+2685 25          %     DEC   H          

+2686 19          .     ADD   HL,DE      

+2687 C5          .     PUSH  BC         

+2688 3A AC 26    :.&   LD    A,(26AC)   

+268B CD 88 21    ..!   CALL  2188       

+268E E1          .     POP   HL         

+268F B7          .     OR    A          

+2690 ED 42       .B    SBC   HL,BC      

+2692 44          D     LD    B,H        

+2693 4D          M     LD    C,L        

+2694 C9          .     RET              

+2695 21 B8 26    !.&   LD    HL,26B8    

+2698 C5          .     PUSH  BC         

+2699 4F          O     LD    C,A        

+269A 06 00       ..    LD    B,00       

+269C 09          .     ADD   HL,BC      

+269D C1          .     POP   BC         

+269E 7E          ~     LD    A,(HL)     

+269F CB BF       ..    RES   7,A        

+26A1 FE 7F       ..    CP    7F         

+26A3 C9          .     RET              

+26A4 FF          .     RST   38         

+26A5 FF          .     RST   38         

+26A6 FF          .     RST   38         

+26A7 FF          .     RST   38         

+26A8 FF          .     RST   38         

+26A9 00          .     NOP              

+26AA 00          .     NOP              

+26AB 00          .     NOP              

+26AC 00          .     NOP              

+26AD 00          .     NOP              

+26AE 00          .     NOP              

+26AF 00          .     NOP              

+26B0 00          .     NOP              

+26B1 00          .     NOP              

+26B2 00          .     NOP              

+26B3 00          .     NOP              

+26B4 00          .     NOP              

+26B5 00          .     NOP              

+26B6 00          .     NOP              

+26B7 00          .     NOP              

+26B8 00          .     NOP              ; typtabellen nummern & Flusskontr.

+26B9 7E          ~     LD    A,(HL)     ; Kanal 1 : psi ohne flow

+26BA FF          .     RST   38         ; kanal 2 : transparent mit flow

+26BB FF          .     RST   38         ; (Bit 7 = 1: Mit Flu�kontrolle)

+26BC FF          .     RST   38         

+26BD FF          .     RST   38         

+26BE FF          .     RST   38         

+26BF FF          .     RST   38         

+26C0 FF          .     RST   38         

+26C1 FF          .     RST   38         

+26C2 FF          .     RST   38         

+26C3 FF          .     RST   38         

+26C4 FF          .     RST   38         

+26C5 FF          .     RST   38         

+26C6 FF          .     RST   38         

+26C7 FF          .     RST   38         

+26C8 FF          .     RST   38         ; kanal 16 

+                                        ; kanaltabelle fuer kanal 1

+26C9 00          .     NOP            0 ; Bit 0 :

+                                        ; Bit 3 : 1=Stoptaste gedrueckt

+                                        ; Bit 5 : 1=Grosser Puffer (>255Byte) 

+26CA 00          .     NOP            1 ; Bits 0..5 : Errorbits

+26CB FF          .     RST   38       2 ; Cursorpos y

+26CC FF          .     RST   38       3 ; Cursorpos x

+26CD 07          .     RLCA           4 ; Pufferzeiger schreiben

+26CE 07          .     RLCA           5 ; Pufferzeiger lesen

+26CF 17          .     RLA            6 ; ysize = 23

+26D0 FF          .     RST   38       7 ; Ab hier Eingabezeichen ...

+26D1 FF          .     RST   38       8 ;

+26D2 FF          .     RST   38       9 ;

+26D3 FF          .     RST   38      10 ;

+26D4 FF          .     RST   38      11 ;

+26D5 FF          .     RST   38      12 ;

+26D6 FF          .     RST   38

+26D7 FF          .     RST   38         

+26D8 FF          .     RST   38         

+26D9 FF          .     RST   38         

+26DA FF          .     RST   38         

+26DB FF          .     RST   38         

+26DC FF          .     RST   38         ; I.d.R bis hier

+26DD FF          .     RST   38         

+26DE FF          .     RST   38         

+26DF FF          .     RST   38         

+26E0 FF          .     RST   38         

+26E1 00          .     NOP              ; kanal 2

+26E2 00          .     NOP              

+26E3 FF          .     RST   38         

+26E4 FF          .     RST   38         

+26E5 07          .     RLCA             

+26E6 07          .     RLCA             

+26E7 17          .     RLA              

+26E8 FF          .     RST   38         

+26E9 FF          .     RST   38         

+26EA FF          .     RST   38         

+26EB FF          .     RST   38         

+26EC FF          .     RST   38         

+26ED FF          .     RST   38         

+26EE FF          .     RST   38         

+26EF FF          .     RST   38         

+26F0 FF          .     RST   38         

+26F1 FF          .     RST   38         

+26F2 FF          .     RST   38         

+26F3 FF          .     RST   38         

+26F4 FF          .     RST   38         

+26F5 FF          .     RST   38         

+26F6 FF          .     RST   38         

+26F7 FF          .     RST   38         

+26F8 FF          .     RST   38         

+26F9 00          .     NOP              ; kanal 3

+26FA 00          .     NOP              

+26FB FF          .     RST   38         

+26FC FF          .     RST   38         

+26FD 07          .     RLCA             

+26FE 07          .     RLCA             

+26FF 17          .     RLA              

+2700 FF          .     RST   38         

+2701 FF          .     RST   38         

+2702 FF          .     RST   38         

+2703 FF          .     RST   38         

+2704 FF          .     RST   38         

+2705 FF          .     RST   38         

+2706 FF          .     RST   38         

+2707 FF          .     RST   38         

+2708 FF          .     RST   38         

+2709 FF          .     RST   38         

+270A FF          .     RST   38         

+270B FF          .     RST   38         

+270C FF          .     RST   38         

+270D FF          .     RST   38         

+270E FF          .     RST   38         

+270F FF          .     RST   38         

+2710 FF          .     RST   38         

+2711 00          .     NOP              ; kanal 4

+2712 00          .     NOP              

+2713 FF          .     RST   38         

+2714 FF          .     RST   38         

+2715 07          .     RLCA             

+2716 07          .     RLCA             

+2717 17          .     RLA              

+2718 FF          .     RST   38         

+2719 FF          .     RST   38         

+271A FF          .     RST   38         

+271B FF          .     RST   38         

+271C FF          .     RST   38         

+271D FF          .     RST   38         

+271E FF          .     RST   38         

+271F FF          .     RST   38         

+2720 FF          .     RST   38         

+2721 FF          .     RST   38         

+2722 FF          .     RST   38         

+2723 FF          .     RST   38         

+2724 FF          .     RST   38         

+2725 FF          .     RST   38         

+2726 FF          .     RST   38         

+2727 FF          .     RST   38         

+2728 FF          .     RST   38         

+2729 00          .     NOP              ; kanal 5

+272A 00          .     NOP              

+272B FF          .     RST   38         

+272C FF          .     RST   38         

+272D 07          .     RLCA             

+272E 07          .     RLCA             

+272F 17          .     RLA              

+2730 FF          .     RST   38         

+2731 FF          .     RST   38         

+2732 FF          .     RST   38         

+2733 FF          .     RST   38         

+2734 FF          .     RST   38         

+2735 FF          .     RST   38         

+2736 FF          .     RST   38         

+2737 FF          .     RST   38         

+2738 FF          .     RST   38         

+2739 FF          .     RST   38         

+273A FF          .     RST   38         

+273B FF          .     RST   38         

+273C FF          .     RST   38         

+273D FF          .     RST   38         

+273E FF          .     RST   38         

+273F FF          .     RST   38         

+2740 FF          .     RST   38         

+2741 00          .     NOP              ; kanal 6

+2742 00          .     NOP              

+2743 FF          .     RST   38         

+2744 FF          .     RST   38         

+2745 07          .     RLCA             

+2746 07          .     RLCA             

+2747 17          .     RLA              

+2748 FF          .     RST   38         

+2749 FF          .     RST   38         

+274A FF          .     RST   38         

+274B FF          .     RST   38         

+274C FF          .     RST   38         

+274D FF          .     RST   38         

+274E FF          .     RST   38         

+274F FF          .     RST   38         

+2750 FF          .     RST   38         

+2751 FF          .     RST   38         

+2752 FF          .     RST   38         

+2753 FF          .     RST   38         

+2754 FF          .     RST   38         

+2755 FF          .     RST   38         

+2756 FF          .     RST   38         

+2757 FF          .     RST   38         

+2758 FF          .     RST   38         

+2759 00          .     NOP              ; kanal 7

+275A 00          .     NOP              

+275B FF          .     RST   38         

+275C FF          .     RST   38         

+275D 07          .     RLCA             

+275E 07          .     RLCA             

+275F 17          .     RLA              

+2760 FF          .     RST   38         

+2761 FF          .     RST   38         

+2762 FF          .     RST   38         

+2763 FF          .     RST   38         

+2764 FF          .     RST   38         

+2765 FF          .     RST   38         

+2766 FF          .     RST   38         

+2767 FF          .     RST   38         

+2768 FF          .     RST   38         

+2769 FF          .     RST   38         

+276A FF          .     RST   38         

+276B FF          .     RST   38         

+276C FF          .     RST   38         

+276D FF          .     RST   38         

+276E FF          .     RST   38         

+276F FF          .     RST   38         

+2770 FF          .     RST   38         

+2771 00          .     NOP              ; kanal 8

+2772 00          .     NOP              

+2773 FF          .     RST   38         

+2774 FF          .     RST   38         

+2775 07          .     RLCA             

+2776 07          .     RLCA             

+2777 17          .     RLA              

+2778 FF          .     RST   38         

+2779 FF          .     RST   38         

+277A FF          .     RST   38         

+277B FF          .     RST   38         

+277C FF          .     RST   38         

+277D FF          .     RST   38         

+277E FF          .     RST   38         

+277F FF          .     RST   38         

+2780 FF          .     RST   38         

+2781 FF          .     RST   38         

+2782 FF          .     RST   38         

+2783 FF          .     RST   38         

+2784 FF          .     RST   38         

+2785 FF          .     RST   38         

+2786 FF          .     RST   38         

+2787 FF          .     RST   38         

+2788 FF          .     RST   38         

+2789 00          .     NOP              ; kanal 9

+278A 00          .     NOP              

+278B FF          .     RST   38         

+278C FF          .     RST   38         

+278D 07          .     RLCA             

+278E 07          .     RLCA             

+278F 17          .     RLA              

+2790 FF          .     RST   38         

+2791 FF          .     RST   38         

+2792 FF          .     RST   38         

+2793 FF          .     RST   38         

+2794 FF          .     RST   38         

+2795 FF          .     RST   38         

+2796 FF          .     RST   38         

+2797 FF          .     RST   38         

+2798 FF          .     RST   38         

+2799 FF          .     RST   38         

+279A FF          .     RST   38         

+279B FF          .     RST   38         

+279C FF          .     RST   38         

+279D FF          .     RST   38         

+279E FF          .     RST   38         

+279F FF          .     RST   38         

+27A0 FF          .     RST   38         

+27A1 00          .     NOP              ; kanal 10

+27A2 00          .     NOP              

+27A3 FF          .     RST   38         

+27A4 FF          .     RST   38         

+27A5 07          .     RLCA             

+27A6 07          .     RLCA             

+27A7 17          .     RLA              

+27A8 FF          .     RST   38         

+27A9 FF          .     RST   38         

+27AA FF          .     RST   38         

+27AB FF          .     RST   38         

+27AC FF          .     RST   38         

+27AD FF          .     RST   38         

+27AE FF          .     RST   38         

+27AF FF          .     RST   38         

+27B0 FF          .     RST   38         

+27B1 FF          .     RST   38         

+27B2 FF          .     RST   38         

+27B3 FF          .     RST   38         

+27B4 FF          .     RST   38         

+27B5 FF          .     RST   38         

+27B6 FF          .     RST   38         

+27B7 FF          .     RST   38         

+27B8 FF          .     RST   38         

+27B9 00          .     NOP              ; kanal 11

+27BA 00          .     NOP              

+27BB FF          .     RST   38         

+27BC FF          .     RST   38         

+27BD 07          .     RLCA             

+27BE 07          .     RLCA             

+27BF 17          .     RLA              

+27C0 FF          .     RST   38         

+27C1 FF          .     RST   38         

+27C2 FF          .     RST   38         

+27C3 FF          .     RST   38         

+27C4 FF          .     RST   38         

+27C5 FF          .     RST   38         

+27C6 FF          .     RST   38         

+27C7 FF          .     RST   38         

+27C8 FF          .     RST   38         

+27C9 FF          .     RST   38         

+27CA FF          .     RST   38         

+27CB FF          .     RST   38         

+27CC FF          .     RST   38         

+27CD FF          .     RST   38         

+27CE FF          .     RST   38         

+27CF FF          .     RST   38         

+27D0 FF          .     RST   38         

+27D1 00          .     NOP              ; kanal 12

+27D2 00          .     NOP              

+27D3 FF          .     RST   38         

+27D4 FF          .     RST   38         

+27D5 07          .     RLCA             

+27D6 07          .     RLCA             

+27D7 17          .     RLA              

+27D8 FF          .     RST   38         

+27D9 FF          .     RST   38         

+27DA FF          .     RST   38         

+27DB FF          .     RST   38         

+27DC FF          .     RST   38         

+27DD FF          .     RST   38         

+27DE FF          .     RST   38         

+27DF FF          .     RST   38         

+27E0 FF          .     RST   38         

+27E1 FF          .     RST   38         

+27E2 FF          .     RST   38         

+27E3 FF          .     RST   38         

+27E4 FF          .     RST   38         

+27E5 FF          .     RST   38         

+27E6 FF          .     RST   38         

+27E7 FF          .     RST   38         

+27E8 FF          .     RST   38         

+27E9 00          .     NOP              ; kanal 13

+27EA 00          .     NOP              

+27EB FF          .     RST   38         

+27EC FF          .     RST   38         

+27ED 07          .     RLCA             

+27EE 07          .     RLCA             

+27EF 17          .     RLA              

+27F0 FF          .     RST   38         

+27F1 FF          .     RST   38         

+27F2 FF          .     RST   38         

+27F3 FF          .     RST   38         

+27F4 FF          .     RST   38         

+27F5 FF          .     RST   38         

+27F6 FF          .     RST   38         

+27F7 FF          .     RST   38         

+27F8 FF          .     RST   38         

+27F9 FF          .     RST   38         

+27FA FF          .     RST   38         

+27FB FF          .     RST   38         

+27FC FF          .     RST   38         

+27FD FF          .     RST   38         

+27FE FF          .     RST   38         

+27FF FF          .     RST   38         

+2800 FF          .     RST   38         

+2801 00          .     NOP              ; kanal 14

+2802 00          .     NOP              

+2803 FF          .     RST   38         

+2804 FF          .     RST   38         

+2805 07          .     RLCA             

+2806 07          .     RLCA             

+2807 17          .     RLA              

+2808 FF          .     RST   38         

+2809 FF          .     RST   38         

+280A FF          .     RST   38         

+280B FF          .     RST   38         

+280C FF          .     RST   38         

+280D FF          .     RST   38         

+280E FF          .     RST   38         

+280F FF          .     RST   38         

+2810 FF          .     RST   38         

+2811 FF          .     RST   38         

+2812 FF          .     RST   38         

+2813 FF          .     RST   38         

+2814 FF          .     RST   38         

+2815 FF          .     RST   38         

+2816 FF          .     RST   38         

+2817 FF          .     RST   38         

+2818 FF          .     RST   38         

+2819 00          .     NOP              ; kanal 15

+281A 00          .     NOP              

+281B FF          .     RST   38         

+281C FF          .     RST   38         

+281D 07          .     RLCA             

+281E 07          .     RLCA             

+281F 17          .     RLA              

+2820 FF          .     RST   38         

+2821 FF          .     RST   38         

+2822 FF          .     RST   38         

+2823 FF          .     RST   38         

+2824 FF          .     RST   38         

+2825 FF          .     RST   38         

+2826 FF          .     RST   38         

+2827 FF          .     RST   38         

+2828 FF          .     RST   38         

+2829 FF          .     RST   38         

+282A FF          .     RST   38         

+282B FF          .     RST   38         

+282C FF          .     RST   38         

+282D FF          .     RST   38         

+282E FF          .     RST   38         

+282F FF          .     RST   38         

+2830 FF          .     RST   38         

+2831 00          .     NOP              ; kanal 16

+2832 00          .     NOP              

+2833 FF          .     RST   38         

+2834 FF          .     RST   38         

+2835 07          .     RLCA             

+2836 07          .     RLCA             

+2837 17          .     RLA              

+2838 FF          .     RST   38         

+2839 FF          .     RST   38         

+283A FF          .     RST   38         

+283B FF          .     RST   38         

+283C FF          .     RST   38         

+283D FF          .     RST   38         

+283E FF          .     RST   38         

+283F FF          .     RST   38         

+2840 FF          .     RST   38         

+2841 FF          .     RST   38         

+2842 FF          .     RST   38         

+2843 FF          .     RST   38         

+2844 FF          .     RST   38         

+2845 FF          .     RST   38         

+2846 FF          .     RST   38         

+2847 FF          .     RST   38         

+2848 FF          .     RST   38         

+2849 73          s     LD    (HL),E     ; "shdifc.z80 001 (!)"

+284A 68          h     LD    L,B        

+284B 64          d     LD    H,H        

+284C 69          i     LD    L,C        

+284D 66          f     LD    H,(HL)     

+284E 63          c     LD    H,E        

+284F 2E 7A       .z    LD    L,7A       

+2851 38 30       80    JR    C,2883     

+2853 20 30        0    JR    NZ,2885    

+2855 30 31       01    JR    NC,2888    

+2857 20 28        (    JR    NZ,2881    

+2859 21 29 

+285B FF                                 ;------ 69 Bytes von hier -------

+285C FF          .     RST   38         ; "SHARD           "

+285D FF          .     RST   38         

+285E FF          .     RST   38         

+285F FF          .     RST   38         

+2860 FF          .     RST   38         

+2861 FF          .     RST   38         

+2862 FF          .     RST   38         

+2863 FF          .     RST   38         

+2864 FF          .     RST   38         

+2865 FF          .     RST   38         

+2866 FF          .     RST   38         

+2867 FF          .     RST   38         

+2868 FF          .     RST   38         

+2869 FF          .     RST   38         

+286A FF          .     RST   38         ; Shard Interface

+286B 06                                 ; SHard versionnummer(wird veraendert

+286C 00                                 ; "

+286D 00          .     NOP              ; mode :BIT 0: 1=frei eumel0

+286E 00          .     NOP              ; bit 8:0=speichetest,9:0=vortest

+286F 00          .     NOP              ; id4

+2870 00          .     NOP              

+2871 00          .     NOP              ; id5

+2872 00          .     NOP              

+2873 00          .     NOP              ; id6

+2874 00          .     NOP              

+2875 00          .     NOP              ; id7

+2876 00          .     NOP              

+2877 00          .     NOP              ; leer

+2878 00          .     NOP              

+2879 00          .     NOP              ; leer

+287A 00          .     NOP              

+287B C3 06 01    ...   JP    0106       ; OUTPUT

+287E C3 09 01    ...   JP    0109       ; BLOCKIN

+2881 C3 0C 01    ...   JP    010C       ; BLOCKOUT

+2884 C3 0F 01    ...   JP    010F       ; IOCONTROL

+2887 C3 12 01    ...   JP    0112       ; SYSEND

+288A C3 15 01    ...   JP    0115       ; SCHINF

+288D C3 18 01    ...   JP    0118       ; SCHACC

+2890 00          .     NOP              ; leer

+2891 00          .     NOP              

+2892 00          .     NOP              ; RAM-Limit low

+2893 00          .     NOP              ;    " high

+2894 00          .     NOP              

+2895 00          .     NOP              

+2896 00          .     NOP              

+2897 00          .     NOP              

+2898 00          .     NOP              

+2899 00          .     NOP              

+289A 00          .     NOP              

+289B 00          .     NOP              

+289C 00          .     NOP              

+289D 00          .     NOP              

+289E 00          .     NOP              

+289F 00          .     NOP              ;----------- bis hier ---------

+28A0 ED 5B 92 28 .[.(  LD    DE,(2892)  ; RAM-Limit laden

+28A4 C9          .     RET              ;-------------------------------

+28A5 ED B0       ..    LDIR             ; Longmove = LDIR (immer)

+28A7 C9          .     RET              

+28A8 B7          .     OR    A          ; Intern IOCONTROL

+28A9 20 D9        .    JR    NZ,2884    ; Fuer alle Kanale > 0: IOCONTROL

+28AB 79          y     LD    A,C        

+28AC FE 05       ..    CP    05         ; HG-Kanal Fkt. 5 : Size

+28AE 28 03       (.    JR    Z,28B3     

+28B0 97          .     SUB   A          ; Alle anderen HG-Controls weiter

+28B1 18 D1       ..    JR    2884       ; IOCONTROL

+28B3 97          .     SUB   A          

+28B4 CD 84 28    ..(   CALL  2884       ; Anz. Bloecke DIV 65536 in A

+28B7 E5          .     PUSH  HL         

+28B8 67          g     LD    H,A        ; A retten

+28B9 3A 6B 28    :k(   LD    A,(286B)   ; Shard Version

+28BC FE 07       ..    CP    07         

+28BE 30 02       0.    JR    NC,28C2    ; 

+28C0 26 00       &.    LD    H,00       ; Shard Version 6 : Hoechstens 65536

+28C2 7C          |     LD    A,H        ; Shard Version > 6 : Auch mehr als^

+28C3 B7          .     OR    A          

+28C4 20 08        .    JR    NZ,28CE    

+28C6 21 80 7E    !.~   LD    HL,7E80    ; 

+28C9 B7          .     OR    A          ; CLC

+28CA ED 42       .B    SBC   HL,BC      

+28CC E1          .     POP   HL         

+28CD D0          .     RET   NC         

+28CE E1          .     POP   HL         

+28CF 97          .     SUB   A          ; Maximum an Bloecken: 32384

+28D0 01 80 7E    ..~   LD    BC,7E80    ; 15MB + 832 KB

+28D3 C9          .     RET              ;========== 175 Systemstart =======

+28D4 11 5B 28    .[(   LD    DE,285B    ; 69 Bytes uebertragen

+28D7 01 45 00    .E.   LD    BC,0045    ; Von Shard Leiste --> EUMEL0

+28DA ED B0       ..    LDIR             ; 175 Systemstart

+28DC C3 99 14    ...   JP    1499       ;========= 173 Systemstart ========

+28DF 3A 1E 01    :..   LD    A,(011E)   ; Shardversion

+28E2 32 6B 28    2k(   LD    (286B),A   

+28E5 FE 07       ..    CP    07         ; >= 7 : falsche Leiste !

+28E7 30 0A       0.    JR    NC,28F3    

+28E9 CD 03 01    ...   CALL  0103       ; LIMIT erfragen

+28EC ED 53 92 28 .S.(  LD    (2892),DE  ; Eintragen

+28F0 C3 99 14    ...   JP    1499       ; Zum neuen Systemstart (175)

+28F3 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+28F6 18 0F       ..    JR    2907       

+28F8 20 66        f    JR    NZ,2960    ; " falsche Leiste"

+28FA 61          a     LD    H,C        

+28FB 6C          l     LD    L,H        

+28FC 73          s     LD    (HL),E     

+28FD 63          c     LD    H,E        

+28FE 68          h     LD    L,B        

+28FF 65          e     LD    H,L        

+2900 20 4C        L    JR    NZ,294E    

+2902 65          e     LD    H,L        

+2903 69          i     LD    L,C        

+2904 73          s     LD    (HL),E     

+2905 74          t     LD    (HL),H     

+2906 65          e     LD    H,L        

+2907 18 EA       ..    JR    28F3       ; Endlos

+2909 F5          .     PUSH  AF         ; Info Aufruf vom Shard

+290A 3E F2       >.    LD    A,F2       

+290C 32 19 7D    2.}   LD    (7D19),A   

+290F F1          .     POP   AF         

+2910 CD 1F 70    ..p   CALL  701F       

+2913 18 06       ..    JR    291B       ; Info aufrufen

+2915 20 73        s    JR    NZ,298A    ; " shard"

+2917 68          h     LD    L,B        

+2918 61          a     LD    H,C        

+2919 72          r     LD    (HL),D     

+291A 64          d     LD    H,H        

+291B C9          .     RET              ;---------------------------------

+291C 3E 04       >.    LD    A,04       ; shutup anfordern

+291E C3 BB 81    ...   JP    81BB       

+2921 3A 00                              ; Task geht in Wartezustand--------

+2923 DD 77 06          LD    (IX+6),A   ; status pcb-Feld setzen

+2926 DD CB 07 7E       BIT   7,(IX+7)

+292A C4 02 2A    ..*   CALL  NZ,2A02    ; Speicherfelder --> pcb-felder

+292D 31 13 6D    1.m   LD    SP,6D13    ; Schleifenanfang fuer offenen Warte

+2930 CD 41 6B    .Ak   CALL  6B41       ; zustand

+2933 3A 1A 6E    :.n   LD    A,(6E1A)   

+2936 3D          =     DEC   A          

+2937 CC 38 4C    .8L   CALL  Z,4C38     ; Supervisor

+293A DD 7E 06    .~.   LD    A,(IX+06)  

+293D CB 47       .G    BIT   0,A        ; geblockt, keine Aktion bis entblockt

+293F 20 3D        =    JR    NZ,297E    

+2941 E6 3C       .<    AND   3C         ; Statusbist ausblenden

+2943 FE 2C       .,    CP    2C         

+2945 D2 D8 29    ..)   JP    NC,29D8    

+2948 32 51 29    2Q)   LD    (2951),A   

+294B FE 18       ..    CP    18         ; 18 : Leitblockfelder --> Speicher

+294D D4 46 2A    .F*   CALL  NC,2A46    

+2950 18 FE       ..    JR    2950       ; Sprung in Tabelle

+2952 C3 CC 29    ..)   JP    29CC       ; 00 : Test, ob haltprocess

+2955 FF          .     RST   38         

+2956 C3 BE 29    ..)   JP    29BE       ; 04 : auf kanalankoppeln warten

+2959 FF          .     RST   38         

+295A C3 AA 29    ..)   JP    29AA       ; 08 : warten auf tastendruck

+295D FF          .     RST   38         

+295E C3 95 29    ..)   JP    2995       ; 0C : pause (in mod)

+2961 FF          .     RST   38         

+2962 C3 7C 2E    .|.   JP    2E7C       ; 10 : Busy, RET TRUE, test halt

+2965 FF          .     RST   38         

+2966 C3 81 2E    ...   JP    2E81       ; 14 : Busy, RET FALSE, test halt

+2969 FF          .     RST   38         

+296A C3 B5 2F    ../   JP    2FB5       ; 18 : CALL PROC

+296D FF          .     RST   38         

+296E C3 38 3D    .8=   JP    3D38       ; 1C : EXTERNAL TERM

+2971 FF          .     RST   38         

+2972 C3 3D 4A    .=J   JP    4A3D       ; 20 : anford. garbagecollect.

+2975 FF          .     RST   38         

+2976 C3 5D 4A    .]J   JP    4A5D       ; 24 : garbage collect. 1. Teil 

+2979 FF          .     RST   38         

+297A C3 09 4B    ..K   JP    4B09       ; 28 : garbage collect. 2 teil

+297D FF          .     RST   38         

+297E 3A 1A 6E    :.n   LD    A,(6E1A)   ; Supervisor  

+2981 FE 01       ..    CP    01         

+2983 20 0A        .    JR    NZ,298F    

+2985 F3          .     DI               

+2986 3A F9 4C    :.L   LD    A,(4CF9)   

+2989 B7          .     OR    A          

+298A 3A 1A 6E    :.n   LD    A,(6E1A)   

+298D 20 03        .    JR    NZ,2992    ; SV-Call angefordert ?

+298F CD 74 6D    .tm   CALL  6D74       ; block SV

+2992 FB          .     EI               

+2993 18 98       ..    JR    292D       

+2995 2A F1 4C    *.L   LD    HL,(4CF1)  ; Pausenende abwarten

+2998 DD 7E 0C    .~.   LD    A,(IX+0C)  

+299B 95          .     SUB   L          

+299C DD 7E 0D    .~.   LD    A,(IX+0D)  

+299F 9C          .     SBC   H          

+29A0 FA CC 29    ..)   JP    M,29CC     

+29A3 DD 7E 26    .~&   LD    A,(IX+26)  

+29A6 B7          .     OR    A          

+29A7 CA 2D 29    .-)   JP    Z,292D     

+29AA DD CB 05 46 ...F  BIT   0,(IX+05)  

+29AE 20 1C        .    JR    NZ,29CC    

+29B0 DD 7E 26    .~&   LD    A,(IX+26)  

+29B3 B7          .     OR    A          

+29B4 28 C8       (.    JR    Z,297E     

+29B6 CD AD 1E    ...   CALL  1EAD       ; taste gedrueckt ?

+29B9 DA 2D 29    .-)   JP    C,292D     

+29BC 18 0E       ..    JR    29CC       

+29BE DD 7E 26    .~&   LD    A,(IX+26)  

+29C1 B7          .     OR    A          

+29C2 28 BA       (.    JR    Z,297E     

+29C4 CD 59 1E    .Y.   CALL  1E59       

+29C7 FE 1E       ..    CP    1E         ; Mindestens 30 Zeichen uebernehmen 

+29C9 DA 2D 29    .-)   JP    C,292D     

+29CC DD 35       .5    DEC   (IX+08)

+29CE 08          .     EX    AF,AF'     

+29CF F2 2D 29    .-)   JP    P,292D     

+29D2 CD 7E 2A    .~*   CALL  2A7E       ; Test, ob halt process

+29D5 C3 A7 2A    ..*   JP    2AA7       ; zur interpreter schleife

+29D8 DD CB 05 46 ...F  BIT   0,(IX+05)  

+29DC 20 EE        .    JR    NZ,29CC    

+29DE DD 7E 34    .~4   LD    A,(IX+34)  

+29E1 B7          .     OR    A          

+29E2 20 9A        .    JR    NZ,297E    

+29E4 DD 7E 26    .~&   LD    A,(IX+26)  

+29E7 B7          .     OR    A          

+29E8 28 94       (.    JR    Z,297E     

+29EA CD AD 1E    ...   CALL  1EAD       ; taste gedrueckt ?

+29ED DA 2D 29    .-)   JP    C,292D     

+29F0 DD 36 2C FC .6,.  LD    (IX+2C),FC ; msgcod := -4

+29F4 DD 36 2D FF .6-.  LD    (IX+2D),FF 

+29F8 DD 36 2E 01 .6..  LD    (IX+2E),01 

+29FC DD CB 07 DE ....  SET   3,(IX+07)  

+2A00 18 CA       ..    JR    29CC       ;---------------------------------

+2A02 CD F6 4B    ..K   CALL  4BF6       

+2A05 DD CB 07 BE ....  RES   7,(IX+07)  ; Felder wurden uebertragen

+2A09 ED 5B 1C 6E .[.n  LD    DE,(6E1C)  

+2A0D 1E 10       ..    LD    E,10       ; 10..17

+2A0F 21 C4 41    !.A   LD    HL,41C4    ; pcb Felder von Hauptspeicher

+2A12 ED A0       ..    LDI              ; in Leitblock  uebertragen

+2A14 ED A0       ..    LDI              ; lbas

+2A16 ED A0       ..    LDI              ; ltop

+2A18 ED A0       ..    LDI

+2A1A ED A0       ..    LDI              ; ls_top

+2A1C ED A0       ..    LDI              

+2A1E ED A0       ..    LDI              ; hptop

+2A20 ED A0       ..    LDI              

+2A22 DD CB 07 6E ...n  BIT   5,(IX+07)  

+2A26 C4 4D 45    .ME   CALL  NZ,454D    

+2A29 D9          .     EXX              ; pbas

+2A2A DD 71 0E    .q.   LD    (IX+0E),C  

+2A2D DD 7E 2A    .~*   LD    A,(IX+2A)  ; prio --> pricnt

+2A30 DD 77 08    .w.   LD    (IX+08),A  

+2A33 08          .     EX    AF,AF'     

+2A34 DD CB 09 16 ....  RL    (IX+09)    

+2A38 1F          .     RRA              

+2A39 30 07       0.    JR    NC,2A42    

+2A3B D6 80       ..    SUB   A,80       

+2A3D 30 03       0.    JR    NC,2A42    

+2A3F DD 35       .5    DEC   (IX+0A)    

+2A41 0A          .     LD    A,(BC)     

+2A42 DD 77 09    .w.   LD    (IX+09),A  

+2A45 C9          .     RET              ;--------------------------------

+2A46 CD 16 42    ..B   CALL  4216       

+2A49 DD 4E 0E    .N.   LD    C,(IX+0E)  ; pbas

+2A4C 16 19       ..    LD    D,19       

+2A4E D9          .     EXX              

+2A4F 2A 1C 6E    *.n   LD    HL,(6E1C)  ; Leitblock Felder in Hauptspeicher

+2A52 2E 10       ..    LD    L,10       ; uebertragen

+2A54 11 C4 41    ..A   LD    DE,41C4    

+2A57 ED A0       ..    LDI              

+2A59 ED A0       ..    LDI              

+2A5B ED A0       ..    LDI              

+2A5D ED A0       ..    LDI              

+2A5F ED A0       ..    LDI              

+2A61 ED A0       ..    LDI              

+2A63 ED A0       ..    LDI              

+2A65 ED A0       ..    LDI              

+2A67 CD AB 42    ..B   CALL  42AB       

+2A6A DD 4E 09    .N.   LD    C,(IX+09)  

+2A6D CB 21       .!    SLA   C          

+2A6F 17          .     RLA              

+2A70 47          G     LD    B,A        

+2A71 DD CB 07 FE ....  SET   7,(IX+07)  ; Felder wurden uebertragen

+2A75 79          y     LD    A,C        

+2A76 08          .     EX    AF,AF'     

+2A77 CD DB 4B    ..K   CALL  4BDB       ; millis verringern

+2A7A CD 93 2A    ..*   CALL  2A93       

+2A7D C9          .     RET              ;--------------------------------

+2A7E CD 46 2A    .F*   CALL  2A46       

+2A81 DD 36 06 00 .6..  LD    (IX+06),00 

+2A85 DD CB 05 46 ...F  BIT   0,(IX+05)  ; halt process angefordert ?

+2A89 C8          .     RET   Z          

+2A8A DD CB 05 86 ....  RES   0,(IX+05)  

+2A8E 3E 01       >.    LD    A,01       

+2A90 C3 0D 3D    ..=   JP    3D0D       ; errorstop "halt from terminal"

+2A93 21 E6 7C    !.|   LD    HL,7CE6    ; AND 7C--------------------------

+2A96 22 AE 2A    ".*   LD    (2AAE),HL  

+2A99 C9          .     RET              

+2A9A 21 18 F1    !..   LD    HL,F118    ; JR 2AA1

+2A9D 22 AE 2A    ".*   LD    (2AAE),HL  

+2AA0 C9          .     RET              

+2AA1 CD 93 2A    ..*   CALL  2A93       ; AND 7C Maske setzen

+2AA4 C3 26 29    .&)   JP    2926       ; Je nach Status reagieren 

+2AA7 79          y     LD    A,C        ;----------------------------------

+2AA8 08          .     EX    AF,AF'

+2AA9 0A          .     LD    A,(BC)     

+2AAA 6F          o     LD    L,A        

+2AAB 0C          .     INC   C          

+2AAC 0A          .     LD    A,(BC)     

+2AAD 67          g     LD    H,A        ; HL := Codeword

+2AAE E6 7C       .|    AND   7C         ; Opcodebits ausmaskieren

+2AB0 32 B6 2A    2.*   LD    (2AB6),A   ; Opcode setzen

+2AB3 AC          .     XOR   H          ; Datenbits in A

+2AB4 0C          .     INC   C          ; BC zeigt auf naechsten Opcode

+2AB5 20 FE        .    JR    NZ,2AB5    ; Wird 

+2AB7 C3 8C 2C    ..,   JP    2C8C       ; Neue Seite, ggf neuen Block laden

+2ABA FF          .     RST   38         ; und Restart (EUMEL0-Restart)

+2ABB C3 F1 2C    ..,   JP    2CF1       ; 0 LN (nr)

+2ABE FF          .     RST   38         ; 1 LONGLN (nr-1024)

+2ABF C3 FD 2C    ..,   JP    2CFD       ; 2 MOV1 (source, dest)

+2AC2 FF          .     RST   38         

+2AC3 C3 11 2D    ..-   JP    2D11       ; 3 INC1 (dest) 

+2AC6 FF          .     RST   38         

+2AC7 C3 1F 2D    ..-   JP    2D1F       ; 4 DEC1 (dest)

+2ACA FF          .     RST   38         

+2ACB C3 30 2D    .0-   JP    2D30       ; 5 INC (source, dest)

+2ACE FF          .     RST   38         

+2ACF C3 50 2D    .P-   JP    2D50       ; 6 DEC (source, dest)

+2AD2 FF          .     RST   38         

+2AD3 C3 65 2D    .e-   JP    2D65       ; 7 ADD (a, b, c)

+2AD6 FF          .     RST   38         

+2AD7 C3 82 2D    ..-   JP    2D82       ; 8 SUB (a, b, c)

+2ADA FF          .     RST   38         

+2ADB C3 D2 2D    ..-   JP    2DD2       ; 9 CLEAR (dest)

+2ADE FF          .     RST   38         

+2ADF C3 2B 2E    .+.   JP    2E2B       ; 10 TEST (source) --> BOOL

+2AE2 FF          .     RST   38         

+2AE3 C3 60 2E    .`.   JP    2E60       ; 11 EQU (a, b) --> BOOL

+2AE6 FF          .     RST   38         

+2AE7 C3 35 2E    .5.   JP    2E35       ; 12 LSEQ (a, b) --> BOOL

+2AEA FF          .     RST   38         

+2AEB C3 04 35    ..5   JP    3504       ; 13 MOV8 (source, dest)

+2AEE FF          .     RST   38         

+2AEF C3 20 35    . 5   JP    3520       ; 14 FADD (a, b, c)

+2AF2 FF          .     RST   38         

+2AF3 C3 3B 35    .;5   JP    353B       ; 15 FSUB (a, b, c)

+2AF6 FF          .     RST   38         

+2AF7 C3 41 35    .A5   JP    3541       ; 16 FMULT (a, b, c) 

+2AFA FF          .     RST   38         

+2AFB C3 47 35    .G5   JP    3547       ; 17 FDIV (a, b, c)

+2AFE FF          .     RST   38         

+2AFF C3 5D 35    .]5   JP    355D       ; 18 FLSEQ (a, b) --> BOOL

+2B02 FF          .     RST   38         

+2B03 C3 CD 30    ..0   JP    30CD       ; 19 TMOV (source, dest)

+2B06 FF          .     RST   38         

+2B07 C3 0F 31    ..1   JP    310F       ; 20 TEQU (a, b) --> BOOL

+2B0A FF          .     RST   38         

+2B0B C3 4E 2E    .N.   JP    2E4E       ; 21 ULSEQU (a, b) --> BOOL

+2B0E FF          .     RST   38         

+2B0F C3 03 36    ..6   JP    3603       ; 22 ACCDS (dsid, refadr)

+2B12 FF          .     RST   38         

+2B13 C3 21 36    .!6   JP    3621       ; 23 REF (source, refadr)

+2B16 FF          .     RST   38         

+2B17 C3 43 36    .C6   JP    3643       ; 24 SUBS (limit-1, index, refadr)

+2B1A FF          .     RST   38         

+2B1B C3 27 36    .'6   JP    3627       ; 25 SEL (base, offset, refadr)

+2B1E FF          .     RST   38         

+2B1F C3 02 2F    ../   JP    2F02       ; 26 PPV (source)

+2B22 FF          .     RST   38         

+2B23 C3 07 2F    ../   JP    2F07       ; 27 PP (source)

+2B26 FF          .     RST   38         

+2B27 C3 8E 2E    ...   JP    2E8E       ; 28 BR (lowadr)

+2B2A FF          .     RST   38         

+2B2B C3 A3 2E    ...   JP    2EA3       ; 29 LONGBR (lowadr-1024)

+2B2E FF          .     RST   38         

+2B2F C3 40 2F    .@/   JP    2F40       ; 30 CALL (modnr)

+2B32 FF          .     RST   38         

+2B33 07          .     RLCA             ; 31 ...

+2B34 07          .     RLCA             

+2B35 07          .     RLCA             

+2B36 32 3A 2B    2:+   LD    (2B3A),A   

+2B39 18 FE       ..    JR    2B39       ; Sprung auf SPezial

+2B3B C3 6E 36    .n6   JP    366E       ; 0 : ISXCHAR (char) --> BOOL

+2B3E FF          .     RST   38         

+2B3F C3 80 36    ..6   JP    3680       ; 1 : STIM (byteval, dest) 

+2B42 FF          .     RST   38         

+2B43 C3 8C 36    ..6   JP    368C       ; 2 : MOVX (bytelen, source, dest)

+2B46 FF          .     RST   38         

+2B47 C3 D2 36    ..6   JP    36D2       ; 3 : PW (ds+segment, offs, value) 

+2B4A FF          .     RST   38         

+2B4B C3 C9 36    ..6   JP    36C9       ; 4 : GW (ds+segment, offs, result) 

+2B4E FF          .     RST   38         

+2B4F C3 DE 2F    ../   JP    2FDE       ; 5 : PENTER (highbyte)

+2B52 FF          .     RST   38         

+2B53 C3 76 2B    .v+   JP    2B76       ; 6 : ESC (functionbyte)

+2B56 FF          .     RST   38         

+2B57 7D          }     LD    A,L        ; 7 : LONGA (opcodebyte)

+2B58 32 B6 2A    2.*   LD    (2AB6),A   

+2B5B E6 83       ..    AND   83         

+2B5D 20 08        .    JR    NZ,2B67    

+2B5F 0A          .     LD    A,(BC)     

+2B60 6F          o     LD    L,A        

+2B61 0C          .     INC   C          ; Zur Interpreterschleife mit Opcode 

+2B62 0A          .     LD    A,(BC)     

+2B63 0C          .     INC   C          

+2B64 C3 B5 2A    ..*   JP    2AB5       ; --------

+2B67 3E FD       >.    LD    A,FD       ; -3 = Block unlesbar

+2B69 BD          .     CP    L          

+2B6A C2 F4 3C    ..<   JP    NZ,3CF4    

+2B6D DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop

+2B71 3E 10       >.    LD    A,10       ; Errorstop Block unlesbar 

+2B73 C3 12 3D    ..=   JP    3D12       ;------------ ESC ---------------

+2B76 7D          }     LD    A,L        

+2B77 FE 82       ..    CP    82         ; 129 ist Maximum ESC 

+2B79 D2 F4 3C    ..<   JP    NC,3CF4    

+2B7C 26 00       &.    LD    H,00       

+2B7E 29          )     ADD   HL,HL      ; * 2 fuer Zugriff

+2B7F 11 88 2B    ..+   LD    DE,2B88    ; Tabellen anfang

+2B82 19          .     ADD   HL,DE      

+2B83 5E          ^     LD    E,(HL)     

+2B84 23          #     INC   HL         

+2B85 56          V     LD    D,(HL)     ; Sprung addresse --> DE

+2B86 EB          .     EX    DE,HL      

+2B87 E9          .     JP    (HL)       ; EXTERNAL aufrufen-------------

+2B88 F3 2F       0 : RTN 

+2B8A F9 2F       1 : RTN FALSE --> BOOL

+2B8C 0A 30       2 : RTN TRUE  --> BOOL

+2B8E F4 3C       3 : --------

+2B90 38 3D       4 : TERM

+2B92 7F 30       5 : GOSUB (adr) 

+2B94 0E 37       6 : KE 

+2B96 AF 30       7 : GORET (adr) 

+2B98 CE 3A       8 : CRD (var, var)

+2B9A DA 3A       9 : BCRD (var, var)

+2B9C B3 3A      10 : CWR (var, char, int)

+2B9E 79 3A      11 : ECWR (var, var, char) 

+2BA0 1B 3B      12 : CTT (int, refadr) 

+2BA2 26 3B      13 : GETC (text, posvar) 

+2BA4 54 3B      14 : FNONBL (charvar, text, posvar) --> BOOL

+2BA6 A7 3B      15 : DREM256 (var, var) 

+2BA8 BC 3B      16 : AMUL256 (var, int)

+2BAA F4 3C      17 : ---------

+2BAC DF 3B      18 : ISDIG (char) --> BOOL 

+2BAE CC 3B      19 : ISLD (char) --> BOOL 

+2BB0 F1 3B      20 : ISLCAS (char) --> BOOL 

+2BB2 F6 3B      21 : ISUCAS (chasr) --> BOOL 

+2BB4 FB 3B      22 : GADDR (a, b, c) 

+2BB6 17 3C      23 : GCADDR (a, b, c) --> BOOL 

+2BB8 36 3C      24 : ISSHA (int) --> BOOL 

+2BBA 14 37      25 : SYSGEN 

+2BBC 42 3C      26 : GETTAB 

+2BBE 58 3C      27 : PUTTAB 

+2BC0 62 3C      28 : ERATAB 

+2BC2 3A 2F      29 : EXEC (modnr)

+2BC4 E8 2E      30 : PPROC (modnr) 

+2BC6 33 2F      31 : PCALL (adr) 

+2BC8 CC 2E      32 : CASE (switch, limit)

+2BCA 86 36      33 : MOVEXX (len, from, to) 

+2BCC 9A 38      34 : ALIAS (...,...) 

+2BCE 0C 2D      35 : MOVIM (...,...) 

+2BD0 4D 35      36 : FEQU (a, b) --> BOOL 

+2BD2 44 31      37 : TLSEQ (a, b) --> BOOL 

+2BD4 6E 35      38 : FCOMPL (source, dest)

+2BD6 DC 2D      39 : COMPL (source, dest) 

+2BD8 C1 2D      40 : IMULT (a, b, c) 

+2BDA A0 2D      41 : MULT (a, b, c) 

+2BDC AC 2D      42 : DIV (a, b, c) 

+2BDE B8 2D      43 : MOD (a, b, c) 

+2BE0 9F 34      44 : ISUB (text, pos, result) 

+2BE2 8D 34      45 : replace (text, pos, int) 

+2BE4 A8 31      46 : CODE (text, result)

+2BE6 B9 31      47 : ENCODE (int, text) 

+2BE8 C2 31      48 : SUB (text, pos, result) 

+2BEA CE 31      49 : subtext (source, from, to, result) 

+2BEC C8 31      50 : subtext (source, from, result)

+2BEE 2F 32      51 : replace (text, pos, text) 

+2BF0 D4 31      52 : CAT (text, text) 

+2BF2 97 31      53 : LENGTH (text, result) 

+2BF4 81 32      54 : pos (source, pattern, result) 

+2BF6 89 32      55 : pos (source, pattern, from, result)

+2BF8 92 32      56 : pos (source, pattern, from, to, result) 

+2BFA 93 33      57 : stranalyze (row256int, intv,int,text,intv,int,intv)

+2BFC 42 33      58 : pos (source, low, high, from, result) 

+2BFE F4 3C      59 : ------------

+2C00 67 37      60 : out (text) 

+2C02 1A 37      61 : cout (int) 

+2C04 5D 37      62 : outsubtext (text, from) 

+2C06 62 37      63 : outsubtext (text, from, to) 

+2C08 9E 37      64 : inchar (result) 

+2C0A BD 37      65 : incharety (result) 

+2C0C D4 37      66 : pause (time) 

+2C0E F5 37      67 : getcursor (x, y)

+2C10 10 38      68 : catinput (textv, escchar) 

+2C12 E5 38      69 : nilspace (result) 

+2C14 EB 38      70 : dscopy (dest, source)

+2C16 19 39      71 : forget (ds) 

+2C18 47 39      72 : settype (ds, type) 

+2C1A 68 39      73 : gettype (ds, type) 

+2C1C 79 39      74 : heapsize (ds, size) 

+2C1E 4E 3D      75 : enablestop 

+2C20 5B 3D      76 : disablestop 

+2C22 62 3D      77 : seterrorstop (nr) 

+2C24 76 3D      78 : iserror --> BOOL 

+2C26 80 3D      79 : clearerror 

+2C28 9F 3D      80 : readpcb (field, result) 

+2C2A 87 41      81 : infopassword (alt, neu, ok)

+2C2C E4 35      82 : setclock (task, value) 

+2C2E 0E 2E      83 : rotate (int, anzahl) 

+2C30 09 3A      84 : control (fkt, code1, code2, result) 

+2C32 B3 39      85 : blockout (ds, page, code1, code2, result) 

+2C34 E5 39      86 : blockin (ds, page, code1, code2, result) 

+2C36 3B 3A      87 : nextdspage (ds, page, result) 

+2C38 97 39      88 : pages (ds, task, result)

+2C3A 7A 3C      89 : storage (size, used) ?

+2C3C 8D 3C      90 : sysop (nr) 

+2C3E E5 2F      91 : arith15 

+2C40 EC 2F      92 : arith16 

+2C42 7A 34      93 : heapsize (result) 

+2C44 88 34      94 : collectheapgarbage 

+2C46 9D 3E      95 : ? (neues begin)

+2C48 7C 35      96 : shiftleftdigits (in, real, out) 

+2C4A 98 35      97 : decimalexponent (real, result) 

+2C4C A1 35      98 : setexp (exp, real) 

+2C4E AE 35      99 : floor (source, dest) 

+2C50 A3 34     100 : RSUB (text, pos, result) 

+2C52 91 34     101 : replace (text, pos, real) 

+2C54 BC 35     102 : clock (nr, result) 

+2C56 F2 35     103 : setclock (value) 

+2C58 EB 3D     104 : readpcb (task, field, result) 

+2C5A F1 3D     105 : writepcb (task, field, value) 

+2C5C DC 35     106 : readclock (task, result) 

+2C5E 1E 3E     107 : status (task, result) 

+2C60 2E 3E     108 : unblock (task) 

+2C62 41 3E     109 : block (task) 

+2C64 63 3E     110 : halt process (task) 

+2C66 6C 3E     111 : create process (... 

+2C68 52 3F     112 : erase process (task) 

+2C6A B7 40     113 : send (...

+2C6C BD 40     114 : wait (... 

+2C6E 06 41     115 : call (... 

+2C70 F7 3A     116 : cdb int (adr, result) 

+2C72 0E 3B     117 : cdb text (adr, result) 

+2C74 4F 3E     118 : nextactive (taskandresult) 

+2C76 EF 36     119 : putword (seg, adr, value) 

+2C78 E5 36     120 : getword (seg, adr, result) 

+2C7A 02 2E     121 : XOR (a, b, c) 

+2C7C 2B 41     122 : pingpong (... 

+2C7E 5B 3F     123 : exists (task) --> BOOL

+2C80 EA 2D     124 : AND (a, b, c) 

+2C82 F6 2D     125 : OR (a, b, c) 

+2C84 67 41     126 : session (result) 

+2C86 96 40     127 : sendfromto (...

+2C88 51 41     128 : define collector (task) 

+2C8A 6E 41     129 : id (field, result)

+

+2C8C C2 F3 2C    ..,   JP    NZ,2CF3    ; C <> 0: LN Befehl, kein Page

+2C8F F5          .     PUSH  AF         ; Neuen Block

+2C90 3A B6 2A    :.*   LD    A,(2AB6)   ; Opcode BF oder LN

+2C93 FE 70       .p    CP    70         

+2C95 28 02       (.    JR    Z,2C99     

+2C97 FE 74       .t    CP    74         

+2C99 C4 87 42    ..B   CALL  NZ,4287    ; Neue Seite laden

+2C9C F1          .     POP   AF         

+2C9D 04          .     INC   B           

+2C9E 05          .     DEC   B          ; Flag B = 0 setzen

+2C9F C3 B5 2A    ..*   JP    2AB5       ; Befehl nochmal aufsetzen

+2CA2 CD 13 43    ..C   CALL  4313       ;--------------------------------

+2CA5 5E          ^     LD    E,(HL)     ; DE := 1. Codewort

+2CA6 2C          ,     INC   L          

+2CA7 56          V     LD    D,(HL)     

+2CA8 CD 13 43    ..C   CALL  4313       ; HL := 2. Codewort

+2CAB 7E          ~     LD    A,(HL)     

+2CAC 2C          ,     INC   L          

+2CAD 66          f     LD    H,(HL)     

+2CAE 6F          o     LD    L,A        

+2CAF C9          .     RET              ;----------- Bytemove ------------

+2CB0 04          .     INC   B          

+2CB1 05          .     DEC   B          

+2CB2 20 12        .    JR    NZ,2CC6    ; Weniger als 256 Bytes ?

+2CB4 79          y     LD    A,C        ; 256 Bytes in einem Schub per LDIR

+2CB5 B7          .     OR    A          

+2CB6 C8          .     RET   Z          ; Nichts moven

+2CB7 85          .     ADD   L          

+2CB8 38 07       8.    JR    C,2CC1     

+2CBA 79          y     LD    A,C         

+2CBB 83          .     ADD   E          

+2CBC 38 03       8.    JR    C,2CC1     

+2CBE ED B0       ..    LDIR             

+2CC0 C9          .     RET              

+2CC1 3E 0D       >.    LD    A,0D       

+2CC3 B9          .     CP    C          

+2CC4 30 0C       0.    JR    NC,2CD2    

+2CC6 CD 78 45    .xE   CALL  4578       ; Move in mehreren Teilen

+2CC9 C8          .     RET   Z          

+2CCA ED B0       ..    LDIR             

+2CCC D0          .     RET   NC         

+2CCD CD C1 45    ..E   CALL  45C1       

+2CD0 18 F4       ..    JR    2CC6       

+2CD2 7E          ~     LD    A,(HL)     

+2CD3 0D          .     DEC   C          

+2CD4 28 19       (.    JR    Z,2CEF     

+2CD6 F5          .     PUSH  AF         

+2CD7 D5          .     PUSH  DE         

+2CD8 FD 21 85 46 .!.F  LD    IY,4685    

+2CDC 2C          ,     INC   L          

+2CDD CC 1B 45    ..E   CALL  Z,451B     

+2CE0 EB          .     EX    DE,HL      

+2CE1 FD 21 89 46 .!.F  LD    IY,4689    

+2CE5 2C          ,     INC   L          

+2CE6 CC 1B 45    ..E   CALL  Z,451B     

+2CE9 EB          .     EX    DE,HL      

+2CEA CD D2 2C    ..,   CALL  2CD2       ; Teilmove

+2CED D1          .     POP   DE         

+2CEE F1          .     POP   AF         

+2CEF 12          .     LD    (DE),A     

+2CF0 C9          .     RET              ;------------- LONGLN ------------

+2CF1 C6 04       ..    ADD   A,04       ; 

+2CF3 07          .     RLCA             ;------------- LN ----------------

+2CF4 DD 75 20    .u    LD    (IX+20),L  

+2CF7 DD 77 21    .w!   LD    (IX+21),A  

+2CFA C3 A7 2A    ..*   JP    2AA7       ;--------- MOV1  -----------------

+2CFD CD 1B 43    ..C   CALL  431B       ; fromaddresse --> HL

+2D00 5E          ^     LD    E,(HL)     

+2D01 2C          ,     INC   L          

+2D02 56          V     LD    D,(HL)     

+2D03 CD 64 43    .dC   CALL  4364       ; toaddresse --> HL

+2D06 73          s     LD    (HL),E     

+2D07 2C          ,     INC   L          

+2D08 72          r     LD    (HL),D     

+2D09 C3 A7 2A    ..*   JP    2AA7       ;----------- MOVIM --------------

+2D0C CD 43 44    .CD   CALL  4443       

+2D0F 18 F2       ..    JR    2D03       

+2D11 CD 6C 43    .lC   CALL  436C       ;---------- INC1 ----------------

+2D14 34          4     INC   (HL)       

+2D15 C2 A7 2A    ..*   JP    NZ,2AA7    

+2D18 2C          ,     INC   L          

+2D19 34          4     INC   (HL)       

+2D1A E2 A7 2A    ..*   JP    PO,2AA7    

+2D1D 18 2B       .+    JR    2D4A       ;-------------- DEC1 -------------

+2D1F CD 6C 43    .lC   CALL  436C       

+2D22 7E          ~     LD    A,(HL)     

+2D23 D6 01       ..    SUB   A,01       

+2D25 77          w     LD    (HL),A     

+2D26 D2 A7 2A    ..*   JP    NC,2AA7    

+2D29 2C          ,     INC   L          

+2D2A 35          5     DEC   (HL)       

+2D2B E2 A7 2A    ..*   JP    PO,2AA7    

+2D2E 18 1A       ..    JR    2D4A       ;------------- INC ---------------

+2D30 CD 1B 43    ..C   CALL  431B       

+2D33 5E          ^     LD    E,(HL)     

+2D34 2C          ,     INC   L          

+2D35 56          V     LD    D,(HL)     

+2D36 CD 64 43    .dC   CALL  4364       

+2D39 7E          ~     LD    A,(HL)     

+2D3A 83          .     ADD   E          

+2D3B 77          w     LD    (HL),A     

+2D3C 2C          ,     INC   L          

+2D3D 7E          ~     LD    A,(HL)     

+2D3E 8A          .     ADC   D          

+2D3F 77          w     LD    (HL),A     

+2D40 E2 A7 2A    ..*   JP    PO,2AA7    

+2D43 30 05       0.    JR    NC,2D4A    

+2D45 3E FF       >.    LD    A,FF       

+2D47 77          w     LD    (HL),A     

+2D48 2D          -     DEC   L          

+2D49 77          w     LD    (HL),A     

+2D4A CD FC 3C    ..<   CALL  3CFC       

+2D4D C3 A7 2A    ..*   JP    2AA7       ;------------- DEC ----------------

+2D50 CD 1B 43    ..C   CALL  431B       

+2D53 5E          ^     LD    E,(HL)     

+2D54 2C          ,     INC   L          

+2D55 56          V     LD    D,(HL)     

+2D56 CD 64 43    .dC   CALL  4364       

+2D59 7E          ~     LD    A,(HL)     

+2D5A 93          .     SUB   E          

+2D5B 77          w     LD    (HL),A     

+2D5C 2C          ,     INC   L          

+2D5D 7E          ~     LD    A,(HL)     

+2D5E 9A          .     SBC   D          

+2D5F 77          w     LD    (HL),A     

+2D60 E2 A7 2A    ..*   JP    PO,2AA7    

+2D63 18 DE       ..    JR    2D43       ;------------- ADD ---------------

+2D65 CD 1B 43    ..C   CALL  431B       

+2D68 5E          ^     LD    E,(HL)     

+2D69 2C          ,     INC   L          

+2D6A 56          V     LD    D,(HL)     

+2D6B CD 13 43    ..C   CALL  4313       

+2D6E 7E          ~     LD    A,(HL)     

+2D6F 2C          ,     INC   L          

+2D70 66          f     LD    H,(HL)     

+2D71 6F          o     LD    L,A        

+2D72 B7          .     OR    A          

+2D73 ED 5A       .Z    ADC   HL,DE      

+2D75 EC FC 3C    ..<   CALL  PE,3CFC    

+2D78 EB          .     EX    DE,HL      

+2D79 CD 64 43    .dC   CALL  4364       

+2D7C 73          s     LD    (HL),E     

+2D7D 2C          ,     INC   L          

+2D7E 72          r     LD    (HL),D     

+2D7F C3 A7 2A    ..*   JP    2AA7       ;------------ SUB ----------------

+2D82 CD 1B 43    ..C   CALL  431B       

+2D85 5E          ^     LD    E,(HL)     

+2D86 2C          ,     INC   L          

+2D87 56          V     LD    D,(HL)     

+2D88 CD 13 43    ..C   CALL  4313       

+2D8B 7E          ~     LD    A,(HL)     

+2D8C 2C          ,     INC   L          

+2D8D 66          f     LD    H,(HL)     

+2D8E 6F          o     LD    L,A        

+2D8F EB          .     EX    DE,HL      

+2D90 B7          .     OR    A          

+2D91 ED 52       .R    SBC   HL,DE      

+2D93 EC FC 3C    ..<   CALL  PE,3CFC    

+2D96 EB          .     EX    DE,HL      

+2D97 CD 64 43    .dC   CALL  4364       

+2D9A 73          s     LD    (HL),E     

+2D9B 2C          ,     INC   L          

+2D9C 72          r     LD    (HL),D     

+2D9D C3 A7 2A    ..*   JP    2AA7       ;-------------- MULT ------------

+2DA0 CD A2 2C    ..,   CALL  2CA2       ; Zwei Addressen holen --> HL, DE

+2DA3 CD 0D 4D    ..M   CALL  4D0D       ; MULT

+2DA6 DC FC 3C    ..<   CALL  C,3CFC     ; Overflow, ggf

+2DA9 C3 03 2D    ..-   JP    2D03       ;--------------- DIV ------------

+2DAC CD A2 2C    ..,   CALL  2CA2       

+2DAF CD 3D 4D    .=M   CALL  4D3D       ; DIV

+2DB2 DC CD 3C    ..<   CALL  C,3CCD     

+2DB5 C3 03 2D    ..-   JP    2D03       ;--------------- MOD -------------

+2DB8 CD A2 2C    ..,   CALL  2CA2       

+2DBB CD 3D 4D    .=M   CALL  4D3D       ; DIV

+2DBE EB          .     EX    DE,HL      ; Rest davon

+2DBF 18 F1       ..    JR    2DB2       ;------------- IMULT -------------

+2DC1 CD A2 2C    ..,   CALL  2CA2       

+2DC4 CD 6D 4D    .mM   CALL  4D6D       

+2DC7 EB          .     EX    DE,HL      

+2DC8 CE 00       ..    ADC   A,00       

+2DCA 28 03       (.    JR    Z,2DCF     

+2DCC 11 FF FF    ...   LD    DE,FFFF    ; Overflow = -1

+2DCF C3 03 2D    ..-   JP    2D03       ;------------- CLEAR -------------

+2DD2 CD 6C 43    .lC   CALL  436C       

+2DD5 97          .     SUB   A          

+2DD6 77          w     LD    (HL),A     

+2DD7 2C          ,     INC   L          

+2DD8 77          w     LD    (HL),A     

+2DD9 C3 A7 2A    ..*   JP    2AA7       ;------------- COMPL --------------

+2DDC CD A8 2C    ..,   CALL  2CA8       

+2DDF EB          .     EX    DE,HL      

+2DE0 21 00 00    !..   LD    HL,0000    

+2DE3 B7          .     OR    A          

+2DE4 ED 52       .R    SBC   HL,DE      

+2DE6 EB          .     EX    DE,HL      

+2DE7 C3 03 2D    ..-   JP    2D03       ;--------------- AND -------------

+2DEA CD A2 2C    ..,   CALL  2CA2       

+2DED 7B          {     LD    A,E        

+2DEE A5          .     AND   L          

+2DEF 5F          _     LD    E,A        

+2DF0 7A          z     LD    A,D        

+2DF1 A4          .     AND   H          

+2DF2 57          W     LD    D,A        

+2DF3 C3 03 2D    ..-   JP    2D03       ;-------------- OR --------------

+2DF6 CD A2 2C    ..,   CALL  2CA2       

+2DF9 7B          {     LD    A,E        

+2DFA B5          .     OR    L          

+2DFB 5F          _     LD    E,A        

+2DFC 7A          z     LD    A,D        

+2DFD B4          .     OR    H          

+2DFE 57          W     LD    D,A        

+2DFF C3 03 2D    ..-   JP    2D03       ;---------------- XOR ------------

+2E02 CD A2 2C    ..,   CALL  2CA2       

+2E05 7B          {     LD    A,E        

+2E06 AD          .     XOR   L          

+2E07 5F          _     LD    E,A        

+2E08 7A          z     LD    A,D        

+2E09 AC          .     XOR   H          

+2E0A 57          W     LD    D,A        

+2E0B C3 03 2D    ..-   JP    2D03       ;-------------- rotate ------------

+2E0E CD 64 43    .dC   CALL  4364       

+2E11 E5          .     PUSH  HL         

+2E12 5E          ^     LD    E,(HL)     

+2E13 2C          ,     INC   L          

+2E14 56          V     LD    D,(HL)     

+2E15 CD 13 43    ..C   CALL  4313       

+2E18 7E          ~     LD    A,(HL)     

+2E19 E6 0F       ..    AND   0F         ; keine links/rechts Optimierung

+2E1B 28 0A       (.    JR    Z,2E27     

+2E1D CB 23       .#    SLA   E          

+2E1F CB 12       ..    RL    D          

+2E21 30 01       0.    JR    NC,2E24    

+2E23 1C          .     INC   E          

+2E24 3D          =     DEC   A          

+2E25 20 F6        .    JR    NZ,2E1D    

+2E27 E1          .     POP   HL         

+2E28 C3 06 2D    ..-   JP    2D06       ;------------- TEST ---------------

+2E2B CD 1B 43    ..C   CALL  431B       

+2E2E 7E          ~     LD    A,(HL)     

+2E2F 2C          ,     INC   L          

+2E30 B6          .     OR    (HL)       

+2E31 28 3E       (>    JR    Z,2E71     ; Beide 0 ?

+2E33 18 4F       .O    JR    2E84       ;------------- LSEQ --------------

+2E35 CD 1B 43    ..C   CALL  431B       

+2E38 EB          .     EX    DE,HL      

+2E39 CD 13 43    ..C   CALL  4313       

+2E3C EB          .     EX    DE,HL      

+2E3D 1A          .     LD    A,(DE)     

+2E3E 96          .     SUB   (HL)       

+2E3F 1C          .     INC   E          

+2E40 2C          ,     INC   L          

+2E41 1A          .     LD    A,(DE)     

+2E42 9E          .     SBC   (HL)       

+2E43 E2 48 2E    .H.   JP    PO,2E48    

+2E46 EE 80       ..    XOR   80         

+2E48 F2 71 2E    .q.   JP    P,2E71     

+2E4B C3 84 2E    ...   JP    2E84       ;------------ ULSEQU --------------

+2E4E CD 1B 43    ..C   CALL  431B       

+2E51 EB          .     EX    DE,HL      

+2E52 CD 13 43    ..C   CALL  4313       

+2E55 EB          .     EX    DE,HL      

+2E56 1A          .     LD    A,(DE)     

+2E57 96          .     SUB   (HL)       

+2E58 1C          .     INC   E          

+2E59 2C          ,     INC   L          

+2E5A 1A          .     LD    A,(DE)     

+2E5B 9E          .     SBC   (HL)       

+2E5C 30 13       0.    JR    NC,2E71    

+2E5E 18 24       .$    JR    2E84       ;----------- EQU -----------------

+2E60 CD 1B 43    ..C   CALL  431B       

+2E63 EB          .     EX    DE,HL      

+2E64 CD 13 43    ..C   CALL  4313       

+2E67 1A          .     LD    A,(DE)     

+2E68 BE          .     CP    (HL)       

+2E69 20 19        .    JR    NZ,2E84    

+2E6B 1C          .     INC   E          

+2E6C 2C          ,     INC   L          

+2E6D 1A          .     LD    A,(DE)     

+2E6E BE          .     CP    (HL)       

+2E6F 20 13        .    JR    NZ,2E84    

+2E71 0A          .     LD    A,(BC)     ; TRUE liefern

+2E72 6F          o     LD    L,A        

+2E73 0C          .     INC   C          

+2E74 0A          .     LD    A,(BC)     

+2E75 CB 77       .w    BIT   6,A        

+2E77 20 4C        L    JR    NZ,2EC5    

+2E79 C3 8E 2E    ...   JP    2E8E       ; zum Branch

+2E7C CD 7E 2A    .~*   CALL  2A7E       

+2E7F 18 F0       ..    JR    2E71       

+2E81 CD 7E 2A    .~*   CALL  2A7E       

+2E84 0A          .     LD    A,(BC)     ; FALSE liefern

+2E85 6F          o     LD    L,A        

+2E86 0C          .     INC   C          

+2E87 0A          .     LD    A,(BC)     

+2E88 CB 77       .w    BIT   6,A        

+2E8A 28 39       (9    JR    Z,2EC5     ; Opcode veraendern

+2E8C E6 87       ..    AND   87         ; folgt immer Branch

+2E8E B7          .     OR    A          ;------------- BR -----------------

+2E8F 20 14        .    JR    NZ,2EA5    

+2E91 78          x     LD    A,B        

+2E92 0F          .     RRCA             

+2E93 4D          M     LD    C,L        

+2E94 CB 21       .!    SLA   C          

+2E96 8F          .     ADC   A          

+2E97 90          .     SUB   B          

+2E98 CA A7 2A    ..*   JP    Z,2AA7     

+2E9B 80          .     ADD   B          

+2E9C 47          G     LD    B,A        

+2E9D DD 75 09    .u.   LD    (IX+09),L  

+2EA0 C3 A7 2A    ..*   JP    2AA7       ;------------ LONGBR --------------

+2EA3 C6 04       ..    ADD   A,04       

+2EA5 07          .     RLCA             

+2EA6 DD 86 0A    ...   ADD   (IX+0A)    

+2EA9 DD BE 0F    ...   CP    (IX+0F)    

+2EAC FA B1 2E    ...   JP    M,2EB1     

+2EAF D6 10       ..    SUB   A,10       

+2EB1 DD 77 0A    .w.   LD    (IX+0A),A  

+2EB4 7D          }     LD    A,L        

+2EB5 DD 77 09    .w.   LD    (IX+09),A  

+2EB8 4F          O     LD    C,A        

+2EB9 87          .     ADD   A          

+2EBA 08          .     EX    AF,AF'     

+2EBB CD AB 42    ..B   CALL  42AB       

+2EBE CB 21       .!    SLA   C          

+2EC0 17          .     RLA              

+2EC1 47          G     LD    B,A        

+2EC2 C3 A7 2A    ..*   JP    2AA7       

+2EC5 0C          .     INC   C          

+2EC6 CC A8 42    ..B   CALL  Z,42A8     

+2EC9 C3 A7 2A    ..*   JP    2AA7       ;------------ CASE ----------------

+2ECC CD A8 2C    ..,   CALL  2CA8       

+2ECF CD 43 44    .CD   CALL  4443       

+2ED2 CB 7C       .|    BIT   7,H        

+2ED4 20 AE        .    JR    NZ,2E84    

+2ED6 7D          }     LD    A,L        

+2ED7 93          .     SUB   E          

+2ED8 7C          |     LD    A,H        

+2ED9 9A          .     SBC   D          

+2EDA 30 A8       0.    JR    NC,2E84    

+2EDC CB 38       .8    SLR   B          

+2EDE CB 19       ..    RR    C          

+2EE0 DD 46 0A    .F.   LD    B,(IX+0A)  

+2EE3 09          .     ADD   HL,BC      

+2EE4 23          #     INC   HL         

+2EE5 7C          |     LD    A,H        

+2EE6 18 C9       ..    JR    2EB1       ;-------------- PPROC -------------

+2EE8 CD 43 44    .CD   CALL  4443       

+2EEB EB          .     EX    DE,HL      

+2EEC 11 02 00    ...   LD    DE,0002    ; D=0

+2EEF 7C          |     LD    A,H        

+2EF0 FE 05       ..    CP    05         ; Modnr < 1280 : Segment 2

+2EF2 38 01       8.    JR    C,2EF5     

+2EF4 1C          .     INC   E          

+2EF5 D5          .     PUSH  DE         ; Segment in E auf Stack

+2EF6 24          $     INC   H          ; +0200 = Moduletable

+2EF7 24          $     INC   H          

+2EF8 97          .     SUB   A          

+2EF9 CD 4D 44    .MD   CALL  444D       

+2EFC 5E          ^     LD    E,(HL)     ; Addresse 

+2EFD 2C          ,     INC   L          

+2EFE 56          V     LD    D,(HL)     

+2EFF D5          .     PUSH  DE         ; REF-Addr auf Stack 

+2F00 18 0A       ..    JR    2F0C       ;--------------- PPV -------------

+2F02 CD A8 2C    ..,   CALL  2CA8       

+2F05 18 03       ..    JR    2F0A       ;--------------- PP -------------

+2F07 CD C0 43    ..C   CALL  43C0       

+2F0A D5          .     PUSH  DE         

+2F0B E5          .     PUSH  HL         

+2F0C 2A C6 41    *.A   LD    HL,(41C6)  ; REF-Addr auf Stack---------------

+2F0F 23          #     INC   HL         

+2F10 23          #     INC   HL         

+2F11 CB 7C       .|    BIT   7,H        

+2F13 C2 D1 3C    ..<   JP    NZ,3CD1    

+2F16 5C          \     LD    E,H        

+2F17 16 1A       ..    LD    D,1A       

+2F19 1A          .     LD    A,(DE)     

+2F1A 67          g     LD    H,A        

+2F1B 29          )     ADD   HL,HL      

+2F1C D4 F9 42    ..B   CALL  NC,42F9    

+2F1F D1          .     POP   DE         

+2F20 73          s     LD    (HL),E     ; Low Word

+2F21 2C          ,     INC   L          

+2F22 72          r     LD    (HL),D     

+2F23 2C          ,     INC   L          

+2F24 D1          .     POP   DE         ; High Word

+2F25 73          s     LD    (HL),E     

+2F26 2C          ,     INC   L          

+2F27 72          r     LD    (HL),D     

+2F28 2A C6 41    *.A   LD    HL,(41C6)  ; Stackpointer

+2F2B 23          #     INC   HL         

+2F2C 23          #     INC   HL         

+2F2D 22 C6 41    ".A   LD    (41C6),HL  

+2F30 C3 A7 2A    ..*   JP    2AA7       ;------------- PCALL --------------

+2F33 CD B8 43    ..C   CALL  43B8       ; REF-Addr vom Stack

+2F36 7B          {     LD    A,E        ; Segment

+2F37 EB          .     EX    DE,HL      

+2F38 18 27       .'    JR    2F61       ;------------- EXEC ---------------

+2F3A CD A8 2C    ..,   CALL  2CA8       

+2F3D 7C          |     LD    A,H        

+2F3E 18 08       ..    JR    2F48       ;-------------- CALL -------------

+2F40 CB 7F       ..    BIT   7,A        

+2F42 CB BF       ..    RES   7,A        

+2F44 28 02       (.    JR    Z,2F48     

+2F46 CB D7       ..    SET   2,A        

+2F48 F5          .     PUSH  AF         

+2F49 C6 02       ..    ADD   A,02       ; Addresse aus Module Addr Tabelle

+2F4B 67          g     LD    H,A        

+2F4C 5F          _     LD    E,A        

+2F4D 16 19       ..    LD    D,19       

+2F4F 1A          .     LD    A,(DE)     

+2F50 67          g     LD    H,A        

+2F51 29          )     ADD   HL,HL      

+2F52 B7          .     OR    A          

+2F53 CC E1 42    ..B   CALL  Z,42E1     

+2F56 5E          ^     LD    E,(HL)     

+2F57 2C          ,     INC   L          

+2F58 56          V     LD    D,(HL)     

+2F59 F1          .     POP   AF         

+2F5A FE 05       ..    CP    05         

+2F5C 3E 02       >.    LD    A,02       

+2F5E 38 01       8.    JR    C,2F61     

+2F60 3C          <     INC   A          ; Call PROC

+2F61 47          G     LD    B,A        ;---- Segment in A, Addr in HL

+2F62 D5          .     PUSH  DE         ; call...

+ - Fortsetzung in Datei "eumel0.prt.2" -

diff --git a/system/eumel0-z80/src/eumel0.prt.2 b/system/eumel0-z80/src/eumel0.prt.2
new file mode 100644
index 0000000..5dbb9b9
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.2
@@ -0,0 +1,3957 @@
+#type ("17.klein")#

+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+2F63 2A C8 41    *.A   LD    HL,(41C8)

+2F66 5C          \     LD    E,H

+2F67 16 1A       ..    LD    D,1A       

+2F69 1A          .     LD    A,(DE)     

+2F6A 67          g     LD    H,A        

+2F6B 29          )     ADD   HL,HL      

+2F6C D4 F9 42    ..B   CALL  NC,42F9    

+2F6F ED 5B C4 41 .[.A  LD    DE,(41C4)  ; Stacktop auf Stack

+2F73 73          s     LD    (HL),E     

+2F74 2C          ,     INC   L          

+2F75 72          r     LD    (HL),D     

+2F76 2C          ,     INC   L          

+2F77 DD CB 09 26 ...&  SLA   (IX+09)    ; icount Felder auf Stack

+2F7B CB 19       ..    RR    C          

+2F7D 71          q     LD    (HL),C     

+2F7E 2C          ,     INC   L          

+2F7F DD 7E 0A    .~.   LD    A,(IX+0A)  

+2F82 77          w     LD    (HL),A     

+2F83 2C          ,     INC   L          

+2F84 DD 7E 0B    .~.   LD    A,(IX+0B)  

+2F87 77          w     LD    (HL),A     

+2F88 2C          ,     INC   L          

+2F89 E6 FC       ..    AND   FC         ; Fehlerzustand vererbt sich

+2F8B B0          .     OR    B          

+2F8C 47          G     LD    B,A        

+2F8D D9          .     EXX              

+2F8E 79          y     LD    A,C        

+2F8F D9          .     EXX              

+2F90 77          w     LD    (HL),A     

+2F91 2C          ,     INC   L          

+2F92 DD 7E 0F    .~.   LD    A,(IX+0F)  

+2F95 77          w     LD    (HL),A     

+2F96 D1          .     POP   DE         

+2F97 7A          z     LD    A,D        

+2F98 C6 10       ..    ADD   A,10       

+2F9A DD 77 0F    .w.   LD    (IX+0F),A  

+2F9D DD 36 06 18 .6..  LD    (IX+06),18 

+2FA1 DD 73 09    .s.   LD    (IX+09),E  ; icount neu setzen

+2FA4 DD 72 0A    .r.   LD    (IX+0A),D  

+2FA7 DD 70 0B    .p.   LD    (IX+0B),B  

+2FAA 4B          K     LD    C,E        

+2FAB 7B          {     LD    A,E        

+2FAC 87          .     ADD   A          

+2FAD 08          .     EX    AF,AF'     

+2FAE CD AB 42    ..B   CALL  42AB       

+2FB1 CB 21       .!    SLA   C          

+2FB3 17          .     RLA              

+2FB4 47          G     LD    B,A        

+2FB5 0A          .     LD    A,(BC)     

+2FB6 5F          _     LD    E,A        

+2FB7 0C          .     INC   C          

+2FB8 0A          .     LD    A,(BC)     

+2FB9 57          W     LD    D,A        

+2FBA 0C          .     INC   C          

+2FBB CC 87 42    ..B   CALL  Z,4287     

+2FBE DD 36 06 00 .6..  LD    (IX+06),00 

+2FC2 2A C8 41    *.A   LD    HL,(41C8)  

+2FC5 22 C4 41    ".A   LD    (41C4),HL  ; Stacktop neu setzen

+2FC8 B7          .     OR    A          

+2FC9 ED 5A       .Z    ADC   HL,DE      

+2FCB EA D1 3C    ..<   JP    PE,3CD1    

+2FCE 22 C8 41    ".A   LD    (41C8),HL  

+2FD1 23          #     INC   HL         

+2FD2 23          #     INC   HL         

+2FD3 22 C6 41    ".A   LD    (41C6),HL  ; Stackpointer neu setzen

+2FD6 CB 7C       .|    BIT   7,H        

+2FD8 CA A7 2A    ..*   JP    Z,2AA7     ; Stackoverflow bei CALL

+2FDB C3 D1 3C    ..<   JP    3CD1       ;------------ PENTER -------------

+2FDE 7D          }     LD    A,L        

+2FDF D9          .     EXX              

+2FE0 4F          O     LD    C,A        ; C' = Packetbase

+2FE1 D9          .     EXX              

+2FE2 C3 A7 2A    ..*   JP    2AA7       ;------------- arith15 ------------ 

+2FE5 DD CB 0B A6 ....  RES   4,(IX+0B)  

+2FE9 C3 A7 2A    ..*   JP    2AA7       ;------------- arith16 ------------

+2FEC DD CB 0B E6 ....  SET   4,(IX+0B)  

+2FF0 C3 A7 2A    ..*   JP    2AA7       ;------------- RTN ----------------

+2FF3 CD 35 30    .50   CALL  3035       ; LEAVE PROC

+2FF6 C3 A7 2A    ..*   JP    2AA7       ;------------- RTN FALSE ----------

+2FF9 CD 1B 30    ..0   CALL  301B       

+2FFC DD 36 06 10 .6..  LD    (IX+06),10 ; Status LEAVE PROC FALSE

+3000 CD 38 30    .80   CALL  3038       

+3003 DD 36 06 00 .6..  LD    (IX+06),00 ; Status wieder busy, BR FALSEmodif.

+3007 C3 71 2E    .q.   JP    2E71       ;-------------- RTN TRUE ----------

+300A CD 1B 30    ..0   CALL  301B       

+300D DD 36 06 14 .6..  LD    (IX+06),14 ; Status LEAVE PROC TRUE

+3011 CD 38 30    .80   CALL  3038       

+3014 DD 36 06 00 .6..  LD    (IX+06),00 ; Wieder Busy

+3018 C3 84 2E    ...   JP    2E84       ; BR TRUE modif.

+301B 2A C4 41    *.A   LD    HL,(41C4)  ;-------- LEAVE PROC -------------

+301E 44          D     LD    B,H        

+301F 4D          M     LD    C,L        ; ALten Stacktop wiederherstellen

+3020 22 C8 41    ".A   LD    (41C8),HL  

+3023 23          #     INC   HL         

+3024 23          #     INC   HL         

+3025 22 C6 41    ".A   LD    (41C6),HL  ; +2 = Neuer Stacktop

+3028 2B          +     DEC   HL         

+3029 2B          +     DEC   HL         

+302A 5C          \     LD    E,H        

+302B 16 1A       ..    LD    D,1A       

+302D 1A          .     LD    A,(DE)     

+302E 67          g     LD    H,A        

+302F 29          )     ADD   HL,HL      

+3030 B7          .     OR    A          

+3031 C0          .     RET   NZ         

+3032 C3 E1 42    ..B   JP    42E1       ;--------------------------------

+3035 CD 1B 30    ..0   CALL  301B       ; LEAVE PROC

+3038 5E          ^     LD    E,(HL)     

+3039 2C          ,     INC   L          

+303A 56          V     LD    D,(HL)     

+303B 7B          {     LD    A,E        

+303C 91          .     SUB   C          

+303D 7A          z     LD    A,D        

+303E 98          .     SBC   B          

+303F 30 37       07    JR    NC,3078    ; Stack underflow, Harakiri

+3041 2C          ,     INC   L          

+3042 ED 53 C4 41 .S.A  LD    (41C4),DE  ; Stacktop

+3046 4E          N     LD    C,(HL)     

+3047 2C          ,     INC   L          

+3048 DD 71 09    .q.   LD    (IX+09),C  ; icount wiederherstellen

+304B 7E          ~     LD    A,(HL)     

+304C 2C          ,     INC   L          

+304D DD 77 0A    .w.   LD    (IX+0A),A  

+3050 DD 7E 0B    .~.   LD    A,(IX+0B)  

+3053 E6 80       ..    AND   80         

+3055 5E          ^     LD    E,(HL)     

+3056 CB BB       ..    RES   7,E        

+3058 B3          .     OR    E          

+3059 DD 77 0B    .w.   LD    (IX+0B),A  ; iserror uebernehmen

+305C 2C          ,     INC   L          

+305D E6 C0       ..    AND   C0         

+305F FE 80       ..    CP    80         

+3061 CA 2E 3D    ..=   JP    Z,3D2E     ; errorstop

+3064 7E          ~     LD    A,(HL)     

+3065 2C          ,     INC   L          

+3066 D9          .     EXX              

+3067 4F          O     LD    C,A        

+3068 D9          .     EXX              

+3069 7E          ~     LD    A,(HL)     

+306A DD 77 0F    .w.   LD    (IX+0F),A  

+306D 79          y     LD    A,C        

+306E 87          .     ADD   A          

+306F 08          .     EX    AF,AF'     

+3070 CD AB 42    ..B   CALL  42AB       

+3073 CB 21       .!    SLA   C          

+3075 17          .     RLA              

+3076 47          G     LD    B,A        

+3077 C9          .     RET              

+3078 DD 36 06 FF .6..  LD    (IX+06),FF ; dead setzen. "Harakiri"

+307C C3 26 29    .&)   JP    2926       ;-------------- GOSUB -------------

+307F CD 43 44    .CD   CALL  4443       ; Branchaddresse holen

+3082 D5          .     PUSH  DE         

+3083 2A C8 41    *.A   LD    HL,(41C8)  

+3086 5C          \     LD    E,H        

+3087 16 1A       ..    LD    D,1A       

+3089 1A          .     LD    A,(DE)     

+308A 67          g     LD    H,A        

+308B 29          )     ADD   HL,HL      

+308C D4 F9 42    ..B   CALL  NC,42F9    

+308F DD 7E 09    .~.   LD    A,(IX+09)  ; icount auf Stack (Seg.bleibt)!

+3092 87          .     ADD   A          

+3093 CB 19       ..    RR    C          

+3095 71          q     LD    (HL),C     

+3096 2C          ,     INC   L          

+3097 DD 7E 0A    .~.   LD    A,(IX+0A)  

+309A 77          w     LD    (HL),A     

+309B 2A C8 41    *.A   LD    HL,(41C8)  ; Stackpointer INCR 4

+309E 23          #     INC   HL         

+309F 23          #     INC   HL         

+30A0 23          #     INC   HL         

+30A1 23          #     INC   HL         

+30A2 22 C8 41    ".A   LD    (41C8),HL  

+30A5 23          #     INC   HL         

+30A6 23          #     INC   HL         

+30A7 22 C6 41    ".A   LD    (41C6),HL  ; stacktop

+30AA E1          .     POP   HL         

+30AB 7C          |     LD    A,H        ; BRANCH

+30AC C3 8E 2E    ...   JP    2E8E       ;------------- GORET -------------

+30AF 2A C8 41    *.A   LD    HL,(41C8)  ; Stackpointer vom Stack

+30B2 2B          +     DEC   HL         

+30B3 2B          +     DEC   HL         

+30B4 22 C6 41    ".A   LD    (41C6),HL  

+30B7 2B          +     DEC   HL         

+30B8 2B          +     DEC   HL         

+30B9 22 C8 41    ".A   LD    (41C8),HL  

+30BC 5C          \     LD    E,H        

+30BD 16 1A       ..    LD    D,1A       

+30BF 1A          .     LD    A,(DE)     

+30C0 67          g     LD    H,A        

+30C1 29          )     ADD   HL,HL      

+30C2 B7          .     OR    A          

+30C3 CC E1 42    ..B   CALL  Z,42E1     

+30C6 2C          ,     INC   L          

+30C7 7E          ~     LD    A,(HL)     

+30C8 2D          -     DEC   L          

+30C9 6E          n     LD    L,(HL)     ; BRANCH

+30CA C3 B1 2E    ...   JP    2EB1       ;------------- TMOV --------------

+30CD CD 92 46    ..F   CALL  4692       

+30D0 FE 02       ..    CP    02         

+30D2 30 0F       0.    JR    NC,30E3    

+30D4 B7          .     OR    A          

+30D5 28 01       (.    JR    Z,30D8     

+30D7 56          V     LD    D,(HL)     

+30D8 CD 64 43    .dC   CALL  4364       

+30DB 2C          ,     INC   L          

+30DC 2C          ,     INC   L          

+30DD 73          s     LD    (HL),E     

+30DE 2C          ,     INC   L          

+30DF 72          r     LD    (HL),D     

+30E0 C3 A7 2A    ..*   JP    2AA7       

+30E3 DD CB 07 DE ....  SET   3,(IX+07)  

+30E7 E5          .     PUSH  HL         

+30E8 D5          .     PUSH  DE         

+30E9 CD AA 47    ..G   CALL  47AA       

+30EC D1          .     POP   DE         

+30ED CD 68 48    .hH   CALL  4868       

+30F0 42          B     LD    B,D        

+30F1 4B          K     LD    C,E        

+30F2 EB          .     EX    DE,HL      

+30F3 E3          .     EX    (SP),HL    

+30F4 7B          {     LD    A,E        

+30F5 95          .     SUB   L          

+30F6 7A          z     LD    A,D        

+30F7 20 01        .    JR    NZ,30FA    

+30F9 94          .     SUB   H          

+30FA C4 B0 2C    ..,   CALL  NZ,2CB0    

+30FD CD E8 45    ..E   CALL  45E8       

+3100 D1          .     POP   DE         

+3101 CD 92 48    ..H   CALL  4892       

+3104 DD CB 07 9E ....  RES   3,(IX+07)  

+3108 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+310C C3 A7 2A    ..*   JP    2AA7       ;------------ TEQU ----------------

+310F CD 92 46    ..F   CALL  4692       

+3112 FE 02       ..    CP    02         

+3114 30 09       0.    JR    NC,311F    

+3116 2D          -     DEC   L          

+3117 E5          .     PUSH  HL         

+3118 CD 07 44    ..D   CALL  4407       

+311B D1          .     POP   DE         

+311C C3 67 2E    .g.   JP    2E67       

+311F E5          .     PUSH  HL         

+3120 D5          .     PUSH  DE         

+3121 CD DD 46    ..F   CALL  46DD       

+3124 E3          .     EX    (SP),HL    

+3125 B7          .     OR    A          

+3126 ED 52       .R    SBC   HL,DE      

+3128 20 15        .    JR    NZ,313F    

+312A ED 43 D0 41 .C.A  LD    (41D0),BC  

+312E 4B          K     LD    C,E        

+312F 42          B     LD    B,D        

+3130 D1          .     POP   DE         

+3131 E1          .     POP   HL         

+3132 CD 7A 31    .z1   CALL  317A       

+3135 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3139 C2 84 2E    ...   JP    NZ,2E84    

+313C C3 71 2E    .q.   JP    2E71       

+313F D1          .     POP   DE         

+3140 E1          .     POP   HL         

+3141 C3 84 2E    ...   JP    2E84       ;------------- TLSEQU ------------

+3144 CD 8D 46    ..F   CALL  468D       

+3147 E5          .     PUSH  HL         

+3148 D5          .     PUSH  DE         

+3149 CD DD 46    ..F   CALL  46DD       

+314C E3          .     EX    (SP),HL    

+314D 7B          {     LD    A,E        

+314E 95          .     SUB   L          

+314F 7A          z     LD    A,D        

+3150 9C          .     SBC   H          

+3151 32 D3 41    2.A   LD    (41D3),A   

+3154 30 01       0.    JR    NC,3157    

+3156 EB          .     EX    DE,HL      

+3157 ED 43 D0 41 .C.A  LD    (41D0),BC  

+315B 44          D     LD    B,H        

+315C 4D          M     LD    C,L        

+315D D1          .     POP   DE         

+315E E1          .     POP   HL         

+315F 78          x     LD    A,B        

+3160 B1          .     OR    C          

+3161 C4 7A 31    .z1   CALL  NZ,317A    

+3164 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3168 28 06       (.    JR    Z,3170     

+316A D2 71 2E    .q.   JP    NC,2E71    

+316D C3 84 2E    ...   JP    2E84       

+3170 3A D3 41    :.A   LD    A,(41D3)   

+3173 B7          .     OR    A          

+3174 F2 71 2E    .q.   JP    P,2E71     

+3177 C3 84 2E    ...   JP    2E84       

+317A CD 78 45    .xE   CALL  4578       

+317D 30 0B       0.    JR    NC,318A    

+317F CD 8A 31    ..1   CALL  318A       

+3182 C2 EC 45    ..E   JP    NZ,45EC    

+3185 CD C1 45    ..E   CALL  45C1       

+3188 18 F0       ..    JR    317A       

+318A C8          .     RET   Z          

+318B 1A          .     LD    A,(DE)     

+318C BE          .     CP    (HL)       

+318D C0          .     RET   NZ         

+318E 2C          ,     INC   L          

+318F 1C          .     INC   E          

+3190 0D          .     DEC   C          

+3191 C2 8B 31    ..1   JP    NZ,318B    

+3194 97          .     SUB   A          

+3195 47          G     LD    B,A        

+3196 C9          .     RET              ;------------- LENGTH ------------

+3197 CD 13 43    ..C   CALL  4313       

+319A 23          #     INC   HL         

+319B 23          #     INC   HL         

+319C 5E          ^     LD    E,(HL)     

+319D 16 00       ..    LD    D,00       

+319F 7B          {     LD    A,E        

+31A0 3C          <     INC   A          

+31A1 C2 03 2D    ..-   JP    NZ,2D03    

+31A4 2C          ,     INC   L          

+31A5 C3 00 2D    ..-   JP    2D00       ;--------------- CODE ------------

+31A8 CD 8D 46    ..F   CALL  468D       

+31AB 11 FF FF    ...   LD    DE,FFFF    ; Wenn Laenge <> 1 ==> -1

+31AE FE 01       ..    CP    01         

+31B0 C2 03 2D    ..-   JP    NZ,2D03    

+31B3 5E          ^     LD    E,(HL)     ; sonst erstes Zeichen

+31B4 16 00       ..    LD    D,00       

+31B6 C3 03 2D    ..-   JP    2D03       ;-------------- ENCODE -----------

+31B9 CD 13 43    ..C   CALL  4313       

+31BC 1E 01       ..    LD    E,01       ; Laenge 1

+31BE 56          V     LD    D,(HL)     

+31BF C3 D8 30    ..0   JP    30D8       ;-------------- TSUB -------------

+31C2 CD 2C 47    .,G   CALL  472C       

+31C5 C3 D4 30    ..0   JP    30D4       ;------------- subtext 1 ---------

+31C8 CD 89 47    ..G   CALL  4789       

+31CB C3 D0 30    ..0   JP    30D0       ;------------- subtext 2 ---------

+31CE CD 95 47    ..G   CALL  4795       

+31D1 C3 D0 30    ..0   JP    30D0       ;------------- CAT ---------------

+31D4 CD B8 43    ..C   CALL  43B8       

+31D7 ED 53 CE 41 .S.A  LD    (41CE),DE  

+31DB E5          .     PUSH  HL         

+31DC CD 8D 46    ..F   CALL  468D       

+31DF 2D          -     DEC   L          

+31E0 7E          ~     LD    A,(HL)     

+31E1 32 D2 41    2.A   LD    (41D2),A   

+31E4 E3          .     EX    (SP),HL    

+31E5 D5          .     PUSH  DE         

+31E6 ED 5B CE 41 .[.A  LD    DE,(41CE)  

+31EA CD AD 47    ..G   CALL  47AD       

+31ED ED 53 40 4B .S@K  LD    (4B40),DE  

+31F1 E3          .     EX    (SP),HL    

+31F2 EB          .     EX    DE,HL      

+31F3 B7          .     OR    A          

+31F4 ED 5A       .Z    ADC   HL,DE      

+31F6 FA 26 32    .&2   JP    M,3226     

+31F9 22 CC 41    ".A   LD    (41CC),HL  

+31FC EB          .     EX    DE,HL      

+31FD E3          .     EX    (SP),HL    

+31FE CD AD 48    ..H   CALL  48AD       

+3201 38 28       8(    JR    C,322B     

+3203 ED 5B 40 4B .[@K  LD    DE,(4B40)  

+3207 CD 0D 45    ..E   CALL  450D       

+320A EB          .     EX    DE,HL      

+320B C1          .     POP   BC         

+320C E1          .     POP   HL         

+320D 3A D2 41    :.A   LD    A,(41D2)   

+3210 BE          .     CP    (HL)       

+3211 C2 26 29    .&)   JP    NZ,2926    

+3214 2C          ,     INC   L          

+3215 CD B0 2C    ..,   CALL  2CB0       

+3218 ED 5B CC 41 .[.A  LD    DE,(41CC)  

+321C CD 92 48    ..H   CALL  4892       

+321F ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3223 C3 A7 2A    ..*   JP    2AA7       

+3226 3E 07       >.    LD    A,07       

+3228 CD 0D 3D    ..=   CALL  3D0D       

+322B C1          .     POP   BC         

+322C E1          .     POP   HL         

+322D 18 F0       ..    JR    321F       ;------------ replace text -------

+322F CD AA 47    ..G   CALL  47AA       

+3232 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3236 E5          .     PUSH  HL         

+3237 CD A8 2C    ..,   CALL  2CA8       

+323A EB          .     EX    DE,HL      

+323B 1B          .     DEC   DE         

+323C B7          .     OR    A          

+323D ED 52       .R    SBC   HL,DE      

+323F 38 21       8!    JR    C,3262     

+3241 E3          .     EX    (SP),HL    

+3242 CD 0D 45    ..E   CALL  450D       

+3245 E3          .     EX    (SP),HL    

+3246 E5          .     PUSH  HL         

+3247 CD 8D 46    ..F   CALL  468D       

+324A ED 43 D0 41 .C.A  LD    (41D0),BC  

+324E C1          .     POP   BC         

+324F 79          y     LD    A,C        

+3250 93          .     SUB   E          

+3251 78          x     LD    A,B        

+3252 9A          .     SBC   D          

+3253 38 02       8.    JR    C,3257     

+3255 4B          K     LD    C,E        

+3256 42          B     LD    B,D        

+3257 D1          .     POP   DE         

+3258 CD B0 2C    ..,   CALL  2CB0       

+325B ED 4B D0 41 .K.A  LD    BC,(41D0)  

+#25F C3 A7 2A    ..*   JP    2AA7       

+3262 E1          .     POP   HL         

+3263 18 FA       ..    JR    325F       

+3265 CD 8D 46    ..F   CALL  468D       

+3268 E3          .     EX    (SP),HL    

+3269 D5          .     PUSH  DE         

+326A E5          .     PUSH  HL         

+326B CD DD 46    ..F   CALL  46DD       

+326E 7E          ~     LD    A,(HL)     

+326F 32 D4 41    2.A   LD    (41D4),A   

+3272 22 D8 41    ".A   LD    (41D8),HL  

+3275 3A 8A 46    :.F   LD    A,(468A)   

+3278 32 DA 41    2.A   LD    (41DA),A   

+327B 1B          .     DEC   DE         

+327C ED 53 D6 41 .S.A  LD    (41D6),DE  

+3280 C9          .     RET              ;------------ pos 1 --------------

+3281 CD 65 32    .e2   CALL  3265       

+3284 11 01 00    ...   LD    DE,0001    

+3287 18 1E       ..    JR    32A7       ;----------- pos 2 --------------- 

+3289 CD 65 32    .e2   CALL  3265       

+328C CD A8 2C    ..,   CALL  2CA8       

+328F EB          .     EX    DE,HL      

+3290 18 15       ..    JR    32A7       ;------------- pos 3 -------------

+3292 CD 65 32    .e2   CALL  3265       

+3295 CD A8 2C    ..,   CALL  2CA8       

+3298 EB          .     EX    DE,HL      

+3299 CD A8 2C    ..,   CALL  2CA8       

+329C EB          .     EX    DE,HL      

+329D E3          .     EX    (SP),HL    

+329E 7B          {     LD    A,E        

+329F 95          .     SUB   L          

+32A0 7A          z     LD    A,D        

+32A1 9C          .     SBC   H          

+32A2 30 01       0.    JR    NC,32A5    

+32A4 EB          .     EX    DE,HL      

+32A5 E3          .     EX    (SP),HL    

+32A6 EB          .     EX    DE,HL      

+32A7 CD 64 43    .dC   CALL  4364       

+32AA 22 CC 41    ".A   LD    (41CC),HL  

+32AD ED 43 D0 41 .C.A  LD    (41D0),BC  

+32B1 C1          .     POP   BC         

+32B2 2A D6 41    *.A   LD    HL,(41D6)  

+32B5 24          $     INC   H          

+32B6 25          %     DEC   H          

+32B7 20 3B        ;    JR    NZ,32F4    

+32B9 79          y     LD    A,C        

+32BA 95          .     SUB   L          

+32BB 4F          O     LD    C,A        

+32BC 78          x     LD    A,B        

+32BD 9C          .     SBC   H          

+32BE 47          G     LD    B,A        

+32BF E1          .     POP   HL         

+32C0 38 33       83    JR    C,32F5     

+32C2 CD 1D 46    ..F   CALL  461D       

+32C5 38 2E       8.    JR    C,32F5     

+32C7 CD 44 45    .DE   CALL  4544       

+32CA 28 29       ()    JR    Z,32F5     

+32CC F5          .     PUSH  AF         

+32CD 3A D4 41    :.A   LD    A,(41D4)   

+32D0 ED B1       ..    CPIR             

+32D2 CC FA 32    ..2   CALL  Z,32FA     

+32D5 28 0C       (.    JR    Z,32E3     

+32D7 78          x     LD    A,B        

+32D8 B1          .     OR    C          

+32D9 20 F2        .    JR    NZ,32CD    

+32DB F1          .     POP   AF         

+32DC 30 17       0.    JR    NC,32F5    

+32DE CD C1 45    ..E   CALL  45C1       

+32E1 18 E4       ..    JR    32C7       

+32E3 F1          .     POP   AF         

+32E4 CD 33 46    .3F   CALL  4633       

+32E7 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+32EB 2A CC 41    *.A   LD    HL,(41CC)  

+32EE 73          s     LD    (HL),E     

+32EF 2C          ,     INC   L          

+32F0 72          r     LD    (HL),D     

+32F1 C3 A7 2A    ..*   JP    2AA7       

+32F4 E1          .     POP   HL         

+32F5 11 00 00    ...   LD    DE,0000    

+32F8 18 ED       ..    JR    32E7       

+32FA 3A D6 41    :.A   LD    A,(41D6)   

+32FD B7          .     OR    A          

+32FE C8          .     RET   Z          

+32FF C5          .     PUSH  BC         

+3300 03          .     INC   BC         

+3301 CD F1 45    ..E   CALL  45F1       

+3304 ED 5B 85 46 .[.F  LD    DE,(4685)  

+3308 D5          .     PUSH  DE         

+3309 E5          .     PUSH  HL         

+330A 3A D6 41    :.A   LD    A,(41D6)   

+330D 47          G     LD    B,A        

+330E 2B          +     DEC   HL         

+330F ED 5B D8 41 .[.A  LD    DE,(41D8)  

+3313 3A DA 41    :.A   LD    A,(41DA)   

+3316 32 8A 46    2.F   LD    (468A),A   

+3319 2C          ,     INC   L          

+331A 20 07        .    JR    NZ,3323    

+331C FD 21 85 46 .!.F  LD    IY,4685    

+3320 CD 1B 45    ..E   CALL  451B       

+3323 1C          .     INC   E          

+3324 20 09        .    JR    NZ,332F    

+3326 FD 21 89 46 .!.F  LD    IY,4689    

+332A EB          .     EX    DE,HL      

+332B CD 1B 45    ..E   CALL  451B       

+332E EB          .     EX    DE,HL      

+332F 1A          .     LD    A,(DE)     

+3330 BE          .     CP    (HL)       

+3331 20 02        .    JR    NZ,3335    

+3333 10 E4       ..    DJNZ  3319       

+3335 F5          .     PUSH  AF         

+3336 CD 12 46    ..F   CALL  4612       

+3339 F1          .     POP   AF         

+333A E1          .     POP   HL         

+333B D1          .     POP   DE         

+333C C1          .     POP   BC         

+333D ED 53 85 46 .S.F  LD    (4685),DE  

+3341 C9          .     RET              ;------------ pos high low -------

+3342 CD 8D 46    ..F   CALL  468D       

+3345 D5          .     PUSH  DE         

+3346 E5          .     PUSH  HL         

+3347 CD 13 43    ..C   CALL  4313       

+334A 23          #     INC   HL         

+334B 23          #     INC   HL         

+334C 23          #     INC   HL         

+334D 5E          ^     LD    E,(HL)     

+334E CD 13 43    ..C   CALL  4313       

+3351 23          #     INC   HL         

+3352 23          #     INC   HL         

+3353 23          #     INC   HL         

+3354 56          V     LD    D,(HL)     

+3355 ED 53 D4 41 .S.A  LD    (41D4),DE  

+3359 CD A8 2C    ..,   CALL  2CA8       

+335C E5          .     PUSH  HL         

+335D CD 64 43    .dC   CALL  4364       

+3360 22 CC 41    ".A   LD    (41CC),HL  

+3363 ED 43 D0 41 .C.A  LD    (41D0),BC  

+3367 D1          .     POP   DE         

+3368 E1          .     POP   HL         

+3369 C1          .     POP   BC         

+336A CD 1D 46    ..F   CALL  461D       

+336D DA F5 32    ..2   JP    C,32F5     

+3370 CD 44 45    .DE   CALL  4544       

+3373 CA F5 32    ..2   JP    Z,32F5     

+3376 F5          .     PUSH  AF         

+3377 ED 5B D4 41 .[.A  LD    DE,(41D4)  

+337B 0B          .     DEC   BC         

+337C 7A          z     LD    A,D        

+337D BE          .     CP    (HL)       

+337E 38 05       8.    JR    C,3385     

+3380 7E          ~     LD    A,(HL)     

+3381 BB          .     CP    E          

+3382 D2 E3 32    ..2   JP    NC,32E3    

+3385 23          #     INC   HL         

+3386 78          x     LD    A,B        

+3387 B1          .     OR    C          

+3388 20 F1        .    JR    NZ,337B    

+338A F1          .     POP   AF         

+338B D2 F5 32    ..2   JP    NC,32F5    

+338E CD C1 45    ..E   CALL  45C1       

+3391 18 DD       ..    JR    3370       ;------------- stranalyze ---------

+3393 CD B8 43    ..C   CALL  43B8       ; REF-Addr vom Stack (HL,DE)

+3396 FD 21 89 46 .!.F  LD    IY,4689    

+339A FD 72 03    .r.   LD    (IY+03),D  ; Dataspace

+339D 7B          {     LD    A,E        ; Segment

+339E CD CA 44    ..D   CALL  44CA       ; Block holen HL = Speicheraddr

+33A1 CB 3C       .<    SLR   H          ; --> Wordaddr konvertieren

+33A3 CB 1D       ..    RR    L          

+33A5 22 DB 41    ".A   LD    (41DB),HL  ; Block 1 Wortaddr

+33A8 29          )     ADD   HL,HL      ; --> Byteaddr konv.

+33A9 11 FE 01    ...   LD    DE,01FE    ; Ende des Blocks auch lesen 

+33AC CD 0D 45    ..E   CALL  450D       ; (schlimmstenfalls also 2 Bloecke) 

+33AF CB 3C       .<    SLR   H          ; 2. Block Wortaddr

+33B1 CB 1D       ..    RR    L          

+33B3 22 DD 41    ".A   LD    (41DD),HL  ; Block 2 Wortaddr

+33B6 CD 64 43    .dC   CALL  4364       ; Addresse d.INT VAR summe holen 

+33B9 22 DF 41    ".A   LD    (41DF),HL  

+33BC CD A8 2C    ..,   CALL  2CA8       ; INT CONST maxbreite holen

+33BF 22 E1 41    ".A   LD    (41E1),HL  

+33C2 CD 8D 46    ..F   CALL  468D       ; TEXT CONST zeile holen

+33C5 E5          .     PUSH  HL         

+33C6 CD 64 43    .dC   CALL  4364       ; INT VAR pos holen

+33C9 E5          .     PUSH  HL         

+33CA CD A8 2C    ..,   CALL  2CA8       ; INT CONST to-pos holen

+33CD 7B          {     LD    A,E        

+33CE 95          .     SUB   L          

+33CF 7A          z     LD    A,D        ; falls to < from beide vertauschen

+33D0 9C          .     SBC   H          

+33D1 38 01       8.    JR    C,33D4     

+33D3 EB          .     EX    DE,HL      

+33D4 CD 64 43    .dC   CALL  4364       ; INT VAR exit addr holen 

+33D7 22 E3 41    ".A   LD    (41E3),HL  ; exit addresse

+33DA ED 43 D0 41 .C.A  LD    (41D0),BC  ; BC retten

+33DE 42          B     LD    B,D        ; BC := to pos

+33DF 4B          K     LD    C,E        

+33E0 E1          .     POP   HL         ; pos addresse

+33E1 22 CC 41    ".A   LD    (41CC),HL  

+33E4 5E          ^     LD    E,(HL)     ; poswert holen --> DE

+33E5 2C          ,     INC   L          

+33E6 56          V     LD    D,(HL)     

+33E7 E1          .     POP   HL         ; TEXT zeile

+33E8 CD 1D 46    ..F   CALL  461D       ; TEXT Zugriff

+33EB DA 56 34    .V4   JP    C,3456     ; Fehlerausgang

+33EE CD 44 45    .DE   CALL  4544       ; Zeichenaddr (Text SUB pos)--> HL

+33F1 CA 56 34    .V4   JP    Z,3456     ; Fehlerausgang, wenn > TEXT-Laenge

+33F4 F5          .     PUSH  AF         ; Flag (C) merken

+33F5 DD CB 07 5E ...^  BIT   3,(IX+07)  ; Extension-Bit (Skip next char) 

+33F9 20 4D        M    JR    NZ,3448    ; Res BIT 3 und �bernaechstes zeichen

+33FB 7E          ~     LD    A,(HL)     ; A = ROW-Offset (Code)

+33FC E5          .     PUSH  HL         

+33FD 2A DB 41    *.A   LD    HL,(41DB)  ; Block 1 Wortaddr

+3400 85          .     ADD   L          

+3401 30 03       0.    JR    NC,3406    

+3403 2A DD 41    *.A   LD    HL,(41DD)  ; Block 2 Wortaddr

+3406 6F          o     LD    L,A        

+3407 29          )     ADD   HL,HL      

+3408 5E          ^     LD    E,(HL)     ; DE := tabelle(A)

+3409 2C          ,     INC   L          

+340A 56          V     LD    D,(HL)     

+340B ED 53 CE 41 .S.A  LD    (41CE),DE  ; fuer exit merken

+340F CB 7A       .z    BIT   7,D        

+3411 28 06       (.    JR    Z,3419     ; < 0 : Extensionchar (Skip next)

+3413 CB BA       ..    RES   7,D        ; F�r Summierung positiv machen

+3415 DD CB 07 DE ....  SET   3,(IX+07)  ; merken, dass DE negativ war

+3419 2A DF 41    *.A   LD    HL,(41DF)  ; Addresse von 'summe'

+341C 7E          ~     LD    A,(HL)     ; DE INCR summe

+341D 83          .     ADD   E          

+3477 C3 06 2D    ..-   JP    2D06       ;---------- task heapsize ---------

+347A 3A CB 41    :.A   LD    A,(41CB)   ; heaptop DIV 4 +1

+347D CB 3F       .?    SLR   A          

+347F CB 3F       .?    SLR   A          

+3481 3C          <     INC   A          

+3482 5F          _     LD    E,A        

+3483 16 00       ..    LD    D,00       

+3485 C3 03 2D    ..-   JP    2D03       ;----------- collect heap garbage -

+3488 79          y     LD    A,C        ; pbase ?

+3489 08          .     EX    AF,AF'     

+348A C3 33 4A    .3J   JP    4A33       ;----------- replace int ---------

+348D 3E 01       >.    LD    A,01       ; 1 Wort

+348F 18 02       ..    JR    3493       ;----------- replace real -------

+3491 3E 07       >.    LD    A,07       ; 7 Woerter

+3493 32 D2 41    2.A   LD    (41D2),A   

+3496 CD AA 47    ..G   CALL  47AA       

+3499 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+349D 18 0C       ..    JR    34AB       ;-------------- ISUB -------------

+349F 3E 01       >.    LD    A,01       

+34A1 18 02       ..    JR    34A5       ;------------- RSUB --------------

+34A3 3E 07       >.    LD    A,07       

+34A5 32 D2 41    2.A   LD    (41D2),A   

+34A8 CD 8D 46    ..F   CALL  468D       

+34AB E5          .     PUSH  HL         

+34AC CD A8 2C    ..,   CALL  2CA8       

+34AF 2B          +     DEC   HL         

+34B0 CB 7C       .|    BIT   7,H        

+34B2 C4 D9 3C    ..<   CALL  NZ,3CD9    

+34B5 29          )     ADD   HL,HL      

+34B6 3A D2 41    :.A   LD    A,(41D2)   

+34B9 FE 01       ..    CP    01         

+34BB 28 02       (.    JR    Z,34BF     

+34BD 29          )     ADD   HL,HL      

+34BE 29          )     ADD   HL,HL      

+34BF B5          .     OR    L          

+34C0 93          .     SUB   E          

+34C1 7C          |     LD    A,H        

+34C2 9A          .     SBC   D          

+34C3 D4 D9 3C    ..<   CALL  NC,3CD9    

+34C6 EB          .     EX    DE,HL      

+34C7 E1          .     POP   HL         

+34C8 CD 0D 45    ..E   CALL  450D       

+34CB EB          .     EX    DE,HL      

+34CC FD CB 00 46 ...F  BIT   0,(IY+00)  

+34D0 28 06       (.    JR    Z,34D8     

+34D2 CD 64 43    .dC   CALL  4364       

+34D5 EB          .     EX    DE,HL      

+34D6 18 03       ..    JR    34DB       

+34D8 CD 13 43    ..C   CALL  4313       

+34DB C5          .     PUSH  BC         

+34DC 3A D2 41    :.A   LD    A,(41D2)   

+34DF 47          G     LD    B,A        

+34E0 4F          O     LD    C,A        

+34E1 D5          .     PUSH  DE         

+34E2 11 F3 41    ..A   LD    DE,41F3    

+34E5 7E          ~     LD    A,(HL)     

+34E6 12          .     LD    (DE),A     

+34E7 2C          ,     INC   L          

+34E8 CC 1B 45    ..E   CALL  Z,451B     

+34EB 13          .     INC   DE         

+34EC 10 F7       ..    DJNZ  34E5       

+34EE 7E          ~     LD    A,(HL)     

+34EF 12          .     LD    (DE),A     

+34F0 E1          .     POP   HL         

+34F1 11 F3 41    ..A   LD    DE,41F3    

+34F4 41          A     LD    B,C        

+34F5 1A          .     LD    A,(DE)     

+34F6 77          w     LD    (HL),A     

+34F7 2C          ,     INC   L          

+34F8 CC 1B 45    ..E   CALL  Z,451B     

+34FB 13          .     INC   DE         

+34FC 10 F7       ..    DJNZ  34F5       

+34FE 1A          .     LD    A,(DE)     

+34FF 77          w     LD    (HL),A     

+3500 C1          .     POP   BC         

+3501 C3 A7 2A    ..*   JP    2AA7       ;----------- FMOV MOV8 ------------

+3504 CD 1B 43    ..C   CALL  431B       

+3507 7D          }     LD    A,L        

+3508 E6 F8       ..    AND   F8         

+350A 5F          _     LD    E,A        

+350B 54          T     LD    D,H        

+350C CD 64 43    .dC   CALL  4364       

+350F 7D          }     LD    A,L        

+3510 E6 F8       ..    AND   F8         

+3512 6F          o     LD    L,A        

+3513 EB          .     EX    DE,HL      

+3514 C5          .     PUSH  BC         

+3515 01 08 00    ...   LD    BC,0008    

+3518 F3          .     DI               

+3519 ED B0       ..    LDIR             

+351B FB          .     EI               

+351C C1          .     POP   BC         

+351D C3 A7 2A    ..*   JP    2AA7       ;-------------- FADD --------------

+3520 FD 21 2C 4F .!,O  LD    IY,4F2C    

+3524 CD AF 44    ..D   CALL  44AF       

+3527 EB          .     EX    DE,HL      

+3528 CD A7 44    ..D   CALL  44A7       

+352B CD 60 4E    .`N   CALL  4E60       

+352E 30 DC       0.    JR    NC,350C    

+3530 3E 06       >.    LD    A,06       

+3532 CD 0D 3D    ..=   CALL  3D0D       

+3535 CD 43 44    .CD   CALL  4443       

+3538 C3 A7 2A    ..*   JP    2AA7       ;------------- FSUB ---------------

+353B FD 21 20 4F .! O  LD    IY,4F20    

+353F 18 E3       ..    JR    3524       ;------------- FMULT --------------

+3541 FD 21 E1 4F .!.O  LD    IY,4FE1    

+3545 18 DD       ..    JR    3524       ;------------ FDIV ----------------

+3547 FD 21 59 50 .!YP  LD    IY,5059    

+354B 18 D7       ..    JR    3524       ;------------ FEQU --------------

+354D CD A7 44    ..D   CALL  44A7       

+3550 EB          .     EX    DE,HL      

+3551 CD A7 44    ..D   CALL  44A7       

+3554 CD 83 4E    ..N   CALL  4E83       

+3557 C2 84 2E    ...   JP    NZ,2E84    

+355A C3 71 2E    .q.   JP    2E71       ;----------- FLSEQ ----------------

+355D CD AF 44    ..D   CALL  44AF       

+3560 EB          .     EX    DE,HL      

+3561 CD A7 44    ..D   CALL  44A7       

+3564 EB          .     EX    DE,HL      

+3565 CD 83 4E    ..N   CALL  4E83       

+3568 DA 84 2E    ...   JP    C,2E84     

+356B C3 71 2E    .q.   JP    2E71       ;------------ FCOMPL -------------

+356E CD A7 44    ..D   CALL  44A7       

+3571 EB          .     EX    DE,HL      

+3572 CD B7 44    ..D   CALL  44B7       

+3575 EB          .     EX    DE,HL      

+3576 CD D2 4E    ..N   CALL  4ED2       

+3579 C3 A7 2A    ..*   JP    2AA7       ;--------------- SLD --------------

+357C CD 13 43    ..C   CALL  4313       

+357F 56          V     LD    D,(HL)     

+3580 CD B7 44    ..D   CALL  44B7       

+3583 E5          .     PUSH  HL         

+3584 CD 64 43    .dC   CALL  4364       

+3587 E3          .     EX    (SP),HL    

+3588 97          .     SUB   A          

+3589 ED 67       .g    RRD              

+358B 5F          _     LD    E,A        

+358C 7A          z     LD    A,D        

+358D CD 1B 52    ..R   CALL  521B       

+3590 E1          .     POP   HL         

+3591 73          s     LD    (HL),E     

+3592 2C          ,     INC   L          

+3593 36 00       6.    LD    (HL),00    

+3595 C3 A7 2A    ..*   JP    2AA7       ;------------ decimalexponent ------

+3598 CD A7 44    ..D   CALL  44A7       

+359B CD E9 4E    ..N   CALL  4EE9       

+359E C3 03 2D    ..-   JP    2D03       ;------------ setexp --------------

+35A1 CD 13 43    ..C   CALL  4313       

+35A4 5E          ^     LD    E,(HL)     

+35A5 CD B7 44    ..D   CALL  44B7       

+35A8 CD E0 4E    ..N   CALL  4EE0       

+35AB C3 A7 2A    ..*   JP    2AA7       ;------------- floor --------------

+35AE CD A7 44    ..D   CALL  44A7       

+35B1 EB          .     EX    DE,HL      

+35B2 CD B7 44    ..D   CALL  44B7       

+35B5 EB          .     EX    DE,HL      

+35B6 CD F6 4E    ..N   CALL  4EF6       

+35B9 C3 A7 2A    ..*   JP    2AA7       ;------------ clock (nr) ----------

+35BC CD 13 43    ..C   CALL  4313       

+35BF 7E          ~     LD    A,(HL)     

+35C0 E6 07       ..    AND   07         

+35C2 28 0F       (.    JR    Z,35D3     ; clock(0) = Taskclock

+35C4 3D          =     DEC   A          ; -1

+35C5 87          .     ADD   A          ; *8 (REAL)

+35C6 87          .     ADD   A          

+35C7 87          .     ADD   A          

+35C8 6F          o     LD    L,A        

+35C9 26 00       &.    LD    H,00       

+35CB 11 B9 4C    ..L   LD    DE,4CB9    ; 4CB9 = clock (1)

+35CE 19          .     ADD   HL,DE      

+35CF EB          .     EX    DE,HL      

+35D0 C3 0C 35    ..5   JP    350C       ; Move Real

+35D3 ED 5B 1C 6E .[.n  LD    DE,(6E1C)  ; Steht im Leitblock ab 38..3f

+35D7 1E 38       .8    LD    E,38       ; Move real

+35D9 C3 0C 35    ..5   JP    350C       ;------------ clock (task) --------

+35DC CD C2 3D    ..=   CALL  3DC2       ; Fremden Leitblock laden

+35DF FD E5       ..    PUSH  IY         ; Leitblock addr in IY

+35E1 D1          .     POP   DE         

+35E2 18 F3       ..    JR    35D7       ;----------- setclock task -------

+35E4 CD BA 3D    ..=   CALL  3DBA       

+35E7 CD 13 43    ..C   CALL  4313       

+35EA FD E5       ..    PUSH  IY         

+35EC D1          .     POP   DE         

+35ED 1E 38       .8    LD    E,38       ; Move Real

+35EF C3 14 35    ..5   JP    3514       ;---------- setclock -------------

+35F2 DD 7E 1D    .~.   LD    A,(IX+1D)  ; priv >= 1

+35F5 FE 01       ..    CP    01         

+35F7 DA E6 3C    ..<   JP    C,3CE6     ; privilegierungsfehler

+35FA CD A7 44    ..D   CALL  44A7       ; 

+35FD 11 B9 4C    ..L   LD    DE,4CB9    

+3600 C3 14 35    ..5   JP    3514       ;------------ ACCDS ---------------

+3603 CD 1B 43    ..C   CALL  431B       

+3606 CD 11 36    ..6   CALL  3611       ; Test ob DSID > 4

+3609 1E 00       ..    LD    E,00       ; REF-Addr D=DSID, E=0

+360B D5          .     PUSH  DE         

+360C 21 04 01    !..   LD    HL,0104    ; Wortaddresse 4 in Seite 1 i. Start

+360F 18 23       .#    JR    3634       ;------------ DSID > 4 ? ----------

+3611 56          V     LD    D,(HL)     

+3612 3E 04       >.    LD    A,04       

+3614 BA          .     CP    D          

+3615 D2 82 38    ..8   JP    NC,3882    ; falscher DATASPACE Zugriff

+3618 2C          ,     INC   L          

+3619 7E          ~     LD    A,(HL)     

+361A DD BE 30    ..0   CP    (IX+30)    

+361D C2 82 38    ..8   JP    NZ,3882    

+3620 C9          .     RET              ;-------------- REF ---------------

+3621 CD C0 43    ..C   CALL  43C0       ; Wortaddr holen

+3624 D5          .     PUSH  DE         ; Zweiwortaddr auf Stack

+3625 18 0D       ..    JR    3634       ;-------------- SEL ---------------

+3627 CD C0 43    ..C   CALL  43C0       

+362A D5          .     PUSH  DE         

+362B CD 43 44    .CD   CALL  4443       ; Offset holen

+362E 19          .     ADD   HL,DE      ; REF:=Base+Offset

+362F 30 03       0.    JR    NC,3634    

+3631 D1          .     POP   DE         

+3632 1C          .     INC   E          

+3633 D5          .     PUSH  DE         

+3634 EB          .     EX    DE,HL      ;---------- REF-Adr auf Stack -----

+3635 CD 64 43    .dC   CALL  4364       

+3638 73          s     LD    (HL),E     ; 4 Bytes auf Stack

+3639 2C          ,     INC   L          

+363A 72          r     LD    (HL),D     

+363B 2C          ,     INC   L          

+363C D1          .     POP   DE         

+363D 73          s     LD    (HL),E     

+363E 2C          ,     INC   L          

+363F 72          r     LD    (HL),D     

+3640 C3 A7 2A    ..*   JP    2AA7       ;------------- SUBS ---------------

+3643 67          g     LD    H,A        

+3644 E5          .     PUSH  HL         

+3645 CD 43 44    .CD   CALL  4443

+3648 CD 13 43    ..C   CALL  4313       

+364B 7E          ~     LD    A,(HL)     

+364C 2C          ,     INC   L          

+364D 66          f     LD    H,(HL)     

+364E 6F          o     LD    L,A        

+364F 2B          +     DEC   HL         

+3650 7B          {     LD    A,E        

+3651 95          .     SUB   L          

+3652 7A          z     LD    A,D        

+3653 9C          .     SBC   H          

+3654 DC D9 3C    ..<   CALL  C,3CD9     

+3657 EB          .     EX    DE,HL      

+3658 E1          .     POP   HL         

+3659 CD 6D 4D    .mM   CALL  4D6D       

+365C DC D9 3C    ..<   CALL  C,3CD9     

+365F E5          .     PUSH  HL         

+3660 F5          .     PUSH  AF         

+3661 CD B8 43    ..C   CALL  43B8       

+3664 F1          .     POP   AF         

+3665 83          .     ADD   E          

+3666 5F          _     LD    E,A        

+3667 EB          .     EX    DE,HL      

+3668 E3          .     EX    (SP),HL    

+3669 19          .     ADD   HL,DE      

+366A 30 C8       0.    JR    NC,3634    ; REF-Adr auf Stack

+366C 18 C3       ..    JR    3631       ;------------ EQUIM --------------

+366E EB          .     EX    DE,HL      

+366F CD 13 43    ..C   CALL  4313       

+3672 7E          ~     LD    A,(HL)     

+3673 BB          .     CP    E          

+3674 C2 84 2E    ...   JP    NZ,2E84    ; Lowbyte vergleichen

+3677 2C          ,     INC   L          

+3678 7E          ~     LD    A,(HL)     ; Highbyte muss 0 sein

+3679 B7          .     OR    A          

+367A C2 84 2E    ...   JP    NZ,2E84    

+367D C3 71 2E    .q.   JP    2E71       ;-------------- STIM -------------

+3680 EB          .     EX    DE,HL      

+3681 16 00       ..    LD    D,00       ; Lowbyte uebernehmen, Highbyte 0

+3683 C3 03 2D    ..-   JP    2D03       ;-------------- MOVEXX -----------

+3686 CD 43 44    .CD   CALL  4443       ; langer move

+3689 D5          .     PUSH  DE         

+368A 18 03       ..    JR    368F       ;-------------- MOVX -------------

+368C 26 00       &.    LD    H,00       ; Highbyte 0

+368E E5          .     PUSH  HL         

+368F CD B8 43    ..C   CALL  43B8       ; laenge holen

+3692 FD 21 85 46 .!.F  LD    IY,4685    

+3696 FD 36 00 01 .6..  LD    (IY+00),01 

+369A FD 72 03    .r.   LD    (IY+03),D  

+369D 7B          {     LD    A,E        

+369E CD CA 44    ..D   CALL  44CA       ; from addr holen

+36A1 E5          .     PUSH  HL         

+36A2 CD B8 43    ..C   CALL  43B8       

+36A5 FD 21 89 46 .!.F  LD    IY,4689    

+36A9 FD 36 00 00 .6..  LD    (IY+00),00 

+36AD FD 72 03    .r.   LD    (IY+03),D  

+36B0 7B          {     LD    A,E        

+36B1 CD CA 44    ..D   CALL  44CA       

+36B4 EB          .     EX    DE,HL      

+36B5 E1          .     POP   HL         

+36B6 ED 43 D0 41 .C.A  LD    (41D0),BC  

+36BA C1          .     POP   BC         

+36BB CB 21       .!    SLA   C          ; Laenge * 2 in Bytes

+36BD CB 10       ..    RL    B          

+36BF CD B0 2C    ..,   CALL  2CB0       

+36C2 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+36C6 C3 A7 2A    ..*   JP    2AA7       ;--------------- GW --------------

+36C9 CD F9 36    ..6   CALL  36F9       ; segment und oofset

+36CC CD 4D 44    .MD   CALL  444D       ; Wert auf Stack

+36CF C3 00 2D    ..-   JP    2D00       ;-------------- PW ---------------

+36D2 CD F9 36    ..6   CALL  36F9       ; segment und offset

+36D5 CD 7D 44    .}D   CALL  447D       

+36D8 EB          .     EX    DE,HL      

+36D9 CD 13 43    ..C   CALL  4313       

+36DC 7E          ~     LD    A,(HL)     

+36DD 12          .     LD    (DE),A     ; segment veraendern

+36DE 2C          ,     INC   L          

+36DF 1C          .     INC   E          

+36E0 7E          ~     LD    A,(HL)     

+36E1 12          .     LD    (DE),A     

+36E2 C3 A7 2A    ..*   JP    2AA7       ;----------- getword ------------- 

+36E5 CD 13 43    ..C   CALL  4313       ; segment (Nur ein Byte)

+36E8 5E          ^     LD    E,(HL)     

+36E9 CD A8 2C    ..,   CALL  2CA8       ; wortaddr --> HL

+36EC 7B          {     LD    A,E        ; Seg in A, addr in HL, Wert a.Stack

+36ED 18 DD       ..    JR    36CC       ;------------ putword ------------

+36EF CD 13 43    ..C   CALL  4313       

+36F2 5E          ^     LD    E,(HL)     ; segment (nur ein byte)

+36F3 CD A8 2C    ..,   CALL  2CA8       

+36F6 7B          {     LD    A,E        ; Segment 

+36F7 18 DC       ..    JR    36D5       ;--------------------------------

+36F9 5D          ]     LD    E,L        ; L ist Opcode Byte m. Seg und Offse

+36FA CD 13 43    ..C   CALL  4313       

+36FD 7B          {     LD    A,E        

+36FE 5E          ^     LD    E,(HL)     ; Wortaddr holen

+36FF 2C          ,     INC   L          

+3700 56          V     LD    D,(HL)     

+3701 67          g     LD    H,A        

+3702 E6 0F       ..    AND   0F         ; Low digit = Offset zu Wortaddr

+3704 6F          o     LD    L,A        

+3705 AC          .     XOR   H          ; Low DIgit in A = 0

+3706 26 00       &.    LD    H,00       

+3708 19          .     ADD   HL,DE      

+3709 0F          .     RRCA             ; A 0 Segment

+370A 0F          .     RRCA             

+370B 0F          .     RRCA             

+370C 0F          .     RRCA             

+370D C9          .     RET              ;------------- KE ----------------

+370E CD 2A 6F    .*o   CALL  6F2A       ; Info " KE"

+3711 C3 A7 2A    ..*   JP    2AA7       ;-------------- SYSGEN ------------

+3714 CD 05 53    ..S   CALL  5305       ; RET, Keine Aktion

+3717 C3 A7 2A    ..*   JP    2AA7       ;--------------- cout ------------

+371A CD 13 43    ..C   CALL  4313       ; INT holen

+371D 5E          ^     LD    E,(HL)     

+371E 2C          ,     INC   L          

+371F 56          V     LD    D,(HL)     

+3720 C5          .     PUSH  BC         

+3721 CB 7A       .z    BIT   7,D        

+3723 20 34        4    JR    NZ,3759    

+3725 DD 7E 26    .~&   LD    A,(IX+26)  ; Am Kanal ?

+3728 B7          .     OR    A          

+3729 28 2E       (.    JR    Z,3759     ; Nur fuer positive Zahlen

+372B CD 59 1E    .Y.   CALL  1E59       

+372E FE 1E       ..    CP    1E         ; Kanal genuegend frei

+3730 38 27       8'    JR    C,3759     

+3732 21 20 20    !     LD    HL,2020    

+3735 22 E9 41    ".A   LD    (41E9),HL  

+3738 22 EB 41    ".A   LD    (41EB),HL  ; Puffer loeschen

+373B 21 E8 41    !.A   LD    HL,41E8    

+373E CD 00 4E    ..N   CALL  4E00       ; Konvertieren

+3741 21 E7 41    !.A   LD    HL,41E7    

+3744 01 0C 00    ...   LD    BC,000C    ; Stringlaenge 12

+3747 59          Y     LD    E,C        

+3748 DD 7E 26    .~&   LD    A,(IX+26)  ; immer noch frei ?

+374B B7          .     OR    A          

+374C 28 0B       (.    JR    Z,3759     

+374E CD 88 21    ..!   CALL  2188       ; OUTPUT

+3751 38 06       8.    JR    C,3759     

+3753 09          .     ADD   HL,BC      

+3754 7B          {     LD    A,E        

+3755 91          .     SUB   C          

+3756 4F          O     LD    C,A        

+3757 18 EE       ..    JR    3747       

+3759 C1          .     POP   BC         

+375A C3 A7 2A    ..*   JP    2AA7       ;------------ outsubtext 1 --------

+375D CD 89 47    ..G   CALL  4789       

+3760 18 08       ..    JR    376A       ;------------ outsubtext 2 --------

+3762 CD 95 47    ..G   CALL  4795       

+3765 18 03       ..    JR    376A       ;--------------- out --------------

+3767 CD 8D 46    ..F   CALL  468D       

+376A C5          .     PUSH  BC         

+376B 42          B     LD    B,D        

+376C 4B          K     LD    C,E        

+376D CD 44 45    .DE   CALL  4544       

+3770 28 16       (.    JR    Z,3788     

+3772 F5          .     PUSH  AF         

+3773 50          P     LD    D,B        

+3774 59          Y     LD    E,C        

+3775 DD 7E 26    .~&   LD    A,(IX+26)  

+3778 B7          .     OR    A          

+3779 28 11       (.    JR    Z,378C     

+377B CD 88 21    ..!   CALL  2188       ; OUTPUT

+377E 30 0F       0.    JR    NC,378F    

+3780 F1          .     POP   AF         

+3781 30 05       0.    JR    NC,3788    

+3783 CD C1 45    ..E   CALL  45C1       

+3786 18 E5       ..    JR    376D       

+3788 C1          .     POP   BC         

+3789 C3 A7 2A    ..*   JP    2AA7       

+378C 01 00 00    ...   LD    BC,0000    

+378F F1          .     POP   AF         

+3790 7B          {     LD    A,E        

+3791 91          .     SUB   C          

+3792 4F          O     LD    C,A        

+3793 7A          z     LD    A,D        

+3794 98          .     SBC   B          

+3795 47          G     LD    B,A        

+3796 CD F1 45    ..E   CALL  45F1       

+3799 3E 44       >D    LD    A,44       

+379B C3 23 29    .#)   JP    2923       ;-------------- inchar ------------

+379E CD 64 43    .dC   CALL  4364       

+37A1 2C          ,     INC   L          

+37A2 2C          ,     INC   L          

+37A3 DD 7E 26    .~&   LD    A,(IX+26)  ; AM Kanal ?

+37A6 B7          .     OR    A          

+37A7 28 05       (.    JR    Z,37AE     

+37A9 CD 06 1F    ...   CALL  1F06       ; incharety 

+37AC 30 05       0.    JR    NC,37B3    

+37AE 3E 48       >H    LD    A,48       ; Status: Auf Taste warten

+37B0 C3 23 29    .#)   JP    2923       

+37B3 36 01       6.    LD    (HL),01    ; Text der laenge 1

+37B5 2C          ,     INC   L          

+37B6 77          w     LD    (HL),A     

+37B7 CD 29 4C    .)L   CALL  4C29       

+37BA C3 A7 2A    ..*   JP    2AA7       ;------------- incharety ---------

+37BD CD 64 43    .dC   CALL  4364       

+37C0 2C          ,     INC   L          

+37C1 2C          ,     INC   L          

+37C2 DD 7E 26    .~&   LD    A,(IX+26)  

+37C5 B7          .     OR    A          

+37C6 28 05       (.    JR    Z,37CD     

+37C8 CD 06 1F    ...   CALL  1F06       

+37CB 30 E6       0.    JR    NC,37B3    ; Text der laenge 1

+37CD 97          .     SUB   A          ; Niltext

+37CE 77          w     LD    (HL),A     

+37CF 2C          ,     INC   L          

+37D0 77          w     LD    (HL),A     

+37D1 C3 A7 2A    ..*   JP    2AA7       ;-------------- pause ------------

+37D4 CD A8 2C    ..,   CALL  2CA8       

+37D7 DD 7E 26    .~&   LD    A,(IX+26)  

+37DA B7          .     OR    A          

+37DB 28 06       (.    JR    Z,37E3     

+37DD CD AD 1E    ...   CALL  1EAD       ; Taste gedrueckt ?

+37E0 D2 A7 2A    ..*   JP    NC,2AA7    

+37E3 ED 5B F1 4C .[.L  LD    DE,(4CF1)  

+37E7 19          .     ADD   HL,DE      

+37E8 DD 75 0C    .u.   LD    (IX+0C),L  ; modi := time

+37EB DD 74 0D    .t.   LD    (IX+0D),H  

+37EE 79          y     LD    A,C        

+37EF 08          .     EX    AF,AF'     

+37F0 3E 4C       >L    LD    A,4C       ; Status: pause

+37F2 C3 23 29    .#)   JP    2923       ;------------ getcursor -----------

+37F5 C5          .     PUSH  BC         

+37F6 DD 7E 26    .~&   LD    A,(IX+26)  

+37F9 B7          .     OR    A          

+37FA C4 85 1E    ...   CALL  NZ,1E85    ; getcursor --> BC

+37FD 59          Y     LD    E,C        

+37FE 50          P     LD    D,B        

+37FF C1          .     POP   BC         ; icount

+3800 DA 26 29    .&)   JP    C,2926     

+3803 1C          .     INC   E          ; x+1 , y+1

+3804 14          .     INC   D          

+3805 CD 64 43    .dC   CALL  4364       ; Zwei Werte (wie REF-Adr) auf Stack

+3808 72          r     LD    (HL),D     ; Beide Highbytes 0

+3809 16 00       ..    LD    D,00       

+380B 2C          ,     INC   L          

+380C 72          r     LD    (HL),D     

+380D C3 03 2D    ..-   JP    2D03       ;------------ catinput ------------

+3810 CD B8 43    ..C   CALL  43B8       

+3813 E5          .     PUSH  HL         

+3814 D5          .     PUSH  DE         

+3815 CD 64 43    .dC   CALL  4364       

+3818 2C          ,     INC   L          

+3819 2C          ,     INC   L          

+381A 22 CC 41    ".A   LD    (41CC),HL  

+381D 97          .     SUB   A          

+381E 77          w     LD    (HL),A     

+381F 2C          ,     INC   L          

+3820 77          w     LD    (HL),A     

+3821 DD 7E 26    .~&   LD    A,(IX+26)  

+3824 B7          .     OR    A          

+3825 28 44       (D    JR    Z,386B     

+3827 D1          .     POP   DE         

+3828 E1          .     POP   HL         

+3829 E5          .     PUSH  HL         

+382A D5          .     PUSH  DE         

+382B CD AD 47    ..G   CALL  47AD       

+382E ED 53 40 4B .S@K  LD    (4B40),DE  

+3832 D5          .     PUSH  DE         

+3833 13          .     INC   DE         

+3834 CD AD 48    ..H   CALL  48AD       

+3837 D1          .     POP   DE         

+3838 38 2A       8*    JR    C,3864     

+383A CD 1D 4A    ..J   CALL  4A1D       

+383D CD 0D 45    ..E   CALL  450D       

+3840 DD 7E 26    .~&   LD    A,(IX+26)  

+3843 CD 06 1F    ...   CALL  1F06       ; incharety

+3846 38 1C       8.    JR    C,3864     

+3848 FE 20       .     CP    20         

+384A 38 11       8.    JR    C,385D     ; < Blank ?

+384C 77          w     LD    (HL),A     

+384D 13          .     INC   DE         

+384E 2C          ,     INC   L          

+384F 7D          }     LD    A,L        ; alle 8 Zeichen unterbrechen

+3850 E6 07       ..    AND   07         

+3852 20 EC        .    JR    NZ,3840    

+3854 CD 92 48    ..H   CALL  4892       

+3857 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+385B 18 CA       ..    JR    3827       ; nochmal von vorne

+385D 2A CC 41    *.A   LD    HL,(41CC)  

+3860 36 01       6.    LD    (HL),01    ; Text der Laenge 1 = escchar

+3862 2C          ,     INC   L          

+3863 77          w     LD    (HL),A     

+3864 CD 92 48    ..H   CALL  4892       ; Kein Zeichen mehr: CAT...

+3867 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+386B D1          .     POP   DE         

+386C E1          .     POP   HL         

+386D C3 A7 2A    ..*   JP    2AA7       ;------ korrekte DSID in HL ?-----

+3870 DD 7E 30    .~0   LD    A,(IX+30)  ; eigener Taskindex

+3873 BC          .     CP    H          

+3874 20 0C        .    JR    NZ,3882    

+3876 7D          }     LD    A,L        ; DSnr > 4

+3877 FE 05       ..    CP    05         

+3879 38 07       8.    JR    C,3882     

+387B C5          .     PUSH  BC         

+387C 4D          M     LD    C,L        ; exists (ds) ?

+387D CD 77 69    .wi   CALL  6977       

+3880 C1          .     POP   BC         

+3881 D0          .     RET   NC         

+3882 3E 0B       >.    LD    A,0B       ; alias error

+3884 CD 0D 3D    ..=   CALL  3D0D       

+3887 21 05 00    !..   LD    HL,0005    ; Errorspace mit eienem Index

+388A 55          U     LD    D,L        

+388B 37          7     SCF              

+388C C9          .     RET              ;---------------------------------

+388D 55          U     LD    D,L        

+388E 1E 00       ..    LD    E,00       

+3890 21 02 01    !..   LD    HL,0102    

+3893 CD 5C 65    .\e   CALL  655C       

+3896 0F          .     RRCA             

+3897 67          g     LD    H,A        

+3898 29          )     ADD   HL,HL      

+3899 C9          .     RET              ;------------ ALIAS --------------

+389A CD 43 44    .CD   CALL  4443       ; DSID holen

+389D 21 0B 01    !..   LD    HL,010B    

+38A0 19          .     ADD   HL,DE      

+38A1 38 0A       8.    JR    C,38AD     

+38A3 7D          }     LD    A,L        

+38A4 E6 F8       ..    AND   F8         

+38A6 6F          o     LD    L,A        

+38A7 29          )     ADD   HL,HL      

+38A8 30 01       0.    JR    NC,38AB    

+38AA 2C          ,     INC   L          

+38AB 18 03       ..    JR    38B0       

+38AD 21 04 00    !..   LD    HL,0004    

+38B0 22 CC 41    ".A   LD    (41CC),HL  

+38B3 CD A8 2C    ..,   CALL  2CA8       

+38B6 CD 70 38    .p8   CALL  3870       

+38B9 E5          .     PUSH  HL         

+38BA CD 8D 38    ..8   CALL  388D       

+38BD 2D          -     DEC   L          

+38BE 2D          -     DEC   L          

+38BF 7E          ~     LD    A,(HL)     

+38C0 3C          <     INC   A          

+38C1 20 1E        .    JR    NZ,38E1    

+38C3 21 00 01    !..   LD    HL,0100    

+38C6 CD 2C 66    .,f   CALL  662C       

+38C9 0F          .     RRCA             

+38CA 67          g     LD    H,A        

+38CB 29          )     ADD   HL,HL      

+38CC ED 5B CC 41 .[.A  LD    DE,(41CC)  ; Liefert REF-Addr

+38D0 73          s     LD    (HL),E     

+38D1 2C          ,     INC   L          

+38D2 72          r     LD    (HL),D     

+38D3 2C          ,     INC   L          

+38D4 73          s     LD    (HL),E     

+38D5 2C          ,     INC   L          

+38D6 72          r     LD    (HL),D     

+38D7 2C          ,     INC   L          

+38D8 CB 7E       .~    BIT   7,(HL)     

+38DA 28 05       (.    JR    Z,38E1     

+38DC 36 00       6.    LD    (HL),00    

+38DE 2C          ,     INC   L          

+38DF 36 00       6.    LD    (HL),00    

+38E1 D1          .     POP   DE         

+38E2 C3 03 2D    ..-   JP    2D03       ;---------- nilspace -------------

+38E5 11 00 00    ...   LD    DE,0000    

+38E8 C3 03 2D    ..-   JP    2D03       ;----------- dscopy := -----------

+38EB CD 64 43    .dC   CALL  4364       ; dest adr holen

+38EE E5          .     PUSH  HL         

+38EF CD A8 2C    ..,   CALL  2CA8       

+38F2 7C          |     LD    A,H        

+38F3 B5          .     OR    L          

+38F4 C4 70 38    .p8   CALL  NZ,3870    ; source <> nilspace

+38F7 EB          .     EX    DE,HL      

+38F8 38 0F       8.    JR    C,3909     

+38FA C5          .     PUSH  BC         

+38FB DD 46 30    .F0   LD    B,(IX+30)  ; eigener taskindex

+38FE 4B          K     LD    C,E        

+38FF 50          P     LD    D,B        

+3900 CD E8 68    ..h   CALL  68E8       ; 

+3903 C1          .     POP   BC         

+3904 1C          .     INC   E          ; Anzahl Dataspaces

+3905 1D          .     DEC   E          

+3906 CC 10 39    ..9   CALL  Z,3910     ; errorstop durhfuehren als SBRT.

+3909 E1          .     POP   HL         

+390A 73          s     LD    (HL),E     

+390B 2C          ,     INC   L          

+390C 72          r     LD    (HL),D     

+390D C3 A7 2A    ..*   JP    2AA7       

+3910 3E 08       >.    LD    A,08       ; errorstop zuviele DS

+3912 CD 0D 3D    ..=   CALL  3D0D       

+3915 11 05 00    ...   LD    DE,0005    ; result ist errorspace

+3918 C9          .     RET              ;------------- forget ------------

+3919 CD 64 43    .dC   CALL  4364       

+391C C5          .     PUSH  BC         

+391D 5E          ^     LD    E,(HL)     

+391E 2C          ,     INC   L          

+391F 56          V     LD    D,(HL)     

+3920 EB          .     EX    DE,HL      

+3921 3E 05       >.    LD    A,05       ; Nur ds > 4 loeschen

+3923 BD          .     CP    L          

+3924 30 17       0.    JR    NC,393D    

+3926 CB 7C       .|    BIT   7,H        

+3928 28 06       (.    JR    Z,3930     

+392A 7D          }     LD    A,L        

+392B 84          .     ADD   H          

+392C 20 0F        .    JR    NZ,393D    

+392E 18 06       ..    JR    3936       

+3930 DD 7E 30    .~0   LD    A,(IX+30)  

+3933 BC          .     CP    H          

+3934 20 07        .    JR    NZ,393D    

+3936 4D          M     LD    C,L        

+3937 CD 77 69    .wi   CALL  6977       

+393A D4 97 69    ..i   CALL  NC,6997    

+393D EB          .     EX    DE,HL      

+393E 36 00       6.    LD    (HL),00    ; ergebnis 01 DS

+3940 2D          -     DEC   L          

+3941 36 01       6.    LD    (HL),01    

+3943 C1          .     POP   BC         

+3944 C3 A7 2A    ..*   JP    2AA7       ;------------- settype -----------

+3947 CD A8 2C    ..,   CALL  2CA8       

+394A EB          .     EX    DE,HL      

+394B CD A8 2C    ..,   CALL  2CA8       

+394E EB          .     EX    DE,HL      

+394F CD 70 38    .p8   CALL  3870       

+3952 38 11       8.    JR    C,3965     

+3954 D5          .     PUSH  DE         

+3955 55          U     LD    D,L        

+3956 1E 00       ..    LD    E,00       

+3958 21 02 01    !..   LD    HL,0102    

+395B CD 2C 66    .,f   CALL  662C       

+395E 0F          .     RRCA             

+395F 67          g     LD    H,A        

+3960 29          )     ADD   HL,HL      

+3961 D1          .     POP   DE         

+3962 73          s     LD    (HL),E     ; type im ds ersetzen

+3963 2C          ,     INC   L          

+3964 72          r     LD    (HL),D     

+3965 C3 A7 2A    ..*   JP    2AA7       ;------------- gettype ------------

+3968 CD A8 2C    ..,   CALL  2CA8       

+396B CD 70 38    .p8   CALL  3870       

+396E 38 06       8.    JR    C,3976     

+3970 CD 8D 38    ..8   CALL  388D       

+3973 5E          ^     LD    E,(HL)     

+3974 2C          ,     INC   L          

+3975 56          V     LD    D,(HL)     

+3976 C3 03 2D    ..-   JP    2D03       ;------------ heapsize ------------

+3979 CD A8 2C    ..,   CALL  2CA8       

+397C CD 70 38    .p8   CALL  3870       

+397F 38 F5       8.    JR    C,3976     

+3981 CD 8D 38    ..8   CALL  388D       

+3984 2E 00       ..    LD    L,00       

+3986 7E          ~     LD    A,(HL)     

+3987 E6 0F       ..    AND   0F         

+3989 2C          ,     INC   L          

+398A 5E          ^     LD    E,(HL)     

+398B 0F          .     RRCA             

+398C CB 1B       ..    RR    E          

+398E 0F          .     RRCA             

+398F CB 1B       ..    RR    E          

+3991 E6 03       ..    AND   03         

+3993 57          W     LD    D,A        

+3994 C3 03 2D    ..-   JP    2D03       ;------------ pages task ----------

+3997 CD 13 43    ..C   CALL  4313       

+399A 5E          ^     LD    E,(HL)     

+399B CD 13 43    ..C   CALL  4313       

+399E 56          V     LD    D,(HL)     

+399F CD 7D 6A    .}j   CALL  6A7D       

+39A2 C3 03 2D    ..-   JP    2D03       ;---- Parameter fuer blockin/out---

+39A5 CD 13 43    ..C   CALL  4313       ; DSnr

+39A8 CD 11 36    ..6   CALL  3611

+39AB CD A8 2C    ..,   CALL  2CA8       ; page --> HL

+39AE 5C          \     LD    E,H        

+39AF 65          e     LD    H,L        

+39B0 2E 00       ..    LD    L,00       

+39B2 C9          .     RET              ;----------------- blockout -------

+39B3 CD A5 39    ..9   CALL  39A5       

+39B6 CD 5C 65    .\e   CALL  655C       

+39B9 67          g     LD    H,A        

+39BA EB          .     EX    DE,HL      

+39BB CD A8 2C    ..,   CALL  2CA8       ; code1 --> HL

+39BE E5          .     PUSH  HL         

+39BF CD A8 2C    ..,   CALL  2CA8       ; code2 --> HL

+39C2 E5          .     PUSH  HL

+39C3 CD 64 43    .dC   CALL  4364       ; result addr

+39C6 ED 43 D0 41 .C.A  LD    (41D0),BC  

+39CA C1          .     POP   BC         

+39CB E3          .     EX    (SP),HL    

+39CC DD 7E 26    .~&   LD    A,(IX+26)  

+39CF B7          .     OR    A          

+39D0 28 05       (.    JR    Z,39D7     ; Kanal > 0 sein

+39D2 CD 2A 26    .*&   CALL  262A       

+39D5 18 03       ..    JR    39DA       

+39D7 01 FF FF    ...   LD    BC,FFFF    ; Nicht fuer HG

+39DA E1          .     POP   HL         ; result liefern

+39DB 71          q     LD    (HL),C     

+39DC 2C          ,     INC   L          

+39DD 70          p     LD    (HL),B     

+39DE ED 4B D0 41 .K.A  LD    BC,(41D0)  

+39E2 C3 A7 2A    ..*   JP    2AA7       ;------------ blockin -------------

+39E5 CD A5 39    ..9   CALL  39A5       

+39E8 CD 2C 66    .,f   CALL  662C       

+39EB 67          g     LD    H,A        

+39EC EB          .     EX    DE,HL      

+39ED CD A8 2C    ..,   CALL  2CA8       

+39F0 E5          .     PUSH  HL         

+39F1 CD A8 2C    ..,   CALL  2CA8       

+39F4 E5          .     PUSH  HL         

+39F5 CD 64 43    .dC   CALL  4364       

+39F8 ED 43 D0 41 .C.A  LD    (41D0),BC  

+39FC C1          .     POP   BC         

+39FD E3          .     EX    (SP),HL    

+39FE DD 7E 26    .~&   LD    A,(IX+26)  

+3A01 B7          .     OR    A          

+3A02 28 D3       (.    JR    Z,39D7     

+3A04 CD 56 25    .V%   CALL  2556       

+3A07 18 D1       ..    JR    39DA       ;------------ control -------------

+3A09 CD A8 2C    ..,   CALL  2CA8       ; funktion

+3A0C EB          .     EX    DE,HL      

+3A0D CD A8 2C    ..,   CALL  2CA8       ; code1

+3A10 E5          .     PUSH  HL         

+3A11 CD A8 2C    ..,   CALL  2CA8       ; code2

+3A14 E5          .     PUSH  HL         

+3A15 CD 64 43    .dC   CALL  4364       ; result

+3A18 ED 43 D0 41 .C.A  LD    (41D0),BC  ; DE = Funktion

+3A1C C1          .     POP   BC         ; BC = Code 2

+3A1D E3          .     EX    (SP),HL    ; HL = Code 1

+3A1E 7B          {     LD    A,E        ; funktion=10 (calendar)

+3A1F D6 0A       ..    SUB   A,0A       

+3A21 B2          .     OR    D          

+3A22 28 0B       (.    JR    Z,3A2F     

+3A24 DD 7E 26    .~&   LD    A,(IX+26)  

+3A27 B7          .     OR    A          

+3A28 28 AD       (.    JR    Z,39D7     

+3A2A CD 56 24    .V$   CALL  2456       ; IOCONTROL

+3A2D 18 AB       ..    JR    39DA       ; result in BC uebertragen

+3A2F 3A 6B 28    :k(   LD    A,(286B)   ; control (10,..)

+3A32 FE 08       ..    CP    08         ; shard >= 8?

+3A34 30 F4       0.    JR    NC,3A2A    ; nein: 

+3A36 01 FF FF    ...   LD    BC,FFFF    ; result -1

+3A39 18 9F       ..    JR    39DA       ;-------------- nextdspage --------

+3A3B CD 13 43    ..C   CALL  4313       ; dsnr holen

+3A3E CD 11 36    ..6   CALL  3611       ; test, gueltigen ds

+3A41 CD A8 2C    ..,   CALL  2CA8       ; page holen

+3A44 CD 5B 6A    .[j   CALL  6A5B       ; nextdspage

+3A47 EB          .     EX    DE,HL      

+3A48 C3 03 2D    ..-   JP    2D03       ; nextpage auf stack

+3A4B CB 7E       .~    BIT   7,(HL)     

+3A4D 28 04       (.    JR    Z,3A53     

+3A4F CB BE       ..    RES   7,(HL)     

+3A51 B7          .     OR    A          

+3A52 C9          .     RET              

+3A53 1C          .     INC   E          

+3A54 2D          -     DEC   L          

+3A55 34          4     INC   (HL)       

+3A56 20 03        .    JR    NZ,3A5B    

+3A58 2C          ,     INC   L          

+3A59 34          4     INC   (HL)       

+3A5A 2D          -     DEC   L          

+3A5B 2C          ,     INC   L          

+3A5C CB FE       ..    SET   7,(HL)     

+3A5E 37          7     SCF              

+3A5F C9          .     RET              

+3A60 CB BC       ..    RES   7,H        

+3A62 5C          \     LD    E,H        

+3A63 16 1D       ..    LD    D,1D       

+3A65 1A          .     LD    A,(DE)     

+3A66 67          g     LD    H,A        

+3A67 29          )     ADD   HL,HL      

+3A68 D8          .     RET   C          

+3A69 C3 F9 42    ..B   JP    42F9       

+3A6C CB BC       ..    RES   7,H        

+3A6E 5C          \     LD    E,H        

+3A6F 16 1D       ..    LD    D,1D       

+3A71 1A          .     LD    A,(DE)     

+3A72 67          g     LD    H,A        

+3A73 29          )     ADD   HL,HL      

+3A74 B7          .     OR    A          

+3A75 C0          .     RET   NZ         

+3A76 C3 E1 42    ..B   JP    42E1       ;---------------- ECWR ------------

+3A79 CD 64 43    .dC   CALL  4364       

+3A7C E5          .     PUSH  HL         

+3A7D CD 64 43    .dC   CALL  4364       

+3A80 5E          ^     LD    E,(HL)     

+3A81 2C          ,     INC   L          

+3A82 56          V     LD    D,(HL)     

+3A83 E5          .     PUSH  HL         

+3A84 EB          .     EX    DE,HL      

+3A85 CD 60 3A    .`:   CALL  3A60       

+3A88 EB          .     EX    DE,HL      

+3A89 CD 13 43    ..C   CALL  4313       

+3A8C 7E          ~     LD    A,(HL)     

+3A8D E1          .     POP   HL         

+3A8E CD 4B 3A    .K:   CALL  3A4B       

+3A91 12          .     LD    (DE),A     

+3A92 38 04       8.    JR    C,3A98     

+3A94 EB          .     EX    DE,HL      

+3A95 2C          ,     INC   L          

+3A96 36 00       6.    LD    (HL),00    

+3A98 E1          .     POP   HL         

+3A99 5E          ^     LD    E,(HL)     

+3A9A 2C          ,     INC   L          

+3A9B 56          V     LD    D,(HL)     

+3A9C EB          .     EX    DE,HL      

+3A9D 29          )     ADD   HL,HL      

+3A9E CB 54       .T    BIT   2,H        

+3AA0 CB 94       ..    RES   2,H        

+3AA2 28 01       (.    JR    Z,3AA5     

+3AA4 2C          ,     INC   L          

+3AA5 85          .     ADD   L          

+3AA6 6F          o     LD    L,A        

+3AA7 30 01       0.    JR    NC,3AAA    

+3AA9 24          $     INC   H          

+3AAA CB 94       ..    RES   2,H        

+3AAC EB          .     EX    DE,HL      

+3AAD 72          r     LD    (HL),D     

+3AAE 2D          -     DEC   L          

+3AAF 73          s     LD    (HL),E     

+3AB0 C3 A7 2A    ..*   JP    2AA7       ;--------------- CWR -------------

+3AB3 CD 64 43    .dC   CALL  4364       

+3AB6 E5          .     PUSH  HL         

+3AB7 CD 13 43    ..C   CALL  4313       

+3ABA 5E          ^     LD    E,(HL)     

+3ABB D5          .     PUSH  DE         

+3ABC CD A8 2C    ..,   CALL  2CA8       

+3ABF CD 60 3A    .`:   CALL  3A60       

+3AC2 D1          .     POP   DE         

+3AC3 73          s     LD    (HL),E     

+3AC4 E1          .     POP   HL         

+3AC5 2C          ,     INC   L          

+3AC6 CD 4B 3A    .K:   CALL  3A4B       

+3AC9 CB BE       ..    RES   7,(HL)     

+3ACB C3 A7 2A    ..*   JP    2AA7       ;----------- CRD ------------------

+3ACE CD A8 2C    ..,   CALL  2CA8       

+3AD1 CD 6C 3A    .l:   CALL  3A6C       

+3AD4 5E          ^     LD    E,(HL)     

+3AD5 16 00       ..    LD    D,00       

+3AD7 C3 03 2D    ..-   JP    2D03       ;------------- BCRD ---------------

+3ADA CD 64 43    .dC   CALL  4364       

+3ADD E5          .     PUSH  HL         

+3ADE CD 64 43    .dC   CALL  4364       

+3AE1 5E          ^     LD    E,(HL)     

+3AE2 2C          ,     INC   L          

+3AE3 56          V     LD    D,(HL)     

+3AE4 E5          .     PUSH  HL         

+3AE5 EB          .     EX    DE,HL      

+3AE6 CD 6C 3A    .l:   CALL  3A6C       

+3AE9 EB          .     EX    DE,HL      

+3AEA E1          .     POP   HL         

+3AEB CD 4B 3A    .K:   CALL  3A4B       

+3AEE E1          .     POP   HL         

+3AEF 1A          .     LD    A,(DE)     

+3AF0 77          w     LD    (HL),A     

+3AF1 2C          ,     INC   L          

+3AF2 36 00       6.    LD    (HL),00    

+3AF4 C3 A7 2A    ..*   JP    2AA7       ;-------------- cdbint -----------

+3AF7 CD A8 2C    ..,   CALL  2CA8       ; address holen

+3AFA 3E 05       >.    LD    A,05       ; Segment 5

+3AFC FD 21 85 46 .!.F  LD    IY,4685    

+3B00 FD 36 00 01 .6..  LD    (IY+00),01 ; 1 Wort

+3B04 FD 36 03 04 .6..  LD    (IY+03),04 ; DS 4

+3B08 CD CA 44    ..D   CALL  44CA       

+3B0B C3 00 2D    ..-   JP    2D00       ;-------------- cdbtext -----------

+3B0E CD A8 2C    ..,   CALL  2CA8       ; Textaddress holen

+3B11 2B          +     DEC   HL         

+3B12 11 05 04    ...   LD    DE,0405    ; DS 4, Segment 5

+3B15 CD 95 46    ..F   CALL  4695       

+3B18 C3 D0 30    ..0   JP    30D0       ;--------------- CTT --------------

+3B1B CD A8 2C    ..,   CALL  2CA8       ; Textaddr holen

+3B1E 2B          +     DEC   HL         

+3B1F 11 04 00    ...   LD    DE,0004    ; REF-Adr : DS 4, HL

+3B22 D5          .     PUSH  DE         

+3B23 C3 34 36    .46   JP    3634       ;-------------- GETC --------------

+3B26 CD 8D 46    ..F   CALL  468D       

+3B29 E5          .     PUSH  HL         

+3B2A CD 64 43    .dC   CALL  4364       

+3B2D 7B          {     LD    A,E        

+3B2E 5E          ^     LD    E,(HL)     

+3B2F 93          .     SUB   E          

+3B30 2C          ,     INC   L          

+3B31 7A          z     LD    A,D        

+3B32 56          V     LD    D,(HL)     

+3B33 9A          .     SBC   D          

+3B34 38 18       8.    JR    C,3B4E     

+3B36 E3          .     EX    (SP),HL    

+3B37 1B          .     DEC   DE         

+3B38 CD 0D 45    ..E   CALL  450D       

+3B3B 5E          ^     LD    E,(HL)     

+3B3C CD 64 43    .dC   CALL  4364       

+3B3F 73          s     LD    (HL),E     

+3B40 2C          ,     INC   L          

+3B41 36 00       6.    LD    (HL),00    

+3B43 E1          .     POP   HL         

+3B44 2D          -     DEC   L          

+3B45 34          4     INC   (HL)       

+3B46 C2 71 2E    .q.   JP    NZ,2E71    

+3B49 2C          ,     INC   L          

+3B4A 34          4     INC   (HL)       

+3B4B C3 71 2E    .q.   JP    2E71       

+3B4E CD 43 44    .CD   CALL  4443       

+3B51 C3 84 2E    ...   JP    2E84       ;------------ FNONBL --------------

+3B54 CD 64 43    .dC   CALL  4364       

+3B57 E5          .     PUSH  HL         

+3B58 CD 8D 46    ..F   CALL  468D       

+3B5B E5          .     PUSH  HL         

+3B5C D5          .     PUSH  DE         

+3B5D CD 64 43    .dC   CALL  4364       

+3B60 22 CC 41    ".A   LD    (41CC),HL  

+3B63 ED 43 D0 41 .C.A  LD    (41D0),BC  

+3B67 C1          .     POP   BC         

+3B68 5E          ^     LD    E,(HL)     

+3B69 2C          ,     INC   L          

+3B6A 56          V     LD    D,(HL)     

+3B6B E1          .     POP   HL         

+3B6C CD 1D 46    ..F   CALL  461D       

+3B6F CD 44 45    .DE   CALL  4544       

+3B72 28 2B       (+    JR    Z,3B9F     

+3B74 F5          .     PUSH  AF         

+3B75 3E 20       >     LD    A,20       

+3B77 ED A1       ..    CPI              

+3B79 20 0B        .    JR    NZ,3B86    

+3B7B EA 77 3B    .w;   JP    PE,3B77    

+3B7E F1          .     POP   AF         

+3B7F 30 1E       0.    JR    NC,3B9F    

+3B81 CD C1 45    ..E   CALL  45C1       

+3B84 18 E9       ..    JR    3B6F       

+3B86 F1          .     POP   AF         

+3B87 2B          +     DEC   HL         

+3B88 7E          ~     LD    A,(HL)     

+3B89 CD 33 46    .3F   CALL  4633       

+3B8C 13          .     INC   DE         

+3B8D 2A CC 41    *.A   LD    HL,(41CC)  

+3B90 73          s     LD    (HL),E     

+3B91 2C          ,     INC   L          

+3B92 72          r     LD    (HL),D     

+3B93 E1          .     POP   HL         

+3B94 77          w     LD    (HL),A     

+3B95 2C          ,     INC   L          

+3B96 36 00       6.    LD    (HL),00    

+3B98 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3B9C C3 71 2E    .q.   JP    2E71       

+3B9F E1          .     POP   HL         

+3BA0 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3BA4 C3 84 2E    ...   JP    2E84       ;-------------- DREM256 ----------- 

+3BA7 CD 64 43    .dC   CALL  4364       

+3BAA EB          .     EX    DE,HL      

+3BAB CD 64 43    .dC   CALL  4364       

+3BAE 1A          .     LD    A,(DE)     

+3BAF 77          w     LD    (HL),A     

+3BB0 97          .     SUB   A          

+3BB1 2C          ,     INC   L          

+3BB2 77          w     LD    (HL),A     

+3BB3 EB          .     EX    DE,HL      

+3BB4 2C          ,     INC   L          

+3BB5 5E          ^     LD    E,(HL)     

+3BB6 77          w     LD    (HL),A     

+3BB7 2D          -     DEC   L          

+3BB8 73          s     LD    (HL),E     

+3BB9 C3 A7 2A    ..*   JP    2AA7       ;------------- AMUL256 ------------

+3BBC CD 64 43    .dC   CALL  4364       

+3BBF EB          .     EX    DE,HL      

+3BC0 CD 13 43    ..C   CALL  4313       

+3BC3 7E          ~     LD    A,(HL)     

+3BC4 EB          .     EX    DE,HL      

+3BC5 5E          ^     LD    E,(HL)     

+3BC6 77          w     LD    (HL),A     

+3BC7 2C          ,     INC   L          

+3BC8 73          s     LD    (HL),E     

+3BC9 C3 A7 2A    ..*   JP    2AA7       ;------------ ISLD ----------------

+3BCC CD 13 43    ..C   CALL  4313       

+3BCF 7E          ~     LD    A,(HL)     

+3BD0 FE 7B       .{    CP    7B         

+3BD2 D2 84 2E    ...   JP    NC,2E84    

+3BD5 FE 61       .a    CP    61         

+3BD7 D2 71 2E    .q.   JP    NC,2E71    

+3BDA 11 3A 30    .:0   LD    DE,303A    

+3BDD 18 07       ..    JR    3BE6       ;------------- ISDIG ---------------

+3BDF 11 3A 30    .:0   LD    DE,303A    

+3BE2 CD 13 43    ..C   CALL  4313       

+3BE5 7E          ~     LD    A,(HL)     

+3BE6 BB          .     CP    E          

+3BE7 D2 84 2E    ...   JP    NC,2E84    

+3BEA BA          .     CP    D          

+3BEB D2 71 2E    .q.   JP    NC,2E71    

+3BEE C3 84 2E    ...   JP    2E84       ;-------------- ISLCAS ------------

+3BF4 18 EC       ..    JR    3BE2       ;-------------- ISUCAS ----------- 

+3BF6 11 5B 41    .[A   LD    DE,415B    

+3BF9 18 E7       ..    JR    3BE2       ;--------------- GADDR ------------

+3BFB CD A8 2C    ..,   CALL  2CA8       

+3BFE EB          .     EX    DE,HL      

+3BFF CD A8 2C    ..,   CALL  2CA8       

+3C02 CB 7C       .|    BIT   7,H        

+3C04 28 0A       (.    JR    Z,3C10     

+3C06 29          )     ADD   HL,HL      

+3C07 CB 7C       .|    BIT   7,H        

+3C09 28 01       (.    JR    Z,3C0C     

+3C0B 2C          ,     INC   L          

+3C0C CB FC       ..    SET   7,H        

+3C0E 18 03       ..    JR    3C13       

+3C10 B7          .     OR    A          

+3C11 ED 52       .R    SBC   HL,DE      

+3C13 EB          .     EX    DE,HL      

+3C14 C3 03 2D    ..-   JP    2D03       ;------------- GCADDR -------------

+3C17 CD A8 2C    ..,   CALL  2CA8       

+3C1A EB          .     EX    DE,HL      

+3C1B CD 13 43    ..C   CALL  4313       

+3C1E 2C          ,     INC   L          

+3C1F 7A          z     LD    A,D        

+3C20 96          .     SUB   (HL)       

+3C21 30 02       0.    JR    NC,3C25    

+3C23 C6 10       ..    ADD   A,10       

+3C25 0F          .     RRCA             

+3C26 57          W     LD    D,A        

+3C27 CD 64 43    .dC   CALL  4364       

+3C2A 73          s     LD    (HL),E     

+3C2B 2C          ,     INC   L          

+3C2C 72          r     LD    (HL),D     

+3C2D 7A          z     LD    A,D        

+3C2E E6 78       .x    AND   78         

+3C30 CA 71 2E    .q.   JP    Z,2E71     

+3C33 C3 84 2E    ...   JP    2E84       ;------------ ISSHA ---------------

+3C36 CD A8 2C    ..,   CALL  2CA8       

+3C39 7C          |     LD    A,H        

+3C3A E6 7C       .|    AND   7C         

+3C3C CA 71 2E    .q.   JP    Z,2E71     

+3C3F C3 84 2E    ...   JP    2E84       ;-------------- GETTAB ------------

+3C42 11 00 04    ...   LD    DE,0400    

+3C45 21 00 05    !..   LD    HL,0500    ; von Segment 5 nach segment 4 

+3C48 3E 80       >.    LD    A,80       

+3C4A C5          .     PUSH  BC         

+3C4B 47          G     LD    B,A        

+3C4C 0E 04       ..    LD    C,04       

+3C4E CD B6 69    ..i   CALL  69B6       

+3C51 CD 16 42    ..B   CALL  4216       

+3C54 C1          .     POP   BC         

+3C55 C3 A7 2A    ..*   JP    2AA7       ;-------------- PUTTAB ------------

+3C58 11 00 05    ...   LD    DE,0500    ; von segment 4 nach segment 5

+3C5B 21 00 04    !..   LD    HL,0400    

+3C5E 3E 80       >.    LD    A,80       

+3C60 18 E8       ..    JR    3C4A       ;------------- ERATAB -------------

+3C62 11 00 04    ...   LD    DE,0400    ; Segment 4 loeschen (6 ist leer)

+3C65 21 00 06    !..   LD    HL,0600    

+3C68 E5          .     PUSH  HL         

+3C69 C5          .     PUSH  BC         

+3C6A 06 FE       ..    LD    B,FE       

+3C6C 0E 04       ..    LD    C,04       

+3C6E CD B6 69    ..i   CALL  69B6       

+3C71 C1          .     POP   BC         

+3C72 E1          .     POP   HL         

+3C73 11 00 07    ...   LD    DE,0700    ; neuerdings auch Segment 7

+3C76 3E FE       >.    LD    A,FE       ; loeschen

+3C78 18 D0       ..    JR    3C4A       ;------------ storage ------------

+3C7A C5          .     PUSH  BC         

+3C7B CD CC 56    ..V   CALL  56CC       ; storage berechnen

+3C7E 59          Y     LD    E,C        

+3C7F 50          P     LD    D,B        

+3C80 C1          .     POP   BC         

+3C81 EB          .     EX    DE,HL      

+3C82 E5          .     PUSH  HL         

+3C83 CD 64 43    .dC   CALL  4364       ; size-addresse holen

+3C86 73          s     LD    (HL),E     

+3C87 2C          ,     INC   L          

+3C88 72          r     LD    (HL),D     

+3C89 D1          .     POP   DE         ; used-auf stack

+3C8A C3 03 2D    ..-   JP    2D03       ;------------- sysop -------------

+3C8D DD 7E 1D    .~.   LD    A,(IX+1D)  ; privilegierte operation

+3C90 FE 01       ..    CP    01         

+3C92 DA E6 3C    ..<   JP    C,3CE6     

+3C95 CD A8 2C    ..,   CALL  2CA8       ; nr holen

+3C98 3E 0C       >.    LD    A,0C       

+3C9A BD          .     CP    L          

+3C9B 20 01        .    JR    NZ,3C9E    ; savesystem ?

+3C9D 2D          -     DEC   L          ; aus 12 wird 11

+3C9E 3A 17 82    :..   LD    A,(8217)   ; Musta

+3CA1 B7          .     OR    A          

+3CA2 C2 26 29    .&)   JP    NZ,2926    ; Warten, bis Musta frei

+3CA5 DD CB 07 5E ...^  BIT   3,(IX+07)  ; restart

+3CA9 20 1B        .    JR    NZ,3CC6    

+3CAB DD CB 07 DE ....  SET   3,(IX+07)  

+3CAF 7D          }     LD    A,L        

+3CB0 32 17 82    2..   LD    (8217),A   

+3CB3 21 60 EA    !`.   LD    HL,EA60    ; 6000.0 s = 100 Minuten

+3CB6 22 B6 4C    ".L   LD    (4CB6),HL  

+3CB9 FE 04       ..    CP    04         ; < shutup ?

+3CBB DA 26 29    .&)   JP    C,2926     

+3CBE CD 02 2A    ..*   CALL  2A02       

+3CC1 CD E2 6D    ..m   CALL  6DE2       ; Endlos warte

+3CC4 18 FB       ..    JR    3CC1       

+3CC6 DD CB 07 9E ....  RES   3,(IX+07)  

+3CCA C3 A7 2A    ..*   JP    2AA7       ;-------------- DIV by 0 ---------

+3CCD 3E 05       >.    LD    A,05       

+3CCF 18 37       .7    JR    3D08       ;---------- Stackoverflow ---------

+3CD1 DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop

+3CD5 3E 02       >.    LD    A,02       ; errorstop

+3CD7 18 39       .9    JR    3D12       ;

+3CD9 3E 09       >.    LD    A,09       ;---------- Subscript overflow ----

+3CDB CB 7C       .|    BIT   7,H        

+3CDD 28 02       (.    JR    Z,3CE1     

+3CDF 3E 0A       >.    LD    A,0A       ;---------- Subscript underflow ----

+3CE1 21 00 00    !..   LD    HL,0000    

+3CE4 18 27       .'    JR    3D0D       ;----- error: privilegierte op --

+3CE6 DD 7E 30    .~0   LD    A,(IX+30)  ; Taskindex = Supervisor ?

+3CE9 FE 01       ..    CP    01         

+3CEB 20 07        .    JR    NZ,3CF4    

+3CED DD 36 1D 02 .6..  LD    (IX+1D),02 ; privileged 2, offener wartezustand

+3CF1 C3 26 29    .&)   JP    2926       ;--------- Codefehler --------------

+3CF4 DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop 

+3CF8 3E 11       >.    LD    A,11       

+3CFA 18 16       ..    JR    3D12       ; errorstop ("Codefehler")

+3CFC 30 03       0.    JR    NC,3D01    ; ------ INT overflow, wenn arith15

+3CFE 21 FF FF    !..   LD    HL,FFFF    

+3D01 DD CB 0B 66 ...f  BIT   4,(IX+0B)  

+3D05 C0          .     RET   NZ         

+3D06 3E 04       >.    LD    A,04       

+3D08 11 01 00    ...   LD    DE,0001    

+3D0B 62          b     LD    H,D        

+3D0C 6A          j     LD    L,D        

+3D0D DD CB 0B 7E ...~  BIT   7,(IX+0B)  ; nur wenn nicht schon iserror

+3D11 C0          .     RET   NZ         

+3D12 DD 36 25 00 .6%.  LD    (IX+25),00 ;--------- errorstop

+3D16 DD 77 24    .w$   LD    (IX+24),A  ; errorno

+3D19 DD 7E 20    .~    LD    A,(IX+20)  ; errline := lineno

+3D1C DD 77 22    .w"   LD    (IX+22),A  

+3D1F DD 7E 21    .~!   LD    A,(IX+21)  

+3D22 DD 77 23    .w#   LD    (IX+23),A  

+3D25 DD CB 0B FE ....  SET   7,(IX+0B)  ; iserror

+3D29 DD CB 0B 76 ...v  BIT   6,(IX+0B)  

+3D2D C0          .     RET   NZ         

+3D2E CD E8 45    ..E   CALL  45E8       ; Return, wenn enablestop

+3D31 DD CB 07 9E ....  RES   3,(IX+07)  

+3D35 31 13 6D    1.m   LD    SP,6D13    

+3D38 DD CB 0B 76 ...v  BIT   6,(IX+0B)  ;-------------- TERM --------------

+3D3C 20 09        .    JR    NZ,3D47    ; bis zum disablestop PROC zurueck

+3D3E DD 36 06 1C .6..  LD    (IX+06),1C ; Status LEAVE PROC

+3D42 CD 35 30    .50   CALL  3035       ; EXEC LEAVE

+3D45 18 F1       ..    JR    3D38       ; Weiter LEAVEn

+3D47 DD 36 06 00 .6..  LD    (IX+06),00 ; Status Busy

+3D4B C3 A7 2A    ..*   JP    2AA7       ;----------- enablestop ---------

+3D4E DD CB 0B B6 ....  RES   6,(IX+0B)  

+3D52 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D56 20 E0        .    JR    NZ,3D38    ; LEAVE PROC, if enablesto and iserr

+3D58 C3 A7 2A    ..*   JP    2AA7       ;------------ disablestop --------

+3D5B DD CB 0B F6 ....  SET   6,(IX+0B)  

+3D5F C3 A7 2A    ..*   JP    2AA7       ;----------- seterrorstop ---------

+3D62 CD A8 2C    ..,   CALL  2CA8       

+3D65 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D69 C2 A7 2A    ..*   JP    NZ,2AA7    

+3D6C DD 74 25    .t%   LD    (IX+25),H  ; errorcode high

+3D6F 7D          }     LD    A,L        

+3D70 CD 16 3D    ..=   CALL  3D16       ; errorstop

+3D73 C3 A7 2A    ..*   JP    2AA7       ;------------- iserror ------------

+3D76 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D7A CA 84 2E    ...   JP    Z,2E84     

+3D7D C3 71 2E    .q.   JP    2E71       ;------------ clearerror ----------

+3D80 DD CB 0B 76 ...v  BIT   6,(IX+0B)  

+3D84 CA A7 2A    ..*   JP    Z,2AA7     ; war kein Fehler

+3D87 C5          .     PUSH  BC         

+3D88 0E 05       ..    LD    C,05       

+3D8A CD 97 69    ..i   CALL  6997       

+3D8D 3A 1A 6E    :.n   LD    A,(6E1A)   ; Aktueller Taskindex

+3D90 47          G     LD    B,A        

+3D91 0E 00       ..    LD    C,00       

+3D93 57          W     LD    D,A        

+3D94 CD E8 68    ..h   CALL  68E8       

+3D97 C1          .     POP   BC         

+3D98 DD CB 0B BE ....  RES   7,(IX+0B)  

+3D9C C3 A7 2A    ..*   JP    2AA7       ;-------- readpcb myself ----------

+3D9F CD A5 3D    ..=   CALL  3DA5       ; 

+3DA2 C3 00 2D    ..-   JP    2D00       ; Wert auf Stack

+3DA5 CD 13 43    ..C   CALL  4313       ; Zwei Addressen holen

+3DA8 7E          ~     LD    A,(HL)     

+3DA9 2A 1C 6E    *.n   LD    HL,(6E1C)  ; Leitblock aktueller

+3DAC 87          .     ADD   A          

+3DAD C6 1E       ..    ADD   A,1E       ; pcb--> pcf konvertieren

+3DAF E6 3F       .?    AND   3F         

+3DB1 6F          o     LD    L,A        

+3DB2 C9          .     RET              ;----- test ob, supervisorson ----

+3DB3 DD 7E 1D    .~.   LD    A,(IX+1D)  ; priv Feld

+3DB6 FE 01       ..    CP    01         ; >= 1 : darf

+3DB8 30 08       0.    JR    NC,3DC2    

+3DBA DD 7E 1D    .~.   LD    A,(IX+1D)  ;------ test, ob supervisor -------

+3DBD FE 02       ..    CP    02         

+3DBF DA E6 3C    ..<   JP    C,3CE6     ; < 2 : darf nicht

+3DC2 CD 07 44    ..D   CALL  4407       ; leitblock einer task laden-------

+3DC5 FD 2A 1C 6E .*.n  LD    IY,(6E1C)  

+3DC9 1A          .     LD    A,(DE)     

+3DCA 3D          =     DEC   A          

+3DCB FE 7F       ..    CP    7F         ; Taskindex >= 128 ?

+3DCD D0          .     RET   NC         

+3DCE 1C          .     INC   E          

+3DCF 1A          .     LD    A,(DE)     

+3DD0 1D          .     DEC   E          

+3DD1 DD BE 31    ..1   CP    (IX+31)    ; Stationsnummer (myself)

+3DD4 20 07        .    JR    NZ,3DDD    

+3DD6 1A          .     LD    A,(DE)     

+3DD7 CD 4D 6D    .Mm   CALL  6D4D       

+3DDA 1A          .     LD    A,(DE)     

+3DDB 37          7     SCF              

+3DDC C9          .     RET              

+3DDD B7          .     OR    A          

+3DDE C9          .     RET              ;------------ pcb-feld lesen -----

+3DDF CD C2 3D    ..=   CALL  3DC2       ; 

+3DE2 CD 13 43    ..C   CALL  4313       

+3DE5 7E          ~     LD    A,(HL)     ; pcb-nummer

+3DE6 FD E5       ..    PUSH  IY         

+3DE8 E1          .     POP   HL         

+3DE9 18 C1       ..    JR    3DAC       ;------------- readpcb task -------

+3DEB CD DF 3D    ..=   CALL  3DDF       ; Readpcb und Wert auf Stack

+3DEE C3 00 2D    ..-   JP    2D00       ;------------- writepcb task ------

+3DF1 CD DF 3D    ..=   CALL  3DDF       ; Readpcb 

+3DF4 FD 7E 30    .~0   LD    A,(IY+30)  ; Eigener Taskindex = pcb-Taskindex

+3DF7 DD BE 30    ..0   CP    (IX+30)    

+3DFA 20 05        .    JR    NZ,3E01    ; Nein, kann nur Supervisor

+3DFC 7D          }     LD    A,L        ; linenumber field

+3DFD FE 20       .     CP    20         ; pcf=32 kann beschrieben werden

+3DFF 28 12       (.    JR    Z,3E13     ; von jeder task

+3E01 DD 7E 1D    .~.   LD    A,(IX+1D)  

+3E04 FE 02       ..    CP    02         

+3E06 30 0B       0.    JR    NC,3E13    ; priv >= 2 darf alle beschreiben

+3E08 FE 01       ..    CP    01         

+3E0A DA E6 3C    ..<   JP    C,3CE6     ; priv < 1 darf nur linenumber

+3E0D 7D          }     LD    A,L        

+3E0E FE 2A       .*    CP    2A         ; priv = 1 darf nur prio beschreiben

+3E10 C2 E6 3C    ..<   JP    NZ,3CE6    

+3E13 EB          .     EX    DE,HL      ; writepcb durchfuehren

+3E14 CD A8 2C    ..,   CALL  2CA8       ; value holen

+3E17 EB          .     EX    DE,HL      

+3E18 73          s     LD    (HL),E     ; leitblock veraendern

+3E19 2C          ,     INC   L          

+3E1A 72          r     LD    (HL),D     

+3E1B C3 A7 2A    ..*   JP    2AA7       ;-------------- status ------------

+3E1E CD C2 3D    ..=   CALL  3DC2       ; leitblock von task holen

+3E21 FD 7E 06    .~.   LD    A,(IY+06)  ; status feld

+3E24 07          .     RLCA             

+3E25 07          .     RLCA             

+3E26 E6 0F       ..    AND   0F         

+3E28 5F          _     LD    E,A        

+3E29 16 00       ..    LD    D,00       

+3E2B C3 03 2D    ..-   JP    2D03       ;--------------- unblock ----------

+3E2E CD B3 3D    ..=   CALL  3DB3       ; nur von supervisorsoehnen

+3E31 DC 68 6D    .hm   CALL  C,6D68     

+3E34 FD CB 06 4E ...N  BIT   1,(IY+06)

+3E38 20 04        .    JR    NZ,3E3E    

+3E3A FD CB 06 86 ....  RES   0,(IY+06)  

+3E3E C3 A7 2A    ..*   JP    2AA7       ;--------------- block ------------

+3E41 CD B3 3D    ..=   CALL  3DB3       ; nur von supervisorsoehnen

+3E44 30 F8       0.    JR    NC,3E3E    

+3E46 FD CB 06 C6 ....  SET   0,(IY+06)  

+3E4A CD 74 6D    .tm   CALL  6D74       

+3E4D 18 EF       ..    JR    3E3E       ;----------- nextactive ----------

+3E4F CD 64 43    .dC   CALL  4364       ; task holen

+3E52 7E          ~     LD    A,(HL)     

+3E53 CD 7E 6D    .~m   CALL  6D7E       

+3E56 F5          .     PUSH  AF         

+3E57 CD 4D 6D    .Mm   CALL  6D4D       

+3E5A F1          .     POP   AF         

+3E5B 77          w     LD    (HL),A     

+3E5C 2C          ,     INC   L          

+3E5D FD 7E 31    .~1   LD    A,(IY+31)  ; taskindex holen

+3E60 77          w     LD    (HL),A     

+3E61 18 DB       ..    JR    3E3E       ;------------ halt process --------

+3E63 CD BA 3D    ..=   CALL  3DBA       ; nur vom supervisor

+3E66 FD CB 05 C6 ....  SET   0,(IY+05)  

+3E6A 18 D2       ..    JR    3E3E       ;------------- create process -----

+3E6C DD 7E 30    .~0   LD    A,(IX+30)  ; myself index

+3E6F 32 13 42    2.B   LD    (4213),A   

+3E72 2A CA 41    *.A   LD    HL,(41CA)  ; heaptop

+3E75 22 14 42    ".B   LD    (4214),HL  

+3E78 CD BA 3D    ..=   CALL  3DBA       ; supervisor ?

+3E7B D2 4C 3F    .L?   JP    NC,3F4C    ; nicht moeglich

+3E7E E5          .     PUSH  HL         ; unprivilegiertes createprocess

+3E7F D5          .     PUSH  DE         

+3E80 FD 36 00 00 .6..  LD    (IY+00),00 ; wstate 

+3E84 FD 36 1D FF .6..  LD    (IY+1D),FF ; priv

+3E88 CD B8 43    ..C   CALL  43B8       ; procadresse holen

+3E8B FD 75 09    .u.   LD    (IY+09),L  ; icount uebertragen

+3E8E FD 74 0A    .t.   LD    (IY+0A),H  

+3E91 FD 73 0B    .s.   LD    (IY+0B),E  

+3E94 7C          |     LD    A,H        

+3E95 C6 10       ..    ADD   A,10       

+3E97 FD 77 0F    .w.   LD    (IY+0F),A  ; c8k, und allgemeiner create proc.

+3E9A C3 D9 3E    ..>   JP    3ED9       ;------- create privileged process-

+3E9D CD 13 43    ..C   CALL  4313       

+3EA0 7E          ~     LD    A,(HL)     

+3EA1 E6 7F       ..    AND   7F         

+3EA3 32 13 42    2.B   LD    (4213),A   

+3EA6 CD 4D 6D    .Mm   CALL  6D4D       

+3EA9 FD 6E 16    .n.   LD    L,(IY+16)  ; hptop

+3EAC FD 66 17    .f.   LD    H,(IY+17)  

+3EAF 22 14 42    ".B   LD    (4214),HL  

+3EB2 CD BA 3D    ..=   CALL  3DBA       ; supervisor ?

+3EB5 D2 49 3F    .I?   JP    NC,3F49    ; nicht moeglich

+3EB8 E5          .     PUSH  HL         

+3EB9 D5          .     PUSH  DE         

+3EBA FD 36 01 00 .6..  LD    (IY+01),00 ; wstate

+3EBE CD A8 2C    ..,   CALL  2CA8       ; priv parameter

+3EC1 FD 75 1D    .u.   LD    (IY+1D),L  

+3EC4 CD 07 44    ..D   CALL  4407       ; PROCAddresse holen --> DE, HL

+3EC7 1A          .     LD    A,(DE)     

+3EC8 FD 77 09    .w.   LD    (IY+09),A  ; icount

+3ECB 1C          .     INC   E          

+3ECC 1A          .     LD    A,(DE)     

+3ECD FD 77 0A    .w.   LD    (IY+0A),A  

+3ED0 C6 10       ..    ADD   A,10       

+3ED2 FD 77 0F    .w.   LD    (IY+0F),A  ; c8k

+3ED5 7E          ~     LD    A,(HL)     ; segment

+3ED6 FD 77 0B    .w.   LD    (IY+0B),A  

+3ED9 ED 43 D0 41 .C.A  LD    (41D0),BC  ;-allgemeimer Teil von createproc.

+3EDD FD E5       ..    PUSH  IY         ; IY = Leitblockaddresse des 

+3EDF D1          .     POP   DE         ; neuen Prozesses

+3EE0 1E 30       .0    LD    E,30       ; 

+3EE2 E1          .     POP   HL         ; taskindex setzen

+3EE3 ED A0       ..    LDI              

+3EE5 ED A0       ..    LDI              

+3EE7 E1          .     POP   HL         ; version

+3EE8 ED A0       ..    LDI              

+3EEA ED A0       ..    LDI              

+3EEC 1E 38       .8    LD    E,38       ; clock

+3EEE 06 08       ..    LD    B,08       

+3EF0 97          .     SUB   A          ; auf 0.0 setzen

+3EF1 12          .     LD    (DE),A     

+3EF2 1C          .     INC   E          

+3EF3 10 FC       ..    DJNZ  3EF1       

+3EF5 FD 77 2A    .w*   LD    (IY+2A),A  ; prio auf 0

+3EF8 FD 77 2B    .w+   LD    (IY+2B),A  

+3EFB 3A 13 42    :.B   LD    A,(4213)   

+3EFE 47          G     LD    B,A        

+3EFF 0E 04       ..    LD    C,04       

+3F01 FD 56 30    .V0   LD    D,(IY+30)  ; myself index

+3F04 DD CB 07 5E ...^  BIT   3,(IX+07)  ; war restart ?

+3F08 CC E8 68    ..h   CALL  Z,68E8     ; 

+3F0B DD CB 07 DE ....  SET   3,(IX+07)  ; kein restart mehr

+3F0F 0E 00       ..    LD    C,00       

+3F11 CD E8 68    ..h   CALL  68E8       

+3F14 DD CB 07 9E ....  RES   3,(IX+07) ; restart

+3F18 2A 14 42    *.B   LD    HL,(4214) ; heaptop uebertragen

+3F1B FD 75 16    .u.   LD    (IY+16),L  

+3F1E FD 74 17    .t.   LD    (IY+17),H  

+3F21 97          .     SUB   A          

+3F22 FD 77 26    .w&   LD    (IY+26),A  ; channel 0 (break)

+3F25 FD 77 27    .w'   LD    (IY+27),A  

+3F28 FD 77 04    .w.   LD    (IY+04),A  ; millis, comflg

+3F2B FD 77 05    .w.   LD    (IY+05),A  

+3F2E FD 77 07    .w.   LD    (IY+07),A  ; restart war

+3F31 FD 77 14    .w.   LD    (IY+14),A  ls_top

+3F34 FD 77 15    .w.   LD    (IY+15),A  

+3F37 FD 36 06 18 .6..  LD    (IY+06),18

+3F3B 7A          z     LD    A,D        

+3F3C CD 68 6D    .hm   CALL  6D68       

+3F3F ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3F43 CD 16 42    ..B   CALL  4216       

+3F46 C3 A7 2A    ..*   JP    2AA7       

+3F49 CD 13 43    ..C   CALL  4313       ;---------- kein createprocess ---

+3F4C CD 13 43    ..C   CALL  4313       

+3F4F C3 A7 2A    ..*   JP    2AA7       ;--------- erase process ----------

+3F52 CD BA 3D    ..=   CALL  3DBA       

+3F55 DC 8B 68    ..h   CALL  C,688B     

+3F58 C3 A7 2A    ..*   JP    2AA7       ;------------ existstask ----------

+3F5B CD C2 3D    ..=   CALL  3DC2       ; leitblock holen

+3F5E D2 84 2E    ...   JP    NC,2E84    ; NC = FALSE

+3F61 FD E5       ..    PUSH  IY         

+3F63 D1          .     POP   DE         

+3F64 1E 32       .2    LD    E,32       ; version vergleichen

+3F66 C3 67 2E    .g.   JP    2E67       ;------------ send ----------------

+3F69 11 0B 42    ..B   LD    DE,420B    

+3F6C DD E5       ..    PUSH  IX         

+3F6E E1          .     POP   HL         

+3F6F 2E 30       .0    LD    L,30       ; myself index

+3F71 CD 72 40    .r@   CALL  4072       

+3F74 97          .     SUB   A          ; msgds := nilspace

+3F75 DD 77 2E    .w.   LD    (IX+2E),A  

+3F78 DD 77 2F    .w/   LD    (IX+2F),A  

+3F7B CD C2 3D    ..=   CALL  3DC2       ; Leitblock der anderen task holen

+3F7E F5          .     PUSH  AF         

+3F7F C5          .     PUSH  BC         

+3F80 D5          .     PUSH  DE         

+3F81 E5          .     PUSH  HL         

+3F82 01 0F 42    ..B   LD    BC,420F    

+3F85 CD 7A 40    .z@   CALL  407A       

+3F88 E1          .     POP   HL         

+3F89 D1          .     POP   DE         

+3F8A C1          .     POP   BC         

+3F8B F1          .     POP   AF         

+3F8C 38 1E       8.    JR    C,3FAC     

+3F8E 1A          .     LD    A,(DE)     

+3F8F FE 02       ..    CP    02         

+3F91 DA 3D 40    .=@   JP    C,403D     

+3F94 1C          .     INC   E          

+3F95 1A          .     LD    A,(DE)     

+3F96 DD BE 31    ..1   CP    (IX+31)    ; station

+3F99 CA 3D 40    .=@   JP    Z,403D     ; gleiche 

+3F9C 3A 07 42    :.B   LD    A,(4207)   

+3F9F 3D          =     DEC   A          

+3FA0 FE 7E       .~    CP    7E         

+3FA2 D2 3D 40    .=@   JP    NC,403D    

+3FA5 3C          <     INC   A          

+3FA6 CD 4D 6D    .Mm   CALL  6D4D       

+3FA9 21 09 42    !.B   LD    HL,4209    

+3FAC FD E5       ..    PUSH  IY         

+3FAE D1          .     POP   DE         

+3FAF 1E 32       .2    LD    E,32       

+3FB1 CD 6A 40    .j@   CALL  406A       

+3FB4 C2 3D 40    .=@   JP    NZ,403D    

+3FB7 FD 7E 06    .~.   LD    A,(IY+06)

+3FBA CB 87       ..    RES   0,A        

+3FBC FE BC       ..    CP    BC         

+3FBE C2 41 40    .A@   JP    NZ,4041    

+3FC1 1E 34       .4    LD    E,34       ; fromid

+3FC3 1A          .     LD    A,(DE)     

+3FC4 B7          .     OR    A          

+3FC5 28 09       (.    JR    Z,3FD0     

+3FC7 21 0B 42    !.B   LD    HL,420B    

+3FCA CD 66 40    .f@   CALL  4066       

+3FCD C2 41 40    .A@   JP    NZ,4041    

+3FD0 CD A8 2C    ..,   CALL  2CA8       

+3FD3 E5          .     PUSH  HL         

+3FD4 CD 64 43    .dC   CALL  4364       

+3FD7 5E          ^     LD    E,(HL)     

+3FD8 2C          ,     INC   L          

+3FD9 56          V     LD    D,(HL)     

+3FDA EB          .     EX    DE,HL      

+3FDB CD 70 38    .p8   CALL  3870       

+3FDE DA 61 40    .a@   JP    C,4061     

+3FE1 E5          .     PUSH  HL         

+3FE2 CD 64 43    .dC   CALL  4364       

+3FE5 97          .     SUB   A          

+3FE6 77          w     LD    (HL),A     

+3FE7 2C          ,     INC   L          

+3FE8 77          w     LD    (HL),A     

+3FE9 E1          .     POP   HL         

+3FEA EB          .     EX    DE,HL      

+3FEB C5          .     PUSH  BC         

+3FEC DD 46 30    .F0   LD    B,(IX+30)  

+3FEF 4B          K     LD    C,E        

+3FF0 FD 56 30    .V0   LD    D,(IY+30)  

+3FF3 CD E5 68    ..h   CALL  68E5       

+3FF6 C1          .     POP   BC         

+3FF7 36 FF       6.    LD    (HL),FF    

+3FF9 FD 73 2E    .s.   LD    (IY+2E),E  

+3FFC FD 7E 30    .~0   LD    A,(IY+30)  

+3FFF FD 77 2F    .w/   LD    (IY+2F),A  

+4002 21 0F 42    !.B   LD    HL,420F    

+4005 DD E5       ..    PUSH  IX         

+4007 D1          .     POP   DE         

+4008 1E 34       .4    LD    E,34       

+400A CD 72 40    .r@   CALL  4072       

+400D 21 0B 42    !.B   LD    HL,420B    

+4010 FD E5       ..    PUSH  IY         

+4012 D1          .     POP   DE         

+4013 1E 34       .4    LD    E,34       

+4015 CD 72 40    .r@   CALL  4072       

+4018 FD CB 0B 7E ...~  BIT   7,(IY+0B)  

+401C 20 08        .    JR    NZ,4026    

+401E 21 0F 42    !.B   LD    HL,420F    

+4021 1E 22       ."    LD    E,22       

+4023 CD 72 40    .r@   CALL  4072       

+4026 EB          .     EX    DE,HL      

+4027 D1          .     POP   DE         

+4028 2E 2C       .,    LD    L,2C       

+402A 73          s     LD    (HL),E     

+402B 2C          ,     INC   L          

+402C 72          r     LD    (HL),D     

+402D 2E 06       ..    LD    L,06       

+402F 36 00       6.    LD    (HL),00    

+4031 2E 07       ..    LD    L,07       

+4033 CB DE       ..    SET   3,(HL)     ; kein restart

+4035 2E 30       .0    LD    L,30       

+4037 7E          ~     LD    A,(HL)     

+4038 CD 68 6D    .hm   CALL  6D68       

+403B 97          .     SUB   A          

+403C C9          .     RET              

+403D 1E FF       ..    LD    E,FF       

+403F 18 11       ..    JR    4052       

+4041 3A 10 42    :.B   LD    A,(4210)   

+4044 DD BE 31    ..1   CP    (IX+31)    

+4047 28 07       (.    JR    Z,4050     

+4049 3A 07 42    :.B   LD    A,(4207)   

+404C B7          .     OR    A          

+404D C2 26 29    .&)   JP    NZ,2926    

+4050 1E FE       ..    LD    E,FE       

+4052 CD 13 43    ..C   CALL  4313       

+4055 CD 13 43    ..C   CALL  4313       

+4058 CD 64 43    .dC   CALL  4364       

+405B 7B          {     LD    A,E        

+405C 77          w     LD    (HL),A     

+405D 2C          ,     INC   L          

+405E 36 FF       6.    LD    (HL),FF    

+4060 C9          .     RET              

+4061 E1          .     POP   HL         

+4062 1E FD       ..    LD    E,FD       

+4064 18 F2       ..    JR    4058       

+4066 CD 6A 40    .j@   CALL  406A       

+4069 C0          .     RET   NZ         

+406A 1A          .     LD    A,(DE)     

+406B BE          .     CP    (HL)       

+406C C0          .     RET   NZ         

+406D 23          #     INC   HL         

+406E 13          .     INC   DE         

+406F 1A          .     LD    A,(DE)     

+4070 BE          .     CP    (HL)       

+4071 C9          .     RET              

+4072 C5          .     PUSH  BC         

+4073 01 04 00    ...   LD    BC,0004    

+4076 ED B0       ..    LDIR             

+4078 C1          .     POP   BC         

+4079 C9          .     RET              

+407A 1A          .     LD    A,(DE)     

+407B 02          .     LD    (BC),A     

+407C 1C          .     INC   E          

+407D 03          .     INC   BC         

+407E 1A          .     LD    A,(DE)     

+407F 02          .     LD    (BC),A     

+4080 03          .     INC   BC         

+4081 7E          ~     LD    A,(HL)     

+4082 02          .     LD    (BC),A     

+4083 2C          ,     INC   L          

+4084 03          .     INC   BC         

+4085 7E          ~     LD    A,(HL)     

+4086 02          .     LD    (BC),A     

+4087 C9          .     RET              

+4088 CD 64 43    .dC   CALL  4364       

+408B 3A 1D 6E    :.n   LD    A,(6E1D)   

+408E 57          W     LD    D,A        

+408F 1A          .     LD    A,(DE)     

+4090 77          w     LD    (HL),A     

+4091 2C          ,     INC   L          

+4092 1C          .     INC   E          

+4093 1A          .     LD    A,(DE)     

+4094 77          w     LD    (HL),A     

+4095 C9          .     RET              ;----------- sendfromto -----------

+4096 DD 7E 1D    .~.   LD    A,(IX+1D)  

+4099 FE 01       ..    CP    01         

+409B DA E6 3C    ..<   JP    C,3CE6     ; nur supervisorsoehne

+409E CD 07 44    ..D   CALL  4407       

+40A1 1C          .     INC   E          

+40A2 1A          .     LD    A,(DE)     

+40A3 1D          .     DEC   E          

+40A4 DD BE 31    ..1   CP    (IX+31)    

+40A7 28 0E       (.    JR    Z,40B7     

+40A9 C5          .     PUSH  BC         

+40AA 01 0B 42    ..B   LD    BC,420B    ; andere station

+40AD CD 7A 40    .z@   CALL  407A       

+40B0 C1          .     POP   BC         

+40B1 CD 74 3F    .t?   CALL  3F74       

+40B4 C3 A7 2A    ..*   JP    2AA7       ;------------- send ---------------

+40B7 CD 69 3F    .i?   CALL  3F69       

+40BA C3 A7 2A    ..*   JP    2AA7       ;------------ wait ----------------

+40BD DD CB 07 5E ...^  BIT   3,(IX+07)  

+40C1 20 1E        .    JR    NZ,40E1    

+40C3 CD 29 4C    .)L   CALL  4C29       

+40C6 97          .     SUB   A          

+40C7 DD 77 34    .w4   LD    (IX+34),A  

+40CA DD 77 35    .w5   LD    (IX+35),A  

+40CD DD 77 36    .w6   LD    (IX+36),A  

+40D0 DD 77 37    .w7   LD    (IX+37),A  

+40D3 DD 36 06 BC .6..  LD    (IX+06),BC ; wait zustand

+40D7 3A 1A 6E    :.n   LD    A,(6E1A)   

+40DA 3D          =     DEC   A          

+40DB CC 38 4C    .8L   CALL  Z,4C38     

+40DE C3 26 29    .&)   JP    2926       

+40E1 1E 2E       ..    LD    E,2E       

+40E3 CD 88 40    ..@   CALL  4088       

+40E6 1E 2C       .,    LD    E,2C       ; 4 Bytes auf Stack

+40E8 CD 88 40    ..@   CALL  4088       

+40EB 1E 34       .4    LD    E,34       ; 4 Bytes auf stack

+40ED D5          .     PUSH  DE         

+40EE CD 39 44    .9D   CALL  4439       

+40F1 E3          .     EX    (SP),HL    

+40F2 C5          .     PUSH  BC         

+40F3 ED A0       ..    LDI              

+40F5 ED A0       ..    LDI              

+40F7 C1          .     POP   BC         

+40F8 D1          .     POP   DE         

+40F9 C5          .     PUSH  BC         

+40FA ED A0       ..    LDI              

+40FC ED A0       ..    LDI              

+40FE C1          .     POP   BC         

+40FF DD CB 07 9E ....  RES   3,(IX+07)  ; restart

+4103 C3 A7 2A    ..*   JP    2AA7       ;--------------- call -------------

+4106 DD CB 07 5E ...^  BIT   3,(IX+07)  

+410A 20 2E        .    JR    NZ,413A    

+410C CD 69 3F    .i?   CALL  3F69       

+410F B7          .     OR    A          

+4110 28 14       (.    JR    Z,4126      

+4112 FE FE       ..    CP    FE         

+4114 C2 A7 2A    ..*   JP    NZ,2AA7    

+4117 FD E5       ..    PUSH  IY         

+4119 E1          .     POP   HL         

+411A DD E5       ..    PUSH  IX         

+411C D1          .     POP   DE         

+411D B7          .     OR    A          

+411E ED 52       .R    SBC   HL,DE      

+4120 CA A7 2A    ..*   JP    Z,2AA7     

+4123 C3 26 29    .&)   JP    2926       

+4126 3E BC       >.    LD    A,BC       ; wait

+4128 C3 23 29    .#)   JP    2923       ;-------------- pingpong ----------

+412B DD CB 07 5E ...^  BIT   3,(IX+07)  

+412F 20 09        .    JR    NZ,413A    

+4131 CD 69 3F    .i?   CALL  3F69       

+4134 B7          .     OR    A          

+4135 28 EF       (.    JR    Z,4126     

+4137 C3 A7 2A    ..*   JP    2AA7       

+413A CD 43 44    .CD   CALL  4443       

+413D CD 43 44    .CD   CALL  4443       

+4140 1E 2E       ..    LD    E,2E       

+4142 CD 88 40    ..@   CALL  4088       

+4145 1E 2C       .,    LD    E,2C       

+4147 CD 88 40    ..@   CALL  4088       

+414A DD CB 07 9E ....  RES   3,(IX+07)  

+414E C3 A7 2A    ..*   JP    2AA7       ;--------- define collector -------

+4151 DD 7E 1D    .~.   LD    A,(IX+1D)  ; nur von supervisorsoehnen

+4154 FE 01       ..    CP    01         

+4156 DA E6 3C    ..<   JP    C,3CE6     

+4159 CD 07 44    ..D   CALL  4407       

+415C C5          .     PUSH  BC         

+415D 01 07 42    ..B   LD    BC,4207    

+4160 CD 7A 40    .z@   CALL  407A       

+4163 C1          .     POP   BC         

+4164 C3 A7 2A    ..*   JP    2AA7       ;------------- session ------------

+4167 ED 5B 17 6B .[.k  LD    DE,(6B17)  

+416B C3 03 2D    ..-   JP    2D03       ;----------------- id -------------

+416E CD 13 43    ..C   CALL  4313       

+4171 7E          ~     LD    A,(HL)     

+4172 E6 07       ..    AND   07         

+4174 21 8F 82    !..   LD    HL,828F    

+4177 5F          _     LD    E,A        

+4178 D6 04       ..    SUB   A,04       

+417A 38 04       8.    JR    C,4180     

+417C 21 6F 28    !o(   LD    HL,286F    

+417F 5F          _     LD    E,A        

+4180 16 00       ..    LD    D,00       

+4182 19          .     ADD   HL,DE      

+4183 19          .     ADD   HL,DE      

+4184 C3 00 2D    ..-   JP    2D00       ;- infopassword ("alt","neu",ok)

+4187 11 F3 41    ..A   LD    DE,41F3

+418A CD A9 41    ..A   CALL  41A9       ; Wort --> 41F3 holen

+418D 11 FD 41    ..A   LD    DE,41FD    

+4190 CD A9 41    ..A   CALL  41A9       ; Wort --> 41FD holen

+4193 CD 64 43    .dC   CALL  4364       ; REF-addr holen

+4196 C5          .     PUSH  BC         

+4197 E5          .     PUSH  HL         

+4198 21 F3 41    !.A   LD    HL,41F3    

+419B 11 FD 41    ..A   LD    DE,41FD    

+419E CD 10 6F    ..o   CALL  6F10       ; 10 bytes invertieren und kopieren

+41A1 E1          .     POP   HL         

+41A2 71          q     LD    (HL),C     ; enthaelt 0, wenn ok

+41A3 2C          ,     INC   L          

+41A4 70          p     LD    (HL),B     

+41A5 C1          .     POP   BC         

+41A6 C3 A7 2A    ..*   JP    2AA7       

+41A9 D5          .     PUSH  DE         

+41AA CD 8D 46    ..F   CALL  468D       ; Word --> HL holen

+41AD D1          .     POP   DE         

+41AE C5          .     PUSH  BC         

+41AF 06 0A       ..    LD    B,0A       ; 10 mal

+41B1 7E          ~     LD    A,(HL)     

+41B2 12          .     LD    (DE),A     

+41B3 13          .     INC   DE         

+41B4 D5          .     PUSH  DE         

+41B5 11 01 00    ...   LD    DE,0001    

+41B8 CD 0D 45    ..E   CALL  450D       ; HL INCR 1

+41BB D1          .     POP   DE         

+41BC 10 F3       ..    DJNZ  41B1       

+41BE C1          .     POP   BC         

+41BF C9          .     RET              ;========= EXTERNALS ENDE ========

+41C0 20 52        R    JR    NZ,4214    ; " REG"

+41C2 45          E     LD    B,L        

+41C3 47          G     LD    B,A        

+41C4 00          .     NOP              

+41C5 00          .     NOP              

+41C6 00          .     NOP              

+41C7 00          .     NOP              

+41C8 00          .     NOP              

+41C9 00          .     NOP              

+41CA 00          .     NOP              

+41CB 00          .     NOP              

+41CC 00          .     NOP              

+41CD 00          .     NOP              

+41CE 00          .     NOP              

+41CF 00          .     NOP              

+41D0 00          .     NOP              

+41D1 00          .     NOP              

+41D2 00          .     NOP              

+41D3 00          .     NOP              

+41D4 00          .     NOP              

+41D5 00          .     NOP              

+41D6 00          .     NOP              

+41D7 00          .     NOP              

+41D8 00          .     NOP              

+41D9 00          .     NOP              

+41DA 00          .     NOP              

+41DB 00          .     NOP              

+41DC 00          .     NOP              

+41DD 01 00 00    ...   LD    BC,0000    

+41E0 00          .     NOP              

+41E1 00          .     NOP              

+41E2 00          .     NOP              

+41E3 00          .     NOP              

+41E4 00          .     NOP              

+41E5 00          .     NOP              

+41E6 00          .     NOP              

+41E7 02          .     LD    (BC),A     

+41E8 20 20             JR    NZ,420A    

+41EA 20 20             JR    NZ,420C    

+41EC 20 08        .    JR    NZ,41F6    

+41EE 08          .     EX    AF,AF'     

+41EF 08          .     EX    AF,AF'     

+41F0 08          .     EX    AF,AF'     

+41F1 08          .     EX    AF,AF'     

+41F2 08          .     EX    AF,AF'     

+41F3 00          .     NOP              

+41F4 00          .     NOP              

+41F5 00          .     NOP              

+41F6 00          .     NOP              

+41F7 00          .     NOP              

+41F8 00          .     NOP              

+41F9 00          .     NOP              

+41FA 00          .     NOP              

+41FB 00          .     NOP              

+41FC 00          .     NOP              

+41FD 00          .     NOP              

+41FE 00          .     NOP              

+41FF 00          .     NOP              

+4200 00          .     NOP              

+4201 00          .     NOP              

+4202 00          .     NOP              

+4203 00          .     NOP              

+4204 00          .     NOP              

+4205 00          .     NOP              

+4206 00          .     NOP              

+4207 00          .     NOP              

+4208 00          .     NOP              

+4209 00          .     NOP              

+420A 00          .     NOP              

+420B 00          .     NOP              

+420C 00          .     NOP              

+420D 00          .     NOP              

+420E 00          .     NOP              

+420F 00          .     NOP              

+4210 00          .     NOP              

+4211 00          .     NOP              

+4212 00          .     NOP              

+4213 00          .     NOP              

+4214 00          .     NOP              

+4215 00          .     NOP              

+4216 97          .     SUB   A          

+4217 32 00 19    2..   LD    (1900),A   

+421A 32 00 19    2..   LD    (1900),A   

+421D 32 00 19    2..   LD    (1900),A   

+4220 32 00 19    2..   LD    (1900),A   

+4223 32 00 19    2..   LD    (1900),A   

+4226 32 00 19    2..   LD    (1900),A   

+4229 32 00 19    2..   LD    (1900),A   

+422C 32 00 19    2..   LD    (1900),A   

+422F 32 00 19    2..   LD    (1900),A   

+4232 32 00 19    2..   LD    (1900),A   

+4235 32 00 19    2..   LD    (1900),A   

+4238 32 00 19    2..   LD    (1900),A   

+423B 32 00 19    2..   LD    (1900),A   

+423E 32 00 19    2..   LD    (1900),A   

+4241 32 00 19    2..   LD    (1900),A   

+4244 32 00 19    2..   LD    (1900),A   

+4247 32 00 19    2..   LD    (1900),A   

+424A 32 00 19    2..   LD    (1900),A   

+424D 32 00 19    2..   LD    (1900),A   

+4250 32 00 19    2..   LD    (1900),A   

+4253 32 00 19    2..   LD    (1900),A   

+4256 32 00 19    2..   LD    (1900),A   

+4259 32 00 19    2..   LD    (1900),A   

+425C 32 00 19    2..   LD    (1900),A   

+425F 32 00 19    2..   LD    (1900),A   

+4262 B7          .     OR    A          

+4263 21 00 00    !..   LD    HL,0000    

+4266 22 75 46    "uF   LD    (4675),HL  

+4269 21 18 42    !.B   LD    HL,4218    

+426C 22 72 42    "rB   LD    (4272),HL  

+426F C9          .     RET              

+4270 EB          .     EX    DE,HL      

+4271 22 18 42    ".B   LD    (4218),HL  

+4274 2A 72 42    *rB   LD    HL,(4272)  

+4277 23          #     INC   HL         

+4278 23          #     INC   HL         

+4279 CB 7E       .~    BIT   7,(HL)     

+427B 23          #     INC   HL         

+427C 22 72 42    "rB   LD    (4272),HL  

+427F EB          .     EX    DE,HL      

+4280 C8          .     RET   Z          

+4281 CD 16 42    ..B   CALL  4216       

+4284 C3 26 29    .&)   JP    2926       

+4287 08          .     EX    AF,AF'     

+4288 F6 01       ..    OR    01         

+428A 08          .     EX    AF,AF'     

+428B CB 40       .@    BIT   0,B        

+428D 20 06        .    JR    NZ,4295    

+428F 04          .     INC   B          

+4290 DD CB 09 FE ....  SET   7,(IX+09)  

+4294 C9          .     RET              

+4295 F5          .     PUSH  AF         

+4296 D5          .     PUSH  DE         

+4297 E5          .     PUSH  HL         

+4298 DD CB 09 BE ....  RES   7,(IX+09)  

+429C DD 34       .4    INC   (IX+0A)    

+429E 0A          .     LD    A,(BC)     

+429F CD AB 42    ..B   CALL  42AB       

+42A2 87          .     ADD   A          

+42A3 47          G     LD    B,A        

+42A4 E1          .     POP   HL         

+42A5 D1          .     POP   DE         

+42A6 F1          .     POP   AF         

+42A7 C9          .     RET              

+42A8 97          .     SUB   A          

+42A9 18 DF       ..    JR    428A       

+42AB DD 66 0A    .f.   LD    H,(IX+0A)  

+42AE DD 7E 0B    .~.   LD    A,(IX+0B)  

+42B1 E6 03       ..    AND   03         

+42B3 5F          _     LD    E,A        

+42B4 FE 02       ..    CP    02         

+42B6 20 07        .    JR    NZ,42BF    

+42B8 CD 48 5F    .H_   CALL  5F48        ; Segment 2 ist Ausnahme

+42BB C0          .     RET   NZ         

+42BC DD 66 0A    .f.   LD    H,(IX+0A)  

+42BF 7B          {     LD    A,E        

+42C0 C6 19       ..    ADD   A,19       

+42C2 57          W     LD    D,A        

+42C3 5C          \     LD    E,H        

+42C4 1A          .     LD    A,(DE)     

+42C5 B7          .     OR    A          

+42C6 C0          .     RET   NZ         

+42C7 D5          .     PUSH  DE         

+42C8 7A          z     LD    A,D        

+42C9 CD 70 42    .pB   CALL  4270       

+42CC D6 19       ..    SUB   A,19       

+42CE 5F          _     LD    E,A        

+42CF 16 04       ..    LD    D,04       

+42D1 FE 02       ..    CP    02         

+42D3 20 05        .    JR    NZ,42DA    

+42D5 CD 55 65    .Ue   CALL  6555       

+42D8 18 03       ..    JR    42DD       

+42DA CD 5C 65    .\e   CALL  655C       

+42DD 0F          .     RRCA             

+42DE E1          .     POP   HL         

+42DF 77          w     LD    (HL),A     

+42E0 C9          .     RET              

+42E1 CB 1C       ..    RR    H          

+42E3 CB 1D       ..    RR    L          

+42E5 D5          .     PUSH  DE         

+42E6 63          c     LD    H,E        

+42E7 7A          z     LD    A,D        

+42E8 CD 70 42    .pB   CALL  4270       

+42EB D6 19       ..    SUB   A,19       

+42ED 5F          _     LD    E,A        

+42EE 16 04       ..    LD    D,04       

+42F0 CD 5C 65    .\e   CALL  655C       

+42F3 D1          .     POP   DE         

+42F4 0F          .     RRCA             

+42F5 12          .     LD    (DE),A     

+42F6 67          g     LD    H,A        

+42F7 29          )     ADD   HL,HL      

+42F8 C9          .     RET              

+42F9 CB 1C       ..    RR    H          

+42FB CB 1D       ..    RR    L          

+42FD D5          .     PUSH  DE         

+42FE 63          c     LD    H,E        

+42FF 7A          z     LD    A,D        

+4300 CD 70 42    .pB   CALL  4270       

+4303 D6 19       ..    SUB   A,19       

+4305 5F          _     LD    E,A        

+4306 16 04       ..    LD    D,04       

+4308 CD 2C 66    .,f   CALL  662C       

+430B D1          .     POP   DE         

+430C 0F          .     RRCA             

+430D 67          g     LD    H,A        

+430E F6 80       ..    OR    80         

+4310 12          .     LD    (DE),A     

+4311 29          )     ADD   HL,HL      

+4312 C9          .     RET              ;---------------------------------

+4313 0A          .     LD    A,(BC)     ; Naechstes Codewort holen --> HL

+4314 6F          o     LD    L,A        

+4315 0C          .     INC   C          

+4316 0A          .     LD    A,(BC)     

+4317 0C          .     INC   C          

+4318 CC 87 42    ..B   CALL  Z,4287     

+431B B7          .     OR    A          

+431C FA 32 43    .2C   JP    M,4332     

+431F D9          .     EXX              

+4320 81          .     ADD   C          

+4321 5F          _     LD    E,A        

+4322 1A          .     LD    A,(DE)     

+4323 D9          .     EXX              

+4324 67          g     LD    H,A        

+4325 29          )     ADD   HL,HL      

+4326 B7          .     OR    A          

+4327 C0          .     RET   NZ         

+4328 D5          .     PUSH  DE         

+4329 D9          .     EXX              

+432A D5          .     PUSH  DE         

+432B D9          .     EXX              

+432C D1          .     POP   DE         

+432D CD E1 42    ..B   CALL  42E1       

+4330 D1          .     POP   DE         

+4331 C9          .     RET              

+4332 D5          .     PUSH  DE         

+4333 ED 5B C4 41 .[.A  LD    DE,(41C4)  

+4337 E6 7F       ..    AND   7F         

+4339 1F          .     RRA              

+433A CB 1D       ..    RR    L          

+433C 67          g     LD    H,A        

+433D 38 0C       8.    JR    C,434B     

+433F 19          .     ADD   HL,DE      

+4340 5C          \     LD    E,H        

+4341 16 1A       ..    LD    D,1A       

+4343 1A          .     LD    A,(DE)     

+4344 67          g     LD    H,A        

+4345 29          )     ADD   HL,HL      

+4346 B7          .     OR    A          

+4347 28 E4       (.    JR    Z,432D     

+4349 D1          .     POP   DE         

+434A C9          .     RET              

+434B CD DE 43    ..C   CALL  43DE       

+434E 20 0C        .    JR    NZ,435C    

+4350 C6 19       ..    ADD   A,19       

+4352 57          W     LD    D,A        

+4353 5C          \     LD    E,H        

+4354 1A          .     LD    A,(DE)     

+4355 67          g     LD    H,A        

+4356 29          )     ADD   HL,HL      

+4357 B7          .     OR    A          

+4358 28 D3       (.    JR    Z,432D     

+435A D1          .     POP   DE         

+435B C9          .     RET              

+435C CD 5C 65    .\e   CALL  655C       

+435F 0F          .     RRCA             

+4360 67          g     LD    H,A        

+4361 29          )     ADD   HL,HL      

+4362 D1          .     POP   DE         

+4363 C9          .     RET              

+4364 0A          .     LD    A,(BC)     

+4365 6F          o     LD    L,A        

+4366 0C          .     INC   C          

+4367 0A          .     LD    A,(BC)     

+4368 0C          .     INC   C          

+4369 CC 87 42    ..B   CALL  Z,4287     

+436C B7          .     OR    A          

+436D FA 82 43    ..C   JP    M,4382     

+4370 D9          .     EXX              

+4371 81          .     ADD   C          

+4372 5F          _     LD    E,A        

+4373 1A          .     LD    A,(DE)     

+4374 D9          .     EXX              

+4375 67          g     LD    H,A        

+4376 29          )     ADD   HL,HL      

+4377 D8          .     RET   C          

+4378 D5          .     PUSH  DE         

+4379 D9          .     EXX              

+437A D5          .     PUSH  DE         

+437B D9          .     EXX              

+437C D1          .     POP   DE         

+437D CD F9 42    ..B   CALL  42F9       

+4380 D1          .     POP   DE         

+4381 C9          .     RET              

+4382 D5          .     PUSH  DE         

+4383 ED 5B C4 41 .[.A  LD    DE,(41C4)  

+4387 E6 7F       ..    AND   7F         

+4389 1F          .     RRA              

+438A CB 1D       ..    RR    L          

+438C 67          g     LD    H,A        

+438D 38 10       8.    JR    C,439F     

+438F 19          .     ADD   HL,DE      

+4390 5C          \     LD    E,H        

+4391 16 1A       ..    LD    D,1A       

+4393 1A          .     LD    A,(DE)     

+4394 67          g     LD    H,A        

+4395 29          )     ADD   HL,HL      

+4396 7B          {     LD    A,E        

+4397 D1          .     POP   DE         

+4398 D8          .     RET   C          

+4399 D5          .     PUSH  DE         

+439A 5F          _     LD    E,A        

+439B 16 1A       ..    LD    D,1A       

+439D 18 DE       ..    JR    437D       

+439F CD DE 43    ..C   CALL  43DE       

+43A2 20 0C        .    JR    NZ,43B0    

+43A4 C6 19       ..    ADD   A,19       

+43A6 57          W     LD    D,A        

+43A7 5C          \     LD    E,H        

+43A8 1A          .     LD    A,(DE)     

+43A9 67          g     LD    H,A        

+43AA 29          )     ADD   HL,HL      

+43AB D4 F9 42    ..B   CALL  NC,42F9    

+43AE D1          .     POP   DE         

+43AF C9          .     RET              

+43B0 CD 2C 66    .,f   CALL  662C       

+43B3 0F          .     RRCA             

+43B4 67          g     LD    H,A        

+43B5 29          )     ADD   HL,HL      

+43B6 D1          .     POP   DE         

+43B7 C9          .     RET              ;------------ REF-Addr vom Stack

+43B8 0A          .     LD    A,(BC)     ; --> HL, DE

+43B9 6F          o     LD    L,A        

+43BA 0C          .     INC   C          

+43BB 0A          .     LD    A,(BC)     

+43BC 0C          .     INC   C          

+43BD CC 87 42    ..B   CALL  Z,4287     

+43C0 B7          .     OR    A          

+43C1 FA CC 43    ..C   JP    M,43CC     

+43C4 D9          .     EXX              

+43C5 81          .     ADD   C          

+43C6 D9          .     EXX              

+43C7 67          g     LD    H,A        

+43C8 97          .     SUB   A          

+43C9 5F          _     LD    E,A        

+43CA 57          W     LD    D,A        

+43CB C9          .     RET              ;----------------------------------

+43CC ED 5B C4 41 .[.A  LD    DE,(41C4)  

+43D0 E6 7F       ..    AND   7F         

+43D2 1F          .     RRA              

+43D3 CB 1D       ..    RR    L          

+43D5 67          g     LD    H,A        

+43D6 38 06       8.    JR    C,43DE     

+43D8 19          .     ADD   HL,DE      

+43D9 97          .     SUB   A          

+43DA 11 01 00    ...   LD    DE,0001    

+43DD C9          .     RET              

+43DE 19          .     ADD   HL,DE      

+43DF 16 1A       ..    LD    D,1A       

+43E1 5C          \     LD    E,H        

+43E2 1A          .     LD    A,(DE)     

+43E3 67          g     LD    H,A        

+43E4 29          )     ADD   HL,HL      

+43E5 B7          .     OR    A          

+43E6 CC E1 42    ..B   CALL  Z,42E1     

+43E9 5E          ^     LD    E,(HL)     

+43EA 2C          ,     INC   L          

+43EB 56          V     LD    D,(HL)     

+43EC 2C          ,     INC   L          

+43ED 7E          ~     LD    A,(HL)     

+43EE 2C          ,     INC   L          

+43EF 66          f     LD    H,(HL)     

+43F0 EB          .     EX    DE,HL      

+43F1 14          .     INC   D          

+43F2 15          .     DEC   D          

+43F3 20 07        .    JR    NZ,43FC    

+43F5 FE 06       ..    CP    06         

+43F7 30 03       0.    JR    NC,43FC    

+43F9 5F          _     LD    E,A        

+43FA BF          .     CP    A          

+43FB C9          .     RET              

+43FC E6 07       ..    AND   07         

+43FE 5F          _     LD    E,A        

+43FF 7A          z     LD    A,D        

+4400 FE 04       ..    CP    04         

+4402 7B          {     LD    A,E        

+4403 D0          .     RET   NC         

+4404 16 05       ..    LD    D,05       

+4406 C9          .     RET              ;----------------------------------

+4407 0A          .     LD    A,(BC)     

+4408 6F          o     LD    L,A        

+4409 0C          .     INC   C          

+440A 0A          .     LD    A,(BC)     

+440B CD 1B 43    ..C   CALL  431B       

+440E 54          T     LD    D,H        

+440F 5D          ]     LD    E,L        

+4410 2C          ,     INC   L          

+4411 2C          ,     INC   L          

+4412 28 05       (.    JR    Z,4419     

+4414 0C          .     INC   C          

+4415 C0          .     RET   NZ         

+4416 C3 87 42    ..B   JP    4287       

+4419 0D          .     DEC   C          

+441A FD 21 85 46 .!.F  LD    IY,4685    

+441E FD CB 00 C6 ....  SET   0,(IY+00)  

+4422 CD B8 43    ..C   CALL  43B8       

+4425 7D          }     LD    A,L        

+4426 32 86 46    2.F   LD    (4686),A   

+4429 ED 53 87 46 .S.F  LD    (4687),DE  

+442D 7B          {     LD    A,E        

+442E CD CA 44    ..D   CALL  44CA       

+4431 54          T     LD    D,H        

+4432 5D          ]     LD    E,L        

+4433 2C          ,     INC   L          

+4434 2C          ,     INC   L          

+4435 CC 1B 45    ..E   CALL  Z,451B     

+4438 C9          .     RET              

+4439 FD 21 85 46 .!.F  LD    IY,4685    

+443D FD CB 00 86 ....  RES   0,(IY+00)  

+4441 18 DF       ..    JR    4422       ;-------- Branchaddresse holen -----

+4443 0A          .     LD    A,(BC)     

+4444 5F          _     LD    E,A        

+4445 0C          .     INC   C          

+4446 0A          .     LD    A,(BC)     

+4447 57          W     LD    D,A        

+4448 0C          .     INC   C          

+4449 C0          .     RET   NZ         

+444A C3 87 42    ..B   JP    4287       

+444D FE 06       ..    CP    06         

+444F 30 0C       0.    JR    NC,445D    

+4451 C6 19       ..    ADD   A,19       

+4453 57          W     LD    D,A        

+4454 5C          \     LD    E,H        

+4455 1A          .     LD    A,(DE)     

+4456 67          g     LD    H,A        

+4457 29          )     ADD   HL,HL      

+4458 B7          .     OR    A          

+4459 C0          .     RET   NZ         

+445A C3 E1 42    ..B   JP    42E1       

+445D ED 5B 75 46 .[uF  LD    DE,(4675)  

+4461 7C          |     LD    A,H        

+4462 BA          .     CP    D          

+4463 20 07        .    JR    NZ,446C    

+4465 7B          {     LD    A,E        

+4466 B7          .     OR    A          

+4467 28 03       (.    JR    Z,446C     

+4469 63          c     LD    H,E        

+446A 29          )     ADD   HL,HL      

+446B C9          .     RET              

+446C 16 04       ..    LD    D,04       

+446E 1E 07       ..    LD    E,07       

+4470 CD 5C 65    .\e   CALL  655C       

+4473 0F          .     RRCA             

+4474 5F          _     LD    E,A        

+4475 54          T     LD    D,H        

+4476 ED 53 75 46 .SuF  LD    (4675),DE  

+447A 63          c     LD    H,E        

+447B 29          )     ADD   HL,HL      

+447C C9          .     RET              

+447D FE 06       ..    CP    06         

+447F 30 0B       0.    JR    NC,448C    

+4481 C6 19       ..    ADD   A,19       

+4483 57          W     LD    D,A        

+4484 5C          \     LD    E,H        

+4485 1A          .     LD    A,(DE)     

+4486 67          g     LD    H,A        

+4487 29          )     ADD   HL,HL      

+4488 D8          .     RET   C          

+4489 C3 F9 42    ..B   JP    42F9       

+448C ED 5B 75 46 .[uF  LD    DE,(4675)  

+4490 7C          |     LD    A,H        

+4491 BA          .     CP    D          

+4492 20 07        .    JR    NZ,449B    

+4494 7B          {     LD    A,E        

+4495 87          .     ADD   A          

+4496 30 03       0.    JR    NC,449B    

+4498 63          c     LD    H,E        

+4499 29          )     ADD   HL,HL      

+449A C9          .     RET              

+449B 16 04       ..    LD    D,04       

+449D 1E 07       ..    LD    E,07       

+449F CD 2C 66    .,f   CALL  662C       

+44A2 0F          .     RRCA             

+44A3 F6 80       ..    OR    80         

+44A5 18 CD       ..    JR    4474       

+44A7 CD 13 43    ..C   CALL  4313       

+44AA 7D          }     LD    A,L        

+44AB E6 F8       ..    AND   F8         

+44AD 6F          o     LD    L,A        

+44AE C9          .     RET              

+44AF CD 1B 43    ..C   CALL  431B       

+44B2 7D          }     LD    A,L        

+44B3 E6 F8       ..    AND   F8         

+44B5 6F          o     LD    L,A        

+44B6 C9          .     RET              

+44B7 CD 64 43    .dC   CALL  4364       

+44BA 7D          }     LD    A,L        

+44BB E6 F8       ..    AND   F8         

+44BD 6F          o     LD    L,A        

+44BE C9          .     RET              

+44BF 5D          ]     LD    E,L        

+44C0 7D          }     LD    A,L        

+44C1 E6 F0       ..    AND   F0         

+44C3 6F          o     LD    L,A        

+44C4 AB          .     XOR   E          

+44C5 1F          .     RRA              

+44C6 CB 1C       ..    RR    H          

+44C8 CB 1D       ..    RR    L          

+44CA FD 74 01    .t.   LD    (IY+01),H  

+44CD FD 77 02    .w.   LD    (IY+02),A  

+44D0 5F          _     LD    E,A        

+44D1 FD 7E 03    .~.   LD    A,(IY+03)  

+44D4 B7          .     OR    A          

+44D5 20 15        .    JR    NZ,44EC    ; Fremdatenraum

+44D7 7B          {     LD    A,E        ; DS4 = 0

+44D8 C6 19       ..    ADD   A,19       

+44DA 57          W     LD    D,A        

+44DB 5C          \     LD    E,H

+44DC 1A          .     LD    A,(DE)     ; DE=1900+256*segment+AddrDIV256

+44DD 67          g     LD    H,A        

+44DE 29          )     ADD   HL,HL      ; In Byteaddresse wandeln

+44DF D8          .     RET   C          

+44E0 FD CB 00 46 ...F  BIT   0,(IY+00)  

+44E4 CA F9 42    ..B   JP    Z,42F9     

+44E7 B7          .     OR    A          

+44E8 C0          .     RET   NZ         

+44E9 C3 E1 42    ..B   JP    42E1       

+44EC 57          W     LD    D,A        

+44ED FD CB 00 46 ...F  BIT   0,(IY+00)  

+44F1 20 05        .    JR    NZ,44F8    

+44F3 CD 2C 66    .,f   CALL  662C       

+44F6 18 03       ..    JR    44FB       

+44F8 CD 5C 65    .\e   CALL  655C       

+44FB 0F          .     RRCA             

+44FC 67          g     LD    H,A        

+44FD 29          )     ADD   HL,HL      

+44FE C9          .     RET              

+44FF CB 3F       .?    SLR   A          

+4501 CB 1C       ..    RR    H          

+4503 CB 1D       ..    RR    L          

+4505 F5          .     PUSH  AF         

+4506 CD CA 44    ..D   CALL  44CA       

+4509 F1          .     POP   AF         

+450A D0          .     RET   NC         

+450B 2C          ,     INC   L          

+450C C9          .     RET              ;---------------------------------

+450D 7D          }     LD    A,L        

+450E 83          .     ADD   E          

+450F 3E 00       >.    LD    A,00       

+4511 8A          .     ADC   D          

+4512 20 02        .    JR    NZ,4516    

+4514 19          .     ADD   HL,DE      

+4515 C9          .     RET              

+4516 3D          =     DEC   A          

+4517 20 0D        .    JR    NZ,4526    

+4519 19          .     ADD   HL,DE      

+451A 25          %     DEC   H          

+451B 24          $     INC   H          

+451C CB 44       .D    BIT   0,H        

+451E C0          .     RET   NZ         

+451F 25          %     DEC   H          

+4520 D5          .     PUSH  DE         

+4521 11 00 01    ...   LD    DE,0100    

+4524 18 01       ..    JR    4527       

+4526 D5          .     PUSH  DE         

+4527 97          .     SUB   A          

+4528 CB 1C       ..    RR    H          

+452A FD 66 01    .f.   LD    H,(IY+01)  

+452D CB 14       ..    RL    H          

+452F 17          .     RLA              

+4530 19          .     ADD   HL,DE      

+4531 CE 00       ..    ADC   A,00       

+4533 1F          .     RRA              

+4534 CB 1C       ..    RR    H          

+4536 CB 1D       ..    RR    L          

+4538 F5          .     PUSH  AF         

+4539 FD 86 02    ...   ADD   (IY+02)    

+453C CD CA 44    ..D   CALL  44CA       

+453F F1          .     POP   AF         

+4540 D1          .     POP   DE         

+4541 D0          .     RET   NC         

+4542 2C          ,     INC   L          

+4543 C9          .     RET              

+4544 D5          .     PUSH  DE         

+4545 11 00 00    ...   LD    DE,0000    

+4548 CD 78 45    .xE   CALL  4578       

+454B D1          .     POP   DE         

+454C C9          .     RET              

+454D 2A 79 46    *yF   LD    HL,(4679)  

+4550 DD 75 0C    .u.   LD    (IX+0C),L  

+4553 DD 74 0D    .t.   LD    (IX+0D),H  

+4556 DD CB 07 AE ....  RES   5,(IX+07)  

+455A DD CB 07 F6 ....  SET   6,(IX+07)  

+455E C9          .     RET              

+455F 69          i     LD    L,C        

+4560 60          `     LD    H,B        

+4561 DD 4E 0C    .N.   LD    C,(IX+0C)  

+4564 DD 46 0D    .F.   LD    B,(IX+0D)  

+4567 B7          .     OR    A          

+4568 ED 42       .B    SBC   HL,BC      

+456A 22 7B 46    "{F   LD    (467B),HL  

+456D ED 43 79 46 .CyF  LD    (4679),BC  

+4571 CD C1 45    ..E   CALL  45C1       

+4574 DD CB 07 B6 ....  RES   6,(IX+07)  

+4578 22 7D 46    "}F   LD    (467D),HL  

+457B ED 53 7F 46 .S.F  LD    (467F),DE  

+457F DD CB 07 76 ...v  BIT   6,(IX+07)  

+4583 20 DA        .    JR    NZ,455F    

+4585 7B          {     LD    A,E        

+4586 BD          .     CP    L          

+4587 30 01       0.    JR    NC,458A    

+4589 7D          }     LD    A,L        

+458A ED 44       .D    NEG              

+458C 28 0F       (.    JR    Z,459D     

+458E 04          .     INC   B          

+458F 05          .     DEC   B          

+4590 20 12        .    JR    NZ,45A4    

+4592 B9          .     CP    C          

+4593 38 0F       8.    JR    C,45A4     

+4595 78          x     LD    A,B        

+4596 B1          .     OR    C          

+4597 C9          .     RET              

+4598 2A 7D 46    *}F   LD    HL,(467D)  

+459B 18 F8       ..    JR    4595       

+459D 04          .     INC   B          

+459E 05          .     DEC   B          

+459F 28 F4       (.    JR    Z,4595     

+45A1 37          7     SCF              

+45A2 18 01       ..    JR    45A5       

+45A4 B7          .     OR    A          

+45A5 69          i     LD    L,C        

+45A6 60          `     LD    H,B        

+45A7 4F          O     LD    C,A        

+45A8 3E 00       >.    LD    A,00       

+45AA 8F          .     ADC   A          

+45AB 47          G     LD    B,A        

+45AC B7          .     OR    A          

+45AD ED 42       .B    SBC   HL,BC      

+45AF 28 E7       (.    JR    Z,4598     

+45B1 DD CB 07 EE ....  SET   5,(IX+07)  

+45B5 ED 43 7B 46 .C{F  LD    (467B),BC  

+45B9 22 79 46    "yF   LD    (4679),HL  

+45BC 2A 7D 46    *}F   LD    HL,(467D)  

+45BF 37          7     SCF              

+45C0 C9          .     RET              

+45C1 2A 7F 46    *.F   LD    HL,(467F)  

+45C4 7C          |     LD    A,H        

+45C5 B5          .     OR    L          

+45C6 28 0C       (.    JR    Z,45D4     

+45C8 FD 21 89 46 .!.F  LD    IY,4689    

+45CC ED 5B 7B 46 .[{F  LD    DE,(467B)  

+45D0 CD 0D 45    ..E   CALL  450D       

+45D3 EB          .     EX    DE,HL      

+45D4 D5          .     PUSH  DE         

+45D5 2A 7D 46    *}F   LD    HL,(467D)  

+45D8 FD 21 85 46 .!.F  LD    IY,4685    

+45DC ED 5B 7B 46 .[{F  LD    DE,(467B)  

+45E0 CD 0D 45    ..E   CALL  450D       

+45E3 D1          .     POP   DE         

+45E4 ED 4B 79 46 .KyF  LD    BC,(4679)  

+45E8 DD CB 07 B6 ....  RES   6,(IX+07)  

+45EC DD CB 07 AE ....  RES   5,(IX+07)  

+45F0 C9          .     RET              

+45F1 DD CB 07 6E ...n  BIT   5,(IX+07)  

+45F5 28 0D       (.    JR    Z,4604     

+45F7 E5          .     PUSH  HL         

+45F8 2A 79 46    *yF   LD    HL,(4679)  

+45FB 22 77 46    "wF   LD    (4677),HL  

+45FE 09          .     ADD   HL,BC      

+45FF 22 79 46    "yF   LD    (4679),HL  

+4602 E1          .     POP   HL         

+4603 C9          .     RET              

+4604 3E FF       >.    LD    A,FF       

+4606 32 78 46    2xF   LD    (4678),A   

+4609 DD CB 07 EE ....  SET   5,(IX+07)  

+460D ED 43 79 46 .CyF  LD    (4679),BC  

+4611 C9          .     RET              

+4612 2A 77 46    *wF   LD    HL,(4677)  

+4615 CB 7C       .|    BIT   7,H        

+4617 20 D3        .    JR    NZ,45EC    

+4619 22 79 46    "yF   LD    (4679),HL  

+461C C9          .     RET              

+461D ED 43 81 46 .C.F  LD    (4681),BC  

+4621 1B          .     DEC   DE         

+4622 7B          {     LD    A,E        

+4623 B2          .     OR    D          

+4624 C8          .     RET   Z          

+4625 FD 21 85 46 .!.F  LD    IY,4685    

+4629 CD 0D 45    ..E   CALL  450D       

+462C 79          y     LD    A,C        

+462D 93          .     SUB   E          ; BC DECR DE

+462E 4F          O     LD    C,A        

+462F 78          x     LD    A,B        

+4630 9A          .     SBC   D          

+4631 47          G     LD    B,A        

+4632 C9          .     RET              ;-----------------------------------

+4633 2A 81 46    *.F   LD    HL,(4681)  

+4636 B7          .     OR    A          

+4637 ED 42       .B    SBC   HL,BC      

+4639 DD CB 07 6E ...n  BIT   5,(IX+07)  

+463D 28 07       (.    JR    Z,4646     

+463F ED 4B 79 46 .KyF  LD    BC,(4679)  

+4643 B7          .     OR    A          

+4644 ED 42       .B    SBC   HL,BC      

+4646 EB          .     EX    DE,HL      

+4647 18 A3       ..    JR    45EC       ; REST  Bit 5 (IX+7)

+4649 F5          .     PUSH  AF         

+464A E5          .     PUSH  HL         

+464B 3E 01       >.    LD    A,01       

+464D CD 7D 44    .}D   CALL  447D       

+4650 36 FF       6.    LD    (HL),FF    

+4652 54          T     LD    D,H        

+4653 5D          ]     LD    E,L        

+4654 13          .     INC   DE         

+4655 97          .     SUB   A          

+4656 93          .     SUB   E          

+4657 4F          O     LD    C,A        

+4658 06 00       ..    LD    B,00       

+465A CB 44       .D    BIT   0,H        

+465C 20 01        .    JR    NZ,465F    

+465E 04          .     INC   B          

+465F 78          x     LD    A,B        

+4660 B1          .     OR    C          

+4661 28 02       (.    JR    Z,4665     

+4663 ED B0       ..    LDIR             

+4665 D1          .     POP   DE         

+4666 F1          .     POP   AF         

+4667 92          .     SUB   D          

+4668 47          G     LD    B,A        

+4669 0E 04       ..    LD    C,04       

+466B 5A          Z     LD    E,D        

+466C 16 01       ..    LD    D,01       

+466E 13          .     INC   DE         

+466F 21 00 06    !..   LD    HL,0600    

+4672 C3 B6 69    ..i   JP    69B6       

+4675 00          .     NOP              

+4676 00          .     NOP              

+4677 00          .     NOP              

+4678 00          .     NOP              

+4679 00          .     NOP              

+467A 00          .     NOP              

+467B 00          .     NOP              

+467C 00          .     NOP              

+467D 00          .     NOP              

+467E 00          .     NOP              

+467F 00          .     NOP              

+4680 00          .     NOP              

+4681 00          .     NOP              

+4682 00          .     NOP              

+4683 56          V     LD    D,(HL)     ; "VR" - 8 Byte-Register

+4684 52          R     LD    D,D        

+4685 00          .     NOP              

+4686 00          .     NOP              

+4687 00          .     NOP              

+4688 00          .     NOP              

+4689 00          .     NOP              

+468A 00          .     NOP              

+468B 00          .     NOP              

+468C 00          .     NOP              

+468D CD B8 43    ..C   CALL  43B8       

+4690 18 03       ..    JR    4695       

+4692 CD C0 43    ..C   CALL  43C0       

+4695 FD 21 85 46 .!.F  LD    IY,4685    

+4699 22 85 46    ".F   LD    (4685),HL  

+469C ED 53 87 46 .S.F  LD    (4687),DE  

+46A0 FD CB 00 C6 ....  SET   0,(IY+00)  

+46A4 20 4B        K    JR    NZ,46F1    

+46A6 23          #     INC   HL         

+46A7 7B          {     LD    A,E        

+46A8 5C          \     LD    E,H        

+46A9 C6 19       ..    ADD   A,19       

+46AB 57          W     LD    D,A        

+46AC 1A          .     LD    A,(DE)     

+46AD 67          g     LD    H,A        

+46AE 29          )     ADD   HL,HL      

+46AF B7          .     OR    A          

+46B0 CC E1 42    ..B   CALL  Z,42E1     

+46B3 7E          ~     LD    A,(HL)     

+46B4 FE FF       ..    CP    FF         

+46B6 28 05       (.    JR    Z,46BD     

+46B8 2C          ,     INC   L          

+46B9 5F          _     LD    E,A        

+46BA 16 00       ..    LD    D,00       

+46BC C9          .     RET              

+46BD 2C          ,     INC   L          

+46BE 5E          ^     LD    E,(HL)     

+46BF 2C          ,     INC   L          

+46C0 56          V     LD    D,(HL)     

+46C1 CB 7A       .z    BIT   7,D        

+46C3 C2 13 4A    ..J   JP    NZ,4A13    

+46C6 CB 95       ..    RES   2,L        

+46C8 7E          ~     LD    A,(HL)     

+46C9 2C          ,     INC   L          

+46CA 66          f     LD    H,(HL)     

+46CB 6F          o     LD    L,A        

+46CC D5          .     PUSH  DE         

+46CD CD BF 44    ..D   CALL  44BF       

+46D0 D1          .     POP   DE         

+46D1 7E          ~     LD    A,(HL)     

+46D2 3C          <     INC   A          

+46D3 C2 13 4A    ..J   JP    NZ,4A13    

+46D6 7D          }     LD    A,L        

+46D7 C6 06       ..    ADD   A,06       

+46D9 6F          o     LD    L,A        

+46DA 3E FF       >.    LD    A,FF       

+46DC C9          .     RET              

+46DD CD B8 43    ..C   CALL  43B8       

+46E0 FD 21 89 46 .!.F  LD    IY,4689    

+46E4 22 89 46    ".F   LD    (4689),HL  

+46E7 ED 53 8B 46 .S.F  LD    (468B),DE  

+46EB FD CB 00 C6 ....  SET   0,(IY+00)  

+46EF 28 B5       (.    JR    Z,46A6     

+46F1 23          #     INC   HL         

+46F2 CD ED 44    ..D   CALL  44ED       

+46F5 7E          ~     LD    A,(HL)     

+46F6 FE FF       ..    CP    FF         

+46F8 20 1A        .    JR    NZ,4714    

+46FA 23          #     INC   HL         

+46FB 23          #     INC   HL         

+46FC BE          .     CP    (HL)       

+46FD 2B          +     DEC   HL         

+46FE 2B          +     DEC   HL         

+46FF 28 13       (.    JR    Z,4714     

+4701 2C          ,     INC   L          

+4702 5E          ^     LD    E,(HL)     

+4703 2C          ,     INC   L          

+4704 56          V     LD    D,(HL)     

+4705 CB 95       ..    RES   2,L        

+4707 7E          ~     LD    A,(HL)     

+4708 2C          ,     INC   L          

+4709 66          f     LD    H,(HL)     

+470A 6F          o     LD    L,A        

+470B D5          .     PUSH  DE         

+470C CD BF 44    ..D   CALL  44BF       

+470F D1          .     POP   DE         

+4710 2C          ,     INC   L          

+4711 2C          ,     INC   L          

+4712 18 C6       ..    JR    46DA       

+4714 B7          .     OR    A          

+4715 F2 B8 46    ..F   JP    P,46B8     

+4718 2D          -     DEC   L          

+4719 56          V     LD    D,(HL)     

+471A 2D          -     DEC   L          

+471B 5E          ^     LD    E,(HL)     

+471C 7B          {     LD    A,E        

+471D E6 07       ..    AND   07         

+471F C2 13 4A    ..J   JP    NZ,4A13    

+4722 EB          .     EX    DE,HL      

+4723 97          .     SUB   A          

+4724 CD FF 44    ..D   CALL  44FF       

+4727 CB D5       ..    SET   2,L        

+4729 7E          ~     LD    A,(HL)     

+472A 18 8C       ..    JR    46B8       

+472C CD 8D 46    ..F   CALL  468D       

+472F E5          .     PUSH  HL         

+4730 CD A8 2C    ..,   CALL  2CA8       

+4733 C5          .     PUSH  BC         

+4734 4D          M     LD    C,L        

+4735 44          D     LD    B,H        

+4736 18 20       .     JR    4758       

+4738 DD CB 07 5E ...^  BIT   3,(IX+07)  

+473C 20 0E        .    JR    NZ,474C    

+473E DD 75 18    .u.   LD    (IX+18),L  ; hpv1

+4741 DD 74 19    .t.   LD    (IX+19),H  

+4744 DD 71 1A    .q.   LD    (IX+1A),C  ; hpv2

+4747 DD 70 1B    .p.   LD    (IX+1B),B  

+474A 18 0C       ..    JR    4758       

+474C DD 6E 18    .n.   LD    L,(IX+18)  

+474F DD 66 19    .f.   LD    H,(IX+19)  

+4752 DD 4E 1A    .N.   LD    C,(IX+1A)  

+4755 DD 46 1B    .F.   LD    B,(IX+1B)  

+4758 2B          +     DEC   HL         

+4759 CB 7C       .|    BIT   7,H        

+475B 28 03       (.    JR    Z,4760     

+475D 21 00 00    !..   LD    HL,0000    

+4760 CB 78       .x    BIT   7,B        

+4762 20 1F        .    JR    NZ,4783    

+4764 7B          {     LD    A,E        

+4765 91          .     SUB   C          

+4766 7A          z     LD    A,D        

+4767 98          .     SBC   B          

+4768 30 02       0.    JR    NC,476C    

+476A 42          B     LD    B,D        

+476B 4B          K     LD    C,E        

+476C EB          .     EX    DE,HL      

+476D 69          i     LD    L,C        

+476E 60          `     LD    H,B        

+476F B7          .     OR    A          

+4770 ED 52       .R    SBC   HL,DE      

+4772 28 0F       (.    JR    Z,4783     

+4774 38 0D       8.    JR    C,4783     

+4776 C1          .     POP   BC         

+4777 E3          .     EX    (SP),HL    

+4778 CD 0D 45    ..E   CALL  450D       

+477B D1          .     POP   DE         

+477C 7B          {     LD    A,E        

+477D 14          .     INC   D          

+477E 15          .     DEC   D          

+477F C8          .     RET   Z          

+4780 3E FF       >.    LD    A,FF       

+4782 C9          .     RET              

+4783 C1          .     POP   BC         

+4784 E1          .     POP   HL         

+4785 97          .     SUB   A          

+4786 57          W     LD    D,A        

+4787 5F          _     LD    E,A        

+4788 C9          .     RET              

+4789 CD 8D 46    ..F   CALL  468D       

+478C E5          .     PUSH  HL         

+478D CD A8 2C    ..,   CALL  2CA8       

+4790 C5          .     PUSH  BC         

+4791 42          B     LD    B,D        

+4792 4B          K     LD    C,E        

+4793 18 A3       ..    JR    4738       

+4795 CD 8D 46    ..F   CALL  468D       

+4798 E5          .     PUSH  HL         

+4799 CD A8 2C    ..,   CALL  2CA8       

+479C 22 4A 4B    "JK   LD    (4B4A),HL  

+479F CD A8 2C    ..,   CALL  2CA8       

+47A2 C5          .     PUSH  BC         

+47A3 44          D     LD    B,H        

+47A4 4D          M     LD    C,L        

+47A5 2A 4A 4B    *JK   LD    HL,(4B4A)  

+47A8 18 8E       ..    JR    4738       

+47AA CD B8 43    ..C   CALL  43B8       

+47AD FD 21 89 46 .!.F  LD    IY,4689    

+47B1 22 89 46    ".F   LD    (4689),HL  

+47B4 ED 53 8B 46 .S.F  LD    (468B),DE  

+47B8 ED 43 D0 41 .C.A  LD    (41D0),BC  

+47BC 3E 02       >.    LD    A,02       

+47BE 32 89 46    2.F   LD    (4689),A   

+47C1 7B          {     LD    A,E        

+47C2 32 3B 4B    2;K   LD    (4B3B),A   

+47C5 B5          .     OR    L          

+47C6 32 3C 4B    2<K   LD    (4B3C),A   

+47C9 7C          |     LD    A,H        

+47CA 32 3D 4B    2=K   LD    (4B3D),A   

+47CD 32 3A 4B    2:K   LD    (4B3A),A   

+47D0 2C          ,     INC   L          

+47D1 7B          {     LD    A,E        

+47D2 CD CA 44    ..D   CALL  44CA       

+47D5 22 38 4B    "8K   LD    (4B38),HL  

+47D8 5E          ^     LD    E,(HL)     

+47D9 1C          .     INC   E          

+47DA 28 28       ((    JR    Z,4804     

+47DC 1D          .     DEC   E          

+47DD 3E 0D       >.    LD    A,0D       

+47DF BB          .     CP    E          

+47E0 30 1C       0.    JR    NC,47FE    

+47E2 FD CB 00 8E ....  RES   1,(IY+00)  

+47E6 2A 38 4B    *8K   LD    HL,(4B38)  

+47E9 36 00       6.    LD    (HL),00    

+47EB 21 00 00    !..   LD    HL,0000    

+47EE 22 3E 4B    ">K   LD    (4B3E),HL  

+47F1 2A 3A 4B    *:K   LD    HL,(4B3A)  

+47F4 22 8A 46    ".F   LD    (468A),HL  

+47F7 2A 38 4B    *8K   LD    HL,(4B38)  

+47FA 1E 00       ..    LD    E,00       

+47FC 3E 0D       >.    LD    A,0D       

+47FE 2C          ,     INC   L          

+47FF 16 00       ..    LD    D,00       

+4801 42          B     LD    B,D        

+4802 4F          O     LD    C,A        

+4803 C9          .     RET              

+4804 FD CB 00 8E ....  RES   1,(IY+00)  

+4808 2D          -     DEC   L          

+4809 56          V     LD    D,(HL)     

+480A 2D          -     DEC   L          

+480B 5E          ^     LD    E,(HL)     

+480C ED 53 3E 4B .S>K  LD    (4B3E),DE  

+4810 3A 8C 46    :.F   LD    A,(468C)   

+4813 B7          .     OR    A          

+4814 20 35        5    JR    NZ,484B    

+4816 7B          {     LD    A,E        

+4817 E6 0F       ..    AND   0F         

+4819 FE 03       ..    CP    03         

+481B 20 CE        .    JR    NZ,47EB    

+481D EB          .     EX    DE,HL      

+481E CD BF 44    ..D   CALL  44BF       

+4821 7E          ~     LD    A,(HL)     

+4822 2C          ,     INC   L          

+4823 A6          .     AND   (HL)       

+4824 3C          <     INC   A          

+4825 20 C4        .    JR    NZ,47EB    

+4827 2C          ,     INC   L          

+4828 3A 3C 4B    :<K   LD    A,(4B3C)   

+482B BE          .     CP    (HL)       

+482C 20 BD        .    JR    NZ,47EB    

+482E 2C          ,     INC   L          

+482F 3A 3D 4B    :=K   LD    A,(4B3D)   

+4832 BE          .     CP    (HL)       

+4833 20 B6        .    JR    NZ,47EB    

+4835 2C          ,     INC   L          

+4836 22 42 4B    "BK   LD    (4B42),HL  

+4839 4E          N     LD    C,(HL)     

+483A 2C          ,     INC   L          

+483B 46          F     LD    B,(HL)     

+483C 2C          ,     INC   L          

+483D E5          .     PUSH  HL         

+483E 2A 38 4B    *8K   LD    HL,(4B38)  

+4841 2C          ,     INC   L          

+4842 5E          ^     LD    E,(HL)     

+4843 2C          ,     INC   L          

+4844 56          V     LD    D,(HL)     

+4845 E1          .     POP   HL         

+4846 FD CB 00 D6 ....  SET   2,(IY+00)  

+484A C9          .     RET              

+484B 7B          {     LD    A,E        

+484C A2          .     AND   D          

+484D 3C          <     INC   A          

+484E CA EB 47    ..G   JP    Z,47EB     

+4851 EB          .     EX    DE,HL      

+4852 CD BF 44    ..D   CALL  44BF       

+4855 18 DF       ..    JR    4836       

+4857 D5          .     PUSH  DE         

+4858 2A 38 4B    *8K   LD    HL,(4B38)  

+485B E5          .     PUSH  HL         

+485C CD 08 48    ..H   CALL  4808       

+485F D1          .     POP   DE         

+4860 3E FF       >.    LD    A,FF       

+4862 12          .     LD    (DE),A     

+4863 FD CB 00 8E ....  RES   1,(IY+00)  

+4867 D1          .     POP   DE         

+4868 7B          {     LD    A,E        

+4869 FE 0E       ..    CP    0E         

+486B 30 0F       0.    JR    NC,487C    

+486D 14          .     INC   D          

+486E 15          .     DEC   D          

+486F 20 0B        .    JR    NZ,487C    

+4871 2A 3A 4B    *:K   LD    HL,(4B3A)  

+4874 22 8A 46    ".F   LD    (468A),HL  

+4877 2A 38 4B    *8K   LD    HL,(4B38)  

+487A 2C          ,     INC   L          

+487B C9          .     RET              

+487C 79          y     LD    A,C        

+487D 93          .     SUB   E          

+487E 78          x     LD    A,B        

+487F 9A          .     SBC   D          

+4880 D0          .     RET   NC         

+4881 FD CB 00 4E ...N  BIT   1,(IY+00)  

+4885 20 D0        .    JR    NZ,4857    

+4887 CD 3F 49    .?I   CALL  493F       

+488A FD CB 00 5E ...^  BIT   3,(IY+00)  

+488E C4 ED 49    ..I   CALL  NZ,49ED    

+4891 C9          .     RET              

+4892 14          .     INC   D          

+4893 15          .     DEC   D          

+4894 20 0B        .    JR    NZ,48A1    

+4896 3E 0D       >.    LD    A,0D       

+4898 BB          .     CP    E          

+4899 38 06       8.    JR    C,48A1     

+489B 2A 38 4B    *8K   LD    HL,(4B38)  

+489E 73          s     LD    (HL),E     

+489F 2C          ,     INC   L          

+48A0 C9          .     RET              

+48A1 E5          .     PUSH  HL         

+48A2 2A 38 4B    *8K   LD    HL,(4B38)  

+48A5 36 FF       6.    LD    (HL),FF    

+48A7 2C          ,     INC   L          

+48A8 73          s     LD    (HL),E     

+48A9 2C          ,     INC   L          

+48AA 72          r     LD    (HL),D     

+48AB E1          .     POP   HL         

+48AC C9          .     RET              

+48AD 3A 89 46    :.F   LD    A,(4689)   

+48B0 B7          .     OR    A          

+48B1 CA 13 4A    ..J   JP    Z,4A13     

+48B4 79          y     LD    A,C        

+48B5 93          .     SUB   E          

+48B6 78          x     LD    A,B        

+48B7 9A          .     SBC   D          

+48B8 D0          .     RET   NC         

+48B9 D5          .     PUSH  DE         

+48BA 2A 85 46    *.F   LD    HL,(4685)  

+48BD E5          .     PUSH  HL         

+48BE 2A 87 46    *.F   LD    HL,(4687)  

+48C1 E5          .     PUSH  HL         

+48C2 2A 89 46    *.F   LD    HL,(4689)  

+48C5 2E 01       ..    LD    L,01       

+48C7 22 85 46    ".F   LD    (4685),HL  

+48CA 2A 8B 46    *.F   LD    HL,(468B)  

+48CD 22 87 46    ".F   LD    (4687),HL  

+48D0 FD CB 00 4E ...N  BIT   1,(IY+00)  

+48D4 20 3A        :    JR    NZ,4910    

+48D6 CD 3F 49    .?I   CALL  493F       

+48D9 22 4A 4B    "JK   LD    (4B4A),HL  

+48DC FD CB 00 5E ...^  BIT   3,(IY+00)  

+48E0 28 20       (     JR    Z,4902     

+48E2 ED 4B 40 4B .K@K  LD    BC,(4B40)  

+48E6 EB          .     EX    DE,HL      

+48E7 2A 8A 46    *.F   LD    HL,(468A)  

+48EA E5          .     PUSH  HL         

+48EB 2A 42 4B    *BK   LD    HL,(4B42)  

+48EE 2C          ,     INC   L          

+48EF 2C          ,     INC   L          

+48F0 CD B0 2C    ..,   CALL  2CB0       

+48F3 E1          .     POP   HL         

+48F4 22 8A 46    ".F   LD    (468A),HL  

+48F7 FD 21 89 46 .!.F  LD    IY,4689    

+48FB FD CB 00 5E ...^  BIT   3,(IY+00)  

+48FF C4 ED 49    ..I   CALL  NZ,49ED    

+4902 E1          .     POP   HL         

+4903 22 87 46    ".F   LD    (4687),HL  

+4906 E1          .     POP   HL         

+4907 22 85 46    ".F   LD    (4685),HL  

+490A 2A 4A 4B    *JK   LD    HL,(4B4A)  

+490D D1          .     POP   DE         

+490E B7          .     OR    A          

+490F C9          .     RET              

+4910 D5          .     PUSH  DE         

+4911 2A 38 4B    *8K   LD    HL,(4B38)  

+4914 CD 08 48    ..H   CALL  4808       

+4917 D1          .     POP   DE         

+4918 79          y     LD    A,C        

+4919 93          .     SUB   E          

+491A 78          x     LD    A,B        

+491B 9A          .     SBC   D          

+491C DC 3F 49    .?I   CALL  C,493F     

+491F 22 4A 4B    "JK   LD    (4B4A),HL  

+4922 ED 4B 40 4B .K@K  LD    BC,(4B40)  

+4926 EB          .     EX    DE,HL      

+4927 2A 8A 46    *.F   LD    HL,(468A)  

+492A E5          .     PUSH  HL         

+492B 2A 38 4B    *8K   LD    HL,(4B38)  

+492E 2C          ,     INC   L          

+492F CD B0 2C    ..,   CALL  2CB0       

+4932 2A 38 4B    *8K   LD    HL,(4B38)  

+4935 7E          ~     LD    A,(HL)     

+4936 36 FF       6.    LD    (HL),FF    

+4938 2C          ,     INC   L          

+4939 77          w     LD    (HL),A     

+493A 2C          ,     INC   L          

+493B 36 00       6.    LD    (HL),00    

+493D 18 B4       ..    JR    48F3       

+493F D5          .     PUSH  DE         

+4940 21 CA 41    !.A   LD    HL,41CA    

+4943 3A 8C 46    :.F   LD    A,(468C)   

+4946 B7          .     OR    A          

+4947 28 11       (.    JR    Z,495A     

+4949 D5          .     PUSH  DE         

+494A 57          W     LD    D,A        

+494B 21 00 01    !..   LD    HL,0100    

+494E 5D          ]     LD    E,L        

+494F CD 2C 66    .,f   CALL  662C       

+4952 0F          .     RRCA             

+4953 67          g     LD    H,A        

+4954 29          )     ADD   HL,HL      

+4955 D1          .     POP   DE         

+4956 3E 02       >.    LD    A,02       

+4958 18 02       ..    JR    495C       

+495A 3E 06       >.    LD    A,06       

+495C E5          .     PUSH  HL         

+495D 32 48 4B    2HK   LD    (4B48),A   

+4960 C6 0F       ..    ADD   A,0F       

+4962 83          .     ADD   E          

+4963 30 01       0.    JR    NC,4966    

+4965 14          .     INC   D          

+4966 E6 F0       ..    AND   F0         

+4968 5F          _     LD    E,A        

+4969 2A 3E 4B    *>K   LD    HL,(4B3E)  

+496C 09          .     ADD   HL,BC      

+496D ED 4B 48 4B .KHK  LD    BC,(4B48)  

+4971 09          .     ADD   HL,BC      

+4972 C1          .     POP   BC         

+4973 0A          .     LD    A,(BC)     

+4974 BD          .     CP    L          

+4975 20 23        #    JR    NZ,499A    

+4977 03          .     INC   BC         

+4978 0A          .     LD    A,(BC)     

+4979 0B          .     DEC   BC         

+497A BC          .     CP    H          

+497B 20 1D        .    JR    NZ,499A    

+497D 2A 3E 4B    *>K   LD    HL,(4B3E)  

+4980 19          .     ADD   HL,DE      

+4981 DC D8 49    ..I   CALL  C,49D8     

+4984 7D          }     LD    A,L        

+4985 02          .     LD    (BC),A     

+4986 03          .     INC   BC         

+4987 7C          |     LD    A,H        

+4988 02          .     LD    (BC),A     

+4989 2A 48 4B    *HK   LD    HL,(4B48)  

+498C EB          .     EX    DE,HL      

+498D B7          .     OR    A          

+498E ED 52       .R    SBC   HL,DE      

+4990 EB          .     EX    DE,HL      

+4991 2A 42 4B    *BK   LD    HL,(4B42)  

+4994 73          s     LD    (HL),E     

+4995 2C          ,     INC   L          

+4996 72          r     LD    (HL),D     

+4997 2C          ,     INC   L          

+4998 D1          .     POP   DE         

+4999 C9          .     RET              

+499A ED 43 44 4B .CDK  LD    (4B44),BC  

+499E 0A          .     LD    A,(BC)     

+499F 6F          o     LD    L,A        

+49A0 03          .     INC   BC         

+49A1 0A          .     LD    A,(BC)     

+49A2 67          g     LD    H,A        

+49A3 E5          .     PUSH  HL         

+49A4 19          .     ADD   HL,DE      

+49A5 DC D8 49    ..I   CALL  C,49D8     

+49A8 22 46 4B    "FK   LD    (4B46),HL  

+49AB 2A 48 4B    *HK   LD    HL,(4B48)  

+49AE EB          .     EX    DE,HL      

+49AF B7          .     OR    A          

+49B0 ED 52       .R    SBC   HL,DE      

+49B2 E3          .     EX    (SP),HL    

+49B3 22 3E 4B    ">K   LD    (4B3E),HL  

+49B6 CD BF 44    ..D   CALL  44BF       

+49B9 D1          .     POP   DE         

+49BA 3A 8C 46    :.F   LD    A,(468C)   

+49BD B7          .     OR    A          

+49BE 20 0E        .    JR    NZ,49CE    

+49C0 36 FF       6.    LD    (HL),FF    

+49C2 2C          ,     INC   L          

+49C3 36 FF       6.    LD    (HL),FF    

+49C5 2C          ,     INC   L          

+49C6 ED 4B 3C 4B .K<K  LD    BC,(4B3C)  

+49CA 71          q     LD    (HL),C     

+49CB 2C          ,     INC   L          

+49CC 70          p     LD    (HL),B     

+49CD 2C          ,     INC   L          

+49CE 73          s     LD    (HL),E     

+49CF 2C          ,     INC   L          

+49D0 72          r     LD    (HL),D     

+49D1 2C          ,     INC   L          

+49D2 D1          .     POP   DE         

+49D3 FD CB 00 DE ....  SET   3,(IY+00)  

+49D7 C9          .     RET              

+49D8 3A 8C 46    :.F   LD    A,(468C)   

+49DB B7          .     OR    A          

+49DC CA 39 4A    .9J   JP    Z,4A39     

+49DF 2C          ,     INC   L          

+49E0 7D          }     LD    A,L        

+49E1 E6 0F       ..    AND   0F         

+49E3 C0          .     RET   NZ         

+49E4 3E 03       >.    LD    A,03       

+49E6 DD CB 0B B6 ....  RES   6,(IX+0B)  

+49EA C3 0D 3D    ..=   JP    3D0D       

+49ED E5          .     PUSH  HL         

+49EE D5          .     PUSH  DE         

+49EF 2A 44 4B    *DK   LD    HL,(4B44)  

+49F2 ED 5B 46 4B .[FK  LD    DE,(4B46)  

+49F6 73          s     LD    (HL),E     

+49F7 23          #     INC   HL         

+49F8 72          r     LD    (HL),D     

+49F9 2A 38 4B    *8K   LD    HL,(4B38)  

+49FC 2D          -     DEC   L          

+49FD 2D          -     DEC   L          

+49FE ED 5B 3E 4B .[>K  LD    DE,(4B3E)  

+4A02 73          s     LD    (HL),E     

+4A03 2C          ,     INC   L          

+4A04 72          r     LD    (HL),D     

+4A05 2C          ,     INC   L          

+4A06 36 FF       6.    LD    (HL),FF    

+4A08 2C          ,     INC   L          

+4A09 ED 5B 40 4B .[@K  LD    DE,(4B40)  

+4A0D 73          s     LD    (HL),E     

+4A0E 2C          ,     INC   L          

+4A0F 72          r     LD    (HL),D     

+4A10 D1          .     POP   DE         

+4A11 E1          .     POP   HL         

+4A12 C9          .     RET              

+4A13 3E 0E       >.    LD    A,0E       

+4A15 CD 0D 3D    ..=   CALL  3D0D       

+4A18 97          .     SUB   A          

+4A19 57          W     LD    D,A        

+4A1A 5F          _     LD    E,A        

+4A1B 37          7     SCF              

+4A1C C9          .     RET              

+4A1D 7A          z     LD    A,D        

+4A1E B7          .     OR    A          

+4A1F C0          .     RET   NZ         

+4A20 7B          {     LD    A,E        

+4A21 FE 0D       ..    CP    0D         

+4A23 C0          .     RET   NZ         

+4A24 4E          N     LD    C,(HL)     

+4A25 2C          ,     INC   L          

+4A26 46          F     LD    B,(HL)     

+4A27 2D          -     DEC   L          

+4A28 E5          .     PUSH  HL         

+4A29 2A 38 4B    *8K   LD    HL,(4B38)  

+4A2C 77          w     LD    (HL),A     

+4A2D 2C          ,     INC   L          

+4A2E 71          q     LD    (HL),C     

+4A2F 2C          ,     INC   L          

+4A30 70          p     LD    (HL),B     

+4A31 E1          .     POP   HL         

+4A32 C9          .     RET              

+4A33 DD CB 07 C6 ....  SET   0,(IX+07)  

+4A37 18 04       ..    JR    4A3D       

+4A39 DD CB 07 86 ....  RES   0,(IX+07)  

+4A3D DD 36 06 20 .6.   LD    (IX+06),20 

+4A41 2A C8 41    *.A   LD    HL,(41C8)  

+4A44 3E 7F       >.    LD    A,7F       

+4A46 CD 49 46    .IF   CALL  4649       

+4A49 21 03 00    !..   LD    HL,0003    

+4A4C 22 CA 41    ".A   LD    (41CA),HL  

+4A4F DD 75 18    .u.   LD    (IX+18),L  

+4A52 DD 74 19    .t.   LD    (IX+19),H  

+4A55 DD 36 06 24 .6.$  LD    (IX+06),24 

+4A59 DD CB 07 A6 ....  RES   4,(IX+07)  

+4A5D DD 6E 18    .n.   LD    L,(IX+18)  

+4A60 DD 66 19    .f.   LD    H,(IX+19)  

+4A63 FD 21 85 46 .!.F  LD    IY,4685    

+4A67 FD CB 00 C6 ....  SET   0,(IY+00)  

+4A6B FD 36 03 00 .6..  LD    (IY+03),00 

+4A6F CD BF 44    ..D   CALL  44BF       

+4A72 22 4A 4B    "JK   LD    (4B4A),HL  

+4A75 DD CB 07 66 ...f  BIT   4,(IX+07)  

+4A79 20 40        @    JR    NZ,4ABB    

+4A7B 2C          ,     INC   L          

+4A7C 2C          ,     INC   L          

+4A7D 5E          ^     LD    E,(HL)     

+4A7E 2C          ,     INC   L          

+4A7F 56          V     LD    D,(HL)     

+4A80 7B          {     LD    A,E        

+4A81 A2          .     AND   D          

+4A82 3C          <     INC   A          

+4A83 CA 09 4B    ..K   JP    Z,4B09     

+4A86 ED 53 C6 41 .S.A  LD    (41C6),DE  

+4A8A 2C          ,     INC   L          

+4A8B 7E          ~     LD    A,(HL)     

+4A8C DD 77 1A    .w.   LD    (IX+1A),A  

+4A8F 2C          ,     INC   L          

+4A90 7E          ~     LD    A,(HL)     

+4A91 DD 77 1B    .w.   LD    (IX+1B),A  

+4A94 7B          {     LD    A,E        

+4A95 E6 01       ..    AND   01         

+4A97 CB 83       ..    RES   0,E        

+4A99 EB          .     EX    DE,HL      

+4A9A CD 4D 44    .MD   CALL  444D       

+4A9D DD 7E 18    .~.   LD    A,(IX+18)  

+4AA0 BE          .     CP    (HL)       

+4AA1 20 47        G    JR    NZ,4AEA    

+4AA3 2C          ,     INC   L          

+4AA4 DD 7E 19    .~.   LD    A,(IX+19)  

+4AA7 BE          .     CP    (HL)       

+4AA8 20 40        @    JR    NZ,4AEA    

+4AAA 2C          ,     INC   L          

+4AAB 7E          ~     LD    A,(HL)     

+4AAC 3C          <     INC   A          

+4AAD 20 3B        ;    JR    NZ,4AEA    

+4AAF 2C          ,     INC   L          

+4AB0 DD 7E 1A    .~.   LD    A,(IX+1A)  

+4AB3 96          .     SUB   (HL)       

+4AB4 23          #     INC   HL         

+4AB5 DD 7E 1B    .~.   LD    A,(IX+1B)  

+4AB8 9E          .     SBC   (HL)       

+4AB9 38 2F       8/    JR    C,4AEA     

+4ABB DD CB 07 E6 ....  SET   4,(IX+07)  

+4ABF 2A C6 41    *.A   LD    HL,(41C6)  

+4AC2 16 00       ..    LD    D,00       

+4AC4 7D          }     LD    A,L        

+4AC5 E6 01       ..    AND   01         

+4AC7 5F          _     LD    E,A        

+4AC8 CB 85       ..    RES   0,L        

+4ACA CD AD 47    ..G   CALL  47AD       

+4ACD ED 53 40 4B .S@K  LD    (4B40),DE  

+4AD1 CD 3F 49    .?I   CALL  493F       

+4AD4 FD CB 00 5E ...^  BIT   3,(IY+00)  

+4AD8 C4 ED 49    ..I   CALL  NZ,49ED    

+4ADB 42          B     LD    B,D        

+4ADC 4B          K     LD    C,E        

+4ADD EB          .     EX    DE,HL      

+4ADE 2A 4A 4B    *JK   LD    HL,(4B4A)  

+4AE1 7D          }     LD    A,L        

+4AE2 C6 06       ..    ADD   A,06       

+4AE4 6F          o     LD    L,A        

+4AE5 CD B0 2C    ..,   CALL  2CB0       

+4AE8 18 04       ..    JR    4AEE       

+4AEA DD CB 07 C6 ....  SET   0,(IX+07)  

+4AEE DD CB 07 A6 ....  RES   4,(IX+07)  

+4AF2 DD 7E 18    .~.   LD    A,(IX+18)  

+4AF5 C6 06       ..    ADD   A,06       

+4AF7 DD 86 1A    ...   ADD   (IX+1A)    

+4AFA DD 77 18    .w.   LD    (IX+18),A  

+4AFD DD 7E 19    .~.   LD    A,(IX+19)  

+4B00 DD 8E 1B    ...   ADC   (IX+1B)    

+4B03 DD 77 19    .w.   LD    (IX+19),A  

+4B06 D2 5D 4A    .]J   JP    NC,4A5D    

+4B09 DD 36 06 28 .6.(  LD    (IX+06),28 

+4B0D 2A C8 41    *.A   LD    HL,(41C8)  

+4B10 23          #     INC   HL         

+4B11 23          #     INC   HL         

+4B12 22 C6 41    ".A   LD    (41C6),HL  

+4B15 2A CA 41    *.A   LD    HL,(41CA)  

+4B18 37          7     SCF              

+4B19 CB 1C       ..    RR    H          

+4B1B CB 1D       ..    RR    L          

+4B1D CB 85       ..    RES   0,L        

+4B1F 3E FF       >.    LD    A,FF       

+4B21 CD 49 46    .IF   CALL  4649       

+4B24 DD 36 06 00 .6..  LD    (IX+06),00 

+4B28 DD CB 07 9E ....  RES   3,(IX+07)  

+4B2C DD CB 07 46 ...F  BIT   0,(IX+07)  

+4B30 C2 26 29    .&)   JP    NZ,2926    

+4B33 C3 E4 49    ..I   JP    49E4       

+4B36 54          T     LD    D,H        ; "TR"

+4B37 52          R     LD    D,D        

+4B38 00          .     NOP              

+4B39 00          .     NOP              

+4B3A 00          .     NOP              

+4B3B 00          .     NOP              

+4B3C 00          .     NOP              

+4B3D 00          .     NOP              

+4B3E 00          .     NOP              

+4B3F 00          .     NOP              

+4B40 00          .     NOP              

+4B41 00          .     NOP              

+4B42 00          .     NOP              

+4B43 00          .     NOP              

+4B44 00          .     NOP              

+4B45 00          .     NOP              

+4B46 00          .     NOP              

+4B47 00          .     NOP              

+4B48 00          .     NOP              

+4B49 00          .     NOP              

+4B4A 00          .     NOP              

+4B4B 00          .     NOP              

+4B4C F5          .     PUSH  AF         

+4B4D C5          .     PUSH  BC         

+4B4E D5          .     PUSH  DE         

+4B4F E5          .     PUSH  HL         

+4B50 FD E5       ..    PUSH  IY         

+4B52 2A B6 4C    *.L   LD    HL,(4CB6)  

+4B55 2B          +     DEC   HL         

+4B56 7C          |     LD    A,H        

+4B57 B5          .     OR    L          

+4B58 20 1D        .    JR    NZ,4B77    

+4B5A 21 17 82    !..   LD    HL,8217    

+4B5D 3A B8 4C    :.L   LD    A,(4CB8)   

+4B60 FE 02       ..    CP    02         

+4B62 28 09       (.    JR    Z,4B6D     

+4B64 CB CE       ..    SET   1,(HL)     

+4B66 3E 02       >.    LD    A,02       

+4B68 21 B8 0B    !..   LD    HL,0BB8    

+4B6B 18 07       ..    JR    4B74       

+4B6D CB C6       ..    SET   0,(HL)     

+4B6F 3E 01       >.    LD    A,01       

+4B71 21 70 17    !p.   LD    HL,1770    

+4B74 32 B8 4C    2.L   LD    (4CB8),A   

+4B77 22 B6 4C    ".L   LD    (4CB6),HL  

+4B7A 2A F1 4C    *.L   LD    HL,(4CF1)  

+4B7D 23          #     INC   HL         

+4B7E 22 F1 4C    ".L   LD    (4CF1),HL  

+4B81 21 B9 4C    !.L   LD    HL,4CB9    

+4B84 CD 99 4E    ..N   CALL  4E99       

+4B87 3A B5 4C    :.L   LD    A,(4CB5)   

+4B8A B7          .     OR    A          

+4B8B 28 08       (.    JR    Z,4B95     

+4B8D 2A B3 4C    *.L   LD    HL,(4CB3)  

+4B90 65          e     LD    H,L        

+4B91 6F          o     LD    L,A        

+4B92 22 B3 4C    ".L   LD    (4CB3),HL  

+4B95 FD E1       ..    POP   IY         

+4B97 E1          .     POP   HL         

+4B98 D1          .     POP   DE         

+4B99 C1          .     POP   BC         

+4B9A F1          .     POP   AF         

+4B9B C9          .     RET              

+4B9C F3          .     DI               

+4B9D 2A B3 4C    *.L   LD    HL,(4CB3)  

+4BA0 7D          }     LD    A,L        

+4BA1 B7          .     OR    A          

+4BA2 28 35       (5    JR    Z,4BD9     

+4BA4 6C          l     LD    L,H        

+4BA5 26 00       &.    LD    H,00       

+4BA7 22 B3 4C    ".L   LD    (4CB3),HL  

+4BAA FB          .     EI               

+4BAB FE 80       ..    CP    80         

+4BAD 28 24       ($    JR    Z,4BD3     

+4BAF CB 7F       ..    BIT   7,A        

+4BB1 C4 CA 4B    ..K   CALL  NZ,4BCA    

+4BB4 21 D1 4C    !.L   LD    HL,4CD1    

+4BB7 06 03       ..    LD    B,03       

+4BB9 0F          .     RRCA             

+4BBA F5          .     PUSH  AF         

+4BBB C5          .     PUSH  BC         

+4BBC E5          .     PUSH  HL         

+4BBD DC 99 4E    ..N   CALL  C,4E99     

+4BC0 E1          .     POP   HL         

+4BC1 C1          .     POP   BC         

+4BC2 F1          .     POP   AF         

+4BC3 11 08 00    ...   LD    DE,0008    

+4BC6 19          .     ADD   HL,DE      

+4BC7 10 F0       ..    DJNZ  4BB9       

+4BC9 C9          .     RET              

+4BCA F5          .     PUSH  AF         

+4BCB 21 C9 4C    !.L   LD    HL,4CC9    

+4BCE CD 99 4E    ..N   CALL  4E99       

+4BD1 F1          .     POP   AF         

+4BD2 C9          .     RET              

+4BD3 21 C1 4C    !.L   LD    HL,4CC1    

+4BD6 C3 99 4E    ..N   JP    4E99       

+4BD9 FB          .     EI               

+4BDA C9          .     RET              

+4BDB 3A F4 6E    :.n   LD    A,(6EF4)   

+4BDE DD 96 04    ...   SUB   (IX+04)    

+4BE1 ED 44       .D    NEG              

+4BE3 DD 77 04    .w.   LD    (IX+04),A  

+4BE6 21 B5 4C    !.L   LD    HL,4CB5    

+4BE9 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4BEC FE 05       ..    CP    05         

+4BEE 30 03       0.    JR    NC,4BF3    

+4BF0 CB C6       ..    SET   0,(HL)     

+4BF2 C9          .     RET              

+4BF3 CB CE       ..    SET   1,(HL)     

+4BF5 C9          .     RET              

+4BF6 3A F4 6E    :.n   LD    A,(6EF4)   

+4BF9 DD 86 04    ...   ADD   (IX+04)    

+4BFC FE 64       .d    CP    64         

+4BFE 38 1E       8.    JR    C,4C1E     

+4C00 D6 64       .d    SUB   A,64       

+4C02 F5          .     PUSH  AF         

+4C03 DD 35       .5    DEC   (IX+1C)    

+4C05 1C          .     INC   E          

+4C06 20 0B        .    JR    NZ,4C13    

+4C08 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4C0B 3C          <     INC   A          

+4C0C FE 03       ..    CP    03         

+4C0E 30 03       0.    JR    NC,4C13    

+4C10 DD 77 2A    .w*   LD    (IX+2A),A  

+4C13 2A 1C 6E    *.n   LD    HL,(6E1C)  

+4C16 2E 38       .8    LD    L,38       

+4C18 CD 99 4E    ..N   CALL  4E99       

+4C1B F1          .     POP   AF         

+4C1C 18 DE       ..    JR    4BFC       

+4C1E DD 77 04    .w.   LD    (IX+04),A  

+4C21 21 B5 4C    !.L   LD    HL,4CB5    

+4C24 CB 86       ..    RES   0,(HL)     

+4C26 CB 8E       ..    RES   1,(HL)     

+4C28 C9          .     RET              

+4C29 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4C2C FE 03       ..    CP    03         

+4C2E D0          .     RET   NC         

+4C2F DD 36 2A 00 .6*.  LD    (IX+2A),00 

+4C33 DD 36 1C 3C .6.<  LD    (IX+1C),3C 

+4C37 C9          .     RET              

+4C38 3A F9 4C    :.L   LD    A,(4CF9)   

+4C3B B7          .     OR    A          

+4C3C C8          .     RET   Z          

+4C3D 3E 01       >.    LD    A,01       

+4C3F 32 F9 4C    2.L   LD    (4CF9),A   

+4C42 2A FA 4C    *.L   LD    HL,(4CFA)  

+4C45 06 11       ..    LD    B,11       

+4C47 23          #     INC   HL         

+4C48 7E          ~     LD    A,(HL)     

+4C49 FE 01       ..    CP    01         

+4C4B 28 0D       (.    JR    Z,4C5A     

+4C4D 38 03       8.    JR    C,4C52     

+4C4F 21 FB 4C    !.L   LD    HL,4CFB    

+4C52 10 F3       ..    DJNZ  4C47       

+4C54 21 F9 4C    !.L   LD    HL,4CF9    

+4C57 CB 86       ..    RES   0,(HL)     

+4C59 C9          .     RET              

+4C5A DD 7E 26    .~&   LD    A,(IX+26)  

+4C5D B7          .     OR    A          

+4C5E 20 28        (    JR    NZ,4C88    

+4C60 22 FA 4C    ".L   LD    (4CFA),HL  

+4C63 11 FC 4C    ..L   LD    DE,4CFC    

+4C66 B7          .     OR    A          

+4C67 ED 52       .R    SBC   HL,DE      

+4C69 DD 7E 06    .~.   LD    A,(IX+06)  

+4C6C FE BC       ..    CP    BC         

+4C6E C0          .     RET   NZ         

+4C6F DD 7E 34    .~4   LD    A,(IX+34)  

+4C72 B7          .     OR    A          

+4C73 C0          .     RET   NZ         

+4C74 DD 36 06 00 .6..  LD    (IX+06),00 

+4C78 DD CB 07 DE ....  SET   3,(IX+07)  

+4C7C DD 75 2C    .u,   LD    (IX+2C),L  

+4C7F DD 74 2D    .t-   LD    (IX+2D),H  

+4C82 2A FA 4C    *.L   LD    HL,(4CFA)  

+4C85 36 00       6.    LD    (HL),00    

+4C87 C9          .     RET              

+4C88 DD CB 05 C6 ....  SET   0,(IX+05)  

+4C8C 97          .     SUB   A          

+4C8D 32 F9 4C    2.L   LD    (4CF9),A   

+4C90 C9          .     RET              

+4C91 F1          .     POP   AF         

+4C92 C9          .     RET              ;---------- SV-Call zustellen -----

+4C93 F5          .     PUSH  AF         ; Kanalnummer

+4C94 3A FC 6E    :.n   LD    A,(6EFC)   

+4C97 B7          .     OR    A          

+4C98 20 F7        .    JR    NZ,4C91    

+4C9A F1          .     POP   AF         

+4C9B F5          .     PUSH  AF         

+4C9C E5          .     PUSH  HL         

+4C9D 21 F9 4C    !.L   LD    HL,4CF9    

+4CA0 CB CE       ..    SET   1,(HL)     ; irgendein Kanal hat SV-Call

+4CA2 21 FC 4C    !.L   LD    HL,4CFC    ; 4CFC+Kanalnummer

+4CA5 85          .     ADD   L          

+4CA6 6F          o     LD    L,A        

+4CA7 30 01       0.    JR    NC,4CAA    

+4CA9 24          $     INC   H          

+4CAA 3E 01       >.    LD    A,01       

+4CAC 77          w     LD    (HL),A     ; 1: SV-Call angefordert

+4CAD CD 68 6D    .hm   CALL  6D68       ; unblock (supervisor)

+4CB0 E1          .     POP   HL         

+4CB1 F1          .     POP   AF         

+4CB2 C9          .     RET              ;--------------------------------

+4CB3 00          .     NOP              

+4CB4 00          .     NOP              

+4CB5 00          .     NOP              

+4CB6 70          p     LD    (HL),B     

+4CB7 17          .     RLA              

+4CB8 01 

+4CB9 00 00                              ; clock (1)

+4CBB 00          .     NOP              

+4CBC 00          .     NOP              

+4CBD 00          .     NOP              

+4CBE 00          .     NOP              

+4CBF 00          .     NOP              

+4CC0 00          .     NOP

+4CC1 00          .     NOP              ; clock (2)

+4CC2 00          .     NOP              

+4CC3 00          .     NOP              

+4CC4 00          .     NOP              

+4CC5 00          .     NOP              

+4CC6 00          .     NOP              

+4CC7 00          .     NOP

+4CC8 00          .     NOP              

+4CC9 00          .     NOP              ; clock (3)

+4CCA 00          .     NOP              

+4CCB 00          .     NOP              

+4CCC 00          .     NOP              

+4CCD 00          .     NOP              

+4CCE 00          .     NOP

+4CCF 00          .     NOP              

+4CD0 00          .     NOP              

+4CD1 00          .     NOP              ; clock (4)

+4CD2 00          .     NOP              

+4CD3 00          .     NOP              

+4CD4 00          .     NOP              

+4CD5 00          .     NOP              

+4CD6 00          .     NOP              

+4CD7 00          .     NOP              

+4CD8 00          .     NOP              

+4CD9 00          .     NOP              ; clock (5)

+4CDA 00          .     NOP              

+4CDB 00          .     NOP              

+ - Fortsetzung in Datei "eumel0.prt.3" -

diff --git a/system/eumel0-z80/src/eumel0.prt.3 b/system/eumel0-z80/src/eumel0.prt.3
new file mode 100644
index 0000000..2ae7eab
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.3
@@ -0,0 +1,4004 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+4CDC 00          .     NOP              

+4CDD 00          .     NOP              

+4CDE 00          .     NOP              

+4CDF 00          .     NOP              

+4CE0 00          .     NOP              

+4CE1 00          .     NOP              ; clock (6)

+4CE2 00          .     NOP              

+4CE3 00          .     NOP              

+4CE4 00          .     NOP              

+4CE5 00          .     NOP              

+4CE6 00          .     NOP              

+4CE7 00          .     NOP              

+4CE8 00          .     NOP              

+4CE9 00          .     NOP              ; clock (7)

+4CEA 00          .     NOP              

+4CEB 00          .     NOP              

+4CEC 00          .     NOP              

+4CED 00          .     NOP              

+4CEE 00          .     NOP              

+4CEF 00          .     NOP              

+4CF0 00          .     NOP              

+4CF1 00          .     NOP              ; ---

+4CF2 00          .     NOP              ; 4CF1/4CF2 = pausenzaehler akt.Task

+4CF3 00          .     NOP              

+4CF4 00          .     NOP              

+4CF5 00          .     NOP              

+4CF6 00          .     NOP              

+4CF7 00          .     NOP              

+4CF8 00          .     NOP              

+4CF9 00          .     NOP              ;--

+4CFA FC 4C 

+4CFC 00                                 ; Tabelle der SV-Call anforderungen

+4CFD 00          .     NOP              ; Kanal 1

+4CFE 00          .     NOP              ; Kanal 2 ...

+4CFF 00          .     NOP              

+4D00 00          .     NOP              

+4D01 00          .     NOP              

+4D02 00          .     NOP              

+4D03 00          .     NOP              

+4D04 00          .     NOP              

+4D05 00          .     NOP              

+4D06 00          .     NOP              

+4D07 00          .     NOP              

+4D08 00          .     NOP              

+4D09 00          .     NOP              

+4D0A 00          .     NOP              

+4D0B 00          .     NOP              ; Kanal 16

+4D0C FF          .     RST   38         ; Tabellenende

+4D0D CD 21 4D    .!M   CALL  4D21       

+4D10 CD 6D 4D    .mM   CALL  4D6D       

+4D13 EB          .     EX    DE,HL      

+4D14 D8          .     RET   C          

+4D15 1F          .     RRA              

+4D16 D8          .     RET   C          

+4D17 7A          z     LD    A,D        

+4D18 17          .     RLA              

+4D19 D8          .     RET   C          

+4D1A 3A 5A 4E    :ZN   LD    A,(4E5A)   

+4D1D B7          .     OR    A          

+4D1E F0          .     RET   P          

+4D1F 18 13       ..    JR    4D34       

+4D21 7A          z     LD    A,D        

+4D22 AC          .     XOR   H          

+4D23 32 5A 4E    2ZN   LD    (4E5A),A   

+4D26 CB 7C       .|    BIT   7,H        

+4D28 28 07       (.    JR    Z,4D31     

+4D2A 97          .     SUB   A          

+4D2B 95          .     SUB   L          

+4D2C 6F          o     LD    L,A        

+4D2D 3E 00       >.    LD    A,00       

+4D2F 9C          .     SBC   H          

+4D30 67          g     LD    H,A        

+4D31 CB 7A       .z    BIT   7,D        

+4D33 C8          .     RET   Z          

+4D34 97          .     SUB   A          

+4D35 93          .     SUB   E          

+4D36 5F          _     LD    E,A        

+4D37 3E 00       >.    LD    A,00       

+4D39 9A          .     SBC   D          

+4D3A 57          W     LD    D,A        

+4D3B B7          .     OR    A          

+4D3C C9          .     RET              

+4D3D CB 7A       .z    BIT   7,D        

+4D3F 20 0E        .    JR    NZ,4D4F    

+4D41 CD 21 4D    .!M   CALL  4D21       

+4D44 CD AD 4D    ..M   CALL  4DAD       

+4D47 30 D1       0.    JR    NC,4D1A    

+4D49 C9          .     RET              

+4D4A CD AD 4D    ..M   CALL  4DAD       

+4D4D B7          .     OR    A          

+4D4E C9          .     RET              

+4D4F DD CB 0B 66 ...f  BIT   4,(IX+0B)  

+4D53 20 F5        .    JR    NZ,4D4A    

+4D55 CD 21 4D    .!M   CALL  4D21       

+4D58 E5          .     PUSH  HL         

+4D59 CD AD 4D    ..M   CALL  4DAD       

+4D5C 38 0B       8.    JR    C,4D69     

+4D5E 7C          |     LD    A,H        

+4D5F B5          .     OR    L          

+4D60 28 07       (.    JR    Z,4D69     

+4D62 EB          .     EX    DE,HL      

+4D63 E3          .     EX    (SP),HL    

+4D64 ED 52       .R    SBC   HL,DE      

+4D66 D1          .     POP   DE         

+4D67 18 B1       ..    JR    4D1A       

+4D69 33          3     INC   SP         

+4D6A 33          3     INC   SP         

+4D6B 18 AD       ..    JR    4D1A       

+4D6D 7A          z     LD    A,D        ; -------- 16 * 16 --> 24 Bit MULT ---

+4D6E BC          .     CP    H          

+4D6F 30 01       0.    JR    NC,4D72    

+4D71 EB          .     EX    DE,HL      

+4D72 C5          .     PUSH  BC         

+4D73 44          D     LD    B,H        

+4D74 4D          M     LD    C,L        

+4D75 97          .     SUB   A          

+4D76 67          g     LD    H,A        

+4D77 6F          o     LD    L,A        

+4D78 CB 38       .8    SLR   B          

+4D7A CB 19       ..    RR    C          

+4D7C 30 01       0.    JR    NC,4D7F    

+4D7E 19          .     ADD   HL,DE      

+4D7F 18 1B       ..    JR    4D9C       

+4D81 CB 23       .#    SLA   E          

+4D83 CB 12       ..    RL    D          

+4D85 CE 00       ..    ADC   A,00       

+4D87 19          .     ADD   HL,DE      

+4D88 CE 00       ..    ADC   A,00       

+4D8A CB 38       .8    SLR   B          

+4D8C CB 19       ..    RR    C          

+4D8E 38 F1       8.    JR    C,4D81     

+4D90 20 04        .    JR    NZ,4D96    

+4D92 04          .     INC   B          

+4D93 05          .     DEC   B          

+4D94 28 12       (.    JR    Z,4DA8     

+4D96 CB 23       .#    SLA   E          

+4D98 CB 12       ..    RL    D          

+4D9A 38 0F       8.    JR    C,4DAB     

+4D9C CB 38       .8    SLR   B          

+4D9E CB 19       ..    RR    C          

+4DA0 38 DF       8.    JR    C,4D81     

+4DA2 20 F2        .    JR    NZ,4D96    

+4DA4 04          .     INC   B          

+4DA5 05          .     DEC   B          

+4DA6 20 EE        .    JR    NZ,4D96    

+4DA8 FE 02       ..    CP    02         

+4DAA 3F          ?     CCF              

+4DAB C1          .     POP   BC         

+4DAC C9          .     RET              

+4DAD 7C          |     LD    A,H        

+4DAE B5          .     OR    L          

+4DAF 20 02        .    JR    NZ,4DB3    

+4DB1 37          7     SCF              

+4DB2 C9          .     RET              

+4DB3 7C          |     LD    A,H        

+4DB4 B2          .     OR    D          

+4DB5 28 2B       (+    JR    Z,4DE2     

+4DB7 C5          .     PUSH  BC         

+4DB8 97          .     SUB   A          

+4DB9 3C          <     INC   A          

+4DBA ED 6A       .j    ADC   HL,HL      

+4DBC F2 B9 4D    ..M   JP    P,4DB9     

+                                                                                                                                                                                           

+4DC0 4D          M     LD    C,L        

+4DC1 EB          .     EX    DE,HL      

+4DC2 11 00 00    ...   LD    DE,0000    

+4DC5 CB 23       .#    SLA   E          

+4DC7 CB 12       ..    RL    D          

+4DC9 22 5B 4E    "[N   LD    (4E5B),HL  

+4DCC B7          .     OR    A          

+4DCD ED 42       .B    SBC   HL,BC      

+4DCF 30 03       0.    JR    NC,4DD4    

+4DD1 2A 5B 4E    *[N   LD    HL,(4E5B)  

+4DD4 38 01       8.    JR    C,4DD7     

+4DD6 13          .     INC   DE         

+4DD7 CB 38       .8    SLR   B          

+4DD9 CB 19       ..    RR    C          

+4DDB 3D          =     DEC   A          

+4DDC F2 C5 4D    ..M   JP    P,4DC5     

+4DDF C1          .     POP   BC         

+4DE0 B7          .     OR    A          

+4DE1 C9          .     RET              

+4DE2 CB 7D       .}    BIT   7,L        

+4DE4 20 06        .    JR    NZ,4DEC    

+4DE6 24          $     INC   H          

+4DE7 CB 25       .%    SLA   L          

+4DE9 F2 E6 4D    ..M   JP    P,4DE6     

+4DEC 7B          {     LD    A,E        

+4DED 1E 00       ..    LD    E,00       

+4DEF CB 23       .#    SLA   E          

+4DF1 BD          .     CP    L          

+4DF2 38 02       8.    JR    C,4DF6     

+4DF4 95          .     SUB   L          

+4DF5 1C          .     INC   E          

+4DF6 CB 3D       .=    SLR   L          

+4DF8 25          %     DEC   H          

+4DF9 F2 EF 4D    ..M   JP    P,4DEF     

+4DFC 6F          o     LD    L,A        

+4DFD 97          .     SUB   A          

+4DFE 67          g     LD    H,A        

+4DFF C9          .     RET              

+4E00 E5          .     PUSH  HL         

+4E01 EB          .     EX    DE,HL      

+4E02 06 10       ..    LD    B,10       

+4E04 11 00 00    ...   LD    DE,0000    

+4E07 4A          J     LD    C,D        

+4E08 29          )     ADD   HL,HL      

+4E09 38 11       8.    JR    C,4E1C     

+4E0B 10 FB       ..    DJNZ  4E08       

+4E0D 18 1C       ..    JR    4E2B       

+4E0F 7A          z     LD    A,D        

+4E10 87          .     ADD   A          

+4E11 27          '     DAA              

+4E12 57          W     LD    D,A        

+4E13 7B          {     LD    A,E        

+4E14 8F          .     ADC   A          

+4E15 27          '     DAA              

+4E16 5F          _     LD    E,A        

+4E17 CB 11       ..    RL    C          

+4E19 29          )     ADD   HL,HL      

+4E1A 30 0D       0.    JR    NC,4E29    

+4E1C 7A          z     LD    A,D        

+4E1D C6 01       ..    ADD   A,01       

+4E1F 27          '     DAA              

+4E20 57          W     LD    D,A        

+4E21 7B          {     LD    A,E        

+4E22 CE 00       ..    ADC   A,00       

+4E24 27          '     DAA              

+4E25 5F          _     LD    E,A        

+4E26 30 01       0.    JR    NC,4E29    

+4E28 0C          .     INC   C          

+4E29 10 E4       ..    DJNZ  4E0F       

+4E2B 21 5D 4E    !]N   LD    HL,4E5D    

+4E2E 71          q     LD    (HL),C     

+4E2F ED 53 5E 4E .S^N  LD    (4E5E),DE  

+4E33 D1          .     POP   DE         

+4E34 06 06       ..    LD    B,06       

+4E36 D5          .     PUSH  DE         

+4E37 0E 00       ..    LD    C,00       

+4E39 3E 30       >0    LD    A,30       

+4E3B CD 53 4E    .SN   CALL  4E53       

+4E3E FE 30       .0    CP    30         

+4E40 20 08        .    JR    NZ,4E4A    

+4E42 10 F7       ..    DJNZ  4E3B       

+4E44 04          .     INC   B          

+4E45 18 03       ..    JR    4E4A       

+4E47 CD 53 4E    .SN   CALL  4E53       

+4E4A 12          .     LD    (DE),A     

+4E4B 13          .     INC   DE         

+4E4C 0C          .     INC   C          

+4E4D 10 F8       ..    DJNZ  4E47       

+4E4F 06 00       ..    LD    B,00       

+4E51 D1          .     POP   DE         

+4E52 C9          .     RET              

+4E53 ED 6F       .o    RLD              

+4E55 CB 40       .@    BIT   0,B        

+4E57 C8          .     RET   Z          

+4E58 23          #     INC   HL         

+4E59 C9          .     RET              

+4E5A 00          .     NOP              

+4E5B 00          .     NOP              

+4E5C 00          .     NOP              

+4E5D 20 20             JR    NZ,4E7F    

+4E5F 20 08        .    JR    NZ,4E69    

+4E61 F5          .     PUSH  AF         

+4E62 C5          .     PUSH  BC         

+4E63 CD 72 4E    .rN   CALL  4E72       

+4E66 DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+4E6A 11 91 4E    ..N   LD    DE,4E91    

+4E6D C1          .     POP   BC         

+4E6E 08          .     EX    AF,AF'     

+4E6F F1          .     POP   AF         

+4E70 08          .     EX    AF,AF'     

+4E71 C9          .     RET              

+4E72 E5          .     PUSH  HL         

+4E73 EB          .     EX    DE,HL      

+4E74 11 91 4E    ..N   LD    DE,4E91    

+4E77 01 08 00    ...   LD    BC,0008    

+4E7A ED B0       ..    LDIR             

+4E7C DD 21 91 4E .!.N  LD    IX,4E91    

+4E80 FD E3       ..    EX    (SP),IY    

+4E82 C9          .     RET              

+4E83 C5          .     PUSH  BC         

+4E84 D5          .     PUSH  DE         

+4E85 DD E3       ..    EX    (SP),IX    

+4E87 E5          .     PUSH  HL         

+4E88 FD E1       ..    POP   IY         

+4E8A CD B3 51    ..Q   CALL  51B3       

+4E8D DD E1       ..    POP   IX         

+4E8F C1          .     POP   BC         

+4E90 C9          .     RET              

+4E91 00          .     NOP              

+4E92 00          .     NOP              

+4E93 00          .     NOP              

+4E94 00          .     NOP              

+4E95 00          .     NOP              

+4E96 00          .     NOP              

+4E97 00          .     NOP              

+4E98 00          .     NOP              

+4E99 0E 01       ..    LD    C,01       

+4E9B E5          .     PUSH  HL         

+4E9C FD E1       ..    POP   IY         

+4E9E FD 7E 07    .~.   LD    A,(IY+07)  

+4EA1 FE 8D       ..    CP    8D         

+4EA3 D0          .     RET   NC         

+4EA4 B7          .     OR    A          

+4EA5 FA AD 4E    ..N   JP    M,4EAD     

+4EA8 3E 80       >.    LD    A,80       

+4EAA FD 77 07    .w.   LD    (IY+07),A  

+4EAD D6 7F       ..    SUB   A,7F       

+4EAF CB 3F       .?    SLR   A          

+4EB1 47          G     LD    B,A        

+4EB2 5F          _     LD    E,A        

+4EB3 16 00       ..    LD    D,00       

+4EB5 79          y     LD    A,C        

+4EB6 38 04       8.    JR    C,4EBC     

+4EB8 87          .     ADD   A          

+4EB9 87          .     ADD   A          

+4EBA 81          .     ADD   C          

+4EBB 87          .     ADD   A          

+4EBC 19          .     ADD   HL,DE      

+4EBD 04          .     INC   B          

+4EBE B7          .     OR    A          

+4EBF 8E          .     ADC   (HL)       

+4EC0 27          '     DAA              

+4EC1 77          w     LD    (HL),A     

+4EC2 2B          +     DEC   HL         

+4EC3 3E 00       >.    LD    A,00       

+4EC5 10 F8       ..    DJNZ  4EBF       

+4EC7 23          #     INC   HL         

+4EC8 7E          ~     LD    A,(HL)     

+4EC9 FE 10       ..    CP    10         

+4ECB D8          .     RET   C          

+4ECC 97          .     SUB   A          

+4ECD CD 3A 52    .:R   CALL  523A       

+4ED0 34          4     INC   (HL)       

+4ED1 C9          .     RET              

+4ED2 C5          .     PUSH  BC         

+4ED3 D5          .     PUSH  DE         

+4ED4 CD 73 52    .sR   CALL  5273       

+4ED7 D1          .     POP   DE         

+4ED8 C1          .     POP   BC         

+4ED9 1A          .     LD    A,(DE)     

+4EDA B7          .     OR    A          

+4EDB C8          .     RET   Z          

+4EDC EE 80       ..    XOR   80         

+4EDE 12          .     LD    (DE),A     

+4EDF C9          .     RET              

+4EE0 7B          {     LD    A,E        

+4EE1 11 07 00    ...   LD    DE,0007    

+4EE4 19          .     ADD   HL,DE      

+4EE5 C6 81       ..    ADD   A,81       

+4EE7 77          w     LD    (HL),A     

+4EE8 C9          .     RET              

+4EE9 11 07 00    ...   LD    DE,0007    

+4EEC 19          .     ADD   HL,DE      

+4EED 7E          ~     LD    A,(HL)     

+4EEE D6 81       ..    SUB   A,81       

+4EF0 5F          _     LD    E,A        

+4EF1 16 00       ..    LD    D,00       

+4EF3 D0          .     RET   NC         

+4EF4 15          .     DEC   D          

+4EF5 C9          .     RET              

+4EF6 C5          .     PUSH  BC         

+4EF7 D5          .     PUSH  DE         

+4EF8 CD 73 52    .sR   CALL  5273       

+4EFB EB          .     EX    DE,HL      

+4EFC D1          .     POP   DE         

+4EFD C1          .     POP   BC         

+4EFE 2B          +     DEC   HL         

+4EFF 3E 8D       >.    LD    A,8D       

+4F01 96          .     SUB   (HL)       

+4F02 D8          .     RET   C          

+4F03 FE 0D       ..    CP    0D         

+4F05 30 0F       0.    JR    NC,4F16    

+4F07 2B          +     DEC   HL         

+4F08 3D          =     DEC   A          

+4F09 F8          .     RET   M          

+4F0A 28 05       (.    JR    Z,4F11     

+4F0C 36 00       6.    LD    (HL),00    

+4F0E 3D          =     DEC   A          

+4F0F 18 F6       ..    JR    4F07       

+4F11 7E          ~     LD    A,(HL)     

+4F12 E6 F0       ..    AND   F0         

+4F14 77          w     LD    (HL),A     

+4F15 C9          .     RET              

+4F16 EB          .     EX    DE,HL      

+4F17 3E 08       >.    LD    A,08       

+4F19 36 00       6.    LD    (HL),00    

+4F1B 23          #     INC   HL         

+4F1C 3D          =     DEC   A          

+4F1D 20 FA        .    JR    NZ,4F19    

+4F1F C9          .     RET              

+4F20 FD 7E 00    .~.   LD    A,(IY+00)  

+4F23 EE 80       ..    XOR   80         

+4F25 5F          _     LD    E,A        

+4F26 DD 56 00    .V.   LD    D,(IX+00)  

+4F29 C3 32 4F    .2O   JP    4F32       

+4F2C DD 56 00    .V.   LD    D,(IX+00)  

+4F2F FD 5E 00    .^.   LD    E,(IY+00)  

+4F32 AF          .     XOR   A          

+4F33 DD BE 07    ...   CP    (IX+07)    

+4F36 C2 49 4F    .IO   JP    NZ,4F49    

+4F39 FD BE 07    ...   CP    (IY+07)    

+4F3C C8          .     RET   Z          

+4F3D 7B          {     LD    A,E        

+4F3E FD E5       ..    PUSH  IY         

+4F40 E1          .     POP   HL         

+4F41 CD 79 52    .yR   CALL  5279       

+4F44 DD 77 00    .w.   LD    (IX+00),A  

+4F47 B7          .     OR    A          

+4F48 C9          .     RET              

+4F49 DD 72 00    .r.   LD    (IX+00),D  

+4F4C FD BE 07    ...   CP    (IY+07)    

+4F4F C8          .     RET   Z          

+4F50 D5          .     PUSH  DE         

+4F51 CB BA       ..    RES   7,D        

+4F53 CB BB       ..    RES   7,E        

+4F55 CD B9 51    ..Q   CALL  51B9       

+4F58 38 0D       8.    JR    C,4F67     

+4F5A CD 7E 52    .~R   CALL  527E       

+4F5D CD 96 52    ..R   CALL  5296       

+4F60 C1          .     POP   BC         

+4F61 78          x     LD    A,B        

+4F62 A9          .     XOR   C          

+4F63 78          x     LD    A,B        

+4F64 C3 71 4F    .qO   JP    4F71       

+4F67 CD 86 52    ..R   CALL  5286       

+4F6A CD 82 52    ..R   CALL  5282       

+4F6D C1          .     POP   BC         

+4F6E 79          y     LD    A,C        

+4F6F A8          .     XOR   B          

+4F70 79          y     LD    A,C        

+4F71 08          .     EX    AF,AF'     

+4F72 3A BD 52    :.R   LD    A,(52BD)   

+4F75 21 C5 52    !.R   LD    HL,52C5    

+4F78 96          .     SUB   (HL)       

+4F79 28 0F       (.    JR    Z,4F8A     

+4F7B FE 0D       ..    CP    0D         

+4F7D D2 D8 4F    ..O   JP    NC,4FD8    

+4F80 47          G     LD    B,A        

+4F81 AF          .     XOR   A          

+4F82 21 BE 52    !.R   LD    HL,52BE    

+4F85 CD 3A 52    .:R   CALL  523A       

+4F88 10 F7       ..    DJNZ  4F81       

+4F8A 06 07       ..    LD    B,07       

+4F8C 21 C4 52    !.R   LD    HL,52C4    

+4F8F 11 BC 52    ..R   LD    DE,52BC    

+4F92 A7          .     AND   A          

+4F93 08          .     EX    AF,AF'     

+4F94 FA B8 4F    ..O   JP    M,4FB8     

+4F97 08          .     EX    AF,AF'     

+4F98 1A          .     LD    A,(DE)     

+4F99 8E          .     ADC   (HL)       

+4F9A 27          '     DAA              

+4F9B 12          .     LD    (DE),A     

+4F9C 1B          .     DEC   DE         

+4F9D 2B          +     DEC   HL         

+4F9E 10 F8       ..    DJNZ  4F98       

+4FA0 3A B6 52    :.R   LD    A,(52B6)   

+4FA3 E6 F0       ..    AND   F0         

+4FA5 CA D8 4F    ..O   JP    Z,4FD8     

+4FA8 21 BD 52    !.R   LD    HL,52BD    

+4FAB 34          4     INC   (HL)       

+4FAC CA B2 52    ..R   JP    Z,52B2     

+4FAF 21 B6 52    !.R   LD    HL,52B6    

+4FB2 CD 3A 52    .:R   CALL  523A       

+4FB5 C3 D8 4F    ..O   JP    4FD8       

+4FB8 08          .     EX    AF,AF'     

+4FB9 1A          .     LD    A,(DE)     

+4FBA 9E          .     SBC   (HL)       

+4FBB 27          '     DAA              

+4FBC 12          .     LD    (DE),A     

+4FBD 1B          .     DEC   DE         

+4FBE 2B          +     DEC   HL         

+4FBF 10 F8       ..    DJNZ  4FB9       

+4FC1 3A BD 52    :.R   LD    A,(52BD)   

+4FC4 4F          O     LD    C,A        

+4FC5 21 B6 52    !.R   LD    HL,52B6    

+4FC8 CD F6 51    ..Q   CALL  51F6       

+4FCB CA A6 52    ..R   JP    Z,52A6     

+4FCE DA A6 52    ..R   JP    C,52A6     

+4FD1 79          y     LD    A,C        

+4FD2 32 BD 52    2.R   LD    (52BD),A   

+4FD5 C3 D8 4F    ..O   JP    4FD8       

+4FD8 21 B6 52    !.R   LD    HL,52B6    

+4FDB CD 79 52    .yR   CALL  5279       

+4FDE C3 0B 51    ..Q   JP    510B       

+4FE1 AF          .     XOR   A          

+4FE2 DD BE 07    ...   CP    (IX+07)    

+4FE5 CA A6 52    ..R   JP    Z,52A6     

+4FE8 FD BE 07    ...   CP    (IY+07)    

+4FEB CA A6 52    ..R   JP    Z,52A6     

+4FEE DD 7E 00    .~.   LD    A,(IX+00)  

+4FF1 FD AE 00    ...   XOR   (IY+00)    

+4FF4 08          .     EX    AF,AF'     

+4FF5 DD E5       ..    PUSH  IX         

+4FF7 D1          .     POP   DE         

+4FF8 21 06 00    !..   LD    HL,0006    

+4FFB 19          .     ADD   HL,DE      

+4FFC 22 B4 52    ".R   LD    (52B4),HL  

+4FFF EB          .     EX    DE,HL      

+5000 CD 93 51    ..Q   CALL  5193       

+5003 CD 86 52    ..R   CALL  5286       

+5006 FD 21 B6 52 .!.R  LD    IY,52B6    

+500A CD A6 52    ..R   CALL  52A6       

+500D 06 07       ..    LD    B,07       

+500F C3 1D 50    ..P   JP    501D       

+5012 AF          .     XOR   A          

+5013 CD 37 52    .7R   CALL  5237       

+5016 CD BD 50    ..P   CALL  50BD       

+5019 AF          .     XOR   A          

+501A CD 37 52    .7R   CALL  5237       

+501D FD 4E 06    .N.   LD    C,(IY+06)  

+5020 FD 2B       .+    DEC   IY         

+5022 CD BD 50    ..P   CALL  50BD       

+5025 10 EB       ..    DJNZ  5012       

+5027 05          .     DEC   B          

+5028 DD 7E 00    .~.   LD    A,(IX+00)  

+502B E6 F0       ..    AND   F0         

+502D 28 05       (.    JR    Z,5034     

+502F 04          .     INC   B          

+5030 AF          .     XOR   A          

+5031 CD 37 52    .7R   CALL  5237       

+5034 3A CD 52    :.R   LD    A,(52CD)   

+5037 D6 80       ..    SUB   A,80       

+5039 4F          O     LD    C,A        

+503A FD 7E 0E    .~.   LD    A,(IY+0E)  

+503D D6 80       ..    SUB   A,80       

+503F 81          .     ADD   C          

+5040 E2 4A 50    .JP   JP    PO,504A    

+5043 80          .     ADD   B          

+5044 E2 AD 51    ..Q   JP    PO,51AD    

+5047 C3 4E 50    .NP   JP    504E       

+504A 80          .     ADD   B          

+504B EA AD 51    ..Q   JP    PE,51AD    

+504E C6 80       ..    ADD   A,80       

+5050 CA A6 52    ..R   JP    Z,52A6     

+5053 DD 77 07    .w.   LD    (IX+07),A  

+5056 C3 0B 51    ..Q   JP    510B       

+5059 AF          .     XOR   A          

+505A FD BE 07    ...   CP    (IY+07)    

+505D CA B2 52    ..R   JP    Z,52B2     

+5060 DD BE 07    ...   CP    (IX+07)    

+5063 CA A6 52    ..R   JP    Z,52A6     

+5066 DD 7E 00    .~.   LD    A,(IX+00)  

+5069 FD AE 00    ...   XOR   (IY+00)    

+506C 08          .     EX    AF,AF'     

+506D FD E5       ..    PUSH  IY         

+506F E1          .     POP   HL         

+5070 CD 93 51    ..Q   CALL  5193       

+5073 DD E5       ..    PUSH  IX         

+5075 CD 7E 52    .~R   CALL  527E       

+5078 01 01 07    ...   LD    BC,0701    

+507B C5          .     PUSH  BC         

+507C 0E 0F       ..    LD    C,0F       

+507E 21 C6 52    !.R   LD    HL,52C6    

+5081 CD 5A 51    .ZQ   CALL  515A       

+5084 30 18       0.    JR    NC,509E    

+5086 C1          .     POP   BC         

+5087 0D          .     DEC   C          

+5088 C5          .     PUSH  BC         

+5089 C3 97 50    ..P   JP    5097       

+508C C5          .     PUSH  BC         

+508D 21 B6 52    !.R   LD    HL,52B6    

+5090 AF          .     XOR   A          

+5091 CD 1B 52    ..R   CALL  521B       

+5094 CD 19 51    ..Q   CALL  5119       

+5097 21 B6 52    !.R   LD    HL,52B6    

+509A AF          .     XOR   A          

+509B CD 1B 52    ..R   CALL  521B       

+509E CD 19 51    ..Q   CALL  5119       

+50A1 79          y     LD    A,C        

+50A2 2F          /     CPL              

+50A3 DD 77 00    .w.   LD    (IX+00),A  

+50A6 DD 23       .#    INC   IX         

+50A8 C1          .     POP   BC         

+50A9 10 E1       ..    DJNZ  508C       

+50AB 41          A     LD    B,C        

+50AC 3A CD 52    :.R   LD    A,(52CD)   

+50AF D6 80       ..    SUB   A,80       

+50B1 4F          O     LD    C,A        

+50B2 3A BD 52    :.R   LD    A,(52BD)   

+50B5 D6 80       ..    SUB   A,80       

+50B7 91          .     SUB   C          

+50B8 DD E1       ..    POP   IX         

+50BA C3 40 50    .@P   JP    5040       

+50BD 21 CC 52    !.R   LD    HL,52CC    

+50C0 CB 19       ..    RR    C          

+50C2 DC DE 50    ..P   CALL  C,50DE     

+50C5 21 D4 52    !.R   LD    HL,52D4    

+50C8 CB 19       ..    RR    C          

+50CA DC DE 50    ..P   CALL  C,50DE     

+50CD 21 DC 52    !.R   LD    HL,52DC    

+50D0 CB 19       ..    RR    C          

+50D2 DC DE 50    ..P   CALL  C,50DE     

+50D5 21 E4 52    !.R   LD    HL,52E4    

+50D8 CB 19       ..    RR    C          

+50DA DC DE 50    ..P   CALL  C,50DE     

+50DD C9          .     RET              

+50DE ED 5B B4 52 .[.R  LD    DE,(52B4)  

+50E2 1A          .     LD    A,(DE)     

+50E3 86          .     ADD   (HL)       

+50E4 27          '     DAA              

+50E5 12          .     LD    (DE),A     

+50E6 1B          .     DEC   DE         

+50E7 2B          +     DEC   HL         

+50E8 1A          .     LD    A,(DE)     

+50E9 8E          .     ADC   (HL)       

+50EA 27          '     DAA              

+50EB 12          .     LD    (DE),A     

+50EC 1B          .     DEC   DE         

+50ED 2B          +     DEC   HL         

+50EE 1A          .     LD    A,(DE)     

+50EF 8E          .     ADC   (HL)       

+50F0 27          '     DAA              

+50F1 12          .     LD    (DE),A     

+50F2 1B          .     DEC   DE         

+50F3 2B          +     DEC   HL         

+50F4 1A          .     LD    A,(DE)     

+50F5 8E          .     ADC   (HL)       

+50F6 27          '     DAA              

+50F7 12          .     LD    (DE),A     

+50F8 1B          .     DEC   DE         

+50F9 2B          +     DEC   HL         

+50FA 1A          .     LD    A,(DE)     

+50FB 8E          .     ADC   (HL)       

+50FC 27          '     DAA              

+50FD 12          .     LD    (DE),A     

+50FE 1B          .     DEC   DE         

+50FF 2B          +     DEC   HL         

+5100 1A          .     LD    A,(DE)     

+5101 8E          .     ADC   (HL)       

+5102 27          '     DAA              

+5103 12          .     LD    (DE),A     

+5104 1B          .     DEC   DE         

+5105 2B          +     DEC   HL         

+5106 1A          .     LD    A,(DE)     

+5107 8E          .     ADC   (HL)       

+5108 27          '     DAA              

+5109 12          .     LD    (DE),A     

+510A C9          .     RET              

+510B DD 7E 00    .~.   LD    A,(IX+00)  

+510E E6 0F       ..    AND   0F         

+5110 47          G     LD    B,A        

+5111 08          .     EX    AF,AF'     

+5112 E6 80       ..    AND   80         

+5114 B0          .     OR    B          

+5115 DD 77 00    .w.   LD    (IX+00),A  

+5118 C9          .     RET              

+5119 21 DE 52    !.R   LD    HL,52DE    

+511C CD 5A 51    .ZQ   CALL  515A       

+511F 38 06       8.    JR    C,5127     

+5121 21 E4 52    !.R   LD    HL,52E4    

+5124 CD 67 51    .gQ   CALL  5167       

+5127 CB 11       ..    RL    C          

+5129 21 D6 52    !.R   LD    HL,52D6    

+512C CD 5A 51    .ZQ   CALL  515A       

+512F 38 06       8.    JR    C,5137     

+5131 21 DC 52    !.R   LD    HL,52DC    

+5134 CD 67 51    .gQ   CALL  5167       

+5137 CB 11       ..    RL    C          

+5139 21 CE 52    !.R   LD    HL,52CE    

+513C CD 5A 51    .ZQ   CALL  515A       

+513F 38 06       8.    JR    C,5147     

+5141 21 D4 52    !.R   LD    HL,52D4    

+5144 CD 67 51    .gQ   CALL  5167       

+5147 CB 11       ..    RL    C          

+5149 21 C6 52    !.R   LD    HL,52C6    

+514C CD 5A 51    .ZQ   CALL  515A       

+514F 38 06       8.    JR    C,5157     

+5151 21 CC 52    !.R   LD    HL,52CC    

+5154 CD 67 51    .gQ   CALL  5167       

+5157 CB 11       ..    RL    C          

+5159 C9          .     RET              

+515A 11 B6 52    ..R   LD    DE,52B6    

+515D 06 07       ..    LD    B,07       

+515F 1A          .     LD    A,(DE)     

+5160 BE          .     CP    (HL)       

+5161 C0          .     RET   NZ         

+5162 23          #     INC   HL         

+5163 13          .     INC   DE         

+5164 10 F9       ..    DJNZ  515F       

+5166 C9          .     RET              

+5167 11 BC 52    ..R   LD    DE,52BC    

+516A 1A          .     LD    A,(DE)     

+516B 96          .     SUB   (HL)       

+516C 27          '     DAA              

+516D 12          .     LD    (DE),A     

+516E 1B          .     DEC   DE         

+516F 2B          +     DEC   HL         

+5170 1A          .     LD    A,(DE)     

+5171 9E          .     SBC   (HL)       

+5172 27          '     DAA              

+5173 12          .     LD    (DE),A     

+5174 1B          .     DEC   DE         

+5175 2B          +     DEC   HL         

+5176 1A          .     LD    A,(DE)     

+5177 9E          .     SBC   (HL)       

+5178 27          '     DAA              

+5179 12          .     LD    (DE),A     

+517A 1B          .     DEC   DE         

+517B 2B          +     DEC   HL         

+517C 1A          .     LD    A,(DE)     

+517D 9E          .     SBC   (HL)       

+517E 27          '     DAA              

+517F 12          .     LD    (DE),A     

+5180 1B          .     DEC   DE         

+5181 2B          +     DEC   HL         

+5182 1A          .     LD    A,(DE)     

+5183 9E          .     SBC   (HL)       

+5184 27          '     DAA              

+5185 12          .     LD    (DE),A     

+5186 1B          .     DEC   DE         

+5187 2B          +     DEC   HL         

+5188 1A          .     LD    A,(DE)     

+5189 9E          .     SBC   (HL)       

+518A 27          '     DAA              

+518B 12          .     LD    (DE),A     

+518C 1B          .     DEC   DE         

+518D 2B          +     DEC   HL         

+518E 1A          .     LD    A,(DE)     

+518F 9E          .     SBC   (HL)       

+5190 27          '     DAA              

+5191 12          .     LD    (DE),A     

+5192 C9          .     RET              

+5193 11 C6 52    ..R   LD    DE,52C6    

+5196 CD 73 52    .sR   CALL  5273       

+5199 21 C6 52    !.R   LD    HL,52C6    

+519C CB BE       ..    RES   7,(HL)     

+519E 06 03       ..    LD    B,03       

+51A0 78          x     LD    A,B        

+51A1 CD 73 52    .sR   CALL  5273       

+51A4 47          G     LD    B,A        

+51A5 A7          .     AND   A          

+51A6 CD 53 52    .SR   CALL  5253       

+51A9 23          #     INC   HL         

+51AA 10 F4       ..    DJNZ  51A0       

+51AC C9          .     RET              

+51AD F2 A6 52    ..R   JP    P,52A6     

+51B0 C3 B2 52    ..R   JP    52B2       

+51B3 DD 56 00    .V.   LD    D,(IX+00)  

+51B6 FD 5E 00    .^.   LD    E,(IY+00)  

+51B9 7A          z     LD    A,D        

+51BA E6 80       ..    AND   80         

+51BC 20 13        .    JR    NZ,51D1    

+51BE CB 7B       .{    BIT   7,E        

+51C0 C0          .     RET   NZ         

+51C1 DD 7E 07    .~.   LD    A,(IX+07)  

+51C4 FD BE 07    ...   CP    (IY+07)    

+51C7 C0          .     RET   NZ         

+51C8 7A          z     LD    A,D        

+51C9 BB          .     CP    E          

+51CA C0          .     RET   NZ         

+51CB DD E5       ..    PUSH  IX         

+51CD FD E5       ..    PUSH  IY         

+51CF 18 11       ..    JR    51E2       

+51D1 AB          .     XOR   E          

+51D2 17          .     RLA              

+51D3 D8          .     RET   C          

+51D4 FD 7E 07    .~.   LD    A,(IY+07)  

+51D7 DD BE 07    ...   CP    (IX+07)    

+51DA C0          .     RET   NZ         

+51DB 7B          {     LD    A,E        

+51DC BA          .     CP    D          

+51DD C0          .     RET   NZ         

+51DE FD E5       ..    PUSH  IY         

+51E0 DD E5       ..    PUSH  IX         

+51E2 E1          .     POP   HL         

+51E3 D1          .     POP   DE         

+51E4 23          #     INC   HL         

+51E5 13          .     INC   DE         

+51E6 06 06       ..    LD    B,06       

+51E8 1A          .     LD    A,(DE)     

+51E9 BE          .     CP    (HL)       

+51EA C0          .     RET   NZ         

+51EB 23          #     INC   HL         

+51EC 13          .     INC   DE         

+51ED 10 F9       ..    DJNZ  51E8       

+51EF C9          .     RET              

+51F0 DD 4E 07    .N.   LD    C,(IX+07)  

+51F3 DD E5       ..    PUSH  IX         

+51F5 E1          .     POP   HL         

+51F6 7E          ~     LD    A,(HL)     

+51F7 A7          .     AND   A          

+51F8 20 10        .    JR    NZ,520A    

+51FA 06 0C       ..    LD    B,0C       

+51FC AF          .     XOR   A          

+51FD 0D          .     DEC   C          

+51FE 28 0E       (.    JR    Z,520E     

+5200 CD 1B 52    ..R   CALL  521B       

+5203 23          #     INC   HL         

+5204 7E          ~     LD    A,(HL)     

+5205 A7          .     AND   A          

+5206 20 02        .    JR    NZ,520A    

+5208 10 F3       ..    DJNZ  51FD       

+520A DD 71 07    .q.   LD    (IX+07),C  

+520D C9          .     RET              

+520E 04          .     INC   B          

+520F CB 38       .8    SLR   B          

+5211 23          #     INC   HL         

+5212 B6          .     OR    (HL)       

+5213 10 FC       ..    DJNZ  5211       

+5215 C8          .     RET   Z          

+5216 37          7     SCF              

+5217 C9          .     RET              

+5218 DD E5       ..    PUSH  IX         

+521A E1          .     POP   HL         

+521B C5          .     PUSH  BC         

+521C 01 06 00    ...   LD    BC,0006    

+521F 09          .     ADD   HL,BC      

+5220 ED 6F       .o    RLD              

+5222 2B          +     DEC   HL         

+5223 ED 6F       .o    RLD              

+5225 2B          +     DEC   HL         

+5226 ED 6F       .o    RLD              

+5228 2B          +     DEC   HL         

+5229 ED 6F       .o    RLD              

+522B 2B          +     DEC   HL         

+522C ED 6F       .o    RLD              

+522E 2B          +     DEC   HL         

+522F ED 6F       .o    RLD              

+5231 2B          +     DEC   HL         

+5232 ED 6F       .o    RLD              

+5234 2B          +     DEC   HL         

+5235 C1          .     POP   BC         

+5236 C9          .     RET              

+5237 DD E5       ..    PUSH  IX         

+5239 E1          .     POP   HL         

+523A ED 67       .g    RRD              

+523C 23          #     INC   HL         

+523D ED 67       .g    RRD              

+523F 23          #     INC   HL         

+5240 ED 67       .g    RRD              

+5242 23          #     INC   HL         

+5243 ED 67       .g    RRD              

+5245 23          #     INC   HL         

+5246 ED 67       .g    RRD              

+5248 23          #     INC   HL         

+5249 ED 67       .g    RRD              

+524B 23          #     INC   HL         

+524C ED 67       .g    RRD              

+524E 23          #     INC   HL         

+524F C9          .     RET              

+5250 DD E5       ..    PUSH  IX         

+5252 E1          .     POP   HL         

+5253 C5          .     PUSH  BC         

+5254 01 06 00    ...   LD    BC,0006    

+5257 09          .     ADD   HL,BC      

+5258 06 07       ..    LD    B,07       

+525A 7E          ~     LD    A,(HL)     

+525B 8F          .     ADC   A          

+525C 27          '     DAA              

+525D 77          w     LD    (HL),A     

+525E 2B          +     DEC   HL         

+525F 10 F9       ..    DJNZ  525A       

+5261 C1          .     POP   BC         

+5262 C9          .     RET              

+5263 11 E6 52    ..R   LD    DE,52E6    

+5266 18 08       ..    JR    5270       

+5268 11 EE 52    ..R   LD    DE,52EE    

+526B 18 03       ..    JR    5270       

+526D 11 F6 52    ..R   LD    DE,52F6    

+5270 DD E5       ..    PUSH  IX         

+5272 E1          .     POP   HL         

+5273 01 08 00    ...   LD    BC,0008    

+5276 ED B0       ..    LDIR             

+5278 C9          .     RET              

+5279 DD E5       ..    PUSH  IX         

+527B D1          .     POP   DE         

+527C 18 F5       ..    JR    5273       

+527E DD E5       ..    PUSH  IX         

+5280 18 06       ..    JR    5288       

+5282 DD E5       ..    PUSH  IX         

+5284 18 12       ..    JR    5298       

+5286 FD E5       ..    PUSH  IY         

+5288 E1          .     POP   HL         

+5289 11 B6 52    ..R   LD    DE,52B6    

+528C CD 73 52    .sR   CALL  5273       

+528F 21 B6 52    !.R   LD    HL,52B6    

+5292 56          V     LD    D,(HL)     

+5293 CB BE       ..    RES   7,(HL)     

+5295 C9          .     RET              

+5296 FD E5       ..    PUSH  IY         

+5298 E1          .     POP   HL         

+5299 11 BE 52    ..R   LD    DE,52BE    

+529C CD 73 52    .sR   CALL  5273       

+529F 21 BE 52    !.R   LD    HL,52BE    

+52A2 5E          ^     LD    E,(HL)     

+52A3 CB BE       ..    RES   7,(HL)     

+52A5 C9          .     RET              

+52A6 06 08       ..    LD    B,08       

+52A8 DD E5       ..    PUSH  IX         

+52AA E1          .     POP   HL         

+52AB 36 00       6.    LD    (HL),00    

+52AD 23          #     INC   HL         

+52AE 10 FB       ..    DJNZ  52AB       

+52B0 B7          .     OR    A          

+52B1 C9          .     RET              

+52B2 37          7     SCF              

+52B3 C9          .     RET              

+52B4 FF          .     RST   38         

+52B5 FF          .     RST   38         

+52B6 FF          .     RST   38         

+52B7 FF          .     RST   38         

+52B8 FF          .     RST   38         

+52B9 FF          .     RST   38         

+52BA FF          .     RST   38         

+52BB FF          .     RST   38         

+52BC FF          .     RST   38         

+52BD FF          .     RST   38         

+52BE FF          .     RST   38         

+52BF FF          .     RST   38         

+52C0 FF          .     RST   38         

+52C1 FF          .     RST   38         

+52C2 FF          .     RST   38         

+52C3 FF          .     RST   38         

+52C4 FF          .     RST   38         

+52C5 FF          .     RST   38         

+52C6 FF          .     RST   38         

+52C7 FF          .     RST   38         

+52C8 FF          .     RST   38         

+52C9 FF          .     RST   38         

+52CA FF          .     RST   38         

+52CB FF          .     RST   38         

+52CC FF          .     RST   38         

+52CD FF          .     RST   38         

+52CE FF          .     RST   38         

+52CF FF          .     RST   38         

+52D0 FF          .     RST   38         

+52D1 FF          .     RST   38         

+52D2 FF          .     RST   38         

+52D3 FF          .     RST   38         

+52D4 FF          .     RST   38         

+52D5 FF          .     RST   38         

+52D6 FF          .     RST   38         

+52D7 FF          .     RST   38         

+52D8 FF          .     RST   38         

+52D9 FF          .     RST   38         

+52DA FF          .     RST   38         

+52DB FF          .     RST   38         

+52DC FF          .     RST   38         

+52DD FF          .     RST   38         

+52DE FF          .     RST   38         

+52DF FF          .     RST   38         

+52E0 FF          .     RST   38         

+52E1 FF          .     RST   38         

+52E2 FF          .     RST   38         

+52E3 FF          .     RST   38         

+52E4 FF          .     RST   38         

+52E5 FF          .     RST   38         

+52E6 FF          .     RST   38         

+52E7 FF          .     RST   38         

+52E8 FF          .     RST   38         

+52E9 FF          .     RST   38         

+52EA FF          .     RST   38         

+52EB FF          .     RST   38         

+52EC FF          .     RST   38         

+52ED FF          .     RST   38         

+52EE FF          .     RST   38         

+52EF FF          .     RST   38         

+52F0 FF          .     RST   38         

+52F1 FF          .     RST   38         

+52F2 FF          .     RST   38         

+52F3 FF          .     RST   38         

+52F4 FF          .     RST   38         

+52F5 FF          .     RST   38         

+52F6 FF          .     RST   38         

+52F7 FF          .     RST   38         

+52F8 FF          .     RST   38         

+52F9 FF          .     RST   38         

+52FA FF          .     RST   38         

+52FB FF          .     RST   38         

+52FC FF          .     RST   38         

+52FD FF          .     RST   38         

+52FE 97          .     SUB   A          

+52FF CD 93 4C    ..L   CALL  4C93       

+5302 C3 26 29    .&)   JP    2926       

+5305 C9          .     RET              

+5306 31 37 35    175   LD    SP,3537    ; "175 bitmap   2 (!)"

+5309 20 62        b    JR    NZ,536D    

+530B 69          i     LD    L,C        

+530C 74          t     LD    (HL),H     

+530D 6D          m     LD    L,L        

+530E 61          a     LD    H,C        

+530F 70          p     LD    (HL),B     

+5310 20 20             JR    NZ,5332    

+5312 20 32        2    JR    NZ,5346    

+5314 20 28        (    JR    NZ,533E    

+5316 21 29 CD    !).   LD    HL,CD29    

+5319 9D          .     SBC   L          

+531A 53          S     LD    D,E        

+531B ED 5B 46 53 .[FS  LD    DE,(5346)  

+531F 7B          {     LD    A,E        

+5320 FE 14       ..    CP    14         

+5322 D0          .     RET   NC         

+5323 CD 41 5D    .A]   CALL  5D41       

+5326 CB FD       ..    SET   7,L        

+5328 CB 8E       ..    RES   1,(HL)     

+532A CB BD       ..    RES   7,L        

+532C D5          .     PUSH  DE         

+532D 65          e     LD    H,L        

+532E CB 24       .$    SLA   H          

+5330 2E 00       ..    LD    L,00       

+5332 54          T     LD    D,H        

+5333 5D          ]     LD    E,L        

+5334 13          .     INC   DE         

+5335 01 FF 01    ...   LD    BC,01FF    

+5338 36 FF       6.    LD    (HL),FF    

+533A ED B0       ..    LDIR             

+533C D1          .     POP   DE         

+533D 1C          .     INC   E          

+533E 1C          .     INC   E          

+533F ED 53 46 53 .SFS  LD    (5346),DE  

+5343 C3 1F 53    ..S   JP    531F       

+5346 04          .     INC   B          

+5347 00          .     NOP              

+5348 C5          .     PUSH  BC         

+5349 E5          .     PUSH  HL         

+534A 42          B     LD    B,D        

+534B 4B          K     LD    C,E        

+534C CB 38       .8    SLR   B          

+534E CB 19       ..    RR    C          

+5350 CB 38       .8    SLR   B          

+5352 CB 19       ..    RR    C          

+5354 CB 38       .8    SLR   B          

+5356 CB 19       ..    RR    C          

+5358 CB 38       .8    SLR   B          

+535A CB 19       ..    RR    C          

+535C FD 21 00 00 .!..  LD    IY,0000    

+5360 2A FD 56    *.V   LD    HL,(56FD)  

+5363 D5          .     PUSH  DE         

+5364 11 08 00    ...   LD    DE,0008    

+5367 7E          ~     LD    A,(HL)     

+5368 B7          .     OR    A          

+5369 28 13       (.    JR    Z,537E     

+536B FE FF       ..    CP    FF         

+536D 28 0D       (.    JR    Z,537C     

+536F C5          .     PUSH  BC         

+5370 06 08       ..    LD    B,08       

+5372 1F          .     RRA              

+5373 30 02       0.    JR    NC,5377    

+5375 FD 23       .#    INC   IY         

+5377 10 F9       ..    DJNZ  5372       

+5379 C1          .     POP   BC         

+537A 18 02       ..    JR    537E       

+537C FD 19       ..    ADD   IY,DE      

+537E ED A1       ..    CPI              

+5380 EA 67 53    .gS   JP    PE,5367    

+5383 D1          .     POP   DE         

+5384 7B          {     LD    A,E        

+5385 1F          .     RRA              

+5386 E6 07       ..    AND   07         

+5388 28 09       (.    JR    Z,5393     

+538A 47          G     LD    B,A        

+538B 7E          ~     LD    A,(HL)     

+538C 1F          .     RRA              

+538D 30 02       0.    JR    NC,5391    

+538F FD 23       .#    INC   IY         

+5391 10 F9       ..    DJNZ  538C       

+5393 FD 29       .)    ADD   IY,HL      

+5395 FD 23       .#    INC   IY         

+5397 E1          .     POP   HL         

+5398 C1          .     POP   BC         

+5399 FD E5       ..    PUSH  IY         

+539B D1          .     POP   DE         

+539C C9          .     RET              

+539D 97          .     SUB   A          

+539E 01 05 00    ...   LD    BC,0005    

+53A1 11 00 00    ...   LD    DE,0000    

+53A4 CD A8 28    ..(   CALL  28A8       

+53A7 ED 43 0A 57 .C.W  LD    (570A),BC  

+53AB E5          .     PUSH  HL         

+53AC 60          `     LD    H,B        

+53AD 69          i     LD    L,C        

+53AE 06 06       ..    LD    B,06       

+53B0 CB 3C       .<    SLR   H          

+53B2 CB 1D       ..    RR    L          

+53B4 10 FA       ..    DJNZ  53B0       

+53B6 7D          }     LD    A,L        

+53B7 C6 28       .(    ADD   A,28       

+53B9 6F          o     LD    L,A        

+53BA 30 01       0.    JR    NC,53BD    

+53BC 24          $     INC   H          

+53BD 22 10 57    ".W   LD    (5710),HL  

+53C0 E1          .     POP   HL         

+53C1 ED 4B 0A 57 .K.W  LD    BC,(570A)  

+53C5 CB 28       .(    SRA   B          

+53C7 CB 19       ..    RR    C          

+53C9 CB 28       .(    SRA   B          

+53CB CB 19       ..    RR    C          

+53CD CB 28       .(    SRA   B          

+53CF CB 19       ..    RR    C          

+53D1 ED 43 FB 56 .C.V  LD    (56FB),BC  

+53D5 C9          .     RET              

+53D6 E5          .     PUSH  HL         

+53D7 2A FD 56    *.V   LD    HL,(56FD)  

+53DA CD DF 53    ..S   CALL  53DF       

+53DD E1          .     POP   HL         

+53DE C9          .     RET              

+53DF C5          .     PUSH  BC         

+53E0 E5          .     PUSH  HL         

+53E1 2A F9 56    *.V   LD    HL,(56F9)  

+53E4 B7          .     OR    A          

+53E5 ED 52       .R    SBC   HL,DE      

+53E7 20 10        .    JR    NZ,53F9    

+53E9 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+53EC 18 0B       ..    JR    53F9       ; " bnr gleich"

+53EE 20 62        b    JR    NZ,5452    

+53F0 6E          n     LD    L,(HL)     

+53F1 72          r     LD    (HL),D     

+53F2 20 67        g    JR    NZ,545B    

+53F4 6C          l     LD    L,H        

+53F5 65          e     LD    H,L        

+53F6 69          i     LD    L,C        

+53F7 63          c     LD    H,E        

+53F8 68          h     LD    L,B        

+53F9 E1          .     POP   HL         

+53FA ED 4B FB 56 .K.V  LD    BC,(56FB)  

+53FE F5          .     PUSH  AF         

+53FF D5          .     PUSH  DE         

+5400 CD 66 56    .fV   CALL  5666       

+5403 30 04       0.    JR    NC,5409    

+5405 19          .     ADD   HL,DE      

+5406 2F          /     CPL              

+5407 A6          .     AND   (HL)       

+5408 77          w     LD    (HL),A     

+5409 D1          .     POP   DE         

+540A F1          .     POP   AF         

+540B C1          .     POP   BC         

+540C C9          .     RET              

+540D E5          .     PUSH  HL         

+540E 2A FF 56    *.V   LD    HL,(56FF)  

+5411 CD DF 53    ..S   CALL  53DF       

+5414 E1          .     POP   HL         

+5415 C9          .     RET              

+5416 E5          .     PUSH  HL         

+5417 D5          .     PUSH  DE         

+5418 C5          .     PUSH  BC         

+5419 CD 9D 53    ..S   CALL  539D       

+541C 78          x     LD    A,B        

+541D 3C          <     INC   A          

+541E 3C          <     INC   A          

+541F CD B1 5F    .._   CALL  5FB1       

+5422 22 FD 56    ".V   LD    (56FD),HL  

+5425 CD 3A 54    .:T   CALL  543A       

+5428 22 FF 56    ".V   LD    (56FF),HL  

+542B 54          T     LD    D,H        

+542C 5D          ]     LD    E,L        

+542D 13          .     INC   DE         

+542E 36 FF       6.    LD    (HL),FF    

+5430 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5434 ED B0       ..    LDIR             

+5436 C1          .     POP   BC         

+5437 D1          .     POP   DE         

+5438 E1          .     POP   HL         

+5439 C9          .     RET              

+543A 11 04 00    ...   LD    DE,0004    

+543D ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5441 C5          .     PUSH  BC         

+5442 D5          .     PUSH  DE         

+5443 E5          .     PUSH  HL         

+5444 CD 46 81    .F.   CALL  8146       

+5447 67          g     LD    H,A        

+5448 2E 00       ..    LD    L,00       

+544A D1          .     POP   DE         

+544B 01 00 02    ...   LD    BC,0200    

+544E ED B0       ..    LDIR             

+5450 62          b     LD    H,D        

+5451 6B          k     LD    L,E        

+5452 D1          .     POP   DE         

+5453 1C          .     INC   E          

+5454 1C          .     INC   E          

+5455 C1          .     POP   BC         

+5456 05          .     DEC   B          

+5457 05          .     DEC   B          

+5458 F2 41 54    .AT   JP    P,5441     

+545B C9          .     RET              

+545C E5          .     PUSH  HL         

+545D D5          .     PUSH  DE         

+545E C5          .     PUSH  BC         

+545F F5          .     PUSH  AF         

+5460 3A 13 57    :.W   LD    A,(5713)   

+5463 B7          .     OR    A          

+5464 C2 12 55    ..U   JP    NZ,5512    

+5467 2A 08 57    *.W   LD    HL,(5708)  

+546A 22 0C 57    ".W   LD    (570C),HL  

+546D 21 04 00    !..   LD    HL,0004    

+5470 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5474 ED 5B FD 56 .[.V  LD    DE,(56FD)  

+5478 FD 21 00 00 .!..  LD    IY,0000    

+547C 3E 01       >.    LD    A,01       

+547E 32 12 57    2.W   LD    (5712),A   

+5481 E5          .     PUSH  HL         

+5482 C5          .     PUSH  BC         

+5483 D5          .     PUSH  DE         

+5484 EB          .     EX    DE,HL      

+5485 FD E5       ..    PUSH  IY         

+5487 CD 46 81    .F.   CALL  8146       

+548A FD E1       ..    POP   IY         

+548C 67          g     LD    H,A        

+548D 2E 00       ..    LD    L,00       

+548F D1          .     POP   DE         

+5490 01 00 02    ...   LD    BC,0200    

+5493 1A          .     LD    A,(DE)     

+5494 AE          .     XOR   (HL)       

+5495 77          w     LD    (HL),A     

+5496 87          .     ADD   A          

+5497 30 02       0.    JR    NC,549B    

+5499 FD 23       .#    INC   IY         

+549B 20 F9        .    JR    NZ,5496    

+549D 13          .     INC   DE         

+549E ED A1       ..    CPI              

+54A0 EA 93 54    ..T   JP    PE,5493    

+54A3 C1          .     POP   BC         

+54A4 E1          .     POP   HL         

+54A5 2C          ,     INC   L          

+54A6 2C          ,     INC   L          

+54A7 05          .     DEC   B          

+54A8 05          .     DEC   B          

+54A9 F2 81 54    ..T   JP    P,5481     

+54AC 2A 0C 57    *.W   LD    HL,(570C)  

+54AF ED 4B 08 57 .K.W  LD    BC,(5708)  

+54B3 B7          .     OR    A          

+54B4 ED 42       .B    SBC   HL,BC      

+54B6 FD E5       ..    PUSH  IY         

+54B8 C1          .     POP   BC         

+54B9 09          .     ADD   HL,BC      

+54BA 44          D     LD    B,H        

+54BB 4D          M     LD    C,L        

+54BC 2A 0A 57    *.W   LD    HL,(570A)  

+54BF B7          .     OR    A          

+54C0 ED 42       .B    SBC   HL,BC      

+54C2 30 0C       0.    JR    NC,54D0    

+54C4 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+54C7 18 07       ..    JR    54D0       ; " HGVOLL"

+54C9 20 48        H    JR    NZ,5513    

+54CB 47          G     LD    B,A        

+54CC 56          V     LD    D,(HL)     

+54CD 4F          O     LD    C,A        

+54CE 4C          L     LD    C,H        

+54CF 4C          L     LD    C,H        

+54D0 ED 4B 10 57 .K.W  LD    BC,(5710)  

+54D4 ED 42       .B    SBC   HL,BC      

+54D6 22 08 57    ".W   LD    (5708),HL  

+54D9 B7          .     OR    A          

+54DA 01 14 00    ...   LD    BC,0014    

+54DD ED 42       .B    SBC   HL,BC      

+54DF 3E 00       >.    LD    A,00       

+54E1 DC FA 54    ..T   CALL  C,54FA     

+54E4 32 13 57    2.W   LD    (5713),A   

+54E7 CD CD 5F    .._   CALL  5FCD       

+54EA 11 04 00    ...   LD    DE,0004    

+54ED ED 53 0E 57 .S.W  LD    (570E),DE  

+54F1 97          .     SUB   A          

+54F2 32 12 57    2.W   LD    (5712),A   

+54F5 F1          .     POP   AF         

+54F6 C1          .     POP   BC         

+54F7 D1          .     POP   DE         

+54F8 E1          .     POP   HL         

+54F9 C9          .     RET              

+54FA 2A 08 57    *.W   LD    HL,(5708)  

+54FD ED 4B 10 57 .K.W  LD    BC,(5710)  

+5501 09          .     ADD   HL,BC      

+5502 22 08 57    ".W   LD    (5708),HL  

+5505 21 81 18    !..   LD    HL,1881    

+5508 06 7D       .}    LD    B,7D       

+550A CB CE       ..    SET   1,(HL)     

+550C 23          #     INC   HL         

+550D 10 FB       ..    DJNZ  550A       

+550F 3E 01       >.    LD    A,01       

+5511 C9          .     RET              

+5512 2A FD 56    *.V   LD    HL,(56FD)  

+5515 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5519 11 00 00    ...   LD    DE,0000    

+551C 7E          ~     LD    A,(HL)     

+551D 87          .     ADD   A          

+551E 30 01       0.    JR    NC,5521    

+5520 13          .     INC   DE         

+5521 20 FA        .    JR    NZ,551D    

+5523 ED A1       ..    CPI              

+5525 EA 1C 55    ..U   JP    PE,551C    

+5528 62          b     LD    H,D        

+5529 6B          k     LD    L,E        

+552A B7          .     OR    A          

+552B ED 5B 10 57 .[.W  LD    DE,(5710)  

+552F ED 52       .R    SBC   HL,DE      

+5531 3E 00       >.    LD    A,00       

+5533 CE 00       ..    ADC   A,00       

+5535 32 13 57    2.W   LD    (5713),A   

+5538 20 0F        .    JR    NZ,5549    

+553A 21 17 82    !..   LD    HL,8217    

+553D 36 03       6.    LD    (HL),03    

+553F 06 7D       .}    LD    B,7D       

+5541 21 81 18    !..   LD    HL,1881    

+5544 CB 8E       ..    RES   1,(HL)     

+5546 23          #     INC   HL         

+5547 10 FB       ..    DJNZ  5544       

+5549 CD CD 5F    .._   CALL  5FCD       

+554C 18 A3       ..    JR    54F1       

+554E 21 12 57    !.W   LD    HL,5712    

+5551 7E          ~     LD    A,(HL)     

+5552 B7          .     OR    A          

+5553 C2 1A 6C    ..l   JP    NZ,6C1A    

+5556 D5          .     PUSH  DE         

+5557 C5          .     PUSH  BC         

+5558 2A 08 57    *.W   LD    HL,(5708)  

+555B 2B          +     DEC   HL         

+555C CB 7C       .|    BIT   7,H        

+555E 28 07       (.    JR    Z,5567     

+5560 CD 0E 6E    ..n   CALL  6E0E       

+5563 FE 4D       .M    CP    4D         

+5565 20 63        c    JR    NZ,55CA    

+5567 22 08 57    ".W   LD    (5708),HL  

+556A ED 5B 0E 57 .[.W  LD    DE,(570E)  

+556E CD 41 5D    .A]   CALL  5D41       

+5571 CB FD       ..    SET   7,L        

+5573 CB 8E       ..    RES   1,(HL)     

+5575 65          e     LD    H,L        

+5576 2E 00       ..    LD    L,00       

+5578 CB 24       .$    SLA   H          

+557A 01 00 02    ...   LD    BC,0200    

+557D CD F7 55    ..U   CALL  55F7       

+5580 30 22       0"    JR    NC,55A4    

+5582 ED 5B 0E 57 .[.W  LD    DE,(570E)  

+5586 7B          {     LD    A,E        

+5587 D6 04       ..    SUB   A,04       

+5589 87          .     ADD   A          

+558A 87          .     ADD   A          

+558B 87          .     ADD   A          

+558C 87          .     ADD   A          

+558D 1E 00       ..    LD    E,00       

+558F 57          W     LD    D,A        

+5590 19          .     ADD   HL,DE      

+5591 ED 5B 0A 57 .[.W  LD    DE,(570A)  

+5595 CB 23       .#    SLA   E          

+5597 CB 12       ..    RL    D          

+5599 B7          .     OR    A          

+559A E5          .     PUSH  HL         

+559B ED 52       .R    SBC   HL,DE      

+559D E1          .     POP   HL         

+559E 30 10       0.    JR    NC,55B0    

+55A0 C1          .     POP   BC         

+55A1 D1          .     POP   DE         

+55A2 B7          .     OR    A          

+55A3 C9          .     RET              

+55A4 ED 5B 0E 57 .[.W  LD    DE,(570E)  

+55A8 1C          .     INC   E          

+55A9 1C          .     INC   E          

+55AA ED 53 0E 57 .S.W  LD    (570E),DE  

+55AE 18 BA       ..    JR    556A       

+55B0 CD 0E 6E    ..n   CALL  6E0E       

+55B3 FE 4D       .M    CP    4D         ; Muell-Prozess ?

+55B5 20 04        .    JR    NZ,55BB    

+55B7 C1          .     POP   BC         

+55B8 D1          .     POP   DE         

+55B9 37          7     SCF              

+55BA C9          .     RET              

+55BB CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+55BE 18 08       ..    JR    55C8       ; " HG voll"

+55C0 20 48        H    JR    NZ,560A    

+55C2 47          G     LD    B,A        

+55C3 20 76        v    JR    NZ,563B    

+55C5 6F          o     LD    L,A        

+55C6 6C          l     LD    L,H        

+55C7 6C          l     LD    L,H        

+55C8 18 F1       ..    JR    55BB       

+55CA 21 17 82    !..   LD    HL,8217    

+55CD 7E          ~     LD    A,(HL)     

+55CE B7          .     OR    A          

+55CF CB C6       ..    SET   0,(HL)     

+55D1 20 03        .    JR    NZ,55D6    

+55D3 3E 03       >.    LD    A,03       

+55D5 77          w     LD    (HL),A     

+55D6 C3 1A 6C    ..l   JP    6C1A       

+55D9 D5          .     PUSH  DE         

+55DA E5          .     PUSH  HL         

+55DB EB          .     EX    DE,HL      

+55DC 01 00 01    ...   LD    BC,0100    

+55DF CD F7 55    ..U   CALL  55F7       

+55E2 44          D     LD    B,H        

+55E3 4D          M     LD    C,L        

+55E4 E1          .     POP   HL         

+55E5 D1          .     POP   DE         

+55E6 C9          .     RET              

+55E7 D5          .     PUSH  DE         

+55E8 C5          .     PUSH  BC         

+55E9 2A FF 56    *.V   LD    HL,(56FF)  

+55EC ED 4B FB 56 .K.V  LD    BC,(56FB)  

+55F0 03          .     INC   BC         

+55F1 CD F7 55    ..U   CALL  55F7       

+55F4 C1          .     POP   BC         

+55F5 D1          .     POP   DE         

+55F6 C9          .     RET              

+55F7 E5          .     PUSH  HL         

+55F8 3E FF       >.    LD    A,FF       

+55FA 03          .     INC   BC         

+55FB ED A1       ..    CPI              

+55FD E2 2B 56    .+V   JP    PO,562B    

+5600 28 F9       (.    JR    Z,55FB     

+5602 2B          +     DEC   HL         

+5603 06 08       ..    LD    B,08       

+5605 CB 1E       ..    RR    (HL)       

+5607 30 02       0.    JR    NC,560B    

+5609 10 FA       ..    DJNZ  5605       

+560B 3E 08       >.    LD    A,08       

+560D 90          .     SUB   B          

+560E 37          7     SCF              

+560F CB 1E       ..    RR    (HL)       

+5611 10 FC       ..    DJNZ  560F       

+5613 C1          .     POP   BC         

+5614 B7          .     OR    A          

+5615 ED 42       .B    SBC   HL,BC      

+5617 CB 25       .%    SLA   L          

+5619 CB 14       ..    RL    H          

+561B CB 25       .%    SLA   L          

+561D CB 14       ..    RL    H          

+561F CB 25       .%    SLA   L          

+5621 CB 14       ..    RL    H          

+5623 B5          .     OR    L          

+5624 6F          o     LD    L,A        

+5625 CB 25       .%    SLA   L          

+5627 CB 14       ..    RL    H          

+5629 37          7     SCF              

+562A C9          .     RET              

+562B E1          .     POP   HL         

+562C B7          .     OR    A          

+562D C9          .     RET              

+562E E5          .     PUSH  HL         

+562F 2A 08 57    *.W   LD    HL,(5708)  

+5632 CB 3C       .<    SLR   H          

+5634 CB 1D       ..    RR    L          

+5636 B7          .     OR    A          

+5637 ED 42       .B    SBC   HL,BC      

+5639 E1          .     POP   HL         

+563A D0          .     RET   NC         

+563B CD 20 6E    . n   CALL  6E20       

+563E C5          .     PUSH  BC         

+563F 3A 17 82    :..   LD    A,(8217)   

+5642 BA          .     CP    D          

+5643 28 09       (.    JR    Z,564E     

+5645 D5          .     PUSH  DE         

+5646 CD C1 81    ...   CALL  81C1       

+5649 D1          .     POP   DE         

+564A 7A          z     LD    A,D        

+564B 32 17 82    2..   LD    (8217),A   

+564E CD C1 81    ...   CALL  81C1       

+5651 CD CC 56    ..V   CALL  56CC       

+5654 B7          .     OR    A          

+5655 ED 42       .B    SBC   HL,BC      

+5657 C1          .     POP   BC         

+5658 ED 42       .B    SBC   HL,BC      

+565A 38 05       8.    JR    C,5661     

+565C CD 2A 6E    .*n   CALL  6E2A       

+565F B7          .     OR    A          

+5660 C9          .     RET              

+5661 CD 2A 6E    .*n   CALL  6E2A       

+5664 37          7     SCF              

+5665 C9          .     RET              

+5666 CB 3A       .:    SLR   D          

+5668 CB 1B       ..    RR    E          

+566A 7B          {     LD    A,E        

+566B E6 07       ..    AND   07         

+566D CB 3A       .:    SLR   D          

+566F CB 1B       ..    RR    E          

+5671 CB 3A       .:    SLR   D          

+5673 CB 1B       ..    RR    E          

+5675 CB 3A       .:    SLR   D          

+5677 CB 1B       ..    RR    E          

+5679 E5          .     PUSH  HL         

+567A 21 14 57    !.W   LD    HL,5714    

+567D 85          .     ADD   L          

+567E 6F          o     LD    L,A        

+567F 30 01       0.    JR    NC,5682    

+5681 24          $     INC   H          

+5682 7E          ~     LD    A,(HL)     

+5683 60          `     LD    H,B        

+5684 69          i     LD    L,C        

+5685 B7          .     OR    A          

+5686 ED 52       .R    SBC   HL,DE      

+5688 30 1B       0.    JR    NC,56A5    

+568A CD 1F 70    ..p   CALL  701F       

+568D 18 10       ..    JR    569F       

+568F 20 66        f    JR    NZ,56F7    ; Info aufrufen 

+5691 61          a     LD    H,C        ; " falsches setbit"

+5692 6C          l     LD    L,H        

+5693 73          s     LD    (HL),E     

+5694 63          c     LD    H,E        

+5695 68          h     LD    L,B        

+5696 65          e     LD    H,L        

+5697 73          s     LD    (HL),E     

+5698 20 73        s    JR    NZ,570D    

+569A 65          e     LD    H,L        

+569B 74          t     LD    (HL),H     

+569C 62          b     LD    H,D        

+569D 69          i     LD    L,C        

+569E 74          t     LD    (HL),H     

+569F E1          .     POP   HL         

+56A0 11 00 00    ...   LD    DE,0000    

+56A3 AF          .     XOR   A          

+56A4 C9          .     RET              

+56A5 E1          .     POP   HL         

+56A6 37          7     SCF              

+56A7 C9          .     RET              

+56A8 E5          .     PUSH  HL         

+56A9 D5          .     PUSH  DE         

+56AA C5          .     PUSH  BC         

+56AB ED 4B FB 56 .K.V  LD    BC,(56FB)  

+56AF CD 66 56    .fV   CALL  5666       

+56B2 F5          .     PUSH  AF         

+56B3 D5          .     PUSH  DE         

+56B4 7A          z     LD    A,D        

+56B5 C6 04       ..    ADD   A,04       

+56B7 5F          _     LD    E,A        

+56B8 16 00       ..    LD    D,00       

+56BA CD 46 81    .F.   CALL  8146       

+56BD 67          g     LD    H,A        

+56BE 2E 00       ..    LD    L,00       

+56C0 D1          .     POP   DE         

+56C1 7A          z     LD    A,D        

+56C2 E6 01       ..    AND   01         

+56C4 57          W     LD    D,A        

+56C5 F1          .     POP   AF         

+56C6 19          .     ADD   HL,DE      

+56C7 A6          .     AND   (HL)       

+56C8 C1          .     POP   BC         

+56C9 D1          .     POP   DE         

+56CA E1          .     POP   HL         

+56CB C9          .     RET              

+56CC 2A 0A 57    *.W   LD    HL,(570A)  

+56CF ED 4B 10 57 .K.W  LD    BC,(5710)  

+56D3 B7          .     OR    A          

+56D4 ED 42       .B    SBC   HL,BC      

+56D6 ED 4B 08 57 .K.W  LD    BC,(5708)  

+56DA E5          .     PUSH  HL         

+56DB ED 42       .B    SBC   HL,BC      

+56DD 3A 13 57    :.W   LD    A,(5713)   

+56E0 B7          .     OR    A          

+56E1 28 05       (.    JR    Z,56E8     

+56E3 ED 4B 10 57 .K.W  LD    BC,(5710)  

+56E7 09          .     ADD   HL,BC      

+56E8 44          D     LD    B,H        

+56E9 4D          M     LD    C,L        

+56EA E1          .     POP   HL         

+56EB CB 3C       .<    SLR   H          

+56ED CB 1D       ..    RR    L          

+56EF CB 38       .8    SLR   B          

+56F1 CB 19       ..    RR    C          

+56F3 C9          .     RET              

+56F4 76          v     HALT             ; "vergl"

+56F5 65          e     LD    H,L        

+56F6 72          r     LD    (HL),D     

+56F7 67          g     LD    H,A        

+56F8 6C          l     LD    L,H        

+56F9 FF          .     RST   38         

+56FA FF          .     RST   38         

+56FB 00          .     NOP              

+56FC 00          .     NOP              

+56FD 00          .     NOP              

+56FE 00          .     NOP              

+56FF 00          .     NOP              

+5700 00          .     NOP              

+5701 68          h     LD    L,B        ; "hgfrei"

+5702 67          g     LD    H,A        

+5703 66          f     LD    H,(HL)     

+5704 72          r     LD    (HL),D     

+5705 65          e     LD    H,L        

+5706 69          i     LD    L,C        

+5707 20 00        .    JR    NZ,5709    

+5709 00          .     NOP              

+570A E8          .     RET   PE         

+570B 03          .     INC   BC         

+570C 00          .     NOP              

+570D 00          .     NOP              

+570E 04          .     INC   B          

+570F 00          .     NOP              

+5710 2E 00       ..    LD    L,00       

+5712 00          .     NOP              

+5713 00          .     NOP              

+5714 01 02 04    ...   LD    BC,0402    

+5717 08          .     EX    AF,AF'     

+5718 10 20       .     DJNZ  573A       

+571A 40          @     LD    B,B        

+571B 80          .     ADD   B          

+571C 31 37 35    175   LD    SP,3537    ; "175 lader   2 (!)"

+571F 20 6C        l    JR    NZ,578D    

+5721 61          a     LD    H,C        

+5722 64          d     LD    H,H        

+5723 65          e     LD    H,L        

+5724 72          r     LD    (HL),D     

+5725 20 20             JR    NZ,5747    

+5727 20 32        2    JR    NZ,575B    

+5729 20 28        (    JR    NZ,5753    

+572B 21 29 3E    !)>   LD    HL,3E29    

+572E FE 32       .2    CP    32         

+5730 27          '     DAA              

+5731 16 CD       ..    LD    D,CD       

+5733 A0          .     AND   B          

+5734 28 CD       (.    JR    Z,5703     

+5736 78          x     LD    A,B        

+5737 82          .     ADD   D          

+5738 2B          +     DEC   HL         

+5739 6C          l     LD    L,H        

+573A 37          7     SCF              

+573B CB 1D       ..    RR    L          

+573D 2C          ,     INC   L          

+573E 26 15       &.    LD    H,15       

+5740 22 9F 60    ".`   LD    (609F),HL  

+5743 13          .     INC   DE         

+5744 7A          z     LD    A,D        

+5745 37          7     SCF              

+5746 CB 1F       ..    RR    A          

+5748 32 A1 60    2.`   LD    (60A1),A   

+574B 21 CF 15    !..   LD    HL,15CF    

+574E CB C6       ..    SET   0,(HL)     

+5750 21 00 14    !..   LD    HL,1400    

+5753 11 01 14    ...   LD    DE,1401    

+5756 01 FF 00    ...   LD    BC,00FF    

+5759 36 80       6.    LD    (HL),80    

+575B ED B0       ..    LDIR             

+575D 21 7D 82    !}.   LD    HL,827D    

+5760 CD CA 6E    ..n   CALL  6ECA       

+5763 CD 8B 59    ..Y   CALL  598B       

+5766 CD 85 64    ..d   CALL  6485       

+5769 C9          .     RET              

+576A 50          P     LD    D,B        ; "PROZ LADER"

+576B 52          R     LD    D,D        

+576C 4F          O     LD    C,A        

+576D 5A          Z     LD    E,D        

+576E 20 4C        L    JR    NZ,57BC    

+5770 41          A     LD    B,C        

+5771 44          D     LD    B,H        

+5772 45          E     LD    B,L        

+5773 52          R     LD    D,D        

+5774 42          B     LD    B,D        

+5775 58          X     LD    E,B        

+5776 C3 A5 5F    .._   JP    5FA5       

+5779 4C          L     LD    C,H        

+577A FF          .     RST   38         

+577B FF          .     RST   38         

+577C FF          .     RST   38         

+577D FF          .     RST   38         

+577E FF          .     RST   38         

+577F FF          .     RST   38         

+5780 FF          .     RST   38         

+5781 FF          .     RST   38         

+5782 FF          .     RST   38         

+5783 FF          .     RST   38         

+5784 FF          .     RST   38         

+5785 FF          .     RST   38         

+5786 FF          .     RST   38         

+5787 FF          .     RST   38         

+5788 FF          .     RST   38         

+5789 FF          .     RST   38         

+578A FF          .     RST   38         

+578B FF          .     RST   38         

+578C FF          .     RST   38         

+578D FF          .     RST   38         

+578E FF          .     RST   38         

+578F FF          .     RST   38         

+5790 FF          .     RST   38         

+5791 FF          .     RST   38         

+5792 FF          .     RST   38         

+5793 FF          .     RST   38         

+5794 FF          .     RST   38         

+5795 FF          .     RST   38         

+5796 FF          .     RST   38         

+5797 FF          .     RST   38         

+5798 FF          .     RST   38         

+5799 FF          .     RST   38         

+579A FF          .     RST   38         

+579B FF          .     RST   38         

+579C FF          .     RST   38         

+579D FF          .     RST   38         

+579E FF          .     RST   38         

+579F FF          .     RST   38         

+57A0 FF          .     RST   38         

+57A1 FF          .     RST   38         

+57A2 FF          .     RST   38         

+57A3 FF          .     RST   38         

+57A4 FF          .     RST   38         

+57A5 FF          .     RST   38         

+57A6 FF          .     RST   38         

+57A7 FF          .     RST   38         

+57A8 FF          .     RST   38         

+57A9 FF          .     RST   38         

+57AA FF          .     RST   38         

+57AB FF          .     RST   38         

+57AC FF          .     RST   38         

+57AD FF          .     RST   38         

+57AE FF          .     RST   38         

+57AF FF          .     RST   38         

+57B0 FF          .     RST   38         

+57B1 FF          .     RST   38         

+57B2 FF          .     RST   38         

+57B3 FF          .     RST   38         

+57B4 FF          .     RST   38         

+57B5 FF          .     RST   38         

+57B6 FF          .     RST   38         

+57B7 FF          .     RST   38         

+57B8 FF          .     RST   38         

+57B9 FF          .     RST   38         

+57BA FF          .     RST   38         

+57BB FF          .     RST   38         

+57BC FF          .     RST   38         

+57BD FF          .     RST   38         

+57BE FF          .     RST   38         

+57BF FF          .     RST   38         

+57C0 FF          .     RST   38         

+57C1 FF          .     RST   38         

+57C2 FF          .     RST   38         

+57C3 FF          .     RST   38         

+57C4 FF          .     RST   38         

+57C5 FF          .     RST   38         

+57C6 FF          .     RST   38         

+57C7 FF          .     RST   38         

+57C8 FF          .     RST   38         

+57C9 FF          .     RST   38         

+57CA FF          .     RST   38         

+57CB FF          .     RST   38         

+57CC FF          .     RST   38         

+57CD FF          .     RST   38         

+57CE FF          .     RST   38         

+57CF FF          .     RST   38         

+57D0 FF          .     RST   38         

+57D1 FF          .     RST   38         

+57D2 FF          .     RST   38         

+57D3 FF          .     RST   38         

+57D4 FF          .     RST   38         

+57D5 FF          .     RST   38         

+57D6 FF          .     RST   38         

+57D7 FF          .     RST   38         

+57D8 FF          .     RST   38         

+57D9 FF          .     RST   38         

+57DA FF          .     RST   38         

+57DB FF          .     RST   38         

+57DC FF          .     RST   38         

+57DD FF          .     RST   38         

+57DE FF          .     RST   38         

+57DF FF          .     RST   38         

+57E0 FF          .     RST   38         

+57E1 FF          .     RST   38         

+57E2 FF          .     RST   38         

+57E3 FF          .     RST   38         

+57E4 FF          .     RST   38         

+57E5 FF          .     RST   38         

+57E6 FF          .     RST   38         

+57E7 FF          .     RST   38         

+57E8 FF          .     RST   38         

+57E9 FF          .     RST   38         

+57EA FF          .     RST   38         

+57EB FF          .     RST   38         

+57EC FF          .     RST   38         

+57ED FF          .     RST   38         

+57EE FF          .     RST   38         

+57EF FF          .     RST   38         

+57F0 FF          .     RST   38         

+57F1 FF          .     RST   38         

+57F2 FF          .     RST   38         

+57F3 FF          .     RST   38         

+57F4 FF          .     RST   38         

+57F5 FF          .     RST   38         

+57F6 FF          .     RST   38         

+57F7 FF          .     RST   38         

+57F8 FF          .     RST   38         

+57F9 FF          .     RST   38         

+57FA FF          .     RST   38         

+57FB FF          .     RST   38         

+57FC FF          .     RST   38         

+57FD FF          .     RST   38         

+57FE FF          .     RST   38         

+57FF FF          .     RST   38         

+5800 FF          .     RST   38         

+5801 FF          .     RST   38         

+5802 FF          .     RST   38         

+5803 FF          .     RST   38         

+5804 FF          .     RST   38         

+5805 FF          .     RST   38         

+5806 FF          .     RST   38         

+5807 FF          .     RST   38         

+5808 FF          .     RST   38         

+5809 FF          .     RST   38         

+580A FF          .     RST   38         

+580B FF          .     RST   38         

+580C FF          .     RST   38         

+580D FF          .     RST   38         

+580E FF          .     RST   38         

+580F FF          .     RST   38         

+5810 FF          .     RST   38         

+5811 FF          .     RST   38         

+5812 FF          .     RST   38         

+5813 FF          .     RST   38         

+5814 FF          .     RST   38         

+5815 FF          .     RST   38         

+5816 FF          .     RST   38         

+5817 FF          .     RST   38         

+5818 FF          .     RST   38         

+5819 FF          .     RST   38         

+581A FF          .     RST   38         

+581B FF          .     RST   38         

+581C FF          .     RST   38         

+581D FF          .     RST   38         

+581E FF          .     RST   38         

+581F FF          .     RST   38         

+5820 FF          .     RST   38         

+5821 FF          .     RST   38         

+5822 FF          .     RST   38         

+5823 FF          .     RST   38         

+5824 FF          .     RST   38         

+5825 FF          .     RST   38         

+5826 FF          .     RST   38         

+5827 FF          .     RST   38         

+5828 FF          .     RST   38         

+5829 FF          .     RST   38         

+582A FF          .     RST   38         

+582B FF          .     RST   38         

+582C FF          .     RST   38         

+582D FF          .     RST   38         

+582E FF          .     RST   38         

+582F FF          .     RST   38         

+5830 FF          .     RST   38         

+5831 FF          .     RST   38         

+5832 FF          .     RST   38         

+5833 FF          .     RST   38         

+5834 FF          .     RST   38         

+5835 FF          .     RST   38         

+5836 FF          .     RST   38         

+5837 FF          .     RST   38         

+5838 FF          .     RST   38         

+5839 FF          .     RST   38         

+583A FF          .     RST   38         

+583B FF          .     RST   38         

+583C FF          .     RST   38         

+583D FF          .     RST   38         

+583E FF          .     RST   38         

+583F FF          .     RST   38         

+5840 FF          .     RST   38         

+5841 FF          .     RST   38         

+5842 44          D     LD    B,H        

+5843 58          X     LD    E,B        

+5844 21 B5 4C    !.L   LD    HL,4CB5    

+5847 CB 96       ..    RES   2,(HL)     

+5849 CD E2 6D    ..m   CALL  6DE2       

+584C 3A 96 60    :.`   LD    A,(6096)   

+584F B7          .     OR    A          

+5850 28 15       (.    JR    Z,5867     

+5852 FE 02       ..    CP    02         

+5854 28 2C       (,    JR    Z,5882     

+5856 2A 97 60    *.`   LD    HL,(6097)  

+5859 CB 46       .F    BIT   0,(HL)     

+585B 20 0A        .    JR    NZ,5867    

+585D CD 1C 59    ..Y   CALL  591C       

+5860 2A 97 60    *.`   LD    HL,(6097)  

+5863 CB CE       ..    SET   1,(HL)     

+5865 18 2A       .*    JR    5891       

+5867 3A 99 60    :.`   LD    A,(6099)   

+586A B7          .     OR    A          

+586B 28 28       ((    JR    Z,5895     

+586D 2A 9A 60    *.`   LD    HL,(609A)  

+5870 CB 46       .F    BIT   0,(HL)     

+5872 20 21        !    JR    NZ,5895    

+5874 CD 1C 59    ..Y   CALL  591C       

+5877 2A 9A 60    *.`   LD    HL,(609A)  

+587A CB CE       ..    SET   1,(HL)     

+587C 97          .     SUB   A          

+587D 32 99 60    2.`   LD    (6099),A   

+5880 18 13       ..    JR    5895       

+5882 3A 5B 60    :[`   LD    A,(605B)   

+5885 B7          .     OR    A          

+5886 28 09       (.    JR    Z,5891     

+5888 CD 96 5C    ..\   CALL  5C96       

+588B 20 08        .    JR    NZ,5895    

+588D 97          .     SUB   A          

+588E 32 B3 60    2.`   LD    (60B3),A   

+5891 97          .     SUB   A          

+5892 32 96 60    2.`   LD    (6096),A   

+5895 3A 1F 16    :..   LD    A,(161F)   

+5898 FE FD       ..    CP    FD         

+589A 28 14       (.    JR    Z,58B0     

+589C 21 CE 15    !..   LD    HL,15CE    

+589F CB 46       .F    BIT   0,(HL)     

+58A1 20 0D        .    JR    NZ,58B0    

+58A3 57          W     LD    D,A        

+58A4 3A 1F 15    :..   LD    A,(151F)   

+58A7 5F          _     LD    E,A        

+58A8 CD 45 59    .EY   CALL  5945       

+58AB 3E FD       >.    LD    A,FD       

+58AD 32 1F 16    2..   LD    (161F),A   

+58B0 3A A4 60    :.`   LD    A,(60A4)   

+58B3 B7          .     OR    A          

+58B4 28 2E       (.    JR    Z,58E4     

+58B6 3A 63 60    :c`   LD    A,(6063)   

+58B9 B7          .     OR    A          

+58BA CA 44 58    .DX   JP    Z,5844     

+58BD CD F7 58    ..X   CALL  58F7       

+58C0 22 9D 60    ".`   LD    (609D),HL  

+58C3 21 B5 4C    !.L   LD    HL,4CB5    

+58C6 CB D6       ..    SET   2,(HL)     

+58C8 2A B1 60    *.`   LD    HL,(60B1)  

+58CB 56          V     LD    D,(HL)     

+58CC 25          %     DEC   H          

+58CD 5E          ^     LD    E,(HL)     

+58CE ED 53 A7 60 .S.`  LD    (60A7),DE  

+58D2 2A 9D 60    *.`   LD    HL,(609D)  

+58D5 CD 45 59    .EY   CALL  5945       

+58D8 2A B1 60    *.`   LD    HL,(60B1)  

+58DB 36 FD       6.    LD    (HL),FD    

+58DD 21 63 60    !c`   LD    HL,6063    

+58E0 35          5     DEC   (HL)       

+58E1 C3 95 58    ..X   JP    5895       

+58E4 CD F4 5B    ..[   CALL  5BF4       

+58E7 20 03        .    JR    NZ,58EC    

+58E9 11 00 00    ...   LD    DE,0000    

+58EC ED 53 A5 60 .S.`  LD    (60A5),DE  

+58F0 3E 02       >.    LD    A,02       

+58F2 32 A4 60    2.`   LD    (60A4),A   

+58F5 18 B9       ..    JR    58B0       

+58F7 06 08       ..    LD    B,08       

+58F9 2A 9D 60    *.`   LD    HL,(609D)  

+58FC CD 3C 5F    .<_   CALL  5F3C       

+58FF CB 46       .F    BIT   0,(HL)     

+5901 20 F9        .    JR    NZ,58FC    

+5903 CB 5E       .^    BIT   3,(HL)     

+5905 28 02       (.    JR    Z,5909     

+5907 10 F0       ..    DJNZ  58F9       

+5909 E5          .     PUSH  HL         

+590A 06 02       ..    LD    B,02       

+590C CD 3C 5F    .<_   CALL  5F3C       

+590F 10 FB       ..    DJNZ  590C       

+5911 06 08       ..    LD    B,08       

+5913 CB 9E       ..    RES   3,(HL)     

+5915 CD 3C 5F    .<_   CALL  5F3C       

+5918 10 F9       ..    DJNZ  5913       

+591A E1          .     POP   HL         

+591B C9          .     RET              

+591C CB C6       ..    SET   0,(HL)     

+591E CB 96       ..    RES   2,(HL)     

+5920 CB 4E       .N    BIT   1,(HL)     

+5922 20 09        .    JR    NZ,592D    

+5924 C3 10 5B    ..[   JP    5B10       

+5927 3E 02       >.    LD    A,02       

+5929 CB 4E       .N    BIT   1,(HL)     

+592B 28 02       (.    JR    Z,592F     

+592D 3E 03       >.    LD    A,03       

+592F CB BD       ..    RES   7,L        

+5931 5E          ^     LD    E,(HL)     

+5932 24          $     INC   H          

+5933 56          V     LD    D,(HL)     

+5934 65          e     LD    H,L        

+5935 CB 24       .$    SLA   H          

+5937 2E 00       ..    LD    L,00       

+5939 FE 03       ..    CP    03         

+593B C8          .     RET   Z          

+593C 7A          z     LD    A,D        

+593D FE FD       ..    CP    FD         

+593F D0          .     RET   NC         

+5940 3E 02       >.    LD    A,02       

+5942 C3 82 5E    ..^   JP    5E82       

+5945 E5          .     PUSH  HL         

+5946 CB 96       ..    RES   2,(HL)     

+5948 D5          .     PUSH  DE         

+5949 CD 1C 59    ..Y   CALL  591C       

+594C D1          .     POP   DE         

+594D E3          .     EX    (SP),HL    

+594E 24          $     INC   H          

+594F 36 FF       6.    LD    (HL),FF    

+5951 25          %     DEC   H          

+5952 E3          .     EX    (SP),HL    

+5953 7A          z     LD    A,D        

+5954 FE FF       ..    CP    FF         

+5956 20 16        .    JR    NZ,596E    

+5958 D5          .     PUSH  DE         

+5959 36 FF       6.    LD    (HL),FF    

+595B 54          T     LD    D,H        

+595C 5D          ]     LD    E,L        

+595D 13          .     INC   DE         

+595E 01 FF 01    ...   LD    BC,01FF    

+5961 CD A5 28    ..(   CALL  28A5       

+5964 D1          .     POP   DE         

+5965 E1          .     POP   HL         

+5966 36 02       6.    LD    (HL),02    

+5968 CB BD       ..    RES   7,L        

+596A 73          s     LD    (HL),E     

+596B 24          $     INC   H          

+596C 72          r     LD    (HL),D     

+596D C9          .     RET              

+596E CD E9 5A    ..Z   CALL  5AE9       

+5971 28 F2       (.    JR    Z,5965     

+5973 3E 01       >.    LD    A,01       

+5975 CD 82 5E    ..^   CALL  5E82       

+5978 7C          |     LD    A,H        

+5979 FE 9C       ..    CP    9C         

+597B 28 E8       (.    JR    Z,5965     

+597D E1          .     POP   HL         

+597E E5          .     PUSH  HL         

+597F CD 68 59    .hY   CALL  5968       

+5982 E1          .     POP   HL         

+5983 E5          .     PUSH  HL         

+5984 CD 10 5B    ..[   CALL  5B10       

+5987 E1          .     POP   HL         

+5988 36 02       6.    LD    (HL),02    

+598A C9          .     RET              

+598B CD 8A 28    ..(   CALL  288A       

+598E 22 AB 60    ".`   LD    (60AB),HL  

+5991 CB 78       .x    BIT   7,B        

+5993 28 0D       (.    JR    Z,59A2     

+5995 3E C3       >.    LD    A,C3       ; JP ... 

+5997 32 95 5A    2.Z   LD    (5A95),A   

+599A 21 8D 28    !.(   LD    HL,288D    ; SCHACC

+599D 22 96 5A    ".Z   LD    (5A96),HL  

+59A0 CB B8       ..    RES   7,B        

+59A2 CB 70       .p    BIT   6,B        

+59A4 28 22       ("    JR    Z,59C8     

+59A6 21 FF FF    !..   LD    HL,FFFF    

+59A9 22 5C 60    "\`   LD    (605C),HL  

+59AC 3E C9       >.    LD    A,C9       ; RET

+59AE 32 95 5A    2.Z   LD    (5A95),A   

+59B1 3E C3       >.    LD    A,C3       ; JP ...

+59B3 32 A8 5A    2.Z   LD    (5AA8),A   

+59B6 21 8D 28    !.(   LD    HL,288D    ; SCHACC

+59B9 3A 6B 28    :k(   LD    A,(286B)   

+59BC FE 06       ..    CP    06         

+59BE 38 03       8.    JR    C,59C3     

+59C0 21 BD 5A    !.Z   LD    HL,5ABD    

+59C3 22 A9 5A    ".Z   LD    (5AA9),HL  

+59C6 CB B0       ..    RES   6,B        

+59C8 CB 21       .!    SLA   C          

+59CA CB 10       ..    RL    B          

+59CC 20 05        .    JR    NZ,59D3    

+59CE 3E 50       >P    LD    A,50       

+59D0 32 B4 60    2.`   LD    (60B4),A   

+59D3 ED 43 AE 60 .C.`  LD    (60AE),BC  

+59D7 78          x     LD    A,B        

+59D8 B1          .     OR    C          

+59D9 32 5B 60    2[`   LD    (605B),A   

+59DC 28 34       (4    JR    Z,5A12     

+59DE C5          .     PUSH  BC         

+59DF 3E 00       >.    LD    A,00       ; HG

+59E1 01 05 00    ...   LD    BC,0005    ; Size

+59E4 11 00 00    ...   LD    DE,0000    ; Schluessel 0

+59E7 CD A8 28    ..(   CALL  28A8       

+59EA E1          .     POP   HL         

+59EB B7          .     OR    A          

+59EC ED 42       .B    SBC   HL,BC      

+59EE 38 0F       8.    JR    C,59FF     

+59F0 3E 01       >.    LD    A,01       

+59F2 CD 1D 5A    ..Z   CALL  5A1D       

+59F5 97          .     SUB   A          

+59F6 32 5B 60    2[`   LD    (605B),A   

+59F9 3C          <     INC   A          

+59FA 32 AD 60    2.`   LD    (60AD),A   

+59FD 18 18       ..    JR    5A17       

+59FF 1E 00       ..    LD    E,00       

+5A01 D5          .     PUSH  DE         

+5A02 CD A6 5A    ..Z   CALL  5AA6       

+5A05 54          T     LD    D,H        

+5A06 5D          ]     LD    E,L        

+5A07 13          .     INC   DE         

+5A08 36 FE       6.    LD    (HL),FE    

+5A0A ED B0       ..    LDIR             

+5A0C D1          .     POP   DE         

+5A0D 1C          .     INC   E          

+5A0E 1C          .     INC   E          

+5A0F 20 F0        .    JR    NZ,5A01    

+5A11 C9          .     RET              

+5A12 3E C9       >.    LD    A,C9       ; RET

+5A14 32 95 5A    2.Z   LD    (5A95),A   

+5A17 21 CF 15    !..   LD    HL,15CF    

+5A1A CB 86       ..    RES   0,(HL)     

+5A1C C9          .     RET              

+5A1D 21 00 00    !..   LD    HL,0000    

+5A20 C5          .     PUSH  BC         

+5A21 F5          .     PUSH  AF         

+5A22 E5          .     PUSH  HL         

+5A23 CD 92 5A    ..Z   CALL  5A92       

+5A26 D1          .     POP   DE         

+5A27 CB 23       .#    SLA   E          

+5A29 CB 12       ..    RL    D          

+5A2B F1          .     POP   AF         

+5A2C CD B0 5E    ..^   CALL  5EB0       

+5A2F CB 3A       .:    SLR   D          

+5A31 CB 1B       ..    RR    E          

+5A33 EB          .     EX    DE,HL      

+5A34 C1          .     POP   BC         

+5A35 ED A1       ..    CPI              

+5A37 EA 20 5A    . Z   JP    PE,5A20    

+5A3A C9          .     RET              

+5A3B 3A AD 60    :.`   LD    A,(60AD)   

+5A3E B7          .     OR    A          

+5A3F C8          .     RET   Z          

+5A40 3E 00       >.    LD    A,00       

+5A42 32 AD 60    2.`   LD    (60AD),A   

+5A45 01 05 00    ...   LD    BC,0005    

+5A48 11 00 00    ...   LD    DE,0000    

+5A4B CD A8 28    ..(   CALL  28A8       

+5A4E C5          .     PUSH  BC         

+5A4F 3E 02       >.    LD    A,02       

+5A51 CD 1D 5A    ..Z   CALL  5A1D       

+5A54 C1          .     POP   BC         

+5A55 11 00 00    ...   LD    DE,0000    

+5A58 C5          .     PUSH  BC         

+5A59 21 00 9E    !..   LD    HL,9E00    

+5A5C 3E 00       >.    LD    A,00       

+5A5E 01 00 00    ...   LD    BC,0000    

+5A61 CD 7E 28    .~(   CALL  287E       

+5A64 78          x     LD    A,B        

+5A65 B1          .     OR    C          

+5A66 20 08        .    JR    NZ,5A70    

+5A68 C1          .     POP   BC         

+5A69 ED A1       ..    CPI              

+5A6B 13          .     INC   DE         

+5A6C EA 58 5A    .XZ   JP    PE,5A58    

+5A6F C9          .     RET              

+5A70 CD CA 6E    ..n   CALL  6ECA       

+5A73 62          b     LD    H,D        

+5A74 6B          k     LD    L,E        

+5A75 CD 92 5A    ..Z   CALL  5A92       

+5A78 01 00 00    ...   LD    BC,0000    

+5A7B 97          .     SUB   A          

+5A7C CD 81 28    ..(   CALL  2881       

+5A7F 18 D8       ..    JR    5A59       

+5A81 7C          |     LD    A,H        

+5A82 47          G     LD    B,A        

+5A83 FE 10       ..    CP    10         

+5A85 D0          .     RET   NC         

+5A86 ED 4B A2 60 .K.`  LD    BC,(60A2)  

+5A8A 18 06       ..    JR    5A92       

+5A8C 78          x     LD    A,B        

+5A8D FE 10       ..    CP    10         

+5A8F D0          .     RET   NC         

+5A90 60          `     LD    H,B        

+5A91 69          i     LD    L,C        

+5A92 22 A2 60    ".`   LD    (60A2),HL  

+5A95 CB 3C       .<    SLR   H          

+5A97 CB 1D       ..    RR    L          

+5A99 7D          }     LD    A,L        

+5A9A 2A AB 60    *.`   LD    HL,(60AB)  

+5A9D 30 02       0.    JR    NC,5AA1    

+5A9F 24          $     INC   H          

+5AA0 24          $     INC   H          

+5AA1 2E 00       ..    LD    L,00       

+5AA3 C3 8D 28    ..(   JP    288D       

+5AA6 3E 03       >.    LD    A,03       

+5AA8 FE 03       ..    CP    03         

+5AAA 28 1A       (.    JR    Z,5AC6     

+5AAC F5          .     PUSH  AF         

+5AAD EB          .     EX    DE,HL      

+5AAE CD 92 5A    ..Z   CALL  5A92       

+5AB1 F1          .     POP   AF         

+5AB2 01 00 02    ...   LD    BC,0200    

+5AB5 3D          =     DEC   A          

+5AB6 CA A5 28    ..(   JP    Z,28A5     

+5AB9 EB          .     EX    DE,HL      

+5ABA C3 A5 28    ..(   JP    28A5       

+5ABD FE 03       ..    CP    03         

+5ABF 30 02       0.    JR    NC,5AC3    

+5AC1 EE 03       ..    XOR   03         

+5AC3 C3 8D 28    ..(   JP    288D       

+5AC6 7B          {     LD    A,E        

+5AC7 26 00       &.    LD    H,00       

+5AC9 07          .     RLCA             

+5ACA 07          .     RLCA             

+5ACB 07          .     RLCA             

+5ACC 07          .     RLCA             

+5ACD F5          .     PUSH  AF         

+5ACE E6 0F       ..    AND   0F         

+5AD0 6F          o     LD    L,A        

+5AD1 CD 92 5A    ..Z   CALL  5A92       

+5AD4 F1          .     POP   AF         

+5AD5 17          .     RLA              

+5AD6 30 01       0.    JR    NC,5AD9    

+5AD8 24          $     INC   H          

+5AD9 E6 C0       ..    AND   C0         

+5ADB 6F          o     LD    L,A        

+5ADC 01 14 00    ...   LD    BC,0014    

+5ADF C9          .     RET              

+5AE0 3A 5B 60    :[`   LD    A,(605B)   

+5AE3 B7          .     OR    A          

+5AE4 C0          .     RET   NZ         

+5AE5 F1          .     POP   AF         

+5AE6 F6 01       ..    OR    01         

+5AE8 C9          .     RET              

+5AE9 CD E0 5A    ..Z   CALL  5AE0       

+5AEC C5          .     PUSH  BC         

+5AED D5          .     PUSH  DE         

+5AEE E5          .     PUSH  HL         

+5AEF CD A6 5A    ..Z   CALL  5AA6       

+5AF2 C5          .     PUSH  BC         

+5AF3 7A          z     LD    A,D        

+5AF4 ED B1       ..    CPIR             

+5AF6 C1          .     POP   BC         

+5AF7 20 13        .    JR    NZ,5B0C    

+5AF9 09          .     ADD   HL,BC      

+5AFA 2B          +     DEC   HL         

+5AFB 7E          ~     LD    A,(HL)     

+5AFC CB EE       ..    SET   5,(HL)     

+5AFE 09          .     ADD   HL,BC      

+5AFF 6E          n     LD    L,(HL)     

+5B00 E6 1F       ..    AND   1F         

+5B02 67          g     LD    H,A        

+5B03 D1          .     POP   DE         

+5B04 D5          .     PUSH  DE         

+5B05 EB          .     EX    DE,HL      

+5B06 3E 01       >.    LD    A,01       

+5B08 CD A8 5A    ..Z   CALL  5AA8       

+5B0B 97          .     SUB   A          

+5B0C E1          .     POP   HL         

+5B0D D1          .     POP   DE         

+5B0E C1          .     POP   BC         

+5B0F C9          .     RET              

+5B10 3A 5B 60    :[`   LD    A,(605B)   

+5B13 B7          .     OR    A          

+5B14 CA 27 59    .'Y   JP    Z,5927     

+5B17 7E          ~     LD    A,(HL)     

+5B18 32 60 60    2``   LD    (6060),A   

+5B1B CB BD       ..    RES   7,L        

+5B1D 5E          ^     LD    E,(HL)     

+5B1E 24          $     INC   H          

+5B1F 56          V     LD    D,(HL)     

+5B20 65          e     LD    H,L        

+5B21 CB 24       .$    SLA   H          

+5B23 2E 00       ..    LD    L,00       

+5B25 7A          z     LD    A,D        

+5B26 FE FD       ..    CP    FD         

+5B28 D0          .     RET   NC         

+5B29 B7          .     OR    A          

+5B2A 20 06        .    JR    NZ,5B32    

+5B2C 7B          {     LD    A,E        

+5B2D FE 04       ..    CP    04         

+5B2F DA 87 5B    ..[   JP    C,5B87     

+5B32 E5          .     PUSH  HL         

+5B33 CD A6 5A    ..Z   CALL  5AA6       

+5B36 C5          .     PUSH  BC         

+5B37 7A          z     LD    A,D        

+5B38 ED B1       ..    CPIR             

+5B3A C1          .     POP   BC         

+5B3B 20 14        .    JR    NZ,5B51    

+5B3D 09          .     ADD   HL,BC      

+5B3E 2B          +     DEC   HL         

+5B3F CB B6       ..    RES   6,(HL)     

+5B41 7E          ~     LD    A,(HL)     

+5B42 09          .     ADD   HL,BC      

+5B43 6E          n     LD    L,(HL)     

+5B44 E6 1F       ..    AND   1F         

+5B46 67          g     LD    H,A        

+5B47 EB          .     EX    DE,HL      

+5B48 E1          .     POP   HL         

+5B49 E5          .     PUSH  HL         

+5B4A 3E 02       >.    LD    A,02       

+5B4C CD A8 5A    ..Z   CALL  5AA8       

+5B4F E1          .     POP   HL         

+5B50 C9          .     RET              

+5B51 3A 60 60    :``   LD    A,(6060)   

+5B54 F5          .     PUSH  AF         

+5B55 B7          .     OR    A          

+5B56 ED 42       .B    SBC   HL,BC      

+5B58 3E FE       >.    LD    A,FE       

+5B5A ED B1       ..    CPIR             

+5B5C 20 24        $    JR    NZ,5B82    

+5B5E D5          .     PUSH  DE         

+5B5F CD F4 5B    ..[   CALL  5BF4       

+5B62 EB          .     EX    DE,HL      

+5B63 D1          .     POP   DE         

+5B64 28 1C       (.    JR    Z,5B82     

+5B66 E5          .     PUSH  HL         

+5B67 CD A6 5A    ..Z   CALL  5AA6       

+5B6A C5          .     PUSH  BC         

+5B6B 3E FE       >.    LD    A,FE       

+5B6D ED B1       ..    CPIR             

+5B6F C1          .     POP   BC         

+5B70 2B          +     DEC   HL         

+5B71 72          r     LD    (HL),D     

+5B72 09          .     ADD   HL,BC      

+5B73 D1          .     POP   DE         

+5B74 72          r     LD    (HL),D     

+5B75 F1          .     POP   AF         

+5B76 CB 4F       .O    BIT   1,A        

+5B78 28 02       (.    JR    Z,5B7C     

+5B7A CB F6       ..    SET   6,(HL)     

+5B7C CB EE       ..    SET   5,(HL)     

+5B7E 09          .     ADD   HL,BC      

+5B7F 73          s     LD    (HL),E     

+5B80 18 C6       ..    JR    5B48       

+5B82 F1          .     POP   AF         

+5B83 E1          .     POP   HL         

+5B84 CB 4F       .O    BIT   1,A        

+5B86 C0          .     RET   NZ         

+5B87 3E 02       >.    LD    A,02       

+5B89 C3 82 5E    ..^   JP    5E82       

+5B8C 32 66 60    2f`   LD    (6066),A   

+5B8F 3A A8 5A    :.Z   LD    A,(5AA8)   

+5B92 FE C3       ..    CP    C3         

+5B94 CA CB 5B    ..[   JP    Z,5BCB     

+5B97 3A 5B 60    :[`   LD    A,(605B)   

+5B9A B7          .     OR    A          

+5B9B CA CB 5B    ..[   JP    Z,5BCB     

+5B9E C5          .     PUSH  BC         

+5B9F CD A6 5A    ..Z   CALL  5AA6       

+5BA2 C5          .     PUSH  BC         

+5BA3 7A          z     LD    A,D        

+5BA4 ED B1       ..    CPIR             

+5BA6 C1          .     POP   BC         

+5BA7 C2 CA 5B    ..[   JP    NZ,5BCA    

+5BAA 09          .     ADD   HL,BC      

+5BAB 2B          +     DEC   HL         

+5BAC CB 6E       .n    BIT   5,(HL)     

+5BAE 20 20             JR    NZ,5BD0    

+5BB0 3A 66 60    :f`   LD    A,(6066)   

+5BB3 CB 4F       .O    BIT   1,A        

+5BB5 20 02        .    JR    NZ,5BB9    

+5BB7 CB B6       ..    RES   6,(HL)     

+5BB9 7E          ~     LD    A,(HL)     

+5BBA 09          .     ADD   HL,BC      

+5BBB 6E          n     LD    L,(HL)     

+5BBC E6 1F       ..    AND   1F         

+5BBE 67          g     LD    H,A        

+5BBF CD 92 5A    ..Z   CALL  5A92       

+5BC2 C1          .     POP   BC         

+5BC3 6C          l     LD    L,H        

+5BC4 CB 3D       .=    SLR   L          

+5BC6 26 15       &.    LD    H,15       

+5BC8 37          7     SCF              

+5BC9 C9          .     RET              

+5BCA C1          .     POP   BC         

+5BCB CD 41 5D    .A]   CALL  5D41       

+5BCE 18 09       ..    JR    5BD9       

+5BD0 22 B5 60    ".`   LD    (60B5),HL  

+5BD3 CD B6 5D    ..]   CALL  5DB6       

+5BD6 38 15       8.    JR    C,5BED     

+5BD8 C1          .     POP   BC         

+5BD9 F5          .     PUSH  AF         

+5BDA CB FD       ..    SET   7,L        

+5BDC 3A 66 60    :f`   LD    A,(6066)   

+5BDF A6          .     AND   (HL)       

+5BE0 77          w     LD    (HL),A     

+5BE1 3A 5B 60    :[`   LD    A,(605B)   

+5BE4 B7          .     OR    A          

+5BE5 28 02       (.    JR    Z,5BE9     

+5BE7 CB 9E       ..    RES   3,(HL)     

+5BE9 CB BD       ..    RES   7,L        

+5BEB F1          .     POP   AF         

+5BEC C9          .     RET              

+5BED 2A B5 60    *.`   LD    HL,(60B5)  

+5BF0 CB AE       ..    RES   5,(HL)     

+5BF2 18 BC       ..    JR    5BB0       

+5BF4 3A B0 60    :.`   LD    A,(60B0)   

+5BF7 B7          .     OR    A          

+5BF8 20 1F        .    JR    NZ,5C19    

+5BFA 2A 5C 60    *\`   LD    HL,(605C)  

+5BFD 23          #     INC   HL         

+5BFE 22 5C 60    "\`   LD    (605C),HL  

+5C01 ED 4B AE 60 .K.`  LD    BC,(60AE)  

+5C05 B7          .     OR    A          

+5C06 ED 42       .B    SBC   HL,BC      

+5C08 30 06       0.    JR    NC,5C10    

+5C0A 09          .     ADD   HL,BC      

+5C0B 54          T     LD    D,H        

+5C0C 5D          ]     LD    E,L        

+5C0D F6 01       ..    OR    01         

+5C0F C9          .     RET              

+5C10 3E 01       >.    LD    A,01       

+5C12 32 B0 60    2.`   LD    (60B0),A   

+5C15 97          .     SUB   A          

+5C16 32 5C 60    2\`   LD    (605C),A   

+5C19 ED 5B 5C 60 .[\`  LD    DE,(605C)  

+5C1D 1C          .     INC   E          

+5C1E 1C          .     INC   E          

+5C1F ED 53 5C 60 .S\`  LD    (605C),DE  

+5C23 CD A6 5A    ..Z   CALL  5AA6       

+5C26 56          V     LD    D,(HL)     

+5C27 3E FE       >.    LD    A,FE       

+5C29 BA          .     CP    D          

+5C2A C8          .     RET   Z          

+5C2B 77          w     LD    (HL),A     

+5C2C 09          .     ADD   HL,BC      

+5C2D CB 7E       .~    BIT   7,(HL)     

+5C2F 28 0C       (.    JR    Z,5C3D     

+5C31 B7          .     OR    A          

+5C32 ED 42       .B    SBC   HL,BC      

+5C34 E5          .     PUSH  HL         

+5C35 C5          .     PUSH  BC         

+5C36 CD 50 5C    .P\   CALL  5C50       

+5C39 C1          .     POP   BC         

+5C3A E1          .     POP   HL         

+5C3B 18 E9       ..    JR    5C26       

+5C3D CD 66 5C    .f\   CALL  5C66       

+5C40 ED 5B 5C 60 .[\`  LD    DE,(605C)  

+5C44 CD A6 5A    ..Z   CALL  5AA6       

+5C47 E5          .     PUSH  HL         

+5C48 09          .     ADD   HL,BC      

+5C49 7E          ~     LD    A,(HL)     

+5C4A E6 1F       ..    AND   1F         

+5C4C 57          W     LD    D,A        

+5C4D 09          .     ADD   HL,BC      

+5C4E 5E          ^     LD    E,(HL)     

+5C4F E1          .     POP   HL         

+5C50 D5          .     PUSH  DE         

+5C51 54          T     LD    D,H        

+5C52 5D          ]     LD    E,L        

+5C53 23          #     INC   HL         

+5C54 C5          .     PUSH  BC         

+5C55 ED B0       ..    LDIR             

+5C57 1B          .     DEC   DE         

+5C58 3E FE       >.    LD    A,FE       

+5C5A 12          .     LD    (DE),A     

+5C5B 13          .     INC   DE         

+5C5C C1          .     POP   BC         

+5C5D CB 21       .!    SLA   C          

+5C5F CB 10       ..    RL    B          

+5C61 ED B0       ..    LDIR             

+5C63 D1          .     POP   DE         

+5C64 B7          .     OR    A          

+5C65 C9          .     RET              

+5C66 CB 76       .v    BIT   6,(HL)     

+5C68 C0          .     RET   NZ         

+5C69 CB F6       ..    SET   6,(HL)     

+5C6B E5          .     PUSH  HL         

+5C6C 3A B3 60    :.`   LD    A,(60B3)   

+5C6F B7          .     OR    A          

+5C70 20 0B        .    JR    NZ,5C7D    

+5C72 CD AE 5D    ..]   CALL  5DAE       

+5C75 38 06       8.    JR    C,5C7D     

+5C77 CB FD       ..    SET   7,L        

+5C79 CB 8E       ..    RES   1,(HL)     

+5C7B E1          .     POP   HL         

+5C7C C9          .     RET              

+5C7D E1          .     POP   HL         

+5C7E D5          .     PUSH  DE         

+5C7F 7E          ~     LD    A,(HL)     

+5C80 E6 1F       ..    AND   1F         

+5C82 57          W     LD    D,A        

+5C83 09          .     ADD   HL,BC      

+5C84 5E          ^     LD    E,(HL)     

+5C85 21 00 9E    !..   LD    HL,9E00    

+5C88 3E 01       >.    LD    A,01       

+5C8A CD A8 5A    ..Z   CALL  5AA8       

+5C8D 21 00 9E    !..   LD    HL,9E00    

+5C90 D1          .     POP   DE         

+5C91 3E 02       >.    LD    A,02       

+5C93 C3 82 5E    ..^   JP    5E82       

+5C96 ED 5B 5E 60 .[^`  LD    DE,(605E)  

+5C9A CD A6 5A    ..Z   CALL  5AA6       

+5C9D 7D          }     LD    A,L        

+5C9E 82          .     ADD   D          

+5C9F 6F          o     LD    L,A        

+5CA0 30 01       0.    JR    NC,5CA3    

+5CA2 24          $     INC   H          

+5CA3 56          V     LD    D,(HL)     

+5CA4 7A          z     LD    A,D        

+5CA5 FE FE       ..    CP    FE         

+5CA7 28 06       (.    JR    Z,5CAF     

+5CA9 09          .     ADD   HL,BC      

+5CAA C5          .     PUSH  BC         

+5CAB CD 66 5C    .f\   CALL  5C66       

+5CAE C1          .     POP   BC         

+5CAF ED 5B 5E 60 .[^`  LD    DE,(605E)  

+5CB3 14          .     INC   D          

+5CB4 7A          z     LD    A,D        

+5CB5 B9          .     CP    C          

+5CB6 20 04        .    JR    NZ,5CBC    

+5CB8 16 00       ..    LD    D,00       

+5CBA 1C          .     INC   E          

+5CBB 1C          .     INC   E          

+5CBC ED 53 5E 60 .S^`  LD    (605E),DE  

+5CC0 C9          .     RET              

+5CC1 E5          .     PUSH  HL         

+5CC2 2A 61 60    *a`   LD    HL,(6061)  

+5CC5 CD 92 5A    ..Z   CALL  5A92       

+5CC8 E1          .     POP   HL         

+5CC9 C9          .     RET              

+5CCA CD 20 6E    . n   CALL  6E20       

+5CCD CD D4 5C    ..\   CALL  5CD4       

+5CD0 CD 2A 6E    .*n   CALL  6E2A       

+5CD3 C9          .     RET              

+5CD4 32 9C 60    2.`   LD    (609C),A   

+5CD7 3A B4 60    :.`   LD    A,(60B4)   

+5CDA 3D          =     DEC   A          

+5CDB C8          .     RET   Z          

+5CDC 32 B4 60    2.`   LD    (60B4),A   

+5CDF 3A A8 5A    :.Z   LD    A,(5AA8)   

+5CE2 FE C3       ..    CP    C3         

+5CE4 C8          .     RET   Z          

+5CE5 3A AD 60    :.`   LD    A,(60AD)   

+5CE8 B7          .     OR    A          

+5CE9 CC E0 5A    ..Z   CALL  Z,5AE0     

+5CEC 3A 9C 60    :.`   LD    A,(609C)   

+5CEF 26 15       &.    LD    H,15       

+5CF1 6F          o     LD    L,A        

+5CF2 CB 3D       .=    SLR   L          

+5CF4 E5          .     PUSH  HL         

+5CF5 5E          ^     LD    E,(HL)     

+5CF6 24          $     INC   H          

+5CF7 56          V     LD    D,(HL)     

+5CF8 3A AD 60    :.`   LD    A,(60AD)   

+5CFB B7          .     OR    A          

+5CFC 20 32        2    JR    NZ,5D30    

+5CFE CD A6 5A    ..Z   CALL  5AA6       

+5D01 C5          .     PUSH  BC         

+5D02 7A          z     LD    A,D        

+5D03 ED B1       ..    CPIR             

+5D05 C1          .     POP   BC         

+5D06 20 30        0    JR    NZ,5D38    

+5D08 09          .     ADD   HL,BC      

+5D09 2B          +     DEC   HL         

+5D0A 7E          ~     LD    A,(HL)     

+5D0B E6 1F       ..    AND   1F         

+5D0D CB FE       ..    SET   7,(HL)     

+5D0F 09          .     ADD   HL,BC      

+5D10 47          G     LD    B,A        

+5D11 4E          N     LD    C,(HL)     

+5D12 E1          .     POP   HL         

+5D13 36 01       6.    LD    (HL),01    

+5D15 24          $     INC   H          

+5D16 CB FD       ..    SET   7,L        

+5D18 36 FF       6.    LD    (HL),FF    

+5D1A CB BD       ..    RES   7,L        

+5D1C 24          $     INC   H          

+5D1D 24          $     INC   H          

+5D1E 7E          ~     LD    A,(HL)     

+5D1F 87          .     ADD   A          

+5D20 21 B7 60    !.`   LD    HL,60B7    

+5D23 30 01       0.    JR    NC,5D26    

+5D25 24          $     INC   H          

+5D26 85          .     ADD   L          

+5D27 6F          o     LD    L,A        

+5D28 30 01       0.    JR    NC,5D2B    

+5D2A 24          $     INC   H          

+5D2B 0D          .     DEC   C          

+5D2C 71          q     LD    (HL),C     

+5D2D 23          #     INC   HL         

+5D2E 70          p     LD    (HL),B     

+5D2F C9          .     RET              

+5D30 42          B     LD    B,D        

+5D31 4B          K     LD    C,E        

+5D32 CB 28       .(    SRA   B          

+5D34 CB 19       ..    RR    C          

+5D36 18 DA       ..    JR    5D12       

+5D38 21 B4 60    !.`   LD    HL,60B4    

+5D3B 34          4     INC   (HL)       

+5D3C E1          .     POP   HL         

+5D3D C9          .     RET              

+5D3E C3 8C 5B    ..[   JP    5B8C       

+5D41 21 B5 4C    !.L   LD    HL,4CB5    

+5D44 CB D6       ..    SET   2,(HL)     

+5D46 CD B6 5D    ..]   CALL  5DB6       

+5D49 D2 A6 5D    ..]   JP    NC,5DA6    

+5D4C 3A 5B 60    :[`   LD    A,(605B)   

+5D4F B7          .     OR    A          

+5D50 28 33       (3    JR    Z,5D85     

+5D52 CD A6 5A    ..Z   CALL  5AA6       

+5D55 7A          z     LD    A,D        

+5D56 ED B1       ..    CPIR             

+5D58 20 2B        +    JR    NZ,5D85    

+5D5A CD F7 58    ..X   CALL  58F7       

+5D5D CB 4E       .N    BIT   1,(HL)     

+5D5F 20 16        .    JR    NZ,5D77    

+5D61 D5          .     PUSH  DE         

+5D62 E5          .     PUSH  HL         

+5D63 CB BD       ..    RES   7,L        

+5D65 5E          ^     LD    E,(HL)     

+5D66 24          $     INC   H          

+5D67 56          V     LD    D,(HL)     

+5D68 24          $     INC   H          

+5D69 7E          ~     LD    A,(HL)     

+5D6A B7          .     OR    A          

+5D6B 28 16       (.    JR    Z,5D83     

+5D6D CD A6 5A    ..Z   CALL  5AA6       

+5D70 7A          z     LD    A,D        

+5D71 ED B1       ..    CPIR             

+5D73 E1          .     POP   HL         

+5D74 D1          .     POP   DE         

+5D75 20 0E        .    JR    NZ,5D85    

+5D77 22 9D 60    ".`   LD    (609D),HL  

+5D7A CD 45 59    .EY   CALL  5945       

+5D7D 21 00 00    !..   LD    HL,0000    

+5D80 C3 9C 5D    ..]   JP    5D9C       

+5D83 E1          .     POP   HL         

+5D84 D1          .     POP   DE         

+5D85 21 20 16    ! .   LD    HL,1620    

+5D88 3E FD       >.    LD    A,FD       

+5D8A ED A1       ..    CPI              

+5D8C 20 0B        .    JR    NZ,5D99    

+5D8E 2B          +     DEC   HL         

+5D8F 72          r     LD    (HL),D     

+5D90 25          %     DEC   H          

+5D91 73          s     LD    (HL),E     

+5D92 E5          .     PUSH  HL         

+5D93 21 63 60    !c`   LD    HL,6063    

+5D96 34          4     INC   (HL)       

+5D97 18 04       ..    JR    5D9D       

+5D99 21 63 60    !c`   LD    HL,6063    

+5D9C E5          .     PUSH  HL         

+5D9D 21 B5 4C    !.L   LD    HL,4CB5    

+5DA0 CB 96       ..    RES   2,(HL)     

+5DA2 E1          .     POP   HL         

+5DA3 C3 1A 6C    ..l   JP    6C1A       

+5DA6 E5          .     PUSH  HL         

+5DA7 21 B5 4C    !.L   LD    HL,4CB5    

+5DAA CB 96       ..    RES   2,(HL)     

+5DAC E1          .     POP   HL         

+5DAD C9          .     RET              

+5DAE CD CD 5D    ..]   CALL  5DCD       

+5DB1 D8          .     RET   C          

+5DB2 7D          }     LD    A,L        

+5DB3 FE 28       .(    CP    28         

+5DB5 C9          .     RET              

+5DB6 CD CD 5D    ..]   CALL  5DCD       

+5DB9 D8          .     RET   C          

+5DBA 7D          }     LD    A,L        

+5DBB FE 28       .(    CP    28         

+5DBD DA 1A 6C    ..l   JP    C,6C1A     

+5DC0 CB FD       ..    SET   7,L        

+5DC2 CB 46       .F    BIT   0,(HL)     

+5DC4 C2 1A 6C    ..l   JP    NZ,6C1A    

+5DC7 CB DE       ..    SET   3,(HL)     

+5DC9 CB BD       ..    RES   7,L        

+5DCB B7          .     OR    A          

+5DCC C9          .     RET              

+5DCD CB 83       ..    RES   0,E        

+5DCF C5          .     PUSH  BC         

+5DD0 7B          {     LD    A,E        

+5DD1 AA          .     XOR   D          

+5DD2 6F          o     LD    L,A        

+5DD3 26 14       &.    LD    H,14       

+5DD5 6E          n     LD    L,(HL)     

+5DD6 26 15       &.    LD    H,15       

+5DD8 7B          {     LD    A,E        

+5DD9 BE          .     CP    (HL)       

+5DDA 20 09        .    JR    NZ,5DE5    

+5DDC 24          $     INC   H          

+5DDD 7A          z     LD    A,D        

+5DDE BE          .     CP    (HL)       

+5DDF 20 04        .    JR    NZ,5DE5    

+5DE1 25          %     DEC   H          

+5DE2 B7          .     OR    A          

+5DE3 C1          .     POP   BC         

+5DE4 C9          .     RET              

+5DE5 21 1F 15    !..   LD    HL,151F    

+5DE8 01 62 00    .b.   LD    BC,0062    

+5DEB 7B          {     LD    A,E        

+5DEC ED B1       ..    CPIR             

+5DEE E2 08 5E    ..^   JP    PO,5E08    

+5DF1 7A          z     LD    A,D        

+5DF2 24          $     INC   H          

+5DF3 2D          -     DEC   L          

+5DF4 BE          .     CP    (HL)       

+5DF5 28 04       (.    JR    Z,5DFB     

+5DF7 2C          ,     INC   L          

+5DF8 25          %     DEC   H          

+5DF9 18 F0       ..    JR    5DEB       

+5DFB 25          %     DEC   H          

+5DFC E5          .     PUSH  HL         

+5DFD 45          E     LD    B,L        

+5DFE 7B          {     LD    A,E        

+5DFF AA          .     XOR   D          

+5E00 6F          o     LD    L,A        

+5E01 26 14       &.    LD    H,14       

+5E03 70          p     LD    (HL),B     

+5E04 E1          .     POP   HL         

+5E05 C1          .     POP   BC         

+5E06 B7          .     OR    A          

+5E07 C9          .     RET              

+5E08 C1          .     POP   BC         

+5E09 37          7     SCF              

+5E0A C9          .     RET              

+5E0B 7C          |     LD    A,H        

+5E0C FE 10       ..    CP    10         

+5E0E D8          .     RET   C          

+5E0F 37          7     SCF              

+5E10 CB 1C       ..    RR    H          

+5E12 6C          l     LD    L,H        

+5E13 26 15       &.    LD    H,15       

+5E15 CB 86       ..    RES   0,(HL)     

+5E17 C9          .     RET              

+5E18 CD 8A 28    ..(   CALL  288A       

+5E1B CB 70       .p    BIT   6,B        

+5E1D 20 1A        .    JR    NZ,5E39    

+5E1F 3A 5B 60    :[`   LD    A,(605B)   

+5E22 B7          .     OR    A          

+5E23 28 14       (.    JR    Z,5E39     

+5E25 21 A4 60    !.`   LD    HL,60A4    

+5E28 CB 4E       .N    BIT   1,(HL)     

+5E2A 20 05        .    JR    NZ,5E31    

+5E2C 36 00       6.    LD    (HL),00    

+5E2E C3 1A 6C    ..l   JP    6C1A       

+5E31 36 01       6.    LD    (HL),01    

+5E33 2A A5 60    *.`   LD    HL,(60A5)  

+5E36 7C          |     LD    A,H        

+5E37 B5          .     OR    L          

+5E38 C0          .     RET   NZ         

+5E39 CD 42 5E    .B^   CALL  5E42       

+5E3C 65          e     LD    H,L        

+5E3D CB 24       .$    SLA   H          

+5E3F 2E 00       ..    LD    L,00       

+5E41 C9          .     RET              

+5E42 2A 9F 60    *.`   LD    HL,(609F)  

+5E45 22 9D 60    ".`   LD    (609D),HL  

+5E48 11 18 FF    ...   LD    DE,FF18    

+5E4B CD 41 5D    .A]   CALL  5D41       

+5E4E CB C6       ..    SET   0,(HL)     

+5E50 CB FD       ..    SET   7,L        

+5E52 CB C6       ..    SET   0,(HL)     

+5E54 CB BD       ..    RES   7,L        

+5E56 C9          .     RET              

+5E57 01 01 00    ...   LD    BC,0001    

+5E5A C9          .     RET              ;--------------------------------

+5E5B 7C          |     LD    A,H        

+5E5C FE A0       ..    CP    A0         

+5E5E 38 F7       8.    JR    C,5E57     

+5E60 37          7     SCF              

+5E61 1F          .     RRA              

+5E62 41          A     LD    B,C        

+5E63 80          .     ADD   B          

+5E64 38 F1       8.    JR    C,5E57     

+5E66 E5          .     PUSH  HL         

+5E67 21 A1 60    !.`   LD    HL,60A1    

+5E6A 3D          =     DEC   A          

+5E6B BE          .     CP    (HL)       

+5E6C E1          .     POP   HL         

+5E6D 30 E8       0.    JR    NC,5E57    

+5E6F CD 20 6E    . n   CALL  6E20       

+5E72 6C          l     LD    L,H        

+5E73 37          7     SCF              

+5E74 CB 1D       ..    RR    L          

+5E76 26 15       &.    LD    H,15       

+5E78 CD B9 5F    .._   CALL  5FB9       

+5E7B CD 2A 6E    .*n   CALL  6E2A       

+5E7E 01 00 00    ...   LD    BC,0000    

+5E81 C9          .     RET              

+5E82 E5          .     PUSH  HL         

+5E83 21 B5 4C    !.L   LD    HL,4CB5    

+5E86 CB FE       ..    SET   7,(HL)     

+5E88 CB 96       ..    RES   2,(HL)     

+5E8A E1          .     POP   HL         

+5E8B 47          G     LD    B,A        

+5E8C 3A AD 60    :.`   LD    A,(60AD)   

+5E8F B7          .     OR    A          

+5E90 78          x     LD    A,B        

+5E91 20 0D        .    JR    NZ,5EA0    

+5E93 CD B0 5E    ..^   CALL  5EB0       

+5E96 E5          .     PUSH  HL         

+5E97 21 B5 4C    !.L   LD    HL,4CB5    

+5E9A CB BE       ..    RES   7,(HL)     

+5E9C CB D6       ..    SET   2,(HL)     

+5E9E E1          .     POP   HL         

+5E9F C9          .     RET              

+5EA0 E5          .     PUSH  HL         

+5EA1 D5          .     PUSH  DE         

+5EA2 CB 2A       .*    SRA   D          

+5EA4 CB 1B       ..    RR    E          

+5EA6 CD A8 5A    ..Z   CALL  5AA8       

+5EA9 D1          .     POP   DE         

+5EAA E1          .     POP   HL         

+5EAB 18 E9       ..    JR    5E96       

+5EAD CD 2A 6E    .*n   CALL  6E2A       

+5EB0 06 32       .2    LD    B,32       

+5EB2 F5          .     PUSH  AF         

+5EB3 C5          .     PUSH  BC         

+5EB4 E5          .     PUSH  HL         

+5EB5 01 00 00    ...   LD    BC,0000    

+5EB8 CB 3A       .:    SLR   D          

+5EBA CB 1B       ..    RR    E          

+5EBC FE 02       ..    CP    02         

+5EBE 3E 00       >.    LD    A,00       

+5EC0 28 05       (.    JR    Z,5EC7     

+5EC2 CD 7E 28    .~(   CALL  287E       

+5EC5 18 03       ..    JR    5ECA       

+5EC7 CD 81 28    ..(   CALL  2881       

+5ECA CB 23       .#    SLA   E          

+5ECC CB 12       ..    RL    D          

+5ECE 79          y     LD    A,C        

+5ECF B0          .     OR    B          

+5ED0 28 66       (f    JR    Z,5F38     

+5ED2 22 A9 60    ".`   LD    (60A9),HL  

+5ED5 E1          .     POP   HL         

+5ED6 C1          .     POP   BC         

+5ED7 F1          .     POP   AF         

+5ED8 10 D8       ..    DJNZ  5EB2       

+5EDA CD 20 6E    . n   CALL  6E20       

+5EDD 21 67 60    !g`   LD    HL,6067    

+5EE0 CD CA 6E    ..n   CALL  6ECA       

+5EE3 2A A9 60    *.`   LD    HL,(60A9)  

+5EE6 CD CA 6E    ..n   CALL  6ECA       

+5EE9 21 6B 60    !k`   LD    HL,606B    

+5EEC CD CA 6E    ..n   CALL  6ECA       ; noch ein Versuch (j)

+5EEF CD 9E 6E    ..n   CALL  6E9E       

+5EF2 FE 64       .d    CP    64         ; "d" Diskerror

+5EF4 28 2D       (-    JR    Z,5F23     

+5EF6 FE 6A       .j    CP    6A         ; "j" nochmal

+5EF8 28 B3       (.    JR    Z,5EAD     

+5EFA FE 59       .Y    CP    59         ; "Y" Mark

+5EFC 20 DF        .    JR    NZ,5EDD    

+5EFE 21 84 60    !.`   LD    HL,6084    

+5F01 CD CA 6E    ..n   CALL  6ECA       

+5F04 CD 9E 6E    ..n   CALL  6E9E       

+5F07 FE 10       ..    CP    10         

+5F09 20 D2        .    JR    NZ,5EDD    

+5F0B CD 2A 6E    .*n   CALL  6E2A       

+5F0E CD 20 6E    . n   CALL  6E20       

+5F11 01 FE 01    ...   LD    BC,01FE    

+5F14 23          #     INC   HL         

+5F15 54          T     LD    D,H        

+5F16 5D          ]     LD    E,L        

+5F17 13          .     INC   DE         

+5F18 36 FF       6.    LD    (HL),FF    

+5F1A 2B          +     DEC   HL         

+5F1B 36 FD       6.    LD    (HL),FD    

+5F1D ED B0       ..    LDIR             

+5F1F CD 2A 6E    .*n   CALL  6E2A       

+5F22 C9          .     RET              

+5F23 CD 2A 6E    .*n   CALL  6E2A       

+5F26 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+5F29 18 0B       ..    JR    5F36       

+5F2B 20 44        D    JR    NZ,5F71    ; " DISK ERROR"

+5F2D 49          I     LD    C,C        

+5F2E 53          S     LD    D,E        

+5F2F 4B          K     LD    C,E        

+5F30 20 45        E    JR    NZ,5F77    

+5F32 52          R     LD    D,D        

+5F33 52          R     LD    D,D        

+5F34 4F          O     LD    C,A        

+5F35 52          R     LD    D,D        

+5F36 18 A2       ..    JR    5EDA       

+5F38 E1          .     POP   HL         

+5F39 C1          .     POP   BC         

+5F3A F1          .     POP   AF         

+5F3B C9          .     RET              

+5F3C 2C          ,     INC   L          

+5F3D CB FD       ..    SET   7,L        

+5F3F 3A A1 60    :.`   LD    A,(60A1)   

+5F42 BD          .     CP    L          

+5F43 C0          .     RET   NZ         

+5F44 2A 9F 60    *.`   LD    HL,(609F)  

+5F47 C9          .     RET              

+5F48 7C          |     LD    A,H        

+5F49 21 B7 60    !.`   LD    HL,60B7    

+5F4C 87          .     ADD   A          

+5F4D 30 01       0.    JR    NC,5F50    

+5F4F 24          $     INC   H          

+5F50 85          .     ADD   L          

+5F51 6F          o     LD    L,A        

+5F52 30 01       0.    JR    NC,5F55    

+5F54 24          $     INC   H          

+5F55 7E          ~     LD    A,(HL)     

+5F56 3C          <     INC   A          

+5F57 C8          .     RET   Z          

+5F58 23          #     INC   HL         

+5F59 66          f     LD    H,(HL)     

+5F5A 6F          o     LD    L,A        

+5F5B 22 61 60    "a`   LD    (6061),HL  

+5F5E CD 92 5A    ..Z   CALL  5A92       

+5F61 7C          |     LD    A,H        

+5F62 CB 3F       .?    SLR   A          

+5F64 C9          .     RET              

+5F65 CD 6B 5F    .k_   CALL  5F6B       

+5F68 CB 86       ..    RES   0,(HL)     

+5F6A C9          .     RET              

+5F6B 3E 01       >.    LD    A,01       

+5F6D C5          .     PUSH  BC         

+5F6E E5          .     PUSH  HL         

+5F6F 47          G     LD    B,A        

+5F70 CD 0E 6E    ..n   CALL  6E0E       

+5F73 FE 41       .A    CP    41         

+5F75 78          x     LD    A,B        

+5F76 28 09       (.    JR    Z,5F81     

+5F78 22 97 60    ".`   LD    (6097),HL  

+5F7B 21 96 60    !.`   LD    HL,6096    

+5F7E 77          w     LD    (HL),A     

+5F7F 18 07       ..    JR    5F88       

+5F81 22 9A 60    ".`   LD    (609A),HL  

+5F84 21 99 60    !.`   LD    HL,6099    

+5F87 77          w     LD    (HL),A     

+5F88 E5          .     PUSH  HL         

+5F89 21 B5 4C    !.L   LD    HL,4CB5    

+5F8C CB 96       ..    RES   2,(HL)     

+5F8E CD E2 6D    ..m   CALL  6DE2       

+5F91 E1          .     POP   HL         

+5F92 7E          ~     LD    A,(HL)     

+5F93 B7          .     OR    A          

+5F94 20 F2        .    JR    NZ,5F88    

+5F96 E1          .     POP   HL         

+5F97 C1          .     POP   BC         

+5F98 C9          .     RET              

+5F99 E5          .     PUSH  HL         

+5F9A 21 00 00    !..   LD    HL,0000    

+5F9D 22 5E 60    "^`   LD    (605E),HL  

+5FA0 E1          .     POP   HL         

+5FA1 3E 02       >.    LD    A,02       

+5FA3 18 C8       ..    JR    5F6D       

+5FA5 CD 1F 70    ..p   CALL  701F       

+5FA8 18 04       ..    JR    5FAE       

+5FAA 20 52        R    JR    NZ,5FFE    

+5FAC 45          E     LD    B,L        

+5FAD 53          S     LD    D,E        

+5FAE C3 44 58    .DX   JP    5844       

+5FB1 21 D0 15    !..   LD    HL,15D0    

+5FB4 47          G     LD    B,A        

+5FB5 ED 43 64 60 .Cd`  LD    (6064),BC  

+5FB9 CD 6B 5F    .k_   CALL  5F6B       

+5FBC 24          $     INC   H          

+5FBD 36 FF       6.    LD    (HL),FF    

+5FBF 25          %     DEC   H          

+5FC0 CB BD       ..    RES   7,L        

+5FC2 CB C6       ..    SET   0,(HL)     

+5FC4 CB FD       ..    SET   7,L        

+5FC6 2C          ,     INC   L          

+5FC7 10 F0       ..    DJNZ  5FB9       

+5FC9 21 00 A0    !..   LD    HL,A000    

+5FCC C9          .     RET              

+5FCD 3A 17 82    :..   LD    A,(8217)   ; musta

+5FD0 CB 67       .g    BIT   4,A        

+5FD2 20 27        '    JR    NZ,5FFB    ; Bit 4 = System-Aufbau

+5FD4 21 28 16    !(.   LD    HL,1628    

+5FD7 7E          ~     LD    A,(HL)     

+5FD8 57          W     LD    D,A        

+5FD9 FE FD       ..    CP    FD         

+5FDB 30 1A       0.    JR    NC,5FF7    

+5FDD 25          %     DEC   H          

+5FDE 5E          ^     LD    E,(HL)     

+5FDF CD A8 56    ..V   CALL  56A8       

+5FE2 20 12        .    JR    NZ,5FF6    

+5FE4 7B          {     LD    A,E        

+5FE5 BE          .     CP    (HL)       

+5FE6 20 0E        .    JR    NZ,5FF6    

+5FE8 24          $     INC   H          

+5FE9 7A          z     LD    A,D        

+5FEA BE          .     CP    (HL)       

+5FEB 20 0A        .    JR    NZ,5FF7    

+5FED 25          %     DEC   H          

+5FEE CB C6       ..    SET   0,(HL)     

+5FF0 CB FD       ..    SET   7,L        

+5FF2 36 02       6.    LD    (HL),02    

+5FF4 CB BD       ..    RES   7,L        

+5FF6 24          $     INC   H          

+5FF7 2C          ,     INC   L          

+5FF8 F2 D7 5F    .._   JP    P,5FD7     

+5FFB 3A 5B 60    :[`   LD    A,(605B)   

+5FFE B7          .     OR    A          

+5FFF 28 12       (.    JR    Z,6013     

+6001 1E 00       ..    LD    E,00       

+6003 D5          .     PUSH  DE         

+6004 CD A6 5A    ..Z   CALL  5AA6       

+6007 09          .     ADD   HL,BC      

+6008 41          A     LD    B,C        

+6009 CB EE       ..    SET   5,(HL)     

+600B 23          #     INC   HL         

+600C 10 FB       ..    DJNZ  6009       

+600E D1          .     POP   DE         

+600F 1C          .     INC   E          

+6010 1C          .     INC   E          

+6011 20 F0        .    JR    NZ,6003    

+6013 ED 4B 64 60 .Kd`  LD    BC,(6064)  

+6017 21 D0 15    !..   LD    HL,15D0    

+601A CB 86       ..    RES   0,(HL)     

+601C 2C          ,     INC   L          

+601D C8          .     RET   Z          

+601E 10 FA       ..    DJNZ  601A       

+6020 C9          .     RET              ;-------------------------------

+6021 E5          .     PUSH  HL         

+6022 41          A     LD    B,C        

+6023 6C          l     LD    L,H        

+6024 37          7     SCF              

+6025 CB 1D       ..    RR    L          

+6027 26 15       &.    LD    H,15       

+6029 CD 1A 60    ..`   CALL  601A       

+602C E1          .     POP   HL         

+602D C9          .     RET              

+602E CD B6 5D    ..]   CALL  5DB6       

+6031 30 18       0.    JR    NC,604B    

+6033 7A          z     LD    A,D        

+6034 32 1F 16    2..   LD    (161F),A   

+6037 7B          {     LD    A,E        

+6038 32 1F 15    2..   LD    (151F),A   

+603B C5          .     PUSH  BC         

+603C D5          .     PUSH  DE         

+603D CD E2 6D    ..m   CALL  6DE2       

+6040 3A 1F 16    :..   LD    A,(161F)   

+6043 FE FD       ..    CP    FD         

+6045 20 F6        .    JR    NZ,603D    

+6047 D1          .     POP   DE         

+6048 C1          .     POP   BC         

+6049 18 E3       ..    JR    602E       

+604B 65          e     LD    H,L        

+604C CB 24       .$    SLA   H          

+604E 2E 00       ..    LD    L,00       

+6050 C9          .     RET              

+6051 3E 01       >.    LD    A,01       

+6053 32 B3 60    2.`   LD    (60B3),A   

+6056 C9          .     RET              

+6057 21 A8 15    !..   LD    HL,15A8    

+605A C9          .     RET              

+605B 00          .     NOP              

+605C 0F          .     RRCA             

+605D 00          .     NOP              

+605E 00          .     NOP              

+605F 00          .     NOP              

+6060 00          .     NOP              

+6061 00          .     NOP              

+6062 00          .     NOP              

+6063 00          .     NOP              

+6064 01 01 FF    ...   LD    BC,FF01    

+6067 03          .     INC   BC         

+6068 06 17       ..    LD    B,17       

+606A 00          .     NOP              

+606B 18 20       .     JR    608D       

+606D 6E          n     LD    L,(HL)     ; "noch ein Versuch"

+606E 6F          o     LD    L,A        

+606F 63          c     LD    H,E        

+6070 68          h     LD    L,B        

+6071 20 65        e    JR    NZ,60D8    

+6073 69          i     LD    L,C        

+6074 6E          n     LD    L,(HL)     

+6075 20 56        V    JR    NZ,60CD    

+6077 65          e     LD    H,L        

+6078 72          r     LD    (HL),D     

+6079 73          s     LD    (HL),E     

+607A 75          u     LD    (HL),L     

+607B 63          c     LD    H,E        

+607C 68          h     LD    L,B        

+607D 20 28        (    JR    NZ,60A7    

+607F 6A          j     LD    L,D        

+6080 29          )     ADD   HL,HL      

+6081 20 3F        ?    JR    NZ,60C2    

+6083 20 11        .    JR    NZ,6096    

+6085 20 69        i    JR    NZ,60F0    ; "ignore (MARK) ?"

+6087 67          g     LD    H,A        

+6088 6E          n     LD    L,(HL)     

+6089 6F          o     LD    L,A        

+608A 72          r     LD    (HL),D     

+608B 65          e     LD    H,L        

+608C 20 28        (    JR    NZ,60B6    

+608E 4D          M     LD    C,L        

+608F 41          A     LD    B,C        

+6090 52          R     LD    D,D        

+6091 4B          K     LD    C,E        

+6092 29          )     ADD   HL,HL      

+6093 20 3F        ?    JR    NZ,60D4    

+6095 20 00        .    JR    NZ,6097    

+6097 FF          .     RST   38         

+6098 FF          .     RST   38         

+6099 00          .     NOP              

+609A FF          .     RST   38         

+609B FF          .     RST   38         

+609C 00          .     NOP              

+609D DA 15 00    ...   JP    C,0015     

+60A0 00          .     NOP              

+60A1 00          .     NOP              

+60A2 00          .     NOP              

+60A3 00          .     NOP              

+60A4 01 00 00    ...   LD    BC,0000    

+60A7 00          .     NOP              

+60A8 00          .     NOP              

+60A9 00          .     NOP              

+60AA 00          .     NOP              

+60AB 00          .     NOP              

+60AC 00          .     NOP              

+60AD 00          .     NOP              

+60AE 00          .     NOP              

+60AF 00          .     NOP              

+60B0 00          .     NOP              

+60B1 20 16        .    JR    NZ,60C9    

+60B3 00          .     NOP              

+60B4 FF          .     RST   38         

+60B5 00          .     NOP              

+60B6 00          .     NOP              

+60B7 FF          .     RST   38         

+60B8 FF          .     RST   38         

+60B9 FF          .     RST   38         

+60BA FF          .     RST   38         

+60BB FF          .     RST   38         

+60BC FF          .     RST   38         

+60BD FF          .     RST   38         

+60BE FF          .     RST   38         

+60BF FF          .     RST   38         

+60C0 FF          .     RST   38         

+60C1 FF          .     RST   38         

+60C2 FF          .     RST   38         

+60C3 FF          .     RST   38         

+60C4 FF          .     RST   38         

+60C5 FF          .     RST   38         

+60C6 FF          .     RST   38         

+60C7 FF          .     RST   38         

+60C8 FF          .     RST   38         

+60C9 FF          .     RST   38         

+60CA FF          .     RST   38         

+60CB FF          .     RST   38         

+60CC FF          .     RST   38         

+60CD FF          .     RST   38         

+60CE FF          .     RST   38         

+60CF FF          .     RST   38         

+60D0 FF          .     RST   38         

+60D1 FF          .     RST   38         

+60D2 FF          .     RST   38         

+60D3 FF          .     RST   38         

+60D4 FF          .     RST   38         

+60D5 FF          .     RST   38         

+60D6 FF          .     RST   38         

+60D7 FF          .     RST   38         

+60D8 FF          .     RST   38         

+60D9 FF          .     RST   38         

+60DA FF          .     RST   38         

+60DB FF          .     RST   38         

+60DC FF          .     RST   38         

+60DD FF          .     RST   38         

+60DE FF          .     RST   38         

+60DF FF          .     RST   38         

+60E0 FF          .     RST   38         

+60E1 FF          .     RST   38         

+60E2 FF          .     RST   38         

+60E3 FF          .     RST   38         

+60E4 FF          .     RST   38         

+60E5 FF          .     RST   38         

+60E6 FF          .     RST   38         

+60E7 FF          .     RST   38         

+60E8 FF          .     RST   38         

+60E9 FF          .     RST   38         

+60EA FF          .     RST   38         

+60EB FF          .     RST   38         

+60EC FF          .     RST   38         

+60ED FF          .     RST   38         

+60EE FF          .     RST   38         

+60EF FF          .     RST   38         

+60F0 FF          .     RST   38         

+60F1 FF          .     RST   38         

+60F2 FF          .     RST   38         

+60F3 FF          .     RST   38         

+60F4 FF          .     RST   38         

+60F5 FF          .     RST   38         

+60F6 FF          .     RST   38         

+60F7 FF          .     RST   38         

+60F8 FF          .     RST   38         

+60F9 FF          .     RST   38         

+60FA FF          .     RST   38         

+60FB FF          .     RST   38         

+60FC FF          .     RST   38         

+60FD FF          .     RST   38         

+60FE FF          .     RST   38         

+60FF FF          .     RST   38         

+6100 FF          .     RST   38         

+6101 FF          .     RST   38         

+6102 FF          .     RST   38         

+6103 FF          .     RST   38         

+6104 FF          .     RST   38         

+6105 FF          .     RST   38         

+6106 FF          .     RST   38         

+6107 FF          .     RST   38         

+6108 FF          .     RST   38         

+6109 FF          .     RST   38         

+610A FF          .     RST   38         

+610B FF          .     RST   38         

+610C FF          .     RST   38         

+610D FF          .     RST   38         

+610E FF          .     RST   38         

+610F FF          .     RST   38         

+6110 FF          .     RST   38         

+6111 FF          .     RST   38         

+6112 FF          .     RST   38         

+6113 FF          .     RST   38         

+6114 FF          .     RST   38         

+6115 FF          .     RST   38         

+6116 FF          .     RST   38         

+6117 FF          .     RST   38         

+6118 FF          .     RST   38         

+6119 FF          .     RST   38         

+611A FF          .     RST   38         

+611B FF          .     RST   38         

+611C FF          .     RST   38         

+611D FF          .     RST   38         

+611E FF          .     RST   38         

+611F FF          .     RST   38         

+6120 FF          .     RST   38         

+6121 FF          .     RST   38         

+6122 FF          .     RST   38         

+6123 FF          .     RST   38         

+6124 FF          .     RST   38         

+6125 FF          .     RST   38         

+6126 FF          .     RST   38         

+6127 FF          .     RST   38         

+6128 FF          .     RST   38         

+6129 FF          .     RST   38         

+612A FF          .     RST   38         

+612B FF          .     RST   38         

+612C FF          .     RST   38         

+612D FF          .     RST   38         

+612E FF          .     RST   38         

+612F FF          .     RST   38         

+6130 FF          .     RST   38         

+6131 FF          .     RST   38         

+6132 FF          .     RST   38         

+6133 FF          .     RST   38         

+6134 FF          .     RST   38         

+6135 FF          .     RST   38         

+6136 FF          .     RST   38         

+6137 FF          .     RST   38         

+6138 FF          .     RST   38         

+6139 FF          .     RST   38         

+613A FF          .     RST   38         

+613B FF          .     RST   38         

+613C FF          .     RST   38         

+613D FF          .     RST   38         

+613E FF          .     RST   38         

+613F FF          .     RST   38         

+6140 FF          .     RST   38         

+6141 FF          .     RST   38         

+6142 FF          .     RST   38         

+6143 FF          .     RST   38         

+6144 FF          .     RST   38         

+6145 FF          .     RST   38         

+6146 FF          .     RST   38         

+6147 FF          .     RST   38         

+6148 FF          .     RST   38         

+6149 FF          .     RST   38         

+614A FF          .     RST   38         

+614B FF          .     RST   38         

+614C FF          .     RST   38         

+614D FF          .     RST   38         

+614E FF          .     RST   38         

+614F FF          .     RST   38         

+6150 FF          .     RST   38         

+6151 FF          .     RST   38         

+6152 FF          .     RST   38         

+6153 FF          .     RST   38         

+6154 FF          .     RST   38         

+6155 FF          .     RST   38         

+6156 FF          .     RST   38         

+6157 FF          .     RST   38         

+6158 FF          .     RST   38         

+6159 FF          .     RST   38         

+615A FF          .     RST   38         

+615B FF          .     RST   38         

+615C FF          .     RST   38         

+615D FF          .     RST   38         

+615E FF          .     RST   38         

+615F FF          .     RST   38         

+6160 FF          .     RST   38         

+6161 FF          .     RST   38         

+6162 FF          .     RST   38         

+6163 FF          .     RST   38         

+6164 FF          .     RST   38         

+6165 FF          .     RST   38         

+6166 FF          .     RST   38         

+6167 FF          .     RST   38         

+6168 FF          .     RST   38         

+6169 FF          .     RST   38         

+616A FF          .     RST   38         

+616B FF          .     RST   38         

+616C FF          .     RST   38         

+616D FF          .     RST   38         

+616E FF          .     RST   38         

+616F FF          .     RST   38         

+6170 FF          .     RST   38         

+6171 FF          .     RST   38         

+6172 FF          .     RST   38         

+6173 FF          .     RST   38         

+6174 FF          .     RST   38         

+6175 FF          .     RST   38         

+6176 FF          .     RST   38         

+6177 FF          .     RST   38         

+6178 FF          .     RST   38         

+6179 FF          .     RST   38         

+617A FF          .     RST   38         

+617B FF          .     RST   38         

+617C FF          .     RST   38         

+617D FF          .     RST   38         

+617E FF          .     RST   38         

+617F FF          .     RST   38         

+6180 FF          .     RST   38         

+6181 FF          .     RST   38         

+6182 FF          .     RST   38         

+6183 FF          .     RST   38         

+6184 FF          .     RST   38         

+6185 FF          .     RST   38         

+6186 FF          .     RST   38         

+6187 FF          .     RST   38         

+6188 FF          .     RST   38         

+6189 FF          .     RST   38         

+618A FF          .     RST   38         

+618B FF          .     RST   38         

+618C FF          .     RST   38         

+618D FF          .     RST   38         

+618E FF          .     RST   38         

+618F FF          .     RST   38         

+6190 FF          .     RST   38         

+6191 FF          .     RST   38         

+6192 FF          .     RST   38         

+6193 FF          .     RST   38         

+6194 FF          .     RST   38         

+6195 FF          .     RST   38         

+6196 FF          .     RST   38         

+6197 FF          .     RST   38         

+6198 FF          .     RST   38         

+6199 FF          .     RST   38         

+619A FF          .     RST   38         

+619B FF          .     RST   38         

+619C FF          .     RST   38         

+619D FF          .     RST   38         

+619E FF          .     RST   38         

+619F FF          .     RST   38         

+61A0 FF          .     RST   38         

+61A1 FF          .     RST   38         

+61A2 FF          .     RST   38         

+61A3 FF          .     RST   38         

+61A4 FF          .     RST   38         

+61A5 FF          .     RST   38         

+61A6 FF          .     RST   38         

+61A7 FF          .     RST   38         

+61A8 FF          .     RST   38         

+61A9 FF          .     RST   38         

+61AA FF          .     RST   38         

+61AB FF          .     RST   38         

+61AC FF          .     RST   38         

+61AD FF          .     RST   38         

+61AE FF          .     RST   38         

+61AF FF          .     RST   38         

+61B0 FF          .     RST   38         

+61B1 FF          .     RST   38         

+61B2 FF          .     RST   38         

+61B3 FF          .     RST   38         

+61B4 FF          .     RST   38         

+61B5 FF          .     RST   38         

+61B6 FF          .     RST   38         

+61B7 FF          .     RST   38         

+61B8 FF          .     RST   38         

+61B9 FF          .     RST   38         

+61BA FF          .     RST   38         

+61BB FF          .     RST   38         

+61BC FF          .     RST   38         

+61BD FF          .     RST   38         

+61BE FF          .     RST   38         

+61BF FF          .     RST   38         

+61C0 FF          .     RST   38         

+61C1 FF          .     RST   38         

+61C2 FF          .     RST   38         

+61C3 FF          .     RST   38         

+61C4 FF          .     RST   38         

+61C5 FF          .     RST   38         

+61C6 FF          .     RST   38         

+61C7 FF          .     RST   38         

+61C8 FF          .     RST   38         

+61C9 FF          .     RST   38         

+61CA FF          .     RST   38         

+61CB FF          .     RST   38         

+61CC FF          .     RST   38         

+61CD FF          .     RST   38         

+61CE FF          .     RST   38         

+61CF FF          .     RST   38         

+61D0 FF          .     RST   38         

+61D1 FF          .     RST   38         

+61D2 FF          .     RST   38         

+61D3 FF          .     RST   38         

+61D4 FF          .     RST   38         

+61D5 FF          .     RST   38         

+61D6 FF          .     RST   38         

+61D7 FF          .     RST   38         

+61D8 FF          .     RST   38         

+61D9 FF          .     RST   38         

+61DA FF          .     RST   38         

+61DB FF          .     RST   38         

+61DC FF          .     RST   38         

+61DD FF          .     RST   38         

+61DE FF          .     RST   38         

+61DF FF          .     RST   38         

+61E0 FF          .     RST   38         

+61E1 FF          .     RST   38         

+61E2 FF          .     RST   38         

+61E3 FF          .     RST   38         

+61E4 FF          .     RST   38         

+61E5 FF          .     RST   38         

+61E6 FF          .     RST   38         

+61E7 FF          .     RST   38         

+61E8 FF          .     RST   38         

+61E9 FF          .     RST   38         

+61EA FF          .     RST   38         

+61EB FF          .     RST   38         

+61EC FF          .     RST   38         

+61ED FF          .     RST   38         

+61EE FF          .     RST   38         

+61EF FF          .     RST   38         

+61F0 FF          .     RST   38         

+61F1 FF          .     RST   38         

+61F2 FF          .     RST   38         

+61F3 FF          .     RST   38         

+61F4 FF          .     RST   38         

+61F5 FF          .     RST   38         

+61F6 FF          .     RST   38         

+61F7 FF          .     RST   38         

+61F8 FF          .     RST   38         

+61F9 FF          .     RST   38         

+61FA FF          .     RST   38         

+61FB FF          .     RST   38         

+61FC FF          .     RST   38         

+61FD FF          .     RST   38         

+61FE FF          .     RST   38         

+61FF FF          .     RST   38         

+6200 FF          .     RST   38         

+6201 FF          .     RST   38         

+6202 FF          .     RST   38         

+6203 FF          .     RST   38         

+6204 FF          .     RST   38         

+6205 FF          .     RST   38         

+6206 FF          .     RST   38         

+6207 FF          .     RST   38         

+6208 FF          .     RST   38         

+6209 FF          .     RST   38         

+620A FF          .     RST   38         

+620B FF          .     RST   38         

+620C FF          .     RST   38         

+620D FF          .     RST   38         

+620E FF          .     RST   38         

+620F FF          .     RST   38         

+6210 FF          .     RST   38         

+6211 FF          .     RST   38         

+6212 FF          .     RST   38         

+6213 FF          .     RST   38         

+6214 FF          .     RST   38         

+6215 FF          .     RST   38         

+6216 FF          .     RST   38         

+6217 FF          .     RST   38         

+6218 FF          .     RST   38         

+6219 FF          .     RST   38         

+621A FF          .     RST   38         

+621B FF          .     RST   38         

+621C FF          .     RST   38         

+621D FF          .     RST   38         

+621E FF          .     RST   38         

+621F FF          .     RST   38         

+6220 FF          .     RST   38         

+6221 FF          .     RST   38         

+6222 FF          .     RST   38         

+6223 FF          .     RST   38         

+6224 FF          .     RST   38         

+6225 FF          .     RST   38         

+6226 FF          .     RST   38         

+6227 FF          .     RST   38         

+6228 FF          .     RST   38         

+6229 FF          .     RST   38         

+622A FF          .     RST   38         

+622B FF          .     RST   38         

+622C FF          .     RST   38         

+622D FF          .     RST   38         

+622E FF          .     RST   38         

+622F FF          .     RST   38         

+6230 FF          .     RST   38         

+6231 FF          .     RST   38         

+6232 FF          .     RST   38         

+6233 FF          .     RST   38         

+6234 FF          .     RST   38         

+6235 FF          .     RST   38         

+6236 FF          .     RST   38         

+6237 FF          .     RST   38         

+6238 FF          .     RST   38         

+6239 FF          .     RST   38         

+623A FF          .     RST   38         

+623B FF          .     RST   38         

+623C FF          .     RST   38         

+623D FF          .     RST   38         

+623E FF          .     RST   38         

+623F FF          .     RST   38         

+6240 FF          .     RST   38         

+6241 FF          .     RST   38         

+6242 FF          .     RST   38         

+6243 FF          .     RST   38         

+6244 FF          .     RST   38         

+6245 FF          .     RST   38         

+6246 FF          .     RST   38         

+6247 FF          .     RST   38         

+6248 FF          .     RST   38         

+6249 FF          .     RST   38         

+624A FF          .     RST   38         

+624B FF          .     RST   38         

+624C FF          .     RST   38         

+624D FF          .     RST   38         

+624E FF          .     RST   38         

+624F FF          .     RST   38         

+6250 FF          .     RST   38         

+6251 FF          .     RST   38         

+6252 FF          .     RST   38         

+6253 FF          .     RST   38         

+6254 FF          .     RST   38         

+6255 FF          .     RST   38         

+6256 FF          .     RST   38         

+6257 FF          .     RST   38         

+6258 FF          .     RST   38         

+6259 FF          .     RST   38         

+625A FF          .     RST   38         

+625B FF          .     RST   38         

+625C FF          .     RST   38         

+625D FF          .     RST   38         

+625E FF          .     RST   38         

+625F FF          .     RST   38         

+6260 FF          .     RST   38         

+6261 FF          .     RST   38         

+6262 FF          .     RST   38         

+6263 FF          .     RST   38         

+6264 FF          .     RST   38         

+6265 FF          .     RST   38         

+6266 FF          .     RST   38         

+6267 FF          .     RST   38         

+6268 FF          .     RST   38         

+6269 FF          .     RST   38         

+626A FF          .     RST   38         

+626B FF          .     RST   38         

+626C FF          .     RST   38         

+626D FF          .     RST   38         

+626E FF          .     RST   38         

+626F FF          .     RST   38         

+6270 FF          .     RST   38         

+6271 FF          .     RST   38         

+6272 FF          .     RST   38         

+6273 FF          .     RST   38         

+6274 FF          .     RST   38         

+6275 FF          .     RST   38         

+6276 FF          .     RST   38         

+6277 FF          .     RST   38         

+6278 FF          .     RST   38         

+6279 FF          .     RST   38         

+627A FF          .     RST   38         

+627B FF          .     RST   38         

+627C FF          .     RST   38         

+627D FF          .     RST   38         

+627E FF          .     RST   38         

+627F FF          .     RST   38         

+6280 FF          .     RST   38         

+6281 FF          .     RST   38         

+6282 FF          .     RST   38         

+6283 FF          .     RST   38         

+6284 FF          .     RST   38         

+6285 FF          .     RST   38         

+6286 FF          .     RST   38         

+6287 FF          .     RST   38         

+6288 FF          .     RST   38         

+6289 FF          .     RST   38         

+628A FF          .     RST   38         

+628B FF          .     RST   38         

+628C FF          .     RST   38         

+628D FF          .     RST   38         

+628E FF          .     RST   38         

+628F FF          .     RST   38         

+6290 FF          .     RST   38         

+6291 FF          .     RST   38         

+6292 FF          .     RST   38         

+6293 FF          .     RST   38         

+6294 FF          .     RST   38         

+6295 FF          .     RST   38         

+6296 FF          .     RST   38         

+6297 FF          .     RST   38         

+6298 FF          .     RST   38         

+6299 FF          .     RST   38         

+629A FF          .     RST   38         

+629B FF          .     RST   38         

+629C FF          .     RST   38         

+629D FF          .     RST   38         

+629E FF          .     RST   38         

+629F FF          .     RST   38         

+62A0 FF          .     RST   38         

+62A1 FF          .     RST   38         

+62A2 FF          .     RST   38         

+62A3 FF          .     RST   38         

+62A4 FF          .     RST   38         

+62A5 FF          .     RST   38         

+62A6 FF          .     RST   38         

+62A7 FF          .     RST   38         

+62A8 FF          .     RST   38         

+62A9 FF          .     RST   38         

+62AA FF          .     RST   38         

+62AB FF          .     RST   38         

+62AC FF          .     RST   38         

+62AD FF          .     RST   38         

+62AE FF          .     RST   38         

+62AF FF          .     RST   38         

+62B0 FF          .     RST   38         

+62B1 FF          .     RST   38         

+62B2 FF          .     RST   38         

+62B3 FF          .     RST   38         

+62B4 FF          .     RST   38         

+62B5 FF          .     RST   38         

+62B6 FF          .     RST   38         

+62B7 61          a     LD    H,C        ; "archiv   3 (!)"

+62B8 72          r     LD    (HL),D     

+62B9 63          c     LD    H,E        

+62BA 68          h     LD    L,B        

+62BB 69          i     LD    L,C        

+62BC 76          v     HALT             

+62BD 20 20             JR    NZ,62DF    

+62BF 20 33        3    JR    NZ,62F4    

+62C1 20 28        (    JR    NZ,62EB    

+62C3 21 29 50    !)P   LD    HL,5029    ; "PROZ ARCH"

+62C6 52          R     LD    D,D        

+62C7 4F          O     LD    C,A        

+62C8 5A          Z     LD    E,D        

+62C9 20 41        A    JR    NZ,630C    

+62CB 52          R     LD    D,D        

+62CC 43          C     LD    B,E        

+62CD 48          H     LD    C,B        

+62CE 54          T     LD    D,H        

+62CF 63          c     LD    H,E        

+62D0 C3 DE 63    ..c   JP    63DE       

+62D3 41          A     LD    B,C        

+62D4 FF          .     RST   38         

+62D5 FF          .     RST   38         

+62D6 FF          .     RST   38         

+62D7 FF          .     RST   38         

+62D8 FF          .     RST   38         

+62D9 FF          .     RST   38         

+62DA FF          .     RST   38         

+62DB FF          .     RST   38         

+62DC FF          .     RST   38         

+62DD FF          .     RST   38         

+62DE FF          .     RST   38         

+62DF FF          .     RST   38         

+62E0 FF          .     RST   38         

+62E1 FF          .     RST   38         

+62E2 FF          .     RST   38         

+62E3 FF          .     RST   38         

+62E4 FF          .     RST   38         

+62E5 FF          .     RST   38         

+62E6 FF          .     RST   38         

+62E7 FF          .     RST   38         

+62E8 FF          .     RST   38         

+62E9 FF          .     RST   38         

+62EA FF          .     RST   38         

+62EB FF          .     RST   38         

+62EC FF          .     RST   38         

+62ED FF          .     RST   38         

+62EE FF          .     RST   38         

+62EF FF          .     RST   38         

+62F0 FF          .     RST   38         

+62F1 FF          .     RST   38         

+62F2 FF          .     RST   38         

+62F3 FF          .     RST   38         

+62F4 FF          .     RST   38         

+62F5 FF          .     RST   38         

+62F6 FF          .     RST   38         

+62F7 FF          .     RST   38         

+62F8 FF          .     RST   38         

+62F9 FF          .     RST   38         

+62FA FF          .     RST   38         

+62FB FF          .     RST   38         

+62FC FF          .     RST   38         

+62FD FF          .     RST   38         

+62FE FF          .     RST   38         

+62FF FF          .     RST   38         

+6300 FF          .     RST   38         

+6301 FF          .     RST   38         

+6302 FF          .     RST   38         

+6303 FF          .     RST   38         

+6304 FF          .     RST   38         

+6305 FF          .     RST   38         

+6306 FF          .     RST   38         

+6307 FF          .     RST   38         

+6308 FF          .     RST   38         

+6309 FF          .     RST   38         

+630A FF          .     RST   38         

+630B FF          .     RST   38         

+630C FF          .     RST   38         

+630D FF          .     RST   38         

+630E FF          .     RST   38         

+630F FF          .     RST   38         

+6310 FF          .     RST   38         

+6311 FF          .     RST   38         

+6312 FF          .     RST   38         

+6313 FF          .     RST   38         

+6314 FF          .     RST   38         

+6315 FF          .     RST   38         

+6316 FF          .     RST   38         

+6317 FF          .     RST   38         

+6318 FF          .     RST   38         

+6319 FF          .     RST   38         

+631A FF          .     RST   38         

+631B FF          .     RST   38         

+631C FF          .     RST   38         

+631D FF          .     RST   38         

+631E FF          .     RST   38         

+631F FF          .     RST   38         

+6320 FF          .     RST   38         

+6321 FF          .     RST   38         

+6322 FF          .     RST   38         

+6323 FF          .     RST   38         

+6324 FF          .     RST   38         

+6325 FF          .     RST   38         

+6326 FF          .     RST   38         

+6327 FF          .     RST   38         

+6328 FF          .     RST   38         

+6329 FF          .     RST   38         

+632A FF          .     RST   38         

+632B FF          .     RST   38         

+632C FF          .     RST   38         

+632D FF          .     RST   38         

+632E FF          .     RST   38         

+632F FF          .     RST   38         

+6330 FF          .     RST   38         

+6331 FF          .     RST   38         

+6332 FF          .     RST   38         

+6333 FF          .     RST   38         

+6334 FF          .     RST   38         

+6335 FF          .     RST   38         

+6336 FF          .     RST   38         

+6337 FF          .     RST   38         

+6338 FF          .     RST   38         

+6339 FF          .     RST   38         

+633A FF          .     RST   38         

+633B FF          .     RST   38         

+633C FF          .     RST   38         

+633D FF          .     RST   38         

+633E FF          .     RST   38         

+633F FF          .     RST   38         

+6340 FF          .     RST   38         

+6341 FF          .     RST   38         

+6342 FF          .     RST   38         

+6343 FF          .     RST   38         

+6344 FF          .     RST   38         

+6345 FF          .     RST   38         

+6346 FF          .     RST   38         

+6347 FF          .     RST   38         

+6348 FF          .     RST   38         

+6349 FF          .     RST   38         

+634A FF          .     RST   38         

+634B FF          .     RST   38         

+634C FF          .     RST   38         

+634D FF          .     RST   38         

+634E FF          .     RST   38         

+634F FF          .     RST   38         

+6350 FF          .     RST   38         

+6351 FF          .     RST   38         

+6352 FF          .     RST   38         

+6353 FF          .     RST   38         

+6354 56          V     LD    D,(HL)     

+6355 63          c     LD    H,E        

+6356 21 B5 4C    !.L   LD    HL,4CB5    

+6359 CB 96       ..    RES   2,(HL)     

+635B CD E2 6D    ..m   CALL  6DE2       

+635E 3A 51 64    :Qd   LD    A,(6451)   

+6361 B7          .     OR    A          

+6362 28 F7       (.    JR    Z,635B     

+6364 FA 5B 63    .[c   JP    M,635B     

+6367 21 B5 4C    !.L   LD    HL,4CB5    

+636A CB D6       ..    SET   2,(HL)     

+636C FE 0C       ..    CP    0C         

+636E DA 81 63    ..c   JP    C,6381     

+6371 CD 1F 70    ..p   CALL  701F       

+6374 18 04       ..    JR    637A       

+6376 20 3F        ?    JR    NZ,63B7    

+6378 3F          ?     CCF              

+6379 3F          ?     CCF              

+637A 3E 00       >.    LD    A,00       

+637C 32 51 64    2Qd   LD    (6451),A   

+637F 18 D5       ..    JR    6356       

+6381 2A 49 64    *Id   LD    HL,(6449)  

+6384 ED 5B 4D 64 .[Md  LD    DE,(644D)  

+6388 ED 4B 4B 64 .KKd  LD    BC,(644B)  

+638C FE 0A       ..    CP    0A         

+638E 28 1F       (.    JR    Z,63AF     

+6390 FE 0B       ..    CP    0B         

+6392 3A 4F 64    :Od   LD    A,(644F)   

+6395 28 05       (.    JR    Z,639C     

+6397 CD 7E 28    .~(   CALL  287E       

+639A 18 19       ..    JR    63B5       

+639C EB          .     EX    DE,HL      

+639D ED 5B 4B 64 .[Kd  LD    DE,(644B)  

+63A1 ED 4B 49 64 .KId  LD    BC,(6449)  

+63A5 CD A8 28    ..(   CALL  28A8       

+63A8 ED 43 53 64 .CSd  LD    (6453),BC  

+63AC C3 7A 63    .zc   JP    637A       

+63AF 3A 4F 64    :Od   LD    A,(644F)   

+63B2 CD 81 28    ..(   CALL  2881       

+63B5 ED 43 53 64 .CSd  LD    (6453),BC  

+63B9 2A 49 64    *Id   LD    HL,(6449)  

+63BC CD CC 63    ..c   CALL  63CC       

+63BF C3 7A 63    .zc   JP    637A       

+63C2 01 01 00    ...   LD    BC,0001    

+63C5 ED 43 53 64 .CSd  LD    (6453),BC  

+63C9 C3 7A 63    .zc   JP    637A       

+63CC 6C          l     LD    L,H        

+63CD 37          7     SCF              

+63CE CB 1D       ..    RR    L          

+63D0 26 15       &.    LD    H,15       

+63D2 CB 86       ..    RES   0,(HL)     

+63D4 C9          .     RET              

+63D5 6C          l     LD    L,H        

+63D6 37          7     SCF              

+63D7 CB 1D       ..    RR    L          

+63D9 26 15       &.    LD    H,15       

+63DB CB C6       ..    SET   0,(HL)     

+63DD C9          .     RET              

+63DE F5          .     PUSH  AF         

+63DF 3E 09       >.    LD    A,09       

+63E1 F5          .     PUSH  AF         

+63E2 E5          .     PUSH  HL         

+63E3 21 51 64    !Qd   LD    HL,6451    

+63E6 7E          ~     LD    A,(HL)     

+63E7 B7          .     OR    A          

+63E8 C2 1A 6C    ..l   JP    NZ,6C1A    

+63EB 23          #     INC   HL         

+63EC 7E          ~     LD    A,(HL)     

+63ED B7          .     OR    A          

+63EE 28 11       (.    JR    Z,6401     

+63F0 3A 1A 6E    :.n   LD    A,(6E1A)   

+63F3 BE          .     CP    (HL)       

+63F4 C2 1A 6C    ..l   JP    NZ,6C1A    

+63F7 36 00       6.    LD    (HL),00    

+63F9 ED 4B 53 64 .KSd  LD    BC,(6453)  

+63FD E1          .     POP   HL         

+63FE F1          .     POP   AF         

+63FF F1          .     POP   AF         

+6400 C9          .     RET              

+6401 3A 1A 6E    :.n   LD    A,(6E1A)   

+6404 77          w     LD    (HL),A     

+6405 E1          .     POP   HL         

+6406 ED 53 49 64 .SId  LD    (6449),DE  

+640A 22 4B 64    "Kd   LD    (644B),HL  

+640D ED 43 4D 64 .CMd  LD    (644D),BC  

+6411 F1          .     POP   AF         

+6412 EB          .     EX    DE,HL      

+6413 32 51 64    2Qd   LD    (6451),A   

+6416 FE 0B       ..    CP    0B         

+6418 C4 D5 63    ..c   CALL  NZ,63D5    

+641B F1          .     POP   AF         

+641C 32 4F 64    2Od   LD    (644F),A   

+641F 21 51 64    !Qd   LD    HL,6451    

+6422 C3 1A 6C    ..l   JP    6C1A       

+6425 F5          .     PUSH  AF         

+6426 3E 0A       >.    LD    A,0A       

+6428 18 B7       ..    JR    63E1       

+642A F5          .     PUSH  AF         

+642B 3E 0B       >.    LD    A,0B       

+642D 18 B2       ..    JR    63E1       

+642F E5          .     PUSH  HL         

+6430 21 52 64    !Rd   LD    HL,6452    

+6433 BE          .     CP    (HL)       

+6434 20 02        .    JR    NZ,6438    

+6436 36 00       6.    LD    (HL),00    

+6438 E1          .     POP   HL         

+6439 C9          .     RET              

+643A ED 4B 45 64 .KEd  LD    BC,(6445)  

+643E 21 00 00    !..   LD    HL,0000    

+6441 22 45 64    "Ed   LD    (6445),HL  

+6444 C9          .     RET              

+6445 00          .     NOP              

+6446 00          .     NOP              

+6447 00          .     NOP              

+6448 00          .     NOP              

+6449 FF          .     RST   38         

+644A FF          .     RST   38         

+644B FF          .     RST   38         

+644C FF          .     RST   38         

+644D FF          .     RST   38         

+644E FF          .     RST   38         

+644F FF          .     RST   38         

+6450 00          .     NOP              

+6451 00          .     NOP              

+6452 00          .     NOP              

+6453 05          .     DEC   B          

+6454 00          .     NOP              

+6455 00          .     NOP              

+6456 00          .     NOP              

+6457 00          .     NOP              

+6458 00          .     NOP              

+6459 00          .     NOP              

+645A 00          .     NOP              

+645B 00          .     NOP              

+645C 00          .     NOP              

+645D 00          .     NOP              

+645E 00          .     NOP              

+645F 00          .     NOP              

+6460 00          .     NOP              

+6461 00          .     NOP              

+6462 00          .     NOP              

+6463 00          .     NOP              

+6464 00          .     NOP              

+6465 00          .     NOP              

+6466 00          .     NOP              

+6467 00          .     NOP              

+6468 00          .     NOP              

+6469 00          .     NOP              

+646A 00          .     NOP              

+646B 31 37 35    175   LD    SP,3537    ; "175---spver quelle   3 (!)"

+646E 2D          -     DEC   L          

+646F 2D          -     DEC   L          

+6470 2D          -     DEC   L          

+6471 73          s     LD    (HL),E     

+6472 70          p     LD    (HL),B     

+6473 76          v     HALT             

+6474 65          e     LD    H,L        

+6475 72          r     LD    (HL),D     

+6476 2E 71       .q    LD    L,71       

+6478 75          u     LD    (HL),L     

+6479 65          e     LD    H,L        

+647A 6C          l     LD    L,H        

+647B 6C          l     LD    L,H        

+647C 65          e     LD    H,L        

+647D 20 20             JR    NZ,649F    

+647F 20 33        3    JR    NZ,64B4    

+6481 20 28        (    JR    NZ,64AB    

+6483 21 29 01    !).   LD    HL,0129    

+6486 38 00       8.    JR    C,6488     

+6488 CD D8 81    ...   CALL  81D8       

+648B FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+648F FD 46 04    .F.   LD    B,(IY+04)  

+6492 FD 4E 03    .N.   LD    C,(IY+03)  

+6495 C5          .     PUSH  BC         

+6496 ED 73 51 65 .sQe  LD    (6551),SP  

+649A 01 3B 65    .;e   LD    BC,653B    

+649D FD 70 04    .p.   LD    (IY+04),B  

+64A0 FD 71 03    .q.   LD    (IY+03),C  

+64A3 CD 48 65    .He   CALL  6548       

+64A6 11 00 00    ...   LD    DE,0000    ; Block 0

+64A9 CD 4E 6A    .Nj   CALL  6A4E       ; In RAM holen (Adresse in HL)

+64AC 67          g     LD    H,A        ; Ettikettadresse (Highbyte in H)

+64AD 97          .     SUB   A          ; HG-Kanal

+64AE 01 05 00    ...   LD    BC,0005    ; IOCONTROL 'size'

+64B1 CD A8 28    ..(   CALL  28A8       

+64B4 2E 24       .$    LD    L,24       ; 'aus historischen Gr�nden...' 

+64B6 CB 28       .(    SRA   B          ; = HG-Blocks DIV 8

+64B8 CB 19       ..    RR    C          

+64BA CB 28       .(    SRA   B          

+64BC CB 19       ..    RR    C          

+64BE CB 28       .(    SRA   B          

+64C0 CB 19       ..    RR    C          

+64C2 71          q     LD    (HL),C     ; eintragen

+64C3 23          #     INC   HL         

+64C4 70          p     LD    (HL),B     

+64C5 2E 0E       ..    LD    L,0E       ; session INCR 1

+64C7 5E          ^     LD    E,(HL)     

+64C8 2C          ,     INC   L          

+64C9 56          V     LD    D,(HL)     

+64CA 13          .     INC   DE         

+64CB 72          r     LD    (HL),D     

+64CC 2D          -     DEC   L          

+64CD 73          s     LD    (HL),E     

+64CE ED 53 17 6B .S.k  LD    (6B17),DE  ; Ausserdem in 6B17 ablegen

+64D2 2E 46       .F    LD    L,46       ; Infopassword

+64D4 11 19 7D    ..}   LD    DE,7D19    ; Lesen --> 7D19 

+64D7 01 0A 00    ...   LD    BC,000A    ; 10 Bytes 

+64DA ED B0       ..    LDIR             

+64DC 2E 50       .P    LD    L,50       ;

+64DE 7E          ~     LD    A,(HL)     

+64DF FE 01       ..    CP    01         ; 1 = frisches System 

+64E1 20 17        .    JR    NZ,64FA    

+64E3 36 00       6.    LD    (HL),00    ; jetzt nicht frisch 

+64E5 3E 11       >.    LD    A,11       ; Funktion 17 

+64E7 CD BB 81    ...   CALL  81BB       

+64EA CD 26 65    .&e   CALL  6526       

+64ED 3E 12       >.    LD    A,12       ; Funktion 18 'System aufbauen'

+64EF CD BB 81    ...   CALL  81BB       

+64F2 21 1A 6B    !.k   LD    HL,6B1A    

+64F5 CD CA 6E    ..n   CALL  6ECA       

+64F8 18 20       .     JR    651A       ; das wars

+64FA 2E 0D       ..    LD    L,0D       ; 0 = shutup-Zustand

+64FC CB 4E       .N    BIT   1,(HL)     

+64FE 28 08       (.    JR    Z,6508     

+6500 21 00 6B    !.k   LD    HL,6B00    ; Alte Werte benuzten 6B00.. 

+6503 CD CA 6E    ..n   CALL  6ECA       

+6506 18 02       ..    JR    650A       

+6508 36 FF       6.    LD    (HL),FF    ; FF = kein Shutup

+650A CD 48 65    .He   CALL  6548       

+650D CD 18 53    ..S   CALL  5318       

+6510 3E 01       >.    LD    A,01       ; Funktion 1

+6512 CD BB 81    ...   CALL  81BB       

+6515 CD 26 65    .&e   CALL  6526       

+6518 18 00       ..    JR    651A       

+651A C1          .     POP   BC         ; 

+651B FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+651F FD 70 04    .p.   LD    (IY+04),B  

+6522 FD 71 03    .q.   LD    (IY+03),C  

+6525 C9          .     RET              

+6526 CD 48 65    .He   CALL  6548       ; N�chsten MINI

+6529 11 02 00    ...   LD    DE,0002    ; Block "2" ist Systemanker

+652C CD 36 6A    .6j   CALL  6A36       ; A ist Adresse (Highbyte)

+652F 67          g     LD    H,A        

+6530 2E 00       ..    LD    L,00       

+6532 11 2B 1E    .+.   LD    DE,1E2B    

+6535 01 10 00    ...   LD    BC,0010    ; 16 Bytes (DR_DR) �bertragen

+6538 ED B0       ..    LDIR             

+653A C9          .     RET              

+653B ED 7B 51 65 .{Qe  LD    SP,(6551)  

+653F CD E2 6D    ..m   CALL  6DE2       

+6542 FD 2A 53 65 .*Se  LD    IY,(6553)  

+6546 FD E9       ..    JP    (IY)       

+6548 E1          .     POP   HL         

+6549 ED 73 51 65 .sQe  LD    (6551),SP  

+654D 22 53 65    "Se   LD    (6553),HL  

+6550 E9          .     JP    (HL)       

+6551 00          .     NOP              ; MINI-Savestackpointer 

+6552 00          .     NOP              

+6553 00          .     NOP              ; MINI IY Zeigt auf MINI-Descriptor

+6554 00          .     NOP              

+6555 CD 5C 65    .\e   CALL  655C       

+6558 CD CA 5C    ..\   CALL  5CCA       

+655B C9          .     RET              

+655C 7A          z     LD    A,D        

+655D FE 04       ..    CP    04         

+655F 30 02       0.    JR    NC,6563    ; Korrekte DSnr in D ? 

+6561 16 05       ..    LD    D,05       ; Nein 'errorspace' 5 

+6563 C5          .     PUSH  BC         

+6564 E5          .     PUSH  HL         

+6565 3A 1A 6E    :.n   LD    A,(6E1A)   

+6568 6F          o     LD    L,A        

+6569 7D          }     LD    A,L        

+656A 87          .     ADD   A          

+656B 8B          .     ADC   E          

+ - Fortsetzung in Datei "eumel0.prt.4" -

+

diff --git a/system/eumel0-z80/src/eumel0.prt.4 b/system/eumel0-z80/src/eumel0.prt.4
new file mode 100644
index 0000000..3eb9b03
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.4
@@ -0,0 +1,4001 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+656C 8A          .     ADC   D          

+656D 8C          .     ADC   H          

+656E 4F          O     LD    C,A        

+656F 06 14       ..    LD    B,14       

+6571 0A          .     LD    A,(BC)     

+6572 4F          O     LD    C,A        

+6573 06 18       ..    LD    B,18       

+6575 0A          .     LD    A,(BC)     

+6576 BC          .     CP    H          

+6577 20 15        .    JR    NZ,658E    

+6579 05          .     DEC   B          

+657A 0A          .     LD    A,(BC)     

+657B BA          .     CP    D          

+657C 20 10        .    JR    NZ,658E    

+657E CB F9       ..    SET   7,C        

+6580 0A          .     LD    A,(BC)     

+6581 BB          .     CP    E          

+6582 20 0A        .    JR    NZ,658E    

+6584 05          .     DEC   B          

+6585 0A          .     LD    A,(BC)     

+6586 BD          .     CP    L          

+6587 20 05        .    JR    NZ,658E    

+6589 79          y     LD    A,C        

+658A 87          .     ADD   A          

+658B E1          .     POP   HL         

+658C C1          .     POP   BC         

+658D C9          .     RET              

+658E DD E5       ..    PUSH  IX         

+6590 FD E5       ..    PUSH  IY         

+6592 D5          .     PUSH  DE         

+6593 7D          }     LD    A,L        

+6594 6C          l     LD    L,H        

+6595 63          c     LD    H,E        

+6596 5A          Z     LD    E,D        

+6597 57          W     LD    D,A        

+6598 E5          .     PUSH  HL         

+6599 7B          {     LD    A,E        

+659A FE 20       .     CP    20         

+659C 38 36       86    JR    C,65D4     

+659E CD DA 66    ..f   CALL  66DA       

+65A1 D1          .     POP   DE         

+65A2 CD E1 65    ..e   CALL  65E1       

+65A5 D1          .     POP   DE         

+65A6 FD E1       ..    POP   IY         

+65A8 DD E1       ..    POP   IX         

+65AA E1          .     POP   HL         

+65AB C1          .     POP   BC         

+65AC E5          .     PUSH  HL         

+65AD C5          .     PUSH  BC         

+65AE F5          .     PUSH  AF         

+65AF 3A 1A 6E    :.n   LD    A,(6E1A)   

+65B2 6F          o     LD    L,A        

+65B3 7D          }     LD    A,L        

+65B4 87          .     ADD   A          

+65B5 8B          .     ADC   E          

+65B6 8A          .     ADC   D          

+65B7 8C          .     ADC   H          

+65B8 4F          O     LD    C,A        

+65B9 06 14       ..    LD    B,14       

+65BB F1          .     POP   AF         

+65BC F5          .     PUSH  AF         

+65BD 0F          .     RRCA             

+65BE 02          .     LD    (BC),A     

+65BF 4F          O     LD    C,A        

+65C0 06 18       ..    LD    B,18       

+65C2 7C          |     LD    A,H        

+65C3 02          .     LD    (BC),A     

+65C4 05          .     DEC   B          

+65C5 7A          z     LD    A,D        

+65C6 02          .     LD    (BC),A     

+65C7 CB F9       ..    SET   7,C        

+65C9 7B          {     LD    A,E        

+65CA 02          .     LD    (BC),A     

+65CB 05          .     DEC   B          

+65CC 7D          }     LD    A,L        

+65CD 02          .     LD    (BC),A     

+65CE F1          .     POP   AF         

+65CF C1          .     POP   BC         

+65D0 E1          .     POP   HL         

+65D1 C9          .     RET              

+65D2 F1          .     POP   AF         

+65D3 C9          .     RET              

+65D4 87          .     ADD   A          

+65D5 87          .     ADD   A          

+65D6 87          .     ADD   A          

+65D7 87          .     ADD   A          

+65D8 2A 1C 6E    *.n   LD    HL,(6E1C)  

+65DB 6F          o     LD    L,A        

+65DC 30 C3       0.    JR    NC,65A1    

+65DE 24          $     INC   H          

+65DF 18 C0       ..    JR    65A1       

+65E1 23          #     INC   HL         

+65E2 7E          ~     LD    A,(HL)     

+65E3 2B          +     DEC   HL         

+65E4 3C          <     INC   A          

+65E5 20 27        '    JR    NZ,660E    

+65E7 7A          z     LD    A,D        

+65E8 B7          .     OR    A          

+65E9 20 0C        .    JR    NZ,65F7    

+65EB 7B          {     LD    A,E        

+65EC FE 03       ..    CP    03         

+65EE 38 0E       8.    JR    C,65FE     

+65F0 96          .     SUB   (HL)       

+65F1 38 04       8.    JR    C,65F7     

+65F3 FE 05       ..    CP    05         

+65F5 38 11       8.    JR    C,6608     

+65F7 11 FF FF    ...   LD    DE,FFFF    

+65FA CD 36 6A    .6j   CALL  6A36       

+65FD C9          .     RET              

+65FE 87          .     ADD   A          

+65FF 28 F6       (.    JR    Z,65F7     

+6601 85          .     ADD   L          

+6602 6F          o     LD    L,A        

+6603 5E          ^     LD    E,(HL)     

+6604 23          #     INC   HL         

+6605 56          V     LD    D,(HL)     

+6606 18 F2       ..    JR    65FA       

+6608 87          .     ADD   A          

+6609 C6 06       ..    ADD   A,06       

+660B C3 01 66    ..f   JP    6601       

+660E 7A          z     LD    A,D        

+660F E6 07       ..    AND   07         

+6611 87          .     ADD   A          

+6612 85          .     ADD   L          

+6613 6F          o     LD    L,A        

+6614 D5          .     PUSH  DE         

+6615 5E          ^     LD    E,(HL)     

+6616 23          #     INC   HL         

+6617 56          V     LD    D,(HL)     

+6618 3E FF       >.    LD    A,FF       

+661A CD 3F 6A    .?j   CALL  6A3F       

+661D E1          .     POP   HL         

+661E CB 25       .%    SLA   L          

+6620 CE 00       ..    ADC   A,00       

+6622 67          g     LD    H,A        

+6623 5E          ^     LD    E,(HL)     

+6624 2C          ,     INC   L          

+6625 56          V     LD    D,(HL)     

+6626 CD C1 5C    ..\   CALL  5CC1       

+6629 C3 FA 65    ..e   JP    65FA       

+662C 7A          z     LD    A,D        

+662D FE 04       ..    CP    04         ; drid < 4

+662F 30 13       0.    JR    NC,6644    

+6631 CD 1F 70    ..p   CALL  701F       ; Info aufrufen 

+6634 18 0C       ..    JR    6642       

+6636 20 75        u    JR    NZ,66AD    ; " unzul. drid"

+6638 6E          n     LD    L,(HL)     

+6639 7A          z     LD    A,D        

+663A 75          u     LD    (HL),L     

+663B 6C          l     LD    L,H        

+663C 2E 20       .     LD    L,20       

+663E 64          d     LD    H,H        

+663F 72          r     LD    (HL),D     

+6640 69          i     LD    L,C        

+6641 64          d     LD    H,H        

+6642 16 05       ..    LD    D,05       

+6644 C5          .     PUSH  BC         

+6645 E5          .     PUSH  HL         

+6646 3A 1A 6E    :.n   LD    A,(6E1A)   

+6649 6F          o     LD    L,A        

+664A 7D          }     LD    A,L        

+664B 87          .     ADD   A          

+664C 8B          .     ADC   E          

+664D 8A          .     ADC   D          

+664E 8C          .     ADC   H          

+664F 4F          O     LD    C,A        

+6650 06 14       ..    LD    B,14       

+6652 0A          .     LD    A,(BC)     

+6653 4F          O     LD    C,A        

+6654 06 18       ..    LD    B,18       

+6656 0A          .     LD    A,(BC)     

+6657 BC          .     CP    H          

+6658 20 1B        .    JR    NZ,6675    

+665A 05          .     DEC   B          

+665B 0A          .     LD    A,(BC)     

+665C BA          .     CP    D          

+665D 20 16        .    JR    NZ,6675    

+665F CB F9       ..    SET   7,C        

+6661 0A          .     LD    A,(BC)     

+6662 BB          .     CP    E          

+6663 20 10        .    JR    NZ,6675    

+6665 05          .     DEC   B          

+6666 0A          .     LD    A,(BC)     

+6667 BD          .     CP    L          

+6668 20 0B        .    JR    NZ,6675    

+666A 05          .     DEC   B          

+666B 0A          .     LD    A,(BC)     

+666C CB 57       .W    BIT   2,A        

+666E 28 05       (.    JR    Z,6675     

+6670 79          y     LD    A,C        

+6671 81          .     ADD   C          

+6672 E1          .     POP   HL         

+6673 C1          .     POP   BC         

+6674 C9          .     RET              

+6675 DD E5       ..    PUSH  IX         

+6677 FD E5       ..    PUSH  IY         

+6679 D5          .     PUSH  DE         

+667A 7D          }     LD    A,L        

+667B 6C          l     LD    L,H        

+667C 63          c     LD    H,E        

+667D 5A          Z     LD    E,D        

+667E 57          W     LD    D,A        

+667F E5          .     PUSH  HL         

+6680 7B          {     LD    A,E        

+6681 FE 20       .     CP    20         

+6683 38 43       8C    JR    C,66C8     

+6685 CD DE 66    ..f   CALL  66DE       

+6688 D1          .     POP   DE         

+6689 CD 93 67    ..g   CALL  6793       

+668C 20 47        G    JR    NZ,66D5    

+668E CD 48 6A    .Hj   CALL  6A48       

+6691 F5          .     PUSH  AF         

+6692 CD C1 5C    ..\   CALL  5CC1       

+6695 F1          .     POP   AF         

+6696 D1          .     POP   DE         

+6697 FD E1       ..    POP   IY         

+6699 DD E1       ..    POP   IX         

+669B E1          .     POP   HL         

+669C C1          .     POP   BC         

+669D E5          .     PUSH  HL         

+669E C5          .     PUSH  BC         

+669F F5          .     PUSH  AF         

+66A0 3A 1A 6E    :.n   LD    A,(6E1A)   

+66A3 6F          o     LD    L,A        

+66A4 7D          }     LD    A,L        

+66A5 87          .     ADD   A          

+66A6 8B          .     ADC   E          

+66A7 8A          .     ADC   D          

+66A8 8C          .     ADC   H          

+66A9 4F          O     LD    C,A        

+66AA 06 14       ..    LD    B,14       

+66AC F1          .     POP   AF         

+66AD F5          .     PUSH  AF         

+66AE 0F          .     RRCA             

+66AF 02          .     LD    (BC),A     

+66B0 4F          O     LD    C,A        

+66B1 06 18       ..    LD    B,18       

+66B3 7C          |     LD    A,H        

+66B4 02          .     LD    (BC),A     

+66B5 05          .     DEC   B          

+66B6 7A          z     LD    A,D        

+66B7 02          .     LD    (BC),A     

+66B8 CB F9       ..    SET   7,C        

+66BA 7B          {     LD    A,E        

+66BB 02          .     LD    (BC),A     

+66BC 05          .     DEC   B          

+66BD 7D          }     LD    A,L        

+66BE 02          .     LD    (BC),A     

+66BF 05          .     DEC   B          

+66C0 0A          .     LD    A,(BC)     

+66C1 F6 0C       ..    OR    0C         

+66C3 02          .     LD    (BC),A     

+66C4 F1          .     POP   AF         

+66C5 C1          .     POP   BC         

+66C6 E1          .     POP   HL         

+66C7 C9          .     RET              

+66C8 87          .     ADD   A          

+66C9 87          .     ADD   A          

+66CA 87          .     ADD   A          

+66CB 87          .     ADD   A          

+66CC 2A 1C 6E    *.n   LD    HL,(6E1C)  

+66CF 6F          o     LD    L,A        

+66D0 30 B3       0.    JR    NC,6685    

+66D2 24          $     INC   H          

+66D3 18 B0       ..    JR    6685       

+66D5 CD 35 68    .5h   CALL  6835       

+66D8 18 6A       .j    JR    6744       

+66DA 3E 00       >.    LD    A,00       

+66DC 18 02       ..    JR    66E0       

+66DE 3E 01       >.    LD    A,01       

+66E0 32 12 6B    2.k   LD    (6B12),A   

+66E3 7B          {     LD    A,E        

+66E4 FE 20       .     CP    20         

+66E6 30 1D       0.    JR    NC,6705    

+66E8 6A          j     LD    L,D        

+66E9 26 14       &.    LD    H,14       

+66EB 6E          n     LD    L,(HL)     

+66EC 26 17       &.    LD    H,17       

+66EE 7E          ~     LD    A,(HL)     

+66EF B7          .     OR    A          

+66F0 20 13        .    JR    NZ,6705    

+66F2 25          %     DEC   H          

+66F3 CB FD       ..    SET   7,L        

+66F5 7E          ~     LD    A,(HL)     

+66F6 BA          .     CP    D          

+66F7 20 0C        .    JR    NZ,6705    

+66F9 25          %     DEC   H          

+66FA CB 56       .V    BIT   2,(HL)     

+66FC 28 07       (.    JR    Z,6705     

+66FE CB DE       ..    SET   3,(HL)     

+6700 7D          }     LD    A,L        

+6701 87          .     ADD   A          

+6702 6B          k     LD    L,E        

+6703 18 6C       .l    JR    6771       

+6705 21 2B 1E    !+.   LD    HL,1E2B    

+6708 D5          .     PUSH  DE         

+6709 CB 3A       .:    SLR   D          

+670B CB 1B       ..    RR    E          

+670D CB 3A       .:    SLR   D          

+670F CB 1B       ..    RR    E          

+6711 CB 3A       .:    SLR   D          

+6713 CB 1B       ..    RR    E          

+6715 CB 3A       .:    SLR   D          

+6717 CB 1B       ..    RR    E          

+6719 CB 3A       .:    SLR   D          

+671B CB 1B       ..    RR    E          

+671D 3A 12 6B    :.k   LD    A,(6B12)   

+6720 B7          .     OR    A          

+6721 28 27       ('    JR    Z,674A     

+6723 CD 93 67    ..g   CALL  6793       

+6726 28 27       ('    JR    Z,674F     

+6728 CD 35 68    .5h   CALL  6835       

+672B D1          .     POP   DE         

+672C 7A          z     LD    A,D        

+672D B7          .     OR    A          

+672E 28 14       (.    JR    Z,6744     

+6730 2E 00       ..    LD    L,00       

+6732 06 20       .     LD    B,20       

+6734 7B          {     LD    A,E        

+6735 FE 20       .     CP    20         

+6737 30 04       0.    JR    NC,673D    

+6739 2E 40       .@    LD    L,40       

+673B 06 1C       ..    LD    B,1C       

+673D C5          .     PUSH  BC         

+673E CD 80 67    ..g   CALL  6780       

+6741 C1          .     POP   BC         

+6742 10 F9       ..    DJNZ  673D       

+6744 21 00 00    !..   LD    HL,0000    

+6747 C3 1A 6C    ..l   JP    6C1A       

+674A CD E1 65    ..e   CALL  65E1       

+674D 18 03       ..    JR    6752       

+674F CD 48 6A    .Hj   CALL  6A48       

+6752 E1          .     POP   HL         

+6753 F5          .     PUSH  AF         

+6754 7D          }     LD    A,L        

+6755 FE 20       .     CP    20         

+6757 30 17       0.    JR    NC,6770    

+6759 F1          .     POP   AF         

+675A F5          .     PUSH  AF         

+675B E5          .     PUSH  HL         

+675C CB 3F       .?    SLR   A          

+675E 6F          o     LD    L,A        

+675F 54          T     LD    D,H        

+6760 26 17       &.    LD    H,17       

+6762 36 00       6.    LD    (HL),00    

+6764 25          %     DEC   H          

+6765 CB FD       ..    SET   7,L        

+6767 72          r     LD    (HL),D     

+6768 25          %     DEC   H          

+6769 CB D6       ..    SET   2,(HL)     

+676B 26 14       &.    LD    H,14       

+676D 6A          j     LD    L,D        

+676E 77          w     LD    (HL),A     

+676F E1          .     POP   HL         

+6770 F1          .     POP   AF         

+6771 CB 25       .%    SLA   L          

+6773 CB 25       .%    SLA   L          

+6775 CB 25       .%    SLA   L          

+6777 CB 25       .%    SLA   L          

+6779 CE 00       ..    ADC   A,00       

+677B 67          g     LD    H,A        

+677C CD C1 5C    ..\   CALL  5CC1       

+677F C9          .     RET              

+6780 06 08       ..    LD    B,08       

+6782 23          #     INC   HL         

+6783 7E          ~     LD    A,(HL)     

+6784 2B          +     DEC   HL         

+6785 FE FF       ..    CP    FF         

+6787 20 03        .    JR    NZ,678C    

+6789 23          #     INC   HL         

+678A 23          #     INC   HL         

+678B 05          .     DEC   B          

+678C CB C6       ..    SET   0,(HL)     

+678E 23          #     INC   HL         

+678F 23          #     INC   HL         

+6790 10 FA       ..    DJNZ  678C       

+6792 C9          .     RET              

+6793 23          #     INC   HL         

+6794 7E          ~     LD    A,(HL)     

+6795 2B          +     DEC   HL         

+6796 3C          <     INC   A          

+6797 C2 0A 68    ..h   JP    NZ,680A    

+679A 7A          z     LD    A,D        

+679B B7          .     OR    A          

+679C 20 1B        .    JR    NZ,67B9    

+679E 7B          {     LD    A,E        

+679F FE 03       ..    CP    03         

+67A1 DA 01 68    ..h   JP    C,6801     

+67A4 7E          ~     LD    A,(HL)     

+67A5 3C          <     INC   A          

+67A6 20 08        .    JR    NZ,67B0    

+67A8 7B          {     LD    A,E        

+67A9 FE FB       ..    CP    FB         

+67AB 38 02       8.    JR    C,67AF     

+67AD 3E FB       >.    LD    A,FB       

+67AF 77          w     LD    (HL),A     

+67B0 7B          {     LD    A,E        

+67B1 96          .     SUB   (HL)       

+67B2 38 05       8.    JR    C,67B9     

+67B4 FE 05       ..    CP    05         

+67B6 DA FC 67    ..g   JP    C,67FC     

+67B9 E5          .     PUSH  HL         

+67BA 21 13 6B    !.k   LD    HL,6B13    

+67BD CD 35 68    .5h   CALL  6835       

+67C0 7C          |     LD    A,H        

+67C1 ED 5B 13 6B .[.k  LD    DE,(6B13)  

+67C5 21 FF FF    !..   LD    HL,FFFF    

+67C8 22 13 6B    ".k   LD    (6B13),HL  

+67CB E1          .     POP   HL         

+67CC 46          F     LD    B,(HL)     

+67CD 73          s     LD    (HL),E     

+67CE 23          #     INC   HL         

+67CF 72          r     LD    (HL),D     

+67D0 57          W     LD    D,A        

+67D1 1E 02       ..    LD    E,02       

+67D3 23          #     INC   HL         

+67D4 78          x     LD    A,B        

+67D5 01 04 00    ...   LD    BC,0004    

+67D8 ED B0       ..    LDIR             

+67DA 01 0A 00    ...   LD    BC,000A    

+67DD 5F          _     LD    E,A        

+67DE 3C          <     INC   A          

+67DF 20 03        .    JR    NZ,67E4    

+67E1 09          .     ADD   HL,BC      

+67E2 18 08       ..    JR    67EC       

+67E4 7A          z     LD    A,D        

+67E5 CB 23       .#    SLA   E          

+67E7 CE 00       ..    ADC   A,00       

+67E9 57          W     LD    D,A        

+67EA ED B0       ..    LDIR             

+67EC 2B          +     DEC   HL         

+67ED 01 0D 00    ...   LD    BC,000D    

+67F0 54          T     LD    D,H        

+67F1 5D          ]     LD    E,L        

+67F2 1B          .     DEC   DE         

+67F3 36 FF       6.    LD    (HL),FF    

+67F5 ED B8       ..    LDDR             

+67F7 36 01       6.    LD    (HL),01    

+67F9 C3 44 67    .Dg   JP    6744       

+67FC 87          .     ADD   A          

+67FD C6 06       ..    ADD   A,06       

+67FF 18 04       ..    JR    6805       

+6801 87          .     ADD   A          

+6802 CA B9 67    ..g   JP    Z,67B9     

+6805 85          .     ADD   L          

+6806 6F          o     LD    L,A        

+6807 CB 46       .F    BIT   0,(HL)     

+6809 C9          .     RET              

+680A D5          .     PUSH  DE         

+680B 7A          z     LD    A,D        

+680C E6 07       ..    AND   07         

+680E CB 27       .'    SLA   A          

+6810 85          .     ADD   L          

+6811 6F          o     LD    L,A        

+6812 CB 46       .F    BIT   0,(HL)     

+6814 20 11        .    JR    NZ,6827    

+6816 5E          ^     LD    E,(HL)     

+6817 2C          ,     INC   L          

+6818 56          V     LD    D,(HL)     

+6819 3E FD       >.    LD    A,FD       

+681B CD 3F 6A    .?j   CALL  6A3F       

+681E E1          .     POP   HL         

+681F CB 25       .%    SLA   L          

+6821 CE 00       ..    ADC   A,00       

+6823 67          g     LD    H,A        

+6824 CB 46       .F    BIT   0,(HL)     

+6826 C9          .     RET              

+6827 CD 35 68    .5h   CALL  6835       

+682A 06 00       ..    LD    B,00       

+682C CB C6       ..    SET   0,(HL)     

+682E 23          #     INC   HL         

+682F 23          #     INC   HL         

+6830 10 FA       ..    DJNZ  682C       

+6832 C3 44 67    .Dg   JP    6744       

+6835 5E          ^     LD    E,(HL)     

+6836 23          #     INC   HL         

+6837 56          V     LD    D,(HL)     

+6838 2B          +     DEC   HL         

+6839 E5          .     PUSH  HL         

+683A CD 41 5D    .A]   CALL  5D41       

+683D E5          .     PUSH  HL         

+683E CB FD       ..    SET   7,L        

+6840 CB 96       ..    RES   2,(HL)     

+6842 CB 4E       .N    BIT   1,(HL)     

+6844 28 28       ((    JR    Z,686E     

+6846 24          $     INC   H          

+6847 36 FF       6.    LD    (HL),FF    

+6849 CD 4E 55    .NU   CALL  554E       

+684C C1          .     POP   BC         

+684D D1          .     POP   DE         

+684E EB          .     EX    DE,HL      

+684F CB 83       ..    RES   0,E        

+6851 73          s     LD    (HL),E     

+6852 23          #     INC   HL         

+6853 72          r     LD    (HL),D     

+6854 2B          +     DEC   HL         

+6855 6C          l     LD    L,H        

+6856 26 15       &.    LD    H,15       

+6858 37          7     SCF              

+6859 CB 1D       ..    RR    L          

+685B CB 8E       ..    RES   1,(HL)     

+685D 60          `     LD    H,B        

+685E 69          i     LD    L,C        

+685F 73          s     LD    (HL),E     

+6860 CB FD       ..    SET   7,L        

+6862 CB 8E       ..    RES   1,(HL)     

+6864 24          $     INC   H          

+6865 CB BD       ..    RES   7,L        

+6867 72          r     LD    (HL),D     

+6868 65          e     LD    H,L        

+6869 CB 24       .$    SLA   H          

+686B 2E 00       ..    LD    L,00       

+686D C9          .     RET              

+686E 24          $     INC   H          

+686F 36 FF       6.    LD    (HL),FF    

+6871 11 F0 FF    ...   LD    DE,FFF0    

+6874 CD 41 5D    .A]   CALL  5D41       

+6877 C1          .     POP   BC         

+6878 E5          .     PUSH  HL         

+6879 55          U     LD    D,L        

+687A 1E 00       ..    LD    E,00       

+687C 61          a     LD    H,C        

+687D 2E 00       ..    LD    L,00       

+687F 01 00 02    ...   LD    BC,0200    

+6882 CB 24       .$    SLA   H          

+6884 CB 22       ."    SLA   D          

+6886 CD A5 28    ..(   CALL  28A5       

+6889 18 BE       ..    JR    6849       

+688B B7          .     OR    A          

+688C C8          .     RET   Z          

+688D CD 2F 64    ./d   CALL  642F       

+6890 CD 20 6E    . n   CALL  6E20       

+6893 CD 74 6D    .tm   CALL  6D74       

+6896 F5          .     PUSH  AF         

+6897 1F          .     RRA              

+6898 1F          .     RRA              

+6899 1F          .     RRA              

+689A 1F          .     RRA              

+689B E6 06       ..    AND   06         

+689D 21 2B 1E    !+.   LD    HL,1E2B    

+68A0 85          .     ADD   L          

+68A1 6F          o     LD    L,A        

+68A2 5E          ^     LD    E,(HL)     

+68A3 23          #     INC   HL         

+68A4 56          V     LD    D,(HL)     

+68A5 CD 4E 6A    .Nj   CALL  6A4E       

+68A8 67          g     LD    H,A        

+68A9 F1          .     POP   AF         

+68AA E5          .     PUSH  HL         

+68AB 21 80 16    !..   LD    HL,1680    

+68AE 01 81 00    ...   LD    BC,0081    

+68B1 ED B1       ..    CPIR             

+68B3 E2 BC 68    ..h   JP    PO,68BC    

+68B6 2B          +     DEC   HL         

+68B7 36 FF       6.    LD    (HL),FF    

+68B9 23          #     INC   HL         

+68BA 18 F5       ..    JR    68B1       

+68BC E1          .     POP   HL         

+68BD CB 27       .'    SLA   A          

+68BF CB 27       .'    SLA   A          

+68C1 CB 27       .'    SLA   A          

+68C3 CB 27       .'    SLA   A          

+68C5 6F          o     LD    L,A        

+68C6 30 01       0.    JR    NC,68C9    

+68C8 24          $     INC   H          

+68C9 36 FF       6.    LD    (HL),FF    

+68CB 54          T     LD    D,H        

+68CC 5D          ]     LD    E,L        

+68CD 13          .     INC   DE         

+68CE 01 0F 00    ...   LD    BC,000F    

+68D1 ED B0       ..    LDIR             

+68D3 CD DA 68    ..h   CALL  68DA       

+68D6 CD 2A 6E    .*n   CALL  6E2A       

+68D9 C9          .     RET              

+68DA 3A 13 57    :.W   LD    A,(5713)   

+68DD B7          .     OR    A          

+68DE C8          .     RET   Z          

+68DF 21 17 82    !..   LD    HL,8217    

+68E2 CB C6       ..    SET   0,(HL)     

+68E4 C9          .     RET              

+68E5 7A          z     LD    A,D        

+68E6 18 02       ..    JR    68EA       

+68E8 3E FF       >.    LD    A,FF       

+68EA 32 16 6B    2.k   LD    (6B16),A   

+68ED E5          .     PUSH  HL         

+68EE C5          .     PUSH  BC         

+68EF 1E 04       ..    LD    E,04       

+68F1 D5          .     PUSH  DE         

+68F2 CD DA 66    ..f   CALL  66DA       

+68F5 D1          .     POP   DE         

+68F6 23          #     INC   HL         

+68F7 7E          ~     LD    A,(HL)     

+68F8 23          #     INC   HL         

+68F9 A6          .     AND   (HL)       

+68FA 23          #     INC   HL         

+68FB A6          .     AND   (HL)       

+68FC 3C          <     INC   A          

+68FD 28 06       (.    JR    Z,6905     

+68FF 1C          .     INC   E          

+6900 20 EF        .    JR    NZ,68F1    

+6902 C1          .     POP   BC         

+6903 E1          .     POP   HL         

+6904 C9          .     RET              

+6905 D5          .     PUSH  DE         

+6906 CD DE 66    ..f   CALL  66DE       

+6909 E5          .     PUSH  HL         

+690A 50          P     LD    D,B        

+690B 59          Y     LD    E,C        

+690C 7B          {     LD    A,E        

+690D B7          .     OR    A          

+690E 28 0A       (.    JR    Z,691A     

+6910 CD DE 66    ..f   CALL  66DE       

+6913 E5          .     PUSH  HL         

+6914 CD 30 80    .0.   CALL  8030       

+6917 E1          .     POP   HL         

+6918 18 03       ..    JR    691D       

+691A 21 26 6A    !&j   LD    HL,6A26    

+691D 3A 16 6B    :.k   LD    A,(6B16)   

+6920 3C          <     INC   A          

+6921 20 05        .    JR    NZ,6928    

+6923 E5          .     PUSH  HL         

+6924 CD 80 67    ..g   CALL  6780       

+6927 E1          .     POP   HL         

+6928 D1          .     POP   DE         

+6929 01 10 00    ...   LD    BC,0010    

+692C ED B0       ..    LDIR             

+692E 3A 16 6B    :.k   LD    A,(6B16)   

+6931 3C          <     INC   A          

+6932 28 0B       (.    JR    Z,693F     

+6934 01 0F 00    ...   LD    BC,000F    

+6937 2B          +     DEC   HL         

+6938 36 FF       6.    LD    (HL),FF    

+693A 54          T     LD    D,H        

+693B 5D          ]     LD    E,L        

+693C 1B          .     DEC   DE         

+693D ED B8       ..    LDDR             

+693F D1          .     POP   DE         

+6940 3E FF       >.    LD    A,FF       

+6942 CD 53 69    .Si   CALL  6953       

+6945 C1          .     POP   BC         

+6946 D5          .     PUSH  DE         

+6947 59          Y     LD    E,C        

+6948 50          P     LD    D,B        

+6949 3E FF       >.    LD    A,FF       

+694B CD 53 69    .Si   CALL  6953       

+694E 42          B     LD    B,D        

+694F 4B          K     LD    C,E        

+6950 D1          .     POP   DE         

+6951 E1          .     POP   HL         

+6952 C9          .     RET              

+6953 21 00 17    !..   LD    HL,1700    

+6956 01 81 00    ...   LD    BC,0081    

+6959 F5          .     PUSH  AF         

+695A 7B          {     LD    A,E        

+695B ED B1       ..    CPIR             

+695D E2 75 69    .ui   JP    PO,6975    

+6960 2B          +     DEC   HL         

+6961 25          %     DEC   H          

+6962 CB FD       ..    SET   7,L        

+6964 7A          z     LD    A,D        

+6965 BE          .     CP    (HL)       

+6966 20 07        .    JR    NZ,696F    

+6968 F1          .     POP   AF         

+6969 77          w     LD    (HL),A     

+696A F5          .     PUSH  AF         

+696B 25          %     DEC   H          

+696C CB 96       ..    RES   2,(HL)     

+696E 24          $     INC   H          

+696F CB BD       ..    RES   7,L        

+6971 24          $     INC   H          

+6972 23          #     INC   HL         

+6973 18 E5       ..    JR    695A       

+6975 F1          .     POP   AF         

+6976 C9          .     RET              

+6977 79          y     LD    A,C        

+6978 FE 04       ..    CP    04         

+697A D8          .     RET   C          

+697B D5          .     PUSH  DE         

+697C E5          .     PUSH  HL         

+697D C5          .     PUSH  BC         

+697E 59          Y     LD    E,C        

+697F 3A 1A 6E    :.n   LD    A,(6E1A)   

+6982 57          W     LD    D,A        

+6983 CD DA 66    ..f   CALL  66DA       

+6986 23          #     INC   HL         

+6987 7E          ~     LD    A,(HL)     

+6988 23          #     INC   HL         

+6989 A6          .     AND   (HL)       

+698A 23          #     INC   HL         

+698B A6          .     AND   (HL)       

+698C 3C          <     INC   A          

+698D 28 05       (.    JR    Z,6994     

+698F B7          .     OR    A          

+6990 C1          .     POP   BC         

+6991 E1          .     POP   HL         

+6992 D1          .     POP   DE         

+6993 C9          .     RET              

+6994 37          7     SCF              

+6995 18 F9       ..    JR    6990       

+6997 D5          .     PUSH  DE         

+6998 E5          .     PUSH  HL         

+6999 C5          .     PUSH  BC         

+699A 79          y     LD    A,C        

+699B FE 04       ..    CP    04         

+699D 38 F1       8.    JR    C,6990     

+699F 3A 1A 6E    :.n   LD    A,(6E1A)   

+69A2 57          W     LD    D,A        

+69A3 59          Y     LD    E,C        

+69A4 CD DE 66    ..f   CALL  66DE       

+69A7 54          T     LD    D,H        

+69A8 5D          ]     LD    E,L        

+69A9 13          .     INC   DE         

+69AA 01 0F 00    ...   LD    BC,000F    

+69AD 36 FF       6.    LD    (HL),FF    

+69AF ED B0       ..    LDIR             

+69B1 CD DA 68    ..h   CALL  68DA       

+69B4 18 DA       ..    JR    6990       

+69B6 78          x     LD    A,B        

+69B7 B7          .     OR    A          

+69B8 C8          .     RET   Z          

+69B9 85          .     ADD   L          

+69BA DC 0B 6A    ..j   CALL  C,6A0B     

+69BD 78          x     LD    A,B        

+69BE 83          .     ADD   E          

+69BF DC 0B 6A    ..j   CALL  C,6A0B     

+69C2 CD 20 6E    . n   CALL  6E20       

+69C5 C5          .     PUSH  BC         

+69C6 E5          .     PUSH  HL         

+69C7 D5          .     PUSH  DE         

+69C8 3A 1A 6E    :.n   LD    A,(6E1A)   

+69CB 57          W     LD    D,A        

+69CC 59          Y     LD    E,C        

+69CD 3E FF       >.    LD    A,FF       

+69CF CD 53 69    .Si   CALL  6953       

+69D2 CD DE 66    ..f   CALL  66DE       

+69D5 2C          ,     INC   L          

+69D6 7E          ~     LD    A,(HL)     

+69D7 2D          -     DEC   L          

+69D8 3C          <     INC   A          

+69D9 28 31       (1    JR    Z,6A0C     

+69DB D1          .     POP   DE         

+69DC E5          .     PUSH  HL         

+69DD CD 93 67    ..g   CALL  6793       

+69E0 CD 1A 6A    ..j   CALL  6A1A       

+69E3 D1          .     POP   DE         

+69E4 E3          .     EX    (SP),HL    

+69E5 EB          .     EX    DE,HL      

+69E6 CD 93 67    ..g   CALL  6793       

+69E9 CD 1A 6A    ..j   CALL  6A1A       

+69EC D1          .     POP   DE         

+69ED C1          .     POP   BC         

+69EE C5          .     PUSH  BC         

+69EF E5          .     PUSH  HL         

+69F0 CB C6       ..    SET   0,(HL)     

+69F2 2C          ,     INC   L          

+69F3 2C          ,     INC   L          

+69F4 10 FA       ..    DJNZ  69F0       

+69F6 E1          .     POP   HL         

+69F7 C1          .     POP   BC         

+69F8 48          H     LD    C,B        

+69F9 CB 21       .!    SLA   C          

+69FB 06 00       ..    LD    B,00       

+69FD CB 10       ..    RL    B          

+69FF CD 14 80    ...   CALL  8014       

+6A02 ED B0       ..    LDIR             

+6A04 CD C1 5C    ..\   CALL  5CC1       

+6A07 CD 2A 6E    .*n   CALL  6E2A       

+6A0A C9          .     RET              

+6A0B C8          .     RET   Z          

+6A0C CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6A0F 18 07       ..    JR    6A18       

+6A11 20 73        s    JR    NZ,6A86    ; " spmove"

+6A13 70          p     LD    (HL),B     

+6A14 6D          m     LD    L,L        

+6A15 6F          o     LD    L,A        

+6A16 76          v     HALT             

+6A17 65          e     LD    H,L        

+6A18 18 F2       ..    JR    6A0C       

+6A1A 1F          .     RRA              

+6A1B CB 1D       ..    RR    L          

+6A1D CD 4E 6A    .Nj   CALL  6A4E       

+6A20 CB 25       .%    SLA   L          

+6A22 CE 00       ..    ADC   A,00       

+6A24 67          g     LD    H,A        

+6A25 C9          .     RET              

+6A26 FF          .     RST   38         ; nilspace-Eintrag

+6A27 FF          .     RST   38         

+6A28 01 FF FF    ...   LD    BC,FFFF    

+6A2B FF          .     RST   38         

+6A2C FF          .     RST   38         

+6A2D FF          .     RST   38         

+6A2E FF          .     RST   38         

+6A2F FF          .     RST   38         

+6A30 FF          .     RST   38         

+6A31 FF          .     RST   38         

+6A32 FF          .     RST   38         

+6A33 FF          .     RST   38         

+6A34 FF          .     RST   38         

+6A35 FF          .     RST   38         

+6A36 E5          .     PUSH  HL         

+6A37 CD 41 5D    .A]   CALL  5D41       

+6A3A 7D          }     LD    A,L        

+6A3B CB 27       .'    SLA   A          

+6A3D E1          .     POP   HL         

+6A3E C9          .     RET              

+6A3F E5          .     PUSH  HL         

+6A40 CD 3E 5D    .>]   CALL  5D3E       

+6A43 CB 25       .%    SLA   L          

+6A45 7D          }     LD    A,L        

+6A46 E1          .     POP   HL         

+6A47 C9          .     RET              

+6A48 E5          .     PUSH  HL         

+6A49 5E          ^     LD    E,(HL)     

+6A4A 23          #     INC   HL         

+6A4B 56          V     LD    D,(HL)     

+6A4C 18 01       ..    JR    6A4F       

+6A4E E5          .     PUSH  HL         

+6A4F CD 41 5D    .A]   CALL  5D41       

+6A52 CB FD       ..    SET   7,L        

+6A54 CB 8E       ..    RES   1,(HL)     

+6A56 7D          }     LD    A,L        

+6A57 CB 27       .'    SLA   A          

+6A59 E1          .     POP   HL         

+6A5A C9          .     RET              

+6A5B 7A          z     LD    A,D        

+6A5C FE 04       ..    CP    04         

+6A5E 38 19       8.    JR    C,6A79     

+6A60 23          #     INC   HL         

+6A61 7C          |     LD    A,H        

+6A62 FE 08       ..    CP    08         

+6A64 30 13       0.    JR    NC,6A79    

+6A66 E5          .     PUSH  HL         

+6A67 D5          .     PUSH  DE         

+6A68 5C          \     LD    E,H        

+6A69 65          e     LD    H,L        

+6A6A CD 5C 65    .\e   CALL  655C       

+6A6D CB 3F       .?    SLR   A          

+6A6F 6F          o     LD    L,A        

+6A70 26 16       &.    LD    H,16       

+6A72 7E          ~     LD    A,(HL)     

+6A73 3C          <     INC   A          

+6A74 D1          .     POP   DE         

+6A75 E1          .     POP   HL         

+6A76 28 E8       (.    JR    Z,6A60     

+6A78 C9          .     RET              

+6A79 21 FF FF    !..   LD    HL,FFFF    

+6A7C C9          .     RET              

+6A7D 7B          {     LD    A,E        

+6A7E FE 04       ..    CP    04         

+6A80 38 26       8&    JR    C,6AA8     

+6A82 E5          .     PUSH  HL         

+6A83 C5          .     PUSH  BC         

+6A84 D5          .     PUSH  DE         

+6A85 CD DA 66    ..f   CALL  66DA       

+6A88 D1          .     POP   DE         

+6A89 23          #     INC   HL         

+6A8A 23          #     INC   HL         

+6A8B 7E          ~     LD    A,(HL)     

+6A8C 23          #     INC   HL         

+6A8D A6          .     AND   (HL)       

+6A8E 3C          <     INC   A          

+6A8F 28 1B       (.    JR    Z,6AAC     

+6A91 2B          +     DEC   HL         

+6A92 2B          +     DEC   HL         

+6A93 7E          ~     LD    A,(HL)     

+6A94 3C          <     INC   A          

+6A95 20 1A        .    JR    NZ,6AB1    

+6A97 06 07       ..    LD    B,07       

+6A99 11 00 00    ...   LD    DE,0000    

+6A9C 2C          ,     INC   L          

+6A9D 2C          ,     INC   L          

+6A9E 7E          ~     LD    A,(HL)     

+6A9F 3C          <     INC   A          

+6AA0 28 01       (.    JR    Z,6AA3     

+6AA2 1C          .     INC   E          

+6AA3 10 F7       ..    DJNZ  6A9C       

+6AA5 C1          .     POP   BC         

+6AA6 E1          .     POP   HL         

+6AA7 C9          .     RET              

+6AA8 11 FF FF    ...   LD    DE,FFFF    

+6AAB C9          .     RET              

+6AAC 11 FF FF    ...   LD    DE,FFFF    

+6AAF 18 F4       ..    JR    6AA5       

+6AB1 06 08       ..    LD    B,08       

+6AB3 FD E5       ..    PUSH  IY         

+6AB5 FD 21 00 00 .!..  LD    IY,0000    

+6AB9 C5          .     PUSH  BC         

+6ABA D5          .     PUSH  DE         

+6ABB CD DA 66    ..f   CALL  66DA       

+6ABE 78          x     LD    A,B        

+6ABF 3D          =     DEC   A          

+6AC0 87          .     ADD   A          

+6AC1 B5          .     OR    L          

+6AC2 6F          o     LD    L,A        

+6AC3 5E          ^     LD    E,(HL)     

+6AC4 2C          ,     INC   L          

+6AC5 56          V     LD    D,(HL)     

+6AC6 14          .     INC   D          

+6AC7 28 23       (#    JR    Z,6AEC     

+6AC9 15          .     DEC   D          

+6ACA 3E FF       >.    LD    A,FF       

+6ACC CD 3F 6A    .?j   CALL  6A3F       

+6ACF 67          g     LD    H,A        

+6AD0 2E 00       ..    LD    L,00       

+6AD2 06 00       ..    LD    B,00       

+6AD4 23          #     INC   HL         

+6AD5 7E          ~     LD    A,(HL)     

+6AD6 23          #     INC   HL         

+6AD7 3C          <     INC   A          

+6AD8 28 02       (.    JR    Z,6ADC     

+6ADA FD 23       .#    INC   IY         

+6ADC 10 F6       ..    DJNZ  6AD4       

+6ADE CD C1 5C    ..\   CALL  5CC1       

+6AE1 D1          .     POP   DE         

+6AE2 C1          .     POP   BC         

+6AE3 10 D4       ..    DJNZ  6AB9       

+6AE5 FD E5       ..    PUSH  IY         

+6AE7 D1          .     POP   DE         

+6AE8 FD E1       ..    POP   IY         

+6AEA 18 B9       ..    JR    6AA5       

+6AEC D1          .     POP   DE         

+6AED C1          .     POP   BC         

+6AEE 2D          -     DEC   L          

+6AEF 2D          -     DEC   L          

+6AF0 7E          ~     LD    A,(HL)     

+6AF1 3C          <     INC   A          

+6AF2 20 EF        .    JR    NZ,6AE3    

+6AF4 05          .     DEC   B          

+6AF5 18 F7       ..    JR    6AEE       

+6AF7 45          E     LD    B,L        ; "EUMEL-000"

+6AF8 55          U     LD    D,L        

+6AF9 4D          M     LD    C,L        

+6AFA 45          E     LD    B,L        

+6AFB 4C          L     LD    C,H        

+6AFC 2D          -     DEC   L          

+6AFD 30 30       00    JR    NC,6B2F    

+6AFF 30 11       0.    JR    NC,6B12    

+6B01 20 20             JR    NZ,6B23    ; "  *** RERUN ***CRLF"

+6B03 2A 2A 2A    ***   LD    HL,(2A2A)  

+6B06 20 52        R    JR    NZ,6B5A    

+6B08 45          E     LD    B,L        

+6B09 52          R     LD    D,D        

+6B0A 55          U     LD    D,L        

+6B0B 4E          N     LD    C,(HL)     

+6B0C 20 2A        *    JR    NZ,6B38    

+6B0E 2A 2A 0A    **.   LD    HL,(0A2A)  

+6B11 0D          .     DEC   C          

+6B12 01 FF FF    ...   LD    BC,FFFF    

+6B15 01 FF 

+6B17 FF FF                              ; session

+6B19 78          x     LD    A,B        

+6B1A 13          .     INC   DE         

+6B1B 20 53        S    JR    NZ,6B70    ; " System aufgebaut."

+6B1D 79          y     LD    A,C        

+6B1E 73          s     LD    (HL),E     

+6B1F 74          t     LD    (HL),H     

+6B20 65          e     LD    H,L        

+6B21 6D          m     LD    L,L        

+6B22 20 61        a    JR    NZ,6B85    

+6B24 75          u     LD    (HL),L     

+6B25 66          f     LD    H,(HL)     

+6B26 67          g     LD    H,A        

+6B27 65          e     LD    H,L        

+6B28 62          b     LD    H,D        

+6B29 61          a     LD    H,C        

+6B2A 75          u     LD    (HL),L     

+6B2B 74          t     LD    (HL),H     

+6B2C 2E 20       .     LD    L,20       

+6B2E 31 37 35    175   LD    SP,3537    ; "175 restart   2 (!)"

+6B31 20 72        r    JR    NZ,6BA5    

+6B33 65          e     LD    H,L        

+6B34 73          s     LD    (HL),E     

+6B35 74          t     LD    (HL),H     

+6B36 61          a     LD    H,C        

+6B37 72          r     LD    (HL),D     

+6B38 74          t     LD    (HL),H     

+6B39 20 20             JR    NZ,6B5B    

+6B3B 20 32        2    JR    NZ,6B6F    

+6B3D 20 28        (    JR    NZ,6B67    

+6B3F 21 29 

+6B41 ED 5B 46 6C       LD    DE,(6C46)

+6B45 ED 53 F7 6E .S.n  LD    (6EF7),DE  

+6B49 11 13 6C    ..l   LD    DE,6C13    

+6B4C ED 53 46 6C .SFl  LD    (6C46),DE  

+6B50 ED 73 F2 6E .s.n  LD    (6EF2),SP  

+6B54 3A F0 6E    :.n   LD    A,(6EF0)   

+6B57 B7          .     OR    A          

+6B58 28 21       (!    JR    Z,6B7B     

+6B5A 06 00       ..    LD    B,00       

+6B5C 97          .     SUB   A          

+6B5D 32 F0 6E    2.n   LD    (6EF0),A   

+6B60 CD 98 6E    ..n   CALL  6E98       

+6B63 FE 69       .i    CP    69         ; "i" und Info-Taste

+6B65 28 09       (.    JR    Z,6B70     

+6B67 C5          .     PUSH  BC         

+6B68 CD E2 6D    ..m   CALL  6DE2       

+6B6B C1          .     POP   BC         

+6B6C 10 EE       ..    DJNZ  6B5C       

+6B6E 18 0B       ..    JR    6B7B       ; Info aufrufen

+6B70 CD 1F 70    ..p   CALL  701F       ; "-break"

+6B73 18 06       ..    JR    6B7B       

+6B75 2D          -     DEC   L          

+6B76 62          b     LD    H,D        

+6B77 72          r     LD    (HL),D     

+6B78 65          e     LD    H,L        

+6B79 61          a     LD    H,C        

+6B7A 6B          k     LD    L,E        

+6B7B CD 9C 4B    ..K   CALL  4B9C       

+6B7E 97          .     SUB   A          

+6B7F 32 F6 6E    2.n   LD    (6EF6),A   

+6B82 2A 1A 6E    *.n   LD    HL,(6E1A)  ; Aktuelle Task

+6B85 CB FD       ..    SET   7,L        

+6B87 2C          ,     INC   L          ; N�echste Task

+6B88 01 FF FF    ...   LD    BC,FFFF    ; unendlich

+6B8B 3E 01       >.    LD    A,01       ; aktive Task suchen

+6B8D ED B1       ..    CPIR             

+6B8F CB 7D       .}    BIT   7,L

+6B91 20 0E        .    JR    NZ,6BA1    ; 01 gefunden

+6B93 21 81 18    !..   LD    HL,1881    ; Auf Anfang

+6B96 ED B1       ..    CPIR             ; naechste suchen

+6B98 CB 7D       .}    BIT   7,L        

+6B9A 20 05        .    JR    NZ,6BA1    

+6B9C CD E2 6D    ..m   CALL  6DE2       ; keine aktivierte Task gefunden  

+6B9F 18 B3       ..    JR    6B54       ; Auf Info-Taste warten

+6BA1 2D          -     DEC   L           

+6BA2 CB BD       ..    RES   7,L        

+6BA4 22 1A 6E    ".n   LD    (6E1A),HL  ; Taskindex Merken 

+6BA7 CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6BAA 3A 1A 6E    :.n   LD    A,(6E1A)   

+6BAD 57          W     LD    D,A        ; DE= PCB (DS 0)

+6BAE 1E 00       ..    LD    E,00       

+6BB0 CD DE 66    ..f   CALL  66DE       

+6BB3 22 1C 6E    ".n   LD    (6E1C),HL  

+6BB6 2A F7 6E    *.n   LD    HL,(6EF7)  

+6BB9 22 46 6C    "Fl   LD    (6C46),HL  

+6BBC DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+6BC0 3A 1A 6E    :.n   LD    A,(6E1A)   ; Taskindex (Leitblock) <> Maxiproz

+6BC3 DD BE 30    ..0   CP    (IX+30)    

+6BC6 28 14       (.    JR    Z,6BDC     

+6BC8 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6BCB 18 0F       ..    JR    6BDC       

+6BCD 20 6B        k    JR    NZ,6C3A    ; " kein Leitblock"

+6BCF 65          e     LD    H,L        

+6BD0 69          i     LD    L,C        

+6BD1 6E          n     LD    L,(HL)     

+6BD2 20 4C        L    JR    NZ,6C20    

+6BD4 65          e     LD    H,L        

+6BD5 69          i     LD    L,C        

+6BD6 74          t     LD    (HL),H     

+6BD7 62          b     LD    H,D        

+6BD8 6C          l     LD    L,H        

+6BD9 6F          o     LD    L,A        

+6BDA 63          c     LD    H,E        

+6BDB 6B          k     LD    L,E        

+6BDC DD 7E 01    .~.   LD    A,(IX+01)  

+6BDF B7          .     OR    A          ; wstate = 00, Task nicht aktiv

+6BE0 C8          .     RET   Z          

+6BE1 FE FE       ..    CP    FE         ; wstate = FE: Info-Stop

+6BE3 20 17        .    JR    NZ,6BFC    

+6BE5 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6BE8 18 10       ..    JR    6BFA       ; " stop durch info"

+6BEA 20 73        s    JR    NZ,6C5F    

+6BEC 74          t     LD    (HL),H     

+6BED 6F          o     LD    L,A        

+6BEE 70          p     LD    (HL),B     

+6BEF 20 64        d    JR    NZ,6C55    

+6BF1 75          u     LD    (HL),L     

+6BF2 72          r     LD    (HL),D     

+6BF3 63          c     LD    H,E        

+6BF4 68          h     LD    L,B        

+6BF5 20 69        i    JR    NZ,6C60    

+6BF7 6E          n     LD    L,(HL)     

+6BF8 66          f     LD    H,(HL)     

+6BF9 6F          o     LD    L,A        

+6BFA 18 12       ..    JR    6C0E       ; wstate loword: addresse im Hauptsp.

+6BFC 67          g     LD    H,A        ; IX+1

+6BFD DD 6E 00    .n.   LD    L,(IX+00)  ; wstate low

+6C00 DD 7E 02    .~.   LD    A,(IX+02)  ; wstate highword: (wstate lowword)

+6C03 BE          .     CP    (HL)       

+6C04 20 08        .    JR    NZ,6C0E    ; highbyte wstate

+6C06 24          $     INC   H          

+6C07 DD 7E 03    .~.   LD    A,(IX+03)  

+6C0A BE          .     CP    (HL)       

+6C0B CA 41 6B    .Ak   JP    Z,6B41     ; wstate/wstate+256 = (wstate)

+6C0E DD 36 01 00 .6..  LD    (IX+01),00 ; Inhalt nicht gleich

+6C12 C9          .     RET              

+6C13 ED 7B F2 6E .{.n  LD    SP,(6EF2)  

+6C17 C3 54 6B    .Tk   JP    6B54       

+6C1A FD 2A FA 6E .*.n  LD    IY,(6EFA)  ; Prozess start

+6C1E FD 23       .#    INC   IY         

+6C20 FD 23       .#    INC   IY         

+6C22 FD E9       ..    JP    (IY)       

+6C24 DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+6C28 DD 75 00    .u.   LD    (IX+00),L  ; wstate neu setzen addresse

+6C2B DD 74 01    .t.   LD    (IX+01),H  

+6C2E 7E          ~     LD    A,(HL)     

+6C2F DD 77 02    .w.   LD    (IX+02),A  ; inhalt von wstate

+6C32 24          $     INC   H          

+6C33 7E          ~     LD    A,(HL)     

+6C34 DD 77 03    .w.   LD    (IX+03),A  

+6C37 C3 26 29    .&)   JP    2926       ; wartezustand

+6C3A 50          P     LD    D,B        ; "PROZ ELAN"

+6C3B 52          R     LD    D,D        

+6C3C 4F          O     LD    C,A        

+6C3D 5A          Z     LD    E,D        

+6C3E 20 45        E    JR    NZ,6C85    

+6C40 4C          L     LD    C,H        

+6C41 41          A     LD    B,C        

+6C42 4E          N     LD    C,(HL)     

+6C43 11 6D C3    .m.   LD    DE,C36D    

+6C46 45          E     LD    B,L        

+6C47 6D          m     LD    L,L        

+6C48 45          E     LD    B,L        

+6C49 FF          .     RST   38         

+6C4A FF          .     RST   38         

+6C4B FF          .     RST   38         

+6C4C FF          .     RST   38         

+6C4D FF          .     RST   38         

+6C4E FF          .     RST   38         

+6C4F FF          .     RST   38         

+6C50 FF          .     RST   38         

+6C51 FF          .     RST   38         

+6C52 FF          .     RST   38         

+6C53 FF          .     RST   38         

+6C54 FF          .     RST   38         

+6C55 FF          .     RST   38         

+6C56 FF          .     RST   38         

+6C57 FF          .     RST   38         

+6C58 FF          .     RST   38         

+6C59 FF          .     RST   38         

+6C5A FF          .     RST   38         

+6C5B FF          .     RST   38         

+6C5C FF          .     RST   38         

+6C5D FF          .     RST   38         

+6C5E FF          .     RST   38         

+6C5F FF          .     RST   38         

+6C60 FF          .     RST   38         

+6C61 FF          .     RST   38         

+6C62 FF          .     RST   38         

+6C63 FF          .     RST   38         

+6C64 FF          .     RST   38         

+6C65 FF          .     RST   38         

+6C66 FF          .     RST   38         

+6C67 FF          .     RST   38         

+6C68 FF          .     RST   38         

+6C69 FF          .     RST   38         

+6C6A FF          .     RST   38         

+6C6B FF          .     RST   38         

+6C6C FF          .     RST   38         

+6C6D FF          .     RST   38         

+6C6E FF          .     RST   38         

+6C6F FF          .     RST   38         

+6C70 FF          .     RST   38         

+6C71 FF          .     RST   38         

+6C72 FF          .     RST   38         

+6C73 FF          .     RST   38         

+6C74 FF          .     RST   38         

+6C75 FF          .     RST   38         

+6C76 FF          .     RST   38         

+6C77 FF          .     RST   38         

+6C78 FF          .     RST   38         

+6C79 FF          .     RST   38         

+6C7A FF          .     RST   38         

+6C7B FF          .     RST   38         

+6C7C FF          .     RST   38         

+6C7D FF          .     RST   38         

+6C7E FF          .     RST   38         

+6C7F FF          .     RST   38         

+6C80 FF          .     RST   38         

+6C81 FF          .     RST   38         

+6C82 FF          .     RST   38         

+6C83 FF          .     RST   38         

+6C84 FF          .     RST   38         

+6C85 FF          .     RST   38         

+6C86 FF          .     RST   38         

+6C87 FF          .     RST   38         

+6C88 FF          .     RST   38         

+6C89 FF          .     RST   38         

+6C8A FF          .     RST   38         

+6C8B FF          .     RST   38         

+6C8C FF          .     RST   38         

+6C8D FF          .     RST   38         

+6C8E FF          .     RST   38         

+6C8F FF          .     RST   38         

+6C90 FF          .     RST   38         

+6C91 FF          .     RST   38         

+6C92 FF          .     RST   38         

+6C93 FF          .     RST   38         

+6C94 FF          .     RST   38         

+6C95 FF          .     RST   38         

+6C96 FF          .     RST   38         

+6C97 FF          .     RST   38         

+6C98 FF          .     RST   38         

+6C99 FF          .     RST   38         

+6C9A FF          .     RST   38         

+6C9B FF          .     RST   38         

+6C9C FF          .     RST   38         

+6C9D FF          .     RST   38         

+6C9E FF          .     RST   38         

+6C9F FF          .     RST   38         

+6CA0 FF          .     RST   38         

+6CA1 FF          .     RST   38         

+6CA2 FF          .     RST   38         

+6CA3 FF          .     RST   38         

+6CA4 FF          .     RST   38         

+6CA5 FF          .     RST   38         

+6CA6 FF          .     RST   38         

+6CA7 FF          .     RST   38         

+6CA8 FF          .     RST   38         

+6CA9 FF          .     RST   38         

+6CAA FF          .     RST   38         

+6CAB FF          .     RST   38         

+6CAC FF          .     RST   38         

+6CAD FF          .     RST   38         

+6CAE FF          .     RST   38         

+6CAF FF          .     RST   38         

+6CB0 FF          .     RST   38         

+6CB1 FF          .     RST   38         

+6CB2 FF          .     RST   38         

+6CB3 FF          .     RST   38         

+6CB4 FF          .     RST   38         

+6CB5 FF          .     RST   38         

+6CB6 FF          .     RST   38         

+6CB7 FF          .     RST   38         

+6CB8 FF          .     RST   38         

+6CB9 FF          .     RST   38         

+6CBA FF          .     RST   38         

+6CBB FF          .     RST   38         

+6CBC FF          .     RST   38         

+6CBD FF          .     RST   38         

+6CBE FF          .     RST   38         

+6CBF FF          .     RST   38         

+6CC0 FF          .     RST   38         

+6CC1 FF          .     RST   38         

+6CC2 FF          .     RST   38         

+6CC3 FF          .     RST   38         

+6CC4 FF          .     RST   38         

+6CC5 FF          .     RST   38         

+6CC6 FF          .     RST   38         

+6CC7 FF          .     RST   38         

+6CC8 FF          .     RST   38         

+6CC9 FF          .     RST   38         

+6CCA FF          .     RST   38         

+6CCB FF          .     RST   38         

+6CCC FF          .     RST   38         

+6CCD FF          .     RST   38         

+6CCE FF          .     RST   38         

+6CCF FF          .     RST   38         

+6CD0 FF          .     RST   38         

+6CD1 FF          .     RST   38         

+6CD2 FF          .     RST   38         

+6CD3 FF          .     RST   38         

+6CD4 FF          .     RST   38         

+6CD5 FF          .     RST   38         

+6CD6 FF          .     RST   38         

+6CD7 FF          .     RST   38         

+6CD8 FF          .     RST   38         

+6CD9 FF          .     RST   38         

+6CDA FF          .     RST   38         

+6CDB FF          .     RST   38         

+6CDC FF          .     RST   38         

+6CDD FF          .     RST   38         

+6CDE FF          .     RST   38         

+6CDF FF          .     RST   38         

+6CE0 FF          .     RST   38         

+6CE1 FF          .     RST   38         

+6CE2 FF          .     RST   38         

+6CE3 FF          .     RST   38         

+6CE4 FF          .     RST   38         

+6CE5 FF          .     RST   38         

+6CE6 FF          .     RST   38         

+6CE7 FF          .     RST   38         

+6CE8 FF          .     RST   38         

+6CE9 FF          .     RST   38         

+6CEA FF          .     RST   38         

+6CEB FF          .     RST   38         

+6CEC FF          .     RST   38         

+6CED FF          .     RST   38         

+6CEE FF          .     RST   38         

+6CEF FF          .     RST   38         

+6CF0 FF          .     RST   38         

+6CF1 FF          .     RST   38         

+6CF2 FF          .     RST   38         

+6CF3 FF          .     RST   38         

+6CF4 FF          .     RST   38         

+6CF5 FF          .     RST   38         

+6CF6 FF          .     RST   38         

+6CF7 FF          .     RST   38         

+6CF8 FF          .     RST   38         

+6CF9 FF          .     RST   38         

+6CFA FF          .     RST   38         

+6CFB FF          .     RST   38         

+6CFC FF          .     RST   38         

+6CFD FF          .     RST   38         

+6CFE FF          .     RST   38         

+6CFF FF          .     RST   38         

+6D00 FF          .     RST   38         

+6D01 FF          .     RST   38         

+6D02 FF          .     RST   38         

+6D03 FF          .     RST   38         

+6D04 FF          .     RST   38         

+6D05 FF          .     RST   38         

+6D06 FF          .     RST   38         

+6D07 FF          .     RST   38         

+6D08 FF          .     RST   38         

+6D09 FF          .     RST   38         

+6D0A FF          .     RST   38         

+6D0B FF          .     RST   38         

+6D0C FF          .     RST   38         

+6D0D FF          .     RST   38         

+6D0E FF          .     RST   38         

+6D0F FF          .     RST   38         

+6D10 FF          .     RST   38         

+6D11 13          .     INC   DE         

+6D12 6D          m     LD    L,L        

+6D13 CD 2D 57    .-W   CALL  572D       

+6D16 11 00 00    ...   LD    DE,0000    ; Task 0, DS 0 laden (Aktiv.Tab.) 

+6D19 CD DA 66    ..f   CALL  66DA       

+6D1C 11 80 18    ...   LD    DE,1880    ; 128 Bytes Akt.Tabelle 

+6D1F 01 80 00    ...   LD    BC,0080    

+6D22 ED B0       ..    LDIR             

+6D24 3A FF 18    :..   LD    A,(18FF)   ; 18FF = FF: SV und 18FF := 01

+6D27 3C          <     INC   A          ; sonst alten SV-Zustand lassen 

+6D28 20 07        .    JR    NZ,6D31    

+6D2A 3C          <     INC   A          

+6D2B 32 81 18    2..   LD    (1881),A   ; supervisor aktivieren

+6D2E 32 FF 18    2..   LD    (18FF),A   

+6D31 11 B9 4C    ..L   LD    DE,4CB9    ; Systemclocks (7)

+6D34 01 40 00    .@.   LD    BC,0040    

+6D37 ED B0       ..    LDIR             

+6D39 CD 41 6B    .Ak   CALL  6B41       

+6D3C 21 24 6C    !$l   LD    HL,6C24    

+6D3F 22 46 6C    "Fl   LD    (6C46),HL  

+6D42 C3 FE 52    ..R   JP    52FE       

+6D45 31 13 6D    1.m   LD    SP,6D13    

+6D48 CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6D4B 18 C9       ..    JR    6D16       ; Aktivierungstabelle/Clocks laden

+6D4D B7          .     OR    A          

+6D4E 20 0A        .    JR    NZ,6D5A    

+6D50 CD 1F 70    ..p   CALL  701F       ; Info aufrufen " plac"

+6D53 18 05       ..    JR    6D5A       

+6D55 20 70        p    JR    NZ,6DC7    

+6D57 6C          l     LD    L,H        

+6D58 61          a     LD    H,C        

+6D59 63          c     LD    H,E        

+6D5A D5          .     PUSH  DE         

+6D5B E5          .     PUSH  HL         

+6D5C 57          W     LD    D,A        

+6D5D 1E 00       ..    LD    E,00       ; Leitblock der Task laden

+6D5F CD DE 66    ..f   CALL  66DE       

+6D62 E5          .     PUSH  HL         

+6D63 FD E1       ..    POP   IY         ; Adresse --> IY

+6D65 E1          .     POP   HL         

+6D66 D1          .     POP   DE         

+6D67 C9          .     RET              ; -------- unblock (A) ------------

+6D68 B7          .     OR    A          

+6D69 C8          .     RET   Z          

+6D6A E5          .     PUSH  HL         

+6D6B 26 18       &.    LD    H,18       ; Aktivierungstabelle 1880 ....

+6D6D 6F          o     LD    L,A        

+6D6E CB FD       ..    SET   7,L        

+6D70 36 01       6.    LD    (HL),01    ; Task aktivieren

+6D72 E1          .     POP   HL         

+6D73 C9          .     RET              ;------------- block (A) ---------

+6D74 E5          .     PUSH  HL         

+6D75 26 18       &.    LD    H,18       

+6D77 6F          o     LD    L,A        

+6D78 CB FD       ..    SET   7,L        ; AKtivierungstabelle

+6D7A 36 FF       6.    LD    (HL),FF    ; Task deaktivieren

+6D7C E1          .     POP   HL         

+6D7D C9          .     RET              ;----------------------------------

+6D7E C5          .     PUSH  BC         

+6D7F E5          .     PUSH  HL         

+6D80 01 FF FF    ...   LD    BC,FFFF    

+6D83 26 18       &.    LD    H,18       

+6D85 C6 81       ..    ADD   A,81       

+6D87 6F          o     LD    L,A        

+6D88 3E 01       >.    LD    A,01       

+6D8A ED B1       ..    CPIR             

+6D8C CB 7D       .}    BIT   7,L        

+6D8E 20 09        .    JR    NZ,6D99    

+6D90 21 81 18    !..   LD    HL,1881    

+6D93 ED B1       ..    CPIR             

+6D95 CB 7D       .}    BIT   7,L        

+6D97 28 03       (.    JR    Z,6D9C     

+6D99 2D          -     DEC   L          

+6D9A CB BD       ..    RES   7,L        

+6D9C 7D          }     LD    A,L        

+6D9D E1          .     POP   HL         

+6D9E C1          .     POP   BC         

+6D9F C9          .     RET              ; ====== Miniprozess-Schleife ======

+6DA0 21 43 6C    !Cl   LD    HL,6C43    ; PROZ ELAN

+6DA3 ED 7B 43 6C .{Cl  LD    SP,(6C43)  

+6DA7 CD DA 6D    ..m   CALL  6DDA       ; 

+6DAA ED 73 43 6C .sCl  LD    (6C43),SP   

+6DAE 21 74 57    !tW   LD    HL,5774    ; PROZ LADER

+6DB1 ED 7B 74 57 .{tW  LD    SP,(5774)  

+6DB5 CD DA 6D    ..m   CALL  6DDA       

+6DB8 ED 73 74 57 .stW  LD    (5774),SP  

+6DBC 21 5E 7D    !^}   LD    HL,7D5E    ; PROZ MUELL

+6DBF ED 7B 5E 7D .{^}  LD    SP,(7D5E)  

+6DC3 CD DA 6D    ..m   CALL  6DDA       

+6DC6 ED 73 5E 7D .s^}  LD    (7D5E),SP  

+6DCA 21 CE 62    !.b   LD    HL,62CE    ; PROZ ARCH

+6DCD ED 7B CE 62 .{.b  LD    SP,(62CE)  

+6DD1 CD DA 6D    ..m   CALL  6DDA       

+6DD4 ED 73 CE 62 .s.b  LD    (62CE),SP  

+6DD8 18 C6       ..    JR    6DA0       ; zum Schleifenanfang

+6DDA 22 FA 6E    ".n   LD    (6EFA),HL  ;------- Prozess wechseln ---------

+6DDD E1          .     POP   HL         

+6DDE 22 1E 6E    ".n   LD    (6E1E),HL  

+6DE1 C9          .     RET              

+6DE2 3A FC 6E    :.n   LD    A,(6EFC)   

+6DE5 B7          .     OR    A          

+6DE6 C0          .     RET   NZ         

+6DE7 2A 1E 6E    *.n   LD    HL,(6E1E)  

+6DEA E9          .     JP    (HL)       

+6DEB F5          .     PUSH  AF         

+6DEC 3A 0D 6E    :.n   LD    A,(6E0D)   

+6DEF 3D          =     DEC   A          

+6DF0 FA FC 6D    ..m   JP    M,6DFC     

+6DF3 32 0D 6E    2.n   LD    (6E0D),A   

+6DF6 20 04        .    JR    NZ,6DFC    

+6DF8 97          .     SUB   A          

+6DF9 32 FC 6E    2.n   LD    (6EFC),A   

+6DFC F1          .     POP   AF         

+6DFD C9          .     RET              

+6DFE F5          .     PUSH  AF         

+6DFF 3A 0D 6E    :.n   LD    A,(6E0D)   

+6E02 3C          <     INC   A          

+6E03 32 0D 6E    2.n   LD    (6E0D),A   

+6E06 3E 01       >.    LD    A,01       

+6E08 32 FC 6E    2.n   LD    (6EFC),A   

+6E0B F1          .     POP   AF         

+6E0C C9          .     RET              

+6E0D 00          .     NOP              

+6E0E FD E5       ..    PUSH  IY         

+6E10 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+6E14 FD 7E 05    .~.   LD    A,(IY+05)  

+6E17 FD E1       ..    POP   IY         

+6E19 C9          .     RET              

+6E1A 80          .     ADD   B          

+6E1B 18 00       ..    JR    6E1D       

+6E1D 00          .     NOP              

+6E1E 00          .     NOP              ; Miniprozess addresse

+6E1F 00          .     NOP              

+6E20 DD E3       ..    EX    (SP),IX    

+6E22 FD E5       ..    PUSH  IY         ; warte

+6E24 D5          .     PUSH  DE         

+6E25 C5          .     PUSH  BC         

+6E26 E5          .     PUSH  HL         

+6E27 F5          .     PUSH  AF         

+6E28 DD E9       ..    JP    (IX)       

+6E2A DD E1       ..    POP   IX         

+6E2C F1          .     POP   AF         

+6E2D E1          .     POP   HL         

+6E2E C1          .     POP   BC         

+6E2F D1          .     POP   DE         

+6E30 FD E1       ..    POP   IY         

+6E32 DD E3       ..    EX    (SP),IX    

+6E34 C9          .     RET              ;========= timerinterrupt =======

+6E35 F5          .     PUSH  AF         

+6E36 3A FC 6E    :.n   LD    A,(6EFC)   

+6E39 B7          .     OR    A          

+6E3A 20 2C        ,    JR    NZ,6E68    

+6E3C F1          .     POP   AF         

+6E3D FB          .     EI               

+6E3E CD 3E 21    .>!   CALL  213E       

+6E41 F5          .     PUSH  AF         

+6E42 E5          .     PUSH  HL         

+6E43 2A F9 6E    *.n   LD    HL,(6EF9)  

+6E46 2D          -     DEC   L          

+6E47 28 1E       (.    JR    Z,6E67     

+6E49 F5          .     PUSH  AF         

+6E4A 21 F4 6E    !.n   LD    HL,6EF4    

+6E4D 86          .     ADD   (HL)       

+6E4E 77          w     LD    (HL),A     

+6E4F F1          .     POP   AF         

+6E50 F5          .     PUSH  AF         

+6E51 23          #     INC   HL         

+6E52 86          .     ADD   (HL)       

+6E53 77          w     LD    (HL),A     

+6E54 D6 64       .d    SUB   A,64       ; MOD 100

+6E56 38 04       8.    JR    C,6E5C     

+6E58 77          w     LD    (HL),A     

+6E59 CD 4C 4B    .LK   CALL  4B4C       

+6E5C F1          .     POP   AF         

+6E5D 21 F6 6E    !.n   LD    HL,6EF6    

+6E60 86          .     ADD   (HL)       

+6E61 77          w     LD    (HL),A     

+6E62 FE 64       .d    CP    64         

+6E64 D4 9A 2A    ..*   CALL  NC,2A9A    

+6E67 E1          .     POP   HL         

+6E68 F1          .     POP   AF         

+6E69 C9          .     RET              ;------------ Info Taste ----------

+6E6A 32 F1 6E    2.n   LD    (6EF1),A   ; Taste zweimal druecken

+6E6D 3A F0 6E    :.n   LD    A,(6EF0)   

+6E70 B7          .     OR    A          

+6E71 28 1F       (.    JR    Z,6E92     

+6E73 CD 8F 6E    ..n   CALL  6E8F       

+6E76 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6E79 18 0F       ..    JR    6E8A       ; " Info erzwungen" 

+6E7B 20 49        I    JR    NZ,6EC6    

+6E7D 6E          n     LD    L,(HL)     

+6E7E 66          f     LD    H,(HL)     

+6E7F 6F          o     LD    L,A        

+6E80 20 65        e    JR    NZ,6EE7    

+6E82 72          r     LD    (HL),D     

+6E83 7A          z     LD    A,D        

+6E84 77          w     LD    (HL),A     

+6E85 75          u     LD    (HL),L     

+6E86 6E          n     LD    L,(HL)     

+6E87 67          g     LD    H,A        

+6E88 65          e     LD    H,L        

+6E89 6E          n     LD    L,(HL)     

+6E8A 97          .     SUB   A          

+6E8B 32 F0 6E    2.n   LD    (6EF0),A   

+6E8E C9          .     RET              ;----------------------------------

+6E8F FB          .     EI               

+6E90 ED 4D       .M    RETI             

+6E92 3C          <     INC   A          

+6E93 32 F0 6E    2.n   LD    (6EF0),A   ; info tasten anzahl

+6E96 97          .     SUB   A          

+6E97 C9          .     RET              

+6E98 3A F1 6E    :.n   LD    A,(6EF1)   ; info kanal 

+6E9B C3 06 1F    ...   JP    1F06       ; auf taste warten

+6E9E CD 98 6E    ..n   CALL  6E98       

+6EA1 D0          .     RET   NC         

+6EA2 CD 20 6E    . n   CALL  6E20       

+6EA5 CD E2 6D    ..m   CALL  6DE2       

+6EA8 CD 2A 6E    .*n   CALL  6E2A       

+6EAB 18 F1       ..    JR    6E9E       

+6EAD CD CA 6E    ..n   CALL  6ECA       

+6EB0 CD 9E 6E    ..n   CALL  6E9E       

+6EB3 CD B9 6E    ..n   CALL  6EB9       

+6EB6 FE 6A       .j    CP    6A         ; j

+6EB8 C9          .     RET              

+6EB9 32 C9 6E    2.n   LD    (6EC9),A   

+6EBC E5          .     PUSH  HL         

+6EBD 21 C8 6E    !.n   LD    HL,6EC8    

+6EC0 CD CA 6E    ..n   CALL  6ECA       

+6EC3 E1          .     POP   HL         

+6EC4 3A C9 6E    :.n   LD    A,(6EC9)   

+6EC7 C9          .     RET              

+6EC8 01 00 E5    ...   LD    BC,E500    

+6ECB C5          .     PUSH  BC         

+6ECC 4E          N     LD    C,(HL)    ; Laenge am Stringanafng 

+6ECD 23          #     INC   HL         

+6ECE 06 00       ..    LD    B,00       

+6ED0 3A F1 6E    :.n   LD    A,(6EF1)   

+6ED3 C5          .     PUSH  BC         

+6ED4 CD 88 21    ..!   CALL  2188       ; OUTPUT

+6ED7 38 13       8.    JR    C,6EEC     

+6ED9 CD 20 6E    . n   CALL  6E20       

+6EDC CD E2 6D    ..m   CALL  6DE2       

+6EDF CD 2A 6E    .*n   CALL  6E2A       

+6EE2 09          .     ADD   HL,BC      

+6EE3 E3          .     EX    (SP),HL    

+6EE4 B7          .     OR    A          

+6EE5 ED 42       .B    SBC   HL,BC      

+6EE7 44          D     LD    B,H        

+6EE8 4D          M     LD    C,L        

+6EE9 E1          .     POP   HL         

+6EEA 18 E4       ..    JR    6ED0       

+6EEC C1          .     POP   BC         

+6EED C1          .     POP   BC         

+6EEE E1          .     POP   HL         

+6EEF C9          .     RET              

+6EF0 00          .     NOP              

+6EF1 01 00 00    ...   LD    BC,0000    

+6EF4 00          .     NOP              

+6EF5 00          .     NOP              

+6EF6 00          .     NOP              

+6EF7 00          .     NOP              

+6EF8 00          .     NOP              

+6EF9 00          .     NOP              

+6EFA 43          C     LD    B,E        

+6EFB 6C          l     LD    L,H        

+6EFC 01 69 6E    .in   LD    BC,6E69    ; "info quelle   3 (!)"

+6EFF 66          f     LD    H,(HL)     

+6F00 6F          o     LD    L,A        

+6F01 2E 71       .q    LD    L,71       

+6F03 75          u     LD    (HL),L     

+6F04 65          e     LD    H,L        

+6F05 6C          l     LD    L,H        

+6F06 6C          l     LD    L,H        

+6F07 65          e     LD    H,L        

+6F08 20 20             JR    NZ,6F2A    

+6F0A 20 33        3    JR    NZ,6F3F    

+6F0C 20 28        (    JR    NZ,6F36    

+6F0E 21 29 

+6F10 D5                PUSH  DE         ;------------------------------

+6F11 CD B1 7A    ..z   CALL  7AB1       ; Altes Password korrekt ?

+6F14 D1          .     POP   DE         

+6F15 01 01 00    ...   LD    BC,0001    

+6F18 C0          .     RET   NZ         

+6F19 21 19 7D    !.}   LD    HL,7D19    

+6F1C 06 0A       ..    LD    B,0A       ; 10 Bytes invertieren und uebetr.

+6F1E 1A          .     LD    A,(DE)     ; Neues Password eintragen 

+6F1F 2F          /     CPL              

+6F20 77          w     LD    (HL),A     

+6F21 23          #     INC   HL         

+6F22 13          .     INC   DE         

+6F23 10 F9       ..    DJNZ  6F1E       

+6F25 01 00 00    ...   LD    BC,0000    

+6F28 C9          .     RET              

+6F29 C9          .     RET              ;----------------------------------

+6F2A CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6F2D 18 03       ..    JR    6F32       

+6F2F 20 4B        K    JR    NZ,6F7C    ; " KE"

+6F31 45          E     LD    B,L        

+6F32 C9          .     RET              ;---------- info-taste gedrueckt ---

+6F33 C3 6A 6E    .jn   JP    6E6A       ; Info aufrufen

+6F36 C3 CA 6E    ..n   JP    6ECA       

+6F39 7A          z     LD    A,D        

+6F3A B7          .     OR    A          

+6F3B 28 14       (.    JR    Z,6F51     

+6F3D FE FF       ..    CP    FF         

+6F3F 20 04        .    JR    NZ,6F45    

+6F41 7C          |     LD    A,H        

+6F42 CB 27       .'    SLA   A          

+6F44 C9          .     RET              

+6F45 CD 72 6F    .ro   CALL  6F72       

+6F48 CD 5C 65    .\e   CALL  655C       

+6F4B DD E1       ..    POP   IX         

+6F4D CD 10 70    ..p   CALL  7010       

+6F50 C9          .     RET              

+6F51 E5          .     PUSH  HL         

+6F52 6C          l     LD    L,H        

+6F53 63          c     LD    H,E        

+6F54 C5          .     PUSH  BC         

+6F55 ED 4B 9B 7C .K.|  LD    BC,(7C9B)  

+6F59 B7          .     OR    A          

+6F5A ED 42       .B    SBC   HL,BC      

+6F5C 30 68       0h    JR    NC,6FC6    

+6F5E 09          .     ADD   HL,BC      

+6F5F C1          .     POP   BC         

+6F60 CD 92 5A    ..Z   CALL  5A92       

+6F63 7C          |     LD    A,H        

+6F64 E1          .     POP   HL         

+6F65 C9          .     RET              

+6F66 CD 72 6F    .ro   CALL  6F72       

+6F69 CD 36 6A    .6j   CALL  6A36       

+6F6C DD E1       ..    POP   IX         

+6F6E CD 10 70    ..p   CALL  7010       

+6F71 C9          .     RET              

+6F72 DD E1       ..    POP   IX         

+6F74 DD 22 8C 6F .".o  LD    (6F8C),IX  

+6F78 CD 20 6E    . n   CALL  6E20       

+6F7B DD 2A 8C 6F .*.o  LD    IX,(6F8C)  

+6F7F DD E5       ..    PUSH  IX         

+6F81 ED 73 90 6F .s.o  LD    (6F90),SP  

+6F85 DD E9       ..    JP    (IX)       

+6F87 69          i     LD    L,C        ; "ixsav"

+6F88 78          x     LD    A,B        

+6F89 73          s     LD    (HL),E     

+6F8A 61          a     LD    H,C        

+6F8B 76          v     HALT             

+6F8C 00          .     NOP              

+6F8D 00          .     NOP              

+6F8E 00          .     NOP              

+6F8F 00          .     NOP              

+6F90 00          .     NOP              

+6F91 00          .     NOP              

+6F92 00          .     NOP              

+6F93 00          .     NOP              

+6F94 3A 4B 7B    :K{   LD    A,(7B4B)   

+6F97 B7          .     OR    A          

+6F98 28 31       (1    JR    Z,6FCB     

+6F9A ED 7B 90 6F .{.o  LD    SP,(6F90)  

+6F9E CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6FA1 DD E1       ..    POP   IX         

+6FA3 DD 22 8C 6F .".o  LD    (6F8C),IX  

+6FA7 DD E5       ..    PUSH  IX         

+6FA9 3A 1A 6E    :.n   LD    A,(6E1A)   ; Taskindex aktueller Prozess

+6FAC E6 7F       ..    AND   7F         

+6FAE 28 0F       (.    JR    Z,6FBF     ; Task 0 ?

+6FB0 57          W     LD    D,A        ; PCB laden

+6FB1 1E 00       ..    LD    E,00       

+6FB3 CD DE 66    ..f   CALL  66DE       

+6FB6 22 1C 6E    ".n   LD    (6E1C),HL  

+6FB9 21 FF FF    !..   LD    HL,FFFF    

+6FBC 22 23 7D    "#}   LD    (7D23),HL  

+6FBF DD E1       ..    POP   IX         

+6FC1 CD 2A 6E    .*n   CALL  6E2A       

+6FC4 18 B2       ..    JR    6F78       

+6FC6 21 BC 7C    !.|   LD    HL,7CBC    

+6FC9 18 03       ..    JR    6FCE       

+6FCB 21 A6 7C    !.|   LD    HL,7CA6    

+6FCE ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+6FD2 CD CA 6E    ..n   CALL  6ECA       

+6FD5 C3 D4 70    ..p   JP    70D4       

+6FD8 ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+6FDC C3 8A 71    ..q   JP    718A       

+6FDF 7A          z     LD    A,D        

+6FE0 B7          .     OR    A          

+6FE1 CA 51 6F    .Qo   JP    Z,6F51     

+6FE4 FE FF       ..    CP    FF         

+6FE6 20 04        .    JR    NZ,6FEC    

+6FE8 7C          |     LD    A,H        

+6FE9 CB 27       .'    SLA   A          

+6FEB C9          .     RET              

+6FEC CD 72 6F    .ro   CALL  6F72       

+6FEF CD 2C 66    .,f   CALL  662C       

+6FF2 DD E1       ..    POP   IX         

+6FF4 CD 10 70    ..p   CALL  7010       

+6FF7 C9          .     RET              

+6FF8 CD 72 6F    .ro   CALL  6F72       

+6FFB CD DA 66    ..f   CALL  66DA       

+6FFE DD E1       ..    POP   IX         

+7000 CD 10 70    ..p   CALL  7010       

+7003 C9          .     RET              

+7004 CD 72 6F    .ro   CALL  6F72       

+7007 CD DE 66    ..f   CALL  66DE       

+700A DD E1       ..    POP   IX         

+700C CD 10 70    ..p   CALL  7010       

+700F C9          .     RET              

+7010 DD E1       ..    POP   IX         

+7012 FD 21 08 00 .!..  LD    IY,0008    

+7016 FD 39       .9    ADD   IY,SP      

+7018 FD F9       ..    LD    SP,IY      

+701A FD E1       ..    POP   IY         

+701C DD E3       ..    EX    (SP),IX    

+701E C9          .     RET              ; =============== Info ===========

+701F E3          .     EX    (SP),HL    

+7020 F5          .     PUSH  AF         

+7021 23          #     INC   HL         

+7022 23          #     INC   HL         

+7023 7E          ~     LD    A,(HL)     

+7024 2B          +     DEC   HL         

+7025 2B          +     DEC   HL         

+7026 B7          .     OR    A          

+7027 20 03        .    JR    NZ,702C    

+7029 F1          .     POP   AF         

+702A E3          .     EX    (SP),HL    

+702B C9          .     RET              

+702C E5          .     PUSH  HL         

+702D 3A 60 78    :`x   LD    A,(7860)   

+7030 B7          .     OR    A          

+7031 28 13       (.    JR    Z,7046     

+7033 23          #     INC   HL         

+7034 CD 98 75    ..u   CALL  7598       

+7037 CD 0E 6E    ..n   CALL  6E0E       

+703A 21 D2 77    !.w   LD    HL,77D2    

+703D BE          .     CP    (HL)       

+703E CA 29 71    .)q   JP    Z,7129     

+7041 CD E2 6D    ..m   CALL  6DE2       

+7044 18 FB       ..    JR    7041       

+7046 E1          .     POP   HL         

+7047 F1          .     POP   AF         

+7048 E3          .     EX    (SP),HL    

+7049 FD E5       ..    PUSH  IY         

+704B F5          .     PUSH  AF         

+704C 3A 17 82    :..   LD    A,(8217)   

+704F 3D          =     DEC   A          

+7050 F2 56 70    .Vp   JP    P,7056     

+7053 32 17 82    2..   LD    (8217),A   

+7056 FD 21 04 00 .!..  LD    IY,0004    

+705A FD 39       .9    ADD   IY,SP      

+705C F1          .     POP   AF         

+705D FD E5       ..    PUSH  IY         

+705F DD E5       ..    PUSH  IX         

+7061 D9          .     EXX              

+7062 E5          .     PUSH  HL         

+7063 D5          .     PUSH  DE         

+7064 C5          .     PUSH  BC         

+7065 D9          .     EXX              

+7066 08          .     EX    AF,AF'     

+7067 F5          .     PUSH  AF         

+7068 08          .     EX    AF,AF'     

+7069 E5          .     PUSH  HL         

+706A D5          .     PUSH  DE         

+706B C5          .     PUSH  BC         

+706C F5          .     PUSH  AF         

+706D CD 8A 28    ..(   CALL  288A       

+7070 CB 70       .p    BIT   6,B        

+7072 20 08        .    JR    NZ,707C    

+7074 CB 21       .!    SLA   C          

+7076 CB 10       ..    RL    B          

+7078 ED 43 9B 7C .C.|  LD    (7C9B),BC  

+707C FD 21 00 00 .!..  LD    IY,0000    

+7080 FD 39       .9    ADD   IY,SP      

+7082 FD E5       ..    PUSH  IY         

+7084 21 60 78    !`x   LD    HL,7860    

+7087 CD 65 82    .e.   CALL  8265       

+708A CD FE 6D    ..m   CALL  6DFE       

+708D 3E 01       >.    LD    A,01       

+708F 32 F9 6E    2.n   LD    (6EF9),A   

+7092 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7096 FD 4E 03    .N.   LD    C,(IY+03)  

+7099 FD 46 04    .F.   LD    B,(IY+04)  

+709C ED 43 50 7B .CP{  LD    (7B50),BC  

+70A0 01 94 6F    ..o   LD    BC,6F94    

+70A3 FD 70 04    .p.   LD    (IY+04),B  

+70A6 FD 71 03    .q.   LD    (IY+03),C  

+70A9 97          .     SUB   A          

+70AA 32 4B 7B    2K{   LD    (7B4B),A   

+70AD FD E1       ..    POP   IY         

+70AF 21 39 7B    !9{   LD    HL,7B39    

+70B2 36 00       6.    LD    (HL),00    

+70B4 21 26 7B    !&{   LD    HL,7B26    

+70B7 22 5C 7B    "\{   LD    (7B5C),HL  

+70BA FD 22 92 6F .".o  LD    (6F92),IY  

+70BE 11 D1 77    ..w   LD    DE,77D1    

+70C1 CD B2 74    ..t   CALL  74B2       

+70C4 3E FF       >.    LD    A,FF       

+70C6 32 54 7B    2T{   LD    (7B54),A   

+70C9 97          .     SUB   A          

+70CA 32 18 7D    2.}   LD    (7D18),A   

+70CD ED 73 8E 6F .s.o  LD    (6F8E),SP  

+70D1 CD F2 74    ..t   CALL  74F2       

+70D4 CD B2 75    ..u   CALL  75B2       

+70D7 FE 67       .g    CP    67         ; "g" Weiter

+70D9 CA 41 71    .Aq   JP    Z,7141     

+70DC FE 50       .P    CP    50         ; "P" Password

+70DE CA 8D 7A    ..z   JP    Z,7A8D     

+70E1 F5          .     PUSH  AF         

+70E2 3A 18 7D    :.}   LD    A,(7D18)   

+70E5 B7          .     OR    A          

+70E6 28 41       (A    JR    Z,7129     

+70E8 F1          .     POP   AF         

+70E9 FE 0D       ..    CP    0D         ; CR Dump

+70EB CA 5A 72    .Zr   JP    Z,725A     

+70EE FE 77       .w    CP    77         ; w  Wordaddress setzen

+70F0 CA 3E 72    .>r   JP    Z,723E     

+70F3 FE 7A       .z    CP    7A         ; z  Leitblock zeigen

+70F5 CA BB 71    ..q   JP    Z,71BB     

+70F8 FE 73       .s    CP    73         ; s  Dataspace waehlen

+70FA CA 26 72    .&r   JP    Z,7226     

+70FD FE 70       .p    CP    70         ; p Byteaddresse setzen

+70FF CA 2D 72    .-r   JP    Z,722D     

+7102 FE 6C       .l    CP    6C         ; l Dumplaenge setzen

+7104 CA 54 72    .Tr   JP    Z,7254     

+7107 FE 6B       .k    CP    6B         ; k Block vom HG laden

+7109 CA A9 73    ..s   JP    Z,73A9     

+710C FE 78       .x    CP    78         ; x Bytekette suchen

+710E CA C0 73    ..s   JP    Z,73C0     

+7111 FE 6F       .o    CP    6F         ; o Naechste Seite dumpen

+7113 CA 51 73    .Qs   JP    Z,7351     

+7116 FE 72       .r    CP    72         ; r Miniprozesse freigeben

+7118 28 1A       (.    JR    Z,7134     

+711A FE 79       .y    CP    79         ; y Spezielle Kommando

+711C CA B3 78    ..x   JP    Z,78B3     

+711F FE 71       .q    CP    71         ; q Zur anderen Tas wechseln

+7121 CA A4 71    ..q   JP    Z,71A4     

+7124 FE 74       .t    CP    74         ; t Register anzeigen

+7126 CC 07 7B    ..{   CALL  Z,7B07     

+7129 3E 07       >.    LD    A,07       ; Unbekannt beep

+712B CD A4 75    ..u   CALL  75A4       

+712E ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+7132 18 A0       ..    JR    70D4       

+7134 22 4C 7B    "L{   LD    (7B4C),HL  

+7137 CD EB 6D    ..m   CALL  6DEB       

+713A 3E 01       >.    LD    A,01       

+713C 32 4B 7B    2K{   LD    (7B4B),A   

+713F 18 93       ..    JR    70D4       

+7141 97          .     SUB   A          

+7142 32 F9 6E    2.n   LD    (6EF9),A   

+7145 21 60 78    !`x   LD    HL,7860    

+7148 CD 62 82    .b.   CALL  8262       

+714B 3A 17 82    :..   LD    A,(8217)   

+714E B7          .     OR    A          

+714F F2 56 71    .Vq   JP    P,7156     

+7152 3C          <     INC   A          

+7153 32 17 82    2..   LD    (8217),A   

+7156 CD EB 6D    ..m   CALL  6DEB       

+7159 ED 4B 50 7B .KP{  LD    BC,(7B50)  

+715D FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7161 FD 71 03    .q.   LD    (IY+03),C  

+7164 FD 70 04    .p.   LD    (IY+04),B  

+7167 3A 4B 7B    :K{   LD    A,(7B4B)   

+716A B7          .     OR    A          

+716B 28 0A       (.    JR    Z,7177     

+716D 21 00 00    !..   LD    HL,0000    

+7170 3A 4C 7B    :L{   LD    A,(7B4C)   

+7173 B7          .     OR    A          

+7174 CA 1A 6C    ..l   JP    Z,6C1A     

+7177 F1          .     POP   AF         

+7178 C1          .     POP   BC         

+7179 D1          .     POP   DE         

+717A E1          .     POP   HL         

+717B 08          .     EX    AF,AF'     

+717C F1          .     POP   AF         

+717D 08          .     EX    AF,AF'     

+717E D9          .     EXX              

+717F C1          .     POP   BC         

+7180 D1          .     POP   DE         

+7181 E1          .     POP   HL         

+7182 D9          .     EXX              

+7183 DD E1       ..    POP   IX         

+7185 FD E1       ..    POP   IY         

+7187 FD E1       ..    POP   IY         

+7189 C9          .     RET              

+718A 21 60 78    !`x   LD    HL,7860    

+718D CD 62 82    .b.   CALL  8262       

+7190 ED 4B 50 7B .KP{  LD    BC,(7B50)  

+7194 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7198 FD 71 03    .q.   LD    (IY+03),C  

+719B FD 70 04    .p.   LD    (IY+04),B  

+719E CD E2 6D    ..m   CALL  6DE2       

+71A1 C3 7C 70    .|p   JP    707C       

+71A4 7D          }     LD    A,L        

+71A5 B7          .     OR    A          

+71A6 CA D4 70    ..p   JP    Z,70D4     

+71A9 55          U     LD    D,L        

+71AA 1E 00       ..    LD    E,00       

+71AC F5          .     PUSH  AF         

+71AD CD 04 70    ..p   CALL  7004       

+71B0 2E 01       ..    LD    L,01       

+71B2 36 FE       6.    LD    (HL),FE    

+71B4 F1          .     POP   AF         

+71B5 CD 68 6D    .hm   CALL  6D68       

+71B8 C3 D4 70    ..p   JP    70D4       

+71BB 7C          |     LD    A,H        

+71BC B5          .     OR    L          

+71BD 28 08       (.    JR    Z,71C7     

+71BF 55          U     LD    D,L        

+71C0 1E 00       ..    LD    E,00       

+71C2 CD F8 6F    ..o   CALL  6FF8       

+71C5 18 03       ..    JR    71CA       

+71C7 2A 1C 6E    *.n   LD    HL,(6E1C)  

+71CA FD E5       ..    PUSH  IY         

+71CC FD 21 72 7B .!r{  LD    IY,7B72    

+71D0 3E 00       >.    LD    A,00       

+71D2 32 71 7B    2q{   LD    (7B71),A   

+71D5 E5          .     PUSH  HL         

+71D6 21 39 7B    !9{   LD    HL,7B39    

+71D9 CB 86       ..    RES   0,(HL)     

+71DB 21 6B 7C    !k|   LD    HL,7C6B    

+71DE CD CA 6E    ..n   CALL  6ECA       

+71E1 CD 1C 7B    ..{   CALL  7B1C       

+71E4 E1          .     POP   HL         

+71E5 FD 7E 02    .~.   LD    A,(IY+02)  

+71E8 B7          .     OR    A          

+71E9 CA 21 72    .!r   JP    Z,7221     

+71EC FD 5E 00    .^.   LD    E,(IY+00)  

+71EF 16 00       ..    LD    D,00       

+71F1 E5          .     PUSH  HL         

+71F2 19          .     ADD   HL,DE      

+71F3 FD 46 01    .F.   LD    B,(IY+01)  

+71F6 CD 2D 75    .-u   CALL  752D       

+71F9 FD E5       ..    PUSH  IY         

+71FB E1          .     POP   HL         

+71FC 23          #     INC   HL         

+71FD 23          #     INC   HL         

+71FE CD CA 6E    ..n   CALL  6ECA       

+7201 3A 71 7B    :q{   LD    A,(7B71)   

+7204 C6 14       ..    ADD   A,14       

+7206 FE 50       .P    CP    50         

+7208 38 04       8.    JR    C,720E     

+720A CD 1C 7B    ..{   CALL  7B1C       

+720D 97          .     SUB   A          

+720E 32 71 7B    2q{   LD    (7B71),A   

+7211 CD 84 75    ..u   CALL  7584       

+7214 16 00       ..    LD    D,00       

+7216 FD 5E 02    .^.   LD    E,(IY+02)  

+7219 13          .     INC   DE         

+721A 13          .     INC   DE         

+721B 13          .     INC   DE         

+721C FD 19       ..    ADD   IY,DE      

+721E E1          .     POP   HL         

+721F 18 C4       ..    JR    71E5       

+7221 FD E1       ..    POP   IY         

+7223 C3 CD 70    ..p   JP    70CD       

+7226 7D          }     LD    A,L        

+7227 32 54 7B    2T{   LD    (7B54),A   

+722A C3 D4 70    ..p   JP    70D4       

+722D 22 5C 7B    "\{   LD    (7B5C),HL  

+7230 3A 71 78    :qx   LD    A,(7871)   

+7233 32 5E 7B    2^{   LD    (7B5E),A   

+7236 3E 01       >.    LD    A,01       

+7238 32 CD 77    2.w   LD    (77CD),A   

+723B C3 D4 70    ..p   JP    70D4       

+723E CB 25       .%    SLA   L          

+7240 CB 14       ..    RL    H          

+7242 22 5C 7B    "\{   LD    (7B5C),HL  

+7245 3A 71 78    :qx   LD    A,(7871)   

+7248 CB 17       ..    RL    A          

+724A 32 5E 7B    2^{   LD    (7B5E),A   

+724D 97          .     SUB   A          

+724E 32 CD 77    2.w   LD    (77CD),A   

+7251 C3 D4 70    ..p   JP    70D4       

+7254 22 65 7B    "e{   LD    (7B65),HL  

+7257 C3 D4 70    ..p   JP    70D4       

+725A 2A 99 7C    *.|   LD    HL,(7C99)  

+725D 7C          |     LD    A,H        

+725E B5          .     OR    L          

+725F C2 D4 70    ..p   JP    NZ,70D4    

+7262 CD 1C 7B    ..{   CALL  7B1C       

+7265 21 61 78    !ax   LD    HL,7861    

+7268 CD CA 6E    ..n   CALL  6ECA       

+726B 21 54 7B    !T{   LD    HL,7B54    

+726E CD 3A 7A    .:z   CALL  7A3A       

+7271 21 5C 7B    !\{   LD    HL,7B5C    

+7274 CD 3A 7A    .:z   CALL  7A3A       

+7277 21 65 7B    !e{   LD    HL,7B65    

+727A CD 3A 7A    .:z   CALL  7A3A       

+727D 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7280 ED 4B 65 7B .Ke{  LD    BC,(7B65)  

+7284 CD 8A 72    ..r   CALL  728A       

+7287 C3 CD 70    ..p   JP    70CD       

+728A 3E 00       >.    LD    A,00       

+728C 32 3E 7B    2>{   LD    (7B3E),A   

+728F 7D          }     LD    A,L        

+7290 32 6C 78    2lx   LD    (786C),A   

+7293 E6 F0       ..    AND   F0         

+7295 6F          o     LD    L,A        

+7296 3A 5E 7B    :^{   LD    A,(7B5E)   

+7299 5F          _     LD    E,A        

+729A 78          x     LD    A,B        

+729B B7          .     OR    A          

+729C FA B3 72    ..r   JP    M,72B3     

+729F CD B9 72    ..r   CALL  72B9       

+72A2 CD 20 6E    . n   CALL  6E20       

+72A5 CD 98 6E    ..n   CALL  6E98       

+72A8 38 04       8.    JR    C,72AE     

+72AA CD 2A 6E    .*n   CALL  6E2A       

+72AD C9          .     RET              

+72AE CD 2A 6E    .*n   CALL  6E2A       

+72B1 18 E7       ..    JR    729A       

+72B3 21 39 7B    !9{   LD    HL,7B39    

+72B6 CB C6       ..    SET   0,(HL)     

+72B8 C9          .     RET              

+72B9 C5          .     PUSH  BC         

+72BA E5          .     PUSH  HL         

+72BB 22 73 78    "sx   LD    (7873),HL  

+72BE ED 53 75 78 .Sux  LD    (7875),DE  

+72C2 22 77 78    "wx   LD    (7877),HL  

+72C5 ED 53 79 78 .Syx  LD    (7879),DE  

+72C9 E5          .     PUSH  HL         

+72CA CD 88 78    ..x   CALL  7888       

+72CD CD 39 6F    .9o   CALL  6F39       

+72D0 E1          .     POP   HL         

+72D1 CB 3C       .<    SLR   H          

+72D3 CE 00       ..    ADC   A,00       

+72D5 67          g     LD    H,A        

+72D6 E5          .     PUSH  HL         

+72D7 CD 1C 7B    ..{   CALL  7B1C       

+72DA 21 3E 7B    !>{   LD    HL,7B3E    

+72DD 34          4     INC   (HL)       

+72DE 3A CD 77    :.w   LD    A,(77CD)   

+72E1 B7          .     OR    A          

+72E2 20 0B        .    JR    NZ,72EF    

+72E4 21 79 78    !yx   LD    HL,7879    

+72E7 CB 3E       .>    SLR   (HL)       

+72E9 2B          +     DEC   HL         

+72EA CB 1E       ..    RR    (HL)       

+72EC 2B          +     DEC   HL         

+72ED CB 1E       ..    RR    (HL)       

+72EF 21 79 78    !yx   LD    HL,7879    

+72F2 CD 56 75    .Vu   CALL  7556       

+72F5 2B          +     DEC   HL         

+72F6 CD 56 75    .Vu   CALL  7556       

+72F9 2B          +     DEC   HL         

+72FA CD 56 75    .Vu   CALL  7556       

+72FD E1          .     POP   HL         

+72FE 22 73 78    "sx   LD    (7873),HL  

+7301 3E 3A       >:    LD    A,3A       

+7303 CD A4 75    ..u   CALL  75A4       

+7306 3E 20       >     LD    A,20       

+7308 CD A4 75    ..u   CALL  75A4       

+730B 06 08       ..    LD    B,08       

+730D CD 2D 75    .-u   CALL  752D       

+7310 3E 20       >     LD    A,20       

+7312 CD A4 75    ..u   CALL  75A4       

+7315 06 08       ..    LD    B,08       

+7317 CD 2D 75    .-u   CALL  752D       

+731A 3E 20       >     LD    A,20       

+731C CD A4 75    ..u   CALL  75A4       

+731F 2A 73 78    *sx   LD    HL,(7873)  

+7322 01 10 00    ...   LD    BC,0010    

+7325 7E          ~     LD    A,(HL)     

+7326 FE 20       .     CP    20         

+7328 30 02       0.    JR    NC,732C    

+732A 3E 2E       >.    LD    A,2E       

+732C FE 7E       .~    CP    7E         

+732E 38 02       8.    JR    C,7332     

+7330 3E 2E       >.    LD    A,2E       

+7332 CD A4 75    ..u   CALL  75A4       

+7335 ED A1       ..    CPI              

+7337 EA 25 73    .%s   JP    PE,7325    

+733A E1          .     POP   HL         

+733B ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+733F ED 5B 75 78 .[ux  LD    DE,(7875)  

+7343 B7          .     OR    A          

+7344 ED 4A       .J    ADC   HL,BC      

+7346 30 01       0.    JR    NC,7349    

+7348 1C          .     INC   E          

+7349 C1          .     POP   BC         

+734A 79          y     LD    A,C        

+734B D6 10       ..    SUB   A,10       

+734D 4F          O     LD    C,A        

+734E D0          .     RET   NC         

+734F 05          .     DEC   B          

+7350 C9          .     RET              

+7351 7C          |     LD    A,H        

+7352 B5          .     OR    L          

+7353 28 04       (.    JR    Z,7359     

+7355 54          T     LD    D,H        

+7356 5D          ]     LD    E,L        

+7357 18 04       ..    JR    735D       

+7359 ED 5B 65 7B .[e{  LD    DE,(7B65)  

+735D 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7360 B7          .     OR    A          

+7361 ED 5A       .Z    ADC   HL,DE      

+7363 22 5C 7B    "\{   LD    (7B5C),HL  

+7366 30 04       0.    JR    NC,736C    

+7368 21 5E 7B    !^{   LD    HL,7B5E    

+736B 34          4     INC   (HL)       

+736C C3 5A 72    .Zr   JP    725A       

+736F 7C          |     LD    A,H        

+7370 B5          .     OR    L          

+7371 20 0C        .    JR    NZ,737F    

+7373 EB          .     EX    DE,HL      

+7374 01 05 00    ...   LD    BC,0005    

+7377 3E 1F       >.    LD    A,1F       

+7379 CD A8 28    ..(   CALL  28A8       

+737C 21 00 00    !..   LD    HL,0000    

+737F 22 25 7D    "%}   LD    (7D25),HL  

+7382 E5          .     PUSH  HL         

+7383 11 12 FF    ...   LD    DE,FF12    

+7386 CD 66 6F    .fo   CALL  6F66       

+7389 D1          .     POP   DE         

+738A 67          g     LD    H,A        

+738B 2E 00       ..    LD    L,00       

+738D 22 23 7D    "#}   LD    (7D23),HL  

+7390 E5          .     PUSH  HL         

+7391 01 00 00    ...   LD    BC,0000    

+7394 3E 1F       >.    LD    A,1F       

+7396 CD 7E 28    .~(   CALL  287E       

+7399 E1          .     POP   HL         

+739A 79          y     LD    A,C        

+739B B7          .     OR    A          

+739C 20 02        .    JR    NZ,73A0    

+739E 18 10       ..    JR    73B0       

+73A0 3E 30       >0    LD    A,30       

+73A2 81          .     ADD   C          

+73A3 CD A4 75    ..u   CALL  75A4       

+73A6 C3 D4 70    ..p   JP    70D4       

+73A9 EB          .     EX    DE,HL      

+73AA CD 66 6F    .fo   CALL  6F66       

+73AD 67          g     LD    H,A        

+73AE 2E 00       ..    LD    L,00       

+73B0 22 5C 7B    "\{   LD    (7B5C),HL  

+73B3 21 5E 7B    !^{   LD    HL,7B5E    

+73B6 36 00       6.    LD    (HL),00    

+73B8 3E FF       >.    LD    A,FF       

+73BA 32 54 7B    2T{   LD    (7B54),A   

+73BD C3 5A 72    .Zr   JP    725A       

+73C0 22 6F 7B    "o{   LD    (7B6F),HL  

+73C3 CD F1 79    ..y   CALL  79F1       

+73C6 FE 68       .h    CP    68         

+73C8 28 0C       (.    JR    Z,73D6     

+73CA FE 63       .c    CP    63         

+73CC 28 2D       (-    JR    Z,73FB     

+73CE FE 0D       ..    CP    0D         

+73D0 CA 98 74    ..t   JP    Z,7498     

+73D3 C3 29 71    .)q   JP    7129       

+73D6 CD A4 75    ..u   CALL  75A4       

+73D9 3E 20       >     LD    A,20       

+73DB CD A4 75    ..u   CALL  75A4       

+73DE 11 FA 7C    ..|   LD    DE,7CFA    

+73E1 06 00       ..    LD    B,00       

+73E3 C5          .     PUSH  BC         

+73E4 D5          .     PUSH  DE         

+73E5 CD B2 75    ..u   CALL  75B2       

+73E8 D1          .     POP   DE         

+73E9 C1          .     POP   BC         

+73EA F5          .     PUSH  AF         

+73EB 7D          }     LD    A,L        

+73EC 12          .     LD    (DE),A     

+73ED 13          .     INC   DE         

+73EE 04          .     INC   B          

+73EF F1          .     POP   AF         

+73F0 FE 0D       ..    CP    0D         

+73F2 20 EF        .    JR    NZ,73E3    

+73F4 ED 43 F8 7C .C.|  LD    (7CF8),BC  

+73F8 C3 98 74    ..t   JP    7498       

+73FB CD A4 75    ..u   CALL  75A4       

+73FE 3E 20       >     LD    A,20       

+7400 CD A4 75    ..u   CALL  75A4       

+7403 11 FA 7C    ..|   LD    DE,7CFA    

+7406 06 00       ..    LD    B,00       

+7408 CD F1 79    ..y   CALL  79F1       

+740B CD A4 75    ..u   CALL  75A4       

+740E FE 0D       ..    CP    0D         

+7410 CA F4 73    ..s   JP    Z,73F4     

+7413 12          .     LD    (DE),A     

+7414 13          .     INC   DE         

+7415 04          .     INC   B          

+7416 18 F0       ..    JR    7408       

+7418 2A 5C 7B    *\{   LD    HL,(7B5C)  

+741B 24          $     INC   H          

+741C 2E 00       ..    LD    L,00       

+741E 22 5C 7B    "\{   LD    (7B5C),HL  

+7421 20 04        .    JR    NZ,7427    

+7423 21 5E 7B    !^{   LD    HL,7B5E    

+7426 34          4     INC   (HL)       

+7427 2A 6F 7B    *o{   LD    HL,(7B6F)  

+742A 2B          +     DEC   HL         

+742B 7C          |     LD    A,H        

+742C B5          .     OR    L          

+742D CA 29 71    .)q   JP    Z,7129     

+7430 CD 20 6E    . n   CALL  6E20       

+7433 CD 98 6E    ..n   CALL  6E98       

+7436 38 06       8.    JR    C,743E     

+7438 CD 2A 6E    .*n   CALL  6E2A       

+743B C3 29 71    .)q   JP    7129       

+743E CD 2A 6E    .*n   CALL  6E2A       

+7441 22 6F 7B    "o{   LD    (7B6F),HL  

+7444 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7447 ED 5B 5E 7B .[^{  LD    DE,(7B5E)  

+744B CD 88 78    ..x   CALL  7888       

+744E CD 39 6F    .9o   CALL  6F39       

+7451 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7454 CB 3C       .<    SLR   H          

+7456 CE 00       ..    ADC   A,00       

+7458 67          g     LD    H,A        

+7459 06 00       ..    LD    B,00       

+745B 3E 00       >.    LD    A,00       

+745D 95          .     SUB   L          

+745E 20 02        .    JR    NZ,7462    

+7460 06 01       ..    LD    B,01       

+7462 4F          O     LD    C,A        

+7463 3A FA 7C    :.|   LD    A,(7CFA)   

+7466 ED B1       ..    CPIR             

+7468 C2 18 74    ..t   JP    NZ,7418    

+746B 7D          }     LD    A,L        

+746C 3D          =     DEC   A          

+746D 32 5C 7B    2\{   LD    (7B5C),A   

+7470 ED 4B F8 7C .K.|  LD    BC,(7CF8)  

+7474 05          .     DEC   B          

+7475 28 0E       (.    JR    Z,7485     

+7477 11 FB 7C    ..|   LD    DE,7CFB    

+747A 1A          .     LD    A,(DE)     

+747B BE          .     CP    (HL)       

+747C 20 1A        .    JR    NZ,7498    

+747E 13          .     INC   DE         

+747F 2C          ,     INC   L          

+7480 CC A2 74    ..t   CALL  Z,74A2     

+7483 10 F5       ..    DJNZ  747A       

+7485 3A 54 7B    :T{   LD    A,(7B54)   

+7488 3C          <     INC   A          

+7489 C2 5A 72    .Zr   JP    NZ,725A    

+748C 2A 5C 7B    *\{   LD    HL,(7B5C)  

+748F 01 FA 7C    ..|   LD    BC,7CFA    

+7492 B7          .     OR    A          

+7493 ED 42       .B    SBC   HL,BC      

+7495 C2 5A 72    .Zr   JP    NZ,725A    

+7498 2A 5C 7B    *\{   LD    HL,(7B5C)  

+749B 23          #     INC   HL         

+749C 22 5C 7B    "\{   LD    (7B5C),HL  

+749F C3 44 74    .Dt   JP    7444       

+74A2 D5          .     PUSH  DE         

+74A3 2A 5C 7B    *\{   LD    HL,(7B5C)  

+74A6 24          $     INC   H          

+74A7 CD 88 78    ..x   CALL  7888       

+74AA CD 39 6F    .9o   CALL  6F39       

+74AD 67          g     LD    H,A        

+74AE 2E 00       ..    LD    L,00       

+74B0 D1          .     POP   DE         

+74B1 C9          .     RET              

+74B2 FD 6E 16    .n.   LD    L,(IY+16)  

+74B5 FD 66 17    .f.   LD    H,(IY+17)  

+74B8 23          #     INC   HL         

+74B9 7E          ~     LD    A,(HL)     

+74BA FE 3C       .<    CP    3C         

+74BC 38 02       8.    JR    C,74C0     

+74BE 3E 3C       ><    LD    A,3C       

+74C0 4F          O     LD    C,A        

+74C1 C6 04       ..    ADD   A,04       

+74C3 12          .     LD    (DE),A     

+74C4 13          .     INC   DE         

+74C5 CD 0E 6E    ..n   CALL  6E0E       

+74C8 12          .     LD    (DE),A     

+74C9 13          .     INC   DE         

+74CA 3A 1A 6E    :.n   LD    A,(6E1A)   

+74CD E5          .     PUSH  HL         

+74CE 21 7F 78    !.x   LD    HL,787F    

+74D1 77          w     LD    (HL),A     

+74D2 3E 30       >0    LD    A,30       

+74D4 ED 6F       .o    RLD              

+74D6 FE 3A       .:    CP    3A         

+74D8 38 02       8.    JR    C,74DC     

+74DA C6 07       ..    ADD   A,07       

+74DC 12          .     LD    (DE),A     

+74DD 3E 30       >0    LD    A,30       

+74DF 13          .     INC   DE         

+74E0 ED 6F       .o    RLD              

+74E2 FE 3A       .:    CP    3A         

+74E4 38 02       8.    JR    C,74E8     

+74E6 C6 07       ..    ADD   A,07       

+74E8 12          .     LD    (DE),A     

+74E9 13          .     INC   DE         

+74EA 13          .     INC   DE         

+74EB E1          .     POP   HL         

+74EC 23          #     INC   HL         

+74ED 06 00       ..    LD    B,00       

+74EF ED B0       ..    LDIR             

+74F1 C9          .     RET              

+74F2 21 7B 78    !{x   LD    HL,787B    

+74F5 CD CA 6E    ..n   CALL  6ECA       

+74F8 21 D1 77    !.w   LD    HL,77D1    

+74FB CD CA 6E    ..n   CALL  6ECA       

+74FE 21 6B 7C    !k|   LD    HL,7C6B    

+7501 CD CA 6E    ..n   CALL  6ECA       

+7504 21 1C 6E    !.n   LD    HL,6E1C    

+7507 06 02       ..    LD    B,02       

+7509 CD 2D 75    .-u   CALL  752D       

+750C CD 82 75    ..u   CALL  7582       

+750F 21 14 78    !.x   LD    HL,7814    

+7512 CD CA 6E    ..n   CALL  6ECA       

+7515 2A 92 6F    *.o   LD    HL,(6F92)  

+7518 06 18       ..    LD    B,18       

+751A CD 2D 75    .-u   CALL  752D       

+751D CD 1C 7B    ..{   CALL  7B1C       

+7520 CD BE 79    ..y   CALL  79BE       

+7523 CD 82 75    ..u   CALL  7582       

+7526 21 61 78    !ax   LD    HL,7861    

+7529 CD CA 6E    ..n   CALL  6ECA       

+752C C9          .     RET              

+752D 04          .     INC   B          

+752E 05          .     DEC   B          

+752F C8          .     RET   Z          

+7530 3A 6C 78    :lx   LD    A,(786C)   

+7533 BD          .     CP    L          

+7534 20 0A        .    JR    NZ,7540    

+7536 3E 08       >.    LD    A,08       

+7538 CD A4 75    ..u   CALL  75A4       

+753B 3E 2D       >-    LD    A,2D       

+753D CD A4 75    ..u   CALL  75A4       

+7540 CD 56 75    .Vu   CALL  7556       

+7543 3A 6C 78    :lx   LD    A,(786C)   

+7546 BD          .     CP    L          

+7547 20 04        .    JR    NZ,754D    

+7549 3E 2D       >-    LD    A,2D       

+754B 18 02       ..    JR    754F       

+754D 3E 20       >     LD    A,20       

+754F CD A4 75    ..u   CALL  75A4       

+7552 23          #     INC   HL         

+7553 10 DB       ..    DJNZ  7530       

+7555 C9          .     RET              

+7556 E5          .     PUSH  HL         

+7557 4E          N     LD    C,(HL)     

+7558 21 7F 78    !.x   LD    HL,787F    

+755B 71          q     LD    (HL),C     

+755C D5          .     PUSH  DE         

+755D 3E 30       >0    LD    A,30       

+755F ED 6F       .o    RLD              

+7561 5F          _     LD    E,A        

+7562 FE 3A       .:    CP    3A         

+7564 38 05       8.    JR    C,756B     

+7566 C6 07       ..    ADD   A,07       

+7568 5F          _     LD    E,A        

+7569 3E 30       >0    LD    A,30       

+756B ED 6F       .o    RLD              

+756D 57          W     LD    D,A        

+756E FE 3A       .:    CP    3A         

+7570 38 03       8.    JR    C,7575     

+7572 C6 07       ..    ADD   A,07       

+7574 57          W     LD    D,A        

+7575 ED 53 CF 77 .S.w  LD    (77CF),DE  

+7579 21 CE 77    !.w   LD    HL,77CE    

+757C CD CA 6E    ..n   CALL  6ECA       

+757F D1          .     POP   DE         

+7580 E1          .     POP   HL         

+7581 C9          .     RET              

+7582 3E 4F       >O    LD    A,4F       

+7584 F5          .     PUSH  AF         

+7585 3A F1 6E    :.n   LD    A,(6EF1)   

+7588 CD 85 1E    ...   CALL  1E85       

+758B F1          .     POP   AF         

+758C 90          .     SUB   B          

+758D C8          .     RET   Z          

+758E D8          .     RET   C          

+758F 47          G     LD    B,A        

+7590 3E 20       >     LD    A,20       

+7592 CD A4 75    ..u   CALL  75A4       

+7595 10 F9       ..    DJNZ  7590       

+7597 C9          .     RET              

+7598 46          F     LD    B,(HL)     

+7599 05          .     DEC   B          

+759A 04          .     INC   B          

+759B C8          .     RET   Z          

+759C 23          #     INC   HL         

+759D 7E          ~     LD    A,(HL)     

+759E CD A4 75    ..u   CALL  75A4       

+75A1 10 F9       ..    DJNZ  759C       

+75A3 C9          .     RET              ;---------------------------- 

+75A4 F5          .     PUSH  AF         ; Zeichen in A ausgeben

+75A5 32 6E 78    2nx   LD    (786E),A   

+75A8 E5          .     PUSH  HL         

+75A9 21 6D 78    !mx   LD    HL,786D    

+75AC CD CA 6E    ..n   CALL  6ECA       

+75AF E1          .     POP   HL         

+75B0 F1          .     POP   AF         

+75B1 C9          .     RET              

+75B2 21 00 00    !..   LD    HL,0000    

+75B5 22 6F 78    "ox   LD    (786F),HL  

+75B8 22 71 78    "qx   LD    (7871),HL  

+75BB CD F1 79    ..y   CALL  79F1       

+75BE FE 03       ..    CP    03         

+75C0 CA 28 76    .(v   JP    Z,7628     

+75C3 18 03       ..    JR    75C8       

+75C5 CD F1 79    ..y   CALL  79F1       

+75C8 CD A4 75    ..u   CALL  75A4       ; Zeichen in A ausgeben

+75CB 21 6F 78    !ox   LD    HL,786F    

+75CE FE 3C       .<    CP    3C         

+75D0 28 24       ($    JR    Z,75F6     

+75D2 FE 3E       .>    CP    3E         

+75D4 28 2A       (*    JR    Z,7600     

+75D6 FE 69       .i    CP    69         

+75D8 28 32       (2    JR    Z,760C     

+75DA FE 30       .0    CP    30         

+75DC 38 44       8D    JR    C,7622     

+75DE FE 3A       .:    CP    3A         

+75E0 38 0A       8.    JR    C,75EC     

+75E2 FE 61       .a    CP    61         

+75E4 38 3C       8<    JR    C,7622     

+75E6 FE 67       .g    CP    67         

+75E8 30 38       08    JR    NC,7622    

+75EA C6 D9       ..    ADD   A,D9       

+75EC ED 6F       .o    RLD              

+75EE 23          #     INC   HL         

+75EF ED 6F       .o    RLD              

+75F1 23          #     INC   HL         

+75F2 ED 6F       .o    RLD              

+75F4 18 CF       ..    JR    75C5       

+75F6 CB 26       .&    SLA   (HL)       

+75F8 23          #     INC   HL         

+75F9 CB 16       ..    RL    (HL)       

+75FB 23          #     INC   HL         

+75FC CB 16       ..    RL    (HL)       

+75FE 18 C5       ..    JR    75C5       

+7600 23          #     INC   HL         

+7601 23          #     INC   HL         

+7602 CB 3E       .>    SLR   (HL)       

+7604 2B          +     DEC   HL         

+7605 CB 1E       ..    RR    (HL)       

+7607 2B          +     DEC   HL         

+7608 CB 1E       ..    RR    (HL)       

+760A 18 B9       ..    JR    75C5       

+760C 7E          ~     LD    A,(HL)     

+760D 32 71 78    2qx   LD    (7871),A   

+7610 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7613 CD 8E 76    ..v   CALL  768E       

+7616 22 6F 78    "ox   LD    (786F),HL  

+7619 18 AA       ..    JR    75C5       

+761B 3E 07       >.    LD    A,07       

+761D CD A4 75    ..u   CALL  75A4       

+7620 18 90       ..    JR    75B2       

+7622 CB 81       ..    RES   0,C        

+7624 2A 6F 78    *ox   LD    HL,(786F)  

+7627 C9          .     RET              

+7628 3A 39 7B    :9{   LD    A,(7B39)   

+762B CB 47       .G    BIT   0,A        

+762D 28 EC       (.    JR    Z,761B     

+762F FD E5       ..    PUSH  IY         

+7631 21 78 7C    !x|   LD    HL,7C78    

+7634 CD CA 6E    ..n   CALL  6ECA       

+7637 FD 21 52 7B .!R{  LD    IY,7B52    

+763B 3A 3E 7B    :>{   LD    A,(7B3E)   

+763E 47          G     LD    B,A        

+763F FD 70 00    .p.   LD    (IY+00),B  

+7642 3E 03       >.    LD    A,03       

+7644 CD 93 78    ..x   CALL  7893       

+7647 2A 5C 7B    *\{   LD    HL,(7B5C)  

+764A CD 99 78    ..x   CALL  7899       

+764D ED 5B 5E 7B .[^{  LD    DE,(7B5E)  

+7651 CD F1 79    ..y   CALL  79F1       

+7654 FE 03       ..    CP    03         

+7656 CA A2 76    ..v   JP    Z,76A2     

+7659 FE 0A       ..    CP    0A         

+765B CA C0 76    ..v   JP    Z,76C0     

+765E FE 02       ..    CP    02         

+7660 CA E7 76    ..v   JP    Z,76E7     

+7663 FE 20       .     CP    20         

+7665 CA E7 76    ..v   JP    Z,76E7     

+7668 FE 08       ..    CP    08         

+766A CA 3E 77    .>w   JP    Z,773E     

+766D FE 01       ..    CP    01         

+766F 28 C0       (.    JR    Z,7631     

+7671 FE 30       .0    CP    30         

+7673 38 0E       8.    JR    C,7683     

+7675 FE 3A       .:    CP    3A         

+7677 DA 8F 77    ..w   JP    C,778F     

+767A FE 61       .a    CP    61         

+767C 38 05       8.    JR    C,7683     

+767E FE 67       .g    CP    67         

+7680 DA 8D 77    ..w   JP    C,778D     

+7683 FD E1       ..    POP   IY         

+7685 22 4E 7B    "N{   LD    (7B4E),HL  

+7688 CD 8E 76    ..v   CALL  768E       

+768B CB C1       ..    SET   0,C        

+768D C9          .     RET              

+768E F5          .     PUSH  AF         

+768F E5          .     PUSH  HL         

+7690 CD 88 78    ..x   CALL  7888       

+7693 CD 39 6F    .9o   CALL  6F39       

+7696 E1          .     POP   HL         

+7697 CB 3C       .<    SLR   H          

+7699 CE 00       ..    ADC   A,00       

+769B 67          g     LD    H,A        

+769C 7E          ~     LD    A,(HL)     

+769D 23          #     INC   HL         

+769E 66          f     LD    H,(HL)     

+769F 6F          o     LD    L,A        

+76A0 F1          .     POP   AF         

+76A1 C9          .     RET              

+76A2 3A 3E 7B    :>{   LD    A,(7B3E)   

+76A5 FD BE 00    ...   CP    (IY+00)    

+76A8 28 34       (4    JR    Z,76DE     

+76AA FD 34       .4    INC   (IY+00)    

+76AC 00          .     NOP              

+76AD 3E 03       >.    LD    A,03       

+76AF CD A4 75    ..u   CALL  75A4       

+76B2 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+76B6 B7          .     OR    A          

+76B7 ED 42       .B    SBC   HL,BC      

+76B9 D2 51 76    .Qv   JP    NC,7651    

+76BC 1D          .     DEC   E          

+76BD C3 51 76    .Qv   JP    7651       

+76C0 3E 01       >.    LD    A,01       

+76C2 FD BE 00    ...   CP    (IY+00)    

+76C5 CA DE 76    ..v   JP    Z,76DE     

+76C8 FD 35       .5    DEC   (IY+00)    

+76CA 00          .     NOP              

+76CB 3E 0A       >.    LD    A,0A       

+76CD CD A4 75    ..u   CALL  75A4       

+76D0 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+76D4 B7          .     OR    A          

+76D5 ED 4A       .J    ADC   HL,BC      

+76D7 D2 51 76    .Qv   JP    NC,7651    

+76DA 1C          .     INC   E          

+76DB C3 51 76    .Qv   JP    7651       

+76DE 3E 07       >.    LD    A,07       

+76E0 CD A4 75    ..u   CALL  75A4       

+76E3 3E 0D       >.    LD    A,0D       

+76E5 18 9C       ..    JR    7683       

+76E7 E5          .     PUSH  HL         

+76E8 E5          .     PUSH  HL         

+76E9 D5          .     PUSH  DE         

+76EA CD 88 78    ..x   CALL  7888       

+76ED CD 39 6F    .9o   CALL  6F39       

+76F0 D1          .     POP   DE         

+76F1 E1          .     POP   HL         

+76F2 CB 3C       .<    SLR   H          

+76F4 CE 00       ..    ADC   A,00       

+76F6 67          g     LD    H,A        

+76F7 CD 56 75    .Vu   CALL  7556       

+76FA 3E 20       >     LD    A,20       

+76FC CD A4 75    ..u   CALL  75A4       

+76FF E1          .     POP   HL         

+7700 7D          }     LD    A,L        

+7701 E6 0F       ..    AND   0F         

+7703 FE 0F       ..    CP    0F         

+7705 28 0D       (.    JR    Z,7714     

+7707 23          #     INC   HL         

+7708 FE 07       ..    CP    07         

+770A 20 05        .    JR    NZ,7711    

+770C 3E 20       >     LD    A,20       

+770E CD A4 75    ..u   CALL  75A4       

+7711 C3 51 76    .Qv   JP    7651       

+7714 3E 01       >.    LD    A,01       

+7716 FD BE 00    ...   CP    (IY+00)    

+7719 28 C3       (.    JR    Z,76DE     

+771B FD 35       .5    DEC   (IY+00)    

+771D 00          .     NOP              

+771E E5          .     PUSH  HL         

+771F 21 40 7B    !@{   LD    HL,7B40    

+7722 CD CA 6E    ..n   CALL  6ECA       

+7725 E1          .     POP   HL         

+7726 C5          .     PUSH  BC         

+7727 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+772B 03          .     INC   BC         

+772C 09          .     ADD   HL,BC      

+772D D2 31 77    .1w   JP    NC,7731    

+7730 1C          .     INC   E          

+7731 01 10 00    ...   LD    BC,0010    

+7734 B7          .     OR    A          

+7735 ED 42       .B    SBC   HL,BC      

+7737 30 01       0.    JR    NC,773A    

+7739 1D          .     DEC   E          

+773A C1          .     POP   BC         

+773B C3 51 76    .Qv   JP    7651       

+773E 7D          }     LD    A,L        

+773F E6 0F       ..    AND   0F         

+7741 FE 00       ..    CP    00         

+7743 28 1A       (.    JR    Z,775F     

+7745 2B          +     DEC   HL         

+7746 FE 08       ..    CP    08         

+7748 28 0E       (.    JR    Z,7758     

+774A 3E 08       >.    LD    A,08       

+774C CD A4 75    ..u   CALL  75A4       

+774F CD A4 75    ..u   CALL  75A4       

+7752 CD A4 75    ..u   CALL  75A4       

+7755 C3 51 76    .Qv   JP    7651       

+7758 3E 08       >.    LD    A,08       

+775A CD A4 75    ..u   CALL  75A4       

+775D 18 EB       ..    JR    774A       

+775F 3A 3E 7B    :>{   LD    A,(7B3E)   

+7762 FD BE 00    ...   CP    (IY+00)    

+7765 CA DE 76    ..v   JP    Z,76DE     

+7768 FD 34       .4    INC   (IY+00)    

+776A 00          .     NOP              

+776B E5          .     PUSH  HL         

+776C 3E 03       >.    LD    A,03       

+776E CD A4 75    ..u   CALL  75A4       

+7771 06 2E       ..    LD    B,2E       

+7773 CD 91 78    ..x   CALL  7891       

+7776 E1          .     POP   HL         

+7777 C5          .     PUSH  BC         

+7778 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+777C B7          .     OR    A          

+777D ED 42       .B    SBC   HL,BC      

+777F 30 01       0.    JR    NC,7782    

+7781 1D          .     DEC   E          

+7782 01 0F 00    ...   LD    BC,000F    

+7785 09          .     ADD   HL,BC      

+7786 30 01       0.    JR    NC,7789    

+7788 1C          .     INC   E          

+7789 C1          .     POP   BC         

+778A C3 51 76    .Qv   JP    7651       

+778D C6 D9       ..    ADD   A,D9       

+778F C5          .     PUSH  BC         

+7790 E6 0F       ..    AND   0F         

+7792 87          .     ADD   A          

+7793 87          .     ADD   A          

+7794 87          .     ADD   A          

+7795 87          .     ADD   A          

+7796 47          G     LD    B,A        

+7797 CD F1 79    ..y   CALL  79F1       

+779A FE 3A       .:    CP    3A         

+779C 38 0A       8.    JR    C,77A8     

+779E FE 61       .a    CP    61         

+77A0 38 E7       8.    JR    C,7789     

+77A2 FE 67       .g    CP    67         

+77A4 30 E3       0.    JR    NC,7789    

+77A6 C6 D9       ..    ADD   A,D9       

+77A8 E6 0F       ..    AND   0F         

+77AA B0          .     OR    B          

+77AB C1          .     POP   BC         

+77AC E5          .     PUSH  HL         

+77AD F5          .     PUSH  AF         

+77AE E5          .     PUSH  HL         

+77AF D5          .     PUSH  DE         

+77B0 CD 88 78    ..x   CALL  7888       

+77B3 CD DF 6F    ..o   CALL  6FDF       

+77B6 D1          .     POP   DE         

+77B7 E1          .     POP   HL         

+77B8 CB 3C       .<    SLR   H          

+77BA CE 00       ..    ADC   A,00       

+77BC 67          g     LD    H,A        

+77BD F1          .     POP   AF         

+77BE 77          w     LD    (HL),A     

+77BF CD 56 75    .Vu   CALL  7556       

+77C2 06 02       ..    LD    B,02       

+77C4 3E 08       >.    LD    A,08       

+77C6 CD 93 78    ..x   CALL  7893       

+77C9 E1          .     POP   HL         

+77CA C3 51 76    .Qv   JP    7651       

+77CD 01 02 00    ...   LD    BC,0002    

+77D0 00          .     NOP              

+77D1 00          .     NOP              

+77D2 00          .     NOP              

+77D3 20 20             JR    NZ,77F5    

+77D5 20 20             JR    NZ,77F7    

+77D7 20 FF        .    JR    NZ,77D8    

+77D9 FF          .     RST   38         

+77DA FF          .     RST   38         

+77DB FF          .     RST   38         

+77DC FF          .     RST   38         

+77DD FF          .     RST   38         

+77DE FF          .     RST   38         

+77DF FF          .     RST   38         

+77E0 FF          .     RST   38         

+77E1 FF          .     RST   38         

+77E2 FF          .     RST   38         

+77E3 FF          .     RST   38         

+77E4 FF          .     RST   38         

+77E5 FF          .     RST   38         

+77E6 FF          .     RST   38         

+77E7 FF          .     RST   38         

+77E8 FF          .     RST   38         

+77E9 FF          .     RST   38         

+77EA FF          .     RST   38         

+77EB FF          .     RST   38         

+77EC FF          .     RST   38         

+77ED FF          .     RST   38         

+77EE FF          .     RST   38         

+77EF FF          .     RST   38         

+77F0 FF          .     RST   38         

+77F1 FF          .     RST   38         

+77F2 FF          .     RST   38         

+77F3 FF          .     RST   38         

+77F4 FF          .     RST   38         

+77F5 FF          .     RST   38         

+77F6 FF          .     RST   38         

+77F7 FF          .     RST   38         

+77F8 FF          .     RST   38         

+77F9 FF          .     RST   38         

+77FA FF          .     RST   38         

+77FB FF          .     RST   38         

+77FC FF          .     RST   38         

+77FD FF          .     RST   38         

+77FE FF          .     RST   38         

+77FF FF          .     RST   38         

+7800 FF          .     RST   38         

+7801 FF          .     RST   38         

+7802 FF          .     RST   38         

+7803 FF          .     RST   38         

+7804 FF          .     RST   38         

+7805 FF          .     RST   38         

+7806 FF          .     RST   38         

+7807 FF          .     RST   38         

+7808 FF          .     RST   38         

+7809 FF          .     RST   38         

+780A FF          .     RST   38         

+780B FF          .     RST   38         

+780C FF          .     RST   38         

+780D FF          .     RST   38         

+780E FF          .     RST   38         

+780F FF          .     RST   38         

+7810 FF          .     RST   38         

+7811 FF          .     RST   38         

+7812 FF          .     RST   38         

+7813 FF          .     RST   38         

+7814 4B          K     LD    C,E        

+7815 01 0D 0A    ...   LD    BC,0A0D    

+7818 20 46        F    JR    NZ,7860    

+781A 20 20             JR    NZ,783C    

+781C 41          A     LD    B,C        

+781D 20 20             JR    NZ,783F    

+781F 43          C     LD    B,E        

+7820 20 20             JR    NZ,7842    

+7822 42          B     LD    B,D        

+7823 20 20             JR    NZ,7845    

+7825 45          E     LD    B,L        

+7826 20 20             JR    NZ,7848    

+7828 44          D     LD    B,H        

+7829 20 20             JR    NZ,784B    

+782B 4C          L     LD    C,H        

+782C 20 20             JR    NZ,784E    

+782E 48          H     LD    C,B        

+782F 20 20             JR    NZ,7851    

+7831 46          F     LD    B,(HL)     

+7832 20 20             JR    NZ,7854    

+7834 41          A     LD    B,C        

+7835 20 20             JR    NZ,7857    

+7837 43          C     LD    B,E        

+7838 20 20             JR    NZ,785A    

+783A 42          B     LD    B,D        

+783B 20 20             JR    NZ,785D    

+783D 45          E     LD    B,L        

+783E 20 20             JR    NZ,7860    

+7840 44          D     LD    B,H        

+7841 20 20             JR    NZ,7863    

+7843 4C          L     LD    C,H        

+7844 20 20             JR    NZ,7866    

+7846 48          H     LD    C,B        

+7847 20 20             JR    NZ,7869    

+7849 49          I     LD    C,C        

+784A 58          X     LD    E,B        

+784B 20 20             JR    NZ,786D    

+784D 20 20             JR    NZ,786F    

+784F 53          S     LD    D,E        

+7850 50          P     LD    D,B        

+7851 20 20             JR    NZ,7873    

+7853 20 20             JR    NZ,7875    

+7855 49          I     LD    C,C        

+7856 59          Y     LD    E,C        

+7857 20 20             JR    NZ,7879    

+7859 20 20             JR    NZ,787B    

+785B 50          P     LD    D,B        

+785C 43          C     LD    B,E        

+785D 0D          .     DEC   C          

+785E 0A          .     LD    A,(BC)     

+785F 20 00        .    JR    NZ,7861    

+7861 0A          .     LD    A,(BC)     

+7862 06 16       ..    LD    B,16       

+7864 00          .     NOP              

+7865 0D          .     DEC   C          

+7866 0A          .     LD    A,(BC)     

+7867 69          i     LD    L,C        

+7868 6E          n     LD    L,(HL)     

+7869 66          f     LD    H,(HL)     

+786A 6F          o     LD    L,A        

+786B 3A 00 01    :..   LD    A,(0100)   

+786E 00          .     NOP              

+786F 00          .     NOP              

+7870 00          .     NOP              

+7871 00          .     NOP              

+7872 00          .     NOP              

+7873 00          .     NOP              

+7874 00          .     NOP              

+7875 00          .     NOP              

+7876 00          .     NOP              

+7877 00          .     NOP              

+7878 00          .     NOP              

+7879 00          .     NOP              

+787A 00          .     NOP              

+787B 03          .     INC   BC         

+787C 0A          .     LD    A,(BC)     

+787D 01 0D 00    ...   LD    BC,000D    

+7880 03          .     INC   BC         

+7881 06 16       ..    LD    B,16       

+7883 07          .     RLCA             

+7884 2A 00 00    *..   LD    HL,(0000)  

+7887 C9          .     RET              

+7888 CB 3B       .;    SLR   E          

+788A CB 1C       ..    RR    H          

+788C 3A 54 7B    :T{   LD    A,(7B54)   

+788F 57          W     LD    D,A        

+7890 C9          .     RET              

+7891 3E 02       >.    LD    A,02       

+7893 CD A4 75    ..u   CALL  75A4       

+7896 10 FB       ..    DJNZ  7893       

+7898 C9          .     RET              

+7899 7D          }     LD    A,L        

+789A E6 0F       ..    AND   0F         

+789C C5          .     PUSH  BC         

+789D 47          G     LD    B,A        

+789E CB 17       ..    RL    A          

+78A0 80          .     ADD   B          

+78A1 C6 08       ..    ADD   A,08       

+78A3 FE 20       .     CP    20         

+78A5 38 01       8.    JR    C,78A8     

+78A7 3C          <     INC   A          

+78A8 47          G     LD    B,A        

+78A9 3E 0D       >.    LD    A,0D       

+78AB CD A4 75    ..u   CALL  75A4       

+78AE CD 91 78    ..x   CALL  7891       

+78B1 C1          .     POP   BC         

+78B2 C9          .     RET              ;----- y - Infokommandos

+78B3 E5          .     PUSH  HL         

+78B4 3E 20       >     LD    A,20       

+78B6 CD A4 75    ..u   CALL  75A4       

+78B9 CD F1 79    ..y   CALL  79F1       

+78BC E1          .     POP   HL         

+78BD FE 0D       ..    CP    0D         ; CR zum lernen

+78BF CA 62 72    .br   JP    Z,7262     

+78C2 FE 50       .P    CP    50         ; P neues Passwort

+78C4 CA DC 7A    ..z   JP    Z,7ADC     

+78C7 FE 6C       .l    CP    6C         ; l Lernmodus an

+78C9 CA 86 79    ..y   JP    Z,7986     

+78CC FE 65       .e    CP    65         ; Lernmodus aus

+78CE CA 8F 79    ..y   JP    Z,798F     

+78D1 FE 61       .a    CP    61         ; Ausfuehren (gelerntes)

+78D3 CA B5 79    ..y   JP    Z,79B5     

+78D6 FE 69       .i    CP    69         ; yi = increment beim dump setzen

+78D8 CA 17 79    ..y   JP    Z,7917     

+78DB FE 74       .t    CP    74         ; t Block vom Archiv lesen

+78DD CA 6F 73    .os   JP    Z,736F     

+78E0 FE 66       .f    CP    66         ; yf lernmodus (zuruecksetzen?)

+78E2 CA A4 79    ..y   JP    Z,79A4     

+78E5 FE 62       .b    CP    62         ; b Breakpoint 1

+78E7 CA 1D 79    ..y   JP    Z,791D     

+78EA FE 63       .c    CP    63         ; c Breakpoint 2

+78EC CA 52 79    .Ry   JP    Z,7952     

+78EF FE 77       .w    CP    77         ; w Zum anderen Miniprozess

+78F1 28 03       (.    JR    Z,78F6     

+78F3 C3 29 71    .)q   JP    7129       ; beep

+78F6 7C          |     LD    A,H        

+78F7 B5          .     OR    L          

+78F8 28 03       (.    JR    Z,78FD     

+78FA 22 25 7D    "%}   LD    (7D25),HL  

+78FD ED 5B 25 7D .[%}  LD    DE,(7D25)  

+7901 2A 23 7D    *#}   LD    HL,(7D23)  

+7904 7C          |     LD    A,H        

+7905 3C          <     INC   A          

+7906 CA 29 71    .)q   JP    Z,7129     

+7909 3E 1F       >.    LD    A,1F       

+790B 01 00 00    ...   LD    BC,0000    

+790E CD 81 28    ..(   CALL  2881       

+7911 2A 23 7D    *#}   LD    HL,(7D23)  

+7914 C3 B0 73    ..s   JP    73B0       

+7917 22 3A 7B    ":{   LD    (7B3A),HL  

+791A C3 D4 70    ..p   JP    70D4       

+791D CB 41       .A    BIT   0,C        

+791F CA 25 79    .%y   JP    Z,7925     

+7922 2A 4E 7B    *N{   LD    HL,(7B4E)  

+7925 E5          .     PUSH  HL         

+7926 21 53 7A    !Sz   LD    HL,7A53    

+7929 7E          ~     LD    A,(HL)     

+792A B7          .     OR    A          

+792B CA 37 79    .7y   JP    Z,7937     

+792E ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7932 01 03 00    ...   LD    BC,0003    

+7935 ED B0       ..    LDIR             

+7937 E1          .     POP   HL         

+7938 22 56 7A    "Vz   LD    (7A56),HL  

+793B 11 53 7A    .Sz   LD    DE,7A53    

+793E 01 03 00    ...   LD    BC,0003    

+7941 ED B0       ..    LDIR             

+7943 ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7947 21 50 7A    !Pz   LD    HL,7A50    

+794A 01 03 00    ...   LD    BC,0003    

+794D ED B0       ..    LDIR             

+794F C3 D4 70    ..p   JP    70D4       

+7952 CB 41       .A    BIT   0,C        

+7954 CA 5A 79    .Zy   JP    Z,795A     

+7957 2A 4E 7B    *N{   LD    HL,(7B4E)  

+795A E5          .     PUSH  HL         

+795B ED 5B F1 7A .[.z  LD    DE,(7AF1)  

+795F 21 01 7B    !.{   LD    HL,7B01    

+7962 01 03 00    ...   LD    BC,0003    

+7965 ED B0       ..    LDIR             

+7967 E1          .     POP   HL         

+7968 11 01 7B    ..{   LD    DE,7B01    

+796B 22 F1 7A    ".z   LD    (7AF1),HL  

+796E 01 03 00    ...   LD    BC,0003    

+7971 ED B0       ..    LDIR             

+7973 ED 5B F1 7A .[.z  LD    DE,(7AF1)  

+7977 21 F3 7A    !.z   LD    HL,7AF3    

+797A 01 03 00    ...   LD    BC,0003    

+797D ED B0       ..    LDIR             

+797F ED 53 05 7B .S.{  LD    (7B05),DE  

+7983 C3 D4 70    ..p   JP    70D4       

+7986 21 CE 7C    !.|   LD    HL,7CCE    

+7989 22 97 7C    ".|   LD    (7C97),HL  

+798C C3 D4 70    ..p   JP    70D4       

+798F 2A 97 7C    *.|   LD    HL,(7C97)  

+7992 7C          |     LD    A,H        

+7993 B5          .     OR    L          

+7994 CA 29 71    .)q   JP    Z,7129     

+7997 2B          +     DEC   HL         

+7998 2B          +     DEC   HL         

+7999 36 FF       6.    LD    (HL),FF    

+799B 21 00 00    !..   LD    HL,0000    

+799E 22 97 7C    ".|   LD    (7C97),HL  

+79A1 C3 D4 70    ..p   JP    70D4       

+79A4 2A 99 7C    *.|   LD    HL,(7C99)  

+79A7 7C          |     LD    A,H        

+79A8 B5          .     OR    L          

+79A9 C2 29 71    .)q   JP    NZ,7129    

+79AC 2A 9D 7C    *.|   LD    HL,(7C9D)  

+79AF 22 99 7C    ".|   LD    (7C99),HL  

+79B2 C3 D4 70    ..p   JP    70D4       

+79B5 21 CE 7C    !.|   LD    HL,7CCE    

+79B8 22 99 7C    ".|   LD    (7C99),HL  

+79BB C3 D4 70    ..p   JP    70D4       

+79BE 21 CE 7C    !.|   LD    HL,7CCE    

+79C1 7E          ~     LD    A,(HL)     

+79C2 FE FF       ..    CP    FF         

+79C4 C8          .     RET   Z          

+79C5 E5          .     PUSH  HL         

+79C6 ED 4B 99 7C .K.|  LD    BC,(7C99)  

+79CA 78          x     LD    A,B        

+79CB B1          .     OR    C          

+79CC 20 04        .    JR    NZ,79D2    

+79CE ED 4B 9D 7C .K.|  LD    BC,(7C9D)  

+79D2 B7          .     OR    A          

+79D3 ED 42       .B    SBC   HL,BC      

+79D5 20 06        .    JR    NZ,79DD    

+79D7 21 9F 7C    !.|   LD    HL,7C9F    

+79DA CD CA 6E    ..n   CALL  6ECA       

+79DD E1          .     POP   HL         

+79DE 7E          ~     LD    A,(HL)     

+79DF FE 20       .     CP    20         

+79E1 30 08       0.    JR    NC,79EB    

+79E3 3E 25       >%    LD    A,25       

+79E5 CD A4 75    ..u   CALL  75A4       

+79E8 7E          ~     LD    A,(HL)     

+79E9 C6 40       .@    ADD   A,40       

+79EB CD A4 75    ..u   CALL  75A4       

+79EE 23          #     INC   HL         

+79EF 18 D0       ..    JR    79C1       

+79F1 E5          .     PUSH  HL         

+79F2 2A 99 7C    *.|   LD    HL,(7C99)  

+79F5 7C          |     LD    A,H        

+79F6 B5          .     OR    L          

+79F7 28 16       (.    JR    Z,7A0F     

+79F9 7E          ~     LD    A,(HL)     

+79FA FE FF       ..    CP    FF         

+79FC 20 0B        .    JR    NZ,7A09    

+79FE 21 00 00    !..   LD    HL,0000    

+7A01 22 99 7C    ".|   LD    (7C99),HL  

+7A04 22 9D 7C    ".|   LD    (7C9D),HL  

+7A07 18 06       ..    JR    7A0F       

+7A09 23          #     INC   HL         

+7A0A 22 99 7C    ".|   LD    (7C99),HL  

+7A0D E1          .     POP   HL         

+7A0E C9          .     RET              

+7A0F CD 9E 6E    ..n   CALL  6E9E       

+7A12 F5          .     PUSH  AF         

+7A13 2A 97 7C    *.|   LD    HL,(7C97)  

+7A16 7C          |     LD    A,H        

+7A17 B5          .     OR    L          

+7A18 28 1D       (.    JR    Z,7A37     

+7A1A B7          .     OR    A          

+7A1B 01 F7 7C    ..|   LD    BC,7CF7    

+7A1E ED 42       .B    SBC   HL,BC      

+7A20 38 0C       8.    JR    C,7A2E     

+7A22 21 7C 7C    !||   LD    HL,7C7C    

+7A25 CD CA 6E    ..n   CALL  6ECA       

+7A28 21 00 00    !..   LD    HL,0000    

+7A2B F1          .     POP   AF         

+7A2C 18 04       ..    JR    7A32       

+7A2E F1          .     POP   AF         

+7A2F 09          .     ADD   HL,BC      

+7A30 77          w     LD    (HL),A     

+7A31 23          #     INC   HL         

+7A32 22 97 7C    ".|   LD    (7C97),HL  

+7A35 E1          .     POP   HL         

+7A36 C9          .     RET              

+7A37 F1          .     POP   AF         

+7A38 E1          .     POP   HL         

+7A39 C9          .     RET              

+7A3A E5          .     PUSH  HL         

+7A3B 2B          +     DEC   HL         

+7A3C 4E          N     LD    C,(HL)     

+7A3D 23          #     INC   HL         

+7A3E 06 00       ..    LD    B,00       

+7A40 09          .     ADD   HL,BC      

+7A41 C5          .     PUSH  BC         

+7A42 CD CA 6E    ..n   CALL  6ECA       

+7A45 C1          .     POP   BC         

+7A46 E1          .     POP   HL         

+7A47 41          A     LD    B,C        

+7A48 CD 2D 75    .-u   CALL  752D       

+7A4B 3E 20       >     LD    A,20       

+7A4D C3 A4 75    ..u   JP    75A4       

+7A50 CD 58 7A    .Xz   CALL  7A58       

+7A53 00          .     NOP              

+7A54 00          .     NOP              

+7A55 00          .     NOP              

+7A56 00          .     NOP              

+7A57 00          .     NOP              

+7A58 CD 1F 70    ..p   CALL  701F       

+7A5B 18 04       ..    JR    7A61       

+7A5D 74          t     LD    (HL),H     ; "test"

+7A5E 65          e     LD    H,L        

+7A5F 73          s     LD    (HL),E     

+7A60 74          t     LD    (HL),H     

+7A61 FD E5       ..    PUSH  IY         

+7A63 F5          .     PUSH  AF         

+7A64 FD 21 00 00 .!..  LD    IY,0000    

+7A68 FD 39       .9    ADD   IY,SP      

+7A6A E5          .     PUSH  HL         

+7A6B D5          .     PUSH  DE         

+7A6C C5          .     PUSH  BC         

+7A6D FD 7E 04    .~.   LD    A,(IY+04)  

+7A70 D6 03       ..    SUB   A,03       

+7A72 FD 77 04    .w.   LD    (IY+04),A  

+7A75 30 03       0.    JR    NC,7A7A    

+7A77 FD 35       .5    DEC   (IY+05)    

+7A79 05          .     DEC   B          

+7A7A ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7A7E 21 53 7A    !Sz   LD    HL,7A53    

+7A81 01 03 00    ...   LD    BC,0003    

+7A84 ED B0       ..    LDIR             

+7A86 C1          .     POP   BC         

+7A87 D1          .     POP   DE         

+7A88 E1          .     POP   HL         

+7A89 F1          .     POP   AF         

+7A8A FD E1       ..    POP   IY         

+7A8C C9          .     RET              

+7A8D 21 FA 7C    !.|   LD    HL,7CFA    

+7A90 06 0A       ..    LD    B,0A       

+7A92 CD F1 79    ..y   CALL  79F1       

+7A95 77          w     LD    (HL),A     

+7A96 23          #     INC   HL         

+7A97 FE 0D       ..    CP    0D         

+7A99 28 05       (.    JR    Z,7AA0     

+7A9B 10 F5       ..    DJNZ  7A92       

+7A9D C3 29 71    .)q   JP    7129       

+7AA0 21 FA 7C    !.|   LD    HL,7CFA    

+7AA3 CD B1 7A    ..z   CALL  7AB1       

+7AA6 C2 29 71    .)q   JP    NZ,7129    

+7AA9 3E 01       >.    LD    A,01       

+7AAB 32 18 7D    2.}   LD    (7D18),A   

+7AAE C3 D4 70    ..p   JP    70D4       

+7AB1 E5          .     PUSH  HL         

+7AB2 21 19 7D    !.}   LD    HL,7D19    

+7AB5 11 1A 7D    ..}   LD    DE,7D1A    

+7AB8 01 09 00    ...   LD    BC,0009    

+7ABB 1A          .     LD    A,(DE)     

+7ABC ED A1       ..    CPI              

+7ABE 13          .     INC   DE         

+7ABF 20 05        .    JR    NZ,7AC6    

+7AC1 EA BB 7A    ..z   JP    PE,7ABB    

+7AC4 18 14       ..    JR    7ADA       

+7AC6 D1          .     POP   DE         

+7AC7 21 19 7D    !.}   LD    HL,7D19    

+7ACA 1A          .     LD    A,(DE)     

+7ACB 13          .     INC   DE         

+7ACC FE 0D       ..    CP    0D         

+7ACE 28 06       (.    JR    Z,7AD6     

+7AD0 2F          /     CPL              

+7AD1 ED A1       ..    CPI              

+7AD3 28 F5       (.    JR    Z,7ACA     

+7AD5 C9          .     RET              

+7AD6 2F          /     CPL              

+7AD7 ED A1       ..    CPI              

+7AD9 C9          .     RET              

+7ADA E1          .     POP   HL         

+7ADB C9          .     RET              

+7ADC 21 19 7D    !.}   LD    HL,7D19    

+7ADF 06 0A       ..    LD    B,0A       

+7AE1 CD F1 79    ..y   CALL  79F1       

+7AE4 2F          /     CPL              

+7AE5 77          w     LD    (HL),A     

+7AE6 FE F2       ..    CP    F2         

+7AE8 CA D4 70    ..p   JP    Z,70D4     

+7AEB 23          #     INC   HL         

+7AEC 10 F3       ..    DJNZ  7AE1       

+7AEE C3 29 71    .)q   JP    7129       

+7AF1 01 7B C3    .{.   LD    BC,C37B    

+7AF4 F6 7A       .z    OR    7A         

+7AF6 CD 1F 70    ..p   CALL  701F       

+7AF9 18 06       ..    JR    7B01       

+7AFB 20 74        t    JR    NZ,7B71    ; " test2"

+7AFD 65          e     LD    H,L        

+7AFE 73          s     LD    (HL),E     

+7AFF 74          t     LD    (HL),H     

+7B00 32 21 00    2!.   LD    (0021),A   

+7B03 00          .     NOP              

+7B04 C3 F6 7A    ..z   JP    7AF6       

+7B07 CD 26 7B    .&{   CALL  7B26       

+7B0A E5          .     PUSH  HL         

+7B0B D5          .     PUSH  DE         

+7B0C C5          .     PUSH  BC         

+7B0D F5          .     PUSH  AF         

+7B0E 21 00 00    !..   LD    HL,0000    

+7B11 39          9     ADD   HL,SP      

+7B12 06 08       ..    LD    B,08       

+7B14 CD 2D 75    .-u   CALL  752D       

+7B17 F1          .     POP   AF         

+7B18 C1          .     POP   BC         

+7B19 D1          .     POP   DE         

+7B1A E1          .     POP   HL         

+7B1B C9          .     RET              

+7B1C 3E 0A       >.    LD    A,0A       

+7B1E CD A4 75    ..u   CALL  75A4       

+7B21 3E 0D       >.    LD    A,0D       

+7B23 C3 A4 75    ..u   JP    75A4       

+7B26 C9          .     RET              

+7B27 C9          .     RET              

+7B28 C9          .     RET              

+7B29 C9          .     RET              

+7B2A C9          .     RET              

+7B2B C9          .     RET              

+7B2C C9          .     RET              

+7B2D C9          .     RET              

+7B2E C9          .     RET              

+7B2F C9          .     RET              

+7B30 C9          .     RET              

+7B31 C9          .     RET              

+7B32 C9          .     RET              

+7B33 C9          .     RET              

+7B34 C9          .     RET              

+7B35 C9          .     RET              

+7B36 C9          .     RET              

+7B37 C9          .     RET              

+7B38 C9          .     RET              

+7B39 00          .     NOP              

+7B3A 10 00       ..    DJNZ  7B3C       

+7B3C 00          .     NOP              

+7B3D 00          .     NOP              

+7B3E 00          .     NOP              

+7B3F 00          .     NOP              

+7B40 0A          .     LD    A,(BC)     ; info Dumpueberschrift

+7B41 0A          .     LD    A,(BC)     

+7B42 0D          .     DEC   C          

+7B43 02          .     LD    (BC),A     

+7B44 02          .     LD    (BC),A     

+7B45 02          .     LD    (BC),A     

+7B46 02          .     LD    (BC),A     

+7B47 02          .     LD    (BC),A     

+7B48 02          .     LD    (BC),A     

+7B49 02          .     LD    (BC),A     

+7B4A 02          .     LD    (BC),A     

+7B4B 00          .     NOP              

+7B4C 00          .     NOP              

+7B4D 00          .     NOP              

+7B4E 00          .     NOP              

+7B4F 00          .     NOP              

+7B50 00          .     NOP              

+7B51 00          .     NOP              

+7B52 00          .     NOP              

+7B53 01 FF 05    ...   LD    BC,05FF    

+7B56 64          d     LD    H,H        

+7B57 73          s     LD    (HL),E     

+7B58 69          i     LD    L,C        

+7B59 64          d     LD    H,H        

+7B5A 3D          =     DEC   A          

+7B5B 03          .     INC   BC         

+7B5C 00          .     NOP              

+7B5D 00          .     NOP              

+7B5E 00          .     NOP              

+7B5F 04          .     INC   B          

+7B60 61          a     LD    H,C        

+7B61 64          d     LD    H,H        

+7B62 72          r     LD    (HL),D     

+7B63 3D          =     DEC   A          

+7B64 02          .     LD    (BC),A     

+7B65 00          .     NOP              

+7B66 00          .     NOP              

+7B67 07          .     RLCA             

+7B68 6C          l     LD    L,H        

+7B69 61          a     LD    H,C        

+7B6A 65          e     LD    H,L        

+7B6B 6E          n     LD    L,(HL)     

+7B6C 67          g     LD    H,A        

+7B6D 65          e     LD    H,L        

+7B6E 3D          =     DEC   A          

+7B6F 00          .     NOP              

+7B70 00          .     NOP              

+7B71 00          .     NOP              

+7B72 00          .     NOP              

+7B73 04          .     INC   B          ; Leitblock Ueberschrift

+7B74 06 77       .w    LD    B,77       

+7B76 73          s     LD    (HL),E     

+7B77 74          t     LD    (HL),H     

+7B78 61          a     LD    H,C        

+7B79 74          t     LD    (HL),H     

+7B7A 65          e     LD    H,L        

+7B7B 04          .     INC   B          

+7B7C 01 06 6D    ..m   LD    BC,6D06    

+7B7F 69          i     LD    L,C        

+7B80 6C          l     LD    L,H        

+7B81 6C          l     LD    L,H        

+7B82 69          i     LD    L,C        

+7B83 73          s     LD    (HL),E     

+7B84 05          .     DEC   B          

+7B85 01 06 63    ..c   LD    BC,6306    

+7B88 6F          o     LD    L,A        

+7B89 6D          m     LD    L,L        

+7B8A 66          f     LD    H,(HL)     

+7B8B 6C          l     LD    L,H        

+7B8C 67          g     LD    H,A        

+7B8D 06 01       ..    LD    B,01       

+7B8F 06 72       .r    LD    B,72       

+7B91 73          s     LD    (HL),E     

+7B92 74          t     LD    (HL),H     

+7B93 63          c     LD    H,E        

+7B94 6F          o     LD    L,A        

+7B95 64          d     LD    H,H        

+7B96 07          .     RLCA             

+7B97 01 06 72    ..r   LD    BC,7206    

+7B9A 73          s     LD    (HL),E     

+7B9B 74          t     LD    (HL),H     

+7B9C 66          f     LD    H,(HL)     

+7B9D 6C          l     LD    L,H        

+7B9E 67          g     LD    H,A        

+7B9F 08          .     EX    AF,AF'     

+7BA0 01 06 70    ..p   LD    BC,7006    

+7BA3 72          r     LD    (HL),D     

+7BA4 69          i     LD    L,C        

+7BA5 63          c     LD    H,E        

+7BA6 6E          n     LD    L,(HL)     

+7BA7 74          t     LD    (HL),H     

+7BA8 09          .     ADD   HL,BC      

+7BA9 03          .     INC   BC         

+7BAA 06 69       .i    LD    B,69       

+7BAC 63          c     LD    H,E        

+7BAD 6F          o     LD    L,A        

+7BAE 75          u     LD    (HL),L     

+7BAF 6E          n     LD    L,(HL)     

+7BB0 74          t     LD    (HL),H     

+7BB1 0C          .     INC   C          

+7BB2 02          .     LD    (BC),A     

+7BB3 04          .     INC   B          

+7BB4 6D          m     LD    L,L        

+7BB5 6F          o     LD    L,A        

+7BB6 64          d     LD    H,H        

+7BB7 69          i     LD    L,C        

+7BB8 0E 01       ..    LD    C,01       

+7BBA 04          .     INC   B          

+7BBB 70          p     LD    (HL),B     

+7BBC 62          b     LD    H,D        

+7BBD 61          a     LD    H,C        

+7BBE 73          s     LD    (HL),E     

+7BBF 0F          .     RRCA             

+7BC0 01 03 63    ..c   LD    BC,6303    

+7BC3 38 6B       8k    JR    C,7C30     

+7BC5 10 02       ..    DJNZ  7BC9       

+7BC7 04          .     INC   B          

+7BC8 6C          l     LD    L,H        

+7BC9 62          b     LD    H,D        

+7BCA 61          a     LD    H,C        

+7BCB 73          s     LD    (HL),E     

+7BCC 12          .     LD    (DE),A     

+7BCD 02          .     LD    (BC),A     

+7BCE 04          .     INC   B          

+7BCF 6C          l     LD    L,H        

+7BD0 74          t     LD    (HL),H     

+7BD1 6F          o     LD    L,A        

+7BD2 70          p     LD    (HL),B     

+7BD3 14          .     INC   D          

+7BD4 02          .     LD    (BC),A     

+7BD5 06 6C       .l    LD    B,6C       

+7BD7 73          s     LD    (HL),E     

+7BD8 5F          _     LD    E,A        

+7BD9 74          t     LD    (HL),H     

+7BDA 6F          o     LD    L,A        

+7BDB 70          p     LD    (HL),B     

+7BDC 16 02       ..    LD    D,02       

+7BDE 05          .     DEC   B          

+7BDF 68          h     LD    L,B        

+7BE0 70          p     LD    (HL),B     

+7BE1 74          t     LD    (HL),H     

+7BE2 6F          o     LD    L,A        

+7BE3 70          p     LD    (HL),B     

+7BE4 18 02       ..    JR    7BE8       

+7BE6 04          .     INC   B          

+7BE7 68          h     LD    L,B        

+7BE8 70          p     LD    (HL),B     

+7BE9 76          v     HALT             

+7BEA 31 1A 02    1..   LD    SP,021A    

+7BED 04          .     INC   B          

+7BEE 68          h     LD    L,B        

+7BEF 70          p     LD    (HL),B     

+7BF0 76          v     HALT             

+7BF1 32 1C 01    2..   LD    (011C),A   

+7BF4 06 70       .p    LD    B,70       

+7BF6 72          r     LD    (HL),D     

+7BF7 69          i     LD    L,C        

+7BF8 63          c     LD    H,E        

+7BF9 6C          l     LD    L,H        

+7BFA 6B          k     LD    L,E        

+7BFB 1D          .     DEC   E          

+7BFC 01 04 70    ..p   LD    BC,7004    

+7BFF 72          r     LD    (HL),D     

+7C00 69          i     LD    L,C        

+7C01 76          v     HALT             

+7C02 1E 02       ..    LD    E,02       

+7C04 04          .     INC   B          

+7C05 66          f     LD    H,(HL)     

+7C06 72          r     LD    (HL),D     

+7C07 65          e     LD    H,L        

+7C08 65          e     LD    H,L        

+7C09 20 02        .    JR    NZ,7C0D    

+7C0B 04          .     INC   B          

+7C0C 6C          l     LD    L,H        

+7C0D 69          i     LD    L,C        

+7C0E 6E          n     LD    L,(HL)     

+7C0F 65          e     LD    H,L        

+7C10 22 02 07    "..   LD    (0702),HL  

+7C13 65          e     LD    H,L        

+7C14 72          r     LD    (HL),D     

+7C15 72          r     LD    (HL),D     

+7C16 6C          l     LD    L,H        

+7C17 69          i     LD    L,C        

+7C18 6E          n     LD    L,(HL)     

+7C19 65          e     LD    H,L        

+7C1A 24          $     INC   H          

+7C1B 02          .     LD    (BC),A     

+7C1C 06 65       .e    LD    B,65       

+7C1E 72          r     LD    (HL),D     

+7C1F 72          r     LD    (HL),D     

+7C20 63          c     LD    H,E        

+7C21 6F          o     LD    L,A        

+7C22 64          d     LD    H,H        

+7C23 26 02       &.    LD    H,02       

+7C25 07          .     RLCA             

+7C26 63          c     LD    H,E        

+7C27 68          h     LD    L,B        

+7C28 61          a     LD    H,C        

+7C29 6E          n     LD    L,(HL)     

+7C2A 6E          n     LD    L,(HL)     

+7C2B 65          e     LD    H,L        

+7C2C 6C          l     LD    L,H        

+7C2D 28 02       (.    JR    Z,7C31     

+7C2F 06 63       .c    LD    B,63       

+7C31 68          h     LD    L,B        

+7C32 61          a     LD    H,C        

+7C33 6D          m     LD    L,L        

+7C34 61          a     LD    H,C        

+7C35 70          p     LD    (HL),B     

+7C36 2A 02 04    *..   LD    HL,(0402)  

+7C39 70          p     LD    (HL),B     

+7C3A 72          r     LD    (HL),D     

+7C3B 69          i     LD    L,C        

+7C3C 6F          o     LD    L,A        

+7C3D 2C          ,     INC   L          

+7C3E 02          .     LD    (BC),A     

+7C3F 06 6D       .m    LD    B,6D       

+7C41 73          s     LD    (HL),E     

+7C42 67          g     LD    H,A        

+7C43 63          c     LD    H,E        

+7C44 6F          o     LD    L,A        

+7C45 64          d     LD    H,H        

+7C46 2E 02       ..    LD    L,02       

+7C48 05          .     DEC   B          

+7C49 6D          m     LD    L,L        

+7C4A 73          s     LD    (HL),E     

+7C4B 67          g     LD    H,A        

+7C4C 64          d     LD    H,H        

+7C4D 73          s     LD    (HL),E     

+7C4E 30 04       0.    JR    NC,7C54    

+7C50 06 74       .t    LD    B,74       

+7C52 61          a     LD    H,C        

+7C53 73          s     LD    (HL),E     

+7C54 6B          k     LD    L,E        

+7C55 69          i     LD    L,C        

+7C56 64          d     LD    H,H        

+7C57 34          4     INC   (HL)       

+7C58 04          .     INC   B          

+7C59 06 66       .f    LD    B,66       

+7C5B 72          r     LD    (HL),D     

+7C5C 6F          o     LD    L,A        

+7C5D 6D          m     LD    L,L        

+7C5E 69          i     LD    L,C        

+7C5F 64          d     LD    H,H        

+7C60 38 08       8.    JR    C,7C6A     

+7C62 05          .     DEC   B          

+7C63 63          c     LD    H,E        

+7C64 6C          l     LD    L,H        

+7C65 6F          o     LD    L,A        

+7C66 63          c     LD    H,E        

+7C67 6B          k     LD    L,E        

+7C68 00          .     NOP              

+7C69 00          .     NOP              

+7C6A 00          .     NOP              

+7C6B 0C          .     INC   C          

+7C6C 20 4C        L    JR    NZ,7CBA    ; " LEITBLOCK"

+7C6E 45          E     LD    B,L        

+7C6F 49          I     LD    C,C        

+7C70 54          T     LD    D,H        

+7C71 42          B     LD    B,D        

+7C72 4C          L     LD    C,H        

+7C73 4F          O     LD    C,A        

+7C74 43          C     LD    B,E        

+7C75 4B          K     LD    C,E        

+7C76 20 20             JR    NZ,7C98    

+7C78 03          .     INC   BC         

+7C79 06 17       ..    LD    B,17       

+7C7B 46          F     LD    B,(HL)     

+7C7C 11 20 7A    . z   LD    DE,7A20    ; "zuviel gelernt!"

+7C7F 75          u     LD    (HL),L     

+7C80 76          v     HALT             

+7C81 69          i     LD    L,C        

+7C82 65          e     LD    H,L        

+7C83 6C          l     LD    L,H        

+7C84 20 67        g    JR    NZ,7CED    

+7C86 65          e     LD    H,L        

+7C87 6C          l     LD    L,H        

+7C88 65          e     LD    H,L        

+7C89 72          r     LD    (HL),D     

+7C8A 6E          n     LD    L,(HL)     

+7C8B 74          t     LD    (HL),H     

+7C8C 21 20 FF    ! .   LD    HL,FF20    

+7C8F FF          .     RST   38         

+7C90 FF          .     RST   38         

+7C91 FF          .     RST   38         

+7C92 FF          .     RST   38         

+7C93 FF          .     RST   38         

+7C94 FF          .     RST   38         

+7C95 00          .     NOP              

+7C96 00          .     NOP              

+7C97 00          .     NOP              

+7C98 00          .     NOP              

+7C99 00          .     NOP              

+7C9A 00          .     NOP              

+7C9B 00          .     NOP              

+7C9C 00          .     NOP              

+7C9D 00          .     NOP              

+7C9E 00          .     NOP              

+7C9F 06 20       .     LD    B,20       ; "<**>

+7CA1 3C          <     INC   A          

+7CA2 2A 2A 3E    **>   LD    HL,(3E2A)  

+7CA5 20 15        .    JR    NZ,7CBC    

+7CA7 20 50        P    JR    NZ,7CF9    ; "Paging erforderlich"

+7CA9 61          a     LD    H,C        

+7CAA 67          g     LD    H,A        

+7CAB 69          i     LD    L,C        

+7CAC 6E          n     LD    L,(HL)     

+7CAD 67          g     LD    H,A        

+7CAE 20 65        e    JR    NZ,7D15    

+7CB0 72          r     LD    (HL),D     

+7CB1 66          f     LD    H,(HL)     

+7CB2 6F          o     LD    L,A        

+7CB3 72          r     LD    (HL),D     

+7CB4 64          d     LD    H,H        

+7CB5 65          e     LD    H,L        

+7CB6 72          r     LD    (HL),D     

+7CB7 6C          l     LD    L,H        

+7CB8 69          i     LD    L,C        

+7CB9 63          c     LD    H,E        

+7CBA 68          h     LD    L,B        

+7CBB 20 11        .    JR    NZ,7CCE    

+7CBD 20 4E        N    JR    NZ,7D0D    ; "Nicht im Schatt"

+7CBF 69          i     LD    L,C        

+7CC0 63          c     LD    H,E        

+7CC1 68          h     LD    L,B        

+7CC2 74          t     LD    (HL),H     

+7CC3 20 69        i    JR    NZ,7D2E    

+7CC5 6D          m     LD    L,L        

+7CC6 20 53        S    JR    NZ,7D1B    

+7CC8 63          c     LD    H,E        

+7CC9 68          h     LD    L,B        

+7CCA 61          a     LD    H,C        

+7CCB 74          t     LD    (HL),H     

+7CCC 74          t     LD    (HL),H     

+7CCD 20 FF        .    JR    NZ,7CCE    

+7CCF FF          .     RST   38         

+7CD0 FF          .     RST   38         

+7CD1 FF          .     RST   38         

+7CD2 FF          .     RST   38         

+7CD3 FF          .     RST   38         

+7CD4 FF          .     RST   38         

+7CD5 FF          .     RST   38         

+7CD6 FF          .     RST   38         

+7CD7 FF          .     RST   38         

+7CD8 FF          .     RST   38         

+7CD9 FF          .     RST   38         

+7CDA FF          .     RST   38         

+7CDB FF          .     RST   38         

+7CDC FF          .     RST   38         

+7CDD FF          .     RST   38         

+7CDE FF          .     RST   38         

+7CDF FF          .     RST   38         

+7CE0 FF          .     RST   38         

+7CE1 FF          .     RST   38         

+7CE2 FF          .     RST   38         

+7CE3 FF          .     RST   38         

+7CE4 FF          .     RST   38         

+7CE5 FF          .     RST   38         

+7CE6 FF          .     RST   38         

+7CE7 FF          .     RST   38         

+7CE8 FF          .     RST   38         

+7CE9 FF          .     RST   38         

+7CEA FF          .     RST   38         

+7CEB FF          .     RST   38         

+7CEC FF          .     RST   38         

+7CED FF          .     RST   38         

+7CEE FF          .     RST   38         

+7CEF FF          .     RST   38         

+7CF0 FF          .     RST   38         

+7CF1 FF          .     RST   38         

+7CF2 FF          .     RST   38         

+7CF3 FF          .     RST   38         

+7CF4 FF          .     RST   38         

+7CF5 FF          .     RST   38         

+7CF6 FF          .     RST   38         

+7CF7 FF          .     RST   38         

+7CF8 00          .     NOP              

+7CF9 00          .     NOP              

+7CFA FF          .     RST   38         

+7CFB FF          .     RST   38         

+7CFC FF          .     RST   38         

+7CFD FF          .     RST   38         

+7CFE FF          .     RST   38         

+7CFF FF          .     RST   38         

+7D00 FF          .     RST   38         

+7D01 FF          .     RST   38         

+7D02 FF          .     RST   38         

+7D03 FF          .     RST   38         

+7D04 FF          .     RST   38         

+7D05 FF          .     RST   38         

+7D06 FF          .     RST   38         

+7D07 FF          .     RST   38         

+7D08 FF          .     RST   38         

+7D09 FF          .     RST   38         

+7D0A FF          .     RST   38         

+7D0B FF          .     RST   38         

+7D0C FF          .     RST   38         

+7D0D FF          .     RST   38         

+7D0E FF          .     RST   38         

+7D0F FF          .     RST   38         

+7D10 FF          .     RST   38         

+7D11 FF          .     RST   38         

+7D12 FF          .     RST   38         

+7D13 FF          .     RST   38         

+7D14 FF          .     RST   38         

+7D15 FF          .     RST   38         

+7D16 FF          .     RST   38         

+7D17 FF          .     RST   38         

+7D18 00          .     NOP              

+7D19 FF          .     RST   38         

+7D1A 00          .     NOP              

+7D1B FF          .     RST   38         

+7D1C FF          .     RST   38         

+7D1D FF          .     RST   38         

+7D1E FF          .     RST   38         

+7D1F FF          .     RST   38         

+7D20 FF          .     RST   38         

+7D21 FF          .     RST   38         

+7D22 FF          .     RST   38         

+7D23 FF          .     RST   38         

+7D24 FF          .     RST   38         

+7D25 FF          .     RST   38         

+7D26 FF          .     RST   38         

+7D27 6D          m     LD    L,L        ; "muell   2 (!)"

+7D28 75          u     LD    (HL),L     

+7D29 65          e     LD    H,L        

+7D2A 6C          l     LD    L,H        

+7D2B 6C          l     LD    L,H        

+7D2C 20 20             JR    NZ,7D4E    

+7D2E 20 32        2    JR    NZ,7D62    

+7D30 20 28        (    JR    NZ,7D5A    

+7D32 21 29 CD    !).   LD    HL,CD29    

+7D35 20 6E        n    JR    NZ,7DA5    

+7D37 21 80 18    !..   LD    HL,1880    

+7D3A 3E 01       >.    LD    A,01       

+7D3C 01 80 00    ...   LD    BC,0080    

+7D3F 57          W     LD    D,A        

+7D40 ED B1       ..    CPIR             

+7D42 E2 48 7D    .H}   JP    PO,7D48    

+7D45 14          .     INC   D          

+7D46 18 F8       ..    JR    7D40       

+7D48 42          B     LD    B,D        

+7D49 C5          .     PUSH  BC         

+7D4A CD E2 6D    ..m   CALL  6DE2       

+7D4D C1          .     POP   BC         

+7D4E 10 F9       ..    DJNZ  7D49       

+7D50 CD 2A 6E    .*n   CALL  6E2A       

+7D53 C9          .     RET              

+7D54 50          P     LD    D,B        ; "PROZ MUELL"

+7D55 52          R     LD    D,D        

+7D56 4F          O     LD    C,A        

+7D57 5A          Z     LD    E,D        

+7D58 20 4D        M    JR    NZ,7DA7    

+7D5A 55          U     LD    D,L        

+7D5B 45          E     LD    B,L        

+7D5C 4C          L     LD    C,H        

+7D5D 4C          L     LD    C,H        

+7D5E EE 7D       .}    XOR   7D         

+7D60 C3 5A 81    .Z.   JP    815A       

+7D63 4D          M     LD    C,L        

+7D64 FF          .     RST   38         

+7D65 FF          .     RST   38         

+7D66 FF          .     RST   38         

+7D67 FF          .     RST   38         

+7D68 FF          .     RST   38         

+7D69 FF          .     RST   38         

+7D6A FF          .     RST   38         

+7D6B FF          .     RST   38         

+7D6C FF          .     RST   38         

+7D6D FF          .     RST   38         

+7D6E FF          .     RST   38         

+7D6F FF          .     RST   38         

+7D70 FF          .     RST   38         

+7D71 FF          .     RST   38         

+7D72 FF          .     RST   38         

+7D73 FF          .     RST   38         

+7D74 FF          .     RST   38         

+7D75 FF          .     RST   38         

+7D76 FF          .     RST   38         

+7D77 FF          .     RST   38         

+7D78 FF          .     RST   38         

+7D79 FF          .     RST   38         

+7D7A FF          .     RST   38         

+7D7B FF          .     RST   38         

+7D7C FF          .     RST   38         

+7D7D FF          .     RST   38         

+7D7E FF          .     RST   38         

+7D7F FF          .     RST   38         

+7D80 FF          .     RST   38         

+7D81 FF          .     RST   38         

+7D82 FF          .     RST   38         

+7D83 FF          .     RST   38         

+7D84 FF          .     RST   38         

+7D85 FF          .     RST   38         

+7D86 FF          .     RST   38         

+7D87 FF          .     RST   38         

+7D88 FF          .     RST   38         

+7D89 FF          .     RST   38         

+7D8A FF          .     RST   38         

+7D8B FF          .     RST   38         

+7D8C FF          .     RST   38         

+7D8D FF          .     RST   38         

+7D8E FF          .     RST   38         

+7D8F FF          .     RST   38         

+7D90 FF          .     RST   38         

+7D91 FF          .     RST   38         

+7D92 FF          .     RST   38         

+7D93 FF          .     RST   38         

+7D94 FF          .     RST   38         

+7D95 FF          .     RST   38         

+7D96 FF          .     RST   38         

+7D97 FF          .     RST   38         

+7D98 FF          .     RST   38         

+7D99 FF          .     RST   38         

+7D9A FF          .     RST   38         

+7D9B FF          .     RST   38         

+7D9C FF          .     RST   38         

+7D9D FF          .     RST   38         

+7D9E FF          .     RST   38         

+7D9F FF          .     RST   38         

+7DA0 FF          .     RST   38         

+7DA1 FF          .     RST   38         

+7DA2 FF          .     RST   38         

+7DA3 FF          .     RST   38         

+7DA4 FF          .     RST   38         

+7DA5 FF          .     RST   38         

+7DA6 FF          .     RST   38         

+7DA7 FF          .     RST   38         

+7DA8 FF          .     RST   38         

+7DA9 FF          .     RST   38         

+7DAA FF          .     RST   38         

+7DAB FF          .     RST   38         

+7DAC FF          .     RST   38         

+7DAD FF          .     RST   38         

+7DAE FF          .     RST   38         

+7DAF FF          .     RST   38         

+7DB0 FF          .     RST   38         

+7DB1 FF          .     RST   38         

+7DB2 FF          .     RST   38         

+7DB3 FF          .     RST   38         

+7DB4 FF          .     RST   38         

+7DB5 FF          .     RST   38         

+7DB6 FF          .     RST   38         

+7DB7 FF          .     RST   38         

+7DB8 FF          .     RST   38         

+7DB9 FF          .     RST   38         

+7DBA FF          .     RST   38         

+7DBB FF          .     RST   38         

+7DBC FF          .     RST   38         

+7DBD FF          .     RST   38         

+7DBE FF          .     RST   38         

+7DBF FF          .     RST   38         

+7DC0 FF          .     RST   38         

+7DC1 FF          .     RST   38         

+7DC2 FF          .     RST   38         

+7DC3 FF          .     RST   38         

+7DC4 FF          .     RST   38         

+7DC5 FF          .     RST   38         

+7DC6 FF          .     RST   38         

+7DC7 FF          .     RST   38         

+7DC8 FF          .     RST   38         

+7DC9 FF          .     RST   38         

+7DCA FF          .     RST   38         

+7DCB FF          .     RST   38         

+7DCC FF          .     RST   38         

+7DCD FF          .     RST   38         

+7DCE FF          .     RST   38         

+7DCF FF          .     RST   38         

+7DD0 FF          .     RST   38         

+7DD1 FF          .     RST   38         

+7DD2 FF          .     RST   38         

+7DD3 FF          .     RST   38         

+7DD4 FF          .     RST   38         

+7DD5 FF          .     RST   38         

+7DD6 FF          .     RST   38         

+7DD7 FF          .     RST   38         

+7DD8 FF          .     RST   38         

+7DD9 FF          .     RST   38         

+7DDA FF          .     RST   38         

+7DDB FF          .     RST   38         

+7DDC FF          .     RST   38         

+7DDD FF          .     RST   38         

+7DDE FF          .     RST   38         

+7DDF FF          .     RST   38         

+7DE0 FF          .     RST   38         

+7DE1 FF          .     RST   38         

+7DE2 FF          .     RST   38         

+7DE3 FF          .     RST   38         

+7DE4 FF          .     RST   38         

+7DE5 FF          .     RST   38         

+7DE6 FF          .     RST   38         

+7DE7 FF          .     RST   38         

+7DE8 FF          .     RST   38         

+7DE9 FF          .     RST   38         

+7DEA FF          .     RST   38         

+7DEB FF          .     RST   38         

+7DEC FF          .     RST   38         

+7DED FF          .     RST   38         

+7DEE F0          .     RET   P          

+7DEF 7D          }     LD    A,L        

+7DF0 21 B5 4C    !.L   LD    HL,4CB5    

+7DF3 CB 96       ..    RES   2,(HL)     

+7DF5 CD E2 6D    ..m   CALL  6DE2       

+7DF8 3A 17 82    :..   LD    A,(8217)   ; "musta" Zelle

+7DFB 3D          =     DEC   A          

+7DFC FA F5 7D    ..}   JP    M,7DF5     

+7DFF 21 B5 4C    !.L   LD    HL,4CB5    

+7E02 CB D6       ..    SET   2,(HL)     

+7E04 3C          <     INC   A          

+7E05 CB 57       .W    BIT   2,A        ; shutup

+7E07 20 1E        .    JR    NZ,7E27    

+7E09 CB 4F       .O    BIT   1,A        ; fixpoint

+7E0B 20 1A        .    JR    NZ,7E27    

+7E0D CB 47       .G    BIT   0,A        ; collect garbage

+7E0F C2 FF 7E    ..~   JP    NZ,7EFF    

+7E12 CB 5F       ._    BIT   3,A        ; savesystem

+7E14 C2 7C 80    .|.   JP    NZ,807C    

+7E17 97          .     SUB   A          

+7E18 32 17 82    2..   LD    (8217),A   

+7E1B 18 D3       ..    JR    7DF0       ; Warte bis Anforderung da

+7E1D 3A 17 82    :..   LD    A,(8217)   ; Musta

+7E20 CB 47       .G    BIT   0,A        

+7E22 C2 FF 7E    ..~   JP    NZ,7EFF    

+7E25 18 C9       ..    JR    7DF0       

+7E27 3A 13 57    :.W   LD    A,(5713)   

+7E2A B7          .     OR    A          

+7E2B 20 F0        .    JR    NZ,7E1D    

+7E2D 21 17 82    !..   LD    HL,8217    

+7E30 CB 66       .f    BIT   4,(HL)     

+7E32 CB A6       ..    RES   4,(HL)      

+7E34 20 1E        .    JR    NZ,7E54    

+7E36 CD 88 81    ...   CALL  8188       

+7E39 11 00 00    ...   LD    DE,0000    

+7E3C CD DE 66    ..f   CALL  66DE       

+7E3F CD A4 81    ...   CALL  81A4       

+7E42 54          T     LD    D,H        

+7E43 5D          ]     LD    E,L        

+7E44 01 80 00    ...   LD    BC,0080    

+7E47 21 80 18    !..   LD    HL,1880    

+7E4A ED B0       ..    LDIR             

+7E4C 21 B9 4C    !.L   LD    HL,4CB9    

+7E4F 01 40 00    .@.   LD    BC,0040    

+7E52 ED B0       ..    LDIR             

+7E54 CD 57 60    .W`   CALL  6057       

+7E57 CB 96       ..    RES   2,(HL)     

+7E59 CB EE       ..    SET   5,(HL)     

+7E5B 2C          ,     INC   L          

+7E5C 20 F9        .    JR    NZ,7E57    

+7E5E 21 2B 1E    !+.   LD    HL,1E2B    

+7E61 CD 80 67    ..g   CALL  6780       

+7E64 21 2B 1E    !+.   LD    HL,1E2B    

+7E67 11 18 82    ...   LD    DE,8218    

+7E6A 01 10 00    ...   LD    BC,0010    

+7E6D ED B0       ..    LDIR             

+7E6F CD 51 60    .Q`   CALL  6051       

+7E72 06 64       .d    LD    B,64       

+7E74 CD 20 6E    . n   CALL  6E20       

+7E77 CD E2 6D    ..m   CALL  6DE2       

+7E7A CD 2A 6E    .*n   CALL  6E2A       

+7E7D 10 F5       ..    DJNZ  7E74       

+7E7F CD 57 60    .W`   CALL  6057       

+7E82 CB 6E       .n    BIT   5,(HL)     

+7E84 28 0C       (.    JR    Z,7E92     

+7E86 CB AE       ..    RES   5,(HL)     

+7E88 CB 4E       .N    BIT   1,(HL)     

+7E8A 20 06        .    JR    NZ,7E92    

+7E8C CD 65 5F    .e_   CALL  5F65       

+7E8F CD 34 7D    .4}   CALL  7D34       

+7E92 2C          ,     INC   L          

+7E93 20 ED        .    JR    NZ,7E82    

+7E95 CD 99 5F    .._   CALL  5F99       

+7E98 11 02 00    ...   LD    DE,0002    

+7E9B CD 46 81    .F.   CALL  8146       

+7E9E 57          W     LD    D,A        

+7E9F 1E EF       ..    LD    E,EF       

+7EA1 62          b     LD    H,D        

+7EA2 2E DF       ..    LD    L,DF       

+7EA4 01 E0 00    ...   LD    BC,00E0    

+7EA7 ED B8       ..    LDDR             

+7EA9 1E 00       ..    LD    E,00       

+7EAB 21 18 82    !..   LD    HL,8218    

+7EAE 01 10 00    ...   LD    BC,0010    

+7EB1 ED B0       ..    LDIR             

+7EB3 6A          j     LD    L,D        

+7EB4 CB 3D       .=    SLR   L          

+7EB6 CB FD       ..    SET   7,L        

+7EB8 26 15       &.    LD    H,15       

+7EBA CD 65 5F    .e_   CALL  5F65       

+7EBD 21 17 82    !..   LD    HL,8217    

+7EC0 CB 4E       .N    BIT   1,(HL)     

+7EC2 CB 8E       ..    RES   1,(HL)     

+7EC4 C2 F0 7D    ..}   JP    NZ,7DF0    

+7EC7 CD DF 7E    ..~   CALL  7EDF       

+7ECA 3A AD 60    :.`   LD    A,(60AD)   

+7ECD B7          .     OR    A          

+7ECE 20 06        .    JR    NZ,7ED6    

+7ED0 21 28 82    !(.   LD    HL,8228    

+7ED3 CD CA 6E    ..n   CALL  6ECA       

+7ED6 CD 3B 5A    .;Z   CALL  5A3B       

+7ED9 CD 87 28    ..(   CALL  2887       

+7EDC C3 DC 7E    ..~   JP    7EDC       

+7EDF 11 00 00    ...   LD    DE,0000    

+7EE2 CD 46 81    .F.   CALL  8146       

+7EE5 67          g     LD    H,A        

+7EE6 2E 0D       ..    LD    L,0D       

+7EE8 36 00       6.    LD    (HL),00    

+7EEA 2E 46       .F    LD    L,46       

+7EEC 11 19 7D    ..}   LD    DE,7D19    

+7EEF 01 0A 00    ...   LD    BC,000A    

+7EF2 EB          .     EX    DE,HL      

+7EF3 ED B0       ..    LDIR             

+7EF5 6F          o     LD    L,A        

+7EF6 CB 3D       .=    SLR   L          

+7EF8 CB FD       ..    SET   7,L        

+7EFA 26 15       &.    LD    H,15       

+7EFC C3 65 5F    .e_   JP    5F65       

+7EFF CD 16 54    ..T   CALL  5416       

+7F02 3A 17 82    :..   LD    A,(8217)   ; Musta

+7F05 CB 67       .g    BIT   4,A        

+7F07 20 2B        +    JR    NZ,7F34    

+7F09 ED 4B 10 82 .K..  LD    BC,(8210)  

+7F0D 11 00 00    ...   LD    DE,0000    

+7F10 78          x     LD    A,B        

+7F11 B1          .     OR    C          

+7F12 28 08       (.    JR    Z,7F1C     

+7F14 CD D6 53    ..S   CALL  53D6       

+7F17 13          .     INC   DE         

+7F18 13          .     INC   DE         

+7F19 0B          .     DEC   BC         

+7F1A 18 F4       ..    JR    7F10       

+7F1C 97          .     SUB   A          

+7F1D 32 0C 82    2..   LD    (820C),A   

+7F20 32 0D 82    2..   LD    (820D),A   

+7F23 21 2B 1E    !+.   LD    HL,1E2B    

+7F26 CD B3 7F    ...   CALL  7FB3       

+7F29 3E 01       >.    LD    A,01       

+7F2B 32 0C 82    2..   LD    (820C),A   

+7F2E 3A 13 57    :.W   LD    A,(5713)   

+7F31 B7          .     OR    A          

+7F32 20 17        .    JR    NZ,7F4B    

+7F34 11 02 00    ...   LD    DE,0002    

+7F37 CD 46 81    .F.   CALL  8146       

+7F3A 67          g     LD    H,A        

+7F3B 2E 00       ..    LD    L,00       

+7F3D 11 18 82    ...   LD    DE,8218    

+7F40 01 10 00    ...   LD    BC,0010    

+7F43 ED B0       ..    LDIR             

+7F45 21 18 82    !..   LD    HL,8218    

+7F48 CD B3 7F    ...   CALL  7FB3       

+7F4B CD 34 7D    .4}   CALL  7D34       

+7F4E CD E7 55    ..U   CALL  55E7       

+7F51 30 27       0'    JR    NC,7F7A    

+7F53 EB          .     EX    DE,HL      

+7F54 3A 17 82    :..   LD    A,(8217)   ; Musta

+7F57 CB 67       .g    BIT   4,A        

+7F59 28 50       (P    JR    Z,7FAB     

+7F5B CD B1 81    ...   CALL  81B1       

+7F5E E5          .     PUSH  HL         

+7F5F 6C          l     LD    L,H        

+7F60 26 15       &.    LD    H,15       

+7F62 CB 3D       .=    SLR   L          

+7F64 CB FD       ..    SET   7,L        

+7F66 CB 8E       ..    RES   1,(HL)     

+7F68 E1          .     POP   HL         

+7F69 06 00       ..    LD    B,00       

+7F6B 5E          ^     LD    E,(HL)     

+7F6C 23          #     INC   HL         

+7F6D 56          V     LD    D,(HL)     

+7F6E 14          .     INC   D          

+7F6F 28 04       (.    JR    Z,7F75     

+7F71 15          .     DEC   D          

+7F72 CD 5F 80    ._.   CALL  805F       

+7F75 23          #     INC   HL         

+7F76 10 F3       ..    DJNZ  7F6B       

+7F78 18 D1       ..    JR    7F4B       

+7F7A 3E 01       >.    LD    A,01       

+7F7C 32 0D 82    2..   LD    (820D),A   

+7F7F CD 5C 54    .\T   CALL  545C       

+7F82 21 17 82    !..   LD    HL,8217    

+7F85 CB 86       ..    RES   0,(HL)     

+7F87 CB 66       .f    BIT   4,(HL)     

+7F89 CA F0 7D    ..}   JP    Z,7DF0     

+7F8C 36 01       6.    LD    (HL),01    

+7F8E 11 02 00    ...   LD    DE,0002    

+7F91 CD 46 81    .F.   CALL  8146       

+7F94 57          W     LD    D,A        

+7F95 1E 00       ..    LD    E,00       

+7F97 21 18 82    !..   LD    HL,8218    

+7F9A 01 10 00    ...   LD    BC,0010    

+7F9D ED B0       ..    LDIR             

+7F9F CD 88 81    ...   CALL  8188       

+7FA2 CD 18 53    ..S   CALL  5318       

+7FA5 CD A4 81    ...   CALL  81A4       

+7FA8 C3 FF 7E    ..~   JP    7EFF       

+7FAB CD D6 53    ..S   CALL  53D6       

+7FAE CD B1 81    ...   CALL  81B1       

+7FB1 18 B6       ..    JR    7F69       

+7FB3 06 04       ..    LD    B,04       

+7FB5 0E 10       ..    LD    C,10       

+7FB7 E5          .     PUSH  HL         

+7FB8 C5          .     PUSH  BC         

+7FB9 5E          ^     LD    E,(HL)     

+7FBA 23          #     INC   HL         

+7FBB 56          V     LD    D,(HL)     

+7FBC CD 67 80    .g.   CALL  8067       

+7FBF 69          i     LD    L,C        

+7FC0 CD CC 7F    ...   CALL  7FCC       

+7FC3 C1          .     POP   BC         

+7FC4 0E 00       ..    LD    C,00       

+7FC6 E1          .     POP   HL         

+7FC7 23          #     INC   HL         

+7FC8 23          #     INC   HL         

+7FC9 10 EC       ..    DJNZ  7FB7       

+7FCB C9          .     RET              

+7FCC 14          .     INC   D          

+7FCD C8          .     RET   Z          

+7FCE 15          .     DEC   D          

+7FCF CD 0D 54    ..T   CALL  540D       

+7FD2 D5          .     PUSH  DE         

+7FD3 CD 46 81    .F.   CALL  8146       

+7FD6 67          g     LD    H,A        

+7FD7 CD EA 7F    ...   CALL  7FEA       

+7FDA D1          .     POP   DE         

+7FDB 20 F5        .    JR    NZ,7FD2    

+7FDD D5          .     PUSH  DE         

+7FDE CD 46 81    .F.   CALL  8146       

+7FE1 67          g     LD    H,A        

+7FE2 24          $     INC   H          

+7FE3 CD EA 7F    ...   CALL  7FEA       

+7FE6 D1          .     POP   DE         

+7FE7 20 F4        .    JR    NZ,7FDD    

+7FE9 C9          .     RET              

+7FEA 5E          ^     LD    E,(HL)     

+7FEB 2C          ,     INC   L          

+7FEC 56          V     LD    D,(HL)     

+7FED 14          .     INC   D          

+7FEE 28 22       ("    JR    Z,8012     

+ - Fortsetzung in Datei "eumel0.prt.5" -

diff --git a/system/multiuser/1.7.5/source-disk b/system/multiuser/1.7.5/source-disk
new file mode 100644
index 0000000..e24344a
--- /dev/null
+++ b/system/multiuser/1.7.5/source-disk
@@ -0,0 +1,2 @@
+175_src/source-code-1.7.5m_0.img
+175_src/source-code-1.7.5m_1.img
diff --git a/system/multiuser/1.7.5/src/archive b/system/multiuser/1.7.5/src/archive
new file mode 100644
index 0000000..8027b29
--- /dev/null
+++ b/system/multiuser/1.7.5/src/archive
@@ -0,0 +1,92 @@
+(* ------------------- VERSION 14     06.03.86 ------------------- *)
+PACKET archive DEFINES
+
+               archive ,
+               clear ,
+               release ,
+               format ,
+               check ,
+               reserve :
+
+
+LET clear code      = 18 ,
+    reserve code    = 19 ,
+    free code       = 20 ,
+    check read code = 22 ,
+    format code     = 23 ;
+
+
+TASK PROC archive :
+ 
+  task ("ARCHIVE")
+
+ENDPROC archive ;
+
+PROC archive (TEXT CONST archive name, TASK CONST task) :
+
+  call (reserve code, archive name, task)
+
+ENDPROC archive ;
+
+PROC reserve (TEXT CONST message, TASK CONST task) :
+
+  call (reserve code, message, task)
+
+END PROC reserve;
+
+PROC reserve (TASK CONST task) :
+
+  call(reserve code, "", task)
+
+END PROC reserve;
+
+PROC archive (TEXT CONST archive name, INT CONST station) :
+
+  call (reserve code, archive name, station/ "ARCHIVE")
+
+ENDPROC archive ;
+
+PROC archive (TEXT CONST archive name):
+
+  call (reserve code, archive name, archive)
+
+ENDPROC archive ;
+
+PROC release (TASK CONST task) :
+
+  call (free code, "", task)
+
+ENDPROC release ;
+
+PROC clear (TASK CONST task) :
+
+  call (clear code, "", task)
+
+ENDPROC clear ;
+
+PROC format (TASK CONST task) :
+
+  format (0, task)
+
+ENDPROC format ;
+
+PROC format (INT CONST code, TASK CONST task) :
+
+  call (format code , text (code), task)
+
+ENDPROC format ;
+
+PROC check (TEXT CONST file name, TASK CONST task) :
+
+  call (check read code, file name, task)
+
+ENDPROC check ;
+
+PROC check (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) check, nameset, task)
+
+ENDPROC check ;
+
+ENDPACKET archive ;
+
diff --git a/system/multiuser/1.7.5/src/archive manager b/system/multiuser/1.7.5/src/archive manager
new file mode 100644
index 0000000..c37d2e2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/archive manager
@@ -0,0 +1,670 @@
+(* ------------------- VERSION 10 vom 17.04.86 ------------------- *)
+PACKET archive manager DEFINES                 (* Autor: J.Liedtke*)
+ 
+      archive manager ,
+      provide channel :
+
+
+
+LET std archive channel  = 31 ,
+
+    ack              = 0 ,
+    nak              = 1 ,
+    error nak        = 2 ,
+    second phase ack = 5 ,
+    false code       = 6 ,
+ 
+    fetch code       = 11 ,
+    save code        = 12 ,
+    exists code      = 13 ,
+    erase code       = 14 ,
+    list code        = 15 ,
+    all code         = 17 ,
+    clear code       = 18 ,
+    reserve code     = 19 ,
+    free code        = 20 ,
+    check read code  = 22 ,
+    format code      = 23 ,
+
+    read error       = 92 ,
+ 
+    max files = 200 ,
+ 
+    start of volume = 1000 ,
+    end of volume = 1 ,
+    file header   = 3 , 
+
+    number of header blocks = 2 ,
+ 
+    quote         = """" ,
+    dummy name    = "-" ,
+    dummy date    = "        " ,
+
+ 
+    HEADER = STRUCT (TEXT name, date, INT type, TEXT password) ;
+
+
+BOUND STRUCT (TEXT name, pass) VAR msg ;
+
+INT VAR archive channel := std archive channel ;
+
+TASK VAR archive owner := niltask ,
+         order task ;
+TEXT VAR archive name := "" , write stamp ;
+
+REAL VAR last access time := 0.0 ;
+
+BOOL VAR was already write access ;
+
+
+DATASPACE VAR header space := nilspace ;
+BOUND HEADER VAR header ;
+
+TEXT VAR file name := "" ;
+
+LET invalid   = 0 ,
+    read only = 1 ,
+    valid     = 2 ;
+
+LET accept read errors = TRUE ,
+    ignore read errors = FALSE ;
+
+
+INT VAR directory state := invalid ;
+
+THESAURUS VAR directory ;
+INT VAR dir index ;
+
+INT VAR archive size ;
+
+INT VAR end of volume block ;
+ROW max files INT VAR header block ;
+ROW max files TEXT VAR header date ;
+
+
+ 
+PROC provide channel (INT CONST channel) :
+
+  archive channel := channel
+
+ENDPROC provide channel ;
+
+PROC archive manager :
+
+  archive manager (archive channel)
+
+ENDPROC archive manager ;
+
+PROC archive manager (INT CONST channel) :
+
+  archive channel := channel ;
+  task password ("-") ;
+  global manager 
+     (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) archive manager)
+
+ENDPROC archive manager ;
+
+PROC archive manager (DATASPACE VAR ds, INT CONST order, phase,
+                      TASK CONST task) :
+
+
+  enable stop ;
+  order task := task ;
+  msg := ds ;
+  SELECT order OF
+    CASE fetch code       : fetch file
+    CASE save code        : save file
+    CASE exists code      : exists file
+    CASE erase code       : erase file
+    CASE list code        : list (ds); manager ok (ds)
+    CASE all code         : deliver directory
+    CASE clear code,
+         format code      : clear or format
+    CASE reserve code     : reserve 
+    CASE free code        : free
+    CASE check read code  : check
+    OTHERWISE errorstop (name (myself) + ": unbekannter Auftrag")
+  ENDSELECT .
+
+deliver directory :
+  access archive ;
+  BOUND THESAURUS VAR all names := ds ;
+  all names := directory ;
+  WHILE all names CONTAINS dummy name REP
+    delete (all names, dummy name, dir index)
+  PER ;
+  manager ok (ds) .
+
+clear or format :
+  IF NOT (order task = archive owner)
+    THEN errorstop ("Archiv nicht angemeldet")
+  ELIF phase = 1
+    THEN ask for erase all
+  ELSE   directory state := invalid ;
+         IF order <> clear code
+           THEN format archive (specification) ;
+                archive size := archive blocks
+         FI ;
+         rewind ;
+         write header (archive name, text (clock(1),13,1), start of volume);
+         write end of volume ;
+         manager ok (ds)
+  FI .
+
+ask for erase all :
+  IF order = format code AND specification > 3
+    THEN errorstop ("ungueltiger Format-Code")
+  FI ;
+  look at volume header ;
+  IF header.name <> ""
+    THEN IF order = clear code
+           THEN manager question ("Archiv """+header.name+""" loeschen", order task) 
+           ELSE manager question ("Archiv """+header.name+""" formatieren", order task) 
+         FI 
+    ELSE IF order = clear code
+           THEN manager question ("Archiv initialisieren", order task) 
+           ELSE manager question ("Archiv formatieren", order task)
+         FI
+  FI .
+
+specification :
+  int (msg.name) .
+
+reserve :
+  IF reserve or free permitted
+     THEN continue archive channel;
+          disable stop ;
+          directory state := invalid ;
+          archive owner := order task ;
+          archive name := msg.name ;
+          manager ok (ds)
+     ELSE errorstop ("Archiv wird von Task """+name(archive owner)+""" benutzt")
+  FI .
+
+continue archive channel :
+  continue channel (archive channel) .
+
+free :
+  IF reserve or free permitted 
+    THEN archive owner := niltask ;
+         break (quiet) ;
+         manager ok (ds)
+    ELSE manager message ("Archiv nicht angemeldet", order task)
+  FI.
+
+reserve or free permitted :
+     order task = archive owner OR last access more than five minutes ago
+     OR archive owner = niltask OR NOT
+     (exists (archive owner) OR station (archive owner) <> station (myself)) .
+ 
+last access more than five minutes ago :
+     abs (last access time - clock (1)) > 300.0 .
+
+fetch file :
+  access archive ;
+  access file (msg.name) ;
+  IF no read error remarked
+    THEN disable stop ;
+         fetch (ds, accept read errors) ;
+         IF read error occurred
+           THEN remark read error
+         FI ;
+         enable stop
+    ELSE fetch (ds, ignore read errors)
+  FI ;
+  manager ok (ds) .
+
+no read error remarked :
+  pos (file name, " mit Lesefehler") = 0 .
+
+read error occurred :
+  is error AND error code = read error .
+
+remark read error :
+  dir index := link (directory, file name) ;
+  REP
+    file name CAT " mit Lesefehler" ;
+  UNTIL NOT (directory CONTAINS file name) PER ;
+  IF LENGTH file name < 100
+    THEN rename (directory, dir index, file name)
+  FI .
+
+save file :
+  IF phase = 1
+    THEN access archive ;
+         access file (msg.name) ;
+         IF file in directory
+           THEN manager question (""""+file name +""" ueberschreiben", order task)
+           ELSE send (order task, second phase ack, ds)
+         FI
+    ELSE access archive ;
+         access file (file name) ;
+         erase ;
+         save (ds) ;
+         forget (ds) ;
+         ds := nilspace ;
+         manager ok (ds)
+  FI .
+
+exists file :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN manager ok (ds)
+    ELSE send (order task, false code, ds)
+  FI .
+
+erase file :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN IF phase = 1
+           THEN manager question (""""+file name+""" loeschen", order task)
+           ELSE erase ; manager ok (ds)
+         FI
+    ELSE manager message ("gibt es nicht", order task)
+  FI .
+
+check :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN position to file ;
+         disable stop ;
+         check read ;
+         IF is error
+           THEN clear error; error ("fehlerhaft")
+           ELSE last access time := clock (1) ;
+                manager message ("""" + file name + """ ohne Fehler gelesen", order task)
+         FI
+    ELSE error ("gibt es nicht")
+  FI .
+
+file in directory :  dir index > 0 .
+
+position to file :
+  seek (header block (dir index) + number of header blocks) .
+
+ENDPROC archive manager ;
+
+PROC manager ok (DATASPACE VAR ds) :
+
+  send (order task, ack, ds) ;
+  last access time := clock (1) .
+
+ENDPROC manager ok ;
+
+PROC access archive :
+ 
+  IF NOT (order task = archive owner)
+    THEN errorstop ("Archiv nicht angemeldet")
+  ELIF directory state = invalid
+    THEN open archive
+  ELIF last access more than two seconds ago
+    THEN check volume name ;
+         new open if somebody changed medium
+  FI .
+
+last access more than two seconds ago :
+  abs (clock (1) - last access time) > 2.0 .
+
+new open if somebody changed medium :
+  IF header.date <> write stamp
+    THEN directory state := invalid ;
+         access archive
+  FI .
+
+open archive :
+  directory state := invalid ;
+  check volume name ;
+  write stamp := header.date ;
+  was already write access := FALSE ;
+  read directory ;
+  make directory valid if no read errors occurred .
+
+read directory :
+  directory := empty thesaurus ;
+  rewind ;
+  get next header ;
+  WHILE header.type = file header REP
+    IF directory CONTAINS header.name
+      THEN rename (directory, header.name, dummy name)
+    FI ;
+    insert (directory, header.name, dir index) ;
+    header block (dir index) := end of volume block ;
+    header date (dir index)  := header.date ;
+    get next header ;
+  PER .
+
+make directory valid if no read errors occurred :
+  IF directory state = invalid
+    THEN directory state := valid
+  FI .
+
+ENDPROC access archive ;
+
+PROC access file (TEXT CONST name) :
+
+  file name := name ;
+  dir index := link (directory, file name) .
+
+ENDPROC access file ;
+
+
+PROC check volume name :
+
+  disable stop ;
+  archive size := archive blocks ;
+  read volume header ;
+  IF header.type <> start of volume
+    THEN simulate header (start of volume, "?????")
+  ELIF header.name <> archive name
+    THEN errorstop ("Archiv heisst """ + header.name + """")
+  FI .
+
+read volume header :
+  rewind ;
+  read header ;
+  IF is error AND error code = read error
+    THEN clear error ;
+         simulate header (start of volume, "?????")
+  FI .
+
+ENDPROC check volume name ;
+
+PROC get next header :
+
+  disable stop ;
+  skip dataspace ;
+  IF NOT is error
+    THEN read header
+  FI ;
+  IF is error
+    THEN clear error ;
+         directory state := read only ;
+         search header
+  FI ;
+  end of volume block := block number - number of header blocks .
+
+search header :
+  INT VAR ds pages ;
+  search dataspace (ds pages) ;
+  IF ds pages < 0
+    THEN simulate header (end of volume, "")
+  ELIF NOT is header space
+    THEN simulate header (file header, "????? " + text (block number))
+  FI .
+
+is header space :
+  IF ds pages <> 1
+    THEN FALSE
+    ELSE remember position ;
+         read header ;
+         IF read error occurred
+           THEN clear error; back to old position; FALSE
+         ELIF header format looks ok
+           THEN TRUE
+           ELSE back to old position ; FALSE
+         FI
+  FI .
+
+read error occurred :
+  is error CAND error code = read error .
+
+header format looks ok :
+  header.type = file header OR header.type = end of volume .
+
+remember position :
+  INT CONST old block nr := block number .
+
+back to old position :
+  seek (old block nr) .
+
+ENDPROC get next header ;
+
+PROC fetch (DATASPACE VAR ds, BOOL CONST error accept):
+
+  enable stop ;
+  IF file name <> dummy name
+    THEN fetch from archive
+    ELSE error ("Name unzulaessig")
+  FI .
+
+fetch from archive :
+  IF file in directory
+    THEN position to file ;
+         read (ds, 30000, error accept)
+  ELIF directory state = read only
+    THEN error ("gibt es nicht (oder Lesefehler)")
+    ELSE error ("gibt es nicht")
+  FI .
+
+position to file :
+  seek (header block (dir index) + number of header blocks) .
+
+file in directory :  dir index > 0 .
+ 
+ENDPROC fetch ;
+
+PROC erase :
+
+  IF directory state = read only
+    THEN errorstop ("'save'/'erase' wegen Lesefehler verboten")
+    ELSE update write stamp if first write access ;
+         erase archive
+  FI .
+
+update write stamp if first write access :
+  IF NOT was already write access 
+    THEN rewind ;
+         write stamp := text (clock (1), 13, 1) ;
+         write header (archive name, write stamp, start of volume) ;
+         was already write access := TRUE
+  FI .
+
+erase archive :
+  IF file in directory
+    THEN IF is last file of archive
+           THEN cut off all erased files
+           ELSE rename to dummy
+         FI
+  FI .
+
+file in directory :         dir index > 0 .
+
+is last file of archive :   dir index = highest entry (directory) .
+
+cut off all erased files :
+  directory state := invalid ;
+  REP
+    delete (directory, dir index) ;
+    dir index DECR 1
+  UNTIL dir index = 0 COR name (directory, dir index) <> dummy name PER ;
+  behind last valid file ;
+  write end of volume ;
+  directory state := valid .
+
+behind last valid file :
+  seek (header block (dir index + 1)) ;
+  end of volume block := block number .
+
+rename to dummy :
+    directory state := invalid ;
+    to file header ;
+    read header ;
+    to file header ;
+    header.name := dummy name ;
+    header.date := dummy date ;
+    write (header space) ;
+    rename (directory, file name, dummy name) ;
+    header date (dir index) := dummy date ;
+    directory state := valid .
+
+to file header :
+  seek (header block (dir index)) .
+
+ENDPROC erase ;
+
+PROC save (DATASPACE VAR ds) :
+
+  IF file name <> dummy name
+    THEN save to archive
+    ELSE error ("Name unzulaessig")
+  FI .
+
+save to archive :
+  IF file too large OR highest entry (directory) >= max files
+    THEN error ( "kann nicht geschrieben werden (Archiv voll)")
+    ELSE write new file
+  FI .
+
+file too large :
+  end of volume block + ds pages (ds) + 5 > archive size .
+
+write new file :
+  seek (end of volume block) ;
+  disable stop ;
+  write file (ds) ;
+  IF is error
+    THEN seek (end of volume block)
+    ELSE insert (directory, file name, dir index) ;
+         remember begin of header block ;
+         remember date
+  FI ;
+  write end of volume .
+
+remember begin of header block :
+  header block (dir index) := end of volume block .
+
+remember date :
+  header date (dir index) := date .
+
+ENDPROC save ;
+
+PROC write file (DATASPACE CONST ds) :
+
+  enable stop ;
+  write header (file name, date, file header) ;
+  write (ds) 
+
+ENDPROC write file ;
+
+PROC write end of volume :
+
+  disable stop ;
+  end of volume block := block number ;
+  write header ("", "", end of volume)
+
+ENDPROC write end of volume ;
+
+PROC write header (TEXT CONST name, date, INT CONST header type) :
+
+  forget (header space) ;
+  header space := nilspace ;
+  header := header space ;
+
+  header.name := subtext (name,1,100) ;
+  header.date := date ;
+  header.type := header type ;
+
+  write (header space) 
+
+ENDPROC write header ;
+
+PROC read header :
+
+  IF archive size > 0
+    THEN forget (header space) ;
+         header space := nilspace ;
+         read (header space, 1, accept read errors) ;
+         header := header space
+    ELSE errorstop ("Lesen unmoeglich (Archiv)")
+  FI .
+
+ENDPROC read header ;
+
+PROC simulate header (INT CONST type, TEXT CONST name) :
+
+  forget (header space) ;
+  header space := nilspace ;
+  header := header space ;
+  header.name := name ;
+  header.date := "??.??.??" ;
+  header.type := type ;
+  header.password := ""
+
+ENDPROC simulate header ;
+
+PROC look at volume header :
+
+  rewind ;
+  archive size := archive blocks ;
+  forget (header space) ;
+  header space := nilspace ;
+  INT VAR return code ;
+  read block (header space, 1, 1, return code) ;
+  header := header space ;
+  disable stop ;
+  IF return code <> 0 OR
+     LENGTH header.name < 0 OR LENGTH header.name > 100 OR is error
+    THEN header.name := "" ;
+         clear error
+  FI
+
+ENDPROC look at volume header ;
+
+PROC list (DATASPACE VAR ds) :
+
+  access archive ;
+  open list file ;
+  INT VAR file number := 0 ;
+  get (directory, file name, file number) ;
+  WHILE file number > 0 REP
+    generate list line ;
+    get (directory, file name, file number)
+  PER ;
+  IF directory state = read only
+    THEN putline (list file, "Lesefehler: Evtl. fehlen Eintraege")
+  FI ;
+  write list head .
+
+open list file :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  putline (list file, "") .
+
+generate list line :
+  write (list file, header date (file number)) ;
+  write (list file, text (file blocks DIV 2, 5)) ;
+  write (list file, " K  ") ;
+  IF file name = dummy name
+    THEN write (list file, dummy name)
+    ELSE write (list file, quote) ;
+         write (list file, file name) ;
+         write (list file, quote)
+  FI ;
+  line (list file) .
+
+file blocks :
+  IF file number < highest entry (directory)
+    THEN header block (file number+1) - header block (file number)
+    ELSE end of volume block - header block (file number)
+  FI .
+
+write list head :                                      (* wk 22.08.85 *)
+  headline (list file, archive name +
+            " (" + used + " K belegt von " + text (archive size DIV 2) + " K)") .
+
+used :  text ((end of volume block + 3) DIV 2) .
+
+ENDPROC list ;
+
+PROC error (TEXT CONST error msg) :
+
+  errorstop ("""" + file name + """ " + error msg)
+ 
+ENDPROC error ;
+
+ENDPACKET archive manager ;
+
diff --git a/system/multiuser/1.7.5/src/basic archive b/system/multiuser/1.7.5/src/basic archive
new file mode 100644
index 0000000..8235607
--- /dev/null
+++ b/system/multiuser/1.7.5/src/basic archive
@@ -0,0 +1,401 @@
+(* ------------------- VERSION 11     06.03.86 ------------------- *)
+PACKET basic archive DEFINES 
+
+  archive blocks ,
+  block number ,
+  check read ,
+  format archive ,
+  read block ,
+  read ,
+  rewind ,
+  search dataspace ,
+  seek ,
+  size ,
+  skip dataspace ,
+  write block ,
+  write :
+
+INT VAR blocknr  := 0 ,
+        rerun    := 0 ,
+        page     := -1 ,
+        bit word := 1 ,
+        unreadable sequence length := 0 ;
+INT CONST all ones :=-1 ;
+
+
+DATASPACE VAR label ds ;
+
+LET write normal            = 0 ,
+    archive version         = 1 ,
+    first page stored       = 2 ,
+    dr size                 = 3 ,
+    first bit word          = 4 ,
+(*  write deleted data mark = 64 , *)
+    inconsistent            = 90 ,
+    read error              = 92 ,
+    label size              = 131 ;
+
+BOUND STRUCT (ALIGN dummy for page1,
+              (* Page 2 begins: *)
+              ROW label size INT lab) VAR label;
+
+
+INT PROC block number :
+  block nr
+ENDPROC block number ;
+
+PROC seek (INT CONST block) :
+  block nr := block
+ENDPROC seek ;
+
+PROC rewind :
+  forget (label ds);
+  label ds := nilspace;
+  label := label ds;
+  block nr := 0;
+  rerun := session 
+END PROC rewind; 
+ 
+PROC skip dataspace:
+  check rerun;
+  get label; 
+  IF is error
+    THEN
+  ELIF olivetti
+    THEN block nr INCR label.lab (dr size+1)
+    ELSE block nr INCR label.lab (dr size)
+  FI
+END PROC skip dataspace; 
+ 
+PROC read (DATASPACE VAR ds):
+  read (ds, 30000, FALSE)
+ENDPROC read ;
+
+PROC read (DATASPACE VAR ds, INT CONST max pages, BOOL CONST error accept) :
+  enable stop ;
+  check rerun;
+  get label; 
+  init next page;
+  INT VAR i ;
+  FOR i FROM 1 UPTO max pages REP
+    next page;
+    IF no further page THEN  LEAVE read FI;
+    check storage ;
+    check rerun ;
+    read block ;
+    block nr INCR 1;
+  PER .
+
+read block :
+  disable stop ;
+  get external block (ds, page, block nr) ;
+  ignore read error if no errors accepted ;
+  enable stop .
+
+ignore read error if no errors accepted :
+  IF is error CAND error code = read error CAND NOT error accept
+    THEN clear error
+  FI .
+
+check storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN forget (ds) ;
+         ds := nilspace ;
+         errorstop ("Speicherengpass") ;
+         LEAVE read
+  FI .
+
+check rerun :
+    IF rerun <> session
+      THEN errorstop ("RERUN beim Archiv-Zugriff") ;
+           LEAVE read
+    FI .
+
+END PROC read;
+
+PROC check read :
+
+  enable stop ;
+  get label ;
+  INT VAR pages, i;
+  IF olivetti
+    THEN pages := label.lab (dr size+1)
+    ELSE pages := label.lab (dr size)
+  FI ;
+  FOR i FROM 1 UPTO pages REP
+    get external block (label ds, 2, block nr) ;
+    block nr INCR 1
+  PER .
+
+ENDPROC check read ;
+
+PROC write (DATASPACE CONST ds):
+  enable stop ;
+  check rerun;
+  INT VAR label block nr := block nr;
+  block nr INCR 1;init label;
+  INT VAR page := -1,i;
+  FOR i FROM 1 UPTO ds pages (ds) REP
+    check rerun ;
+    page := next ds page(ds,page);
+    put external block (ds, page, block nr) ;
+    reset archive bit;
+    label.lab(dr size) INCR 1;
+    block nr INCR 1
+  PER;
+  put label.
+
+
+  init label:
+  label.lab(archive version) := 0 ;
+  label.lab(first page stored) := 0 ;
+  label.lab(dr size) := 0;
+  INT VAR j;
+  FOR j FROM first bit word UPTO label size REP
+    label.lab (j) := all ones
+  PER.
+
+  put label:
+  put external block (label ds, 2, label block nr).
+
+  reset archive bit:
+  reset bit (label.lab (page DIV 16+first bit word), page MOD 16).
+
+END PROC write;
+
+PROC get label:
+
+  enable stop ;
+  get external block (label ds, 2, block nr)  ;
+  block nr INCR 1;
+  check label.
+
+check label:
+  IF may be z80 format label OR may be old olivetti format label
+    THEN
+    ELSE errorstop (inconsistent, "Archiv inkonsistent")
+  FI.
+
+may be z80 format label :
+  z80 archive AND label.lab(dr size) > 0 .
+
+may be old olivetti format label :
+  olivetti AND label.lab(first page stored)=0 AND label.lab(dr size+1) > 0 .
+
+END PROC get label; 
+ 
+PROC next page:
+  IF z80 archive 
+  THEN 
+    WHILE labelbits = all ones REP
+      bitword INCR 1;
+      IF bitword >= label size THEN
+      no further page := true; LEAVE next page FI
+    PER;
+    INT VAR p := lowest reset (labelbits);
+    set bit (labelbits, p);
+    page := 16*(bitword-first bit word)+p 
+  ELSE
+    WHILE oli bits = 0 REP 
+      bitword INCR 1; 
+      IF bitword >= labelsize-64 THEN
+      no further page := true; LEAVE next page FI 
+    PER; 
+    p := lowest set (oli bits); 
+    reset bit (olibits, p); 
+    page := 16*(bitword-firstbitword)+p; 
+  FI. 
+ 
+  label bits : label.lab (bitword).
+  oli bits : label.lab (bitword+1). 
+ 
+END PROC next page;
+.
+olivetti : label.lab (archive version) = -1. 
+ 
+z80 archive : label.lab (archive version) = 0. 
+ 
+init next page:
+   BOOL VAR no further page := false;
+   bitword := first bit word.
+
+check rerun :
+    IF rerun <> session
+      THEN errorstop ("RERUN beim Archiv-Zugriff")
+    FI .
+
+PROC get external block (DATASPACE VAR ds, INT CONST page,
+                         INT CONST block nr): 
+
+  INT VAR error ;
+  read block (ds, page, block nr, error) ;
+  SELECT error OF
+    CASE 0: read succeeded
+    CASE 1: error stop ("Lesen unmoeglich (Archiv)")
+    CASE 2: read failed
+    CASE 3: error stop ("Archiv-Ueberlauf") 
+    OTHERWISE error stop ("??? (Archiv)")
+  END SELECT .
+
+read succeeded :
+  unreadable sequence length := 0 .
+
+read failed :
+  unreadable sequence length INCR 1 ;
+  IF unreadable sequence length >= 30
+    THEN errorstop ("30 unlesbare Bloecke hintereinander")
+    ELSE error stop (read error, "Lesefehler (Archiv)")
+  FI .
+
+END PROC get external block; 
+ 
+PROC put external block (DATASPACE CONST ds, INT CONST page, 
+                         INT CONST block nr):
+  INT VAR error;
+  write block (ds, page, write normal, block nr, error) ;
+  SELECT error OF
+    CASE 0: 
+    CASE 1: error stop ("Schreiben unmoeglich (Archiv)")
+    CASE 2: error stop ("Schreibfehler (Archiv)")
+    CASE 3: error stop ("Archiv-Ueberlauf") 
+    OTHERWISE error stop ("??? (Archiv)") 
+  END SELECT .
+
+END PROC put external block;
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code) :
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, 0, block no, return code). 
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 INT CONST mode,
+                 INT CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, mode * 256, block no, return code) .
+
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block;
+ 
+INT PROC size (INT CONST key) :
+
+  INT VAR return code ;
+  control (5, key, 0, return code) ;
+  return code .
+
+ENDPROC size ;
+
+INT PROC archive blocks :
+  size (0)
+ENDPROC archive blocks ;
+
+PROC search dataspace (INT VAR ds pages) :
+
+  disable stop ;
+  ds pages := -1 ;
+  INT CONST last block := archive blocks ;
+ 
+  WHILE block nr < last block REP
+    IF block is dataspace label
+      THEN ds pages := pages counted ;
+           LEAVE search dataspace
+    FI ;
+    block nr INCR 1
+  UNTIL is error PER .
+
+block is dataspace label :
+  look at label block ;
+  IF is error
+    THEN IF error code = read error OR error code = inconsistent
+           THEN clear error
+         FI ;
+         FALSE
+    ELSE count pages ;
+         pages counted = number of pages as label says
+  FI .
+
+look at label block :
+  INT CONST
+  old block nr := block nr ;
+  get label ;
+  block nr := old block nr.
+
+count pages :
+  INT VAR
+  pages counted := 0 ;
+  init next page ;
+  next page ;
+  WHILE NOT no further page REP
+    pages counted INCR 1 ;
+    next page
+  PER .
+
+number of pages as label says :   label.lab (dr size) .
+
+ENDPROC search dataspace ;
+
+PROC format archive (INT CONST format code) :
+
+  IF format is possible
+    THEN format
+    ELSE errorstop ("'format' ist hier nicht implementiert")
+  FI .
+
+format is possible :
+  INT VAR return code ;
+  control (1,0,0, return code) ;
+  bit (return code, 4) .
+
+format :
+  control (7, format code, 0, return code) ;
+  IF return code = 1
+    THEN errorstop ("Formatieren unmoeglich")
+  ELIF return code > 1
+    THEN errorstop ("Schreibfehler (Archiv)")
+  FI .
+
+ENDPROC format archive ;
+
+END PACKET basic archive;
+
diff --git a/system/multiuser/1.7.5/src/canal b/system/multiuser/1.7.5/src/canal
new file mode 100644
index 0000000..ad0baa8
--- /dev/null
+++ b/system/multiuser/1.7.5/src/canal
@@ -0,0 +1,227 @@
+(* ------------------- VERSION 6     20.05.86 ------------------- *)
+PACKET canal DEFINES                           (* Autor: J.Liedtke *)
+ 
+    analyze supervisor command :
+ 
+ 
+
+LET command list =
+ 
+"begin:1.12end:3.0break:4.0continue:5.01halt:7.0
+taskinfo:8.0storageinfo:9.0help:10.0 ",
+
+    supervisor command text =
+
+""6""20""1"ESC ?  -->     help
+"6""21""1"ESC b  -->     begin ("""")
+"6""22""1"ESC c  -->     continue ("""")
+"6""23""1"ESC q  -->     break
+"6""21""50"ESC h  -->     halt
+"6""22""50"ESC s  -->     storage info
+"6""23""50"ESC t  -->     task info
+"6""8""6"gib supervisor kommando :" ,
+
+     text type = 4 ,
+     ack                 = 0 ,
+     error nak           = 2 ,
+     begin code          = 4 ,
+     end code            = 5 ,
+     break code          = 6 ,
+     halt code           = 8 ,
+     password code       = 9 ,
+     continue code       = 100 ,
+
+     home      = ""1"" ;
+
+ 
+TASK VAR sv ;
+
+DATASPACE VAR ds ;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ;
+BOUND TEXT VAR error msg ;
+
+INT VAR command index , number of params , reply ;
+TEXT VAR param 1, param 2 , task password ;
+ 
+
+  lernsequenz auf taste legen ("b", ""1""8""1""12"begin ("""")"8""8""11"") ;
+  lernsequenz auf taste legen ("c", ""1""8""1""12"continue ("""")"8""8""11"") ;
+  lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ;
+  lernsequenz auf taste legen ("h", ""1""8""1""12"halt"13"") ;
+  lernsequenz auf taste legen ("s", ""1""8""1""12"storage info"13"") ;
+  lernsequenz auf taste legen ("t", ""1""8""1""12"task info"13"") ;
+  lernsequenz auf taste legen ("?", ""1""8""1""12"help"13"") ;
+
+PROC analyze supervisor command :
+ 
+  disable stop ;
+  sv := supervisor ;
+  ds := nilspace ;
+  REP
+    command dialogue (TRUE) ;
+    command pre ;
+    cry if not enough storage ;
+    get command (supervisor command text) ;
+    analyze command (command list, text type,
+                     command index, number of params,
+                     param1, param2) ;
+    execute command ;
+  PER .
+
+command pre :
+  IF NOT is error
+    THEN wait for terminal; eumel must advertise
+    ELSE forget (ds) ; ds := nilspace
+  FI .
+
+wait for terminal :
+  out (home) .
+
+cry if not enough storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN out (""7"Speicher Engpass!"13""10"") ;
+  FI .
+
+ENDPROC analyze supervisor command ;
+
+PROC execute command :
+
+  enable stop ;
+  SELECT command index OF
+    CASE  1 : begin ("PUBLIC")
+    CASE  2 : begin (param2)
+    CASE  3 : end via canal
+    CASE  4 : break
+    CASE  5 : quiet
+    CASE  6 : continue (param1)
+    CASE  7 : halt
+    CASE  8 : task info (0); eumel must advertise; quiet
+    CASE  9 : storage info; quiet
+    CASE 10 : help; eumel must advertise; quiet
+    OTHERWISE analyze command error
+  ENDSELECT ;
+  IF reply = error nak
+    THEN error msg := ds ;
+         errorstop (CONCR (error msg))
+  FI .
+ 
+end via canal :
+  IF yes ("Task """ + name (task (channel (myself))) + """ loeschen")
+    THEN eumel must advertise ;
+         call (sv, end code, ds, reply)
+  FI .
+
+break :
+  eumel must advertise ;
+  call (sv, break code, ds, reply) .
+
+halt :
+  call (sv, halt code, ds, reply) .
+
+quiet :
+  call (sv, ack, ds, reply) .
+
+analyze command error :
+  command error ;
+  IF command index = 0
+    THEN errorstop ("kein supervisor kommando")
+  ELIF number of params = 0
+    THEN errorstop ("Taskname fehlt")
+    ELSE errorstop ("Parameter ueberfluessig")
+  FI .
+
+ENDPROC  execute command ;
+ 
+PROC begin (TEXT CONST father name) :
+
+  IF param1 = "-"
+    THEN errorstop ("Name ungueltig")
+  FI ;
+  sv msg := ds ;
+  CONCR (sv msg).tname := param1 ;
+  CONCR (sv msg).tpass := "" ;
+  call (task (father name), begin code, ds, reply) ;
+  IF reply = password code
+    THEN get password ;
+         sv msg := ds ;
+         CONCR (sv msg).tpass := task password ;
+         call (task (father name), begin code, ds, reply) 
+  FI ;
+  IF reply = ack
+    THEN continue (param1)
+  FI .
+
+get password :
+  put ("      Passwort:") ;
+  get secret line (task password) .
+ 
+ENDPROC begin ;
+
+PROC continue (TEXT CONST task name) :
+
+  sv msg := ds ;
+  CONCR (sv msg).tname := task name ;
+  CONCR (sv msg).tpass := "" ;
+  call (sv, continue code + channel, ds, reply) ;
+  IF reply = password code
+    THEN get password ;
+         sv msg := ds ;
+         CONCR (sv msg).tpass := task password ;
+         call (sv, continue code + channel, ds, reply)
+  FI .
+
+get password :
+  put ("      Passwort:") ;
+  get secret line (task password) .
+
+ENDPROC continue ;
+
+PROC help: 
+
+  LET page       = ""1""4"" 
+     ,bell       = ""7"" 
+     ,cr         = ""13""
+     ,end mark   = ""14""
+     ,begin mark = ""15""
+     ,esc        = ""27"" 
+     ;
+
+  REP
+    out (page) ;
+    show page ;
+  UNTIL is quit command PER .
+
+  show page : 
+    putline(begin mark + (31 * ".") + " supervisor help " + (31 * ".") + end mark) ;
+    putline("Hier finden Sie einige Kommandos, die Ihnen den Einstieg ins System er -") ;
+    putline("leichtern sollen:") ;
+    out(""6""05""07"1. Informations-Kommandos") ;
+    out(""6""07""11"storage info        physisch belegten Hintergrundplatz melden") ;
+    out(""6""08""11"task info           Taskbaum zeigen") ;
+    out(""6""14""07"2. Verbindung zum Supervisor") ;
+    out(""6""16""11"break               Task vom Terminal abkoppeln") ;
+    out(""6""17""11"begin(""task"")       neue Task `task` einrichten") ;
+    out(""6""18""11"continue(""task"")    Task `task` an ein Terminal ankoppeln") ;
+    out(""6""21""01"Näheres:     Benutzerhandbuch, Teil 2, Kap. 2") ;
+    out(""6""23""05"Wenn Sie den Hilfe-Modus beenden wollen, tippen Sie die Taste `q`.   ") ;
+    out(cr) .
+
+  is quit command :
+    TEXT VAR char ;
+    get char (char) ;
+    IF char = esc 
+      THEN get char (char)
+    FI;
+    IF char = "q" COR char = "Q"
+      THEN true 
+      ELSE out (bell); 
+           FALSE
+    FI.
+
+END PROC help ;
+
+ENDPACKET canal ;
+
diff --git a/system/multiuser/1.7.5/src/configuration manager b/system/multiuser/1.7.5/src/configuration manager
new file mode 100644
index 0000000..5eaea52
--- /dev/null
+++ b/system/multiuser/1.7.5/src/configuration manager
@@ -0,0 +1,553 @@
+(* ------------------- VERSION 11     02.06.86 ------------------- *)
+PACKET configuration manager DEFINES
+ 
+       configurate ,
+       exec configuration ,
+       setup ,
+       define collector ,
+       configuration manager :
+
+ 
+LET baudrates      = ""1"50"2"75"3"110"4"134.5"5"150"6"300"7"600
+"8"1200"9"1800"10"2400"11"3600"12"4800"13"7200
+"14"9600"15"19200"16"38400"17"",
+    parities       = ""0"no"1"odd"2"even"3"" ,
+    bits per char  = ""0"1"1"2"2"3"3"4"4"5"5"6"6"7"7"8"8"" ,
+    stopbits       = ""0"1"1"1.5"2"2"3"" ,
+    flow modes     = ""0"ohne Protokoll"1"XON/XOFF"2"RTS/CTS
+"3""4""5"XON/XOFF - ausgabeseitig"6"RTS/CTS - ausgabeseitig"7""8"
+"9"XON/XOFF - eingabeseitig"10"RTS/CTS - eingabeseitig"11"" ,
+
+    ok             = "j" ,
+    esc            = ""27"" ,
+    cr             = ""13"" ,
+    right          = ""2"" ,
+
+    psi            = "psi" ,
+    transparent    = "transparent" ,
+
+    std rate          = 14 ,
+    std bits          = 22 ,
+    std flow          = 0 ,
+    std inbuffer size = 16 ,
+
+    device table      = 32000 ,
+
+    max edit terminal      = 15 ,
+    configuration channel  = 32 ,
+
+    fetch code             = 11 ,
+    save  code             = 12 ,
+    erase code             = 14 ,
+    system start interrupt = 100 ,
+
+    CONF = STRUCT (TEXT dev type,
+                   INT baud, bits par stop, flow control, inbuffer size) ;
+ 
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+
+BOUND ROW max edit terminal CONF VAR conf ;
+
+INT VAR channel no ;
+
+TEXT VAR prelude , last feature , answer , collector := "" ;
+
+
+ 
+BOOL PROC shard permits (INT CONST code, key) :
+
+  INT VAR reply ; 
+  IF key > -128
+    THEN control (code, channel no, key, reply)
+    ELSE control (code, channel no, -maxint-1, reply)
+  FI ;
+  reply = 0 . 
+
+ENDPROC shard permits ;
+
+PROC ask user (TEXT CONST feature, question) :
+
+  last feature := feature ;
+  put question ;
+  skip pretyped chars ;
+  get valid answer .
+
+put question :
+  clear line ;
+  out (prelude) ;
+  out (feature) ;
+  out (question) ;
+  out (" (j/n) ") .
+
+clear line :
+  out (cr) ;
+  79 TIMESOUT " " ;
+  out (cr) .
+
+skip pretyped chars :
+  REP UNTIL incharety = "" PER .
+
+get valid answer :
+  REP
+    inchar (answer)
+  UNTIL pos ("jJyYnN"27"", answer) > 0 PER ;
+  IF answer > ""31""
+    THEN out (answer)
+  FI ;
+  out (cr) ;
+  normalize answer .
+
+normalize answer :
+  IF pos ("jJyY", answer) > 0
+    THEN answer := ok
+  FI .
+
+ENDPROC ask user ;
+
+BOOL PROC yes (TEXT CONST question) :
+
+  ask user ("", question) ;
+  answer = ok
+
+ENDPROC yes ;
+
+PROC chose key (INT VAR old key, INT CONST max key, TEXT CONST key string,
+                key entity, BOOL PROC (INT CONST) shard permits):
+
+  IF shard permits at least one standard key
+    THEN try all keys
+  FI .
+
+shard permits at least one standard key :
+  INT VAR key ;
+  FOR key FROM 0 UPTO max key REP
+    IF shard permits (key)
+      THEN LEAVE shard permits at least one standard key WITH TRUE
+    FI
+  PER ;
+  FALSE .
+
+try all keys :
+  key := old key ;
+  REP
+    examine this key ;
+    next key
+  PER .
+
+examine this key :
+  IF shard permits (key) CAND key value <> ""
+    THEN ask user (key value, key entity) ;
+         IF answer = ok
+           THEN chose this key
+         ELIF answer = esc
+           THEN key := -129
+         FI
+  FI .
+
+key value : 
+  IF key >= 0
+    THEN subtext (key string, key pos + 1, next key pos - 1)
+    ELSE text (key)
+  FI .
+
+key pos       : pos (key string, code (key)) .
+next key pos  : pos (key string, code (key+1)) .
+
+chose this key :
+  remember calibration ;
+  old key := key ;
+  LEAVE chose key .
+
+next key :
+  IF key < max key
+    THEN key INCR 1
+    ELSE key := 0
+  FI .
+
+remember calibration :
+  prelude CAT last feature ;
+  prelude CAT ", " .
+
+ENDPROC chose key ;
+
+BOOL PROC rate ok (INT CONST key) :
+
+  shard permits (8, key)
+
+ENDPROC rate ok ;
+
+BOOL PROC bits ok (INT CONST key) :
+
+  IF key < 0
+    THEN shard permits (9, key)
+    ELSE some standard combination ok
+  FI .
+
+some standard combination ok :
+  INT VAR combined := key ;
+  REP
+    IF shard permits (9, combined)
+      THEN LEAVE bits ok WITH TRUE
+    FI ;
+    combined INCR 8
+  UNTIL combined > 127 PER ;
+  FALSE
+
+ENDPROC bits ok ;
+
+BOOL PROC parity ok (INT CONST key) :
+
+  INT VAR combined := 8 * key + data bits ;
+  key >= 0 AND (shard permits (9, combined)      OR
+                shard permits (9, combined + 32) OR
+                shard permits (9, combined + 64)    )
+
+ENDPROC parity ok ;
+
+BOOL PROC stopbits ok (INT CONST key) :
+
+  key >= 0 AND shard permits (9, 32 * key + 8 * parity + data bits)
+
+ENDPROC stopbits ok ;
+
+BOOL PROC flow mode ok (INT CONST key) :
+
+  shard permits (6, key)
+
+ENDPROC flow mode ok ;
+
+
+
+INT VAR data bits ,
+        parity ,
+        stop ;
+
+INT VAR old session := 0 ;
+
+
+TEXT VAR table name, dummy ;
+
+
+PROC configurate :
+
+  new configuration ;
+  access configuration table ;
+  show all device types ;
+  channel no := 1 ;
+  REP
+    IF channel hardware exists
+      THEN try this channel ;
+           setup this channel
+    FI ;
+    channel no INCR 1
+  UNTIL channel no > 15 PER ;
+  prelude := "" ;
+  IF yes ("Koennen unbenutzte Geraetetypen geloescht werden")
+    THEN forget unused device tables
+  FI .
+
+access configuration table :
+  IF exists ("configuration")
+    THEN conf := old ("configuration")
+    ELSE conf := new ("configuration") ;
+         initialize configuration
+  FI .
+
+initialize configuration :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    conf (channel no) :=
+    CONF:(transparent, std rate, std bits, std flow, std inbuffer size)
+  PER ;
+  conf (1).dev type := psi .
+
+show all device types :
+  show prelude ;
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF dataspace is device table
+      THEN show table name
+    FI ;
+    get list entry (table name, dummy)
+  PER ;
+  line (2) .
+
+show prelude :
+  line (30) ;
+  outtext (psi, 1, 20) ;
+  outtext (transparent, 1, 20) .
+
+dataspace is device table :
+  type (old (table name)) = device table .
+
+show table name :
+  outtext (table name, 1, 20) .
+ 
+try this channel :
+  prelude := "Kanal " ;
+  ask user ("", text (channel no)) ;
+  IF answer = ok
+    THEN prelude CAT text (channel no) + ": " ;
+         get configuration from user (conf (channel no)) ;
+         line
+  FI .
+
+channel hardware exists :
+  INT VAR
+  operators channel := channel ;
+  INT VAR channel type ;
+  disable stop ;
+  continue (channel no) ;
+  IF is error
+    THEN IF error message = "kein Kanal"
+           THEN channel type := 0
+           ELSE channel type := inout mask
+         FI
+    ELSE get channel type from shard
+  FI ;
+  clear error ;
+  disable stop ;
+  continue operators channel ; 
+  (channel type AND inout mask) <> 0 .
+
+get channel type from shard :
+  control (1, 0, 0, channel type) .
+
+inout mask : 3 .
+
+forget unused device tables :
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF type (old (table name)) = device table
+      THEN forget if unused
+    FI ;
+    get list entry (table name, dummy)
+  PER .
+
+forget if unused :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    IF conf (channel no).dev type = table name
+      THEN LEAVE forget if unused
+    FI
+  PER ;
+  forget (table name, quiet) .
+
+setup this channel :
+  operators channel := channel ;
+  disable stop ;
+  continue (configuration channel) ;
+  set up channel (channel no, conf (channel no)) ;
+  continue operators channel . 
+
+continue operators channel :
+  continue (operators channel) ;
+  IF is error
+    THEN clear error ;
+         break (quiet) ;
+         LEAVE configurate
+  FI ;
+  enable stop .
+
+ENDPROC configurate ;
+
+PROC get configuration from user (CONF VAR conf) :
+
+  get device type ;
+  get baud rate ;
+  get bits and parity and stopbits ;
+  get protocol ;
+  get buffer size .
+
+
+get device type :
+  begin list ;
+  table name := conf.dev type ;
+  IF NOT is valid device type
+    THEN next device type
+  FI ;
+  REP
+    IF NOT (table name = transparent AND channel no = 1)
+      THEN ask user ("", table name) ;
+           IF answer = ok COR was esc followed by type table name
+             THEN IF is valid device type 
+                    THEN remember device type ;
+                         LEAVE get device type
+                    ELSE out (""7" unbekannter Typ"); pause (20) 
+                  FI
+           FI
+    FI ;
+    next device type
+  PER .
+
+was esc followed by type table name :
+  IF answer = esc
+    THEN 9 TIMESOUT right ;
+         put ("Typ:") ;
+         editget (table name) ;
+         TRUE
+    ELSE FALSE
+  FI .
+
+is valid device type :
+  table name = psi OR table name = transparent OR
+  (exists (table name) CAND type (old (table name)) = device table) .
+
+remember device type :
+  prelude CAT table name ;
+  conf.dev type := table name ;
+  prelude CAT ", " .
+
+next device type :
+  IF table name = psi
+    THEN table name := transparent
+    ELSE IF table name = transparent
+           THEN begin list
+         FI ;
+         search next device type space
+  FI .
+
+search next device type space :
+  REP
+    get list entry (table name, dummy)
+  UNTIL table name = "" COR type (old (table name)) = device table PER;
+  IF table name = ""
+    THEN table name := psi
+  FI .
+
+get baud rate :
+  chose key (conf.baud, 16, baudrates, " Baud", PROC rate ok) .
+
+get bits and parity and stopbits :
+  data bits := conf.bits par stop MOD 8 ;
+  parity := (conf.bits par stop DIV 8) MOD 4 ;
+  stop := (conf.bits par stop DIV 32) MOD 4 ;
+  chose key (data bits, 7, bits per char, " Bits", PROC bits ok) ;
+  IF data bits >= 0
+    THEN chose key (parity, 2, parities, " parity", PROC parity ok) ;
+         chose key (stop, 2, stopbits, " Stopbits", PROC stopbits ok);
+         conf.bits par stop := data bits + 8 * parity + 32 * stop
+    ELSE conf.bits par stop := data bits
+  FI .
+
+get protocol :
+  chose key (conf.flow control, 10, flow modes,
+             "", PROC flow mode ok) .
+
+get buffer size :
+  IF dev type is transparent
+    THEN chose buffer size
+    ELSE conf.inbuffer size := std inbuffer size
+  FI .
+
+dev type is transparent :
+  conf.dev type = "transparent" .
+
+chose buffer size :
+  REP
+    IF conf.inbuffer size = 16 CAND yes ("normaler Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 512 ;
+    IF yes ("grosser Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 16
+  PER .
+
+ENDPROC get configuration from user ;
+
+PROC exec configuration :
+
+  setup
+
+ENDPROC exec configuration ;
+
+PROC setup :
+
+  conf := old ("configuration") ;
+  continue (configuration channel) ;
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    set up channel (channel no, conf (channel no))
+  PER ;
+  set up collector task ;
+  break but do not forget error message if any .
+
+set up collector task :
+  IF collector <> "" CAND collector <> "-" CAND exists task (collector)
+    THEN define collector (task (collector))
+  FI .
+
+break but do not forget error message if any :
+  IF is error
+    THEN dummy := error message ;
+         clear error ;
+         break (quiet) ;
+         errorstop (dummy)
+    ELSE break (quiet)
+  FI .
+
+ENDPROC set up ;
+
+PROC set up channel (INT CONST channel no, CONF CONST conf) :
+
+  link (channel no, conf.dev type) ;
+  baudrate (channel no, conf.baud) ;
+  bits (channel no, conf.bits par stop) ;
+  flow (channel no, conf.flow control) ;
+  input buffer size (channel no, conf.inbuffer size) .
+
+ENDPROC setup channel ;
+
+PROC configuration manager (DATASPACE VAR ds, INT CONST order, phase,
+                            TASK CONST order task) :
+
+  enable stop ;
+  IF order <> system start interrupt
+    THEN font manager
+  FI ;
+  IF session <> old session
+    THEN disable stop ;
+         set up ;
+         clear error ;
+         old session := session ;
+         set autonom
+  FI .
+
+  font manager :
+    IF (order <> save code AND order <> erase code ) OR order task < supervisor
+       THEN delete password if there is one;
+            free manager (ds, order, phase, order task)
+       ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """")
+    FI .
+ 
+  delete password if there is one :
+    IF order >= fetch code AND order <= erase code AND phase = 1
+       THEN msg := ds;
+            msg. write pass := "";
+            msg. read  pass := "";
+    FI .
+ 
+ENDPROC configuration manager ;
+
+PROC configuration manager :
+
+  configurate ;
+  break ;
+  global manager
+  (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST) configuration manager)
+
+ENDPROC configuration manager ;
+
+PROC define collector (TEXT CONST task table name) :
+
+  collector := task table name ;
+  IF exists task (collector)
+    THEN define collector (task (collector))
+  FI
+
+ENDPROC define collector ;
+
+ENDPACKET configuration manager ;
+
diff --git a/system/multiuser/1.7.5/src/eumel printer b/system/multiuser/1.7.5/src/eumel printer
new file mode 100644
index 0000000..94858b5
--- /dev/null
+++ b/system/multiuser/1.7.5/src/eumel printer
@@ -0,0 +1,3066 @@
+PACKET eumel printer                           (* Autor   : Rudolf Ruland *)
+                                               (* Version : 4             *)
+                                               (* Stand   : 05.05.86      *)
+       DEFINES print, 
+               with elan listings,
+               is elan source,
+               bottom label for elan listings,
+               x pos,
+               y pos,
+               y offset index,
+               line type,
+               material,
+               pages printed :
+ 
+
+LET std x wanted                   =  2.54,
+    std y wanted                   =  2.35,
+    std limit                      =  16.0,
+    std pagelength                 =  25.0,
+    std linefeed faktor            =  1.0,
+    std material                   =  "";
+
+LET blank                          =  " ",
+    blank code 1                   =  33,
+    geschuetztes blank             =  ""223"", 
+    keine blankanalyse             =  0,
+    einfach blank                  =  1,
+    doppel blank                   =  2,
+ 
+    anweisungszeichen              =  "#",
+    anweisungszeichen code 1       =  36,
+    geschuetztes anweisungszeichen =  ""222"",
+    druckerkommando zeichen        =  "/",
+    quote                          =  """",
+ 
+    erweiterungs ausgang           =  32767,
+    blank ausgang                  =  32766,
+    anweisungs ausgang             =  32765,
+    d code ausgang                 =  32764,
+    max breite                     =  32763,
+ 
+    punkt                          =  ".",
+ 
+    leer                           =   0,
+
+    kommando token                 =  0,
+    text token                     =  1,
+ 
+    underline linetype             =  1,
+    underline bit                  =  0,
+    bold bit                       =  1,
+    italics bit                    =  2,
+    modifikations liste            =  "ubir",
+    anzahl modifikationen          =  4, 
+ 
+    document                       =  1,
+    page                           =  2,
+ 
+    write text                     =  1,
+    write cmd                      =  2,
+    carriage return                =  3, 
+    move                           =  4,
+    draw                           =  5,
+    on                             =  6, 
+    off                            =  7,
+    type                           =  8,
+ 
+    tag type                       =  1,
+    bold type                      =  2,
+    number type                    =  3,
+    text type                      =  4,
+    delimiter type                 =  6,
+    eof type                       =  7;
+ 
+ 
+INT CONST null ausgang            := -32767-1;
+ 
+ROW anzahl modifikationen INT CONST modifikations werte :=
+                               ROW anzahl modifikationen INT : (1, 2, 4, 8);
+ 
+TEXT CONST anweisungsliste := 
+    "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" +
+    "fillchar:10.1mark:11.2markend:12.0" +
+    "ub:13.0ue:14.0fb:15.0fe:16.0" +
+    "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + 
+    "material:26.1page:27.01pagelength:29.1start:30.2" + 
+    "table:31.0tableend:32.0clearpos:33.01" + 
+    "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" +
+    "textbegin:40.02textend:42.0" +
+    "indentation:43.1ytab:44.1";
+ 
+LET a type             =   1,      a block            =  20,
+    a on               =   2,      a columns          =  21,
+    a off              =   3,      a columnsend       =  22,
+    a center           =   4,      a free             =  23,
+    a right            =   5,      a limit            =  24,
+    a up               =   6,      a linefeed         =  25,
+    a down             =   7,      a material         =  26,
+    a end up or down   =   8,      a page0            =  27,
+    a bsp              =   9,      a page1            =  28,
+    a fill char        =  10,      a pagelength       =  29,
+    a mark             =  11,      a start            =  30,
+    a markend          =  12,      a table            =  31,
+    a ub               =  13,      a tableend         =  32,
+    a ue               =  14,      a clearpos0        =  33,
+    a fb               =  15,      a clearpos1        =  34,
+    a fe               =  16,      a lpos             =  35,
+                                   a rpos             =  36,
+                                   a cpos             =  37,
+                                   a dpos             =  38,
+                                   a bpos             =  39,
+                                   a textbegin0       =  40,
+                                   a textbegin2       =  41,
+                                   a textend          =  42,
+                                   a indentation      =  43,
+                                   a y tab            =  44;
+ 
+INT VAR  a xpos, a breite, a font, a modifikationen,
+         a modifikationen fuer x move, a ypos, aktuelle ypos,
+         letzter font, letzte modifikationen,
+         d ypos, d xpos, d font, d modifikationen, 
+ 
+         zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang,
+         anzahl einrueck blanks, blankbreite,
+         einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite,
+         font durchschuss, fonthoehe, font tiefe,
+         groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe,
+         blankmodus, alter blankmodus,
+         token zeiger, erstes token der zeile, 
+
+         erstes tab token, tab anfang, anzahl blanks, 
+         d code 1, d pitch, fuell zeichen breite, erstes fuell token, 
+         letztes fuell token, 
+ 
+         x size, y size, x wanted, y wanted, x start, y start,
+         pagelength, limit, indentation,
+         left margin, top margin, seitenlaenge,
+         papierlaenge, papierbreite,
+         luecke, anzahl spalten, aktuelle spalte,
+
+         verschiebung, rest, neue modifikationen, modifikations modus, pass,
+ 
+         int param, anweisungs index, anzahl params, index,
+ 
+         gedruckte seiten;
+ 
+BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile,
+         zeile muss geblockt werden, rechts, a block token, offsets,
+         tabellen modus, block modus, center modus, right modus,
+         seite ist offen, vor erster seite;
+ 
+REAL VAR linefeed faktor, real param;
+ 
+TEXT VAR zeile, anweisung, par1, par2, material wert, replacements,
+         fuell zeichen, d string, font offsets;
+ 
+ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler;
+ 
+INITFLAG VAR in dieser task := FALSE;
+ 
+. zeile ist zu ende               : zeilenpos > zeilen laenge
+ 
+. zeilen breite                   : a xpos - left margin
+ 
+. neue zeilenhoehe                : int (linefeed faktor * real (fonthoehe) + 0.5)
+ 
+. naechstes zeichen ist blank     : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0
+ 
+. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos)
+ 
+. in letzter spalte               : aktuelle spalte >= anzahl spalten
+ 
+. anfangs blankmodus :
+    INT VAR dummy;
+    IF   center modus OR right modus
+         THEN dummy
+    ELIF index zaehler = 0
+         THEN blankmodus
+         ELSE alter blankmodus
+    FI
+ 
+. initialisiere tab variablen : 
+    erstes tab token := token index f + 1;
+    tab anfang       := zeilen breite;
+    anzahl blanks    := 0;
+.;
+ 
+(******************************************************************)
+ 
+LET zeilen nr laenge  =  4,
+    teil einrueckung  =  5,
+ 
+    headline pre  = "Zeile    ****   E L A N    EUMEL 1.7.5  ****   ",
+    headline post = "   ****    ";
+ 
+INT  VAR zeilen nr, rest auf seite,
+         max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name,
+         symbol type, naechster symbol type;
+ 
+BOOL VAR vor erstem packet, innerhalb der define liste;
+ 
+TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile;
+ 
+ 
+. symbol           : fuell zeichen
+. naechstes symbol : d string
+. elan text        : d token. text
+.; 
+ 
+(******************************************************************)
+(*** tokenspeicher                                              ***)
+
+LET max token  = 3000,
+    max ypos   = 1000,
+ 
+    TOKEN      = STRUCT (TEXT text,
+                         INT  xpos, breite, font, modifikationen,
+                              modifikationen fuer x move, 
+                              offset index, naechster token index, 
+                         BOOL block token ),
+
+    YPOS       = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index,
+                             erster token index, letzter token index ), 
+ 
+    TOKENLISTE = STRUCT (ROW max token TOKEN token liste,
+                         ROW max ypos  YPOS  ypos  liste );
+ 
+DATASPACE VAR ds;
+ 
+BOUND TOKENLISTE VAR tokenspeicher;
+ 
+TOKEN VAR d token, offset token;
+ 
+INT VAR erster ypos index a, letzter ypos index a, 
+        erster ypos index d, letzter ypos index d, 
+        ypos  index, ypos  index f, ypos  index a, ypos  index d, 
+        token index, token index f;
+ 
+. t  : tokenspeicher. token liste (token index)
+. tf : tokenspeicher. token liste (token index f)
+ 
+. y  : tokenspeicher. ypos  liste (ypos  index) 
+. yf : tokenspeicher. ypos  liste (ypos  index f) 
+. ya : tokenspeicher. ypos  liste (ypos  index a)
+. yd : tokenspeicher. ypos  liste (ypos  index d)
+ 
+. loesche druckspeicher :
+    erster ypos index d := 0;
+           ypos index f := 0;
+          token index f := 0;
+ 
+. druckspeicher ist nicht leer :
+    erster ypos index d <> 0
+ 
+. loesche analysespeicher :
+    erster ypos index a := 0;
+ 
+. analysespeicher ist nicht leer :
+    erster ypos index a <> 0
+.; 
+ 
+(******************************************************************)
+(*** anweisungsspeicher                                         ***)
+ 
+INT  VAR anweisungszaehler;
+TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger;
+THESAURUS VAR params1, params2; 
+ 
+PROC loesche anweisungsspeicher :
+ 
+    anweisungs zaehler := 0;
+    anweisungs indizes := "";
+    params1 zeiger     := "";
+    params2 zeiger     := "";
+    params1            := empty thesaurus;
+    params2            := empty thesaurus;
+ 
+END PROC loesche anweisungsspeicher; 
+ 
+(******************************************************************)
+(*** indexspeicher                                              ***)
+ 
+INT  VAR index zaehler;
+TEXT VAR grosse fonts, verschiebungen;
+
+PROC loesche indexspeicher :
+ 
+    index zaehler  := 0;
+    grosse fonts   := "";
+    verschiebungen := "";
+ 
+END PROC loesche indexspeicher; 
+ 
+ 
+(******************************************************************)
+(*** tabellenspeicher                                           ***)
+ 
+LET max tabs          =  30,
+    TABELLENEINTRAG   =  STRUCT (INT tab typ, tab position, tab param);
+
+TEXT VAR tab liste, fill char;
+THESAURUS VAR d strings;
+ROW max tabs TABELLENEINTRAG VAR tabspeicher;
+ 
+INT VAR tab index;
+ 
+. tab typ       : tab speicher (tab liste ISUB tab index). tab typ
+. tab position  : tab speicher (tab liste ISUB tab index). tab position
+. tab param     : tab speicher (tab liste ISUB tab index). tab param 
+. anzahl tabs   : LENGTH tab liste DIV 2 
+.;
+ 
+PROC loesche tabellenspeicher :
+ 
+    fill char := " ";
+    tabliste  := "";
+    d strings := empty thesaurus;
+    FOR tab index FROM 1 UPTO max tabs
+        REP tab speicher (tab index). tab typ := leer PER;
+ 
+END PROC loesche tabellenspeicher;
+ 
+(******************************************************************)
+(*** markierungsspeicher                                        ***)
+ 
+INT VAR mark index l, mark index r, alter mark index l, alter mark index r;
+ 
+ROW 4 TOKEN VAR mark token;
+ 
+. markierung links  : mark index l > 0
+. markierung rechts : mark index r > 0
+.;
+ 
+PROC loesche markierung :
+ 
+     mark index l := 0;
+     mark index r := 0;
+
+END PROC loesche markierung;
+ 
+ 
+PROC loesche alte markierung :
+ 
+     alter mark index l := 0;
+     alter mark index r := 0;
+
+END PROC loesche alte markierung;
+ 
+
+PROC initialisiere markierung :
+ 
+     FOR mark index l FROM 1 UPTO 4
+     REP mark token (mark index l). modifikationen fuer x move := 0;
+         mark token (mark index l). offset index               := text token;
+         mark token (mark index l). block token                := FALSE;
+         mark token (mark index l). naechster token index      := 0;
+     PER;
+ 
+END PROC initialisiere markierung;
+ 
+(******************************************************************)
+(*** durchschuss                                                ***)
+ 
+INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, 
+        anzahl durchschuss, zeilen zaehler;
+ 
+BOOL VAR wechsel := TRUE;
+ 
+INT PROC durchschuss :
+ 
+     zeilen zaehler INCR 1;
+     IF   zeilen zaehler <= anzahl durchschuss 1
+          THEN durchschuss 1
+     ELIF zeilen zaehler <= anzahl durchschuss 
+          THEN durchschuss 2
+          ELSE 0
+     FI
+ 
+END PROC durchschuss;
+ 
+ 
+PROC neuer durchschuss (INT CONST anzahl, rest) :
+ 
+     zeilen zaehler     := 0;
+     anzahl durchschuss := anzahl;
+     IF anzahl > 0 
+        THEN IF wechsel
+                THEN durchschuss 1        := rest DIV anzahl durchschuss;
+                     durchschuss 2        := durchschuss 1 + sign (rest);
+                     anzahl durchschuss 1 := anzahl durchschuss -
+                                             abs (rest) MOD anzahl durchschuss;
+                     wechsel              := FALSE;
+                ELSE durchschuss 2        := rest DIV anzahl durchschuss; 
+                     durchschuss 1        := durchschuss 2 + sign (rest);
+                     anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss;
+                     wechsel              := TRUE;
+             FI;
+        ELSE loesche durchschuss
+     FI;
+ 
+END PROC neuer durchschuss;
+ 
+ 
+PROC loesche durchschuss :
+
+     durchschuss 1           := 0;
+     durchschuss 2           := 0;
+     anzahl durchschuss 1    := 0;
+     anzahl durchschuss      := 0;
+     zeilen zaehler          := 0;
+ 
+END PROC loesche durchschuss;
+ 
+(****************************************************************)
+ 
+PROC initialisierung :
+ 
+  forget (ds);
+  ds := nilspace; tokenspeicher := ds;
+  loesche druckspeicher;
+  loesche anweisungsspeicher;
+  loesche indexspeicher;
+  initialisiere markierung;
+  right  modus                 := FALSE;
+  center modus                 := FALSE;
+  seite ist offen              := FALSE;
+  pass                         := 0;
+  a breite                     := 0;
+  a block token                := FALSE;
+  a modifikationen fuer x move := 0;
+  d code 1                     := leer;
+  erstes fuell token           := leer;
+  IF two bytes
+     THEN FOR index FROM   1 UPTO 129 REP zeichen zaehler (index) := 1 PER; 
+          FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER;
+          FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER;
+          FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER;
+          FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER;
+     ELSE FOR index FROM   1 UPTO 256 REP zeichen zaehler (index) := 1 PER; 
+  FI;
+ 
+END PROC initialisierung;
+ 
+(****************************************************************)
+(*** print - Kommando                                         ***)
+
+BOOL VAR elan listings erlaubt;
+FILE VAR eingabe;
+ 
+with elan listings (TRUE);
+ 
+PROC with elan listings (BOOL CONST flag) :
+     elan listings erlaubt := flag;
+END PROC with elan listings;
+ 
+BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings;
+ 
+ 
+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ):
+ 
+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,
+         PROC (INT CONST, INT VAR, INT VAR) open,
+         PROC (INT CONST, INT CONST) close,
+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 
+         FALSE, "");
+ 
+END PROC print;
+ 
+ 
+PROC print (FILE VAR file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+
+  eingabe := file;
+  input (eingabe);
+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,
+         PROC (INT CONST, INT VAR, INT VAR) open,
+         PROC (INT CONST, INT CONST) close,
+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 
+         elan listings erlaubt CAND is elan source (eingabe), 
+         headline (eingabe) );
+ 
+END PROC print;
+ 
+PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile;
+ 
+BOOL PROC eof : eof (eingabe) END PROC eof;
+ 
+BOOL PROC is elan source (FILE VAR eingabe) :
+ 
+hole erstes symbol;
+elan programm tag COR elan programm bold COR kommentar
+
+. elan programm tag :
+    symbol type = tag type CAND pos (zeile, ";") > 0 
+ 
+. elan programm bold :
+    symbol type = bold type CAND is elan bold
+
+    . is elan bold :
+        symbol = "PACKET" COR symbol = "LET"
+            COR proc oder op (symbol) COR deklaration
+ 
+    . deklaration :
+        next symbol (symbol);
+        symbol = "VAR" OR symbol = "CONST"
+
+. kommentar :
+    pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 
+
+. 
+  hole erstes symbol :
+    hole erstes nicht blankes symbol; 
+    scan (zeile);
+    next symbol (symbol, symbol type);
+ 
+    . hole erstes nicht blankes symbol :
+        IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI;
+        REP getline (eingabe, zeile);
+        UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER;
+        reset (eingabe);
+ 
+END PROC is elan source;
+
+(****************************************************************)
+ 
+bottom label for elan listings ("");
+ 
+PROC bottom label for elan listings (TEXT CONST label) :
+     bottom label := label;
+END PROC bottom label for elan listings;
+ 
+TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings;
+ 
+ 
+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+            BOOL CONST elan listing, TEXT CONST file name) :
+ 
+disable stop;
+gedruckte seiten := 0;
+drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,
+              PROC (INT CONST, INT VAR, INT VAR) open,
+              PROC (INT CONST, INT CONST) close,
+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+              elan listing, file name );
+IF is error THEN behandle fehlermeldung FI;
+ 
+. behandle fehlermeldung :
+    par1 := error message;
+    int param := error line;
+    clear error;
+    IF NOT vor erster seite
+       THEN IF seite ist offen
+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )
+            FI;
+            clear error;
+            close (document, 0);
+            clear error;
+    FI;
+    initialisierung;
+    errorstop (par1 (* + " -> " + text (int param) *) );
+ 
+END PROC print; 
+ 
+INT PROC x pos          : d xpos                END PROC x pos;
+INT PROC y pos          : d ypos                END PROC y pos;
+INT PROC y offset index : d token. offset index END PROC y offset index;
+INT PROC linetype       : underline linetype    END PROC linetype;
+TEXT PROC material      : material wert         END PROC material;
+INT PROC pages printed  : gedruckte seiten      END PROC pages printed;
+ 
+(****************************************************************)
+ 
+PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,
+                   PROC (INT CONST, INT VAR, INT VAR) open,
+                   PROC (INT CONST, INT CONST) close,
+                   PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+                   BOOL CONST elan listing, TEXT CONST file name ) :
+ 
+ 
+enable stop;
+IF elan listing
+   THEN dateiname := file name;
+        drucke elan listing;
+   ELSE drucke text datei;
+FI;
+ 
+.
+  drucke text datei :
+    initialisiere druck; 
+    WHILE NOT eof
+    REP next line (zeile); 
+        analysiere zeile; 
+        drucke token soweit wie moeglich;
+        werte anweisungsspeicher aus;
+    PER;
+    schliesse druck ab; 
+ 
+. 
+  initialisiere druck :
+    IF NOT initialized (in dieser task)
+       THEN ds := nilspace;
+            initialisierung
+    FI;
+    vor erster seite               := TRUE;
+    tabellen modus                 := FALSE;
+    block modus                    := FALSE;
+    zeile ist absatzzeile          := TRUE;
+    x wanted                       := x step conversion (std x wanted);
+    y wanted                       := y step conversion (std y wanted);
+    limit                          := x step conversion (std limit);
+    pagelength                     := y step conversion (std pagelength);
+    linefeed faktor                := std linefeed faktor;
+    material wert                  := std material;
+    indentation                    := 0;
+    modifikations modus            := maxint; 
+    seitenlaenge                   := maxint;
+    papierlaenge                   := maxint;
+    left margin                    := 0;
+    top  margin                    := 0;
+    a ypos                         := top margin;
+    a font                         := -1;
+    a modifikationen               := 0;
+    aktuelle spalte                := 1;
+    anzahl spalten                 := 1;
+    stelle neuen font ein (1);
+    loesche tabellenspeicher;
+    loesche markierung;
+    loesche alte markierung;
+    loesche durchschuss;
+ 
+. 
+  schliesse druck ab :
+    IF NOT vor erster seite
+       THEN IF seite ist offen
+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )
+            FI;
+            close (document, 0);
+    FI;
+ 
+.
+  drucke token soweit wie moeglich :
+    IF analysespeicher ist nicht leer
+       THEN letztes token bei gleicher ypos; 
+            IF NOT seite ist offen
+               THEN eroeffne seite (x wanted, y wanted,
+                                  PROC (INT CONST, INT VAR, INT VAR) open);
+            FI;
+            gehe zur letzten neuen ypos;
+            IF seitenlaenge ueberschritten OR papierlaenge ueberschritten 
+               THEN neue seite oder spalte;
+                    analysiere zeile nochmal;
+               ELSE sortiere neue token ein;
+                    IF in letzter spalte
+                       THEN drucke tokenspeicher (a ypos,
+                            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                    FI;
+            FI;
+    FI;
+ 
+    . gehe zur letzten neuen ypos :
+        ypos index a := letzter ypos index a
+ 
+    . seitenlaenge ueberschritten :
+        ya. ypos > seitenlaenge 
+ 
+    . papierlaenge ueberschritten :
+        ya. ypos > papierlaenge 
+ 
+    . neue seite oder spalte :
+        IF in letzter spalte
+           THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                      PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                eroeffne seite (x wanted, aktuelles y wanted,
+                      PROC (INT CONST, INT VAR, INT VAR) open);
+           ELSE neue spalte;
+        FI;
+ 
+        . aktuelles y wanted :
+            IF seitenlaenge ueberschritten
+               THEN y wanted
+               ELSE 0
+            FI
+ 
+    . analysiere zeile nochmal :
+        setze auf alte werte zurueck;
+        loesche anweisungsspeicher;
+        analysiere zeile;
+        letztes token bei gleicher ypos;
+        sortiere neue token ein;
+ 
+        . setze auf alte werte zurueck :
+           zeile ist absatzzeile := letzte zeile war absatzzeile;
+           a modifikationen      := letzte modifikationen;
+           stelle neuen font ein (letzter font);
+ 
+.
+  werte anweisungsspeicher aus :
+    INT VAR index;
+    FOR index  FROM 1 UPTO anweisungszaehler
+    REP
+        SELECT anweisungs indizes ISUB index OF
+          CASE a block             : block anweisung
+          CASE a columns           : columns anweisung
+          CASE a columnsend        : columnsend anweisung
+          CASE a free              : free anweisung
+          CASE a limit             : limit anweisung
+          CASE a linefeed          : linefeed anweisung
+          CASE a material          : material anweisung
+          CASE a page0, a page1    : page anweisung
+          CASE a pagelength        : pagelength anweisung
+          CASE a start             : start anweisung
+          CASE a table             : table anweisung
+          CASE a tableend          : tableend anweisung 
+          CASE a clearpos0         : clearpos0 anweisung
+          CASE a clearpos1         : clearpos1 anweisung
+          CASE a lpos, a rpos, a cpos, a dpos
+                                   : lpos rpos cpos dpos anweisung
+          CASE a bpos              : bpos anweisung
+          CASE a fillchar          : fillchar anweisung
+          CASE a textbegin0        : textbegin0 anweisung
+          CASE a textbegin2        : textbegin2 anweisung
+          CASE a textend           : textend anweisung
+          CASE a indentation       : indentation anweisung
+          CASE a y tab             : y tab anweisung
+        END SELECT
+   PER; 
+   loesche anweisungsspeicher;
+ 
+   . block anweisung :
+       blockmodus := TRUE;
+ 
+   . columns anweisung :
+       IF anzahl spalten = 1 AND int  conversion ok (param1)
+                             AND real conversion ok (param2) 
+          THEN anzahl spalten := max (1, int param); 
+               luecke         := x step conversion (real param);
+       FI;
+ 
+   . columnsend anweisung :
+       anzahl spalten  := 1;
+       aktuelle spalte := 1; 
+       left margin     := x wanted - x start + indentation;
+ 
+   . free anweisung :
+       IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI;
+ 
+   . limit anweisung :
+       IF real conversion ok (param1) THEN limit := x step conversion (real param) FI;
+ 
+   . linefeed anweisung :
+       IF real conversion ok (param1)
+          THEN linefeed faktor    := real param;
+               letzte zeilenhoehe := neue zeilenhoehe;
+       FI;
+
+   . material anweisung :
+       material wert := param1;
+ 
+   . page anweisung :
+       IF seite ist offen
+          THEN IF NOT in letzter spalte
+                  THEN neue spalte
+                  ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                       papier laenge := maxint;
+               FI;
+          ELSE a ypos        := top margin;
+               papier laenge := maxint;
+       FI;
+ 
+   . pagelength anweisung :
+       IF real conversion ok (param1)
+          THEN pagelength   := y step conversion (real param);
+       FI;
+ 
+   . start anweisung :
+       IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI;
+       IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI;
+ 
+   . table anweisung :
+       tabellenmodus := TRUE;
+ 
+   . tableend anweisung :
+       tabellenmodus := FALSE;
+ 
+   . clearpos0 anweisung :
+       loesche tabellenspeicher;
+ 
+   . clearpos1 anweisung :
+       IF real conversion ok (param1) 
+          THEN int param := x step conversion (real param);
+               FOR tab index FROM 1 UPTO anzahl tabs
+               REP IF tab position = int param
+                      THEN tab typ := leer;
+                           delete int (tab liste, tab index);
+                           LEAVE clearpos1 anweisung;
+                   FI;
+               PER;
+       FI; 
+ 
+   . lpos rpos cpos dpos anweisung :
+       IF real conversion ok (param1)
+          THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; 
+ 
+   . bpos anweisung :
+       IF real conversion ok (param2) CAND real conversion ok (param1)
+            CAND real (param2) > real param
+          THEN neuer tab eintrag (a bpos, param2) FI;
+ 
+   . fillchar anweisung :
+        fill char := param1;
+ 
+   . textbegin0 anweisung :
+       aktuelle einrueckbreite := alte einrueckbreite;
+       mark index l            := alter mark index l;
+       mark index r            := alter mark index r;
+       loesche alte markierung;
+ 
+   . textbegin2 anweisung :
+       aktuelle einrueckbreite := alte einrueckbreite;
+       mark index l            := alter mark index l;
+       mark index r            := alter mark index r;
+       loesche alte markierung;
+       neuer durchschuss (int (param1), y step conversion (real (param 2)));
+ 
+   . textend anweisung :
+       alte einrueckbreite := aktuelle einrueckbreite;
+       alter mark index l  := mark index l;
+       alter mark index r  := mark index r;
+       loesche markierung;
+       loesche durchschuss;
+
+   . indentation anweisung :
+(*     IF real conversion ok (param1)
+          THEN int param   := x step conversion (real param);
+               left margin INCR (int param - indentation);
+               indentation :=    int param;
+       FI;
+  *)
+   . y tab anweisung :
+(*     IF real conversion ok (param1)
+          THEN int param := y step conversion (real param);
+               IF int param <= seitenlaenge THEN a ypos := int param FI;
+       FI;
+  *)
+       . param1 :
+           IF (params1 zeiger ISUB index) <> 0
+              THEN name (params1, params1 zeiger ISUB index)
+              ELSE ""
+           FI
+ 
+       . param2 :
+           IF (params2 zeiger ISUB index) <> 0
+              THEN name (params2, params2 zeiger ISUB index)
+              ELSE ""
+           FI
+ 
+
+.
+  drucke elan listing :
+    initialisiere elan listing;
+    WHILE NOT eof
+    REP next line (zeile);
+        zeilen nr INCR 1;
+        drucke elan zeile;
+    PER;
+    schliesse elan listing ab;
+ 
+.
+  initialisiere elan listing :
+    open document cmd;
+    hole elan list font;
+    initialisiere variablen;
+    elan fuss und kopf (1,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+    . open document cmd :
+        material wert         := "";
+        d token. offset index := 1;
+        erster ypos index d   := 0; 
+        vor erster seite      := FALSE;
+        seite ist offen       := FALSE;
+        open (document, x size, y size);
+        vor erster seite      := TRUE;
+ 
+    . hole elan list font :
+        d font := max (1, font ("elanlist"));
+        get replacements (d font, replacements, replacement tabelle);
+        einrueckbreite := indentation pitch (d font) ;
+        font hoehe     := font lead (d font) + font height (d font) + font depth (d font);
+ 
+    . initialisiere variablen :
+        innerhalb der define liste := FALSE;
+        vor erstem packet       := TRUE;
+        zeilen nr               := 0;
+        y wanted                := y size DIV 23;
+        pagelength              := y size - y wanted - y wanted; 
+        x wanted                := (min (x size DIV 10, x step conversion (2.54))
+                                        DIV einrueckbreite) * einrueckbreite; 
+        max zeichen zeile       := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite;
+        max zeichen fuss        := fusszeilenbreite;
+        layout laenge           := min (38, max zeichen zeile DIV 3);
+        layout laenge name      :=  layout laenge - zeilen nr laenge - 8; 
+        layout blanks           := (layout laenge - zeilen nr laenge - 1) * " "; 
+        refinement layout zeile := (layout laenge - 1) * " " ;
+        refinement layout zeile CAT "|" ;
+        IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65
+           THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI;
+ 
+        . fusszeilenbreite :
+            INT CONST dina 4 breite := x step conversion (21.0);
+            IF   x size <= dina 4 breite
+                 THEN (x size - 2 * x wanted) DIV einrueckbreite 
+            ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted
+                 THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite 
+                 ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite)
+            FI
+ 
+.
+  schliesse elan listing ab :
+    elan fuss und kopf (-1,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    close (document, 0);
+ 
+. 
+  drucke elan zeile :
+    IF pos (zeile, "#page#") = 1 
+       THEN IF nicht am seiten anfang THEN seiten wechsel FI;
+       ELSE bestimme elan layout;
+            bestimme elan zeile;
+            gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+            seitenwechsel wenn noetig;
+    FI;
+ 
+    . nicht am seitenanfang :
+        rest auf seite < pagelength - 3 * font hoehe
+ 
+    . seiten wechsel :
+        elan fuss und kopf (0,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. 
+  bestimme elan layout :
+    IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0
+       THEN leeres layout 
+       ELSE analysiere elan zeile
+    FI;
+    elan text CAT "|";
+ 
+    . leeres layout :
+        elan text := text (zeilen nr, zeilen nr laenge);
+        elan text CAT layout blanks;
+ 
+    . analysiere elan zeile :
+        scan (zeile);
+        next symbol (symbol, symbol type);
+        next symbol (naechstes symbol, naechster symbol type) ;
+        IF   packet anfang              THEN packet     layout 
+        ELIF innerhalb der define liste THEN leeres     layout; pruefe ende der define liste 
+        ELIF proc op anfang             THEN proc op    layout
+        ELIF refinement anfang          THEN refinement layout
+                                        ELSE leeres     layout
+        FI;
+ 
+    . packet anfang :
+        symbol = "PACKET"
+ 
+    . proc op anfang :
+        IF   proc oder op (symbol)
+             THEN naechster symbol type <> delimiter type
+        ELIF (symbol <> "END") AND proc oder op (naechstes symbol)
+             THEN symbol := naechstes symbol;
+                  next symbol (naechstes symbol, naechster symbol type) ;
+                  naechster symbol type <> delimiter type
+             ELSE FALSE
+        FI
+ 
+    . refinement anfang :
+        symbol type = tag type AND naechstes symbol = ":" 
+                                  AND NOT innerhalb der define liste 
+ 
+    . packet layout :
+        IF nicht am seiten anfang AND
+             (NOT vor erstem packet OR gedruckte seiten > 0)
+           THEN seiten wechsel FI;
+        layout ("   ", naechstes symbol, "*") ;
+        vor erstem packet := FALSE ;
+        innerhalb der define liste := TRUE;
+        pruefe ende der define liste;
+
+       . pruefe ende der define liste :
+           IF pos (zeile, ":") <> 0
+              THEN scan (zeile);
+                   WHILE innerhalb der define liste
+                   REP next symbol (symbol);
+                       IF symbol = ":" THEN innerhalb der define liste := FALSE FI;
+                   UNTIL symbol = "" PER;
+           FI;
+
+    . proc op layout :
+        IF   keine vier zeilen mehr
+             THEN seiten wechsel
+        ELIF nicht am seitenanfang
+             THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        FI ; 
+        layout ("   ", naechstes symbol, ".");
+ 
+        . keine vier zeilen mehr :
+            rest auf seite <= 8 * font hoehe 
+ 
+    . refinement layout :
+        IF   keine drei zeilen mehr
+             THEN seiten wechsel
+        ELIF nicht am seitenanfang
+             THEN elan text := refinement layout zeile;
+                  gib elan text aus
+                       (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+        FI ; 
+        layout ("      ", symbol, " ");
+ 
+        . keine drei zeilen mehr :
+            rest auf seite <= 7 * font hoehe 
+ 
+. 
+  bestimme elan zeile : 
+    IF zeile ist nicht zu lang
+       THEN elan text CAT zeile;
+       ELSE drucke zeile in teilen 
+    FI;
+ 
+    . zeile ist nicht zu lang :
+        zeilen laenge := LENGTH zeile;
+        zeilen laenge <= rest auf zeile
+ 
+       . rest auf zeile :
+           max zeichen zeile - LENGTH elan text
+ 
+    . drucke zeile in teilen :
+        zeilen pos := 1;
+        bestimme einrueckung;
+        WHILE zeile noch nicht ganz gedruckt REP teil layout PER;
+ 
+    . bestimme einrueckung :
+        anzahl einrueck blanks := naechstes nicht blankes zeichen - 1;
+        IF anzahl einrueck blanks > rest auf zeile - 20
+           THEN anzahl einrueck blanks := 0 FI;
+ 
+    . zeile noch nicht ganz gedruckt :
+        bestimme zeilenteil;
+        NOT zeile ist zu ende
+ 
+        . bestimme zeilenteil :
+            bestimme laenge;
+            zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1);
+            elan text CAT zeilen teil;
+            zeilen pos INCR laenge;
+ 
+            . zeilen teil : par1
+
+            . bestimme laenge :
+               INT VAR laenge := zeilen laenge - zeilen pos + 1;
+               IF laenge > rest auf zeile
+                  THEN laenge := rest auf zeile;
+                       WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " "
+                       REP laenge DECR 1 UNTIL laenge = 0 PER;
+                       IF laenge = 0 THEN laenge := rest auf zeile FI;
+               FI;
+ 
+    . teil layout :
+        gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        elan text :=  (zeilen nr laenge - 1) * " "; 
+        elan text CAT "+";
+        elan text CAT layout blanks;
+        elan text CAT "|";
+        elan text cat blanks (anzahl einrueck blanks + teil einrueckung);
+ 
+. 
+  seiten wechsel wenn noetig :
+    IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; 
+ 
+    . keine zeilen mehr :
+        rest auf seite <= 4 * font hoehe 
+ 
+END PROC drucke datei;
+ 
+ 
+BOOL PROC real conversion ok (TEXT CONST param) :
+     real param := real (param);
+     last conversion ok AND real param >= 0.0
+END PROC real conversion ok;
+ 
+ 
+BOOL PROC int conversion ok (TEXT CONST param) :
+     int param := int (param);
+     last conversion ok AND int param >= 0 
+END PROC int conversion ok;
+ 
+ 
+PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) :
+ 
+     suche neuen eintrag;
+     sortiere neue tab position ein;
+     tab typ      := typ;
+     tab position := neue tab position;
+     tab param    := eventueller parameter;
+ 
+     . suche neuen eintrag :
+         INT VAR index := 0;
+         REP index INCR 1;
+             IF tab speicher (index). tab typ = leer
+                THEN LEAVE suche neuen eintrag FI;
+         UNTIL index = max tabs PER;
+         LEAVE neuer tab eintrag;
+ 
+     . sortiere neue tab position ein :
+         INT VAR neue tab position := x step conversion (real param);
+         FOR tab index FROM 1 UPTO anzahl tabs
+         REP IF   tab position = neue tab position
+                THEN LEAVE neuer tab eintrag
+             ELIF tab position > neue tab position
+                THEN insert int (tab liste, tab index, index);
+                     LEAVE sortiere neue tab position ein;
+             FI;
+         PER;
+         tab liste CAT index;
+         tab index :=  anzahl tabs;
+ 
+     . eventueller parameter :
+         INT VAR link;
+         SELECT typ OF
+           CASE a dpos : insert (d strings, param, link); link
+           CASE a bpos : x step conversion (real(param))
+             OTHERWISE : 0
+         END SELECT
+ 
+END PROC neuer tab eintrag;
+ 
+ 
+PROC neue spalte :
+     a ypos           :=  top margin;
+     left margin     INCR (limit + luecke);
+     aktuelle spalte INCR 1;
+END PROC neue spalte ;
+ 
+ 
+BOOL PROC proc oder op (TEXT CONST symbol) :
+
+  symbol = "PROC" OR symbol = "PROCEDURE"
+    OR symbol = "OP" OR symbol = "OPERATOR" 
+
+ENDPROC proc oder op ;
+ 
+ 
+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :
+
+name := subtext (name, 1, layout laenge name) ;
+elan text :=  text (zeilen nr, zeilen nr laenge);
+elan text CAT pre;
+elan text CAT name;
+elan text CAT " ";
+generiere strukturiertes layout;
+ 
+. generiere strukturiertes layout :
+    INT VAR index;
+    FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1
+        REP elan text CAT post PER;
+
+ENDPROC layout ;
+ 
+ 
+PROC elan text cat blanks (INT CONST anzahl) :
+ 
+  par2 := anzahl * " ";
+  elan text CAT par2;
+ 
+END PROC elan text cat blanks;
+ 
+ 
+(***********************************************************************)
+ 
+PROC analysiere zeile : 
+ 
+loesche analysespeicher;
+behandle fuehrende blanks;
+pruefe ob anweisungszeile;
+pruefe ob markierung links;
+ 
+IF   tabellen modus
+     THEN analysiere tabellenzeile
+ELIF letzte zeile war absatzzeile 
+     THEN analysiere zeile nach absatzzeile 
+     ELSE analysiere zeile nach blockzeile
+FI; 
+ 
+pruefe center und right modus;
+pruefe ob tabulation vorliegt;
+werte indexspeicher aus;
+berechne zeilenhoehe;
+pruefe ob markierung rechts;
+ 
+.
+  analysiere zeile nach absatzzeile :
+    test auf aufzaehlung;
+    IF zeile muss geblockt werden 
+       THEN analysiere blockzeile nach absatzzeile 
+       ELSE analysiere absatzzeile nach absatzzeile 
+    FI; 
+.
+  analysiere zeile nach blockzeile :
+    IF zeile muss geblockt werden 
+       THEN analysiere blockzeile nach blockzeile 
+       ELSE analysiere absatzzeile nach blockzeile
+    FI; 
+ 
+ 
+.
+  behandle fuehrende blanks :
+    zeilenpos := 1;
+    zeilenpos := naechstes nicht blankes zeichen; 
+    IF zeilenpos = 0
+       THEN behandle leerzeile;
+            LEAVE analysiere zeile;
+       ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; 
+            IF letzte zeile war absatzzeile THEN neue einrueckung FI;
+            initialisiere analyse;
+    FI;
+ 
+    . behandle leerzeile :
+        a ypos INCR (letzte zeilenhoehe + durchschuss);
+        zeile ist absatzzeile := LENGTH zeile > 0;
+        pruefe ob markierung links;
+        pruefe ob markierung rechts;
+ 
+    . neue einrueckung :
+        aktuelle einrueckbreite := einrueckbreite;
+ 
+    . initialisiere analyse :
+        zeile ist absatzzeile        := (zeile SUB LENGTH zeile) = blank;
+        zeile muss geblockt werden   := block modus AND NOT zeile ist absatzzeile;
+        erstes token der zeile       := token index f + 1;
+        groesste fonthoehe           := fonthoehe;
+        aktuelle zeilenhoehe         := letzte zeilenhoehe;
+        zeilen laenge                := laenge der zeile;
+        anzahl einrueck blanks       := zeilen pos - 1; 
+        anzahl zeichen               := anzahl einrueck blanks;
+        a xpos                       := left margin + anzahl zeichen * aktuelle einrueckbreite; 
+        a modifikationen fuer x move := 0;
+        letzter font                 := a font;
+        letzte modifikationen        := a modifikationen;
+        IF zeile muss geblockt werden THEN initialisiere tab variablen FI;
+
+        . laenge der zeile :
+            IF zeile ist absatzzeile
+               THEN LENGTH zeile - 1
+               ELSE LENGTH zeile 
+            FI
+.
+  pruefe ob anweisungszeile :
+    IF erstes zeichen ist anweisungszeichen
+       THEN REP analysiere anweisung;
+                IF zeile ist zu ende THEN LEAVE analysiere zeile FI;
+            UNTIL zeichen ist kein anweisungs zeichen PER;
+    FI;
+ 
+    . erstes zeichen ist anweisungszeichen :
+        pos (zeile, anweisungszeichen, 1, 1) <> 0
+ 
+    . zeichen ist kein anweisungszeichen :
+        pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0
+ 
+.
+  pruefe ob markierung links :
+    IF markierung links
+       THEN mark token (mark index l). xpos := 
+                             left margin - mark token (mark index l). breite;
+            lege markierungs token an (mark index l);
+            erstes token der zeile := token index f + 1;
+            initialisiere tab variablen;
+    FI;
+ 
+. 
+  analysiere tabellenzeile : 
+    anfangs blankmodus := doppel blank;
+    alte zeilenpos     := zeilen pos;
+    FOR tab index FROM 1 UPTO anzahl tabs
+    REP lege fuell token an wenn noetig;
+        initialisiere tab variablen; 
+        SELECT tab typ OF
+          CASE a lpos  :  linksbuendige spalte
+          CASE a rpos  :  rechtsbuendige spalte
+          CASE a cpos  :  zentrierte spalte
+          CASE a dpos  :  dezimale spalte
+          CASE a bpos  :  geblockte spalte
+        END SELECT;
+        berechne fuell token wenn noetig;
+        tabulation;
+    PER;
+    analysiere rest der zeile;
+ 
+    . lege fuell token an wenn noetig :
+        IF fill char <> blank
+           THEN fuellzeichen                 := fill char;
+                fuellzeichen breite          := string breite (fuellzeichen);
+                token zeiger                 := zeilen pos;
+                erstes fuell token           := token index f + 1;
+                lege text token an;
+                letztes fuell token          := token index f;
+                a modifikationen fuer x move := a modifikationen
+        FI;
+ 
+    . berechne fuell token wenn noetig :
+        IF erstes fuell token <> leer
+           THEN IF letztes fuell token <> token index f 
+                   THEN berechne fuell token;
+                   ELSE loesche letzte token;
+                FI;
+                erstes fuell token := leer
+        FI;
+ 
+        . berechne fuell token :
+            INT VAR anzahl fuellzeichen, fuell breite;
+            token index         := erstes fuell token;
+            anzahl fuellzeichen := (tab anfang - t. xpos + left margin) 
+                                                 DIV fuellzeichen breite;
+            rest                := (tab anfang - t. xpos + left margin) 
+                                                 MOD fuellzeichen breite;
+            IF anzahl fuell zeichen > 0
+               THEN fuell text   := anzahl fuellzeichen * fuellzeichen; 
+                    fuell breite := anzahl fuellzeichen * fuellzeichen breite; 
+                    FOR token index FROM erstes fuell token UPTO letztes fuell token
+                    REP t. text   := fuell text;
+                        t. breite := fuell breite;
+                        IF erstes fuell token <> erstes token der zeile
+                           THEN t. xpos INCR rest DIV 2;
+                                t. modifikationen fuer x move := t. modifikationen;
+                        FI;
+                    PER;
+            FI;
+ 
+            . fuell text : par1
+ 
+        . loesche letzte token :
+            FOR token index FROM letztes fuell token DOWNTO erstes fuell token
+            REP loesche letztes token PER;
+ 
+    . tabulation :
+        alte zeilenpos := zeilenpos;
+        zeilenpos := naechstes nicht blankes zeichen; 
+        IF zeilenpos = 0
+           THEN zeilenpos := zeilenlaenge + 1; 
+                LEAVE analysiere tabellenzeile;
+        FI;
+        anzahl zeichen INCR zeilenpos - alte zeilenpos; 
+ 
+    . linksbuendige spalte : 
+        a xpos     := left margin + tab position;
+        tab anfang := tab position;
+        bestimme token bis terminator oder zeilenende;
+ 
+    . rechtsbuendige spalte :
+        bestimme token bis terminator oder zeilenende;
+        schreibe zeile rechtsbuendig (tab position);
+ 
+    . zentrierte spalte :
+        bestimme token bis terminator oder zeilenende;
+        zentriere zeile (tab position);
+ 
+    . dezimale spalte :
+        d string                  := name (d strings, tab param);
+        d code 1                  := code (d string SUB 1) + 1;
+        d pitch                   := zeichenbreiten (d code 1);
+        zeichenbreiten (d code 1) := d code ausgang;
+        bestimme token bis terminator oder zeilenende;
+        zeichenbreiten (d code 1) := d pitch;
+        d code 1                  := leer;
+        schreibe zeile rechtsbuendig (tab position);
+        IF zeichen ist dezimal zeichen
+           THEN IF tab position <> zeilen breite
+                   THEN a xpos     := left margin + tab position;
+                        tab anfang := tab position;
+                FI;
+                bestimme token bis terminator oder zeilenende
+        FI;
+ 
+        . zeichen ist dezimal zeichen :
+            pos (zeile, d string,  zeilen pos) = zeilen pos
+ 
+    . geblockte spalte :
+        blankmodus := einfach blank;
+        a xpos     := left margin + tab position;
+        tab anfang := tab position;
+        REP bestimme token bis terminator oder zeilenende; 
+            IF zeile ist zu ende OR naechstes zeichen ist blank
+               THEN blocke spalte wenn noetig;
+                    LEAVE geblockte spalte;
+               ELSE dehnbares blank gefunden;
+            FI;
+        PER;
+ 
+        . blocke spalte wenn noetig :
+            IF letztes zeichen ist kein geschuetztes blank
+               THEN blocke zeile (tab param) FI;
+            blank modus := doppel blank;
+ 
+        . letztes zeichen ist kein geschuetztes blank :
+            pos (zeile, geschuetztes blank,  zeilen pos - 1, zeilen pos - 1) = 0
+              AND NOT within kanji (zeile, zeilen pos - 2)
+
+    . analysiere rest der zeile :
+        blankmodus := keine blankanalyse;
+        zeilen pos := alte zeilenpos;
+        bestimme token bis terminator oder zeilenende;
+ 
+.
+  test auf aufzaehlung : 
+    anfangs blankmodus := einfach blank;
+    bestimme token bis terminator oder zeilenende;
+    IF zeile ist zu ende
+       THEN LEAVE analysiere zeile nach absatzzeile
+       ELSE aufzaehlung moeglich
+    FI;
+ 
+    . aufzaehlung moeglich :
+        bestimme letztes zeichen;
+        IF    (anzahl zeichen bei aufzaehlung < 2  AND letztes zeichen = "-")
+           OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":")
+           OR (anzahl zeichen bei aufzaehlung < 7
+                                        AND pos (".)", letztes zeichen) <> 0)
+           OR naechstes zeichen ist blank
+          THEN tabulator position gefunden;
+        ELIF zeile muss geblockt werden
+          THEN dehnbares blank gefunden;
+        FI;
+ 
+        . bestimme letztes zeichen : 
+            token index := token index f;
+            WHILE token index >= erstes token der zeile
+            REP IF token ist text token 
+                   THEN letztes zeichen := t. text SUB LENGTH t. text;
+                        LEAVE bestimme letztes zeichen;
+                FI;
+                token index DECR 1;
+            PER;
+            letztes zeichen := "";
+ 
+        . letztes zeichen : par1
+ 
+        . anzahl zeichen bei aufzaehlung :
+            anzahl zeichen - anzahl einrueck blanks
+ 
+        . token ist text token :
+            t. offset index >= text token
+.
+  analysiere blockzeile nach absatzzeile :
+    REP bestimme token bis terminator oder zeilenende; 
+        IF zeile ist zu ende 
+           THEN blocke zeile (limit);
+                LEAVE analysiere blockzeile nach absatzzeile
+           ELSE analysiere blank in blockzeile nach absatzzeile 
+        FI;
+    PER;
+ 
+    . analysiere blank in blockzeile nach absatzzeile : 
+        IF naechstes zeichen ist blank
+           THEN tabulator position gefunden;
+           ELSE dehnbares blank gefunden;
+        FI;
+ 
+.
+  analysiere absatzzeile nach absatzzeile :
+    blankmodus := doppel blank;
+    REP bestimme token bis terminator oder zeilenende;
+        IF zeile ist zu ende 
+           THEN LEAVE analysiere absatzzeile nach absatzzeile
+           ELSE tabulator position gefunden
+        FI;
+    PER;
+ 
+.
+  analysiere blockzeile nach blockzeile :
+    anfangs blankmodus := einfach blank;
+    REP bestimme token bis terminator oder zeilenende;
+        IF zeile ist zu ende 
+           THEN blocke zeile (limit);
+                LEAVE analysiere blockzeile nach blockzeile
+           ELSE dehnbares blank gefunden 
+        FI;
+    PER;
+ 
+.
+  analysiere absatzzeile nach blockzeile :
+    anfangs blankmodus := keine blankanalyse;
+    bestimme token bis terminator oder zeilenende;
+
+.
+  dehnbares blank gefunden :
+    anzahl zeichen INCR 1;
+    zeilenpos      INCR 1;
+    a xpos         INCR blankbreite;
+    a modifikationen fuer x move := a modifikationen;
+    IF NOT a block token
+       THEN anzahl blanks  INCR 1;
+            a block token := TRUE; 
+    FI;
+.
+  tabulator position gefunden :
+    alte zeilenpos := zeilenpos; 
+    zeilenpos := naechstes nicht blankes zeichen;
+    IF zeilenpos = 0 
+       THEN zeilenpos := zeilen laenge + 1;
+       ELSE IF erstes token der zeile > token index f
+               THEN token zeiger := zeilen pos;
+                    lege text token an;
+            FI;
+            anzahl zeichen INCR (zeilenpos - alte zeilenpos);
+            a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; 
+            a modifikationen fuer x move := a modifikationen;
+            IF zeile muss geblockt werden THEN initialisiere tab variablen FI;
+    FI;
+ 
+.
+  pruefe center und right modus : 
+    IF center modus THEN zentriere zeile (limit DIV 2) FI;
+    IF right  modus THEN schreibe zeile rechtsbuendig (limit) FI;
+.
+  pruefe ob tabulation vorliegt:
+    IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite
+       THEN a modifikationen fuer x move := a modifikationen; 
+            token zeiger := zeilen pos;
+            lege text token an;
+    FI;
+.
+  werte indexspeicher aus :
+    INT VAR index;
+    IF index zaehler > 0
+       THEN FOR index FROM index zaehler DOWNTO 1
+                REP a ypos DECR (verschiebungen ISUB index) PER;
+            stelle neuen font ein (grosse fonts ISUB 1);
+            loesche index speicher;
+    FI;
+.
+  berechne zeilenhoehe :
+    verschiebung := aktuelle zeilenhoehe + durchschuss;
+    a ypos INCR verschiebung;
+    verschiebe token ypos (verschiebung);
+ 
+.
+  pruefe ob markierung rechts :
+    IF markierung rechts
+       THEN mark token (mark index r). xpos := left margin + limit;
+            lege markierungs token an (mark index r);
+    FI;
+ 
+END PROC analysiere zeile;
+ 
+ 
+PROC blocke zeile (INT CONST rechter rand) :
+ 
+rest := rechter rand - zeilen breite;
+IF rest > 0 AND anzahl blanks > 0
+   THEN INT CONST schmaler schritt       := rest DIV anzahl blanks,
+                  breiter schritt        := schmaler schritt + 1,
+                  anzahl breite schritte := rest MOD anzahl blanks;
+        IF rechts
+           THEN blocke token xpos (breiter schritt, schmaler schritt,
+                                                     anzahl breite schritte);
+                rechts := FALSE; 
+           ELSE blocke token xpos (schmaler schritt, breiter schritt,
+                                     anzahl blanks - anzahl breite schritte);
+                rechts := TRUE;
+       FI;
+       a xpos INCR ( breiter schritt * anzahl breite schritte +
+              schmaler schritt * (anzahl blanks - anzahl breite schritte) );
+FI;
+ 
+END PROC blocke zeile;
+ 
+ 
+PROC zentriere zeile (INT CONST zentrier pos) :
+ 
+IF erstes tab token <= token index f
+   THEN verschiebung := zentrier pos - tab anfang -
+                                   (zeilen breite - tab anfang) DIV 2; 
+        verschiebe token xpos (verschiebung);
+        a xpos     INCR verschiebung; 
+        tab anfang INCR verschiebung; 
+FI;
+center modus := FALSE;
+ 
+END PROC zentriere zeile;
+
+
+PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) :
+ 
+IF erstes tab token <= token index f
+   THEN verschiebung := rechte pos - zeilen breite;
+        verschiebe token xpos (verschiebung);
+        a xpos     INCR verschiebung;
+        tab anfang INCR verschiebung; 
+FI;
+right modus := FALSE;
+ 
+ 
+END PROC schreibe zeile rechtsbuendig;
+
+ 
+PROC bestimme token bis terminator oder zeilenende :
+ 
+token zeiger := zeilen pos;
+REP stranalyze (zeichenbreiten, a breite, max breite, 
+                zeile, zeilen pos, zeilen laenge,
+                ausgang);
+    zeilen pos INCR 1;
+    IF   ausgang = blank ausgang
+         THEN analysiere blank
+    ELIF ausgang = anweisungs ausgang
+         THEN anweisung gefunden
+    ELIF ausgang = d code ausgang
+         THEN analysiere d string
+    ELIF ausgang = erweiterungs ausgang
+         THEN erweiterung gefunden
+         ELSE terminator oder zeilenende gefunden
+    FI;
+PER;
+ 
+. analysiere blank :
+    IF blankmodus = einfach blank OR
+       (blankmodus = doppel blank AND naechstes zeichen ist blank)
+       THEN terminator oder zeilenende gefunden 
+       ELSE a breite INCR blankbreite;
+            zeilenpos INCR 1;
+    FI;
+ 
+. analysiere d string :
+    IF pos (zeile, d string, zeilen pos) = zeilen pos 
+       THEN terminator oder zeilenende gefunden 
+       ELSE IF   d pitch = maxint
+                 THEN erweiterung gefunden
+            ELIF d pitch < 0
+                 THEN a breite INCR (d pitch XOR - maxint - 1); 
+                      zeilen pos INCR 2; 
+                 ELSE a breite INCR d pitch; 
+                      zeilenpos INCR 1;
+            FI;
+    FI;
+ 
+. erweiterung gefunden :
+    a breite INCR extended char pitch (a font, zeile SUB zeilen pos, 
+                                               zeile SUB zeilen pos + 1); 
+    zeilen pos INCR 2;
+ 
+. anweisung gefunden :
+    gegebenfalls neues token gefunden;
+    analysiere anweisung;
+    IF zeile ist zu ende
+       THEN LEAVE bestimme token bis terminator oder zeilenende FI;
+    token zeiger := zeilenpos;
+ 
+. terminator oder zeilenende gefunden :
+    IF ausgang = null ausgang THEN  zeilen laenge DECR 1 FI;
+    gegebenfalls neues token gefunden;
+    LEAVE bestimme token bis terminator oder zeilenende;
+ 
+    . gegebenfalls neues token gefunden :
+        IF token zeiger < zeilenpos THEN lege text token an FI;
+ 
+END PROC bestimme token bis terminator oder zeilen ende;
+
+ 
+PROC analysiere anweisung :
+ 
+   bestimme anweisung;
+   IF anweisung ist kommando
+      THEN lege kommando token an;
+      ELSE werte anweisung aus; 
+   FI;
+ 
+    . anweisungsanfang : token zeiger
+ 
+    . anweisungsende   : zeilen pos - 2
+ 
+    . erstes zeichen   : par1
+ 
+. bestimme anweisung :
+    anweisungsanfang := zeilenpos + 1;
+    zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge);
+    IF zeilenpos = 0
+       THEN zeilenpos := anweisungsanfang - 1;
+            replace (zeile, zeilenpos, geschuetztes anweisungszeichen);
+            LEAVE analysiere anweisung;
+    FI;
+    zeilen pos INCR 1; 
+    anweisung      := subtext (zeile, anweisungsanfang, anweisungsende);
+    erstes zeichen := anweisung SUB 1;
+ 
+. anweisung ist kommando : 
+    IF   erstes zeichen = quote
+         THEN scan (anweisung);
+              next symbol (anweisung, symbol type);
+              next symbol (par2, naechster symbol type);
+              IF symbol type <> text type OR naechster symbol type <> eof type
+                 THEN LEAVE analysiere anweisung FI;
+              TRUE
+    ELIF erstes zeichen = druckerkommando zeichen
+         THEN delete char (anweisung, 1);
+              TRUE
+         ELSE FALSE
+    FI
+ 
+. 
+  werte anweisung aus :
+    analyze command (anweisungs liste, anweisung, number type,
+                     anweisungs index, anzahl params, par1, par2);
+    SELECT anweisungs index OF
+      CASE a type           : type anweisung
+      CASE a on             : on anweisung
+      CASE a off            : off anweisung
+      CASE a ub, a fb       : ub fb anweisung
+      CASE a ue, a fe       : ue fe anweisung
+      CASE a center         : center anweisung
+      CASE a right          : right anweisung
+      CASE a up, a down     : index anweisung
+      CASE a end up or down : end index anweisung
+      CASE a bsp            : bsp anweisung
+      CASE a fillchar       : fillchar anweisung
+      CASE a mark           : mark anweisung
+      CASE a markend        : markend anweisung
+      OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI;
+    END SELECT;
+ 
+    . type anweisung :
+        change all (par1, " ", "");
+        stelle neuen font ein (font (par1));
+        groesste fonthoehe := max (groesste fonthoehe, fonthoehe);
+        a modifikationen   := 0;
+        IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI;
+ 
+        . nicht innerhalb eines indexes :
+            index zaehler = 0
+ 
+        . berechne aktuelle zeilenhoehe :
+            IF linefeed faktor >= 1.0
+              THEN aktuelle zeilenhoehe := max (groesste   fonthoehe,
+                                                       letzte zeilenhoehe);
+              ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe,
+                                                       letzte zeilenhoehe);
+           FI;
+ 
+    . on anweisung :
+        par1 := par1 SUB 1;
+        IF pos (modifikations liste, par1) > 0
+           THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 );
+        FI;
+ 
+    . off anweisung :
+        par1 := par1 SUB 1;
+        IF pos (modifikations liste, par1) > 0
+           THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 );
+        FI;
+
+    . ub fb anweisung :
+        IF anweisungs index = a ub
+           THEN par1 := "u"
+           ELSE par1 := "b"
+        FI;
+        on anweisung;
+
+    . ue fe anweisung :
+        IF anweisungs index = a ue
+           THEN par1 := "u"
+           ELSE par1 := "b"
+        FI;
+        off anweisung;
+
+    . center anweisung :
+        IF NOT zeile muss geblockt werden AND NOT tabellen modus
+               AND NOT right modus
+           THEN center modus := TRUE;
+                blankmodus   := keine blankanalyse;
+                initialisiere tab variablen; 
+        FI;
+ 
+    . right anweisung :
+        IF NOT zeile muss geblockt werden AND NOT tabellen modus
+           THEN IF center modus THEN zentriere zeile (limit DIV 2) FI;
+                right modus := TRUE;
+                blankmodus  := keine blankanalyse;
+                initialisiere tab variablen; 
+        FI;
+ 
+    . index anweisung :
+        INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; 
+        INT VAR   kleiner font;
+        IF next smaller font exists (grosser font, kleiner font)
+           THEN stelle neuen font ein (kleiner font) FI;
+        IF font hoehe < grosse fonthoehe
+           THEN berechne verschiebung fuer kleinen font
+           ELSE berechne verschiebung fuer grossen font
+        FI;
+        a ypos INCR verschiebung;
+        merke grossen font und verschiebung;
+ 
+        . berechne verschiebung fuer kleinen font :
+            IF anweisungs index = a down
+               THEN verschiebung :=     15 PROZENT grosse fonthoehe;
+               ELSE verschiebung :=  - ( 9 PROZENT grosse fonthoehe )
+                                     - (grosse fonthoehe - fonthoehe);
+            FI;
+ 
+        . berechne verschiebung fuer grossen font :
+            IF anweisungs index = a down
+               THEN verschiebung :=    25 PROZENT fonthoehe;
+               ELSE verschiebung := - (50 PROZENT fonthoehe);
+            FI;
+ 
+        . merke grossen font und verschiebung :
+            index zaehler INCR 1;
+            grosse fonts   CAT grosser font;
+            verschiebungen CAT verschiebung;
+            IF index zaehler = 1
+               THEN alter blankmodus := blankmodus; 
+                          blankmodus := keine blankanalyse;
+            FI;
+ 
+    . end index anweisung :
+        IF index zaehler > 0
+           THEN schalte auf groesseren font zurueck;
+        FI;
+ 
+        . schalte auf groesseren font zurueck :
+            a ypos DECR (verschiebungen ISUB index zaehler);
+            stelle neuen font ein (grosse fonts ISUB index zaehler);
+            IF index zaehler = 1
+               THEN blankmodus := alter blankmodus;
+            FI;
+            index zaehler DECR 1;
+            verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler);
+            grosse fonts   := subtext (grosse fonts,   1, 2 * index zaehler);
+ 
+    . bsp anweisung :
+        INT VAR breite davor, breite dahinter;
+        IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge
+           THEN IF is kanji esc (zeile SUB anweisungs anfang - 3)
+                   THEN zeichen davor := subtext (zeile, anweisungs anfang - 3,
+                                                         anweisungs anfang - 2);
+                   ELSE zeichen davor := zeile SUB anweisungs anfang - 2;
+                FI;
+                IF is kanji esc (zeile SUB anweisungs ende + 2)
+                   THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2,
+                                                            anweisungs ende + 3 );
+                   ELSE zeichen dahinter := zeile SUB anweisungs ende + 2;
+                FI;
+                IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 
+                   THEN breite davor    := char pitch (a font, zeichen davor);
+                        breite dahinter := char pitch (a font, zeichen dahinter);
+                        IF breite davor < breite dahinter THEN vertausche zeichen FI;
+                        lege token fuer zeichen dahinter an;
+                        a xpos INCR (breite davor - breite dahinter) DIV 2; 
+                FI;
+        FI;
+ 
+        . zeichen davor    : par1
+        . zeichen dahinter : par2
+ 
+        . vertausche zeichen :
+            change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, 
+                           anweisungs anfang - 2, zeichen dahinter);
+            change (zeile, anweisungs ende + 2,
+                           anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor);
+            change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1,
+                              LENGTH tf. text, zeichen dahinter);
+            tf. breite INCR (breite dahinter - breite davor);
+            a xpos     INCR (breite dahinter - breite davor);
+            int param        := breite davor;
+            breite davor     := breite dahinter;
+            breite dahinter  := int param;
+ 
+        . lege token fuer zeichen dahinter an :
+            token zeiger := zeilen pos;
+            a breite     := breite dahinter;
+            zeilen pos INCR LENGTH zeichen dahinter;
+            a xpos     DECR (breite davor + breite dahinter) DIV 2; 
+            lege text token an;
+            anzahl zeichen DECR 1;
+ 
+    . fillchar anweisung :
+        IF par1 = "" THEN par1 := " " FI;
+        fill char := par1;
+        speichere anweisung;
+ 
+    . mark anweisung :
+        IF par1 <> "" 
+           THEN mark index l := (alter mark index l MOD 2) + 1;
+                neue markierung (par1, mark index l);
+           ELSE mark index l := 0;
+        FI;
+        IF par2 <> "" 
+           THEN mark index r := (alter mark index r MOD 2) + 3;
+                neue markierung (par2, mark index r);
+           ELSE mark index r := 0;
+        FI;
+ 
+    . markend anweisung :
+        loesche markierung;
+ 
+    . speichere anweisung :
+        anweisungs zaehler INCR 1;
+        anweisungs indizes CAT anweisungs index;
+        IF par1 <> ""
+           THEN insert (params1, par1); 
+                params1 zeiger CAT highest entry (params1);
+           ELSE params1 zeiger CAT 0;
+        FI;
+        IF par2 <> ""
+           THEN insert (params2, par2); 
+                params2 zeiger CAT highest entry (params2);
+           ELSE params2 zeiger CAT 0;
+        FI;
+ 
+END PROC analysiere anweisung;
+ 
+ 
+PROC stelle neuen font ein (INT CONST font nr ) :
+
+  IF font nr <> a font THEN neuer font FI;
+ 
+  . neuer font :
+      a font := max (1, font nr);
+      get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe,
+                zeichenbreiten);
+      font hoehe INCR (font durchschuss + font tiefe);
+      letzte zeilenhoehe                         := neue zeilenhoehe;
+      blankbreite                                := zeichenbreiten (blank code 1);
+      zeichenbreiten (blank code 1)              := blank ausgang;
+      zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang;
+      font offsets                               := y offsets (a font);
+      offsets                                    := LENGTH font offsets > 2;
+      IF d code 1 <> leer
+         THEN d pitch                            := zeichenbreiten (d code 1);
+              zeichenbreiten (d code 1)          := d code ausgang;
+     FI;
+ 
+END PROC stelle neuen font ein;
+ 
+ 
+INT OP PROZENT (INT CONST prozent, wert) :
+ 
+    (wert * prozent + 99) DIV 100
+ 
+END OP PROZENT; 
+ 
+ 
+PROC neue markierung (TEXT CONST text, INT CONST mark index) :
+ 
+      mark token (mark index). text           := text;
+      mark token (mark index). breite         := string breite (text);
+      mark token (mark index). font           := a font;
+      mark token (mark index). modifikationen := a modifikationen;
+ 
+END PROC neue markierung;
+ 
+ 
+INT PROC string breite (TEXT CONST string) :
+ 
+    INT VAR summe := 0, pos := 1;
+    REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang);
+        IF   ausgang = erweiterungs ausgang
+             THEN summe INCR extended char pitch (a font,
+                                       string SUB pos+1, string SUB pos+2);
+                  pos INCR 3;
+        ELIF ausgang = blank ausgang
+             THEN summe INCR blankbreite;
+                  pos INCR 2;
+        ELIF ausgang = anweisungs ausgang
+             THEN summe INCR char pitch (a font, anweisungszeichen);
+                  pos INCR 2;
+             ELSE LEAVE string breite WITH summe
+        FI;
+    PER;
+    0
+ 
+END PROC string breite;
+ 
+(*******************************************************************)
+ 
+PROC lege text token an :
+ 
+  aktuelle ypos := a ypos + (font offsets ISUB 1); 
+  neuer token index;
+  uebertrage text token (tf);
+  IF offsets THEN lege offsets an (font offsets) FI;
+  stranalyze (zeichen zaehler, anzahl zeichen, max int,
+              zeile, token zeiger, zeilen pos - 1, ausgang);
+  a xpos                       INCR a breite;
+  a breite                     := 0;
+  a modifikationen fuer x move := 0;
+  a block token                := FALSE;
+ 
+END PROC lege text token an;
+ 
+ 
+PROC uebertrage text token (TOKEN VAR tf) :
+ 
+  tf. text                       := subtext (zeile, token zeiger, zeilenpos - 1);
+  tf. xpos                       := a xpos;
+  tf. breite                     := a breite;
+  tf. font                       := a font;
+  tf. modifikationen             := a modifikationen;
+  tf. modifikationen fuer x move := a modifikationen fuer x move;
+  tf. offset index               := text token;
+  tf. block token                := a block token;
+
+END PROC uebertrage text token;
+ 
+ 
+PROC lege kommando token an :
+ 
+  aktuelle ypos := a ypos + (font offsets ISUB 1); 
+  neuer token index;
+  uebertrage kommando token (tf);
+  a modifikationen fuer x move := 0;
+  a block token                := FALSE;
+ 
+END PROC lege kommando token an;
+ 
+ 
+PROC uebertrage kommando token (TOKEN VAR tf) :
+ 
+  tf. text                       := anweisung;
+  tf. breite                     := 0;
+  tf. xpos                       := a xpos;
+  tf. font                       := a font;
+  tf. modifikationen             := a modifikationen;
+  tf. modifikationen fuer x move := a modifikationen fuer x move;
+  tf. offset index               := kommando token;
+  tf. block token                := a block token;
+ 
+END PROC uebertrage kommando token;
+ 
+ 
+PROC lege markierungs token an (INT CONST mark index) :
+ 
+  aktuelle ypos := a ypos + (mark font offsets ISUB 1); 
+  neuer token index;
+  tf := mark token (mark index);
+  IF mark offsets THEN lege offsets an (mark font offsets) FI;
+ 
+  . mark font offsets   : y offsets (mark token (mark index). font)
+ 
+  . mark offsets        : LENGTH mark font offsets > 2
+ 
+END PROC lege markierungs token an;
+ 
+ 
+PROC lege offsets an (TEXT CONST offsets) :
+ 
+  INT CONST anzahl offsets := LENGTH offsets DIV 2;
+  offset token := tf;
+  offset token. block token := FALSE;
+  reset bit (offset token. modifikationen, underline bit);
+  FOR index FROM 2 UPTO anzahl offsets
+  REP aktuelle ypos := a ypos + (offsets ISUB index); 
+      neuer token index;
+      tf               := offset token;
+      tf. offset index := index;
+  PER;
+ 
+END PROC lege offsets an;
+ 
+ 
+PROC neuer token index :
+ 
+IF   erster ypos index a = 0
+     THEN erste ypos
+ELIF ya. ypos = aktuelle ypos 
+     THEN neues token bei gleicher ypos
+     ELSE fuege neue ypos ein
+FI;
+ 
+  . erste ypos :
+      ypos  index f INCR 1;
+          erster     ypos index a := ypos index f;
+          letzter    ypos index a := ypos index f;
+      yf. vorheriger ypos index   := 0;
+      yf. naechster  ypos index   := 0;
+      erstes token bei neuer ypos;
+ 
+  . fuege neue ypos ein :
+      letztes token bei gleicher ypos;
+      IF ya. ypos > aktuelle ypos
+         THEN richtige ypos ist oberhalb
+         ELSE richtige ypos ist unterhalb
+      FI;
+ 
+      . richtige ypos ist oberhalb :
+          REP ypos index a := ya. vorheriger ypos index;
+              IF   ypos index a = 0
+                   THEN fuege ypos vor erstem ypos index ein;
+                        LEAVE richtige ypos ist oberhalb;
+              ELIF ya. ypos = aktuelle ypos
+                   THEN neues token bei neuer ypos;
+                        LEAVE richtige ypos ist oberhalb;
+              ELIF ya. ypos < aktuelle ypos
+                   THEN fuege ypos nach ypos index ein;
+                        LEAVE richtige ypos ist oberhalb;
+              FI;
+          PER;
+ 
+      . richtige ypos ist unterhalb :
+          REP ypos index a := ya. naechster ypos index;
+              IF   ypos index a = 0
+                   THEN fuege ypos nach letztem ypos index ein;
+                        LEAVE richtige ypos ist unterhalb;
+              ELIF ya. ypos = aktuelle ypos
+                   THEN neues token bei neuer ypos;
+                        LEAVE richtige ypos ist unterhalb;
+              ELIF ya. ypos > aktuelle ypos 
+                   THEN fuege ypos vor ypos index ein;
+                        LEAVE richtige ypos ist unterhalb;
+              FI;
+          PER;
+ 
+          . fuege ypos vor erstem ypos index ein :
+              ypos  index f INCR 1;
+              yf. vorheriger ypos index   := 0;
+              yf. naechster  ypos index   :=     erster    ypos index a;
+                  erster     ypos index a :=               ypos index f;
+                             ypos index a := yf. naechster ypos index;
+              ya. vorheriger ypos index   :=               ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos nach ypos index ein :
+              ypos  index f INCR 1;
+              yf. vorheriger ypos index   :=               ypos index a;
+              yf. naechster  ypos index   := ya. naechster ypos index;
+              ya. naechster  ypos index   :=               ypos index f;
+                             ypos index a := yf. naechster ypos index;
+              ya. vorheriger ypos index   :=               ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos vor ypos index ein :
+              ypos  index f INCR 1;
+              yf. naechster  ypos index   :=                ypos index a;
+              yf. vorheriger ypos index   := ya. vorheriger ypos index;
+              ya. vorheriger ypos index   :=                ypos index f;
+                             ypos index a := yf. vorheriger ypos index;
+              ya. naechster  ypos index   :=                ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos nach letztem ypos index ein :
+              ypos  index f INCR 1;
+              yf. naechster  ypos index   := 0;
+              yf. vorheriger ypos index   :=     letzter    ypos index a;
+                  letzter    ypos index a :=                ypos index f;
+                             ypos index a := yf. vorheriger ypos index;
+              ya. naechster  ypos index   :=                ypos index f;
+              erstes token bei neuer ypos;
+ 
+END PROC neuer token index;
+ 
+
+PROC erstes token bei neuer ypos :
+     token index f INCR 1;
+                 ypos index a := ypos index f;
+     ya. erster token index   := token index f; 
+     ya. ypos                 := aktuelle ypos;
+END PROC erstes token bei neuer ypos;
+ 
+ 
+PROC neues token bei neuer ypos :
+     token index f INCR 1;
+     ya. ypos                 := aktuelle ypos;
+                  token index := ya. letzter token index;
+     t. naechster token index := token index f;
+END PROC neues token bei neuer ypos;
+ 
+ 
+PROC neues token bei gleicher ypos :
+     tf. naechster token index := token index f + 1;
+     token index f INCR 1;
+END PROC neues token bei gleicher ypos;
+ 
+ 
+PROC letztes token bei gleicher ypos : 
+     tf. naechster token index := 0;
+     ya. letzter   token index := token index f;
+END PROC letztes token bei gleicher ypos;
+ 
+ 
+PROC loesche letztes token :
+ 
+     IF token index f = ya. erster token index 
+        THEN loesche ypos
+        ELSE token index f DECR 1;
+     FI;
+ 
+     . loesche ypos :
+         kette vorgaenger um;
+         kette nachfolger um;
+         bestimme letzten ypos index;
+ 
+         . kette vorgaenger um :
+             ypos index := ya. vorheriger ypos index; 
+             IF ypos index = 0
+                THEN       erster ypos index a := ya. naechster ypos index;
+                ELSE y. naechster ypos index   := ya. naechster ypos index; 
+             FI;
+ 
+         . kette nachfolger um :
+             ypos index := ya. naechster ypos index;
+             IF ypos index = 0
+                THEN       letzter ypos index a := ya. vorheriger ypos index;
+                ELSE y. vorheriger ypos index   := ya. vorheriger ypos index; 
+             FI;
+ 
+         . bestimme letzten ypos index :
+             IF ypos index a = ypos index f THEN ypos index f DECR 1 FI;
+             token index f DECR 1;
+             ypos index a := letzter ypos index a; 
+             WHILE ypos index a <> 0
+                       CAND ya. letzter token index <> token index f
+             REP ypos index a := ya. vorheriger ypos index PER;
+ 
+END PROC loesche letztes token;
+ 
+ 
+PROC blocke token xpos (INT CONST dehnung 1, dehnung 2,
+                                  anzahl dehnungen fuer dehnung 1 ) :
+
+  INT VAR dehnung := 0, anzahl dehnungen := 0;
+  token index := erstes tab token;
+  WHILE token index <= token index f
+  REP erhoehe token xpos bei block token;
+      t. xpos INCR dehnung;
+      token index INCR 1; 
+  PER;
+ 
+  . erhoehe token xpos bei block token :
+      IF t. block token
+         THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1
+                 THEN anzahl dehnungen INCR 1;
+                      dehnung INCR dehnung 1;
+                 ELSE dehnung INCR dehnung 2;
+              FI;
+      FI;
+ 
+END PROC blocke token xpos;
+ 
+ 
+PROC verschiebe token xpos (INT CONST verschiebung) :
+ 
+  token index := erstes tab token;
+  WHILE token index <= token index f
+  REP t. xpos INCR verschiebung;
+      token index INCR 1; 
+  PER;
+ 
+END PROC verschiebe token xpos;
+ 
+ 
+PROC verschiebe token ypos (INT CONST verschiebung) :
+ 
+  ypos index := erster ypos index a;
+  WHILE ypos index <> 0
+  REP y. ypos INCR verschiebung; 
+      ypos index := y. naechster ypos index;
+  PER;
+ 
+END PROC verschiebe token ypos;
+ 
+ 
+PROC sortiere neue token ein :
+ 
+IF analysespeicher ist nicht leer
+   THEN IF druckspeicher ist nicht leer
+           THEN sortiere neue token in sortierte liste ein
+           ELSE sortierte liste ist leer
+        FI;
+FI;
+
+. sortierte liste ist leer :
+    IF erster ypos index a <> 0
+       THEN erster  ypos index d := erster  ypos index a;
+            letzter ypos index d := letzter ypos index a;
+                    ypos index d := letzter ypos index a;
+    FI;
+ 
+. sortiere neue token in sortierte liste ein :
+    gehe zum ersten neuen token;
+    bestimme erste einsortierposition;
+    WHILE es gibt noch neue token
+    REP IF   ypos index d = 0
+             THEN haenge neue token ans ende der sortierten liste 
+        ELIF ya. ypos > yd. ypos
+             THEN naechste ypos der sortierten liste
+        ELIF ya. ypos = yd. ypos
+             THEN neues token auf gleicher ypos
+             ELSE neue token vor ypos
+        FI; 
+    PER;
+ 
+    . gehe zum ersten neuen token :
+        ypos index a := erster ypos index a;
+ 
+    . bestimme erste einsortierposition :
+        WHILE ypos index d <> 0  CAND  ya. ypos < yd. ypos
+          REP ypos index d := yd. vorheriger ypos index PER;
+        IF ypos index d = 0 THEN erste neue token vor listen anfang FI;
+ 
+        . erste neue token vor listen anfang :
+                   ypos index d := erster ypos index d;
+            erster ypos index d := erster ypos index a;
+            REP ypos index a := ya. naechster ypos index;
+                IF   ypos index a = 0
+                     THEN verkette letztes ya mit yd;
+                          LEAVE sortiere neue token in sortierte liste ein
+                ELIF ya. ypos = yd. ypos
+                     THEN verkette ya mit yd;
+                          LEAVE erste neue token vor listen anfang
+                ELIF ya. ypos > yd. ypos
+                     THEN verkette vorheriges ya mit yd;
+                          ypos index d := yd. naechster ypos index;
+                          LEAVE erste neue token vor listen anfang
+                FI;
+            PER;
+ 
+    . es gibt noch neue token :
+        ypos index a <> 0
+ 
+    . haenge neue token ans ende der sortierten liste : 
+                       ypos index d := letzter ypos index d;
+        yd. naechster  ypos index   :=         ypos index a;
+        ya. vorheriger ypos index   :=         ypos index d;
+            letzter    ypos index d := letzter ypos index a;
+                       ypos index d := letzter ypos index a;
+                       ypos index a := 0;
+ 
+    . naechste ypos der sortierten liste :
+        ypos index d := yd. naechster ypos index;
+ 
+    . neues token auf gleicher ypos :
+                      token index   := yd. letzter   token index;
+        t . naechster token index   := ya. erster    token index;
+        yd. letzter   token index   := ya. letzter   token index;
+                      ypos  index a := ya. naechster ypos  index;
+                      ypos  index d := yd. naechster ypos  index;
+        IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI;
+ 
+    . neue token vor ypos :
+        verkette ya mit vorherigem yd;
+        REP ypos index a := ya. naechster ypos index;
+            IF   ypos index a = 0
+                 THEN verkette letztes ya mit yd;
+                      LEAVE sortiere neue token in sortierte liste ein
+            ELIF ya. ypos = yd. ypos
+                 THEN verkette ya mit yd;
+                      LEAVE neue token vor ypos
+            ELIF ya. ypos > yd. ypos 
+                 THEN verkette vorheriges ya mit yd;
+                      ypos index d := yd. naechster ypos index;
+                      LEAVE neue token vor ypos
+            FI;
+        PER;
+
+ 
+. verkette ya mit vorherigem yd :
+                        index   := ypos index d;
+                   ypos index d := yd. vorheriger ypos index; 
+    yd. naechster  ypos index   :=                ypos index a;
+    ya. vorheriger ypos index   :=                ypos index d;
+                   ypos index d := index;
+ 
+. verkette letztes ya mit yd :
+                   ypos index a := letzter ypos index a;
+    yd. vorheriger ypos index   :=         ypos index a;
+    ya. naechster  ypos index   :=         ypos index d;
+                   ypos index a := 0;
+ 
+. verkette vorheriges ya mit yd :
+                        index   := ypos index a;
+                   ypos index a := ya. vorheriger ypos index; 
+    yd. vorheriger ypos index   :=         ypos index a;
+    ya. naechster  ypos index   :=         ypos index d;
+                   ypos index a := index;
+ 
+. verkette ya mit yd :
+    verkette vorheriges ya mit yd;
+    neues token auf gleicher ypos;
+ 
+END PROC sortiere neue token ein;
+ 
+(***************************************************************)
+ 
+PROC drucke tokenspeicher
+             (INT CONST max ypos,
+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+IF druckspeicher ist nicht leer
+   THEN gehe zur ersten ypos; 
+        WHILE yd. ypos <= max ypos 
+        REP drucke token bei ypos;
+            gehe zur naechsten ypos; 
+        PER;
+        loesche gedruckte token;
+FI;
+ 
+. gehe zur ersten ypos :
+    ypos index d := erster ypos index d;
+
+. drucke token bei ypos :
+    IF yd. ypos >= - y start
+       THEN druck durchgang;
+            IF bold      pass THEN fett         durchgang FI;
+            IF underline pass THEN unterstreich durchgang FI;
+    FI;
+ 
+    . bold      pass : bit (pass, bold bit)
+ 
+    . underline pass : bit (pass, underline bit)
+ 
+. gehe zur naechsten ypos : 
+    IF ypos index d = letzter ypos index d
+       THEN loesche druckspeicher;
+            LEAVE drucke tokenspeicher;
+    FI;
+    ypos index d := yd. naechster ypos index;
+ 
+. loesche gedruckte token :
+        erster     ypos index d := ypos index d;
+    yd. vorheriger ypos index   := 0;
+ 
+. 
+  druck durchgang :
+    verschiebung := yd. ypos - d ypos;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    gehe zum ersten token dieser ypos; 
+    REP drucke token UNTIL kein token mehr vorhanden PER;
+    gib cr aus;
+ 
+    . drucke token :
+        IF NOT token passt in zeile THEN berechne token teil FI;
+        font wechsel wenn noetig;
+        x move mit modifikations ueberpruefung; 
+        IF token ist text token
+           THEN gib text token aus
+                  (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+           ELSE gib kommando token aus
+        FI;
+ 
+    . gib kommando token aus :
+        execute (write cmd, d token. text, 1, LENGTH d token. text)
+ 
+        . berechne token teil :
+            INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt);
+            INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; 
+            IF   d token. xpos < - x start
+                   AND d token. xpos + d token. breite > - x start 
+                 THEN berechne token teil von links
+            ELIF d token. xpos < papierbreite
+                   AND d token. xpos + d token. breite > papierbreite
+                 THEN berechne token teil nach rechts
+                 ELSE LEAVE drucke token
+            FI;
+ 
+        . berechne token teil von links :
+            rest          := min (x size, d token. xpos + d token. breite + x start);
+            d token. xpos := - x start;
+            IF rest <= fuenf punkte 
+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);
+                    d token. text   := anzahl punkte * punkt;
+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);
+               ELSE token pos    := LENGTH d token. text + 1;
+                    token breite := fuenf punkte;
+                    berechne token teil breite von hinten;
+                    change (d token. text, 1, token pos - 1, 5 * punkt);
+                    d token. breite := token breite;
+            FI;
+ 
+            . berechne token teil breite von hinten :
+                WHILE naechstes zeichen passt noch davor
+                REP token breite INCR zeichen breite; 
+                    token pos    DECR zeichen laenge;
+                PER;
+ 
+            . naechstes zeichen passt noch davor :
+                IF within kanji (d token. text, token pos - 1) 
+                   THEN zeichen laenge := 2
+                   ELSE zeichen laenge := 1
+                FI;
+                zeichen breite := char pitch (d token. font,
+                    subtext (d token. text, token pos - zeichen laenge, token pos - 1));
+                token breite + zeichen breite < rest
+ 
+        . berechne token teil nach rechts :
+            rest := papier breite - d token. xpos;
+            IF rest <= fuenf punkte 
+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);
+                    d token. text   := anzahl punkte * punkt;
+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);
+               ELSE token pos    := 0;
+                    token breite := fuenf punkte;
+                    berechne token teil breite von vorne;
+                    change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt);
+                    d token. breite := token breite;
+            FI;
+ 
+            . berechne token teil breite von vorne :
+                WHILE naechstes zeichen passt noch dahinter
+                REP token breite INCR zeichen breite; 
+                    token pos    INCR zeichen laenge;
+                PER;
+ 
+            . naechstes zeichen passt noch dahinter :
+                IF is kanji esc (d token. text SUB token pos + 1) 
+                   THEN zeichen laenge := 2
+                   ELSE zeichen laenge := 1
+                FI;
+                zeichen breite := char pitch (d token. font,
+                    subtext (d token. text, token pos + 1, token pos + zeichen laenge));
+                token breite + zeichen breite < rest
+ 
+.
+  fett durchgang :
+    reset bit (pass, bold bit);
+    gehe zum ersten token dieser ypos;
+    REP gib token nochmal aus UNTIL kein token mehr vorhanden PER;
+    schalte modifikationen aus wenn noetig;
+    gib cr aus;
+ 
+    . gib token nochmal aus :
+        INT CONST min verschiebung := bold offset (d token. font); 
+        d token. xpos INCR min verschiebung;
+        IF bit (d token. modifikationen, bold bit) AND
+               token passt in zeile AND token ist text token 
+          THEN verschiebung := d token. xpos - d xpos;
+               font wechsel wenn noetig;
+               schalte italics ein wenn noetig;
+               x move wenn noetig;
+               gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        FI;
+        d token. xpos DECR min verschiebung;
+ 
+        . schalte italics ein wenn noetig :
+            IF bit (d token. modifikationen, italics bit)
+               THEN neue modifikationen := modifikations werte (italics bit + 1);
+                    schalte modifikationen ein wenn noetig;
+               ELSE schalte modifikationen aus wenn noetig;
+            FI;
+ 
+. 
+  unterstreich durchgang :
+    INT VAR l xpos := 0;
+    reset bit (pass, underline bit);
+    schalte modifikationen aus wenn noetig;
+    gehe zum ersten token dieser ypos;
+    REP unterstreiche token UNTIL kein token mehr vorhanden PER;
+    gib cr aus;
+ 
+    . unterstreiche token :
+        IF token muss unterstrichen werden AND
+                token passt in zeile AND token ist text token 
+           THEN font wechsel wenn noetig;
+                berechne x move laenge; 
+                x move wenn noetig;
+                berechne unterstreich laenge;
+                unterstreiche;
+         FI;
+         l xpos := d token. xpos + d token. breite;
+ 
+         . token muss unterstrichen werden :
+             bit (d token. modifikationen, underline bit) OR
+                bit (d token. modifikationen fuer x move, underline bit)
+ 
+         . berechne x move laenge :
+             IF bit (d token. modifikationen fuer x move, underline bit) 
+                THEN verschiebung := l  xpos - d xpos
+                ELSE verschiebung := d token. xpos - d xpos
+             FI;
+
+         . berechne unterstreich laenge :
+             INT VAR unterstreich verschiebung;
+             IF bit (d token. modifikationen, underline bit) 
+                THEN unterstreich verschiebung := d token. xpos + 
+                                                d token. breite - d xpos
+                ELSE unterstreich verschiebung := d token. xpos - d xpos
+             FI;
+ 
+ 
+. gehe zum ersten token dieser ypos :
+    token index := yd. erster token index;
+    d token := t;
+ 
+. kein token mehr vorhanden :
+    token index := d token. naechster token  index;
+    IF token index = 0
+       THEN TRUE
+       ELSE d token := t;
+            FALSE
+    FI
+ 
+. token ist text token :
+    d token. offset index >= text token
+ 
+. token passt in zeile :
+    d token. xpos >= - x start AND
+         d token. xpos + d token. breite <= papier breite 
+ 
+. font wechsel wenn noetig :
+    IF d token. font <>  d font
+       THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+ 
+. schalte modifikationen ein wenn noetig :
+    IF d modifikationen <> neue modifikationen
+       THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+ 
+. schalte modifikationen aus wenn noetig :
+    IF d modifikationen <> 0
+       THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+
+. x move wenn noetig :
+    IF verschiebung <> 0
+       THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; 
+ 
+. gib cr aus :
+    execute (carriage return, "", d xpos, 0);
+    d xpos := 0;
+ 
+. 
+  x move mit modifikations ueberpruefung :
+    verschiebung := d token. xpos - d xpos;
+    IF verschiebung <> 0
+       THEN neue modifikationen := d token. modifikationen fuer x move;
+            schalte modifikationen ein wenn noetig;
+            x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    FI;
+    neue modifikationen := d token. modifikationen;
+    schalte modifikationen ein wenn noetig;
+ 
+. 
+  unterstreiche :
+    IF unterstreich verschiebung > 0
+       THEN disable stop; 
+            d xpos INCR unterstreich verschiebung;
+            execute (draw, "", unterstreich verschiebung, 0);
+            IF is error
+               THEN unterstreiche nach cr;
+            FI;
+            enable stop;
+    FI;
+ 
+    . unterstreiche nach cr :
+        clear error;
+        d xpos DECR unterstreich verschiebung;
+        verschiebung := d xpos;
+        gib cr aus;
+        x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+        d xpos INCR unterstreich verschiebung;
+        execute (draw, "", unterstreich verschiebung, 0);
+        IF is error
+           THEN clear error; 
+                d xpos DECR unterstreich verschiebung;
+                gib cr aus;
+                LEAVE unterstreich durchgang;
+        FI;
+
+END PROC drucke tokenspeicher;
+ 
+PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+    IF verschiebung <> 0
+       THEN disable stop; 
+            d ypos INCR verschiebung;
+            execute (move, "", 0, verschiebung);
+            IF is error
+               THEN clear error;
+                    d ypos DECR verschiebung;
+                    verschiebung := 0;
+            FI;
+            enable stop;
+    FI;
+ 
+END PROC y move;
+ 
+
+PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+    disable stop;
+    d xpos INCR verschiebung; 
+    execute (move, "", verschiebung, 0);
+    IF is error
+       THEN fuehre x move nach cr aus
+    FI;
+ 
+    . fuehre x move nach cr aus :
+        clear error;
+        schalte modifikationen aus wenn noetig;
+        gib cr aus;
+        IF d xpos <> 0
+           THEN execute (move, "", d xpos, 0);
+                IF is error
+                   THEN clear error;
+                        d xpos := 0;
+                FI
+        FI;
+        schalte modifikationen ein wenn noetig;
+ 
+        . gib cr aus :
+            execute (carriage return,  "", d xpos - verschiebung, 0);
+ 
+        . schalte modifikationen aus wenn noetig :
+            neue modifikationen := d modifikationen;
+            IF d modifikationen <> 0
+               THEN schalte modifikationen aus
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+            FI;
+ 
+        . schalte modifikationen ein wenn noetig :
+            IF d modifikationen <> neue modifikationen
+               THEN schalte modifikationen ein
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+            FI;
+ 
+END PROC x move;
+ 
+ 
+PROC schalte modifikationen ein 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     INT VAR index;
+     IF d modifikationen <> 0
+        THEN schalte modifikationen aus
+               (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+     FI;
+     d modifikationen := neue modifikationen;
+     FOR index FROM 1 UPTO anzahl modifikationen
+     REP IF bit (d modifikationen, modifikations bit)
+            THEN modifikation muss eingeschaltet werden
+         FI; 
+     PER;
+ 
+     . modifikations bit : index - 1
+ 
+     . modifikation muss eingeschaltet werden :
+         IF bit (modifikations modus, modifikations bit) 
+            THEN execute (on, "", modifikations werte (index), 0);
+                 IF is error
+                    THEN clear error;
+                         reset bit (modifikations modus, modifikations bit); 
+                         set bit   (pass,                modifikations bit);
+                 FI;
+            ELSE set bit (pass, modifikations bit); 
+         FI;
+ 
+END PROC schalte modifikationen ein;
+ 
+ 
+PROC schalte modifikationen aus 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     INT VAR index;
+     FOR index FROM 1 UPTO anzahl modifikationen
+     REP IF bit (d modifikationen, modifikations bit)
+            THEN modifikation muss ausgeschaltet werden
+         FI; 
+     PER;
+     d modifikationen := 0;
+ 
+     . modifikations bit : index - 1
+ 
+     . modifikation muss ausgeschaltet werden :
+         IF bit (modifikations modus, modifikations bit) 
+            THEN execute (off, "", modifikations werte (index), 0);
+                 IF is error THEN clear error FI;
+         FI;
+ 
+END PROC schalte modifikationen aus;
+ 
+ 
+PROC font wechsel 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     d font := d token. font;
+     get replacements (d font, replacements, replacement tabelle);
+     execute (type, "", d font, 0);
+     IF is error THEN font wechsel nach cr FI;
+     enable stop;
+ 
+     . font wechsel nach cr :
+         clear error;
+         verschiebung := d xpos;
+         gib cr aus;
+         execute (type, "", d font, 0);
+         IF NOT is error
+            THEN schalte modifikationen aus
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                 x move
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+         FI;
+ 
+        . gib cr aus :
+            execute (carriage return,  "", d xpos, 0);
+            d xpos := 0;
+ 
+END PROC font wechsel;
+ 
+ 
+PROC gib text token aus 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+  INT CONST token laenge := LENGTH d token. text;
+  INT VAR token pos := 1, alte token pos, summe := 0;
+  IF token laenge > 0
+     THEN REP alte token pos := token pos;
+              stranalyze (replacement tabelle, summe, 0,
+                          d token. text, token pos, token laenge,
+                          ausgang);
+              IF ausgang = 0 
+                 THEN gib token rest aus;
+                 ELSE gib token teil aus;
+                      gib ersatzdarstellung aus;
+              FI;
+          PER;
+  FI;
+ 
+  . gib token rest aus :
+      IF token laenge >= alte token pos
+         THEN execute (write text, d token. text, alte token pos, token laenge) FI;
+      d xpos INCR d token. breite;
+      LEAVE gib text token aus;
+
+  . gib token teil aus :
+      IF token pos >= alte token pos
+         THEN execute (write text, d token. text, alte token pos, token pos) FI;
+ 
+  . gib ersatzdarstellung aus :
+      IF ausgang = maxint
+         THEN ersatzdarstellung := extended replacement (d token. font,
+                d token. text SUB token pos + 1, d token. text SUB token pos + 2);
+              execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung);
+              tokenpos INCR 3;
+         ELSE IF ausgang < 0
+                 THEN ausgang := ausgang XOR (-32767-1);
+                      token pos INCR 1;
+              FI;
+              execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang));
+              token pos INCR 2;
+      FI;
+ 
+      . ersatzdarstellung : par1
+ 
+END PROC gib text token aus;
+ 
+ 
+PROC schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+
+enable stop;
+gebe restliche token aus;
+seiten ende kommando;
+
+. gebe restliche token aus :
+    IF erster ypos index d <> 0
+       THEN drucke tokenspeicher (maxint,
+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    FI;
+    rest := papier laenge - d ypos;
+
+. seiten ende kommando :
+    seite ist offen := FALSE;
+    a ypos          := top margin;
+    aktuelle spalte := 1;
+    close (page, rest);
+ 
+END PROC schliesse seite ab;
+ 
+ 
+PROC eroeffne seite (INT CONST x wanted, y wanted,
+                     PROC (INT CONST, INT VAR, INT VAR) open ) :
+ 
+IF vor erster seite THEN eroeffne druck FI;
+seiten anfang kommando;
+initialisiere neue seite;
+
+. eroeffne druck :
+    open (document, x size, y size);
+    vor erster seite := FALSE;
+    d font           := -1;
+    d modifikationen := 0;
+
+. seiten anfang kommando :
+    x start := x wanted;
+    y start := y wanted;
+    open (page, x start, y start);
+    gedruckte seiten INCR 1;
+    seite ist offen := TRUE;
+
+. initialisiere neue seite :
+    INT CONST dif left margin := x wanted - x start - left margin + indentation,
+              dif top  margin := y wanted - y start - top  margin; 
+    IF dif left margin <> 0
+       THEN erstes tab token := 1;
+            verschiebe token xpos (dif left margin);
+            a xpos      INCR dif left margin;
+            left margin INCR dif left margin;
+    FI;
+    IF dif top margin <> 0
+       THEN verschiebe token ypos (dif top margin);
+            a ypos      INCR dif top margin;
+            top margin  INCR dif top margin;
+    FI;
+    d xpos := 0;
+    d ypos := 0;
+    IF seitenlaenge <= papierlaenge
+       THEN seitenlaenge := top margin + pagelength; 
+       ELSE seitenlaenge DECR papierlaenge;
+    FI;
+    papierlaenge := y size - y start;
+    papierbreite := x size - x start;
+
+END PROC eroeffne seite;
+ 
+(****************************************************************)
+ 
+PROC elan fuss und kopf (INT CONST fuss oder kopf,
+                PROC (INT CONST, INT CONST) close,
+                PROC (INT CONST, INT VAR, INT VAR) open,
+                PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+IF fuss oder kopf <= 0 THEN elan fuss FI;
+IF fuss oder kopf >= 0 THEN elan kopf FI;
+ 
+.
+  elan fuss :
+    y move zur fusszeile;
+    drucke elan fuss;
+    close page cmd;
+ 
+. y move zur fusszeile :
+    execute (carriage return,  "", d xpos, 0);
+    d xpos := 0;
+    verschiebung := rest auf seite - font hoehe;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. drucke elan fuss :
+    IF bottom label = ""
+       THEN seiten nr := ""
+       ELSE seiten nr := bottom label;
+            seiten nr CAT "/";
+    FI;
+    seiten nr CAT text (gedruckte seiten);
+    elan text := seiten nr;
+    elan text CAT "   ";
+    elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text);
+    elan text CAT dateiname;
+    elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3);
+    elan text CAT "   ";
+    elan text CAT seiten nr;
+    IF LENGTH elan text > max zeichen zeile
+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;
+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+ 
+    . seiten nr : par1
+ 
+. close page cmd :
+    close (page, papierlaenge - d ypos);
+    seite ist offen := FALSE;
+
+.
+  elan kopf :
+    open page cmd ;
+    y move zur kopfzeile;
+    drucke elan kopf;
+
+. open page cmd :
+    x start         := x wanted;
+    y start         := y wanted;
+    open (page, x start, y start);
+    IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI;
+    gedruckte seiten INCR 1;
+    seite ist offen := TRUE;
+    top  margin     := y wanted - y start;
+    left margin     := x wanted - x start;
+    rest auf seite  := pagelength;
+    papierlaenge    := y size - y start;
+    d ypos          := 0; 
+    d xpos          := 0;
+ 
+. y move zur kopf zeile :
+    verschiebung := top margin;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    IF verschiebung = 0 THEN rest auf seite INCR top margin FI;
+ 
+. drucke elan kopf :
+    elan text :=  headline pre;
+    elan text CAT date;
+    elan text CAT headline post;
+    elan text CAT datei name;
+    IF LENGTH elan text > max zeichen zeile
+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;
+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+    cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+ 
+ENDPROC elan fuss und kopf;
+ 
+ 
+PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+linker rand wenn noetig;
+d token. breite := LENGTH elan text * einrueckbreite;
+gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. linker rand wenn noetig :
+    IF left margin > 0
+       THEN disable stop;
+            d xpos := left margin;
+            execute (move, "", left margin, 0);
+            IF is error 
+               THEN clear error;
+                    d xpos := 0;
+            FI;
+            enable stop;
+    FI;
+ 
+END PROC gib elan text aus;
+ 
+ 
+PROC cr plus lf (INT CONST anzahl,
+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : 
+ 
+gib cr aus;
+gib lf aus;
+rest auf seite DECR verschiebung;
+ 
+. gib cr aus :
+    execute (carriage return,  "", d xpos, 0);
+    d xpos := 0;
+ 
+. gib lf aus :
+    verschiebung := anzahl * font hoehe;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+END PROC cr plus lf ; 
+ 
+ 
+END PACKET eumel printer;
+
diff --git a/system/multiuser/1.7.5/src/font store b/system/multiuser/1.7.5/src/font store
new file mode 100644
index 0000000..ebb6a62
--- /dev/null
+++ b/system/multiuser/1.7.5/src/font store
@@ -0,0 +1,695 @@
+PACKET font store                                 (* Autor : Rudolf Ruland *) 
+                                                  (* Stand : 18.02.86      *) 
+        DEFINES font table, 
+                list font tables,
+                list fonts, 
+ 
+                x step conversion,
+                y step conversion,
+                on string,
+                off string,
+ 
+                font,
+                font exists, 
+                next larger font exists, 
+                next smaller font exists,
+                font lead,
+                font height,
+                font depth,
+                indentation pitch,
+                char pitch, 
+                extended char pitch,
+                replacement,
+                extended replacement,
+                font string,
+                y offsets,
+                bold offset,
+                get font, 
+                get replacements :
+ 
+ 
+LET font task       = "configurator";
+ 
+LET ack             =    0,
+    fetch code      =   11,
+    all code        =   17,
+ 
+    underline       =    1,
+    bold            =    2,
+    italics         =    4,
+    reverse         =    8,
+
+    first font      =    1,
+    max fonts       =   50,
+    max extensions  =  120, 
+    font table type = 3009,
+ 
+    FONTTABLE = STRUCT (
+ 
+        THESAURUS font names, 
+ 
+        TEXT replacements, font name links,
+             extension chars, extension indexes, 
+
+        ROW 4 TEXT on strings, off strings,
+ 
+        REAL x unit, y unit,
+ 
+        ROW 256 INT replacements table,
+ 
+        INT last font, last extension
+ 
+        ROW max fonts STRUCT (
+            TEXT font string, font name indexes, replacements,
+                 extension chars, extension indexes, y offsets,
+            ROW 256 INT pitch table, replacements table,
+            INT  indentation pitch, font lead, font height, font depth,
+                 next larger font, next smaller font, bold offset ) fonts ,
+ 
+        ROW max extensions STRUCT (
+            TEXT replacements,
+            ROW 256 INT pitch table, replacements table,
+            INT std pitch                                     ) extensions ,
+ 
+                        );
+ 
+INT VAR font nr, help, reply, list index, last font,
+        index, char code 1, link nr, font store replacements length; 
+ 
+TEXT VAR fo table := "", old font table, font name links, buffer;
+ 
+THESAURUS VAR font tables, font names;
+ 
+INITFLAG VAR in this task := FALSE, 
+             init font ds := FALSE,
+             init ds      := FALSE;
+ 
+BOUND FONTTABLE VAR font store;
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;
+ 
+BOUND THESAURUS VAR all msg;
+ 
+BOUND TEXT VAR error msg;
+ 
+DATASPACE VAR font ds, ds;
+ 
+(*****************************************************************) 
+ 
+PROC font table (TEXT CONST new font table) :
+
+  disable stop;
+  get font table (new font table);
+  in this task := NOT (font table = "" OR type (font ds) <> font table type);
+ 
+END PROC font table;
+ 
+ 
+PROC get font table (TEXT CONST new font table) :
+ 
+  enable stop;
+  buffer := new font table;
+  change all (buffer, " ", "");
+  IF   exists (buffer) CAND type (old (buffer)) = font table type
+       THEN get font table from own task 
+  ELIF exists task (font task)
+       THEN get font table from font task 
+       ELSE errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")
+  FI;
+ 
+  . get font table from own task :
+      IF NOT initialized (init ds) THEN ds := nilspace FI;
+      forget (ds); ds := old (buffer);
+      new font store;
+ 
+  . get font table from font task :
+      fetch font table (buffer);
+      IF type (ds) <> font table type 
+         THEN forget (ds);
+              errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")
+      FI;
+      new font store;
+ 
+      . new font store :
+          disable stop;
+          IF NOT initialized (init font ds) THEN font ds := nilspace FI;
+          forget (font ds);
+          font ds := ds;
+          forget (ds);
+          font store      := font ds;
+          fo table        := buffer;
+          font names      := font store. font names;
+          font name links := font store. font name links;
+          last font       := font store. last font;
+          font store replacements length := LENGTH font store. replacements;
+
+END PROC get font table;
+ 
+ 
+TEXT PROC font table :
+ 
+  fo table
+ 
+END PROC  font table;
+ 
+ 
+PROC list font tables :
+ 
+  enable stop; 
+  font tables := empty thesaurus;
+  font tables in own task;
+  font tables in font task;
+  note font tables;
+  note edit;
+ 
+  . font tables in own task :
+      list index := 0;
+      REP get (all, buffer, list index);
+          IF buffer = "" THEN LEAVE font tables in own task FI;
+          IF type (old (buffer)) = font table type
+                  AND NOT (font tables CONTAINS buffer)
+            THEN insert (font tables, buffer) FI;
+      PER;
+ 
+  . font tables in font task :
+      all file names from font task;
+      THESAURUS CONST names := all msg;
+      list index := 0;
+      REP get (names, buffer, list index);
+          IF buffer = ""
+             THEN forget (ds);
+                  LEAVE font tables in font task
+          FI;
+          fetch font table (buffer);
+          IF type (ds) = font table type
+                  AND NOT (font tables CONTAINS buffer) 
+             THEN insert (font tables, buffer) FI;
+      PER;
+ 
+  . note font tables :
+      list index := 0;
+      REP get (font tables, buffer, list index);
+          IF buffer = ""
+             THEN LEAVE note font tables;
+             ELSE note (buffer); note line;
+          FI;
+      PER;
+ 
+END PROC list font tables;
+ 
+ 
+PROC list fonts (TEXT CONST name):
+ 
+  initialize if necessary;
+  disable stop;
+  old font table := font table;
+  font table (name);
+  list fonts;
+  font table (old font table);
+ 
+END PROC list fonts;
+ 
+ 
+PROC list fonts :
+ 
+  enable stop;
+  initialize if necessary;
+  note font table;
+  FOR font nr FROM first font UPTO last font REP note font PER;
+  note edit;
+
+. note font table :
+    note ("FONTTABELLE  :  """); note (font table);              note (""";"); noteline; 
+    note ("  x einheit  =  ");   note (text (font store. x unit)); note (";"); noteline; 
+    note ("  y einheit  =  ");   note (text (font store. y unit)); note (";"); noteline; 
+ 
+. note font :
+    cout (font nr);
+    noteline;
+    note ("  FONT  :  ");                note font names;                       note (";"); noteline; 
+    note ("    einrueckbreite   =  ");   note (text(font. indentation pitch));  note (";"); noteline;
+    note ("    durchschuss      =  ");   note (text(font. font lead));          note (";"); noteline;
+    note ("    fonthoehe        =  ");   note (text(font. font height));        note (";"); noteline; 
+    note ("    fonttiefe        =  ");   note (text(font. font depth));         note (";"); noteline; 
+    note ("    groesserer font  =  """); note (next larger);                  note (""";"); noteline;
+    note ("    kleinerer font   =  """); note (next smaller);                 note (""";"); noteline;
+ 
+    . font         : font store. fonts (font nr) 
+    . next larger  : name (font store. font names, font. next larger font)
+    . next smaller : name (font store. font names, font. next smaller font)
+ 
+    . note font names :
+        INT VAR index;
+        note ("""");
+        note (name (font names, font. font name indexes ISUB 1));
+        note ("""");
+        FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2
+        REP note (",  """);
+            note (name (font names, font. font name indexes ISUB index));
+            note ("""");
+        PER;
+ 
+END PROC list fonts;
+ 
+ 
+INT PROC x step conversion (REAL CONST cm) :
+ 
+  initialize if necessary;
+  IF cm >= 0.0
+     THEN int (cm * font store. x unit + 0.5 )
+     ELSE int (cm * font store. x unit - 0.5 )
+  FI
+ 
+END PROC x step conversion;
+ 
+ 
+REAL PROC x step conversion (INT CONST steps) :
+ 
+  initialize if necessary;
+  real (steps) / font store. x unit
+ 
+END PROC x step conversion;
+ 
+ 
+INT PROC y step conversion (REAL CONST cm) :
+ 
+  initialize if necessary;
+  IF cm >= 0.0
+     THEN int (cm * font store. y unit + 0.5 )
+     ELSE int (cm * font store. y unit - 0.5 )
+  FI
+ 
+END PROC y step conversion;
+ 
+ 
+REAL PROC y step conversion (INT CONST steps) :
+ 
+  initialize if necessary;
+  real (steps) / font store. y unit
+ 
+END PROC y step conversion;
+ 
+ 
+TEXT PROC on string (INT CONST modification) :
+ 
+  initialize if necessary;
+  SELECT modification OF
+    CASE underline : font store. on strings (1)
+    CASE bold      : font store. on strings (2)
+    CASE italics   : font store. on strings (3)
+    CASE reverse   : font store. on strings (4)
+         OTHERWISE : errorstop ("unzulaessige Modifikation"); ""
+  END SELECT
+ 
+END PROC on string;
+ 
+ 
+TEXT PROC  off string (INT CONST modification) :
+ 
+  initialize if necessary;
+  SELECT modification OF
+    CASE underline : font store.  off strings (1)
+    CASE bold      : font store.  off strings (2)
+    CASE italics   : font store.  off strings (3)
+    CASE reverse   : font store.  off strings (4)
+         OTHERWISE : errorstop ("unzulaessige Modifikation"); ""
+  END SELECT
+ 
+END PROC  off string;
+ 
+ 
+INT PROC font (TEXT CONST font name) :
+ 
+  initialize if necessary;
+  buffer := font name;
+  change all (buffer, " ", "");
+  INT CONST link nr := link (font names, buffer)
+  IF link nr <> 0
+     THEN font name links ISUB link nr
+     ELSE 0
+  FI
+ 
+END PROC font;
+ 
+ 
+TEXT PROC font (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN name (font names, fonts. font name indexes ISUB 1)
+     ELSE ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font;
+ 
+ 
+BOOL PROC font exists (TEXT CONST font name) :
+ 
+  font (font name) <> 0
+ 
+END PROC font exists;
+ 
+ 
+BOOL PROC next larger font exists(INT CONST font number,
+                                  INT VAR   next larger font) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN next larger font := fonts. next larger font;
+          IF next larger font <> 0
+             THEN next larger font := font name links ISUB next larger font;
+                  next larger font <> 0
+             ELSE FALSE
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht");
+          FALSE
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC next larger font exists;
+ 
+ 
+BOOL PROC next smaller font exists (INT CONST font number,
+                                    INT VAR   next smaller font) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN next smaller font := fonts. next smaller font;
+          IF next smaller font <> 0
+             THEN next smaller font := font name links ISUB next smaller font;
+                  next smaller font <> 0
+             ELSE FALSE
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht");
+          FALSE
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC next smaller font exists;
+ 
+ 
+INT PROC font lead (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font lead 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font lead; 
+ 
+ 
+INT PROC font height (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font height
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font height;
+ 
+ 
+INT PROC font depth (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font depth
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font depth;
+ 
+ 
+INT PROC indentation pitch (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. indentation pitch
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC indentation pitch;
+ 
+ 
+INT PROC char pitch (INT  CONST font number,
+                     TEXT CONST char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN INT CONST pitch := font. pitch table (code (char SUB 1) + 1);
+          IF   pitch = maxint
+               THEN extended char pitch (font number, char SUB 1, char SUB 2)
+          ELIF pitch < 0
+               THEN pitch XOR (-maxint-1) 
+               ELSE pitch
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . font :      font store. fonts (font number)
+ 
+END PROC char pitch;
+ 
+ 
+INT PROC extended char pitch (INT  CONST font number,
+                               TEXT CONST esc char, char) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN extension. pitch table (code (char) + 1) 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . font      : font store. fonts (font number)
+ 
+  . extension : font store. extensions (extension number)
+ 
+  . extension number :
+      INT CONST index := pos (font. extension chars, esc char);
+      IF index = 0
+         THEN errorstop ("""" + esc char + char + """ hat keine Erweiterung") FI; 
+      font. extension indexes ISUB index
+ 
+END PROC extended char pitch;
+ 
+ 
+TEXT PROC replacement (INT  CONST font number,
+                       TEXT CONST char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN link nr := font. replacements table (code (char SUB 1) + 1);
+          IF link nr = maxint
+             THEN extended replacement (font number, char SUB 1, char SUB 2)
+             ELSE process font replacement
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . font      : font store. fonts (font number)
+ 
+  . process font replacement :
+      IF link nr < 0 THEN link nr := link nr XOR (-maxint-1) FI;
+      IF   link nr = 0
+           THEN char
+      ELIF link nr > font store replacements length
+           THEN link nr DECR font store replacements length;
+                replacement text (font. replacements)
+           ELSE replacement text (font store. replacements)
+      FI
+ 
+END PROC replacement;
+ 
+ 
+TEXT PROC extended replacement (INT  CONST font number,
+                                 TEXT CONST esc char, char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN process extension replacement
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . process extension replacement :
+      determine extension link nr;
+      IF   link nr = 0
+           THEN char
+      ELIF link nr > font store extension replacements length 
+           THEN link nr DECR font store extension replacements length;
+                replacement text (font extension. replacements)
+           ELSE replacement text (font store extension. replacements)
+      FI
+ 
+      . determine extension link nr :
+          INT CONST index 1 := pos (font. extension chars, esc char); 
+          INT CONST index 2 := pos (font store. extension chars, esc char);
+          IF   index 1 <> 0
+               THEN link nr := font extension. replacements table (code (char) + 1); 
+          ELIF index 2 <> 0
+               THEN link nr := font store extension. replacements table (code (char) + 1); 
+               ELSE errorstop ("""" + esc char + char + """ hat keine Erweiterung") 
+          FI;
+ 
+      . font extension              : font store. extensions (font extension number)
+ 
+      . font extension number       : font. extension indexes ISUB index 1
+ 
+      . font                        : font store. fonts (font number)
+ 
+      . font store extension        : font store. extensions (font store extension number)
+ 
+      . font store extension number : font store. extension indexes ISUB index 2
+ 
+      . font store extension replacements length :
+          IF index 2 = 0
+             THEN 0
+             ELSE LENGTH font store extension. replacements
+          FI
+ 
+END PROC extended replacement;
+ 
+ 
+TEXT PROC replacement text (TEXT CONST replacements) :
+ 
+  buffer := subtext (replacements, link nr + 1,
+                                   link nr + code (replacements SUB link nr));
+  buffer
+ 
+END PROC replacement text;
+ 
+ 
+TEXT PROC font string (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font string
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font string;
+ 
+ 
+TEXT PROC y offsets (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. y offsets
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC y offsets;
+ 
+ 
+INT PROC bold offset (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. bold offset
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC bold offset;
+ 
+ 
+PROC get font (INT CONST font number,
+               INT VAR indentation pitch, font lead, font height, font depth,
+               ROW 256 INT VAR pitch table ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN indentation pitch := fonts. indentation pitch;
+          pitch table       := fonts. pitch table;
+          font lead         := fonts. font lead; 
+          font height       := fonts. font height;
+          font depth        := fonts. font depth; 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 
+  FI;
+ 
+  . fonts : font store. fonts (font number) 
+ 
+END PROC get font;
+ 
+ 
+PROC get replacements (INT CONST font number, 
+                       TEXT VAR replacements,
+                       ROW 256 INT VAR replacements table) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN replacements       := font store. replacements;
+          replacements      CAT fonts. replacements;
+          replacements table := fonts. replacements table;
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 
+  FI;
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC get replacements;
+ 
+ 
+PROC initialize if necessary :
+
+  IF NOT initialized (in this task)
+     THEN IF font table = ""
+             THEN in this task := FALSE;
+                  errorstop ("Fonttabelle noch nicht eingestellt");
+             ELSE font table (font table);
+          FI;
+  FI;
+
+END PROC initialize if necessary; 
+ 
+ 
+PROC fetch font table (TEXT CONST font table name) :
+ 
+  enable stop;
+  IF NOT initialized (init ds) THEN ds := nilspace FI;
+  forget (ds); ds := nilspace;
+  msg             := ds;
+  msg. name       := font table name;
+  msg. write pass := "";
+  msg. read  pass := "";
+  call (task (font task), fetch code, ds, reply);
+  IF reply <> ack
+     THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht")
+  FI;
+ 
+END PROC fetch font table;
+ 
+ 
+PROC all file names from font task :
+ 
+  enable stop;
+  IF NOT initialized (init ds) THEN ds := nilspace FI;
+  forget (ds); ds := nilspace;
+  call (task (font task), all code, ds, reply);
+  IF reply <> ack
+     THEN error msg := ds;
+          errorstop (error msg);
+     ELSE all msg := ds
+  FI;
+ 
+END PROC all file names from font task;
+ 
+ 
+END PACKET font store;
+
diff --git a/system/multiuser/1.7.5/src/global manager b/system/multiuser/1.7.5/src/global manager
new file mode 100644
index 0000000..b3d64cc
--- /dev/null
+++ b/system/multiuser/1.7.5/src/global manager
@@ -0,0 +1,683 @@
+(* ------------------- VERSION 19     16.05.86 ------------------- *)
+PACKET global manager DEFINES                  (* Autor: J.Liedtke *)
+ 
+  ALL ,
+  begin password ,
+  call ,
+  continue channel ,
+  erase ,
+  exists ,
+  fetch , 
+  free global manager ,
+  free manager ,
+  global manager ,
+  list ,
+  manager message ,
+  manager question ,
+  save , 
+  std manager :
+ 
+ 
+LET ack                  = 0 ,
+    nak                  = 1 ,
+    error nak            = 2 ,
+    message ack          = 3 ,
+    question ack         = 4 ,
+    second phase ack     = 5 ,
+    false code           = 6 , 
+
+    begin code           = 4 ,
+    password code        = 9 ,
+    fetch code           = 11 ,
+    save code            = 12 ,
+    exists code          = 13 ,
+    erase code           = 14 ,
+    list code            = 15 ,
+    all code             = 17 ,
+    free code            = 20 ,
+    continue code        = 100,
+ 
+
+    error pre            = ""7""13""10""5"FEHLER : " , 
+    cr lf                = ""13""10"" ;
+
+INT VAR reply , order , last order, phase number ;
+ 
+DATASPACE VAR ds := nilspace ;
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+BOUND TEXT VAR reply msg ;
+BOUND THESAURUS VAR thesaurus msg ;
+ 
+TASK VAR order task, last order task ; 
+
+FILE VAR list file ;
+ 
+TEXT VAR error message buffer := "" 
+        ,record 
+        ,received name 
+        ,create son password := "" 
+        ,save file name 
+        ,save write password 
+        ,save read password 
+        ;
+ 
+ 
+PROC fetch (TEXT CONST file name) :
+
+  fetch (file name, father)
+ 
+ENDPROC fetch ;
+ 
+PROC fetch (TEXT CONST file name, TASK CONST manager) :
+ 
+  enable stop ;
+  last param (file name) ;
+  IF NOT exists (file name) 
+    THEN call (fetch code, file name, manager)
+  ELIF overwrite permitted
+    THEN call (fetch code, file name, manager) ;
+         forget (file name, quiet) 
+  ELSE LEAVE fetch
+  FI ;
+  IF reply = ack 
+    THEN disable stop ;
+         copy (ds, file name) ; 
+         forget (ds)
+    ELSE forget (ds) ; 
+         errorstop ("Task """ + name (manager) + """antwortet nicht mit ack")
+  FI . 
+ 
+overwrite permitted :
+  say ("eigene Datei """) ;
+  say (file name) ;
+  yes (""" ueberschreiben") .
+
+ENDPROC fetch ;
+
+PROC fetch (DATASPACE VAR dest, TEXT CONST file name, TASK CONST manager) :
+
+  disable stop ;
+  call (fetch code, file name, manager) ;
+  dest := ds ;
+  forget (ds)
+
+ENDPROC fetch ;
+
+
+PROC save :
+ 
+  save (last param)
+ 
+ENDPROC save ;
+ 
+PROC save (TEXT CONST file name) :
+ 
+  save (file name, father)
+ 
+ENDPROC save ;
+ 
+PROC save (TEXT CONST file name, TASK CONST manager) :
+ 
+  last param (file name) ;
+  call (save code, file name, old (file name), manager) ; 
+  forget (ds) 
+ 
+ENDPROC save ;
+
+PROC save (DATASPACE CONST source, TEXT CONST file name, TASK CONST manager):
+
+  call (save code, file name, source, manager) ; 
+  forget (ds) 
+
+ENDPROC save ;
+
+
+BOOL PROC exists (TEXT CONST file name, TASK CONST manager) :
+
+  call (exists code, file name, manager) ; 
+  forget (ds) ;
+  reply = ack .
+
+ENDPROC exists ;
+
+
+PROC erase :
+ 
+  erase (last param)
+ 
+ENDPROC erase ;
+ 
+PROC erase (TEXT CONST file name) :
+ 
+  erase (file name, father)
+ 
+ENDPROC erase ;
+ 
+PROC erase (TEXT CONST file name, TASK CONST manager) :
+ 
+  call (erase code, file name, manager) ; 
+  forget (ds)
+
+ENDPROC erase ;
+
+ 
+PROC list (TASK CONST manager) :
+ 
+  IF manager = myself
+    THEN list
+    ELSE list from manager
+  FI .
+
+list from manager :
+  call (list code, "", manager) ;
+  IF reply = ack
+    THEN DATASPACE VAR save ds := ds ; 
+         forget (ds) ; 
+         list file := sequential file (modify, save ds) ;
+         insert station and name of task in headline if possible ; 
+         show (list file) ;
+         forget (save ds)
+    ELSE forget (ds) 
+  FI . 
+ 
+insert station and name of task in headline if possible :
+  IF headline (list file) = "" 
+    THEN headline (list file, station number if there is one 
+                              + "  Task : " + name (manager))
+  FI . 
+ 
+station number if there is one : 
+  IF station (manager) > 0 
+    THEN "Station : " + text (station (manager)) 
+    ELSE "" 
+  FI . 
+ 
+ENDPROC list ;
+        
+PROC list (FILE VAR f, TASK CONST manager) :
+ 
+  IF manager = myself
+    THEN list (f)
+    ELSE list from manager
+  FI .
+
+list from manager :
+  call (list code, "", manager) ;
+  IF reply = ack
+    THEN DATASPACE VAR save ds := ds ; 
+         forget (ds) ; 
+         list file := sequential file (input, save ds) ;
+         copy attributes (list file, f) ;
+         insert station and name of task in headline if possible ;
+         REP
+           getline (list file, record) ;
+           putline (f, record)
+         UNTIL eof (list file) PER ; 
+         forget (save ds)
+    ELSE forget (ds) 
+  FI . 
+
+insert station and name of task in headline if possible :
+  IF headline (list file) = "" 
+    THEN headline (list file, station number if there is one 
+                              + "  Task : " + name (manager))
+  FI . 
+ 
+station number if there is one : 
+  IF station (manager) > 0 
+    THEN "Station : " + text (station (manager)) 
+    ELSE "" 
+  FI . 
+ 
+ENDPROC list ;
+
+THESAURUS OP ALL (TASK CONST manager) :
+
+  THESAURUS VAR result ;
+  IF manager = myself
+    THEN result := all
+    ELSE get all from manager
+  FI ;
+  result .
+
+get all from manager :
+  call (all code, "", manager) ;
+  IF reply = ack
+    THEN get result thesaurus
+    ELSE result := empty thesaurus
+  FI .
+
+get result thesaurus :
+  thesaurus msg := ds ;
+  result := CONCR (thesaurus msg) ;
+  forget (ds) .
+ 
+ENDOP ALL ; 
+ 
+ 
+PROC call (INT CONST op code, TEXT CONST file name, TASK CONST manager) :
+ 
+  DATASPACE VAR dummy space ;
+  call (op code, file name, dummy space, manager) 
+
+ENDPROC call ;
+
+PROC call (INT CONST op code, TEXT CONST file name,
+           DATASPACE CONST save space, TASK CONST manager) :
+ 
+  enable stop ;
+  send first order first time ;
+  send second order if required first time ;
+  WHILE order restart required REP
+    pause (10) ;
+    send first order (op code, file name, manager) ;
+    send second order if required
+  PER ;
+  error or message if required .
+
+send first order first time :
+  send first order (op code, file name, manager) ;
+  WHILE order restart required REP
+    pause (10) ;
+    send first order (op code, file name, manager)
+  PER .
+
+send second order if required first time :
+  IF reply = question ack
+    THEN reply msg := ds ;
+         IF NOT yes (reply msg)
+           THEN LEAVE call 
+           ELSE send second order (op code, file name, save space, manager)
+         FI
+  ELIF reply = second phase ack
+    THEN send second order (op code, file name, save space, manager)
+  FI .
+
+send second order if required :
+    IF reply = second phase ack OR reply = question ack
+      THEN send second order (op code, file name, save space, manager)
+    FI .
+
+error or message if required :
+  IF reply = message ack
+    THEN reply msg := ds ;
+         say (reply msg) ;
+         say (cr lf)
+  ELIF reply = error nak
+    THEN reply msg := ds ;
+         errorstop (reply msg)
+  FI .
+
+order restart required : reply = nak .
+
+ENDPROC call ;
+
+PROC send first order (INT CONST op code, TEXT CONST file name,
+                       TASK CONST manager) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  msg := ds ;
+  msg.name := file name ;
+  msg.write pass := write password ;
+  msg.read pass  := read password ;
+  call (manager, op code, ds, reply) ;
+  IF reply < 0
+    THEN errorstop ("Task nicht vorhanden")
+  FI .
+
+ENDPROC send first order ;
+
+PROC send second order (INT CONST op code, TEXT CONST file name,
+                        DATASPACE CONST save space, TASK CONST manager) :
+
+  IF op code = save code
+    THEN send save space
+    ELSE send first order (second phase ack, file name, manager)
+  FI .
+
+send save space :
+  forget (ds) ;
+  ds := save space ;
+  call (manager, second phase ack, ds, reply) .
+
+ENDPROC send second order ;
+ 
+ 
+PROC global manager :
+
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager)
+
+ENDPROC global manager ;
+
+PROC free global manager :
+
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) free manager)
+
+ENDPROC free global manager ;
+
+
+PROC global manager (PROC (DATASPACE VAR, 
+                     INT CONST, INT CONST, TASK CONST) manager) :
+ 
+  DATASPACE VAR local ds := nilspace ;
+  break ; 
+  set autonom ;
+  disable stop ;
+  command dialogue (FALSE) ;
+  remember heap size ;
+  last order task := niltask ;
+  REP
+    forget (local ds) ; 
+    wait (local ds, order, order task) ;
+    IF order <> second phase ack
+      THEN prepare first phase ;
+           manager (local ds, order, phase number, order task)
+    ELIF order task = last order task
+      THEN prepare second phase ;
+           manager (local ds, order, phase number, order task)
+    ELSE   send nak
+    FI ;
+    send error if necessary ;
+    collect heap garbage if necessary
+  PER .
+
+prepare first phase :
+  phase number := 1 ;
+  last order := order ;
+  last order task := order task .
+
+prepare second phase :
+  phase number INCR 1 ;
+  order := last order .
+
+send nak :
+  forget (local ds) ;
+  local ds := nilspace ;
+  send (order task, nak, local ds) .
+
+send error if necessary :
+  IF is error
+    THEN forget (local ds) ;
+         local ds := nilspace ;
+         reply msg := local ds ;
+         CONCR (reply msg) := error message ;
+         clear error ;
+         send (order task, error nak, local ds)
+  FI .
+ 
+remember heap size :
+  INT VAR old heap size := heap size .
+
+collect heap garbage if necessary :
+  IF heap size > old heap size + 8
+    THEN collect heap garbage ;
+         old heap size := heap size
+  FI .
+
+ENDPROC global manager ;
+
+PROC std manager (DATASPACE VAR ds, 
+                  INT CONST order, phase, TASK CONST order task) :
+
+  IF order task < myself OR order = begin code OR order task = supervisor
+    THEN free manager (ds, order, phase, order task)
+    ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """")
+  FI .
+
+ENDPROC std manager ;
+
+PROC free manager (DATASPACE VAR ds, 
+                   INT CONST order, phase, TASK CONST order task):
+
+  enable stop ;
+  IF   order > continue code   AND
+       order task = supervisor THEN y maintenance
+  ELIF order = begin code      THEN y begin
+  ELSE                              file manager order
+  FI .
+
+file manager order :
+  get message text if there is one ;
+  SELECT order OF
+    CASE fetch code       : y fetch
+    CASE save code        : y save
+    CASE exists code      : y exists
+    CASE erase code       : y erase
+    CASE list code        : y list
+    CASE all code         : y all
+    OTHERWISE errorstop ("falscher Auftrag fuer Task """+name(myself)+"""")
+  ENDSELECT .
+ 
+get message text if there is one :
+  IF order >= fetch code AND order <= erase code AND phase = 1
+    THEN msg := ds ;
+         received name := msg.name
+  FI .
+ 
+y begin :
+  BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg := ds ;
+  IF create son password = sv msg.tpass AND create son password <> "-"
+    THEN create son task
+  ELIF sv msg.tpass = ""
+    THEN ask for password
+  ELSE   errorstop ("Passwort falsch")
+  FI .
+
+create son task :
+  begin (ds, PROC std begin, reply) ;
+  send (order task, reply, ds) .
+
+ask for password :
+  send (order task, password code, ds) .
+
+
+y fetch :
+  IF read permission (received name, msg.read pass)
+    THEN forget (ds) ;
+         ds := old (received name) ;
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y erase :
+  msg := ds ;
+  received name := msg.name ;
+  IF NOT exists (received name)
+    THEN manager message ("""" + received name + """ existiert nicht", order task)
+  ELIF phase = 1
+    THEN manager question ("""" + received name + """ loeschen", order task)
+  ELIF write permission (received name, msg.write pass)
+    THEN forget (received name, quiet) ;
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y save :
+  IF phase = 1
+    THEN y save pre
+    ELSE y save post
+  FI .
+
+y save pre :
+  IF write permission (received name, msg.write pass)
+    THEN save file name := received name ;
+         save write password  := msg.write pass ;
+         save read password   := msg.read pass ;
+         IF exists (received name)
+           THEN manager question 
+                ("""" + received name + """ ueberschreiben", order task)
+           ELSE send (order task, second phase ack, ds) 
+         FI
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y save post :
+  forget (save file name, quiet) ;
+  copy (ds, save file name) ;
+  enter password (save file name, save write password, save read password) ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) ;
+  cover tracks of save passwords .
+
+cover tracks of save passwords :
+  replace (save write password, 1, LENGTH save write password * " ") ;
+  replace (save read password, 1, LENGTH save read password * " ") .
+
+y exists :
+  IF exists (received name)
+    THEN send (order task, ack, ds)
+    ELSE send (order task, false code, ds)
+  FI .
+
+y list :
+  forget (ds) ;
+  ds := nilspace ;
+  list file := sequential file (output, ds) ;
+  list (list file) ;
+  send (order task, ack, ds) .
+ 
+y all :
+  BOUND THESAURUS VAR all names := ds ;
+  all names := all ;
+  send (order task, ack, ds) .
+ 
+y maintenance :
+  disable stop ;
+  call (supervisor, order, ds, reply) ;
+  forget (ds) ;
+  IF reply = ack
+    THEN put error message if there is one ; 
+         REP 
+           command dialogue (TRUE) ;
+           get command ("maintenance :") ;
+           reset editor ; 
+           do command
+         UNTIL NOT on line PER ;
+         command dialogue (FALSE) ;
+         break ;
+         set autonom ;
+         save error message if there is one 
+  FI ;
+  enable stop .
+
+put error message if there is one : 
+  IF error message buffer <> "" 
+    THEN  out (error pre) ; 
+          out (error message buffer) ; 
+          out (cr lf) ; 
+          error message buffer := ""
+  FI . 
+ 
+reset editor :
+  WHILE aktueller editor > 0 REP
+    quit
+  PER ;
+  clear error .
+
+save error message if there is one : 
+  IF is error 
+    THEN error message buffer := error message ; 
+         clear error 
+  FI . 
+ 
+ENDPROC free manager ;
+ 
+PROC manager message (TEXT CONST message) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := message ;
+  send (order task, message ack, ds)
+
+ENDPROC manager message ;
+
+PROC manager question (TEXT CONST question) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := question ;
+  send (order task, question ack, ds)
+
+ENDPROC manager question ;
+
+PROC manager message (TEXT CONST message, TASK CONST receiver) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := message ;
+  send (receiver, message ack, ds)
+
+ENDPROC manager message ;
+
+PROC manager question (TEXT CONST question, TASK CONST receiver) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := question ;
+  send (receiver, question ack, ds)
+
+ENDPROC manager question ;
+
+PROC std begin :
+
+  do ("monitor")
+
+ENDPROC std begin ;
+
+PROC begin password (TEXT CONST password) :
+
+  cover tracks of old create son password ;
+  create son password := password ;
+  say (""3""13""5"") ;
+  cover tracks .
+
+cover tracks of old create son password :
+  replace (create son password, 1, LENGTH create son password * " ") .
+
+ENDPROC begin password ;
+
+
+PROC continue channel (INT CONST channel number) : 
+
+  TASK CONST channel owner := task (channel number) ; 
+  IF i am not channel owner 
+    THEN IF NOT is niltask (channel owner)
+           THEN ask channel owner to release the channel ;
+                IF channel owner does not release channel
+                  THEN errorstop ("Task """ + name (channel owner)
+                                            + """ gibt Kanal " 
+                                            + text (channel number)
+                                            + " nicht frei") 
+                FI 
+         FI ; 
+         continue (channel number) 
+  FI .
+  
+i am not channel owner : 
+  channel <> channel number . 
+ 
+ask channel owner to release the channel :
+  forget (ds) ; 
+  ds := nilspace ; 
+  pingpong (channel owner, free code, ds, reply) . 
+
+channel owner does not release channel : 
+  (reply <> ack) AND task exists . 
+ 
+task exists : 
+  reply <> -1 . 
+ 
+ENDPROC continue channel ;
+
+
+END PACKET global manager ;
+
diff --git a/system/multiuser/1.7.5/src/indexer b/system/multiuser/1.7.5/src/indexer
new file mode 100644
index 0000000..e60110a
--- /dev/null
+++ b/system/multiuser/1.7.5/src/indexer
@@ -0,0 +1,1142 @@
+(* ------------------- VERSION 59 vom 21.02.86 -------------------- *)
+PACKET index program DEFINES outline,
+                             index,
+                             index merge:
+
+(* Programm zur Behandlung von Indizes aus Druckdateien
+   Autor: Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+          1.7.4 (Maerz 1985) 'outline'
+*)
+
+LET escape            = ""27"",
+    blank             = " ",
+    trenn k           = ""220"",
+    trennzeichen      = ""221"",
+    minuszeichen      = ""45"",
+    kommando zeichen  = "#",
+    trenner           = " ...",
+    ziffernanfang     = "...  ",
+    ziffern           = "1234567890",
+    ib0               = 1,
+    ib1               = 2,
+    ib2               = 3,
+    ie0               = 4,
+    ie1               = 5,
+    ie2               = 6,
+    max indizes       = 10, (* !!Anzahl möglichetr Indizes *)
+    punkt grenze      = 50,
+    leer              = 0,
+    fuellend          = 1,
+    nicht angekoppelt = 2;
+ 
+INT VAR  seiten nr,
+         zeilen nr,
+         erste fehler zeilennr,
+         zeilen seit index begin,
+         von,
+         komm anf,
+         komm ende,
+         kommando index,
+         index nr,
+         inhalt nr,
+         anz params,
+         anz zwischenspeicher,
+         y richtung; 
+ 
+BOOL VAR outline modus,
+         inhaltsverzeichnis offen;
+
+TEXT VAR dummy,
+         dummy2,
+         fehlerdummy,
+         einrueckung,
+         akt zeile,
+         zweite zeile,
+         akt index,
+         zweiter index,
+         zeile,
+         kommando,
+         datei name,
+         kommando liste :: "ib:1.012ie:4.012",
+         par1,
+         par2;
+ 
+FILE VAR eingabe file,
+         ausgabe file;
+
+ROW max indizes FILE VAR f;
+
+ROW max indizes TEXT VAR zwischenspeicher;
+
+LET SAMMLER = STRUCT (TEXT index text,
+                      TEXT seitennummer zusatz,
+                      INT  zustand);
+ 
+ROW max indizes SAMMLER VAR sammler;
+
+(******************************* outline-Routine **********************)
+
+PROC outline:
+  outline (last param)
+END PROC outline;
+
+PROC outline (TEXT CONST eingabe datei):
+  outline modus := TRUE;
+  disable stop;
+  do outline (eingabe datei);
+  IF is error
+    THEN put error;
+         clear error
+  FI;
+  enable stop;
+  IF anything noted
+    THEN to line (eingabe file, erste fehler zeilennr);
+         note edit (eingabe file)
+    ELSE to line (eingabe file, 1);
+         last param (eingabe datei + ".outline")
+  FI;
+  line
+END PROC outline;
+
+PROC do outline (TEXT CONST eingabe datei):
+  enable stop;
+  IF exists (eingabe datei)
+    THEN initialisiere bildschirm;
+         deaktiviere sammler;
+         anfrage auf inhaltsverzeichnis;
+         einrichten fuer zeilennummer ausgabe;
+         richte dateien ein;
+         verarbeite datei;
+    ELSE errorstop ("Datei nicht vorhanden")
+  FI;
+  cursor (1, y richtung + 1).
+
+initialisiere bildschirm:
+  eingabe file := sequential file (modify, eingabe datei);
+  page;
+  put ("OUTLINE"); put ("( für"); put (lines (eingabe file)); put ("Zeilen):");
+  put (eingabe datei);
+  put ("->"); out (eingabe datei); out (".outline");
+  cursor (1, 3).
+
+anfrage auf inhaltsverzeichnis:
+  put ("Bitte Index-Nr. für Inhaltsverzeichnis:");
+  dummy := "9";
+  REP
+    editget (dummy);
+    inhalt nr := int (dummy);
+    IF last conversion ok AND inhalt nr > 0 AND inhalt nr < 10
+      THEN LEAVE anfrage auf inhaltsverzeichnis
+      ELSE line; put ("Nr. zwischen 0 und 9, bitte nochmal:")
+    FI
+  END REP.
+
+einrichten fuer zeilennummer ausgabe:
+  line (2);
+  INT VAR x;
+  get cursor (x, y richtung).
+
+richte dateien ein:
+  inhaltsverzeichnis offen := FALSE;
+  anz zwischenspeicher := 0;
+  einrueckung := "";
+  erste fehler zeilennr := 0;
+  ggf ueberschreibe anfrage (eingabe datei + ".outline");
+  ausgabe file := sequential file (output, eingabe datei + ".outline");
+  to line (eingabe file, 1);
+  col (eingabe file, 1).
+
+verarbeite datei:
+  REP
+    suche naechste zeile mit kommandozeichen;
+    IF pattern found
+      THEN verarbeite ggf index kommandos
+    FI;
+    IF line no (eingabe file) = lines (eingabe file)
+      THEN LEAVE verarbeite datei
+      ELSE down (eingabe file);
+           col (eingabe file, 1)
+    FI
+  END REP.
+
+verarbeite ggf index kommandos:
+  komm anf := col (eingabe file);
+  von := komm anf;
+  REP
+    WHILE komm anf <> 0 REP
+      komplettiere alle fuellenden sammler (von, komm anf - 1);
+      entschluessele kommando;
+      von := komm ende + 1;
+      setze kommando um
+    END REP;
+    IF alle sammler leer
+      THEN LEAVE verarbeite ggf index kommandos
+      ELSE fuelle sammler mit restzeile und lese naechste zeile
+    FI
+ UNTIL line no (eingabe file) = lines (eingabe file) END REP.
+
+setze kommando um:
+  SELECT kommando index OF
+  CASE ib0, ib1, ib2:
+    zeilen seit index begin := 0;
+    IF anz params = 0
+      THEN index nr := 1
+      ELSE index nr := int (par1)
+    FI;
+    index anfang;
+  CASE ie0, ie1, ie2:
+    IF anz params = 0
+      THEN index nr := 1
+      ELSE index nr := int (par1)
+    FI;
+    index ende;
+  OTHERWISE
+  END SELECT.
+
+index anfang:
+  IF gueltiger index
+    THEN fange neuen index an
+    ELSE fehler (18, par1)
+  FI.
+
+fange neuen index an:
+  IF sammler fuellend (index nr)
+    THEN fehler (20, text (index nr))
+  ELIF index ist inhaltsverzeichnis
+    THEN stelle einrueckung fest;
+         sammler [index nr] . index text := einrueckung;
+         einrueckung CAT "   ";
+         inhaltsverzeichnis offen := TRUE
+  ELIF index ist hauptindex
+    THEN sammler [index nr] . index text := einrueckung;
+    ELSE sammler [index nr] . index text := einrueckung;
+         sammler [index nr] . index text CAT text (index nr);
+         sammler [index nr] . index text CAT " --> "
+  FI;
+  sammler [index nr] . zustand := fuellend.
+
+stelle einrueckung fest:
+  einrueckung := "";
+  INT VAR punkt pos :: pos (zeile, ".");
+  WHILE punkt pos <> 0 REP
+    einrueckung CAT "   ";
+    punkt pos := pos (zeile, ".", punkt pos + 1)
+  END REP.
+
+index ende:
+  IF gueltiger index
+    THEN IF sammler fuellend (index nr)
+           THEN IF kommando index = ie2
+                  THEN sammler [index nr] . index text CAT par2;
+                FI;
+                leere sammler in outline datei (index nr)
+           ELSE fehler (21, text (index nr))
+          FI
+    ELSE fehler (18, text (index nr))
+  FI;
+  sammler [index nr] . zustand := leer.
+
+index ist inhaltsverzeichnis:
+  index nr = inhalt nr.
+
+index ist hauptindex:
+  index nr = 1.
+END PROC do outline;
+
+PROC leere sammler in outline datei (INT CONST nr):
+  IF index ist inhaltsverzeichnis
+    THEN line (ausgabe file);
+         putline (ausgabe file, sammler [nr] . index text);
+         inhaltsverzeichnis offen := FALSE;
+         leere zwischenspeicher
+  ELIF inhaltsverzeichnis offen
+    THEN fuelle zwischenspeicher
+    ELSE putline (ausgabe file, sammler [nr] . index text)
+  FI;
+  sammler [nr] . zustand := leer.
+
+index ist inhaltsverzeichnis:
+  nr = inhalt nr.
+
+leere zwischenspeicher:
+  INT VAR i;
+  FOR i FROM 1 UPTO anz zwischenspeicher REP
+    putline (ausgabe file, zwischenspeicher [i])
+  END REP;
+  anz zwischenspeicher := 0.
+
+fuelle zwischenspeicher:
+  anz zwischenspeicher INCR 1;
+  IF anz zwischenspeicher <= max indizes
+    THEN zwischenspeicher [anz zwischenspeicher] := sammler [nr] . index text
+  FI.
+END PROC leere sammler in outline datei;
+
+(********************* Utility Routinen *****************************)
+
+PROC ggf ueberschreibe anfrage (TEXT CONST d):
+  yrichtung INCR 1;
+  cursor (1, yrichtung);
+  IF exists (d)
+    THEN IF yes (d + " überschreiben")
+           THEN forget (d, quiet)
+           ELSE put ("wird angefügt")
+         FI
+  FI;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI
+END PROC ggf ueberschreibe anfrage;
+
+BOOL PROC gueltiger index:
+  last conversion ok AND index nr > 0 AND index nr <= max indizes
+END PROC gueltiger index;
+
+PROC suche naechste zeile mit kommandozeichen:
+  TEXT VAR steuerzeichen :: incharety;
+  IF steuerzeichen = escape
+    THEN errorstop ("Abbruch durch ESC")
+  FI;
+  downety (eingabe file, "#", lines (eingabe file));
+  read record (eingabe file, zeile);
+  zeilen nr := line no (eingabe file);
+  cout (zeilen nr);
+END PROC suche naechste zeile mit kommandozeichen;
+
+PROC entschluessele kommando:
+  komm ende := pos (zeile, kommando zeichen, komm anf + 1);
+  IF komm ende <> 0 
+    THEN hole kommando text; 
+         TEXT CONST kommando anfangs zeichen :: kommando SUB 1;
+         IF pos ("-/"":*", kommando anfangs zeichen) = 0
+           THEN analysiere kommando
+         FI;
+         komm anf := pos (zeile, kommando zeichen, komm ende + 1);
+    ELSE fehler (2, ""); 
+         komm anf := 0;
+         LEAVE entschluessele kommando
+  END IF. 
+ 
+hole kommando text: 
+  kommando := subtext (zeile, komm anf + 1, komm ende - 1). 
+ 
+analysiere kommando:
+  kommando index := 0;
+  analyze command (kommando liste, kommando, 3,
+                   kommando index, anz params, par1, par2);
+  disable stop; 
+  command error; 
+  IF is error 
+    THEN dummy := error message;
+         clear error;
+         dummy CAT " -> ";
+         dummy CAT kommando;
+         fehler (22, dummy);
+         enable stop; 
+         komm anf := 0;
+         kommando index := 0;
+         LEAVE entschluessele kommando
+  END IF; 
+  enable stop
+END PROC entschluessele kommando;
+
+PROC fuelle sammler mit restzeile und lese naechste zeile:
+  restzeile auffuellen;
+  naechste zeile und zaehlen;
+  zeilen seit index begin INCR 1;
+  von := pos (zeile, ""33"", ""255"", 1);
+  komm anf := pos (zeile, kommando zeichen, von);
+  IF zeilen seit index begin > 10 (* !!Anzahl Zeilen!! *)
+    THEN index aufnahme stoppen;
+         fehler (17, "");
+         LEAVE fuelle sammler mit restzeile und lese naechste zeile
+  ELIF seitenbegrenzung
+    THEN index aufnahme stoppen;
+         fehler (7, "");
+  END IF.
+
+restzeile auffuellen:
+  IF silbentrennung
+    THEN IF durch silbentrennung gewandeltes k
+           THEN replace (zeile, length (zeile) - 1, "c")
+         FI;
+        komplettiere alle fuellenden sammler (von, length (zeile) - 1)
+  ELIF bindestrich
+    THEN komplettiere alle fuellenden sammler (von, length (zeile));
+    ELSE komplettiere alle fuellenden sammler (von, length (zeile));
+         zeile := " ";
+         komplettiere alle fuellenden sammler (1, 1)
+  END IF.
+ 
+silbentrennung: 
+  (zeile SUB length (zeile)) = trennzeichen. 
+ 
+durch silbentrennung gewandeltes k:
+  (zeile SUB length (zeile) - 1) = trenn k.
+
+bindestrich:
+  (zeile SUB length (zeile)) = minuszeichen AND
+      (zeile SUB length (zeile) - 1) <> blank. 
+END PROC fuelle sammler mit restzeile und lese naechste zeile;
+
+(**************************** index routine *************************) 
+ 
+PROC index: 
+  index (last param) 
+END PROC index; 
+ 
+PROC index (TEXT CONST eingabe datei): 
+  outline modus := FALSE;
+  last param (eingabe datei);
+  disable stop;
+  suche indizes (eingabe datei); 
+    IF is error 
+      THEN put error; 
+           clear error;
+    FI;
+  enable stop;
+  nachbehandlung. 
+ 
+nachbehandlung:
+  IF anything noted
+    THEN to line (eingabe file, erste fehler zeilennr);
+         note edit (eingabe file)
+    ELSE to line (eingabe file, 1)
+  FI;
+  line.
+END PROC index;
+ 
+(************************** eigentliche index routine *****************) 
+ 
+PROC suche indizes (TEXT CONST eingabe datei):
+  enable stop;
+  IF exists (eingabe datei)
+    THEN IF pos (eingabe datei, ".p") = 0 
+           THEN errorstop ("Datei ist keine Druckdatei") 
+         FI;
+         eingabe file := sequential file (modify, eingabe datei); 
+         datei name := eingabe datei;
+         erste fehler zeilennr := 0;
+         initialisiere bildschirm; 
+         deaktiviere sammler;
+         verarbeite datei;
+         sortiere die index dateien;
+    ELSE errorstop ("Datei existiert nicht") 
+  END IF. 
+ 
+initialisiere bildschirm: 
+  page;
+  put ("INDEX"); put ("(für"); put (lines (eingabe file)); put ("Zeilen):");
+  put (eingabe datei); 
+  cursor (1, 3);
+  out ("Zeile:      "); 
+  out ("Seite:"); 
+  y richtung := 4;
+  cursor (7, 3).
+ 
+verarbeite datei:
+  lese bis erste seitenbegrenzung;
+  WHILE NOT eof (eingabe file) REP
+     lese bis naechste seitenbegrenzung;
+     setze seiten nr;
+     gehe auf erste textzeile zurueck;
+     verarbeite indizes dieser seite
+  END REP.
+ 
+lese bis erste seitenbegrenzung: 
+  to line (eingabe file, 1); 
+  col (eingabe file, 1);
+  read record (eingabe file, zeile);
+  zeilen nr := 1;
+  cout (1);
+  REP
+     IF eof (eingabe file)
+       THEN errorstop ("Datei ist keine Druckdatei")
+     ELIF seitenbegrenzung
+       THEN LEAVE lese bis erste seitenbegrenzung
+       ELSE naechste zeile und zaehlen
+     END IF
+  END REP.
+ 
+lese bis naechste seitenbegrenzung:
+  IF line no (eingabe file) >= lines (eingabe file)
+    THEN LEAVE verarbeite datei
+    ELSE down (eingabe file)
+  FI;
+  INT VAR erste textzeile := line no (eingabe file);
+  down (eingabe file, "#page##----", lines (eingabe file));
+  IF pattern found
+    THEN read record (eingabe file, zeile)
+    ELSE LEAVE verarbeite datei
+  FI.
+
+gehe auf erste textzeile zurueck: 
+  to line (eingabe file, erste textzeile); 
+  read record (eingabe file, zeile);
+  zeilennr := lineno (eingabe file);
+  cout (zeilennr). 
+ 
+verarbeite indizes dieser seite: 
+  REP
+    suche naechste zeile mit kommandozeichen;
+    IF seitenbegrenzung 
+      THEN LEAVE verarbeite indizes dieser seite 
+    FI;
+    verarbeite index kommandos der naechsten zeilen;
+    IF seitenbegrenzung
+      THEN LEAVE verarbeite indizes dieser seite
+    FI;
+    down (eingabe file);
+    col (eingabe file, 1)
+  END REP.
+ 
+verarbeite index kommandos der naechsten zeilen:
+  komm anf := col (eingabe file);
+  von      := komm anf;
+  REP
+    WHILE komm anf <> 0 REP
+      komplettiere alle fuellenden sammler (von, komm anf - 1);
+      entschluessele kommando;
+      von := komm ende + 1;
+      setze kommando um
+    END REP;
+    IF alle sammler leer
+      THEN LEAVE verarbeite index kommandos der naechsten zeilen
+      ELSE fuelle sammler mit restzeile und lese naechste zeile
+    END IF
+  UNTIL seitenbegrenzung ENDREP;
+  fehler (7, "").
+ 
+setze kommando um: 
+SELECT kommando index OF 
+CASE ib0, ib1, ib2: 
+  zeilen seit index begin := 0;
+  IF anz params = 0
+    THEN index nr := 1
+    ELSE index nr := int (par1)
+  FI;
+  index anfang;
+CASE ie0, ie1, ie2:
+  IF anz params = 0
+    THEN index nr := 1
+    ELSE index nr := int (par1)
+  FI;
+  index ende;
+OTHERWISE
+ENDSELECT. 
+
+index anfang: 
+  IF gueltiger index
+    THEN fange neuen index an
+    ELSE fehler (18, par1)
+  END IF.
+ 
+fange neuen index an: 
+  IF sammler fuellend (index nr) 
+    THEN fehler (20, text (index nr))
+    ELSE fuelle sammler mit (index nr, ""); 
+         IF anz params = 2 
+           THEN zusatz an seitennummer (index nr, par2) 
+           ELSE zusatz an seitennummer (index nr, "") 
+         END IF
+  END IF.
+ 
+index ende: 
+  IF gueltiger index
+    THEN schreibe fuellenden sammler
+    ELSE fehler (18, text (index nr))
+  END IF.
+ 
+schreibe fuellenden sammler: 
+  IF sammler fuellend (index nr) 
+    THEN IF anz params = 2 
+           THEN fuelle sammler mit (index nr, par2) 
+         ENDIF;
+         schreibe sammler (index nr); 
+    ELSE fehler (21, text (index nr))
+  END IF.
+END PROC suche indizes; 
+ 
+(********************* Service Routinen ************************) 
+ 
+BOOL PROC seitenbegrenzung: 
+ subtext (zeile, 2, 5) = "page" AND subtext (zeile, 8, 12) = "-----"
+END PROC seitenbegrenzung;
+ 
+PROC setze seiten nr:
+  seiten nr := int (subtext (zeile, ziffern anfang, ziffernende));
+  cursor (20, 3);
+  put (seiten nr);
+  cursor (7, 3).
+ 
+ziffern anfang:
+  pos (zeile, "0", "9", 10).
+ 
+ziffern ende:
+  pos (zeile, " ", ziffern anfang) - 1
+END PROC setze seiten nr;
+ 
+PROC naechste zeile und zaehlen:
+  zeilen nr INCR 1;
+  cout (zeilen nr);
+  naechste zeile
+END PROC naechste zeile und zaehlen;
+ 
+PROC naechste zeile:
+  down (eingabe file);
+  read record (eingabe file, zeile);
+  col (eingabe file, 1)
+END PROC naechste zeile; 
+ 
+(**************************** Fehler - Routine *********************) 
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilen nr
+  FI;
+  yrichtung INCR 1; 
+  IF yrichtung > 23
+    THEN yrichtung := 23;
+  FI;
+  cursor (1, yrichtung); 
+  fehler melden;
+  fehlermeldung auf terminal ausgeben;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI.
+ 
+fehler melden:
+  report text processing error (nr, zeilen nr, fehlerdummy, addition).
+ 
+fehlermeldung auf terminal ausgeben: 
+  out (fehlerdummy); 
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilen nr
+  FI;
+  yrichtung INCR 1; 
+  IF yrichtung > 23 
+    THEN yrichtung := 23;
+  FI;
+  cursor (1, yrichtung); 
+  fehler melden;
+  meldung auf terminal ausgeben;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI.
+ 
+fehler melden:
+  report text processing warning (nr, zeilen nr, fehlerdummy, addition).
+ 
+meldung auf terminal ausgeben: 
+  out (fehlerdummy); 
+END PROC warnung;
+ 
+(************************** Sammler-Dienste **************************)
+ 
+PROC index aufnahme stoppen:
+  zeile := "INDEX FEHLER";
+  komplettiere alle fuellenden sammler (1, length (zeile));
+  schreibe alle sammler;
+  read record (eingabe file, zeile)
+END PROC index aufnahme stoppen;
+ 
+PROC deaktiviere sammler:
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    sammler [i] . zustand := nicht angekoppelt 
+  END REP 
+END PROC deaktiviere sammler; 
+ 
+BOOL PROC sammler fuellend (INT CONST nr): 
+  sammler [nr] . zustand = fuellend 
+END PROC sammler fuellend; 
+ 
+BOOL PROC sammler angekoppelt (INT CONST nr): 
+  NOT (sammler [nr] . zustand = nicht angekoppelt)
+END PROC sammler angekoppelt; 
+ 
+BOOL PROC alle sammler leer: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler [i] . zustand = fuellend
+      THEN LEAVE alle sammler leer WITH FALSE 
+    END IF 
+  END REP; 
+  TRUE 
+END PROC alle sammler leer; 
+ 
+PROC komplettiere alle fuellenden sammler (INT CONST von pos, bis pos): 
+  INT VAR i; 
+  IF von pos > bis pos
+    THEN LEAVE komplettiere alle fuellenden sammler
+  FI;
+  dummy := subtext (zeile, von pos, bis pos);
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler [i] . zustand = fuellend
+      THEN sammler [i] . index text CAT dummy;
+    FI 
+  END REP;
+END PROC komplettiere alle fuellenden sammler; 
+ 
+PROC fuelle sammler mit (INT CONST nr, TEXT CONST dazu):
+  IF sammler [nr] . zustand = nicht angekoppelt
+    THEN ankoppeln;
+         sammler [nr] . index text := dazu
+  ELIF sammler [nr] . zustand = leer
+    THEN sammler [nr] . index text := dazu
+  ELIF sammler fuellend (nr)
+    THEN sammler [nr] . index text CAT dazu 
+  END IF;
+  sammler [nr] . zustand := fuellend.
+ 
+ankoppeln:
+  yrichtung INCR 1;
+  cursor (1, yrichtung);
+  put ("Indizes");
+  put (nr);
+  put ("gehen in Datei:");
+  dummy := datei name;
+  IF subtext (dummy, length (dummy) - 1) = ".p" 
+    THEN replace (dummy, length (dummy) - 1, ".i") 
+    ELSE dummy CAT ".i"; 
+  END IF;
+  dummy CAT text (nr); 
+  out (dummy);
+  ggf ueberschreibe anfrage (dummy);
+  f [nr] := sequential file (output, dummy);
+  copy attributes (eingabe file, f[nr]);
+  cursor (7, 3)
+END PROC fuelle sammler mit;
+ 
+PROC zusatz an seitennummer (INT CONST nr, TEXT CONST zus text): 
+  sammler [nr] . seitennummer zusatz := zus text 
+END PROC zusatz an seitennummer; 
+ 
+PROC schreibe sammler (INT CONST nr):
+  entferne leading blanks;
+  IF outline modus
+    THEN leere sammler in outline datei (nr)
+    ELSE fuege punkte an;
+         fuege seiten nr an;
+         fuege zusatz an seitennummer an;
+         fuege absatzzeichen an;
+         leere sammler
+  FI.
+
+entferne leading blanks: 
+  WHILE (aufgesammelter text SUB 1) = blank REP 
+    delete char (aufgesammelter text, 1) 
+  END REP. 
+ 
+fuege punkte an: 
+  aufgesammelter text CAT trenner;
+  IF length (aufgesammelter text) < punkt grenze 
+    THEN dummy := (punkt grenze - length (aufgesammelter text)) * ".";
+         aufgesammelter text CAT dummy
+  END IF; 
+  aufgesammelter text CAT "  ".
+ 
+fuege seiten nr an:
+  aufgesammelter text CAT text (seiten nr).
+ 
+fuege zusatz an seitennummer an: 
+  aufgesammelter text CAT sammler [nr]. seitennummer zusatz. 
+ 
+fuege absatzzeichen an: 
+  aufgesammelter text CAT blank.
+ 
+leere sammler: 
+  putline (f [nr], aufgesammelter text);
+  sammler [nr] . zustand := leer.
+ 
+aufgesammelter text: 
+  sammler [nr] . index text
+END PROC schreibe sammler; 
+ 
+PROC schreibe alle sammler: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler fuellend (i) 
+      THEN schreibe sammler (i) 
+    END IF 
+  END REP 
+END PROC schreibe alle sammler;
+ 
+(**************** Sortieren und Indizes zusammenfuehren ***************) 
+ 
+PROC sortiere die index dateien: 
+INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF index datei erstellt 
+      THEN sortiere diese datei
+    END IF 
+  END REP. 
+ 
+index datei erstellt: 
+  sammler angekoppelt (i). 
+ 
+sortiere diese datei:
+  y richtung INCR 1; 
+  cursor (1, yrichtung);
+  dummy := datei name; 
+  IF subtext (dummy, length (dummy) - 1) = ".p" 
+    THEN replace (dummy, length (dummy) - 1, ".i") 
+    ELSE dummy CAT ".i"; 
+  END IF;
+  dummy CAT text (i);
+  put (dummy);
+  IF yes ("sortieren") 
+    THEN lex sort (dummy);
+         eintraege zusammenziehen (dummy)
+  END IF;
+END PROC sortiere die index dateien; 
+ 
+PROC eintraege zusammenziehen (TEXT CONST fname):
+  FILE VAR sorted file :: sequential file (modify, fname);
+  INT VAR i :: 1;
+  to line (sorted file, 1);
+  read record (sorted file, akt zeile);
+  akt index := subtext (akt zeile, 1, pos (akt zeile, trenner) - 1);
+  down (sorted file);
+  WHILE NOT eof (sorted file) REP
+    read record (sorted file, zweite zeile);
+    zweiter index := subtext (zweitezeile, 1, pos (zweitezeile, trenner)-1);
+    i INCR 1;
+    cout (i);
+    IF akt index LEXEQUAL zweiter index
+      THEN fuege seitennummern von zweite in akt zeile ein
+      ELSE akt zeile := zweite zeile;
+           akt index := zweiter index
+    FI;
+    down (sorted file)
+  END REP;
+  to line (sorted file, 1).
+
+fuege seitennummern von zweite in akt zeile ein:
+  hole seitennummer der zweiten zeile;
+  fuege in akt zeile ein;
+  delete record (sorted file);
+  up (sorted file);
+  write record (sorted file, akt zeile).
+
+hole seitennummer der zweiten zeile:
+  INT VAR von := pos (zweite zeile, ziffernanfang) + length (ziffernanfang),
+          bis := von;
+  WHILE pos (ziffern, zweite zeile SUB bis) <> 0 REP
+    bis INCR 1
+  END REP;
+  bis DECR 1;
+  INT VAR zweite nummer := int( subtext (zweite zeile, von, bis));
+  TEXT VAR zweiter nummern text :=
+                    subtext (zweite zeile, von, length (zweite zeile) - 1).
+
+fuege in akt zeile ein:
+  suche einfuege position in akt zeile;
+  fuege ein.
+
+suche einfuege position in akt zeile:
+  INT VAR einfuege pos :=
+                    pos (akt zeile, ziffernanfang) + length (ziffernanfang);
+  von := einfuege pos;
+  REP
+    hole neue nummer;
+  UNTIL am ende der zeile END REP.
+
+am ende der zeile:
+  von >= length (akt zeile).
+
+hole neue nummer:
+  bis := von;
+  WHILE pos (ziffern, akt zeile SUB bis) <> 0 REP
+    bis INCR 1
+  END REP;
+  bis DECR 1;
+  IF bis < von
+    THEN bis := von
+  FI;
+  INT VAR neue nummer := int (subtext (akt zeile, von, bis));
+  IF zweite nummer = neue nummer
+    THEN fuege ggf zweiten nummern text mit textanhang ein
+  ELIF zweite nummer > neue nummer
+    THEN einfuege pos := von;
+         von := pos (akt zeile, ", ", bis) + 2;
+         IF von <= 2
+           THEN von := length (akt zeile)
+         FI
+    ELSE einfuege pos := von;
+         LEAVE suche einfuege position in akt zeile
+  FI.
+
+fuege ggf zweiten nummern text mit textanhang ein:
+  bis := pos (akt zeile, ", ", von);
+  IF bis <= 0
+    THEN bis := length (akt zeile);
+  FI;
+  IF die beiden nummern sind mit textanhang gleich
+    THEN LEAVE fuege in akt zeile ein
+    ELSE einfuege pos := von;
+         LEAVE suche einfuege position in akt zeile
+  FI.
+
+die beiden nummern sind mit textanhang gleich:
+  zweiter nummern text = subtext (akt zeile, von, bis - 1).
+
+fuege ein:
+  IF am ende der zeile
+    THEN change (akt zeile, length (akt zeile), length (akt zeile), ", ");
+         akt zeile CAT (zweiter nummern text + " ")
+    ELSE zweiter nummern text CAT ", ";
+         change
+          (akt zeile, einfuege pos, einfuege pos -1, zweiter nummern text);
+  FI.
+END PROC eintraege zusammenziehen;
+
+(*********************** merge routine *********************) 
+ 
+PROC index merge (TEXT CONST i1, i2):
+  disable stop;
+    indizes zusammenziehen (i1, i2);
+    IF is error
+      THEN put error; 
+           clear error;
+      ELSE last param (i2)
+    FI;
+  enable stop;
+  line.
+END PROC index merge; 
+ 
+PROC indizes zusammenziehen (TEXT CONST i1, i2): 
+  enable stop; 
+  ueberschrift schreiben;
+  dateien assoziieren; 
+  i1 vor i2 einfuegen;
+  sortieren; 
+  forget (i1).
+ 
+dateien assoziieren: 
+  IF exists (i1) 
+    THEN eingabe file := sequential file (modify, i1) 
+    ELSE errorstop (i1 + "existiert nicht")
+  END IF; 
+  IF exists (i2) 
+    THEN f[2] := sequential file (modify, i2) 
+    ELSE errorstop (i2 + "existiert nicht") 
+  END IF.
+
+ueberschrift schreiben: 
+  page; 
+  put ("INDEX MERGE:"); put (i1); put ("-->"); put (i2);
+  cursor (1, 3); 
+  yrichtung := 3.
+ 
+i1 vor i2 einfuegen:
+  to first record (eingabe file); 
+  to first record (f [2]);
+  zeilen nr := 0; 
+  WHILE NOT eof (eingabe file) REP
+    zeilennr INCR 1; 
+    cout (zeilennr);
+    read record (eingabe file, zeile);
+    insert record (f [2]);
+    write record (f[2], zeile);
+    down (f[2]);
+    down (eingabe file);
+  END REP.
+
+sortieren: 
+  y richtung INCR 1; 
+  cursor (1, yrichtung);
+  put (i2); 
+  IF yes ("sortieren") 
+    THEN lex sort (i2);
+         eintraege zusammenziehen (i2)
+  END IF
+END PROC indizes zusammenziehen;
+END PACKET index program;
+
+PACKET columns DEFINES col put, col get, col lineform, col autoform:
+ 
+INT VAR ende pos,
+        anfangs pos;
+ 
+FILE VAR file, spaltenfile; 
+ 
+TEXT VAR dummy, 
+         spalte, 
+         zeile; 
+ 
+LET geschuetztes blank = ""223"",
+    blank              = " ";
+
+BOOL VAR spalte loeschen;
+
+DATASPACE VAR local space := nilspace;
+
+PROC col lineform:
+  spalte loeschen := TRUE;
+  columns put;
+  file := sequential file (modify, local space);
+  lineform (spaltenfile);
+  col get
+END PROC col lineform;
+
+PROC col autoform:
+  spalte loeschen := TRUE;
+  columns put;
+  file := sequential file (modify, local space);
+  autoform (spaltenfile);
+  col get
+END PROC col autoform;
+
+PROC col put:
+  spalte loeschen := yes ("Spalte löschen");
+  columns put
+END PROC col put;
+
+PROC columns put:
+  IF aktueller editor > 0 AND mark 
+    THEN editor bereich bearbeiten 
+    ELSE errorstop ("col put arbeitet nur auf markierten Bereich im Editor") 
+  FI. 
+ 
+editor bereich bearbeiten: 
+    file := editfile; 
+    anfangs pos einholen;
+    ende pos einholen;
+    INT VAR letzte zeile := line no (file),
+            erste zeile  := mark line no (file);
+    to line (file, erste zeile);
+    col (file, 1);
+    spalten put;
+    to line (file, erste zeile);
+    col (file, anfangs pos);
+    mark (false);
+    ueberschrift neu.
+
+anfangs pos einholen:
+  anfangs pos := mark col (file).
+
+ende pos einholen:
+  ende pos := col (file) - 1;
+  IF ende pos < anfangs pos
+    THEN errorstop ("Markierungsende muß rechts vom -anfang sein")
+  FI.
+
+spalten put:
+  spaltendatei einrichten;
+  satznr neu;
+  WHILE line no (file) <= letzte zeile REP
+    satznr zeigen;
+    read record (file, zeile);
+    spalte herausholen;
+    spalte schreiben;
+    down (file)
+  END REP.
+
+spaltendatei einrichten:
+  forget (local space);
+  local space := nilspace;
+  spaltenfile := sequential file (output, local space).
+
+spalte herausholen:
+  spalte := subtext (zeile, anfangs pos, ende pos);
+  IF spalte loeschen
+    THEN change (zeile, anfangs pos, ende pos, "");
+         write record (file, zeile)
+  FI;
+  WHILE length (spalte) > 1 AND (spalte SUB length (spalte)) = blank REP
+    delete char (spalte, length (spalte))
+  END REP;
+  IF spaltenende ist geschuetztes blank
+    THEN delete char (spalte, length (spalte));
+         spalte CAT " "
+  FI.
+
+spalte schreiben:
+  putline (spaltenfile, spalte).
+
+spaltenende ist geschuetztes blank:
+  (spalte SUB length (spalte)) = geschuetztes blank.
+END PROC columns put;
+
+PROC col get:
+  IF aktueller editor > 0
+    THEN editor bereich bearbeiten
+    ELSE errorstop ("col put kann nur im Editor aufgerufen werden")
+  FI;
+  columns get;
+  alles neu.
+
+editor bereich bearbeiten:
+  file := editfile; 
+  spaltenfile := sequential file (input, local space).
+
+columns get:
+  anfangs pos := col (file) - 1;
+  spaltenbreite feststellen;
+  col (file, 1);
+  satznr neu;
+  WHILE NOT eof (spaltenfile) REP
+    satznr zeigen;
+    getline (spaltenfile, spalte);
+    read record (file, zeile);
+    spalte ggf verbreitern;
+    zeile ggf verbreitern;
+    spalte in zeile einfuegen;
+    zeile schreiben;
+    down (file);
+    IF eof (file)
+      THEN errorstop ("Spalte hat zu viele Zeilen für die Datei")
+    FI
+  END REP.
+
+zeile ggf verbreitern:
+  WHILE length (zeile) < anfangs pos REP
+    zeile CAT blank
+  END REP.
+
+spaltenbreite feststellen:
+  INT VAR anz spaltenzeichen :: 0;
+  WHILE NOT eof (spaltenfile) REP
+    getline (spaltenfile, spalte);
+    IF length (spalte) > anz spaltenzeichen
+      THEN anz spaltenzeichen := length (spalte)
+    FI
+  END REP;
+  spaltenfile := sequential file (input, local space).
+
+spalte ggf verbreitern:
+  IF (spalte SUB length (spalte)) = blank
+    THEN delete char (spalte, length (spalte));
+         spalte CAT geschuetztes blank
+  FI;
+  IF anzufuegende spalte soll nicht ans zeilenende
+    THEN spalte verbreitern
+  FI.
+
+anzufuegende spalte soll nicht ans zeilenende:
+  anfangs pos <= length (zeile).
+
+spalte verbreitern:
+  WHILE length (spalte) < anz spaltenzeichen REP
+    spalte CAT blank
+  END REP.
+
+spalte in zeile einfuegen:
+  dummy := subtext (zeile, 1, anfangs pos);
+  dummy CAT spalte;
+  dummy CAT subtext (zeile, anfangs pos + 1);
+  zeile := dummy.
+
+zeile schreiben:
+  write record (file, zeile).
+END PROC col get;
+END PACKET columns;
+
diff --git a/system/multiuser/1.7.5/src/konfigurieren b/system/multiuser/1.7.5/src/konfigurieren
new file mode 100644
index 0000000..016fef2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/konfigurieren
@@ -0,0 +1,254 @@
+(* ------------------- VERSION 4     22.04.86 ------------------- *)
+PACKET konfigurieren DEFINES                (* Autor: D.Heinrichs *)
+
+
+
+    ansi cursor,
+    baudrate ,
+    bits ,
+    cursor logic , 
+    elbit cursor , 
+    enter incode , 
+    enter outcode , 
+    flow , 
+    input buffer size , 
+    link ,
+    new configuration ,
+    new type , 
+    ysize :
+
+LET max dtype nr = 5,  (* maximum number of active device tables *)
+    device table = 32000,
+    ack = 0 ;
+
+ 
+INT VAR next outstring,
+        next instring; 
+ 
+BOUND STRUCT (ALIGN space,                       (* umsetzcodetabelle *)
+              ROW 128 INT outcodes,
+              ROW  64 INT outstrings,
+              ROW  64 INT instrings) VAR x;
+
+
+ROW max dtype nr DATASPACE VAR device code table;
+
+THESAURUS VAR dtypes ;
+
+ 
+PROC new configuration :
+
+  dtypes := empty thesaurus ;
+  INT VAR i ;
+  insert (dtypes, "psi", i) ;
+  insert (dtypes, "transparent", i) ;
+  FOR i FROM 1 UPTO max dtype nr REP
+    forget (device code table (i))
+  PER .
+
+ENDPROC new configuration ;
+
+ 
+PROC block out (DATASPACE CONST ds, INT CONST page, code): 
+  INT VAR err; 
+  block out (ds,page,0,code,err);
+  announce error (err)
+END PROC block out; 
+ 
+PROC announce error (INT CONST err):
+  SELECT err OF 
+  CASE 0:
+  CASE 1: errorstop ("unbekanntes Terminalkommando")
+  CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch")
+  CASE 3: errorstop ("falsche Terminalnummer") 
+  OTHERWISE errorstop ("blockout: unzulaessiger Kanal")
+  ENDSELECT
+END PROC announce error;
+ 
+PROC flow (INT CONST nr, INT CONST dtype):
+  control (6, dtype, nr)
+END PROC flow;
+
+PROC ysize (INT CONST channel ,new size, INT VAR old size) :
+  control (11, channel, new size, old size)
+ENDPROC ysize ;
+
+PROC input buffer size (INT CONST nr,size):
+  INT VAR err;
+  control (2,nr,size,err)
+END PROC input buffer size;
+
+PROC baudrate (INT CONST nr, rate) :
+  control (8, rate, nr)
+ENDPROC baudrate ;
+
+PROC bits (INT CONST channel, number, parity) :
+  bits (channel, number-1 + 8*parity)
+ENDPROC bits ;
+
+PROC bits (INT CONST channel, key) :
+  control (9, key, channel)
+ENDPROC bits ;
+
+PROC control (INT CONST function, key, channel) :
+
+  INT VAR err ;
+  IF key > -128 AND key < 127
+    THEN control (function, channel, key, err)
+  ELIF key = -128
+    THEN control (function, channel, -maxint-1, err)
+  FI
+
+ENDPROC control ;
+
+
+PROC new type (TEXT CONST dtype):
+  x := new (dtype);
+  type (old (dtype), device table);
+  next outstring := 4;
+  next instring := 0;
+  INT VAR i;
+  (* Defaults, damit trmpret den cursor mitfuehrt: *)
+    FOR i FROM 1 UPTO 6 REP
+    enter outcode (i,i)
+    PER;
+    enter outcode (8,8); 
+    enter outcode (10,10);
+    enter outcode (13,13);
+    enter outcode (14,126); 
+    enter outcode (15,126);
+END PROC new type;
+
+INT PROC activate dtype (TEXT CONST dtype): 
+ 
+ INT VAR i := link (dtypes, dtype);
+ IF (exists (dtype) CAND type (old (dtype)) = device table) 
+    THEN IF i <= 0
+            THEN insert (dtypes, dtype, i);
+         FI;
+         forget(device code table (i-2));
+         device code table (i-2) := old (dtype)
+ FI;
+ IF i > max dtype nr +2  (* 5 neue Typen erlaubt *) 
+    THEN delete (dtypes,i);
+         error stop ("Anzahl Terminaltypen > "+text (i));0 
+    ELIF i <= 0
+         THEN error stop ("Unbekannter Terminaltyp" + dtype); 0
+    ELSE i
+ FI. 
+
+END PROC activate dtype; 
+
+PROC link (INT CONST nr, TEXT CONST dtype): 
+ 
+  INT VAR lst nr := activate dtype (dtype)-3;
+  IF lst nr < 0
+     THEN lst nr INCR 256  (* fuer std terminal und std device *)
+     ELSE blockout (device code table(lst nr+1), 2, lst nr); 
+  FI; 
+  INT VAR err := 0;
+  control (1,nr,lst nr,err) ;
+  announce error(err)
+
+END PROC link;
+ 
+
+PROC enter outcode (INT CONST eumel code, ziel code):
+
+  IF ziel code < 128
+    THEN simple entry (eumel code, ziel code)
+    ELSE enter outcode (eumel code, 0, code (ziel code))
+  FI .
+
+ENDPROC enter outcode ;
+
+PROC simple entry (INT CONST eumel code, ziel code) :
+
+  INT CONST position := eumel code DIV 2 +1, 
+            teil := eumel code - 2*position + 2;
+  TEXT VAR h :="     ";
+  replace (h,1,out word);
+  replace (h,1+teil,code (ziel code));
+  out word := (h ISUB 1).
+
+  out word: x.outcodes (position).
+
+END PROC simple entry ;
+
+PROC enter outcode (INT CONST eumel code, wartezeit,
+                    TEXT CONST sequenz):
+
+     INT VAR i;
+     simple entry (eumel code, next outstring + 128);
+     enter part (x.outstrings, next outstring, wartezeit); 
+     FOR i FROM 1 UPTO length (sequenz) REP
+       enter part (x.outstrings, next outstring + i, code (sequenzSUBi))
+     PER;
+     next outstring INCR length (sequenz)+2;
+     abschluss. 
+ 
+     abschluss:
+     enter part (x.outstrings, next outstring-1, 0)
+END PROC enter outcode;
+
+PROC enter outcode (INT CONST eumelcode, TEXT CONST wert):
+  enter outcode (eumelcode,code(wert))
+END PROC enter outcode;
+
+PROC enter part (ROW 64 INT VAR a,INT CONST index, wert):
+  INT CONST position := index DIV 2 +1, 
+            teil := index - 2*position + 2;
+  IF position > 64 THEN errorstop ("Ueberlauf der Terminaltyptabelle") FI;
+  TEXT VAR h :="     ";
+  replace (h,1,out word);
+  replace (h,1+teil,code (wert));
+  out word := (h ISUB 1).
+
+  out word: a (position).
+END PROC enter part;
+
+
+PROC enter incode (INT CONST elan code, TEXT CONST sequenz):
+     IF elan code > 254 OR elan code < 0 THEN errorstop ("kein Eingabecode")
+     ELSE
+     INT VAR i;
+     enter part (x.instrings, next instring, elan code); 
+     FOR i FROM 1 UPTO length (sequenz) REP
+       enter part (x.instrings, next instring + i, code (sequenzSUBi))
+     PER;
+     next instring INCR length (sequenz)+2;
+
+     FI
+
+END PROC enter incode;
+
+PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post):
+
+     cursor logic (dist,255,pre,mid,post)
+
+END PROC cursor logic;
+
+PROC ansi cursor (TEXT CONST pre, mid, post):
+ 
+     cursor logic (0, 1, pre, mid, post)
+
+END PROC ansi cursor;
+
+PROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post):
+
+     enter part (x.outstrings,2,dist);
+     enter part (x.outstrings,3,dist);
+     enter part (x.outstrings,0,modus);
+     enter part (x.outstrings,1,modus);
+     enter outcode (6,0,pre+""0"y"+mid+""0"x"+post+""0"")
+
+END PROC cursor logic;
+
+PROC elbit cursor: 
+     cursor logic (0,""27"","",""); 
+     enter part (x.outstrings,0,2);
+     enter part (x.outstrings,1,255);
+END PROC elbit cursor;
+
+ENDPACKET konfigurieren;
+
diff --git a/system/multiuser/1.7.5/src/liner b/system/multiuser/1.7.5/src/liner
new file mode 100644
index 0000000..bc1f41d
--- /dev/null
+++ b/system/multiuser/1.7.5/src/liner
@@ -0,0 +1,3079 @@
+(* ------------------- VERSION 406 vom 28.05.86 ----(1.7.5)------------- *)
+PACKET liner DEFINES line form,
+                     autoform,
+                     hyphenation width,
+                     additional commands:
+
+(* Programm zur Zeilenformatierung mit unterschiedlichen Schriftypen
+   Autor: Rainer Hahn
+   Stand: 1.7.1 Febr. 1984
+          1.7.3 Juli  1984
+          1.7.4 Juni  1985 
+          1.7.5 ab Okt. 1985 
+ *)
+
+(********************* form deklarationen ********************)
+
+TEXT VAR zeichen,
+         aufzaehlungszeichen,
+         par 1,
+         par 2,
+         kommando,
+         command store,
+         zielreferenzen,
+         herkunftsreferenzen,
+         aktuelle referenz,
+         alter schriftname, 
+         dummy,
+         fehlerdummy,
+         footdummy,
+         scan symbol,
+         font table name :: "",
+         trennwort,
+         trennwort ohne komm,
+         wort1,
+         wort1 ohne komm,
+         wort2,
+         font nr speicher,
+         modifikations speicher,
+         mod zeilennr speicher,
+         index speicher,
+         ind zeilennr speicher,
+         counter numbering store,
+         counter reference store,
+         trennsymbol,
+         puffer,
+         neue zeile,
+         zeile,
+         einrueckung zweite zeile,
+         aktuelle blanks,
+         alte blanks,
+         zusaetzliche commands :: "",
+         kommando liste;
+
+INT CONST rueckwaerts :: -1,
+          esc char ohne zweites byte ausgang :: - maxint - 1;
+
+INT VAR anz tabs,
+        mitzuzaehlende zeichen,
+        anz blanks freihalten,
+        kommando index,
+        scan type,
+        font nr :: 1,
+        blankbreite fuer diesen schrifttyp,
+        aktuelle     pitch zeilenlaenge,
+        eingestellte indentation pitch,
+        einrueckbreite,
+        zeilenbreite,
+        trennbreite in prozent :: 7,
+        trennbreite,
+        max trennlaenge,
+        max trenn laenge ohne komm,
+        zeichenwert ausgang,
+        formelbreite,
+        formelanfang,
+        zeilennr,
+        wortanfang,
+        wortende,
+        erste fehler zeilennr,
+        macro kommando ende,
+        von,
+        pufferlaenge,
+        zeichenpos,
+        zeichenpos bereits verarbeitet;
+
+BOOL VAR ask type and limit,
+         format file in situ,
+         lineform mode,
+         macro works,
+         kommandos speichern,
+         letzter puffer war absatz,
+         in d und e verarbeitung,
+         in tabelle,
+         in foot uebertrag,
+         in foot;
+
+LET hop          = ""1"",
+    rechts       = ""2"",
+    cl eol       = ""5"",
+    links        = ""8"",
+    return       = ""13"",
+    begin mark   = ""15"",
+    end mark     = ""14"",
+    escape       = ""27"",
+    trennzeichen = ""221"",
+    trenn k      = ""220"",
+    blank        = " ",
+    bindestrich  = "-",
+    buchstaben   =
+               "abcdefghijklmnopqrstuvwxyzüäößABCDEFGHIJKLMNOPQRSTUVWXYZÄÜö",
+    kommando zeichen = "#",
+    max tabs              = 30,
+    extended char ausgang = 32767,
+    blank      ausgang    = 32766,
+    kommando   ausgang    = 32765,
+    such       ausgang    = 32764,
+    zeilenende ausgang    = 0,
+    vorwaerts          = 1,
+    type1        = 1,
+    linefeed     = 3,
+    limit        = 4,
+    free         = 5,
+    page command0= 6,
+    page command1= 7,
+    on           = 8,
+    off          = 9,
+    page nr      = 10,
+    pagelength   = 11,
+    start        = 12,
+    foot         = 13,
+    end          = 14,
+    head         = 15,
+    headeven     = 16,
+    headodd      = 17,
+    bottom       = 18,
+    bottomeven   = 19,
+    bottomodd    = 20,
+    block        = 21,
+    material     = 22,
+    columns      = 23,
+    columnsend   = 24,
+    ib0          = 25,
+    ib1          = 26,
+    ib2          = 27,
+    ie0          = 28,
+    ie1          = 29,
+    ie2          = 30,
+    topage       = 31,
+    goalpage     = 32,
+    count0       = 33,
+    count1       = 34,
+    setcount     = 35,
+    value0       = 36,
+    value1       = 37,
+    table        = 38,
+    table end    = 39,
+    r pos        = 40,
+    l pos        = 41,
+    c pos        = 42,
+    d pos        = 43,
+    b pos        = 44,
+    clear pos0   = 45,
+    clear pos1   = 46,
+    right        = 47,
+    center       = 48,
+    skip         = 49,
+    skip end     = 50,
+    u command    = 51,
+    d command    = 52,
+    e command    = 53,
+    head on      = 54,
+    head off     = 55,
+    bottom on    = 56,
+    bottom off   = 57,
+    count per page=58,
+    fillchar     = 59,
+    mark command = 60,
+    mark end     = 61,
+    pageblock    = 62,
+    bsp          = 63,
+    counter1     = 64,
+    counter2     = 65,
+    setcounter   = 66,
+    putcounter0  = 67,
+    putcounter1  = 68,
+    storecounter = 69,
+    ub           = 70,
+    ue           = 71,
+    fb           = 72,
+    fe           = 73;
+
+REAL VAR limit in cm :: 16.0,
+         fehler wert :: -1.0;
+
+FILE VAR eingabe,
+         ausgabe,
+         file;
+
+FRANGE VAR alter bereich; 
+ 
+DATASPACE VAR ds;
+
+ROW 256 INT VAR pitch table;
+ROW max tabs TEXT VAR tab zeichen;
+ROW max tabs ROW 3 INT VAR tabs;
+(* 1. Eintrag: Position
+   2. Eintrag: Art
+   3. Eintrag: Bis-Position
+*)
+ 
+(************************** liner state-Routinen **********************)
+
+TYPE LINERSTATE =
+  STRUCT (INT position, from,
+          BOOL in macro,
+          TEXT buffer line, next line,
+               old blanks, actual blanks,
+               new line);
+
+LINERSTATE VAR before macro state,
+               before foot state;
+
+PROC get liner state (LINERSTATE VAR l):
+  l . position    := zeichenpos;
+  l . from        := von;
+  l . in macro    := macro works;
+  l . buffer line := puffer;
+  l . next line   := zeile;
+  l . old blanks  := alte blanks;
+  l . actualblanks:= aktuelle blanks;
+  l . new line    := neue zeile;
+END PROC get liner state;
+
+PROC put liner state (LINERSTATE CONST l):
+  zeichenpos          := l . position;
+  von                 := l . from;
+  macro works         := l . in macro;
+  puffer              := l . buffer line ;
+  zeile               := l . next line ;
+  alte blanks         := l . old blanks;
+  aktuelle blanks     := l . actual blanks;
+  neue zeile          := l . new line ;
+  pufferlaenge := length (puffer);
+END PROC put liner state;
+
+(*********************** Utility Routinen **************************)
+
+PROC delete int (TEXT VAR resultat, INT CONST delete pos) :
+    change  (resultat, delete pos * 2 - 1, delete pos * 2, "")
+END PROC delete int; 
+
+OP CAT (TEXT VAR resultat, INT CONST zahl) :
+    resultat CAT "  ";
+    replace (resultat, LENGTH resultat DIV 2, zahl);
+END OP CAT;
+
+PROC conversion (REAL VAR cm, INT VAR pitches):
+  disable stop;
+    INT VAR i :: x step conversion (cm);
+    IF is error
+      THEN dummy := error message;
+           clear error;
+           dummy CAT " -> ";
+           dummy CAT text (cm);
+           fehler (38, dummy);
+           cm := fehler wert
+    ELIF i < 0
+      THEN fehler (38, "negativ");
+           cm := fehler wert
+      ELSE pitches := i
+    FI;
+  enable stop
+END PROC conversion;
+
+(************************** Fehlermeldungen **********************)
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  fehler melden;
+  meldung auf terminal ausgeben und ggf zeilennummer merken.
+ 
+fehler melden:
+  report text processing error (nr, zeilen nr, fehlerdummy, addition).
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  warnung melden;
+  meldung auf terminal ausgeben und ggf zeilennummer merken.
+ 
+warnung melden:
+  report text processing warning (nr, zeilennr, fehlerdummy, addition).
+END PROC warnung;
+
+PROC meldung auf terminal ausgeben und ggf zeilennummer merken:
+  IF online
+    THEN line ;
+         out (fehlerdummy);
+         line ;
+  FI;
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilennr
+  FI
+END PROC meldung auf terminal ausgeben und ggf zeilennummer merken;
+
+(*********************** Macro-Bearbeitung ***********************)
+
+PROC fuehre initialisierung fuer macro aus:
+  get liner state (before macro state);
+  get macro line (puffer);
+  pufferlaenge := length (puffer);
+  get macro line (zeile);
+  zeichenpos := 1;
+  von := 1;
+  macro works := TRUE.
+END PROC fuehre initialisierung fuer macro aus;
+
+PROC macro end command: 
+  kommando := subtext (kommando, 2);
+  scan (kommando);
+  next symbol (scan symbol, scan type); 
+  IF NOT macro works
+    THEN fehler (40, kommando);
+         LEAVE macro end command
+  ELIF scan symbol <> "macroend" 
+    THEN fehler (33, kommando) 
+    ELSE put liner state (before macro state);
+  FI
+END PROC macro end command; 
+ 
+(************************** Schrifttyp einstellen *********************)
+
+PROC stelle font ein:
+  IF alter schriftname = par1
+    THEN IF zeilen nr > 2
+           THEN warnung (8, par1)
+           ELSE LEAVE stelle font ein
+         FI
+  ELIF font exists (par1)
+    THEN font nr := font (par1);
+    ELSE fehler (1, par1);
+         par1 := font (1);
+         font nr := 1
+  FI;
+  alter schriftname := par1;
+  hole font und stelle trennbreite ein
+END PROC stelle font ein;
+ 
+PROC hole font:
+  INT VAR x; (* height Werte *)
+  get font (font nr, eingestellte indentation pitch, x, x, x, pitch table);
+  pitch table [code (kommandozeichen) + 1] := kommando ausgang;
+  blankbreite fuer diesen schrifttyp := pitch table [code (blank) + 1] 
+END PROC hole font;
+
+PROC hole font und stelle trennbreite ein:
+  hole font;
+  trennbreite setzen
+END PROC hole font und stelle trennbreite ein;
+
+PROC trennbreite setzen:
+  trennbreite := berechnete trennbreite.
+
+berechnete trennbreite:
+  INT VAR eingestellte trennbreite;
+  conversion (limit in cm, eingestellte trennbreite);
+  eingestellte trennbreite := eingestellte trennbreite
+                                            DIV 100 * trennbreite in prozent;
+  IF eingestellte trennbreite <= zweimal blankbreite
+    THEN zweimal blankbreite
+    ELSE eingestellte trennbreite
+  FI.
+
+zweimal blankbreite:
+  2 * eingestellte indentation pitch.
+END PROC trennbreite setzen; 
+ 
+PROC hyphenation width (INT CONST prozente): 
+  IF prozente < 4 OR prozente > 20 
+    THEN putline ("Fehler: Einstellbare Trennbreite zwischen 4 und 20%") 
+    ELSE trennbreite in prozent := prozente
+  FI 
+END PROC hyphenation width;
+
+(************************** kommando verarbeitung ****************)
+
+PROC additional commands (TEXT CONST k): 
+  zusaetzliche commands := k 
+END PROC additional commands; 
+ 
+TEXT PROC additional commands:
+  zusaetzliche commands
+END PROC additional commands;
+
+BOOL PROC hinter dem kommando steht nix (INT CONST komm ende):
+  komm ende = pufferlaenge OR absatz hinter dem kommando.
+
+absatz hinter dem kommando:
+  komm ende + 1 = pufferlaenge AND puffer hat absatz.
+END PROC hinter dem kommando steht nix;
+
+PROC verarbeite kommando und neue zeile auffuellen:
+  neue zeile auffuellen (von, zeichenpos - 1);
+  von := zeichenpos;
+  verarbeite kommando;
+  neue zeile auffuellen (von, zeichenpos - 1);
+  von := zeichenpos
+END PROC verarbeite kommando und neue zeile auffuellen;
+
+PROC speichere kommando:
+  command store CAT "#";
+  command store CAT kommando;
+  command store CAT "#"
+END PROC speichere kommando;
+
+PROC execute stored commands:
+  IF length (command store) <> 0
+    THEN kommandos speichern := FALSE;
+         dummy := puffer;
+         INT VAR zpos := zeichenpos;
+         zeichenpos := 1;
+         puffer := command store;
+         pufferlaenge := length (puffer);
+         execute commands;
+         puffer := dummy;
+         pufferlaenge := length (puffer);
+         zeichenpos := zpos;
+         command store := "";
+  FI;
+  kommandos speichern := TRUE.
+
+execute commands:
+  WHILE zeichenpos < pufferlaenge REP
+    verarbeite kommando
+  END REP.
+END PROC execute stored commands;
+
+PROC verarbeite kommando:
+INT VAR  anz params,
+         intparam,
+         kommando ende;
+REAL VAR realparam;
+   zeichenpos INCR 1;
+   kommando ende := pos (puffer, kommando zeichen, zeichenpos);
+   IF kommando ende <> 0
+     THEN kommando oder kommentar kommando verarbeiten;
+          zeichenpos := kommando ende + 1
+     ELSE fehler (2, "")
+  FI.
+
+kommando oder kommentar kommando verarbeiten:
+  kommando := subtext (puffer, zeichenpos, kommando ende - 1);
+  TEXT CONST erstes kommandozeichen :: (kommando SUB 1);
+  IF pos ("-/"":*", erstes kommandozeichen) = 0
+    THEN scanne kommando und fuehre es aus
+    ELSE restliche kommandos
+  FI.
+
+restliche kommandos:
+  IF erstes kommandozeichen = "-" OR erstes kommandozeichen = "/"
+    THEN
+  ELIF erstes kommandozeichen = """"
+    THEN scan (kommando);
+         next symbol (scan symbol, scan type);
+         INT VAR scan type2;
+         next symbol (scan symbol, scan type2);
+         IF scan type <> 4 OR scan type2 <> 7
+           THEN fehler (58, kommando)
+         FI
+  ELIF erstes kommandozeichen = "*"
+    THEN zeichenpos := kommando ende + 1;
+         macroend command;
+         LEAVE verarbeite kommando
+  ELIF erstes kommandozeichen = ":"
+    THEN disable stop;
+         delete char (kommando, 1);
+         INT CONST line no before do := line no (eingabe);
+         do (kommando);
+         to line (eingabe, line no before do);
+         IF is error
+           THEN dummy := error message;
+                clear error;
+                dummy CAT " -> ";
+                dummy CAT kommando;
+                fehler (9, dummy)
+         FI;
+         enable stop
+  FI.
+ 
+scanne kommando und fuehre es aus:
+   analyze command (kommando liste, kommando, 3,
+                    kommando index, anz params, par1, par2);
+   disable stop ; 
+   command error ;
+   IF is error
+     THEN dummy := error message;
+          clear error;
+          dummy CAT " -> ";
+          dummy CAT kommando;
+          fehler (22, dummy); 
+          enable stop;
+          LEAVE scanne kommando und fuehre es aus
+   FI;
+   enable stop;
+   setze kommando um.
+
+setze kommando um:
+   SELECT kommando index OF
+ 
+CASE type1:
+     stelle font ein;
+     modifikations speicher := "";
+     mod zeilennr speicher  := ""
+ 
+CASE limit:
+     realparam := real (par1); 
+     IF kommandos speichern
+       THEN speichere kommando
+     ELIF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF realparam = 0.0
+              THEN fehler (37, "")
+              ELSE conversion (realparam, aktuelle pitch zeilenlaenge);
+                   IF realparam <> fehlerwert
+                     THEN limit in cm := realparam;
+                          trennbreite setzen
+                   FI
+            FI
+       ELSE fehler (4, par1);
+     FI
+ 
+CASE on, ub, fb:
+     TEXT VAR mod zeichen;
+     IF kommando index = ub
+       THEN mod zeichen := "u"
+     ELIF kommando index = fb
+       THEN mod zeichen := "b"
+       ELSE mod zeichen := (par1 SUB 1);
+     FI;
+     INT VAR position :: pos (modifikations speicher, mod zeichen);
+     IF position <> 0
+       THEN dummy := mod zeichen + " in Zeile ";
+            dummy CAT text (mod zeilennr speicher ISUB position);
+            fehler (54, dummy);
+            replace (mod zeilennr speicher, position, zeilennr);
+       ELSE modifikations speicher CAT mod zeichen;
+            mod zeilennr speicher CAT zeilennr
+     FI
+ 
+CASE off, fe, ue:
+     IF kommando index = ue
+       THEN mod zeichen := "u"
+     ELIF kommando index = fe
+       THEN mod zeichen := "b"
+       ELSE mod zeichen := (par1 SUB 1);
+     FI;
+     position := pos (modifikations speicher, mod zeichen);
+     IF position  = 0
+       THEN fehler (55, mod zeichen)
+       ELSE delete char (modifikations speicher, position);
+            delete int (mod zeilennr speicher, position)
+     FI
+ 
+CASE pagenr, pagelength, start, block, material, setcount, right, center,
+     linefeed:
+ 
+CASE head, headodd, headeven, bottom, bottomodd, bottomeven, end, free,
+          page command0, page command1, columns, columnsend:
+     IF NOT hinter dem kommando steht nix (kommando ende)
+       THEN fehler (19, kommando)
+     ELIF kommando ende = pufferlaenge
+       THEN IF (neue zeile SUB length (neue zeile)) = blank
+              THEN delete char (neue zeile, length (neue zeile))
+            FI;
+            puffer CAT blank;
+            pufferlaenge := length (puffer)
+     FI;
+     in foot := FALSE
+ 
+CASE foot:
+     IF in foot uebertrag
+       THEN zeilenbreite := aktuelle pitch zeilenlaenge + 1
+     ELIF in foot
+       THEN fehler (3, "")
+       ELSE fuelle ggf zeile vor foot auf (kommando ende)
+     FI
+ 
+CASE ib0, ib1, ib2:
+     TEXT VAR ind zeichen;
+     IF kommando index = ib0
+       THEN ind zeichen:= "1"
+       ELSE ind zeichen := par1
+     FI;
+     position := pos (index speicher, ind zeichen);
+     IF position <> 0
+       THEN dummy := ind zeichen + " in Zeile ";
+            dummy CAT text (ind zeilennr speicher ISUB position);
+            fehler (56, dummy);
+            replace (ind zeilennr speicher, position, zeilennr)
+       ELSE index speicher CAT ind zeichen;
+            ind zeilennr speicher CAT zeilennr
+     FI
+
+CASE ie0, ie1, ie2:
+     IF kommando index = ie0
+       THEN ind zeichen := "1"
+       ELSE ind zeichen := par1
+     FI;
+     position := pos (index speicher, ind zeichen);
+     IF position = 0
+       THEN fehler (57, ind zeichen)
+       ELSE delete char (index speicher, position);
+            delete int (ind zeilennr speicher, position)
+     FI
+
+CASE topage, count1: 
+     herkunftsreferenzen speichern;
+     zeilenbreite um blankbreite erhoehen (3)
+ 
+CASE count0: 
+     zeilenbreite um blankbreite erhoehen (3)
+ 
+CASE value0, value1: 
+     IF anz params <> 0
+       THEN zielreferenzen speichern ohne warnung
+     FI;
+     zeilenbreite um blankbreite erhoehen (3)
+
+CASE goalpage: 
+     zielreferenzen speichern
+
+CASE table:
+     IF in tabelle
+       THEN fehler (41, "")
+       ELSE IF hinter dem kommando steht nix (kommando ende)
+              THEN zeichenpos := pufferlaenge;
+                   neue zeile auffuellen und ausgabe bei zeilenende
+              ELSE neue zeile auffuellen (von, kommando ende);
+                   puffer := subtext (puffer, kommandoende + 1);
+                   schreibe und initialisiere neue zeile
+            FI;
+            verarbeite tabelle;
+            LEAVE verarbeite kommando
+     FI
+
+CASE table end:
+     IF NOT in tabelle
+       THEN fehler (59, "")
+     FI
+
+CASE r pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (r pos)
+     FI
+
+CASE l pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (l pos)
+     FI
+
+CASE c pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (c pos)
+     FI
+
+CASE d pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (d pos)
+     FI
+
+CASE b pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (b pos)
+     FI
+
+CASE clear pos0:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE anz tabs := 0;
+     FI
+
+CASE clear pos1:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition loeschen
+     FI
+
+CASE skip:
+     IF hinter dem kommando steht nix (kommando ende)
+       THEN neue zeile auffuellen und ausgabe bei zeilenende
+       ELSE neue zeile auffuellen (von, kommandoende);
+            puffer := subtext (puffer, kommandoende + 1);
+            schreibe und initialisiere neue zeile
+     FI;
+     skip zeilen verarbeiten;
+     kommando ende := zeichenpos;
+
+CASE skip end:
+
+CASE u command, d command:
+     INT VAR next smaller font;
+     speichere font nr;
+     IF next smaller font exists (font nr, next smaller font)
+       THEN font nr := next smaller font
+     FI;
+     hole font und stelle trennbreite ein;
+     IF NOT in d und e verarbeitung
+       THEN verarbeite index und exponenten;
+            LEAVE verarbeite kommando
+     FI
+
+CASE e command:
+     entspeichere font nr
+
+CASE head on, head off, bottom on, bottom off, count per page, fillchar,
+     mark command, markend, pageblock:
+
+CASE bsp:
+     zeichenpos DECR 2;
+     IF kommandoende = length (puffer) OR
+        (puffer SUB kommandoende + 1) = kommandozeichen OR
+        zeichenpos < 1 OR
+        (puffer SUB zeichenpos) = kommandozeichen
+       THEN fehler (28, "");
+            LEAVE setze kommando um
+     FI;
+     begin of this char (puffer, zeichenpos);
+     kommandoende INCR 1;
+     INT VAR diese breite    :: breite (puffer, zeichenpos),
+             naechste breite :: breite (puffer, kommandoende);
+     IF in d und e verarbeitung
+       THEN formelbreite DECR diese breite;
+            formelbreite INCR max (diese breite, naechste breite)
+       ELSE zeilenbreite DECR diese breite;
+            zeilenbreite INCR max (diese breite, naechste breite) 
+     FI;
+     zeichenpos := kommandoende;
+     char pos move (vorwaerts);
+     LEAVE verarbeite kommando
+
+CASE counter1, counter2:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     IF pos (counter numbering store, dummy) = 0
+       THEN fehler (34, par1);
+     FI;
+     IF kommando index = counter1
+       THEN par2 := "0"
+     FI;
+     anz blanks freihalten := 3 + 2 * int (par2);
+     zeilenbreite um blankbreite erhoehen (anz blanks freihalten)
+
+CASE set counter:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     IF pos (counter numbering store, dummy) = 0
+       THEN counter numbering store CAT dummy
+       ELSE warnung (15, par1)
+     FI
+
+CASE put counter0:
+     zeilenbreite um blankbreite erhoehen (anz blanks freihalten) 
+
+CASE put counter1:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     INT VAR begin pos :: pos (counter reference store, dummy);
+     IF begin pos = 0
+       THEN counter reference store CAT "u";
+            counter reference store CAT dummy
+     ELIF (counter reference store SUB begin pos - 1) <> "u"
+       THEN insert char (counter reference store,"u", max (begin pos, 1))
+     FI;
+     zeilenbreite um blankbreite erhoehen (5)
+
+CASE store counter:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     begin pos := pos (counter reference store, dummy);
+     IF begin pos <> 0
+       THEN IF (counter reference store SUB begin pos - 1) = "i" OR
+               (counter reference store SUB begin pos - 2) = "i"
+              THEN fehler (35, par1)
+            ELIF (counter reference store SUB begin pos - 1) = "u"
+              THEN insert char (counter reference store, "i",
+                                max (begin pos - 1, 1))
+              ELSE insert char (counter reference store, "i",
+                                max (begin pos, 1))
+            FI
+       ELSE counter reference store CAT "i";
+            counter reference store CAT dummy
+     FI
+
+OTHERWISE
+     IF macro command and then process parameters (kommando)
+       THEN IF macro works
+              THEN fehler (15, kommando)
+              ELSE zeichenpos := kommando ende + 1;
+                   neue zeile auffuellen (von, zeichenpos - 1);
+                   von := zeichenpos;
+                   fuehre initialisierung fuer macro aus;
+                   LEAVE verarbeite kommando
+            FI
+     ELIF zusaetzliche commands <> ""
+       THEN analyze command (zusaetzliche commands, kommando, 3,
+                             kommando index, anz params, par1, par2);
+            IF kommando index = 0
+              THEN fehler (8, kommando)
+            FI
+       ELSE fehler (8, kommando)
+     FI;
+END SELECT.
+END PROC verarbeite kommando;
+ 
+(************************* Indizes und Exponenten **********************)
+
+PROC zeilenbreite um blankbreite erhoehen (INT CONST anz):
+  INT CONST blankbreite mal anz :: anz * eingestellte indentation pitch;
+  IF in d und e verarbeitung 
+    THEN formelbreite INCR blankbreite mal anz
+    ELSE zeilenbreite INCR blankbreite mal anz
+  FI;
+  mitzuzaehlende zeichen INCR anz
+END PROC zeilenbreite um blankbreite erhoehen;
+
+PROC speichere font nr:
+  IF index oder exponent anfang
+    THEN suche wortanfang in neuer zeile;
+         zeilenbreite DECR formelbreite
+  FI;
+  font nr speicher CAT " ";
+  font nr speicher CAT text (font nr).
+
+index oder exponent anfang:
+  font nr speicher = "".
+
+suche wortanfang in neuer zeile:
+  auf das letzte zeichen stellen;
+  WHILE NOT wortanfang vor formel REP
+    formelbreite INCR breite (neue zeile, formelanfang);
+    IF formelanfang = 1
+      THEN LEAVE suche wortanfang in neuer zeile
+    FI;
+    char pos move (neue zeile, formelanfang, rueckwaerts);
+  END REP;
+  char pos move (neue zeile, formelanfang, vorwaerts).
+
+wortanfang vor formel:
+  pos (" #", neue zeile SUB formelanfang) <> 0.
+
+auf das letzte zeichen stellen:
+  formelanfang := length (neue zeile);
+  formelbreite := 0;
+  IF formelanfang > 0
+    THEN begin of this char (neue zeile, formelanfang);
+    ELSE formelanfang := 1;
+         LEAVE suche wortanfang in neuer zeile
+  FI
+END PROC speichere font nr;
+
+PROC verarbeite index und exponenten:
+  in d und e verarbeitung := TRUE;
+  zeichenpos := pos (puffer, kommandozeichen, zeichenpos) + 1;
+  INT VAR altes zeichenpos := zeichenpos;
+  verarbeite index oder exponenten zeichen;
+  fehler (52, "");
+  entspeichere font nr.
+
+verarbeite index oder exponenten zeichen:
+  REP
+    stranalyze (pitch table, formelbreite,
+               aktuelle pitch zeilenlaenge - zeilenbreite,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite zeichen vor kommando;
+           verarbeite kommando und neue zeile auffuellen;
+           IF NOT in d und e verarbeitung
+             THEN zeilenbreite INCR formelbreite;
+                  LEAVE verarbeite index und exponenten
+           FI;
+           altes zeichenpos := zeichenpos
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF     zeichenpos >= pufferlaenge
+         AND formelbreite + zeilenbreite < aktuelle pitch zeilenlaenge
+      THEN LEAVE verarbeite index oder exponenten zeichen
+    ELIF formelanfang <= 1
+      THEN fehler (53, "");
+           formelbreite := 0;
+    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN fehler (23, "");
+           LEAVE verarbeite index oder exponenten zeichen
+      ELSE schreibe neue zeile vor formelanfang
+    FI
+  END REP.
+
+verarbeite zeichen vor kommando:
+  mitzuzaehlende zeichen INCR
+                         number chars (puffer, altes zeichenpos, zeichenpos);
+  IF (puffer SUB zeichenpos) <> blank
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
+  FI;
+  char pos move (vorwaerts).
+
+schreibe neue zeile vor formelanfang:
+  dummy := subtext (neue zeile, formelanfang);
+  neue zeile := subtext (neue zeile, 1, formelanfang - 1);
+  loesche nachfolgende blanks;
+  schreibe und initialisiere neue zeile;
+  neue zeile CAT dummy;
+  formelanfang := 1;
+  char pos move (vorwaerts)
+END PROC verarbeite index und exponenten;
+
+PROC entspeichere font nr:
+  INT VAR index := length (font nr speicher);
+  IF index <= 1
+    THEN fehler (51, "")
+    ELSE suche nr anfang;
+         entspeichere;
+  FI.
+
+suche nr anfang:
+  WHILE (font nr speicher SUB index) <> " " AND index <> 0 REP
+    index DECR 1
+  END REP.
+
+entspeichere:
+  font nr := int (subtext (font nr speicher, index + 1));
+  IF index <= 1
+    THEN font nr speicher := "";
+         in d und e verarbeitung := FALSE
+    ELSE font nr speicher := subtext (font nr speicher, 1, index - 1)
+  FI;
+  hole font und stelle trennbreite ein
+END PROC entspeichere font nr;
+
+(*************************** skip zeilen ****************************)
+
+PROC skip zeilen verarbeiten:
+  REP
+    IF dateiende
+      THEN errorstop ("Dateiende während skip-Anweisung")
+    ELIF skip ende kommando
+      THEN LEAVE skip zeilen verarbeiten
+    FI;
+    neue zeile auffuellen und ausgabe bei zeilenende
+  END REP.
+
+dateiende:
+  pufferlaenge = 0.
+
+skip ende kommando:
+  TEXT VAR kliste :: "skipend:1.0", k;
+  INT VAR k anf :: pos (puffer, kommandozeichen),
+          kende, anz params, kindex;
+  WHILE noch ein kommando vorhanden REP
+    kindex := 0;
+    analysiere das kommando
+  END REP;
+  FALSE.
+
+noch ein kommando vorhanden:
+  kanf <> 0.
+
+analysiere das kommando:
+  kende := pos (puffer, kommandozeichen, kanf + 1);
+  IF kende = 0
+    THEN fehler (2, "");
+         LEAVE skip ende kommando WITH FALSE
+  FI;
+  k := subtext (puffer, kanf + 1, kende - 1);
+  analyze command (kliste, k, 3, kindex, anz params, par1, par2);
+  IF kindex = 1
+    THEN zeichenpos := kende;
+         LEAVE skip ende kommando WITH TRUE
+  FI;
+  kanf := pos (puffer, kommandozeichen, kende + 1).
+END PROC skip zeilen verarbeiten;
+
+(**************** sonderbehandlung von zeilen vor foot *******************)
+
+PROC fuelle ggf zeile vor foot auf (INT VAR com ende):
+  IF foot am zeilenende ohne absatz AND NOT macro works
+    THEN letzter puffer war absatz := TRUE;
+         IF text vor foot AND NOT zeile hat richtige laenge
+           THEN INT VAR   foot zeilennr := line no (eingabe);
+                INT CONST x1            := com ende;
+                in foot uebertrag := TRUE;
+                get liner state (before foot state);
+                formatiere diese zeile;
+                to line (eingabe, foot zeilennr);
+                footdummy := neue zeile;
+                put liner state (before foot state);
+                neue zeile := footdummy;
+                com ende := x1;
+                in foot uebertrag := FALSE
+         FI
+  ELIF NOT hinter dem kommando steht nix (com ende)
+    THEN fehler (19, kommando);
+         LEAVE fuelle ggf zeile vor foot auf
+  FI;
+  in foot := TRUE.
+
+foot am zeilenende ohne absatz:
+  com ende = pufferlaenge.
+
+text vor foot:
+  pos (neue zeile, ""33"", ""255"", 1) <> 0.
+
+formatiere diese zeile:
+  foot anweisung entfernen;
+  lese eingabe datei bis end kommando;
+  zeile nach end in zeile;
+  formatiere;
+  schreibe die veraenderte zeile nach end.
+ 
+foot anweisung entfernen:
+  zeichenpos := com ende;
+  ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
+  zeichenpos DECR 1;
+  puffer := subtext (puffer, 1, zeichenpos);
+  WHILE NOT within kanji (puffer, zeichenpos) AND
+        (puffer SUB zeichenpos) = blank AND foot stand nicht am zeilenanfang
+        REP
+    zeilenbreite DECR breite (blank);
+    delete char (puffer, zeichenpos);
+    delete char (neue zeile, length (neue zeile));
+    zeichenpos DECR 1
+  END REP;
+  pufferlaenge := length (puffer).
+
+foot stand nicht am zeilenanfang:
+  zeichenpos > 0.
+
+lese eingabe datei bis end kommando:
+  TEXT VAR kliste :: "end:1.0";
+  dummy := zeile;
+  WHILE NOT foot ende kommando REP
+    IF eof (eingabe)
+      THEN LEAVE formatiere diese zeile
+    FI;
+    read record (eingabe, dummy);
+    down (eingabe);
+  ENDREP;
+  INT CONST zeile nach end := line no (eingabe);
+  IF NOT end kommando steht am zeilenende
+    THEN LEAVE formatiere diese zeile
+  FI.
+
+end kommando steht am zeilenende:
+  k ende = length (dummy) OR k ende + 1 = length (dummy).
+
+foot ende kommando:
+  INT VAR k anf, k ende :: 0, anz params, k index;
+  WHILE noch ein kommando vorhanden REP
+    k ende := pos (dummy, kommandozeichen, k anf + 1);
+    IF k ende = 0
+      THEN LEAVE foot ende kommando WITH FALSE
+      ELSE kommando := subtext (dummy, k anf + 1, k ende - 1);
+    FI;
+    analyze command (kliste, kommando, 3, kindex, anz params, par1, par2);
+    IF k index = 1
+      THEN LEAVE foot ende kommando WITH TRUE
+    FI;
+  END REP;
+  FALSE.
+
+noch ein kommando vorhanden:
+  k anf := pos (dummy, kommandozeichen, k ende + 1);
+  k anf <> 0.
+
+zeile nach end in zeile:
+  read record (eingabe, zeile);
+  INT VAR text anf := pos (zeile, ""33"", ""255"", 1);
+  IF zeile nach end ist leerzeile
+    THEN LEAVE formatiere diese zeile
+    ELSE IF text anf > 1
+           THEN aktuelle blanks := subtext (zeile, 1, text anf - 1);
+                zeile := subtext (zeile, text anf)
+         FI;
+  FI.
+
+zeile nach end ist leerzeile:
+  text anf <= 0.
+
+formatiere:
+  IF foot stand nicht am zeilenanfang
+    THEN verarbeite letztes zeichen von puffer
+    ELSE puffer CAT zeile;
+         pufferlaenge := length (puffer)
+  FI;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang = kommando ausgang
+      THEN zeichenpos INCR 1;
+           neue zeile auffuellen (von, zeichenpos - 1);
+           von := zeichenpos;
+           INT VAR ende der neuen zeile := length (neue zeile),
+                   zpos davor := zeichenpos;
+           verarbeite kommando;
+           neue zeile auffuellen (von, zeichenpos - 1);
+           von := zeichenpos;
+           IF kommando index = foot
+             THEN behandlung der zeile vor foot;
+                  LEAVE formatiere
+           ELIF zeichenpos >= pufferlaenge
+              OR zeilenbreite > aktuelle pitch zeilenlaenge
+             THEN ende einer neuen zeile;
+                  LEAVE formatiere
+           FI
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN up (eingabe);
+           delete record (eingabe);
+           neue zeile auffuellen;
+           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+             THEN fehler (23, "")
+           FI;
+           LEAVE formatiere diese zeile
+      ELSE ende einer neuen zeile;
+           LEAVE formatiere
+    FI
+  END REP.
+
+behandlung der zeile vor foot:
+  neue zeile := subtext (neue zeile, 1, ende der neuen zeile);
+  zeichenpos := zpos davor.
+
+schreibe die veraenderte zeile nach end:
+  to line (eingabe, zeile nach end);
+  dummy := (text anf - 1) * blank;
+  dummy CAT subtext (puffer, zeichenpos);
+  IF format file in situ
+    THEN insert record (eingabe)
+  FI;
+  write record (eingabe, dummy).
+END PROC fuelle ggf zeile vor foot auf;
+
+(*************** Tabulator- und Tabellen verarbeitung ******************)
+
+PROC tabulatorposition eintragen (INT CONST tab type):
+  ROW 3 INT VAR akt tab pos;
+  IF anz tabs >= max tabs
+    THEN fehler (32, "")
+  ELIF tab in cm umwandeln (par1, tab pos in pitches)
+    THEN IF tab type = b pos AND tab in cm umwandeln (par2, bis tab)
+           THEN 
+           ELSE bis tab := 0
+         FI;
+         TEXT VAR zentrierzeichen;
+         IF tab type = d pos
+           THEN zentrierzeichen := par2
+           ELSE zentrierzeichen := ""
+         FI;
+        tabs sortiert eintragen
+  FI.
+
+tabs sortiert eintragen:
+  INT VAR i;
+  type tab := tab type;
+  FOR i FROM 1 UPTO anz tabs REP
+    IF tab pos in pitches = tabs [i] [1]
+      THEN fehler (42, par1);
+           LEAVE tabulatorposition eintragen
+    ELIF tabs [i] [1] > tab pos in pitches
+      THEN vertauschen
+    FI;
+    IF ueberschneidende bpos
+      THEN fehler (12, text (xstepconversion (tab pos in pitches)))
+    FI;
+  END REP;
+  anz tabs INCR 1;
+  tabs [anz tabs]        := akt tab pos;
+  tab zeichen [anz tabs] := zentrierzeichen.
+
+ueberschneidende bpos:
+  tabs [i] [2] = bpos AND naechste anfang pos liegt in diesem bpos bereich.
+
+naechste anfang pos liegt in diesem bpos bereich:
+  tab pos in pitches <= tabs [i] [3].
+
+vertauschen:
+  ROW 3 INT CONST hilf1 :: tabs [i];
+  TEXT CONST thilf      :: tab zeichen [i];
+  tabs [i]        := akt tab pos;
+  tab zeichen [i] := zentrierzeichen;
+  akt tab pos     := hilf1;
+  zentrierzeichen := thilf.
+
+tab pos in pitches: 
+  akt tab pos [1].
+
+type tab:
+  akt tab pos [2].
+
+bis tab:
+  akt tab pos [3].
+END PROC tabulatorposition eintragen;
+
+BOOL PROC tab in cm umwandeln (TEXT CONST text wert, INT VAR f breite):
+  REAL VAR cm := real (text wert);
+  IF last conversion ok AND pos (text wert, ".") <> 0
+    THEN umwandeln
+    ELSE fehler (4, par1);
+         TRUE
+  FI.
+
+umwandeln:
+  conversion (cm, f breite);
+  IF f breite > aktuelle pitch zeilenlaenge
+    THEN fehler (39, par1)
+  ELIF cm = fehlerwert
+    THEN
+    ELSE LEAVE tab in cm umwandeln WITH TRUE
+  FI;
+  FALSE
+END PROC tab in cm umwandeln;
+
+PROC cm angabe der druckposition in dummy (INT CONST nr):
+  dummy := text (x step conversion (tabs [nr] [1]));
+  IF (dummy SUB length (dummy)) = "."
+    THEN dummy CAT "0"
+  FI;
+  dummy CAT " cm"
+END PROC cm angabe der druckposition in dummy;
+
+PROC tabulator position loeschen:
+  INT VAR tab pos in pitches;
+  IF tab in cm umwandeln (par1, tab pos in pitches)
+    THEN versuche zu loeschen
+  FI.
+
+versuche zu loeschen:
+  INT VAR i;
+  FOR i FROM 1 UPTO anz tabs REP
+    IF tab pos in pitches = tabs [i] [1]
+      THEN verschiebe eintraege nach unten;
+           LEAVE tabulator position loeschen
+    FI
+  END REP;
+  fehler (43, par1).
+
+verschiebe eintraege nach unten:
+  INT VAR k;
+  FOR k FROM i UPTO anz tabs - 1 REP
+    tabs [k] := tabs [k + 1];
+    tab zeichen [k] := tab zeichen [k + 1];
+  END REP;
+  anz tabs DECR 1.
+END PROC tabulatorposition loeschen;
+
+PROC verarbeite tabelle:
+  in tabelle := TRUE;
+  pitch table auf blank ausgang setzen;
+  verarbeite tabellenzeilen;
+  pitch table auf blank setzen;
+  IF suchausgang gesetzt
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                                breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE; 
+  FI;
+  in tabelle := FALSE.
+
+verarbeite tabellenzeilen:
+  WHILE pufferlaenge <> 0 REP
+    ueberpruefe tabellenzeile;
+    zeichenpos := pufferlaenge;
+    neue zeile auffuellen und ausgabe bei zeilenende
+  END REP;
+  puffer       := " ";
+  pufferlaenge := 1;
+  zeichenpos   := 1;
+  fehler (49, "").
+
+ueberpruefe tabellenzeile:
+(* Achtung: Zeilenbreite ist Spaltenbreite;
+            tab zeilen breite ist Summe der Spalten und Positionen *)
+  INT VAR tab zeilen breite :: 0,
+          tab no   :: 1;
+  WHILE noch tab positionen OR only command line (puffer) REP
+    positioniere auf naechste spalte;
+    errechne spaltenbreite;
+    IF anz tabs > 0
+      THEN ueberpruefe ob es passt;
+    FI;
+    tab no INCR 1
+  END REP;
+  IF tabellenzeile breiter als limit
+    THEN warnung (10, "")
+  ELIF noch mehr spaltentexte AND anz tabs <> 0
+    THEN warnung (11, subtext (puffer, zeichenpos))
+  FI.
+
+noch tab positionen: 
+  tab no <= anz tabs.
+
+positioniere auf naechste spalte:
+  zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
+  IF leerzeile oder rest der zeile ist leer 
+    THEN IF NOT only command line (puffer) AND pufferlaenge > 1
+           THEN warnung (14, "")
+         FI;
+         LEAVE ueberpruefe tabellenzeile
+  FI.
+
+leerzeile oder rest der zeile ist leer:
+  zeichenpos <= 0.
+
+errechne spaltenbreite:
+  zeilenbreite := 0;
+  BOOL VAR suchausgang gesetzt :: FALSE;
+  IF diese position ist dezimal pos
+    THEN setze dezimalzeichen auf suchausgang
+  FI;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    zeichenpos INCR 1;
+    IF zeichenwert ausgang = blank ausgang
+      THEN behandele dieses blank
+    ELIF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite das kommando
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = such ausgang
+      THEN verarbeite ersten teil der dezimal zentrierung 
+    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN fehler (23, "");
+           LEAVE ueberpruefe tabellenzeile
+    ELIF zeilenbreite + zeichenwert ausgang > aktuelle pitch zeilenlaenge
+      THEN fehler (36, "");
+           LEAVE ueberpruefe tabellenzeile
+      ELSE tabellenzeile ohne absatz
+    FI
+  END REP.
+ 
+diese position ist dezimal pos:
+  tabs [tab no] [2] = dpos.
+
+setze dezimalzeichen auf suchausgang:
+  INT CONST pos tab zeichen in pitch table ::
+                 code (tab zeichen [tab no] SUB 1) + 1;
+  INT VAR breite erstes dezimalzeichen :=breite (tab zeichen [tab no] SUB 1),
+          breite excl dezimalzeichen := 0;
+  suchausgang gesetzt := TRUE;
+  pitch table [pos tab zeichen in pitch table] := such ausgang.
+
+verarbeite ersten teil der dezimal zentrierung:
+  IF pos (puffer, tab zeichen [tab no], zeichenpos) = zeichenpos
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                           breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE;
+         breite excl dezimalzeichen := zeilenbreite
+  FI;
+  zeilenbreite INCR breite (puffer SUB zeichenpos);
+  zeichenpos INCR 1.
+
+behandele dieses blank:
+  IF doppelblank OR absatz
+    THEN LEAVE errechne spaltenbreite
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp;
+         zeichenpos INCR 1
+  FI.
+
+doppelblank:
+  (puffer SUB zeichenpos + 1) = blank.
+
+verarbeite das kommando:
+  pitch table auf blank setzen;
+  verarbeite kommando und neue zeile auffuellen;
+  pitch table auf blank ausgang setzen;
+  IF kommando index = table end
+    THEN LEAVE verarbeite tabellenzeilen
+  ELIF suchausgang gesetzt AND
+       pitch table [pos tab zeichen in pitch table] <> suchausgang
+    THEN pitch table [pos tab zeichen in pitch table] := suchausgang
+  FI.
+
+tabellenzeile ohne absatz:
+  IF zeilenende eines macros
+    THEN zeile in puffer und zeile lesen;
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
+    ELSE LEAVE errechne spaltenbreite
+  FI.
+
+zeilenende eines macros:
+  zeichenwert ausgang = zeilenende ausgang AND macro works.
+
+ueberpruefe ob es passt:
+  INT CONST akt tab pos :: tabs [tab no] [1];
+  IF vorherige spalte ueberschreibt tabulator position 
+    THEN cm angabe der druckposition in dummy (tab no - 1);
+         fehler (44, dummy);
+         tab zeilenbreite := akt tab pos
+  ELIF only command line (puffer)
+    THEN
+    ELSE ueberpruefe nach art des tabulators
+  FI.
+
+ueberpruefe nach art des tabulators:
+  IF   tabs [tab no] [2] = r pos
+    THEN nach links schreibend
+  ELIF tabs [tab no] [2] = l pos
+    THEN nach rechts schreibend
+  ELIF tabs [tab no] [2] = b pos
+    THEN nach rechts blockend schreibend
+  ELIF tabs [tab no] [2] = c pos
+    THEN zentrierend
+    ELSE zentrierend um zeichen
+  FI.
+
+vorherige spalte ueberschreibt tabulator position:
+  tab zeilenbreite > akt tab pos.
+
+nach links schreibend:
+  IF tab zeilenbreite + zeilenbreite > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no); 
+         fehler (45, dummy);
+  FI;
+  tab zeilenbreite := akt tab pos.
+
+nach rechts schreibend:
+  tab zeilenbreite := akt tab pos + zeilenbreite.
+
+nach rechts blockend schreibend:
+  IF akt tab pos + zeilenbreite > tabs [tab no] [3]
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (48, dummy)
+  FI;
+  tab zeilenbreite := tabs [tab no] [3].
+
+zentrierend:
+  IF tab zeilenbreite + (zeilenbreite DIV 2) > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (46, dummy)
+  FI;
+  tab zeilenbreite := akt tab pos + (zeilenbreite DIV 2).
+
+zentrierend um zeichen:
+  IF breite excl dezimalzeichen = 0
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (50, dummy)
+  ELIF tab zeilenbreite + breite excl dezimalzeichen > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (47, dummy)
+  FI;
+  IF suchausgang gesetzt
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                                breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE; 
+  FI;
+  tab zeilenbreite := akt tab pos +
+                                 (zeilenbreite - breite excl dezimalzeichen).
+
+tabellenzeile breiter als limit:
+  tab zeilenbreite > aktuelle pitch zeilenlaenge + einrueckbreite.
+
+noch mehr spaltentexte:
+  pos (puffer, ""33"", ""255"", zeichenpos) <> 0.
+END PROC verarbeite tabelle;
+ 
+(*********************** referenzen ueberpruefen **********************)
+ 
+PROC aktuelle referenz erstellen:
+  aktuelle referenz := "#";
+  aktuelle referenz CAT par1;
+  aktuelle referenz CAT "#";
+END PROC aktuelle referenz erstellen;
+
+PROC zielreferenzen speichern ohne warnung:
+  aktuelle referenz erstellen;
+  IF pos (zielreferenzen, aktuelle referenz) = 0 
+    THEN delete char (aktuelle referenz, 1);
+         zielreferenzen CAT aktuelle referenz
+  FI 
+END PROC zielreferenzen speichern ohne warnung;
+
+PROC zielreferenzen speichern:
+  aktuelle referenz erstellen;
+  IF pos (zielreferenzen, aktuelle referenz) <> 0 
+    THEN warnung (9, par1) 
+    ELSE delete char (aktuelle referenz, 1);
+         zielreferenzen CAT aktuelle referenz
+  FI 
+END PROC zielreferenzen speichern;
+ 
+PROC herkunftsreferenzen speichern:
+  aktuelle referenz erstellen;
+  IF pos (herkunftsreferenzen, aktuelle referenz) = 0 
+    THEN delete char (aktuelle referenz, 1);
+         herkunftsreferenzen CAT aktuelle referenz
+  FI 
+END PROC herkunftsreferenzen speichern; 
+ 
+PROC referenzen ueberpruefen: 
+  ueberpruefe zielreferenzen; 
+  ueberpruefe restliche herkunftsreferenzen. 
+ 
+ueberpruefe zielreferenzen: 
+  REP 
+    hole naechste zielreferenz; 
+    IF pos (herkunfts referenzen, aktuelle referenz) = 0 
+      THEN change all (aktuelle referenz,"#", ""); 
+           warnung (3, aktuelle referenz)
+      ELSE delete char (aktuelle referenz, length (aktuelle referenz));
+           change (herkunftsreferenzen, aktuelle referenz, ""); 
+    FI
+  END REP. 
+ 
+hole naechste zielreferenz: 
+  IF length (zielreferenzen) > 1
+    THEN aktuelle referenz :=
+            subtext (zielreferenzen, 1, pos (zielreferenzen, "#", 2));
+         zielreferenzen := 
+            subtext (zielreferenzen, pos (zielreferenzen, "#", 2))
+    ELSE LEAVE ueberpruefe zielreferenzen 
+  FI. 
+ 
+ueberpruefe restliche herkunftsreferenzen: 
+  WHILE length (herkunftsreferenzen) > 1 REP 
+    aktuelle referenz :=
+     subtext (herkunftsreferenzen, 1, pos (herkunftsreferenzen, "#", 2) - 1);
+    change (herkunftsreferenzen, aktuelle referenz, "");
+    delete char (aktuelle referenz, 1); 
+    warnung (4, aktuelle referenz) 
+  END REP. 
+END PROC referenzen ueberpruefen;
+ 
+(*************************** Utilities *******************************)
+
+INT PROC breite (TEXT CONST z):
+  INT VAR b;
+  IF z = ""
+    THEN display and pause (1)
+  ELIF z = kommandozeichen
+    THEN display and pause (2); b := 1
+    ELSE b := pitch table [code (z) + 1]
+  FI;
+  IF zeilenbreite > maxint - b
+    THEN display and pause (3); b := 1
+  FI;
+  b.
+END PROC breite;
+
+INT PROC breite (TEXT CONST ein text, INT CONST zpos):
+  TEXT CONST z :: ein text SUB zpos;
+  INT VAR zeichen breite;
+  IF z = ""
+    THEN display and pause (4); zeichen breite := 1
+  ELIF z = kommandozeichen
+    THEN display and pause (6); zeichen breite := 1
+    ELSE zeichen breite := pitch table [code (z) + 1]
+  FI;
+  IF zeichen breite = extended char ausgang
+    THEN zeichen breite := extended char pitch (font nr,
+           ein text SUB zpos, ein text SUB zpos + 1)
+  FI;
+  zeichen breite
+END PROC breite;
+
+PROC char pos move (INT CONST richtung):
+  char pos move (zeichenpos, richtung)
+END PROC char pos move;
+
+PROC char pos move (INT VAR zpos, INT CONST richtung):
+  char pos move (puffer, zpos, richtung)
+END PROC char pos move;
+
+BOOL PROC absatz:
+  zeichenpos = pufferlaenge AND puffer hat absatz
+END PROC absatz;
+
+BOOL PROC puffer hat absatz:
+  NOT within kanji (puffer, pufferlaenge) AND
+  (puffer SUB pufferlaenge) = blank
+END PROC puffer hat absatz;
+
+PROC pitch table auf blank ausgang setzen:
+  IF pitch table [code (blank) + 1] <> blank ausgang
+    THEN blank breite fuer diesen schrifttyp := breite (blank);
+         pitch table [code (blank) + 1] := blank ausgang
+  FI
+END PROC pitch table auf blank ausgang setzen;
+
+PROC pitch table auf blank setzen:
+  pitch table [code (blank) + 1] := blank breite fuer diesen schrifttyp
+END PROC pitch table auf blank setzen;
+
+(*PROC zustands test (TEXT CONST anf):
+line ;put(anf);
+line ;put("zeilenbreite, aktuelle pitch zeilenlaenge:");
+     put(zeilenbreite);put(aktuelle pitch zeilenlaenge);
+line ;put("zeichenpos, pufferlaenge, ausgang, zeichen:");
+put(zeichenpos);put(pufferlaenge);
+IF zeichenwert ausgang = blank ausgang
+  THEN put ("blank")
+ELIF zeichenwert ausgang = kommando ausgang
+  THEN put ("kommando")
+ELIF zeichenwert ausgang = such ausgang
+  THEN put ("such")
+ELIF zeichenwert ausgang = zeilenende ausgang
+  THEN put ("zeilenende")
+  ELSE put(zeichenwert ausgang);
+FI; put ("ausgang");
+out(">");out(puffer SUB zeichenpos);out("<");
+line ;out("puffer >");
+IF length (puffer) > 65
+  THEN outsubtext (puffer, 1, 65);
+       line ; outsubtext (puffer, 66)
+  ELSE out(puffer);
+FI;
+out("<");
+line ;out("zeile >");
+IF length (zeile) > 65
+  THEN outsubtext (zeile, 1, 65);
+       line ; outsubtext (zeile, 66)
+  ELSE out (zeile);
+FI;
+out("<");
+line ;out("neue zeile >");
+IF length (neue zeile) > 65
+  THEN outsubtext (neue zeile, 1, 65);
+       line ; outsubtext (neue zeile, 66)
+  ELSE out(neue zeile);
+FI;
+out("<");
+line ; 
+END PROC zustands test;*)
+
+(*************************** eigentliche form routine ********************)
+
+PROC zeilen form (TEXT CONST datei):
+  enable stop;
+  form initialisieren (datei);
+  formiere absatzweise;
+  letzte neue zeile ausgeben.
+
+formiere absatzweise:
+  REP
+    letzter puffer war absatz := FALSE;
+    einrueckbreite := eingestellte indentation pitch;
+    IF einfacher absatz nach absatz
+      THEN gebe einfachen absatz aus
+      ELSE verarbeite abschnitt nach absatz
+    FI
+  UNTIL pufferlaenge = 0 END REP.
+
+einfacher absatz nach absatz:
+  absatz.
+
+gebe einfachen absatz aus:
+  neue zeile := blank;
+  ausgabe bei zeilenende.
+
+verarbeite abschnitt nach absatz:
+  berechne erste zeile nach absatz;
+  IF NOT letzter puffer war absatz
+    THEN formiere
+  FI.
+
+formiere:
+  INT VAR letzte zeilennr;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang   = kommando ausgang
+      THEN zeichenpos INCR 1;
+           verarbeite kommando und neue zeile auffuellen;
+           IF letzter puffer war absatz
+             THEN ausgabe bei zeilenende;
+                  LEAVE verarbeite abschnitt nach absatz
+           ELIF zeichenpos > pufferlaenge OR absatz
+             THEN letzte zeilennr := zeilennr;
+                  verarbeite letztes zeichen von puffer;
+                  IF neue zeile ausgeloest
+                    THEN LEAVE verarbeite abschnitt nach absatz
+                    ELSE letzter puffer war absatz := FALSE
+                  FI
+           FI
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN letzte zeilennr := zeilennr;
+           verarbeite letztes zeichen von puffer;
+           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+             THEN fehler (23, "")
+           FI;
+           IF neue zeile ausgeloest
+             THEN LEAVE verarbeite abschnitt nach absatz
+             ELSE letzter puffer war absatz := FALSE
+           FI
+      ELSE ende einer neuen zeile
+    FI;
+  UNTIL pufferlaenge = 0 END REP. 
+
+neue zeile ausgeloest:
+  letzte zeilennr < zeilennr.
+END PROC zeilen form;
+
+PROC berechne erste zeile nach absatz:
+  INT CONST anz einrueckungszeichen :: zeilenbreite DIV einrueckbreite;
+  INT VAR anz zeichen fuer einzeilige einrueckung :: 0,
+          anz zeichen          :: 0,
+          schlepper zeichenpos :: 1,
+          letzte zeilennr;
+  BOOL CONST puffer hatte anfangs absatz :: puffer hat absatz;
+  BOOL VAR   noch kein blank gewesen :: TRUE;
+  pitch table auf blank ausgang setzen;
+  berechne erste zeile;
+  pitch table auf blank setzen.
+
+berechne erste zeile:
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang   = blank ausgang
+      THEN verarbeite text
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite dieses kommando
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN behandele zu kurze zeile
+      ELSE behandele zu lange zeile
+    FI
+  END REP.
+
+verarbeite dieses kommando:
+  textzeichen mitzaehlen;
+  IF pos (" #", (puffer SUB zeichenpos)) = 0
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
+  FI;
+  char pos move (vorwaerts);
+  mitzuzaehlende zeichen := 0;
+  pitch table auf blank setzen;
+  verarbeite kommando und neue zeile auffuellen;
+  pitch table auf blank ausgang setzen;
+  IF letzter puffer war absatz
+    THEN neue zeile auffuellen und ausgabe bei zeilenende;
+         LEAVE berechne erste zeile
+  ELIF zeichenpos > pufferlaenge OR absatz
+    THEN letzte zeilennr := zeilennr;
+         verarbeite letztes zeichen von puffer;
+         IF neue zeile ausgeloest
+           THEN LEAVE berechne erste zeile
+           ELSE letzter puffer war absatz := FALSE
+         FI
+  ELIF anweisung erlaubt keine aufzaehlung
+    THEN LEAVE berechne erste zeile
+  FI;
+  anz zeichen INCR mitzuzaehlende zeichen;
+  schlepper zeichenpos := zeichenpos.
+
+neue zeile ausgeloest:
+  letzte zeilennr < zeilennr.
+
+anweisung erlaubt keine aufzaehlung:
+  kommando index = center OR kommando index = right.
+
+verarbeite text:
+  char pos move (vorwaerts);
+  IF absatz
+    THEN verarbeite letztes zeichen von puffer;
+         LEAVE berechne erste zeile
+  ELIF zeilenbreite + blankbreite fuer diesen schrifttyp >
+                                                  aktuelle pitch zeilenlaenge
+    THEN behandele zu lange zeile
+  ELIF mehrfaches blank
+    THEN positionierung mit doppelblank
+  ELIF noch kein blank gewesen AND
+       anz zeichen +
+                number chars (puffer, schlepper zeichenpos, zeichenpos) <= 20
+    THEN ggf aufzaehlung aufnehmen
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
+  FI;
+  noch kein blank gewesen := FALSE;
+  zeichenpos INCR 1.
+
+mehrfaches blank:
+  (puffer SUB zeichenpos + 1) = blank.
+
+positionierung mit doppelblank:
+  WHILE NOT within kanji (puffer, zeichenpos + 1) AND
+        (puffer SUB zeichenpos + 1) = blank REP
+    zeichenpos INCR 1
+  END REP;
+  textzeichen mitzaehlen;
+  pruefe auf ueberschreibung
+              (zeilenbreite, anz zeichen + anz einrueckungszeichen).
+
+ggf aufzaehlung aufnehmen:
+  IF NOT within kanji (puffer, zeichenpos - 1) AND
+     (puffer SUB zeichenpos - 1) <> kommandozeichen
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos - 1);
+  FI;
+  textzeichen mitzaehlen;
+  IF    aufzaehlungszeichen = ":"
+     OR (aufzaehlungszeichen = "-" AND anz zeichen <= 2)
+     OR (anz zeichen <= 7 AND (   aufzaehlungszeichen = ")"
+                               OR aufzaehlungszeichen = "."))
+    THEN anz zeichen fuer einzeilige einrueckung := anz zeichen;
+         pruefe auf ueberschreibung
+               (zeilenbreite, anz zeichen + anz einrueckungszeichen)
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
+  FI.
+
+textzeichen mitzaehlen:
+  anz zeichen INCR number chars (puffer, schlepper zeichenpos, zeichenpos);
+  IF is kanji esc (puffer SUB zeichenpos)
+    THEN schlepper zeichenpos := zeichenpos + 2
+    ELSE schlepper zeichenpos := zeichenpos + 1
+  FI.
+
+behandele zu kurze zeile:
+  textzeichen mitzaehlen;
+  IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+    THEN fehler (23, "");
+         neue zeile auffuellen;
+         schreibe und initialisiere neue zeile;
+         zeichenpos := 1;
+         LEAVE berechne erste zeile
+  FI;
+  letzte zeilennr := zeilennr;
+  verarbeite letztes zeichen von puffer;
+  IF neue zeile ausgeloest
+    THEN LEAVE berechne erste zeile
+  FI;
+  schlepper zeichenpos := 1.
+
+behandele zu lange zeile:
+  pitch table auf blank setzen;
+  IF zeilenende bei erstem zeichen
+    THEN loesche nachfolgende blanks;
+         schreibe und initialisiere neue zeile;
+         zeichenpos := 1;
+         LEAVE berechne erste zeile
+  ELIF (puffer SUB zeichenpos) = kommandozeichen
+    THEN zeichenpos INCR 1
+    ELSE zeilenbreite DECR breite (puffer, zeichenpos)
+  FI;
+  IF puffer hatte anfangs absatz
+    THEN einrueckung gemaess pufferanfang
+  FI;
+  LEAVE berechne erste zeile.
+
+zeilenende bei erstem zeichen:
+  zeichenpos < 1.
+
+einrueckung gemaess pufferanfang:
+alte blanks :=
+(anz einrueckungszeichen + anz zeichen fuer einzeilige einrueckung) * blank.
+END PROC berechne erste zeile nach absatz;
+
+PROC pruefe auf ueberschreibung (INT CONST aufzaehlungsbreite,
+                                           anz aufzaehlungszeichen):
+  IF ueberschreibung
+    THEN fehlende blanks errechnen;
+         INT VAR aufzaehlungsende :: zeichenpos - 1;
+         WHILE (puffer SUB aufzaehlungsende) = blank REP
+           aufzaehlungsende DECR 1
+         END REP;
+         dummy := ">"; 
+         dummy CAT subtext (puffer,
+                            aufzaehlungsende - 15, aufzaehlungsende);
+         dummy CAT "< Fehlende Blanks: ";
+         dummy CAT text (anz fehlende blanks);
+         warnung (12, dummy)
+  FI;
+  zeilenbreite := anz aufzaehlungszeichen * einrueckbreite.
+
+ueberschreibung:
+  INT CONST anz zeichen mal einrueckbreite ::
+                                anz aufzaehlungszeichen * einrueckbreite,
+            min zwischenraum :: (einrueckbreite DIV 4);
+  aufzaehlungsbreite + min zwischenraum > anz zeichen mal einrueckbreite.
+
+fehlende blanks errechnen:
+  INT VAR anz fehlende blanks ::
+  (aufzaehlungsbreite + min zwischenraum
+                   - anz zeichen mal einrueckbreite + einrueckbreite - 1)
+   DIV einrueckbreite.
+END PROC pruefe auf ueberschreibung;
+
+(********************** eingabe routinen **************************)
+
+PROC zeile lesen:
+  alte blanks := aktuelle blanks;
+  hole zeile;
+  behandele einrueckung.
+
+hole zeile:
+  IF macro works
+    THEN get macro line (zeile);
+  ELIF eof (eingabe)
+    THEN zeile := "";
+         LEAVE zeile lesen
+    ELSE lesen
+  FI;
+  IF zeile = ""
+    THEN zeile := blank
+  ELIF (zeile SUB length (zeile) - 1) = blank
+    THEN ggf ueberfluessige leerzeichen am ende entfernen
+  FI.
+
+lesen:
+  IF format file in situ
+    THEN read record (eingabe, zeile);
+         delete record (eingabe)
+    ELSE read record (eingabe, zeile);
+         down (eingabe)
+  FI.
+ 
+ggf ueberfluessige leerzeichen am ende entfernen:
+  WHILE NOT within kanji (zeile, length (zeile) - 1) AND
+        subtext (zeile, length (zeile) - 1) = "  " REP 
+    delete char (zeile, length (zeile)) 
+  END REP. 
+ 
+behandele einrueckung:
+  aktuelle blanks := "";
+  IF zeile <> blank
+    THEN INT VAR einrueckung := pos (zeile, ""33"", ""255"", 1);
+         IF einrueckung > 1
+           THEN aktuelle blanks := subtext (zeile, 1, einrueckung - 1);
+                zeile := subtext (zeile, einrueckung)
+         FI
+  FI
+END PROC zeile lesen;
+
+PROC zeile in puffer und zeile lesen:
+  puffer := zeile;
+  zeichenpos := 1;
+  von        := 1;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen;
+END PROC zeile in puffer und zeile lesen;
+
+PROC ggf absatz an puffer anfuegen:
+  IF    (zeile ist nur absatz AND NOT puffer hat absatz)
+     OR (NOT puffer hat absatz AND only command line (puffer)
+         AND only command line (zeile))
+    THEN puffer CAT blank;
+         pufferlaenge := length (puffer)
+  ELIF puffer ist nur absatz AND (zeile SUB length (zeile)) <> " " AND
+       only command line (zeile)
+    THEN zeile CAT " "
+  FI. 
+ 
+puffer ist nur absatz:
+  puffer = blank.
+
+zeile ist nur absatz: 
+  zeile = blank. 
+END PROC ggf absatz an puffer anfuegen;
+
+(****************** routinen fuer zeilenende behandlung ***********)
+
+PROC verarbeite letztes zeichen von puffer:
+  zeichenpos := length (puffer);
+  begin of this char (puffer, zeichenpos);
+  zeichen := puffer SUB zeichenpos;
+  IF trennung vorhanden
+    THEN IF zeile hat richtige laenge
+           THEN neue zeile auffuellen und ausgabe bei zeilenende
+           ELSE getrennte zeilen zusammenziehen
+         FI
+  ELSE neue zeile auffuellen;
+       IF absatz
+         THEN letzter puffer war absatz := TRUE;
+              IF letztes kommando war macro AND macro hat absatz getaetigt
+                THEN zeile in puffer und zeile lesen;
+                     initialisiere neue zeile;
+                ELSE ausgabe bei zeilenende;
+              FI
+         ELSE neue zeile ggf weiterfuehren
+       FI
+  FI.
+ 
+neue zeile ggf weiterfuehren:
+  IF macro end in dieser oder naechster zeile
+    THEN
+  ELIF zeile = ""
+    THEN schreibe und initialisiere neue zeile;
+         letzter puffer war absatz := TRUE
+  ELIF zeilenbreite + blank breite fuer diesen schrifttyp >
+                                                 aktuelle pitch zeilenlaenge
+    THEN loesche nachfolgende blanks;
+         schreibe und initialisiere neue zeile
+  ELIF in neuer zeile steht etwas
+    THEN neue zeile CAT blank;
+         zeilenbreite INCR blank breite fuer diesen schrifttyp
+  FI;
+  zeile in puffer und zeile lesen.
+
+macro end in dieser oder naechster zeile:
+  macro works AND (pos (puffer, "#*") <> 0 OR pos (zeile, "#*") <> 0).
+
+in neuer zeile steht etwas:
+  pos (neue zeile, ""33"", ""255"", 1) <> 0.
+
+letztes kommando war macro:
+  pos (kommando, "macro") <> 0.
+
+macro hat absatz getaetigt:
+  NOT in neuer zeile steht etwas.
+END PROC verarbeite letztes zeichen von puffer;
+ 
+PROC getrennte zeilen zusammenziehen:
+  zeichen := puffer SUB pufferlaenge;
+  IF NOT within kanji (puffer, pufferlaenge) AND zeichen = trennzeichen
+    THEN zeilenbreite DECR breite (trennzeichen);
+         delete char (puffer, pufferlaenge);
+         pufferlaenge := length (puffer);
+         IF ((puffer SUB pufferlaenge) = trenn k) AND ((zeile SUB 1) = "k")
+           THEN replace (puffer, pufferlaenge, "c");
+                zeilenbreite DECR breite ("k");
+                zeilenbreite INCR breite ("c");
+         FI;
+         zeichenpos := pufferlaenge + 1
+  FI;
+  puffer CAT zeile;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen;
+END PROC getrennte zeilen zusammenziehen;
+ 
+BOOL PROC trennung vorhanden:
+  IF within kanji (puffer, pufferlaenge)
+    THEN LEAVE trennung vorhanden WITH FALSE
+  FI;
+  zeichen := puffer SUB pufferlaenge;
+  zeichen = trennzeichen OR wort mit bindestrich.
+
+wort mit bindestrich:
+  zeichen = bindestrich AND kein leerzeichen davor
+   AND NOT naechstes wort ist konjunktion AND kein loser gedankenstrich.
+
+kein leerzeichen davor:
+ NOT within kanji (puffer, pufferlaenge - 1) AND
+     (puffer SUB pufferlaenge - 1) <> blank.
+
+naechstes wort ist konjunktion:
+     pos (zeile, "und")   = 1
+  OR pos (zeile, "oder")  = 1
+  OR pos (zeile, "bzw")   = 1
+  OR pos (zeile, "sowie") = 1.
+
+kein loser gedankenstrich:
+  pufferlaenge > 1.
+END PROC trennung vorhanden;
+ 
+BOOL PROC zeile hat richtige laenge:
+  zeilenbreite > aktuelle pitch zeilenlaenge - trennbreite
+END PROC zeile hat richtige laenge;
+
+(*********************** ausgabe routinen *******************)
+
+PROC ende einer neuen zeile:
+  IF zeichenpos > 0
+    THEN begin of this char (puffer, zeichenpos);
+  FI;
+  zeichen := puffer SUB zeichenpos;
+  zeichenpos bereits verarbeitet := 0;
+  IF naechstes zeichen ist absatz
+    THEN zeichenpos := pufferlaenge;
+         verarbeite letztes zeichen von puffer;
+         LEAVE ende einer neuen zeile 
+  ELIF zeichen = blank
+    THEN neue zeile auffuellen (von, zeichenpos - 1);
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); 
+         von := zeichenpos;
+  ELIF nach zeichenpos beginnt ein neues wort
+    THEN neue zeile auffuellen (von, zeichenpos); 
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos + 1);
+         von := zeichenpos
+  ELIF letzter puffer passte genau
+    THEN (* erstes zeichen des neuen puffers > zeilenbreite *)
+         zeichenpos := 1;
+         von := 1
+    ELSE zeichenpos bereits verarbeitet := zeichenpos;
+         trennung eventuell vornehmen;
+         IF erstes wort auf der absatzzeile laesst sich nicht trennen
+           THEN alte blanks := aktuelle blanks
+         FI
+  FI;
+  loesche nachfolgende blanks;
+  IF NOT in foot uebertrag
+    THEN schreibe und initialisiere neue zeile;
+         zeilenbreite und zeichenpos auf das bereits verarbeitete
+         zeichen setzen;
+  FI.
+
+erstes wort auf der absatzzeile laesst sich nicht trennen:
+  pos (neue zeile, ""33"", ""255"", 1) = 0 AND  (*keine buchstaben*)
+  length (neue zeile) > 1 AND                   (*einrueckung*)
+  (neue zeile SUB length (neue zeile)) = blank. (* Absatz *)
+
+naechstes zeichen ist absatz:
+  zeichenpos + 1 = pufferlaenge AND puffer hat absatz.
+
+nach zeichenpos beginnt ein neues wort:
+  (pufferlaenge > zeichenpos + 2) AND (puffer SUB zeichenpos + 1) = blank.
+
+letzter puffer passte genau:
+  zeichenpos <= 0.
+
+zeilenbreite und zeichenpos auf das bereits verarbeitete zeichen setzen:
+  IF zeichenpos bereits verarbeitet <> 0
+    THEN INT VAR bis := zeichenpos, einfuege pos := bis;
+         zeilenbreite um die bereits verarbeiteten zeichen erhoehen; 
+         zeichenpos := zeichenpos bereits verarbeitet;
+         IF einfuege pos > 1
+           THEN insert char (puffer, blank, einfuege pos);
+                pufferlaenge := length (puffer);
+                von := einfuege pos + 1;
+                char pos move (vorwaerts)
+         FI;
+         char pos move (vorwaerts);
+  FI.
+
+zeilenbreite um die bereits verarbeiteten zeichen erhoehen:
+  zeichenpos := zeichenpos bereits verarbeitet;
+  WHILE (puffer SUB bis) = kommandozeichen REP
+    bis := pos (puffer, kommandozeichen, bis + 1) + 1
+  END REP;
+  begin of this char (puffer, zeichenpos);
+  WHILE zeichenpos >= bis REP
+    IF (puffer SUB zeichenpos) = kommandozeichen
+      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts)
+      ELSE zeilenbreite INCR breite (puffer, zeichenpos);
+    FI;
+    IF zeichenpos <= 1
+      THEN LEAVE zeilenbreite um die bereits verarbeiteten zeichen erhoehen
+    FI;
+    char pos move (rueckwaerts)
+  END REP.
+END PROC ende einer neuen zeile;
+ 
+PROC loesche nachfolgende blanks:
+  WHILE NOT within kanji (neue zeile, length (neue zeile)) AND
+        (neue zeile SUB length (neue zeile)) = blank REP
+    delete char (neue zeile, length (neue zeile))
+  END REP
+END PROC loesche nachfolgende blanks; 
+ 
+PROC neue zeile auffuellen:
+   dummy := subtext (puffer, von);
+   neue zeile CAT dummy
+END PROC neue zeile auffuellen;
+
+PROC neue zeile auffuellen (INT CONST from, to):
+   dummy := subtext (puffer, from, to);
+   neue zeile CAT dummy
+END PROC neue zeile auffuellen;
+
+PROC schreibe neue zeile:
+  IF macro works
+    THEN IF alte neue zeile einschliesslich macro ist auszugeben
+           THEN schreibe textteil einschliesslich macro;
+         FI
+  ELSE schreibe;
+       pruefe auf abbruch
+  FI.
+
+alte neue zeile:
+  before macro state . new line.
+
+alter puffer:
+  before macro state . buffer line.
+
+alte neue zeile einschliesslich macro ist auszugeben:
+  INT VAR text anf :: pos (alte neue zeile, ""33"", ""255"", 1);
+  text anf <> 0.
+
+schreibe textteil einschliesslich macro:
+  dummy := neue zeile;
+  neue zeile := alte neue zeile;
+  IF macro hatte absatz danach
+    THEN neue zeile CAT " "
+    ELSE zeilennr INCR 1
+  FI;
+  schreibe;
+  neue zeile := dummy;
+  alte neue zeile := subtext (alte neue zeile, 1, text anf - 1).
+
+macro hatte absatz danach:
+  length (alter puffer) - 1 = length (alte neue zeile) AND
+     (alter puffer SUB length (alter puffer)) = " ".
+
+pruefe auf abbruch:
+  IF incharety = escape
+    THEN errorstop ("Abbruch mit ESC")
+  FI.
+END PROC schreibe neue zeile;
+
+PROC schreibe:
+  IF format file in situ
+    THEN insert record (eingabe);
+         write record (eingabe, neue zeile);
+         down (eingabe)
+    ELSE insert record (ausgabe);
+         write record  (ausgabe, neue zeile);
+         down (ausgabe);
+         speicher ueberlauf
+  FI;
+  execute stored commands;
+  IF (neue zeile SUB length (neue zeile)) = blank
+    THEN einrueckbreite := eingestellte indentation pitch
+  FI.
+
+speicher ueberlauf:
+  INT VAR size, used;
+  storage (size, used);
+  IF used > size
+    THEN errorstop ("Speicherengpaß")
+  FI.
+END PROC schreibe;
+
+PROC schreibe und initialisiere neue zeile:
+   schreibe neue zeile;
+   initialisiere neue zeile
+END PROC schreibe und initialisiere neue zeile;
+
+PROC ausgabe bei zeilenende:
+  schreibe und initialisiere neue zeile;
+  zeile in puffer und zeile lesen
+END PROC ausgabe bei zeilenende;
+
+PROC neue zeile auffuellen und ausgabe bei zeilenende:
+  neue zeile auffuellen;
+  schreibe und initialisiere neue zeile;
+  zeile in puffer und zeile lesen
+END PROC neue zeile auffuellen und ausgabe bei zeilenende;
+
+PROC initialisiere neue zeile:
+  einrueckung in die neue zeile;
+  zeilennummer mitzaehlen.
+
+einrueckung in die neue zeile:
+  IF  zeichenpos < pufferlaenge AND
+      (puffer hat absatz OR foot ohne absatz am zeilenende)
+    THEN neue zeile := alte blanks
+    ELSE neue zeile := aktuelle blanks
+  FI;
+  zeilenbreite := length (neue zeile) * einrueckbreite;
+  IF zeilenbreite +trennbreite +einrueckbreite >= aktuelle pitch zeilenlaenge
+    THEN fehler (10, "");
+         zeilenbreite := 0;
+  FI.
+
+foot ohne absatz am zeilenende:
+  pos (puffer, "#foot#") > 1 AND pos (puffer, "#foot#") = length (puffer) -5.
+
+zeilennummer mitzaehlen:
+  IF NOT macro works
+    THEN zeilennr INCR 1;
+         cout (zeilennr);
+  FI.
+END PROC initialisiere neue zeile;
+
+PROC letzte neue zeile ausgeben:
+  IF pos (neue zeile, ""33"", ""255"", 1) <> 0
+    THEN schreibe neue zeile
+  FI;
+  offene modifikationen ausgeben;
+  offene indizes ausgeben;
+  IF aktueller editor < 1
+    THEN referenzen ueberpruefen;
+         offene counter referenzen ausgeben;
+  FI.
+
+offene modifikationen ausgeben:
+  WHILE length (modifikations speicher) <> 0 REP
+    dummy := (modifikations speicher SUB 1);
+    delete char (modifikations speicher, 1);
+    dummy CAT " in Zeile ";
+    dummy CAT text (mod zeilennr speicher ISUB 1);
+    delete int (mod zeilennr speicher, 1);
+    warnung (5, dummy)
+  END REP.
+
+offene indizes ausgeben:
+  WHILE length (index speicher) <> 0 REP
+    dummy := (index speicher SUB 1);
+    delete char (index speicher, 1);
+    dummy CAT " in Zeile ";
+    dummy CAT text (ind zeilennr speicher ISUB 1);
+    delete int (ind zeilennr speicher, 1);
+    warnung (6, dummy)
+  END REP.
+
+offene counter referenzen ausgeben:
+  INT VAR begin pos := pos (counter reference store, "#");
+  WHILE begin pos > 0 REP
+    INT VAR end pos := pos (counter reference store, "#", begin pos + 1);
+    IF (counter reference store SUB begin pos - 1) <> "u"
+      THEN fehler (60, subtext (counter reference store, begin pos + 1,
+                                end pos - 1))
+    ELIF (counter reference store SUB begin pos - 2) <> "i"
+      THEN fehler (61, subtext (counter reference store, begin pos + 1,
+                                end pos - 1))
+    FI;
+    begin pos := pos (counter reference store, "#", end pos + 1)
+  END REP.
+END PROC letzte neue zeile ausgeben;
+
+(*********************** silbentrenn routinen *******************)
+
+INT PROC position von (TEXT CONST such zeichen, INT CONST richtung,
+                       INT VAR anz zeich, breite der z):
+  INT VAR index :: zeichenpos;
+  TEXT VAR akt z;
+  anz zeich    := 0;
+  breite der z := 0;
+  WHILE index > 1 AND index < pufferlaenge REP
+    akt z := puffer SUB index;
+    IF akt z   = such zeichen
+      THEN LEAVE position von WITH index
+    ELIF akt z = kommandozeichen
+      THEN ueberspringe das kommando (puffer, index, richtung);
+           IF nur ein kommandozeichen gefunden
+             THEN gehe nur bis erstes kommandozeichen
+           ELIF index <= 1 OR index >= pufferlaenge
+             THEN LEAVE position von WITH index
+           FI
+      ELSE anz zeich INCR 1;
+           breite der z INCR breite (puffer, index)
+    FI;
+    char pos move (index, richtung)
+  END REP;
+  anz zeich INCR 1;
+  breite der z INCR breite (puffer, index);
+  index.
+
+nur ein kommandozeichen gefunden:
+  (puffer SUB index) <> kommandozeichen.
+
+gehe nur bis erstes kommandozeichen:
+  index := zeichenpos; anz zeich := 0; breite der z := 0;
+  WHILE (puffer SUB index) <> kommandozeichen REP
+    anz zeich INCR 1;
+    breite der z INCR breite (puffer, index);
+    char pos move (index, richtung)
+  END REP;
+  IF richtung <> rueckwaerts
+    THEN index DECR 1
+  FI;
+  LEAVE position von WITH index.
+END PROC position von;
+
+PROC ueberspringe das kommando (TEXT CONST t, INT VAR i, INT CONST richtung):
+  REP
+    i INCR richtung;
+    IF within kanji (t, i)
+      THEN i INCR richtung
+    FI
+  UNTIL (t SUB i) = kommandozeichen OR i <= 1 OR i >= length (t) END REP.
+END PROC ueberspringe das kommando;
+
+PROC trennung eventuell vornehmen: 
+INT VAR xwort1, ywort1,
+        anz zeichen davor,
+        breite davor;
+  IF macro works
+    THEN fehler (6, "")
+  FI;
+  trennsymbol := trennzeichen;
+  wortanfang := position von
+                       (blank, rueckwaerts, anz zeichen davor, breite davor);
+  bereite neue zeile bis wortanfang auf;
+  IF trennung sinnvoll
+    THEN versuche zu trennen
+    ELSE zeichenpos := wortanfang
+  FI.
+ 
+bereite neue zeile bis wortanfang auf:
+  IF wortanfang > 1
+    THEN wortanfang INCR 1
+  FI;
+  IF von > wortanfang
+    THEN eliminiere zeichen in neuer zeile bis wortanfang
+    ELSE neue zeile auffuellen (von, wortanfang - 1)
+  FI;
+  von := wortanfang.
+
+eliminiere zeichen in neuer zeile bis wortanfang:
+  INT VAR y :: length (neue zeile);
+  begin of this char (neue zeile, y);
+  WHILE y >= 1 REP
+    IF (neue zeile SUB y) = kommandozeichen
+      THEN ueberspringe das kommando (neue zeile, y, rueckwaerts)
+    FI;
+    char pos move (neue zeile, y, rueckwaerts)
+  UNTIL (neue zeile SUB y) = blank END REP;
+  neue zeile := subtext (neue zeile, 1, y).
+
+trennung sinnvoll:
+  anz zeichen davor > 2 AND breite davor > trennbreite.
+
+versuche zu trennen: 
+  INT CONST k := zeichenpos;
+  naechste zeile ggf heranziehen;
+  zeichenpos := k;
+  wortteile holen;
+  trenn (trennwort ohne komm, wort1 ohne komm, trennsymbol,
+                                               max trennlaenge ohne komm);
+  wort1 mit komm ermitteln;
+  IF lineform mode
+    THEN wort2 := subtext (trennwort, length (wort1) + 1, max trennlaenge);
+         display vorherige zeile bis wortanfang;
+         schreibe nicht trennbaren teil des trennwortes;
+         schreibe zeile nach trennwort;
+         skip input;
+         interaktive worttrennung
+  FI;
+  neue zeile mit trennwort versehen;
+  IF wort1 <> "" AND NOT lineform mode
+    THEN note (zeilen nr); note (": ");
+         note (trennwort);
+         note (" --> ");
+         note (wort1); note (trennsymbol);
+         wort2 := subtext (trennwort, length (wort1) + 1);
+         note (wort2);
+         note line
+  FI.
+
+wortteile holen:
+  zeichenpos durch trennzeichenbreite verschieben;
+  wort1 := subtext (puffer, wortanfang, zeichenpos);
+  max trennlaenge := length (wort1);
+  wortende ermitteln;
+  wort2 := subtext (puffer, zeichenpos, wortende);
+  trennwort := subtext (puffer, wortanfang, wortende);
+  trennwort ohne komm ermitteln;
+  wort1 ohne komm := subtext (trennwort ohne komm, 1, anz zeichen davor);
+  max trenn laenge ohne komm := anz zeichen davor.
+
+trennwort ohne komm ermitteln:
+  trennwort ohne komm := trennwort;
+  WHILE pos (trennwort ohne komm, kommando zeichen) <> 0 REP
+    INT CONST komm anf := pos (trennwort ohne komm, kommando zeichen),
+              komm ende:= pos (trennwort ohne komm, kommando zeichen,
+                                        komm anf + 1);
+    IF komm ende = 0
+      THEN LEAVE trennwort ohne komm ermitteln
+    FI;
+    dummy := subtext (trennwort ohne komm, komm ende + 1);
+    trennwort ohne komm := subtext (trennwort ohne komm, 1, komm anf - 1);
+    trennwort ohne komm CAT dummy;
+  END REP.
+
+wort1 mit komm ermitteln:
+  IF length (wort1 ohne komm) = 0
+    THEN wort1 := "";
+         LEAVE wort1 mit komm ermitteln
+  FI;
+  INT VAR index ohne := 0,
+          index mit  := 0;
+  REP
+    index ohne INCR 1;
+    index mit  INCR 1;
+    WHILE (wort1 SUB index mit) = kommando zeichen REP
+      index mit := pos (wort1, kommando zeichen, index mit + 1) + 1
+    END REP;
+  UNTIL index ohne >= length (wort1 ohne komm) END REP;
+  wort1 := subtext (wort1, 1, index mit). 
+
+zeichenpos durch trennzeichenbreite verschieben:
+  REP
+    zeichen := puffer SUB zeichenpos;
+    IF zeichen = kommandozeichen
+      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
+           char pos move (rueckwaerts)
+    ELIF zeichenpos < wortanfang + 1
+      THEN zeichenpos := wortanfang;
+           LEAVE trennung eventuell vornehmen
+      ELSE zeilenbreite DECR breite (puffer, zeichenpos);
+           anz zeichen davor DECR 1;
+           char pos move (rueckwaerts);
+           IF zeilenbreite+breite(trennzeichen) <= aktuellepitchzeilenlaenge
+              AND (puffer SUB zeichenpos) <> kommandozeichen
+             THEN LEAVE zeichenpos durch trennzeichenbreite verschieben
+           FI
+    FI;
+  END REP.
+ 
+wortende ermitteln:
+  INT VAR x1, x2;
+  wortende := position von (blank, 1, x1, x2);
+  IF pufferlaenge > wortende
+   THEN wortende DECR 1
+  FI.
+
+display vorherige zeile bis wortanfang:
+  dummy := neue zeile;
+  dummy CAT subtext (puffer, von, wortanfang - 2);
+  line ;
+  outsubtext (dummy, length (dummy) - 78).
+
+schreibe nicht trennbaren teil des trennwortes:
+  line ;
+  get cursor (xwort1, ywort1);
+  IF length (trennwort) < 70
+    THEN cursor (max trennlaenge + 4, ywort1);
+         outsubtext (trennwort, max trennlaenge + 1)
+  FI.
+ 
+schreibe zeile nach trennwort: 
+   dummy := subtext (puffer, wortende + 1);
+   get cursor (trennwort endepos, ywort1);
+   IF length (trennwort) >= 70
+     THEN
+   ELIF length (dummy) > 75 - trennwort ende pos
+     THEN outsubtext (dummy, 1, 75 - trennwort endepos);
+     ELSE out (dummy);
+          IF (dummy SUB length (dummy)) = blank
+            THEN cursor (78, ywort1);
+                 out (begin mark);
+                 out (end mark)
+          FI
+   FI.
+ 
+trennwort endepos: 
+  xwort1.
+ 
+interaktive worttrennung:
+   REP
+      out (return); 
+      schreibe erstes wort;
+      get cursor (xwort1, ywort1);
+      schreibe trennung;
+      schreibe zweites wort;
+      schreibe rest bei zu langem trennwort;
+      cursor (xwort1, ywort1);
+      hole steuerzeichen und veraendere worte
+   END REP.
+
+schreibe erstes wort:
+  out (begin mark);
+  IF length (trennwort) < 70
+    THEN out (wort1)
+    ELSE outsubtext (wort1, length (wort1) - 60)
+  FI.
+
+schreibe trennung:
+  IF ck vorhanden
+    THEN out (links); out ("k");
+  FI;
+  out (trennsymbol).
+
+schreibe zweites wort:
+  IF length (trennwort) < 70
+    THEN out (wort2)
+    ELSE outsubtext (wort2, 1, 70 - xwort1);
+  FI;
+  out (end mark).
+
+schreibe rest bei zu langem trennwort:
+  IF length (trennwort) >= 70 
+    THEN INT VAR xakt pos;
+         out (cl eol);
+         get cursor (xakt pos, ywort1);
+         outsubtext (trennwort, max trennlaenge + 1,
+                                max trennlaenge + 1 + (78 - xakt pos))
+  FI.
+
+ck vorhanden: 
+  (wort1 SUB length (wort1)) = "c" AND
+              (trennwort SUB (length (wort1) + 1)) = "k".
+ 
+hole steuerzeichen und veraendere worte:
+TEXT VAR steuerzeichen;
+   inchar (steuerzeichen);
+   IF steuerzeichen = links
+     THEN nach links
+   ELIF steuerzeichen = rechts
+     THEN nach rechts
+   ELIF steuerzeichen = hop
+     THEN sprung
+   ELIF steuerzeichen = return
+     THEN line ;
+          LEAVE interaktive worttrennung
+   ELIF steuerzeichen = escape
+     THEN errorstop ("Abbruch mit ESC")
+   ELIF code (steuerzeichen) < 32
+     THEN
+     ELSE trennsymbol := steuerzeichen;
+          LEAVE hole steuerzeichen und veraendere worte
+   FI;
+   IF wort1 = ""
+      OR (wort1 SUB length (wort1)) = bindestrich 
+     THEN trennsymbol := blank 
+     ELSE trennsymbol := trennzeichen 
+   FI. 
+ 
+nach links:
+TEXT VAR ein zeichen;
+INT VAR  position;
+   IF length (wort1) <> 0
+     THEN position := length (wort1);
+          IF (wort1 SUB position) = kommando zeichen
+            THEN ueberspringe das kommando (wort1, position, rueckwaerts);
+          FI;
+          position DECR 1;
+          wort1 := subtext (trennwort, 1, position);
+          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
+          IF rechtes teilwort mit bindestrich
+            THEN ein zeichen := (wort1 SUB length (wort1));
+                 delete char (wort1, length (wort1));
+                 insert char (wort2, ein zeichen, 1)
+          FI
+   FI.
+
+nach rechts:
+   IF length (wort1) <  max trennlaenge
+     THEN position := length (wort1) + 1;
+          IF (trennwort SUB position) = kommando zeichen
+            THEN ueberspringe das kommando (trennwort, position, +1);
+          FI;
+          wort1 := subtext (trennwort, 1, position);
+          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
+          IF rechtes teilwort mit bindestrich
+            THEN wort1 CAT bindestrich;
+                 delete char (wort2, 1)
+          FI
+   FI.
+ 
+rechtes teilwort mit bindestrich:
+  (wort2 SUB 1) = bindestrich AND
+                             pos (buchstaben, wort1 SUB length (wort1)) <> 0.
+
+sprung:
+   inchar(steuerzeichen);
+   IF steuerzeichen = rechts
+     THEN wort1 := subtext (trennwort, 1, max trennlaenge);
+          wort2 := ""
+   ELIF steuerzeichen = links
+     THEN wort1 := "";
+          wort2 := subtext (trennwort, 1, max trennlaenge)
+   FI.
+
+neue zeile mit trennwort versehen:
+  IF wort1 = ""
+    THEN keine trennung
+    ELSE zeichenpos := wortanfang + length (wort1); 
+         mit trennsymbol trennen;
+         von := zeichenpos
+  FI.
+ 
+keine trennung:
+  IF wort ist zu lang fuer limit
+    THEN warnung (7, trennwort);
+         neue zeile CAT trennwort;
+         zeichenpos := wortende + 1;
+         zeichenpos bereits verarbeitet := 0;
+         von := zeichenpos
+    ELSE loesche nachfolgende blanks;
+         zeichenpos := wortanfang
+  FI.
+
+wort ist zu lang fuer limit:
+  length (alte blanks) * einrueckbreite + breite davor + trennbreite
+                                             >= aktuelle pitch zeilenlaenge.
+
+mit trennsymbol trennen:
+  IF (wort1 SUB length (wort1)) = "c" AND
+      (trennwort SUB (length (wort1) + 1)) = "k"
+    THEN replace (wort1, length (wort1), trenn k)
+  FI;
+  neue zeile CAT wort1;
+  IF trennsymbol <> blank
+    THEN neue zeile CAT trennsymbol
+  FI.
+END PROC trennung eventuell vornehmen;
+ 
+PROC naechste zeile ggf heranziehen:
+  IF puffer hat absatz
+     OR puffer hat noch mindestens zwei woerter
+     OR zeile hat eine foot anweisung
+     OR in foot uebertrag
+    THEN LEAVE naechste zeile ggf heranziehen
+  ELIF trennung vorhanden
+    THEN IF zeichenpos < pufferlaenge
+           THEN zeilenbreite INCR breite (trennzeichen)
+         FI;
+         getrennte zeilen zusammenziehen;
+         LEAVE naechste zeile ggf heranziehen
+  FI;
+  puffer CAT blank;
+  puffer CAT zeile;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen.
+ 
+puffer hat noch mindestens zwei woerter:
+  INT VAR anz :: 0, i :: zeichenpos;
+  WHILE pos (puffer, " ", i) > 0 REP
+    anz INCR 1;
+    i := pos (puffer, " ", i) + 1
+  END REP;
+  anz > 1.
+
+zeile hat eine foot anweisung:
+  pos (puffer, "#foot") <> 0.
+END PROC naechste zeile ggf heranziehen; 
+ 
+(******************** initialisierungs routine *******************)
+
+PROC form initialisieren (TEXT CONST datei):
+   kommando liste :=
+"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2
+pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0
+headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";
+   kommando liste CAT
+"material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1
+goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0
+rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";
+  kommando liste CAT
+"center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0
+bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2
+markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01
+storecounter:69.1";
+  kommando liste CAT 
+"ub:70.0ue:71.0fb:72.0fe:73.0";
+  line ;
+  erste fehlerzeilennr    := 0;
+  anz tabs                := 0;
+  zeilennr                := 0;
+  zeilenbreite            := 0;
+  anz blanks freihalten   := 3;
+  herkunftsreferenzen     := "#";
+  zielreferenzen          := "#";
+  aktuelle blanks         := "";
+  font nr speicher        := "";
+  modifikationsspeicher   := "";
+  mod zeilennr speicher   := "";
+  index speicher          := "";
+  ind zeilennr speicher   := "";
+  counter numbering store := "";
+  counter reference store := "";
+  command store           := "";
+  kommando                := "";
+  neue zeile              := "";
+  zeile                   := "";
+  puffer                  := " ";
+  macro works             := FALSE;
+  in tabelle              := FALSE;
+  in d und e verarbeitung := FALSE;
+  kommandos speichern     := TRUE;
+  in foot                 := FALSE;
+  in foot uebertrag       := FALSE;
+  test ob font table vorhanden;
+  bildschirm initialisieren;
+  zeile lesen;
+  zeile in puffer und zeile lesen;
+  einrueckung zweite zeile := "xxx";
+  limit und type ggf anfragen;
+  einrueckbreite := eingestellte indentation pitch ;
+  initialisiere neue zeile;
+  IF einrueckung zweite zeile <> "xxx"
+    THEN aktuelle blanks := einrueckung zweite zeile
+  FI.
+
+test ob font table vorhanden:
+  INT VAR xxx :: x step conversion (0.0). 
+
+bildschirm initialisieren:
+  IF online
+    THEN init
+  FI.
+
+init:
+   page;
+   IF lineform mode
+     THEN put ("LINEFORM") 
+     ELSE put ("AUTOFORM")
+   FI;
+   put ("(für"); put (lines (eingabe)); put ("Zeilen):");
+   put (datei);
+   cursor (1, 3).
+END PROC form initialisieren;
+
+PROC limit und type ggf anfragen:
+  conversion (limit in cm, aktuelle pitch zeilenlaenge);
+  IF ask type and limit
+    THEN type und limit setzen
+    ELSE alter schriftname := kein vorhandener schriftname;
+         stelle font ein
+  FI;
+  REAL VAR x :: limit in cm;
+  conversion (x, aktuelle pitch zeilenlaenge);
+  IF x = fehler wert
+    THEN limit in cm := 16.0;
+         conversion (limit in cm, aktuelle pitch zeilenlaenge)
+    ELSE limit in cm := x
+  FI;
+  trennbreite setzen.
+
+type und limit setzen:
+  LET type text                    = "#type (""",
+      limit text                   = "#limit (",
+      kommando ende text           = ")#",
+      kein vorhandener schriftname = "#####";
+  IF type und limit anweisungen nicht vorhanden
+    THEN type und limit fragen
+    ELSE hole font;
+         alter schriftname := kein vorhandener schriftname
+  FI.
+
+type und limit fragen:
+  type anfragen;
+  type in neue zeile;
+  limit anfragen;
+  limit in neue zeile;
+  IF NOT format file in situ
+    THEN schreibe neue zeile;
+         zeilen nr INCR 1
+  FI;
+  IF NOT puffer hat absatz
+    THEN einrueckung zweite zeile := aktuelle blanks;
+         aktuelle blanks := alte blanks;(* Einrueckung fuer die erste zeile*)
+  FI;
+  line.
+
+type und limit anweisungen nicht vorhanden:
+  (pos (puffer, type text) <> 1 OR pos (puffer, "limit") < 12).
+
+type anfragen:
+  put ("Bitte Schrifttyp    :");
+  IF font table name = font table
+    THEN dummy := font (font nr);
+    ELSE dummy := font (1);
+         font table name := font table
+  FI;
+  REP
+    editget (dummy);
+    IF font exists (dummy)
+      THEN alter schriftname := dummy;
+           font nr := font (dummy);
+           hole font;
+           LEAVE type anfragen
+      ELSE line ;
+           put ("ERROR: unbekannter Schrifttyp");
+           line (2);
+           put ("Schrifttyp bitte nochmal:")
+    FI
+  END REP.
+
+type in neue zeile:
+  neue zeile := type text;
+  neue zeile CAT dummy;
+  neue zeile CAT """";
+  neue zeile CAT kommando ende text.
+ 
+limit anfragen:
+  line ;
+  put ("Zeilenbreite (in cm):");
+  dummy := text (limit in cm);
+  REP
+    editget (dummy);
+    limit in cm := real (dummy);
+    IF last conversion ok AND pos (dummy, ".") <> 0
+      THEN LEAVE limit anfragen
+      ELSE line ;
+           put ("ERROR: Falsche Angabe");
+           line (2);
+           put ("Zeilenbreite (in cm) bitte nochmal:");
+    FI
+  END REP.
+
+limit in neue zeile:
+  neue zeile CAT limit text;
+  neue zeile CAT dummy;
+  neue zeile CAT kommando ende text;
+  neue zeile CAT " ".
+END PROC limit und type ggf anfragen;
+
+PROC start form (TEXT CONST datei): 
+  IF NOT format file in situ 
+    THEN last param (datei);
+  FI;
+  disable stop; 
+     dateien assoziieren;
+     zeilen form (datei);
+     IF is error
+       THEN fehlerbehandlung
+       ELSE datei neu nach alt kopieren
+     FI;
+     zwischendatei loeschen;
+  enable stop;
+  col (eingabe, 1);
+  IF aktueller editor > 0
+    THEN set range (file, alter bereich)
+  FI;
+  IF anything noted
+    THEN IF aktueller editor = 0
+           THEN to line (eingabe, erste fehler zeilen nr);
+           ELSE alles neu
+         FI;
+         note edit (eingabe)
+  ELIF NOT format file in situ
+    THEN to line (eingabe, 1)
+  FI.
+
+dateien assoziieren:
+  IF format file in situ 
+    THEN
+  ELIF exists (datei)
+    THEN IF subtext (datei, length (datei) - 1) = ".p"
+           THEN errorstop
+                ("'.p'-Datei kann nicht mit lineform bearbeitet werden")
+         FI;
+         eingabe := sequential file (modify, datei);
+         ausgabe datei einrichten
+    ELSE errorstop ("Datei existiert nicht")
+  FI;
+  to line (eingabe, 1);
+  col (eingabe, 1).
+
+ausgabe datei einrichten:
+  ds := nilspace;
+  ausgabe := sequential file (modify, ds);
+  to line (ausgabe, 1);
+  copy attributes (eingabe, ausgabe).
+
+fehlerbehandlung:
+  put error;
+  clear error;
+  font nr := 1;
+  font table name := "";
+  limit in cm := 16.0;
+  IF format file in situ
+    THEN insert record (eingabe);
+         write record  (eingabe, neue zeile);
+         down (eingabe);
+         insert record (eingabe);
+         write record  (eingabe, puffer);
+         down (eingabe);
+         insert record (eingabe);
+         write record  (eingabe, zeile)
+  FI.
+
+datei neu nach alt kopieren:
+  IF NOT format file in situ 
+    THEN forget (datei, quiet);
+         copy (ds, datei);
+         eingabe := sequential file (modify, datei)
+  FI. 
+
+zwischendatei loeschen:
+  IF NOT format file in situ 
+    THEN forget (ds)
+  FI.
+END PROC start form;
+ 
+(************** line/autoform fuer benannte Dateien ******************)
+
+PROC lineform:
+  IF aktueller editor > 0
+    THEN IF mark
+           THEN editor bereich bearbeiten
+           ELSE errorstop ("kein markierter Bereich")
+         FI
+    ELSE lineform (last param)
+  FI.
+
+editor bereich bearbeiten:
+  disable stop;
+    file := editfile; 
+    set marked range (file, alter bereich); 
+    lineform (file);
+  enable stop;
+END PROC lineform;
+ 
+PROC lineform (TEXT CONST datei):
+  ask type and limit  := TRUE;
+  lineform mode       := TRUE;
+  format file in situ := FALSE; 
+  start form (datei)
+END PROC lineform;
+ 
+PROC autoform:
+  IF aktueller editor > 0
+    THEN IF mark
+           THEN editor bereich bearbeiten
+           ELSE errorstop ("kein markierter Bereich")
+         FI
+    ELSE auto form (last param)
+  FI.
+
+editor bereich bearbeiten:
+  disable stop;
+    file := editfile; 
+    set marked range (file, alter bereich); 
+    autoform (file);
+  enable stop
+END PROC autoform;
+
+PROC autoform (TEXT CONST datei):
+  ask type and limit  := TRUE;
+  lineform mode       := FALSE;
+  format file in situ := FALSE; 
+  start form (datei)
+END PROC autoform;
+ 
+(******************** line/autoform fuer files ************************)
+
+PROC lineform (FILE VAR f):
+  enable stop;
+  eingabe := f; 
+  format file in situ := TRUE;
+  ask type and limit  := TRUE;
+  lineform mode       := TRUE;
+  start form ("");
+END PROC lineform;
+
+PROC autoform (FILE VAR f):
+  enable stop;
+  eingabe := f; 
+  format file in situ := TRUE;
+  ask type and limit  := TRUE;
+  lineform mode       := FALSE;
+  start form ("");
+END PROC autoform;
+
+PROC lineform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
+  eingabe := f; 
+  format file in situ := TRUE;
+  lineform mode       := TRUE; 
+  ask type and limit  := FALSE;
+  par1        := type name; 
+  limit in cm := file limit;
+  start form (""); 
+END PROC lineform; 
+
+PROC autoform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
+  eingabe := f; 
+  format file in situ := TRUE;
+  lineform mode       := FALSE; 
+  ask type and limit  := FALSE;
+  par1        := type name; 
+  limit in cm := file limit;
+  start form (""); 
+END PROC autoform; 
+END PACKET liner;
+(*
+REP
+    copy("lfehler","zz");
+    IF yes ("autoform")
+      THEN autoform ("zz")
+      ELSE lineform ("zz")
+    FI;
+    edit("zz");
+    forget("zz")
+UNTIL yes ("ENDE") ENDREP;
+*)
+
diff --git a/system/multiuser/1.7.5/src/macro store b/system/multiuser/1.7.5/src/macro store
new file mode 100644
index 0000000..dc13a1b
--- /dev/null
+++ b/system/multiuser/1.7.5/src/macro store
@@ -0,0 +1,298 @@
+(* ------------------- VERSION 13 vom 28.05.86 -------------------- *)
+PACKET macro store DEFINES macro command and then process parameters,
+                           get macro line,
+                           number macro lines,
+                           load macros,
+                           list macros:
+
+(* Programm zur Behandlung von Textkosemtik-Macros
+   Autor: Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+*)
+
+INITFLAG VAR this packet :: FALSE;
+
+DATASPACE VAR ds;
+
+BOUND MACROTABLE VAR macro table;
+
+FILE VAR f;
+
+LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store,
+                         ROW max macro zeilen TEXT macro zeilen,
+                         ROW max macros TEXT macro namen,
+                         ROW max macros INT  anz parameter,
+                         ROW max macros INT  macro start);
+
+ 
+LET tag              = 1, 
+    number           = 3,
+    delimiter        = 6, 
+    end of scan      = 7,
+    max macro zeilen = 1000,
+    max macros       = 200;
+
+INT VAR index aktuelle macro zeile,
+        type,
+        anz zeilen in macro,
+        anz macro zeilen,
+        anz macros :: 0;
+
+TEXT VAR symbol,
+         fehlertext, 
+         dummy,
+         kommando,
+         zeile;
+
+BOOL VAR with parameters,
+         macro end gewesen;
+
+PROC init macros:
+  IF NOT initialized (this packet)
+    THEN ds := nilspace;
+         macro table := ds;
+         macros leeren
+  FI.
+
+macros leeren:
+  anz macro zeilen := 0;
+  anz macros := 0.
+END PROC init macros;
+
+PROC load macros (TEXT CONST fname):
+  init macros;
+  line;
+  IF exists (fname)
+    THEN f := sequential file (input, fname);
+         forget (ds);
+         ds := nilspace;
+         macro table := ds;
+         macros einlesen
+    ELSE errorstop ("Datei existiert nicht")
+  FI.
+
+macros einlesen:
+  macro end gewesen := TRUE;
+  anz macros        := 0;
+  anz macro zeilen  := 0;
+  WHILE NOT eof (f) REP
+    anz macro zeilen INCR 1;
+    IF anz macro zeilen > max macro zeilen
+      THEN errorstop ("Zu viele Zeilen (max.1000)") 
+    FI;
+    cout (anz macro zeilen);
+    getline (f, zeile);
+    IF zeile = ""
+      THEN zeile := " "
+    ELIF pos (zeile, "#*") > 0
+      THEN macro name oder end vermerken
+    FI;
+    IF macro end gewesen AND zeile = " "
+      THEN anz macro zeilen DECR 1
+      ELSE macro table . macro zeilen [anz macro zeilen] := zeile
+    FI
+  END REP;
+  anz macro zeilen INCR 1;
+  macro table . macro zeilen [anz macro zeilen] := " "; 
+  IF anz macros = 0
+    THEN putline  ("Macros geleert")
+  FI.
+
+macro name oder end vermerken:
+  INT CONST komm anfang :: pos (zeile, "#*") + 2,
+            komm ende   :: pos (zeile, "#", komm anfang);
+  IF komm anfang <> 3 OR hinter dem kommando steht noch was
+    THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile");
+  FI;
+  kommando := subtext (zeile, komm anfang, komm ende -1); 
+  scan (kommando); 
+  next symbol (symbol, type); 
+  IF type = tag 
+    THEN macro namen aufnehmen
+    ELSE errorstop ("kein Macroname nach #*") 
+  FI; 
+  next symbol (symbol, type);
+  IF type >= end of scan 
+    THEN macro table . anz parameter [anz macros] := 0; 
+         LEAVE macro name oder end vermerken 
+  ELIF symbol = "(" 
+    THEN parameter aufsammeln;
+    ELSE errorstop ("keine ( nach Macro-Name") 
+  FI.
+ 
+macro namen aufnehmen:
+  IF symbol = "macroend"
+    THEN put ("mit"); put (macro table . anz parameter [anz macros]);
+         put ("Parameter(n) geladen"); 
+         macro end gewesen := TRUE;
+         line;
+         LEAVE macro name oder end vermerken
+  ELIF NOT macro end gewesen
+    THEN errorstop ("macro end fehlt")
+    ELSE macro end gewesen := FALSE;
+         anz macros INCR 1; 
+         IF anz macros > max macros 
+           THEN errorstop ("Zu viele Macros (max. 200") 
+         FI;
+         macro table . macro namen [anz macros] := symbol;
+         macro table . macro start [anz macros] := anz macro zeilen;
+         line;
+         put (symbol);
+  FI.
+
+hinter dem kommando steht noch was:
+  NOT (komm ende = length (zeile) COR
+    (komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")).
+ 
+parameter aufsammeln: 
+  INT VAR parameter number :: 1;
+  next symbol (symbol, type); 
+  WHILE symbol = "$" REP 
+    next symbol (symbol, type); 
+    IF type = number CAND int (symbol) = parameter number 
+      THEN IF parameter number > 9
+             THEN errorstop ("Anzahl Parameter > 9")
+           FI;
+           macro table . anz parameter [anz macros] := parameter number; 
+           parameter number INCR 1; 
+      ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol)
+    FI;  
+    next symbol (symbol, type); 
+    IF symbol = ")" 
+      THEN LEAVE parameter aufsammeln 
+    ELIF symbol = "," 
+      THEN next symbol (symbol, type) 
+      ELSE errorstop (", oder ) erwartet:" + symbol) 
+    FI 
+  END REP;
+  errorstop ("Parameterliste inkorrekt bei" + symbol).
+END PROC load macros;
+
+PROC load macros: 
+  load macros (last param)
+END PROC load macros;
+
+PROC list macros:
+  init macros;
+  note ("");
+  INT VAR i := 1;
+  WHILE i <= anz macro zeilen REP
+    cout (i);
+    note (macro table . macro zeilen [i]);
+    note line;
+    i INCR 1
+  END REP;
+  note edit
+END PROC list macros;
+
+BOOL PROC macro exists (TEXT CONST name, INT VAR anz params):
+  INT VAR i;
+  FOR i FROM 1 UPTO anz macros REP
+    IF macro table . macro namen [i] = name
+      THEN anz params := macro table . anz parameter [i]; 
+           index aktuelle macro zeile := macro table . macro start [i] + 1;
+           berechne anzahl zeilen in macro;
+           IF anz params = 0 
+             THEN with parameters := FALSE 
+             ELSE with parameters := TRUE;
+                  lade macro in replacement store;
+                  index aktuelle macro zeile := 1;
+           FI;
+           LEAVE macro exists WITH TRUE
+    FI
+  END REP;
+  FALSE.
+ 
+berechne anzahl zeilen in macro: 
+  IF i = anz macros 
+    THEN anz zeilen in macro := 
+           anz macro zeilen - index aktuelle macro zeile; 
+    ELSE anz zeilen in macro := 
+           macro table . macro start [i + 1] - index aktuelle macro zeile 
+  FI.
+ 
+lade macro in replacement store: 
+  INT VAR k; 
+  FOR k FROM 1 UPTO anz zeilen in macro REP 
+    macro table . replacement store [k] := 
+          macro table . macro zeilen [index aktuelle macro zeile +k-1]
+  END REP. 
+END PROC macro exists;
+
+PROC replace macro parameter (INT CONST number, TEXT CONST param): 
+  TEXT VAR param text := "$" + text (number); 
+  INT VAR k; 
+  FOR k FROM 1 UPTO anz zeilen in macro - 1 REP 
+    change all (macro table . replacement store [k], param text, param); 
+  END REP 
+END PROC replace macro parameter; 
+ 
+BOOL PROC macro command and then process parameters (TEXT VAR komm):
+  init macros;
+  LET tag = 1;
+  scan (komm); 
+  next symbol (symbol, type); 
+  IF type = tag  
+    THEN untersuche ob deklariertes macro 
+    ELSE FALSE 
+  FI. 
+ 
+untersuche ob deklariertes macro: 
+  INT VAR anz macro params; 
+  IF macro exists (symbol, anz macro params) 
+    THEN fehlertext := "in Makro: "; fehlertext CAT symbol;
+         IF anz macro params > 0 
+           THEN macro parameter ersetzen
+         FI;
+         TRUE 
+    ELSE FALSE 
+  FI. 
+ 
+macro parameter ersetzen:
+  next symbol (symbol, type); 
+  IF symbol = "(" 
+    THEN ersetze 
+    ELSE report text processing error (34, 0, dummy, symbol + fehlertext); 
+         LEAVE macro command and then process parameters WITH FALSE 
+  FI.
+ 
+ersetze: 
+  LET text type = 4,
+      end of scan = 7;
+  INT VAR number parameter :: 1;
+  REP  
+    next symbol (symbol, type);  
+    IF type = texttype 
+      THEN replace macro parameter (number parameter, symbol);
+      ELSE report text processing error (35, 0, dummy, fehlertext + symbol); 
+           LEAVE macro command and then process parameters WITH FALSE 
+    FI; 
+    number parameter INCR 1; 
+    IF number parameter > anz macro params 
+      THEN LEAVE macro command and then process parameters WITH TRUE 
+    FI; 
+    next symbol (symbol, type); 
+    IF symbol <> "," OR type >= end of scan
+      THEN report text processing error (36, 0, dummy, fehlertext + symbol); 
+           LEAVE macro command and then process parameters WITH FALSE 
+    FI 
+  END REP.
+END PROC macro command and then process parameters;
+ 
+PROC get macro line (TEXT VAR macro zeile):
+  IF index aktuelle macro zeile > anz zeilen in macro
+    THEN macro zeile := "#### "
+  ELIF with parameters 
+    THEN macro zeile :=
+           macro table . replacement store [index aktuelle macro zeile]
+    ELSE macro zeile := 
+           macro table . macro zeilen [index aktuelle macro zeile] 
+  FI; 
+  index aktuelle macro zeile INCR 1; 
+END PROC get macro line;
+ 
+INT PROC number macro lines: 
+  anz zeilen in macro
+END PROC number macro lines; 
+END PACKET macro store;
+
diff --git a/system/multiuser/1.7.5/src/multi user monitor b/system/multiuser/1.7.5/src/multi user monitor
new file mode 100644
index 0000000..dd3051e
--- /dev/null
+++ b/system/multiuser/1.7.5/src/multi user monitor
@@ -0,0 +1,93 @@
+(* ------------------- VERSION 2      16.05.86 ------------------- *)
+PACKET multi user monitor DEFINES              (* Autor: J.Liedtke *)
+
+    monitor :
+ 
+ 
+LET command list =
+ 
+"edit:1.01run:4.01runagain:6.0insert:7.01forget:9.01rename:11.2copy:12.2
+list:13.0storageinfo:14.0taskinfo:15.0
+fetch:16.1save:17.01break:19.0saveall:20.0 " ;
+
+LET text param type = 4 ;
+
+ 
+INT VAR command index , number of params , previous heap size ;
+TEXT VAR param 1, param 2 ;
+ 
+ 
+  lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ;
+  lernsequenz auf taste legen ("e", ""1""8""1""12"edit"13"") ;
+
+
+PROC monitor :
+ 
+  disable stop ;
+  previous heap size := heap size ;
+  REP 
+    command dialogue (TRUE) ;
+    sysin ("") ;
+    sysout ("") ;
+    cry if not enough storage ;
+    get command ("gib kommando :") ;
+    reset editor ;
+    analyze command (command list, text param type,
+                     command index, number of params, param1, param2) ;
+    execute command ;
+    collect heap garbage if necessary
+  PER .
+ 
+collect heap garbage if necessary :
+  IF heap size > previous heap size + 10
+    THEN collect heap garbage ;
+         previous heap size := heap size
+  FI .
+
+cry if not enough storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"")
+  FI .
+
+reset editor :
+  WHILE aktueller editor > 0 REP
+    quit
+  PER ;
+  clear error .
+
+ENDPROC monitor ;
+
+PROC execute command :
+
+  enable stop ;
+  SELECT command index OF
+    CASE 1 : edit
+    CASE 2 : edit (param1)
+    CASE 3 : (* war frueher paralleleditor *)
+    CASE 4 : run
+    CASE 5 : run (param1)
+    CASE 6 : run again
+    CASE 7 : insert
+    CASE 8 : insert (param1)
+    CASE 9 : forget
+    CASE 10: forget (param1)
+    CASE 11: rename (param1, param2)
+    CASE 12: copy (param1, param2)
+    CASE 13: list
+    CASE 14: storage info
+    CASE 15: task info
+    CASE 16: fetch (param1)
+    CASE 17: save
+    CASE 18: save (param1)
+    CASE 19: break
+    CASE 20: save all
+
+    OTHERWISE do command
+  ENDSELECT .
+ 
+ENDPROC  execute command ;
+ 
+ENDPACKET multi user monitor ;
+
diff --git a/system/multiuser/1.7.5/src/nameset b/system/multiuser/1.7.5/src/nameset
new file mode 100644
index 0000000..8ea4359
--- /dev/null
+++ b/system/multiuser/1.7.5/src/nameset
@@ -0,0 +1,355 @@
+(* ------------------- VERSION 3     17.03.86 ------------------- *)
+PACKET name set DEFINES                       (* Autor: J.Liedtke *)
+ 
+       ALL ,
+       SOME ,
+       LIKE ,
+       + ,
+       - ,
+       / ,
+       do ,
+       FILLBY ,
+       remainder ,
+       
+       fetch ,
+       save ,
+       fetch all ,
+       save all ,
+       forget ,
+       erase ,
+       insert ,
+       edit :
+
+
+LET cr lf = ""13""10"" ;
+
+TEXT VAR name ;
+DATASPACE VAR edit space ;
+
+THESAURUS VAR remaining thesaurus := empty thesaurus ;
+
+
+THESAURUS OP + (THESAURUS CONST left, right) :
+
+  THESAURUS VAR union := left ;
+  INT VAR index := 0 ;
+  get (right, name, index) ;
+  WHILE name <> "" REP
+    IF NOT (union CONTAINS name)
+      THEN insert (union, name)
+    FI ;
+    get (right, name, index)
+  PER ;
+  union .
+
+ENDOP + ;
+
+THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) :
+
+  THESAURUS VAR union := left ;
+  IF NOT (union CONTAINS right)
+    THEN insert (union, right)
+  FI ;
+  union .
+
+ENDOP + ;
+
+THESAURUS OP - (THESAURUS CONST left, right) :
+
+  THESAURUS VAR difference := empty thesaurus ;
+  INT VAR index := 0 ;
+  get (left, name, index) ;
+  WHILE name <> "" REP
+    IF NOT (right CONTAINS name)
+      THEN insert (difference, name)
+    FI ;
+    get (left, name, index)
+  PER ;
+  difference .
+
+ENDOP - ;
+
+THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) :
+
+  THESAURUS VAR difference := left ;
+  INT VAR index ;
+  delete (difference, right, index) ;
+  difference .
+
+ENDOP - ;
+
+THESAURUS OP / (THESAURUS CONST left, right) :
+
+  THESAURUS VAR intersection := empty thesaurus ;
+  INT VAR index := 0 ;
+  get (left, name, index) ;
+  WHILE name <> "" REP
+    IF right CONTAINS name
+      THEN insert (intersection, name)
+    FI ;
+    get (left, name, index)
+  PER ;
+  intersection .
+
+ENDOP / ;
+
+THESAURUS OP ALL (TEXT CONST file name) :
+
+  FILE VAR file := sequential file (input, file name) ;
+  THESAURUS VAR thesaurus := empty thesaurus ;
+  thesaurus FILLBY file ;
+  thesaurus .
+
+ENDOP ALL ;
+
+THESAURUS OP SOME (THESAURUS CONST thesaurus) :
+
+  copy thesaurus into file ;
+  edit file ;
+  copy file into thesaurus .
+
+copy thesaurus into file :
+  forget (edit space) ;
+  edit space := nilspace ;
+  FILE VAR file := sequential file (output, edit space) ;
+  file FILLBY thesaurus .
+  
+edit file :
+  modify (file) ;
+  edit (file) .
+
+copy file into thesaurus :
+  THESAURUS VAR result := empty thesaurus ;
+  input (file) ;
+  result FILLBY file ;
+  forget (edit space) ;
+  result .
+
+ENDOP SOME ;
+
+THESAURUS OP SOME (TASK CONST task) :
+
+  SOME ALL task
+
+ENDOP SOME ;
+
+THESAURUS OP SOME (TEXT CONST file name) :
+
+  SOME ALL file name
+
+ENDOP SOME ;
+
+THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) : 
+ 
+  THESAURUS VAR result:= empty thesaurus ; 
+  INT VAR index:= 0 ; 
+  REP get (thesaurus, name, index) ; 
+    IF name = "" 
+      THEN LEAVE LIKE WITH result 
+    ELIF name LIKE pattern 
+      THEN insert (result, name) 
+    FI 
+ PER ; 
+ result .
+ 
+ENDOP LIKE ; 
+
+THESAURUS PROC remainder :
+
+  remaining thesaurus
+
+ENDPROC remainder ;
+
+PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) :
+
+  INT VAR index := 0 , operation number := 0 ;
+  TEXT VAR name ;
+  
+  remaining thesaurus := empty thesaurus ;
+  disable stop ;
+  work off thesaurus ;
+  fill leftover with remainder .
+
+work off thesaurus :
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE work off thesaurus
+    FI ;
+    operation number INCR 1 ;
+    cout (operation number) ;
+    execute (PROC (TEXT CONST) operate, name)
+  UNTIL is error ENDREP .
+
+fill leftover with remainder :
+  WHILE name <> "" REP
+    insert (remaining thesaurus, name) ;
+    get (thesaurus, name, index)
+  PER .
+
+ENDPROC do ;
+ 
+PROC execute (PROC (TEXT CONST) operate, TEXT CONST name) :
+
+  enable stop ;
+  operate (name)
+
+ENDPROC execute ;
+ 
+PROC do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus,
+         TASK CONST task) :
+
+  INT VAR index := 0 , operation number := 0 ;
+  TEXT VAR name ;
+  
+  remaining thesaurus := empty thesaurus ;
+  disable stop ;
+  work off thesaurus ;
+  fill leftover with remainder .
+
+work off thesaurus :
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE work off thesaurus
+    FI ;
+    operation number INCR 1 ;
+    cout (operation number) ;
+    execute (PROC (TEXT CONST, TASK CONST) operate, name, task)
+  UNTIL is error ENDREP .
+
+fill leftover with remainder :
+  WHILE name <> "" REP
+    insert (remaining thesaurus, name) ;
+    get (thesaurus, name, index)
+  PER .
+
+ENDPROC do ;
+ 
+PROC execute (PROC (TEXT CONST, TASK CONST) operate,
+              TEXT CONST name, TASK CONST task) :
+
+  enable stop ;
+  operate (name, task)
+
+ENDPROC execute ;
+ 
+OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) :
+
+  WHILE NOT eof (file) REP
+    getline (file, name) ;
+    delete trailing blanks ;
+    IF name <> "" CAND NOT (thesaurus CONTAINS name)
+      THEN insert (thesaurus, name)
+    FI
+  PER .
+
+delete trailing blanks :
+  WHILE (name SUB LENGTH name) = " " REP
+    name := subtext (name, 1, LENGTH name - 1)
+  PER .
+
+ENDOP FILLBY ;
+
+OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) :
+
+  INT VAR index := 0 ;
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE FILLBY
+    FI ;
+    putline (file, name)
+  PER .
+
+ENDOP FILLBY ;
+
+OP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus) :
+
+  FILE VAR f := sequential file (output, file name) ;
+  f FILLBY thesaurus
+
+ENDOP FILLBY ;
+
+
+ 
+PROC fetch (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) fetch, nameset)
+
+ENDPROC fetch ;
+ 
+PROC fetch (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task)
+
+ENDPROC fetch ;
+ 
+PROC save (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) save, nameset)
+
+ENDPROC save ;
+ 
+PROC save (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) save, nameset, task)
+
+ENDPROC save ;
+ 
+PROC fetch all :
+
+  fetch all (father)
+
+ENDPROC fetch all ;
+
+PROC fetch all (TASK CONST manager) :
+
+  fetch (ALL manager, manager)
+
+ENDPROC fetch all ;
+
+PROC save all :
+
+  save all (father)
+
+ENDPROC save all ;
+
+PROC save all (TASK CONST manager) :
+
+  save (ALL myself, manager)
+
+ENDPROC save all ;
+
+PROC forget (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) forget, nameset)
+
+ENDPROC forget ;
+ 
+PROC erase (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) erase, nameset)
+
+ENDPROC erase ;
+ 
+PROC erase (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) erase, nameset, task)
+
+ENDPROC erase ;
+ 
+PROC insert (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) insert, nameset)
+
+ENDPROC insert ;
+ 
+PROC edit (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) edit, nameset)
+
+ENDPROC edit ;
+ 
+ENDPACKET name set ;
+
diff --git a/system/multiuser/1.7.5/src/pager b/system/multiuser/1.7.5/src/pager
new file mode 100644
index 0000000..35189a4
--- /dev/null
+++ b/system/multiuser/1.7.5/src/pager
@@ -0,0 +1,2451 @@
+(*-------------------- VERSION 197 vom 05.05.86 -------(1.7.5)------ *)
+PACKET seiten formatieren DEFINES pageform,
+                                  auto pageform,
+                                  number empty lines before foot,
+                                  first head,
+                                  last bottom:
+
+(* Programm zur interaktiven Formatierung von Seiten, Fussnoten, Kopf- und
+   Fusszeilen, Seitennummern usw.
+   Autor: Rainer Hahn
+ *)
+ 
+(***************** Deklarationen fuer pageform ************)
+
+LET type1        = 1,
+    linefeed     = 3,
+    limit        = 4,
+    free         = 5,
+    page command0= 6,
+    page command1= 7,
+    pagenr       = 8,
+    pagelength   = 9,
+    foot         = 10,
+    end          = 11,
+    head         = 12,
+    headeven     = 13,
+    headodd      = 14,
+    bottom       = 15,
+    bottomeven   = 16,
+    bottomodd    = 17,
+    columns      = 18,
+    columnsend   = 19,
+    topage       = 20,
+    goalpage     = 21,
+    count0       = 22,
+    count1       = 23,
+    setcount     = 24,
+    value0       = 25,
+    value1       = 26,
+    on           = 27, 
+    off          = 28,
+    head on      = 29,
+    head off     = 30,
+    bottom on    = 31,
+    bottom off   = 32,
+    count per page=33,
+    foot contd   = 34,
+    table        = 35,
+    table end    = 36,
+    r pos        = 37,
+    l pos        = 38,
+    c pos        = 39,
+    d pos        = 40,
+    b pos        = 41,
+    clearpos0    = 42,
+    clearpos1    = 43,
+    fillchar     = 44,
+    pageblock    = 45,
+    counter1     = 46,
+    counter2     = 47,
+    counter store= 48,
+    countervalue0= 49,
+    countervalue1= 50,
+    set counter  = 51,
+    u            = 52,
+    d            = 53,
+    e            = 54,
+    fehler index = 100,
+    hop          = ""1"",
+    upchar       = ""3"",
+    cl eop       = ""4"",
+    cl eol       = ""5"",
+    downchar     = ""10"",
+    rub in       = ""11"",
+    rub out      = ""12"",
+    return       = ""13"",
+    end mark     = ""14"",
+    begin mark   = ""15"",
+    begin end mark = ""15""14"",
+    esc          = ""27"",
+    blank        = " ",
+    kommando zeichen = "#",
+    kopf          = 1,
+    kopf gerade   = 2,
+    fuss          = 3,
+    fuss gerade   = 4,
+    kopf ungerade = 5,
+    fuss ungerade = 6,
+    foot note     = 7,
+    dina4 limit           = "16.0",
+    dina4 pagelength      = 25.0,
+    pos seitengrenze      = 17,
+    zeilen nach oben      = 13,
+    zeilen nach unten     = 6,
+    max foot zeilen       = 120,
+    max zeilen zahl       = 15,
+    max refers            = 300,
+    max anz seitenzeichen = 3;
+ 
+BOOL VAR interaktiv,
+         bereich aufnehmen,
+         zeile noch nicht verarbeitet,
+         es war ein linefeed in der zeile,
+         mindestens ein topage gewesen,
+         insert first head  :: TRUE,
+         insert last bottom :: TRUE,
+         pageblock on,
+         ausgeschalteter head,
+         ausgeschalteter bottom,
+         count seitenzaehlung,
+         file works,
+         in tabelle,
+         in nullter seite,
+         letzte textzeile war mit absatz,
+         letztes seitenende war mit absatz,
+         letztes seitenende war in tabelle;
+ 
+INT VAR kommando anfangs pos,
+        kommando ende pos,
+        kommando index,
+        number blank lines before foot :: 1,
+        in index oder exponent,
+        durchgang,
+        nummer erste seite, 
+        nummer letzte seite,
+        laufende spaltennr,
+        anz refers,
+        counter,
+        anz spalten,
+        anz zeilen nach oben,
+        anz vertauschte zeilen,
+        font nr,
+        type          zeilenvorschub,
+        berechneter   zeilenvorschub,
+        max           zeilenvorschub,
+        max type      zeilenvorschub,
+        textbegin zeilennr,
+        anz textzeilen,
+        text laenge vor columns,
+        bereichshoehe,
+        aktuelle seitenlaenge,
+        eingestellte seitenlaenge;
+ 
+REAL VAR real eingestellter zeilenvorschub,
+         realparam;
+
+TEXT VAR kommando,
+         par1, par2,
+         macro line, 
+         vor macro, 
+         nach macro,
+         dummy,
+         fehlerdummy,
+         modifikation,
+         modifikations speicher,
+         kommando seitenspeicher,
+         dec value,
+         counter numbering store,
+         counter reference store,
+         letzte kommandoleiste,
+         kommando speicher,
+         tab pos speicher,
+         bereich kommando speicher,
+         seitenzeichen,
+         name druck datei,
+         name eingabe datei,
+         zeile,
+         eingestellter typ,
+         eingestelltes limit;
+ 
+TEXT VAR kommando liste ::
+"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01pagenr:8.2pagelength:9.1
+foot:10.0end:11.0head:12.0headeven:13.0headodd:14.0bottom:15.0bottomeven:16.0
+bottomodd:17.0columns:18.2columnsend:19.0topage:20.1goalpage:21.1count:22.01
+setcount:24.1";
+ 
+kommando liste CAT
+"value:25.01on:27.1off:28.1headon:29.0headoff:30.0bottomon:31.0bottomoff:32.0
+countperpage:33.0footcontinued:34.0table:35.0tableend:36.0rpos:37.1lpos:38.1
+cpos:39.1dpos:40.2bpos:41.2clearpos:42.01fillchar:44.1pageblock:45.0";
+ 
+kommando liste CAT
+"counter:46.12storecounter:48.1putcounter:49.01setcounter:51.2u:52.0d:53.0
+e:54.0";
+
+FILE VAR eingabe,
+         ausgabe;
+ 
+ROW 6 ROW max zeilenzahl TEXT VAR kopf fuss zeilen;
+ 
+ROW max foot zeilen TEXT VAR foot zeilen;
+ 
+ROW max foot zeilen BOOL VAR kommandos vorhanden;
+
+ROW 7 INT VAR anz kopf oder fuss zeilen,
+              kopf oder fuss laenge; 
+
+ROW max anz seitenzeichen INT VAR laufende seitennr;
+ 
+BOUND ROW max refers REFER VAR refer sammler;
+ 
+LET REFER = STRUCT (TEXT kennzeichen, INT nummer, BOOL referenced);
+ 
+DATASPACE VAR ds;
+ 
+(********************* Einstell-Prozeduren ***************************)
+
+PROC first head (BOOL CONST was): 
+  insert first head := was 
+END PROC first head; 
+ 
+PROC last bottom (BOOL CONST was): 
+  insert last bottom := was 
+END PROC last bottom; 
+ 
+PROC number empty lines before foot (INT CONST n):
+  IF n >= 0 AND n < 10
+    THEN number blank lines before foot := n
+    ELSE errorstop ("nur einstellbar zwischen 0 und 9")
+  FI
+END PROC number empty lines before foot;
+
+(************************** Fehlermeldungen **********************)
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  IF durchgang = 1 OR
+     kommando index = goalpage  OR kommandoindex = count0 OR
+     kommando index = count1    OR kommando index = value1  OR 
+     kommando index = topage    OR kommando index = pagelength OR
+     kommando index = counterstoreOR kommando index = counter1 OR
+     kommando index = counter2  OR kommando index = countervalue1
+    THEN fehler melden;
+         fehlermeldung auf terminal ausgeben
+  FI.
+ 
+fehler melden:
+  report text processing error (nr, line no (ausgabe), fehlerdummy, addition).
+ 
+fehlermeldung auf terminal ausgeben:
+  IF interaktiv
+    THEN cursor(1,2); out(cleop);
+    ELSE line
+  FI;
+  out (fehlerdummy);
+  line.
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  IF durchgang = 1 OR
+     kommando index = goalpage OR kommandoindex = count0 OR
+     kommando index = count1 OR kommando index = value1  OR 
+     kommando index = topage OR kommando index = set counter
+    THEN fehler melden;
+         meldung auf terminal ausgeben
+  FI.
+ 
+fehler melden:
+  report text processing warning (nr, line no (ausgabe), fehlerdummy, addition).
+ 
+meldung auf terminal ausgeben:
+  IF interaktiv
+    THEN cursor(1,2); out(cleop);
+    ELSE line
+  FI;
+  out (fehlerdummy);
+  line.
+END PROC warnung;
+
+(*************************** Globale Dateibehandlung **************)
+ 
+PROC datei assoziieren:
+   IF exists (name eingabe datei)
+     THEN ausgabe datei einrichten
+     ELSE errorstop (name eingabe datei + " existiert nicht")
+   FI.
+ 
+ausgabe datei einrichten:
+   IF name eingabe datei = name druck datei
+     THEN errorstop ("Name Eingabedatei = Name Ausgabedatei")
+   ELIF subtext (name eingabe datei, length (name eingabe datei) - 1) = ".p"
+     THEN errorstop ("Druckdatei kann nicht nochmal formatiert werden")
+     ELSE eingabe := sequential file (input, name eingabe datei);
+          copy (name eingabedatei, name druck datei);
+          ausgabe := sequential file (modify, name druck datei);
+          copy attributes (eingabe, ausgabe);
+          headline (ausgabe, name druck datei);
+   FI
+END PROC datei assoziieren;
+
+PROC record einfuegen (TEXT CONST rec):
+  insert record (ausgabe);
+  write record (ausgabe, rec);
+  down (ausgabe);
+END PROC record einfuegen;
+
+(******************** Kopf- oder Fusszeilen aufnehmen *************)
+ 
+PROC fussnote aufnehmen:
+  bereich aufnehmen := TRUE;
+  IF keine zeichen ausser blank nach dem kommando
+    THEN aufnehmen (footnote)
+    ELSE fehler (19, kommando)
+  FI;
+  in index oder exponent := 0;
+  bereich aufnehmen := FALSE
+END PROC fussnote aufnehmen;
+
+PROC aufnehmen (INT CONST was):
+  kommando zustand vor bereich speichern;
+  aktuelle zeile ggf mitzaehlen;
+  aufnehmen initialisieren;
+  kopf oder fuss zeilen aufnehmen.
+ 
+kommando zustand vor bereich speichern:
+  kommandos in dummy speichern;
+  bereich kommando speicher := dummy.
+
+aktuelle zeile ggf mitzaehlen:
+INT VAR einleitungs kommando anfang :: kommando anfangs pos;
+  IF kommando anfangs pos > 1 
+    THEN IF NOT only command line (zeile)
+           THEN aktuelle seitenlaenge INCR max zeilenvorschub
+         FI;
+         read record (ausgabe, zeile)
+  FI. 
+ 
+aufnehmen initialisieren:
+  IF was = foot note
+    THEN initialisierung fuer fussnoten
+    ELSE anz kopf oder fuss zeilen [was] := 1;
+         kommandos in dummy speichern;
+         kopf fuss zeilen [was] [1] := dummy;
+         kopf oder fuss laenge [was] := 0;
+  FI;
+  bereichshoehe := kopf oder fusslaenge [was].
+
+initialisierung fuer fussnoten:
+  INT CONST fussnotenlaenge vorher :: kopf oder fuss laenge [footnote],
+            anz fusszeilen vorher  :: anz kopf oder fusszeilen [footnote];
+  anz kopf oder fuss zeilen [footnote] INCR 1;
+  kommandos in dummy speichern;
+  kommandoleiste in fussnote speichern; (* davor *)
+  IF anz kopf oder fuss zeilen [footnote] = 1
+    THEN unterstreichungsstrich
+  FI.
+ 
+kommandoleiste in fussnote speichern:
+  foot zeilen [anz kopf oder fuss zeilen [footnote]] := dummy;
+  kommandos vorhanden [anz kopf oder fuss zeilen [footnote]]:= TRUE.
+
+unterstreichungsstrich:
+  FOR i FROM 2 UPTO max foot zeilen REP
+    kommandos vorhanden [i] := FALSE
+  ENDREP;
+  FOR i FROM 1 UPTO number blank lines before foot REP
+    foot zeilen [i + 1] := " "
+  END REP;
+  foot zeilen [number blank lines before foot + 2] :=
+     "#on(""underline"")#               #off(""underline"")# ";
+  kopf oder fuss laenge [footnote] :=
+     (number blank lines before foot + 1) * berechneter zeilenvorschub;
+  anz kopf oder fuss zeilen [footnote] := number blank lines before foot + 2.
+
+kopf oder fuss zeilen aufnehmen:
+INT VAR anzahl :: 1;
+  REP
+    naechste zeile lesen;
+    cout (line no (ausgabe));
+    IF mindestens ein kommando vorhanden
+      THEN kommandos von kopf oder fuss verarbeiten
+    FI;
+    in index oder exponent := 0;
+    zeile aufnehmen;
+    anzahl INCR 1
+  UNTIL eof (ausgabe) END REP;
+  errorstop ("end fehlt bei Dateiende").
+
+kommandos von kopf oder fuss verarbeiten:
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  kommando anfangs pos := pos (zeile, kommando zeichen);
+  WHILE kommando anfangs pos <> 0 REP
+    verarbeite kommando;
+    kommandos von kopf oder fuss pruefen;
+    kommando anfangs pos :=
+        pos (zeile, kommando zeichen, kommando ende pos + 1)
+  END REP.
+ 
+kommandos von kopf oder fuss pruefen:
+  IF kommandoindex = end
+    THEN aufnehmen beenden
+  ELIF kommando index = free
+    THEN IF y step conversion (realparam) >= eingestellte seitenlaenge
+           THEN fehler (24, text (realparam))
+           ELSE kopf oder fusslaenge [was] INCR y step conversion (realparam)
+         FI
+  ELIF seitenende
+    THEN INT VAR xx := durchgang;
+         durchgang := 1;
+         fehler (25, "");
+         durchgang := xx;
+         zeile zurueck lesen;
+         kommando index := end;
+         LEAVE aufnehmen
+  ELIF kommando index = fehler index
+    THEN LEAVE aufnehmen
+  ELIF kommando index > free AND kommando index < to page
+    THEN fehler (11, kommando);
+         kommando index := fehler index;
+         LEAVE aufnehmen
+  FI.
+
+aufnehmen beenden:
+  IF kommando anfangs pos > 1
+    THEN IF absatzzeile
+           THEN zeile := subtext (zeile, 1, kommando anfangs pos -1);
+                zeile CAT blank;
+           ELSE zeile := subtext (zeile, 1, kommando anfangs pos -1);
+         FI;
+         zeile aufnehmen
+  FI;
+  IF NOT (durchgang = 1 AND was = footnote)
+    THEN die aufgenommenen zeilen in druckdatei loeschen
+  FI;
+  LEAVE aufnehmen.
+
+die aufgenommenen zeilen in druckdatei loeschen:
+  INT VAR i;
+  delete record (ausgabe);
+  FOR i FROM 1 UPTO anzahl - 1 REP
+    up (ausgabe);
+    delete record (ausgabe)
+  END REP;
+  zeile zurueck lesen;
+  letztes kommando dieser zeile loeschen;
+  ggf kommandoleiste generieren.
+ 
+letztes kommando dieser zeile loeschen:
+  IF einleitungs kommando anfang = 1
+    THEN delete record (ausgabe);
+         IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+           ELSE zeile zurueck lesen
+         FI
+    ELSE dummy := subtext (zeile, 1, einleitungs kommando anfang - 1);
+         IF absatz zeile
+           THEN dummy CAT blank;
+         ELIF (dummy SUB length (dummy)) = " "
+           THEN delete char (dummy, length (dummy))
+         FI;
+         write record (ausgabe, dummy)
+  FI.
+ 
+ggf kommandoleiste generieren:
+  kommandos in dummy speichern;
+  IF was = footnote
+    THEN anz kopf oder fusszeilen [footnote] INCR 1;
+         kommandoleiste in fussnote speichern (* danach *)
+  FI;
+  IF dummy <> bereich kommando speicher
+    THEN down (ausgabe);
+         record einfuegen (dummy);
+         up (ausgabe, 2);
+  FI.
+
+zeile aufnehmen:
+  zeile speichern (was, anzahl);
+  IF erreichte seitenlaenge > eingestellte seitenlaenge
+    THEN bereich aufnehmen := FALSE;
+         IF kommando index = end
+           THEN seitenende nach geteilter fussnote
+           ELSE seitenende vor der fussnote
+         FI;
+         kommando index := end;
+         LEAVE aufnehmen
+  FI.
+
+seitenende nach geteilter fussnote:
+  kopf oder fuss laenge     [footnote] DECR max zeilenvorschub;
+  anz kopf oder fuss zeilen [footnote] DECR 1;
+  seitenende einbringen und zurueck.
+
+seitenende vor der fussnote:
+  kopf oder fuss laenge     [footnote] := fussnotenlaenge vorher;
+  anz kopf oder fuss zeilen [footnote] := anz fusszeilen vorher;
+  ende einer seite.
+END PROC aufnehmen;
+ 
+PROC zeile speichern (INT CONST was, anzahl):
+  zeile mitzaehlen;
+  IF was = footnote
+    THEN fussnote aufnehmen
+  ELIF anz kopf oder fuss zeilen [was] > max zeilenzahl
+    THEN errorstop ("Zu viele 'head' oder 'bottom' Zeilen");
+    ELSE kopf fuss zeilen [was] [anz kopf oder fuss zeilen [was]] := zeile
+  FI.
+ 
+zeile mitzaehlen: 
+  anz kopf oder fuss zeilen [was] INCR 1;
+  IF NOT only command line (zeile)
+    THEN IF mindestens ein kommando vorhanden
+           THEN kopf oder fuss laenge [was] INCR max zeilenvorschub;
+                bereichshoehe INCR max zeilenvorschub
+           ELSE kopf oder fuss laenge [was] INCR berechneter zeilenvorschub;
+                bereichshoehe INCR berechneter zeilenvorschub
+         FI;
+         IF bereichshoehe >= eingestellte seitenlaenge
+           THEN errorstop
+            ("head, bottom oder footzeilen > Seitenlänge (end vergessen?)")
+         FI
+  FI;
+  IF es war ein linefeed in der zeile
+    THEN berechne zeilenvorschub;
+         es war ein linefeed in der zeile := FALSE
+  FI;
+  IF erreichte seitenlaenge > eingestellte seitenlaenge
+    THEN fussnotenumbruch pruefung
+  FI.
+ 
+fussnote aufnehmen: 
+  IF anz kopf oder fuss zeilen [footnote] > max footzeilen
+    THEN errorstop ("Zu viele Fußnotenzeilen")
+  ELIF bereichshoehe > eingestellte seitenlaenge - seitenlaenge fester teil
+                       - (eingestellte seitenlaenge DIV 100 * 15) 
+    THEN errorstop ("Fußnote > 85% der Seitenlänge (end vergessen?)")
+    ELSE foot zeilen [anz kopf oder fuss zeilen [footnote]] := zeile
+  FI. 
+ 
+fussnotenumbruch pruefung:
+  IF fussnotenumbruch moeglich
+    THEN ggf fussnote aufbrechen
+    ELSE lese rueckwaerts um (anzahl);
+         IF only command line (zeile)
+           THEN lese rueckwaerts um (1)
+         FI
+  FI.
+
+fussnotenumbruch moeglich:
+  was = footnote AND anzahl > 2.
+
+ggf fussnote aufbrechen:
+  up (ausgabe);
+  IF interaktiv
+    THEN fussnotenumbruch anfrage;
+         line (2)
+  FI;
+  anweisungen fuer umbruch einfuegen.
+
+fussnotenumbruch anfrage:
+  schreibe titelzeile ("Weiterführen der Fußnote auf nächster Seite (j/n)?");
+  line (2);
+  schreibe bildschirm;
+  cursor (53, 1);
+  skip input;
+  REP
+    TEXT VAR steuerzeichen;
+    inchar (steuerzeichen);
+    IF steuerzeichen = "n"
+      THEN lese rueckwaerts um (anzahl - 1);
+           IF only command line (zeile)
+             THEN lese rueckwaerts um (1)
+           FI;
+           LEAVE ggf fussnote aufbrechen
+    ELIF steuerzeichen = "j" OR steuerzeichen = return
+      THEN LEAVE fussnotenumbruch anfrage
+    ELIF steuerzeichen = esc
+      THEN errorstop ("Abbruch durch ESC")
+    FI
+  END REP.
+
+anweisungen fuer umbruch einfuegen:
+  record einfuegen ("#end#");
+  record einfuegen ("#foot continued#");
+  kommandos in dummy speichern;
+  record einfuegen (dummy);
+  record einfuegen ("Forts. von letzter Seite: ");
+  lese rueckwaerts um (3);
+  kommando index := end.
+END PROC zeile speichern;
+
+PROC lese rueckwaerts um (INT CONST anzahl):
+  to line (ausgabe, line no (ausgabe) - anzahl);
+  read record (ausgabe, zeile)
+END PROC lese rueckwaerts um;
+
+PROC schreibe kopf oder fuss (INT CONST was):
+  IF was = footnote
+    THEN fussnoten generieren
+  ELIF laufende spaltennr < 2
+    THEN kopf oder fuss zeilen generieren
+  FI.
+
+kopf oder fusszeilen generieren:
+INT VAR i :: 1;
+BOOL VAR in generierter zeile war kommando :: FALSE;
+   ggf anfangs kommandos generieren;
+   FOR i FROM 2 UPTO anz kopf oder fuss zeilen [was] REP
+      dummy := kopf fuss zeilen [was] [i];
+      IF NOT in generierter zeile war kommando
+        THEN in generierter zeile war kommando :=
+              pos (dummy, kommandozeichen) <> 0
+      FI;
+      fuege seitennr ein;
+      record einfuegen (dummy)
+   END REP;
+   ggf ende kommandos generieren.
+ 
+ggf anfangs kommandos generieren:
+   kommandos in dummy speichern;
+   IF dummy <> kopf fuss zeilen [was] [1]
+     THEN record einfuegen (kopf fuss zeilen [was] [1])
+   FI.
+ 
+ggf ende kommandos generieren:
+   kommandos in dummy speichern;
+   IF dummy <> kopf fuss zeilen [was] [1] OR
+                                       in generierter zeile war kommando
+     THEN record einfuegen (dummy)
+   FI.
+ 
+fuege seitennr ein:
+INT VAR k;
+  change all (dummy,
+              (seitenzeichen SUB 1) + (seitenzeichen SUB 1),
+              text (laufende seitennr [1] +1));
+  FOR k FROM 1 UPTO length (seitenzeichen) REP
+    change all (dummy, seitenzeichen SUB k, text (laufende seitennr [k]));
+  END REP.
+ 
+fussnoten generieren:
+   kommandos in dummy speichern;
+   letzte kommandoleiste := dummy;
+   i := 1;
+   WHILE i < anz kopf oder fusszeilen [footnote] REP
+     IF kommandos vorhanden [i]
+       THEN IF letzte kommandoleiste <> footzeilen [i]
+              THEN record einfuegen (footzeilen [i]);
+                   letzte kommandoleiste := footzeilen [i]
+            FI
+       ELSE record einfuegen (footzeilen [i])
+     FI;
+     i INCR 1
+   END REP;
+   IF footzeilen [i] <> dummy
+     THEN record einfuegen (dummy)
+   FI
+END PROC schreibe kopf oder fuss;
+
+PROC fussnoten loeschen:
+  kopf oder fuss laenge [footnote] := 0;
+  anz kopf oder fuss zeilen [footnote] := 0
+END PROC fussnoten loeschen;
+ 
+PROC schreibe ggf fuss:
+  record einfuegen ("#text end#");
+  ggf tabellenende generieren;
+  letztes seitenende war mit absatz := letzte textzeile war mit absatz;
+  IF erreichte seitenlaenge <> eingestellte seitenlaenge
+    THEN schreibe freien platz
+  FI;
+  IF kopf oder fuss laenge [footnote] > 0
+    THEN ggf tabellenende generieren; 
+         schreibe kopf oder fuss (footnote);
+         fussnoten loeschen
+  FI;
+  IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite)
+     OR ausgeschalteter bottom
+    THEN 
+    ELSE schreibe mal fussbereich
+  FI.
+ 
+schreibe mal fussbereich:
+  IF kopf oder fuss laenge [fuss] > 0
+    THEN schreibe kopf oder fuss (fuss)
+  ELIF kopf oder fuss laenge [fuss gerade] > 0 AND
+            (laufende seitennr [1] MOD 2 = 0)
+    THEN schreibe kopf oder fuss (fuss gerade)
+  ELIF kopf oder fuss laenge [fuss ungerade] > 0 AND
+            (laufende seitennr [1] MOD 2 <> 0)
+    THEN schreibe kopf oder fuss (fuss ungerade)
+  FI.
+
+ggf tabellenende generieren:
+  IF tab pos speicher <> ""
+    THEN record einfuegen ("#clear pos# ")
+  FI;
+  IF in tabelle
+    THEN record einfuegen ("#table end# ");
+         letztes seitenende war in tabelle := TRUE;
+         in tabelle := FALSE
+  FI.
+
+schreibe freien platz:
+  IF pageblock on
+    THEN schreibe ggf stauchung oder streckungs anweisung
+    ELSE schreibe free (eingestellte seitenlaenge - erreichte seitenlaenge) 
+  FI.
+
+schreibe ggf stauchung oder streckungs anweisung:
+  IF interaktiv AND seitenluecke > fuenf prozent der seitenlaenge
+    THEN cursor (1, 2);
+         dummy := begin mark;
+         dummy CAT "Soll die Seite beim Druck gestreckt werden (";
+         dummy CAT text (ystepconversion (seitenluecke)); 
+         dummy CAT " cm)";
+         dummy CAT end mark;
+         IF no (dummy)
+          THEN cursor (1, 2);
+               out (cl eol);
+               schreibe free
+                        (eingestellte seitenlaenge - erreichte seitenlaenge);
+               line;
+               LEAVE schreibe ggf stauchung oder streckungs anweisung
+         FI;
+         cursor (1, 2);
+         out (cl eol);
+         line
+  FI;
+  INT VAR i :: lineno (ausgabe);
+  to line (ausgabe, textbegin zeilennr);
+  dummy := "#textbegin (";
+  dummy CAT text (anz textzeilen);
+  dummy CAT ", """;
+  dummy CAT text (ystepconversion (seitenluecke)); 
+  dummy CAT """)#";
+  read record (ausgabe, zeile);
+  IF (zeile SUB length (zeile)) = blank
+    THEN dummy CAT blank
+  FI;
+  write record (ausgabe, dummy);
+  to line (ausgabe, i).
+
+seitenluecke:
+  eingestellte seitenlaenge - erreichte seitenlaenge.
+
+fuenf prozent der seitenlaenge:
+  ((eingestellte seitenlaenge + 99) DIV 100) * 5.
+END PROC schreibe ggf fuss;
+
+(**************************** kommando speicherung *****************)
+ 
+PROC grenzmarkierung in dummy speichern:
+  dummy := "#page##";
+  dummy CAT (3 * "-----------");
+  dummy CAT " Ende der Seite ";
+  IF in nullter seite
+    THEN dummy CAT "0 "
+    ELSE dummy CAT (text (laufende seitennr [1]) + blank)
+  FI;
+  IF anz spalten > 1
+    THEN dummy CAT "und Spalte ";
+         dummy CAT (text (laufende spaltennr) + blank)
+    ELSE dummy CAT "-----------"
+  FI;
+  dummy CAT kommando zeichen
+END PROC grenzmarkierung in dummy speichern;
+
+PROC kommandos in dummy speichern:
+  type speichern;
+  dummy CAT modifikation;
+  limit speichern;
+  linefeed mit absatzblank speichern.
+ 
+type speichern:
+  dummy := "#type(""";
+  dummy CAT eingestellter typ;
+  dummy CAT """)#".
+
+limit speichern:
+  dummy CAT "#limit(";
+  dummy CAT eingestelltes limit;
+  dummy CAT ")#".
+
+linefeed mit absatzblank speichern:
+  dummy CAT "#linefeed(0";
+  dummy CAT text (real eingestellter zeilenvorschub);
+  dummy CAT ")# ".
+END PROC kommandos in dummy speichern; 
+
+PROC kommandos aufheben:
+   kommandos in dummy speichern;
+   kommando speicher := dummy
+END PROC kommandos aufheben;
+
+PROC kommandos wiederherstellen:
+  zeile := kommando speicher;
+  kommandos verarbeiten;
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub
+END PROC kommandos wiederherstellen;
+ 
+(**************************** headzeilen einfuegen ************************) 
+ 
+PROC schreibe ggf kopf:
+  IF (NOT insert first head AND laufende seiten nr [1] = nummer erste seite)
+     OR ausgeschalteter head
+    THEN 
+    ELSE schreibe mal 
+  FI;
+  ggf tabellenanfang generieren;
+  text begin anweisung generieren.
+ 
+schreibe mal: 
+  IF kopf oder fuss laenge [kopf] > 0
+    THEN schreibe kopf oder fuss (kopf);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf]
+  ELIF kopf oder fuss laenge [kopf gerade] > 0
+             AND (laufende seitennr [1] MOD 2 = 0)
+    THEN schreibe kopf oder fuss (kopf gerade);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf gerade]
+  ELIF kopf oder fuss laenge [kopf ungerade] > 0
+             AND (laufende seitennr [1] MOD 2 <> 0)
+    THEN schreibe kopf oder fuss (kopf ungerade);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf ungerade]
+  FI.
+
+ggf tabellenanfang generieren:
+  IF tab pos speicher <> ""
+    THEN record einfuegen ("#clearpos#");
+         record einfuegen (tab pos speicher)
+  FI;
+  IF letztes seitenende war in tabelle
+    THEN record einfuegen ("#table# ");
+         letztes seitenende war in tabelle := FALSE;
+         in tabelle := TRUE
+  FI.
+
+text begin anweisung generieren:
+  dummy := "#text begin#";
+  IF letztes seitenende war mit absatz
+    THEN dummy CAT " "
+  FI;
+  record einfuegen (dummy);
+  textbegin zeilennr := line no (ausgabe) - 1.
+END PROC schreibe ggf kopf;
+
+PROC erhoehe seiten und spaltennr:
+  IF anz spalten > 1
+    THEN erhoehe spaltennummer
+  FI;
+  IF NOT in nullter seite
+    THEN erhoehe seitennummer
+  FI.
+ 
+erhoehe spaltennummer:
+  laufende spaltennr INCR 1;
+  IF laufende spaltennr > anz spalten
+    THEN laufende spaltennr := 1;
+         text laenge vor columns := 0
+    ELSE LEAVE erhoehe seiten und spaltennr
+  FI.
+
+erhoehe seitennummer:
+  INT VAR i;
+  FOR i FROM 1 UPTO length (seitenzeichen) REP
+    laufende seitennr [i] INCR 1
+  END REP
+END PROC erhoehe seiten und spaltennr;
+ 
+PROC seitennummer setzen (INT CONST akt nummer):
+  IF pos (seitenzeichen, par1) = 0
+    THEN IF length (seitenzeichen) >= max anz seitenzeichen
+           THEN fehler (16, "");
+                LEAVE seitennummer setzen
+         FI;
+         seitenzeichen CAT par1
+  FI;
+  laufende seitennr [pos (seitenzeichen, par1)] := akt nummer.
+END PROC seitennummer setzen;
+ 
+PROC kommando seitenspeicher fuellen:
+  kommando seitenspeicher CAT "#";
+  kommando seitenspeicher CAT kommando;
+  kommando seitenspeicher CAT "#"
+END PROC kommando seitenspeicher fuellen;
+
+(************************** kommandos verarbeiten ********************) 
+ 
+PROC verarbeite kommando:
+INT VAR anz params, intparam;
+  kommando ende pos :=
+      pos (zeile, kommando zeichen, kommando anfangs pos + 1);
+  IF kommando ende pos <> 0
+    THEN kommando oder kommentar kommando verarbeiten
+    ELSE fehler (2,
+            subtext (zeile, kommandoanfangspos, kommandoanfangspos+9)+"...");
+         zeile CAT kommando zeichen;
+         write record (ausgabe, zeile);
+         kommando ende pos := length (zeile)
+  FI.
+ 
+kommando oder kommentar kommando verarbeiten:
+  IF pos ("-/"":", zeile SUB kommando anfangs pos + 1) = 0
+    THEN kommando :=
+         subtext (zeile, kommando anfangs pos + 1, kommando ende pos - 1);
+         scanne kommando;
+         setze kommando um
+    ELSE kommando index := 0
+  FI.
+
+scanne kommando:
+  analyze command (kommandoliste, kommando, 3,
+                   kommando index, anz params, par1, par2);
+  disable stop;
+   command error;
+   IF is error
+     THEN dummy := error message;
+          clear error;
+          dummy CAT " -> ";
+          dummy CAT kommando;
+          fehler (22, dummy);
+          enable stop;
+          LEAVE verarbeite kommando
+   FI;
+  enable stop.
+ 
+setze kommando um:
+  IF durchgang = 3 AND kommando index <> value1 AND kommando index <> to page
+     AND kommando index <> counter value1
+    THEN LEAVE verarbeite kommando
+  FI;
+  SELECT kommando index OF
+ 
+CASE type1:
+     modifikation := "";
+     IF in index oder exponent > 0
+       THEN LEAVE setze kommando um
+     ELIF font exists (par1)
+       THEN font nr := font (par1);
+            eingestellter typ := par1;
+            type zeilenvorschub :=
+            font height (fontnr) + font lead (fontnr) + font depth (fontnr);
+            IF type zeilenvorschub > max type zeilenvorschub
+              THEN max type zeilenvorschub := type zeilenvorschub
+            FI
+       ELSE fehler (1, par1)
+     FI;
+     berechne zeilenvorschub
+ 
+CASE linefeed:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN real eingestellter zeilenvorschub := realparam;
+            es war ein linefeed in der zeile  := TRUE
+       ELSE fehler (4, par1)
+     FI
+ 
+CASE limit:
+     eingestelltes limit := par1
+ 
+CASE free:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF keine zeichen ausser blank nach dem kommando 
+              THEN free kommando ausfuehren
+              ELSE fehler (19, kommando);
+            FI
+       ELSE fehler (4, par1)
+     FI
+ 
+CASE page command0:
+  IF keine zeichen ausser blank nach dem kommando
+    THEN page behandlung;
+         schreibe titelzeile
+    ELSE fehler (19, kommando)
+  FI
+ 
+CASE page command1: 
+  IF keine zeichen ausser blank nach dem kommando
+    THEN INT VAR seitennummer mit page := int (par1);
+         page behandlung;
+         laufende spaltennr := 1;
+         text laenge vor columns := 0;
+         IF seitennummer mit page <= 0 
+           THEN fehler (27, "page (" + text (seitennummer mit page) + ")")
+           ELSE laufende seitennr [1] := seitennummer mit page
+         FI
+     ELSE fehler (19, kommando)
+  FI
+
+CASE pagenr:
+     IF in nullter seite OR durchgang = 4
+       THEN intparam := int (par2);
+            IF length (par1) <> 1
+              THEN fehler (14, "")
+            ELIF NOT last conversion ok
+              THEN fehler (5, kommando)
+            ELIF intparam <= 0
+              THEN fehler (27, kommando)
+              ELSE seitennummer setzen (intparam) 
+            FI
+     ELIF durchgang = 2
+       THEN kommando seitenspeicher fuellen
+     FI
+ 
+CASE pagelength:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF in nullter seite OR durchgang = 4
+              THEN eingestellte seitenlaenge := y step conversion (realparam)
+            ELIF durchgang = 2
+              THEN kommando seitenspeicher fuellen
+            FI 
+       ELSE fehler (4, kommando) 
+     FI
+ 
+CASE foot, foot contd:
+     fussnote aufnehmen
+ 
+CASE end:
+     IF NOT bereich aufnehmen
+       THEN fehler (31, "")
+     FI;
+     bereich aufnehmen := FALSE;
+     kommando index := end;
+     IF NOT keine zeichen ausser blank nach dem kommando
+       THEN fehler (19, kommando)
+     FI
+ 
+CASE head:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf ungerade] := 0;
+            kopf oder fuss laenge [kopf gerade] := 0;
+            aufnehmen (kopf)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE headeven:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf] := 0;
+            aufnehmen (kopf gerade)
+       ELSE fehler (19, kommando)
+     FI; 
+     bereich aufnehmen := FALSE
+ 
+CASE headodd:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf] := 0;
+            aufnehmen (kopf ungerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottom:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss ungerade] := 0;
+            kopf oder fuss laenge [fuss gerade] := 0;
+            aufnehmen (fuss)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottomeven:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss] := 0;
+            aufnehmen (fuss gerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottomodd:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss] := 0;
+            aufnehmen (fuss ungerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+
+CASE columns:
+     IF anz spalten > 1
+       THEN fehler (29, "")
+       ELSE anz spalten := int (par1);
+            laufende spalten nr := 1;
+            IF anz spalten < 2
+              THEN fehler (26, "");
+                   anz spalten := 2
+            FI;
+            text laenge vor columns :=
+                   aktuelle seitenlaenge + kopf oder fuss laenge [footnote]
+     FI
+
+CASE columnsend:
+     IF durchgang = 1
+       THEN delete record (ausgabe);
+            IF NOT nur dateiende danach
+              THEN seitenende einbringen und zurueck;
+                   record einfuegen ("#columnsend#");
+                   text laenge vor columns := 0;
+                   laufende spaltennr := 1;
+                   anz spalten := 1;
+                   kommando index := page command0;
+                   down (ausgabe)
+            FI
+     FI
+
+CASE topage:
+     IF durchgang > 1
+       THEN ggf gespeicherte nummer einsetzen (par1);
+            mindestens ein topage gewesen := TRUE
+     FI
+
+CASE goalpage:
+     IF durchgang > 1
+       THEN nummer und kennzeichen speichern (laufende seitennr[1], par1)
+     FI
+
+CASE count0, count1:
+     IF durchgang > 1
+       THEN counter INCR 1;
+            change (zeile,
+                    kommando anfangs pos, kommando ende pos, text(counter));
+            kommando ende pos := kommando anfangs pos;
+            write record (ausgabe, zeile);
+            IF anz params = 1
+              THEN nummer und kennzeichen speichern (counter, par1)
+            FI
+     FI
+
+CASE setcount:
+     intparam := int (par1);
+     IF last conversion ok AND intparam >= 0
+       THEN counter := intparam - 1
+       ELSE fehler (30, par1)
+     FI
+
+CASE value0:
+     IF durchgang > 1
+       THEN change (zeile, kommando anfangs pos, kommando ende pos,
+                     text (counter));
+            write record (ausgabe, zeile);
+            kommando ende pos := kommando anfangs pos
+     FI
+
+CASE value1:
+     IF durchgang > 1
+       THEN ggf gespeicherte nummer einsetzen (par1)
+     FI
+ 
+CASE on: 
+     change all (par1, " ", ""); 
+     par1 := (par1 SUB 1); 
+     modifikation CAT "#on(""" + par1 + """)#"
+ 
+CASE off: 
+     change all (par1, " ", ""); 
+     par1 := (par1 SUB 1); 
+     changeall (modifikation, "#on(""" + par1 + """)#", ""); 
+ 
+CASE head on:  ausgeschalteter head := FALSE
+CASE head off: ausgeschalteter head := TRUE
+
+CASE bottom on:  ausgeschalteter bottom := FALSE
+CASE bottom off: ausgeschalteter bottom := TRUE
+
+CASE count per page: count seitenzaehlung := TRUE
+
+CASE table:
+     IF durchgang > 1
+       THEN in tabelle := TRUE
+     FI
+
+CASE table end:
+     IF durchgang > 1
+       THEN in tabelle := FALSE
+     FI
+
+CASE r pos, l pos, c pos, d pos, b pos, clearpos1, fillchar:
+     IF durchgang > 1
+       THEN tab pos speicher CAT "#";
+            tab pos speicher CAT kommando;
+            tab pos speicher CAT "#"
+     FI
+
+CASE clearpos0:
+     IF durchgang > 1
+       THEN tab pos speicher := ""
+     FI
+
+CASE pageblock : pageblock on := TRUE
+
+CASE counter1, counter2:
+     IF durchgang > 1
+       THEN process counter
+     FI
+
+CASE set counter:
+     IF durchgang > 1
+       THEN process set counter
+     FI
+
+CASE counter store:
+     IF durchgang > 1
+       THEN process counter store
+     FI
+
+CASE counter value0:
+     IF durchgang > 1
+       THEN write dec value into file
+     FI
+
+CASE counter value1:
+     IF durchgang > 1
+       THEN process counter value
+     FI
+
+CASE u, d:
+     in index oder exponent INCR 1
+
+CASE e:
+     in index oder exponent DECR 1
+
+OTHERWISE
+     kommando index := 0; 
+     IF macro command and then process parameters (kommando)
+       THEN ersetze macro 
+     FI
+END SELECT.
+
+nur dateiende danach:
+  INT VAR diese zeile :: line no (ausgabe);
+  WHILE NOT eof (ausgabe) REP
+    read record (ausgabe, zeile);
+    IF length (zeile) > 1
+      THEN to line (ausgabe, diese zeile);
+           read record (ausgabe, zeile);
+           LEAVE nur dateiende danach WITH FALSE
+    FI;
+    down (ausgabe)
+  END REP;
+  to line (ausgabe, diese zeile);
+  read record (ausgabe, zeile);
+  TRUE.
+END PROC verarbeite kommando;
+
+(************************ Makro-Ersetzung **************************)
+ 
+PROC ersetze macro: 
+  INT VAR erste zeile :: line no (ausgabe);
+  hole texte um macro herum;
+  fuege macro zeilen ein;
+  fuege text nach macro an;
+  positioniere zurueck.
+
+hole texte um macro herum:
+  vor macro  := subtext (zeile, 1, kommando anfangs pos - 1);
+  nach macro := subtext (zeile, kommando ende pos + 1).
+
+fuege macro zeilen ein:
+  INT VAR anz :: 1;
+  WHILE anz < number macro lines REP 
+    get macro line (macro line);
+    IF anz = 1
+      THEN vor macro CAT macro line ;
+           write record (ausgabe, vor macro);
+      ELSE down (ausgabe);
+           insert record (ausgabe);
+           write record (ausgabe, macro line)
+    FI;
+    anz INCR 1
+  END REP.
+
+fuege text nach macro an: 
+  read record (ausgabe, zeile);
+  IF length (nach macro) <> 0
+    THEN zeile CAT nach macro
+  ELIF (zeile SUB length (zeile)) <> blank AND number macro lines > 2
+    THEN delete record (ausgabe);
+         read record (ausgabe, dummy);
+         zeile CAT dummy
+  FI;
+  IF subtext (zeile, length (zeile) - 1, length (zeile)) = "  "
+    THEN delete char (zeile, length (zeile))
+  FI;
+  write record (ausgabe, zeile). 
+
+positioniere zurueck:
+  to line (ausgabe, erste zeile);
+  read record (ausgabe, zeile);
+  IF in nullter seite
+    THEN zeile noch nicht verarbeitet := TRUE
+  FI;
+  kommando ende pos := kommando anfangs pos - 1. 
+END PROC ersetze macro; 
+ 
+(************************ Zeilenvorschub-Berechnung ****************)
+ 
+PROC berechne zeilenvorschub:
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  IF real eingestellter zeilenvorschub >= 1.0
+    THEN max zeilenvorschub := max
+    (int (real (max type zeilenvorschub)*real eingestellter zeilenvorschub + 0.5),
+     berechneter zeilenvorschub)
+  ELIF berechneter zeilenvorschub > max zeilenvorschub
+    THEN max zeilenvorschub := berechneter zeilenvorschub
+  FI
+END PROC berechne zeilenvorschub;
+ 
+(**************************** counter processing **********************)
+
+PROC process counter:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter numbering store, dummy) = 0
+    THEN fehler (34, par1);
+         LEAVE process counter
+  FI;
+  get dec value (counter numbering store);
+  IF kommando index = counter2
+    THEN resize dec value to needed points
+  FI;
+  IF dec value was just initialized
+    THEN dec value := subtext (dec value, 2)
+  ELIF kommando index = counter1
+    THEN digit value := int (dec value);
+         digit value INCR 1;
+         dec value := text (digit value)
+    ELSE incr counter value
+  FI;
+  write dec value into file;
+  replace value in numbering store (dec value).
+
+resize dec value to needed points:
+  INT VAR needed points       :: int (par2),
+          begin of last digit :: 1;
+  WHILE needed points > 0 REP
+    IF next point pos = 0
+      THEN IF needed points = 1
+             THEN dec value CAT ".0"
+             ELSE dec value CAT ".1"
+           FI;
+           begin of last digit := length (dec value)
+      ELSE begin of last digit := next point pos + 1
+    FI;
+    needed points DECR 1
+  END REP;
+  INT VAR end of last digit := next point pos - 1;
+  IF end of last digit < 0
+    THEN end of last digit := length (dec value)
+  FI;
+  dec value := subtext (dec value, 1, end of last digit).
+
+next point pos:
+  pos (dec value, ".", begin of last digit).
+
+dec value was just initialized:
+  (dec value SUB 1) = "i".
+
+incr counter value:
+  INT VAR digit value :: int (
+               subtext (dec value, begin of last digit, end of last digit));
+  digit value INCR 1;
+  change (dec value, begin of last digit, end of last digit,
+                                                         text (digit value)).
+END PROC process counter;
+
+PROC process set counter:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter numbering store, dummy) <> 0
+    THEN warnung (15, par1);
+         replace value in numbering store (par2);
+         INT VAR begin pos :: pos (counter numbering store, dummy) + 1;
+         begin pos := pos (counter numbering store, "#", beginpos) + 1;
+         insert char (counter numbering store, "i", begin pos)
+    ELSE counter numbering store CAT dummy;
+         counter numbering store CAT "i";
+         counter numbering store CAT par2
+  FI.
+END PROC process set counter;
+
+PROC process counter store:
+  IF pos (counter reference store, par1) <> 0
+    THEN fehler (35, par1)
+    ELSE store it
+  FI.
+
+store it:
+  counter reference store CAT "#";
+  counter reference store CAT par1;
+  counter reference store CAT "#";
+  counter reference store CAT dec value
+END PROC process counter store;
+
+PROC process counter value:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter reference store, dummy) <> 0
+    THEN get dec value (counter reference store);
+         write dec value into file
+  ELIF durchgang = 3
+    THEN fehler (61, par1)
+  FI.
+END PROC process counter value;
+
+PROC replace value in numbering store (TEXT CONST val):
+  INT VAR begin pos :: pos (counter numbering store, dummy) + 1;
+  begin pos := pos (counter numbering store, "#", begin pos) + 1;
+  INT VAR end pos := pos (counter numbering store, "#", begin pos)-1;
+  IF end pos <= 0
+    THEN end pos := length (counter numbering store)
+  FI;
+  change (counter numbering store, begin pos, end pos, val)
+END PROC replace value in numbering store;
+
+PROC write dec value into file:
+  change (zeile, kommando anfangs pos, kommando ende pos, dec value);
+  kommando ende pos := kommando anfangs pos;
+  write record (ausgabe, zeile)
+END PROC write dec value into file;
+
+PROC get dec value (TEXT CONST store):
+  INT VAR value begin :: pos (store, dummy);
+  value begin := pos (store, "#", value begin + 1) + 1;
+  INT VAR value end :: pos (store, "#", value begin)-1;
+  IF value end < 0
+    THEN value end := length (store)
+  FI;
+  dec value := subtext (store, value begin, value end).
+END PROC get dec value;
+
+(************************** Zaehler routinen ('refer') ***************)
+ 
+PROC nummer und kennzeichen speichern (INT CONST number, TEXT VAR kennung):
+  ueberpruefe auf bereits vorhandenes kennzeichen;
+  anz refers INCR 1;
+  IF anz refers > max refers 
+    THEN errorstop ("Anzahl Referenzen zu gross") 
+  FI;
+  refer sammler [anz refers] . kennzeichen := kennung;
+  refer sammler [anz refers] . nummer      := number;
+  refer sammler [anz refers] . referenced  := FALSE.
+ 
+ueberpruefe auf bereits vorhandenes kennzeichen: 
+  INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF refer sammler [i] . kennzeichen = kennung
+      THEN warnung (9, kennung);
+           LEAVE nummer und kennzeichen speichern
+    FI
+  END REP.
+END PROC nummer und kennzeichen speichern;
+ 
+PROC ggf gespeicherte nummer einsetzen (TEXT VAR kennung):
+  IF kennzeichen vorhanden
+    THEN change (zeile, kommando anfangs pos, kommando ende pos, textnummer);
+         refer sammler [i] . referenced := TRUE;
+         kommando ende pos := kommando anfangs pos;
+         write record (ausgabe, zeile)
+  ELIF durchgang = 3
+    THEN warnung (4, kennung)
+  FI. 
+ 
+textnummer:
+  text (refer sammler [i] . nummer).
+ 
+kennzeichen vorhanden: 
+INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF refer sammler [i] . kennzeichen = kennung
+      THEN LEAVE kennzeichen vorhanden WITH TRUE
+    FI
+  END REP;
+  FALSE.
+END PROC ggf gespeicherte nummer einsetzen;
+
+(************************** free-Kommando *****************************) 
+ 
+PROC free kommando ausfuehren:
+INT CONST wert in y steps :: y step conversion (realparam);
+  IF bereich aufnehmen
+    THEN 
+  ELIF wert in y steps>=eingestellte seitenlaenge - seitenlaenge fester teil
+    THEN fehler (13, "")
+  ELIF erreichte seitenlaenge + wert in y steps > eingestellte seitenlaenge
+    THEN ende einer seite;
+         kommando index := fehler index
+    ELSE aktuelle seitenlaenge INCR wert in y steps
+  FI
+END PROC free kommando ausfuehren;
+ 
+(*************************** page-Kommando ******************************) 
+ 
+PROC page behandlung:
+TEXT VAR steuerzeichen;
+  page kommando entfernen;
+  IF aktuelle seitenlaenge <= 0
+    THEN IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+           ELSE up (ausgabe)
+         FI;
+         LEAVE page behandlung
+  FI;
+  IF interaktiv
+    THEN initialisiere bildschirm fuer page;
+         mit page interaktiv formatieren;
+         schreibe titelzeile;
+  FI;
+  BOOL CONST hilf :: pageblock on;
+  pageblock on := FALSE;
+  seitenende einbringen und zurueck;
+  pageblock on := hilf;
+  kommando index := page command0.
+ 
+page kommando entfernen:
+  IF kommando anfangs pos = 1
+    THEN delete record (ausgabe);
+         IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+         FI
+    ELSE zeile := subtext (zeile, 1, kommando anfangs pos - 1);
+         write record (ausgabe, zeile);
+         IF NOT only command line (zeile)
+           THEN aktuelle seitenlaenge INCR max zeilenvorschub
+         FI;
+         down (ausgabe)
+  FI.
+
+initialisiere bildschirm fuer page:
+  schreibe titelzeile
+  ("#page# bestaetigen: RETURN / loeschen: HOP RUBOUT / Abbruch: ESC");
+  line ; out (cleol);
+  put ("#page# nach");
+  put (y step conversion (erreichte seitenlaenge)); put ("cm");
+  schreibe bildschirm;
+  out (hop).
+
+mit page interaktiv formatieren:
+  REP
+     inchar (steuerzeichen);
+     IF steuerzeichen = return
+       THEN zeilenmitteilung loeschen;
+            LEAVE mit page interaktiv formatieren
+     ELIF steuerzeichen = rubout
+       THEN weitermachen
+     ELIF steuerzeichen = esc
+       THEN errorstop ("Abbruch mit ESC")
+     FI
+  END REP.
+ 
+weitermachen:
+  zeilenmitteilung loeschen;
+  up (ausgabe);
+  LEAVE page behandlung.
+ 
+zeilenmitteilung loeschen:
+  cursor (1, 2); out (cleol); line.
+END PROC page behandlung;
+
+PROC seite nochmal durchgehen:
+  zurueck bis seitenende;
+  kommandos wiederherstellen;
+  down (ausgabe);
+  IF count seitenzaehlung
+    THEN counter := 0
+  FI;
+  schreibe ggf kopf;
+  read record (ausgabe, zeile);
+  seitenlaenge initialisieren;
+  fussnoten loeschen;
+  bis seitenende lesen und kommandos verarbeiten;
+  schreibe ggf fuss;
+  initialisieren fuer neue seite.
+ 
+bis seitenende lesen und kommandos verarbeiten:
+  durchgang := 2;
+  zeilen und kommandos verarbeiten;
+  durchgang := 1.
+ 
+zeilen und kommandos verarbeiten:
+  anz textzeilen := 0;
+  WHILE NOT seitenende REP
+    IF mindestens ein kommando vorhanden
+      THEN IF NOT only command line (zeile)
+             THEN anz textzeilen INCR 1
+           FI;
+           kommandos verarbeiten und ggf zeile mitzaehlen;
+      ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub;
+           anz textzeilen INCR 1
+    FI;
+    naechste zeile lesen
+  END REP.
+ 
+initialisieren fuer neue seite:
+  kommandos aufheben;
+  fussnoten loeschen;
+  erhoehe seiten und spaltennr;
+  seitenlaenge initialisieren
+END PROC seite nochmal durchgehen;
+
+PROC seitenlaenge initialisieren: 
+  IF anz spalten > 1 AND laufende spaltennr > 1
+    THEN aktuelle seitenlaenge := text laenge vor columns
+    ELSE aktuelle seitenlaenge := 0;
+         verarbeite seitenkommandos
+  FI.
+
+verarbeite seitenkommandos:
+  IF kommando seitenspeicher <> ""
+    THEN zeile := kommando seitenspeicher;
+         kommando seitenspeicher := "";
+         INT CONST xx := durchgang;
+         durchgang := 4;
+         kommandos verarbeiten;
+         durchgang := xx
+  FI.
+END PROC seitenlaenge initialisieren; 
+ 
+PROC zurueck bis seitenende:
+  up (ausgabe, "#page##---", line no (ausgabe));
+  IF anz spalten > 1 AND laufende spaltennr > 1
+    THEN down (ausgabe);
+         schreibe free (text laenge vor columns + head laenge);
+         up (ausgabe)
+  FI;
+  read record (ausgabe, zeile);
+  cout (line no (ausgabe));
+END PROC zurueck bis seitenende;
+ 
+BOOL PROC seitenende:
+  pos (zeile, "#page#") = 1 AND pos (zeile, "-----", 8) = 8
+END PROC seitenende;
+
+(**************************** eigentliche seitenform-routine *********) 
+ 
+PROC seiten form:
+  enable stop;
+   datei assoziieren;
+   page form initialisieren;
+   to line (ausgabe, 1);
+   read record (ausgabe, zeile);
+   in nullter seite := TRUE;
+   nullte seite verarbeiten;
+   nullte seitengrenze einfuegen;
+   in nullter seite := FALSE;
+   formieren.
+ 
+nullte seite verarbeiten:
+  aktuelle seitenlaenge := 0;
+  WHILE only command line (zeile) REP
+    IF seitenende 
+      THEN errorstop ("Bitte Originaldatei bearbeiten (keine Druckdatei)")
+    FI;
+    kommandos verarbeiten; 
+    IF es war ein free kommando OR tabellen kommando
+      THEN LEAVE nullte seite verarbeiten
+    ELIF es war ein linefeed in der zeile
+      THEN berechne zeilenvorschub;
+           es war ein linefeed in der zeile := FALSE;
+           naechste zeile lesen
+    ELIF zeile noch nicht verarbeitet
+      THEN read record (ausgabe, zeile);
+           zeile noch nicht verarbeitet := FALSE
+      ELSE naechste zeile lesen
+    FI;
+    cout (line no (ausgabe))
+  ENDREP.
+ 
+es war ein free kommando:
+  aktuelle seitenlaenge <> 0.
+ 
+tabellen kommando:
+  kommando index >= 35 AND kommando index <= 44.
+
+nullte seitengrenze einfuegen:
+  laufende spaltennr := 0;
+  grenzmarkierung in dummy speichern;
+  record einfuegen (dummy);
+  read record (ausgabe, zeile);
+  kommandos aufheben;
+  aktuelle seitenlaenge := 0;
+  erhoehe seiten und spaltennr;
+  nummer erste seite := laufende seiten nr [1].
+
+formieren:
+   REP
+     cout (line no (ausgabe));
+     IF mindestens ein kommando vorhanden
+       THEN kommandos verarbeiten und ggf zeile mitzaehlen
+       ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub;
+     FI;
+     IF erreichte seitenlaenge > eingestellte seitenlaenge
+       THEN ende einer seite
+     FI;
+     IF eof (ausgabe)
+       THEN eof behandlung;
+            LEAVE formieren
+       ELSE down (ausgabe);
+            IF eof (ausgabe)
+              THEN eof behandlung;
+                   LEAVE formieren
+              ELSE read record (ausgabe, zeile)
+            FI
+     FI
+   END REP.
+END PROC seiten form;
+
+PROC eof behandlung:
+  grenzmarkierung in dummy speichern;
+  insert record (ausgabe);
+  write record (ausgabe, dummy);
+  nummer letzte seite := laufende seiten nr [1];
+  pageblock on := FALSE;
+  seite nochmal durchgehen;
+  IF anz refers <> 0 OR mindestens ein topage gewesen
+     OR counter reference store <> ""
+    THEN ausgabe datei nochmals durchgehen;
+         offene referenzen pruefen
+  FI. 
+ 
+ausgabe datei nochmals durchgehen: 
+  to line (ausgabe, 1); col (ausgabe, 1);
+  durchgang := 3; 
+  REP
+    down (ausgabe, "#", lines (ausgabe));
+    IF pattern found
+      THEN read record (ausgabe, zeile);
+           cout (line no (ausgabe));
+           kommandos verarbeiten;
+           IF eof (ausgabe)
+             THEN LEAVE ausgabe datei nochmals durchgehen
+             ELSE down (ausgabe); col (ausgabe, 1)
+           FI
+      ELSE LEAVE ausgabe datei nochmals durchgehen
+    FI
+  END REP.
+
+offene referenzen pruefen: 
+  INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF NOT refer sammler [i] . referenced
+      THEN report text processing warning
+                  (3, 0, fehlerdummy, CONCR(refersammler) [i] . kennzeichen) 
+    FI 
+  END REP.
+END PROC eof behandlung;
+
+(************************** kommando verarbeitung **********)
+
+BOOL PROC mindestens ein kommando vorhanden:
+   pos (zeile, kommando zeichen) <> 0.
+END PROC mindestens ein kommando vorhanden;
+
+PROC kommandos verarbeiten:
+  kommando anfangs pos := pos (zeile, kommando zeichen);
+  WHILE kommando anfangs pos <> 0 REP
+    verarbeite kommando;
+    IF kommando index = end OR kommando index = page command0
+       OR kommando index = page command1 OR kommando index = fehler index
+      THEN LEAVE kommandos verarbeiten
+      ELSE kommando anfangs pos :=
+                 pos (zeile, kommando zeichen, kommando ende pos + 1)
+    FI
+  END REP. 
+END PROC kommandos verarbeiten;
+
+PROC kommandos verarbeiten und ggf zeile mitzaehlen:
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  kommandos verarbeiten;
+  in index oder exponent := 0;
+  zeile zur seitenlaenge ggf addieren;
+  IF es war ein linefeed in der zeile
+    THEN berechne zeilenvorschub;
+         es war ein linefeed in der zeile := FALSE
+  FI.
+
+zeile zur seitenlaenge ggf addieren:
+  IF only command line (zeile) OR
+     kommando index = end OR kommando index = page command0 OR
+     kommando index = page command1 OR kommando index = fehler index
+    THEN 
+    ELSE aktuelle seitenlaenge INCR max zeilenvorschub;
+  FI.
+END PROC kommandos verarbeiten und ggf zeile mitzaehlen;
+
+BOOL PROC keine zeichen ausser blank nach dem kommando:
+  IF kommando anfangs pos > 1 AND
+          pos (zeile, ""33"", ""255"", 1) = kommando anfangs pos
+    THEN warnung (13, kommando)
+  FI;
+  kommando ende pos = length (zeile) OR
+  pos (zeile, ""33"", ""254"", kommando ende pos + 1) = 0
+END PROC keine zeichen ausser blank nach dem kommando;
+
+BOOL PROC absatz zeile:
+  (zeile SUB length (zeile)) = blank
+END PROC absatz zeile;
+ 
+(********************** routinen fuers seitenende *************)
+
+INT PROC erreichte seitenlaenge:
+  aktuelle seitenlaenge + kopf oder fuss laenge [footnote] +
+        seitenlaenge fester teil
+END PROC erreichte seitenlaenge;
+ 
+INT PROC seitenlaenge fester teil:
+  head laenge + bottom laenge.
+ 
+bottom laenge: 
+  IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite)
+     OR ausgeschalteter bottom
+   THEN 0
+    ELSE kopf oder fuss laenge [fuss] +
+         bottom laenge fuer gerade oder ungerade seiten
+  FI. 
+
+bottom laenge fuer gerade oder ungerade seiten:
+  IF laufende seitennr [1] MOD 2 = 0
+    THEN kopf oder fuss laenge [fuss gerade]
+    ELSE kopf oder fuss laenge [fuss ungerade]
+  FI.
+END PROC seitenlaenge fester teil;
+
+INT PROC head laenge: 
+  IF (NOT insert first head AND laufende seitennr [1] = nummer erste seite)
+     OR ausgeschalteter head
+    THEN 0
+    ELSE kopf oder fuss laenge [kopf] + 
+         head laenge fuer gerade oder ungerade seiten 
+  FI. 
+ 
+head laenge fuer gerade oder ungerade seiten:
+  IF laufende seitennr [1] MOD 2 = 0
+    THEN kopf oder fuss laenge [koπ3Πφ&η6φζ�
+    ELSE kopf oder fuss laenge [kopf ungerade]
+  FI.
+END PROC head laenge;
+
+PROC ende einer seite:
+  IF interaktiv
+    THEN seitenende ggf verschieben
+    ELSE seitenende fuer autopageform ggf verschieben
+  FI;
+  seitenende einbringen und zurueck.
+ 
+seitenende ggf verschieben:
+  BOOL VAR veraenderungen in der seite :: FALSE;
+  formatiere ueber bildschirm (veraenderungen in der seite);
+  schreibe titelzeile;
+  IF veraenderungen in der seite
+    THEN zum seitenanfang zur erneuten bearbeitung;
+         LEAVE ende einer seite
+  FI.
+
+seitenende fuer autopageform ggf verschieben:
+INT VAR i, hier :: line no (ausgabe);
+  FOR i FROM 1 UPTO 4 REP
+    zeile zurueck lesen;
+    IF absatz zeile OR line no (ausgabe) <= 2
+      THEN ggf um leerzeilen nach oben lesen;
+           naechste zeile lesen;
+           LEAVE seitenende fuer autopageform ggf verschieben
+    FI
+  END REP;
+  to line (ausgabe, hier);
+  read record (ausgabe, zeile);
+  IF pageblock on
+    THEN FOR i FROM 1 UPTO 4 REP
+           IF absatz zeile OR eof (ausgabe) OR pos (zeile, "#foot") <> 0
+              OR pos (zeile, "#free") <> 0
+             THEN naechste zeile lesen;
+                  LEAVE seitenende fuer autopageform ggf verschieben
+           FI;
+           naechste zeile lesen
+         END REP;
+         to line (ausgabe, hier);
+         read record (ausgabe, zeile)
+  FI.
+
+ggf um leerzeilen nach oben lesen:
+  INT VAR ii := i;
+  WHILE zeile = " " AND pageblock on AND ii <= 4 REP
+    IF line no (ausgabe) <= 2
+      THEN LEAVE ggf um leerzeilen nach oben lesen
+    FI;
+    zeile zurueck lesen;
+    ii INCR 1
+  END REP.
+END PROC ende einer seite;
+
+PROC seitenende einbringen und zurueck:
+  letzte textzeile war mit absatz := letzte zeile;
+  down (ausgabe);
+  grenzmarkierung in dummy speichern;
+  record einfuegen (dummy);
+  up (ausgabe);
+  seite nochmal durchgehen.
+
+letzte zeile:
+  up (ausgabe);
+  read record (ausgabe, zeile);
+  absatz zeile.
+END PROC seitenende einbringen und zurueck;
+
+PROC zum seitenanfang zur erneuten bearbeitung:
+  zurueck bis seitenende; 
+  durchgang := 1;
+  aktuelle seitenlaenge := 0; 
+  fussnoten loeschen; 
+  kommandos wiederherstellen 
+END PROC zum seitenanfang zur erneuten bearbeitung; 
+ 
+(********************** positionierungs routinen ************)
+
+PROC naechste zeile lesen: 
+   down (ausgabe);
+   read record (ausgabe, zeile)
+END PROC naechste zeile lesen; 
+
+PROC zeile zurueck lesen: 
+   up (ausgabe);
+   read record (ausgabe, zeile);
+END PROC zeile zurueck lesen;
+
+(***************** seitenende interaktiv positionieren **********)
+
+PROC formatiere ueber bildschirm (BOOL VAR veraenderungen):
+  veraenderungen := FALSE;
+  anz zeilen nach oben := 0;
+  erste bildschirmzeile schreiben;
+  schreibe bildschirm;
+  REP
+     positioniere lfd satz nach steuerzeichen und ggf schirm schreiben
+  END REP.
+ 
+positioniere lfd satz nach steuerzeichen und ggf schirm schreiben:
+TEXT VAR steuerzeichen;
+   inchar (steuerzeichen);
+   IF steuerzeichen = upchar
+     THEN nach oben;
+          IF fussnoten ende
+            THEN ueberspringe fussnote nach oben;
+                 schreibe bildschirm
+          FI
+   ELIF steuerzeichen = downchar
+     THEN IF fussnoten anfang 
+            THEN ueberspringe fussnote nach unten;
+                 schreibe bildschirm
+            ELSE nach unten;
+                 IF fussnoten anfang 
+                   THEN ueberspringe fussnote nach unten;
+                        schreibe bildschirm
+                 FI
+          FI 
+   ELIF steuerzeichen = hop
+     THEN sprung oder leerzeilen veraenderung;
+          schreibe bildschirm;
+   ELIF steuerzeichen = return
+     THEN IF anz zeilen nach oben < 0
+            THEN down (ausgabe);
+                 read record (ausgabe, zeile)
+          FI;
+          IF zeile = "" OR zeile = " " 
+            THEN leerzeilen vor neuer seite loeschen
+          FI;
+          LEAVE formatiere ueber bildschirm
+  ELIF steuerzeichen = esc
+    THEN errorstop ("Abbruch mit ESC")
+   FI.
+
+fussnoten anfang:
+  pos (zeile, "#foot") <> 0 AND anz zeilen nach oben > 0.
+
+fussnoten ende:
+  pos (zeile, "#end") <> 0.
+
+nach oben:
+  IF anz zeilen nach oben < 0
+    THEN nach oben unterhalb der seitengrenze
+  ELIF eine zeile nach oben war moeglich
+    THEN IF fussnoten ende
+           THEN ueberspringe fussnote nach oben;
+                schreibe bildschirm
+         ELIF anz vertauschte zeilen < zeilen nach oben
+           THEN out (upchar); raus; out (upchar);
+                schreibe seitenbegrenzung auf bildschirm;
+                anz vertauschte zeilen INCR 1
+           ELSE schreibe bildschirm
+         FI
+  FI.
+
+nach oben unterhalb der seitengrenze:
+  IF anz zeilen nach oben = -1
+    THEN cursor (1, pos seitengrenze); out (cl eop);
+         schreibe seitenbegrenzung auf bildschirm;
+         cursor (1, pos seitengrenze);
+         schreibe untere zeilen;
+         anz zeilen nach oben := 0
+    ELSE INT VAR bildschirmzeile unterhalb ::
+                           pos seitengrenze + abs (anz zeilen nach oben) + 1;
+         cursor (1, bildschirmzeile unterhalb);
+         out (cl eol);
+         outsubtext (zeile, 1, 76);
+         anz zeilen nach oben INCR 1;
+         bildschirmzeile unterhalb DECR 1;
+         cursor (1, bildschirmzeile unterhalb);
+         schreibe seitenbegrenzung auf bildschirm;
+         zeile zurueck lesen;
+         cursor (1, pos seitengrenze)
+  FI.
+
+nach unten:
+  IF anz zeilen nach oben < -4
+    THEN
+  ELIF anz zeilen nach oben < 1
+    THEN ggf nach unten formatieren
+  ELIF anz vertauschte zeilen > 0
+    THEN out (upchar); raus; line ;
+         schreibe seitenbegrenzung auf bildschirm;
+         eine zeile nach unten wenn moeglich;
+         anz vertauschte zeilen DECR 1
+    ELSE eine zeile nach unten wenn moeglich;
+         IF fussnoten anfang
+           THEN ueberspringe fussnote nach unten;
+         FI;
+         schreibe bildschirm
+  FI.
+
+ggf nach unten formatieren:
+  IF pageblock on
+    THEN zeile nach unten ueber seitengrenze;
+         cursor (1, pos seitengrenze);
+  FI.
+
+zeile nach unten ueber seitengrenze:
+  IF eof (ausgabe) OR page oder free oder foot anweisung
+    THEN LEAVE zeile nach unten ueber seitengrenze
+    ELSE naechste zeile lesen;
+         IF eof (ausgabe) OR page oder free oder foot anweisung
+           THEN zeile zurueck lesen;
+                LEAVE zeile nach unten ueber seitengrenze
+         FI;
+         zeile zurueck lesen
+  FI;
+  IF anz zeilen nach oben = 0
+    THEN out (cl eol);
+         out (begin mark);
+         out ("Über Seitenende hinaus (Stauchung): UP/DOWN");
+         out (end mark);
+         cursor (1, pos seitengrenze + 1);
+         schreibe untere zeilen;
+    ELSE naechste zeile lesen;
+  FI;
+  cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1);
+  out (cl eol);
+  outsubtext (zeile, 1, 76);
+  anz zeilen nach oben DECR 1;
+  cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1);
+  schreibe seitenbegrenzung auf bildschirm.
+
+page oder free oder foot anweisung:
+  pos (zeile, "#page") <> 0 OR pos (zeile, "#free") <> 0
+  OR pos (zeile, "#foot") <> 0.
+
+sprung oder leerzeilen veraenderung:
+  INT VAR i :: 0;
+  REP
+    inchar (steuerzeichen);
+    IF steuerzeichen = upchar
+      THEN sprung nach oben
+    ELIF steuerzeichen = downchar
+      THEN sprung nach unten
+    ELIF steuerzeichen = rub out
+      THEN zeile loeschen;
+    ELIF steuerzeichen = rub in
+      THEN leerzeilen einfuegen;
+    FI
+  END REP.
+
+sprung nach oben:
+   WHILE eine zeile nach oben war moeglich REP
+      i INCR 1;
+      IF fussnoten ende
+        THEN ueberspringe fussnote nach oben;
+             LEAVE sprung oder leerzeilen veraenderung
+      FI
+   UNTIL i >= zeilen nach oben END REP;
+   LEAVE sprung oder leerzeilen veraenderung.
+
+sprung nach unten:
+   WHILE i < zeilen nach oben REP
+      IF fussnoten anfang
+        THEN ueberspringe fussnote nach unten;
+             LEAVE sprung oder leerzeilen veraenderung
+        ELSE eine zeile nach unten wenn moeglich;
+             i INCR 1;
+      FI;
+      IF fussnoten anfang
+        THEN ueberspringe fussnote nach unten;
+             LEAVE sprung oder leerzeilen veraenderung
+      FI
+   END REP;
+   LEAVE sprung oder leerzeilen veraenderung.
+
+zeile loeschen:
+  veraenderungen := TRUE;
+  up (ausgabe);
+  read record (ausgabe, zeile);
+  IF seiten ende
+    THEN down (ausgabe);
+    ELSE delete record (ausgabe);
+  FI;
+  LEAVE formatiere ueber bildschirm.
+
+leerzeilen einfuegen:
+  veraenderungen := TRUE;
+  out (cl eop);
+  REP
+    inchar (steuerzeichen);
+    IF steuerzeichen = return
+      THEN insert record (ausgabe);
+           zeile := " ";
+           write record (ausgabe, zeile);
+           out (upchar);
+           raus;
+           line
+    ELIF steuerzeichen = rubin
+      THEN LEAVE formatiere ueber bildschirm
+    FI
+  END REP.
+END PROC formatiere ueber bildschirm;
+
+PROC leerzeilen vor neuer seite loeschen:
+  WHILE zeile = "" OR zeile = " " REP
+    delete record (ausgabe);
+    IF eof (ausgabe)
+      THEN LEAVE leerzeilen vor neuer seite loeschen
+      ELSE read record (ausgabe, zeile)
+    FI
+  END REP.
+END PROC leerzeilen vor neuer seite loeschen;
+
+PROC ueberspringe fussnote nach oben:
+  WHILE eine zeile nach oben war moeglich REP
+    IF fussnoten anfang
+      THEN IF eine zeile nach oben war moeglich
+             THEN
+           FI;
+           LEAVE ueberspringe fussnote nach oben
+    FI
+  END REP.
+
+fussnoten anfang:
+  pos (zeile, "#foot#") <> 0.
+END PROC ueberspringe fussnote nach oben;
+
+PROC ueberspringe fussnote nach unten:
+  REP
+    eine zeile nach unten wenn moeglich;
+    IF fussnoten ende
+      THEN eine zeile nach unten wenn moeglich;
+           LEAVE ueberspringe fussnote nach unten
+    FI
+  END REP.
+
+fussnoten ende:
+  pos (zeile, "#end#") <> 0.
+END PROC ueberspringe fussnote nach unten;
+
+PROC schreibe free (INT CONST wert):
+REAL CONST wert in y steps :: y step conversion (wert);
+  dummy := "#free(";
+  IF wert in y steps < 1.0
+    THEN dummy CAT "0"; 
+  FI;
+  dummy CAT text (wert in y steps);
+  dummy CAT ")#";
+  record einfuegen (dummy);
+END PROC schreibe free;
+
+BOOL PROC eine zeile nach oben war moeglich:
+  IF line no (ausgabe) = 1
+    THEN FALSE
+    ELSE zeile zurueck lesen;
+         IF seitenende OR columns kommando in dieser zeile
+           THEN naechste zeile lesen;
+                FALSE
+           ELSE anz zeilen nach oben INCR 1;
+                TRUE
+         FI
+  FI.
+
+columns kommando in dieser zeile:
+  anz spalten > 1 AND pos (zeile, "#columns") <> 0.
+END PROC eine zeile nach oben war moeglich;
+
+PROC eine zeile nach unten wenn moeglich:
+   IF anz zeilen nach oben > 0
+     THEN naechste zeile lesen;
+          anz zeilen nach oben DECR 1
+   FI
+END PROC eine zeile nach unten wenn moeglich;
+
+PROC erste bildschirmzeile schreiben:
+  IF anz spalten > 1
+    THEN dummy := "Spalten"
+    ELSE dummy := "Seiten"
+  FI;
+  dummy CAT "ende verschieben: UP, DOWN / bestaetigen: RETURN / Abbruch: ESC";
+  schreibe titelzeile (dummy).
+END PROC erste bildschirmzeile schreiben;
+
+PROC schreibe bildschirm:
+  anz vertauschte zeilen := 0;
+  cursor (1, 3);
+  out (cl eop);
+  gehe zurueck;
+  wieder nach vorne und zeilen ausgeben;
+  cursor (1, pos seitengrenze);
+  schreibe seitenbegrenzung auf bildschirm;
+  cursor (1, pos seitengrenze);
+  schreibe untere zeilen.
+
+gehe zurueck:
+  INT VAR hier :: line no (ausgabe) -1;
+  to line (ausgabe, hier - zeilen nach oben + 1);
+  INT VAR anz read zeilen :: hier - line no (ausgabe) + 2.
+
+ wieder nach vorne und zeilen ausgeben:
+   IF line no (ausgabe) = 1
+     THEN ggf leerzeilen auf bildschirm schreiben;
+   FI;
+   WHILE line no (ausgabe) <= hier REP
+      read record (ausgabe, zeile);
+      raus;
+      down (ausgabe);
+   END REP;
+   read record (ausgabe, zeile).
+
+ggf leerzeilen auf bildschirm schreiben:
+   IF zeilen nach oben - anz read zeilen >= 0
+     THEN INT VAR i;
+          FOR i FROM 1 UPTO zeilen nach oben - anz read zeilen REP
+            line ; out (cl eol); out(" ")
+          END REP;
+          line ; out (cl eol);
+          out ("<< DATEI ANFANG >>"); out (return)
+   FI.
+END PROC schreibe bildschirm;
+
+PROC schreibe untere zeilen:
+  gehe weiter und gebe zeilen aus;
+  gehe wieder zurueck;
+  skip input;
+  cursor (1, pos seitengrenze).
+
+gehe weiter und gebe zeilen aus:
+INT VAR anz read zeilen :: 0,
+        i               :: line no (ausgabe);
+  WHILE anz read zeilen < zeilen nach unten REP
+    IF eof (ausgabe)
+       THEN line ; out (cleol); out ("<< DATEI ENDE >>");
+            LEAVE gehe weiter und gebe zeilen aus
+     FI;
+     raus;
+     naechste zeile lesen;
+     anz read zeilen INCR 1
+  END REP.
+
+gehe wieder zurueck:
+  to line (ausgabe, i);
+  read record (ausgabe, zeile).
+END PROC schreibe untere zeilen;
+
+(***************** schreib-routinen fuer den bildschirm ************)
+
+PROC schreibe seitenbegrenzung auf bildschirm:
+   out (cl eol); out (begin mark);
+   grenzmarkierung in dummy speichern;
+   out (dummy);
+   out (end mark);
+   out (return)
+END PROC schreibe seitenbegrenzung auf bildschirm;
+
+PROC raus:
+INT VAR xzeile, yspalte;
+   line ; out (cl eol);
+   outsubtext (zeile, 1, 76);
+   IF absatz zeile
+     THEN get cursor (yspalte, xzeile);
+          cursor (77, xzeile);
+          out (begin end mark)
+   FI;
+   out (return)
+END PROC raus;
+ 
+PROC schreibe titelzeile:
+  IF online
+    THEN schreibe
+  FI.
+
+schreibe:
+  out (hop); out (cleol);
+  put ("PAGEFORM"); put ("(für"); put (lines (ausgabe)); put ("Zeilen):");
+  put (name eingabe datei);
+  put ("->");
+  put (name druck datei);
+  cursor (1, 3).
+END PROC schreibe titelzeile;
+ 
+PROC schreibe titelzeile (TEXT CONST t):
+  IF online
+    THEN schreibe
+  FI.
+
+schreibe:
+  out (hop); out (cl eol);
+  out (begin mark);
+  out (t);
+  out (end mark)
+END PROC schreibe titelzeile; 
+ 
+(************************** initialisierungs-routine ************)
+
+PROC page form initialisieren:
+BOOL VAR exists;
+INT VAR i;
+  letzte textzeile war mit absatz   := TRUE;
+  letztes seitenende war mit absatz := TRUE;
+  pageblock on                      := FALSE;
+  zeile noch nicht verarbeitet      := FALSE;
+  bereich aufnehmen                 := FALSE;
+  count seitenzaehlung              := FALSE;
+  ausgeschalteter head              := FALSE;
+  ausgeschalteter bottom            := FALSE;
+  in tabelle                        := FALSE;
+  es war ein linefeed in der zeile  := FALSE;
+  letztes seitenende war in tabelle := FALSE;
+  mindestens ein topage gewesen     := FALSE;
+  in index oder exponent    := 0;
+  anz refers                := 0;
+  kommando index            := 0;
+  counter                   := 0;
+  laufende seitennr [1]     := 1;
+  durchgang                 := 1;
+  anz spalten               := 1;
+  modifikation              := "";
+  tab pos speicher          := "";
+  kommando seitenspeicher   := "";
+  counter numbering store   := "";
+  counter reference store   := "";
+  dec value                 := "";
+  seitenzeichen             := "%";
+  eingestelltes limit       := dina4 limit;
+  IF NOT file works
+    THEN font nr := 1;
+         eingestellter typ := font (1);
+         type zeilenvorschub :=
+                          font height (1) + font lead (1) + font depth (1);
+         eingestellte seitenlaenge := y step conversion (dina4 pagelength);
+         real eingestellter zeilenvorschub := 1.0
+  FI;
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  max      zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  FOR i FROM 1 UPTO 7 REP
+     kopf oder fuss laenge [i]     := 0;
+     anz kopf oder fuss zeilen [i] := 0
+  END REP;
+  IF online
+    THEN page
+  FI;
+  IF command dialogue
+    THEN interaktiv := TRUE;
+    ELSE interaktiv := FALSE;
+  FI;
+  IF online
+    THEN page
+  FI;
+  schreibe titelzeile
+END PROC page form initialisieren;
+
+PROC central pagefo9ü̈NSγJr+�Cβ+̂γ��{s�β�KrΓλγb�#Τκ�ZK��
+  name eingabe datei := input;
+  name druck datei   := druck;
+  IF exists (druck)
+    THEN forget (druck, quiet)
+  FI;
+  disable stop;
+    ds := nilspace; 
+    refer sammler := ds;
+    seiten form;
+    forget(ds);
+    IF is error
+      THEN put error;
+           clear error; 
+           last param (name eingabe datei)
+      ELSE last param (name druck datei)
+    FI;
+  enable stop;
+  IF anything noted
+    THEN note edit (ausgabe)
+  FI.
+END PROC central pageform routine;
+
+PROC pageform (TEXT CONST input, druck):
+  file works := FALSE;
+  central pageform routine (input, druck).
+END PROC pageform;
+ 
+PROC pageform (TEXT CONST input):
+  file works := FALSE;
+  central pageform routine (input, input + ".p").
+END PROC pageform;
+
+PROC pageform:
+  file works := FALSE;
+  pageform (last param)
+END PROC pageform;
+ 
+PROC pageform (TEXT CONST input, REAL CONST lf, seitenlaenge):
+  file works                := TRUE;
+  eingestellte seitenlaenge := y step conversion (seitenlaenge);
+  real eingestellter zeilenvorschub := lf;
+  central pageform routine (input, input + ".p")
+END PROC pageform;
+
+PROC autopageform:
+  autopageform (last param)
+END PROC autopageform;
+
+PROC autopageform (TEXT CONST input):
+  command dialogue (false);
+  pageform (input);
+  command dialogue (true)
+END PROC autopageform;
+END PACKET seiten formatieren;
+(*
+REP
+  IF yes ("autopageform")
+    THEN autopageform ("pfehler")
+    ELSE pageform ("pfehler")
+  FI;
+  edit("pfehler.p");
+UNTIL yes ("ENDE") ENDREP;
+*)
+
diff --git a/system/multiuser/1.7.5/src/print cmd b/system/multiuser/1.7.5/src/print cmd
new file mode 100644
index 0000000..1fcb475
--- /dev/null
+++ b/system/multiuser/1.7.5/src/print cmd
@@ -0,0 +1,29 @@
+ 
+PACKET print cmd DEFINES print, printer : 
+ 
+PROC print :
+
+  print (last param)
+
+ENDPROC print ;
+
+PROC print (TEXT CONST file name) :
+
+  save (file name, task ("PRINTER")) ; 
+ 
+ENDPROC print ;
+
+PROC print (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) print, nameset)
+
+ENDPROC print ;
+
+TASK PROC printer :
+
+  task ("PRINTER")
+
+ENDPROC printer ;
+
+ENDPACKET print cmd ;
+
diff --git a/system/multiuser/1.7.5/src/priv ops b/system/multiuser/1.7.5/src/priv ops
new file mode 100644
index 0000000..a92ee76
--- /dev/null
+++ b/system/multiuser/1.7.5/src/priv ops
@@ -0,0 +1,268 @@
+(* ------------------- VERSION 10     22.04.86 ------------------- *)
+PACKET privileged operations DEFINES           (* Autor: J.Liedtke *)
+ 
+     block ,
+     calendar ,
+     collect garbage blocks ,
+     define collector , 
+     fixpoint ,
+     info password ,
+     prio ,
+     save system ,
+     send ,
+     set clock ,
+     set date ,
+     shutup ,
+     unblock :
+ 
+LET prio field           = 6 ,
+    cr                   = ""13"" ,
+    archive channel      = 31 ,
+
+    ack                  = 0 , 
+
+    garbage collect code = 1 ,
+    fixpoint code        = 2 ,
+    shutup code          = 4 ,
+    shutup and save code = 12 ,
+    reserve code         = 19 ,
+    release code         = 20 ;
+
+
+
+INT PROC prio (TASK CONST task) :
+  pcb (task, prio field)
+ENDPROC prio ;
+
+PROC prio (TASK CONST task, INT CONST new prio) :
+  pcb (task, prio field, new prio)
+ENDPROC prio ;
+
+TEXT VAR date text ;
+
+PROC collect garbage blocks :
+
+  system operation (garbage collect code)
+
+ENDPROC collect garbage blocks ;
+
+PROC fixpoint :
+
+  system operation (fixpoint code)
+
+ENDPROC fixpoint ;
+
+PROC info password (TEXT CONST old info password, new info password) :
+
+  INT VAR error code ;
+  IF online
+    THEN say (""3""5""10"")
+  FI ;
+  IF LENGTH new info password < 10
+    THEN infopw (old info password + cr, new info pw, error code) ;
+         IF error code = 0
+           THEN shutup
+           ELSE errorstop ("Falsches Info-Passwort")
+         FI
+    ELSE errorstop ("Passwort zu lang (max. 9 Zeichen)")
+  FI ;
+  cover tracks .
+
+new info pw :
+  IF new info password = "-"
+    THEN "-" + 9 * "0"
+    ELSE new info password + "cr"
+  FI .
+
+ENDPROC info password ;
+
+PROC shutup :
+
+  system operation (shutup code) ;
+  IF command dialogue
+     THEN wait for configurator ;
+          page ;
+          set date
+  FI
+
+ENDPROC shutup ;
+
+PROC save system :
+
+  INT VAR reply ;
+  TASK VAR channel owner ;
+  enable stop ;
+  reserve archive channel ;
+  IF yes ("Leere Floppy eingelegt")
+  THEN
+    reserve archive channel ;
+    system operation (shutup and save code) ;
+    release archive channel ;
+    IF command dialogue
+      THEN wait for configurator ; 
+           page ;
+           set date
+    FI 
+  FI ;
+  release archive channel .
+
+reserve archive channel :
+  channel owner := task (archive channel) ;
+  IF NOT is niltask (channel owner) 
+    THEN  ask channel owner to reserve the channel ;
+          IF channel owner does not reserve channel
+            THEN errorstop ("Task """ + name (channel owner)
+                                      + """ gibt Kanal " 
+                                      + text (archive channel)
+                                      + " nicht frei") 
+         FI 
+  FI . 
+ 
+ask channel owner to reserve the channel :
+  forget (ds) ;
+  ds := nilspace ;
+  pingpong (channel owner, reserve code, ds, reply) . 
+
+channel owner does not reserve channel : 
+  (reply <> ack) AND task exists . 
+ 
+task exists : 
+  reply <> -1 . 
+
+release archive channel :
+  forget (ds) ;
+  ds := nilspace ;
+  pingpong (channel owner, release code, ds, reply) .
+
+ENDPROC save system ;
+
+PROC system operation (INT CONST code) :
+
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used <= size
+    THEN sys op (code)
+    ELSE errorstop ("Speicherengpass")
+  FI
+
+ENDPROC system operation ;
+
+DATASPACE VAR ds := nilspace ;
+
+PROC wait for configurator :
+
+  INT VAR i , receipt ;
+  FOR i FROM 1 UPTO 20 WHILE configurator exists REP
+    pause (30) ;
+    forget (ds) ;
+    ds := nilspace ;
+    ping pong (configurator, ack, ds, receipt)
+  UNTIL receipt >= 0 PER .
+
+configurator exists :
+  disable stop ;
+  TASK VAR configurator := task ("configurator") ;
+  clear error ;
+  NOT is niltask (configurator) .
+
+ENDPROC wait for configurator ;
+
+BOOL VAR hardware clock ok ; 
+REAL VAR now ;
+ 
+PROC set date : 
+ 
+  hardware clock ok := TRUE ; 
+  try to get date and time from hardware ; 
+  IF NOT hardware clock ok 
+    THEN get date and time from user 
+  FI ; 
+  define date and time . 
+ 
+try to get date and time from hardware : 
+  disable stop ;
+  REAL VAR previous now ;
+  now := 0.0 ; 
+  INT VAR try ; 
+  FOR try FROM 1 UPTO 3 WHILE hardware clock ok REP 
+    previous now := now ; 
+    now := date (hardwares today) + time (hardwares time) 
+  UNTIL now = previous now OR is error PER ; 
+  clear error ;
+  enable stop .
+
+get date and time from user :
+  line (2) ;
+  put ("      Bitte geben Sie das heutige Datum ein :") ;
+  date text := date ;
+  TEXT VAR exit char ;
+  editget (date text, cr, "", exit char) ;
+  now := date (date text) ;
+  line ;
+  put ("      und die aktuelle Uhrzeit :") ;
+  date text := time of day ;
+  editget (date text, cr, "", exit char) ;
+  now INCR time (date text) ;
+  IF NOT last conversion ok 
+    THEN errorstop ("Falsche Zeitangabe")
+  FI .
+
+hardwares today :  calendar (3) + "." + calendar (4) + "." + calendar (5) . 
+
+hardwares time  :  calendar (2) + ":" + calendar (1) . 
+ 
+define date and time : 
+  set clock (now) . 
+ 
+ENDPROC set date ; 
+ 
+TEXT PROC calendar (INT CONST index) : 
+ 
+  INT VAR bcd ; 
+  control (10, index, 0, bcd) ; 
+  IF bcd < 0  
+    THEN hardware clock ok := FALSE ; "" 
+    ELSE text (low digit + 10 * high digit) 
+  FI . 
+ 
+low digit :  bcd AND 15 . 
+
+high digit:  (bcd AND (15*256)) DIV 256 . 
+ 
+ENDPROC calendar ; 
+
+PROC infopw (TEXT CONST old, new, INT VAR error code) :
+  EXTERNAL 81
+ENDPROC infopw ;
+
+PROC sys op (INT CONST code) :
+  EXTERNAL 90
+ENDPROC sys op ;
+
+PROC set clock (REAL CONST time) :
+  EXTERNAL 103
+ENDPROC set clock ;
+
+PROC pcb (TASK CONST task, INT CONST field, value) :
+  EXTERNAL 105
+ENDPROC pcb ;
+
+PROC unblock (TASK CONST task) :
+  EXTERNAL 108
+ENDPROC unblock ;
+
+PROC block (TASK CONST task) :
+  EXTERNAL 109
+ENDPROC block ;
+
+PROC send (TASK CONST from, to, INT CONST order, DATASPACE VAR ds,
+           INT VAR receipt) :
+  EXTERNAL 127
+ENDPROC send ;
+
+PROC define collector (TASK CONST task) :
+  EXTERNAL 128
+ENDPROC define collector ;
+
+ENDPACKET privileged operations ;
+
diff --git a/system/multiuser/1.7.5/src/silbentrennung b/system/multiuser/1.7.5/src/silbentrennung
new file mode 100644
index 0000000..dfbdf75
--- /dev/null
+++ b/system/multiuser/1.7.5/src/silbentrennung
@@ -0,0 +1,1166 @@
+(* ------------------- VERSION 170 vom 30.09.85 -------------------- *)
+PACKET silbentrennung DEFINES
+       trenn,
+       schreibe trennvektor,
+       ist ausnahme wort,
+       lade ausnahmen,
+       entlade ausnahmen:
+
+(* Programm zur Silbentrennung
+   Autor: Klaus-Uwe Koschnick / Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+          1.7.4 (Mai 1984) (Ausnahme-Woerterbuch, Verbesserungen)
+*)
+ 
+(*--------------------- Ausnahme Woerterbuch -----------------------*)
+
+DATASPACE VAR ds1 :: nilspace; 
+ 
+FILE VAR f; 
+ 
+LET name table length = 1024, 
+    max hash chars = 5; 
+ 
+INT VAR anz worte :: 0, 
+        hash index; 
+ 
+INITFLAG VAR this packet :: FALSE; 
+ 
+TEXT VAR dummy, 
+         name ohne trennstellen,
+         trennstellen,
+         blanked name;
+ 
+BOUND ROW name table length TEXT VAR name table; 
+ 
+PROC init packet:
+  IF NOT initialized (this packet)
+    THEN anz worte := 0
+  FI
+END PROC init packet;
+
+PROC init name table:
+  forget (ds1);
+  ds1 := nilspace;
+  name table := ds1;
+  INT VAR i;
+  FOR i FROM 1 UPTO name table length REP
+    cout (i);
+    name table [i] := ""
+  END REP;
+  anz worte := 0.
+END PROC init name table;
+
+PROC lade ausnahmen:
+  lade ausnahmen (last param)
+END PROC lade ausnahmen;
+
+PROC lade ausnahmen (TEXT CONST filename): 
+ IF exists (filename) 
+   THEN lade 
+   ELSE errorstop ("Datei nicht vorhanden") 
+ FI. 
+ 
+lade: 
+  init packet;
+  IF anz worte > 0 
+    THEN IF yes ("überschreiben") 
+           THEN init nametable 
+         ELIF no ("anfügen") 
+           THEN LEAVE lade ausnahmen
+         FI
+    ELSE init nametable
+  FI;
+  line (2);
+  f := sequential file (input, file name);
+  WHILE NOT eof (f) REP
+    get (f, dummy);
+    IF subtext (dummy, 1, 2) = "(*"
+      THEN ueberlese kommentar
+      ELSE lade wort (* Vor.: Worte ohne Blanks *)
+    FI
+  END REP.
+
+ueberlese kommentar:
+  WHILE NOT eof (f) AND pos (dummy, "*)") = 0 REP
+    get (f, dummy);
+  END REP.
+
+lade wort:
+  line ;
+  anz worte INCR 1;
+  put (anz worte);
+  stelle namen ohne trennstellen her;
+  put (name ohne trennstellen);
+  blanked name := " ";
+  name ohne trennstellen CAT " ";
+  blanked name CAT name ohne trennstellen;
+  hash;
+  IF pos (name table [hash index], blanked name) > 0
+    THEN put ("(bereits geladen)")
+    ELSE insert char (name ohne trennstellen, " ", 1);
+         name ohne trennstellen CAT trennstellen;
+         name table [hash index] CAT name ohne trennstellen;
+  FI.
+
+stelle namen ohne trennstellen her:
+  INT VAR number;
+  name ohne trennstellen := dummy;
+  trennstellen := "";
+  WHILE pos (name ohne trennstellen, "-") > 0 REP
+    number := pos (name ohne trennstellen, "-");
+    delete char (name ohne trennstellen, number);
+    trennstellen CAT text (number - 1);
+    trennstellen CAT " "
+  END REP.
+END PROC lade ausnahmen;
+
+PROC entlade ausnahmen (TEXT CONST file name):
+  init packet;
+  IF exists (file name)
+    THEN errorstop ("Datei existiert bereits")
+    ELSE unload
+  FI.
+
+unload:
+  f := sequential file (output, file name);
+  INT VAR i;
+  FOR i FROM 1 UPTO name table length REP
+    cout (i);
+    IF name table [i] <> ""
+      THEN putline (f, name table [i])
+    FI
+  END REP.
+END PROC entlade ausnahmen;
+
+BOOL PROC ist ausnahme wort (TEXT CONST word,
+                             INT CONST maximum, INT VAR trenn position):
+  init packet;
+  IF anz worte > 0 
+    THEN blanked name fuer hash bilden;
+         hash;
+         IF pos (name table [hash index], blanked name) > 0
+           THEN trennstelle suchen
+         FI
+  FI;
+  FALSE.
+
+blanked name fuer hash bilden:
+  blanked name := " ";
+  IF maximum <= max hash chars
+    THEN eliminiere ggf satzzeichen hinter dem wort;
+         blanked name CAT
+           subtext (word, 1, min (max hash chars, wortlaenge))
+    ELSE blanked name CAT subtext (word, 1, maximum);
+  FI.
+
+eliminiere ggf satzzeichen hinter dem wort:
+  INT VAR wort laenge := length (word);
+  WHILE letztes zeichen ist kein buchstabe REP
+    wort laenge DECR 1;
+    IF wort laenge <= 2
+      THEN LEAVE ist ausnahme wort WITH FALSE
+    FI
+  END REP.
+
+letztes zeichen ist kein buchstabe:
+  TEXT CONST letztes zeichen :: (word SUB wortlaenge);
+  NOT (letztes zeichen >= "A" AND letztes zeichen <= "Z" OR
+  letztes zeichen >= "a" AND letztes zeichen <= "z" OR
+  letztes zeichen >= "Ä" AND letztes zeichen <= "k" OR 
+  letztes zeichen = "ß").
+
+trennstelle suchen:
+  index der ersten ziffer suchen;
+  INT VAR neue ziffer := 0;
+  trenn position := 0;
+  ziffern holen.
+
+index der ersten ziffer suchen:
+  dummy := name table [hash index];
+  INT VAR ziffern index := pos (dummy, blanked name);
+  ziffern index := pos (dummy, " ", ziffern index + 1) + 1.
+
+ziffern holen:
+  WHILE ist ziffer REP
+    hole neue ziffer;
+    IF gefundene ziffer ist ausserhalb des trennbereichs
+      THEN LEAVE ist ausnahme wort WITH TRUE
+    FI;
+    trenn position := neue ziffer
+  END REP;
+  LEAVE ist ausnahme wort WITH TRUE.
+
+ist ziffer:
+  ziffern index < length (dummy) AND
+((dummy SUB ziffern index + 1) = " " OR (dummy SUB ziffern index + 2) = " ").
+
+hole neue ziffer:
+  INT VAR ende position :: pos (dummy, " ", ziffern index);
+  neue ziffer := int (subtext (dummy, ziffern index, ende position - 1));
+  ziffern index := ende position + 1.
+
+gefundene ziffer ist ausserhalb des trennbereichs:
+  neue ziffer > maximum.
+END PROC ist ausnahme wort;
+
+PROC hash:
+  INT VAR i;
+  hash index := code (blanked name SUB 2);
+  FOR i FROM 3 UPTO min (length (blanked name), max hash chars) REP
+    hash index INCR hash index;
+    hash index INCR code (blanked name SUB i);
+    decrementiere hash index
+  END REP.
+
+decrementiere hash index:
+  WHILE hash index > name table length REP
+    hash index DECR 1023
+  END REP.
+END PROC hash;
+
+(*-------------- eigentlicher Trenn-Algorithmus --------------*)
+
+LET zeichenkette n = "-/",
+    regelmaessig = " bl br chl chr dr fl fr gl gr kl kn kr pf ph pl pr
+ sp st schl schm schn schr schw th tr zw ",
+    vokal string = "aeiouyäöü",
+    buchstaben   =
+    "abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",
+    grosse buchstaben = "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
+    trennstrich = ""221"",
+    cv a = 97 , cv b = 98 , cv c = 99 , cv d = 100, cv e = 101,
+    cv f = 102, cv g = 103, cv i = 105, cv k = 107,
+    cv l = 108, cv m = 109, cv n = 110, cv o = 111,
+    cv p = 112, cv r = 114, cv s = 115, cv t = 116,
+    cv u = 117, cv w = 119, cv x = 120, cv y = 121,
+    cv ae = 217 , cv oe = 218 , cv ue = 219 , cv sz = 251,
+    weder h noch ch = 0 ,
+    buchstabe h     = 1 ,
+    zeichenfolge ch = 2 ;
+
+INT CONST minus one :: - 1;
+
+INT VAR i, grenze, absolute grenze, sonderzeichen trennpos,
+        zeichen vor teilwort, teilwort laenge, a pos, e pos, 
+        a pos minus 2, a pos minus 1, a pos plus 1, a pos plus 2, 
+        e pos minus 1; 
+ 
+ROW 50 INT VAR vektor ;
+ 
+TEXT VAR wort,
+         teilwort,
+         kons gr,
+         search,
+         zeichen;
+
+BOOL VAR trennstelle gefunden ;
+
+PROC trenn (TEXT CONST word, TEXT VAR part1, trennsymbol, INT CONST maximum):
+  IF ist ausnahme wort (word, maximum, position)
+    THEN ausnahme wort behandlung;
+         LEAVE trenn
+  FI;
+  INT VAR laenge :: length (word) ;
+  IF laenge < 4
+     THEN trennung nicht moeglich
+     ELSE wort := word ;
+          grenze := min (50, maximum) ;
+          absolute grenze := min (laenge, grenze + 5) ;
+          trennung versuchen
+  FI .
+ 
+ausnahme wort behandlung:
+  IF position <= 0
+    THEN trennung nicht moeglich
+    ELSE part1 := subtext (word, 1, position);
+         IF pos (zeichenkette n, word SUB position + 1) > 0
+           THEN trennsymbol := " "
+           ELSE trennsymbol := trennstrich
+         FI
+  FI.
+
+trennung nicht moeglich : 
+  part 1 := "";
+  trennsymbol := " ".
+ 
+trennung versuchen :
+  erstelle trennvektor ;
+  IF sonderzeichen trennpos > 0
+     THEN part 1 := subtext (word, 1, sonderzeichen trennpos) ;
+          trennsymbol := " " 
+     ELSE bestimme trennposition ;
+          IF position = 0
+             THEN trennung nicht moeglich
+             ELSE part 1 := subtext (wort, 1, position) ;
+                  trennsymbol := trennstrich
+          FI
+  FI .
+
+bestimme trennposition :
+  INT VAR position ;
+  FOR position FROM grenze DOWNTO 1 REP
+     IF vektor [position] = 1
+        THEN LEAVE bestimme trennposition
+     FI
+  END REP ; 
+  position := 0 
+END PROC trenn ;
+
+BOOL PROC buchstabe (INT CONST posi) : 
+  pos (buchstaben, wort SUB posi) > 0 OR spezialcode.
+
+spezialcode:
+  INT CONST z code :: code (wort SUB posi) ;
+  (zcode > 96 AND zcode < 123).
+END PROC buchstabe ; 
+ 
+OP SPERRE (INT CONST element) :
+  INT CONST w element :: zeichen vor teilwort + element ;
+  IF w element > 0 AND w element <= grenze
+     THEN vektor [w element] := minus one
+  FI
+END OP SPERRE ;
+
+OP SETZE (INT CONST element) :
+  INT CONST w element :: zeichen vor teilwort + element;
+  IF w element > 0 AND w element <= grenze AND vektor [w element] <> minus one
+    THEN vektor [w element] := 1 ;
+         trennstelle gefunden := TRUE 
+  FI
+END OP SETZE ;
+
+BOOL PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt
+                    (INT CONST akt buchstabenpos):
+  vorletzter buchstabe (akt buchstabenpos)
+  OR NOT trennung oder sperre gesetzt (akt buchstabenpos).
+END PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt;
+
+BOOL PROC vorletzter buchstabe (INT CONST akt buchstabenpos):
+  akt buchstabenpos = absolute grenze - 1
+END PROC vorletzter buchstabe;
+
+BOOL PROC trennung oder sperre gesetzt (INT CONST element):
+  INT CONST w element :: zeichen vor teilwort + element;
+  IF w element > 1 AND w element < teilwort laenge
+    THEN vektor [w element] = 1 OR gesperrt
+    ELSE TRUE
+  FI.
+
+gesperrt:
+  IF w element >= length (wort) - 1
+    THEN TRUE
+    ELSE vektor [w element] = minus one
+  FI.
+END PROC trennung oder sperre gesetzt;
+
+PROC sperren und setzen (INT CONST element) : 
+  INT CONST w element :: zeichen vor teilwort + element ; 
+  vektor [w element - 1] := minus one;
+  vektor [w element] := 1 
+END PROC sperren und setzen ; 
+ 
+TEXT PROC string (INT CONST anf pos, end pos) : 
+  subtext (teilwort, maximum, minimum).
+
+maximum:
+  IF anf pos > 1
+    THEN anf pos
+    ELSE 1
+  FI.
+
+minimum:
+  IF teilwort laenge < end pos
+    THEN teilwort laenge
+    ELSE end pos
+  FI.
+END PROC string ; 
+ 
+BOOL PROC silbenanfang vor (INT CONST akt buchstabenpos): 
+  zwei silber (akt buchstabenpos - 2) OR drei silber (akt buchstabenpos - 3)
+END PROC silbenanfang vor;
+
+BOOL PROC silbenanfang nach (INT CONST akt buchstabenpos):
+  zwei silber (akt buchstabenpos + 1) OR drei silber (akt buchstabenpos + 1)
+END PROC silbenanfang nach;
+
+BOOL PROC zwei silber (INT CONST akt buchstabenpos):
+  TEXT VAR zweier :: string (akt buchstabenpos, akt buchstabenpos + 1);
+  length (zweier) = 2 AND
+  pos ("ab an ar be er ge in um un zu re", zweier) > 0
+END PROC zwei silber;
+
+BOOL PROC drei silber (INT CONST akt buchstabenpos):
+  TEXT VAR dreier :: string (akt buchstabenpos, akt buchstabenpos + 2);
+  length (dreier) = 3 AND
+  pos ("auf aus bei ein end ent mit", dreier) > 0
+END PROC drei silber;
+
+BOOL PROC reg (INT CONST st pos) : 
+  INT CONST code one :: code (teilwort SUB st pos) ,
+            code two :: code (teilwort SUB st pos + 1) ;
+  pos (regelmaessig, konsonanten) > 0 .
+
+konsonanten :
+  search := " " ;
+  IF code one = cv c
+    THEN search CAT string (st pos, st pos + 2)
+  ELIF code one = cv s AND code two = cv c 
+    THEN search CAT string (st pos, st pos + 3)
+    ELSE search CAT string (st pos, st pos + 1) 
+  FI ;
+  search CAT " " ;
+  search
+END PROC reg ;
+ 
+INT PROC grenz position (INT CONST start pos, richtung):
+  INT VAR posit :: start pos ;
+  REP
+     posit INCR richtung 
+  UNTIL sonderzeichen oder position unzulaessig END REP;
+  posit - richtung.
+
+sonderzeichen oder position unzulaessig: 
+  posit = 0 AND posit > absolute grenze OR ist kein buchstabe.
+
+ist kein buchstabe:
+  pos (buchstaben, wort SUB posit) = 0 AND kein spezialcode.
+
+kein spezialcode:
+  INT CONST z code :: code (wort SUB posit) ;
+  (zcode < 97 OR zcode > 121).
+END PROC grenz position ; 
+
+PROC schreibe trennvektor (TEXT CONST ttt):
+line ; put (ttt); INT VAR ii;
+FOR ii FROM 1 UPTO length (wort) REP put(vektor [ii]) PER
+END PROC schreibe trennvektor;
+
+PROC erstelle trennvektor :
+INT VAR akt pos, anfang teilwort, ende teilwort, anzahl, 
+        zuletzt, tr pos, ind, code 1, code 2, code 3,
+        rechts von a pos, z code, posit;
+BOOL VAR sonderzeichen modus,
+         aktueller buchstabe ist vokal,
+         vorsilbe oder nachsilbe;
+
+  sonderzeichen trennpos := 0 ;
+  trennstelle gefunden := FALSE ;
+  initialisiere trennvektor ;
+  akt pos := grenze ;
+  IF buchstabe (akt pos) 
+     THEN zuerst teilwort
+     ELSE zuerst sonderzeichenblock
+  FI;
+  WHILE akt pos > 0 REP
+     IF sonderzeichen modus
+        THEN behandle sonderzeichenblock
+        ELSE suche trennstellen in teilwort
+     FI
+  END REP.
+
+initialisiere trennvektor : 
+  FOR i FROM 1 UPTO grenze REP vektor [i] := 0 END REP .
+
+zuerst teilwort:
+  ende teilwort := grenz position (akt pos, 1) ;
+  sonderzeichen modus := FALSE .
+
+zuerst sonderzeichenblock:
+  sonderzeichen modus := TRUE .
+
+behandle sonderzeichenblock:
+  WHILE sonderzeichen modus REP
+     IF buchstabe (akt pos)
+        THEN sonderzeichen modus := FALSE
+        ELSE zeichen := wort SUB akt pos ;
+             IF pos (zeichenkette n, zeichen) <> 0
+                THEN sonderzeichen trennpos := akt pos ;
+                     LEAVE erstelle trennvektor
+             FI ;
+             akt pos DECR 1 ;
+             IF akt pos = 0 
+                THEN LEAVE erstelle trennvektor
+             FI
+     FI
+  END REP;
+  ende teilwort := akt pos .
+
+suche trennstellen in teilwort:
+  bestimme anfang von teilwort ;
+  IF teilwort lang genug
+     THEN teilwort ausbauen und wandeln ;
+          SPERRE 1 ; SPERRE (teilwort laenge - 1) ;
+          vorsilben untersuchen ;
+          nachsilben untersuchen ;
+          vorsilbe oder nachsilbe := trennstelle gefunden ;
+          trennstelle gefunden := FALSE ;
+          weitere trennstellen suchen ;
+          IF vorsilbe oder nachsilbe
+             THEN LEAVE erstelle trennvektor
+          FI
+  FI ;
+  akt pos := anfang teilwort - 1 ;
+  sonderzeichen modus := TRUE .
+
+bestimme anfang von teilwort:
+  anfang teilwort := grenz position (ende teilwort, minus one) .
+
+teilwort lang genug:
+  teilwort laenge := ende teilwort - anfang teilwort + 1 ;
+  teilwort laenge > 3 .
+
+teilwort ausbauen und wandeln:
+  teilwort := subtext (wort, anfang teilwort, ende teilwort);
+  zeichen vor teilwort := anfang teilwort - 1 ;
+  IF pos (grosse buchstaben, teilwort SUB 1) > 0
+     THEN replace (teilwort, 1, code (code (teilwort SUB 1) + 32))
+  FI .
+  (* Es ist nicht notwendig, gross geschriebene Umlaute am
+  Wortanfang zu wandeln! *)
+
+weitere trennstellen suchen:
+  e pos := teilwort laenge ;
+  aktueller buchstabe ist vokal := letzter buchstabe ist vokal ;
+  WHILE e pos > 1 REP
+     anzahl := 0 ;
+     a pos := e pos ;
+     IF aktueller buchstabe ist vokal
+        THEN behandle vokalgruppe
+        ELSE behandle konsonantengruppe
+     FI ;
+     IF trennstelle gefunden 
+        THEN LEAVE erstelle trennvektor
+     FI ;
+     e pos := a pos - 1 ;
+  END REP .
+
+letzter buchstabe ist vokal:
+  pos (vokal string,teilwort SUB e pos) > 0 .
+
+behandle vokalgruppe:
+  vokalgruppe lokalisieren ;
+  IF a pos > 1 AND e pos < teilwort laenge
+     THEN a pos plus 1 := a pos + 1 ; 
+          a pos plus 2 := a pos + 2 ; 
+          IF anzahl = 2
+             THEN vokal 2
+          ELIF anzahl > 2
+             THEN vokal 3
+             ELSE vokal 1
+          FI
+  FI .
+
+vokalgruppe lokalisieren:
+  zuletzt := 0 ;
+  WHILE aktueller buchstabe ist vokal REP
+     zeichen := teilwort SUB a pos ;
+     IF pos (vokal string,zeichen) > 0
+        THEN z code := code(zeichen) ;
+             IF zuletzt <> cv e
+                OR (z code <> cv a AND z code <> cv o AND z code <> cv u)
+                THEN anzahl INCR 1
+             FI ;
+             IF a pos > 1
+                THEN a pos DECR 1 ;
+                     zuletzt := z code 
+                ELSE aktueller buchstabe ist vokal := FALSE
+             FI
+        ELSE a pos INCR 1 ;
+             aktueller buchstabe ist vokal := FALSE
+     FI 
+  END REP .
+
+behandle konsonantengruppe:
+  konsonantengruppe lokalisieren ;
+  IF a pos > 1 AND e pos < teilwort laenge
+     THEN a pos minus 2 := a pos - 2 ; 
+          a pos minus 1 := a pos - 1 ; 
+          a pos plus 1  := a pos + 1 ; 
+          a pos plus 2  := a pos + 2 ; 
+          e pos minus 1 := e pos - 1 ; 
+          SELECT anzahl OF
+          CASE 1    : konsonant 1
+          CASE 2    : konsonant 2
+          OTHERWISE : konsonant 3
+          END SELECT
+  FI .
+
+konsonantengruppe lokalisieren:
+  rechts von a pos := weder h noch ch ;
+  REP 
+     zeichen := teilwort SUB a pos ;
+     IF pos (vokal string, zeichen) = 0
+        THEN anzahl INCR 1 ;
+             IF zeichen = "h" 
+                THEN rechts von a pos := buchstabe h
+              ELIF zeichen = "c" AND rechts von a pos = buchstabe h
+                THEN anzahl DECR 1 ;
+                     rechts von a pos := zeichenfolge ch
+              ELIF zeichen = "s" AND rechts von a pos = zeichenfolge ch
+                THEN anzahl DECR 1 ;
+                     rechts von a pos := weder h noch ch
+                ELSE rechts von a pos := weder h noch ch 
+             FI ;
+             IF a pos > 1 
+                THEN a pos DECR 1 
+                ELSE aktueller buchstabe ist vokal := TRUE
+             FI
+        ELSE a pos INCR 1 ;
+             aktueller buchstabe ist vokal := TRUE 
+     FI
+  UNTIL aktueller buchstabe ist vokal END REP .
+
+vorsilben untersuchen: 
+  code 2 := code (teilwort SUB 2);
+  code 3 := code (teilwort SUB 3);
+  IF ch vierer silbe
+    THEN sperren und setzen (4)
+    ELSE restliche vorsilben
+  FI.
+
+ch vierer silbe:
+ string (2, 4) = "ach" OR string (2, 4) = "och" OR string (2, 4) = "uch".
+
+restliche vorsilben:
+  ind    := pos ("abdefghimnrstuvwüu", teilwort SUB 1);
+SELECT ind OF 
+CASE1(*a*): IF drei silber (1)
+              THEN sperren und setzen (3) 
+            ELIF code 2 = cv b (*ab*)
+              THEN IF string(3,5) = "end" (*abend*)
+                      THEN SPERRE 2; sperren und setzen (5) 
+                    ELIF string(3,4) = "er" (*aber*)
+                      THEN sperren und setzen (4) 
+                      ELSE sperren und setzen (2)
+                   FI
+            ELIF code 2 = cv n AND string(3,5) <> "alo" (*analo*)
+              THEN SETZE 2
+            FI
+CASE2(*b*): IF code 2 = cv e (* be *)
+              THEN IF    (teilwort SUB 3) = "h" (* be-handeln usw *)
+                      OR (teilwort SUB 3) = "a" (* beamter *)
+                     THEN sperren und setzen (2)
+                   ELIF string (3, 4) = "ob" (* beobachten *)
+                     THEN SETZE 2; sperren und setzen (4)
+                   FI
+            ELIF string (2, 3) = "au" (* bauer usw *)
+              THEN sperren und setzen (3)
+            FI
+CASE3(*d*): IF (code 3 = cv s AND (code 2 = cv i OR code 2 = cv e))
+               OR string (2, 3) = "ar" (* dis, des, dar*)
+              THEN sperren und setzen (3) 
+            ELIF string (2, 4) = "enk" (* denk.. *)
+              THEN sperren und setzen (4)
+            ELIF string(2,5) = "urch" (*durch*)
+              THEN SPERRE 3 ; SETZE 5 
+            FI
+CASE4(*e*): IF code 2 = cv r AND code 3 <> cv n AND code 3 <> cv d 
+              AND string (3, 4) <> "ro" (* er, aber nicht: ern, erd, erro *)
+              THEN SETZE 2
+            ELIF code 2 = cv x (* ex *)
+              THEN SETZE 2
+            ELIF (code 2 = cv m AND code 3 = cv p AND (teilwort SUB 4) = "f")
+                 OR (code 2 = cv n AND code 3 = cv t) (* empf, ent *)
+              THEN sperren und setzen (3)
+            FI 
+CASE5(*f*): 
+CASE6(*g*): IF string (2, 5) = "egen" (* gegen *)
+              THEN sperren und setzen (5)
+            ELIF string (2, 6) = "leich" (* gleich *)
+              THEN IF vorletzter buchstabe (5)
+                     THEN SPERRE 6
+                   ELIF vorletzter buchstabe (6)
+                     THEN sperren und setzen (4)
+                     ELSE sperren und setzen (6)
+                   FI
+            ELIF zwei silber (1)
+              THEN SETZE 2
+            FI
+CASE7(*h*): IF string (2, 3) = "in" OR string (2, 3) = "er" (* hin, her *)
+              THEN sperren und setzen (3)
+            FI
+CASE8(*i*): IF code 2 = cv n (* in *)
+              THEN IF string (3, 5) = "ter" (* inter *)
+                      THEN sperren und setzen (5)
+                   ELIF subtext (teilwort, 1, 5) = "insbe"
+                      THEN sperren und setzen (3)
+                      ELSE sperren und setzen (2)
+                   FI;
+            FI
+CASE9(*m*):  IF string (2, 3) = "ög" AND teilwort laenge > 5 (* mög *)
+               THEN sperren und setzen (3);
+             FI
+CASE10(*n*): IF string (2, 4) = "ach" AND teilwort laenge >= 7 
+                AND (teilwort SUB 5) <> "t" (* nach, aber nicht: nacht *)
+               THEN SETZE 4 
+             ELIF string (2, 6) = "ieder" (* nieder *)
+               THEN sperren und setzen (6) 
+             ELIF string (2, 5) = "icht" (* nicht *)
+               THEN sperren und setzen (5)
+             ELIF string (2, 3) = "eu" (* neu *)
+               THEN sperren und setzen (3);
+                    IF dreisilber (4)
+                      THEN sperren und setzen (6)
+                    FI
+             ELIF string (2, 5) = "iste"
+               THEN sperren und setzen (2)
+             FI
+CASE11(*r*): IF code 2 = cv e (* re *)
+               THEN IF silbenanfang nach (4) (* Realeinkommen *)
+                      THEN sperren und setzen (4)
+                      ELSE sperren und setzen (2)
+                    FI
+             FI
+CASE12(*s*): IF string (2, 6) = "elbst" (* selbst *)
+               THEN sperren und setzen (6); SPERRE 4
+             FI
+CASE13(*t*): IF string (2, 3) = "at" (* tat *)
+               THEN sperren und setzen (3)
+             ELIF string (2, 5) = "rans" (* trans *)
+               THEN sperren und setzen (5)
+             ELIF string (2, 4) = "heo" (* theo *)
+               THEN sperren und setzen (4)
+             FI
+CASE14(*u*): IF code 2 = cv m (* um *)
+               THEN SETZE 2
+             ELIF code 2 = cv n (* un *)
+               THEN IF code 3 = cv i (* uni *)
+                       THEN sperren und setzen (3)
+                       ELSE sperren und setzen (2);
+                            IF string (3, 5) = "ter" (* unter *)
+                               THEN sperren und setzen (5)
+                            FI
+                    FI
+             FI
+CASE15(*v*): IF string (2, 3) = "or" OR string (2, 3) = "on" OR
+                string (2, 3) = "er" (* vor, von, ver *)
+               THEN sperren und setzen (3)
+             FI
+CASE16(*w*): IF code 2 = cv e AND code 3 = cv g (* weg *)
+               THEN sperren und setzen (3) 
+             ELIF code 2 = cv i (* wi *)
+               THEN IF string(3,5) = "der" (* wider *)
+                       THEN sperren und setzen (5)
+                     ELIF string(3,6) = "eder" (* weder *)
+                       THEN sperren und setzen (6) 
+                    FI
+             FI
+CASE17(*ü*): IF string (2, 4) = "ber" (* über *)
+               THEN sperren und setzen (4)
+             FI
+CASE18(*z*): IF code 2 = cv u (*zu*)
+               THEN sperren und setzen (2);
+                    IF drei silber (3) (* zuein *)
+                      THEN sperren und setzen (5)
+                    FI
+             FI
+END SELECT.
+ 
+nachsilben untersuchen:
+  IF (teilwort SUB teilwort laenge) = "t" 
+     THEN IF (string (teilwort laenge - 3,teilwort laenge) = "heit" 
+             AND (teilwort SUB teilwort laenge - 4) <> "c")
+             OR string (teilwort laenge - 3, teilwort laenge -1) = "kei"
+             THEN sperren und setzen (teilwort laenge - 4)
+          FI
+  ELIF string (teilwort laenge - 2, teilwort laenge) = "tag"
+    THEN sperren und setzen (teilwort laenge - 3)
+  ELIF string (teilwort laenge - 3, teilwort laenge) = "tags"
+    THEN sperren und setzen (teilwort laenge - 4)
+  FI.
+
+vokal 1:
+  IF string (a pos, a pos plus 2) = "uel"
+    THEN SETZE a pos
+  FI.
+
+vokal 2 :
+  ind    := pos (vokal string, teilwort SUB a pos);
+  code 2 := code (teilwort SUB a pos plus 1);
+SELECT ind OF 
+CASE1(*a*): IF code 2 = cv a OR code 2 = cv i OR code 2 = cv y (*aa,ai,ay*)
+              THEN
+            ELIF code 2 = cv u
+              THEN silbe au behandlung
+              ELSE SETZE a pos 
+            FI
+CASE2(*e*): IF code 2 = cv u AND (teilwort SUB a pos plus 2) = "e" (*eue*)
+              THEN SETZE a pos plus 1 
+            ELIF code 2 = cv o OR code 2 = cv ae OR code 2 = cv ue
+                OR code 2 = cv oe  (*eo, eä, eü, eö *)
+             THEN SETZE a pos 
+            FI
+CASE3(*i*): IF code 2 <> cv e AND code 2 <> cv o (* i, aber nicht: ie, io *)
+              THEN SETZE a pos
+            FI
+CASE4(*o*): IF code 2 = cv o OR code 2 = cv u (* oo, ou *)
+              THEN 
+            ELIF code 2 = cv e (* oe *)
+              THEN SETZE a pos plus 1 
+              ELSE SETZE a pos 
+            FI
+CASE5(*u*): IF (teilwort SUB a pos - 1) = "q" (* qu *)
+              THEN 
+            ELIF code 2 = cv e (* ue *)
+              THEN SETZE a pos plus 1
+              ELSE SETZE a pos 
+            FI
+CASE7(*y*): IF code 2 <> cv u (* yu *)
+              THEN SETZE a pos
+            FI
+OTHERWISE (*äöü*): SETZE a pos
+END SELECT.
+ 
+silbe au behandlung:
+  IF (teilwort SUB a pos + 2) = "e" (* aue, wie in dau-ernd *)
+    THEN SETZE a pos plus 1 
+  ELIF a pos > 2 AND trennung oder sperre gesetzt (a pos + 2) AND 
+       ((teilwort SUB a pos + 2) = "f" OR (teilwort SUB a pos + 2) = "s")
+       (* aus- oder auf-Mittelsilben *)
+    THEN SETZE (a pos - 1)
+  FI.
+
+vokal 3 : 
+  IF string (a pos, a pos plus 2) <> "eau"
+     AND string (a pos plus 1, a pos+3) <> "eau" 
+     THEN IF e pos - a pos = anzahl - 1 
+             THEN SETZE a pos plus 1
+             ELSE code 1 := code(teilwort SUB a pos) ; 
+                  tr pos := a pos plus 1 ; 
+                  IF (code 1 = cv a OR code 1 = cv o OR code 1 = cv u) 
+                     AND (teilwort SUB a pos plus 1) = "e" 
+                     THEN tr pos INCR 1
+                  FI;
+                  code 2 := code (teilwort SUB tr pos) ; 
+                  IF (code 2 = cv a OR code 2 = cv o OR code 2 = cv u) 
+                     AND (teilwort SUB tr pos + 1) = "e" 
+                     THEN tr pos INCR 1
+                  FI ; 
+                  SETZE tr pos
+          FI 
+  FI .
+
+konsonant 1 : 
+  ind := pos ("bcklmnrstß", teilwort SUB a pos);
+SELECT ind OF 
+CASE1(*b*): IF string (a pos minus 1, a pos plus 2) = "über"
+              THEN SETZE a pos minus 2
+            ELIF silbenanfang nach (a  pos)
+                 AND NOT trennung oder sperre gesetzt (a pos minus 1)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1
+            FI;
+CASE2(* c oder ch *):
+            IF ((teilwort SUB a pos plus 1) = "h"
+                 AND (silbenanfang nach (a pos plus 1)
+                     OR string (a pos, a pos + 3) = "chen"))
+               OR (teilwort SUB a pos plus 1) <> "h"
+              THEN SETZE a pos minus 1
+              ELSE SETZE a pos plus 1
+            FI
+CASE3(*k*): IF string (a pos minus 2, a pos minus 1) = "ti" (* tik *)
+               AND silbenanfang nach (a pos)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE4(*l*): IF string (a pos - 3, a pos plus 1) = "reali"
+              THEN SETZE a pos plus 1
+            ELIF string (a pos minus 1, a pos plus 1) = "aly"
+              THEN SETZE a pos minus 1
+            ELIF    string (a pos minus 2, a pos minus 1) = "ta" (*..tal..*)
+                 OR string (a pos minus 2, a pos minus 1) = "na" (*..nal..*)
+                 OR string (a pos minus 2, a pos minus 1) = "ia" (*..ial..*) 
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE5(*m*): IF string (a pos minus 2, a pos minus 1) = "to" (* ..tom..*)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE6(*n*): IF string (a pos - 4, a pos minus 1) = "gege" 
+               OR string (a pos - 4, a pos minus 1) = "nebe" (*gegen, neben*)
+              THEN SETZE (a pos - 3) ; SETZE a pos 
+            ELIF string (a pos minus 1, a pos plus 1) = "ini"
+              THEN 
+            ELIF NOT silbenanfang vor (a pos)
+                 AND ((teilwort SUB a pos minus 1) = "e"  (* en *)
+                       OR (teilwort SUB a pos minus 1) = "u") (* un *)
+                       AND (silbenanfang nach (a pos) 
+                       OR string (a pos plus 1, a pos plus 2) = "ob")
+              THEN SETZE a pos
+            ELIF string (a pos minus 2, a pos plus 1) = "eina"
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1 
+            FI
+CASE7(*r*): IF string (a pos minus 2, a pos minus 1) = "tu" (*..tur..*)
+              THEN IF    string (a pos plus 1, a pos plus 2) = "el" 
+                      OR (string (a pos plus 1, a pos plus 2) = "en"
+                          AND string (a pos minus 1, apos +3) <> "ent")
+                         (* turel OR <>turentwick*)
+                     THEN SETZE a pos minus 1
+                     ELSE SETZE a pos
+                   FI
+            ELIF    string (a pos minus 2, a pos minus 1) = "ve"  (*..ver..*)
+                 OR string (a pos minus 2, a pos minus 1) = "vo"  (*..vor..*)
+              THEN SETZE a pos 
+            ELIF string (a pos minus 2, a pos minus 1) = "te" (* ter *)
+              THEN IF dreisilber (a pos plus 1)
+                      OR string (a pos plus 1, a pos plus 1) = "a" (*tera*)
+                      OR string (a pos - 3, a pos minus 2) <> "zt" (*zter*)
+                     THEN SETZE a pos
+                     ELSE SETZE a pos minus 1
+                   FI
+            ELIF (teilwort SUB a pos minus 1) = "e" (* er*)
+                 AND silbenanfang nach (a pos) 
+                 AND string (a pos plus 1, a pos + 3) <> "ung" (*erung*)
+                 AND string (a pos plus 1, a pos plus 2) <> "er" (*erer*)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1 
+            FI
+CASE8(*s*): IF string (a pos minus 2, a pos minus 1) = "de" (* des *)
+               OR string (a pos minus 2, a pos minus 1) = "xi" (* ..xis *)
+              THEN SETZE a pos
+            ELIF string (a pos minus 2, a pos minus 1) = "ni" (* nis *)
+               AND silbenanfang nach (a pos)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE apos minus 1
+            FI
+CASE9(*t*): IF string (a pos plus 1, a pos + 3) = "ion" (* tion *)
+              THEN SETZE a pos minus 1
+            ELIF string (a pos plus 1, a pos + 3) <> "ier" (* imitieren *)
+               AND    (string (a pos minus 2, a pos minus 1) = "mi"(*...mit..*)
+                    OR string (a pos minus 2, a pos minus 1) = "va"(*privat..*)
+                    OR string (a pos minus 2, a pos minus 1) = "fi"(*profit..*)
+                    OR string (a pos - 3, a pos minus 1)     = "zei")(*..zeit..*)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE10(*ß*): IF string (a pos, a pos plus 2) = "ßen"
+               OR vorletzter buchstabe (a pos)
+               THEN SETZE a pos minus 1
+               ELSE SETZE a pos
+             FI
+OTHERWISE:  IF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1
+            FI
+END SELECT.
+ 
+konsonant 2 : 
+  kons gr := string (a pos, e pos);
+  IF a pos > 2 AND trennung oder sperre gesetzt (a pos minus 1)
+    THEN 
+  ELIF ausnahme fuer zwei konsonanten
+    THEN SETZE a pos
+  ELIF kons gr = "ts"
+    THEN IF NOT trennung oder sperre gesetzt (a pos)
+            (* für <> Tatsache, tatsächlich *)
+           THEN SETZE e pos 
+         FI
+  ELIF kons gr = "tz"
+    THEN IF (teilwort SUB a pos plus 2) = "e" (* ..tze.. *)
+            OR (teilwort SUB a pos plus 2) = "u" (* ..tzu.. *)
+           THEN SETZE a pos
+           ELSE SETZE a pos plus 1
+         FI
+  ELIF string (a pos, a pos plus 1) = "ch"(* ch zaehlt als 1 Buchstabe *)
+    THEN SETZE a pos plus 1               (* darum keine Abfrage mit kons gr *)
+  ELIF (kons gr = "dt" OR kons gr = "kt")
+       AND silbenanfang nach (e pos)
+    THEN SETZE e pos
+  ELIF kons gr = "ns" AND
+       (string (a pos - 2, a pos - 1) = "io"    (* ..ions *)
+        OR (string (a pos minus 1, a pos) ="en" (*..ens..*)
+            AND (teilwort SUB a pos minus 2) <> "t")) (* aber nicht ..tensiv*)
+    THEN SETZE e pos
+  ELIF string (a pos minus 2, a pos plus 1) = "nach" 
+    THEN IF (teilwort SUB a pos plus 2) <> "t"
+           THEN SETZE a pos plus 1 
+         FI 
+  ELIF string (e pos, e pos + 3) = "lich" 
+    THEN IF string (a pos minus 2, a pos) = "mög"
+           THEN SETZE a pos
+         ELIF pos ("hg", teilwort SUB e pos minus 1) > 0
+           THEN SPERRE e pos minus 1 
+           ELSE SETZE e pos minus 1
+         FI;
+  ELIF (reg (a pos) AND NOT trennung oder sperre gesetzt (a pos))
+       OR (kons gr = "sp" AND silbenanfang vor (a pos))
+    THEN SETZE a pos minus 1 
+  ELIF string (a pos, a pos plus 2) = "sch"
+    THEN SETZE a pos plus 2
+    ELSE SETZE a pos
+  FI.
+ 
+ausnahme fuer zwei konsonanten:
+  string (a pos minus 2, a pos) = "nis" AND a pos > 1
+          (*..nis.., aber nicht nisten *)
+  OR string (a pos minus 2, a pos plus 1) = "rafr" (* strafrecht *)
+  OR string (a pos - 4, a pos) = "undes" (* Bundes *)
+  OR string (a pos minus 1, a pos + 3) = "unter" 
+  OR silbenanfang vor (e pos).
+
+konsonant 3 : 
+  code 1 := code (teilwort SUB a pos);
+  code 2 := code (teilwort SUB a pos plus 1);
+  code 3 := code (teilwort SUB a pos plus 2);
+  IF NOT (ausnahme 1 OR ausnahme 2 OR ausnahme 3 OR ausnahme 4)
+     THEN suche regelmaessige konsonantenverbindung
+  FI.
+ 
+ausnahme 1 : 
+  ind := pos ("cfgklnprt", code (code 1));
+  SELECT ind OF 
+CASE1(*c*): IF code 2 = cv k (* ck *)
+              THEN SETZE a pos plus 1
+            ELIF string (a pos, a pos + 3) = "chts"
+            (* Rechts.., Gesichts.., .. machts..*)
+              THEN SETZE (a pos + 3)
+            ELIF string (a pos plus 1, a pos + 5) = "hstag" (* Reichstag *)
+                 OR (string (a pos, a pos plus 2) = "chs" AND (* ..chs.. *)
+                     string (a pos plus 2, a pos +3) <> "st") 
+              THEN SETZE a pos plus 2
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE
+CASE2(*f*): IF code 2 = cv f (*ff*)
+              THEN IF code 3 = cv s
+                     THEN SETZE a pos plus 2 (* ffs *)
+                     ELSE SETZE a pos plus 1
+                   FI
+            ELIF string (a pos minus 1, a pos plus 1) = "aft" (*..aft..*)
+              THEN IF (teilwort SUB a pos plus 2) = "s"
+                     THEN SETZE a pos plus 2
+                     ELSE SETZE a pos plus 1
+                   FI
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE
+CASE3(*g*): IF string (a pos minus 2, a pos minus 1) = "ag" (* ags *)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE4(*k*): IF string (a pos, a pos plus 1) = "kt"
+               AND silbenanfang nach (a pos plus 1)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE5(*l*): IF code 2 = cv d OR code 2 = cv g OR code 2 = cv k (*ld, lg, lk*)
+              THEN SETZE a pos plus 1
+            ELIF string (a pos, a pos + 4) = "ltspr" (* Anwaltsprogramm *)
+              THEN SETZE (a pos + 2)
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE6(*n*): IF string (a pos - 2, a pos) = "ein"
+              THEN SETZE a pos
+            ELIF code 2 = cv d (* nd *)
+              THEN IF code 3 = cv s (* nds, wie in ...stands... *)
+                     THEN SETZE a pos plus 2
+                     ELSE SETZE a pos plus 1
+                   FI
+            ELIF code 2 = cv g (* ng *)
+              THEN IF code 3 = cv s   (* ..ngs.. *)
+                      THEN SETZE a pos plus 2 
+                   ELIF code 3 = cv r (* ..ngr.. *)
+                      THEN SETZE a pos
+                   ELIF code 3 = cv l (* ungleich *)
+                      THEN
+                      ELSE SETZE a pos plus 1
+                   FI 
+            ELIF   string (a pos - 3, a pos plus 1) = "trans" 
+                OR string (a pos - 3, a pos plus 1) = "tions" (*tionsplan*)
+              THEN SETZE a pos plus 1 
+            ELIF string (a pos plus 1, a pos + 6) = "ftsper"  (*ftsperspek*)
+              THEN SETZE (a pos + 3)
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE 
+CASE7(*p*): IF code 2 = cv p                        (* pp *)
+               OR (code 2 = cv f AND code 3 = cv t) (* pft *)
+              THEN SETZE a pos plus 1; TRUE
+              ELSE FALSE 
+            FI 
+CASE8(*r*): IF string (a pos plus 1, a pos + 4) = "tner" (* rtner *)
+              THEN SETZE a pos plus 1
+            ELIF trennung oder sperre gesetzt (a pos)
+              THEN
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE9(*t*): IF string (a pos plus 1, a pos plus 2) = "st" (*tst*)
+              THEN SETZE a pos 
+            ELIF string (a pos plus 1, a pos plus 2) = "zt"
+                      (* letzt.. *) 
+              THEN IF (teilwort SUB a pos + 3) = "e" (*letzte..*)
+                     THEN SETZE a pos plus 1
+                     ELSE SETZE a pos plus 2
+                   FI
+            ELIF string (apos - 2, a pos plus 1) = "eits"
+                      (* ..heits.., ..keits.., ..beits.. *)
+                 OR string (a pos plus 1, a pos plus 1)= "z" (*tz*)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+OTHERWISE: FALSE
+END SELECT.
+ 
+ausnahme 2 : 
+  IF e pos - a pos = 2 
+     THEN FALSE 
+   ELIF code 2 = cv p AND string (a pos plus 2, a pos + 3) = "ft" (* pft *)
+     THEN SETZE a pos plus 2; TRUE 
+     ELSE FALSE 
+  FI . 
+ 
+ausnahme 3 : 
+  IF code 1 = cv s 
+     THEN IF code 2 = cv t AND code 3 <> cv r (* st, aber nicht: str *)
+             AND pos (vokal string, teilwort SUB a pos plus 2) = 0 
+             THEN SETZE a pos plus 1 ; TRUE 
+             ELSE FALSE 
+          FI 
+   ELIF code 2 = cv s 
+     THEN IF code 3 = cv t AND (teilwort SUB a pos + 3) <> "r" 
+             AND pos (vokal string, teilwort SUB (a pos + 3)) = 0
+             THEN SETZE a pos plus 2; TRUE 
+             ELSE FALSE
+          FI 
+     ELSE FALSE
+  FI . 
+ 
+ausnahme 4 :
+  IF string (e pos, e pos + 3) = "lich" 
+     THEN IF pos ("hg", teilwort SUB e pos minus 1) > 0
+            THEN SPERRE e pos minus 1
+            ELSE SETZE e pos minus 1 
+          FI;
+          TRUE
+     ELSE FALSE
+  FI .
+ 
+suche regelmaessige konsonantenverbindung : 
+  FOR posit FROM a pos UPTO e pos minus 1 REP 
+      IF reg (posit) 
+         THEN SETZE (posit - 1); LEAVE konsonant 3 
+      FI 
+  END REP ;
+  IF (teilwort SUB e pos) <> "h" OR (teilwort SUB e pos minus 1) <> "c" 
+     THEN SETZE e pos minus 1 
+   ELIF (teilwort SUB e pos - 2) <> "s" 
+     THEN SETZE (e pos - 2) 
+     ELSE SETZE (e pos - 3)
+  FI  
+END PROC erstelle trennvektor ; 
+END PACKET silbentrennung;
+
diff --git a/system/multiuser/1.7.5/src/supervisor b/system/multiuser/1.7.5/src/supervisor
new file mode 100644
index 0000000..00874b2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/supervisor
@@ -0,0 +1,774 @@
+(* ------------------- VERSION 19     03.06.86 ------------------- *)
+PACKET supervisor :                            (* Autor: J.Liedtke *)
+ 
+ 
+ 
+
+LET ack           = 0 ,
+    nak           = 1 ,
+    error nak     = 2 ,
+
+    system catalogue code        = 3 ,
+    begin code                   = 4 ,
+    end code                     = 5 ,
+    break code                   = 6 ,
+    rename code                  = 7 ,
+    halt code                    = 8 ,
+    password code                = 9 ,
+    family password code         = 40 ,
+    set autonom code             = 41 ,
+    reset autonom code           = 42 ,
+    define canal code            = 43 ,
+    go back to old canal code    = 44 ,
+    task of channel code         = 45 ,
+    canal of channel code        = 46 ,
+    set automatic startup code   = 47 ,
+    reset automatic startup code = 48 ,
+
+    continue code low            = 100 ,
+    continue code high           = 132 ,
+
+    system start code            = 100 ,
+    define station code          = 32000 ,
+    max station no               = 127 ,
+ 
+    nil = 0 ,
+
+    number of tasks       = 125 ,
+ 
+    number of channels       = 32 ,
+    highest terminal channel = 16 ,
+    highest user channel     = 24 ,
+    highest system channel   = 32 ,
+    configurator channel     = 32 ,
+
+    shutup and save code = 12 ,
+
+    channel field         = 4 ,
+    fromid field          = 11 ,
+    nilchannel            = 0 ;
+
+
+
+TASK VAR order task ;
+INT VAR  order code ,
+         channel nr ,
+         channel index ;
+
+DATASPACE VAR ds ;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR msg ;
+BOUND TEXT VAR error msg ;
+
+REAL VAR last rename time := 0.0 ;
+
+
+TEXT VAR actual password, supply password ;
+
+ 
+ROW highest terminal channel TASK VAR canal ;
+
+ROW number of channels TASK VAR connected task ;
+
+FOR channel index FROM 1 UPTO highest terminal channel REP
+  canal (channel index) := niltask ;
+PER ;
+FOR channel index FROM 1 UPTO number of channels REP
+  connected task (channel index) := niltask
+PER ;
+
+
+ROW number of tasks BOOL VAR autonom flag ;
+ROW number of tasks BOOL VAR automatic startup flag ;
+ROW number of tasks TEXT VAR task password ;
+
+task password (1) := "-"  ;
+task password (2) := "-"  ;
+
+set clock (date ("09.06.86")) ;
+
+TASK VAR dummy task ;
+command dialogue (TRUE) ; 
+
+ke ;     (* maintenance ke *) 
+
+create son (myself, "SYSUR", dummy task, proca (PROC sysur)) ;
+
+PROC sysur :
+
+  disable stop ;
+  begin ("ARCHIVE", PROC archive manager, dummy task) ;
+  begin ("OPERATOR", PROC monitor, dummy task) ;
+  begin ("conf", PROC configurator, dummy task) ;
+  system manager
+
+ENDPROC sysur ;
+
+PROC configurator :
+
+  page ;
+  REP UNTIL yes("Archiv 'dev' eingelegt") PER;
+  archive ("dev") ;
+  fetch all (archive) ;
+  release (archive) ;
+  REP UNTIL yes ("save system") PER ;
+  command dialogue (FALSE) ;
+  save system ;
+  command dialogue (TRUE) ;
+  rename myself ("configurator") ;
+  disable stop ;
+  REP
+    configuration manager ;
+    clear error
+  PER
+
+ENDPROC configurator ;
+
+
+erase last bootstrap source dataspace ;
+channel (myself, 1) ;
+command dialogue (TRUE) ;
+IF yes("Leere Floppy eingelegt")
+  THEN channel (myself, nilchannel) ;
+       command dialogue (FALSE) ;
+       sys op (shutup and save code)
+  ELSE channel (myself, nilchannel) ;
+       command dialogue (FALSE)
+FI ;
+supervisor ;
+ 
+ 
+PROC supervisor :
+ 
+  disable stop ;
+  INT VAR old session := session ;
+  REP
+    wait (ds, order code, order task) ;
+    IF is niltask (order task)
+      THEN interrupt
+    ELIF station (order task) = station (myself)
+      THEN order from task
+    FI 
+  PER .
+
+interrupt :
+  IF order code = 0
+    THEN IF old session <> session
+           THEN disconnect all terminal tasks ;
+                old session := session
+         FI ;
+         system start interrupt
+    ELSE supervisor interrupt (canal (order code), order code,
+                               connected task (order code)) 
+  FI .
+
+disconnect all terminal tasks :
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    TASK VAR id := connected task (i) ;
+    IF NOT (is niltask (id) COR automatic startup flag (index (id))
+            COR is niltask (canal (i))) 
+      THEN break task
+    FI
+  PER .
+
+break task :
+  IF task direct connected to channel
+    THEN channel (id, nilchannel) ;
+         connected task (i) := niltask 
+    ELSE disconnect if at terminal but overloaded by canal
+  FI .
+
+task direct connected to channel :
+ pcb (id, channel field) <> nilchannel .
+
+disconnect if at terminal but overloaded by canal :
+  connected task (i) := niltask .
+
+order from task :
+  channel index := channel (order task) ;
+  IF is command analyzer task
+    THEN order from command analyzer (connected task (channel index))
+    ELSE order from user task
+  FI ;
+  IF is error
+    THEN send back error message
+  FI .
+
+is command analyzer task :
+        channel index <> nilchannel
+  CAND  channel index <= highest terminal channel
+  CAND  order task = canal (channel index) .
+
+send back error message :
+  forget (ds) ;
+  ds := nilspace ;
+  error msg := ds ;
+  CONCR (error msg) := error message ;
+  clear error ;
+  send (order task, error nak, ds) .
+
+ENDPROC supervisor ;
+
+PROC supervisor interrupt (TASK VAR command analyzer, INT CONST channel nr,
+                           TASK VAR terminal task) :
+ 
+  IF NOT is niltask (terminal task)
+    THEN channel (terminal task, nilchannel)
+  FI ;
+  create command analyzer if necessary ;
+  IF already at terminal
+    THEN halt process (command analyzer)
+    ELSE send acknowledge
+  FI ;
+  channel (command analyzer, channel nr) ;
+  activate (command analyzer) .
+
+create command analyzer if necessary :
+  IF is niltask (command analyzer)
+    THEN create son (myself, "-", command analyzer, proca (PROC analyze supervisor command))
+  FI .
+
+send acknowledge : 
+  forget (ds) ;
+  ds := nilspace ;
+  send (command analyzer, ack, ds) .
+
+already at terminal :  channel (command analyzer) = channel nr .
+
+ENDPROC supervisor interrupt ;
+
+PROC order from command analyzer (TASK VAR terminal task) :
+
+enable stop ;
+IF is continue                          THEN sv cmd continue 
+ELIF order code = system catalogue code THEN task info cmd
+ELIF order code = task of channel code  THEN sv cmd task of channel
+ELSE SELECT order code OF  CASE ack :
+                           CASE end code   : sv cmd end
+                           CASE break code : sv cmd break
+                           CASE halt code  : sv cmd halt 
+                           OTHERWISE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") 
+     END SELECT ;
+     channel (command analyzer, nilchannel)
+FI ;
+
+forget (ds) ;
+IF NOT is niltask (terminal task) AND order code <> system catalogue code
+  THEN channel (order task, nilchannel) ;
+       channel (terminal task, channel index) ;
+       activate (terminal task)
+FI .
+
+sv cmd task of channel :
+  msg := ds ;
+  msg.task := terminal task ;
+  send (order task,ack, ds) ;
+  LEAVE order from command analyzer .
+
+sv cmd end :
+  IF NOT is niltask (terminal task)
+    THEN delete task (terminal task) ;
+         terminal task := niltask
+  FI .
+
+sv cmd break :
+  terminal task := niltask .
+
+sv cmd continue :
+  sv cmd break ;
+  continue cmd by canal .
+
+sv cmd halt :
+  IF is niltask (terminal task)
+    THEN errorstop ("keine Task angekoppelt")
+    ELSE halt process (terminal task)
+  FI .
+
+is continue :
+  order code > continue code low AND order code <= continue code high .
+
+command analyzer : canal (channel index) .
+
+ENDPROC order from command analyzer ;
+
+PROC order from user task :
+
+  enable stop ;
+  SELECT order code OF
+    CASE nak, error nak               : 
+    CASE system catalogue code        : task info cmd
+    CASE begin code                   : user begin cmd
+    CASE end code                     : user end cmd
+    CASE break code                   : user break cmd
+    CASE rename code                  : user rename cmd
+    CASE password code                : password cmd
+    CASE family password code         : family password cmd
+    CASE set autonom code             : set autonom cmd
+    CASE reset autonom code           : reset autonom cmd
+    CASE define canal code            : define new canal
+    CASE go back to old canal code    : go back to old canal
+    CASE task of channel code         : task of channel
+    CASE canal of channel code        : canal of channel
+    CASE set automatic startup code   : set automatic startup cmd
+    CASE reset automatic startup code : reset automatic startup cmd
+    OTHERWISE IF is continue
+                THEN            user continue cmd
+              ELIF is define station
+                THEN            define new station
+                  ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") 
+              FI
+  ENDSELECT .
+
+user begin cmd :
+  msg := ds ;
+  create son (order task, new task name, new task, new start proc) ;
+  send (order task, ack, ds) .
+
+user end cmd :
+  msg := ds ;
+  TASK VAR to be erased := CONCR (msg).task ;
+  IF task end permitted
+    THEN delete task (to be erased)
+    ELSE errorstop ("'end' unzulaessig")
+  FI ;
+  IF exists (order task)
+    THEN send (order task, ack, ds)
+    ELSE forget (ds)
+  FI .
+
+task end permitted :
+  ( (task is dead AND system catalogue contains entry) OR exists (to be erased))
+  CAND  (     to be erased = order task 
+          COR to be erased < order task
+          COR (order task < myself AND NOT (order task < to be erased)) ) .
+
+task is dead :
+  status (to be erased) > 6 .
+
+system catalogue contains entry :
+  task in catalogue (to be erased, index (to be erased)) .
+
+user rename cmd :
+  IF last rename was long ago
+    THEN msg := ds ;
+         name (order task, CONCR (msg).tname) ;
+         update entry in connected task array ;
+         send (order task, ack, ds) ;
+         remember rename time
+    ELSE send (order task, nak, ds)
+  FI .
+
+update entry in connected task array :
+  IF channel (order task) <> nilchannel
+    THEN connected task (channel (order task)) := order task
+  FI .
+
+remember rename time :
+  last rename time := clock (1) .
+
+last rename was long ago :  abs (clock (1) - last rename time) > 20.0 .
+
+user break cmd :
+  break order task ;
+  send (order task, ack, ds) .
+
+break order task :
+  IF task direct connected to channel
+    THEN channel (order task, nilchannel) ;
+         terminal task := niltask
+    ELSE disconnect if at terminal but overloaded by canal
+  FI .
+
+task direct connected to channel : channel index <> nilchannel .
+
+terminal task :  connected task (channel index) .
+
+disconnect if at terminal but overloaded by canal :
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF connected task (i) = order task
+      THEN connected task (i) := niltask ;
+           LEAVE disconnect if at terminal but overloaded by canal
+    FI
+  PER .
+
+user continue cmd :
+  INT CONST dest channel := order code - continue code low ;
+  IF dest channel <= highest user channel OR order task < myself
+    THEN IF NOT channel really existing
+           THEN errorstop ("kein Kanal")
+         ELIF dest channel is free OR task is already at dest channel
+           THEN break order task ;
+                continue (order task, dest channel) ;
+                autonom flag (index (order task)) := FALSE ;
+                send (order task, ack, ds) 
+           ELSE errorstop ("Kanal belegt")
+         FI
+     ELSE errorstop ("ungueltiger Kanal")
+   FI .
+
+channel really existing :
+  channel type (dest channel) <> 0 OR dest channel = configurator channel .
+
+dest channel is free : 
+  (is niltask (connected task (dest channel)) OR channel (connected task (dest channel)) = nilchannel)
+  AND no canal active .
+
+no canal active :
+  dest channel > highest terminal channel    COR
+  is niltask (canal (dest channel))          COR 
+  channel (canal (dest channel)) = nilchannel .
+
+task is already at dest channel :
+  channel index = dest channel .
+
+
+password cmd :
+  msg := ds ;
+  task password (index (order task)) := new task password ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) .
+
+family password cmd :
+  msg := ds ;
+  actual password := new task password ;
+  supply password := task password (index (order task)) ;
+  change pw of all sons where necessary (son (order task)) ;
+  task password (index (order task)) := actual password ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) .
+
+set autonom cmd :
+  autonom flag (index (order task)) := TRUE ;
+  send (order task, ack, ds) .
+
+reset autonom cmd :
+  autonom flag (index (order task)) := FALSE ;
+  send (order task, ack, ds) .
+ 
+define new canal :
+  IF order task < myself AND
+     channel index > 0 AND channel index <= highest terminal channel CAND
+     is niltask (canal (channel index))
+    THEN canal (channel index) := order task ;
+         connected task (channel index) := niltask ;
+         send (order task, ack, ds)
+    ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+go back to old canal :
+  IF order task < myself AND
+     channel index > 0 AND channel index <= highest terminal channel 
+    THEN IF NOT is niltask (canal (channel index))
+           THEN delete task (canal (channel index)) 
+         FI ;
+         send (order task, ack, ds)
+    ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+task of channel :
+  msg := ds ;
+  channel nr := int (msg.tname) ;
+  msg.task := channel task ;
+  send (order task, ack, ds).
+
+channel task :
+  IF channel nr <= highest terminal channel
+    THEN IF no command analyzer active
+           THEN connected task (channel nr)
+           ELSE canal (channel nr)
+         FI
+    ELSE connected task (channel nr)
+  FI .
+
+no command analyzer active :
+  channel (canal (channel nr)) = nilchannel .
+
+canal of channel :
+  msg := ds ;
+  channel nr := int (msg.tname) ;
+  msg.task := canal (channel nr) ;
+  send (order task, ack, ds).
+
+set automatic startup cmd :
+  automatic startup flag (index (order task)) := TRUE ;
+  send (order task, ack, ds) .
+
+reset automatic startup cmd :
+  automatic startup flag (index (order task)) := FALSE ;
+  send (order task, ack, ds) .
+ 
+is continue :
+  order code > continue code low AND order code <= continue code high .
+
+new task name :     CONCR (msg).tname . 
+
+new task      :     CONCR (msg).task .
+ 
+new task password : subtext (CONCR (msg).tpass, 1, 100) .
+
+new start proc :    CONCR (msg).start proc .
+ 
+is define station :
+  order code >= define station code AND order task < myself AND 
+  order code <= define station code + max station no .
+
+ENDPROC order from user task ;
+
+PROC continue cmd by canal :
+
+  access task name and password ;
+  check password if necessary ;
+  continue or send continue request ;
+  channel (order task, nilchannel) .
+
+access task name and password :
+  msg := ds ;
+  TASK CONST user task := task (CONCR (msg).tname) ;
+  INT CONST task index := index (user task) ;
+  actual password := task password (task index) ;
+  supply password := CONCR (msg).tpass .
+
+check password if necessary :
+  IF actual password <> ""
+    THEN IF supply password = ""
+           THEN ask for password ;
+                LEAVE continue cmd by canal
+         ELIF actual password <> supply password OR actual password = "-"
+           THEN errorstop ("Passwort falsch")
+         FI
+   FI .
+ask for password :
+  send (order task, password code, ds) .
+
+continue or send continue request :
+  IF autonom flag (task index)
+    THEN send continue request to user task
+    ELSE continue (user task, order code - continue code low)
+  FI .
+ 
+send continue request to user task :
+  INT VAR request count , quit ;
+  FOR request count FROM 1 UPTO 10 REP
+    send (user task, order code, ds, quit) ;
+    IF quit = ack
+      THEN LEAVE send continue request to user task
+    FI ;
+    pause (3)
+  PER ;
+  errorstop ("Task antwortet nicht") .
+
+ENDPROC continue cmd by canal ;
+
+PROC continue (TASK CONST id, INT CONST channel nr) :
+
+  IF NOT is niltask (id) CAND channel (id) <> channel nr
+    THEN check whether not linked to another channel ;
+         channel (id, channel nr) ;
+         connected task (channel nr) := id ;
+         prio (id, 0) ;
+         activate (id)
+  FI .
+
+check whether not linked to another channel :
+  INT VAR i ;
+  FOR i FROM 1 UPTO number of channels REP
+    IF connected task (i) = id
+      THEN errorstop ("bereits an Kanal " + text (i) ) ;
+           LEAVE continue
+    FI
+  PER .
+ 
+ENDPROC continue ;
+
+PROC task info cmd :
+
+  forget (ds) ;
+  ds := sys cat ;
+  send (order task, ack, ds) .
+
+ENDPROC task info cmd ;
+ 
+PROC delete task (TASK CONST superfluous) :
+
+  delete all sons of superfluous ;
+  delete superfluous itself .
+
+delete superfluous itself :
+  update cpu time of father ;
+  erase process (superfluous) ;
+  delete (superfluous) ;
+  erase terminal connection remark .
+
+update cpu time of father :
+  TASK CONST father task := father (superfluous) ;
+  IF NOT is niltask (father task)
+    THEN disable stop ;
+         REAL CONST father time := clock (father task) + clock (superfluous);
+         IF is error
+           THEN clear error
+           ELSE set clock (father task, father time)
+         FI ;
+         enable stop
+  FI .
+
+erase terminal connection remark :
+  INT VAR i ;
+  FOR i FROM 1 UPTO number of channels REP
+    IF connected task (i) = superfluous
+      THEN connected task (i) := niltask ;
+           LEAVE erase terminal connection remark
+    FI
+  PER ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF canal (i) = superfluous
+      THEN canal (i) := niltask ;
+           LEAVE erase terminal connection remark
+    FI
+  PER .
+
+delete all sons of superfluous :
+  TASK VAR son task ;
+  REP
+    son task := son (superfluous) ;
+    IF is niltask (son task)
+      THEN LEAVE delete all sons of superfluous
+    FI ;
+    delete task (son task)
+  PER .
+
+ENDPROC delete task ;
+
+PROC create son (TASK CONST father, TEXT CONST task name, TASK VAR new task, PROCA CONST start) :
+
+  entry (father, task name, new task) ;
+  autonom flag  (index (new task)) := FALSE ;
+  automatic startup flag (index (new task)) := TRUE ;
+  task password (index (new task)) := "" ;
+  create (father, new task, privilege, start) .
+
+privilege :
+  IF new task < myself
+    THEN 1
+    ELSE 0
+  FI .
+
+ENDPROC create son ;
+
+
+PROC system start interrupt :
+
+  IF exists task ("configurator")
+    THEN send system start message
+  FI .
+
+send system start message :
+  ds := nilspace ;
+  INT VAR request count, quit ;
+  FOR request count FROM 1 UPTO 10 REP
+    send (task ("configurator"), system start code, ds, quit) ;
+    IF quit = ack
+      THEN LEAVE send system start message
+    FI ;
+    pause (3)
+  PER ;
+  forget (ds) .
+
+ENDPROC system start interrupt ;
+
+PROC define new station :
+
+  INT CONST station := order code - define station code ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF NOT is niltask (canal (i))
+      THEN delete task (canal (i))
+    FI
+  PER ;
+  define station (station) ;
+  FOR i FROM 1 UPTO number of channels REP
+    update (connected task (i))
+  PER ;
+  forget (ds) .
+
+ENDPROC define new station ;
+
+PROC change pw of all sons where necessary (TASK CONST first son) :
+
+  TASK VAR actual task := first son ;
+  WHILE NOT is niltask (actual task) REP
+    change pw ;
+    change pw of all sons where necessary (son (actual task));
+    actual task := brother (actual task)
+  PER.
+
+  change pw :
+    IF task password (index (actual task)) = supply password 
+                        OR
+       task password (index (actual task)) = ""
+      THEN task password (index (actual task)) := actual password
+    FI.
+
+END PROC change pw of all sons where necessary ;
+
+(******************* basic supervisor operations **********************)
+
+
+PROC channel (TASK CONST id, INT CONST channel nr) :
+  pcb (id, channel field, channel nr)
+ENDPROC channel ;
+
+INT PROC channel type (INT CONST channel nr) :
+  disable stop ;
+  channel (myself, channel nr) ;
+  INT VAR type ;
+  control (1, 0, 0, type) ;
+  channel (myself, nilchannel) ;
+  type
+ENDPROC channel type ;
+
+PROC erase last bootstrap source dataspace :
+
+  disable stop ;
+  errorstop ("") ;
+  clear error
+
+ENDPROC erase last bootstrap source dataspace ;
+
+PROC set clock (TASK CONST id, REAL CONST clock value) :
+  EXTERNAL 82
+ENDPROC set clock ;
+
+PROC sys op (INT CONST code) :
+  EXTERNAL 90
+END PROC sys op ;
+
+PROC create (TASK CONST father, son, INT CONST priv, PROCA CONST start) :
+  EXTERNAL 95
+ENDPROC create ;
+ 
+PROC pcb (TASK CONST id, INT CONST field, value) :
+  EXTERNAL 105
+ENDPROC pcb ;
+
+PROC activate (TASK CONST id) :
+  EXTERNAL 108
+ENDPROC activate ;
+
+PROC deactivate (TASK CONST id) :
+  EXTERNAL 109
+ENDPROC deactivate ;
+
+PROC halt process (TASK CONST id) :
+  EXTERNAL 110
+ENDPROC halt process ;
+
+PROC erase process (TASK CONST id) :
+  EXTERNAL 112
+ENDPROC erase process ;
+
+ENDPACKET supervisor ;
+
diff --git a/system/multiuser/1.7.5/src/sysgen off b/system/multiuser/1.7.5/src/sysgen off
new file mode 100644
index 0000000..9cb999b
--- /dev/null
+++ b/system/multiuser/1.7.5/src/sysgen off
@@ -0,0 +1,9 @@
+ke ; (* maintenance ke *) 
+ 
+PROC sysgen off (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k) :
+  EXTERNAL 256
+ENDPROC sysgen off ;
+
+INT VAR x := 0 ;
+sysgen off (3,x,x,x,x,x,x,x,x,x,x,x) ;
+
diff --git a/system/multiuser/1.7.5/src/system info b/system/multiuser/1.7.5/src/system info
new file mode 100644
index 0000000..c29dfc2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/system info
@@ -0,0 +1,342 @@
+
+PACKET system info DEFINES                      (* Autor: J.Liedtke *)
+                                                (* Stand: 10.09.84  *)
+    task info ,
+    task status ,
+    storage info ,
+    help :
+
+
+LET supervisor mode = 0 ,
+    simple mode     = 1 ,
+    status mode     = 2 ,
+    storage mode    = 3 ,
+
+    ack             = 0 ,
+
+    channel field  = 4 ,
+    prio field     = 6 ,
+
+    cr lf     = ""13""10"" , 
+    cr        = ""13"" , 
+    page      = ""1""4"" ,
+    begin mark= ""15"" ,
+    end mark  = ""14"" ,
+    bell      = ""7"" ,
+    esc       = ""27"" ;
+
+
+
+TEXT VAR task name , record ;
+DATASPACE VAR ds := nilspace ;
+
+
+PROC task info :
+
+  task info (simple mode)
+
+ENDPROC task info ;
+
+PROC task info (INT CONST mode) :
+
+  open list file ;
+  task info (mode, list file) ;
+  show task info .
+
+open list file :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) .
+
+show task info :
+  IF mode <> supervisor mode
+    THEN show (list file)
+    ELSE open editor (list file, FALSE) ;
+         edit (groesster editor, "q", PROC (TEXT CONST) no orders)
+  FI .
+
+ENDPROC task info ;
+
+PROC task info (INT CONST mode, FILE VAR list file) :
+
+  access catalogue ;
+  IF mode > simple mode
+    THEN generate head
+  FI ;
+  list tree (list file, supervisor,0, mode) .
+
+generate head :
+  put (list file, date) ;
+  put (list file, " ") ;
+  put (list file, time of day) ;
+  put (list file, "                          ") ;
+  IF mode = storage mode
+    THEN put (list file, "K     ")
+  FI ;
+  put (list file, " CPU    PRIO CHAN STATUS") ;
+  line (list file) .
+
+ENDPROC task info ;
+ 
+PROC task info (INT CONST level, fremdstation): 
+  IF fremdstation = station (myself) 
+  THEN task info (level) 
+  ELSE 
+    disable stop;
+    DATASPACE VAR x:= nilspace; 
+    BOUND INT VAR l := x; l := level; 
+    call (collector, 256+fremdstation, x, rtn); 
+    INT VAR rtn; 
+    IF rtn = ack 
+      THEN FILE VAR ti:= sequential file (modify, x) ;
+           show (ti) 
+      ELSE forget (x) ;
+           errorstop ("Station " + text (fremdstation) + " antwortet nicht")
+    FI ;
+    forget (x) 
+  FI 
+END PROC task info; 
+
+PROC no orders (TEXT CONST ed kommando taste) :
+
+  IF ed kommando taste = "q"
+    THEN quit
+    ELSE out (""7"")
+  FI
+
+ENDPROC no orders ;
+
+PROC list tree (FILE VAR list file,
+                TASK CONST first son, INT CONST depth, mode) :
+
+  enable stop ;
+  TASK VAR actual task := first son ;
+  WHILE NOT is niltask (actual task) REP
+    list actual task ;
+    list tree (list file, son (actual task), depth+1, mode) ;
+    actual task := brother (actual task)
+  PER .
+
+list actual task :
+  record := "" ;
+  generate layout and task name ;
+  IF mode > simple mode
+    THEN tab to info position ;
+         show storage if wanted ;
+         record CAT cpu time of (actual task) ;
+         record CAT prio of actual task ;
+         record CAT channel of actual task ;
+         record CAT "   " ;
+         record CAT status of (actual task)
+   FI ;
+   putline (list file, record) .
+
+generate layout and task name :
+  INT VAR i ;
+  FOR i FROM 1 UPTO depth REP
+    record CAT "    "
+  PER ;
+  task name := name (actual task) ;
+  record CAT task name .
+
+tab to info position :
+  record := subtext (record, 1, 40) ;
+  FOR i FROM LENGTH record + 1 UPTO 40 REP
+    record CAT "."
+  PER ;
+  record CAT " " .
+
+show storage if wanted :
+  IF mode = storage mode
+    THEN record CAT text (storage (actual task), 5) ;
+         record CAT "  "
+  FI .
+
+prio of actual task :
+  text (pcb (actual task, prio field),4) .
+
+channel of actual task :
+  INT CONST channel := pcb (actual task, channel field) ;
+  IF channel = 0
+    THEN "   -"
+    ELSE text (channel,4)
+  FI .
+
+ENDPROC list tree ;
+
+TEXT PROC cpu time of (TASK CONST actual task) :
+
+  disable stop ;
+  TEXT VAR result := subtext (time (clock (actual task), 12), 1, 10) ;
+  IF is error
+    THEN clear error ;
+         result := 10 * "*"
+  FI ;
+  result
+
+ENDPROC cpu time of ;
+
+TEXT PROC status of (TASK CONST actual task) :
+
+  SELECT status (actual task) OF
+    CASE 0 :  "-busy-"
+    CASE 1 :  "i/o"
+    CASE 2 :  "wait"
+    CASE 4 :  "busy-blocked"
+    CASE 5 :  "i/o -blocked"
+    CASE 6 :  "wait-blocked"
+    OTHERWISE "--dead--"
+  END SELECT .
+
+ENDPROC status of ;
+
+PROC task status :
+
+  task status (myself)
+
+ENDPROC task status ;
+
+PROC task status (TEXT CONST task name) :
+
+  task status (task (task name))
+
+ENDPROC task status ;
+
+PROC task status (TASK CONST actual task) :
+
+  IF exists (actual task)
+    THEN put status of task
+    ELSE errorstop ("Task nicht vorhanden")
+  FI .
+
+put status of task :
+  line ;
+  put (date); put (time of day) ;
+  put ("  TASK:") ;
+  put (name (actual task)) ;
+  line (2) ;
+  put ("Speicher:"); put (storage (actual task)); putline ("K");
+  put ("CPU-Zeit:"); put (cpu time of (actual task)) ; line;
+  put ("Zustand :"); write (status of (actual task)); 
+                     put (", (prio");
+                     write (text (pcb (actual task, prio field)));
+                     put ("), Kanal") ;
+                     IF channel (actual task) = 0
+                       THEN put ("-")
+                       ELSE put (channel (actual task))
+                     FI ;
+                     line .
+
+ENDPROC task status ;
+
+PROC storage info :
+ 
+  INT VAR size, used ;
+  storage (size, used) ;
+  out (""13""10"      ") ;
+  put (used) ;
+  put ("K von") ;
+  put (size plus reserve) ;
+  putline ("K sind belegt!") .
+ 
+size plus reserve :
+  int (real (size + 24) * 64.0 / 63.0 ) .
+
+ENDPROC storage info ;
+ 
+ 
+PROC help :
+
+  IF NOT exists ("help")
+    THEN get help file
+  FI ;
+  FILE VAR f := sequential file (modify, "help") ;
+  help (f) .
+
+get help file :
+  TEXT VAR old std param := std ;
+  IF exists ("help", father)
+    THEN fetch ("help")
+    ELSE fetch ("help", public)
+  FI ;
+  last param (old std param) .
+
+ENDPROC help ;
+
+PROC help (FILE VAR help file) :
+ 
+  initialize help command ;
+  REP 
+    out (page) ;
+    to paragraph ; 
+    show paragraph ; 
+    get show command 
+  UNTIL is quit command PER .
+ 
+initialize help command :
+   TEXT VAR
+   help command := getcharety ;
+   IF help command = ""
+     THEN help command := "0"
+   FI .
+
+to paragraph : 
+  col (help file, 1) ;
+  to line (help file, 1) ; 
+  downety (help file, "#" + help command + "#") ; 
+  IF eof (help file) 
+    THEN to line (help file, 1) ;
+         out (bell)
+  FI . 
+ 
+show paragraph : 
+  show headline ;
+  WHILE NOT end of help subfile REP 
+    show help line
+  PER ; 
+  show bottom line .
+
+show headline :
+  out (begin mark) ;
+  INT CONST dots := (x size - len (help file) - 5) DIV 2 ;
+  dots TIMESOUT "." ;
+  exec (PROC show line, help file, 4) ;
+  dots TIMESOUT "." ;
+  out (end mark) ;
+  down (help file) .
+
+show help line :
+  out (cr lf) ;
+  exec (PROC show line, help file, 1) ;
+  down (help file) .
+
+show bottom line :
+  cursor (5, y size) ; 
+  exec (PROC show line, help file, 3) ; 
+  out (cr) . 
+ 
+get show command : 
+  TEXT VAR char ;
+  get char (char) ;
+  IF char = esc
+    THEN get char (char)
+  FI ;
+  IF char >= " "
+    THEN help command := char
+    ELSE out (bell)
+  FI .
+
+end of help subfile : pos (help file,"##",1) <> 0 OR eof (help file) .
+
+is quit command     : help command = "q" OR help command = "Q" .
+
+ENDPROC help ;
+ 
+PROC show line (TEXT CONST line, INT CONST from) : 
+ 
+  outsubtext (line, from, x size - from) 
+ 
+ENDPROC show line ;
+ 
+ENDPACKET system info ;
+
diff --git a/system/multiuser/1.7.5/src/system manager b/system/multiuser/1.7.5/src/system manager
new file mode 100644
index 0000000..5406ff0
--- /dev/null
+++ b/system/multiuser/1.7.5/src/system manager
@@ -0,0 +1,117 @@
+(* ------------------- VERSION 4 vom 31.01.86 ------------------- *)
+PACKET system manager DEFINES                       (* F. Klapper *)
+  system manager , 
+  generate shutup manager ,
+  put log :
+ 
+LET ack            = 0  ,
+    error nak      = 2  ,
+    fetch code     = 11 ,
+    list code      = 15 ,
+    all code       = 17 ,
+    log code       = 21 ,
+    eszet          = ""251"" ,
+    log file name  = "logbuch";
+
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+BOUND TEXT VAR log message, 
+               error msg;
+
+INT VAR reply;
+
+TEXT VAR xname;
+ 
+FILE VAR log file;
+
+PROC system manager:
+  lernsequenz auf taste legen ("s", eszet) ;
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) sys manager) 
+ 
+END PROC system manager; 
+ 
+PROC sys manager (DATASPACE VAR ds, INT CONST order, phase,
+                  TASK CONST order task):
+  enable stop;
+  SELECT order OF
+  CASE log code      : y put log
+  CASE list code     : y list
+  CASE all code      : y all
+  CASE fetch code    : y fetch
+  OTHERWISE std manager (ds, order, phase, order task)
+  END SELECT.
+ 
+y fetch :
+  msg := ds;
+  xname := msg.name;
+  IF read permission (xname, msg.read pass)
+  THEN forget (ds) ;
+       ds := old (xname) ;
+       send (order task, ack, ds)
+  ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y list :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  list (list file) ;
+  send (order task, ack, ds) .
+ 
+y all :
+  forget (ds);
+  ds := nilspace;
+  BOUND THESAURUS VAR all names := ds ;
+  all names := all ;
+  send (order task, ack, ds) .
+ 
+y put log :
+  log file := sequential file (output, log file name) ;
+  IF lines (log file) < 4000
+    THEN max line length (log file,1000);
+         put (log file, date) ;
+         put (log file, time of day) ;
+         put (log file, text (name (order task), 8));
+         log message := ds ;
+         put (log file, CONCR (log message)) ;
+  FI ;
+  send (order task, ack, ds) .
+
+END PROC sys manager;
+ 
+PROC put log (TEXT CONST message) :
+  enable stop;
+  forget (ds) ;
+  ds := nilspace ;
+  log message := ds ;
+  CONCR (log message) := message ;
+  call (task("SYSUR"), log code, ds, reply) .
+
+ENDPROC put log ;
+
+PROC generate shutup manager :
+
+  TASK VAR son ;
+  begin ("shutup", PROC shutup manager, son)
+
+ENDPROC generate shutup manager ;
+
+PROC shutup manager :
+  disable stop ;
+  task password ("") ;
+  command dialogue (TRUE) ;
+  REP
+    break ;
+    line ;
+    IF yes ("shutup")
+       THEN clear error ;
+            shutup
+    FI
+  PER
+
+ENDPROC shutup manager ;
+
+ENDPACKET system manager ;
+
diff --git a/system/multiuser/1.7.5/src/tasks b/system/multiuser/1.7.5/src/tasks
new file mode 100644
index 0000000..276011e
--- /dev/null
+++ b/system/multiuser/1.7.5/src/tasks
@@ -0,0 +1,978 @@
+(* ------------------- VERSION 9 vom 09.06.86 ------------------- *)
+PACKET tasks DEFINES                          (* Autor: J.Liedtke *)
+ 
+    TASK ,
+    PROCA ,
+    := ,
+    = ,
+    < ,
+    / ,
+    niltask ,
+    is niltask ,
+    exists ,
+    exists task ,
+    supervisor ,
+    myself ,
+    public ,
+    proca ,
+    collector ,
+    access ,
+    name ,
+    task ,
+    canal ,
+    dataspaces ,
+    index ,
+    station ,
+    update ,
+    father ,
+    son ,
+    brother ,
+    next active ,
+    access catalogue ,
+    family password ,
+    task in catalogue ,
+    entry ,
+    delete ,
+    define station ,
+
+    pcb ,
+    status ,
+    channel ,
+    clock ,
+    storage ,
+    callee ,
+
+    send ,
+    wait ,
+    call ,
+    pingpong ,
+    collected destination ,
+ 
+    begin ,
+    end ,
+    break ,
+    continue ,
+    rename myself ,
+    task password ,
+    set autonom ,
+    reset autonom ,
+    set automatic startup ,
+    reset automatic startup ,
+
+    sys cat :
+
+ 
+
+LET nil = 0 ,
+
+    max version = 30000 ,
+    max task = 125 ,
+    max station no = 127 ,
+    sv no = 1 ,
+
+    hex ff   = 255 ,
+    hex 7f00 = 32512 ,
+
+    collected dest field 1 = 2 ,
+    collected dest field 2 = 3 ,
+    channel field = 4 ,
+    myself no field = 9 ,
+    myself version field = 10 ,
+    callee no field = 11 ,
+    callee version field = 12 ,
+
+    highest terminal channel = 16 ,
+    number of channels       = 32 ,
+
+    wait state = 2 ,
+
+    ack                            = 0 ,
+    nak                            = 1 ,
+    error nak                      = 2 ,
+    system catalogue code          = 3 ,
+    begin code                     = 4 ,
+    end code                       = 5 ,
+    break code                     = 6 ,
+    rename code                    = 7 ,
+    password code                  = 9 ,
+    family password code           = 40 ,
+    set autonom code               = 41 ,
+    reset autonom code             = 42 ,
+    task of channel code           = 45 ,
+    canal of channel code          = 46 ,
+    set automatic startup code     = 47 ,
+    reset automatic startup code   = 48 ,
+
+    continue code                  = 100,
+    define station code            = 32000,
+
+    lowest ds number               = 4 ,
+    highest ds number              = 255 ;
+
+
+TYPE TASK  = STRUCT (INT no, version) ,
+     PROCA = STRUCT (INT a, b) ;
+ 
+OP := (PROCA VAR right, PROCA CONST left) :
+  CONCR (right) := CONCR (left)
+ENDOP :=  ;
+
+PROCA PROC proca (PROC p) : 
+
+  push (0, PROC p) ;
+  pop
+
+ENDPROC proca ;
+
+PROC push (INT CONST dummy, PROC p) : ENDPROC push ;
+
+PROCA PROC pop :
+  PROCA VAR res;
+  res
+ENDPROC pop ;
+
+TASK CONST niltask := TASK: (0,0) ,
+           collector  := TASK: (-1,0) ;
+
+TASK PROC supervisor :
+ 
+  TASK: (my station id + sv no, 0) .
+
+my station id :  pcb (myself no field) AND hex 7f00 .
+
+ENDPROC supervisor ;
+
+TASK VAR   father task ;
+
+INITFLAG VAR catalogue known := FALSE , father known := FALSE ;
+
+
+
+LET TASKVECTOR = STRUCT (INT version, father, son, brother) ;
+
+
+DATASPACE VAR catalogue space , sv space ;
+
+BOUND STRUCT (THESAURUS dir,
+              ROW max task TASKVECTOR link) VAR system catalogue ;
+ initialize catalogue ; 
+ 
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ;
+
+
+PROC initialize catalogue :
+
+  catalogue space := nilspace ;
+  system catalogue := catalogue space ;
+  system catalogue.dir := empty thesaurus ;
+
+  insert (system catalogue.dir, "SUPERVISOR") ;
+  insert (system catalogue.dir, "UR") ;
+  system catalogue.link (1) := TASKVECTOR:(0,0,0,2) ;
+  system catalogue.link (2) := TASKVECTOR:(0,0,0,0) .
+
+ENDPROC initialize catalogue ;
+
+DATASPACE PROC sys cat :
+  catalogue space
+ENDPROC sys cat ;
+
+
+TASK PROC myself :
+
+  TASK: (pcb (myself no field), pcb (myself version field))
+
+ENDPROC myself ;
+
+
+OP := (TASK VAR dest, TASK CONST source):
+
+  CONCR (dest) := CONCR (source)
+
+ENDOP := ;
+
+BOOL OP = (TASK CONST left, right) :
+
+  left.no = right.no  AND  left.version = right.version
+
+ENDOP = ;
+
+BOOL PROC is niltask (TASK CONST t) :
+
+  t.no = 0
+
+ENDPROC is niltask ;
+
+BOOL OP < (TASK CONST left, right) :
+
+  IF both of my station
+    THEN access (left) ;
+         access (right) ;
+            ( index (left) > 0  CAND  index (left) <= max task )
+         CAND
+            ( father (left) = right  COR  father (left) < right )
+    ELSE FALSE
+  FI .
+
+both of my station :
+  station (left) = station (right) AND station (right) = station (myself) .
+
+ENDOP < ;
+
+BOOL PROC exists (TASK CONST task) :
+
+  EXTERNAL 123
+
+ENDPROC exists ;
+ 
+BOOL PROC exists task (TEXT CONST name) :
+
+  task id (name).no <> 0
+
+ENDPROC exists task ;
+
+TEXT PROC name (TASK CONST task) :
+
+  IF is task of other station
+  THEN external name (task)
+  ELSE
+    access (task) ;
+    INT CONST task no := index (task) ;
+    IF task in catalogue (task ,task no)
+      THEN name (system catalogue.dir, task no) 
+      ELSE ""
+    FI 
+  FI.
+
+is task of other station :
+  (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
+ 
+ENDPROC name ;
+
+BOOL PROC task in catalogue (TASK CONST task, INT CONST task no) :
+
+  access catalogue ;
+  task no >= 1 CAND task no <= max task CAND
+  task.version = system catalogue.link (task no).version .
+
+ENDPROC task in catalogue ;
+
+PROC access (TASK CONST task) :
+
+  INT CONST task no := task.no AND hex ff ;
+  IF task no < 1 OR task no > max task
+    THEN
+  ELIF is task of other station
+    THEN errorstop ("TASK anderer Station")
+  ELIF actual task id not in catalogue COR NOT exists (task)
+    THEN access catalogue
+  FI .
+
+actual task id not in catalogue :
+  NOT initialized (catalogue known)  COR
+  ( task no > 0 CAND catalogue version <> task.version ) .
+ 
+catalogue version :  system catalogue.link (task no).version .
+
+is task of other station :
+  (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
+
+ENDPROC access ;
+
+TASK PROC task (TEXT CONST task name) :
+
+  TASK CONST id := task id (task name) ;
+  IF id.no = 0
+    THEN errorstop (""""+task name+""" gibt es nicht")
+  FI ;
+  id
+
+ENDPROC task ;
+
+TASK PROC task id (TEXT CONST task name) :
+
+  IF task name = "-" OR task name = ""
+    THEN errorstop ("Taskname unzulaessig")
+  FI ;
+  IF NOT initialized (catalogue known)
+    THEN access catalogue
+  FI ;
+
+  TASK VAR
+  id := task id (link (system catalogue.dir, task name)) ;
+  IF NOT exists (id)
+    THEN access catalogue ;
+         id  := task id (link (system catalogue.dir, task name)) ;
+  FI ;
+  id .
+
+ENDPROC task id ;
+
+TASK OP / (TEXT CONST task name) :
+
+  task (task name)
+
+ENDOP / ;
+
+INT PROC index (TASK CONST task) :
+
+  IF NOT initialized (catalogue known)
+    THEN access catalogue
+  FI ;
+  task.no AND hex ff
+
+ENDPROC index ;
+
+INT PROC station (TASK CONST task) :
+
+  task.no DIV 256
+
+ENDPROC station ;
+
+PROC update (TASK VAR task) :
+
+  IF task.no <> nil
+    THEN task.no := (task.no AND hex ff) + new station number
+  FI .
+
+new station number :  (pcb (myself no field) AND hex 7f00) .
+
+ENDPROC update ;
+
+
+TASK PROC public :
+
+  task ("PUBLIC")
+
+ENDPROC public ;
+
+TASK PROC father :
+
+  IF NOT initialized (father known) COR station or rename changed father id
+    THEN access catalogue ;
+         father task := father (myself)
+  FI ;
+  father task .
+
+station or rename changed father id :
+  NOT exists (father task) .
+
+ENDPROC father ;
+
+INT VAR task no ;
+
+TASK PROC father (TASK CONST task) :
+
+  task no := index (task) ;
+  task id (system catalogue.link (task no).father) .
+
+ENDPROC father ;
+
+TASK PROC son (TASK CONST task) :
+
+  task no := index (task) ;
+  IF task no = nil
+    THEN supervisor
+    ELSE task id (system catalogue.link (task no).son)
+  FI .
+
+ENDPROC son ;
+
+TASK PROC brother (TASK CONST task) :
+
+  task no := index (task) ;
+  task id (system catalogue.link (task no).brother) .
+
+ENDPROC brother ;
+
+PROC next active (TASK VAR task) :
+
+  next active task index (task.no) ;
+  IF task.no > 0
+    THEN task.version := pcb (task, myself version field)
+    ELSE task.version := 0
+  FI 
+
+ENDPROC next active ;
+
+PROC next active task index (INT CONST no) :
+
+  EXTERNAL 118
+
+ENDPROC next active task index ;
+
+TASK PROC task id (INT CONST task nr) :
+
+  INT VAR task index := task nr AND hex ff ;
+  TASK VAR result ;
+  result.no := task index ;
+  IF task index = nil
+    THEN result.version := 0
+    ELSE result.version := system catalogue.link (task index).version ;
+         result.no INCR my station id
+  FI ;
+  result .
+
+my station id : pcb (myself no field) AND hex 7f00 .
+
+ENDPROC task id ;
+
+PROC access catalogue :
+
+  IF this is not supervisor
+    THEN get catalogue from supervisor
+  FI .
+
+this is not supervisor :
+  (pcb (myself no field) AND hex ff) <> sv no .
+
+get catalogue from supervisor :
+  INT VAR dummy reply ;
+  forget (catalogue space) ;
+  catalogue space := nilspace ;
+  call (supervisor, system catalogue code, catalogue space, dummy reply) ;
+  system catalogue := catalogue space .
+
+ENDPROC access catalogue ;
+
+
+PROC entry (TASK CONST father task, TEXT CONST task name,
+            TASK VAR son task) :
+
+  IF task name <> "-" CAND (system catalogue.dir CONTAINS task name)
+    THEN errorstop (""""+task name+""" existiert bereits")
+  ELIF is niltask (father task)
+    THEN errorstop ("Vatertask existiert nicht")
+  ELSE   entry task 
+  FI .
+
+entry task :
+  INT VAR son task nr ;
+  INT CONST father task nr := index (father task) ;
+  insert (system catalogue.dir, task name, son task nr) ;
+  IF son task nr = nil OR son task nr > max task
+    THEN delete (system catalogue.dir, son task nr) ;
+         son task := niltask ;
+         errorstop ("zu viele Tasks")
+    ELSE insert task (father task, father vec, son task, son vec, son tasknr)
+  FI .
+
+father vec : system catalogue.link (father task nr) .
+
+son vec    : system catalogue.link (son task nr) .
+
+ENDPROC entry ;
+
+PROC insert task (TASK CONST father task, TASKVECTOR VAR father vec,
+                  TASK VAR son task, TASKVECTOR VAR son vec, INT CONST nr) :
+
+  initialize version number if son vec is first time used ; 
+  increment version (son vec) ;
+  son task.no := my station id + nr ;
+  son task.version := son vec.version ;
+  link into task tree .
+
+initialize version number if son vec is first time used :
+  IF son vec.version < 0
+    THEN son vec.version := 0
+  FI .
+
+link into task tree :
+  son vec.son := nil ;
+  son vec.brother := father vec.son ;
+  son vec.father := index (father task) ;
+  father vec.son := son task.no .
+
+my station id :  pcb (myself no field) AND hex 7f00 .
+
+END PROC insert task ;
+
+
+PROC delete (TASK CONST superfluous) :
+
+  INT CONST superfluous nr := index (superfluous) ;
+  delete (system catalogue.dir, superfluous nr) ;
+  delete superfluous task ;
+  increment version (superfluous vec) .
+ 
+delete superfluous task :
+  INT CONST successor of superfluous := superfluous vec.brother ;
+  TASK VAR
+  last := father (superfluous) ,
+  actual := son (last) ;
+  IF actual = superfluous
+    THEN delete first son of last
+    ELSE search previous brother of superfluous ;
+         delete from brother chain
+  FI .
+
+delete first son of last :
+  last vec.son := successor of superfluous .
+
+search previous brother of superfluous :
+  REP
+    last := actual ;
+    actual := brother (actual)
+  UNTIL actual = superfluous PER .
+
+delete from brother chain :
+  last vec.brother := successor of superfluous .
+
+last vec        :   system catalogue.link (index (last)) .
+
+superfluous vec :   system catalogue.link (superfluous nr) .
+
+ENDPROC delete ;
+
+
+PROC name (TASK VAR task, TEXT CONST new name) :
+
+  INT CONST task no := index (task) ;
+  IF (system catalogue.dir CONTAINS new name) AND (new name <> "-")
+                  AND (name (task) <> new name)
+    THEN errorstop (""""+new name+""" existiert bereits")
+    ELSE rename (system catalogue.dir, task no, new name) ;
+         increment version (system catalogue.link (task no)) ;
+         IF this is supervisor
+           THEN update task version in pcb and task variable
+         FI
+  FI .
+
+this is supervisor :  (pcb (myself no field) AND hex ff) = sv no .
+
+update task version in pcb and task variable :
+  INT CONST new version := system catalogue.link (task no).version ;
+  write pcb (task, myself version field, new version) ;
+  task.version := new version .
+
+ENDPROC name ;
+
+
+PROC increment version (TASKVECTOR VAR task vec) :
+
+  task vec.version := task vec.version MOD max version + 1
+
+ENDPROC increment version ;
+
+
+INT PROC pcb (TASK CONST id, INT CONST field) :
+ 
+  EXTERNAL 104
+
+ENDPROC pcb ;
+
+INT PROC status (TASK CONST id) :
+
+  EXTERNAL 107
+
+ENDPROC status ;
+
+INT PROC channel (TASK CONST id) :
+
+  pcb (id, channel field)
+
+ENDPROC channel ;
+
+REAL PROC clock (TASK CONST id) :
+
+  EXTERNAL 106
+
+ENDPROC clock ;
+
+INT PROC storage (TASK CONST id) :
+
+  INT VAR ds number, storage sum := 0, ds size;
+  FOR ds number FROM lowest ds number UPTO highest ds number REP
+    ds size := pages (ds number, id) ;
+    IF ds size > 0
+      THEN storage sum INCR ((ds size + 1) DIV 2)
+    FI
+  PER ;
+  storage sum
+
+ENDPROC storage ;
+
+INT PROC pages (INT CONST ds number, TASK CONST id) :
+
+  EXTERNAL 88
+
+ENDPROC pages ;
+
+TASK PROC callee (TASK CONST from) :
+
+  IF status (from) = wait state
+    THEN TASK:(pcb (from, callee no field), pcb (from, callee version field))
+    ELSE niltask
+  FI
+
+ENDPROC callee ;
+
+
+PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds,
+           INT VAR quit) :
+  EXTERNAL  113
+ 
+ENDPROC send ;
+
+PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds) :
+
+  INT VAR dummy quit ;
+  send (dest, send code, ds, dummy quit) ;
+  forget (ds)
+
+ENDPROC send ;
+
+PROC wait (DATASPACE VAR ds, INT VAR receive code, TASK VAR source) :
+
+  EXTERNAL 114
+ 
+ENDPROC wait ;
+
+PROC call (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
+           INT VAR reply code) :
+  EXTERNAL 115
+ 
+ENDPROC call ;
+
+PROC pingpong (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
+                  INT VAR reply code) :
+  EXTERNAL 122
+ 
+ENDPROC pingpong ;
+
+TASK PROC collected destination :
+
+  TASK: (pcb (collected dest field 1), pcb (collected dest field 2))
+
+ENDPROC collected destination ;
+
+
+PROC begin (PROC start, TASK VAR new task) :
+
+  begin ("-", PROC start, new task)
+
+ENDPROC begin ;
+
+PROC begin (TEXT CONST son name, PROC start, TASK VAR new task) :
+
+  enable stop ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tname := son name ;
+  CONCR (sv msg).start proc := proca (PROC start) ;
+  supervisor call (begin code) ;
+  sv msg := sv space ;
+  new task := CONCR (sv msg).task .
+ 
+ENDPROC begin ;
+
+PROC begin (DATASPACE VAR ds, PROC start, INT VAR reply) :
+
+  sv msg := ds ;
+  sv msg.start proc := proca (PROC start)  ;
+  call (supervisor, begin code, ds, reply)
+
+ENDPROC begin ;
+
+PROC end :
+
+  command dialogue (TRUE) ;
+  say ("task """) ;
+  say (name (myself)) ;
+  IF yes (""" loeschen")
+    THEN eumel must advertise ;
+         end (myself)
+  FI
+
+ENDPROC end ;
+
+PROC end (TASK CONST id) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).task := id ;
+  supervisor call (end code)
+
+ENDPROC end ;
+
+PROC break (QUIET CONST quiet) :
+
+  simple supervisor call (break code)
+
+ENDPROC break ;
+
+PROC break :
+
+  eumel must advertise ;
+  simple supervisor call (break code)
+
+ENDPROC break ;
+
+PROC continue (INT CONST channel nr) :
+ 
+  simple supervisor call (continue code + channel nr)
+
+ENDPROC continue ;
+
+PROC rename myself (TEXT CONST new name) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tname := new name ;
+  supervisor call (rename code) .
+
+ENDPROC rename myself ;
+
+
+PROC simple supervisor call (INT CONST code) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  supervisor call (code)
+
+ENDPROC simple supervisor call ;
+ 
+PROC supervisor call (INT CONST code) :
+
+  INT VAR answer ;
+  call (supervisor, code, sv space, answer) ;
+  WHILE answer = nak REP
+    pause (20) ;
+    call (supervisor, code, sv space, answer)
+  PER ;
+  IF answer = error nak
+    THEN BOUND TEXT VAR error message := sv space ;
+         errorstop (CONCR (error message))
+  FI 
+
+ENDPROC supervisor call ;
+
+PROC task password (TEXT CONST password) :
+
+  IF online 
+    THEN say (""3""5""10"")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tpass := password ;
+  supervisor call (password code) ;
+  cover tracks .
+
+ENDPROC task password ;
+
+PROC set autonom :
+ 
+  simple supervisor call (set autonom code)
+
+ENDPROC set autonom ;
+
+PROC reset autonom :
+
+  simple supervisor call (reset autonom code)
+
+ENDPROC reset autonom ;
+
+PROC set automatic startup :
+    simple supervisor call (set automatic startup code)
+ENDPROC set automatic startup ;
+
+PROC reset automatic startup :
+    simple supervisor call (reset automatic startup code)
+ENDPROC reset automatic startup ;
+
+PROC define station (INT CONST station number) :
+
+  IF this is supervisor
+    THEN update all tasks
+    ELIF i am privileged
+        THEN IF station number is valid
+               THEN send define station message
+               ELSE errorstop ("ungueltige Stationsnummer (0 - 127)")
+             FI
+        ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+update all tasks :
+  start at supervisor ;
+  REP
+    get next task ;
+    IF no more task found
+      THEN update station number of supervisor ;
+           LEAVE update all tasks
+    FI ;
+    update station number of actual task
+  PER .
+
+i am privileged :
+  myself < supervisor .
+
+station number is valid :
+  station number >= 0 AND station number <= max station no .
+
+start at supervisor :
+  TEXT VAR name ;
+  INT VAR index := sv no .
+ 
+get next task :
+  get (system catalogue.dir, name, index) .
+ 
+no more task found :  index = 0 .
+
+update station number of actual task :
+  write pcb (task id (index), myself no field, station number * 256 + index).
+
+update station number of supervisor :
+  write pcb (supervisor, myself no field, station number * 256 + sv no) .
+
+send define station message :
+  forget (sv space) ;
+  sv space := nilspace ;
+  INT VAR receipt ;
+  REP
+    send (supervisor, define station code+station number, sv space, receipt)
+  UNTIL receipt = ack PER .
+
+this is supervisor :
+  (pcb (myself no field) AND hex ff) = sv no .
+
+ENDPROC define station ;
+
+
+TASK OP / (INT CONST station number, TEXT CONST task name) :
+
+  IF station number = station (myself)
+    THEN task (task name)
+    ELSE get task id from other station
+  FI .
+
+get task id from other station :
+  enable stop ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  BOUND TEXT VAR name message := sv space ;
+  name message := task name ;
+  INT VAR reply ;
+  call (collector, station number, sv space, reply) ;
+  IF reply = ack
+    THEN BOUND TASK VAR result := sv space ;
+         CONCR (result) 
+  ELIF reply = error nak
+    THEN name message := sv space;
+         disable stop;
+         errorstop (name message) ;
+         forget (sv space) ;
+         niltask
+    ELSE forget (sv space);
+         errorstop ("Collector-Task fehlt") ;
+         niltask
+  FI
+
+ENDOP / ;
+
+
+TASK OP / (INT CONST station number, TASK CONST tsk):
+
+  station number / name (tsk)
+
+END OP / ;
+
+ 
+TEXT PROC external name (TASK CONST tsk):
+
+  IF tsk = nil task 
+  THEN 
+    ""
+  ELIF tsk = collector
+  THEN
+    "** collector **"
+  ELSE
+    name via net
+  FI.
+
+name via net:
+  enable stop ;
+  forget (sv space);
+  sv space := nil space;
+  BOUND TASK VAR task message := sv space;
+  task message := tsk;
+  INT VAR reply;
+  call (collector, 256, sv space, reply);
+  BOUND TEXT VAR result := sv space;
+  CONCR (result).
+
+END PROC external name;
+
+PROC write pcb (TASK CONST task, INT CONST field, value) :
+  EXTERNAL  105
+ENDPROC write pcb ;
+
+TASK PROC task (INT CONST channel number) :
+
+  IF channel number < 1 OR channel number > 32
+    THEN errorstop ("ungueltige Kanalnummer")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tname := text (channel number) ;
+  supervisor call (task of channel code) ;
+  sv msg := sv space ;
+  sv msg.task
+
+END PROC task;
+
+TASK PROC canal (INT CONST channel number) :
+
+  IF channel number < 1 OR channel number > highest terminal channel
+    THEN errorstop ("ungueltige Kanalnummer")
+  FI ;
+  forget (sv space);
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tname := text (channel number) ;
+  supervisor call (canal of channel code) ;
+  sv msg := sv space ;
+  sv msg.task
+
+END PROC canal ;
+
+PROC family password (TEXT CONST password) :
+
+  IF online 
+    THEN say (""3""5""10"")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tpass := password ;
+  supervisor call (family password code) ;
+  cover tracks .
+
+ENDPROC family password ;
+
+INT PROC dataspaces (TASK CONST task) :
+
+  INT VAR ds number, spaces := 0 ;
+  FOR ds number FROM lowest ds number UPTO highest ds number REP
+    IF pages (ds number, index (task)) >= 0
+      THEN spaces INCR 1
+    FI
+  PER ;
+  spaces
+
+ENDPROC dataspaces ;
+
+INT PROC dataspaces :
+  dataspaces (myself)
+ENDPROC dataspaces ;
+
+INT PROC pages (INT CONST ds number, INT CONST task no) :
+  EXTERNAL 88
+ENDPROC pages ;
+
+ENDPACKET tasks ;
+
diff --git a/system/multiuser/1.7.5/src/ur start b/system/multiuser/1.7.5/src/ur start
new file mode 100644
index 0000000..efbf8c1
--- /dev/null
+++ b/system/multiuser/1.7.5/src/ur start
@@ -0,0 +1,40 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PROC begin process (TASK CONST father, son, INT CONST priv, PROCA CONST start) :
+  EXTERNAL 95
+ENDPROC begin process ;
+
+PROC ur :
+  TASK VAR dummy ;
+  begin ("PUBLIC", PROC public manager, dummy) ;
+  global manager (PROC ur manager)
+ENDPROC ur ;
+
+PROC public manager :
+
+  page ;
+  REP UNTIL yes("Archiv 'help' eingelegt") PER;
+  archive ("help") ;
+  fetch ("help", archive) ;
+  release (archive) ;
+  free global manager
+
+ENDPROC public manager ;
+
+PROC ur manager (DATASPACE VAR ds, INT CONST order, phase,
+                 TASK CONST order task) :
+
+  LET begin code = 4 ;
+  enable stop ;
+  IF order = begin code
+    THEN std manager (ds, order, phase, order task)
+    ELSE errorstop ("falscher Auftrag fuer Task ""UR""")
+  FI
+
+ENDPROC ur manager ;
+ 
+check on ;
+command dialogue (TRUE) ;
+begin process (supervisor, task ("UR"), 0, proca (PROC ur)) ;
+command dialogue (FALSE) ;
+check off;
+
diff --git a/system/net/1.7.5/doc/EUMEL Netz b/system/net/1.7.5/doc/EUMEL Netz
new file mode 100644
index 0000000..ad39db3
--- /dev/null
+++ b/system/net/1.7.5/doc/EUMEL Netz
@@ -0,0 +1,832 @@
+#type ("trium8")##limit (11.0)# 

+#start(2.5,1.5)##pagelength (17.4)# 

+#block# 

+#headeven# 

+ 

+%                        EUMEL-Netzbeschreibung 

+ 

+ 

+#end# 

+#headodd# 

+ 

+#center#Inhalt#right#% 

+ 

+ 

+#end# 

+ 

+#type ("triumb12")# 

+1. Einleitung 

+ 

+ 

+Teil 1: Netz einrichten und benutzen 

+#type ("trium8")# 

+ 

+1. Benutzung des Netzes 

+ 

+2. Hardwarevoraussetzungen 

+ 

+3. Einrichten des Netzes 

+ 

+4. Informationsm�glichkeiten 

+ 

+5. Eingriffsm�glichkeiten 

+ 

+6. Fehlerbehebung im Netz 

+ 

+#type ("triumb12")# 

+ 

+Teil 2: Arbeitsweise der Netzsoftware 

+#type ("trium8")# 

+ 

+1. Die Netztask 

+ 

+2. Protokollebenen 

+ 

+3. Stand der Netzsoftware 

+ 

+#page# 

+#headodd# 

+ 

+#center#Einleitung#right#% 

+ 

+ 

+#end# 

+ 

+#type("triumb12")# 

+1. Einleitung #type("trium8")# 

+ 

+ 

+Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit-

+einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das

+Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu-

+dehnen, da� Tasks verschiedener Stationen einander Datenr�ume zusenden

+k�nnen. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa-

+tisch das Netz aus: So ist es z.B. m�glich 

+ 

+- von einer Station aus auf einer anderen zu Drucken, 

+ 

+- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, da�

+  PUBLIC dort ein free global manager ist, 

+ 

+- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk

+  defekt ist oder ein anderes Format hat). 

+ 

+Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. 

+ 

+ 

+#type("triumb12")# 

+Teil 1: Netz einrichten und benutzen 

+ 

+1. Benutzung des Netzes #type("trium8")# 

+#headodd# 

+ 

+#center#Teil 1: Netz einrichten und benutzen#right#% 

+ 

+ 

+#end# 

+ 

+   Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur

+   Verf�gung: 

+ 

+ 

+1.1 

+ 

+   TASK OP / (INT CONST station, TEXT CONST taskname) 

+ 

+   liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. 

+ 

+   Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird

+   solange gewartet, bis das der Fall ist. 

+ 

+   Fehlerf�lle: 

+ 

+     - task "..." gibt es nicht 

+ 

+       Die angeforderte Task gibt es in der Zielstation nicht. 

+ 

+     - Collectortask fehlt 

+ 

+       Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). 

+ 

+     - Station x antwortet nicht 

+ 

+       Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. 

+       Hinweis: Dieser Fehler wird angenommen, wenn eine �berwachungszeit

+                von ca. 30 Sekunden verschrichen ist, ohne da� Station x die

+                Taskidentifikation angeliefert hat. 

+ 

+   Beispiel: 

+ 

+     list (5/"PUBLIC") 

+ 

+     Dateiliste von PUBLIC auf Station 5 wird angefordert. 

+ 

+1.2 

+ 

+   TASK OP / (INT CONST station, TASK CONST task) 

+ 

+   liefert 

+ 

+   station / name (task) . 

+ 

+ 

+   Beispiel: 

+ 

+     list (4/archive) 

+ 

+ 

+1.3 

+ 

+   INT PROC station (TASK CONST task) 

+ 

+   liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. 

+ 

+   Beispiel: 

+ 

+     put (station (myself)) 

+ 

+     gibt die eigene Stationsnummer aus. 

+ 

+ 

+1.4 

+ 

+   PROC archive (TEXT CONST archivename, INT CONST station) 

+ 

+   dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. 

+ 

+   Beispiel: 

+ 

+   archive ("std", 4); list (4/archive) 

+ 

+   gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. 

+   Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations-

+            angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")#

+            archive). 

+   Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop-

+            pyformate umsetzen wollen. 

+ 

+ 

+1.5 

+ 

+   PROC free global manager 

+ 

+   dient dazu, die eigene Task �ber das Netz ansprechbar zu machen. Jede

+   andere Task im Netz kann dann die �blichen Manageraufrufe ('save', 'fetch',

+   u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop-

+   pelt ist. 

+ 

+   Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit

+   'maintenance' statt mit 'gib kommando'. 

+ 

+   Beispiel: 

+ 

+   An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")#

+   auf. Anschlie�end kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w.

+   machen. 

+ 

+ 

+1.6 

+ 

+  TEXT PROC name (TASK CONST t) 

+ 

+  Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, da� der

+  Name einer Task einer anderen Station �ber Netz angefordert wird. 

+ 

+  Fehlerfall: 

+ 

+  Station x antwortet nicht 

+ 

+ 

+ 

+ 

+#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# 

+ 

+2.1 Zwei Stationen 

+ 

+      Sie k�nnen zwei Stationen miteinander Vernetzen, wenn Sie daf�r an jeder

+      Station eine V24-Schnittstelle zur Verf�gung stellen. 

+ 

+      Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner-

+      kopplung (siehe Systemhandbuch 1.7 Teil 2). 

+ 

+2.2 Mehrere Stationen 

+ 

+      Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je

+      einer V24 an jeder Station noch je eine Netzanschlu�box. 

+ 

+      Jede Box besitzt eine V24-Schnittstelle zum Anschlu� an die V24-

+      Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur

+      Verbindung der Boxen untereinander. 

+ 

+ 

+#type("triumb12")#3. Einrichten des Netzes #type("trium8")# 

+ 

+Hinweis: Dieses Kapitel ist nur f�r Systembetreuer wichtig. 

+ 

+3.1 Legen Sie Stationsnummern f�r die am Netz beteiligten Rechner fest (von 1 an

+    aufsteigend). 

+ 

+    Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box

+    und des zugeordneten Rechners m�ssen �bereinstimmen. 

+ 

+ 

+3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie

+    das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie au�erdem das

+    Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gew�hlte Stationsnummer ist. 

+ 

+    Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, f�hren zu feh-

+             lerhaften Verhalten. Dies liegt daran, da� durch #on("bold")#define station#off("bold")# alle

+             Task-Id's ge�ndert werden m�ssen, weil eine Task-Id u.a. die

+             Stationsnummer der eigenen Station enth�lt (siehe 2.3). TASK-

+             Variable, die noch Task-Id's mit keiner oder falscher Stationsnum-

+             mer enthalten, k�nnen nicht mehr zum Ansprechen einer Task

+             verwendet werden. 

+ 

+    Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet

+              beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen

+              Task-Id in einer TASK-Variablen, um sicherzustellen, da� nur der

+              Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")#

+              define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker

+              nicht mehr identifizieren, weil der Worker eine neue Task-Id er-

+              halten hat. Man mu� daher den Worker l�schen und mit dem

+              Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. 

+ 

+ 

+             Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines

+             frischen Systems von Archiv. 

+ 

+    Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den f�r das Netz vorgese-

+    henen Kanal auf 

+ 

+    - transparent 

+    - 9600 Baud (Standardeinstellung der Boxen) 

+    - RTS/CTS-Protokoll 

+    - gro�en Puffer 

+    - 8 bit 

+    - even parity 

+    - 1 stopbit. 

+ 

+    Falls diese Einstellungen nicht alle angeboten werden, kl�ren Sie mit Ihrem

+    Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden k�nnen. 

+    Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn

+             der Eingabepuffer der Station gro� genug ist. Die Anzahl simultan

+             laufender Netzkommunikationen ist dann auf 

+ 

+             puffergr��e DIV 150 

+ 

+             begrenzt (bei Z80, 8086: 3; bei M20: 10). 

+   Hinweis: Es k�nnen auch andere Baudraten (2400, 4800, 19200) an der Box

+            eingestellt werden. 

+ 

+3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen-

+    station bei einem Zweistationennetz ohne Boxen) darauf, da� neben den

+    Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet

+    werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7

+    Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. 

+ 

+    Beispiel: 

+ 

+    Verbindung eines CSK-Systems mit der Box: 

+ 

+    Stecker                  Stecker 

+    Pin                      Pin 

+ 

+    2  <--------->           3 

+    3  <--------->           2 

+    4  <--------->           5 

+    5  <--------->           4 

+    7  <--------->           7 

+ 

+ 

+3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei-

+en 

+ 

+    net report/M 

+    basic net 

+    net manager/M. 

+ 

+    Beantworten Sie die Frage nach dem Kanal f�r das Netz und nach der Flu�-

+    kontrolle (RTS/CTS). 

+ 

+ 

+#type("triumb12")#4. Informationsm�glichkeiten #type("trium8")# 

+ 

+   In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# gef�hrt in der Fehlersituationen des

+   Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list

+   (/"net")#off("bold")# angezeigt werden. 

+ 

+   In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine �bersicht �ber

+   die momentan laufenden Netz�bertragungen der eigenen Station erhalten

+   werden. 

+ 

+ 

+#type("triumb12")#5. Eingriffsm�glichkeiten #type("trium8")# 

+#headodd# 

+ 

+#center#Eingriffsm�glichkeiten#right#% 

+ 

+ 

+#end# 

+ 

+5.1 Jede Task kann Sende- und Empfangsstr�me, die bei #on("bold")#list (/"net port")#off("bold")# gemel-

+    det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das

+    Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus

+    dem 'list') ist. 

+ 

+    Unberechtigte L�schversuche werden abgewiesen. 

+ 

+    Von der Task 'net' aus k�nnen jedoch damit beliebige Str�me abgebrochen

+    werden. 

+ 

+5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet

+    werden. Dabei werden alle augenblicklichen Netzkommunikationen gel�scht.

+    Die Tasks 'net port' und 'net timer' werden dabei gel�scht und neu eingerich-

+    tet. 

+ 

+    #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt

+    und maximal 'quit' Empfangsstr�me zugelassen. 'quit' ist auf 3 zu setzen,

+    wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). 

+ 

+ 

+#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# 

+ 

+   Fehler im Netz k�nnen sich verschiedenartig auswirken. Im Folgenden wird auf

+   einige Beispiele eingegangen: 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. 

+ 

+   Fehlerm�glichkeiten: 

+ 

+   -  Station 4 gibt es nicht am Netz. 

+      Abhilfe: Richtige Station angeben. 

+ 

+   -  Station 4 ist nicht eingeschaltet. 

+      Abhilfe: Station 4 einschalten. Kommando erneut geben. 

+ 

+   -  Netztask an Station 4 ist nicht arbeitsf�hig. 

+      Abhilfe: Kommando 'start' in der Task 'net'. 

+ 

+   -  Stationsnummern und Boxnummern stimmen nicht �berein. 

+      Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). 

+ 

+   -  Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. 

+      Abhilfe: Verbindungen �berpr�fen. Durch Ansprechen einer dritten Station

+               kann oft schnell gekl�rt werden, welche Rechner/Box-Verbindung

+               defekt sein mu�. 

+ 

+   -  Verbindung der Boxen untereinander defekt. 

+      Abhilfe: Fehlende Verbindung, Masseschlu� und Dreher (keine 1:1 Ver-

+               bindung) �berpr�fen und beheben. 

+      Hinweis: Liegt z.B. ein Masseschlu� vor, so kann es durchaus sein, da�

+               Boxen, die nicht in der N�he des Masseschlu� stehen noch mitei-

+               nander arbeiten k�nnen. Man kann aus der Tatsache, da� zwei

+               Boxen miteinander arbeiten k�nnen, also nicht schlie�en, da� man

+               nicht nach diesem Fehler suchen mu�. 

+ 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. 

+ 

+ 

+   -  Station 4 ist w�hrend dieser Sendung zusammengebrochen. 

+      Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos

+               wird automatisch wieder aufgenommen. 

+ 

+   -  PUBLIC auf Station 4 ist nicht im Managerzustand. 

+      Abhilfe: PUBLIC in den Managerzustand versetzen. 

+ 

+ 

+      Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So

+               wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen.

+               Danach wird die Sendung gel�scht. Ist dies eingetreten, so mu�

+               das list-Kommando erneut gegeben werden. 

+ 

+   -  Fehler in der Netzhardware. 

+      �berpr�fen Sie, ob 

+ 

+      - die Boxen eingeschaltet sind, 

+      - die Bereitlampe blinkt (wenn nicht: RESET an der Box) 

+      - die V24-Kabel richtig stecken, 

+      - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5

+        poligen Diodenbuchsen). 

+ 

+ 

+   -  Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. 

+      Dieser wird im Report vermerkt. 

+      Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die

+               Netzsoftware neu gestartet. Alle Netzkommunikationen dieser

+               Station gehen verloren. 

+ 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. 

+ 

+   -  In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2)

+      nicht gegeben. 

+ 

+   -  Die Task 'net port' existiert nicht mehr. 

+      Abhilfe: Kommando 'start' in der Task 'net'. 

+ 

+ 

+   Beispiel: 

+ 

+   Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verf�lscht. 

+ 

+   -  Die V24-Verbindung zur Box ist nicht in Ordnung. 

+      Abhilfe: Abstand zwischen Rechner und Box verk�rzen; Baudrate ernie-

+               drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob

+               diese defekt ist. 

+      Hinweis: Die Verbindung zwischen den Boxen ist durch Pr�fsummen abge-

+               sichert (Hardware). 

+ 

+#headodd# 

+ 

+#center#Teil 2: Arbeitsweise der Netzsoftware#right#% 

+ 

+ 

+#end# 

+#page# 

+#type("triumb12")# 

+ 

+Teil 2: Arbeitsweise der Netzsoftware 

+ 

+ 

+1. Die Netztask #type ("trium8")# 

+ 

+In diesem Kapitel wird beschrieben, wie eine Netztask in das System

+eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser

+Konzepte kann die ausgelieferte Netztask so ge�ndert werden, da� sie

+beliebige andere Netzhardware unterst�tzt. Z.Zt. ist die Netzsoftware noch

+nicht so gegliedert, da� nur eine hardwareabh�ngige Komponente ausgetauscht

+werden mu�. 

+ 

+Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem

+Rendevouskonzept: Die Zieltask einer Sendung mu� empfangsbereit sein, wenn die

+Quelltask sendet. 

+ 

+Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden)

+und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer

+'code' und ein Datenraum 'dr' �bergeben. 'code' mu� >= 0 sein, da negative

+Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal

+gekoppelt ('continue'), so f�hrt eine Zeicheneingabe auf diesem Kanal dazu,

+da� eine

+Sendung mit dem Code -4 ankommt. Die Eingabedaten m�ssen mit den �blichen

+Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der �bermittelte Datenraum

+und die Absendertask sind dabei ohne Bedeutung und d�rfen nicht interpretiert

+werden. 

+ 

+Die Prozedur 'send' hat einen R�ckmeldeparameter, der besagt, ob die Sendung

+�bermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann

+die Sendung nicht �bermittelt werden. 

+ 

+ 

+Ein Entwicklungskriterium f�r das EUMEL-Netz war es, m�glichst wenig Unter-

+st�tzung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit-

+gehend in ELAN programmiert werden kann. Dadurch ist es m�glich eine (privili-

+gierte) Task mit der Netzabwicklung zu betrauen. 

+ 

+Zun�chst wird auf die EUMEL0-Unterst�tzung eingegangen: 

+ 

+1.1. Es gibt die Prozedur 'define collector', mit der die f�r das Netz verantwort-

+     liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im

+     folgenden Collector genannt. 

+ 

+1.2. Es gibt die Prozedur 'define station', die f�r den Rechner eine Stationsnum-

+     mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un-

+     terschieden. Das Einstellen bewirkt, da� f�r alle Tasks die Stationsnummer in

+     ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK

+     annehmen kann). 

+ 

+1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B.

+     'station (myself)' die Stationsnummer des eigenen Rechners. 

+ 

+1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station

+     (ziel) <> station (myself)), wird auf die Collectortask geleitet. 

+ 

+1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die

+     eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. 

+ 

+1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der

+     Zieltask eine beliebige andere Task als Absender vorzumachen. 

+ 

+1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein-

+     gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver-

+     mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von

+     EUMEL0 an den derzeitigen Collector geschickt. 

+ 

+Ein Collector kann also auf drei Wegen von den �brigen Tasks desselben Rechners

+Sendungen erhalten: 

+ 

+  1. �ber ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der-

+     zeitige Collector ist), 

+ 

+  2. �ber ein Send an die Task 'collector' (s.u.) und 

+ 

+  3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen

+     Rechner). 

+ 

+Der Collector kann diese F�lle anhand von 'collected destination' unterscheiden. 

+ 

+Die Punkte 1.4...1.6 dienen dazu, den Collector f�r �ber Netz kommunizierende

+Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von

+Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum k�mmern

+m�ssen, ob eine Sendung �bers Netz geht oder im eigenen Rechner bleibt. 

+ 

+Wenn ein Datenraum an einen anderen Rechner geschickt wird, mu� der gesamte

+Inhalt (z. Zt. max. 1 MB) �bertragen werden. Dies macht bei der �blichen Netz-

+hardware eine Zerlegung in Packete n�tig (siehe Systemhandbuch 173, Teil 4,

+Punkt 5). F�r Netze �ber V24-Kan�le stehen spezielle Blockbefehle zur verf�-

+gung: 

+ 

+1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) 

+ 

+   Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zur�ckgemeldet,

+   wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert).

+   Bearbeitet werden die Bytes 

+ 

+      'seite' * 512 + 'abstand' 

+ 

+   bis maximal 

+ 

+      'seite' * 512 + 'abstand' + 'anzahl' - 1 

+ 

+  Der Kanal, an den die Task gekoppelt ist, wird dabei �ber Stream-IO (d.h.

+  'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. 

+ 

+  Hinweis: Die Anforderung darf nicht �ber Seitengrenze gehen, d.h. 

+ 

+  'abstand' + 'anzahl' <= 512 

+ 

+  mu� erf�llt sein. 

+ 

+ 

+Eine Netzsendung l�uft wie folgt ab: 

+ 

+Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. 

+ 

+1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, da�

+   die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id

+   enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de-

+   fine collector' kennt, umgeleitet. 

+ 

+2. Die Task Collector empf�ngt �ber 'wait' den Datenraum, den Sendecode und

+   die Absendertask q. Die Zieltask z erf�hrt sie durch 'collected destination'. 

+ 

+3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta-

+   tionsnummer ja 'station(z)' ist, auf und �bermittelt diesem Sendecode, Quelltask

+   (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN

+   geschrieben sind, k�nnen sie an beliebige Netzhardware und Protokolle ange-

+   pa�t werden. 

+ 

+4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die

+   Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q

+   als Absender der Sendung. 

+ 

+Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) mu� der Collector noch

+spezielle Funktionen beherrschen. Diese sind 

+ 

+   der /-Operator (Taskname in Task-Id wandeln) und 

+   die name-Prozedur (Task-Id in Namen wandeln). 

+ 

+Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der

+Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe

+Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta-

+tion in Verbindung, damit dieser die Task-Id ermittelt und zur�ckschickt. Der

+eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der

+die Task-Id enth�lt. 

+ 

+Umgekehrt l�uft 'name' ab: Wenn die Task-Id von einer fremden Station ist,

+schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id

+steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der

+Task aus der Task-Id und l��t sich vom entsprechenden Collector den Tasknamen

+geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum �bergeben. 

+ 

+#type ("triumb12")#2. Ebenen #type("trium8")# 

+ 

+In diesem Kapitel werden die Protokollebenen f�r das Netz beschrieben, wie

+sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer

+Netzhardware m�ssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung

+der im vorigen Kapitel beschriebenen Randbedingungen k�nnen auch die h�heren

+Ebenen ge�ndert werden. 

+ 

+ 

+2.1 Physikalische Ebene 

+ 

+    2.1.1  Station <--> Box 

+ 

+           V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. 

+ 

+    2.1.2  Box <--> Box 

+ 

+           RS422 �ber 2 verdrillte Leitungspaare (Takt und Daten). 

+ 

+2.2 Verbindungsebene 

+ 

+    2.2.1  Station <--> Box 

+ 

+           Asynchron 

+           8 Bit 

+           Even Parity 

+           2400/4800/9600/19200 Baud (einstellbar �ber L�tbr�cken) 

+ 

+    2.2.2  Box <--> Box 

+ 

+           SDLC 

+           400 KBaud 

+ 

+2.3 Netzebene 

+ 

+    2.3.1  Station <--> Box 

+ 

+           Telegrammformat:  STX, <n>, <ziel>, <quelle>, <(n-4) byte> 

+ 

+           <n> ist L�ngenangabe ( 8 <= n <= 160) 

+           <ziel>, <quelle> sind Stationsnummern. Diese m�ssen an den je-

+           weiligen Boxen �ber L�tbr�cken eingestellt sein. 

+ 

+           Box --> Station: 

+ 

+           Ein Telegramm kommt nur bei der Station an, bei deren Box die

+           Nummer <ziel> eingestellt ist. Dadurch ist ein Mith�ren fremder

+           �bertragungen nicht m�glich (Datenschutz). 

+ 

+           Zwischen Telegrammen k�nnen Fehlermeldungen der Box (Klartext)

+           �bermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er-

+           wartet wurde, aber 'x' von der Station ankommt). 

+ 

+           Station --> Box: 

+ 

+           Ein Telegramm wird nur abgeschickt, wenn <quelle> mit der einge-

+           stellten Nummer �bereinstimmt (Datenschutz: Man kann nicht eine

+           beliebige Station zu sein vorschwindeln, es sei denn man hat physi-

+           schen Zugriff zur Box und stellt dort die Stationsnummer um). 

+ 

+    2.3.2  Box <--> Box 

+ 

+           Telegrammformat: FRAME, <ziel>, <quelle>, <daten> ,

+           <CRC-Code> 

+ 

+           Eine L�ngenangabe ist nicht n�tig, da SDLC eine Rekonstruktion der

+           L�nge erlaubt. 

+ 

+           Telegramme mit falschen CRC-Code werden vernichtet. Auf h�heren

+           Ebenen mu� dies durch Zeit�berwachung erkannt und behandelt

+           werden. 

+ 

+ 

+2.4 Transportebene 

+ 

+    Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht,

+    und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). 

+ 

+    Der im 'send' angegebene Datenraum wird als Folge von Seiten (im

+    EUMEL-Sinne: Pagingeinheit und Allokiereinheit) �bermittelt, wobei jede Seite

+    noch in 64 Byte gro�e St�cke zerlegt wird. Es werden nur echt allokierte Seiten

+    �bermittelt. Um nicht jedes Telegramm voll qualifizieren zu m�ssen, wird

+    zun�chst eine Art virtuelle Verbindung durch ein OPEN-Telegramm er�ffnet.

+    Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch

+    QUIT-Telegramme quittiert, um folgende Funktionen zu erm�glichen: 

+ 

+    Flu�kontrolle (z.B. Zielrechner langsam) 

+    Wiederaufsetzen (verlorene Telegramme) 

+    Abbruch (z.B. weil Zieltask inzwischen beendet). 

+ 

+    Ein CLOSE-Telegramm ist nicht n�tig, da das letzte DATA-Telegramm als

+    solches erkannt werden kann (siehe unten). 

+ 

+    2.4.1 OPEN-Telegramm 

+ 

+          STX, 20, <ziel>, <quelle>, <strom>, <sequenz>, <seite>, 

+          <quelltask>, <zieltask>, <code> 

+ 

+          <ziel>, <quelle> siehe 2.3.1 

+ 

+          <strom>      Die Stromnummer identifiziert die virtuelle Verbindung.

+                       Sie mu� in den QUIT-Telegrammen angegeben wer-

+                       den. 

+ 

+          <sequenz>    -1 (Kennzeichen f�r OPEN) 

+ 

+          <seite>      Nummer der ersten echt allokierten Seite des Datenra-

+                       ums (=-1, falls Nilspace) 

+ 

+          <quelltask>  Taskid der sendenden Task 

+ 

+          <zieltask>   Taskid der empfangenden Task 

+ 

+          <code>       Wert des im 'send' angegebenen Codes. 

+ 

+    2.4.2 DATA-Telegramm 

+ 

+          STX, 74, <ziel>, <quelle>, <sequenz>, <seite>, <64 byte> 

+ 

+          <sequenz>    wird von Telegramm zu Telegramm hochgez�hlt. Dient

+                       der �berwachung gegen verlorengegangene Telegramme

+                       bzw. durch Zeit�berwachung verdoppelter Telegramme. 

+ 

+          <seite>      Nummer der x.ten echt allokierten Seite des Datenra-

+                       ums. (x = (<sequenz>+16) DIV 8). 

+ 

+          <64 byte>    Nutzinformation. Diese geh�rt zur Adresse a des Daten-

+                       raums. 

+ 

+                       a = N (<sequenz> DIV 8 + 1) * 512 

+                           + (<sequenz> MOD 8) * 64 

+ 

+                       wobei N (x) die Nummer der x.ten Seite ist. 

+ 

+                       Aus den Formeln ergibt sich, da� diese Nummer schon in

+                       einem vorhergehenden DATA/OPEN-Telegramm �ber-

+                       mittelt wurde (im Feld <seite>). 

+ 

+    2.4.3 QUIT-Telegramm 

+ 

+          STX, 8, <ziel>, <quelle>, <strom>, <quit> 

+ 

+          <strom>      mu� die Stromnummer sein, die in dem OPEN/DATA-

+                       Telegramm stand, das quittiert wird. 

+ 

+          <quit>       0 :  ok. N�chstes Telegramm schicken. 

+ 

+                       -1:  �bertragung neu starten (mit OPEN), weil die

+                            Empfangsstation das OPEN nicht erhalten hat. 

+ 

+                       -2:  �bertragung ca. 20 Telegramme zur�cksetzen. 

+ 

+                       -3:  �bertragung abbrechen. 

+ 

+ 

+2.5 Vermittlungsebene 

+ 

+    Diese Ebene ist daf�r zust�ndig, Tasknamen von Task auf anderen Stationen

+    in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im

+    entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als <code>

+    eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die

+    Aufgaben selbst ab, soda� es dabei nicht n�tig ist, irgendeine Taskid der

+    Zielstation zu kennen. 

+ 

+    Dieses Verfahren ist m�glich, weil im 'send' nur positive Codes erlaubt sind. 

+ 

+2.6 H�here Ebenen 

+ 

+    H�here Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem

+    Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der

+    Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese

+    Task (bei der Variante 'free global manager') auf einer beliebigen Station im

+    Netz liegen. Wegen des Rendevous-Konzepts k�nnen beliebige Sicherheit-

+    strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von

+    gro�en Wert ist z.B., da� man ohne weiteres das Archiv (Floppylaufwerk) einen

+    anderen Station anmelden und benuzten kann, wodurch eine einfache Kon-

+    vertierung von Floppyformaten m�glich ist. Dies ist m�glich, weil auch die Ar-

+    chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. 

+ 

+ 

+#type("triumb12")# 

+Bemerkungen#type("trium8")# 

+ 

+Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu

+entfernen. Die Ebene 4 �berwacht den Netzverkehr sowieso �ber Timeouts, die

+eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. 

+ 

+Da bei der sendenden Station der ganze Datenraum zur Verf�gung steht, ist eine

+Fenstertechnik (wie bei HDLC) nicht n�tig. Es kann zu jedem Zeitpunkt um beliebig

+viele Telegramme zur�ckgesetzt werden. 

+ 

+Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen

+der Insert/Delete-M�glichkeiten, ohne den Rest der Datei zu schieben), ist es ein

+hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL-

+Netz zu senden. F�r solche Zwecke mu� noch eine einfachere Dateistruktur defi-

+niert werden und entsprechende Dateikonverter erstellt werden. 

+ 

+ 

+ 

+#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# 

+ 

+Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# �ber das Netz ab, wenn die

+Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge-

+kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen-

+derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). 

+ 

+Nicht unterst�tzt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese

+funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist

+die Zieltask l�nger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die

+Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")#

+pingpong#off("bold")#: R�ckmeldung -2). 

+ 

+Wegen dieser Einschr�nkung kann man z.B. ein sicheres Drucken von Station a

+auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf

+Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings

+sowieso sinnvoll, damit man 

+ 

+- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx",

+4/printer);) und 

+- nicht zu warten braucht, bis die Datei �bers Netz gesendet ist. 

+ 

+ 

+ 

+ 

+ 

diff --git a/system/net/1.7.5/src/basic net b/system/net/1.7.5/src/basic net
new file mode 100644
index 0000000..88b41e5
--- /dev/null
+++ b/system/net/1.7.5/src/basic net
@@ -0,0 +1,840 @@
+PACKET basic net DEFINES                          (* D. Heinrichs *)

+                                                  (* 02.10.85     *)

+  nam,

+  max verbindungsnummer,

+  neuer start,

+  packet eingang,

+  neue sendung,

+  zeitueberwachung,

+  verbindung,

+  loesche verbindung:

+

+TEXT PROC nam (TASK CONST t):

+  IF t = collector THEN name (t)

+  ELIF station (t) <> station (myself) 

+  THEN "** fremd **"

+  ELSE name (t)

+  FI

+END PROC nam;

+

+INT PROC tasknr (TASK CONST t):

+  IF t = collector THEN maxtasks

+  ELSE index (t)

+  FI

+END PROC tasknr;

+

+LET

+    maxtasks = 127,

+    max strom = 20,

+    max strom 1 = 21,

+    stx = ""2"",

+    code stx = 2, 

+    ack = 0,

+    nak = 1,

+    error nak = 2,

+    zeichen eingang = 4,

+    list code = 15,

+    fetch code = 11,

+    inspect code = 30,

+    continue code = 100,

+    erase code = 14,

+    report code = 99,

+    seiten groesse = 512,

+    dr verwaltungslaenge = 8,

+    dr verwaltungslaenge2=10,

+    nutzlaenge = 64,

+    openlaenge = 20,

+    vorspannlaenge = 10, 

+    neue ack laenge = 10, 

+    ack laenge = 8,

+

+    (* Typen von Kommunikationsströmen *)

+

+    send wait = 0,

+    zustellung = 1,

+    call pingpong = 2,

+    call im wait = 3,

+    call im abbruch = 4,

+    call in zustellung = 5,

+

+    (*quittungscodes*)

+

+    ok = 0,

+    von vorne = 1,

+    wiederhole = 2,

+    loesche = 3,

+    beende = 4;

+

+LET STEUER =

+      STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom,

+           sequenz,

+           seitennummer,

+      TASK quelle,ziel,

+      INT  sende code);

+ 

+BOUND STEUER VAR open block;

+

+BOUND STRUCT (STEUER steuer, INT typ) VAR info block; 

+ 

+BOUND STRUCT (

+      INT  head, 

+           rechner nummern, 

+           strom,

+           sequenz,

+           seitennummer) VAR vorspann ;

+ 

+BOUND STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom, 

+           code) VAR ack packet ; 

+ 

+INT CONST max verbindungsnummer := max strom;

+

+BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge): 

+ INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512;

+ REAL VAR time out := clock (1) + 10.0;

+ REP 

+   blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 

+ UNTIL hilfslaenge = 0 OR clock (1) > time out PER  ;

+ hilfslaenge = 0

+END PROC blockin; 

+

+PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge): 

+ INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; 

+ REP 

+   blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 

+ UNTIL hilfslaenge = 0 PER 

+END PROC blockout; 

+ 

+ 

+ 

+ 

+DATASPACE VAR work space;

+ 

+ 

+INT CONST packete pro seite:= seitengroesse DIV nutzlaenge, 

+          packete pro seite minus 1 := packete pro seite -1,

+          datenpacketlaenge := vorspannlaenge + nutzlaenge;

+ 

+INT VAR err,strom; 

+ 

+INT VAR   own:=station (myself) ,

+          quit max := 3,

+          quit zaehler := 3,

+          own256 := 256*own;

+INT CONST stx open := code stx+256*openlaenge,

+          stx quit := code stx+256*acklaenge;

+

+  ROW maxstrom1 STEUER VAR verbindungen; 

+  ROW maxstrom1 DATASPACE VAR netz dr; 

+  ROW maxstrom1 INT VAR zeit, typ;

+  FOR strom FROM 1 UPTO maxstrom1 REP vdr := nilspace; forget (vdr) PER;

+  ROW maxstrom INT VAR dr page ;

+  ROW maxtasks INT VAR alter call;

+  STEUER VAR opti;

+ 

+.vx : verbindungen (strom). 

+ 

+vdr: netz dr (strom). 

+ 

+falsche stromnummer: strom < 1 OR strom > maxstrom.

+

+call aufruf: typ(strom) >= call pingpong.

+

+alles raus: vx.seitennummer = -1 AND letztes packet der seite . 

+

+letztes packet der seite :

+(vx.sequenz AND packete pro seite minus 1) = packete pro seite minus 1.

+

+PROC neuer start (INT CONST empfangsstroeme):

+  workspace := nilspace;

+  open block := workspace; 

+  info block := workspace;

+  vorspann := workspace; 

+  ack packet := workspace;

+  FOR strom FROM 1 UPTO maxstrom1 REP 

+  vx.strom := 0;  forget (vdr)

+  PER; 

+  INT VAR i;

+  FOR i FROM 1 UPTO maxtasks REP alter call (i) := 0 PER;

+  quitmax := empfangsstroeme;

+  own:=station (myself);

+  quit zaehler := quit max;

+  own256 := 256*own; 

+  reset box.

+

+reset box: 

+  out (90*""4""); 

+  REP UNTIL incharety (1) = "" PER. 

+ 

+END PROC neuer start;

+

+DATASPACE PROC verbindung (INT CONST nr):

+  infoblock.steuer := verbindungen (nr);

+  infoblock.typ := typ (nr);

+  workspace

+END PROC verbindung;

+

+PROC neue sendung (TASK CONST q,z, INT CONST cod, DATASPACE CONST dr):

+

+  naechste verbindung vorbereiten;

+  forget (vdr); vdr := dr;

+  IF z = collector 

+  THEN 

+    verbindungsebene 

+  ELSE 

+    sendung starten (q,z,cod)

+  FI.

+

+verbindungsebene: 

+  IF cod = 256 THEN name von fremdstation

+  ELIF cod > 256

+  THEN

+    taskinfo fremd 

+  ELSE

+    task id von fremd

+  FI.

+

+taskinfo fremd: sendung starten (q, collector, cod-256, -8).

+

+task id von fremd: sendung starten (q,collector, zielstation,-6) .

+

+name von fremdstation:

+  BOUND TASK VAR tsk := vdr;

+  TASK VAR tsk1 := tsk;

+  forget (vdr);

+  vdr := nilspace;

+  sendung starten (q, tsk1, -7).

+

+zielstation: cod.

+

+END PROC neue sendung; 

+

+PROC zeitueberwachung

+     (INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):

+  snr INCR 1;

+  FOR strom FROM snr UPTO maxstrom REP zeitkontrolle PER;

+  snr := 0. 

+

+zeitkontrolle: 

+  IF vx.strom <> 0 AND zeit(strom) > 0

+  THEN 

+    zeit(strom) DECR 1; 

+    IF sendung noch nicht zugestellt

+    THEN 

+      IF zeit(strom) = 0 THEN 

+         report ("Nicht zustellbar. """+nam (vx.ziel)+""". "+

+         text (vx.rechnernummernDIV256)); 

+         loesche verbindung (strom)

+      ELSE

+         snr := strom;

+         q := vx.quelle;

+         z := vx.ziel;

+         ant := vx.sendecode;

+         dr := vdr;

+         LEAVE zeitueberwachung

+      FI

+    ELIF zeit(strom) = 0 THEN wiederholen FI 

+  FI. 

+ 

+sendung noch nicht zugestellt:

+  typ (strom) = zustellung.

+

+wiederholen: 

+  IF sendeeintrag 

+  THEN 

+    sendung wiederholen

+  ELSE

+    empfangseintrag freigeben

+  FI. 

+ 

+sendeeintrag : vx.rechnernummern DIV 256 = own . 

+ 

+sendung wiederholen:

+  IF wiederholung noch sinnvoll 

+  THEN

+    IF frisch 

+    THEN 

+      time out bei open

+    ELSE 

+      datenteil wiederholen 

+    FI

+  ELSE

+    sendung loeschen

+  FI.

+

+wiederholung noch sinnvoll:

+  task noch da AND bei call noch im call.

+

+task noch da: vx.quelle = collector OR exists (vx.quelle).

+

+bei call noch im call: 

+  IF call aufruf

+  THEN

+    callee (vx.quelle) = vx.ziel

+  ELSE

+    TRUE

+  FI.

+

+frisch: vx.sequenz = -1. 

+ 

+time out bei open:

+  IF vx.sendecode > -4 THEN open wiederholen ELSE nak an quelle senden FI.

+

+nak an quelle senden:

+  forget (vdr); vdr := nilspace;

+  BOUND TEXT VAR erm := vdr;

+  erm := "Station "+text(vx.rechnernummernMOD256)+" antwortet nicht";

+  snr := strom;

+  q := collector;

+  z := vx.quelle;

+  ant := error nak;

+  dr := vdr;

+  sendung loeschen;

+  LEAVE zeitueberwachung .

+

+open wiederholen: 

+  sendereport ("wdh open"); 

+  zeit(strom) := 20;

+  openblock := vx; 

+  openblock.head := stx open; 

+  ab die post. 

+ 

+datenteil wiederholen: 

+  sendereport ("wdh data. sqnr "+text (vx.sequenz));

+  senden .

+

+empfangseintrag freigeben:

+  IF antwort auf call 

+  THEN

+    weiter warten

+  ELSE

+    empfangsreport ("Empfangseintrag freigegeben");

+    empfang loeschen

+  FI.

+antwort auf call: callee (vx.ziel) = vx.quelle.

+

+weiter warten: zeit (strom) := 200.

+

+END PROC zeitueberwachung;

+

+PROC sendereport (TEXT CONST txt):

+  report (text (strom)+":"+txt+". Absender: """+nam (vx.quelle)+

+          """. Ziel "+text(vx.rechnernummernMOD256)); 

+END PROC sendereport;

+

+PROC empfangsreport  (TEXT CONST txt):

+  report (text (strom)+":"+txt+". Empfänger: """

+          +nam (vx.ziel)+""". Quelle "+text (vx.rechnernummernDIV256));

+END PROC empfangsreport  ;

+

+PROC sendung loeschen:

+    IF callaufruf CAND alter call (tasknr (vx.quelle)) = strom

+    THEN

+       alter call (tasknr (vx.quelle)) := 0

+    FI;

+    vx.strom := 0;

+    forget (vdr)

+END PROC sendung loeschen;

+

+PROC empfang loeschen:

+    quit zaehler INCR 1;

+    IF callaufruf AND alter call (tasknr (vx.ziel)) = strom

+    THEN

+       alter call (tasknr (vx.ziel)) := 0

+    FI; 

+    forget (vdr);

+    vx.strom := 0

+END PROC empfang loeschen;

+

+PROC loesche verbindung (INT CONST nr):

+  strom := nr;

+  IF sendeeintrag

+  THEN

+    sendung loeschen

+  ELSE

+    gegenstelle zum loeschen auffordern; 

+    empfang loeschen

+  FI.

+

+gegenstelle zum loeschen auffordern:

+  IF verbindung aktiv THEN quittieren (-loesche) FI.

+

+verbindung aktiv: vx.strom > 0.

+

+sendeeintrag: vx.rechnernummern DIV 256 = own . 

+

+END PROC loesche verbindung;

+

+PROC weiter senden: 

+  IF NOT alles raus

+  THEN

+    sequenz zaehlung; 

+    IF neue seite THEN seitennummer eintragen FI;

+    senden

+  FI.

+

+sequenz zaehlung: 

+  vx.sequenz INCR 1. 

+ 

+neue seite: 

+  (vx.sequenz AND packete pro seite minus 1) = 0. 

+

+seitennummer eintragen: 

+  dr page (strom) :=  vx.seiten nummer;

+  vx.seitennummer := next ds page (vdr, dr page (strom)). 

+ 

+ 

+END PROC weiter senden;

+ 

+PROC senden:

+  zeit(strom) := 3;

+  vorspann senden;

+  daten senden.

+

+vorspann senden: 

+  openblock := vx; 

+  blockout (workspace, 1, dr verwaltungslaenge, vorspannlaenge). 

+ 

+daten senden: 

+  blockout (vdr,dr page (strom),distanz,nutzlaenge). 

+ 

+distanz: nutzlaenge* (vx.sequenz AND (packete pro seite minus 1)). 

+

+END PROC senden;

+

+PROC naechste verbindung vorbereiten: 

+  FOR strom FROM 1 UPTO maxstrom REP 

+  UNTIL vx.strom = 0 PER; 

+  IF vx.strom <> 0 THEN errorstop ("Verbindungsengpass") FI. 

+END PROC naechste verbindung vorbereiten;

+

+PROC sendung starten (TASK CONST quelle, ziel, INT CONST code): 

+  sendung starten (quelle,ziel, station(ziel), code) 

+END PROC sendung starten;

+ 

+PROC sendung starten (TASK CONST quelle, ziel, INT CONST ziel station,code):

+  IF ziel station = own 

+  THEN

+    report ("Irrläufer: Sendung an eigene Station. Absender:"""+

+            nam (quelle)+""".");

+    vx.strom := 0;

+    forget (vdr)

+  ELSE

+    openblock.ziel := ziel;

+    openblock.quelle :=quelle; 

+    openblock.sendecode := code;

+    openblock.rechnernummern:= ziel station + own256; 

+    alten call loeschen (quelle);

+    IF call oder ping pong

+    THEN typ (strom) := call pingpong; call merken

+    ELSE typ (strom) := send wait FI;

+    sendung neu starten

+  FI.

+

+call oder pingpong: openblock.ziel = callee (openblock.quelle).

+

+call merken: alter call (tasknr (quelle)) := strom.

+

+END PROC sendung starten;

+

+PROC sendung neu starten:

+  openblock.head:= stx open; 

+  openblock.sequenz := -1; 

+  openblock.seitennummer:= next ds page (vdr,-1); 

+  openblock.strom := strom;

+  vx := open block; 

+  zeit(strom) := 3;

+  ab die post;

+  vx.head:=code stx+256*(vorspannlaenge+nutzlaenge). 

+ 

+END PROC sendung neu starten; .

+

+ab die post: 

+  block out (work space,1, dr verwaltungslaenge,open laenge).

+ 

+PROC alten call loeschen (TASK CONST quelle):

+  IF alter call aktiv

+  THEN

+    INT VAR lstrom := strom;

+    vx:=openblock;

+    strom := alter call (tasknr (quelle));

+    IF in ausfuehrungsphase

+    THEN

+      sendereport ("Call-Löschung vorgemerkt");

+      loeschung vormerken

+    ELSE

+      report ("Call gelöscht."""+nam(quelle)+""". Strom "+text(strom));

+      loesche verbindung (strom)

+    FI;

+    strom := lstrom;

+    openblock := vx

+  FI.

+

+in ausfuehrungsphase:

+  typ(strom) = call im wait OR typ (strom) = call in zustellung.

+

+loeschung vormerken:

+  typ(strom) := call im abbruch;

+  alter call (tasknr (quelle)) := 0.

+

+ 

+  alter call aktiv:

+    alter call (tasknr (quelle)) > 0.

+

+END PROC alten call loeschen;

+

+PROC packet eingang

+  (TEXT CONST ft, INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):

+    snr := 0;

+    vorspann holen; 

+    IF NOT ring logik THEN daten teil FI.

+

+ring logik: FALSE.

+# IF selbst quelle THEN daten aus puffer entfernen ; TRUE

+  ELIF NOT selbst ziel THEN weitergeben; TRUE 

+  ELSE FALSE

+  FI.

+

+selbst quelle: openblock.rechnernummern DIV 256 = station (myself).

+

+selbst ziel:   (openblock.rechnernummern AND 255) = own.

+#

+daten aus puffer entfernen:

+  IF code (t) > nutzlaenge 

+  THEN

+    BOOL VAR dummy :=blockin (workspace, 1, drverwaltungslaenge, nutzlaenge) 

+  FI.

+#

+weitergeben:

+  IF code (t) > nutzlaenge

+  THEN 

+    IF NOT  blockin (workspace, 2, 0, nutzlaenge) 

+    THEN LEAVE test auf packeteingang FI;

+  FI;

+  out (stx+t);

+  blockout (workspace, 1, drverwaltungslaenge2, blocklaenge);

+  IF code (t) > nutzlaenge

+  THEN

+    blockout (workspace, 2, 0, nutzlaenge)

+  FI.

+#

+vorspann holen: 

+  sync; 

+  IF NOT blockin (workspace, 1, dr verwaltungslaenge2, block laenge)

+  THEN LEAVE packeteingang 

+  FI.

+

+

+blocklaenge: IF code t  > nutzlaenge 

+             THEN 

+               vorspannlaenge-2 

+             ELSE 

+               code t -2 

+             FI. 

+

+sync: 

+  TEXT VAR skipped:=ft , t :="";

+  REP 

+    skipped CAT t;

+    t := incharety (1); 

+    IF t = "" THEN 

+      report ("skipped",skipped); 

+      LEAVE packet eingang

+    FI ;

+    INT VAR codet := code (t);

+  UNTIL blockanfang PER; 

+  IF skipped <> stx THEN report ("skipped bei sync:", skipped) FI. 

+ 

+blockanfang: 

+  (skipped SUB length(skipped)) = stx 

+  AND

+  (codet = datenpacketlaenge

+  OR codet = ack laenge OR codet = neue ack laenge OR code t = openlaenge). 

+ 

+daten teil: 

+  IF neue verbindung 

+  THEN

+    verbindung bereitstellen

+  ELIF quittung 

+  THEN 

+    strom := ack packet.strom; 

+    IF falsche stromnummer THEN report ("Strom falsch in Quittung");

+                                LEAVE datenteil FI;

+    IF vx.strom = 0 THEN LEAVE datenteil FI;

+    IF ackpacket.code >= ok   THEN weiter senden

+    ELIF ackpacket.code = -von vorne THEN

+        sendereport ("Neustart");

+        openblock := vx; 

+        sendung neu starten 

+    ELIF ackpacket.code = -wiederhole THEN back 16

+    ELIF ackpacket.code = -loesche    THEN fremdloeschung

+    ELIF ackpacket.code = -beende AND alles raus THEN strom abschliessen

+    FI

+  ELIF verbindung festgestellt 

+  THEN

+    zeit(strom) := 200;

+    opti := vx;

+    datenpacket

+  ELSE 

+    strom := maxstrom1; 

+    vx:=openblock;

+    report ("Daten ohne Eroeffnung von " +text(vx.rechnernummernDIV256) 

+    +"  Sequenznr "+text(openblock.sequenz)); 

+    daten aus puffer entfernen;

+    IF alles raus THEN quittieren (-beende) ELSE quittieren(-von vorne) FI

+  FI. 

+

+verbindung bereitstellen:

+  IF openblock.ziel = collector OR station (openblock.ziel) = own

+  THEN

+    freie verbindungsnummer; 

+    vdr := nilspace;

+    vx := open block; 

+    zeit(strom) := 10;

+    quittieren falls genug pufferplatz;

+    vx.sequenz := 0 ; 

+    IF loeschung vorgemerkt

+    THEN 

+      loesche verbindung (strom)

+    ELSE

+      opti := vx;

+      abschluss testen

+    FI;

+  FI.

+

+loeschung vorgemerkt: typ(strom) = call im abbruch.

+

+strom abschliessen:

+  IF call aufruf THEN zeit(strom) := 80; ausfuehrungsphase merken

+  ELSE

+    vx.strom := 0; 

+    forget (vdr)

+  FI.

+

+ausfuehrungsphase merken: typ(strom) := call in zustellung.

+ 

+back16:

+  datenraum etwas rueckspulen; 

+  nicht sofort senden (* wegen vagabundierender Quittungen *).

+

+nicht sofort senden: zeit(strom) := 2.

+

+datenraum etwas rueckspulen:

+  sendereport ("etwas rueckgespult");

+  INT VAR sk , vs :=-1;

+  dr page (strom) := -1;

+  INT VAR i;

+  FOR i FROM 1 UPTO vx.sequenz DIV packete pro seite - etwas REP

+    vs INCR packete pro seite;

+    dr page (strom) := next ds page (vdr, dr page (strom)) 

+  PER;

+  vx.seiten nummer := next ds page (vdr, dr page (strom)) ;

+  vx.sequenz := vs.

+

+etwas: 3.

+

+fremdloeschung:

+  IF fremdrechner ok und sendung 

+  THEN

+    IF typ (strom) = call in zustellung

+    THEN

+      typ (strom) := call im wait

+    ELSE

+      sendereport ("Sendung von Gegenstelle geloescht");

+      sendung loeschen

+    FI

+  FI.

+

+fremdrechner ok und sendung:

+ (ackpacket.rechnernummern DIV 256) = (vx.rechnernummern AND 255).

+

+

+quittieren falls genug pufferplatz:

+  IF quit zaehler > 0 THEN

+    quit zaehler DECR 1;

+    open quittieren;

+    block vorab quittieren

+  FI.

+

+open quittieren: quittieren (ok).

+block vorab quittieren: quittieren (ok).

+

+quittung:  code t <= neue ack laenge. 

+ 

+neue verbindung: code t = open laenge.

+ 

+verbindung festgestellt: 

+  FOR strom FROM maxstrom DOWNTO 1 REP 

+    IF bekannter strom

+    THEN LEAVE verbindung festgestellt WITH TRUE FI 

+  PER; 

+  FALSE. 

+ 

+bekannter strom: 

+  vx.strom = vorspann.strom AND vom selben rechner. 

+ 

+vom selben rechner: 

+  vx.rechnernummern = vorspann.rechnernummern. 

+ 

+daten: 

+  IF NOT blockin (vdr, opti.seiten nummer, distanz, nutzlaenge)

+  THEN quittieren (-wiederhole); LEAVE packeteingang 

+  FI; 

+  sequenz zaehlung;

+  IF neue seite kommt 

+  THEN 

+    vx.seiten nummer := vorspann.seiten nummer 

+  FI. 

+ 

+datenpacket:

+  IF sendung wartet auf zustellung THEN auffrischen ELSE daten holen FI.

+

+sendung wartet auf zustellung: typ (strom) = zustellung.

+

+auffrischen: zeit (strom) := 100; daten aus puffer entfernen.

+

+daten holen:

+  IF opti.sequenz >= vorspann.sequenz AND opti.sequenz < vorspann.sequenz+100

+  THEN 

+    IF opti.sequenz <> vorspann.sequenz

+    THEN empfangsreport ("Sequenzreset von "+text(opti.sequenz)+" auf "+

+                  text (vorspann.sequenz));

+         vx.sequenz := vorspann.sequenz;

+         vorabquittung regenerieren 

+    FI;

+    quittieren(ok); 

+    daten  ; 

+    abschluss testen

+  ELSE 

+    empfangsreport ("Sequenzfehler: soll "+text(vx.sequenz)+" ist "+ 

+            text(vorspann.sequenz));

+    quittieren (-wiederhole);

+    daten aus puffer entfernen

+  FI. 

+ 

+vorabquittung regenerieren: quittieren (ok).

+ 

+distanz: (opti.sequenz AND  packete pro seite minus 1 ) * nutzlaenge. 

+ 

+sequenz zaehlung: 

+  vx.sequenz INCR 1. 

+ 

+neue seite kommt: 

+(vx.sequenz AND packete pro seite minus1) = 0. 

+ 

+freie verbindungsnummer: 

+  INT VAR h strom :=0;

+  FOR strom FROM 1 UPTO maxstrom REP 

+    IF vx.strom = 0 THEN h strom := strom 

+    ELIF bekannter strom

+    THEN empfangsreport ("Reopen"); 

+         quit zaehler INCR 1;

+         forget (vdr);

+         LEAVE freie verbindungsnummer 

+    ELIF antwort auf call

+    THEN

+      typ (strom) := call pingpong;

+      forget (vdr);

+      LEAVE freie verbindungsnummer 

+    FI

+  PER; 

+  strom := h strom; 

+  IF strom = 0 THEN

+    error stop ("Zuviele simulatane Verbindungen") 

+  FI; 

+  typ(strom) := send wait.

+

+antwort auf call:

+  openblock.sendecode >= 0 AND

+  call aufruf AND vx.quelle = openblock.ziel AND vx.ziel = openblock.quelle. 

+

+abschluss testen: 

+  IF neue seite kommt AND vx.seiten nummer = -1 

+  THEN 

+    quittieren (-beende);

+    an ziel weitergeben 

+  FI. 

+ 

+an ziel weitergeben: 

+  IF tasknummerfrage  THEN taskfrage beantworten ;pufferplatz freigeben;

+  ELIF tasknamenfrage THEN name senden ;pufferplatz freigeben;

+  ELIF taskinfofrage  THEN task info senden;pufferplatz freigeben;

+  ELSE                     senden

+  FI. 

+

+pufferplatz freigeben: quitzaehler INCR 1.

+

+senden:

+  max 100 versuche; 

+  snr := strom;

+  IF NOT callaufruf THEN typ (strom) := zustellung FI;

+  q := vx.quelle;

+  z := vx.ziel;

+  ant := vx.sendecode;

+  dr := vdr;

+  LEAVE packet eingang.

+

+tasknummerfrage:opti.sendecode = -6.

+ 

+tasknamenfrage: opti.sendecode = -7.

+ 

+taskinfofrage: opti.sendecode = -8.

+

+max 100 versuche: zeit(strom) := 100.

+

+taskfrage beantworten:

+  BOUND TEXT VAR tsk := vdr; 

+  TEXT VAR save tsk := tsk;

+  forget (vdr); vdr := nilspace; 

+  BOUND TASK VAR task id := vdr;

+  disable stop;

+  task id := task(save tsk);

+  IF is error THEN 

+    clear error; enable stop;

+    forget (vdr); vdr := nilspace; 

+    BOUND TEXT VAR errtxt := vdr;

+    errtxt := text(station(myself))+"/"""+save tsk+""" gibt es nicht";

+    sendung starten (collector, opti.quelle, 2)

+  ELSE

+    enable stop;

+    sendung starten (collector, opti.quelle, 0)

+  FI.

+ 

+name senden: 

+  forget (vdr); vdr := nilspace;

+  tsk := vdr; 

+  disable stop;

+  tsk := nam (opti.ziel);

+  clear error; enable stop;

+  sendung starten (collector, opti.quelle, 0). 

+ 

+task info senden:

+  BOUND INT VAR ti code := vdr;

+  INT VAR ti cd := ti code;

+  forget (vdr); vdr := nilspace;

+  FILE VAR task inf := sequential file (output,vdr);

+  head line (task inf,"Station "+text(own)); 

+  task info (ti cd, task inf);

+  sendung starten (collector,opti.quelle,0).

+ 

+END PROC packet eingang;

+

+PROC quittieren(INT CONST code) : 

+  quellrechner wird zielrechner; 

+  ackpacket.code := code; 

+  ackpacket.head := stx quit;

+  ackpacket.strom := vx.strom;

+  blockout (workspace,1,dr verwaltungslaenge, ack laenge). 

+ 

+quellrechner wird zielrechner: 

+  ack packet.rechnernummern := vx.rechnernummern DIV 256 

+                               + own256. 

+ 

+END PROC quittieren; 

+ 

+END PACKET basic net;

diff --git a/system/net/1.7.5/src/callee b/system/net/1.7.5/src/callee
new file mode 100644
index 0000000..42d80da
--- /dev/null
+++ b/system/net/1.7.5/src/callee
@@ -0,0 +1,14 @@
+PACKET callee DEFINES callee:

+

+TASK PROC callee (TASK CONST t): 

+  IF im wait THEN trick 1 (t); trick 2 ELSE niltask FI.

+im wait: (status(t) AND 3) = 2. 

+END PROC callee; 

+ 

+PROC trick 1 (TASK CONST t): 

+  INT VAR x := pcb(t,11), y:=pcb(t,12); 

+END PROC trick1; 

+ 

+TASK PROC trick 2: TASK VAR calle; calle END PROC trick2; 

+ 

+END PACKET callee;

diff --git a/system/net/1.7.5/src/net inserter b/system/net/1.7.5/src/net inserter
new file mode 100644
index 0000000..d8c0856
--- /dev/null
+++ b/system/net/1.7.5/src/net inserter
@@ -0,0 +1,50 @@
+

+{ Inserter für EUMEL - Netz - Software;                         04.12.83

+  berücksichtigt EUMEL - Versionen 1.7.3 und 1.7.5, sowie Multi / Single } 

+ 

+ 

+INT VAR version :: id (0), cy :: 4;

+IF online THEN head FI;

+

+IF ich bin multi THEN insert multi net

+                 ELSE meldung an single

+FI.

+

+ich bin multi : (pcb (9) AND 255) > 1.

+

+insert multi net :

+   IF version >= 173 THEN IF version < 175 THEN insert and say ("callee") FI; 

+                          insert and say ("net report/M"); 

+                          insert and say ("basic net"); 

+                          insert and say ("net manager/M") 

+                     ELSE versionsnummer zu klein

+   FI.

+

+meldung an single : 

+   cursor (1, cy);

+   putline

+   ("Das EUMEL - Netz ist zur Zeit nur auf Multi - User - Versionen");

+   putline ("installierbar !").

+

+head :

+   page;

+   putline (" E U M E L  -  Netz  -  Inserter");

+   put     ("---------------------------------").

+ 

+versionsnummer zu klein : 

+   cursor (1, cy);

+   putline ("Netzsoftware erst ab Version 1.7.3 insertierbar !").

+ 

+PROC insert and say (TEXT CONST name of packet): 

+   IF online THEN cl eop (1, cy); 

+                  put ("Paket '" + name of packet + "' wird insertiert"); 

+                  line (2);

+                  cy INCR 1

+   FI;

+   insert (name of packet); 

+END PROC insert and say;

+

+PROC cl eop (INT CONST cx, cy) :

+   cursor (cx, cy);

+   out    (""4"")

+END PROC cl eop;

diff --git a/system/net/1.7.5/src/net manager-M b/system/net/1.7.5/src/net manager-M
new file mode 100644
index 0000000..bf64a68
--- /dev/null
+++ b/system/net/1.7.5/src/net manager-M
@@ -0,0 +1,302 @@
+PACKET net manager DEFINES start,stop,net manager,frei:

+TEXT VAR stand := "Netzsoftware vom  02.09.85";

+                 (*Heinrichs     *)

+ 

+LET

+    ack = 0,

+    nak = 1,

+    error nak = 2,

+    zeichen eingang = 4,

+    list code = 15,

+    fetch code = 11,

+    freigabecode = 29,

+    continue code = 100,

+    erase code = 14,

+    report code = 99, 

+

+    (* Typen von Kommunikationsströmen *)

+

+    send wait = 0,

+    zustellung = 1,

+    call pingpong = 2,

+    call im wait = 3,

+    call im abbruch = 4,

+    call in zustellung = 5;

+ 

+LET STEUER =

+      STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom,

+      INT  sequenz,

+           seiten nummer,

+      TASK quelle,ziel,

+      INT  sende code); 

+ 

+LET INFO = STRUCT (STEUER steuer, INT typ); 

+ 

+TASK VAR sohn;

+INT VAR strom,c.

+ 

+vx: v.steuer.

+ 

+PROC frei (INT CONST stat,lvl): 

+  DATASPACE VAR ds := nilspace;

+  BOUND STRUCT (INT x,y) VAR msg := ds;

+  msg.x := stat; msg.y := lvl;

+  INT VAR return;

+  call (/"net port", freigabecode, ds, return) ;

+  forget (ds)

+END PROC frei; 

+ 

+PROC net manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST

+                  ordertask):

+ 

+    IF order = report code

+    THEN 

+      forget ("report",quiet); 

+      copy (ds,"report"); 

+      forget (ds) 

+    ELSE 

+      IF ordertask < myself

+      OR order = list code

+      OR order > continue code

+      THEN

+        IF order = list code 

+        THEN

+          enable stop;

+          forget (ds); ds := old ("report");

+          FILE VAR ff := sequential file (output,ds);

+          putline (ff,stand);

+          putline (ff,"Rechner "+text(station(myself))+"  um "+time of day);

+          send (ordertask, ack, ds)

+        ELSE

+        free manager (ds,order,phase,order task) 

+        FI

+      ELSE

+      errorstop ("nur 'list' ist erlaubt")

+      FI

+    FI 

+END PROC net manager; 

+

+TASK VAR cd,stask;

+ROW 255 INT VAR erlaubt; 

+INT VAR i;

+FOR i FROM 1 UPTO 255 REP erlaubt (i) := 0 PER;

+

+PROC communicate: 

+  enable stop;

+  INT VAR scode;

+  DATASPACE VAR dr := nilspace;

+  neuer start (quit max);

+REP 

+  forget (dr); 

+  wait (dr, scode, stask); 

+  cd := collected destination;

+  IF zeichen da OR zeit abgelaufen 

+  THEN 

+    packet

+  ELIF cd = myself 

+  THEN 

+    netz info und steuerung 

+  ELSE

+    neue sendung (stask, cd, scode, dr)

+  FI 

+PER. 

+ 

+zeichen da: scode < 0 . 

+ 

+zeit abgelaufen: scode = ack AND cd = myself. 

+

+packet: 

+    TEXT VAR t := incharety; 

+    INT VAR snr, ant,err;

+    TASK VAR quelle, ziel;

+    snr := 0;

+    REP 

+      IF t = "" 

+      THEN 

+        zeitueberwachung (snr, quelle, ziel, ant, dr); 

+      ELSE

+        packet eingang (t, snr, quelle, ziel, ant, dr); 

+      FI;

+      IF snr > 0 

+      THEN 

+        IF ant > 5 AND erlaubt(station (quelle)) < 0 

+        THEN unerlaubt

+        ELSE 

+          send (quelle,ziel,ant,dr,err); 

+          fehlerbehandlung ;

+        FI

+      FI 

+    UNTIL snr = 0 OR zeichen da PER.

+

+fehlerbehandlung: 

+  IF ok oder ziel nicht da THEN loesche verbindung (snr) FI. 

+ 

+ok oder ziel nicht da: err=0 OR err=-1. 

+ 

+netz info und steuerung: 

+    IF scode = list code THEN   list status 

+  ELIF scode = erase code THEN strom beenden

+  ELIF scode = freigabe code AND stask = father THEN freigabelevel 

+  ELSE forget (dr); ablehnen ("nicht möglich") 

+  FI. 

+ 

+freigabelevel: 

+  BOUND STRUCT (INT stat,lvl) VAR lv := dr; 

+  IF lv.stat > 0 AND lv.stat < 256 THEN erlaubt (lv.stat) := lv.lvl FI; 

+  send (stask,ack,dr).

+ 

+unerlaubt: 

+  report ("Fremdzugriff von "+text(station (quelle))+" auf "+nam(ziel)

+          +" code "+text(ant)); 

+  loesche verbindung (snr). 

+ 

+strom beenden:

+  BOUND TEXT VAR stromtext := dr;

+  INT VAR erase strom := int (stromtext);

+  forget (dr);

+  strom := erase strom;

+  IF falsche stromnummer THEN ablehnen ("Strom gibt es nicht")

+  ELSE 

+    BOUND INFO VAR v := verbindung (strom); 

+  IF

+    stask = father OR stask = vx.quelle OR stask = vx.ziel

+  THEN

+    loeschen

+  ELSE ablehnen ("Nur Empfänger/Absender darf löschen")

+  FI

+  FI. 

+ 

+loeschen:

+  IF sendeeintrag  THEN

+    IF callee (vx.quelle) = vx.ziel THEN absender warnen FI;

+    loesche verbindung (strom)

+  ELSE

+    IF callee (vx.ziel) = vx.quelle THEN warnen FI; 

+    loesche verbindung (strom)

+  FI; 

+  dr := nilspace;

+  send (stask,ack,dr).

+

+absender warnen:

+ dr := nilspace;

+ send(vx.ziel,vx.quelle,1,dr,err) .

+

+warnen:

+ dr := nilspace;

+BOUND TEXT VAR errtxt := dr; errtxt:= "Station antwortet nicht"; 

+send (vx.quelle,vx.ziel,error nak, dr, err). 

+ 

+falsche stromnummer: strom < 1 OR strom > max verbindungsnummer.

+sendeeintrag: vx.rechnernummern DIV256 = station (myself).

+END PROC communicate;

+

+PROC ablehnen (TEXT CONST t):

+  DATASPACE VAR vdr := nilspace;

+  BOUND TEXT VAR errtxt := vdr; 

+  errtxt := t;

+  send (stask, error nak, vdr).

+END PROC ablehnen;

+

+PROC stop: 

+  disable stop; 

+  end (task ("net port"));

+  end (task ("net timer")); 

+  clear error;

+END PROC stop; 

+ 

+PROC list status: 

+ 

+  DATASPACE VAR ds := nilspace; 

+  FILE VAR f:=sequential file (output, ds);

+  FOR strom FROM 1 UPTO max verbindungsnummer REP 

+    BOUND INFO VAR v := verbindung (strom);

+    IF vx.strom <> 0 THEN info FI 

+  PER; 

+  send (stask, ack, ds). 

+ 

+info: 

+  put (f,"Strom "+text(strom)+" (sqnr"+text(vx.sequenz)+")"); 

+  IF sendeeintrag THEN sendeinfo ELSE empfangsinfo FI; 

+  line (f). 

+ 

+sendeeintrag: vx.rechnernummern DIV 256 = station(myself) . 

+ 

+sendeinfo: 

+  IF v.typ = call im wait THEN put (f,"erwartet Antwort von")

+  ELIF v.typ = call in zustellung THEN put (f,"Ziel busy. Zielstation:") 

+  ELIF v.typ = call im abbruch THEN put (f,"wird gelöscht bei Antwort von") 

+  ELSE put (f,"sendet an") 

+  FI; 

+  put (f,vx.rechnernummernMOD256); 

+  put (f,". Absender ist """+nam (vx.quelle)+"""."). 

+ 

+empfangsinfo: 

+  IF v.typ = zustellung THEN 

+  put (f,"Sendung noch nicht zustellbar")

+  ELSE

+  put (f,"empfängt von");

+  put (f,vx.rechnernummernDIV256); 

+  FI;

+  put (f,". Empfaenger ist """+nam (vx.ziel)+""".").

+END PROC list status; 

+

+

+PROC start (INT CONST chan):

+  c:=chan;

+  start

+END PROC start;

+INT VAR quitmax := 3;

+PROC start (INT CONST chan,quit):

+  quitmax := quit;

+  c:=chan;

+  start

+END PROC start;

+

+PROC start: 

+stop;

+IF exists ("report") THEN forget ("report") FI;

+FILE VAR s := sequential file (output,"report"); 

+putline (s," N e u e r   S t a r t "+time of day); 

+begin ("net port",PROC net io, sohn); 

+TASK VAR dummy;

+begin ("net timer",PROC timer,dummy);

+define collector (sohn) 

+END PROC start; 

+ 

+PROC timer: 

+  disable stop;

+  REP 

+    clear error;

+    DATASPACE VAR ds := nilspace;

+    pause (100); 

+    send (sohn, ack, ds) 

+  PER; 

+END PROC timer; 

+

+PROC net io:

+  disable stop; 

+  fetch ("report");

+  commanddialogue (FALSE); 

+  continue (c);

+  communicate;

+  TEXT VAR emsg := "++++++ "+error message +" Zeile "+text(errorline);

+  clear error; 

+  report (emsg);

+  save ("report");

+  end (myself) 

+END PROC net io; 

+

+put ("Netzkanalnummer:"); get (c);line;

+IF yes ("Ist der Netzkanal mit Flußkontrolle verdrahtet") THEN

+   quit max := 10

+ELSE

+   quit max := 3

+FI; 

+END PACKET net manager;

+ 

+ 

+start; global manager (PROC (DATASPACE VAR,INT CONST,INT CONST, TASK

+CONST) net manager ) 

diff --git a/system/net/1.7.5/src/net report-M b/system/net/1.7.5/src/net report-M
new file mode 100644
index 0000000..3ce67ff
--- /dev/null
+++ b/system/net/1.7.5/src/net report-M
@@ -0,0 +1,29 @@
+PACKET net report DEFINES report: 

+

+LET reportcode = 99;

+

+PROC report (TEXT CONST x):

+  report(x,"") 

+END PROC report;

+

+PROC report (TEXT CONST txt, info): 

+  IF storage (old("report")) > 20 THEN forget ("report",quiet) FI;

+  reportfile := sequential file (output, "report");

+  put (reportfile, date);

+  put (reportfile, time of day);

+  put (reportfile, txt); 

+  INT VAR i; 

+  FOR i FROM 1 UPTO length (info) REP 

+    INT VAR z :=  code (infoSUBi)  ;

+    IF z < 32 OR z > 126 

+      THEN put (reportfile,"%"+text(z)) 

+      ELSE put (reportfile,infoSUBi)

+    FI

+  PER; 

+  line (reportfile); 

+  DATASPACE VAR net report := old ("report"); 

+  send (father, report code , net report)

+END PROC report; 

+FILE VAR reportfile; 

+ 

+END PACKET net report;

diff --git a/doc/net/netzhandbuch b/system/net/1.8.7/doc/netzhandbuch
index 7083462..7083462 100644
--- a/doc/net/netzhandbuch
+++ b/system/net/1.8.7/doc/netzhandbuch
diff --git a/doc/net/netzhandbuch.anhang b/system/net/1.8.7/doc/netzhandbuch.anhang
index 17d1ece..17d1ece 100644
--- a/doc/net/netzhandbuch.anhang
+++ b/system/net/1.8.7/doc/netzhandbuch.anhang
diff --git a/doc/net/netzhandbuch.index b/system/net/1.8.7/doc/netzhandbuch.index
index 01d8a0f..01d8a0f 100644
--- a/doc/net/netzhandbuch.index
+++ b/system/net/1.8.7/doc/netzhandbuch.index
diff --git a/system/net/1.8.7/source-disk b/system/net/1.8.7/source-disk
new file mode 100644
index 0000000..5a39f6c
--- /dev/null
+++ b/system/net/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/11_austausch.img
diff --git a/net/basic net b/system/net/1.8.7/src/basic net
index c5e9278..c5e9278 100644
--- a/net/basic net
+++ b/system/net/1.8.7/src/basic net
diff --git a/net/net files-M b/system/net/1.8.7/src/net files-M
index ae6f9f3..ae6f9f3 100644
--- a/net/net files-M
+++ b/system/net/1.8.7/src/net files-M
diff --git a/net/net hardware interface b/system/net/1.8.7/src/net hardware interface
index 4e3466a..4e3466a 100644
--- a/net/net hardware interface
+++ b/system/net/1.8.7/src/net hardware interface
diff --git a/net/net inserter b/system/net/1.8.7/src/net inserter
index c89d0f0..c89d0f0 100644
--- a/net/net inserter
+++ b/system/net/1.8.7/src/net inserter
diff --git a/net/net manager b/system/net/1.8.7/src/net manager
index 05f530e..05f530e 100644
--- a/net/net manager
+++ b/system/net/1.8.7/src/net manager
diff --git a/net/net report b/system/net/1.8.7/src/net report
index ddc19d2..ddc19d2 100644
--- a/net/net report
+++ b/system/net/1.8.7/src/net report
diff --git a/net/netz b/system/net/1.8.7/src/netz
index c237ba2..c237ba2 100644
--- a/net/netz
+++ b/system/net/1.8.7/src/netz
diff --git a/system/net/unknown/doc/EUMEL Netz b/system/net/unknown/doc/EUMEL Netz
new file mode 100644
index 0000000..941e2ea
--- /dev/null
+++ b/system/net/unknown/doc/EUMEL Netz
@@ -0,0 +1,829 @@
+#type ("trium8")##limit (11.0)# 
+#start(2.5,1.5)##pagelength (17.4)# 
+#block# 
+#headeven# 
+ 
+%                        EUMEL-Netzbeschreibung 
+ 
+ 
+#end# 
+#headodd# 
+ 
+#center#Inhalt#right#% 
+ 
+ 
+#end# 
+ 
+#type ("triumb12")# 
+1. Einleitung 
+ 
+ 
+Teil 1: Netz einrichten und benutzen 
+#type ("trium8")# 
+ 
+1. Benutzung des Netzes 
+ 
+2. Hardwarevoraussetzungen 
+ 
+3. Einrichten des Netzes 
+ 
+4. Informationsmöglichkeiten 
+ 
+5. Eingriffsmöglichkeiten 
+ 
+6. Fehlerbehebung im Netz 
+ 
+#type ("triumb12")# 
+ 
+Teil 2: Arbeitsweise der Netzsoftware 
+#type ("trium8")# 
+ 
+1. Die Netztask 
+ 
+2. Protokollebenen 
+ 
+3. Stand der Netzsoftware 
+ 
+#page# 
+#headodd# 
+ 
+#center#Einleitung#right#% 
+ 
+ 
+#end# 
+ 
+#type("triumb12")# 
+1. Einleitung #type("trium8")# 
+ 
+ 
+Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit­
+einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das
+Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu­
+dehnen, daß Tasks verschiedener Stationen einander Datenräume zusenden
+können. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa­
+tisch das Netz aus: So ist es z.B. möglich 
+ 
+- von einer Station aus auf einer anderen zu Drucken, 
+ 
+- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, daß
+  PUBLIC dort ein free global manager ist, 
+ 
+- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk
+  defekt ist oder ein anderes Format hat). 
+ 
+Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. 
+ 
+ 
+#type("triumb12")# 
+Teil 1: Netz einrichten und benutzen 
+ 
+1. Benutzung des Netzes #type("trium8")# 
+#headodd# 
+ 
+#center#Teil 1: Netz einrichten und benutzen#right#% 
+ 
+ 
+#end# 
+ 
+   Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur
+   Verfügung: 
+ 
+ 
+1.1 
+ 
+   TASK OP / (INT CONST station, TEXT CONST taskname) 
+ 
+   liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. 
+ 
+   Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird
+   solange gewartet, bis das der Fall ist. 
+ 
+   Fehlerfälle: 
+ 
+     - task "..." gibt es nicht 
+ 
+       Die angeforderte Task gibt es in der Zielstation nicht. 
+ 
+     - Collectortask fehlt 
+ 
+       Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). 
+ 
+     - Station x antwortet nicht 
+ 
+       Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. 
+       Hinweis: Dieser Fehler wird angenommen, wenn eine Überwachungszeit
+                von ca. 30 Sekunden verschrichen ist, ohne daß Station x die
+                Taskidentifikation angeliefert hat. 
+ 
+   Beispiel: 
+ 
+     list (5/"PUBLIC") 
+ 
+     Dateiliste von PUBLIC auf Station 5 wird angefordert. 
+ 
+1.2 
+ 
+   TASK OP / (INT CONST station, TASK CONST task) 
+ 
+   liefert 
+ 
+   station / name (task) . 
+ 
+ 
+   Beispiel: 
+ 
+     list (4/archive) 
+ 
+ 
+1.3 
+ 
+   INT PROC station (TASK CONST task) 
+ 
+   liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. 
+ 
+   Beispiel: 
+ 
+     put (station (myself)) 
+ 
+     gibt die eigene Stationsnummer aus. 
+ 
+ 
+1.4 
+ 
+   PROC archive (TEXT CONST archivename, INT CONST station) 
+ 
+   dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. 
+ 
+   Beispiel: 
+ 
+   archive ("std", 4); list (4/archive) 
+ 
+   gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. 
+   Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations­
+            angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")#
+            archive). 
+   Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop­
+            pyformate umsetzen wollen. 
+ 
+ 
+1.5 
+ 
+   PROC free global manager 
+ 
+   dient dazu, die eigene Task über das Netz ansprechbar zu machen. Jede
+   andere Task im Netz kann dann die üblichen Manageraufrufe ('save', 'fetch',
+   u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop­
+   pelt ist. 
+ 
+   Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit
+   'maintenance' statt mit 'gib kommando'. 
+ 
+   Beispiel: 
+ 
+   An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")#
+   auf. Anschließend kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w.
+   machen. 
+ 
+ 
+1.6 
+ 
+  TEXT PROC name (TASK CONST t) 
+ 
+  Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, daß der
+  Name einer Task einer anderen Station über Netz angefordert wird. 
+ 
+  Fehlerfall: 
+ 
+  Station x antwortet nicht 
+ 
+ 
+ 
+ 
+#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# 
+ 
+2.1 Zwei Stationen 
+ 
+      Sie können zwei Stationen miteinander Vernetzen, wenn Sie dafür an jeder
+      Station eine V24-Schnittstelle zur Verfügung stellen. 
+ 
+      Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner­
+      kopplung (siehe Systemhandbuch 1.7 Teil 2). 
+ 
+2.2 Mehrere Stationen 
+ 
+      Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je
+      einer V24 an jeder Station noch je eine Netzanschlußbox. 
+ 
+      Jede Box besitzt eine V24-Schnittstelle zum Anschluß an die V24-
+      Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur
+      Verbindung der Boxen untereinander. 
+ 
+ 
+#type("triumb12")#3. Einrichten des Netzes #type("trium8")# 
+ 
+Hinweis: Dieses Kapitel ist nur für Systembetreuer wichtig. 
+ 
+3.1 Legen Sie Stationsnummern für die am Netz beteiligten Rechner fest (von 1 an
+    aufsteigend). 
+ 
+    Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box
+    und des zugeordneten Rechners müssen übereinstimmen. 
+ 
+ 
+3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie
+    das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie außerdem das
+    Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewählte Stationsnummer ist. 
+ 
+    Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, führen zu feh­
+             lerhaften Verhalten. Dies liegt daran, daß durch #on("bold")#define station#off("bold")# alle
+             Task-Id's geändert werden müssen, weil eine Task-Id u.a. die
+             Stationsnummer der eigenen Station enthält (siehe 2.3). TASK-
+             Variable, die noch Task-Id's mit keiner oder falscher Stationsnum­
+             mer enthalten, können nicht mehr zum Ansprechen einer Task
+             verwendet werden. 
+ 
+    Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet
+              beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen
+              Task-Id in einer TASK-Variablen, um sicherzustellen, daß nur der
+              Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")#
+              define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker
+              nicht mehr identifizieren, weil der Worker eine neue Task-Id er­
+              halten hat. Man muß daher den Worker löschen und mit dem
+              Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. 
+ 
+ 
+             Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines
+             frischen Systems von Archiv. 
+ 
+    Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den für das Netz vorgese­
+    henen Kanal auf 
+ 
+    - transparent 
+    - 9600 Baud (Standardeinstellung der Boxen) 
+    - RTS/CTS-Protokoll 
+    - großen Puffer 
+    - 8 bit 
+    - even parity 
+    - 1 stopbit. 
+ 
+    Falls diese Einstellungen nicht alle angeboten werden, klären Sie mit Ihrem
+    Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden können. 
+    Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn
+             der Eingabepuffer der Station groß genug ist. Die Anzahl simultan
+             laufender Netzkommunikationen ist dann auf 
+ 
+             puffergröße DIV 150 
+ 
+             begrenzt (bei Z80, 8086: 3; bei M20: 10). 
+   Hinweis: Es können auch andere Baudraten (2400, 4800, 19200) an der Box
+            eingestellt werden. 
+ 
+3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen­
+    station bei einem Zweistationennetz ohne Boxen) darauf, daß neben den
+    Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet
+    werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7
+    Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. 
+ 
+    Beispiel: 
+ 
+    Verbindung eines CSK-Systems mit der Box: 
+ 
+    Stecker                  Stecker 
+    Pin                      Pin 
+ 
+    2  <--------->           3 
+    3  <--------->           2 
+    4  <--------->           5 
+    5  <--------->           4 
+    7  <--------->           7 
+ 
+ 
+3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei­
+en 
+ 
+    net report/M 
+    basic net 
+    net manager/M. 
+ 
+    Beantworten Sie die Frage nach dem Kanal für das Netz und nach der Fluß­
+    kontrolle (RTS/CTS). 
+ 
+ 
+#type("triumb12")#4. Informationsmöglichkeiten #type("trium8")# 
+ 
+   In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# geführt in der Fehlersituationen des
+   Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list
+   (/"net")#off("bold")# angezeigt werden. 
+ 
+   In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine Übersicht über
+   die momentan laufenden Netzübertragungen der eigenen Station erhalten
+   werden. 
+ 
+ 
+#type("triumb12")#5. Eingriffsmöglichkeiten #type("trium8")# 
+#headodd# 
+ 
+#center#Eingriffsmöglichkeiten#right#% 
+ 
+ 
+#end# 
+ 
+5.1 Jede Task kann Sende- und Empfangsströme, die bei #on("bold")#list (/"net port")#off("bold")# gemel­
+    det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das
+    Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus
+    dem 'list') ist. 
+ 
+    Unberechtigte Löschversuche werden abgewiesen. 
+ 
+    Von der Task 'net' aus können jedoch damit beliebige Ströme abgebrochen
+    werden. 
+ 
+5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet
+    werden. Dabei werden alle augenblicklichen Netzkommunikationen gelöscht.
+    Die Tasks 'net port' und 'net timer' werden dabei gelöscht und neu eingerich­
+    tet. 
+ 
+    #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt
+    und maximal 'quit' Empfangsströme zugelassen. 'quit' ist auf 3 zu setzen,
+    wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). 
+ 
+ 
+#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# 
+ 
+   Fehler im Netz können sich verschiedenartig auswirken. Im Folgenden wird auf
+   einige Beispiele eingegangen: 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. 
+ 
+   Fehlermöglichkeiten: 
+ 
+   -  Station 4 gibt es nicht am Netz. 
+      Abhilfe: Richtige Station angeben. 
+ 
+   -  Station 4 ist nicht eingeschaltet. 
+      Abhilfe: Station 4 einschalten. Kommando erneut geben. 
+ 
+   -  Netztask an Station 4 ist nicht arbeitsfähig. 
+      Abhilfe: Kommando 'start' in der Task 'net'. 
+ 
+   -  Stationsnummern und Boxnummern stimmen nicht überein. 
+      Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). 
+ 
+   -  Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. 
+      Abhilfe: Verbindungen überprüfen. Durch Ansprechen einer dritten Station
+               kann oft schnell geklärt werden, welche Rechner/Box-Verbindung
+               defekt sein muß. 
+ 
+   -  Verbindung der Boxen untereinander defekt. 
+      Abhilfe: Fehlende Verbindung, Masseschluß und Dreher (keine 1:1 Ver­
+               bindung) überprüfen und beheben. 
+      Hinweis: Liegt z.B. ein Masseschluß vor, so kann es durchaus sein, daß
+               Boxen, die nicht in der Nähe des Masseschluß stehen noch mitei­
+               nander arbeiten können. Man kann aus der Tatsache, daß zwei
+               Boxen miteinander arbeiten können, also nicht schließen, daß man
+               nicht nach diesem Fehler suchen muß. 
+ 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. 
+ 
+ 
+   -  Station 4 ist während dieser Sendung zusammengebrochen. 
+      Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos
+               wird automatisch wieder aufgenommen. 
+ 
+   -  PUBLIC auf Station 4 ist nicht im Managerzustand. 
+      Abhilfe: PUBLIC in den Managerzustand versetzen. 
+ 
+ 
+      Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So
+               wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen.
+               Danach wird die Sendung gelöscht. Ist dies eingetreten, so muß
+               das list-Kommando erneut gegeben werden. 
+ 
+   -  Fehler in der Netzhardware. 
+      Überprüfen Sie, ob 
+ 
+      - die Boxen eingeschaltet sind, 
+      - die Bereitlampe blinkt (wenn nicht: RESET an der Box) 
+      - die V24-Kabel richtig stecken, 
+      - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5
+        poligen Diodenbuchsen). 
+ 
+ 
+   -  Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. 
+      Dieser wird im Report vermerkt. 
+      Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die
+               Netzsoftware neu gestartet. Alle Netzkommunikationen dieser
+               Station gehen verloren. 
+ 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. 
+ 
+   -  In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2)
+      nicht gegeben. 
+ 
+   -  Die Task 'net port' existiert nicht mehr. 
+      Abhilfe: Kommando 'start' in der Task 'net'. 
+ 
+ 
+   Beispiel: 
+ 
+   Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verfälscht. 
+ 
+   -  Die V24-Verbindung zur Box ist nicht in Ordnung. 
+      Abhilfe: Abstand zwischen Rechner und Box verkürzen; Baudrate ernie­
+               drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob
+               diese defekt ist. 
+      Hinweis: Die Verbindung zwischen den Boxen ist durch Prüfsummen abge­
+               sichert (Hardware). 
+ 
+#headodd# 
+ 
+#center#Teil 2: Arbeitsweise der Netzsoftware#right#% 
+ 
+ 
+#end# 
+#page# 
+#type("triumb12")# 
+ 
+Teil 2: Arbeitsweise der Netzsoftware 
+ 
+ 
+1. Die Netztask #type ("trium8")# 
+ 
+In diesem Kapitel wird beschrieben, wie eine Netztask in das System
+eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser
+Konzepte kann die ausgelieferte Netztask so geändert werden, daß sie
+beliebige andere Netzhardware unterstützt. Z.Zt. ist die Netzsoftware noch
+nicht so gegliedert, daß nur eine hardwareabhängige Komponente ausgetauscht
+werden muß. 
+ 
+Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem
+Rendevouskonzept: Die Zieltask einer Sendung muß empfangsbereit sein, wenn die
+Quelltask sendet. 
+ 
+Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden)
+und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer
+'code' und ein Datenraum 'dr' übergeben. 'code' muß >= 0 sein, da negative
+Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal
+gekoppelt ('continue'), so führt eine Zeicheneingabe auf diesem Kanal dazu,
+daß eine
+Sendung mit dem Code -4 ankommt. Die Eingabedaten müssen mit den üblichen
+Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der übermittelte Datenraum
+und die Absendertask sind dabei ohne Bedeutung und dürfen nicht interpretiert
+werden. 
+ 
+Die Prozedur 'send' hat einen Rückmeldeparameter, der besagt, ob die Sendung
+übermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann
+die Sendung nicht übermittelt werden. 
+ 
+ 
+Ein Entwicklungskriterium für das EUMEL-Netz war es, möglichst wenig Unter­
+stützung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit­
+gehend in ELAN programmiert werden kann. Dadurch ist es möglich eine (privili­
+gierte) Task mit der Netzabwicklung zu betrauen. 
+ 
+Zunächst wird auf die EUMEL0-Unterstützung eingegangen: 
+ 
+1.1. Es gibt die Prozedur 'define collector', mit der die für das Netz verantwort­
+     liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im
+     folgenden Collector genannt. 
+ 
+1.2. Es gibt die Prozedur 'define station', die für den Rechner eine Stationsnum­
+     mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un­
+     terschieden. Das Einstellen bewirkt, daß für alle Tasks die Stationsnummer in
+     ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK
+     annehmen kann). 
+ 
+1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B.
+     'station (myself)' die Stationsnummer des eigenen Rechners. 
+ 
+1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station
+     (ziel) <> station (myself)), wird auf die Collectortask geleitet. 
+ 
+1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die
+     eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. 
+ 
+1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der
+     Zieltask eine beliebige andere Task als Absender vorzumachen. 
+ 
+1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein­
+     gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver­
+     mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von
+     EUMEL0 an den derzeitigen Collector geschickt. 
+ 
+Ein Collector kann also auf drei Wegen von den übrigen Tasks desselben Rechners
+Sendungen erhalten: 
+ 
+  1. Über ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der­
+     zeitige Collector ist), 
+ 
+  2. über ein Send an die Task 'collector' (s.u.) und 
+ 
+  3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen
+     Rechner). 
+ 
+Der Collector kann diese Fälle anhand von 'collected destination' unterscheiden. 
+ 
+Die Punkte 1.4...1.6 dienen dazu, den Collector für über Netz kommunizierende
+Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von
+Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum kümmern
+müssen, ob eine Sendung übers Netz geht oder im eigenen Rechner bleibt. 
+ 
+Wenn ein Datenraum an einen anderen Rechner geschickt wird, muß der gesamte
+Inhalt (z. Zt. max. 1 MB) übertragen werden. Dies macht bei der üblichen Netz­
+hardware eine Zerlegung in Packete nötig (siehe Systemhandbuch 173, Teil 4,
+Punkt 5). Für Netze über V24-Kanäle stehen spezielle Blockbefehle zur verfü­
+gung: 
+ 
+1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) 
+ 
+   Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zurückgemeldet,
+   wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert).
+   Bearbeitet werden die Bytes 
+ 
+      'seite' * 512 + 'abstand' 
+ 
+   bis maximal 
+ 
+      'seite' * 512 + 'abstand' + 'anzahl' - 1 
+ 
+  Der Kanal, an den die Task gekoppelt ist, wird dabei über Stream-IO (d.h.
+  'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. 
+ 
+  Hinweis: Die Anforderung darf nicht über Seitengrenze gehen, d.h. 
+ 
+  'abstand' + 'anzahl' <= 512 
+ 
+  muß erfüllt sein. 
+ 
+ 
+Eine Netzsendung läuft wie folgt ab: 
+ 
+Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. 
+ 
+1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, daß
+   die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id
+   enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de­
+   fine collector' kennt, umgeleitet. 
+ 
+2. Die Task Collector empfängt über 'wait' den Datenraum, den Sendecode und
+   die Absendertask q. Die Zieltask z erfährt sie durch 'collected destination'. 
+ 
+3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta­
+   tionsnummer ja 'station(z)' ist, auf und Übermittelt diesem Sendecode, Quelltask
+   (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN
+   geschrieben sind, können sie an beliebige Netzhardware und Protokolle ange­
+   paßt werden. 
+ 
+4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die
+   Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q
+   als Absender der Sendung. 
+ 
+Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) muß der Collector noch
+spezielle Funktionen beherrschen. Diese sind 
+ 
+   der /-Operator (Taskname in Task-Id wandeln) und 
+   die name-Prozedur (Task-Id in Namen wandeln). 
+ 
+Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der
+Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe
+Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta­
+tion in Verbindung, damit dieser die Task-Id ermittelt und zurückschickt. Der
+eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der
+die Task-Id enthält. 
+ 
+Umgekehrt läuft 'name' ab: Wenn die Task-Id von einer fremden Station ist,
+schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id
+steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der
+Task aus der Task-Id und läßt sich vom entsprechenden Collector den Tasknamen
+geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum übergeben. 
+ 
+#type ("triumb12")#2. Ebenen #type("trium8")# 
+ 
+In diesem Kapitel werden die Protokollebenen für das Netz beschrieben, wie
+sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer
+Netzhardware müssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung
+der im vorigen Kapitel beschriebenen Randbedingungen können auch die höheren
+Ebenen geändert werden. 
+ 
+ 
+2.1 Physikalische Ebene 
+ 
+    2.1.1  Station <--> Box 
+ 
+           V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. 
+ 
+    2.1.2  Box <--> Box 
+ 
+           RS422 über 2 verdrillte Leitungspaare (Takt und Daten). 
+ 
+2.2 Verbindungsebene 
+ 
+    2.2.1  Station <--> Box 
+ 
+           Asynchron 
+           8 Bit 
+           Even Parity 
+           2400/4800/9600/19200 Baud (einstellbar über Lötbrücken) 
+ 
+    2.2.2  Box <--> Box 
+ 
+           SDLC 
+           400 KBaud 
+ 
+2.3 Netzebene 
+ 
+    2.3.1  Station <--> Box 
+ 
+           Telegrammformat:  STX, <n>, <ziel>, <quelle>, <(n-4) byte> 
+ 
+           <n> ist Längenangabe ( 8 <= n <= 160) 
+           <ziel>, <quelle> sind Stationsnummern. Diese müssen an den je­
+           weiligen Boxen über Lötbrücken eingestellt sein. 
+ 
+           Box --> Station: 
+ 
+           Ein Telegramm kommt nur bei der Station an, bei deren Box die
+           Nummer <ziel> eingestellt ist. Dadurch ist ein Mithören fremder
+           Übertragungen nicht möglich (Datenschutz). 
+ 
+           Zwischen Telegrammen können Fehlermeldungen der Box (Klartext)
+           übermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er­
+           wartet wurde, aber 'x' von der Station ankommt). 
+ 
+           Station --> Box: 
+ 
+           Ein Telegramm wird nur abgeschickt, wenn <quelle> mit der einge­
+           stellten Nummer übereinstimmt (Datenschutz: Man kann nicht eine
+           beliebige Station zu sein vorschwindeln, es sei denn man hat physi­
+           schen Zugriff zur Box und stellt dort die Stationsnummer um). 
+ 
+    2.3.2  Box <--> Box 
+ 
+           Telegrammformat: FRAME, <ziel>, <quelle>, <daten> ,
+           <CRC-Code> 
+ 
+           Eine Längenangabe ist nicht nötig, da SDLC eine Rekonstruktion der
+           Länge erlaubt. 
+ 
+           Telegramme mit falschen CRC-Code werden vernichtet. Auf höheren
+           Ebenen muß dies durch Zeitüberwachung erkannt und behandelt
+           werden. 
+ 
+ 
+2.4 Transportebene 
+ 
+    Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht,
+    und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). 
+ 
+    Der im 'send' angegebene Datenraum wird als Folge von Seiten (im
+    EUMEL-Sinne: Pagingeinheit und Allokiereinheit) übermittelt, wobei jede Seite
+    noch in 64 Byte große Stücke zerlegt wird. Es werden nur echt allokierte Seiten
+    übermittelt. Um nicht jedes Telegramm voll qualifizieren zu müssen, wird
+    zunächst eine Art virtuelle Verbindung durch ein OPEN-Telegramm eröffnet.
+    Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch
+    QUIT-Telegramme quittiert, um folgende Funktionen zu ermöglichen: 
+ 
+    Flußkontrolle (z.B. Zielrechner langsam) 
+    Wiederaufsetzen (verlorene Telegramme) 
+    Abbruch (z.B. weil Zieltask inzwischen beendet). 
+ 
+    Ein CLOSE-Telegramm ist nicht nötig, da das letzte DATA-Telegramm als
+    solches erkannt werden kann (siehe unten). 
+ 
+    2.4.1 OPEN-Telegramm 
+ 
+          STX, 20, <ziel>, <quelle>, <strom>, <sequenz>, <seite>, 
+          <quelltask>, <zieltask>, <code> 
+ 
+          <ziel>, <quelle> siehe 2.3.1 
+ 
+          <strom>      Die Stromnummer identifiziert die virtuelle Verbindung.
+                       Sie muß in den QUIT-Telegrammen angegeben wer­
+                       den. 
+ 
+          <sequenz>    -1 (Kennzeichen für OPEN) 
+ 
+          <seite>      Nummer der ersten echt allokierten Seite des Datenra­
+                       ums (=-1, falls Nilspace) 
+ 
+          <quelltask>  Taskid der sendenden Task 
+ 
+          <zieltask>   Taskid der empfangenden Task 
+ 
+          <code>       Wert des im 'send' angegebenen Codes. 
+ 
+    2.4.2 DATA-Telegramm 
+ 
+          STX, 74, <ziel>, <quelle>, <sequenz>, <seite>, <64 byte> 
+ 
+          <sequenz>    wird von Telegramm zu Telegramm hochgezählt. Dient
+                       der Überwachung gegen verlorengegangene Telegramme
+                       bzw. durch Zeitüberwachung verdoppelter Telegramme. 
+ 
+          <seite>      Nummer der x.ten echt allokierten Seite des Datenra­
+                       ums. (x = (<sequenz>+16) DIV 8). 
+ 
+          <64 byte>    Nutzinformation. Diese gehört zur Adresse a des Daten­
+                       raums. 
+ 
+                       a = N (<sequenz> DIV 8 + 1) * 512 
+                           + (<sequenz> MOD 8) * 64 
+ 
+                       wobei N (x) die Nummer der x.ten Seite ist. 
+ 
+                       Aus den Formeln ergibt sich, daß diese Nummer schon in
+                       einem vorhergehenden DATA/OPEN-Telegramm über­
+                       mittelt wurde (im Feld <seite>). 
+ 
+    2.4.3 QUIT-Telegramm 
+ 
+          STX, 8, <ziel>, <quelle>, <strom>, <quit> 
+ 
+          <strom>      muß die Stromnummer sein, die in dem OPEN/DATA-
+                       Telegramm stand, das quittiert wird. 
+ 
+          <quit>       0 :  ok. Nächstes Telegramm schicken. 
+ 
+                       -1:  Übertragung neu starten (mit OPEN), weil die
+                            Empfangsstation das OPEN nicht erhalten hat. 
+ 
+                       -2:  Übertragung ca. 20 Telegramme zurücksetzen. 
+ 
+                       -3:  Übertragung abbrechen. 
+ 
+ 
+2.5 Vermittlungsebene 
+ 
+    Diese Ebene ist dafür zuständig, Tasknamen von Task auf anderen Stationen
+    in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im
+    entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als <code>
+    eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die
+    Aufgaben selbst ab, sodaß es dabei nicht nötig ist, irgendeine Taskid der
+    Zielstation zu kennen. 
+ 
+    Dieses Verfahren ist möglich, weil im 'send' nur positive Codes erlaubt sind. 
+ 
+2.6 Höhere Ebenen 
+ 
+    Höhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem
+    Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der
+    Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese
+    Task (bei der Variante 'free global manager') auf einer beliebigen Station im
+    Netz liegen. Wegen des Rendevous-Konzepts können beliebige Sicherheit­
+    strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von
+    großen Wert ist z.B., daß man ohne weiteres das Archiv (Floppylaufwerk) einen
+    anderen Station anmelden und benuzten kann, wodurch eine einfache Kon­
+    vertierung von Floppyformaten möglich ist. Dies ist möglich, weil auch die Ar­
+    chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. 
+ 
+ 
+#type("triumb12")# 
+Bemerkungen#type("trium8")# 
+ 
+Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu
+entfernen. Die Ebene 4 überwacht den Netzverkehr sowieso über Timeouts, die
+eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. 
+ 
+Da bei der sendenden Station der ganze Datenraum zur Verfügung steht, ist eine
+Fenstertechnik (wie bei HDLC) nicht nötig. Es kann zu jedem Zeitpunkt um beliebig
+viele Telegramme zurückgesetzt werden. 
+ 
+Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen
+der Insert/Delete-Möglichkeiten, ohne den Rest der Datei zu schieben), ist es ein
+hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL-
+Netz zu senden. Für solche Zwecke muß noch eine einfachere Dateistruktur defi­
+niert werden und entsprechende Dateikonverter erstellt werden. 
+ 
+ 
+ 
+#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# 
+ 
+Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# über das Netz ab, wenn die
+Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge­
+kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen­
+derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). 
+ 
+Nicht unterstützt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese
+funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist
+die Zieltask länger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die
+Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")#
+pingpong#off("bold")#: Rückmeldung -2). 
+ 
+Wegen dieser Einschränkung kann man z.B. ein sicheres Drucken von Station a
+auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf
+Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings
+sowieso sinnvoll, damit man 
+ 
+- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx",
+4/printer);) und 
+- nicht zu warten braucht, bis die Datei übers Netz gesendet ist. 
+
+
diff --git a/printer/dotmatrix24/readme b/system/printer-24nadel/0.9/doc/readme
index d526aa3..d526aa3 100644
--- a/printer/dotmatrix24/readme
+++ b/system/printer-24nadel/0.9/doc/readme
diff --git a/system/printer-24nadel/0.9/source-disk b/system/printer-24nadel/0.9/source-disk
new file mode 100644
index 0000000..2ed06c0
--- /dev/null
+++ b/system/printer-24nadel/0.9/source-disk
@@ -0,0 +1,3 @@
+grundpaket/07_std.printer_24_nadel.img
+187_ergos/05_std.printer_24nadel.img
+187_ergos/06_std.printer_24nadel.img
diff --git a/printer/dotmatrix24/beschreibungen24 b/system/printer-24nadel/0.9/src/beschreibungen24
index e3d2fa9..e3d2fa9 100644
--- a/printer/dotmatrix24/beschreibungen24
+++ b/system/printer-24nadel/0.9/src/beschreibungen24
diff --git a/printer/dotmatrix24/fonttab.brother b/system/printer-24nadel/0.9/src/fonttab.brother
index 2251e18..2251e18 100644
--- a/printer/dotmatrix24/fonttab.brother
+++ b/system/printer-24nadel/0.9/src/fonttab.brother
diff --git a/printer/dotmatrix24/fonttab.epson.lq1500 b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500
index 1b4c6a6..1b4c6a6 100644
--- a/printer/dotmatrix24/fonttab.epson.lq1500
+++ b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500
diff --git a/printer/dotmatrix24/fonttab.epson.lq850 b/system/printer-24nadel/0.9/src/fonttab.epson.lq850
index 7a6d2f0..7a6d2f0 100644
--- a/printer/dotmatrix24/fonttab.epson.lq850
+++ b/system/printer-24nadel/0.9/src/fonttab.epson.lq850
diff --git a/printer/dotmatrix24/fonttab.nec.p5 b/system/printer-24nadel/0.9/src/fonttab.nec.p5
index 9910da6..9910da6 100644
--- a/printer/dotmatrix24/fonttab.nec.p5
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p5
diff --git a/printer/dotmatrix24/fonttab.nec.p5.new b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new
index 9804bd5..9804bd5 100644
--- a/printer/dotmatrix24/fonttab.nec.p5.new
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new
diff --git a/printer/dotmatrix24/fonttab.nec.p6+ b/system/printer-24nadel/0.9/src/fonttab.nec.p6+
index b209e81..b209e81 100644
--- a/printer/dotmatrix24/fonttab.nec.p6+
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p6+
diff --git a/printer/dotmatrix24/fonttab.oki b/system/printer-24nadel/0.9/src/fonttab.oki
index 2251e18..2251e18 100644
--- a/printer/dotmatrix24/fonttab.oki
+++ b/system/printer-24nadel/0.9/src/fonttab.oki
diff --git a/printer/dotmatrix24/fonttab.toshiba.p321 b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321
index 452afca..452afca 100644
--- a/printer/dotmatrix24/fonttab.toshiba.p321
+++ b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321
diff --git a/printer/dotmatrix24/inserter b/system/printer-24nadel/0.9/src/inserter
index 442075d..442075d 100644
--- a/printer/dotmatrix24/inserter
+++ b/system/printer-24nadel/0.9/src/inserter
diff --git a/printer/dotmatrix24/module24 b/system/printer-24nadel/0.9/src/module24
index a4957c2..a4957c2 100644
--- a/printer/dotmatrix24/module24
+++ b/system/printer-24nadel/0.9/src/module24
diff --git a/printer/dotmatrix24/printer.24.nadel b/system/printer-24nadel/0.9/src/printer.24.nadel
index 579f67f..579f67f 100644
--- a/printer/dotmatrix24/printer.24.nadel
+++ b/system/printer-24nadel/0.9/src/printer.24.nadel
diff --git a/system/printer-24nadel/schulis-mathe-1.0/doc/readme b/system/printer-24nadel/schulis-mathe-1.0/doc/readme
new file mode 100644
index 0000000..d526aa3
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/doc/readme
@@ -0,0 +1,320 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 
+#head# 
+Treiber-Installations-Programm   #right#Seite % 
+für 24-Nadel-Matrixdrucker   #right#23.12.1988 
+ 
+ 
+#end# 
+#on("u")#Dokumentation zum Treiber-Installations-Programm für 24-Nadel-
+Matrixdrucker#off("u")# 
+ 
+#on("u")#Inhalt:#off("u")# 
+ 
+1. Installations- und Gebrauchsanleitung 
+2. Druckertreiber-Auswahl 
+3. Steuerungsmöglichkeiten und Spezialfeatures 
+4. Weitere Hinweise 
+ 
+ 
+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 
+ 
+#on("u")#Einrichten#off("u")# 
+So wird das Treiber-Installationsprogramm eingerichtet: 
+ 
+       SV drücken 
+ 
+    nach 'gib supervisor kommando:' 
+ 
+       begin("PRINTER","SYSUR") 
+ 
+    in der Task "PRINTER" (nach 'gib kommando'): 
+ 
+       archive ("std.printer") 
+       fetch ("printer.24.nadel",archive) 
+       check off 
+       insert ("printer.24.nadel") 
+ 
+Das Programm wird dann insertiert. 
+ 
+#on("u")#Druckerkanal#off("u")# 
+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker
+über Parallelschnittstelle betrieben wird, ist die Kanalnummer
+meistens 15. 
+ 
+#on("u")#Menüsystem#off("u")# 
+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.
+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste
+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier
+den passenden Typ aus! 
+Das Installationsprogramm zeigt nun einige Informationen zu dem ange­
+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­
+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt
+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­
+ber betrieben werden soll. 
+ 
+Hinweise zu Konfigurationsangaben: 
+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion
+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf
+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So
+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu
+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze
+   weiterdruckt. 
+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­
+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker
+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln
+   für die Konfiguration: 
+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 
+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­
+     lenvorschub durchführen. 
+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 
+ 
+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht
+     achten. 
+ 
+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 
+ 
+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des
+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 
+ 
+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­
+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,
+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­
+stellungen können nachträglich in der Task "PRINTER" mit den entspre­
+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte
+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­
+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­
+ments verändert werden (direkte Druckeranweisung \#"..."\#). 
+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 
+ 
+ 
+#on("b")#2. Druckertreiber-Auswahl#off("b")# 
+ 
+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 
+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­
+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker
+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 
+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im
+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),
+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.
+(Viele Drucker verfügen über EPSON LQ-1000 oder IBM Grafikdrucker bzw.
+Proprinter-Eumulationen.) 
+Eine der beiden Anpassungen 'EPSON LQ-1050' oder 'OKI ML-393
+IBM-kompatibel' müßte immer einen (Minimal-) Betrieb ermöglichen (wobei die
+Verwendung der Proportionalschrift bzw. der doppelt hohen Schriften u. U.
+nicht funktioniert). 
+ 
+ 
+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 
+ 
+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.
+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 
+Die Einstellungen können über 
+- Steuerprozeduren 
+- Materialanweisungen bzw. 
+- direkte Druckeranweisungen 
+vorgenommen werden. 
+ 
+#on("u")#Steuerprozeduren#off("u")# 
+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten
+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")
+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in
+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 
+ 
+PROC papersize (REAL CONST breite, länge) 
+    Dient zur Einstellung der Größe der physikalisch beschreibbaren
+    Fläche. 
+    Beispiel:  papersize (20.32, 30.48) 
+               (Standardeinstellung für Endlospapier 8 Zoll breit und
+               12 Zoll lang) 
+ 
+PROC papersize 
+    Informationsprozedur 
+ 
+PROC top margin (REAL CONST margin) 
+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­
+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser
+    Prozedur die Länge des oberen Randes, den der Drucker nicht be­
+    drucken kann, in cm angegeben werden. 
+    Beispiel:  top margin (2.0) 
+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm
+               nicht bedruckbar sind.) 
+ 
+REAL PROC top margin 
+    Informationsprozedur 
+ 
+PROC std speed (TEXT CONST speed) 
+    Parameter: slow, fast 
+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in
+    Blanks (fast). 
+    Beispiel:  std speed ("slow") 
+ 
+TEXR PROC std speed 
+    Informationsprozedur 
+ 
+PROC std quality (TEXT CONST quality) 
+    übliche Parameter: draft, nlq 
+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-
+    Qualität 
+    Beispiel:  std quality ("draft") 
+ 
+TEXT PROC std quality 
+    Informationsprozedur 
+ 
+PROC std typeface (TEXT CONST typeface) 
+    übliche Parameter: roman, sansserif, courier 
+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im
+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 
+    Beispiel: std typeface ("roman") 
+ 
+TEXT PROC std typeface 
+    Informationsprozedur 
+ 
+PROC paper feed (TEXT CONST name) 
+    übliche Parameter: tractor, sheet, schacht1, schacht2 
+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 
+    Beispiel:  paper feed ("sheet") 
+ 
+TEXT PROC paper feed 
+    Informationsprozedur 
+ 
+ 
+#on("u")#Materialanweisungen \#material("...")\##off("u")# 
+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und
+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben
+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­
+stellten Standardwerten. Diese werden durch die Materialanweisung aber
+nicht geändert.) 
+ 
+Beispiel:  \#material("nlq")\# 
+           sorgt bei entsprechendem Treiber dafür, daß das gesamte
+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal
+           wie 'std quality' eingestellt ist. 
+ 
+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­
+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung
+erscheinen. Beispiel:  \#material("sheet;draft")\# 
+ 
+ 
+#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# 
+gelten ab der Position, an der sie in der Datei auftreten. Sie haben
+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und
+Materialeinstellungen. 
+ 
+Beispiel:  \#"draft"\# 
+           schaltet (bei entsprechendem Treiber) auf Datenverar­
+           beitungs-Qualität, egal welche Standardeinstellung vorliegt
+           und welche Materialanweisung gegeben wurde. 
+ 
+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen
+werden.#off("b")# Also:  \#"nlq"\#\#"sansserif"\# 
+ 
+ 
+#on("u")#Wichtig#off("u")# 
+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen
+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben
+  berücksichtigt! Also:  \#"nlq"\# und keinesfalls \#"NLQ"\#!!! 
+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und
+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann
+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse
+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen
+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die
+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.
+  für beide Spalten) unerwünscht erhalten bleibt. 
+ 
+ 
+#on("u")#Tabelle#off("u")# 
+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­
+lungen erfolgen können. 
+ 
+#type("17")# 
+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 
+ 
+#on("u")#                                                                                          #off("u")# 
+ 
+Positionierung     std speed             slow, fast              ------ 
+                     slow, fast 
+ 
+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 
+                     z.B. draft, nlq 
+ 
+Schriftart         std typeface          z.B. roman,             z.B. roman, 
+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 
+                     sansserif, courier 
+ 
+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 
+einzug               z.B. tractor,       schacht2                schacht2 
+                     sheet, 
+                     schacht1, schacht2 
+ 
+Farbdruck          ------                ------                  z.B. schwarz, 
+                                                                 rot, blau, 
+                                                                 violett, gelb 
+                                                                 orange, grün 
+ 
+ 
+ 
+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 
+ 
+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 
+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb
+des Codes 127 einige internationale Zeichen zur Verfügung gestellt
+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 
+Bei den Treibern der vorliegenden Version gilt folgendes: 
+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-
+  Zeichensatz (sofern möglich) unterstützt. 
+- Der Code 252 liefert das Paragraphzeichen. 
+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes
+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des
+  IBM-Grafikzeichensatzes. 
+ 
+ 
+#on("u")#Hinweis zu Proportionalschriften#off("u")# 
+Bei Proportionalschriften kann die Modifikation \#on("i")\# zu Problemen
+führen (z.B. beim Blocksatz), wenn die kursiven Zeichen andere
+Proportionalbreiten haben.
+ 
+#on("u")#Hinweis zur Modifikation on/off("b") bzw. on/off("r")#off("u")# 
+Die meisten 24-Nadel Drucker verfügen sowohl über einen horizontalen als
+auch über einen vertikalen Schattendruck. Diese beiden Druckarten können
+mit der Modifikation on("b") (bold) bzw. on("r") (eigentlich für reverse
+gedacht) eingeschaltet werden.
+
+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 
+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­
+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 
+ 
+   Am Drucker: 
+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug
+   schalten (siehe Druckerhandbuch!). 
+ 
+   In der Druckspooltask (meist 'PRINTER'): 
+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­
+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für
+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed
+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 
+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­
+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­
+   len. 
+   Beispiel:  papersize (21.0, 29.7) 
+              (für DIN A4-Blätter) 
+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­
+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß
+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem
+   Druckertreiber mitgeteilt werden. 
+   Beispiel:  top margin (1.5) 
+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine
+   Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) 
+ 
+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren
+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien
+   ein genügend großer y-Wert für die Startposition eingestellt wird
+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der
+   ersten Zeile zu Überschreibungen. 
+ 
+ 
+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben
+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 
+
+
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24
new file mode 100644
index 0000000..e3d2fa9
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24
@@ -0,0 +1,62 @@
+ 
+(*************************************************************************)
+(*                                            Stand   :  3. 1.89         *)
+(*  Beschreibungen-Datei für 24-Nadel-Drucker Version : 0.9              *)
+(*                                            Autor   : hjh              *)
+(*************************************************************************)
+ 
+$necp5p7$ 
+begin;headnecp5p7;declarations;feed; 
+open;opendoch;opendocp5p7;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+
+$necp6$ 
+begin;headnecp6;declarations;feed; 
+open;opendoch;opendocp6;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+ 
+$necp6+$
+begin;headnecp6+;declarations;speed;topmargin;typefacep6+;feed; 
+open;opendoch;initspeed;opendocp6+;openpage;close;closepage; 
+execute;cmdp6+;crs;move;stdmove;onoff;typep6+;end
+
+$epsonlq850$
+begin;headlq850;declarations;speed;topmargin;typefacelq850;feed; 
+open;opendoch;initspeed;opendoclq850;openpage;close;closepage; 
+execute;cmdlq850;crs;move;stdmove;onoff;typeplq850;end
+
+$epsonlq1500$
+printerlq1500;end
+ 
+$oki390/391$
+begin;headoki390/391;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end
+
+$oki393/393Ceps$
+begin;headoki393/393Ceps;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end 
+ 
+$oki393/393Cibm$
+begin;headoki393/393Cibm;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokiibm;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokiibm;end 
+ 
+$toshp321$ 
+begin;headtoshp321;declarations;speed;feed; 
+open;opendochtosh;initspeed;opendoctosh;openpagetosh;close;closepagetosh; 
+execute;cmdtosh;crs;move;stdmove;onoff;typetosh;end 
+ 
+$starnb24$ 
+begin;headstarnb24;declarations;speed;topmargin;typefacestar;feedschacht; 
+open;opendoch;initspeed;opendocstar;openpage;close;closepage; 
+execute;cmdstar;crs;move;stdmove;onoff;typestar;end 
+ 
+$brotherm1724l$ 
+begin;headbrotherm1724l;declarations;speed;topmargin;feed; 
+open;opendoch;initspeed;opendocbrother;openpage;close;closepage; 
+execute;cmdtosh;crs;move;stdmove;onoff;typebrother;end 
+ 
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500
new file mode 100644
index 0000000..1b4c6a6
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850
new file mode 100644
index 0000000..7a6d2f0
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5
new file mode 100644
index 0000000..9910da6
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new
new file mode 100644
index 0000000..9804bd5
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+
new file mode 100644
index 0000000..b209e81
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321
new file mode 100644
index 0000000..452afca
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/inserter b/system/printer-24nadel/schulis-mathe-1.0/src/inserter
new file mode 100644
index 0000000..1a165e0
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/inserter
@@ -0,0 +1,793 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      clear error; 
+      no error := no error CAND
+                  (pr channel <> channel (myself)) CAND  
+                  (pr channel > 1)                 CAND  
+                  (pr channel < 17); 
+      
+      IF NOT no error
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      enable stop 
+    UNTIL no error PER; 
+    IF exists task ("canal " + text (pr channel)) 
+      THEN end (/ ("canal " + text (pr channel))); 
+    FI; 
+ 
+. inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+(*  putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+*) 
+(*  put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+*) 
+    putline ("  Generierung beendet."); 
+    putline ("  Weiter: Bitte Taste drücken"); 
+    WHILE incharety <> "" REP ENDREP; 
+    REP UNTIL incharety <> "" ENDREP; 
+    unlink; 
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line; 
+    pause(50); 
+    unlink. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  TEXT VAR buffer;
+(*line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer)*). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/module24 b/system/printer-24nadel/schulis-mathe-1.0/src/module24
new file mode 100644
index 0000000..a4957c2
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/module24
@@ -0,0 +1,1554 @@
+
+(*************************************************************************) 
+(*                                            Stand   : 03. 1.89         *) 
+(*   Module-Datei für 24-Nadel-Drucker        Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+$begin$ 
+PACKET printer driver 
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+               paper size,
+               std quality,
+
+$headnecp6$    paper feed:
+(* Treiber fuer NEC P6, automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp5p7$  paper feed:
+(* Treiber fuer NEC P5, P7 , automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp6+$   std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) 
+ 
+
+$headlq850$    std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) 
+ 
+$headbrotherm1724l$ 
+               std speed, 
+               top margin, 
+               paper feed: 
+INT VAR vertical factor := 1; 
+(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) 
+ 
+$headoki390/391$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 390/391  ,automatisch generiert *) 
+ 
+$headoki393/393Ceps$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) 
+ 
+$headoki393/393Cibm$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) 
+ 
+$headtoshp321$   std speed, 
+                 paper feed: 
+(* Treiber für TOSHIBA P321, automatisch generiert *) 
+ 
+$headstarnb24$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) 
+ 
+$declarations$
+INT VAR font nr, font bits, modification bits, 
+        blankbreite, x rest, high, low, steps;
+REAL VAR x size, y size;
+TEXT VAR buffer :: "";
+BOOL VAR is nlq ;
+TEXT VAR font text :: "";
+TEXT VAR std quality name :: "draft";
+ 
+. is pica  : font bits = 0
+. is elite : font bits = 1
+.;
+
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+END PROC paper size;
+ 
+papersize (20.32, 30.48); 
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+END PROC paper size;
+ 
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality
+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")
+  FI
+END PROC std quality;
+ 
+TEXT PROC std quality : 
+ 
+  std quality name 
+END PROC std quality;
+                        
+ 
+$topmargin$ 
+REAL VAR  y margin := 0.0 ;
+ 
+PROC top margin (REAL CONST margin): 
+ 
+  y margin := margin 
+END PROC top margin; 
+ 
+REAL PROC top margin: 
+ 
+  y margin 
+END PROC top margin;
+ 
+ 
+$speed$
+BOOL VAR is slow :: TRUE; 
+TEXT VAR std speed name :: "slow";
+ 
+PROC std speed (TEXT CONST speed) :
+ 
+  IF speed = "fast" OR speed = "slow"
+     THEN std speed name := speed
+     ELSE errorstop ("unzulässige Geschwindigkeit")
+  FI
+END PROC std speed;
+ 
+TEXT PROC std speed : 
+ 
+std speed name 
+END PROC std speed;
+ 
+ 
+$typefacelq850$ 
+TEXT VAR act typeface name :: "";
+TEXT VAR std typeface name :: "";
+ 
+. is roman: 
+  act typeface name = "roman". 
+. is sansserif: 
+  act typeface name = "sansserif"
+.; 
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+ 
+ 
+$typefacep6+$ 
+BOOL VAR is courier :: TRUE; 
+TEXT VAR std typeface name :: "courier";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "courier" OR typeface = "souvenir" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefaceoki$ 
+BOOL VAR is courier ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "courier" OR typeface = "kassette" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefacestar$ 
+BOOL VAR is roman ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "font1" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$feed$ 
+BOOL VAR is sheet feed :: FALSE;
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "sheet"
+    THEN is sheet feed := TRUE 
+  ELIF feeder = "tractor" 
+    THEN is sheet feed := FALSE 
+    ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: 
+  IF is sheet feed
+    THEN "sheet" 
+    ELSE "tractor" 
+  FI 
+END PROC paper feed;
+ 
+$feedschacht$
+BOOL VAR is sheet feed :: FALSE;
+TEXT VAR feeder name :: "tractor";
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "tractor" 
+     THEN feeder name := "tractor"; 
+          is sheet feed := FALSE
+  ELIF feeder = "sheet" OR feeder = "schacht1" 
+     THEN feeder name := "schacht1" ; 
+          is sheet feed := TRUE
+  ELIF feeder = "schacht2" 
+     THEN feeder name := "schacht2" ; 
+          is sheet feed := TRUE 
+     ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: feeder name END PROC paper feed;
+ 
+$open$
+PROC open (INT CONST op code, INT VAR param1, param2):
+ 
+  SELECT op code OF
+    CASE 1: open document(param1,param2)
+    CASE 2: open page    (param1,param2)
+  END SELECT. 
+END PROC open ; 
+ 
+ 
+$opendoch$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+ 
+$opendochtosh$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 36) * 36;
+ 
+$initspeed$ 
+    IF pos (material, "slow") <> 0 
+         THEN is slow := TRUE;
+    ELIF pos (material, "fast") <> 0 
+         THEN is slow := FALSE;
+         ELSE is slow := std speed name = "slow"
+    FI;
+ 
+$opendocp6+$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "souvenir") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ;
+ 
+$opendocp5p7$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+            center paper ;
+    FI;
+ 
+    . center paper :
+        INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0),
+                  left margin      := (136 - x steps in chars) DIV 2;
+        out (""27"P");
+        out (""27"l"); out (code (left margin + 1));
+END PROC open document ;
+
+$opendocp6$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein              *)
+    FI;
+END PROC open document ;
+
+$opendoclq850$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN out (""27""25"4");                       (* Sheetmode ein    *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN act typeface name := "roman" 
+    ELIF pos (material, "sansserif") <> 0 
+      THEN act typeface name := "sansserif" 
+      ELSE act typeface name := std typeface name  
+    FI; 
+END PROC open document ; 
+ 
+$opendocokieps$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendoctosh$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6");                              (* Zeichensatz *) 
+    out (""27"A"12""27"2") ;
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocbrother$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"R"0"");                (* Zeichensatz II ascii *) 
+    out (""27"A"10""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+       THEN out (""27""25"4")  
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocokiibm$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"!"64"");                (* Zeichensatz II ascii *) 
+    out (""27""91""92""4""0""0""0""180"");      (* 1/180 *)
+    out (""27"A"12""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendocstar$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"R"0"");                  (* amerikanischer Zeichensatz *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN is roman := TRUE ; 
+    ELIF pos (material, "font1") <> 0 
+      THEN is roman := FALSE ; 
+      ELSE is roman := std typeface name = "roman" 
+    FI; 
+END PROC open document ; 
+ 
+$openpagetosh$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (2.54)    (* 1 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$openpage$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0 ; 
+    y start := y step conversion (y margin) ; 
+    x rest := 0; 
+    out (""13""). 
+END PROC open page; 
+ 
+$openpagep5-7$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (8.466667e-1)    (* 2/6 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$close$
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+  SELECT op code OF
+    CASE 1: close document 
+    CASE 2: close page (param1)
+  END SELECT.
+ 
+close document : 
+. 
+END PROC close ; 
+ 
+$closepage$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF remaining y steps > 0
+       THEN out (""12"")
+    ELIF is sheet feed
+       THEN out (""27""25"R")
+    FI;
+END PROC close page;
+
+$closepagetosh$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF   is sheet feed
+         THEN out (""12"")
+    ELIF remaining y steps > 0
+         THEN out (""12"")
+    FI;
+END PROC close page;
+
+$execute$
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE 1:  write text
+  CASE 2:  write cmd
+  CASE 3:  carriage return
+  CASE 4:  move
+  CASE 5:  draw
+  CASE 6:  on
+  CASE 7:  off
+  CASE 8:  type
+END SELECT.
+
+from : param1. 
+to   : param2. 
+ 
+  write text :
+    out subtext (string, from, to).
+ 
+$cmdp6+$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "souvenir"
+      THEN IF is courier THEN is courier := FALSE; switch to souvenir FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdp5-7$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN IF NOT is nlq THEN switch to nlq FI;
+              is nlq := TRUE;
+    ELIF buffer = "draft"
+         THEN IF     is nlq THEN switch to draft FI;
+              is nlq := FALSE;
+         ELSE out (buffer);
+    FI;.
+ 
+$cmdlq850$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN act typeface name := "roman" ; 
+                                switch to roman FI;
+    ELIF buffer = "sansserif"
+      THEN IF NOT is sansserif THEN act typeface name := "sansserif"; 
+                                    switch to sansserif FI;
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdoki$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "kassette"
+      THEN IF is courier THEN is courier := FALSE; switch to kassette FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdtosh$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE;  switch to draft FI;
+      ELSE out (buffer);
+    FI;.
+ 
+$cmdstar$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI;
+    ELIF buffer = "font1"
+      THEN IF is roman THEN is roman := FALSE; switch to font1 FI;
+    FI. 
+ 
+$crs$
+  carriage return :
+    x rest := 0;
+    out (""13"").
+ 
+$move$ 
+x steps : param1.
+y steps : param2.
+
+move :
+  IF x steps < 0 OR y steps < 0 THEN stop FI; 
+  IF x steps > 0 THEN x move FI; 
+  IF y steps > 0 THEN y move FI. 
+
+$stdmove$ 
+x move : 
+  x rest INCR x steps;
+  high   := (x rest) DIV blankbreite;
+  x rest := (x rest) MOD blankbreite; 
+  steps := x rest DIV 3;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF steps > 0 AND is slow
+     THEN IF is underline THEN out (" "8"") FI;
+          out (""27"Y" + code (steps) + ""0"");  (* 1/360 *)
+          steps TIMESOUT ""0"";
+          x rest := x rest MOD 3
+  FI. 
+ 
+is underline: 
+  bit (modification bits,7). 
+ 
+y move : 
+  IF y steps > 0
+     THEN high := y steps DIV 255;
+          low  := y steps MOD 255;
+          IF high > 0 THEN high TIMESOUT ""27"J"255"" FI;   (* 1/180 *)
+          IF low  > 0 THEN out (""27"J" + code (low)) FI;
+  FI. 
+ 
+draw :
+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
+    THEN stop
+  ELIF x steps > 0
+    THEN x draw
+  FI. 
+ 
+x draw : 
+  x rest INCR x steps ; 
+  steps := x steps DIV 3 ; 
+  IF steps > 0 THEN 
+    x rest := x steps MOD 3 ; 
+    out (""27"Y");
+    out (code (steps MOD 256));
+    out (code (steps DIV 256));
+    steps TIMESOUT ""1""; 
+  FI.
+ 
+$movep5-7$ 
+      x move :
+        x rest INCR x steps; 
+        IF not is underline
+           THEN simple x move
+           ELSE underline x move
+        FI;
+
+        . not is underline :
+            NOT bit (modification bits, 7)
+ 
+        . simple x move :
+            high   := x rest DIV factor 1;
+            x rest := x rest MOD factor 1;
+            out (""27"\");
+            out (code (high MOD 256));
+            out (code (high DIV 256));
+ 
+        . underline x move :
+            high   := x rest DIV factor 2;
+            x rest := x rest MOD factor 2;
+            IF high < blankbreite
+               THEN stop
+               ELSE low  := high MOD 127;
+                    high := high DIV 127;
+                    IF low >= blankbreite
+                       THEN low  DECR blankbreite;
+                       ELSE high DECR 1;
+                            low  DECR (blankbreite - 127);
+                    FI;
+                    IF high > 0 
+                       THEN out (""27" ");
+                            out (code (127 - blankbreite));
+                            high TIMESOUT " ";
+                    FI;
+                    out (""27" ");
+                    out (code (low)); 
+                    out (" "27" "0"");
+            FI;
+. y move:
+
+  low  := y steps MOD 255;
+  high := y steps DIV 255;
+  IF high > 0 THEN high TIMESOUT (""27"J"255"") FI;
+  IF low  > 0 THEN out (""27"J" + code (low))   FI;
+ 
+. draw :
+    IF   x steps < 0 OR y steps <> 0 
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        x rest INCR x steps;
+        steps  := x rest DIV 4;
+        x rest := x rest MOD 4;
+        IF steps > 0
+           THEN low  := steps MOD 256;
+                high := steps DIV 256;
+                out (""27"*"39"");
+                out (code (low));
+                out (code (high));
+                steps TIMESOUT dot;
+        FI;
+
+        . dot :
+            IF linetype = underline linetype
+               THEN ""000""000""001""
+               ELSE ""000""000""048""
+            FI. 
+ 
+ 
+$onoff$ 
+  modification : param1
+.
+  on :
+    buffer := on string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits OR code (buffer);
+            switch to font;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    buffer := off string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits XOR code (buffer);
+            switch to font;
+       ELSE stop
+    FI.
+ 
+$typep6+$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to souvenir 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to souvenir : 
+    out (""27"k"15"") ; 
+END PROC execute;
+ 
+$typeplq850$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to sansserif 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to sansserif : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+$typeokieps$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    vertical factor := code (buffer SUB 1); 
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    IF vertical factor = 2 
+      THEN out (""27"w"1"") 
+      ELSE out (""27"w"0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typep5-7$ 
+  type :
+    font nr     := param1;
+    buffer      := font string (font nr);
+    factor 1    := code (buffer SUB 1);  (* 720 / Mikroschritte pro Inch mit ESC \ *)
+    factor 2    := code (buffer SUB 2);  (* 720 / Mikroschritte pro Inch mit ESC Blank *)
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") DIV factor 2; 
+    switch to font;
+    IF is nlq THEN switch to nlq FI;
+ 
+END PROC execute;
+ 
+ 
+PROC switch to font :
+ 
+  out (""27"!");
+  out (code (font bits OR modification bits));
+  out (font text);
+ 
+END PROC switch to font;
+ 
+ 
+PROC switch to nlq :
+ 
+  IF is pica OR is elite
+     THEN draft factor 1 := factor 1;
+          factor 1       := 4;
+          draft factor 2 := factor 2; 
+          IF is pica
+             THEN factor 2    := 4 * factor 2 DIV 6;
+                  blankbreite := char pitch (font nr, " ") DIV factor 2;
+          FI;
+          out (""27"x"1"");
+     ELSE out (""27"x"0"");
+  FI;
+ 
+END PROC switch to nlq;
+ 
+ 
+PROC switch to draft :
+ 
+  IF is pica OR is elite
+     THEN factor 1 := draft factor 1;
+          factor 2 := draft factor 2;
+          out (""27"x"0"");
+  FI;
+ 
+END PROC switch to draft;
+
+$typetosh$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"1"");
+ 
+END PROC execute;
+ 
+$typeokiibm$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN  out(""27"%G")
+       ELSE  out(""27"%H")
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typebrother$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+END PROC execute;
+ 
+$typestar$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to font1 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to font1 : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+ 
+
+$printerlq1500$ 
+PACKET printer driver
+ 
+(**************************************************************************)
+(*                                                Stand   : 29.07.86      *)
+(*   EPSON   LQ-1500                              Version : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(*   geändert am 15.12.88 hjh                                             *)
+(**************************************************************************)
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+ 
+               paper size,
+               std quality:
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8, *)
+ 
+    underline linetype  =  1,
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+INT VAR rest, high, low, factor;
+BOOL VAR is nlq, factor was 6, condensed;
+REAL VAR x size, y size;
+TEXT VAR std quality name, buffer;
+ 
+(*********************************************************************)
+ 
+paper size  (13.6 * 2.54, 12.0 * 2.54);
+std quality ("draft");
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality;
+     ELSE errorstop ("unzulaessige Betriebsart")
+  FI;
+ 
+END PROC std quality;
+ 
+TEXT PROC std quality : std quality name END PROC std quality;
+ 
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    factor       := 0;
+    factor was 6 := FALSE;
+    condensed    := FALSE; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+    out (""27""64"");                      (* Reset des Druckers             *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)
+    out (""27"x"0"");                      (* Entwurfsqualität               *) 
+ 
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := 0;
+    y start := 0;
+    rest    := 0;
+    out (""13"");
+ 
+END PROC open;
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+. remaining y steps : param1
+.
+  close page :
+    IF remaining y steps > 0 THEN out (""12"") FI
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN is nlq := TRUE;
+              near letter quality;
+    ELIF buffer = "draft"
+         THEN is nlq := FALSE;
+              draft quality;
+         ELSE out (buffer);
+    FI;
+ 
+    . near letter quality :
+        IF factor = 6
+           THEN factor was 6 := TRUE;
+                factor       := 4; 
+           ELSE factor was 6 := FALSE;
+        FI;
+        IF condensed
+           THEN out (""27"x"0"")
+           ELSE out (""27"x"1"") 
+        FI;
+ 
+    . draft quality :
+        IF factor was 6
+           THEN factor was 6 := FALSE;
+                factor       := 6; 
+        FI;
+        out (""27"x"0"");
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    rest := 0;
+    out (""13"");
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps < 0 OR y steps < 0
+         THEN stop
+    ELIF x steps > 0
+         THEN x move
+    ELIF y steps > 0
+         THEN y move
+    FI;
+ 
+    . x move :
+        high := (x steps + rest) DIV factor;
+        rest := (x steps + rest) MOD factor;
+        out (""27"\");
+        out (code (high MOD 256));
+        out (code (high DIV 256));
+ 
+    . y move :
+        high := y steps DIV 255;
+        low  := y steps MOD 255;
+        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
+        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+ 
+. 
+  draw :
+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        high := (x steps + rest) DIV 6;
+        rest := (x steps + rest) MOD 6;
+        IF high > 0
+           THEN low  := high MOD 255;
+                high := high DIV 255;
+                out (""27"V");
+                out (code (low));
+                out (""27"*"1""1""0""1""27"V"0"");
+                FOR low FROM 1 UPTO high
+                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 
+        FI;
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> "" 
+       THEN out (on string (modification))
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification))
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    buffer := font string (font nr);
+    out (buffer);
+    factor := pitch factor;
+    IF is nlq THEN near letter quality FI;
+ 
+    . pitch factor :                           (*             Mikroschritt *)
+        INT CONST font bits := code (buffer SUB 3);
+        IF   bit (font bits, 1) 
+             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)
+        ELIF pos (buffer, ""27"x"1"") <> 0
+             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)
+        ELIF bit (font bits, 2) 
+             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)
+        ELIF bit (font bits, 0) 
+             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)
+             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)
+        FI
+ 
+END PROC execute;
+
+
+$end$
+INT VAR reply; DATASPACE VAR ds; FILE VAR file;
+ 
+PROC printer:
+ 
+  disable stop;
+  continue (server channel);
+  check error (error message);
+  ds := nilspace;
+  REP forget (ds);
+      execute print;
+      IF is error AND online THEN put error; clear error; FI;
+  PER;
+END PROC printer;
+ 
+PROC execute print:
+ 
+  LET ack = 0, fetch code = 11, file type = 1003;
+  enable stop;
+  ds := nilspace;
+  call (father, fetch code, ds, reply);
+  IF reply = ack CAND type (ds) = file type
+     THEN file := sequential file (input, ds);
+          print (file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+  FI;
+END PROC execute print;
+ 
+PROC check error(TEXT CONST message):
+ 
+  IF is error
+     THEN clear error; rename myself (message);
+          IF is error THEN end(myself) FI;
+          pause (9000); end(myself);
+  FI;
+END PROC check error;
+ 
+END PACKET printerdriver
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel
new file mode 100644
index 0000000..579f67f
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel
@@ -0,0 +1,776 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      IF is error 
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      clear error; 
+      enable stop 
+    UNTIL no error PER. 
+ 
+  inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+    put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  TEXT VAR buffer;
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/schulis-sim-3.0 b/system/printer-24nadel/schulis-sim-3.0
new file mode 120000
index 0000000..5ca05f9
--- /dev/null
+++ b/system/printer-24nadel/schulis-sim-3.0
@@ -0,0 +1 @@
+schulis-mathe-1.0/
\ No newline at end of file
diff --git a/printer/dotmatrix9/readme b/system/printer-9nadel/0.9/doc/readme
index 2047abe..2047abe 100644
--- a/printer/dotmatrix9/readme
+++ b/system/printer-9nadel/0.9/doc/readme
diff --git a/system/printer-9nadel/0.9/source-disk b/system/printer-9nadel/0.9/source-disk
new file mode 100644
index 0000000..ddcd852
--- /dev/null
+++ b/system/printer-9nadel/0.9/source-disk
@@ -0,0 +1 @@
+grundpaket/06_std.printer_9_nadel.img
diff --git a/printer/dotmatrix9/beschreibungen9 b/system/printer-9nadel/0.9/src/beschreibungen9
index 6a74b88..6a74b88 100644
--- a/printer/dotmatrix9/beschreibungen9
+++ b/system/printer-9nadel/0.9/src/beschreibungen9
diff --git a/printer/dotmatrix9/fonttab.1 b/system/printer-9nadel/0.9/src/fonttab.1
index b5d17e6..b5d17e6 100644
--- a/printer/dotmatrix9/fonttab.1
+++ b/system/printer-9nadel/0.9/src/fonttab.1
diff --git a/printer/dotmatrix9/fonttab.10 b/system/printer-9nadel/0.9/src/fonttab.10
index 6a13c49..6a13c49 100644
--- a/printer/dotmatrix9/fonttab.10
+++ b/system/printer-9nadel/0.9/src/fonttab.10
diff --git a/printer/dotmatrix9/fonttab.20 b/system/printer-9nadel/0.9/src/fonttab.20
index 7cf0aaf..7cf0aaf 100644
--- a/printer/dotmatrix9/fonttab.20
+++ b/system/printer-9nadel/0.9/src/fonttab.20
diff --git a/printer/dotmatrix9/fonttab.20.lc b/system/printer-9nadel/0.9/src/fonttab.20.lc
index ddf4535..ddf4535 100644
--- a/printer/dotmatrix9/fonttab.20.lc
+++ b/system/printer-9nadel/0.9/src/fonttab.20.lc
diff --git a/printer/dotmatrix9/fonttab.20.lx b/system/printer-9nadel/0.9/src/fonttab.20.lx
index 1ce0940..1ce0940 100644
--- a/printer/dotmatrix9/fonttab.20.lx
+++ b/system/printer-9nadel/0.9/src/fonttab.20.lx
diff --git a/printer/dotmatrix9/fonttab.7 b/system/printer-9nadel/0.9/src/fonttab.7
index 676b9a0..676b9a0 100644
--- a/printer/dotmatrix9/fonttab.7
+++ b/system/printer-9nadel/0.9/src/fonttab.7
diff --git a/printer/dotmatrix9/fonttab.7.cxp b/system/printer-9nadel/0.9/src/fonttab.7.cxp
index 0a996f3..0a996f3 100644
--- a/printer/dotmatrix9/fonttab.7.cxp
+++ b/system/printer-9nadel/0.9/src/fonttab.7.cxp
diff --git a/printer/dotmatrix9/fonttab.7.fuj b/system/printer-9nadel/0.9/src/fonttab.7.fuj
index 1ed83be..1ed83be 100644
--- a/printer/dotmatrix9/fonttab.7.fuj
+++ b/system/printer-9nadel/0.9/src/fonttab.7.fuj
diff --git a/printer/dotmatrix9/fonttab.7.mt b/system/printer-9nadel/0.9/src/fonttab.7.mt
index c816646..c816646 100644
--- a/printer/dotmatrix9/fonttab.7.mt
+++ b/system/printer-9nadel/0.9/src/fonttab.7.mt
diff --git a/printer/dotmatrix9/module9 b/system/printer-9nadel/0.9/src/module9
index 65de1ee..65de1ee 100644
--- a/printer/dotmatrix9/module9
+++ b/system/printer-9nadel/0.9/src/module9
diff --git a/printer/dotmatrix9/printer.neun.nadel b/system/printer-9nadel/0.9/src/printer.neun.nadel
index 00f698b..00f698b 100644
--- a/printer/dotmatrix9/printer.neun.nadel
+++ b/system/printer-9nadel/0.9/src/printer.neun.nadel
diff --git a/system/printer-9nadel/1986/doc/readme b/system/printer-9nadel/1986/doc/readme
new file mode 100644
index 0000000..4fe4035
--- /dev/null
+++ b/system/printer-9nadel/1986/doc/readme
@@ -0,0 +1,323 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 

+#head# 

+Treiber-Installations-Programm   #right#Seite % 

+für 9-Nadel-Matrixdrucker   #right#23.06.1988 

+ 

+ 

+#end# 

+#on("u")#Dokumentation zum Treiber-Installations-Programm für 9-Nadel-

+Matrixdrucker#off("u")# 

+ 

+#on("u")#Inhalt:#off("u")# 

+ 

+1. Installations- und Gebrauchsanleitung 

+2. Druckertreiber-Auswahl 

+3. Steuerungsmöglichkeiten und Spezialfeatures 

+4. Weitere Hinweise 

+ 

+ 

+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 

+ 

+#on("u")#Einrichten#off("u")# 

+So wird das Treiber-Installationsprogramm eingerichtet: 

+ 

+       SV drücken 

+ 

+    nach 'gib supervisor kommando:' 

+ 

+       begin("PRINTER","SYSUR") 

+ 

+    in der Task "PRINTER" (nach 'gib kommando'): 

+ 

+       archive ("std.printer") 

+       fetch ("printer.neun.nadel",archive) 

+       check off 

+       insert ("printer.neun.nadel") 

+ 

+Das Programm wird dann insertiert. 

+ 

+#on("u")#Druckerkanal#off("u")# 

+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker

+über Parallelschnittstelle betrieben wird, ist die Kanalnummer

+meistens 15. 

+ 

+#on("u")#Menüsystem#off("u")# 

+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.

+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste

+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier

+den passenden Typ aus! 

+Das Installationsprogramm zeigt nun einige Informationen zu dem ange-

+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi-

+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt

+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei-

+ber betrieben werden soll. 

+ 

+Hinweise zu Konfigurationsangaben: 

+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion

+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf

+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So

+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu

+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze

+   weiterdruckt. 

+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge-

+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker

+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln

+   für die Konfiguration: 

+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 

+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei-

+     lenvorschub durchführen. 

+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 

+ 

+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht

+     achten. 

+ 

+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 

+ 

+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des

+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 

+ 

+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er-

+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,

+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein-

+stellungen können nachträglich in der Task "PRINTER" mit den entspre-

+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte

+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck-

+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku-

+ments verändert werden (direkte Druckeranweisung #"..."#). 

+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 

+ 

+ 

+#on("b")#2. Druckertreiber-Auswahl#off("b")# 

+ 

+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 

+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll-

+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker

+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 

+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im

+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),

+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.

+(Viele Drucker verfügen über EPSON FX-85 bzw. FX-800-Emulationen oder

+IBM Grafikdrucker bzw. Proprinter-Eumulationen.) 

+Eine der beiden Anpassungen 'EPSON MX' oder 'IBM-Grafikdrucker' müßte

+immer einen (Minimal-) Betrieb ermöglichen. 

+ 

+#on("u")#Hinweise zu den Treibern für FX-80/85-kompatilble Drucker#off("u")# 

+Die Treiber für FX-80-bzw. FX-85-kompatible Geräte, die oft auch IBM-

+kompatibel sind, basieren üblicherweise auf den Treibern für EPSON-

+Drucker, weil so einige Schrifttypen (z.B. Proportionalschrift) und

+Modifikationen leichter ausgenutzt werden können. Ein Nachteil liegt

+aber darin, daß beim FX-80 und FX-85 noch die alten EPSON-Zeichensätze

+benutzt werden, die nicht die IBM-üblichen Grafik- und Sonderzeichen

+enthalten. 

+Falls für Sie die Benutzung dieser Zeichen vordringlich ist, sollten

+Sie Ihren Drucker (nachdem er auf IBM-Emulation konfiguriert wurde)

+zusammen mit dem Treiber für IBM-Grafikdrucker bzw. -Proprinter ver-

+wenden. 

+ 

+ 

+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 

+ 

+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.

+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 

+Die Einstellungen können über 

+- Steuerprozeduren 

+- Materialanweisungen bzw. 

+- direkte Druckeranweisungen 

+vorgenommen werden. 

+ 

+#on("u")#Steuerprozeduren#off("u")# 

+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten

+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")

+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in

+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 

+ 

+PROC papersize (REAL CONST breite, länge) 

+    Dient zur Einstellung der Größe der physikalisch beschreibbaren

+    Fläche. 

+    Beispiel:  papersize (20.32, 30.48) 

+               (Standardeinstellung für Endlospapier 8 Zoll breit und

+               12 Zoll lang) 

+ 

+PROC papersize 

+    Informationsprozedur 

+ 

+PROC top margin (REAL CONST margin) 

+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk-

+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser

+    Prozedur die Länge des oberen Randes, den der Drucker nicht be-

+    drucken kann, in cm angegeben werden. 

+    Beispiel:  top margin (2.0) 

+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm

+               nicht bedruckbar sind.) 

+ 

+REAL PROC top margin 

+    Informationsprozedur 

+ 

+PROC std speed (TEXT CONST speed) 

+    Parameter: slow, fast 

+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in

+    Blanks (fast). 

+    Beispiel:  std speed ("slow") 

+ 

+TEXR PROC std speed 

+    Informationsprozedur 

+ 

+PROC std quality (TEXT CONST quality) 

+    übliche Parameter: draft, nlq 

+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-

+    Qualität 

+    Beispiel:  std quality ("draft") 

+ 

+TEXT PROC std quality 

+    Informationsprozedur 

+ 

+PROC std typeface (TEXT CONST typeface) 

+    übliche Parameter: roman, sansserif, courier 

+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im

+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 

+    Beispiel: std typeface ("roman") 

+ 

+TEXT PROC std typeface 

+    Informationsprozedur 

+ 

+PROC paper feed (TEXT CONST name) 

+    übliche Parameter: tractor, sheet, schacht1, schacht2 

+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 

+    Beispiel:  paper feed ("sheet") 

+ 

+TEXT PROC paper feed 

+    Informationsprozedur 

+ 

+ 

+#on("u")#Materialanweisungen #material("...")##off("u")# 

+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und

+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben

+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge-

+stellten Standardwerten. Diese werden durch die Materialanweisung aber

+nicht geändert.) 

+ 

+Beispiel:  #material("nlq")# 

+           sorgt bei entsprechendem Treiber dafür, daß das gesamte

+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal

+           wie 'std quality' eingestellt ist. 

+ 

+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh-

+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung

+erscheinen. Beispiel:  #material("sheet;draft")# 

+ 

+ 

+#on("u")#direkte Druckeranweisungen #"..."##off("u")# 

+gelten ab der Position, an der sie in der Datei auftreten. Sie haben

+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und

+Materialeinstellungen. 

+ 

+Beispiel:  #"draft"# 

+           schaltet (bei entsprechendem Treiber) auf Datenverar-

+           beitungs-Qualität, egal welche Standardeinstellung vorliegt

+           und welche Materialanweisung gegeben wurde. 

+ 

+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen

+werden.#off("b")# Also:  #"nlq"##"sansserif"# 

+ 

+ 

+#on("u")#Wichtig#off("u")# 

+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen

+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben

+  berücksichtigt! Also:  #"nlq"# und keinesfalls #"NLQ"#!!! 

+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und

+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann

+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse

+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen

+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die

+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.

+  für beide Spalten) unerwünscht erhalten bleibt. 

+ 

+ 

+#on("u")#Tabelle#off("u")# 

+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel-

+lungen erfolgen können. 

+ 

+#type("17")# 

+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 

+ 

+#on("u")#                                                                                          #off("u")# 

+ 

+Positionierung     std speed             slow, fast              ------ 

+                     slow, fast 

+ 

+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 

+                     z.B. draft, nlq 

+ 

+Schriftart         std typeface          z.B. roman,             z.B. roman, 

+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 

+                     sansserif, courier 

+ 

+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 

+einzug               z.B. tractor,       schacht2                schacht2 

+                     sheet, 

+                     schacht1, schacht2 

+ 

+Farbdruck          ------                ------                  z.B. schwarz, 

+                                                                 rot, blau, 

+                                                                 violett, gelb 

+                                                                 orange, grün 

+ 

+ 

+ 

+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 

+ 

+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 

+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb

+des Codes 127 einige internationale Zeichen zur Verfügung gestellt

+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 

+Bei den Treibern der vorliegenden Version gilt folgendes: 

+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-

+  Zeichensatz (sofern möglich) unterstützt. 

+- Der Code 252 liefert das Paragraphzeichen. 

+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes

+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des

+  IBM-Grafikzeichensatzes. 

+ 

+ 

+#on("u")#Hinweis zu Proportionalschriften#off("u")# 

+Bei Proportionalschriften sollte die Modifikation #on("i")# nicht

+benutzt werden, da die kursiven Zeichen andere Proportionalbreiten

+haben. Stattdessen sollte auf den schrägen Typ umgeschaltet werden

+(z.B. von "prop10" auf "prop10i"). 

+ 

+ 

+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 

+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel-

+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 

+ 

+   Am Drucker: 

+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug konfigu-

+   rieren (siehe Druckerhandbuch!). 

+ 

+   In der Druckspooltask (meist 'PRINTER'): 

+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü-

+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für

+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed

+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 

+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen-

+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel-

+   len. 

+   Beispiel:  papersize (21.0, 29.7) 

+              (für DIN A4-Blätter) 

+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt-

+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß

+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem

+   Druckertreiber mitgeteilt werden. 

+   Beispiel:  top margin (1.5) 

+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine

+   Datei mit #start(0.0,0.0)# ausgedruckt wird.) 

+ 

+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren

+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien

+   ein genügend großer y-Wert für die Startposition eingestellt wird

+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der

+   ersten Zeile zu Überschreibungen. 

+ 

+ 

+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben

+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 

diff --git a/system/printer-9nadel/1986/src/CHARED.ELA b/system/printer-9nadel/1986/src/CHARED.ELA
new file mode 100644
index 0000000..a54679f
--- /dev/null
+++ b/system/printer-9nadel/1986/src/CHARED.ELA
@@ -0,0 +1,47 @@
+PACKET chared DEFINES chared : 

+ 

+PROC chared (TEXT VAR text denoter, BOOL CONST dens) :

+FILE VAR f := editfile; 

+TEXT VAR t ; 

+ROW 30 INT VAR bytes ; 

+INT VAR i, zeile, max breite := 0 ; 

+FOR i FROM 1 UPTO 30 REP 

+ bytes(i) := 0 

+PER ; 

+input (f) ; 

+zeile := 7 ;

+WHILE NOT eof (f) REP 

+ getline (f, t) ; 

+ convert line ; 

+ zeile DECR 1

+UNTIL zeile < 0 PER ; 

+convert to text denoter . 

+ 

+ 

+convert line : 

+ FOR i FROM 1 UPTO LENGTH t REP 

+  IF (t SUB i) <> " " AND (t SUB i) <> "." 

+     THEN setbit (bytes (i), zeile) ; 

+          max breite := max (max breite, i)

+  FI 

+ PER . 

+ 

+convert to text denoter : 

+ text denoter := """""27""K""" ;

+ IF dens 

+   THEN text denoter CAT text (max breite) 

+   ELSE text denoter CAT text (max breite DIV 2) 

+ FI ; 

+ text denoter CAT """""0""" ; 

+ FOR i FROM 1 UPTO max breite REP 

+  IF dens OR (i AND 1) = 1 

+     THEN text denoter CAT """" ; 

+          text denoter CAT text (bytes (i)) ; 

+          text denoter CAT """"

+  FI

+ PER ; 

+ text denoter CAT """" . 

+ 

+ENDPROC chared ; 

+ 

+ENDPACKET chared

diff --git a/system/printer-9nadel/1986/src/EPSONFX.ELA b/system/printer-9nadel/1986/src/EPSONFX.ELA
new file mode 100644
index 0000000..40b9cc3
--- /dev/null
+++ b/system/printer-9nadel/1986/src/EPSONFX.ELA
@@ -0,0 +1,575 @@
+ FONTTABLE  :  "fonttab.epson.fx+";

+   x unit      =  47.24409;

+   y unit      =  85.03937;

+   on string   =  ""27"-1",  ""27"G",  ""27"4",  "";

+   off string  =  ""27"-0",  ""27"H",  ""27"5",  "";

+ 

+           ""127"",   "";

+           ""128"",   "-";

+           ""129"",   "-";

+           ""130"",   "-";

+           ""131"",   "-";

+           ""132"",   "-";

+           ""133"",   "-";

+           ""134"",   "-";

+           ""135"",   "-";

+           ""136"",   "-";

+           ""137"",   "-";

+           ""138"",   "-";

+           ""139"",   "-";

+           ""140"",   "-";

+           ""141"",   "-";

+           ""142"",   "-";

+           ""143"",   "-";

+           ""144"",   "-";

+           ""145"",   "-";

+           ""146"",   "-";

+           ""147"",   "-";

+           ""148"",   "-";

+           ""149"",   "-";

+           ""150"",   "-";

+           ""151"",   "-";

+           ""152"",   "-";

+           ""153"",   "-";

+           ""154"",   "-";

+           ""155"",   "-";

+           ""156"",   "-";

+           ""157"",   "-";

+           ""158"",   "-";

+           ""159"",   "-";

+           ""160"",   "-";

+           ""161"",   "-";

+           ""162"",   "-";

+           ""163"",   "-";

+           ""164"",   "-";

+           ""165"",   "-";

+           ""166"",   "-";

+           ""167"",   "-";

+           ""168"",   "-";

+           ""169"",   "-";

+           ""170"",   "-";

+           ""171"",   "-";

+           ""172"",   "-";

+           ""173"",   "-";

+           ""174"",   "-";

+           ""175"",   "-";

+           ""176"",   "-";

+           ""177"",   "-";

+           ""178"",   "-";

+           ""179"",   "-";

+           ""180"",   "-";

+           ""181"",   "-";

+           ""182"",   "-";

+           ""183"",   "-";

+           ""184"",   "-";

+           ""185"",   "-";

+(*i`*)     ""186"",   ""27"%"0""0""4""27"%"1""0"";

+           ""187"",   "-";

+           ""188"",   "-";

+           ""189"",   "-";

+(*a`*)     ""190"",   ""27"%"0""0""0""27"%"1""0"";

+           ""191"",   "-";

+           ""192"",   "-";

+(*e'*)     ""193"",   ""27"R"1"{"27"R"0"";

+(*e`*)     ""194"",   ""27"%"0""0""1""27"%"1""0"";

+           ""195"",   "-";

+           ""196"",   "-";

+           ""197"",   "-";

+(*o`*)     ""198"",   ""27"%"0""0""3""27"%"1""0"";

+           ""199"",   "-";

+(*c,*)     ""200"",   ""27"R"1"\"27"R"0"";

+           ""201"",   "-";

+(*u`*)     ""202"",   ""27"%"0""0""2""27"%"1""0"";

+           ""203"",   "-";

+           ""204"",   "-";

+(*grad*)   ""205"",   ""27"R"1"["27"R"0"";

+(*A-grad*) ""206"",   ""27"R"4"]"27"R"0"";

+(*AE*)     ""207"",   ""27"R"4"]"27"R"0"";

+(*E'*)     ""208"",   ""27"R"5"@"27"R"0"";

+(*N~*)     ""209"",   ""27"R"7"\"27"R"0"";

+(*a-punkt*)""210"",   ""27"R"4"}"27"R"0"";

+(*ae*)     ""211"",   ""27"R"4"{"27"R"0"";

+(*n~*)     ""212"",   ""27"R"7"|"27"R"0"";

+(*pound*)  ""213"",   ""27"R"3"#"27"R"0"";

+   (* Ä *) ""214"",   ""27"R"2"["27"R"0"";

+   (* Ö *) ""215"",   ""27"R"2"\"27"R"0"";

+   (* Ü *) ""216"",   ""27"R"2"]"27"R"0"";

+   (* ä *) ""217"",   ""27"R"2"{"27"R"0"";

+   (* ö *) ""218"",   ""27"R"2"|"27"R"0"";

+   (* ü *) ""219"",   ""27"R"2"}"27"R"0"";

+   (* k *) ""220"",   "k";

+   (* - *) ""221"",   "-";

+   (* # *) ""222"",   "#";

+   (*   *) ""223"",   " ";

+           ""224"",   "-";

+           ""225"",   "-";

+           ""226"",   "-";

+           ""227"",   "-";

+           ""228"",   "-";

+           ""229"",   "-";

+           ""230"",   "-";

+           ""231"",   "-";

+           ""232"",   "-";

+           ""233"",   "-";

+           ""234"",   "-";

+           ""235"",   "-";

+           ""236"",   "-";

+           ""237"",   "-";

+           ""238"",   "-";

+           ""239"",   "-";

+           ""240"",   "-";

+           ""241"",   "-";

+           ""242"",   "-";

+           ""243"",   "-";

+           ""244"",   "-";

+           ""245"",   "-";

+           ""246"",   "-";

+           ""247"",   "-";

+           ""248"",   "-";

+           ""249"",   "-";

+           ""250"",   "-";

+   (* ß *) ""251"",   ""27"R"2"~"27"R"0"";

+(*paragr.*)""252"",   ""27"R"2"@"27"R"0"";

+           ""253"",   "-";

+           ""254"",   "-";

+           ""255"",   "-";

+ 

+ 

+   FONT  :  "17",  "micron",  "elanlist";

+     indentation pitch  =  7;

+     font height        =  36;

+     next smaller font  =  "17.klein";

+     font string        =  ""27"!"4""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "17.klein",  "micron.klein";

+     indentation pitch  =  7;

+     font height        =  19;

+     font string        =  ""27"!"4""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10",  "pica";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"!"0""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10.klein",  "pica.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"0""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10b.klein";

+     font string        =  ""27"!"8""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"8""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "20";

+     indentation pitch  =  6;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"!"5""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "20.klein";

+     indentation pitch  =  6;

+     font height        =  19;

+     font string        =  ""27"!"5""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12",  "elite";

+     indentation pitch  =  10;

+     font height        =  36;

+     next smaller font  =  "12.klein";

+     font string        =  ""27"!"1""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12.klein",  "elite.klein";

+     indentation pitch  =  10;

+     font height        =  19;

+     font string        =  ""27"!"1""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.5",  "8";

+     indentation pitch  =  14;

+     font height        =  36;

+     next smaller font  =  "8.5.klein";

+     font string        =  ""27"!$"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.5.klein",  "8.klein";

+     indentation pitch  =  14;

+     font height        =  19;

+     font string        =  ""27"!$"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5.klein";

+     font string        =  ""27"! "27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5b.klein";

+     font string        =  ""27"!("27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"!("27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10-2";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10-2.klein";

+     font string        =  ""27"!%"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10-2.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!%"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6";

+     indentation pitch  =  20;

+     font height        =  36;

+     next smaller font  =  "6.klein";

+     font string        =  ""27"!!"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6.klein";

+     indentation pitch  =  20;

+     font height        =  19;

+     font string        =  ""27"!!"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "prop10";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "prop10.klein";

+     font string        =  ""27"!"0""27"5"27"T"27"p1";

+ 

+   (* ! *) ""033"",    5;              (* " *) ""034"",    8;

+   (* ' *) ""039"",    5;              (* ( *) ""040"",    6;

+   (* ) *) ""041"",    6;              (* , *) ""044"",    7;

+   (* . *) ""046"",    6;              (* / *) ""047"",   10;

+   (* 1 *) ""049"",    8;              (* : *) ""058"",    6;

+   (* ; *) ""059"",    6;              (* < *) ""060"",   10;

+   (* > *) ""062"",   10;              (* I *) ""073"",    8;

+   (* J *) ""074"",   11;              (* X *) ""088"",   10;

+   (* Z *) ""090"",   10;              (* [ *) ""091"",    8;

+   (* \ *) ""092"",   10;              (* ] *) ""093"",    8;

+   (* ` *) ""096"",    5;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* d *) ""100"",   11;

+   (* f *) ""102"",   10;              (* g *) ""103"",   11;

+   (* h *) ""104"",   11;              (* i *) ""105"",    8;

+   (* j *) ""106"",    9;              (* k *) ""107"",   10;

+   (* l *) ""108"",    8;              (* n *) ""110"",   11;

+   (* p *) ""112"",   11;              (* q *) ""113"",   11;

+   (* r *) ""114"",   11;              (* t *) ""116"",   11;

+   (* x *) ""120"",   10;              (* z *) ""122"",   10;

+           ""123"",    9;              (* | *) ""124"",    5;

+           ""125"",    9;                      ""127"",    0;

+           ""186"",    6;                      ""198"",   10;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""212"",   11;

+   (* ö *) ""218"",   10;              (* ü *) ""219"",   11;

+   (* k *) ""220"",   10;              (* ß *) ""251"",   11;

+           ""252"",   10;              

+ 

+   FONT  :  "prop10.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     next smaller font  =  "prop10";

+     font string        =  ""27"!"0""27"5"27"S1"27"p1";

+ 

+   (* ! *) ""033"",    5;              (* " *) ""034"",    8;

+   (* ' *) ""039"",    5;              (* ( *) ""040"",    6;

+   (* ) *) ""041"",    6;              (* , *) ""044"",    7;

+   (* . *) ""046"",    6;              (* / *) ""047"",   10;

+   (* 1 *) ""049"",    8;              (* : *) ""058"",    6;

+   (* ; *) ""059"",    6;              (* < *) ""060"",   10;

+   (* > *) ""062"",   10;              (* I *) ""073"",    8;

+   (* J *) ""074"",   11;              (* X *) ""088"",   10;

+   (* Z *) ""090"",   10;              (* [ *) ""091"",    8;

+   (* \ *) ""092"",   10;              (* ] *) ""093"",    8;

+   (* ` *) ""096"",    5;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* d *) ""100"",   11;

+   (* f *) ""102"",   10;              (* g *) ""103"",   11;

+   (* h *) ""104"",   11;              (* i *) ""105"",    8;

+   (* j *) ""106"",    9;              (* k *) ""107"",   10;

+   (* l *) ""108"",    8;              (* n *) ""110"",   11;

+   (* p *) ""112"",   11;              (* q *) ""113"",   11;

+   (* r *) ""114"",   11;              (* t *) ""116"",   11;

+   (* x *) ""120"",   10;              (* z *) ""122"",   10;

+           ""123"",    9;              (* | *) ""124"",    5;

+           ""125"",    9;                      ""127"",    0;

+           ""186"",    6;                      ""198"",   10;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""212"",   11;

+   (* ö *) ""218"",   10;              (* ü *) ""219"",   11;

+   (* k *) ""220"",   10;              (* ß *) ""251"",   11;

+           ""252"",   10;              

+ 

+   FONT  :  "prop10i";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "prop10i.klein";

+     font string        =  ""27"!"0""27"4"27"T"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   10;

+   (* $ *) ""036"",   11;              (* ' *) ""039"",    5;

+   (* ( *) ""040"",    8;              (* ) *) ""041"",    8;

+   (* , *) ""044"",    8;              (* . *) ""046"",    7;

+   (* / *) ""047"",   10;              (* 1 *) ""049"",    9;

+   (* 6 *) ""054"",   11;              (* 9 *) ""057"",   11;

+   (* : *) ""058"",    8;              (* ; *) ""059"",    9;

+   (* < *) ""060"",   10;              (* = *) ""061"",   11;

+   (* > *) ""062"",    9;              (* ? *) ""063"",   11;

+   (* I *) ""073"",   10;              (* L *) ""076"",   10;

+   (* V *) ""086"",   11;              (* [ *) ""091"",   11;

+   (* \ *) ""092"",    7;              (* ] *) ""093"",   11;

+   (* ^ *) ""094"",   10;              (* ` *) ""096"",    5;

+   (* a *) ""097"",   11;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* e *) ""101"",   11;

+   (* g *) ""103"",   11;              (* h *) ""104"",   11;

+   (* i *) ""105"",    9;              (* j *) ""106"",   10;

+   (* k *) ""107"",   11;              (* l *) ""108"",    9;

+   (* m *) ""109"",   11;              (* n *) ""110"",   10;

+   (* o *) ""111"",   11;              (* p *) ""112"",   11;

+   (* q *) ""113"",   11;              (* r *) ""114"",   10;

+   (* s *) ""115"",   11;              (* t *) ""116"",   10;

+   (* u *) ""117"",   11;              (* v *) ""118"",   10;

+   (* y *) ""121"",   11;                      ""123"",   10;

+   (* | *) ""124"",    9;                      ""125"",   10;

+           ""127"",    0;                      ""186"",    8;

+           ""190"",   11;                      ""193"",   11;

+           ""194"",   11;                      ""198"",   11;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""210"",   11;

+   (* ä *) ""217"",   11;              (* ö *) ""218"",   11;

+   (* k *) ""220"",   11;              (* ß *) ""251"",   11;

+ 

+   FONT  :  "prop10i.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"0""27"4"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   10;

+   (* $ *) ""036"",   11;              (* ' *) ""039"",    5;

+   (* ( *) ""040"",    8;              (* ) *) ""041"",    8;

+   (* , *) ""044"",    8;              (* . *) ""046"",    7;

+   (* / *) ""047"",   10;              (* 1 *) ""049"",    9;

+   (* 6 *) ""054"",   11;              (* 9 *) ""057"",   11;

+   (* : *) ""058"",    8;              (* ; *) ""059"",    9;

+   (* < *) ""060"",   10;              (* = *) ""061"",   11;

+   (* > *) ""062"",    9;              (* ? *) ""063"",   11;

+   (* I *) ""073"",   10;              (* L *) ""076"",   10;

+   (* V *) ""086"",   11;              (* [ *) ""091"",   11;

+   (* \ *) ""092"",    7;              (* ] *) ""093"",   11;

+   (* ^ *) ""094"",   10;              (* ` *) ""096"",    5;

+   (* a *) ""097"",   11;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* e *) ""101"",   11;

+   (* g *) ""103"",   11;              (* h *) ""104"",   11;

+   (* i *) ""105"",    9;              (* j *) ""106"",   10;

+   (* k *) ""107"",   11;              (* l *) ""108"",    9;

+   (* m *) ""109"",   11;              (* n *) ""110"",   10;

+   (* o *) ""111"",   11;              (* p *) ""112"",   11;

+   (* q *) ""113"",   11;              (* r *) ""114"",   10;

+   (* s *) ""115"",   11;              (* t *) ""116"",   10;

+   (* u *) ""117"",   11;              (* v *) ""118"",   10;

+   (* y *) ""121"",   11;                      ""123"",   10;

+   (* | *) ""124"",    9;                      ""125"",   10;

+           ""127"",    0;                      ""186"",    8;

+           ""190"",   11;                      ""193"",   11;

+           ""194"",   11;                      ""198"",   11;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""210"",   11;

+   (* ä *) ""217"",   11;              (* ö *) ""218"",   11;

+   (* k *) ""220"",   11;              (* ß *) ""251"",   11;

+ 

+   FONT  :  "prop5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "prop5.klein";

+     font string        =  ""27"! "27"5"27"T"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   16;

+   (* ' *) ""039"",   10;              (* ( *) ""040"",   12;

+   (* ) *) ""041"",   12;              (* , *) ""044"",   14;

+   (* . *) ""046"",   12;              (* / *) ""047"",   20;

+   (* 1 *) ""049"",   16;              (* : *) ""058"",   12;

+   (* ; *) ""059"",   12;              (* < *) ""060"",   20;

+   (* > *) ""062"",   20;              (* I *) ""073"",   16;

+   (* J *) ""074"",   22;              (* X *) ""088"",   20;

+   (* Z *) ""090"",   20;              (* [ *) ""091"",   16;

+   (* \ *) ""092"",   20;              (* ] *) ""093"",   16;

+   (* ` *) ""096"",   10;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* d *) ""100"",   22;

+   (* f *) ""102"",   20;              (* g *) ""103"",   22;

+   (* h *) ""104"",   22;              (* i *) ""105"",   16;

+   (* j *) ""106"",   18;              (* k *) ""107"",   20;

+   (* l *) ""108"",   16;              (* n *) ""110"",   22;

+   (* p *) ""112"",   22;              (* q *) ""113"",   22;

+   (* r *) ""114"",   22;              (* t *) ""116"",   22;

+   (* x *) ""120"",   20;              (* z *) ""122"",   20;

+           ""123"",   18;              (* | *) ""124"",   10;

+           ""125"",   18;                      ""127"",    0;

+           ""186"",   12;                      ""198"",   20;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""212"",   22;

+   (* ö *) ""218"",   20;              (* ü *) ""219"",   22;

+   (* k *) ""220"",   20;              (* ß *) ""251"",   22;

+           ""252"",   20;              

+ 

+   FONT  :  "prop5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"5"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   16;

+   (* ' *) ""039"",   10;              (* ( *) ""040"",   12;

+   (* ) *) ""041"",   12;              (* , *) ""044"",   14;

+   (* . *) ""046"",   12;              (* / *) ""047"",   20;

+   (* 1 *) ""049"",   16;              (* : *) ""058"",   12;

+   (* ; *) ""059"",   12;              (* < *) ""060"",   20;

+   (* > *) ""062"",   20;              (* I *) ""073"",   16;

+   (* J *) ""074"",   22;              (* X *) ""088"",   20;

+   (* Z *) ""090"",   20;              (* [ *) ""091"",   16;

+   (* \ *) ""092"",   20;              (* ] *) ""093"",   16;

+   (* ` *) ""096"",   10;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* d *) ""100"",   22;

+   (* f *) ""102"",   20;              (* g *) ""103"",   22;

+   (* h *) ""104"",   22;              (* i *) ""105"",   16;

+   (* j *) ""106"",   18;              (* k *) ""107"",   20;

+   (* l *) ""108"",   16;              (* n *) ""110"",   22;

+   (* p *) ""112"",   22;              (* q *) ""113"",   22;

+   (* r *) ""114"",   22;              (* t *) ""116"",   22;

+   (* x *) ""120"",   20;              (* z *) ""122"",   20;

+           ""123"",   18;              (* | *) ""124"",   10;

+           ""125"",   18;                      ""127"",    0;

+           ""186"",   12;                      ""198"",   20;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""212"",   22;

+   (* ö *) ""218"",   20;              (* ü *) ""219"",   22;

+   (* k *) ""220"",   20;              (* ß *) ""251"",   22;

+           ""252"",   20;              

+ 

+   FONT  :  "prop5i";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "prop5i.klein";

+     font string        =  ""27"! "27"4"27"T"27"p1";

+ 

+   (* ! *) ""033"",   20;              (* " *) ""034"",   20;

+   (* $ *) ""036"",   22;              (* ' *) ""039"",   10;

+   (* ( *) ""040"",   16;              (* ) *) ""041"",   16;

+   (* , *) ""044"",   16;              (* . *) ""046"",   14;

+   (* / *) ""047"",   20;              (* 1 *) ""049"",   18;

+   (* 6 *) ""054"",   22;              (* 9 *) ""057"",   22;

+   (* : *) ""058"",   16;              (* ; *) ""059"",   18;

+   (* < *) ""060"",   20;              (* = *) ""061"",   22;

+   (* > *) ""062"",   18;              (* ? *) ""063"",   22;

+   (* I *) ""073"",   20;              (* L *) ""076"",   20;

+   (* V *) ""086"",   22;              (* [ *) ""091"",   22;

+   (* \ *) ""092"",   14;              (* ] *) ""093"",   22;

+   (* ^ *) ""094"",   20;              (* ` *) ""096"",   10;

+   (* a *) ""097"",   22;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* e *) ""101"",   22;

+   (* g *) ""103"",   22;              (* h *) ""104"",   22;

+   (* i *) ""105"",   18;              (* j *) ""106"",   20;

+   (* k *) ""107"",   22;              (* l *) ""108"",   18;

+   (* m *) ""109"",   22;              (* n *) ""110"",   20;

+   (* o *) ""111"",   22;              (* p *) ""112"",   22;

+   (* q *) ""113"",   22;              (* r *) ""114"",   20;

+   (* s *) ""115"",   22;              (* t *) ""116"",   20;

+   (* u *) ""117"",   22;              (* v *) ""118"",   20;

+   (* y *) ""121"",   22;                      ""123"",   20;

+   (* | *) ""124"",   18;                      ""125"",   20;

+           ""127"",    0;                      ""186"",   16;

+           ""190"",   22;                      ""193"",   22;

+           ""194"",   22;                      ""198"",   22;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""210"",   22;

+   (* ä *) ""217"",   22;              (* ö *) ""218"",   22;

+   (* k *) ""220"",   22;              (* ß *) ""251"",   22;

+ 

+   FONT  :  "prop5i.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"4"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   20;              (* " *) ""034"",   20;

+   (* $ *) ""036"",   22;              (* ' *) ""039"",   10;

+   (* ( *) ""040"",   16;              (* ) *) ""041"",   16;

+   (* , *) ""044"",   16;              (* . *) ""046"",   14;

+   (* / *) ""047"",   20;              (* 1 *) ""049"",   18;

+   (* 6 *) ""054"",   22;              (* 9 *) ""057"",   22;

+   (* : *) ""058"",   16;              (* ; *) ""059"",   18;

+   (* < *) ""060"",   20;              (* = *) ""061"",   22;

+   (* > *) ""062"",   18;              (* ? *) ""063"",   22;

+   (* I *) ""073"",   20;              (* L *) ""076"",   20;

+   (* V *) ""086"",   22;              (* [ *) ""091"",   22;

+   (* \ *) ""092"",   14;              (* ] *) ""093"",   22;

+   (* ^ *) ""094"",   20;              (* ` *) ""096"",   10;

+   (* a *) ""097"",   22;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* e *) ""101"",   22;

+   (* g *) ""103"",   22;              (* h *) ""104"",   22;

+   (* i *) ""105"",   18;              (* j *) ""106"",   20;

+   (* k *) ""107"",   22;              (* l *) ""108"",   18;

+   (* m *) ""109"",   22;              (* n *) ""110"",   20;

+   (* o *) ""111"",   22;              (* p *) ""112"",   22;

+   (* q *) ""113"",   22;              (* r *) ""114"",   20;

+   (* s *) ""115"",   22;              (* t *) ""116"",   20;

+   (* u *) ""117"",   22;              (* v *) ""118"",   20;

+   (* y *) ""121"",   22;                      ""123"",   20;

+   (* | *) ""124"",   18;                      ""125"",   20;

+           ""127"",    0;                      ""186"",   16;

+           ""190"",   22;                      ""193"",   22;

+           ""194"",   22;                      ""198"",   22;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""210"",   22;

+   (* ä *) ""217"",   22;              (* ö *) ""218"",   22;

+   (* k *) ""220"",   22;              (* ß *) ""251"",   22;

diff --git a/system/printer-9nadel/1986/src/EPSONRX.ELA b/system/printer-9nadel/1986/src/EPSONRX.ELA
new file mode 100644
index 0000000..ebc9f23
--- /dev/null
+++ b/system/printer-9nadel/1986/src/EPSONRX.ELA
@@ -0,0 +1,171 @@
+ FONTTABLE  :  "fonttab.epson.rx";

+   x unit      =  47.24409;

+   y unit      =  85.03937;

+   on string   =  ""27"-1",  ""27"G",  ""27"4",  "";

+   off string  =  ""27"-0",  ""27"H",  ""27"5",  "";

+ 

+           ""127"",   "";

+(*Herz*)   ""153"",   ""146"";

+(*Karo*)   ""154"",   ""147"";

+(*Baum*)   ""155"",   ""148"";

+(*Pik *)   ""156"",   ""145"";

+(*Note*)   ""157"",   ""149"";

+(*Telefon*)""158"",   ""150"";

+(*Flugzg.*)""159"",   ""151"";

+(*Auto*)   ""160"",   ""152"";

+(*Glas*)   ""161"",   ""153"";

+(*Mann*)   ""162"",   ""154"";

+(*i`*)     ""186"",   ""27"R"6"~"27"R"0"";

+(*a`*)     ""190"",   ""27"R"6"{"27"R"0"";

+(*e'*)     ""193"",   ""27"R"6"]"27"R"0"";

+(*e`*)     ""194"",   ""27"R"6"}"27"R"0"";

+(*o`*)     ""198"",   ""27"R"6"|"27"R"0"";

+(*c,*)     ""200"",   ""27"R"1"\"27"R"0"";

+(*u`*)     ""202"",   ""27"R"6"`"27"R"0"";

+(*grad*)   ""205"",   ""27"R"1"["27"R"0"";

+(*A-grad*) ""206"",   ""27"R"4"]"27"R"0"";

+(*AE*)     ""207"",   ""27"R"4"["27"R"0"";

+(*E'*)     ""208"",   ""27"R"5"@"27"R"0"";

+(*N~*)     ""209"",   ""27"R"7"\"27"R"0"";

+(*a-punkt*)""210"",   ""27"R"4"}"27"R"0"";

+(*ae*)     ""211"",   ""27"R"4"{"27"R"0"";

+(*n~*)     ""212"",   ""27"R"7"|"27"R"0"";

+(*pound*)  ""213"",   ""27"R"3"#"27"R"0"";

+   (* Ä *) ""214"",   ""27"R"2"["27"R"0"";

+   (* Ö *) ""215"",   ""27"R"2"\"27"R"0"";

+   (* Ü *) ""216"",   ""27"R"2"]"27"R"0"";

+   (* ä *) ""217"",   ""27"R"2"{"27"R"0"";

+   (* ö *) ""218"",   ""27"R"2"|"27"R"0"";

+   (* ü *) ""219"",   ""27"R"2"}"27"R"0"";

+   (* k *) ""220"",   "k";

+   (* - *) ""221"",   "-";

+   (* # *) ""222"",   "#";

+   (*   *) ""223"",   " ";

+(* +/- *)  ""224"",   ""159"";

+(*uparrow*)""236"",   ""155"";

+(*downarr*)""238"",   ""156"";

+(*x-kreuz*)""245"",   ""157"";

+(*geteilt*)""246"",   ""158"";

+   (* ß *) ""251"",   ""27"R"2"~"27"R"0"";

+(*paragr.*)""252"",   ""27"R"2"@"27"R"0"";

+ 

+ 

+   FONT  :  "17",  "micron";

+     indentation pitch  =  7;

+     font height        =  36;

+     next smaller font  =  "17.klein";

+     font string        =  ""27"P"15""27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "17.klein",  "micron.klein", "elanlist";

+     indentation pitch  =  7;

+     font height        =  19;

+     font string        =  ""27"P"15""27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8";

+     indentation pitch  =  14;

+     font height        =  36;

+     next smaller font  =  "8.klein";

+     font string        =  ""27"P"15""27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.klein";

+     indentation pitch  =  14;

+     font height        =  19;

+     font string        =  ""27"P"15""27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10",  "pica";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"P"18""27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10.klein",  "pica.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10b.klein";

+     font string        =  ""27"P"18""27"W"0""27"E"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"0""27"E"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12",  "elite";

+     indentation pitch  =  10;

+     font height        =  36;

+     next smaller font  =  "12.klein";

+     font string        =  ""18""27"M"27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12.klein",  "elite.klein";

+     indentation pitch  =  10;

+     font height        =  19;

+     font string        =  ""18""27"M"27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5.klein";

+     font string        =  ""27"P"18""27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5b.klein";

+     font string        =  ""27"P"18""27"W"1""27"E"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"1""27"E"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6";

+     indentation pitch  =  20;

+     font height        =  36;

+     next smaller font  =  "6.klein";

+     font string        =  ""18""27"M"27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6.klein";

+     indentation pitch  =  20;

+     font height        =  19;

+     font string        =  ""18""27"M"27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

diff --git a/system/printer-9nadel/1986/src/FONTTAB.10A b/system/printer-9nadel/1986/src/FONTTAB.10A
new file mode 100644
index 0000000..8a8cd59
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.10A
diff --git a/system/printer-9nadel/1986/src/FONTTAB.12A b/system/printer-9nadel/1986/src/FONTTAB.12A
new file mode 100644
index 0000000..ed08d88
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.12A
diff --git a/system/printer-9nadel/1986/src/FONTTAB.S10 b/system/printer-9nadel/1986/src/FONTTAB.S10
new file mode 100644
index 0000000..90769b0
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.S10
diff --git a/system/printer-9nadel/1986/src/FONTTAB.S12 b/system/printer-9nadel/1986/src/FONTTAB.S12
new file mode 100644
index 0000000..e367bcc
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.S12
diff --git a/system/printer-9nadel/1986/src/beschreibungen9 b/system/printer-9nadel/1986/src/beschreibungen9
new file mode 100644
index 0000000..21aa015
--- /dev/null
+++ b/system/printer-9nadel/1986/src/beschreibungen9
@@ -0,0 +1,96 @@
+ 

+(*************************************************************************)

+(*                                            Stand   : 01.10.88         *)

+(*  Beschreibungen-Datei für 9-Nadel-Drucker  Version : 0.9              *)

+(*                                            Autoren : mov/hjh          *)

+(*************************************************************************)

+ 

+$fx85$ 

+head;hfx85;decl;speed;openh;opendoch;initspeed;opendocfx85;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+

+$fx800$ 

+head;hfx800;decl;quality;typeface;openh;opendoch;opendocfx800;openpge;betwoc; 

+clpge;betwce;cmdfx800;crs;moh;mofx800;ymodr;onoff;tyfx800;end 

+

+$mx$ 

+head;hmx;decl;speed;openh;opendoch;initspeed;opendocmx;openpge;betwoc;clpge; 

+betwce;cmd;crs;moh;modrmx;onoff;tymx;end 

+ 

+$lx800$ 

+head;hlx800;decl;speed;quality;typeface;openh;opendoch;initspeed; 

+opendocfx800;openpge;betwoc;clpge;betwce;cmdfx800;crs;moh;mofx85;ymodr;onoff; 

+tyfx800;end 

+

+$ibmgp$ 

+head;hgp;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 

+ 

+$ibmpp$ 

+head;hpp;decl;speed;quality;openh;opendoch;initspeed;opendocpp;openpge; 

+betwoc;clpge;betwce;cmdpp;crs;moh;mofx85;ymodr;onoffpp;tyfx85;end 

+ 

+$okiml182i$

+head;hml182i;decl;speed;quality;openh;opendoch;initspeed;opendocml182i; 

+opendocgp;openpge;betwoc;clpge;betwce;cmdml182i;crs;moh;mogp;ymodr;onoff; 

+tyohnesmall;end 

+ 

+$okiml192el$ 

+head;hml192el;decl;speed;feed;openh;opendoch;initspeed;opendocml192el; 

+openpgemlsf;betwoc;clmlsf;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+ 

+$okiml292el$ 

+head;hml292el;decl;quality;typeface292;feed;openh;opendoch;opendocml292el; 

+openpgemlsf;betwoc;clmlsf;betwce;cmdml292el;crs;moh;mofx800;ymodr;onoff; 

+tyml292el;end 

+ 

+$okiml294i$ 

+head;hml294i;decl;speed;quality;feed;openh;opendoch;initspeed;opendocml294i; 

+openpgemlsf;betwoc;clmlsf;betwce;cmdml294i;crs;moh;mofx85;ymodr;ontyml294i;end 

+ 

+$okiml320$ 

+head;hml320;decl;speed;openh;opendoch;initspeed;opendocml320; 

+openpge;betwoc;clpge;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+ 

+$starlc10$ 

+head;hlc10;decl;quality;typefacelc10;openh;opendoch;opendoclc10;openpge; 

+betwoc;clpge;betwce;cmdlc10;crs;moh;mofx800;ymodr;onoff;tyfx800;end 

+ 

+$dmp4000$ 

+head;hdmp4000;decl;speed;openh;opendoch;initspeed;opendocdmp4000;openpge; 

+betwoc;clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+ 

+$starnx15$ 

+head;hnx15;decl;speed;openh;opendoch;initspeed;opendocnx15;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+ 

+$mt230$ 

+head;hmt230;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 

+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;mofx85;ymodr;onoff; 

+tyfx85;end 

+ 

+$mt340$ 

+head;hmt340;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 

+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;moml192el;ymodr;onoff; 

+tyml192el;end 

+ 

+$citi120d$ 

+head;h120d;decl;openh;opendoch;opendoc120d;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx800;ymodr;onoff;tyfx85;end 

+ 

+$citohc310cxp$ 

+head;hc310;decl;speed;feedschacht;openh;opendoch;initspeed;opendocc310; 

+openpgec310sf;betwoc;clc310sf;betwce;cmdc310;crs;moh;mofx85;ymodr;onoff; 

+tyfx85;end 

+ 

+$citohci3500$ 

+head;hci3500;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 

+ 

+$fujdx2100$ 

+head;hdx2100;decl;speed;feed;openh;opendoch;initspeed;opendocdx2100; 

+openpge;betwoc;clpge;betwce;cmddx2100;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+

diff --git a/system/printer-9nadel/1986/src/fonttab.1 b/system/printer-9nadel/1986/src/fonttab.1
new file mode 100644
index 0000000..c008441
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.1
diff --git a/system/printer-9nadel/1986/src/fonttab.10 b/system/printer-9nadel/1986/src/fonttab.10
new file mode 100644
index 0000000..cf79bc7
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.10
diff --git a/system/printer-9nadel/1986/src/fonttab.20 b/system/printer-9nadel/1986/src/fonttab.20
new file mode 100644
index 0000000..774029f
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20
diff --git a/system/printer-9nadel/1986/src/fonttab.20.lc b/system/printer-9nadel/1986/src/fonttab.20.lc
new file mode 100644
index 0000000..030f9fa
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20.lc
diff --git a/system/printer-9nadel/1986/src/fonttab.20.lx b/system/printer-9nadel/1986/src/fonttab.20.lx
new file mode 100644
index 0000000..423cda1
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20.lx
diff --git a/system/printer-9nadel/1986/src/fonttab.7 b/system/printer-9nadel/1986/src/fonttab.7
new file mode 100644
index 0000000..c18f223
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7
diff --git a/system/printer-9nadel/1986/src/fonttab.7.cxp b/system/printer-9nadel/1986/src/fonttab.7.cxp
new file mode 100644
index 0000000..a2b833a
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.cxp
diff --git a/system/printer-9nadel/1986/src/fonttab.7.fuj b/system/printer-9nadel/1986/src/fonttab.7.fuj
new file mode 100644
index 0000000..1244175
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.fuj
diff --git a/system/printer-9nadel/1986/src/fonttab.7.mt b/system/printer-9nadel/1986/src/fonttab.7.mt
new file mode 100644
index 0000000..a7eea47
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.mt
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.fx b/system/printer-9nadel/1986/src/fonttab.epson.fx
new file mode 100644
index 0000000..ad68a4d
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.fx
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.lq b/system/printer-9nadel/1986/src/fonttab.epson.lq
new file mode 100644
index 0000000..3e7dc5d
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.lq
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.mx b/system/printer-9nadel/1986/src/fonttab.epson.mx
new file mode 100644
index 0000000..b813fe9
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.mx
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.rx b/system/printer-9nadel/1986/src/fonttab.epson.rx
new file mode 100644
index 0000000..7042102
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.rx
diff --git a/system/printer-9nadel/1986/src/module9 b/system/printer-9nadel/1986/src/module9
new file mode 100644
index 0000000..2ab5304
--- /dev/null
+++ b/system/printer-9nadel/1986/src/module9
@@ -0,0 +1,1098 @@
+ 

+(*************************************************************************)

+(*                                            Stand   : 01.10.88         *)

+(*   Module-Datei für 9-Nadel-Drucker         Version : 0.9              *)

+(*                                            Autoren : mov/hjh          *)

+(*************************************************************************)

+

+$head$ 

+PACKET printer driver 

+ 

+       DEFINES printer,

+               open,

+               close,

+               execute,

+               paper size,

+               top margin,

+

+$hfx85$        std speed:

+(* Treiber für EPSON FX85/105, automatisch generiert *)

+

+$hfx800$       std quality,

+               std typeface:

+(* Treiber für EPSON FX800/1000, automatisch generiert *) 

+BOOL VAR was tall font;

+ 

+$hmx$          std speed:

+(* Treiber für EPSON MX80/100, Typ III *) 

+(* Treiber automatisch generiert *)

+BOOL VAR is condensed, is small;

+

+$hlx800$       std speed, 

+               std quality,

+               std typeface:

+(* Treiber für EPSON LX800/1000, automatisch generiert *) 

+BOOL VAR was tall font;

+

+$hgp$          std speed: 

+(* Treiber für IBM-Grafikdrucker *) 

+(* Treiber automatisch generiert *) 

+

+$hpp$          std speed, 

+               std quality:

+(* Treiber für IBM-Proprinter *) 

+(* Treiber automatisch generiert *) 

+ 

+$hml182i$      std speed,

+               std quality:

+(* Treiber für OKI ML182/183 IBM-kompatibel *) 

+(* Treiber automatisch generiert *) 

+ 

+$hml192el$     paper feed,

+               std speed:

+(* Treiber für OKI ML192/193 Elite *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font;

+ 

+$hml292el$     std quality, 

+               std typeface, 

+               paper feed: 

+(* Treiber für OKI ML292/293 Elite *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR was tall font;

+

+$hml294i$      std speed, 

+               paper feed,

+               std quality:

+(* Treiber für OKI ML294 IBM-kompatibel *)

+(* Treiber automatisch generiert *) 

+

+$hml320$       std speed:

+(* Treiber für OKI ML320 IBM/EPSON-kompatibel *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font;

+ 

+$hlc10$        std quality, 

+               std typeface:

+(* Treiber für Star LC-10 oder LC-10 Colour *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR was tall font;

+ 

+$hdmp4000$     std speed:

+(* Treiber für Schneider DMP4000, automatisch generiert *)

+ 

+$hnx15$        std speed:

+(* Treiber für Star NX-15, ND-10, ND-15, NR-10 und NR-15 *)

+(* Treiber automatisch generiert *)

+ 

+$hmt230$       paper feed, 

+               std speed: 

+(* Treiber für Mannesmann-Tally MT 230 *) 

+(* Treiber automatisch generiert *) 

+ 

+$hmt340$       paper feed,

+               std speed:

+(* Treiber für Mannesmann-Tally MT 340 *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font := FALSE; 

+ 

+$h120d$        : 

+(* Treiber für Citizen 120-D *) 

+(* Treiber automatisch generiert *) 

+ 

+$hc310$        paper feed,

+               std speed:

+(* Treiber für C. Itoh C 310/315 CXP *) 

+(* Treiber automatisch generiert *) 

+

+$hci3500$      std speed: 

+(* Treiber für C. Itoh CI-3500 *) 

+(* Treiber automatisch generiert *) 

+ 

+$hdx2100$     paper feed,

+              std speed:

+(* Treiber für Fujitsu DX 2100 *)

+(* Treiber automatisch generiert *)

+BOOL VAR prop font := FALSE ;

+ 

+$decl$

+INT VAR blankbreite, x rest, y rest, high, low, small, modifikations;

+REAL VAR x size, y size, y margin;

+TEXT VAR buffer :: "";

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+END PROC paper size;

+ 

+papersize (20.32, 30.48); 

+ 

+PROC top margin (REAL CONST margin): 

+ 

+  y margin := margin 

+END PROC top margin; 

+ 

+REAL PROC top margin:   y margin   END PROC top margin;

+ 

+top margin (0.0); 

+ 

+$speed$

+BOOL VAR is slow; 

+TEXT VAR std speed name :: "slow";

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed

+     ELSE errorstop ("unzulässige Geschwindigkeit")

+  FI

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+$quality$ 

+TEXT VAR std quality name :: "draft";

+ 

+PROC std quality (TEXT CONST quality) :

+ 

+  IF quality = "nlq" OR quality = "draft"

+     THEN std quality name := quality

+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")

+  FI

+END PROC std quality;

+ 

+TEXT PROC std quality : std quality name END PROC std quality;

+ 

+$typeface$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$typeface292$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif"

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$typefacelc10$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" 

+                   OR typeface = "orator1" OR typeface = "orator2" 

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$feed$ 

+TEXT VAR feeder name :: "tractor";

+ 

+PROC paper feed (TEXT CONST feeder) :

+ 

+  IF feeder = "sheet" OR feeder = "tractor"

+     THEN feeder name := feeder

+     ELSE errorstop ("unzulässige Einzugsart")

+  FI

+END PROC paper feed;

+ 

+TEXT PROC paper feed: feeder name END PROC paper feed;

+ 

+$feedschacht$

+TEXT VAR act feeder :: "", 

+         feeder name :: "tractor";

+ 

+PROC paper feed (TEXT CONST feeder) :

+ 

+  IF feeder = "tractor" OR feeder = "schacht1" OR feeder = "schacht2" 

+     THEN feeder name := feeder

+  ELIF feeder = "sheet" 

+     THEN feeder name := "schacht1" 

+     ELSE errorstop ("unzulässige Einzugsart")

+  FI

+END PROC paper feed;

+ 

+TEXT PROC paper feed: feeder name END PROC paper feed;

+ 

+$openh$

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE 1: open document 

+  CASE 2: open page

+END SELECT.

+ 

+$opendoch$

+  open document :

+    modifikations := 0; 

+    param 1 := x step conversion ( x size );

+    param 2 := y step conversion ( y size );

+$initspeed$ 

+    IF pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+$opendocfx85$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2"27"6");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+ 

+$opendocfx800$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"9"27"O"27"2"); 

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "roman") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF std typeface name = "roman" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    FI. 

+ 

+$opendocmx$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"R"0""27""64"");               (* Reset des Druckers *) 

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36));  (* Formularlaenge *) 

+    out (""27"9"27"O").

+ 

+$opendocgp$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"H"27"W"0""27"T"27"-"0""); (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2"); 

+    out (""27"C" + code (param 2 DIV 36)).       (* Formularlaenge *)

+ 

+$opendocpp$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"W"0""27"T"27"-"0"");      (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2"); 

+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"G")

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"H") 

+    ELIF std quality name = "nlq" 

+      THEN out (""27"G") 

+      ELSE out (""27"H") 

+    FI. 

+    

+$opendocml182i$ 

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"I3") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"I1") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"I3") 

+      ELSE out (""27"I1")

+    FI; 

+    out (""27"N"0"");           (* Kein Sprung über Perf. *)

+

+$opendocml192el$ 

+    param 2 := (param 2 DIV 36) * 36;

+    prop font := FALSE;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"O"27"x"0"").

+ 

+$opendocml292el$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"9"27"O"27"r0"); 

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "courier") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF std typeface name = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    FI. 

+ 

+$opendocml294i$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"W0"27"T"27"-0"27"%H");    (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2");

+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"G")

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"H") 

+    ELIF std quality name = "nlq" 

+      THEN out (""27"G") 

+      ELSE out (""27"H") 

+    FI. 

+ 

+$opendocml320$ 

+    param 2 := (param 2 DIV 36) * 36;

+    prop font := FALSE;

+    out (""27"{"99""27"{"40"");            (* Umschaltung auf EPSON-Emulation *) 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"O"27"x"0"").

+ 

+$opendoclc10$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"9"27"r"0"");

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "courier") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF pos (material, "orator1") <> 0 

+         THEN out (""27"k"2"") 

+    ELIF pos (material, "orator2") <> 0 

+         THEN out (""27"k"3"") 

+    ELIF std typeface name = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF std typeface name = "orator1" 

+      THEN out (""27"k"2"") 

+    ELIF std typeface name = "orator2" 

+      THEN out (""27"k"3"") 

+    FI. 

+ 

+$opendocnx15$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2"); 

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"x"0"").

+ 

+$opendocdmp4000$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *) 

+    out (""27"m"0""27"R"0""27"9"27"O"27"2"27"6");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+ 

+$opendocmt$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"O"27"x"0""27"r"0""27"6"); 

+    IF feeder name = "tractor" 

+      THEN act feeder := feeder name; 

+           out (""27"[5{") 

+      ELSE out (""27"[0{");

+           IF pos (material, "schacht1") <> 0 

+             THEN act feeder := "schacht1" 

+           ELIF pos (material, "schacht2") <> 0 

+             THEN act feeder := "schacht2" 

+             ELSE act feeder := feeder name 

+           FI 

+    FI.

+ 

+$opendocdx2100$

+param 2 := (param 2 DIV 36) * 36;

+out (""24""27""64"");                            (* Reset des Druckers *) 

+out (""27"R"0"");                                (* US-Zeichensatz *)

+out (""27"2" + ""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+out (""27"N"0"");                                (* skip perforation *)

+out (""27"x"0"" + ""27"r"0"").                   (* draft und black *)

+ 

+ 

+$opendoc120d$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"9"27"O"27"x0"27"2");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+

+$opendocc310$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"O"27"x"0""27"r"0""27"6"); 

+    IF feeder name = "tractor" 

+      THEN act feeder := feeder name; 

+      ELSE IF pos (material, "schacht1") <> 0 

+             THEN act feeder := "schacht1" 

+           ELIF pos (material, "schacht2") <> 0 

+             THEN act feeder := "schacht2" 

+             ELSE act feeder := feeder name 

+           FI 

+    FI.

+ 

+$openpge$

+  open page :

+    param 1 := 0;

+    param 2 := y step conversion (y margin);

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"").

+$openpgemlsf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "sheet" THEN out (""12"") FI; 

+    out (""13"").

+$openpgemtsf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "schacht1" 

+      THEN out (""27"[21{"12"") 

+    ELIF feeder name = "schacht2" 

+      THEN out (""27"[22{"12"") 

+    FI; 

+    out (""13"").

+  

+$openpgec310sf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "schacht1" 

+      THEN out (""27""25"1"12"") 

+    ELIF feeder name = "schacht2" 

+      THEN out (""27""25"2"12"") 

+    FI; 

+    out (""13"").

+  

+$betwoc$

+END PROC open; 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE 1: close document 

+  CASE 2: close page

+END SELECT.

+close document : 

+$clpge$

+. close page :

+    IF param 1 > 0 THEN out (""12"") FI.

+$clmlsf$ 

+.close page :

+  IF feeder name = "sheet" 

+    THEN out (""27""25""3"") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI. 

+$clmtsf$ 

+.close page :

+  IF feeder name <> "tractor" 

+    THEN out (""27"[2J") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI.

+$clc310sf$ 

+.close page :

+  IF feeder name = "sheet" 

+    THEN out (""27""25"R") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI. 

+ 

+$betwce$

+END PROC close;

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE 1:  write text

+  CASE 2:  write cmd

+  CASE 3:  carriage return

+  CASE 4:  move

+  CASE 5:  draw

+  CASE 6:  on

+  CASE 7:  off

+  CASE 8:  type

+END SELECT.

+

+is underline: bit (modifikations, 0).

+is bold     : bit (modifikations, 1). 

+is italics  : bit (modifikations, 2). 

+ 

+  write text :

+    out subtext (string, param 1, param 2).

+$cmd$ 

+  write cmd :

+    out subtext (string, param 1, param 2). 

+$cmdfx800$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "roman" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+      ELSE out (buffer) 

+    FI. 

+$cmdpp$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"H")

+    ELIF buffer = "nlq"

+      THEN out (""27"G") 

+      ELSE out (buffer) 

+    FI. 

+$cmdml182i$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"I1") 

+    ELIF buffer = "nlq"

+      THEN out (""27"I3") 

+      ELSE out (buffer) 

+    FI. 

+$cmdml292el$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r0")

+    ELIF buffer = "rot" 

+      THEN out (""27"r1")

+    ELIF buffer = "blau" 

+      THEN out (""27"r2")

+    ELIF buffer = "violett" 

+      THEN out (""27"r3")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r4")

+    ELIF buffer = "orange" 

+      THEN out (""27"r5")

+    ELIF buffer = "grün" 

+      THEN out (""27"r6")

+      ELSE out (buffer) 

+    FI. 

+$cmdml294i$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"H") 

+    ELIF buffer = "nlq"

+      THEN out (""27"G") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r0")

+    ELIF buffer = "rot" 

+      THEN out (""27"r1")

+    ELIF buffer = "blau" 

+      THEN out (""27"r2")

+    ELIF buffer = "violett" 

+      THEN out (""27"r3")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r4")

+    ELIF buffer = "orange" 

+      THEN out (""27"r5")

+    ELIF buffer = "grün" 

+      THEN out (""27"r6")

+      ELSE out (buffer) 

+    FI. 

+$cmdlc10$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF buffer = "orator1" 

+      THEN out (""27"k"2"") 

+    ELIF buffer = "orator2" 

+      THEN out (""27"k"3"") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "violett" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "orange" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+$cmdmt230$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF feeder name <> "tractor" 

+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 

+             THEN act feeder := buffer 

+           FI 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "magenta" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "cyan" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+ 

+$cmdc310$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF feeder name <> "tractor" 

+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 

+             THEN act feeder := buffer 

+           FI 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "violett" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "orange" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+ 

+$cmddx2100$ 

+   write cmd :

+     buffer := subtext (string, param 1, param 2); 

+     IF buffer = "schwarz"

+       THEN out (""27"r"0"")

+     ELIF buffer = "rot"

+       THEN out (""27"r"1"")

+     ELIF buffer = "blau"

+       THEN out (""27"r"2"")

+     ELIF buffer = "violett"

+       THEN out (""27"r"3"")

+     ELIF buffer = "gelb"

+       THEN out (""27"r"4"")

+     ELIF buffer = "orange"

+       THEN out (""27"r"5"")

+     ELIF buffer = "grün"

+       THEN out (""27"r"6"")

+     ELSE out (buffer)

+     FI.

+ 

+$crs$

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"").

+$moh$ 

+x steps : param1.

+y steps : param2.

+

+move :

+  IF x steps < 0 OR y steps < 0 THEN stop FI; 

+  IF x steps > 0 THEN x move FI; 

+  IF y steps > 0 THEN y move FI. 

+

+$mofx85$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+     THEN IF is underline THEN out (" "8"") FI;

+          out (""27"Y"+ code (x rest) + ""0"");

+          x rest TIMESOUT ""0"";

+          x rest := 0

+  FI. 

+ 

+ 

+$mofx800$

+x move :

+  IF is underline

+    THEN underline x move

+    ELSE simple x move

+  FI. 

+ 

+underline x move: 

+  high   := (x steps + x rest) DIV blankbreite;

+  low    := (x steps + x rest) MOD blankbreite;

+  IF high > 0 THEN high TIMESOUT " " FI;

+  IF low > 0

+     THEN out (" "8""27"\"+ code (low) + ""0"")

+  FI. 

+ 

+simple x move:

+  out (""27"\");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256)). 

+ 

+$modrmx$ 

+x move :

+  high := (x steps + x rest) DIV blankbreite;

+  low  := (x steps + x rest) MOD blankbreite;

+  IF high > 0 THEN high TIMESOUT " " FI;

+  IF low  > 0 AND is slow

+     THEN IF is underline THEN out ("_"8"") FI;

+          IF is condensed 

+             THEN high := low;

+                  low  := 0;

+                  out (""27"L"+ code (high) + ""0"");

+             ELSE high := low DIV 2;

+                  low  := low MOD 2;

+                  out (""27"K"+ code (high) + ""0"");

+          FI;

+          high TIMESOUT ""0"";

+          IF is small

+             THEN out (""27"S"1"");

+                  small DECR 1;

+          FI;

+  FI;

+  x rest := low. 

+ 

+y move : 

+  y rest INCR y steps;

+  IF y rest > 0

+     THEN high := y rest DIV 255;

+          low  := y rest MOD 255;

+          IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+          IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+          y rest := 0

+  FI. 

+ 

+draw :

+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 

+    THEN stop

+  ELIF x steps > 0

+    THEN x draw

+  FI. 

+ 

+x draw :

+  out (""27"L");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256));

+  x steps TIMESOUT ""1"";

+  IF is small THEN out (""27"S"1"") FI. 

+ 

+$mogp$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+     THEN IF is underline 

+            THEN out (" "13""27"Y"); 

+                 out (code (x pos MOD 256)); 

+                 out (code (x pos DIV 256)); 

+                 x pos TIMESOUT ""0"" 

+            ELSE out (""27"Y"+ code (x rest) + ""0"");

+                 x rest TIMESOUT ""0"" 

+          FI;

+          x rest := 0 

+  FI. 

+ 

+$moml192el$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+    THEN  IF is underline THEN 

+             IF prop font THEN 

+               out (""27"p"0"" + " "8"" + ""27"p"1"") 

+             ELSE 

+               out (" "8"") 

+             FI; 

+          FI;

+          out (""27"Y"+ code (x rest) + ""0"");

+          x rest TIMESOUT ""0"";

+          x rest := 0

+  FI.

+ 

+$ymodr$ 

+y move : 

+  y rest INCR y steps;

+  IF y rest > 0

+    THEN high := y rest DIV 255;

+         low  := y rest MOD 255;

+         IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+         IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+         y rest := 0 

+  FI.

+ 

+draw :

+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 

+    THEN stop

+  ELIF x steps > 0

+    THEN x draw

+  FI. 

+ 

+x draw :

+  out (""27"Y");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256));

+  x steps TIMESOUT ""1"".

+ 

+$onoff$              

+  on :

+    IF on string (param 1) <> ""

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> ""

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+$onoffpp$              

+  on :

+    IF on string (param 1) <> "" AND param 1 <> 2

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> "" AND param 1 <> 2 

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+$tyfx85$ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ");

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.  

+

+$tyfx800$ 

+ type :

+    buffer := font string (param 1);

+    IF was tall font 

+      THEN out (""27"w"0"") 

+    FI; 

+    out (buffer);

+    restore modifikations;

+    blankbreite  := char pitch (param 1, " "); 

+    was tall font := pos (buffer, ""27"w"1"") <> 0.

+

+$tymx$ 

+  type :

+    buffer := font string (param 1);

+    blankbreite  := char pitch (param 1, " ");

+    is condensed := pos (buffer, ""15"") <> 0;

+    IF pos (buffer, ""27"S") <> 0 

+       THEN small DECR 1;

+            is small := TRUE;

+       ELSE is small := FALSE;

+    FI;

+    out (buffer);

+    restore modifikations.

+

+$tyohnesmall$

+ type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations;

+    blankbreite  := char pitch (param 1, " ").

+

+$tyml192el$ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ");

+    prop font    := pos (buffer, ""27"p"1"") <> 0;

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.

+

+$tyml292el$ 

+  type :

+    buffer := font string (param 1);

+    IF was tall font 

+      THEN out (""27""31"0"27"U0") 

+    FI; 

+    was tall font := pos (buffer, ""27"w"1"") <> 0;

+    change all (buffer, ""27"w"0"", ""27""31"0"27"U0"); 

+    change all (buffer, ""27"w"1"", ""27""31"1"27"U1"); 

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ").

+ 

+$ontyml294i$ 

+  on :

+    IF on string (param 1) <> "" AND param 1 <> 2 

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1 

+    ELIF param 1 = 4

+       THEN out (""27"%G"); 

+            modifikations := modifikations OR param 1 

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> "" AND param 1 <> 2

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+    ELIF param 1 = 4 

+       THEN out (""27"%H"); 

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    IF is underline THEN out (on string (1)) FI; 

+    IF is bold      THEN out (on string (2)) FI; 

+    IF is italics   THEN out (""27"%G") FI;

+    blankbreite  := char pitch (param 1, " ");

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.

+

+$end$

+  restore modifikations: 

+    IF is underline THEN out (on string (1)) FI; 

+    IF is bold      THEN out (on string (2)) FI; 

+    IF is italics   THEN out (on string (4)) FI. 

+ 

+END PROC execute;

+

+INT VAR reply; DATASPACE VAR ds; FILE VAR file;

+ 

+PROC printer:

+ 

+  disable stop;

+  continue (server channel);

+  check error (error message);

+  ds := nilspace;

+  REP forget (ds);

+      execute print;

+      IF is error AND online THEN put error; clear error; FI;

+  PER;

+END PROC printer;

+ 

+PROC execute print:

+ 

+  LET ack = 0, fetch code = 11, file type = 1003;

+  enable stop;

+  ds := nilspace;

+  call (father, fetch code, ds, reply);

+  IF reply = ack CAND type (ds) = file type

+     THEN file := sequential file (input, ds);

+          print (file,

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+  FI;

+END PROC execute print;

+ 

+PROC check error(TEXT CONST message):

+ 

+  IF is error

+     THEN clear error; rename myself (message);

+          IF is error THEN end(myself) FI;

+          pause (9000); end(myself);

+  FI;

+END PROC check error;

+ 

+END PACKET printerdriver

+ 

diff --git a/system/printer-9nadel/1986/src/printer.epson.fx b/system/printer-9nadel/1986/src/printer.epson.fx
new file mode 100644
index 0000000..ecb8a27
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.fx
@@ -0,0 +1,505 @@
+PACKET epson fx printer

+ 

+(*************************************************************************)

+(*                                               Stand   : 29.07.86      *)

+(*   EPSON    FX-80 / FX-100 / FX-100+           Version : 4             *)

+(*                                               Autor   : Rudolf Ruland *)

+(*************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+(*  bold                =  2, *)

+    italics             =  4,

+(*  reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is slow, is underline, is italics,

+         double font, prop font, italics font; 

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+(* paper size ( 8.0 * 2.54, 12.0 * 2.54); *) (* FX-80  *)

+   paper size (13.6 * 2.54, 12.0 * 2.54);    (* FX-100 *)

+   std speed  ("fast");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    is italics   := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27""64"");                      (* Reset des Druckers             *)

+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36)); (* Formularlaenge                 *)

+    out (""27"I1"27"6");                   (* Erweiterung des Zeichensatzes  *)

+    out (""27":"0""0""0""27"%"1""0"");     (* Ladbarer Zeichensatz           *)

+    (* Definieren von Zeichen der Breiten 5, 6, 7, 8 und 9 Mikroschritte     *)

+    out (""27"&"0""000""000""4""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""001""001""5""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""002""002""6""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""003""003""7""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""004""004""8""0""0""0""0""0""0""0""0""0""0""0"");

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        IF prop font

+           THEN prop x move

+           ELSE fest x move

+        FI;

+ 

+        . prop x move :

+            high := (x steps + x rest) DIV 5 - 1;

+            low  := (x steps + x rest) MOD 5 + 5;

+            IF high < 0

+               THEN x rest := low - 5;

+               ELSE IF double font                THEN out (""27"W"0"")     FI; 

+                    IF italics font OR is italics THEN out (""27"5")        FI;

+                    IF high > 0                   THEN high TIMESOUT ""0""  FI;

+                    IF low  > 0                   THEN out (code (low - 5)) FI;

+                    IF double font                THEN out (""27"W"1"")     FI;

+                    IF italics font OR is italics THEN out (""27"4")        FI;

+                    x rest := 0;

+           FI;

+ 

+        . fest x move :

+            high   := (x steps + x rest) DIV blankbreite;

+            x rest := (x steps + x rest) MOD blankbreite;

+            IF high   > 0 THEN high TIMESOUT " " FI;

+            IF x rest > 0 AND is slow

+               THEN IF is underline THEN out (" "8"") FI;

+                    out (""27"Y"+ code (x rest) + ""0"");

+                    x rest TIMESOUT ""0"";

+                    x rest := 0;

+            FI;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"Y");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+            IF modification = italics   THEN is italics   := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+            IF modification = italics   THEN is italics   := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    TEXT CONST buffer := font string (font nr);

+    out (buffer);

+    IF is italics THEN out (""27"4") FI;

+    blankbreite  := char pitch (font nr, " ");

+    prop font    := pos (buffer, ""27"p") <> 0;

+    italics font := pos (buffer, ""27"4") <> 0;

+    double font  := blankbreite > 12;

+    IF pos (string, ""27"S") <> 0 THEN small DECR 1 FI;

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson fx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.fx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.fx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for printer type;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for printer type :

+    line;

+    SELECT printer type OF

+      CASE 0 : papersize ( 8.0 * 2.54, 12.0 * 2.54);

+      CASE 1 : papersize (13.6 * 2.54, 12.0 * 2.54);

+      CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54);

+               fonttab name CAT "+";

+    END SELECT;

+ 

+    . printer type :

+        REP out (up); 

+            IF yes ("Druckertyp : FX-80")

+               THEN LEAVE printer type WITH 0 FI;

+            out (up);

+            IF yes ("Druckertyp : FX-100")

+               THEN LEAVE printer type WITH 1 FI;

+            out (up);

+            IF yes ("Druckertyp : FX-100+")

+               THEN LEAVE printer type WITH 2 FI;

+        PER;

+        0

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;";

diff --git a/system/printer-9nadel/1986/src/printer.epson.lq b/system/printer-9nadel/1986/src/printer.epson.lq
new file mode 100644
index 0000000..3be408c
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.lq
@@ -0,0 +1,501 @@
+PACKET epson lq printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   LQ-1500                              Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std quality:

+ 

+LET

+(*  underline           =  1,

+    bold                =  2,

+    italics             =  4,

+    reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR rest, high, low, factor;

+BOOL VAR is nlq, factor was 6, condensed;

+REAL VAR x size, y size;

+TEXT VAR std quality name, buffer;

+ 

+(*********************************************************************)

+ 

+paper size  (13.6 * 2.54, 12.0 * 2.54);

+std quality ("draft");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std quality (TEXT CONST quality) :

+ 

+  IF quality = "nlq" OR quality = "draft"

+     THEN std quality name := quality;

+     ELSE errorstop ("unzulaessige Betriebsart")

+  FI;

+ 

+END PROC std quality;

+ 

+TEXT PROC std quality : std quality name END PROC std quality;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "nlq") <> 0 

+         THEN is nlq := TRUE;

+    ELIF pos (material, "draft") <> 0 

+         THEN is nlq := FALSE;

+         ELSE is nlq := std quality = "nlq"

+    FI;

+    factor       := 0;

+    factor was 6 := FALSE;

+    condensed    := FALSE; 

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 30) * 30;

+    out (""27""64"");                      (* Reset des Druckers             *)

+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)

+    out (""27"x"0"");                      (* Entwurfsqualität               *) 

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    rest    := 0;

+    out (""13"");

+ 

+END PROC open;

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    buffer := subtext (string, from, to);

+    IF   buffer = "nlq"

+         THEN is nlq := TRUE;

+              near letter quality;

+    ELIF buffer = "draft"

+         THEN is nlq := FALSE;

+              draft quality;

+         ELSE out (buffer);

+    FI;

+ 

+    . near letter quality :

+        IF factor = 6

+           THEN factor was 6 := TRUE;

+                factor       := 4; 

+           ELSE factor was 6 := FALSE;

+        FI;

+        IF condensed

+           THEN out (""27"x"0"")

+           ELSE out (""27"x"1"") 

+        FI;

+ 

+    . draft quality :

+        IF factor was 6

+           THEN factor was 6 := FALSE;

+                factor       := 6; 

+        FI;

+        out (""27"x"0"");

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    rest := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + rest) DIV factor;

+        rest := (x steps + rest) MOD factor;

+        out (""27"\");

+        out (code (high MOD 256));

+        out (code (high DIV 256));

+ 

+    . y move :

+        high := y steps DIV 255;

+        low  := y steps MOD 255;

+        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := (x steps + rest) DIV 6;

+        rest := (x steps + rest) MOD 6;

+        IF high > 0

+           THEN low  := high MOD 255;

+                high := high DIV 255;

+                out (""27"V");

+                out (code (low));

+                out (""27"*"1""1""0""1""27"V"0"");

+                FOR low FROM 1 UPTO high

+                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 

+        FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> "" 

+       THEN out (on string (modification))

+       ELSE stop

+    FI

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification))

+       ELSE stop

+    FI

+ 

+ 

+. font nr : param1

+.

+  type :

+    buffer := font string (font nr);

+    out (buffer);

+    factor := pitch factor;

+    IF is nlq THEN near letter quality FI;

+ 

+    . pitch factor :                           (*             Mikroschritt *)

+        INT CONST font bits := code (buffer SUB 3);

+        IF   bit (font bits, 1) 

+             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)

+        ELIF pos (buffer, ""27"x"1"") <> 0

+             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)

+        ELIF bit (font bits, 2) 

+             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)

+        ELIF bit (font bits, 0) 

+             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)

+             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)

+        FI

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson lq printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.lq",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.lq";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for print quality;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+.

+  ask for print quality :

+    line;

+    std quality (quality);

+ 

+    . quality :

+        REP out (up);

+            IF yes ("standardmäßige Druckqualität : draft quality")

+               THEN LEAVE quality WITH "draft" FI;

+            out (up);

+            IF yes ("standardmäßige Druckqualität : near letter quality")

+               THEN LEAVE quality WITH "nlq" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.epson.mx b/system/printer-9nadel/1986/src/printer.epson.mx
new file mode 100644
index 0000000..706f8ab
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.mx
@@ -0,0 +1,488 @@
+PACKET epson mx printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   MX-80 TYPE III                       Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+    bold                =  2,

+(*  italics             =  4,

+    reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is underline, is bold, is condensed, is small, is slow;

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+paper size (8.0 * 2.54, 12.0 * 2.54);

+std speed  ("slow");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    is bold      := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27"R"0""27""64"");               (* Reset des Druckers             *)

+    out (""27"R"0"");                       (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36));  (* Formularlaenge                 *)

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + x rest) DIV blankbreite;

+        low  := (x steps + x rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+        IF low  > 0 AND is slow

+           THEN IF is underline THEN out ("_"8"") FI;

+                IF is condensed 

+                   THEN high := low;

+                        low  := 0;

+                        out (""27"L"+ code (high) + ""0"");

+                   ELSE high := low DIV 2;

+                        low  := low MOD 2;

+                        out (""27"K"+ code (high) + ""0"");

+                FI;

+                high TIMESOUT ""0"";

+                IF is small

+                   THEN out (""27"S"1"");

+                        small DECR 1;

+                FI;

+        FI;

+        x rest := low;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"L");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+        IF is small THEN out (""27"S"1"") FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+            IF modification = bold      THEN is bold      := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+            IF modification = bold      THEN is bold      := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite  := char pitch (font nr, " ");

+    is condensed := pos (font string (font nr), ""15"") <> 0;

+    IF pos (font string (font nr), ""27"S") <> 0 

+       THEN small DECR 1;

+            is small := TRUE;

+       ELSE is small := FALSE;

+    FI;

+    out (font string (font nr));

+    IF is bold THEN out (on string (bold)) FI;

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson mx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 19.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.mx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.mx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.epson.rx b/system/printer-9nadel/1986/src/printer.epson.rx
new file mode 100644
index 0000000..5554efd
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.rx
@@ -0,0 +1,446 @@
+PACKET epson rx printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   RX-80 F/T +                          Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+(*  bold                =  2,

+    italics             =  4,

+    reverse             =  8,*)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is underline, is slow;

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+paper size (8.0 * 2.54, 12.0 * 2.54);

+std speed  ("slow");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27""64"");                       (* Reset des Druckers             *)

+    out (""27"R"0"");                       (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36));  (* Formularlaenge                 *)

+    out (""27"m"4"");                       (* graphischer Zeichensatz        *)

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + x rest) DIV blankbreite;

+        low  := (x steps + x rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+        IF low  > 0 AND is slow

+           THEN IF is underline THEN out (" "8"") FI;

+                out (""27"Y"+ code (low) + ""0"");

+                low TIMESOUT ""0"";

+                x rest := 0;

+           ELSE x rest := low;

+        FI;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"Y");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite := char pitch (font nr, " ");

+    IF pos (font string (font nr), ""27"S") <> 0 THEN small DECR 1 FI;

+    out (font string (font nr));

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson rx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 19.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.rx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.rx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.std b/system/printer-9nadel/1986/src/printer.std
new file mode 100644
index 0000000..587e582
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.std
@@ -0,0 +1,431 @@
+PACKET std printer 

+ 

+(************************************************************************)

+(*                                              Stand   : 29.07.86      *)

+(*   STANDARD PRINTER                           Version : 4             *)

+(*                                              Autor   : Rudolf Ruland *)

+(************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size :

+ 

+LET underline           =  1,

+    bold                =  2,

+    italics             =  4,

+    reverse             =  8,

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR high, rest, blankbreite;

+REAL VAR x size, y size;

+ 

+(*********************************************************************)

+

+paper size (8.0 * 2.54, 12.0 * 2.54);

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    x steps      := x step conversion ( x size );

+    y steps      := y step conversion ( y size );

+    out (off string (underline));

+    out (off string (bold));

+    out (off string (italics));

+    out (off string (reverse));

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    rest    := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    remaining y steps TIMESOUT ""10""

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    rest := 0;

+    out (""13"")

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+        THEN stop

+    ELIF x steps > 0

+        THEN x move

+    ELIF y steps > 0

+        THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + rest) DIV blankbreite;

+        rest := (x steps + rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+ 

+    . y move :

+        y steps TIMESOUT ""10""

+ 

+. 

+  draw :

+    IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+       THEN stop

+       ELSE x draw

+    FI

+ 

+    . x draw :

+        high := (x steps + rest) DIV blankbreite;

+        rest := (x steps + rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT "_" FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification))

+       ELSE stop

+    FI

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification))

+       ELSE stop

+    FI

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite := char pitch (font nr, " ");

+    out (font string (font nr));

+ 

+END PROC execute;

+ 

+ 

+END PACKET std printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.std",

+    up           = ""3""13""5"" ;

+ 

+TEXT VAR fonttab name := "fonttab.std";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for font table;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+.

+  ask for font table :

+    line;

+    fonttab name CAT char pitch;

+    line;

+    fonttab name CAT language

+ 

+    . char pitch :

+        REP out (up); 

+            IF yes ("Zeichenbreite des Druckers : 10 Zeichen pro Zoll")

+               THEN LEAVE char pitch WITH "-10" FI;

+            out (up);

+            IF yes ("Zeichenbreite des Druckers : 12 Zeichen pro Zoll")

+               THEN LEAVE char pitch WITH "-12" FI;

+        PER;

+        ""

+ 

+    . language :

+        REP out (up); 

+            IF yes ("Zeichensatz des Druckers : deutsch") 

+               THEN LEAVE language WITH "" FI;

+            out (up);

+            IF yes ("Zeichensatz des Druckers : ascii") 

+               THEN LEAVE language WITH ".ascii" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/printer/laser/readme b/system/printer-laser/4/doc/readme
index 019d75c..019d75c 100644
--- a/printer/laser/readme
+++ b/system/printer-laser/4/doc/readme
diff --git a/system/printer-laser/4/source-disk b/system/printer-laser/4/source-disk
new file mode 100644
index 0000000..d21e78b
--- /dev/null
+++ b/system/printer-laser/4/source-disk
@@ -0,0 +1 @@
+grundpaket/08_std.printer_laser.img
diff --git a/printer/laser/fonttab.apple.laserwriter b/system/printer-laser/4/src/fonttab.apple.laserwriter
index bee2d6a..bee2d6a 100644
--- a/printer/laser/fonttab.apple.laserwriter
+++ b/system/printer-laser/4/src/fonttab.apple.laserwriter
diff --git a/printer/laser/fonttab.canon.lbp-8 b/system/printer-laser/4/src/fonttab.canon.lbp-8
index 45314ac..45314ac 100644
--- a/printer/laser/fonttab.canon.lbp-8
+++ b/system/printer-laser/4/src/fonttab.canon.lbp-8
diff --git a/printer/laser/fonttab.epson.sq b/system/printer-laser/4/src/fonttab.epson.sq
index a3f7af3..a3f7af3 100644
--- a/printer/laser/fonttab.epson.sq
+++ b/system/printer-laser/4/src/fonttab.epson.sq
diff --git a/printer/laser/fonttab.hp.laserjet b/system/printer-laser/4/src/fonttab.hp.laserjet
index 4082e46..4082e46 100644
--- a/printer/laser/fonttab.hp.laserjet
+++ b/system/printer-laser/4/src/fonttab.hp.laserjet
diff --git a/printer/laser/fonttab.kyocera.f-1010 b/system/printer-laser/4/src/fonttab.kyocera.f-1010
index 9c3fbda..9c3fbda 100644
--- a/printer/laser/fonttab.kyocera.f-1010
+++ b/system/printer-laser/4/src/fonttab.kyocera.f-1010
diff --git a/printer/laser/fonttab.nec.lc-08 b/system/printer-laser/4/src/fonttab.nec.lc-08
index f032953..f032953 100644
--- a/printer/laser/fonttab.nec.lc-08
+++ b/system/printer-laser/4/src/fonttab.nec.lc-08
diff --git a/printer/laser/genfont.kyocera.f-1010.dynamic1 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
index fae8c09..fae8c09 100644
--- a/printer/laser/genfont.kyocera.f-1010.dynamic1
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
diff --git a/printer/laser/genfont.kyocera.f-1010.dynamic2 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
index f425a7f..f425a7f 100644
--- a/printer/laser/genfont.kyocera.f-1010.dynamic2
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
diff --git a/printer/laser/laser.inserter b/system/printer-laser/4/src/laser.inserter
index c28766f..c28766f 100644
--- a/printer/laser/laser.inserter
+++ b/system/printer-laser/4/src/laser.inserter
diff --git a/printer/laser/printer.apple.laserwriter b/system/printer-laser/4/src/printer.apple.laserwriter
index d4c6adf..d4c6adf 100644
--- a/printer/laser/printer.apple.laserwriter
+++ b/system/printer-laser/4/src/printer.apple.laserwriter
diff --git a/printer/laser/printer.canon.lbp-8 b/system/printer-laser/4/src/printer.canon.lbp-8
index 4dfe9f8..4dfe9f8 100644
--- a/printer/laser/printer.canon.lbp-8
+++ b/system/printer-laser/4/src/printer.canon.lbp-8
diff --git a/printer/laser/printer.epson.sq b/system/printer-laser/4/src/printer.epson.sq
index 63e474f..63e474f 100644
--- a/printer/laser/printer.epson.sq
+++ b/system/printer-laser/4/src/printer.epson.sq
diff --git a/printer/laser/printer.hp.laserjet b/system/printer-laser/4/src/printer.hp.laserjet
index 152ee8e..152ee8e 100644
--- a/printer/laser/printer.hp.laserjet
+++ b/system/printer-laser/4/src/printer.hp.laserjet
diff --git a/printer/laser/printer.kyocera.f-1010 b/system/printer-laser/4/src/printer.kyocera.f-1010
index a46f7b3..a46f7b3 100644
--- a/printer/laser/printer.kyocera.f-1010
+++ b/system/printer-laser/4/src/printer.kyocera.f-1010
diff --git a/printer/laser/printer.nec.lc-08 b/system/printer-laser/4/src/printer.nec.lc-08
index 9ee2837..9ee2837 100644
--- a/printer/laser/printer.nec.lc-08
+++ b/system/printer-laser/4/src/printer.nec.lc-08
diff --git a/system/ruc-terminal/unknown/doc/BIOSINT.PRT b/system/ruc-terminal/unknown/doc/BIOSINT.PRT
new file mode 100644
index 0000000..26bde5a
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/BIOSINT.PRT
@@ -0,0 +1,281 @@
+#type ("17.klein")# 

+Interrupts/Traps/Exeptions (Bios)                                 29.04.87

+ 

+Interrupt: IRQn (Durch Hardware ausgelöst, werden auf Traps umgelenkt) 

+Trap     : INTn (Durch Software ausgelöst) 

+Exeption : INTn (Im Protected Mode vom Prozessor ausgelöst) 

+ 

+Traps   | Funktion 

+--------+------------------------------------------------------------------ 

+INT 00H : Abort Program

+INT 01H : 

+INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) 

+INT 03H : INT3 - Break

+INT 04H : INTO - Overflow

+INT 05H : Print Screen 

+INT 06H : 

+INT 07H : 

+INT 08H : IRQ0 System Interrupt 

+INT 09H : IRQ1 Keyboard Buffer full

+INT 0AH : Software redirected from IRQ9 

+INT 0BH : IRQ3 Serial Port 2 

+INT 0CH : IRQ4 Serial Port 1 

+INT 0DH : IRQ5 Parallel Port 2 

+INT 0EH : IRQ6 Diskette Interrupt 

+INT 0FH : IRQ7 Parallel Port 1 

+ 

+INT 10H : Video Trap 

+  ah = 00H : set mode (al = mode) 

+             (Videoram: Herkules: B0000 

+                        EGA     : B8000)

+             al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten 

+             ---+------+-------+---------+---------+-------+-------- 

+             00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*|   8 

+             01 | Text |640x200| 40 x 25 | Color   | 16/64*|   8 

+             02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*|   8 

+             03 | Text |640x200| 80 x 25 | Color   | 16/64*|   8 

+             04 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             05 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             06 | Graf |640x200| 80 x 25 | Mono/Col|   2   |   1 

+             07 | Text |720x348| 80 x 25 | Mono    |   4   |   8 

+             08 | Graf |720x348| 90 x 48 | Mono    |   2   |   1

+       --------- ab hier nicht implementiert, nur EGA ------------------ 

+             VideoRAM-Adresse A0000

+             0D | Graf |320x200| 40 x 25 | Color   |  16   |   8 

+             0E | Graf |640x350| 80 x 25 | Color   |  16   |   4 

+             0F | Graf |640x350| 80 x 25 | Mono    |   4   |   2 

+             10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*|   2 

+                                                           * mit EGA-Monitor 

+  ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) 

+             CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks 

+  ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile)

+  ah = 03H : read cursor 

+             Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des 

+                      Cursorblocks, CH=Endzeile des Cursorblocks

+  ah = 04H : read lightpen 

+             Ausgang: AH=1 : Register sind gültig, AH=0: Taste nicht gedrückt

+                      DH = Zeile, DL = Spalte des Lightpens

+                      CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) 

+                      BX = Rasterspalte (1..319/1..639) 

+  ah = 05H : set actual display (AL = Neue Seite)

+  ah = 06H : scroll up 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 07H : scroll down 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 08H : read current attribute and char

+             Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) 

+  ah = 09H : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe

+  ah = 0AH : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen 

+  ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) 

+  ah = 0CH : write dot 

+             BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird

+             alte Farbe mit neuer Farbe geXORed)

+  ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert)

+  ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) 

+  ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl

+                                   Zeichenspalten, BH=Seite)

+  ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) 

+  ax = 1142H: draw line (EGA-Bios: 12 Routinen für den Charactergenerator) 

+             CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to

+  ah = 12H : reserved (EGA-Bios: Alternate Characterset) 

+  ah = 13H : write string

+             Allgemein: 

+               ES:BP = Stringanfang 

+               CX = Stringlänge

+               DL, DH = Cursorposition (Stringanfang) 

+               BH = Seite 

+       al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht 

+               bewegt.

+       al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt.

+       al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. 

+       al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. 

+ 

+INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) 

+          AX : 

+             Bit 1 : 80287 installiert

+             Bit 3 : Herkules installiert

+             Bit 4/5   : 0 = No Primary Display set 

+                         1 = Monochrome 

+                         2 = Color 80 * 25 

+                         3 = EGA

+             Bit 6     : Drive B installiert

+             Bit 9..12 : Anzahl RS232

+             Bit 14/15 : Anzahl Printer

+ 

+INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) 

+ 

+INT 13H : Hardisk Trap 

+          Allgemein: 

+          DL = Drive (0, 1...) 

+          AL = Sector count 

+          CX = Bit 0... Bit 5 = Sector 

+               Bit 6... Bit 15 = Cylinder 

+          Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) 

+  ah = 0 reset diskette, wd1010, hdisks 

+  ah = 1 return status 

+  ah = 2 read 

+  ah = 3 write 

+  ah = 4 verify 

+  ah = 5 format 

+  ah = 8 drive params 

+  ah = 9 init drive 

+  ah = A read long 

+  ah = B write long 

+  ah = C seek 

+  ah = D reset wd1010 (DL = Drive) 

+  ah =10 ready test

+  ah =11 reclibrate 

+  ah =14 check controller  

+  ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) 

+ 

+INT 14H : RS232C Trap 

+  Allgemein: dx = port (>= 1FE0H : SCC = 8530) 

+  ah = 0 : Init

+           al : Bit 5..7 = Baudrate 

+                    000 = 110,

+                    001 = 150, 

+                    010 = 300, 

+                    011 = 600, 

+                    100 = 1200, 

+                    101 = 2400, 

+                    110 = 4800, 

+                    111 = 9600, 

+                Bit 3..4 = Parity    (no, odd, even) 

+                Bit 2    = Stopbits  (1, 2)

+                Bit 0..1 = Datenbits (5, 6, 7, 8)

+  ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) 

+  ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen)

+  ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) 

+           ah : Bit 0 = 1 : Data available 

+                Bit 1 = 1 : Receiver overrun 

+                Bit 2 = 1 : Parity Error 

+                Bit 3 = 1 : Framing Error 

+                Bit 4 = 1 : Transmitter empty 

+                Bit 5 = 1 : Break received 

+ 

+INT 15H : Utility Trap 

+  ah = 80H open device (nicht implementiert) 

+  ah = 81H close device (nicht implementiert)

+  ah = 82H prog term (nicht implementiert)

+  ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) 

+           Ausgang: CY=0, Event wait wurde aktiviert 

+                    CY=1, Noch kein RTC-Event aufgetreten 

+                          (INT 15H periodisch aufrufen zum pollen)

+  ah = 84H joy stick (Eingang: DX)

+       DX = 0: Ausgang: AL (Bits 4..7) = Buttons 

+       DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb

+  ah = 85H sys request (nicht implementiert) 

+  ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) 

+  ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block

+           Descriptoren: 8 Bytes Source, 8 Bytes Destination)

+  ah = 88H extended memory (Ausgang: AX= KB extended Memory) 

+  ah = 89H enter protected mode

+  ax = 8A42H run setup 

+  ax = 8B42H error beep

+  ax = 8C42H usr-powerfail-shutdown-routine

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS abgelegt werden) 

+  ax = 8D42H usr-powerfail-resume-routine 

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS geholt werden) 

+  ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue 

+                                 BH: Bit 0 = BCD, Bit 1..3 = Mode, 

+                                     Bit 4..5 Write CMD, Bit 6/7 unused) 

+                       (Timer wird bei Resume wieder so initialisert)

+  ax = 8F42H hardcopy (Grafik & Mono)

+  ah = 90H device busy (nicht implementiert)

+  ah = 91H set int complete (nicht implementiert)

+  ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI 

+                              = Destinationadr.)

+  ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = 

+                                Destinationadr.)

+INT 16H : Keyboard Trap 

+  ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0)

+  ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue)

+  ah = 02 Shift status (Ausgang: AL = KB_flag) 

+  ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) 

+  ax = 0442 soft power down 

+ 

+INT 17H : Printer Trap

+  Allgemein: dx = port 

+  ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) 

+  ah = 1 : init printer port 

+  ah = 2 : ah = Status 

+ 

+INT 18H : Basic (nicht implementiert) 

+ 

+INT 19H : Bootstrap Trap 

+  Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) 

+  Der Block hat in Bytes 510/511 das Kennzeichen AA55H. 

+ 

+INT 1AH : Time of day Trap

+  ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow)

+  ah = 1 : Set Timer (CS=Timer low, DX=Timer high)  

+  ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) 

+  ah = 3 : Set Clock  (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std)

+  ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std)

+  ah = 7 : Reset Alarm 

+ 

+INT 1BH : Dummy Return 

+ 

+INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen.

+ 

+INT 1DH : Zeigt auf die Video Parameter

+INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) 

+INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255

+

+INT 20H ... INT 3FH sind für das Betriebssystem reserviert.

+ 

+INT 20H : DOS: Terminate Program

+INT 21H : DOS: Function Call

+INT 22H : DOS:

+INT 23H : DOS:

+INT 24H : DOS: 

+INT 25H : DOS: 

+ 

+INT 40H : Diskette Trap 

+  AH = 0 disk reset 

+  AH = 1 disk status (ret) 

+  AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren,

+                    DH = Head, DL = Drive, CL = Sektor, CH = Cylinder)

+  AH = 3 disk write           "

+  AH = 4 disk verify          "

+  AH = 5 disk format          "

+  AH = 21 disk type  (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) 

+  AH = 22 disk change 

+  AH = 23 format set 

+ 

+INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios unterstützt)

+ 

+INT 4AH : Für User software redirected from RTC-IRQ (Alarm, periodic) 

+ 

+INT 60H 

+  ...     User 

+INT 6FH

+ 

+Hardware-Interrupts 8..15:

+INT 70H : IRQ 8 RTC-Interrupt

+INT 71H : IRQ 9 Software Redirected to INT 0AH 

+INT 72H : IRQ10 Frei

+INT 73H : IRQ11 Frei 

+INT 74H : IRQ12 Frei 

+INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) 

+INT 76H : IRQ14 Harddisk Interrupt

+INT 77H : IRQ15 Frei

+ 

+INT 78H : User 0

+INT 79H : User 1

+INT 7AH : User 2

+INT 7BH : User 3

+INT 7CH : User 4

+INT 7DH : User 5 

+INT 7EH : User 6

+INT 7FH : User 7

diff --git a/system/ruc-terminal/unknown/doc/MACROS.PRT b/system/ruc-terminal/unknown/doc/MACROS.PRT
new file mode 100644
index 0000000..4a3b78f
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/MACROS.PRT
@@ -0,0 +1,54 @@
+#*t ($1)# 

+#topage("$1")#

+#*macroend# 

+

+

+#*linie ($1)# 

+#rpos($1)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos#

+#*macroend# 

+ 

+

+

+#*k ($1, $2)#

+#type("8")##center##ib(3)#$1  $2#ie(3)##type("elite")# 

+#*macroend#

+ 

+

+

+

+

+#*h ($1, $2)#

+#type("8")##center##on("i")##on("u")##ib(3)#$1  $2#ie(3)##off("u")##off("i")##type("elite")# 

+#headodd#

+#center##on("b")#$1  $2#off("b")# 

+ 

+ 

+ 

+#end#

+#*macroend#

+ 

+

+

+

+

+#*kopf ($1)#

+#headeven#

+#center##on("b")#$1#off("b")# 

+ 

+ 

+ 

+#end# 

+#bottomodd# 

+ 

+ 

+ α 

+#end# 

+#bottomeven# 

+ 

+ 

+#right#α 

+#end# 

+#*macroend#

diff --git a/system/ruc-terminal/unknown/doc/TDOC.PRT b/system/ruc-terminal/unknown/doc/TDOC.PRT
new file mode 100644
index 0000000..2326c5e
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TDOC.PRT
@@ -0,0 +1,3012 @@
+#type ("elite")##limit (16.2)##block# 

+ 

+#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# 

+ 

+#center#Version 1.1 

+ 

+#center#Oktober 1986 

+#free (16.0)# 

+ruc - Rolf Uhlig Computer 

+GmbH & Co Kommanditgesellschaft 

+Sendenhorster Straße 82 

+D - 4406 Drensteinfurt 1 

+Telefon 02508/8500 

+ 

+Michael Staubermann 

+Moränenstraße 29 

+D - 4400 Münster-Hiltrup 

+Telefon 02501/4320 

+#pagenr (""224"", 1)##page (1)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("1.", "Einige Worte zuvor")# 

+ 

+ 

+Dieses Terminalprogramm wird in zwei Versionen (für den Basis 108 und den

+Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich

+(BASIS oder APPLE). 

+ 

+Eigenschaften des Terminals: 

+ 

+- Kommandozeilen für schnelle Offline Parametereinstellung 

+- Statuszeile für spezielle Betriebzustände 

+- Über 70 programmierbare Funktionstasten 

+- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) 

+- 7935 Zeichen Empfangspuffer 

+- Verschiedene Hardcopy Modi für Text und Graphik 

+- 192x280 Punkte auflösender Graphikmodus mit zwei Helligkeitsstufen 

+- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung 

+- Viele Graphikroutinen (Bogen, Flächenfüllung, Kreis, Rechteck...) 

+- Graphikmodus für Texte in verschieden Richtungen, Dicken, Grössen 

+- Griechische Graphikzeichen und Kursivschrift 

+- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken 

+ 

+ 

+Zum Handbuch 

+ 

+Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und

+in spitze Klammern gesetzt (z.B. <TAB>) in einigen Fällen auch durch ihren

+Namen (z.B. <DOWN> oder <TOPLEFT>). Eine zusätzlich zu betätigende Umschalt-

+taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in

+der Klammer davorgestellt (z.B. <SHIFT RETURN>). 

+ 

+Nicht druckbare Ascii-Codes (z.B. <ESC> oder <SPACE>), sowie Kommandopara-

+meter (z.B. <n>) werden ebenfalls in spitze Klammern gesetzt. Komandopara-

+meter werden mit Kleinbuchstaben bezeichnet. 

+ 

+#page# 

+#h("2.", "Die Hardware")# 

+ 

+ 

+Unterstützt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein

+Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen

+werden. 

+ 

+ 

+#k("2.1", "Die serielle Schnittstelle")# 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host oder vom Terminal

+(LOCAL) eingestellt werden (Siehe Kommando <ESC> <SPACE> <SPACE>). Es wer-

+den alle 15 gängigen Baudrates zwischen 50 und 19200 Baud unterstützt. Pari-

+tycheck kann mit gerader oder ungerader Parität durchgeführt werden. Fluß-

+kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF möglich.

+Empfohlen wird DTR/DSR oder XON/XOFF. 

+ 

+             Benötigte Verdrahtung der seriellen Schnittstelle 

+ 

+            Pin                                        Priorität 

+              2 : TXD Sendedaten    zum Host (RXD)         1 

+              3 : RXD Empfangsdaten vom Host (TXD)         1 

+              4 : RTS Ready To Send zum Host (CTS)         3 

+              5 : CTS Clear To Send vom Host (RTS)         3 

+              6 : DSR DataSet Ready vom Host (DTR)         2 

+              7 : Masse an Host Masse                      1 

+              8 : DCD Eingang, nicht benötigt 

+             20 : DTR Data Terminal Ready zum Host (DSR)   2 

+ 

+Priorität: 

+ 1 : Muß verdrahtet werden 

+ 2 : Ist bei DSR/DTR Flußkontrolle zu verdrahten 

+ 3 : Ist bei RTS/CTS Flußkontrolle zu verdrahten 

+ 

+Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host

+nur über 7 Bit Datentransfer verfügen, müssen einige Einschränkungen bei der

+Parameterübergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die

+Anzahl der Datenbits kann auch in der Kommandozeile verändert werden. 

+ 

+ 

+#k("2.2", "Der Reset")# 

+ 

+Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm-

+seiten und Puffer, sowie der Druckerspooler werden gelöscht. Der Reset kann

+vom Host durch 

+ 

+                         #ib(1)#<ESC> 0#ie(1)#    (Hex 1B 30) 

+ 

+initiiert werden, vom Basiskeyboard aus durch <SHIFT SHIFT CTRL>. Die Para-

+meter in der Kommandozeile werden dem Setup entnommen. Nach dem Löschen

+aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies

+ist die Funktionstaste <SHIFT BOTRIGHT>. 

+ 

+#page# 

+#h("3.", "Die Kommandozeile")# 

+ 

+ 

+Die wichtigsten Parameter des Terminals können im laufenden Betrieb in den

+beiden Kommandozeilen geändert werden. Die erste Kommandozeile erscheint

+beim Basiskeyboard durch Drücken von <SHIFT CE> und beim Apple durch <OA

+CTRL X>. 

+ 

+Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen

+(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mög-

+lichkeit wichtige Parameter in der Kommandozeile zu ändern. 

+ 

+Die angezeigten Einstellungen bieten außerdem eine Informationsmöglichkeit

+über die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite

+Kommandozeile enthält die Parameter der seriellen Schnittstelle. 

+ 

+Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF)

+können auch durch ESC-Kommandos vom Host oder im Localmodus geändert wer-

+den. 

+Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen

+sichtbar sind. 

+ 

+ 

+#k("3.1", "Tastenfunktionen in der Kommandozeile")# 

+ 

+Folgende Tasten haben in der Kommandozeile eine Wirkung: 

+ 

+Taste              Bedeutung 

+#linie ("16.2")#

+<UP> oder <DOWN>   Wechselt in die jeweils andere Kommandozeile 

+ 

+<LEFT>             Springt zum vorherigen (linken) Parameter ohne etwas zu

+                   verändern. 

+ 

+<RIGHT>            Springt zum nächsten (rechten) Parameter ohne etwas zu

+                   verändern. 

+ 

+<SPACE>            Ändert das selektierte Parameterfeld. Das selektierte

+                   Parameterfeld ist durch Invertierung hervorgehoben. Die

+                   möglichen Parameter wiederholen sich zyklisch. 

+ 

+<ESC>              Die Kommandozeile wird verlassen. Es werden keine Ände-

+                   rungen durchgeführt. 

+ 

+<SHIFT S>          Die Kommandozeile wird verlassen. Vorher werden alle

+                   Änderungen permanent auf die Diskette geschrieben. Wei-

+                   tere Einzelheiten s.u. (Setup) 

+ 

+<SHIFT R>          Alle Parameter werden auf ihre Defaultwerte zurückge-

+                   setzt. Die Kommandozeile wird noch nicht verlassen, daher

+                   kann dieser 'Reset' durch <ESC> wieder aufgehoben werden. 

+                   <CE> oder <CTRL X> Die Kommandozeile wird verlassen. Die

+                   Änderungen werden nur im Speicher vermerkt. Nach dem

+                   Ein-/Ausschalten des Rechners werden die alten Parameter

+                   von der Diskette gelesen. Wird allerdings ein Hardware-

+                   reset (s.o.) durchgeführt, sind diese Änderungen nicht

+                   verloren. 

+ 

+ 

+#k("3.2", "Setup")# 

+ 

+Beim Setup, der in der Kommandozeile durch <SHIFT S> ausgelöst werden kann,

+werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann

+'permanent' und müssen nach dem Einschalten des Terminals nicht neu einge-

+stellt werden. Diese Parameter sind die 

+- Parameter der seriellen Schnittstelle (2. Kommandozeile) 

+- anderen Parameter der Kommandozeilen 

+- vom Benutzer programmierte Belegung der Funktionstasten 

+- Druckerspezifischen Hardcopyparameter 

+ 

+Vor dem Setup ist zu prüfen, ob der Diskettenschreibschutz entfernt wurde

+(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte

+nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent-

+fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In

+diesem Falle erscheint nach dem Drücken einer Taste wieder die Kommando-

+zeile. 

+Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er-

+scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh-

+ler)!'. Weitere Schreibversuche sind möglicherweise erfolgreich. 

+ 

+ 

+#k("3.3", "Die zweite Kommandozeile")# 

+ 

+Beim Basis (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+USA  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+APL       HEX ON                                                  CUR OFF 

+UNI 

+#type ("elite")# 

+ 

+Beim Apple (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+FLH  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+          HEX ON                                                  CUR OFF 

+#type ("elite")# 

+ 

+ 

+Default Andere   Funktion 

+#linie ("16.2")# 

+Basis 

+ GER    USA      Die Zeichensatzeinstellung ist für die gebräuchlichsten 

+        APL      vier Zeichensätze in der Kommandozeile möglich. 

+        UNI      GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz

+                 UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der

+                 APL-Zeichensatz entählt auch die Zeichen [\]{|}~. Über

+                 ESC-Kommandos lassen weitere Möglichkeiten einstellen. 

+ 

+ BASIS  TVI      Keyboard Emulation. BASIS sendet die Funktionstastencodes

+                 mit Bit 7 = 1. TVI sendet für jede Funktionstaste eine

+                 Zeichenfolge <SOH> x <CR>. Die Cursortasten sowie DEL CHAR,

+                 INS CHAR, DEL LINE, INS LINE werden wie bei TVI üblich

+                 gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) 

+ 

+Apple 

+ USA    FLH      USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken

+                 und Invers. 

+ 

+ APPLE  TVI      Keyboard Emulation. APPLE führt keine Codeumsetzung durch.

+                 Wird allerdings die <OPEN APPLE>-Taste mit einer anderen

+                 Taste zusammen gedrückt, wird das Bit 7 im Code auf 1 ge-

+                 setzt. Zur TVI-Emulation siehe oben. 

+ 

+MON OFF MON ON   Der Monitor Modus wird mit MON ON eingeschaltet. In diesem 

+        HEX ON   Modus werden alle Steuerzeichen auf dem Bildschirm mar-

+                 kiert ausgegeben. Bis auf die Kommandos <ESC> u oder <ESC>

+                 X (um den Monitormodus auszuschalten) werden keine Komman-

+                 dos interpretiert. Alle anderen Zeichen werden unverändert

+                 dargestellt. Der Monitormodus kann auch durch MON OFF aus-

+                 geschaltet werden. 

+                 Im Hexmodus werden keine Zeichen, sondern deren Ascii-

+                 Codes in Hexadezimaldarstellung ausgegeben. 

+ 

+PRT OFF PRT ON   Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden

+                 alle Zeichen die von der seriellen Schnittstelle kommen,

+                 auf dem Drucker ausgegeben bzw. in den Druckerspooler ge-

+                 schrieben. Die Bildschirmausgabe wird hiervon nicht beein-

+                 flußt. 

+ 

+SCRN ON SCR OFF  Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer-

+                 den alle Zeichen die von der seriellen Schnittstelle kom-

+                 men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann

+                 zum Beispiel benutzt werden, um Daten nur an den Drucker zu

+                 schicken, ohne daß diese auch auf dem Bildschirm erschei-

+                 nen. 

+ 

+KEY CLK CLK OFF  Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede

+                 Taste (bis auf SHIFT, CTRL) bei ihrer Betätigung einen Ton

+                 (Klick) von sich. CLK OFF schaltet dies ab. 

+ 

+NORVID  REVVID   Bildschirmdarstellung. NORVID stellt hellen Text auf

+                 schwarzem Grund dar, REVVID stellt schwarzen Text auf hel-

+                 lem Grund dar (Möglicherweise angenehmer für die Augen). 

+ 

+SCROLL  PAGE     Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile

+                 nach oben geschoben, sobald der Cursor in der letzten Bild-

+                 schirmzeile steht und ein Zeilenvorschub <LF> ausgeführt

+                 werden soll. Die erste Bildschirmzeile verschwindet. Ist

+                 PAGE eingeschaltet, springt der Cursor in einer solchen

+                 Situation in die erste Bildschirmzeile. Die Cursorspalte

+                 wird dabei nicht verändert. 

+ 

+BELL ON BELL OFF Normalerweise erzeugt jedes empfangene <CTRL G> einen kur-

+                 zen Signalton. Wenn das stört, kann die Tonausgabe mit BELL

+                 OFF abgeschaltet werden. 

+ 

+CUR FLH CUR STD  Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF

+                 Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor-

+                 block. CUR OFF schaltet den Cursor ab (unsichtbar). 

+ 

+F STRG  F CODE   Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt

+                 eine programmierte (belegte) Funktionstaste keinen Tasten-

+                 code, sondern sendet die programmierten Zeichen. Eine unbe-

+                 legte Funktionstaste sendet ihren Tastencode. Ist F CODE

+                 eingeschaltet, erzeugen auch belegte Funktionstasten einen

+                 Tastencode und senden keine programmierten Zeichen. 

+ 

+ 

+#k("3.4", "Die zweite Kommandozeile")# 

+ 

+Die erste Zeile zeigt Defaultwerte für <SHIFT R>: 

+ 

+#type ("micron")# 

+STATOFF|TXT| 9600|STOP 1|DATA 8|NO  PAR|NO XONOFF|NO RTSCTS|NO DTRDSR 

+STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR  XON/XOFF  RTS/CTS   DTR/DSR 

+               50               ODD PAR 

+               75 

+            109.9 

+            134.6 

+              150 

+              300 

+              600 

+             1200 

+             1800 

+             2400 

+             3600 

+             4800 

+             7200 

+#type ("elite")# 

+ 

+Default Andere   Funktion 

+#linie ("16.2")# 

+STATOFF STAT ON  Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms

+                 beträgt zwar immer 24 Zeilen, allerdings ist bei STAT ON

+                 anstelle der 24. Textzeile die Statuszeile sichtbar. Bei

+                 STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht-

+                 bar. Einzelheiten s.u. (Die Statuszeile) 

+ 

+TXT     GFX      Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen

+                 Textdarstellung um. GFX schaltet auf die aktuelle Graphik-

+                 seite um. 

+ 

+9600    19200    Wählt die Baudrate für die serielle Schnittstelle. 

+           50    Die Angabe erfolgt in Bits/Sekunde (Baud) 

+           75 

+          109.9 

+          134.6 

+          150 

+          300 

+          600 

+         1200 

+         1800 

+         2400 

+         3600 

+         4800 

+         7200 

+ 

+STOP 1  STOP 2   Wählt die Anzahl der Stopbits für die serielle Schnitt-

+                 stelle. 

+ 

+DATA 8  DATA 7   Wählt die Anzahl der Datenbits für die serielle Schnitt-

+                 stelle. 

+ 

+NO PAR  EVN PAR  Wählt Parity Check Art. NO PAR = Kein Paritätsbit, keine 

+        ODD PAR  Paritätsprüfung. EVN PAR = Gerade Parität, ODD PAR = Unge-

+                 rade Parität. 

+ 

+NO XONOFF        Wählt XON (CTRL Q) und XOFF (CTRL S) als Protokoll für die 

+        XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann

+                 das Terminal noch 255 Zeichen empfangen, bis der Empfangs-

+                 puffer überläuft. Mit NO XONXOFF wird dieses Protokoll

+                 ausgeschaltet. 

+ 

+NO RTSCTS        Wählt RTS/CTS als Protokoll für die serielle Schnittstel-

+        RTS/CTS  le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. 

+ 

+NO DTRDSR        Wählt DTR/DSR als Protokoll für die serielle Schnittstel-

+        DTR/DSR  le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. 

+ 

+#page# 

+#h("4.", "Die Statuszeile")# 

+ 

+ 

+Die Statuszeile enthält 5 Felder, die über die wichtigsten Betriebszustände

+des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin-

+tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit

+STAT ON oder vom Host oder im Local Modus mit 

+ 

+                         #ib(1)#<ESC> }#ie(1)#   (Hex 1B 7D) 

+ 

+eingeschaltet werden. Ausschalten ebenso mit STATOFF oder 

+ 

+                         #ib(1)#<ESC> {#ie(1)#   (Hex 1B 7B) 

+ 

+Die Zuordnung der Felder: 

+ 

+#type ("micron")# 

+Spooler | Empfängerpuffer | Senderpuffer | Bereit/Beschäftigt | Local/Online

+#type ("elite")# 

+ 

+Kritische Zustände werden invers markiert. Dies sind alle Fälle, in denen

+ein Puffer überläuft. 

+Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. 

+Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe

+mehr annehmen, kann man durch längeres Drücken von <SHIFT ESC> Zeichen aus

+dem Druckerpuffer entfernen, damit wieder Platz frei wird. 

+Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich

+daran, daß der Host kein XON gesendet hat oder dieses falsch übertragen

+wurde. Durch Drücken von <SHIFT ESC> kann man den Transmitter wieder star-

+ten. 

+ 

+ 

+#k("4.1", "Spoolerstatus")# 

+ 

+- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist

+  nichts zum Drucken im Puffer. 

+ 

+- PRINT zeigt an: Der Spooler ist gefüllt. Das Terminal ist druckwillig oder

+  der Drucker druckt. 

+ 

+- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei-

+  teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man

+  einzelne Zeichen mit <SHIFT ESC> aus dem Druckerpuffer entfernen bis PRINT

+  im Feld erscheint. 

+ 

+ 

+#k("4.2", "Empfängerstatus")# 

+ 

+- Ein leeres Feld bedeutet: Im Empfängerpuffer ist noch Platz. 

+ 

+- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfängerpuffer

+  voll ist. 

+ 

+ 

+#k("4.3", "Senderstatus")# 

+ 

+- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge-

+  sendet werden muß, wird es sofort auf die serielle Schnittstelle ge-

+  schickt. 

+  Ein > vor TX ON zeigt an, daß das Terminal auf Freiwerden der seriellen

+  Schnittstelle wartet. 

+ 

+- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware-

+  flußkontrolle aktiviert, um das Terminal zu stoppen. 

+ 

+- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine

+  Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit <SHIFT ESC>

+  erzwungen werden. 

+ 

+ 

+#k("4.4", "Busy - Anzeige")# 

+ 

+- READY bedeutet: Der Empfänger ist empfangsbereit, d.h. im Empfangspuffer

+  sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht

+  per Flußkontrolle gestoppt. 

+ 

+- BUSY bedeutet: Der Empfänger hat dem Host per Flußkontrolle angezeigt, daß

+  nicht mehr genügend Platz im Empfangspuffer war. Die Flußkontrolle wird

+  wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. 

+  (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrückt wird und der Host

+  #on("u")#nicht#off("u")# empfangsbereit ist, gerät das Terminal in eine

+  "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset

+  abgebrochen werden kann.) 

+ 

+ 

+#k("4.5", "Online/Local - Anzeige")# 

+ 

+- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp-

+  fängt Zeichen und Kommandos vom Host. 

+ 

+- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei-

+  ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter-

+  minal. 

+ 

+#page# 

+#h("5.", "Die Bedeutung der Tasten")# 

+ 

+ 

+Zusätzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind

+einige weitere zur Verfügung gestellt worden. Beim Apple senden fast alle

+Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom

+Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden

+einige bisher nur einfach belegte Tasten wie <RETURN>, <TAB>, <ESC>, <CE>

+und der Zehnerblock mit Doppelfunktionen über <SHIFT> versehen. 

+ 

+ 

+#k("5.1", "Die Funktions- und Steuertasten")# 

+ 

+Zuerst werden die Tastenfunktionen erläutert für ein nicht emulierendes

+Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden

+(1. Zeile, 2. Feld) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 0#ie(1)#    (Hex 1B 20 30) 

+ 

+Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim

+Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes

+überein. <TOPLEFT> bezeichnet beim Basiskeyboard die linke obere Eckposi-

+tion des Cursorblocks, <TOPRIGHT> die rechte obere etc. 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#linie ("16.2")# 

+<TAB>            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten. Also 1, 9, 17, 25, 33, 41, 49,

+                                       57, 65, 73. War der Cursor in Spalte

+                                       73 bis 79, dann wird er in die erste

+                                       Spalte der nächst tieferen Bild-

+                                       schirmzeile gesetzt. War der Cursor

+                                       vorher auch noch in Zeile 24, dann

+                                       wird der Bildschirminhalt entweder

+                                       nach oben gescrollt (SCROLL) oder in

+                                       Homeposition gebracht (PAGE). 

+ 

+<SHIFT TAB>      <OA TAB>      89      Back-Tab (Rückwärtstabulator). Der

+                                       Cursor wird in die nächste links vom

+                                       Cursor befindliche Tabulatorposition

+                                       gebracht. War der Cursor in Spalte 1,

+                                       dann steht er jetzt in Spalte 73 der

+                                       darüberliegenden Zeile. War der Cur-

+                                       sor in Homeposition, dann ändert sich

+                                       seine Position nicht. 

+ 

+<SHIFT CE>       <OA CTRL X>    -      Kommandozeile aktivieren. Einzelhei-

+                                       ten zur Kommandozeile siehe Abschnitt

+                                       3.: Die Kommandozeilen. 

+ 

+<CE>             <CTRL X>      18      U.a. Kommandozeile verlassen. 

+ 

+<RETURN>         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub.

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+<SHIFT RETURN>   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten (24.) Bild-

+                                       schirmzeile war, wird der Bildschir-

+                                       minhalt entweder nach oben gescrollt

+                                       (SCROLL) oder in Homeposition ge-

+                                       bracht (PAGE). 

+ 

+<UP>             <UP>       8B/0B      Cursor eine Zeile höher. War der

+                                       Cursor in der ersten Bildschirmzei-

+                                       le, ändert sich seine Position nicht. 

+ 

+<DOWN>           <DOWN>     8A/0A      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann wird der

+                                       Bildschirminhalt entweder nach oben

+                                       gescrollt (SCROLL) oder der Cursor in

+                                       die erste Bildschirmzeile gesetzt

+                                       (PAGE). 

+ 

+<CTRL V>         <CTRL V>      16      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+<LEFT>           <LEFT>     88/08      Cursor eine Spalte nach links. War

+                                       der Cursor in der ersten Bildschirm-

+                                       spalte, dann steht er jetzt in der

+                                       letzten Spalte der darüberliegenden

+                                       Bildschirmspalte. War der Cursor

+                                       allerdings in Homeposition, ändert

+                                       sich seine Position nicht. 

+ 

+<RIGHT>             -          95      Cursor eine Spalte nach rechts. War

+                                       der Cursor in Spalte 79, dann steht

+                                       er jetzt in der ersten Spalte der

+                                       folgenden Zeile. War der Cursor in

+                                       der letzten Zeile, dann wird der

+                                       Bildschirminhalt um eine Zeile nach

+                                       oben gescrollt (SCROLL) oder der

+                                       Cursor in Homeposition gebracht

+                                       (PAGE). 

+ 

+<HOME>           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+<SHIFT HOME>     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+<DELETE>         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm als Punktraster dargestellt.

+                                       Der Host interpretiert es in der

+                                       Regel als Zeichenlöschbefehl. 

+ 

+<TOPLEFT>        <OA CTRL N>   8E      Zeichen bei Cursorposition einfügen.

+                                       Der Cursor ändert seine Position

+                                       nicht. Unter dem Cursor steht dann

+                                       ein Leerzeichen. Das Zeichen in Spal-

+                                       te 79 geht verloren. 

+ 

+<SHIFT TOPLEFT>  <OA CTRL B>   82      Zeichen unter Cursorposition löschen.

+                                       In Spalte 79 steht dann ein Leerzei-

+                                       chen. 

+ 

+<TOPRIGHT>       <OA CTRL O>   8F      Zeile bei Cursorposition einfügen.

+                                       Die Cursorposition ändert sich nicht.

+                                       Der Inhalt der letzten Bildschirmzei-

+                                       le ist verloren. Die Zeile in der der

+                                       Cursor steht wird mit Leerzeichen

+                                       gefüllt. 

+ 

+<SHIFT TOPRIGHT> <OA CTRL C>   83      Zeile in der der Cursor steht lö-

+                                       schen. Die Cursorposition ändert sich

+                                       nicht. Der Inhalt der gelöschten

+                                       Zeile ist verloren. Die letzte Bild-

+                                       schirmzeile wird mit Leerzeichen

+                                       aufgefüllt. 

+ 

+<BOTTOMLEFT>     <BACKSPACE>   08      Cursor eine Spalte nach links. Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+<BOTTOMRIGHT>    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts. Die Funktion ist mit der von

+                                       <RIGHT> identisch. 

+ 

+<SHIFT BOTTOMRIGHT> <OA RIGHT> EF      Diese Taste ist eine programmierbare

+                                       Funktionstaste (siehe <ESC> e). 

+ 

+<SHIFT DELETE>   <OA DELETE>   81      Diese das liefert den

+                                       Makroparametercode (siehe <ESC> e). 

+ 

+<ESC>            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+<SHIFT ESC>      <OA ESC>      9B      Während der Funktionstastedefinition

+                                       wirkt diese Taste wie ein Local

+                                       Escape, sonst liefert sie den Code 9B.

+                                       (siehe <ESC> e). 

+                                       

+<SHIFT CTRL HOME><OA 0>         -      Local/Online umschalten. 

+ 

+<CTRL HOME>      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...    <OA a> ...    E1 ...  programmierbare Funktionstasten 

+<SHIFT 9>        <OA i>        E9             "               " 

+<SHIFT 0>        <OA j>        EA             "               " 

+<SHIFT .>        <OA k>        EB             "               " 

+<SHIFT +>        <OA l>        EC             "               " 

+<SHIFT ->        <OA m>        ED             "               " 

+ 

+<SHIFT BOTRIGHT> <OA RIGHT>    EF             "               " 

+ (Dieser Code wird beim RESET des 

+ Terminals ausgeführt. Der Benut- 

+ zer kann damit das Terminal nach 

+ seinen Wünschen konfigurieren.) 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+<F1> ...         <OA A> ...    C1             "               " 

+<F15>            <OA O>        CF             "               " 

+<SHIFT F1> ...   <OA Q> ...    D1             "               " 

+<SHIFT F15>      <OA _>        DF             "               " 

+<CTRL F1> ...    <OA !> ...    A1             "               " 

+<CTRL F15>       <OA />        AF             "               " 

+<SHIFT CTRL F1>..<OA 1> ...    B1             "               " 

+<SHIFT CTRL F15> <OA ?>        BF             "               " 

+ 

+Die Programmierung der Funktionstasten geschieht mit #ib(1)#<ESC> e#ie(1)#. 

+ 

+ 

+#k("5.2", "Die TVI-Emulation")# 

+ 

+Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige

+Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape-

+Sequenzen ändert sich dadurch nicht. 

+Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2.

+Feld) oder durch 

+ 

+                         #ib(1)#<ESC> <SPACE> 1#ie(1)#    (Hex 1B 20 31) 

+ 

+An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey-

+boards. Die entsprechenden Tasten, die beim Applekeyboard zu drücken sind,

+kann man im letzten Abschnitt nachlesen. 

+ 

+Folgende Tasten senden andere Tastencodes: 

+ 

+Taste       TVI-Code(sequenz)       Bemerkung 

+#linie ("16.2")# 

+<RIGHT>     0C    #ib(1)#<CTRL L>#ie(1)#          Cursor nach rechts 

+ 

+<HOME>      1E    #ib(1)#<CTRL SHIFT ^>#ie(1)#    Cursor in Homeposition 

+ 

+<CLEAR>     1A    #ib(1)#<CTRL Z>#ie(1)#          Durch Drücken von <SHIFT HOME> 

+                                    Bildschirm löschen und Cursor Home 

+ 

+<DEL CHAR>  1B 57 #ib(1)#<ESC> W#ie(1)#           Durch Drücken von <SHIFT TOPLEFT> 

+                                    Zeichen löschen 

+ 

+<DEL LINE>  1B 52 #ib(1)#<ESC> R#ie(1)#           Durch Drücken von <SHIFT TOPRIGHT> 

+                                    Zeile löschen 

+ 

+<INS CHAR>  1B 51 #ib(1)#<ESC> Q#ie(1)#           Durch Drücken von <TOPLEFT> 

+                                    Zeichen einfügen 

+ 

+<INS LINE>  1B 45 #ib(1)#<ESC> E#ie(1)#           Durch Drücken von <TOPRIGHT> 

+                                    Zeile einfügen 

+ 

+<LEFT>      08    #ib(1)#<BACKSPACE>#ie(1)#       Cursor nach links 

+ 

+<BACK TAB>  1B 49 #ib(1)#<ESC> I#ie(1)#           Durch Drücken von <SHIFT TAB> 

+                                    Rückwärtstabulator 

+ 

+<DOWN>      0A    #ib(1)#<LF>#ie(1)#              Cursor nach unten 

+ 

+<UP>        0B    #ib(1)#<CTRL K>#ie(1)#          Cursor nach oben 

+ 

+<NEWLINE>   1F    #ib(1)#<CTRL SHIFT _>#ie(1)#    Durch Drücken von <SHIFT RETURN> 

+                                    Waagenrücklauf und Zeilenvorschub 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+Für jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der

+Form <CTRL A> <code> <CR> also 01 <code> 0D gesendet. Für <code> gilt: 

+ 

+Taste             <code>    Hex-Code 

+<F1> ...            @ ...      40 ...   Diese Tasten sind auf fast allen 

+<F11>               J          4A       TVI-Terminals vorhanden. 

+<F12> ...           ` ...      60 ... 

+<F15>               c          63 

+ 

+<SHIFT F1> ...      K ...      4B ... 

+<SHIFT F15>         Y          59 

+ 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...       d ...      64 ... 

+<SHIFT 9>           l          6C 

+<SHIFT 0>           m          6D 

+<SHIFT .>           n          6E 

+<SHIFT +>           o          6F 

+<SHIFT ->           p          70 

+ 

+<SHIFT BOTRIGHT>    r          72 

+ 

+Alle nicht in dieser Tabelle aufgeführten Funktionstasten senden den Basis-

+tastencode. 

+ 

+#page# 

+#h("6.", "Der Graphikmodus")# 

+ 

+ 

+#k("6.1", "Allgemeines")# 

+ 

+Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra-

+phik: GFX, Text: TXT) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> $#ie(1)#    (Hex 1B 24) 

+ 

+eingeschaltet und mit dem Kommando 

+ 

+                         #ib(1)#<ESC> %#ie(1)#    (Hex 1B 25) 

+ 

+ausgeschaltet. 

+ 

+Die Auflösung beträgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk-

+te, das sind 53760 Punkte. 

+ 

+ 

+#k("6.2", "Koordinaten und Parameterübergabe")# 

+ 

+Die Koordinaten für die Graphikkommandos dürfen den Bereich von -32768 bis

+32767 überstreichen. Der sichtbare Bereich ist für die X-Koordinate 0..279

+und für die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) )

+des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic-

+hnen nur innerhalb des sichtbaren Bereichs (Clipping). 

+ 

+ 

+#k("6.2.1", "Cursorposition/Fadenkreuz")# 

+ 

+Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam-

+ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn

+sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi-

+tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit 

+ 

+                         #ib(1)#<CTRL X>#ie(1)# oder #ib(1)#<CE>#ie(1)#    (Hex 18) 

+ 

+ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge-

+zeichnet. Das heißt, daß die Punkte an der Stelle des Fadenkreuzes inver-

+tiert (umgedreht) werden. Das hat wiederum zur Folge, daß an der Graphik-

+seite nichts verändert wird, wenn zweimal <CTRL X> gesendet wird. Solange

+der Bereich oder die Position des Fadenkreuzes nicht verändert wird, können

+zwischen den beiden <CTRL X> Kommandos auch andere Graphikkommandos ausge-

+führt werden. 

+ 

+ 

+#k("6.2.2", "Binäre oder dezimale Parameter")# 

+ 

+Die Übergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten

+und in einigen Fällen auch anderer Parameter, kann auf zwei verschiedene

+Arten erfolgen. Das Terminal erkennt die Übergabeart am ersten Parameterby-

+te: 

+Bei dezimalen Parametern ist dies entweder <SPACE>, +, - oder eine Zahl. Bei

+Binären Parametern liegt das Höherwertige Byte (das erste!) im Bereich von

+00..1F oder 3A..FF. Die Festlegung auf dezimale oder binäre Parameter gilt

+für beide (X und Y) Koordinaten. 

+ 

+ 

+#k("6.2.2.1", "Binäre Parameter")# 

+ 

+Binäre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten

+beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die

+Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer-

+den durch Bilden des Zweierkomplements dargestellt. 

+Zu beachten ist, daß zuerst das höherwertige (Highbyte) und dann das nie-

+derwertige (Lowbyte) gesendet werden muß. 

+ 

+Der Vorteil der binären Parameter ist, daß die Parameterübergabe schneller

+ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver-

+tierung vornehmen müssen und die Anzahl der Parameterbytes in der Regel

+geringer ist als bei dezimaler Parameterübergabe. 

+ 

+Der Nachteil ist, daß bei XON/XOFF Flußkontrolle einige Zahlen als XON oder

+XOFF interpretiert werden können und daß diese Parameter nicht auf Funk-

+tionstasten gelegt werden können, wenn sie Zeichen > Hex 7F enthalten. 

+ 

+ 

+#k("6.2.2.2", "Dezimale Parameter")# 

+ 

+Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden

+Koordinaten werden durch einen Separator (Komma, CR, Semikolon o.ä.) ge-

+trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger

+Stelle in und vor den Zahlen dürfen Leerzeichen (<SPACE>) oder Pluszeichen

+(+) stehen, die keine Änderung des Ergebnisses bewirken. Ein Minuszeichen

+vor einer Zahl negiert sie. 

+ 

+Der Vorteil der dezimalen Parameter ist, daß sie in höheren Programmier-

+sprachen bequem und lesbar in ein Programm geschrieben werden können und daß

+keine Steuerzeichen vorkommen, die die XON/XOFF - Flußkontrolle stören könn-

+ten. Außerdem können diese Parameter immer auf Funktionstasten gelegt wer-

+den, da sie keine Codes > Hex 7F enthalten. 

+ 

+Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima-

+liegen Konvertierung (Host, Terminal) und die in der Regel längeren Parame-

+ter. 

+ 

+ 

+#k("6.2.3", "Absolute oder relative Koordinaten")# 

+ 

+Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso-

+luten Koordinaten. 

+ 

+Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter

+angegebene Position. Z.B. <ESC> v 200, 100; setzt den Cursor direkt auf die

+Position X=200, Y=100. Die meisten Programme unterstützen nur absolute Koor-

+dinaten. 

+ 

+Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad-

+diert. Das hat den Vorteil, daß eine Routine nicht zu wissen braucht, wo der

+Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen

+Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der

+aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen.

+Z.B. <ESC> q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk-

+te nach oben. 

+ 

+ 

+#k("6.2.4", "Byteparameter")# 

+ 

+Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kön-

+nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fällen,

+in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder-

+wertigsten Bits ausaskiert, die höherwertigen werden ignoriert, wenn nicht

+ausdrücklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert

+und ASCII-Ziffer identisch. Bei Werten großer als 9 geht das allerdings

+nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man

+folgende Tabelle benutzen: 

+ 

+#on("u")#Wert   ASCII (Hex) oder Binär#off("u")# 

+  0      0     30        00 

+  1      1     31        01 

+  2      2     32        02 

+  3      3     33        03 

+  4      4     34        04 

+  5      5     35        05 

+  6      6     36        06 

+  7      7     37        07 

+  8      8     38        08 

+  9      9     39        09 

+ 10      :     3A        0A 

+ 11      ;     3B        0B 

+ 12      <     3C        0C 

+ 13      =     3D        0D 

+ 14      >     3E        0E 

+ 15      ?     3F        0F 

+ 

+Für Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Groß-

+buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und <DEL>). Die Zuord-

+nung entnimmt man der ASCII-Tabelle in Anhang A. 

+ 

+ 

+#k("6.3", "Die Graphikparameter")# 

+ 

+Für die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs-

+weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die

+Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und

+die Bitverknüpfungen (löschen, invertieren...) festlegen. Diese Parameter

+werden mit einem Kommando <ESC> O <n> ... verändert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden all diese Parameter auf Defaultwerte zurückgesetzt. Diese Default-

+werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknüpfung (Punkte

+setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und

+als Arbeitsseite gewählt. Es wird auf ganzseitige Graphik geschaltet (falls

+im Graphikmodus). 

+ 

+ 

+#k("6.3.1", "Strichdicke")# 

+ 

+Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet

+parallel zur ursprünglichen Linie auf beiden Seiten jeweils eine weitere

+Linie der gleichen Länge. Die Strichdicke 3 zeichnet dann auf beiden Seiten

+jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge-

+wählt werden. Sie wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 1#ie(1)# <dicke>   (Hex 1B 4F 31 <dicke>) 

+ 

+eingestellt. <dicke> ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe-

+reich 1 bis 15. 

+ 

+ 

+#k("6.3.2", "Farbe/Helligkeit")# 

+ 

+Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun-

+kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe.

+Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7

+Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro-

+gramm allerdings nicht unterstützt, da sich dann die Auflösung in X-Richtung

+halbiert (also nur noch 140 x 192 Punkte). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 2#ie(1)# <n>    (Hex 1B 4F 32 <n>) 

+ 

+kann die Helligkeit eingestellt werden. <n> ist ein Byteparameter bei dem

+nur das Bit 0 wichtig ist: 

+ 

+Bit 0   Bedeutung 

+  0     dunkel/Violett     <n> ist eine gerade Zahl 

+  1     hell/Gelb          <n> ist eine ungerade Zahl 

+ 

+ 

+#k("6.3.3", "Linientyp")# 

+ 

+Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich-

+muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch

+Pattern genannt) wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 3#ie(1)# <n>    (Hex 1B 4F 33 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die

+Strichtypen sind <n> folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bitmuster (16 Bit)  Name                    #off("u")# 

+ 0                       unsichtbare Linie 

+ 1   ----------------    durchgehende Linie 

+ 2   - - - - - - - -     gepunktete Linie 

+ 3   ----    ----        kurz gestrichelte Linie 

+ 4   --------            lang gestrichelte Linie 

+ 5   --------    -       Strichpunktlinie 

+ 6   -   -   -----       Strich-Punkt-Punkt Linie 

+ 7   - - - -  - - - -    Benutzerdefinierte Linie 

+                         (Hier Defaultangabe) 

+ 

+Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der

+nächste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu-

+sters. Das Muster wiederholt sich bei längeren Linien zyklisch. Wird zwi-

+schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite

+Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste

+Draw-Befehl aufgehört hat. Auch dicke Linien behalten das Linienmuster bei,

+man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie über-

+gehen, wenn man eine gepunktete dicke Linie haben will. 

+ 

+ 

+#k("6.3.3.1", "Selbstdefinierte Linientypen (Pattern)")# 

+ 

+Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert

+werden. Da die Länge 16 Bit ist, kann man mit den relativen Move's und

+Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist

+dabei auch die Bitverknüpfung COPY, die im nächsten Abschnitt erläutert

+wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des

+Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie

+mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1)

+kann der Vorgang für die nächste Zeile fortgesetzt werden. 

+ 

+Das benutzerdefinierbare Pattern wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 6#ie(1)# <l> <h>    (Hex 1B 4F 36 <l> <h>) 

+ 

+festgelegt. <l> ist dabei das niederwertige (Lowbyte) des Bitmusters, <h>

+ist das höherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster

+für Linien (und nicht für Icons) benutzt wird, dann sollte man darauf ach-

+ten, daß das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein

+Move vorangegangen ist, zumindestes einen Punkt sieht. 

+ 

+ 

+#k("6.3.4", "Bitverknüpfungen")# 

+ 

+Über Bitverknüpfungen werden die Punkte auf der Graphikseite verändert. Das

+Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das

+aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Veränderung der Graphik-

+seite durchgeführt. 

+Bis auf die COPY-Funktion wirken die Bitverknüpfungen nur auf die Graphik-

+seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. 

+ 

+- Das Zeichnen einer sichtbaren Linie mit weißen Punkten geschieht zum Bei-

+  spiel durch eine OR- (Oder-) Verknüpfung. 

+ 

+- Das Löschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge-

+  schieht mit einer AND- (Und-) Verknüpfung (Genau genommen eine NAND-, d.h.

+  negierte AND-Verknüpfung). 

+ 

+- Das Invertieren (d.h. Weißer Punkt wird schwarz, schwarzer Punkt wird

+  weiß) kann man mit einer XOR- (Exklusiv-Oder-) Verknüpfung erreichen. 

+ 

+- Für Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk-

+  tion, die eigentlich keine einzelne Bitverknüpfung ist. Ist im Linientyp

+  das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknüpfung

+  durchgeführt (d.h. der Punkt wird gelöscht) ist das aktuelle Bit im Li-

+  nientyp 1, dann wird eine OR-Verknüpfung durchgeführt (d.h. der Punkt wird

+  gelöscht). Der Effekt ist, daß genau das Bitmuster des Linientyps in der

+  Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die

+  Linie gezeichnet wurde. 

+ 

+Die Bitverknüpfung kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 4#ie(1)# <n>    (Hex 1B 4F 34 <n>) 

+ 

+festgelegt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+<n> hat folgende Bedeutung: 

+ 

+<n>  Bitverknüpfung         Verwendung 

+#linie ("16.2")# 

+ 0   OR (Oder)              Weiß (auf schwarzem Grund) zeichnen 

+ 1   AND (Und)              Schwarz (auf weißem Grund) zeichnen 

+ 2   XOR (Exklusiv Oder)    Schwarze und Weiße Punkte umdrehen (invertie-

+ ren) 

+ 3   COPY (kopieren)        Icons zeichnen oder Bilduntergrund überschrei-

+ ben 

+ 

+ 

+#k("6.3.5", "Multiparametereinstellung")# 

+ 

+Die obigen Parameter (bis auf Linientyp) können alle zugleich mit einem

+Kommando gesetzt werden. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> O 5#ie(1)# <n>    (Hex 1B 4F 35 <n>) 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind

+folgendermaßen zugeordnet: 

+ 

+   Bit     Bedeutung        Werte 

+#linie ("16.2")# 

+ 0 .. 3  : Strickdicke      1 .. 15 

+ 4 .. 5  : Bitverknüpfung   0 = OR, 16 = AND, 32 = XOR, 48 = COPY 

+      6  : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) 

+ 

+Standardeinstellung ist also '<ESC> O 5 A'. 

+ 

+ 

+#k("6.4", "Graphikseiten")# 

+ 

+Das Terminal verwaltet zwei Graphikseiten mit einer Größe von jeweils 8k

+Byte (d.h. 8192 Bytes). 

+ 

+ 

+#k("6.4.1", "Die sichtbare Seite und die Arbeitsseite")# 

+ 

+Die beiden Graphikseiten können (müssen aber nicht) getrennt voneinander

+angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im

+Hintergrund" aufbereitet werden soll, während die andere (schon aufbereite-

+te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen

+und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec-

+hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck

+eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen,

+kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter-

+grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7

+Sekunden). 

+ 

+Die sichtbare und die Arbeitsseite können mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 7#ie(1)# <n>    (Hex 1B 4F 37 <n>) 

+ 

+gewählt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 7. 

+ 

+Bit 0 von <n> : Sichtbare Seite (0 oder 1) 

+Bit 1 von <n> : Arbeitsseite (0 oder 1) 

+Bit 2 von <n> : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik-

+                zeilen eingeblendet. 0 = Nur Graphikmode. 

+ 

+#on("u")#<n>     Sichtbar Arbeitsseite  Inhalt der untersten 32 Graphikzeilen#off("u")# 

+ 0      Seite 0  Seite 0       Graphik (Seite 0) 

+ 1      Seite 1  Seite 0       Graphik (Seite 1) 

+ 2      Seite 0  Seite 1       Graphik (Seite 0) 

+ 3      Seite 1  Seite 1       Graphik (Seite 1) 

+ 4      Seite 0  Seite 0       Text 

+ 5      Seite 1  Seite 0       Müll 

+ 6      Seite 0  Seite 1       Text 

+ 7      Seite 1  Seite 1       Müll 

+ 

+ 

+#k("6.4.1.1", "80-Zeichen Text und Graphik")# 

+ 

+Mit dem in 6.4.1 beschriebenen Kommando können, wie beschrieben, die unter-

+sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un-

+tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt

+und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi-

+schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht

+sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Müll erscheint. Das

+Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert

+wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der

+Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen-

+deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder-

+-Einblenden ansehen. 

+ 

+ 

+#k("6.4.2", "Aufbau einer Graphikseite")# 

+ 

+Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512

+sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus

+einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent-

+spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit

+eines Bytes wird am weitesten links angezeigt. 

+Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei-

+len sind zu Reihen zusammengefaßt. Es gibt also 24 Reihen. Jede erste Gra-

+phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle

+aufgelistet ist: 

+ 

+#on("u")#Reihe  Adresse  Hex  |  Reihe  Adresse  Hex  |  Reihe  Adresse  Hex#off("u")# 

+  0        0    000  |    8      40     028  |   16      80     050 

+  1      128    080  |    9     168     0A8  |   17     208     0D0 

+  2      256    100  |   10     296     128  |   18     336     150 

+  3      384    180  |   11     424     1A8  |   19     464     1D0 

+  4      512    200  |   12     552     228  |   20     592     250 

+  5      640    280  |   13     680     2A8  |   21     720     2D0 

+  6      768    300  |   14     808     328  |   22     848     350 

+  7      896    380  |   15     936     3A8  |   23     976     3D0 

+ 

+Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen-

+de Tabelle benutzen: 

+ 

+#on("u")#n  Offset (Hex)#off("u")# 

+0      0   0000 

+1   1024   0400 

+2   2048   0800 

+3   3072   0C00 

+4   4096   1000 

+5   5120   1400 

+6   6144   1800 

+7   7168   1C00 

+ 

+Beispiel: 

+  Die Adresse des Punktes (123, 45) soll bestimmt werden. 

+  45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8

+                = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der

+                Y-Offset also 5120. 

+  123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. 

+  Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. 

+  123 MOD 7 = 4  d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. 

+ 

+ 

+#k("6.4.3", "Operationen auf den Graphikseiten")# 

+ 

+Hier sollen nur die Operationen erläutert werden, die nicht in andere Kate-

+gorien (z.B. Löschen, Linien zeichnen etc.) passen. 

+ 

+Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert,

+kopiert, gemischt und miteinander logisch verknüpft werden können. Verän-

+dert wird bei diesem Kommando nur die Arbeitsseite. 

+ 

+Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> !#ie(1)# <n>    (Hex 1B 21 <n>) 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol-

+gende Bedeutung: 

+ 

+<n>   Bedeutung 

+#linie ("16.2")# 

+ 0    Keine Veränderung. Kopiert die Arbeitsseite in sich selbst (Färbt die

+      Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). 

+ 1    Die Arbeitsseite wird invertiert. 

+ 2    Mischt beide Seiten zusammen (OR Verknüpfung). 

+ 3    Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. 

+ 6    Bildet den Durchschnitt beider Seiten (AND Verknüpfung). 

+ 7    Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis

+10    Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR

+      Verknüpfung). 

+11    Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das

+      Inverse von <n>=10). 

+14    Kopiert die andere Seite in die Arbeitsseite. 

+15    Kopiert das Inverse von der anderen Seite in die Arbeitsseite. 

+ 

+Andere Werte für <n> wiederholen sich in der Tabelle. Die ganze Arbeitssei-

+te hat nach der Operation die gewählte Farbe/Helligkeit. 

+ 

+ 

+#k("6.4.4", "Laden einer Graphikseite vom Host")# 

+ 

+Graphikseiten können ganz oder teilweise vom Host geladen werden. Das kön-

+nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-)

+Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das

+Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> /#ie(1)# <ll> <lh> <al> <ah> <b...> 

+                                                    (Hex 1B 2F ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer-

+den. <lh>, <ll>, <ah>, <al> und <p...> sind Byteparameter (8 Bits). <ll> und

+<lh> bilden zusammen die binäre Länge, d.h. die Anzahl der Datenbytes

+<p...>, die die Graphik enthalten. Die Länge kann von 0 bis Hex 2000 (dezi-

+mal 8192) reichen. Die Adresse, durch <al> und <ah> gebildet, darf von 0 bis

+Hex 1FFF reichen. Zusätzlich gilt, daß die Summe von Länge und Adresse nicht

+größer als Hex 2000 sein darf, da sonst außerhalb der Graphikseite geladen

+würde. In einem dieser Fehlerfälle werden die folgenden Graphikdatenbytes

+ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu

+unvorhersehbaren Reaktionen des Terminals führt. 

+ 

+ 

+#k("6.4.5", "Graphik auf Diskette speichern/laden")# 

+ 

+Um Graphikseiten, zum Besipiel für Präsentationen, unabhängig vom Host auf

+dem Bildschirm darstellen zu können, benutzt man das Kommando 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei-

+chern und zu einem späteren Zeitpunkt wieder in das Terminal zurückladen.

+Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu

+schreiben oder von Diskette zu lesen. <n> ist ein Byteparameter mit dem

+Wertebereich 0 bis 31, wobei die Bits folgendermaßen belegt sind: 

+ 

+Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) 

+Bit 3    : Bei Graphikseiten immer 1 (Bei Textseiten 0) 

+Bit 4    : 0 heißt: die Graphikseite wird von der Diskette gelesen, 

+           1 heißt: die Graphikseite wird auf die Diskette geschrieben. 

+ 

+Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Graphikseite überschrieben. 

+ 

+Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt

+auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. 

+ 

+Beispiele: 

+    <ESC> S <CTRL H> liest die Graphikseite in Fach 0 in die Arbeitsseite. 

+    <ESC> S <CTRL X> schreibt die Arbeitsseite in Fach 0 der Diskette. 

+ 

+Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini-

+ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi-

+ken auf Diskette vorbereiten und sie dann mit verschränkter Arbeits- und

+Sichtbarkeitsseite anzeigen. 

+Z.B.: Seite 1 als Arbeitsseite wählen, Seite 0 als sichtbare Seite. Graphik

+      von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1

+      als sichtbare Seite wählen, Seite 0 jetzt als Arbeitsseite wählen. Die

+      nächste Graphikseite wird von der Diskette in die Seite 1 geladen etc. 

+      Bei dieser Vorgehensweise scheinen Übergänge kontinuierlich zu sein. 

+ 

+Für Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten

+             befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen-

+             folge. 

+ 

+ 

+#k("6.5", "Textdarstellung im Graphikmodus")# 

+ 

+Nicht nur auf der 80-Zeichen Textseite können Buchstaben und Zeichen darge-

+stellt werden, sondern auch auf den Graphikseiten. Die Auflösung ist zwar

+nicht so groß wie auf der reinen Textseite, aber die Anzahl der verschiede-

+nen Darstellungsmöglichkeiten ist sehr viel größer. Fast alle Kommandos, die

+in der Textseite angewandt werden können, haben in der Graphikseite die

+gleiche Funktion. 

+ 

+Textdarstellung in der Graphikseite ist hauptsächlich zum Beschriften von

+Graphiken oder zum Drucken von Überschriften etc. vorgesehen. Da aber fast

+alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo-

+dus zur Verfügung stehen, kann man auch im Graphikmodus Textverarbeitung

+oder Editor benutzen. 

+ 

+ 

+#k("6.5.1", "Zeichendarstellung")# 

+ 

+Die normale Größe eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen

+sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn

+die Größe mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen

+sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor-

+table Textverarbeitung läßt sich damit natürlich nicht machen, zumal die

+Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden

+gegenüber der der reinen Textseite langsamer ist. 

+ 

+ 

+#k("6.5.1.1", "Zeichengröße und Schreibrichtung")# 

+ 

+Die Zeichen können in verschiedenen Größen und unter verschiedenen Winkeln

+auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von

+rechts nach links mit auf dem Kopf stehenden Zeichen möglich. 

+Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet

+sich die linke untere Ecke eines Zeichens an der Position des Graphikcur-

+sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter

+der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren

+(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, können sie

+schnell beliebig gedreht und vergrössert (und verkleinert) werden. Der Dreh-

+winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben.

+Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im

+Anhang A angegeben. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> N#ie(1)# <b> <h> <w>    (Hex 1B 4E <b><h><w>) 

+ 

+stellt Breite, Höhe und Drehwinkel der Zeichen ein. Alle Parameter sind

+Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00

+kann der Defaultwert (Standardwert) für den jeweiligen Parameter eingestellt

+werden. 

+<b> bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. 

+<h> bezeichnet die Zeichenhöhe in Punkten. Standardwert ist 10. 

+<w> bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. 

+ 

+Einige ausgezeichnet Werte für <w> sind: 

+<w>    Richtung 

+#linie ("16.2")# 

+ 0     Waagerecht von links nach rechts (Ost) 

+ 9     Schräg nach unten rechts         (Süd-Ost) 

+18     Senkrecht von oben nach unten    (Süd) 

+27     Schräg nach unten links          (Süd-West) 

+36     Waagerecht (auf dem Kopf stehend) von rechts nach links (West) 

+45     Schräg nach oben links           (Nord-West) 

+54     Senkrecht von unten nach oben    (Nord) 

+63     Schräg von nach oben rechts (Aufwärts) (Nord-Ost) 

+72...  Wie 0 ... 

+ 

+ 

+#k("6.5.1.2", "Dicke, Farbe etc.")# 

+ 

+Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter,

+die für Striche eingestellt werden, wirken dann auch auf die Zeichen. Mög-

+liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknüpfung. Mit

+dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden alle diese Parameter auf Standardwerte zurückgesetzt. Die Standard-

+werte sind in Kapitel 6.3 erläutert. Die Beschreibung des Kommandos zur

+Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel-

+len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in

+Kapitel 6.3.3 und das Einstellen der Bitverknüpfung ist in Kapitel 6.3.4

+beschrieben. Auch für die Zeichendarstellung können mehrere dieser Parame-

+ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom-

+mando ist in Kapitel 6.3.5 beschrieben. 

+ 

+ 

+#k("6.5.1.3", "Zeichensätze und Attribute")# 

+ 

+Ähnlich wie bei der 80-Zeichen Textdarstellung können Zeichensatz und Text-

+attribute eingestellt werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+kann einer der beiden Zeichensätze USA oder GER (ASCII und Deutsch) gewählt

+werden. Ein griechischer Zeichensatz ist unabhängig von beiden immer vor-

+handen. 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus

+sind aber nur die beiden folgende Werte sinnvoll: 

+ 

+#on("u")#<n>  Zeichensatz  Abweichende Zeichen#off("u")# 

+ 2   Deutsch      Ä Ö Ü ä ö ü ß 

+ 4   Ascii        [ \ ] { | } ~ 

+ 

+Außerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein-

+gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch-

+staben außerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen-

+satz ist im Anhang abgebildet. 

+ 

+Wie im Textmodus können Attribute mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt werden. <n> ist ein Byteparameter mit dem Wertebereich 0, 1, 4

+und 5. Die Werte von <n> sind folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bedeutung                                       #off("u")#

+ 0   Normaler Text (sichtbar und aufrecht) 

+ 1   Unsichtbarer Text (Nur der Cursor wird bewegt) 

+ 4   Kursivschrift, die Zeichen werden schräggestellt 

+ 5   Wie 1 (unsichtbarer Text) 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#   (Hex 1B 29) 

+ 

+hat wie im Textmodus die gleiche Bedeutung wie <ESC> G 4. Damit wird im

+Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#   (hex 1B 28) 

+ 

+wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge-

+hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor-

+gehoben. 

+Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur-

+sives Zeichen, dann wird das rechte Zeichen möglicherweise etwas überschrie-

+ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver-

+mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen

+ausgegeben wird. 

+ 

+ 

+#k("6.5.1.4", "Zeichen überschreiben")# 

+ 

+Im 80-Zeichen Textmodus kann man Zeichen einfach übereinandertippen, das

+zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit

+in eine Zeichnung geschrieben werden können, ohne daß Teile von Linien even-

+tuell gelöscht werden. Dieser Modus bringt außerdem eine etwas größere

+Schreibgeschwindigkeit mit sich. Es ist aber auch möglich, daß die Fläche,

+in die das Zeichen geschrieben werden soll, vorher gelöscht wird, um ein

+sauberes Schriftbild zu erzielen. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> &#ie(1)#   (Hex 1B 26) 

+ 

+kann man das vorherige Löschen einschalten, mit dem Kommando 

+ 

+                         #ib(1)#<ESC> '#ie(1)#   (Hex 1B 27) 

+ 

+wird der Modus des Überschreibens ausgeschaltet. 

+ 

+Bei Kursivzeichen wird eine rautenförmige Fläche gelöscht oder gefüllt (wenn

+Bitverknüpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re-

+chteckige Fläche, der mit #ib(1)#<ESC> N#ie(1)# eingestellten Breite und Höhe, gelöscht

+oder gefüllt. Zu beachten ist, daß das Löschen/Füllen nur bei waagerechter

+Schreibrichtung von links nach rechts funktioniert. 

+ 

+Da die Größe der Zeichen in weiten Grenzen mit <ESC> N eingestellt werden

+kann, ist es auch möglich mit dem durch <ESC> & eingeschalteten Ersetzungs-

+modus schnell rechteckige Flächen zu füllen oder zu löschen, wenn nicht auf

+das später beschriebene Füllkommando für beliebige Flächen zurückgegriffen

+werden soll. Dazu schaltet man mit dem Kommando <ESC> O 4 1 die Bitverknü-

+pfung AND (für Füllen) ein und gibt dann einfach ein Leerzeichen aus, das

+dann invertiert dargestellt wird. 

+ 

+ 

+#k("6.5.2", "Textkommandos im Graphikmodus")# 

+ 

+Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo-

+dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition

+senden, haben im Graphikmodus andere Funktionen und haben deshalb andere

+Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind:

+<ESC> I (Backtab), <ESC> j (Reverse Linefeed), <ESC> E (Insert Line), <ESC>

+Q (Insert Character), <ESC> R (Delete Line), <ESC> W (Delete Character). 

+ 

+ 

+#k("6.5.2.1", "Die Cursorpositionierung")# 

+ 

+Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra-

+phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel

+180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem

+Kopf schreiben), dann muß man, um einen Backspace (d.h. ein Zeichen zurück)

+auszuführen, nicht <RIGHT> sondern wie bei normaler Schreibrichtung üblich,

+<LEFT> drücken. Die vier Cursorsteuertasten funktionieren für beliebige

+Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage-

+rechte Schreibrichtung von links nach rechts. 

+ 

+Alle Steuertasten berücksichtigen die Zeichengröße (Breite und Höhe). Auch

+die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen

+gescrollt, wie ein Zeichen hoch ist. 

+ 

+Folgende Steuerkommandos/Tasten wirken im Graphikmodus: 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#linie ("16.2")# 

+#ib(1)#<TAB>#ie(1)#            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten (wie im Textmodus). Liegt die

+                                       nächste Tabulatorposition außerhalb

+                                       des sichtbaren Bereichs, dann steht

+                                       der Cursor jetzt da. 

+ 

+#ib(1)#<SHIFT CE>#ie(1)#       <OA CTRL X>    -      Kommandozeile aktivieren. 

+                                       Einzelheiten zur Kommandozeile siehe

+                                       Abschnitt 3.: Die Kommandozeilen. 

+ 

+#ib(1)#<CE>#ie(1)#             <CTRL X>      18      u.a. Kommandozeile verlassen. 

+ 

+#ib(1)#<RETURN>#ie(1)#         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub. 

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+#ib(1)#<SHIFT RETURN>#ie(1)#   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten sichtbaren

+                                       Bildschirmzeile war, wird der Bild-

+                                       schirminhalt entweder nach oben ge-

+                                       scrollt (SCROLL) oder in Homeposition

+                                       gebracht (PAGE). 

+ 

+#ib(1)#<UP>#ie(1)#             <UP>       8B/0B      Cursor eine Zeile höher (bzw. über

+                                       die Zeile). War der Cursor in der

+                                       ersten sichtbaren Bildschirmzeile,

+                                       dann steht er jetzt im unsichtbaren

+                                       Bereich. 

+ 

+#ib(1)#<DOWN>#ie(1)#           <DOWN>     8A/0A      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten sichtbaren Zeile, dann

+                                       wird der Inhalt des Graphikbild-

+                                       schirms nach oben gescrollt, d.h. die

+                                       obersten Zeilen werden gelöscht (im

+                                       SCROLL-Modus) oder der Cursor in die

+                                       erste Zeile gesetzt (im PAGE-Modus). 

+ 

+#ib(1)#<CTRL V>#ie(1)#         <CTRL V>      16      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten Zeile, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+#ib(1)#<LEFT>#ie(1)#           <LEFT>     88/08      Cursor eine Spalte nach links (bzw.

+                                       entegegen der Schreibrichtung). War

+                                       der Cursor in der ersten sichtbaren

+                                       Bildschirmspalte, dann ist er jetzt

+                                       unsichtbar "links" davon. 

+ 

+#ib(1)#<RIGHT>#ie(1)#             -          95      Cursor eine Spalte nach rechts (bzw.

+                                       in Schreibrichtung). War der Cursor

+                                       in der letzten sichtbaren Spalte,

+                                       dann befindet er sich jetzt außer-

+                                       halb des Bildschirms. Im Gegensatz

+                                       zum Textmodus wird kein Linefeed oder

+                                       Scroll ausgeführt. 

+ 

+#ib(1)#<HOME>#ie(1)#           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+#ib(1)#<SHIFT HOME>#ie(1)#     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+#ib(1)#<DELETE>#ie(1)#         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm nicht dargestellt. Der Host

+                                       interpretiert es in der Regel als

+                                       Zeichenlöschbefehl. 

+ 

+#ib(1)#<BOTTOMLEFT>#ie(1)#     <BACKSPACE>   08      Cursor eine Spalte nach links (bzw.

+                                       entgegen der Schreibrichtung). Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+#ib(1)#<BOTTOMRIGHT>#ie(1)#    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts (bzw. in Schreibrichtung). Die

+                                       Funktion ist mit der von <RIGHT>

+                                       identisch. 

+ 

+#ib(1)#<ESC>#ie(1)#            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+#ib(1)#<SHIFT CTRL HOME>#ie(1)#<OA 0>         -      Local/Online umschalten 

+ 

+#ib(1)#<CTRL HOME>#ie(1)#      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge-

+sehen werden können. 

+ 

+ 

+#k("6.5.2.2", "Löschbefehle")# 

+ 

+Das Kommando (Clear to End Of Line) 

+ 

+                         #ib(1)#<ESC> T#ie(1)#    (Hex 1B 54) 

+ 

+löscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Höhe des

+gelöschten Balkens entspricht der Buchstabenhöhe. Der Balken wird unabhän-

+gig von der Bitverknüpfung immer gelöscht. Der Balken wird unabhängig von

+der Schreibrichtung immer waagerecht gelöscht. 

+ 

+Das Kommando (Clear to End Of Page) 

+ 

+                         #ib(1)#<ESC> Y#ie(1)#    (Hex 1B 59) 

+ 

+löscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum

+Bildschirmende. Auch dieses Kommando löscht unabhängig von der gewählten

+Bitverknüpfung und Schreibrichtung immer waagerecht. 

+ 

+Die Kommandos 

+ 

+                         #ib(1)#<ESC> *#ie(1)#    (Hex 1B 2A) 

+                         #ib(1)#<ESC> ,#ie(1)#    (Hex 1B 2C) 

+                         #ib(1)#<ESC> +#ie(1)#    (Hex 1B 2B) 

+                         #ib(1)#<ESC> :#ie(1)#    (Hex 1B 3A) 

+                         #ib(1)#<CTRL Z>#ie(1)#   (Hex 1A) 

+ 

+löschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h.

+eine Buchstabenhöhe unter dem oberen Bildschirmrand. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> y#ie(1)#    (Hex 1B 79) 

+ 

+löscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke,

+d.h. den Ursprung des Koordinatensystems. 

+ 

+ 

+#k("6.6", "Die Graphikkommandos")# 

+ 

+ 

+#k("6.6.1", "Draw's und Move's")# 

+ 

+Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den

+Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und

+zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel-

+le Cursorposition. Die Endposition kann relativ, absolut oder mit einem

+relativen Winkel angegeben werden. Der Befehl zum Setzen/Löschen eines Punk-

+tes wurde mit in diese Befehlskategorie aufgenommen. 

+ 

+ 

+#k("6.6.1.1", "Punkt setzen")# 

+ 

+Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h.

+die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik-

+cursors wird durch diesen Befehl nicht verändert. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> m#ie(1)# <x, y;>    (Hex 1B 6D <x, y;>) 

+ 

+setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren

+Bereichs liegt. <x, y;> sind dezimale oder binäre Koordinaten. Das Aussehen

+des Punktes kann durch Farbe/Helligkeit oder Bitverknüpfung festgelegt wer-

+den. Mit einer AND-Bitverknüpfung wird der angegebene Punkt gelöscht, mit

+einer OR oder COPY Bitverknüpfung wird der angegebene Punkt gesetzt, mit

+einer XOR Bitverknüpfung wird sein Zustand umgedreht (invertiert). 

+Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen)

+Draw-Befehl <ESC> r 0, 0; benutzen, der an die Position des Graphikcursors,

+einen Punkt der eingestellten Dicke zeichnet. 

+ 

+ 

+#k("6.6.1.2", "Move-Befehle")# 

+ 

+Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso-

+luten. Das Kommando für einen absoluten Move lautet 

+ 

+                         #ib(1)#<ESC> v#ie(1)# <x, y;>    (Hex 1B 76 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die neue Position

+des Graphikcursors bezeichnen. Diese Position muß nicht im sichtbaren Be-

+reich liegen, sondern kann auch außerhalb des Fensters liegen. Der Wertebe-

+reich von <x> und <y> ist -32768 bis 32767. 

+ 

+Das Kommando für den relativen Move-Befehl lautet 

+ 

+                         #ib(1)#<ESC> q#ie(1)# <x, y;>    (Hex 1B 71 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert. Auch hier darf die neue Position des Graphik-

+cursors außerhalb des sichtbaren Bereichs liegen. 

+ 

+Die Move-Befehle setzen außerdem das Bitmuster für den Linientyp wieder auf

+den Startwert zurück, damit der nächste Draw-Befehl auch mit einem Punkt

+beginnt. 

+ 

+ 

+#k("6.6.1.3", "Draw-Befehle")# 

+ 

+Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen,

+einer relativen und einer absoluten. Das Kommando für einen absoluten Draw

+lautet 

+ 

+                         #ib(1)#<ESC> w#ie(1)# <x, y;>    (Hex 1B 77 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die Endposition der

+Linie bezeichnen. Diese Position muß nicht im sichtbaren Bereich liegen,

+sondern kann auch außerhalb des Fensters liegen. Der unsichtbare Teil der

+Linie wird dann "geclippt". Der Wertebereich von <x> und <y> ist -32768 bis

+32767. 

+ 

+Das Kommando für den relativen Draw-Befehl lautet 

+ 

+                         #ib(1)#<ESC> r#ie(1)# <x, y;>    (Hex 1B 72 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch

+hier darf die Endposition der Linie außerhalb des sichtbaren Bereichs lie-

+gen. 

+ 

+ 

+#k("6.6.1.4", "Turtle-Graphik")# 

+ 

+Turtle-Graphik (Schildkröten-Graphik, obwohl hier keine Schildkröte sicht-

+bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Längen und

+Winkelangaben, statt mit x/y-Koordinaten, arbeiten benötigt. Man stellt sich

+dazu eine Schildkröte vor, die auf ihrem Weg über den Bildschirm eine sicht-

+bare Spur zurücklassen kann (aber nicht muß). Die Schildkröte kann einen Weg

+bestimmter Länge in ihre Blickrichtung gehen und bleibt dann stehen. Außer-

+dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung

+ändert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung

+der Schildkröte verändern kann und dann einen Weg bestimmter Länge in dieser

+Richtung zurücklegt. Außerdem wird noch ein Befehl benötigt, der das "Spur-

+verhalten" der Schildkröte ändert, also von "Spur sichtbar" auf "Spur un-

+sichtbar" umschaltet und umgekehrt. Natürlich ist die Zeichengeschwindigkeit

+nicht mit der Fortbewegungsgeschwindigkeit von Schildkröten zu vergleichen.

+Das erste Kommando lautet 

+ 

+                         #ib(1)#<ESC> n#ie(1)# <l, w;>    (Hex 1B 6E <l, w;>) 

+ 

+<l> und <w> sind dezimale oder binäre Parameter. <l> ist die Länge der Spur

+mit einem Wertebereich von 0 bis 511. <w> ist der relative Drehwinkel der

+Schildkröte, also die Änderung von der ursprünglichen Blickrichtung aus. <w>

+überstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0

+bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> o#ie(1)#    (Hex 1B 6F) 

+ 

+kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. 

+ 

+Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu

+setzen, kann man das Kommando 

+ 

+                         #ib(1)#<ESC> O 8#ie(1)# <n>    (Hex 1B 4F 38 <n>) 

+ 

+benutzen. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+ 

+#on("u")#Bit 0 hat folgende Bedeutung:                                    #off("u")# 

+  0       Pendown. Die Schildkröte hinterläßt eine sichtbare Spur 

+  1       Penup. Die Schildkröte hinterläßt keine Spur 

+ 

+#on("u")#Bit 1 hat folgende Bedeutung:                                    #off("u")# 

+  0       Drawer. Es wird eine weiße Linie gezeichnet. 

+  1       Eraser. Es wird eine schwarze Linie gezeichnet (gelöscht) 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 9#ie(1)#    (Hex 1B 4F 39) 

+ 

+wird die Turtle-Graphik initialisiert. Dieses Kommando muß nicht aufgerufen

+werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Möglichkeit

+am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt

+die Schildkröte in die Mitte des Bildschirms (140, 96) mit Blickrichtung

+nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie

+wird voreingestellt (Pendown). 

+ 

+ 

+#k("6.6.2", "Komplexere Zeichenkommandos")# 

+ 

+Außer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur-

+sors gibt es noch verschiedene andere Zeichenkommandos. 

+ 

+ 

+#k("6.6.2.1", "Kreise und Kreissegmente")# 

+ 

+Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition.

+Der Radius eines Kreises ist in weiten Grenzen von 0 bis über 30000 Punkten

+wählbar. Clipping wird ausserhalb des Bildschirmrandes durchgeführt. Ein

+Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel-

+ne gezeichnet werden können. Damit ist es dann auch möglich, Halb- oder

+Viertelkreise zu Zeichnen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> K#ie(1)# <r, s;>   (Hex 1B 4B <r, s;>) 

+ 

+wird ein Kreis mit dem Radius <r> um die aktuelle Cursorposition gezeichnet

+(relative Kreise). <s> legt fest, welche Segmente gezeichnet werden sollen.

+<r, s;> sind dezimale oder binäre Parameter. <s> hat den Wertebereich von 0

+bis 255. 

+Jedes Bit in <s> ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1),

+dann wird das zugehörige Segment gezeichnet. Der Wert 0 entspricht dem Wert

+255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine

+Abfrage der einzelnen Bits durchgeführt wird. 

+ 

+Die Segmente sind folgendermaßen numeriert: 

+ 

+                                  7  0 

+                                6      1 

+                                5      2 

+                                  4  3 

+ 

+Beispiele für <n> : 

+ 

+#on("u")#<n>  Bedeutung                               #off("u")#

+  0  Zeichnet einen ganzen Kreis 

+ 15  Zeichnet einen links offenen Halbkreis 

+240  Zeichnet einen rechts offenen Halbkreis 

+195  Zeichnet einen unten offenen Halbkreis 

+ 60  Zeichnet einen oben offenen Halbkreis 

+  3  Zeichnet ein Kreisviertel rechts oben 

+ 12  Zeichnet ein Kreisviertel rechts unten 

+ 48  Zeichnet ein Kreisviertel links unten 

+192  Zeichnet ein Kreisviertel links oben 

+etc. 

+ 

+Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die

+Bitverknüpfung verändert werden. Der Linientyp (Punkt-, Strichlinie) und die

+Strickdicke haben keinen Einfluß, d.h. der Kreis wird immer mit durchgehen-

+der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch

+verändert werden, sollte man den Befehl <ESC> s für Ellipsenbögen verwenden. 

+ 

+ 

+#k("6.6.2.2", "Rechtecke")# 

+ 

+Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle

+Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks

+liegen parallel zur X- und Y-Achse, gedrehte Rechtecke können aber aus 4

+relativen Draw-Befehlen zusammengesetzt werden. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> J#ie(1)# <b, h;>    (Hex 1B 4A <b, h;>) 

+ 

+zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. <b,

+h;> sind dezimale oder binäre Parameter. <b> ist die Breite des Rechtecks

+und kann den ganzen Wertebereich von -32768 bis 32767 überstreichen, <h> ist

+die Höhe des Rechtecks und kann ebenfalls diesen Wertebereich überstreichen.

+Je nach Vorzeichen von <b> und <h> wird das Rechteck links/ rechts und

+oben/unten von der aktuelle Cursorposition gezeichnet. 

+ 

+<b> <h>  Cursorposition bildet die Ecke 

+ +   +   unten links 

+ +   -   oben links 

+ -   +   unten rechts 

+ -   -   oben rechts 

+ 

+ 

+#k("6.6.2.3", "Bögen und Ellipsen")# 

+ 

+Um die Zeichengeschwindigkeit eines Kreises zu vergrößern, wurde ein sepa-

+rater Befehl für Kreise eingeführt (6.6.2.1). Da der Kreis ein Sonderfall

+der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch

+benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen-

+ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> s#ie(1)# <xr, yr,> <aw, ew;>    (Hex 1B 73 ...) 

+ 

+zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen

+mit Radius <xr> in X-Richtung und Radius <yr> in Y-Richtung, ausgehend vom

+Anfangswinkel <aw> im Uhrzeigersinn, bis zum Endwinkel <ew>. Der Winkel 0

+Grad ist dabei oben (Norden). 

+ 

+Alle Parameter sind dezimale oder binäre Parameter. <aw> und <ew> haben den

+Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von

+0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad

+Schritten und können Anhang A entnommen werden.. <xr> und <yr> dürfen den

+vollen Wertebereich von -32768 bis 32767 überstreichen. 

+ 

+ 

+#k("6.6.2.4", "Gefüllte Flächen")# 

+ 

+Rechteckige oder rautenförmige Flächen können, wie in Abschnitt 6.5.1.4

+beschrieben, schnell gefüllt werden. Für beliebig geformte Flächen kann das

+Kommando 

+ 

+                         #ib(1)#<ESC> |#ie(1)#<n>    (Hex 1B 7C <n>) 

+ 

+benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor-

+position herum gefüllt wird. <n> ist ein Byteparameter mit dem Wertebereich

+0 bis 15, der die Nummer des Musters für die Füllung angibt. Der Fill-Befehl

+arbeitet auf der aktuellen Arbeitsseite und füllt eine sichtbar begrenzte

+Fläche mit einem angegebenen Muster aus. 

+ 

+Ist die Bitverknüpfung OR eingestellt darf der Cursor nicht auf einem weißen

+Punkt stehen und die Fläche muß von einer durchgehenden weißen Linie be-

+grenzt sein. 

+Ist die Bitverknüpfung AND eingestellt, darf der Cursor nicht auf einem

+schwarzen Punkt stehen und die Fläche muß von einer durchgehenden schwarzen

+Linie begrenzt sein. 

+ 

+Außer den Parametern Bitverknüpfung und Helligkeit/Farbe werden keine be-

+rücksichtigt. 

+ 

+Bei sehr komplex geformten Figuren kann der Fall eintreten, daß die Fläche

+nicht ganz gefüllt ist. Dies liegt daran, daß intern ein zu größer Spei-

+cherplatz zum Merken von Rücksprungcursorpositionen benötigt wird (Stack-

+Überlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht

+gefüllte Fläche setzen und das Kommando erneut geben. 

+ 

+<n> kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): 

+<n>  Bedeutung 

+#linie ("16.2")# 

+ 0   Fläche ganz gefüllt 

+ 1   Fläche halb gefüllt (grau) 

+ 2   Jede 4. Zeile wird durchgezogen 

+ 3   Jede 2. Zeile wird durchgezogen 

+ 4   Jede 4. Spalte wird durchgezogen 

+ 5   Jede 2. Spalte wird durchgezogen 

+ 6   Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) 

+ 7   Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) 

+ 8   Schraffur von links unten nach rechts oben 

+ 9   Schraffur von links oben nach rechts unten 

+ A   Schräges Raster (Links- und Rechtsschraffur) 

+ B   Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) 

+ C   Mauerwerk 

+ D   Feines Netzgeflecht 

+ E   Feine Zickzacklinie 

+ F   Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie 

+ 

+Ist die AND-Bitverknüpfung eingeschaltet, dann sind die Punkte schwarz und

+weiß in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich-

+nungen 'gefüllt' und 'gelöscht' auszutauschen. 

+ 

+ 

+#k("6.6.2.4.1", "Definition des Musters")# 

+ 

+Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> O :#ie(1)# <b1..b8>   (Hex 1B 4F 3A <b1..b8>) 

+ 

+eingestellt werden. Das Defaultmuster wird dabei überschrieben, das neu

+eingestellte Muster allerdings nicht beim Setup mitgesichert. 

+<b1..b1> sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das

+erste Byte wird im Füllmuster in Richtung der niedrigeren y-Positionen dar-

+gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren

+x-Positionen. 

+ 

+ 

+#k("6.7", "Graphikdaten zum Host")# 

+ 

+Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen-

+den kann. Damit der Host über den Status des Terminals informiert werden

+kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host

+kann auch ganze Graphikseiten anfordern, so daß die auf dem Terminal er-

+zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host

+gespeichert werden können. 

+ 

+ 

+#k("6.7.1", "Graphikseiten zum Host")# 

+ 

+Graphikseiten können ganz oder teilweise übertragen werden. Da ein angefor-

+dertes Datenpaket immer ganz übertragen wird, sollte der Host, wenn keine

+Flußkontrolle eingeschaltet ist, nur so große Blöcke anfordern, die er puf-

+fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch

+verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal)

+verändern zu lassen. Mit dem Kommando <ESC> / ... kann der modifizierte Teil

+dann wieder an das Terminal zurückgesendet werden. Zum Aufbau der Graphik-

+seite findet man in Kapitel 6.4.2 Informationen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> \#ie(1)# <ll> <lh> <al> <ah>   (Hex 1B 5C ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden.

+<lh>, <ll>, <ah> und <al> sind Byteparameter (8 Bits). <ll> und <lh> bilden

+zusammen die binäre Länge, d.h. die Anzahl der Datenbytes, die zum Host

+gesendet werden. Die Länge kann von 0 bis Hex 2000 (dezimal 8192) reichen.

+Die Adresse durch <al> und <ah> gebildet, darf von 0 bis Hex 1FFF reichen.

+Zusätzlich gilt, daß die Summe von Länge und Adresse nicht größer als Hex

+2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite

+befindet. In diesem Fehlerfall werden keine Daten gesendet. 

+ 

+ 

+#k("6.7.2", "Cursorposition zum Host")# 

+ 

+Da die Graphikcursorposition einen anderen Wertebereich überstreicht als die

+Position des Textcursors, wurde zum Senden der Graphikcursorposition ein

+weiteres Kommando eingeführt. Pro Koordinate werden dabei 2 Bytes, zusammen

+also 4 Bytes, gesendet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ;#ie(1)#    (Hex 1B 3B) 

+ 

+kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist <xlow>

+<xhigh> <ylow> <yhigh>. Im Gegensatz zu <ESC> ? (für die Textcursorposi-

+tion) wird auch kein abschließendes <CR> gesendet. 

+ 

+ 

+#k("6.7.3", "Einzelne Bits zum Host")# 

+ 

+Außer ganzen Graphikseiten oder Blöcken daraus, kann der Host auch einzelne

+Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur

+Verfügung. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> _#ie(1)#    (Hex 1B 5F) 

+ 

+kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be-

+findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7)

+ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor

+außerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> -#ie(1)#    (Hex 1B 2D) 

+ 

+kann das Bit, daß durch die Graphikcursorposition addressiert wird, abge-

+fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende

+Bedeutung haben: 

+ 

+#on("u")#Bit 0 Dezimal   Bedeutung                            #off("u")# 

+  0      0      Das adressierte Bit ist nicht gesetzt 

+  1      1      Das adressierte Bit ist gesetzt 

+ 

+#on("u")#Bit 1 Dezimal   Bedeutung                   #off("u")# 

+  0      0      Die Farbe ist violett/dunkel 

+  1      2      Die Farbe ist gelb/hell 

+ 

+Bit 2 Dezimal   Bedeutung 

+#linie ("16.2")# 

+  0      0      Der Graphikcursor ist innerhalb des sichtabren Bereichs 

+  1      4      Der Graphikcursor ist außerhalb des sichtbaren Bereichs. 

+                Bit 0 und Bit 1 sind dann 0. 

+ 

+Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4"

+geliefert. 

+ 

+ 

+#k("6.7.4", "Parameter zum Host")# 

+ 

+Die eingestellten Draw-Parameter können auch abgefragt werden. Dazu exi-

+stieren zwei Kommandos. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 4#ie(1)#    (Hex 1B 34) 

+ 

+können die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format

+wie zum Einstellen der Seiten mit dem Kommando #ib(1)#<ESC> O 7#ie(1)# <n>, angefordert

+werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2

+sind folgendermaßen zugeordnet: 

+ 

+#on("u")#Bit 0  Bedeutung                #off("u")# 

+  0    Sichtbar ist Seite 0 

+  1    Sichtbar ist Seite 1 

+ 

+#on("u")#Bit 1  Bedeutung               #off("u")# 

+  0    Arbeitsseite ist Seite 0 

+  1    Arbeitsseite ist Seite 1 

+ 

+#on("u")#Bit 2  Bedeutung               #off("u")# 

+  0    Nur Graphik eingeschaltet 

+  1    In den letzten 32 Graphikzeilen 

+       sind 4 Textzeilen eingeblendet 

+ 

+#on("u")#Bit 3  Bedeutung                         #off("u")# 

+  0    Der Graphikmodus ist eingeschaltet 

+  1    Der Textmodus ist eingeschaltet 

+ 

+Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 5#ie(1)#    (Hex 1B 35) 

+ 

+können die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer-

+tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaßen

+zugeordnet: 

+ 

+Bit        Bedeutung 

+#linie("16.2")# 

+Bit 0..3 : Strichdicke 

+Bit 4..5 : Bitverknüpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) 

+Bit 6    : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) 

+ 

+Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)#<ESC> O 5#ie(1)# <n>. 

+ 

+ 

+#k("6.8", "Graphikhardcopy")# 

+ 

+Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer-

+tigt werden. Dabei können keine verschiedene Helligkeitsstufen oder Farben

+dargestellt werden. 

+ 

+ 

+#k("6.8.1", "Der Druckertreiber")# 

+ 

+Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch

+gleiche Kommandos erreicht werden kann, muß das Terminal an den vorhandenen

+Drucker angepaßt werden. Defaultmäßig werden die Epson-Modelle ab RX80 auf-

+wärts, sowie kompatible (IBM, Panasonic etc.) unterstützt. Die Anpassung

+wird in diesem Abschnitt beschrieben. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ~#ie(1)# <n> <p...>    (Hex 1B 7E <n> <p...>) 

+ 

+können Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: 

+ 

+<n> Default (Hex)   Aufgabe 

+#linie ("16.2")# 

+ 0  0D              Einleiten der gesamten Hardcopy (Waagenrücklauf) 

+ 1  1B 2A 04 18 01  Einschalten des Graphikmodus. Es folgen 280 Graphikby-

+                    tes (jeweils 8 Bit) 

+ 2  0D 1B 4A 17     Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi-

+                    schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrück-

+                    lauf. 

+ 3     Nichts       Dieses Kommando wird nach der kompletten Hardcopy zum

+                    Drucker gesendet. 

+ 

+Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander

+gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile

+gegeben. 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. <p...> ist

+eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Längenby-

+te, das die Länge der Kommandosequenz (oder die Anzahl der noch folgenden

+Bytes) angibt. Für die nach dem Längenbyte folgenden Bytes sind alle Werte

+von 0 bis 255 erlaubt. 

+ 

+Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom-

+mandozeile auch mit abgespeichert, so daß sie nur einmal (wenn überhaupt)

+und dann nie wieder eingestellt werden müßen. 

+ 

+ 

+#k("6.8.2", "Die Hardcopyparameter")# 

+ 

+Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik

+beim Ausdruck noch verändert werden. Das Kommando 

+ 

+                         #ib(1)#<ESC> ^#ie(1)# <n>    (Hex 1B 5E <n>) 

+ 

+druckt eine Hardcopy mit dem Parameter <n>. <n> ist ein Byteparameter mit

+dem Wertebereich von 0 bis 15. Jedes Bit in <n> legt eine Darstellungsweise

+fest. Die Bits haben folgende Bedeutung: 

+ 

+Invertieren: 

+Bit 0 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz

+              gedruckt, dunkle Punkte bleiben beim Ausdruck weiß. 

+  1      1    Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund

+              bleibt auf dem Drucker dunkel (schwarz). 

+ 

+Doppelte Breite: 

+Bit 1 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es

+              werden also 280 Punkte nebeneinander gedruckt. 

+  1      2    Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In

+              diesem Fall werden auf dem Drucker 560 Punkte nebeneinander

+              gedruckt. 

+ 

+Doppelte Höhe: 

+Bit 2 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Höhe gedruckt. Es wer-

+              den also 192 Punkte untereinander gedruckt. 

+  1      4    Jeder Bildschirmpunkt wird in doppelter Höhe gedruckt. In

+              diesem Fall werden also 384 Punkte untereinander gedruckt. 

+ 

+Zwei Seiten nebeneinander drucken: 

+Bit 3 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Es wird nur eine Graphikseite (linksbündig) gedruckt. 

+  1      8    Die aktuelle (mit #ib(1)#<ESC> O 7#ie(1)# <n> eingestellte) Graphikseite

+              wird linksbündig und die andere Graphikseite nahtlos rechts

+              daneben gedruckt. 

+ 

+Zur Kombination von Möglichkeiten (mehrere Bits sind gesetzt): 

+ 

+- Eine Graphik mit doppelter Höhe und doppelter Breite hat ungefähr das

+  Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040

+  Punkten. Zusätzliches Invertieren macht die Graphik dem Bildschirmausse-

+  hen noch ähnlicher. 

+ 

+- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re-

+  icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra-

+  phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber

+  Kommandosequenz 1 temporär auf eine hohe (4-fache) Dichte umschalten.

+  Solange kein Setup ausgeführt wird, ist diese Dichte nur solange gültig,

+  bis das Terminal ausgeschaltet wird. 

+ 

+#page# 

+#h("7.", "Die Parameter der seriellen Schnittstelle")# 

+ 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host durch Escape-

+Sequenzen gändert werden. Die Änderung der Parameter wird erst durchgeführt,

+wenn die Parameterübergabe komplett ist (d.h das letzte Byte wurde übertra-

+gen). Alle Übertragungsparameter wie Stopbits, Datenbits, Parität und Bau-

+drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flußkon-

+trolle wird mit separaten Escape-Sequenzen eingestellt. 

+Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. 

+ 

+ 

+#k("7.1", "Das Übertragungsformat")# 

+ 

+Das Übertragunsformat eines Datenbytes sieht folgendermaßen aus: 

+(Beispiel für 8 Datenbits, 1 Paritätsbit und 1 Stopbit) 

+ 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+    ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+       Start-  ----  D a t e n b i t s ---- Pari- Stop- 

+        bit                                 täts- bit 

+                                            bit 

+     --------> Zeit 

+ 

+Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Paritätsbit. Wenn zwei

+Stopbits übertragen werden steht an dieser Stelle das 1. Stopbit ("1"). 

+ 

+ 

+#k("7.2", "Die Übertragungsparameter")# 

+ 

+Alle vier Parameter werden zugleich verändert. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> <SPACE> <SPACE>#ie(1)# <x>    (Hex 1B 20 20 <x>) 

+ 

+<x> ist dabei ein Datenbyte, das wie folgt festgelegt wird: 

+ 

+   Bit     7       6       5       4       3       2       1       0 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+       |Parity |Parity | Stop- | Daten-|            Baudrate           | 

+       | even/ |on/off | bits  | bits  |       |       |       |       | 

+       | odd   |       |       |       |       |       |       |       | 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+ 

+ 

+#k("7.2.1", "Baudrate")# 

+ 

+Baudrate = Anzahl der pro Sekunde übertragenen Bits (Übertragungsgeschwin-

+digkeit) . 

+ 

+         Bits 

+#on("u")#Dezimal 3 2 1 0    Neue Baudrate#off("u")# 

+  0     0 0 0 0    Alte Baudrate (nicht verändern) 

+  1     0 0 0 1      50 Baud 

+  2     0 0 1 0      75 Baud 

+  3     0 0 1 1     109.9 Baud 

+  4     0 1 0 0     134.58 Baud 

+  5     0 1 0 1     150 Baud 

+  6     0 1 1 0     300 Baud 

+  7     0 1 1 1     600 Baud 

+  8     1 0 0 0    1200 Baud 

+  9     1 0 0 1    1800 Baud 

+ 10     1 0 1 0    2400 Baud 

+ 11     1 0 1 1    3600 Baud 

+ 12     1 1 0 0    4800 Baud 

+ 13     1 1 0 1    7200 Baud 

+ 14     1 1 1 0    9600 Baud 

+ 15     1 1 1 1   19200 Baud 

+ 

+Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari-

+tätsbit verändert werden sollen. 

+ 

+ 

+#k("7.2.2", "Datenbits")# 

+ 

+Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. 

+ 

+#on("u")#Dezimal Bit 4              #off("u")# 

+   0      0     8 Datenbits 

+  16      1     7 Datenbits 

+ 

+Mit einem anschliessenden Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 6#ie(1)#    (Hex 1B 20 36) 

+ 

+kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann

+notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge-

+setztes 8. Datenbit falsch reagiert (Steuerbit oder ähnliches). 

+ 

+Mit 

+ 

+                         #ib(1)#<ESC> <SPACE> 7#ie(1)#    (Hex 1B 20 37) 

+ 

+kann die Maskierung wieder aufgehoben werden. 

+Zu beachten ist, daß bei 7 Bit Datentransfer zum Beispiel das Farbbit bei

+Download einer Graphikseite nicht übertragen wird. 

+ 

+ 

+#k("7.2.3", "Stopbits")# 

+ 

+Bit 5 legt die Anzahl der Stopbits fest. 

+ 

+#on("u")#Dezimal Bit 5            #off("u")# 

+   0      0    1 Stopbit 

+  32      1    2 Stopbits 

+ 

+Zu beachten ist, daß bei eingeschaltetem Paritycheck und 8 Datenbits immer

+ein Stopbit übertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es

+können maximal 11 Bits/Daten"byte" übertragen werden.) 

+ 

+ 

+#k("7.2.4", "Paritätsbit")# 

+ 

+Bit 6 legt fest, ob Paritätskontrolle erfolgen soll und ob ein Paritätsbit

+vorhanden ist. 

+ 

+Dezimal Bit 6 

+#linie("16.2")# 

+   0      0     Keine Paritätskontrolle/Kein Paritätsbit 

+  64      1     Paritätskontrolle eingeschaltet. Parität mit Bit 7 gewählt 

+ 

+Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Parität geprüft

+werden soll. 

+ 

+#on("u")#Dezimal Bit 7                   #off("u")# 

+   0      0     Ungerade Parität 

+ 128      1     Gerade Parität 

+ 

+ 

+#k("7.2.5", "Übertragungsfehler")# 

+ 

+Wird ein Rahmenfehler (Stopbit fehlt) oder ein Paritätsfehler (mindestens

+ein Bit verfälscht) entdeckt, dann wird statt des empfangenen Mülls ein Byte

+Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in-

+vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an,

+wenn es mitten in einer Escape-Sequenz empfangen wird. 

+ 

+ 

+#k("7.3", "Die Flußkontrolle")# 

+ 

+Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine

+solchen mehr empfangen kann, sollte eine Flußkontrolle eingeschaltet wer-

+den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen),

+aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048

+Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flußkon-

+trolle mitgeteilt hat, daß er keine Zeichen mehr empfangen kann. Das Termi-

+nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar-

+beiten (Spooler, Bildschirmausgabe, Localmodus etc.). 

+ 

+Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y"

+in der Statuszeile erkennen, sonst steht dort "R E A D Y". 

+Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F"

+in der Statuszeile erkennen, sonst steht dort "T X   O N". 

+ 

+Da dieses Terminal einen großen Empfangspuffer hat, sollte man allerdings im

+Notfall auch ohne Flußkontrolle auskommen, wenn nicht gerade umfangreiche

+Graphikoperationen ausgeführt werden sollen, bei denen der Puffer nicht

+schnell genug geleert werden kann. 

+ 

+ 

+#k("7.3.1", "XON/XOFF")# 

+ 

+XON/XOFF ist eine Softwareflußkontrolle. Als Stopzeichen wird 

+ 

+                         #ib(1)#XOFF#ie(1)#    (#ib(1)#<CTRL S>#ie(1)# Hex 13) 

+ 

+verwendet. Als Startzeichen wird 

+ 

+                         #ib(1)#XON#ie(1)#    (#ib(1)#<CTRL Q>#ie(1)# Hex 11) 

+ 

+verwendet. Diese Flußkontrolle sollte nur im Textmodus verwendet werden, da

+Binärdaten möglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als

+Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Fluß-

+kontrolle ist, daß man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen

+Schnittstelle auskommt. 

+ 

+Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese

+Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen

+werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. 

+ 

+Die XON/XOFF Flußkontrolle kann in der 2. Kommandozeile ein- und ausgeschal-

+tet werden, sowie mit dem Kommando 

+ 

+                         #ib(1)#<CTRL O>#ie(1)#    (Hex 0F) 

+ 

+eingeschaltet und mit 

+ 

+                         #ib(1)#<CTRL N>#ie(1)#    (Hex 0E) 

+ 

+ausgeschaltet werden. 

+ 

+Zu beachten ist, daß der Sender vor dem Ausschalten noch im "TX OFF"-

+Zustand sein kann. Man sollte deshalb direkt vor <CTRL N> noch <CTRL Q> (Hex

+11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom

+Terminal nicht automatisch gemacht, da sonst ein <CTRL N> das im Datenstrom

+vorkommt, auch noch ein Zeichen für Flußkontrolle wäre. 

+ 

+ 

+#k("7.3.2", "DTR/DSR")# 

+ 

+DTR/DSR ist eine Hardwareflußkontrolle bei der die Leitungen Pin 20 (DTR)

+und Pin 6 (DSR) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+DTR (Data Terminal Ready)/DSR (DataSet Ready) Flußkontrolle kann in der 2.

+Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE>#ie(1)# <n>    (Hex 1B 20 <n>) 

+ 

+erreichen. Die Werte von <n> sind 

+ 

+#on("u")#<n>  Hex    Bedeutung                                              #off("u")# 

+ 2    32    Weder RTS/CTS noch DSR/DTR Flußkontrolle 

+ 3    33    RTS/CTS Flußkontrolle, aber keine DSR/DTR Flußkontrolle 

+ 4    34    DSR/DTR Flußkontrolle, aber keine RTS/CTS Fluskontrolle 

+ 5    35    DSR/DTR und RTS/CTS Flußkontrolle 

+ 

+DTR/DSR Flußkontrolle wird empfohlen, da hier alle Zeichen ohne Veränderung

+empfangen werden können. RTS/CTS Flußkontrolle kann, hardwaremäßig bedingt,

+beim Einschalten von RTS ein Bit "umkippen". 

+ 

+ 

+#k("7.3.3", "RTS/CTS")# 

+ 

+RTS/CTS ist eine Hardwareflußkontrolle bei der die Leitungen Pin 4 (RTS) und

+Pin 5 (CTS) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+RTS (Ready To Send)/CTS (Clear To Send) Flußkontrolle kann in der 2. Kom-

+mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom-

+mando <ESC> <SPACE> <n> erreichen. Die Werte von <n> sind im letzten Ab-

+schnitt (7.3.2 DTR/DSR) angegeben. 

+ 

+ 

+#k("7.4", "Echo und Local/Online")# 

+ 

+In einigen Fällen verlangt der Host, daß das vom Terminal empfangene Zei-

+chen zurückgesendet (geechoed) wird, um eventuelle Übertragungsfehler zu

+erkennen. Dieser Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D E#ie(1)#    (Hex 1B 44 45) 

+ 

+eingeschaltet. Zusätzlich wird hiermit der Localmodus ausgeschaltet (d.h der

+Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus

+gegeben wurde. 

+ 

+Der Echo-Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D O#ie(1)#    (Hex 1B 44 4F) 

+ 

+ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus.

+Der Local-Modus wird auch hierbei verlassen. 

+ 

+Der Local-Modus kann vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D L#ie(1)#    (Hex 1B 44 4C) 

+ 

+eingeschaltet werden. Dabei ist zu beachten, daß der Host den Local-Modus

+nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drücken von

+#ib(1)#<SHIFT CTRL HOME>#ie(1)# am Keyboard verlassen werden. 

+ 

+Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt,

+sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert.

+Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape-

+Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik

+oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgeführt,

+d.h. die Daten werden zum Host geschickt. 

+ 

+#page# 

+#h("8.", "Spezielle Kommandos im Textmodus")# 

+ 

+ 

+In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind

+und thematisch nicht in die anderen Kapitel passen, beschrieben. 

+ 

+ 

+#k("8.1", "Weitere Cursorpositionierungskommandos")# 

+ 

+Zusätzlich zu den im Graphikmodus und im Textmodus gültigen Cursorpositio-

+nierungskommandos gibt es noch einige weitere. Die fünf Kommandos Zeile

+löschen, Zeile einfügen, Zeichen löschen, Zeichen einfügen und Rückwärtsta-

+bulator sind schon in Kapitel 5 beschrieben worden. 

+ 

+Hier nur noch einmal die entsprechenden Kommandos: 

+ 

+Funktion            Escape-Sequenz 

+#linie("16.2")# 

+Zeile einfügen      #ib(1)#<ESC> E#ie(1)#     oder #ib(1)#<ESC> L#ie(1)# 

+Zeile löschen       #ib(1)#<ESC> R#ie(1)#     oder #ib(1)#<ESC> M#ie(1)# 

+Zeichen einfügen    #ib(1)#<ESC> Q#ie(1)# 

+Zeichen löschen     #ib(1)#<ESC> W#ie(1)# 

+Rückwärtstabulator  #ib(1)#<ESC> I#ie(1)# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> j#ie(1)#    (Hex 1B 6A) 

+ 

+kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in

+Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie <UP>. Steht der Cursor

+in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die

+erste Bildschirmzeile gelöscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> =#ie(1)# <y+32> <x+32>    (Hex 1B 3D ...) 

+ 

+kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer-

+den. <x+32> und <y+32> sind dabei Byteparameter. <x+32> hat den Wertebe-

+reich 32 (<SPACE>) bis 110 ("o"), <y+32> hat den Wertebereich 32 (<SPACE>)

+bis 55 ("7"). <x+32> ist dabei die gewünschte x-Position + 32 (gezählt wird

+von 0 bis 79), <y+32> ist die gewünschte y-Position + 32 (gezählt wird von 0

+bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man

+auch im Anhang A unter "Cursor" nachlesen. 

+ 

+Dieser Befehl hat im Graphikmodus die gleiche Wirkung! 

+ 

+ 

+#k("8.2", "Cursormodus")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> .#ie(1)# <n>    (Hex 1B 2E <n>) 

+ 

+kann die Darstellung des Cursors verändert werden. Für <n> sind ASCII-Zei-

+chen "0", "1" und "2" zugelassen. <n> hat folgende Bedeutung: 

+ 

+#on("u")#<n>   Bedeutung                             #off("u")# 

+ 0    Cursor blinkt nicht und ist unsichtbar 

+ 1    Cursor blinkt und ist sichtbar 

+ 2    Cursor blinkt nicht und ist sichtbar 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> Z#ie(1)#    (Hex 1B 5A) 

+ 

+kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge-

+schaltet werden. 

+ 

+ 

+#k("8.3", "Zeichensatz einstellen")# 

+ 

+Da die Zeichensätze von Basis und Apple unterschiedlich sind, muß hier bei

+den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei-

+chensatzes lautet in beiden Fällen 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+wobei <n> ein Byteparameter ist. Beim Apple hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#linie("16.2")# 

+ 1    Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei-

+ chen 

+ 4    Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen 

+ 

+Beim Basis hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#linie("16.2")# 

+ 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen 

+ 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen 

+ 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen 

+ 

+     Und mit blinkenden statt inversen Zeichen: 

+ 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) 

+ 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) 

+10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen 

+12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen 

+14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen 

+ 

+Einige ausgewählte Zeichensätze können auch in der Kommandozeile eingestellt

+werden. 

+ 

+ 

+#k("8.4", "Texthardcopy")# 

+ 

+Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> P#ie(1)#   (Hex 1B 50) 

+ 

+erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht verän-

+dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt,

+sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird <CR> und

+<LF> gedruckt, der Drucker sollte deshalb kein Autolinefeed bei <CR> durch-

+führen. 

+ 

+Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her-

+vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar-

+gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge-

+stellt. 

+ 

+ 

+#k("8.5", "Zeichen-Attribute")# 

+ 

+Die Zeichenattribute werden mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter, der folgende Werte annehmen kann: 

+ 

+#on("u")#<n>   Attribute                                                      #off("u")# 

+ 0    Sichtbare, normale Zeichen 

+ 1    Unsichtbare Zeichen, es werden Leerzeichen dargestellt 

+ 4    Sichtbare, inverse Zeichen 

+ 5    Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#    (Hex 1B 28) 

+ 

+kann auf normale Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 0,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#    (Hex 1B 29) 

+ 

+kann auf inverse Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 4,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+ 

+#k("8.6", "Bildhintergrund hell/dunkel")# 

+ 

+Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be-

+züglich eines gelöschten Bildschirms) umgeschaltet werden auf dunkle Schrift

+auf hellem Grund. Die Darstellung "schwarz auf weiß" ist auf einigen Monito-

+ren augenfreundlicher. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> b#ie(1)#    (Hex 1B 62) 

+ 

+kann die dunkle Schrift auf weißem Grund eingeschaltet werden. Die Darstel-

+lung von inverser und normaler Schrift wird vertauscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> d#ie(1)#    (Hex 1B 64) 

+ 

+kann helle Schrift auf dunklem Grund eingeschaltet werden. 

+ 

+ 

+#k("8.7", "Zeichentransfer zum Host")# 

+ 

+Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle

+Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers-

+schrift anzeigt. 

+ 

+ 

+#k("8.7.1", "Ein Zeichen senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 8#ie(1)#    (Hex 1B 38) 

+ 

+wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition

+ändert sich nicht. Der Cursor muß nicht sichtbar sein. 

+ 

+ 

+#k("8.7.2", "Eine Zeile senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 6#ie(1)#    (Hex 1B 36) 

+ 

+wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow,

+falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in

+Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen-

+det. Im Anschluß an die Zeile werden eventuell ein oder zwei eingestellte

+Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer

+ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen-

+det. Die Cursorposition ändert sich durch das Kommando nicht. 

+ 

+ 

+#k("8.7.3", "Eine Seite senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 7#ie(1)#    (Hex 1B 37) 

+ 

+wird die gesamte Bildschirmseite an den Host gesendet. Im Anschluß an jede

+Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschluß an

+die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator)

+gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969

+Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun-

+terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe-

+grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ändert sich

+durch dieses Kommando nicht. 

+ 

+ 

+#k("8.7.4", "Terminatorzeichen definieren")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 1#ie(1)# <l1> <l2>    (Hex 1B 78 31 <l1><l2>) 

+ 

+können die Zeilenbegrenzer der Sendekommandos festgelegt werden. <l1> und

+<l2> sind dabei Byteparameter, die den Wertebereich 0 bis 255 überstrei-

+chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet.

+Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren-

+zerzeichen nach der Zeile gesendet. 

+Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 4#ie(1)# <p>    (Hex 1B 78 34 <p>) 

+ 

+kann der Seitenbegrenzer des Kommandos #ib(1)#<ESC> 7#ie(1)# festgelegt werden. <p> ist

+ein Byteparameter, der den Wertebereich von 0 bis 255 überstreicht. Ist <p>

+Hex 00, dann wird kein Seitenbegrenzer gesendet. 

+Voreingestellt ist <p> = <CR> (Hex 0D). 

+ 

+ 

+#k("8.7.5", "Cursorposition senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ?#ie(1)#    (Hex 1B 3F) 

+ 

+kann der Host die Position des Textcursors abfragen. Es wird eine Folge von

+3 Bytes gesendet: <y+32> <x+32> <CR> 

+ 

+<y+32> ist die y-Position + 32, <x+32> die x-Position + 32. Beide Parameter

+können für den Befehl #ib(1)#<ESC> =#ie(1)# <y+32> <x+32> verwendet werden, da Sie den

+gleichen Wertebereich überstreichen. 

+ 

+ 

+#k("8.8", "Textseite auf Diskette speichern/laden")# 

+ 

+Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und

+zu einem späteren Zeitpunkt wieder zurückgeladen werden. Bei der Textseite

+wird außerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann

+sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen

+und diese Seiten auf Diskette abspeichern. Später kann man die Datei Offline

+(im Localmodus) Seitenweise ansehen. 

+ 

+Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen.

+Die "Fächer" für die Textseiten sind unabhängig von denen für die Graphik-

+seiten. 

+Die Seiten werden unabhängig von REVVID (Schwarz auf Weiß) immer NORVID

+(also Weiß auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach

+REVVID/NORVID dargestellt. 

+ 

+Das Kommando für diese Operationen lautet 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits

+folgendermaßen belegt sind: 

+Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) 

+Bit 3    : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) 

+Bit 4    : 0 heißt: die Textseite wird von der Diskette gelesen, 

+           1 heißt: die Textseite wird auf die Diskette geschrieben. 

+ 

+Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Textseite überschrieben. 

+ 

+Für Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten

+             befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol-

+             ge. 

+ 

+ 

+#page# 

+#h("9.", "Verschiedene Steuerkommandos")# 

+ 

+ 

+#k("9.1", "Signalton")# 

+ 

+Mit 

+                         #ib(1)#<CTRL G>#ie(1)#   (Hex 07) 

+ 

+wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schär-

+fer (heller). 

+ 

+ 

+#k("9.2", "Keyboardclick")# 

+ 

+Der Tastaturclick wird für fast alle Tasten erzeugt. Ausnahmen sind die

+<SHIFT> und die <CTRL> Tasten, sowie beim Apple die Apfeltasten. Der Tasta-

+turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder

+mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <#ie(1)#    (Hex 1B 3C) 

+ 

+vom Host. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> >#ie(1)#    (Hex 1B 3E) 

+ 

+kann der Keyboardclick wieder eingeschaltet werden. 

+ 

+ 

+#k("9.3", "Bildschirmausgabe/Druckerausgabe")# 

+ 

+Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der

+Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> `#ie(1)#    (Hex 1B 60) 

+ 

+abgeschaltet werden. Bis auf das Kommando 

+ 

+                         #ib(1)#<ESC> a#ie(1)#    (Hex 1B 61) 

+ 

+werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit <ESC> a

+wird die Bildschirmausgabe wieder zugelassen. 

+ 

+Die Druckerausgabe kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> @#ie(1)#    (Hex 1B 40) 

+ 

+eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild-

+schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch

+ein- und ausgeschaltet werden. 

+Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal-

+ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet.

+Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe

+abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker-

+ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. 

+ 

+Abgeschaltet wird die Druckerausgabe mit dem Kommando 

+ 

+                         #ib(1)#<ESC> A#ie(1)#    (Hex 1B 41) 

+ 

+ 

+#k("9.4", "Scroll/Page-Modus")# 

+ 

+Steht der Cursor in der letzten Zeile und soll er in die nächst tiefere

+gebracht werden (<DOWN>, <TAB>, <NEWLINE> etc.), dann gibt es entweder die

+Möglichkeit, daß der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile

+verschwindet und die 24. Zeile wird gelöscht, oder daß der Cursor in der

+ersten Bildschirmzeile wieder auftaucht, ohne daß der Bildschirminhalt ver-

+ändert wird. Die erste Möglichkeit heißt SCROLL-Modus, die zweite PAGE-

+Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen

+oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> H#ie(1)#    (Hex 1B 48). 

+ 

+In der Kommandozeile hat man die Informationsmöglichkeit, welcher Modus

+gerade aktiv ist. 

+ 

+ 

+#k("9.5", "Belegung der Funktionstasten")# 

+ 

+Eine nützliche Angelegenheit sind die programmierbaren Funktionstasten. Die

+Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk-

+tionstasten können im Local-Modus aufgerufen werden, zum Beispiel für häu-

+fig gebrauchte Terminalkommandos oder längere Kommandosequenzen (Graphikmo-

+dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion-

+stasten legen. 

+ 

+Die Länge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095

+Zeichen überschreiten. Ein akustisches Warnsignal ertönt, wenn die Funk-

+tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch

+nach dem Abschalten des Terminals erhalten bleiben, dann muß in der Komman-

+dozeile <SHIFT S> gegeben werden, damit der Setup samt Funktionstastende-

+finitionen auf die Diskette geschrieben wird. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+wird eine Taste belegt. <d...> und <t> sind Byteparameter. <d...> ist eine

+Folge von Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funk-

+tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese

+Einschränkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman-

+dos möglich, man kann allerdings z.B. auch nicht alle binären Parameter auf

+Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc.

+können nicht belegt werden. 

+Um die Original-Tastencodes wieder zu benutzen, gibt es drei Möglichkeiten: 

+ 

+- Die Tabelle der Tastendefinitionen wird ganz gelöscht (Abschnitt 9.6). 

+- Die Definition auf einzelnen Tasten wird durch <ESC> e <t> gelöscht. <t>

+  ist dabei der Code einer zu löschenden Taste. 

+- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando 

+ 

+                         #ib(1)#<ESC> c#ie(1)#    (Hex 1B 63) 

+ 

+  gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder,

+  bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im

+  Graphikmodus möchte man eventuell die griechischen Sonderzeichen auf den

+  Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten-

+  strings (F STRG). 

+ 

+ 

+#k("9.5.1", "Local-Escape")# 

+ 

+Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu

+können (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei-

+chen statt <ESC> (Hex 1B) verwendet. 

+Das Zeichen 

+ 

+                         #ib(1)#<LOCESC>#ie(1)#    (Hex 9B) 

+ 

+teilt dem Terminal mit, daß die nun folgende Escape-Sequenz nicht an den

+Host gesendet wird (was bei <ESC> der Fall wäre), sondern vom Terminal in-

+terpretiert werden muß. 

+Im Local-Modus wirkt ein <LOCESC> wie ein normales <ESC>, d.h. das Kommando

+wird sowieso vom Terminal interpretiert. 

+ 

+ 

+#k("9.5.2", "Makrokommandos")# 

+ 

+Ein Makrokommando hat (mindestens) drei Aufgaben: 

+- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren,

+  z.B. um andere Terminals zu emulieren. 

+- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der

+  Host, wenn die Funkionstaste als Makro aufgerufen wird. 

+- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkürzungen

+  häufig benutzter Zeichenfolgen beschleunigt werden. 

+ 

+Ein Makro wird wie eine Funktionstaste mit dem Kommando 

+ 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+definiert. <d...> und <t> sind Byteparameter. <d...> ist eine Folge von

+Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funktionstaste

+(Bit 7 = 1) oder mit anderen Worten der Makroname. 

+Es sind alle Codes für <t> zugelassen, die auch bei der Funktionstastende-

+finition zugelassen sind. 

+ 

+Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host

+mit 

+ 

+                         #ib(1)#<ESC> <Macrocode>#ie(1)#    (Hex 1B <Makrocode>) 

+ 

+aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge-

+setzt, als käme sie von der Tastatur im Local-Modus. Wird das Makro also

+bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, daß man

+im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. 

+Anmerkung: Wird das <ESC> vor dem <Makrocode> weggelassen, dann wird der

+           Code <Makrocode> ohne Makroausführung an das Terminal gesendet

+           und i.d.R. als inverses Zeichen dargestellt. 

+ 

+Sollen Byteparameter in die Zeichensequenz des Makros übernommen werden, die

+zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen

+Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81

+kann auf der Tastatur durch <SHIFT DELETE> erzeugt werden. 

+Wird bei der Makroausführung ein solcher Code gefunden, wartet das Terminal

+auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde,

+oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es dürfen beliebig

+viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird

+durch ein weiteres Zeichen von Host oder Tastatur ersetzt. 

+ 

+ 

+#k("9.5.3", "Startup-Makro")# 

+ 

+Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur

+durch <SHIFT BOTTOMRIGHT> (beim Apple <OA RIGHT>) erzeugt werden. 

+ 

+Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder <ESC> 0)

+oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra-

+phikseiten werden vorher gelöscht. 

+

+

+#k("9.6", "Tabellen und Puffer löschen")# 

+ 

+Das Terminal enthält den Empfangspuffer, den Sendepuffer, den Druckerspoo-

+ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die

+Tabelle zu löschen, kann das Kommando 

+ 

+                         #ib(1)#<ESC> <DEL>#ie(1)# <n>    (Hex 1B 7F <n>) 

+ 

+verwendet werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 15

+und hat folgende Bedeutung: 

+ 

+#on("u")#<n>    Gelöschte Tabelle oder Puffer#off("u")# 

+ 0     Keine 

+ 1     Tastendefinitionen 

+ 2     Druckerspooler 

+ 3     Empfangspuffer 

+ 4     Sendepuffer 

+ 

+Zu beachten ist, daß zwar der Sendepuffer gelöscht wird, aber eine eventu-

+ell gestoppte Übertragung (TX OFF) nicht wider gestartet wird. 

+ 

+ 

+#k("9.7", "Zeitverzögerung")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 9#ie(1)# <n>    (Hex 1B 39 <n>) 

+ 

+kann eine Zeitverzögerung aufgerufen werden. Man kann zum Beispiel ein Fa-

+denkreuz darstellen, die Zeitverzögerung aufrufen und das Fadenkreuz wieder

+löschen. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die

+Verzögerung beträgt ca. <n> * 2 ms. 

+ 

+ 

+#k("9.8", "Transparentmodi")# 

+ 

+Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp-

+fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten

+Programmen gedacht. 

+ 

+ 

+#k("9.8.1", "Monitor-Modus")# 

+ 

+Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control-

+zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei-

+chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex

+A0..FF unterscheiden, die auch invers dargestellt werden. 

+Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet

+werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> U#ie(1)#    (Hex 1B 55) 

+ 

+kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter-

+pretation ausgegeben, Ausnahmen sind 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58) 

+ 

+die den Monitormodus ausschalten. 

+ 

+ 

+#k("9.8.2", "Hexadezimal-Modus")# 

+ 

+In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son-

+dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden

+Blanks. Der Hexmode kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus-

+gegeben, außer #ib(1)#<ESC> u#ie(1)# und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58), 

+ 

+die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten

+Kommandozeile ein- und ausgeschaltet werden. 

+ 

+ 

+#k("9.8.3", "Einzelne Control-Zeichen anzeigen")# 

+ 

+Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. für den

+unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt

+es das Kommando 

+ 

+                         #ib(1)#<ESC> F#ie(1)# <z>    (Hex 1B 46 <z>). 

+ 

+<z> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei-

+se 0 bis 31. <z> wir mit invertiertem Bit 7 (normal/invers) in den Bild-

+schirmspeicher an der aktuellen Cursorposition geschrieben. 

diff --git a/system/ruc-terminal/unknown/doc/TDOCP.PRT b/system/ruc-terminal/unknown/doc/TDOCP.PRT
new file mode 100644
index 0000000..1c2b6f1
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TDOCP.PRT
@@ -0,0 +1,4008 @@
+#type ("elite")##limit (16.2)##block# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#text begin# 

+ 

+#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# 

+ 

+#center#Version 1.1 

+ 

+#center#Oktober 1986 

+#free (16.0)# 

+ruc - Rolf Uhlig Computer 

+GmbH & Co Kommanditgesellschaft 

+Sendenhorster Straße 82 

+D - 4406 Drensteinfurt 1 

+Telefon 02508/8500 

+ 

+Michael Staubermann 

+Moränenstraße 29 

+D - 4400 Münster-Hiltrup 

+Telefon 02501/4320 

+#pagenr (""224"", 1)#

+#text end#

+#free(2.2225)#

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#1.  Einige Worte zuvor#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin#

+#type("8")##center##on("i")##on("u")##ib(3)#1.  Einige Worte zuvor#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Dieses Terminalprogramm wird in zwei Versionen (für den Basis 108 und den

+Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich

+(BASIS oder APPLE). 

+ 

+Eigenschaften des Terminals: 

+ 

+- Kommandozeilen für schnelle Offline Parametereinstellung 

+- Statuszeile für spezielle Betriebzustände 

+- Über 70 programmierbare Funktionstasten 

+- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) 

+- 7935 Zeichen Empfangspuffer 

+- Verschiedene Hardcopy Modi für Text und Graphik 

+- 192x280 Punkte auflösender Graphikmodus mit zwei Helligkeitsstufen 

+- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung 

+- Viele Graphikroutinen (Bogen, Flächenfüllung, Kreis, Rechteck...) 

+- Graphikmodus für Texte in verschieden Richtungen, Dicken, Grössen 

+- Griechische Graphikzeichen und Kursivschrift 

+- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken 

+ 

+ 

+Zum Handbuch 

+ 

+Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und

+in spitze Klammern gesetzt (z.B. <TAB>) in einigen Fällen auch durch ihren

+Namen (z.B. <DOWN> oder <TOPLEFT>). Eine zusätzlich zu betätigende Umschalt-

+taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in

+der Klammer davorgestellt (z.B. <SHIFT RETURN>). 

+ 

+Nicht druckbare Ascii-Codes (z.B. <ESC> oder <SPACE>), sowie Kommandopara-

+meter (z.B. <n>) werden ebenfalls in spitze Klammern gesetzt. Komandopara-

+meter werden mit Kleinbuchstaben bezeichnet. 

+ 

+#text end#

+#free(7.220185)#

+ 

+ 

+ 1 

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#2.  Die Hardware#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Unterstützt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein

+Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen

+werden. 

+ 

+ 

+#type("8")##center##ib(3)#2.1  Die serielle Schnittstelle#ie(3)##type("elite")# 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host oder vom Terminal

+(LOCAL) eingestellt werden (Siehe Kommando <ESC> <SPACE> <SPACE>). Es wer-

+den alle 15 gängigen Baudrates zwischen 50 und 19200 Baud unterstützt. Pari-

+tycheck kann mit gerader oder ungerader Parität durchgeführt werden. Fluß-

+kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF möglich.

+Empfohlen wird DTR/DSR oder XON/XOFF. 

+ 

+             Benötigte Verdrahtung der seriellen Schnittstelle 

+ 

+            Pin                                        Priorität 

+              2 : TXD Sendedaten    zum Host (RXD)         1 

+              3 : RXD Empfangsdaten vom Host (TXD)         1 

+              4 : RTS Ready To Send zum Host (CTS)         3 

+              5 : CTS Clear To Send vom Host (RTS)         3 

+              6 : DSR DataSet Ready vom Host (DTR)         2 

+              7 : Masse an Host Masse                      1 

+              8 : DCD Eingang, nicht benötigt 

+             20 : DTR Data Terminal Ready zum Host (DSR)   2 

+ 

+Priorität: 

+ 1 : Muß verdrahtet werden 

+ 2 : Ist bei DSR/DTR Flußkontrolle zu verdrahten 

+ 3 : Ist bei RTS/CTS Flußkontrolle zu verdrahten 

+ 

+Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host

+nur über 7 Bit Datentransfer verfügen, müssen einige Einschränkungen bei der

+Parameterübergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die

+Anzahl der Datenbits kann auch in der Kommandozeile verändert werden. 

+ 

+ 

+#type("8")##center##ib(3)#2.2  Der Reset#ie(3)##type("elite")# 

+ 

+Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm-

+seiten und Puffer, sowie der Druckerspooler werden gelöscht. Der Reset kann

+vom Host durch 

+ 

+                         #ib(1)#<ESC> 0#ie(1)#    (Hex 1B 30) 

+ 

+initiiert werden, vom Basiskeyboard aus durch <SHIFT SHIFT CTRL>. Die Para-

+meter in der Kommandozeile werden dem Setup entnommen. Nach dem Löschen

+aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies

+ist die Funktionstaste <SHIFT BOTRIGHT>. 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#2 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 2 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#3.  Die Kommandozeile#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die wichtigsten Parameter des Terminals können im laufenden Betrieb in den

+beiden Kommandozeilen geändert werden. Die erste Kommandozeile erscheint

+beim Basiskeyboard durch Drücken von <SHIFT CE> und beim Apple durch <OA

+CTRL X>. 

+ 

+Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen

+(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mög-

+lichkeit wichtige Parameter in der Kommandozeile zu ändern. 

+ 

+Die angezeigten Einstellungen bieten außerdem eine Informationsmöglichkeit

+über die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite

+Kommandozeile enthält die Parameter der seriellen Schnittstelle. 

+ 

+Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF)

+können auch durch ESC-Kommandos vom Host oder im Localmodus geändert wer-

+den. 

+Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen

+sichtbar sind. 

+ 

+ 

+#type("8")##center##ib(3)#3.1  Tastenfunktionen in der Kommandozeile#ie(3)##type("elite")# 

+ 

+Folgende Tasten haben in der Kommandozeile eine Wirkung: 

+ 

+Taste              Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<UP> oder <DOWN>   Wechselt in die jeweils andere Kommandozeile 

+ 

+<LEFT>             Springt zum vorherigen (linken) Parameter ohne etwas zu

+                   verändern. 

+ 

+<RIGHT>            Springt zum nächsten (rechten) Parameter ohne etwas zu

+                   verändern. 

+ 

+<SPACE>            Ändert das selektierte Parameterfeld. Das selektierte

+                   Parameterfeld ist durch Invertierung hervorgehoben. Die

+                   möglichen Parameter wiederholen sich zyklisch. 

+ 

+<ESC>              Die Kommandozeile wird verlassen. Es werden keine Ände-

+                   rungen durchgeführt. 

+ 

+<SHIFT S>          Die Kommandozeile wird verlassen. Vorher werden alle

+                   Änderungen permanent auf die Diskette geschrieben. Wei-

+                   tere Einzelheiten s.u. (Setup) 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 3 

+#page##--------------------------------- Ende der Seite 3 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")#

+#text begin# 

+<SHIFT R>          Alle Parameter werden auf ihre Defaultwerte zurückge-

+                   setzt. Die Kommandozeile wird noch nicht verlassen, daher

+                   kann dieser 'Reset' durch <ESC> wieder aufgehoben werden. 

+                   <CE> oder <CTRL X> Die Kommandozeile wird verlassen. Die

+                   Änderungen werden nur im Speicher vermerkt. Nach dem

+                   Ein-/Ausschalten des Rechners werden die alten Parameter

+                   von der Diskette gelesen. Wird allerdings ein Hardware-

+                   reset (s.o.) durchgeführt, sind diese Änderungen nicht

+                   verloren. 

+ 

+ 

+#type("8")##center##ib(3)#3.2  Setup#ie(3)##type("elite")# 

+ 

+Beim Setup, der in der Kommandozeile durch <SHIFT S> ausgelöst werden kann,

+werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann

+'permanent' und müssen nach dem Einschalten des Terminals nicht neu einge-

+stellt werden. Diese Parameter sind die 

+- Parameter der seriellen Schnittstelle (2. Kommandozeile) 

+- anderen Parameter der Kommandozeilen 

+- vom Benutzer programmierte Belegung der Funktionstasten 

+- Druckerspezifischen Hardcopyparameter 

+ 

+Vor dem Setup ist zu prüfen, ob der Diskettenschreibschutz entfernt wurde

+(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte

+nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent-

+fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In

+diesem Falle erscheint nach dem Drücken einer Taste wieder die Kommando-

+zeile. 

+Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er-

+scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh-

+ler)!'. Weitere Schreibversuche sind möglicherweise erfolgreich. 

+ 

+ 

+#type("8")##center##ib(3)#3.3  Die zweite Kommandozeile#ie(3)##type("elite")# 

+ 

+Beim Basis (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+USA  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+APL       HEX ON                                                  CUR OFF 

+UNI 

+#type ("elite")# 

+ 

+Beim Apple (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+FLH  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+          HEX ON                                                  CUR OFF 

+#type ("elite")# 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#4 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 4 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")#

+#text begin# 

+Default Andere   Funktion 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Basis 

+ GER    USA      Die Zeichensatzeinstellung ist für die gebräuchlichsten 

+        APL      vier Zeichensätze in der Kommandozeile möglich. 

+        UNI      GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz

+                 UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der

+                 APL-Zeichensatz entählt auch die Zeichen [\]{|}~. Über

+                 ESC-Kommandos lassen weitere Möglichkeiten einstellen. 

+ 

+ BASIS  TVI      Keyboard Emulation. BASIS sendet die Funktionstastencodes

+                 mit Bit 7 = 1. TVI sendet für jede Funktionstaste eine

+                 Zeichenfolge <SOH> x <CR>. Die Cursortasten sowie DEL CHAR,

+                 INS CHAR, DEL LINE, INS LINE werden wie bei TVI üblich

+                 gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) 

+ 

+Apple 

+ USA    FLH      USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken

+                 und Invers. 

+ 

+ APPLE  TVI      Keyboard Emulation. APPLE führt keine Codeumsetzung durch.

+                 Wird allerdings die <OPEN APPLE>-Taste mit einer anderen

+                 Taste zusammen gedrückt, wird das Bit 7 im Code auf 1 ge-

+                 setzt. Zur TVI-Emulation siehe oben. 

+ 

+MON OFF MON ON   Der Monitor Modus wird mit MON ON eingeschaltet. In diesem 

+        HEX ON   Modus werden alle Steuerzeichen auf dem Bildschirm mar-

+                 kiert ausgegeben. Bis auf die Kommandos <ESC> u oder <ESC>

+                 X (um den Monitormodus auszuschalten) werden keine Komman-

+                 dos interpretiert. Alle anderen Zeichen werden unverändert

+                 dargestellt. Der Monitormodus kann auch durch MON OFF aus-

+                 geschaltet werden. 

+                 Im Hexmodus werden keine Zeichen, sondern deren Ascii-

+                 Codes in Hexadezimaldarstellung ausgegeben. 

+ 

+PRT OFF PRT ON   Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden

+                 alle Zeichen die von der seriellen Schnittstelle kommen,

+                 auf dem Drucker ausgegeben bzw. in den Druckerspooler ge-

+                 schrieben. Die Bildschirmausgabe wird hiervon nicht beein-

+                 flußt. 

+ 

+SCRN ON SCR OFF  Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer-

+                 den alle Zeichen die von der seriellen Schnittstelle kom-

+                 men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann

+                 zum Beispiel benutzt werden, um Daten nur an den Drucker zu

+                 schicken, ohne daß diese auch auf dem Bildschirm erschei-

+                 nen. 

+ 

+KEY CLK CLK OFF  Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede

+                 Taste (bis auf SHIFT, CTRL) bei ihrer Betätigung einen Ton

+                 (Klick) von sich. CLK OFF schaltet dies ab. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 5 

+#page##--------------------------------- Ende der Seite 5 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+NORVID  REVVID   Bildschirmdarstellung. NORVID stellt hellen Text auf

+                 schwarzem Grund dar, REVVID stellt schwarzen Text auf hel-

+                 lem Grund dar (Möglicherweise angenehmer für die Augen). 

+ 

+SCROLL  PAGE     Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile

+                 nach oben geschoben, sobald der Cursor in der letzten Bild-

+                 schirmzeile steht und ein Zeilenvorschub <LF> ausgeführt

+                 werden soll. Die erste Bildschirmzeile verschwindet. Ist

+                 PAGE eingeschaltet, springt der Cursor in einer solchen

+                 Situation in die erste Bildschirmzeile. Die Cursorspalte

+                 wird dabei nicht verändert. 

+ 

+BELL ON BELL OFF Normalerweise erzeugt jedes empfangene <CTRL G> einen kur-

+                 zen Signalton. Wenn das stört, kann die Tonausgabe mit BELL

+                 OFF abgeschaltet werden. 

+ 

+CUR FLH CUR STD  Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF

+                 Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor-

+                 block. CUR OFF schaltet den Cursor ab (unsichtbar). 

+ 

+F STRG  F CODE   Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt

+                 eine programmierte (belegte) Funktionstaste keinen Tasten-

+                 code, sondern sendet die programmierten Zeichen. Eine unbe-

+                 legte Funktionstaste sendet ihren Tastencode. Ist F CODE

+                 eingeschaltet, erzeugen auch belegte Funktionstasten einen

+                 Tastencode und senden keine programmierten Zeichen. 

+ 

+ 

+#type("8")##center##ib(3)#3.4  Die zweite Kommandozeile#ie(3)##type("elite")# 

+ 

+Die erste Zeile zeigt Defaultwerte für <SHIFT R>: 

+ 

+#type ("micron")# 

+STATOFF|TXT| 9600|STOP 1|DATA 8|NO  PAR|NO XONOFF|NO RTSCTS|NO DTRDSR 

+STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR  XON/XOFF  RTS/CTS   DTR/DSR 

+               50               ODD PAR 

+               75 

+            109.9 

+            134.6 

+              150 

+              300 

+              600 

+             1200 

+             1800 

+             2400 

+             3600 

+             4800 

+             7200 

+#type ("elite")# 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+#right#6 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 6 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Default Andere   Funktion 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+STATOFF STAT ON  Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms

+                 beträgt zwar immer 24 Zeilen, allerdings ist bei STAT ON

+                 anstelle der 24. Textzeile die Statuszeile sichtbar. Bei

+                 STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht-

+                 bar. Einzelheiten s.u. (Die Statuszeile) 

+ 

+TXT     GFX      Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen

+                 Textdarstellung um. GFX schaltet auf die aktuelle Graphik-

+                 seite um. 

+ 

+9600    19200    Wählt die Baudrate für die serielle Schnittstelle. 

+           50    Die Angabe erfolgt in Bits/Sekunde (Baud) 

+           75 

+          109.9 

+          134.6 

+          150 

+          300 

+          600 

+         1200 

+         1800 

+         2400 

+         3600 

+         4800 

+         7200 

+ 

+STOP 1  STOP 2   Wählt die Anzahl der Stopbits für die serielle Schnitt-

+                 stelle. 

+ 

+DATA 8  DATA 7   Wählt die Anzahl der Datenbits für die serielle Schnitt-

+                 stelle. 

+ 

+NO PAR  EVN PAR  Wählt Parity Check Art. NO PAR = Kein Paritätsbit, keine 

+        ODD PAR  Paritätsprüfung. EVN PAR = Gerade Parität, ODD PAR = Unge-

+                 rade Parität. 

+ 

+NO XONOFF        Wählt XON (CTRL Q) und XOFF (CTRL S) als Protokoll für die 

+        XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann

+                 das Terminal noch 255 Zeichen empfangen, bis der Empfangs-

+                 puffer überläuft. Mit NO XONXOFF wird dieses Protokoll

+                 ausgeschaltet. 

+ 

+NO RTSCTS        Wählt RTS/CTS als Protokoll für die serielle Schnittstel-

+        RTS/CTS  le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. 

+ 

+NO DTRDSR        Wählt DTR/DSR als Protokoll für die serielle Schnittstel-

+        DTR/DSR  le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 7 

+#page##--------------------------------- Ende der Seite 7 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#4.  Die Statuszeile#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die Statuszeile enthält 5 Felder, die über die wichtigsten Betriebszustände

+des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin-

+tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit

+STAT ON oder vom Host oder im Local Modus mit 

+ 

+                         #ib(1)#<ESC> }#ie(1)#   (Hex 1B 7D) 

+ 

+eingeschaltet werden. Ausschalten ebenso mit STATOFF oder 

+ 

+                         #ib(1)#<ESC> {#ie(1)#   (Hex 1B 7B) 

+ 

+Die Zuordnung der Felder: 

+ 

+#type ("micron")# 

+Spooler | Empfängerpuffer | Senderpuffer | Bereit/Beschäftigt | Local/Online

+#type ("elite")# 

+ 

+Kritische Zustände werden invers markiert. Dies sind alle Fälle, in denen

+ein Puffer überläuft. 

+Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. 

+Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe

+mehr annehmen, kann man durch längeres Drücken von <SHIFT ESC> Zeichen aus

+dem Druckerpuffer entfernen, damit wieder Platz frei wird. 

+Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich

+daran, daß der Host kein XON gesendet hat oder dieses falsch übertragen

+wurde. Durch Drücken von <SHIFT ESC> kann man den Transmitter wieder star-

+ten. 

+ 

+ 

+#type("8")##center##ib(3)#4.1  Spoolerstatus#ie(3)##type("elite")# 

+ 

+- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist

+  nichts zum Drucken im Puffer. 

+ 

+- PRINT zeigt an: Der Spooler ist gefüllt. Das Terminal ist druckwillig oder

+  der Drucker druckt. 

+ 

+- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei-

+  teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man

+  einzelne Zeichen mit <SHIFT ESC> aus dem Druckerpuffer entfernen bis PRINT

+  im Feld erscheint. 

+ 

+ 

+#type("8")##center##ib(3)#4.2  Empfängerstatus#ie(3)##type("elite")# 

+ 

+- Ein leeres Feld bedeutet: Im Empfängerpuffer ist noch Platz. 

+ 

+- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfängerpuffer

+  voll ist. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#8 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 8 -----------#

+#center##on("b")#4.  Die Statuszeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#4.3  Senderstatus#ie(3)##type("elite")# 

+ 

+- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge-

+  sendet werden muß, wird es sofort auf die serielle Schnittstelle ge-

+  schickt. 

+  Ein > vor TX ON zeigt an, daß das Terminal auf Freiwerden der seriellen

+  Schnittstelle wartet. 

+ 

+- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware-

+  flußkontrolle aktiviert, um das Terminal zu stoppen. 

+ 

+- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine

+  Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit <SHIFT ESC>

+  erzwungen werden. 

+ 

+ 

+#type("8")##center##ib(3)#4.4  Busy - Anzeige#ie(3)##type("elite")# 

+ 

+- READY bedeutet: Der Empfänger ist empfangsbereit, d.h. im Empfangspuffer

+  sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht

+  per Flußkontrolle gestoppt. 

+ 

+- BUSY bedeutet: Der Empfänger hat dem Host per Flußkontrolle angezeigt, daß

+  nicht mehr genügend Platz im Empfangspuffer war. Die Flußkontrolle wird

+  wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. 

+  (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrückt wird und der Host

+  #on("u")#nicht#off("u")# empfangsbereit ist, gerät das Terminal in eine

+  "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset

+  abgebrochen werden kann.) 

+ 

+ 

+#type("8")##center##ib(3)#4.5  Online/Local - Anzeige#ie(3)##type("elite")# 

+ 

+- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp-

+  fängt Zeichen und Kommandos vom Host. 

+ 

+- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei-

+  ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter-

+  minal. 

+ 

+#text end#

+#clear pos# 

+#free(5.103519)#

+ 

+ 

+ 9 

+#page##--------------------------------- Ende der Seite 9 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#5.  Die Bedeutung der Tasten#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Zusätzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind

+einige weitere zur Verfügung gestellt worden. Beim Apple senden fast alle

+Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom

+Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden

+einige bisher nur einfach belegte Tasten wie <RETURN>, <TAB>, <ESC>, <CE>

+und der Zehnerblock mit Doppelfunktionen über <SHIFT> versehen. 

+ 

+ 

+#type("8")##center##ib(3)#5.1  Die Funktions- und Steuertasten#ie(3)##type("elite")# 

+ 

+Zuerst werden die Tastenfunktionen erläutert für ein nicht emulierendes

+Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden

+(1. Zeile, 2. Feld) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 0#ie(1)#    (Hex 1B 20 30) 

+ 

+Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim

+Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes

+überein. <TOPLEFT> bezeichnet beim Basiskeyboard die linke obere Eckposi-

+tion des Cursorblocks, <TOPRIGHT> die rechte obere etc. 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<TAB>            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten. Also 1, 9, 17, 25, 33, 41, 49,

+                                       57, 65, 73. War der Cursor in Spalte

+                                       73 bis 79, dann wird er in die erste

+                                       Spalte der nächst tieferen Bild-

+                                       schirmzeile gesetzt. War der Cursor

+                                       vorher auch noch in Zeile 24, dann

+                                       wird der Bildschirminhalt entweder

+                                       nach oben gescrollt (SCROLL) oder in

+                                       Homeposition gebracht (PAGE). 

+ 

+<SHIFT TAB>      <OA TAB>      89      Back-Tab (Rückwärtstabulator). Der

+                                       Cursor wird in die nächste links vom

+                                       Cursor befindliche Tabulatorposition

+                                       gebracht. War der Cursor in Spalte 1,

+                                       dann steht er jetzt in Spalte 73 der

+                                       darüberliegenden Zeile. War der Cur-

+                                       sor in Homeposition, dann ändert sich

+                                       seine Position nicht. 

+ 

+<SHIFT CE>       <OA CTRL X>    -      Kommandozeile aktivieren. Einzelhei-

+                                       ten zur Kommandozeile siehe Abschnitt

+                                       3.: Die Kommandozeilen. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#10 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 10 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<CE>             <CTRL X>      18      U.a. Kommandozeile verlassen. 

+ 

+<RETURN>         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub.

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+<SHIFT RETURN>   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten (24.) Bild-

+                                       schirmzeile war, wird der Bildschir-

+                                       minhalt entweder nach oben gescrollt

+                                       (SCROLL) oder in Homeposition ge-

+                                       bracht (PAGE). 

+ 

+<UP>             <UP>       8B/0B      Cursor eine Zeile höher. War der

+                                       Cursor in der ersten Bildschirmzei-

+                                       le, ändert sich seine Position nicht. 

+ 

+<DOWN>           <DOWN>     8A/0A      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann wird der

+                                       Bildschirminhalt entweder nach oben

+                                       gescrollt (SCROLL) oder der Cursor in

+                                       die erste Bildschirmzeile gesetzt

+                                       (PAGE). 

+ 

+<CTRL V>         <CTRL V>      16      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+<LEFT>           <LEFT>     88/08      Cursor eine Spalte nach links. War

+                                       der Cursor in der ersten Bildschirm-

+                                       spalte, dann steht er jetzt in der

+                                       letzten Spalte der darüberliegenden

+                                       Bildschirmspalte. War der Cursor

+                                       allerdings in Homeposition, ändert

+                                       sich seine Position nicht. 

+ 

+<RIGHT>             -          95      Cursor eine Spalte nach rechts. War

+                                       der Cursor in Spalte 79, dann steht

+                                       er jetzt in der ersten Spalte der

+                                       folgenden Zeile. War der Cursor in

+                                       der letzten Zeile, dann wird der

+                                       Bildschirminhalt um eine Zeile nach

+                                       oben gescrollt (SCROLL) oder der

+                                       Cursor in Homeposition gebracht

+                                       (PAGE). 

+ 

+<HOME>           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+<SHIFT HOME>     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 11 

+#page##--------------------------------- Ende der Seite 11 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<DELETE>         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm als Punktraster dargestellt.

+                                       Der Host interpretiert es in der

+                                       Regel als Zeichenlöschbefehl. 

+ 

+<TOPLEFT>        <OA CTRL N>   8E      Zeichen bei Cursorposition einfügen.

+                                       Der Cursor ändert seine Position

+                                       nicht. Unter dem Cursor steht dann

+                                       ein Leerzeichen. Das Zeichen in Spal-

+                                       te 79 geht verloren. 

+ 

+<SHIFT TOPLEFT>  <OA CTRL B>   82      Zeichen unter Cursorposition löschen.

+                                       In Spalte 79 steht dann ein Leerzei-

+                                       chen. 

+ 

+<TOPRIGHT>       <OA CTRL O>   8F      Zeile bei Cursorposition einfügen.

+                                       Die Cursorposition ändert sich nicht.

+                                       Der Inhalt der letzten Bildschirmzei-

+                                       le ist verloren. Die Zeile in der der

+                                       Cursor steht wird mit Leerzeichen

+                                       gefüllt. 

+ 

+<SHIFT TOPRIGHT> <OA CTRL C>   83      Zeile in der der Cursor steht lö-

+                                       schen. Die Cursorposition ändert sich

+                                       nicht. Der Inhalt der gelöschten

+                                       Zeile ist verloren. Die letzte Bild-

+                                       schirmzeile wird mit Leerzeichen

+                                       aufgefüllt. 

+ 

+<BOTTOMLEFT>     <BACKSPACE>   08      Cursor eine Spalte nach links. Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+<BOTTOMRIGHT>    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts. Die Funktion ist mit der von

+                                       <RIGHT> identisch. 

+ 

+<SHIFT BOTTOMRIGHT> <OA RIGHT> EF      Diese Taste ist eine programmierbare

+                                       Funktionstaste (siehe <ESC> e). 

+ 

+<SHIFT DELETE>   <OA DELETE>   81      Diese das liefert den

+                                       Makroparametercode (siehe <ESC> e). 

+ 

+<ESC>            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+<SHIFT ESC>      <OA ESC>      9B      Während der Funktionstastedefinition

+                                       wirkt diese Taste wie ein Local

+                                       Escape, sonst liefert sie den Code 9B.

+                                       (siehe <ESC> e). 

+                                       

+<SHIFT CTRL HOME><OA 0>         -      Local/Online umschalten. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#12 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 12 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<CTRL HOME>      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...    <OA a> ...    E1 ...  programmierbare Funktionstasten 

+<SHIFT 9>        <OA i>        E9             "               " 

+<SHIFT 0>        <OA j>        EA             "               " 

+<SHIFT .>        <OA k>        EB             "               " 

+<SHIFT +>        <OA l>        EC             "               " 

+<SHIFT ->        <OA m>        ED             "               " 

+ 

+<SHIFT BOTRIGHT> <OA RIGHT>    EF             "               " 

+ (Dieser Code wird beim RESET des 

+ Terminals ausgeführt. Der Benut- 

+ zer kann damit das Terminal nach 

+ seinen Wünschen konfigurieren.) 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+<F1> ...         <OA A> ...    C1             "               " 

+<F15>            <OA O>        CF             "               " 

+<SHIFT F1> ...   <OA Q> ...    D1             "               " 

+<SHIFT F15>      <OA _>        DF             "               " 

+<CTRL F1> ...    <OA !> ...    A1             "               " 

+<CTRL F15>       <OA />        AF             "               " 

+<SHIFT CTRL F1>..<OA 1> ...    B1             "               " 

+<SHIFT CTRL F15> <OA ?>        BF             "               " 

+ 

+Die Programmierung der Funktionstasten geschieht mit #ib(1)#<ESC> e#ie(1)#. 

+ 

+ 

+#type("8")##center##ib(3)#5.2  Die TVI-Emulation#ie(3)##type("elite")# 

+ 

+Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige

+Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape-

+Sequenzen ändert sich dadurch nicht. 

+Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2.

+Feld) oder durch 

+ 

+                         #ib(1)#<ESC> <SPACE> 1#ie(1)#    (Hex 1B 20 31) 

+ 

+An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey-

+boards. Die entsprechenden Tasten, die beim Applekeyboard zu drücken sind,

+kann man im letzten Abschnitt nachlesen. 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 13 

+#page##--------------------------------- Ende der Seite 13 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Folgende Tasten senden andere Tastencodes: 

+ 

+Taste       TVI-Code(sequenz)       Bemerkung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<RIGHT>     0C    #ib(1)#<CTRL L>#ie(1)#          Cursor nach rechts 

+ 

+<HOME>      1E    #ib(1)#<CTRL SHIFT ^>#ie(1)#    Cursor in Homeposition 

+ 

+<CLEAR>     1A    #ib(1)#<CTRL Z>#ie(1)#          Durch Drücken von <SHIFT HOME> 

+                                    Bildschirm löschen und Cursor Home 

+ 

+<DEL CHAR>  1B 57 #ib(1)#<ESC> W#ie(1)#           Durch Drücken von <SHIFT TOPLEFT> 

+                                    Zeichen löschen 

+ 

+<DEL LINE>  1B 52 #ib(1)#<ESC> R#ie(1)#           Durch Drücken von <SHIFT TOPRIGHT> 

+                                    Zeile löschen 

+ 

+<INS CHAR>  1B 51 #ib(1)#<ESC> Q#ie(1)#           Durch Drücken von <TOPLEFT> 

+                                    Zeichen einfügen 

+ 

+<INS LINE>  1B 45 #ib(1)#<ESC> E#ie(1)#           Durch Drücken von <TOPRIGHT> 

+                                    Zeile einfügen 

+ 

+<LEFT>      08    #ib(1)#<BACKSPACE>#ie(1)#       Cursor nach links 

+ 

+<BACK TAB>  1B 49 #ib(1)#<ESC> I#ie(1)#           Durch Drücken von <SHIFT TAB> 

+                                    Rückwärtstabulator 

+ 

+<DOWN>      0A    #ib(1)#<LF>#ie(1)#              Cursor nach unten 

+ 

+<UP>        0B    #ib(1)#<CTRL K>#ie(1)#          Cursor nach oben 

+ 

+<NEWLINE>   1F    #ib(1)#<CTRL SHIFT _>#ie(1)#    Durch Drücken von <SHIFT RETURN> 

+                                    Waagenrücklauf und Zeilenvorschub 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+Für jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der

+Form <CTRL A> <code> <CR> also 01 <code> 0D gesendet. Für <code> gilt: 

+ 

+Taste             <code>    Hex-Code 

+<F1> ...            @ ...      40 ...   Diese Tasten sind auf fast allen 

+<F11>               J          4A       TVI-Terminals vorhanden. 

+<F12> ...           ` ...      60 ... 

+<F15>               c          63 

+ 

+<SHIFT F1> ...      K ...      4B ... 

+<SHIFT F15>         Y          59 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#14 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 14 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...       d ...      64 ... 

+<SHIFT 9>           l          6C 

+<SHIFT 0>           m          6D 

+<SHIFT .>           n          6E 

+<SHIFT +>           o          6F 

+<SHIFT ->           p          70 

+ 

+<SHIFT BOTRIGHT>    r          72 

+ 

+Alle nicht in dieser Tabelle aufgeführten Funktionstasten senden den Basis-

+tastencode. 

+ 

+#text end#

+#clear pos# 

+#free(16.11019)#

+ 

+ 

+ 15 

+#page##--------------------------------- Ende der Seite 15 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#6.  Der Graphikmodus#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#6.1  Allgemeines#ie(3)##type("elite")# 

+ 

+Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra-

+phik: GFX, Text: TXT) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> $#ie(1)#    (Hex 1B 24) 

+ 

+eingeschaltet und mit dem Kommando 

+ 

+                         #ib(1)#<ESC> %#ie(1)#    (Hex 1B 25) 

+ 

+ausgeschaltet. 

+ 

+Die Auflösung beträgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk-

+te, das sind 53760 Punkte. 

+ 

+ 

+#type("8")##center##ib(3)#6.2  Koordinaten und Parameterübergabe#ie(3)##type("elite")# 

+ 

+Die Koordinaten für die Graphikkommandos dürfen den Bereich von -32768 bis

+32767 überstreichen. Der sichtbare Bereich ist für die X-Koordinate 0..279

+und für die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) )

+des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic-

+hnen nur innerhalb des sichtbaren Bereichs (Clipping). 

+ 

+ 

+#type("8")##center##ib(3)#6.2.1  Cursorposition/Fadenkreuz#ie(3)##type("elite")# 

+ 

+Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam-

+ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn

+sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi-

+tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit 

+ 

+                         #ib(1)#<CTRL X>#ie(1)# oder #ib(1)#<CE>#ie(1)#    (Hex 18) 

+ 

+ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge-

+zeichnet. Das heißt, daß die Punkte an der Stelle des Fadenkreuzes inver-

+tiert (umgedreht) werden. Das hat wiederum zur Folge, daß an der Graphik-

+seite nichts verändert wird, wenn zweimal <CTRL X> gesendet wird. Solange

+der Bereich oder die Position des Fadenkreuzes nicht verändert wird, können

+zwischen den beiden <CTRL X> Kommandos auch andere Graphikkommandos ausge-

+führt werden. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+#right#16 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 16 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.2.2  Binäre oder dezimale Parameter#ie(3)##type("elite")# 

+ 

+Die Übergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten

+und in einigen Fällen auch anderer Parameter, kann auf zwei verschiedene

+Arten erfolgen. Das Terminal erkennt die Übergabeart am ersten Parameterby-

+te: 

+Bei dezimalen Parametern ist dies entweder <SPACE>, +, - oder eine Zahl. Bei

+Binären Parametern liegt das Höherwertige Byte (das erste!) im Bereich von

+00..1F oder 3A..FF. Die Festlegung auf dezimale oder binäre Parameter gilt

+für beide (X und Y) Koordinaten. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.2.1  Binäre Parameter#ie(3)##type("elite")# 

+ 

+Binäre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten

+beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die

+Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer-

+den durch Bilden des Zweierkomplements dargestellt. 

+Zu beachten ist, daß zuerst das höherwertige (Highbyte) und dann das nie-

+derwertige (Lowbyte) gesendet werden muß. 

+ 

+Der Vorteil der binären Parameter ist, daß die Parameterübergabe schneller

+ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver-

+tierung vornehmen müssen und die Anzahl der Parameterbytes in der Regel

+geringer ist als bei dezimaler Parameterübergabe. 

+ 

+Der Nachteil ist, daß bei XON/XOFF Flußkontrolle einige Zahlen als XON oder

+XOFF interpretiert werden können und daß diese Parameter nicht auf Funk-

+tionstasten gelegt werden können, wenn sie Zeichen > Hex 7F enthalten. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.2.2  Dezimale Parameter#ie(3)##type("elite")# 

+ 

+Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden

+Koordinaten werden durch einen Separator (Komma, CR, Semikolon o.ä.) ge-

+trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger

+Stelle in und vor den Zahlen dürfen Leerzeichen (<SPACE>) oder Pluszeichen

+(+) stehen, die keine Änderung des Ergebnisses bewirken. Ein Minuszeichen

+vor einer Zahl negiert sie. 

+ 

+Der Vorteil der dezimalen Parameter ist, daß sie in höheren Programmier-

+sprachen bequem und lesbar in ein Programm geschrieben werden können und daß

+keine Steuerzeichen vorkommen, die die XON/XOFF - Flußkontrolle stören könn-

+ten. Außerdem können diese Parameter immer auf Funktionstasten gelegt wer-

+den, da sie keine Codes > Hex 7F enthalten. 

+ 

+Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima-

+liegen Konvertierung (Host, Terminal) und die in der Regel längeren Parame-

+ter. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 17 

+#page##--------------------------------- Ende der Seite 17 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.2.3  Absolute oder relative Koordinaten#ie(3)##type("elite")# 

+ 

+Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso-

+luten Koordinaten. 

+ 

+Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter

+angegebene Position. Z.B. <ESC> v 200, 100; setzt den Cursor direkt auf die

+Position X=200, Y=100. Die meisten Programme unterstützen nur absolute Koor-

+dinaten. 

+ 

+Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad-

+diert. Das hat den Vorteil, daß eine Routine nicht zu wissen braucht, wo der

+Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen

+Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der

+aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen.

+Z.B. <ESC> q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk-

+te nach oben. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.4  Byteparameter#ie(3)##type("elite")# 

+ 

+Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kön-

+nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fällen,

+in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder-

+wertigsten Bits ausaskiert, die höherwertigen werden ignoriert, wenn nicht

+ausdrücklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert

+und ASCII-Ziffer identisch. Bei Werten großer als 9 geht das allerdings

+nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man

+folgende Tabelle benutzen: 

+ 

+#on("u")#Wert   ASCII (Hex) oder Binär#off("u")# 

+  0      0     30        00 

+  1      1     31        01 

+  2      2     32        02 

+  3      3     33        03 

+  4      4     34        04 

+  5      5     35        05 

+  6      6     36        06 

+  7      7     37        07 

+  8      8     38        08 

+  9      9     39        09 

+ 10      :     3A        0A 

+ 11      ;     3B        0B 

+ 12      <     3C        0C 

+ 13      =     3D        0D 

+ 14      >     3E        0E 

+ 15      ?     3F        0F 

+ 

+Für Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Groß-

+buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und <DEL>). Die Zuord-

+nung entnimmt man der ASCII-Tabelle in Anhang A. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#18 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 18 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3  Die Graphikparameter#ie(3)##type("elite")# 

+ 

+Für die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs-

+weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die

+Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und

+die Bitverknüpfungen (löschen, invertieren...) festlegen. Diese Parameter

+werden mit einem Kommando <ESC> O <n> ... verändert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden all diese Parameter auf Defaultwerte zurückgesetzt. Diese Default-

+werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknüpfung (Punkte

+setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und

+als Arbeitsseite gewählt. Es wird auf ganzseitige Graphik geschaltet (falls

+im Graphikmodus). 

+ 

+ 

+#type("8")##center##ib(3)#6.3.1  Strichdicke#ie(3)##type("elite")# 

+ 

+Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet

+parallel zur ursprünglichen Linie auf beiden Seiten jeweils eine weitere

+Linie der gleichen Länge. Die Strichdicke 3 zeichnet dann auf beiden Seiten

+jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge-

+wählt werden. Sie wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 1#ie(1)# <dicke>   (Hex 1B 4F 31 <dicke>) 

+ 

+eingestellt. <dicke> ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe-

+reich 1 bis 15. 

+ 

+ 

+#type("8")##center##ib(3)#6.3.2  Farbe/Helligkeit#ie(3)##type("elite")# 

+ 

+Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun-

+kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe.

+Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7

+Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro-

+gramm allerdings nicht unterstützt, da sich dann die Auflösung in X-Richtung

+halbiert (also nur noch 140 x 192 Punkte). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 2#ie(1)# <n>    (Hex 1B 4F 32 <n>) 

+ 

+kann die Helligkeit eingestellt werden. <n> ist ein Byteparameter bei dem

+nur das Bit 0 wichtig ist: 

+ 

+Bit 0   Bedeutung 

+  0     dunkel/Violett     <n> ist eine gerade Zahl 

+  1     hell/Gelb          <n> ist eine ungerade Zahl 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 19 

+#page##--------------------------------- Ende der Seite 19 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.3  Linientyp#ie(3)##type("elite")# 

+ 

+Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich-

+muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch

+Pattern genannt) wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 3#ie(1)# <n>    (Hex 1B 4F 33 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die

+Strichtypen sind <n> folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bitmuster (16 Bit)  Name                    #off("u")# 

+ 0                       unsichtbare Linie 

+ 1   ----------------    durchgehende Linie 

+ 2   - - - - - - - -     gepunktete Linie 

+ 3   ----    ----        kurz gestrichelte Linie 

+ 4   --------            lang gestrichelte Linie 

+ 5   --------    -       Strichpunktlinie 

+ 6   -   -   -----       Strich-Punkt-Punkt Linie 

+ 7   - - - -  - - - -    Benutzerdefinierte Linie 

+                         (Hier Defaultangabe) 

+ 

+Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der

+nächste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu-

+sters. Das Muster wiederholt sich bei längeren Linien zyklisch. Wird zwi-

+schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite

+Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste

+Draw-Befehl aufgehört hat. Auch dicke Linien behalten das Linienmuster bei,

+man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie über-

+gehen, wenn man eine gepunktete dicke Linie haben will. 

+ 

+ 

+#type("8")##center##ib(3)#6.3.3.1  Selbstdefinierte Linientypen (Pattern)#ie(3)##type("elite")# 

+ 

+Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert

+werden. Da die Länge 16 Bit ist, kann man mit den relativen Move's und

+Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist

+dabei auch die Bitverknüpfung COPY, die im nächsten Abschnitt erläutert

+wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des

+Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie

+mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1)

+kann der Vorgang für die nächste Zeile fortgesetzt werden. 

+ 

+Das benutzerdefinierbare Pattern wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 6#ie(1)# <l> <h>    (Hex 1B 4F 36 <l> <h>) 

+ 

+festgelegt. <l> ist dabei das niederwertige (Lowbyte) des Bitmusters, <h>

+ist das höherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster

+für Linien (und nicht für Icons) benutzt wird, dann sollte man darauf ach-

+ten, daß das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein

+Move vorangegangen ist, zumindestes einen Punkt sieht. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#20 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 20 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.4  Bitverknüpfungen#ie(3)##type("elite")# 

+ 

+Über Bitverknüpfungen werden die Punkte auf der Graphikseite verändert. Das

+Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das

+aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Veränderung der Graphik-

+seite durchgeführt. 

+Bis auf die COPY-Funktion wirken die Bitverknüpfungen nur auf die Graphik-

+seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. 

+ 

+- Das Zeichnen einer sichtbaren Linie mit weißen Punkten geschieht zum Bei-

+  spiel durch eine OR- (Oder-) Verknüpfung. 

+ 

+- Das Löschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge-

+  schieht mit einer AND- (Und-) Verknüpfung (Genau genommen eine NAND-, d.h.

+  negierte AND-Verknüpfung). 

+ 

+- Das Invertieren (d.h. Weißer Punkt wird schwarz, schwarzer Punkt wird

+  weiß) kann man mit einer XOR- (Exklusiv-Oder-) Verknüpfung erreichen. 

+ 

+- Für Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk-

+  tion, die eigentlich keine einzelne Bitverknüpfung ist. Ist im Linientyp

+  das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknüpfung

+  durchgeführt (d.h. der Punkt wird gelöscht) ist das aktuelle Bit im Li-

+  nientyp 1, dann wird eine OR-Verknüpfung durchgeführt (d.h. der Punkt wird

+  gelöscht). Der Effekt ist, daß genau das Bitmuster des Linientyps in der

+  Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die

+  Linie gezeichnet wurde. 

+ 

+Die Bitverknüpfung kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 4#ie(1)# <n>    (Hex 1B 4F 34 <n>) 

+ 

+festgelegt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+<n> hat folgende Bedeutung: 

+ 

+<n>  Bitverknüpfung         Verwendung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0   OR (Oder)              Weiß (auf schwarzem Grund) zeichnen 

+ 1   AND (Und)              Schwarz (auf weißem Grund) zeichnen 

+ 2   XOR (Exklusiv Oder)    Schwarze und Weiße Punkte umdrehen (invertie-

+ ren) 

+ 3   COPY (kopieren)        Icons zeichnen oder Bilduntergrund überschrei-

+ ben 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 21 

+#page##--------------------------------- Ende der Seite 21 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.5  Multiparametereinstellung#ie(3)##type("elite")# 

+ 

+Die obigen Parameter (bis auf Linientyp) können alle zugleich mit einem

+Kommando gesetzt werden. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> O 5#ie(1)# <n>    (Hex 1B 4F 35 <n>) 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind

+folgendermaßen zugeordnet: 

+ 

+   Bit     Bedeutung        Werte 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0 .. 3  : Strickdicke      1 .. 15 

+ 4 .. 5  : Bitverknüpfung   0 = OR, 16 = AND, 32 = XOR, 48 = COPY 

+      6  : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) 

+ 

+Standardeinstellung ist also '<ESC> O 5 A'. 

+ 

+ 

+#type("8")##center##ib(3)#6.4  Graphikseiten#ie(3)##type("elite")# 

+ 

+Das Terminal verwaltet zwei Graphikseiten mit einer Größe von jeweils 8k

+Byte (d.h. 8192 Bytes). 

+ 

+ 

+#type("8")##center##ib(3)#6.4.1  Die sichtbare Seite und die Arbeitsseite#ie(3)##type("elite")# 

+ 

+Die beiden Graphikseiten können (müssen aber nicht) getrennt voneinander

+angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im

+Hintergrund" aufbereitet werden soll, während die andere (schon aufbereite-

+te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen

+und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec-

+hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck

+eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen,

+kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter-

+grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7

+Sekunden). 

+ 

+Die sichtbare und die Arbeitsseite können mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 7#ie(1)# <n>    (Hex 1B 4F 37 <n>) 

+ 

+gewählt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 7. 

+ 

+Bit 0 von <n> : Sichtbare Seite (0 oder 1) 

+Bit 1 von <n> : Arbeitsseite (0 oder 1) 

+Bit 2 von <n> : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik-

+                zeilen eingeblendet. 0 = Nur Graphikmode. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#22 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 22 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#on("u")#<n>     Sichtbar Arbeitsseite  Inhalt der untersten 32 Graphikzeilen#off("u")# 

+ 0      Seite 0  Seite 0       Graphik (Seite 0) 

+ 1      Seite 1  Seite 0       Graphik (Seite 1) 

+ 2      Seite 0  Seite 1       Graphik (Seite 0) 

+ 3      Seite 1  Seite 1       Graphik (Seite 1) 

+ 4      Seite 0  Seite 0       Text 

+ 5      Seite 1  Seite 0       Müll 

+ 6      Seite 0  Seite 1       Text 

+ 7      Seite 1  Seite 1       Müll 

+ 

+ 

+#type("8")##center##ib(3)#6.4.1.1  80-Zeichen Text und Graphik#ie(3)##type("elite")# 

+ 

+Mit dem in 6.4.1 beschriebenen Kommando können, wie beschrieben, die unter-

+sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un-

+tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt

+und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi-

+schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht

+sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Müll erscheint. Das

+Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert

+wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der

+Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen-

+deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder-

+-Einblenden ansehen. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.2  Aufbau einer Graphikseite#ie(3)##type("elite")# 

+ 

+Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512

+sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus

+einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent-

+spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit

+eines Bytes wird am weitesten links angezeigt. 

+Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei-

+len sind zu Reihen zusammengefaßt. Es gibt also 24 Reihen. Jede erste Gra-

+phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle

+aufgelistet ist: 

+ 

+#on("u")#Reihe  Adresse  Hex  |  Reihe  Adresse  Hex  |  Reihe  Adresse  Hex#off("u")# 

+  0        0    000  |    8      40     028  |   16      80     050 

+  1      128    080  |    9     168     0A8  |   17     208     0D0 

+  2      256    100  |   10     296     128  |   18     336     150 

+  3      384    180  |   11     424     1A8  |   19     464     1D0 

+  4      512    200  |   12     552     228  |   20     592     250 

+  5      640    280  |   13     680     2A8  |   21     720     2D0 

+  6      768    300  |   14     808     328  |   22     848     350 

+  7      896    380  |   15     936     3A8  |   23     976     3D0 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 23 

+#page##--------------------------------- Ende der Seite 23 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen-

+de Tabelle benutzen: 

+ 

+#on("u")#n  Offset (Hex)#off("u")# 

+0      0   0000 

+1   1024   0400 

+2   2048   0800 

+3   3072   0C00 

+4   4096   1000 

+5   5120   1400 

+6   6144   1800 

+7   7168   1C00 

+ 

+Beispiel: 

+  Die Adresse des Punktes (123, 45) soll bestimmt werden. 

+  45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8

+                = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der

+                Y-Offset also 5120. 

+  123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. 

+  Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. 

+  123 MOD 7 = 4  d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.3  Operationen auf den Graphikseiten#ie(3)##type("elite")# 

+ 

+Hier sollen nur die Operationen erläutert werden, die nicht in andere Kate-

+gorien (z.B. Löschen, Linien zeichnen etc.) passen. 

+ 

+Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert,

+kopiert, gemischt und miteinander logisch verknüpft werden können. Verän-

+dert wird bei diesem Kommando nur die Arbeitsseite. 

+ 

+Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> !#ie(1)# <n>    (Hex 1B 21 <n>) 

+ 

+#text end#

+#clear pos# 

+#free(6.796852)#

+ 

+ 

+#right#24 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 24 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<n> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol-

+gende Bedeutung: 

+ 

+<n>   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0    Keine Veränderung. Kopiert die Arbeitsseite in sich selbst (Färbt die

+      Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). 

+ 1    Die Arbeitsseite wird invertiert. 

+ 2    Mischt beide Seiten zusammen (OR Verknüpfung). 

+ 3    Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. 

+ 6    Bildet den Durchschnitt beider Seiten (AND Verknüpfung). 

+ 7    Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis

+10    Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR

+      Verknüpfung). 

+11    Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das

+      Inverse von <n>=10). 

+14    Kopiert die andere Seite in die Arbeitsseite. 

+15    Kopiert das Inverse von der anderen Seite in die Arbeitsseite. 

+ 

+Andere Werte für <n> wiederholen sich in der Tabelle. Die ganze Arbeitssei-

+te hat nach der Operation die gewählte Farbe/Helligkeit. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.4  Laden einer Graphikseite vom Host#ie(3)##type("elite")# 

+ 

+Graphikseiten können ganz oder teilweise vom Host geladen werden. Das kön-

+nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-)

+Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das

+Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> /#ie(1)# <ll> <lh> <al> <ah> <b...> 

+                                                    (Hex 1B 2F ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer-

+den. <lh>, <ll>, <ah>, <al> und <p...> sind Byteparameter (8 Bits). <ll> und

+<lh> bilden zusammen die binäre Länge, d.h. die Anzahl der Datenbytes

+<p...>, die die Graphik enthalten. Die Länge kann von 0 bis Hex 2000 (dezi-

+mal 8192) reichen. Die Adresse, durch <al> und <ah> gebildet, darf von 0 bis

+Hex 1FFF reichen. Zusätzlich gilt, daß die Summe von Länge und Adresse nicht

+größer als Hex 2000 sein darf, da sonst außerhalb der Graphikseite geladen

+würde. In einem dieser Fehlerfälle werden die folgenden Graphikdatenbytes

+ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu

+unvorhersehbaren Reaktionen des Terminals führt. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+ 25 

+#page##--------------------------------- Ende der Seite 25 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.4.5  Graphik auf Diskette speichern/laden#ie(3)##type("elite")# 

+ 

+Um Graphikseiten, zum Besipiel für Präsentationen, unabhängig vom Host auf

+dem Bildschirm darstellen zu können, benutzt man das Kommando 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei-

+chern und zu einem späteren Zeitpunkt wieder in das Terminal zurückladen.

+Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu

+schreiben oder von Diskette zu lesen. <n> ist ein Byteparameter mit dem

+Wertebereich 0 bis 31, wobei die Bits folgendermaßen belegt sind: 

+ 

+Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) 

+Bit 3    : Bei Graphikseiten immer 1 (Bei Textseiten 0) 

+Bit 4    : 0 heißt: die Graphikseite wird von der Diskette gelesen, 

+           1 heißt: die Graphikseite wird auf die Diskette geschrieben. 

+ 

+Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Graphikseite überschrieben. 

+ 

+Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt

+auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. 

+ 

+Beispiele: 

+    <ESC> S <CTRL H> liest die Graphikseite in Fach 0 in die Arbeitsseite. 

+    <ESC> S <CTRL X> schreibt die Arbeitsseite in Fach 0 der Diskette. 

+ 

+Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini-

+ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi-

+ken auf Diskette vorbereiten und sie dann mit verschränkter Arbeits- und

+Sichtbarkeitsseite anzeigen. 

+Z.B.: Seite 1 als Arbeitsseite wählen, Seite 0 als sichtbare Seite. Graphik

+      von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1

+      als sichtbare Seite wählen, Seite 0 jetzt als Arbeitsseite wählen. Die

+      nächste Graphikseite wird von der Diskette in die Seite 1 geladen etc. 

+      Bei dieser Vorgehensweise scheinen Übergänge kontinuierlich zu sein. 

+ 

+Für Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten

+             befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen-

+             folge. 

+ 

+ 

+#type("8")##center##ib(3)#6.5  Textdarstellung im Graphikmodus#ie(3)##type("elite")# 

+ 

+Nicht nur auf der 80-Zeichen Textseite können Buchstaben und Zeichen darge-

+stellt werden, sondern auch auf den Graphikseiten. Die Auflösung ist zwar

+nicht so groß wie auf der reinen Textseite, aber die Anzahl der verschiede-

+nen Darstellungsmöglichkeiten ist sehr viel größer. Fast alle Kommandos, die

+in der Textseite angewandt werden können, haben in der Graphikseite die

+gleiche Funktion. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#26 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 26 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Textdarstellung in der Graphikseite ist hauptsächlich zum Beschriften von

+Graphiken oder zum Drucken von Überschriften etc. vorgesehen. Da aber fast

+alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo-

+dus zur Verfügung stehen, kann man auch im Graphikmodus Textverarbeitung

+oder Editor benutzen. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1  Zeichendarstellung#ie(3)##type("elite")# 

+ 

+Die normale Größe eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen

+sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn

+die Größe mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen

+sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor-

+table Textverarbeitung läßt sich damit natürlich nicht machen, zumal die

+Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden

+gegenüber der der reinen Textseite langsamer ist. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.1  Zeichengröße und Schreibrichtung#ie(3)##type("elite")# 

+ 

+Die Zeichen können in verschiedenen Größen und unter verschiedenen Winkeln

+auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von

+rechts nach links mit auf dem Kopf stehenden Zeichen möglich. 

+Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet

+sich die linke untere Ecke eines Zeichens an der Position des Graphikcur-

+sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter

+der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren

+(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, können sie

+schnell beliebig gedreht und vergrössert (und verkleinert) werden. Der Dreh-

+winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben.

+Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im

+Anhang A angegeben. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> N#ie(1)# <b> <h> <w>    (Hex 1B 4E <b><h><w>) 

+ 

+stellt Breite, Höhe und Drehwinkel der Zeichen ein. Alle Parameter sind

+Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00

+kann der Defaultwert (Standardwert) für den jeweiligen Parameter eingestellt

+werden. 

+<b> bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. 

+<h> bezeichnet die Zeichenhöhe in Punkten. Standardwert ist 10. 

+<w> bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 27 

+#page##--------------------------------- Ende der Seite 27 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Einige ausgezeichnet Werte für <w> sind: 

+<w>    Richtung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0     Waagerecht von links nach rechts (Ost) 

+ 9     Schräg nach unten rechts         (Süd-Ost) 

+18     Senkrecht von oben nach unten    (Süd) 

+27     Schräg nach unten links          (Süd-West) 

+36     Waagerecht (auf dem Kopf stehend) von rechts nach links (West) 

+45     Schräg nach oben links           (Nord-West) 

+54     Senkrecht von unten nach oben    (Nord) 

+63     Schräg von nach oben rechts (Aufwärts) (Nord-Ost) 

+72...  Wie 0 ... 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.2  Dicke, Farbe etc.#ie(3)##type("elite")# 

+ 

+Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter,

+die für Striche eingestellt werden, wirken dann auch auf die Zeichen. Mög-

+liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknüpfung. Mit

+dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden alle diese Parameter auf Standardwerte zurückgesetzt. Die Standard-

+werte sind in Kapitel 6.3 erläutert. Die Beschreibung des Kommandos zur

+Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel-

+len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in

+Kapitel 6.3.3 und das Einstellen der Bitverknüpfung ist in Kapitel 6.3.4

+beschrieben. Auch für die Zeichendarstellung können mehrere dieser Parame-

+ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom-

+mando ist in Kapitel 6.3.5 beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.3  Zeichensätze und Attribute#ie(3)##type("elite")# 

+ 

+Ähnlich wie bei der 80-Zeichen Textdarstellung können Zeichensatz und Text-

+attribute eingestellt werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+kann einer der beiden Zeichensätze USA oder GER (ASCII und Deutsch) gewählt

+werden. Ein griechischer Zeichensatz ist unabhängig von beiden immer vor-

+handen. 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus

+sind aber nur die beiden folgende Werte sinnvoll: 

+ 

+#on("u")#<n>  Zeichensatz  Abweichende Zeichen#off("u")# 

+ 2   Deutsch      Ä Ö Ü ä ö ü ß 

+ 4   Ascii        [ \ ] { | } ~ 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#28 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 28 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Außerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein-

+gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch-

+staben außerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen-

+satz ist im Anhang abgebildet. 

+ 

+Wie im Textmodus können Attribute mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt werden. <n> ist ein Byteparameter mit dem Wertebereich 0, 1, 4

+und 5. Die Werte von <n> sind folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bedeutung                                       #off("u")#

+ 0   Normaler Text (sichtbar und aufrecht) 

+ 1   Unsichtbarer Text (Nur der Cursor wird bewegt) 

+ 4   Kursivschrift, die Zeichen werden schräggestellt 

+ 5   Wie 1 (unsichtbarer Text) 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#   (Hex 1B 29) 

+ 

+hat wie im Textmodus die gleiche Bedeutung wie <ESC> G 4. Damit wird im

+Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#   (hex 1B 28) 

+ 

+wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge-

+hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor-

+gehoben. 

+Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur-

+sives Zeichen, dann wird das rechte Zeichen möglicherweise etwas überschrie-

+ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver-

+mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen

+ausgegeben wird. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.4  Zeichen überschreiben#ie(3)##type("elite")# 

+ 

+Im 80-Zeichen Textmodus kann man Zeichen einfach übereinandertippen, das

+zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit

+in eine Zeichnung geschrieben werden können, ohne daß Teile von Linien even-

+tuell gelöscht werden. Dieser Modus bringt außerdem eine etwas größere

+Schreibgeschwindigkeit mit sich. Es ist aber auch möglich, daß die Fläche,

+in die das Zeichen geschrieben werden soll, vorher gelöscht wird, um ein

+sauberes Schriftbild zu erzielen. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> &#ie(1)#   (Hex 1B 26) 

+ 

+kann man das vorherige Löschen einschalten, mit dem Kommando 

+ 

+                         #ib(1)#<ESC> '#ie(1)#   (Hex 1B 27) 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 29 

+#page##--------------------------------- Ende der Seite 29 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+wird der Modus des Überschreibens ausgeschaltet. 

+ 

+Bei Kursivzeichen wird eine rautenförmige Fläche gelöscht oder gefüllt (wenn

+Bitverknüpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re-

+chteckige Fläche, der mit #ib(1)#<ESC> N#ie(1)# eingestellten Breite und Höhe, gelöscht

+oder gefüllt. Zu beachten ist, daß das Löschen/Füllen nur bei waagerechter

+Schreibrichtung von links nach rechts funktioniert. 

+ 

+Da die Größe der Zeichen in weiten Grenzen mit <ESC> N eingestellt werden

+kann, ist es auch möglich mit dem durch <ESC> & eingeschalteten Ersetzungs-

+modus schnell rechteckige Flächen zu füllen oder zu löschen, wenn nicht auf

+das später beschriebene Füllkommando für beliebige Flächen zurückgegriffen

+werden soll. Dazu schaltet man mit dem Kommando <ESC> O 4 1 die Bitverknü-

+pfung AND (für Füllen) ein und gibt dann einfach ein Leerzeichen aus, das

+dann invertiert dargestellt wird. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.2  Textkommandos im Graphikmodus#ie(3)##type("elite")# 

+ 

+Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo-

+dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition

+senden, haben im Graphikmodus andere Funktionen und haben deshalb andere

+Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind:

+<ESC> I (Backtab), <ESC> j (Reverse Linefeed), <ESC> E (Insert Line), <ESC>

+Q (Insert Character), <ESC> R (Delete Line), <ESC> W (Delete Character). 

+ 

+ 

+#type("8")##center##ib(3)#6.5.2.1  Die Cursorpositionierung#ie(3)##type("elite")# 

+ 

+Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra-

+phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel

+180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem

+Kopf schreiben), dann muß man, um einen Backspace (d.h. ein Zeichen zurück)

+auszuführen, nicht <RIGHT> sondern wie bei normaler Schreibrichtung üblich,

+<LEFT> drücken. Die vier Cursorsteuertasten funktionieren für beliebige

+Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage-

+rechte Schreibrichtung von links nach rechts. 

+ 

+Alle Steuertasten berücksichtigen die Zeichengröße (Breite und Höhe). Auch

+die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen

+gescrollt, wie ein Zeichen hoch ist. 

+ 

+#text end#

+#clear pos# 

+#free(4.256852)#

+ 

+ 

+#right#30 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 30 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Folgende Steuerkommandos/Tasten wirken im Graphikmodus: 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#ib(1)#<TAB>#ie(1)#            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten (wie im Textmodus). Liegt die

+                                       nächste Tabulatorposition außerhalb

+                                       des sichtbaren Bereichs, dann steht

+                                       der Cursor jetzt da. 

+ 

+#ib(1)#<SHIFT CE>#ie(1)#       <OA CTRL X>    -      Kommandozeile aktivieren. 

+                                       Einzelheiten zur Kommandozeile siehe

+                                       Abschnitt 3.: Die Kommandozeilen. 

+ 

+#ib(1)#<CE>#ie(1)#             <CTRL X>      18      u.a. Kommandozeile verlassen. 

+ 

+#ib(1)#<RETURN>#ie(1)#         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub. 

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+#ib(1)#<SHIFT RETURN>#ie(1)#   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten sichtbaren

+                                       Bildschirmzeile war, wird der Bild-

+                                       schirminhalt entweder nach oben ge-

+                                       scrollt (SCROLL) oder in Homeposition

+                                       gebracht (PAGE). 

+ 

+#ib(1)#<UP>#ie(1)#             <UP>       8B/0B      Cursor eine Zeile höher (bzw. über

+                                       die Zeile). War der Cursor in der

+                                       ersten sichtbaren Bildschirmzeile,

+                                       dann steht er jetzt im unsichtbaren

+                                       Bereich. 

+ 

+#ib(1)#<DOWN>#ie(1)#           <DOWN>     8A/0A      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten sichtbaren Zeile, dann

+                                       wird der Inhalt des Graphikbild-

+                                       schirms nach oben gescrollt, d.h. die

+                                       obersten Zeilen werden gelöscht (im

+                                       SCROLL-Modus) oder der Cursor in die

+                                       erste Zeile gesetzt (im PAGE-Modus). 

+ 

+#ib(1)#<CTRL V>#ie(1)#         <CTRL V>      16      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten Zeile, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 31 

+#page##--------------------------------- Ende der Seite 31 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#ib(1)#<LEFT>#ie(1)#           <LEFT>     88/08      Cursor eine Spalte nach links (bzw.

+                                       entegegen der Schreibrichtung). War

+                                       der Cursor in der ersten sichtbaren

+                                       Bildschirmspalte, dann ist er jetzt

+                                       unsichtbar "links" davon. 

+ 

+#ib(1)#<RIGHT>#ie(1)#             -          95      Cursor eine Spalte nach rechts (bzw.

+                                       in Schreibrichtung). War der Cursor

+                                       in der letzten sichtbaren Spalte,

+                                       dann befindet er sich jetzt außer-

+                                       halb des Bildschirms. Im Gegensatz

+                                       zum Textmodus wird kein Linefeed oder

+                                       Scroll ausgeführt. 

+ 

+#ib(1)#<HOME>#ie(1)#           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+#ib(1)#<SHIFT HOME>#ie(1)#     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+#ib(1)#<DELETE>#ie(1)#         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm nicht dargestellt. Der Host

+                                       interpretiert es in der Regel als

+                                       Zeichenlöschbefehl. 

+ 

+#ib(1)#<BOTTOMLEFT>#ie(1)#     <BACKSPACE>   08      Cursor eine Spalte nach links (bzw.

+                                       entgegen der Schreibrichtung). Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+#ib(1)#<BOTTOMRIGHT>#ie(1)#    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts (bzw. in Schreibrichtung). Die

+                                       Funktion ist mit der von <RIGHT>

+                                       identisch. 

+ 

+#ib(1)#<ESC>#ie(1)#            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+#ib(1)#<SHIFT CTRL HOME>#ie(1)#<OA 0>         -      Local/Online umschalten 

+ 

+#ib(1)#<CTRL HOME>#ie(1)#      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge-

+sehen werden können. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#32 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 32 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.5.2.2  Löschbefehle#ie(3)##type("elite")# 

+ 

+Das Kommando (Clear to End Of Line) 

+ 

+                         #ib(1)#<ESC> T#ie(1)#    (Hex 1B 54) 

+ 

+löscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Höhe des

+gelöschten Balkens entspricht der Buchstabenhöhe. Der Balken wird unabhän-

+gig von der Bitverknüpfung immer gelöscht. Der Balken wird unabhängig von

+der Schreibrichtung immer waagerecht gelöscht. 

+ 

+Das Kommando (Clear to End Of Page) 

+ 

+                         #ib(1)#<ESC> Y#ie(1)#    (Hex 1B 59) 

+ 

+löscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum

+Bildschirmende. Auch dieses Kommando löscht unabhängig von der gewählten

+Bitverknüpfung und Schreibrichtung immer waagerecht. 

+ 

+Die Kommandos 

+ 

+                         #ib(1)#<ESC> *#ie(1)#    (Hex 1B 2A) 

+                         #ib(1)#<ESC> ,#ie(1)#    (Hex 1B 2C) 

+                         #ib(1)#<ESC> +#ie(1)#    (Hex 1B 2B) 

+                         #ib(1)#<ESC> :#ie(1)#    (Hex 1B 3A) 

+                         #ib(1)#<CTRL Z>#ie(1)#   (Hex 1A) 

+ 

+löschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h.

+eine Buchstabenhöhe unter dem oberen Bildschirmrand. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> y#ie(1)#    (Hex 1B 79) 

+ 

+löscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke,

+d.h. den Ursprung des Koordinatensystems. 

+ 

+ 

+#type("8")##center##ib(3)#6.6  Die Graphikkommandos#ie(3)##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1  Draw's und Move's#ie(3)##type("elite")# 

+ 

+Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den

+Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und

+zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel-

+le Cursorposition. Die Endposition kann relativ, absolut oder mit einem

+relativen Winkel angegeben werden. Der Befehl zum Setzen/Löschen eines Punk-

+tes wurde mit in diese Befehlskategorie aufgenommen. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 33 

+#page##--------------------------------- Ende der Seite 33 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.1.1  Punkt setzen#ie(3)##type("elite")# 

+ 

+Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h.

+die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik-

+cursors wird durch diesen Befehl nicht verändert. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> m#ie(1)# <x, y;>    (Hex 1B 6D <x, y;>) 

+ 

+setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren

+Bereichs liegt. <x, y;> sind dezimale oder binäre Koordinaten. Das Aussehen

+des Punktes kann durch Farbe/Helligkeit oder Bitverknüpfung festgelegt wer-

+den. Mit einer AND-Bitverknüpfung wird der angegebene Punkt gelöscht, mit

+einer OR oder COPY Bitverknüpfung wird der angegebene Punkt gesetzt, mit

+einer XOR Bitverknüpfung wird sein Zustand umgedreht (invertiert). 

+Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen)

+Draw-Befehl <ESC> r 0, 0; benutzen, der an die Position des Graphikcursors,

+einen Punkt der eingestellten Dicke zeichnet. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1.2  Move-Befehle#ie(3)##type("elite")# 

+ 

+Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso-

+luten. Das Kommando für einen absoluten Move lautet 

+ 

+                         #ib(1)#<ESC> v#ie(1)# <x, y;>    (Hex 1B 76 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die neue Position

+des Graphikcursors bezeichnen. Diese Position muß nicht im sichtbaren Be-

+reich liegen, sondern kann auch außerhalb des Fensters liegen. Der Wertebe-

+reich von <x> und <y> ist -32768 bis 32767. 

+ 

+Das Kommando für den relativen Move-Befehl lautet 

+ 

+                         #ib(1)#<ESC> q#ie(1)# <x, y;>    (Hex 1B 71 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert. Auch hier darf die neue Position des Graphik-

+cursors außerhalb des sichtbaren Bereichs liegen. 

+ 

+Die Move-Befehle setzen außerdem das Bitmuster für den Linientyp wieder auf

+den Startwert zurück, damit der nächste Draw-Befehl auch mit einem Punkt

+beginnt. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+#right#34 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 34 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.1.3  Draw-Befehle#ie(3)##type("elite")# 

+ 

+Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen,

+einer relativen und einer absoluten. Das Kommando für einen absoluten Draw

+lautet 

+ 

+                         #ib(1)#<ESC> w#ie(1)# <x, y;>    (Hex 1B 77 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die Endposition der

+Linie bezeichnen. Diese Position muß nicht im sichtbaren Bereich liegen,

+sondern kann auch außerhalb des Fensters liegen. Der unsichtbare Teil der

+Linie wird dann "geclippt". Der Wertebereich von <x> und <y> ist -32768 bis

+32767. 

+ 

+Das Kommando für den relativen Draw-Befehl lautet 

+ 

+                         #ib(1)#<ESC> r#ie(1)# <x, y;>    (Hex 1B 72 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch

+hier darf die Endposition der Linie außerhalb des sichtbaren Bereichs lie-

+gen. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1.4  Turtle-Graphik#ie(3)##type("elite")# 

+ 

+Turtle-Graphik (Schildkröten-Graphik, obwohl hier keine Schildkröte sicht-

+bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Längen und

+Winkelangaben, statt mit x/y-Koordinaten, arbeiten benötigt. Man stellt sich

+dazu eine Schildkröte vor, die auf ihrem Weg über den Bildschirm eine sicht-

+bare Spur zurücklassen kann (aber nicht muß). Die Schildkröte kann einen Weg

+bestimmter Länge in ihre Blickrichtung gehen und bleibt dann stehen. Außer-

+dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung

+ändert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung

+der Schildkröte verändern kann und dann einen Weg bestimmter Länge in dieser

+Richtung zurücklegt. Außerdem wird noch ein Befehl benötigt, der das "Spur-

+verhalten" der Schildkröte ändert, also von "Spur sichtbar" auf "Spur un-

+sichtbar" umschaltet und umgekehrt. Natürlich ist die Zeichengeschwindigkeit

+nicht mit der Fortbewegungsgeschwindigkeit von Schildkröten zu vergleichen.

+Das erste Kommando lautet 

+ 

+                         #ib(1)#<ESC> n#ie(1)# <l, w;>    (Hex 1B 6E <l, w;>) 

+ 

+<l> und <w> sind dezimale oder binäre Parameter. <l> ist die Länge der Spur

+mit einem Wertebereich von 0 bis 511. <w> ist der relative Drehwinkel der

+Schildkröte, also die Änderung von der ursprünglichen Blickrichtung aus. <w>

+überstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0

+bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 35 

+#page##--------------------------------- Ende der Seite 35 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> o#ie(1)#    (Hex 1B 6F) 

+ 

+kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. 

+ 

+Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu

+setzen, kann man das Kommando 

+ 

+                         #ib(1)#<ESC> O 8#ie(1)# <n>    (Hex 1B 4F 38 <n>) 

+ 

+benutzen. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+ 

+#on("u")#Bit 0 hat folgende Bedeutung:                                    #off("u")# 

+  0       Pendown. Die Schildkröte hinterläßt eine sichtbare Spur 

+  1       Penup. Die Schildkröte hinterläßt keine Spur 

+ 

+#on("u")#Bit 1 hat folgende Bedeutung:                                    #off("u")# 

+  0       Drawer. Es wird eine weiße Linie gezeichnet. 

+  1       Eraser. Es wird eine schwarze Linie gezeichnet (gelöscht) 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 9#ie(1)#    (Hex 1B 4F 39) 

+ 

+wird die Turtle-Graphik initialisiert. Dieses Kommando muß nicht aufgerufen

+werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Möglichkeit

+am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt

+die Schildkröte in die Mitte des Bildschirms (140, 96) mit Blickrichtung

+nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie

+wird voreingestellt (Pendown). 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2  Komplexere Zeichenkommandos#ie(3)##type("elite")# 

+ 

+Außer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur-

+sors gibt es noch verschiedene andere Zeichenkommandos. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.1  Kreise und Kreissegmente#ie(3)##type("elite")# 

+ 

+Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition.

+Der Radius eines Kreises ist in weiten Grenzen von 0 bis über 30000 Punkten

+wählbar. Clipping wird ausserhalb des Bildschirmrandes durchgeführt. Ein

+Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel-

+ne gezeichnet werden können. Damit ist es dann auch möglich, Halb- oder

+Viertelkreise zu Zeichnen. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#36 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 36 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> K#ie(1)# <r, s;>   (Hex 1B 4B <r, s;>) 

+ 

+wird ein Kreis mit dem Radius <r> um die aktuelle Cursorposition gezeichnet

+(relative Kreise). <s> legt fest, welche Segmente gezeichnet werden sollen.

+<r, s;> sind dezimale oder binäre Parameter. <s> hat den Wertebereich von 0

+bis 255. 

+Jedes Bit in <s> ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1),

+dann wird das zugehörige Segment gezeichnet. Der Wert 0 entspricht dem Wert

+255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine

+Abfrage der einzelnen Bits durchgeführt wird. 

+ 

+Die Segmente sind folgendermaßen numeriert: 

+ 

+                                  7  0 

+                                6      1 

+                                5      2 

+                                  4  3 

+ 

+Beispiele für <n> : 

+ 

+#on("u")#<n>  Bedeutung                               #off("u")#

+  0  Zeichnet einen ganzen Kreis 

+ 15  Zeichnet einen links offenen Halbkreis 

+240  Zeichnet einen rechts offenen Halbkreis 

+195  Zeichnet einen unten offenen Halbkreis 

+ 60  Zeichnet einen oben offenen Halbkreis 

+  3  Zeichnet ein Kreisviertel rechts oben 

+ 12  Zeichnet ein Kreisviertel rechts unten 

+ 48  Zeichnet ein Kreisviertel links unten 

+192  Zeichnet ein Kreisviertel links oben 

+etc. 

+ 

+Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die

+Bitverknüpfung verändert werden. Der Linientyp (Punkt-, Strichlinie) und die

+Strickdicke haben keinen Einfluß, d.h. der Kreis wird immer mit durchgehen-

+der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch

+verändert werden, sollte man den Befehl <ESC> s für Ellipsenbögen verwenden. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.2  Rechtecke#ie(3)##type("elite")# 

+ 

+Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle

+Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks

+liegen parallel zur X- und Y-Achse, gedrehte Rechtecke können aber aus 4

+relativen Draw-Befehlen zusammengesetzt werden. 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 37 

+#page##--------------------------------- Ende der Seite 37 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> J#ie(1)# <b, h;>    (Hex 1B 4A <b, h;>) 

+ 

+zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. <b,

+h;> sind dezimale oder binäre Parameter. <b> ist die Breite des Rechtecks

+und kann den ganzen Wertebereich von -32768 bis 32767 überstreichen, <h> ist

+die Höhe des Rechtecks und kann ebenfalls diesen Wertebereich überstreichen.

+Je nach Vorzeichen von <b> und <h> wird das Rechteck links/ rechts und

+oben/unten von der aktuelle Cursorposition gezeichnet. 

+ 

+<b> <h>  Cursorposition bildet die Ecke 

+ +   +   unten links 

+ +   -   oben links 

+ -   +   unten rechts 

+ -   -   oben rechts 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.3  Bögen und Ellipsen#ie(3)##type("elite")# 

+ 

+Um die Zeichengeschwindigkeit eines Kreises zu vergrößern, wurde ein sepa-

+rater Befehl für Kreise eingeführt (6.6.2.1). Da der Kreis ein Sonderfall

+der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch

+benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen-

+ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> s#ie(1)# <xr, yr,> <aw, ew;>    (Hex 1B 73 ...) 

+ 

+zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen

+mit Radius <xr> in X-Richtung und Radius <yr> in Y-Richtung, ausgehend vom

+Anfangswinkel <aw> im Uhrzeigersinn, bis zum Endwinkel <ew>. Der Winkel 0

+Grad ist dabei oben (Norden). 

+ 

+Alle Parameter sind dezimale oder binäre Parameter. <aw> und <ew> haben den

+Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von

+0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad

+Schritten und können Anhang A entnommen werden.. <xr> und <yr> dürfen den

+vollen Wertebereich von -32768 bis 32767 überstreichen. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(4.256852)#

+ 

+ 

+#right#38 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 38 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.2.4  Gefüllte Flächen#ie(3)##type("elite")# 

+ 

+Rechteckige oder rautenförmige Flächen können, wie in Abschnitt 6.5.1.4

+beschrieben, schnell gefüllt werden. Für beliebig geformte Flächen kann das

+Kommando 

+ 

+                         #ib(1)#<ESC> |#ie(1)#<n>    (Hex 1B 7C <n>) 

+ 

+benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor-

+position herum gefüllt wird. <n> ist ein Byteparameter mit dem Wertebereich

+0 bis 15, der die Nummer des Musters für die Füllung angibt. Der Fill-Befehl

+arbeitet auf der aktuellen Arbeitsseite und füllt eine sichtbar begrenzte

+Fläche mit einem angegebenen Muster aus. 

+ 

+Ist die Bitverknüpfung OR eingestellt darf der Cursor nicht auf einem weißen

+Punkt stehen und die Fläche muß von einer durchgehenden weißen Linie be-

+grenzt sein. 

+Ist die Bitverknüpfung AND eingestellt, darf der Cursor nicht auf einem

+schwarzen Punkt stehen und die Fläche muß von einer durchgehenden schwarzen

+Linie begrenzt sein. 

+ 

+Außer den Parametern Bitverknüpfung und Helligkeit/Farbe werden keine be-

+rücksichtigt. 

+ 

+Bei sehr komplex geformten Figuren kann der Fall eintreten, daß die Fläche

+nicht ganz gefüllt ist. Dies liegt daran, daß intern ein zu größer Spei-

+cherplatz zum Merken von Rücksprungcursorpositionen benötigt wird (Stack-

+Überlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht

+gefüllte Fläche setzen und das Kommando erneut geben. 

+ 

+<n> kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): 

+<n>  Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0   Fläche ganz gefüllt 

+ 1   Fläche halb gefüllt (grau) 

+ 2   Jede 4. Zeile wird durchgezogen 

+ 3   Jede 2. Zeile wird durchgezogen 

+ 4   Jede 4. Spalte wird durchgezogen 

+ 5   Jede 2. Spalte wird durchgezogen 

+ 6   Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) 

+ 7   Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) 

+ 8   Schraffur von links unten nach rechts oben 

+ 9   Schraffur von links oben nach rechts unten 

+ A   Schräges Raster (Links- und Rechtsschraffur) 

+ B   Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) 

+ C   Mauerwerk 

+ D   Feines Netzgeflecht 

+ E   Feine Zickzacklinie 

+ F   Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 39 

+#page##--------------------------------- Ende der Seite 39 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Ist die AND-Bitverknüpfung eingeschaltet, dann sind die Punkte schwarz und

+weiß in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich-

+nungen 'gefüllt' und 'gelöscht' auszutauschen. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.4.1  Definition des Musters#ie(3)##type("elite")# 

+ 

+Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> O :#ie(1)# <b1..b8>   (Hex 1B 4F 3A <b1..b8>) 

+ 

+eingestellt werden. Das Defaultmuster wird dabei überschrieben, das neu

+eingestellte Muster allerdings nicht beim Setup mitgesichert. 

+<b1..b1> sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das

+erste Byte wird im Füllmuster in Richtung der niedrigeren y-Positionen dar-

+gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren

+x-Positionen. 

+ 

+ 

+#type("8")##center##ib(3)#6.7  Graphikdaten zum Host#ie(3)##type("elite")# 

+ 

+Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen-

+den kann. Damit der Host über den Status des Terminals informiert werden

+kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host

+kann auch ganze Graphikseiten anfordern, so daß die auf dem Terminal er-

+zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host

+gespeichert werden können. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.1  Graphikseiten zum Host#ie(3)##type("elite")# 

+ 

+Graphikseiten können ganz oder teilweise übertragen werden. Da ein angefor-

+dertes Datenpaket immer ganz übertragen wird, sollte der Host, wenn keine

+Flußkontrolle eingeschaltet ist, nur so große Blöcke anfordern, die er puf-

+fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch

+verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal)

+verändern zu lassen. Mit dem Kommando <ESC> / ... kann der modifizierte Teil

+dann wieder an das Terminal zurückgesendet werden. Zum Aufbau der Graphik-

+seite findet man in Kapitel 6.4.2 Informationen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> \#ie(1)# <ll> <lh> <al> <ah>   (Hex 1B 5C ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden.

+<lh>, <ll>, <ah> und <al> sind Byteparameter (8 Bits). <ll> und <lh> bilden

+zusammen die binäre Länge, d.h. die Anzahl der Datenbytes, die zum Host

+gesendet werden. Die Länge kann von 0 bis Hex 2000 (dezimal 8192) reichen.

+Die Adresse durch <al> und <ah> gebildet, darf von 0 bis Hex 1FFF reichen.

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#40 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 40 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin#

+Zusätzlich gilt, daß die Summe von Länge und Adresse nicht größer als Hex

+2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite

+befindet. In diesem Fehlerfall werden keine Daten gesendet. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.2  Cursorposition zum Host#ie(3)##type("elite")# 

+ 

+Da die Graphikcursorposition einen anderen Wertebereich überstreicht als die

+Position des Textcursors, wurde zum Senden der Graphikcursorposition ein

+weiteres Kommando eingeführt. Pro Koordinate werden dabei 2 Bytes, zusammen

+also 4 Bytes, gesendet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ;#ie(1)#    (Hex 1B 3B) 

+ 

+kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist <xlow>

+<xhigh> <ylow> <yhigh>. Im Gegensatz zu <ESC> ? (für die Textcursorposi-

+tion) wird auch kein abschließendes <CR> gesendet. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.3  Einzelne Bits zum Host#ie(3)##type("elite")# 

+ 

+Außer ganzen Graphikseiten oder Blöcken daraus, kann der Host auch einzelne

+Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur

+Verfügung. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> _#ie(1)#    (Hex 1B 5F) 

+ 

+kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be-

+findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7)

+ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor

+außerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> -#ie(1)#    (Hex 1B 2D) 

+ 

+kann das Bit, daß durch die Graphikcursorposition addressiert wird, abge-

+fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende

+Bedeutung haben: 

+ 

+#on("u")#Bit 0 Dezimal   Bedeutung                            #off("u")# 

+  0      0      Das adressierte Bit ist nicht gesetzt 

+  1      1      Das adressierte Bit ist gesetzt 

+ 

+#on("u")#Bit 1 Dezimal   Bedeutung                   #off("u")# 

+  0      0      Die Farbe ist violett/dunkel 

+  1      2      Die Farbe ist gelb/hell 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 41 

+#page##--------------------------------- Ende der Seite 41 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Bit 2 Dezimal   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0      Der Graphikcursor ist innerhalb des sichtabren Bereichs 

+  1      4      Der Graphikcursor ist außerhalb des sichtbaren Bereichs. 

+                Bit 0 und Bit 1 sind dann 0. 

+ 

+Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4"

+geliefert. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.4  Parameter zum Host#ie(3)##type("elite")# 

+ 

+Die eingestellten Draw-Parameter können auch abgefragt werden. Dazu exi-

+stieren zwei Kommandos. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 4#ie(1)#    (Hex 1B 34) 

+ 

+können die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format

+wie zum Einstellen der Seiten mit dem Kommando #ib(1)#<ESC> O 7#ie(1)# <n>, angefordert

+werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2

+sind folgendermaßen zugeordnet: 

+ 

+#on("u")#Bit 0  Bedeutung                #off("u")# 

+  0    Sichtbar ist Seite 0 

+  1    Sichtbar ist Seite 1 

+ 

+#on("u")#Bit 1  Bedeutung               #off("u")# 

+  0    Arbeitsseite ist Seite 0 

+  1    Arbeitsseite ist Seite 1 

+ 

+#on("u")#Bit 2  Bedeutung               #off("u")# 

+  0    Nur Graphik eingeschaltet 

+  1    In den letzten 32 Graphikzeilen 

+       sind 4 Textzeilen eingeblendet 

+ 

+#on("u")#Bit 3  Bedeutung                         #off("u")# 

+  0    Der Graphikmodus ist eingeschaltet 

+  1    Der Textmodus ist eingeschaltet 

+ 

+Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 5#ie(1)#    (Hex 1B 35) 

+ 

+können die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer-

+tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaßen

+zugeordnet: 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#42 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 42 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Bit        Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Bit 0..3 : Strichdicke 

+Bit 4..5 : Bitverknüpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) 

+Bit 6    : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) 

+ 

+Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)#<ESC> O 5#ie(1)# <n>. 

+ 

+ 

+#type("8")##center##ib(3)#6.8  Graphikhardcopy#ie(3)##type("elite")# 

+ 

+Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer-

+tigt werden. Dabei können keine verschiedene Helligkeitsstufen oder Farben

+dargestellt werden. 

+ 

+ 

+#type("8")##center##ib(3)#6.8.1  Der Druckertreiber#ie(3)##type("elite")# 

+ 

+Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch

+gleiche Kommandos erreicht werden kann, muß das Terminal an den vorhandenen

+Drucker angepaßt werden. Defaultmäßig werden die Epson-Modelle ab RX80 auf-

+wärts, sowie kompatible (IBM, Panasonic etc.) unterstützt. Die Anpassung

+wird in diesem Abschnitt beschrieben. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ~#ie(1)# <n> <p...>    (Hex 1B 7E <n> <p...>) 

+ 

+können Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: 

+ 

+<n> Default (Hex)   Aufgabe 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0  0D              Einleiten der gesamten Hardcopy (Waagenrücklauf) 

+ 1  1B 2A 04 18 01  Einschalten des Graphikmodus. Es folgen 280 Graphikby-

+                    tes (jeweils 8 Bit) 

+ 2  0D 1B 4A 17     Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi-

+                    schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrück-

+                    lauf. 

+ 3     Nichts       Dieses Kommando wird nach der kompletten Hardcopy zum

+                    Drucker gesendet. 

+ 

+Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander

+gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile

+gegeben. 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. <p...> ist

+eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Längenby-

+te, das die Länge der Kommandosequenz (oder die Anzahl der noch folgenden

+Bytes) angibt. Für die nach dem Längenbyte folgenden Bytes sind alle Werte

+von 0 bis 255 erlaubt. 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 43 

+#page##--------------------------------- Ende der Seite 43 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom-

+mandozeile auch mit abgespeichert, so daß sie nur einmal (wenn überhaupt)

+und dann nie wieder eingestellt werden müßen. 

+ 

+ 

+#type("8")##center##ib(3)#6.8.2  Die Hardcopyparameter#ie(3)##type("elite")# 

+ 

+Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik

+beim Ausdruck noch verändert werden. Das Kommando 

+ 

+                         #ib(1)#<ESC> ^#ie(1)# <n>    (Hex 1B 5E <n>) 

+ 

+druckt eine Hardcopy mit dem Parameter <n>. <n> ist ein Byteparameter mit

+dem Wertebereich von 0 bis 15. Jedes Bit in <n> legt eine Darstellungsweise

+fest. Die Bits haben folgende Bedeutung: 

+ 

+Invertieren: 

+Bit 0 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz

+              gedruckt, dunkle Punkte bleiben beim Ausdruck weiß. 

+  1      1    Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund

+              bleibt auf dem Drucker dunkel (schwarz). 

+ 

+Doppelte Breite: 

+Bit 1 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es

+              werden also 280 Punkte nebeneinander gedruckt. 

+  1      2    Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In

+              diesem Fall werden auf dem Drucker 560 Punkte nebeneinander

+              gedruckt. 

+ 

+Doppelte Höhe: 

+Bit 2 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Höhe gedruckt. Es wer-

+              den also 192 Punkte untereinander gedruckt. 

+  1      4    Jeder Bildschirmpunkt wird in doppelter Höhe gedruckt. In

+              diesem Fall werden also 384 Punkte untereinander gedruckt. 

+ 

+Zwei Seiten nebeneinander drucken: 

+Bit 3 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Es wird nur eine Graphikseite (linksbündig) gedruckt. 

+  1      8    Die aktuelle (mit #ib(1)#<ESC> O 7#ie(1)# <n> eingestellte) Graphikseite

+              wird linksbündig und die andere Graphikseite nahtlos rechts

+              daneben gedruckt. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#44 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 44 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Zur Kombination von Möglichkeiten (mehrere Bits sind gesetzt): 

+ 

+- Eine Graphik mit doppelter Höhe und doppelter Breite hat ungefähr das

+  Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040

+  Punkten. Zusätzliches Invertieren macht die Graphik dem Bildschirmausse-

+  hen noch ähnlicher. 

+ 

+- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re-

+  icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra-

+  phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber

+  Kommandosequenz 1 temporär auf eine hohe (4-fache) Dichte umschalten.

+  Solange kein Setup ausgeführt wird, ist diese Dichte nur solange gültig,

+  bis das Terminal ausgeschaltet wird. 

+ 

+#text end#

+#clear pos# 

+#free(16.11019)#

+ 

+ 

+ 45 

+#page##--------------------------------- Ende der Seite 45 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#7.  Die Parameter der seriellen Schnittstelle#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host durch Escape-

+Sequenzen gändert werden. Die Änderung der Parameter wird erst durchgeführt,

+wenn die Parameterübergabe komplett ist (d.h das letzte Byte wurde übertra-

+gen). Alle Übertragungsparameter wie Stopbits, Datenbits, Parität und Bau-

+drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flußkon-

+trolle wird mit separaten Escape-Sequenzen eingestellt. 

+Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#7.1  Das Übertragungsformat#ie(3)##type("elite")# 

+ 

+Das Übertragunsformat eines Datenbytes sieht folgendermaßen aus: 

+(Beispiel für 8 Datenbits, 1 Paritätsbit und 1 Stopbit) 

+ 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+    ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+       Start-  ----  D a t e n b i t s ---- Pari- Stop- 

+        bit                                 täts- bit 

+                                            bit 

+     --------> Zeit 

+ 

+Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Paritätsbit. Wenn zwei

+Stopbits übertragen werden steht an dieser Stelle das 1. Stopbit ("1"). 

+ 

+ 

+#type("8")##center##ib(3)#7.2  Die Übertragungsparameter#ie(3)##type("elite")# 

+ 

+Alle vier Parameter werden zugleich verändert. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> <SPACE> <SPACE>#ie(1)# <x>    (Hex 1B 20 20 <x>) 

+ 

+<x> ist dabei ein Datenbyte, das wie folgt festgelegt wird: 

+ 

+   Bit     7       6       5       4       3       2       1       0 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+       |Parity |Parity | Stop- | Daten-|            Baudrate           | 

+       | even/ |on/off | bits  | bits  |       |       |       |       | 

+       | odd   |       |       |       |       |       |       |       | 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+#right#46 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 46 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.2.1  Baudrate#ie(3)##type("elite")# 

+ 

+Baudrate = Anzahl der pro Sekunde übertragenen Bits (Übertragungsgeschwin-

+digkeit) . 

+ 

+         Bits 

+#on("u")#Dezimal 3 2 1 0    Neue Baudrate#off("u")# 

+  0     0 0 0 0    Alte Baudrate (nicht verändern) 

+  1     0 0 0 1      50 Baud 

+  2     0 0 1 0      75 Baud 

+  3     0 0 1 1     109.9 Baud 

+  4     0 1 0 0     134.58 Baud 

+  5     0 1 0 1     150 Baud 

+  6     0 1 1 0     300 Baud 

+  7     0 1 1 1     600 Baud 

+  8     1 0 0 0    1200 Baud 

+  9     1 0 0 1    1800 Baud 

+ 10     1 0 1 0    2400 Baud 

+ 11     1 0 1 1    3600 Baud 

+ 12     1 1 0 0    4800 Baud 

+ 13     1 1 0 1    7200 Baud 

+ 14     1 1 1 0    9600 Baud 

+ 15     1 1 1 1   19200 Baud 

+ 

+Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari-

+tätsbit verändert werden sollen. 

+ 

+ 

+#type("8")##center##ib(3)#7.2.2  Datenbits#ie(3)##type("elite")# 

+ 

+Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. 

+ 

+#on("u")#Dezimal Bit 4              #off("u")# 

+   0      0     8 Datenbits 

+  16      1     7 Datenbits 

+ 

+Mit einem anschliessenden Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 6#ie(1)#    (Hex 1B 20 36) 

+ 

+kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann

+notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge-

+setztes 8. Datenbit falsch reagiert (Steuerbit oder ähnliches). 

+ 

+Mit 

+ 

+                         #ib(1)#<ESC> <SPACE> 7#ie(1)#    (Hex 1B 20 37) 

+ 

+kann die Maskierung wieder aufgehoben werden. 

+Zu beachten ist, daß bei 7 Bit Datentransfer zum Beispiel das Farbbit bei

+Download einer Graphikseite nicht übertragen wird. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 47 

+#page##--------------------------------- Ende der Seite 47 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.2.3  Stopbits#ie(3)##type("elite")# 

+ 

+Bit 5 legt die Anzahl der Stopbits fest. 

+ 

+#on("u")#Dezimal Bit 5            #off("u")# 

+   0      0    1 Stopbit 

+  32      1    2 Stopbits 

+ 

+Zu beachten ist, daß bei eingeschaltetem Paritycheck und 8 Datenbits immer

+ein Stopbit übertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es

+können maximal 11 Bits/Daten"byte" übertragen werden.) 

+ 

+ 

+#type("8")##center##ib(3)#7.2.4  Paritätsbit#ie(3)##type("elite")# 

+ 

+Bit 6 legt fest, ob Paritätskontrolle erfolgen soll und ob ein Paritätsbit

+vorhanden ist. 

+ 

+Dezimal Bit 6 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+   0      0     Keine Paritätskontrolle/Kein Paritätsbit 

+  64      1     Paritätskontrolle eingeschaltet. Parität mit Bit 7 gewählt 

+ 

+Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Parität geprüft

+werden soll. 

+ 

+#on("u")#Dezimal Bit 7                   #off("u")# 

+   0      0     Ungerade Parität 

+ 128      1     Gerade Parität 

+ 

+ 

+#type("8")##center##ib(3)#7.2.5  Übertragungsfehler#ie(3)##type("elite")# 

+ 

+Wird ein Rahmenfehler (Stopbit fehlt) oder ein Paritätsfehler (mindestens

+ein Bit verfälscht) entdeckt, dann wird statt des empfangenen Mülls ein Byte

+Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in-

+vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an,

+wenn es mitten in einer Escape-Sequenz empfangen wird. 

+ 

+ 

+#type("8")##center##ib(3)#7.3  Die Flußkontrolle#ie(3)##type("elite")# 

+ 

+Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine

+solchen mehr empfangen kann, sollte eine Flußkontrolle eingeschaltet wer-

+den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen),

+aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048

+Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flußkon-

+trolle mitgeteilt hat, daß er keine Zeichen mehr empfangen kann. Das Termi-

+nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar-

+beiten (Spooler, Bildschirmausgabe, Localmodus etc.). 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#48 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 48 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y"

+in der Statuszeile erkennen, sonst steht dort "R E A D Y". 

+Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F"

+in der Statuszeile erkennen, sonst steht dort "T X   O N". 

+ 

+Da dieses Terminal einen großen Empfangspuffer hat, sollte man allerdings im

+Notfall auch ohne Flußkontrolle auskommen, wenn nicht gerade umfangreiche

+Graphikoperationen ausgeführt werden sollen, bei denen der Puffer nicht

+schnell genug geleert werden kann. 

+ 

+ 

+#type("8")##center##ib(3)#7.3.1  XON/XOFF#ie(3)##type("elite")# 

+ 

+XON/XOFF ist eine Softwareflußkontrolle. Als Stopzeichen wird 

+ 

+                         #ib(1)#XOFF#ie(1)#    (#ib(1)#<CTRL S>#ie(1)# Hex 13) 

+ 

+verwendet. Als Startzeichen wird 

+ 

+                         #ib(1)#XON#ie(1)#    (#ib(1)#<CTRL Q>#ie(1)# Hex 11) 

+ 

+verwendet. Diese Flußkontrolle sollte nur im Textmodus verwendet werden, da

+Binärdaten möglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als

+Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Fluß-

+kontrolle ist, daß man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen

+Schnittstelle auskommt. 

+ 

+Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese

+Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen

+werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. 

+ 

+Die XON/XOFF Flußkontrolle kann in der 2. Kommandozeile ein- und ausgeschal-

+tet werden, sowie mit dem Kommando 

+ 

+                         #ib(1)#<CTRL O>#ie(1)#    (Hex 0F) 

+ 

+eingeschaltet und mit 

+ 

+                         #ib(1)#<CTRL N>#ie(1)#    (Hex 0E) 

+ 

+ausgeschaltet werden. 

+ 

+Zu beachten ist, daß der Sender vor dem Ausschalten noch im "TX OFF"-

+Zustand sein kann. Man sollte deshalb direkt vor <CTRL N> noch <CTRL Q> (Hex

+11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom

+Terminal nicht automatisch gemacht, da sonst ein <CTRL N> das im Datenstrom

+vorkommt, auch noch ein Zeichen für Flußkontrolle wäre. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 49 

+#page##--------------------------------- Ende der Seite 49 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.3.2  DTR/DSR#ie(3)##type("elite")# 

+ 

+DTR/DSR ist eine Hardwareflußkontrolle bei der die Leitungen Pin 20 (DTR)

+und Pin 6 (DSR) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+DTR (Data Terminal Ready)/DSR (DataSet Ready) Flußkontrolle kann in der 2.

+Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE>#ie(1)# <n>    (Hex 1B 20 <n>) 

+ 

+erreichen. Die Werte von <n> sind 

+ 

+#on("u")#<n>  Hex    Bedeutung                                              #off("u")# 

+ 2    32    Weder RTS/CTS noch DSR/DTR Flußkontrolle 

+ 3    33    RTS/CTS Flußkontrolle, aber keine DSR/DTR Flußkontrolle 

+ 4    34    DSR/DTR Flußkontrolle, aber keine RTS/CTS Fluskontrolle 

+ 5    35    DSR/DTR und RTS/CTS Flußkontrolle 

+ 

+DTR/DSR Flußkontrolle wird empfohlen, da hier alle Zeichen ohne Veränderung

+empfangen werden können. RTS/CTS Flußkontrolle kann, hardwaremäßig bedingt,

+beim Einschalten von RTS ein Bit "umkippen". 

+ 

+ 

+#type("8")##center##ib(3)#7.3.3  RTS/CTS#ie(3)##type("elite")# 

+ 

+RTS/CTS ist eine Hardwareflußkontrolle bei der die Leitungen Pin 4 (RTS) und

+Pin 5 (CTS) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+RTS (Ready To Send)/CTS (Clear To Send) Flußkontrolle kann in der 2. Kom-

+mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom-

+mando <ESC> <SPACE> <n> erreichen. Die Werte von <n> sind im letzten Ab-

+schnitt (7.3.2 DTR/DSR) angegeben. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(3.833519)#

+ 

+ 

+#right#50 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 50 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.4  Echo und Local/Online#ie(3)##type("elite")# 

+ 

+In einigen Fällen verlangt der Host, daß das vom Terminal empfangene Zei-

+chen zurückgesendet (geechoed) wird, um eventuelle Übertragungsfehler zu

+erkennen. Dieser Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D E#ie(1)#    (Hex 1B 44 45) 

+ 

+eingeschaltet. Zusätzlich wird hiermit der Localmodus ausgeschaltet (d.h der

+Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus

+gegeben wurde. 

+ 

+Der Echo-Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D O#ie(1)#    (Hex 1B 44 4F) 

+ 

+ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus.

+Der Local-Modus wird auch hierbei verlassen. 

+ 

+Der Local-Modus kann vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D L#ie(1)#    (Hex 1B 44 4C) 

+ 

+eingeschaltet werden. Dabei ist zu beachten, daß der Host den Local-Modus

+nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drücken von

+#ib(1)#<SHIFT CTRL HOME>#ie(1)# am Keyboard verlassen werden. 

+ 

+Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt,

+sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert.

+Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape-

+Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik

+oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgeführt,

+d.h. die Daten werden zum Host geschickt. 

+ 

+#text end#

+#clear pos# 

+#free(7.643519)#

+ 

+ 

+ 51 

+#page##--------------------------------- Ende der Seite 51 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#8.  Spezielle Kommandos im Textmodus#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind

+und thematisch nicht in die anderen Kapitel passen, beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#8.1  Weitere Cursorpositionierungskommandos#ie(3)##type("elite")# 

+ 

+Zusätzlich zu den im Graphikmodus und im Textmodus gültigen Cursorpositio-

+nierungskommandos gibt es noch einige weitere. Die fünf Kommandos Zeile

+löschen, Zeile einfügen, Zeichen löschen, Zeichen einfügen und Rückwärtsta-

+bulator sind schon in Kapitel 5 beschrieben worden. 

+ 

+Hier nur noch einmal die entsprechenden Kommandos: 

+ 

+Funktion            Escape-Sequenz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Zeile einfügen      #ib(1)#<ESC> E#ie(1)#     oder #ib(1)#<ESC> L#ie(1)# 

+Zeile löschen       #ib(1)#<ESC> R#ie(1)#     oder #ib(1)#<ESC> M#ie(1)# 

+Zeichen einfügen    #ib(1)#<ESC> Q#ie(1)# 

+Zeichen löschen     #ib(1)#<ESC> W#ie(1)# 

+Rückwärtstabulator  #ib(1)#<ESC> I#ie(1)# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> j#ie(1)#    (Hex 1B 6A) 

+ 

+kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in

+Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie <UP>. Steht der Cursor

+in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die

+erste Bildschirmzeile gelöscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> =#ie(1)# <y+32> <x+32>    (Hex 1B 3D ...) 

+ 

+kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer-

+den. <x+32> und <y+32> sind dabei Byteparameter. <x+32> hat den Wertebe-

+reich 32 (<SPACE>) bis 110 ("o"), <y+32> hat den Wertebereich 32 (<SPACE>)

+bis 55 ("7"). <x+32> ist dabei die gewünschte x-Position + 32 (gezählt wird

+von 0 bis 79), <y+32> ist die gewünschte y-Position + 32 (gezählt wird von 0

+bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man

+auch im Anhang A unter "Cursor" nachlesen. 

+ 

+Dieser Befehl hat im Graphikmodus die gleiche Wirkung! 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+#right#52 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 52 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.2  Cursormodus#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> .#ie(1)# <n>    (Hex 1B 2E <n>) 

+ 

+kann die Darstellung des Cursors verändert werden. Für <n> sind ASCII-Zei-

+chen "0", "1" und "2" zugelassen. <n> hat folgende Bedeutung: 

+ 

+#on("u")#<n>   Bedeutung                             #off("u")# 

+ 0    Cursor blinkt nicht und ist unsichtbar 

+ 1    Cursor blinkt und ist sichtbar 

+ 2    Cursor blinkt nicht und ist sichtbar 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> Z#ie(1)#    (Hex 1B 5A) 

+ 

+kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge-

+schaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.3  Zeichensatz einstellen#ie(3)##type("elite")# 

+ 

+Da die Zeichensätze von Basis und Apple unterschiedlich sind, muß hier bei

+den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei-

+chensatzes lautet in beiden Fällen 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+wobei <n> ein Byteparameter ist. Beim Apple hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 1    Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei-

+ chen 

+ 4    Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen 

+ 

+Beim Basis hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen 

+ 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen 

+ 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 53 

+#page##--------------------------------- Ende der Seite 53 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+     Und mit blinkenden statt inversen Zeichen: 

+ 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) 

+ 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) 

+10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen 

+12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen 

+14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen 

+ 

+Einige ausgewählte Zeichensätze können auch in der Kommandozeile eingestellt

+werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.4  Texthardcopy#ie(3)##type("elite")# 

+ 

+Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> P#ie(1)#   (Hex 1B 50) 

+ 

+erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht verän-

+dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt,

+sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird <CR> und

+<LF> gedruckt, der Drucker sollte deshalb kein Autolinefeed bei <CR> durch-

+führen. 

+ 

+Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her-

+vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar-

+gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge-

+stellt. 

+ 

+ 

+#type("8")##center##ib(3)#8.5  Zeichen-Attribute#ie(3)##type("elite")# 

+ 

+Die Zeichenattribute werden mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter, der folgende Werte annehmen kann: 

+ 

+#on("u")#<n>   Attribute                                                      #off("u")# 

+ 0    Sichtbare, normale Zeichen 

+ 1    Unsichtbare Zeichen, es werden Leerzeichen dargestellt 

+ 4    Sichtbare, inverse Zeichen 

+ 5    Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#    (Hex 1B 28) 

+ 

+kann auf normale Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 0,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#54 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 54 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#    (Hex 1B 29) 

+ 

+kann auf inverse Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 4,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+ 

+#type("8")##center##ib(3)#8.6  Bildhintergrund hell/dunkel#ie(3)##type("elite")# 

+ 

+Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be-

+züglich eines gelöschten Bildschirms) umgeschaltet werden auf dunkle Schrift

+auf hellem Grund. Die Darstellung "schwarz auf weiß" ist auf einigen Monito-

+ren augenfreundlicher. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> b#ie(1)#    (Hex 1B 62) 

+ 

+kann die dunkle Schrift auf weißem Grund eingeschaltet werden. Die Darstel-

+lung von inverser und normaler Schrift wird vertauscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> d#ie(1)#    (Hex 1B 64) 

+ 

+kann helle Schrift auf dunklem Grund eingeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.7  Zeichentransfer zum Host#ie(3)##type("elite")# 

+ 

+Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle

+Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers-

+schrift anzeigt. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.1  Ein Zeichen senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 8#ie(1)#    (Hex 1B 38) 

+ 

+wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition

+ändert sich nicht. Der Cursor muß nicht sichtbar sein. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.563519)#

+ 

+ 

+ 55 

+#page##--------------------------------- Ende der Seite 55 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.7.2  Eine Zeile senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 6#ie(1)#    (Hex 1B 36) 

+ 

+wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow,

+falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in

+Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen-

+det. Im Anschluß an die Zeile werden eventuell ein oder zwei eingestellte

+Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer

+ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen-

+det. Die Cursorposition ändert sich durch das Kommando nicht. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.3  Eine Seite senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 7#ie(1)#    (Hex 1B 37) 

+ 

+wird die gesamte Bildschirmseite an den Host gesendet. Im Anschluß an jede

+Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschluß an

+die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator)

+gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969

+Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun-

+terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe-

+grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ändert sich

+durch dieses Kommando nicht. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.4  Terminatorzeichen definieren#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 1#ie(1)# <l1> <l2>    (Hex 1B 78 31 <l1><l2>) 

+ 

+können die Zeilenbegrenzer der Sendekommandos festgelegt werden. <l1> und

+<l2> sind dabei Byteparameter, die den Wertebereich 0 bis 255 überstrei-

+chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet.

+Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren-

+zerzeichen nach der Zeile gesendet. 

+Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 4#ie(1)# <p>    (Hex 1B 78 34 <p>) 

+ 

+kann der Seitenbegrenzer des Kommandos #ib(1)#<ESC> 7#ie(1)# festgelegt werden. <p> ist

+ein Byteparameter, der den Wertebereich von 0 bis 255 überstreicht. Ist <p>

+Hex 00, dann wird kein Seitenbegrenzer gesendet. 

+Voreingestellt ist <p> = <CR> (Hex 0D). 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#56 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 56 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.7.5  Cursorposition senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ?#ie(1)#    (Hex 1B 3F) 

+ 

+kann der Host die Position des Textcursors abfragen. Es wird eine Folge von

+3 Bytes gesendet: <y+32> <x+32> <CR> 

+ 

+<y+32> ist die y-Position + 32, <x+32> die x-Position + 32. Beide Parameter

+können für den Befehl #ib(1)#<ESC> =#ie(1)# <y+32> <x+32> verwendet werden, da Sie den

+gleichen Wertebereich überstreichen. 

+ 

+ 

+#type("8")##center##ib(3)#8.8  Textseite auf Diskette speichern/laden#ie(3)##type("elite")# 

+ 

+Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und

+zu einem späteren Zeitpunkt wieder zurückgeladen werden. Bei der Textseite

+wird außerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann

+sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen

+und diese Seiten auf Diskette abspeichern. Später kann man die Datei Offline

+(im Localmodus) Seitenweise ansehen. 

+ 

+Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen.

+Die "Fächer" für die Textseiten sind unabhängig von denen für die Graphik-

+seiten. 

+Die Seiten werden unabhängig von REVVID (Schwarz auf Weiß) immer NORVID

+(also Weiß auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach

+REVVID/NORVID dargestellt. 

+ 

+Das Kommando für diese Operationen lautet 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits

+folgendermaßen belegt sind: 

+Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) 

+Bit 3    : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) 

+Bit 4    : 0 heißt: die Textseite wird von der Diskette gelesen, 

+           1 heißt: die Textseite wird auf die Diskette geschrieben. 

+ 

+Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Textseite überschrieben. 

+ 

+Für Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten

+             befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol-

+             ge. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 57 

+#page##--------------------------------- Ende der Seite 57 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#9.  Verschiedene Steuerkommandos#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#9.1  Signalton#ie(3)##type("elite")# 

+ 

+Mit 

+                         #ib(1)#<CTRL G>#ie(1)#   (Hex 07) 

+ 

+wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schär-

+fer (heller). 

+ 

+ 

+#type("8")##center##ib(3)#9.2  Keyboardclick#ie(3)##type("elite")# 

+ 

+Der Tastaturclick wird für fast alle Tasten erzeugt. Ausnahmen sind die

+<SHIFT> und die <CTRL> Tasten, sowie beim Apple die Apfeltasten. Der Tasta-

+turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder

+mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <#ie(1)#    (Hex 1B 3C) 

+ 

+vom Host. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> >#ie(1)#    (Hex 1B 3E) 

+ 

+kann der Keyboardclick wieder eingeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#9.3  Bildschirmausgabe/Druckerausgabe#ie(3)##type("elite")# 

+ 

+Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der

+Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> `#ie(1)#    (Hex 1B 60) 

+ 

+abgeschaltet werden. Bis auf das Kommando 

+ 

+                         #ib(1)#<ESC> a#ie(1)#    (Hex 1B 61) 

+ 

+werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit <ESC> a

+wird die Bildschirmausgabe wieder zugelassen. 

+ 

+Die Druckerausgabe kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> @#ie(1)#    (Hex 1B 40) 

+ 

+eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild-

+schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch

+ein- und ausgeschaltet werden. 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#58 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 58 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal-

+ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet.

+Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe

+abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker-

+ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. 

+ 

+Abgeschaltet wird die Druckerausgabe mit dem Kommando 

+ 

+                         #ib(1)#<ESC> A#ie(1)#    (Hex 1B 41) 

+ 

+ 

+#type("8")##center##ib(3)#9.4  Scroll/Page-Modus#ie(3)##type("elite")# 

+ 

+Steht der Cursor in der letzten Zeile und soll er in die nächst tiefere

+gebracht werden (<DOWN>, <TAB>, <NEWLINE> etc.), dann gibt es entweder die

+Möglichkeit, daß der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile

+verschwindet und die 24. Zeile wird gelöscht, oder daß der Cursor in der

+ersten Bildschirmzeile wieder auftaucht, ohne daß der Bildschirminhalt ver-

+ändert wird. Die erste Möglichkeit heißt SCROLL-Modus, die zweite PAGE-

+Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen

+oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> H#ie(1)#    (Hex 1B 48). 

+ 

+In der Kommandozeile hat man die Informationsmöglichkeit, welcher Modus

+gerade aktiv ist. 

+ 

+ 

+#type("8")##center##ib(3)#9.5  Belegung der Funktionstasten#ie(3)##type("elite")# 

+ 

+Eine nützliche Angelegenheit sind die programmierbaren Funktionstasten. Die

+Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk-

+tionstasten können im Local-Modus aufgerufen werden, zum Beispiel für häu-

+fig gebrauchte Terminalkommandos oder längere Kommandosequenzen (Graphikmo-

+dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion-

+stasten legen. 

+ 

+Die Länge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095

+Zeichen überschreiten. Ein akustisches Warnsignal ertönt, wenn die Funk-

+tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch

+nach dem Abschalten des Terminals erhalten bleiben, dann muß in der Komman-

+dozeile <SHIFT S> gegeben werden, damit der Setup samt Funktionstastende-

+finitionen auf die Diskette geschrieben wird. 

+ 

+#text end#

+#clear pos# 

+#free(3.410185)#

+ 

+ 

+ 59 

+#page##--------------------------------- Ende der Seite 59 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+wird eine Taste belegt. <d...> und <t> sind Byteparameter. <d...> ist eine

+Folge von Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funk-

+tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese

+Einschränkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman-

+dos möglich, man kann allerdings z.B. auch nicht alle binären Parameter auf

+Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc.

+können nicht belegt werden. 

+Um die Original-Tastencodes wieder zu benutzen, gibt es drei Möglichkeiten: 

+ 

+- Die Tabelle der Tastendefinitionen wird ganz gelöscht (Abschnitt 9.6). 

+- Die Definition auf einzelnen Tasten wird durch <ESC> e <t> gelöscht. <t>

+  ist dabei der Code einer zu löschenden Taste. 

+- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando 

+ 

+                         #ib(1)#<ESC> c#ie(1)#    (Hex 1B 63) 

+ 

+  gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder,

+  bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im

+  Graphikmodus möchte man eventuell die griechischen Sonderzeichen auf den

+  Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten-

+  strings (F STRG). 

+ 

+ 

+#type("8")##center##ib(3)#9.5.1  Local-Escape#ie(3)##type("elite")# 

+ 

+Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu

+können (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei-

+chen statt <ESC> (Hex 1B) verwendet. 

+Das Zeichen 

+ 

+                         #ib(1)#<LOCESC>#ie(1)#    (Hex 9B) 

+ 

+teilt dem Terminal mit, daß die nun folgende Escape-Sequenz nicht an den

+Host gesendet wird (was bei <ESC> der Fall wäre), sondern vom Terminal in-

+terpretiert werden muß. 

+Im Local-Modus wirkt ein <LOCESC> wie ein normales <ESC>, d.h. das Kommando

+wird sowieso vom Terminal interpretiert. 

+ 

+ 

+#type("8")##center##ib(3)#9.5.2  Makrokommandos#ie(3)##type("elite")# 

+ 

+Ein Makrokommando hat (mindestens) drei Aufgaben: 

+- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren,

+  z.B. um andere Terminals zu emulieren. 

+- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der

+  Host, wenn die Funkionstaste als Makro aufgerufen wird. 

+- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkürzungen

+  häufig benutzter Zeichenfolgen beschleunigt werden. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#60 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 60 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Ein Makro wird wie eine Funktionstaste mit dem Kommando 

+ 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+definiert. <d...> und <t> sind Byteparameter. <d...> ist eine Folge von

+Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funktionstaste

+(Bit 7 = 1) oder mit anderen Worten der Makroname. 

+Es sind alle Codes für <t> zugelassen, die auch bei der Funktionstastende-

+finition zugelassen sind. 

+ 

+Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host

+mit 

+ 

+                         #ib(1)#<ESC> <Macrocode>#ie(1)#    (Hex 1B <Makrocode>) 

+ 

+aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge-

+setzt, als käme sie von der Tastatur im Local-Modus. Wird das Makro also

+bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, daß man

+im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. 

+Anmerkung: Wird das <ESC> vor dem <Makrocode> weggelassen, dann wird der

+           Code <Makrocode> ohne Makroausführung an das Terminal gesendet

+           und i.d.R. als inverses Zeichen dargestellt. 

+ 

+Sollen Byteparameter in die Zeichensequenz des Makros übernommen werden, die

+zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen

+Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81

+kann auf der Tastatur durch <SHIFT DELETE> erzeugt werden. 

+Wird bei der Makroausführung ein solcher Code gefunden, wartet das Terminal

+auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde,

+oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es dürfen beliebig

+viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird

+durch ein weiteres Zeichen von Host oder Tastatur ersetzt. 

+ 

+ 

+#type("8")##center##ib(3)#9.5.3  Startup-Makro#ie(3)##type("elite")# 

+ 

+Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur

+durch <SHIFT BOTTOMRIGHT> (beim Apple <OA RIGHT>) erzeugt werden. 

+ 

+Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder <ESC> 0)

+oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra-

+phikseiten werden vorher gelöscht. 

+

+

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 61 

+#page##--------------------------------- Ende der Seite 61 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin#

+#type("8")##center##ib(3)#9.6  Tabellen und Puffer löschen#ie(3)##type("elite")# 

+ 

+Das Terminal enthält den Empfangspuffer, den Sendepuffer, den Druckerspoo-

+ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die

+Tabelle zu löschen, kann das Kommando 

+ 

+                         #ib(1)#<ESC> <DEL>#ie(1)# <n>    (Hex 1B 7F <n>) 

+ 

+verwendet werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 15

+und hat folgende Bedeutung: 

+ 

+#on("u")#<n>    Gelöschte Tabelle oder Puffer#off("u")# 

+ 0     Keine 

+ 1     Tastendefinitionen 

+ 2     Druckerspooler 

+ 3     Empfangspuffer 

+ 4     Sendepuffer 

+ 

+Zu beachten ist, daß zwar der Sendepuffer gelöscht wird, aber eine eventu-

+ell gestoppte Übertragung (TX OFF) nicht wider gestartet wird. 

+ 

+ 

+#type("8")##center##ib(3)#9.7  Zeitverzögerung#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 9#ie(1)# <n>    (Hex 1B 39 <n>) 

+ 

+kann eine Zeitverzögerung aufgerufen werden. Man kann zum Beispiel ein Fa-

+denkreuz darstellen, die Zeitverzögerung aufrufen und das Fadenkreuz wieder

+löschen. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die

+Verzögerung beträgt ca. <n> * 2 ms. 

+ 

+ 

+#type("8")##center##ib(3)#9.8  Transparentmodi#ie(3)##type("elite")# 

+ 

+Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp-

+fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten

+Programmen gedacht. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.1  Monitor-Modus#ie(3)##type("elite")# 

+ 

+Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control-

+zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei-

+chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex

+A0..FF unterscheiden, die auch invers dargestellt werden. 

+Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet

+werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> U#ie(1)#    (Hex 1B 55) 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#62 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 62 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter-

+pretation ausgegeben, Ausnahmen sind 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58) 

+ 

+die den Monitormodus ausschalten. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.2  Hexadezimal-Modus#ie(3)##type("elite")# 

+ 

+In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son-

+dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden

+Blanks. Der Hexmode kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus-

+gegeben, außer #ib(1)#<ESC> u#ie(1)# und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58), 

+ 

+die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten

+Kommandozeile ein- und ausgeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.3  Einzelne Control-Zeichen anzeigen#ie(3)##type("elite")# 

+ 

+Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. für den

+unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt

+es das Kommando 

+ 

+                         #ib(1)#<ESC> F#ie(1)# <z>    (Hex 1B 46 <z>). 

+ 

+<z> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei-

+se 0 bis 31. <z> wir mit invertiertem Bit 7 (normal/invers) in den Bild-

+schirmspeicher an der aktuellen Cursorposition geschrieben. 

+#text end#

+#clear pos# 

+#free(5.103519)#

+ 

+ 

+ 63 

+#page##--------------------------------- Ende der Seite 63 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TINHALT.PRT b/system/ruc-terminal/unknown/doc/TINHALT.PRT
new file mode 100644
index 0000000..e8e7435
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TINHALT.PRT
@@ -0,0 +1,120 @@
+#type ("elite")##limit (16.2)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("", "Inhalt  ")# 

+ 

+1.  Einige Worte zuvor ...........................  1 

+2.  Die Hardware .................................  2 

+2.1  Die serielle Schnittstelle ..................  2 

+2.2  Der Reset ...................................  2 

+3.  Die Kommandozeile ............................  3 

+3.1  Tastenfunktionen in der Kommandozeile .......  3 

+3.2  Setup .......................................  4 

+3.3  Die zweite Kommandozeile ....................  4 

+3.4  Die zweite Kommandozeile ....................  6 

+4.  Die Statuszeile ..............................  8 

+4.1  Spoolerstatus ...............................  8 

+4.2  Empfängerstatus .............................  8 

+4.3  Senderstatus ................................  9 

+4.4  Busy - Anzeige ..............................  9 

+4.5  Online/Local - Anzeige ......................  9 

+5.  Die Bedeutung der Tasten .....................  10 

+5.1  Die Funktions- und Steuertasten .............  10 

+5.2  Die TVI-Emulation ...........................  13 

+6.  Der Graphikmodus .............................  16 

+6.1  Allgemeines .................................  16 

+6.2  Koordinaten und Parameterübergabe ...........  16 

+6.2.1  Cursorposition/Fadenkreuz .................  16 

+6.2.2  Binäre oder dezimale Parameter ............  17 

+6.2.2.1  Binäre Parameter ........................  17 

+6.2.2.2  Dezimale Parameter ......................  17 

+6.2.3  Absolute oder relative Koordinaten ........  18 

+6.2.4  Byteparameter .............................  18 

+6.3  Die Graphikparameter ........................  19 

+6.3.1  Strichdicke ...............................  19 

+6.3.2  Farbe/Helligkeit ..........................  19 

+6.3.3  Linientyp .................................  20 

+6.3.3.1  Selbstdefinierte Linientypen (Pattern) ..  20 

+6.3.4  Bitverknüpfungen ..........................  21 

+6.3.5  Multiparametereinstellung .................  22 

+6.4  Graphikseiten ...............................  22 

+6.4.1  Die sichtbare Seite und die Arbeitsseite ..  22 

+6.4.1.1  80-Zeichen Text und Graphik .............  23 

+6.4.2  Aufbau einer Graphikseite .................  23 

+6.4.3  Operationen auf den Graphikseiten .........  24 

+6.4.4  Laden einer Graphikseite vom Host .........  25 

+6.4.5  Graphik auf Diskette speichern/laden ......  26 

+6.5  Textdarstellung im Graphikmodus .............  26 

+6.5.1  Zeichendarstellung ........................  27 

+6.5.1.1  Zeichengröße und Schreibrichtung ........  27 

+6.5.1.2  Dicke, Farbe etc. .......................  28 

+6.5.1.3  Zeichensätze und Attribute ..............  28 

+6.5.1.4  Zeichen überschreiben ...................  29 

+6.5.2  Textkommandos im Graphikmodus .............  30 

+6.5.2.1  Die Cursorpositionierung ................  30 

+6.5.2.2  Löschbefehle ............................  33 

+6.6  Die Graphikkommandos ........................  33 

+6.6.1  Draw's und Move's .........................  33 

+6.6.1.1  Punkt setzen ............................  34 

+6.6.1.2  Move-Befehle ............................  34 

+6.6.1.3  Draw-Befehle ............................  35 

+6.6.1.4  Turtle-Graphik ..........................  35 

+6.6.2  Komplexere Zeichenkommandos ...............  36 

+6.6.2.1  Kreise und Kreissegmente ................  36 

+6.6.2.2  Rechtecke ...............................  37 

+6.6.2.3  Bögen und Ellipsen ......................  38 

+6.6.2.4  Gefüllte Flächen ........................  39 

+6.6.2.4.1  Definition des Musters ................  40 

+6.7  Graphikdaten zum Host .......................  40 

+6.7.1  Graphikseiten zum Host ....................  40 

+6.7.2  Cursorposition zum Host ...................  41 

+6.7.3  Einzelne Bits zum Host ....................  41 

+6.7.4  Parameter zum Host ........................  42 

+6.8  Graphikhardcopy .............................  43 

+6.8.1  Der Druckertreiber ........................  43 

+6.8.2  Die Hardcopyparameter .....................  44 

+7.  Die Parameter der seriellen Schnittstelle ....  46 

+7.1  Das Übertragungsformat ......................  46 

+7.2  Die Übertragungsparameter ...................  46 

+7.2.1  Baudrate ..................................  47 

+7.2.2  Datenbits .................................  47 

+7.2.3  Stopbits ..................................  48 

+7.2.4  Paritätsbit ...............................  48 

+7.2.5  Übertragungsfehler ........................  48 

+7.3  Die Flußkontrolle ...........................  48 

+7.3.1  XON/XOFF ..................................  49 

+7.3.2  DTR/DSR ...................................  50 

+7.3.3  RTS/CTS ...................................  50 

+7.4  Echo und Local/Online .......................  51 

+8.  Spezielle Kommandos im Textmodus .............  52 

+8.1  Weitere Cursorpositionierungskommandos ......  52 

+8.2  Cursormodus .................................  53 

+8.3  Zeichensatz einstellen ......................  53 

+8.4  Texthardcopy ................................  54 

+8.5  Zeichen-Attribute ...........................  54 

+8.6  Bildhintergrund hell/dunkel .................  55 

+8.7  Zeichentransfer zum Host ....................  55 

+8.7.1  Ein Zeichen senden ........................  55 

+8.7.2  Eine Zeile senden .........................  56 

+8.7.3  Eine Seite senden .........................  56 

+8.7.4  Terminatorzeichen definieren ..............  56 

+8.7.5  Cursorposition senden .....................  57 

+8.8  Textseite auf Diskette speichern/laden ......  57 

+9.  Verschiedene Steuerkommandos .................  58 

+9.1  Signalton ...................................  58 

+9.2  Keyboardclick ...............................  58 

+9.3  Bildschirmausgabe/Druckerausgabe ............  58 

+9.4  Scroll/Page-Modus ...........................  59 

+9.5  Belegung der Funktionstasten ................  59 

+9.5.1  Local-Escape ..............................  60 

+9.5.2  Makrokommandos ............................  60 

+9.5.3  Startup-Makro .............................  61 

+9.6  Tabellen und Puffer löschen .................  62 

+9.7  Zeitverzögerung .............................  62 

+9.8  Transparentmodi .............................  62 

+9.8.1  Monitor-Modus .............................  62 

+9.8.2  Hexadezimal-Modus .........................  63 

+9.8.3  Einzelne Control-Zeichen anzeigen .........  63 

+Anhang A - ASCII Tabelle, Zeichensätze, Parameter.  64 

+Anhang B - Befehlsübersicht ......................  70 

+Anhang C - Default Funktionstastenbelegungen .....  74 

+Stichwortverzeichnis .............................  75 

diff --git a/system/ruc-terminal/unknown/doc/TINHALTP.PRT b/system/ruc-terminal/unknown/doc/TINHALTP.PRT
new file mode 100644
index 0000000..22b1d0a
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TINHALTP.PRT
@@ -0,0 +1,157 @@
+#type ("elite")##limit (16.2)# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#  Inhalt  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#  Inhalt  #ie(3)##off("u")##off("i")##type("elite")# 

+ 

+1.  Einige Worte zuvor ...........................  1 

+2.  Die Hardware .................................  2 

+2.1  Die serielle Schnittstelle ..................  2 

+2.2  Der Reset ...................................  2 

+3.  Die Kommandozeile ............................  3 

+3.1  Tastenfunktionen in der Kommandozeile .......  3 

+3.2  Setup .......................................  4 

+3.3  Die zweite Kommandozeile ....................  4 

+3.4  Die zweite Kommandozeile ....................  6 

+4.  Die Statuszeile ..............................  8 

+4.1  Spoolerstatus ...............................  8 

+4.2  Empfängerstatus .............................  8 

+4.3  Senderstatus ................................  9 

+4.4  Busy - Anzeige ..............................  9 

+4.5  Online/Local - Anzeige ......................  9 

+5.  Die Bedeutung der Tasten .....................  10 

+5.1  Die Funktions- und Steuertasten .............  10 

+5.2  Die TVI-Emulation ...........................  13 

+6.  Der Graphikmodus .............................  16 

+6.1  Allgemeines .................................  16 

+6.2  Koordinaten und Parameterübergabe ...........  16 

+6.2.1  Cursorposition/Fadenkreuz .................  16 

+6.2.2  Binäre oder dezimale Parameter ............  17 

+6.2.2.1  Binäre Parameter ........................  17 

+6.2.2.2  Dezimale Parameter ......................  17 

+6.2.3  Absolute oder relative Koordinaten ........  18 

+6.2.4  Byteparameter .............................  18 

+6.3  Die Graphikparameter ........................  19 

+6.3.1  Strichdicke ...............................  19 

+6.3.2  Farbe/Helligkeit ..........................  19 

+6.3.3  Linientyp .................................  20 

+6.3.3.1  Selbstdefinierte Linientypen (Pattern) ..  20 

+6.3.4  Bitverknüpfungen ..........................  21 

+6.3.5  Multiparametereinstellung .................  22 

+6.4  Graphikseiten ...............................  22 

+6.4.1  Die sichtbare Seite und die Arbeitsseite ..  22 

+6.4.1.1  80-Zeichen Text und Graphik .............  23 

+6.4.2  Aufbau einer Graphikseite .................  23 

+6.4.3  Operationen auf den Graphikseiten .........  24 

+6.4.4  Laden einer Graphikseite vom Host .........  25 

+6.4.5  Graphik auf Diskette speichern/laden ......  26 

+6.5  Textdarstellung im Graphikmodus .............  26 

+6.5.1  Zeichendarstellung ........................  27 

+6.5.1.1  Zeichengröße und Schreibrichtung ........  27 

+6.5.1.2  Dicke, Farbe etc. .......................  28 

+6.5.1.3  Zeichensätze und Attribute ..............  28 

+6.5.1.4  Zeichen überschreiben ...................  29 

+6.5.2  Textkommandos im Graphikmodus .............  30 

+6.5.2.1  Die Cursorpositionierung ................  30 

+6.5.2.2  Löschbefehle ............................  33 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ i 

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+6.6  Die Graphikkommandos ........................  33 

+6.6.1  Draw's und Move's .........................  33 

+6.6.1.1  Punkt setzen ............................  34 

+6.6.1.2  Move-Befehle ............................  34 

+6.6.1.3  Draw-Befehle ............................  35 

+6.6.1.4  Turtle-Graphik ..........................  35 

+6.6.2  Komplexere Zeichenkommandos ...............  36 

+6.6.2.1  Kreise und Kreissegmente ................  36 

+6.6.2.2  Rechtecke ...............................  37 

+6.6.2.3  Bögen und Ellipsen ......................  38 

+6.6.2.4  Gefüllte Flächen ........................  39 

+6.6.2.4.1  Definition des Musters ................  40 

+6.7  Graphikdaten zum Host .......................  40 

+6.7.1  Graphikseiten zum Host ....................  40 

+6.7.2  Cursorposition zum Host ...................  41 

+6.7.3  Einzelne Bits zum Host ....................  41 

+6.7.4  Parameter zum Host ........................  42 

+6.8  Graphikhardcopy .............................  43 

+6.8.1  Der Druckertreiber ........................  43 

+6.8.2  Die Hardcopyparameter .....................  44 

+7.  Die Parameter der seriellen Schnittstelle ....  46 

+7.1  Das Übertragungsformat ......................  46 

+7.2  Die Übertragungsparameter ...................  46 

+7.2.1  Baudrate ..................................  47 

+7.2.2  Datenbits .................................  47 

+7.2.3  Stopbits ..................................  48 

+7.2.4  Paritätsbit ...............................  48 

+7.2.5  Übertragungsfehler ........................  48 

+7.3  Die Flußkontrolle ...........................  48 

+7.3.1  XON/XOFF ..................................  49 

+7.3.2  DTR/DSR ...................................  50 

+7.3.3  RTS/CTS ...................................  50 

+7.4  Echo und Local/Online .......................  51 

+8.  Spezielle Kommandos im Textmodus .............  52 

+8.1  Weitere Cursorpositionierungskommandos ......  52 

+8.2  Cursormodus .................................  53 

+8.3  Zeichensatz einstellen ......................  53 

+8.4  Texthardcopy ................................  54 

+8.5  Zeichen-Attribute ...........................  54 

+8.6  Bildhintergrund hell/dunkel .................  55 

+8.7  Zeichentransfer zum Host ....................  55 

+8.7.1  Ein Zeichen senden ........................  55 

+8.7.2  Eine Zeile senden .........................  56 

+8.7.3  Eine Seite senden .........................  56 

+8.7.4  Terminatorzeichen definieren ..............  56 

+8.7.5  Cursorposition senden .....................  57 

+8.8  Textseite auf Diskette speichern/laden ......  57 

+9.  Verschiedene Steuerkommandos .................  58 

+9.1  Signalton ...................................  58 

+9.2  Keyboardclick ...............................  58 

+9.3  Bildschirmausgabe/Druckerausgabe ............  58 

+9.4  Scroll/Page-Modus ...........................  59 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#ii 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 2 -----------#

+#center##on("b")#  Inhalt  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+9.5  Belegung der Funktionstasten ................  59 

+9.5.1  Local-Escape ..............................  60 

+9.5.2  Makrokommandos ............................  60 

+9.5.3  Startup-Makro .............................  61 

+9.6  Tabellen und Puffer löschen .................  62 

+9.7  Zeitverzögerung .............................  62 

+9.8  Transparentmodi .............................  62 

+9.8.1  Monitor-Modus .............................  62 

+9.8.2  Hexadezimal-Modus .........................  63 

+9.8.3  Einzelne Control-Zeichen anzeigen .........  63 

+Anhang A - ASCII Tabelle, Zeichensätze, Parameter.  64 

+Anhang B - Befehlsübersicht ......................  70 

+Anhang C - Default Funktionstastenbelegungen .....  74 

+Stichwortverzeichnis .............................  75 

+#text end#

+#free(16.11019)#

+ 

+ 

+ iii

+#page##--------------------------------- Ende der Seite 3 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TSTICHP.PRT b/system/ruc-terminal/unknown/doc/TSTICHP.PRT
new file mode 100644
index 0000000..4f2a3e8
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TSTICHP.PRT
@@ -0,0 +1,211 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 75)#

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#  Stichwortverzeichnis  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#  Stichwortverzeichnis  #ie(3)##off("u")##off("i")##type("elite")# 

+ 

+<BACKSPACE> ......................................  14 

+<BOTTOMLEFT> .....................................  32 

+<BOTTOMRIGHT> ....................................  32 

+<CE> .............................................  16 

+<CE> .............................................  31 

+<CTRL G> .........................................  58 

+<CTRL HOME> ......................................  32 

+<CTRL K> .........................................  14 

+<CTRL L> .........................................  14 

+<CTRL N> .........................................  49 

+<CTRL O> .........................................  49 

+<CTRL SHIFT ^> ...................................  14 

+<CTRL SHIFT _> ...................................  14 

+<CTRL V> .........................................  31 

+<CTRL X> .........................................  16 

+<CTRL Z> .........................................  14 

+<CTRL Z> .........................................  33 

+<CTRL Q> .........................................  49 

+<CTRL S> .........................................  49 

+<DELETE> .........................................  32 

+<DOWN> ...........................................  31 

+<ESC> ! ..........................................  24 

+<ESC> $ ..........................................  16 

+<ESC> % ..........................................  16 

+<ESC> & ..........................................  29 

+<ESC> ' ..........................................  29 

+<ESC> ( ..........................................  29 

+<ESC> ( ..........................................  54 

+<ESC> ) ..........................................  29 

+<ESC> ) ..........................................  55 

+<ESC> * ..........................................  33 

+<ESC> + ..........................................  33 

+<ESC> , ..........................................  33 

+<ESC> - ..........................................  41 

+<ESC> . ..........................................  53 

+<ESC> ............................................  32 

+<ESC> / ..........................................  25 

+<ESC> 0 ..........................................  2 

+<ESC> 4 ..........................................  42 

+<ESC> 5 ..........................................  42 

+<ESC> 6 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 8 ..........................................  55 

+<ESC> 9 ..........................................  62 

+<ESC> : ..........................................  33 

+<ESC> ; ..........................................  41 

+<ESC> < ..........................................  58 

+<ESC> <DEL> ......................................  62 

+<ESC> <Macrocode> ................................  61 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 75 

+#page##--------------------------------- Ende der Seite 75 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+<ESC> <SPACE> ....................................  50 

+<ESC> <SPACE> 0 ..................................  10 

+<ESC> <SPACE> 1 ..................................  13 

+<ESC> <SPACE> 6 ..................................  47 

+<ESC> <SPACE> 7 ..................................  47 

+<ESC> <SPACE> <SPACE> ............................  46 

+<ESC> = ..........................................  52 

+<ESC> = ..........................................  57 

+<ESC> > ..........................................  58 

+<ESC> ? ..........................................  57 

+<ESC> @ ..........................................  58 

+<ESC> A ..........................................  59 

+<ESC> D E ........................................  51 

+<ESC> D L ........................................  51 

+<ESC> D O ........................................  51 

+<ESC> E ..........................................  14 

+<ESC> E ..........................................  52 

+<ESC> F ..........................................  63 

+<ESC> G ..........................................  29 

+<ESC> G ..........................................  54 

+<ESC> H ..........................................  59 

+<ESC> I ..........................................  14 

+<ESC> I ..........................................  52 

+<ESC> J ..........................................  38 

+<ESC> K ..........................................  37 

+<ESC> L ..........................................  52 

+<ESC> M ..........................................  52 

+<ESC> N ..........................................  27 

+<ESC> N ..........................................  30 

+<ESC> O 0 ........................................  19 

+<ESC> O 0 ........................................  28 

+<ESC> O 1 ........................................  19 

+<ESC> O 2 ........................................  19 

+<ESC> O 3 ........................................  20 

+<ESC> O 4 ........................................  21 

+<ESC> O 5 ........................................  22 

+<ESC> O 5 ........................................  43 

+<ESC> O 6 ........................................  20 

+<ESC> O 7 ........................................  22 

+<ESC> O 7 ........................................  42 

+<ESC> O 7 ........................................  44 

+<ESC> O 8 ........................................  36 

+<ESC> O 9 ........................................  36 

+<ESC> O : ........................................  40 

+<ESC> P ..........................................  54 

+<ESC> Q ..........................................  14 

+<ESC> Q ..........................................  52 

+<ESC> R ..........................................  14 

+<ESC> R ..........................................  52 

+<ESC> S ..........................................  26 

+<ESC> S ..........................................  57 

+<ESC> T ..........................................  33 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#76 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 76 -----------#

+#center##on("b")#  Stichwortverzeichnis  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+<ESC> U ..........................................  62 

+<ESC> W ..........................................  14 

+<ESC> W ..........................................  52 

+<ESC> X ..........................................  63 

+<ESC> X ..........................................  63 

+<ESC> Y ..........................................  33 

+<ESC> Z ..........................................  53 

+<ESC> \ ..........................................  40 

+<ESC> ^ ..........................................  44 

+<ESC> _ ..........................................  41 

+<ESC> ` ..........................................  58 

+<ESC> a ..........................................  58 

+<ESC> b ..........................................  55 

+<ESC> c ..........................................  60 

+<ESC> d ..........................................  55 

+<ESC> e ..........................................  13 

+<ESC> e ..........................................  60 

+<ESC> e ..........................................  61 

+<ESC> j ..........................................  52 

+<ESC> m ..........................................  34 

+<ESC> n ..........................................  35 

+<ESC> o ..........................................  36 

+<ESC> q ..........................................  34 

+<ESC> r ..........................................  35 

+<ESC> s ..........................................  38 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> v ..........................................  34 

+<ESC> w ..........................................  35 

+<ESC> x 1 ........................................  56 

+<ESC> x 4 ........................................  56 

+<ESC> y ..........................................  33 

+<ESC> z ..........................................  28 

+<ESC> z ..........................................  53 

+<ESC> { ..........................................  8 

+<ESC> | ..........................................  39 

+<ESC> } ..........................................  8 

+<ESC> ~ ..........................................  43 

+<HOME> ...........................................  32 

+<LEFT> ...........................................  32 

+<LF> .............................................  14 

+<LOCESC> .........................................  60 

+<RETURN> .........................................  31 

+<RIGHT> ..........................................  32 

+<SHIFT CE> .......................................  31 

+<SHIFT CTRL HOME> ................................  32 

+<SHIFT CTRL HOME> ................................  51 

+<SHIFT HOME> .....................................  32 

+<SHIFT RETURN> ...................................  31 

+<TAB> ............................................  31 

+<UP> .............................................  31 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 77 

+#page##--------------------------------- Ende der Seite 77 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+XOFF .............................................  49 

+XON ..............................................  49 

+#text end#

+#free(21.19019)#

+ 

+ 

+#right#78 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 78 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TSTICHWO.PRT b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT
new file mode 100644
index 0000000..ac6f011
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT
@@ -0,0 +1,161 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 75)##page (75)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("", "Stichwortverzeichnis  ")# 

+ 

+<BACKSPACE> ......................................  14 

+<BOTTOMLEFT> .....................................  32 

+<BOTTOMRIGHT> ....................................  32 

+<CE> .............................................  16 

+<CE> .............................................  31 

+<CTRL G> .........................................  58 

+<CTRL HOME> ......................................  32 

+<CTRL K> .........................................  14 

+<CTRL L> .........................................  14 

+<CTRL N> .........................................  49 

+<CTRL O> .........................................  49 

+<CTRL SHIFT ^> ...................................  14 

+<CTRL SHIFT _> ...................................  14 

+<CTRL V> .........................................  31 

+<CTRL X> .........................................  16 

+<CTRL Z> .........................................  14 

+<CTRL Z> .........................................  33 

+<CTRL Q> .........................................  49 

+<CTRL S> .........................................  49 

+<DELETE> .........................................  32 

+<DOWN> ...........................................  31 

+<ESC> ! ..........................................  24 

+<ESC> $ ..........................................  16 

+<ESC> % ..........................................  16 

+<ESC> & ..........................................  29 

+<ESC> ' ..........................................  29 

+<ESC> ( ..........................................  29 

+<ESC> ( ..........................................  54 

+<ESC> ) ..........................................  29 

+<ESC> ) ..........................................  55 

+<ESC> * ..........................................  33 

+<ESC> + ..........................................  33 

+<ESC> , ..........................................  33 

+<ESC> - ..........................................  41 

+<ESC> . ..........................................  53 

+<ESC> ............................................  32 

+<ESC> / ..........................................  25 

+<ESC> 0 ..........................................  2 

+<ESC> 4 ..........................................  42 

+<ESC> 5 ..........................................  42 

+<ESC> 6 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 8 ..........................................  55 

+<ESC> 9 ..........................................  62 

+<ESC> : ..........................................  33 

+<ESC> ; ..........................................  41 

+<ESC> < ..........................................  58 

+<ESC> <DEL> ......................................  62 

+<ESC> <Macrocode> ................................  61 

+<ESC> <SPACE> ....................................  50 

+<ESC> <SPACE> 0 ..................................  10 

+<ESC> <SPACE> 1 ..................................  13 

+<ESC> <SPACE> 6 ..................................  47 

+<ESC> <SPACE> 7 ..................................  47 

+<ESC> <SPACE> <SPACE> ............................  46 

+<ESC> = ..........................................  52 

+<ESC> = ..........................................  57 

+<ESC> > ..........................................  58 

+<ESC> ? ..........................................  57 

+<ESC> @ ..........................................  58 

+<ESC> A ..........................................  59 

+<ESC> D E ........................................  51 

+<ESC> D L ........................................  51 

+<ESC> D O ........................................  51 

+<ESC> E ..........................................  14 

+<ESC> E ..........................................  52 

+<ESC> F ..........................................  63 

+<ESC> G ..........................................  29 

+<ESC> G ..........................................  54 

+<ESC> H ..........................................  59 

+<ESC> I ..........................................  14 

+<ESC> I ..........................................  52 

+<ESC> J ..........................................  38 

+<ESC> K ..........................................  37 

+<ESC> L ..........................................  52 

+<ESC> M ..........................................  52 

+<ESC> N ..........................................  27 

+<ESC> N ..........................................  30 

+<ESC> O 0 ........................................  19 

+<ESC> O 0 ........................................  28 

+<ESC> O 1 ........................................  19 

+<ESC> O 2 ........................................  19 

+<ESC> O 3 ........................................  20 

+<ESC> O 4 ........................................  21 

+<ESC> O 5 ........................................  22 

+<ESC> O 5 ........................................  43 

+<ESC> O 6 ........................................  20 

+<ESC> O 7 ........................................  22 

+<ESC> O 7 ........................................  42 

+<ESC> O 7 ........................................  44 

+<ESC> O 8 ........................................  36 

+<ESC> O 9 ........................................  36 

+<ESC> O : ........................................  40 

+<ESC> P ..........................................  54 

+<ESC> Q ..........................................  14 

+<ESC> Q ..........................................  52 

+<ESC> R ..........................................  14 

+<ESC> R ..........................................  52 

+<ESC> S ..........................................  26 

+<ESC> S ..........................................  57 

+<ESC> T ..........................................  33 

+<ESC> U ..........................................  62 

+<ESC> W ..........................................  14 

+<ESC> W ..........................................  52 

+<ESC> X ..........................................  63 

+<ESC> X ..........................................  63 

+<ESC> Y ..........................................  33 

+<ESC> Z ..........................................  53 

+<ESC> \ ..........................................  40 

+<ESC> ^ ..........................................  44 

+<ESC> _ ..........................................  41 

+<ESC> ` ..........................................  58 

+<ESC> a ..........................................  58 

+<ESC> b ..........................................  55 

+<ESC> c ..........................................  60 

+<ESC> d ..........................................  55 

+<ESC> e ..........................................  13 

+<ESC> e ..........................................  60 

+<ESC> e ..........................................  61 

+<ESC> j ..........................................  52 

+<ESC> m ..........................................  34 

+<ESC> n ..........................................  35 

+<ESC> o ..........................................  36 

+<ESC> q ..........................................  34 

+<ESC> r ..........................................  35 

+<ESC> s ..........................................  38 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> v ..........................................  34 

+<ESC> w ..........................................  35 

+<ESC> x 1 ........................................  56 

+<ESC> x 4 ........................................  56 

+<ESC> y ..........................................  33 

+<ESC> z ..........................................  28 

+<ESC> z ..........................................  53 

+<ESC> { ..........................................  8 

+<ESC> | ..........................................  39 

+<ESC> } ..........................................  8 

+<ESC> ~ ..........................................  43 

+<HOME> ...........................................  32 

+<LEFT> ...........................................  32 

+<LF> .............................................  14 

+<LOCESC> .........................................  60 

+<RETURN> .........................................  31 

+<RIGHT> ..........................................  32 

+<SHIFT CE> .......................................  31 

+<SHIFT CTRL HOME> ................................  32 

+<SHIFT CTRL HOME> ................................  51 

+<SHIFT HOME> .....................................  32 

+<SHIFT RETURN> ...................................  31 

+<TAB> ............................................  31 

+<UP> .............................................  31 

+XOFF .............................................  49 

+XON ..............................................  49 

diff --git a/system/ruc-terminal/unknown/doc/TTAB.PRT b/system/ruc-terminal/unknown/doc/TTAB.PRT
new file mode 100644
index 0000000..e8333d5
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TTAB.PRT
@@ -0,0 +1,510 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 64)##type ("elite")# 

+#page (64)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("A.", "Anhang A - ASCII Tabelle, Zeichensätze, Parameter")# 

+ 

+ 

+              Winkel Cur- Byteparameter 

+Dez Hex ASCII  Grad  sor  4    5    6 Taste(n)             Graphikzeichen 

+#linie ("16.0")# 

+  0 00  NUL       0       0    0    0  <SHIFT CTRL @> 

+  1 01  SOH       5       1    1    1  <CTRL A> 

+  2 02  STX      10       2    2    2  <CTRL B> 

+  3 03  ETX      15       3    3    3  <CTRL C> 

+  4 04  EOT      20       4    4    4  <CTRL D> 

+  5 05  ENQ      25       5    5    5  <CTRL E> 

+  6 06  ACK      30       6    6    6  <CTRL F> 

+  7 07  BEL      35       7    7    7  <CTRL G> 

+  8 08  BS       40       8    8    8  <BACKSPACE>  <== 

+  9 09  HT       45       9    9    9  <TAB> 

+ 10 0A  LF       50      10   10   10  <CTRL J> Apple: <DOWN> 

+ 11 0B  VT       55      11   11   11  <CTRL K> Apple: <UP> 

+ 12 0C  FF       60      12   12   12  <CTRL L> TVI: <RIGHT> 

+ 13 0D  CR       65      13   13   13  <RETURN> 

+ 14 0E  SO       70      14   14   14  <CTRL N> 

+ 15 0F  SI       75      15   15   15  <CTRL O> 

+ 16 10  DLE      80       0   16   16  <CTRL P> 

+ 17 11  DC1 XON  85       1   17   17  <CTRL Q> 

+ 18 12  DC2      90       2   18   18  <CTRL R> 

+ 19 13  DC3 XOFF 95       3   19   19  <CTRL S> 

+ 20 14  DC4     100       4   20   20  <CTRL T> 

+ 21 15  NAK     105       5   21   21  ==>   Apple: <RIGHT> 

+ 22 16  SYN     110       6   22   22  <CTRL V> 

+ 23 17  ETB     115       7   23   23  <CTRL W> 

+ 24 18  CAN     120       8   24   24  <CTRL X> <CE> 

+ 25 19  EM      125       9   25   25  <CTRL Y> 

+ 26 1A  SUB     130      10   26   26  <CTRL Z> TVI: <CLEAR> 

+ 27 1B  ESC     135      11   27   27  <ESC> 

+ 28 1C  FS      140      12   28   28  <CTRL \> 

+ 29 1D  GS      145      13   29   29  <CTRL ]> 

+ 30 1E  RS      150      14   30   30  <CTRL ^> TVI: <HOME> 

+ 31 1F  US      155      15   31   31  <CTRL _> TVI: <SHIFT RETURN> 

+ 32 20  SPACE   160   0   0    0   32  <SPACE> 

+ 33 21  !       165   1   1    1   33  ! 

+ 34 22  "       170   2   2    2   34  " 

+ 35 23  #       175   3   3    3   35  # 

+ 36 24  $       180   4   4    4   36  $ 

+ 37 25  %       185   5   5    5   37  % 

+ 38 26  &       190   6   6    6   38  & 

+ 39 27  '       195   7   7    7   39  ' 

+ 40 28  (       200   8   8    8   40  ( 

+ 41 29  )       205   9   9    9   41  ) 

+ 42 2A  *       210  10  10   10   42  * 

+ 43 2B  +       215  11  11   11   43  + 

+ 44 2C  ,       220  12  12   12   44  , 

+ 45 2D  -       225  13  13   13   45  - 

+ 46 2E  .       230  14  14   14   46  . 

+ 47 2F  /       235  15  15   15   47  / 

+ 48 30  0       240  16   0   16   48  0 

+ 49 31  1       245  17   1   17   49  1 

+ 50 32  2       250  18   2   18   50  2 

+ 51 33  3       255  19   3   19   51  3 

+ 52 34  4       260  20   4   20   52  4 

+ 53 35  5       265  21   5   21   53  5 

+ 54 36  6       270  22   6   22   54  6 

+ 55 37  7       275  23   7   23   55  7 

+ 56 38  8       280  24   8   24   56  8 

+ 57 39  9       285  25   9   25   57  9 

+ 58 3A  :       290  26  10   26   58  : 

+ 59 3B  ;       295  27  11   27   59  ; 

+ 60 3C  <       300  28  12   28   60  < 

+ 61 3D  =       305  29  13   29   61  = 

+ 62 3E  >       310  30  14   30   62  > 

+ 63 3F  ?       315  31  15   31   63  ? 

+ 64 40  @       320  32   0    0    0  @ 

+ 65 41  A       325  33   1    1    1  A 

+ 66 42  B       330  34   2    2    2  B 

+ 67 43  C       335  35   3    3    3  C 

+ 68 44  D       340  36   4    4    4  D 

+ 69 45  E       345  37   5    5    5  E 

+ 70 46  F       350  38   6    6    6  F 

+ 71 47  G       355  39   7    7    7  G 

+ 72 48  H         0  40   8    8    8  H 

+ 73 49  I         5  41   9    9    9  I 

+ 74 4A  J        10  42  10   10   10  J 

+ 75 4B  K        15  43  11   11   11  K 

+ 76 4C  L        20  44  12   12   12  L 

+ 77 4D  M        25  45  13   13   13  M 

+ 78 4E  N        30  46  14   14   14  N 

+ 79 4F  O        35  47  15   15   15  O 

+ 80 50  P        40  48   0   16   16  P 

+ 81 51  Q        45  49   1   17   17  Q 

+ 82 52  R        50  50   2   18   18  R 

+ 83 53  S        55  51   3   19   19  S 

+ 84 54  T        60  52   4   20   20  T 

+ 85 55  U        65  53   5   21   21  U 

+ 86 56  V        70  54   6   22   22  V 

+ 87 57  W        75  55   7   23   23  W 

+ 88 58  X        80  56   8   24   24  X 

+ 89 59  Y        85  57   9   25   25  Y 

+ 90 5A  Z        90  58  10   26   26  Z 

+ 91 5B  [   Ä    95  59  11   27   27  [ 

+ 92 5C  \   Ö   100  60  12   28   28  \ 

+ 93 5D  ]   Ü   105  61  13   29   29  ] 

+ 94 5E  ^       110  62  14   30   30  ^ 

+ 95 5F  _       115  63  15   31   31  _ 

+ 96 60  `       120  64   0    0   32  ` 

+ 97 61  a       125  65   1    1   33  a 

+ 98 62  b       130  66   2    2   34  b 

+ 99 63  c       135  67   3    3   35  c 

+100 64  d       140  68   4    4   36  d 

+101 65  e       145  69   5    5   37  e 

+102 66  f       150  70   6    6   38  f 

+103 67  g       155  71   7    7   39  g 

+104 68  h       160  72   8    8   40  h 

+105 69  i       165  73   9    9   41  i 

+106 6A  j       170  74  10   10   42  j 

+107 6B  k       175  75  11   11   43  k 

+108 6C  l       180  76  12   12   44  l 

+109 6D  m       185  77  13   13   45  m 

+110 6E  n       190  78  14   14   46  n 

+111 6F  o       195  79  15   15   47  o 

+112 70  p       200       0   16   48  p 

+113 71  q       205       1   17   49  q 

+114 72  r       210       2   18   50  r 

+115 73  s       215       3   19   51  s 

+116 74  t       220       4   20   52  t 

+117 75  u       225       5   21   53  u 

+118 76  v       230       6   22   54  v 

+119 77  w       235       7   23   55  w 

+120 78  x       240       8   24   56  x 

+121 79  y       245       9   25   57  y 

+122 7A  z       250      10   26   58  z 

+123 7B  {   ä   255      11   27   59  { 

+124 7C  |   ö   260      12   28   60  | 

+125 7D  }   ü   265      13   29   61  } 

+126 7E  ~   ß   270      14   30   62  ~ 

+127 7F  DEL     275      15   31   63  <DELETE> 

+128 80  * NUL   280       0    0    0 

+129 81  * SOH   285       1    1    1  <SHIFT DELETE> 

+130 82  * STX   290       2    2    2  <SHIFT TOPLEFT> # 

+131 83  * ETX   295       3    3    3  <SHIFT TOPRIGHT> # 

+132 84  * EOT   300       4    4    4 

+133 85  * ENQ   305       5    5    5 

+134 86  * ACK   310       6    6    6 

+135 87  * BEL   315       7    7    7 

+136 88  * BS    320       8    8    8  <LEFT> # 

+137 89  * HT    325       9    9    9  <SHIFT TAB> # 

+138 8A  * LF    330      10   10   10  <DOWN> # 

+139 8B  * VT    335      11   11   11  <UP> # 

+140 8C  * FF    340      12   12   12 

+141 8D  * CR    345      13   13   13  <SHIFT RETURN> # 

+142 8E  * SO    350      14   14   14  <TOPLEFT> # 

+143 8F  * SI    355      15   15   15  <TOPRIGHT> # 

+144 90  * DLE     0       0   16   16 

+145 91  * DC1     5       1   17   17 

+146 92  * DC2    10       2   18   18 

+147 93  * DC3    15       3   19   19 

+148 94  * DC4    20       4   20   20 

+149 95  * NAK    25       5   21   21  <RIGHT> # 

+150 96  * SYN    30       6   22   22 

+151 97  * ETB    35       7   23   23 

+152 98  * CAN    40       8   24   24 

+153 99  * EM     45       9   25   25 

+154 9A  * SUB    50      10   26   26 

+155 9B  * ESC    55      11   27   27  <SHIFT ESC> 

+156 9C  * FS     60      12   28   28 

+157 9D  * GS     65      13   29   29 

+158 9E  * RS     70      14   30   30 

+159 9F  * US     75      15   31   31 

+160 A0  * SPACE  80       0    0   32 

+161 A1  * !      85       1    1   33  <CTRL F1> 

+162 A2  * "      90       2    2   34  <CTRL F2> 

+163 A3  * #      95       3    3   35  <CTRL F3> 

+164 A4  * $     100       4    4   36  <CTRL F4> 

+165 A5  * %     105       5    5   37  <CTRL F5> 

+166 A6  * &     110       6    6   38  <CTRL F6> 

+167 A7  * '     115       7    7   39  <CTRL F7> 

+168 A8  * (     120       8    8   40  <CTRL F8> 

+169 A9  * )     125       9    9   41  <CTRL F9> 

+170 AA  * *     130      10   10   42  <CTRL F10> 

+171 AB  * +     135      11   11   43  <CTRL F11> 

+172 AC  * ,     140      12   12   44  <CTRL F12> 

+173 AD  * -     145      13   13   45  <CTRL F13> 

+174 AE  * .     150      14   14   46  <CTRL F14> 

+175 AF  * /     155      15   15   47  <CTRL F15> 

+176 B0  * 0     160       0   16   48 

+177 B1  * 1     165       1   17   49  <SHIFT CTRL F1> 

+178 B2  * 2     170       2   18   50  <SHIFT CTRL F2> 

+179 B3  * 3     175       3   19   51  <SHIFT CTRL F3> 

+180 B4  * 4     180       4   20   52  <SHIFT CTRL F4> 

+181 B5  * 5     185       5   21   53  <SHIFT CTRL F5> 

+182 B6  * 6     190       6   22   54  <SHIFT CTRL F6> 

+183 B7  * 7     195       7   23   55  <SHIFT CTRL F7> 

+184 B8  * 8     200       8   24   56  <SHIFT CTRL F8> 

+185 B9  * 9     205       9   25   57  <SHIFT CTRL F9> 

+186 BA  * :     210      10   26   58  <SHIFT CTRL F10> 

+187 BB  * ;     215      11   27   59  <SHIFT CTRL F11> 

+188 BC  * <     220      12   28   60  <SHIFT CTRL F12> 

+189 BD  * =     225      13   29   61  <SHIFT CTRL F13> 

+190 BE  * >     230      14   30   62  <SHIFT CTRL F14> 

+191 BF  * ?     235      15   31   63  <SHIFT CTRL F15> 

+192 C0  * @     240       0    0    0 

+193 C1  * A     245       1    1    1  <F1> # 

+194 C2  * B     250       2    2    2  <F2> # 

+195 C3  * C     255       3    3    3  <F3> # 

+196 C4  * D     260       4    4    4  <F4> # 

+197 C5  * E     265       5    5    5  <F5> # 

+198 C6  * F     270       6    6    6  <F6> # 

+199 C7  * G     275       7    7    7  <F7> # 

+200 C8  * H     280       8    8    8  <F8> # 

+201 C9  * I     285       9    9    9  <F9> # 

+202 CA  * J     290      10   10   10  <F10> # 

+203 CB  * K     295      11   11   11  <F11> # 

+204 CC  * L     300      12   12   12  <F12> # 

+205 CD  * M     305      13   13   13  <F13> # 

+206 CE  * N     310      14   14   14  <F14> # 

+207 CF  * O     315      15   15   15  <F15> # 

+208 D0  * P     320       0   16   16  <SHIFT HOME> # 

+209 D1  * Q     325       1   17   17  <SHIFT F1> # 

+210 D2  * R     330       2   18   18  <SHIFT F2> # 

+211 D3  * S     335       3   19   19  <SHIFT F3> # 

+212 D4  * T     340       4   20   20  <SHIFT F4> # 

+213 D5  * U     345       5   21   21  <SHIFT F5> # 

+214 D6  * V     350       6   22   22  <SHIFT F6> # 

+215 D7  * W     355       7   23   23  <SHIFT F7> # 

+216 D8  * X       0       8   24   24  <SHIFT F8> # 

+217 D9  * Y       5       9   25   25  <SHIFT F9> # 

+218 DA  * Z      10      10   26   26  <SHIFT F10> # 

+219 DB  * [ * Ä  15      11   27   27  <SHIFT F11> # 

+220 DC  * \ * Ö  20      12   28   28  <SHIFT F12> # 

+221 DD  * ] * Ü  25      13   29   29  <SHIFT F13> # 

+222 DE  * ^      30      14   30   30  <SHIFT F14> # 

+223 DF  * _      35      15   31   31  <SHIFT F15> # 

+224 E0  * `      40       0    0   32 

+225 E1  * a      45       1    1   33  <SHIFT NUM1> # 

+226 E2  * b      50       2    2   34  <SHIFT NUM2> # 

+227 E3  * c      55       3    3   35  <SHIFT NUM3> # 

+228 E4  * d      60       4    4   36  <SHIFT NUM4> # 

+229 E5  * e      65       5    5   37  <SHIFT NUM5> # 

+230 E6  * f      70       6    6   38  <SHIFT NUM6> # 

+231 E7  * g      75       7    7   39  <SHIFT NUM7> # 

+232 E8  * h      80       8    8   40  <SHIFT NUM8> # 

+233 E9  * i      85       9    9   41  <SHIFT NUM9> # 

+234 EA  * j      90      10   10   42  <SHIFT NUM0> # 

+235 EB  * k      95      11   11   43  <SHIFT NUM.> # 

+236 EC  * l     100      12   12   44  <SHIFT NUM+> # 

+237 ED  * m     105      13   13   45  <SHIFT NUM-> # 

+238 EE  * n     110      14   14   46 

+239 EF  * o     115      15   15   47  <SHIFT BOTRIGHT> # 

+240 F0  * p     120       0   16   48 

+241 F1  * q     125       1   17   49 

+242 F2  * r     130       2   18   50 

+243 F3  * s     135       3   19   51 

+244 F4  * t     140       4   20   52 

+245 F5  * u     145       5   21   53 

+246 F6  * v     150       6   22   54 

+247 F7  * w     155       7   23   55 

+248 F8  * x     160       8   24   56 

+249 F9  * y     165       9   25   57 

+250 FA  * z     170      10   26   58 

+251 FB  * { * ä 175      11   27   59 

+252 FC  * | * ö 180      12   28   60 

+253 FD  * } * ü 185      13   29   61 

+254 FE  * ~ * ß 190      14   30   62 

+255 FF  * DEL   195      15   31   63 

+ 

+Beim Apple-Keyboard können alle Codes > 127 auch mit der Open-Apple Taste

+und einem ASCII-Zeichen zusammen erzeugt werden. 

+Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. 

+Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers

+dargestellt. 

+ 

+#page# 

+#h("B.", "Anhang B - Befehlsübersicht")# 

+ 

+ 

+#on("u")#Controlkommandos:#off("u")# 

+ 

+Hex ASCII Taste(n)                      Funktion 

+#linie ("16.0")# 

+07  BEL  <CTRL G>                       Signalton 

+08  BS   <BACKSPACE>  <==               Backspace, Cursor Left 

+09  HT   <TAB>                          Tabulator, 8 Spalten 

+0A  LF   <CTRL J> Apple: <DOWN>         Zeilenvorschub, ggf. Scroll/Page 

+0B  VT   <CTRL K> Apple: <UP>           Cursor hoch 

+0C  FF   <CTRL L> TVI: <RIGHT>          Cursor rechts 

+0D  CR   <RETURN>                       Waagenrücklauf, ohne Linefeed 

+0E  SO   <CTRL N>                       XON/XOFF Protokoll ausschalten 

+0F  SI   <CTRL O>                       XON/XOFF Protokoll einschalten 

+11  DC1  <CTRL Q>                       XON 

+13  DC3  <CTRL S>                       XOFF 

+15  NAK  <CTRL U> ==> Apple: <RIGHT>    Cursor rechts 

+16  SYN  <CTRL V>                       Cursor runter (ohne Scroll/Page) 

+17  CAN  <CTRL X> <CE>                  Graphikmodus: Fadenkreuz an/aus 

+1A  SUB  <CTRL Z> TVI: <CLEAR>          Bildschirm löschen & Cursor Home 

+1B  ESC  <ESC>                          Escape-Sequenz einleiten 

+1E  RS   <CTRL ^> TVI: <HOME>           Cursor Home 

+1F  US   <CTRL _> TVI: <SHIFT RETURN>   Zum nächsten Zeilenanfang, ggf.

+                                        Scroll/Page 

+ 

+ 

+Escape-Sequenzen, thematisch sortiert 

+------------------------------------- 

+ 

+a.) Betriebsmodi: 

+ 

+ESC $                 Graphikmodus einschalten 

+ESC %                 Textmodus einschalten 

+ESC H                 Autoscroll/Pagemode 

+ESC U                 Monitormode einschalten 

+ESC X                 Monitormode/Hexmode ausschalten 

+ESC c                 Funktionstastencode/Funktionstastenstring 

+ESC u                 Hexmode ein-/ausschalten, Monitormode ausschalten 

+ 

+ 

+b.) Editkommandos 

+ 

+ESC *                 Text oder Graphikbildschirm löschen und Cursor Home 

+ESC +                                        " 

+ESC ,                                        " 

+ESC :                                        " 

+ESC E                 Zeile einfügen (im Textmodus) 

+ESC I                 Rückwärtstabulator (8 Spalten, im Textmodus) 

+ESC L                 Zeile einfügen (im Textmodus) 

+ESC M                 Zeile löschen (im Textmodus) 

+ESC Q                 Zeichen einfügen (im Textmodus) 

+ESC R                 Zeile löschen (im Textmodus) 

+ESC T                 Zeile ab Cursorposition bis zum Zeilenende löschen 

+ESC W                 Zeichen löschen (im Textmodus) 

+ESC Y                 Seite ab Cursorposition bis zum Seitenende löschen 

+ESC j                 Umgekehrter Zeilenvorschub 

+ESC t                 Zeile ab Cursor bis Zeilenende löschen (im Textmodus) 

+ 

+ 

+c.) Sendekommandos 

+ 

+ESC -                 Farbe, Zustand, In-Window-Bit bei Cursorpos senden 

+ESC 4                 Nummer der sichtbaren und der Arbeitsseite senden 

+ESC 5                 Graphikparameter (Dicke,Farbe,Bitverknüpfung) senden 

+ESC 6                 Aktuelle Textzeile senden 

+ESC 7                 Ganze Textseite senden 

+ESC 8                 Zeichen an der Cursorposition senden 

+ESC \ <ll><lh><al><ah>Aktuelle Graphikseite senden (oder Teile) 

+ESC ;                 Position des Graphikcursors senden 

+ESC ?                 Position des Textcursors senden 

+ESC _                 Graphikbyte bei Graphikcursorposition senden 

+ESC x 1 <l><m>        Zeilenbegrenzer für <ESC> 6 und <ESC> 7 einstellen 

+ESC x 4 <p>           Seitenbegrenzer für <ESC> 7 einstellen 

+ 

+ 

+d.) Übertragungskommandos 

+ 

+ESC SPACE SPACE <p>   Baudrate, Stopbits, Datenbits, Parity einstellen 

+ESC SPACE 0           Basis/Apple Keyboardcodes, keine Emulation 

+ESC SPACE 1           TVI - Emulation 

+ESC SPACE 2           Keine Hardware Flußkontrolle 

+ESC SPACE 3           RTS/CTS Flußkontrolle 

+ESC SPACE 4           DTR/DSR Flußkontrolle 

+ESC SPACE 5           RTS/CTS und DTR/DSR Flußkontrolle 

+ESC SPACE 6           8. Datenbit ist 0 

+ESC SPACE 7           8. Datenbit vorhanden 

+ESC D L               Local-Modus 

+ESC D E               Online-Modus mit Echo 

+ESC D O               Online-Modus ohne Echo 

+ 

+ 

+e.) Bildschirm/Druckerausgabe 

+ 

+ESC @                 Empfangsdaten auf Drucker ausgeben 

+ESC A                 Empfangsdaten nicht auf Drucker ausgeben 

+ESC P                 Hardcopy der Textseite 

+ESC ^ <p>             Hardcopy der aktuellen Graphikseite 

+ESC `                 Empfangsdaten nicht auf dem Bildschirm anzeigen 

+ESC a                 Empfangsdaten auf dem Bildschirm anzeigen 

+ESC ~ <n><l><p.>      Definition d.Druckertreiberstrings f.Graphikhardcopy 

+ 

+ 

+f.) Cursor/Cursor Adressierung 

+ 

+ESC . 0               Cursor aus 

+ESC . 1               Cursor blinkend 

+ESC . 2               Cursor an, nicht blinkend 

+ESC = <y+32><x+32>    Cursor auf Adresse positionieren 

+ESC Z                 Cursor an/aus 

+ 

+ 

+g.) Attribute 

+ 

+ESC (                 Normale Zeichen 

+ESC )                 Textmodus: Inversschrift, Graphik: Kursivschrift 

+ESC G 0               Normale Schrift 

+ESC G 1               Unsichtbare Schrift, Leerzeichen 

+ESC G 4               Inverse Schrift 

+ESC G 5               Unsichtbare Schrift, inverse Leerzeichen 

+ESC b                 Schwarze Schrift auf hellem Grund (nur im Textmodus) 

+ESC d                 Helle Schrift auf dunklem Grund, (nur im Textmodus) 

+ESC z <n>             Zeichensatz einstellen 

+ 

+ 

+h.) Text in Graphiken 

+ 

+ESC &                 Graphikzeichen ersetzen darunterliegende 

+ESC '                 Graphikzeichen überschreiben darunterliegende 

+ESC N <b><h><w>       Zeichenbreite, -höhe und Schreibrichtung einstellen 

+ 

+ 

+i.) Graphikzeichenkommandos 

+ 

+ESC J <b, h;>         Relatives Rechteck zeichnen 

+ESC K <r, s;>         Kreis(segmente) mit dem Radius <r> zeichnen 

+ESC m <x, y;>         Absoluten Punkt bei (x, y) zeichnen 

+ESC n <l, w;>         Turtle Draw/Move <l> ist Länge, <w> ist Winkel 

+ESC o                 Turtle Penup/Pendown 

+ESC q <x, y;>         Relativer Move 

+ESC r <x, y;>         Relativer Draw 

+ESC s <xr,yr,aw,ew;>  Ellipsenbogen(Radien xr,yr) v.<aw> bis <ew> zeichnen 

+ESC v <x, y;>         Absoluter Move nach (x, y) 

+ESC w <x, y;>         Absoluter Draw nach (x, y) 

+ 

+ 

+j.) Verschiede Graphikkommandos 

+ 

+ESC ! <p>             Graphikseiten mischen, kopieren, trennen, invertieren 

+ESC / <ll><lh><al><ah><p...> Graphikseite vom Host laden 

+ESC O 0               Graphikparameter auf Default 

+ESC O 1 <d>           Strichdicke setzen 

+ESC O 2 <f>           Farbe/Helligkeit einstellen 

+ESC O 3 <p>           Linientyp (Punkt/Strichmuster) einstellen 

+ESC O 4 <p>           Bitverknüpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) 

+ESC O 5 <p>           Farbe, Dicke, Bitverknüpfung zusammen einstellen 

+ESC O 6 <pl><ph>      Benutzerdefinierbares Linienmuster einstellen 

+ESC O 7 <p>           Arbeitsseite, sichtbare Seite u.Mixedmode einstellen 

+ESC O 8 <p>           Turtle Penup/Pendown und Eraser/Drawer einstellen 

+ESC O 9               Turtle Bildmitte, Richtung nach oben, Pendown, Drawer 

+ESC O : <b1..b8>      Benutzerdefinierbares Füllmuster einstellen 

+ESC y                 Graphikseite löschen und Cursor nach (0, 0) 

+ESC | <n>             Fläche füllen/löschen mit dem Muster Nummer <n> 

+ 

+ 

+k.) Verschiedene und spezielle Funktionen 

+ 

+ESC 0                 Terminalprogramm initialisieren (Softwarereset) 

+ESC 9 <d>             Zeitverzögerung ca. <d> * 2 ms 

+ESC <                 Keyboardclick ausschalten 

+ESC >                 Keyboardclick einschalten 

+ESC F <c>             Controlcharacter darstellen 

+ESC e <d...><t>       Funktionstaste <t> mit Daten <d...> belegen 

+ESC {                 Statuszeile aus (24. Textzeile sichtbar) 

+ESC }                 Statuszeile an (24. Textzeile unsichtbar) 

+ESC S <n>             Graphik/Textseite von/auf Diskette laden/speichern 

+ESC DEL 1             Tastenbelegungen löschen 

+ESC DEL 2             Druckerpuffer löschen 

+ESC DEL 3             Empfangspuffer löschen 

+ESC DEL 4             Sendepuffer löschen 

+ 

+#page# 

+#h("C.", "Anhang C - Default Funktionstastenbelegungen")# 

+ 

+ 

+Bemerkung zur Schreibweise: 

+<#40> bezeichnet den ASCII-Code für '(', also den ASCII-Code 40 (dezimal). 

+<LESC> bezeichnet den Code Hex 9B für Local Escape, damit diese Tastenfunk-

+tionen sowohl im Local- als auch im Onlinemodus ausgeführt werden können. 

+ 

+a.) Zehnerblock mit <SHIFT> 

+ 

+Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht

+Richtungen. Die Taste <SHIFT 5> zeigt nur das Fadenkreuz, d.h. die Position

+des Graphikcursors bleibt unverändert. Bei allen anderen Zifferntasten än-

+dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz

+sichtbar. Bis auf die Help-Taste <SHIFT F4> können alle Tasten auch im On-

+line-Modus aufgerufen werden. 

+ 

+Die Tastenbelegungen im einzelnen: 

+ 

+Taste    Hex-Code Code-Sequenz 

+#linie ("16.0")# 

+<SHIFT 1>  E1  <LESC> q-1,-1; <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 2>  E2  <LESC> q0,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 3>  E3  <LESC> q1,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 4>  E4  <LESC> q-1,0;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 5>  E5  <LESC> <CTRL X><LESC> 9 <#127> <LESC> <CTRL X> 

+<SHIFT 6>  E6  <LESC> q1,0;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 7>  E7  <LESC> q-1,1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 8>  E8  <LESC> q0,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 9>  E9  <LESC> q1,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+ 

+Terminalinitialisierung mit <SHIFT BOTTOMRIGHT>: 

+            EF  (Cursorpositionierung und Einschaltmeldung) 

+ 

+ 

+b.) Die Funktionstasten mit <SHIFT> 

+ 

+Taste    Hex-Code Code-Sequenz                     Bedeutung 

+#linie ("16.0")# 

+<SHIFT F1>  D1  <LESC> $ <LESC> O70                Graphikseite 1 

+<SHIFT F2>  D2  <LESC> $ <LESC> O73                Graphikseite 2 

+<SHIFT F3>  D3  <LESC> %                           Textseite 

+<SHIFT F4>  D4  <ESC>SW<#26> H e l p s c r e e n (a..f): <ESC>S<#81> 

+                <ESC>9<#81> <ESC>SG                Help-Bilschirm anzeigen 

+<SHIFT F8>  D8  <LESC> O41                         Linien schwarz (löschen) 

+<SHIFT F9>  D9  <LESC> O40                         Linien weiß (sichtbar) 

+<SHIFT F10> DA  <LESC> O12 <LESC> N <#12><#20><#0> Große und dicke Schrift 

+<SHIFT F11> DB  <LESC> O11 <LESC> N <#0><#0><#0>   Normal dünne Schrift 

+<SHIFT F12> DC  <LESC> G4                          Kursiv/Invers an 

+<SHIFT F13> DD  <LESC> G0                          Kursiv/Invers aus 

+<SHIFT F14> DE  <LESC> ^0                          Graphikhardcopy 

+<SHIFT F15> DF  <LESC> P                           Texthardcopy 

+ 

diff --git a/system/ruc-terminal/unknown/doc/TTABP.PRT b/system/ruc-terminal/unknown/doc/TTABP.PRT
new file mode 100644
index 0000000..f5b9b57
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TTABP.PRT
@@ -0,0 +1,666 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 64)##type ("elite")# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+              Winkel Cur- Byteparameter 

+Dez Hex ASCII  Grad  sor  4    5    6 Taste(n)             Graphikzeichen 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+  0 00  NUL       0       0    0    0  <SHIFT CTRL @> 

+  1 01  SOH       5       1    1    1  <CTRL A> 

+  2 02  STX      10       2    2    2  <CTRL B> 

+  3 03  ETX      15       3    3    3  <CTRL C> 

+  4 04  EOT      20       4    4    4  <CTRL D> 

+  5 05  ENQ      25       5    5    5  <CTRL E> 

+  6 06  ACK      30       6    6    6  <CTRL F> 

+  7 07  BEL      35       7    7    7  <CTRL G> 

+  8 08  BS       40       8    8    8  <BACKSPACE>  <== 

+  9 09  HT       45       9    9    9  <TAB> 

+ 10 0A  LF       50      10   10   10  <CTRL J> Apple: <DOWN> 

+ 11 0B  VT       55      11   11   11  <CTRL K> Apple: <UP> 

+ 12 0C  FF       60      12   12   12  <CTRL L> TVI: <RIGHT> 

+ 13 0D  CR       65      13   13   13  <RETURN> 

+ 14 0E  SO       70      14   14   14  <CTRL N> 

+ 15 0F  SI       75      15   15   15  <CTRL O> 

+ 16 10  DLE      80       0   16   16  <CTRL P> 

+ 17 11  DC1 XON  85       1   17   17  <CTRL Q> 

+ 18 12  DC2      90       2   18   18  <CTRL R> 

+ 19 13  DC3 XOFF 95       3   19   19  <CTRL S> 

+ 20 14  DC4     100       4   20   20  <CTRL T> 

+ 21 15  NAK     105       5   21   21  ==>   Apple: <RIGHT> 

+ 22 16  SYN     110       6   22   22  <CTRL V> 

+ 23 17  ETB     115       7   23   23  <CTRL W> 

+ 24 18  CAN     120       8   24   24  <CTRL X> <CE> 

+ 25 19  EM      125       9   25   25  <CTRL Y> 

+ 26 1A  SUB     130      10   26   26  <CTRL Z> TVI: <CLEAR> 

+ 27 1B  ESC     135      11   27   27  <ESC> 

+ 28 1C  FS      140      12   28   28  <CTRL \> 

+ 29 1D  GS      145      13   29   29  <CTRL ]> 

+ 30 1E  RS      150      14   30   30  <CTRL ^> TVI: <HOME> 

+ 31 1F  US      155      15   31   31  <CTRL _> TVI: <SHIFT RETURN> 

+ 32 20  SPACE   160   0   0    0   32  <SPACE> 

+ 33 21  !       165   1   1    1   33  ! 

+ 34 22  "       170   2   2    2   34  " 

+ 35 23  #       175   3   3    3   35  # 

+ 36 24  $       180   4   4    4   36  $ 

+ 37 25  %       185   5   5    5   37  % 

+ 38 26  &       190   6   6    6   38  & 

+ 39 27  '       195   7   7    7   39  ' 

+ 40 28  (       200   8   8    8   40  ( 

+ 41 29  )       205   9   9    9   41  ) 

+ 42 2A  *       210  10  10   10   42  * 

+ 43 2B  +       215  11  11   11   43  + 

+ 44 2C  ,       220  12  12   12   44  , 

+ 45 2D  -       225  13  13   13   45  - 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#64 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 64 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+ 46 2E  .       230  14  14   14   46  . 

+ 47 2F  /       235  15  15   15   47  / 

+ 48 30  0       240  16   0   16   48  0 

+ 49 31  1       245  17   1   17   49  1 

+ 50 32  2       250  18   2   18   50  2 

+ 51 33  3       255  19   3   19   51  3 

+ 52 34  4       260  20   4   20   52  4 

+ 53 35  5       265  21   5   21   53  5 

+ 54 36  6       270  22   6   22   54  6 

+ 55 37  7       275  23   7   23   55  7 

+ 56 38  8       280  24   8   24   56  8 

+ 57 39  9       285  25   9   25   57  9 

+ 58 3A  :       290  26  10   26   58  : 

+ 59 3B  ;       295  27  11   27   59  ; 

+ 60 3C  <       300  28  12   28   60  < 

+ 61 3D  =       305  29  13   29   61  = 

+ 62 3E  >       310  30  14   30   62  > 

+ 63 3F  ?       315  31  15   31   63  ? 

+ 64 40  @       320  32   0    0    0  @ 

+ 65 41  A       325  33   1    1    1  A 

+ 66 42  B       330  34   2    2    2  B 

+ 67 43  C       335  35   3    3    3  C 

+ 68 44  D       340  36   4    4    4  D 

+ 69 45  E       345  37   5    5    5  E 

+ 70 46  F       350  38   6    6    6  F 

+ 71 47  G       355  39   7    7    7  G 

+ 72 48  H         0  40   8    8    8  H 

+ 73 49  I         5  41   9    9    9  I 

+ 74 4A  J        10  42  10   10   10  J 

+ 75 4B  K        15  43  11   11   11  K 

+ 76 4C  L        20  44  12   12   12  L 

+ 77 4D  M        25  45  13   13   13  M 

+ 78 4E  N        30  46  14   14   14  N 

+ 79 4F  O        35  47  15   15   15  O 

+ 80 50  P        40  48   0   16   16  P 

+ 81 51  Q        45  49   1   17   17  Q 

+ 82 52  R        50  50   2   18   18  R 

+ 83 53  S        55  51   3   19   19  S 

+ 84 54  T        60  52   4   20   20  T 

+ 85 55  U        65  53   5   21   21  U 

+ 86 56  V        70  54   6   22   22  V 

+ 87 57  W        75  55   7   23   23  W 

+ 88 58  X        80  56   8   24   24  X 

+ 89 59  Y        85  57   9   25   25  Y 

+ 90 5A  Z        90  58  10   26   26  Z 

+ 91 5B  [   Ä    95  59  11   27   27  [ 

+ 92 5C  \   Ö   100  60  12   28   28  \ 

+ 93 5D  ]   Ü   105  61  13   29   29  ] 

+ 94 5E  ^       110  62  14   30   30  ^ 

+ 95 5F  _       115  63  15   31   31  _ 

+ 96 60  `       120  64   0    0   32  ` 

+ 97 61  a       125  65   1    1   33  a 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 65 

+#page##--------------------------------- Ende der Seite 65 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+ 98 62  b       130  66   2    2   34  b 

+ 99 63  c       135  67   3    3   35  c 

+100 64  d       140  68   4    4   36  d 

+101 65  e       145  69   5    5   37  e 

+102 66  f       150  70   6    6   38  f 

+103 67  g       155  71   7    7   39  g 

+104 68  h       160  72   8    8   40  h 

+105 69  i       165  73   9    9   41  i 

+106 6A  j       170  74  10   10   42  j 

+107 6B  k       175  75  11   11   43  k 

+108 6C  l       180  76  12   12   44  l 

+109 6D  m       185  77  13   13   45  m 

+110 6E  n       190  78  14   14   46  n 

+111 6F  o       195  79  15   15   47  o 

+112 70  p       200       0   16   48  p 

+113 71  q       205       1   17   49  q 

+114 72  r       210       2   18   50  r 

+115 73  s       215       3   19   51  s 

+116 74  t       220       4   20   52  t 

+117 75  u       225       5   21   53  u 

+118 76  v       230       6   22   54  v 

+119 77  w       235       7   23   55  w 

+120 78  x       240       8   24   56  x 

+121 79  y       245       9   25   57  y 

+122 7A  z       250      10   26   58  z 

+123 7B  {   ä   255      11   27   59  { 

+124 7C  |   ö   260      12   28   60  | 

+125 7D  }   ü   265      13   29   61  } 

+126 7E  ~   ß   270      14   30   62  ~ 

+127 7F  DEL     275      15   31   63  <DELETE> 

+128 80  * NUL   280       0    0    0 

+129 81  * SOH   285       1    1    1  <SHIFT DELETE> 

+130 82  * STX   290       2    2    2  <SHIFT TOPLEFT> # 

+131 83  * ETX   295       3    3    3  <SHIFT TOPRIGHT> # 

+132 84  * EOT   300       4    4    4 

+133 85  * ENQ   305       5    5    5 

+134 86  * ACK   310       6    6    6 

+135 87  * BEL   315       7    7    7 

+136 88  * BS    320       8    8    8  <LEFT> # 

+137 89  * HT    325       9    9    9  <SHIFT TAB> # 

+138 8A  * LF    330      10   10   10  <DOWN> # 

+139 8B  * VT    335      11   11   11  <UP> # 

+140 8C  * FF    340      12   12   12 

+141 8D  * CR    345      13   13   13  <SHIFT RETURN> # 

+142 8E  * SO    350      14   14   14  <TOPLEFT> # 

+143 8F  * SI    355      15   15   15  <TOPRIGHT> # 

+144 90  * DLE     0       0   16   16 

+145 91  * DC1     5       1   17   17 

+146 92  * DC2    10       2   18   18 

+147 93  * DC3    15       3   19   19 

+148 94  * DC4    20       4   20   20 

+149 95  * NAK    25       5   21   21  <RIGHT> # 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#66 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 66 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+150 96  * SYN    30       6   22   22 

+151 97  * ETB    35       7   23   23 

+152 98  * CAN    40       8   24   24 

+153 99  * EM     45       9   25   25 

+154 9A  * SUB    50      10   26   26 

+155 9B  * ESC    55      11   27   27  <SHIFT ESC> 

+156 9C  * FS     60      12   28   28 

+157 9D  * GS     65      13   29   29 

+158 9E  * RS     70      14   30   30 

+159 9F  * US     75      15   31   31 

+160 A0  * SPACE  80       0    0   32 

+161 A1  * !      85       1    1   33  <CTRL F1> 

+162 A2  * "      90       2    2   34  <CTRL F2> 

+163 A3  * #      95       3    3   35  <CTRL F3> 

+164 A4  * $     100       4    4   36  <CTRL F4> 

+165 A5  * %     105       5    5   37  <CTRL F5> 

+166 A6  * &     110       6    6   38  <CTRL F6> 

+167 A7  * '     115       7    7   39  <CTRL F7> 

+168 A8  * (     120       8    8   40  <CTRL F8> 

+169 A9  * )     125       9    9   41  <CTRL F9> 

+170 AA  * *     130      10   10   42  <CTRL F10> 

+171 AB  * +     135      11   11   43  <CTRL F11> 

+172 AC  * ,     140      12   12   44  <CTRL F12> 

+173 AD  * -     145      13   13   45  <CTRL F13> 

+174 AE  * .     150      14   14   46  <CTRL F14> 

+175 AF  * /     155      15   15   47  <CTRL F15> 

+176 B0  * 0     160       0   16   48 

+177 B1  * 1     165       1   17   49  <SHIFT CTRL F1> 

+178 B2  * 2     170       2   18   50  <SHIFT CTRL F2> 

+179 B3  * 3     175       3   19   51  <SHIFT CTRL F3> 

+180 B4  * 4     180       4   20   52  <SHIFT CTRL F4> 

+181 B5  * 5     185       5   21   53  <SHIFT CTRL F5> 

+182 B6  * 6     190       6   22   54  <SHIFT CTRL F6> 

+183 B7  * 7     195       7   23   55  <SHIFT CTRL F7> 

+184 B8  * 8     200       8   24   56  <SHIFT CTRL F8> 

+185 B9  * 9     205       9   25   57  <SHIFT CTRL F9> 

+186 BA  * :     210      10   26   58  <SHIFT CTRL F10> 

+187 BB  * ;     215      11   27   59  <SHIFT CTRL F11> 

+188 BC  * <     220      12   28   60  <SHIFT CTRL F12> 

+189 BD  * =     225      13   29   61  <SHIFT CTRL F13> 

+190 BE  * >     230      14   30   62  <SHIFT CTRL F14> 

+191 BF  * ?     235      15   31   63  <SHIFT CTRL F15> 

+192 C0  * @     240       0    0    0 

+193 C1  * A     245       1    1    1  <F1> # 

+194 C2  * B     250       2    2    2  <F2> # 

+195 C3  * C     255       3    3    3  <F3> # 

+196 C4  * D     260       4    4    4  <F4> # 

+197 C5  * E     265       5    5    5  <F5> # 

+198 C6  * F     270       6    6    6  <F6> # 

+199 C7  * G     275       7    7    7  <F7> # 

+200 C8  * H     280       8    8    8  <F8> # 

+201 C9  * I     285       9    9    9  <F9> # 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 67 

+#page##--------------------------------- Ende der Seite 67 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+202 CA  * J     290      10   10   10  <F10> # 

+203 CB  * K     295      11   11   11  <F11> # 

+204 CC  * L     300      12   12   12  <F12> # 

+205 CD  * M     305      13   13   13  <F13> # 

+206 CE  * N     310      14   14   14  <F14> # 

+207 CF  * O     315      15   15   15  <F15> # 

+208 D0  * P     320       0   16   16  <SHIFT HOME> # 

+209 D1  * Q     325       1   17   17  <SHIFT F1> # 

+210 D2  * R     330       2   18   18  <SHIFT F2> # 

+211 D3  * S     335       3   19   19  <SHIFT F3> # 

+212 D4  * T     340       4   20   20  <SHIFT F4> # 

+213 D5  * U     345       5   21   21  <SHIFT F5> # 

+214 D6  * V     350       6   22   22  <SHIFT F6> # 

+215 D7  * W     355       7   23   23  <SHIFT F7> # 

+216 D8  * X       0       8   24   24  <SHIFT F8> # 

+217 D9  * Y       5       9   25   25  <SHIFT F9> # 

+218 DA  * Z      10      10   26   26  <SHIFT F10> # 

+219 DB  * [ * Ä  15      11   27   27  <SHIFT F11> # 

+220 DC  * \ * Ö  20      12   28   28  <SHIFT F12> # 

+221 DD  * ] * Ü  25      13   29   29  <SHIFT F13> # 

+222 DE  * ^      30      14   30   30  <SHIFT F14> # 

+223 DF  * _      35      15   31   31  <SHIFT F15> # 

+224 E0  * `      40       0    0   32 

+225 E1  * a      45       1    1   33  <SHIFT NUM1> # 

+226 E2  * b      50       2    2   34  <SHIFT NUM2> # 

+227 E3  * c      55       3    3   35  <SHIFT NUM3> # 

+228 E4  * d      60       4    4   36  <SHIFT NUM4> # 

+229 E5  * e      65       5    5   37  <SHIFT NUM5> # 

+230 E6  * f      70       6    6   38  <SHIFT NUM6> # 

+231 E7  * g      75       7    7   39  <SHIFT NUM7> # 

+232 E8  * h      80       8    8   40  <SHIFT NUM8> # 

+233 E9  * i      85       9    9   41  <SHIFT NUM9> # 

+234 EA  * j      90      10   10   42  <SHIFT NUM0> # 

+235 EB  * k      95      11   11   43  <SHIFT NUM.> # 

+236 EC  * l     100      12   12   44  <SHIFT NUM+> # 

+237 ED  * m     105      13   13   45  <SHIFT NUM-> # 

+238 EE  * n     110      14   14   46 

+239 EF  * o     115      15   15   47  <SHIFT BOTRIGHT> # 

+240 F0  * p     120       0   16   48 

+241 F1  * q     125       1   17   49 

+242 F2  * r     130       2   18   50 

+243 F3  * s     135       3   19   51 

+244 F4  * t     140       4   20   52 

+245 F5  * u     145       5   21   53 

+246 F6  * v     150       6   22   54 

+247 F7  * w     155       7   23   55 

+248 F8  * x     160       8   24   56 

+249 F9  * y     165       9   25   57 

+250 FA  * z     170      10   26   58 

+251 FB  * { * ä 175      11   27   59 

+252 FC  * | * ö 180      12   28   60 

+253 FD  * } * ü 185      13   29   61 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#68 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 68 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+254 FE  * ~ * ß 190      14   30   62 

+255 FF  * DEL   195      15   31   63 

+ 

+Beim Apple-Keyboard können alle Codes > 127 auch mit der Open-Apple Taste

+und einem ASCII-Zeichen zusammen erzeugt werden. 

+Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. 

+Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers

+dargestellt. 

+ 

+#text end#

+#free(18.22685)#

+ 

+ 

+ 69 

+#page##--------------------------------- Ende der Seite 69 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#B.  Anhang B - Befehlsübersicht#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#on("u")#Controlkommandos:#off("u")# 

+ 

+Hex ASCII Taste(n)                      Funktion 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+07  BEL  <CTRL G>                       Signalton 

+08  BS   <BACKSPACE>  <==               Backspace, Cursor Left 

+09  HT   <TAB>                          Tabulator, 8 Spalten 

+0A  LF   <CTRL J> Apple: <DOWN>         Zeilenvorschub, ggf. Scroll/Page 

+0B  VT   <CTRL K> Apple: <UP>           Cursor hoch 

+0C  FF   <CTRL L> TVI: <RIGHT>          Cursor rechts 

+0D  CR   <RETURN>                       Waagenrücklauf, ohne Linefeed 

+0E  SO   <CTRL N>                       XON/XOFF Protokoll ausschalten 

+0F  SI   <CTRL O>                       XON/XOFF Protokoll einschalten 

+11  DC1  <CTRL Q>                       XON 

+13  DC3  <CTRL S>                       XOFF 

+15  NAK  <CTRL U> ==> Apple: <RIGHT>    Cursor rechts 

+16  SYN  <CTRL V>                       Cursor runter (ohne Scroll/Page) 

+17  CAN  <CTRL X> <CE>                  Graphikmodus: Fadenkreuz an/aus 

+1A  SUB  <CTRL Z> TVI: <CLEAR>          Bildschirm löschen & Cursor Home 

+1B  ESC  <ESC>                          Escape-Sequenz einleiten 

+1E  RS   <CTRL ^> TVI: <HOME>           Cursor Home 

+1F  US   <CTRL _> TVI: <SHIFT RETURN>   Zum nächsten Zeilenanfang, ggf.

+                                        Scroll/Page 

+ 

+ 

+Escape-Sequenzen, thematisch sortiert 

+------------------------------------- 

+ 

+a.) Betriebsmodi: 

+ 

+ESC $                 Graphikmodus einschalten 

+ESC %                 Textmodus einschalten 

+ESC H                 Autoscroll/Pagemode 

+ESC U                 Monitormode einschalten 

+ESC X                 Monitormode/Hexmode ausschalten 

+ESC c                 Funktionstastencode/Funktionstastenstring 

+ESC u                 Hexmode ein-/ausschalten, Monitormode ausschalten 

+ 

+ 

+#text end#

+#free(4.256852)#

+ 

+ 

+#right#70 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 70 -----------#

+#center##on("b")#B.  Anhang B - Befehlsübersicht#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+b.) Editkommandos 

+ 

+ESC *                 Text oder Graphikbildschirm löschen und Cursor Home 

+ESC +                                        " 

+ESC ,                                        " 

+ESC :                                        " 

+ESC E                 Zeile einfügen (im Textmodus) 

+ESC I                 Rückwärtstabulator (8 Spalten, im Textmodus) 

+ESC L                 Zeile einfügen (im Textmodus) 

+ESC M                 Zeile löschen (im Textmodus) 

+ESC Q                 Zeichen einfügen (im Textmodus) 

+ESC R                 Zeile löschen (im Textmodus) 

+ESC T                 Zeile ab Cursorposition bis zum Zeilenende löschen 

+ESC W                 Zeichen löschen (im Textmodus) 

+ESC Y                 Seite ab Cursorposition bis zum Seitenende löschen 

+ESC j                 Umgekehrter Zeilenvorschub 

+ESC t                 Zeile ab Cursor bis Zeilenende löschen (im Textmodus) 

+ 

+ 

+c.) Sendekommandos 

+ 

+ESC -                 Farbe, Zustand, In-Window-Bit bei Cursorpos senden 

+ESC 4                 Nummer der sichtbaren und der Arbeitsseite senden 

+ESC 5                 Graphikparameter (Dicke,Farbe,Bitverknüpfung) senden 

+ESC 6                 Aktuelle Textzeile senden 

+ESC 7                 Ganze Textseite senden 

+ESC 8                 Zeichen an der Cursorposition senden 

+ESC \ <ll><lh><al><ah>Aktuelle Graphikseite senden (oder Teile) 

+ESC ;                 Position des Graphikcursors senden 

+ESC ?                 Position des Textcursors senden 

+ESC _                 Graphikbyte bei Graphikcursorposition senden 

+ESC x 1 <l><m>        Zeilenbegrenzer für <ESC> 6 und <ESC> 7 einstellen 

+ESC x 4 <p>           Seitenbegrenzer für <ESC> 7 einstellen 

+ 

+ 

+d.) Übertragungskommandos 

+ 

+ESC SPACE SPACE <p>   Baudrate, Stopbits, Datenbits, Parity einstellen 

+ESC SPACE 0           Basis/Apple Keyboardcodes, keine Emulation 

+ESC SPACE 1           TVI - Emulation 

+ESC SPACE 2           Keine Hardware Flußkontrolle 

+ESC SPACE 3           RTS/CTS Flußkontrolle 

+ESC SPACE 4           DTR/DSR Flußkontrolle 

+ESC SPACE 5           RTS/CTS und DTR/DSR Flußkontrolle 

+ESC SPACE 6           8. Datenbit ist 0 

+ESC SPACE 7           8. Datenbit vorhanden 

+ESC D L               Local-Modus 

+ESC D E               Online-Modus mit Echo 

+ESC D O               Online-Modus ohne Echo 

+ 

+ 

+#text end#

+#free(04.468519e-1)#

+ 

+ 

+ 71 

+#page##--------------------------------- Ende der Seite 71 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+e.) Bildschirm/Druckerausgabe 

+ 

+ESC @                 Empfangsdaten auf Drucker ausgeben 

+ESC A                 Empfangsdaten nicht auf Drucker ausgeben 

+ESC P                 Hardcopy der Textseite 

+ESC ^ <p>             Hardcopy der aktuellen Graphikseite 

+ESC `                 Empfangsdaten nicht auf dem Bildschirm anzeigen 

+ESC a                 Empfangsdaten auf dem Bildschirm anzeigen 

+ESC ~ <n><l><p.>      Definition d.Druckertreiberstrings f.Graphikhardcopy 

+ 

+ 

+f.) Cursor/Cursor Adressierung 

+ 

+ESC . 0               Cursor aus 

+ESC . 1               Cursor blinkend 

+ESC . 2               Cursor an, nicht blinkend 

+ESC = <y+32><x+32>    Cursor auf Adresse positionieren 

+ESC Z                 Cursor an/aus 

+ 

+ 

+g.) Attribute 

+ 

+ESC (                 Normale Zeichen 

+ESC )                 Textmodus: Inversschrift, Graphik: Kursivschrift 

+ESC G 0               Normale Schrift 

+ESC G 1               Unsichtbare Schrift, Leerzeichen 

+ESC G 4               Inverse Schrift 

+ESC G 5               Unsichtbare Schrift, inverse Leerzeichen 

+ESC b                 Schwarze Schrift auf hellem Grund (nur im Textmodus) 

+ESC d                 Helle Schrift auf dunklem Grund, (nur im Textmodus) 

+ESC z <n>             Zeichensatz einstellen 

+ 

+ 

+h.) Text in Graphiken 

+ 

+ESC &                 Graphikzeichen ersetzen darunterliegende 

+ESC '                 Graphikzeichen überschreiben darunterliegende 

+ESC N <b><h><w>       Zeichenbreite, -höhe und Schreibrichtung einstellen 

+ 

+ 

+i.) Graphikzeichenkommandos 

+ 

+ESC J <b, h;>         Relatives Rechteck zeichnen 

+ESC K <r, s;>         Kreis(segmente) mit dem Radius <r> zeichnen 

+ESC m <x, y;>         Absoluten Punkt bei (x, y) zeichnen 

+ESC n <l, w;>         Turtle Draw/Move <l> ist Länge, <w> ist Winkel 

+ESC o                 Turtle Penup/Pendown 

+ESC q <x, y;>         Relativer Move 

+ESC r <x, y;>         Relativer Draw 

+ESC s <xr,yr,aw,ew;>  Ellipsenbogen(Radien xr,yr) v.<aw> bis <ew> zeichnen 

+ESC v <x, y;>         Absoluter Move nach (x, y) 

+ESC w <x, y;>         Absoluter Draw nach (x, y) 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#72 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 72 -----------#

+#center##on("b")#B.  Anhang B - Befehlsübersicht#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+j.) Verschiede Graphikkommandos 

+ 

+ESC ! <p>             Graphikseiten mischen, kopieren, trennen, invertieren 

+ESC / <ll><lh><al><ah><p...> Graphikseite vom Host laden 

+ESC O 0               Graphikparameter auf Default 

+ESC O 1 <d>           Strichdicke setzen 

+ESC O 2 <f>           Farbe/Helligkeit einstellen 

+ESC O 3 <p>           Linientyp (Punkt/Strichmuster) einstellen 

+ESC O 4 <p>           Bitverknüpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) 

+ESC O 5 <p>           Farbe, Dicke, Bitverknüpfung zusammen einstellen 

+ESC O 6 <pl><ph>      Benutzerdefinierbares Linienmuster einstellen 

+ESC O 7 <p>           Arbeitsseite, sichtbare Seite u.Mixedmode einstellen 

+ESC O 8 <p>           Turtle Penup/Pendown und Eraser/Drawer einstellen 

+ESC O 9               Turtle Bildmitte, Richtung nach oben, Pendown, Drawer 

+ESC O : <b1..b8>      Benutzerdefinierbares Füllmuster einstellen 

+ESC y                 Graphikseite löschen und Cursor nach (0, 0) 

+ESC | <n>             Fläche füllen/löschen mit dem Muster Nummer <n> 

+ 

+ 

+k.) Verschiedene und spezielle Funktionen 

+ 

+ESC 0                 Terminalprogramm initialisieren (Softwarereset) 

+ESC 9 <d>             Zeitverzögerung ca. <d> * 2 ms 

+ESC <                 Keyboardclick ausschalten 

+ESC >                 Keyboardclick einschalten 

+ESC F <c>             Controlcharacter darstellen 

+ESC e <d...><t>       Funktionstaste <t> mit Daten <d...> belegen 

+ESC {                 Statuszeile aus (24. Textzeile sichtbar) 

+ESC }                 Statuszeile an (24. Textzeile unsichtbar) 

+ESC S <n>             Graphik/Textseite von/auf Diskette laden/speichern 

+ESC DEL 1             Tastenbelegungen löschen 

+ESC DEL 2             Druckerpuffer löschen 

+ESC DEL 3             Empfangspuffer löschen 

+ESC DEL 4             Sendepuffer löschen 

+ 

+#text end#

+#free(7.220185)#

+ 

+ 

+ 73 

+#page##--------------------------------- Ende der Seite 73 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#C.  Anhang C - Default Funktionstastenbelegungen#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Bemerkung zur Schreibweise: 

+<#40> bezeichnet den ASCII-Code für '(', also den ASCII-Code 40 (dezimal). 

+<LESC> bezeichnet den Code Hex 9B für Local Escape, damit diese Tastenfunk-

+tionen sowohl im Local- als auch im Onlinemodus ausgeführt werden können. 

+ 

+a.) Zehnerblock mit <SHIFT> 

+ 

+Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht

+Richtungen. Die Taste <SHIFT 5> zeigt nur das Fadenkreuz, d.h. die Position

+des Graphikcursors bleibt unverändert. Bei allen anderen Zifferntasten än-

+dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz

+sichtbar. Bis auf die Help-Taste <SHIFT F4> können alle Tasten auch im On-

+line-Modus aufgerufen werden. 

+ 

+Die Tastenbelegungen im einzelnen: 

+ 

+Taste    Hex-Code Code-Sequenz 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+<SHIFT 1>  E1  <LESC> q-1,-1; <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 2>  E2  <LESC> q0,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 3>  E3  <LESC> q1,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 4>  E4  <LESC> q-1,0;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 5>  E5  <LESC> <CTRL X><LESC> 9 <#127> <LESC> <CTRL X> 

+<SHIFT 6>  E6  <LESC> q1,0;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 7>  E7  <LESC> q-1,1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 8>  E8  <LESC> q0,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 9>  E9  <LESC> q1,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+ 

+Terminalinitialisierung mit <SHIFT BOTTOMRIGHT>: 

+            EF  (Cursorpositionierung und Einschaltmeldung) 

+ 

+ 

+b.) Die Funktionstasten mit <SHIFT> 

+ 

+Taste    Hex-Code Code-Sequenz                     Bedeutung 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+<SHIFT F1>  D1  <LESC> $ <LESC> O70                Graphikseite 1 

+<SHIFT F2>  D2  <LESC> $ <LESC> O73                Graphikseite 2 

+<SHIFT F3>  D3  <LESC> %                           Textseite 

+<SHIFT F4>  D4  <ESC>SW<#26> H e l p s c r e e n (a..f): <ESC>S<#81> 

+                <ESC>9<#81> <ESC>SG                Help-Bilschirm anzeigen 

+<SHIFT F8>  D8  <LESC> O41                         Linien schwarz (löschen) 

+<SHIFT F9>  D9  <LESC> O40                         Linien weiß (sichtbar) 

+<SHIFT F10> DA  <LESC> O12 <LESC> N <#12><#20><#0> Große und dicke Schrift 

+<SHIFT F11> DB  <LESC> O11 <LESC> N <#0><#0><#0>   Normal dünne Schrift 

+<SHIFT F12> DC  <LESC> G4                          Kursiv/Invers an 

+<SHIFT F13> DD  <LESC> G0                          Kursiv/Invers aus 

+<SHIFT F14> DE  <LESC> ^0                          Graphikhardcopy 

+<SHIFT F15> DF  <LESC> P                           Texthardcopy 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#74 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 74 -----------#

+#center##on("b")#C.  Anhang C - Default Funktionstastenbelegungen#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#text end#

+#free(22.03685)#

+ 

+ 

+ 75 

+#page##--------------------------------- Ende der Seite 75 -----------#

diff --git a/system/ruc-terminal/unknown/src/SCCPARAM.ELA b/system/ruc-terminal/unknown/src/SCCPARAM.ELA
new file mode 100644
index 0000000..ab59518
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/SCCPARAM.ELA
@@ -0,0 +1,144 @@
+(* Uebertragungsparameter fuer Kanal 2 und 3 (SCC) setzen *) 

+(* Vers. 1.2 : 'setup'-Prozedur / 03.02.86, M.Staubermann *) 

+ 

+PACKET scc DEFINES baudrate, 

+                   setup ,

+ 

+                   channel a, 

+                   channel b, 

+                   no parity, 

+                   even parity, 

+                   odd parity, 

+ 

+                   read port, 

+                   write port, 

+                   register, 

+                   quartz :

+ 

+BOOL CONSTchannel a   :: TRUE , 

+          channel b   :: FALSE ; 

+INT CONST no parity   :: 0, 

+          even parity :: 3, 

+          odd parity  :: 1; 

+ 

+REAL VAR clk frequency := 12288000.0 ; (* Oszillatorfrequenz *) 

+LET offset        = 0 ; 

+ 

+PROC quartz (REAL CONST wert) : 

+ clk frequency := wert 

+ENDPROC quartz ; 

+ 

+REAL PROC quartz : 

+ clk frequency 

+ENDPROC quartz ; 

+ 

+PROC setup (BOOL CONST channel, INT CONST parity, 

+            REAL CONST stopbits, INT CONST bits, 

+            BOOL CONST dtr, rts, auto dtr, auto cts) :

+ 

+(* Parameter müssen zusammen gesetzt werden, da die Register keine 

+   Read-Register sind. Alte Werte müssen ausserhalb des SCC's gespeichert 

+   werden. *) 

+ 

+ INT VAR value := 64 ; 

+ value INCR parity value ; 

+ value INCR stopbit value ; 

+ 

+ register (channel, 3, 0) ; 

+ register (channel, 5, 32 * bits value) ;

+ register (channel,14, 2) ; 

+ 

+ register (channel, 4, value) ; 

+ register (channel, 5, 8 + dtr value + rts value + 32 * bits value) ;

+ register (channel,14, 3 + auto dtr value) ;

+ register (channel, 3, 1 + 64 * bits value + auto cts value) .

+ 

+bits value : 

+ IF bits <= 5 THEN 0 

+ ELIF bits >= 8 THEN 3 

+ ELIF bits = 6 THEN 2 

+ ELSE 1

+ FI .

+ 

+parity value : 

+ IF parity >= 0 AND parity <= 3 THEN parity ELSE 0 FI . 

+ 

+stopbit value : 

+ IF stopbits = 1.0 THEN 4 

+ ELIF stopbits = 1.5 THEN 8 

+ ELIF stopbits = 2.0 THEN 12 

+ ELSE 4 

+ FI . 

+ 

+dtr value : 

+ IF dtr THEN 128 ELSE 0 FI . 

+ 

+rts value : 

+ IF rts THEN 2 ELSE 0 FI . 

+ 

+auto cts value :

+ IF auto cts THEN 32 ELSE 0 FI . 

+ 

+auto dtr value : 

+ IF auto dtr THEN 4 ELSE 0 FI . 

+ 

+ENDPROC setup ;

+ 

+PROC baudrate (BOOL CONST channel, REAL CONST rate) :

+ INT CONST time constant :: int (clk frequency / (64.0 * rate) + 0.5) - 2 ;

+ register (channel, 13, time constant DIV 256) ; 

+ register (channel, 12, time constant AND 255)

+ENDPROC baudrate ; 

+ 

+REAL PROC baudrate (BOOL CONST channel) : 

+ INT CONST time constant :: 

+     register (channel, 12) + 256 * register (channel, 13) ;

+ round (clk frequency / (real (time constant + 2) * 64.0), 1)

+ENDPROC baudrate ; 

+ 

+ 

+(*********************************************************************) 

+(********* S C C    -     Z u g r i f f s p r o z e d u r e n ********)

+(*********************************************************************) 

+ 

+ 

+INT PROC read port (INT CONST port) : 

+ INT VAR value ; 

+ control (-1, offset + port, -1, value) ; 

+ IF value = -1 THEN errorstop ("SCC - Read failed") ; 0 

+ ELSE value 

+FI . 

+ 

+ENDPROC read port ;

+ 

+PROC write port (INT CONST port, value) : 

+ INT VAR rcode, my channel := channel ; 

+ continue (32) ; 

+ control (-1, offset + port, value, r code) ; 

+ continue (my channel) ; 

+ IF r code = -1 THEN errorstop ("SCC - Write failed") FI 

+ENDPROC write port ; 

+ 

+INT PROC register (BOOL CONST is channel a, INT CONST register x) : 

+ INT VAR value ; 

+ IF is channel a 

+    THEN write port (1, registerx) ; 

+         read port (1) 

+    ELSE write port (0, registerx) ; 

+         read port (0) 

+ FI 

+ENDPROC register ; 

+ 

+ 

+PROC register (BOOL CONST is channel a, INT CONST register x, wert): 

+ IF is channel a 

+    THEN write port (1, register x) ;

+         write port (1, wert) 

+    ELSE write port (0, register x) ;

+         write port (0, wert)

+ FI 

+ENDPROC register ; 

+ 

+ENDPACKET scc ; 

+ 

+

diff --git a/system/ruc-terminal/unknown/src/SETUP.ELA b/system/ruc-terminal/unknown/src/SETUP.ELA
new file mode 100644
index 0000000..ade2118
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/SETUP.ELA
@@ -0,0 +1,257 @@
+PACKET setup DEFINES setup :         (* 02.03.86, M.Staubermann *) 

+ 

+LET separator  = "|" , 

+    old option mark = " " , (* ""16"" , *)

+    choice mark = ""15"" , 

+    end mark   = ""14"" , 

+    left       = ""8"" , 

+    right      = ""2"" , 

+    bottom     = ""6""21""0"" , 

+    clr line   = ""13""5"" ,

+    home       = ""1"" ;

+ 

+PROC selektor (TEXT CONST options, INT VAR option number,BOOL CONST warten) :

+ TEXT VAR zeichen ;

+ INT VAR i , 

+         last separator pos , 

+         new separator pos := 0 ,

+         old option := option number , 

+         max options := 0 ;

+ REP 

+  new separator pos := pos (options, separator, new separator pos +1) ; 

+  max options INCR 1 

+ UNTIL new separator pos = 0 PER ;

+ out (""13"") ; 

+ REP 

+  i := 0 ; 

+  last separator pos := 0 ;

+  REP 

+   i INCR 1 ;

+   new separator pos := pos (options, separator, last separator pos + 1) ; 

+   IF new separator pos = 0 

+      THEN new separator pos := LENGTH options + 1 

+   FI ;

+   IF i = option number

+      THEN out (choice mark) 

+   ELIF i = old option 

+      THEN out (old option mark) 

+   ELSE out (end mark) 

+   FI ; 

+   out subtext (options, last separator pos + 1, new separator pos - 1) ; 

+   out (end mark) ;

+   last separator pos := new separator pos 

+  UNTIL last separator pos = LENGTH options + 1 PER ;

+  out (""13"") ;

+  IF warten 

+     THEN inchar (zeichen) ; 

+          IF zeichen = ""27"" 

+             THEN option number := old option 

+          ELIF zeichen = left AND option number = 1 

+             THEN option number := max options 

+          ELIF zeichen = left 

+             THEN option number DECR 1 

+          ELIF zeichen = right AND option number = max options 

+             THEN option number := 1 

+          ELIF zeichen = right 

+             THEN option number INCR 1 

+          FI 

+  ELSE zeichen := ""13"" 

+  FI

+ UNTIL zeichen = ""13"" OR zeichen = ""27"" PER 

+ENDPROC selektor ; 

+ 

+LET std datenbits = 4 , (* 8 *) 

+    std stopbits  = 1 , (* 1.0 *) 

+    std flowmode  = 1 , (* xon/xoff *) 

+    std parity    = 1 , (* no parity *) 

+    std fixed     = 4 , (* RTS ON, DTR ON *) 

+ 

+    setup text    = "Ende|Kanal|Baudrate|Datenbits|Stopbits|Parity|Flußkontrolle", 

+    ende text     = "Ändern|Abbruch" , 

+    kanal text    = "2|3" , 

+    datenbits text= "5|6|7|8" , 

+    stopbits text = "1.0|1.5|2.0" , 

+    parity text   = "no|even|odd" , 

+    fixed text    = "DTR OFF/RTS OFF|DTR OFF/RTS ON|DTR ON/RTS OFF|DTR ON/RTS ON" , 

+    flowmode text = "xon/xoff|dtr|rts/cts|dtr/rts/cts|fixed" ; 

+ 

+INT VAR old session := 0 ; 

+ROW 2 INT VAR datenbits, stopbits, parity, flowmode , fixed ; 

+ROW 2 REAL VAR baudrates ; 

+ 

+PROC init params : 

+ datenbits := ROW 2 INT:(std datenbits , std datenbits) ; 

+ stopbits  := ROW 2 INT:(std stopbits , std stopbits) ; 

+ parity    := ROW 2 INT:(std parity , std parity) ; 

+ flowmode  := ROW 2 INT:(std flowmode , std flowmode) ; 

+ fixed     := ROW 2 INT:(std fixed, std fixed) ; 

+ baudrates := ROW 2REAL:(baudrate (channelb), baudrate (channela)) ;

+ENDPROC init params ; 

+ 

+PROC setup :

+ INT VAR kanal := aktueller kanal , 

+         setup choice := 1 ; 

+ BOOL VAR x dtr, x rts, x auto dtr, x cts ; 

+ page ;

+ init setup (kanal, setup choice) ; 

+ select setup choice ; 

+ cursor (1, 19) ; 

+ setup choice := 2 ; 

+ selektor (ende text, setup choice, TRUE) ; 

+ out (bottom) ;

+ IF setup choice = 1 

+    THEN kanal := 1 ; 

+         x flowmode ; 

+         setup (kanal bool, x parity, x stopbits, x datenbits, 

+                x dtr, x rts, x auto dtr, x cts) ; 

+         baudrate (kanal bool, baudrates (kanal)) ; 

+         kanal := 2 ; 

+         x flowmode ; 

+         setup (kanal bool, x parity, x stopbits, x datenbits, 

+                x dtr, x rts, x auto dtr, x cts) ; 

+         baudrate (kanal bool, baudrates (kanal)) 

+ FI . 

+ 

+x flowmode : 

+ x dtr := FALSE ; 

+ x rts := FALSE ; 

+ SELECT flowmode (kanal) OF 

+  CASE 1 : x auto dtr := FALSE ; (* XON/XOFF *) 

+           x cts      := FALSE 

+  CASE 2 : x auto dtr := TRUE ;  (* DTR *)

+           x cts      := FALSE 

+  CASE 3 : x auto dtr := FALSE ; (* RTS/CTS *)

+           x cts      := TRUE 

+  CASE 4 : x auto dtr := TRUE  ; (* RTS/CTS/DTR *) 

+           x cts      := TRUE 

+  CASE 5 : x auto dtr := FALSE ; (* fixed *) 

+           x cts      := FALSE ; 

+           SELECT fixed (kanal) OF 

+            CASE 1 : x dtr := FALSE ; (* wie XON/XOFF *)

+                     x rts := FALSE 

+            CASE 2 : x dtr := FALSE ; (* RTS=1 *) 

+                     x rts := TRUE 

+            CASE 3 : x dtr := TRUE ;  (* DTR=1 *)

+                     x rts := FALSE 

+            CASE 4 : x dtr := TRUE ;  (* RTS=1,DTR=1 *) 

+                     x rts := TRUE 

+           ENDSELECT 

+ENDSELECT. 

+ 

+x parity : 

+ SELECT parity (kanal) OF 

+  CASE 2 : even parity 

+  CASE 3 : odd parity 

+  OTHERWISE no parity 

+ ENDSELECT. 

+ 

+x stopbits : 

+ SELECT stopbits (kanal) OF 

+  CASE 2 : 1.5 

+  CASE 3 : 2.0 

+  OTHERWISE 1.0 

+ ENDSELECT. 

+ 

+x datenbits : 

+ datenbits (kanal) + 4. 

+ 

+select setup choice : 

+ REP 

+  cursor (1, 5) ; 

+  selektor (setup text, setup choice, TRUE) ; 

+  SELECT setup choice OF 

+   CASE 1 : LEAVE select setup choice 

+   CASE 2 : select kanal choice 

+   CASE 3 : select baudrate choice 

+   CASE 4 : select datenbits choice 

+   CASE 5 : select stopbits choice 

+   CASE 6 : select parity choice 

+   CASE 7 : select flowmode choice 

+  ENDSELECT 

+ PER . 

+ 

+select kanal choice : 

+ INT VAR save kanal := kanal ; 

+ cursor (1, 7) ; 

+ selektor (kanal text, kanal, TRUE) ; 

+ init setup (kanal, setup choice) .

+ 

+select baudrate choice : 

+ cursor (1, 9) ; 

+ TEXT VAR t := text (baudrates (kanal)) + "    " ; 

+ out (" ") ;

+ editget (t) ; 

+ baudrates (kanal) := real (t) . 

+ 

+select datenbits choice : 

+ cursor (1, 11) ; 

+ selektor (datenbits text, datenbits (kanal), TRUE) . 

+ 

+select stopbits choice : 

+ cursor (1, 13) ; 

+ selektor (stopbits text, stopbits (kanal), TRUE) . 

+ 

+select parity choice : 

+ cursor (1, 15) ; 

+ selektor (parity text, parity (kanal), TRUE).

+ 

+select flowmode choice : 

+ cursor (1, 17) ; 

+ selektor (flowmode text, flowmode (kanal), TRUE) ; 

+ IF flowmode (kanal) = 5 

+    THEN cursor (1, 19) ; 

+         selektor (fixed text, fixed (kanal), TRUE) ; 

+         out (clr line) 

+ FI . 

+ 

+aktueller kanal : 

+ IF channel = 2 THEN 1 

+ ELIF channel = 3 THEN 2 

+ ELSE 1 

+ FI . 

+ 

+kanal bool : 

+ IF kanal = 1 THEN channel b ELSE channel a FI . 

+ 

+ENDPROC setup ; 

+ 

+PROC init setup (INT VAR kanal, setup choice) :

+ IF session <> old session 

+    THEN init params ; 

+         old session := session 

+ FI ;

+ out (home) ; 

+ putline (" ----------------------------- V 2 4 - S E T U P ---------------------------") ; 

+ line ; 

+ putline (" Verlassen 'ESC', Aussuchen 'LEFT' und 'RIGHT', Einstellen 'RETURN'") ; 

+ line ; 

+ selektor (setup text, setup choice, FALSE) ; 

+ line ; 

+ line ; 

+ selektor (kanal text, kanal, FALSE) ; 

+ line ; 

+ line ; 

+ out (" ") ; put (baudrates (kanal)) ; out ("     ") ;

+ line ; 

+ line ; 

+ selektor (datenbits text, datenbits (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (stopbits text, stopbits (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (parity text, parity (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (flowmode text, flowmode (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ line ; 

+ line ;

+ putline (" --------------------------------------------------------------------------") ; 

+ out (home) . 

+ENDPROC init setup ;

+ 

+ENDPACKET setup ; 

+ 

+

diff --git a/system/ruc-terminal/unknown/src/Terminal108(ascii) b/system/ruc-terminal/unknown/src/Terminal108(ascii)
new file mode 100644
index 0000000..f06755e
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/Terminal108(ascii)
@@ -0,0 +1,121 @@
+                                      (* Terminaltyp: Terminal108 *) 

+                                      (* Keyboard   : Deutsch     *) 

+                                      (* Zeichensatz: ASCII       *) 

+                                      (* Stand      : 28.04.86    *) 

+ 

+forget  ("Terminal108(ascii)", quiet) ; 

+new type ("Terminal108(ascii)") ; 

+ 

+cursor logic  (32, ""30"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode ( 1, 25) ;                (* Cursor Home *) 

+enter outcode ( 2, 28) ;                (* Cursor right *)

+enter outcode ( 3, 31) ;                (* Cursor up *) 

+enter outcode ( 4, 11) ;                (* Clear EOP *) 

+enter outcode ( 5, 29) ;                (* Clear EOL *) 

+enter outcode ( 7,  7) ;                (* Bell      *) 

+enter outcode (14, 0, " "14"") ;        (* Norm Vid  *) 

+enter outcode (15, 0, ""15" ") ;        (* Inv  Vid  *) 

+

+enter outcode (214, 193) ;  (* Inv A *)

+enter outcode (215, 207) ;  (* Inv O *)

+enter outcode (216, 213) ;  (* Inv U *)

+enter outcode (217, 225) ;  (* Inv a *)

+enter outcode (218, 239) ;  (* Inv o *)

+enter outcode (219, 245) ;  (* Inv u *)

+enter outcode (220, 235) ;  (* Inv k *)

+enter outcode (221, 173) ;  (* Inv - *)

+enter outcode (222, 163) ;  (* Inv # *)

+enter outcode (223, 160) ;  (* Inv Blank *)

+enter outcode (251, 194) ;  (* Inv B *)

+ 

+enter outcode (64, 0, ""1"B"64"") ; (* ""1"B" = ASCII *)

+enter outcode (91, 0, ""1"B"91"") ; 

+enter outcode (92, 0, ""1"B"92"") ; 

+enter outcode (93, 0, ""1"B"93"") ; 

+enter outcode (123,0, ""1"B"123"") ; 

+enter outcode (124,0, ""1"B"124"") ; 

+enter outcode (125,0, ""1"B"125"") ; 

+enter outcode (126,0, ""1"B"126"") ; 

+(* 

+enter outcode (12, 12) ;              (* CLR SCRN *) 

+enter outcode (16, 2) ;               (* Cursor Mode <mode> *) 

+enter outcode (17, 1) ;               (* Zeichensatz <switch> : Bit 0..3 *)

+enter outcode (18, 18) ;              (* Insert Line *) 

+enter outcode (19, 26) ;              (* Erase (nicht Delete) Line *) 

+enter outcode (20, 5) ;               (* xpos := 80 *) 

+enter outcode (22, 22) ;              (* Select Screen <nr> : Bit 0 *) 

+enter outcode (23, 23) ; (*SetWindow <left><top><right+1><bottom+1>  (+128)*) 

+*)

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *)

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode (4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

diff --git a/system/ruc-terminal/unknown/src/Terminal108(deutsch) b/system/ruc-terminal/unknown/src/Terminal108(deutsch)
new file mode 100644
index 0000000..24ad9e7
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/Terminal108(deutsch)
@@ -0,0 +1,122 @@
+                                      (* Terminaltyp: Terminal108 *) 

+                                      (* Keyboard   : Deutsch     *) 

+                                      (* Zeichensatz: Deutsch     *) 

+                                      (* Stand      : 28.04.86    *) 

+ 

+forget  ("Terminal108(deutsch)", quiet) ; 

+new type ("Terminal108(deutsch)") ; 

+ 

+cursor logic  (32, ""30"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214, 0, ""1"D"91"") ; (* ""1"D" = Deutsch *)

+enter outcode (215, 0, ""1"D"92"") ; 

+enter outcode (216, 0, ""1"D"93"") ; 

+enter outcode (217, 0, ""1"D"123"") ; 

+enter outcode (218, 0, ""1"D"124"") ; 

+enter outcode (219, 0, ""1"D"125"") ; 

+enter outcode (220, 235) ;           (* Inv k *)

+enter outcode (221, 173) ;           (* Inv - *)

+enter outcode (222, 163) ;           (* Inv # *)

+enter outcode (223, 160) ;           (* Inv Blank *)

+enter outcode (251, 0, ""1"D"126"") ; 

+ 

+enter outcode ( 1, 25) ;                (* Cursor Home *) 

+enter outcode ( 2, 28) ;                (* Cursor right *)

+enter outcode ( 3, 31) ;                (* Cursor up *) 

+enter outcode ( 4, 11) ;                (* Clear EOP *) 

+enter outcode ( 5, 29) ;                (* Clear EOL *) 

+enter outcode ( 7,  7) ;                (* Bell      *) 

+enter outcode (14, 0, " "14"") ;        (* Norm Vid  *) 

+enter outcode (15, 0, ""15" ") ;        (* Inv  Vid  *) 

+(* 

+enter outcode (12, 12) ;              (* CLR SCRN *) 

+enter outcode (16, 2) ;               (* Cursor Mode <mode> *) 

+enter outcode (17, 1) ;               (* Zeichensatz <switch> : Bit 0..3 *)

+enter outcode (18, 18) ;              (* Insert Line *) 

+enter outcode (19, 26) ;              (* Erase (nicht Delete) Line *) 

+enter outcode (20, 5) ;               (* xpos := 80 *) 

+enter outcode (22, 22) ;              (* Select Screen <nr> : Bit 0 *) 

+enter outcode (23, 23) ; (*SetWindow <left><top><right+1><bottom+1>  (+128)*) 

+*)

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *)

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode (4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

+ 

+ 

diff --git a/system/ruc-terminal/unknown/src/ructerm.apl-german b/system/ruc-terminal/unknown/src/ructerm.apl-german
new file mode 100644
index 0000000..c381c6b
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/ructerm.apl-german
@@ -0,0 +1,125 @@
+                                      (* Terminaltyp: ructerm  *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Universal*) 

+                                      (* Stand      : 08.10.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+ 

+forget  ("ructerm.apl/german", quiet) ; 

+new type ("ructerm.apl/german") ; 

+ 

+enter outcode (11, 253) ;              (* links Pfeil *) 

+enter outcode (12, 221) ;              (* rechts Pfeil *) 

+enter outcode (16, 240) ; 

+enter outcode (17, 241) ; 

+enter outcode (18, 242) ; 

+enter outcode (19, 243) ; 

+enter outcode (20, 244) ; 

+enter outcode (21, 245) ; 

+enter outcode (22, 246) ; 

+enter outcode (23, 247) ; 

+enter outcode (24, 248) ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y"27"z7") ; (* CLEOP und Zeichensatz : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14,  175) ;       (* END MARK    : Spitz. Klammer zu *)

+enter outcode ( 15,  192) ;       (* BEGIN MARK  : Spitz. Klammer auf *)

+ 

+enter outcode (214, 91) ;               (* Ae *) 

+enter outcode (215, 92) ;               (* Oe *) 

+enter outcode (216, 93) ;               (* Ue *) 

+enter outcode (217, 123) ;              (* ae *) 

+enter outcode (218, 124) ;              (* oe *) 

+enter outcode (219, 125) ;              (* ue *)

+enter outcode (220, 235) ;              (* Trenn-k *) 

+enter outcode (221, 191) ;              (* Trennstrich *) 

+enter outcode (222, 188) ;              (* Fest-# = Raute *)

+enter outcode (223, 160) ;              (* Fest-Blank *) 

+enter outcode (251, 126) ;              (* sz *) 

+enter outcode (252, 64) ;               (* paragraph *)

+ 

+enter outcode (64, 131) ;               (* At-Sign *) 

+enter outcode (91, 252) ;               (* Eck. Klammer auf *) 

+enter outcode (92, 223) ;               (* Backslash *) 

+enter outcode (93, 251) ;               (* Eck. Klammer zu *) 

+enter outcode (123, 167) ;              (* Geschw. Klammer auf *) 

+enter outcode (124, 205) ;              (* Senkr. Strich *) 

+enter outcode (125, 163) ;              (* Geschw. Klammer zu *) 

+enter outcode (126, 212) ;              (* Tilde *) 

+

+enter outcode (144, 214) ;              (* Zeichen mit Umlautcodes *)

+enter outcode (145, 215) ;              (* verlegen *)

+enter outcode (146, 216) ; 

+enter outcode (147, 217) ; 

+enter outcode (148, 218) ; 

+enter outcode (149, 219) ; 

+enter outcode (150, 220) ; 

+enter outcode (151, 221) ; 

+enter outcode (152, 222) ;

+

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 Insert Line *)

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

diff --git a/system/ruc-terminal/unknown/src/ructerm.ascii b/system/ruc-terminal/unknown/src/ructerm.ascii
new file mode 100644
index 0000000..b06df7c
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/ructerm.ascii
@@ -0,0 +1,94 @@
+                                      (* Terminaltyp: ructerm  *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Ascii    *) 

+                                      (* Stand      : 08.10.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+ 

+forget  ("ructerm.ascii", quiet) ; 

+new type ("ructerm.ascii") ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14,  0, " "27"(") ;   (* END MARK    : <ESC> ( *)

+enter outcode ( 15,  0, ""27") ") ;   (* BEGIN MARK  : <ESC> ) *)

+ 

+enter outcode (214, 193) ;              (* Ae *) 

+enter outcode (215, 207) ;              (* Oe *) 

+enter outcode (216, 213) ;              (* Ue *) 

+enter outcode (217, 225) ;              (* ae *) 

+enter outcode (218, 239) ;              (* oe *) 

+enter outcode (219, 245) ;              (* ue *)

+enter outcode (220, 235) ;              (* Trenn-k *) 

+enter outcode (221, 173) ;              (* Trennstrich *) 

+enter outcode (222, 163) ;              (* Fest-# *)

+enter outcode (223, 160) ;              (* Fest-Blank *) 

+enter outcode (251, 194) ;              (* sz *) 

+enter outcode (252, 192) ;              (* paragraph *)

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 Insert Line *)

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

diff --git a/system/setup/3.1/source-disk b/system/setup/3.1/source-disk
new file mode 100644
index 0000000..1421205
--- /dev/null
+++ b/system/setup/3.1/source-disk
@@ -0,0 +1 @@
+setup/setup-src-3.1_shard-4.9_1989-04-18.img
diff --git a/system/setup/3.1/src/AT-4.x b/system/setup/3.1/src/AT-4.x
new file mode 100644
index 0000000..86962e3
--- /dev/null
+++ b/system/setup/3.1/src/AT-4.x
diff --git a/system/setup/3.1/src/SHARD b/system/setup/3.1/src/SHARD
new file mode 100644
index 0000000..c1619b3
--- /dev/null
+++ b/system/setup/3.1/src/SHARD
diff --git a/system/setup/3.1/src/SHard Basis b/system/setup/3.1/src/SHard Basis
new file mode 100644
index 0000000..60800a1
--- /dev/null
+++ b/system/setup/3.1/src/SHard Basis
diff --git a/system/setup/3.1/src/bootblock b/system/setup/3.1/src/bootblock
new file mode 100644
index 0000000..00b56a2
--- /dev/null
+++ b/system/setup/3.1/src/bootblock
diff --git a/system/setup/3.1/src/configuration b/system/setup/3.1/src/configuration
new file mode 100644
index 0000000..139597f
--- /dev/null
+++ b/system/setup/3.1/src/configuration
@@ -0,0 +1,2 @@
+
+
diff --git a/system/setup/3.1/src/neu b/system/setup/3.1/src/neu
new file mode 100644
index 0000000..a89779c
--- /dev/null
+++ b/system/setup/3.1/src/neu
@@ -0,0 +1,34 @@
+TEXT VAR t1 :: "SHardmodul Floppy", t2 :: "FLOPPY.EXE"; 
+reserve ("ds", /"DOS"); 
+IF yes("init",FALSE)
+  THEN init modules list; 
+FI;
+THESAURUS VAR th1 :: all modules, th2 :: empty thesaurus; 
+WHILE yes ("noch Module holen", TRUE) REP 
+t2 := ONE /"DOS"; 
+t1 := ONE (th1); 
+editget (t1); line; 
+forget (t1); 
+fetch (t2, /"DOS"); 
+copy (t2, t1);  last param (t1); 
+th2 := th2 + t1
+PER;
+WHILE yes ("jetzt noch andere holen", FALSE) REP 
+  t2 := ONE /"DOS";
+  t1 := ONE all;
+editget (t1); line; 
+forget (t1); 
+fetch (t2, /"DOS"); 
+copy (t2, t1);  last param (t1); 
+PER;
+release (/"DOS");
+
+linkshard module (th2);
+ 
+
+
+
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel -1: mini eumel dummies b/system/setup/3.1/src/setup eumel -1: mini eumel dummies
new file mode 100644
index 0000000..a1fa2b5
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel -1: mini eumel dummies
@@ -0,0 +1,28 @@
+ 
+PACKET setup eumel mini eumel dummies    (* Stand : 08.04.88 *)
+DEFINES FILE, 
+        sequentialfile, 
+        output, 
+        putline, 
+        :=,
+        run : 
+ 
+TYPE FILE = INT;
+ 
+INT CONST output :: 0; 
+
+OP := (FILE VAR a, FILE CONST b):
+
+END OP :=;
+FILE PROC sequentialfile (INT CONST a, TEXT CONST b) : 
+  FILE : (0).
+END PROC sequentialfile; 
+ 
+PROC putline (FILE CONST a, TEXT CONST b): 
+END PROC putline; 
+ 
+PROC run (TEXT CONST a): 
+END PROC run; 
+ 
+END PACKET setup eumel mini eumel dummies;
+
diff --git a/system/setup/3.1/src/setup eumel 0: -M b/system/setup/3.1/src/setup eumel 0: -M
new file mode 100644
index 0000000..bad5028
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 0: -M
@@ -0,0 +1,32 @@
+PACKET setup eumel multiuserspecials       (* Copyright (C) 1985, 1988 *)
+DEFINES terminal setup,                    (* Martin Schönbeck, Spenge *)
+        indirect list,                     (* Lutz Prechelt, Karlsruhe *)
+        setup testing :                    (* Stand: 07.05.88   2.1    *)
+
+LET sysout file = "sysout";
+
+BOOL VAR setup test version :: FALSE;
+
+PROC terminal setup: 
+  (* It took about 2 manmonths to debug this procedure ! *)
+END PROC terminal setup; 
+ 
+PROC indirect list (BOOL CONST make indirection) :
+  IF make indirection
+  THEN sysout (sysout file);
+  ELSE sysout ("");
+       print (sysout file);
+       forget (sysout file, quiet)
+  FI.
+END PROC indirect list;
+
+PROC setup testing (BOOL CONST new ):
+   setup test version := new;
+END PROC setup testing;
+
+BOOL PROC setup testing :
+  setup test version.
+END PROC setup testing;
+
+END PACKET setup eumel multiuserspecials;
+
diff --git a/system/setup/3.1/src/setup eumel 0: -S b/system/setup/3.1/src/setup eumel 0: -S
new file mode 100644
index 0000000..50a8330
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 0: -S
@@ -0,0 +1,35 @@
+PACKET setup eumel singleuserspecials      (* Copyright (C) 1985, 1988 *)
+DEFINES terminal setup,                    (* Martin Schönbeck, Spenge *)
+        break,                             (* Lutz Prechelt, Karlsruhe *)
+        indirect list,                     (* Stand: 07.05.88   2.1    *)
+        setup testing :
+
+LET printer channel  = 15,
+    screen  channel  =  1;
+
+ 
+PROC break (QUIET CONST quiet): 
+END PROC break; 
+ 
+PROC terminal setup:
+  setup
+END PROC terminal setup;
+
+PROC indirect list (BOOL CONST make indirection) :
+  (* Man beachte, daß es nicht besonders sinnvoll ist, auf einem Drucker
+     cout zu machen...
+  *)
+  IF make indirection
+  THEN continue (printer channel)
+  ELSE continue (screen channel)  FI.
+END PROC indirect list;
+
+PROC setup testing (BOOL CONST new):
+END PROC setup testing;
+
+BOOL PROC setup testing :
+  FALSE.
+END PROC setup testing;
+
+END PACKET setup eumel singleuserspecials;
+
diff --git a/system/setup/3.1/src/setup eumel 1: basisoperationen b/system/setup/3.1/src/setup eumel 1: basisoperationen
new file mode 100644
index 0000000..a705ff4
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 1: basisoperationen
@@ -0,0 +1,1071 @@
+
+(**************************************************************************)
+(***** Grundoperationen für den Setup-Eumel (Modul-SHard) *****************)
+(***** Copyright (c) 1985 - 1988 by                       *****************)
+(***** Martin Schönbeck, Spenge / Lutz Prechelt, Karlsruhe ****************)
+(**************************************************************************)
+
+(* Fünf Pakete :
+   1. setup eumel basisoperationen
+         Handhabung von 16-Bit unsigned Werten in INTs und Editierfunktionen
+   2. splitting
+         Worttrennung von REALs und Bytetrennung von INTs
+   3. basic block io
+         blockin und blockout auf Datenräume mit retrys und Fehlermeldungen
+   4. write file
+         Direktes Schreiben/Lesen eines Datenraums in/aus eine(r) Partition
+   5. thesaurus utilities
+         ONE,CERTAIN,certain  zum Aussuchen aus Thesauri ohne Editor
+*)
+
+
+PACKET setup eumel basisoperationen   (* (C) 1987 Lutz Prechelt, Karlsruhe *)
+DEFINES editget, editgetchar,         (* Stand: 08.04.88   Version 1.1     *)
+        yes, no,                      (* Eumel 1.8.0                       *)
+        direction, reset direction,
+        data error, write head,
+        LIST, list, CAT, emptylist,
+        (*UNSIGNED,*) unsigned, int, text,
+        RANGE, range, everywhere,
+        ANDXOR, andxor,
+        dec, hex, bin,
+        IN,
+        := ,
+        put :
+ 
+(* Dieses Paket stellt die Basisfunktionen für den Elanteil des Setup-SHard 
+   zur Verfügung. 
+   Es ist dies im Wesentlichen die Handhabung von INT-Werten auch in Binär- 
+   und Hexdarstellung, sowie die Plausibilitätsprüfung mit Fehleranzeigen. 
+*) 
+ 
+TYPE    LIST     = TEXT,    (* TEXT aus mehreren UNSIGNEDen (replace/ISUB) *)
+        RANGE    = STRUCT (UNSIGNED low, high), 
+        ANDXOR   = STRUCT (UNSIGNED and mask, xor mask);
+
+LET     UNSIGNED   = INT;     (* 16 bit *)
+
+TYPE    REPRESENTATION = INT;
+
+REPRESENTATION CONST dec :: REPRESENTATION : (10),
+                     hex :: REPRESENTATION : (16), 
+                     bin :: REPRESENTATION :  (2);
+
+(* Diese Typen dienen zur Wertprüfung bei der Eingabe. *) 
+ 
+LET    up      = ""3"",
+       down    = ""10"",
+       right   = ""2"",
+       error   = ""0"";  (* fuer current direction *)
+
+TEXT VAR current direction :: ""; (* enthaelt up oder down oder "" *)
+BOOL VAR direction valid :: FALSE;
+
+TEXT CONST hex digits :: "0123456789abcdef"; 
+ 
+(********************* Zuweisungen *************************************) 
+
+OP := (LIST VAR a, LIST CONST b) : 
+  CONCR (a) := CONCR (b) 
+END OP := ; 
+ 
+OP := (RANGE VAR a, RANGE CONST b) : 
+  a.low  := b.low; 
+  a.high := b.high
+END OP := ; 
+
+OP := (ANDXOR VAR a, ANDXOR CONST b) : 
+  a.and mask := b.and mask;
+  a.xor mask := b.xor mask
+END OP := ; 
+ 
+OP := (REPRESENTATION VAR a, REPRESENTATION CONST b) : 
+  CONCR (a) := CONCR (b) 
+END OP := ; 
+ 
+(************************** IN ******************************************) 
+ 
+BOOL OP IN (UNSIGNED CONST a, LIST CONST l) : 
+  INT CONST p :: pos (CONCR (l), textform (a)); 
+  p > 0 AND p MOD 2 = 1  (* enthalten und word-aligned *) 
+END OP IN; 
+ 
+BOOL OP IN (UNSIGNED CONST a, RANGE CONST b) : 
+  (* RANGES sind inklusiv ihrer Grenzen *)
+  reverse (textform (a)) <= reverse (textform (b.high)) AND 
+  reverse (textform (a)) >= reverse (textform (b.low)) 
+END OP IN;
+ 
+BOOL OP IN (UNSIGNED CONST a, ANDXOR CONST mask) : 
+  (* Es muss (Bitweise) (a AND andmask) XOR xormask = 0 sein *)
+  ((a AND mask.and mask) XOR mask.xor mask) = 0 
+END OP IN;
+
+(************************* Konstruktoren ********************************) 
+ 
+LIST CONST emptylist :: LIST : (""); 
+ 
+LIST PROC list (TEXT CONST list text) :
+  (* Konstruiert aus einer in Textform gegebenen Liste von Unsigneds eine
+     LIST. Die einzelnen Werte sind durch Komma getrennt und dürfen in
+     dezimaler, sedezimaler oder binärer Darstellung notiert sein. 
+  *)
+  TEXT VAR t :: compress (list text);
+  IF t = "" THEN emptylist
+  ELSE TEXT VAR result :: ""; 
+       REPEAT 
+         INT VAR first comma pos :: pos (t, ","); 
+         IF first comma pos = 0 THEN first comma pos := LENGTH t + 1  FI; 
+         result CAT textform (unsigned (subtext (t, 1, first comma pos - 1)));
+         t := subtext (t, first comma pos + 1) 
+       UNTIL t = ""  PER;
+       LIST : (result)
+  FI 
+END PROC list;
+
+(*UNSIGNED PROC unsigned (INT CONST sixteen bits) :
+  sixteen bits
+END PROC unsigned;*)
+
+UNSIGNED PROC unsigned (TEXT CONST number) : 
+  INT  VAR result :: 0, i;
+  TEXT VAR t :: compress (to lower (number)), type :: t SUB LENGTH t; 
+  IF pos ("hb" + hex digits, type) = 0 
+  THEN set conversion (FALSE); 
+       LEAVE unsigned WITH 0 
+  FI; 
+  IF type = "h" 
+  THEN convert hex 
+  ELIF type = "b" 
+  THEN convert binary
+  ELSE convert decimal  FI;
+  result. 
+ 
+convert hex : 
+  FOR i FROM 1 UPTO LENGTH t - 1 REP
+    TEXT CONST c :: t SUB i;
+    IF pos (hex digits, c) = 0
+    THEN set conversion (FALSE);
+         LEAVE unsigned WITH 0
+    FI;
+    rotate (result, 4);
+    result INCR pos (hex digits, c) - 1
+  PER.
+
+convert binary :
+  FOR i FROM 1 UPTO LENGTH t - 1 REP
+    TEXT CONST bit :: t SUB i;
+    IF bit <> "0" AND bit <> "1"
+    THEN set conversion (FALSE);
+         LEAVE unsigned WITH 0
+    FI;
+    rotate (result, 1);
+    result INCR int (bit)
+  PER.
+
+convert decimal :
+  REAL VAR x :: real (t);
+  IF NOT last conversion ok THEN LEAVE unsigned WITH 0  FI;
+  IF x < 32768.0
+  THEN result := int (x)
+  ELSE result := int (x - 65536.0)  FI.
+END PROC unsigned; 
+ 
+RANGE CONST everywhere :: RANGE : (0, -1); 
+ 
+RANGE PROC range (UNSIGNED CONST low, high) : 
+  RANGE : (low, high) 
+END PROC range; 
+ 
+ANDXOR PROC andxor (UNSIGNED CONST and mask, xor mask) : 
+  ANDXOR : (and mask, xor mask) 
+ENDPROC andxor; 
+ 
+
+(******* weitere Operationen für UNSIGNED, LIST, RANGE, ANDXOR **************)
+ 
+INT PROC int (UNSIGNED CONST a) : 
+  (* falls jemand noch exotische Dinge damit tun will *)
+  a 
+END PROC int;
+
+OP CAT (LIST VAR l, UNSIGNED CONST a) : 
+  (* Liste nachtraeglich erweitern *)
+  CONCR (l) CAT textform (a) 
+END OP CAT; 
+ 
+(********************* editget(char), yes, no *****************************) 
+
+PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, INT VAR i) : 
+  cursor (spalte, zeile);
+  editget (prompt, i)
+END PROC editget; 
+ 
+PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, UNSIGNED VAR a,
+              REPRESENTATION CONST r) :
+  cursor (spalte, zeile);
+  editget (prompt, a, r)
+END PROC editget; 
+ 
+PROC editget (TEXT CONST prompt, INT VAR i) : 
+  TEXT VAR t :: text (i);
+  test up or down (prompt, t);
+  IF current direction <> "" THEN LEAVE editget  FI;
+  editget (t,7,7);
+  i := int (t);
+  IF NOT last conversion ok
+  THEN data error ("Eingabe unerlaubt als Zahl")  FI
+END PROC editget; 
+ 
+PROC editget (TEXT CONST prompt, UNSIGNED VAR a, REPRESENTATION CONST r) : 
+  TEXT VAR t :: text (a, r);
+  test up or down (prompt, t);
+  IF current direction <> "" THEN LEAVE editget  FI;
+  editget (t,18,18);
+  a := unsigned (t);
+  IF NOT last conversion ok
+  THEN data error ("Eingabe unerlaubt")  FI
+END PROC editget; 
+ 
+BOOL PROC yes (TEXT CONST frage, BOOL CONST std antwort) : 
+  (* Achtung: hierdrin kann nicht die alte "yes" Prozedur benutzt werden, da
+              diese kein getchar benutzt.
+     Die alten yes/no werden unten durch Resultatlose ueberdeckt.
+  *)
+  LET allowed = "NnJj";
+  INT VAR x,y; get cursor (x,y);
+  IF NOT command dialogue THEN LEAVE yes WITH std antwort  FI;
+  REP UNTIL getcharety = "" PER;
+  REP
+    cursor (x,y);
+    test up or down (frage + " ? (j/n)", standard antwort text);
+    IF current direction <> "" THEN LEAVE yes WITH std antwort  FI;
+    TEXT VAR t;
+    getchar (t);
+    IF t = ""13""
+    THEN t := standard antwort text  FI;
+    IF pos (allowed, t) = 0
+    THEN out (""7"") ELSE out (t); out (""13""10"")  FI
+  UNTIL pos (allowed, t) <> 0  PER;
+  t = "j" OR t = "J".
+
+standard antwort text:
+  IF std antwort
+    THEN "j"
+    ELSE "n"
+  FI.
+END PROC yes; 
+
+BOOL PROC yes (INT CONST spalte, zeile, TEXT CONST frage,
+               BOOL CONST std antwort) :
+  cursor (spalte, zeile);
+  yes (frage, std antwort).
+END PROC yes;
+
+PROC yes (TEXT CONST dummy): END PROC yes;
+
+PROC no  (TEXT CONST dummy): END PROC no;
+
+PROC editgetchar (INT CONST spalte, zeile,  TEXT CONST prompt, allowed,
+                  UNSIGNED VAR a) :
+  cursor (spalte, zeile);
+  editgetchar (prompt, allowed, a)
+END PROC editgetchar;
+
+PROC editgetchar (TEXT CONST prompt, allowed, UNSIGNED VAR a) :
+  (* Bietet Zeichen an (nehmen mit RETURN), nimmt nur die in allowed.
+     obere 8 Bit der Vorbesetzung werden abgeschnitten.
+  *)
+  TEXT VAR t;
+  test up or down (prompt, perhaps a);
+  a := a MOD 256;
+  IF current direction <> "" THEN LEAVE editgetchar  FI;
+  getchar (t);
+  IF t = ""13""
+  THEN (* Vorbesetzung behalten *)
+       out (right)
+  ELIF pos (allowed, t) <> 0
+  THEN a := code (t);
+       out (t)
+  ELSE out (t);
+       data error ("unzulässiges Zeichen")
+  FI.
+
+perhaps a:
+  IF a > 31 THEN code (a) ELSE ""  FI.
+END PROC editgetchar;
+
+(********* data error, write head, (reset) direction *********************)
+
+PROC data error (TEXT CONST fehlermeldung) :
+  cursor (1, 24);
+  out (""7"Fehler : " + fehlermeldung + "    (Bitte Taste) ");
+  REP UNTIL incharety (2) = "" PER; pause;
+  cursor (1, 24); out (""4"");
+  current direction := error
+END PROC data error;
+
+PROC write head (TEXT CONST headtext) :
+  TEXT CONST text :: subtext (headtext, 1, 77);
+  INT CONST luecke :: (79 - LENGTH text) DIV 2 - 1;
+  out (""1""4""15"");
+  luecke TIMESOUT " ";
+  out (text);
+  luecke TIMESOUT " ";
+  out (""14""13""10""10"").
+END PROC write head;
+
+TEXT PROC direction :
+  current direction
+END PROC direction;
+
+PROC reset direction (BOOL CONST manouvres possible) :
+  (* Hiermit kann die letzte Manövrierbewegung nach der Auswertung gelöscht
+     werden. Mit NOT manouvres possible wird der ganze Manövriermechanismus
+     außer Betrieb gesetzt.
+  *)
+  direction valid := manouvres possible;
+  current direction := ""
+END PROC reset direction;
+
+(*********************** put *******************************************) 
+ 
+PROC put (INT CONST spalte, zeile, UNSIGNED CONST a, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (a, r)
+END PROC put;
+
+PROC put (INT CONST spalte, zeile, LIST CONST l, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (l, r)
+END PROC put;
+
+PROC put (INT CONST spalte, zeile, RANGE CONST a, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (a, r)
+END PROC put;
+
+PROC put (UNSIGNED CONST a, REPRESENTATION CONST r) : 
+  put (text (a, r)) 
+END PROC put; 
+ 
+PROC put (LIST CONST a, REPRESENTATION CONST r) : 
+  INT VAR i, l :: LENGTH CONCR (a) DIV 2;
+  write ("(");
+  FOR i FROM 1 UPTO l REP 
+    put (text (CONCR (a) ISUB i, r)); 
+    IF i < l THEN put (",")  FI
+  PER; 
+  IF l > 0 THEN out (""8"")  FI;
+  put (")")
+END PROC put;
+
+PROC put (RANGE CONST a, REPRESENTATION CONST r) : 
+  write (text (a.low, r));
+  write ("...");
+  write (text (a.high, r))
+END PROC put;
+(*** ist put auf RANGE in dieser Weise sinnvoll ?
+     vielleicht lieber die Maske bitweise mit x, 1, 0 darstellen ?
+***)
+
+PROC put (BOOL CONST b):
+  IF b
+    THEN put ("Ja  ");
+    ELSE put ("Nein");
+  FI
+END PROC put;
+
+
+(********************* interne Hilfsprozeduren ****************************) 
+ 
+TEXT PROC text (UNSIGNED CONST a, REPRESENTATION CONST r) : 
+  TEXT VAR result :: "";
+  INT  VAR i;
+  set conversion (TRUE);
+  IF CONCR (r) = 10   THEN decimal form
+  ELIF CONCR (r) = 2  THEN binary form 
+  ELSE hex form  FI. 
+ 
+decimal form :
+  IF bit (a, 15)  (* dann kriegt man im Eumel negatives Vorzeichen *)
+  THEN result := text (real (text (a)) + 65536.0); (* Der Umweg ueber
+       Text ist noetig, wegen (1.8.0) real (-32767-1) --> stack overflow *)
+       subtext (result, 1, pos (result, ".") - 1) (* Dezimalpunkt weghauen *)
+  ELSE text (a)  FI. 
+
+binary form : 
+  FOR i FROM 15 DOWNTO 0 REP
+    IF bit (a, i) THEN result CAT "1" ELSE result CAT "0"  FI 
+  PER; 
+  result + "b". 
+ 
+hex form : 
+  INT VAR help :: a; 
+  FOR i FROM 1 UPTO 4 REP 
+    rotate (help, 4);    (* oberste 4 bit zu untersten 4 machen *)
+    result CAT (hex digits SUB nibble + 1);  (* oberste 4 bit darstellen *) 
+  PER; 
+  result + "h". 
+ 
+nibble : 
+  help MOD 16.   (* unterste 4 bit *) 
+END PROC text; 
+
+TEXT PROC textform (UNSIGNED CONST a) : 
+  (* speichert das INT in einen TEXT (mit ISUB lesbar) *) 
+  TEXT VAR ta :: "  ";
+  replace (ta, 1, a);
+  ta 
+END PROC textform; 
+ 
+TEXT PROC reverse (TEXT CONST a) : 
+  (* Text umdrehen. Das braucht man, um die ISUBS direkt vergleichen zu
+     koennen. 
+  *)
+  IF LENGTH a <= 1 THEN a 
+  ELSE reverse (subtext (a, 2)) + (a SUB 1)  FI 
+END PROC reverse;
+
+PROC test up or down (TEXT CONST prompt, data) :
+  IF current direction <> "" AND NOT direction valid
+  THEN current direction := "";
+       LEAVE test up or down
+  FI;
+  out (prompt);
+  out ("       "8""8""8""8""8""8"");  (* nächste 6 Zeichen Löschen *)
+  out (data); LENGTH data TIMESOUT ""8"";
+  IF NOT direction valid THEN LEAVE test up or down  FI;
+  getchar (current direction);
+  IF current direction = up OR current direction = down
+  THEN (* verschlucken, spaeter auswerten *)
+  ELSE push (current direction);
+       current direction := ""
+  FI
+END PROC test up or down;
+
+TEXT PROC to lower (TEXT CONST text) :
+  TEXT VAR t :: text;
+  INT  VAR i;
+  FOR i FROM 1 UPTO LENGTH t REP
+    IF (t SUB i) >= ""65"" AND (t SUB i) <= ""90""
+    THEN replace (t, i, code (code (t SUB i) + 32))  FI
+  PER;
+  t
+END PROC to lower;
+
+END PACKET setup eumel basisoperationen;
+
+
+
+PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)
+                          high byte,    (* Martin Schönbeck, Spenge *)
+                          low word,     (* Stand: 13.09.85          *)
+                          high word: 
+ 
+INT PROC high byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 2)
+
+END PROC high byte;
+
+INT PROC low byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 1)
+
+END PROC low byte; 
+ 
+INT PROC high word (REAL CONST double precission int):
+
+    int (double precission int / 65536.0)
+
+END PROC high word;
+
+INT PROC low word (REAL CONST double precission int): 
+ 
+    string of low bytes ISUB 1.
+
+string of low bytes:
+    code (int (double precission int MOD 256.0)) +
+    code (int ((double precission int MOD 65536.0) / 256.0)). 
+ 
+END PROC low word; 
+ 
+END PACKET splitting;
+
+
+
+PACKET basic block io DEFINES
+  verify track, 
+  read block,
+  write block:
+
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, 0, block no, return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, 0, block no, return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+PROC read block (DATASPACE VAR ds, INT CONST ds page,
+                 REAL CONST archive block):
+
+   enable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC read block;
+
+PROC write block (DATASPACE CONST ds, INT CONST ds page,
+                  REAL CONST archive block):
+
+   enable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC write block;
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, high word (block no) OR -512,
+                             low word (block no), return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, high word (block no) OR -512,
+                              low word (block no), return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+PROC verify track (DATASPACE VAR ds, INT CONST ds page no,
+                   REAL CONST startblock no, INT VAR return code):
+  block in (ds, ds page no, high word (startblock no) OR -256,
+                   low word (startblock no), return code);
+END PROC verify track;
+
+END PACKET basic block io;
+
+
+
+PACKET write file DEFINES write file,   (* Copyright (C) 1985, 1987 *)
+                          read file :   (* Martin Schönbeck, Spenge *)
+                                        (* Lutz Prechelt, Karlsruhe *)
+                                        (* Stand: 07.06.87          *)
+
+PROC write file (TEXT CONST file name, REAL CONST start block,
+                 INT CONST number of blocks): 
+ 
+    INT VAR count;
+    disable stop; 
+    DATASPACE VAR ds := old (file name);
+    FOR count FROM 0 UPTO (number of blocks - 1) REP 
+        write block (ds, count + 3, start block + real (count)) 
+    UNTIL is error PER; 
+    forget (ds). 
+ 
+END PROC write file; 
+ 
+PROC write file (TEXT CONST file name, REAL CONST start block,
+                 INT CONST number of blocks, write channel): 
+ 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF old channel <> write channel THEN continue (write channel)  FI;
+    disable stop;
+    write file (file name, start block, number of blocks);
+    IF old channel <> write channel
+    THEN break (quiet);
+         continue (old channel)
+    FI.
+END PROC write file;
+
+PROC read file (DATASPACE VAR file, REAL CONST start block,
+                 INT CONST number of blocks): 
+    INT VAR count;
+    disable stop; 
+    forget (file); file := nilspace;
+    FOR count FROM 0 UPTO (number of blocks - 1) REP 
+        read block (file, count + 3, start block + real (count)) 
+    UNTIL is error PER.
+END PROC read file; 
+ 
+PROC read file (DATASPACE VAR file, REAL CONST start block,
+                INT CONST number of blocks, read channel): 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF old channel <> read channel THEN continue (read channel)  FI;
+    disable stop;
+    read file (file, start block, number of blocks);
+    IF old channel <> channel
+    THEN break (quiet);
+         continue (old channel)
+    FI.
+END PROC read file;
+
+END PACKET write file;
+
+PACKET thesaurus utilities
+DEFINES ONE, certain :                     (* Stand: 21.03.88 *)
+                                           (* Korr : Lutz Prechelt *)
+LET  max entries = 200; 
+ 
+LET oben unten rubout return = ""3""10""12""13"";
+ 
+INT  VAR anzahl, 
+         firstline, size,  (* erste Bildschirmz./Anz. Zeilen für Vorgang *)
+         realc, virtc;     (* akt. Zeile in Fenster/Eintragsnummer *)
+ 
+TEXT VAR string; 
+ 
+THESAURUS PROC certain (THESAURUS CONST in, pre) :
+  einzelne (in, pre, TRUE).
+END PROC certain;
+
+TEXT OP ONE (THESAURUS CONST t): 
+  name (einzelne (t, empty thesaurus, FALSE),1) 
+END OP ONE; 
+ 
+THESAURUS PROC einzelne (THESAURUS CONST thes, preselections, 
+                         BOOL CONST viele): 
+  (* Benutzt nur den Rest des Bildschirms ab der aktuellen Zeile nach unten. 
+     Die in preselections enthaltenen Namen aus t sind bereits zu Beginn 
+     angekreuzt. 
+     Ein Aufruf mit NOT viele und preselections/t <> empty thesaurus ist
+     nicht sinnvoll.
+     Die Cursorposition nach Verlassen ist wieder in der "aktuellen" Zeile 
+     auf Position 1, so daß mit out (""4"") der Kram selektiv gelöscht
+     werden kann.
+  *)
+  ROW maxentries TEXT VAR eintrag;
+  THESAURUS VAR ausgabe :: empty thesaurus,
+                t :: empty thesaurus + thes;  (* Leereinträge entfernen! *)
+  INT VAR i; 
+  initialisiere ankreuzen;
+  IF anzahl = 0 THEN LEAVE einzelne WITH empty thesaurus FI;
+  bildschirm vorbereiten;
+  bild (1, eintrag); 
+  virtc := 1; 
+  realc := 1; 
+  realcursor setzen; 
+  kreuze an (viele, eintrag);
+  ausgabe erzeugen; 
+  cursor (1, firstline - 2); out (""4"");
+  ausgabe. 
+ 
+initialisiere ankreuzen:
+  anzahl := highest entry (t);
+  string := "";
+  (* t enthält keine Leereinträge mehr ! *)
+  FOR i FROM 1 UPTO anzahl REP 
+     eintrag [i] := name (t,i)
+  PER;
+  FOR i FROM 1 UPTO highest entry (preselections) REP 
+    INT CONST preselection link :: link (t, name (preselections, i));
+    IF preselection link > 0
+    THEN string CAT textstr (preselection link)  FI
+  PER.
+
+bildschirm vorbereiten: 
+  get cursor (i, firstline); 
+  out (""13""4"");  (* Restbildschirm löschen *)
+  IF viele
+  THEN putline ("Wählen <CR>  Löschen <RUBOUT>  " + 
+                "alle Löschen <HOP><RUBOUT>  Beenden <ESC>q") 
+  ELSE putline ("Auswählen <CR>")  FI;
+  putline ("Marke bewegen  <RUNTER>  <RAUF>  <HOP><RUNTER>  <HOP><RAUF>"); 
+  firstline INCR 2; 
+  size := 24 - firstline + 1.
+
+ausgabe erzeugen: 
+  WHILE string <> "" REP 
+    insert (ausgabe, eintrag [string ISUB 1]);
+    string := subtext (string, 3); 
+ PER 
+END PROC einzelne; 
+ 
+PROC realcursor setzen: 
+  TEXT CONST mark :: marke (virtc, TRUE);
+  cursor (1, firstline + realc - 1); 
+  out (mark + LENGTH mark * ""8"").
+END PROC real cursor setzen; 
+ 
+TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor): 
+  INT VAR pl :: nr (zeiger); 
+  IF pl = 0 
+     THEN leer
+     ELSE mit zahl
+  FI. 
+ 
+mit zahl: 
+  IF mit cursor 
+     THEN (3 - length (text (pl))) * "-" + text (pl) + "-> " 
+     ELSE text (pl, 3) + " > " 
+  FI. 
+ 
+leer: 
+  IF mit cursor 
+     THEN ">>>>> " 
+     ELSE "      "
+  FI 
+END PROC marke; 
+ 
+PROC bild (INT CONST anfang, ROW maxentries TEXT CONST eintrag): 
+  cursor (1, firstline);
+  out (""4""3"");    (* Restschirm löschen, 1 Zeile rauf *)
+  INT VAR i; 
+  FOR i FROM anfang UPTO grenze REP 
+     out (""13""10"");
+     out (marke (i, FALSE)); 
+     out (eintrag [i]) 
+  PER. 
+ 
+grenze: 
+  min (anzahl, anfang + size - 1)
+END PROC bild; 
+ 
+PROC kreuze an (BOOL CONST viele, ROW maxentries TEXT CONST eintrag) :
+  REP zeichen lesen; 
+      zeichen interpretieren 
+  PER. 
+ 
+zeichen lesen: 
+  TEXT VAR zeichen; 
+  inchar (zeichen, ""1""27""3""10""13"1Xx+"11""12"Oo0-"). 
+ 
+zeichen interpretieren: 
+  SELECT code (zeichen) OF 
+    CASE   1 (* hop *)    : hoppen (eintrag)
+    CASE  27 (* ESC *)    : IF incharety (600) = "q" THEN LEAVE kreuze an  FI
+    CASE   3 (* rauf *)   : nach oben (eintrag)
+    CASE  10 (* runter *) : nach unten (eintrag)
+    CASE  13 (* Return *) : ankreuzen (eintrag, TRUE); evtl aufhoeren
+    CASE  49,(* 1 *)
+          88,(* X *)
+         120,(* x *)
+          43,(* + *)
+          11 (* Rubin *)  : ankreuzen (eintrag, FALSE); evtl aufhoeren 
+    CASE  12,(* Rubout *)
+          79,(* O *)
+         111,(* o *)
+          48,(* 0 *)
+          45 (* - *)      : auskreuzen (eintrag)
+  END SELECT. 
+ 
+evtl aufhoeren: 
+  IF NOT viele THEN LEAVE kreuze an FI. 
+ 
+END PROC kreuze an; 
+ 
+PROC hoppen (ROW maxentries TEXT CONST eintrag) :
+  zweites zeichen lesen; 
+  zeichen interpretieren. 
+ 
+zweites zeichen lesen: 
+  TEXT VAR zz; 
+  inchar (zz).
+ 
+zeichen interpretieren: 
+  SELECT pos (oben unten rubout return, zz) OF 
+    CASE 1 : hop nach oben 
+    CASE 2 : hop nach unten 
+    CASE 3 : alles loeschen 
+    CASE 4 : rest ankreuzen
+    OTHERWISE out (""7"")
+  END SELECT. 
+ 
+rest ankreuzen:
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl REP     (* alles *)
+    IF nr (i) = 0                  (* was noch nicht angekreuzt ist *)
+       THEN string CAT textstr (i) (* ankreuzen *)
+    FI
+  PER;
+  bild aktualisieren.
+
+alles loeschen: 
+  string := ""; 
+  bild aktualisieren.
+ 
+hop nach oben: 
+  IF   ganz oben 
+       THEN out (""7"") 
+  ELIF oben im fenster    
+       THEN raufblaettern 
+       ELSE top of page 
+  FI. 
+ 
+ganz oben: 
+  virtc = 1. 
+ 
+oben im fenster: 
+  realc = 1. 
+ 
+raufblaettern: 
+  virtc DECR size;
+  virtc := max (virtc, 1); 
+  bild (virtc, eintrag); 
+  realcursor setzen. 
+ 
+top of page: 
+  loesche marke; 
+  virtc DECR (realc - 1); 
+  realc := 1; 
+  realcursor setzen. 
+ 
+hop nach unten: 
+  IF   ganz unten 
+       THEN out (""7"") 
+  ELIF unten im fenster 
+       THEN runterblaettern 
+       ELSE bottom of page 
+  FI. 
+ 
+ganz unten: 
+  virtc = anzahl. 
+ 
+unten im fenster: 
+  firstline + realc > 24. 
+ 
+runterblaettern: 
+  INT VAR alter virtc :: virtc; 
+  virtc INCR size;
+  virtc := min (virtc, anzahl); 
+  realc := virtc - alter virtc; 
+  bild (alter virtc + 1, eintrag);
+  realcursor setzen. 
+ 
+bottom of page: 
+  loesche marke; 
+  alter virtc := virtc; 
+  virtc INCR (size - realc); 
+  virtc := min (anzahl, virtc); 
+  realc INCR (virtc - alter virtc); 
+  realcursor setzen 
+END PROC hoppen; 
+ 
+PROC ankreuzen (ROW maxentries TEXT CONST eintrag, BOOL CONST ggf auskreuzen):
+  (* bei ggf auskreuzen wird der Eintrag, falls er schon angekreuzt ist,
+     ausgekreuzt, andernfalls normal angekreuzt.
+  *)
+  INT VAR pl :: nr (virtc); 
+  IF pl <> 0 
+     THEN schon angekreuzt
+  FI; 
+  string CAT textstr (virtc); 
+  IF virtc < anzahl THEN nach unten (eintrag) ELSE realcursor setzen  FI.
+
+schon angekreuzt :
+  IF ggf auskreuzen THEN auskreuzen (eintrag) ELSE out (""7"")  FI;
+  LEAVE ankreuzen.
+END PROC ankreuzen; 
+ 
+PROC auskreuzen (ROW maxentries TEXT CONST eintrag) :
+  INT VAR posi :: nr (virtc); 
+  IF posi = 0 
+     THEN out (""7""); LEAVE auskreuzen 
+  FI; 
+  rausschmeissen; 
+  loesche marke; 
+  bild aktualisieren; 
+  IF virtc < anzahl THEN nach unten (eintrag) FI.
+ 
+rausschmeissen: 
+  string := subtext (string,1, 2*posi-2) + subtext (string,2*posi+1) 
+END PROC auskreuzen; 
+ 
+PROC bild aktualisieren: 
+  INT VAR ob, un, i; 
+  ob := virtc - realc + 1; 
+  un := min (ob + size - 1, anzahl); 
+  cursor (1, firstline - 1); 
+  FOR i FROM ob UPTO un REP 
+    out (""13""10""); out (marke (i, FALSE))
+  PER;
+  realcursor setzen.
+END PROC bild aktualisieren; 
+ 
+PROC nach oben (ROW maxentries TEXT CONST eintrag) :
+  IF noch nicht oben   (* virtuell *) 
+     THEN gehe nach oben 
+     ELSE out (""7"") 
+  FI;
+  realcursor setzen.
+ 
+noch nicht oben: 
+  virtc > 1. 
+ 
+gehe nach oben: 
+  IF realc = 1 
+     THEN scroll down 
+     ELSE cursor up 
+  FI. 
+ 
+scroll down: 
+  virtc DECR 1; 
+  bild (virtc, eintrag).
+ 
+cursor up: 
+  loesche marke; 
+  virtc DECR 1; 
+  realc DECR 1.
+END PROC nach oben; 
+ 
+PROC nach unten (ROW maxentries TEXT CONST eintrag) :
+  IF noch nicht unten  (* virtuell *) 
+     THEN gehe nach unten
+     ELSE out (""7"")
+  FI. 
+ 
+noch nicht unten: 
+  virtc < anzahl. 
+ 
+gehe nach unten:
+  IF realc > size - 1 
+     THEN scroll up 
+     ELSE cursor down 
+  FI. 
+ 
+scroll up: 
+  virtc INCR 1; 
+  bild (virtc - size + 1, eintrag); 
+  realcursor setzen. 
+ 
+cursor down: 
+  loesche marke; 
+  virtc INCR 1; 
+  realc INCR 1; 
+  realcursor setzen 
+END PROC nach unten; 
+ 
+PROC loesche marke: 
+  out (marke (virtc, FALSE)) 
+END PROC loesche marke; 
+ 
+TEXT PROC textstr (INT CONST nr): 
+  TEXT VAR help :: "  "; 
+  replace (help, 1, nr); 
+  help.
+END PROC textstr; 
+ 
+INT PROC nr (INT CONST zeiger): 
+  IF pos (string, textstr (zeiger)) = 0 (* haut hin, da zeiger < 255 *)
+     THEN 0 
+     ELSE (pos (string,textstr (zeiger)) DIV 2) + 1 
+  FI 
+END PROC nr;
+
+PROC inchar (TEXT VAR t, TEXT CONST allowed) : 
+  REP 
+    getchar (t); 
+    IF pos (allowed, t) = 0 THEN out (""7"")  FI 
+  UNTIL pos (allowed, t) > 0  PER. 
+END PROC inchar; 
+ 
+END PACKET thesaurus utilities;
+
diff --git a/system/setup/3.1/src/setup eumel 2: modulzugriffe b/system/setup/3.1/src/setup eumel 2: modulzugriffe
new file mode 100644
index 0000000..42163f4
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 2: modulzugriffe
@@ -0,0 +1,441 @@
+
+(* Pakete:
+ 1. setup eumel modulzugriffe
+       Abstrakter Datentyp MODUL : Typ, Datenraumtyp, Zugriffsoperationen
+ 2. setup eumel modul und shard zugriffe
+       Zugriffe in Module und SHards (Datentyp MODUL) mit Strukturwissen
+*)
+ 
+(**************************************************************************)
+(***** Datentyp MODUL und Zugriffsoperationen dafür        ****************)
+(***** Copyright (c) 1987, 1988 by                         ****************)
+(***** Lutz Prechelt, Karlsruhe                            ****************)
+(**************************************************************************)
+
+PACKET setup eumel modulzugriffe            (* Copyright (c) 1987 by    *)
+DEFINES int, byte, text, unsigned,          (* Lutz Prechelt, Karlsruhe *)
+        dtcb abfragen,    ccb abfragen,     (* Stand : 12.03.88   1.1   *)
+        dtcb refinements, ccb refinements,  (* Eumel 1.8.1              *)
+        info,
+        page,
+        copy,
+        datenraumtyp modul,
+        MODUL :
+
+
+(* Dies Paket realisiert gezielte Zugriffe in einen Struct vom Typ MODUL.
+   Dies ist das Format eines SHard Moduls. Der Typ wird auch verwendet, um
+   das SHard-Hauptmodul oder einzelne ccbs zu handhaben!
+   Für die Adressierung der Bytes werden REAL-Werte verwendet, damit die
+   Größe nicht auf maxint beschränkt ist. Dies ist normalerweise sicher
+   (wegen der BCD-Arithmetik des Eumel), jedoch sind sinnlose nichtganzzahlige
+   Adressen dadurch möglich. Das wird aus Effizienzgründen nicht abgefangen,
+   die korrekte Benutzung liegt in der Verantwortung des Aufrufers.
+   Es sollen alle Zugriffe auf Module nur mit den Prozeduren dieses Pakets
+   abgewickelt werden.
+*) 
+ 
+ 
+INT CONST high only ::-256,
+          low  only :: 255;
+
+LET  max page = 128;
+
+TYPE MODUL =   STRUCT (ALIGN dummy, ROW 256 INT header,
+                      ROW max page ROW 256 INT b, 
+                      INT dtcb abfragen, ccb abfragen, 
+                      TEXT dtcb ref, ccb ref, info);
+
+(* Der Typ kann wegen des ALIGN direkt auf einen Datenraum (für ein Modul)
+   gelegt werden. Der Teil b fasst 64kB Daten und kann direkt für blockout
+   verwendet werden. Die restlichen Teile sind nur für Module relevant. 
+*) 
+ 
+INT CONST datenraumtyp modul :: 5687;  (* Typ eines MODUL als Datenraum *)
+
+(*********************** INT ********************************************)
+
+INT PROC int (MODUL CONST m, REAL CONST byte nr) : 
+  (* liefert das INT aus dem Modul m, das bei Byte "byte nr" beginnt *)
+  INT VAR   page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   whole int :: m.b[page][nr];
+  IF byte nr MOD 2.0 <> 0.0 
+  THEN rotate (whole int, 8); (* high und low byte vertauschen *)
+       (whole int AND low only) + next byte in high
+  ELSE whole int  FI.
+
+next byte in high :
+  IF nr = 256 THEN nr := 1; page INCR 1 ELSE nr INCR 1  FI;
+  INT VAR help :: m.b[page][nr] AND low only;
+  rotate (help, 8);
+  help.
+END PROC int;
+
+INT PROC int (MODUL CONST m, INT CONST byte nr) :
+  int (m, real (byte nr))
+END PROC int;
+
+PROC int (MODUL VAR m, REAL CONST byte nr, INT CONST new) :
+  (* schreibt den neuen 16-Bit Wert new ab dem Byte "byte nr" in den Teil b
+     des Moduls m. Hier kommt es nicht sehr aufs Tempo an, deshalb benutzen
+     wir hier einfach "byte".
+  *)
+  INT VAR value :: new;
+  rotate (value, 8); (* high byte zu low byte machen *)
+  byte (m, byte nr,       new   AND low only);
+  byte (m, byte nr + 1.0, value AND low only);
+END PROC int;
+
+PROC int (MODUL VAR m, INT CONST byte nr, INT CONST new) :
+  int (m, real (byte nr), new)
+END PROC int;
+
+(************************** BYTE *******************************************)
+
+INT PROC byte (MODUL CONST m, REAL CONST byte nr) : 
+  (* liefert das Byte mit der Nummer "byte nr" aus dem Teil b des Moduls m.
+     Das erste Byte hat die Nummer 0
+  *)
+  INT CONST page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   whole int :: m.b[page][nr];
+  IF byte nr MOD 2.0 <> 0.0 
+  THEN rotate (whole int, 8); (* high und low byte vertauschen *)  FI; 
+  whole int AND low only. 
+END PROC byte; 
+ 
+INT PROC byte (MODUL CONST m, INT CONST byte nr) :
+  byte (m, real (byte nr))
+END PROC byte;
+
+PROC byte (MODUL VAR m, REAL CONST byte nr, INT CONST new) :
+  (* Schreibt die unteren 8 bit von new an das Byte der Stelle byte nr im
+     Modul m
+  *)
+  INT CONST page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   new byte  :: new AND low only,
+            whole int :: m.b[page][nr];
+  m.b[page][nr] := new int.
+
+new int :
+  IF byte nr MOD 2.0 = 0.0  (* low byte ändern ? *)
+  THEN (whole int AND high only) + new byte
+  ELSE rotate (new byte, 8); (* new nach high rotieren *)
+       new byte + (whole int AND low only)
+  FI.
+END PROC byte;
+
+PROC byte (MODUL VAR m, INT CONST byte nr, INT CONST new) :
+  byte (m, real (byte nr), new)
+END PROC byte;
+
+(*********************** TEXT ********************************************)
+
+TEXT PROC text (MODUL CONST m, REAL CONST first byte nr, INT CONST length) : 
+  (* Extrahiert die naechsten length bytes aus m ab byte nr als TEXT *) 
+  REAL VAR i :: first byte nr;
+  TEXT VAR result :: ""; 
+  WHILE i < first byte nr + real (length) REP
+    result CAT code (byte (m, i)); 
+    i INCR 1.0
+  PER; 
+  result. 
+END PROC text; 
+ 
+TEXT PROC text (MODUL CONST m, INT CONST first byte nr, INT CONST length) : 
+  text (m, real (first byte nr), length)
+END PROC text;
+
+(* Ein schreibendes Analogon zu "text" gibt es nicht. *)
+
+(*********************** unsigned *****************************************)
+
+REAL PROC unsigned (INT CONST sixteen bits) :
+  (* hiermit kann man die Vorzeichenprobleme umschiffen, die der Eumel bei
+     INTs über maxint macht.
+     Liefert das INT als 16-Bit unsigned Wert interpretiert im REAL-Format.
+  *)
+  real (text (sixteen bits, dec))
+END PROC unsigned;
+
+INT PROC unsigned (REAL CONST sixteen bit value) :
+  (* Umkehrung des obigen : REAL 0..65536 rein, passenden 16 bit unsigned
+     Wert raus
+  *)
+  TEXT CONST t :: text (sixteen bit value);
+  int (unsigned (value text)).
+
+value text :
+  IF pos (t, ".") <> 0
+  THEN subtext (t, 1, pos (t, ".") - 1)
+  ELSE t
+  FI.
+END PROC unsigned;
+
+(******************** dtcb, ccb, info **************************************)
+
+INT PROC dtcb abfragen (MODUL CONST m) :
+  m.dtcb abfragen
+END PROC dtcb abfragen;
+
+PROC dtcb abfragen (MODUL VAR m, INT CONST neu) :
+  m.dtcb abfragen := neu
+END PROC dtcb abfragen;
+
+TEXT PROC dtcb refinements (MODUL CONST m) :
+  m.dtcb ref
+END PROC dtcb refinements;
+
+PROC dtcb refinements (MODUL VAR m, TEXT CONST neu) :
+  m.dtcb ref := neu
+END PROC dtcb refinements;
+
+INT PROC ccb abfragen (MODUL CONST m) :
+  m.ccb abfragen
+END PROC ccb abfragen;
+
+PROC ccb abfragen (MODUL VAR m, INT CONST neu) :
+  m.ccb abfragen := neu
+END PROC ccb abfragen;
+
+TEXT PROC ccb refinements (MODUL CONST m) :
+  m.ccb ref
+END PROC ccb refinements;
+
+PROC ccb refinements (MODUL VAR m, TEXT CONST neu) :
+  m.ccb ref := neu
+END PROC ccb refinements;
+
+TEXT PROC info (MODUL CONST m) :
+  m.info
+END PROC info;
+
+PROC info (MODUL VAR m, TEXT CONST neu) :
+  m.info := neu
+END PROC info;
+
+(********************* page **********************************************)
+
+(* Die Prozedur page dient dazu, aus dem Datenbereich b eines MODULs
+   einzelne Seiten (512 Byte Blöcke) in Form eines ROW 256 INT anzusprechen
+   um damit blockin/blockout zu machen.
+   Die Seitennummern gehen von 1 bis max page
+*)
+
+ROW 256 INT PROC page (MODUL CONST m, INT CONST page nr) :
+  m.b[page nr]
+END PROC page;
+
+PROC page (MODUL VAR m, INT CONST page nr, ROW 256 INT CONST new page) :
+  m.b[page nr] := new page
+END PROC page;
+
+(*********************** copy ********************************************)
+
+PROC copy (MODUL CONST from, REAL CONST origin,
+           MODUL VAR   to,   REAL CONST destination, INT CONST length) :
+  (* Kopiert schnell eine Anzahl von Bytes aus einem Modul in ein anderes
+     die Optimierung klappt nur, wenn von einer geraden Adresse an eine
+     gerade Adresse kopiert wird oder von ungerade nach ungerade.
+     Macht cout.
+  *)
+  INT  VAR i, interval :: cout interval;
+  REAL VAR offset :: 0.0;
+  IF length < 0 THEN errorstop ("copy : length = " + text (length))  FI;
+  IF origin MOD 2.0 <> destination MOD 2.0
+  THEN copy slow
+  ELSE copy fast  FI;
+  cout (length).
+
+cout interval :
+  IF   length > 1024   THEN 32
+  ELIF length >   64   THEN  8
+  ELSE                       1  FI.
+
+copy slow :
+  FOR i FROM 1 UPTO length REP
+    IF i MOD 2*interval = 0 THEN cout (i)  FI;
+    byte (to, destination + offset, byte (from, origin + offset));
+    offset INCR 1.0
+  PER.
+
+copy fast :
+  IF origin MOD 2.0 <> 0.0 AND length > 0
+  THEN byte (to, destination, byte (from, origin));
+       offset := 1.0
+  FI;
+  FOR i FROM 1 UPTO (length - int (origin MOD 2.0))  DIV 2 REP
+    INT CONST page1 :: int ((origin+offset) DIV 512.0) + 1,
+              nr1   :: int ((origin+offset) MOD 512.0) DIV 2 + 1,
+              page2 :: int ((destination+offset) DIV 512.0) + 1,
+              nr2   :: int ((destination+offset) MOD 512.0) DIV 2 + 1;
+    to.b[page2][nr2] := from.b[page1][nr1];
+    IF i MOD interval = 0 THEN cout (2*i)  FI;
+    offset INCR 2.0
+  PER;
+  IF length - int (offset) = 1
+  THEN byte (to, destination + offset, byte (from, origin + offset))  FI.
+END PROC copy;
+
+(************************ Hilfsprozeduren ********************************)
+
+REAL OP DIV (REAL CONST a, b) :
+  floor (a/b)
+END OP DIV;
+
+END PACKET setup eumel modulzugriffe;
+
+ 
+(**************************************************************************)
+(***** Zugriffe in Module mit Strukturwissen               ****************)
+(***** Copyright (c) 1988 by                               ****************)
+(***** Lutz Prechelt, Karlsruhe                            ****************)
+(**************************************************************************)
+
+PACKET setup eumel modul und shard zugriffe (* Copyright (c) 1988 by    *)
+DEFINES sh dtcb offset,                     (* Lutz Prechelt, Karlsruhe *)
+        sh ccb offset,                      (* Stand : 23.04.88   1.2   *)
+        get new channel table,              (* Eumel 1.8.1              *)
+        init modules list,
+        all modules,
+        module type,
+        module name:
+
+(* Dieses Paket definiert Operationen zum Zugriff auf bestimmte Daten in 
+   SHardmodulen und SHards. Es ist hierin Wissen über die Struktur dieser 
+   Teile enthalten. 
+   Beschreibung des SHardformats siehe setup eumel 4: modulkonfiguration
+*) 
+
+LET nr of channels total          = 40,
+    offset channel table pointer  = 10;
+
+THESAURUS VAR all the beautiful modules we know :: emptythesaurus;
+ 
+(******************* Kanaltabelle lesen/schreiben **************************)
+
+(* Hier geht schöne Struktur (und damit zugleich einfache Programmierung)
+   über gute Performance. (Wir lesen einiges mehrfach)
+*)
+
+REAL PROC sh dtcb offset (MODUL CONST shard, INT CONST kanal) :
+  unsigned (int (shard, ct + 4 * kanal)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh dtcb offset;
+
+REAL PROC sh ccb offset (MODUL CONST shard, INT CONST kanal) :
+  unsigned (int (shard, ct + 4 * kanal + 2)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh ccb offset;
+
+PROC sh dtcb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) :
+  int (shard, ct + 4 * kanal, unsigned (value)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh dtcb offset;
+
+PROC sh ccb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) :
+  int (shard, ct + 4 * kanal + 2, unsigned (value)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh ccb offset;
+
+PROC get new channel table (MODUL CONST new shard,
+                            ROW 256 INT VAR channel table of new shard) :
+  (* Kopiert die Kanaltabelle aus new shard nach
+     channel table of new shard
+  *)
+  INT VAR offset :: int (new shard, offset channel table pointer);
+  INT VAR  i;
+  FOR i FROM 1 UPTO 2 * nr of channels total REP
+    channel table of new shard [i] := int (new shard, offset);
+    offset INCR 2
+  PER.
+END PROC get new channel table;
+
+(********************* modules list handling *****************************)
+
+TEXT VAR m list;
+
+PROC init modules list :
+  (* Baut in der Variablen m list einen "Assoziativspeicher" für
+     Modulnamen <--> Modultyp auf und erstellt eine Liste aller
+     Shardmoduldateinamen für "all modules"
+     Der Text m list enthält für jede Datei, die ein SHardmodul enthält,
+     einen Eintrag folgender Form :
+     ""0"", modultyp, ""0"", Dateiname, ""0""
+     Dabei ist modultyp genau 4 Byte lang.
+     Diese Eintragsform ermöglicht ein (auf dem Eumel) sehr effizientes
+     Suchen, sowohl von Modultypen zu Modulnamen als auch umgekehrt.
+     Die Prozedur macht cout (dateinummer)
+  *)
+  INT VAR i;
+  TEXT VAR t;
+  m list := ""; all the beautiful modules we know := empty thesaurus;
+  FOR i FROM 1 UPTO highest entry (all) REP
+     cout (i);
+     t := name (all, i);
+     IF t <> "" CAND type (old (t)) = datenraumtyp modul
+     THEN add t  FI
+  PER.
+
+add t :
+  insert (all the beautiful modules we know, t);
+  TEXT CONST typ :: read module type (t);
+  m list cat typmarker;
+  m list CAT t;
+  m list CAT ""0"".
+
+m list cat typmarker :
+  m list CAT ""0"";
+  m list CAT typ;
+  m list CAT ""0"".
+END PROC init modules list;
+
+THESAURUS PROC all modules :
+  all the beautiful modules we know.
+END PROC all modules;
+
+TEXT PROC read module type (TEXT CONST datei) : 
+  (* Liefert den 4-Byte Modultyp des in der Datei datei enthaltenen 
+     SHardmoduls, falls möglich, andernfalls "" 
+  *) 
+  IF NOT exists (datei) COR type (old (datei)) <> datenraumtyp modul 
+  THEN ""
+  ELSE BOUND MODUL CONST m :: old (datei); 
+       text (m, int (m, 8), 4)
+  FI.
+END PROC read module type; 
+ 
+TEXT PROC module type (TEXT CONST module name) :
+  (* Liefert den 4-Byte Modultyp zu module name aus m list, sofern vorhanden
+     andernfalls ""
+  *)
+  INT CONST p :: pos (m list, ""0"" + module name + ""0"");
+  IF p = 0
+  THEN ""
+  ELSE subtext (m list, p - 4, p - 1)  FI.
+END PROC module type;
+
+TEXT PROC module name (TEXT CONST module type) :
+  (* Liefert den Moduldateinamen zum 4-Byte Modultyp module type, oder
+     "" falls kein solches Modul vorhanden.
+  *)
+  INT VAR p :: pos (m list, ""0"" + module type + ""0"");
+  IF p = 0
+  THEN ""
+  ELSE p INCR 6;
+       subtext (m list, p, pos (m list, ""0"", p) - 1)
+  FI.
+END PROC module name;
+
+END PACKET setup eumel modul und shard zugriffe;
+
diff --git a/system/setup/3.1/src/setup eumel 3: modulkonfiguration b/system/setup/3.1/src/setup eumel 3: modulkonfiguration
new file mode 100644
index 0000000..529d0de
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 3: modulkonfiguration
@@ -0,0 +1,854 @@
+
+(**************************************************************************)
+(***** Ergänzung des SHards um ein Modul (mit Dialog)     *****************)
+(***** Copyright (c) 1987, 1988 by                        *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel modulkonfiguration     (* Copyright (c) by         *)
+DEFINES configurate module,               (* Lutz Prechelt, Karlsruhe *)
+        print configuration,              (* Eumel 1.8.1              *)
+        give me, take you,                (* Stand : 12.07.88   3.2   *)
+        new index,                        
+        perform dtcb dialogue,
+        perform ccb  dialogue,
+        (* für Modulprogrammierer : *)
+        write info,
+        channel free,
+        reserve channel,
+        channels of this module,
+        buffer address :
+
+(* Dieses Modul führt den kompletten Dialog mit dem Benutzer durch, der
+   nötig ist, um alle Kanäle, die mit demselben Modul laufen sollen, zu 
+   konfigurieren. 
+   Verfahren : 
+      im alten SHard den dtcb suchen 
+      dtcb und Modul im neuen SHard eintragen
+      dtcb mit oder ohne Vorbild konfigurieren 
+      alle ccbs zu dem Modul im alten SHard suchen und Kanalnummern merken
+      Auswahl einer Kanalmenge durch Benutzer mit alten als Vorschlag
+      ccbs in neuen SHard kopieren
+      ccbs mit oder ohne Vorbild konfigurieren
+      Kanaltabelle auf den neuen Stand bringen
+      neuen Shard und seine geänderte Länge zurückgeben 
+
+   Dabei kann der "Dialog" bei geeigneten Rahmenbedingungen durch bloßes
+   Übertragen der Werte aus einem Vorlage-SHard ersetzt werden, wenn der
+   Benutzer dies wünscht (want automatic mode). Dann geht alles von selbst.
+   (....kaufen Sie Setup-Eumel und es geht alles wie von selbst !)
+
+Format des SHard-Hauptmoduls : 
+   1. (Byte 0-2)     jmp boot (3 Byte)
+   2. (Byte 3)       reserviert
+   3. (Byte 4)       SHard-Version
+   4. (Byte 5)       SHard-Release
+   5. (Byte 6/7)     SHardlänge (2 Byte)
+   6. (Byte 8/9)     Verweis auf Bad-Block Tabelle (2 Byte)
+   7. (Byte 10/11)   Verweis auf Kanaltabelle
+   8. (Byte 16-175)  Eumelleiste
+   9. (Byte 176-299) SHardleiste
+  10. (ab Byte 300)  Shardhauptmodulroutinen und -daten
+  11. (danach)       Rumpf des Hauptmoduls mit Bad-Block-Tabelle,
+                     Kanaltabelle, Routinen und Daten
+  12. (danach)       Folge der Module (bis Byte SHardlänge - 1)
+
+Kanaltabelle:
+        feste Länge 40 Einträge "nr of channels total" (Kanal 0 bis Kanal 39)
+        jeder Eintrag besteht aus : (alles 2 Byte) 
+        offset dtcb, offset ccb 
+ 
+Achtung : Dieses Programm schmiert bei SHards über 32767 Byte Länge
+          eventuell ab (es hat noch niemand probiert) !
+
+Abkürzungen: cb steht für control block und meint entweder ccb oder dtcb 
+ 
+Implementationsanmerkung :
+Bei der Verwendung von THESAURUS wird von dem Wissen über die Art der
+Implementation derselben Gebrauch gemacht, indem folgende Annahmen in den
+Code eingehen:
+1. Bei einem THESAURUS, in dem nicht gelöscht wurde, ist highest entry gleich
+   der Kardinalität
+2. außerdem entspricht dann die Nummer (link) eines Eintrags seinem
+   Eintragszeitpunkt, d.h. der Position in der Eintragsfolge
+3. + und - liefert THESAURi, in denen nicht gelöscht wurde und die Eintrags-
+   reihenfolge ist wie von den Parametern vorgegeben (bei + links zuerst)
+4. certain und ONE liefern THESAURi, in denen nicht gelöscht wurde.
+*)
+
+(************************* Daten ********************************)
+
+LET    nr of channels total          = 40,  (* SHard Tabellenlänge *)
+       mdts                          = 40,  (* max dialogtable size in INTs *)
+       mchm                          = 20,  (* max channels for module *)
+       offset sh version             = 4,
+       offset sh structureversion    = 5,
+       offset shardlength            = 6,
+
+       do name = "PrOgRaM tO Do";
+
+LET  UNSIGNED  = INT,
+     VARIABLES = ROW mdts ROW mchm INT;
+TEXT CONST variables var xxv :: "ROW " + text (mdts) + " ROW "+
+                                text (mchm) + " INT VARxxv;";
+
+VARIABLES VAR v;             (* siehe give me / take you *)
+
+INT  VAR max index;          (* Information für new index *)
+
+INT  VAR channels of module; (* Information für channels of this module *)
+
+TEXT VAR actual info;        (* fuer write info *)
+
+ROW 256 INT VAR channel table of new shard;  (* für channel free *)
+
+DATASPACE VAR dummy ds;      (* für print configuration *)
+
+REAL VAR new shard length;
+
+(***************************************************************************)
+(************* Hier geht's los...... ***************************************)
+(***************************************************************************)
+
+(******************** configurate module **********************************)
+
+PROC configurate module (MODUL VAR  new shard, MODUL CONST old shard,
+                         BOOL CONST old shard valid, want automatic mode,
+                         TEXT CONST modulname) :
+  do configurate module (new shard, old shard, old shard valid,
+                      want automatic mode, modulname, FALSE)
+END PROC configurate module;
+
+(********************** print configuration *******************************)
+
+PROC print configuration (MODUL CONST old shard, TEXT CONST modulname) :
+  (* Es ist hier schon sichergestellt, daß old shard valid ist und das Modul
+     auch im SHard enthalten
+  *)
+  forget (dummy ds); dummy ds := nilspace;
+  BOUND MODUL VAR dummy :: dummy ds;
+  do configurate module (dummy, old shard, TRUE, FALSE, modulname, TRUE);
+  forget (dummy ds).
+END PROC print configuration;
+
+
+(******************* do configurate module *********************************)
+
+PROC do configurate module (MODUL VAR  new shard, MODUL CONST old shard,
+                            BOOL CONST old shard valid, want automatic mode,
+                            TEXT CONST modulname,
+                            BOOL CONST print configuration only):
+  (* In dieser Prozedur ist die Beschränkung auf Module mit unter 32kB
+     Länge ausgenutzt.
+     Ist kein alter SHard vorhanden, so muss ein leerer SHard übergeben
+     werden (d.h. alle Einträge in der Kanaltabelle sind 0).
+     Ein alter SHard darf keinesfalls unterschiedliche releases desselben
+     Modultyps enthalten.
+     Resultierende SHardgesamtlängen von über 32k sind noch nicht getestet.
+  *)
+  BOUND MODUL VAR m;
+  INT VAR  (***** Daten über das neue Modul *****)
+           sh version, sh structure version, release,
+           max ccb, nr of ccbs,
+           dtcb table entries, offset dtcb table, (* Variablentabellen *)
+           ccb  table entries, offset ccb  table,
+           muster ccb length, offset muster ccb, (* Muster-ccb im Modul *)
+           module body length,  (* Länge des zu kopierenden Modulrumpfs *)
+           offset module body, offset dtcb;
+  TEXT VAR modultyp; (* 4 Byte *)
+  INT VAR  (***** Daten über den alten SHard *****)
+           old release :: -2;  (* garantiert inkompatibel *)
+  REAL VAR offset old dtcb :: 0.0;
+  ROW nr of channels total REAL VAR offset old ccb;
+  BOOL VAR old cbs valid :: FALSE;
+  THESAURUS VAR old channels :: empty thesaurus;
+  (***** Daten über den neuen SHard *****)
+  REAL VAR dtcb location;
+  ROW nr of channels total REAL VAR ccb location;
+  (***** Sonstige Daten *****)
+  INT  VAR i, k, kanal, ccb count;
+  BOOL VAR automatic mode, configurate :: NOT print configuration only;
+  reset direction (FALSE); (* zur Sicherheit *)
+  IF configurate
+  THEN new shard length := unsigned (int (new shard, offset shard length)) FI;
+  connect module;
+  get module data;
+  test sh version compatibility;      (* ggf. LEAVE *)
+  (* Bisher wurde nur gelesen, ab jetzt darf nicht mehr abgebrochen werden *)
+  search old shard for module and find all old ccbs;
+  test release compatibility;         (* ggf. LEAVE *)
+  IF configurate
+  THEN write module with dtcb to shard;
+       perhaps set automatic mode;
+  FI;
+  configurate dtcb;
+  IF configurate
+  THEN kopf;
+       select channels;
+       write ccbs to shard;
+  ELSE nr of ccbs := highest entry (old channels)
+  FI;
+  configurate ccbs;
+  IF configurate
+  THEN make entries in channeltable of new shard;
+       int (new shard, offset shardlength, unsigned (new shard length))
+  FI.
+
+connect module :
+  m := old (modulname);
+  actual info := info (m);
+  IF configurate
+  THEN kopf
+  ELSE put ("-----"); put (modulname); putline ("-----")
+  FI.
+
+get module data :
+  (* Format des Moduls in den ersten Bytes:
+     Byte    Entry
+     0/1     offset dtcb variablen tabelle
+     2/3     offset ccb  variablen tabelle
+     4/5     offset muster-ccb
+     6/7     offset modulrumpf
+     8/9     offset dtcb
+     10/11   max anzahl ccbs
+     die tabellen enthalten im ersten Wort die Anzahl ihrer Einträge
+     der modulrumpf und der ccb ihre Länge in Byte
+     die Länge der Tabellen ergibt sich aus den offset-Differenzen.
+     dtcb-Format : Modultyp (4 Byte)
+                   SHardversion (1 Byte)
+                   SHardstrukturversion (1 Byte)
+                   Modulrelease (2 Byte)     ....
+  *)
+  max ccb := int (m, 10);
+  offset dtcb table  := int (m, 0);
+  dtcb table entries := int (m, offset dtcb table);
+  offset ccb table   := int (m, 2);
+  ccb  table entries := int (m, offset ccb table);
+  offset muster ccb  := int (m, 4);
+  muster ccb length  := int (m, offset muster ccb);
+  offset module body := int (m, 6);
+  module body length := int (m, offset module body);
+  offset dtcb        := int (m, 8);
+(*****
+put ("  offset dtcb table:"); put(       offset dtcb table); line;
+put ("  dtcb table entrie:"); put(      dtcb table entries); line;
+put ("  offset ccb table :"); put(       offset ccb table);  line;
+put ("  ccb  table entrie:"); put(      ccb  table entries); line;
+put ("  offset muster ccb:"); put(       offset muster ccb); line;
+put ("  muster ccb length:"); put(       muster ccb length); line;
+put ("  offset module bod:"); put(      offset module body); line;
+put ("  module body lengt:"); put(      module body length); line;
+put ("  offset dtcb      :"); put(       offset dtcb);       line;*****)
+  modultyp            := text (m, offset dtcb, 4);
+  sh version          := byte (m, offset dtcb + 4);
+  sh structureversion := byte (m, offset dtcb + 5);
+  release             := int  (m, offset dtcb + 6).
+
+test sh version compatibility :
+  IF configurate AND NOT version is compatible
+  THEN putline ("Das Modul ist mit dieser SHard-Version nicht mehr verträglich.");
+       putline (""10""10""15"  Installation des Moduls wird abgebrochen.  "14""7""13""10"");
+       go on;
+       LEAVE do configurate module
+  FI.
+
+version is compatible:
+  (* Kompatibel, wenn das Modul eine ältere oder gleiche sh version verlangt
+     und die gleiche sh structureversion
+  *)
+  sh version <= byte (new shard, offset sh version) CAND
+  sh structure version = byte (new shard, offset sh structureversion).
+
+search old shard for module and find all old ccbs :
+  (* Es werden alle Kanäle des alten SHard untersucht, ob der dortige Treiber
+     den gleichen Modultyp hat und in diesem Fall die Kanalnummer in
+     "old channels" gesammelt, sowie offset old ccb gemerkt, im Nichterfolgs-
+     falle wird offset old ccb auf diesem Kanal 0 gesetzt.
+     Es werden auch alle verketteten Treiber untersucht.
+     Auch old cbs valid und offset old dtcb werden ggf. gesetzt.
+  *)
+  IF NOT old shard valid
+  THEN LEAVE search old shard for module and find all old ccbs  FI;
+  IF configurate THEN put ("Ich untersuche den alten SHard :")  FI;
+  FOR kanal FROM 0 UPTO nr of channels total - 1 REP
+    IF configurate THEN cout (kanal)  FI;
+    collect ccbs on this channel
+  PER;
+  IF configurate THEN put (""13""5"")  FI.  (* Zeile löschen *)
+
+collect ccbs on this channel :
+  REAL VAR p dtcb :: sh dtcb offset (old shard, kanal),
+           p ccb  :: sh ccb offset (old shard, kanal);
+  WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
+    BOOL CONST success :: text (old shard, p dtcb, 4) = modultyp;
+    IF success
+    THEN offset old dtcb := p dtcb;
+         old release     := int (old shard, p dtcb + 6.0);
+         insert (old channels, text (kanal));
+         offset old ccb [kanal+1] := p ccb
+    ELSE p dtcb := unsigned (int (old shard, p ccb + 2.0));  (* verkettet *)
+         p ccb  := unsigned (int (old shard, p ccb + 4.0))
+    FI
+  UNTIL success  PER;
+  old cbs valid := old shard valid AND offset old dtcb <> 0.0 AND
+                   (release = old release + 1 OR release = old release).
+
+test release compatibility:
+  IF print configuration only AND NOT old cbs valid
+  THEN putline ("Kein Zugriff auf die Konfigurationsdaten möglich");
+       LEAVE do configurate module
+  FI.
+
+write module with dtcb to shard :
+  put ("Modul """ + modulname + """ wird in den SHard eingetragen :");
+  IF int (new shard length MOD 2.0) <> offset module body MOD 2
+  THEN new shard length INCR 1.0  FI;   (* kopiert so schneller *)
+  dtcb location := new shard length +
+                      real (offset dtcb - offset module body);
+  copy (m, real (offset module body), new shard, new shard length,
+        module body length);
+  new shard length INCR real (module body length).
+
+perhaps set automatic mode :
+  IF old cbs valid AND old release = release
+  THEN automatic mode := want automatic mode
+  ELSE automatic mode := FALSE  FI.
+
+configurate dtcb :
+  IF configurate
+  THEN kopf;
+       putline ("Konfiguration des Treibers :");
+       get new channel table (new shard, channel table of new shard);
+  FI;
+  perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries,
+                         new shard, dtcb location,
+                         old shard, offset old dtcb,
+                         old cbs valid, release = old release,
+                         dtcb refinements (m), dtcb abfragen (m),
+                         automatic mode, print configuration only).
+
+select channels :
+  ccb count := highest entry (old channels);
+  k := min (ccb count, max ccb); (* .... Mutter der Porzellankiste *)
+  nr of ccbs := max (k, 1);
+  IF automatic mode THEN LEAVE select channels  FI;
+  IF max ccb > 1
+  THEN REP
+         editget ("Wieviele Kanäle mit diesem Treiber (1 bis " +
+                  text (max ccb) + ") : ", nr of ccbs);
+         out (""13"")
+       UNTIL nr of ccbs IN range (1, max ccb)  PER;
+       out (""10""10"")
+  ELSE nr of ccbs := 1  FI;
+  IF nr of ccbs < ccb count  (* weniger als früher *)
+  THEN put ("Wählen Sie mindestens"); putline (x kanäle aus deren);
+       putline ("Werte nicht als Vorbesetzung angeboten werden sollen"10"");
+       REP
+         THESAURUS CONST help :: certain (old channels, empty thesaurus);
+         IF NOT enough refused THEN out (""7"")  FI
+       UNTIL enough refused  PER;
+       old channels := old channels - help;
+       out (""3""3""3""4"")  (* clear screen from incl. "Wählen..." on *)
+  FI.
+
+x kanäle aus deren :
+  IF ccb count - nr of ccbs > 1
+  THEN text (ccb count - nr of ccbs) + " Kanäle aus, deren"
+  ELSE "einen Kanal aus, dessen"  FI.
+
+enough refused :
+  highest entry (help) >= ccb count - nr of ccbs.
+
+write ccbs to shard :
+  (* Ausserdem wird hier ccb location vorbereitet *)
+  out ("Die Kanäle werden in den neuen SHard eingetragen : ");
+  FOR i FROM 1 UPTO nr of ccbs REP
+    ccb location [i] := new shard length;
+    copy (m, real (offset muster ccb + 2), new shard, new shard length,
+         muster ccb length);
+    new shard length INCR real (muster ccb length)
+  PER.
+
+configurate ccbs :
+  (*put (old shard valid); put ("Release:"); put (release); put ("  old release:"); put (old release);
+    put (old cbs valid); pause;*)
+  IF configurate
+  THEN out (""13""10"Konfiguration der Kanäle:"13""10"");
+       get new channel table (new shard, channel table of new shard)  
+  FI;
+  ccb count := 0;
+  FOR kanal FROM 0 UPTO nr of channels total REP
+    IF old channels CONTAINS text (kanal)
+    THEN ccb count INCR 1;
+         offset old ccb [ccb count] := offset old ccb [kanal+1]
+    FI
+  PER;
+  FOR i FROM ccb count + 1 UPTO nr of ccbs REP
+    offset old ccb [i] := 0.0
+  PER;
+  perform ccb dialogue (m, real (offset ccb table+2), ccb table entries,
+                        new shard, ccb location,
+                        old shard, offset old ccb,
+                        nr of ccbs,
+                        offset old dtcb <> 0.0, release = old release,
+                        ccb refinements (m), ccb abfragen (m),
+                        automatic mode, print configuration only).
+
+make entries in channeltable of new shard :
+  kopf;
+  out ("Konfigurationsdaten werden in den neuen SHard eingetragen : ");
+  FOR i FROM 1 UPTO nr of ccbs REP
+    cout (i);
+    kanal := (*v[1][i]falsch???!!!*) byte (new shard, ccb location [i]);
+    make entry in channeltable of new shard
+  PER.
+
+make entry in channeltable of new shard :
+  IF NOT channel free (kanal)
+  THEN (* dtcb/ccb Adresse aus channel table nach neuem ccb umtragen. *)
+       int (new shard, ccb location [i] + 2.0,
+            unsigned (sh dtcb offset (new shard, kanal)));
+       int (new shard, ccb location [i] + 4.0,
+            unsigned (sh ccb offset (new shard, kanal)));
+  ELSE (* Folge-dtcb/ccb Adresse auf 0 setzen *)
+       int (new shard, ccb location [i] + 2.0, 0);
+       int (new shard, ccb location [i] + 4.0, 0);
+  FI;
+  (* Jetzt neue Adresse in channel table eintragen *)
+  sh dtcb offset (new shard, kanal, dtcb location);
+  sh ccb  offset (new shard, kanal, ccb location [i]);
+  k := byte (new shard, ccb location [i] + 1.0);  (* Zusatzkanalnummer *)
+  IF k <> 255  (* 255 = kein Zusatzkanal vorhanden *)
+  THEN (* IF NOT channel free (k) THEN alter eintrag futsch !!! *)
+       sh dtcb offset (new shard, k, dtcb location);
+       sh ccb  offset (new shard, k, ccb location [i])
+  FI.
+
+kopf :
+  write head ("""" + modulname + """ in den SHard aufnehmen");
+  out (actual info);
+  out (""13""10"").
+END PROC do configurate module;
+
+
+(********************* perform dialogue ************************************)
+
+PROC perform dtcb dialogue
+   (MODUL VAR m,          REAL CONST offset dialogue table, 
+    INT CONST dialogue table entries,
+    MODUL VAR   dtcb,     REAL CONST offset dtcb,
+    MODUL CONST old dtcb, REAL CONST offset old dtcb,
+    BOOL CONST old dtcb valid, same release,
+    TEXT CONST refinements, INT CONST count,
+    BOOL CONST automatic mode, print configuration only):
+  ROW nr of channels total REAL VAR offset cb, offset old cb;
+  offset cb [1]     := offset dtcb;
+  offset old cb [1] := offset old dtcb;
+  perform dialogue (TRUE, m, offset dialogue table, dialogue table entries,
+                    dtcb, offset cb, old dtcb, offset old cb, 1,
+                    old dtcb valid, same release, refinements, count,
+                    automatic mode, print configuration only).
+END PROC perform dtcb dialogue;
+
+PROC perform ccb dialogue
+   (MODUL VAR m,         REAL CONST offset dialogue table, 
+    INT CONST dialogue table entries,
+    MODUL VAR   ccb,     ROW nr of channels total REAL CONST offset ccb,
+    MODUL CONST old ccb, ROW nr of channels total REAL CONST offset old ccb,
+    INT CONST nr of ccbs, BOOL CONST old ccbs valid, same release,
+    TEXT CONST refinements, INT CONST count,
+    BOOL CONST automatic mode, print configuration only) : 
+  perform dialogue (FALSE, m, offset dialogue table, dialogue table entries,
+                    ccb, offset ccb, old ccb, offset old ccb, nr of ccbs,
+                    old ccbs valid, same release, refinements, count,
+                    automatic mode, print configuration only).
+END PROC perform ccb dialogue;
+
+
+PROC perform dialogue
+  (BOOL CONST is dtcb,
+  MODUL VAR m,       REAL CONST offset dialogue table, 
+  INT CONST dialogue table entries,
+  MODUL VAR   cb,     ROW nr of channels total REAL CONST offset cb,
+  MODUL CONST old cb, ROW nr of channels total REAL CONST offset old cb,
+  INT CONST nr of cbs, BOOL CONST old cb valid, same release,
+  TEXT CONST refinements, INT CONST refinement count,
+  BOOL CONST automatic mode, print configuration only) : 
+  (* Konfigurationsdialog für einen (Satz von) Kontrollblock(s) oder bloßes
+     Anzeigen der Konfigurationsdaten derselben.
+
+  1. bei NOT print configuration only:
+     Führt den Dialog für eine Tabelle (also ccb oder dtcb Variablentabelle) 
+     durch und bestückt den controlblock entsprechend. 
+     Es wird gleich eine ganze Tabelle von controlblocks (max. mchm Stück)
+     abgearbeitet und zwar nr of cbs Stück; im Falle is dtcb wird natürlich
+     nur der Eintrag 1 der Tabellen benutzt (vom Aufrufer).
+     Das Eingabemodul ist m mit der zu bearbeitenden Tabelle an der Stelle
+     offset dialogue table. Die Tabelle enthält dialogue table entries
+     Einträge (max. mdts Stück !)
+     Die Ausgabe des Prozesses landet im Modul cb ab den Stellen offset cb.
+     cb ist dabei jeweils der neue SHard, damit man nicht das Modul ändert.
+     Die Vorlagen zum Abgucken liefert, falls old cb valid ist, das
+     Modul old cb (der alte SHard) ab offset old cb, dabei ist die Struktur
+     gleich der neuen, wenn same release gilt, andernfalls sind die
+     Vorversionsoffsets zu benutzen (Versionsnummer um genau 1 erhöht).
+     Bei automatic mode werden nur still diese Vorgabewerte übernommen.
+     Die Elan-Teile für den Dialog liefert schliesslich der Text refinements,
+     er enthält refinement count Abfragen der Namen r1, r2, .....
+     Wenn refinent count = 0 ist, passiert hier eigentlich nichts,
+     deshalb sollte dann
+     für eine korrekte Initialisierung auch die Variablentabelle leer sein;
+     ist sie es allerdings doch nicht, werden hier noch die Standardwerte in
+     die ccbs eingetragen und nur der leere Dialog unterdrückt.
+     Vor Beginn/Nach Ende des gesamten Dialogs wird das refinement
+     dialoguestart/dialogueend aufgerufen; bei NOT is dtcb vor/nach dem Dialog
+     jedes Kanals auch noch channelstart/channelend.
+
+  2. bei print configuration only:
+     Die Daten zum new shard werden überhaupt nicht benutzt, von den
+     refinements wird nur für jeden Kanal einmal "print configuration"
+     aufgerufen.
+  *)
+  REAL VAR table byte :: offset dialogue table;
+  ROW mdts INT VAR offset, old offset, length;
+  INT  VAR i, k;
+  BOOL VAR configurate :: NOT print configuration only;
+  TEXT VAR program, t;
+  IF print configuration only       (* Hier wird evtl. schon verlassen *)
+  THEN startup for print
+  ELSE startup for dialogue  FI;
+  IF refinement count > 0 THEN build program  FI;
+  build data in v;
+  IF refinement count > 0 THEN do program  FI;
+  IF configurate THEN put values in cb  FI.
+
+startup for print :
+  IF refinement count = 0 OR dialogue table entries = 0
+  THEN LEAVE perform dialogue  FI.
+
+startup for dialogue:
+  IF refinement count = 0
+  THEN putline ("Keine Konfiguration notwendig.");
+       IF dialogue table entries = 0
+       THEN pause (20); LEAVE perform dialogue  FI
+  ELSE putline ("Die Konfiguration wird vorbereitet.")  FI.
+
+build program:
+  max index := refinement count;  (* damit new index bescheid weiss *)
+  program := variables var xxv;
+  program cat main part;
+  perhaps program cat data refinements;
+  program CAT refinements.
+
+program cat main part :
+  program CAT "LET UNSIGNED=INT;giveme(xxv);INT VARxxi::1,actchannel;";
+  IF print configuration only OR automatic mode
+  THEN program cat main part for print or automatic mode
+  ELSE program cat main part for dialogue  FI.
+
+program cat main part for print or automatic mode:
+  (* Leider muss man, wenn man den Modulprogrammierer bei den .ccb und .dtcb
+     Teilen nicht zu stark reglementieren will, einiges mitübersetzen, was
+     dann gar nicht benutzt wird (z.B. alle Refinements).
+           Und der Gedanke macht ihn blaß,
+           wenn er fragt: was kostet das ?
+                                     Wilhelm Busch
+  *)
+  program CAT "FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
+  IF print configuration only
+  THEN program CAT "printconfigurationPER."
+  ELSE (* automatic mode: *) program CAT "automaticPER;takeyou(xxv)."
+  FI;
+  program CAT " xxa:actchannel. thischannel:";
+  IF NOT is dtcb THEN program CAT "channelstart;"  FI;
+  FOR i FROM 1 UPTO refinement count REP
+    program CAT "r";         (* Alle in this channel aufrufen, damit  *)
+    program CAT text (i);    (* "LEAVE this channel" kein Fehler ist. *)
+    program CAT ";"
+  PER;
+  IF NOT is dtcb
+  THEN program CAT "channelend"  FI;
+  program CAT ". ".
+
+program cat main part for dialogue:
+  program CAT "dialoguestart;FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
+  program CAT "thischannelPER;dialogueend;takeyou(xxv). ";
+  program CAT "xxa:actchannel. thischannel:";
+  IF NOT is dtcb THEN program CAT "channelstart;"  FI;
+  program CAT "REP SELECTxxiOF ";
+  FOR i FROM 1 UPTO refinement count REP
+    program CAT "CASE ";
+    program CAT text (i);
+    program CAT ":r";
+    program CAT text (i);
+    program CAT " "
+  PER;
+  program CAT "ENDSELECT UNTIL NOTnewindex(xxi)PER";
+  IF NOT is dtcb
+  THEN program CAT ";channelend;reservechannel(xxv[1][xxa])"  FI;
+  program CAT ". ".
+
+perhaps program cat data refinements :
+  FOR i FROM 1 UPTO dialogue table entries REP
+    IF configurate THEN cout (i)  FI;
+    read start of next table entry; (* must be done in autom. mode, too,  *)
+    t := next variable name;        (* to get offset/oldoffset/length [i] *)
+    program CAT t;
+    program CAT ":xxv[";
+    program CAT text (i);
+    program CAT "][xxa]. ";  (* Das war der normale Eintrag "varname" *)
+    program CAT t;           (* Jetzt der für alle Kanäle "varname k" *)
+    program CAT "k:xxv[";
+    program CAT text (i);
+    program CAT "]. "
+  PER.
+
+read start of next table entry :
+  (* Format der Einträge in den Variablentabellen:
+     dw offset in cb
+     dw offset in old cb (oder ffffh falls neu)
+     db Typ (d.h. Länge und ist 1 oder 2)
+     db Namenslänge
+     db ...(Name)...
+  *)
+  INT CONST length of variable :: byte (m, table byte + 4.0),
+            length of name     :: byte (m, table byte + 5.0);
+  old offset [i] := int (m, table byte + 2.0);  (* Diese Sammlung *)
+  offset [i]     := int (m, table byte);  (* bereitet das Datenholen vor *)
+  length [i]     := length of variable;
+  IF length of variable < 1 OR length of variable > 2
+  THEN errorstop ("invalid variablelength : " + text (length of variable))
+  FI;
+  table byte INCR 6.0.
+
+next variable name:
+  table byte INCR real (length of name);
+  text (m, table byte - real (length of name), length of name).
+
+build data in v :
+  FOR k FROM 1 UPTO nr of cbs REP  (* Kanäle *)
+    IF configurate THEN cout (k)  FI;
+    FOR i FROM 1 UPTO dialogue table entries REP  (* Variablen *)
+      v[i][k] := next init value
+    PER
+  PER.
+
+next init value :
+  IF old cb valid CAND old cb present CAND value accessible
+  THEN value from old cb
+  ELSE value from new cb  FI.
+
+old cb present :
+  offset old cb [k] > 0.0.
+
+value accessible :
+  same release OR
+  (* Ein release zuvor und Variable gibts schon: *) old offset [i] <> -1.
+
+value from old cb :
+  IF length [i] = 1
+  THEN byte (old cb, offset old cb [k] + real (offset of old value))
+  ELSE int  (old cb, offset old cb [k] + real (offset of old value))
+  FI.
+
+value from new cb :
+  IF length [i] = 1
+  THEN byte (cb, offset cb [k] + real (offset [i]))
+  ELSE int  (cb, offset cb [k] + real (offset [i]))  FI.
+
+offset of old value :
+  IF same release
+  THEN offset [i]
+  ELSE old offset [i]  FI.
+
+do program :
+  reset direction (TRUE);
+  channels of module := nr of cbs;
+  IF setup testing
+    THEN (* für diesen THEN-Teil beim abgespeckten Eumel
+            setup eummel mini eumel dummies insertieren *)
+         forget (do name, quiet);
+         FILE VAR f := sequentialfile (output, do name);
+         putline (f, program);
+         (*edit (do name);*)
+         run (do name);
+         forget(do name, quiet);
+    ELSE do (program);
+  FI;
+  program := "";  (* Platz sparen *)
+  reset direction (FALSE).
+
+put values in cb :
+  FOR k FROM 1 UPTO nr of cbs REP
+    cout (k);
+    FOR i FROM 1 UPTO dialogue table entries REP
+      IF length [i] = 1 THEN put byte ELSE put int  FI
+    PER;
+  PER.
+
+put byte :
+  byte (cb, offset cb [k] + real (offset [i]), v[i][k]).
+
+put int :
+  int  (cb, offset cb [k] + real (offset [i]), v[i][k]).
+END PROC perform dialogue;
+
+(****************** give me, take you, new index ***************************)
+
+(* Diese Prozeduren werden aus dem do beim perform dialogue heraus aufgerufen
+   Sie dienen zur Kommunikation mit den Paketdaten dieses Pakets (give me,
+   take you) oder zur Verkleinerung des do-Programms (new index)
+*)
+
+PROC give me (VARIABLES VAR variables) :
+  (* Der Sinn dieser Prozedur besteht in Folgendem :
+     bei perform dialogue wird in dem do, das die refinements des
+     SHard-Moduls ausführt, eine Datenstruktur vom Typ VARIABLES aufgebaut,
+     die alle in den Variablentabellen des Moduls aufgeführten Variablen
+     enthält und einzeln über passend benannte refinements zugänglich macht.
+     Diese Datenstruktur wird zuvor in diesem Paket hier initialisiert mit
+     Initwerten aus der Variablentabelle oder wenn möglich mit den
+     entsprechenden Werten aus dem alten SHard. Mit give me fordert das
+     do-Programm die initialisierte Datenstruktur aus diesem Paket hier an.
+     Im do wird am Schluss mit take you diese Datenstruktur an dieses Paket
+     (und damit an perform dialogue) zurückgegeben, damit die durch den
+     Dialog gesetzten Werte in den neuen SHard eingetragen werden können.
+     Eine alternative Methode, diese Kommunikation zu realisieren, wäre die
+     Benutzung von BOUND VARIABLES VARs mit demselben Datenraum.
+   *)
+  variables := v
+END PROC give me;
+
+PROC take you (VARIABLES CONST variables) :
+  (* Gegenstück zu give me, siehe dort *)
+  v := variables
+END PROC take you;
+
+BOOL PROC new index (INT VAR index) :
+  (* Verändert den Index je nach der direction und fragt bei down am Ende,
+     ob fertig. Liefert, ob es noch weitergehen soll (falls nein: index = 1)
+  *)
+  LET up     = ""3"",
+      down   = ""10"",
+      error  = ""0"";
+  TEXT CONST old direction :: direction;
+  reset direction (TRUE);
+  IF old direction = error   (* Bei Fehlern immer stehenbleiben *)
+  THEN TRUE
+  ELIF index = max index     (* am Schluss aufhören oder nach 1 springen *)
+  THEN perhaps end
+  ELIF index = 1 AND old direction = up  (* bei 1 und up an den Schluss *)
+  THEN index := max index; TRUE
+  ELSE normal new index     (* sonst je nach direction up oder down *)
+  FI.
+
+perhaps end :  (* index = max index *)
+  IF old direction = up AND max index > 1    (* hoch vom Ende *)
+  THEN index DECR 1;
+       TRUE
+  ELIF old direction = up
+  THEN TRUE
+  ELIF old direction = down                  (* runter am Ende *)
+  THEN index := 1;
+       TRUE
+  ELSE reset direction (FALSE);          (* normal oder runter ans Ende *)
+       index := 1;
+       BOOL CONST ready :: yes (1, 23, "Fertig", FALSE);
+       reset direction (TRUE);
+       NOT ready
+  FI.
+
+normal new index :
+  IF old direction = up
+  THEN index DECR 1; TRUE
+  ELSE index INCR 1; TRUE  FI.
+END PROC new index;
+
+(******************** channel (table) handling *****************************)
+
+BOOL PROC channel free (INT CONST nr,
+                        ROW 256 INT CONST channel table of shard) :
+  IF nr < 0 OR nr > nr of channels total
+  THEN FALSE
+  ELSE channel table of shard [index ccb offset] = 0  FI.
+
+index ccb offset :
+  2 * nr + 1 + 1.
+END PROC channel free;
+
+BOOL PROC channel free (INT CONST nr) :
+  channel free (nr, channel table of new shard).
+END PROC channel free;
+
+PROC reserve channel (INT CONST nr,
+                      ROW 256 INT VAR channel table of shard) :
+  IF nr >= 0 AND nr < nr of channels total
+  THEN channel table of shard [index ccb offset] := 1  (* nichtnull *)  FI.
+
+index ccb offset :
+  2 * nr + 1 + 1.  (* Start nicht bei 0 und ccb hinter dtcb *)
+END PROC reserve channel;
+
+PROC reserve channel (INT CONST nr) :
+  reserve channel (nr, channel table of new shard).
+END PROC reserve channel;
+
+(*THESAURUS PROC free channels (ROW 256 INT VAR channel table of shard):
+  (* Liefert einen THESAURUS, der die Klartextform genau aller in
+     channel table of shard als frei angegebenen Kanäle enthält.
+  *)
+  INT VAR i;
+  THESAURUS VAR result :: empty thesaurus;
+  FOR i FROM 1 UPTO nr of channels total REP
+    IF channel free (i, channel table of shard)
+    THEN insert (result, text (i))  FI
+  PER;
+  result.
+END PROC free channels;*)
+
+INT PROC channels of this module :
+  channels of module.
+END PROC channels of this module;
+
+(********************* write info, buffer adress **************************)
+
+PROC write info :
+  putline (actual info)
+END PROC write info;
+
+INT PROC buffer address (INT CONST buffer size):
+  IF new shard length MOD 2.0 <> 0.0 THEN new shard length INCR 1.0 FI;
+  INT CONST buf adr := unsigned (new shard length);
+  new shard length INCR real (buffer size);
+  IF new shard length >= 65536.0 OR buffer size > 1024
+    THEN errorstop ("zu großer Puffer verlangt")
+  FI;
+  buf adr
+END PROC buffer address;
+
+(************************* Hilfsprozeduren *******************************)
+
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
+           INT VAR start module nr, BOOL CONST new init, ins, dump, lst,
+           sys, coder, rt check, sermon) :
+  EXTERNAL 256
+END PROC elan;
+
+PROC do (TEXT CONST long line) :
+  DATASPACE VAR ds;
+  INT VAR module nr :: 0;
+  elan (2, ds, long line, module nr, FALSE, FALSE, FALSE, FALSE,
+        FALSE, FALSE, FALSE, FALSE);
+  forget (ds);
+  no do again
+END PROC do;
+
+PROC go on :
+  put ("   >>>>> Taste drücken zum Weitermachen  ");
+  REPEAT UNTIL incharety (2) = ""  PER;
+  pause;
+  line.
+END PROC go on;
+
+END PACKET setup eumel modulkonfiguration;
+
diff --git a/system/setup/3.1/src/setup eumel 4: dienstprogramme b/system/setup/3.1/src/setup eumel 4: dienstprogramme
new file mode 100644
index 0000000..9ce9ca3
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 4: dienstprogramme
@@ -0,0 +1,218 @@
+ 
+(**************************************************************************)
+(***** Dienstprogramme für Modulprogrammierer             *****************)
+(***** Copyright (c) 1987, 1988                           *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel dienstprogramme            (* Copyright (c) 1987 by    *)
+DEFINES                                       (* Lutz Prechelt, Karlsruhe *)
+   file as one text,                          (* Stand : 07.05.88   1.4   *)
+   ich schreibe jetzt ein neues shard modul,  (* Eumel 1.8.1              *)
+   link shard module,
+   all modules:
+
+(* Dies sind Dienstprogramme, die der Modul-Programmierer braucht *) 
+
+(* Das Format der Refinementdateien für den dtcb- und ccb-Setupdialog ist wie
+   folgt:
+   1. Zeile: INT-Denoter für die Anzahl von Abfragerefinements, die drin sind
+             Rest der Zeile muß leer sein.
+   Danach  : lauter ELAN-Refinements mit den Namen r1, r2 usw.
+             evtl. weitere Refinements zur Hilfe mit beliebigen Namen (es
+             gibt ein paar Ausnahmen, über die man beim ersten Test dann aber
+             stolpert.)
+   In den Refinements dürfen Variablen vereinbart werden. Vor dem ersten
+   refinement der Datei darf KEIN Punkt sein (es ist sowieso schlechter
+   Stil, die Punkte nicht hinter die vorherige Zeile zu setzen, sondern
+   vor den refinementnamen.), hingegen MUSS nach dem letzten Refinement der
+   Datei ein Punkt stehen.
+   Wer das für nötig hält, kann auch Prozeduren definieren und verwenden,
+   was allerdings nicht geht, sind Pakete.
+   Wenn man mit Kommentaren und sonstigen Bytefressern sparsam
+   umgeht, läuft der Dialog beim Setup später etwas schneller an.
+*)
+
+LET modul namentyp         = "SHardmodul *";
+
+DATASPACE VAR ds;
+
+(***************************************************************************)
+
+THESAURUS PROC all modules (THESAURUS CONST th):
+  (* Hier wird schlabberig nach Namen ausgewählt, während der Setup Eumel
+     im Betrieb die Datenraumtypen als Auswahlkriterium verwendet.
+     Die Schwierigkeiten, die bei Nichteinhalten der Namenskonventionen
+     entstehen, veranlassen hoffentlich jeden zur nötigen Disziplin...
+  *)
+  (th LIKE "SHardmodul *") - (th LIKE "SHardmodul *.ccb")
+  - (th LIKE "SHardmodul *.dtcb") - (th LIKE "SHardmodul *.info")
+END PROC all modules;
+
+(*****THESAURUS PROC all modules:        wird sauber in Teil 2 realisiert
+  all modules (all)
+END PROC all modules;
+*****)
+
+(********************* link shard module *********************************) 
+
+PROC link shard module:
+  TEXT VAR module :: std;
+  REPEAT 
+    page; 
+    putline ("          L I N K   S H A R D - M O D U L E"); line (2);
+    put ("Modulname:"); editget (module); line (2); 
+    link shard module (module); line;
+  UNTIL NOT yes ("noch ein Modul linken", FALSE)  PER 
+END PROC link shard module;
+
+PROC link shard module (THESAURUS CONST th):
+   do (PROC (TEXT CONST) link shard module, th);
+END PROC link shard module;
+
+PROC link shard module (TEXT CONST module): 
+  (* Ruft link shard module (modul, dtcb, ccb, info) unter Anwendung von
+     Namenskonventionen (nämlich entsprechende Suffixe ".dtcb" etc.) auf.
+  *)
+  TEXT VAR dtcb, ccb, info;
+  BOOL VAR elan neu;
+  dtcb := module + ".dtcb"; 
+  ccb  := module + ".ccb"; 
+  info := module + ".info"; 
+  perhaps change filenames;
+  elan neu := yes (module + ": neue Elan Teile machen", FALSE);
+  IF elan neu THEN neue elan teile machen  FI;
+  link shard module (module, dtcb, ccb, info);
+  IF elan neu THEN check syntax FI.
+
+neue elan teile machen:
+  edit (dtcb); line (2);
+  edit (ccb);  line (2);
+  edit (info); page.
+
+perhaps change filenames:
+(*put ("Datei mit dtcb-refinements :"); editget (dtcb); line;
+  put ("Datei mit  ccb-refinements :"); editget (ccb);  line;
+  put ("Datei mit Infotext         :"); editget (info); line (2)*) .
+
+check syntax :
+  line (2); put (module); putline (": Syntax-Check");
+  forget (ds);
+  ds := nilspace;
+  BOUND MODUL VAR m :: old (module), old shard :: ds, new shard :: ds;
+  INT VAR  offset dtcb table  :: int (m, 0),
+           dtcb table entries :: int (m, offset dtcb table),
+           offset ccb table   :: int (m, 2),
+           ccb  table entries :: int (m, offset ccb table);
+  (* Jetzt einen total verkrüppelten automatischen "perform dialogue" für
+     die Probeübersetzung der .dtcb und .ccb refinements aufrufen.
+  *)
+  perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries,
+                         new shard, 0.0,
+                         old shard, 0.0,
+                         FALSE, FALSE,
+                         dtcb refinements (m), dtcb abfragen (m),
+                         TRUE, FALSE);
+  putline ("dtcb refinements O.K.");
+  ROW 40 REAL VAR x :: ROW 40 REAL : (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0);
+  perform ccb dialogue (m, real (offset ccb table+2), ccb table entries,
+                        new shard, x,
+                        old shard, x,
+                        1,
+                        FALSE, FALSE,
+                        ccb refinements (m), ccb abfragen (m),
+                        TRUE, FALSE);
+  putline ("ccb refinements O.K.");
+  forget (ds).
+END PROC link shard module;
+
+PROC link shard module (TEXT CONST module, dtcb, ccb, infofile) : 
+  IF type (old (module)) <> datenraumtyp modul CAND NOT typ aendern 
+  THEN LEAVE link shard module
+  ELSE type (old (module), datenraumtyp modul)  FI;
+  IF NOT (module LIKE modul namentyp)
+  THEN errorstop ("Module MÜSSEN Namen der Art """ + modul namentyp +
+                   """ haben")
+  FI;
+  line;
+  BOUND MODUL VAR m :: old (module); 
+  TEXT VAR dtcb ref :: file as one text (dtcb, FALSE), 
+           ccb  ref :: file as one text (ccb,  FALSE),
+           info text:: file as one text (infofile, TRUE); 
+  INT CONST pos dtcb :: pos (dtcb ref, " "), (* Ende der ersten Zeile, die *)
+            pos ccb  :: pos (ccb ref,  " "); (* die Abfragezahl enthält *)
+  INT VAR   dtcb count, ccb count;
+  dtcb count := int (subtext (dtcb ref, 1, pos dtcb)); 
+  IF NOT last conversion ok OR dtcb count < 0 OR dtcb count > 1000 
+  THEN errorstop ("keine vernünftige Zahl von dtcb Abfragen gefunden")  FI;
+  ccb count := int (subtext (ccb ref, 1, pos ccb)); 
+  IF NOT last conversion ok OR ccb count < 0 OR ccb count > 1000 
+  THEN errorstop ("keine vernünftige Zahl von ccb Abfragen gefunden")  FI;
+  (* JETZT PASSIERTS : *) 
+  dtcb abfragen (m, dtcb count); 
+  dtcb refinements (m, subtext (dtcb ref, pos dtcb + 1)); 
+  ccb abfragen (m, ccb count); 
+  ccb refinements (m, subtext (ccb ref, pos ccb + 1)); 
+  info (m, infotext);
+  line;
+  putline (""""+module+""" gelinkt. " + text (storage (old (module))) +
+           " K Datenraumgröße.").
+
+typ aendern :
+  IF type (old (module)) = 1003 (* file type *)
+  THEN putline ("(""" + module + """ hat den Typ FILE)")  FI;
+  putline ("Achtung: """ + module + """ ist nicht vom Typ eines SHard-Moduls");
+  yes ("Soll es dazu gemacht werden (Typ aufprägen)", FALSE).
+END PROC link shard module;
+
+(******************** file as one text ************************************) 
+ 
+TEXT PROC file as one text (TEXT CONST filename, BOOL CONST verbatim) : 
+  FILE VAR f :: sequential file (input, filename); 
+  TEXT VAR result :: "", t; 
+  put ("Lese """ + filename + """ :");
+  WHILE NOT eof (f) REP 
+    cout (line no (f));
+    getline (f, t);
+    work on t;
+    result CAT t
+  PER;
+  line;
+  result.
+
+work on t :
+  IF verbatim
+  THEN t CAT ""13""10""
+  ELSE t := compress (t); t CAT " "  FI.
+END PROC file as one text;
+
+(****** ich schreibe jetzt ein neues shard modul ***************************)
+
+PROC ich schreibe jetzt ein neues shard modul :
+  line (2);
+  putline ("So so, Sie wollen also ein neues SHard-Modul schreiben."); line;
+  pause (20);
+  putline ("Mir kommt es so vor, als sei heute der " + date +
+           " und im Moment gerade " + time of day + " Uhr"); line;
+  IF NOT yes ("Stimmt das ungefähr (auf 5 Minuten kommt's nicht an)", TRUE)
+  THEN do ("set date"); line (2) FI;
+  putline ("Also gut. Schreiben Sie Ihr verdammtes Modul.");
+  putline ("Aber merken Sie sich die folgenden 4 Bytes als ihren Modultyp");
+  put (""15"   ");
+  REAL VAR x :: floor (clock (1) - date ("05.05.79") - time ("10:00:00"));
+  INT VAR i;
+  FOR i FROM 1 UPTO 4 REP
+    put (int (x MOD 256.0));
+    x := floor (x / 256.0)
+  PER;
+  put ("  "14""); line (2);
+  putline ("Also : die Dinger merken (schreiben Sie sie auf, sonst vergessen Sie");
+  putline ("       sie ja doch) und NICHT MEHR ÄNDERN !");
+  line (3)
+END PROC ich schreibe jetzt ein neues shard modul;
+
+END PACKET setup eumel dienstprogramme;
+
diff --git a/system/setup/3.1/src/setup eumel 5: partitionierung b/system/setup/3.1/src/setup eumel 5: partitionierung
new file mode 100644
index 0000000..705f26d
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 5: partitionierung
@@ -0,0 +1,435 @@
+PACKET setup eumel partitionierung         (* Copyright (C) 1985       *)
+                                           (* Martin Schönbeck, Spenge *)
+DEFINES             tracks,                (* Lutz Prechelt, Karlsruhe *)
+                    sectors,               (* Änderungen: Ley    ms    *)
+                    heads,                 (* Stand: 07.04.89          *)
+                    first track,
+                    last track,
+                    partition start,
+                    partition type,
+                    partition active,
+                    partition size,
+                    partition word 0,
+
+                    get boot block,
+                    put boot block,
+                    clear partition,
+
+                  (*get bad track table,*)
+                    get bad sector table,
+                    clear partition table,
+                    setup channel,
+                    start of partition:
+
+    LET bst size             = 1024;  (* nr of bad sector table entrys *)
+
+ROW 256 INT VAR boot block;
+INT VAR boot block session := session - 1;
+INT VAR fd channel         := 28;    (* Festplatten-Setupkanal *)
+
+INT PROC setup channel:
+   fd channel
+END PROC setup channel;
+
+PROC setup channel (INT CONST new channel):
+    enable stop;
+    teste kanal typ;
+    boot block session DECR 1;
+    wirf altes pac raus;
+    fd channel := new channel;
+    sorge dafuer dass kanal uptodate ist.
+
+teste kanal typ:
+    IF (get value (1, new channel) AND 12) <> 12
+       THEN errorstop ("Hier gibt es leider keine Platte")
+    FI.
+
+wirf altes pac raus:
+    IF new channel <> fd channel
+        THEN INT VAR raus := get value (-13, fd channel);
+    FI.
+
+sorge dafuer dass kanal uptodate ist:
+   INT VAR old channel := channel; 
+   ROW 256 INT VAR dummy; INT VAR i;
+   continue (new channel);
+   disable stop;
+   blockin (dummy, -1, -1, i);
+   break (quiet);
+   continue (old channel).
+
+END PROC setup channel;
+
+PROC get bad sector table (ROW bst size REAL VAR bb tab,
+                           INT VAR bad sect, INT CONST eumel type):
+    initialisiere tabelle;
+    suche schlechte sectoren.
+
+initialisiere tabelle:
+    INT VAR i;
+    FOR i FROM 1 UPTO bst size REP
+      bb tab [i] := -1.0;
+    PER.
+
+suche schlechte sectoren:
+    INT VAR  my channel := channel;
+    REAL VAR sector := start of partition (eumel type),
+             end := sector + partition size (partition number (eumel type)),
+             track mode restart :: 0.0;
+    INT VAR  akt track := 0,
+             fehler code;
+    bad sect := 1;  (* Eintragsnr. des NÄCHSTEN schlechten Sektors *)
+    continue (fd channel);
+    disable stop;
+    DATASPACE VAR ds := nilspace;
+    REAL CONST cylinder size :: real (sectors * heads),
+               track size    :: real (sectors);
+    track mode restart := sector + track size -
+                              (sector MOD track size);
+     (* wenn sector nicht erster der spur, dann die erste einzeln *)
+    WHILE sector < end REP
+         IF sector MOD cylinder size = 0.0
+         THEN melde naechste spur  FI;
+         IF sector >= track mode restart
+         THEN check track
+         ELSE check sector  FI
+    UNTIL bad sect > bst size OR is error PER;
+    continue (my channel);
+    forget (ds);
+    enable stop;
+    IF bad sect > bst size 
+        THEN errorstop ("Zu viele schlechte Sektoren"); 
+    FI;
+    lass nicht zu dass ein ersatzsektor ein schlechter ist;
+    bad sect DECR 1.  (* ANZAHL schlechter Sektoren *)
+
+melde naechste spur:
+   break (quiet);
+   continue (my channel);
+   akt track INCR 1;
+   cout (akt track);
+   continue (fd channel).
+
+check track :
+  verify track (ds, 2, sector, fehler code);
+  IF schlechten sektor gefunden
+  THEN track mode restart := sector + tracksize
+  ELSE sector INCR track size  FI.
+
+check sector :
+  read block (ds, 2, sector, fehler code);
+  IF schlechten sektor gefunden 
+  THEN eintragen  FI;
+  sector INCR 1.0.
+
+schlechten sektor gefunden:
+    SELECT fehler code OF
+       CASE 0: FALSE
+       CASE 1: error stop ("Platte kann nicht gelesen werden"); FALSE
+       CASE 2: TRUE
+       CASE 3: error stop ("Versorgungsfehler beim Plattentest"); FALSE
+       OTHERWISE error stop ("unbekannter Fehler auf Platte"); FALSE
+    END SELECT.
+
+eintragen:
+    bb tab [bad sect] := sector;
+    bad sect INCR 1.
+
+lass nicht zu dass ein ersatzsektor ein schlechter ist:
+    REAL VAR aktueller ersatz := end - real (bad sect - 1);
+    INT VAR akt b sect;
+    FOR akt b sect FROM 1 UPTO bad sect - 1 REP
+        IF aktueller ersatz ist in tabelle
+            THEN vertausche aktuell zu ersetzenden mit ihm
+        FI;
+    PER.
+
+aktueller ersatz ist in tabelle:
+    INT VAR such index;
+    FOR such index FROM 1 UPTO bad sect REP
+       IF aktueller ersatz = bb tab (such index)
+           THEN LEAVE aktueller ersatz ist in tabelle WITH TRUE
+       FI;
+    PER;
+    FALSE.
+
+vertausche aktuell zu ersetzenden mit ihm:
+    bb tab ( such index ) := bb tab ( akt b sect );
+    bb tab (akt b sect)   := aktueller ersatz.
+END PROC get bad sector table;
+
+INT PROC cyl and head (REAL CONST sector):
+     cylinder code (int (sector / real (sectors)) DIV heads) OR head.
+
+head :
+  (int (sector / real (sectors)) MOD heads).
+END PROC cyl and head;
+
+PROC get boot block:
+    IF boot block session <> session
+       THEN hole aktuellen boot block
+    FI.
+
+hole aktuellen bootblock :
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    get external block (dummy ds, 2, 0, fd channel); 
+    IF NOT is error
+        THEN transfer data to boot block
+    FI; 
+    forget (dummy ds). 
+ 
+transfer data to boot block:
+    IF not valid boot block
+        THEN try to get valid boot block from file
+    FI;
+    boot block := partition table. block;
+    boot block session := session.
+
+not valid boot block:
+    partition table. block [256] <> boot indicator OR
+    it is an old boot block of eumel.
+
+boot indicator: -21931.
+
+it is an old boot block of eumel:
+    partition table. block [1] = 1514.
+
+try to get valid boot block from file:
+    forget (dummy ds);
+    partition table := old ("bootblock");
+    IF is error THEN LEAVE transfer data to boot block FI.
+END PROC get boot block;
+
+PROC clear partition table (INT CONST sicherung):
+    IF sicherung = -3475 
+       THEN neuen boot block;
+            put boot block
+    FI.
+
+neuen boot block:
+    enable stop;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table;
+    partition table := old ("bootblock");
+    boot block := partition table. block;
+    boot block session := session.
+END PROC clear partition table;
+
+PROC put boot block:
+    IF boot block ist uptodate
+        THEN schreibe block auf platte
+        ELSE errorstop ("boot block nicht uptodate")
+    FI.
+
+boot block ist uptodate:
+    boot block session = session.
+
+schreibe block auf platte:
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    transfer data to dataspace;
+    put external block (dummy ds, 2, 0, fd channel); 
+    forget (dummy ds). 
+ 
+transfer data to dataspace:
+    partition table. block := boot block.
+END PROC put boot block;
+
+INT PROC partition number (INT CONST part type):
+    INT VAR partition;
+    FOR partition FROM 1 UPTO 4 REP
+         IF partition type (partition) = part type
+              THEN LEAVE partition number WITH partition
+         FI
+    PER;
+    errorstop ("Partitiontyp gibt es nicht");
+    7.
+END PROC partition number;
+
+INT PROC partition word 0 (INT CONST partition):
+   boot block (entry (partition))
+END PROC partition word 0;
+
+PROC partition word 0 (INT CONST partition, word):
+   boot block (entry (partition)) := word
+END PROC partition word 0;
+
+REAL PROC start of partition (INT CONST partition type):
+    partition start (partition number (partition type))
+END PROC start of partition;
+ 
+
+INT PROC first track (INT CONST partition):
+    high byte (boot block [entry (partition) + 1]) 
+       + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) 
+END PROC first track;
+
+INT PROC last track (INT CONST partition):
+    high byte (boot block [entry (partition) + 3]) 
+       + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) 
+END PROC last track;
+
+INT PROC partition type (INT CONST partition):
+    low byte (boot block [entry (partition) + 2])
+END PROC partition type;
+
+BOOL PROC partition active (INT CONST partition):
+    low byte (boot block [entry (partition)]) = 128
+END PROC partition active;
+
+(****************** neu eingefügt ******************************)
+PROC partition active (INT CONST partition, BOOL CONST active):
+   IF active THEN activate this partition
+             ELSE deactivate this partition
+   FI.
+
+deactivate this partition:
+    set bit (boot block [entry (partition)], 7);
+    (* first setting needed, because reset bit does xor *)
+    reset bit (boot block [entry (partition)], 7).
+
+activate this partition:
+    set bit (boot block [entry (partition)], 7).
+END PROC partition active;
+
+(****************** neu eingefügt ******************************)
+ 
+PROC first track (INT CONST partition, cylinder):
+    boot block [entry (partition) + 1]
+            := cylinder code (cylinder) OR start sector.
+
+start sector:
+    IF cylinder = 0
+        THEN 2
+        ELSE 1
+    FI.
+END PROC first track;
+
+PROC last track (INT CONST partition, cylinder):
+    boot block [entry (partition) + 3] := cylinder code (cylinder).
+END PROC last track;
+
+PROC partition type (INT CONST partition, type):
+    boot block [entry (partition) + 2] := type.
+END PROC partition type;
+
+REAL PROC partition start (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 4])) +
+    real (high byte (boot block [entry (partition) + 4])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 5]) * 65536.0.
+END PROC partition start;
+
+PROC partition start (INT CONST partition, REAL CONST sector offset):
+    boot block [entry (partition) + 4] := low word (sector offset);
+    boot block [entry (partition) + 5] := high word (sector offset)
+END PROC partition start;
+
+REAL PROC partition size (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 6])) +
+    real (high byte (boot block [entry (partition) + 6])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 7]) * 65536.0.
+END PROC partition size;
+
+PROC partition size (INT CONST partition, REAL CONST number of blocks):
+    boot block [entry (partition) + 6] := low word (number of blocks);
+    boot block [entry (partition) + 7] := high word (number of blocks)
+END PROC partition size;
+ 
+PROC clear partition (INT CONST partition):
+    INT VAR i;
+    FOR i FROM 0 UPTO 7 REP
+        boot block [entry (partition) + i] := 0
+    PER
+END PROC clear partition;
+
+INT PROC entry (INT CONST partition):
+    get boot block;
+    256 - 5 * 8 + (partition * 8)
+END PROC entry;
+
+INT PROC cylinder code (INT CONST cylinder):
+    cylinder text ISUB 1.
+
+cylinder text:
+    high cylinder bits + low cylinder bits.
+
+high cylinder bits:
+    code ((cylinder AND (256 + 512)) DIV 4).
+
+low cylinder bits:
+    code (cylinder AND (128 + 64 + 32 + 16 + 8 + 4 + 2 + 1)).
+END PROC cylinder code;
+
+INT PROC tracks: 
+   get value (-10, fd channel) 
+END PROC tracks; 
+ 
+INT PROC sectors: 
+   get value (-11, fd channel) 
+END PROC sectors; 
+ 
+INT PROC heads: 
+   get value (-12, fd channel) 
+END PROC heads;
+ 
+INT PROC get value (INT CONST control code, channel for value): 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF channel for value <> old channel THEN continue (channel for value)  FI;
+    INT VAR value; 
+    control (control code, 0, 0, value); 
+    IF channel for value <> old channel THEN continue (old channel)  FI;
+    value 
+END PROC get value; 
+ 
+PROC get external block (DATASPACE VAR ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC get external block;
+
+PROC put external block (DATASPACE CONST ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC put external block;
+
+END PACKET setup eumel partitionierung;
+
diff --git a/system/setup/3.1/src/setup eumel 6: shardmontage b/system/setup/3.1/src/setup eumel 6: shardmontage
new file mode 100644
index 0000000..cc0d475
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 6: shardmontage
@@ -0,0 +1,389 @@
+
+(**************************************************************************)
+(***** Zusammenbau eines SHards aus Modulen mit Dialog    *****************)
+(***** Copyright (c) 1987, 1988 by                        *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel shardmontage        (* Copyright (c) 1987 by    *)
+DEFINES build shard,                   (* Lutz Prechelt, Karlsruhe *)
+        add bad sector table to shard, (* Stand : 08.04.88   3.2   *)
+        installation nr,               (* Eumel 1.8.1              *)
+        print configuration :
+
+(* Beschreibung des SHard-Hauptmodulformats siehe "modulkonfiguration" *)
+
+(* In diesem Paket sind viele Namenskonventionen verankert. 
+   Das leere SHard-Hauptmodul hat den Namen "SHard leer", teilaufgebaute
+   SHards heissen normalerweise in der Form "SHard 07.07.87 14:34" (andere
+   Namen sind möglich, wenn sie mit "SHard " beginnen.)
+   Die Prozedur build shard bastelt in Dialogsteuerung durch den Benutzer
+   aus Modulen und einem leeren oder teilaufgebauten SHard-Hauptmodul einen 
+   neuen SHard zusammen und schreibt ihn in die Datei SHARD 
+   Die Prozedur add bad block table to shard fügt einem so zusammengebauten
+   SHard eine bad block tabelle gemäß dem Zustand der Partition hinzu oder
+   ändert die vorhandene.
+   Dann ist der SHard komplett fertig zum auf-die-Partition-schleudern.
+   (einschliesslich Installationsnummer)
+*) 
+ 
+LET hauptmodul namentyp    = "SHard *", 
+  (*modul namentyp         = "SHardmodul *",*)
+    shard name             = "SHARD";
+
+LET bad sector table size            = 1024,   (* Entries *)
+    max sh length                    =   60,   (* Blocks, vorläufig !!! *)
+    nr of channels total             =   40,
+    offset shard length              =    6,
+    offset bad sector table pointer  =    8,
+    offset verbal identification     =  176,   (* Start Shardleiste *)
+    offset id 4                      =  196;   (* 176 + 14h *)
+
+INT VAR actual installation nr :: id (5);
+DATASPACE VAR ds :: nilspace;
+ 
+PROC build shard (DATASPACE CONST old shard ds) :
+  (* Der Aufrufer muß hinterher nachsehen, ob es die Datei SHARD auch
+     wirklich gibt. Falls nicht, ist "Aufbau des SHards war nicht möglich"
+     zu melden.
+  *)
+  BOUND MODUL VAR old shard :: old shard ds, new shard;
+  TEXT VAR t;
+  INT  VAR i;
+  THESAURUS VAR th, modules, automatic mode modules,
+                modules in old shard, modules in new shard;
+  BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
+                                  verbal identification ok;
+  perhaps take old shard;  (* ggf. LEAVE *) 
+  get main module name in t;
+  copy (t, shard name);
+  new shard := old (shard name);
+  enable stop;
+  eliminate bad sector table from shard (new shard);
+  get module names; 
+  configurate modules and build shard;
+  add ids.
+ 
+verbal identification ok :
+  text (old shard, offset verbal identification, 16) =
+  "SHard Schoenbeck".
+
+perhaps take old shard : 
+  kopf; 
+  forget (shard name, quiet); 
+  IF old shard valid CAND 
+     yes ("Wollen Sie den SHard genauso wie beim letzten Setup", FALSE) 
+  THEN copy (old shard ds, shard name); LEAVE build shard
+  ELSE out (""10"")  FI.
+ 
+get main module name in t : 
+  putline ("   A u s w a h l   d e s   S H a r d - H a u p t m o d u l s "10"");
+  th := all LIKE hauptmodul namentyp;
+  IF highestentry (th) > 1
+  THEN let the user select one
+  ELSE take the only one  FI.
+
+let the user select one :
+  putline ("Wählen Sie jetzt bitte, welches SHard-Hauptmodul Sie als"); 
+  putline ("Ausgangspunkt der Konfiguration benutzen möchten."); 
+  putline ("(Namen durch Zeiger auswählen dann RETURN-Taste drücken)"); 
+  t := ONE th;
+  out (""4""13""10""10""10""). 
+
+take the only one :
+  t := name (th, 1);
+  putline ("Das einzige verfügbare SHard Hauptmodul ist");
+  putline (t);
+  pause (30).
+
+get module names :
+  (* Besorgt die Listen 1. vorhandene Module   2. Module im alten SHard
+     und 3. Module im SHard Hauptmodul
+     Liefert in modules eine Auswahl von 1. ohne 3. mit 2. als Vorschläge
+     und in automatic mode modules eine Auswahl von 2. (alles vorgeschlagen)
+     Die Liste 2. ist dabei so sortiert, daß stets eingekettete Module in der
+     richtigen Reihenfolge auftauchen.
+  *)
+  kopf;
+  put ("Ich untersuche den SHard: ");
+  get modules in shard (new shard, modules in new shard);
+  IF old shard valid
+  THEN get modules in shard (old shard, modules in old shard)
+  ELSE modules in old shard := empty thesaurus  FI;
+  kopf;
+  putline ("Wählen Sie jetzt bitte mit RETURN/rauf/runter, welche Module Sie");
+  putline ("mit in den SHard aufnehmen möchten.");
+  putline ("(Zum Verlassen ESC q)");
+  modules := certain (all modules - modules in new shard,
+                      modules in old shard);
+  IF old shard valid
+  THEN kopf;
+       putline ("Wählen Sie jetzt, welche der Module vollautomatisch wie im");
+       putline ("Vorlage-SHard konfiguriert werden sollen (Reihenfolge egal)");
+       automatic mode modules := certain (modules / modules in old shard,
+                                          modules in old shard)
+  ELSE automatic mode modules := empty thesaurus  FI.
+
+configurate modules and build shard :
+  FOR i FROM 1 UPTO highest entry (modules) REP
+    page; cout (i); collect heap garbage;
+    t := name (modules, i);
+    configurate module (new shard, old shard,
+                        modules in old shard CONTAINS t,
+                        automatic mode modules CONTAINS t, t)
+  PER;
+  IF highest entry (automatic mode modules) < highest entry (modules)
+  THEN perhaps keep copy of partly build shard  FI;
+  collect heap garbage.
+
+perhaps keep copy of partly build shard :
+  kopf;
+  storage info;
+  out (""10"Möchten Sie eine zusätzliche Kopie des SHard in dieser Version"13""10"");
+  IF yes ("aufheben", FALSE)
+  THEN TEXT CONST start :: subtext (hauptmodul namentyp, 1,
+                                    LENGTH hauptmodul namentyp - 1);
+       t := date;
+       put ("Gewünschter Name :"); out (start); editget (t); out (""13""10"");
+       t := start + t;
+       IF NOT exists (t) COR overwrite THEN copy (shard name, t)  FI
+  FI.
+
+add ids :
+  int (new shard, offset id 4 + 2  (* ID5 *), actual installation nr);
+  int (new shard, offset id 4 + 4  (* ID6 *), id (6));
+  int (new shard, offset id 4 + 6  (* ID7 *), id (7)).
+
+overwrite :
+  IF yes ("Existierende Datei """ + t + """ überschreiben", FALSE)
+  THEN forget (t, quiet);
+       TRUE
+  ELSE FALSE  FI.
+END PROC build shard;
+
+(******************** print configuration **********************************)
+
+PROC print configuration (DATASPACE CONST old shard ds, BOOL CONST on screen):
+  (* Ruft für alle Module, die in old shard ds und als Datei vorhanden sind
+     print configuration aus dem Paket modulkonfiguration auf.
+     Macht bei on screen nach jedem Modul eine Pause, andernfalls wird die
+     Ausgabe in einem Rutsch gemacht und mit indirect list auf den Drucker
+     umgeleitet.
+  *)
+  BOUND MODUL VAR old shard :: old shard ds;
+  THESAURUS VAR modules in old shard;
+  BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
+                                  verbal identification ok;
+  enable stop;
+  IF NOT old shard valid
+  THEN errorstop ("Der SHard ist ungültig");
+       LEAVE print configuration
+  FI;
+  write head ("Anzeigen der Konfiguration des SHard");
+  put ("Bitte fassen Sie sich in Geduld");
+  get modules in shard (old shard, modules in old shard);
+  out (""4""13""10"");  (* clear cout, line *)
+  IF on screen
+  THEN putline ("Nach jedem Modul eine Taste drücken.")
+  ELSE putline ("Die Ausgabe geht zum Drucker");
+       indirect list (TRUE);
+       putline ("***** SHardkonfiguration *****"); line;
+  FI;
+  disable stop;
+  do print configuration (old shard, modules in old shard, on screen);
+  IF is error THEN put error; pause; clear error  FI;
+  enable stop;
+  IF NOT on screen THEN indirect list (FALSE)  FI.
+
+verbal identification ok :
+  text (old shard, offset verbal identification, 16) =
+  "SHard Schoenbeck".
+END PROC print configuration;
+
+PROC do print configuration (MODUL CONST old shard,
+                            THESAURUS CONST modules in old shard,
+                            BOOL CONST on screen) :
+  INT  VAR i;
+  TEXT VAR t;
+  enable stop;
+  FOR i FROM 1 UPTO highest entry (modules in old shard) REP
+    t := name (modules in old shard, i);
+    print configuration (old shard, t);
+    collect heap garbage;
+    IF on screen THEN pause  FI
+  PER.
+END PROC do print configuration;
+
+(********************** modules in shard **********************************)
+
+PROC get modules in shard (MODUL CONST old shard,
+                           THESAURUS VAR modules in old shard) :
+  (* Stellt einem THESAURUS zusammen, der aus den Namen aller in old shard
+     enthaltenen Module besteht (ohne Duplikate).
+     Dabei sind diejenigen Modulnamen, deren Treiber in old SHard nicht als
+     eingekettete Treiber vorkommen, im Resultat VOR den eingeketteten
+     (d.h. mit kleineren link-Nummern) zu finden, um die richtige
+     Konfigurationsreihenfolge vorschlagen zu können.
+     Es muß zuvor bereits einmal init modules list aufgerufen worden sein !
+  *)
+  INT  VAR kanal;
+  REAL VAR p dtcb, p ccb;
+  TEXT VAR type, m name;
+  THESAURUS VAR simple :: empty thesaurus, chained :: empty thesaurus;
+  FOR kanal FROM 0 UPTO nr of channels total - 1 REP
+    cout (kanal);
+    p dtcb := sh dtcb offset (old shard, kanal);
+    p ccb  := sh ccb  offset (old shard, kanal);
+    look at this chain
+  PER;
+  invert chained thesaurus;
+  modules in old shard := what comes out when i let nameset do all the hard
+           work for me with a little trick and knowledge of implementation.
+
+look at this chain :
+  (* Das Verfahren ist auf den ersten Blick etwas kompliziert, spart aber
+     einiges an Kodeduplikation
+  *)
+  m name :=  "";
+  WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
+    IF m name <> "" AND NOT (chained CONTAINS m name)
+    THEN insert (chained, m name)  FI;
+    type   := text (old shard, p dtcb, 4);
+    m name := module name (type);
+    p dtcb := unsigned (int (old shard, p ccb + 2.0));  (* verkettet *)
+    p ccb  := unsigned (int (old shard, p ccb + 4.0));
+  PER;
+  IF m name <> "" THEN insert (simple, m name)  FI.
+
+invert chained thesaurus :
+  (* bis jetzt sind bei mehrfachen Verkettungen die zuletzt eingeketteten
+     Treiber als erstes eingetragen, das darf jedoch nicht so bleiben
+  *)
+  INT VAR i;
+  THESAURUS VAR help :: empty thesaurus;
+  FOR i FROM highest entry (chained) DOWNTO 1 REP
+    insert (help, name (chained, i))
+  PER;
+  chained := help.
+
+what comes out when i let nameset do all the hard
+work for me with a little trick and knowledge of implementation :
+  (* Beware of false algebraic identities !   These are neither numbers nor
+     sets but lists (ordered and not duplicate-free)
+  *)
+  empty thesaurus + (simple - chained) + chained.
+END PROC get modules in shard;
+
+(*************** add bad sector table to shard ****************************)
+
+PROC add bad sector table to shard (INT CONST eumel type,
+                                    DATASPACE CONST shard ds,
+                                    BOOL CONST take from partition,
+                                    INT VAR bad sector count) :
+  (* Fügt einem SHard eine bad sector table hinzu oder ändert sie.
+     Ist noch keine vorhanden, so sollte der Zeiger 0 sein.
+  *)
+  ROW bad sector table size REAL VAR bst;
+  BOUND MODUL VAR new shard :: shard ds;
+  REAL VAR new shard length, offset bst;
+  INT  VAR i;
+  enable stop;
+  IF take from partition
+  THEN put ("kopiere Tabelle :");
+       find bst in shard on partition
+  ELSE put ("Spur :");
+       get bad sector table (bst, bad sector count, eumel type);
+  FI;
+  eliminate bad sector table from shard (new shard);
+  new shard length := unsigned (int (new shard, offset shard length));
+  int (new shard, new shard length, bad sector count);
+  int (new shard, offset bad sector table pointer, unsigned (new shard length));
+  new shard length INCR 2.0;
+  IF take from partition
+  THEN copy bst from old to new shard
+  ELSE write bst to new shard  FI;
+  int (new shard, offset shard length, unsigned (new shard length)).
+
+copy bst from old to new shard :
+  copy (old shard, offset bst + 2.0, new shard, new shard length,
+        bad sector count * 4);
+  cout (bad sector count * 4);
+  new shard length INCR real (bad sector count * 4).
+
+write bst to new shard :
+  FOR i FROM 1 UPTO bad sector count REP
+    cout (i);
+    enter bad sector low word
+  PER;
+  FOR i FROM 1 UPTO bad sector count REP
+    cout (i);
+    enter bad sector high word;
+  PER.
+
+find bst in shard on partition :
+  cout (0);
+  read file (ds, start of partition (eumel type) + 1.0, max sh length,
+             setup channel);
+  BOUND MODUL CONST old shard :: ds;
+  IF int (old shard, offset id 4) <> id (4)
+  THEN errorstop ("SHard auf Partition unbrauchbar")  FI;
+  offset bst := unsigned (int (old shard, offset bad sector table pointer));
+  bad sector count := int (old shard, unsigned (offset bst)).
+
+enter bad sector low word :
+  int (new shard, new shard length, low word (bst [i]));
+  new shard length INCR 2.0.
+
+enter bad sector high word :
+  int (new shard, new shard length, high word (bst [i]));
+  new shard length INCR 2.0.
+END PROC add bad sector table to shard;
+
+(************ eliminate bad sector table from shard ****************)
+
+PROC eliminate bad sector table from shard (MODUL VAR shard) :
+  (* Entfernt die bad sector table (bst) aus dem shard falls sie sich am Ende
+     desselben befindet. Trägt korrekte neue Werte für den bst pointer und
+     shard laenge ein.
+  *)
+  REAL VAR shard length :: unsigned (int (shard, offset shard length)),
+           bst offset   :: unsigned (int (shard, offset bad sector table pointer));
+  LET bst entry length  =  4.0;  (* bst entries sind Wort-Paare *)
+  IF bst offset = 0.0
+  THEN (* ist gar keine bst vorhanden, also schon prima eliminiert *)
+  ELIF bst ist am ende
+  THEN bst entfernen  FI;
+  bst austragen.
+
+bst ist am ende :
+  bst offset + bst entry length * nr of bst entries + 2.0 =
+  shard length.
+
+nr of bst entries :
+  unsigned (int (shard, bst offset)).
+
+bst entfernen :
+  int (shard, offset shard length, unsigned (bst offset)).
+
+bst austragen :
+  int (shard, offset bad sector table pointer, 0).
+END PROC eliminate bad sector table from shard;
+
+(******************* installation nr *************************************)
+
+INT PROC installation nr :
+  actual installation nr
+END PROC installation nr;
+
+PROC installation nr (INT CONST new) :
+  actual installation nr := new
+END PROC installation nr;
+
+(*********************** Hilfsprozeduren **********************************)
+
+PROC kopf :
+  write head ("M o d u l - S H a r d     Zusammenbau eines SHard").
+END PROC kopf;
+
+END PACKET setup eumel shardmontage;
+
diff --git a/system/setup/3.1/src/setup eumel 7: setupeumel b/system/setup/3.1/src/setup eumel 7: setupeumel
new file mode 100644
index 0000000..0504e97
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 7: setupeumel
@@ -0,0 +1,1238 @@
+(*************************************************************************)
+(*** Hauptprogramm des setup-Eumel:Einstellen der EUMEL - Partitionen  ***)
+(*** und SHard-Installation auf einer Festplatte.                      ***)
+(***                                                                   ***)
+(*** Autor : W. Sauerwein                          Stand   : 07.04.89  ***)
+(***         I. Ley                                Version : 2.3       ***)
+(*** Anpassung an Modul-SHard : Lutz Prechelt, Karlsruhe               ***)
+(***           -"-            : Werner Metterhausen                    ***)
+(***           -"-            : Martin Schönbeck                       ***)
+(*************************************************************************)
+(*** V 3.1   14.04.89  shard wird immer mit 'max sh size' geschriegen  ***)
+(***                   da mit 'ds pages' ggf teile fehlten, wenn innen ***)
+(***                   unbenutzte pages (buffer) waren                 ***)
+(*** V 3.0   10.04.89  support fuer mehrere Laufwerke eingebaut        ***)
+(***                   ausgabe der module vor loeschen etc. entfernt   ***)
+
+PACKET setup eumel DEFINES setup eumel, setup eumel endlos, version,
+show partition table:
+
+LET setup version = "Version 3.1";
+
+TEXT VAR stand :: "Stand : 18.04.89    (mit Modul-SHard Version 4.9)";
+
+PROC version (TEXT CONST vers): stand := vers END PROC version;
+
+PROC version: editget (stand) END PROC version;
+
+LET    max partitions           =   4,
+       max sh size              =  128, (* Anzahl Bloecke *)
+       return                   = ""13"",
+       escape                   = ""27"";
+
+LET hauptmodul namentyp    = "SHard *", 
+    modul namentyp         = "SHardmodul *",
+    sh name                = "SHARD",
+    sh backup              = "SHARD Sicherungskopie";
+
+ROW max partitions INT  VAR   part list;
+ROW max partitions INT  VAR   part type, part active,
+                              part first track, part last track;
+ROW max partitions REAL VAR   part start,
+                              part size;
+
+ INT  VAR   zylinder,
+            startzeile tabelle      ::   1,
+            startzeile menu         ::  12,
+            active partition,
+            partitions,
+            partition, i, j, cx, cy, help;
+ TEXT VAR   retchar,
+            meldung := "";
+ BOOL VAR   testausgabe,
+            mit schreibzugriff := TRUE,
+            meldung eingetroffen := FALSE,
+            endlos :: FALSE,
+            at version;
+THESAURUS VAR minimum modulkollektion := empty thesaurus;
+DATASPACE VAR ds := nilspace;
+
+(************************* setup eumel endlos *****************************)
+                                 
+PROC setup eumel endlos (BOOL CONST b) :
+  endlos := b;
+  IF endlos
+  THEN line;
+       putline ("Bitte geben Sie nun alle die Dateien an, die der Benutzer auf");
+       putline ("keinen Fall löschen darf.  (Taste drücken)");
+       minimum modulkollektion := certain (all, emptythesaurus);
+       line (3);
+       putline ("Der setup eumel kann nun nach dem nächsten Aufruf nicht mehr ");
+       putline ("verlassen werden. ")
+  FI.
+END PROC setup eumel endlos;
+
+(******************** get/put actual partition data ************************)
+
+PROC get actual partition data :
+   get boot block;
+   zylinder := tracks;
+   FOR i FROM 1 UPTO max partitions REP
+      part type        (i) := partition type (i);
+      part first track (i) := first track (i);
+      part last track  (i) := last track (i);
+      part start       (i) := partition start (i);
+      part size        (i) := partition size (i);
+      part active      (i) := partition word 0 (i);
+      IF partition active (i) THEN active partition := i FI
+   PER;
+   get number of installed partitions;
+   generate part list.
+
+get number of installed partitions :
+   partitions := 0;
+   FOR i FROM 1 UPTO max partitions REP
+     IF part type (i) <> 0 THEN partitions INCR 1 FI
+   PER.
+
+generate part list :
+   FOR i FROM 1 UPTO max partitions REP
+      IF part type (i) <> 0 THEN part list (i) := i
+                            ELSE part list (i) := 0
+      FI;
+   PER;
+   schiebe nullen nach hinten;
+   sort part list.
+
+schiebe nullen nach hinten :
+   i := 1; INT VAR k := 0;
+   REP k INCR 1;
+       IF part list (i) = 0 THEN circle
+                            ELSE i INCR 1
+       FI
+   UNTIL k = max partitions - 1 PER.
+
+circle :
+   FOR j FROM i UPTO max partitions - 1 REP
+      part list (j) := part list (j + 1)
+   PER;
+   part list (max partitions) := 0.
+
+sort part list :
+   FOR i FROM 2 UPTO partitions REP
+      FOR j FROM 1 UPTO i - 1 REP
+          IF part first track (part list (i)) < part first track (part list (j))
+             THEN tausche FI
+      PER
+   PER.
+
+tausche :
+   help := part list (i);
+   part list (i) := part list (j);
+   part list (j) := help.
+
+END PROC get actual partition data;
+
+PROC put actual partition data :
+   FOR i FROM 1 UPTO max partitions REP
+      IF partition exists (i) THEN put partition
+                              ELSE clear partition (i)
+      FI;
+   PER;
+   IF mit schreibzugriff THEN put boot block FI.
+  
+put partition :
+   IF is eumel (i) THEN partition type   (i, part type        (i));
+                        first track      (i, part first track (i));
+                        last track       (i, part last track  (i));
+                        partition start  (i, part start       (i));
+                        partition size   (i, part size        (i))
+   FI;
+   partition word 0    (i, part active      (i));
+   IF active partition = i
+      THEN partition active (i, TRUE)
+      ELSE partition active (i, FALSE)
+   FI.
+
+END PROC put actual partition data;
+
+(*************************** setup eumel ********************************)
+
+PROC setup eumel :
+   line; command dialogue (TRUE);
+   at version := yes ("System für AT", TRUE);
+   testausgabe := FALSE; (*yes ("Testversion", FALSE); *)
+   pruefe ob notwendige dateien vorhanden;
+   init modules list;
+   IF  yes ("Leere Floppy für Systemsicherung eingelegt", FALSE)
+   THEN command dialogue (FALSE); save system; command dialogue (TRUE)  FI;
+   IF NOT endlos THEN putline ("Verlassen mit ESC."); pause (40)  FI;
+   terminal setup;
+   logo;
+   generate eumel.
+
+pruefe ob notwendige dateien vorhanden:
+   BOUND INT VAR y;
+   IF mit schreibzugriff THEN y := old (sh name);
+                              y := old ("shget.exe");
+                              y := old ("bootblock");
+                              y := old ("configuration");
+                              y := old ("AT-4.x")
+   FI.
+
+END PROC setup eumel;
+
+PROC generate eumel :
+   disable stop;
+   show partition table;
+   REP update table;
+       main menu;
+       action;
+       IF is error THEN fehler;
+                        put line (error message);
+                        put line ("Bitte betätigen Sie eine Taste !");
+                        clear error;
+                        pause;
+                        IF mit schreibzugriff THEN terminal setup FI
+       FI
+   PER.
+
+action :
+   INT VAR choice;
+   clear error;
+   REP
+      cursor (cx, cy);
+      IF partitions < max partitions
+      THEN choice := get choice (0, max, retchar)
+      ELSE choice := get choice (2, max, 0, retchar)
+      FI;
+      IF escaped CAND NOT endlos THEN LEAVE generate eumel FI;
+   UNTIL retchar = return PER;
+   cl eop (1, startzeile menu - 1);
+   INT VAR unser kanal := channel;
+   SELECT choice OF
+      CASE 0 : programm ende
+      CASE 1 : create partition (TRUE)
+      CASE 2 : create partition (FALSE)
+      CASE 3 : activate partition
+      CASE 4 : delete partition
+      CASE 5 : delete partition table
+      CASE 6 : konfiguration anzeigen
+      CASE 7 : shard zusammenbauen
+      CASE 8 : modulkollektion aendern
+      CASE 9 : change drive
+
+  END SELECT;
+  continue (unser kanal).
+
+max :
+  9.
+
+change drive:
+   cursor (1, startzeile menu);
+   put ("Bitte Laufwerksnummer angeben:");
+   get cursor (cx, cy);
+   put ("   0 - 3");
+   REP cursor (cx, cy);
+     INT VAR drive := get choice (0, 3, retchar);
+     IF sure escaped THEN LEAVE change drive FI;
+   UNTIL NOT escaped PER;
+   setup channel (28-drive);
+   show partition table.
+
+
+programm ende :
+   cursor (1, startzeile menu);
+   IF keine partition aktiv
+      THEN IF trotz warnung beenden THEN eumel beenden FI
+      ELSE IF yes ("Wollen Sie die Partitionierung Ihrer Festplatte beenden", FALSE)
+              THEN eumel beenden
+   FI FI.
+
+keine partition aktiv : active partition = 0.
+
+trotz warnung beenden :
+   put line ("ACHTUNG : Es ist keine Partition aktiv gesetzt !");
+   put line ("          Sie können daher nicht von der Festplatte booten !");
+   line;
+   yes ("Wollen Sie trotzdem die Partitionierung der Festplatte beenden", FALSE).
+
+eumel beenden :
+   cl eop (1, startzeile menu - 1);
+   cursor (1, startzeile menu + 3);
+   shutup; terminal setup;
+   logo;
+   show partition table.
+   
+shard zusammenbauen :
+  cl eop (1, startzeile menu);
+  IF yes ("Wollen Sie Ihren SHard neu konfigurieren", FALSE)
+    THEN shard sichern und vorlage beschaffen;
+
+       IF NOT is error THEN build shard (ds)  FI;
+       IF is error OR NOT exists (sh name)
+
+       THEN forget (sh name, quiet); rename (sh backup, sh name);
+            putline ("Zusammenbau fehlgeschlagen. Alter SHard erhalten.");
+            pause (300);
+       FI;
+       forget (sh backup, quiet); forget (ds);
+       show partition table
+  FI.
+
+shard sichern und vorlage beschaffen :
+  forget (sh backup, quiet);
+  IF exists (shname)
+     THEN copy (sh name, sh backup);
+  FI;
+  forget (ds);
+  line;
+  IF yes (""3"Ist in einer existierenden Eumel-Partition ein SHard installiert,
+"13""10"der als Vorlage dienen soll", FALSE)
+  THEN INT VAR vorlage :: 69;
+       editget (1, startzeile menu + 4, "Partitiontyp: ", vorlage);
+       (* Das sollte man mal noch schöner machen !!! *)
+       read file (ds, start of partition (vorlage) + 1.0, max sh size,
+                  setup channel)
+  ELSE ds := old (sh name)  FI.
+
+
+konfiguration anzeigen :
+  hole anzuzeigenden ds;
+  line;
+  print configuration (ds, NOT yes ("Auf dem Drucker ausgeben", FALSE));
+  show partition table.
+
+hole anzuzeigenden ds:
+  forget (ds);
+  line;
+  IF yes ("Soll ein SHard aus einer Partition angezeigt werden", TRUE)
+  THEN INT VAR anzeige :: 69;
+       editget (1, startzeile menu + 4, "Partitiontyp: ", anzeige);
+       (* Das sollte man mal noch schöner machen !!! *)
+       read file (ds, start of partition (anzeige) + 1.0, max sh size,
+                  setup channel)
+  ELSE ds := old (ONE ((all LIKE hauptmodul namentyp) + "SHARD")) FI.
+
+
+modulkollektion aendern :
+  THESAURUS VAR th;
+  TEXT VAR x :: "SHard";
+  INT VAR i ;
+  page;
+  th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) +
+             (all LIKE sh name) ;
+  (* Diese Ausgabe macht leider den Bildschirmaufbau kaputt *)
+  (* mit dem Erfolg, daß man dann nicht mehr sieht, was man *)
+  (* ankreuzt, deshalb auskommentiert *)
+  (*******
+  putline(" Alle SHards :");
+  line;
+  FOR i FROM 1 UPTO highest entry(th)
+  REP
+     putline(name(th,i))
+  PER;
+  *******)
+  putline("      Modulkollektion ändern");
+  line;
+  IF yes ("Wollen Sie irgendwelche Module löschen", FALSE)
+  THEN th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) +
+             (all LIKE sh name) - minimum modulkollektion;
+       forget (certain (th, emptythesaurus));
+  ELIF yes ("Wollen Sie Module vom Archiv holen", FALSE)
+  THEN put ("Archivname:"); editget (x); line;
+       archive (x);
+       th := ALL archive LIKE modul namentyp;
+       fetch (certain (th, emptythesaurus), archive);
+       release (archive)
+  FI;
+  init modules list;
+  show partition table.
+
+
+END PROC generate eumel;
+
+
+PROC show partition table :
+   IF NOT mit schreibzugriff THEN get actual partition data FI;
+   headline;
+   devide table;
+   columns;
+   underlines;
+   rows;
+   downline.
+
+head line :
+   cl eop (1, startzeile tabelle);
+   put center (startzeile tabelle, "Aktuelle Partitions - Tabelle", TRUE).
+
+devide table :
+   FOR i FROM 1 UPTO 8
+   REP
+      cursor (45, startzeile tabelle + i); out (inverse (""))
+   PER.
+
+columns :
+   cursor ( 1, startzeile tabelle + 2);
+   out ("Nr. System   Typ Zustand Grösse Anfang Ende");
+   cursor (48, startzeile tabelle + 2);
+   out ("Platte    :   Zyl. / KB").
+
+underlines :
+   cursor ( 1, startzeile tabelle + 3);
+   out ("--------------------------------------------");
+   cursor (47, startzeile tabelle + 3);
+   out ("------------------------------").
+
+rows :
+   FOR i FROM 1 UPTO max partitions
+   REP cursor (2, startzeile tabelle + 3 + i);
+       put (text (i) + " :")
+   PER.
+
+downline :
+   put center (startzeile menu - 3, " EUMEL Installationssystem " + setup version
+                     + " (IBM PC/" + rechner typ
+                     + " und kompatible Rechner) ", TRUE);
+   put center (startzeile menu - 2, stand, TRUE).
+
+rechner typ :
+   IF at version THEN "AT"
+                 ELSE "XT"
+   FI.
+
+END PROC show partition table;
+
+PROC main menu :
+   biete auswahl an;
+   IF meldung eingetroffen THEN melde FI;
+   IF testausgabe THEN ausgabe fuer test FI.
+
+ausgabe fuer test :
+   testrahmen;
+   test out.
+
+testrahmen :
+   FOR i FROM startzeile menu - 1 UPTO startzeile menu + 9
+   REP
+      cl eol (45, i);
+      put (inverse (""))
+   PER;
+   cursor (52, startzeile menu);
+   put ("Ecke für Test-Output");
+   cursor (52, startzeile menu).
+
+test out :
+   FOR i FROM 1 UPTO max partitions
+   REP
+      cursor (52, startzeile menu + 1 + i);
+      put (text (i) + ":");
+      put (part type (i)); 
+      put (part first track (i));
+      put (part last track (i));
+      IF active partition = i THEN put ("aktiv")
+                             ELSE put ("inaktiv")
+      FI;
+   PER.
+
+melde :
+   cursor (1, 24);
+   put (inverse ("Meldung :"));
+   put (meldung);
+   meldung eingetroffen := FALSE.
+
+biete auswahl an :
+    cl eop (1, startzeile menu - 1); line;
+    IF partitions < max partitions
+    THEN putline (" EUMEL - Partition einrichten .............. 1")
+    ELSE line;
+         putline (" EUMEL - Partition")
+    FI;
+    cursor (20, startzeile menu + 1);
+    putline                    ("erneuern (Neuer SHard) .. 2");
+    putline ("                   aktivieren .............. 3");
+    putline ("                   löschen ................. 4");
+    putline (" Partitionstabelle löschen ................. 5");
+    putline (" SHard-Konfiguration anzeigen .............. 6");
+    putline (" SHard konfigurieren ....................... 7");
+    putline (" SHardmodule laden oder löschen ............ 8");
+    putline (" Bearbeitetes Laufwerk wechseln ............ 9");
+    putline (" SETUP-EUMEL beenden ....................... 0");
+    putline ("-----------------------------------------------");
+    put     (" Ihre Wahl                                >>");
+    get cursor (cx, cy).
+
+END PROC main menu;
+
+PROC update table :
+   IF mit schreibzugriff THEN get actual partition data FI;
+   FOR i FROM 1 UPTO partitions REP update partition PER;
+   FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER;
+   zeige plattengroesse;
+   IF active partition = 0 THEN meldung := "ACHTUNG : Es ist keine Partition aktiv gesetzt !";
+                                meldung eingetroffen := TRUE
+   FI.
+
+update partition :
+   partition := part list (i);
+   show partition.
+
+rubout partition :
+   cursor (5, startzeile tabelle + 3 + i);
+   out ("                                       ").
+
+show partition :
+   cursor (5, startzeile tabelle + 3 + i);
+   put (name + type + zustand  + groesse + startspur + endspur).
+
+name : subtext (subtext (part name, 1, 7)
+              + "     ", 1, 8).
+
+type : text (part type (partition), 5) + "  ".
+
+zustand   : IF active partition = partition THEN (" aktiv ")
+                                            ELSE ("       ")
+            FI.
+
+startspur : " " + text (part first track (partition), 5).
+endspur   :       text (part last track   (partition), 6).
+groesse   :       text (part groesse, 5).
+
+zeige plattengroesse :
+   put gesamt;
+   put noch freie;
+   put maximaler zwischenraum.
+
+put maximaler zwischenraum :
+   cursor (48, startzeile tabelle + 6);
+   put ("gr. Lücke : " + text (maximaler zwischenraum, 5) + "  / "
+   + kilobyte(maximaler zwischenraum)).
+
+put gesamt :
+   cursor (48, startzeile tabelle + 4);
+   put ("Gesamt    : " + text (zylinder, 5) + "  / "
+   + kilobyte(zylinder)).
+
+put noch freie :
+   cursor (48, startzeile tabelle + 5);
+   put ("Frei      : " + text (freie zylinder, 5) + "  / "
+   + kilobyte( freie zylinder)).
+
+END PROC update table;
+
+
+TEXT PROC kilobyte (INT CONST zylinderzahl):
+     TEXT VAR kb;
+     kb := text(round(real(zylinderzahl) * real(heads) * real(sectors) * 0.512,0));
+     subtext(kb,1,length(kb)-2)
+
+END PROC kilobyte;
+
+
+PROC create partition (BOOL CONST partition is new) :
+   IF NOT partition is new
+   THEN renew partition
+   ELIF freie part number gefunden CAND noch platz uebrig
+   THEN new partition
+   ELSE kein platz mehr  FI.
+
+kein platz mehr :
+   fehler;
+   put ("Es kann keine neue Partition mehr eingerichtet werden.");
+   pause (300).
+
+noch platz uebrig : freie zylinder > 0.
+
+freie part number gefunden :
+   IF partitions < max partitions THEN suche nummer;
+                                       TRUE
+                                  ELSE FALSE
+   FI.
+
+suche nummer :
+   partition := 0;
+   REP partition INCR 1 UNTIL part type (partition) = 0 PER.
+
+new partition :
+   cl eop (1, startzeile menu);
+   IF yes ("Neue EUMEL - Partition einrichten", FALSE)
+      THEN INT VAR alte aktive partition := active partition;
+           IF NOT partition exists (partition)
+              THEN IF enter partition spezifikations
+                      THEN IF mit schreibzugriff THEN check part and install FI
+                   FI;
+              ELSE keine freie partition
+   FI FI.
+
+renew partition :
+   cl eop (1, startzeile menu);
+   IF yes ("Neuen SHard auf bestehende EUMEL - Partition schreiben", FALSE)
+      THEN enter part number;
+           IF mit schreibzugriff THEN check part and install FI
+   FI.
+
+enter part number :
+   put ("Welche Partition wollen Sie erneuern :");
+   get cursor (cx, cy);
+   put ("   Abbruch mit <ESC>");
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE create partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+      IF NOT (partition exists (partition) AND is eumel (partition))
+      THEN fehler; put ("Keine EUMEL - Partition");
+           pause (300); cl eop (1, 20);
+      FI
+   UNTIL partition exists (partition) AND is eumel (partition) PER.
+
+check part and install:
+   IF partition is new THEN put actual partition data  FI;
+   IF testausgabe THEN put ("Keine Überprüfung schlechter Sektoren, da Testversion !")
+                  ELSE trage schlechte sektoren ein;
+   FI;
+   IF is error AND partition is new
+               THEN active partition := alte aktive partition;
+                    rubout partition;
+                    LEAVE check part and install
+               ELIF NOT is error
+               THEN line;
+                    put ("Shard wird auf die Partition geschrieben..."); line (2);
+                    bringe shard auf platte (part type (partition));
+               ELSE line;
+                    putline ("Fehler aufgetreten. Partition unverändert")
+               FI;
+   put ("Bitte betätigen Sie eine Taste !");
+   loesche eingabepuffer;
+   pause.
+
+trage schlechte sektoren ein:
+   INT VAR anzahl schlechter sektoren;
+   line (2);
+   putline ("Überprüfen der Partition nach schlechten Sektoren.");
+   add bad sector table to shard (part type (partition), old (sh name),
+             NOT partition is new, anzahl schlechter sektoren);
+   line;
+   IF NOT is error THEN put ("Ich habe " + bs zahl + " gefunden.") FI.
+
+bs zahl:
+   IF anzahl schlechter sektoren = 0 
+      THEN "keine schlechten Sektoren"
+   ELIF anzahl schlechter sektoren > 1
+      THEN text (anzahl schlechter sektoren) + " schlechte Sektoren" 
+      ELSE "einen schlechten Sektor"
+   FI.
+
+keine freie partition :
+   fehler;
+   put line ("Sie können nur auf freien Partitionen 'EUMEL' einrichten.");
+   put      ("Die Partition " + text (partition) + " ist bereits mit einem System belegt !");
+   pause (300).
+
+END PROC create partition;
+
+BOOL PROC enter partition spezifikations :
+   cl eol (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cl eol (1, startzeile menu + 2);
+   put ("Typ : EUMEL,");
+   INT VAR old end             := part last track (partition);
+   enter part size;
+   enter part first track;
+   put end track;
+   cl eol (60, startzeile menu);
+   IF NOT eingaben ok THEN LEAVE enter partition spezifikations WITH FALSE FI;
+   cl eol (1, startzeile menu + 4);
+   part first track (partition) := int (start);
+   part last track  (partition) := int (start) + int (size) - 1;
+   part start       (partition) := first usable sector;
+   part size        (partition) := first sector behind partition -
+                                               part start (partition);
+   active partition             := partition;
+   part type        (partition) := kleinste freie eumel nummer;
+   add to part list;
+   TRUE.
+
+eingaben ok :
+   cl eop (1, startzeile menu + 4);
+   yes ("Sind die Partitionsangaben korrekt", FALSE).
+
+enter part size :
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          put ("Welche Grösse :");
+          TEXT VAR size := groessenvorschlag;
+          loesche eingabepuffer;
+          editget (size, escape, "", retchar);
+          IF sure escaped
+             THEN LEAVE enter partition spezifikations WITH FALSE
+          FI
+      UNTIL NOT escaped PER;
+      IF NOT size ok THEN falsche groesse FI
+   UNTIL size ok  AND not too big PER;
+   cl eol (1, y + 1);
+   cl eol (1, y + 2);
+   cl eol (cx, cy);
+   put ("Grösse : " + size + ";").
+
+size ok :
+        NOT size greater maxint
+   CAND size positiv
+    AND desired size <= maximaler zwischenraum.
+
+not too big:
+  INT VAR x,y;
+  get cursor(x,y);
+  IF real(kilobyte(int(size))) >= 16196.0
+   THEN line;
+        putline("Eine Partition grösser 16 MB ist nur bei einer + Version sinnvoll !");
+        yes("Eingabe korrekt",FALSE)
+   ELSE TRUE
+  FI.
+
+size greater maxint :
+   length (size) >= 5.
+
+size positiv :
+   desired size > 0.
+   
+falsche groesse :
+   fehler;
+   put line ("Es kann keine Partition mit " + size + " Zylindern eingerichtet werden !");
+   IF NOT size greater maxint CAND size positiv
+      THEN put ("Die grösste zusammenhängende Anzahl Zylinder ist "
+              + text (maximaler zwischenraum) + ".")
+      ELSE put ("Bitte eine positive Grösse angeben !")
+   FI.
+
+groessenvorschlag :
+   text (maximaler zwischenraum).
+
+enter part first track :
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          put ("Start - Zylinder der Partition :");
+          TEXT VAR start := startvorschlag;
+          loesche eingabepuffer;
+          editget (start, escape, "", retchar);
+          IF sure escaped THEN part last track (partition) := old end;
+                               LEAVE enter partition spezifikations WITH FALSE
+          FI
+      UNTIL NOT escaped PER;
+      IF NOT start ok THEN falscher start FI
+   UNTIL start ok PER;
+   cl eol (cx, cy);
+   put ("Start : " + start + ";").
+
+put end track :
+   put ("Ende : " + text (int (start) + int (size) - 1)).
+
+start ok :
+        length (start) < 5
+   CAND enough room
+    AND NOT in existing partition
+    AND NOT out of volume.
+
+out of volume : desired start > zylinder OR desired start < 0.
+
+in existing partition :
+   IF partitions = 0 THEN FALSE
+                     ELSE i := 0;
+                          REP
+                             i INCR 1
+                          UNTIL start of part i > desired start
+                             OR last partition
+                             OR error found PER;
+                          IF error found THEN TRUE ELSE FALSE FI
+   FI.
+
+error found :
+   part index <> i AND
+   (start of part i <= desired start AND end spur i >= desired start).
+
+part index :
+   0.
+
+desired start : int (start).
+
+start of part i : part first track (part list (i)).
+
+last partition : i = partitions.
+
+enough room :
+   desired start + desired size <= begin of next partition.
+
+desired size : int (size).
+
+begin of next partition :
+   IF partitions = 0 THEN zylinder
+                     ELSE i := 0;
+                          REP
+                             i INCR 1;
+                          UNTIL start of part i > desired start
+                             OR last partition PER;
+                          IF start of part i > desired start THEN start of part i
+                                                             ELSE zylinder
+                          FI
+   FI.
+
+falscher start :
+   fehler;
+   put ("Auf Zylinder " + start);
+   put ("kann keine Partition der Grösse " + size);
+   put ("beginnen !").
+
+startvorschlag :
+   text (best start position).
+
+best start position :
+   IF partitions = 0 THEN 0
+                     ELSE best start spur vor und zwischen den partitionen
+   FI.
+
+best start spur vor und zwischen den partitionen :
+   INT VAR best start := 0, min size := zylinder;
+   FOR i FROM 0 UPTO partitions
+   REP
+      IF platz genug zwischen i und i plus 1 AND kleiner min size
+         THEN min size   := platz zwischen i und i plus 1;
+              best start := start des zwischenraums
+      FI
+   PER;
+   best start.
+
+start des zwischenraums :
+   end spur i + 1.
+
+end spur i :
+   IF i = 0 THEN -1
+            ELSE part last track (part list (i))
+   FI.
+
+platz zwischen i und i plus 1 :
+   part first track i plus 1 - (end spur i + 1).
+
+part first track i plus 1 :
+   IF i = partitions THEN zylinder
+                     ELSE part first track (part list (i + 1))
+   FI.
+
+platz genug zwischen i und i plus 1 :
+   platz zwischen i und i plus 1 >= int (size).
+
+kleiner min size : platz zwischen  i und i plus 1 < min size.
+
+first usable sector:
+   IF int (start) = 0
+      THEN 1.0
+      ELSE real (heads * sectors) * real (start)
+   FI.
+
+first sector behind partition:
+   real (heads * sectors) * (real(start) + real (size)).
+
+kleinste freie eumel nummer :
+   IF partitions = 0 THEN 69
+                     ELSE search for part type (69)
+   FI.
+   
+END PROC enter partition spezifikations;
+
+INT PROC search for part type (INT CONST minimum) :
+   IF minimum exists THEN search for part type (minimum + 1)
+                     ELSE minimum
+   FI.
+
+minimum exists :
+   BOOL VAR exists := FALSE;
+   INT VAR i;
+   FOR i FROM 1 UPTO partitions REP
+      IF part type (part list (i)) = minimum THEN exists := TRUE FI
+   PER;
+   exists.
+
+END PROC search for part type;
+
+PROC bringe shard auf platte (INT CONST eumel type):
+   IF mit schreibzugriff THEN
+      enable stop;
+      INT CONST old session :: session;
+      fixpoint;
+      IF session <> old session
+      THEN errorstop ("SHard auf Platte schreiben im RERUN !")  FI;
+      write file ("shget.exe", start der eumel partition, 1, setup channel);
+      write file (sh name, start der eumel partition + 1.0,
+                  max sh size, setup channel)
+   FI.
+
+start der eumel partition:
+   start of partition (eumel type).
+END PROC bringe shard auf platte;
+
+
+PROC add to part list :
+   IF part list leer THEN part list (1) := partition
+   ELIF neuer start vor letzter partition THEN fuege ein
+                                          ELSE haenge an
+   FI;
+   partitions INCR 1.
+
+part list leer : partitions = 0.
+
+neuer start vor letzter partition :
+   part first track (partition) < part first track (part list (partitions)).
+
+haenge an : part list (partitions + 1) := partition.
+
+fuege ein :
+   suche erste partition die spaeter startet;
+   schiebe restliste auf;
+   setze partition ein.
+
+suche erste partition die spaeter startet :
+   i := 0;
+   REP i INCR 1
+   UNTIL part first track (part list (i)) > part first track (partition) PER.
+
+schiebe restliste auf :
+   FOR j FROM partitions DOWNTO i
+   REP
+      part list (j + 1) := part list (j)
+   PER.
+
+setze partition ein :
+   part list (i) := partition.
+
+END PROC add to part list ;
+
+INT PROC maximaler zwischenraum :
+   IF partitions = 0 THEN zylinder
+                     ELSE max (maximaler platz vor und zwischen den partitionen,
+                               platz hinter letzter partition)
+   FI.
+
+maximaler platz vor und zwischen den partitionen :
+   help := platz vor erster partition;
+   FOR i FROM 1 UPTO partitions - 1
+   REP
+      help := max (help, begin of part i plus 1 - end of part i - 1)
+   PER;
+   help.
+
+platz vor erster partition :
+   part first track (part list (1)).
+
+platz hinter letzter partition :
+   zylinder - part last track (part list (partitions)) - 1.
+
+begin of part i plus 1 :
+   part first track (part list (i + 1)).
+
+end of part i :
+   part last track (part list (i)).
+
+END PROC maximaler zwischenraum;
+
+PROC activate partition :
+   enter part number;
+   IF NOT escaped THEN set partition active  FI.
+
+set partition active :
+   IF yes ("Partition mit Typnummer " + text (part type (partition)) + " aktivieren", FALSE)
+   THEN active partition := partition;
+        put actual partition data
+   FI.
+
+enter part number :
+   cursor (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cursor ( 1, startzeile menu);
+   put ("Welche Partition wollen Sie aktivieren :");
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE activate partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+      IF NOT partition exists (partition) THEN fehler melden FI
+   UNTIL partition exists (partition) PER;
+   cl eol (60, startzeile menu);
+   cl eop (1, cy + 2).
+
+fehler melden :
+   partition gibt es nicht.
+
+partition gibt es nicht :
+   fehler;
+   put ("Diese Partition gibt es nicht.").
+
+END PROC activate partition;
+
+PROC delete partition :
+   enter part number;
+   IF NOT escaped THEN
+      IF yes ("Partition mit Typnummer " + text (part type (partition)) + " löschen", FALSE)
+      AND ganz sicher
+          THEN rubout partition
+   FI FI.
+
+enter part number :
+   cursor (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cursor ( 1, startzeile menu);
+   put ("Welche Partition wollen Sie löschen :");
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE delete partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+   IF NOT (partition exists (partition) AND is eumel (partition)) THEN fehler melden FI
+   UNTIL partition gueltig AND is eumel (partition) PER;
+   cl eol (60, startzeile menu);
+   cl eop (1, cy + 2).
+   
+fehler melden :
+   IF NOT partition exists (partition) THEN partition gibt es nicht
+                                       ELSE keine eumel partition
+   FI.
+
+partition gibt es nicht :
+   fehler;
+   put ("Diese Partition gibt es nicht.").
+
+ganz sicher :
+   line;
+   yes ("Sind Sie sich ganz sicher", FALSE).
+   
+END PROC delete partition;
+
+PROC delete partition table :
+   cursor ( 1, startzeile menu + 1);
+   put ("Es gehen ALLE Daten verloren, die sich auf Ihrer Platte befinden !");
+   line (2);
+   IF yes ("Wollen Sie wirklich die ganze Partitionstabelle löschen", FALSE)
+      THEN line;
+           IF yes ("Sind Sie sich ganz sicher", FALSE)
+              THEN loesche ganze tabelle
+   FI FI.
+
+loesche ganze tabelle :
+   FOR i FROM 1 UPTO max partitions
+   REP part type  (i) := 0;
+       part first track (i) := 0;
+       part last track   (i) := 0;
+       part start (i) := 0.0;
+       part size (i) := 0.0;
+       part list  (i) := 0
+   PER;
+   partitions := 0;
+   active partition := 0;
+   IF mit schreibzugriff THEN clear partition table (-3475) FI.
+
+END PROC delete partition table;
+
+PROC rubout partition :
+   part type  (partition) := 0;
+   part first track (partition) := 0;
+   part last track   (partition) := 0;
+   IF active partition = partition THEN active partition := 0 FI;
+   del from part list;
+   put actual partition data.
+
+del from part list :
+   search for partition in part list;
+   delete it and set highest to 0;
+   partitions DECR 1.
+
+search for partition in part list :
+   i := 0;
+   REP i INCR 1 UNTIL part list (i) = partition PER.
+
+delete it and set highest to 0 :
+   FOR j FROM i UPTO partitions - 1
+   REP
+      part list (j) := part list (j + 1)
+   PER;
+   part list (partitions) := 0.
+
+END PROC rubout partition;
+
+INT PROC get choice (INT CONST von, bis, TEXT VAR retchar):
+  get choice (von, bis, von, retchar)
+END PROC get choice;
+
+INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar):
+   LET return  = ""13"",
+       escape  = ""27"",
+       left    = ""8"";
+   TEXT VAR buffer; 
+   INT VAR cx, cy;
+   get cursor (cx, cy); out (" " + left);
+   REP
+      REP 
+         cursor (cx, cy); buffer := incharety;
+      UNTIL input ok OR buffer = escape PER; 
+      IF buffer = escape THEN retchar := escape;
+                              LEAVE get choice WITH 0
+      FI;
+      out (buffer); 
+      leseschleife bis left or ret;
+      IF retchar = left   THEN out (left + " ") FI;
+      IF retchar = escape THEN LEAVE get choice WITH 0 FI
+   UNTIL retchar = return OR retchar = escape PER;
+   int (buffer). 
+ 
+input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz).
+
+leseschleife bis left or ret:
+   REP 
+     inchar (retchar) 
+   UNTIL retchar = return OR retchar = left OR retchar = escape PER.
+
+END PROC get choice;
+
+TEXT PROC inverse (TEXT CONST t):
+  ""15"" + t + " " + ""14""
+END PROC inverse;
+
+PROC put center (TEXT CONST t):
+   put center (t, 80)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, BOOL CONST inverse):
+   put center (zeile, t, 80, inverse);
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, 80)
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   put center (zeile, t, gesamtbreite, FALSE);
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite,
+                   BOOL CONST inverse):
+   IF inverse
+     THEN cursor (1, zeile);
+          out (""15"");
+          gesamtbreite - 2 TIMESOUT " ";
+   FI;
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t);
+   IF inverse
+     THEN cursor (gesamtbreite - 1, zeile);
+          out (""14"");
+   FI
+END PROC put center;
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+ 
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
+INT PROC partition groesse (INT CONST part) :
+   part last track (part) - part first track (part) + 1
+END PROC partition groesse;
+
+BOOL PROC is eumel (INT CONST partition) :
+   part type (partition) >= 69 AND part type (partition) <= 72
+END PROC is eumel;
+
+BOOL PROC partition exists (INT CONST partition) :
+   IF partition > 0 AND partition <= max partitions
+      THEN part type (partition) <> 0
+      ELSE FALSE
+   FI
+END PROC partition exists;.
+
+part groesse : partition groesse (partition).
+
+part name :
+   SELECT part type (partition) OF
+     CASE 1, 4           : "DOS"
+     CASE 69, 70, 71, 72 : "EUMEL"
+     OTHERWISE text (part type (partition))
+   END SELECT.
+
+escaped : retchar = escape.
+
+sure escaped :
+   IF escaped THEN cl eop (1, 20); cursor (1, 22);
+                   yes ("Vorgang abbrechen", TRUE)
+              ELSE FALSE
+   FI.
+
+partition gueltig :
+       partition > 0
+   AND partition <= max partitions.
+
+freie zylinder :
+   zylinder - belegte zylinder.
+
+belegte zylinder :
+   help := 0;
+   FOR i FROM 1 UPTO partitions REP
+      help INCR partition groesse (part list (i))
+   PER;
+   help.
+
+keine eumel partition :
+   fehler;
+   put line ("Sie dürfen mit diesem System nur 'EUMEL' - Partitionen manipulieren.");
+   put      ("Die Partition " + text (partition) + " ist nicht vom Typ 'EUMEL' !").
+
+fehler :
+   cl eop (1, 20);
+   put (""7"" + inverse ("FEHLER :")); line (2).
+
+loesche eingabepuffer :
+   REP UNTIL incharety = "" PER. ;
+
+PROC logo :
+  page;
+  put center (3, "S E T U P - E U M E L   "+ setup version);
+  put center (5, "für");
+  put center (7, "M O D U L - S H A R D");
+  put center (13, "======================================================");
+  put center (15, "(für IBM " + typ + " und Kompatible)");
+  put center (20, stand);
+  pause (50);
+  collect heap garbage.
+
+typ :
+  IF at version THEN "AT" ELSE "XT"  FI.
+END PROC logo;
+
+END PACKET setup eumel;
+
+setup eumel
+
+
+
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel erzeugen b/system/setup/3.1/src/setup eumel erzeugen
new file mode 100644
index 0000000..7a50898
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel erzeugen
@@ -0,0 +1,15 @@
+check off;
+insert("setup eumel -1: mini eumel dummies");
+insert("setup eumel 0: /S");
+insert("setup eumel 1: basisoperationen");
+insert("setup eumel 2: modulzugriffe");
+insert("setup eumel 3: modulkonfiguration");
+insert("setup eumel 5: partitionierung");
+insert("setup eumel 6: shardmontage");
+insert("setup eumel 7: setupeumel");
+putline("Jetzt 'setup eumel endlos' nicht vergessen");
+ 
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel erzeugen-M b/system/setup/3.1/src/setup eumel erzeugen-M
new file mode 100644
index 0000000..ad85301
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel erzeugen-M
@@ -0,0 +1,14 @@
+check off;
+insert("setup eumel 0: /M");
+insert("setup eumel 1: basisoperationen");
+insert("setup eumel 2: modulzugriffe");
+insert("setup eumel 3: modulkonfiguration");
+insert("setup eumel 5: partitionierung");
+insert("setup eumel 6: shardmontage");
+insert("setup eumel 7: setupeumel");
+putline("Jetzt 'setup eumel endlos' nicht vergessen");
+ 
+
+
+
+
diff --git a/system/setup/3.1/src/shget.exe b/system/setup/3.1/src/shget.exe
new file mode 100644
index 0000000..902d697
--- /dev/null
+++ b/system/setup/3.1/src/shget.exe
diff --git a/system/shard-x86-at/7/README.rst b/system/shard-x86-at/7/README.rst
new file mode 100644
index 0000000..5d62c2e
--- /dev/null
+++ b/system/shard-x86-at/7/README.rst
@@ -0,0 +1,5 @@
+AT SHard 7
+==========
+
+SHard for PC AT on 8086, version 7 (SHDVER) for Hintergrund 1.7.4.2 (hgver).
+
diff --git a/system/shard-x86-at/7/data/EXEMOD.EXE b/system/shard-x86-at/7/data/EXEMOD.EXE
new file mode 100644
index 0000000..c52538b
--- /dev/null
+++ b/system/shard-x86-at/7/data/EXEMOD.EXE
diff --git a/system/shard-x86-at/7/data/EXEPACK.EXE b/system/shard-x86-at/7/data/EXEPACK.EXE
new file mode 100644
index 0000000..794b562
--- /dev/null
+++ b/system/shard-x86-at/7/data/EXEPACK.EXE
diff --git a/system/shard-x86-at/7/data/FSHARD.EXE b/system/shard-x86-at/7/data/FSHARD.EXE
new file mode 100644
index 0000000..61b0eb6
--- /dev/null
+++ b/system/shard-x86-at/7/data/FSHARD.EXE
diff --git a/system/shard-x86-at/7/data/FSHGET.EXE b/system/shard-x86-at/7/data/FSHGET.EXE
new file mode 100644
index 0000000..1f678ed
--- /dev/null
+++ b/system/shard-x86-at/7/data/FSHGET.EXE
diff --git a/system/shard-x86-at/7/data/GENBOOT.EXE b/system/shard-x86-at/7/data/GENBOOT.EXE
new file mode 100644
index 0000000..077be93
--- /dev/null
+++ b/system/shard-x86-at/7/data/GENBOOT.EXE
diff --git a/system/shard-x86-at/7/doc/8039.PRT b/system/shard-x86-at/7/doc/8039.PRT
new file mode 100644
index 0000000..c7f20e5
--- /dev/null
+++ b/system/shard-x86-at/7/doc/8039.PRT
@@ -0,0 +1,569 @@
+0.ope ("12")##limit (15.5)# 

+#right#20.01.88 

+ 

+#center##ub#Beschreibung der Single-Chip-uP 8031/5/9/40/8/9/50#ue# 

+ 

+1.) Pinning MCS-48, UPI-41, UPI-42 

+ 

+                          +----__----+ 

+              T0          |  1    40 | Vcc +5V

+              Xtal1       |  2    39 | T1 (In) 

+              Xtal2       |  3    38 | P27       -DACK =8x41/2

+              -Reset (In) |  4    37 | P26       DRQ   =8x41/2

+              -SS (In)    |  5    36 | P25       -IBF  =8x41/2

+              -Int (In)   |  6    35 | P24       -OBF  =8x41/2

+              EA (In)     |  7    34 | P17 

+              -RD (Out)   |  8    33 | P16 

+ 8x41/2=A0    -PSEN (Out) |  9    32 | P15 

+              -WR (Out)   | 10    31 | P14 

+ 8x41/2=SYNC  ALE (Out)   | 11    30 | P13 

+              D0          | 12    29 | P12 

+              D1          | 13    28 | P11 

+              D2          | 14    27 | P10 

+              D3          | 15    26 | Vdd/Vpp +5V/+21V bzw. 25V         

+              D4          | 16    25 | PROG (O=8243 ioExpander,I=pulse)  

+              D5          | 17    24 | P23 

+              D6          | 18    23 | P22 

+              D7          | 19    22 | P21 

+              GND         | 20    21 | P20 

+                          +----------+ 

+-SS   : Single Step (zusammen mit ALE-Output) 

+-RESET: 10uF Kondensator nach GND

+-INT  : muss mind. 3 Zyklen lang low sein 

+PROG  : Programmierpuls (+18V, +23V) bzw. 

+        bzw. Output fuer 8243 I/O Expander 

+SYNC  : Output Clock wie ALE 

+A0    : Input from Host: 0 = Datatransfer, 1 = Commandtransfer (kann in F1 

+        gelesen werden) 

+-IBF  : Input buffer full 

+OBF   : Outputbuffer full 

+-DACK : DMA Acknowledge 

+DRQ   : DMA request 

+ 

+ 

+- Pinning MCS-51 

+ 

+                          +----__----+ 

+8x32/52=T2    P10         |  1    40 | Vcc +5V

+8x32/52=T2EX  P11         |  2    39 | P00/AD0 

+              P12         |  3    38 | P01/AD1

+              P13         |  4    37 | P02/AD2

+              P14         |  5    36 | P03/AD3

+              P15         |  6    35 | P04/AD4

+              P16         |  7    34 | P05/AD5

+              P17         |  8    33 | P06/AD6

+              Reset/Vpd   |  9    32 | P07/AD7

+              P30/RXD     | 10    31 | -EA 

+              P31/TXD     | 11    30 | ALE 

+              P32/-INT0   | 12    29 | -PSEN

+              P33/-INT1   | 13    28 | P27/A15

+              P34/T0      | 14    27 | P26/A14

+              P35/T1      | 15    26 | P25/A13                           

+              P36/-WR     | 16    25 | P24/A12                           

+              P37/-RD     | 17    24 | P23/A11

+              Xtal2       | 18    23 | P22/A10

+              Xtal1       | 19    22 | P21/A9

+              GND         | 20    21 | P20/A8

+                          +----------+ 

+ 

+T2 = Timer 2 counter trigger input 

+T2EX = Timer 2 external input clock 

+

+-Vdd     : +5V im Betrieb, 

+           0V fuer Low Power Standby 

+           +21V/+25V fuer Programmierspannung 

+-T0      : Test Input 0 bzw. 

+           Clock-Output des Timers falls ENT0 CLK Befehl gegeben wurde. 

+-T1      : Test Input 1 bzw. 

+           Counter/Timer Input if STRT CNT Befehl gegeben wurde 

+XTAL1    : Quartz, bzw. CLock Input 

+XTAL2    : Quartz 

+ALE      : Adresse Latch enable output (einmal pro Zyklus aktiviert, d.h.

+           als Clockoutput zu gebrauchen) 

+           Negative Flanke uebernimmt Adressen auf dem Bus in ext. Latch 

+-RD      : Output-Strobe to read Data from the BUS into the CPU 

+-WR      : Output-Strobe indicating a write into external Memory 

+-PSEN    : Low if a fetch to external memory occurs (ROM -CE)

+P10..P17 : I/O Port 1 quasi-bidirektional 

+P20..P27 : I/O Port 2 " 

+           P20..P23 dienen als A8..A11 bei Programstore fetches bzw. 

+           mit PROG & 8243 als 4Bit I/O Expander Adresse 

+EA       : External Access input, If high, all internal Programm Memory 

+           fetches reference external memory (debugging mode) 

+D0..D7   : Datenbus, I/O zus. mit -RD, -WR, ALE 

+           Enthaelt A0..A7 zusammen mit PSEN fuer ext. Prog.mem.References  

+            "       A0..A7 "       mit ALE, -RD, -WR fuer ext.RAM-References 

+ 

+ 

+2.) Vergleich der Single-Chip-CPUs 

+ 

+UPI-41      : 8041, 8641, 8741 

+UPI-42      : 8042, 8742 

+MCS-48 Serie: 8035, 8039, 8040, 8048, 8049, 8050, 8748, 8749, (8243) 

+MCS-51 Serie: 8031, 8032, 8044, 8344, 8744, 8051, 8052 

+ 

+E = EPROM - Version 

+R = (Mask)-ROM Version 

+- = Kein ROM 

+X = External PROM 

+Buf=Buffered Port, Buffer-Full über Pins rausgeführt. 

+ 

+ CPU  | RAM | ROM |E|Ports|Serial |Timer |INTs| Sonstiges 

+------+-----+-----+-+-----+-------+------+----+-------------------------- 

+ 8031 |  64 |  -  |-| 4(3)|1 Async| 2x16 | 2  | 128k ext.mem., boolean-cpu 

+ 8032 | 256 |  -  |-| 4(3)|1 Async| 3x16 | 2  | 128k ext.mem., boolean-cpu 

+ 8035 |  64 |  -  |-| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8039 | 128 |  -  |-| 2   |   -   | 1x 8 | 1  | " 

+ 8040 | 256 |  -  |-| 2   |   -   | 1x 8 | 1  | " 

+ 8041 |  64 | 1k  |R|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8042 | 128 | 2k  |R|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8044 | 192 | 4k  |R| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8048 |  64 | 1k  |R| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8049 | 128 | 2k  |R| 2   |   -   | 1x 8 | 1  | " 

+ 8050 | 256 | 4k  |R| 2   |   -   | 1x 8 | 1  | " 

+ 8051 | 128 | 4k  |R| 4(3)|1 Async| 2x16 | 2  | 128k ext., boolean-cpu 

+ 8052 | 256 | 8k  |R| 4(3)|1 Async| 3x16 | 2  | 128k ext., boolean-cpu 

+ 8243 |   - |  -  |-|4x4B |   -   |  -   | -  | I/O Expander f.MCS-48 Serie 

+ 8344 | 192 | 4k  |X| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8741 |  64 | 1k  |E|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8742 | 128 | 2k  |E|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8744 ! 192 | 4k  |E| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8748 |  64 | 1k  |E| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8749 | 128 | 2k  |E| 2   |   -   | 1x 8 | 1  | " 

+ 8751 | 128 | 4k  |E| 4(3)|1 Async| 2x16 | 2  | 128k ext., boolean-cpu 

+ 8752 | 256 | 4k  |E| 4(3)|1 Async| 3x16 | 2  | 128k ext., boolean-cpu 

+ 

+ 

+- Programmieren des 8748: 

+ 

+ 1.) Vdd = 5V, XTAL angeschlossen, -RESET = 0V, T0=5V, EA=5V 

+ 2.) 8748 in Sockel setzen 

+ 3.) T0=0V (* Program Mode select *) 

+ 4.) EA=23V (* Program Mode activate *) 

+ 5.) BUS (0..7) und P2.0..P2.3 (8..B) mit Adresse belegen 

+ 6.) -RESET=5V (* Latch Adress *) 

+ 7.) BUS := Databyte 

+ 8.) Vdd=25V (* Programmierspannung *) 

+ 9.) PROG=0V, dann 50ms PROG=23V (* Programmieren *) 

+10.) Vdd=5V (* Programmierspannung weg *) 

+11.) T0=5V (* Verify mode *) 

+12.) Read Data on BUS and compare (* Verify *) 

+13.) T0=0V (* Select Program Mode *) 

+14.) -RESET=0V, GOTO Step 5 (* Floating BUS *) 

+15.) Vdd=5V, -RESET=0V, EA=5V, 8748 aus Sockel nehmen 

+ 

+3.) Memory-Map des 8039 

+ 

+RAM 

+Adresse  Funktion 

+00..07   Registerbank 0 (r0..r7) 

+08..17   Stack (8 Ebenen) 

+18..1F   Registerbank 1 (r0..r7) 

+20..7F   Frei belegbar 

+ 

+ROM 

+Adresse 

+000..0FF ROM-Page 0, Bank 0 (Bank 0 ist mb0) 

+... 

+700..7FF ROM-Page 7, Bank 0 

+800..8FF ROM Page 0, Bank 1 (Adressen 800..FFF treten im Code nur 

+...                          als 000..7FF auf!) 

+F00..FFF ROM Page 7, Bank 1 (Bank 1 ist mb1) 

+ 

+Bei Reset erfolgt ein Sprung nach 000 

+Bei (Timer-)Interrupt erfolgt ein Sprung nach 007 

+ 

+Register 

+Bezeichn. Name 

+a         Akkumulator (8 Bit) 

+r0..r7    Register 0 bis 7 (Im internen RAM) (je 8 Bit) 

+t         Timer (8 Bit) 

+p1        Port 1 (8 Bit) 

+p2        Port 2 (8 Bit) 

+ 

+Bits 

+i         Interrupt-Leitung INT (1 Bit) 

+t0        Test-Eingang T0 (1 Bit) 

+t1        Test-Eingang T1 (91 Bit) 

+f0        Internes Flag 0 

+f1        Internes Flag 1 

+ 

+Jump-Conditions 

+jtf        Jump if Timer finished (Nulldurchgang) 

+jntf       Jump if Timer not finished (zählt noch) 

+jb0..jb7   Jump if Bit 0..7 in a is set 

+jt0        Jump if T0-Input is high 

+jnt0       Jump if T0-Input is low 

+jt1        Jump if T1-Input is high 

+jnt1       Jump if T1-Input is low 

+jf0        Jump if Flag 0 is set 

+jnf0       Jump if Flag 0 is cleared 

+jf1        Jump if Flag 1 is set 

+jnf1       Jump if Flag 1 is cleared 

+jz         Jump if a is zero 

+jnz        Jump if a is not zero 

+jc         Jump if carry is set 

+jnc        Jump if carry is cleared 

+jni        Jump if Interrupt-Pin INT is low 

+ 

+4.) Befehlssatz nach Opcode sortiert 

+ 

+Symbolik (Beispiele) 

+ 

+@r0   Inhalt der Speicherstelle, deren Adresse in Register 0 steht. 

+#xx   Die (Byte-)Konstante xx 

+2xx   Die Adressen 200..2FF (je nach xx), xx ist ein Offset zur Seite 2. 

+mb1   ROM-Bank 1 ('800..FFF') 

+ 

+00             nop 

+01 

+02 

+03 xx          add  a,#xx 

+04 xx          jmp  0xx 

+05 

+06 xx          jntf xx 

+07             dec  a 

+08 

+09             in   a,p1 

+0A             in   a,p2 

+0B 

+0C 

+0D 

+0E 

+0F 

+ 

+10             inc  @r0       Memoryvalue incrementieren 

+11             inc  @r1 

+12 xx          jb0  xx        Jump if Bit 0 in a is high 

+13 

+14 xx          call 0xx 

+15             dis  i         Disable Interrupts 

+16 xx          jtf  xx 

+17             inc  a 

+18             inc  r0 

+19             inc  r1 

+1A             inc  r2 

+1B             inc  r3 

+1C             inc  r4 

+1D             inc  r5 

+1E             inc  r6 

+1F             inc  r7 

+ 

+20             xch  a,@r0     a und Memoryinhalt bei @r0 austauschen 

+21             xch  a,@r1 

+22 

+23 xx          mov  a,#xx     a mit Konstante laden 

+24 xx          jmp  1xx 

+25             en   tcnti     Enable Timer/Counter Interrupt 

+26 xx          jnt0 xx 

+27             clr  a         a := 0 

+28             xch  a,r0      a und Register vertauschen 

+29             xch  a,r1 

+2A             xch  a,r2 

+2B             xch  a,r3 

+2C             xch  a,r4 

+2D             xch  a,r5 

+2E             xch  a,r6 

+2F             xch  a,r7 

+ 

+30 

+31 

+32 xx          jb1  xx 

+33 

+34 xx          call 1xx 

+35             dis  tcnti     Disable Timer/Counter Interrupt 

+36 xx          jt0  xx 

+37             cpl  a         a := NOT a 

+38 

+39 

+3A 

+3B 

+3C 

+3D 

+3E 

+3F 

+ 

+40             orl  a,@r0 

+41             orl  a,@r1 

+42             mov  a,t       Timervalue lesen nach a 

+43 xx          orl  a,#xx     Logisches Oder 

+44 xx          jmp  2xx 

+45             strt cnt       Counter starten, Timer aus 

+46 xx          jnt1 xx 

+47 

+48             orl  a,r0 

+49             orl  a,r1 

+4A             orl  a,r2 

+4B             orl  a,r3 

+4C             orl  a,r4 

+4D             orl  a,r5 

+4E             orl  a,r6 

+4F             orl  a,r7 

+ 

+50             anl  a,@r0 

+51             anl  a,@r1 

+52 xx          jb2  xx 

+53 xx          anl  a,#xx     Logisches Und 

+54 xx          call 2xx 

+55             strt t         Timer starten, Counter aus 

+56 xx          jt1  xx 

+57 

+58             anl  a,r0 

+59             anl  a,r1 

+5A             anl  a,r2 

+5B             anl  a,r3 

+5C             anl  a,r4 

+5D             anl  a,r5 

+5E             anl  a,r6 

+5F             anl  a,r7 

+ 

+60             add  a,@r0 

+61             add  a,@r1 

+62             mov  t,a       Timervalue mit a laden 

+63 

+64 xx          jmp  3xx 

+65             stop tcnt      Timer/Counter stoppen 

+66 xx          jnf1 xx 

+67             rrc  a         a rechts rotieren (durchs Carry) 

+68             add  a,r0      a := a + r0 

+69             add  a,r1 

+6A             add  a,r2 

+6B             add  a,r3 

+6C             add  a,r4 

+6D             add  a,r5 

+6E             add  a,r6 

+6F             add  a,r7 

+ 

+70 

+71 

+72 xx          jb3  xx 

+73 

+74 xx          call 3xx 

+75 

+76 xx          jf1  xx 

+77             rr   a         a rechts rotieren (ohne Carry) 

+78 

+79 

+7A 

+7B 

+7C 

+7D 

+7E 

+7F 

+ 

+80                  

+81 

+82 

+83             ret            Unterprogrammruecksprung 

+84 xx          jmp  4xx 

+85             clr  f0        Flag 0 loeschen 

+86 xx          jni  xx 

+87 

+88 

+89 xx          orl  p1,#xx    Bits im Outputport 1 setzen 

+8A xx          orl  p2,#xx    dto. Port 2 

+8B 

+8C 

+8D 

+8E 

+8F 

+ 

+90             movx @r0,a     Port (@r0) mit a beschreiben 

+91             movx @r1,a 

+92 xx          jb4  xx 

+93             retr           Return from Interrupt

+94 xx          call 4xx 

+95             cpl  f0        Flag 0 umdrehen 

+96 xx          jnz  xx 

+97             clr  c         Carry loeschen 

+98 

+99 xx          anl  p1,#xx    Bit im Outputport 1 loeschen (mit NOT xx) 

+9A xx          anl  p2,#xx    dto. Port 2 

+9B 

+9C 

+9D 

+9E 

+9F 

+ 

+A0             mov  @r0,a     Memory mit a beschreiben 

+A1             mov  @r1,a 

+A2 

+A3             movp a,@a      a mit ROMinhalt (a) laden (aktuelle Page) 

+A4 xx          jmp  5xx 

+A5             clr  f1 

+A6 

+A7             cpl  c         Carry umdrehen 

+A8             mov  r0,a 

+A9             mov  r1,a 

+AA             mov  r2,a 

+AB             mov  r3,a 

+AC             mov  r4,a 

+AD             mov  r5,a 

+AE             mov  r6,a 

+AF             mov  r7,a 

+ 

+B0 xx          mov  @r0,#xx   Memoryzelle mit Konstante laden 

+B1 xx          mov  @r1,#xx 

+B2 xx          jb5  xx 

+B3 

+B4 xx          call 5xx 

+B5             cpl  f1 

+B6 

+B7 

+B8 xx          mov  r0,#xx    Register mit Konstante laden 

+B9 xx          mov  r1,#xx 

+BA xx          mov  r2,#xx 

+BB xx          mov  r3,#xx 

+BC xx          mov  r4,#xx 

+BD xx          mov  r5,#xx 

+BE xx          mov  r6,#xx 

+BF xx          mov  r7,#xx 

+ 

+C0             dec  @r0 

+C1             dec  @r1 

+C2 

+C3 

+C4 xx          jmp  6xx 

+C5             sel  rb0       Registerbank 0 waehlen (RAM 00..07) 

+C6 xx          jz   xx 

+C7 

+C8             dec  r0 

+C9             dec  r1 

+CA             dec  r2 

+CB             dec  r3 

+CC             dec  r4 

+CD             dec  r5 

+CE             dec  r6 

+CF             dec  r7 

+  

+D0             xrl  a,@r0 

+D1             xrl  a,@r1 

+D2 xx          jb6  xx 

+D3 xx          xrl  a,#xx     Logisches Exklusiv-Oder 

+D4 xx          call 6xx 

+D5             sel  rb1       Registerbank 1 waehlen (RAM 18..1F) 

+D6 

+D7 

+D8             xrl  a,r0 

+D9             xrl  a,r1 

+DA             xrl  a,r2 

+DB             xrl  a,r3 

+DC             xrl  a,r4 

+DD             xrl  a,r5 

+DE             xrl  a,r6 

+DF             xrl  a,r7 

+ 

+E0 xx          djnz @r0,xx    

+E1 xx          djnz @r1,xx 

+E2 

+E3             movp3 a,@a     a mit Inhalt von (3aa) laden, aa = (a)

+E4 xx          jmp  7xx 

+E5             sel  mb0       Memorybank 0 (ROM 000..7FF) waehlen 

+E6 xx          jnc  xx 

+E7             rl   a         a nicht durch c links rotieren 

+E8 xx          djnz r0,xx     Decrement r0, jump to xx if r0 is not zero 

+E9 xx          djnz r1,xx 

+EA xx          djnz r2,xx 

+EB xx          djnz r3,xx 

+EC xx          djnz r4,xx 

+ED xx          djnz r5,xx 

+EE xx          djnz r6,xx 

+EF xx          djnz r7,xx 

+ 

+F0             mov  a,@r0 

+F1             mov  a,@r1 

+F2 xx          jb7  xx 

+F3 

+F4 xx          call 7xx 

+F5             sel  mb1       Memorybank 1 (ROM 800..FFF) waehlen 

+F6 xx          jc   x 

+F7             rlc  a         a durch carry links rotieren 

+F8             mov  a,r0 

+F9             mov  a,r1 

+FA             mov  a,r2 

+FB             mov  a,r3 

+FC             mov  a,r4 

+FD             mov  a,r5 

+FE             mov  a,r6 

+FF             mov  a,r7 

+ 

+5.) Befehlssatz nach Funktionsgruppen 

+ 

+- Arithmetik 

+            @r0 @r1 -   #xx -   -   -   a   r0..r7 

+dec         c0  c1      -               07  C8..CF 

+inc         10  11      -               17  18..1F 

+clr         -   -       -               27  - 

+cpl         -   -       -               37  - 

+orl a,..    40  41      43              -   48..4F 

+anl a,..    50  51      53              -   58..5F 

+add a,..    60  61      03              -   68..6F 

+rrc         -   -       -               67  - 

+rr          -   -       -               77  - 

+xrl a,..    D0  D1      D3              -   D8..DF 

+rl          -   -       -               E7  - 

+rlc         -   -       -               F7  - 

+ 

+- Flags 

+                                f0  f1  c 

+clr                             85  A5  97 

+cpl                             95  B5  A7 

+ 

+- Transfer 

+            @r0 @r1 -   #xx -   -   -   a   r0..r7 

+xch a,..    20  21      -                   28..2F 

+mov a,..    F0  F1      23                  F8..FF 

+mov ..,a    A0  A1      -                   A8..AF 

+mov ..,#xx  B0  B1      23                  B8..BF 

+ 

+swap a

+movp a,@a               A3  

+movp3 a,@a              E3 

+ 

+ 

+- I/O 

+                                                  i= 1   2 

+in   a,pi                                            09   0A 

+orl  pi,#xx                                          89   8A 

+anl  pi,#xx                                          99   9A 

+outl pi,a 

+ 

+movx ..,a   90  91 

+movx a,xx 

+ 

+ 

+- Timer 

+                                i  tcnti 

+en                              05  25 

+dis                             15  35 

+ 

+                                cnt t 

+strt                            45  55 

+stop                              65 

+ 

+mov a,t             42 

+mov t,a             62 

+ 

+ 

+- Programmsteuerung 

+ 

+ret                     83 

+retr                    93 

+ 

+     rr=   @r0 @r1                          r0..r7 

+djnz rr,xx (E0  E1)                         E8..EF 

+ 

+      i=   0   1   2   3   4   5   6   7 

+jmp  $ixx  04  24  44  64  84  A4  C4  E4 

+call $ixx  14  34  54  74  94  B4  D4  F4 

+ 

+      i=   0   1   2   3   4   5   6   7 

+jbi,xx     12  32  52  72  92  B2  D2  F2 

+ 

+      cc=  ntf tf  nt0 t0  nt1 t1  nf1 f1  ni  nz  z   nc  c 

+jcc,xx     06  16  26  36  46  56  66  76  86  96  C6  E6  F6 

+ 

+- Sonstiges 

+                                rb0 rb1 mb0 mb1 

+sel                             C5  D5  E5  F5 

+nop        00 

diff --git a/system/shard-x86-at/7/doc/BIOSINT.TXT b/system/shard-x86-at/7/doc/BIOSINT.TXT
new file mode 100644
index 0000000..c55b064
--- /dev/null
+++ b/system/shard-x86-at/7/doc/BIOSINT.TXT
@@ -0,0 +1,305 @@
+#type ("17.klein")# 

+Interrupts/Traps/Exeptions (Bios)                                 03.06.87

+ 

+Interrupt: IRQn (Durch Hardware ausgelöst, werden auf Traps umgelenkt) 

+Trap     : INTn (Durch Software ausgelöst) 

+Exeption : INTn (Im Protected Mode vom Prozessor ausgelöst) 

+ 

+Traps   | Funktion 

+--------+------------------------------------------------------------------ 

+INT 00H : Abort Program

+INT 01H : 

+INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) 

+INT 03H : INT3 - Break

+INT 04H : INTO - Overflow

+INT 05H : Print Screen 

+INT 06H : 

+INT 07H : 

+INT 08H : IRQ0 System Interrupt 

+INT 09H : IRQ1 Keyboard Buffer full

+INT 0AH : Software redirected from IRQ9 

+INT 0BH : IRQ3 Serial Port 2 

+INT 0CH : IRQ4 Serial Port 1 

+INT 0DH : IRQ5 Parallel Port 2 

+INT 0EH : IRQ6 Diskette Interrupt 

+INT 0FH : IRQ7 Parallel Port 1 

+ 

+INT 10H : Video Trap 

+  ah = 00H : set mode (al = mode) 

+             (Videoram: Herkules: B0000 

+                        EGA     : B8000)

+             al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten 

+             ---+------+-------+---------+---------+-------+-------- 

+             00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*|   8 

+             01 | Text |640x200| 40 x 25 | Color   | 16/64*|   8 

+             02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*|   8 

+             03 | Text |640x200| 80 x 25 | Color   | 16/64*|   8 

+             04 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             05 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             06 | Graf |640x200| 80 x 25 | Mono/Col|   2   |   1 

+             07 | Text |720x348| 80 x 25 | Mono    |   4   |   8 

+             08 | Graf |720x348| 90 x 48 | Mono    |   2   |   1

+       --------- ab hier nicht implementiert, nur EGA ------------------ 

+             VideoRAM-Adresse A0000

+             0D | Graf |320x200| 40 x 25 | Color   |  16   |   8 

+             0E | Graf |640x350| 80 x 25 | Color   |  16   |   4 

+             0F | Graf |640x350| 80 x 25 | Mono    |   4   |   2 

+             10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*|   2 

+                                                           * mit EGA-Monitor 

+  ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) 

+             CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks 

+  ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile)

+  ah = 03H : read cursor 

+             Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des 

+                      Cursorblocks, CH=Endzeile des Cursorblocks

+  ah = 04H : read lightpen 

+             Ausgang: AH=1 : Register sind gültig, AH=0: Taste nicht gedrückt

+                      DH = Zeile, DL = Spalte des Lightpens

+                      CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) 

+                      BX = Rasterspalte (1..319/1..639) 

+  ah = 05H : set actual display (AL = Neue Seite)

+  ah = 06H : scroll up 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 07H : scroll down 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 08H : read current attribute and char

+             Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) 

+  ah = 09H : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe

+  ah = 0AH : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen 

+  ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) 

+  ah = 0CH : write dot 

+             BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird

+             alte Farbe mit neuer Farbe geXORed)

+  ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert)

+  ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) 

+  ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl

+                                   Zeichenspalten, BH=Seite)

+  ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) 

+  ax = 1142H: draw line (EGA-Bios: 12 Routinen für den Charactergenerator) 

+             CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to

+  ah = 12H : reserved (EGA-Bios: Alternate Characterset) 

+  ah = 13H : write string

+             Allgemein: 

+               ES:BP = Stringanfang 

+               CX = Stringlänge

+               DL, DH = Cursorposition (Stringanfang) 

+               BH = Seite 

+       al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht 

+               bewegt.

+       al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt.

+       al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. 

+       al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. 

+ 

+INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) 

+          AX : 

+             Bit 1 : 80287 installiert

+             Bit 3 : Herkules installiert

+             Bit 4/5   : 0 = No Primary Display set 

+                         1 = Monochrome 

+                         2 = Color 80 * 25 

+                         3 = EGA

+             Bit 6     : Drive B installiert

+             Bit 9..12 : Anzahl RS232

+             Bit 14/15 : Anzahl Printer

+ 

+INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) 

+ 

+INT 13H : Hardisk Trap 

+          Allgemein: 

+          DL = Drive (0, 1...) 

+          AL = Sector count 

+          CX = Bit 0... Bit 5 = Sector 

+               Bit 6... Bit 15 = Cylinder 

+          Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) 

+  ah = 0 reset diskette, wd1010, hdisks 

+  ah = 1 return status 

+  ah = 2 read 

+  ah = 3 write 

+  ah = 4 verify 

+  ah = 5 format 

+  ah = 8 drive params 

+  ah = 9 init drive 

+  ah = A read long 

+  ah = B write long 

+  ah = C seek 

+  ah = D reset wd1010 (DL = Drive) 

+  ah =10 ready test

+  ah =11 reclibrate 

+  ah =14 check controller  

+  ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) 

+ 

+INT 14H : RS232C Trap 

+  Allgemein: dx = port (>= 1FE0H : SCC = 8530) 

+  ah = 0 : Init

+           al : Bit 5..7 = Baudrate 

+                    000 = 110,

+                    001 = 150, 

+                    010 = 300, 

+                    011 = 600, 

+                    100 = 1200, 

+                    101 = 2400, 

+                    110 = 4800, 

+                    111 = 9600, 

+                Bit 3..4 = Parity    (no, odd, even) 

+                Bit 2    = Stopbits  (1, 2)

+                Bit 0..1 = Datenbits (5, 6, 7, 8)

+  ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) 

+  ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen)

+  ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) 

+           ah : Bit 0 = 1 : Data available 

+                Bit 1 = 1 : Receiver overrun 

+                Bit 2 = 1 : Parity Error 

+                Bit 3 = 1 : Framing Error 

+                Bit 4 = 1 : Transmitter empty 

+                Bit 5 = 1 : Break received 

+ 

+INT 15H : Utility Trap 

+  ah = 80H open device (nicht implementiert) 

+  ah = 81H close device (nicht implementiert)

+  ah = 82H prog term (nicht implementiert)

+  ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) 

+           Ausgang: CY=0, Event wait wurde aktiviert 

+                    CY=1, Noch kein RTC-Event aufgetreten 

+                          (INT 15H periodisch aufrufen zum pollen)

+  ah = 84H joy stick (Eingang: DX)

+       DX = 0: Ausgang: AL (Bits 4..7) = Buttons 

+       DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb

+  ah = 85H sys request (nicht implementiert) 

+  ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) 

+  ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block

+           Descriptoren: 8 Bytes Source, 8 Bytes Destination)

+  ah = 88H extended memory (Ausgang: AX= KB extended Memory) 

+  ah = 89H enter protected mode

+  ax = 8A42H run setup 

+  ax = 8B42H error beep

+  ax = 8C42H usr-powerfail-shutdown-routine

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS abgelegt werden) 

+  ax = 8D42H usr-powerfail-resume-routine 

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS geholt werden) 

+  ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue 

+                                 BH: Bit 0 = BCD, Bit 1..3 = Mode, 

+                                     Bit 4..5 Write CMD, Bit 6/7 unused) 

+                       (Timer wird bei Resume wieder so initialisert)

+  ax = 8F42H hardcopy (Grafik & Mono)

+  ah = 90H device busy (nicht implementiert)

+  ah = 91H set int complete (nicht implementiert)

+  ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI 

+                              = Destinationadr.)

+  ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = 

+                                Destinationadr.)

+INT 16H : Keyboard Trap 

+  ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0)

+  ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue)

+  ah = 02 Shift status (Ausgang: AL = KB_flag) 

+  ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) 

+  ax = 0442 soft power down 

+ 

+INT 17H : Printer Trap

+  Allgemein: dx = port 

+  ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) 

+  ah = 1 : init printer port 

+  ah = 2 : ah = Status 

+ 

+INT 18H : Basic (nicht implementiert) 

+ 

+INT 19H : Bootstrap Trap 

+  Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) 

+  Der Block hat in Bytes 510/511 das Kennzeichen AA55H. 

+ 

+INT 1AH : Time of day Trap

+  ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow)

+  ah = 1 : Set Timer (CS=Timer low, DX=Timer high)  

+  ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) 

+  ah = 3 : Set Clock  (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std)

+  ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std)

+  ah = 7 : Reset Alarm 

+ 

+INT 1BH : Dummy Return 

+ 

+INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen.

+ 

+INT 1DH : Zeigt auf die Video Parameter

+INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) 

+INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255

+

+INT 20H ... INT 3FH sind für das Betriebssystem reserviert.

+ 

+INT 20H : DOS: Terminate Program

+INT 21H : DOS: Function Call

+INT 22H : DOS:

+INT 23H : DOS:

+INT 24H : DOS: 

+INT 25H : DOS: 

+ 

+INT 40H : Diskette Trap 

+  AH = 0 disk reset 

+  AH = 1 disk status (ret) 

+  AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren,

+                    DH = Head, DL = Drive, CL = Sektor, CH = Cylinder)

+  AH = 3 disk write           "

+  AH = 4 disk verify          "

+  AH = 5 disk format          "

+  AH = 21 disk type  (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) 

+  AH = 22 disk change 

+  AH = 23 format set 

+ 

+INT 41H : Hardfile Table Vector 

+INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios unterstützt)

+INT 46H : Hardfile 1 Table Vector 

+ 

+INT 4AH : Für User software redirected from RTC-IRQ (Alarm, periodic) 

+ 

+INT 60H 

+  ...     User 

+INT 6FH

+ 

+Hardware-Interrupts 8..15:

+INT 70H : IRQ 8 RTC-Interrupt

+INT 71H : IRQ 9 Software Redirected to INT 0AH 

+INT 72H : IRQ10 Frei

+INT 73H : IRQ11 Frei 

+INT 74H : IRQ12 Frei 

+INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) 

+INT 76H : IRQ14 Harddisk Interrupt

+INT 77H : IRQ15 Frei

+ 

+INT 78H : User 0

+INT 79H : User 1

+INT 7AH : User 2

+INT 7BH : User 3

+INT 7CH : User 4

+INT 7DH : User 5 

+INT 7EH : User 6

+INT 7FH : User 7 

+ 

+ 

+Exception | Bezeichnung                         | E-Code | Restart| Instr.

+----------+-------------------------------------+--------+--------+----------

+    0     | Divide Error                        |   -    | Ja     | DIV, IDIV

+    1     | Single Step                         |   -    | Ja     | Alle

+    2     | NMI                                 |   -    | Ja     | Alle

+    3     | Breakpoint                          |   -    | Ja     | INT3

+    4     | INTO Overflow                       |   -    | Ja     | INTO

+    5     | BOUND Range                         |   -    | Ja     | BOUND

+    6     | Invalid Opcode                      |   -    | Ja     | undef.Opc.

+    7     | Processor Extension Not Available   |   -    | Ja     | ESC, WAIT

+    8     | Double Exception / IDTL too small   |   0    | Nein   | LIDT

+    9     | Processor Extension Segment Overrun |   -    | Nein   | ESC

+   10     | Invalid Task State Segment          |  Ja    | Ja     | TaskSwitch

+   11     | Segment Not Present                 |  Ja    | Ja     | Alle Mem.

+   12     | Stack Segment Overrun or Not Present|  Ja    | Ja     | Stackopc.

+   13     | General Protection                  |  Ja    | Ja     | Alle Mem.

+   14     | -                                   |   -    |   -    | -

+   15     | -                                   |   -    |   -    | -

+   16     | Processor Extension Interrupt       |   -    |   -    | ESC, WAIT

+

diff --git a/system/shard-x86-at/7/doc/CONTROLS.ELA b/system/shard-x86-at/7/doc/CONTROLS.ELA
new file mode 100644
index 0000000..1ea4978
--- /dev/null
+++ b/system/shard-x86-at/7/doc/CONTROLS.ELA
@@ -0,0 +1,76 @@
+SHard-Spezifische 'control'-Funktionen (V2.7, AT-SHard)

+

+Kanal 32: 

+  control (-3, x, mcr*256+kanal, r) : Modem-Control-Register setzen

+                          mcr: Bit 0: DTR 

+                               Bit 1: RTS 

+                               Bit 2: OUT1 

+                               Bit 3: OUT2 (Interrupt enable) muss 1 sein

+                               Bit 4: Diagnostic-Mode (muss 0 sein) 

+                               Bit 5: -

+                               Bit 6: -

+                               Bit 7: -

+  control (-5, x, x, r)     : Anforderung nach 'shutup' Systemreset. 

+  blockin (clock, -4, x, r) : HW-Clock auslesen 

+           clock (1) = jahrhundert

+           clock (2) = jahr 

+           clock (3) = monat 

+           clock (4) = tag 

+           clock (5) = stunden 

+           clock (6) = minuten 

+           clock (7) = sekunden 

+

+Kanal 2..13 (sofern vorhanden) : 

+  control (-3, x, x, r) : 8250 Linestatusregister/Modemstatusregister lesen 

+          Bit  1: 1 = Receiver overrun detected 

+               2: 1 = Parity Error detected 

+               3: 1 = Framing Error detected 

+               4: 1 = Break Interrupt Detected 

+          Bit 8..15 nicht im Standard-SHard 

+         (Bit  8: 1 = CTS changed

+               9: 1 = DSR changed 

+              10: 1 = RI changed to inactive 

+              11: 1 = DCD changed 

+              12: CTS input 

+              13: DSR input 

+              14: RI input 

+              15: DCD input)

+  control (-4, x, x, r) ; r = Anzahl Eingabezeichen, seit letzter Abfrage 

+  control (-5, x, x, r) ; r = Anzahl Ausgabezeichen, seit letzter Abfrage 

+  control (-6, x, x, r) ; Break senden 

+  control (-10, x, x, r) ; DTR+RTS inactive setzen (stop!) 

+  control (-11, x, x, r) ; DTR+RTS active setzen (weiter)

+ 

+Kanal 14..16 (falls vorhanden): 

+  control (-3, x, x, r) ; Printeroutput nicht mehr ueber SHard sondern BIOS 

+  control (-4, 256 * retry + wartezeit, x, r) ; 

+                          Setzt fuer langsame Drucker retrys und Wartezeit 

+                          zwischen den Zeichen.

+ 

+Kanal 1 : 

+  control (-3, attribut, x, r) ; Textattribut fuer Bildschirmausgaben setzen 

+  control (-4, x, palette, r) ; Colorpalette fuer Farbkarte setzen. 

+  control (-5, 256 * karte + mode, x, r) ; Videomodus einschalten 

+                     karte: 1 = tecmar(mode=0..5), 2 = hercules (mode=0)

+                     karte: 0 = Bios (mode=0, 7, 8=graphik)

+  control (-6, xpos, ypos, r) ; Draw line to (xpos, ypos) 

+  control (-7, xpos, ypos, r) ; Move to (xpos, ypos)

+  control (-8, maske, linetype, r) ; Set pen 

+  control (-9, p1, p2, r) ; Set color pen 1 

+  control (-10, p1, p2, r) ; Set color pen 2 

+  control (-11, new mask count, mode, old mask count) ; Set Mask Mode 

+                             mode = 0 : Kein Mask mode 

+                             mode = 1 : Mask Mode einschalten. 

+Kanal 28, 29 (Harddisk): 

+  control (-10, x, x, r) : r = Anzahl Cylinder-1 (Gesamte Platte) 

+  control (-11, x, x, r) : r = Anzahl Sektoren

+  control (-12, x, x, r) : r = Anzahl Heads

+ 

+Kanal 30, 31 (Floppy) :

+  - 

+ 

+

+

+

+

+

diff --git a/system/shard-x86-at/7/doc/PORTS.PRT b/system/shard-x86-at/7/doc/PORTS.PRT
new file mode 100644
index 0000000..f11e760
--- /dev/null
+++ b/system/shard-x86-at/7/doc/PORTS.PRT
@@ -0,0 +1,658 @@
+#type ("17.klein")# 

+System-Ports: 

+ 

+Port | Funktion

+-----+-------------------------------------------------------------------- 

+     | DMA Controller 1 (8237A-5) für Bytetransfers (Kanal 0..3) 

+ 00  | Byteadresse (start/current) Kanal 0 (frei für Memory-Memory Transfer)

+ 01  | Bytecount Kanal 0            (Pageregister 87H) (Sourcechannel)

+ 02  | Byteadresse (start/current) Kanal 1 (reserviert für SDLC) 

+ 03  | Bytecount Kanal 1            (Pageregister 83H) (Destinationchannel)

+ 04  | Byteadresse (start/current) Kanal 2 (Diskette) 

+ 05  | Bytecount Kanal 2            (Pageregister 81H) 

+ 06  | Byteadresse (start/current) Kanal 3 (XT: Harddisk) 

+ 07  | Bytecount Kanal 3            (Pageregister 82H) 

+ 08  | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) 

+     | Write: DMA-Command: 

+     |  D0 1 = memory<-->memory transfer enabled 

+     |  D1 Falls D0 = 1: 1 = Kanal 0 Adresse INCR/DECR, 0 = Adr. unverändert

+     |  D2 1 = DMA-Control enabled

+     |  D3 1 = R/W-Signal verkürzt 

+     |  D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren 

+     |  D5 Falls D3 = 0, 1 = verzögertes R/W-Signal, 0 = verlängertes R/W 

+     |  D6 1 = DREQ active-low, 0 = DREQ active-high 

+     |  D7 1 = DACK active-high, 1 = DACK active-low 

+  09 | Read/Write: Anforderungsregister 

+     |  D1, D0 = Nummer des aktiven DMA-Kanals 

+     |  D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) 

+     |     0 = DMA-Transfer wurde per Hardware angestossen 

+  0A | Read/Write : Single Mask Register Bit 

+     | D0..D3 für jeden Kanal: 1 =  DREQ gesperrt, 0 = DREQ freigegeben 

+  0B | Write: Mode-Register

+     | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (0..3) 

+     | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) 

+     |  0   0 Prüfzyklen 

+     |  0   1 Write in Memory 

+     |  1   0 Read aus Memory 

+     |  1   1 Illegal 

+     | D4 1 = Autorepeat 

+     | D5 1 = DECR Adressen, 0 = INCR Adressen 

+     | D7, D6 

+     |  0   0 Polling

+     |  0   1 Cycle Steal 

+     |  1   0 Burst Mode 

+     |  1   1 Kaskadierter Controller

+  0C | Clear Byte Pointer Flip-Flop 

+  0D | Read: Temporary-Register, Write: Master Clear 

+  0E | Clear Mask Register 

+  0F | Write: All Mask Register 

+     | 

+     | Interrupt-Controller 1 (Master) 8259, siehe Datenblatt 

+  20 | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) 

+  21 | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand)

+     | 

+     | Intervall-Timer 8254.2 

+  40 | Channel 0 Timeconstant (System Interrupt IRQ 0) 

+  41 | Channel 1 Timeconstant (Refesh Request) 

+  42 | Channel 2 Timeconstant (Speaker Output) 

+  43 | Control (Channel 0..2) 

+     |

+     | KEYBOARD

+  60 | Keyboard Data Read/Write 

+  61 | System Control Port (In/Out Port) 

+     | Write:

+     |  D0 = Speaker Gate

+     |  D1 = Speaker Data

+     |  D2 = Base Parity Check (<512k), 0 = Parity Check erlaubt

+     |  D3 = Channel Parity Check (>=512k), 0 = Parity Check erlaubt  

+     | Read:

+     |  D4 = 1 = Refresh Detected

+     |  D5 = 1 = Output Timer 2 

+     |  D6 = 1 = IO-RAM Parity Error 

+     |  D7 = 1 = Base-RAM Parity Error 

+  64 | Keyboard Command/Status Port

+     | Write (Command): 

+     | Command C0H liest Input Port, Byte im Datenregister ist dann: 

+     | D4 : 0 = 2nd 256k Board-RAM disabled 

+     | D5 : 0 = Manufacturing Jumper installed 

+     | D6 : 1 = Primary Display is Monochrome, 0 = Color 

+     | D7 : 0 = Keyboard is inhibited

+     | Command D0H liest Output Port, Byte im Datenregister ist dann:

+     | D0 : 0 = System Reset 

+     | D1 : Gate A20 (AND-Verknüpfung mit A20-Adressleitung)

+     | D4 : Output-Buffer full 

+     | D5 : Input-Buffer empty 

+     | D6 : Keyboard clock (output) 

+     | D7 : Keyboard data (output)

+     | D1H schreibt Output Port, sonst wie D0H 

+     | Read (Status): 

+     | D0 : 1 = Outputbuffer is filled (Keyboard --> Computer) 

+     | D1 : 0 = Inputbuffer is empty

+     | D2 : System-Flag

+     | D3 : Last Write: 1 = Command, 0 = Data

+     | D4 : 0 = keyboard is inhibited 

+     | D5 : 1 = Transmit-Timeout Error

+     | D6 : 1 = Receive-Timeout Error

+     | D7 : 1 = Parity Error (Receive)

+     | 

+     | RTC/RAM

+ 70  | CMOS-Adresse, NMI-Mask 

+     | D0..D5 = CMOS-Adresse (0..63) 

+     | D7 : 0 = NMI enabled, 1 = NMI disabled (Power-Fail, Parity-Check, NP)

+     | RTC-Adressen:

+     | 00 : Seconds 

+     | 01 : Alarm Seconds 

+     | 02 : Minutes 

+     | 03 : Alarm Minutes 

+     | 04 : Hours 

+     | 05 : Alarm Hours 

+     | 06 : Day of week (1..7) 

+     | 07 : Date of Month 

+     | 08 : Month 

+     | 09 : Year     (32H = Century) 

+     | 0A : Status Register A : Bit 7 = 1 Update in progress 

+     | 0B : Status Register B : Bit 5 = 1 Alarm Interrupt enabled 

+     |                          Bit 0 = 1 Sommerzeit (Ende Mai..Ende Okt.!) 

+     | 0C : Status register C : Bit 7 = 1 Interrupt occured 

+     | 0D : (Read!) Bit 7 = 1 Power Good 

+     | RAM-Adressen: 

+     | 0E : Diagnostic Status Byte 

+     |  D7 : 1 = RTC lost power 

+     |  D6 : 1 = CMOS Checksum wrong 

+     |  D5 : 1 = Primary Display not set/No Diskette attached 

+     |  D4 : 1 = Memory Size miscompare (Vorhanden <> Setup-angegeben) 

+     |  D3 : 1 = Fixed Disk (Drive C) not ok 

+     |  D2 : 1 = RTC Time/Status nicht gültig 

+     | 0F : Shutdown Status Byte (Restart Code) 

+     |  0 = Power on Reset

+     |  9 = Enter Real Mode: 

+     |      TESTPORT = 32, Stack (SS=0469,SP=0467) RET-Adr., PUSHA, ES, DS 

+     | 10 : Diskette configuration: 

+     |    D4..D7 : 0 = Not installed 

+     |             1 = 48 tpi (double sided)        Drive A

+     |             2 = 96 tpi (high capacity)

+     |    D0..D3 : 0 = Not installed 

+     |             1 = 48 tpi (double sided)        Drive B 

+     |             2 = 96 tpi (high capacity)

+     | 12 : Fixed Disk configuration: 

+     |    D4..D7 : 0 = Not installed 

+     |             1..14 Tabelle                    Drive C 

+     |             15 = Typ 16..47 spezifiziert 

+     |    D0..D3 : 0 = Not installed 

+     |             1..14 Tabelle                    Drive D 

+     |             15 = Typ 16..47 spezifiziert 

+     | 

+     | 

+     | 14 : Equipment Byte (only for Power on Diagnostics) 

+     |    D6/D7 :  0 = 1 Floppy 

+     |             1 = 2 Floppys

+     |    D4/D5 :  0 = No Primary Display 

+     |             1 = Color 40 Zeichen 

+     |             2 = Color 80 Zeichen 

+     |             3 = Monochrome 

+     |    D1    :  1 = Mathe Coprozessor installed 

+     |    D0    :  1 = Disk drives are installed

+     | 

+     | 15/16 : Base Memory Size (in KB) 

+     | 15 = low, 16 = high 

+     | 

+     | 17/18 : Expansion Memory Size (in KB) 

+     | 17 = low, 18 = high 

+     | 

+     | 2E/2D Checksum der Adressen 10..20 

+     | 2E = high, 2F = low

+     | 

+     | 30/31 : Expansion Memory Size (in KB über ersten 1MB) 

+     | 30 = low, 31 = high 

+     |

+     | 32 : Date Century Byte (19) 

+     | 

+     | 33 : Information Flag 

+     | 

+ 71  | CMOS-Daten (Read/Write) 

+     | 

+     | Memory Mapper 74LS612

+ 80  | Test-Port (Read/Write) Fehlerstatus der letzten Testoperation 

+ 81  | Channel 2 DMA-Pageregister

+ 82  | Channel 3 DMA-Pageregister

+ 83  | Channel 1 DMA-Pageregister

+ 84  | frei 

+ 85  | frei 

+ 86  | frei 

+ 87  | Channel 0 DMA-Pageregister

+ 88  | frei 

+ 89  | Channel 6 DMA-Pageregister

+ 8A  | Channel 7 DMA-Pageregister

+ 8B  | Channel 5 DMA-Pageregister

+ 8C  | frei 

+ 8D  | frei 

+ 8E  | frei

+ 8F  | Refresh Register

+     | 

+     | Interrupt-Controller 2 (Slave) 8259, siehe Datenblatt 

+ A0  | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) 

+ A1  | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand)

+     | 

+     | DMA Controller 2 (8237A-5) für Wordtransfers (Kanal 5..7) 

+ C0  | Wordadresse (start/current) Kanal 4 (Kaskade für Controller 1)

+ C2  | Wordcount Kanal 4

+ C4  | Wordadresse (start/current) Kanal 5 (frei) 

+ C6  | Wordcount Kanal 5            (Pageregister 8BH)

+ C8  | Wordadresse (start/current) Kanal 6 (frei) 

+ CA  | Wordcount Kanal 6            (Pageregister 89H) 

+ CC  | Wordadresse (start/current) Kanal 7 (frei) 

+ CE  | Wordcount Kanal 7            (Pageregister 8AH) 

+ D0  | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) 

+     | Write: DMA-Command: 

+     |  D0 1 = memory<-->memory transfer enabled 

+     |  D1 Falls D0 = 1: 1 = Kanal 4 Adresse INCR/DECR, 0 = Adr. unverändert

+     |  D2 1 = DMA-Control enabled

+     |  D3 1 = R/W-Signal verkürzt 

+     |  D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren 

+     |  D5 Falls D3 = 0, 1 = verzögertes R/W-Signal, 0 = verlängertes R/W 

+     |  D6 1 = DREQ active-low, 0 = DREQ active-high 

+     |  D7 1 = DACK active-high, 1 = DACK active-low 

+  D2 | Read/Write: Anforderungsregister 

+     |  D1, D0 = Nummer des aktiven DMA-Kanals 

+     |  D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) 

+     |     0 = DMA-Transfer wurde per Hardware angestossen 

+  D4 | Read/Write : Single Mask Register Bit 

+     | D0..D3 für jeden Kanal: 1 =  DREQ gesperrt, 0 = DREQ freigegeben 

+  D6 | Write: Mode-Register

+     | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (4..7) 

+     | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) 

+     |  0   0 Prüfzyklen 

+     |  0   1 Write in Memory 

+     |  1   0 Read aus Memory 

+     |  1   1 Illegal 

+     | D4 1 = Autorepeat 

+     | D5 1 = DECR Adressen, 0 = INCR Adressen 

+     | D7, D6 

+     |  0   0 Polling

+     |  0   1 Cycle Steal 

+     |  1   0 Burst Mode 

+     |  1   1 Kaskadierter Controller

+  D8 | Clear Byte Pointer Flip-Flop 

+  DA | Read: Temporary-Register, Write: Master Clear 

+  DC | Clear Mask Register 

+  DE | Write: All Mask Register 

+     | 

+     | Coprozessor 

+  F0 | Clear Coprozessor Busy 

+  F1 | Reset Coprozessor (mit D0..D7 = 0) und in Real Mode bringen) 

+     | 

+  F8 | Coprozessor Ports (vom 80286 vorgegeben) 

+  ...| 

+  FF |

+     | 

+-----+---------------------------------------------------------------------

+     |

+     | Harddisk WD1010 

+01F0 | Read/Write: Daten (am besten per DMA uebertragen)

+01F1 | Write: Taskfile Byte 1 (Write Precomp DIV 4, 6 Bit)

+     | Read : Error Register

+     | D0..D7 <> 1 : Fehler aufgetreten

+01F2 | Write: Taskfile Byte 2 (Sector Count 8 Bit)

+01F3 | Write: Taskfile Byte 3 (Sector Number 6 Bit)

+01F4 | Write: Taskfile Byte 4 (Cylinder low 8 Bit)

+01F5 | Write: Taskfile Byte 5 (Cylinder high 2 Bit D6,D7) 

+01F6 | Write: Taskfile Byte 6 

+     | D0..D3 = Head 

+     | D4 : 0 = Drive C, 1 = Drive D 

+     | D5 : 1 = 512 Bytes/Sektor, 0 = 256 Bytes/Sektor 

+     | D6 : 

+     | D7 : 1 = ECC versuchen

+01F7 | Write: Taskfile Byte 7 (Commandbyte, Retries)

+     | D0 : 1 = No Retries 

+     | D1 : 1 = 4 ECC Bytes uebrtragen

+     | D2 : 

+     | D3 :

+     | CMD: 7654 Funktion

+     |      0000

+     |      0001 Recalibrate

+     |      0010 Read

+     |      0011 Write

+     |      0100 Verify

+     |      0101 Format Taskfile Byte 3: Gap

+     |      0110

+     |      0111 Seek

+     |      1000

+     |      1001 D0 = 1: Set Parameters, D0 = 0 : Diagnostics

+     |      1010

+     |      1011

+     |      1100 

+     |      1101

+     |      1110

+     |      1111

+     | Read : Status Register

+     | D7 : 1 = BUSY 

+     | D6 : 1 = Not ready 

+     | D5 : Write fault 

+     | D4 : Seek not complete 

+     | D3 : 1 = Request Data

+     | D2 : 1 = Data corrected 

+     | D1 : 1 = 

+     | D0 : 1 =

+01F8 | Datenport Read/Write 

+01F9 | Write: Reset 

+     | Read: Statusport 

+01FA | Write: Select 

+01FB | Write: DMA/IRQ Maskenregister 

+     | 

+     | Game Connector

+0200 | 

+0201 | Write: Start Monoflops 

+     | Read: 

+     | D0..D3 : Ausgänge der 4 Monoflops Zeit = (24.2 + 0.011 * R(kOhm))us. 

+     | D4..D7 : Auslösetasten (nicht entprellt) 

+0202 | Nicht verwendet, aber ausdekodiert

+ ... | 

+0207 |

+     | 

+     | Printer 2 (LPT2)

+0278 | Write: Daten (Read latched write data) 

+0279 | Read/Write: 

+     | D3 : -ERROR 

+     | D4 : -SLCT in

+     | D5 : PE 

+     | D6 : -ACK 

+     | D7 : BUSY 

+027A | D0 : -STROBE

+     | D1 : -AUTOFEED 

+     | D2 : INIT 

+     | D3 : -SLCT out

+     | D4 : IRQ Mask 

+027B | N.C. 

+ ... | 

+027F |

+     |

+02F8 | RS232C Adapter (COM2) wie COM1 (03F8..03FF) 

+...  | Generiert IRQ 3

+02FF | 

+     | 

+0300 | Prototype Card 

+ ... | 

+031F | 

+     |

+     | Printer 1 (LPT1, wie 03B8..03BA) 

+0378 | Write: Daten (Read latched write data) 

+0379 | Read/Write: 

+     | D3 : -ERROR 

+     | D4 : -SLCT in

+     | D5 : PE 

+     | D6 : -ACK 

+     | D7 : BUSY 

+037A | D0 : -STROBE

+     | D1 : -AUTOFEED 

+     | D2 : INIT 

+     | D3 : -SLCT out

+     | D4 : IRQ Mask 

+037B | N.C. 

+ ... | 

+037F |

+     |

+     | SDLC, bisync 2 

+     | 0380..0383 = 8255 : Parallel Ports

+0380 | Port A - Read

+     | D0 : 0 = Rufzeichen liegt an (RI)

+     | D1 : 0 = Trägerfrequenzkennung liegt an (DCD)

+     | D2 : TXCLK (Diagnostic)

+     | D3 : 0 = Sendebereitschaft liegt an (CTS)

+     | D4 : RXCLK (Diagnostic)

+     | D5 : 1 = Modemstatusänderung (DSR changed) 

+     | D6 : 1 = Timer 2 Output active

+     | D7 : 1 = Timer 1 Output active

+0381 | Port B - Write 

+     | D0 : 0 = Baudrateselektor ein

+     | D1 : 0 = Auswahlbereitschaft ein 

+     | D2 : 0 = Prüfung einschalten 

+     | D3 : 1 = Reset Modemstatusänderungs Flip-Flop 

+     | D4 : 1 = Reset 8273 

+     | D5 : 1 = Timer 2 durchschalten 

+     | D6 : 1 = Timer 1 durchschalten 

+     | D7 : 1 = IRQ 4 aktivieren 

+0382 | Port C - D0..D3 Write, D4..D6 Read, D7 N.C. 

+     | D0 : 1 = Internen Takt durchschalten 

+     | D1 : 1 = Externen Takt durchschalten 

+     | D2 : 1 = Elektronischer Test 

+     | D3 : 0 = IRQ 3 + 4 durchschalten 

+     | D4 : RX Daten 

+     | D5 : Timer 0 Output 

+     | D6 : 0 = Prüfanzeige aktiv

+0383 | 8255 Modussteuerregister 

+     |

+     | 0384..0387 = 8253: Timer

+0384 | Timer 0 low/high. Ausgang ist Eingang von Timer 2 (Bit 5 in 0382) 

+0385 | Timer 1 low/high. Timeout Counter 

+0386 | Timer 2 low/high. Timeout Counter 

+0387 | 8254 Modusregister 

+     | 

+     | 0388..038C = 8273 SDLC Controller 

+0388 | Read: Statusregister 

+     | Write: Befehlsregister 

+0389 | Read: Ergebnisregister 

+     | Write: Parameterregister

+038A | DMA/Interrupt Register für Empfangen 

+038B | DMA/Interrupt Register für Senden 

+038C | Datenport Read/Write 

+     | 8273 Registerbeschreibung: 

+     | Moderegister (Bit D6..D7 wählt Counter auf den sich D0..D5 beziehen) 

+     | D0 : 0 = Counter 16 Bit Binär 

+     |      1 = Counter  4 Dekad. BCD

+     | D1..D3 : Modus 0..5 (D7 = 1) 

+     | D4..D5 : D54

+     |           00 = Counter stop 

+     |           01 = read/write highbyte 

+     |           10 = read/write lowbyte 

+     |           11 = erst low, dann highbyte read/write 

+     | D6..D7 : Counter auswählen (00=0, 01=1, 10=2, 11=3) 

+     | 

+     | Betriebsarten Register

+     | D0 : 1 = Kennzeichenmodus 

+     | D1 : 1 = Sync für 2. Header

+     | D2 : 1 = Buffer Modus 

+     | D3 : 1 = Vorzeitigen Sendeinterrupt aktivieren 

+     | D4 : 1 = EOP IRQ aktivieren 

+     | D5 : 1 = MDLC Abbruch aktivieren 

+     | 

+     | Serial I/O Moderegister 

+     | D0 = 1 : NRZI Modus 

+     | D1 = 1 : Clock Loopback 

+     | D2 = 1 : Data Loopback 

+     | 

+     | Transmit Moderegister 

+     | D0 = 1 : Datenübertragung unterbrechen 

+     | 

+     | Singlebit Delay Modusregister 

+     | D7 = 1 : Singlebit delay aktivieren 

+     | 

+038D | N.C.

+ ... |

+038F |

+     |

+     |

+03A0 | bisync 1 

+ ... | wie 0380..038F

+03AF |

+     | 

+     | Hercules komp. Mono/Graphik Karte

+     | Mit * gekennzeichnete Bits sind nicht auf allen Karten verfügbar.

+03B4 | Indexport 6845 (Videocontroller) 

+     | Write: Register Nummer 0..17 

+03B5 | Datenport 6845 : Register (Write only, sofern nichts anderes vermerkt)

+     |  0: D0..D7 = Anzahl Zeichen pro Zeile -1 (Horizontalfreq.) 

+     |  1: D0..D7 = Anzahl dargestellte Zeichen pro Zeile 

+     |  2: D0..D7 = Zeichenposition-1 des HSYNC Signals 

+     |  3: D0..D3 = Breite-1 des HSYNC Signals in Zeichen 

+     |  4: D0..D6 = Anzahl Zeichenzeilen (Vertikalfreq. 50/60 Hz) 

+     |  5: D0..D4 = Bilddurchlauf Abgleich in Mikrozeilen 

+     |  6: D0..D6 = Anzahl dargestellte Zeichenzeilen 

+     |  7: D0..D6 = Zeichenzeile, bei der VSYNC Signal beginnt 

+     |  8: D0 = 0 : Kein Zeilensprungverfahren 

+     |        = 1 und D1 = 0 : Zeilensprungverfahren, normale Dichte 

+     |        =1  und D1 = 1 : Zeilensprungverfahren, doppelte Dichte 

+     |  9: D0..D4 = Mikrozeilen/Zeichen-1 

+     | 10: D0..D4 = Startmikrozeile des Cursors 

+     |     D5/D6  = 0 : Cursor normal, blinkend 

+     |              1 : Cursor unsichtbar 

+     |              2 : Cursor blinkt mit 1/16 der Vertikalfrequenz 

+     |              3 : Cursor blinkt mit 1/32 der Vertikalfrequenz 

+     | 11: D0..D4 = Endmikrozeile des Cursors 

+     | 12: D0..D5 = Highbits der Speicherstartadresse 

+     | 13: D0..D7 = Lowbits der Speicherstartadresse 

+     | 14: D0..D5 = Highbits der aktuellen Cursorspeicheradresse (Read/Write)

+     | 15: D0..D7 = Lowbits der aktuellen Cursorspeicheradresse (Read/Write)

+     | 16: D0..D5 = Highbits der Speicherstelle, bei der LPSTB ausgelöst 

+     | 17: D0..D7 = Lowbits der Speicherstelle, bei der LPSTB ausgelöst 

+03B8 | Write: Display Mode Control Port 

+     | D1: 6845 muss nach einer Änderung dieses Bits neu initialisiert werdem

+     |     0 : Text Mode    (Zeichen 9 x 14, 0.5625us/Zeichen)

+     |     1 : Graphik Mode (Zeichen 4 x 16, 1us/Zeichen Horizontal)

+     | D3: 0 : Screen blanked (Bei Init 6845 auf 0 setzen) 

+     |     1 : Screen activated 

+     | D5: 0 : Textblinker (Attributbit 7 = 1) ausgeschaltet 

+     |     1 : Textblinker angeschaltet 

+     |*D6: 0 : 80 Spalten Modus (nur CT6040S)

+     | D7: 0 : Graphikpage 0 (B0000..B7FFF) 

+     |     1 : Graphikpage 1 (B8000..BFFFF) 

+03B9 |*Write: Set Lightpen Flip-Flop (Eingang zum 6845 LPSTB) 

+03BA | Read: Display Status Port 

+     | D0: 1 : HSYNC (Horizontal Retrace) läuft gerade 

+     |*D1: Ausgang des Lightpen Flip-Flop (LPSTB-Eingang 6845) 

+     |*D2: 1 : Lightpen Taster gedrückt (Pin 3 des LP-Steckers) 

+     | D3: Ausgang VIDEO zum Monitor (Dots on/off) 

+     | D7: 1 : VSYNC (Vertical Retrace) läuft gerade 

+03BB |*Write: Reset Lightpen Flip-Flop 

+03BC | Read: Latched Write Data 

+     | Write: Printer Data D0..D7 (pin 2..9)

+03BD | Read: Printer Status Port 

+     | D3:0 : Printer Error (ERROR, pin 15) 

+     | D4:0 : Printer deselected (SLCT, pin 13)

+     | D5:1 : Paper end (PE, pin 12) 

+     | D6:1 : Ready for more (ACK, pin 10) 

+     | D7:0 : Printer is busy (BUSY, pin 11) 

+03BE | Read (Latched Write Data) 

+     | Write: Printer Control Port 

+     | D0: Printer Strobe (0 = Strobe to Printer, 1 = Release Strobe) pin 1

+     | D1: 0 = Autolinefeed after CR, 1 = CR, LF (Programm) pin 14

+     | D2: 0 = Init Printer (pin 16), 1 = Release Init 

+     | D3: 0 = Deselect Printer (SLCT, pin 17), 1 = Select Printer 

+     | D4: 0 = Mask IRQ7 off, 1 = IRQ7 (ACK Flanke) mask on 

+03BF |*Read LPSTB extension Adress (Im Graphikmodus) 

+     |*D0..D3 = xpos Dots MOD 16

+     |*D4: Dotclk 74112 (U58) 

+     |*D5..D6 = ypos Dots MOD 4 

+     |*D7: Aktive Graphikseite 

+     | Write: Configuration Switch 

+     | D0: Bit 1 03B8 AND-Mask (0: Kein Graphikmode einschaltbar) 

+     | D1: Bit 7 03B8 AND-Mask (0: Keine Graphikseite 1 einschaltbar) 

+     |     (falls 0: B8000..BFFFF auf Graphikkarte abgeschaltet)

+     | 

+     | 

+     | CGA (Color Graphics Adapter) 

+03D4 | 6845 Index Register (siehe 03B4)

+03D5 | 6845 Data Register (siehe 03B5)

+03D8 | 

+     | D0 : 1 = 80x25 

+     |      0 = 40x25 

+     | D1 : 1 = 320x200 Graphikmodus 

+     |      0 = Alphanumerisch Text 

+     | D2 : 1 = S/W 

+     |      0 = Color 

+     | D3 : 0 = Screen blanked

+     | D4 : 1 = 640x200 S/W Modus 

+     | D5 : 1 = Blinken statt Intensitätsbit (Bit 3) 

+     |      0 = Intensitätsbit für 16 statt 8 Farben (2 Helligkeiten)

+03D9 | Write: Paletteregister 

+     | D0 : Blau 

+     | D1 : Grün 

+     | D2 : Rot 

+     | D3 : Intensity 

+     | D4 : 1 = Intensivfarbsatz im Graphikmodus 

+     | D5 : 1 = Farbsatz 320x200 Modus aktivieren

+03DA | Read: Statusregister 

+     | D0 = HSYNC (Anzeige aktiviert) 

+     | D1 = Lightpen Strobe Flip-Flop Ausgang 

+     | D2 = Lightpentaster gedrückt 

+     | D3 = VSYNC 

+03DB | Write: Reset Lightpen Flip-Flop 

+03DC | Write: Set Lightpen Flip-Flop

+     | 

+     | 

+     | Diskettencontroller uPD 765 

+03F2 | DIGOR (Digital Output Register) - Write

+     | D0..D1 : Laufwerk 00 = A, 01 = B, 10 = C, 11 = D 

+     | D2 : 0 = RESET Signal aktiviert, 1 = RESET aus

+     | D3 : 1 = DMA und IRQ aktivieren 

+     | D4..D7 : 1 = Motor für Laufwerk A..D einschalten 

+03F4 | Hauptstatusregister - Read

+     | D0..D3 : Laufwerk A..D seeked noch 

+     | D4 : 1 = BUSY 

+     | D5 : 1 = DMA nicht aktiv 

+     | D6 : 1 = Prozessor liest Datenregister, 0 = Prozessor schreibt Datenr. 

+     | D7 : 1 = Register bereit für Datentransfer

+03F5 | Diskettensteuerungsdatenregister - Write 

+     | D0..D7 : Command 

+     |     C5 = write (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, 

+     |                 gap.b, dtl.b)

+     |     E6 = read (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, 

+     |                gap.b, dtl.b)

+     |     4D = format (byte_p_sec.b, last_sec.b, gap.b, dtl.b)

+     |          hd+drv.b : D5..D2 = Head, D1..D0 = Drive

+     |     Nach jedem Kommando kann solange BUSY=1 ist, ein Statusbyte bei 

+     |     03F5 abgeholt werden (warten bis D6=1 und D7=1 in 03F4). 

+     |     Status: 

+     |     D7 = rnf, timeout

+     |     D6

+     |     D5 = crc error

+     |     D4 = dma error

+     |     D3

+     |     D2 = rnf 

+     |     D1 = write protected 

+     |     D0 = bad addr mark

+     |

+03F6 | Harddisk Control Register

+     | D7 : 1 = Disable Retries 

+     | D6 : 1 = Kein ECC bei Fehler 

+     | D5 :

+     | D4 :

+     | D3 : 1 = Falls anz. Heads > 8 

+     | D2 : 1 = RESET KONGO CARD (wieder auf 0 setzen) 

+     | D1 : 

+     | D0 :

+     | 

+03F7 | DIGIR (Digital Input Register) - Read 

+     | D7 : 1 = Media changed

+     | 

+     | 

+     | RS232C Adapter 8250 (COM1) Generiert IRQ 4

+03F8 | DLAB = 0

+     |       Read: Receivebuffer (RBR = receive buffer register)

+     |      Write: Transmitbuffer (THR = transmit holding register)

+     | DLAB = 1 : Read/Write: Divisor Latch LSB   Read/Write

+03F9 | DLAB = 1 : Read/Write: Divisor Latch MSB   Read/Write

+     |            Baud = 115200/divisor (clk = 1.8432 MHz DIV 16) 

+     | DLAB = 0 : Interrupt Enable Register (IER) Read/Write 

+     |     Bit = 1: Interrupt enabled, Bit=0: Interrupt disabled  

+     | D0: Receive Char Interrupt 

+     | D1: Transmitter empty Interrupt 

+     | D2: Receiver Line Status Interrupt (Framing, Parity, Overrun, Break)

+     | D3: Modem Status Interrupt (CTS, DSR, RI, DCD changed)

+     | D4..D7 = 0

+03FA | Interrupt Identification Register (IIR) Read/Write

+     | Prios: 1=Receiver Line Status, RX available, THR empty, 4=Modem Status 

+     | D0 = 0: Interrupt pending 

+     | D1..D2: Interrupt source (falls D0 = 0) 

+     |   Prio D21 Source                            Cleared by

+     |      1  01 Overrun, Parity, Framing, Break   Read LSR 

+     |      2  10 Receive data available            Read RBR 

+     |      3  11 THR empty                         Read IIR oder Write THR 

+     |      4  00 CTS, DSR, RI, RLSD changed        Read MSR 

+03FB | Line Control Register (LCR) Read/Write

+     | D0..D1 : Wordlength (00=5, 01=6, 10=7, 11=8 Datenbits) 

+     | D2 : 0 = 1 Stopbit 

+     |      1 = 1.5 Stopbits, falls 5 Datenbits, 2 Stopbits sonst 

+     | D3 : 1 = Parity generate & check enabled 

+     | D4 : Falls D3 = 1 : 0 = Odd Parity, 1 = Even Parity 

+     | D5 : Falls D3 = 1 und D5 = 1: 0 = Parity Mark, 1 = Parity Space

+     |     D543 Funktion

+     |      000 Kein Parity

+     |      001 Odd Parity

+     |      010 Kein Parity 

+     |      011 Even Parity

+     |      100 Kein Parity

+     |      101 Parity stuck on (1 = Mark) 

+     |      110 Kein Parity

+     |      111 Parity stuck off (0 = Space) 

+     | D6 : 1 = Send Break (Muss wieder auf 0 gesetzt werden)

+     | D7 : DLAB = 1 : Baudrate Divisor Latch Access ueber 0XF8/0XF9 

+03FC | Modem Control Register (MCR) 

+     | D0: 1 = DTR aktiv

+     | D1: 1 = RTS aktiv 

+     | D2: 1 = OUT1 aktiv (Pin 34) 

+     | D3: 1 = OUT2 aktiv (Pin 31)

+     | D4: 1 = Diagnostic Mode: 

+     |         TX-Out --> RX-In (Local Loopback) 

+     |         RTS->CTS, DTR->DSR, OUT1->DCD, OUT2->RI internally connected 

+     |         Interupts lassen sich mit D0..D3 des MCR, bzw. D0..D5 des LSR 

+     |         auslösen (dann Bits wieder auf 0 und MCR auf 0). 

+03FD | Line Status Register (LSR) Read/Write 

+     | D0: 1 = Character Received                 Interrupt 2

+     | D1: 1 = Receiver Overrun Error             Interrupt 1

+     | D2: 1 = Parity Error                       Interrupt 1

+     | D3: 1 = Framing Error                      Interrupt 1

+     | D4: 1 = Break detected                     Interrupt 1

+     | D5: 1 = Transmitter Holding register empty Interrupt 3

+     | D6: 1 = Transmitter complete cleared (THR & TSR empty) 

+     | D7: 0 

+03FE | Modem Status Register (MSR) Read/Write 

+     | D0: 1 = CTS changed since last MSR read    Interrupt 4

+     | D1: 1 = DSR changed since last MSR read    Interrupt 4

+     | D2: 1 = RI changed from active to inactive Interrupt 4

+     | D3: 1 = DCD changed since last MSR read    Interrupt 4

+     | D4: CTS input (Diagnostic: RTS) 

+     | D5: DSR input (Diagnostic: DTR) 

+     | D6: RI  input (Diagnostic: OUT1) 

+     | D7: DCD input (Diagnostic: OUT2)

+03FF | Reserviert 

+     | 

diff --git a/system/shard-x86-at/7/src/ATSHARD.ASM b/system/shard-x86-at/7/src/ATSHARD.ASM
new file mode 100644
index 0000000..fcc5c50
--- /dev/null
+++ b/system/shard-x86-at/7/src/ATSHARD.ASM
@@ -0,0 +1,157 @@
+  page 80,132

+title AT-SHard, Copyright (C) 1985, 86 Martin Schoenbeck, Spenge  

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 80286 Systemen                                        *

+;*                                                                            *

+;*       SHard Version 7-PC/AT                                                *

+;*                                                                            *

+;*       Copyright (C) 1985, 86 Martin Schoenbeck, Spenge                     *

+;*                                                                            *

+;******************************************************************************

+

+at equ 1

+gensys equ 0

+ramsys equ 0

+pcxt equ 0

+pcd equ 0

+kompatible equ 0

+romharddisk equ 0

+romfloppy equ 0

+limited_to_360 equ 0

+boot_size equ 0

+

+hdsystem equ 1

+withhd equ 1

+

+setup_channel equ 28

+dos_channel equ 29

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+

+shstart:

+     jmp los_gehts

+

+     even

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     org 0a0h			;bei wort 80 beginnen

+     include PATCHARE.ASM

+

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+com2irq  equ 3

+com3base equ 03e8h

+com3irq  equ 3

+com4base equ 82f8h

+com4irq  equ 7

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+para1base equ 3bch

+para1irq equ 7

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+     channel 0,fixdisk,hgccb0

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     channel 12,parallel,para1ccb

+     channel 28,fixdisk,hgccb1

+     channel 29,fixdisk,hgccb2

+     channel 31,archive,archive_0

+     channel 30,archive,archive_1

+     channel -1,nilchannel,0

+ 

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+     include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     para_ccb para1,12

+ ;erlaubt drivetypen: highdensity, drive720

+     archive_ccb 0,highdensity

+     archive_ccb 1,0

+     fix_ccb 0

+     fix_ccb 1

+     fix_ccb 2

+

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/BLOCKERR.ASM b/system/shard-x86-at/7/src/BLOCKERR.ASM
new file mode 100644
index 0000000..fb5b137
--- /dev/null
+++ b/system/shard-x86-at/7/src/BLOCKERR.ASM
@@ -0,0 +1,81 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Dieses Modul enthaelt Routinen zur Uebergabe von Fehlermeldungen       *

+;*   nach Blockin/Blockout                                                  *

+;*                                                                          *

+;*   blockerr erwartet dabei folgende codes in ah:                          *

+sense_fail      equ     0ffh            ; sense operation

+blnrhigh        equ     0feh            ; block number to high

+write_fault     equ     0cch            ; 

+not_rdy         equ     0aah            ; drive not ready

+undef_err       equ     0bbf            ; undefined error occurred

+time_out        equ     80h             ; attachment failed to respond

+bad_seek        equ     40h             ; seek operation failed

+bad_cntlr       equ     20h             ; controller has failed

+data_corrected  equ     11h             ; ecc corrected data error

+bad_ecc         equ     10h             ; bad ecc on disk read

+bad_crc         equ     10h             ; crc error on sector

+bad_track       equ     0bh             ; bad track flag detected

+bad_sect        equ     0ah             ; sector marked bad

+dma_boundary    equ     9               ; attempt to dma across 64k

+bad_dma         equ     8               ; dma failed

+init_fail       equ     7               ; drive parameter activity failed

+bad_reset       equ     5               ; reset failed

+record_not_fnd  equ     4               ; requested sector not found

+write_protect   equ     3               ; disk write protected

+bad_addr_mark   equ     2               ; address mark not found

+bad_cmd         equ     1               ; bad command passed to disk i/o

+;*                                                                          *

+;****************************************************************************

+

+blockerr:

+     pop bp                      ;return adresse holen

+     pop dx                      ;ds:bx vom stack putzen

+     pop dx

+     mov bx,offset messagetable  ;tabelle mit meldungen holen

+     mov dh,0                    ;laengenangaben sind nur ein byte

+err_loop:

+     mov al,byte ptr [bx]        ;fehlerschluessel holen

+     inc bx

+     cmp al,ah                   ;war das der gesuchte

+     jz err_found                ;ja

+     inc al                      ;oder ende der tabelle

+     jz err_found                ;ja

+     inc bx                      ;auf laengenbyte

+     mov dl,byte ptr [bx]        ;laenge holen

+     add bx,dx                   ;adresse des naechsten textes

+     inc bx                      ;und ueber laengenbyte rueber

+     jmp err_loop

+

+err_found:

+     mov cl,byte ptr [bx]

+     mov ch,0                    ;nur ein byte fehlercodes

+     inc bx                      ;auf textlaenge gehen

+     push cs                     ;adresse fehlermeldung drauf

+     push bx

+     jmp bp

+

+highblock:

+     mov ah,blnrhigh             ;meldung blocknummer zu hoch

+     jmp blockerr

+

+err_mess macro code,eucode,mess

+local m_end

+     db code,eucode,m_end-$-1,mess

+m_end:

+     endm

+

+messagetable:

+     err_mess blnrhigh,3,'blocknummer zu hoch'

+     err_mess not_rdy,1,'not ready'

+     err_mess bad_crc,2,'crc err'

+     err_mess bad_sect,2,'bad sect'

+     err_mess record_not_fnd,2,'rec not fnd'

+     err_mess dma_boundary,1,'dma boundary'

+     err_mess time_out,2,'timeout'

+     err_mess 0ffh,2,'undef_err_code'

+

+

+

+

diff --git a/system/shard-x86-at/7/src/BOOT.ASM b/system/shard-x86-at/7/src/BOOT.ASM
new file mode 100644
index 0000000..c26f1df
--- /dev/null
+++ b/system/shard-x86-at/7/src/BOOT.ASM
@@ -0,0 +1,425 @@
+;*****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===================*

+;*                                                                           *

+;*        Laden des EUMEL - Restsystems vom Archiv oder HG                   *

+;*                                                                           *

+;*****************************************************************************

+

+; Versionsschluessel:

+;2.2 enthaelt mehrere Partition, Floppy size = 0 bei start und fehler

+;2.3 enhaelt Floppy mit Block 0 lesen immer erlaubt

+;2.4 Drucker geht ueber rom, wenn adresse nicht ibmlike

+;    mehrere Drucker moeglich

+;    busy Abfrage kann verzoegert werden (Problem LQ1000)

+;    es werden nur die vorhandenen Schnittstellen angezeigt

+;    Lesezugriffe bis Block 6 auf Floppy werden immer erlaubt

+;2.5 Hercules Karte wird unterstuetzt

+;    Bei AT werden schlechte sectoren statt spuren behandelt

+;2.6 Fehler in Plattengröße bei behoben (meldete immer al <> 0)

+;2.7 Floppylogik fuer 1.7.3 restauriert, Floppy steht jetzt immer

+;    auf 360k, wenn keine Floppy erkannt wird, und der Urlader die

+;    HG-Version 1742 hat.

+;    die Schnittstellen der Addonics-Karte sind jetzt immer mit drin,

+;    wenn COM4 generiert sind.

+;    Die Druckerkanäle liegen auf 15,14,16

+;    Die Baudrateabfrage verneint auch 0

+

+los_gehts:

+     cli

+; achtung: es und si muessen bis zum einstellen der Festplatte

+; unveraendert bleiben !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

+     mov ax,cs

+     mov ds,ax

+; cs in vorlaeufige EUMEL Tabelle eintragen

+     mov bx,offset systemstart+2

+     mov cx,eumel_cs_init_length

+self_cs_init_loop:

+     mov word ptr [bx],ax

+     add bx,4

+     loop self_cs_init_loop

+; cs in SHard - Tabelle eintragen

+     mov bx,offset first_shard_cs_to_alter

+     mov cx,shard_cs_alter_length

+shard_cs_init_loop:

+     mov word ptr [bx],cs     ;put in my code segment

+     add bx,4

+     loop shard_cs_init_loop 

+; berechnen, wohin der EUMEL spaeter soll

+     mov bx,offset lastbootbyte  ;relativen paragraph ausrechnen

+     mov cl,4

+     shr bx,cl

+     inc bx

+     add ax,bx                ;hier soll spaeter der EUMEL hin

+     mov ss,ax

+     mov sp,0

+     push si                  ;werte fuer plattensetup merken

+     push es

+; warte routine fuer Platten und Floppytreiber eintragen

+     call device_init           ;int 15 eintragen

+; alle Kanaele initialisieren

+     mov dh,33

+     mov al,0

+inilop:

+     mov cx,-2

+     push ax

+     call control32

+     pop ax

+     cli

+     inc al

+     dec dh

+     jnz inilop

+     sti                      ;interrupts sind erlaubt

+     mov bx,offset signon     ;sag ihm, wer wir sind

+     call print

+; alle kanaele fuer festplatte einstellen (falls vorhanden)

+     pop es

+     pop si                   ;zeiger auf partitiontabelle wiederholen

+     call setup_fix_disk

+; EUMEL 0 laden

+getagain:

+   ife gensys

+     mov al,31      ;zuerst von kanal 31 versuchen

+     mov bx,offset archtext

+     call geteumel

+   endif

+     mov al,0

+     mov bx,offset hgtext

+     call geteumel

+     mov bx,offset noeutext

+     call print

+     call waitchar

+     jmp getagain

+

+geteumel:	;EUMEL 0 laden und bei Erfolg starten

+     push ax

+     mov cx,5       ;size

+     call cs:iocontrol

+     pop ax

+     push bx        ;text fuer medium merken

+     mov cx,ss      ;ausrechnen, wohin der urlader muss (ss:0)

+     add cx,31                ;damit wir nicht rueckwaerts gehen

+     and cx,0ffe0h  ;auf 512 byte boundary

+     mov ds,cx      ;segment nach ds

+     mov bx,0       ;bei 0 im segment laden wir zuerst

+     mov cx,0       ;auftrag

+     mov dx,10      ;erster urlader block ist 10

+     mov ah,1       ;nur ein versuch 

+     cmp al,0

+     ifz <mov ah,3> ;hintergrund muss lesbar sein

+     push bx 

+     push ds

+     call getblock

+     pop ds

+     pop bx

+     or cx,cx       ;fehlerfrei?

+     jz firstok

+     pop bx         ;text fuer medium vergessen

+     ret

+firstok:

+     push ax

+     mov cx,5       ;text EUMEL hat 5 buchstaben

+     mov si,offset eutext     ;text EUMEL

+     mov di,bx                ;puffer

+textloop: 

+     lods byte ptr cs:[si]

+     cmp al,byte ptr ds:[di]

+     jz charok

+     pop ax         ;stack saeubern

+     pop bx

+     ret            ;nicht gleich, kein eumel urlader

+charok:

+     inc di

+     loop textloop

+     pop ax         ;kanal fuer urlader wiederholen

+     pop bx         ;text fuer medium holen

+     call print     ;ausgeben

+     mov bx,0       ;bx ist zerstoert, aber wir wissen, wohin

+     mov ah,8       ;ab hier mit acht versuchen

+euloop:

+     mov cx,0

+     inc dx

+     add bx,512     ;auf naechsten block schalten

+     push bx

+     push ds

+     call getblock

+     or cx,cx

+     jnz booterr

+     pop ds

+     pop bx

+     cmp dx,10+100  ;schon kompletten urlader gelesen

+     jnz euloop

+; Sprungleiste vom EUMEL abholen

+     push cs

+     pop es                   ;ziel ist codesegment

+     mov si,0

+     mov di,offset eumel0id

+     mov cx,eumel_leisten_laenge 

+     cli

+     cld

+     rep movsb

+     mov ax,ds                ;eumel codesegment nach ax

+     push cs                  ;datensegment wieder auf shard

+     pop ds

+; und passendes cs eintragen

+     mov bx,offset systemstart+2

+     mov cx,eumel_cs_init_length

+eumel_cs_init_loop:

+     mov word ptr [bx],ax

+     add bx,4

+     loop eumel_cs_init_loop 

+     call paragraphs

+     sub dx,ax                ;rest fuer eumel ausrechnen

+    if ramsys

+     urram equ 1000h

+

+     sub dx,urram             ;64k fuer urlader und paging

+     mov M3SIZE,dx

+     mov M0SIZE,urram

+     mov M0START,ax

+     add ax,urram

+     mov M3START,ax

+    else

+     mov M0SIZE,dx

+     mov M0START,ax           ;eumel codesegment eintragen

+    endif

+     mov ax,31           ;allen floppies die chance geben

+i173lop:                 ;sich auf 173 einzustellen

+     mov cx,-173

+     push ax

+     call control32

+     pop ax

+     dec al

+     jnz i173lop

+     mov bx,offset SHard_leiste

+     jmp systemstart

+ 

+

+booterr:

+     push ds

+     push bx

+     mov bx,offset booterrtext

+     call print

+     pop bx

+     pop ds

+     call dsprint

+     jmp $

+ 

+getblock:

+     push ax        ;original ax merken

+getloop:

+     push bx

+     push ds 

+     push ax        ;ax mit retry zaehler

+     mov cx,0

+     call cs:blockin

+     pop ax

+     or cx,cx

+     jnz geterr

+     pop ds

+     pop bx

+     pop ax

+     ret

+geterr:

+     dec ah         ;genuegend retries

+     jnz getcontinue

+     pop ax         ;kill ds

+     pop ax         ;kill bx

+     pop ax         ;altes ax holen

+     ret

+getcontinue:

+     pop ds

+     pop bx

+     jmp getloop

+

+waitchar:

+     sti

+     mov byte ptr cs:waschar,0

+waitcloop:

+     cmp byte ptr cs:waschar,0

+     jz waitcloop

+     ret

+

+iint proc far

+     cmp al,1                 ;nur kanal 1 ist interessant

+     ifnz <ret>

+     mov byte ptr cs:waschar,1

+     ret

+iint endp

+

+waschar db 0

+

+print:

+     push ds

+     push cs

+     pop ds

+     call dsprint

+     pop ds

+     ret

+

+dsprint:

+     push cx

+     push ax

+     mov cl,byte ptr [bx]     ;laenge holen

+     inc bx                   ;auf text schalten

+     mov ch,0

+     mov al,1                 ;auf terminal 1

+     call cs:output

+     pop ax

+     pop cx

+     ret

+

+setup_fix_disk:

+  if hdsystem

+     mov di,si                ;si retten

+     mov dl,4

+eumel_partition_search_loop:

+     test byte ptr es:[si],80h  ;aktivierte Partition

+     jnz eu_found

+     add si,10h

+     dec dl

+     jnz eumel_partition_search_loop

+; keine EUMEL Partition, Sauerei

+no_eu_part:

+     mov bx,offset no_eumel_partition_text

+     call print

+     sti

+     jmp $

+

+eu_found:

+     cmp byte ptr es:[si+4],'E' ;EUMEL partition

+     jc no_eu_part

+     mov dx,es:[si+8]    ;low word partition start holen

+     mov bx,es:[si+10]   ;high word partition start holen

+     add dx,68           ;50k fuer shard etc. frei lassen

+     adc bl,0

+     mov cx,-101         ;partition start einstellen

+     mov al,0            ;fuer HG

+     call control32

+     mov cx,-100         ;dasselbe als groesse fuer Setup Kanal

+     mov al,setup_channel

+     call control32

+     mov dx,es:[si+12]   ;low word partition size holen

+     mov bx,es:[si+14]   ;high word partition size holen

+     

+    if at

+     sub dx,68           ;platz fuer SHard

+     sbb bl,0

+     sub dx,[bb_anz]     ;platz fuer schlechte sectoren lassen

+     sbb bl,0

+    else

+     sub dx,68+(2*68)    ;das, was wir fuers SHard lassen, abziehen

+                         ;und das, was fuer schlechte spuren bleiben muss

+     sbb bl,0

+    endif

+

+     mov cx,-100         ;size einstellen

+     mov al,0            ;fuer hg

+     call control32

+; DOS partition suchen

+     mov si,di           ;si wieder holen

+     mov dl,4

+dos_partition_search_loop:

+     cmp byte ptr es:[si+4],1 ;DOS partition

+     jz dos_found

+     add si,10h

+     dec dl

+     jnz dos_partition_search_loop

+     xor dx,dx

+     mov bx,dx           ;DOS Partition existiert nicht

+     jmp short dos_size

+dos_found:

+     mov dx,es:[si+8]    ;low word partition start holen

+     mov bx,es:[si+10]   ;high word partition start holen

+     mov cx,-101         ;partition start einstellen

+     mov al,dos_channel  ;fuer DOS

+     call control32

+     mov dx,es:[si+12]   ;low word partition size holen

+     mov bx,es:[si+14]   ;high word partition size holen

+dos_size:

+     mov cx,-100         ;size einstellen

+     mov al,dos_channel  ;fuer DOS

+     call control32

+  endif

+     ret

+

+ if 0

+     mov ax,0

+     mov cx,5

+     call cs:iocontrol           ;get size of harddisk

+  if mit_msdos

+     mov bx,17068

+  else

+     mov bx,100               ;50k freilassen

+  endif

+     sub cx,bx                ;von size abziehen

+     cmp cx,0fd00h shr 1      ;bei mehr legt sich eumel auf den bauch

+     ifnc <mov cx,0fcfeh shr 1> ;dann nur soviel, wie er kann

+     mov dx,cx                ;in dx melden

+     mov cx,-100              ;set size

+     call control32

+     ret

+ endif

+

+eutext:

+     db 'EUMEL'

+

+signon:

+     db booterrtext-$-1

+  if pcd

+     db 1bh,5bh,'H',1bh,5bh,'2J'

+     db 13,10,10 

+     db 'Demo - SHard f',129,'r EUMEL auf Siemens PC-D, V 2.1'

+     db 13,10

+     db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+     db 13,10

+   else

+     if gensys

+        db 13,10,10

+        db 'Setup - SHard f',129,'r EUMEL'

+        db ' auf IBM PC,AT,XT und Kompatiblen V 2.7'

+        db 13,10

+        db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+        db 13,10

+     else

+       if at

+          db 13,10,10

+          db 'SHard f',129,'r EUMEL auf IBM PC/AT, V 2.7'

+          db 13,10

+          db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+          db 13,10

+       else

+          db 13,10,10

+          db 'ModSoft - SHard f',129,'r EUMEL'

+          db ' auf IBM-PC und Kompatiblen, Version 2.7'

+          db 13,10

+          db 'Copyright (C) 1985,86 ModSoft, Martin Sch',148,'nbeck'

+          db 13,10

+       endif

+     endif

+  endif

+

+booterrtext:

+     db archtext-$-1

+     db 'Fehler beim Laden des Systems: '

+     db 7

+archtext:

+     db hgtext-$-1

+     db 'EUMEL wird vom Archiv geladen'

+     db 13,10

+hgtext:

+     db noeutext-$-1

+     db 'EUMEL wird vom Hintergrund geladen'

+     db 13,10

+noeutext:

+     db no_eumel_partition_text-$-1

+     db 'Kein EUMEL - System gefunden'

+     db 13,10

+     db 'Bitte einlegen und Taste dr',129,'cken! '

+no_eumel_partition_text:

+     db endtext-$-1

+     db 'Keine EUMEL Partition auf der Platte'

+     db 13,10

+     db 'Bitte benutzen Sie Ihre Setup-Floppy zum Anlegen'

+endtext:

+

+lastbootbyte:

diff --git a/system/shard-x86-at/7/src/CLOCK.ASM b/system/shard-x86-at/7/src/CLOCK.ASM
new file mode 100644
index 0000000..1f0e395
--- /dev/null
+++ b/system/shard-x86-at/7/src/CLOCK.ASM
@@ -0,0 +1,55 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Lesen der Echtzeituhr des IBM PC-AT                                    *

+;*   Schreiben dummy routine	                                            *

+;*        Aufruf: blockin/blockout mit code -4 ueber kanal 32               *

+;*        Puffer: ROW 7 INT VAR                                             *

+;*                                                                          *

+;****************************************************************************

+

+clockread:

+     call hardware

+     cmp al,IBMat                ;haben wir den IBM PC-AT

+     jnz no_clock

+     mov ah,4                    ;read date

+     int 1ah

+     jc no_clock

+     mov al,ch                   ;jahrhundert

+     call putbcd                 ;ueber bx wegschreiben

+     mov al,cl                   ;jahr

+     call putbcd

+     mov al,dh                   ;monat

+     call putbcd

+     mov al,dl                   ;tag

+     call putbcd

+     mov ah,2                    ;read time

+     int 1ah

+     jc no_clock

+     mov al,ch                   ;stunden

+     call putbcd

+     mov al,cl                   ;minuten

+     call putbcd

+     mov al,dh                   ;sekunden

+     call putbcd

+     mov cx,0                    ;keine fehler

+     ret

+

+no_clock:

+     mov cx,-1                   ;geht nicht

+     ret

+

+clockwrite:

+     mov cx,-1

+     ret

+

+putbcd:

+     mov ah,al

+     and ah,0fh                  ;in al niedrige nibble behalten

+     ib shr al,4                 ;rueberschieben

+     or ax,3030h                 ;ziffern draus machen

+     mov word ptr es:[bx],ax     ;eintragen

+     inc bx

+     inc bx                      ;zum naechsten

+     ret

+

diff --git a/system/shard-x86-at/7/src/DEVICE.ASM b/system/shard-x86-at/7/src/DEVICE.ASM
new file mode 100644
index 0000000..68eb129
--- /dev/null
+++ b/system/shard-x86-at/7/src/DEVICE.ASM
@@ -0,0 +1,91 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Macros zur Definition von devicetypecontrolblocks und                 *

+;*   bestimmten channelcontrolblock Eintraegen                             *

+;*                                                                         *

+;***************************************************************************

+ .xlist

+

+actualdevice = 0

+

+device macro type

+     if1

+     ifdef type

+     .printx * device type doppelt definiert *

+     endif

+     endif

+actualdevice = actualdevice+1

+type = actualdevice

+ 

+     endm

+

+routine macro code,execut

+     db code

+     dw offset execut

+     endm

+

+dtcbroutines macro type

+     ifidn <type>,<blockin>

+      buildlabel blockin_,%actualdevice

+     else

+     ifidn <type>,<blockout>

+      buildlabel blockout_,%actualdevice

+     else

+     ifidn <type>,<iocontrol>

+      buildlabel iocontrol_,%actualdevice

+     else

+     ifidn <type>,<control32>

+      buildlabel control32_,%actualdevice

+     else

+      .printx * unbekannter routinentyp: '&type' in dctbroutine *

+     endif

+     endif

+     endif

+     endif

+     endm

+

+dtcbparams macro output,typ

+     buildlabel paramstart_,%actualdevice

+     dw offset output

+     dbbp blockin_,%actualdevice

+     dbbp blockout_,%actualdevice

+     dbbp iocontrol_,%actualdevice

+     dbbp control32_,%actualdevice

+dtcbentry devtype

+     db typ

+     endm

+

+dtcbentry macro entry

+     xequat entry,%actualdevice

+     endm

+

+dwb macro first,second

+     dw offset first&second

+     endm

+

+dbbp macro first,second

+     db first&second-paramstart_&second

+     endm

+

+xequat macro entry,dev

+entry = $-paramstart_&dev

+     endm

+

+buildlabel macro first,second

+first&second:

+     endm

+

+startccb macro name,kanal

+name:

+actccb = $

+ccbentry channel_no

+     db kanal

+     endm

+

+ccbentry macro entry

+entry = $-actccb

+     endm

+

+ .list

+

diff --git a/system/shard-x86-at/7/src/EUCONECT.ASM b/system/shard-x86-at/7/src/EUCONECT.ASM
new file mode 100644
index 0000000..7bc0aa2
--- /dev/null
+++ b/system/shard-x86-at/7/src/EUCONECT.ASM
@@ -0,0 +1,79 @@
+;======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =============

+;---------------------------------------------------------------------

+   even

+

+eumel0id                       db 'EUMEL           '

+eumel0blocks                   dw 100

+hgver                          dw 1742

+cputype                        dw 3            ; 8086

+urver                          dw 100

+                               dw 0

+shdvermin                      dw 7

+shdvermax                      dw 7

+                               dw 0

+systemstart                    dd dummy_ret

+inputinterrupt                 dd iint

+timerinterrupt                 dd dummy_ret

+warte                          dd dummy_ret

+grab                           dd dummy_ret

+free                           dd dummy_ret

+shutup                         dd dummy_ret

+info                           dd dummy_ret

+eumel_cs_init_length equ ($-systemstart)/4

+eumel_leisten_laenge equ $-eumel0id

+

+;---------------------------------------------------------------------

+;

+;                  SHard-Leiste

+;

+;---------------------------------------------------------------------

+

+SHard_leiste:

+SHDID                          db 'SHard Schoenbeck'

+SHDVER                         dw 7

+ if withhd or at

+MODE                           dw 0

+ else

+MODE                           dw 1 ;freieumel0

+ endif

+ID4                            dw 4711

+ID5                            dw 4712

+ID6                            dw 0

+ID7                            dw 0

+                               dw 0

+                               dw 0

+output label dword

+                               dw offset i_output

+first_shard_cs_to_alter:

+                               dw 0

+blockin label dword

+                               dw offset i_blockin

+                               dw 0

+blockout label dword

+                               dw offset i_blockout

+                               dw 0

+iocontrol label dword

+                               dw offset i_iocontrol

+                               dw 0

+sysend label dword

+                               dw offset i_sysend

+                               dw 0

+                               dd 0

+                               dd 0

+                               dd 0

+shard_cs_alter_length equ ($-first_shard_cs_to_alter)/4

+M0START                        dw 0

+M0SIZE                         dw 0

+M1START                        dw 0

+M1SIZE                         dw 0

+M2START                        dw 0

+M2SIZE                         dw 0

+M3START                        dw 0

+M3SIZE                         dw 0

+

+shdveclen equ offset shdid-offset m3size+2

+

+dummy_ret proc far

+  sti

+  ret

+dummy_ret endp 

diff --git a/system/shard-x86-at/7/src/FDISK.ASM b/system/shard-x86-at/7/src/FDISK.ASM
new file mode 100644
index 0000000..1ada045
--- /dev/null
+++ b/system/shard-x86-at/7/src/FDISK.ASM
@@ -0,0 +1,839 @@
+;-----------------------------------------------------------------------

+;       Disketten I/O                                           

+;       Input:

+;       (ah)=0  Reset Diskette System

+;               hard reset to nec, prepare command, recal rquired

+;               on all drives

+;       (ah)=1  read the status of the system into (al)

+;               diskette_status from last operation is used

+;

+;       Registers for read/write/verify/format

+;       (dl)    drive number (0-3 allowed, vlue checked)

+;       (dh)    head number (0-1 allowed, not value checked)

+;       (ch)    track number (0-39, not value checked)

+;       (cl)    sektor number (1-8, not value checked,

+;                       not used for format)

+;       (al)    number of sektors ( max = 8, not value checked,

+;                       not used for format

+;       (es:bx) address of buffer (not required for verify)

+;       (ah)=2  read the desired sektors into memory

+;                       =3      write

+;                       =4      verify

+;                       =5      format

+;               for the format operation, the buffer pointer (es,bx)

+;               must point to the collektion of desired address fields

+;               for the track. Each field is composed of 4 Bytes,

+;               (c,h,r,n) where c = track number, h=head number,

+;               r = sektor number, n = number of bytes per sektor

+;               (00=128, 01=256, 02=512, 03=1024). There must be one

+;               entry for every sektor on the track. This information

+;               is used to find the requested sektor during read/write

+;               access.

+;

+;       Data Variable -- disk_pointer

+;       double word pointer to the current set of diskette parameters

+;       Output

+;       ah = status of Operation

+;               Status bits are defined in the equates for

+;               Diskette_status variable in the data segment of this

+;               module.

+;       cy = 0  successful operation (ah = 0 on return)

+;       cy = 1  failed operation (ah has error reason)

+;       for read/write/verify

+;               ds,bx,dx,ch,cl  reserved

+;               al = number of sektors actually read

+;               ***** al may not be correkt if time out error occurs

+;       note:   if an error is reported by the diskette code, the

+;               appropriate action is to reset the diskette, then retry

+;               the operation, on read access, no motor start delay

+;               is taken, so that three retries are required on reads

+;               to ensure that the problem is not due to motor

+;               start-up.

+;-----------------------------------------------------------------------

+

+        data segment at 40h

+        org 3eh

+seek_status     db ?

+int_flag        equ 80h

+motor_status    db ?

+motor_count     db ?

+motor_wait      equ 37

+diskette_status db ?

+nec_status      db 7 dup(?)

+

+        data ends

+

+        assume ds:data

+

+ ife withhd

+dma             equ     0               ; dma address

+dma_high        equ     82h             ; port for high 4 bits of dma

+ endif

+

+

+diskette_io     proc near

+        sti

+        push    bx

+        push    cx

+        push    ds

+        push    si

+        push    di

+        push    bp

+        push    dx

+        mov     bp,sp                   ; set up pointer to head parm

+        mov     si,data

+        mov     ds,si

+        call    j1                      ; call the rest to ensure ds restored

+        mov     bx,4                    ; get the motor wait parameter

+        call    get_parm 

+        mov     motor_count,ah          ; set the timer count for the motor

+        mov     ah,diskette_status      ; get status of operation

+        cmp     ah,1                    ; set the carry flag to indicate

+        cmc                             ;        success or failure

+        pop     dx

+        pop     bp

+        pop     di

+        pop     si

+        pop     ds

+        pop     cx

+        pop     bx

+        ret

+diskette_io     endp

+

+j1      proc near

+        mov     dh,al

+        and     motor_status,07fh

+        or      ah,ah

+        jz      disk_reset

+        dec     ah

+        jz      fdisk_status

+        mov     diskette_status,0

+        cmp     dl,4

+        jae     j3

+        dec     ah

+        jz      fdisk_read

+        dec     ah

+        jnz     j2

+        jmp     fdisk_write

+j2:

+        dec     ah

+        jz      disk_verf

+        dec     ah

+        jz      disk_format

+j3:

+        mov     diskette_status,bad_cmd

+        ret

+j1      endp

+

+;----- reset the diskette system

+

+disk_reset      proc near

+        mov     dx,03f2h

+        cli

+        mov     al,motor_status

+        mov     cl,4

+        sal     al,cl

+        test    al,20h

+        jnz     j5

+        test    al,40h

+        jnz     j4

+        test    al,80h

+        jz      j6

+        inc     al

+j4:

+        inc     al

+j5:

+        inc     al

+j6:

+        or      al,8

+        out     dx,al

+        mov     seek_status,0

+        mov     diskette_status,0

+        or      al,4

+        out     dx,al

+        sti

+        call    chk_stat_2

+

+        mov     al,nec_status

+        cmp     al,0c0h

+        jz      j7

+        or      diskette_status,bad_cntlr

+        ret

+

+;----- send specific command to nec

+

+j7:

+        mov     ah,3

+        call    nec_output

+        mov     bx,1

+        call    get_parm

+        mov     bx,3

+        call    get_parm

+j8:

+        ret

+disk_reset      endp

+

+

+;-----diskette status routine

+

+fdisk_status    proc near

+        mov     al,diskette_status

+        ret

+fdisk_status    endp

+

+

+;-----diskette read

+

+fdisk_read      proc near

+        mov     al,046h

+j9:

+        call    dma_setup

+        mov     ah,0e6h

+        jmp     short rw_opn

+fdisk_read      endp

+

+

+;----- diskette verify

+

+disk_verf       proc near

+        mov     al,042h

+        jmp     j9

+disk_verf       endp

+

+

+;----- diskette format

+

+disk_format     proc near

+        or      motor_status,80h

+        mov     al,04ah

+        call    dma_setup

+        mov     ah,04dh

+        jmp     short rw_opn

+j10:

+        mov     bx,7

+        call    get_parm

+        mov     bx,9

+        call    get_parm

+        mov     bx,15

+        call    get_parm

+        mov     bx,17

+        jmp     j16

+disk_format     endp

+

+

+;-----diskette write routine

+

+fdisk_write     proc near

+        or      motor_status,80h

+        mov     al,04ah

+        call    dma_setup

+        mov     ah,0c5h

+fdisk_write     endp

+

+;-----allow write routine to fall into rw_opn

+

+;-----------------------------------------------------------------------

+; rw_opn

+;       this routine performs the read/write/verify operation

+;-----------------------------------------------------------------------

+

+rw_opn  proc    near

+        jnc     j11

+        mov     diskette_status,dma_boundary

+        mov     al,0

+        ret

+j11:

+        push    ax

+

+;----- turn on the motor and select the drive

+

+        push    cx

+        mov     cl,dl

+        mov     al,1

+        sal     al,cl

+        cli

+

+        mov     motor_count,0ffh

+        test    al,motor_status

+        jnz     j14

+        and     motor_status,0f0h

+        or      motor_status,al

+        sti

+        mov     al,10h

+        sal     al,cl

+        or      al,dl

+        or      al,0ch

+        push    dx

+        mov     dx,03f2h

+        out     dx,al

+        pop     dx

+

+;----- wait for motor if write operation

+

+        test    motor_status,80h

+        jz      j14

+

+        clc

+        mov     ax,090fdh

+        int     15h

+        jc      j14

+

+

+        mov     bx,20

+        call    get_parm

+        or      ah,ah

+j12:

+        jz      j14

+        sub     cx,cx

+j13:

+        loop    j13

+        dec     ah

+        jmp     j12

+j14:

+        sti

+        pop     cx

+

+;----- do the seek operation

+

+        call    seek

+        pop     ax

+        mov     bh,ah

+        mov     dh,0

+        jc      j17

+        mov     si,offset j17

+        push    si

+

+;----- send out the parameters to the controller

+

+        call    nec_output

+        mov     ah,[bp+1]

+        sal     ah,1

+        sal     ah,1

+        and     ah,4

+        or      ah,dl

+        call    nec_output

+

+;----- test for format command

+

+        cmp     bh,04dh

+        jne     j15

+        jmp     j10

+j15:

+        mov     ah,ch

+        call    nec_output

+        mov     ah,[bp+1]

+        call    nec_output

+        mov     ah,cl

+        call    nec_output

+        mov     bx,7

+        call    get_parm

+        mov     bx,9

+        call    get_parm

+        mov     bx,11

+        call    get_parm

+        mov     bx,13

+j16:

+        call    get_parm

+        pop     si

+

+;----- let the operation happen

+

+        call    wait_int

+j17:

+        jc      j21

+        call    results

+        jc      j20

+

+;----- check the results returned by the controller

+

+        cld

+        mov     si,offset nec_status

+        lods    nec_status

+        and     al,0c0h

+        jz      j22

+        cmp     al,040h

+        jnz     j18

+

+;----- abnormal termination, find out wy

+

+        lods    nec_status

+        sal     al,1

+        mov     ah,record_not_fnd

+        jc      j19

+        sal     al,1

+        sal     al,1

+        mov     ah,bad_crc

+        jc      j19

+        sal     al,1

+        mov     ah,bad_dma

+        jc      j19

+        sal     al,1

+        sal     al,1

+        mov     ah,record_not_fnd

+        jc      j19

+        sal     al,1

+        mov     ah,write_protect

+        jc      j19

+        sal     al,1

+        mov     ah,bad_addr_mark

+        jc      j19

+

+;----- nec must have failed

+

+j18:

+        mov     ah,bad_cntlr

+j19:

+        or      diskette_status,ah

+        call    num_trans               ; how many were really transferred

+j20:

+        ret

+j21:

+        call    results

+        ret

+

+;----- operation was successfull

+

+j22:

+        call    num_trans

+        xor     ah,ah

+        ret

+rw_opn  endp

+

+;-----------------------------------------------------------------------

+;       nec_output

+;       This routine sends a byte to the nec controller after testing

+;       for correct direction and controller ready. This routine will

+;       time out if the byte is not accepted within a reasonable

+;       amount of time, setting the diskette status on completion.

+; Input

+;       (ah)    byte to be output

+; Output

+;       cy=0    success

+;       cy=1    failure -- diskette status updated

+;               If a failure has occured, the return is made one level

+;               higher than the caller of nec_output. (!Schweinkram)

+;               This removes the requirement of testing after every

+;               call of nec_output

+;       (al)    destroyed

+;-----------------------------------------------------------------------

+

+nec_output      proc near

+        push    dx

+        push    cx

+        mov     dx,03f4h

+        xor     cx,cx

+j23:

+        in      al,dx

+        test    al,040h

+        jz      j25

+        loop    j23

+j24:

+        or      diskette_status,time_out

+        pop     cx

+        pop     dx

+        pop     ax              ; discard the return address

+        stc

+        ret

+j25:

+        xor     cx,cx

+j26:

+        in      al,dx

+        test    al,080h

+        jnz     j27

+        loop    j26

+        jmp     j24

+j27:

+        mov     al,ah

+        mov     dl,0f5h

+        out     dx,al

+        pop     cx

+        pop     dx

+        ret

+nec_output      endp

+

+;-----------------------------------------------------------------------

+; get_parm

+;       This routine fetches the indext pointer from the disk_bas

+;       block pointed at by the data variable disk_pointer. A byte from

+;       that table is then moved into ah, the index of that byte being

+;       the parm in bx

+; Input:

+;       bx      index of byte to be fetched *2

+;               if the low bit of bx is on, the byte is immediately output

+;               to the nec controller

+; Exit

+;       am      that byte from block

+;-----------------------------------------------------------------------

+

+disk_pointer    equ 1eh * 4

+

+get_parm        proc near

+        push    ds

+        push    si

+        sub     ax,ax

+        mov     ds,ax

+

+        lds     si,dword ptr ds:disk_pointer

+        shr     bx,1

+

+        mov     ah,[si+bx]

+        pop     si

+        pop     ds

+        jc      nec_output

+        ret

+get_parm        endp

+

+;-----------------------------------------------------------------------

+; seek

+;       Thi routine will move the head on the named drive to the

+;       named track. If the drive has not been accessed since the

+;       drive reset command was issued, the drive will be recalibrated.

+; Input:

+;       (dl) = Drive to seek on

+;       (ch) = track t seek to

+; Output:

+;       cy = 0 success

+;       cy = 1 failure -- diskette_status set accordingly

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+seek    proc near

+        mov     al,1

+        push    cx

+        mov     cl,dl

+        rol     al,cl

+        pop     cx

+        test    al,seek_status

+        jnz     j28

+        or      seek_status,al

+        mov     ah,07h

+        call    nec_output

+        mov     ah,dl

+        call    nec_output

+        call    chk_stat_2

+        jc      j32

+

+;----- drive is in synch with controller, seek to track

+

+j28:

+        mov     ah,0fh

+        call    nec_output

+        mov     ah,dl

+        call    nec_output

+        mov     ah,ch

+        call    nec_output

+        call    chk_stat_2

+

+;----- wait for head settle

+

+        pushf

+        mov     bx,18

+        call    get_parm

+        push    cx

+j29:

+        mov     cx,550

+        or      ah,ah

+        jz      j31

+j30:

+        loop    j30

+        dec     ah

+        jmp     j29

+j31:

+        pop     cx

+        popf

+j32:

+        ret

+seek    endp

+

+;-----------------------------------------------------------------------

+; dma_setup

+;       this routine sets up the dma for read/write/verify operations

+; input:

+;       (al) = mode byte for the dma

+;       (es:bx) - address to read/write the data

+; output:

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+dma_setup       proc near

+        push    cx

+        cli

+        out     dma+12,al

+        push    ax

+        pop     ax

+        out     dma+11,al

+        mov     ax,es

+        mov     cl,4

+        rol     ax,cl

+        mov     ch,al

+        and     al,0f0h

+        add     ax,bx

+        jnc     jj33

+        inc     ch

+jj33:

+        push    ax

+        out     dma+4,al

+        mov     al,ah

+        out     dma+4,al

+        mov     al,ch

+        and     al,0fh

+        out     081h,al

+

+;----- determine count

+

+        mov     ah,dh

+        sub     al,al

+        shr     ax,1

+        push    ax

+        mov     bx,6

+        call    get_parm

+        mov     cl,ah

+        pop     ax

+        shl     ax,cl

+        dec     ax

+        push    ax

+        out     dma+5,al

+        mov     al,ah

+        out     dma+5,al

+        sti

+        pop     cx

+        pop     ax

+        add     ax,cx

+        pop     cx

+        mov     al,2

+        out     dma+10,al

+        ret

+dma_setup       endp

+

+;-----------------------------------------------------------------------

+; chk_stat_2

+;       This routine handles the interrupt received after a

+;       recalibrate, seek, or reset to the adapter.

+;       The interrupt is waited for, the interrupt sensed,

+;       and the result returned to the caller.

+; input:

+;       none

+; output:

+;       cy = 0  success

+;       cy = 1  failure -- error is in diskette_status

+;       (ax)            destroyed

+;-----------------------------------------------------------------------

+

+chk_stat_2      proc near

+        call    wait_int

+        jc      j34

+        mov     ah,08h

+        call    nec_output

+        call    results

+        jc      j34

+        mov     al,nec_status

+        and     al,060h

+        cmp     al,060h

+        jz      j35

+        clc

+j34:

+        ret

+j35:

+        or      diskette_status,bad_seek

+        stc

+        ret

+chk_stat_2      endp

+

+;-----------------------------------------------------------------------

+; wait_int

+;       This routine waits for an interrupt to occur. A time out

+;       routine takes place during the wait, so that an error may be

+;       returned if the drive is not ready.

+; input:

+;       none

+; output:

+;       cy = 0 success

+;       cy = 1 failure -- diskette_status is set accordingly

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+wait_int        proc near

+        sti

+        push    ax

+        push    bx

+        push    cx

+        clc

+        mov     ax,09001h

+        int     15h

+        sti

+        jc      j36a

+;

+        mov     bl,2

+        xor     cx,cx

+j36:

+        test    seek_status,int_flag

+        jnz     j37

+;       push cx

+;       push bx

+;       push ds

+;       push es

+;       push ax

+;       push dx

+;       push si

+;       push di

+;       push bp

+;       call cs:warte

+;       pop bp

+;       pop di

+;       pop si

+;       pop dx

+;       pop ax

+;       pop es

+;       pop ds

+;       pop bx

+;       pop cx

+        loop    j36

+        dec     bl

+        jnz     j36

+

+j36a:   or      diskette_status, time_out

+        stc

+j37:

+        pushf

+        and     seek_status, not int_flag

+        popf

+        pop     cx

+        pop     bx

+        pop     ax

+        ret

+wait_int        endp

+

+;-----------------------------------------------------------------------

+; disk_int

+;       This routine handles the diskette interrupt

+; Input

+;       none

+; output:

+;       The interrupt flag is set is seek_status

+;-----------------------------------------------------------------------

+

+;**************

+;org    0ef57h

+;**************

+disk_int        proc far

+        sti

+        push    ds

+        push    ax

+        push si

+        mov     si,data

+        mov     ds,si

+        or      seek_status, int_flag

+        mov     al,20h

+        out     20h,al

+        mov     ax,09101h

+        int     15h

+        pop si

+        pop     ax

+        pop     ds

+        iret

+disk_int        endp

+

+;-----------------------------------------------------------------------

+; results

+;       This routine will read anything that the nec controller has

+;       to say following an interrupt.

+; input:

+;       none

+; output:

+;       cy = 0  successful transfer

+;       cy = 1  failure -- time out in waiting for status

+;       nec_status area has status byte loaded into it

+;       (ah) destroyed

+;-----------------------------------------------------------------------

+

+results proc near

+        cld

+        mov     di,offset nec_status

+        push    cx

+        push    dx

+        push    bx

+        mov     bl,7

+

+;-----wait for request for master

+

+j38:

+        xor     cx,cx

+        mov     dx,03f4h

+j39:

+        in      al,dx

+        test    al,80h

+        jnz     j40a

+        loop    j39

+        or      diskette_status, time_out

+j40:

+        stc

+        pop     bx

+        pop     dx

+        pop     cx

+        ret

+

+;----- test the direction bit

+

+j40a:

+        in      al,dx

+        test    al,40h

+        jnz     j42

+j41:

+        or      diskette_status,bad_cntlr

+        jmp     j40

+

+;-----read in the status

+

+j42:

+        inc     dx

+        in      al,dx

+        mov     [di],al

+        inc     di

+        mov     cx,10

+j43:    loop    j43

+        dec     dx

+        in      al,dx

+        test    al,10h

+        jz      j44

+        dec     bl

+        jnz     j38

+        jmp     j41

+

+;----- result operation is done

+

+j44:

+        pop     bx

+        pop     dx

+        pop     cx

+        ret

+

+;-----------------------------------------------------------------------

+; num_trans

+;       This routine calculates the number of sectors that were

+;       actually transferred to/from the diskette

+; input

+;       (ch) = cylinder of operation

+;       (cl) = start sector of operation

+; output

+;       (al) = number actually transferred

+;       no other registers modified

+;-----------------------------------------------------------------------

+

+num_trans       proc near

+        mov     al,nec_status+3

+        cmp     al,ch

+        mov     al,nec_status+5

+        jz      j45

+        mov     bx,8

+        call    get_parm

+        mov     al,ah

+        inc     al

+j45:

+        sub     al,cl

+        ret

+num_trans       endp

+results         endp

+

+        assume ds:shard

+

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/FIXDISK.ASM b/system/shard-x86-at/7/src/FIXDISK.ASM
new file mode 100644
index 0000000..0b18fdd
--- /dev/null
+++ b/system/shard-x86-at/7/src/FIXDISK.ASM
@@ -0,0 +1,306 @@
+;************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============*

+;*                                                                      *

+;*   Harddisk routinen                                                  *

+;*                                                                      *

+;************************************************************************

+

+     device fixdisk

+

+     dtcbroutines iocontrol

+          routine 5,fixed_size

+          routine -10,fixed_tracks

+          routine -11,fixed_sects

+          routine -12,fixed_heads

+          routine 1,devicetype

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -2,fixed_init

+          routine -100,fixed_size_set

+          routine -101,fixed_start_set

+          routine -102,fixed_landing_zone

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine -1,fixed_read

+     dtcbroutines blockout

+          routine -1,fixed_write

+     dtcbparams nil_output,0ch     ;kein output, blockio device

+

+

+heads equ 4

+sects equ 17

+

+ if pcxt

+  if at

+   bitte nicht at und pcxt gleichzeitig

+  endif

+ endif

+

+ if pcd

+romhd equ 1

+ else

+ if at

+romhd equ 1

+ else

+romhd equ romharddisk

+  endif

+  endif

+

+fix_ccb macro kanal

+startccb hgccb&kanal,kanal

+ccbentry fix_size

+    dw 0

+    db 0

+ccbentry fix_firstblock

+    dw 0

+    db 0

+ccbentry fix_sects

+    db 0

+ccbentry fix_cylsize

+    dw 0

+    endm

+

+fixed_size_set:

+     mov [di+fix_size],dx

+     mov [di+fix_size+2],bl

+     ret

+ 

+fixed_start_set:

+     mov [di+fix_firstblock],dx

+     mov [di+fix_firstblock+2],bl

+     ret

+

+fixed_init:

+     mov ax,0801h                      ;return drive type

+     mov dl,80h                        ;drive 0

+     int 13h

+     mov al,cl                         ;anzahl sects holen

+     and al,3fh                        ;nur sector anzahl

+     mov [di+fix_sects],al             ;eintragen

+     inc dh                            ;anzahl koepfe (statt hoechste nummer)

+     mul dh                            ;sects pro cylinder

+     mov [di+fix_cylsize],ax           ;eintragen

+     mov dl,cl                         ;cylinder anzahl nach dx packen

+     shl dx,1

+     shl dx,1

+     and dh,3                          ;nur unterste zwei bits behalten

+     mov dl,ch                         ;rest cylindernummer holen

+     inc dx                            ;anzahl draus machen

+     mul dx                            ;anzahl bloecke ausrechnen

+     mov [di+fix_size],ax

+     mov [di+fix_size+2],dl

+     ret

+

+fixed_tracks:

+     call fix_drive

+     rol cl,1                          ;trackzahl in cx melden

+     rol cl,1

+     and cl,3                          ;nur zwei bits sind noch track

+     xchg cl,ch

+     inc cx                            ;meldet hoechste nummer, anzahl draus

+     ret

+

+fixed_sects:

+     call fix_drive

+     and cl,03fh                       ;nur sectorenzahl behalten

+     mov ch,0                          ;high byte 0

+     ret

+

+fixed_heads:

+     call fix_drive

+     mov cl,dh

+     mov ch,0

+     inc cx                            ;hoechsten head -> anzahl umrechnen

+     ret

+

+fix_drive:

+     mov ax,0801h                      ;return drive type

+     mov dl,80h                        ;drive 0

+     int 13h

+     ret

+

+fixed_landing_zone:

+     mov bx,0

+     call device_free              ;auf freigabe warten

+     call hardware                 ;pruefen, ob at

+     cmp al,IBMat

+     jz fixed_at_landing

+     call fix_drive

+     mov ax,0c01h                  ;seek

+     mov dl,80h                    ;immer auf erstem drive

+     inc ch                        ;auf naechste spur

+     ifz <add cl,40h>              ;hoeherwertigen bits auch zaehlen

+     int 13h

+     ret

+

+fixed_at_landing:

+     sub ax,ax

+     mov ds,ax

+     les bx,dword ptr ds:[(41h*4)]

+     mov ax,es:[bx+12]             ;landing zone

+     mov ch,al                     ;unterste byte der cylinder number

+     and ax,0300h                  ;obersten zwei bits

+     shr ax,1

+     shr ax,1

+     or al,1                       ;immer sector 1

+     mov cl,al

+     mov dx,80h                    ;drive und head 0

+     mov ax,0c01h                  ;seek

+     int 13h

+     ret                           ;device nicht wieder freigeben

+                                   ;aendern, wenn zwei laufwerke

+

+fix_highblock:

+     pop bx

+     jmp highblock

+

+fixed_write:

+    push bx

+ if romhd

+    mov bl,3

+ else

+    mov bl,0               ;auftrag schreiben nach bl

+ endif

+    jmp short fixed_rw

+fixed_read:

+     push bx

+  if romhd

+     mov bl,2              ;lesen nach bl

+  else

+     mov bl,1

+  endif

+fixed_rw:

+     cmp ch,0                 ;wirklich read oder write

+     ifnz <jmp unknowncontrol>

+     cmp cl,[di+fix_size+2]

+     ifz <cmp dx,[di+fix_size]> ;blocknummer zu hoch?

+     jnc fix_highblock

+     push bx

+     mov bx,0

+     call device_free

+

+     pop bx

+     mov ax,dx               ;blocknummer nach ax

+     add ax,[di+fix_firstblock] ;offset fuer ersten block dazu

+     adc cl,[di+fix_firstblock+2]

+     mov dx,cx                ;high byte muss nach dx

+

+     if at                    ;translate bad blocks if at

+; jetzt erstmal schlechte sectoren suchen

+     push es

+     push ds

+     pop es

+     push di

+     mov di,offset bb_table

+     cld

+     mov cx,[bb_anz]          ;anzahl schlechte sectoren

+fix_search_bb:

+     jcxz fix_no_translate

+     repnz scasw              ;sieh mal nach

+     jnz fix_no_translate

+     cmp dl,byte ptr [di+max_bb*2-2] ;obere byte ebenfalls pruefen

+     jnz fix_search_bb

+; schlechten sector gefunden

+     pop di

+     mov ax,[di+fix_firstblock]        ;direkt hinter letzten block

+     mov dl,[di+fix_firstblock+2]

+     add ax,[di+fix_size]

+     adc dl,[di+fix_size+2]

+     add ax,cx

+     adc dl,0

+     push di

+fix_no_translate:

+     pop di

+     pop es

+     endif

+

+     div word ptr (di+fix_cylsize)    ;dxax / sectoren pro zylinder

+                             ;der rest passt immer in 32 bit

+     mov ch,al               ;low byte tracknummer nach ch

+     ror ah,1

+     ror ah,1

+     mov cl,ah               ;high bits der cylindernummer nach cl 

+     mov ax,dx               ;rest nach ax

+     div byte ptr (di+fix_sects)

+

+     if at

+     mov dh,al                ;kopf nach dh

+     else

+; jetzt erstmal schlechte spuren suchen

+     or cl,al                 ;kopf zur spur dazu

+     push ax                  ;retten

+     mov ax,cx                ;zum suchen da rueber

+     push di

+     push es

+     push ds

+     pop es

+     mov di,offset bt_table

+     mov cx,8                 ;8 moegliche schlechte spuren

+     cld

+     repnz scasw              ;sieh mal nach

+     ifz <mov ax,word ptr [di+14]> ersatzwert holen

+     pop es

+     pop di

+     mov cx,ax                ;zurueckgeben

+     and cl,0c0h              ;nur cylinderbits behalten

+     and al,03fh              ;nur kopf bits

+     mov dh,al               ;head nach dh

+     pop ax

+     endif

+

+     mov dl,080h   ;drive nach dl

+     or cl,ah                ;sector nach cl reinbasteln

+     mov al,1                ;einen sector

+     mov ah,bl               ;auftrag nach ah

+     pop bx

+ if romhd

+     inc cl

+     push es

+     int 13h

+     pop es

+     jc diskerr

+ else

+     push bx

+     mov bx,0

+     call device_lock

+     pop bx

+     mov byte ptr [cmd_block+1],dh ;kopfnummer

+     mov byte ptr [cmd_block+2],cl ;cylinder + sect

+     mov byte ptr [cmd_block+3],ch ;cylinder

+     push es

+     call hard_dsk

+     pop es

+     xor bx,bx     ;device 0 freigeben

+     call device_unlock

+     mov ah,byte ptr [disk_status]  ;haben wir fehler

+     or ah,ah

+     jnz diskerr

+ endif

+     mov byte ptr fix_err,0       ;ein aufruf war ohne fehler

+     mov cx,0

+     ret

+

+diskerr:

+  inc byte ptr fix_err

+  cmp byte ptr fix_err,4 ;schon viermal hintereinander fehler

+  jnz fix_blockerr

+  mov byte ptr fix_err,0

+  push ax

+  mov ah,13               ;nur harddisk zuruecksetzen

+  mov dl,80h    ;disk reset

+  int 13h

+  pop ax

+fix_blockerr:

+  jmp blockerr

+

+fixed_size:

+        mov al,[di+fix_size+2]

+        mov cx,[di+fix_size]

+        ret

+

+fix_err db 0

+

+

+   ife romhd

+     include HDISK.ASM

+   endif

diff --git a/system/shard-x86-at/7/src/FLOPPY.ASM b/system/shard-x86-at/7/src/FLOPPY.ASM
new file mode 100644
index 0000000..07145ce
--- /dev/null
+++ b/system/shard-x86-at/7/src/FLOPPY.ASM
@@ -0,0 +1,453 @@
+;************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============*

+;*                                                                      *

+;*   Floppydisk archiv routinen                                         *

+;*                                                                      *

+;************************************************************************

+

+     device archive

+

+     dtcbroutines iocontrol

+          routine 5,archive_size

+          routine 1,devicetype

+          routine 7,archive_format

+          routine -1,unknowncontrol

+     dtcbroutines control32

+     ife pcd

+          routine -2,archive_init

+     endif

+          routine -173,set173size

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine 0,archive_read

+     dtcbroutines blockout

+          routine 0,archive_write

+          routine -1,unknowncontrol

+     if pcd

+     dtcbparams nil_output,0ch     ;kein output, blockio device

+     else

+     dtcbparams nil_output,1ch     ;kein output, blockio device, format erlaubt

+     endif

+

+IBM equ 0

+OLI equ 1

+IBM_BIG equ 2

+IBMsize equ 360*2

+OLIsize equ 400*2

+IBM_BIGsize equ 15*80*2

+

+if pcd

+romfd equ 1

+ else

+ if at

+romfd equ 1

+ else

+romfd equ romfloppy

+  endif

+  endif 

+

+floppyio macro

+     if romfd

+       if withhd

+        int 40h

+       else

+        int 13h                 ;disketten routine aufrufen

+       endif

+     else

+       call diskette_io

+     endif

+ endm

+

+archive_ccb macro drive,drive_type

+     startccb archive_&drive,0 ;kanalnummer ist uninterressant

+ccbentry arch_typ

+     db IBM                   ;standardmaessig IBM annehmen

+ccbentry arch_size

+     dw 0

+ccbentry arch_drive

+     db drive

+ccbentry arch_drive_type

+     db drive_type

+ccbentry arch_default_format

+     if drive_type eq highdensity

+       db 3

+     else

+      if drive_type eq drive720

+       db 2

+      else

+       db 1

+      endif

+     endif

+     endm

+

+highdensity equ 1             ;bit 0 ist highdensity bit

+with_boot_on_it equ 2 	      ;bit 1 sagt, dass boot auf der floppy ist (fuer hg)

+drive720 equ 4                ;bit 2 sagt, dass 80 track double density

+eighty_tracks equ 8           ;bit 3 sagt, wir formatieren gerade 80 spuren

+no_floppy equ 16              ;bit 4 sagt, hier ist kein laufwerk

+

+diskvector equ 01eh*4

+diskinterrupt equ 0eh*4

+

+archive_init:

+     mov ax,0

+     mov es,ax                ;auf int vektoren zeigen

+     mov word ptr es:[diskvector],offset nineblockvector

+     mov word ptr es:[diskvector+2],cs

+   ife romfd                  ;wenn nicht at

+     mov word ptr es:[diskinterrupt],offset disk_int

+     mov word ptr es:[diskinterrupt+2],cs

+   endif

+     ret

+

+oliinout:

+  mov ax,dx               ;blocknummer nach ax

+  mov dl,20               ;20 sectoren pro cylinder

+  div dl                  ;ax/dl

+  mov ch,al               ;track nach ch

+  mov al,ah               ;rest nach al

+  mov ah,0                ;obere haelfte loeschen

+  mov dl,10               ;10 sects pro spur

+  div dl

+  mov dh,al               ;head nach dh

+  mov dl,(di+arch_drive)  ;drive nach dl

+  mov cl,ah               ;sector nach cl

+  inc cl                  ;beginnt mit eins

+  mov al,1                ;einen sector

+  mov ah,bl               ;auftrag nach ah

+  pop bx

+  push es

+  floppyio

+  pop es

+  jc archive_diskerr

+  mov cx,0

+  ret

+

+

+archive_write:

+ push bx

+ mov bl,3               ;auftrag schreiben nach bl

+ jmp short archive_rw

+

+archive_read:

+  push bx

+  mov bl,2              ;lesen nach bl

+

+archive_rw:

+  push bx

+  mov bx,1                    ;floppy ist device 1

+  call device_free            ;warten, bis frei

+  pop bx

+  test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf

+  ifnz <add dx,boot_size>

+  jc archive_highblock

+  cmp dx,word ptr (di+arch_size) ;blocknummer zu hoch

+  jnc archive_highblock

+  cmp byte ptr (di+arch_typ),OLI       ;haben wir ein olivetti archiv

+  jz oliinout

+  mov ax,dx

+  mov dh,0              ;erste seite annehmen

+  mov cx,(di+arch_size)       ;gesamtgroesse

+  shr cx,1                    ;halbieren

+  cmp ax,cx            ;schon zweite seite

+  jc notsecond

+  mov dh,1              ;zweiten kopf

+  sub ax,cx 

+notsecond:

+  mov dl,9

+  cmp byte ptr (di+arch_typ),IBM_BIG

+  ifz <mov dl,15>        ;15 sectoren pro spur

+  div dl                  ;9 sectoren pro spur

+  mov ch,al               ;track nach ch

+  mov dl,(di+arch_drive)  ;drive nach dl

+  mov cl,ah               ;sector nach cl

+  inc cl                  ;beginnt mit eins

+  mov al,1                ;einen sector

+  mov ah,bl               ;auftrag nach ah

+  pop bx

+  push es

+  floppyio

+  pop es

+  jc archive_diskerr

+  mov cx,0

+  ret

+

+archive_diskerr:

+   push ax

+   mov ah,0

+   floppyio                   ;reset disk system

+   pop ax

+  jmp blockerr

+archive_highblock:

+     pop bx

+     jmp highblock

+

+set173size:

+     cmp word ptr [hgver],1742

+     ifz <mov word ptr (di+arch_size),IBMsize>

+     ret

+

+;************************************************************************

+;* archive_size liefert die groesse einer aktuell eingelegten floppy

+;*

+;* und zwar wird unterschieden zwischen IBM-Format (9 Sectoren pro Spur)

+;* und Olivetti (M20) Format mit 10 Sectoren pro Spur sowie IBM Format mit

+;* 15 Sectoren pro Spur

+archive_size:

+     mov bx,1              ;floppy ist device 1

+     call device_free

+     mov word ptr (di+arch_size),0  ;annehmen, dass keine floppy da

+; falls noch version 1.7.3, dann in diesem Fall 360K annehmen

+     cmp word ptr [hgver],1742

+     ifz <mov word ptr (di+arch_size),IBMsize>

+    if pcd

+     and byte ptr (di+arch_drive),0ffh-20h ;96 tpi ausschalten

+    endif

+

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,1        ;track 0, sector 1 

+     mov ax,0401h    ;verify, ein sector

+     floppyio        ;ist ueberhaupt ne floppy da

+     jnc arch_det_size

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,1        ;track 0, sector 1 

+     mov ax,0401h    ;verify, ein sector

+     floppyio        ;ist ueberhaupt ne floppy da

+     jc arch_size_end ;fertig

+arch_det_size:

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,14       ;track 0, sector 14

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     mov byte ptr (di+arch_typ),IBM_BIG

+     mov word ptr (di+arch_size),IBM_BIGsize

+     jnc arch_size_end ;wir sind fertig

+

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,10       ;track 0, sector 10

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     mov byte ptr (di+arch_typ),OLI

+     mov word ptr (di+arch_size),OLIsize

+     jnc arch_is_oli

+     mov byte ptr (di+arch_typ),IBM ;konnten nicht finden, dann IBM Format 

+     mov word ptr (di+arch_size),IBMsize

+arch_is_oli:

+     mov dl,(di+arch_drive) ;drive nummer holen

+  if pcd

+     or dl,20h             ;96 tpi floppy?

+  endif

+     test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk

+     jnz arch_test_720k

+  ife limited_to_360

+     mov dh,0        ;head 0

+     mov cx,2901h      ;track 41, sector 1

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     jc arch_size_end

+     mov bx,word ptr (di+arch_size)

+     add bx,bx             ;doppelte kapazitaet

+     mov word ptr (di+arch_size),bx

+    if pcd

+     or byte ptr (di+arch_drive),20h  ;96 tpi einstellen

+    endif

+    endif

+arch_size_end:

+     mov al,0

+     mov cx,word ptr (di+arch_size)

+     test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf

+     ifnz <sub cx,boot_size>

+     ret

+

+arch_test_720k:

+     mov dh,0  ;head 0

+     mov cx,0201h   ;spur 2, sector 1

+     mov ax,0401h

+     floppyio

+     mov al,0       ;annehmen, muss nicht gewechselt werden

+     jnc arch_skip_flip  ;erkannt, groesse setzen

+     mov dl,(di+arch_drive)

+     mov dh,0  ;zurueck auf spur 0

+     mov cx,1       ;spur 0, sector 1

+     mov ax,0401h

+     floppyio

+     mov al,20h     ;muss gewechselt werden

+arch_skip_flip:

+     mov bx,40h     ;auf datensegment gehen

+     mov es,bx

+     mov bx,90h

+     add bl,byte ptr (di+arch_drive)

+     xor byte ptr es:[bx],al            ;ggf. flag flippen

+     test byte ptr es:[bx],20h		;wenn double step stimmt groesse

+     jnz arch_size_end

+     mov bx,word ptr (di+arch_size)

+     add bx,bx             ;doppelte kapazitaet

+     mov word ptr (di+arch_size),bx

+     jmp arch_size_end

+

+

+arch_form_unallowed:

+     mov cx,3

+     ret

+

+;*********************************************************************

+; formatieren einer floppy mit 9 oder 15 sects pro spur

+archive_format:

+     mov bx,1                 ;floppy ist device 1

+     call device_free

+     and byte ptr (di+arch_drive_type),0ffh-eighty_tracks

+     cmp dx,0

+     ifz <mov dl,byte ptr (di+arch_default_format)>

+     cmp dx,1

+     jz arch_form_1

+     or byte ptr (di+arch_drive_type),eighty_tracks

+     cmp dx,2

+     jz arch_form_2

+     cmp dx,3

+     jnz arch_form_unallowed

+;format 3

+     test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk 

+     jz arch_form_unallowed   ;nur bei highdensity geht 3

+     mov ax,1703h             ;1.2M in 1.2M laufwerk

+     mov dl,(di+arch_drive)

+     floppyio

+     mov dx,offset fifteenblockvector

+     mov bx,offset archive_format_buffer15

+     jmp short arch_form_go

+

+;format 2

+arch_form_2:

+     test byte ptr (di+arch_drive_type),drive720+highdensity ;kann es 720k

+     jz arch_form_unallowed     ;weder highdensity noch 720k, da geht nur 1

+     test byte ptr (di+arch_drive_type),highdensity

+     jz arch_form_1           ;wie 1, 80 track bit steht schon

+     mov ax,1702h             ;low density in high density drive

+     mov dl,(di+arch_drive)

+     floppyio

+     mov bx,40h     ;auf datensegment gehen

+     mov es,bx

+     mov bx,90h                    ;zur state variablen

+     add bl,byte ptr (di+arch_drive)

+     and byte ptr es:[bx],0ffh-20h      ;double step flag loeschen

+     jmp short arch_form_low_density

+

+;format 1

+arch_form_1:

+     mov ax,1701h             ;normal drive

+     mov dl,(di+arch_drive)

+     floppyio

+     test byte ptr (di+arch_drive_type),highdensity 

+     jz arch_form_low_density ;kein highdensity laufwerk, einstellung bleibt

+     mov ax,1702h             ;low density in high density drive

+     mov dl,(di+arch_drive)

+     floppyio

+     

+arch_form_low_density:

+     mov dx,offset nineblockvector

+     mov bx,offset archive_format_buffer

+arch_form_go:

+     push es

+     mov ax,0

+     mov es,ax                ;auf int vektoren zeigen

+     mov word ptr es:[diskvector],dx

+     mov word ptr es:[diskvector+2],cs

+     pop es

+     mov dl,(di+arch_drive)                  ;drive nummer holen

+     mov ch,0                                ;bei track 0 anfangen

+archive_form_track_loop:

+     mov dh,0

+archive_form_head_loop:

+     push cs

+     pop es         ;buffer liegt in cs

+     mov al,15

+     mov bp,bx      ;wir muessen was eintragen

+arch_track_set_loop:

+     mov byte ptr cs:[bp],ch       ;track

+     inc bp

+     mov byte ptr cs:[bp],dh       ;head

+     inc bp

+     inc bp

+     inc bp

+     dec al

+     jnz arch_track_set_loop

+     mov ax,0501h                  ;format

+     floppyio

+     jnc arch_form_cont

+     mov cx,2                 ;fehler melden

+     ret

+arch_form_cont:

+  if romfd

+     push bx

+     push cx

+     push dx

+     push di

+     push si

+     call warte

+     call warte

+     pop si

+     pop di

+     pop dx

+     pop cx

+     pop bx

+   endif

+     inc dh         ;naechste kopf

+     cmp dh,2       ;fertig

+     jnz archive_form_head_loop

+     inc ch         ;naechste track

+     cmp ch,40

+     jc archive_form_track_loop

+     test byte ptr (di+arch_drive_type),eighty_tracks ;80 spuren ?

+     jz arch_form_end

+     cmp ch,80

+     jnz archive_form_track_loop

+arch_form_end:

+     mov cx,0       ;ok

+     ret

+

+archive_format_buffer:

+     irp x,<1,6,2,7,3,8,4,9,5,10>

+     db 0,0,x,2          ;;track und head wird per programm eingetragen

+     endm

+;;achtung: hier nichts einfuegen, da beim initialisieren vom ersten buffer

+;;auch ein teil vom zweiten initialisiert wird

+archive_format_buffer15:

+     irp x,<1,9,2,10,3,11,4,12,5,13,6,14,7,15,8>

+     db 0,0,x,2          ;;track und head wird per programm eingetragen

+     endm

+

+nineblockvector:

+     db 11011111b                ;step rate und hut

+     db 2                        ;hd load = 1

+     db 37                       ;let motor run 37 seconds

+     db 2                        ;512 byte per sector

+     db 9                        ;last sector is 9

+     db 42                       ;gap length

+     db 0ffh                     ;dtl

+     db 80                       ;gap length format

+     db 0f6h                     ;fill byte fuer format

+     db 15                       ;head settle time

+     db 2                        ;motor start time

+

+fifteenblockvector:

+     db 11011111b                ;step rate und hut

+     db 2                        ;hd load = 1

+     db 37                       ;let motor run 37 seconds

+     db 2                        ;512 byte per sector

+     db 15                       ;last sector is 15

+     db 01bh                     ;gap length

+     db 0ffh                     ;dtl

+     db 054h                     ;gap length format

+     db 0f6h                     ;fill byte fuer format

+     db 15                       ;head settle time

+     db 8                        ;motor start time (1/8 sekunden)

+

+

+ ife romfd

+     include FDISK.ASM

+ endif

+

+

diff --git a/system/shard-x86-at/7/src/FSHARD.ASM b/system/shard-x86-at/7/src/FSHARD.ASM
new file mode 100644
index 0000000..83c0c21
--- /dev/null
+++ b/system/shard-x86-at/7/src/FSHARD.ASM
@@ -0,0 +1,225 @@
+  page 80,132

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 8086/8088 Systemen                                    *

+;*                                                                            *

+;*       SHard Version 6-PC/Floppy                                            *

+;*                                                                            *

+;*       Copyright (C) Martin Schoenbeck, Spenge                              *

+;*                                                                            *

+;******************************************************************************

+

+com2wrongirq equ 0

+add4 equ 0

+ast equ 0

+

+at equ 0 

+pcxt equ 1

+pcd equ 0

+romfloppy equ 0

+ramsys equ 0

+limited_to_360 equ 0

+mit_msdos equ 0

+withhd equ 0

+hdsystem equ 0

+boot_size equ 0

+gensys equ 0

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+     org 100h

+shstart:

+     jmp los_gehts

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+ if com2wrongirq

+   com2irq equ 5

+ else

+   com2irq  equ 3

+ endif

+ if add4

+com4_1base equ 03e8h

+com4_1irq  equ 3

+com4_2base equ 03e0h

+com4_2irq  equ 3

+com4_3base equ 02f0h

+com4_3irq  equ 3

+com4_4base equ 02e8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 0260h

+com8_2irq  equ 3

+com8_3base equ 02d8h

+com8_3irq  equ 3

+ else

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+add4_3base equ 03e8h

+add4_3irq  equ 3

+add4_4base equ 03e0h

+add4_4irq  equ 3

+add4_8base equ 0260h

+add4_8irq  equ 3

+ endif

+ast0_1base equ 01a0h

+ast0_1irq  equ 5

+ast0_2base equ 01a8h

+ast0_2irq  equ 5

+ast0_3base equ 01b0h

+ast0_3irq  equ 5

+ast0_4base equ 01b8h

+ast0_4irq  equ 5

+ast1_1base equ 02a0h

+ast1_1irq  equ 5

+ast1_2base equ 02a8h

+ast1_2irq  equ 5

+ast1_3base equ 02b0h

+ast1_3irq  equ 5

+ast1_4base equ 02b8h

+ast1_4irq  equ 5

+

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+ 

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+   if at

+     channel 0,archive,archive_0

+   else

+     channel 0,archive,archive_1

+   endif

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+    if ast

+     channel 4,i8250,ast0_1ccb

+     channel 5,i8250,ast0_2ccb

+     channel 6,i8250,ast0_3ccb

+     channel 7,i8250,ast0_4ccb

+     channel 8,i8250,ast1_1ccb

+     channel 9,i8250,ast1_2ccb

+     channel 10,i8250,ast1_3ccb

+     channel 11,i8250,ast1_4ccb

+    else

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     channel 11,i8250,add4_3ccb

+     channel 12,i8250,add4_4ccb

+     channel 13,i8250,add4_8ccb

+     endif

+    endif

+     channel 15,parallel,para0ccb

+     channel 14,parallel,para1ccb

+     channel 16,parallel,para2ccb

+   if at and not ramsys

+     channel 31,archive,archive_1

+   else

+     channel 31,archive,archive_0

+   endif

+     channel -1,nilchannel,0

+ 

+

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+;    include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+    if ast

+     i8250_ccb ast0_1,4

+     i8250_ccb ast0_2,5

+     i8250_ccb ast0_3,6

+     i8250_ccb ast0_4,7

+     i8250_ccb ast1_1,8

+     i8250_ccb ast1_2,9

+     i8250_ccb ast1_3,10

+     i8250_ccb ast1_4,11

+    else

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     i8250_ccb add4_3,11

+     i8250_ccb add4_4,12

+     i8250_ccb add4_8,13

+     endif

+    endif

+     para_ccb 0,15

+     para_ccb 1,14

+     para_ccb 2,16

+     archive_ccb 0,0

+     archive_ccb 1,0

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/HARDWARE.ASM b/system/shard-x86-at/7/src/HARDWARE.ASM
new file mode 100644
index 0000000..88b66dd
--- /dev/null
+++ b/system/shard-x86-at/7/src/HARDWARE.ASM
@@ -0,0 +1,16 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Lesen des Hardware Kennzeichen-Bytes                                   *

+;*                                                                          *

+;****************************************************************************

+

+hardware:

+     push es

+     mov ax,0ffffh

+     mov es,ax

+     mov al,byte ptr es:14          ;hardware byte holen

+     pop es

+     ret

+

+

diff --git a/system/shard-x86-at/7/src/HDISK.ASM b/system/shard-x86-at/7/src/HDISK.ASM
new file mode 100644
index 0000000..67044d4
--- /dev/null
+++ b/system/shard-x86-at/7/src/HDISK.ASM
@@ -0,0 +1,482 @@
+;shard  segment

+;       assume cs: shard

+;       assume ds: shard, es:nothing, ss:nothing

+

+;================================================================

+;       modul hdisk.asm

+;       hard - disk - treiber

+;

+;  Status:

+;       0.0     13.11.84        erste Testversion

+;================================================================

+

+TIMEOUT1        equ     20h             ; warten auf Disk-Interrupt

+                                        ; (20.0000h  Tests)

+

+;-------------------------------------------------------;

+;       Fehlercodes

+;       Bem: 11h ist eigentlich  k e i n  Fehler !

+;-------------------------------------------------------;

+

+;sense_fail      equ     0ffh            ; sense operation

+;undef_err       equ     0bbf            ; undefined error occurred

+;time_out        equ     80h             ; attachment failed to respond

+;bad_seek        equ     40h             ; seek operation failed

+;bad_cntlr       equ     20h             ; controller has failed

+;data_corrected  equ     11h             ; ecc corrected data error

+;bad_ecc         equ     10h             ; bad ecc on disk read

+;bad_track       equ     0bh             ; bad track flag detected

+;dma_boundary    equ     9               ; attempt to dma across 64k

+;init_fail       equ     7               ; drive parameter activity failed

+;bad_reset       equ     5               ; reset failed

+;record_not_fnd  equ     4               ; requested sector not found

+;bad_addr_mark   equ     2               ; address mark not found

+;bad_cmd         equ     1               ; bad command passed to disk i/o

+

+;-------------------------------------------------------;

+;       interrrupt and status area                      ;

+;-------------------------------------------------------;

+

+dummy           segment at 0

+

+                org 0dh *4

+hdisk_int       label dword

+                

+                org 13h * 4

+org_vector      label dword

+                org 19h *4

+hf_tbl_vec      label dword

+dummy           ends

+

+;-----------------------------------------------------------------------;

+;       cmd_block

+;

+;  +0   Kommando

+;  +1   Kopfnummer                              Aufrufparameter 1

+;  +2   2-Bit Zylinder  & Rest Sektor           Aufrufparameter 2

+;  +3   Zylinder                                Aufrufparameter 3

+;  +4   Block - Count   (ist immer 1 )

+;  +5   Control-Byte (Step - Option)

+;-----------------------------------------------------------------------;

+

+cmd_block       label byte

+hd_error        db 7 dup(?)

+disk_status     db ?

+

+;-------------------------------------------------------;

+;       hardware specific values                        ;

+;                                                       ;

+; - Controller i/o port                                 ;

+;   > when ready from:                                  ;

+;       hf_port+0 - read data (from controller to cpu   ;

+;       hf_port+1 - read controller hardware status     ;

+;               (controller to cpu)                     ;

+;       hf_port+2 - read configuration switches         ;

+;       hf_port+3 - not used                            ;

+;  < when written to:                                   ;

+;       hf_port+0 - write data (from cpu to controller) ;

+;       hf_port+1 - controller reset                    ;

+;       hf_port+2 - generate controller select pulse    ;

+;       hf_port+3 - write pattern to dma and interrupt  ;

+;                   mask register                       ;

+;-------------------------------------------------------;

+

+hf_port         equ     320h            ; disk port

+r1_busy         equ     00001000b       ; disk port 1 busy bit

+r1_bus          equ     00000100b       ;       command/data bit

+r1_iomode       equ     00000010b       ;       mode bit

+r1_req          equ     00000001b       ;       request bit

+

+dma_read        equ     01000111b       ; channel 3 (47h)

+dma_write       equ     01001011b       ; channel 3 (4bh)

+dma             equ     0               ; dma address

+dma_high        equ     82h             ; port for high 4 bits of dma

+

+tst_rdy_cmd     equ     0               ; cntrl ready (00h)

+recal_cmd       equ     00000001b       ;       recal (01h)

+sense_cmd       equ     00000011b       ;       sense (03h)

+fmtdrv_cmd      equ     00000100b       ;       drive (04h)

+chk_trk_cmd     equ     00000101b       ;       t chk (05h)

+fmttrk_cmd      equ     00000110b       ;       track (06h)

+fmtbad_cmd      equ     00000111b       ;       bad   (07h)

+read_cmd        equ     00001000b       ;       read  (08h)

+write_cmd       equ     00001010b       ;       write (0ah)

+seek_cmd        equ     00001011b       ;       seek  (0bh)

+init_drv_cmd    equ     00001100b       ;       init  (0ch)

+rd_ecc_cmd      equ     00001101b       ;       burst (00h)

+rd_buff_cmd     equ     00001110b       ;       buffr (0eh)

+wr_buff_cmd     equ     00001111b       ;       buffr (0fh)

+ram_diag_cmd    equ     11100000b       ;       ram   (e0h)

+chk_drv_cmd     equ     11100011b       ;       drv   (e3h)

+cntrl_diag_cmd  equ     11100100b       ;       cntlr (e4h)

+rd_long_cmd     equ     11100101b       ;       rlong (e5h)

+wr_long_cmd     equ     11100110b       ;       wlong (e6h)

+

+int_ctl_port    equ     20h             ; 8259 control port

+eoi             equ     20h             ; end of interrupt command

+

+        page

+

+;===============================================================;

+;       MAIN - Routine

+; Input:

+;       ah      -       0 write disk

+;               -       1 read disk

+;       (es:bx) -       Datenadresse

+;       cmd_block

+; Output:

+;       disk_status     0 - alles OK

+;===============================================================;

+

+hard_dsk        proc

+;       mov     ax,0                    ; interrupt initiieren

+;       mov     es,ax

+;       mov     word ptr es:[hdisk_int+2],cs

+;       mov     word ptr es:[hdisk_int],offset hd_int

+

+        sti                             ; enable interrupts

+        mov     disk_status,0           ; noch alles ok !

+        mov     cmd_block+5,5           ; 70 ysec steprate

+        cmp     ah,0                    ; ah = 0  --> write disk

+        jz      a4                      ; ah <> 0 --> read disk

+        call    disk_read

+        jmp     short   dsbl

+a4:     call    disk_write

+

+;-------------------------------------------------------;

+;       dsbl

+;       make shure that all housekeeping is done

+;       before exit

+;-------------------------------------------------------;

+

+dsbl:

+        mov     dx,hf_port+3

+        sub     al,al

+        out     dx,al                   ; reset int/dma mask

+        mov     al,7

+        out     dma+10,al               ; set dma - mode to disable

+        cli                             ; disable interrupts

+        in      al,21h

+        or      al,20h

+        out     21h,al                  ; disable interrupt 5

+        sti                             ; enable interrupts

+        ret

+

+hard_dsk        endp

+

+;========================================================

+;       disk read routine

+; Input:

+;       (es:bx) -       Datenadresse

+;       cmd_block

+;========================================================

+

+disk_read       proc    near

+        mov     al,dma_read             ; mode byte for dma read

+        mov     cmd_block+0,read_cmd

+        jmp     do_io

+disk_read       endp

+

+;========================================================

+;       disk write routine

+; Input:

+;       (es:bx) -       Datenadresse

+;       cmd_block

+;========================================================

+

+disk_write      proc    near

+        mov     al,dma_write            ; mode byte for dma write

+        mov     cmd_block+0, write_cmd

+        jmp     do_io

+disk_write      endp

+        page

+;========================================================

+;       do_io

+;       gemeinsame Routine fuer alle Kommandos

+; Input:

+;       (es:bx) -       Datenadresse

+;       al      -       mode (dma_read/dma_write)

+;       cmd_block

+;========================================================

+

+do_io   proc near

+

+        mov     cmd_block+4,1           ; Blockzahl immer 1

+

+;-------------------------------------------------------;

+;       DMA_SETUP

+;       diese Routine dressiert den DMA

+;-------------------------------------------------------;

+

+        cli                             ; keine Interrupts mehr

+        out     dma+12,al               ; first/last ff setzen

+        push    ax                      ; warten ?

+        pop     ax

+        out     dma+11,al               ; mode setzen

+

+;-----phys. Adresse zum DMA ausgeben:

+

+        mov     ax,es

+        mov     cl,4

+        rol     ax,cl                   ; h - nibble von es nach al

+        mov     ch,al

+        and     al,0f0h

+        add     ax,bx

+        jnc     j33

+        inc     ch                      ; Uebertrag notieren

+j33:    out     dma+6,al                ; a0 - a7 ausgeben

+        push    ax                      ; fuer Ueberlauftest merken

+        mov     al,ah

+        out     dma+6,al                ; a8 - a15 ausgeben

+        mov     al,ch

+        and     al,0fh

+        out     dma_high,al             ; a16 - a19 ausgeben

+

+;-----Blocklaenge zum DMA ausgeben:

+

+        mov     ax,511                  ; Blocklaenge

+        out     dma+7,al                ; Blocklaenge ausgeben

+        mov     al,ah

+        out     dma+7,al

+        sti                             ; Interrupts scharfmachen

+        pop     ax

+        add     ax,511                  ; 64k Overflow testen

+        jnc     gx                      ; wenn kein Overflow

+        mov     disk_status, dma_boundary

+        ret

+

+gx:     call command

+        jc      error_chk               ; wenn was schiefgelaufen ist

+

+        mov     al,3                    ; controller dma/interrupt register mask

+        out     dma+10,al               ; initialize the disk channel

+g3:

+        in      al,21h

+        and     al,0dfh

+        out     21h,al

+

+;-------------------------------------------------------;

+;       wait_int

+;       this routine waits for the fixed disk

+;       controller to signal, that an interrupt

+;       has occured

+;-------------------------------------------------------;

+

+        sti                             ; muss das nochmal sein ???

+        push    es

+        push    si

+

+;----- set timeout values

+        sub     bh,bh

+        mov     bl,TIMEOUT1             ; timout Zaehler setzen (high word)

+        sub     cx,cx

+

+;----- wait for interrupt

+w1:

+        push    ds

+        push    bx

+        push    cx

+        call    cs:warte                   ; nicht dumm rumloopen, sondern

+        pop     cx                      ;    arbeiten !!

+        pop     bx

+        pop     ds

+

+        mov     dx,hf_port+1

+        in      al,dx

+        and     al,20h

+        cmp     al,20h

+        jz      w2

+        loop    w1

+        dec     bx

+        jnz     w1

+        mov     disk_status,time_out

+

+w2:     mov     dx, hf_port

+        in      al,dx

+        and     al,2

+        or      disk_status,al          ; Fehler merken

+        mov     dx,hf_port+3

+        xor     al,al

+        out     dx,al

+        pop     si

+        pop     es

+

+;-----------------------------------------------;

+;       error_chk                               ;

+;-----------------------------------------------;

+

+error_chk:

+        ret                             ; zunaechst keine Fehler- Auswertung

+        mov     al,disk_status

+        or      al,al

+        jnz     g21

+        ret

+

+;-----perform sense status

+

+g21:    mov     ax, shard

+        mov     es,ax

+        sub     ax,ax

+        mov     di,ax

+        mov     cmd_block+0, sense_cmd

+        sub     al,al

+        call    command

+        jc      sense_abort

+        mov     cx,4

+g22:

+        call    hd_wait_req

+        jc      g24

+        mov     dx,hf_port

+        in      al,dx

+        mov     hd_error[di],al

+        inc     di

+        mov     dx,hf_port+1

+        loop    g22

+        call    hd_wait_req

+        jc      g24

+        mov     dx,hf_port

+        in      al,dx

+        test    al,2

+        jz      stat_err

+sense_abort:

+        mov     disk_status, sense_fail

+g24:

+        stc

+        ret

+do_io   endp

+

+;========================================================

+;       command

+;       erklaert dem controller, was zu tun ist

+;   input

+;       cmd_block

+;========================================================

+

+command proc    near

+

+        mov     dx,hf_port+2

+        out     dx,al                   ; controller select pulse ausgeben

+        mov     dx,hf_port+3

+        mov     al,3            ; controller dma/interrupt register mask

+        out     dx,al                   ; DMA und Interrupt-Maske setzen

+

+; eigentlich ist es nicht normal, wenn der Controller an dieser

+; Stelle beschaeftigt ist, aber wer weiss ...

+

+        sub     cx,cx                   ; timeout - Zaehler setzen

+        mov     dx,hf_port+1

+wait_busy:

+        in      al,dx                   ; status lesen

+        and     al,0fh

+        cmp     al,r1_busy or r1_bus or r1_req

+        je      weiter_gehts            ; weiter, wenn controller frei

+        loop    wait_busy               ; warten...

+        mov     disk_status, time_out   ; is nix

+        stc

+        ret

+

+weiter_gehts:

+        cld                             ; clear direction flag

+        mov     cx,6                    ; Blocklaenge fuer move

+        mov     si, offset cmd_block

+

+cm3:    mov     dx,hf_port              ; Command-Block ausgeben

+        lodsb                           ; 

+        out     dx,al

+        loop    cm3

+

+        inc     dx                      ; weiter nach hf_port+1

+        in      al,dx                   ; status lesen

+        test    al,r1_req

+        jz      cm7                     ; wenn alles ok

+        mov     disk_status, bad_cntlr  ; war nix

+        stc

+cm7:

+        ret

+command endp

+

+

+;================================================================

+;       hd_int

+;================================================================

+

+hd_int  proc    near

+        push    ax

+        mov     al,eoi                  ; end of interrupt

+        out     int_ctl_port,al

+        mov     al,7                    ; set dma mode to disable

+        out     dma+10,al

+        in      al,21h

+        or      al,20h

+        out     21h,al

+        pop     ax

+        iret

+hd_int  endp

+

+

+t_0     dw      type_0

+t_1     dw      type_1

+t_2     dw      type_2

+t_3     dw      type_3

+

+

+stat_err:

+        mov     bl,es:hd_error          ; get error byte

+        mov     al,bl

+        and     al,0fh

+        and     bl,00110000b

+        sub     bh,bh

+        mov     cl,3

+        shr     bx,cl

+        jmp     word ptr cs:[bx + offset t_0]

+

+type0_table     label byte

+        db      0, bad_cntlr, bad_seek, bad_cntlr, time_out, 0, bad_cntlr

+        db      0, bad_seek

+type0_len       equ     $-type0_table

+

+type1_table     label   byte

+        db      bad_ecc, bad_ecc, bad_addr_mark, 0, record_not_fnd

+        db      bad_seek, 0, 0, data_corrected, bad_track

+type1_len       equ     $-type1_table

+

+type2_table     label byte

+        db      bad_cmd, bad_addr_mark

+type2_len       equ     $-type2_table

+

+type3_table     label   byte

+        db      bad_cntlr, bad_cntlr, bad_ecc

+type3_len       equ     $-type3_table

+

+type_0:

+                ret

+type_1:

+                ret

+type_2:

+                ret

+type_3:

+                ret

+

+;================================================================

+;       hd_wait_req

+;================================================================

+

+hd_wait_req     proc near

+        push    cx

+        sub     cx,cx                   ; timeout - Zaehler setzen

+        mov     dx,hf_port + 1

+l1:

+        in      al,dx

+        test    al,r1_req

+        jnz     l2                      ; wenn ok

+        loop    l1

+        mov     disk_status, time_out

+        stc

+l2:

+        pop     cx

+        ret

+hd_wait_req     endp

+

+

+;       end

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/HSHARD.ASM b/system/shard-x86-at/7/src/HSHARD.ASM
new file mode 100644
index 0000000..1a2100a
--- /dev/null
+++ b/system/shard-x86-at/7/src/HSHARD.ASM
@@ -0,0 +1,245 @@
+  page 80,132

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 80286, 8086, 8088 Systemen                            *

+;*                                                                            *

+;*       SHard Version 7-PC/XT, PC/AT                                         *

+;*                                                                            *

+;*       Copyright (C) 1985, 86 Martin Schoenbeck, Spenge                     *

+;*                                                                            *

+;******************************************************************************

+

+

+com2wrongirq equ 0

+add4 equ 0

+ast equ 0

+

+at equ 0 

+gensys equ 0

+ramsys equ 0

+pcxt equ 1

+pcd equ 0

+romharddisk equ 0

+romfloppy equ 0

+limited_to_360 equ 0

+boot_size equ 0

+

+hdsystem equ 1

+withhd equ 1

+

+setup_channel equ 28

+dos_channel equ 29

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+

+shstart:

+     jmp los_gehts

+

+     even

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     org 0a0h			;bei wort 80 beginnen

+     include PATCHARE.ASM

+

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+ if com2wrongirq

+   com2irq equ 5

+ else

+   com2irq  equ 3

+ endif

+ if add4

+com4_1base equ 03e8h

+com4_1irq  equ 3

+com4_2base equ 03e0h

+com4_2irq  equ 3

+com4_3base equ 02f0h

+com4_3irq  equ 3

+com4_4base equ 02e8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 0260h

+com8_2irq  equ 3

+com8_3base equ 02d8h

+com8_3irq  equ 3

+ else

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+add4_3base equ 03e8h

+add4_3irq  equ 3

+add4_4base equ 03e0h

+add4_4irq  equ 3

+add4_8base equ 0260h

+add4_8irq  equ 3

+ endif

+ast0_1base equ 01a0h

+ast0_1irq  equ 5

+ast0_2base equ 01a8h

+ast0_2irq  equ 5

+ast0_3base equ 01b0h

+ast0_3irq  equ 5

+ast0_4base equ 01b8h

+ast0_4irq  equ 5

+ast1_1base equ 02a0h

+ast1_1irq  equ 5

+ast1_2base equ 02a8h

+ast1_2irq  equ 5

+ast1_3base equ 02b0h

+ast1_3irq  equ 5

+ast1_4base equ 02b8h

+ast1_4irq  equ 5

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+     channel 0,fixdisk,hgccb0

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+    if ast

+     channel 4,i8250,ast0_1ccb

+     channel 5,i8250,ast0_2ccb

+     channel 6,i8250,ast0_3ccb

+     channel 7,i8250,ast0_4ccb

+     channel 8,i8250,ast1_1ccb

+     channel 9,i8250,ast1_2ccb

+     channel 10,i8250,ast1_3ccb

+     channel 11,i8250,ast1_4ccb

+    else

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     channel 11,i8250,add4_3ccb

+     channel 12,i8250,add4_4ccb

+     channel 13,i8250,add4_8ccb

+     endif

+    endif

+;    channel 4,i8250,com3ccb

+;    channel 5,i8250,com4ccb

+     channel 15,parallel,para0ccb

+     channel 14,parallel,para1ccb

+     channel 16,parallel,para2ccb

+     channel 28,fixdisk,hgccb1

+     channel 29,fixdisk,hgccb2

+  if 0 

+     channel 30,archive,archive_0

+     channel 31,archive,archive_1

+  else

+     channel 31,archive,archive_0

+     channel 30,archive,archive_1

+  endif

+     channel -1,nilchannel,0

+ 

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+     include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+    if ast

+     i8250_ccb ast0_1,4

+     i8250_ccb ast0_2,5

+     i8250_ccb ast0_3,6

+     i8250_ccb ast0_4,7

+     i8250_ccb ast1_1,8

+     i8250_ccb ast1_2,9

+     i8250_ccb ast1_3,10

+     i8250_ccb ast1_4,11

+    else

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     i8250_ccb add4_3,11

+     i8250_ccb add4_4,12

+     i8250_ccb add4_8,13

+     endif

+    endif

+     para_ccb 0,15

+     para_ccb 1,14

+     para_ccb 2,16

+ ;erlaubt drivetypen: highdensity, drive720

+    if at

+     archive_ccb 0,highdensity

+     archive_ccb 1,0 ;drive720

+    else

+     archive_ccb 0,0

+     archive_ccb 1,0

+    endif 

+     fix_ccb 0

+     fix_ccb 1

+     fix_ccb 2

+

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/I8250.ASM b/system/shard-x86-at/7/src/I8250.ASM
new file mode 100644
index 0000000..cb69233
--- /dev/null
+++ b/system/shard-x86-at/7/src/I8250.ASM
@@ -0,0 +1,436 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Routinen fuer 8250 UART im EUMEL - System                             *

+;*                                                                         *

+;*                                                                         *

+;***************************************************************************

+

+i8250_data equ 0

+i8250_ier  equ 1                 ;interrupt enable register

+i8250_iir  equ 2                 ;interrupt indicator register

+i8250_lcr  equ 3                 ;line control register

+i8250_mcr  equ 4                 ;modem control register

+i8250_lsr  equ 5                 ;line status register

+i8250_msr  equ 6                 ;modem status register

+

+     device i8250

+

+     dtcbroutines iocontrol

+     routine 1,i8250_devicetype

+     routine 2,frout

+     routine 3,i8250_stop

+     routine 4,i8250_weiter

+     routine 5,nil_size

+     routine 6,priv_op_question

+     routine 8,priv_op_question

+     routine 9,priv_op_question

+     routine -2,frout

+     routine -3,i8250_status

+     routine -4,stream_in_count

+     routine -5,stream_out_count

+     routine -6,i8250_sendbreak

+     routine -10,i8250_i_stop

+     routine -11,i8250_i_weiter

+     routine -1,unknowncontrol

+

+     dtcbroutines control32

+     routine 6,i8250_flow

+     routine 8,i8250_baud

+     routine 9,i8250_bits

+     routine -2,i8250_init

+     routine -3,i8250_test

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams i8250_output,3   ;typ = nur stream io

+

+

+;******************************************************************

+;*   der macro i8250_ccb muss fuer jeden 8250 im system einmal

+;*   aufgerufen werden

+;*

+;*   parameter: 

+

+i8250_ccb macro i8250,kanal

+i8250&buf db 100 DUP (0ffh)

+     startccb i8250&ccb,kanal

+     stream 100,i8250&buf        ;;die 8250 routinen benutzen stream routinen

+ccbentry i8250_stat

+     db 0

+ccbentry i8250_statusandmask

+     db 0                        ;;keine statusleitungen abfragen

+ccbentry i8250_statusxormask

+     db 0

+ccbentry i8250_errmask

+     db 0                        ;;keine fehler auswerten

+ccbentry i8250_errflags

+     db 0

+ccbentry i8250_irq_line

+     db i8250&irq

+ccbentry i8250_base

+     dw i8250&base

+ccbentry i8250_next_ccb

+     dw 0

+ccbentry i8250_int_entry

+     call i8250_interrupt

+     endm

+

+;*** bits in i8250_stat:

+i8250_rtscts equ 1

+i8250_exists equ 2

+

+i8250_baud_table:

+     dw 2304                     ;50 

+     dw 1536                     ;75

+     dw 1047                     ;110

+     dw 857                      ;134.5

+     dw 768                      ;150

+     dw 384                      ;300

+     dw 192                      ;600

+     dw 96                       ;1200

+     dw 64                       ;1800

+     dw 48                       ;2400

+     dw 32                       ;3600

+     dw 24                       ;4800

+     dw 16                       ;7200

+     dw 12                       ;9600

+

+

+i8250_devicetype:

+     mov cx,0                      ;erstmal 0 setzen

+     test byte ptr [di+i8250_stat],i8250_exists ;ist da einer

+     ifnz <mov cl,shard:(si+devtype)>     ;type dazu

+     ret

+

+

+

+

+i8250_test:

+     cmp bh,0                    ;abfrage

+     ifnz <int 0bh>

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir            ;auf interrupt indicator register

+     in al,(dx)

+     mov cl,al

+     mov ch,1

+     ret

+

+i8250_init:

+     mov ax,0

+     mov es,ax

+; pruefen, ob ueberhaupt vorhanden

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir         ;interrupt indicate register holen

+     jmp short $+2

+     in al,dx

+     nop                      ;der in befehl erwischt einen von diesen

+     nop                      ;codes, wenn auf der adresse kein port ist

+     nop

+     nop

+     nop

+     test al,0f8h             ;alle bits weg, die nicht da sein koennen

+     ifnz <ret>               ;keine schnittstelle da

+     or byte ptr [di+i8250_stat],i8250_exists ;da ist einer

+

+     mov bx,first_ictlr_int

+     add bl,(di+i8250_irq_line)  ;an welchem pin des controllers haengt er

+                                 ;carry kann hier nicht auftreten

+     mov byte ptr i8250_initint,bl ;fuer passenden initialisierungsint basteln

+     add bx,bx                   ;*2 als wortadresse

+     mov dx,word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx] ;letzten ccb holen

+     mov word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx],di ;neuen eintragen

+     mov (di+i8250_next_ccb),dx  ;alten selbst merken

+     add bx,bx                   ;*4

+     mov word ptr es:[bx+2],cs

+     mov dx,di                   ;adresse ccb holen

+     add dx,i8250_int_entry      ;adresse interrupt routine errechnen

+     mov word ptr es:[bx],dx     ;eintragen

+     mov cl,(di+i8250_irq_line)  ;nochmal bit im controller

+     inc cl                      ;mindestens einmal shiften

+     stc

+     mov ch,0                    ;mit nichts anfangen

+     rcl ch,cl

+     in al,int_ctlr+1            ;interrupt enable register holen

+     or al,ch                    ;bit fuer i8250 setzen 

+     xor al,ch                   ;und freigeben

+     out int_ctlr+1,al

+     mov dx,(di+i8250_base)

+     add dx,i8250_ier            ;auf interrupt enable register

+     mov al,0fh                  ;alle interrupts an

+     out dx,al                   ;interrupt enable

+     add dx,i8250_mcr-i8250_ier  ;auf modem control register

+     mov al,0bh                  ;rts, dtr, int enable

+     out dx,al

+;    ret

+i8250_initint = $+1

+     int 12

+     ret

+

+i8250_i_tab:

+     dw 0                        ;int 3

+     dw 0                        ;int 4

+     dw 0                        ;int 5

+     dw 0                        ;int 6

+     dw 0                        ;int 7

+

+i8250_interrupt:

+     push ds

+     push cx

+     push di

+     push bx

+     push dx

+     push ax

+     mov ax,cs

+     mov ds,ax                   ;ds = cs setzen

+     mov bx,sp                   ;auf stack zeigen

+     mov di,ss:[bx+12]           ;return adresse im ccb holen

+     sub di,i8250_int_entry+3    ;auf anfang ccb rechnen

+i8250_to_first_ccb:

+     push di                     ;ersten ccb merken

+     mov ah,1                    ;bis jetzt keinen port gefunden

+i8250_check_same_int:

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir            ;interrupt indicate register lesen

+     in al,(dx)

+     test al,1                   ;war interrupt auf diesem kanal

+     jnz i8250_int_end

+     mov ah,0                    ;ax als index, gleichzeitig ah loeschen

+     push ax

+     mov bx,ax

+     call word ptr i8250_int_table[bx]    ;passende service routine aufrufen

+     pop ax

+     jmp i8250_check_same_int

+

+i8250_int_end:

+     mov di,(di+i8250_next_ccb)  ;naechsten port fuer diesen vektor holen

+     or di,di                    ;ende eintrag?

+     jnz i8250_check_same_int

+     pop di                      ;ersten ccb holen

+     or ah,ah                    ;haben wir im letzten durchlauf einen gefunden

+     jz i8250_to_first_ccb       ;ja, dann weiter suchen

+     mov al,20h                  ;end of interrupt

+     out int_ctlr,al

+     pop ax

+     pop dx

+     pop bx

+     pop di

+     pop cx

+     pop ds

+     pop cs:[i8250_ret_dummy]    ;return adresse im ccb vergessen

+     iret                        ;fertig

+

+i8250_ret_dummy dw 0

+

+i8250_int_table:

+     dw offset i8250_out_restart ;bei ext. status wechsel oder bei tx empty

+     dw offset i8250_out_restart ;nur output ggf. neu starten

+     dw offset i8250_rec_int

+     dw offset i8250_error_int

+

+

+i8250_baud:

+     cmp bh,15                   ;negativer wert oder > 15

+     jnc i8250_not_ok

+     cmp bh,0

+     jz i8250_not_ok

+     test bl,1                   ;abfage?

+     jnz i8250_ok                ;ja, wir koennen alles

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr            ;line control register

+     cli                         ;nichts dazwischen lassen

+     in al,dx                    ;alten wert holen

+     push ax

+     mov al,80h

+     out dx,al                   ;auf baudrate register schalten

+     sub dx,i8250_lcr            ;wieder auf base

+     mov bl,bh                   ;baudrate schluessel nach bx ausdehnen

+     mov bh,0

+     sal bx,1                    ;ein baudrate eintrag ist zwei byte

+     mov ax,word ptr i8250_baud_table-2[bx] ;passenden baudrate eintrag holen

+     out dx,al                   ;low byte raus

+     mov al,ah

+     inc dx

+     out dx,al                   ;high byte raus

+     pop ax

+     add dx,i8250_lcr-1          ;wieder auf lcr

+     out dx,al                   ;alte lcr wieder setzen

+     sti                         ;jetzt darf er wieder

+     jmp short i8250_ok          ;alles klar

+     ret

+

+i8250_bits:

+     test bh,0a0h                ;negativer wert oder 1.5 Stopbits

+     jnz i8250_not_ok

+     test bh,4                   ;bitzahl >= 5

+     jz i8250_not_ok             ;nein, muss aber

+     test bl,1                   ;abfrage

+     jnz i8250_ok

+     mov al,bh                   ;anfoderung nach al

+     test al,10h                 ;gerade paritaet?

+     jz i8250_not_even

+     or al,8                     ;dann paritaet auch enablen

+i8250_not_even:

+     test al,40h                 ;2 stopbits

+     jnz i8250_not_two           ;nein, das bit steht schon

+     and al,0ffh-4               ;bit ausknipsen

+i8250_not_two:

+     and al,1fh                  ;alle unbenutzten loeschen

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr            ;auf line control register

+     out dx,al

+     mov cl,bh                   ;anzahl bits nach cl

+     and cl,7                    ;ausblenden

+     inc cl                      ;aus 0-7 1-8 machen

+     mov dx,0ffh                 ;von 0 bits ausgehen

+     shl dl,cl                   ;bits anzahl nullen reinziehen

+     xor dl,0ffh                 ;und 1 und 0 tauschen

+     call set_out_mask

+     call set_inp_mask

+     call set_inp_errmask

+i8250_ok:

+     mov cx,0

+     ret

+

+i8250_not_ok:

+     mov cx,1

+     ret

+

+i8250_flow:

+     test bh,80h                 ;negativer wert?

+     jnz i8250_not_ok

+     cmp bh,3

+     jnc i8250_not_ok            ;oder > 2

+     test bl,1                   ;abfrage

+     jnz i8250_ok                ;ja

+   cli

+     mov byte ptr (di+i8250_statusxormask),0 ;beim status nichts abfragen

+     mov byte ptr (di+i8250_statusandmask),0

+     and byte ptr (di+i8250_stat),0ffh-i8250_rtscts ;handshake ausschalten

+     dec bh

+     jnz i8250_not_xonxoff

+     call enablexon

+     jmp i8250_flow_end

+i8250_not_xonxoff:

+     call disablexon

+     dec bh

+     jnz i8250_flow_end

+     mov byte ptr (di+i8250_statusandmask),10h ;cts abfragen

+     mov byte ptr (di+i8250_statusxormask),10h ;auf gesetzt

+     or byte ptr (di+i8250_stat),i8250_rtscts

+i8250_flow_end:

+     call i8250_out_restart      ;immer probieren, ob jetzt output moeglich

+     sti

+     jmp i8250_ok

+

+i8250_output:

+     call fillbuffer

+     pushf

+     jz i8250_no_orest

+     call i8250_out_restart

+i8250_no_orest:

+     popf

+     ret

+

+;* out_restart kann jederzeit aufgerufen werden, da der status jedesmal

+;* abgefragt wird

+i8250_out_restart:

+     mov dx,(di+i8250_base)      ;commandport laden

+     add dx,i8250_lsr            ;adresse line status register

+    cli

+     in al,(dx)                  ;status holen

+     test al,20h                 ;tx buffer empty

+     lahf                        ;modem status register immer lesen

+     inc dx                      ;auf modem status register

+     in al,(dx)                  ;holen

+     sahf

+     jz i8250_stiret             ;nein, sti und zurueck

+     and al,(di+i8250_statusandmask) ;gewuenschte bits ausblenden

+     xor al,(di+i8250_statusxormask)

+     jnz i8250_stiret

+     call getnextchar            ;zeichen holen, xon/xoff etc. abhandeln

+     mov dx,(di+i8250_base)      ;port holen

+     ifnz <out (dx),al>          ;wenn was da, ausgeben

+i8250_stiret:

+    sti

+     ret                         ;fertig

+

+i8250_rec_int:

+     mov dx,(di+i8250_base)

+     in al,(dx)                  ;zeichen holen

+     call input                  ;zeichen uebergeben, xon/xoff etc. abhandeln

+     jz i8250_out_restart        ;ggf. output neu starten

+     ret

+

+i8250_error_int:

+     mov dx,(di+i8250_base)

+     add dx,i8250_lsr            ;line status register holen

+     in al,(dx)

+     or (di+i8250_errflags),al   ;alte errorflags dazu

+     test al,10h                 ;break detected

+     jnz i8250_break

+     and al,(di+i8250_errmask)   ;welche fehlerbits sollen behandelt werden

+     jz i8250_rec_int            ;keine, normal einlesen

+     mov dx,(di+i8250_base)

+     in al,(dx)                  ;zeichen holen

+     call errorinput             ;uebergeben

+     jz i8250_out_restart

+     ret

+

+i8250_break:

+     call breakinput             ;break zeichen uebergeben

+     jz i8250_out_restart

+     ret

+

+i8250_stop:

+     call stream_stop

+     ifnz <call i8250_out_restart> ;output ggf neu starten

+     test byte ptr (di+i8250_stat),i8250_rtscts

+     jz i8250_stop_end

+i8250_i_stop:

+     mov dx,(di+i8250_base)

+     add dx,i8250_mcr            ;auf modem control register

+     mov al,9                    ;rts wegnehmen

+     out (dx),al

+i8250_stop_end:

+     ret

+

+i8250_weiter:

+     call stream_weiter

+     ifnz <call i8250_out_restart> ;output ggf. neu starten

+     test byte ptr (di+i8250_stat),i8250_rtscts

+     jz i8250_stop_end

+i8250_i_weiter:

+     mov dx,(di+i8250_base)

+     add dx,i8250_mcr            ;auf modem control register

+     mov al,0bh                  ;rts wieder setzen

+     out (dx),al

+     ret

+

+i8250_status:

+     cli

+     mov cl,(di+i8250_errflags)    ;fehler holen

+     mov byte ptr (di+i8250_errflags),0 ;loeschen

+     mov dx,(di+i8250_base)

+     add dx,i8250_lsr

+     in al,dx

+     mov ch,al

+     sti

+     ret

+

+i8250_sendbreak:

+     cli

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr

+     in al,dx

+     and al,10111111b            ;switch breakbit off

+     and bl,1                    ;nur ein bit behalten

+     ror bl,1

+     ror bl,1                    ;auf bit 6 position

+     or al,bl                    ;send break or not

+     out dx,al

+     sti

+     ret

diff --git a/system/shard-x86-at/7/src/MAC286.ASM b/system/shard-x86-at/7/src/MAC286.ASM
new file mode 100644
index 0000000..3a1f164
--- /dev/null
+++ b/system/shard-x86-at/7/src/MAC286.ASM
@@ -0,0 +1,23 @@
+iw macro op,reg,count

+ local fbyte,cbyte

+fbyte:

+     op reg,1

+cbyte:

+     org cs:fbyte

+     db 0c1h

+     org cs:cbyte

+     db count

+     endm

+

+ib macro op,reg,count

+ local fbyte,cbyte

+fbyte:

+     op reg,1

+cbyte:

+     org cs:fbyte

+     db 0c0h

+     org cs:cbyte

+     db count

+     endm

+

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/MACROS.ASM b/system/shard-x86-at/7/src/MACROS.ASM
new file mode 100644
index 0000000..c2f8b3a
--- /dev/null
+++ b/system/shard-x86-at/7/src/MACROS.ASM
@@ -0,0 +1,79 @@
+;*************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===============*

+;*                                                                       *

+;*         M A C R O s   fuer   E U M E L   -   U R L A D E R            *

+;*                                                                       *

+;*************************************************************************

+

+   .XLIST

+on  equ  0ffh

+off  equ  0

+

+test  equ  off

+

+deft macro text 

+local textend

+ db (textend-$-1)

+ db &text

+textend label byte

+ endm

+

+ke  macro text

+  local teend

+  call info

+  jmp teend

+  db '&text'

+teend:

+  endm

+

+trcpas  macro  name

+  local trcfield,endtrc

+  if trcswitch

+  push hl

+  ld hl,(trcfield)

+  inc hl

+  ld (trcfield),hl

+  pop hl

+  jr endtrc

+  db '&name'

+trcfield:

+  dw 0

+endtrc:

+  endif

+  endm

+

+

+ifz macro op

+local false

+     jnz false

+     op

+false:

+     endm

+

+ifnz macro op

+local false

+     jz false

+     op

+false:

+     endm

+

+ifc macro op

+local false

+     jnc false

+     op

+false:

+     endm

+

+ifnc macro op

+local false

+     jc false

+     op

+false:

+     endm

+

+popff macro

+     push cs

+     call x_iret

+     endm

+

+  .LIST

diff --git a/system/shard-x86-at/7/src/NILCHAN.ASM b/system/shard-x86-at/7/src/NILCHAN.ASM
new file mode 100644
index 0000000..1ff0108
--- /dev/null
+++ b/system/shard-x86-at/7/src/NILCHAN.ASM
@@ -0,0 +1,53 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Dieses Modul definiert alle Routinen, die benoetigt werden, wenn      *

+;*   ein Kanal nicht existiert oder bestimmte Funktionen nicht durch-      *

+;*   fuehren kann.                                                         *

+;*                                                                         *

+;***************************************************************************

+

+     device nilchannel

+

+     dtcbroutines iocontrol

+          routine 1,devicetype

+          routine 2,frout_ok

+          routine 5,nil_size

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+     dtcbroutines blockout

+          routine -1,no_blockinout

+     dtcbparams nil_output,0            ;output; niltype

+

+nil_size:

+     mov al,0

+     mov cx,0

+     ret

+

+unknowncontrol:

+no_blockinout:

+     mov cx,-1

+     ret

+

+frout_ok:

+     mov cx,200                    ;200 bytes frei

+     stc                           ;puffer leer

+     ret

+

+no_baud:

+no_bits:

+no_flow:

+no_channel_setup:

+     mov cx,1

+     ret

+

+nil_output:

+     stc

+     ret                           ;alle zeichen uebernommen

+

+devicetype:

+     mov ch,0                      ;hoeherwertige teil immer null

+     mov cl,shard:(si+devtype)     ;type dazu

+     ret

diff --git a/system/shard-x86-at/7/src/PATCH.ELA b/system/shard-x86-at/7/src/PATCH.ELA
new file mode 100644
index 0000000..c3f34f1
--- /dev/null
+++ b/system/shard-x86-at/7/src/PATCH.ELA
@@ -0,0 +1,500 @@
+(* SHard-Patcher fuer Schoenbeck AT-Shard V2.7: 

+   - Vortest/Speichertest 

+   - Keyboard Repeatfrequenz 

+   - Baudrates 19200/38400 werden angeboten 

+   - Refresh-Intervall änderbar (bis zu 5% mehr Leistung) 

+   - control (-3,,,r) liefert im Highbyte das Modemstatusregister (RI etc.) 

+   - control (-5,8,,r) geht in ruc-Bios-Graphikmodus (mit Textausgabe: 

+     Text mit 'out', 'put' etc. schreiben, cursor (x, y) mit y:1..43, 

+     Codes ""4"", ""5"", Scroll löschen jetzt vernünftig (Attribut von 7 auf

+     0 geändert), 

+     Achtung: getcursor (x, y) im 'begin plot' einbauen. 

+              cursor (x,y) im 'end plot' einbauen, wegen y<25 im Textmodus!) 

+   - Kanal 30 (Archiv 1) jetzt für MF-Laufwerke (5.25" bzw. 3.5"), Default- 

+              Size ist 1.2MB (Achtung bei Formatieren von 3.5"-Floppys!) 

+   - Mit control (-10/-11,...) ("stop", "weiter") wird an den RS232-Kanälen 

+     jetzt nicht nur RTS active/inactive gesetzt sondern auch DTR (Modem). 

+   - An Kanal 32: 

+     Mit control (-3, x, mcr*32+kanal, r) (mcr ist Modemcontrolregister Wert,

+     x egal) können RTS, DTR explizit gesetzt werden.

+   - id (6) > 0 : SHard wurde gepatcht.

+ 

+   Michael Staubermann, Version 2:   09.10.87, Keyboardrepeat, Baudrates

+                        Version 3:   04.11.87, Graphikcursor & Graphikmodi

+                        Version 3.1: 20.11.87, >32MB Partitionen f. M+ 

+                        Version 4:   04.12.87, TX-Interrupt restart

+                        Version 4.1: 10.01.88, Refresh-Intervall änderbar 

+                        Version 5:   21.02.88, Kanal 30 1.2MB-Format (3.5") 

+                        Version 5.1: 22.02.88,

+*) 

+ 

+LET setup channel = 28 ; 

+ 

+LET max partitions = 4 , 

+    patch version  = 5 ,

+    shard bloecke  = 18 ; 

+ 

+   

+patch shard ; 

+

+ROW shard bloecke ROW 256 INT VAR block ; 

+ROW shard bloecke BOOL VAR modified ; 

+INT VAR old session := 0 ; 

+REAL VAR partition size := 0.0, partition start 1 := 256.0 * 65536.0 -1.0 ; 

+INT VAR i ; 

+FOR i FROM 1 UPTO shard bloecke REP 

+ modified (i) := FALSE 

+PER ; 

+ 

+ROW 256 INT VAR partition table ; 

+ 

+ 

+INT OP & (TEXT CONST hex) : 

+ INT VAR i, h := 0 ; 

+ IF LENGTH hex > 4 THEN errorstop ("OP &: LENGTH > 4") FI ; 

+ FOR i FROM 1 UPTO LENGTH hex REP 

+  rotate (h, 4) ;

+  INT CONST c :: code (hex SUB i) ; 

+  IF c >= 97 AND c <= 102 

+     THEN h := h OR (c-87)

+  ELIF c >= 65 AND c <= 70 

+     THEN h := h OR (c-55)

+  ELIF c >= 48 AND c <= 57 

+     THEN h := h OR (c-48) 

+  ELSE errorstop ("OP &: ungültiges Hexdigit ("+code(c)+")") 

+  FI ; 

+ PER ; 

+ h 

+ENDOP & ; 

+ 

+TEXT OP % (INT CONST int) : 

+ LET hex = "0123456789ABCDEF" ; 

+ TEXT VAR t := "" ; 

+ INT VAR i, r := int ; 

+ FOR i FROM 1 UPTO 4 REP 

+  rotate (r, 4) ; 

+  t CAT (hex SUB ((r AND 15)+1)) ; 

+ PER ; 

+ t 

+ENDOP % ; 

+ 

+PROC poke (INT CONST shard adr, INT CONST byte) : 

+ (* Der Shard beginnt bei 1280 d.h. 0500H, EUCONECT bei 504H (='EUMEL') *) 

+ INT VAR block no, block offset ; 

+ IF shard adr < 256 

+    THEN errorstop ("poke: Adresse < 256") ; 

+         LEAVE poke 

+ FI ; 

+ block offset := shard adr-256 ; 

+ rotate (block offset, -1) ; 

+ block offset := (block offset AND 255) + 1 ;

+ block no := shard adr - 256 ; 

+ rotate (block no, -9) ; 

+ block no := (block no AND 63) + 1 ; 

+ IF block no < 1 OR block no > shard bloecke 

+    THEN errorstop ("poke: falsche Adresse") ; 

+         LEAVE poke 

+ FI ; 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, block (block no)(block offset)) ; 

+ replace (t, (shard adr AND 1) + 1, code (byte AND 255)) ; 

+ modified (block no) := TRUE ; 

+ block (block no)(block offset) := t ISUB 1 ; 

+ENDPROC poke ; 

+ 

+PROC poke2 (INT CONST shard adr, INT CONST word) : 

+ INT VAR r := word ; 

+ poke (shard adr, r) ; 

+ rotate (r, 8) ; 

+ poke (shard adr+1, r) ; 

+ENDPROC poke2 ; 

+ 

+PROC poken (INT CONST shard adr, TEXT CONST str) : 

+ INT VAR i, adr := shard adr ; 

+ i := 1 ; 

+ WHILE i <= LENGTH str REP 

+  IF (str SUB i+2) = " " OR (str SUB i+2) = ""

+     THEN poke (adr, &subtext (str, i, i+1)) ; 

+          i INCR 3 ; 

+          adr INCR 1 

+  ELIF (str SUB i+4) = " " OR (str SUB i+4) = "" 

+     THEN poke2 (adr, &subtext (str, i, i+3)) ; 

+          i INCR 5 ; 

+          adr INCR 2 

+  ELSE errorstop ("poken: Zuviele zusammenhängende Bytes") 

+  FI ; 

+ PER ; 

+ENDPROC poken ; 

+ 

+INT PROC peek (INT CONST shard adr) : 

+ INT VAR block no, block offset ; 

+ block offset := shard adr ; 

+ IF shard adr < 256 

+    THEN errorstop ("peek: Adresse < 256") ; 

+         LEAVE peek WITH 0 

+ FI ; 

+ block offset := shard adr-256 ; 

+ rotate (block offset, -1) ; 

+ block offset := (block offset AND 255) + 1 ;

+ block no := shard adr-256 ; 

+ rotate (block no, -9) ; 

+ block no := (block no AND 63) + 1 ;

+ IF block no < 1 OR block no > shard bloecke 

+    THEN errorstop ("peek: falsche Adresse") ; 

+         LEAVE peek WITH 0

+ FI ; 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, block (block no)(block offset)) ; 

+ code (t SUB ((shard adr AND 1) + 1))  

+ENDPROC peek ; 

+ 

+ 

+INT PROC peek2 (INT CONST shard adr) : 

+ INT VAR r := peek (shard adr + 1) ; 

+ rotate (r, 8) ; 

+ r + peek (shard adr) 

+ENDPROC peek2 ; 

+ 

+ 

+PROC get partition : 

+ INT VAR partition, cyls, heads, secs ; 

+ get media size (setup channel, cyls, heads, secs) ; 

+ get partition table ; 

+ get partition number from user ; 

+ line ; 

+ IF (partition size  high AND -256) <> 0 OR 

+    (partition start high AND -256) <> 0

+    THEN errorstop ("Sorry, Partitionsangaben zu hoch") 

+ FI ; 

+ line ; 

+ partition start1 := real24 (partition start high, partition start low)-1.0; 

+ partition size  := real24 (partition size high, partition size low) ; 

+ putline ("Platte hat " + text (cyls) + " Cylinder, " + text (heads) + 

+          " Heads, " + text (secs) + " Sektoren = " + 

+          text (real(cyls)*real(heads)*real(secs)/2048.0, 5, 1) + " MB") ;

+ putline ("Partionsanfang: " + 

+           text ((partition start 1+1.0)/2.0, 6, 0) + " KB = Cylinder " + 

+           text (int ((partition start 1+1.0)/real(secs)/real(heads)))) ; 

+ putline ("Partionsgrösse: " + text (partition size/2.0, 6, 0) + " KB = " + 

+           text (int (partition size/real(secs)/real(heads))) + " Cylinder"); 

+ put ("Diese Partition ist") ; 

+ IF NOT partition active 

+    THEN put (""15"nicht"14"")

+ FI ; 

+ putline ("aktiviert.") ;

+ line . 

+ 

+get partition table : 

+ blockin (setup channel, partition table, 0.0) . 

+ 

+get partition number from user : 

+ FOR partition FROM 1 UPTO max partitions REP 

+  IF eumel partition CAND yes ("EUMEL-Partiton " + 

+                          text (partition type) + " patchen") 

+     THEN LEAVE get partition number from user 

+  FI 

+ PER ; 

+ partition := 0 ; 

+ errorstop ("Keine EUMEL Partition gefunden") . 

+ 

+ 

+eumel partition : 

+ partition type >= 69 AND partition type <= 72 . 

+ 

+entry               : 216 + partition * 8 . 

+partition active    : bit (partition table (entry), 7) . 

+partition type      : partition table (entry + 2) AND 255 . 

+partition start low : partition table (entry + 4) .

+partition start high: partition table (entry + 5) . 

+partition size  low : partition table (entry + 6) . 

+partition size  high: partition table (entry + 7) . 

+ 

+ENDPROC get partition ; 

+ 

+PROC read shard : 

+ INT VAR i ; 

+ old session := session ; 

+ FOR i FROM 1 UPTO shard bloecke REP 

+  cout (i) ; 

+  modified (i) := FALSE ; 

+  blockin (setup channel, block (i), partition start1 + real(i-1)) 

+ PER ; 

+ENDPROC read shard ; 

+ 

+ 

+PROC write shard : 

+ INT VAR i ; 

+ FOR i FROM 1 UPTO shard bloecke REP 

+  IF modified (i) 

+     THEN IF session <> old session 

+             THEN errorstop ("RERUN während patch") 

+          FI ; 

+          blockout (setup channel, block (i), partition start1+real(i-1)) ; 

+          modified (i) := FALSE 

+  FI ; 

+  cout (i)

+ PER 

+ENDPROC write shard ; 

+ 

+REAL PROC real24 (INT CONST high, low) : 

+ real (high) * 65536.0 + low real . 

+ 

+low real : 

+ IF low < 0 

+    THEN real (low) + 65536.0 

+    ELSE real (low) 

+ FI 

+ENDPROC real24 ;

+ 

+PROC split real24 (REAL CONST r, INT VAR high, low) : 

+ high := int (r/65536.0) ; 

+ low := (code (int (r MOD 256.0)) + 

+         code (int ((r MOD 65536.0)/256.0))) ISUB1

+ENDPROC split real24 ; 

+

+PROC patch shard : 

+ get partition ; 

+ read shard ; 

+ check if patch possible ; 

+ patch baudrate ;

+ patch id and mode ; 

+ patch typematic ;

+ patch refresh ; 

+ patch modem status ; 

+ patch cursor maxima ; 

+ patch attribute bytes ; 

+ patch out restart ; 

+ patch dtr inactive ; 

+ patch mcr set routine ; 

+ patch archive 1 format ; 

+ IF yes ("Änderungen permanent machen") 

+    THEN write shard ; 

+         putline ("Änderungen durchgeführt, System neu booten.") ;

+    ELSE putline ("Keine Änderungen durchgeführt.") ; 

+ FI . 

+ 

+check if patch possible : 

+ IF peek2 (&"0300") <> &"05EA" 

+    THEN errorstop ("Partition enthaelt keinen SHard") 

+    ELSE IF peek2 (shard ver) <> 7 

+            THEN errorstop ("Dies ist die falsche SHard-Version")

+         ELIF peek2 (id6) = patch version 

+            THEN putline ("Hinweis: Dieser SHard wurde bereits gepatcht") 

+         ELIF peek2 (id6) <> 0 

+            THEN putline ("Der SHard-Patch wird upgedated") 

+         FI 

+ FI . 

+ 

+shard ver: &"0554" . 

+mode:      &"0556" . 

+id 6:      &"055C" . 

+ 

+patch baudrate :

+ putline ("Baudrates 50, 75 entfernt, 19200, 38400 eingefügt.") ; 

+ poke2 (&"07E8", 1047) ; (*  3:   110 *) 

+ poke2 (&"07EA",  857) ; (*  4:   134.5 *) 

+ poke2 (&"07EC",  768) ; (*  5:   150 *) 

+ poke2 (&"07EE",  384) ; (*  6:   300 *) 

+ poke2 (&"07F0",  192) ; (*  7:   600 *) 

+ poke2 (&"07F2",   96) ; (*  8:  1200 *) 

+ poke2 (&"07F4",   64) ; (*  9:  1800 *) 

+ poke2 (&"07F6",   48) ; (* 10:  2400 *) 

+ poke2 (&"07F8",   32) ; (* 11:  3600 *) 

+ poke2 (&"07FA",   24) ; (* 12:  4800 *) 

+ poke2 (&"07FC",   16) ; (* 13:  7200 *) 

+ poke2 (&"07FE",   12) ; (* 14:  9600 *) 

+ poke2 (&"0800",    6) ; (* 15: 19200 *) 

+ poke2 (&"0802",    3) ; (* 16: 38400 *) 

+   

+ (* Korrektur der Adressoffsetberechnung auf Baudtable *) 

+ (* Maschinencode nicht veraendern! 

+    08F4: 

+    i8250_baud: 

+      CMP BH,17 

+      JNC i8250_not_ok 

+      CMP BH,3 

+      JC  i8250_not_ok 

+      .... 

+    0918:

+      MOV AX,WORD PTR i8250_baud_table-6[BX] 

+*) 

+ poken (&"08F4", "17 73 75 80 FF 03 72 70") ; 

+ poken (&"0918", "87 E2") . 

+ 

+patch id and mode : 

+ poke2 (id6, patch version) ; (* Update Patch Version *)

+ IF yes ("Soll ein Vortest durchgeführt werden") 

+    THEN IF yes ("Soll ein Speichertest durchgefuehrt werden") 

+            THEN poke2 (mode, 0) 

+            ELSE poke2 (mode, 256) 

+         FI

+    ELSE poke2 (mode, 512) 

+ FI . 

+ 

+patch modem status: 

+  poke (&"0A5D", 6) . (* Modem Status Register Offset = 6 *) 

+ 

+patch typematic: (* Nur mit ruc-Bios *) 

+ INT VAR typematic ; 

+ IF yes ("Schneller Keyboardrepeat") 

+    THEN typematic := 4 (* Fast *) 

+    ELSE typematic := 2 * 256 + 12 (* Standard *) 

+ FI ; 

+ (* Maschinencode, nicht veraendern! 

+ 0E20: 

+   XOR  AX,AX           ; Set Default Video Mode 

+   INT  10H 

+    MOV  AX,0342        ; Set Typematic + Marwin 

+    MOV  BX,typematic   ; BH = Delay (0..3), BL = Rate (0..31) 

+    INT  16H             

+ 0E2C: 

+     MOV  AL,54H        ; Ab hier in 'patch refresh' 

+     OUT  [43H],AL      ; 

+     JMP  $+2           ;

+     MOV  AL,interval   ; interval = 1.19 * us 

+     OUT  [41H],AL      ;

+   RET                  ; End pc_init

+*) 

+ poken (&"0E20", "33 C0 CD 10 B8 42 03 BB " + %typematic + " CD 16 C3") . 

+ (* RET wird ueberschrieben von Refresh *) 

+ 

+patch refresh: 

+ INT VAR refresh ; 

+ TEXT VAR ref := "15.126" ;

+ line ; 

+ putline ("215us Refresh-Intervall bringen 5% mehr RAM-Performance.") ; 

+ putline ("Achtung: Nicht bei allen RAMs moeglich (z.B. 120ns Toshiba nicht).") ;

+ put ("RAM-Refresh Intervall (in us):") ; 

+ editget (ref) ; line ; 

+ refresh := int (1.19 * real (ref) + 0.5) ; 

+ IF refresh < 1 

+    THEN refresh := 1 

+ ELIF refresh > 255 

+    THEN refresh := 256 

+ FI ; 

+ put (real (refresh) / 1.19) ; 

+ putline ("us Refresh-Intervall eingestellt.") ;

+ IF refresh = 256 THEN refresh := 0 FI ; 

+ poken (&"0E2C", "B0 54 E6 43 EB 00 B0 " + subtext (%refresh, 3, 4) + 

+                " E6 41 C3") . 

+ 

+patch cursor maxima: 

+(* Es werden nur die Maxima bei CURSOR(,) veraendert, CLEOL, CLEOP,SCROLL 

+    etc. arbeiten weiter mit 24 Zeilen, 80 Spalten *) 

+ (* CURSOR y:0..43, x:0..89 EUMEL lässt allerdings nur 0..79 zu *)

+ poke (&"0EFF", 43) ; 

+ poke (&"0F16", 89) . 

+ 

+patch attribute bytes: 

+ poke (&"0FD4", 0) ; poke (&"0FE8", 0) ; (* CLEOP *) 

+ poke (&"1002", 0) ; (* CLREOL *) 

+ poke (&"1027", 0) . (* SCROLL *) 

+ 

+patch out restart : 

+ poke (&"09BA", 0) . (* out_restart immer: JP $+0 *) 

+ 

+patch dtr inactive : 

+ poke (&"0A30", 8) . (* RTS + DTR inaktiv, OUT2 muss an bleiben *) 

+ 

+patch mcr set routine :

+ (* 

+  0812: 20 Bytes zur Verfügung

+   MOV  DX,(DI+i8250_base) 

+   ADD  DX,i8250_mcr 

+   MOV  AL,BH        ; Highbyte 2. IOCONTROL Parameter 

+   OUT  [DX],AL 

+   MOV  CX,0 

+   RET 

+  *) 

+ poken (&"0812", "8B 95 1B 00 83 C2 04 88 F8 EE B9 00 00 C3") . 

+ 

+patch archive 1 format :

+ line ; 

+ putline ("Archiv-Kanal 30-Laufwerk (bitte Typnummer angeben):") ; 

+ putline ("  0: Nicht vorhanden") ; 

+ putline ("  1: 360K (Standard/Doublestep)") ; 

+ putline ("  2: 720K (Standard/Singlestep)") ; 

+ putline ("  3: 1.2MB (Multifunction)") ; 

+ putline ("ESC: Nichts verändern") ; 

+ put ("Typ:") ; 

+ TEXT VAR t ; 

+ REP inchar (t) UNTIL t >= "0" AND t <= "3" OR t = ""27"" PER ; 

+ putline (t) ; 

+ line ;

+ IF t = "0" OR t = "1" 

+    THEN poken (&"21DE", "00 01") 

+ ELIF t = "2" 

+    THEN poken (&"21DE", "04 02")

+ ELIF t = "3" 

+    THEN poken (&"21DE", "01 03") 

+ FI . 

+ 

+ENDPROC patch shard ; 

+ 

+PROC blockin (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno) :

+ INT VAR r, my channel :: channel, high, low ; 

+ split real24 (blockno, high, low) ; 

+ continue (kanal) ; 

+ blockin (block, high AND 255, low, r) ; 

+ continue (my channel) ; 

+ SELECT r OF 

+   CASE 0 :

+   CASE 1 : errorstop ("Harddisk kann nicht gelesen werden")

+   CASE 2 : errorstop ("Lesefehler bei Block " + text (blockno))

+   CASE 3 : errorstop ("Block " + text(blockno) + " zu hoch")

+  OTHERWISE errorstop ("unbekannter Lesefehler auf Harddisk")

+ ENDSELECT .

+ 

+ENDPROC blockin ; 

+

+PROC blockout (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno):

+ INT VAR r, my channel :: channel, high, low ; 

+ split real24 (blockno, high, low) ; 

+ continue (kanal) ; 

+ blockout (block, high AND 255, low, r) ; 

+ continue (my channel) ; 

+ SELECT r OF 

+   CASE 0 :

+   CASE 1 : errorstop ("Harddisk kann nicht beschrieben werden")

+   CASE 2 : errorstop ("Schreibfehler bei Block " + text (blockno))

+   CASE 3 : errorstop ("Block " + text (blockno) + " zu hoch")

+  OTHERWISE errorstop ("unbekannter Schreibfehler auf Harddisk")

+ ENDSELECT .

+ 

+ENDPROC blockout ; 

+

+PROC get media size (INT CONST kanal, INT VAR cyls, heads, secs) : 

+ INT CONST old channel :: channel ; 

+ continue (kanal) ;

+ control (-10, 0, 0, cyls) ; cyls INCR 1 ; 

+ control (-11, 0, 0, secs) ;

+ control (-12, 0, 0, heads) ; 

+ continue (old channel)

+ENDPROC get media size ; 

+(*

+PROC dump block (INT CONST adr) : 

+TEXT VAR t ; 

+FOR i FROM adr UPTO adr+511 REP 

+ IF (i AND 15) = 0 

+    THEN line ; 

+         put (%i+":") ; 

+         t := "" ; 

+ FI ;

+ INT CONST j :: peek (i) ; 

+ IF j < 32 OR j > 126 THEN t CAT "." 

+ ELSE t CAT code (j) FI ; 

+ outsubtext (%j, 3, 4) ;

+ out (" ") ; 

+ IF (i AND 15) = 15 

+    THEN out (t)

+ FI 

+PER ; 

+line 

+ENDPROC dump block ; 

+ 

+putline ("Partitionstabelle lesen...") ; 

+get partition ; 

+putline ("SHard lesen...") ; 

+read shard ; 

+put (%peek (1364)) ; 

+*)

diff --git a/system/shard-x86-at/7/src/PATCHARE.ASM b/system/shard-x86-at/7/src/PATCHARE.ASM
new file mode 100644
index 0000000..c62ffdb
--- /dev/null
+++ b/system/shard-x86-at/7/src/PATCHARE.ASM
@@ -0,0 +1,16 @@
+;********************************************************

+;*==== Copyright (C) 1985,86 Martin Schoenbeck, Spenge =*

+;*                                                      *

+;* Bereich, der vom setup-Programm gepatcht wird        *

+;*                                                      *

+;********************************************************

+

+     if at

+bb_table dw 32 DUP (-1)

+         dw 32 DUP (-1)

+max_bb equ 32

+bb_anz dw 0

+     else

+bt_table dw 8 DUP (-1)   ;diese kopf/spur Kombination ist unmoeglich

+bt_replace dw 8 DUP (-1) ;ersatz

+     endif

diff --git a/system/shard-x86-at/7/src/PCPAR.ASM b/system/shard-x86-at/7/src/PCPAR.ASM
new file mode 100644
index 0000000..0bca2c5
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCPAR.ASM
@@ -0,0 +1,225 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Routinen fuer IBM - PC Parallel - Schnittstelle im EUMEL - System     *

+;*                                                                         *

+;*                                                                         *

+;***************************************************************************

+

+     device parallel

+

+     dtcbroutines iocontrol

+     routine 1,para_devicetype

+     routine 2,para_frout

+     routine 5,nil_size

+     routine -3,para_force_rom_output

+     routine -4,para_set_wait

+     routine -1,no_channel_setup

+

+     dtcbroutines control32

+     routine -2,para_init

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams para_output,3   ;typ = nur stream io

+

+

+;******************************************************************

+;*   der macro para_ccb muss fuer jede parallelschnittstelle im system

+;*   einmal aufgerufen werden

+;*

+;*   parameter: 

+

+para_ccb macro par,kanal

+     startccb para&par&ccb,kanal

+ccbentry para_number

+     dw par

+ccbentry para_stat

+     db 0

+ccbentry para_statusandmask

+     db 80h                        ;;busy abfragen

+ccbentry para_statusxormask

+     db 80h                        ;;active high

+ccbentry para_wait                 ;;wie lange vor busy warten

+     db 1

+ccbentry para_retry

+     db 30                         ;;> 100 usec minimum

+     endm

+

+para_rom_mode equ 1

+

+para_devicetype:

+     mov cx,0                      ;erstmal 0 setzen

+     call para_get_port

+     ifnz <mov cl,shard:(si+devtype)>     ;type dazu

+     ret

+

+para_init:

+     call para_get_port

+     ifz <ret>

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_init

+     inc dx

+     inc dx                        ;auf status ausgabe zeigen

+     mov al,8                      ;init leitung aktivieren

+     out (dx),al

+     mov ax,4000

+para_ini_loop:

+     dec ax

+     jnz para_ini_loop             ;warte ein weilchen

+     mov al,0ch                    ;kein auto lf, init high

+     out (dx),al

+     ret

+

+para_rom_init:

+     mov ah,1

+     mov dx,[di+para_number]

+     int 17h

+     ;es passt noch

+     mov bx,dx                     ;nummer nach bx

+     mov byte ptr es:[078h+bx],1 ;timeout wert,falls er doch mal busy kriegt

+     ret

+

+para_set_wait:

+     inc dl

+     mov [di+para_wait],dl

+     inc dh

+     mov [di+para_retry],dh

+     ret

+

+para_force_rom_output:

+     or byte ptr [di+para_stat],para_rom_mode

+     ret

+

+para_output:

+     jcxz para_all

+     push es

+     push bx

+     call para_get_port

+     pop bx

+     pop es

+     jz para_all                   ;kein port, dann wegwerfen

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_output           ;nein, ueber rom raus

+     test byte ptr [di+para_stat],para_rom_mode

+     jnz para_rom_output

+     push cx

+     inc dx                   ;auf status gehen

+para_out_loop:

+     push cx

+     mov cl,[di+para_wait]

+     sub ch,ch                ;0 nach ch

+     loop $                   ;pause fuer langsame drucker

+     mov cl,[di+para_retry]

+     ;ch ist 0

+para_ow_loop:                 ;warten, bis output erlaubt

+     in al,dx                 ;status holen

+     and al,(di+para_statusandmask) ;welche bits interessieren uns

+     xor al,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_ready            ;passt, ausgeben

+     loop para_ow_loop

+     pop dx                   ;restlaenge holen

+     pop cx                   ;gesamtlaenge holen

+     sub cx,dx                ;uebernommene laenge melden

+                              ;carry ist geloescht

+     ret

+

+para_ready:

+     pop cx                   ;zeichenzaehler zurueckholen

+     dec dx                   ;auf port direkt gehen

+     mov al,byte ptr es:[bx]  ;zeichen holen

+     inc bx                   ;auf naechstes zeichen

+     out (dx),al              ;zeichen ausgeben

+     inc dx

+     inc dx                   ;auf port fuer strobe zeigen

+     mov al,0dh               ;strobe ist bit 0

+     out (dx),al

+     jmp short $+2

+     mov al,0ch               ;und strobe zuruecknehmen

+     out (dx),al

+     dec dx                   ;auf status port gehen

+     loop para_out_loop       ;naechstes ausgeben

+     pop cx                   ;alles ausgegeben

+para_all:

+     stc

+     ret

+

+para_rom_output:

+     push cx

+     mov dx,[di+para_number]

+para_rom_out_loop:

+     push cx

+     mov cl,[di+para_wait]

+     sub ch,ch

+     loop $                   ;pause fuer langsame drucker

+     mov cl,[di+para_retry]

+     shr cl,1                 ;durch 16

+     shr cl,1

+     shr cl,1

+     shr cl,1                 

+     inc cl                   ;aber nie 65000 mal     

+para_rom_ow_loop:             ;warten, bis output erlaubt

+     mov ah,2                 ;status holen

+     int 17h

+     and ah,(di+para_statusandmask) ;welche bits interessieren uns

+     xor ah,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_rom_ready            ;passt, ausgeben

+     loop para_rom_ow_loop

+     pop dx                   ;restlaenge holen

+     pop cx                   ;gesamtlaenge holen

+     sub cx,dx                ;uebernommene laenge melden

+                              ;carry ist geloescht

+     ret

+

+para_rom_ready:

+     pop cx                   ;zeichenzaehler zurueckholen

+     mov al,byte ptr es:[bx]  ;zeichen holen

+     inc bx                   ;auf naechstes zeichen

+     mov ah,0                 ;zeichen ausgeben

+     int 17h

+     loop para_rom_out_loop   ;naechstes ausgeben

+     pop cx                   ;alles ausgegeben

+     stc

+     ret

+

+para_frout:

+     call para_get_port

+     jz para_frout_ok

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_frout            ;nein, ueber rom fragen

+     test byte ptr [di+para_stat],para_rom_mode

+     jnz para_rom_frout

+     inc dx                   ;auf status gehen

+     in al,dx                 ;status holen

+     and al,(di+para_statusandmask) ;welche bits interessieren uns

+     xor al,(di+para_statusxormask) ;und wie sollen sie stehen

+     jnz para_frout_not_ok    ;passt nicht, melden

+para_frout_ok:

+     mov cx,50                ;kann ausgeben

+     stc                      ;puffer leer

+     ret

+

+para_rom_frout:

+     mov dx,[di+para_number]

+     mov ah,2                 ;status holen

+     int 17h

+     and ah,(di+para_statusandmask) ;welche bits interessieren uns

+     xor ah,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_frout_ok         ;passt, melden

+para_frout_not_ok:

+     mov cx,0                 ;nichts passt

+     clc                      ;puffer nicht leer

+     ret

+

+para_get_port:

+     ;setzt zero flag, wenn port = 0

+     mov ax,40h                    ;ins pc datensegment

+     mov es,ax

+     mov bx,[di+para_number]       ;welcher printer

+     shl bx,1                      ;fuer basis adresse passend

+     mov dx,es:[8+bx]              ;printer basis adresse holen

+     or dx,dx                      ;0?

+     ret

diff --git a/system/shard-x86-at/7/src/PCPLOT.ASM b/system/shard-x86-at/7/src/PCPLOT.ASM
new file mode 100644
index 0000000..a922bd7
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCPLOT.ASM
@@ -0,0 +1,429 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Graphikroutinen fuer IBM - PC                                          *

+;*                                                                          *

+;*                                                                          *

+;****************************************************************************

+

+gr_base dw 03d0h                 ;default grahpic adress

+

+gr_pointer equ 4                 ;pointer register of 6845

+gr_data equ 5                    ;data register of 6845

+gr_msr equ 8                     ;mode select register

+gr_csr equ 9                     ;color select register

+gr_status equ 10                 ;status register

+gr_xmsr equ 10                   ;extended mode select register

+gr_cfgswitch equ 15              ;hercules config switch

+

+switch_mode:

+     cmp dh,1

+     jz gm_switch                ;tecmar graphics master

+     cmp dh,2                    ;hercules

+     jz herc_switch

+     push dx

+     push ax

+     mov dx,[gr_base]

+     add dx,gr_xmsr              ;tecmar auf normal mode setzen

+     mov al,0

+     out (dx),al

+     jmp short $+2               ;io pause machen

+     add dx,gr_cfgswitch-gr_xmsr ;hercules configswitch

+     out (dx),al

+     pop ax

+     pop dx

+     mov byte ptr [plot_mode],0  ;kein mode, den wir direkt auswerten

+     mov al,dl

+     mov ah,0

+     int 10h                     ;auf gewuenschten mode schalten

+     mov cx,0

+     jnc mode_ok

+unallowed_mode:

+     mov cx,-1

+mode_ok:

+     ret

+

+herc_switch:

+     mov word ptr [gr_base],03b0h

+     cmp dl,1                    ;mode 0 ist erlaubt

+     jnc unallowed_mode

+     add dl,6                    ;da steht der erste herculesmode

+     jmp short all_allowed

+gm_switch:                       ;tecmar graphics master

+     cmp dl,6                    ;werte 0 bis 5 erlaubt

+     jnc unallowed_mode

+     push dx

+     mov dx,[gr_base]

+     add dx,gr_status            ;statusregister holen

+     in al,dx

+     pop dx

+     test al,80h                 ;schalter auf monochrom

+     jnz all_allowed             ;nein, alle modi erlaubt

+     cmp dh,2                    ;nur 0 und 1

+     jnc unallowed_mode

+all_allowed:

+     mov byte ptr [plot_mode],1  ;merken, dass in erweitertem mode

+     mov dh,0

+     mov ax,offset mod_tb_length ;laenge einer tabelle

+     mul dx                      ;auf passende tabelle zeigen

+     mov bx,ax

+     add bx,offset mod_tables    ;auf erstes byte der tabelle

+;

+     mov ah,13                   ;vierzehn register muessen ausgegeben werden

+     mov dx,[gr_base]

+     add dx,gr_msr               ;da ist mode select register unserer graphik

+     mov al,0                    ;disable screen output

+     out (dx),al

+     jmp short $+2

+     add dx,gr_cfgswitch-gr_msr  ;hercules einschalten (wenn da)

+     mov al,3

+     out (dx),al

+     sub dx,gr_cfgswitch-gr_pointer

+

+set_6845:

+     mov al,ah

+     out (dx),al                 ;in dieses register wollen wir schreiben

+     inc dx                      ;und hier muss der wert hin

+     mov al,byte ptr [bx]

+     inc bx                      ;auf naechstes feld

+     out (dx),al

+     dec dx                      ;wieder auf zeiger_register

+     dec ah

+     jns set_6845                ;bis nummer negativ

+;

+     cld

+     mov cx,08000h               ;fill 64k

+     mov ax,0a000h

+     mov es,ax

+     xor ax,ax                   ;fill with 0

+     xor di,di                   ;start at 0 in area

+     rep stosw

+     mov cx,08000h

+     mov ax,0b000h               ;next 64k

+     mov es,ax

+     xor ax,ax                   ;fill with 0

+     xor di,di                   ;start at 0 in area

+     rep stosw

+;

+     mov al,byte ptr[bx]         ;csr wert holen

+     inc bx

+     add dx,gr_csr-gr_pointer

+     out (dx),al

+;

+     inc dx                      ;to xmsr

+     mov al,byte ptr [bx]

+     inc bx

+     out (dx),al

+;

+     sub dx,gr_xmsr-gr_msr       ;to msr

+     mov al,byte ptr [bx]

+     inc bx

+     out (dx),al

+;

+     mov ax,word ptr [bx]        ;laenge einer graphik zeile

+     inc bx

+     inc bx

+     mov word ptr [gr_linelength],ax

+;

+     mov al,byte ptr [bx]        ;maske, um ein pixel zu behalten

+     push ds

+     pop es

+     mov cx,16

+     mov di,offset color_tab

+     rep stosb                   ;farbtabelle auf 3 initalisieren

+     mov ah,0

+     inc bx

+     mov word ptr [gr_pixel_mask],ax

+     xor al,0ffh                 ;maske erzeugen, die ein pixel loescht

+     mov byte ptr [gr_pixel_inv_mask],al

+;

+     mov word ptr [first_shift],9090h ;ersten shift wegnoppen

+     test byte ptr [bx],1        ;vier segmente ?

+     ifnz <mov word ptr [first_shift],0ebd1h> ;shift wieder eintragen

+     inc bx

+;

+     mov al,byte ptr [bx]        ;mask fuer pixel_pro_byte holen

+     inc bx

+     mov byte ptr [gr_pixel_per_byte_mask],al

+     mov word ptr [shift_count_shift],0c902h ;volles shift annehmen

+     mov word ptr [shift_count_shift+2],0c902h ;add cl,cl

+     mov ah,1                    ;anzahl shifts, um byteoffset zu kriegen

+     shr al,1                    ;bei mehr als zwei pixel ein shift weniger

+     jz shifts_nopped

+     inc ah

+     mov word ptr [shift_count_shift],09090h ;nops

+     shr al,1                    ;bei acht pixel gar kein shift

+     jz shifts_nopped

+     inc ah

+     mov word ptr [shift_count_shift+2],09090h ;nops

+shifts_nopped:

+     mov byte ptr [gr_byte_calc_shift],ah

+;

+     mov si,bx

+     mov di,offset gr_segtable

+     mov cx,4

+     rep movsw                   ;segmentwerte uebertragen

+     add bx,8

+     mov cx,0

+     ret

+

+pen:

+     mov word ptr [maske],dx

+     mov byte ptr [linetype],bl

+     ret

+

+new_pen1:

+     mov cx,bx                   ;bx merken

+     mov bx,offset color_tab

+     call set4

+     mov cx,dx

+     call set4

+     ret

+

+new_pen2:

+     mov cx,bx                   ;bx merken

+     mov bx,offset color_tab+8   ;zweite haelfte der tabelle

+     call set4

+     mov cx,dx

+     call set4

+     ret

+

+set4:

+     call set2

+     mov cl,ch

+set2:

+     mov al,cl

+     and al,15                   ;nur untersten 4 bits behalten

+     mov byte ptr [bx],al

+     inc bx

+     mov al,cl

+     mov cl,4

+     shr al,cl                   ;obersten 4 bits

+     mov byte ptr [bx],al

+     inc bx

+     ret

+

+mask_mode:

+     mov word ptr [jmp_or_not],9090h ;set mask mode

+     mov cx,word ptr [mask_count] ;alten mask_count zurueckliefern

+     mov word ptr [mask_count],bx

+     cmp dx,0                    ;wirklich mask_mode gewuenscht

+     ifz <mov word ptr [jmp_or_not],07ebh> ;nein, sprung wieder einbauen

+     ret

+

+move:

+     mov word ptr [altx],dx      ;neuen x wert

+     mov word ptr [alty],bx      ;und y wert setzen

+     ret

+

+draw:

+     mov byte ptr [stepx],46h ;inc si

+     mov byte ptr [stepy],47h ;inc di

+     mov cx,dx                   ;in welche richtung wie weit gehen

+     sub cx,word ptr [altx]

+     jns positiv_x

+     neg cx                      ;negative richtung, positiv machen und

+     mov byte ptr [stepx],4eh ;dec si zum ausgleich

+positiv_x:

+     mov dx,bx                   ;y wert holen

+     sub dx,word ptr [alty]      ;wie weit und welche richtung

+     jns positiv_y

+     neg dx                      ;negative richtung, positiv rechnen und

+     mov byte ptr [stepy],4fh ;dec di zur korrektur

+positiv_y:

+     cmp dx,cx                   ;hauptrichtung entlang des groesseren

+                                 ;offsets

+     jc direction_ok             ;hauptrichtung war entlang si

+     mov bx,word ptr [stepy]  ;richtungen tauschen

+     xchg bh,bl

+     mov word ptr [stepy],bx

+     xchg cx,dx                  ;und richtungslaengen tauschen

+                                 ;hauptrichtung ist jetzt entlang di

+direction_ok:

+                                 ;der wert fuer die hauptrichtung ist

+                                 ;in cx, fuer die nebenrichtung in dx

+                                 ;der fehlerwert der nebenrichtung in

+                                 ;1/abs(hauptrichtung) - einheiten ist in bx

+     mov bx,0                    ;fehlerwert ist im moment 0

+     mov word ptr [delta_x],cx   ;wert fuer hauptrichtung merken

+     mov si,word ptr [altx]      ;alte werte holen

+     mov di,word ptr [alty]

+paint:

+     jcxz paint_done             ;fertig, letzten punkt noch malen

+     sub bx,dx                   ;ist gerader fehler schon negativ

+     jns stepx                   ;nur hauptrichtung nehmen

+     mov ax,bx                   ;geraden fehler nach ax

+     add ax,ax                   ;

+     add ax,word ptr [delta_x]   ;

+     jns stepx                   ;nur hauptrichtung

+     add bx,word ptr [delta_x]

+stepy:

+     inc di

+stepx:

+     inc si

+

+; errechneten punkt setzen

+

+     call punkt

+

+     loop paint

+

+paint_done:

+     call punkt                  ;letzten punkt setzen

+     mov word ptr [alty],di

+     mov word ptr [altx],si

+     ret

+

+

+punkt:

+     test byte ptr [plot_mode],0ffh

+     jnz new_punkt

+     push cx

+     push dx

+     mov dx,di

+     mov cx,si

+     ror word ptr maske,1

+linetype equ $+1

+     mov ax,0c01h                ;write dot

+     and al,byte ptr [maske]      ;linie einbauen

+     int 10h

+     pop dx

+     pop cx

+     ret

+

+new_punkt:

+     push ax

+     push bx

+     push cx

+     push dx

+     push es

+     mov bx,di

+     and bx,3

+     add bx,bx                   ; *2

+     mov es,[bx+gr_segtable]     ;in diesem segment liegt unser punkt

+gr_linelength equ $+1

+     mov ax,720/4                ;bytes pro zeile horizontal

+     mov bx,di                   ;y wert wieder holen

+first_shift:                     ;dieser shift faellt bei zwei segmenten aus

+     shr bx,1

+     shr bx,1                    ;di / 4

+     mul bx                      ;mal anzahl bytes pro graphikzeile

+     mov bx,si                   ;byte in zeile ausrechnen

+gr_byte_calc_shift equ $+1

+     mov cl,2                    ;so oft si shiften, fuer byte in zeile

+     shr bx,cl

+     add bx,ax                   ;dies byte enthaelt unseren punkt

+     mov cx,si                   ;untersten bits geben shiftfaktor an

+     inc cx                      ;einmal mehr shiften (oder gar nicht)

+gr_pixel_per_byte_mask equ $+2

+     and cl,3                    ;vier pixel pro byte (15 fuer zwei pixel etc

+shift_count_shift:

+     add cl,cl                   ;shiftfaktor verdoppeln

+     add cl,cl                   ;oder vervierfachen

+     mov al,byte ptr es:[bx]     ;byte holen

+     rol al,cl                   ;pixel nach 0 holen

+     mov bp,ax                   ;evtl. wird pixelwert als index benutzt

+gr_pixel_mask equ $+2

+     and bp,3                    ;die pixel bits behalten

+jmp_or_not:

+     jmp short punkt_no_mask

+mask_count equ $+1               ;zaehler fuer maske

+     mov bp,0

+     and bp,15                   ;maskenzaehler MOD 16 nehmen

+punkt_no_mask:

+gr_pixel_inv_mask equ $+1

+     and al,0fch                 ;rest behalten

+     or al,byte ptr ds:[bp+color_tab] ;pixel setzen

+     ror al,cl                   ;zurueckdrehen

+     mov byte ptr es:[bx],al     ;wieder eintragen

+     inc word ptr ds:[mask_count]

+     pop es

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     ret

+

+ even

+

+maske dw 0ffffh

+altx dw 0

+alty dw 0

+delta_x dw 0

+;gr_pixel_mask dw 3               ;maske, welche bits zum pixel gehoeren

+;mask_count dw 0                  ;zaehler fuer maskiertes schreiben

+

+gr_segtable dw 0a000h            ;tabelle der graphik segmente

+            dw 0a800h

+            dw 0b000h

+            dw 0b800h

+

+

+;gr_linelength dw 720/4           ;laenge einer graphikzeile

+;mask_mod db 0                    ;nicht 0, wenn mit maske

+color_tab db 16 DUP (3)          ;farbtabelle

+

+plot_mode db 0

+

+;gr_pixel_inv_mask db 0fch        ;invertiert, nur byte

+

+

+

+mod_tables equ $

+;mode 0

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,2,88,86,1,91,14,90,90,109,  0, 191, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+mod_tb_length equ $-mod_tables

+;mode 1

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,3,88,86,1,91,14,90,90,109,  0, 191, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 2

+; 6845 regs 13       -                          0,csr,xmsr,msr

+     db 0,0,0,32,1,2,112,100,6,127,15,184,160,227,  0,  31, 24

+     dw 640/2                    ;laenge einer graphikzeile

+     db 15                       ;maske, um ein pixel zu behalten

+     db 0                        ;1 = 4 segmente, 0 = 2 segmente

+     db 1                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente

+;mode 3

+; 6845 regs 13       -                       0,csr,xmsr,msr

+     db 0,0,0,32,3,3,56,50,1,64,15,184,160,227,  0,  31, 24

+     dw 640/2                    ;laenge einer graphikzeile

+     db 15                       ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 1                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 4

+; 6845 regs 13       -                        0,csr,xmsr,msr

+     db 0,0,0,32,1,2,112,100,7,127,15,98,90,128,  0,  63, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 0                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente

+;mode 5

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,3,56,50,3,64,15,98,90,128,  0,  63, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 6 (hercules)

+; 6845 regs 13       -                  0,csr,xmsr,msr

+     db 0,0,0,0,3,2,87,87,2,91,7,46,45,53,  0,  0, 10

+     dw 720/8                    ;laenge einer graphikzeile

+     db 1                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 7                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0b000h,0b200h,0b400h,0b600h ;die vier segmente

diff --git a/system/shard-x86-at/7/src/PCSCREEN.ASM b/system/shard-x86-at/7/src/PCSCREEN.ASM
new file mode 100644
index 0000000..62d37eb
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCSCREEN.ASM
@@ -0,0 +1,437 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Behandlung des PC Bildschirms und der Tastatur                        *

+;*                                                                         *

+;***************************************************************************

+

+     device pc

+

+     dtcbroutines iocontrol

+     routine 1,devicetype

+     routine 2,frout_ok

+     routine 5,nil_size

+     routine 6,priv_op_question

+     routine 8,priv_op_question

+     routine 9,priv_op_question

+     routine -3,set_attribute

+     routine -4,set_palette

+     routine -5,switch_mode

+     routine -6,draw

+     routine -7,move

+     routine -8,pen

+     routine -9,new_pen1

+     routine -10,new_pen2

+     routine -11,mask_mode

+

+     routine -1,unknowncontrol

+

+     dtcbroutines control32

+     routine -2,pc_init

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams pc_output,3   ;typ = nur stream io

+

+

+;***************************************************************************

+

+pc_init:

+breakaddress    equ     01bh*4  ;tastatur break adresse 

+     mov bx,0

+     mov es,bx                ;in die interrupt vektoren zeigen

+     mov word ptr es:[breakaddress+2],cs

+     mov word ptr es:[breakaddress],offset breakint

+     mov dx,0                 ;cursor in die obere ecke 

+     mov bh,0

+     mov ah,2                 ;cursor setzen

+     int 10h

+     mov ax,0600h             ;clear entire window

+     mov cx,0                 ;von oben

+     mov dx,25*256+80         ;bis unten

+     mov bh,7                 ;attribut

+     int 10h 

+     ret

+

+;

+breakint:

+                push cx

+                push ax

+                push ds

+                push cs

+                pop ds

+;               mov al,1

+;               mov ch,'i'

+;               call inputinterrupt

+                mov al,1

+                mov ch,2            ;sv

+                call inputinterrupt

+                pop ds

+                pop ax

+                pop cx

+                iret

+;

+;

+;

+REVERS          EQU     01110000B       ;ATTRIBUT FUER REVERS-VIDEO

+NORMAL          EQU     00000111B       ;ATTRIBUT FUER NORMAL-VIDEO

+HOME            EQU     1 

+RECHTS          EQU     2

+OBEN            EQU     3

+CLEOP           EQU     4               ;CLEAR TO END OF PAGE

+CLEOL           EQU     5               ;CLEAR TO END OF LINE

+CPOS            EQU     6               ;CURSOR-POSITIONIERUNG

+;                                        ES FOLGEN X- UND Y-KOORDINATE

+BELL            EQU     7 

+LINKS           EQU     8

+UNTEN           EQU     10

+RETURN          EQU     13

+BEGMARK         EQU     15

+ENDMARK         EQU     14

+MAXCOLS         EQU     79

+MAXLINES        EQU     23

+ATTRIBUT        DB      NORMAL

+CURFLAG         DB      0

+YPOS            DB      0

+;

+;***********************************************************************

+;*   output auf bildschirm des pc

+;*

+pc_output:

+       PUSH    CX     ;RETTE ORIGINALLAENGE DES STRINGS

+       CLD            ;DIRECTION FLAG : INCREM. SI

+       MOV     SI,BX

+OUT:   mov al,es:[si]    ;HOLE ZEICHEN

+       inc si

+       MOV     AH,CURFLAG

+       CMP     AH,0

+       JNZ     s0

+       CMP     AL,HOME

+       JZ      s1     ;CURSOR HOME VERLANGT ?

+       CMP     AL,RECHTS 

+       JZ      s2     ;CURSOR NACH RECHTS ?

+       CMP     AL,OBEN 

+       JZ      s3     ;CURSOR NACH OBEN ?

+       CMP     AL,CLEOP 

+       JZ      s4     ;LOESCHEN BIS BILDSCHIRMENDE ?

+       CMP     AL,CLEOL

+       JZ      s5     ;LOESCHEN BIS ZEILENENDE ?

+       CMP     AL,CPOS 

+       JZ      s6     ;CURSOR POSITIONIEREN ?

+       CMP     AL,LINKS

+       JZ      s7     ;CURSOR NACH LINKS?

+       CMP     AL,UNTEN

+       JZ      s8     ;CURSOR NACH UNTEN ?

+       CMP     AL,RETURN 

+       JZ      s9     ;CURSOR AN DEN ANFANG DER AKT. ZEILE ?

+       CMP     AL,BEGMARK 

+       JZ      s10    ;AB JETZT REVERS ?

+       CMP     AL,ENDMARK 

+       JZ      s11    ;WIEDER NORMALE VIDEO-DARSTELLUNG ?

+       CMP     AL,BELL

+       JZ      s12    ;KLINGELN ?

+;

+       PUSH    CX

+       PUSH    BX

+       PUSH    SI 

+       PUSH    AX     ;AKTUELLES ATTRIBUT

+       MOV     AL,ATTRIBUT

+       MOV     BL,AL

+       POP     AX

+       MOV     AH,9   ;SCHREIBEN MIT ATTRIBUT

+       MOV     BH,0   ;PAGE #

+       MOV     CX,1

+       INT     010H   ;CALL BIOS

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       INC     DL     ;COL = COL + 1

+       CMP     DL,MAXCOLS+1

+       JNZ     SAME_LINE

+       MOV     DL,0

+       CMP     DH,MAXLINES 

+       JZ      SCROLL_UP

+       INC     DH

+SAME_LINE:      MOV     AH,2

+       mov bh,0     ;page number 

+       INT     010H

+       POP     SI

+       POP     BX

+       POP     CX

+       JMP     DONE

+;

+SCROLL_UP:      CALL    SCROLL

+       JMP     SAME_LINE 

+;

+DONE:  DEC     CX     ;ANZAHL ZEICHEN = ANZAHL ZEICHEN - 1

+       JNZ     OUT    ;WEITER ?

+       POP     CX     ;ANZAHL UEBERNOMMENE ZEICHEN (S.O.)

+       RET

+; 

+s0:    JMP     CUR1

+s1:    JMP     CURHOME

+s2:    JMP     RIGHT

+s3:    JMP     UP

+s4:    JMP     CLEAREOP

+s5:    JMP     CLEAREOL

+s6:    JMP     CURPOS

+s7:    JMP     LEFT

+s8:    JMP     DOWN

+s9:    JMP     ENTER

+s10:   JMP     MARK

+s11:   JMP     UNMARK

+s12:   JMP     KLINGELN

+;

+;

+CURPOS:MOV     AL,2

+       MOV     CURFLAG,AL

+       JMP     DONE

+;

+CUR1:  CMP     AH,1

+       JZ      CURX

+     cmp al,maxlines

+     jc  cur1ok

+     mov al,maxlines

+cur1ok:

+       MOV     YPOS,AL

+       DEC     CURFLAG

+       JMP     DONE

+

+CURX:  DEC     CURFLAG

+       MOV     DH,YPOS;Y-KOORDINATE

+     cmp  al,maxcols

+     jc   curxok

+     mov  al,maxcols

+curxok:

+       MOV     DL,AL  ;X-KOORDINATE

+       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     BH,0   ;PAGE #

+       MOV     AH,2   ;SET CURSOR POSITION

+       INT     010H   ;CALL BIOS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+CURHOME:        PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     BH,0   ;PAGE #

+       MOV     DX,0000H        ;POSITION (0,0)

+       MOV     AH,2

+       INT     010H   ;CALL BIOS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+RIGHT: PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       CMP     DL,MAXCOLS      ;X-POSITION DES CURSOR ZU GROSS?

+       JZ      RUNTER

+       INC     DL     ;COL = COL + 1

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+RUNTER:MOV     DL,0

+       MOV     BH,0

+     mov  ah,2

+       INT     010H

+       JMP     down1

+; 

+LEFT:  PUSH    BX     ;KOMMENTARE : S.O.

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       DEC     DL

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+UP:    PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       DEC     DH

+       MOV     AH,2 

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+DOWN:  PUSH    BX

+       PUSH    CX

+       PUSH    SI

+down1:       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       CMP     DH,MAXLINES

+       JZ      SCRL

+       INC     DH

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+SCRL:  CALL    SCROLL

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+;

+ENTER: PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       MOV     DL,0

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+;

+CLEAREOP:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       MOV     CX,DX  ;CURRENT CURS.POS = UPPER LEFT CORNER

+       MOV     DL,maxcols      ;END OF LINE

+       MOV     AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H   ;CLEAR TO END OF LINE

+       MOV     CL,0

+       CMP     DH,MAXLINES

+       JZ      FERTIG

+       INC     CH

+       MOV     DH,MAXLINES     ;NEW LOWER RIGHT CORNER 

+       MOV     DL,MAXCOLS

+       MOV     AX,600H

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H

+FERTIG:POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+CLEAREOL:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       MOV     CX,DX  ;CURRENT CURS.POS = UPPER LEFT CORNER

+       MOV     DL,maxcols      ;END OF LINE

+       MOV     AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H   ;CLEAR TO END OF LINE

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+MARK:

+       MOV     ATTRIBUT,revers

+       JMP     DONE

+;

+UNMARK:

+       MOV     ATTRIBUT,normal 

+       JMP     DONE

+;

+SCROLL:MOV     AH,6

+       MOV     AL,1   ;SCROLL WINDOW ONE LINE UP

+       MOV     CX,0000H        ;UPPER LEFT CORNER : (0,0)

+       MOV     DH,MAXLINES

+       MOV     DL,MAXCOLS

+       mov bh,7          ;attribute for scroll

+       INT     010H

+       MOV     DH,MAXLINES

+       MOV     DL,0

+       MOV     BH,0   ;PAGE #

+       RET

+;

+;

+KLINGELN:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,14

+       MOV     BH,0

+       INT     010H   ;PIEEPS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+set_attribute:

+     mov attribut,dl

+     ret

+

+set_palette:

+     mov ah,11                ;set color palette

+     int 10h

+     ret

+

+;

+;

+;

+;**********************************************************************

+;*

+;*   checkkey prueft ob ein zeichen auf der tastatur eingegeben wurde

+;*   und uebergibt dies ggf. dem EUMEL;

+;*   muss regelmaessig (z.B. aus timerinterrupt aufgerufen werden

+; 

+checkkey:

+     push ax

+checkagain:

+     MOV     AH,1    ;Z-FLAG GESETZT : ZEICHEN !

+   cli

+     INT     016H    ;INPUT FROM KEYBOARD

+     JZ      NO_KEY  ;NEIN,KEINE TASTE GEDRUECKT

+     MOV     AH,0

+     INT     016H    ;JA, ZEICHEN ABHOLEN

+     cmp ax,0        ;kommt von 'break'

+     jz no_key

+     cmp al,0        ;extended code

+     jnz normal_key

+     mov al,ah       ;mit bit acht kennzeichnen

+     or  al,80h

+normal_key:

+     push cx

+     MOV     CH,AL

+     MOV     AL,1    ;KANAL-NUMMER

+     CALL    inputinterrupt

+     pop cx

+   sti

+     jmp checkagain

+NO_KEY:

+   sti

+     pop ax

+     ret

+;

diff --git a/system/shard-x86-at/7/src/PCSYS.ASM b/system/shard-x86-at/7/src/PCSYS.ASM
new file mode 100644
index 0000000..6ae6b0a
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCSYS.ASM
@@ -0,0 +1,130 @@
+;**************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ================*

+;*                                                                        *

+;*   PC spezifische, deviceunabhaengige routinen                          *

+;*                                                                        *

+;************************************************************************** 

+

+limit:

+        mov dx,0FFFh

+        push ax

+        push cx

+        int 12h      ;Speichergroesse abholen

+        mov cl,6h

+        shl ax,cl

+        dec ax

+        mov dx,ax

+        mov ax,cs

+        sub dx,ax                        ;must be relativ to cs

+        pop cx

+        pop ax

+        ret

+

+paragraphs:

+        mov dx,0FFFh

+        push ax

+        push cx

+        int 12h      ;Speichergroesse abholen

+        mov cl,6h

+        shl ax,cl

+        dec ax

+        mov dx,ax

+        pop cx

+        pop ax

+        ret

+ 

+

+;**************************************************************************

+timerint equ 08*4

+timercont equ 018h*4	;resident basic ist ueberfluessig

+timer_init:

+     mov ax,0

+     mov es,ax

+     mov bx,word ptr es:[timerint+2]

+     mov word ptr es:[timercont+2],bx

+     mov bx,word ptr es:[timerint]

+     mov word ptr es:[timercont],bx

+     mov word ptr es:[timerint+2],cs

+     mov word ptr es:[timerint],offset timer_tick

+     ret

+; 

+timer_tick:

+     int 18h 

+     push ax

+     push ds

+     push cs                  ;ds := cs

+     pop ds

+   sti

+     call checkkey            ;keybord abfragen

+   if pcd

+     mov al,50

+   else

+     mov al,55                ;ungefaehr 55 millisekunden

+   endif

+   cli

+     call timerinterrupt

+     inc tickcount

+     cmp tickcount,1000/55    ;schon eine sekunde um

+     jnc sec_tick

+     pop ds

+     pop ax

+     iret

+;

+;**************************************************************************

+;*

+;*   Die Initialisierung der einzelnen Kanaele kann in der Zelle sec_entry

+;*   eine Routine eintragen, die im Sekundentack (ungefaehr) aufgerufen

+;*   werden soll. Diese Routine muss dann die vorher dort eingetragene 

+;*   Routine aufrufen. Ebenfalls kann ein di und si registerinhalt

+;*   eingetragen werden, der beim aufruf gegeben sein soll. Dann ist dafuer

+;*   Sorge zu tragen, dass die nachfolgenden Routine den jeweils vorher

+;*   dort eingetragenen Wert erhaelt. Alle Register ausser di, si und !!ds!!

+;*   duerfen beliebig zerstoert werden.

+;*   ds ist immer auf das datensegment (momentan = cs) gesetzt.

+sec_tick:

+     mov tickcount,0          ;wieder vorn anfangen zu zaehlen

+     push si

+     push di

+     push bp

+     push bx

+     push cx

+     push dx

+     push es

+     mov di,word ptr sec_di

+     mov si,word ptr sec_si

+     jmp word ptr sec_entry

+sec_cont:

+     pop es

+     pop dx

+     pop cx

+     pop bx

+     pop bp

+     pop di

+     pop si

+     pop ds

+     pop ax

+     iret

+

+sec_entry dw offset sec_cont

+sec_di    dw 0                ;hier koennen routinen das di und das si

+sec_si    dw 0                ;ablegen, mit dem sie aufgerufen werden wollen

+

+tickcount db 0

+

+;****************************************************************************

+;* neuen bootvorgang einleiten

+reboot:

+   if hdsystem

+     mov ax,0401h             ;sector verify

+     mov cx,1                 ;spur 0, sector 1

+     mov dx,80h               ;drive 0, head 0

+     int 13h

+   endif

+     mov ax,40h

+     mov ds,ax                ;auf datensegment

+     mov word ptr ds:[0072h],1234h ;reset flag

+     db 0eah                  ;jmp 0ffffh:0

+     dw 0 

+     dw 0ffffh

+

+

diff --git a/system/shard-x86-at/7/src/SHMAIN.ASM b/system/shard-x86-at/7/src/SHMAIN.ASM
new file mode 100644
index 0000000..8c584c5
--- /dev/null
+++ b/system/shard-x86-at/7/src/SHMAIN.ASM
@@ -0,0 +1,240 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Routinen zur Verteilung der Auftraege auf verschiedene Kanaele         *

+;*   und Kanal 32                                                           *

+;*                                                                          *

+;****************************************************************************

+

+;******************************************************************************

+; routinen, die das restsystem vom SHard erwartet

+;******************************************************************************

+; routinen im restsystem, die SHard benutzen kann

+;systemstart    = cs:1e10h

+;inputinterrupt = cs:1e13h

+;timerinterrupt = cs:1e16h

+;warte          = cs:1e19h

+;freieumel0     = cs:1e1ch

+;info           = cs:1e1fh

+;

+;******************************************************************************

+;******************************************************************************

+; kanalspezifische funktionen

+i_output proc far

+     push bp

+     push si

+     push di

+     push bx

+     push dx

+     push ax

+     push es

+     push ds                  ;bis hierhin nach funktion restaurieren

+     mov si,ds                ;wir brauchen den alten wert von ds in es

+     mov es,si

+     mov si,cs                ;wir brauchen ds = cs

+     mov ds,si

+     push bx             ;fuer versorgung der funktion sichern

+     call select

+     pop bx

+     call shard:[si]     ;routine anspringen

+     pop ds                   ;register wieder herstellen

+     pop es

+     pop ax

+     pop dx

+     pop bx

+     pop di

+     pop si

+     pop bp

+     ret

+i_output endp

+

+i_blockin label far

+     push bp

+     mov bp,2            ;kennung blockin

+     jmp short dispatch

+

+i_blockout label far

+     push bp

+     mov bp,3            ;kennung blockout

+     jmp short dispatch

+

+i_iocontrol label far

+     push bp

+     mov bp,4            ;kennung iocontrol

+     jmp short dispatch

+

+control32:               ;spezialaufrufe indirekt ueber kanal 32 gekommen

+     push cs

+     call i_control32

+     ret

+

+i_control32:

+     push bp

+     mov bp,5            ;kennung control32

+     jmp short dispatch

+

+;******************************************************************************

+; dispatch routine um aufrufe auf die kanalspezifischen treiber zu verteilen

+;

+; in: al = kanal

+;     bp auf dem stack

+;     bp = 2 bei blockin

+;          3 bei blockout

+;          4 bei iocontrol

+;          5 bei control ueber kanal 32

+;     aufruf mit jmp dispatch

+;

+; funktion: aufruf der entsprechenden funktion des kanaltreibers mit

+;      si = devicetypecontrolblock

+;      di = channelcontrolblock

+;      auf dem stack: bp, si, di, dx, es, ds, bx, returnadresse

+;

+;      die routinen muessen deshalb keine register sichern.

+;      soll in ds:bx etwas zurueckgeliefert werden, so ist dies ueber den

+;      stack zu tun.

+;

+; out: die gewuenschte funktion wurde ausgefuehrt

+;      bp, si, di, dx, bx unveraendert, ausnahme: bx in bestimmten faellen wo dies

+;      ausdruecklich verlangt wird. flags, cx (ggf. bx) wie von der funktion geliefert.

+dispatch proc far

+     push si                  ;register sichern um sie nach ende der Funktion

+     push di

+     push dx                  ;zu restaurieren

+     push es

+     push ds

+     push bx

+     mov si,ds                ;wir brauchen den alten wert von ds in es

+     mov es,si

+     mov si,cs                ;wir brauchen ds = cs

+     mov ds,si

+     call dispexecute         ;fuehre dispatch aus

+     pop bx                   ;register wieder herstellen

+     pop ds

+     pop es

+     pop dx

+     pop di

+     pop si

+     pop bp

+     ret                      ;fertig, funktion ausgefuehrt

+dispatch endp

+

+dispexecute:

+     push bx                  ;sichern, um versorgung der funktion durchfuehren

+     push dx                  ;zu koennen

+     call select         ;adressen fuer diesen kanal laden 

+     add bp,si           ;adresse fuer offset der funktionstabelle in dtcb ausrechnen

+     mov bl,shard:[bp]        ;offset nach bl

+     mov bh,0ffh              ;maximal 255 byte grosse tabelle

+;bx enthaelt jetzt negativen offset

+     add bx,si           ;start der tabelle fuer funktionswerte ausrechnen

+;

+; als funktionswert wird derzeit nur der bereich von -128 bis +127 akzeptiert.

+; -1 dient dabei als tabellenendekennzeichnung und wird fuer alle undefinierten 

+; funktionswerte aufgerufen

+; 

+; die tabelle besteht aus jeweils einem byte funktionsschluessel

+; im bereich -128 - +127 und zwei byte funktionsadresse. 

+     mov dl,cl                ;niederwertigen teil nach dl

+     mov al,ch                ;hoeheren bits von cx muessen 0 oder 0ffh sein

+     or al,al                 ;ist es 0

+     jz dispfunctloop         ;ja, ok

+     inc al                   ;oder -1

+     ifnz <mov dl,0ffh>       ;nein, dann -1 als funktionswert

+dispfunctloop:

+     mov al,shard:[bx]        ;aktuellen tabelleneintrag suchen

+     inc bx                   ;und auf dazugehoerige adresse

+     cmp al,dl                ;gefunden

+     jz dispfuncfound         ;ja

+     inc al                   ;oder -1

+     jz dispfuncfound

+     inc bx              ;adresse ueberspringen

+     inc bx

+     jmp dispfunctloop

+dispfuncfound:

+     mov bp,bx           ;adresse der routine nach bp

+     pop dx              ;dx wieder herstellen

+     pop bx              ;bx wiederherstellen

+     jmp shard:[bp]      ;jmp funktion

+

+;***************************************************************************

+; select routine, um die tabellen eines bestimmten kanals zu adressieren

+;

+; in:  al  = kanalnummer

+;

+; out: si = dtcb adresse

+;      di = ccb adresse

+;      bx, dx zerstoert

+select:

+     push cx

+     mov dx,offset selectentry ;laenge eines eintrags in selecttabelle

+     mov bx,offset selecttable

+     mov cl,shard:[bx]        ;anzahl kanaele laden

+     mov ch,0

+     inc bx                   ;auf eigentliche tabelle

+selectloop:

+     cmp al,shard:[bx]        ;kanal gefunden

+     jz selectfound

+     add bx,dx                ;auf naechsten kanal

+     loop selectloop

+; hier haben wir einen unbekannten kanal

+; bx zeigt jetzt auf den 'nilkanal'

+selectfound:

+; hier wurde der passende kanal gefunden

+     mov di,shard:[bx]+1      ;adresse channelcontrolblock

+     mov si,shard:[bx]+3      ;adresse devicetypecontrolblock

+     pop cx

+     ret

+

+;********************************************************************************

+;* definition des typs 'shardkanal' fuer operation ueber kanal 32

+     device shardchannel

+

+     dtcbroutines iocontrol

+          routine 1,devicetype

+          routine 2,frout_ok

+          routine 5,nil_size

+          routine 6,priv_operation

+          routine 8,priv_operation

+          routine 9,priv_operation

+          routine -3,priv_operation

+          routine -4,priv_operation

+          routine -5,reboot_request

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -2,timer_init

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine -4,clockread

+     dtcbroutines blockout

+          routine -4,clockwrite

+          routine -1,no_blockinout

+     dtcbparams nil_output,0            ;output,no in_out

+

+priv_operation:

+     mov al,bl                ;kanalnummer nach al

+     mov bl,0                 ;vermerken: privilegiert

+     jmp control32

+

+priv_op_question:

+     mov al,bl                ;kanalnummer nach al

+     mov bl,1                 ;vermerken: abfrage

+     jmp control32

+

+reboot_request:

+     mov byte ptr reboot_byte,1

+     ret

+

+reboot_byte db 0

+

+longmove:

+     rep movsw

+     ret

+

+i_sysend proc far

+     cmp byte ptr cs:reboot_byte,1

+     ifz <jmp reboot>

+     mov al,0

+     mov cx,-102

+     call control32           ;laufwerk parken, wenn implementiert

+     ret

+i_sysend endp

diff --git a/system/shard-x86-at/7/src/STREAM.ASM b/system/shard-x86-at/7/src/STREAM.ASM
new file mode 100644
index 0000000..87c3547
--- /dev/null
+++ b/system/shard-x86-at/7/src/STREAM.ASM
@@ -0,0 +1,289 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Pufferverwaltung fuer Stream-I/O-Kanaele                              *

+;*   und allgemeine Stream-I/O-Routinen                                    *

+;*                                                                         *

+;***************************************************************************

+

+;******************************************************************************

+; macro zur definition der fuer 'stream' notwendigen daten im ccb

+stream macro bufsiz,bufadr

+ccbentry stream_stat 

+;;definition der bits in stream_stat

+outrestart   = 1    ;;output war fertig, muss neu gestartet werden

+wasxon       = 2    ;;es wurde bereits xon empfangen

+out_xon_xoff = 4    ;;ausgabeseitig findet xon/xoff handshake statt

+in_xon_xoff  = 8    ;;eingabeseitig findet xon/xoff handshake statt

+sendxon_xoff = 10h  ;;xon oder xoff muss gesendet werden

+sendxon      = 20h  ;;xon senden (in verbindung mit sendxon_xoff verwendet)

+in_xoff_send = 40h  ;;xoff wurde ausgesendet -> nur dann xon senden

+     db outrestart + wasxon + in_xoff_send

+ccbentry buffersize

+     db bufsiz

+ccbentry content

+     db 0           ;;puffer ist anfangs leer

+ccbentry inpointer

+     db 0           ;;wir fuellen den puffer vom anfang an

+ccbentry outpointer

+     db 0           ;;und leeren ihn auch von da

+ccbentry buffer

+     dw offset bufadr      ;;pufferadresse

+ccbentry andmask

+     db 0ffh        ;;high bit loeschen

+ccbentry xormask

+     db 0           ;;keine bits kippen

+ccbentry errorandmask

+     db 0ffh        ;;high bit loeschen

+ccbentry errorxormask

+     db 0           ;;keine bits kippen

+ccbentry outandmask

+     db 0ffh        ;;high bit loeschen

+ccbentry outxormask

+     db 0           ;;keine bits kippen

+ccbentry breakchar

+     db '?'         ;;nach ? umsetzen

+ccbentry xoffchar

+     db 'S'-40h     ;;ctrl-s ist xoff

+ccbentry xonchar

+     db 'Q'-40h     ;;ctrl-q ist xon

+ccbentry stream_icount

+     dw 0

+ccbentry stream_ocount

+     dw 0

+     endm

+

+

+fillbuffer:

+; di zeigt auf ccb

+; das z-flag ist rueckgesetzt, wenn der output neu gestartet werden muss

+     or cx,cx                      ;falls laenge null: alles uebernommen melden

+     jnz fillit

+     stc                           ;'alles uebernommen' setzen

+     ret                           ;war null, nichts zu tun

+fillit:

+     push cx                       ;gewuenschte laenge merken fuer rueckmeldung

+fillagain:

+     mov al,shard:(di+buffersize)  ;puffergroesse holen

+     sub al,shard:(di+content)     ;belegte abziehen

+     jz bufferfull                 ;nichts mehr frei

+     push cx                       ;noch zu uebernehmende merken

+     or ch,ch                      ;nachsehen, ob laenge > 255

+     ifnz <mov cl,0ffh>            ;nein, dann bis zu 255 byte uebernehmen

+     cmp al,cl                     ;kleinere von freien und gewuenschten nehmen

+     ifc <mov cl,al>               ;anzahl freie ist kleiner

+     mov al,shard:(di+buffersize)  ;groesse holen

+     sub al,shard:(di+inpointer)   ;zeiger abziehen -> abstand vom pufferende

+     jnz takeminimum

+     mov byte ptr shard:(di+inpointer),0 ;ist am ende, vorne anfangen

+     mov al,cl                     ;von daher volle groesse

+takeminimum:                       ;minimum (abstand vom ende, max moegliche) -> c

+     cmp al,cl                     ;welches ist groesser

+     ifc <mov cl,al>               ;a ist kleiner, nehmen wir das

+     mov ch,0                      ;laenge fuer movsb

+     push cx                       ;merken

+     mov dx,shard:(di+buffer)

+     add dl,shard:(di+inpointer)

+     ifc <inc dh>                  ;zielstartadresse nach dx

+;es:bx enthaelt quellenstart

+;ds:dx enthaelt zieladresse

+     push es

+     push ds

+     pop es                        ;es / ds vertauschen

+     pop ds

+     xchg bx,si                    ;bx als source

+     xchg dx,di                    ;dx als destination

+     cld

+     rep movsb                     ;uebertragen

+     xchg bx,si                    ;register zuruecktauschen

+     xchg dx,di

+     push es

+     push ds

+     pop es

+     pop ds

+     pop cx                        ;uebernommene laenge nach cx

+     add shard:(di+inpointer),cl   ;neuen inpointer errechnen

+     add shard:(di+content),cl     ;neuen inhalt

+     pop bp                        ;gewuenschte laenge nach bp

+     sub bp,cx                     ;restlaenge ausrechnen

+     mov cx,bp                     ;restlaenge nach cx

+     jnz fillagain                 ;ok, fertig

+     pop cx                        ;alles uebernommen

+     test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? 

+     stc                           ;carry setzen

+     ret

+

+bufferfull:                        ;nicht alles uebernommen

+     pop bx                        ;gewuenschte laenge vom stack holen

+     sub bx,cx                     ;uebernommene laenge errechnen

+     mov cx,bx                     ;uebernommene nach bc

+     test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? 

+     ret                           ;carry ist geloescht

+

+frout:

+;* meldet anzahl freie im puffer und carry, wenn puffer leer

+     mov al,shard:(di+buffersize)  ;groesse

+     mov ch,al                     ;merken

+     sub al,shard:(di+content)     ;minus inhalt gibt freie

+     cmp al,ch                     ;volle puffergroesse?

+     cmc                           ;carry ist genau dann gesetzt, wenn bl>al

+     mov ch,0 

+     mov cl,al                     ;laenge melden

+     ret

+

+getnextchar:

+;* diese routine muss im disable interrupt aufgerufen werden und wird so verlassen

+;* z-flag -> kein zeichen mehr gefunden

+;* dx,ax,f werden zerstoert

+     test byte ptr (di+stream_stat),sendxon_xoff ;muessen wir xon/xoff senden

+     jnz getxon_xoff

+     test byte ptr shard:(di+stream_stat),wasxon ;war schon xon

+     jz getret                     ;nein, z sagt: kein zeichen mehr da

+     or byte ptr shard:(di+stream_stat),outrestart ;puffer leer, neustart erforderlich

+     cmp byte ptr shard:(di+content),0      ;noch was im puffer

+     jz getret                     ;ja

+     and byte ptr shard:(di+stream_stat),not outrestart ;kein neustart erforderlich

+     dec byte ptr shard:(di+content) ;einen vom inhalt abziehen

+     mov dx,shard:(di+buffer)      ;buffer adresse + outpointer nach cx

+     mov al,shard:(di+outpointer)

+     cmp al,shard:(di+buffersize)  ;sind wir am ende angelangt

+     ifz <mov al,0>                ;ja, dann auf den anfang setzen

+     inc al                        ;auf naechstes zeigen

+     mov shard:(di+outpointer),al  ;neuen outpointer setzen

+     dec al                        ;alten outpointer wiederherstellen

+     xor ah,ah                     ;ah loeschen

+     add dx,ax                     ;byte im puffer errechnen

+     xchg bx,dx

+     mov al,shard:[bx]             ;zeichen holen

+     xchg bx,dx

+     and al,(di+outandmask)        ;unerwuenschte bits blenden

+     xor al,(di+outxormask)        ;andere evtl. kippen

+     inc word ptr (di+stream_ocount) ;zeichen zaehlen

+     inc dx                        ;puffer steht nie auf 0

+                                   ;nz => zeigt an, dass zeichen da

+getret:

+     ret

+

+getxon_xoff:

+     and byte ptr (di+stream_stat),not sendxon_xoff ;jetzt senden wirs

+     test byte ptr (di+stream_stat),sendxon ;sollen wir xon senden

+     jz getxoff                    ;nein, dann wars xoff

+     and byte ptr (di+stream_stat),not sendxon ;muss jetzt auch weg

+     or al,1                       ;nz => zeichen da

+     mov al,(di+xonchar)           ;xon holen

+     ret 

+

+getxoff:

+     or al,1                       ;nz => zeichen

+     mov al,(di+xoffchar)          ;xoff holen

+     ret

+

+xonfound:

+     test byte ptr shard:(di+stream_stat),wasxon ;warten wir auf xon

+     lahf

+     or byte ptr shard:(di+stream_stat),wasxon ;jetzt war auf jeden fall eins da

+     sahf

+     ret                                ;z => output wieder starten

+

+xofffound:

+     and byte ptr shard:(di+stream_stat),not wasxon  ;ab sofort auf xon warten

+     ret                                ;nz => output nicht wieder starten

+

+input:

+     and al,shard:(di+andmask)          ;evtl. bits ausblenden

+     xor al,shard:(di+xormask)          ;oder kippen

+allinput:

+     test byte ptr shard:(di+stream_stat),out_xon_xoff

+     jz directinput

+     cmp al,shard:(di+xonchar)

+     jz xonfound

+     cmp al,shard:(di+xoffchar)

+     jz xofffound

+directinput:                       ;input ohne xon/xoff

+     mov ch,al                     ;zeichen nach ch

+     mov al,shard:(di+channel_no)  ;kanal nach al

+     inc word ptr shard:(di+stream_icount) ;zeichen zaehlen

+     call inputinterrupt

+     or al,1                       ;nz => kein output restart

+     ret

+

+errorinput:

+     and al,shard:(di+errorandmask) ;evtl. bits ausblenden

+     xor al,shard:(di+errorxormask) ;oder kippen

+     jmp allinput

+

+breakinput:

+     mov al,shard:(di+breakchar)

+     jmp allinput

+

+stream_weiter:

+   cli

+     mov al,(di+stream_stat)       ;aktuellen status holen

+     test al,in_xon_xoff           ;ueberhaupt xon_xoff handshake

+     jz stream_weiter_end          ;nein, ei und zurueck

+     test al,in_xoff_send          ;habe ich ein xoff gesendet

+     jz stream_weiter_end          ;nichts liefern 

+     or al,sendxon+sendxon_xoff    ;bitte schick ein xon

+     and al,0ffh-in_xoff_send      ;das xoff ist erledigt

+     mov (di+stream_stat),al       ;neuen status setzen

+     test byte ptr (di+stream_stat),outrestart ;nz => output neu starten

+stream_weiter_end:

+   sti

+     ret

+

+stream_stop:

+   cli

+     mov al,(di+stream_stat)       ;aktuellen status holen

+     test al,in_xon_xoff           ;ueberhaupt xon_xoff handshake

+     jz stream_stop_end            ;nein, ei und zurueck

+     or al,in_xoff_send+sendxon_xoff    ;bitte schick ein xoff und merk dirs

+     and al,0ffh-sendxon           ;auf keinen fall mehr xon schicken

+     mov (di+stream_stat),al       ;neuen status setzen

+     test byte ptr (di+stream_stat),outrestart ;nz => output neu starten

+stream_stop_end:

+   sti

+     ret

+

+enablexon:

+     or byte ptr shard:(di+stream_stat),in_xon_xoff ;ab sofort xon/xoff handshake

+enableoutxon:

+     or byte ptr (di+stream_stat),out_xon_xoff ;auch ausgabe seitig

+     ret

+

+

+disablexon:

+     and byte ptr (di+stream_stat),not in_xon_xoff ;ab sofort eingabe und

+disablexoff:

+     and byte ptr (di+stream_stat),not out_xon_xoff ;ausgabe wieder ohne xon/xoff

+     test byte ptr shard:(di+stream_stat),wasxon   ;warten wir noch auf xon

+     lahf 

+     or byte ptr shard:(di+stream_stat),wasxon     ;dann haben wir jetzt eins

+     sahf

+     ret                                           ;z => outputrestart

+

+set_out_mask:

+     mov (di+outandmask),dx

+     ret

+

+set_inp_mask:

+     mov (di+andmask),dx

+     ret

+

+set_inp_errmask:

+     mov (di+errorandmask),dx

+     ret

+

+stream_in_count:

+   cli

+     mov cx,(di+stream_icount)

+     mov word ptr (di+stream_icount),0

+   sti

+     ret

+

+stream_out_count:

+   cli

+     mov cx,(di+stream_ocount)

+     mov word ptr (di+stream_ocount),0

+   sti

+     ret

+

diff --git a/system/shard-x86-at/7/src/WAIT.ASM b/system/shard-x86-at/7/src/WAIT.ASM
new file mode 100644
index 0000000..80ff838
--- /dev/null
+++ b/system/shard-x86-at/7/src/WAIT.ASM
@@ -0,0 +1,175 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Support fuer die Wartelogik des IBM PC-AT ueber int 15h                *

+;*                                                                          *

+;*                                                                          *

+;****************************************************************************

+

+int15 proc far

+     sti

+     push ax

+     cmp ah,90h                  ;hat ein treiber nichts zu tun

+     jz device_is_busy

+     cmp ah,91h                  ;oder ist er gerade fertig

+     jz device_ready

+not_for_me:                      ;hab ich nichts mit am hut

+     pop ax

+     jmp dword ptr cs:[int15_cont]

+

+device_ready:

+     cmp al,2                    ;0 (platte) oder 1 (floppy)

+     jnc not_for_me

+     mov ah,0

+     push bx

+     mov bx,ax

+     mov byte ptr cs:device_busy[bx],2  ;device ist fertig geworden

+     pop bx

+     pop ax

+     iret

+

+device_is_busy:

+     mov ah,8                    ;annahme: 6 sekunden fuer platte

+     cmp al,0                    ;ist es platte

+     jz device_wait              ;ja

+     mov ah,3                    ;annahme: 2 sekunden fuer floppy

+     cmp al,1

+     jz device_wait              ;ist floppy

+     cmp al,0fdh                 ;warten auf floppy_motor 

+     jnz not_for_me              ;mit allem anderen haben wir nichts am hut

+     mov ax,0301h                ;zwei sekunden warten; device floppy

+device_wait:

+     push bx                     ;den ganzen ramsch sichern

+     push cx

+     push dx

+     push bp

+     push di

+     push si

+     push es

+     push ds

+     mov bl,al

+     mov bh,0

+   cli

+     mov byte ptr cs:device_table[bx],1          ;device busy setzen

+     mov byte ptr cs:device_timeout_table[bx],ah ;anzahl sekunden eintragen

+   sti

+device_wait_loop:

+     cmp byte ptr cs:device_busy[bx],0  ;noch kein interrupt gekommen

+     jnz device_wait_end

+     push bx

+     call cs:warte

+     pop bx

+     jmp device_wait_loop

+device_wait_end:

+     cmp byte ptr cs:device_busy[bx],2 ;normales ende

+     ifnz <stc>                         ;nicht normal, war timeout

+     mov byte ptr cs:device_table[bx],0 ;device ist wieder frei

+     mov byte ptr cs:device_busy[bx],0 ;device kann wieder auf int warten

+;    jnc devcont

+;    call cs:info

+;    jmp short devcont

+;    db ' timeout'

+devcont:

+     pop ds

+     pop es

+     pop si

+     pop di

+     pop bp

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     ret 2                       ;kill flags on stack

+

+int15 endp

+

+device_timing:

+     mov bx,-1                   ;mit 0 fangen wir an

+     mov cx,2                    ;zwei durchlaeufe

+device_timing_loop:

+     inc bx

+     mov al,byte ptr device_timeout_table[bx] ;timeout zaehler holen

+     cmp al,0ffh                 ;schon fertig mit zaehlen

+     jz device_timing_end

+     dec al

+     mov byte ptr device_timeout_table[bx],al ;timeout zaehler neu setzen

+     jns device_timing_end

+     cmp byte ptr device_table[bx],1 ;noch aktiv?

+     ifz <cmp byte ptr device_busy[bx],0> ;und noch kein endeinterrupt

+     ifz <mov byte ptr device_busy[bx],3> ;timeout aufgetreten

+device_timing_end:

+     loop device_timing_loop

+     jmp word ptr device_cont

+

+;***********************************************************************

+;* warten, bis das in bx uebergebene device frei ist

+;* ds = cs ist bedingung, alle register (ausser flags) bleiben erhalten

+  db 'device free'

+device_free:

+     cmp byte ptr device_table[bx],0 ;ist das device frei 

+     jnz device_not_free

+     mov byte ptr device_busy[bx],0 ;evtl. nachgeklapperte ints loeschen

+     ret                         ;device kann benutzt werden

+device_not_free:

+     push ax

+     push bx

+     push cx

+     push dx

+     push si

+     push di

+     push bp

+     push ds

+     push es

+     call warte

+     pop es

+     pop ds

+     pop bp

+     pop di

+     pop si

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     jmp device_free

+

+device_lock:

+     mov byte ptr device_table[bx],1 ;device sperren 

+     ret

+

+device_unlock:

+     mov byte ptr device_table[bx],0 ;device freigeben 

+     ret

+

+device_init:

+     mov ax,0

+     mov es,ax

+     mov bx,word ptr es:[15h*4]         ;int routine holen

+     mov cx,word ptr es:[15h*4+2]       ;int segment holen

+     mov word ptr es:[15h*4],offset int15

+     mov word ptr es:[15h*4+2],cs

+     mov word ptr [int15_cont],bx

+     mov word ptr [int15_cont+2],cx

+     mov ax,word ptr [sec_entry]       ;alte adresse fuer sec_tick holen

+     mov word ptr [device_cont],ax     ;eintragen fuer weitergabe

+     mov word ptr [sec_entry],offset device_timing ;unseren aufruf eintragen 

+     ret

+

+int15_cont:

+     dw 0

+     dw 0

+

+device_cont:

+     dw 0

+

+device_table:

+     db 0

+     db 0

+

+device_busy:

+     db 0

+     db 0

+

+device_timeout_table:

+     db 0

+     db 0

+

diff --git a/system/shard-z80-altos/6/src/ALTOSSHD.ASM b/system/shard-z80-altos/6/src/ALTOSSHD.ASM
new file mode 100644
index 0000000..5df69fb
--- /dev/null
+++ b/system/shard-z80-altos/6/src/ALTOSSHD.ASM
@@ -0,0 +1,1786 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT

+0100 C3 F9 01    ...   JP    01F9       ; Init Shard + Start EUMEL0

+0103 C3 8C 0B    ...   JP    0B8C       ; LIMIT

+0106 C3 2A 01    .*.   JP    012A       ; OUTPUT

+0109 C3 4B 01    .K.   JP    014B       ; BLOCKIN

+010C C3 53 01    .S.   JP    0153       ; BLOCKOUT

+010F C3 5B 01    .[.   JP    015B       ; IOCONTROL

+0112 C3 AC 0B    ...   JP    0BAC       ; SYSEND

+0115 C3 90 0B    ...   JP    0B90       ; SCHINF

+0118 C3 94 0B    ...   JP    0B94       ; SCHACC

+011B C3 89 0B    ...   JP    0B89       ; LONGMOVE

+011E 06                                 ; SHDVER = 6 

+011F 00 00                              ; ID 4

+0121 00 00                              ; ID 5

+0123 00 00                              ; ID 6

+0125 00 00                              ; ID 7

+0127 C3 63 01    .c.   JP    0163       ; I/O-Setzen fuer 'putboot' 

+012A DD E5       ..    PUSH  IX         ; OUTPUT (Kanal A, Length BC, 

+012C FD E5       ..    PUSH  IY         ;         Addr HL, Ausgegeben BC, 

+012E E5          .     PUSH  HL         ;         Carry SET : Alles raus)

+012F D5          .     PUSH  DE

+0130 F5          .     PUSH  AF 

+0131 E5          .     PUSH  HL 

+0132 CD A6 01    ...   CALL  01A6       ; Zugriff auf Kanaltabelle --> IY/DE

+0135 D5          .     PUSH  DE         ; DE --> IX (Addr. von Startaddr.) 

+0136 DD E1       ..    POP   IX 

+0138 EB          .     EX    DE,HL 

+0139 5E          ^     LD    E,(HL)     ; (Startaddresse) --> DE 

+013A 23          #     INC   HL 

+013B 56          V     LD    D,(HL) 

+013C E1          .     POP   HL         ; Textstartaddresse 

+013D CD 49 01    .I.   CALL  0149       ; = JP (DE) Routine starten 

+0140 D1          .     POP   DE         ; ehem. Returnaddresse loeschen

+0141 7A          z     LD    A,D 

+0142 D1          .     POP   DE 

+0143 E1          .     POP   HL 

+0144 FD E1       ..    POP   IY 

+0146 DD E1       ..    POP   IX 

+0148 C9          .     RET 

+0149 D5          .     PUSH  DE 

+014A C9          .     RET              ;----------------------------------- 

+014B DD E5       ..    PUSH  IX         ; BLOCKIN 

+014D DD 21 02 00 .!..  LD    IX,0002    ; Aufgabe 2

+0151 18 18       ..    JR    016B       ;----------------------------------

+0153 DD E5       ..    PUSH  IX         ; BLOCKOUT

+0155 DD 21 03 00 .!..  LD    IX,0003    ; Aufgabe 3

+0159 18 10       ..    JR    016B       ;---------------------------------- 

+015B DD E5       ..    PUSH  IX         ; IOCONTROL

+015D DD 21 04 00 .!..  LD    IX,0004    ; Aufgabe 4

+0161 18 08       ..    JR    016B       ;---------putboot Aufg. 5---------- 

+0163 DD E5       ..    PUSH  IX         ; 

+0165 DD 21 05 00 .!..  LD    IX,0005    ; Aufgabe 5

+0169 18 00       ..    JR    016B       ;--------------------------------- 

+016B FD E5       ..    PUSH  IY         ; Je nach IX Kanal-Aufgabe (I/O)

+016D D5          .     PUSH  DE 

+016E E5          .     PUSH  HL 

+016F CD 79 01    .y.   CALL  0179       ; Register wurden gerettet

+0172 E1          .     POP   HL 

+0173 D1          .     POP   DE 

+0174 FD E1       ..    POP   IY 

+0176 DD E1       ..    POP   IX 

+0178 C9          .     RET              ;----------------------------------- 

+0179 E5          .     PUSH  HL 

+017A D5          .     PUSH  DE 

+017B CD A6 01    ...   CALL  01A6       ; Kanaladdr --> DE, IY

+017E DD 19       ..    ADD   IX,DE      ; DE = 4. + 5. Byte + Aufgabennummer

+0180 DD 6E 00    .n.   LD    L,(IX+00)  ; Byte zur Aufgabe 

+0183 26 FF       &.    LD    H,FF 

+0185 D5          .     PUSH  DE 

+0186 DD E1       ..    POP   IX         ; IX = Addresse des tabellenentries

+0188 19          .     ADD   HL,DE      ; 

+0189 59          Y     LD    E,C        ; BC = code1

+018A 78          x     LD    A,B 

+018B B7          .     OR    A 

+018C 28 05       (.    JR    Z,0193     ; EUMEL-Funktion 0<=code1<256

+018E 3C          <     INC   A 

+018F 28 02       (.    JR    Z,0193     ; Shard-Funktion -256<=code1<0

+0191 1E FF       ..    LD    E,FF       ; -1 = Illegale Funktion

+0193 7E          ~     LD    A,(HL) 

+0194 23          #     INC   HL 

+0195 BB          .     CP    E          ; Addresse mit der Funktionsnummer 

+0196 28 07       (.    JR    Z,019F     ; suchen 

+0198 3C          <     INC   A          ; FF=Tabellenende 

+0199 28 04       (.    JR    Z,019F 

+019B 23          #     INC   HL 

+019C 23          #     INC   HL 

+019D 18 F4       ..    JR    0193       ; naechste Funktionsnummer 

+019F 5E          ^     LD    E,(HL) 

+01A0 23          #     INC   HL 

+01A1 56          V     LD    D,(HL)     ; Sprung zur Addresse, die in der 

+01A2 EB          .     EX    DE,HL      ; Tabelle steht 

+01A3 D1          .     POP   DE         ; DE= code2 (Eingang HL)

+01A4 E3          .     EX    (SP),HL 

+01A5 C9          .     RET              ; --------------------------------- 

+01A6 C5          .     PUSH  BC         ;   Kanalinfos aus Tabelle --> IY/DE

+01A7 11 05 00    ...   LD    DE,0005    ; Entrylaenge in der Tabelle

+01AA 21 12 02    !..   LD    HL,0212    ; Tabellenanfang (Kanaele)

+01AD 46          F     LD    B,(HL)     ; Erstes Byte ist Tabellenlaenge

+01AE 23          #     INC   HL 

+01AF BE          .     CP    (HL)       ; Erstes Entrybyte ist Kanalnummer

+01B0 28 03       (.    JR    Z,01B5     ; Bis Kanal gefunden

+01B2 19          .     ADD   HL,DE 

+01B3 10 FA       ..    DJNZ  01AF 

+01B5 23          #     INC   HL         ; 2. u. 3. Byte --> DE

+01B6 5E          ^     LD    E,(HL) 

+01B7 23          #     INC   HL 

+01B8 56          V     LD    D,(HL) 

+01B9 D5          .     PUSH  DE         ; 2. u. 3. Byte --> IY 

+01BA FD E1       ..    POP   IY 

+01BC 23          #     INC   HL         ; 4. u. 5. Byte --> DE

+01BD 5E          ^     LD    E,(HL) 

+01BE 23          #     INC   HL 

+01BF 56          V     LD    D,(HL) 

+01C0 C1          .     POP   BC         ; gerettetes BC zurueck

+01C1 C9          .     RET              ;----------------------------------

+;============================= Parameterkanal ============================== 

+01C2 01 5F 06                           ; 1, IOCONTROL "typ"

+01C5 02 50 06                           ; 2, IOCONTROL "frout"

+01C8 05 46 06                           ; 5, IOCONTROL "size"

+01CB 06 ED 01                           ; 6, IOCONTROL "flow"

+01CE 08 ED 01                           ; 8, IOCONTROL "baud"

+01D1 09 ED 01                           ; 9, IOCONTROL "bits"

+01D4 E2 ED 01                           ; -30, IOCONTROL maske f. busystatus

+01D7 E1 ED 01                           ; -31, IOCONTROL maske f. strobe setz.

+01DA FF 4C 06                           ; -1, IOCONTROL ill.

+01DD FE 86 0B                           ; -2, Aufg. 5 : kanal init

+01E0 FF 55 06                           ; -1, Aufg. 5 : BC = 1

+01E3 FF 4C 06                           ; BLOCKIO ill.

+01E6 59                                 ; Parameterkanal : OUTPUT: 0659 ill. 

+01E7 06                                 ; 

+01E8 FD                                 ; BLOCKIN : 01E3

+01E9 FD                                 ; BLOCKOUT : 01E3

+01EA DC                                 ; IOCONTROL : 01C2

+01EB F7                                 ; Aufg. 5 : 01DD

+01EC 00                                 ; Keine I/O moeglich

+                                        ; ----- set "flow","bits","baud" --- 

+01ED 7D          }     LD    A,L        ; Kanal = addressierter kanal

+01EE 2E 00       ..    LD    L,00       ; 0 = Parameter setzen (code2) 

+01F0 C3 63 01    .c.   JP    0163       ; Aufgabe 5, L = 0 

+01F3 7D          }     LD    A,L        ; kanal = addressierter Kanal

+01F4 2E 01       ..    LD    L,01       ; 1 = Parameter lesen (code2) 

+01F6 C3 63 01    .c.   JP    0163       ; Aufgabe 5, L = 1

+01F9 F3          .     DI               ;---------- Init Shard -------------

+01FA 3E 00       >.    LD    A,00       ; Page 0 = Interruptvektoren

+01FC ED 47       .G    LD    I,A 

+01FE 31 00 B0    1..   LD    SP,B000 

+0201 3E 21       >!    LD    A,21       ; Kanal 0..32 

+0203 01 FE FF    ...   LD    BC,FFFE    ; Funktion -2 = Kanalinit 

+0206 3D          =     DEC   A 

+0207 F5          .     PUSH  AF 

+0208 CD 63 01    .c.   CALL  0163       ; Kanaele initialisieren (IRQ's) 

+020B F1          .     POP   AF 

+020C B7          .     OR    A 

+020D 20 F4        .    JR    NZ,0203 

+020F C3 10 1E    ...   JP    1E10       ; Systemstart EUMEL0 bzw. 'putboot' 

+     -----------------------------------  Entry : Kanal, Puffer, ROUTINETBL 

+0212 0C                                 ; Tabelle mit 12 Kanaelen

+0213 20 00 00 E6 01                     ; Parameterkanal, Kein Puffer 

+0218 00 64 0C 0C 07                     ; Hintergrund 

+021D 01 CD 0C 7B 02                     ; Kanal 1 .. 6 = seriell

+0222 02 5B 0D 7B 02                     ; 

+0227 03 E9 0D 7B 02 

+022C 04 77 0E 7B 02

+0231 05 05 0F 7B 02

+0236 06 93 0F 7B 02 

+023B 07 BD 0F EA 0A                     ; printer

+0240 08 C3 0F EA 0A                     ; parallel 1

+0245 09 C9 0F EA 0A                     ; parallel 2

+024A 1F CF 0F 7D 06                     ; floppy

+024F FF 00 00 3F 06                     ; illegal Kanal

+;======================== Serielle Kanaele =================================

+0254 01 5F 06                           ; 1, IOCONTROL "typ"

+0257 02 36 05                           ; 2, IOCONTROL "frout" 

+025A 05 46 06                           ; 5, IOCONTROL "size"

+025D 06 F3 01                           ; 6, IOCONTROL "flow"

+0260 08 F3 01                           ; 8, IOCONTROL "baud"

+0263 09 F3 01                           ; 9, IOCONTROL "bits"

+0266 FD D6 02                           ; -3, IOCONTROL "portinfo" 

+0269 FF 4C 06                           ; -1 ill. 

+026C 06 2A 03                           ; 6, Aufg .5 : "flow" setzen/info 

+026F 08 F2 02                           ; 8, Aufg. 5 : "baud" setzen/info

+0272 09 AA 03                           ; 9, Aufg. 5 : "bits" setzen/info 

+0275 FE A2 02                           ; -2, Aufg. 5 : Kanal init

+0278 FF 4C 06                           ; BLOCKIN/BLOCKOUT ill.

+027B 31                                 ; Seriell : 0431 = OUTPUT 

+027C 04 

+027D FD                                 ; BLOCKIN : 0278

+027E FD                                 ; BLOCKOUT : 0278

+027F D9                                 ; IOCONTROL : 0251

+0280 F1                                 ; Aufg. 5 : 026C

+0281 03                                 ; Typ : Stream I/O 

+    ; Baudratetabelle : 1. Byte: Bit 7+6 = Vorteiler (Register4) 

+    ;                      Bit 4 = DIV 256, DIV 16,Bit 5 : Mode (CTC) 

+    ;                   2. Byte: CTC-Zeitkonstante 

+0282 40 9C                              ; 50 Baud 

+0284 40 68                              ; 75 Baud 

+0286 40 47                              ; 110 baud 

+0288 E0 E8                              ; 134.5 Baud 

+028A E0 D0                              ; 150 Baud 

+028C A0 D0                              ; 300 Baud 

+028E 60 D0                              ; 600 Baud 

+0290 60 68                              ; 1200 baud 

+0292 60 45                              ; 1800 Baud 

+0294 60 34                              ; 2400 Baud 

+0296 60 23                              ; 3600 Baud 

+0298 60 1A                              ; 4800 Baud 

+029A 60 11                              ; 7200 Baud 

+029C 60 0D                              ; 9600 Baud 

+029E 60 07                              ; 19200 Baud 

+02A0 60 03                              ; 38400 Baud

+02A2 FD 4E 1A    .N.   LD    C,(IY+1A)  ;------------- "kanal init" -------- 

+02A5 06 0D       ..    LD    B,0D       ; Commandport in (IY+1A) 

+02A7 21 C9 02    !..   LD    HL,02C9    ; 13 Bytes ausgeben 

+02AA ED B3       ..    OTIR             ; An den Commandport schicken

+02AC FD 5E 1D    .^.   LD    E,(IY+1D)  ; Interruptvektor des Kanals 

+02AF ED 57       .W    LD    A,I        ; Vektortabellenaddresse High

+02B1 57          W     LD    D,A 

+02B2 ED 59       .Y    OUT   (C),E      ; Interruptvektor fuer Kanal 

+02B4 0E 1E       ..    LD    C,1E       ; Serviceroutine am Pufferende 

+02B6 06 00       ..    LD    B,00       ; (IY+1E)

+02B8 FD E5       ..    PUSH  IY 

+02BA E1          .     POP   HL 

+02BB 09          .     ADD   HL,BC 

+02BC 06 04       ..    LD    B,04       ; 4 Interrupt (Vector+Status) 

+02BE EB          .     EX    DE,HL      ; DE= Serviceroutinenaddresse 

+02BF 73          s     LD    (HL),E     ; HL = Interruptvektoraddresse 

+02C0 23          #     INC   HL         ; Serviceroutine eintragen

+02C1 72          r     LD    (HL),D 

+02C2 23          #     INC   HL         ; Fuer alle 4 Interrupts einen 

+02C3 13          .     INC   DE         ; Interrupthandler 

+02C4 13          .     INC   DE 

+02C5 13          .     INC   DE 

+02C6 10 F7       ..    DJNZ  02BF 

+02C8 C9          .     RET              ;-------- Inittabelle Serielle ----- 

+02C9 14 44             ; reset ext status IRQs, Clock x16, 1 Stopbit,noparity

+02CB 03 61             ; Rx 7 Bits, Autoenables (CTS), Receiver enable 

+02CD 05 EA             ; Tx 8 Bits, DTR = 1, RTS = 1, Transmitter enable 

+02CF 11 1F             ; kein WAIT/RDY, Vektor incl. Status, alle IRQs an 

+02D1 03 C1             ; Rx 8 Bits, Keine Autoenables, Receiver enable 

+02D3 11 1F             ; s.o. 

+02D5 02                ; Interruptvektor folgt als naechstes Byte

+02D6 FD 4E 1A    .N.   LD    C,(IY+1A)  ;------"IOCONTROL portinfo -3"------ 

+02D9 06 01       ..    LD    B,01       ; ^ Status/Commandport

+02DB 3E 30       >0    LD    A,30 

+02DD F3          .     DI 

+02DE ED 41       .A    OUT   (C),B      ; Read-Register 1 waehlen

+02E0 ED 40       .@    IN    B,(C)      ; Einlesen

+02E2 ED 79       .y    OUT   (C),A      ; Error Reset = 30H

+02E4 ED 78       .x    IN    A,(C)      ; Statusregister (0) lesen

+02E6 FB          .     EI 

+02E7 E6 AC       ..    AND   AC         ; DCD,CTS,... durchlassen 

+02E9 4F          O     LD    C,A        ; Lowbyte = Read-Register 1 Bits 

+02EA 78          x     LD    A,B        ; Highbyte = Read-Register 0 Bits 

+02EB E6 70       .p    AND   70         ; Nur Error-Bits durchlassen 

+02ED DD B6 15    ...   OR    (IX+15)    ; Schon vorhandene Fehler dazu

+02F0 47          G     LD    B,A 

+02F1 C9          .     RET              ;----------- "baud" -------------- 

+02F2 01 01 00    ...   LD    BC,0001    ; Rueckmeldung "nicht moeglich" 

+02F5 CB 7C       .|    BIT   7,H        ; Keine Shard-spezifischen Baudrates 

+02F7 C0          .     RET   NZ 

+02F8 7C          |     LD    A,H        ; Schluessel --> A

+02F9 B7          .     OR    A 

+02FA C8          .     RET   Z          ; 0 ist ungueltiger Schluessel

+02FB FD CB 11 4E ...N  BIT   1,(IY+11)  ; Baudrateeinstellung moeglich ? 

+02FF C8          .     RET   Z          ; nein 

+0300 0E 00       ..    LD    C,00       ; Rueckmeldung "ok" 

+0302 CB 45       .E    BIT   0,L        ; 0 = Lesen, 1 = parameter setzen 

+0304 C0          .     RET   NZ         ; Nur Information, dann fertig 

+0305 11 80 02    ...   LD    DE,0280    ; Tabelle der Baudrates/Timeconsts 

+0308 6C          l     LD    L,H 

+0309 CB 25       .%    SLA   L 

+030B 26 00       &.    LD    H,00       ; Schluessel * 2 + Tabellenanfang 

+030D 19          .     ADD   HL,DE 

+030E 7E          ~     LD    A,(HL)     ; Timeconst 

+030F E6 C0       ..    AND   C0         ; Taktvorteiler (1,16,32,64) waehlen 

+0311 4F          O     LD    C,A        ; fuer SIO/DART-Register 4

+0312 3E 3F       >?    LD    A,3F       ; Nur Clock-Bits (6,7) veraendern 

+0314 CD 1E 04    ...   CALL  041E       ; Clock x1, x16

+0317 7E          ~     LD    A,(HL)     ; 

+0318 E6 30       .0    AND   30         ; CTC Vorteiler (DIV16,DIV256) 

+031A 07          .     RLCA 

+031B F6 05       ..    OR    05         ; Modus = Timer, Kein IRQ, Timeconst

+031D FD 4E 1C    .N.   LD    C,(IY+1C)  ; CTC-Port fuer Baudrategenerator 

+0320 ED 79       .y    OUT   (C),A      ; An CTC ausgeben 

+0322 23          #     INC   HL 

+0323 7E          ~     LD    A,(HL)     ; Timeconst fuer CTC 

+0324 ED 79       .y    OUT   (C),A 

+0326 01 00 00    ...   LD    BC,0000    ; "ok"

+0329 C9          .     RET              ;-------------- "flow" ------------- 

+032A CB 7C       .|    BIT   7,H        ; Keine Shard-spezifischen "flow"s 

+032C C2 55 06    .U.   JP    NZ,0655    ; BC = 1 liefern

+032F CB 45       .E    BIT   0,L        ; NZ, wenn nur Information 

+0331 C2 5B 06    .[.   JP    NZ,065B    ; "alles moeglich" melden 

+0334 CD 07 06    ...   CALL  0607       ; Flowmodebits loeschen

+0337 F3          .     DI 

+0338 FD CB 11 86 ....  RES   0,(IY+11)  ; Kein RTS/CTS 

+033C FD CB 17 AE ....  RES   5,(IY+17)  ; Autoenables (CTS) loeschen

+0340 FD 36 12 04 .6..  LD    (IY+12),04 ; AND-maske Statusport Tx-Full 

+0344 FD 36 13 04 .6..  LD    (IY+13),04 ; XOR-maske Statusport Tx-Full

+0348 25          %     DEC   H          ; H=0, oder H>1 

+0349 20 03        .    JR    NZ,034E 

+034B CD FE 05    ...   CALL  05FE       ; H=1 : XON/XOFF setzen

+034E 25          %     DEC   H 

+034F 20 14        .    JR    NZ,0365    ; H=0 : keine Flusskontrolle

+0351 FD CB 11 C6 ....  SET   0,(IY+11)  ; H=2 : RTS/CTS

+0355 FD CB 17 EE ....  SET   5,(IY+17)  ; Autoenables (CTS) moeglich 

+0359 FD 36 12 2C .6.,  LD    (IY+12),2C ; TxDfull, CTS on, DCD on

+035D FD 36 13 2C .6.,  LD    (IY+13),2C ; Alle obigen Bits invertieren 

+0361 FD 36 14 82 .6..  LD    (IY+14),82 ; ? 

+0365 FD 7E 17    .~.   LD    A,(IY+17)  ; Writeregister 3

+0368 06 03       ..    LD    B,03       ; Register 3

+036A FD 4E 1A    .N.   LD    C,(IY+1A)  ; Commanndport

+036D ED 41       .A    OUT   (C),B      ; Neuen Autoenableswert ausgeben

+036F ED 79       .y    OUT   (C),A 

+0371 FB          .     EI 

+0372 CD 3C 04    .<.   CALL  043C       ; ggf. XON/XOFF je nach Status ausg.

+0375 01 00 00    ...   LD    BC,0000    ; "ok"

+0378 C9          .     RET              ;----- RTS/DTR o.XON/XOFF set/reset 

+0379 CD E9 05    ...   CALL  05E9       ; testet BIT 0 (IY0+0)

+037C C4 3C 04    .<.   CALL  NZ,043C    ; ggf XON/XOFF ausgeben

+037F FD CB 11 46 ...F  BIT   0,(IY+11)  ; NZ, wenn RTS/CTS eingestellt 

+0383 C8          .     RET   Z 

+0384 F3          .     DI               ; RTS/CTS ist eingestellt 

+0385 FD 7E 14    .~.   LD    A,(IY+14)  ; Bits, die bei RTS/CTS veraendert 

+0388 4F          O     LD    C,A        ; werden: RTS/DTR 

+0389 FD B6 19    ...   OR    (IY+19)    ; Register 5 Wert

+038C A9          .     XOR   C          ; RTS/DTR ggf loeschen

+038D FD 77 19    .w.   LD    (IY+19),A  ; Wieder zurueckschreiben

+0390 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Commandport

+0393 06 05       ..    LD    B,05       ; Register 5 beschreiben 

+0395 ED 41       .A    OUT   (C),B 

+0397 ED 79       .y    OUT   (C),A      ; Neuen Wert laden

+0399 FB          .     EI 

+039A C9          .     RET              ;----------------------------------- 

+039B CD D6 05    ...   CALL  05D6       ; Wenn XON/XOFF,

+039E C4 3C 04    .<.   CALL  NZ,043C    ; XON oder XOFF ausgeben

+03A1 F3          .     DI 

+03A2 FD 7E 14    .~.   LD    A,(IY+14)  ; RTS/DTR ggf. setzen 

+03A5 FD B6 19    ...   OR    (IY+19)    ; weiter wie oben

+03A8 18 E3       ..    JR    038D       ;------------ "bits" -------------- 

+03AA CB 7C       .|    BIT   7,H        ; Keine Shard-Spezifischen "bits" 

+03AC C2 55 06    .U.   JP    NZ,0655 

+03AF CB 45       .E    BIT   0,L        ; Info: "alles moeglich" melden 

+03B1 C2 5B 06    .[.   JP    NZ,065B 

+03B4 7C          |     LD    A,H        ; H = stop * 32 + par * 8 + (bit-1)

+03B5 C6 20       .     ADD   A,20       ; Stopbits + 1 : 1..3, parity

+03B7 1F          .     RRA              ; Bit 0,1 = parity

+03B8 1F          .     RRA              ; Bit 2,3 = stopbits

+03B9 1F          .     RRA 

+03BA E6 0F       ..    AND   0F         ; restregister ausblenden 

+03BC CB 4F       .O    BIT   1,A        ; 

+03BE 28 02       (.    JR    Z,03C2     ; Wenn gerader Parity: 

+03C0 CB C7       ..    SET   0,A        ; Parity enablen 

+03C2 4F          O     LD    C,A        ; C enthaelt OR-Wert fuer Register 4

+03C3 3E F0       >.    LD    A,F0       ; Nur Stopbits und Parity veraendern 

+03C5 CD 1E 04    ...   CALL  041E       ; SIO-Register 4 veraendern

+03C8 7C          |     LD    A,H        ; Datenbits ausblenden 

+03C9 E6 07       ..    AND   07 

+03CB 47          G     LD    B,A        ; + 1 = Anzahl Datenbits 

+03CC 04          .     INC   B 

+03CD 3E 00       >.    LD    A,00 

+03CF 16 F8       ..    LD    D,F8       ; 11111000

+03D1 37          7     SCF              ; Maskenbits "AND" fuer ungueltige 

+03D2 17          .     RLA              ; Datenbits links reinrotieren 

+03D3 CB 22       ."    SLA   D          ; Bei weniger als 5 Bits zusaetzl. 1

+03D5 10 FA       ..    DJNZ  03D1 

+03D7 5F          _     LD    E,A 

+03D8 CD 18 06    ...   CALL  0618       ; Datenbitsmasken setzen 

+03DB 16 00       ..    LD    D,00       ; Keine Bits invertieren 

+03DD CD 1F 06    ...   CALL  061F       ; Datenbitmasken setzen AND/XOR

+03E0 CD 26 06    .&.   CALL  0626 

+03E3 06 00       ..    LD    B,00 

+03E5 CB 54       .T    BIT   2,H 

+03E7 28 0C       (.    JR    Z,03F5     ; 1,2,3,4,5 datenbits : 00

+03E9 CB 44       .D    BIT   0,H        ; 6 datenbits : 80H

+03EB 28 02       (.    JR    Z,03EF     ; 7 datenbits : 40H

+03ED CB F8       ..    SET   7,B        ; 8 datenbits : C0H

+03EF CB 4C       .L    BIT   1,H 

+03F1 28 02       (.    JR    Z,03F5 

+03F3 CB F0       ..    SET   6,B 

+03F5 FD 7E 17    .~.   LD    A,(IY+17)  ; Register 3 Wert

+03F8 E6 3F       .?    AND   3F         ; Bits, die nicht veraendert werden 

+03FA B0          .     OR    B 

+03FB FD 77 17    .w.   LD    (IY+17),A  ; Register 3 Wert setzen

+03FE 16 03       ..    LD    D,03 

+0400 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Command-Port 

+0403 F3          .     DI 

+0404 ED 51       .Q    OUT   (C),D      ; Register 3 selektieren

+0406 ED 79       .y    OUT   (C),A      ; Neuen Register 3 Wert

+0408 CB 38       .8    SLR   B          ; Register 5 Bits "tiefer"

+040A FD 7E 19    .~.   LD    A,(IY+19)  ; Alten Registerwert 

+040D E6 9F       ..    AND   9F         ; unbenoetigte Bits ausblenden 

+040F B0          .     OR    B 

+0410 FD 77 19    .w.   LD    (IY+19),A  ; abspeichern 

+0413 16 05       ..    LD    D,05       ;

+0415 ED 51       .Q    OUT   (C),D      ; Register 5 selektieren

+0417 ED 79       .y    OUT   (C),A      ; Wert in das Register schreiben

+0419 FB          .     EI 

+041A 01 00 00    ...   LD    BC,0000    ; "ok"

+041D C9          .     RET              ;---------- Register 4 setzen -----

+041E F3          .     DI               ; A enthaelt Maske fuer alte Bits

+041F FD A6 18    ...   AND   (IY+18)    ; Register 4 Maske 

+0422 B1          .     OR    C          ; Neuer Clock/Parity/Stopbit Wert

+0423 FD 77 18    .w.   LD    (IY+18),A  ; In der Tabelle setzen

+0426 06 04       ..    LD    B,04       ; 

+0428 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Am Kommandoport ausgeben

+042B ED 41       .A    OUT   (C),B      ; Register 4 waehlen 

+042D ED 79       .y    OUT   (C),A      ; Neuen Wert des Registers setzen

+042F FB          .     EI 

+0430 C9          .     RET              ; ---------------------------------- 

+0431 CD CD 04    ...   CALL  04CD       ; Serieller OUTPUT:String in Puffer

+0434 F5          .     PUSH  AF         ; schreiben fuer IRQ-Ausgabe

+0435 C5          .     PUSH  BC 

+0436 C4 3C 04    .<.   CALL  NZ,043C    ; NZ, wenn Puffer gefuellt

+0439 C1          .     POP   BC 

+043A F1          .     POP   AF 

+043B C9          .     RET              ;--------- ggf. XON/XOFF ausgeben-- 

+043C FD 4E 1A    .N.   LD    C,(IY+1A)  ; Statusportaddresse

+043F F3          .     DI 

+0440 ED 78       .x    IN    A,(C)      ; Statusbyte

+0442 FD A6 12    ...   AND   (IY+12)    ;"Transmitter full"-Bit ausmaskieren

+0445 FD AE 13    ...   XOR   (IY+13)    ; Umdrehen, falls high-Aktiv

+0448 20 0A        .    JR    NZ,0454    ; NZ=Puffer noch voll

+044A CD 45 05    .E.   CALL  0545       ; Flusskontrolle pruefen(XON/XOFF-->A

+044D FD 4E 1B    .N.   LD    C,(IY+1B)  ; Addresse des Datenports seriell

+0450 28 02       (.    JR    Z,0454     ; Nichtausgeben, weil Flusskontrolle

+0452 ED 79       .y    OUT   (C),A      ; Zeichen aus Akku ausgeben

+0454 FB          .     EI 

+0455 C9          .     RET              ;--------Transmitbuffer empty IRQ- 

+0456 FD E3       ..    EX    (SP),IY    ; Ruecksprungaddresse -31

+0458 C5          .     PUSH  BC         ; = Anfang der Kanalinfotabelle 

+0459 F5          .     PUSH  AF 

+045A 01 DF FF    ...   LD    BC,FFDF    ; -31

+045D FD 09       ..    ADD   IY,BC 

+045F FD 4E 1A    .N.   LD    C,(IY+1A)  ; Kommandoport des Kanals

+0462 3E 28       >(    LD    A,28       ; reset interrupt pending 

+0464 ED 79       .y    OUT   (C),A      ; Kommando ausgeben 

+0466 CD 3F 04    .?.   CALL  043F       ; Flusskontrolle durchfuehren

+0469 18 48       .H    JR    04B3       ; Interruptende

+046B FD E3       ..    EX    (SP),IY    ;------- External/Status Change IRQ 

+046D C5          .     PUSH  BC 

+046E F5          .     PUSH  AF 

+046F 01 DC FF    ...   LD    BC,FFDC    ; IY := Kanaltabelleninfo

+0472 FD 09       ..    ADD   IY,BC 

+0474 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Statusportaddresse 

+0477 ED 78       .x    IN    A,(C)      ; Status einlesen 

+0479 06 10       ..    LD    B,10       ; reset Ext/Status Interrupts 

+047B ED 41       .A    OUT   (C),B 

+047D FC D1 05    ...   CALL  M,05D1     ; break empfangen : bit 7 = 1

+0480 CD 3C 04    .<.   CALL  043C       ; Flusskontrolle durchfuehren

+0483 18 2E       ..    JR    04B3       ; interrupt ende

+0485 FD E3       ..    EX    (SP),IY    ;--------special receive cond. IRQ 

+0487 C5          .     PUSH  BC 

+0488 F5          .     PUSH  AF 

+0489 01 D6 FF    ...   LD    BC,FFD6    ; IY := Kanaltabelleninfo 

+048C FD 09       ..    ADD   IY,BC 

+048E FD 4E 1A    .N.   LD    C,(IY+1A)  ; Status- u. Kommandoport 

+0491 3E 01       >.    LD    A,01       ; Read-Register 1

+0493 06 30       .0    LD    B,30 

+0495 ED 79       .y    OUT   (C),A      ; Reg.selekt

+0497 ED 78       .x    IN    A,(C)      ; Status einlesen

+0499 ED 41       .A    OUT   (C),B      ; Error-reset

+049B 47          G     LD    B,A 

+049C FD B6 15    ...   OR    (IY+15) 

+049F FD 77 15    .w.   LD    (IY+15),A  ; Fehler vermerken

+04A2 78          x     LD    A,B 

+04A3 FD A6 16    ...   AND   (IY+16)    ; Zulaessige Fehler maskieren

+04A6 28 1B       (.    JR    Z,04C3     ; keine Fehler, normale Eingabe 

+04A8 FD 4E 1B    .N.   LD    C,(IY+1B)  ; Zeichen vom Datenport einlesen

+04AB ED 78       .x    IN    A,(C) 

+04AD CD C9 05    ...   CALL  05C9       ; Zeichen per Inputinterrupt melden 

+04B0 CC 3C 04    .<.   CALL  Z,043C     ; Flusskontrolle durchfuehren

+04B3 F1          .     POP   AF 

+04B4 C1          .     POP   BC 

+04B5 FD E1       ..    POP   IY 

+04B7 FB          .     EI 

+04B8 ED 4D       .M    RETI             ;-------Receive Character avil. IRQ 

+04BA FD E3       ..    EX    (SP),IY 

+04BC C5          .     PUSH  BC 

+04BD F5          .     PUSH  AF 

+04BE 01 D9 FF    ...   LD    BC,FFD9    ; IY := Pufferanfang

+04C1 FD 09       ..    ADD   IY,BC 

+04C3 FD 4E 1B    .N.   LD    C,(IY+1B)  ; Datenport

+04C6 ED 78       .x    IN    A,(C)      ; Zeichen einlesen 

+04C8 CD A9 05    ...   CALL  05A9       ; Zeichen per inputinterrupt melden 

+04CB 18 E3       ..    JR    04B0       ; Interrupt mit Flusskontroller ende 

+04CD 78          x     LD    A,B        ;--------String in Puffer schreiben 

+04CE B1          .     OR    C          ; Nichts Auszugeben --> SCF RET

+04CF 37          7     SCF 

+04D0 C8          .     RET   Z 

+04D1 C5          .     PUSH  BC         ; String (HL/BC) in Puffer schreiben 

+04D2 FD 7E 02    .~.   LD    A,(IY+02)  ; IY - Kanaldescriptor

+04D5 FD 96 03    ...   SUB   (IY+03)    ; Puffergroesse - Pufferzeigerwrite 

+04D8 28 51       (Q    JR    Z,052B     ; puffer ist voll 

+04DA C5          .     PUSH  BC 

+04DB 5F          _     LD    E,A        ; freier Platz

+04DC 78          x     LD    A,B        ; Highbyte > 0 ? Laenge 

+04DD B7          .     OR    A 

+04DE 28 02       (.    JR    Z,04E2 

+04E0 0E FF       ..    LD    C,FF       ; Mehr als 255 Bytes Laenge

+04E2 7B          {     LD    A,E        ; 

+04E3 B9          .     CP    C 

+04E4 30 01       0.    JR    NC,04E7    ; Nicht genuegend Platz ?

+04E6 4F          O     LD    C,A 

+04E7 FD 7E 02    .~.   LD    A,(IY+02)  ; Puffergroesse- Pufferreadzeiger 

+04EA FD 96 04    ...   SUB   (IY+04) 

+04ED 20 05        .    JR    NZ,04F4    ; Noch Platz

+04EF FD 36 04 00 .6..  LD    (IY+04),00 ; Lesezeiger auf Anfang

+04F3 79          y     LD    A,C 

+04F4 B9          .     CP    C 

+04F5 30 01       0.    JR    NC,04F8 

+04F7 4F          O     LD    C,A 

+04F8 06 00       ..    LD    B,00 

+04FA C5          .     PUSH  BC 

+04FB FD 56 07    .V.   LD    D,(IY+07)  ; Pufferanfang + Pufferzeiger

+04FE FD 7E 06    .~.   LD    A,(IY+06) 

+0501 FD 86 04    ...   ADD   (IY+04) 

+0504 30 01       0.    JR    NC,0507 

+0506 14          .     INC   D          ; -->  DE bringen

+0507 5F          _     LD    E,A        ; und String von HL --> DE bringen 

+0508 ED B0       ..    LDIR 

+050A C1          .     POP   BC 

+050B FD 7E 04    .~.   LD    A,(IY+04) 

+050E 81          .     ADD   C          ; Pufferzeiger erhoehen

+050F FD 77 04    .w.   LD    (IY+04),A 

+0512 F3          .     DI 

+0513 FD 7E 03    .~.   LD    A,(IY+03)  ; Pufferzeigerwrite erhoehen

+0516 81          .     ADD   C          ; darf kein IRQ auftreten

+0517 FD 77 03    .w.   LD    (IY+03),A 

+051A FB          .     EI 

+051B E3          .     EX    (SP),HL    ; Stringlaenge (auf Stack) --> HL

+051C B7          .     OR    A 

+051D ED 42       .B    SBC   HL,BC      ; Reststringlaenge

+051F 44          D     LD    B,H 

+0520 4D          M     LD    C,L 

+0521 E1          .     POP   HL 

+0522 20 AE        .    JR    NZ,04D2    ; Reststring ggf. ausgeben

+0524 C1          .     POP   BC         ; Alle Zeichen uebernommen 

+0525 37          7     SCF 

+0526 FD CB 01 46 ...F  BIT   0,(IY+01) 

+052A C9          .     RET              ;----------------------------------

+052B E1          .     POP   HL 

+052C B7          .     OR    A 

+052D ED 42       .B    SBC   HL,BC 

+052F 44          D     LD    B,H 

+0530 4D          M     LD    C,L 

+0531 FD CB 01 46 ...F  BIT   0,(IY+01) 

+0535 C9          .     RET              ;----------- "frout" -------------- 

+0536 F3          .     DI               ; keine zeichen annehmen 

+0537 FD 7E 02    .~.   LD    A,(IY+02)  ; Puffergroesse - Pufferzeigerwrite 

+053A 47          G     LD    B,A        ; Pufferzeiger Write = anzahl Z. 

+053B FD 96 03    ...   SUB   (IY+03) 

+053E FB          .     EI 

+053F B8          .     CP    B          ; SCF, wenn Puffer leer

+0540 3F          ?     CCF 

+0541 06 00       ..    LD    B,00 

+0543 4F          O     LD    C,A 

+0544 C9          .     RET              ;---------------------------------- 

+0545 FD CB 01 66 ...f  BIT   4,(IY+01)  ; Flusskontrolle ?

+0549 20 37        7    JR    NZ,0582    ; ja 

+054B FD CB 01 4E ...N  BIT   1,(IY+01) 

+054F C8          .     RET   Z 

+0550 FD CB 01 C6 ....  SET   0,(IY+01)  ; Zeichen aus Puffer lesen (IY+05)

+0554 FD 7E 03    .~.   LD    A,(IY+03) 

+0557 B7          .     OR    A          ; Writezeiger am Anfang (leer)

+0558 C8          .     RET   Z          ; Zurueck

+0559 FD CB 01 86 ....  RES   0,(IY+01) 

+055D FD 35       .5    DEC   (IY+03)    ; Writezeiger DEC 1

+055F 03          .     INC   BC 

+0560 FD 46 07    .F.   LD    B,(IY+07)  ; Pufferanfang High

+0563 FD 7E 05    .~.   LD    A,(IY+05) 

+0566 FD BE 02    ...   CP    (IY+02) 

+0569 20 02        .    JR    NZ,056D 

+056B 3E 00       >.    LD    A,00 

+056D 3C          <     INC   A 

+056E FD 77 05    .w.   LD    (IY+05),A 

+0571 3D          =     DEC   A 

+0572 FD 86 06    ...   ADD   (IY+06)    ; Pufferanfang low

+0575 30 01       0.    JR    NC,0578 

+0577 04          .     INC   B          ; BC = Pufferzeiger

+0578 4F          O     LD    C,A 

+0579 0A          .     LD    A,(BC)     ; Zeichen aus Puffer (zeiger)

+057A FD A6 0C    ...   AND   (IY+0C)    ; Bit 8 ggf ausblenden

+057D FD AE 0D    ...   XOR   (IY+0D)    ;

+0580 04          .     INC   B 

+0581 C9          .     RET              ; Flusskontrolle

+0582 FD CB 01 A6 ....  RES   4,(IY+01) 

+0586 FD CB 01 6E ...n  BIT   5,(IY+01)  ; XON oder XOFF ?

+058A 28 08       (.    JR    Z,0594 

+058C FD CB 01 AE ....  RES   5,(IY+01) 

+0590 FD 7E 10    .~.   LD    A,(IY+10)  ; XON (CTRL-Q) stattdessen ausgeben

+0593 C9          .     RET              ;-----------------------------------

+0594 F6 01       ..    OR    01 

+0596 FD 7E 0F    .~.   LD    A,(IY+0F)  ; XOFF stattdessen ausgeben

+0599 C9          .     RET              ;----------------------------------

+059A FD CB 01 4E ...N  BIT   1,(IY+01)  ; XON empfangen

+059E FD CB 01 CE ....  SET   1,(IY+01) 

+05A2 C9          .     RET              ;--------------------------------- 

+05A3 FD CB 01 8E ....  RES   1,(IY+01)  ; XOFF-empfangen

+05A7 18 1D       ..    JR    05C6 

+05A9 FD A6 08    ...   AND   (IY+08)    ;------- Zeichen per 'inputinterrupt'

+05AC FD AE 09    ...   XOR   (IY+09)    ; masken fuer fehlerfreien receive 

+05AF FD CB 01 56 ...V  BIT   2,(IY+01)  ; XON/XOFF ? 

+05B3 28 0A       (.    JR    Z,05BF 

+05B5 FD BE 10    ...   CP    (IY+10)    ; XON-Zeichen ?

+05B8 28 E0       (.    JR    Z,059A 

+05BA FD BE 0F    ...   CP    (IY+0F)    ; XOFF-Zeichen ?

+05BD 28 E4       (.    JR    Z,05A3 

+05BF 47          G     LD    B,A        ; Zeichen in B verlangt

+05C0 FD 7E 00    .~.   LD    A,(IY+00)  ; Kanalnummer 

+05C3 CD 13 1E    ...   CALL  1E13       ; Inputinterrupt aufrufen

+05C6 F6 01       ..    OR    01 

+05C8 C9          .     RET              ;-------- fehlerhafter receive

+05C9 FD A6 0A    ...   AND   (IY+0A)    ; masken fuer fehlerhaften receive 

+05CC FD AE 0B    ...   XOR   (IY+0B) 

+05CF 18 DE       ..    JR    05AF       ; weiter wie normal 

+05D1 FD 7E 0E    .~.   LD    A,(IY+0E)  ;--------- fehlerhafter receive ---- 

+05D4 18 D9       ..    JR    05AF       ; '?' ausgeben 

+05D6 F3          .     DI               ;---------------------------------- 

+05D7 FD 7E 01    .~.   LD    A,(IY+01) 

+05DA CB 5F       ._    BIT   3,A 

+05DC 28 09       (.    JR    Z,05E7 

+05DE F6 30       .0    OR    30         ; Bit 4 + 5 setzen (XON/XOFF) 

+05E0 FD 77 01    .w.   LD    (IY+01),A 

+05E3 FD CB 01 46 ...F  BIT   0,(IY+01) 

+05E7 FB          .     EI 

+05E8 C9          .     RET              ;---------------------------------- 

+05E9 F3          .     DI               ; von RTS/DTR - XON/XOFF Routine 

+05EA FD 7E 01    .~.   LD    A,(IY+01)  ; aufgerufen

+05ED CB 5F       ._    BIT   3,A 

+05EF 28 0B       (.    JR    Z,05FC     ; Unbekannte Flusskontrolle

+05F1 F6 10       ..    OR    10 

+05F3 E6 DF       ..    AND   DF 

+05F5 FD 77 01    .w.   LD    (IY+01),A 

+05F8 FD CB 01 46 ...F  BIT   0,(IY+01) 

+05FC FB          .     EI 

+05FD C9          .     RET              ;----------- XON/XOFF setzen --------

+05FE FD CB 01 DE ....  SET   3,(IY+01) 

+0602 FD CB 01 D6 ....  SET   2,(IY+01) 

+0606 C9          .     RET              ;--------- IO-Stop d. Flow loeschen 

+0607 FD CB 01 9E ....  RES   3,(IY+01)  ; XON/XOFF loeschen

+060B FD CB 01 96 ....  RES   2,(IY+01) 

+060F FD CB 01 4E ...N  BIT   1,(IY+01)  ; XON Modus ?

+0613 FD CB 01 CE ....  SET   1,(IY+01)  ; XON-setzen

+0617 C9          .     RET              ;--------- Datenbitmasken --------- 

+0618 FD 73 0C    .s.   LD    (IY+0C),E  ; AND-maske fuer Datenbits setzen 

+061B FD 72 0D    .r.   LD    (IY+0D),D  ; Bei weniger als 5 Bits links 1er

+061E C9          .     RET              ;--------- Datenbitmasken setzen-- 

+061F FD 73 08    .s.   LD    (IY+08),E  ; AND  fuer fehlerfreien reiceive

+0622 FD 72 09    .r.   LD    (IY+09),D  ; XOR

+0625 C9          .     RET              ;--------- Datenbitmasken setzen 

+0626 FD 73 0A    .s.   LD    (IY+0A),E  ; AND fuer fehlerhaften receive

+0629 FD 72 0B    .r.   LD    (IY+0B),D  ; XOR

+062C C9          .     RET              ;-----------------------------------

+;======================== Illegaler Kanal ================================= 

+062D 01 5F 06                           ; 1, IOCONTROL "typ"

+0630 02 50 06                           ; 2, IOCONTROL "frout"

+0633 05 46 06                           ; 5, IOCONTROL "size"

+0636 FF 4C 06                           ; -1, IOCONTROL ill.

+0639 FF 55 06                           ; -1, Aufg. 5 Nicht moeglich

+063C FF 4C 06                           ; -1, BLOCKIN/BLOCKOUT nicht moegl. 

+063F 59 06                              ; Illegaler Kanal : OUTPUT 0659 

+0641 FD                                 ; BLOCKIN : 063C

+0642 FD                                 ; BLOCKOUT : 063C

+0643 EE                                 ; IOCONTROL : 062D

+0644 FA                                 ; Aufg. 5 : 0636

+0645 00                                 ; Keine I/O moeglich

+0646 3E 00       >.    LD    A,00       ; ---------- "size" --------------

+0648 01 00 00    ...   LD    BC,0000    ; Null Bloecke

+064B C9          .     RET              ;----------- "illegal" -1 ---------

+064C 01 FF FF    ...   LD    BC,FFFF    ; Kann nicht ausgefuehrt werden

+064F C9          .     RET              ;------------ "frout" -------------

+0650 01 C8 00    ...   LD    BC,00C8    ; kann 200 zeichen uebernehmen 

+0653 37          7     SCF              ; Puffer leer

+0654 C9          .     RET              ;---------- "nicht moegl" ----------

+0655 01 01 00    ...   LD    BC,0001    ; Liefert 1

+0658 C9          .     RET              ;---------- "OUTPUT" --------------

+0659 37          7     SCF              ; Alle Zeichen uebernommen 

+065A C9          .     RET              ;------------- "ok" ---------------- 

+065B 01 00 00    ...   LD    BC,0000 

+065E C9          .     RET              ; -------- "typ" ------------------ 

+065F 06 00       ..    LD    B,00       ; Type aus Parameterblock d. Kanals

+0661 DD 4E 06    .N.   LD    C,(IX+06) 

+0664 C9          .     RET              ;---------------------------------- 

+;=========================== Floppykanal ================================== 

+0665 05 95 06                           ; 5, IOCONTROL "size"

+0668 01 5F 06                           ; 1, IOCONTROL "typ"

+066B FF 4C 06                           ; -1, IOCONTROL ill.

+066E FE 85 06                           ; -2, Aufg. 5 : Kanal init

+0671 FF 55 06                           ; -1, Aufg. 5 : Geht nicht

+0674 00 9D 06                           ; 0, BLOCKIN : 069D

+0677 00 99 06                           ; 0, BLOCKOUT : 0699

+067A FF 4C 06                           ; -1, BLOCKOUT ill.

+067D 59 06                              ; Floppy: OUTPUT 0659 

+067F F7                                 ; BLOCKIN : 0674

+0680 FA                                 ; BLOCKOUT : 0677

+0681 E8                                 ; IOCONTROL : 0665

+0682 F1                                 ; Aufg. 5 : 066E

+0683 0C                                 ; Typ : BLOCKIO ohne format

+0684 04 

+0685 3E 70       >p    LD    A,70       ; ----------- Floppyinit ----------- 

+0687 D3 0A       ..    OUT   (0A),A     ; Interruptvektor PIOA Floppy = $70

+0689 11 58 09    .X.   LD    DE,0958    ; Interruptroutine FDC

+068C ED 57       .W    LD    A,I        ; In die Interruptvektortabelle 

+068E 67          g     LD    H,A        ; eintragen

+068F 2E 70       .p    LD    L,70 

+0691 73          s     LD    (HL),E 

+0692 23          #     INC   HL 

+0693 72          r     LD    (HL),D 

+0694 C9          .     RET              ;------------ "size" ---------------

+0695 01 D0 04    ...   LD    BC,04D0    ; 1232 Bloecke = 616K

+0698 C9          .     RET              ;----------- "BLOCKOUT" ----------- 

+0699 3E 01       >.    LD    A,01       ; A=1 : Write

+069B 18 01       ..    JR    069E       ; BLOCKIO

+069D AF          .     XOR   A          ;------------ "BLOCKIN" ---------- 

+069E E5          .     PUSH  HL         ; Hauptspeicheraddresse

+069F 21 CF 04    !..   LD    HL,04CF    ; Mit Max. Blocknummer

+06A2 B7          .     OR    A 

+06A3 ED 52       .R    SBC   HL,DE 

+06A5 E1          .     POP   HL 

+06A6 DA C9 0B    ...   JP    C,0BC9     ; Block zu hoch = 3

+06A9 E5          .     PUSH  HL 

+06AA 21 11 08    !..   LD    HL,0811    ; Floppysemaphor reservieren

+06AD CD 47 0C    .G.   CALL  0C47 

+06B0 E1          .     POP   HL 

+06B1 EB          .     EX    DE,HL      ; DE = Hauptspeicheraddresse

+06B2 4F          O     LD    C,A        ; A= Read/Write,HL = Blocknummer

+06B3 7D          }     LD    A,L 

+06B4 E6 0F       ..    AND   0F         ; A = Sektornummer 0..15

+06B6 CB 25       .%    SLA   L 

+06B8 CB 14       ..    RL    H          ; HL = Tracknummer 

+06BA CB 25       .%    SLA   L          ; Track = (Blocknr * 16) DIV 256

+06BC CB 14       ..    RL    H          ;       = Blocknr DIV 16

+06BE CB 25       .%    SLA   L 

+06C0 CB 14       ..    RL    H 

+06C2 CB 25       .%    SLA   L 

+06C4 CB 14       ..    RL    H 

+06C6 6F          o     LD    L,A        ; L = Sektor, H = Track

+06C7 79          y     LD    A,C        ; A = Read/Write

+06C8 B7          .     OR    A 

+06C9 FD 7E 08    .~.   LD    A,(IY+08) 

+06CC 28 05       (.    JR    Z,06D3     ; Z, wenn Read

+06CE CD CA 09    ...   CALL  09CA       ; Write Floppy (Interrupt anstossen)

+06D1 18 03       ..    JR    06D6       ; Skip

+06D3 CD BE 09    ...   CALL  09BE       ; Read Floppy (Interrupt anstossen)

+06D6 FD E5       ..    PUSH  IY 

+06D8 CD 19 1E    ...   CALL  1E19       ; Zur Sicherheit einmal 'warte'

+06DB FD E1       ..    POP   IY 

+06DD FD 7E 05    .~.   LD    A,(IY+05)  ; Return von Floppy-IRQ-Routine

+06E0 3C          <     INC   A 

+06E1 28 F3       (.    JR    Z,06D6     ; FF = Busy, IRQ noch nicht beendet

+06E3 21 11 08    !..   LD    HL,0811    ; Semaphor wieder freigeben

+06E6 CD 61 0C    .a.   CALL  0C61 

+06E9 3D          =     DEC   A          ; Muss = 0 sein, sonst fehler

+06EA C2 AE 0B    ...   JP    NZ,0BAE    ; Fehler ggf. melden

+06ED 01 00 00    ...   LD    BC,0000    ; Return: ok

+06F0 C9          .     RET              ;-----------------------------------

+;========================= Hintergrundkanal (Harddisk) ===================== 

+06F1 05 34 07                           ; 5, IOCONTROL "size"

+06F4 01 5F 06                           ; 1, IOCONTROL "typ"

+06F7 FF 4C 06                           ; -1, IOCONTROL ill.

+06FA FE 19 07                           ; -2, Aufg. 5 : kanal Init

+06FD 9C 3C 07                           ; -100, Aufg.5:Anz.HG-Bloecke setzen

+0700 FF 55 06                           ; -1, Aufg. 5 : BC = 1

+0703 00 4D 07                           ; 0, BLOCKIN

+0706 00 49 07                           ; 0, BLOCKOUT

+0709 FF 4C 06                           ; -1, BLOCKIO illg. 

+070C 59                                 ; Hintergrund : OUTPUT 0659

+070D 06 

+070E F7                                 ; BLOCKIN : 0703

+070F FA                                 ; BLOCKOUT : 0706

+0710 E5                                 ; IOCONTROL : 06F1

+0711 EE                                 ; Aufg. 5 : 06FA

+0712 0C                                 ; Typ : BLOCKIN/BLOCKOUT

+0713 00          .     NOP 

+0714 01 00 00    ...   LD    BC,0000 

+0717 00          .     NOP 

+0718 FF          .     RST   38         ;----------"HD-Init" --------------- 

+0719 21 DA 0F    !..   LD    HL,0FDA    ; Bei Floppy (0FDA) = 46H

+071C 22 0F 08    "..   LD    (080F),HL  ; Harddisktransferbufferaddresse

+071F DD 7E 0A    .~.   LD    A,(IX+0A)  ; New Cylinder Number

+0722 D3 22       ."    OUT   (22),A 

+0724 3E 70       >p    LD    A,70       ; Interruptvektor FDC+HDC

+0726 D3 0A       ..    OUT   (0A),A 

+0728 11 58 09    .X.   LD    DE,0958    ; Interruptserviceroutinenaddresse

+072B ED 57       .W    LD    A,I 

+072D 67          g     LD    H,A 

+072E 2E 70       .p    LD    L,70 

+0730 73          s     LD    (HL),E 

+0731 23          #     INC   HL 

+0732 72          r     LD    (HL),D 

+0733 C9          .     RET              ;------------ "size" --------------- 

+0734 FD 4E 01    .N.   LD    C,(IY+01)  ; HG-Maxblock Low

+0737 FD 46 02    .F.   LD    B,(IY+02)  ; High

+073A 03          .     INC   BC         ; +1 = Anzahl Bloecke

+073B C9          .     RET              ;------ Anzahl-HG-Bloecke setzen ---

+073C FD 75 01    .u.   LD    (IY+01),L  ; Letzter HD-Block 

+073F FD 74 02    .t.   LD    (IY+02),H 

+0742 FD 73 03    .s.   LD    (IY+03),E  ; Erster HD-Block

+0745 FD 72 04    .r.   LD    (IY+04),D 

+0748 C9          .     RET              ;-------- Hintergrund-Write --------- 

+0749 3E 01       >.    LD    A,01       ; 

+074B 18 01       ..    JR    074E       ;--------- Hintergrund-Read -------- 

+074D AF          .     XOR   A 

+074E E5          .     PUSH  HL         ; Blocknummer in DE

+074F FD 6E 01    .n.   LD    L,(IY+01)  ; Anzahl Hintergrundbloecke

+0752 FD 66 02    .f.   LD    H,(IY+02) 

+0755 B7          .     OR    A 

+0756 ED 52       .R    SBC   HL,DE 

+0758 E1          .     POP   HL 

+0759 DA C9 0B    ...   JP    C,0BC9     ; Block zu hoch

+075C E5          .     PUSH  HL 

+075D 21 11 08    !..   LD    HL,0811    ; Harddisksemaphor reservieren

+0760 CD 47 0C    .G.   CALL  0C47 

+0763 FD 6E 03    .n.   LD    L,(IY+03)  ; Erster Harddiskblock

+0766 FD 66 04    .f.   LD    H,(IY+04) 

+0769 19          .     ADD   HL,DE      ; + Blocknummer

+076A EB          .     EX    DE,HL 

+076B E1          .     POP   HL         ; DE=Blocknummer neu

+076C E5          .     PUSH  HL         ; HL=Hauptspeicherzieladdresse

+076D F5          .     PUSH  AF         ; Wird spaeter als BC gepopt

+076E B7          .     OR    A 

+076F 20 03        .    JR    NZ,0774    ; NZ=Write

+0771 2A 0F 08    *..   LD    HL,(080F)  ; Harddiskbufferaddresse

+0774 CD A5 07    ...   CALL  07A5       ; HDC fuer Transfer anstossen

+0777 DD E5       ..    PUSH  IX 

+0779 CD 19 1E    ...   CALL  1E19       ; 'warte' EUMEL0 aufrufen

+077C DD E1       ..    POP   IX 

+077E DD 7E 07    .~.   LD    A,(IX+07)  ; Harddisk ready ?

+0781 3C          <     INC   A          ; FF = not ready

+0782 28 F3       (.    JR    Z,0777     ; weiter warten

+0784 21 11 08    !..   LD    HL,0811    ; Semaphor freigeben

+0787 CD 61 0C    .a.   CALL  0C61 

+078A 3D          =     DEC   A          ; Fehlercode

+078B C1          .     POP   BC 

+078C E1          .     POP   HL 

+078D C2 AE 0B    ...   JP    NZ,0BAE    ; Bei Fehler melden 

+0790 78          x     LD    A,B        ; A=1 : Write

+0791 B7          .     OR    A 

+0792 20 0C        .    JR    NZ,07A0    ; Bei Write kein Transfer mehr

+0794 EB          .     EX    DE,HL      ; DE = Hauptspeicherzieladdresse

+0795 2A 0F 08    *..   LD    HL,(080F)  ; Hauptspeicher fuer HD-Transfer

+0798 23          #     INC   HL         ; Vorweg Status etc.

+0799 23          #     INC   HL 

+079A 23          #     INC   HL 

+079B 01 00 02    ...   LD    BC,0200    ; Vom HD-Buffer --> EUMEL-Block

+079E ED B0       ..    LDIR 

+07A0 01 00 00    ...   LD    BC,0000    ; "ok"

+07A3 C9          .     RET              ;----------------------------------

+07A4 C9          .     RET 

+07A5 E5          .     PUSH  HL         ;----------- HD-Transfer anstoss. --

+07A6 F5          .     PUSH  AF         ; A=1:Write,0=Read,HL=Mem.Addresse

+07A7 D5          .     PUSH  DE         ; DE=Blocknummer

+07A8 06 00       ..    LD    B,00       ; Cachesize = 21 max.

+07AA 3A 05 00    :..   LD    A,(0005)   ; (5) = Cachegroesse

+07AD B7          .     OR    A 

+07AE 28 26       (&    JR    Z,07D6     ; Nicht in Cache, neu berechnen

+07B0 4F          O     LD    C,A 

+07B1 7A          z     LD    A,D        ; D = Blocknummer High zum suchen

+07B2 21 05 00    !..   LD    HL,0005    ; Tabellenanfang = 6

+07B5 09          .     ADD   HL,BC      ; + Cachegroesse

+07B6 ED B9       ..    CPDR             ; Blocknummerhigh suchen 

+07B8 20 1C        .    JR    NZ,07D6    ; Nicht gefunden, Tabelle durch

+07BA F5          .     PUSH  AF         ; gefunden, test, ob Blocknummerlow 

+07BB E5          .     PUSH  HL         ; auch stimmt

+07BC 21 1A 00    !..   LD    HL,001A    ; Tabellenanfang = 27

+07BF 09          .     ADD   HL,BC 

+07C0 7B          {     LD    A,E        ; Blocknummer Low

+07C1 BE          .     CP    (HL) 

+07C2 28 07       (.    JR    Z,07CB     ; Ja, Block gefunden in Cache

+07C4 E1          .     POP   HL 

+07C5 F1          .     POP   AF 

+07C6 EA B6 07    ...   JP    PE,07B6    ; Noch nicht die ganze Tabelle durch

+07C9 18 0B       ..    JR    07D6       ; Ganz durch, neu berechnen 

+07CB E1          .     POP   HL         ; Aus Cache entnehmen

+07CC F1          .     POP   AF 

+07CD 21 44 00    !D.   LD    HL,0044 

+07D0 09          .     ADD   HL,BC 

+07D1 C1          .     POP   BC 

+07D2 EB          .     EX    DE,HL 

+07D3 C3 A7 07    ...   JP    07A7       ;---------------------------------- 

+07D6 E1          .     POP   HL 

+07D7 F1          .     POP   AF 

+07D8 D1          .     POP   DE 

+07D9 01 40 04    .@.   LD    BC,0440    ; 1088 Bloecke subtrahieren

+07DC F5          .     PUSH  AF         ; fuer Cylindernrhigh

+07DD AF          .     XOR   A 

+07DE ED 42       .B    SBC   HL,BC      ; 1088 = 17(sektoren)*4(heads)*16

+07E0 3C          <     INC   A 

+07E1 30 FB       0.    JR    NC,07DE    ; cylindernrh = blocknr DIV 1088

+07E3 09          .     ADD   HL,BC 

+07E4 3D          =     DEC   A          ; restbloecke in HL

+07E5 07          .     RLCA             ; ins hoeherwertige Nibble bringen 

+07E6 07          .     RLCA             ; (*16)

+07E7 07          .     RLCA 

+07E8 07          .     RLCA 

+07E9 F5          .     PUSH  AF 

+07EA 01 44 00    .D.   LD    BC,0044    ; Cylindernummerlow

+07ED AF          .     XOR   A          ; restblocknr DIV 68 = cylindernrl

+07EE ED 42       .B    SBC   HL,BC 

+07F0 3C          <     INC   A 

+07F1 30 FB       0.    JR    NC,07EE 

+07F3 09          .     ADD   HL,BC 

+07F4 3D          =     DEC   A 

+07F5 67          g     LD    H,A       ; Cylinder = cylinderl*16+cylinderh

+07F6 F1          .     POP   AF 

+07F7 B4          .     OR    H 

+07F8 67          g     LD    H,A       ; H = Cylinder

+07F9 7D          }     LD    A,L       ; Head = Blocknr MOD 4

+07FA E6 03       ..    AND   03 

+07FC 07          .     RLCA            ; Head ins Highnibble bringen

+07FD 07          .     RLCA 

+07FE 07          .     RLCA 

+07FF 07          .     RLCA 

+0800 CB 3D       .=    SLR   L         ; Sektor = restblocknr DIV 4

+0802 CB 3D       .=    SLR   L         ; 17. Sektor ist ungenutzt

+0804 4F          O     LD    C,A 

+0805 F1          .     POP   AF 

+0806 FE 01       ..    CP    01 

+0808 79          y     LD    A,C 

+0809 CA 6B 08    .k.   JP    Z,086B     ; Z, wenn Write

+080C C3 5C 08    .\.   JP    085C       ; Read

+080F 00          .     NOP              ; HD-Transferpuffer

+0810 00          .     NOP 

+0811 00          .     NOP 

+;=============================== Timerinterrupt ===========================

+0812 11 2D 08    .-.   LD    DE,082D    ;-------- Timer Init ----------------

+0815 ED 57       .W    LD    A,I 

+0817 67          g     LD    H,A 

+0818 2E C6       ..    LD    L,C6       ; HL = 00C6 Interruptserviceroutine 

+081A 3E 33       >3    LD    A,33       ; Fuer alle Kanaele einen programm. 

+081C E6 FC       ..    AND   FC         ; C0=0, C2=1, C4=2, C6=3(timer)

+081E 4F          O     LD    C,A 

+081F ED 69       .i    OUT   (C),L      ; Interruptvektor setzen

+0821 73          s     LD    (HL),E     ; Addresse der Serviceroutine 

+0822 23          #     INC   HL         ; --> (00C6) fuer CTC-Kanal 3 

+0823 72          r     LD    (HL),D 

+0824 3E B5       >.    LD    A,B5       ; IRQ,Timer,DIV256,pos.flanke,kein

+0826 D3 33       .3    OUT   (33),A     ; externer trigger, timeconst folgt

+0828 3E FA       >.    LD    A,FA       ; 250 = Zeitkonstante: 

+082A D3 33       .3    OUT   (33),A     ; Hz=4000000/256/250=62.5 ^ 16ms

+082C C9          .     RET              ;------ Timer-Service-IRQ --------- 

+082D F5          .     PUSH  AF 

+082E 3E 10       >.    LD    A,10       ; Alle 16ms Interrupt 

+0830 CD 16 1E    ...   CALL  1E16       ; "timerinterrupt" 

+0833 3A 5B 08    :[.   LD    A,(085B) 

+0836 3C          <     INC   A 

+0837 FE 3E       .>    CP    3E         ; Alle 62 Timerdurchlaeufe ~ 1s 

+0839 28 07       (.    JR    Z,0842 

+083B 32 5B 08    2[.   LD    (085B),A   ; Zaehler INCR 1

+083E F1          .     POP   AF 

+083F FB          .     EI 

+0840 ED 4D       .M    RETI             ;-------------IRQ-Ende-------------- 

+0842 AF          .     XOR   A          ; Sekundenzaehler auf 0

+0843 32 5B 08    2[.   LD    (085B),A 

+0846 DD E5       ..    PUSH  IX 

+0848 FD E5       ..    PUSH  IY 

+084A E5          .     PUSH  HL 

+084B D5          .     PUSH  DE 

+084C C5          .     PUSH  BC 

+084D C3 50 08    .P.   JP    0850       ; Wird jede Sekunde aufgerufen 

+0850 C1          .     POP   BC 

+0851 D1          .     POP   DE 

+0852 E1          .     POP   HL 

+0853 FD E1       ..    POP   IY 

+0855 DD E1       ..    POP   IX 

+0857 F1          .     POP   AF 

+0858 FB          .     EI 

+0859 ED 4D       .M    RETI             ;-----------IRQ-Ende---------------- 

+085B 00          .     NOP              ; Sekundenzaehler

+;============================= Harddisk I/O ===============================

+085C 0E 01       ..    LD    C,01       ;----------- HD-Read-Routine-------- 

+085E DD 36 09 01 .6..  LD    (IX+09),01 ; Read-Kommando fuer HDC

+0862 ED 53 AB 09 .S..  LD    (09AB),DE  ; Zieladdresse

+0866 11 02 02    ...   LD    DE,0202    ; 515 Bytes

+0869 18 0D       ..    JR    0878 

+086B 0E 05       ..    LD    C,05       ;---------- HD-Write-Routine ------- 

+086D DD 36 09 02 .6..  LD    (IX+09),02 ; (09BA) = Track(High),Sektor(Low)

+0871 ED 53 AB 09 .S..  LD    (09AB),DE  ; Sourceaddresse, 02 = WriteCMD HDC

+0875 11 FF 01    ...   LD    DE,01FF    ; 512 Bytes

+0878 DD 22 BC 09 ."..  LD    (09BC),IX  ; IX retten

+087C ED 53 AD 09 .S..  LD    (09AD),DE  ; Anzahl Bytes zu uebertragen

+0880 DD 36 0C 05 .6..  LD    (IX+0C),05 

+0884 22 BA 09    "..   LD    (09BA),HL 

+0887 DD 36 07 FF .6..  LD    (IX+07),FF 

+088B 2A BA 09    *..   LD    HL,(09BA) 

+088E F6 01       ..    OR    01         ; HD-Drive 1 auswaehlen

+0890 D3 20       .     OUT   (20),A     ; Head und Drive selektieren

+0892 57          W     LD    D,A 

+0893 79          y     LD    A,C 

+0894 32 B7 09    2..   LD    (09B7),A   ; Read or Write 01/05

+0897 DB 23       .#    IN    A,(23)     ; Status einlesen

+0899 CB 77       .w    BIT   6,A 

+089B 28 07       (.    JR    Z,08A4 

+089D 3E 02       >.    LD    A,02       ; NZ = "write fault"

+089F D3 20       .     OUT   (20),A     ; Drive 2 selektieren

+08A1 7A          z     LD    A,D        ; Headnummer setzen

+08A2 D3 20       .     OUT   (20),A 

+08A4 7C          |     LD    A,H        ; Cylindernummer

+08A5 DD BE 0A    ...   CP    (IX+0A)    ; = Alter Cylinder

+08A8 CA C4 08    ...   JP    Z,08C4     ; ja, kein neuer Cylinderseek

+08AB DD 7E 0A    .~.   LD    A,(IX+0A)  ; alten Cylinder holen --> HDC

+08AE D3 21       .!    OUT   (21),A     ; last significant Bits of CYL

+08B0 AF          .     XOR   A          ; most significant Bits of CYL = 0

+08B1 D3 21       .!    OUT   (21),A 

+08B3 7C          |     LD    A,H        ; Neue Cylindernummer

+08B4 D3 22       ."    OUT   (22),A     ; ausgeben und 

+08B6 DD 77 0A    .w.   LD    (IX+0A),A  ; vermerken

+08B9 AF          .     XOR   A          ; Most significant Bits = 0

+08BA D3 22       ."    OUT   (22),A 

+08BC 3E 10       >.    LD    A,10       ; Seek-Kommando an HDC

+08BE CD 5B 09    .[.   CALL  095B 

+08C1 2A BA 09    *..   LD    HL,(09BA)  ; Sektornummer

+08C4 7D          }     LD    A,L        ; ausgeben

+08C5 D3 21       .!    OUT   (21),A 

+08C7 21 A9 09    !..   LD    HL,09A9    ; DMA-Init-Tabelle

+08CA C5          .     PUSH  BC 

+08CB 01 00 11    ...   LD    BC,1100    ; DMA-Transfer vorbereiten

+08CE ED B3       ..    OTIR             ; 17 Bytes an DMA-Controller

+08D0 C1          .     POP   BC 

+08D1 DD 7E 09    .~.   LD    A,(IX+09)  ; 01=Read, 02=Write

+08D4 CD 5B 09    .[.   CALL  095B       ; An HDC-Controller schicken

+08D7 DD 36 0C FF .6..  LD    (IX+0C),FF ; Status in A

+08DB 21 40 09    !@.   LD    HL,0940    ; Fehlernummer (in L) --> IX+07 

+08DE E5          .     PUSH  HL 

+08DF 21 58 09    !X.   LD    HL,0958    ; HD-IRQ-Serviceroutine

+08E2 22 70 00    "p.   LD    (0070),HL  ; in Vektortabelle eintragen

+08E5 2E 00       ..    LD    L,00 

+08E7 E6 5D       .]    AND   5D         ; HD-Status in A

+08E9 CA 46 09    .F.   JP    Z,0946     ; "ok"

+08EC CB 5F       ._    BIT   3,A        ; NZ, wenn "Record not found"

+08EE C2 11 09    ...   JP    NZ,0911    ; 

+08F1 CB 67       .g    BIT   4,A        ; NZ, wenn "CRC error"

+08F3 28 03       (.    JR    Z,08F8 

+08F5 2E 02       ..    LD    L,02       ; 2 = "crc err"

+08F7 C9          .     RET              ;------------------------------- 

+08F8 CB 57       .W    BIT   2,A        ; NZ, wenn "bad sector"

+08FA 28 03       (.    JR    Z,08FF 

+08FC 2E 03       ..    LD    L,03       ; "bad sect"

+08FE C9          .     RET              ;-------------------------------

+08FF CB 77       .w    BIT   6,A        ; NZ, wenn "write fault"

+0901 28 0B       (.    JR    Z,090E 

+0903 2E 04       ..    LD    L,04       ; "write fault"

+0905 3E 02       >.    LD    A,02       ; Drive 2 selektieren

+0907 D3 20       .     OUT   (20),A 

+0909 E6 3F       .?    AND   3F 

+090B D3 20       .     OUT   (20),A     ; Heads 4..15 gibt es nicht

+090D C9          .     RET              ;-------------------------------

+090E 2E 05       ..    LD    L,05       ; "write fault" 

+0910 C9          .     RET              ;------------------------------ 

+0911 2E 07       ..    LD    L,07       ; "rec not fnd"

+0913 DD 35       .5    DEC   (IX+08)    ; Noch einmal

+0915 08          .     EX    AF,AF' 

+0916 C0          .     RET   NZ         ; Nach 8 Versuchen:

+0917 E1          .     POP   HL 

+0918 DD 36 0B 07 .6..  LD    (IX+0B),07 ; Register fuer Cylinderpos etc. 

+091C DD 36 08 08 .6..  LD    (IX+08),08 

+0920 DD 36 07 FF .6..  LD    (IX+07),FF 

+0924 DD 36 0C FF .6..  LD    (IX+0C),FF 

+0928 DD 36 0A 00 .6..  LD    (IX+0A),00 

+092C 3E 20       >     LD    A,20       ; Recalibrate Head

+092E CD 5B 09    .[.   CALL  095B       ; Kommando ausgeben

+0931 DD 7E 0B    .~.   LD    A,(IX+0B) 

+0934 DD 77 07    .w.   LD    (IX+07),A 

+0937 21 58 09    !X.   LD    HL,0958    ; Dummy-IRQ-Vektor (EI, RETI)

+093A 22 70 00    "p.   LD    (0070),HL 

+093D C3 A4 07    ...   JP    07A4       ; RET

+0940 DD 75 07    .u.   LD    (IX+07),L 

+0943 C3 A4 07    ...   JP    07A4       ; NOP oder RET (i.d.R RET)

+0946 3E BB       >.    LD    A,BB       ; Lesemaske setzen 

+0948 D3 00       ..    OUT   (00),A     ; DMA-Kommando

+094A 3E 01       >.    LD    A,01       ; BIT0 = Register 0 wird gelesen

+094C D3 00       ..    OUT   (00),A     ; Register 0 ist Statusregister

+094E DB 00       ..    IN    A,(00)     ; DMA-Status einlesen (Readregister0)

+0950 E6 21       .!    AND   21         ; Test, ob DMA laeuft

+0952 EE 01       ..    XOR   01         ; Kein Blockende und DMA erhielt BCK

+0954 C8          .     RET   Z          ; DMA- angestossen = 0

+0955 36 06       6.    LD    (HL),06    ; DMA-failed

+0957 C9          .     RET 

+0958 FB          .     EI 

+0959 ED 4D       .M    RETI             ;--------- Kommando an HDC -------- 

+095B E1          .     POP   HL         ; in A

+095C 22 7F 09    "..   LD    (097F),HL  ; Returnaddresse --> CALL Fehler 

+095F 21 68 09    !h.   LD    HL,0968    ; Interruptserviceroutine

+0962 22 70 00    "p.   LD    (0070),HL 

+0965 D3 23       .#    OUT   (23),A     ; Kommando ausgeben

+0967 C9          .     RET              ;-------- IRQ-Serviceroutine HDC-----

+0968 F5          .     PUSH  AF 

+0969 DD E5       ..    PUSH  IX 

+096B DD 2A BC 09 .*..  LD    IX,(09BC) 

+096F E5          .     PUSH  HL 

+0970 DB 08       ..    IN    A,(08)     ; HDC-IRQ ?

+0972 CB 7F       ..    BIT   7,A 

+0974 F5          .     PUSH  AF 

+0975 DB 23       .#    IN    A,(23)     ; Status lesen (wird geloescht)

+0977 67          g     LD    H,A 

+0978 3E 00       >.    LD    A,00 

+097A D3 23       .#    OUT   (23),A     ; Null (quiescent state) Kommando

+097C F1          .     POP   AF 

+097D 7C          |     LD    A,H 

+097E C4 67 09    .g.   CALL  NZ,0967   ; Fehler --> L bringen

+0981 DB 04       ..    IN    A,(04)    ; Drive/Controller Status FDC 

+0983 E1          .     POP   HL 

+0984 DD E1       ..    POP   IX 

+0986 F1          .     POP   AF 

+0987 FB          .     EI 

+0988 ED 4D       .M    RETI             ;----------------------------------- 

+098A F5          .     PUSH  AF 

+098B E5          .     PUSH  HL 

+098C DD E5       ..    PUSH  IX 

+098E DB 23       .#    IN    A,(23)     ; Status einlesen (dummy)

+0990 DD 2A BC 09 .*..  LD    IX,(09BC) 

+0994 3E 40       >@    LD    A,40       ; Welches Kommando ist das ???!!!

+0996 D3 23       .#    OUT   (23),A 

+0998 DB 04       ..    IN    A,(04)     ; FDC-Status einlesen

+099A DD 36 07 08 .6..  LD    (IX+07),08 

+099E 21 58 09    !X.   LD    HL,0958    ; Dummy-IRQ-Vektor

+09A1 22 70 00    "p.   LD    (0070),HL 

+09A4 DD E1       ..    POP   IX 

+09A6 E1          .     POP   HL 

+09A7 F1          .     POP   AF 

+09A8 C9          .     RET              ; DMA-Initialisierungstabelle -HDC-

+                            ;-DMA-Register 6 (Kommandoregister) "RESET"

+09A9 C3                                 ; Softreset an DMA-Controller

+                            ;-DMA-Register 0 (Port A Addressregister) 

+09AA 7D                                 ; A --> B uebertragen, BL & Adr folgt

+09AB 00 00                              ; Startaddresse Port A 

+09AD FF 01                              ; Anzahl Bytes -1 (Bytecount) 

+                            ;-DMA-Register 1 (Port A Modus)

+09AF 14                                 ; Port A ist Speicher, INCR Adress

+                            ;-DMA-Register 2 (Port B Modus) 

+09B0 28                                 ; Port B ist IO-Port, Adr. konstant 

+                            ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.)

+09B1 A5                                 ; Blockmodus, IO-Port B folgt 

+09B2 21                                 ; 21 = Data I/O-Port fuer HDC

+                            ;-DMA-Register 5 (Pin-Control)

+09B3 8A                                 ; Stop am Blockende,Pin16=-CE,RDYakt1

+                            ;-DMA-Register 6 (Kommando) "LOAD"

+09B4 CF                                 ; Adresse & BL aus WR0/WR4 laden 

+09B5 01                                 ; Wegen Maskenfehler: Direction umk. 

+09B6 CF                                 ;        "         Kommando "LOAD"

+09B7 01                                 ; 01 : B-->A, 05 : A-->B

+09B8 CF                                 ; Kommando : "LOAD"

+09B9 87                                 ; DMA-Freigabe       ------ bis hier

+09BA 00          .     NOP              ; Bereich fuer IX (retten) 

+09BB 00          .     NOP 

+09BC 00          .     NOP              ; Sektornummer, 09BD = Tracknummer 

+09BD 00          .     NOP              ;------- Floppy-Read anstoss.------ 

+;============================= Floppy I/O ==================================

+09BE FD 36 01 9F .6..  LD    (IY+01),9F ; AND-Maske fuer FDC-Status-ready

+09C2 0E 01       ..    LD    C,01       ; DMA-Read-Kommando

+09C4 FD 36 02 88 .6..  LD    (IY+02),88 ; FDC-Kommando read

+09C8 18 0A       ..    JR    09D4 

+09CA FD 36 01 FF .6..  LD    (IY+01),FF ;------- Floppy-Write anstoss.------ 

+09CE 0E 05       ..    LD    C,05       ; AND-Maske fuer FDC-Status-ready

+09D0 FD 36 02 A8 .6..  LD    (IY+02),A8 ; ^ DMA-Write-Kommando,FDC-Kommandowrite 

+09D4 FD 22 B1 0A ."..  LD    (0AB1),IY  ; IY retten

+09D8 FB          .     EI 

+09D9 E5          .     PUSH  HL 

+09DA 21 C1 0A    !..   LD    HL,0AC1    ; DMA-Direction-Byte

+09DD 71          q     LD    (HL),C 

+09DE E1          .     POP   HL 

+09DF FD 36 0A 46 .6.F  LD    (IY+0A),46 

+09E3 ED 53 B5 0A .S..  LD    (0AB5),DE  ; Zieladdresse fuer DMA 

+09E7 FD 36 05 FF .6..  LD    (IY+05),FF 

+09EB CB BF       ..    RES   7,A 

+09ED DD BE 07    ...   CP    (IX+07) 

+09F0 28 1C       (.    JR    Z,0A0E 

+09F2 DD 77 07    .w.   LD    (IX+07),A 

+09F5 22 C4 0A    "..   LD    (0AC4),HL  ; track/sektor retten

+09F8 FD 7E 06    .~.   LD    A,(IY+06) 

+09FB D3 05       ..    OUT   (05),A     ;  Tracknummer

+09FD D3 07       ..    OUT   (07),A     ;  Output to FDC

+09FF 3E 12       >.    LD    A,12       ; FDC-Kommando

+0A01 CD 76 0A    .v.   CALL  0A76 

+0A04 FD 7E 09    .~.   LD    A,(IY+09)  ; Floppydrive (Headselect)

+0A07 CB C7       ..    SET   0,A        ; Single Density

+0A09 D3 08       ..    OUT   (08),A     ; Floppy Format + Headselect

+0A0B 2A C4 0A    *..   LD    HL,(0AC4)  ; geretteter Sektor 

+0A0E 7D          }     LD    A,L        ; Sektornumber

+0A0F D3 06       ..    OUT   (06),A 

+0A11 7C          |     LD    A,H        ; Tracknummer

+0A12 FD BE 06    ...   CP    (IY+06) 

+0A15 28 0A       (.    JR    Z,0A21 

+0A17 FD 77 06    .w.   LD    (IY+06),A 

+0A1A D3 07       ..    OUT   (07),A     ; Outputdatabyte Track setzen

+0A1C 3E 1A       >.    LD    A,1A       ; FDC-Kommando

+0A1E CD 76 0A    .v.   CALL  0A76 

+0A21 DB 08       ..    IN    A,(08)     ; Headloadinput testen

+0A23 CB 4F       .O    BIT   1,A 

+0A25 FD 7E 02    .~.   LD    A,(IY+02)  ; Read/Write-Kommando an FDC

+0A28 20 02        .    JR    NZ,0A2C    ; Head ist auf der Floppy

+0A2A CB D7       ..    SET   2,A        ; Head muss noch auf Floppy

+0A2C 21 B3 0A    !..   LD    HL,0AB3    ; DMA-Tabelle 

+0A2F 01 00 11    ...   LD    BC,1100    ; 17 Bytes in DMA schreiben

+0A32 ED B3       ..    OTIR 

+0A34 CD 76 0A    .v.   CALL  0A76       ; FDC-Kommando ausgeben (starten)

+0A37 FD 36 0A FF .6..  LD    (IY+0A),FF 

+0A3B 21 AE 0A    !..   LD    HL,0AAE 

+0A3E 22 70 00    "p.   LD    (0070),HL 

+0A41 DB 04       ..    IN    A,(04)     ; FDC - Status

+0A43 FD A6 01    ...   AND   (IY+01)    ; maske fuer 'fehler'

+0A46 CB 7F       ..    BIT   7,A 

+0A48 20 11        .    JR    NZ,0A5B    ; ist noch busy

+0A4A B7          .     OR    A          ; Irgendwelche Fehler ?

+0A4B 20 05        .    JR    NZ,0A52 

+0A4D FD 36 05 00 .6..  LD    (IY+05),00 ; Kein Fehler, "ok"

+0A51 C9          .     RET 

+0A52 CB 67       .g    BIT   4,A        ; CRC ?

+0A54 20 0A        .    JR    NZ,0A60 

+0A56 FD 36 05 02 .6..  LD    (IY+05),02 ; Fehler "crc err"

+0A5A C9          .     RET 

+0A5B FD 36 05 01 .6..  LD    (IY+05),01 ; Fehler 1 : "busy"

+0A5F C9          .     RET 

+0A60 FD 36 05 FF .6..  LD    (IY+05),FF ; Interrupt noch nicht beendet setz.

+0A64 3E 0A       >.    LD    A,0A       ; Kommando 10 an FDC

+0A66 CD 76 0A    .v.   CALL  0A76 

+0A69 FD 36 05 02 .6..  LD    (IY+05),02 ; Fehler 2 : "crc err"

+0A6D DB 04       ..    IN    A,(04)     ; FDC-Status

+0A6F 21 AE 0A    !..   LD    HL,0AAE    ; Dummy-IRQ Vektor (EI, RETI)

+0A72 22 70 00    "p.   LD    (0070),HL  ; eintragen

+0A75 C9          .     RET              ;----------FDC Kommandoausgeben----

+0A76 E1          .     POP   HL         ; Returnaddresse = Fehlernr.laden

+0A77 22 A5 0A    "..   LD    (0AA5),HL 

+0A7A 21 96 0A    !..   LD    HL,0A96 

+0A7D 22 70 00    "p.   LD    (0070),HL  ; Floppy IRQ-Vektor setzen

+0A80 D3 04       ..    OUT   (04),A     ; 1797 FDC Command

+0A82 C9          .     RET              ;----------------------------------

+0A83 F5          .     PUSH  AF 

+0A84 FD 2A B1 0A .*..  LD    IY,(0AB1)  ; geretteter IY

+0A88 FD 36 05 02 .6..  LD    (IY+05),02 ; "crc err"

+0A8C E5          .     PUSH  HL 

+0A8D 21 AE 0A    !..   LD    HL,0AAE    ; Dummy-Interrupt-Vektor

+0A90 22 70 00    "p.   LD    (0070),HL 

+0A93 E1          .     POP   HL 

+0A94 F1          .     POP   AF 

+0A95 C9          .     RET              ;----- IRQ-Service-Routine ---------

+0A96 FB          .     EI               ; 

+0A97 FD E5       ..    PUSH  IY 

+0A99 E5          .     PUSH  HL 

+0A9A C5          .     PUSH  BC 

+0A9B F5          .     PUSH  AF 

+0A9C FD 2A B1 0A .*..  LD    IY,(0AB1)  ; geretteter IY

+0AA0 DB 08       ..    IN    A,(08)     ; IRQ-Anford.Register

+0AA2 CB 77       .w    BIT   6,A        ; BIT6=FDC IRQ aufgetreten

+0AA4 C4 82 0A    ...   CALL  NZ,0A82    ; Returnaddresse in CALL-Addresse

+0AA7 DB 23       .#    IN    A,(23)     ; Statusbyte Harddisk loeschen

+0AA9 F1          .     POP   AF 

+0AAA C1          .     POP   BC 

+0AAB E1          .     POP   HL 

+0AAC FD E1       ..    POP   IY 

+0AAE FB          .     EI 

+0AAF ED 4D       .M    RETI             ;-----------------------------------

+0AB1 00          .     NOP              ; Platz zum retten von IY 

+0AB2 00          .     NOP              ;- DMA-Initialisierung fuer FDC --- 

+0AB3 C3                                 ; Softreset an DMA-Controller

+                            ;-DMA-Register 0 (Port A Addressregister) 

+0AB4 7D                                 ; A --> B uebertragen, BL & Adr folgt

+0AB5 00 00                              ; Startaddresse Port A 

+0AB7 FF 01                              ; Anzahl Bytes -1 (Bytecount) 

+                            ;-DMA-Register 1 (Port A Modus)

+0AB9 14                                 ; Port A ist Speicher, INCR Adress

+                            ;-DMA-Register 2 (Port B Modus) 

+0ABA 28                                 ; Port B ist IO-Port, Adr. konstant 

+                            ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.)

+0ABB 85                                 ; Einzelbytemodus(!) IO-Port B folgt 

+0ABC 07                                 ; 01 = Data I/O-Port fuer FDC

+                            ;-DMA-Register 5 (Pin-Control)

+0ABD 8A                                 ; Stop am Blockende,Pin16=-CE,RDYakt1

+                            ;-DMA-Register 6 (Kommando) "LOAD"

+0ABE CF                                 ; Adresse & BL aus WR0/WR4 laden 

+0ABF 01                                 ; Wegen Maskenfehler: Direction umk. 

+0AC0 CF                                 ;        "         Kommando "LOAD"

+0AC1 01                                 ; 01 : B-->A, 05 : A-->B

+0AC2 CF                                 ; Kommando : "LOAD"

+0AC3 87                                 ; DMA-Freigabe       ------ bis hier

+0AC4 00 00                              ;---------------------------------- 

+;=========================== Parallel Kanaele =============================

+0AC6 01 5F 06                           ; 1 IOCONTROL "typ"

+0AC9 02 7B 0B                           ; 2 IOCONTROL "frout"

+0ACC 05 46 06                           ; 5 IOCONTROL "size"

+0ACF FD 07 0B                           ; -3 IOCONTROL "Printerstat --> BC" 

+0AD2 FC FF 0A                           ; -4 IOCONTROL"code2 --> Printerport" 

+0AD5 FB 03 0B                           ; -5 IOCONTROL"code2 --> Pstatusport"

+0AD8 FF 4C 06                           ; -1 IOCONTROL ill.

+0ADB E2 0D 0B                           ; -30 Aufg. 5, Maske fuer Busy-Status

+0ADE E1 14 0B                           ; -31 Aufg. 5, Maske fuer Printerstb.

+0AE1 FE F1 0A                           ; -2  Aufg. 5 = Kanal init

+0AE4 FF 55 06                           ; -1, Aufg. 5 --> BC = 1 

+0AE7 FF 4C 06                           ; -1, BLOCKIN, BLOCKOUT ill.

+0AEA 1E                                 ; Parallel 0B1E = OUTPUT

+0AEB 0B          .     DEC   BC 

+0AEC FD          .                      ; BLOCKIN : 0AE7

+0AED FD          .                      ; BLOCKOUT : 0AE7

+0AEE DC                                 ; IOCONTROL : 0AC6

+0AEF F1                                 ; Aufg. 5 : 0ADB

+0AF0 03                                 ; Typ : Input/Ouput (Stream)

+0AF1 DB 10       ..    IN    A,(10)     ;-------- Kanal Init --------------- 

+0AF3 FD A6 03    ...   AND   (IY+03)    ; Printer selektieren

+0AF6 FD AE 04    ...   XOR   (IY+04) 

+0AF9 FD AE 05    ...   XOR   (IY+05) 

+0AFC D3 10       ..    OUT   (10),A     ; Ausgabe an Printerstatusport

+0AFE C9          .     RET              ;----------- "IOCONTROL -4" --------

+0AFF 7B          {     LD    A,E        ; Printerdata direkt ausgeben 

+0B00 D3 11       ..    OUT   (11),A 

+0B02 C9          .     RET              ;---------- "IOCONTROL -5"- --------

+0B03 7B          {     LD    A,E        ; datastrobe, input prime, control 

+0B04 D3 10       ..    OUT   (10),A     ; An Statusport (printer) ausgeben 

+0B06 C9          .     RET              ;-------- "IOCONTROL -3" -----------

+0B07 DB 10       ..    IN    A,(10)     ; Liest der Printerstatus ein 

+0B09 4F          O     LD    C,A 

+0B0A 06 00       ..    LD    B,00 

+0B0C C9          .     RET              ;----- Aufg. 5, "-14" -------------- 

+0B0D FD 73 01    .s.   LD    (IY+01),E  ; code2 --> AND/XOR Masken "Busy"

+0B10 FD 72 02    .r.   LD    (IY+02),D 

+0B13 C9          .     RET              ;----- Aufg. 5, "-15" ------------- 

+0B14 FD 73 03    .s.   LD    (IY+03),E  ; code2, code3 --> Maske "selekt" 

+0B17 FD 72 04    .r.   LD    (IY+04),D 

+0B1A FD 74 05    .t.   LD    (IY+05),H 

+0B1D C9          .     RET              ;--------- "OUTPUT" --------------- 

+0B1E 78          x     LD    A,B        ; Nichts auszugeben ? 

+0B1F B1          .     OR    C 

+0B20 37          7     SCF 

+0B21 C8          .     RET   Z 

+0B22 C5          .     PUSH  BC 

+0B23 DB 10       ..    IN    A,(10)     ; Status einelsen

+0B25 FD A6 03    ...   AND   (IY+03)    ; Printerselekt.

+0B28 FD AE 04    ...   XOR   (IY+04) 

+0B2B 57          W     LD    D,A 

+0B2C FD AE 05    ...   XOR   (IY+05) 

+0B2F 5F          _     LD    E,A 

+0B30 E5          .     PUSH  HL 

+0B31 09          .     ADD   HL,BC      ; Ende des Textes

+0B32 E3          .     EX    (SP),HL 

+0B33 41          A     LD    B,C        ; Textlaenge Low (Pbuffersize < 256)

+0B34 0E 11       ..    LD    C,11       ; Dataport = 11H

+0B36 DB 10       ..    IN    A,(10)     ; Printer busy ?

+0B38 FD A6 01    ...   AND   (IY+01) 

+0B3B FD AE 02    ...   XOR   (IY+02) 

+0B3E 20 1B        .    JR    NZ,0B5B    ; testen, ob printer da

+0B40 ED A3       ..    OUTI             ; Ein Zeichen ausgeben

+0B42 7A          z     LD    A,D 

+0B43 D3 10       ..    OUT   (10),A     ; Printer Strobe an

+0B45 7B          {     LD    A,E 

+0B46 D3 10       ..    OUT   (10),A     ; printer Strobe aus

+0B48 20 EC        .    JR    NZ,0B36    ; Naechstes Zeichen

+0B4A 44          D     LD    B,H 

+0B4B 4D          M     LD    C,L 

+0B4C E1          .     POP   HL 

+0B4D E5          .     PUSH  HL 

+0B4E B7          .     OR    A          ; Anzahl Restzeichen --> BC

+0B4F ED 42       .B    SBC   HL,BC 

+0B51 E5          .     PUSH  HL 

+0B52 C5          .     PUSH  BC 

+0B53 E1          .     POP   HL 

+0B54 C1          .     POP   BC 

+0B55 20 DC        .    JR    NZ,0B33    ; Nochmal mit dem rest aufrufen

+0B57 E1          .     POP   HL 

+0B58 C1          .     POP   BC 

+0B59 37          7     SCF              ; Alles uebernommen 

+0B5A C9          .     RET              ;----------

+0B5B CD 72 0B    .r.   CALL  0B72       ; test,. ob printer bereit

+0B5E 28 E0       (.    JR    Z,0B40 

+0B60 CD 72 0B    .r.   CALL  0B72 

+0B63 28 DB       (.    JR    Z,0B40     

+0B65 54          T     LD    D,H 

+0B66 5D          ]     LD    E,L        

+0B67 E1          .     POP   HL 

+0B68 B7          .     OR    A 

+0B69 ED 52       .R    SBC   HL,DE 

+0B6B EB          .     EX    DE,HL 

+0B6C E1          .     POP   HL         

+0B6D ED 52       .R    SBC   HL,DE      ; Nicht alles uebernommen

+0B6F 44          D     LD    B,H 

+0B70 4D          M     LD    C,L 

+0B71 C9          .     RET              ; ----------- "printerstatus" ----- 

+0B72 DB 10       ..    IN    A,(10)     ; Status einlesen

+0B74 FD A6 01    ...   AND   (IY+01)    ; Maskieren 

+0B77 FD AE 02    ...   XOR   (IY+02)    ; Kanal 7..9 selektieren 

+0B7A C9          .     RET              ;-------------- "frout" ------------ 

+0B7B CD 72 0B    .r.   CALL  0B72       ; Puffer voll ?

+0B7E CA 50 06    .P.   JP    Z,0650     ; Nein, kann 200 Zeichen uebernehmen 

+0B81 B7          .     OR    A 

+0B82 01 00 00    ...   LD    BC,0000    ; Druckerpuffer voll --> 0 Zeichen 

+0B85 C9          .     RET              ;--------- Aufg. 5 -2 ------------- 

+;================== Sonstige Shard-Routinen (Non I/O) =====================

+0B86 C3 12 08    ...   JP    0812       ; Init Parameterkanal = Timerinit 

+0B89 ED B0       ..    LDIR             ;------------ "LONGMOVE" ----------- 

+0B8B C9          .     RET              ;------------- "LIMIT" ------------- 

+0B8C 11 FF FF    ...   LD    DE,FFFF    ; Geht bis zum RAM-Ende

+0B8F C9          .     RET              ;------------ "SCHINF" ------------- 

+0B90 01 00 00    ...   LD    BC,0000    ; Kein Schattenspeicher vorhanden ? 

+0B93 C9          .     RET              ;------------ "SCHACC" --------------

+0B94 F5          .     PUSH  AF 

+0B95 E5          .     PUSH  HL 

+0B96 CB 2C       .,    SRA   H 

+0B98 CB 1D       ..    RR    L 

+0B9A 7D          }     LD    A,L 

+0B9B CD AD 0B    ...   CALL  0BAD 

+0B9E E1          .     POP   HL                           ?

+0B9F 7D          }     LD    A,L 

+0BA0 21 00 FC    !..   LD    HL,FC00 

+0BA3 CB 47       .G    BIT   0,A 

+0BA5 28 03       (.    JR    Z,0BAA 

+0BA7 21 00 FE    !..   LD    HL,FE00 

+0BAA F1          .     POP   AF 

+0BAB C9          .     RET 

+0BAC C9          .     RET              ; -----------"SYSEND"-------------- 

+0BAD C9          .     RET              ; ----- SHARD-fehler melden ------ 

+0BAE E1          .     POP   HL         ; Ruecksprungaddresse 

+0BAF E3          .     EX    (SP),HL 

+0BB0 21 CD 0B    !..   LD    HL,0BCD    ; Tabellenanfang Fehlernummer + text

+0BB3 16 00       ..    LD    D,00 

+0BB5 4E          N     LD    C,(HL)     ; Textnummer aus Tabelle 

+0BB6 23          #     INC   HL 

+0BB7 B9          .     CP    C          ; gesucht und gefunden ?

+0BB8 28 09       (.    JR    Z,0BC3     ; Ja, gefunden. Nummer melden

+0BBA 0C          .     INC   C          ; Naechste Fehlernummer

+0BBB 28 06       (.    JR    Z,0BC3 

+0BBD 23          #     INC   HL 

+0BBE 5E          ^     LD    E,(HL) 

+0BBF 23          #     INC   HL 

+0BC0 19          .     ADD   HL,DE 

+0BC1 18 F2       ..    JR    0BB5       ; Naechsten nehmen

+0BC3 4E          N     LD    C,(HL)     ; Fehlernummer in BC

+0BC4 06 00       ..    LD    B,00 

+0BC6 23          #     INC   HL 

+0BC7 E3          .     EX    (SP),HL    ; Zur Rueckspungaddresse

+0BC8 E9          .     JP    (HL) 

+0BC9 3E 09       >.    LD    A,09       ; Block zu hoch

+0BCB 18 E1       ..    JR    0BAE       ; melden ------------------------

+0BCD 01 01 09    ...   LD    BC,0901    ; #1 : "not ready", Typ 1

+0BD0 6E          n     LD    L,(HL) 

+0BD1 6F          o     LD    L,A 

+0BD2 74          t     LD    (HL),H 

+0BD3 20 72        r    JR    NZ,0C47 

+0BD5 65          e     LD    H,L 

+0BD6 61          a     LD    H,C        

+0BD7 64          d     LD    H,H 

+0BD8 79          y     LD    A,C 

+0BD9 02          .     LD    (BC),A     ; #2 : "crc err". Typ 2

+0BDA 02          .     LD    (BC),A 

+0BDB 07          .     RLCA 

+0BDC 63          c     LD    H,E 

+0BDD 72          r     LD    (HL),D 

+0BDE 63          c     LD    H,E        

+0BDF 20 65        e    JR    NZ,0C46 

+0BE1 72          r     LD    (HL),D     

+0BE2 72          r     LD    (HL),D 

+0BE3 03          .     INC   BC         ; #3 : "bad sect". Typ 2

+0BE4 02          .     LD    (BC),A 

+0BE5 08          .     EX    AF,AF' 

+0BE6 62          b     LD    H,D 

+0BE7 61          a     LD    H,C 

+0BE8 64          d     LD    H,H 

+0BE9 20 73        s    JR    NZ,0C5E 

+0BEB 65          e     LD    H,L 

+0BEC 63          c     LD    H,E 

+0BED 74          t     LD    (HL),H 

+0BEE 04          .     INC   B          ; #4 : "write fault". Typ 2

+0BEF 02          .     LD    (BC),A 

+0BF0 0B          .     DEC   BC 

+0BF1 77          w     LD    (HL),A 

+0BF2 72          r     LD    (HL),D 

+0BF3 69          i     LD    L,C 

+0BF4 74          t     LD    (HL),H 

+0BF5 65          e     LD    H,L 

+0BF6 20 66        f    JR    NZ,0C5E    

+0BF8 61          a     LD    H,C 

+0BF9 75          u     LD    (HL),L 

+0BFA 6C          l     LD    L,H 

+0BFB 74          t     LD    (HL),H 

+0BFC 05          .     DEC   B          ; #5 : "busy". Typ 2

+0BFD 02          .     LD    (BC),A 

+0BFE 04          .     INC   B 

+0BFF 62          b     LD    H,D        

+0C00 75          u     LD    (HL),L 

+0C01 73          s     LD    (HL),E     

+0C02 79          y     LD    A,C        

+0C03 06 02       ..    LD    B,02       ; #6 : "dma failed". Typ 2

+0C05 0A          .     LD    A,(BC) 

+0C06 64          d     LD    H,H 

+0C07 6D          m     LD    L,L 

+0C08 61          a     LD    H,C        

+0C09 20 66        f    JR    NZ,0C71 

+0C0B 61          a     LD    H,C        

+0C0C 69          i     LD    L,C 

+0C0D 6C          l     LD    L,H 

+0C0E 65          e     LD    H,L 

+0C0F 64          d     LD    H,H 

+0C10 07          .     RLCA             ; #7 : "rec not fnd". Typ 2

+0C11 02          .     LD    (BC),A 

+0C12 0B          .     DEC   BC 

+0C13 72          r     LD    (HL),D     

+0C14 65          e     LD    H,L 

+0C15 63          c     LD    H,E 

+0C16 20 6E        n    JR    NZ,0C86 

+0C18 6F          o     LD    L,A 

+0C19 74          t     LD    (HL),H     

+0C1A 20 66        f    JR    NZ,0C82 

+0C1C 6E          n     LD    L,(HL) 

+0C1D 64          d     LD    H,H 

+0C1E 08          .     EX    AF,AF'     ; #8 : "timeout". Typ 2

+0C1F 02          .     LD    (BC),A 

+0C20 07          .     RLCA 

+0C21 74          t     LD    (HL),H 

+0C22 69          i     LD    L,C 

+0C23 6D          m     LD    L,L        

+0C24 65          e     LD    H,L 

+0C25 6F          o     LD    L,A 

+0C26 75          u     LD    (HL),L 

+0C27 74          t     LD    (HL),H 

+0C28 09          .     ADD   HL,BC      ; #9 : "block zu hoch". Typ 3

+0C29 03          .     INC   BC 

+0C2A 0D          .     DEC   C 

+0C2B 62          b     LD    H,D 

+0C2C 6C          l     LD    L,H 

+0C2D 6F          o     LD    L,A 

+0C2E 63          c     LD    H,E 

+0C2F 6B          k     LD    L,E 

+0C30 20 7A        z    JR    NZ,0CAC 

+0C32 75          u     LD    (HL),L 

+0C33 20 68        h    JR    NZ,0C9D 

+0C35 6F          o     LD    L,A        

+0C36 63          c     LD    H,E 

+0C37 68          h     LD    L,B 

+0C38 FF          .     RST   38         ; #255 : "wrg err code". Typ 1 

+0C39 01 0C 77    ..w   LD    BC,770C 

+0C3C 72          r     LD    (HL),D 

+0C3D 67          g     LD    H,A 

+0C3E 20 65        e    JR    NZ,0CA5 

+0C40 72          r     LD    (HL),D 

+0C41 72          r     LD    (HL),D 

+0C42 20 63        c    JR    NZ,0CA7 

+0C44 6F          o     LD    L,A 

+0C45 64          d     LD    H,H 

+0C46 65          e     LD    H,L 

+;=============================== Semaphorhandler =========================== 

+0C47 35          5     DEC   (HL)       ; --- Semaphor (HL) testen, warte -- 

+0C48 34          4     INC   (HL) 

+0C49 36 01       6.    LD    (HL),01    ; Semaphor belegen 

+0C4B C8          .     RET   Z          ; unbeleget, return

+0C4C E5          .     PUSH  HL         ; Register fuer 'warte' retten

+0C4D DD E5       ..    PUSH  IX 

+0C4F FD E5       ..    PUSH  IY 

+0C51 C5          .     PUSH  BC 

+0C52 D5          .     PUSH  DE 

+0C53 F5          .     PUSH  AF 

+0C54 CD 19 1E    ...   CALL  1E19       ; "warte" bis Semaphor frei

+0C57 F1          .     POP   AF 

+0C58 D1          .     POP   DE 

+0C59 C1          .     POP   BC 

+0C5A FD E1       ..    POP   IY 

+0C5C DD E1       ..    POP   IX 

+0C5E E1          .     POP   HL 

+0C5F 18 E6       ..    JR    0C47      ; Semaphor jetzt frei ? 

+0C61 36 00       6.    LD    (HL),00    ; -------- Sempahor freigeben ------ 

+0C63 C9          .     RET 

+;=========================== Kanalpuffer + Kanalstatusbytes ================ 

+ 

+;----------------------------- Hintergrund Kanal 0 ------------------------

+0C64 00                                 ; Hintergrund 

+0C65 FF 43                              ; letzter EUMEL-Block (8,5MB)

+0C67 00 00                              ; erster EUMEL-Block

+ 

+;----------------------------- Serieller Kanal 1 ------------------------- 

+0C69 FF                                 ; 100 Bytes Puffer fuer Kanal 1

+     ... 

+0CCC FF 

+0CCD 01                           IY+00 ; Kanal 1 

+0CCE 03                              01 ; Flusskontrollen Bits 

+                                          BIT 0 : 

+                                          BIT 1 : 0 = XOFF-Status, 1=XON

+                                          BIT 2 : XON/XOFF bei receive

+                                          BIT 3 : XON/XOFF bei transmit

+0CCF 64                              02 ; Puffergroesse = 100 

+0CD0 00                              03 ; Pufferzeiger Write

+0CD1 00                              04 ; Pufferzeiger Read 

+0CD2 00                              05 ; 

+0CD3 69 0C                           06 ; 0C69 = Pufferanfang 

+0CD5 7F                              08 ; AND-maske f. fehlerfreien receive 

+0CD6 00                              09 ; Datenbitmaske XOR   "

+0CD7 7F                              0A ; AND-maske f. fehlerhaften reiceive 

+0CD8 00                              0B ; Datenbitmaske XOR  "

+0CD9 7F                              0C ; Maske fuer Read aus Puffer AND

+0CDA 00                              0D ;    "                       XOR

+0CDB 3F        ?                     0E ; Zeichen fuer Fehlerhaften Receive 

+0CDC 13                              0F ; 19 = Stop (XOFF)

+0CDD 11                              10 ; 17 = Weiter (XON)

+0CDE 02                              11 ; BIT 1 = 1 : Baudrateeinst. moegl. 

+                                        ; BIT 0 = 1 : RTS/CTS 

+0CDF 04                              12 ; AND-Maske Test Statusport (TxDfull)

+0CE0 04                              13 ; XOR-Maske f. TxDfull (ggf invert.)

+0CE1 00                              14 ; DTR/RTS - Bits im Register 5 (82H)

+0CE2 00                              15 ; OR-Register fuer V24-Errors

+0CE3 00                              16 ; AND-Maske fuer zulaessige Fehler

+0CE4 C1                              17 ; Register 3 (Rxbits, Autoenables) 

+0CE5 44                              18 ; Register 4 (Stopb., Clock, parity) 

+0CE6 EA                              19 ; Register 5 (Txbits, RTS, DTR)

+0CE7 1D                              1A ; Port Kanal 1 Status/Command

+0CE8 1C                              1B ; Datenport Kanal 1 : DART Channel A

+0CE9 0C                              1C ; BR-Generatorport: CTC1 - Kanal 0

+0CEA 88                              1D ; Interruptvektor Kanal 1 

+0CEB CD 56 04          CALL  0456       ; Transmitbuffer empty IRQ 

+0CEE CD 6B 04          CALL  046B       ; External/Status Change IRQ 

+0CF1 CD BA 04          CALL  04BA       ; Receive Character available IRQ 

+0CF4 CD 85 04          CALL  0485       ; Special Receive condition IRQ

+ 

+;----------------------------- Serieller Kanal 2 -------------------------- 

+0CF7 FF                                 ; 100 Bytes Puffer Kanal 2 

+     ...

+0D5A FF 

+0D5B 02                                 ; Kanal 2 

+0D5C 03                                 ; Flusskontrollenbits

+0D5D 64                                 ; 100 = Puffergroesse

+0D5E 00 00 00                           ; Pufferzeiger

+0D61 F7 0C                              ; 0CF7 = Pufferanfang Kanal 2

+0D63 7F 00                              ; Masken fuer fehlerfreiene Receive

+0D65 7F 00                              ;          "  fehlerhaften Receive 

+0D67 7F 00                              ; Masken fuer read aus Puffer 

+0D69 3F          ?                      ; Zeichen fuer fehlerhaften receive 

+0D6A 13 11                              ; XOFF/XON Zeichen 

+0D6C 02                                 ; Baudrateeinstellung moeglich 

+0D6D 04 04                              ; Masken fuer Test Statusport:TxDfull

+0D6F 00                                 ; DTR/RTS Bits in Register 5

+0D70 00 00                              ; Masken fuer zulaessige Fehler 

+0D72 C1 44 EA                           ; Register 3, 4, 5 Werte

+0D75 1F                                 ; Port Kanal 2 Status / Command 

+0D76 1E                                 ; Datenport Kanal 2 : DART Channel B 

+0D77 0E                                 ; BR-Generatorport: CTC1 - Kanal 1

+0D78 80                                 ; Interruptvektor Kanal 2

+0D79 CD 56 04          CALL  0456       ; Interruptroutinen

+0D7C CD 6B 04          CALL  046B 

+0D7F CD BA 04          CALL  04BA 

+0D82 CD 85 04          CALL  0485 

+ 

+;------------------------------ Serieller kanal 3 -------------------------

+0D85 FF                                 ; 100 Byte Datenpuffer (Senden)

+     ... 

+0DE8 FF 

+0DE9 03                                 ; Kanal 3 

+0DEA 03                                 ; Flusskontrollenbits 

+0DEB 64                                 ; Puffergroesse 

+0DEC 00 00 00                           ; Pufferzeiger

+0DEF 85 0D                              ; Pufferanfang Kanal 3 : 0D85 

+0DF1 7F 00                              ; Datenbitsmasken s.o

+0DF3 7F 00                              ;   "

+0DF5 7F 00                              ;   "

+0DF7 3F        ?                        ; Zeichen bei fehlerhaftem Receive

+0DF8 13 11                              ; XOFF/XON Zeichen 

+0DFA 02                                 ; Baudrateeinstellung moeglich 

+0DFB 04 04                              ; Masken fuer Test Statusport:TxDfull 

+0DFD 00                                 ; DTR/RTS Bits in register 5 (82H) 

+0DFE 00 00                              ; Masken fuer zulaessige Fehler 

+0E00 C1 44 EA                           ; Register 3, 4, 5 Werte 

+0E03 29                                 ; Port Kanal 3 Status / Command 

+0E04 28                                 ; Datenport Kanal 3 : SIO 1 Channel A

+0E05 32                                 ; BR-generatorport: CTC2 - Kanal 2 

+0E06 98                                 ; Interruptvektor Kanal 3

+0E07 CD 56 04          CALL  0456       ; Interruptroutinen

+0E0A CD 6B 04          CALL  046B 

+0E0D CD BA 04          CALL  04BA 

+0E10 CD 85 04          CALL  0485 

+ 

+;--------------------------------- Serieller Kanal 4 ----------------------- 

+0E13 FF                                 ; 100 Bytes Kanalpuffer 

+     ... 

+0E76 FF 

+0E77 04                                 ; Kanal 4 

+0E78 03                                 ; Flusskontrollenbits 

+0E79 64                                 ; Puffergroesse 

+0E7A 00 00 00                           ; Pufferzeiger 

+0E7D 13 0E                              ; Pufferanfang Kanal 4 : 0E13

+0E7F 7F 00                              ; Datenbitmasken s.o. 

+0E81 7F 00 

+0E83 7F 00 

+0E85 3F          ?                      ; Zeichen bei fehlerhaften Receive 

+0E86 13 11                              ; XOFF/XON Zeichen 

+0E88 02                                 ; Baudrateeinstellung moeglich 

+0E89 04 04                              ; Masken fuer TxDfull Status 

+0E8B 00                                 ; RTS/DTR Bits (82H) 

+0E8C 00 00                              ; Masken fuer zulaessige Fehler 

+0E8E C1 44 EA                           ; Register 3, 4, 5 Werter 

+0E91 2B                                 ; Port Kanal 4 Status/Command 

+0E92 2A                                 ; Datenport kanal 4 : SIO 1 Channel B

+0E93 31                                 ; BR-Generatorport: CTC2 - Kanal 1

+0E94 90                                 ; Interruptvektor Kanal 4

+0E95 CD 56 04          CALL  0456       ; Interruptroutinen 

+0E98 CD 6B 04          CALL  046B 

+0E9B CD BA 04          CALL  04BA 

+0E9E CD 85 04          CALL  0485 

+ 

+;-------------------------------- Serieller Kanal 5 -----------------------

+0EA1 FF                                 ; 100 Bytes Ausgabepuffer

+     ... 

+0F04 FF 

+0F05 05                                 ; Kanal 5 

+0F06 03                                 ; Flusskontrollenbits 

+0F07 64                                 ; Puffergroesse 

+0F08 00 00 00                           ; Pufferzeiger 

+0F0B A1 0E                              ; Pufferanfang : 0EA1 

+0F0D 7F 00                              ; Datenbitmasken s.o. 

+0F0F 7F 00                              ;   "

+0F11 7F 00                              ;   " 

+0F13 3F          ?                      ; Zeichen fuer fehlerhaften Receive

+0F14 13 11                              ; XOFF/XON Zeichen 

+0F16 02                                 ; Baudrateeinstellung moeglich 

+0F17 04 04                              ; Maskenbits fuer Status TxDfull

+0F19 00                                 ; RTS/DTR Bits (82H) 

+0F1A 00 00                              ; Masken fuer zulaessige fehler 

+0F1C C1 44 EA                           ; Register 3, 4, 5 Werte 

+0F1F 2D                                 ; Port Kanal 5 Status / Command 

+0F20 2C                                 ; Datenport kanal 5 : SIO 2 Channel A

+0F21 30                                 ; BR-Generatorport: CTC2 - Kanal 0

+0F22 A8                                 ; Interruptvektor Kanal 5 

+0F23 CD 56 04          CALL  0456       ; Interruptroutinen

+0F26 CD 6B 04          CALL  046B 

+0F29 CD BA 04          CALL  04BA 

+0F2C CD 85 04          CALL  0485 

+ 

+;--------------------------- Serieller kanal 6 ---------------------------- 

+0F2F FF                                 ; 100 Bytes ausgabepuffer 

+     ... 

+0F92 FF 

+0F93 06                                 ; Kanal 6 

+0F94 03                                 ; Flusskontrollenbits

+0F95 64                                 ; Puffergroesse

+0F96 00 00 00                           ; Pufferzeiger 

+0F99 2F 0F                              ; Pufferanfang Kanal 6 : 0F2F 

+0F9B 7F 00                              ; Datenbitmasken s.o. 

+0F9D 7F 00                              ;      " 

+0F9F 7F 00                              ;      " 

+0FA1 3F          ?                      ; Zeichen fuer fehlerhaften Receive

+0FA2 13 11                              ; XOFF/XON Zeichen 

+0FA4 02                                 ; Baudrateeinstellung moeglich 

+0FA5 04 04                              ; Maskenbits Status TxDfull 

+0FA7 00                                 ; RTS/DTR Bits in Register 5 

+0FA8 00 00                              ; Masken fuer zulaessige Fehler 

+0FAA C1 44 EA                           ; Register 3, 4, 5 Werte 

+0FAD 2F                                 ; Port Kanal 6 : Status / Command 

+0FAE 2E                                 ; Datenport kanal 6 : SIO 2 Channel B

+0FAF 31                                 ; BR-Generatorport : CTC2 - Kanal 1 

+0FB0 A0                                 ; Interruptvektor kanal 6 

+0FB1 CD 56 04          CALL  0456       ; Interruptroutinen

+0FB4 CD 6B 04          CALL  046B 

+0FB7 CD BA 04          CALL  04BA 

+0FBA CD 85 04          CALL  0485 

+ 

+;------------------------------- Parallelkanal 7 --------------------------

+0FBD 07                                 ; Kanal 7 

+0FBE 20                                 ; AND-Maske fuer Printerbusy

+0FBF 00                                 ; XOR-Maske f. Printer 0 busy

+0FC0 FE                                 ; AND-Maske fuer Printerstrobe

+0FC1 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FC2 01                                 ; XOR-Maske2 fuer Printerstrobe aus

+ 

+;------------------------------- Parallel Kanal 8 ------------------------- 

+0FC3 08                                 ; Kanal 8 

+0FC4 40                                 ; AND-Maske fuer Printerbusy

+0FC5 00                                 ; XOR-Maske fuer Printer 1 busy

+0FC6 FD                                 ; AND-Maske fuer Printerstrobe

+0FC7 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FC8 02                                 ; XOR-Maske2 fuer Printerstrobe aus

+ 

+;------------------------------ Parallel kanal 9 -------------------------- 

+0FC9 09                                 ; Kanal 9 

+0FCA 80                                 ; AND-Maske f. Printerbusy

+0FCB 00                                 ; XOR-Maske f. Printer 2 busy

+0FCC FB                                 ; AND-Maske fuer Printerstrobe

+0FCD 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FCE 04                                 ; XOR-maske2 fuer Printerstrobe aus

+ 

+;----------------------------- Floppy Kanal 31 ---------------------------- 

+0FCF 1F                                 ; Kanal 31 

+0FD0 00                                 ; IY+00

+0FD1 00                                 ; IY+01 FDC-AND-Maske Status-ready

+0FD2 00                                 ; 02 FDC-Kommando Read/Write

+0FD3 00                                 ; 03

+0FD4 00                                 ; 04 

+0FD5 00                                 ; 05 : Returncode aus Floppy-IRQ

+0FD6 00                                 ; 06 : Alter Sektor 

+0FD7 00                                 ; 07

+0FD8 04                                 ; 08

+0FD9 FF                                 ; 09 Floppydrive (f. Headselect)

+0FDA 00                                 ; 0A  - 46H = "F"

+;============================== SHARD ENDE ================================= 

diff --git a/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT
new file mode 100644
index 0000000..a698b27
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT
@@ -0,0 +1,584 @@
+#type ("12")##limit (16.0)##block##pageblock# 

+#head# 

+#center#Dokumentation zum EUMEL-SHard 

+ 

+ 

+#end# 

+#bottom# 

+ 

+ 

+#center#- % - 

+#end# 

+************************************************************************ 

+*                                                                      * 

+*             D o k u m e n t a t i o n    z u m   S H a r d  (8)      * 

+*                                                                      * 

+*             Stand der Dokumentation:  26.06.87                       * 

+*             Stand der Implementation: 26.06.87, Version 1.5          * 

+*                                                                      * 

+*                                                  Michael Staubermann * 

+*                                                  Moränenstraße 29    * 

+*                                                  44 Münster-Hiltrup  * 

+************************************************************************ 

+ 

+ 

+ 

+1.   Allgemeines 

+1.1    Neuheiten 

+1.2    Logische und physische Kanäle 

+ 

+2.   Block I/O 

+2.1    Harddisk (Kanal 0) 

+2.2    SCSI-Floppy (Kanal 31) 

+2.3    Harddisk-Volume (Kanal 28) 

+2.4    160k/640k-Floppys (Kanal 29, 30) 

+2.5    Graphikmemory (Kanal 1) 

+ 

+3.   Stream I/O 

+3.1    Konsole (Kanal 1) 

+3.2    6551-Seriell (Kanal 5) 

+3.3    SCCs (Kanal 2, 3) 

+3.4    CIO-Drucker (Kanal 4) 

+3.5    Motherboard-Drucker (Kanal 6) 

+ 

+4.   Graphik 

+4.1    CTRL 

+4.2    MOVE 

+4.3    DRAW 

+4.4    TEST 

+4.5    CLR 

+4.6    FILL 

+4.7    TRANS 

+ 

+5.   Hardware 

+5.1    Zugriff auf die Hardware-Uhr 

+5.2    Zugriff auf die Analog-Ports 

+5.3    Zugriff auf die I/O-Ports 

+5.4    ID-Felder 

+ 

+6.   Installation 

+6.1    Vortest/Speichertest 

+6.2    Konsole 

+6.3    SCSI-Floppy 

+6.4    Harddisk Volume 

+6.5    Logische Kanäle zuordnen 

+6.6    Installation auf Harddisk 

+6.7    Installation auf Floppy 

+ 

+#page# 

+#ub#1  Allgemeines#ue# 

+ 

+#ub#1.1  Neuheiten#ue# 

+ 

+Neu in Version 1.2: 40% höherer CPU-Durchsatz. 

+ 

+Neu in Version 1.4: Texthardcopy mit SHIFT CTRL F12. 

+ 

+Neu in Version 1.5: Beide Printer-Spooler löschbar mit control (-10,...). 

+Korrektur in   1.5: Kanal 4 - Printer darf auch während des Betriebs aus-

+                    und eingeschaltet werden (läuft automatisch wieder an). 

+ 

+ 

+#ub#1.2  Logische und physische Kanäle#ue# 

+ 

+Die Unterscheidung zwischen logischen und physischen Kanälen bringt Vortei-

+le: 

+ 

+- Der Systemstart muß nicht mehr an der Konsole erfolgen (jetzt z.B. an

+  einem externen Terminal). 

+- Systemfehler/Hardwarefehler und Info werden damit auch an einem anderen

+  physischen Kanal ausgegeben. 

+- Das Hintergrundmedium muß nicht mehr unbedingt die Harddisk sein. Eine

+  SCSI-Floppy (720k) wäre denkbar, oder ein anderes Harddisk-Volume. 

+- Das Archivmedium muß nicht mehr unbedingt die SCSI-Floppy sein. Ein Hard-

+  diskvolume oder eine 640k-Floppy wären denkbar. 

+- Für einen anderen SHard geschriebene Software (z.B. alter Druckertrei-

+  ber/Graphiktreiber) muß nicht geändert werden. 

+ 

+#page#

+#ub#2.  Block I/O#ue# 

+ 

+#ub#2.1  Harddisk (Kanal 0)#ue# 

+ 

+Keine Recalibrates (wg. Timeout/DMA-Fehler) mehr! 

+Das beste Sektor-Interleave ist 5. 

+ 

+ 

+#ub#2.2  SCSI-Floppy (Kanal 31)#ue# 

+ 

+- Falls keine Floppy im Schacht liegt, werden keine Retries mehr gemacht.

+  Bei Write-Protect auch nicht. 

+- Harddisk und Floppy arbeiten jetzt auch bei intensiver Benutzung gut

+  nebeneinander. 

+- Mit 'size (schluessel)' kann vom EUMEL aus das Format eingestellt werden.

+  Interpretiert wird 0 und 2 als 720k-Format und 1 als 360k-Format, sowie

+  der analytische Schlüssel (lt. Portierungshandbuch). 

+- 'format (schluessel)' formatiert eine Floppy im 720k-Format. Der Control-

+  ler wird allerdings wie bei 'size (schluessel)' vorher initialisiert, da

+  EUMEL das nicht macht. 

+- Falls gewünscht kann auch SCSI-Floppy #1 über Kanal 31 angesprochen wer-

+  den. Die entsprechende Frage wird im Installationsprogramm gestellt. 

+ 

+ 

+#ub#2.3  Harddisk-Volume (Kanal 28)#ue# 

+ 

+Mit diesem Kanal ist es möglich, ein anderes Harddisk-Volume, dessen Anfang

+und Größe auf der Platte mit dem Installationsprogramm ausgewählt wurde,

+anzusprechen. Ein CP/M-Volume kann z.B. auch durch EUMEL genutzt werden

+oder das Harddisk-Volume wird als Archiv-Kanal genutzt. 

+ 

+ 

+#ub#2.4  160k/640k Floppys (Kanal 29, 30)#ue# 

+ 

+- Kanal 29 spricht Disk #1 in Slot 6 an, 

+- Kanal 30 spricht Disk #0 in Slot 6 an. 

+- Da sich beide Disks einen Controller und Datenbereich (4k-Cache) teilen,

+  kann Block I/O nicht auf beiden Kanen parallel ablaufen. Blockweise Ab-

+  wechslung ist allerdings möglich (Wird durch Semaphor geregelt). 

+- Formatieren ist auf diesen Kanälen nicht möglich. 

+- Das Format (160k/640k) wird mit 'size (schluessel)' im EUMEL eingestellt.

+  Außer dem analytischen Schlüssel wird noch 0 und 2 für 2 * 80 Tracks

+  (640k) und 1 für 1 * 40 Tracks (160k) interpretiert. 

+- Ein (CP/M-) Interleave von 3 Sektoren ist eingestellt. 

+- Daten werden jeweils Trackweise in einen Puffer gelesen und in 512-Byte

+  Blöcken an EUMEL übergeben. Bei 'blockout' wird der Block (512-Bytes)

+  sofort auf die Floppy geschrieben. 

+- Writeprotection wird erkannt. 

+- Media-Mangel wird nicht erkannt, sondern als Lesefehler interpretiert bei

+  dem Retries versucht werden. (SHard führt von sich aus 1 Recalibrate aus,

+  den Rest muß EUMEL machen). 

+ 

+ 

+#ub#2.5  Graphikmemory (Kanal 1)#ue# 

+ 

+- Dieser flüchtige Speicher hat eine Größe von 32KB (64 Blöcke) 

+- 4 Graphikseiten zu jeweils 8KB sind linear angeordnet. 

+- Seiten 0 und 1 können als Grahikbitmap angezeigt werden 

+- Seiten 2 und 3 können dienen als Hilfsspeicherseiten 

+ 

+#page#

+#ub#3. Stream I/O#ue# 

+ 

+#ub#3.1  Konsole (Kanal 1)#ue# 

+ 

+- Die Blinkfrequenz des Cursors kann nicht mehr mit 'control' eingestellt

+  werden, sondern vor dem Systemstart mit dem Installationsprogramm. 

+- Zusätzlich kann die Tonhöhe des Steuercodes ""7"" bestimmt werden (Im

+  Installationsprogramm). 

+- Der Zeichensatz wird nicht mehr mit 'control' eingestellt. Da jetzt Steu-

+  ercodes benutzt werden, kann der Zeichensatz in der Typtabelle festgelegt

+  werden. 

+- Zeichencodes 128..255 werden ohne Umsetzung auf den Bildschirm geschrie-

+  ben. 

+- Folgenden Steuercodes sind definiert: 

+   0 - Keine Aktion 

+   1 - Cursor Home 

+   2 - Cursor right 

+   3 - Cursor up 

+   4 - Clear to end of Page 

+   5 - Clear to end of Line 

+   6 - Cursor Positionierung (Row, Column) (ohne Offset!) 

+   7 - Bell 

+   8 - Cursor left 

+   9 - Clear Screen 

+  10 - Cursor down 

+  11 - Insert Line 

+  12 - Delete Line 

+  13 - Carriage Return 

+  14 - End Mark 

+  15 - Begin Mark 

+  16 - Deutscher Zeichensatz (German ASCII) 

+  17 - ASCII Zeichensatz 

+  18 - APL Zeichensatz 

+  19 - Universal Zeichensatz (German ASCII + APL) 

+  20 - Mode einschalten: Inverse Zeichen blinken nicht 

+  21 - Mode einschalten: Inverse Zeichen blinken 

+ 

+- Es werden keine Eingabeumcodierungen gemacht, dies soll in der Typtabelle

+  geschehen. 

+- Falls EUMEL keine Eingabezeichen mehr puffern kann, werden diese im Ta-

+  staturpuffer gespeichert. Damit ist es möglich bis zu 270 Tastendrücke im

+  voraus zu tippen. Werden noch mehr Tasten gedrückt, ertönt ein Signal, da

+  weitere Tastendrücke verlorengehen. EUMEL wird beim nächsten Inputinter-

+  rupt ein Overrun-Error gemeldet. 

+ 

+- Einige Funktionstasten haben eine besondere Bedeutung: 

+  F2 = SV-Call: Diese Taste wird auch dann weitergeleitet, wenn EUMEL keine

+                weiteren Zeichen puffern kann, damit Tasks, die nicht auf

+                Eingabe warten, abgebrochen werden können. 

+  SHIFT CTRL F12 = Texthardcopy: Durch Drücken dieser Tasten wird der In-

+                halt des Textbildschirms auf einem Drucker an der paralle-

+                len Basisschnittstelle ausgedruckt. Achtung: Dies funktio-

+                niert nur, wenn der Spooler leer ist. Falls ein Druckauf-

+                trag läuft, sollte keine Hardcopy gemacht werden (Falls der

+                Spooler nämlich kurzfristig leer ist, wird die Hardcopy

+                gedruckt den Druckauftrag ruinieren.) 

+  SHIFT CTRL F13 = Weiter: Durch Drücken dieser Tasten wird der Tastatur-

+                puffer ohne Rücksicht darauf, ob EUMEL noch Zeichen puffern

+                kann, zeichenweise entleert. (Wird wohl kaum benutzt werden

+                müßen). 

+  SHIFT CTRL F14 = Shutup: Durch Drücken dieser Tasten wird das System

+                kontrolliert heruntergefahren. 

+  SHIFT CTRL F15 = Reset:  Falls verdrahtet löst die Software einen Hard-

+                warereset aus. 

+ 

+ 

+#ub#3.2  6551-Seriell (Kanal 5)#ue# 

+ 

+Dieser Kanal wurde erweitert: 

+- Außer Baudrate können jetzt auch Stopbits, Datenbits, Parity und Fluß-

+  kontrolle eingestellt werden (CTS, DSR/DTR, XON/XOFF). 

+- Ein Empfangspuffer von 2300 Zeichen wurde eingebaut und der Ausgabepuffer

+  auf 1k erweitert. 

+- Ein- und Ausgabe läuft jetzt Interruptgetrieben, kann also auch während

+  einer Floppyoperation stattfinden. 

+- Übertragungsfehler (Parity, Framing, Overrun) werden beim Inputinterrupt

+  an EUMEL gemeldet. Die Fehler werden in dem Moment, in dem sie bemerkt

+  werden gemeldet, d.h. i.d.R. nicht passend zum gleichzeitig übermittelten

+  Zeichen. 

+- Ein Break-Kommando wird interpretiert und ggf. an EUMEL gemeldet. Folgt

+  auf das Break-Kommando ('00' + Framing Error) ein 'Kommandozeichen', dann

+  wird dieses Remote-Kommando ausgeführt, anderenfalls wird das auf 'Break'

+  folgende Zeichen in den Empfangspuffer geschrieben und 'Break' an EUMEL

+  gemeldet. 

+- Folgende Break-Komandos werden interpretiert: 

+  <BREAK> <CTRL B> : SV-Call ohne Rücksicht auf Verluste an EUMEL leiten. 

+  <BREAK> W        : Wie SHIFT CTRL F13 bei Keyboard. 

+  <BREAK> S        : Shutup, System kontrolliert herunterfahren. 

+  <BREAK> R        : Software löst, falls verdrahtet, einen Hardarereset

+                     aus. 

+ 

+ 

+#ub#3.3  SCCs (Kanal 2, 3)#ue# 

+ 

+- Außer der Baudrate kann man jetzt auch Stopbits, Datenbits, Parity und

+  Flußkontrolle (RTS+DTR /CTS) einstellen. XON/XOFF wird nicht empfohlen. 

+- Übertragungsfehler (Overrun, Parity und Break) werden EUMEL gemeldet. 

+- Beide Kanäle besitzen einen Ausgabepuffer von jeweils 2KB. 

+ 

+ 

+#ub#3.4  CIO-Drucker (Kanal 4)#ue# 

+ 

+- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloßen. 

+- Dieser Kanal besitzt einen Ausgabepuffer von 4KB (Interruptgetrieben). 

+- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 4 gelöscht

+  werden. 

+ 

+ 

+#ub#3.5  Motherboard-Drucker (Kanal 6)#ue# 

+ 

+- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloßen. 

+- Dieser Kanal besitzt einen 4KB Ausgabepuffer (Polling). 

+- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 6 gelöscht

+  werden. 

+ 

+#page#

+#ub#4.  Graphik#ue# 

+ 

+#ub#4.1  CTRL#ue# 

+ 

+control (-8, flags, linienmuster, r) 

+Setzt verschiedene Graphikmodi. 

+ 

+Die Bits im Parameter 'flags' sind folgendermaßen zugeordnet: 

+ 

+Bit 0 : 

+     0 = Textmodus einschalten, Graphikmodus ausschalten 

+     1 = Graphikmodus einschalten, Textmodus ausschalten 

+ 

+Bit 1 : 

+     0 = Seite 0 als sichtbare Seite wählen 

+     1 = Seite 1 als sichtbare Seite wählen 

+ 

+Bit 2 : 

+     0 = Seite 0 als bearbeitete Seite wählen 

+     1 = Seite 1 als bearbeitete Seite wählen 

+ 

+Bit 3, 4 : Verknüpfung Patternbit: 0           1 

+    0           OR              setzen     unverändert 

+    1         NAND             löschen     unverändert 

+    2          XOR         invertieren     unverändert 

+    3         COPY             löschen     setzen 

+ 

+Bit 5 : 

+     0 = Der gesamte Bildschirm zeigt die Graphikseite ('full screen') 

+     1 = In den letzten 32 Graphikzeilen erscheint die Textseite ('mixed') 

+ 

+Bit 6 : 

+     0 = Das im zweiten Parameter übergebene Wort wird als 16-Bit 

+         Linienmuster eingestellt. Modus siehe Bit 3/4. 

+     1 = Das alte (bzw. voreingestellte) Linienmuster wird benutzt 

+ 

+Bit 7 : 

+     0 = Als Punkthelligkeit wird 'dunkel' (bzw. Violett) eingestellt 

+     1 = Als Punkthelligkeit word 'hell' (bzw. Gelb) eingestellt 

+ 

+Bit 8..11 : 

+     0 = Default-Strichdicke (1) 

+     1..15 = Strichdicke (Es werden 2*s-1 Linien parallel gezeichnet.) 

+ 

+Der zweite Parameter enthält das 16-Bit Linienmuster. Dieses wird beim

+Zeichnen einer Linie zyklisch Bitweise abgetastet. Je nach Status des Bits

+im Linienmuster wird eine Punktaktion ausgeführt, deren Wirkung in 'flags'

+mit den Bits 3 und 4 spezifiziert wird. 

+ 

+ 

+#ub#4.2  MOVE#ue# 

+ 

+control (-5, x pos, y pos, r) 

+Setzt den (unsichtbaren) Graphikcursor auf xpos/ypos. 

+ 

+Der nächste 'draw' zeichnet eine Linie beginnend bei xpos/ypos. 

+ 

+ 

+#ub#4.3  DRAW#ue# 

+ 

+control (-6, x pos, y pos, r) 

+Zeichnet eine Linie zur angegebenen Position xpos/ypos. 

+ 

+Die eingestellten Parameter Helligkeit, Linientyp, Bitverknüpfung und Dicke

+werden beachtet. Der nächste 'draw' zeichnet eine Linie beginnend bei

+xpos/ypos. 

+ 

+ 

+#ub#4.4  TEST#ue# 

+ 

+control (-7, x pos, y pos, result) 

+Testet den Status eines bestimmten Pixels. 

+ 

+Die Pixelposition wird mit xpos/ypos beschrieben. 

+Als 'result' wird zurückgeliefert: 

+    255, falls xpos/ypos außerhalb des sichtbaren Fensters liegt. 

+    Bit 0 = 1: Pixel sichtbar 

+    Bit 0 = 0: Pixel unsichtbar 

+    Bit 7 = 1: Pixelfarbe ist hell (gelb) 

+    Bit 7 = 0: Pixelfarbe ist dunkel (violett) 

+ 

+ 

+#ub#4.5  CLR#ue# 

+ 

+control (-3, seite, muster, r) 

+Füllt die angegebene Seite mit dem angegebenen Muster. 

+ 

+Bit 7 des Musters bestimmt die Farbe (0 = dunkel, 1 = hell). Das Muster

+wird zyklisch Spalten- und Zeilenweise wiederholt. muster=128 löscht z.B.

+die Graphikseite. 

+ 

+ 

+#ub#4.6  FILL#ue# 

+ 

+control (-4, muster nummer, 0, return) 

+Füllt eine beliebig durchgehend begrenzte Fläche mit dem angegebenen Mu-

+ster. 

+ 

+Das Muster ist eine 8 x 8 Matrix, die sich auf allen (pos MOD 8)-Pixel-

+adressen wiederholt. Im NAND-Modus wird mit dem inversen Muster gefüllt.

+Die Fläche muß dann aber mit unsichtbaren Pixeln begrenzt werden. 

+ 

+Folgende Muster sind möglich: 

+    0 = 'solid' (alles gefüllt) 

+    1 = 'lrs2'  (jeder zweite Punkt, Zeilenweise versetzt) 

+    2 = 'row4'  (jede 4. Zeile wird gefüllt) 

+    3 = 'row2'  (jede 2. Zeile wird gefüllt) 

+    4 = 'col4'  (jede 4. Spalte wird gefüllt) 

+    5 = 'col2'  (jede 2. Spalte wird gefüllt) 

+    6 = 'grid4' (jede 4. Spalte/Zeile wird gefüllt) 

+    7 = 'grid2' (jede 2. Spalte/Zeile wird gefüllt) 

+    8 = 'ls4'   (Schraffur links unten --> rechts oben, jede 4.) 

+    9 = 'rs4'   (Schraffur rechts unten --> links oben, jede 4.) 

+   10 = 'lrs4'  (Schräges Gitter wie 8 und 9 zusammen) 

+   11 = 'point2'(In jeder 2. Zeile jeder 2. Punkt) 

+   12 = 'wall4' (Mauer, ein Ziegelstein 4 Pixel hoch) 

+   13 = 'basket'(Korb/Netz) 

+   14 = 'wave4' (Wellenlinie 4 Pixel hoch) 

+   15 = 'wave8' (Wellenlinie 8 Pixel hoch) 

+ 

+Falls die zu füllende Fläche zu komplex wird, kann es vorkommen, daß der

+interne Stack überläuft. In diesem Fall wird nicht die gesamte Fläche ge-

+füllt. 

+ 

+ 

+#ub#4.7  TRANS#ue# 

+ 

+control (-9, from page, to page, r) 

+Kopiert den Inhalt der Graphikseite 'from page' in die Seite 'to page'. 

+ 

+Folgende Seitennummern sind möglich: 

+    0 : Seite 0 kann mit 'visible page (0)' angezeigt werden 

+    1 : Seite 1 kann mit 'visible page (1)' angezeigt werden 

+    2 : Seite 2 kann nicht sichtbar werden (Hilfsspeicher-Seite) 

+    3 : Ähnlich Seite 2, wird aber bei 'FILL' noch als Arbeitsseite benutzt

+    (wird dann überschrieben!) 

+ 

+#page#

+#ub#5.  Hardware#ue# 

+ 

+#ub#5.1  Zugriff auf die Hardware-Uhr#ue# 

+ 

+Mit 'TEXT PROC calendar (INT CONST feld)' kann in Söhnen von SYSUR die

+Hardware-Uhr gelesen werden. Für 'feld' sind folgende Werte zugeordnet: 

+ 

+ 0  Sekunden (0..59) 

+ 1  Minuten (0..59) 

+ 2  Stunden (0..23) 

+ 3  Tag des Monats (1..31) 

+ 4  Monat (1..12) 

+ 5  Jahr (87..99) 

+ 

+Ist die Uhr richtig gestellt (das ist aus CP/M mit 'date set' möglich),

+liefert jeder Aufruf von 'calendar' eine Zahl, anderenfalls wird immer

+'niltext' geliefert und EUMEL fragt nach dem Systemstart nach dem Datum.

+Dabei wird die Hardware-Uhr jedoch #ub#nicht#ue# gestellt. 

+In diesem Fall ist der Akku wahrscheinlich entladen (Abhilfe: Rechner eini-

+ge Stunden laufen lassen) oder die Uhr ist noch nicht gestellt worden (Ab-

+hilfe: 'date set' im CP/M). 

+ 

+In Tasks, die keine Söhne von SYSUR sind, kann die Hardware-Uhr mit 

+ 

+ TEXT PROC calendar (INT CONST feld) : 

+  INT VAR r ; 

+  control (10, feld, 0, r) ; 

+  text (r DIV 256 * 10 + (r AND 15)) 

+ ENDPROC calendar ; 

+ 

+abgefragt werden. 

+ 

+ 

+#ub#5.2  Zugriff auf die Analog-Ports#ue# 

+ 

+Die 4 Analog-Ports auf dem Motherboard können mit 

+ 

+  control (-2, port, 0, r) 

+ 

+abgefragt werden. 'port' kann 1..4 sein, in 'r' werden Werte von 1..255

+zurückgemeldet. Dieser Wert ist proportional dem Widerstandswert zwischen

++5V und Analogeingang. 

+ 

+Für Hardwarefreaks : 

+ 

+    Port  Connectorpin 

+    ------------------ 

+      1         6 

+      2        10 

+      3         7 

+      4        11 

+     +5V        1 

+ 

+Da der Meßwertaufnehmer ein 'LS123 mit C#d#t#e#=68nF, R#d#t#e#=0.27+R#d#x#e# kOhm ist, gilt:

+t#d#w#e#=0.45 * R#d#t#e# * C#d#t#e# = (30.6 * R#d#x#e# + 8.262) [us]. t#d#w#e# wird gemessen. (t#d#w#e# = 11

+Zyklen * r + 5 Zyklen bei 1.023 MHz) 

+ ==> 30.6 * R#d#x#e# + 8.262 = (11 * r + 5) / 1.023 [us] 

+<==> R#d#x#e# = ((11 * r - 5) / 1.023 -8.262) / 30.6 [kOhm] 

+(Damit ist auch klar, warum der Wert 0 nicht geliefert wird.) 

+ 

+R#d#x#e# [kOhm] = 0.351 * r + 0.43 

+r = 2.846 * R#d#x#e# + 1.221 

+ 

+ 

+#ub#5.3  Zugriff auf die I/O-Ports#ue# 

+ 

+Das Schreiben #ub#und#ue# Lesen der I/O-Ports der CPU ist jetzt nur an privilegier-

+ten Kanälen (25..32) möglich. 

+ 

+  control (-1, port, -1, r) 

+ 

+kann der angegebene Port 'port' (0..255) gelesen werden. Das Resultat (By-

+te) steht dann in 'r'. Falls der aufrufende Kanal ungültig war, wird -1

+geliefert. Mit 

+ 

+  control (-1, port, wert, r) 

+ 

+kann der angegebene Port 'port' (0..255) beschrieben werden. Der Bytewert

+steht in 'wert', die Erfolgsmeldung in 'r' (0 = ok). 

+ 

+ 

+#ub#5.4  ID-Felder#ue# 

+ 

+Mit 'INT PROC id (INT CONST feld nr)' können Systemkonstanten abgefragt

+werden. Für 'feld nr' sind folgende Werte zugeordnet: 

+ 

+0  Minimale Hintergrundversion (175) 

+1  Urladertyp (1 = Z80) 

+2  Urladerversion (101 = Version 1.1) 

+3  Reserviert 

+4  Lizenznummer des SHards 

+5  Installationsnummer 

+6  Reserviert 

+7  Versionsnummer des SHards: 1000 * Interfaceversion + SHard Version (ent-

+   hält z.Zt. 8105, d.h. Interface 8, Version 1.5) 

+ 

+#page#

+#ub#6.  Installation#ue# 

+ 

+#ub#6.1  Vortest/Speichertest#ue# 

+ 

+Vortest und Speichertest sollten normalerweise durchgeführt werden. (Beide

+Fragen mit 'j' beantworten). Wird kein Vortest gewünscht, wird automatisch

+auch kein Speichertest durchgeführt und es besteht keine Möglichkeit, das

+Hardwaretest-Menue aufzurufen. 

+ 

+ 

+#ub#6.2  Konsole#ue# 

+ 

+Die Blinkperiode des Cursor und die Tonhöhe des Steuercodes ""7"" kann

+verändert werden (Sekunden bzw. Hertz). Defaults sind 0.8s und 500Hz. 

+ 

+ 

+#ub#6.3  SCSI-Floppy#ue# 

+ 

+Falls nicht SCSI-Floppy #0 sondern, falls vorhanden, SCSI-Floppy #1 als

+Kanal 31 angesprochen werden soll, wird diese Frage mit 'n' beantwortet. 

+ 

+ 

+#ub#6.4  Harddisk Volume#ue# 

+ 

+Als Kanal 28 kann ein Harddisk-Volume angesprochen werden. Alle verfügbaren

+Volumes werden angeboten und ein ausgewähltes wird im SHard als Kanal 28

+installiert. Achtung: Sollte dieses Volume gelöscht, vergrößert oder ver-

+schoben werden (durch CP/M) dann weiß SHard noch nichts davon. Deshalb

+sollte der SHard nach einer solchen Aktion noch einmal installiert werden. 

+Aus Sicherheitsgründen wird empfohlen, ein spezielles Volume einzurichten,

+über das dann der Datenaustauch CP/M <--> EUMEL läuft. 

+ 

+ 

+#ub#6.5  Logische Kanäle zuordnen#ue# 

+ 

+Als logische Kanäle stehen Kanal 0..31 zur Verfügung, als physiche Kanäle

+0..6 und 28..31. Den logischen Kanälen können fast beliebig physische Kanä-

+le zugeordnet werden. 

+Ausnahmen: 

+- Der log. Kanal 0 (Hintergrund) muß als Blockkanal definiert werden (d.h.

+  die physischen Kanäle 0, 28, 29, 30, 31 können zugeordnet werden.) 

+- Der log. Kanal 1 (Systemkanal) muß als Stream-I/O-Kanal definiert werden

+  (d.h. die physischen Kanäle 1, 2, 3, 5 können zugeordnet werden.) 

+- Der log. Kanal 31 (Archiv) sollte definiert werden, dann aber als Block-

+  kanal (d.h. die physischen Kanäle 0, 28, 29, 30, 31) können zugeorndet

+  werden.) 

+- Nicht jeder physische Kanal muß zugeordnet werden. 

+- Jeder physische Kanal darf höchstens einmal zugeordnet werden. 

+ 

+Hinweis: 

+  EUMEL verwaltet Kanal 1..16 als (unprivilegierte) Stream-Kanäle, 

+                  Kanal 17..24 als unprivilegierte Block-Kanäle, 

+                  Kanal 25..31 als privillegierte Block-Kanäle. 

+ 

+ 

+#ub#6.6  Installation auf Harddisk#ue# 

+ 

+Wie früher kann der SHard auf einem Harddisk-Volume installiert werden.

+Dazu werden alle vorhandenen EUMEL-Volumes angeboten und das gewünschte

+ausgesucht. Falls kein EUMEL-Volume (mehr) vorhanden ist, werden alle ande-

+ren Volumes angeboten. Dadurch ist es möglich ein neues EUMEL-Volume einzu-

+richten (mit 'dmgr' unter CP/M). Der SHard belegt 2 Tracks (16k) auf der

+Harddisk. 

+ 

+ 

+#ub#6.7  Installation auf Floppy#ue# 

+ 

+Um ganz auf eine Harddisk verzichten zu können oder falls der Harddisk-

+SHard zerstört wurde, kann EUMEL jetzt auch über eine Boot-Diskette hochge-

+fahren werden. Eine Bootdiskette (160k oder 640k) enthält auf den ersten 4

+Tracks den SHard, kann deshalb nicht mehr als CP/M-Datendiskette verwendet

+werden. 

+Die Floppy kann mit dem Installationsprogramm bootfähig gemacht werden. 

+ 

diff --git a/system/shard-z80-ruc-64180/1.5/src/65.SUB b/system/shard-z80-ruc-64180/1.5/src/65.SUB
new file mode 100644
index 0000000..7dc9439
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/65.SUB
@@ -0,0 +1 @@
+M80=DISK/M

diff --git a/system/shard-z80-ruc-64180/1.5/src/BOOT.INC b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC
new file mode 100644
index 0000000..b03a57c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC
@@ -0,0 +1,121 @@
+

+;

+;****************************************************************

+;

+;	EUMEL Initialisierung fuer 6502 Teil

+;

+;	Version 0.4 vom 25. 11. 1985

+;	Version	0.5 vom 24.12.86

+;	Version	0.6 vom 14.01.87

+;

+;****************************************************************

+;

+	  .6502

+

+          .radix    16

+

+main_ROM  equ      0C082

+lc_RAM    equ	   0C083

+lc_lock	  equ	   0C00F

+

+RESET	EQU	$FA62

+BREAK	EQU	$FA4C

+VECTBL	EQU	$FFFA

+

+;................................................................

+;

+init65:

+	sei

+	lda	lc_RAM

+	lda	lc_RAM		; LC-RAM write enable

+	lda	lc_lock		; verriegeln

+

+;

+	ldx	#0		; pointer initialisieren

+	stx	task

+	stx	INTPAR1	

+	stx	IFLG		; "Weiter" Kanal 5 Receiveinterrupt

+	stx	E_FLG		; Keine Eingabeflusskontrolle

+	stx	A_FLG		; Keine Ausgabeflusskontrolle

+	stx	SerFlg		; Kein Ausgabestop

+	stx	Wait_flg	; 64180 darf auf Pufferdescriptor zugreifen

+	stx	bus_locked	; Inteerupt an 64180 erlaubt, da kein Bus-Lock

+	stx	err1_bits

+	stx	err5_bits	; Keine Uebertragungs-Fehler aufgetreten

+	stx	KeyIn		; Tastaturpuffer leer

+	stx	KeyOut

+	stx	param1+1

+

+	dex			; X := FF

+	stx	param2

+	stx	param2+1

+	stx	last_track

+

+		lda	#0		; Physische Addresse der Sektoren

+		tax			; bestimmen (ueber Interleave)

+interlv_1:	

+		sta	ilv_tble,x

+		inx

+		clc

+		adc	#3		; interleave

+		and	#0F		; MOD 16

+		cpx	#10

+		bne	interlv_1

+

+	ldx	#80

+	stx	param1

+	jsr	GCTRL		; Grafik initialisieren

+

+	jsr	init_pbuf

+

+	ldx	#initab_len

+rloop:	lda	rbuf_ini,x

+	sta	rbuf,x

+	dex

+	bpl	rloop

+

+	ldx	#initab_len

+tloop:	lda	tbuf_ini,x

+	sta	tbuf,x

+	dex

+	bpl	tloop

+

+	ldx	#6

+vecloop:

+	lda	vector,x

+	sta	vectbl,x	; Vektoren ins RAM kopieren

+	dex

+	bne	vecloop

+

+	sta	KeyStr		; Tastatur ruecksetzen

+	sta	0C009		;   auf Interrupt schalten

+

+;	serielle Schnittstelle initialisieren

+;

+	lda	#1E		; 9600 Bd, 8 Bits/Char., 1 Stopbit

+	sta	SER_CTR

+	lda	#09		; no parity, rx/tx irq's enabled

+	sta	SER_COM

+

+	ldx	SLT180

+	stx	SLOT180

+	cli			; Interrupt enable

+

+	jmp	task_loop	; Jump in die Task_Loop_Routine

+

+vector:	

+	dw	resvec		; NMI

+	dw	resvec		; RESET

+	dw	irqvec		; IRQ & BRK

+

+tbuf_ini:

+	DW	(SBUFEND - SBUFBEG) * 100H, 0

+	DW	SBUFBEG * 100H, SBUFBEG * 100H

+	DB	SBUFBEG, SBUFEND

+

+rbuf_ini:

+	DW	(RBUFEND - RBUFBEG) * 100H, 0

+	DW	RBUFBEG * 100H, RBUFBEG * 100H

+	DB	RBUFBEG, RBUFEND

+	

+	ds	$100-(*-start)

diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC
new file mode 100644
index 0000000..273c56e
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC
@@ -0,0 +1,123 @@
+	TITLE	Basis 108 Console Ausgabe

+;

+	INCLUDE HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	C O N O U T

+;

+;	Direkte BASIS 80 Zeichen Ausgabe

+;

+;	Version 1.0 - 16. 9. 1985

+;	Version 1.1 - 28. 10. 1985 (Invers korrigiert)

+;	Version 1.2 - 30.12.86 (Zeichensatzeinstellung, Stringausgabe)

+;

+;	Teil des EUMEL SHARD fuer RUC 64180

+;

+;****************************************************************

+;

+;	Globale Adressen

+;

+	GLOBAL	CRTOUT, SWICUR, STROUT

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL  TO6502, ZGERL, BEEPFRQ

+;

+;----------------------------------------------------------------

+;

+;	Konstanten fuer MMU

+;

+BIOSBANK EQU	0F2H		;CBAR fuer 6502 Zugriff

+AR6502	EQU	5EH		;BBR-Wert fuer 6502 Zugriff

+BASE	EQU	2000H		;6502 Adressoffset

+;

+;	6502 Softswitches

+;

+STRAM1	EQU	BASE+0C00CH	;Umschalten auf Videobank 0

+STRAM2	EQU	STRAM1+1	;Umschalten auf Videobank 1

+

+SWINV	EQU	BASE+0C000H	; > 127: Invers

+SWFLSH	EQU	SWINV+1		; > 127: Flash

+SW2OFF	EQU	SWFLSH+1	; Zeichensatzswitch 2

+SW2ON	EQU	SW2OFF+1

+SW1OFF	EQU	SW2ON+1

+SW1ON	EQU	SW1OFF+1

+SW0OFF	EQU	SW1ON+1

+SW0ON	EQU	SW0OFF+1

+;

+;	andere 6502 Adressen

+;

+SCREEN	EQU	BASE+400H	;Anfang Video RAM

+;

+;----------------------------------------------------------------

+;

+	DSEG

+;

+;	lokale Daten

+;

+GOTOCNT: DEFB	0

+GOTOX:	DEFB	0		;Reihenfolge GOTOX, GOTOY festgelegt !!

+GOTOY:	DEFB	0

+SCRADR:	DEFW	SCREEN

+SCRXY:	DEFW	0

+INVMOD:	DEFB	80H

+CURCHR:	DEFB	0

+CURINV:	DEFB	80H

+;

+OLDCBAR: DEFB	0		;Zwischenspeicher fuer CBAR

+OLDBBR:	DEFB	0		;Zwischenspeicher fuer BBR

+STKSAV:	DEFW	0		;Stackpointer Zwischenspeicher

+	DEFS	20

+STACK:

+;

+;----------------------------------------------------------------

+;

+	CSEG

+;

+

+;----------------------------------------------------------------

+;

+;	S T R O U T

+;	Zeichenkette auf Masterconsole-Bildschirm ausgeben

+;

+;	Eingang: HL = Startadresse der Zeichenkette

+;		 BC = Laenge der Zeichenkette

+;	Ausgang: HL und Akku veraendert

+;

+STROUT:

+	PUSH	BC

+	PUSH	DE

+	PUSH	IX

+

+	PUSH	HL		; Stringadresse --> IX

+	POP	IX

+

+OUTLOOP:

+	LD	A,B

+	OR	C

+	JR	Z,POPRET

+

+	PUSH	BC

+	LD	C,(IX+0)

+	CALL	CRTOUT

+	POP	BC

+	INC	IX

+	DEC	BC

+	JR	OUTLOOP

+

+POPRET:

+	POP	IX

+	POP	DE

+	POP	BC

+	RET

+	

+;-----------------------------------------------------------------

+	

+	INCLUDE	CONOUT4.INC

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC
new file mode 100644
index 0000000..9ffda13
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC
@@ -0,0 +1,466 @@
+

+;

+; CONOUT4.INC

+;

+; Character auf BASIS 108 80-Zeichen ausgeben

+;

+; Copyright (c) 1985 by Joerg Stattaus

+;

+; Modified for psi by R. Ellerbrake

+;

+; C=char

+;

+; Version 17.09.85

+;	Stand: 22.12.86, mit Zeichensatzeinstellung (M.St)

+;	       31.12.86, Mod. fuer 6502-Teil > 0C00

+;

+

+crtout:	

+	ld	hl,gotocnt	; GotoXY in Aktion ?

+	ld	a,(hl)

+	or	a

+	jr	z,crt2

+

+	dec	(hl)

+	ld	a,c

+	jr	z,crt1		; Get X-Value

+

+	ld	(gotoy),a	; Y storen

+	ret	

+

+crt1:	ld	(gotox),a

+

+	ld      b,7             ; Gotoxy is Function 7

+	jr      conq

+

+crt2:

+	ld      b,a

+	ld	a,c

+

+crt3:	cp	' '

+	jr      nc,conq		; normales Zeichen

+

+crt4:	ld      hl,scrfen       ; In Tabelle nach Zeichen suchen

+	ld      b,22            

+crt5:	cp	(hl)          

+	jr      z,crtfnd	; Sequenz erkannt

+

+	dec     hl              

+	djnz    crt5

+

+	ret			; nicht in der Tabelle enthalten

+

+crtfnd: ld      a,b		; Found

+	cp      7

+	jr      nz,conq       

+;

+	ld      a,2

+	ld      (gotocnt),a	; next 2 Bytes sind Koordinaten

+	RET

+

+SWICUR:

+	LD	B,23		; Cursor invertieren

+conq:

+	LD	A,I		; IEF2 retten

+	PUSH	AF

+	DI			; keine Interrupts zulassen

+;

+	in0	a,(cbar)	; Set CommonBaseAreaRegister for Video

+	ld	(oldcbar),a

+	ld	a,biosbank

+	out0	(cbar),a

+;

+	IN0	A,(BBR)		; Set Bank Base Register

+	LD	(OLDBBR),A

+	LD	A,AR6502

+	OUT0	(BBR),A

+;

+	LD	(STKSAV),SP	; alten SP retten (im umgeschalteten Bereich)

+	LD	SP,STACK

+;

+	CALL	CONQ1		; Print Char. on screen

+;

+	LD	SP,(STKSAV)	; alten Stack zurueckholen

+;

+	LD	A,(OLDBBR)	; restore old BBR

+	OUT0	(BBR),A

+	ld	a,(oldcbar)	; and CBAR

+	out0	(cbar),a

+	POP	AF		; IEF2 zurueckholen

+	RET	PO		; vorher kein EI ->

+;

+	EI			;reenable Interrupts

+	RET

+	

+; B=Sequenz / C=Char

+

+conq1:	ld      hl,(scradr)

+	ld      de,(scrxy)

+	ld      a,e

+	rra

+

+	CALL	ZGERL		; Zugriff erlaubt ?

+	ld	(stram1),a	; Dyn./Static RAM

+	jr	nc,conq2

+	ld	(stram2),a

+conq2:  

+	ld	a,b

+	or	a

+	jr	nz,scrfkt	; Screen-Function

+

+	ld	a,(invmod)	; schreibe Zeichen auf Bildschirm

+	or	c

+	ld	(hl),a

+adv0:   ex	de,hl

+	inc	hl

+	ld	a,l

+	cp	80

+	jp	c,onlinc

+

+	ld      l,0

+	inc     h

+	ld      a,h

+	cp      24

+	jp      c,calc

+

+	; scroll noetig

+

+	ld      l,0

+scroll: dec	h

+	push    hl

+	ld      d,0

+	call    del0		; delete Zeile 0

+

+	pop     hl

+calc:   ld      (scrxy),hl

+	ld      e,l

+	ld      a,h

+	call    basclc

+	ld      a,e     	; hl=lineadr / a=scrxyr

+	srl	a

+

+	ld      (stram1),a

+	jr      nc,calc3

+	ld      (stram2),a

+calc3:  

+	add     a,l

+	ld      l,a

+calc4:  ld      (scradr),hl

+calc5:  ld      a,(hl)  	; get char on cursor adr

+	ld      (curchr),a

+	ld      a,(curinv)

+	xor     (hl)

+	ld      (hl),a  	; invers zurueck

+	ld      (stram1),a

+

+crtret:	ret

+

+onlinc: ld      (scrxy),a	; normales increment des scr.poi.

+	ex      de,hl           ; HL wieder = scradr

+	rra

+

+	ld      (stram2),a

+	jr      c,calc5         ; selbe Adresse, 2. Seite

+	ld      (stram1),a

+	inc     hl

+	jr      calc4

+

+scrfkt: ld	a,(curchr)	; Restore Char on Screen

+	ld	(hl),a

+	ld	a,b

+	ld      hl,scrtab-2

+	add     a,a

+	add     a,l

+	ld      l,a

+	LD	A,H		; cross page boundary ?

+	ADC	A,0

+	LD	H,A

+	ld      a,(hl)

+	inc     hl

+	ld      h,(hl)

+	ld      l,a

+	jp      (hl)

+

+; Screen-Functions

+

+advanc: ld      hl,(scradr)

+	jr      adv0

+

+schome: ld      hl,0

+	jr      tocalc

+

+gotoxy: ld      hl,(gotox)	; H=Y / L=X

+got0:   ld      a,h

+	cp      24

+	jr      c,got1

+	

+	ld      h,0

+got1:   ld      a,l

+	cp      80

+	jr      c,tocalc

+

+got2:   ld      l,0

+	jr      tocalc

+

+up:     ex      de,hl

+	dec     h

+	jr      got0

+

+carret: ex      de,hl

+	jr      got2

+

+backsp: ex      de,hl

+	dec     hl

+	ld      a,l

+	cp      80

+	jr      c,tocalc

+

+	ld      l,79

+	jr      got0

+

+linefd: ex      de,hl

+	inc     h

+	ld      a,h

+	cp      24

+	jr      c,tocalc

+

+	jp      scroll

+

+erapag: push    de

+	call    erap0

+	pop     hl

+tocalc: jp      calc

+

+eralin: push    de

+	call    eral2

+	pop     hl

+	jr      tocalc

+

+insert: push    de

+	ld      a,d		; korrigiert

+	ld      de,SCREEN+003d0h ; Zeile 23

+	cp	23

+	jr      z,ins1          ; kein Verschieben

+

+	ld      b,23

+ins0:   dec     b

+	call    linmov

+	ld      a,(scrxy+1)	; Vertikal Adresse

+	cp      b

+	jr      nz,ins0

+

+ins1:   call    blank

+	pop     hl

+	jr      got2

+

+delete: push    de

+	call    del0

+	pop     hl

+	jr      got2

+

+normal: ld      a,80h

+	jr      inv1

+

+invers: xor     a

+inv1:   ld      (invmod),a

+;

+inv2:   ex      de,hl

+	jr      tocalc

+

+chacur: ld      hl,curinv

+	ld      a,(hl)

+	xor     80h

+	ld      (hl),a

+	jr      inv2

+

+clear:  call    schome

+	ld      de,0

+	push    de

+	call    erap0

+	pop     hl

+	jr      tocalc

+

+bell:   push	hl

+	ld	a,(BEEPFRQ)

+	ld	h,a

+	ld	l,2		; task beep

+	call	to6502

+	pop	hl		; transport scrxy to HL

+	ret

+

+eral2:  ld      hl,(scradr)

+	push    hl

+	ld      (stram1),a

+	ld      a,e

+	srl     a

+	jr      nc,eral3

+

+	inc     a

+	inc     hl

+eral3:  call    erablk

+	

+	ld      (stram2),a

+	pop     hl

+	ld      a,e

+	srl     a

+erablk: sub     41

+	cpl

+	ld      b,0a0h

+erabl1: or	a

+	ret	z

+	ld      (hl),b

+	inc     hl

+	dec     a

+	jr      erabl1

+

+erap0:  call    eral2

+	ld      a,(scrxy+1)

+erap1:  inc     a

+	cp      24

+	ret     nc

+

+	push    af

+	call    basclc

+	

+	ex      de,hl

+	call    blank

+	pop     af

+	jr      erap1

+

+del0:   ld      a,d

+	cp      23

+	ld      de,SCREEN+003d0h  ; Zeile 23

+	jr      z,blank

+

+	push    af

+	call    basclc

+	pop     bc              ; Vert. Adr. von D -> A -> B

+

+	ex      de,hl

+del1:   inc	b

+	call    linmov

+	ld      a,b

+	cp      23

+	jr      c,del1

+

+blank:  ld      (stram1),a

+	ld      a,' '+80h

+	push    de

+	call    blank1

+	pop     de

+	ld      (stram2),a

+

+blank1: ld      b,40

+blank2: ld      (de),a

+	inc     de

+	djnz    blank2

+

+	ret

+

+linmov: push    bc

+	ld      a,b

+	call    basclc

+	ld      (stram1),a

+	push    hl

+	push    de

+	ld      bc,40

+	ldir                    ; eine Zeile

+	pop     de

+	pop     hl

+	push    hl

+	ld      (stram2),a

+	ld      bc,40

+	ldir

+	pop     de              ; HL nun in DE = neues Ziel

+	pop     bc

+	ret

+

+basclc: ld      c,a

+	ld      l,0

+	rra

+	rr      l

+	and     3

+	add     a,HIGH SCREEN	; screen - start

+	ld      h,a

+	ld      a,c

+	and     18h

+	ld      c,a

+	add     a,a

+	add     a,a

+	add     a,c             ; * 5 = 40

+	add     a,l

+	ld      l,a

+	ret                     ; HL = Line adress

+

+ger:				; German ASCII

+	ld	(sw0off),a

+	ld	(sw1on),a

+	ld	(sw2off),a

+	ret

+

+usa:				; ASCII

+	ld	(sw0off),a

+	ld	(sw1off),a

+	ld	(sw2on),a

+	ret

+

+apl:				; APL

+	ld	(sw0off),a

+	ld	(sw1on),a

+	ld	(sw2on),a

+	ret

+

+uni:				; ASCII und Inv. APL

+	ld	(sw0on),a

+	ld	(sw1on),a

+	ld	(sw2on),a

+	ret

+

+invsw:

+	ld	(swinv),a

+	ret

+

+flshsw:

+	ld	(swflsh),a

+	ret

+

+; Screen-Command-Definition-Table

+

+;leadsf:db	1bh

+;	db	0aah,0d9h,0d4h,0a9h,0a8h,1eh,0bdh,0bh,0ch

+;	db	0ah,08h,0dh,0cch,0cdh,0dah,07h

+;

+;	EUMEL psi-Terminal Definition

+;

+	DEFB	9		;Clear Screen (bei psi undefiniert)

+	DEFB	4		;Clear to End of Page

+	DEFB	5		;Erase to End-of-Line

+	DEFB	14		;Endmark (Normal Video)

+	DEFB	15		;Beginmark (Invers Video)

+	DEFB	1		;Home

+	DEFB	6		;Cursor Positionierung

+	DEFB	3		;Cursor 1 Zeile nach oben

+	DEFB	2		;Cursor nach rechts

+	DEFB	10		;Line feed

+	DEFB	8		;Backspace

+	DEFB	13		;Carriage Return

+	DEFB	11		;Insert Line (bei psi undefiniert)

+	DEFB	12		;Delete Line (bei psi undefiniert)

+	DEFB	0		;NULL (nichts tun)

+	DEFB	7		;BELL

+	DEFB	16		;GER, Zeichensatz

+	DEFB	17		;USA,     "

+	DEFB	18		;APL,     "

+	DEFB	19		;UNI, 	  "

+	DEFB	20		;Invers > 127

+	DEFB	21		;Flash > 127

+

+scrfen	equ	$-1

+

+scrtab: dw      clear,erapag,eralin,normal,invers,schome,gotoxy,up,advanc

+	dw      linefd,backsp,carret,insert,delete,CRTRET,bell

+	dw	ger,usa,apl,uni,invsw,flshsw,chacur

+;

+;	CRTRET anstelle von chacur

+

+; Ende von CONOUT3.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/CREF.COM b/system/shard-z80-ruc-64180/1.5/src/CREF.COM
new file mode 100644
index 0000000..e449ce9
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CREF.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/DB.COM b/system/shard-z80-ruc-64180/1.5/src/DB.COM
new file mode 100644
index 0000000..63b3afb
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DB.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC
new file mode 100644
index 0000000..70f173c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC
@@ -0,0 +1,1657 @@
+;

+	TITLE	EUMEL fuer RUC 64180, 6502 Teil & Diskroutinen

+;

+;****************************************************************

+;

+;	 EUMEL 1.8.0 with RUC180-Card on BASIS 108

+;

+;	 6502 DISK-Driver und Motherboard I/O

+;

+;	 Stand (1.8) : 14.01.87, mit neuem Puffer-Handling

+;		     : 27.05.87, mit Hardcopy auf SHIFT CTRL F12

+;		     : 26.06.87, Druckerspooler loeschen mit Task 8

+;	 Version 23.09.85 ./. 22.11.85

+;

+;****************************************************************

+;

+	  .6502

+          .radix    16 

+;

+;----------------------------------------------------------------

+;

+;	Globale Variable

+;

+	GLOBAL	DES6502, PRG6502, LEN65, ST6502

+;

+;----------------------------------------------------------------

+;

+;	Konstanten

+;

+XOFF	EQU	13		; CTRL-S

+XON	EQU	11		; CTRL-Q

+;

+;	Adressen

+;

+KeyBoard 	equ	0C000

+Keyext		equ	0C008

+KeyStr		equ	0C010

+

+VIDBNK		equ	0C00C

+

+prackn		equ	0C1C1

+prport		equ	0C090

+

+speaker		equ	0C030

+

+serial_stat	equ	0C099

+SER_DAT 	EQU	0C098H		;Serial Interface Data

+SER_COM 	EQU	0C09AH		;Serial Command Register

+SER_CTR		EQU	0C09BH		;Serial Control Register

+	

+analog_1	EQU	$C063

+analogreset	EQU	$C070

+

+; Floppy Hardware

+

+phase0    equ      0C080

+phase1    equ      0C082

+phase2    equ      0C084

+phase3    equ      0C086

+mtroff    equ      0C088

+mtron     equ      0C089

+drive0    equ      0C08A

+Q6off     equ      0C08C

+Q6on      equ      0C08D

+Rstate    equ      0C08E

+Wstate    equ      0C08F

+;

+	INCLUDE	ZPAGE.INC	;Zero Page Adressen

+;

+;	sonstiges

+;

+bit_z		equ	24

+

+fast_step equ	$0E	; etwas weniger als 3 ms Track-Wechselzeit

+

+pagerr	  macro	    adr

+	  if high(*-start) ne high(adr-start)

+	  .printx 'Page-Error'

+	  endif

+	  endm

+

+	  cseg

+PRG6502:

+	  .phase    0C00

+DES6502:			; 6502-Startadresse zum kopieren

+

+start:				; Label fuer Pageboundcheck

+nible1:				; Anfang des Nibble-Buffers

+	defm	'6502-Teil'

+

+ST6502:				; Startadresse 6502-Teil Initialisierung

+	include BOOT.INC

+

+	include NIBLE.INC	

+

+write_data

+          SEC

+          LDA       Q6on,X

+          LDA       Rstate,X

+          BMI       wrdat99

+          LDA       nible2

+          STA       temp2

+          LDA       #0FF

+          STA       Wstate,X    ;  5

+          ORA       Q6off,X     ;  4

+          PHA                   ;  3

+          PLA                   ;  4     [sta..sta[

+          NOP                   ;  2

+          LDY       #04         ;  2

+wrdat1    PHA                   ;  3             3

+          PLA                   ;  4             4

+          JSR       wrt_nibl1   ;+13        15  13

+          DEY                   ;---         2

+          BNE       wrdat1      ; 40       + 3

+                                ;          --- ---

+                                ;           20+ 20 = 40

+

+	  pagerr    wrdat1

+

+                                ;           -1

+          LDA       #0D5        ;            2

+          JSR       wrt_nibl     ; 15       +15

+          LDA       #0AA        ;  2       ---

+          JSR       wrt_nibl     ;+15        36

+          LDA       #0AD        ;---

+          JSR       wrt_nibl     ; 32        15

+          TYA                   ;            2

+          LDY       #56         ;            2

+wrdat11   BNE       wrdat3      ;            3

+wrdat2    LDA       nible2,Y    ;            0    4

+wrdat3    EOR       nible2-1,Y  ;            5    5

+          TAX                   ;            2    2

+          LDA       to_nibble,X ;            4    4

+          LDX       slot10z     ;            3    3

+                                       ;   ---  ---

+                                       ;    36   18

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          DEY                          ;     2

+          BNE       wrdat2             ;     3

+                                       ;   ---

+                                       ;    14 + 18 = 32

+                                       ;    -1

+          LDA       temp2              ;     3

+          NOP                          ;     2

+wrdat4    EOR       nible1,Y           ;     4    4

+          TAX                          ;     2    2

+          LDA       to_nibble,X        ;     4    4

+          LDX       slot10             ;     4    4

+                                       ;   ---  ---

+                                       ;    32   14

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          LDA       nible1,Y           ;     4

+          INY                          ;     2

+          BNE       wrdat4             ;     3

+                                       ;   ---

+                                       ;    18+ 14 = 32

+

+	  pagerr	    wrdat11

+

+          TAX                          ;     2

+          LDA       to_nibble,X        ;     4

+          LDX       slot10z            ;     3

+          JSR       wrt_nibl2          ;     6  15

+          LDA       #0DE               ;   ---   2

+          JSR       wrt_nibl            ;    32  15

+          LDA       #0AA               ;       ---

+          JSR       wrt_nibl            ;        32

+          LDA       #0EB

+          JSR       wrt_nibl

+          LDA       #0FF

+          JSR       wrt_nibl

+          LDA       Rstate,X

+wrdat99

+          LDA       Q6off,X

+wrdat999

+	  dey

+	  bne	   wrdat999		; PostErase-Delay 1 ms

+

+          RTS

+

+read_hdr

+          sei

+          LDY       #0FC

+          STY       temp2

+rdhdr0

+          INY

+          BNE       rdhdr1

+          INC       temp2

+          BEQ       fail

+rdhdr1

+          LDA       Q6off,X

+          BPL       rdhdr1

+rdhdr11   CMP       #0D5

+          BNE       rdhdr0

+

+          NOP

+rdhdr2    LDA       Q6off,X

+          BPL       rdhdr2

+          CMP       #0AA

+          BNE       rdhdr11

+

+          LDY       #03

+rdhdr3    LDA       Q6off,X

+          BPL       rdhdr3

+          CMP       #96

+          BNE       rdhdr11

+          

+	  pagerr    rdhdr1

+

+          

+          LDA       #00

+nxthByte  STA       chk_sum

+rdhdr4    LDA       Q6off,X

+          BPL       rdhdr4

+	  ROL	    A

+          STA       temp2

+rdhdr5    LDA       Q6off,X

+          BPL       rdhdr5

+          AND       temp2

+          STA       chk_in_hdr,Y

+          EOR       chk_sum

+          DEY

+          BPL       nxthbyte

+

+          TAY

+          BNE       fail

+

+rdhdr6    LDA       Q6off,X

+          bpl       rdhdr6

+          cmp       #0DE

+          BNE       fail

+

+          NOP

+rdhdr7    LDA       Q6off,X

+          BPL       rdhdr7

+          CMP       #0AA

+          BNE       fail

+

+          CLC

+          RTS

+fail

+          SEC

+          RTS

+

+moving

+          LDY       #0

+mov0      LDA       Q6off,X

+	  JSR	    mov1

+	  PHA			;  3

+ 	  PLA			;  4

+	  CMP	    Q6off,X	;  4

+	  BNE	    mov1	;----

+	  DEY			; 21 uS

+	  BNE	    mov0

+mov1	  RTS

+

+

+read_data

+	  TXA

+	  ORA	    #8C

+	  STA	    ld1+1

+	  STA	    ld2+1

+	  STA	    ld3+1

+	  STA	    ld4+1

+	  STA	    ld5+1

+	  LDA	    user_data

+	  LDY	    user_data+1

+	  STA	    st5+1

+	  STY	    st5+2

+	  SEC

+	  SBC	    #54

+	  BCS	    rddat1

+	  DEY

+	  SEC

+rddat1

+	  STA	    st3+1

+	  STY	    st3+2

+          SBC       #57

+          BCS       rddat2

+          DEY

+rddat2

+          STA       st2+1

+          STY       st2+2

+

+          LDY       #20

+nxt_begin

+          DEY

+          BEQ       fail

+wait_begin

+waitb0    LDA       Q6off,X

+          BPL       waitb0

+waitb00   EOR       #0D5

+          BNE       nxt_begin

+          NOP

+waitb1    LDA       Q6off,X

+          BPL       waitb1

+          CMP       #0AA

+          BNE       waitb00

+          NOP

+waitb2    LDA       Q6off,X

+          BPL       waitb2

+          CMP       #0AD

+          BNE       waitb00

+

+          LDY       #0AA

+          LDA       #0

+rloop1    STA       temp2

+ld1       LDX       Q6off+60  ; addr modified by read init !

+          BPL       ld1

+          LDA       to_bits-96,X

+          STA       nible2-0AA,Y

+          EOR       temp2

+          INY

+          BNE       rloop1

+          

+;

+; read nible from disk and convert to user data

+;

+          LDY       #0AA

+          BNE       ld2

+rloop2

+st2       STA       1000,Y

+ld2       LDX       Q6off+60  ; modified by read init

+          BPL       ld2

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+0,X

+          INY

+          BNE       rloop2

+

+          PHA

+          AND       #0FC

+          LDY       #0AA

+ld3       LDX       Q6off+60  ; modified by read init

+          BPL       ld3

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+1,X

+st3       STA       1000,Y

+          INY

+          BNE       ld3

+

+ld4       LDX       Q6off+60  ; modified by read init

+          BPL       ld4

+          AND       #0FC

+          LDY       #0AC

+rloop5    EOR       to_bits-96,X

+          LDX       nible2-0AC,Y

+          EOR       to_bytes+2,X

+st5       STA       1000,Y

+ld5       LDX       Q6off+60  ; modified by read init

+          BPL       ld5

+          INY

+          BNE       rloop5

+          AND       #0FC

+          EOR       to_bits-96,X

+          LDX       slot10z

+          TAY

+          BNE       chk_fail

+rloop6    LDA       Q6off,X

+          BPL       rloop6

+          CMP       #0DE

+          BEQ       read_ok

+

+          pagerr      wait_begin

+chk_fail

+          SEC

+          db     bit_z

+read_ok

+          clc

+          PLA

+          LDY       #55

+          STA       (user_data),Y

+          RTS

+

+seekT	  lda	    iob_trk          

+seekL

+	  jsr	    trk_to_ph

+          cmp       phase0,X

+          cmp       phase1,X

+          cmp       phase2,X

+          cmp       phase3,X

+          LDY       disk_no

+          LDA       head_table,y	; da steht der Kopf jetzt

+          STA       head_pos

+	  lda	    dest_phase

+	  sta	    head_table,y	; da soll er nachher stehen

+          

+seekH

+          cmp       head_pos

+          BEQ       seek_rts

+          LDA       #0

+          STA       temp2

+seekh0    LDA       head_pos

+          STA       phase

+          SEC

+          SBC       dest_phase

+          BEQ       seekh5

+          BCS       seekh1

+          EOR       #0FF

+          INC       head_pos

+          BCC       seekh2

+seekh1    ADC       #0FE

+          DEC       head_pos

+seekh2    CMP       temp2

+          BCC       seekh3

+          LDA       temp2

+seekh3    CMP       #8

+          BCS       seekh4

+          TAY

+seekh4    SEC

+          JSR       step

+          LDA       time0,Y

+          JSR       step_wait

+          LDA       phase

+          CLC

+          JSR       step1

+          LDA       time1,Y

+          JSR       step_wait

+          INC       temp2

+          BNE       seekh0

+

+seekh5    JSR       step_wait

+          CLC

+step      LDA       head_pos

+step1     AND       #3

+          ROL       A

+          ORA       slot10z

+          TAX

+          LDA       phase0,X

+          LDX       slot10z

+seek_rts  RTS

+

+;-------------------------------;

+

+make_nibl

+          LDY       #56

+          LDA       #0

+maken0    STA       nible2-1,Y

+          DEY

+          BNE       maken0

+maken1    LDX       #55

+maken2    LDA       (user_data),Y

+          AND       #0FC

+          STA       nible1,Y

+          EOR       (user_data),Y

+          INY

+          CMP       #02

+          ORA       nible2,X

+          ROR       A

+          ROR       A

+          STA       nible2,X

+          DEX

+          BPL       maken2

+          CPY       #02

+          BNE       maken1

+          RTS

+

+;	ds	10

+          

+Dsk_RW 

+	  ldx	    #0A9	; LDA #xx

+	  lda	    def_byte

+	  and	    #$20	; Bit 5 ?

+	  bne	    rw_0	; Fast Step - use abs. value

+

+				; Slow Step - use MotorOn/Off-Tables

+	  ldx	    #0C9	; CMP #xx

+rw_0:	  stx	    step_wait

+	

+	  lda	    #fast_step	; Set Step Rate

+	  bit	    def_byte

+	  bmi	    rw_1	; Bit7: Controller-Typ

+				; Bit7=0 => Ehring

+	  lsr	    a		; bei Ehring 2-fache Phases => halbe Steprate

+

+rw_1:	  sta	    step_wait+1		; Steprate

+

+          lda       disk_no

+          LSR       A

+          TAY

+          LDA       slotn,Y

+          STA       slot10

+          sta       slot10z

+          adc       #0

+          STA       iob_drv

+          

+ 	  include TRACK.INC 

+

+trk_to_ph:			; IN: A = track / OUT: A,dest_phase = phase

+	sta	dest_phase

+

+; Select Side 0

+

+	bit	def_byte	; Bit7: 1=Erphi-Controller

+				; Bit6: 1=Erphi-Format

+

+	bvc	ehring_format	; Bit6 = 0 => Ehring-Format

+

+	lsr	dest_phase	; Erphi-Format

+	bcc	side0

+

+; Select Side 1

+; Erphi:  mtroff, Q6on, mtron

+; Ehring: mtroff,mtron

+

+side1:	lda	mtroff,x

+	bit	def_byte

+	bpl	side1_2

+				; Erphi-Side-1-Select

+	lda	Q6on,x

+side1_2:

+	lda	mtron,x

+	jmp	ph_mult

+

+ehring_format:

+	cmp	#$50		; Track >= 80 ?

+	bcc	side0		; nein: Select Side 0

+

+	sbc	#$50

+	sta	dest_phase

+	jmp	side1

+

+; Select Side 0

+; Ehring: lda cn00,x

+; Erphi : mtroff, Q6off, mtron

+

+side0:	bit	def_byte

+	bmi	erphi_s0	; Bit7 = 1 => Erphi-Controller

+

+	txa			; Ehring-Side-0-Select

+	lsr	a

+	lsr	a

+	lsr	a

+	lsr	a

+	ora	#$C0

+	sta	ehr_sel+2

+

+ehr_sel:lda	$C600

+	jmp	ph_mult

+

+erphi_s0:			; Erphi-Side-0-Select

+	cmp	mtroff,x

+	cmp	Q6off,x

+	cmp	mtron,x

+

+ph_mult:

+	lda	def_byte	; Bit 0..1: 0 = 1 Step/Track

+	and	#03		;           1 = 2 Steps/Track

+	tay			;           2 = 4 Steps/Track

+	beq	ph_mult2

+

+ph_mult1:

+	asl	dest_phase

+	dey

+	bne	ph_mult1

+

+ph_mult2:

+	lda	dest_phase

+	rts

+

+;---------------------------------------------------------------------------

+;

+;	D I S K R W

+;	Eingang:	iob_trk, sektor, def_byte, disk_no, param, last_track

+;			dma, ilv_tbl, 

+;	Ausgang:	iob_err

+;	Daten:		x000..xFFF (Ein Track, Sektoren in log. Reihenfolge)

+;	64180 darf nicht auf den Applebus, Aufruf mit JSR

+;

+;---------------------------------------------------------------------------

+

+DISKRW:

+		jsr	lock_bus

+

+		lda	iob_trk		; Track fuer Read/Write		

+		bit	param		; 0 = Write, FF = Read

+		bpl	writecmd

+		cmp	last_track	; Muss auf neuen Track positioniert

+		bne	readtrack	; werden ?

+

+		ldy	sektor

+		ldx	ilv_tble,y

+		lda	sec_tble,x

+		beq	readtrack	; Sektor nicht ok

+		ldx	ilv_tble+1,y

+		lda	sec_tble,x

+		beq	readtrack

+

+		lda	#00		; Nein, somit auch kein Lesefehler

+		sta	iob_err

+		jmp	unlock_bus

+

+readtrack:

+		sei

+		lda	#10		; Track muss ganz neu gelesen werden

+		sta	sec_cnt		; das sind 16 Sektoren a 256 Byte

+		lda	#00		; Kennzeichen fuer Einlesen

+		ldx	#0F

+sec_1_loop:	sta	sec_tble,x	; Sektortabelle = Kennzeichen setzen

+		dex

+		bpl	sec_1_loop

+		bmi	readwrite

+

+writecmd:	

+		sei

+		ldx	#02		; Bei Write nur 512 Byte schreiben

+		stx	sec_cnt

+		ldx	#0F

+		lda	#$FF		; Kennzeichen fuer 'nicht Einlesen'

+sec_2_loop:	sta	sec_tble,x

+		dex

+		bpl	sec_2_loop

+

+		ldy	sektor		; gewuenschter 1. Sektor

+		ldx	ilv_tble,y	; logisch --> physisch umrechnen

+		lda	#00		; Kennzeichen 'Sektor schreiben'

+		sta	sec_tble,x

+		ldx	ilv_tble+1,y	; 2. Sektor logisch --> physisch

+		sta	sec_tble,x	; Auch schreiben

+

+		lda	last_track	

+		cmp	iob_trk		; Anderer Track als der letzte ?

+		beq	readwrite

+		jsr	readwrite	; Ja

+		lda	#$FF		; Muss bei Read neu eingelesen werden,

+					; da die anderen 14 Sektoren zum

+					; letzen Track gehoeren

+		sta	last_track

+		rts

+

+readwrite:	

+

+		lda	#00

+		tay

+		tax

+interlv_2:

+		ora	#dma_4k		; Cachebereich (4k) fuer Track

+		sty	dma,x

+		inx

+		sta	dma,x

+		inx

+		clc

+		adc	#0B		; Interleave 3

+		and	#0F		; MOD 16

+		cpx	#20		; 16 Sektoren

+		bne	interlv_2

+

+		lda	#0F		; Step Rate

+		sta	iob_err

+		jsr	dsk_rw		; Disk Operation

+		lda	iob_err		; Fehlerkennzeichen

+		beq	no_err

+

+		ldy	sektor

+		ldx	ilv_tble,y

+		lda	sec_tble,x

+		beq	is_err		; Fehler im 1. Teil des Blocks ?

+		ldx	ilv_tble+1,y

+		lda	sec_tble,x

+		beq	is_err		; Fehler im 2. Teil des Blocks ?

+					; nein,

+		lda	#0

+		sta	iob_err		; Zumindest dieser Block ok

+		beq	no_err		; Always

+

+is_err:

+		lda	#$FF		; Track muss neu gelesen werden

+		db	bit_a		; Skip 2 Bytes

+no_err:		lda	iob_trk		; last_track := track

+		sta	last_track

+		jmp	unlock_bus

+

+;----------------------------------------------------------------------------

+;

+;	A N A L 6 5

+;	Eingang:	param = 1..4 (Analogschalternummer)

+;	Ausgang:	analogwert = 0..255

+;

+;---------------------------------------------------------------------------

+

+ANAL65:

+		sei

+		jsr	lock_bus

+		ldx	param		; Nummer des Analogports

+		lda	analogreset	; Timer starten

+		ldy	#00

+		nop

+		nop

+readanalog:

+		lda	analog_1,x	; Analogwert lesen

+		bpl	anaready

+		iny

+		bne	readanalog	; Bis Bit 7 auf 0

+		pagerr	readanalog

+		dey			; Maximum 255

+

+anaready:	sty	analogwert

+		cli

+		jmp	unlock_bus

+

+;

+		INCLUDE GRAFIK65.MAC

+;

+irqvec:

+	sta	Asave		; Akku retten

+	pla

+	pha

+	and	#10		; BRK -Bit ?

+	bne	brkirq

+	lda	Asave

+	jmp	irq		; Interrupt ausfuehren

+

+brkirq:

+	lda	main_ROM

+	lda	Asave

+	jmp	BREAK		; Alte BREAK-Routine

+

+resvec:

+	lda	main_ROM	; ROM einschalten

+	jmp	RESET		; Alte RESET-Routine

+

+;****************************************************************

+;

+;	B E L L

+;

+; => Akustisches Signal

+

+beep	  sei

+	  jsr	    lock_bus

+	  lda	    #$32	; Laenge

+				; Frequenz = 5000/X Hz

+

+beep1	  ldx	    param	;  3

+beep2	  ldy	    #$12	; 	 2

+beep3	  dey			; 		   2

+	  bne	    beep3	; 		 + 3

+				;		----

+				;	89 = 	   5 * 18 - 1

+	  nop			;        2

+	  nop			;        2

+	  nop			;        2

+	  dex			; 	 2

+	  bne	    beep2	; 	 3

+				;	----

+				;	102 * X * 0.9775 us

+				;     = 99.7ms (f ~ 10kHz/X)

+				; -1 (Branch)

+	  bit	    speaker	;  4

+	  sec			;  2

+	  sbc	    #1		;  2

+	  bne	    beep1	;  3

+				; -----

+				; (14 + 102 * X) * A States Dauer

+				; 0.9775 * (14 + 102 * X) * A us

+	  cli

+	  jmp	    unlock_bus

+

+;*******************************************************************

+;

+;	Zugriffskontrolle fuer 64180 auf 6502-Bus

+;

+lock_bus:

+	lda	#$FF

+	sta	bus_locked

+	ldx	SLOT180

+	lda	wait180,x

+	rts

+

+unlock_bus:

+	lda	#$00

+	sta	bus_locked

+	ldx	SLOT180

+	lda	start180,x

+	rts

+

+;*******************************************************************

+;

+;	Input-Buffer Handler

+;

+;	Der Buffer darf nicht voll sein!

+;	Interrupts bei Receive-Buffer disabled

+;	Eingang: A = Zeichen

+;		 X = Bufferdescriptor Offset

+;	Ausgang: X intakt

+;		 A veraendert

+;		 SEC, wenn Puffer voll war

+putbuf:

+	sei

+putbuf0:

+	pha

+	lda	free,x		; Test, ob Puffer voll

+	ora	free+1,x

+	beq	putbuf4

+	pla

+

+	sta	(in,x)		; Zeichen in Puffer schreiben

+

+	inc	in,x		; Schreibzeiger erhoehen

+	bne	putbuf1

+	inc	in+1,x

+

+	lda	in+1,x		; Puffer-Ende ?

+	cmp	end,x

+	bcc	putbuf1

+	lda	beg,x		; Ringpuffer, wieder auf Pufferanfang setzen

+	sta	in+1,x

+

+putbuf1:

+	dec	wait_flg	; Warten, bis update vorbei

+	inc	full,x		; Belegten Platz vergroessern

+	bne	putbuf2

+	inc	full+1,x

+

+putbuf2:			; Dieser Wert wird auch von FROUT benutzt!

+	lda	free,x		; Freiplatz verringern

+	bne	putbuf3

+	dec	free+1,x

+putbuf3:

+	dec	free,x

+	inc	wait_flg	; Update gelaufen

+	clc			; Zeichen uebernommen

+	rts

+

+putbuf4:

+	pla

+	sec

+	rts			; Puffer war voll

+	

+;*******************************************************************

+;

+;	Output-Buffer Handler

+;

+;	Interrupts bei Transmit-Buffer disabled

+;	Der Buffer darf nicht leer sein!

+;	Eingang: X = Bufferdescriptor Offset

+;	Ausgang: X intakt

+;		 A = Zeichen

+;		 SEC, wenn Puffer leer war

+getbuf:

+	sei

+getbuf0:

+	sec

+	lda	full,x

+	ora	full+1,x

+	beq	getbuf4		; Test, ob Puffer leer ist

+

+	lda	(out,x)		; Zeichen aus Puffer lesen

+	pha

+

+	inc	out,x

+	bne	getbuf1

+	inc	out+1,x		; Lesezeiger erhoehen

+

+	lda	out+1,x

+	cmp	end,x

+	bne	getbuf1

+	lda	beg,x

+	sta	out+1,x		; Ringpuffer, Zeiger wieder auf Pufferanfang

+

+getbuf1:

+	dec	wait_flg	; Warten, bis Update vorbei

+	inc	free,x

+	bne	getbuf2

+	inc	free+1,x	; Freien Platz vergroessern

+getbuf2:

+

+	lda	full,x

+	bne	getbuf3

+	dec	full+1,x

+getbuf3:

+	dec	full,x		; Belegten Platz verringern

+	inc	wait_flg	; Update vorbei

+

+	pla

+	clc

+

+getbuf4:			; A enthaelt 00, wenn Puffer leer war

+	rts

+

+;****************************************************************

+;

+; => Drucker-Spooler

+;

+;------------------------------------------------------------------

+;

+;	Zeichen aus Druckerspooler an Drucker senden

+;

+spochc:	

+	lda	prackn

+	bmi	chcend		; Printer ready ?

+

+	ldx	#pbuf		; Printer Buffer

+	jsr	getbuf0		; Ohne SEI

+	bcs	chcend		; Nichts auszugeben, fertig

+

+	sta	prport		; Zeichen ausgeben

+	jmp	spochc		; Bis nichts mehr moeglich ist

+

+chcend:

+	rts

+

+;--------------------------------------------------------------------

+;

+;	Zeichen in Druckerpuffer schreiben

+

+bufin:	

+	ldx	#pbuf		; Zeichen geht verloren, wenn Puffer voll

+	jmp	putbuf0		; Zeichen in Puffer schreiben

+

+

+;****************************************************************

+;

+; => Ausgabe Spooler fuer serielle Schnittstelle

+;

+;-----------------------------------------------------------------

+;

+;	Zeichen aus dem Transmitbuffer senden

+;

+;spsero:	

+;	LDA	serial_stat

+;	AND	#10		; Transmit Data Register empty ?

+;	BEQ	schend		; serielles Interface nicht bereit

+

+spserok:			; Einsprung fuer Transmitinterrupt

+

+	LDA	SerFlg		; Ausgabe Stop ?

+	BMI	dis_tx		; Ja -> nichts ausgeben

+

+	ldx	#tbuf		; Transmitbuffer

+	jsr	getbuf		; Zeichen aus Puffer lesen

+	bcs	dis_tx		; Transmitter disabled, wenn Puffer leer

+

+	sta	SER_DAT		; Zeichen ausgeben

+schend:

+	rts

+

+dis_tx:

+	lda	ser_com

+	and	#$F3

+	ora	#$08		; Transmit Interrupt aus

+	sta	ser_com

+	rts

+

+;---------------------------------------------------------------------

+;

+;	Zeichen in den Transmitbuffer schreiben

+sbufin:	

+	ldx	#tbuf		; Zeichen in Transmitbuffer schreiben

+	jsr	putbuf		; Zeichen geht verloren, wenn Puffer voll

+	cli			; Wird nicht in Interruptrotinen aufgerufen

+

+	lda	ser_com

+	and	#$F3

+	cmp	#$04		; War Transmitinterrupt enabled ?

+	beq	sbufin1

+

+	ora	#$04		; Enable Transmit Interrupt

+	sta	ser_com

+sbufin1:

+	rts

+

+;****************************************************************

+;

+;	Eingabe Spooler fuer serielle Schnittstelle

+;

+;-----------------------------------------------------------------

+;

+;	Zeichen in A in den Receivebuffer schreiben

+rxser:

+	bit	A_FLG		; Ausgabeflusskontrolle

+	bpl	rxser3		; XON/XOFF interpretieren ?

+

+	cmp	#XON

+	bne	rxser4

+

+	lda	#$7F

+	and	SerFlg		; Transmitter starten

+	sta	SerFlg		; Bit 7 := 0

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04

+	sta	ser_com

+	rts

+

+rxser4:

+	cmp	#XOFF

+	bne	rxser3		; war weder XON noch XOFF

+

+	lda	#80

+	ora	SerFlg		; Transmit-IRQ schaltet sich selbst aus

+	sta	SerFlg		; Bit 7 := 1

+	rts

+

+rxser3:

+	ldx	#rbuf

+	jsr	putbuf		; Zeichen geht verloren, wenn Puffer voll

+	bcs	rx_rts

+

+	lda	free+1+rbuf

+	bne	rx_rts		; Noch genug Platz

+	lda	free+rbuf

+	cmp	#10

+	bne	rx_rts		; Mehr als 16 Zeichen frei

+				; Flusskontrolle durchfuehren

+	bit	E_FLG		; Eingabeflusskontrolle

+	bpl	rxser1

+				; XOFF senden

+	lda	#XOFF

+	jsr	DSerOut

+	

+rxser1:

+	bit	E_FLG

+	bvc	rx_rts

+				; DTR low legen

+	lda	ser_com

+	and	#$FE

+	sta	ser_com

+

+rx_rts:	rts

+

+

+

+;--------------------------------------------------------------------

+;

+;	Zeichen aus Receivepuffer lesen an 64180 senden

+;

+rxout:

+	lda	INTPAR1

+	bne	rxout_rts	; Letzer Interrupt noch nicht quittiert

+

+	bit	bus_locked

+	bmi	rxout_rts	; 64180 darf nicht auf den Bus

+

+	bit	IFLG		; "stop" - Zustand

+	bmi	rxout_rts	; Kein Inputinterrupt

+

+	ldx	#rbuf

+	jsr	getbuf		; Zeichen lesen

+	bcs	rxout_rts	; Puffer ist leer

+

+	ldx	#5		; Kanal 5: serielle Schnittstelle

+	ldy	err5_bits	; Fehlerbits (passen nicht zum Zeichen)

+	jsr	TO180		; Zeichen im Akku

+

+	ldy	#0

+	sty	err5_bits	; loeschen

+

+	lda	full+1+rbuf

+	bne	rxout_rts	; Noch zuviel im Puffer

+	lda	full+rbuf

+	cmp	#10

+	bne	rxout_rts	; Noch mehr als 16 Zeichen im Puffer

+

+	bit	E_FLG

+	bpl	rxout2

+

+	lda	#XON		; XON senden

+	jsr	DSerOut

+

+rxout2:

+	bit	E_FLG

+	bvc	rxout_rts

+				; DTR high legen

+	lda	ser_com

+	ora	#01

+	sta	ser_com

+

+rxout_rts:

+	rts

+

+

+;-------------------------------------------------------------------

+;

+;	Direkte Ausgabe auf der seriellen Schnittstelle

+;

+DSerOut:

+	pha

+

+	lda	ser_com

+	and	#$F3

+	ora	#08		; Transmitter on, Tx_IRQ off

+	sta	ser_com

+

+Wai_empty:

+	LDA	serial_stat

+	AND	#10		; Transmit Data Register empty ?

+	BEQ	Wai_empty	; warten bis Transmitter empty ->

+

+	pla

+	STA	SER_DAT

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04

+	sta	ser_com		; Transmitter on, TX_IRQ on

+

+	RTS

+

+

+;************************************************************************

+;

+; => Interrupt: Tastatur/V24

+;

+;-------------------------------------------------------------------------

+;

+;	Interrupt-Handler

+;

+IRQ:

+	sta	ASave

+	stx	XSave

+	sty	YSave

+

+	bit	keyboard	; Taste gedrueckt ?

+	bpl	irq_1

+

+	jsr	keyIRQ

+

+irq_1:

+	lda	serial_stat

+	bpl	irqret

+

+	pha

+	and	#08		; Receive Data Register full ?

+	beq	irq_2

+

+	pla

+	pha

+	jsr	receive_irq

+

+irq_2:

+	pla

+	pha

+	and	#10		; Transmit Data Register empty ?

+	beq	irq_3

+

+	jsr	spserok		; Zeichen aus Transmitbuffer senden

+

+irq_3:

+	pla

+	pha

+	and	#18

+	bne	irq_4

+				; External Status Change IRQ

+	pla

+	pha

+	jsr	status_irq

+	

+irq_4:

+	pla

+IRQret:

+	ldy	YSave

+	ldx	XSave

+	lda	ASave

+	rti			; Pull Old Status and Return

+

+;-------------------------------------------------------------------

+;

+;	Status Change - Interrupt

+;

+;	Eingang: A = serial_stat

+;

+status_irq:

+	bit	A_FLG		; Ausgabe Flusskontrolle (DSR beachten)

+	bvc	status1

+

+	and	#40		; DSR beobachten

+	beq	status2		; -DSR low, Transmitter starten

+

+	lda	#$7F		; Bit 7 := 0

+	and	SerFlg

+	sta	SerFlg

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04		; Transmitter on, Tx_IRQ on

+	sta	ser_com

+status1:

+	rts

+

+status2:			; -DSR high, Transmitter stoppen

+	lda	#80

+	ora	SerFlg		; Transmitter stoppt sich selbst

+	sta	SerFlg

+	rts

+	

+;-------------------------------------------------------------------

+;

+;	Receiver - Interrupt

+;	Eingang: Y = ser_dat

+;		 A = serial_stat

+;

+receive_irq:

+	and	#7		; Fehlerbits ausmaskieren

+	ldy	ser_dat		; Zeichen einlesen

+

+	bit	SerFlg		; Letztes Zeichen war Break

+	bvc	receive1

+

+	pha

+	lda	#2		; Break

+	ora	err5_bits

+	sta	err5_bits	; Break empfangen

+

+	lda	#$BF

+	and	SerFlg		; Break Bit 6 := 0

+	sta	SerFlg

+	pla

+

+	cpy	#2		; SV-Call

+	beq	sv_call

+	cpy	#'W'		; BREAK - W = control ('weiter') simulieren

+	beq	weiter		; WEITER

+	cpy	#'R'		; BREAK - R = RESET

+	beq	reset_sys	; RESET

+	cpy	#'S'		; BREAK - S = Shutup

+	bne	receive1	; SHUTUP

+

+	pha

+	ldx	#'S'		; Shutup-Kennzeichen

+	tay

+	jsr	TO180		; Shutup - Interrupt

+	pla

+

+receive1:

+	cmp	#2		; Framing Error ?

+	bne	receive2

+	cpy	#0		; und Zeichen 00 = Break

+	bne	receive2

+

+	lda	#$40

+	ora	SerFlg		; Break vermerken

+	sta	SerFlg

+	rts

+

+sv_call:

+	jsr	weiter

+	ldy	#0

+	ldx	#5

+	lda	#2		; CTRL-B

+	jmp	TO180

+

+weiter:

+	lda	#0

+	sta	INTPAR1		; Interrupt als quittiert ansehen

+	lda	#7F

+	and	IFLG

+	sta	IFLG

+	rts

+

+receive2:

+	tax

+	lda	errbit_tab,x	; ACIA-Fehlerbits --> EUMEL Fehlerbits

+	ora	err5_bits

+	sta	err5_bits	; Fehler vermerken

+

+	tya			; Zeichen war in Y

+	jsr	rxser		; Zeichen in Receivepuffer schreiben

+

+	jmp	rxout		; Versuchen an 64180 zu senden

+

+;-------------------------------------------------------------------------

+;

+;	Fehlerbits

+;

+errbit_tab:

+	db	0, 4, 4, 4, 1, 5, 5, 5

+	; EUMEL: Bit 0= Overrun, Bit 1= Break, Bit 2= Parity/Framing

+

+;*******************************************************************

+;

+;	Remote - Reset

+;

+reset_sys:

+	sei

+	ldx	#rescodelen-1

+resetsysa:

+	lda	rescode,x

+	sta	0,x

+	dex

+	bpl	resetsysa

+

+	ldx	SLOT180

+	lda	stop180,x

+	nop

+	lda	start180,x

+	nop

+	lda	stop180,x

+	jmp	resvec

+

+rescode:

+	db	$AF, $F3, $ED, $39, $00, $ED, $39, $00, $ED, $76

+rescodelen	equ	$-rescode

+

+	; SYSEND:

+	; XOR A

+	; DI

+	; OUT0 (CNTLA0),A

+	; OUT0 (CNTLA0),A

+	; SLP

+

+;------------------------------------------------------------------

+;

+;	Keyboard - Interrupt

+;

+keyIRQ:

+	lda	KeyBoard

+	asl	a

+

+	tax			; X = 6543 210O

+	lda	KeyExt

+	asl	a		; Carry = Bit 7

+	txa

+	ror	a

+	sta	KeyStr		; Strobe loeschen

+

+	bit	bus_locked

+	bmi	readkey0	; Nur SHUTUP/RESET erlaubt

+

+	cmp	#$C2		; F2 = SV-CALL

+	bne	readkey0a

+	jsr	readkey0b

+

+	lda	#$C2

+	ldx	#1

+	jmp	TO180

+

+readkey0a:

+	cmp	#$BC		; SHIFT CTRL F12 = HCOPY-KEY

+	bne	readkey0c

+	jmp	HCOPY

+

+readkey0c:

+	cmp	#$BD		; SHIFT CTRL F13 = WEITER-KEY

+	bne	readkey0

+readkey0b:

+	lda	#0

+	sta	INTPAR1		; Interrupt als quittiert ansehen

+	lda	#$BF		; Bit 6 loeschen

+	and	IFLG

+	sta	IFLG

+	rts

+

+readkey0:

+	cmp	#$BE		; SHIFT CTRL F14 = SHUTUP-KEY

+	bne	readkey1

+	ldx	#'S'		; Kennzeichen fuer Shutup

+	jmp	TO180		; Shutup-Interrupt

+	

+readkey1:

+	cmp	#$BF		; SHIFT CTRL F15 = RESET-KEY

+	bne	readkey2

+	jmp	reset_sys	; Keine Rueckkehr

+

+readkey2:

+	ldx	KeyIn

+	inx

+	cpx	KeyOut

+	bne	readkey3

+				; Tastaturpuffer Overflow

+	lda	err1_bits	; Kanal 1 Fehlerbits

+	ora	#1

+	sta	err1_bits	; Overrun-Error

+

+	ldx	#$0A		; Kurzer Beep: Buffer full

+	ldy	#$10

+	jmp	beep1

+

+readkey3:

+	dex

+	sta	KeyBuf,x

+	inc	KeyIn

+				; Versuchen an 64180 zu senden

+

+;----------------------------------------------------------------

+;

+;	Zeichen aus Keyboard-Buffer holen

+;

+getkey:	

+	ldx	INTPAR1		; letzter Interrupt quittiert ?

+	bne	Getret

+

+	bit	bus_locked

+	bmi	Getret

+

+	bit	IFLG		; "stop" - Zustand ?

+	bvs	Getret		; Kein Inputinterrupt

+

+	sei

+	ldx	KeyOut

+	cpx	KeyIn

+	beq	GetRet		; Puffer leer

+

+	lda	KeyBuf,x

+	inc	KeyOut

+

+	ldx	#1		; Kanal 1, Zeichen muss da sein

+	ldy	err1_bits	; Overrun Bit

+	jsr	TO180		; 64180 Interrupt

+

+	ldy	#0

+	sty	err1_bits

+

+GetRet:	

+	rts

+

+;****************************************************************

+;

+;	Texthardcopy auf Basis-Parallel

+;	(Interrupt muessen disabled sein)

+;	(Nur moeglich, wenn Druckerspooler leer, 64180 wird gestoppt)

+;

+HCOPY:

+	lda	pbuf+full

+	ora	pbuf+full+1

+	bne	getret		; Kein Hardcopy, da Spooler nicht leer ist.

+	

+	jsr	lock_bus	; 64180 vom Dienst suspendieren

+	lda	#$0D

+	jsr	bufin		; CR an Drucker

+

+	ldx	#0

+hcopy2:

+	ldy	#0		; 1. Spalte

+hcopy1:

+	txa

+	pha

+	tya

+	pha

+	jsr	bascalc		; Zeichen an der Position lesen

+	and	#$7F		; Inversbit ausblenden

+	jsr	bufin		; Zeichen an Drucker

+	pla

+	tay

+	pla

+	tax

+

+	iny

+	cpy	#$50		; 80. Spalte ?

+	bne	hcopy1

+

+	txa

+	pha

+

+	lda	#$0D		; CRLF an Drucker

+	jsr	bufin

+	lda	#$0A

+	jsr	bufin

+	jsr	spochc		; Spooler erstmal leeren

+

+	pla

+	tax

+	inx

+	cpx	#$18		; 24. Zeile ?

+	bne	hcopy2

+

+	jmp	unlock_bus	; 64180 darf wieder arbeiten

+

+;------------------------------------------------------------------------

+;

+;	Berechnet Adresse der Bildschirmposition (A,X) nach basl/bash

+;	Holt Zeichen --> A

+;	Static/Dynamic - Switch ggf. veraendert

+;

+bascalc:

+	lsr	a

+	tay			; Y DIV 2

+	sta	VIDBNK		; default even Y

+	bcc	bascalc1

+	sta	VIDBNK+1	; odd Y

+bascalc1:

+	txa

+	lsr	a

+	and	#3

+	ora	#4		; Page 0400..0BFF

+	sta	bash 		; High

+	txa

+	and	#$18

+	bcc	bascalc2

+	ora	#$80

+bascalc2:

+	sta	basl 		; Low

+	asl	a

+	asl	a

+	ora	basl 

+	sta	basl 

+	lda	(basl),y

+	rts

+

+;****************************************************************

+;

+;	Interrupts zum 64180 (Inputinterrupts)

+;	moeglich von Tastatur (Kanal 1) und seriellem Interface (Kanal 5)

+;	Shutup-Interrupt mit X = 'S'

+;	Ausgang: X veraendert

+;

+TO180:	

+	php

+	sei

+	STA	intpar2		; Zeichen

+	STY	intpar3		; Fehlerbits

+	STX	intpar1		; Kanalnr.

+	LDX	SLOT180

+	LDA	INT180,X	; 64180 Interrupt erzeugen

+	LDA	intpar2

+	plp			; Interrupt Flag

+	RTS

+

+;****************************************************************

+;

+;	Drucker Spooler loeschen

+;

+init_pbuf:

+	ldx	#initab_len

+ploop:	lda	pbuf_ini,x

+	sta	pbuf,x

+	dex

+	bpl	ploop

+	rts

+

+pbuf_ini:

+	DW	(DBUFEND - DBUFBEG) * 100H, 0

+	DW	DBUFBEG * 100H, DBUFBEG * 100H

+	DB	DBUFBEG, DBUFEND

+initab_len	EQU	*-pbuf_ini-1	; Alle gleich Lang

+

+

+;****************************************************************

+;

+;	Puffer pollen

+;

+polling:

+	jsr	spochc		; Zeichen aus Printer Spooler ?

+

+;	lda	full+tbuf

+;	ora	full+tbuf+1

+;	beq	polling2

+

+;	jsr	spsero		; Zeichen aus Transmitbuffer senden

+;	cli

+

+;polling2:

+	lda	INTPAR1		; letzter Interrupt quittiert ?

+	bne	polling1	; Puffer garnicht erst testen

+				; Polling: Interrupts an 64180

+

+	jsr	getkey		; Zeichen aus Tastatur-Buffer 

+	cli

+

+	lda	full+rbuf

+	ora	full+rbuf+1

+	beq	polling1

+

+	jsr	rxout		; Zeichen aus Receive-Buffer 

+	cli

+

+polling1:

+	rts

+

+

+;****************************************************************

+; 

+;	Hauptschleife des 6502: wartet auf Tasks

+;

+;	Task	1 : Disk R/W

+;		2 : Bell

+;		3 : Char zum Drucker(spooler)

+;		4 : Char zum seriell Spooler

+;		5 : Direktausgabe auf serieller Schnittstelle

+;		6 : Analog I/O

+;		7 : Grafik

+;

+task_end:

+;		8 : Druckerspooler loeschen

+

+	lda	#0

+	sta	task

+	sta	bus_locked	; Nicht mehr gesperrt

+

+

+task_loop:

+	cli

+	jsr	polling		; Puffer pollen

+

+	lda	task

+	beq	task_loop

+

+	cmp	#1

+	bne	task_lp1

+

+	jsr	DISKRW		; Disk I/O

+	jmp	task_end

+

+task_lp1:

+	cmp	#2

+	bne	task_lp2

+

+	jsr	Beep

+	jmp	task_end

+

+task_lp2:

+	cmp	#3

+	bne	task_lp3

+

+	lda	param

+	jsr	bufin		; in Spooler-Buffer

+	jmp	task_end

+

+task_lp3:

+	cmp	#4

+	bne	task_lp4

+

+	lda	param

+	jsr	sbufin		; Output to serial Interface

+	jmp	task_end

+

+task_lp4:

+	cmp	#5

+	bne	task_lp5

+

+	lda	param

+	jsr	DSerOut		; direkte Ausgabe auf ser. Schnittstelle

+	jmp	task_end

+

+task_lp5:

+	cmp	#6

+	bne	task_lp6

+

+	jsr	ANAL65		; Analog I/O

+	jmp	task_end

+

+task_lp6:

+	cmp	#7

+	bne	task_lp7

+

+	JSR	GRAFIK		; Grafik I/O

+	jmp	task_end

+

+task_lp7:

+	cmp	#8

+	bne	task_end

+

+	jsr	init_pbuf	; Drucker Spooler loeschen

+	jmp	task_end

+

+

+	defm	'Ende vom SHard'

+LEN65	EQU	$-start

+	IF $ GE 2000

+	   .printx '6502-Modul in Grafikseite 1!'

+	ENDIF

+	end

diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC
new file mode 100644
index 0000000..ecb4419
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC
@@ -0,0 +1,301 @@
+		TITLE	64180-Teil fuer EUMEL-SHard Apple-Disk Unterstuetzung

+

+;		24.05.86, M. Staubermann

+;		Ueberarbeitet: 04.01.87

+

+		INCLUDE	HD64180.LIB

+		.LIST

+		CSEG

+;

+;----------------------------------------------------------------

+;

+;		Globale Adressen

+;

+		GLOBAL	ANALOG, DISKBK, INIDISK

+;

+;----------------------------------------------------------------

+;

+;		Externe Adressen

+;

+		EXTERNAL TO6502, WTEND, TO65WA, ZGERL, RD6502

+		EXTERNAL HGOP, WARTE, MEMDMA

+

+;---------------------------------------------------------------------------

+;

+;	K O N S T A N T E

+;

+;---------------------------------------------------------------------------

+

+SEKTOR		EQU	0F00CH

+LASTTRACK	EQU	0F00DH

+ANALOGWERT	EQU	0F00FH

+TASK		EQU	0F080H

+PARAM		EQU	0F081H

+DEFBYTE		EQU	0F082H

+DISKNO		EQU	0F083H

+TRACK		EQU	0F084H

+DISKERR		EQU	0F086H

+

+BUFPAGE		EQU	0E0H		; Erste Page des Trackpuffers

+

+SEMA:		DEFB	0		; Semaphor fuer Apple-Disk

+LASTDISK:	DEFB	0FFH

+DEFBYTE0:	DEFB	0E0H		; Drive 0

+DEFBYTE1:	DEFB	0E0H		; Drive 1

+

+;---------------------------------------------------------------------------

+;

+;	A N A L O G

+;	Eingang:	E = Nummer des Analogschalters (1..4)

+;	Ausgang:	BC = Analogwert (0..255)

+;

+;---------------------------------------------------------------------------

+

+ANALOG:

+		LD	A,E		; An jedem Kanal moeglich

+		AND	A

+		JR	Z,ILLEGAL	; Nur Analogschalter 1..4

+

+		CP	5

+		JR	NC,ILLEGAL

+

+		LD	H,E		; Parameter ist Analogschalternr.

+		LD	L,6		; Analogport abfragen

+		CALL	TO6502		; Auf Taskende warten

+

+		CALL	WTEND		; Auf Ergebnis warten

+

+		LD	HL,LOW ANALOGWERT

+		CALL	RD6502

+		LD	C,A

+

+		LD	B,0		; Ergebnis in BC

+		POP	HL

+		RET

+

+ILLEGAL:

+		LD	BC,-1

+		POP	HL

+		RET

+

+;---------------------------------------------------------------------------

+;

+;	C H K A C C

+;	Semaphorhandler fuer Apple-Disks

+;

+;	Akku veraendert, warte wird aufgerufen

+;

+CHKACC:

+	LD	A,(SEMA)	; Disk-Zugriffssemaphor

+	AND	A		; 0=frei

+	JR	Z,ISFREE	; Ja ->

+	CALL	WARTE

+	JR	CHKACC

+

+ISFREE:

+	DEC	A

+	LD	(SEMA),A	;Semaphor sperren

+	RET

+

+;---------------------------------------------------------------------------

+;

+;	I N I D I S K

+;	Eingang:	A = Kanalnummer (29, 30)

+;			DE = Schluessel von control 'size'

+;	Ausgang:	BC = Anzahl 512-Byte Bloecke, die auf die Disk passen

+;

+;--------------------------------------------------------------------------

+

+INIDISK:

+		PUSH	HL

+		PUSH	AF

+

+		CALL	CHKACC

+

+		LD	A,0FFH		; Nach der naechsten Operation

+		LD	(LASTDISK),A	; Track neu laden

+

+		LD	C,081H

+		LD	A,D

+		AND	A

+		JR	Z,INIDISK3	; DE = 0, 1, 2

+					; Format ueber Schluessel

+		AND	10000010B	; Bit 7 und Bit 1 ausblenden

+		JR	Z,INIDISK4	; 0: Erphi, 160k

+

+		LD	C,0E0H

+		CP	10B		; 2: Erphi, 640k

+		JR	Z,INIDISK4

+

+		LD	C,0A1H

+		CP	10000000B	; 128: Ehring, 160k

+		JR	Z,INIDISK4

+

+		DEC	C		; 130: Ehring 640k

+		JR	INIDISK4

+

+INIDISK3:

+		LD	A,E		; Kein analytischer Schluessel

+		CP	1

+		JR	Z,INIDISK4	; 1: 40 Tracks

+

+		LD	C,0E0H		; 2 * 80 Tracks		

+INIDISK4:

+		POP	AF

+

+		LD	HL,DEFBYTE0

+		CP	30

+		JR	Z,INIDISK5

+		INC	HL

+INIDISK5:	LD	(HL),C		; Defbyte eintragen

+		LD	HL,SEMA

+		LD	(HL),0		; Semaphor freigeben

+		

+		POP	HL

+

+		BIT	0,C		; 160k oder 640k ?

+		LD	BC,640*2

+		RET	Z

+		LD	BC,160*2

+		RET

+

+;---------------------------------------------------------------------------

+;

+;	D I S K B K

+;	Blockio auf Apple-Drives

+;

+;	Eingang:	A = Kanal (29, 30)

+;			DE = Blocknummer

+;			HL = Hauptspeicheraddresse des Blocks

+;			(HGOP) : 1 = BLOCKOUT, 0 = BLOCKIN

+;	Ausgang:	BC = Fehlercode (0, 1, 2)

+;

+;--------------------------------------------------------------------------

+

+DISKBK:

+		PUSH	DE

+		PUSH	AF		; Kanal merken

+

+		CALL	CHKACC		; Auf freie Diskroutinen warten

+

+		XOR	A		; A := 0

+		LD	B,3

+DIVLOOP:	SRL	D		; DE DIV 8 (Blocks/Track)

+		RR	E

+		RRA

+		DJNZ	DIVLOOP		; E = Tracknummer

+					; D = 0

+		RRA

+		RRA

+		RRA

+		RRA			; A = Sektornummer

+		LD	D,E

+		LD	E,A		; DE = Track/Sektor

+

+		LD	A,(HGOP)	; BLOCKIN oder BLOCKOUT ?

+		DEC	A

+		CALL	Z,TRANSPORT	; BLOCKOUT: 180-RAM --> 6502-RAM

+

+		DI

+		IN0	B,(CBR)

+		LD	C,51H		; Zeropage 6502 einblenden

+		OUT0	(CBR),C

+

+		CALL	ZGERL

+

+		POP	AF		; Kanal zurueck

+		AND	1		; Diskno in A

+		LD	C,A

+		LD	A,(LASTDISK)

+		CP	C

+		JR	Z,DISKBK2

+		LD	A,0FFH

+		LD	(LASTTRACK),A	; Track muss neu geladen werden

+DISKBK2:

+		PUSH	HL

+

+		LD	HL,TRACK

+		LD	(HL),D		; Track

+

+		LD	A,C

+		LD	(LASTDISK),A

+		DEC	HL

+		LD	(HL),C

+

+		LD	A,(DEFBYTE0)

+		DEC	C

+		INC	C

+		JR	Z,DISKBK3

+		LD	A,(DEFBYTE1)

+DISKBK3:

+		DEC	HL

+		LD	(HL),A		; Defbyte

+

+		LD	A,(HGOP)

+		DEC	A		; Read/Write Param

+		DEC	HL

+		LD	(HL),A

+

+		LD	A,E		; Sektor

+		LD	(SEKTOR),A

+

+		DEC	HL

+		LD	(HL),1		; Task: Disk R/W starten

+

+		OUT0	(CBR),B

+		EI

+

+		CALL	TO65WA		; Auf Beendigung der Task warten

+					; EUMEL-'warte' wird aufgerufen!

+		LD	HL,LOW DISKERR

+		CALL	RD6502

+		POP	HL

+

+		PUSH	AF

+		LD	A,(HGOP)

+		DEC	A

+		CALL	NZ,TRANSPORT

+		POP	AF

+		LD	BC,2

+		DEC	A

+		JR	Z,DISKBK1	; 2 = Diskettenfehler

+		DEC	BC

+		DEC	A

+		JR	Z,DISKBK1	; 1 = Writeprotected

+		DEC	BC		; 0 = ok

+DISKBK1:

+		XOR	A

+		LD	(SEMA),A

+		POP	DE

+		RET

+

+

+;............................................................................

+;

+;	Falls HGOP = 0:

+;		2 Sektoren (E, E+1) aus Basisspeicher --> 64180 (HL)

+;	Falls HGOP = 1:

+;		2 Sektoren aus 64180-RAM (HL) --> Basisspeicher (E, E+1)

+;

+;	Eingang: E = Sektornummer (muss gerade sein)

+;		 HL = Hauptspeicheradresse

+;	Ausgang: A, BC, HL veraendert

+ 

+TRANSPORT:	PUSH	HL

+		PUSH	DE

+		LD	A,E		; Sektor

+		EX	DE,HL		; HL (log. Adr.) --> DE

+

+		AND	0FH		; 0..15

+		OR	BUFPAGE		; Highbyte des Trackbuffers 6502

+		LD	H,A		; phys. Adr. berechnen

+		LD	L,0

+		LD	BC,512		; 512 Bytes uebertragen

+		LD	A,(HGOP)	; Transferrichtung

+

+		CALL	MEMDMA		; DMA-Transfer

+		POP	DE

+		POP	HL

+		RET

+

+		END

diff --git a/system/shard-z80-ruc-64180/1.5/src/DUMP.COM b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM
new file mode 100644
index 0000000..d425dbf
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM
new file mode 100644
index 0000000..134ccc5
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC
new file mode 100644
index 0000000..bb365b4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC
@@ -0,0 +1,338 @@
+	TITLE	EBOOT - Eumel Bootstrap Schreibprogramm

+;

+;****************************************************************

+;

+;	E B O O T

+;

+;	Version 1.3 - 29.12.1986

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;

+;****************************************************************

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+BDOS	EQU	5

+EUMEL	EQU	6		;Volume Directory Typ

+BOTLNG	EQU	3FH		; Nicht 40H

+BOTPA1	EQU	10H

+BOTPA2	EQU	10H

+DEFFCB	EQU	5CH

+;

+	EXTERNAL INITS, HDIO, FDIO, SCSIIO

+	GLOBAL	EBOOT

+;

+	CSEG

+;

+;****************************************************************

+;

+;	Meldungen

+;

+STARTUP:

+	DEFB	0DH, 0AH

+	DEFM	'**** E U M E L  Harddisk Bootstrap Installationsprogramm ****'

+	DEFB	0DH, 0AH

+	DEFM	'   Version 1.3 - 29.12.1986 - (C) by R. Ellerbrake (RUC)$'

+;

+NOBOOT:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Datei EUMEL.COM nicht gefunden, leer oder fehlerhaft!$'

+; 

+ERRSTR:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Harddisk E/A Fehler: '

+ERRNR:	DEFM	'00$'

+;

+ENDMSG:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Kein (weiteres) EUMEL Volume vorhanden!$'

+;

+QSTR:

+	DEFB	0DH, 0AH

+	DEFM	'EUMEL Bootstrap Lader auf Harddisk Volume '

+QSTRN:

+	DEFM	'                $'

+;

+LSTR:

+	DEFB	' installieren (J/N): $'

+;

+ILLSTR:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Unzulaessige Eingabe !!!$'

+;

+RDYSTR:

+	DEFB	0DH, 0AH

+	DEFM	'EUMEL Bootstraplader erfolgreich installiert.$'

+;

+;****************************************************************

+;

+EBOOT::

+	LD	SP,STACK

+;

+	LD	DE,STARTUP

+	LD	C,9

+	CALL	BDOS

+;

+	LD	A,(DEFFCB)

+	LD	DE,EUMELFI

+	LD	(DE),A		;ggf. Drive aus Kommandozeile verwenden

+	LD	C,15		;Open File

+	CALL	BDOS

+	INC	A		;Fehler ?

+	JR	NZ,FIOK		;Nein ->

+;

+ILLFI:

+	LD	DE,NOBOOT	;Bootstrap Lader Datei nicht gefunden

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+FIOK:

+	LD	A,(EUMELFI+16)	;1. BLock vorhanden ?

+	AND	A

+	JR	Z,ILLFI		;Nein -> Fehler

+;

+	CALL	INITS

+	CALL	INITS

+;

+;	Warten bis Harddisk hochgelaufen ist

+;

+WRTHRD:

+	LD	DE,TESTRD

+	LD	BC,0

+	CALL	SCSIIO

+	CP	4		;Drive not Ready ?

+	JR	Z,WRTHRD	;Ja -> warten

+;

+	LD	HL,DATAR

+	LD	BC,PARBLK

+	LD	A,0		;Superdirectory lesen

+	LD	DE,0

+	CALL	HDIO

+	AND	A

+	JR	Z,SDOK

+;

+HDIOER:

+	LD	DE,ERRNR	; Fehlernummer in A

+	CALL	HEX1

+	LD	DE,ERRSTR

+	LD	C,9

+	CALL	BDOS

+	JP	0

+

+HEX1:

+	PUSH	AF

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	CALL	HEX2

+	POP	AF

+HEX2:

+	AND	0FH

+	CP	0AH

+	JR	C,HEX3

+	ADD	7

+HEX3:

+	ADD	30H

+	LD	(DE),A

+	INC	DE

+	RET

+;

+;	64180 Bootvolume mit EUMEL Kennung suchen

+;

+SDOK:

+	LD	HL,DATAR

+	LD	E,(HL)		;Byte 0 = Anfangsoffset

+	LD	D,0		;DE = Volume Eintrag Laenge

+	ADD	HL,DE

+	LD	A,(DATAR+20H)	;Volume Anzahl

+	LD	B,A

+;

+SRCLOP:

+	PUSH	HL

+	POP	IX

+	LD	A,(IX+23H)	;Directory Typ

+	CP	EUMEL		;EUMEL Diretory ?

+	JR	Z,ISEDIR	;Ja ->

+;

+NXVOL:

+	ADD	HL,DE

+	DJNZ	SRCLOP

+;

+;	Alle Volumes durchsucht

+;

+	LD	DE,ENDMSG

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+;	EUMEL Volume gefunden

+;

+ISEDIR:

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+	PUSH	IX

+	LD	B,0

+	LD	C,(IX+10H)	;Laenge des Volumenamens

+	LD	DE,11H

+	ADD	HL,DE		;auf Volumename

+	LD	DE,QSTRN

+	LDIR

+	LD	A,'$'

+	LD	(DE),A		;Stringende eintragen

+;

+	LD	DE,QSTR

+	LD	C,9

+	CALL	BDOS		;anfragen

+	LD	DE,LSTR

+	LD	C,9

+	CALL	BDOS

+;

+	LD	C,1		;1 Zeichen einlesen

+	CALL	BDOS

+	AND	05FH

+;

+	CP	'Y'		;Ja ->

+	JR	Z,PUTBOT

+;

+	CP	'J'		;Ja ->

+	JR	Z,PUTBOT

+;

+	CP	'N'		;Nein ->

+	JR	Z,NOBOT

+;

+;	Falsche Eingabe: nochmal anfragen

+;

+	LD	DE,ILLSTR

+	LD	C,9

+	CALL	BDOS

+;

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+	JR	ISEDIR

+;

+NOBOT:

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+	JR	NXVOL

+;

+;	Bootstrap installieren

+;

+

+PUTBOT:

+	XOR	A

+	LD	HL,BOTBUF

+	LD	(HL),A

+	LD	DE,BOTBUF+1

+	LD	B,BOTLNG

+	LD	C,0

+	LDIR			; Bereich loeschen

+

+	LD	HL,BOTBUF	;EUMEL Bootstrap Datei einlesen

+	LD	B,BOTLNG*2	;max. Recordanzahl

+	LD	DE,EUMELFI

+;

+RDLOP:

+	PUSH	BC

+	PUSH	DE

+	LD	C,26

+	EX	DE,HL

+	PUSH	DE

+	CALL	BDOS		;DMA-Adresse setzen

+	POP	HL

+	LD	DE,128		;und hochzaehlen

+	ADD	HL,DE

+	POP	DE

+	PUSH	HL

+	PUSH	DE

+	LD	C,20		;Read sequential

+	CALL	BDOS		;Record lesen

+	POP	DE

+	POP	HL

+	POP	BC

+	CP	1

+	JR	Z,READY

+	DJNZ	RDLOP		;Nicht fertig ->

+;

+;	Bootstrap Lader im Speicher

+;

+READY:

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+

+	LD	(HL),40H	;EUMEL Bootkennung eintragen

+	LD	(IX+20H),BOTPA1	;EUMEL Bootparameter eintragen

+	LD	(IX+21H),BOTPA2

+	LD	(IX+22H),BOTLNG

+	INC	HL

+	PUSH	HL		;Bootvolume

+;

+	LD	HL,DATAR

+	LD	BC,PARBLK

+	LD	A,1		;Superdirectory schreiben

+	LD	DE,0

+	CALL	HDIO

+;

+;	Bootstrap Lader schreiben

+;

+	LD	HL,BOTBUF	;Datenbereich

+	LD	DE,0		;Blocknummer

+;

+WRLOP:

+	POP	BC

+	PUSH	BC

+	PUSH	DE

+	PUSH	HL

+	LD	A,1

+	CALL	HDIO

+;

+	JP	NZ,HDIOER

+;

+	POP	HL

+	LD	DE,512		;Adresse hochzaehlen

+	ADD	HL,DE

+	POP	DE

+	INC	DE

+	LD	A,E

+	CP	BOTLNG/2	;fertig ?

+	JR	NZ,WRLOP	;Nein ->

+;

+	POP	BC

+	LD	DE,RDYSTR

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+;****************************************************************

+;

+EUMELFI:

+	DEFB	0		;auf Default Drive

+	DEFM	'EUMEL   COM'

+	DEFB	0,0,0,0,0

+	DEFB	0,0,0,0,0,0,0,0

+	DEFB	0,0,0,0,0,0,0,0,0

+;

+PARBLK:

+	DEFB	0,0,2,0

+;

+TESTRD:

+	DEFB	0,0,0,0,0,0	;Test Ready

+;

+	DEFS	200

+STACK:	DEFW	0

+;

+DATAR:	DEFS	512

+;

+BOTBUF:

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB
new file mode 100644
index 0000000..b9736c7
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB
@@ -0,0 +1,2 @@
+SLR EBOOT

+L80 /P:0100, START, SCSI, EBOOT, EBOOT/N/E

diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.COM b/system/shard-z80-ruc-64180/1.5/src/EINST.COM
new file mode 100644
index 0000000..1fdd334
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EINST.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.PAS b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS
new file mode 100644
index 0000000..312069f
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS
@@ -0,0 +1,509 @@
+PROGRAM installieren_des_eumel_shards ;

+{$U-}

+

+CONST vers        = '2.1 vom 22.01.87' ;

+      shard_file  = 'EUMEL.COM' ;

+      floppy_boot_file = 'FBOOT.COM' ;

+      conf_offset = $37 ;  { Anfang ohne LOAD-Modul (phys.-Adr $00000) }

+

+{ 2.1: 22.01.87 mit Pascal SCSI-Routinen & Konfiguration }

+

+{$I SCSI.PAS}

+

+TYPE SECTOR   = ARRAY[0..255] OF BYTE ;

+

+     FLAGTYPE = SET OF (x0, x1, x2, x3, autoboot, curvol, b64180, b6502) ;

+

+     IDTYPE   = (free, ucsd, dos, cpm, prodos, id5, eumel, id7,

+                 id8, id9, id10, id11, id12, id13, id14, spare) ;

+

+     STRING15 = STRING[15] ;

+

+     LUN      = RECORD

+                 drive, high, low : BYTE

+                END ;

+

+     DISKENTRYTYPE = RECORD

+               entrylength : BYTE ;

+               first_block : LUN ;

+               reserved    : BYTE ;

+               last_block  : LUN ;  { exclusiv }

+               params      : ARRAY [0..7] OF BYTE ;

+               name        : STRING15 ;

+               volumes     : BYTE ; { Anzahl Volumes }

+               autoboot    : CHAR ; { Volumekennzeichen fuer Autoboot }

+               waittime    : INTEGER ; { Wartezeit vor Autoboot in 1.46ms }

+              END ;

+

+     VOLUMEENTRYTYPE = RECORD

+               flags : FLAGTYPE ;

+               first : LUN ;

+               kz    : CHAR ; { Kennzeichen in der VOLTAB }

+               last  : LUN ; { Letzer Block exclusiv }

+               params: ARRAY[0..7] OF BYTE ;

+               name  : STRING15 ;

+               loadpage : BYTE ; { Highbyte Ladeadresse im 6502-Memory }

+               jumppage : BYTE ; { Highbyte Startadresse im 6502-Memory }

+               pages : BYTE ; { Anzahl zu ladender Seiten }

+               volid : IDTYPE ;

+              END ;

+

+VAR f          : FILE ;

+    floppy_version : BOOLEAN ;

+    shard_size, volume : INTEGER ;

+    volume_name, scsi_floppy : STRING15 ;

+    buffer     : ARRAY[0..$3F] OF SECTOR ;

+    boot_buffer: ARRAY[0..15] OF SECTOR ;

+    conf       : RECORD

+                  offset  : ARRAY[1..conf_offset] OF BYTE ;

+                  umsch   : ARRAY[1..8] OF BYTE ;

+                  blinkp  : BYTE ;    { Cursor Blinkfrequenz in 50ms }

+                  beepfreq: BYTE ;    { Kanal 1: Beepfrequenz }

+                  arc31   : LUN ;     { SCSI-Floppy LUN }

+                  mode    : INTEGER ; { EUMEL-MODE-Word }

+                  id4     : INTEGER ; { Lizenznummer des SHards }

+                  id5     : INTEGER ; { Installationsnummer des SHards }

+                  id6     : INTEGER ; { Reserviert fuer SHard }

+                  urlk1   : BYTE ;    { Primaerer Urladerkanal }

+                  urlk2   : BYTE ;    { Sekundaerer Urladerkanal }

+                  free    : BYTE ;

+                  irqvecs : ARRAY[1..$40] OF BYTE ; { Interruptvektoren }

+                  ikantab : ARRAY[0..7] OF BYTE ;   { phys. --> log. Kanalnr. }

+                  kantab  : ARRAY[0..32] OF BYTE ;  { log. --> phys. Kanalnr. }

+                  ioftb   : ARRAY[0..31] OF BYTE ;  { 'typ'-Bits der Kanaele }

+                  cpmofs  : LUN ; { LUN & Anfangs-Adr. eines CP/M-Volumes }

+                  cpmlast : LUN ; { LUN & Endadr. (excl.) eines CP/M-Volumes }

+                 END ABSOLUTE buffer ;

+

+    superdirectory :

+                 RECORD

+                  diskentry   : DISKENTRYTYPE ;

+                  volumeentry : ARRAY[1..26] OF VOLUMEENTRYTYPE ;

+                 END ;

+

+

+

+PROCEDURE errorstop (message : STRING77) ;

+ BEGIN

+  writeln ;

+  writeln (#7, 'FEHLER: ', message) ;

+  halt

+ END { errorstop } ;

+

+

+FUNCTION yes (question : STRING77) : BOOLEAN ;

+ VAR zeichen : CHAR ;

+ CONST answer : SET OF CHAR = ['y', 'Y', 'n', 'N', 'j', 'J'] ;

+ BEGIN

+  WHILE keypressed DO read (KBD, zeichen) ; { empty buffer }

+  write (question, ' (j/n) ? ') ;

+  REPEAT

+   read (KBD, zeichen) ;

+   IF zeichen = #27 THEN errorstop ('Abbruch mit ESC') ;

+   IF NOT (zeichen IN answer)

+      THEN write (#7)

+      ELSE writeln (zeichen)

+  UNTIL zeichen IN answer ;

+  yes := zeichen IN ['y', 'Y', 'j', 'J']

+ END { yes } ;

+

+

+FUNCTION txt (nr : INTEGER) : STRING15 ;

+ VAR result : STRING15 ;

+ BEGIN

+  str (nr, result) ;

+  txt := result

+ END { txt } ;

+

+

+PROCEDURE shard_lesen ;

+ BEGIN

+  fillchar (buffer, sizeof (buffer), 0) ;

+  assign (f, shard_file) ;

+  reset (f) ;

+  shard_size := filesize (f) ;

+  blockread (f, buffer, shard_size) ;

+  close (f) ;

+  IF (shard_size < 3) OR (shard_size > 2 * $3F)

+     THEN errorstop ('Die Datei ' + shard_file + ' ist inkonsistent!')

+ END { shard_lesen } ;

+

+

+PROCEDURE shard_schreiben ;

+ VAR eumel_track : INTEGER ;

+ BEGIN

+  WITH superdirectory.volumeentry[volume].first DO BEGIN

+   eumel_track := low DIV 32 + high * 8 + (drive AND $3F) * 2048

+  END ;

+  hd_write (buffer, eumel_track * 32, 32) ;

+  hd_write (buffer[32], succ (eumel_track) * 32, 32)

+ END { shard_schreiben } ;

+

+

+PROCEDURE eumel_volume_suchen ;

+ VAR name : STRING[255] ;

+ BEGIN

+  volume := 1 ;

+  WITH superdirectory DO BEGIN

+

+    WHILE volume <= diskentry.volumes DO BEGIN

+      IF volumeentry[volume].volid = eumel

+         THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name +

+                      '" installieren')

+                 THEN exit ;

+      volume := succ (volume) ;

+    END { WHILE } ;

+    writeln ('Kein (weiteres) EUMEL-Volume gefunden.') ;

+

+    IF yes ('Soll ein anderes Volume zu einem EUMEL-Volume werden')

+       THEN BEGIN

+         volume := 1 ;

+         WHILE volume <= diskentry.volumes DO BEGIN

+           IF volumeentry[volume].volid <> spare

+              THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name +

+                           '" installieren')

+                      THEN BEGIN

+                        IF yes ('Volumename aendern')

+                           THEN BEGIN

+                             write ('Neuer Volumename: ') ;

+                             REPEAT

+                               readln (name) ;

+                               IF length (name) > 15

+                                  THEN writeln ('Zu lang!')

+                             UNTIL (name <> '') AND (length (name) < 16) ;

+                             volumeentry[volume].name := name ;

+                        END ;

+                        exit ;

+                   END ;

+           volume := succ (volume)

+         END { WHILE } ;

+         writeln ('Kein (weiteres) Volume gefunden.') ;

+    END { IF } ;

+    writeln ('Installation abgebrochen.') ;

+    halt

+

+  END { WITH }

+ END { eumel_volume_suchen } ;

+

+

+PROCEDURE superdirectory_lesen ;

+ BEGIN

+  hd_read (superdirectory, 2, 4) ;

+ END { superdirectory_lesen } ;

+

+

+PROCEDURE superdirectory_schreiben ;

+ BEGIN

+  WITH superdirectory.volumeentry[volume] DO BEGIN

+   flags := [b64180] ; (* Boot in 64180-Code geschrieben *)

+   loadpage := $10 ;

+   jumppage := loadpage ;

+   pages    := $3F ; (* Da $40 nicht geht (Timeout auf Cylindergrenze) *)

+   volid    := eumel ;

+  END ;

+

+  hd_write (superdirectory, 2, 4)

+ END { superdirectory_schreiben } ;

+

+

+FUNCTION sector_write (trk, sec, adr : INTEGER) : BOOLEAN ;

+BEGIN

+  bios (9, trk) ;

+  bios (10, sec) ;

+  bios (11, adr) ;

+  sector_write := (bios (13, 0) = 0) ;

+END ;

+

+

+PROCEDURE shard_auf_floppy_schreiben ;

+ VAR trk, sec, curdrv, drive : INTEGER ;

+     zeichen : CHAR ;

+ BEGIN

+  fillchar (boot_buffer, sizeof (boot_buffer), 0) ;

+  assign (f, floppy_boot_file) ;

+  reset (f) ;

+  blockread (f, boot_buffer, filesize (f)) ; { max. 4k Boot }

+  close (f) ;

+

+  boot_buffer[0][$FF] := 0 ;

+  WHILE boot_buffer[0][$FF] = 0 DO BEGIN

+        IF yes ('2 * 80 Track (Erphi) Format') THEN boot_buffer[0][$FF] := $E0

+   ELSE IF yes ('1 * 35 Track (Apple) Format') THEN boot_buffer[0][$FF] := $81

+   ELSE IF yes ('2 * 80 Track (Ehring) Format')THEN boot_buffer[0][$FF] := $A0 ;

+  END ;

+

+  curdrv := bdos (25, 0) ; { current_drive }

+  drive := curdrv ;

+

+  write ('Floppy-Drive (Abbruch mit ESC): ', chr (drive + 65), #8) ;

+  REPEAT

+   read (KBD, zeichen) ;

+   IF zeichen = #27

+      THEN errorstop ('Abbruch mit ESC') ;

+   zeichen := upcase (zeichen) ;

+   IF NOT (zeichen IN ['A'..'P'])

+      THEN write (#7)

+      ELSE writeln (zeichen)

+  UNTIL zeichen IN ['A'..'P'] ;

+  drive := ord (zeichen) - 65 ;

+

+  IF drive = curdrv

+     THEN REPEAT UNTIL yes ('(Leere) Destinationdiskette eingelegt') ;

+

+  writeln ;

+  bios (8, drive) ; { Select Floppy Drive }

+

+  FOR sec := 0 TO 15 DO  { Floppy-Boot/Taskloop schreiben }

+   IF NOT sector_write (0, sec, addr (boot_buffer [sec]))

+      THEN BEGIN

+            bios (8, curdrv) ;

+            errorstop ('Schreibfehler auf Drive ' + zeichen +

+                       ':, Track 0, Sektor ' + txt (sec))

+           END ;

+  FOR trk := 1 TO 4 DO  { SHard schreiben }

+   FOR sec := 0 TO 15 DO

+    IF NOT sector_write (trk, sec, addr (buffer [sec + pred(trk) * 16]))

+       THEN BEGIN

+             bios (8, curdrv) ;

+             errorstop ('Schreibfehler auf Drive ' + zeichen + ':, Track ' +

+                        txt (trk) + ', Sektor ' + txt (sec))

+            END ;

+

+  bios (8, curdrv) ; { Select previous Drive }

+

+ END ;

+

+

+PROCEDURE cpm_volume_suchen ;

+ BEGIN

+  WITH superdirectory DO BEGIN

+   REPEAT

+    volume := 1 ;

+    WHILE volume < diskentry.volumes DO BEGIN

+     IF volumeentry[volume].volid = cpm

+        THEN IF yes (volumeentry[volume].name)

+                THEN exit ;

+     volume := succ (volume) ;

+    END

+   UNTIL yes ('Kein (weiteres) Volume gefunden, erstes Volume nehmen') ;

+   volume := 1 ;

+   writeln ('Volume "', volumeentry[volume].name, '" wird angenommen.') ;

+  END

+END { cpm_volume_suchen } ;

+

+

+PROCEDURE kanalzuordnungen ;

+ VAR i, j, channel : INTEGER ;

+     ok : BOOLEAN ;

+

+FUNCTION kanal_erfragen (log : INTEGER) : INTEGER ;

+ VAR channel : INTEGER ;

+ BEGIN

+  REPEAT

+   channel := 255 ;

+   write (' ':77, #13) ;

+   write ('Logischer Kanal ', log:2, ' ---> physischer Kanal: -'#8) ;

+   buflen := 2 ;

+   read (channel) ;

+   write (#13) ;

+  UNTIL ((channel >= 0) AND (channel < 7)) OR

+        ((channel >= 28) AND (channel < 32)) OR

+        (channel = 255) ;

+  kanal_erfragen := channel

+ END ;

+

+PROCEDURE message (msg : STRING77) ;

+ VAR zeichen : CHAR ;

+ BEGIN

+  write (#13, ' ', msg, ' - Taste -'#13) ;

+  read (KBD, zeichen)

+ END { message } ;

+

+ BEGIN { kanalzuordnungen }

+  REPEAT

+  clrscr ;

+  writeln ('--- Zuordnung der logischen/physischen Kanaele ---') ;

+  writeln ;

+  writeln ('Den logischen Kanaelen werden physische Kanaele zugeordnet,') ;

+  writeln ('dabei sind folgende Einschraenkungen zu beachten:') ;

+  writeln ('- Kanal 0 und 31 muessen als Blockkanal definiert werden.') ;

+  writeln ('- Kanal 1 muss als Streamkanal definiert werden (Systemstart).') ;

+  writeln ('- Kein physischer Kanal darf mehrfach zugeordnet werden.') ;

+  writeln ;

+  writeln ('Folgende physische Kanaele stehen zur Verfuegung:') ;

+  writeln ;

+  writeln ('Streamkanaele:                     Blockkanaele:') ;

+  writeln ('--------------                     -------------') ;

+  writeln ('1 ... Basis  - Konsole              0 ... SCSI  - Harddisk #0') ;

+  writeln ('2 ... ruc180 - Serielle B         ( 1 ... Basis - Graphikkonsole)') ;

+  writeln ('3 ... ruc180 - Serielle A          28 ... SCSI  - Volume "', volume_name, '"') ;

+  writeln ('4 ... ruc180 - Centronics          29 ... Basis - Diskdrive 1') ;

+  writeln ('5 ... Basis  - Serielle            30 ... Basis - Diskdrive 0') ;

+  writeln ('6 ... Basis  - Centronics          31 ... SCSI  - ', scsi_floppy) ;

+  writeln ;

+  conf.kantab[32] := 32 ; { Parameterkanal }

+  writeln ;

+   FOR i:= 0 TO 31 DO BEGIN

+    REPEAT

+     REPEAT

+      channel := kanal_erfragen (i) ;

+      ok := FALSE ;

+      IF channel = 255

+         THEN IF (i = 0) OR (i = 1) OR (i = 31)

+                 THEN message ('Kanal 0, 1 und 31 muessen definiert werden!')

+                 ELSE ok := TRUE

+         ELSE IF ((i = 0) OR (i = 31)) AND

+                 ((conf.ioftb[channel] AND 12) <> 12)

+                 THEN message ('Kanal ' + txt (i) + ' muss ein Blockkanal (0, 28..31) sein!')

+                 ELSE IF (i = 1) AND ((conf.ioftb[channel] AND 3) <> 3)

+                         THEN message ('Kanal 1 muss ein Stream I/O-Kanal sein!')

+                         ELSE ok := TRUE

+     UNTIL ok ;

+     IF channel <> 255

+        THEN BEGIN

+         j := 0 ;

+         WHILE (j < i) AND (conf.kantab[j] <> channel) DO j := succ (j) ;

+         IF j < i

+            THEN message ('Der phys. Kanal ' + txt(channel) +

+                          ' wurde schon dem log. Kanal ' + txt (j) +

+                          ' zugeordnet!') ;

+     END ;

+    UNTIL (j = i) OR (channel = 255) ;

+    conf.kantab[i] := channel ;         { Zuordnung log. --> phys. }

+    IF channel < 7

+       THEN conf.ikantab[channel] := i ; { Zuordnung phys. --> log. }

+   END ;

+

+   clrscr ;

+   writeln ('So sind die physischen Kanaele den logischen Kanaelen zugeordnet:') ;

+   FOR i:= 0 TO 31 DO BEGIN

+    gotoxy (succ ((i DIV 16) * 40), 3 + (i MOD 16)) ;

+    write (i:2, ': ') ;

+    CASE conf.kantab[i] OF

+      0 : write ('SCSI   - Harddisk #0') ;

+      1 : write ('Basis  - Konsole') ;

+      2 : write ('ruc180 - Serielle B') ;

+      3 : write ('ruc180 - Serielle A') ;

+      4 : write ('ruc180 - Centronics') ;

+      5 : write ('Basis  - Serielle') ;

+      6 : write ('Basis  - Centronics') ;

+     28 : write ('SCSI   - Volume "', volume_name, '"') ;

+     29 : write ('Basis  - Diskdrive 1') ;

+     30 : write ('Basis  - Diskdrive 0') ;

+     31 : write ('SCSI   - ', scsi_floppy) ;

+    255 : write ('       -')

+    END { CASE } ;

+   END ;

+   writeln ;

+   writeln ;

+

+  UNTIL yes ('Alle Kanal-Zuordnungen korrekt') ;

+END { kanalzuordnungen } ;

+

+

+PROCEDURE konfigurieren ;

+ VAR freq : REAL ;

+ BEGIN

+  writeln ;

+  writeln ('************************* Systemstart - Parameter ************************') ;

+  writeln ;

+

+  IF yes ('EUMEL-Vortest beim Systemstart')

+     THEN IF NOT yes ('Speichertest durchfuehren')

+             THEN conf.mode := $0100

+             ELSE conf.mode := 0

+     ELSE conf.mode := $0200 ;

+  writeln ;

+

+  conf.urlk1 := 31 ;

+  conf.urlk2 := 0 ;

+  IF NOT yes ('Soll der Urlader zuerst auf dem Archivkanal gesucht werden')

+     THEN BEGIN

+      conf.urlk1 := 0 ;

+      conf.urlk2 := 31

+  END ;

+  writeln ;

+

+  writeln ('**************** Parameter der Konsole (phys. Kanal 1) ******************') ;

+  writeln ;

+

+  freq := conf.blinkp * 0.1 ;

+  write ('Cursor Blinkperiode (s)  : ', freq:2:1, #8#8#8#8) ;

+  REPEAT

+    readln (freq)

+  UNTIL (freq >= 0.05) AND (freq <= 25.5) ;

+  conf.blinkp := round (freq * 10.0) ;

+  writeln ;

+

+  freq := int (5000.0/conf.beepfreq + 0.5) ;

+  write ('Tonfrequenz bei Bell (Hz): ', freq:4:0, #8#8#8#8) ;

+  REPEAT

+    readln (freq)

+  UNTIL freq >= 1.0 ;

+  conf.beepfreq := round (5000.0/freq) ;

+  writeln ;

+

+  IF NOT floppy_version

+     THEN BEGIN

+      writeln ('********** Parameter fuer Harddisk-Volume (phys. Kanal 28) **************') ;

+      writeln ;

+

+      writeln ('Welches CP/M-Volume soll angesprochen werden ?') ;

+      cpm_volume_suchen ;

+      conf.cpmofs  := superdirectory.volumeentry[volume].first ;

+      conf.cpmlast := superdirectory.volumeentry[volume].last ;

+      volume_name  := superdirectory.volumeentry[volume].name ;

+     END

+  ELSE volume_name := '(1. Volume)' ;

+

+  writeln ;

+  writeln ('************* Parameter fuer SCSI-Floppy (phys. Kanal 31) ****************') ;

+  writeln ;

+  conf.arc31.drive := $60 ;

+  scsi_floppy := 'Floppy #1' ;

+  IF yes ('SCSI-Floppy #0 statt SCSI-Floppy #1')

+     THEN BEGIN

+       conf.arc31.drive := $40 ;

+       scsi_floppy := 'Floppy #0'

+  END ;

+

+  writeln ;

+  IF yes ('Zuordnung der logischen/physischen Kanaele aendern')

+     THEN kanalzuordnungen ;

+

+  writeln ;

+  writeln ;

+ END { konfigurieren } ;

+

+

+BEGIN { MAIN }

+ clrscr ;

+ writeln ('                            EUMEL-SHard Installation') ;

+ writeln ('                            Version ', vers) ;

+ writeln ('                            (c) M. Staubermann (ruc)') ;

+ writeln ;

+ writeln ;

+

+ IF yes ('SHard auf der Harddisk installieren')

+    THEN BEGIN

+     floppy_version := FALSE ;

+     shard_lesen ;

+     superdirectory_lesen ;

+     IF yes ('SHard-Defaults aendern')

+        THEN konfigurieren ;

+     eumel_volume_suchen ;

+     shard_schreiben ;

+     superdirectory_schreiben ;

+     writeln ('SHard erfolgreich auf Harddisk installiert.')

+    END

+ ELSE IF yes ('SHard auf einer (CP/M-)Floppy installieren')

+    THEN BEGIN

+     floppy_version := TRUE ;

+     shard_lesen ;

+     IF yes ('SHard-Defaults aendern')

+        THEN konfigurieren ;

+     shard_auf_floppy_schreiben ;

+     writeln ('SHard erfolgreich auf Floppy installiert.')

+    END

+ ELSE writeln ('Kein SHard installiert.')

+END.

diff --git a/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM
new file mode 100644
index 0000000..3d0a00c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM
new file mode 100644
index 0000000..6cddfa2
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC
new file mode 100644
index 0000000..d8c9a82
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC
@@ -0,0 +1,713 @@
+

+;---------------------------------------------------------------------------

+;

+;	SHard 1.8.0 - Schneller Boot von Floppy

+;	===========

+;

+;	(C) Copyright 1987, Michael Staubermann (ruc)

+;

+;	Version 0.2, 22.01.87

+;

+;---------------------------------------------------------------------------

+;

+		.6502

+		.RADIX	16

+		SUBTTL	Floppyboot

+

+slot      equ      6

+load_sec  equ	   $C65C

+p_data    equ      27

+sector    equ      3D

+ROM       equ      slot*100+0C000

+

+vpoint		EQU	$10		; Zeigt auf Volumetabelle

+VOLTAB		EQU	$B800

+

+DMA       equ	50		; 50..6F

+sec_tble  equ	70		; 70..7F

+task	  equ	80		; 80

+param	  equ	81

+def_byte  equ	82

+disk_no   equ	83

+iob_trk   equ	84

+sec_cnt   equ	85

+iob_err   equ	86

+

+; work space

+

+wait_Cnt   equ	87

+user_data equ	89

+dest_phase equ	8B

+chk_in_hdr equ	8C

+sec_in_hdr equ	8D

+trk_in_hdr equ	8E

+vol_in_hdr equ	8F

+slot10z   equ	90          ; slot #: s0

+iob_drv   equ	91

+phase     equ	92

+iob_sec   equ	93

+chk_sum   equ	94

+temp2     equ	95

+head_pos  equ	96

+tktry_cnt equ	97

+hdtry_cnt equ	98

+recal_cnt equ	99

+

+; Floppy Hardware

+

+phase0    equ      0C080

+phase1    equ      0C082

+phase2    equ      0C084

+phase3    equ      0C086

+mtroff    equ      0C088

+mtron     equ      0C089

+drive0    equ      0C08A

+Q6off     equ      0C08C

+Q6on      equ      0C08D

+Rstate    equ      0C08E

+Wstate    equ      0C08F

+

+bit_z     equ      24

+

+fast_step equ	$0E	; etwas weniger als 3 ms Track-Wechselzeit

+

+start180	EQU	$C087		; 64180 startet bei 0000

+

+;----------------------------------------------------------------------------

+

+pagerr	  macro	    adr

+	  if high(*-start) ne high(adr-start)

+	  .printx 'Page-Error'

+	  endif

+	  endm

+

+		.phase 0800

+

+start:

+nible1:

+

+		DB	0		; Nur einen Sektor

+		cpx	#60

+		beq	slotok

+		jmp	booterr

+slotok:

+		lda	sector

+		cmp	#8		; Alle Sektoren gewesen ?

+		beq	loader

+		cmp	#$0F

+		bne	next_sec

+		lda	#8

+		sta	p_data

+		lda	#0

+		sta	sector		; Mit Sektor 1 nach 0900 weiter

+next_sec:

+		inc	p_data

+		inc	sector

+		jmp	load_sec	; Sector laden und --> 0801 springen

+

+loader:

+		lda	$03F3

+		sta	$03F4		; Reboot

+

+		lda	def

+		sta	def_byte

+

+		jmp	load_shard

+

+booterr:

+		jsr	$FE84

+		jsr	$FB2F

+		jsr	$FE93

+		jsr	$FE89

+		jsr	$FC58		; Init Video, KBD, CLRSCR...

+		ldy	#0

+err1:		lda	errtxt,y

+		eor	#$80

+		jsr	$FDED		; Auf Bildschirm ausgeben

+		iny

+		cmp	#$8D		; RETURN als Abschluss

+		bne	err1

+		jmp	$FF65		; Sprung in Monitor

+		

+

+errtxt:		DB	'Boot error!', 0D

+

+

+          ds        $FF-(*-start)

+

+def:	  db	    $E0

+

+ 	  include NIBLE.INC

+

+write_data

+          SEC

+          LDA       Q6on,X

+          LDA       Rstate,X

+          BMI       wrdat99

+          LDA       nible2

+          STA       temp2

+          LDA       #0FF

+          STA       Wstate,X    ;  5

+          ORA       Q6off,X     ;  4

+          PHA                   ;  3

+          PLA                   ;  4     [sta..sta[

+          NOP                   ;  2

+          LDY       #04         ;  2

+wrdat1    PHA                   ;  3             3

+          PLA                   ;  4             4

+          JSR       wrt_nibl1   ;+13        15  13

+          DEY                   ;---         2

+          BNE       wrdat1      ; 40       + 3

+                                ;          --- ---

+                                ;           20+ 20 = 40

+

+	  pagerr    wrdat1

+

+                                ;           -1

+          LDA       #0D5        ;            2

+          JSR       wrt_nibl     ; 15       +15

+          LDA       #0AA        ;  2       ---

+          JSR       wrt_nibl     ;+15        36

+          LDA       #0AD        ;---

+          JSR       wrt_nibl     ; 32        15

+          TYA                   ;            2

+          LDY       #56         ;            2

+wrdat11   BNE       wrdat3      ;            3

+wrdat2    LDA       nible2,Y    ;            0    4

+wrdat3    EOR       nible2-1,Y  ;            5    5

+          TAX                   ;            2    2

+          LDA       to_nibble,X ;            4    4

+          LDX       slot10z     ;            3    3

+                                       ;   ---  ---

+                                       ;    36   18

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          DEY                          ;     2

+          BNE       wrdat2             ;     3

+                                       ;   ---

+                                       ;    14 + 18 = 32

+                                       ;    -1

+          LDA       temp2              ;     3

+          NOP                          ;     2

+wrdat4    EOR       nible1,Y           ;     4    4

+          TAX                          ;     2    2

+          LDA       to_nibble,X        ;     4    4

+          LDX       slot10             ;     4    4

+                                       ;   ---  ---

+                                       ;    32   14

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          LDA       nible1,Y           ;     4

+          INY                          ;     2

+          BNE       wrdat4             ;     3

+                                       ;   ---

+                                       ;    18+ 14 = 32

+

+	  pagerr	    wrdat11

+

+          TAX                          ;     2

+          LDA       to_nibble,X        ;     4

+          LDX       slot10z            ;     3

+          JSR       wrt_nibl2          ;     6  15

+          LDA       #0DE               ;   ---   2

+          JSR       wrt_nibl            ;    32  15

+          LDA       #0AA               ;       ---

+          JSR       wrt_nibl            ;        32

+          LDA       #0EB

+          JSR       wrt_nibl

+          LDA       #0FF

+          JSR       wrt_nibl

+          LDA       Rstate,X

+wrdat99

+          LDA       Q6off,X

+wrdat999

+	  dey

+	  bne	   wrdat999		; PostErase-Delay 1 ms

+

+          RTS

+

+read_hdr

+          sei

+          LDY       #0FC

+          STY       temp2

+rdhdr0

+          INY

+          BNE       rdhdr1

+          INC       temp2

+          BEQ       fail

+rdhdr1

+          LDA       Q6off,X

+          BPL       rdhdr1

+rdhdr11   CMP       #0D5

+          BNE       rdhdr0

+

+          NOP

+rdhdr2    LDA       Q6off,X

+          BPL       rdhdr2

+          CMP       #0AA

+          BNE       rdhdr11

+

+          LDY       #03

+rdhdr3    LDA       Q6off,X

+          BPL       rdhdr3

+          CMP       #96

+          BNE       rdhdr11

+          

+	  pagerr    rdhdr1

+

+          

+          LDA       #00

+nxthByte  STA       chk_sum

+rdhdr4    LDA       Q6off,X

+          BPL       rdhdr4

+	  ROL	    A

+          STA       temp2

+rdhdr5    LDA       Q6off,X

+          BPL       rdhdr5

+          AND       temp2

+          STA       chk_in_hdr,Y

+          EOR       chk_sum

+          DEY

+          BPL       nxthbyte

+

+          TAY

+          BNE       fail

+

+rdhdr6    LDA       Q6off,X

+          bpl       rdhdr6

+          cmp       #0DE

+          BNE       fail

+

+          NOP

+rdhdr7    LDA       Q6off,X

+          BPL       rdhdr7

+          CMP       #0AA

+          BNE       fail

+

+          CLC

+          RTS

+fail

+          SEC

+          RTS

+

+moving

+          LDY       #0

+mov0      LDA       Q6off,X

+	  JSR	    mov1

+	  PHA			;  3

+ 	  PLA			;  4

+	  CMP	    Q6off,X	;  4

+	  BNE	    mov1	;----

+	  DEY			; 21 uS

+	  BNE	    mov0

+mov1	  RTS

+

+

+read_data

+	  TXA

+	  ORA	    #8C

+	  STA	    ld1+1

+	  STA	    ld2+1

+	  STA	    ld3+1

+	  STA	    ld4+1

+	  STA	    ld5+1

+	  LDA	    user_data

+	  LDY	    user_data+1

+	  STA	    st5+1

+	  STY	    st5+2

+	  SEC

+	  SBC	    #54

+	  BCS	    rddat1

+	  DEY

+	  SEC

+rddat1

+	  STA	    st3+1

+	  STY	    st3+2

+          SBC       #57

+          BCS       rddat2

+          DEY

+rddat2

+          STA       st2+1

+          STY       st2+2

+

+          LDY       #20

+nxt_begin

+          DEY

+          BEQ       fail

+wait_begin

+waitb0    LDA       Q6off,X

+          BPL       waitb0

+waitb00   EOR       #0D5

+          BNE       nxt_begin

+          NOP

+waitb1    LDA       Q6off,X

+          BPL       waitb1

+          CMP       #0AA

+          BNE       waitb00

+          NOP

+waitb2    LDA       Q6off,X

+          BPL       waitb2

+          CMP       #0AD

+          BNE       waitb00

+

+          LDY       #0AA

+          LDA       #0

+rloop1    STA       temp2

+ld1       LDX       Q6off+60  ; addr modified by read init !

+          BPL       ld1

+          LDA       to_bits-96,X

+          STA       nible2-0AA,Y

+          EOR       temp2

+          INY

+          BNE       rloop1

+          

+;

+; read nible from disk and convert to user data

+;

+          LDY       #0AA

+          BNE       ld2

+rloop2

+st2       STA       1000,Y

+ld2       LDX       Q6off+60  ; modified by read init

+          BPL       ld2

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+0,X

+          INY

+          BNE       rloop2

+

+          PHA

+          AND       #0FC

+          LDY       #0AA

+ld3       LDX       Q6off+60  ; modified by read init

+          BPL       ld3

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+1,X

+st3       STA       1000,Y

+          INY

+          BNE       ld3

+

+ld4       LDX       Q6off+60  ; modified by read init

+          BPL       ld4

+          AND       #0FC

+          LDY       #0AC

+rloop5    EOR       to_bits-96,X

+          LDX       nible2-0AC,Y

+          EOR       to_bytes+2,X

+st5       STA       1000,Y

+ld5       LDX       Q6off+60  ; modified by read init

+          BPL       ld5

+          INY

+          BNE       rloop5

+          AND       #0FC

+          EOR       to_bits-96,X

+          LDX       slot10z

+          TAY

+          BNE       chk_fail

+rloop6    LDA       Q6off,X

+          BPL       rloop6

+          CMP       #0DE

+          BEQ       read_ok

+

+          pagerr      wait_begin

+chk_fail

+          SEC

+          db     bit_z

+read_ok

+          clc

+          PLA

+          LDY       #55

+          STA       (user_data),Y

+          RTS

+

+seekT	  lda	    iob_trk          

+seekL

+	  jsr	    trk_to_ph

+          cmp       phase0,X

+          cmp       phase1,X

+          cmp       phase2,X

+          cmp       phase3,X

+          LDY       disk_no

+          LDA       head_table,y	; da steht der Kopf jetzt

+          STA       head_pos

+	  lda	    dest_phase

+	  sta	    head_table,y	; da soll er nachher stehen

+          

+seekH

+          cmp       head_pos

+          BEQ       seek_rts

+          LDA       #0

+          STA       temp2

+seekh0    LDA       head_pos

+          STA       phase

+          SEC

+          SBC       dest_phase

+          BEQ       seekh5

+          BCS       seekh1

+          EOR       #0FF

+          INC       head_pos

+          BCC       seekh2

+seekh1    ADC       #0FE

+          DEC       head_pos

+seekh2    CMP       temp2

+          BCC       seekh3

+          LDA       temp2

+seekh3    CMP       #8

+          BCS       seekh4

+          TAY

+seekh4    SEC

+          JSR       step

+          LDA       time0,Y

+          JSR       step_wait

+          LDA       phase

+          CLC

+          JSR       step1

+          LDA       time1,Y

+          JSR       step_wait

+          INC       temp2

+          BNE       seekh0

+

+seekh5    JSR       step_wait

+          CLC

+step      LDA       head_pos

+step1     AND       #3

+          ROL       A

+          ORA       slot10z

+          TAX

+          LDA       phase0,X

+          LDX       slot10z

+seek_rts  RTS

+

+;-------------------------------;

+

+make_nibl

+          LDY       #56

+          LDA       #0

+maken0    STA       nible2-1,Y

+          DEY

+          BNE       maken0

+maken1    LDX       #55

+maken2    LDA       (user_data),Y

+          AND       #0FC

+          STA       nible1,Y

+          EOR       (user_data),Y

+          INY

+          CMP       #02

+          ORA       nible2,X

+          ROR       A

+          ROR       A

+          STA       nible2,X

+          DEX

+          BPL       maken2

+          CPY       #02

+          BNE       maken1

+          RTS

+

+;	ds	10

+          

+Dsk_RW 

+	  ldx	    #0A9	; LDA #xx

+	  lda	    def_byte

+	  and	    #$20	; Bit 5 ?

+	  bne	    rw_0	; Fast Step - use abs. value

+

+				; Slow Step - use MotorOn/Off-Tables

+	  ldx	    #0C9	; CMP #xx

+rw_0:	  stx	    step_wait

+	

+	  lda	    #fast_step	; Set Step Rate

+	  bit	    def_byte

+	  bmi	    rw_1	; Bit7: Controller-Typ

+				; Bit7=0 => Ehring

+	  lsr	    a		; bei Ehring 2-fache Phases => halbe Steprate

+

+rw_1:	  sta	    step_wait+1		; Steprate

+

+          lda       disk_no

+          LSR       A

+          TAY

+          LDA       slotn,Y

+          STA       slot10

+          sta       slot10z

+          adc       #0

+          STA       iob_drv

+          

+ 	  include TRACK.INC 

+

+trk_to_ph:			; IN: A = track / OUT: A,dest_phase = phase

+	sta	dest_phase

+

+; Select Side 0

+

+	bit	def_byte	; Bit7: 1=Erphi-Controller

+				; Bit6: 1=Erphi-Format

+

+	bvc	ehring_format	; Bit6 = 0 => Ehring-Format

+

+	lsr	dest_phase	; Erphi-Format

+	bcc	side0

+

+; Select Side 1

+; Erphi:  mtroff, Q6on, mtron

+; Ehring: mtroff,mtron

+

+side1:	lda	mtroff,x

+	bit	def_byte

+	bpl	side1_2

+				; Erphi-Side-1-Select

+	lda	Q6on,x

+side1_2:

+	lda	mtron,x

+	jmp	ph_mult

+

+ehring_format:

+	cmp	#$50		; Track >= 80 ?

+	bcc	side0		; nein: Select Side 0

+

+	sbc	#$50

+	sta	dest_phase

+	jmp	side1

+

+; Select Side 0

+; Ehring: lda cn00,x

+; Erphi : mtroff, Q6off, mtron

+

+side0:	bit	def_byte

+	bmi	erphi_s0	; Bit7 = 1 => Erphi-Controller

+

+	txa			; Ehring-Side-0-Select

+	lsr	a

+	lsr	a

+	lsr	a

+	lsr	a

+	ora	#$C0

+	sta	ehr_sel+2

+

+ehr_sel:lda	$C600

+	jmp	ph_mult

+

+erphi_s0:			; Erphi-Side-0-Select

+	cmp	mtroff,x

+	cmp	Q6off,x

+	cmp	mtron,x

+

+ph_mult:

+	lda	def_byte	; Bit 0..1: 0 = 1 Step/Track

+	and	#03		;           1 = 2 Steps/Track

+	tay			;           2 = 4 Steps/Track

+	beq	ph_mult2

+

+ph_mult1:

+	asl	dest_phase

+	dey

+	bne	ph_mult1

+

+ph_mult2:

+	lda	dest_phase

+	rts

+

+load_shard:

+

+load_0:		lda	#$10

+		ldx	#1		; Track 1

+		jsr	loadtrack

+		bne	load_0

+

+load_1:		lda	#$20

+		ldx	#2		; Track 2

+		jsr	loadtrack

+		bne	load_1

+

+load_2:		lda	#$30

+		ldx	#3		; Track 3

+		jsr	loadtrack

+		bne	load_2

+

+load_3:		lda	#$40

+		ldx	#4		; Track 4

+		jsr	loadtrack

+		bne	load_3

+

+

+		lda	#HIGH VOLTAB

+		sta	vpoint+1

+		lda	#LOW VOLTAB

+		sta	vpoint

+		ldx	#8

+loop2:		lda	eumel_vol,x

+		sta	VOLTAB,x

+		dex

+		bpl	loop2

+

+		lda	#$C3

+		sta	0

+		lda	#$00

+		sta	1

+		lda	#$10

+		sta	2		; JP $1000 - 64180

+		lda	#0

+		sta	task

+		sei

+		ldx	#leng1-1

+lp1:

+		lda	codp,x

+		sta	8000,x

+		dex

+		bpl	lp1

+		jmp	8000

+

+codp:

+		ldx	#$70		; Karte in Slot 7

+		stx	$04F8

+		lda	start180,x	; Start 64180

+loop:

+		lda	task

+		cmp	#4

+		bne	loop		; Auf Adress-Task warten

+

+		jmp	(1)		; Neue Taskloop anspringen

+leng1	equ	$-codp

+	

+loadtrack:

+	stx	iob_trk

+	tax

+	dex

+	txa

+	ldx	#0

+	ldy	#0

+boot31:	pha

+	lda	#0

+	sta	sec_tble,y

+	sta	DMA,x

+	pla

+	clc

+	adc	#1

+	sta	DMA+1,x

+	inx

+	inx

+	iny

+	cpy	#10

+	bne	boot31

+;

+;	Steprate einstellen und andere Disk Voreinstellungen

+;          

+	sty	sec_cnt     ; := 10     read track, sector 0..F

+	ldx	#0f

+	stx	iob_err     ; StepRate

+	ldx	#0

+	stx	disk_no  	; :=  0

+        dex

+        stx	param    	; := FF (read)

+	jsr	dsk_rw

+	lda	iob_err

+	rts

+

+

+eumel_vol:

+		40H, 00H, 4AH, 60H, 00H, 00H, 0B3H, 00H, 0FFH

+		; Default, ggf. Aendern

+

+		END

diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM
new file mode 100644
index 0000000..d3f5a12
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM
@@ -0,0 +1 @@
+

diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC
new file mode 100644
index 0000000..268cdbe
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC
@@ -0,0 +1,1635 @@
+;

+;****************************************************************

+;

+;	EUMEL-SHard Graphikroutinen fuer 6502-Teil.

+;	Anfang: 20.05.86, Michael Staubermann

+;	Version	1.2, Mit Incremental-Fill, dicke Striche, COPY-Modus

+;	Stand:	12.01.87

+;	

+		.printx	'GRAFIK65.MAC'

+

+;----------------------------------------------------------------------------

+;	V A R I A B L E

+;----------------------------------------------------------------------------

+;

+;	Konstante

+

+bit_a		EQU	2C	; Skip 2 Bytes

+

+;	Switches

+

+graphic_mode	EQU	$C050

+text_mode	EQU	$C051

+full_graphics	EQU	$C052

+page_1		EQU	$C054

+hires_mode	EQU	$C057

+lc_00		EQU	$C083

+lc_01		EQU	$C08B

+

+;----------------------------------------------------------------------------

+;

+;	G R A P H I K		Einsprung fuer alle Graphiksubtasks

+;

+;	Eingang:	$81 Subtasknummer

+;				0 = Move (x, y)

+;				1 = Draw (x, y)

+;				2 = Testbit (x, y) --> $81

+;				3 = Control (on/off, bank, page, or/and/xor, 

+;					     patternsource, colour, pattern)

+;				4 = Clear (page)

+;				5 = Fill (muster)

+;				6 = Trans (page a) to (page b)

+;

+;	Ausgang:	$81 (Nur bei Testbit)

+;

+;----------------------------------------------------------------------------

+

+GRAFIK:

+		lda	subtask		; 0 - 6

+		cmp	#7

+		bcc	grafik1

+		rts			; unerlaubt

+

+grafik1:

+		asl	a

+		tax

+		lda	gfunct,x

+		sta	1

+		lda	gfunct+1,x

+		sta	2		; 1/2 Sprungadressen

+		jmp	(1)		; Funktion aurufen

+

+gfunct:

+		dw	gmove, gdraw, gtest, gctrl, gclr, gfill, gtrans

+

+;---------------------------------------------------------------------

+;

+;	G M O V E

+;	Graphikcursor auf Position (x, y) setzen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;

+GMOVE:

+		lda	param1

+		sta	xpos		; LOW xpos

+		lda	param1+1

+		sta	xpos+1		; HIGH xpos

+		lda	param2

+		sta	ypos		; LOW ypos

+		lda	param2+1

+		sta	ypos+1		; HIGH ypos

+

+move_x:

+		lda	savepattern

+		sta	pattern

+		lda	savepattern+1

+		sta	pattern+1	; Linetypepattern auf Anfangswert

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G D R A W

+;	Linie zur Position (x, y) zeichen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;

+GDRAW:

+	IF 0

+		lda	param1

+		pha			; 'to' Parameter retten

+		lda	param1+1

+		pha

+		lda	param2

+		pha

+		lda	param2+1

+		pha

+	ENDIF

+		jsr	draw		; draw (xpos,ypos TO param1,param2)

+	IF 0

+		pla

+		sta	ypos+1

+		pla

+		sta	ypos

+		pla

+		sta	xpos+1

+		pla

+		sta	xpos

+	ENDIF

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G T E S T

+;	Punkt (x, y) testen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;	Ausgang: param = result = Flags

+;

+GTEST:

+		lda	param2+1	; HIGH y

+		bne	ytohigh		; Carry is set

+		lda	param1+1	; HIGH x

+		ldx	param1		; LOW x

+		ldy	param2		; LOW y

+		jsr	calcaddr	; Byteaddresse des Punktes berechnen

+ytohigh:	lda	#$FF		; 255 = Falsche Punktposition

+		bcs	testrts		; Return mit Ergebnis

+		ldy	#00

+		lda	(address),y

+		php			; Farbbit merken

+		and	bitmask,x	; Pixel ausmaskieren

+		beq	testcolor

+		lda	#01		; Bit 0 : Zustand des gesuchten Pixels

+testcolor:	plp

+		bpl	testrts

+		ora	#80		; Bit 7 : Farbe

+testrts:	sta	result

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G C T R L

+;	Verschiede Steuerfunktionen

+;

+;	Eingang: param1 s.u.

+; Steuerbits:

+; 0:	0 = graphik off

+;	1 = graphik on

+; 1:	0 = Sichtbare Seite 0

+;	1 = Sichtbare Seite 1

+; 2:	0 = Bearbeitete Seite 0 (2000..3FFF)

+;	1 = Bearbeitete Seite 1 (4000..5FFF)

+; 3,4:	0 = OR (Setzen)

+;	1 = AND (Loeschen)

+;	2 = XOR (Invertieren)

+;	3 = COPY (kopieren = loeschen/setzen)

+; 5:	0 = Full Graphics display

+;	1 = Mixed Graphics display (4 Zeilen Text)

+; 6:	0 = param2 ist Linetypepattern

+;	1 = savepattern ist Linetypepatt.

+; 7:	0 = Violett

+;	1 = Gelb

+; 8..11 = Strichdicke

+;

+; param2 ist 16Bit Pattern (falls Bit 6 = 0)

+;

+GCTRL:

+		lda	param1		; Steuerbits

+		and	#80		; Bit 7 = Farbe

+		sta	colormask

+

+		lsr	param1		; Bit 0 = Graphik on/off

+		bcs	graphon

+

+		lda	text_mode

+		lda	page_1

+		bcc	bit12

+

+graphon:	lda	graphic_mode

+		lda	hires_mode

+

+		lda	param1		; Bit 2 = Page

+		and	#01

+		tax

+		sta	page_1,x	; Page Select

+

+bit12:		lsr	param1		; Bit 1 ins Carry

+		lsr	param1		; Bit 2 ins Carry

+		bcs	page2sel

+		lda	#20

+		db	bit_a

+page2sel:	lda	#40

+		sta	pagebase

+

+		lda	param1

+		and	#03		; Bit 3,4 = Bitmode

+		sta	bitmode

+		lsr	param1		; Bit 3 ins Carry

+		lsr	param1		; Bit 4 ins Carry

+

+		lda	param1+1

+		and	#0F

+		bne	setthick

+		lda	#1		; Default 0: 1 Strich

+setthick:

+		sta	thick		; Strichdicke in 8..11

+

+		lda	param1		; Bit 5 = full (0) or mixed (1) Graph.

+		and	#01

+		tax

+		sta	full_graphics,x

+		lsr	param1		; Bit 5 ins Carry

+

+		lsr	param1		; Bit 6 ins Carry

+		bcs	saved

+

+		lda	param2		; Parameter 2 (Word) Pattern

+		sta	pattern		; in interne Linepattern kopieren

+		sta	savepattern

+		lda	param2+1

+		sta	pattern+1

+		sta	savepattern+1

+		bcc	ctrlret

+

+saved:

+		lda	pattern		; Internes Savepattern als Workpattern

+		sta	savepattern	; benutzen

+		lda	pattern+1

+		sta	savepattern+1

+

+ctrlret:	rts

+

+;---------------------------------------------------------------------

+;

+;	G C L R 

+;	Graphikseite loeschen, bzw. mit einem Bitmuster fuellen

+;

+;	Eingang: param1 = Seite (0..3)

+;		 param2 = Byte (0..255)

+;

+GCLR:

+		lda	param1

+		jsr	page_addr	; Anfangsaddresse der Page --> A

+					; y := 0

+		sta	address+1

+		sty	address

+		ldx	#20		; 32 Pages

+		lda	param2

+gclr1:

+		sta	(address),y

+		iny

+		bne	gclr1

+		inc	address+1

+		dex

+		bne	gclr1

+		rts

+

+page_addr:

+		and	#3

+		asl	a

+		asl	a

+		asl	a

+		asl	a

+		asl	a

+		adc	#20		; + Offset fuer erste Grafikseite

+		ldy	#0

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G F I L L

+;	Umrandete Flaeche Fuellen

+;

+;	Eingang: param1 = Nummer des Fuellmusters

+;

+GFILL:

+		lda	lc_01

+		lda	lc_01		; Select Page 1 D000..DFFF (Stack)

+		lda	param1

+		jsr	fill

+		lda	lc_00

+		lda	lc_00		; Select Page 0 D000..DFFF (Spooler)

+		rts

+

+

+;---------------------------------------------------------------------

+;

+;	G T R A N S

+;	Graphikseite in eine andere Grafikseite kopieren

+;

+;	Eingang: param1 = 'from'-Page (0..3)

+;		 param2 = 'to'-Page (0..3)

+;

+GTRANS:

+		lda	param1

+		jsr	page_addr

+		sta	address+1		; 'from' - Pagebase

+		sty	address

+

+		lda	param2

+		jsr	page_addr

+		sta	param1+1

+		sty	param			; 'to' - Pagebase

+		ldx	#20			; 32 Pages

+

+gtrans1:

+		lda	(address),y

+		sta	(param1),y

+		iny

+		bne	gtrans1

+		inc	address+1

+		inc	param1+1

+		dex

+		bne	gtrans1

+		rts

+

+;--------------------------------------------------------------------------

+;	Umrandete Graphikflaeche (xpos, ypos) ausfuellen

+;	Musternummer in A

+

+FILL:

+		and	#0F		; 16 Muster a 64 Bit

+		asl	a		; *8 (8 Bytes pro Muster)

+		asl	a

+		asl	a		; Offset auf Muster

+		sta	olderror+1

+		lda	pagebase

+		sta	olderror	; Merken

+		lda	#wrkpage	; Workpage (alter Inhalt geloescht!)

+		sta	pagebase

+		jsr	fill1		; ggf POP Returnaddress

+		lda	olderror

+		sta	pagebase	; restoren

+		rts

+

+fill1:

+		lda	bitmode

+		and	#1

+		sta	creg

+

+

+		lda	#2

+		sta	areg+1		; stackpointer

+		lda	ypos+1

+		bne	fill1d		; Out of Window

+		ldx	xpos

+		stx	xa		; xpos low (fuer Muster)

+		lda	xpos+1

+		sta	xb

+		ldy	ypos

+		sty	ya		; yposlow (fuer Muster)

+		jsr	startxy

+		bcc	fill1c

+fill1d:		rts			; Ausserhalb oder auf Punkt

+

+fill1c:

+		ldx	#wrkpage

+		stx	address+1

+		ldx	olderror	; Echte Seite

+		stx	link+1

+		ldx	#20		; 8k

+		ldy	#0

+		sty	address

+		sty	link

+fill1b:		lda	(link),y	; Echte Seite in Arbeitsseite kopieren

+		sta	(address),y	; Arbeitsseite loeschen

+		iny

+		bne	fill1b

+		inc	address+1

+		inc	link+1

+		dex

+		bne	fill1b

+		lda	xpos+1

+		ldx	xpos

+		ldy	ypos

+		jsr	startxy

+

+fill2:

+		ldy	creg+1		; Byte Offset

+		ldx	breg+1		; Bit Offset

+		jsr	testquick	; Bei (x,y) Punkt gesetzt ?

+		bcc	fill2h		; Punkt gesetzt

+		jsr	poppos

+		jmp	fill2

+					; (x-1, y) testen

+fill2h:		lda	breg+1

+		sta	dx

+		lda	creg+1

+		sta	dx+1

+		lda	xa

+		sta	xa+1		; Save xpos

+		lda	xb

+		sta	xb+1

+

+		lda	xa

+		bne	fill2d2

+		dec	xb

+fill2d2:	dec	xa

+		jsr	decx		; x-1, y bleibt

+		bcs	fill2d

+		jsr	testquick

+		bcc	fill2h

+

+fill2d:		lda	dx		; Altes x wiederherstellen

+		sta	breg+1		; (Der letzte Punkt vorm linken

+		lda	dx+1		; Rand)

+		sta	creg+1

+		lda	xa+1

+		sta	xa

+		lda	xb+1

+		sta	xb

+

+fill4:					; (x, y-1) testen

+		lda	address		; ypos retten

+		sta	dy

+		lda	address+1

+		sta	dy+1

+		lda	breg

+		sta	yb	

+		lda	ya		; ypos low

+		sta	ya+1

+

+		dec	ya

+		jsr	decy		; y-1

+		bcs	fill2a

+		jsr	testquick

+		bcs	fill2a

+		jsr	clrstack	; Hier auch 'pushpos'

+

+fill2a:					; (x, y+1) testen

+		jsr	incy

+		bcs	fill2e

+		jsr	incy

+		bcs	fill2e

+		inc	ya

+		inc	ya

+		jsr	testquick

+		bcs	fill2e

+		jsr	clrstack	; Hier auch 'pushpos'

+fill2e:					; Altes y wiederherstellen

+		lda	dy

+		sta	address		; ypos widerherstellen

+		lda	dy+1

+		sta	address+1

+		lda	yb

+		sta	breg

+		lda	ya+1

+		sta	ya

+

+		jsr	pointquick

+

+		inc	xa

+		bne	fill2g

+		inc	xb

+fill2g:		jsr	incx

+		bcs	fill2i

+		jsr	testquick

+		bcc	fill4		; Punkt bei (x+1, y) ?

+fill2i:		jsr	poppos		; Gerettete x/y Pos vom Stack

+		jmp	fill2		; Damit nochmal (pseudorekursion)

+

+;--------------------------------------------------------------------------

+;	Hilfsroutinen fuer 'GFILL'

+

+testquick:

+		lda	(address),y

+		and	bitmask,x

+		beq	testquick1	; Kein Punkt gesetzt

+		lda	#1

+testquick1:	eor	creg		; umdrehen, falls AND/COPY

+		lsr	a		; SEC/CLC

+		rts

+

+pointquick:

+		lda	ya		; ypos low

+		and	#7

+		ora	olderror+1	; Offset auf Muster

+		tay

+		lda	xa

+		and	#7

+		tax

+		lda	bitmask,x	; xpos Bit

+		and	muster,y	; ypos Byte

+		sta	yb+1		; 0, wenn kein Punkt gesetzt

+

+		ldx	breg+1

+		ldy	creg+1

+		lda	(address),y

+		eor	bitmask,x	; Bei OR loeschen, bei AND setzen!

+		sta	(address),y	; Zum Merken in Workpage

+					; Test, ob auch in echter Seite Punkt

+		lda	yb+1

+		beq	pointquick1	; Nicht mehr in echter Seite setzen

+		lda	address+1

+		pha

+		and	#$1F		; Nur 8k Bits

+		ora	olderror	; Echte pagebase

+		sta	address+1

+		lda	(address),y

+		and	#$7F

+		ora	colormask

+		eor	bitmask,x

+		sta	(address),y	; In echter Seite setzen

+		pla

+		sta	address+1

+

+pointquick1:	rts

+

+poppos:					; x/y Pos vom Stack holen

+		ldx	areg+1		; stackpointer

+		cpx	#2

+		beq	poppos1

+		dex			; ? ggf beq poppos1

+		beq	poppos1

+

+		lda	stack+000,x	; xpos

+		sta	breg+1

+		lda	stack+100,x

+		sta	creg+1

+

+		lda	stack+200,x	; ypos

+		sta	address

+		lda	stack+300,x

+		sta	address+1

+		lda	stack+400,x

+		sta	breg

+

+		lda	stack+500,x	; xpos low

+		sta	xa

+		lda	stack+600,x	; xpos high

+		sta	xb

+		lda	stack+700,x	; ypos low

+		sta	ya

+		stx	areg+1		; stackpointer

+		rts

+poppos1:

+		pla

+		pla

+		rts			; Fill verlassen

+

+

+clrstack:				; Stack aufraeumen und pushpos

+		ldx	#$FE		; creg+1, da Neues startxy gegeben wird

+		stx	yb+1		; Flag, ob zweites mal clrstack

+		ldx	areg+1		; stackpointer

+clrstack4:	dex

+		lda	stack+700,x

+		cmp	ya

+		bne	clrstack3

+		lda	stack+600,x	; (stack)+1 --> temp (in A/Y)

+		ldy	stack+500,x

+		iny

+		bne	clrstack2

+		clc

+		adc	#1

+clrstack2:	cmp	xb		; Stacktop = xpos-1 ?

+		bne	clrstack3

+		cpy	xa

+		bne	clrstack3

+

+		lda	breg+1		; xpos replacen

+		sta	stack+000,x

+		lda	creg+1

+		sta	stack+100,x

+		lda	xa

+		sta	stack+500,x

+		lda	xb

+		sta	stack+600,x

+		rts

+

+clrstack3:	inc	yb+1		; Flag fuer 2. Durchlauf

+		bne	clrstack4

+

+pushpos:				; xpos/ypos auf Stack bringen

+		ldx	areg+1		; stackpointer

+		lda	breg+1

+		sta	stack+000,x

+		lda	creg+1

+		sta	stack+100,x

+		lda	address

+		sta	stack+200,x

+		lda	address+1

+		sta	stack+300,x

+		lda	breg

+		sta	stack+400,x

+		lda	xa

+		sta	stack+500,x

+		lda	xb

+		sta	stack+600,x

+		lda	ya

+		sta	stack+700,x

+		inx

+		beq	pushpos1	; Stackoverflow

+		stx	areg+1		; stackpointer

+pushpos1:	rts

+

+;===========================================================================

+;	Incremental Adresses

+;	Belegt breg = rowstartoffset, breg+1 = x-reg = bitoffset

+;	       creg+1 = y-reg = xbyte offset,

+;	       address/address+1 = Byteaddresse

+;

+;	Fuer jede Routine gilt:

+;	Ausgang: X = Bitoffset, Y = Byteoffset, SEC = Out of Window

+;	Trat SEC auf, ist die aktuelle Position unveraendert (!)

+;		 Beispiel: jsr	incy

+;			   bcs	fehler

+;			   lda	(address),y

+;			   and	bitmask,x

+

+;---------------------------------------------------------------------------

+;	Start Scan

+;

+;	Eingang:		A: HIGH xpos

+;				X: LOW xpos

+;				Y: LOW ypos

+

+STARTXY:

+		cmp	#02		; xpos >= 512 ?

+		bcc	startxy1

+startxy2:	rts			; Carry is Set

+startxy1:	cmp	#01

+		bne	startxy3	; xpos < 256

+		cpx	#18		; xpos >= 280 ?

+		bcs	startxy2	; Bereichsfehler

+startxy3:	cpy	#$C0		; ypos >= 192 ?

+		bcs	startxy2	

+

+		pha			; xpos (HIGH) retten

+		tya

+		pha

+

+; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7

+

+		lsr	a		; ypos DIV 8

+		lsr	a

+		lsr	a

+		asl	a		; Fuer Tabellenzugriff * 2 (Bit 0 = 0)

+		tay

+		sty	breg		; rowstart Offset

+		lda	rowstart,y	; Tabelle der Zeilenanfaenge

+		sta	address

+		lda	rowstart+1,y

+		clc

+		adc	pagebase

+		sta	address+1

+		pla			; ypos

+		and	#07		; MOD 8

+		eor	#07		; y = 0 ist unten links

+		asl	a		; * 4 (* 256)

+		asl			; Carry is cleared

+		adc	address+1	; Mikrozeile addieren

+		sta	address+1

+		pla			; xpos (HIGH) --> Y

+		tay

+		txa			; xpos (LOW) --> A

+		jsr	divide7		; A/Y --> A (Quotient), X (Remainder)

+		sta	creg+1

+		tay			; y-reg = Byteoffset

+		stx	breg+1		; Bitoffset

+		clc			; Carry cleared = ok

+		rts

+			

+;-------------------------------------------------------------------------

+;	Increment actual y

+

+INCY:

+		lda	address+1

+		and	#1C

+		beq	incy1		; naechste Mikrozeile

+		lda	address+1

+		sec

+		sbc	#4

+		sta	address+1

+		clc			; ok

+incy2:		ldy	creg+1

+		ldx	breg+1

+		rts

+

+incy1:		ldy	breg

+		iny

+		iny			; naechste Makrozeile

+		cpy	#30		; tabellenende ?

+		bcs	incy2		; Fehler, nichts veraendert

+		sty	breg

+		lda	rowstart,y

+		sta	address		; Carry war cleared

+		lda	rowstart+1,y

+		adc	pagebase

+		adc	#1C		; 7. Mikrozeile

+		sta	address+1

+		bcc	incy2		; Always

+

+;--------------------------------------------------------------------------

+;	Decrement actual y

+

+DECY:

+		lda	address+1

+		and	#1C

+		cmp	#1C		; 7. Mikrozeile ?

+		beq	decy1		; naechste Mikrozeile

+		lda	address+1

+		adc	#4

+		sta	address+1

+decy2:		ldy	creg+1

+		ldx	breg+1

+		rts

+

+decy1:		ldy	breg		; naechste Makrozeile

+		sec

+		beq	decy2		; Out of Window ?

+		dey

+		dey

+		sty	breg

+		lda	rowstart,y

+		sta	address

+		clc

+		lda	rowstart+1,y

+		adc	pagebase

+		sta	address+1

+		bcc	decy2		; Always

+

+;-------------------------------------------------------------------------

+;	Increment actual x

+

+INCX:

+		ldy	creg+1

+		ldx	breg+1

+		cpx	#6

+		bcs	incx1

+		inx

+		clc

+incx2:		stx	breg+1		; y schon = creg+1

+		rts

+

+incx1:		inc	creg+1

+		iny

+		ldx	creg+1

+		cpx	#28		; Out of Window ?

+		ldx	#0

+		bcc	incx2		; CLC: ok

+		dec	creg+1		; Wieder Rueckgaengig

+		rts

+

+;-----------------------------------------------------------------------

+;	Decrement actual x

+

+DECX:

+		ldy	creg+1

+		ldx	breg+1

+		beq	decx1

+		dex

+decx2:		stx	breg+1		; y schon creg+1

+		rts

+

+decx1:		ldx	#6

+		dec	creg+1

+		dey

+		clc

+		bpl	decx2		; < 0 ?

+		sec			; Out of Window !

+		inc	creg+1		; Alter Zustand

+		rts

+

+

+;==========================================================================

+;	Absolute Adresses

+

+;--------------------------------------------------------------------------

+;

+;		C A L C A D D R

+;		Berechnet die Addresse eines Pixels

+;

+;		Eingang:	A: HIGH xpos

+;				X: LOW xpos

+;				Y: ypos

+;		Ausgang:	address,address+1: Addresse des Bytes mit Pixel

+;				Carry: Set = Pixelpos ausserhalb des Fensters

+;				X: Bitnummer im addressierten Byte (0..6)

+;---------------------------------------------------------------------------

+

+CALCADDR:

+		cmp	#02		; xpos >= 512 ?

+		bcc	less512

+rangeerr:	rts			; Carry is Set

+less512:	cmp	#01

+		bne	xposok		; xpos < 256

+		cpx	#18		; xpos >= 280 ?

+		bcs	rangeerr	; Bereichsfehler

+xposok:		cpy	#$C0		; ypos >= 192 ?

+		bcs	rangeerr	

+

+		pha			; xpos (HIGH) retten

+		tya

+		pha

+

+; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7

+

+		lsr			; ypos DIV 8

+		lsr

+		lsr

+		asl			; Fuer Tabellenzugriff * 2 (Bit 0 = 0)

+		tay

+		lda	rowstart,y	; Tabelle der Zeilenanfaenge

+		sta	address

+		lda	rowstart+1,y

+		clc

+		adc	pagebase

+		sta	address+1

+		pla			; ypos

+		and	#07		; MOD 8

+		eor	#07		; y = 0 ist unten links

+		asl			; * 4 (* 256)

+		asl			; Carry is cleared

+		adc	address+1

+		sta	address+1

+		pla			; xpos (HIGH) --> Y

+		tay

+		txa			; xpos (LOW) --> A

+		jsr	divide7		; A/Y --> A (Quotient), X (Remainder)

+		clc

+		adc	address

+		sta	address

+		bcc	calcret

+		inc	address+1

+		clc			; Carry cleared = ok

+calcret:	rts

+

+;-----------------------------------------------------------------------------

+;

+;		N E G 

+;		Vorzeichenwechsel

+;		Eingang/Ausgang:	A/X (HIGH/LOW)

+;-----------------------------------------------------------------------------

+

+NEG:		pha

+		txa

+		eor	#$FF

+		clc

+		adc	#01

+		tax

+		pla

+		eor	#$FF

+		adc	#00

+		rts

+

+;---------------------------------------------------------------------------

+;

+;		D I V I D E 7

+;		Division durch 7 mit Rest

+;		Eingang:	A: Low, Y: High (Nur 0 oder 1)

+;		Ausgang:	A: Quotient (Auch in quotient)

+;				X: Rest

+;--------------------------------------------------------------------------

+

+DIVIDE7:

+		ldx	#00		; Quotient Schieberegister loeschen

+		stx	quotient

+		ldx	#$E0		; 224 = 7 * 2^5 als Startwert

+		stx	divmask

+		ldx	#06		; Anzahl Verschiebungen

+		cpy	#01		; Zahl > 255 ?

+		bne	shiftloop	; Carry is set

+		inc	quotient

+		adc	#1F		; (Zahl MOD 256) + 32

+		bne	shift2loop	; Erste Subtraktion ueberspringen

+

+shiftloop:	sec

+		sbc	divmask		; Probeweise subtrahieren

+		php			; Borrow merken

+		rol	quotient	; Borrow in quotient rotieren

+		plp

+		bcs	shift2loop

+		adc	divmask		; Falls zuviel subtrahiert wieder add.

+shift2loop:	lsr	divmask		; Dann nur noch die Haelfte subtr.

+		dex

+		bne	shiftloop

+		tax			; Rest der Division

+		lda	quotient	; Quotient

+		rts

+

+;----------------------------------------------------------------------------

+;

+;		P O I N T

+;		Setzt/Loescht Punkt an bestimmter Position

+;		Eingang:	Position in xpos/ypos

+;				Linepattern in pattern

+;				Farbmaske in colormask

+;				Bitmodus in bitmode

+;---------------------------------------------------------------------------

+

+;DOPOINT:

+;		ldy	bitmode

+;		bpl	patternres	; Always

+

+POINT:

+		ldy	bitmode

+		asl	pattern

+		rol	pattern+1

+		bcs	patternset

+		cpy	#03		; Copymodus

+		bne	pointret	; Keine Aktion

+		ldy	#01		; Loeschen

+		bne	patternres	; Always

+

+patternset:	inc	pattern		; 1 links im pattern setzen

+patternres:	sty	tempmode	

+		lda	ypos+1

+		bne	pointret

+		lda	xpos+1

+		ldx	xpos

+		ldy	ypos

+;MAKEDOT:	

+		jsr	calcaddr	; Punktaddresse berechnen

+		bcs	pointret	; Ausserhalb des Bildschirms

+		ldy	#00

+		lda	(address),y

+		ldy	tempmode	

+		bne	mode1

+

+mode0:		ora	bitmask,x	; Modus 0 = setzen

+		bcc	setcolor

+

+mode1:		dey

+		bne	mode2

+		and	notbitmask,x	; Modus 1 = loeschen

+		bcc	setcolor

+

+mode2:		dey

+		bne	mode0		; Modus 3 (copy) wie Modus 0

+		eor	bitmask,x	; Modus 2 = invertieren

+		bcc	setcolor

+

+setcolor:	ldy	#00

+		and	#7F		; Altes Farbbit loeschen

+		ora	colormask	; Farbbit neu setzen

+		sta	(address),y	; Graphikbyte zurueckschreiben

+pointret:	rts

+

+

+;-----------------------------------------------------------------------------

+;	Drawthick zeichnet eine dicke Linie

+

+drawthick:

+		lda	param1

+		pha

+		lda	param1+1

+		pha			; to-pos retten

+		lda	param2

+		pha

+		lda	param2+1

+		pha

+

+		lda	savepattern

+		pha

+		lda	savepattern+1

+		pha

+		lda	pattern		; Linetype auf Startwert

+		sta	savepattern

+		lda	pattern+1

+		sta	savepattern+1

+

+		dec	thick

+

+;	x- oder y- Richtung feststellen:

+;	x direction := abs (xto - xfrom) > abs (yto - yfrom)

+

+		lda	param1

+		sec

+		sbc	xpos

+		tax

+		lda	param1+1

+		sbc	xpos+1

+		bcs	drawthick1

+		jsr	NEG		; Absolutwert (A/X)

+drawthick1:	sta	dx+1

+		stx	dx

+

+		lda	param2

+		sec

+		sbc	ypos

+		tax

+		lda	param2+1

+		sbc	ypos+1

+		bcs	drawthick2

+		jsr	NEG		; Absolutwert (A/X)

+drawthick2:	pha

+		txa

+		sec

+		sbc	dx

+		pla

+		sbc	dx+1		; Nur das Vorzeichen wichtig

+		pha			; xdirection, wenn A < 0

+

+;	Start- und Endpunkt der mittleren Linie berechnen

+

+		bpl	drawthick3	; y direction

+

+; start.x := xfrom - thick x  ; to.x := xto + thick x

+; start.y := yfrom            ; to.y := yto

+; thick x : IF xto < xfrom THEN -thick ELSE +thick FI

+		

+		lda	param1

+		sec

+		sbc	xpos		; xto - xfrom 

+		lda	param1+1

+		sbc	xpos+1

+		bcs	drawthick4	; xto >= xfrom (xto-xfrom >= 0)

+					; xto < xfrom

+		lda	xpos		; Carry is cleared

+		adc	thick

+		sta	xa		; start.x

+		lda	xpos+1

+		adc	#0

+		sta	xa+1

+

+		lda	param1		; to.x

+		sec

+		sbc	thick

+		sta	xb

+		lda	param1+1

+		sbc	#0

+		sta	xb+1

+		jmp	drawthick5

+

+drawthick4:

+		lda	xpos		; Carry is set

+		sbc	thick

+		sta	xa

+		lda	xpos+1

+		sbc	#0

+		sta	xa+1

+

+		lda	param1

+		clc

+		adc	thick

+		sta	xb

+		lda	param1+1

+		adc	#0

+		sta	xb+1

+

+drawthick5:

+;	start.y := ypos ; to.y := param2

+		lda	ypos

+		sta	ya

+		lda	ypos+1

+		sta	ya+1

+		lda	param2

+		sta	yb

+		lda	param2+1

+		sta	yb+1

+		jmp	drawthick8

+

+drawthick3:				; x direction

+

+; start.x := xfrom           ; to.x := xto

+; start.y := yfrom - thick y ; to.y := yto + thick y

+; thick y : IF yto < yfrom THEN -thick ELSE +thick FI

+

+		lda	param2

+		sec

+		sbc	ypos		; yto - yfrom 

+		lda	param2+1

+		sbc	ypos+1

+		bcs	drawthick6	; yto >= yfrom (yto-yfrom >= 0)

+					; yto < yfrom

+		lda	ypos		; Carry is cleared

+		adc	thick

+		sta	ya		; start.y

+		lda	ypos+1

+		adc	#0

+		sta	ya+1

+

+		lda	param2		; to.y

+		sec

+		sbc	thick

+		sta	yb

+		lda	param2+1

+		sbc	#0

+		sta	yb+1

+		jmp	drawthick7

+

+drawthick6:

+		lda	ypos		; Carry is set

+		sbc	thick

+		sta	ya

+		lda	ypos+1

+		sbc	#0

+		sta	ya+1

+

+		lda	param2

+		clc

+		adc	thick

+		sta	yb

+		lda	param2+1

+		adc	#0

+		sta	yb+1

+

+drawthick7:

+;	start.x := xpos ; to.x := param1

+		lda	xpos

+		sta	xa

+		lda	xpos+1

+		sta	xa+1

+		lda	param1

+		sta	xb

+		lda	param1+1

+		sta	xb+1

+

+;------

+;	FOR diff FROM -thick TO thick REP drawsingl PER

+

+drawthick8:

+		ldx	thick

+		lda	#0

+		jsr	NEG		; -thick

+		sta	areg+1

+		stx	areg		; = diff

+

+drawthick11:

+		ldx	areg

+		lda	areg+1

+		bne	drawthick9

+		cpx	thick		; > +thick ?

+		beq	drawthick9

+		bcc	drawthick9

+		

+;	PER ; restore pattern

+

+		pla			; x direction

+		inc	thick

+		pla

+		sta	savepattern+1

+		sta	pattern+1

+		pla

+		sta	savepattern

+		sta	pattern

+		pla

+		sta	param2+1		; To-Pos restoren

+		pla

+		sta	param2

+		pla

+		sta	param1+1

+		pla

+		sta	param1

+		lda	param1

+		sta	xpos

+		lda	param1+1

+		sta	xpos+1

+		lda	param2

+		sta	ypos

+		lda	param2+1

+		sta	ypos+1

+		rts

+

+;	singlevector:

+

+drawthick9:

+		pla

+		pha			; xdirection ?

+		bpl	drawthick10	; y direction

+

+; move (start.x, start.y-diff) ;

+; draw (to.x, to.y-diff) ;

+

+		lda	xa

+		sta	xpos

+		lda	xa+1

+		sta	xpos+1		; xpos := start.x

+		lda	ya

+		sec

+		sbc	areg

+		sta	ypos

+		lda	ya+1

+		sbc	areg+1

+		sta	ypos+1		; ypos := start.y - diff

+		jsr	move_x

+		

+		lda	xb		; xto := to.x

+		sta	param1

+		lda	xb+1

+		sta	param1+1

+		lda	yb		; yto := to.y - diff

+		sec

+		sbc	areg

+		sta	param2

+		lda	yb+1

+		sbc	areg+1

+		sta	param2+1

+		jsr	drawsglvec	; Linie von x/ypos nach param1/2

+		jmp	drawthick12

+

+drawthick10:

+

+; move (start.x + diff, start.y) ;

+; draw (to.x + diff, to.y) ;

+

+		lda	xa

+		clc

+		adc	areg

+		sta	xpos		; xpos := start.x + diff

+		lda	xa+1

+		adc	areg+1

+		sta	xpos+1

+		lda	ya		; ypos := start.y

+		sta	ypos

+		lda	ya+1

+		sta	ypos+1

+		jsr	move_x

+

+		lda	xb

+		clc

+		adc	areg		; xto := to.x + diff

+		sta	param1

+		lda	xb+1

+		adc	areg+1

+		sta	param1+1

+

+		lda	yb

+		sta	param2

+		lda	yb+1		; yto := to.y

+		sta	param2+1

+		jsr	drawsglvec	; Linie von x/ypos nach param1/2

+

+;	NEXT diff

+

+drawthick12:	

+		inc	areg

+		bne	drawthick13

+		inc	areg+1

+drawthick13:	jmp	drawthick11	; diff INCR 1

+		

+		

+;-----------------------------------------------------------------------------

+;

+;		D R A W

+;		Linie zwischen zwei Punkten zeichnen

+;		Eingang:	FROM-Position in xpos/ypos

+;				TO-Position in param1/param2

+;				Attribute in bitmode,pattern,colormask

+;-----------------------------------------------------------------------------

+

+DRAW:

+

+;	X-Vektorrichtung bestimmen

+;	dx := xto - xfrom ; right := sign (dx) ; dx := ABS dx

+

+		lda	thick

+		bne	draw1

+		rts			; Unsichtbare Linie

+draw1:		

+		cmp	#1

+		beq	drawsglvec	; Eine Linie Zeichnen

+		jmp	drawthick

+

+drawsglvec:

+		ldy	#00		; Vorzeichen fuer right: positiv

+		lda	param1		; xto (LOW)

+		sec

+		sbc	xpos		; xfrom (LOW)

+		tax

+		lda	param1+1	; xto (HIGH)

+		sbc	xpos+1		; xfrom (HIGH)

+		bpl	dxpositiv

+		jsr	NEG		; dx := -dx

+		dey			; Vorzeichen fuer right: negativ

+dxpositiv:	sta	dx+1

+		stx	dx

+		sty	right

+

+;	Y-Vektorrichtung bestimmen

+;	dy := yto - yfrom ; up := sign (dy) ; dy := ABS dy

+

+		ldy	#00		; Vorzeichen fuer up: positiv	

+		lda	param2		; yto

+		sec

+		sbc	ypos		; yfrom

+		tax

+		lda	param2+1

+		sbc	ypos+1

+		bpl	dypositiv

+		jsr	NEG		; dy := -dy

+		dey			; Vorzeichen fuer up: negativ

+dypositiv:	sta	dy+1

+		stx	dy

+		sty	up

+

+; init vectorloop

+

+		ldx	#00

+		stx	olderror

+		stx	olderror+1	; olderror := 0

+		ldx	#xpos		; xpointer zeigt auf xpos

+		stx	xpointer

+		ldx	#ypos

+		stx	ypointer	; ypointer zeigt auf ypos

+

+;	dy > dx   ==>   dx - dy < 0   ==> Parameter vertauschen

+

+		lda	dx

+		sec

+		sbc	dy		; Ergebnis unwichtig, nur Carry

+		lda	dx+1		; dx (HIGH)

+		sbc	dy+1		; dy (HIGH)

+		bpl	dy_lsequal_dx

+

+;	Parameter vertauschen

+

+		lda	xpointer	; xpointer und ypointer vertauschen

+		ldx	ypointer

+		stx	xpointer

+		sta	ypointer

+

+		lda	up		; up und right vertauschen

+		ldx	right

+		stx	up

+		sta	right

+

+		lda	dx		; dx (LOW) und dy (LOW) vertauschen

+		ldx	dy

+		stx	dx

+		sta	dy

+

+		lda	dx+1		; dx (HIGH) und dy (HIGH) vertauschen

+		ldx	dy+1

+		stx	dx+1

+		sta	dy+1

+

+dy_lsequal_dx:				; vector(xpos, ypos, dx, dy, right, up)

+

+;	uprighterror := dy - dx ; righterror = dy

+

+		lda	dy

+		sec

+		sbc	dx

+		sta	uprighterror

+		lda	dy+1

+		sbc	dx+1

+		sta	uprighterror+1

+

+;	Schleife: dx DECR 1

+

+nextpixel:	jsr	POINT		; POINT (xpos, ypos)

+		lda	dx		; dx = counter = 0 ?

+		ora	dx+1

+		bne	do_one_step

+		rts			; Ende der Vektorloop

+

+do_one_step:	

+		ldx	xpointer	; Referenz auf xpos oder ypos

+		bit	right		; right < 0 ?

+		bpl	rightstep	; sonst leftstep

+;leftstep:

+		lda	0,x		; xpos-Referenz DEC 1

+		bne	xposdec1

+		dec	1,x		; Highbyte von xpos

+xposdec1:	dec	0,x		; Lowbyte von xpos

+		jmp	detdirection

+rightstep:

+		inc	0,x

+		bne	detdirection

+		inc	1,x

+

+detdirection:

+

+;	IF abs (olderror + righterror) < abs (olderror + uprighterror)

+;		THEN do_right_step ELSE do_upright_step FI

+

+;	abs (olderror + uprighterror) = abs1

+

+		lda	olderror

+		clc

+		adc	uprighterror

+		tax

+		lda	olderror+1

+		adc	uprighterror+1

+		bpl	abs1positiv

+		jsr	NEG		; abs1 := -abs1 (A=HIGH, Y=LOW)

+abs1positiv:	stx	temporary	; Fuer spaetere Subtraktion merken

+		sta	temporary+1

+		

+;	abs (olderror + righterror) = abs2

+

+		lda	olderror

+		clc

+		adc	righterror

+		tax

+		lda	olderror+1

+		adc	righterror+1

+		bpl	abs2positiv

+		jsr	NEG		; abs2 := -abs2 (A=HIGH, X=LOW)

+abs2positiv:

+		tay			; abs2 (HIGH) retten

+		txa			; abs2 (LOW) --> A

+		sec

+		sbc	temporary	; abs1 (LOW) 

+		tya			; Nur Carrybit wesentlich

+		sbc	temporary+1	; abs1 (HIGH) 

+		bmi	do_right_step

+

+;do_upright_step:

+

+;	ypos INCR up

+

+		ldx	ypointer

+		bit	up		; Vorzeichen von up

+		bpl	yposinc1

+

+		lda	0,x		; ypointer enthaelt Offset ab xpos

+		bne	yposdec1

+		dec	1,x

+yposdec1:	dec	0,x

+		jmp	xyerror

+

+yposinc1:	inc	0,x

+		bne	xyerror

+		inc	1,x

+

+xyerror:	

+

+;	olderror INCR uprighterror

+

+		lda	olderror

+		clc

+		adc	uprighterror

+		sta	olderror

+		lda	olderror+1

+		adc	uprighterror+1

+		sta	olderror+1

+		jmp	dxdec1

+

+do_right_step:

+

+;	olderror INCR righterror

+

+		lda	olderror

+		clc

+		adc	righterror

+		sta	olderror

+		lda	olderror+1

+		adc	righterror+1

+		sta	olderror+1

+

+dxdec1:

+		lda	dx

+		bne	dxdec

+		dec	dx+1

+dxdec:		dec	dx

+

+		jmp	nextpixel		; zum Schleifenanfang

+

+;--------------------------------------------------------------------------

+;	Muster fuer GFILL:

+

+muster:

+		.RADIX	2

+		DB	11111111	; 0: gefuellt

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+

+		DB	10101010	; 1: Halb

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+

+		DB	11111111	; 2: Waagerecht (grob)

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+

+		DB	11111111	; 3: Waagerecht (fein)

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+

+		DB	10001000	; 4: Senkrecht (grob)

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+

+		DB	10101010	; 5: Senkrecht (fein)

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+

+		DB	11111111	; 6: Gerades Raster (grob)

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	11111111	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+

+		DB	11111111	; 7: Gerades Raster (fein)

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+

+		DB	10001000	; 8: Links Schraffur

+		DB	00010001	

+		DB	00100010	

+		DB	01000100	

+		DB	10001000	

+		DB	00010001	

+		DB	00100010	

+		DB	01000100	

+

+		DB	10001000	; 9: Rechts Schraffur

+		DB	01000100	

+		DB	00100010	

+		DB	00010001	

+		DB	10001000	

+		DB	01000100	

+		DB	00100010	

+		DB	00010001	

+

+		DB	10001000	; 10: Schraeges Gitter

+		DB	01010101	

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+		DB	01010101	

+		DB	00100010	

+		DB	01010101	

+

+		DB	10101010	; 11: Punktraster

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+

+		DB	11111111	; 12: Mauer

+		DB	01000000	

+		DB	01000000	

+		DB	01000000	

+		DB	11111111	

+		DB	00000100	

+		DB	00000100	

+		DB	00000100	

+

+		DB	00100010	; 13: Korb

+		DB	01010101	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	01010101	

+		DB	00100010	

+		DB	00100010	

+

+		DB	00000000	; 14: Wellenlinie

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+		DB	00000000	

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+

+;usermuster:

+		DB	10000000	; 15: User (Default: Zickzack)

+		DB	01000001	

+		DB	00100010	

+		DB	00010100	

+		DB	00001000	

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+

+		.RADIX	16

+

+;----------------------------------------------------------------------------

+;	T A B E L L E N

+;----------------------------------------------------------------------------

+

+bitmask:	db	$01, $02, $04, $08, $10, $20, $40, $80

+notbitmask:	db	$FE, $FD, $FB, $F7, $EF, $DF, $BF, $7F

+

+;	Graphikzeilenanfaenge, Ypos 0 ist unten

+

+rowstart:	

+		dw	03D0, 0350, 02D0, 0250

+		dw	01D0, 0150, 00D0, 0050

+

+		dw	03A8, 0328, 02A8, 0228

+		dw	01A8, 0128, 00A8, 0028

+

+		dw	0380, 0300, 0280, 0200

+		dw	0180, 0100, 0080, 0000

+

+		.printx 'Ende'

diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC
new file mode 100644
index 0000000..b7f25f4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC
@@ -0,0 +1,202 @@
+		TITLE	EUMEL-SHard Graphikroutinen, 64180-Teil

+

+;		RUC64180 auf Basis108

+;		19.05.86, Michael Staubermann

+;		Ueberarbeitet: 11.01.87

+

+		GLOBAL	GMOVE, GDRAW, GTEST, GCTRL

+		GLOBAL	GTRANS, GCLR, GFILL, GRAFIO

+;

+		EXTERNAL WTEND, MEMDMA, HGOP

+

+		INCLUDE HD64180.LIB

+		.LIST

+		CSEG

+

+CTRLMOVE	EQU	0

+CTRLDRAW	EQU	1

+CTRLTEST	EQU	2

+CTRLCTRL	EQU	3

+CTRLCLR		EQU	4

+CTRLFILL	EQU	5

+CTRLTRANS	EQU	6

+

+

+TASK		EQU	0F080H	; Task fuer 6502

+RESULT		EQU	0F081H	; Subtask und Ergebnis

+PARAM1		EQU	0F082H	; xpos oder Parameter

+PARAM2		EQU	0F084H	; ypos oder Linepattern

+

+;...........................................................................

+;

+;	M O V E

+;

+;	Startposition fuer DRAW setzen

+;	Es findet keine Bereichspruefung statt

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+GMOVE:

+		LD	B,CTRLMOVE

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	D R A W

+;

+;	Linie von Startposition bis zur uebergebenen Position zeichnen

+;	Ausserhalb des Bildschirms wird nicht gezeichnet

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+GDRAW:

+		LD	B,CTRLDRAW

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	T E S T B I T

+;

+;	Pruefen, ob Punkt gesetzt

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+;	Ausgang: BC = 255 : Position ausserhalb des gueltigen Bereichs

+;		      sonst: Bit 0 = Zustand (0 = geloescht, 1 = gesetzt)

+;			     Bit 7 = Farbe (1 = Gelb, 0 = Violett)

+;

+GTEST:

+		LD	B,CTRLTEST

+		JR	GRAPHIK

+

+;...........................................................................

+;

+;	C T R L

+;

+;	Graphikparameter setzen

+;

+;	Eingang:  DE = Steuerbits:

+;			Bit 0: 0 = Textmode, 1 = Graphikmode

+;			Bit 1: 0 = Sichtbare Seite 0, 1 = Sichtbare Seite 1

+;			Bit 2: 0 = Bearbeitete Seite 0, 1 = Bearbeitete Seite 1

+;			Bit 3,4: 0 = OR, 1 = NAND, 2 = XOR Zeichnen

+;			Bit 5: 0 = Full Graphics, 1 = Mixed Graphics

+;			Bit 6: 0 = Pattern in HL, 1 = Letztes DRAW Pattern

+;					fuer Linetype benutzen

+;			Bit 7: 1 = Gelb, 0 = Violett

+;		 HL = Linetype Pattern, wenn Bit 6 = 0

+;

+GCTRL:

+		LD	B,CTRLCTRL

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	C L E A R

+;

+;	Graphikseite mit einem Fuellzeichen loeschen

+;

+;	Eingang: DE = Page (0..3)

+;		 HL = Fuellzeichen (Byte in L)

+;

+GCLR:

+		LD	B,CTRLCLR

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	F I L L

+;

+;	Umrandete Flaeche fuellen

+;

+;	Eingang: DE = xpos

+;		 HL = ypos

+GFILL:

+		LD	B,CTRLFILL

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	T R A N S

+;

+;	Transportiert (kopiert) eine Graphikseite in eine andere

+;

+;	Eingang: DE = 'from'-Page (0..3)

+;		 HL = 'to'-Page (0..3)

+GTRANS:

+		LD	B,CTRLTRANS

+

+GRAPHIK:	

+		LD	A,B		; Subtasknummer

+		CALL	WTEND		; Busy warten, da in IOCONTROL

+		POP	HL

+		PUSH	HL		; Zweiter Parameter

+

+		DI

+		IN0	B,(CBR)		; Alte MMU-Einstellung merken

+		LD	C,51H		; Basisspeicher Page 0

+		OUT0	(CBR),C

+

+		LD	(PARAM1),DE	; 1. Parameter

+		LD	(PARAM2),HL	; 2. Parameter

+

+		LD	L,7		; 6502-Task: Graphik

+		LD	H,A		; Subtask

+		LD	(TASK),HL

+		LD	C,0		; Als 'ok' vorbesetzen

+		CP	CTRLTEST	; Muss auf Resultat gewartet werden ?

+		JR	NZ,TASKEND

+

+WAITTEND:	LD	A,(TASK)	; Darf intensiv auf Taskende warten

+		AND	A

+		JR	NZ,WAITTEND

+		LD	A,(RESULT)

+		LD	C,A

+

+TASKEND:	OUT0	(CBR),B		; Alte MMU-Einstellung wiederherstellen

+		EI

+		POP	HL

+		LD	B,0

+		RET

+

+;..............................................................................

+;

+;	G R A F I O 

+;	Blockin/Blockout fuer Graphikpage			

+;

+;	Eingang: DE = Blocknummer : 0..15= Page 0 (ggf. sichtbar)

+;				   16..31= Page 1 (ggf. sichtbar)

+;				   32..47= Page 2 (nur durch Transfer)

+;				   48..63= Page 3 (nur durch Transfer)

+;

+;		 HL = Hauptspeicheraddresse

+;		 (HGOP) = 1 : Graphikseite --> Hauptspeicher

+;		 (HGOP) = 0 : Hauptspeicher --> Graphikseite

+;

+GRAFIO:

+	PUSH	AF

+	PUSH	DE

+

+	EX	DE,HL		; DE = log. Hauptspeicheradresse

+	LD	A,L

+	ADD	A		; HL * 512 + 2000H

+	ADD	A,20H

+	LD	H,A

+	LD	L,0

+	LD	BC,512		; Blockgroesse

+	LD	A,(HGOP)	; Transferrichtung

+

+	CALL	MEMDMA		; Block tranportieren

+

+	POP	DE

+	POP	AF

+	LD	BC,0		; Transfer fehlerfrei

+	RET

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB
new file mode 100644
index 0000000..5d733e4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB
@@ -0,0 +1,159 @@
+

+; HD64180-Macro-Library - 14.04.85

+

+	.z80

+	.xlist

+

+CNTLA0	equ	00h

+CNTLA1	equ	01h

+CNTLB0	equ	02h

+CNTLB1	equ	03h

+STAT0	equ	04h

+STAT1	equ	05h

+TDR0	equ	06h

+TDR1	equ	07h

+TSR0	equ	08h

+TSR1	equ	09h

+CNTR	equ	0ah

+TRDR	equ	0bh

+TMDROL	equ	0ch

+TMDROH	equ	0dh

+RLDROL	equ	0eh

+RLDROH	equ	0fh

+TCR	equ	10h

+TMDR1L	equ	14h

+TMDR1H	equ	15h

+RLDR1L	equ	16h

+RLDR1H	equ	17h

+SAR0L	equ	20h

+SAR0H	equ	21h

+SAR0B	equ	22h

+DAR0L	equ	23h

+DAR0H	equ	24h

+DAR0B	equ	25h

+BCR0L	equ	26h

+BCR0H	equ	27h

+MAR1L	equ	28h

+MAR1H	equ	29h

+MAR1B	equ	2ah

+IAR1L	equ	2bh

+IAR1H	equ	2ch

+BCR1L	equ	2eh

+BCR1H	equ	2fh

+DSTAT	equ	30h

+DMODE	equ	31h

+DCNTL	equ	32h

+IL	equ	33h

+ITC	equ	34h

+RCR	equ	36h

+CBR	equ	38h

+BBR	equ	39h

+CBAR	equ	3ah

+ICR	equ	3fh

+

+hdword	macro	x

+	if	'&X' eq 'BC'  or '&X' eq 'bc'

+ww	defl	0	; INIT mit 0, BC=0

+	else

+	if	'&X' eq 'DE'  or '&X' eq 'de'

+ww	defl	1

+	else

+	if	'&X' eq 'HL'  or '&X' eq 'hl'

+ww	defl	2

+	else

+	if	'&X' eq 'SP'  or '&X' eq 'sp'

+ww	defl	3

+	else

+	.printx 'HD-Word-Error'

+	endif

+	endif

+	endif

+	endif

+	endm

+

+

+hdreg	macro	x

+	ifidn	<X>,<(hl)>

+reg	defl	6

+	else

+	ifidn	<X>,<(HL)>

+reg	defl	6

+	else

+	if	'&X' eq 'B' or '&X' eq 'b'

+reg	defl	0

+	else 

+	if	'&X' eq 'C' or '&X' eq 'c'

+reg	defl	1

+	else 

+	if	'&X' eq 'D' or '&X' eq 'd'

+reg	defl	2

+	else 

+	if	'&X' eq 'E' or '&X' eq 'e'

+reg	defl	3

+	else 

+	if	'&X' eq 'H' or '&X' eq 'h'

+reg	defl	4

+	else 

+	if	'&X' eq 'L' or '&X' eq 'l'

+reg	defl	5

+	else 

+	if	'&X' eq 'A' or '&X' eq 'a'

+reg	defl	7

+	else

+	.printx	'HD-Reg Error'

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endm

+

+mlt	macro	x

+	hdword	x

+	db	0edh,4ch+ww*10h

+	endm

+

+slp	macro

+	db	0edh,076h

+	endm

+

+in0	macro	x,y

+	hdreg	x

+	db	0edh,reg*8,y

+	endm

+

+out0	macro	y,x

+	hdreg	x

+	db	0edh,reg*8+1,y

+	endm

+

+tst	macro	x		; Test register

+	hdreg	x

+	db	0edh,reg*8+4

+	endm

+

+otim	macro

+	db	0edh,83h

+	endm

+

+otimr	macro

+	db	0edh,93h

+	endm

+

+otdm	macro

+	db	0edh,8bh

+	endm

+

+otdmr	macro

+	db	0edh,9bh

+	endm

+

+tstio	macro	x

+	db	0edh,074h,x

+	endm

+

+; ENDE der HD64180-Macros

diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.COM b/system/shard-z80-ruc-64180/1.5/src/IINST.COM
new file mode 100644
index 0000000..332f731
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/IINST.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.PAS b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS
new file mode 100644
index 0000000..0bf5c91
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS
@@ -0,0 +1,21 @@
+PROGRAM installationsnummer_setzen ;

+ { M. Staubermann, 8.2.87 }

+

+VAR f : FILE ;

+    buffer : ARRAY[0..63] OF INTEGER ;

+BEGIN

+ assign (f, 'EUMEL.COM') ;

+ reset (f) ;

+ blockread (f, buffer, 1) ;

+ writeln ;

+ write ('Lizenznummer (GMD) : ', buffer[$23], #13) ;

+ write ('Lizenznummer (GMD) : ') ;

+ readln (buffer[$23]) ;

+ buffer[$24] := succ (buffer[$24]) ;

+ write ('Installationsnummer: ', buffer[$24], #13) ;

+ write ('Installationsnummer: ') ;

+ readln (buffer[$24]) ;

+ seek (f, 0) ;

+ blockwrite (f, buffer, 1) ;

+ close (f) ;

+END.

diff --git a/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC
new file mode 100644
index 0000000..6c2cdf1
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC
@@ -0,0 +1,636 @@
+	TITLE	INIMOD - Hardwareinitialisierung fuer EUMEL 1.8 auf RUC 180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	INIMOD: Initialisierung fuer  EUMEL 1.8 -> RUC 64180 Karte

+;

+;	Version 1.2 - 05.01.87 

+;		1.2 mit logischen und physischen Kanaelen

+;	Version 1.3 - 08.02.87

+;		1.4 - 27.05.87 Console-Texthardcopy m. SHIFT CTRl F12

+;		1.5 - CIO-Printer Haenger beseitigt

+vers	equ	105

+;

+;	Copyright (C) 1985, 86, 87 by ruc:

+;			1.7.3:Rainer Ellerbrake

+;			      Eggeberger Str. 12

+;			      4802 Halle (Westf.)

+;

+;			1.8.: Michael Staubermann

+;			      Moraenenstr. 29

+;			      4400 Muenster-Hiltrup

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	START, ZZZZZZ, ZZZZZD

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT

+	EXTERNAL INITS, SCCINIT

+	EXTERNAL RTCOK, TRAP, MEMDMA, SENDMSG

+	EXTERNAL ADLEISTE, MODECONF, URLK1, URLK2

+	EXTERNAL HDOFS, HDLAST, HGBLKS, CPMOFS, CPMLAST, CPMBLKS

+	EXTERNAL DES6502, PRG6502, LEN65, ST6502

+	EXTERNAL TIMER, CENTR, I6502, ERROR

+	EXTERNAL SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX

+;	

+;................................................................

+;

+;	Konstanten

+;

+;	Eumel Systemadressen

+;

+VECBASE	EQU	0A000H			; Basisadresse fuer JP-Vektoren

+;

+EU0BLKS	EQU	VECBASE+10H

+;

+ESTART	EQU	VECBASE+1EH		; EUMEL Systemstart

+;

+ELEISTE	EQU	VECBASE+21H

+;	

+ELLEN	EQU	VECBASE+36H-ELEISTE

+;

+;................................................................

+;

+;	andere Adressen

+;

+WINDOW	EQU	0F000H		; Anfangsadresse des 4K Windows

+LIMIT	EQU	WINDOW-1	; Obergrenze fuer EUMEL-Pufferbereich

+;SHUG	EQU	0100H		; SHard Code Anfang

+SHOG	EQU	1400H		; EUMEL 0 Anfang

+RESVEC	EQU	0F3F4H		; Pruefsumme Reset Vektor (CBR=51H)

+VPOINT	EQU	0F010H		; Pointer auf Hintergrund Volume

+;

+;	Adressen

+;

+BASE	EQU	WINDOW

+;

+STADR	EQU	BASE+01H

+TSK65	EQU	BASE+80H	;Task fuer 6502

+;

+;	Zeichen

+;

+CR	EQU	0DH		;Carriage Return

+LF	EQU	0AH		;Line Feed

+;

+;	sonstige Konstanten

+;

+CB1	EQU	0F0H		;Anfang Common Base 1 und Bank Base (log.)

+BOTLNG	EQU	40H		; Laenge des Bootstrapladers in Bloecken

+;

+CMN1T0	EQU	51H		;Common Area 1 auf 6502 Adr. 0

+CMN1T1	EQU	52H		;Common Area 1 auf 6502 Adr. $1000

+;

+	INCLUDE	PORTS.MAC

+;

+;-----------------------------------------------------------------------

+;	Bereich ab hier darf NACH dem Systemstart ueberschrieben werden

+;

+KANAL:	DEFB	0		; log. Kanal, der Systemstarturlader enthaelt

+

+SLEISTE:

+	DEFB	'SHARD           ' ; Identifikationstext

+	DEFW	8		; SHard-Interface-Version

+MODE:	DEFW	0		; Vortest-Modus, 	wird ueberschrieben

+ID4:	DEFW	0		; Lizenznummer des SHards,		"

+ID5:	DEFW	0		; Installationsnummer des SHards,	"

+ID6:	DEFW	0		; Reserviert f. SHard,			"

+ID7:	DEFW	8000+vers	; Frei f. SHard: SHard-Version

+	DEFW	0		; -

+	DEFW	0		; -

+	JP	SHOUT

+	JP	SHBIN

+	JP	SHBOUT

+	JP	SHIOCNT

+	JP	SHEND

+	JP	SHSINF

+	JP	SHSACC

+	DEFW	0		; -

+	DEFW	LIMIT		; obere Hauptspeicher-Grenze fuer EUMEL

+

+;----------------------------------------------------------------

+;

+;	System laden

+;

+SYSRD:

+	LD	HL,SHOG

+	LD	DE,10

+;

+RDSLOP:

+	PUSH	HL

+	PUSH	DE		;Adresse + Block retten

+;

+	LD	A,(KANAL)

+	CALL	SHBIN

+;

+	POP	DE

+	POP	HL

+	LD	A,C

+	AND	A

+	JR	NZ,RDSLOP	;Fehler -> Retry

+;

+	INC	H		;Adresse erhoehen

+	INC	H

+	INC	DE		;Blocknummer erhoehen

+	LD	A,(EU0BLKS)

+	ADD	10

+	CP	E		; Alle gelesen ?

+	JR	NC,RDSLOP	;Nein -> weiterlesen

+

+;	System wurde geladen

+;

+

+;	SHard muss sich die benoetigten Teile der EUMEL-Linkleiste retten

+;

+	DI

+

+	LD	HL,ELEISTE

+	LD	DE,ADLEISTE

+	LD	BC,ELLEN	; EUMEL-Linkleiste kopieren

+	LDIR

+;

+;	EUMEL starten

+;

+	LD	HL,SLEISTE	; SHard-Linkleiste

+	JP	ESTART		;EUMEL Lader starten

+;

+ZZZZZZ	EQU	$

+;

+;****************************************************************

+;

+;	S T A R T 

+;

+;	SHARD Initialisierung und Systemstart

+;

+;	1. Treiber initialisieren

+;	2. Startup Meldung ausgeben

+;	3. Interruptadressen setzen, Interrupt Modus setzen

+;	4. Urlader laden

+;	5. Systemstart

+;

+;	Bereich ab hier darf schon VOR dem Systemstart ueberschrieben werden

+;	(darf vom Urlader ueberschrieben werden)

+

+START:

+	DI

+	LD	SP,LIMIT	;obere Speichergrenze

+;

+;	Speicherkonfiguration setzen

+;

+	XOR	A		;Bank Area ab 0

+	OUT0	(BBR),A

+;

+	LD	A,CB1		;Common Area 1 ab log. F000, Bank Area ab 0

+	OUT0	(CBAR),A

+;

+	LD	A,83H		; Refresh Zyklus 2 Takte, alle 80 States

+	OUT0	(RCR),A

+;

+;	Startvektor deaktivieren

+;

+

+	LD	A,0C3H		; JP-Code

+	LD	(0),A		; JP-Code eintragen bei RESET/TRAP-Adr

+	LD	HL,TRAP		; Falls RESET oder TRAP: Info ' shard' 'TRAP'

+	LD	(1),HL		; Kein START, dieses Modul wird ueberschrieben

+

+	LD	A,51H		;Common Area 1 auf Apple Speicher setzen

+	OUT0	(CBR),A 

+;

+;	Durch Veraenderung der Pruefsumme des Reset-Vektors wird erreicht,

+;	dass bei Betaetigen von Reset immer ein Kaltstart ausgefuehrt wird

+;

+	LD	(RESVEC),A	;veraendert

+

+;

+;	Anfang und Ende des Harddisk Volumes (HG) eintragen

+;

+	LD	HL,(VPOINT)	;Pointer auf Tabelle

+	LD	A,H

+	AND	0F0H		;4K-Bereich bestimmen

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	ADD	A,51H		;Apple Speicher Anfangsoffset

+	OUT0	(CBR),A		;in MMU eintragen

+;

+	LD	A,H

+	OR	0F0H		;im 64180 Speicher ab F000H

+	LD	H,A

+;

+	LD	BC,3		;3 Byte kopieren

+	INC	HL

+	LD	DE,HDOFS

+	LDIR			;Anfang

+;

+;	Laenge des Bootstrapladers (SHARD) hinzuaddieren

+;

+	DEC	DE

+	LD	A,(DE)

+	ADD	A,BOTLNG	;Laenge in 256-Byte Pages

+	LD	(DE),A

+	DEC	DE

+	LD	A,(DE)

+	ADC	A,0

+	LD	(DE),A

+	DEC	DE

+	LD	A,(DE)

+	ADC	A,0

+	LD	(DE),A

+;

+	INC	HL

+	LD	C,3

+	LD	DE,HDLAST

+	LDIR			;Ende

+;

+	LD	A,51H

+	OUT0	(CBR),A

+;

+;	Hintergrund Blockanzahl bestimmen

+;

+	LD	HL,HDOFS+2

+	LD	DE,HDLAST+2	;Last-First ausrechnen

+	CALL	CALCSIZ

+	LD	(HGBLKS),HL	;Groesse eintragen, max. 32MB

+;

+;	CP/M-Volume Blockanzahl bestimmen

+;

+	LD	HL,CPMOFS+2

+	LD	DE,CPMLAST+2

+	CALL	CALCSIZ

+	LD	(CPMBLKS),HL

+;

+	CALL	INICIO		; CIO, incl. Interrupts initialisieren

+

+	CALL	INIINT		; Interrupt System starten

+

+	CALL	INITS		; SCSI-Controller initialisieren

+;

+	CALL	CHKRTC		; Flag fuer gueltige RTC-Werte setzen

+;

+;	Mode, ID laden

+;

+	LD	HL,MODECONF

+	LD	DE,MODE

+	LD	BC,8		; 3 ID-Felder, 1 Mode-Feld

+	LDIR

+

+	LD	HL,STARTUP	; Startupmeldung ausgeben

+	CALL	SENDMSG

+;

+;	Block 10 lesen (enthaelt EUMEL0-Linkleiste)

+;

+

+	LD	A,(URLK1)	; Kanal, auf dem der Urlader zuerst

+	CALL	NEXTKAN		; gesucht wird

+	JP	Z,SYSRD		; System von diesem Kanal laden

+

+	LD	A,(URLK2)	; Kanal, auf dem der Uralder dann gesucht

+	CALL	NEXTKAN		; wird

+	JP	Z,SYSRD		; von diesem Kanal laden

+

+	LD	HL,NOURL	;kein EUMEL Urlader

+	CALL	SENDMSG

+	DI

+	HALT

+

+NEXTKAN:

+	LD	(KANAL),A

+	LD	DE,0		; Default Typ

+	LD	BC,5		; IOCONTROL 'size'

+	CALL	SHIOCNT		; zum initialisieren

+	LD	A,B		; 0 Bloecke, Fehler

+	OR	C

+	JR	NZ,NEXTOK

+	INC	A		; NZ setzen, da vorher 0

+	RET

+

+NEXTOK:

+	LD	A,(KANAL)

+	LD	HL,VECBASE	; Hauptspeicher-Adresse

+	LD	DE,10		; Block 10 lesen

+	CALL	SHBIN

+

+	LD	A,C		; Fehlerrueckmeldung

+	AND	A		;erfolgreich ?

+	RET	NZ

+

+	JP	CKEUMEL		;Eumel Urlader ?

+

+;................................................................

+;

+;	Berechnung der Groesse eines Volumes

+;	Eingang: HL = Zeiger auf letztes der 3 Byte Anfangs LUN/Adresse

+;		 DE = Zeiger auf letztes der 3 Byte Ende+1 LUN/Adresse

+;	Ausgang: HL = Anzahl 512-Byte Bloecke dieses Volumes

+;		 DE und A werden veraendert!

+;

+CALCSIZ:

+	LD	A,(DE)

+	SUB	(HL)

+	LD	C,A

+;

+	DEC	DE

+	DEC	HL

+	LD	A,(DE)

+	SBC	A,(HL)

+	LD	H,A

+	LD	L,C

+	SRL	H		;256 -> 512 Byte Bloecke

+	RR	L

+	RET

+;

+;................................................................

+;

+;	Ueberpruefen ob Block 10 den Text EUMEL enthaelt

+;

+;	Exit:	B=0! bei F=Zero

+;

+CKEUMEL:

+	LD	HL,VECBASE

+	LD	DE,EUMTXT

+	LD	B,5

+;

+CKLP:

+	LD	A,(DE)

+	CP	(HL)

+	INC	HL

+	INC	DE

+	RET	NZ

+	DJNZ	CKLP

+

+	RET

+;

+;................................................................

+;

+STARTUP:

+	DEFB	STUPLEN, 9, CR, LF, LF

+	DEFB	'   EUMEL auf HD64180 & 6502', CR, LF

+	DEFB	'   SHard-Interfaceversion 8', CR, LF

+	DEFB	'   Version 1.5 vom 26.06.87', CR, LF

+	DEFB	'    (c) 1985, 86, 87 by ruc', CR, LF

+	DEFB	'   '

+STUPLEN	EQU	$-STARTUP-1

+;

+NOURL:

+	DEFB	NOURLEN, CR, LF

+	DEFB	'EUMEL-Urlader nicht gefunden', CR, LF

+NOURLEN	EQU	$-NOURL-1

+;

+EUMTXT:

+	DEFB	'EUMEL'

+;

+;-----------------------------------------------------------------

+;

+;	C H K R T C

+;

+;	RTC-Werte auf Gueltigkeit ueberpruefen

+;

+

+CHKRTC:

+	LD	A,20H		; 2 (programmierte) eff. 3 Uhrenwaitstates

+	OUT	(DCNTL),A

+

+				; Testen, ob vernuenftige Werte vorhanden

+				; (BCD, Uhr laeuft, 24h-Modus, Bereiche ok)

+	XOR	A

+	LD	(RTCOK),A	; 'Nicht ok' vorbesetzen

+

+	IN0	A,(RTCRA)	; Register A der Uhr

+	AND	7FH

+	CP	20H		; 

+	JR	NZ,CALEND	; falscher Wert

+

+	IN0	A,(RTCRB)	; Register B der Uhr

+	CP	2

+	JR	NZ,CALEND	; falscher Wert

+

+	IN0	A,(RTCYR)	; Jahr < 87 ?

+	CP	87H

+	JR	C,CALEND

+

+	IN0	A,(RTCDY)	; Tag > 31

+	CP	32H		; 

+	JR	NC,CALEND

+	LD	H,A

+

+	IN0	A,(RTCMO)	; Monat > 12 ?

+	CP	13H

+	JR	NC,CALEND

+

+ 	OR	H

+	JR	Z,CALEND	; Monat oder Tag = 0 ?

+

+	IN0	A,(RTCM)

+	CP	60H

+	JR	NC,CALEND	; Minuten > 59 ?

+	

+	IN0	A,(RTCH)

+	CP	24H

+	JR	NC,CALEND	; Stunden > 23 ?

+	

+	LD	A,0FFH

+	LD	(RTCOK),A

+	

+CALEND:

+	XOR	A

+	OUT0	(DCNTL),A	; 0 (prog.) I/O Waitstates, 0 Memory Waitst.

+	RET

+

+;................................................................

+;

+;	I N I C I O

+;

+INICIO:

+

+;	CIO initialisieren

+

+	IN0	C,(CIOCTL)	;Dummy Read

+	LD	B,INILNG

+	LD	HL,INITAB	;CIO Initialisierungstabelle

+

+INILOP:

+	LD	C,(HL)		;Wert holen

+	OUT0	(CIOCTL),C	;und ausgeben

+	INC	HL

+	DJNZ	INILOP

+	RET

+

+;......................................................................

+;

+;	I N I I N T

+;

+;	Interrupt System starten

+;

+INIINT:

+	CALL	SCCINIT		;SCC initialisieren

+;

+;	6502-Programmstueck verschieben

+;

+	LD	A,1		; Transferrichtung 64180 --> 6502

+	LD	BC,LEN65	; Laenge des Programmstuecks

+	LD	DE,PRG6502	; Startadresse im log. 64180-Speicher

+	LD	HL,DES6502	; Destinationadresse im Basisspeicher

+	CALL	MEMDMA		; Bytes transferieren

+;

+	LD	B,(CBR)		; CBR merken

+

+	LD	A,CMN1T0

+	OUT0	(CBR),A

+

+	LD	HL,ST6502	;Startadresse 6502-Routinen

+	LD	(STADR),HL

+	LD	A,4		;6502 Teil starten

+	LD	(TSK65),A

+;

+	OUT0	(CBR),B		;CBR wieder zuruecksetzen

+;

+	LD	HL,VECTAB	; Interrupttabelle

+	LD	DE,18H		; Destination

+	LD	BC,ITABLEN	; Transferlaenge

+	LDIR

+

+	XOR	A		;interne Interrupts ab Vektor 0040

+	LD	I,A		;externe Interrupts ab 0018H

+	LD	A,40H

+	OUT0	(IL),A

+;

+	IM	2		; Fuer INT0 Interrupt Modus 2 benutzen

+	LD	A,3		;Enable Interrupt 0 and 1

+	OUT0	(ITC),A

+;

+;

+;	6502 Interrupts hardwaremaessig freigeben

+;

+	LD	A,0B0H		;CIO PC2 auf Low setzen

+	OUT0	(CIOCD),A

+	LD	A,0B4H		;CIO PC2 auf High setzen

+	OUT0	(CIOCD),A

+

+	EI

+

+	RET

+

+;...........................................................................

+;

+;	CIO Initialisierungs Tabelle

+;

+

+INITAB:

+;*	DEFB	0,1		;Set Reset Bit (raus: kein Recalibrate mehr)

+	DEFB	0,0		;Reset Reset Bit

+	DEFB	1,0		;Master configuration control

+

+;	SCSI-Interface-Leitungen

+

+	DEFB    20H,00000010B	;Port A Mode Reg.

+	DEFB	22H,01000010B	;Port A Data Path Polarity Reg.

+	DEFB	23H,10111101B	;Port A Data Direction Reg.

+	DEFB	24H,0		;Port A Special I/O Control

+	DEFB	25H,10101100B	;Port A Pattern Polarity

+	DEFB	26H,0		;Port A Pattern Transition

+	DEFB	27H,10101100B	;Port A Pattern Mask

+	DEFB	0DH,0		;Port A Data

+	DEFB	02H,18H		;Port A Interrupt Vector (** TEST **)

+	DEFB	08H,11100000B	;Port A Command: Clear IE

+	DEFB	08H,00100000B	;Port A Command: Clear IUS & IP

+

+;	General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske)

+

+	DEFB	06H,00000001B	;Port C Data Direction Reg.

+	DEFB	05H,00001000B	;Port C Data Path Polarity Reg.

+	DEFB	07H,0		;Port C Special I/O Control

+	DEFB	0FH,4		;Port C Data Register

+

+;	Centronics Interface

+

+	DEFB	28H,10010000B	;Port B Mode

+	DEFB	29H,01000000B	;Port B Handshake: Strobed

+	DEFB	09H,00100000B	;Port B Command: Clear IUS & IP

+	DEFB	2AH,0		;Port B Data Path Polarity

+	DEFB	2CH,0		;Port B Special I/O Control

+	DEFB	03H,30H		;Port B Interrupt Vektor

+

+;	Deskew Timer

+

+;	DEFB	1EH,00000010B	;Counter 3 Mode Specification

+;	DEFB	0CH,00100000B	;Counter 3 Command and Status

+;	DEFB	1AH,0		;Counter 3 Time Constant MSB

+;	DEFB	1BH,7		;Counter 3 Time Constant LSB (2,268 us)

+;	DEFB	0CH,11100100B	;Counter 3 Gate Enable

+

+;	Timer

+

+	DEFB	1CH,10000000B	;Counter/Timer 1 Mode Spec. Reg.

+	DEFB	1DH,10000000B   ;Counter/Timer 2 Mode Spec. Reg.

+	DEFB	0AH,00100000B	;Counter/Timer 1 Command: Clear IP & IUS

+	DEFB	0BH,00100000B	;Counter/Timer 2 Command: Clear IP & IUS

+	DEFB	16H,HIGH 38400  ;Time Constant 1 MSB

+	DEFB	17H,LOW 38400   ;Time Constant 1 LSB

+	DEFB	18H,0		;Time Constant 2 MSB, mit Timer 1 zus. 50ms

+	DEFB	19H,4		;Time Constant 2 LSB

+	DEFB	04H,18H		;Interrupt Vector Counters

+

+;	CIO-Interrupts freigeben

+

+	DEFB	01H,11110111B	;Master Config. Register

+	DEFB	00H,10000010B	;Master Interrupt Enable

+

+	DEFB	09H,11000000B	;Port B Command: Set IE

+

+	DEFB	0BH,11000110B	;Counter/Timer 2 Command: Set IE

+ 	DEFB	0AH,11100110B	;Counter/Timer 1 Command: Clear IE

+

+INILNG	EQU	$-INITAB

+

+;****************************************************************

+;

+;	Interrupt Vektor Tabelle, wird kopiert

+;

+VECTAB:

+	DEFW	TIMER	;18	Timer Interrupt (CIO Counter 2)

+	DEFW	ERROR	;1A

+	DEFW	ERROR	;1C

+	DEFW	ERROR	;1E

+	DEFW	SCCBTX	;20	SCC Transmitter Interrupt (Kanal B)

+	DEFW	ERROR	;22	SCC EXT/Status Interrupt (Kanal B) 

+	DEFW	SCCKB	;24	SCC Receive Char. available (Kanal B)

+	DEFW	SCCBER	;26	SCC Special Receive Condition (Kanal B)

+	DEFW	SCCATX	;28	SCC Transmitter Interrupt (Kanal A)

+	DEFW	ERROR	;2A	SCC EXT/Status Interrupt (Kanal A) 

+	DEFW	SCCKA	;2C	SCC Receive Char. available (Kanal A)

+	DEFW	SCCAER	;2E	SCC Special Receive Condition (Kanal A)

+	DEFW	CENTR	;30	Centronics Interface

+	DEFW	ERROR	;32

+	DEFW	ERROR	;34

+	DEFW	ERROR	;36

+	DEFW	ERROR	;38

+	DEFW	ERROR	;3A

+	DEFW	ERROR	;3C

+	DEFW	ERROR	;3E

+	DEFW	I6502	;40	INT1 = 6502 Interrupt

+	DEFW	ERROR	;42	INT2 = unbenutzt

+	DEFW	ERROR	;44	Timer Channel 0 = unbenutzt

+	DEFW	ERROR	;46	Timer Channel 1 = unbenutzt

+	DEFW	ERROR	;48	DMA Channel 0 = unbenutzt

+	DEFW	ERROR	;4A	DMA Channel 1 = unbenutzt

+	DEFW	ERROR	;4C	CSI/O = unbenutzt

+	DEFW	ERROR	;4E	ASCI Channel 0 = unbenutzt

+	DEFW	ERROR	;50	ASCI Channel 1 = unbenutzt

+

+ITABLEN	EQU	$-VECTAB

+;

+;.....................................................................

+

+ZZZZZD:	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/INT65.MAC b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC
new file mode 100644
index 0000000..55efcf6
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC
@@ -0,0 +1,411 @@
+	TITLE	INT65 - Interface 6502 <-> 64180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	INT65: Interface BASIS 6502 <-> 64180, Einstellungen fuer

+;	serielle Schnittstelle im BASIS 108

+;

+;	Version 0.4 - 25.11.85 / 11:00

+;	Version 0.5 - 23.12.86, M.Staubermann

+;	Version 0.6 - 14.01.86, Kanal 5 Flusskontrolle durch 6502

+;

+;	Copyright (C) 1985 by Rainer Ellerbrake

+;			      Eggeberger Str. 12

+;			      4802 Halle (Westf.)

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	ZGERL, TO6502, TO65WA, WTEND, RD6502

+	GLOBAL	BAUBAS, BITBAS, AFLOW5, EFLOW5, FRE65

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL WARTE

+;

+;................................................................

+;

+;	Konstanten

+;

+P065	EQU	51H		;Page 0 des 6502 einblenden

+PC65	EQU	5DH		;I/O-Bereich des 6502

+;

+TASK	EQU	0F080H

+PARAM	EQU	TASK+1

+;

+AFLG	EQU	0F09AH		; XON/XOFF - Ausgabeseitig: Bit 7 = 1

+EFLG	EQU	0F09BH		; Ausgabeseitiger Stopzustand: Bit 7 = 1

+;SFLG	EQU	0F09CH		; Stopzustand des Transmitters

+WAITFLG	EQU	0F09DH		; 6502 - Update-Synchro

+;

+PFREE	EQU	0F0E0H		; Word: Anzahl freie Bytes im Druckerspooler

+TFREE	EQU	0F0F0H		; Word: Anzahl freie Bytes im Transmitbuffer

+;

+SER_CMD	EQU	0F09AH		; Command Register 6551 BASIS

+SER_CTR	EQU	0F09BH		; Control Register 6551 BASIS

+;

+;

+	INCLUDE	PORTS.MAC

+;

+;****************************************************************

+;

+;	T O 6 5 0 2

+;

+;	6502 Task Aufruf

+;

+;	Eingang: L - Task-Nummer

+;		 H - Parameter

+;

+TO6502:

+	PUSH	AF

+	LD	A,I

+	PUSH	AF

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+;

+	LD	A,P065

+	OUT0	(CBR),A

+;

+;	Warten bis vorherige Task beendet ist

+;

+WRTTAS:

+	CALL	ZGERL

+	LD	A,(TASK)	;Task = 0: beendet	

+	AND	A

+	JR	NZ,WRTTAS

+;

+	LD	A,H

+	LD	(PARAM),A

+;

+	LD	A,L

+	LD	(TASK),A	;Task aufrufen

+;

+;	auf Ende wird erst beim naechsten Aufruf gewartet

+;

+	POP	AF

+	OUT0	(CBR),A		;zurueckschalten

+	POP	AF

+	JP	PO,NOEI

+;

+	EI

+NOEI:

+	POP	AF

+	RET

+;

+;----------------------------------------------------------------

+;

+;	T O 6 5 W A

+;

+;	Warten auf Beendigung des Task Aufrufs

+;	(EUMEL WARTE wird aufgerufen!!)

+;

+TO65WA:

+	PUSH	AF

+;

+;	Warten bis Task beendet ist

+;

+	

+WTTAS:

+	IN0	A,(CIOAD)

+	BIT	0,A

+	JR	Z,WTTA1		;Zugriff nicht erlaubt -> warten

+;

+	PUSH	HL

+	LD	HL,LOW TASK

+	CALL	RD6502		; Task-Byte in A

+	POP	HL

+

+	AND	A

+	JR	NZ,WTTA1

+	POP	AF

+	RET

+

+WTTA1:

+	CALL	WARTE

+;

+	JR	WTTAS

+;

+;----------------------------------------------------------------

+;

+;	W T E N D

+;

+;	Warten auf Beendigung des Task Aufrufs

+;

+WTEND:

+	PUSH	AF

+;

+;	Warten bis Task beendet ist

+;

+WTTAS1:

+	CALL	ZGERL

+;

+	PUSH	HL

+	LD	HL,LOW TASK

+	CALL	RD6502

+	POP	HL

+

+	AND	A

+	JR	NZ,WTTAS1

+;

+	POP	AF

+	RET

+

+;

+;----------------------------------------------------------------

+;

+;	Z G E R L

+;

+;	Auf Zugriffserlaubnis warten

+;

+;	keine Register veraendert

+;

+;

+;	Zugriff auf 6502-Speicher zulaessig ?

+;

+ZGERL:

+	PUSH	AF

+WAI65:

+	IN0	A,(CIOAD)

+	BIT	0,A

+	JR	Z,WAI65		;nicht erlaubt -> warten

+;

+	POP	AF

+	RET

+;

+;---------------------------------------------------------------

+;

+;	R D 6 5 0 2

+;	Byte aus 6520-Memory Adresse HL nach A lesen

+;

+;	Eingang: HL = Zeropage- oder I/O-Page-Adresse im 6502-Memory

+;	Ausgang: In A steht der Inhalt der Adresse

+;

+RD6502:

+	PUSH	BC

+	LD	B,A

+	LD	A,I

+	DI

+	PUSH	AF

+

+	IN0	A,(CBR)

+	LD	C,P065		; Bit 7 nicht gesetzt: Zeropage

+	BIT	7,H

+	JR	Z,RD6502B

+	LD	C,PC65		; Bit 7 gesetzt: I/O-Adresse

+RD6502B:			; Achtung: Nicht eindeutig!

+	OUT0	(CBR),C

+

+	LD	C,H

+	LD	H,0F0H

+	LD	B,(HL)

+	LD	H,C	

+

+	OUT0	(CBR),A

+

+	POP	AF

+	JP	PO,RD6502A

+	EI

+RD6502A:

+	LD	A,B

+	POP	BC

+	RET

+

+;----------------------------------------------------------------

+;

+;	Baudrateneinstellung fuer BASIS serielle Schnittstelle

+;

+;	Eingang: A - Kanalnummer (immer 5)

+;		 HL - Schluessel (s. Tabelle) (1..15)

+;		 Es werden korrekte Parameter vorausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BAUBAS:

+	PUSH	AF

+	DI

+				; Da nur I/O Zugriffe gemacht werden, braucht

+				; nicht auf Zugriffserlaubnis gewartet werden

+	IN0	A,(CBR)

+	PUSH	AF		;alte Einstellung retten

+	LD	A,PC65		;I/O-Bereich einblenden

+	OUT0	(CBR),A

+	LD	A,(SER_CTR)	;Control Register lesen

+	AND	0F0H		;Baudratenbits ausblenden

+	OR	L		;und neue Einstellung einfuegen

+	LD	(SER_CTR),A

+

+	POP	AF

+	OUT0	(CBR),A		;alten Bereich wieder einblenden

+EIRET:

+	EI

+	POP	AF

+	RET

+;

+;

+;------------------------------------------------------------------

+;

+;	F R E 6 5

+;	Freiplatz eines 6502-Ausgabepuffers erfragen

+;

+;	Eingang: A = Kanal (5, 6)

+;	Ausgang: HL veraendert, A veraendert

+;		 BC = Free Bytes

+;		 Carry set, Puffer leer

+;

+FRE65:

+	CP	5		; BASIS serielle Schnittstelle

+	LD	HL,TFREE	; Transmitbuffer

+	JR	Z,BASER

+	LD	HL,PFREE	; Druckerpuffer

+

+BASER:

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+	LD	A,51H

+	OUT0	(CBR),A		; Zeropage

+

+WAIUPD:

+	LD	A,(WAITFLG)

+	AND	A

+	JR	NZ,WAIUPD	; Warten, bis Update zuende

+

+	LD	C,(HL)		; Lowbyte Free

+	INC	HL

+	LD	B,(HL)		; Highbyte Free

+	INC	HL

+	LD	A,(HL)		; Lowbyte Size

+	INC	HL

+	OR	(HL)

+	LD	L,A

+

+	POP	AF

+	OUT0	(CBR),A

+	EI

+	LD	A,L

+	AND	A

+	RET	NZ		; Carry cleared, Puffer nicht leer

+	SCF			; Carry set, Puffer leer

+	RET

+

+;----------------------------------------------------------------

+;

+;	Stopbits, Datenbits, Parity fuer BASIS serielle Schnittstelle

+;

+;	Eingang: A - Kanalnummer (immer 5)

+;		 L - Schluessel

+;		 Es werden korrekte Parameter vorrausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BITBAS:

+	PUSH	AF

+	DI

+				; Da nur I/O Zugriffe gemacht werden, braucht

+				; nicht auf Zugriffserlaubnis gewartet werden

+	PUSH	HL

+	IN0	H,(CBR)

+	LD	A,PC65		; I/O-Bereich einblenden

+	OUT0	(CBR),A

+				; Stopbits und Datenbits setzen

+	LD	A,(SER_CTR)	; Control Register lesen

+	AND	1FH		; Datenbits Stopbits ausblenden

+	BIT	6,L		; 2 Stopbits ?

+	JR	Z,BITBAS1

+	SET	7,A

+BITBAS1:

+	BIT	0,L		; Bit 0 = 0, wenn 7 Datenbits (7-1 = 6)

+	JR	NZ,BITBAS2

+	SET	5,A		; 01 = 7 Datenbits, 00 = 8 Datenbits

+BITBAS2:

+	LD	(SER_CTR),A

+				; Parity setzen

+	LD	A,L

+	RLCA

+	RLCA

+	AND	01100000B

+	BIT	6,A

+	JR	Z,BITBAS3	; 00 = No, 01 = Odd, 10 = Even

+	SET	5,A

+BITBAS3:			; 00 = No, 01 = Odd, 11 = Even

+	LD	L,A

+	LD	A,(SER_CMD)

+	AND	0FH

+	OR	L		; Neue Parity Bits

+	LD	(SER_CMD),A

+

+	OUT0	(CBR),H		;alten Bereich wieder einblenden

+	POP	HL

+	JR	EIRET

+;

+;-----------------------------------------------------------------

+;

+;	A F L O W 5

+;	Ausgabeflusskontrolle einstellen

+;

+;	Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR

+;

+AFLOW5:

+	PUSH	AF

+	PUSH	HL

+	XOR	A

+	BIT	2,(HL)		; Ausgabeflusskontrolle ?

+	JR	Z,AFLOW5A

+	CALL	CALCF

+AFLOW5A:

+	LD	HL,AFLG

+EAFLOW:

+	PUSH	BC

+	DI

+	IN0	B,(CBR)

+	LD	C,51H

+	OUT0	(CBR),C

+	LD	(HL),A

+	OUT0	(CBR),B

+	EI

+	POP	BC

+	POP	HL

+	POP	AF

+	RET

+	

+CALCF:

+	BIT	0,(HL)

+	JR	Z,CALCF1

+	SET	7,A		; XON/XOFF

+CALCF1:

+	BIT	1,(HL)

+	JR	Z,CALCF2

+	SET	6,A		; DSR/DTR

+CALCF2:

+	RET

+

+;-----------------------------------------------------------------

+;

+;	E F L O W 5

+;	Eingabeflusskontrolle einstellen

+;

+;	Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR

+;

+EFLOW5:

+	PUSH	AF

+	PUSH	HL

+	XOR	A

+	BIT	3,(HL)		; EIngabeflusskontrolle ?

+	JR	Z,EFLOW5A

+	CALL	CALCF		; EUMEL --> 6502 Format

+EFLOW5A:

+	LD	HL,EFLG

+	JR	EAFLOW

+

+;-------------------------------------------------------------------

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC
new file mode 100644
index 0000000..ebff654
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC
@@ -0,0 +1,1292 @@
+

+	TITLE	Interrrupts fuer SHARD

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	Interruptmodul fuer EUMEL SHARD

+;

+;	Timer Handling, SCC Interrupts, 6502 Interrupts

+;	Buffer Manager

+;

+;	Version 0.9 vom 10.01.87 (Transmittinterrupts)

+;	Version 1.0, getestet (Ringpuffer korrigiert,

+;			20.01.87 - keine Interrupthaenger an Kanal 1/5 mehr)

+;		1.1 (27.05.87) Verlorener Timerinterrupt im Info/Vortest

+;			durch Korrektur von CHKINT (weniger oft aufgerufen)

+;               1.2 (26.06.87) Wieder rausgebaut, da bei mehr als 16 Zeichen im

+;			Eingabepuffer die Puffer-Auslesegeschwindigkeit stark

+;			sinkt.

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;			86/87, M. Staubermann

+;

+;****************************************************************

+;

+;	Globale Adressen

+;

+	GLOBAL	BAUSCC, BITSCC, SCCINIT, CLRCBUF 

+	GLOBAL	ESTOP, EGO, AFLOW

+	GLOBAL  I6502, TIMER, CENTR

+	GLOBAL	SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX

+	GLOBAL	PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB

+

+;

+;----------------------------------------------------------------

+;

+;	Externe Adressen

+;

+	EXTERNAL TIMEAD, IINTAD, SHUTUPAD

+	EXTERNAL IKANTAB, BLINKP, SWICUR, MEMDMA, FLWTYP

+	EXTERNAL AFLOW5, RD6502

+;

+;

+;----------------------------------------------------------------

+;

+	CSEG

+;

+;	Konstanten

+;

+CMN1T0	EQU	51H		;Common Area 1 auf 6502 Adr. 0

+CMN1T1	EQU	52H		;Common Area 1 auf 6502 Adr. $1000

+;

+XON	EQU	11H		; CTRL-Q

+XOFF	EQU	13H		; CTRL-S

+

+				; Bereich fuer Transmitbuffer im 6502-Speicher

+DBUF	EQU	0A000H

+SABUF	EQU	DBUF+1000H

+SBBUF	EQU	SABUF+0800H	; SABUF+SBBUF zusammen max. 4k in einem Window

+				; Offsets auf Kanal-Buffer-Tabellen

+SIZE	EQU	0		; aktuelle Groesse (Belegung) des Puffers

+BEG	EQU	2		; Pufferanfang (fest)

+READ	EQU	3		; Adresse des naechsten Out-Buffer-Zeichens

+WRITE	EQU	5		; Adresse des naechsten In-Buffer-Zeichens

+ENDE	EQU	7		; excl. Pufferende (fest)

+

+CPORT	EQU	8		; Controlport mit Statusregister

+XFLAG	EQU	9		; Bit 7 = 1: Transmitter stoppen

+				; Bit 6 = 1: XON/XOFF ausgabeseitig

+

+	INCLUDE	PORTS.MAC

+

+

+;----------------------------------------------------------------

+;

+;	6502-Adressen

+;

+

+BASE	EQU	0F000H		;Anfangsadresse 6502 Bereich

+IFLG	EQU	BASE+09EH	; Start/Stop Flag fuer 6502

+INTPAR1	EQU	BASE+0EAH	;Interrupt Parameter 1 (Kanal)

+INTPAR2	EQU	INTPAR1+1	;Interrupt Parameter 2 (Eingabezeichen)

+INTPAR3	EQU	INTPAR2+1	;Interrupt Parameter 3 (Fehlerbits)

+

+

+;-----------------------------------------------------------------

+;

+;	P H Y S L O G

+;	Umrechnung der physischen Kanalnummer in eine logische

+;

+;	Eingang: A = phys. Kanalnummer

+;	Ausgang: A = log. Kanalnummer

+;		 keine anderen Register veraendert

+;

+PHYSLOG:

+	PUSH	HL

+	ADD	A,IKANTAB	; Kanal phys. --> log. Umrechnen

+	LD	L,A

+	LD	H,0

+	LD	A,(HL)

+	POP	HL

+	RET

+

+;................................................................

+;

+;	Timer Interrupt Handler

+;

+;	wird durch CIO Timer 2 Interrupt aufgerufen

+;

+TIMER:

+	PUSH	AF

+;

+	LD	A,50		;50 ms pro Timerinterrupt

+	CALL	TIMEAD		;EUMEL timerinterrupt

+;

+	DI

+	LD	A,(CCOUNT)	;Cursor invertieren ?

+	DEC	A

+	JR	NZ,TIMER1

+;

+	IN0	A,(CIOAD)	; Cursor invertieren, wenn Zugriff erlaubt

+	BIT	0,A

+	JR	Z,TIMER2

+

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+	CALL	SWICUR		; Cursor invertieren

+	POP	BC

+	POP	DE

+	POP	HL

+

+TIMER2:

+	LD	A,(BLINKP)

+TIMER1:

+	LD	(CCOUNT),A

+

+	LD	A,0BH

+	OUT0	(CIOCTL),A	;Counter/Timer 2 Command

+	LD 	A,00100100B 	;Clear IP & IUS

+	OUT0	(CIOCTL),A

+

+	PUSH	IX

+	LD	IX,DRUCK

+	CALL	TXHANDLER	; Testen, ob Drucker haengt

+	POP	IX

+

+EINT:

+	POP	AF

+EINT1:

+	EI

+	RETI

+;

+;................................................................

+;

+;	I 6 5 0 2

+;

+;	6502 Interrupt Handler

+;

+I6502:

+	PUSH	AF

+	PUSH	BC

+	CALL	INT6502

+	POP	BC

+	JR	EINT

+

+INT6502:

+	PUSH	DE

+

+	LD	A,0B0H		; Reset Interrupt FF (Keine IRQ's mehr)

+	OUT0	(CIOCD),A

+

+	IN0	A,(CBR)		;Common Area 1 retten

+	PUSH	AF

+

+	LD	A,CMN1T0

+	OUT0	(CBR),A

+;

+	LD	BC,(INTPAR1)	; C = Kanalnummer, B = Eingabezeichen

+	LD	DE,(INTPAR3)	; E = Fehlerbits

+

+	XOR	A		; Interrupt quitieren

+	LD	(INTPAR1),A

+

+	POP	AF

+	OUT0	(CBR),A		;Common Area 1 zurueckschalten

+

+	LD	A,C

+	AND	A		;kein Auftrag ->

+	JR	Z,RET6502I

+

+	CP	40H

+	JR	NC,BREAK	; Sonderbehandlung

+

+	LD	C,E		; Fehlerbits

+

+	PUSH	AF

+

+	CALL	PHYSLOG

+	CALL	IINTAD		; EUMEL Inputinterrupt

+	DI

+

+	POP	BC		; Kanal in B

+	CP	1

+	JR	NZ,RET6502I	; noch Platz im Puffer

+

+	LD	A,B

+	CALL	ESTOP		; Eingabestop, reagiert sofort

+

+RET6502I:

+	POP	DE

+RET6502J:

+	LD	C,0B4H		; Reseteingang des 6502-IRQ-FF wieder auf High

+	OUT0	(CIOCD),C

+	RET

+

+

+BREAK:

+	POP	DE

+	CALL	RET6502J

+

+	CP	'S'		; Shutup ? (53H)

+	RET	NZ

+

+	CALL	EINT1		; Interrupts freigeben

+	JP	SHUTUPAD

+

+;-------------------------------------------------------------------

+;

+;	E F L W 5

+;	Kanal 5 Interrupt an 64180 stoppen/starten

+;	Reagiert sofort

+;

+;	Eingang: Bit 7(HL) = 1: Stop, = 0: Start

+;	Ausgang: BC veraendert

+;

+EFLW5:

+	LD	BC,7F80H	; B = AND-resetmaske, C = OR-setmaske

+	JR	EFLW15		; Bit 7 ist Flag

+

+;-------------------------------------------------------------------

+;

+;	E F L W 1

+;	Kanal 1 Interrupt an 64180 stoppen/starten

+;	Reagiert sofort

+;

+;	Eingang: Bit 7(HL) = 1: Stop, = 0: Start

+;	Ausgang: BC veraendert

+;

+EFLW1:

+	LD	BC,0BF40H	; Bit 6 ist Flag

+

+EFLW15:

+	PUSH	AF

+	LD	A,I

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+

+	LD	A,51H

+	OUT0	(CBR),A

+

+	LD	A,(IFLG)

+	AND	B		; "weiter"

+	BIT	7,(HL)

+	JR	Z,EFLWA

+	OR	C		; "stop" setzen

+EFLWA:	LD	(IFLG),A	; Stop/Weiter an 6502 weitergeben

+

+	POP	AF

+	OUT0	(CBR),A

+	JP	PO,EFLWB

+	EI

+EFLWB:

+	POP	AF

+	RET

+

+;********************************************************************

+;

+;	Ringpuffer - Verwaltung

+;

+;----------------------------------------------------------------

+;

+;	F R E E B U F

+;	freien Platz im Puffer berechnen

+;	(dies ist nicht immer die Anzahl der uebernehmbaren Zeichen!)

+;

+;	Eingang: IX = Zeiger auf Kanal-Puffer-Tabelle

+;	Ausgang: BC = Anzahl Bytes, die noch in den Puffer passen

+;		 Carry gesetzt: Puffer leer, sonst Puffer gefuellt

+;		 A veraendert

+;

+FREEBUF:

+	PUSH	HL

+	LD	A,(IX+ENDE)		; Konstante

+	SUB	(IX+BEG)

+	LD	H,A

+	LD	L,0

+

+	DI

+	LD	B,(IX+SIZE+1)

+	LD	C,(IX+SIZE)

+	EI

+

+	LD	A,B

+	OR	C

+	SCF				; Set carry, Puffer leer

+	JR	Z,FREEBUF1

+	AND	A

+	SBC	HL,BC			; Carry is cleared

+FREEBUF1:

+	LD	B,H

+	LD	C,L

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	P U T B U F

+;	Zeichenkette in Ausgabepuffer schreiben

+;

+;	Eingang: HL = Anfangsadresse der Zeichenkette

+;		 BC = Laenge der Zeichenkette

+;		 IX = Zeiger auf Kanal-Puffer-Tabelle

+;	Ausgang: BC = Anzahl der uebernommenen Zeichen

+;		 Carry set, alles uebernommen

+;		 HL, A veraendert

+;

+PUTBUF:

+	PUSH	BC

+	CALL	FREEBUF

+	DI

+	LD	A,B

+	OR	C

+	JR	NZ,PUTBUF1

+

+	PUSH	AF

+	CALL	TXHANDLER

+	POP	AF

+	EI

+

+	INC	SP		; POP BC, nichts uebernommen, Clear carry

+	INC	SP

+	RET

+

+PUTBUF1:

+	POP	BC

+

+	PUSH	DE

+	PUSH	HL		; Stringanfang im Hauptspeicher in HL

+

+	LD	H,(IX+READ+1)	; Lesezeiger in HL

+	LD	L,(IX+READ)

+	LD	D,(IX+WRITE+1)	; Schreibzeiger in DE

+	LD	E,(IX+WRITE)

+

+	LD	A,(IX+SIZE)	; Puffer leer ?

+	OR	(IX+SIZE+1)

+	JR	NZ,PUTBUF3

+

+	LD	D,(IX+BEG)

+	LD	E,0		; Beide Zeiger auf Pufferstart

+	LD	(IX+READ+1),D

+	LD	(IX+READ),E

+	LD	(IX+WRITE+1),D

+	LD	(IX+WRITE),E	; Weiter, ohne zu splitten

+	LD	L,E		; L := 0

+	LD	H,(IX+ENDE)

+

+PUTBUF3:

+				; DE, erste Position fuer String

+				; HL, letzte Position (excl.) fuer String

+	AND	A		; falls nicht HL = Pufferende

+	SBC	HL,DE

+	JR	C,PUTBUF2	; C, wenn Read < Write: String splitten

+				; Z kann nicht auftreten, da Puffer nicht voll

+

+PUTBUF9:			; BC := min (BC, HL)

+	LD	A,L		; HL enthaelt max. uebernehmbare Size

+	SUB	C		; BC enthaelt Eingangs-Stringlaenge

+	LD	A,H

+	SBC	B

+	JR	NC,PUTBUF4	; NC, alles uebernommen

+	LD	B,H		; C --> nur Puffersize uebernommen

+	LD	C,L

+

+PUTBUF4:

+	CCF			; Carry fuer EUMEL umdrehen

+

+	POP	HL		; Stringanfang in HL

+

+	PUSH	AF

+	CALL	PUTBUFA

+	CALL	TXHANDLER	; Ein Zeichen ausgeben, IP wird gesetzt

+	EI

+	POP	AF

+	POP	DE

+	RET

+

+PUTBUF2:			; String muss ggf. gesplittet werden

+	LD	H,(IX+ENDE)

+	XOR	A

+	LD	L,A

+	SBC	HL,DE		; HL enthaelt Size (immer > 0)

+	JR	PUTBUF9

+

+;----------------------------------------------------------------------

+;

+;	Teilstring in Puffer schreiben

+;	Eingang: Interrupts disabled

+;		 HL = Teilstringanfang

+;		 DE = Schreibzeiger

+;		 BC = Stringlaenge, die uebernommen werden soll

+;			(BC muss ok sein!)

+;	Ausgang: Nur BC ok

+;		 (DE = Schreibzeiger (korrigiert))

+;		 (HL = Teilstring + uebernommene Stringlaenge)

+;		 BC unveraendert

+;		

+PUTBUFA:

+	PUSH	HL

+	EX	DE,HL		; DE = Hauptspeicher, HL = 6502-Speicher

+	PUSH	BC		; merken fuer Ausgang

+	PUSH	HL		; Stringanfang in DE, Schreibzeiger in HL

+	LD	A,1		; Von DE (log.) nach HL(6502) kopieren

+	CALL	MEMDMA

+	POP	HL		; Schreibzeiger

+	POP	BC		; uebernommene Stringlaenge

+

+	ADD	HL,BC		; Stringlaenge addieren

+

+	LD	A,H

+	CP	(IX+ENDE)

+	JR	NZ,PUTBUFA2

+	LD	H,(IX+BEG)	; Schreibzeiger auf Pufferanfang setzen

+				; L war schon 0

+PUTBUFA2:

+	LD	(IX+WRITE+1),H

+	LD	(IX+WRITE),L	; Schreibzeiger neu setzen

+;	EX	DE,HL		; Schreibzeiger in DE

+

+	LD	L,(IX+SIZE)

+	LD	H,(IX+SIZE+1)

+	ADD	HL,BC		; Stringlaenge addieren

+	LD	(IX+SIZE+1),H	; eintragen

+	LD	(IX+SIZE),L

+

+	POP	HL		; Stringanfang

+	RET

+

+;................................................................

+;

+;	SCCA Output Interrupt

+;

+SCCATX:

+	PUSH	IX

+	LD	IX,SCCATAB

+	JR	TXCHAR

+

+;................................................................

+;

+;	SCCB Output Interrupt

+;

+SCCBTX:

+	PUSH	IX

+	LD	IX,SCCBTAB

+TXCHAR:

+	PUSH	AF

+	CALL	TXHANDLER

+

+	LD	A,00111000B	; Reset highest IUS

+	OUT0	(SCCBC),A

+

+	JR	EOFTX

+	

+

+;................................................................

+;

+;	Centronics Output Interrupt

+;

+CENTR:

+	PUSH	IX

+	LD	IX,DRUCK

+	PUSH	AF

+	CALL	TXHANDLER

+

+	LD	A,9		; Statusregister

+	OUT0	(CIOCTL),A

+	LD	A,00100000B	; Reset IP & IUS

+	OUT0	(CIOCTL),A

+EOFTX:

+	POP	AF

+	POP	IX

+	EI

+	RETI

+;

+;------------------------------------------------------------------------

+;	Output Interrupt Handler

+;	fuer Centronics und SCC

+;

+;	Eingang: IX = Zeiger auf Descriptortabelle des Kanals

+;		 Interrupts disabled

+;	Ausgang: Nur AF veraendert

+;

+TXHANDLER:

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+

+	IN0	A,(CIOAD)	; Zugriff auf Puffer erlaubt ?

+	BIT	0,A

+	JP	Z,REGRET

+

+	PUSH	IX

+	POP	HL

+	LD	A,L

+	CP	LOW DRUCK

+	JR	Z,CENTRIRQ

+

+	LD	B,0

+

+	BIT	7,(IX+XFLAG)	; Transmitter gestoppt ?

+	JR	NZ,REGRET	; Keine Interruptbehandlung

+

+	LD	E,(IX+SIZE)

+	LD	D,(IX+SIZE+1)

+	LD	L,(IX+READ)

+	LD	H,(IX+READ+1)

+

+TX1:

+	LD	C,(IX+CPORT)

+

+	LD	A,D

+	OR	E

+	JR	Z,TX5		; Puffer ist leer

+	

+	TSTIO	0100B

+	JR	Z,TX4		; Output-Buffer voll

+

+	IN0	A,(CBR)

+	PUSH	AF

+

+	LD	A,51H+(SABUF/1000H); MMU-Wert fuer Pufferwindow (max. 4k)

+	OUT0	(CBR),A

+

+	PUSH	HL

+

+	LD	A,H

+	AND	0FH

+	OR	0F0H		; Ins Window F000H...

+	LD	H,A

+

+	LD	A,(HL)		; Zeichen ausgeben

+	INC	C		; Aus Controlport wird Datenport

+	INC	C

+	OUT	(C),A		; B bleibt 0!

+

+	POP	HL

+	INC	HL

+

+	POP	AF

+	OUT0	(CBR),A		; MMU zurueckschalten

+

+	LD	A,H

+	CP	(IX+ENDE)

+	JR	NZ,TX2		; Carry set: Lesezeiger < Pufferende, ok

+

+	LD	H,(IX+BEG)	; L war schon 0

+TX2:

+	DEC	DE		; Puffergroesse DECR 1

+	JR	TX1		; Falls moeglich naechstes Zeichen ausgeben

+

+TX5:

+	LD	A,00101000B	; Reset TxIP (B ist 0!)

+	OUT	(C),A

+

+TX4:

+	LD	(IX+SIZE),E

+	LD	(IX+SIZE+1),D

+	LD	(IX+READ),L

+	LD	(IX+READ+1),H

+

+REGRET:

+	POP	BC

+	POP	DE

+	POP	HL

+	RET

+

+CENTRIRQ:

+	LD	C,CIOCTL

+	LD	DE,(DRUCK+SIZE)

+	LD	HL,(DRUCK+READ)

+

+CENTR3:

+	LD	A,D

+	OR	E

+	JR	Z,TX4		; Puffer ist leer

+	

+	LD	A,9		; Statusregister

+	OUT0	(CIOCTL),A	; Statusregister

+	TSTIO	1000B

+	JR	Z,TX4		; Output-Buffer voll

+

+	IN0	B,(CBR)

+

+	LD	A,51H+(DBUF/1000H)	; MMU-Wert fuer Pufferwindow (max. 4k)

+	OUT0	(CBR),A

+

+	PUSH	HL

+

+	LD	A,H

+	AND	0FH

+	OR	0F0H		; Ins Window F000H...

+	LD	H,A

+

+	LD	A,(HL)		; Byte aus Puffer lesen

+	OUT0	(CIOBD),A	; und ausgeben

+

+	OUT0	(CBR),B		; MMU zurueckschalten

+

+	POP	HL

+	INC	HL

+

+	LD	A,H		; Pufferende ?

+	CP	(IX+ENDE)

+	JR	NZ,CENTR2

+

+	LD	H,(IX+BEG)	; L war schon 0

+CENTR2:

+

+	DEC	DE		; Puffergroesse DECR 1

+	JR	CENTR3		; Falls moeglich naechstes Zeichen ausgeben

+

+

+;*************************************************************************

+;

+;	CLRCBUF

+;

+;	64180-Centronics Buffer loeschen

+;	Ausgang: HL veraendert, Flags unveraendert

+;

+CLRCBUF:

+	LD	HL,DBUF

+	LD	(DRUCK+READ),HL

+	LD	(DRUCK+WRITE),HL

+	LD	HL,0

+	LD	(DRUCK+SIZE),HL

+	RET

+	

+;................................................................

+;

+;	SCC Input Interrupt Handler

+

+;--------------------------------------------------------------------

+;	Zeichen mit Fehler empfangen

+

+SCCAER:				; von SCC-Kanal A

+	PUSH	BC

+	LD	C,SCCAC

+	JR	SCCERR

+

+SCCBER:				; von SCC-Kanal B

+	PUSH	BC

+	LD	C,SCCBC

+

+SCCERR:

+	PUSH	AF

+

+	LD	B,0

+	LD	A,00010000B	; Reset EXT/Status Interrupts

+	OUT	(C),A

+	LD	A,00110000B	; Error Reset

+	OUT	(C),A

+

+	LD	A,1

+	OUT	(C),A		; Read-Register 1

+	IN	B,(C)

+

+	BIT	5,B		; Overrun Error ?

+	JR	Z,SCCER1

+	SET	0,A

+SCCER1:

+	BIT	4,B		; Parity Error ?

+	JR	Z,SCCER2

+	SET	2,A

+SCCER2:

+	BIT	6,B		; Framing Error (mit 0 = Break)

+	JR	Z,SCCER3

+	SET	1,A

+SCCER3:

+	JR	SCC1

+

+;-----------------------------------------------------------------------

+;	Zeichen ohne Fehler empfangen

+

+SCCKA:

+	PUSH	BC

+	LD	C,SCCAC

+	JR	SCCOK

+

+SCCKB:

+	PUSH	BC

+	LD	C,SCCBC

+

+SCCOK:

+	PUSH	AF

+	XOR	A		; Keine Fehler

+

+;	Interrupt weiterleiten und Flusskontrolle auswerten

+;	Eingang: A = Fehlerbits

+;		 C = Contollportadresse des Kanals

+

+SCC1:

+	LD	(ERRBIT),A

+	LD	A,C

+	SUB	A,3EH

+	LD	(KANAL),A

+

+	LD	B,0

+	PUSH	BC

+

+	TSTIO	1		; Statusregister

+	JR	Z,IRET		; Receive Character available ?

+

+	INC	C		; Aus Controlport wird Datenport

+	INC	C

+	IN	B,(C)		; Zeichen einlesen

+

+	LD	A,11111101B	; Maske zur XON/XOFF Erkennung

+	AND	B		; mit Eingabezeichen verknuepfen

+	CP	00010001B	; = XON oder XOFF ?

+	JR	NZ,SCC2		; Nein, normaler Inputinterrupt

+

+	PUSH	HL

+

+	LD	HL,XFLGB

+	LD	A,(KANAL)

+	CP	2

+	JR	Z,SCC3

+	LD	HL,XFLGA

+SCC3:	

+	BIT	6,(HL)		; Bit 6: Ausgabeseitig XON/XOFF

+	JR	Z,SCC5		; 0: An Inputinterrupt weiterleiten

+

+	BIT	1,B		; XOFF : Bit 1 = 1, XON: Bit 1 = 0

+	JR	Z,SCC4

+

+	SET	7,(HL)		; Transmitter stoppen

+	POP	HL

+	JR	IRET

+SCC4:

+	RES	7,(HL)		; Transmitter starten

+

+	POP	HL

+	POP	BC

+

+	CP	2		; Flag setzen

+

+	CALL	NZ,SCCATX	; Flags werden nicht veraendert!

+	CALL	Z,SCCBTX	; enthaelt u.a. EI und RETI

+				; und Reset highest IUS	

+	POP	AF

+	POP	BC

+	RET

+	

+SCC5:	

+	POP	HL

+SCC2:

+	LD	A,(ERRBIT)	; Fehlerbits

+	LD	C,A

+	LD	A,(KANAL)	; Kanalnummer

+	CALL	PHYSLOG		; phys. Kanalnummer --> log. Kanalnummer

+

+	CALL	IINTAD

+

+	CP	3		; Weniger als 3 Zeichen Platz ?

+	JR	NC,IRET

+

+	LD	A,(KANAL)

+	CALL	ESTOP		; Eingabestop fuer Kanal 2 oder 3

+

+IRET:

+	POP	BC

+

+	LD	A,00111000B	; Reset highest IUS

+	OUT	(C),A

+;

+	POP	AF

+	POP	BC

+	EI

+	RETI

+

+;................................................................

+;

+;	SCC Initialisierung

+;	HL, BC veraendert

+;

+SCCINIT:

+	LD	HL,SCCAINI		;SCC Kanal A initialisieren

+	LD	BC,(SCCALG+1)*100H+SCCAC+1

+INILP1:

+	DEC	C

+	OTIM

+	JR	NZ,INILP1

+;					; SCC Kanal B initialisieren

+	LD	BC,(SCCBLG+1)*100H+SCCBC+1

+INILP2:

+	DEC	C

+	OTIM

+	JR	NZ,INILP2

+;

+	RET

+;

+;.................................................................

+;

+;	B A U S C C

+;	Baudrateneinstellung fuer SCC-Kanaele

+;

+;	Eingang: A - Kanalnummer (2 oder 3)

+;		 HL - Schluessel (s. Tabelle) (1..16)

+;		 Es werden korrekte Parameter vorrausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BAUSCC:

+	PUSH	AF

+	PUSH	HL

+	LD	BC,BDSCCA+1

+	CP	3		;Kanal A ?

+	JR	Z,CHABD		;Ja ->

+;

+	LD	BC,BDSCCB+1	;Tab. fuer Kanal B

+;

+CHABD:

+	PUSH	BC

+	LD	BC,BDTAB-2	;Tabelle mit Baudratenteilfaktoren

+	ADD	HL,HL		;Tab.-Offset

+	ADD	HL,BC

+	POP	BC		;Baudrate eintragen

+	LD	A,(HL)

+	LD	(BC),A		;LSB eintragen

+	INC	HL

+	INC	BC

+	INC	BC

+	LD	A,(HL)		;MSB eintragen

+	LD	(BC),A

+

+INISCC:

+	CALL	SCCINIT

+	POP	HL

+	POP	AF

+	RET	

+;

+;.................................................................

+;

+;	B I T S C C

+;	Stopbits, Parity, Datenbits fuer SCC-Kanaele einstellen

+;

+;	Eingang: A = Kanal (2 oder 3)

+;		 L = Schluessel : 

+;		     Bit 0..2 : Datenbits - 1 (Nur 7 oder 8 erlaubt)

+;		     Bit 3..4 : 00 = No Parity, 01 = Odd , 10 = Even

+;		     Bit 5..6 : 00 = 1 Stop, 01 = 1.5 Stop, 10 = 2 Stop

+;

+;	Es werden korrekte Parameter vorausgesetzt

+;

+;	Ausgang: Register unveraendert

+;

+BITSCC:

+	PUSH	AF

+	PUSH	HL

+	LD	BC,BTSCCA+1

+	CP	3		;Kanal A ?

+	JR	Z,CHABT		;Ja ->

+;

+	LD	BC,BTSCCB+1	;Tab. fuer Kanal B

+;

+CHABT:

+	LD	A,L

+	RRA

+	RRA

+	RRA			; Paritybits (0, 1), Stopbits (2, 3)

+	AND	0FH

+	ADD	4		; Stopbits korrigieren

+	BIT	1,A		; Wenn even Parity noch Bit 0 setzen

+	JR	Z,NOEVN		; 00 = No Parity, 01 = Odd, 11 = Even

+	SET	0,A

+NOEVN:	OR	01000000B	; Clock x16 Mode

+	LD	(BC),A		; eintragen

+	INC	BC		; Zeigt auf Register 3

+	INC	BC

+

+	LD	A,L

+	AND	7

+	CP	7-1

+	LD	A,01000001B	; Receiver Enable, 7 Datenbits

+	JR	Z,CHABT1

+	LD	A,11000001B	; dgl., 8 Datenbits

+CHABT1:

+	LD	(BC),A		; Eintragen

+	INC	BC		; Zeigt auf Register 5

+	INC	BC

+	LD	A,10101010B	; Enable Transmitter, 7 Datenbits

+	JR	Z,CHABT2	; Compare-Flag noch nicht veraendert!

+	LD	A,11101010B	; dgl. 8 Datenbits

+CHABT2:

+	LD	(BC),A		; eintragen

+	JR	INISCC

+

+;..................................................................

+;

+;	X F L W 2 3

+;	XON/XOFF - Eingabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 BIT 7 (HL), Stop/Weiter

+;

+;	Ausgang: alle Register unveraendert

+;

+XFLW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+	ADD	A,3EH		; Kanal --> Controlport

+	LD	C,A		; Transmitinterrupt kann nicht durchkommen

+

+XFLW23B:

+	TSTIO	0100B		; Transmitbuffer empty ?

+	JR	Z,XFLW23B

+

+	LD	A,XON

+	BIT	7,(HL)

+	JR	Z,XFLW23A

+	LD	A,XOFF

+XFLW23A:

+	INC	C		; Controlport --> Datenport

+	INC	C

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+;.................................................................

+;

+;	C F L O W 2 3

+;	CTS - Ausgabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 BIT 1(HL), BIT 2(HL) beide 1 : Mit CTS-Flusskontrolle

+;						sonst ohne Flusskontrolle

+;	Ausgang: Nur HL darf veraendert werden

+;

+CFLOW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+

+	ADD	A,3EH		; Controlport

+	LD	C,A

+

+	CP	40H		; SCCA ?

+

+	LD	A,(HL)		; Bit 1 und 2 relevant

+

+	LD	HL,CTSA+1

+	JR	Z,CFLOW2

+	LD	HL,CTSB+1

+CFLOW2:

+	RES	5,(HL)		; erstmal keine Auto-Enables

+	AND	0110B		; Bit 1 und 2 ausblenden

+	CP	0110B

+	JR	NZ,CFLOW3

+

+	SET	5,(HL)		; Auto-Enables einschalten

+CFLOW3:	

+	LD	A,3

+	OUT	(C),A		; Write-Register 3

+	LD	A,(HL)

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+	

+;......................................................................

+;

+;	R F L W 2 3

+;	RTS/DTR - Eingabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 Bit 7 (HL), Stop/Weiter

+;

+;	Ausgang: Nur Register HL darf veraendert werden

+;

+RFLW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+

+	ADD	A,3EH		; Controlport

+	LD	C,A

+

+	CP	40H		; SCCA ?

+	LD	A,(RTSA+1)

+	JR	Z,RFLW2

+	LD	A,(RTSB+1)

+RFLW2:

+	AND	01111101B	; RTS und DTR ausblenden

+	BIT	7,(HL)

+	JR	NZ,RFLW3	; Stop: RTS = 0 und DTR = 0

+	OR	10000010B	; Go : RTS = 1 und DTR = 1

+RFLW3:	

+	PUSH	AF

+

+	LD	A,5

+	OUT	(C),A		; Write-Register 5

+	POP	AF

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+;........................................................................

+;

+;	X F L O W 2 3

+;	XON/XOFF - Ausgabeflusskontrolle fuer SCC-Kanaele

+;

+;	Eingang: A = Kanal (2, 3)

+;		 Bit 0, 2 (HL) = 1 : XON/XOFF gewuenscht sonst nicht

+;	Ausgang: Nur HL veraendert

+;

+XFLOW23:

+	PUSH	AF

+	LD	A,(HL)

+	AND	0101B

+	CP	0101B		; einstellen, wenn 0101

+	LD	L,0

+	JR	NZ,XFLOW2

+	SET	6,L		; Bit 6 = 1 : mit Flusskontrolle

+XFLOW2:

+	POP	AF

+	PUSH	AF

+	CP	2		; Kanal 2 = SCCB

+	LD	A,L

+	JR	Z,XFLOW1

+

+	LD	(XFLGA),A

+	POP	AF

+	RET

+

+XFLOW1:

+	LD	(XFLGB),A

+	POP	AF

+	RET

+

+;........................................................................

+;

+;	A F L O W

+;	Ausgabeflusskontrolle einstellen

+;

+;	Eingang: A = phys. Kanalnummer

+;		 Bit 0, 1, 2(HL) = Flusskontrolmodus

+;

+;	Ausgang: Nur HL darf veraendert werden

+;

+AFLOW:

+	CP	5

+	JP	Z,AFLOW5	; Kanal 5: Ausgabeseitig ist immer CTS

+				; Flusskontrolle eingestellt, Software-

+				; Flusskontrolle mit XON/XOFF ist einschalt-

+				; bar, zusaetzlich einstellbar DSR-Flussk.

+	CP	2

+	RET	C		; Kanal 1 hat keine Ausgabeflusskontrolle

+	CP	4

+	RET	NC		; > 3 : -->

+

+	PUSH	HL

+	CALL	XFLOW23		; XON/XOFF-Flusskontrolle einstellen

+	POP	HL

+	JP	CFLOW23		; Auto-Enables on, wenn Bit 1(HL)=1 und 2(HL)=1

+

+;..................................................................

+;

+;	Eingabestop

+;

+;	Eingang: A = phys. Kanalnummer (2, 3, 5)

+;

+ESTOP:

+	CP	7

+	RET	NC		; Nicht existenter Kanal

+

+	PUSH	HL

+	CALL	FLWTYP		; Zeiger auf Flowmode - Tabelle berechnen

+

+	BIT	3,(HL)

+	JR	Z,POPRET	; Keine Eingabeflusskontrolle erwuenscht

+

+	BIT	7,(HL)		; War der Kanal schon gestoppt ?

+	JR	NZ,POPRET

+

+	SET	7,(HL)		; Stopflag setzen

+

+ESTPGO:				; Ab hier Stop/Go identisch

+

+	CP	2

+	JR	Z,ESTOP23

+	CP	3

+	JR	Z,ESTOP23

+

+	PUSH	BC

+	CP	5

+	CALL	Z,EFLW5		; AF wird nicht veraendert

+	CP	1

+	CALL	Z,EFLW1

+	POP	BC

+

+POPRET:

+	POP	HL

+	RET

+

+ESTOP23:

+	BIT	0,(HL)		; XOFF senden ?

+	CALL	NZ,XFLW23	; Bit 7 unterscheidet XON/XOFF

+	BIT	1,(HL)		; DTR/RTS low setzen?

+	CALL	NZ,RFLW23	; Bit 7 unterscheidet 

+	JR	POPRET

+

+;..................................................................

+;

+;	Eingabe Weiter

+;

+;	Eingang: A = Kanalnummer (2, 3, 5)

+;

+EGO:

+	CP	7

+	RET	NC		; Nicht existenter Kanal

+

+	PUSH	HL

+

+	PUSH	AF

+	AND	1011B		; Kanal 1 oder 5

+	CP	1

+	CALL	Z,CHKINT

+	POP	AF

+

+	CALL	FLWTYP		; Zeiger auf Flowmode - Tabelle berechnen

+

+	BIT	3,(HL)

+	JR	Z,POPRET	; Keine Eingabeflusskontrolle erwuenscht

+

+	BIT	7,(HL)		; War der Kanal gestoppt ?

+	JR	Z,POPRET	; Nein, return

+

+	RES	7,(HL)		; Goflag setzen

+	JR	ESTPGO		; Wie Stop weiter

+

+;-----------------------------------------------------------------

+;

+;	C H K I N T

+;	ggf. Inputinterrupt aufrufen, falls 6502-IRQ nicht quittiert

+;

+;	HL, A veraendert

+;

+CHKINT:

+;	LD	HL,DCOUNT	; Nicht immer CHKINT

+;	DEC	(HL)		; Korr. 1.1

+;	RET	NZ

+;	LD	(HL),100

+

+	PUSH	BC

+	LD	HL,LOW INTPAR1

+	CALL	RD6502		; Byte aus Zeropage lesen

+	AND	A

+	CALL	NZ,INT6502

+	POP	BC

+	RET

+	

+;----------------------------------------------------------------

+;

+;	SCC Kanal A Initialisierung

+;

+SCCAINI:

+	DEFB	9,0C0H		; Force Hardware Reset (beide Kanaele)

+				; Master Interrupts disabled

+	DEFB	2,20H		; Interrupt Vektor (beide Kanaele)

+

+	DEFB	11,01010110B	; use Baudrategenerator Output

+BDSCCA:

+	DEFB	12,18		; Baud Rate Low, Default 9600 Baud

+	DEFB	13,0		; Baud Rate High

+	DEFB	14,00000010B	; Baud Rate Gen. Source = PCLK

+BTSCCA:

+	DEFB	4,01001100B	; No Parity, 2 Stopbits

+CTSA:

+	DEFB	3,11000001B	; Enable Receiver, Datenbits

+RTSA:

+	DEFB	5,11101010B	; Enable Transmitter, Datenbits

+;

+ 	DEFB	14,00000011B	; Enable Baudrategenerator

+	DEFB	17,00010110B	; Receive/Transmit Interrupts Enable

+				; Reset Ext./STatus-Interrupts

+

+SCCALG	EQU	$-SCCAINI

+;

+;	SCC Kanal B Initialisierung

+;

+SCCBINI:

+	DEFB	11,01010110B	; use Baudrategenerator Output

+BDSCCB:

+	DEFB	12,18		; Baud Rate Low, Default 9600 Baud

+	DEFB	13,0		; Baud Rate High

+	DEFB	14,00000010B	; Baud Rate Gen. Source = PCLK

+BTSCCB:

+	DEFB	4,01001100B	; No Parity, 2 Stopbits

+CTSB:

+	DEFB	3,11000001B	; Enable Receiver, Datenbits

+RTSB:

+	DEFB	5,11101010B	; Enable Transmitter, Datenbits

+;

+ 	DEFB	14,00000011B	; Enable Baudrategenerator

+	DEFB	17,00010110B	; Receive/Transmit Interrupts Enable

+				; Reset Ext./Status-Interrupts

+	DEFB	9,00001001B	; Master Interrupt Enable

+;

+SCCBLG	EQU	$-SCCBINI

+;

+;	Baudratentabelle fuer beide SCC-Kanaele

+;

+BDTAB:

+	DEFW	3838		;50 Baud

+	DEFW	2558		;75 Baud

+	DEFW	1743		;110 Baud

+	DEFW	1426		;134.5 Baud

+	DEFW	1278		;150 Baud

+	DEFW	638		;300 Baud

+	DEFW	318		;600 Baud

+	DEFW	158		;1200 Baud

+	DEFW	105		;1800 Baud

+	DEFW	78		;2400 Baud

+	DEFW	51		;3600 Baud

+	DEFW	38		;4800 Baud

+	DEFW	25		;7200 Baud

+	DEFW	18		;9600 Baud

+	DEFW	8		;19200 Baud

+	DEFW	3		;38400 Baud

+;

+;	Datenbereich

+;

+

+ERRBIT:	DEFB	0		; Fehlerbits

+KANAL:	DEFB	0		; Kanal mit Eingabezeichen

+

+CCOUNT:	DEFB	8		; Cursorinvertier Zaehler

+;DCOUNT: DEFB	0		; CHKINT - Weiter Zaehler

+

+DRUCK:	

+	DEFW	0		; aktuelle Groesse des Puffers

+	DEFB	HIGH DBUF	; Drucker-Pufferanfang

+	DEFW	DBUF		; Lesezeiger

+	DEFW	DBUF		; Schreibzeiger

+	DEFB	HIGH (DBUF+1000H); Druckerpufferende (excl.)

+

+SCCATAB:	

+	DEFW	0		; Aktuelle Groesse des Puffers

+	DEFB	HIGH SABUF	; SCCA-Transmitbuffer Anfang im Basisspeicher

+	DEFW	SABUF		; Lesezeiger

+	DEFW	SABUF		; Schreibzeiger

+	DEFB	HIGH (SABUF+0800H); SCCA-Transmitbufferende (excl.)

+	DEFB	SCCAC		; Controlport

+XFLGA:	DEFB	0		; XON/XOFF auf SCCA ausgabeseitig ?

+

+SCCBTAB:	

+	DEFW	0		; aktuelle Groesse des Puffers

+	DEFB	HIGH SBBUF	; SCCB-Transmitbuffer Anfang im Basispeicher

+	DEFW	SBBUF		; Lesezeiger

+	DEFW	SBBUF		; Schreibzeiger

+	DEFB	HIGH (SBBUF+0800H); SCCB-Transmitbufferende (excl.)

+	DEFB	SCCBC		; Controlport

+XFLGB:	DEFB	0		; XON/XOFF auf SCCB ausgabeseitig ?

+

+;****************************************************************

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/L80.COM b/system/shard-z80-ruc-64180/1.5/src/L80.COM
new file mode 100644
index 0000000..c9d5c84
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/L80.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC
new file mode 100644
index 0000000..e6fa7e2
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC
@@ -0,0 +1,169 @@
+	TITLE	LOADER - SHARD Loader fuer EUMEL System

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	Lader fuer SHARD, wird vom Harddisk Boot aufgerufen

+;

+;	Version 1.0 - 22. 10. 1985 - R. Ellerbrake

+;	Version 1.2 - 09.01.1987 - M. Staubermann, Konfigurationsblock

+;

+;****************************************************************

+;

+

+;	Konstanten

+;

+BASE	EQU	1000H		;Lader-Startadresse

+	.PHASE	BASE

+DEST	EQU	8000H		;Zieladresse fuer SHARD

+BOTLNG	EQU	40H

+SHARD	EQU	100H		;SHARD Anfangsadresse

+;

+;

+;	Lader wird ab Adresse 1000H im Apple Speicher gestartet

+;	und kopiert den SHard in den 64180 Speicher

+;

+

+LOAD:

+	LD	A,080H		;0..7FFF:Apple, 8000..FFFF:64180 RAM

+	OUT0	(CBAR),A

+;

+;	Speicherverwaltung umschalten, log. Adr. 0..7FFFH im unteren

+;	Bereich des Apple Speichers liegen lassen, Adresse 8000..FFFFH

+;	auf phys. Adresse 00000H..07FFFH abbilden

+;

+	LD	A,0F8H

+	OUT0	(CBR),A		;F8+8=0! (00000... Phys. = 8000H log.)

+;

+	LD	A,60H		; Jetzt offiziell 60000... = 0000H log.

+	OUT0	(BBR),A		; Wird beim ersten Zugriff auf 180-Memory aktiv

+;

+;	Umschaltroutine kopieren

+;

+	LD	HL,UMSCH-LOAD+BASE

+	LD	DE,DEST

+	LD	BC,CONFLG	 ; Page bis zum Ende uebertragen

+	LDIR

+;

+	LD	A,2		; Burst Mode, Memory <--> Memory Transfer

+	OUT0	(DMODE),A

+

+	LD	BC,8*0100H+SAR0L; 8 Bytes in DMA-Register transportieren

+	LD	HL,DMATAB

+	OTIMR

+

+	LD	A,01000011B	; DMA Kanal 0 starten

+	OUT0	(DSTAT),A

+

+	JP	DEST		; im 64180-Memory starten (noch 8000H)

+

+DMATAB:	

+	DEFW	SHARD+BASE	; SHard liegt noch ab 1100H

+	DEFB	6		; im Basis-Speicher

+	DEFW	SHARD		; soll nach 0100H

+	DEFB	0		; im 64180-Speicher

+	DEFW	(BOTLNG-1)*100H	; Bis auf LOAD-Modul (dieses) alles kopieren

+;

+;	Programmstueck zur RAM-Umschaltung phys. 0 = log. 0

+;

+UMSCH:

+	XOR	A

+	OUT0	(BBR),A		; 0000.7FFF log. = 8000..FFFF log = 00000 phys.

+	JP	SHARD		; von 81xx --> 01xx springen 

+	NOP

+

+CONF:				; Konfigurationsblock

+

+;--------------------------------------------------------------------------

+NOVTST	EQU	200H		; Kein Vortest, kein Speichertest

+NOSTST	EQU	100H		; Vortest, aber kein Speichertest

+FREEU0	EQU	1		; EUMEL0 auf HG freigeben (loeschen!)

+VORTST	EQU	0		; Vortest, Speichertest, (Normalfall)

+

+BLINKP:	

+	DEFB	8		; Blinkdauer des Cursors

+BEEPFRQ:

+	DEFB	10		; Tonfrequenz bei Bell (f = 10kHz/beepfrq)

+ARC31:	

+	DEFB	40H, 0, 0	; LUN der SCSI-Floppy

+MODECONF:

+	DEFW	VORTST

+ID4:

+	DEFW	0		; Lizenznummer des SHards

+ID5:

+	DEFW	0		; Installationsnummer des SHards

+ID6:

+	DEFW	0		; reserviert

+URLK1:

+	DEFB	31		; Archiv

+URLK2:

+	DEFB	0		; HG

+

+	DEFS	1		; free

+

+;--------------------------------------------------------------------------

+

+	DEFS	40H		; Interrupttabelle

+	;ORG	BASE+UMSCH-LOAD+58H	; Nach der Interrupttabelle weiter

+

+

+IKANTAB:			; Zuordnungstabelle fuer phys. --> log.

+				; Kanaele mit Inputinterrupt

+	DEFB	0, 1, 2, 3, 4, 5, 6, 7

+

+KANTAB:				; Zuordnungstabelle fuer log. --> phys.

+				; fuer alle Kanaele

+	DEFB	0, 1, 2, 3, 4, 5, 6, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH

+	DEFB	0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH

+	DEFB	0FFH, 0FFH, 0FFH, 0FFH, 28, 29, 30, 31, 32

+

+IOFTB:				; Kan. def.Funktionen	 Beschreibung

+	DEFB	0CH		;  0  blockin/out	 Hintergrund

+	; Stream I/O & Block I/O

+	DEFB	0FH		;  1  blockin/out,iint/outvar Konsole-Terminal

+	DEFB	03H		;  2  iint/outvar	 SCCB-Terminal

+	DEFB	03H		;  3  iint/outvar	 SCCA-Terminal

+	DEFB	02H		;  4  outvar     	 Drucker 180-Card

+	DEFB	03H		;  5  iint/outvar	 Terminal Motherb.

+	DEFB	02H		;  6  outvar     	 Drucker Motherb.

+	DEFB	00H		;  7  -----------	 nicht definiert

+	DEFB	00H		;  8  -----------	 nicht definiert

+	DEFB	00H		;  9  -----------	 nicht definiert

+	DEFB	00H		; 10  -----------	 nicht definiert

+	DEFB	00H		; 11  -----------	 nicht definiert

+	DEFB	00H		; 12  -----------	 nicht definiert

+	DEFB	00H		; 13  -----------	 nicht definiert

+	DEFB	00H		; 14  -----------	 nicht definiert

+	DEFB	00H		; 15  -----------	 nicht definiert

+	DEFB	00H		; 16  -----------	 nicht definiert

+	; Block I/O

+	DEFB	00H		; 17  -----------	 nicht definiert

+	DEFB	00H		; 18  -----------	 nicht definiert

+	DEFB	00H		; 19  -----------	 nicht definiert

+	DEFB	00H		; 20  -----------	 nicht definiert

+	DEFB	00H		; 21  -----------	 nicht definiert

+	DEFB	00H		; 22  -----------	 nicht definiert

+	DEFB	00H		; 23  -----------	 nicht definiert

+	; Privilegierte Block I/O

+	DEFB	00H		; 24  -----------	 nicht definiert

+	DEFB	00H		; 25  -----------	 nicht definiert

+	DEFB	00H		; 26  -----------	 nicht definiert

+	DEFB	00H		; 27  -----------	 nicht definiert

+	DEFB	0CH		; 28  blockin/blockout	 CP/M-Harddisk-Volume

+	DEFB	0CH		; 29  blockin/blockout	 Apple-Drive 1

+	DEFB	0CH		; 30  blockin/blockout	 Apple-Drive 0

+	DEFB	1CH		; 31  format,blockin/out SCSI-Floppy

+

+CPMOFS:	DEFB	00H, 0AH, 60H	; Anfang eines CP/M Volumes

+CPMLAST:DEFB	00H, 2AH, 60H	; Ende+1 des CP/M Volumes

+

+CONFLG	EQU	$-UMSCH

+	.DEPHASE

+;

+;****************************************************************

+;

+	END

+

diff --git a/system/shard-z80-ruc-64180/1.5/src/M80.COM b/system/shard-z80-ruc-64180/1.5/src/M80.COM
new file mode 100644
index 0000000..d575728
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/M80.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC
new file mode 100644
index 0000000..f52f900
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC
@@ -0,0 +1,112 @@
+

+; NIBLE.INC for RUC180-Card on BASIS 108

+;

+; Version 08.09.85

+

+

+nible2    ds    57

+

+slot10    db     0

+

+iob_old_S db     60

+iob_old_D db     60

+

+head_table db    0,60,60,60,60,60

+

+slotn     db     60,50,40

+

+time0     db     01,30,28,24,20,1E,1D,1C

+time1     db     70,2C,26,22,1F,1E,1D,1C

+          

+

+step_wait:

+	lda	#00		; wird gepatcht

+wait

+          LDX       #11

+wait0     DEX

+          BNE       wait0

+          INC       wait_Cnt

+          BNE       wait1

+          INC       wait_Cnt+1

+wait1     SEC

+          SBC       #01

+          BNE       wait

+          RTS

+

+          ds	    96-low(*-start)		

+

+to_bits

+          db                             000,004

+          db     098,099,008,00C,09C,010,014,018

+          db     0A0,0A1,0A2,0A3,0A4,0A5,01C,020

+          db     0A8,0A9,0AA,024,028,02C,030,034

+          db     0B0,0B1,038,03C,040,044,048,04C

+          db     0B8,050,054,058,05C,060,064,068

+

+         ;LDA       #xx         2

+         ;JSR       wrtnibl     6   6

+wrt_nibl                    ;              len=10

+          CLC               ;     2

+wrt_nibl1

+          PHA               ;     3   3

+          PLA               ;     4   4

+wrt_nibl2

+          STA       Q6on,X  ;     5   5

+          ORA       Q6off,X ;     4   4

+          RTS               ;   + 6 + 6

+                            ;  ---- ---

+                            ;    32  28 uS

+          

+          db             0CA,06C,0CC,070,074,078

+          db     0D0,0D1,0D2,07C,0D4,0D5,080,084

+          db     0D8,088,08C,090,094,098,09C,0A0

+          db     0E0,0E1,0E2,0E3,0E4,0A4,0A8,0AC

+          db     0E8,0B0,0B4,0B8,0BC,0C0,0C4,0C8

+          db     0F0,0F1,0CC,0D0,0D4,0D8,0DC,0E0

+          db     0F8,0E4,0E8,0EC,0F0,0F4,0F8,0FC

+

+          if	low(*-start) ne 0 

+          .printx  'Missing bytes !'

+          endif

+

+to_bytes

+          db     000,000,000

+to_nibble

+          db                 096,002,000,000,097

+          db     001,000,000,09A,003,000,000,09B

+          db     000,002,000,09D,002,002,000,09E

+          db     001,002,000,09F,003,002,000,0A6

+          db     000,001,000,0A7,002,001,000,0AB

+          db     001,001,000,0AC,003,001,000,0AD

+          db     000,003,000,0AE,002,003,000,0AF

+          db     001,003,000,0B2,003,003,000,0B3

+          db     000,000,002,0B4,002,000,002,0B5

+          db     001,000,002,0B6,003,000,002,0B7

+          db     000,002,002,0B9,002,002,002,0BA

+          db     001,002,002,0BB,003,002,002,0BC

+          db     000,001,002,0BD,002,001,002,0BE

+          db     001,001,002,0BF,003,001,002,0CB

+          db     000,003,002,0CD,002,003,002,0CE

+          db     001,003,002,0CF,003,003,002,0D3

+          db     000,000,001,0D6,002,000,001,0D7

+          db     001,000,001,0D9,003,000,001,0DA

+          db     000,002,001,0DB,002,002,001,0DC

+          db     001,002,001,0DD,003,002,001,0DE

+          db     000,001,001,0DF,002,001,001,0E5

+          db     001,001,001,0E6,003,001,001,0E7

+          db     000,003,001,0E9,002,003,001,0EA

+          db     001,003,001,0EB,003,003,001,0EC

+          db     000,000,003,0ED,002,000,003,0EE

+          db     001,000,003,0EF,003,000,003,0F2

+          db     000,002,003,0F3,002,002,003,0F4

+          db     001,002,003,0F5,003,002,003,0F6

+          db     000,001,003,0F7,002,001,003,0F9

+          db     001,001,003,0FA,003,001,003,0FB

+          db     000,003,003,0FC,002,003,003,0FD

+          db     001,003,003,0FE,003,003,003,0FF

+

+          if       low (*-start) ne 0

+          .printx  'Missing bytes'

+          endif

+

+; Ende von NIBLE.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC
new file mode 100644
index 0000000..d9a99f1
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC
@@ -0,0 +1,37 @@
+;

+;----------------------------------------------------------------

+;

+;	Port-Adressen

+;

+SCCAC	EQU	41H		;Z8530 (SCC) Kanal A Control

+SCCAD	EQU	43H		;Z8530 (SCC) Kanal A Daten

+SCCBC	EQU	40H		;Z8530 (SCC) Kanal B Control

+SCCBD	EQU	42H		;Z8530 (SCC) Kanal B Daten

+;

+CIOAD	EQU	52H		;Z8536 (CIO) Kanal A Daten

+CIOBD	EQU	51H		;Z8536 (CIO) Kanal B Daten

+CIOCD	EQU	50H		;Z8536 (CIO) Kanal C Daten

+CIOCTL	EQU	53H		;Z8536 (CIO) Control Register

+;

+SCSIP	EQU	80H		;SCSI-Daten-Port

+;

+RTCS	EQU	0C0H		; Sekunden RTC

+RTCSA	EQU	0C1H		; Sekunden Alarm

+RTCM	EQU	0C2H		; Minuten RTC

+RTCMA	EQU	0C3H		; Minuten Alarm

+RTCH	EQU	0C4H		; Stunden RTC

+RTCHA	EQU	0C5H		; Stunden Alarm

+

+RTCDW	EQU	0C6H		; Day of Week RTC 1..7

+RTCDY	EQU	0C7H		; Day of Month 1..31

+RTCMO	EQU	0C8H		; Month 1..12

+RTCYR	EQU	0C9H		; Year 0..99

+

+RTCRA	EQU	0CAH		; Register A, Devider...

+RTCRB	EQU	0CBH		; Register B, Mode-Flags

+RTCRC	EQU	0CCH		; Register C, Interrupt-Flags

+RTCRD	EQU	0CDH		; Register D, VRT-Bit

+

+RTCRAM	EQU	0CEH		; Ab hier bis 0FFH Batary-RAM

+;

+;----------------------------------------------------------------

diff --git a/system/shard-z80-ruc-64180/1.5/src/SC.COM b/system/shard-z80-ruc-64180/1.5/src/SC.COM
new file mode 100644
index 0000000..49872e0
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SC.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC
new file mode 100644
index 0000000..32c0583
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC
@@ -0,0 +1,1477 @@
+

+	TITLE	SCSI Interface fuer RUC 180 Karte

+

+	INCLUDE	HD64180.LIB

+

+	.LIST

+

+;****************************************************************

+;

+;	S C S I

+;

+;	Elementare Ein- und Ausgaben auf dem SCSI Interface

+;

+;	Version 0.7, R. Ellerbrake

+;	Version 0.8 vom 31.12.86, M.Staubermann

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;

+;	Vers. 0.2: Kommando Transfer per DMA wieder eingebaut

+;	Vers. 0.3: Reset Signal implementiert

+;	Vers. 0.4: automatische Erkennung 40/80 Spuren Archiv

+;

+;****************************************************************

+

+;	Conditional Switches

+

+FALSE	EQU	0

+TRUE	EQU	NOT FALSE

+

+DMA	EQU	TRUE		;-1 = Daten nur per DMA ausgeben

+EUMEL	EQU	TRUE		;EUMEL Version

+SEC8	EQU	FALSE		;-1 = 8 Sektor Floppy

+TRK40	EQU	FALSE		;-1 = Voreinst. 2x40 Spuren

+DEBUG	EQU	FALSE		; Retries bei DMA/Hardwarefehler

+

+;----------------------------------------------------------------

+

+;	Globale Adressen

+

+	GLOBAL	SCSIIO, PHYSADR, INITS

+	GLOBAL	HDIO, FDIO, INIFLP, INITS1, PARKHD

+;

+;----------------------------------------------------------------

+

+;	Externe Adressen

+

+	IF	EUMEL

+

+	EXTERNAL WARTE

+

+	ENDIF

+

+;----------------------------------------------------------------

+

+;	Port-Adressen

+

+CIOAD	EQU	52H		;Z8536 (CIO) Kanal A Daten

+CIOCD	EQU	50H		;Z8536 (CIO) Kanal C Daten

+CIOCTL	EQU	53H		;Z8536 (CIO) Control Register

+

+SCSIP	EQU	80H		;SCSI I/O Port

+

+;................................................................

+

+;	Masken und Bits fuer CIO

+

+MBUSY	EQU	08H		;BUSY-Signal von SCSI Schnittstelle

+MMSG	EQU	10H		;Message-Signal von SCSI Schnittstelle

+MDC	EQU	20H		;Data(0)/Command(1) Sig. von SCSI

+MREQ	EQU	80H		;REQ-Signal vom SCSI-Controller

+MIO	EQU	04H		;I/O Signal von SCSI (0=Tr. Host -> SCSI)

+MSELS	EQU	02H		;Select Signal zum SCSI Interface

+

+BSELS	EQU	1		;Bitnummern

+BIO	EQU	2

+BBUSY	EQU	3

+BMSG	EQU	4

+BDC	EQU	5

+BREQ	EQU	7

+

+BRESS	EQU	3		;Reset-Signal fuer SCSI Controller

+MRESS	EQU	78H		;Maske zum Bit setzen (Bit 3)

+

+PCOMA	EQU	8		;Port A Command and Status

+

+;................................................................

+

+;	SCSI-Kommandos

+

+TST_RDY		EQU	0	;Drive Ready pruefen

+RECALIBR	EQU	1	;Drive recalibrieren

+REQ_STAT	EQU	3	;Fehlerstatus holen

+FORMAT		EQU	4	;Diskette oder Harddisk formatieren

+CHK_FORM	EQU	5	;Harddisk Format kontrollieren

+FRM_TRKS	EQU	6	;Spuren formatieren

+SREAD		EQU	8	;Sektoren lesen (1 od. mehrere)

+SVREAD		EQU	9	;Read Verify

+SWRITE		EQU	10	;Sektoren schreiben (")

+SEEK		EQU	11	;Auf Block positionieren

+WBUFFER		EQU	15	;Write Controller Buffer

+INITDRV		EQU	17	;Disk Parameter setzen

+RINIT		EQU	18	;Disk Parameter lesen

+FD48TPI		EQU	6*32+4	;Floppy im Doppelstepmodus betreiben

+FD96TPI		EQU	6*32+3	;Floppy im Singlestepmodus betreiben

+

+FDDRIV		EQU	0	;Floppy Laufwerk Nr.

+

+;................................................................

+

+;	Werte fuer SCSIIO-Aufruf

+

+DMATRA	EQU	4000H		;Datentransfer per DMA

+;DMATRA	EQU	0		;** TEST **

+RDDAT	EQU	8000H		;Lesen vom Controller

+

+;................................................................

+

+;	DMA-Controller Werte

+

+ENABDMA	EQU	90H		;Enable Kanal 1 DMA (keine Interrupts)

+DISDMA	EQU	10H		;Disable Kanal 1 DMA (-> DSTAT)

+DE1	EQU	7		;Bitnummer in DSTAT

+

+CH1MSK	EQU	0F4H		;Nicht fuer Kanal 1 wichtige Bits maskieren

+CHGDIR	EQU	2		;Aenderung der Transferrichtung (-> DCNTL)

+

+;................................................................

+

+;	Fehlernummern

+

+WPROTE	EQU	13H		; Diskette Schreibgeschuetzt

+TSNF	EQU	14H		; Target Sector not found

+

+HARD	EQU	0F0H		;Kennung Hardware bzw. Kommandofehler

+

+NOCONT	EQU	0		;SCSI-Controller nicht angeschlossen

+TIMOUT	EQU	1		;Timeout Fehler bei SCSI I/O

+ENDERR	EQU	2		;Falsches Kommandoende

+ILLD	EQU	3		;Falsche Datenrichtung

+EARLYE	EQU	4		;vorzeitiges Kommandoende

+ILLCOM	EQU	5		;Fehler bei Kommandoausgabe

+STRERR	EQU	6		;Fehler beim Status lesen

+DMAERR	EQU	7		;Fehler beim DMA Transfer

+UNKNOWN	EQU	8		;undefinierte Fehlerfaelle

+MULCNT	EQU	10		; Reset nach 10 hardwarefehlern

+

+;----------------------------------------------------------------

+

+;	Lokale Daten

+

+	DSEG

+

+SCSIST:	DEFS	4		;4 Byte Stati

+CODALN:	DEFW	0		;Datenlaenge

+SEMA:	DEFB	0		;Zugriffs-Semaphor

+TOFLG:	DEFB	0		;Timeoutflag

+

+	IF DEBUG

+RETRCN:	DEFB	4		;Retry Flag

+HERCNT:	DEFB	10		;Hardwarefehlerzaehler

+	ENDIF

+

+	CSEG

+

+;****************************************************************

+;

+;	SCSIIO

+;

+;	Elementare Ausgabe auf SCSI-Interface

+;

+;	Entry:	HL = Zeiger auf Datenbereich (falls vorhanden)

+;		DE = Zeiger auf Kommandobereich (immer 6 Byte)

+;		BC = Groesse des Datenbereichs (0=nicht vorhanden)

+;		B Bit 7: 1 = Lesen vom SCSI-Controller

+;			 0 = Schreiben auf SCSI-Controller

+;		B Bit 6: 1 = Datentransfer per DMA

+;		         0 = Datentransfer per Programm

+;

+;	Exit:	A  = Status (0 = ok, <>0 = Fehlercode)

+;		alle anderen Register (ausser AF) unveraendert

+;

+SCSIIO:

+	IF DEBUG

+	LD	A,3		;Retries bei Unknown Error

+	ENDIF

+

+NRETSC:

+	IF DEBUG

+	LD	(RETRCN),A

+	ENDIF

+

+	PUSH	HL

+	PUSH	BC

+	PUSH	DE

+

+	CALL	SCSI2		;Kommando ausfuehren

+	LD	L,A

+	AND	9FH		;Drive Code ausmaskieren

+	JR	Z,EOCOM		;Kein Fehler ->

+

+	CP	2		;SCSI-Fehler ?

+	LD	A,L

+	JR	NZ,EOCOM	;Nein -> fertig

+

+	POP	HL		;Kommandotab.-Adr.

+	PUSH	HL

+	LD	A,(HL)		;altes Kommando retten

+	PUSH	AF

+	LD	A,HARD+STRERR	;Fehler beim Status lesen annehmen

+	LD	(SCSIST),A

+	LD	(HL),REQ_STAT	;Kommando 3: Request Status

+	EX	DE,HL

+	LD	BC,4+RDDAT	;4 Byte Status Informationen

+	LD	HL,SCSIST	;Statusbereich

+	CALL	SCSI2

+	POP	AF

+	POP	HL

+	LD	(HL),A		;altes Kommando zurueckschreiben

+	PUSH	HL

+	LD	A,(SCSIST)

+	RES	7,A

+	AND	A		;Meldung: kein Fehler ?

+	JR	NZ,EOCOM

+

+;	kein Fehler: falsche Meldung da vorher einer aufgetreten war !!

+

+	LD	A,HARD+UNKNOWN	;unbekannnter Fehler melden

+

+EOCOM:

+	POP	DE

+	POP	BC

+	POP	HL

+

+	IF DEBUG

+	CP	HARD+ENDERR

+	JR	C,RETSCSI

+

+	LD	A,(RETRCN)

+	DEC	A

+	JR	NZ,NRETSC	;Retries bei "Unknown Error"

+

+	LD	A,HARD+UNKNOWN

+RETSCSI:

+	PUSH	HL

+	LD	HL,HERCNT	;Hardware Fehler Zaehler

+	CP	HARD		;Hardware Fehler ?

+	JR	C,NOHER		;Nein ->

+

+	DEC	(HL)

+	JR	NZ,EOHER	;nicht mehrere Hardwarefehler hintereinander

+

+	LD	(HL),MULCNT

+	PUSH	AF

+	PUSH	DE

+	PUSH	BC

+	CALL	INITS1		;Schnittstelle neu initialisieren

+	POP	BC

+	POP	DE

+	POP	AF

+	JR	EOHER

+

+NOHER:

+	LD	(HL),MULCNT

+

+EOHER:

+	POP	HL

+	ENDIF

+

+	AND	A

+	RET

+

+;................................................................

+;

+;	SCSI2

+;

+;	Kommandoausgabe auf dem SCSI-Interface

+;

+;	Entry-Parameter wie SCSIIO

+;

+;	Exit:	A = 0: alles ok

+;		A = 2: Fehler ist aufgetreten

+;		A >= F0H: Hardware oder Bedienungsfehler

+;

+SCSI2:

+	PUSH	BC		;Laenge retten

+

+;	Pruefen ob letzter DMA beendet wurde

+

+	IN0	A,(DSTAT)	;DMA beendet ?

+	BIT	DE1,A

+	JR	Z,DMAOK		;Ja ->

+

+	LD	A,DISDMA	;Reset Kanal 1 DMA

+	OUT0	(DSTAT),A

+

+DMAOK:

+ 	LD	BC,CIOAD	;B=0 !

+	JR	TENDLP

+

+;	"Bus free", Controller selektieren

+

+BUSYOK:

+	IN	A,(C)

+	SET	BSELS,A		;Select Leitung aktivieren

+	OUT	(C),A

+	RES	BSELS,A		;und wieder zuruecknehmen

+	OUT	(C),A

+

+;	"Command Phase"

+

+	XOR	A

+

+WAIREQ:

+	PUSH	AF		;Auf Kommandoanforderung warten

+	IN	A,(C)

+	AND	MDC+MREQ+MIO+MMSG

+	CP	MDC+MREQ

+	JR	Z,RDYCOM	;Ok ->

+

+	POP	AF

+	DEC	A

+	JR	NZ,WAIREQ

+

+;	keine Reaktion der Schnittstelle: Versuchen Restbytes einzulesen  falls

+;	dies nicht der 2. Timeout ist.

+

+	LD	A,(TOFLG)	;Timeoutflag gesetzt ?

+	AND	A

+	LD	A,HARD+TIMOUT	;Timeout Fehler

+	JP	NZ,POPRET	;bereits gesetzt ->

+

+	LD	(TOFLG),A	;Timeoutflag setzen

+

+;	ggf. letztes Kommando abschliessen

+

+TENDLP:

+	IN0	A,(CIOAD)	;"Bus free" ?

+	BIT	BBUSY,A

+	JR	Z,BUSYOK	;Ja -> neu selektieren

+

+	CALL	CHKREQ

+	BIT	BIO,A

+	JR	NZ,INPU

+

+	XOR	A

+	OUT0	(SCSIP),A

+	JR	TENDLP

+

+INPU:

+	IN0	A,(SCSIP)

+	JR	TENDLP

+

+ILLMOD:

+	LD	A,HARD+ILLCOM	;Fehler bei Kommandoausgabe

+	JP	POPRET

+

+;	Kommando Ausgabe

+

+RDYCOM:

+	POP	AF		;Clear Stack

+	LD	BC,SCSIP+6*256	;6 Bytes ausgeben

+	EX	DE,HL

+

+CMNON:

+	CALL	CHKREQ

+	CP	MDC

+	JR	NZ,ILLMOD	;keine Kommandoausgabe -> Fehler

+

+	DI

+	OTIM			;Kommando ausgeben

+	EI

+	JR	NZ,CMNON	;Nicht fertig ->

+

+;	"Data Phase"

+

+	POP	HL		;B=0!

+	PUSH	HL

+	LD	A,H		;Datenlaenge = 0 ?

+	AND	3FH		;Bit 6 und 7 ausblenden

+	OR	L

+	JP	Z,NODAT		;Ja -> keine Datenphase

+

+	IF	NOT DMA

+

+	BIT	6,H		;Datentransfer per DMA ?

+	JR	Z,DTAPROG	;Nein -> per Programm

+

+	ENDIF

+

+;	CIO Pattern Match Logik aktivieren

+

+	DI

+	LD	C,CIOCTL	;CIO Control Register

+	LD	A,PCOMA		;Port A Command Register

+	OUT	(C),A

+	LD	A,20H		;Clear IP & IUS

+	OUT	(C),A

+	EI

+

+;*	IF	DMA AND EUMEL

+

+;*	BIT	7,H		;schreiben ?

+;*	JR	Z,POLWRIT

+

+;*	ENDIF

+

+;	DMA-Kanal 1 initialisieren (I/O Adresse wird in SCINIT gesetzt)

+

+	CALL	DMASTUP		;DMA-Adressen eintragen

+

+;*	IF	NOT EUMEL

+

+	BIT	7,H		;lesen ?

+	JR	Z,ISWRITE	;Nein ->

+

+;*	ENDIF

+

+	OR	CHGDIR		;Richtung aendern (I/O -> Memory)

+

+ISWRITE:

+	OUT0	(DCNTL),A

+	LD	A,ENABDMA	;DMA aktivieren

+	OUT0	(DSTAT),A

+

+;	Auf Kommandoende warten

+;	Die CIO ist so initialisiert dass der SCSI-Status "Status lesen"

+;	einen Pattern Match Zustand erzeugt

+

+WEND2:

+	LD	C,CIOCTL	;auf Pattern Match warten

+

+WAIEND:

+

+	IN0	L,(DSTAT)	;DMA Status pruefen

+	DI

+	LD	A,PCOMA		;Port A Command Register

+	OUT	(C),A

+	IN	A,(C)		;CIO Status lesen (Port A Statusregister)

+	BIT	5,A		;Interrupt pending ?

+	JR	NZ,DATRDY	;Ja -> Datentransfer beendet

+

+	EI

+	IN0	A,(CIOAD)

+	BIT	BBUSY,A		;steht Busy noch an ?

+	JR	Z,ILLEND

+

+	BIT	DE1,L		;DMA beendet ?

+	JR	Z,DMAEND

+

+NOEND:

+	IF	EUMEL

+	CALL	WARTE		;andere Tasks zulassen

+	ENDIF

+

+	JR	WAIEND

+

+;	Pruefen ob ein DMA-Fehler aufgetreten ist

+

+DMAEND:

+	IN0	A,(CIOAD)

+

+	BIT	BREQ,A		;Anforderung ?

+	JR	Z,NOEND		;Nein -> warten

+

+	AND	MDC+MIO+MMSG

+	CP	MDC+MIO		;Statusanforderung ?

+	JR	Z,CMNST		;Ja -> alles in Ordnung

+

+;	Fehler beim DMA-Transfer

+

+	LD	L,HARD+DMAERR

+	JR	WENDLP

+

+DATRDY:

+	IN	A,(C)		;Pattern match testen

+	EI

+	BIT	1,A

+	JR	Z,ENDKL		;Nein -> DMA hat Status geklaut

+

+CMNST:

+

+	IN0	L,(SCSIP)	;Status holen

+

+;	Letztes Statusbyte holen (Kommandoende)

+

+	CALL	CHKREQ

+	IN0	H,(SCSIP)	;letzten Status einlesen (Dummy Read)

+	CP	MDC+MIO+MMSG	;wirklich letzter Status ?

+	JR	Z,ENDOK		;Ja ->

+

+ILLEND:

+	LD	L,HARD+ENDERR

+

+ENDOK:

+	LD	A,L		;Status in A

+

+POPRET:

+	POP	BC

+

+;	Interrupt Daisy Chain der CIO freigeben

+

+	DI

+	LD	L,PCOMA		;Port A Command

+	OUT0	(CIOCTL),L

+	LD	L,20H		;Clear IP & IUS

+	OUT0	(CIOCTL),L

+	EI

+	RET

+

+ENDKL:

+

+;	DMA anhalten falls dieser nicht beendet wurde

+

+	LD	L,DISDMA	;Reset Kanal 1 DMA

+	OUT0	(DSTAT),L

+	LD	L,2		;Error Status

+

+WENDLP:

+	IN0	A,(CIOAD)	;"Bus free" ?

+	BIT	BBUSY,A

+	JR	Z,ENDOK		;Ja -> fertig

+

+	CALL	CHKREQ

+	BIT	BIO,A

+	JR	NZ,INPU2

+

+	XOR	A

+	OUT0	(SCSIP),A

+	JR	WENDLP

+

+INPU2:

+	IN0	A,(SCSIP)	;Dummy Read

+	JR	WENDLP

+

+	IF	NOT DMA

+

+;	Datentransfer bei Schreiben per Programm

+

+POLWRIT:

+	CALL	CHKREQ

+	JR	NZ,NODAT	;Kein Datentransfer -> Fehler

+

+	BIT	BIO,A		;Lesen von SCSI ?

+	JR	NZ,DIRERR	;Ja -> falsche Richtung

+

+	LD	A,(DE)		;Daten holen

+	OUT0	(SCSIP),A	;und ausgeben

+

+	INC	DE		;Datenadresse inkrementieren

+	DEC	HL		;Datenlaenge dekrementieren

+	LD	A,H		;Fertig ?

+	AND	3FH

+	OR	L

+	JR	NZ,POLWRIT	;Nein -> naechstes Byte holen

+

+	JP	WEND2

+

+;	Falsche Datenrichtung (falsches Kommando)

+

+DIRERR:

+	LD	A,HARD+ILLD

+	JR	POPRET

+

+;	Datentransfer per Programm

+

+DTAPROG:

+	CALL	CHKREQ

+	JR	NZ,NODAT	;Kein Datentransfer -> Fehler

+

+	BIT	BIO,A		;Lesen von SCSI ?

+	JR	NZ,RDSCSI	;Ja ->

+

+	BIT	7,H		;Schreiben definiert ?

+	JR	NZ,DIRERR	;Nein -> falsche Richtung !!

+

+	LD	A,(DE)		;Daten holen

+	OUT0	(SCSIP),A	;und ausgeben

+

+	JR	CMDIO

+

+RDSCSI:

+	BIT	7,H		;Lesen definiert ?

+	JR	NZ,RDSOK	;Ja ->

+

+;	Falsche Datenrichtung (falsches Kommando)

+

+DIRERR:

+	LD	A,HARD+ILLD

+	JR	POPRET

+

+RDSOK:

+	IN0	A,(SCSIP)	;Daten holen

+	LD	(DE),A

+

+CMDIO:

+	INC	DE		;Datenadresse inkrementieren

+	DEC	HL		;Datenlaenge dekrementieren

+	LD	A,H		;Fertig ?

+	AND	3FH

+	OR	L

+	JR	NZ,DTAPROG	;Nein -> naechstes Byte holen

+

+	ENDIF

+

+;	Status lesen

+

+NODAT:

+	CALL	CHKREQ

+	CP	MDC+MIO		;Status Anforderung ?

+	JR	NZ,ILLEND	;Nein -> Fehler

+	JR	CMNST

+

+;................................................................

+;

+;	Pruefen ob Busy und Request anstehen

+;

+;	Exit:	A = CIO Port A SCSI-Status Leitungen (ohne BUSY und REQ)

+;		F = Z: Datentransfer

+;

+CHKREQ:

+	IN0	A,(CIOAD)

+	BIT	BBUSY,A		;Busy aktiv ?

+	JR	Z,INCOMPL	;Nein -> vorzeitiges Kommandoende

+

+	BIT	BREQ,A		;Anforderung ?

+	JR	Z,CHKREQ	;Nein -> warten

+

+	AND	MDC+MIO+MMSG

+	BIT	BDC,A

+	RET

+

+INCOMPL:

+	POP	HL		;Skip Return Adresse

+	LD	A,HARD+EARLYE	;vorzeitiges Ende

+	JR	POPRET

+

+;................................................................

+;

+;	DMASTUP

+;

+;	Adressen des DMA-Kanals 1 eintragen

+;

+;	Entry:	DE = log. Adresse

+;		DE = 0: auf 6502 Bereich FC00 schalten

+;

+;	Exit:	A = (DCNTL) Kanal 1

+;

+DMASTUP:

+	DI

+	LD	A,D

+	OR	E

+	JR	NZ,DOCHG

+

+	LD	A,6

+	LD	D,0FDH		; 6FD00..6FEFF ist SCSI-Puffer

+	JR	NOCHG

+

+DOCHG:

+	CALL	PHYSADR		;Physikalische Adresse bestimmen (in ADE)

+

+NOCHG:

+	LD	C,MAR1L		;Adressen eintragen

+	OUT	(C),E		;Speicheradresse eintragen (LSB)

+	INC	C

+	OUT	(C),D		;mittleres Byte

+	INC	C

+	OUT	(C),A		;upper Byte

+	LD	C,BCR1L

+	OUT	(C),L		;Byte Zaehler (LSB)

+	INC	C

+	LD	A,H

+	AND	3FH

+	OUT	(C),A		;MSB

+

+	IN0	A,(DCNTL)	;DMA-Richtung setzen

+	AND	CH1MSK		;nur DMA-Kanal 1 Bits veraendern !

+	EI

+	RET

+

+;................................................................

+;

+;	P H Y S A D R

+;

+;	Umrechnung der logischen in eine physikalische Adresse

+;

+;	Entry:	DE = logische Adresse im 64K Adressraum

+;

+;	Exit:	DE = niederwertiger Teil der phys. Adr. im 512K Adr.-raum

+;		A  = hoechstwertiges Nibble der phys. Adr.

+;		alle anderen Register bleiben unveraendert

+;

+PHYSADR:

+	INC	D		;Fuer Vergleiche

+	IN0	A,(CBAR)	;Common Bank Area Register

+	PUSH	AF

+	AND	0F0H		;Common Area Teil ausmaskieren

+	CP	D		;D >= Common Area 1 Anfang ?

+	JR	C,COMA1		;Ja -> (Stack!!)

+

+	POP	AF

+	AND	0FH		;Bank Area Teil ausmaskieren

+	RLCA

+	RLCA

+	RLCA

+	RLCA			;und ins MSN schieben

+	CP	D		;D >= Bank Area Anfang ?

+	JR	C,BAR		;Ja ->

+

+;	Common Area 0 (unveraenderte Adresse)

+

+	DEC	D		;D wieder korrigieren

+	XOR	A

+	RET

+

+;	Bank Area

+

+BAR:

+	DEC	D

+	IN0	A,(BBR)		;Bank Base Register

+

+CMND:

+	PUSH	BC

+	LD	B,0

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B		;B = MSN Phys. Adr., A = mittleres MSB

+

+	ADD	A,D		;+ Offset zum Area Anfang

+	LD	D,A		;wieder in D (mittleres MSB der phys. Adr.)

+	LD	A,B		;A = MSN

+	ADC	A,0		;ggf. 64K-Uebertrag beruecksichtigen

+	POP	BC

+	RET

+

+;	Common Area 1

+

+COMA1:

+	DEC	D		;D wieder korrigieren

+	POP	AF		;Clear Stack

+	IN0	A,(CBR)

+	JR	CMND

+

+	IF	EUMEL

+

+;................................................................

+;

+;	C H K A C C

+;

+;	Auf Freiwerden des SCSI-Controllers warten

+;

+CHKACC:

+	LD	A,(SEMA)	;SCSI-Zugriffssemaphor

+	AND	A		;0=frei

+	JR	Z,ISFREE	;Ja ->

+	CALL	WARTE

+	JR	CHKACC

+

+ISFREE:

+	DEC	A

+	LD	(SEMA),A	;Semaphor sperren

+	RET

+

+	ENDIF

+

+;................................................................

+;

+;	I N I T S

+;

+;	Initialisierung der SCSI-Schnittstelle

+;

+;	CIO und DMA Kanal 1 werden initialisiert

+;	Floppy Parameter werden gesetzt

+;

+;	Exit:	AF', BC, DE und HL werden veraendert

+;		AF = Status des Floppy Parameters setzens

+;

+INITS1:

+	IF 	NOT EUMEL

+	CALL	INICIO

+	ENDIF

+

+INITS:

+	IF	EUMEL

+	XOR	A

+	LD	(SEMA),A	;Semaphor initialisieren

+	ENDIF

+

+	LD	C,DISDMA

+	OUT0	(DSTAT),C	;Kanal 1 stoppen, beide Kanaele keine

+				; Interrupts zulassen

+

+;	DMA - Kanal 0 intialisieren (Memory <--> Memory Transfer)

+

+	LD	C,2		; Memory <--> Memory im Burst Mode

+	OUT0	(DMODE),C

+

+;	DMA - Kanal 1 initialisieren (Memory <--> SCSI I/O - Transfer)

+

+	LD	BC,SCSIP	;DMA-Kanal 1 I/O Adresse auf SCSI setzen

+	OUT0	(IAR1L),C

+	OUT0	(IAR1H),B

+

+;	Warten bis Harddisk hochgelaufen ist

+

+	IF NOT EUMEL

+WRTHRD:

+	LD	DE,TESTRD

+	LD	BC,0

+	CALL	SCSIIO

+	AND	A		;Drive not Ready ?

+	JR	NZ,WRTHRD	;Ja -> warten

+

+	ENDIF

+

+;	Teil der bei Controller RESET neu initialisert werden muss

+

+SCINIT:

+

+;	Floppy Parameter setzen

+

+	LD	DE,FLPINI	;Initialize Kommando

+	LD	HL,FLPDAT	;Parameter

+	LD	BC,PARALNG	;Anzahl der Parameter Bytes

+	CALL	SCSIIO

+

+	LD	L,A

+	LD	A,(FLPTRKS)

+	CP	40		;40 Tracks ?

+	LD	A,L

+	LD	BC,0

+	LD	DE,SGLSTEP	; Floppy im Doppelstep Modus

+	JR	NZ,NODBLS	;Nein -> kein Double Step

+	LD	DE,DBLSTEP

+NODBLS:

+	JP	SCSIIO

+

+;................................................................

+;

+;	I N I C I O

+;

+	IF NOT EUMEL

+INICIO:

+	DI

+

+;	CIO initialisieren

+

+	IN0	C,(CIOCTL)	;Dummy Read

+	LD	B,INILNG

+	LD	HL,INITAB	;CIO Initialisierungstabelle

+

+INILOP:

+	LD	C,(HL)		;Wert holen

+	OUT0	(CIOCTL),C	;und ausgeben

+	INC	HL

+	DJNZ	INILOP

+	RET

+	ENDIF

+

+;................................................................

+;

+;	P A R K H D

+;

+;	Harddisk in Parkposition fahren

+;

+PARKHD:

+

+	LD	BC,0

+	LD	DE,PARSEK	; seek (0)

+	CALL	SCSIIO

+	LD	DE,RECAL	; Recalibrate

+	JP	SCSIIO

+

+	IF	0

+	LD	HL,INIHDT

+	LD	DE,RDINI

+	LD	BC,RDDAT+PARALNG

+

+	CALL	SCSIIO		;Harddisk Konfiguration lesen

+

+	LD	HL,(INIHDT)	;Spuranzahl (H=LSB!)

+	PUSH	HL

+	INC	H		;um 1 erhoehen

+	JR	NZ,INCOK

+

+	INC	L

+INCOK:

+	LD	(INIHDT),HL

+	LD	HL,RDINI

+	LD	DE,INIHDT

+	LD	(HL),INITDRV	;Init-Schreibkommando eintragen

+	EX	DE,HL

+	LD	BC,PARALNG

+

+	CALL	SCSIIO		;neue, groessere, Konfiguration setzen

+

+	POP	HL

+

+	LD	D,L

+	LD	L,H

+	LD	H,D		;Spuranzahl richtig

+	LD	A,(INIHDT+2)	;Kopfanzahl

+	LD	E,L

+

+HDLOP:

+	DEC	A

+	JR	Z,HDAOK

+

+	ADD	HL,DE

+	JR	HDLOP

+

+HDAOK:

+	XOR	A

+	ADC	HL,HL

+	RLCA

+	ADC	HL,HL		;*4

+	RLCA

+	ADC	HL,HL		;*8

+	RLCA

+	ADC	HL,HL		;*16

+	RLCA

+	ADC	HL,HL		;*32

+	RLCA

+

+;	max. Blocknr. in AHL

+

+	DEC	HL		;-1: 1.Block hinter formatiertem Bereich

+

+	LD	(BKNR),A

+	LD	A,L

+	LD	L,H

+	LD	H,A

+

+	LD	(BKNR+1),HL	;Blocknr. eintragen

+	LD	BC,0		;keine Daten

+	LD	DE,PARSEK

+

+	JP	SCSIIO		;Drive parken

+

+	ENDIF

+

+;................................................................

+;

+;	H D I O

+;

+;	Lesen / Schreiben eines Blocks (512 Byte) auf der Harddisk

+;

+;	Entry:	A  = Kommandocode (0 = Lesen, 1 = Schreiben)

+;		HL = Hauptspeicheradresse 	

+;		BC = Pointer auf Drive und Offset (256 Byte Bloecke)

+;		DE = (512 Byte-) Blocknummer (ohne Offset)

+;

+;		BC + 2 -> Low (Block Offset)

+;		BC + 1 -> Middle (Block Offset)

+;		BC + 0 -> High (BLock Offset) + Drive * 32 

+;

+;	Exit:	A  = Status (0=ok, sonst SCSIIO-Fehlercode)

+;		BC, DE, HL, AF' = veraendert

+;

+FDIO:

+HDIO:

+	PUSH	AF

+	XOR	A

+	LD	(TOFLG),A	;Timeoutflag ruecksetzen

+

+	IF	EUMEL

+

+	CALL	CHKACC		;Pruefen ob SCSI-Controller bereits belegt ist

+

+	ENDIF

+

+	LD	A,(BC)

+	BIT	6,A		;Floppy Drive ?

+	JP	NZ,FDIO1	;Ja ->

+

+	POP	AF

+

+	CP	2

+	JR	C,COMOK1

+

+	LD	A,20H		;illegal Command Code

+	RET

+

+COMOK1:

+	PUSH	HL

+	PUSH	BC

+	CALL	CMSCOM		;Kommandonr. umrechnen

+	LD	(HDIOTB),A	;Kommando eintragen

+	POP	BC

+	LD	HL,(CODALN)	;Datenlaenge

+	PUSH	HL

+	LD	HL,HDIOTB+3	;Harddisk Read Command

+

+	SLA	E		;Blocknummer * 2 (256 Byte Bloecke)

+	RL	D

+

+CMFDIO:

+	INC	BC

+	INC	BC

+	LD	A,(BC)		;Low Offset

+	ADD	A,E		;+ Low Block No.

+	LD	(HL),A		;eintragen

+	DEC	HL

+	DEC	BC

+	LD	A,(BC)		;Middle Offset

+	ADC	A,D		;+ Block No.

+	LD	(HL),A

+	DEC	HL

+	DEC	BC

+	LD	A,(BC)

+	LD	(HL),A		;Drive + High Blocknr.

+	DEC	HL

+	EX	DE,HL		;DE = Read Command Adresse

+	POP	BC		;Datenlaenge

+	POP	HL		;Hauptspeicheradresse

+	CALL	SCSIIO

+

+	IF	EUMEL

+

+	PUSH	AF

+	XOR	A

+	LD	(SEMA),A	;Semaphor freigeben

+	POP	AF

+

+	ENDIF

+

+	RET

+

+;................................................................

+;

+;	I N I F L P

+;

+;	Blockanzahl der Floppy ermitteln (nur BC, A und HL veraendern !!)

+;

+;	Eingang:A = Anzahl Spuren, Voreinstellung (40 oder 80)

+;	Exit:	BC = Blockanzahl der Floppy (in 512 Byte Bloecken)

+;		A  = 0 = ok, <> 0 = SCSI-Fehlercode

+;

+INIFLP:

+	PUSH	AF		; Anzahl Spuren Voreinstellung (40, 80)

+

+	IF	EUMEL

+	CALL	CHKACC		;keine Doppelzugriffe !!

+	ENDIF

+

+	XOR	A

+	LD	(TOFLG),A	;Timeoutflag ruecksetzen

+	POP	AF

+

+	PUSH	HL

+	PUSH	DE

+

+	LD	(FLPTRKS),A	;Spuren eintragen

+	CALL	SCINIT		;Floppy Parameter setzen

+

+	LD	A,2		;Retry-Anzahl

+RETR1:

+	PUSH	AF

+

+	LD	DE,SEK18	; Auf Block 18 (Track 2)

+	LD	BC,RDDAT+512

+	LD	HL,0

+	LD	A,1

+	CALL	NRETSC		;Read ohne Retries 

+

+	AND	7FH

+	LD	C,A

+	JR	Z,OKA		; Format ok

+

+	CP	TSNF		; Target Sector not found ?

+	CALL	Z,TOB		; anderes Format (B) versuchen

+

+	POP	AF		; Anderer Floppy Fehler, Retries

+	DEC	A

+	JR	NZ,RETR1

+

+	XOR	A

+	LD	(SEMA),A

+

+	LD	A,C		; permanenter Fehler

+

+	LD	BC,0

+	POP	DE

+	POP	HL

+	RET

+

+;	auf B Spuren umschalten

+

+TOB:

+	LD	A,(FLPTRKS)

+	XOR	01111000B	; aus 40 wird 80, aus 80 wird 40

+	LD	(FLPTRKS),A

+	CALL	SCINIT		;Floppy Parameter setzen

+	LD	C,TSNF

+	RET

+

+OKA:

+	POP	AF

+	POP	DE

+	POP	HL

+

+	LD	BC,(FLPTRKS)

+

+	IF	SEC8

+	LD	B,8

+	ELSE

+	LD	B,9

+	ENDIF

+

+	MLT	BC

+	SLA	C		;*2: 2 Seiten

+	RL	B

+	XOR	A

+

+	IF	EUMEL

+	LD	(SEMA),A	;Sempahor wieder freigeben

+	ENDIF

+

+	RET	

+

+;................................................................

+;

+;	F D I O

+;

+;	Lesen oder Schreiben eines Blocks (512 Byte) auf der Floppy Disk

+;

+;	Entry:	A  = Kommandocode (0=Lesen, 1=Schreiben, 2=Formatieren)

+;		HL = Hauptspeicheradresse 	

+;		BC = Pointer auf Drive und Offset (512 Byte Bloecke)

+;		DE = (512 Byte-) Blocknummer (ohne Offset)

+;

+;		BC + 2 -> Low (Block Offset)

+;		BC + 1 -> Middle (Block Offset)

+;		BC + 0 -> High (BLock Offset) + Drive * 32 

+;

+;	Exit:	A  = Status (0=ok, sonst SCSIIO-Fehlercode)

+;		BC, DE, HL, AF' = veraendert

+;

+FDIO1:

+	POP	AF

+	CP	3

+	JR	C,COMOK

+

+	LD	A,20H		;illegal Command Code

+	RET

+

+COMOK:

+	PUSH	HL

+	PUSH	BC

+	CP	2

+

+	CALL	Z,SW80		;Beim Formatieren immer 2x80 Spuren 

+

+	CALL	CMSCOM		;Kommando und Datenlaenge best.

+	LD	(FDIOTB),A	;Kommandocode eintragen

+

+	LD	A,C

+	LD	(FDIOTB+4),A	;Block Count / Skew Faktor eintragen

+

+;	DE enthaelt Blocknummer x aus EUMEL-Sicht. 

+;	Block x meint die 512 Bytes ab 512*x auf Floppy.

+;

+;	Aus Blocknummer: Spur, Sector, Seite berechnen

+;

+;	EUMEL behandelt, im Gegensatz zum SCSI-Controller,

+;	zunaechst die Oberseite der Floppy und erst dann die Unterseite.

+ 

+	LD	H,D

+	LD	L,E

+	XOR	A

+

+	IF	SEC8

+	LD	DE,8

+	ELSE

+	LD	DE,9		;Anzahl der Sektoren pro Spur

+	ENDIF

+

+DIVLOP:

+	AND	A

+	SBC	HL,DE

+	JR	C,DIVDON

+	INC	A

+	JR	DIVLOP 

+

+DIVDON:

+	ADD	HL,DE

+

+;	A = Spurnummer; HL = sector/seite

+

+	LD	BC,(FLPTRKS)	;Spuren pro Seite (B undefiniert !)

+	CP	C		;Rueckseite ?

+	JR	C,NOBACK	;Nein -> alles ok

+

+;	Rueckseite: Spurnummer := Spurnummer - Spuranzahl

+;		    Sektornummer := Sektornummer + Sektoranzahl (9)

+

+	SUB	C		;tatsaechliche Spurnummer

+	ADD	HL,DE		;HL = sector (cylinder)

+

+;	SCSI Blocknummer aus Spur und Sektor ausrechnen

+

+NOBACK:

+	LD	D,A

+

+	IF	SEC8

+	LD	E,16

+	ELSE

+	LD	E,18

+	ENDIF

+

+	MLT	DE		;DE = Spur * 18

+	ADD	HL,DE		;HL = Spur * 18 + Sektor (cylinder)

+	EX	DE,HL

+

+;	SCSI Blocknummer in DE

+

+	POP	BC		;Offsetadresse wiederherstellen

+

+	LD	HL,(CODALN)

+	PUSH	HL

+	LD	HL,FDIOTB+3	;Floppy Read Command

+	JP	CMFDIO

+

+SW80:

+	PUSH	AF

+	PUSH	BC

+	PUSH	DE

+	PUSH	HL

+

+	LD	A,80		; 80 Tracks

+	LD	(FLPTRKS),A

+	CALL	SCINIT

+

+	POP	HL

+	POP	DE

+	POP	BC

+	POP	AF

+	RET

+

+;................................................................

+;

+;	C M S C O M

+;

+;	Entry:	A  = Funktionsnr.

+;

+;	Exit:	A  = SCSI-Kommandonr.

+;		C  = Block Count / Skew Faktor

+;		HL = veraendert

+;		B  = veraendert

+;		(CODALN) = Datenlaenge

+;

+CMSCOM:

+	LD	BC,LGTAB	;Datenlaenge ermitteln

+	LD	L,A

+	LD	H,0

+	ADD	HL,HL		;16 Bit Werte

+	ADD	HL,BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,(HL)

+	LD	(CODALN),BC

+

+	LD	HL,COMTB	;Kommandonr. umrechnen

+	ADD	A,L

+	LD	L,A

+	LD	A,H

+	ADC	A,0

+	LD	H,A

+	LD	A,(HL)		;SCSI-Kommando holen

+

+	LD	BC,BCSKTB-COMTB

+	ADD	HL,BC

+	LD	C,(HL)		;Block Count ./. Skew Faktor holen

+

+	RET

+

+;****************************************************************

+;

+;	SCSI-Kommandotabellen

+;

+;	Achtung: Die Schreib- und Lesetabellen werden vom Programm

+;	         geaendert (muessen im RAM stehen)

+;

+COMTB:

+	DEFB	SREAD		;Lesekommando

+	DEFB	SWRITE		;Schreibkommando

+	DEFB	FORMAT		;Formatierkommando

+

+LGTAB:

+	DEFW	512+DMATRA+RDDAT ;Datenlaenge Lesen

+	DEFW	512+DMATRA	;Datenlaenge schreiben

+	DEFW	0		;Datenlaenge formatieren

+

+BCSKTB:

+	DEFB	1		;1 Block lesen (nur Floppy)

+	DEFB	1		;1 Block schreiben (")

+	DEFB	4		;Skew 4 (nur Floppy)

+

+;................................................................

+;

+	IF NOT EUMEL

+TESTRD:

+	DEFB	0,0,0,0,0,0	;Test Ready (Harddisk)

+	ENDIF

+

+

+FDIOTB:				;Lesen / Schreiben auf Floppy Disk

+	DEFB	SREAD		;Lesekommando (wird ueberschrieben)

+	DEFB	FDDRIV*32+40H	;Floppy Drive (wird ueberschrieben)

+	DEFB	0, 0		;Block Middle und Low (")

+	DEFB	1		;Block Count / Interleave (Format)

+	DEFB	80H		;keine Retries

+

+

+HDIOTB:				;Lesen / Schreiben auf Harddisk

+	DEFB	SREAD		;Lesekommando (wird ueberschrieben)

+	DEFB	0		;Harddisk Drive (wird ueberschrieben)

+	DEFB	0, 0		;Block Middle und Low (")

+	DEFB	2		;Block Count

+	DEFB	0H		;Retries

+

+	IF 0

+RDINI:

+	DEFB	RINIT		;Harddisk Konfiguration lesen

+	DEFB	0		;Harddisk Drive

+	DEFB	0,0,0,0

+INIHDT:

+	DEFB	0,0,0,0,0

+	DEFB	0,0,0,0,0

+	ENDIF

+

+

+RECAL:

+	DEFB	RECALIBR	;Drive recalibrieren

+	DEFB	0		; Harddisk

+	DEFB	0,0,0,80H	; keine Retries

+

+

+PARSEK:

+	DEFB	SEEK

+	DEFB	0		;Harddisk

+	DEFB	0,0,0

+	DEFB	80H		;keine Retries

+

+

+FLPINI:				;Setze Floppy Parameter

+	DEFB	INITDRV		;Initialize Kommando

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0, 0, 0, 0	;nicht benutzt

+FLPDAT:				;Floppy Disk Parameter zu INIFLP

+	DEFB	0

+FLPTRKS:

+	IF	TRK40

+	DEFB	40		;Spuranzahl

+	ELSE

+	DEFB	80

+	ENDIF

+

+	DEFB	2		;2 Koepfe (doppelseitig)

+	DEFB	1*16+3		;4 ms Steprate, MFM

+	DEFB	3		;512 Byte/Sektor

+	DEFB	15		;Head Unload Time (240ms)

+	DEFB	10		;Motor Start Time (0.1 s)

+	DEFB	23		;Head Load Time (46 ms)

+	DEFB	3		;Motor off time (3 s)

+	IF SEC8

+	DEFB	0		;8 Sektoren/Spur

+	ELSE

+	DEFB	1		;9 Sektoren/Spur

+	ENDIF

+

+PARALNG	EQU	$-FLPDAT

+

+

+DBLSTEP:

+	DEFB	FD48TPI		;Doppel Step aktivieren

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0, 0, 0, 0	;nicht benutzt

+

+

+SGLSTEP:

+	DEFB	FD96TPI		;auf Single Step zurueckschalten

+	DEFB	FDDRIV*32+40H

+	DEFB	0, 0, 0, 0	;nicht benutzt

+

+

+SEK18:

+	DEFB	SREAD		;auf Block positionieren

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0,18,1,80H	;Track 2, ein Block, keine Retries

+

+

+;...........................................................................

+;

+;	CIO Initialisierungs Tabelle

+;

+

+	IF	NOT EUMEL

+

+INITAB:

+;*	DEFB	0,1		;Set Reset Bit

+	DEFB	0,0		;Reset Reset Bit

+	DEFB	1,0		;Master configuration control

+

+;	SCSI-Interface-Leitungen

+

+	DEFB    20H,00000010B	;Port A Mode Reg.

+	DEFB	22H,01000010B	;Port A Data Path Polarity Reg.

+	DEFB	23H,10111101B	;Port A Data Direction Reg.

+	DEFB	24H,0		;Port A Special I/O Control

+	DEFB	25H,10101100B	;Port A Pattern Polarity

+	DEFB	26H,0		;Port A Pattern Transition

+	DEFB	27H,10101100B	;Port A Pattern Mask

+	DEFB	0DH,0		;Port A Data

+	DEFB	02H,18H		;Port A Interrupt Vector (** TEST **)

+	DEFB	PCOMA,11100000B	;Port A Command: Clear IE

+	DEFB	PCOMA,00100000B	;Port A Command: Clear IUS & IP

+

+;	General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske)

+

+	DEFB	06H,00000001B	;Port C Data Direction Reg.

+	DEFB	05H,00001000B	;Port C Data Path Polarity Reg.

+	DEFB	07H,0		;Port C Special I/O Control

+	DEFB	0FH,4		;Port C Data Register

+

+;	Centronics Interface

+

+	DEFB	28H,10010000B	;Port B Mode

+	DEFB	29H,01000000B	;Port B Handshake: Strobed

+	DEFB	09H,00100000B	;Port B Command: Clear IUS & IP

+	DEFB	2AH,0		;Port B Data Path Polarity

+	DEFB	2CH,0		;Port B Special I/O Control

+	DEFB	03H,30H		;Port B Interrupt Vektor

+

+;	Deskew Timer

+

+	IF 0

+	DEFB	1EH,00000010B	;Counter 3 Mode Specification

+	DEFB	0CH,00100000B	;Counter 3 Command and Status

+	DEFB	1AH,0		;Counter 3 Time Constant MSB

+	DEFB	1BH,7		;Counter 3 Time Constant LSB (2,268 us)

+	DEFB	0CH,11100100B	;Counter 3 Gate Enable

+	ENDIF

+

+;	Timer

+

+	DEFB	1CH,10000000B	;Counter/Timer 1 Mode Spec. Reg.

+	DEFB	1DH,10000000B   ;Counter/Timer 2 Mode Spec. Reg.

+	DEFB	0AH,00100000B	;Counter/Timer 1 Command: Clear IP & IUS

+	DEFB	0BH,00100000B	;Counter/Timer 2 Command: Clear IP & IUS

+	DEFB	16H,HIGH 38400  ;Time Constant 1 MSB

+	DEFB	17H,LOW 38400   ;Time Constant 1 LSB

+	DEFB	18H,0		;Time Constant 2 MSB, mit Timer 1 zus. 50ms

+	DEFB	19H,4		;Time Constant 2 LSB

+	DEFB	04H,18H		;Interrupt Vector Counters

+

+;	CIO-Interrupts freigeben

+

+	DEFB	01H,11110111B	;Master Config. Register

+	DEFB	00H,10000010B	;Master Interrupt Enable

+

+	DEFB	09H,11000000B	;Port B Command: Set IE

+

+	DEFB	0BH,11000110B	;Counter/Timer 2 Command: Set IE

+ 	DEFB	0AH,11100110B	;Counter/Timer 1 Command: Clear IE

+

+INILNG	EQU	$-INITAB

+	ENDIF

+

+

+;****************************************************************

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS
new file mode 100644
index 0000000..7316dac
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS
@@ -0,0 +1,271 @@
+{---------------------- Include File fuer SCSI-Routinen ---------------------

+  Michael Staubermann, 27.06.86, Version 1.1, ohne DMA

+

+  Die CIO (Kanal A) muss fuer SCSI initialiert worden sein (BIOS macht das)

+

+  Prozeduren/Funktionen :

+

+  FUNCTION port0 (portnr : INTEGER) : BYTE ;

+    Liest des Port mit Addressbits A8..A15 = 0

+

+  PROCEDURE port0out (portnr, wert : INTEGER) ;

+   Schreibt den 'wert' in den Port mit A8..A15 = 0

+

+  PROCEDURE scsiio (VAR datenbereich ; kommando : KOMMANDOTYPE ;

+                    datenlaenge : INTEGER) ;

+   SCSI-Controller fuehrt das Kommando aus, Je nach Eingabe oder Ausgabe

+   wird der Datenbereich gelesen oder beschrieben. Es ist sichergestellt,

+   das nicht mehr als 'datenlaenge' Bytes in 'datenbereich' geschrieben

+   werden.

+

+ PROCEDURE floppy_init ;

+  Initialisiert den Controller fuer 512 Byte/Sektor, 9 Sektoren, 2*80 Track

+  Floppy-Format (720K, grosses IBM-Format)

+

+ PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Liest mehrere ('sektoren') 512-Byte Sektoren ab der (SCSI-) Blocknummer

+  von der Floppy. Der 'datenbereich' muss 512 * 'sektoren' Bytes fassen koennen.

+

+ PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie fd_read, schreibt aber auf die Floppy.

+

+ PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie fd_read, liest aber 256-Byte Sektoren von der Harddisk. Der

+  'datenbereich' muss 256 * 'sektoren' Bytes fassen koennen.

+

+ PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie hd_read, schreibt aber auf die Harddisk.

+

+ FUNCTION scsi_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ;

+  Aus der EUMEL-Blocknummer wird die SCSI-Blocknummer berechnet. EUMEL

+  behandelt im Gegensatz zum SCSI-Controller, erst die Oberseite und dann

+  die Unterseite der Floppy. Da die EUMEL-Sektoren nicht SCSI-physisch

+  hintereinander zu liegen brauchen, sollte man mehrere Sektoren nicht

+  mit einer 'sektoren'-Angabe groesser '1' lesen, sondern in einer Schleife

+  jede Blocknummer neu berechnen und dann einlesen.

+

+

+-----------------------------------------------------------------------------}

+

+

+TYPE KOMMANDOTYPE = ARRAY[1..6] OF BYTE ;

+     STRING77 = STRING[77] ;

+

+FUNCTION port0 (portnr : INTEGER) : BYTE ;

+ BEGIN

+  INLINE (6/0) ; { B-Register 0 }

+  port0 := port[portnr]

+ END ;

+

+

+PROCEDURE port0out (portnr, wert : INTEGER) ;

+ BEGIN

+  INLINE (6/0) ;

+  port[portnr] := wert

+ END ;

+

+

+PROCEDURE scsiio (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ;

+                  datenlaenge : INTEGER) ;

+ VAR i, status : INTEGER ;

+     statusbereich : ARRAY[1..4] OF BYTE ;

+     request_status : KOMMANDOTYPE ;

+

+

+PROCEDURE fehler (meldung : STRING77) ;

+ BEGIN

+  writeln ('SCSI-Fehler: ', meldung) ;

+  halt

+ END ;

+

+

+procedure writehex(b:byte);

+var b1:byte;

+procedure writenibble(b:byte);

+   begin

+     b:=b+$30;

+     if(b>$39) then b:=b+7;

+     write(chr(b))

+   end;

+begin

+  b1:=b shr 4;  writenibble(b1);

+  b1:=b and $0f;writenibble(b1);

+end;

+

+FUNCTION scsi2 (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ;

+                 datenlaenge : INTEGER) : INTEGER ;

+CONST scsiport = $80 ;

+      cioad    = $52 ;

+      dstat    = $30 ;

+

+VAR addresse, ciowert : INTEGER ;

+

+

+ PROCEDURE check_request ; { Auf Busyende warten }

+  BEGIN

+   REPEAT

+    ciowert := port0 (cioad) ;

+{    IF (ciowert AND 8) = 0

+      THEN fehler ('vorzeitiges Ende') }

+   UNTIL (ciowert AND $80) = $80 ;

+   ciowert := ciowert AND $34

+  END ;

+

+

+PROCEDURE scsitrans (address,  datenlaenge : INTEGER) ;

+ BEGIN

+  INLINE($ED/$4B/datenlaenge/      { LD BC,(datenlaenge) }

+         $ED/$6B/address/          { LD HL,(address)     }

+         $ED/$38/$52/              { IN0 A,(CIOAD)       }

+         $CB/$7F/                  { BIT 7,A             }

+         $28/$F9/                  { JR Z,F9H            }

+         $E6/$34/                  { AND 34H             }

+         $CB/$6F/                  { BIT 5,A             }

+         $C0/                      { RET NZ              }

+         $CB/$57/                  { BIT 2,A             }

+         $20/$06/                  { JR NZ,rdscsi        }

+         $7E/                      { LD A,(HL)           }

+         $ED/$39/$80/              { OUT0 (SCSIP),A      }

+         $18/$04/                  { JR cmdio            }

+         $ED/$38/$80/              { rdscsi:IN0 A,(SCSIP)}

+         $77/                      { LD (HL),A           }

+         $ED/$A1/                  { cmdio: CPI   = DEC BC, INC HL PE:BC=0 }

+         $EA/*-$1D)                { JP PE,*-   }

+                                   { nodat: RET }

+ END { scsitrans } ;

+

+

+BEGIN { scsi2 }

+

+ { Controller selektieren }

+ ciowert := port0 (cioad) ;

+ port0out (cioad, ciowert OR 2) ;

+ port0out (cioad, ciowert AND $FB) ;

+

+ { Auf Kommandoanforderung warten }

+ WHILE (port0 (cioad) AND $B4) <> $A0 DO ; { warten, ggf Timeout testen }

+

+ { Kommando ausgeben }

+ FOR i := 1 TO 6 DO

+  BEGIN

+   check_request ;

+   port0out (scsiport, kommandobereich[i])

+  END ;

+

+ { Datenphase ohne DMA }

+ scsitrans (addr (datenbereich), datenlaenge) ;

+

+ { Status abholen }

+ check_request ;

+ IF ciowert <> $24

+    THEN BEGIN

+     REPEAT

+      ciowert := port0 (scsiport) ;

+      check_request ;

+     UNTIL ciowert <> $04 ;

+     scsi2 := $FF ; { SCSI-Fehler }

+     END

+    ELSE scsi2 := port0 (scsiport) ; { Status }

+ check_request ;

+ i := port0 (scsiport) ; { zweites Statusbyte immer 00 }

+

+END { scsi2 } ;

+

+

+ BEGIN { scsiio }

+  status := scsi2 (datenbereich, kommandobereich, datenlaenge) ;

+  IF (status AND $9F) = $02

+     THEN BEGIN

+      fillchar (request_status, sizeof(request_status), 0) ;

+      request_status [1] := 3 ;

+      request_status [2] := status AND $60 ;

+      status := scsi2 (statusbereich, request_status, sizeof (statusbereich)) ;

+      write ('SCSI-Fehler: ') ;

+      FOR i := 1 TO sizeof (statusbereich) DO

+       BEGIN

+        writehex (statusbereich[i]) ;

+        write (' ')

+       END ;

+      halt

+      END

+     ELSE IF (status AND $9F) <> 0

+           THEN fehler ('Daten nicht ganz uebertragen')

+ END ;

+

+

+TYPE INITDATATYPE = ARRAY[1..10] OF BYTE ;

+CONST floppy_write  : KOMMANDOTYPE = ($0A, $40, 0, 0, 0, 0) ;

+      floppy_read   : KOMMANDOTYPE = ($08, $40, 0, 0, 0, 0) ;

+      harddisk_write: KOMMANDOTYPE = ($0A, $00, 0, 0, 0, 0) ;

+      harddisk_read : KOMMANDOTYPE = ($08, $00, 0, 0, 0, 0) ;

+      fd_initialize : KOMMANDOTYPE = ($0B, $40, 0, 0, 0, 0) ;

+

+      floppy_daten :  INITDATATYPE = (0, 80, 2, $13, 3, 30, 50, 23, 50, 1) ;

+                      { 9 Sektoren/Track, 80 Tracks, 512 Byte/Sektor }

+

+PROCEDURE floppy_init ;

+ VAR init_daten : INITDATATYPE ;

+ BEGIN

+  init_daten := floppy_daten ;

+  scsiio (init_daten, fd_initialize, sizeof (init_daten))

+ END ;

+

+

+PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := floppy_write ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 512) ;

+ END ;

+

+

+PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := harddisk_write ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 256) ;

+ END ;

+

+

+PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := floppy_read ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 512)

+ END ;

+

+

+PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := harddisk_read ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 256)

+ END ;

+

+

+FUNCTION floppy_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ;

+ VAR track, sektor : INTEGER ;

+ BEGIN

+  track := eumel_blocknummer DIV 9 ;

+  sektor := eumel_blocknummer MOD 9 ;

+  IF track >= 80 { Rueckseite }

+   THEN BEGIN

+    track := track - 80 ;

+    sektor := sektor + 9

+   END ;

+  floppy_blocknummer := track * 18 + sektor

+ END ;

+

+

diff --git a/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM
new file mode 100644
index 0000000..c198640
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX
new file mode 100644
index 0000000..061431a
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX
@@ -0,0 +1,15 @@
+SLR LOAD

+SLR SHARD

+SLR SCSI

+SLR CONOUT

+SLR DISK80

+SLR GRAFIK80

+SLR INTMOD

+SLR INT65

+SLR INIMOD

+M80=DISK/M

+L80 

+</P:0,LOAD,/P:0100,SHARD,SCSI,CONOUT,DISK80,GRAFIK80,INTMOD,INT65,INIMOD,DISK

+<EUMEL/N/E

+EBOOT

+<J

diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC b/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC
new file mode 100644
index 0000000..f84dd1a
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC
@@ -0,0 +1,1433 @@
+	TITLE	SHARD - Hardwareinterface fuer EUMEL 1.8 auf RUC 180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	SHARD: Interface EUMEL 1.8 -> RUC 64180 Karte

+;

+;	Version 1.3 - 05.01.87 

+;		1.3 mit log. und phys. Kanaelen

+;		1.4 - 26.06.87, Code gekuerzt, IOCONTROL clear_spooler

+;

+;	Copyright (C) 1985, 86, 87 by ruc:

+;			1.7.3:	Rainer Ellerbrake

+;				Eggeberger Str. 12

+;				4802 Halle (Westf.)

+;

+;			1.8:	Michael Staubermann

+;				Moraenenstr. 29

+;				4400 Muenster-Hiltrup

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT

+	GLOBAL	WARTE, SENDMSG, FLWTYP, MEMDMA

+	GLOBAL	RTCOK, HGOP

+	GLOBAL	HDOFS, HDLAST, CPMOFS, CPMLAST

+	GLOBAL	D0BLKS, D1BLKS, HGBLKS, CPMBLKS

+	GLOBAL	ADLEISTE, IINTAD, TIMEAD, INFOAD, SHUTUPAD, ERROR, TRAP

+	GLOBAL	MODECONF, ARC31, BEEPFRQ, BLINKP, IKANTAB, URLK1, URLK2

+

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL INIFLP, HDIO, PARKHD, PHYSADR, START, FRE65

+	EXTERNAL PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB, EFLOW5

+	EXTERNAL BAUSCC, BAUBAS, TO6502, ZGERL, STROUT, AFLOW, CLRCBUF

+	EXTERNAL BITSCC, BITBAS, EGO, ESTOP, DISKBK, INIDISK, ANALOG

+	EXTERNAL GMOVE, GDRAW, GTEST, GCTRL, GCLR, GFILL, GTRANS, GRAFIO

+;	

+;................................................................

+;

+;	andere Adressen

+;

+WINDOW	EQU	0F000H		;Anfangsadresse des 4K Windows

+;

+;	Konstanten

+;

+SCHGR	EQU	196		;Groesse des Schattenspeichers in KByte

+MINFUN	EQU	-10		;iocontrol: unterste Funktionsnummer

+;

+;	Harddisk / Floppy Kommandos

+;

+SREAD	EQU	0

+SWRITE	EQU	1

+SFORMAT	EQU	2

+;

+	INCLUDE	PORTS.MAC

+;

+;*****************************************************************************

+;

+;	Konfigurationsblock, wird im Load-Modul festgelegt

+;

+BLINKP		EQU	8		; 1 Byte

+BEEPFRQ		EQU	9		; 1 Byte

+ARC31		EQU	10		; 3 Bytes SCSI-Floppy LUN

+MODECONF	EQU	13		; 4 Words: Mode, ID 4, 5, 6

+URLK1		EQU	21		; 1 Byte log. Kanal f.1.Urladertest

+URLK2		EQU	22		; 1 Byte log. Kanal f.2.Urladertest

+FREE		EQU	23		; 1 Byte

+;

+IKANTAB		EQU	58H		; 8 Bytes Kanalzuordung phys. --> log.

+KANTAB		EQU	60H		; 33 Bytes Kanalzuordnung log. --> phys

+IOFTB		EQU	81H		; 32 Bytes I/O 'typ'-Tabelle

+CPMOFS		EQU	0A1H		; Anfang eines CP/M-Volumes

+CPMLAST		EQU	0A4H		; Ende+1 des CP/M-Volumes

+

+;*****************************************************************************

+;

+;	EUMEL - Linkleiste

+;

+	JP	START		; Beginn der Initialisierung, starten

+

+ADLEISTE:			; Beginn der EUMEL-Linkleiste (kopiert)

+

+IINTAD:	JP	DEFRET		; Inputinterrupt

+

+TIMEAD:	JP	DEFRET		; Timerinterrupt

+

+WARTAD:	JP	DEFRET		; EUMEL 'warte'

+

+GRABAD:	JP	DEFRET		; (BC) 512-Byte Kacheln ab (HL) fuer SHard

+				; reservieren

+FREEAD:	JP	DEFRET		; (BC) 512-Byte Kacheln ab (HL) (wie bei

+				; 'grab'!) freigeben

+SHUTUPAD:

+	JP	DEFRET		; Shutup anfordern

+

+INFOAD:	JP	DEFRET		; Info ' shard'

+	

+DEFRET:	RET

+

+;----------------------------------------------------------------

+;

+;	W A R T E

+;

+;	Aufruf der EUMEL Warte Routine

+;

+WARTE:

+	PUSH	BC		;Register, ausser AF, retten

+	PUSH	DE

+	PUSH	HL

+	PUSH	IX

+	PUSH	IY

+;	EX	AF,AF'

+;	PUSH	AF

+;	EXX

+;	PUSH	BC

+;	PUSH	DE

+;	PUSH	HL

+;

+	CALL	WARTAD		;zunaechst auf RET-Befehl

+;

+;	POP	HL

+;	POP	DE

+;	POP	BC

+;	EXX

+;	POP	AF

+;	EX	AF,AF'

+	POP	IY

+	POP	IX

+	POP	HL

+	POP	DE

+	POP	BC

+	RET

+

+;................................................................

+;

+;	T R A P

+;

+;	Behandlung einer TRAP-Exception

+;	Einsprung bei JP 0

+

+TRAP:

+	LD	(SAVSTP),SP	; Stackpointer retten

+	PUSH	AF

+	PUSH	HL

+	PUSH	DE

+	IN0	A,(ITC)		; Trap ?

+	BIT	7,A

+	RES	7,A		; Auf jeden Fall loeschen

+	OUT0	(ITC),A

+	JR	Z,RESV		; War kein TRAP, sondern Reset: PC undefiniert

+	LD	HL,(SAVSTP)

+	LD	E,(HL)

+	INC	HL

+	LD	D,(HL)		; DE = PC bei Trapadresse

+	DEC	DE		; PC-1

+	BIT	6,A		; UFO ? (Undefined Fetch Object)

+	JR	Z,TRAP1

+	DEC	DE		; PC-2

+TRAP1:

+	LD	HL,TRPADR

+	CALL	HEXDEHL		; Nach Hex konvertieren

+

+RESV:

+	LD	HL,TRPTXT	; Vor Infoaufruf ausgeben (in Zeile 6)

+SENDERR:

+	CALL	SENDMSG

+	CALL	INFOAD

+	POP	DE

+	POP	HL

+	POP	AF

+	RET

+	

+TRPTXT:	DEFB	TRPLEN, 7, 6, 4, 1, 15, 'TRAP:'

+TRPADR:	DEFB	'RES ', 5, 14

+TRPLEN	EQU	$-TRPTXT-1

+

+;...................................................................

+;

+;	Falscher Interrupt

+;

+ERROR:	

+	PUSH	AF

+	PUSH	HL

+	PUSH	DE

+

+	LD	A,00111000B	; Reset SCC highest IUS

+	OUT0	(SCCAC),A

+	OUT0	(SCCBC),A

+	CALL	EIRET

+

+	LD	HL,INTTXT	; Message 'Ghost Interrupt'

+	JR	SENDERR

+

+INTTXT:	DEFB	INTXTLEN, 6, 4, 1, 15, 'Wrong Int', 5, 14

+INTXTLEN	EQU	$-INTTXT-1

+

+EIRET:

+	EI

+	RETI

+

+;----------------------------------------------------------------

+;

+;	S Y S E N D

+;

+;	Kaltstart ausfuehren

+;

+;	Eingang:  -

+;	Ausgang:  (Keine Rueckkehr)

+;

+SHEND:

+	CALL	PARKHD		; Harddisk in Parkposition fahren

+	DI

+	XOR	A

+	OUT0	(CNTLA0),A	; Falls verdrahtet, Hardwarereset (RTS-Pin)

+	OUT0	(CNTLA0),A	; sicherheitshalber

+	SLP			; Kein Refresh mehr, I/O bleibt aktiv

+

+;

+;----------------------------------------------------------------

+;

+;	S H S I N F

+;

+;	Groesse und Ansprechmodus des Schattenspeichers bestimmen

+;

+;	Ausgang:  BC = Groesse des Schattenspeichers in k (0..8191)

+;		       Bit 15: 1=Fenstermodus, Bit 14: 1=Transportmodus

+;

+;	In diesem SHARD werden die 1. 256 KByte RAM des HD 64180, soweit

+;	diese nicht vom SHARD und EUMEL0 belegt sind, als Schattenspeicher

+;	im Fenstermodus benutzt.

+;

+;	Der Speicher wird im einzelnen wie folgt verwendet:

+;

+;	00000 - 013FF	SHARD

+;	01400 - 0EFFF	EUMEL0 und Pagingbereich

+;	0F000 - 3FFFF	Schattenspeicher

+;	40000 - 5FFFF	reserviert fuer Grafikkarte (nicht benutzt)

+;	60000 - 6FFFF	BASIS bzw. Apple Hauptspeicher (6502 Treiber)

+;	70000 - 7FFFF	wie 60000 - 6FFFF

+;   

+SHSINF:

+	LD	BC,SCHGR+8000H	;Fenstermodus

+	RET

+;

+;----------------------------------------------------------------

+;

+;	S C H A C C

+;

+;	Ein-/ Ausgabe auf den Schattenspeicher

+;

+;	Eingang: HL = Nummer der 1/2K-Seite, die in das 4K Fenster

+;		      zu schalten ist.

+;

+;	Ausgang: HL = Anfangsadresse (im Normaladressraum) des aktuellen

+;		      Fensters

+;

+;	Das Fenster befindet sich innerhalb eines 4K Bereichs ab 0F000H

+;	in der Common Area 1

+;

+SHSACC:

+	PUSH	AF		;Akku retten

+

+	LD	A,L		;Offset im 4K Fenster berechnen

+	SLA	A		;auf 256 Byte Grenze (MSB)

+;	AND	0FH		;nicht noetig, da MSB=F 

+	OR	HIGH WINDOW	;MSB der Anfangsadresse im Fenster

+;

+	SRL	H		;512 Byte Block -> 4 K Offset (/8)

+	RR	L

+	SRL	H

+	RR	L

+	SRL	L		;nicht mehr als 512 K !!

+	OUT0	(CBR),L		;4K Blockanf. (- F000) in MMU eintragen

+

+	LD	H,A		;MSB der Anfangsadr. retten

+	LD	L,0		;HL = Anfangsadresse im log. Adr.-raum

+	POP	AF		;AF wieder herstellen

+	RET

+;

+;-------------------------------------------------------------------

+;

+;	L O G P H Y S

+;	Umrechnung der log. Kanalnummer in eine phys. Kanalnummer

+;

+;	Eingang: A = logische Kanalnummer (0..32)

+;	Ausgang: A = physische Kanalnummer (0..6, 28..32)

+;		 alle anderen Register bleiben unveraendert

+;

+LOGPHYS:

+	PUSH	HL

+	ADD	A,KANTAB

+	LD	L,A

+	LD	H,0

+	LD	A,(HL)

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	B L O C K O U T

+;

+;	Block (512 Byte) Ausgabe

+;

+;	Der 512 Byte grosse in DE angegebene Block wird ab der in HL

+;	angegebenen Hauptspeicheradresse auf das durch Kanalnummer angewaehlte

+;	Geraet uebertragen.

+;

+;	Eingang:  A = Kanalnummer (log.)

+;		 BC = Funktionscode (immer 0)

+;		 HL = Adresse des Hauptspeicherbereichs

+;		 DE = 2. Funktionscode (Blocknummer)

+;

+;	Ausgang:  A = veraendert

+;		 BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf)

+;		 HL = Adresse des Rueckmeldetextes (1 Byte <Laenge>,

+;						    <Laenge> Bytes Text)

+;

+SHBOUT:

+	PUSH	AF

+	LD	A,SWRITE		;Schreiboperation

+	JR	BLKCOM

+;

+;----------------------------------------------------------------

+;

+;	B L O C K I N

+;

+;	Block (512 Byte) Eingabe

+;

+;	Der 512 Byte grosse in DE angegebene Block wird ab der in HL

+;	angegebenen Adresse vom durch Kanalnummer angewaehlten Geraet

+;	in den Hauptspeicher uebertragen.

+;

+;	Eingang:  A = Kanalnummer (log.)

+;		 BC = Funktionscode (immer 0)

+;		 HL = Adresse des Hauptspeicherbereichs

+;		 DE = 2. Funktionscode (Blocknummer)

+;

+;	Ausgang:  A = veraendert

+;		 BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf)

+;		 HL = Adresse des Rueckmeldetextes (1 Byte <Laenge>,

+;						    <Laenge> Bytes Text)

+;		 DE = unveraendert

+;

+;	Folgende physischen Kanaele sind fuer Block I/O definiert:

+;

+;	0 = Harddisk 0 am SCSI-Controller

+;	1 = Graphikmemory (Apple)

+;

+;	28 = Harddisk CP/M-Volume

+;	29 = Apple-Drive 1

+;	30 = Apple-Drive 0

+;	31 = Floppy 0 am SCSI-Controller

+;

+;................................................................

+

+SHBIN:

+	PUSH	AF

+	LD	A,SREAD

+BLKCOM:

+	LD	(HGOP),A	;0=lesen, 1=schreiben, 2=formatieren

+;

+	POP	AF

+	CALL	LOGPHYS		; Umrechnen log. --> phys.

+	PUSH	AF

+

+;FDHDIO:

+	CALL	BLOCKS		; Anzahl Blocks des Kanals erfragen

+

+	LD	A,B		; 0 Bloecke: Nochmal initialisieren

+	OR	C

+	JR	NZ,BLKCOM1

+

+	POP	AF

+	PUSH	AF

+

+	PUSH	DE

+	LD	D,B		; DE = 0 : Standardformat

+	LD	E,B

+	CALL	SIZEX

+	POP	DE

+

+BLKCOM1:

+	POP	AF		; A = Kanal

+

+	PUSH	HL

+	LD	H,D		; HL = Blocknummer

+	LD	L,E

+	AND	A

+	SBC	HL,BC		; Falls HL >= BC : Block zu hoch

+	POP	HL

+

+	JR	NC,TRKERR

+

+	LD	BC,HDOFS

+	AND	A

+	JR	Z,SCSIBK	; Hintergrund

+

+	LD	BC,ARC31

+	CP	31

+	JR	Z,SCSIBK	; SCSI-Floppy

+

+	LD	BC,CPMOFS

+	CP	28

+	JR	Z,SCSIBK	; CP/M-Volume auf der Harddisk

+

+				; Kein SCSI-blockio

+	JP	NC,DISKBK	; Kanal 29, 30 ist Apple-Drive

+

+	CP	1		; Grafikspeicher ?

+	JP	Z,GRAFIO

+				; Andere Kanaele nicht erlaubt

+	LD	BC,-1		; Falscher Kanal

+	RET

+

+

+SCSIBK:

+	LD	A,(HGOP)

+	PUSH	DE

+	CALL	HDIO		;I/O ausfuehren

+	POP	DE

+;

+	LD	BC,0

+	AND	A

+	RET	Z		; Transfer ok

+

+	INC	BC		; Fehler, bei dem Retries sinnlos sind

+	CP	13H		; Writeprotected (Floppy)

+	RET	Z

+	CP	14H		; Target sector not found (kein Medium)

+	RET	Z

+

+	INC	BC		; Retries sinnvoll

+	LD	HL,ERRNR	; Bufferaddress fuer Hexbyte-Fehlernummer

+	CALL	HEXAHL		; Konvertieren

+	LD	HL,BLKNR1	; Blocknr

+	CALL	HEXDEHL		; Blocknummer in Puffer schreiben

+

+	LD	HL,RWERR

+	RET

+;

+TRKERR:

+	LD	HL,BLKNR2	; Bufferadresse fuer Konvertierung

+	CALL	HEXDEHL		; DE ab HL schreiben

+	LD	BC,3		; Versorgungsfehler (Spur zu gross)

+	LD	HL,BLKZHOCH

+	RET

+;

+				; Word in DE als 4 Byte ASCII ab HL ablegen

+HEXDEHL:

+	LD	A,D		; Highbyte

+	CALL	HEXAHL

+	LD	A,E		; Lowbyte dahinter

+				; Byte in A als 2 ASCII-Zeichen ab HL ablegen

+HEXAHL:

+	PUSH	AF

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	CALL	HEXAHL1

+	POP	AF

+

+HEXAHL1:

+	AND	0FH

+	CP	0AH		; A..F ?

+	JR	C,HEXAHL2

+	ADD	A,7

+HEXAHL2:

+	ADD	A,30H

+	LD	(HL),A

+	INC	HL

+	RET

+;

+;	Fehlermeldungen, die mit 'noch ein Versuch ?' ausgegeben werden

+;

+RWERR:

+	DEFB	RWERRLN

+	DEFM	'Fehler '

+ERRNR:	DEFM	'00H auf Block '

+BLKNR1:	DEFM	'0000H,'

+RWERRLN	EQU	$-RWERR-1

+

+;

+BLKZHOCH:

+	DEFB	BLKZLN

+	DEFM	'Block '

+BLKNR2:	DEFM	'0000H zu hoch,'

+BLKZLN	EQU	$-BLKZHOCH-1

+

+;

+;----------------------------------------------------------------

+;

+;	M E M D M A

+;	DMA-Transfer zwischen 64180-Speicher (log.) und Basisspeicher

+;

+;	Darf auch in Interruptroutinen benutzt werden!

+;

+;	Eingang: BC = Anzahl der zu transportierenden Bytes

+;		 DE = log.Hauptspeicheradresse (64k)

+;		 HL = phys. Adresse im Basisspeicher

+;		 A  = 0 : Basis --> 64180

+;		 A  = 1 : 64180 --> Basis

+;	Ausgang: alle Register (A, BC, DE, HL) moeglicherweise veraendert

+;

+MEMDMA:

+	RRA			; Bit 0 (A) ins Carry

+	LD	A,I

+	DI

+	PUSH	AF		; Carry und IEF1 merken

+

+	OUT0	(BCR0L),C	; Transferlaenge programmieren

+	OUT0	(BCR0H),B

+

+	CALL	PHYSADR		; Bank in A

+	LD	B,6		; Basis Bank

+

+	POP	AF

+	PUSH	AF		; Carryflag holen: Set : 64180 --> Basis

+

+	JR	NC,MEMDMA1

+

+	EX	DE,HL		; Source <--> Dest vertauschen

+	LD	B,A		; Bank auch vertauschen

+	LD	A,6

+

+MEMDMA1:

+	OUT0	(SAR0L),L	; Source-Adresse

+	OUT0	(SAR0H),H

+	OUT0	(SAR0B),B

+	OUT0	(DAR0L),E	; Destination-Adresse

+	OUT0	(DAR0H),D

+	OUT0	(DAR0B),A

+

+	CALL	ZGERL		; Auf 6502-Speicher Zugriffserlaubnis warten

+

+	LD	A,01100011B	; DMA-Transfer starten

+	OUT0	(DSTAT),A

+

+	POP	AF

+	RET	PO

+	EI

+	RET

+

+;----------------------------------------------------------------

+;

+;	I O C O N T R O L

+;

+;	Steuerung und Zustandsabfragen fuer alle Kanaele

+;

+;	Eingang: A  = Kanalnummer (log.)

+;		 BC = Funktionsnummer

+;		      negative Codes siehe Funktionsadresstabelle

+;		      1 = 'typ' (fuer alle Kanaele (0..32))

+;		      2 = 'frout' (fuer Kanal 1..6)

+;		      3 = 'stop' (fuer Kanal 1..6)

+;		      4 = 'weiter' (fuer Kanal  1..6)

+;		      5 = 'size' (fuer Kanal 0, 1, 30, 31)

+;		      6 = 'flow' (fuer Kanal 1..6)

+;		      7 = 'format' (fuer Kanal 30, 31)

+;		      8 = 'baud' (fuer Kanal 2, 3, 5) 

+;		      9 = 'bits' (fuer Kanal 2, 3, 5)

+;		     10 = 'calendar' (1.8)

+;

+;		 DE = 2. Parameter

+;		 HL = 3. Parameter

+;

+;	Ausgang: s. Einzelfunktion

+;		 A, BC und Flags duerfen veraendert sein (manchmal definiert!)

+;

+SHIOCNT:

+	CALL	LOGPHYS		; Kanalnummer log. --> phys. umrechnen

+

+	PUSH	HL		;3. Funktionscode retten

+	LD	HL,-MINFUN	;unterste Funktionsnummer

+	AND	A

+	ADC	HL,BC		;auf 0 normierte Funktionsnummer

+	JP	M,ILLFUN	;unzulaessige Funktion ->

+

+	LD	B,H

+	LD	C,L

+	LD	HL,MAXFUN	;Funktionsanzahl

+	AND	A

+	SBC	HL,BC

+	JR	C,ILLFUN	;Funktionsnummer zu gross ->

+

+	LD	HL,FUNTAB	;Sprungadresstabelle fuer alle Funktionen

+	ADD	HL,BC

+	ADD	HL,BC		;+ Funktionsnummer * 2

+	PUSH	AF

+	LD	A,(HL)		;LSB (Funktionsadresse)

+	INC	HL

+	LD	H,(HL)		;MSB (Funktionsadresse)

+	LD	L,A

+	POP	AF

+	JP	(HL)		; (TOS)=(HL), Funktion anspringen

+;

+ILLFUN:

+	POP	HL

+	LD	BC,-2

+	RET

+;

+;................................................................

+;

+;	Funktionsadresstabelle

+;

+FUNTAB:

+	DEFW	CLRBUF		;-10 Printerspooler loeschen

+	DEFW	GTRANS		;-9  Grafik: Grafikseiten transportieren

+	DEFW	GCTRL		;-8  Grafik: Verschiedene Steuerfunktionen

+	DEFW	GTEST		;-7  Grafik: Test, ob Pixel (x, y) gesetzt

+	DEFW	GDRAW		;-6  Grafik: Draw Line to (x, y)

+	DEFW	GMOVE		;-5  Grafik: Move to (x, y)

+	DEFW	GFILL		;-4  Grafik: Umrandete Flaeche fuellen

+	DEFW	GCLR		;-3  Grafik: Seite loeschen (fuellen)

+	DEFW	ANALOG		;-2  Analog I/O

+	DEFW	IOACC		;-1  64180-Card I/O-Ports (privilegiert)

+	DEFW	ILLFUN		; 0  -

+	DEFW	TYP		; 1

+	DEFW	FROUT		; 2

+	DEFW	STOP		; 3

+	DEFW	WEITER		; 4

+	DEFW	SIZE		; 5

+	DEFW	FLOW		; 6

+	DEFW	FORMAT		; 7

+	DEFW	BAUD		; 8

+	DEFW	BITS		; 9

+	DEFW	CALENDAR	;10

+;

+MAXFUN	EQU	(($-FUNTAB)/2)-1	;FUNKTIONSANZAHL

+;

+;................................................................

+;

+;	T Y P

+;

+;	Information welche I/O fuer welchen Kanal sinnvoll ist liefern

+;

+;	Eingang: A = Kanalnummer (phys.)

+;

+;	Ausgang: Information in BC

+;		 C Bit 0 gesetzt: 'iint' kann kommen (Zeicheneingabe)

+;		 C Bit 1 gesetzt: 'output' ist sinnvoll (Zeichenausgabe)

+;		 C Bit 2 gesetzt: 'blockin' ist sinnvoll (Blockeingabe)

+;		 C Bit 3 gesetzt: 'blockout' ist sinnvoll (Blockausgabe)

+;		 C Bit 4 gesetzt: 'IOCONTROL format' ist sinnvoll

+;

+TYP:

+	LD	BC,0

+	CP	32

+	JR	NC,TYP1

+	LD	C,A		;BC = Kanalnummer

+	LD	HL,IOFTB

+	ADD	HL,BC

+	LD	C,(HL)		;Information aus IO-Funktionstab. holen

+TYP1:

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	F R O U T

+;

+;	Information, wieviel Zeichen der naechst 'outvar' uebernehmen

+;	kann.

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;

+;	Ausgang: BC = Anzahl Zeichen die der naechste 'outvar' uebernehmen

+;		      kann

+;		 C-Flag gesetzt: Puffer ist leer

+;

+FROUT:

+	CP	1		; Console ?

+	JR	Z,FROUTOK

+	CP	2		; SCCB

+	JR	Z,SCCBFROUT

+	CP	3		; SCCA

+	JR	Z,SCCAFROUT

+	CP	4

+	JR	Z,OBDRU		; 64180-Card Parallel

+

+	CP	7		; Basis-Schnittstellen ?

+	JR	NC,FROUTOK	; Nein -> falscher Kanal

+

+				; Basis serielle/parallele Schnittstellen

+	CALL	FRE65

+	JR	FRCORR		; BC korrigieren auf Bytewert

+;

+OBDRU:

+	PUSH	IX

+	LD	IX,DRUCK

+FREBUF:

+	CALL	FREEBUF

+	POP	IX

+

+FRCORR:

+	POP	HL

+

+	INC	B	; Carry unveraendert

+	DEC	B

+	RET	Z	; weniger als 256 Zeichen frei

+	LD	BC,255	; mehr als 255 frei, Korrektur wegen EUMEL0!

+	RET

+

+FROUTOK:

+	SCF

+	LD	BC,200

+	POP	HL

+	RET

+

+SCCAFROUT:

+	PUSH	IX

+	LD	IX,SCCATAB

+	JR	FREBUF

+

+SCCBFROUT:

+	PUSH	IX

+	LD	IX,SCCBTAB

+	JR	FREBUF

+

+	

+;................................................................

+;

+;	S T O P

+;

+;	Weitere Eingaben sperren

+;

+;	Eingang: A = Kanalnummer (phys.)

+;

+STOP:

+	CALL	ESTOP

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	W E I T E R

+;

+;	Weitere Eingaben wieder zulassen

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;

+WEITER:

+	CALL	EGO

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	S I Z E

+;

+;	Groesse in Bloecken eines Block I/O Kanals erfragen

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;		 DE = Schluessel:

+;			Alle Formate haben 512-Bytes/Sektor und 5.25 Zoll

+;			0 = Standardformat des Laufwerks

+;			1, 0101010110101001B = 55A9H = 360k, 2 * 40 Tracks

+;			2, 0101011110101001B = 57A9H = 720k, 2 * 80 Tracks

+;			   0101011110001111B = 578FH = 640k-Erphi, 2 * 80 Trks

+;			   1101011110001111B = D78FH = 640k-Ehring, 2 * 80 Trks

+;			   0100000110001111B = 418FH = 160k-Apple, 1 * 40 Trks

+;	Ausgang: BC = Blockanzahl low

+;		 A  = Blockanzahl high

+SIZEX:

+	PUSH	HL

+

+SIZE:

+	CP	31

+	JR	NZ,SIZE1

+

+	LD	B,80		; Default 80 Tracks

+	INC	D

+	DEC	D		; D = 0 ?

+	JR	NZ,SIZE3	; Nein, Schluessel auswerten

+	LD	A,E

+	CP	1

+	JR	C,SIZE2		; 0: Default 80 Tracks

+	JR	NZ,SIZE2	; > 1 : 80 Tracks

+SIZE4:

+	LD	B,40		; 1: 40 Tracks

+SIZE2:

+	LD	A,B

+	CALL	INIFLP		; Archivtyp bestimmen

+	LD	(ARBLKS),BC

+	JR	ZRET

+

+SIZE3:

+	BIT	1,D		; Bit 9 (DE) unterscheidet 40/80 Tracks

+	JR	Z,SIZE4

+	JR	SIZE2

+	

+SIZE1:

+	CP	29		; Apple-Drive 0 oder 1 ?

+	JR	C,BRET		; Keine Formaterkennung auf anderen Kanaelen

+	CP	32

+	JR	NC,BRET		; Kanal >= 32 ?

+

+	CALL	INIDISK

+

+	LD	HL,D0BLKS	; HL darf veraendert werden

+	CP	30

+	JR	Z,SIZE5

+	LD	HL,D1BLKS

+SIZE5:

+	LD	(HL),C		; Fuer Blockio eintragen

+	INC	HL

+	LD	(HL),B

+	JR	ZRET		; Groesse in BC

+	

+BRET:

+	CALL	BLOCKS		; Groesse erfragen

+

+ZRET:

+	XOR	A		; Immer weniger als 65536 Bloecke

+	POP	HL

+	RET

+

+;................................................................

+;

+;	B L O C K S

+;	Erfragt die Anzahl der 512-Byte Bloecke, die ein phys. Kanal

+;	fassen kann.

+;

+;	Eingang: A = Kanalnummer (0, 1, 27..31)

+;	Ausgang: BC = Anzahl 512-Byte Blocks

+;		 keine anderen Register veraendert

+;

+BLOCKS:

+	PUSH	AF

+	CP	28

+	JR	NC,BLOCKS1

+	ADD	A,32			; 0 --> 32, 1 --> 33

+BLOCKS1:

+	LD	BC,0

+

+	CP	34

+	JR	NC,BLOCKS2		; Kanal existiert nicht

+

+	SUB	28			; Auf 0 normieren

+

+	PUSH	HL

+	ADD	A			; * 2

+	LD	C,A

+	LD	HL,BLKTAB

+	ADD	HL,BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,(HL)

+	POP	HL

+BLOCKS2:

+	POP	AF

+	RET

+

+;................................................................

+;

+;	B A U D

+;

+;	Einstellung der Baudrate fuer serielle Schnittstellen

+;	andere Funktionen nicht implementiert

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;		

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;

+BAUD:

+	POP	HL

+	PUSH	AF

+	LD	A,H

+	OR	D

+	JR	NZ,BITERR

+

+	LD	A,E		; addressierter Kanal

+	CALL	LOGPHYS		; Kanalnummer umrechnen

+	LD	E,A

+

+	CP	5

+	JR	Z,BASSER

+	CP	2

+	JR	Z,ONBDSR

+	CP	3

+	JR	NZ,BITERR

+

+ONBDSR:

+	LD	A,L

+	CP	17

+	JR	NC,BITERR	; Keine SHardspezifischen Baudrates

+	POP	AF

+	PUSH	AF

+	CP	32

+	LD	A,E

+	CALL	Z,BAUSCC	;serielle Schnittstellen on board

+	JR	ISPO

+;

+BASSER:

+	LD	A,L		;serielle Schnittstelle BASIS	

+	CP	16		;38400 Baud nicht moeglich, kein SHardspez.

+	JR	NC,BITERR

+	POP	AF

+	PUSH	AF

+	CP	32		;einstellend ?

+	CALL	Z,BAUBAS	;Ja ->	

+	JR	ISPO

+;

+;................................................................

+;

+;	B I T S

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;	Unterstuetzt: 	1, 1.5, 2 Stopbits

+;			7 oder 8 Datenbits

+;			No, Even, Odd Parity

+;

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;

+BITS:

+	POP	HL

+	PUSH	AF

+	LD	A,H

+	OR	D

+	JR	NZ,BITERR

+

+	LD	A,E		; addressierter Kanal

+	CALL	LOGPHYS		; umrechnen

+	LD	E,A

+

+	CP	5

+	JR	Z,TBASS

+	CP	2

+	JR	Z,TSSER

+	CP	3		;serielle Kanaele ?

+	JR	NZ,BITERR	;Nein ->

+

+TSSER:

+	LD	A,L

+	AND	7		; Weniger als 7 Datenbits ?

+	CP	7-1

+	JR	C,BITERR

+;

+	POP	AF

+	PUSH	AF

+	CP	32

+	LD	A,E

+	CALL	Z,BITSCC

+ISPO:

+	POP	AF

+	LD	BC,0		;sonst moeglich melden

+	RET

+;

+TBASS:

+	LD	A,L

+	AND	7

+	CP	7-1

+	JR	C,BITERR	; Weniger als 7 Datenbits

+	BIT	5,L		; 1.5 Stopbits nicht moeglich

+	JR	NZ,BITERR

+	LD	A,L

+	CP	00101111B	; 8 Datenbits, 2 Stopbits und Parity nicht

+	JR	Z,BITERR

+	CP	00110111B	; dgl. even Parity nicht moeglich

+	JR	Z,BITERR

+

+	POP	AF

+	PUSH	AF

+	CP	32		; Werte einstellen ?

+	CALL	Z,BITBAS

+	JR	ISPO

+;

+BITERR:

+	POP	AF

+	LD	BC,1		;nicht moeglich

+	RET

+;

+;................................................................

+;

+;	F L O W

+;

+;	Flusskontrolle einstellen

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;		

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;		

+FLOW:

+	POP	HL

+	PUSH	AF

+	LD	A,D

+	OR	H		; Modus > 255 oder Kanal > 255 --> geht nicht

+	JR	NZ,BITERR

+

+	LD	A,E		; adressierter Kanal

+	CALL	LOGPHYS		; umrechnen

+	LD	E,A

+	CP	CHNUM

+	JR	NC,BITERR	;falscher Kanal -> nicht moeglich

+	CP	1

+	JR	Z,BITERR

+

+	LD	A,L

+	AND	A		; Keine Flusskontrolle ?

+	JR	Z,FLOW1		; ja, 0 eintragen

+

+	CP	11

+	JR	NC,BITERR	; Modus > 11 geht nicht

+

+	CP	4		; Eingabe-/Ausgabeseitig ? (1, 2, 3)

+	JR	NC,FLOW1	; nein, Bits bleiben so

+	OR	1100B		; Bit 2 und 3 setzen

+FLOW1:

+	LD	C,A

+	LD	HL,FLMOD

+	ADD	HL,DE

+	AND	(HL)		; Und-Verknuepfen

+	CP	C		; Immer noch gleich Modus ? ja, erlaubt

+	JR	NZ,BITERR	; sonst nicht erlaubt

+	

+	POP	AF

+	PUSH	AF

+	CP	32

+	JR	NZ,ISPO		; ok melden, wenn nicht einstellend

+

+;	Flusskontrolle einstellen

+

+	LD	A,E		; Adressierter Kanal in A 

+	CALL	EGO		; 'Weiter' aufrufen mit alter Einstellung

+

+	CALL	FLWTYP

+	LD	(HL),C		; gewuenschten Modus eintragen

+

+	CP	5

+	CALL	Z,EFLOW5	; Eingabeflusskontrolle fuer Kanal 5

+				; DTR, XON/XOFF einstellbar

+

+				; Da RTS-Fluskontrolle hardwaremaessig bedingt

+				; nicht wie gewuenscht arbeitet (Uebertragungs-

+				; fehler und Transmitter disabled), wird DTR-

+				; Flusskontrolle verwendet. ggf. muss die RTS-

+				; Leitung des Fremdrechners mit der DTR-

+				; Leitung (Pin 20) des Basis verbunden werden.

+	CALL	AFLOW		; Ausgabe-Flusskontrolle einstellen

+	JR	ISPO

+	

+;...........................................................................

+;	

+;	F L W T Y P

+;

+;	Zeiger auf Tabelle mit aktuellem Flusskontrollmodus berechnen

+;

+;	Eingang: A = gewuenschter Kanal (1..15)

+;

+;	Ausgang: HL = Zeiger auf Eintrag in der Flowtabelle

+;		 andere Register nicht veraendert

+;

+FLWTYP:

+	LD	HL,FLTAB

+	CP	CHNUM		; Zeigt auf Dummyeintrag

+	RET	NC

+

+	PUSH	DE

+	LD	D,0

+	LD	E,A

+	ADD	HL,DE

+	POP	DE

+	RET

+

+;

+;

+;	Flowtabelle

+;

+;	Bit 0 : 1 = XON/XOFF

+;	Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis)

+;	Bit 2 : 1 = Ausgabeseitige Flusskontrolle

+;	Bit 3 : 1 = Eingabeseitige Flusskontrolle

+;	Bit 7 : 1 = Eingabeseitig im Stopzustand

+;

+FLTAB::

+	DEFB	0		; -

+	DEFB	1000B		; Kanal 1, Eingabeflusskontrolle

+	DEFB	0		; Kanal 2

+	DEFB	0		; Kanal 3

+	DEFB	0		; Kanal 4

+	DEFB	0		; Kanal 5

+	DEFB	0		; Kanal 6

+;

+CHNUM	EQU	$-FLTAB		;Kanalanzahl

+

+;	Tabelle mit Flowmoeglichkeiten der Kanaele

+;	Bit 0 : 1 = XON/XOFF moeglich

+;	Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis) moeglich

+;	Bit 2 : 1 = Ausgabeseitige Flusskontrolle moeglich

+;	Bit 3 : 1 = Eingabeseitige Flusskontrolle moeglich

+;		Bit 2 und 3 duerfen gleichzeitig 1 sein.

+;		Bit 0 und 1 duerfen gleichzeitig 0 und 1 sein.

+

+FLMOD:

+	DEFB	0		; -

+	DEFB	0		; Kanal 1, nicht einstellbar

+	DEFB	1111B		; Kanal 2

+	DEFB	1111B		; Kanal	3

+	DEFB	0		; Kanal 4

+	DEFB	1111B		; Kanal 5

+	DEFB	0		; Kanal 6

+;

+;................................................................

+;

+;	F O R M A T

+;

+;	Archiv formatieren

+;

+;	Eingang:  A = Kanalnummer

+;		  DE = Schluessel, wie SIZE

+;	Ausgang:  BC = Rueckmeldung, wie BLOCKIO

+;

+FORMAT:

+	POP	HL

+	LD	BC,-1

+	CP	31		; SCSI-Floppy ?

+	RET	NZ		; Kein formatieren moeglich

+

+	PUSH	AF

+

+	CALL	SIZEX

+	LD	A,SFORMAT

+	LD	(HGOP),A

+	LD	BC,ARC31

+	CALL	SCSIBK

+	POP	AF

+	RET

+;

+;****************************************************************

+;

+;	C A L E N D A R

+;

+;	Entry:	DE = (1:Min, 2:Std, 3: Tag, 4:Mon, 5:Jahr)

+;	Ausgang:BC = Rueckmeldung

+;		     BC = -1 : Keine Uhr oder falsche Parameter

+;			sonst: gewuenschter BCD(!)-Wert

+;

+;

+

+CALENDAR:

+	PUSH	AF

+	DI

+	LD	BC,-1

+	LD	A,D	

+	JR	NZ,CALEND	; fehlerhafter Aufruf

+	LD	A,E

+	CP	6

+	JR	NC,CALEND	; ebenfalls

+	LD	A,(RTCOK)	; Flag fuer Time ok

+	AND	A

+	JR	Z,CALEND	; 0= Nicht ok

+

+	LD	A,20H		; 2 (programmierte) eff. 3 Uhrenwaitstates

+	OUT0	(DCNTL),A

+

+	LD	BC,RTCRA	; B=0 !

+

+CAL1:	TSTIO	80H		; UIP (Update in progress) testen

+	JR	NZ,CAL1		; warten bis beendet

+

+	LD	HL,CALPORTS	; Tabelle mit Registerzuordnung

+	ADD	HL,DE		; D ist 0, E ist Offset

+	LD	C,(HL)

+	IN	C,(C)		; BC = BCD-Wert

+	LD	B,C		; High-Digit ins Highbyte

+	SRL	B

+	SRL	B

+	SRL	B

+	SRL	B

+

+CALEND:

+	XOR	A

+	OUT0	(DCNTL),A	; 0 (prog.) I/O Waitstates

+	EI

+	POP	AF

+	POP	HL

+	RET

+

+CALPORTS:

+	DEFB	RTCS, RTCM, RTCH, RTCDY, RTCMO, RTCYR

+;		Sec,  Min,  Std,  Day,   Mon,   Year

+

+	

+;****************************************************************

+;

+;	I O A C C

+;

+;	Entry:	HL = -1 = Read, sonst Value

+;		DE = I/O-Addr. (0..FF) real + 40H

+;			(Prozessor I/O: C0..FF)

+;		A  = aufrufender Kanal (Write nur 32!)

+;

+;	Exit:	BC = -1 = Error

+;		sonst Value

+;

+;

+IOACC:

+	POP	HL

+	CP	25		; Nur an privilegierten Kanaelen

+	LD	BC,-1		; Kanal 25..32

+	RET	C

+	INC	B		; B := 0

+

+	LD	A,E

+	ADD	A,040H		; I/O-Adresse umrechnen

+	LD	C,A

+;

+;	2 zusaetzliche I/O Wait States einbauen (fuer Uhrenzugriff)

+;

+	CP	0C0H		; Uhrenzugriff ?

+	JR	C,NCLK		; Nein -> keine extra Wait States

+

+	DI

+

+	LD	A,20H

+	OUT0	(DCNTL),A

+;

+NCLK:

+	LD	A,L

+	AND	H

+	INC	A		; HL = -1 ? 

+	JR	Z,RDVAL		; Ja ->

+;

+	OUT	(C),L		; Wert eintragen

+	LD	C,B		; C := 0

+	JR	IOAEND

+;

+RDVAL:

+	IN	C,(C)

+;

+IOAEND:

+	XOR	A		; Keine Waitstates mehr

+	OUT0	(DCNTL),A

+	EI

+	RET

+

+;***********************************************************************

+;

+;	C L R B U F

+;

+;	Drucker-Spooler des Kanals loeschen

+;

+;	Eingang: A = Kanalnummer (4, 6)

+;

+CLRBUF:

+	CALL	LOGPHYS

+	LD	L,8			; Task 8 : Clear Spooler

+	CP	A,6

+	CALL	Z,TO6502		; A nicht veraendert

+	CP	A,4

+	CALL	Z,CLRCBUF

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	O U T V A R

+;

+;	Ausgabe einer Zeichenkette

+;

+; 	Eingang:  A = Terminalnummer (1=Arbeitsconsole, 2=Drucker)

+;	          HL = Adresse der Zeichenkette

+;       	  BC = Anzahl der Zeichen

+;	Ausgang:  BC = Anzahl der uebernommenen Zeichen.

+;	          c-Flag gesetzt <=> alles uebernommem.

+;

+;	Hinweis: SHOUT darf auf keinen Fall WARTE aufrufen !!

+;

+SHOUT:

+	

+	CALL	LOGPHYS		; Kanalnummer log. --> phys. umrechnen

+	LD	(KANAL),A

+	LD	A,B

+	OR	C

+	JR	Z,OUTEA		; Nix auszugeben

+

+	PUSH	DE

+	PUSH	HL

+

+	LD	A,(KANAL)

+	CP	1

+	JR	Z,OUT1

+	CP	5

+	JR	Z,OUT5

+	CP	6

+	JR	C,OUT234

+	JR	Z,OUT6

+

+OVDON:

+	SCF			; Alles uebernommen

+RETREG:

+	POP	HL

+	POP	DE

+OUTEA:	LD	A,(KANAL)

+	RET

+

+OUT1:				; Master Console

+	CALL	STROUT

+	JR	OVDON		; Alles uebernommen

+;

+;

+OUT5:				; BASIS serielle Schnittstelle

+	LD	E,4

+	JR	OUT56

+

+OUT6:				; BASIS parallele Schnittstelle

+	LD	E,3

+OUT56:

+				; Anzahl uebernehmbarer Zeichen berechnen

+	PUSH	BC

+	CALL	FRE65		; Kanal in A, HL veraendert BC = Size-Free

+	LD	H,B

+	LD	L,C

+	POP	BC

+

+	LD	A,L

+	SUB	C

+	LD	A,H

+	SBC	B		; NC : HL (free) >= BC (length)

+	JR	NC,OUT56A	; NC: Alles uebernommen

+	LD	B,H

+	LD	C,L		; uebernommene Laenge

+OUT56A:

+	POP	HL

+	PUSH	HL

+	CCF			; Carry Flag, fuer "Alles uebernommen"

+	PUSH	BC

+	PUSH	AF

+				; fuer Ausgang merken

+OUT56B:

+	LD	A,B

+	OR	C

+	JR	Z,OUT56C	; fertig

+

+	PUSH	HL

+	LD	H,(HL)		; Zu sendendes Zeichen

+	LD	L,E		; Task 3 oder 4

+	CALL	TO6502

+	POP	HL

+

+	INC	HL

+	DEC	BC

+	JR	OUT56B

+

+OUT56C:

+	POP	AF		; Carry Flag

+	POP	BC

+	JR	RETREG

+

+OUT234:				; 64180-Card Kanaele (SCCA, SCCB, Centronics)

+	PUSH	IX

+	LD	IX,DRUCK	; Zeiger auf Centronics Kanaltabelle

+	CP	4

+	JR	Z,PUTBUFF

+	LD	IX,SCCATAB

+	CP	3

+	JR	Z,PUTBUFF

+	LD	IX,SCCBTAB

+

+PUTBUFF:

+	CALL	PUTBUF		; Falls Puffer voll, nichts uebernommen

+	POP	IX

+	JR	RETREG

+

+;

+;

+;****************************************************************

+;

+;	Meldungen ausgeben auf System-Kanal

+;	String beginnt mit Laengenbyte (!)

+;	Ausser HL keine Register verandert

+;

+SENDMSG:

+	PUSH	AF

+	PUSH	BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,0

+	LD	A,1		; System-Kanal

+	CALL	SHOUT		; String ab HL an Kanal in A ausgeben

+	POP	BC

+	POP	AF

+	RET

+;

+;****************************************************************

+;

+;	Variable

+;

+HDOFS:	DEFB	0		;Harddisk 0

+	DEFB	30H, 00H

+HDLAST:	DEFB	0

+	DEFB	0B2H, 0

+;

+SAVSTP:	DEFW	0		; gesicherter Stackpointer bei TRAP-Interrupt

+RTCOK:	DEFB	0		; FF, wenn RTC-Werte gueltig

+HGOP:	DEFB	0

+KANAL:	DEFB	1		; Kanal merken

+

+;------------------------------------------------------------------------

+;	Anzahl 512-Byte Bloecke, die ein Blockkanal fassen kann

+;	Wird bei control-size abgefragt und vorher bestimmt

+

+BLKTAB:

+

+CPMBLKS:DEFW	0		; Kanal 28 CP/M-Harddisk-Volume

+D1BLKS:	DEFW	0		; Kanal 29 Apple-Floppy 1

+D0BLKS:	DEFW	0		; Kanal 30 Apple-Floppy 0

+ARBLKS:	DEFW	1440		; Kanal 31 SCSI-Floppy 0

+HGBLKS:	DEFW	0		; Kanal 0 (Hintergrund)

+CONBLKS:DEFW	2*4*8		; Kanal 1 (Graphikspeicher) 4 * 8k Seiten

+;

+;

+;****************************************************************

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB
new file mode 100644
index 0000000..1438f05
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB
@@ -0,0 +1,7 @@
+L80

+</P:0,LOAD,/P:0100,SHARD,SCSI,CONOUT,DISK80,GRAFIK80,INTMOD,INT65,INIMOD,DISK

+</M

+<EUMEL/N/E

+<N

+EBOOT

+<J

diff --git a/system/shard-z80-ruc-64180/1.5/src/SLR.COM b/system/shard-z80-ruc-64180/1.5/src/SLR.COM
new file mode 100644
index 0000000..eb9b9a9
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SLR.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/START.MAC b/system/shard-z80-ruc-64180/1.5/src/START.MAC
new file mode 100644
index 0000000..ec199cd
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/START.MAC
@@ -0,0 +1,4 @@
+; Start zum EBOOT, 29.12.86

+	EXTRN	EBOOT

+	JP	EBOOT

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SUB.COM b/system/shard-z80-ruc-64180/1.5/src/SUB.COM
new file mode 100644
index 0000000..5cd90e3
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SUB.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/TRACK.INC b/system/shard-z80-ruc-64180/1.5/src/TRACK.INC
new file mode 100644
index 0000000..162d1ae
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/TRACK.INC
@@ -0,0 +1,166 @@
+

+; TRACK.INC for RUC180 CP/M 3.0

+;

+; Version 13.09.85

+; Stand: 13.01.87, Retries fuer EUMEL entschaerft (ca. 1/8 der alten Zeit)

+

+	  .printx 'TRACK.INC'

+

+track_RW

+          ldy       #1			; 13.01.87, Michael

+          sty       recal_cnt

+          ldy       #02			; 13.01.87

+          sty       tktry_cnt

+          ldx       iob_old_S

+          cpx       slot10z

+          beq       sameSLt

+track0

+          JSR       moving

+          BNE       track0

+          LDX       slot10z

+          STX       iob_old_S

+sameSlt

+          JSR       moving

+          PHP

+          LDA       mtron,X

+          ldy       iob_drv

+          cpy       iob_old_D

+          BEQ       sameDrv

+          sty       iob_old_D

+          PLP

+          lda       #0

+          PHP

+sameDrv

+          CMP       drive0,Y

+          LDA       #0EF

+          STA       wait_cnt

+          LDA       #0D8

+          STA       wait_cnt+1

+          PLP

+          PHP

+          BNE       track2

+          LDY       #8

+track1    JSR       wait

+          DEY

+          BNE       track1

+

+          LDX       slot10z

+track2    JSR       seekT		; Step to Track

+

+          PLP

+          BNE       rotating

+;         bit       param		; wg. bescheuerten Philips-Drives

+;         bmi       no_wait           	; branch if read

+

+track3    LDY       #12

+track4    DEY

+          BNE       track4

+          INC       wait_cnt

+          BNE       track3

+          INC       wait_cnt+1

+          BNE       track3

+;no_wait

+          JSR       moving

+          BEQ       drive_err

+rotating

+          LDA       #0FF

+          STA       iob_sec

+search_hdr

+          LDY       #10			; 13.01.87

+          STY       hdtry_cnt

+nxt_sec

+          cli

+          dec       hdtry_cnt

+          BMI       no_sec

+

+          LDX       slot10z

+          JSR       read_hdr

+          BCS       nxt_sec

+          LDA       trk_in_hdr

+          CMP       iob_trk

+          BEQ       found_trk

+          cli

+	  jsr	    trk_to_ph		; Translate Track to Phase

+          LDY       disk_no

+          STA       head_table,Y	; Store it in Table

+          DEC       tktry_cnt

+          BNE       try_seek

+no_sec

+          DEC       recal_cnt

+          BEQ       drive_err

+          LDA       #02			; 13.01.87

+          STA       tktry_cnt

+	  lda	    #56

+	  bit	    def_byte

+	  bmi	    no_sec2		; Ehring-Controller ?

+

+	  asl	    a			; Ehring: *2

+no_sec2:  LDY       disk_no

+          STA       head_table,Y

+          LDA       #0

+          JSR       seekL		; Step von hinten bis 0

+try_seek

+          JSR       seekT

+          JMP       search_hdr

+drive_err

+          LDA       #1

+          JMP       track_fail

+

+found_trk

+          bit       param

+          bmi       found2

+          LDA       sec_in_hdr

+          CMP       iob_sec

+          BEQ       write_it

+          CLC                     ; next sector for write!

+          ADC       #01

+          AND       #0F

+          CMP       iob_sec

+          BEQ       nxt_sec

+          STA       sec_in_hdr

+found2

+          LDY       sec_in_hdr   ; if sec_in_hdr>=10 then crash...

+          LDA       sec_tble,Y

+          bne       nxt_sec

+;need_sec

+          TYA               	  ; physical sector #

+          ASL       A       	  ;

+          TAY

+          lda       DMA,y

+          sta       user_data

+          lda       DMA+1,y

+          STA       user_data+1    ; pointer to user's buffer

+          bit       param

+          bmi       read_it

+          JSR       make_nibl 

+          LDX       slot10z

+          LDA       sec_in_hdr

+          STA       iob_sec

+j_nxt_sec

+          JMP       nxt_sec

+read_it

+          JSR       read_data

+          BCS       j_nxt_sec

+mark_sec

+          LDY       sec_in_hdr

+          LDA       #0FF

+          STA       sec_tble,Y

+          STA       iob_sec

+          DEC       sec_cnt

+          BNE       j_nxt_sec

+;track_ok

+          lda       #0

+track_fail

+          sta       iob_err

+          lda       mtroff,X

+          cli

+          rts

+write_it

+          JSR       write_data

+          BCC       mark_sec

+          LDA       #2              ; write protected !

+          BCS       track_fail      ; bra

+

+	  .printx   'Ende'

+

+; Ende von NIBLE.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC
new file mode 100644
index 0000000..a6edf3e
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC
@@ -0,0 +1,154 @@
+	;		05..09  		GRAFIK

+basl		EQU	0A	;		DISK (HCOPY im IRQ)

+bash 		EQU	0B	;		DISK (HCOPY im IRQ)

+

+sektor		EQU	0C	;		DISK65

+last_track	EQU	0D	;		DISK65

+bus_locked	EQU	0E	;		DISK65	; Interrupt Flag

+analogwert	EQU	0F	;		DISK65

+

+rbuf		EQU	10	; 10 Bytes Receive-Buffer Descriptor

+

+keyin		EQU	1A	;		DISK

+keyout		EQU	1B	;		DISK

+

+err1_bits	EQU	1C	;		DISK

+err5_bits	EQU	1D	;		DISk

+

+quotient	EQU	1E	;		GRAFIK

+divmask		EQU	1F	;		GRAFIK

+

+temporary	EQU	1E	; +1F		GRAFIK

+

+;	Paket Variable (duerfen Global NICHT veraendert werden!)

+

+thick		EQU	05	;		GRAFIK

+colormask	EQU	06	;		GRAFIK 

+bitmode		EQU	07	;		GRAFIK

+savepattern	EQU	08	; +09		GRAFIK

+pattern		EQU	24	; +25		GRAFIK

+pagebase	EQU	2A	;		GRAFIK

+xpos		EQU	2B	; +2C		GRAFIK

+ypos		EQU	2D	; +2E		GRAFIK

+

+;	Workspace

+

+xpointer	EQU	26	;		GRAFIK

+ypointer	EQU	27	;		GRAFIK

+

+olderror	EQU	28	; +29		GRAFIK

+

+right		EQU	3D	;		GRAFIK

+up		EQU	3E	;		GRAFIK

+

+uprighterror	EQU	3F	; +40		GRAFIK

+;

+ASave		equ	45	;		DISK

+XSave		equ	46	;		DISK

+YSave		equ	47	;		DISK

+

+;

+				; Basis-Schnittstellen:

+KeyBuf		equ	0200	; Page 2 fuer KeyBuf

+wrkpage		EQU	080	; 8k Workpage fuer Fill-Routine

+dma_4k		EQU	0E0	;		DISK65

+DBUFBEG		EQU	0D0	;Printer Spooler Grenzen (4k)

+DBUFEND		EQU	0E0	;		DISK (LC00)

+stack		EQU	0D000	;		GRAFIK (LC01)

+SBUFBEG		EQU	0F0	;Seriell Ausgabe-Spooler Grenzen (1k)

+SBUFEND		EQU	0F4	;		DISK

+RBUFBEG		EQU	0F4	; Serieller Empfangspuffer (2.25k)

+RBUFEND		EQU	0FD	;		DISK

+

+				; Dummy-Block-Buffer fuer SCSI: FD00..FEFF

+				; 64180-Card-Schnittstellen:

+				; DBUF (Centronics): A000..AFFF

+				; SCCA : B000..B7FF

+				; SCCB : B800..BFFF

+

+

+; 64180 interface

+

+DMA       	equ	50	; 50..6F	DISK, DISK65	

+address		equ	50	; +51		GRAFIK

+dx		equ	52	; +53		GRAFIK

+dy		equ	54	; +55		GRAFIK

+righterror	equ	54	; +55		GRAFIK (wie dy!)

+tempmode	equ	56	;		GRAFIK

+

+sec_tble  	equ	70	; 70..7F	DISK, DISK65

+areg		equ	70	; +71		GRAFIK

+breg		equ	72	; +72		GRAFIK

+creg		equ	74	; +75		GRAFIK

+xa		equ	76	; +77		GRAFIK

+xb		equ	78	; +79		GRAFIK

+ya		equ	7A	; +7B		GRAFIK

+yb		equ	7C	; +7D		GRAFIK

+link		equ	7E	; +7F		GRAFIK

+

+task	  	equ	80	; 80		DISK, DISK65

+subtask		EQU	81	;		GRAFIK

+result		EQU	81	;		GRAFIK

+param	  	equ	81	;		DISK, DISK65

+param1		EQU	82	; +83		GRAFIK

+def_byte  	equ	82	;		DISK, DISK65

+disk_no   	equ	83	;		DISK, DISK65

+param2		EQU	84	; +85		GRAFIK

+iob_trk   	equ	84	;		DISK, DISK65

+sec_cnt   	equ	85	;		DISK, DISK65

+iob_err   	equ	86	;		DISK, DISK65

+

+; work space

+

+wait_Cnt   	equ	87	;		DISK

+user_data 	equ	89	;		DISK

+dest_phase 	equ	8B	;		DISK

+chk_in_hdr 	equ	8C	;		DISK

+sec_in_hdr 	equ	8D	;		DISK

+trk_in_hdr 	equ	8E	;		DISK

+vol_in_hdr 	equ	8F	;		DISK

+slot10z   	equ	90      ; slot #: s0	DISK

+iob_drv   	equ	91	;		DISK

+phase     	equ	92	;		DISK

+iob_sec   	equ	93	;		DISK

+chk_sum   	equ	94	;		DISK

+temp2     	equ	95	;		DISK

+head_pos  	equ	96	;		DISK

+tktry_cnt 	equ	97	;		DISK

+hdtry_cnt 	equ	98	;		DISK

+recal_cnt 	equ	99	;		DISK

+A_FLG	  	EQU	9A	; Flags fuer Ausgabeflusskontrolle

+E_FLG		EQU	9B	; Flags fuer Eingabeflusskontrolle

+SerFLG	  	EQU	9C	; Break/Ausgabestopflags

+Wait_Flg	EQU	9D	; 64180 muss auf Update warten

+IFLG		EQU	9E	; Bit 7 = 1: Keine Inputinterrupt Kanal 5

+SLOT180	  	EQU	9F	; Bootslot (Kopie)

+;

+ilv_tble	EQU	$A0	; A0..AF	DISK, DISK65

+	

+;	Offset auf Buffer-Descriptor

+

+free		equ	0	; Freiplatz in Bytes

+full		equ	2	; Anzahl Zeichen im Puffer

+in		equ	4	; Schreibzeiger

+out		equ	6	; Lesezeiger

+beg		equ	8	; Highbyte Pufferanfang

+end		equ	9	; Highbyte Pufferende

+

+pbuf		equ	0E0	; 10 Bytes Spooler Descriptor

+;

+; Interruptparameter zum 64180

+;

+INTPAR1		EQU	0EA	; Interrupt Kanalnr. und Sync.

+INTPAR2		EQU	0EB	;		DISK

+INTPAR3		EQU	0EC	; Fehlerbits	DISK

+

+tbuf		EQU	0F0	; 10 Bytes Transmit-Buffer Descrptor

+

+SLT180	  	EQU	04F8	; Bootslot	DISK

+

+start180 	equ	0C087	;		DISK

+wait180		equ	0C086	;		DISK

+STOP180		equ	0C084	;		DISK

+INT180		EQU	0C083	;		DISK	

+

diff --git a/system/spooler/1.7.5/source-disk b/system/spooler/1.7.5/source-disk
new file mode 100644
index 0000000..e24344a
--- /dev/null
+++ b/system/spooler/1.7.5/source-disk
@@ -0,0 +1,2 @@
+175_src/source-code-1.7.5m_0.img
+175_src/source-code-1.7.5m_1.img
diff --git a/system/spooler/1.7.5/src/spool manager b/system/spooler/1.7.5/src/spool manager
new file mode 100644
index 0000000..ac0295a
--- /dev/null
+++ b/system/spooler/1.7.5/src/spool manager
@@ -0,0 +1,887 @@
+PACKET spool manager DEFINES                        (* Autor: J. Liedtke *)
+                                                    (*        R. Nolting *) 
+                                                    (*        R. Ruland  *)
+                                                    (* Stand: 25.04.86   *)
+ 
+    spool manager ,
+ 
+    server channel ,
+    spool duty,
+    station only, 
+    spool control task :
+ 
+LET que size           = 101 ,
+
+    ack                = 0 ,
+    nak                = 1 ,
+    error nak          = 2 ,
+    message ack        = 3 , 
+    question ack       = 4 ,
+    second phase ack   = 5 ,
+
+    fetch code         = 11 ,
+    save code          = 12 ,
+    file save code old = 13 ,
+    erase code         = 14 ,
+    list code          = 15 ,
+    all code           = 17 ,
+    param fetch code   = 21 ,
+    file save code     = 22 ,
+    entry line code    = 23 ,
+    killer code        = 24 , 
+    first code         = 25 ,
+    start code         = 26 , 
+    stop code          = 27 ,
+    halt code          = 28 ,
+    wait for halt code = 29 ,
+ 
+    continue code      = 100 ,
+ 
+    file type          = 1003 ;
+
+LET begin char  =  ""0"",
+    end char    =  ""1"";
+
+LET PARAMS  =  STRUCT (TEXT name, userid, password, sendername, INT station),
+    ENTRY   =  STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space);
+ 
+ROW que size ENTRY VAR que ;
+
+PARAMS CONST empty params := PARAMS : ("", "", "", "", -1);
+ 
+PARAMS VAR save params, file save params;
+ 
+ENTRY VAR fetch entry;
+ 
+FILE VAR file;
+ 
+INT VAR order, last order, phase, reply, old heap size, first, last, list index, 
+        begin pos, end pos, order task station, sp channel, counter;
+ 
+TEXT VAR order task name, buffer, sp duty, start time;
+ 
+BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry;
+ 
+TASK VAR order task, last order task, server, calling parent, task in control; 
+ 
+INITFLAG VAR in this task := FALSE;
+ 
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT name, userid, password) VAR msg;
+BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
+BOUND PARAMS VAR fetch msg;
+BOUND THESAURUS VAR all msg;
+BOUND TEXT VAR error msg ;
+ 
+ 
+. first entry   :  que (first)
+. list  entry   :  que (list index)
+. last  entry   :  que (last)
+ 
+. que is empty  :  first = last 
+. que is full   :  first = next (last) 
+.; 
+ 
+sp channel      := 0;
+sp duty         := ""; 
+stat only       := FALSE;
+task in control := myself;
+ 
+PROC server channel (INT CONST channel nr) :
+     IF channel nr <= 0 OR channel nr >= 33
+        THEN errorstop ("falsche Kanalangabe") FI;
+     sp channel := channel nr;
+END PROC server channel;
+ 
+INT PROC server channel :
+     sp channel 
+END PROC server channel;
+ 
+ 
+PROC station only (BOOL CONST flag) :
+     stat only := flag
+END PROC station only;
+ 
+BOOL PROC station only : 
+     stat only 
+END PROC station only;
+ 
+ 
+PROC spool duty (TEXT CONST duty) :
+     sp duty := duty;
+END PROC spool duty;
+ 
+TEXT PROC spool duty :
+     sp duty
+END PROC spool duty;
+ 
+ 
+PROC spool control task (TASK CONST task id):
+     task in control := task id;
+END PROC spool control task;
+ 
+TASK PROC spool control task :
+     task in control
+END PROC spool control task;
+ 
+ 
+PROC spool manager (PROC server start) :
+ 
+  spool manager (PROC server start, TRUE) 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool manager (PROC server start, BOOL CONST with start) :
+
+  set autonom ;
+  break ;
+  disable stop ;
+  initialize spool manager ;
+  REP forget (ds) ;
+      wait (ds, order, order task) ;
+      IF   order <> second phase ack
+         THEN prepare first phase ;
+              spool (PROC server start); 
+      ELIF order task = last order task
+         THEN prepare second phase ;
+              spool (PROC server start); 
+         ELSE send nak
+      FI ;
+      send error if necessary ;
+      collect heap garbage if necessary
+  PER 
+ 
+  . initialize spool manager :
+      initialize if necessary;
+      stop;
+      erase fetch entry;
+      IF with start THEN start (PROC server start) FI;
+ 
+  . initialize if necessary :
+      IF NOT initialized (in this task)
+         THEN FOR list index FROM 1 UPTO que size 
+              REP list entry. space := nilspace PER;
+              fetch entry. space    := nilspace;
+              ds                    := nilspace;
+              last order task       := niltask;
+              server                := niltask; 
+              calling parent        := niltask;
+              server is waiting     := FALSE;
+              stop command pending  := FALSE;
+              old heap size         := 0;
+              clear spool;
+      FI;
+
+  . prepare first phase :
+      IF order = save code OR order = erase code OR order = stop code
+         THEN phase := 1 ;
+              last order := order ;
+              last order task := order task ;
+      FI;
+ 
+  . prepare second phase :
+      phase INCR 1 ;
+      order := last order 
+
+  . send nak :
+      forget (ds) ;
+      ds := nilspace ;
+      send (order task, nak, ds);
+ 
+  . send error if necessary :
+      IF is error
+         THEN forget (ds) ;
+              ds := nilspace ;
+              error msg := ds ;
+              CONCR (error msg) := error message;
+              clear error;
+              send (order task, error nak, ds) 
+     FI;
+ 
+  . collect heap garbage if necessary :
+      IF heap size > old heap size + 2
+         THEN collect heap garbage;
+              old heap size := heap size;
+      FI; 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool (PROC server start):
+ 
+  command dialogue (FALSE);
+  enable stop;
+  IF station only CAND station (ordertask) <> station (myself)
+     THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself))
+                      + "/""" + name(myself) + """") 
+  FI;
+ 
+  SELECT order OF
+ 
+    CASE fetch code        :  out of que
+    CASE param fetch code  :  send fetch params
+    CASE save code         :  new que entry
+    CASE file save code, file save code old :
+                              new file que entry 
+    CASE erase code        :  erase que entry
+    CASE list code         :  send spool list
+    CASE all code          :  send owners ds names
+ 
+    OTHERWISE :
+ 
+       IF   order >= continue code AND order task = supervisor
+            THEN forget (ds);
+                 spool command (PROC server start)
+ 
+       ELIF spool control allowed by order task 
+            THEN SELECT order OF
+                   CASE entry line code    :  send next entry line 
+                   CASE killer code        :  kill entry 
+                   CASE first code         :  make to first
+                   CASE start code         :  start server 
+                   CASE stop code          :  stop server
+                   CASE halt code          :  halt server
+                   CASE wait for halt code :  wait for halt
+                   OTHERWISE : errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+                 END SELECT
+ 
+            ELSE errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+       FI;
+  END SELECT;
+ 
+ 
+. spool control allowed by order task :
+    (order task = spool control task OR order task < spool control task
+       OR spool control task = supervisor)
+         AND station (order task) = station (myself)
+. 
+  out of que :
+    IF   NOT (order task = server)
+         THEN errorstop ("keine Servertask")
+    ELIF stop command pending 
+         THEN forget (ds);
+              stop;
+              erase fetch entry;
+    ELIF que is empty
+         THEN forget (ds) ;
+              erase fetch entry;
+              server is waiting := TRUE;
+         ELSE send first entry;
+    FI;
+ 
+. 
+  send fetch params :
+    IF order task = server
+       THEN send params
+       ELSE errorstop ("keine Servertask")
+    FI;
+ 
+    . send params :
+        forget(ds); ds := nilspace; fetch msg := ds;
+        fetch msg := fetch entry. ds params;
+        send (order task, ack, ds);
+ 
+. 
+  new que entry :
+    IF phase = 1
+       THEN prepare into que
+       ELSE into que
+    FI;
+ 
+.
+  prepare into que :
+    msg := ds ;
+    save params. name       := msg.name;
+    save params. userid     := msg.userid;
+    save params. password   := msg.password;
+    save params. sendername := name (order task);
+    save params. station    := station (order task);
+    forget (ds); ds := nilspace;
+    send (order task, second phase ack, ds);
+ 
+. 
+  new file que entry :
+    IF type (ds) <> file type
+       THEN errorstop ("Datenraum hat falschen Typ");
+       ELSE get file params;
+            into que;
+    FI;
+ 
+    . get file params :
+        file := sequential file (input, ds);
+        end pos := 0;
+        next headline information (file save params. name); 
+        next headline information (file save params. userid); 
+        next headline information (file save params. password); 
+        next headline information (file save params. sendername); 
+        next headline information (buffer);
+        file save params. station := int (buffer);
+        IF NOT last conversion ok
+           THEN file save params. station    := station (order task) FI;
+        IF file save params. sendername = ""
+           THEN file save params. sendername := name    (order task) FI;
+        IF file save params. name = ""
+           THEN IF headline (file) <> ""
+                   THEN file save params. name := headline (file);
+                   ELSE errorstop ("Name unzulaessig")
+                FI;
+           ELSE headline (file, file save params. name);
+        FI;
+ 
+. 
+  erase que entry :
+    msg                := ds ;
+    order task name    := name (order task);
+    order task station := station (order task);
+    IF phase = 1
+       THEN ask for erase
+       ELSE erase entry from order task 
+    FI;
+ 
+    . ask for erase :
+        to first que entry; 
+        WHILE next que entry found 
+        REP IF is entry from order task (msg. name) 
+               THEN manager question ("""" + msg.name + """ loeschen"); 
+                    LEAVE erase que entry
+            FI;
+        PER ;
+        manager message ("""" + msg.name + """ existiert nicht");
+ 
+    . erase entry from order task :
+        IF is entry from order task (msg. name) 
+           THEN delete que entry; 
+                LEAVE erase que entry 
+           ELSE to first que entry; 
+                WHILE next que entry found 
+                REP IF is entry from order task (msg. name) 
+                       THEN delete que entry;
+                            LEAVE erase que entry 
+                    FI ;
+                PER ;
+                manager message ("""" + msg.name +  """ existiert nicht");
+        FI;
+ 
+        . delete que entry :
+            erase entry (list index) ;
+            send ack;
+ 
+.
+  send owners ds names:
+     order task name    := name (order task);
+     order task station := station (order task);
+     forget (ds); ds := nilspace; all msg := ds; 
+     all msg := empty thesaurus; 
+     to first que entry; 
+     WHILE next que entry found 
+     REP IF is entry from order task ("")
+            THEN insert (all msg, list entry. ds params. name) 
+         FI; 
+     PER;
+     send (order task, ack, ds) 
+ 
+. 
+  send spool list :
+     list spool;
+     send (order task, ack, ds);
+ 
+.
+  send next entry line :
+    control msg := ds;
+    get next entry line (control msg. entry line, control msg. index);
+    send (order task, ack, ds);
+ 
+. 
+  kill entry :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN erase entry (list index)
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  make to first :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN new first (list entry);
+            erase entry (list index); 
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  start server :
+    IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI;
+    start (PROC server start);
+    IF server channel <= 0 OR server channel >= 33
+       THEN manager message ("WARNUNG : Serverkanal nicht eingestellt");
+       ELSE send ack
+    FI;
+ 
+. 
+  stop server:
+    IF phase = 1
+       THEN stop;
+            IF valid fetch entry
+               THEN valid fetch entry := FALSE;
+                    manager question (""13""10"" +
+                          fetch entry. entry line + "   neu eintragen");
+               ELSE erase fetch entry;
+                    send ack;
+            FI;
+       ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI;
+            erase fetch entry; 
+            send ack;
+    FI;
+ 
+. 
+  halt server :
+    stop command pending := TRUE; 
+    IF NOT exists (server) OR server is waiting
+       THEN stop;
+            erase fetch entry;
+    FI;
+    send ack;
+
+.
+  wait for halt :
+    IF exists (calling parent)
+       THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt")
+       ELSE calling parent := order task;
+            stop command pending := TRUE;
+            forget (ds);
+            IF NOT exists (server) OR server is waiting
+            THEN stop;
+                 erase fetch entry;
+            FI;
+    FI;
+ 
+END PROC spool;
+ 
+
+PROC  send first entry :
+ 
+  forget (ds); ds := first entry. space;
+  send (server, ack, ds, reply) ;
+  IF reply = ack
+     THEN server is waiting := FALSE;
+          start time  := time of day;
+          start time CAT " am ";
+          start time CAT date;
+          erase fetch entry;
+          fetch entry := first entry;
+          erase entry (first);
+          valid fetch entry := TRUE;
+     ELSE forget (ds);
+  FI;
+ 
+END PROC  send first entry;
+
+ 
+PROC into que :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE make new entry;
+          send ack;
+          awake server if necessary
+  FI;
+ 
+  . make new entry :
+      IF order = save code
+         THEN last entry. ds params  := save params;
+              save params := empty params;
+         ELSE last entry. ds params  := file save params;
+              file save params := empty params;
+      FI;
+      last entry. space :=  ds;
+      counter INCR 1;
+      build entry line;
+      last := next (last) ;
+ 
+      . build entry line :
+          IF LENGTH last entry. ds params. sender name > 16
+             THEN buffer := subtext (last entry. ds params. sender name, 1, 13); 
+                  buffer CAT "...""";
+             ELSE buffer := last entry. ds params. sender name;
+                  buffer CAT """";
+                  buffer := text (buffer, 17);
+          FI;
+          last entry. entry line :=  text (last entry. ds params. station, 2);
+          last entry. entry line CAT "/""";
+          last entry. entry line CAT buffer;
+          last entry. entry line CAT " : """ ;
+          last entry. entry line CAT last entry. ds params. name;
+          last entry. entry line CAT """  (" ;
+          last entry. entry line CAT text (storage (last entry. space));
+          last entry. entry line CAT " K)";
+ 
+  . awake server if necessary :
+      IF server is waiting THEN send first entry FI;
+ 
+END PROC into que;
+
+ 
+PROC list spool :
+ 
+  forget (ds); ds := nilspace;
+  file := sequential file (output, ds) ;
+  max line length (file, 1000);
+  headline(file, text (station(myself)) + "/""" + name (myself) + """");
+  put spool duty;
+  put current job;
+  put spool que;
+ 
+  . put spool duty :
+      IF spool duty <> ""
+         THEN write (file, "Aufgabe: ");
+              write (file, spool duty );
+              line (file, 2);
+      FI;
+ 
+  . put current job :
+      IF valid fetch entry AND exists (server)
+         THEN write (file, "In Bearbeitung seit ");
+              write (file, start time);
+              write (file, ":");
+              line (file, 2);
+              putline (file, fetch entry. entry line);
+              IF stop command pending
+                 THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert");
+              FI;
+              line (file);
+         ELSE write (file, "kein Auftrag in Bearbeitung");
+              IF   NOT exists (server)
+                   THEN write (file, ", da Spool deaktiviert");
+              ELIF que is empty
+                   THEN write (file, ", da Warteschlange leer");
+                        LEAVE list spool;
+              FI;
+              line (file, 2);
+      FI;
+ 
+  . put spool que :
+      IF que is empty
+         THEN putline (file, "Warteschlange ist leer");
+         ELSE write (file, "Warteschlange (");
+              write (file, text (counter));
+              write (file, " Auftraege):");
+              line (file, 2);
+              to first que entry ;
+              WHILE next que entry found
+              REP putline (file, list entry. entry line) PER;
+      FI;
+ 
+END PROC list spool ;
+ 
+ 
+PROC clear spool :
+ 
+  first                := 1; 
+  last                 := 1;
+  counter              := 0;
+  FOR list index FROM 1 UPTO que size 
+  REP list entry. ds params  := empty params;
+      list entry. entry line := "";
+      forget (list entry. space)
+  PER;
+ 
+END PROC clear spool;
+ 
+(*********************************************************************) 
+(*  Hilfsprozeduren zum Spoolmanager                                 *)
+ 
+BOOL PROC is valid que entry (INT CONST index) :
+ 
+  que (index). entry line <> ""
+ 
+END PROC is valid que entry;
+ 
+ 
+INT PROC next (INT CONST index) :
+ 
+  IF index < que size
+     THEN index + 1
+     ELSE 1
+  FI
+ 
+END PROC next;
+ 
+ 
+PROC to first que entry :
+ 
+  list index := first - 1;
+ 
+ENDPROC to first que entry ;
+ 
+ 
+BOOL PROC next que entry found :
+ 
+  list index := next (list index);
+  WHILE is not last que entry
+  REP IF is valid que entry (list index) 
+         THEN LEAVE next que entry found WITH TRUE FI;
+      list index := next (list index);
+  PER;
+  FALSE
+ 
+  . is not last que entry :
+      list index <> last 
+ 
+ENDPROC next que entry found ;
+ 
+ 
+PROC get next entry line (TEXT VAR entry line, INT VAR index) :
+ 
+  IF index = 0
+     THEN list index := first - 1
+     ELSE list index := index
+  FI;
+  IF next que entry found
+     THEN entry line := list entry. entry line;
+          index      := list index;
+     ELSE entry line := "";
+          index      := 0;
+  FI;
+ 
+END PROC get next entry line;
+ 
+ 
+PROC new first (ENTRY VAR new first entry) :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE first DECR 1 ;
+          IF first = 0 THEN first := que size FI;
+          first entry := new first entry;
+          counter INCR 1;
+  FI;
+ 
+END PROC new first;
+ 
+ 
+PROC erase entry (INT CONST index) :
+ 
+  entry. ds params  := empty params;
+  entry. entry line := "";
+  forget (entry.space) ;
+  counter DECR 1;
+  IF index = first
+     THEN inc first
+  FI ;
+
+  . entry : que (index) 
+ 
+  . inc first :
+      REP first := next (first)
+        UNTIL que is empty OR is valid que entry (first) PER
+ 
+END PROC erase entry;
+ 
+ 
+PROC erase fetch entry :
+ 
+  fetch entry. ds params  := empty params;
+  fetch entry. entry line := "";
+  forget (fetch entry. space);
+  valid fetch entry := FALSE;
+ 
+END PROC erase fetch entry;
+ 
+ 
+BOOL PROC is entry from order task (TEXT CONST file name) :
+ 
+  correct order task CAND correct filename
+ 
+  . correct order task :
+      order task name = list entry. ds params. sendername
+          AND order task station = list entry. ds params. station
+ 
+  . correct file name :
+      file name = "" OR file name = list entry. ds params. name
+ 
+END PROC is entry from order task; 
+ 
+ 
+PROC start (PROC server start):
+ 
+  begin (PROC server start, server);
+ 
+END PROC start;
+
+ 
+PROC stop :
+ 
+  stop server;
+  send calling parent reply if necessary;
+ 
+  . stop server:
+      IF exists (server) THEN end (server) FI;
+      server               := niltask;
+      server is waiting    := FALSE;
+      stop command pending := FALSE; 
+ 
+  . send calling parent reply if necessary :
+      IF exists (calling parent)
+         THEN forget (ds); ds := nilspace;
+              send (calling parent, ack, ds);
+              calling parent  := niltask;
+      FI;
+ 
+END PROC stop;
+ 
+ 
+PROC next headline information (TEXT VAR t):
+ 
+  begin pos := pos (headline (file), begin char, end pos + 1);
+  IF begin pos = 0
+     THEN begin pos := LENGTH headline (file) + 1;
+          t := "";
+     ELSE end pos := pos (headline (file), end char, begin pos + 1);
+          IF end pos = 0
+             THEN end pos := LENGTH headline (file) + 1; 
+                  t := "";
+             ELSE t := subtext (headline (file), begin pos+1, end pos-1)
+          FI
+  FI
+ 
+END PROC next headline information;
+ 
+ 
+PROC send ack :
+ 
+    forget (ds); ds := nilspace;
+    send (order task, ack, ds)
+ 
+END PROC send ack;
+ 
+ 
+PROC manager question (TEXT CONST question) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := question ;
+  send (order task, question ack, ds)
+ 
+ENDPROC manager question ;
+ 
+
+PROC manager message (TEXT CONST message) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := message ;
+  send (order task, message ack, ds)
+ 
+ENDPROC manager message ;
+ 
+(*********************************************************************) 
+(*  Spool - Kommandos                                                *)
+ 
+INT VAR command index , params ;
+TEXT VAR command line, param 1, param 2 ;
+ 
+LET spool command list =
+"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0
+clearspool:9.0spoolcontrolby:10.1";
+ 
+PROC spool command (PROC server start) :
+
+  enable stop ;
+  continue (order - continue code) ;
+  disable stop ;
+  REP command dialogue (TRUE) ;
+      get command ("gib Spool-Kommando:", command line);
+      analyze command (spool command list, command line, 3, command index,
+                       params, param1, param2);
+      execute command (PROC server start);
+  UNTIL NOT online PER;
+  command dialogue (FALSE);
+  break (quiet);
+  set autonom;
+ 
+END PROC spool command;
+ 
+ 
+PROC execute command (PROC server start) :
+ 
+ enable stop;
+ SELECT command index OF 
+   CASE 1  :  break
+   CASE 2  :  start server 
+   CASE 3  :  start server with new channel
+   CASE 4  :  stop server
+   CASE 5  :  halt server
+   CASE 6  :  first cmd
+   CASE 7  :  killer cmd
+   CASE 8  :  show spool list
+   CASE 9  :  clear spool
+   CASE 10 :  spool control task (task (param1))
+   OTHERWISE  do (command line)
+ END SELECT;
+ 
+  . start server :
+     IF server channel <= 0 OR server channel >= 33
+        THEN line;
+             putline ("WARNUNG : Serverkanal nicht eingestellt");
+     FI;
+     stop server;
+     start (PROC server start);
+ 
+  . start server with new channel:
+      INT VAR i := int (param1);
+      IF last conversion ok 
+         THEN server channel (i);
+              start server;
+         ELSE errorstop ("falsche Kanalangabe")
+      FI;
+ 
+  . stop server :
+      disable stop;
+      stop;
+      IF valid fetch entry CAND
+             yes (""13""10"" + fetch entry. entry line + "   neu eintragen")
+         THEN new first (fetch entry) FI;
+      erase fetch entry;
+      enable stop;
+ 
+  . halt server :
+      stop command pending := TRUE; 
+      IF NOT exists (server) OR server is waiting
+         THEN stop server;
+              erase fetch entry;
+      FI;
+ 
+  . first cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   als erstes")
+             THEN new first (list entry);
+                  erase entry (list index);
+                  LEAVE first cmd
+          FI ;
+      PER;
+ 
+  . killer cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   loeschen") THEN erase entry (list index) FI ;
+      PER;
+ 
+  . show spool list :
+      list spool;
+      disable stop;
+      show (file);
+      forget (ds);
+ 
+ENDPROC execute command ;
+ 
+ENDPACKET spool manager; 
+
diff --git a/system/spooler/1.8.7-net/source-disk b/system/spooler/1.8.7-net/source-disk
new file mode 100644
index 0000000..5a39f6c
--- /dev/null
+++ b/system/spooler/1.8.7-net/source-disk
@@ -0,0 +1 @@
+grundpaket/11_austausch.img
diff --git a/net/port server b/system/spooler/1.8.7-net/src/port server
index 46c647f..46c647f 100644
--- a/net/port server
+++ b/system/spooler/1.8.7-net/src/port server
diff --git a/net/printer server b/system/spooler/1.8.7-net/src/printer server
index b1a30bc..b1a30bc 100644
--- a/net/printer server
+++ b/system/spooler/1.8.7-net/src/printer server
diff --git a/net/spool cmd b/system/spooler/1.8.7-net/src/spool cmd
index b44e799..b44e799 100644
--- a/net/spool cmd
+++ b/system/spooler/1.8.7-net/src/spool cmd
diff --git a/net/spool manager b/system/spooler/1.8.7-net/src/spool manager
index e711ab4..e711ab4 100644
--- a/net/spool manager
+++ b/system/spooler/1.8.7-net/src/spool manager
diff --git a/system/spooler/1.8.7-std.zusatz/source-disk b/system/spooler/1.8.7-std.zusatz/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/spooler/1.8.7-std.zusatz/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/system/port server b/system/spooler/1.8.7-std.zusatz/src/port server
index 46c647f..46c647f 100644
--- a/system/port server
+++ b/system/spooler/1.8.7-std.zusatz/src/port server
diff --git a/system/printer server b/system/spooler/1.8.7-std.zusatz/src/printer server
index b1a30bc..b1a30bc 100644
--- a/system/printer server
+++ b/system/spooler/1.8.7-std.zusatz/src/printer server
diff --git a/system/spool cmd b/system/spooler/1.8.7-std.zusatz/src/spool cmd
index 9b43d36..9b43d36 100644
--- a/system/spool cmd
+++ b/system/spooler/1.8.7-std.zusatz/src/spool cmd
diff --git a/system/spool manager b/system/spooler/1.8.7-std.zusatz/src/spool manager
index 6b4fe55..6b4fe55 100644
--- a/system/spool manager
+++ b/system/spooler/1.8.7-std.zusatz/src/spool manager
diff --git a/doc/graphic/Altes Handbuch - Teil 10 - Graphik b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
index 36fa31e..36fa31e 100644
--- a/doc/graphic/Altes Handbuch - Teil 10 - Graphik
+++ b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
diff --git a/doc/graphic/GRAPHIK.book b/system/std.graphik/1.8.7/doc/GRAPHIK.book
index 435d9e4..435d9e4 100644
--- a/doc/graphic/GRAPHIK.book
+++ b/system/std.graphik/1.8.7/doc/GRAPHIK.book
diff --git a/doc/graphic/graphik beschreibung b/system/std.graphik/1.8.7/doc/graphik beschreibung
index 53ebe49..53ebe49 100644
--- a/doc/graphic/graphik beschreibung
+++ b/system/std.graphik/1.8.7/doc/graphik beschreibung
diff --git a/system/std.graphik/1.8.7/source-disk b/system/std.graphik/1.8.7/source-disk
new file mode 100644
index 0000000..8e7ff34
--- /dev/null
+++ b/system/std.graphik/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/05_std.graphik.img
diff --git a/graphic/Beispiel.Kreuz b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
index e29f24a..e29f24a 100644
--- a/graphic/Beispiel.Kreuz
+++ b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
diff --git a/graphic/Beispiel.Sinus b/system/std.graphik/1.8.7/src/Beispiel.Sinus
index beac7cd..beac7cd 100644
--- a/graphic/Beispiel.Sinus
+++ b/system/std.graphik/1.8.7/src/Beispiel.Sinus
diff --git a/graphic/GRAPHIK.Picfile b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
index 3accf52..3accf52 100644
--- a/graphic/GRAPHIK.Picfile
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
diff --git a/graphic/GRAPHIK.Plot b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
index 5087abb..5087abb 100644
--- a/graphic/GRAPHIK.Plot
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
diff --git a/graphic/GRAPHIK.Plotter b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
index a55e515..a55e515 100644
--- a/graphic/GRAPHIK.Plotter
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
diff --git a/graphic/GRAPHIK.Server b/system/std.graphik/1.8.7/src/GRAPHIK.Server
index dfe5f62..dfe5f62 100644
--- a/graphic/GRAPHIK.Server
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Server
diff --git a/graphic/GRAPHIK.Transform b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
index 54690cc..54690cc 100644
--- a/graphic/GRAPHIK.Transform
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
diff --git a/graphic/GRAPHIK.vektor plot b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
index 8bef1e4..8bef1e4 100644
--- a/graphic/GRAPHIK.vektor plot
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
diff --git a/graphic/HP7475.plot b/system/std.graphik/1.8.7/src/HP7475.plot
index 860dd03..860dd03 100644
--- a/graphic/HP7475.plot
+++ b/system/std.graphik/1.8.7/src/HP7475.plot
diff --git a/graphic/PC.plot b/system/std.graphik/1.8.7/src/PC.plot
index 712f5ea..712f5ea 100644
--- a/graphic/PC.plot
+++ b/system/std.graphik/1.8.7/src/PC.plot
diff --git a/graphic/ZEICHENSATZ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
index 9866ec2..9866ec2 100644
--- a/graphic/ZEICHENSATZ
+++ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
diff --git a/graphic/gen Graphik b/system/std.graphik/1.8.7/src/gen Graphik
index f70cc66..f70cc66 100644
--- a/graphic/gen Graphik
+++ b/system/std.graphik/1.8.7/src/gen Graphik
diff --git a/graphic/gen Plotter b/system/std.graphik/1.8.7/src/gen Plotter
index 73d7b2f..73d7b2f 100644
--- a/graphic/gen Plotter
+++ b/system/std.graphik/1.8.7/src/gen Plotter
diff --git a/graphic/graphik editor b/system/std.graphik/1.8.7/src/graphik editor
index 7aa6e33..7aa6e33 100644
--- a/graphic/graphik editor
+++ b/system/std.graphik/1.8.7/src/graphik editor
diff --git a/system/std.zusatz/1.7.3/src/17CHARS.ELA b/system/std.zusatz/1.7.3/src/17CHARS.ELA
new file mode 100644
index 0000000..160997a
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/17CHARS.ELA
@@ -0,0 +1,44 @@
+PACKET special 17 chars DEFINES chars 17 :

+

+TEXT VAR rec , schar ;

+FILE VAR f ;

+

+PROC chars 17 :

+

+  REP

+    down ("""") ;

+    get schar ;

+  UNTIL perhaps schar ("225", "217")

+    COR perhaps schar ("239", "218")

+    COR perhaps schar ("245", "219")

+    COR perhaps schar ("193", "214")

+    COR perhaps schar ("207", "215")

+    COR perhaps schar ("213", "216")

+    COR perhaps schar ("235", "220")

+    COR perhaps schar ("173", "221")

+    COR perhaps schar ("163", "222")

+    COR perhaps schar ("160", "223")

+    COR perhaps schar ("194", "251")

+    COR eof

+  PER ;

+  zeile neu .

+

+get schar :

+  f := editfile ;

+  read record (f, rec) ;

+  schar := subtext (rec, col + 1, col + 3) .

+

+ENDPROC chars 17 ;

+

+BOOL PROC perhaps schar (TEXT CONST old, new) :

+

+  IF schar = old

+    THEN change (rec, col + 4, col + 3, new) ;

+         write record (f, rec) ;

+         TRUE

+    ELSE FALSE

+  FI .

+

+ENDPROC perhaps schar ;

+

+ENDPACKET special 17 chars ;

diff --git a/system/std.zusatz/1.7.3/src/EMU16.ELA b/system/std.zusatz/1.7.3/src/EMU16.ELA
new file mode 100644
index 0000000..a8e1292
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/EMU16.ELA
@@ -0,0 +1,109 @@
+PACKET emulator 16 DEFINES                     (* Autor:  J.Liedtke *)

+                                               (* Stand:  11.10.83  *)

+  killer ,                                     (* F. Klapper, 26.03.84 *) 

+  command handler ,

+  set command ,

+  to archive, 

+  from archive, 

+  load archive, 

+  save archive, 

+  list archive, 

+  release archive: 

+ 

+PROC list archive: 

+  list (archive) 

+ 

+END PROC list archive; 

+ 

+PROC release archive: 

+  release (archive) 

+ 

+END PROC release archive; 

+ 

+PROC to archive: 

+  save (last param, archive) 

+ 

+END PROC to archive; 

+ 

+PROC to archive (TEXT CONST t): 

+  save (t, archive) 

+ 

+END PROC to archive; 

+ 

+PROC from archive (TEXT CONST t): 

+  fetch (t, archive) 

+ 

+END PROC from archive; 

+ 

+PROC load archive: 

+  fetch all (archive) 

+ 

+END PROC load archive; 

+ 

+PROC save to archive (THESAURUS CONST thes): 

+  disable stop; 

+  all to archive (thes); 

+  IF is error 

+  THEN put error; 

+       line; 

+       clear error; 

+       IF yes ("naechste Archivfloppy eingelegt") 

+       THEN save to archive (remainder) 

+       FI 

+   FI; 

+   enable stop 

+ 

+END PROC save to archive; 

+ 

+PROC all to archive (THESAURUS CONST thes): 

+  enable stop; 

+  save (thes, archive) 

+ 

+END PROC all to archive; 

+ 

+PROC save archive: 

+  save to archive (ALL myself) 

+ 

+END PROC save archive; 

+ 

+PROC save archive (TEXT CONST liste): 

+  save to archive (ALL liste) 

+ 

+END PROC save archive; 

+ 

+PROC killer :

+  forget (ALL myself)

+

+ENDPROC killer ;

+

+TEXT VAR command line;

+INT VAR permitted type := 0 ;

+

+PROC set command (TEXT CONST command text, INT CONST type) :

+

+  command line := command text;

+  permitted type := type

+

+ENDPROC set command ;

+

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2) :

+

+  analyze command (command list, command line, permitted type, command index,

+                   number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+ 

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2,

+                      TEXT CONST command text) :

+ 

+  get command (command text, command line) ;

+  analyze command (command list, command line, 0,

+                   command index, number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+

+ENDPACKET emulator 16 ;

diff --git a/system/std.zusatz/1.7.3/src/EMU16M.ELA b/system/std.zusatz/1.7.3/src/EMU16M.ELA
new file mode 100644
index 0000000..ed8cff4
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/EMU16M.ELA
@@ -0,0 +1,162 @@
+PACKET emulator 16 multi DEFINES               (* Autor:  J.Liedtke *)

+                                               (* Stand:  11.10.83  *)

+  killer ,                                     (* F. Klapper, 16.05.84 *)

+  file names ,

+  out ,

+  command handler ,

+  set command ,

+  call ,

+  read , 

+  to archive, 

+  from archive, 

+  load archive, 

+  save archive, 

+  list archive, 

+  release archive, 

+  forward, 

+  backward, 

+  to eof,

+  to first record, 

+  is first record: 

+ 

+PROC list archive: 

+  list (archive) 

+END PROC list archive; 

+ 

+PROC release archive: 

+  release (archive) 

+END PROC release archive; 

+ 

+PROC to archive: 

+  save (last param, archive) 

+END PROC to archive; 

+ 

+PROC to archive (TEXT CONST t): 

+  save (t, archive) 

+END PROC to archive; 

+ 

+PROC from archive (TEXT CONST t): 

+  fetch (t, archive) 

+END PROC from archive; 

+ 

+PROC load archive: 

+  fetch all (archive) 

+END PROC load archive; 

+ 

+PROC save to archive (THESAURUS CONST thes): 

+  disable stop; 

+  all to archive (thes); 

+  IF is error 

+  THEN put error; 

+       line; 

+       clear error; 

+       IF yes ("naechste Archivfloppy eingelegt") 

+       THEN save to archive (remainder) 

+       FI 

+   FI; 

+   enable stop 

+END PROC save to archive; 

+ 

+PROC all to archive (THESAURUS CONST thes): 

+  enable stop; 

+  save (thes, archive) 

+END PROC all to archive; 

+ 

+PROC save archive: 

+  save to archive (ALL myself) 

+END PROC save archive; 

+ 

+PROC save archive (TEXT CONST liste): 

+  save to archive (ALL liste) 

+END PROC save archive; 

+

+PROC killer :

+  forget (ALL myself)

+ENDPROC killer ;

+

+THESAURUS VAR cat ;

+TEXT VAR file name ;

+

+PROC file names (FILE VAR f) :

+  file names (f, name (myself))

+ENDPROC file names ;

+

+PROC file names (FILE VAR f, TEXT CONST manager name) :

+  INT VAR index := 0 ;

+  cat := ALL task (manager name) ;

+  REP

+    get (cat, file name, index) ;

+    IF file name = ""

+      THEN LEAVE file names

+    FI ;

+    putline (f, file name)

+  PER

+ENDPROC file names ;

+

+PROC out (FILE VAR f, TEXT CONST t) :

+  write (f,t)

+ENDPROC out ;

+

+TEXT VAR command line;

+INT VAR permitted type := 0 ;

+

+PROC set command (TEXT CONST command text, INT CONST type) :

+  command line := command text;

+  permitted type := type

+ENDPROC set command ;

+

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2) :

+ 

+  analyze command (command list, command line, permitted type, command index,

+                   number of params, param 1, param 2) 

+ 

+ENDPROC command handler ;

+ 

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2,

+                      TEXT CONST command text) :

+ 

+  get command (command text, command line) ;

+  analyze command (command list, command line, 0,

+                   command index, number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+

+PROC call (TEXT CONST dest name, INT CONST order code, 

+           DATASPACE VAR ds, INT VAR reply code) :

+

+  call (task (dest name), order code, ds, reply code)

+

+ENDPROC call ;

+

+PROC read (TEXT CONST file name) :

+  fetch (file name)

+ENDPROC read ;

+

+PROC read (TEXT CONST file name, manager name) :

+  fetch (file name, task(manager name))

+ENDPROC read ;

+

+PROC forward (FILE VAR f): 

+  down (f) 

+END PROC forward; 

+ 

+PROC backward (FILE VAR f): 

+  up (f) 

+END PROC backward; 

+ 

+PROC to first record (FILE VAR f): 

+  to line (f, 1) 

+END PROC to first record; 

+ 

+BOOL PROC is first record (FILE VAR f): 

+  line no (f) = 1 

+END PROC is first record; 

+ 

+PROC to eof (FILE VAR f): 

+  to line (f, lines (f)) 

+END PROC to eof;

+ENDPACKET emulator 16 multi ;

diff --git a/system/std.zusatz/1.7.3/src/FONTR16.ELA b/system/std.zusatz/1.7.3/src/FONTR16.ELA
new file mode 100644
index 0000000..91acfe0
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/FONTR16.ELA
@@ -0,0 +1,360 @@
+PACKET fonts routines

+(************************************************************************** 

+***** Verwaltung der Schriftfontstabelle  **  Author : R. Nolting     *****

+***** Benoetigt von allen Druckertreibern **  Version: 0.1 / 3.5.82   *****

+*****                                     **  Version: 1.0 / 8.6.82   ***** 

+*****                                     **  Version: 2.0 / 1. 8. 82 *****

+***** Schrittweite in x und y in Tabelle  **  Version: 3.0 / 1. 9. 83 ***** 

+***** Zeilenhoehe in cm                   **  Version: 3.1 / 2. 4. 84 *****

+**************************************************************************)

+ 

+    DEFINES 

+             load font table,

+             get font,

+             list fonts,

+             inch,

+             current font number,

+             lf height of current font,

+             x factor per inch, 

+             y factor per inch:

+

+LET max fonts = 8;

+LET max nr points = 4;

+LET PRINTTYPE = STRUCT (INT x steps per inch, y steps per inch,

+                        ROW max nr points INT point size,

+                        TEXT name, pitch table, codetable);

+ROW max fonts PRINTTYPE VAR font;

+FILE VAR font file;

+INT VAR font number := 1, point number := 1;

+TEXT VAR record :=  " ",

+         symb;

+INT VAR i;

+REAL CONST inch := 2.54;

+ 

+INT PROC x factor per inch: 

+  x step

+END PROC x factor per inch;

+ 

+INT PROC y factor per inch: 

+  lf 

+END PROC y factor per inch;

+ 

+REAL PROC lf height of current font:

+  real(point (point number)) * inch / real (lf)  (* 9.1.84 Nolting *)

+END PROC lf height of current font;

+ 

+INT PROC current font number: 

+  font number 

+END PROC current font number;

+(*******************************************************************

+*********  Setzen und Liefern von Schriftsaetzen              ******

+*******************************************************************)

+PROC init font:

+FOR font number FROM 1 UPTO max fonts REP;

+  lf := 1; 

+  x step := 1; 

+  FOR point number FROM 1 UPTO max nr points REP 

+    point(point number) := 1; 

+    PER;

+  kode := "";

+  name := "";

+  pitch:= "";

+  PER;

+END PROC init font;

+(******************************************************************)

+ 

+PROC list fonts:

+  line;

+  FOR font number FROM 1 UPTO max fonts REP

+   IF name <> "" AND name <> " "

+       THEN put typ name 

+       FI;

+    line;

+    PER;

+  font number := 1; point number := 1;

+. 

+put typ name:

+  put (font number); put (".");

+  put ("'"); put (name); put ("'");

+  IF length (pitch) > 1 

+     THEN put ("proportional mit Blankbreite"); put (code (pitch SUB 32))

+     ELSE put ("fest mit Blankbreite"); put (code (pitch));

+     FI;

+  put ("und Zeilenhoehe"); put (point (1));

+END PROC list fonts;

+ 

+BOOL PROC font is in table (TEXT CONST name of font):

+  record := name of font;

+  changeall (record, " ","");

+  IF record = ""

+     THEN font number := 1; TRUE

+     ELSE search through the table

+     FI

+.

+search through the table:

+(* der Name des gewuenschten Types darf noch ein angehaengtes Attribut haben *)

+  FOR font number FROM 1 UPTO max fonts REPEAT

+    IF pos (record, name) = 1

+       THEN LEAVE search through the table WITH TRUE

+       FI;

+    PER;

+    font number := 1;

+    FALSE

+ENDPROC font is in table;

+ 

+PROC get font (TEXT VAR name of font,

+               TEXT VAR font pitch table, font code table,

+               BOOL VAR success):

+INT VAR lf size := 0;

+  get font (name of font, lf size, 

+            font pitch table, font code table, success); 

+  replace (font pitch table, 10, code(lfsize)); 

+END PROC get font; 

+ 

+PROC get font (TEXT VAR name of font, INT VAR size,

+               TEXT VAR font pitch table, font code table,

+               BOOL VAR success):

+  success := font is in table (name of font);

+  name of font := name;

+  (* hiermit wird eine Ueberpruefung 'alter Typ = neuer Typ'

+     im aufrufenden Programm ermoeglicht *)

+  font code table := kode;

+  font pitch table := pitch;

+  point number := max nr points;

+  WHILE point (point number) <> size REP

+    point number DECR 1; 

+    UNTIL point number = 1 PER; 

+  size := point (point number); 

+  IF size = point (1) 

+     THEN font pitch table := pitch;

+          LEAVE get font 

+     ELSE font pitch table := ""

+     FI; 

+  INT VAR j := point (1); 

+  FOR i FROM 1 UPTO length (pitch) REP

+    font pitch table CAT code(code (pitch SUB i) * size DIV j)

+    PER;

+

+END PROC get font;

+ 

+LET tag            = 1 ,

+    bold           = 2 , 

+    number         = 3 ,

+    string         = 4 ,  (* = text; aber PROC text wird benoetigt *)

+    operator       = 5 ,

+    delimiter      = 6 , 

+    end of file    = 7 , 

+    within comment = 8 ,

+    within text    = 9 ;

+ 

+PROC load font table (TEXT CONST font file name):

+BOOL VAR prop font;

+INT VAR type of symbol := 0;

+REAL VAR blank in cm ,

+         lf in cm;

+REAL VAR width, inch factor;

+INT VAR factor width;

+ 

+enable stop;

+IF NOT exists (font file name)

+   THEN errorstop ("Fontdatei nicht vorhanden")

+   FI;

+font file := sequential file (input, font file name);

+  init font;

+  font number := 0;

+  getline (font file, record);

+  protline (record);

+  WHILE NOT eof (font file) REP

+    font number INCR 1;

+    get font name and parameters;

+    get char width and output function;

+  UNTIL eof (font file) COR font number >= max fonts PER;

+  font number := 1; point number := 1;

+.

+get font name and parameters:

+  get font name; 

+  get fixed or prop; 

+  get blank width; 

+  get linefeed height; 

+  get pointsizes;

+  get optional x steps per inch;

+  fill pitch and code table with default;

+. 

+get font name:

+  next entry;  prot (symb);

+  IF (symb SUB 1) = "#" 

+     THEN symb := subtext (symb, 2);

+          WHILE (symb SUB length(symb)) <> "#" REP

+            name CAT symb;

+            next entry; prot (symb);

+            IF symb = ""

+               THEN errorstop ("# fehlt beim Fontnamen");

+               FI;

+            PER;

+            name CAT subtext (symb, 1, length (symb)-1)

+     ELSE error stop ("1. Symbol kein Fontname")

+     FI;

+. 

+get fixed or prop:

+  next entry;

+  prop font := (symb SUB 1) = "p" OR (symb SUB 1) = "P";

+  prot (symb);

+. 

+get blank width:

+  next entry;

+  blank in cm := real (symb); 

+  IF NOT last conversion ok COR blank in cm < 0.01 

+     THEN errorstop ("Blankbreite falsch") 

+     FI;

+  prot ("Blank=");prot (symb);

+. 

+get linefeed height: 

+  next entry; 

+  lf in cm := real (symb);

+  IF NOT last conversion ok COR lf in cm < 0.01 

+     THEN errorstop ("Linefeedhoehe falsch") 

+     FI;

+  prot ("lf="); prot(symb);

+.

+get pointsizes:

+  next entry; 

+  IF symb <> "(" 

+     THEN protline ("alle Pointgroessen = 1 per Voreinstellung") ; 

+          LEAVE get pointsizes

+     FI; 

+  protline(" "); prot ("lf in punkten=");

+  get one lf size;

+  lf := int (inch * real (point (1))/ lf in cm + 0.5);

+. 

+get one lf size:

+  FOR i FROM 1 UPTO max nr points REP

+    next entry; 

+    IF symb = ")" 

+       THEN LEAVE get one lf size

+       ELIF symb = "" 

+            THEN errorstop ("Pointangaben unvollstaendig") 

+       FI; 

+    point(i) := int (symb); 

+    IF NOT last conversion ok COR point (i) < 1

+       THEN errorstop ("Pointgroesse falsch")

+       FI;

+    prot (symb); prot (",");

+    PER;

+. 

+get optional x steps per inch:

+  IF symb = ")"

+     THEN next entry FI;

+  IF symb = "" 

+     THEN width := 1.0

+     ELSE width := real (symb)

+     FI;

+  x step := int (inch * width / blank in cm + 0.5);

+  factor width := int (width + 0.5);

+  IF NOT last conversion ok COR x step < 1

+     THEN errorstop ("minimale Schritte falsch")

+     FI;

+  protline(" "); prot ("Schritte pro Inch="); prot (text(x step)); prot(","); prot (text(lf)); protline(" ");

+.

+fill pitch and code table with default:

+  IF prop font

+     THEN pitch  := 255 * code (factor width)

+     ELSE pitch  := code (factor width)

+     FI;

+  kode  := 31 * ""0"";

+  kode  CAT 224 * ""1""; (* print all *)

+  inch factor := real (x step)

+.

+get char width and output function:

+  WHILE NOT eof (font file) REP

+    getline (font file, record);

+    protline (record);

+    IF (record SUB 1) = "#" AND pos (record, "#", 2, length (record)) > 2

+       THEN LEAVE get char width and output function

+       FI;

+    get internal code for char;

+    IF char code > 0 AND char code <= 255

+       THEN IF prop font 

+               THEN get char width;

+                    prot (text(factor width));

+                    replace (pitch, char code, code (factor width))

+               FI;

+               get output function

+       FI;

+    PER;

+.

+get internal code for char:

+INT VAR char code;

+  next entry; prot (symb);

+  IF length(symb) = 1 

+     THEN char code := code (symb SUB 1)

+     ELIF symb >= "000" AND symb <= "255" 

+          THEN char code := int (symb); 

+               IF NOT last conversion ok 

+                  THEN errorstop ("Zeichen falsch") 

+                  FI 

+     ELSE errorstop ("Zeichen falsch") 

+     FI; 

+

+.

+get char width:

+  next entry; 

+  IF pos (symb, ".") > 0

+     THEN width := real (symb);

+          factor width := int (round(((width * inch factor) / inch), 0))

+     ELSE factor width := int (symb) 

+     FI;

+  IF NOT last conversion ok 

+     THEN errorstop ("Breitenangabe falsch") 

+     FI 

+.

+get output function:

+  next entry; prot (symb);  protline(" ");

+  IF symb = "" 

+     THEN symb := "1"

+     FI;

+  replace (kode, char code, code (int (symb)));

+  IF NOT last conversion ok 

+     THEN errorstop ("Ausgabefunktion falsch") 

+     FI;

+END PROC load font table;

+ 

+PROC next entry:

+INT VAR next blank pos;

+WHILE (record SUB 1) = " " REP

+  record := subtext (record, 2, length (record)) PER;

+next blank pos := pos (record, " ");

+IF next blank pos >= 1

+   THEN symb := subtext (record, 1, next blank pos - 1);

+        record := subtext (record, next blank pos + 1)

+   ELSE symb := record;

+        record := ""

+   FI;

+END PROC next entry;

+

+PROC prot (TEXT CONST t):

+  IF online

+     THEN put (t)

+     FI;

+END PROC prot;

+

+PROC protline (TEXT CONST t):

+  IF online

+     THEN putline (t)

+     FI;

+END PROC protline;

+

+init font; (* PACKET Initialisierung ******************************)

+.

+name:   font[font number].name 

+. 

+pitch:  font[font number].pitch table 

+. 

+kode:   font [font number].code table 

+.

+lf:     font [fontnumber].y steps per inch

+. 

+x step: font [font number].x steps per inch

+. 

+point:  font [font number].point size

+.

+END PACKET fonts routines;

diff --git a/system/std.zusatz/1.7.3/src/MINPRINT.ELA b/system/std.zusatz/1.7.3/src/MINPRINT.ELA
new file mode 100644
index 0000000..a0bd44a
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/MINPRINT.ELA
@@ -0,0 +1,94 @@
+PACKET minimal font routines DEFINES lf height of current font, 

+                                     x factor per inch, 

+                                     y factor per inch: 

+ 

+REAL CONST lf height of current font ::  2.54 / 6.0;

+INT CONST x factor per inch         :: 10,

+          y factor per inch         ::  6;

+ 

+END PACKET minimal font routines;

+

+PACKET minimal printer                 (* 25.04.84 *)

+    DEFINES  material,

+             start,

+             new page, 

+             reset printer,

+             line, 

+             print text , 

+             printer cmd,

+             on,

+             off,

+             x pos, 

+             y pos,

+             papersize,

+             limit,

+             change type:

+ 

+ 

+PROC change type (TEXT CONST name of type): ENDPROC change type; 

+

+PROC material (TEXT CONST value): END PROC material;

+ 

+PROC start (REAL CONST x,y): END PROC start;

+

+PROC papersize (REAL CONST x,y): END PROC papersize;

+

+PROC limit (REAL CONST l): END PROC limit;

+

+PROC on (TEXT CONST cmd): END PROC on;

+

+PROC off (TEXT CONST cmd): END PROC off;

+ 

+PROC xpos (REAL CONST cm): END PROC xpos; 

+ 

+PROC ypos (REAL CONST cm): END PROC ypos; 

+ 

+PROC printer cmd (TEXT CONST cmd):

+  out (buffer); buffer := "";

+  out(cmd)

+END PROC printer cmd;

+ 

+INT VAR actual line ;

+

+TEXT VAR buffer;

+

+PROC reset printer:

+  buffer := "";

+  actual line := 0 

+ENDPROC reset printer;

+ 

+PROC print text (TEXT CONST content, INT CONST mode): 

+  buffer CAT content

+ENDPROC print text; 

+ 

+PROC new page:

+  IF buffer <> ""

+  THEN line (1.0)

+  FI;

+  actual line := actual line MOD 72 ;

+  IF actual line > 0

+    THEN page feed

+  FI .

+

+page feed :

+  INT VAR i ;

+  FOR i FROM actual line UPTO 71 REP

+    out(" "13""10"")

+  PER ;

+  actual line := 0

+

+ENDPROC new page; 

+ 

+PROC line (REAL CONST lf): 

+  out (buffer); buffer := "";

+  IF lf > 0.0

+    THEN REAL VAR ist := 0.0 ;

+         REP

+           out (""13""10"") ;

+           actual line INCR 1 ;

+           ist INCR 1.0

+         UNTIL ist >= floor (lf) PER

+  FI 

+ENDPROC line; 

+ 

+ENDPACKET minimal printer;

diff --git a/system/std.zusatz/1.7.3/src/TO16.ELA b/system/std.zusatz/1.7.3/src/TO16.ELA
new file mode 100644
index 0000000..94cfc73
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/TO16.ELA
@@ -0,0 +1,102 @@
+PACKET to 16 DEFINES to 16 :

+

+

+LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT line) ,

+    OLDFILE   = BOUND ROW 4075 OLDRECORD ;

+

+LET free root = 1 ,

+    used root = 2 ;

+

+LET file type 16 = 1002 ;

+

+

+FILE VAR file 17 ;

+OLDFILE VAR file 16 ;

+DATASPACE VAR file space ;

+

+

+PROC to 16 :

+  to 16 (last param)

+ENDPROC to 16 ;

+

+PROC to 16 (TEXT CONST file name) :

+

+  last param (file name) ;

+  file 17 := sequential file (input, file name) ;

+  disable stop ;

+  file space := nilspace ;

+  file 16 := file space ;

+  type (file space, file type 16) ;

+  copy 17 to 16 ;

+  IF NOT is error

+    THEN replace 17 by 16 file

+  FI ;

+  forget (file space) .

+

+replace 17 by 16 file :

+  forget (file name, quiet) ;

+  copy (file space, file name) .

+

+ENDPROC to 16 ;

+

+PROC copy 17 to 16 :

+

+  enable stop ;

+  build used record chain ;

+  build free record chain .

+

+build used record chain :

+  copy all records ;

+  construct used chains head and circular links .

+

+copy all records :

+  INT VAR line ;

+  FOR line FROM 1 UPTO lines (file 17) REP

+    copy one record ;

+    cout (line)

+  PER .

+

+copy one record :

+  INT VAR index := line + 2 ;

+  TEXT VAR line 17;

+  record.pred := index - 1 ;

+  record.succ := index + 1 ;

+  getline (file 17, line 17) ;

+  change special 17 chars;

+  record.line := line 17.

+

+change special 17 chars: 

+  change all (line 17, ""217"", ""225"");

+  change all (line 17, ""218"", ""239"");

+  change all (line 17, ""219"", ""245"");

+  change all (line 17, ""214"", ""193"");

+  change all (line 17, ""215"", ""207"");

+  change all (line 17, ""216"", ""213"");

+  change all (line 17, ""220"", ""235"");

+  change all (line 17, ""221"", ""173"");

+  change all (line 17, ""222"", ""163"");

+  change all (line 17, ""223"", ""160"");

+  change all (line 17, ""251"", ""194"").

+

+construct used chains head and circular links :

+  record.succ := used root ;

+  used root record.pred := index ;

+  used root record.succ := used root + 1 ;

+  used root record.line := headline (file 17) .

+

+build free record chain :

+  free root record.pred := free root ;

+  free root record.succ := free root ;

+  free root record.y    := index + 1 ;

+  free root record.line := "    0    1    1" ;

+  free root record.line CAT text (maxlinelength (file 17), 5) .

+

+record : CONCR (file 16) (index) .

+

+used root record : CONCR (file 16) (used root) .

+

+free root record : CONCR (file 16) (free root) .

+

+ENDPROC copy 17 to 16 ;

+

+ENDPACKET to 16 ;

diff --git a/system/std.zusatz/1.7.3/src/complex b/system/std.zusatz/1.7.3/src/complex
new file mode 100644
index 0000000..d62085b
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/complex
@@ -0,0 +1,133 @@
+ 

+PACKET complex DEFINES COMPLEX,:=,complex zero,complex one,complex i, 

+                       complex,realpart,imagpart,CONJ,+,-,*,/,=,<>, 

+                       put,get, ABS, sqrt, phi, dphi :

+ 

+TYPE COMPLEX = STRUCT(REAL re,im); 

+COMPLEX PROC complex zero: COMPLEX :(0.0,0.0). END PROC complex zero; 

+COMPLEX PROC complex one : COMPLEX :(1.0,0.0). END PROC complex one; 

+COMPLEX PROC complex i   : COMPLEX :(0.0,1.0). END PROC complex i; 

+ 

+OP := (COMPLEX VAR dest, COMPLEX CONST source) :

+ 

+  CONCR (dest) := CONCR (source)

+ 

+ENDOP := ;

+ 

+COMPLEX PROC complex(REAL CONST re,im): 

+   COMPLEX :(re,im). 

+END PROC complex; 

+ 

+REAL PROC realpart(COMPLEX CONST number): 

+           number.re. 

+END PROC realpart; 

+ 

+REAL PROC imagpart(COMPLEX CONST number): 

+           number.im. 

+END PROC imagpart ;

+ 

+COMPLEX OP CONJ(COMPLEX CONST number): 

+   COMPLEX :( number.re,- number.im). 

+END OP CONJ; 

+ 

+BOOL OP =(COMPLEX CONST a,b): 

+   IF   a.re=b.re 

+   THEN a.im=b.im 

+   ELSE FALSE 

+   FI. 

+END OP =; 

+ 

+BOOL OP <>(COMPLEX CONST a,b): 

+   IF   a.re=b.re 

+   THEN a.im<>b.im 

+   ELSE TRUE 

+   FI. 

+END OP <>; 

+ 

+COMPLEX OP +(COMPLEX CONST a,b): 

+   COMPLEX :(a.re+b.re,a.im+b.im). 

+END OP +; 

+ 

+COMPLEX OP -(COMPLEX CONST a,b): 

+   COMPLEX :(a.re-b.re,a.im-b.im). 

+END OP -; 

+ 

+COMPLEX OP *(COMPLEX CONST a,b): 

+   REAL VAR re of a::a.re,im of a ::a.im, 

+            re of b::b.re,im of b ::b.im; 

+   COMPLEX :(re of a*re of b- im of a *im of b, 

+             re of a*im of b+ im of a*re of b). 

+END OP *; 

+ 

+COMPLEX OP /(COMPLEX CONST a,b): 

+   REAL VAR re of a::a.re,im of a::a.im, 

+            re of b::b.re,im of b::b.im; 

+   REAL VAR sqare sum of re and im ::b.re*b.re+b.im*b.im; 

+   COMPLEX :( (re of a * re of b + im of a * im of b)/sqare sum of re and im,

+              (im of a *re of b - re of a*im of b)/sqare sum of re and im). 

+END OP /; 

+ 

+PROC get(COMPLEX VAR a): 

+   REAL VAR realpart,imagpart; 

+   get(realpart);get(imagpart); 

+   a:= COMPLEX :(realpart,imagpart); 

+END PROC get; 

+ 

+PROC put(COMPLEX CONST a): 

+   put(a.re);put(" ");put(a.im); 

+END PROC put; 

+ 

+REAL PROC dphi(COMPLEX CONST x): 

+ IF   imagpart(x)=0.0 THEN reell

+ ELIF realpart(x)=0.0 THEN imag 

+ ELIF realpart(x)>0.0 THEN realpositiv 

+ ELSE realnegativ 

+ FI. 

+reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. 

+imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. 

+realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) 

+                               ELSE

+arctand(realpart(x)/imagpart(x))+360.0 FI. 

+realnegativ: arctand(realpart(x)/imagpart(x))+180.0. 

+END PROC dphi; 

+ 

+REAL PROC phi(COMPLEX CONST x): 

+dphi(x)*3.141592653689793/180.0. 

+END PROC phi; 

+ 

+REAL PROC dphi(COMPLEX CONST x): 

+ IF   imagpart(x)=0.0 THEN reell

+ ELIF realpart(x)=0.0 THEN imag 

+ ELIF realpart(x)>0.0 THEN realpositiv 

+ ELSE realnegativ 

+ FI. 

+reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. 

+imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. 

+realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) 

+                               ELSE

+arctand(realpart(x)/imagpart(x))+360.0 FI. 

+realnegativ: arctand(realpart(x)/imagpart(x))+180.0. 

+END PROC dphi; 

+ 

+ 

+REAL PROC phi(COMPLEX CONST x): 

+dphi(x)*3.141592653689793/180.0. 

+END PROC phi; 

+ 

+COMPLEX PROC sqrt(COMPLEX CONST x): 

+IF x=complex zero THEN x 

+ELIF realpart(x)<0.0 THEN 

+complex(imagpart(x)/(2.0*real(sign(imagpart(x)))

+        *sqrt((ABSx-realpart(x))/2.0)), 

+        real(sign(imagpart(x)))*sqrt((ABS x-realpart(x))/2.0)) 

+ELSE complex(sqrt((ABS x+realpart(x))/2.0), 

+     imagpart(x)/(2.0*sqrt((ABS x+realpart(x))/2.0)))

+FI. 

+ 

+END PROC sqrt; 

+ 

+REAL OP ABS(COMPLEX CONST x): 

+ sqrt(realpart(x)*realpart(x)+imagpart(x)*imagpart(x)). 

+END OP ABS; 

+ 

+END PACKET complex; 

diff --git a/system/std.zusatz/1.7.3/src/crypt b/system/std.zusatz/1.7.3/src/crypt
new file mode 100644
index 0000000..f6711fa
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/crypt
@@ -0,0 +1,139 @@
+PACKET cryptograf DEFINES                            (* Autor: J.Liedtke *)

+                                                     (* Stand: 01.10.80  *)

+  crypt ,

+  decrypt :

+ 

+TEXT VAR char , in buffer, out buffer ;

+INT VAR in pos , key index ;

+DATASPACE VAR scratch space := nilspace ;

+FILE VAR in, out;

+ 

+PROC crypt (TEXT CONST file, key) :

+ 

+  open (file) ;

+  initialize crypt (key) ;

+  WHILE NOT eof REP

+    read char ;

+    crypt char ;

+    write char

+  PER ;

+  close (file) .

+ 

+crypt char :

+  char := code (( character + random char + key char ) MOD 250) ;

+  IF key index = LENGTH key

+    THEN key index := 1

+    ELSE key index INCR 1

+  FI .

+ 

+character   : code (char) .

+ 

+random char : random (0,250).

+ 

+key char    : code (key SUB key index) .

+ 

+ENDPROC crypt ;

+ 

+PROC decrypt (TEXT CONST file, key) :

+ 

+  open (file) ;

+  initialize crypt (key) ;

+  WHILE NOT eof REP

+    read char ;

+    decrypt char ;

+    write char

+  PER ;

+  close (file) .

+ 

+decrypt char :

+  char := code (( character - random char - key char ) MOD 250) ;

+  IF key index = LENGTH key

+    THEN key index := 1

+    ELSE key index INCR 1

+  FI .

+ 

+character   : code (char) .

+ 

+random char : random (0,250) .

+ 

+key char    : code (key SUB key index) .

+ 

+ENDPROC decrypt ;

+ 

+PROC initialize crypt (TEXT CONST key) :

+ 

+  INT VAR random key := 0 ;

+  FOR key index FROM 1 UPTO LENGTH key REP

+    random key := (random key + code (key SUB key index)) MOD 32000

+  PER ;

+  initialize random (random key) ;

+  key index := 1

+ 

+ENDPROC initialize crypt ;

+ 

+PROC open (TEXT CONST source file) :

+ 

+  in := sequential file (input, source file) ;

+  getline (in, in buffer) ;

+  in pos := 1 ;

+  out := sequential file (output, scratch space) ;

+  out buffer := "" .

+ 

+ENDPROC open ;

+ 

+PROC close (TEXT CONST source file) :

+ 

+  IF out buffer <> ""

+    THEN putline (out, out buffer)

+  FI ;

+  forget (source file, quiet) ;

+  copy (scratch space, source file) ;

+  forget (scratch space) .

+ 

+ENDPROC close ;

+ 

+BOOL PROC eof :

+ 

+  IF in pos > LENGTH in buffer

+    THEN eof (in)

+    ELSE FALSE

+  FI

+ 

+ENDPROC eof ;

+ 

+PROC read char :

+ 

+  IF in pos > 250

+    THEN getline (in, in buffer) ;

+         in pos := 1 ;

+         read char

+  ELIF in pos > LENGTH in buffer

+    THEN in pos := 1 ;

+         getline (in, in buffer) ;

+         char := ""13""

+    ELSE char := in buffer SUB in pos ;

+         in pos INCR 1

+  FI .

+ 

+ENDPROC read char ;

+ 

+PROC write char :

+ 

+  IF char = ""13""

+    THEN putline (out, out buffer) ;

+         out buffer := ""

+    ELSE out buffer CAT char

+  FI ;

+  IF LENGTH out buffer = 250

+    THEN putline (out, out buffer) ;

+         out buffer := ""

+  FI .

+ 

+ENDPROC write char ;

+ 

+ENDPACKET cryptograf ;

+

+

+

+

+

diff --git a/system/std.zusatz/1.7.3/src/elan lister b/system/std.zusatz/1.7.3/src/elan lister
new file mode 100644
index 0000000..dc34176
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/elan lister
@@ -0,0 +1,263 @@
+PACKET elan lister DEFINES                            (* Autor: J.Liedtke *)

+                                                      (* Stand: 22.03.84  *)

+      is elan source ,

+      elan list :

+ 

+

+LET source lines per page  = 64 ,

+    x start                = 1 ,

+    y start                = 2 ,

+

+    tag                    = 1 ,

+    bold                   = 2 ,

+ 

+    linelength             = 120 ,

+    struct comment length  = 32 ,

+    max name length        = 25 ,

+    struct comment blanks  = "                                " ,

+    refinement layout line = "                                     |" ,

+    headline pre =

+       " Zeile    *****   E L A N    EUMEL 1.7  *****   " ;

+ 

+INT VAR  symbol type ,

+         line nr ,

+         page nr ,

+         line at page ;

+

+BOOL VAR within defines list ;

+

+TEXT VAR record,

+         list pre ,

+         source name ,

+         source prefix ,

+         symbol,

+         ahead symbol ,

+         bottom blanks := (linelength) * " " ;

+

+

+PROC elan list (FILE VAR source) :

+ 

+  initialize listing ;

+  within defines list := FALSE ;

+  WHILE NOT eof (source) REP

+    list one source line ;

+    line nr INCR 1

+  PER ;

+  page bottom ;

+  start (0.0,0.0) ;

+  new page .

+

+initialize listing :

+  reset printer ;

+  construct source name and prefix ;

+  print first page head ;

+  line nr := 1 .

+

+construct source name and prefix :

+  source name := headline (source) ;

+  INT CONST slash pos := pos (source name, "/") ;

+  IF slash pos = 0

+    THEN source prefix := ""

+    ELSE source prefix := subtext (source name, slash pos+1) + "/" ;

+         source name   := subtext (source name, 1, slash pos-1) 

+  FI .

+

+list one source line :

+  getline (source, record) ;

+  print list pre ;

+  printline (record) ;

+  page if necessary .

+

+print list pre :

+  list pre := text (line nr, 5) ;

+  IF pos (record, "P") = 0 AND pos (record, ":") = 0

+    THEN empty layout

+    ELSE analyze source line

+  FI ;

+  list pre CAT ("|") ;

+  print text (list pre, 0) .

+

+empty layout :

+  list pre CAT struct comment blanks .

+ 

+analyze source line :

+  scan (record) ;

+  next symbol (symbol, symbol type) ;

+  next symbol (ahead symbol) ;

+  IF   begin of packet     THEN packet layout 

+  ELIF within defines list THEN check end of defines part

+  ELIF begin of proc op    THEN proc op layout

+  ELIF begin of refinement THEN refinement layout

+  ELSE                          empty layout

+  FI .

+ 

+begin of packet :

+  symbol = "PACKET" .

+ 

+begin of proc op :

+  IF   is proc or op (symbol)

+    THEN TRUE

+  ELIF (symbol <> "END") AND  is proc or op (ahead symbol)

+    THEN symbol := ahead symbol ;

+         next symbol (ahead symbol) ; TRUE

+    ELSE FALSE

+  FI .

+ 

+begin of refinement :

+  symbol type = tag AND ahead symbol = ":" AND NOT within defines list .

+ 

+packet layout :

+  IF not at page head

+    THEN page bottom ;

+         page head

+  FI ;

+  layout ("   ", ahead symbol, "*") ;

+  within defines list := TRUE .

+

+check end of defines part :

+  empty layout ;

+  scan (record) ;

+  REP

+    nextsymbol (symbol) ;

+    IF symbol = ":"

+      THEN within defines list := FALSE

+    FI

+  UNTIL symbol = "" PER .

+

+proc op layout :

+(*printline ("") ;*)

+  printline ("") ;

+  printline ("") ;

+  IF not two free lines 

+    THEN page bottom ;

+         page head

+  FI ; 

+  layout ("   ", ahead symbol, ".") .

+ 

+refinement layout :

+(*print line (refinement layout line) ;*)

+  print line (refinement layout line) ;

+  IF not two free lines THEN page bottom; page head FI; 

+  layout ("      ", symbol, " ") .

+ 

+

+print first page head :

+  page nr := 1 ;

+  page head .

+

+page if necessary :

+  IF line at page > source lines per page

+    THEN page bottom ;

+         page head

+  FI .

+

+not two free lines :

+  line at page >= source lines per page - 2 .

+

+not at page head :

+  line at page > 5 .

+

+ENDPROC elan list ;

+ 

+BOOL PROC is proc or op (TEXT CONST symbol) :

+

+  symbol = "PROC" OR symbol = "PROCEDURE"

+  OR symbol = "OP" OR symbol = "OPERATOR" 

+

+ENDPROC is proc or op ;

+ 

+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :

+

+  list pre CAT pre ;

+  name := subtext (name, 1, max name length) ;

+  list pre CAT name ;

+  list pre CAT " " ;

+  generate remaining struct comment .

+ 

+generate remaining struct comment :

+  INT VAR i ;

+  FOR i FROM 1 UPTO remaining struct comment length REP

+    list pre CAT post

+  PER .

+

+remaining struct comment length :

+  struct comment length - LENGTH pre - min(LENGTH name,max name length) - 1.

+ 

+ENDPROC layout ;

+

+PROC print line (TEXT CONST line text) :

+

+  print text (line text, 0) ;

+  line (1.0) ;

+  line at page INCR 1

+

+ENDPROC print line ;

+

+PROC printtext (TEXT CONST t, BOOL CONST b) :

+  out (t)

+ENDPROC printtext ;       (*** sonst im Hardwaretreiber *********)

+

+PROC page head :

+

+  new page ;

+  print text (headline pre, 0) ;

+  print text (date, 0);           (* R. Nolting 27.10.83 *)

+  print text ("   *****     ",0);

+  print text (source name, 0) ;

+  line (4.0) ;

+  line at page := 1 

+

+ENDPROC page head ;

+

+PROC page bottom :

+

+  WHILE line at page < source lines per page REP

+    line (1.0) ;

+    line at page INCR 1

+  PER ;

+  line (1.0) ;

+  printtext (text (source prefix + text (page nr), 8), FALSE) ;

+  printtext (bottom blanks, FALSE) ;

+  printtext (source prefix + text (page nr), FALSE) ;

+  line (1.0) ;

+  page nr INCR 1 .

+

+ENDPROC page bottom ;

+

+BOOL PROC is elan source (FILE VAR source) :

+

+  input (source) ;

+  get first symbol ;

+  symbol type = tag COR is bold begin of program COR is comment .

+

+is bold begin of program :

+  symbol type = bold CAND is elan bold .

+

+is elan bold :

+  symbol = "PACKET" COR is proc or op (symbol) COR is data declaration .

+

+is data declaration :

+  next symbol (symbol) ;

+  symbol = "VAR" OR symbol = "CONST" .

+

+is comment :

+  pos (record, "(*") > 0 OR pos (record, "{") > 0 .

+

+

+get first symbol :

+  get first non blank record ;

+  scan (record) ;

+  next symbol (symbol, symbol type) ;

+  reset (source) .

+

+get first non blank record :

+  REP

+    getline (source, record)

+  UNTIL record contains non blank OR eof (source) PER .

+

+record contains non blank :

+  pos (record, ""33"",""254"", 1) > 0 .

+

+ENDPROC is elan source ;

+

+ENDPACKET elan lister ;

diff --git a/system/std.zusatz/1.7.3/src/eumel printer b/system/std.zusatz/1.7.3/src/eumel printer
new file mode 100644
index 0000000..79a4b2c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/eumel printer
@@ -0,0 +1,369 @@
+PACKET eumel printer DEFINES 

+(***************************************************************************

+*****  EUMEL - DRUCKER                      ** Author: A. Reichpietch     **

+*****                                       **         R. Nolting         **

+*****                                       ** Date:   30.09.81 Vers. 0   **

+*****                                       **         15.03.82 Vers. 1.0 **

+*****                                       **         22.07.82 Vers. 1.1 **

+*****                                       **         01.10.82 Vers. 1.2 **

+***** reelle Werte fuer limit etc.          **         15.01.83 Vers. 2.0 **

+***** direkte Druckerkommandos (Hardware)   **         15.08.83 Vers. 2.1 **

+*****                                       **         15.12.83 Vers. 2.2 **

+***** alle Zeilen-/Spaltenprocs entfernt    **         9.1.84   Vers. 2.3 **

+***** neue 'print text' prozedur            **         04.03.84 Vers. 2.4 **

+***************************************************************************)

+ 

+              print, 

+              reset print,

+              print line, 

+              pages printed,

+

+              is elan source , (* dummy Prozeduren , koennen von  *)

+              elan list :      (* 'elan lister' ueberdeckt werden *)

+ 

+

+LET blank = " " ,

+    backspace = ""8"" ,

+    begin mark underline = ""15"" ,

+    end mark underline = ""14"" ;

+LET paragraph end = " ";

+TEXT VAR inline := blank, 

+         outline := blank, 

+         type := blank, 

+         command char,

+         help := blank; 

+TEXT VAR command, 

+         par 1, par 2,

+         skip end text;

+REAL VAR  y position, y step, y max, y factor;

+INT VAR pagenr, from, to; 

+INT VAR printed pages;

+BOOL VAR not skipped, lines to be skipped,

+         first text line, end of paragraph,

+         linefeed needed;

+LET std pagelength = 25.4;

+

+INT VAR print mode set := left adj, collumn print possible;

+LET left adj=       0;

+LET right adj=      1;

+LET centre adj=     2;

+LET block line=     3;

+LET left col=       4;

+LET right col=      5;

+LET centre col=     6;

+LET block col=      7;

+LET collumn print = 4;

+ 

+

+PROC print (FILE VAR f):

+  enable stop;

+  reset printer; 

+  reset print;

+  print (f, from, to);

+END PROC print;

+ 

+PROC print (FILE VAR f, INT CONST first page, last page): 

+  enable stop;

+  from := first page; 

+  to := last page; 

+  IF from > 1 THEN not skipped := FALSE FI; 

+  WHILE (NOT eof(f)) AND (pagenr <= to)  REP 

+     getline (f, inline);

+     print input line;

+     ENDREP;

+  start(0.0, 0.0); make page;

+ENDPROC print; 

+

+PROC reset print:

+     first text line := TRUE;

+     not skipped := TRUE; 

+     lines to be skipped := FALSE;

+     command char := "#"; 

+     print mode set := left adj;

+     end of paragraph := TRUE;

+     inline := ""; 

+     y max := stdpagelength ;

+     y position := 10000.0;

+     y step := lf height of current font;

+     y factor := 1.0; 

+     pagenr := 0; 

+     from := 1; to := maxint;

+     printed pages := -1; (* move to top of first page will set to 0 *)

+ENDPROC reset print;

+ 

+INT PROC pages printed: 

+  printed pages 

+END PROC pages printed; 

+ 

+PROC print line (TEXT CONST in): 

+  inline := in;

+  print input line;

+END PROC print line;

+ 

+PROC print input line:

+(* debug   out ("print line:"); out (in); out (""10""13"");    debug *)

+INT VAR compos;

+INT VAR endpos := 0, tpos := 1;

+IF lines to be skipped

+     THEN IF pos (inline, skip end text) > 1 AND (inline SUB 1) = command char

+             THEN lines to be skipped := FALSE

+             FI;

+             LEAVE print input line

+     FI;

+  linefeed needed := FALSE;

+IF end of paragraph

+   THEN collumn print possible := collumn print

+   ELSE collumn print possible := 0

+   FI;

+compos := LENGTH inline;

+IF (inline SUB compos) = paragraph end

+   THEN end of paragraph := TRUE;

+        inline := subtext (inline, 1, compos -1)

+   ELSE end of paragraph := FALSE;

+   FI;

+  compos := pos (inline, command char);

+  IF compos <= 0

+     THEN print the line (inline);

+          new line;

+          LEAVE print input line

+     FI;

+  outline := "";

+  extract commands from input;

+  IF outline <> ""

+     THEN print the line (outline); new line 

+  ELIF linefeed needed 

+     THEN new line FI;

+.

+extract commands from input:

+WHILE compos > 0 REP

+  outline CAT subtext (inline, tpos, compos-1);

+  endpos := pos ( inline, command char, compos +1);

+  IF endpos <= compos

+     THEN endpos := compos - 1;

+          compos := 0

+     ELSE command := subtext ( inline, compos +1, endpos -1); 

+          analyze command ( command); 

+          tpos := endpos +1;

+          compos := pos(inline, command char, tpos);

+     FI;

+  PER;

+outline CAT subtext (inline, endpos + 1);

+

+ENDPROC print input line; 

+

+ 

+TEXT VAR comlist:="ub:1.0ue:2.0type:4.1linefeed:5.1limit:6.1free:7.1page:8.01

+pagenr:9.2pagelength:10.1start:11.2foot:12.0end:13.0head:15.0headeven:16.0

+headodd:17.0bottom:19.0bottomeven:20.0bottomodd:21.0"

+LET com list 2 =

+"on:22.1off:23.1block:24.0left:25.0right:26.0centre:27.0center:28.0material:31.1papersize:32.2print:33.2"; 

+comlist CAT comlist 2;

+ 

+PROC analyze command (TEXT CONST command): 

+(* debug   out ("analyze command:"); out (command); out (""10""13"");    debug *)

+IF pos (command, "-") = 1

+     THEN LEAVE analyze command

+     ELIF pos (command, "/") = 1 

+          THEN help := subtext (command, 2);

+               print line so far;

+               printer cmd (help);

+               LEAVE analyze command

+     FI;

+INT VAR comindex := -1, number := 0; 

+   par 1 := ""; par 2 := ""; 

+   disable stop;

+   analyze command ( com list, command, 3, comindex, number, par 1, par 2); 

+   IF is error

+      THEN clear error 

+      ELSE select command 

+      FI; 

+   enable stop;

+.

+select command : 

+ SELECT comindex OF 

+        CASE 1  :       print line so far; on ("u");

+        CASE 2  :       print line so far; off ("u");

+        CASE 4  :       print line so far; set type (par 1)

+        CASE 5  :       set linefeed ( par 1) 

+        CASE 6  :       set limit (par 1) 

+        CASE 7  :       print line so far; free (par 1)

+        CASE 8  :       print line so far; make page

+        CASE 9  :

+        CASE 10 :       set pagelength  (par 1)

+        CASE 11 :       set start (par 1, par 2)

+        CASE 12 :       (* skip text ("end") *)

+        CASE 15,16,17 : (* skip text ("end") *)

+        CASE 19,20,21 : (* skip text ("end") *)

+        CASE 22 :       print line so far; on (par1) 

+        CASE 23 :       print line so far; off (par1) 

+        CASE 24 :       print line so far; print mode set := block line;

+        CASE 25 :       print line so far; print mode set := left adj;

+        CASE 26 :       print line so far; print mode set := right adj

+        CASE 27 :       print line so far; print mode set := centre adj

+        CASE 28 :       comindex := print mode set MOD 4;

+                        IF comindex = block line

+                           THEN inline CAT "#block#"

+                        ELIF comindex = left adj

+                           THEN inline CAT "#left#"

+                        ELIF comindex = right adj

+                           THEN inline CAT "#right#"

+                        FI;

+                        print mode set := centre adj;

+(* the following commands must appear before any text *)

+        CASE 31 :       IF first text line THEN material (par1) FI

+        CASE 32 :       IF first text line THEN do papersize (par1, par2) FI

+        CASE 33 :       IF first text line THEN print from page till page (par1, par2) FI

+        OTHERWISE 

+       END SELECT ; 

+.

+print line so far:

+  IF outline <> ""

+     THEN print the line (outline);

+          outline := "";

+          linefeed needed := TRUE

+     FI;

+ 

+ENDPROC analyze command; 

+ 

+PROC do papersize (TEXT CONST s, t):

+REAL VAR w, l;

+     IF ok (par1, w) AND ok (par2, l) 

+          THEN papersize (w, l)

+     FI;

+END PROC do papersize;

+ 

+PROC print from page till page(TEXT VAR s, t):

+INT VAR i, j;

+  IF ok (par1, i) AND ok (par2, j)

+     THEN from := i;

+          to := j;

+     FI;

+END PROC print from page till page; 

+ 

+PROC set type (TEXT CONST new type): 

+  change type (new type);

+  y step := lf height of current font;

+ENDPROC set type; 

+ 

+PROC make page : 

+  IF y position > 0.0 CAND NOT first text line

+     THEN y position := y max + 1.0; new line

+     FI; 

+  end of paragraph := TRUE;

+  inline := "";  (* this stops further processing of the input line *)

+ENDPROC make page; 

+ 

+PROC skip text (TEXT CONST endword):

+  lines to be skipped := TRUE;

+  skip end text := endword;

+  inline := ""; (* possible rest of the line is not examined *)

+END PROC skip text;

+ 

+PROC set linefeed ( TEXT CONST lf): 

+REAL VAR l:= real (lf); 

+   IF last conversion ok THEN y factor := l FI;

+ENDPROC set linefeed; 

+ 

+PROC set limit ( TEXT CONST l): 

+  REAL VAR len;

+  IF ok (l, len) 

+     THEN limit (len) 

+     FI;

+ENDPROC set limit; 

+ 

+BOOL PROC ok ( TEXT CONST param, INT VAR number): 

+    number := int (param) ; 

+    last conversion ok 

+ENDPROC ok; 

+ 

+BOOL PROC ok ( TEXT CONST param, REAL VAR number): 

+    number := real (param) ; 

+    last conversion ok 

+ENDPROC ok; 

+ 

+PROC set pagelength (TEXT CONST y): 

+REAL VAR iy ; 

+  IF ok (y, iy )

+     THEN y max := iy;

+FI; 

+ENDPROC set pagelength; 

+ 

+PROC set start (TEXT CONST x, y): 

+REAL VAR rx, ry;

+  IF ok (x, rx) AND ok (y, ry) 

+     THEN start (rx, ry)

+     FI; 

+ENDPROC set start; 

+ 

+PROC free (TEXT CONST p): 

+REAL VAR x, y := y factor;

+  IF ok (p, x)

+     THEN advance 

+     FI; 

+y factor := y;

+end of paragraph := TRUE;

+  inline := "";  (* this stops further processing of the input line *)

+. 

+advance:

+  y factor := x / y step;

+  IF outline <> ""

+     THEN print the line (outline);

+          outline := ""

+     FI;

+  IF first text line

+     THEN new line FI;

+new line;

+END PROC free; 

+ 

+PROC print the line ( TEXT CONST in): 

+(* debug   out ("print the line:"); out (in); out (print mode set);

+out (""10""13"");  debug *)

+IF first text line

+     THEN first text line := FALSE; new line FI;

+IF not skipped

+   THEN IF print mode set = blockline

+           THEN IF end of paragraph

+                   THEN print text (in, left adj + collumn print possible)

+                   ELSE print text (in, blockline + collumn print possible)

+                   FI

+           ELSE print text (in, print mode set + collumn print possible)

+           FI

+   FI;

+ENDPROC print the line; 

+ 

+PROC new line: 

+(* debug   out ("new line: lf=");  out (text(yfactor)); out (""10""13"");    debug *)

+IF page is full 

+     THEN pagenr INCR 1; 

+          IF not skipped 

+             THEN printed pages INCR 1;

+                  new page

+                  FI;

+             check printmodes; 

+             y position := 0.0

+     ELSE IF not skipped

+             THEN line (y factor) 

+             FI;

+          y position INCR yfactor * y step 

+     FI; 

+ENDPROC new line; 

+ 

+PROC check printmodes: 

+   not skipped := ( pagenr >=  from) AND ( pagenr <= to);

+ENDPROC check printmodes; 

+ 

+BOOL PROC page is full: 

+     y position + yfactor * y step > y max

+ENDPROC page is full; 

+ 

+(********** dummys ************)

+

+BOOL PROC is elan source (FILE VAR source) :

+  FALSE

+ENDPROC is elan source ;

+ 

+PROC elan list (FILE VAR source) :

+  print (source)

+ENDPROC elan list ;

+

+ENDPACKET eumel printer;

diff --git a/system/std.zusatz/1.7.3/src/eumelmeter b/system/std.zusatz/1.7.3/src/eumelmeter
new file mode 100644
index 0000000..24f5833
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/eumelmeter
@@ -0,0 +1,130 @@
+                                              (* Author: J.Liedtke*)

+PACKET eumelmeter DEFINES                     (* Stand:  11.10.83 *)

+ 

+     init log ,

+     log :

+ 

+ 

+LET snapshot interval = 590.0 ;

+

+REAL VAR next snapshot time ,

+         time        , timex ,

+         paging wait , paging wait x ,

+         paging busy , paging busy x ,

+         fore cpu    , fore cpu x ,

+         back cpu    , back cpu x ,

+         system cpu  , system cpu x ,

+         delta t ;

+INT VAR storage max, used ;

+TEXT VAR record ;

+

+PROC init log :

+

+  time        := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  next snapshot time := time + snapshot interval

+

+ENDPROC init log ;

+

+PROC log (INT CONST active terminals, active background) :

+

+  new snapshot time if was clock reset ;

+  IF clock (1) >= next snapshot time

+    THEN save values ;

+         get new values ;

+         create stat record ;

+         put log (record) ;

+         define next snapshot time

+  FI .

+

+new snapshot time if was clock reset :

+  IF clock (1) < next snapshot time - snapshot interval 

+    THEN next snapshot time := clock (1)

+  FI .

+

+save values :

+  time x := time ;

+  paging wait x := paging wait ;

+  paging busy x := paging busy ;

+  fore cpu x    := fore cpu ;

+  back cpu x    := back cpu ;

+  system cpu x  := system cpu .

+

+get new values :

+  time := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  storage (storage max, used) .

+

+create stat record :

+  record :=  text (used, 5) ;

+  record CAT text (active terminals,3) ;

+  record CAT text (active background,3) ;

+  delta t := (time - time x) ;

+  percent (paging wait, paging wait x) ;

+  percent (paging busy, paging busy x) ;

+  percent (fore cpu, fore cpu x) ;

+  percent (back cpu, back cpu x) ;

+  percent (system cpu, system cpu x) ;

+  percent (last, 0.0) ;

+  percent (nutz, 0.0) .

+

+last :   paging wait  + paging busy  + fore cpu  + back cpu  + system cpu

+       - paging waitx - paging busyx - fore cpux - back cpux - system cpux .

+

+nutz :   time  - paging wait  - system cpu

+       - timex + paging waitx + system cpux .

+

+define next snapshot time :

+  next snapshot time := time + snapshot interval .

+ 

+ENDPROC log ;

+

+PROC percent (REAL CONST neu, alt ) :

+

+  record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%"

+

+ENDPROC percent ;

+

+ENDPACKET eumelmeter ;

+ 

+INT VAR active terminals , active background ;

+

+task password ("-") ;

+break ;

+command dialogue (FALSE) ;

+forget ("eumelmeter") ;

+init log ;

+REP

+  pause (6000) ;

+  count active processes (active terminals, active background) ;

+  log (active terminals, active background)

+PER ;

+

+PROC count active processes (INT VAR active terminals, active background) :

+ 

+  active terminals := 0 ;

+  active background := 0 ;

+  TASK VAR process := myself ;

+  REP

+    next active (process) ;

+    IF user process 

+      THEN IF process at terminal

+             THEN active terminals INCR 1

+             ELSE active background INCR 1

+           FI

+    FI

+  UNTIL process = myself PER .

+

+user process :         NOT (process < supervisor) .

+

+process at terminal :  channel (process) >= 0 .

+

+ENDPROC count active processes ;

diff --git a/system/std.zusatz/1.7.3/src/free channel b/system/std.zusatz/1.7.3/src/free channel
new file mode 100644
index 0000000..89f7ce0
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/free channel
@@ -0,0 +1,292 @@
+PACKET free channel DEFINES                       (* Autor: J.Liedtke *)

+                                                  (* Stand: 05.10.82  *)

+  FCHANNEL ,

+  := ,

+  free channel ,

+  open ,

+  close ,

+  out ,

+  in ,

+  dialogue :

+ 

+ 

+

+LET ack                = 0 ,

+    nak                = 1 ,

+    break code         = 6 ,

+    empty message code = 256 ,

+    long message code  = 257 ,

+    file message code  = 1024 ,

+    open code          = 1000 ,

+    close code         = 1001 ,

+

+    cr                 = ""13"" ;

+

+INT CONST task not existing := - 1 ;

+

+

+TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ;

+

+INT VAR message code , response code ;

+TASK VAR partner , used by ;

+DATASPACE VAR ds ;

+

+BOUND TEXT VAR msg ;

+TEXT VAR response, char, esc char , record ;

+

+FILE VAR file ;

+

+

+OP := (FCHANNEL VAR dest, FCHANNEL CONST source) :

+ 

+  dest.server := source.server ;

+  dest.input buffer := "" ;

+  dest.server name := source.server name ;

+  open (dest)

+

+ENDOP := ;

+

+FCHANNEL PROC free channel (TEXT CONST channel name) :

+

+  FCHANNEL:(niltask,"", channel name)

+

+ENDPROC free channel ;

+

+PROC open (FCHANNEL VAR channel) :

+

+  TASK VAR task id ;

+  INT VAR receipt ;

+ 

+  initialize message dataspace ;

+  send open code ;

+  IF receipt <> ack

+    THEN errorstop ("channel not free")

+  FI .

+

+initialize message dataspace :

+  forget (ds) ;

+  ds := nilspace .

+

+send open code :

+  ping pong (channel.server, open code, ds, receipt) ;

+  IF receipt = task not existing

+    THEN channel.server := task (channel.server name) ;

+         ping pong (channel.server, open code, ds, receipt)

+  FI .

+ 

+ENDPROC open ;

+

+PROC close (FCHANNEL VAR channel) :

+

+  call (channel.server, close code, ds, response code)

+

+ENDPROC close ;

+

+PROC close (TEXT CONST channel server) :

+

+  call (task (channel server), close code, ds, response code)

+

+ENDPROC close ;

+

+

+PROC out (FCHANNEL VAR channel, TEXT CONST message) :

+

+  send message ;

+  get response .

+

+send message :

+  IF message = ""

+    THEN call (channel.server, empty message code, ds, response code)

+    ELSE msg := ds ;

+         CONCR (msg) := message ;

+         call (channel.server, long message code, ds, response code)

+  FI .

+

+get response :

+  IF response code < 0

+    THEN errorstop ("channel not ready")

+  ELIF response code < 256

+    THEN channel.input buffer CAT code (response code)

+  ELIF response code = long message code

+    THEN msg := ds ;

+         channel.input buffer CAT CONCR (msg)

+  FI .

+

+ENDPROC out ;

+

+PROC in (FCHANNEL VAR channel, TEXT VAR response) :

+

+  out (channel, "") ;

+  response := channel.input buffer ;

+  channel.input buffer := ""

+

+ENDPROC in ;

+

+PROC out (FCHANNEL VAR channel, DATASPACE CONST file space) :

+

+  out (channel, file space, ""0"")

+

+ENDPROC out ;

+

+PROC out (FCHANNEL VAR channel, DATASPACE CONST file space,

+          TEXT CONST handshake char) :

+

+  forget (ds) ;

+  ds := file space ;

+  call (channel.server, file message code + code (handshake char) ,

+                        ds, response code) ;

+  forget (ds) ;

+  ds := nilspace

+

+ENDPROC out ;

+

+

+PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) :

+

+  forget (ds) ;

+  ds := nilspace ;

+  partner := channel.server ;

+  esc char := esc ;

+  enable stop ;

+

+  response code := empty message code ;

+  REP

+    get and send message charety ;

+    out response option

+  PER .

+

+get and send message charety :

+  IF response code = empty message code

+    THEN char := incharety (10)

+    ELSE char := incharety

+  FI ;

+  IF char = ""

+    THEN call (partner, empty message code, ds, response code)

+  ELIF char = esc char

+    THEN LEAVE dialogue

+  ELSE   call (partner, code (char), ds, response code)

+  FI .

+

+out response option :

+  IF response code < 256

+    THEN out (code (response code))

+  ELIF response code = long message code

+    THEN msg := ds ;

+         out (CONCR (msg))

+  FI .

+

+ENDPROC dialogue ;

+

+PROC free channel (INT CONST nr) :

+

+  INT CONST my channel := nr ;

+  break ;

+  disable stop ;

+  REP

+    wait (ds, message code, partner) ;

+    IF message code = open code

+      THEN connect to my channel ;

+           use channel ;

+           break without advertise ;

+           send handshake ack 

+      ELSE send (partner, nak, ds)

+    FI

+  PER .

+

+use channel :

+  ping pong (partner, ack, ds, message code) ;

+  REP

+    execute message ;

+    response option

+  PER .

+

+execute message :

+  IF   message code < 0

+    THEN LEAVE use channel

+  ELIF message code < 256

+    THEN out (code (message code))

+  ELIF message code = long message code

+    THEN msg := ds ;

+         out (CONCR (msg))

+  ELIF message code >= file message code

+    THEN send file ;

+         clear error

+  ELIF message code = close code

+    THEN LEAVE use channel

+  FI .

+

+response option :

+  response := incharety (1) ;

+  IF response = ""

+    THEN ping pong (partner, empty message code, ds, message code)

+    ELSE short or long response

+  FI .

+

+short or long response :

+  char := incharety ;

+  IF char = ""

+    THEN short response

+    ELSE long response

+  FI .

+

+short response :

+  ping pong (partner, code (response), ds, message code) .

+

+long response :

+  msg := ds ;

+  response CAT char ;

+  REP

+    char := incharety ;

+    response CAT char

+  UNTIL char = "" PER ;

+  CONCR (msg) := response ;

+  ping pong (partner, long message code, ds, message code) .

+

+connect to my channel :

+  continue (my channel) ;

+  WHILE is error REP

+    clear error ;

+    pause (100) ;

+    continue (my channel)

+  PER .

+

+break without advertise :

+  INT VAR receipt ;

+  call (supervisor, break code, ds, receipt) .

+

+send handshake ack :

+  send (partner, ack, ds) .

+

+ENDPROC free channel ;

+

+PROC send file :

+

+  enable stop ;

+  get handshake ;

+  file := sequential file (input,ds) ;

+  REP

+    getline (file, record) ;

+    out (record) ;

+    out (cr) ;

+    handshake option

+  UNTIL eof (file) PER .

+

+get handshake :

+  TEXT CONST handshake char := code (message code - file message code) .

+

+handshake option :

+  IF handshake char <> ""0""

+    THEN wait for handshake or time out

+  FI .

+

+wait for handshake or time out :

+  REP

+    char := incharety (300)

+  UNTIL char = handshake char OR char = "" PER ;

+  IF char = ""

+    THEN LEAVE send file

+  FI .

+

+ENDPROC send file ;

+

+ENDPACKET free channel ;

diff --git a/system/std.zusatz/1.7.3/src/longint b/system/std.zusatz/1.7.3/src/longint
new file mode 100644
index 0000000..ac3dad5
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/longint
@@ -0,0 +1,422 @@
+PACKET longint    DEFINES LONGINT,        (* Autoren: S.Baumann,A.Bentrup *)

+                          :=,             (*          T.Sillke *)

+                          <,              (* Stand:   17.03.81 *)

+                          >, 

+                          <=,

+                          >=,

+                          <>,

+                          =,

+                          -,

+                          +,

+                          *,

+                          **,

+                          ABS,

+                          abs,

+                          DECR,

+                          DIV,

+                          get,

+                          INCR,

+                          int,

+                        (*last rest,*)

+                          longint,

+                          max,

+                          max longint,

+                          min,

+                          MOD,

+                          put,

+                          random,

+                          SIGN,

+                          sign,

+                          text,

+                          zero:

+ 

+TYPE LONGINT = TEXT;

+ 

+LONGINT VAR   result,aleft,aright;

+TEXT    VAR   ergebnis,x,y,z,h;

+INT     VAR   v byte,slr,sll;

+INT     CONST snull    :: code("0"), mtl :: 300 ;

+TEXT    CONST negativ  :: code(127),max digit :: code(99),null :: code(0),

+              overflow :: "LONGINT overflow",eins :: code(1); 

+BOOL    VAR   vorl,vorr,vleft,vright;

+

+OP := (LONGINT VAR left, LONGINT CONST right) :

+   CONCR(left) := CONCR(right)

+END OP :=;

+ 

+BOOL OP <  (LONGINT CONST left,right) :

+   slr := sign(right)*length(right);

+   sll := sign(left )*length(left );

+   IF slr <> sll THEN

+      IF slr > sll THEN TRUE ELSE FALSE FI

+   ELSE IF slr>0

+        THEN CONCR(left) < CONCR(right)

+        ELSE CONCR(left) > CONCR(right) FI

+   FI

+END  OP < ;

+ 

+BOOL OP >  (LONGINT CONST left,right) :

+   slr := sign(right)*length(right);

+   sll := sign(left )*length(left );

+   IF slr <> sll THEN

+      IF slr < sll THEN TRUE ELSE FALSE FI

+   ELSE IF slr>0

+        THEN CONCR(left) > CONCR(right)

+        ELSE CONCR(left) < CONCR(right) FI

+   FI

+END  OP > ;

+ 

+BOOL OP <= (LONGINT CONST left,right) :

+   NOT (left > right)

+END  OP <=;

+ 

+BOOL OP >= (LONGINT CONST left,right) :

+   NOT (left < right)

+END  OP >=;

+ 

+BOOL OP <> (LONGINT CONST left,right) :

+   CONCR (left) <> CONCR (right)

+END OP  <>;

+ 

+BOOL OP =  (LONGINT CONST left,right) :

+   CONCR (left) =  CONCR (right)

+END  OP = ;

+ 

+LONGINT OP - (LONGINT CONST arg) : 

+   SELECT  code(CONCR(arg)SUB1)  OF

+     CASE 0  : zero

+     CASE 127: LONGINT : (subtext(CONCR(arg),2))

+     OTHERWISE LONGINT : (negativ + CONCR(arg))

+   END SELECT

+END OP -;

+ 

+LONGINT OP + (LONGINT CONST arg) :   arg  END OP +;

+ 

+LONGINT OP - (LONGINT CONST left,right) :

+   IF   CONCR(left ) = null       THEN LEAVE - WITH -right

+   ELIF CONCR(right) = null       THEN LEAVE - WITH   left

+   ELIF sign(left) <> sign(right) THEN LEAVE - WITH left + (-right) FI;

+   betrag(left,right);

+   BOOL CONST betrag max :: aleft > aright;

+   IF   betrag max

+        THEN result := LONGINT : (CONCR(aleft ) SUB CONCR(aright))

+        ELSE result := LONGINT : (CONCR(aright) SUB CONCR(aleft )) FI;

+        kuerze fuehrende nullen(CONCR(result),null);

+   IF   vleft  XOR  betrag max  THEN -result ELSE result FI

+END OP -;

+ 

+LONGINT OP + (LONGINT CONST left,right) :

+   IF   sign(left) <> sign(right) THEN LEAVE + WITH left - (-right) FI;

+   betrag(left,right);

+   IF aleft > aright

+      THEN result := LONGINT : (CONCR(aleft ) ADD CONCR(aright))

+      ELSE result := LONGINT : (CONCR(aright) ADD CONCR(aleft )) FI;

+   IF vleft THEN result ELSE -result FI

+END OP +;

+ 

+LONGINT OP * (LONGINT CONST left,right) :

+   IF   CONCR(left) = null OR CONCR(right) = null THEN LEAVE * WITH zero

+   ELIF length(left) + length(right) > mtl THEN errorstop (overflow) FI;

+   betrag(left,right);

+   IF   aleft < aright 

+        THEN result := LONGINT : (CONCR(aright) MUL CONCR(aleft ))

+        ELSE result := LONGINT : (CONCR(aleft ) MUL CONCR(aright))  FI;

+   IF   length(CONCR(result)) = mtl  THEN errorstop(overflow) FI;

+   IF   vleft XOR vright THEN -result ELSE result FI

+END OP *;

+ 

+LONGINT OP ** (LONGINT CONST arg,exp) :

+   IF exp > longint(max int) THEN errorstop (overflow) FI;

+   arg ** int(exp)

+END OP **;

+ 

+LONGINT OP ** (LONGINT CONST arg,INT CONST exp) :

+   IF   exp < 0 THEN errorstop ("LONGINT OP ** : negativ exp")

+   ELIF CONCR(arg)=null AND exp=0 THEN errorstop(text(0 ** 0)) FI;

+   IF   exp = 0  THEN one

+   ELIF exp = 1  THEN arg

+   ELIF sign(arg) = -1 AND exp MOD 2 <> 0

+        THEN -LONGINT:(CONCR(abs(arg))EXPexp) 

+        ELSE  LONGINT:(CONCR(abs(arg))EXPexp) FI

+END OP **; 

+ 

+LONGINT OP ABS (LONGINT CONST arg) : abs(arg) END OP ABS;

+ 

+LONGINT PROC abs (LONGINT CONST a) : 

+ IF (CONCR(a)SUB1)=negativ THEN LONGINT:(subtext(CONCR(a),2)) ELSE a FI

+END PROC abs;

+ 

+OP DECR (LONGINT VAR result,LONGINT CONST ab) :

+   result := result - ab;

+END OP DECR;

+ 

+LONGINT OP DIV (LONGINT CONST left,right) :

+   IF CONCR(right) = null THEN error stop("LONGINT OP DIV by zero") FI;

+   betrag(left,right);        h    := CONCR(aright);

+   y := null + CONCR(aleft ); vorl := vleft;

+   z := null + CONCR(aright); vorr := vright;

+   IF aleft < aright THEN y:=CONCR(aleft); LEAVE DIV WITH zero FI;

+   INT  VAR try,i,cr1 :: code(z SUB 2),cr2,cr3,zw;

+   BOOL VAR sh :: length(z) <> 2;

+   IF sh THEN cr3:=code(zSUB3); cr2:=10*cr1+cr3DIV10; cr3:=100*cr1+cr3 FI;

+   CONCR(result) := "";

+   FOR i FROM 0 UPTO length(y)-length(z) REP

+      laufe eine abschaetzung durch; 

+      CONCR (result) CAT code(try)

+   PER;  kuerze fuehrende nullen(y,null);

+   IF(CONCR(result)SUB1)=nullTHEN CONCR(result):=subtext(CONCR(result),2)FI;

+   IF vleft XOR vright THEN -result ELSE result FI.

+ 

+   laufe eine abschaetzung durch :

+      zw := 100*code(y SUB i+1) + code(y SUB i+2);

+      IF zw < 3276 AND sh THEN IF zw < 327

+      THEN try := min((100*zw + code(ySUBi+3))     DIV cr3, 99)

+      ELSE try := min(( 10*zw + code(ySUBi+3)DIV10)DIV cr2, 99) FI

+      ELSE try := min(     zw                      DIV cr1, 99) FI;

+       x := z MUL code(try); 

+      WHILE x > subtext(y,i+1,i+length(x)) REP

+            try DECR 1;   x := x SUB z     PER;

+      replace(y,i + 1,subtext(y,i + 1,i + length(x)) SUB x) 

+END OP DIV;

+ 

+PROC get (LONGINT VAR result) : 

+   get (ergebnis);

+   result := longint(ergebnis);

+END PROC get;

+ 

+PROC get (FILE VAR file,LONGINT VAR result) :

+   get(file,ergebnis);

+   result := longint(ergebnis);

+END PROC get;

+ 

+OP INCR (LONGINT VAR result,LONGINT CONST dazu) : 

+   result := result + dazu;

+END OP INCR;

+ 

+INT PROC int (LONGINT CONST longint) :

+   IF length(longint) > 3 

+      THEN max int + 1

+      ELSE ergebnis := (3-length(longint))*null + CONCR(abs(longint));

+           (code(ergebnis SUB 1)  * 10000 +

+            code(ergebnis SUB 2)  * 100   +

+            code(ergebnis SUB 3)) * sign(longint)

+   FI

+END PROC int;

+ 

+LONGINT PROC longint (INT CONST int) :

+   CONCR(result) :=  code( abs(int)            DIV 10000) +

+                     code((abs(int) MOD 10000) DIV 100)   +

+                     code( abs(int) MOD 100);

+   kuerze fuehrende nullen (CONCR(result),null);

+   IF int < 1 THEN -result ELSE result FI

+END PROC longint;

+ 

+LONGINT PROC longint (TEXT CONST text) :

+   INT  VAR i;

+   ergebnis := compress(text);

+   BOOL VAR minus :: (ergebnisSUB1) = "-"; 

+   IF (ergebnisSUB1)="+" OR minus THEN ergebnis:=subtext(ergebnis,2) FI;

+   kuerze fuehrende nullen(ergebnis,"0");

+   kuerze die unzulaessigen zeichen aus ergebnis;

+   schreibe ergebnis im hundertersystem in result;

+   result mit vorzeichen.

+

+   kuerze die unzulaessigen zeichen aus ergebnis :

+      ergebnis := subtext(ergebnis,1,letztes zulaessiges zeichen).

+   letztes zulaessiges zeichen :

+      FOR i FROM 1 UPTO length(ergebnis) REP 

+      UNTIL pos("0123456789", ergebnis SUB i) = 0 PER;

+      i - 1.

+   schreibe ergebnis im hundertersystem in result :

+      sll := length(ergebnis);

+      IF sll MOD 2 <> 0 THEN ergebnis := "0"+ergebnis; sll INCR 1 FI; 

+      i := 1; CONCR(result) := "";

+      REP schreibe ein zeichen im hundertersystem in result;

+          i INCR 2

+      UNTIL i >= sll PER.

+   schreibe ein zeichen im hundertersystem in result :

+      CONCR(result) CAT code((code(ergebnis SUB i    ) - snull) * 10 +

+                              code(ergebnis SUB i + 1) - snull).

+   result mit vorzeichen : 

+      IF ergebnis="" THEN zero ELIF minus THEN -result ELSE result FI

+END PROC longint;

+ 

+LONGINT PROC max (LONGINT CONST left,right) :

+   IF left > right THEN left ELSE right FI

+END PROC max;

+ 

+LONGINT PROC max longint :

+   LONGINT : ((mtl - 1) * max digit)

+END PROC max longint;

+ 

+LONGINT PROC min (LONGINT CONST left,right) :

+   IF left < right THEN left ELSE right FI

+END PROC min;

+ 

+LONGINT OP MOD (LONGINT CONST left,right) :

+   IF CONCR(right) = null THEN errorstop("LONGINT OP MOD by zero") FI;

+   result := left DIV right; last rest 

+END OP MOD;

+ 

+PROC put (LONGINT CONST longint) :

+   INT  VAR i :: 1,zwei ziffern;

+   IF sign(longint) = -1 THEN out("-"); i:=2 FI;

+   out(text(code(CONCR(longint) SUB i)));

+   FOR i FROM i + 1 UPTO length(CONCR(longint)) REP

+       zwei ziffern := code(CONCR(longint) SUB i);

+       out(code(zwei ziffern DIV 10 + snull));

+       out(code(zwei ziffern MOD 10 + snull));

+   PER;out(" ")

+END PROC put;

+ 

+PROC put (FILE VAR file,LONGINT CONST longint) :

+   put(file,text(longint));

+END PROC put;

+ 

+LONGINT PROC random (LONGINT CONST lower bound,upper bound) :

+   INT VAR i; x := CONCR(upper bound - lower bound - one); y := "";

+   FOR i FROM 1 UPTO length(x) REP y CAT code(random(0,99)) PER;

+   upper bound - (LONGINT : (y) MOD LONGINT : (x)) 

+END PROC random;

+ 

+INT OP SIGN (LONGINT CONST arg) : sign(arg) END OP SIGN;

+ 

+INT PROC sign (LONGINT CONST arg) :

+   SELECT code(CONCR(arg) SUB 1) OF

+      CASE 0   :  0

+      CASE 127 : -1

+      OTHERWISE   1

+   END SELECT

+END PROC sign;

+ 

+TEXT PROC text (LONGINT CONST longint) :

+   INT  VAR i::1,zwei ziffern; ergebnis := "";

+   IF sign(longint) = -1 THEN ergebnis := "-"; i:=2  FI;

+   ergebnis CAT text (code (CONCR (longint) SUB i ) ) ;

+   FOR i FROM i+1 UPTO length(CONCR(longint)) REP

+      zwei ziffern := code(CONCR(longint) SUB i);

+      ergebnis CAT code(zwei ziffern DIV 10 + snull);

+      ergebnis CAT code(zwei ziffern MOD 10 + snull) 

+   PER;   ergebnis

+END PROC text;

+ 

+TEXT PROC text (LONGINT CONST longint,INT CONST length) :

+   x := text(longint); sll := LENGTH x;

+   IF sll > length THEN length * "*" ELSE (length - sll)*" " + x FI

+END PROC text; 

+

+LONGINT PROC last rest :

+  IF y=null THEN LEAVE last rest WITH zero FI; 

+  IF vorl XOR vorr THEN y := h SUB y; kuerze fuehrende nullen(y,null);

+                        vorl := TRUE FI;

+  IF NOTvorr THEN y:=negativ+y; vorr := TRUE FI; LONGINT:(y) 

+END PROC last rest;

+ 

+LONGINT PROC zero :   LONGINT : (null)   END PROC zero;

+LONGINT PROC one  :   LONGINT : (""1"")  END PROC one;

+ 

+ 

+(* ----------------------- INTERNE HILFSPROZEDUREN ----------------------- *)

+ 

+TEXT OP ADD (TEXT CONST left,right) :

+   INT  VAR   carrybit :: 0,i,dif :: length(left) - length(right);

+   ergebnis := left; 

+   FOR i FROM length(left) DOWNTO dif + 1 REP

+      replace(ergebnis,i,das result der addition)

+   PER;

+   IF carrybit = 1 THEN addiere den uebertrag  FI; 

+   ergebnis.

+ 

+   das result der addition :

+      v byte := (code(left SUB i) + code(right SUB i - dif) + carrybit);

+      IF v byte > 99 

+         THEN carrybit := 1; code(v byte - 100)

+         ELSE carrybit := 0; code(v byte)

+      FI. 

+   addiere den uebertrag :

+      FOR i FROM i DOWNTO 1

+          WHILE (ergebnis SUB i) >= max digit REP

+          replace(ergebnis,i,null) 

+      PER;

+      IF (ergebnis SUB 1) = null  OR  dif = 0

+         THEN pruefe auf longint overflow 

+         ELSE replace(ergebnis,i,code(code(ergebnis SUB i) + 1))

+      FI.

+   pruefe auf longint overflow :

+      IF length(ergebnis) = mtl - 1 THEN errorstop(overflow) FI;

+      ergebnis := eins + ergebnis

+END OP ADD;

+ 

+PROC betrag (LONGINT CONST a, b) :

+   vleft := (CONCR(a)SUB1)<>negativ; vright := (CONCR(b)SUB1)<>negativ;

+   IF vleft  THEN aleft :=a ELSE CONCR(aleft ):=subtext(CONCR(a),2) FI;

+   IF vright THEN aright:=b ELSE CONCR(aright):=subtext(CONCR(b),2) FI

+END PROC betrag;

+

+TEXT OP EXP (TEXT CONST arg,INT CONST exp) :

+   INT VAR zaehler :: exp;

+   x := arg; z := eins;

+   REP  IF zaehler MOD 2 = 1 THEN z := z MUL x FI; 

+        zaehler := zaehler DIV 2; x := x MUL x 

+   UNTIL zaehler = 1 PER;

+    x MUL z 

+END OP EXP;

+ 

+PROC kuerze fuehrende nullen ( TEXT VAR text,TEXT CONST snull) :

+   INT VAR i;

+   text := subtext(text,erste nicht snull).

+ 

+   erste nicht snull :

+   FOR i FROM 1 UPTO length (text) - 1 REP

+   UNTIL (text SUB i) <> snull PER;

+   i

+END PROC kuerze fuehrende nullen;

+ 

+INT PROC length (LONGINT CONST a) : 

+  IF (CONCR(a)SUB1)=negativ THEN length(CONCR(a))-1 ELSE length(CONCR(a)) FI

+END PROC length;

+ 

+TEXT OP MUL (TEXT CONST left,right) :

+   INT VAR i,j,carrybit,v,w;

+   ergebnis := (length(left) + length(right) - 1) * null;

+   FOR i FROM length(ergebnis) DOWNTO length(left) REP

+       v := i - length(left); w := length(right) - length(ergebnis) + i;

+       carrybit := 0;

+      FOR j FROM length(left) DOWNTO 1 REP

+            replace(ergebnis,v + j,result der addition)

+      PER;

+       replace(ergebnis,v,code(code(ergebnis SUB v) + carrybit));

+   PER;

+   IF carrybit = 0 THEN ergebnis ELSE code(carrybit) + ergebnis FI.

+

+   result der addition :

+      v byte := code(right    SUB w) * code(left SUB j) + carrybit +

+                code(ergebnis SUB v + j);

+      carrybit := v byte DIV 100;

+      code(v byte MOD 100)

+END OP MUL;

+ 

+TEXT OP SUB (TEXT CONST left,right) : 

+   INT  VAR   carrybit :: 0,i,dif :: length(left) - length(right);

+   ergebnis := left;

+   FOR i FROM length(left) DOWNTO dif + 1 REP 

+       replace(ergebnis,i,das result der subtraktion);

+   PER;

+   IF carrybit = 1 THEN subtrahiere den uebertrag FI;

+   ergebnis.

+ 

+   das result der subtraktion :

+      v byte := (code(left SUB i) - code(right SUB i - dif) - carrybit);

+      IF v byte < 0 

+         THEN carrybit := 1;code(v byte + 100)

+         ELSE carrybit := 0;code(v byte)

+      FI.

+   subtrahiere den uebertrag :

+      FOR i FROM i DOWNTO 2 

+          WHILE (ergebnis SUB i) = null REP

+          replace(ergebnis,i,max digit)

+      PER;

+      replace(ergebnis,i,code(code(ergebnis SUB i) - 1))

+END OP SUB;

+ 

+END PACKET longint;

diff --git a/system/std.zusatz/1.7.3/src/matrix b/system/std.zusatz/1.7.3/src/matrix
new file mode 100644
index 0000000..fbc5ffc
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/matrix
@@ -0,0 +1,470 @@
+PACKET matrix DEFINES MATRIX, matrix, idn,  (* Stand : 21.10.83      *)

+                      :=, sub,              (* Autor : H.Indenbirken *)

+                      row, column,

+                      COLUMNS,

+                      ROWS,

+                      DET, 

+                      INV, 

+                      TRANSP, 

+                      transp,

+                      replace row, replace column,

+                      replace element,

+                      get, put,

+                      =, <>,

+                      +, -, * :

+

+TYPE MATRIX = STRUCT (INT rows, columns, VECTOR elems);

+TYPE INITMATRIX = STRUCT (INT rows, columns, REAL value, BOOL idn);

+

+MATRIX VAR a :: idn (1);

+INT VAR i;

+

+(****************************************************************************

+PROC dump (MATRIX CONST m) :

+  put line (text (m.rows) + " Reihen, " + text (m.columns) + " Spalten.");

+  dump (m.elems)  .

+

+END PROC dump;

+****************************************************************************)

+

+OP := (MATRIX VAR l, MATRIX CONST r) :

+  CONCR (l) := CONCR (r);

+END OP :=;

+

+OP := (MATRIX VAR l, INITMATRIX CONST r) :

+  l.rows    := r.rows;

+  l.columns := r.columns;

+  l.elems   := vector (r.rows*r.columns, r.value);

+  IF r.idn

+  THEN idn FI  .

+

+idn :

+  INT VAR i;

+  FOR i FROM 1 UPTO r.rows

+  REP replace (l.elems, calc pos (l.columns, i, i), 1.0) PER

+

+END OP :=;

+ 

+INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) :

+  IF rows <= 0

+  THEN errorstop ("PROC matrix : rows <= 0")

+  ELIF columns <= 0

+  THEN errorstop ("PROC matrix : columns <= 0") FI;

+

+  INITMATRIX : (rows, columns, value, FALSE)

+

+END PROC matrix;

+

+INITMATRIX PROC matrix (INT CONST rows, columns) :

+  matrix (rows, columns, 0.0)

+

+END PROC matrix;

+

+INITMATRIX PROC idn (INT CONST size) :

+  IF size <= 0

+  THEN errorstop ("MATRIX PROC idn : size <= 0") FI;

+

+  INITMATRIX : (size, size, 0.0, TRUE)

+

+END PROC idn;

+

+VECTOR PROC row (MATRIX CONST m, INT CONST i) :

+  VECTOR VAR v :: vector (m.columns);

+  INT VAR j, k :: 1, pos :: (i-1) * m.columns;

+  FOR j FROM pos+1 UPTO pos + m.columns

+  REP replace (v, k, m.elems SUB j);

+      k INCR 1

+  PER;

+  v

+

+END PROC row;

+

+VECTOR PROC column (MATRIX CONST m, INT CONST j) :

+  VECTOR VAR v :: vector (m.rows);

+  INT VAR i, k :: j;

+  FOR i FROM 1 UPTO m.rows

+  REP replace (v, i, m.elems SUB k);

+      k INCR m.columns

+  PER;

+  v

+

+END PROC column;

+

+INT OP COLUMNS (MATRIX CONST m) :

+  m.columns

+

+END OP COLUMNS;

+

+INT OP ROWS (MATRIX CONST m) :

+  m.rows

+

+END OP ROWS;

+

+REAL PROC sub (MATRIX CONST a, INT CONST row, column) :

+  a.elems SUB calc pos (a.columns, row, column)

+

+END PROC sub;

+

+PROC replace row (MATRIX VAR m, INT CONST rowindex, VECTOR CONST rowvalue) :

+  test ("PROC replace row : ", "LENGTH rowvalue", "COLUMNS m",

+        LENGTH rowvalue, m.columns);

+  test ("PROC replace row : row ", rowindex, m.rows);

+

+  INT VAR i, pos :: (rowindex-1) * m.columns;

+  FOR i FROM 1 UPTO m.columns

+  REP replace (m.elems, pos+i, rowvalue SUB i) PER

+

+END PROC replace row;

+

+PROC replace column (MATRIX VAR m, INT CONST columnindex,

+                     VECTOR CONST columnvalue) :

+  test ("PROC replace column : ", "LENGTH columnvalue", "ROWS m",

+        LENGTH columnvalue, m.rows);

+  test ("PROC replace column : column ", columnindex, m.columns);

+

+  INT VAR i;

+  FOR i FROM 1 UPTO m.rows

+  REP replace (m.elems, calc pos (m.columns, i, columnindex),

+               columnvalue SUB i) PER

+

+END PROC replace column;

+

+PROC replace element (MATRIX VAR a, INT CONST row, column, REAL CONST x) :

+  test ("PROC replace element : row ", row, a.rows);

+  test ("PROC replace element : column ", column, a.columns);

+  replace (a.elems, calc pos (a.columns, row, column), x)

+

+END PROC replace element;

+

+BOOL OP = (MATRIX CONST l, r) :

+  IF l.rows <> r.rows

+  THEN FALSE

+  ELIF l.columns <> r.columns

+  THEN FALSE

+  ELSE l.elems = r.elems FI

+

+END OP =;

+

+BOOL OP <> (MATRIX CONST l, r) :

+  IF l.rows <> r.rows

+  THEN TRUE

+  ELIF l.columns <> r.columns

+  THEN TRUE

+  ELSE l.elems <> r.elems FI

+

+END OP <>;

+

+INT PROC calc pos (INT CONST columns, z, s) :

+ (z-1) * columns + s

+END PROC calc pos;

+

+MATRIX OP + (MATRIX CONST m) :

+  m

+

+END OP +;

+

+MATRIX OP + (MATRIX CONST l, r) :

+  test ("MATRIX OP + : ", "ROWS l", "ROWS r", l.rows, r.rows);

+  test ("MATRIX OP + : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns);

+

+  a := l;

+  INT VAR i;

+  FOR i FROM 1 UPTO l.rows * l.columns

+  REP replace (a.elems, i, (l.elems SUB i) + (r.elems SUB i))

+  PER;

+  a

+

+END OP +;

+

+MATRIX OP - (MATRIX CONST m) :

+  a := m;

+  INT VAR i;

+  FOR i FROM 1 UPTO m.rows * m.columns

+  REP replace (a.elems, i, -a.elems SUB i)

+  PER;

+  a

+

+END OP -;

+

+MATRIX OP - (MATRIX CONST l, r) :

+  test ("MATRIX OP - : ", "ROWS l", "ROWS r", l.rows, r.rows);

+  test ("MATRIX OP - : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns);

+

+  a := l;

+  INT VAR i;

+  FOR i FROM 1 UPTO l.rows * l.columns

+  REP replace (a.elems, i, (l.elems SUB i) - (r.elems SUB i))

+  PER;

+  a

+

+END OP -;

+

+MATRIX OP * (REAL CONST x, MATRIX CONST m) :

+ m*x

+

+END OP *;

+

+MATRIX OP * (MATRIX CONST m, REAL CONST x) :

+  a := m;

+  INT VAR i;

+  FOR i FROM 1 UPTO m.rows * m.columns

+  REP replace (a.elems, i, x*m.elems SUB i) PER;

+  a

+

+END OP *;

+

+VECTOR OP * (VECTOR CONST v, MATRIX CONST m) :

+  test ("VECTOR OP * : ", "LENGTH v", "ROWS m", LENGTH v, m.rows);

+  VECTOR VAR result :: vector (m.rows);

+  INT VAR i;

+  FOR i FROM 1 UPTO m.rows

+  REP replace (result, i, v * column (m, i)) PER;

+  result  .

+

+END OP *;

+

+VECTOR OP * (MATRIX CONST m, VECTOR CONST v) :

+  test ("VECTOR OP * : ", "COLUMNS m", "LENGTH v", COLUMNS m, LENGTH v);

+  VECTOR VAR result :: vector (m.columns);

+  INT VAR i;

+  FOR i FROM 1 UPTO m.columns

+  REP replace (result, i, row (m, i) * v) PER;

+  result  .

+

+END OP *;

+

+MATRIX OP * (MATRIX CONST l, r) :

+  test ("MATRIX OP * : ","COLUMNS l","ROWS r", l.columns, r.rows);

+

+  a.rows := l.rows;

+  a.columns := r.columns;

+  a.elems := vector (a.rows*a.columns)

+  INT VAR i, j;

+  FOR i FROM 1 UPTO a.rows

+  REP FOR j FROM 1 UPTO a.columns

+      REP VECTOR VAR rl :: row (l, i), cr :: column (r, j);

+          replace (a.elems, calc pos (a.columns, i, j), rl * cr)

+      PER

+  PER;

+  a  .

+

+END OP *;

+

+PROC get (MATRIX VAR a, INT CONST rows, columns) :

+ 

+  a := matrix (rows,columns);

+  INT VAR i, j;

+  VECTOR VAR v;

+  FOR i FROM 1 UPTO rows

+  REP get (v, columns);

+      store row

+  PER  .

+

+store row :

+  FOR j FROM 1 UPTO a.columns

+  REP replace (a.elems, calc pos (a.columns, i, j), v SUB j)

+  PER  .

+

+END PROC get;

+

+PROC put (MATRIX CONST a, INT CONST length, fracs) :

+  INT VAR i, j;

+  FOR i FROM 1 UPTO a.rows

+  REP FOR j FROM 1 UPTO a.columns

+      REP put (text (sub (a, i, j), length, fracs)) PER;

+      line (2);

+  PER

+

+END PROC put;

+

+PROC put (MATRIX CONST a) :

+  INT VAR i, j;

+  FOR i FROM 1 UPTO a.rows

+  REP FOR j FROM 1 UPTO a.columns

+      REP TEXT CONST number :: "                 " + text (sub (a, i, j));

+          put (subtext (number, LENGTH number - 15))

+      PER;

+      line (2);

+  PER

+

+END PROC put;

+

+TEXT VAR error :: "";

+PROC test (TEXT CONST proc, l text, r text, INT CONST left, right) :

+  IF left <> right

+  THEN error := proc;

+       error CAT l text;

+       error CAT " (";

+       error CAT text (left);

+       error CAT ") <> ";

+       error CAT r text;

+       error CAT " (";

+       error CAT text (right);

+       error CAT ")";

+       errorstop (error)

+  FI  .

+

+END PROC test;

+

+PROC test (TEXT CONST proc, INT CONST i, n) :

+  IF i < 1

+  THEN error := proc;

+       error CAT "subscript underflow (";

+       error CAT text (i);

+       error CAT ")";

+       errorstop (error)

+  ELIF i > n

+  THEN error := proc;

+       error CAT "subscript overflow (i=";

+       error CAT text (i);

+       error CAT ", max=";

+       IF n <= 0

+       THEN error CAT "undefined"

+       ELSE error CAT text (n) FI;

+       error CAT ")";

+       errorstop (error)

+  FI

+

+END PROC test;

+

+

+MATRIX OP TRANSP (MATRIX CONST m) :

+  MATRIX VAR a :: m;

+  transp (a);

+  a

+

+END OP TRANSP;

+

+PROC transp (MATRIX VAR m) :

+  INT VAR k :: 1, n :: m.rows*m.columns;

+  a := m;

+  FOR i FROM 2 UPTO n

+  REP replace (m.elems, i, a.elems SUB position) PER;

+  a := idn (1);

+  i := m.rows;

+  m.rows := m.columns;

+  m.columns := i  .

+

+position :

+  k INCR m.columns;

+  IF k > n

+  THEN k DECR (n-1) FI;

+  k  .

+END PROC transp;

+

+MATRIX OP INV (MATRIX CONST m) :

+  a := m;

+  ROW 32 INT VAR pivots;

+  INT VAR i, j, k :: ROWS a, n :: COLUMNS a, pos;

+

+  IF n <> k

+  THEN errorstop ("MATRIX OP INV : no square matrix") FI;

+

+  initialisiere die pivotpositionen;

+

+  FOR j FROM 1 UPTO n

+  REP pivotsuche (a, j, pos);

+      IF sub (a, pos, pos) = 0.0

+      THEN errorstop ("MATRIX OP INV : singular matrix") FI;

+      zeilentausch (a, j, pos);

+      merke dir die vertauschung;

+      transformiere die matrix

+  PER;

+

+  spaltentausch;

+  a  .

+

+initialisiere die pivotpositionen :

+  FOR i FROM 1 UPTO n

+  REP pivots [i] := i PER  .

+

+merke dir die vertauschung :

+  IF pos > j

+  THEN INT VAR hi :: pivots [j];

+       pivots [j] := pivots [pos];

+       pivots [pos] := hi

+  FI  .

+

+transformiere die matrix :

+  REAL VAR h := 1.0/sub (a, j, j);

+

+  FOR k FROM 1 UPTO n

+  REP IF k <> j

+      THEN FOR i FROM 1 UPTO n

+           REP IF i <> j

+               THEN replace element (a, i, k, sub (a, i, k) -

+                                     sub (a, i, j)*sub (a, j, k)*h);

+               FI

+           PER;

+       FI

+  PER;

+

+  FOR k FROM 1 UPTO n

+  REP replace element (a, j, k, -h*sub (a, j, k));

+      replace element (a, k, j,  h*sub (a, k, j))

+  PER;

+  replace element (a, j, j, h)  .

+

+spaltentausch :

+  VECTOR VAR v :: vector (n);

+  FOR i FROM 1 UPTO n

+  REP FOR k FROM 1 UPTO n

+      REP replace (v, pivots [k], sub (a, i, k)) PER;

+      replace row (a, i, v)

+  PER  .

+

+END OP INV;

+

+REAL OP DET (MATRIX CONST m) :

+  IF COLUMNS m <> ROWS m

+  THEN errorstop ("REAL OP DET : no square matrix") FI;

+

+  a := m;

+  INT VAR i, j, k, n :: COLUMNS m, pos;

+  FOR j FROM 1 UPTO n

+  REP pivotsuche (a, j, pos);

+      zeilentausch (a, j, pos);

+      transformiere die matrix

+  PER;

+  produkt der pivotelemente  .

+

+transformiere die matrix :

+  REAL VAR h := 1.0/sub (a, j, j);

+  FOR i FROM j+1 UPTO n

+  REP FOR k FROM j+1 UPTO n

+      REP replace element (a, i, k, sub (a, i, k) -

+                           sub (a, i, j)*h*sub (a, j, k))

+      PER

+  PER  .

+

+produkt der pivotelemente :

+  REAL VAR produkt :: sub (a, 1, 1);

+  FOR j FROM 2 UPTO n

+  REP produkt := produkt * sub (a, j, j) PER;

+  a := idn (1);

+  produkt  .

+

+END OP DET;

+

+PROC pivotsuche (MATRIX CONST a, INT CONST start pos, INT VAR pos) :

+  REAL VAR max :: abs (sub (a, start pos, start pos));

+  INT VAR i;

+  pos := start pos;

+

+  FOR i FROM start pos+1 UPTO COLUMNS a

+  REP IF abs (sub (a, i, start pos)) > max

+      THEN max := abs (sub (a, i, start pos));

+           pos := i

+      FI

+  PER  .

+

+END PROC pivotsuche;

+

+PROC zeilentausch (MATRIX VAR a, INT CONST old pos, pos) :

+  VECTOR VAR v := row (a, pos);

+  replace row (a, pos, row (a, old pos));

+  replace row (a, old pos, v)  .

+

+END PROC zeilentausch;

+

+END PACKET matrix;

diff --git a/system/std.zusatz/1.7.3/src/minimal fonts routines b/system/std.zusatz/1.7.3/src/minimal fonts routines
new file mode 100644
index 0000000..adcfc66
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/minimal fonts routines
@@ -0,0 +1,9 @@
+PACKET minimal fonts routines DEFINES lf height of current font, 

+                                      x factor per inch, 

+                                      y factor per inch: 

+ 

+REAL CONST lf height of current font :: 2.54 / 6.0;

+INT CONST x factor per inch         :: 10,

+          y factor per inch         ::  6;

+ 

+END PACKET minimal fonts routines;

diff --git a/system/std.zusatz/1.7.3/src/printer-M b/system/std.zusatz/1.7.3/src/printer-M
new file mode 100644
index 0000000..45b1381
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/printer-M
@@ -0,0 +1,69 @@
+PACKET multi user printer :

+

+INT VAR printer channel ;

+

+  put ("Druckerkanal:") ;

+  get (printer channel) ;

+  server channel (printer channel); 

+ 

+  command dialogue (FALSE) ;

+  spool manager (PROC printer) ;

+

+

+LET ack = 0 ,

+    fetch code = 11 ,

+    file type = 1003 ;

+

+INT VAR reply , old heap size ;

+

+DATASPACE VAR ds ;

+

+FILE VAR file ;

+

+PROC printer :

+

+  disable stop ;

+  continue (server channel) ;

+  IF is error

+    THEN clear error ;

+         end

+  FI ;

+

+  old heap size := heap size ;

+  REP

+    forget (ds) ;

+    execute print ;

+    IF is error AND online

+      THEN put error

+    FI ;

+    clear error ;

+    IF heap size > old heap size + 4

+      THEN collect heap garbage ;

+           old heap size := heap size

+    FI

+  PER 

+

+ENDPROC printer ;

+

+PROC execute print :

+

+  enable stop ;

+  REP

+    ds := nilspace ;

+    call (father, fetch code, ds, reply) ;

+    IF reply = ack CAND type (ds) = file type

+      THEN print file

+    FI ;

+    forget (ds)

+  PER .

+

+print file :

+  file := sequential file (input, ds) ;

+  IF is elan source (file)

+    THEN elan list (file)

+    ELSE print (file)

+  FI .

+

+ENDPROC execute print ;

+

+ENDPACKET multi user printer ;

diff --git a/system/std.zusatz/1.7.3/src/printer-S b/system/std.zusatz/1.7.3/src/printer-S
new file mode 100644
index 0000000..5124cc4
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/printer-S
@@ -0,0 +1,36 @@
+PACKET single user print cmd DEFINES print :

+ 

+INT VAR print channel ;

+FILE VAR print file ;

+

+put ("Druckerkanal:") ;

+get (print channel) ;

+

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  continue (0)

+

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  IF is elan source (print file)

+    THEN elan list (print file)

+    ELSE print (print file)

+  FI

+

+ENDPROC execute print ;

+

+ENDPACKET single user print cmd ;

diff --git a/system/std.zusatz/1.7.3/src/purge b/system/std.zusatz/1.7.3/src/purge
new file mode 100644
index 0000000..e325646
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/purge
@@ -0,0 +1,85 @@
+

+PACKET purge DEFINES purge :

+

+ 

+TEXT VAR task name, record, file name, dummy ;

+

+FILE VAR permit ;

+

+

+PROC purge :

+

+  IF exists ("permitted tasks")

+    THEN access catalogue ;

+         permit := sequential file (input, "permitted tasks") ;

+         say (""10""13"TASKS :"10""10""13"") ;

+         IF myself < supervisor

+           THEN purge son tasks (brother (supervisor))

+           ELSE purge son tasks (myself)

+         FI

+  FI ;

+  IF exists ("permitted files")

+    THEN permit := sequential file (input, "permitted files") ;

+         say (""10""13"DATEIEN :"10""10""13"") ;

+         purge files

+  FI

+

+ENDPROC purge ;

+

+PROC purge son tasks (TASK CONST father task) :

+

+  TASK VAR actual task := son (father task) ;

+  WHILE NOT is niltask (actual task) REP

+    purge son tasks (actual task) ;

+    IF NOT actual task permitted

+      THEN erase actual task

+    FI ;

+    actual task := brother (actual task)

+  END REP .

+

+erase actual task :

+  say ("""") ; say (task name) ; say ("""") ;

+  IF yes (" loeschen")

+    THEN end (actual task)

+  FI .

+

+actual task permitted :

+  task name := name (actual task) ;

+  reset (permit) ;

+  WHILE NOT eof (permit) REP

+    getline (permit, record) ;

+    IF task name = record

+      THEN LEAVE actual task permitted WITH TRUE

+    FI

+  END REP ;

+  FALSE .

+

+ENDPROC purge son tasks ;

+

+PROC purge files :

+

+  begin list ;

+  get list entry (file name, dummy) ;

+  WHILE file name <> "" REP

+    IF NOT file permitted

+      THEN forget (file name)

+    FI ;

+    get list entry (file name, dummy)

+  END REP .

+

+file permitted :

+  IF file name = "permitted tasks" OR file name = "permitted files"

+    THEN LEAVE file permitted WITH TRUE

+  FI ;

+  reset (permit) ;

+  WHILE NOT eof (permit) REP

+    getline (permit, record) ;

+    IF file name = record

+      THEN LEAVE file permitted WITH TRUE

+    FI

+  END REP ;

+  FALSE .

+

+ENDPROC purge files ;

+

+ENDPACKET purge ;

diff --git a/system/std.zusatz/1.7.3/src/referencer b/system/std.zusatz/1.7.3/src/referencer
new file mode 100644
index 0000000..5606e4c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/referencer
@@ -0,0 +1,1077 @@
+PACKET referencer errors DEFINES report referencer error: 

+ 

+(* Programm zur Fehlerbehandlung des referencers.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+TEXT VAR fehlerdummy,

+         message;

+

+PROC report referencer error (INT CONST error nr,

+                           INT CONST line nr,

+                           TEXT CONST addition):

+ 

+  einfache fehlermeldung aufbauen; 

+  diese auf terminal ausgeben; 

+  fehlermeldung in fehlerdatei ausgeben. 

+ 

+einfache fehlermeldung aufbauen: 

+  message := "WARNUNG in Zeile ";

+  message CAT text (line nr);

+  message CAT " : ";

+  message CAT simple message.

+ 

+diese auf terminal ausgeben: 

+  line; 

+  out (message); 

+  line. 

+ 

+fehlermeldung in fehlerdatei ausgeben: 

+  note (message); 

+  note line;

+  fehlerdummy := "   >>> ";

+  fehlerdummy CAT zusatz;

+  note (fehlerdummy);

+  note line.

+ 

+simple message: 

+  SELECT error nr OF 

+  CASE 1: "Text Denoter ueber mehr als eine Zeile"

+  CASE 2: "Nicht beendeter Text Denoter bei Programmende" 

+  CASE 3: "Kommentar ueber mehr als eine Zeile" 

+  CASE 4: "Nicht beendeter Kommentar bei Programmende" 

+  CASE 5: "Ueberdeckung"

+  CASE 6, 9: "Refinement mehrmals eingesetzt" 

+  CASE 7, 10: "Refinement wird nicht aufgerufen"

+  CASE 8: "Objekt wird nicht angesprochen"

+  OTHERWISE "" 

+  ENDSELECT. 

+ 

+zusatz: 

+  SELECT error nr OF 

+  CASE 1, 2, 3, 4: "Ueber " + addition + " Zeilen"

+  CASE 5: addition

+  CASE 6, 7, 8: addition

+  CASE 9, 10: addition + " in mindestens einer Prozedur"

+  OTHERWISE "interner Fehler: HRZ Bielefeld benachrichtigen!" 

+  END SELECT.

+END PROC report referencer error 

+END PACKET referencer errors; 

+(************************************************************************)

+ 

+PACKET name table handling

+              DEFINES NAMETABLE,

+                      empty name table,

+                      put name, 

+                      get name,

+                      dump table:

+ 

+(* Programm zur Speicherung von Namen.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+LET hash table length           = 1024, 

+    hash table length minus one = 1023,

+    start of name table         = 255,

+    name table length           = 2000;

+ 

+TYPE NAMETABLE = STRUCT (INT number of entries, 

+                         ROW hash table length INT hash table,

+                         ROW name table length INT next, 

+                         ROW name table length TEXT name table); 

+ 

+TEXT VAR dummy, f;

+ 

+PROC put name (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):

+  INT VAR errechneter index; 

+  hash (name, errechneter index); 

+  IF noch kein eintrag 

+    THEN gaenzlich neuer eintrag 

+    ELSE name in vorhandener kette 

+  FI. 

+ 

+noch kein eintrag: 

+  n . hash table [errechneter index] = 0. 

+ 

+gaenzlich neuer eintrag: 

+  n . hash table [errechneter index] := n . number of entries; 

+  neuer eintrag (n, name, pointer).

+ 

+name in vorhandener kette:

+  INT VAR dieser eintrag :: n. hash table [errechneter index]; 

+  REP 

+    IF name ist vorhanden

+      THEN pointer := dieser eintrag;

+           LEAVE put name 

+    ELIF kette zu ende

+      THEN neuer eintrag an vorhandene kette anketten; 

+           neuer eintrag (n, name, pointer);

+           LEAVE put name

+      ELSE naechster eintrag in der kette

+    FI 

+  END REP.

+ 

+name ist vorhanden: 

+  n . name table [dieser eintrag] = name.

+ 

+kette zu ende: 

+  n . next [dieser eintrag] = 0.

+ 

+neuer eintrag an vorhandene kette anketten: 

+  n . next [dieser eintrag] := n . number of entries. 

+ 

+naechster eintrag in der kette:

+  dieser eintrag := n . next [dieser eintrag].

+END PROC put name; 

+ 

+PROC neuer eintrag (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):

+  n . name table [n . number of entries] := name; 

+  n . next [n . number of entries] := 0; 

+  pointer := n . number of entries;

+  n . number of entries INCR 1; 

+  IF n . number of entries > name table length 

+    THEN errorstop ("volle Namenstabelle")

+  FI 

+END PROC neuer eintrag;

+ 

+PROC hash (TEXT CONST name, INT VAR index) :

+  INT VAR i;

+  index := code (name SUB 1);

+  FOR i FROM 2 UPTO length (name) REP

+    addmult cyclic

+  ENDREP.

+ 

+addmult cyclic :

+  index INCR index ;

+  IF index > hash table length minus one

+    THEN wrap around

+  FI;

+  index := (index + code (name SUB i)) MOD hash table length.

+ 

+wrap around :

+  index DECR hash table length minus one

+ENDPROC hash ;

+ 

+PROC get name (NAMETABLE CONST n, INT CONST index, TEXT VAR t): 

+  IF index < n . number of entries AND index >= start of name table

+    THEN t := n . name table [index] 

+    ELSE errorstop ("Interner Fehler 1") 

+  FI 

+END PROC get name; 

+ 

+PROC empty name table (NAMETABLE VAR n): 

+INT VAR i;

+  n . number of entries := start of name table; 

+  FOR i FROM 1 UPTO hash table length REP 

+    n . hash table [i] := 0 

+  END REP 

+END PROC empty name table;

+ 

+PROC dump table (NAMETABLE CONST n): 

+  line;

+  put ("Bitte Name der Datei, in die die Namenstabelle gehen soll:");

+  getline (f);

+  line;

+  file assoziieren; 

+  dump namens ketten; 

+  zusammenfassung.

+ 

+file assoziieren: 

+  FILE VAR file :: sequential file (output, f). 

+ 

+dump namens ketten:

+  INT VAR i,

+          anz hash eintraege :: 0, 

+          kette 3 eintraege  :: 0;

+  FOR i FROM 1 UPTO hash table length REP 

+    IF n . hash table [i] <> 0 

+      THEN anz hash eintraege INCR 1;

+           INT VAR naechster eintrag :: n . hash table [i];

+           dump hash eintrag;

+           ketten eintraege

+    FI 

+  END REP. 

+ 

+dump hash eintrag: 

+  dummy := text (i); 

+  WHILE length (dummy) < 4 REP dummy CAT " " END REP;

+  dummy CAT ": ".

+ 

+ketten eintraege:

+  INT VAR anz eintraege pro kette :: 0;

+  WHILE naechster eintrag > 0 REP 

+    anz eintraege pro kette INCR 1;

+    dummy CAT " ";

+    dummy CAT text (naechster eintrag);

+    dummy CAT " -> ";

+    dummy CAT n . name table [naechster eintrag]; 

+    naechster eintrag := n . next [naechster eintrag];

+  END REP;

+  IF anz eintraege pro kette > 2 

+    THEN kette 3 eintraege INCR 1 

+  FI;

+  putline (file, dummy). 

+ 

+zusammenfassung: 

+  statistik ueberschrift;

+  anzahl hash eintraege; 

+  anzahl namens eintraege;

+  verkettungsfaktor; 

+  anzahl laengerer ketten.

+ 

+statistik ueberschrift: 

+  line (file, 2);

+  dummy := " ---------- "; 

+  dummy CAT "S T A T I S T I K:";

+  dummy CAT " ---------- ";

+  putline (file, dummy);

+  line (file, 2).

+ 

+anzahl hash eintraege:

+  dummy := "Anzahl Hash-Eintraege (max. "; 

+  dummy CAT text (hash table length); 

+  dummy CAT "): "; 

+  dummy CAT text (anz hash eintraege); 

+  putline (file, dummy).

+ 

+anzahl namens eintraege: 

+  dummy := "Anzahl Namen (max. "; 

+  dummy CAT text (name table length - start of name table + 1); 

+  dummy CAT "): "; 

+  dummy CAT text (n . number of entries - start of name table);

+  putline (file, dummy).

+ 

+verkettungsfaktor: 

+  dummy := "Verkettungsfaktor (Anzahl Namen / Anzahl Ketten): "; 

+  dummy CAT text (real (n . number of entries - start of name table) /

+         real (anz hash eintraege));

+  putline (file, dummy).

+ 

+anzahl laengerer ketten:

+  dummy := "Anzahl Ketten > 2 Eintraege: "; 

+  dummy CAT text (kette 3 eintraege); 

+  putline (file, dummy).

+END PROC dump table; 

+END PACKET name table handling; 

+(***************************************************************************)

+ 

+PACKET scanner DEFINES init scanning, 

+                       init name table with,

+                       dump name table,

+                       get name,

+                       end scanning,

+                       line number,

+                       symbol: 

+

+(* Programm zum scannen von ELAN-Programmen.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+FILE VAR eingabe; 

+ 

+DATASPACE VAR ds alt := nilspace,

+              ds neu := nilspace;

+ 

+BOUND NAMETABLE VAR tabelle;

+ 

+TEXT VAR zeile, 

+         zeichen, 

+         dummy;

+ 

+LET end of program = ""30"",

+    eop            = 1, 

+    identifier     = 2, 

+    keyword        = 3, 

+    delimiter      = 4,

+    klammer auf    = 40,

+    punkt          = 46,

+    doppelpunkt    = 58, 

+    init symbol    = 30, 

+    assign symbol  = 31;

+

+INT VAR zeilen nr,

+        zeichen pos;

+ 

+PROC init name table with (TEXT CONST worte):

+INT VAR index;

+  forget (ds alt);

+  ds alt := nilspace;

+  tabelle := dsalt;

+  empty name table (CONCR (tabelle));

+  INT VAR anf :: 1, 

+          ende :: pos (worte, ",", 1); 

+  WHILE ende > 0 REP 

+    dummy := subtext (worte, anf, ende - 1); 

+    put name (CONCR (tabelle), dummy, index); 

+    anf := ende + 1; 

+    ende := pos (worte, ",", ende + 1)

+  END REP; 

+  dummy := subtext (worte, anf); 

+  put name (CONCR (tabelle), dummy, index) 

+END PROC init name table with; 

+

+PROC init scanning (TEXT CONST f): 

+  IF exists (f) 

+    THEN namenstabelle holen;

+         erste zeile lesen 

+    ELSE errorstop ("Datei existiert nicht") 

+  FI. 

+ 

+namenstabelle holen: 

+  forget (ds neu);

+  ds neu := ds alt; 

+  tabelle := ds neu. 

+ 

+erste zeile lesen: 

+  eingabe := sequential file (input, f);

+  IF eof (eingabe) 

+    THEN errorstop ("Datei ist leer")

+    ELSE zeile := "";

+         zeilen nr := 0; 

+         zeile lesen; 

+         naechstes non blank zeichen

+  FI 

+END PROC init scanning; 

+

+PROC dump name table: 

+  dump table (CONCR (tabelle)) 

+END PROC dump name table; 

+ 

+PROC end scanning (TEXT CONST f): 

+  IF anything noted

+    THEN eingabe := sequential file (modify, f);

+         note edit (eingabe) 

+  FI

+END PROC end scanning; 

+ 

+PROC get name (INT CONST index, TEXT VAR t): 

+  get name (CONCR (tabelle), index, t) 

+END PROC get name; 

+ 

+PROC zeile lesen: 

+  getline (eingabe, zeile); 

+  zeilen nr INCR 1; 

+  cout (zeilen nr);

+  zeichen pos := 0

+END PROC zeile lesen; 

+ 

+PROC naechstes non blank zeichen: 

+  REP

+    zeichen pos := pos (zeile, ""33"", ""254"", zeichen pos + 1); 

+    IF zeichen pos <> 0 

+      THEN zeichen := (zeile SUB zeichen pos);

+           LEAVE naechstes non blank zeichen

+    ELIF eof (eingabe) 

+      THEN zeichen := end of program;

+           LEAVE naechstes non blank zeichen

+      ELSE zeile lesen

+    FI

+  END REP.

+END PROC naechstes non blank zeichen; 

+ 

+PROC naechstes zeichen: 

+  IF zeichen pos > length (zeile) 

+    THEN IF eof (eingabe) 

+           THEN zeichen := end of program;

+                LEAVE naechstes zeichen

+           ELSE zeile lesen 

+         FI 

+  FI; 

+  zeichenpos INCR 1; 

+  zeichen := zeile SUB zeichenpos

+END PROC naechstes zeichen; 

+ 

+INT PROC line number:

+  IF zeichenpos = pos (zeile, ""33"", ""254"", 1)

+    THEN zeilen nr - 1 

+    ELSE zeilen nr 

+  FI

+END PROC line number; 

+ 

+PROC symbol (INT VAR symb, type): 

+  REP 

+    suche naechstes checker symbol 

+  END REP. 

+ 

+suche naechstes checker symbol: 

+  SELECT code (zeichen) OF

+  CASE 30: (* end of programn *)

+    symb := eop; 

+    type := eop; 

+    LEAVE symbol

+  CASE 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110,

+       111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122:

+    (* small letters *)

+    identifier aufsammeln; 

+    put name (CONCR (tabelle), dummy, symb); 

+    type := identifier;

+    LEAVE symbol

+  CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,

+       82, 83, 84, 85, 86, 87, 88, 89, 90: (* large letters *)

+    schluesselwort aufsammeln; 

+    put name (CONCR (tabelle), dummy, symb); 

+    type := keyword; 

+    LEAVE symbol

+  CASE 34: (* " *)

+    skip text denoter 

+  CASE 40: (* ( *) 

+    IF (zeile SUB zeichen pos + 1) = "*" 

+      THEN skip comment 

+      ELSE symb := code (zeichen);

+           type := delimiter;

+           naechstes non blank zeichen;

+           LEAVE symbol;

+    FI 

+  CASE 58: (* : *) 

+    IF (zeile SUB zeichenpos + 1) = "=" 

+      THEN symb := assign symbol;

+           zeichenpos INCR 1

+    ELIF (zeile SUB zeichenpos + 1) = ":" 

+      THEN symb := init symbol; 

+           zeichenpos INCR 1 

+      ELSE symb := doppelpunkt 

+    FI; 

+    type := delimiter; 

+    naechstes non blank zeichen;

+    LEAVE symbol

+  CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: (* 0 - 9 *)

+    int denoter skippen;

+    IF zeichen = "."

+      THEN naechstes non blank zeichen;

+           IF digit

+             THEN real denoter skippen

+             ELSE symb := punkt; 

+                  type := delimiter;

+                  LEAVE symbol

+           FI

+    FI

+  CASE 41, 44, 46, 59, 61: (* ) , . ; =  *) 

+    symb := code (zeichen); 

+    type := delimiter; 

+    naechstes non blank zeichen; 

+    LEAVE symbol

+  OTHERWISE naechstes non blank zeichen

+  END SELECT.

+END PROC symbol; 

+ 

+PROC real denoter skippen:

+  int denoter skippen;

+  IF zeichen = "e" 

+    THEN naechstes non blank zeichen;

+         int denoter skippen

+  FI

+END PROC real denoter skippen;

+

+PROC int denoter skippen:

+  naechstes non blank zeichen;

+  WHILE zeichen >= "0" AND zeichen <= "9" REP

+    naechstes non blank zeichen

+  ENDREP;

+  zeichenpos DECR 1;

+  naechstes non blank zeichen

+END PROC int denoter skippen;

+

+PROC identifier aufsammeln:

+  dummy := zeichen; 

+  REP 

+    naechstes non blank zeichen; 

+    IF small letter or digit 

+      THEN dummy CAT zeichen 

+      ELSE LEAVE identifier aufsammeln 

+    FI 

+  END REP 

+END PROC identifier aufsammeln; 

+ 

+PROC schluesselwort aufsammeln:

+  dummy := "";

+  sammle schluesselwort; 

+  IF dummy = "END" 

+    THEN noch einmal 

+  FI.

+ 

+sammle schluesselwort: 

+  WHILE large letter REP 

+    dummy CAT zeichen;

+    naechstes zeichen

+  END REP; 

+  IF zeichen = " "

+    THEN naechstes non blank zeichen

+  FI.

+ 

+noch einmal: 

+  sammle schluesselwort

+END PROC schluesselwort aufsammeln; 

+ 

+PROC skip text denoter: 

+  INT VAR anz zeilen :: 0; 

+  zeichen pos := pos (zeile, """", zeichenpos + 1);

+  WHILE zeichen pos = 0 REP 

+    naechste zeile einlesen;

+    zeichen pos := pos (zeile, """");

+  END REP;

+  ende text denoter.

+ 

+ende text denoter: 

+  IF anz zeilen > 1 

+    THEN report referencer error (1, zeilen nr, text (anz zeilen))

+  FI; 

+  naechstes non blank zeichen. 

+ 

+naechste zeile einlesen: 

+  IF eof (eingabe) 

+    THEN report referencer error (2, zeilen nr, text (anz zeilen));

+         zeichen := end of program; 

+         LEAVE skip text denoter 

+    ELSE zeile lesen;

+         anz zeilen INCR 1 

+  FI.

+END PROC skip text denoter; 

+

+PROC skip comment:

+  INT VAR anz zeilen :: 0;

+  zeichen pos := pos (zeile, "*)", zeichenpos + 2);

+  WHILE zeichen pos = 0 REP 

+    naechste zeile einlesen; 

+    zeichen pos := pos (zeile, "*)"); 

+  END REP;

+  ende comment.

+ 

+ende comment:

+  IF anz zeilen > 1 

+    THEN report referencer error (3, zeilen nr, text (anz zeilen))

+  FI; 

+  zeichen pos INCR 2;

+  naechstes non blank zeichen. 

+ 

+naechste zeile einlesen: 

+  IF eof (eingabe) 

+    THEN report referencer error (4, zeilen nr, text (anz zeilen));

+         zeichen := end of program; 

+         LEAVE skip comment

+    ELSE zeile lesen;

+         anz zeilen INCR 1 

+  FI.

+END PROC skip comment;

+

+BOOL PROC small letter or digit: 

+  (zeichen >= "0" AND zeichen <= "9") OR (zeichen >= "a" AND zeichen <= "z") 

+END PROC small letter or digit; 

+ 

+BOOL PROC small letter: 

+  zeichen >= "a" AND zeichen <= "z" 

+END PROC small letter; 

+ 

+BOOL PROC large letter:

+  zeichen >= "A" AND zeichen <= "Z"

+END PROC large letter;

+ 

+BOOL PROC digit:

+  zeichen >= "0" AND zeichen <= "9"

+END PROC digit;

+END PACKET scanner;

+(*************************************************************************)

+PACKET referencer2 DEFINES referencer:

+ 

+(* Programm fuer den 'referencer'

+   Autor: Rainer Hahn

+   Stand: 19.03.84

+*)

+INT VAR symb,

+        typ,

+        max index;

+ 

+TEXT VAR dummy,

+         dummy2,

+         name;

+ 

+DATASPACE VAR ds;

+ 

+BOUND ROW max TEXT VAR liste; 

+ 

+FILE VAR f; 

+ 

+BOOL VAR initialisiert :: FALSE,

+         symbol bereits geholt,

+         globale deklarationen;

+ 

+LET max = 1751,

+    global text     = "<--G", 

+    local text      = "<--L", 

+    refinement text = "<--R",

+    procedure text  = "<--P",

+    eop           = 1, 

+    identifier    = 2, 

+    keyword       = 3, 

+    init symbol   = 30, 

+    assign symbol = 31,

+    klammer auf   = 40, 

+    klammer zu    = 41,

+    komma         = 44,

+    punkt         = 46,

+    doppelpunkt   = 58, 

+    semikolon     = 59, 

+    proc symbol       = 255, 

+    end proc symbol   = 256,

+    packet symbol     = 257, 

+    end packet symbol = 258,

+    type symbol       = 259, 

+    var symbol        = 260,

+    const symbol      = 261,

+    let symbol        = 262,

+    leave symbol      = 263,

+    op symbol         = 264,

+    endop symbol      = 265,

+    endif symbol      = 266,

+    fi symbol         = 266;

+ 

+PROC referencer: 

+  referencer (last param) 

+END PROC referencer; 

+ 

+PROC referencer (TEXT CONST check file): 

+  referencer (check file, check file + ".r") 

+END PROC referencer; 

+ 

+PROC referencer (TEXT CONST check file, dump file):

+  IF exists (check file)

+    THEN dump file ueberpruefen

+    ELSE errorstop ("Eingabe-Datei nicht vorhanden")

+  FI.

+ 

+dump file ueberpruefen:

+ IF exists (dump file)

+   THEN errorstop ("Ausgabe-Datei existiert bereits")

+   ELSE disable stop;

+        start referencing (check file, dump file);

+        forget (ds);

+        enable stop;

+ FI

+END PROC referencer;

+ 

+PROC start referencing (TEXT CONST check file, dump file):

+  enable stop;

+  ueberschrift;

+  initialisierung;

+  verkuerzte syntax analyse;

+  line;

+  in dump file kopieren (dump file);

+  line;

+  end scanning (check file).

+ 

+ueberschrift:

+  page;

+  put ("REFERENCER:");

+  put (check file);

+  put ("->");

+  put (dump file);

+  line.

+ 

+initialisierung:

+  IF NOT initialisiert

+    THEN init name table with

+("PROC,ENDPROC,PACKET,ENDPACKET,TYPE,VAR,CONST,LET,LEAVE,OP,ENDOP,ENDIF,FI"); 

+         initialisiert := TRUE

+  FI; 

+  ds := nilspace;

+  liste := ds;

+  maxindex := endop symbol;

+  dummy := checkfile.

+ 

+verkuerzte syntax analyse: 

+  globale deklarationen := TRUE;

+  line;

+  init scanning (dummy);

+  symbol bereits geholt := FALSE;

+  REP 

+    IF symbol bereits geholt 

+      THEN symbol bereits geholt := FALSE 

+      ELSE symbol (symb, typ)

+    FI;

+    IF typ = keyword 

+      THEN nach schluesselwort verarbeiten

+    ELIF symb = punkt

+      THEN ggf refinement aufnehmen

+    ELIF typ = identifier 

+      THEN identifier aufnehmen und ggf aktuelle parameter liste

+    FI

+  UNTIL typ = eop ENDREP. 

+ 

+identifier aufnehmen und ggf aktuelle parameter liste:

+  in die liste (symb, "");

+  symbol (symb, typ); 

+  IF symb = klammer auf 

+    THEN aktuelle parameter aufnehmen 

+    ELSE symbol bereits geholt := TRUE 

+  FI. 

+

+nach schluesselwort verarbeiten:

+  SELECT symb OF 

+  CASE let symbol:

+    let deklarationen aufsammeln

+  CASE packet symbol:

+    namen des interface aufsammeln

+  CASE end packet symbol:

+    skip naechstes symbol 

+  CASE var symbol, const symbol:

+    datenobjekt deklaration aufnehmen

+  CASE proc symbol:

+    globale deklarationen := FALSE; 

+    prozedur name und ggf parameter aufsammeln

+  CASE end proc symbol:

+    globale deklarationen := TRUE;

+    skip naechstes symbol

+  CASE op symbol: 

+    globale deklarationen := FALSE; 

+    operatornamen skippen und ggf parameter aufsammeln 

+  CASE end op symbol: 

+    globale deklarationen := TRUE; 

+    skip until (semikolon) 

+  CASE type symbol: 

+    namen der typ definition aufsammeln

+  CASE leave symbol: 

+    skip naechstes symbol

+  OTHERWISE: 

+  ENDSELECT. 

+ 

+skip naechstes symbol: 

+  symbol (symb, typ). 

+END PROC start referencing;

+

+PROC aktuelle parameter aufnehmen: 

+  REP 

+    symbol (symb, typ); 

+    IF typ = identifier 

+      THEN in die liste (symb, "") 

+    FI 

+  UNTIL symb = klammer zu END REP. 

+END PROC aktuelle parameter aufnehmen; 

+ 

+PROC ggf refinement aufnehmen:

+  symbol (symb, typ); 

+  symbol bereits geholt := TRUE;

+  WHILE typ = identifier REP 

+    doppelpunkt oder selektor

+  END REP.

+ 

+doppelpunkt oder selektor:

+  INT CONST letzter id :: symb; 

+  symbol (symb, typ);

+  IF symb = doppelpunkt

+    THEN in die liste (letzter id, refinement text);

+         LEAVE ggf refinement aufnehmen

+    ELSE in die liste (letzter id, "");

+         IF symb = punkt 

+           THEN symbol (symb, typ) 

+           ELSE LEAVE ggf refinement aufnehmen

+         FI

+  FI

+END PROC ggf refinement aufnehmen; 

+ 

+PROC namen des interface aufsammeln: 

+  packet name ueberspringen;

+  namen der schnittstelle aufsammeln. 

+ 

+packet name ueberspringen: 

+  symbol (symb, typ).

+ 

+namen der schnittstelle aufsammeln:

+  REP 

+    symbol (symb, typ);

+    IF typ = identifier 

+      THEN in die liste (symb, "")

+    FI

+  UNTIL symb = doppelpunkt END REP.

+END PROC namen des interface aufsammeln; 

+ 

+PROC let deklarationen aufsammeln:

+  REP

+    symbol (symb, typ);

+    IF typ = identifier 

+      THEN let name aufnehmen

+    ELIF typ = keyword 

+      THEN bis zum komma oder semikolon

+    FI;

+  UNTIL symb = semikolon END REP.

+

+let name aufnehmen: 

+  IF globale deklarationen

+    THEN in die liste (symb, global text)

+    ELSE in die liste (symb, "")

+  FI;

+  REP

+    symbol (symb, typ);

+    IF typ = identifier

+      THEN in die liste (symb, "")

+    FI

+  UNTIL symb = komma OR symb = semikolon END REP. 

+END PROC let deklarationen aufsammeln;

+

+PROC namen der typ definition aufsammeln: 

+  REP 

+    symbol (symb, typ); 

+    bis zum komma oder semikolon

+  UNTIL symb = semikolon END REP 

+END PROC namen der typ definition aufsammeln;

+

+PROC bis zum komma oder semikolon: 

+  INT VAR anz klammern :: 0; 

+  REP 

+    symbol (symb, typ); 

+    (* fields aufnehmen weggelassen *)

+    IF symb = klammer auf 

+      THEN anz klammern INCR 1 

+    ELIF symb = klammer zu

+      THEN anz klammern DECR 1

+    FI

+  UNTIL (symb = komma AND anz klammern = 0) OR symb = semikolon ENDREP.

+END PROC bis zum komma oder semikolon; 

+ 

+PROC datenobjekt deklaration aufnehmen:

+  symbol (symb, typ); 

+  REP 

+    IF globale deklarationen

+      THEN in die liste (symb, global text) 

+      ELSE in die liste (symb, local text) 

+    FI; 

+    skip ggf initialisierung;

+    IF symb = komma 

+      THEN symbol (symb, typ) 

+    FI

+  UNTIL symb = semikolon END REP.

+

+skip ggf initialisierung: 

+  symbol (symb, typ); 

+  IF symb = init symbol OR symb = assign symbol

+    THEN initialisierung skippen

+  FI.

+ 

+initialisierung skippen: 

+  INT VAR anz klammern :: 0;

+  REP 

+    INT CONST vorheriges symbol :: symb,

+              vorheriger typ    :: typ;

+    symbol (symb, typ); 

+    IF symb = klammer auf 

+      THEN anz klammern INCR 1;

+           IF vorheriger typ = identifier 

+             THEN in die liste (vorheriges symbol, "") 

+           FI

+    ELIF symb = klammer zu 

+      THEN anz klammern DECR 1; 

+           IF vorheriger typ = identifier 

+             THEN in die liste (vorheriges symbol, "") 

+           FI

+    ELIF vorheriger typ = identifier AND symb = doppelpunkt

+      THEN in die liste (vorheriges symbol, refinement text); 

+           LEAVE datenobjekt deklaration aufnehmen

+    ELIF vorheriger typ = identifier 

+      THEN in die liste (vorheriges symbol, "")

+    FI

+  UNTIL (symb = komma AND anz klammern = 0)

+         OR symb = semikolon OR symb = end proc symbol OR 

+         symb = end op symbol OR symb = endif symbol OR symb = fi symbol

+  END REP.

+END PROC datenobjekt deklaration aufnehmen; 

+ 

+PROC prozedur name und ggf parameter aufsammeln: 

+  prozedurname aufsammeln;

+  symbol (symb, typ); 

+  IF symb <> doppelpunkt

+    THEN formale parameter aufsammeln

+  FI. 

+ 

+prozedurname aufsammeln:

+  symbol (symb, typ); 

+  in die liste (symb, procedure text).

+END PROC prozedurname und ggf parameter aufsammeln; 

+ 

+PROC operatornamen skippen und ggf parameter aufsammeln: 

+  symbol (symb, typ);

+  IF symb <> doppelpunkt

+    THEN formale parameter aufsammeln 

+  FI 

+END PROC operatornamen skippen und ggf parameter aufsammeln;

+ 

+PROC formale parameter aufsammeln: 

+  REP 

+    symbol (symb, typ); 

+    IF typ = identifier 

+      THEN in die liste (symb, local text); 

+    FI 

+  UNTIL symb = doppelpunkt END REP 

+END PROC formale parameter aufsammeln; 

+ 

+PROC skip until (INT CONST zeichencode): 

+  skip until (zeichencode, 0) 

+END PROC skip until; 

+ 

+PROC skip until (INT CONST z1, z2):

+  REP 

+    symbol (symb, typ) 

+  UNTIL symb = z1 OR symb = z2 END REP

+END PROC skip until; 

+ 

+PROC in die liste (INT CONST index, TEXT CONST zusatz): 

+  IF index > max index 

+    THEN listenelemente initialisieren; 

+  FI;

+  IF aktueller eintrag = "" 

+    THEN namens eintrag 

+  FI;

+  aktueller eintrag CAT " ";

+  aktueller eintrag CAT text (line number);

+  aktueller eintrag CAT zusatz.

+ 

+aktueller eintrag: 

+  liste [index]. 

+ 

+listenelemente initialisieren: 

+  INT VAR i; 

+  FOR i FROM max index + 1 UPTO index REP 

+     liste [i] := ""

+  END REP; 

+  max index := index.

+ 

+namens eintrag:

+  get name (index, aktueller eintrag);

+  WHILE length (aktueller eintrag) < 15 REP 

+    aktueller eintrag CAT " "

+  END REP; 

+  aktueller eintrag CAT ":".

+END PROC in die liste; 

+ 

+TEXT VAR zeile;

+

+PROC in dump file kopieren (TEXT CONST dump file): 

+  put ("Ausgabedatei erstellen"); 

+  line;

+  f := sequential file (output, dump file); 

+  INT VAR i; 

+  kopieren und ggf fehlermeldung;

+  modify (f);

+  ggf sortieren;

+  zeile ggf aufspalten.

+

+kopieren und ggf fehlermeldung:

+  FOR i FROM fi symbol UPTO max index REP 

+    cout (i);

+    zeile := liste [i];

+    IF zeile <> "" 

+      THEN ausgabe der referenz und ggf fehlermeldung

+    FI 

+  ENDREP.

+ 

+ausgabe der referenz und ggf fehlermeldung:

+  putline (f, zeile);

+  ggf referencer fehlermeldung.

+ 

+ggf sortieren:

+  IF yes (dump file + " sortieren")

+    THEN sort (dump file);

+  FI.

+

+zeile ggf aufspalten: 

+  i := 0;

+  to line (f, 1);

+  WHILE NOT eof (f) REP

+    i INCR 1;

+    cout (i);

+    read record (f, zeile);

+    ggf aufspalten

+  END REP.

+

+ggf aufspalten:

+INT VAR anf :: 1, ende :: pos (zeile, " ", 72); 

+  IF ende > 0

+    THEN dummy := subtext (zeile, 1, ende - 1);

+         write record (f, dummy);

+         spalte bis restzeile auf;

+         dummy CAT subtext (zeile, anf); 

+         write record (f, dummy);

+  FI;

+  down (f).

+

+spalte bis restzeile auf:

+   REP 

+     dummy :=  "                 ";

+     anf := ende + 1;

+     ende := pos (zeile, " ", ende + 55);

+     down (f);

+     insert record (f);

+     IF ende <= 0

+       THEN LEAVE spalte bis restzeile auf

+     FI;

+     dummy CAT subtext (zeile, anf, ende - 1); 

+     write record (f, dummy); 

+  END REP.

+END PROC in dump file kopieren; 

+ 

+PROC ggf referencer fehlermeldung:

+  name := subtext (zeile, 1, min( pos(zeile, " "), pos(zeile, ":")) - 1);

+  dummy := subtext (zeile, pos (zeile, ": ") + 2); 

+  ueberdeckungs ueberpruefung; 

+  not used ueberpruefung; 

+  IF pos (dummy, "R") > 0

+    THEN refinement mehr als zweimal verwendet

+  FI.

+ 

+ueberdeckungs ueberpruefung: 

+  IF pos (dummy, global text) > 0 AND pos (dummy, local text) > 0 

+    THEN dummy2 := "und Zeile "; 

+         dummy2 CAT text (nr (pos (dummy, local text))); 

+         dummy2 CAT ": "; 

+         dummy2 CAT name;

+         report referencer error

+            (5, nr (pos (dummy, global text)), dummy2) 

+  FI. 

+ 

+not used ueberpruefung: 

+  IF pos (dummy, " ") = 0 AND

+     (pos (dummy, global text) > 0 OR pos (dummy, local text) > 0 OR

+      pos (dummy, refinement text) > 0)

+    THEN not used fehlermeldung

+  FI. 

+ 

+not used fehlermeldung: 

+  report referencer error

+  (8, nr (length (dummy) - length (local text) + 1), name).

+ 

+refinement mehr als zweimal verwendet: 

+  INT VAR refinement deklarationen :: 0, 

+          refinement aufrufe       :: 0, 

+          anf                      :: 1;

+  WHILE pos (dummy,"R", anf) > 0 REP

+    refinement deklarationen INCR 1; 

+    anf := pos (dummy, "R", anf) + 1 

+  END REP; 

+  anf := 1; 

+  WHILE pos (dummy, " ", anf) > 0 REP

+    refinement aufrufe INCR 1; 

+    anf := pos (dummy, " ", anf) + 1 

+  END REP; 

+  IF refinement deklarationen = 1 

+    THEN IF refinement aufrufe > 1 

+           THEN report referencer error

+                     (6, nr (pos (dummy, refinement text)), name) 

+         ELIF refinement aufrufe = 0 

+           THEN report referencer error

+                     (7, nr (pos (dummy, refinement text)), name) 

+         FI

+  ELIF refinement deklarationen > 1 

+    THEN IF 2 * refinement deklarationen - 1 > refinement aufrufe

+           THEN report referencer error (9, 0, name)

+         ELIF 2 * refinement deklarationen - 1 < refinement aufrufe

+           THEN report referencer error (10, 0, name)

+         FI

+  FI.

+END PROC ggf referencer fehlermeldung; 

+ 

+INT PROC nr (INT CONST ende): 

+  INT VAR von :: ende - 1; 

+  WHILE von > 0 AND ((dummy SUB von) >= "0" AND (dummy SUB von) <= "9") REP 

+    von DECR 1 

+  END REP; 

+  int (subtext (dummy, von + 1, ende - 1)) 

+END PROC nr; 

+ 

+END PACKET referencer2;

diff --git a/system/std.zusatz/1.7.3/src/reporter b/system/std.zusatz/1.7.3/src/reporter
new file mode 100644
index 0000000..13e76b5
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/reporter
@@ -0,0 +1,479 @@
+PACKET reporter routines DEFINES generate counts,

+                                 count on,

+                                 count off,

+                                 generate reports,

+                                 eliminate reports,

+                                 assert,

+                                 report on,

+                                 report off,

+                                 report:

+

+(* Programm zur Ablaufverfolgung von ELAN Programmen. Das Programm 

+   verfolgt Prozedur- und Refinementaufrufe ('trace') und erstellt

+   eine Haeufigkeitszaehlung ('frequency count') und beachtet 'assertions'.

+ 

+   Autor: Rainer Hahn 

+   Letzte Aenderung: 11.01.84  

+   Ausgabe der Gesamtaufrufe (Jan. 84) 

+*)

+

+FILE VAR input file;

+

+INT VAR zeilen nr,

+        type;

+ 

+TEXT VAR zeile,

+         dummy,

+         dummy1,

+         symbol;

+ 

+LET quadro fis = "####",

+    triple fis = "###",

+    double fis = "##",

+

+    tag = 1 ;

+

+DATASPACE VAR ds := nilspace;

+BOUND ROW max STRUCT (INT anzahl, BOOL proc) VAR zaehlwerk;

+

+LET max = 2000;

+

+(******************* gen report-Routinen ******************************) 

+ 

+PROC generate reports:

+  generate reports (last param)

+END PROC generate reports;

+

+PROC generate reports (TEXT CONST name):

+  disable stop; 

+  gen trace statements (name); 

+  IF is error AND error message = "ende"

+    THEN clear error

+  FI;

+  last param (name);

+  enable stop. 

+END PROC generate reports;

+

+PROC gen trace statements (TEXT CONST name):

+  enable stop;

+  IF exists (name) 

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist") 

+  FI;

+  input file modifizieren

+END PROC gen trace statements; 

+ 

+(*************************** Test file modifizieren *****************) 

+ 

+PROC input file modifizieren:

+  zeilen nr := 1;

+  to first record (input file); 

+  WHILE NOT eof (input file) REP 

+    lese zeile;

+    IF triple fis symbol

+      THEN wandele in quadro fis

+    FI;

+    IF proc oder op symbol

+      THEN verarbeite operator oder prozedurkopf

+    ELIF refinement symbol

+      THEN verarbeite ggf refinements

+    FI;

+    down (input file)

+  END REP.

+ 

+triple fis symbol:

+  pos (zeile, triple fis) > 0 AND 

+       (pos (zeile, triple fis) <> pos (zeile, quadro fis)).

+

+wandele in quadro fis:

+  change all (zeile, triple fis, quadro fis);

+  write record (input file, zeile).

+

+proc oder op symbol:

+  pos (zeile, "PROC") > 0 OR pos (zeile, "OP") > 0.

+

+verarbeite operator oder prozedurkopf:

+  IF NOT (pos (zeile, "END") > 0)

+    THEN scanne kopf;

+         insertiere trace anweisung

+  FI.

+

+scanne kopf:

+  scan (zeile);

+  REP

+    next symbol (symbol, type);

+    IF ende der zeile gescannt

+      THEN vorwaerts;

+           lese zeile;

+           continue scan (zeile);

+           next symbol (symbol, type)

+    FI

+  UNTIL symbol = "PROC" OR symbol = "OP" END REP;

+  baue trace statement fuer kopf auf.

+

+baue trace statement fuer kopf auf:

+  dummy := double fis;

+  dummy CAT "report(""";

+  dummy CAT symbol;

+  dummy CAT " ";

+  IF ende der zeile gescannt

+    THEN vorwaerts;

+         lese zeile;

+         continue scan (zeile)

+  FI;

+  next symbol (symbol, type);

+  dummy CAT symbol;

+  dummy CAT " ";

+  next symbol (symbol, type);

+  IF type = tag

+    THEN dummy CAT symbol

+  FI.

+

+ende der zeile gescannt:

+  type >= 7.

+

+insertiere trace anweisung:

+  WHILE pos (zeile, ":") = 0 REP

+    vorwaerts;

+    lese zeile

+  END REP;

+  schreibe zeile mit report statement.

+

+refinement symbol:

+  INT CONST point pos :=  pos (zeile, ".") ;

+  point pos > 0 AND point pos >= length (zeile) - 1.

+

+verarbeite ggf refinements:

+  ueberlies leere zeilen ; 

+  IF ist wirklich refinement

+    THEN insertiere report fuer refinement

+  FI .

+

+ueberlies leere zeilen :

+  REP 

+    vorwaerts;

+    lese zeile

+  UNTIL pos (zeile, ""33"", ""254"", 1) > 0 PER .

+ 

+ist wirklich refinement :

+  scan (zeile) ;

+  next symbol (symbol, type) ;

+  next symbol (symbol) ;

+  symbol = ":" AND type = tag .

+

+insertiere report fuer refinement:

+  dummy := double fis;

+  dummy CAT "report(""";

+  dummy1 := subtext (zeile, 1, pos (zeile, ":") - 1);

+  dummy CAT dummy1;

+  schreibe zeile mit report statement

+END PROC input file modifizieren; 

+ 

+PROC schreibe zeile mit report statement:

+  dummy CAT """);";

+  dummy CAT double fis;

+  IF doppelpunkt steht am ende der zeile

+    THEN (********** bei neuer Compiler-Version aendern:

+          fuelle zeile ggf auf 75 spalten auf;

+          zeile CAT dummy

+          die naechste drei zeilen dann loeschen **************)

+         down (input file);

+         insert record (input file);

+         write record (input file, dummy)

+    ELSE insert char (dummy, ":", 1);

+         change (zeile, ":", dummy);

+         write record (input file, zeile)

+  FI.

+

+doppelpunkt steht am ende der zeile:

+  pos (zeile, ":") >= length (zeile) - 1.

+

+(* Kommentarklammern beineuer Compiler Version hier weg:

+fuelle zeile ggf auf 75 spalten auf:

+  IF length (zeile) < 75

+    THEN dummy1 := (75 - length (zeile)) * " ";

+         zeile CAT dummy1

+  FI.*)

+END PROC schreibe zeile mit report statement;

+ 

+PROC vorwaerts:

+    down (input file);

+    IF eof (input file) 

+      THEN errorstop ("ende")

+    FI

+END PROC vorwaerts;

+

+PROC lese zeile:

+  read record (input file, zeile); 

+  cout (zeilen nr); 

+  zeilen nr INCR 1

+END PROC lese zeile;

+

+(************************ eliminate reports-Routinen ******************)

+

+PROC eliminate reports:

+  eliminate reports (last param)

+END PROC eliminate reports;

+

+PROC eliminate reports (TEXT CONST name): 

+  disable stop; 

+  eliminate statements (name); 

+  IF is error AND error message = "ende"

+    THEN clear error

+  FI;

+  last param (name);

+  enable stop. 

+END PROC eliminate reports;

+

+PROC eliminate statements (TEXT CONST name): 

+  enable stop;

+  IF exists (name) 

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist") 

+  FI;

+  statements entfernen.

+

+statements entfernen:

+  to first record (input file);

+  zeilen nr := 1;

+  WHILE NOT eof (input file) REP

+    lese zeile;

+    IF pos (zeile, double fis) > 0

+      THEN eliminiere zeichenketten in dieser zeile

+      ELSE down (input file)

+    FI

+  END REP.

+

+eliminiere zeichenketten in dieser zeile:

+  INT VAR anfang := pos (zeile, double fis);

+  WHILE es ist noch etwas zu eliminieren REP

+    IF es ist ein quadro fis

+      THEN wandele es in ein triple fis

+    ELIF es ist ein triple fis

+      THEN lass diese sequenz stehen

+      ELSE entferne zeichenkette

+    FI

+  END REP;

+  IF zeile ist jetzt leer

+    THEN delete record (input file)

+    ELSE write record (input file, zeile);

+         down (input file)

+  FI.

+

+es ist noch etwas zu eliminieren:

+  anfang > 0.

+ 

+es ist ein quadro fis:

+  pos (zeile, quadro fis, anfang) = anfang.

+

+wandele es in ein triple fis:

+  delete char (zeile, anfang);

+  anfang := pos (zeile, double fis, anfang + 3).

+

+es ist ein triple fis:

+  pos (zeile, triple fis, anfang) = anfang.

+

+lass diese sequenz stehen:

+  anfang := pos (zeile, triple fis, anfang + 1) + 3.

+

+entferne zeichenkette:

+  INT VAR end := pos (zeile, double fis, anfang+2) ;

+  IF end > 0

+    THEN change (zeile, anfang, end + 1, "");

+         anfang := pos (zeile, double fis, anfang)

+    ELSE anfang := pos (zeile, double fis, anfang+2) 

+  FI .

+

+zeile ist jetzt leer:

+  pos (zeile, ""33"", ""254"", 1) = 0.

+END PROC eliminate statements; 

+

+(********************** Trace-Routinen *******************************) 

+ 

+FILE VAR trace file;

+

+BOOL VAR trace on, haeufigkeit on;

+

+PROC report (TEXT CONST message):

+  IF NOT exists ("TRACE")

+    THEN trace file := sequential file (output, "TRACE");

+         trace on := TRUE;

+         haeufigkeit on := FALSE;

+  FI;

+  BOOL CONST ist prozedur ::

+               (pos (message, "PROC") > 0 OR pos (message, "OP") > 0);

+  IF trace on

+    THEN ablauf verfolgung

+  FI;

+  IF haeufigkeit on

+    THEN haeufigkeits zaehlung (ist prozedur)

+  FI.

+

+ablauf verfolgung:

+  dummy := text (pcb (1));

+  dummy CAT ": ";

+  IF NOT ist prozedur

+    THEN dummy CAT "    "

+  FI;

+  dummy CAT message;

+  putline (trace file, dummy). 

+END PROC report;

+ 

+PROC report (TEXT CONST message, INT CONST value):

+  report (message, text (value))

+END PROC report;

+

+PROC report (TEXT CONST message, REAL CONST value):

+  report (message, text (value))

+END PROC report;

+ 

+PROC report (TEXT CONST message, TEXT CONST value):

+  dummy1 := message;

+  dummy1 CAT ": ";

+  dummy1 CAT value;

+  report (dummy1)

+END PROC report;

+

+PROC report (TEXT CONST message, BOOL CONST value):

+  dummy1 := message;

+  dummy1 CAT ": ";

+  IF value

+    THEN dummy1 CAT "TRUE"

+    ELSE dummy1 CAT "FALSE"

+  FI;

+  report (dummy1)

+END PROC report;

+

+PROC report on: 

+  trace on := TRUE;

+  dummy1 := "REPORT ---> ON";

+  report (dummy1)

+END PROC report on;

+ 

+PROC report off: 

+  dummy1 := "REPORT ---> OFF";

+  report (dummy1);

+  trace on := FALSE;

+END PROC report off; 

+

+PROC assert (BOOL CONST value):

+  assert ("", value)

+END PROC assert;

+

+PROC assert (TEXT CONST message, BOOL CONST value):

+  dummy1 := "ASSERTION:";

+  dummy1 CAT message;

+  dummy1 CAT " ---> ";

+  IF value

+    THEN dummy1 CAT "TRUE"

+    ELSE line;

+         put ("ASSERTION:"); 

+         put (message);

+         put ("---> FALSE");

+         line;

+         IF yes ("weiter")

+           THEN dummy1 CAT "FALSE"

+           ELSE errorstop ("assertion failed")

+         FI

+  FI;

+  report (dummy1)

+END PROC assert;

+

+(************************** haeufigkeits-zaehlung ****************)

+

+PROC count on:

+  report ("COUNT ---> ON");

+  haeufigkeit on := TRUE;

+  initialisiere haeufigkeit.

+

+initialisiere haeufigkeit:

+  INT VAR i;

+  forget (ds);

+  ds := nilspace;

+  zaehlwerk := ds;

+  FOR i FROM 1 UPTO max REP

+    zaehlwerk [i] . anzahl := 0

+  END REP

+END PROC count on;

+

+PROC count off:

+  report ("COUNT ---> OFF");

+  haeufigkeit on := FALSE

+END PROC count off;

+

+PROC haeufigkeits zaehlung (BOOL CONST ist prozedur):

+  IF pcb (1) <= max

+    THEN zaehlwerk [pcb (1)]. anzahl INCR 1;

+         zaehlwerk [pcb (1)] . proc := ist prozedur

+FI

+END PROC haeufigkeits zaehlung;

+

+PROC generate counts:

+  generate counts (last param)

+END PROC generate counts;

+

+PROC generate counts (TEXT CONST name): 

+  disable stop; 

+  insert counts (name); 

+  last param (name);

+  enable stop. 

+END PROC generate counts;

+

+PROC insert counts (TEXT CONST name):

+  enable stop;

+  IF exists (name)

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist")

+  FI;

+  counts insertieren;

+  dataspace loeschen;

+  statistik ausgeben.

+ 

+counts insertieren:

+  REAL VAR gesamt aufrufe :: 0.0, 

+           proc   aufrufe :: 0.0, 

+           andere aufrufe :: 0.0; 

+  zeilen nr := 1;

+  WHILE zeilennr <= lines (input file) REP

+    cout (zeilen nr);

+    IF zaehlwerk [zeilen nr] . anzahl > 0

+      THEN anzahl aufrufe in die eingabe zeile einfuegen;

+           aufrufe mitzaehlen

+    FI;

+    zeilen nr INCR 1

+  END REP.

+

+anzahl aufrufe in die eingabe zeile einfuegen: 

+  to line (input file, zeilen nr);

+  read record (input file, zeile);

+  dummy := double fis;

+  dummy1 := text (zaehlwerk [zeilen nr] . anzahl);

+  dummy CAT dummy1;

+  dummy CAT double fis;

+  change (zeile, 1, 0, dummy);

+  write record (input file, zeile).

+

+aufrufe mitzaehlen: 

+  gesamt aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl); 

+  IF zaehlwerk [zeilen nr] . proc 

+    THEN proc aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) 

+    ELSE andere aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) 

+  FI. 

+ 

+dataspace loeschen:

+  forget (ds).

+ 

+statistik ausgeben: 

+  line (2); 

+  put ("Anzahl der Gesamtaufrufe:"); 

+  put (gesamt aufrufe); 

+  line; 

+  put ("davon:"); 

+  line; 

+  put (proc aufrufe); put ("Prozeduren oder Operatoren"); 

+  line; 

+  put (andere aufrufe); put ("Refinements und andere"); 

+  line. 

+END PROC insert counts;

+

+END PACKET reporter routines;

diff --git a/system/std.zusatz/1.7.3/src/scheduler b/system/std.zusatz/1.7.3/src/scheduler
new file mode 100644
index 0000000..7a76f10
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/scheduler
@@ -0,0 +1,419 @@
+ 

+PACKET std schedule strategy DEFINES                (* Autor: J.Liedtke *)

+                                                    (* Stand: 15.10.82  *)

+    strategic decision :

+

+

+PROC strategic decision 

+              (INT CONST foreground workers, background workers,

+               REAL CONST fore cpu load, back cpu load, paging load,

+               INT VAR lowest activation prio, max background tasks) :

+ 

+  IF no background permitted

+    THEN lowest activation prio := 0 ;

+         max background tasks := 0

+    ELSE lowest activation prio := 10 ;

+         select max background tasks

+  FI .

+ 

+no background permitted :

+      foreground workers > 0 AND fore cpu load > 0.03 .

+

+select max background tasks :

+  IF fore cpu load > 0.01

+    THEN max background tasks := 1

+  ELIF paging load < 0.07

+    THEN max background tasks := 3

+  ELIF paging load < 0.15

+    THEN max background tasks := 2

+    ELSE max background tasks := 1

+  FI .

+

+ENDPROC strategic decision ;

+

+ENDPACKET std schedule strategy ;

+

+

+                                              (* Autor: J.Liedtke*)

+PACKET eumelmeter DEFINES                     (* Stand: 11.10.83 *)

+ 

+     init log ,

+     log :

+ 

+ 

+LET snapshot interval = 590.0 ;

+

+REAL VAR next snapshot time ,

+         time        , timex ,

+         paging wait , paging wait x ,

+         paging busy , paging busy x ,

+         fore cpu    , fore cpu x ,

+         back cpu    , back cpu x ,

+         system cpu  , system cpu x ,

+         delta t ;

+INT VAR storage max, used ;

+TEXT VAR record ;

+

+PROC init log :

+

+  time        := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  next snapshot time := time + snapshot interval

+

+ENDPROC init log ;

+

+PROC log (INT CONST active terminals, active background) :

+

+  new snapshot time if was clock reset ;

+  IF clock (1) >= next snapshot time

+    THEN save values ;

+         get new values ;

+         create stat record ;

+         put log (record) ;

+         define next snapshot time

+  FI .

+

+new snapshot time if was clock reset :

+  IF clock (1) < next snapshot time - snapshot interval 

+    THEN next snapshot time := clock (1)

+  FI .

+

+save values :

+  time x := time ;

+  paging wait x := paging wait ;

+  paging busy x := paging busy ;

+  fore cpu x    := fore cpu ;

+  back cpu x    := back cpu ;

+  system cpu x  := system cpu .

+

+get new values :

+  time := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  storage (storage max, used) .

+

+create stat record :

+  record :=  text (used, 5) ;

+  record CAT text (active terminals,3) ;

+  record CAT text (active background,3) ;

+  delta t := (time - time x) ;

+  percent (paging wait, paging wait x) ;

+  percent (paging busy, paging busy x) ;

+  percent (fore cpu, fore cpu x) ;

+  percent (back cpu, back cpu x) ;

+  percent (system cpu, system cpu x) ;

+  percent (last, 0.0) ;

+  percent (nutz, 0.0) .

+

+last :   paging wait  + paging busy  + fore cpu  + back cpu  + system cpu

+       - paging waitx - paging busyx - fore cpux - back cpux - system cpux .

+

+nutz :   time  - paging wait  - system cpu

+       - timex + paging waitx + system cpux .

+

+define next snapshot time :

+  next snapshot time := time + snapshot interval .

+ 

+ENDPROC log ;

+

+PROC percent (REAL CONST neu, alt ) :

+

+  record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%"

+

+ENDPROC percent ;

+

+ENDPACKET eumelmeter ;

+

+

+

+PACKET background que manager DEFINES                (* Autor: J.Liedtke *)

+                                                     (* Stand: 15.10.82  *)

+    into background que ,

+    delete from background que ,

+    get first from background que ,

+    get next from background que :

+

+LET que size = 100 ,

+    ENTRY    = STRUCT (TASK task, INT class) ;

+

+INT VAR end of que := 0 ,

+        actual entry pos ;

+

+ROW que size ENTRY VAR que ;

+

+

+PROC into background que (TASK CONST task) :

+

+  INT VAR class := prio (task) ;

+  IF end of que = que size

+    THEN delete all not existing tasks

+  FI ;

+  check whether already in que ;

+  IF already in que

+    THEN IF in same class

+           THEN LEAVE into background que

+           ELSE delete from background que (task) ;

+                into background que (task)

+         FI

+    ELSE insert new entry

+  FI .

+

+check whether already in que :

+  INT VAR entry pos := 1 ;

+  WHILE entry pos <= end of que  REP

+    IF que (entry pos).task = task

+      THEN LEAVE check whether already in que

+    FI ;

+    entry pos INCR 1

+  PER .

+

+already in que :  entry pos <= end of que .

+

+in same class :   que (entry pos).class = class .

+

+insert new entry :

+  end of que INCR 1 ;

+  que (end of que) := ENTRY:( task, class ) .

+

+delete all not existing tasks :

+  INT VAR j ;

+  FOR j FROM 1 UPTO end of que REP

+    TASK VAR examined := que (j).task ;

+    IF NOT exists (examined)

+      THEN delete from background que (examined)

+    FI

+  PER .

+

+ENDPROC into background que ;

+

+PROC delete from background que (TASK CONST task) :

+

+  search for entry ;

+  IF entry found

+    THEN delete entry ;

+         update actual entry pos 

+  FI .

+

+search for entry :

+  INT VAR entry pos := 1 ;

+  WHILE entry pos <= end of que REP

+    IF que (entry pos).task = task

+      THEN LEAVE search for entry

+    FI ;

+    entry pos INCR 1

+  PER .

+

+entry found : entry pos <= end of que .

+

+delete entry :

+  INT VAR i ;

+  FOR i FROM entry pos UPTO end of que - 1 REP

+    que (i) := que (i+1)

+  PER ;

+  end of que DECR 1 .

+

+update actual entry pos :

+  IF actual entry or following one deleted

+    THEN actual entry pos DECR 1

+  FI .

+

+actual entry or following one deleted :

+  entry pos >= actual entry pos .

+

+ENDPROC delete from background que ;

+

+PROC get first from background que (TASK VAR task, INT CONST lowest class) :

+

+  actual entry pos := 0 ;

+  get next from background que (task, lowest class)

+

+ENDPROC get first from background que ;

+

+PROC get next from background que (TASK VAR task, INT CONST lowest class) :

+ 

+  search next entry of permitted class ;

+  IF actual entry pos <= end of que

+    THEN task := que (actual entry pos).task

+    ELSE task := niltask

+  FI .

+

+search next entry of permitted class :

+  REP

+    actual entry pos INCR 1

+  UNTIL actual entry pos > end of que 

+        COR que (actual entry pos).class <= lowest class PER.

+

+ENDPROC get next from background que ;

+

+ENDPACKET background que manager ;

+

+ 

+

+PACKET scheduler DEFINES                         (* Autor: J.Liedtke *)

+                                                 (* Stand: 09.12.82  *)

+    scheduler :

+ 

+

+LET std background prio     = 7 ,

+    highest background prio = 5 ,

+    long slice              = 6000 ,

+    short slice             = 600 ,

+    blocked busy            = 4 ;

+

+INT VAR slice ,

+        foreground workers ,

+        background workers ;

+

+BOOL VAR is logging ;

+

+REAL VAR fore cpu load , back cpu load , paging load ;

+

+

+access catalogue ;

+TASK CONST ur task := brother (supervisor) ;

+

+TASK VAR actual task ;

+

+

+PROC scheduler :

+  IF yes ("mit eumelmeter")

+    THEN is logging := TRUE

+    ELSE is logging := FALSE

+  FI ;

+  task password ("-") ;

+  break ;

+  set autonom ;

+  command dialogue (FALSE) ;

+  forget ("scheduler", quiet) ;

+  disable stop; 

+  REP scheduler operation; 

+      clear error 

+  PER; 

+ 

+END PROC scheduler; 

+ 

+PROC scheduler operation:

+  enable stop;

+  IF is logging 

+    THEN init log 

+  FI;

+  slice := short slice ;

+  init system load moniting ;

+  REP

+    pause (slice) ;

+    monit system load ;

+    look at all active user tasks and block background workers ;

+    activate next background workers if possible ;

+    IF is logging

+      THEN log (foreground workers, background workers)

+    FI

+  PER .

+

+init system load moniting :

+  REAL VAR 

+  time     x := clock (1) ,

+  fore cpu x := clock (4) ,

+  back cpu x := clock (5) ,

+  paging   x := clock (2) + clock (3) .

+

+monit system load :

+  REAL VAR interval := clock (1) - time x ;

+  fore cpu load := (clock (4) - fore cpu x) / interval ;

+  back cpu load := (clock (5) - back cpu x) / interval ;

+  paging load   := (clock (2) + clock (3) - paging x) / interval ;

+  time     x := clock (1) ;

+  fore cpu x := clock (4) ;

+  back cpu x := clock (5) ;

+  paging   x := clock (2) + clock (3) .

+

+ENDPROC scheduler operation;

+

+PROC look at all active user tasks and block background workers :

+

+  foreground workers := 0 ;

+  background workers := 0 ;

+  actual task := myself ;

+  next active (actual task) ;

+  WHILE NOT (actual task = myself) REP

+    IF actual task < ur task

+      THEN look at this task

+    FI ;

+    next active (actual task)

+  END REP .

+

+look at this task :

+  IF channel (actual task) >= 0

+    THEN foreground workers INCR 1

+    ELSE background workers INCR 1 ;

+         block actual task if simple worker

+  FI .

+

+block actual task if simple worker :

+  IF son (actual task) = niltask

+    THEN pause (5) ;

+         block (actual task) ;

+         IF status (actual task) = blocked busy

+           THEN set background prio ;

+                into background que (actual task)

+         ELIF prio (actual task) < highest background prio

+           THEN unblock (actual task)

+         FI

+  FI .

+

+set background prio :

+  IF prio (actual task) < highest background prio

+    THEN prio (actual task, std background prio)

+  FI .

+ 

+ENDPROC look at all active user tasks and block background workers ;

+

+PROC activate next background workers if possible :

+

+  INT VAR lowest activation prio ,

+          max background workers ,

+          active background workers := 0 ;

+

+  strategic decision (foreground workers, background workers,

+                      fore cpu load, back cpu load, paging load,

+                      lowest activation prio, max background workers) ;

+

+  IF background permitted

+    THEN try to activate background workers

+  FI ;

+  IF active background workers > 0

+    THEN slice := short slice

+    ELSE slice := long slice

+  FI .

+

+background permitted : max background workers > 0 .

+

+try to activate background workers :

+  get first from background que (actual task, lowest activation prio) ;

+  IF NOT is niltask (actual task)

+    THEN delete from background que (actual task)

+  FI ;

+

+  WHILE active background workers < max background workers REP

+    IF is niltask (actual task)

+      THEN LEAVE try to activate background workers

+    ELIF status (actual task) <> blocked busy

+      THEN delete from background que (actual task)

+    ELSE

+           unblock (actual task) ;

+           active background workers INCR 1

+    FI ;

+    get next from background que (actual task, lowest activation prio)

+  PER .

+

+ENDPROC activate next background workers if possible ;

+ 

+ENDPACKET scheduler ;

+ 

+scheduler;

diff --git a/system/std.zusatz/1.7.3/src/spool manager b/system/std.zusatz/1.7.3/src/spool manager
new file mode 100644
index 0000000..8f9ab9f
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/spool manager
@@ -0,0 +1,377 @@
+PACKET spool manager DEFINES                         (* Autor: J. Liedtke *)

+    spool manager, server channel:                   (* 21.05.84          *)

+ 

+ 

+LET que size       = 100 ,

+

+    ack            = 0 ,

+    nak            = 1 ,

+    error nak      = 2 ,

+    second phase ack = 5 ,

+

+    fetch code     = 11 ,

+    save code      = 12 ,

+    erase code     = 14 ,

+    list code      = 15 ,

+    all code       = 17 ,

+    continue code  = 100,

+

+    empty          = 0 ,

+    used           = 1 ;

+

+TASK VAR order task , waiting server , from task , server ;

+INT VAR order code , reply , first , last , list index ;

+

+DATASPACE VAR ds ;

+

+TEXT VAR from title ;

+

+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;

+BOUND TEXT VAR error msg ;

+BOUND STRUCT (TEXT tname, tpass, TASK task) VAR sv msg ;

+

+FILE VAR list file ;

+TEXT VAR entry name, entry task;

+

+INT VAR command index , params ;

+TEXT VAR command line, param 1, param 2 ;

+ 

+LET spool command list =

+"break:1.0start:2.01stop:4.0first:5.0killer:6.0 " ;

+

+

+LET ENTRY = STRUCT (TEXT title, TASK origin, DATASPACE space, INT status) ;

+

+ROW que size ENTRY VAR que ;

+

+

+INT VAR server chan := 0; 

+ 

+PROC server channel (INT CONST ch): 

+  server chan := ch 

+ 

+END PROC server channel; 

+ 

+INT PROC server channel: 

+  server chan 

+ 

+END PROC server channel; 

+ 

+PROC spool manager (PROC server start) :

+  INT VAR old heap size := heap size;

+  begin (PROC server start, server) ;

+  set autonom ;

+  break ;

+  disable stop ;

+  first := 1 ;

+  last  := 1 ;

+  from task := niltask ;

+  waiting server := niltask ;

+  spool ;

+  clear error ;

+  forget all dataspaces.

+

+forget all dataspaces :

+  INT VAR i ;

+  FOR i FROM 1 UPTO que size REP

+    forget (que (i).space)

+  PER .

+

+spool:

+  REP

+    wait (ds, order code, order task) ;

+    IF   order code = fetch code    THEN out of que

+    ELIF order code = save code     THEN prepare into que

+    ELIF order code = second phase ack THEN into que

+    ELIF order code = erase code    THEN delete que entry

+    ELIF order code = list code     THEN list spool

+    ELIF order code = all code      THEN y all

+    ELIF order code >= continue code

+       AND order task = supervisor  THEN spool command (PROC server start)

+    FI;

+    clear error

+  PER;

+  collect heap garbage if necessary. 

+ 

+collect heap garbage if necessary: 

+  IF heap size > old heap size + 2 

+  THEN collect heap garbage; 

+       old heap size := heap size 

+  FI.

+

+ENDPROC spool manager ;

+

+PROC out of que :

+

+  forget (ds) ;

+  IF NOT (order task < myself)

+    THEN error ("not parent")

+  ELIF que empty

+    THEN waiting server := order task

+    ELSE send (order task, ack, que (first).space) ;

+         inc first

+  FI .

+

+que empty :   first = last .

+

+ENDPROC out of que ;

+

+PROC inc first :

+

+  que (first).status := empty ;

+  REP

+    first := first MOD que size + 1 ;

+  UNTIL first = last OR que (first).status <> empty PER

+

+ENDPROC inc first ;

+

+PROC dec first :

+

+  first DECR 1 ;

+  IF first = 0

+    THEN first := que size

+  FI

+

+ENDPROC dec first ;

+

+PROC prepare into que :

+

+  msg := ds ;

+  from task := order task ;

+  from title := CONCR (msg).name ;

+  send (order task,  second phase ack, ds) .

+

+ENDPROC prepare into que ;

+

+PROC into que :

+

+  IF order task = from task

+    THEN try entry into spool

+    ELSE send (order task, nak, ds)

+  FI .

+

+try entry into spool :

+  IF que full

+    THEN error ("spool overflow")

+    ELSE entry (que (last)) ;

+         last := next (last) ;

+         send (order task, ack, ds) ;

+         awake server if necessary

+  FI .

+ 

+awake server if necessary :

+  IF NOT is niltask (waiting server)

+    THEN send (waiting server, ack, que (first).space , reply) ;

+         IF reply = ack

+           THEN waiting server := niltask ;

+                inc first

+         FI

+  FI .

+

+que full  :   first = next (last) .

+

+ENDPROC into que ;

+

+PROC entry (ENTRY VAR que entry) :

+

+  que entry.title   := from title ;

+  que entry.origin  := from task ;

+  que entry.space   := ds ;

+  que entry.status  := used ;

+

+ENDPROC entry ;

+

+INT PROC next (INT CONST index) :

+

+  index MOD que size + 1 

+

+ENDPROC next ;

+

+

+PROC delete que entry :

+

+  msg := ds ;

+  INT VAR index := first ;

+  WHILE index <> last REP

+    IF entry found

+      THEN erase entry (index) ;

+           send (order task, ack, ds) ;

+           LEAVE delete que entry

+    FI ;

+    index := next (index)

+  PER ;

+  error ("your file does not exist") .

+

+entry found :

+  entry.status = used CAND entry.origin = order task

+  CAND entry.title = CONCR (msg).name .

+

+entry :  que (index) .

+

+ENDPROC delete que entry ;

+

+PROC erase entry (INT CONST index) :

+

+  entry.status := empty ;

+  forget (entry.space) ;

+  IF index = first

+    THEN inc first

+  FI .

+

+entry : que (index) .

+

+ENDPROC erase entry ;

+

+PROC list spool :

+

+  forget (ds) ;

+  ds := nilspace ;

+  list file := sequential file (output, ds) ;

+  to first que entry ; 

+  get next que entry (entry name, entry task) ; 

+  WHILE entry name <> "" REP 

+    putline (list file, text (entry task, 15) + " : " + entry name);

+    get next que entry (entry name, entry task)

+  PER;

+  send (order task, ack, ds) .

+

+ENDPROC list spool ;

+

+BOUND THESAURUS VAR all thesaurus;

+ 

+PROC y all:

+  forget (ds); 

+  ds := nilspace;

+  all thesaurus := ds; 

+  all thesaurus := empty thesaurus; 

+  to first que entry; 

+  get next que entry (entry name, entry task);   (* hier erster Eintrag *) 

+  WHILE entryname <> "" REP 

+    IF entry task = name (order task) 

+      AND NOT (all thesaurus CONTAINS entry name)

+      THEN insert (all thesaurus, entry name) 

+    FI; 

+    get next que entry (entry name, entry task) 

+  PER;

+  send (order task, ack, ds) 

+ 

+END PROC y all; 

+ 

+PROC to first que entry :

+

+  list index := first - 1

+

+ENDPROC to first que entry ;

+

+PROC get next que entry (TEXT VAR entry name, origin task name): 

+ 

+  WHILE list index <> last REP

+    list index := next (list index)

+  UNTIL que (list index).status <> empty PER ;

+  IF que (list index).status = used

+    THEN origin task name := name (que (list index).origin) ;

+         entry name := que (list index).title

+    ELSE entry name := ""; 

+         origin task name := ""

+  FI .

+

+ENDPROC get next que entry ;

+

+PROC error (TEXT CONST error text) :

+

+  forget (ds) ;

+  ds := nilspace ;

+  error msg := ds ;

+  CONCR (error msg) := error text ;

+  send (order task, error nak, ds)

+

+ENDPROC error ;

+

+PROC spool command (PROC server start) :

+

+  enable stop ;

+  continue (order code - continue code) ;

+  command dialogue (TRUE) ;

+  disable stop ;

+  REP 

+    get command ("gib spoolkommando :", command line);

+    analyze command (spool command list, command line, 3,

+                     command index, params, param1, param2);

+    execute command

+  PER .

+

+execute command :

+  SELECT command index OF 

+    CASE 1 : break cmd 

+    CASE 2 : start cmd

+    CASE 3 : start channel cmd

+    CASE 4 : stop cmd

+    CASE 5 : first cmd

+    CASE 6 : killer cmd

+  OTHERWISE  do (command line) END SELECT .

+

+start channel cmd: 

+  server channel (int (param1)); 

+  start cmd; 

+  break cmd. 

+ 

+break cmd: 

+  break; set autonom  ; LEAVE spool command. 

+

+start cmd :

+  IF is niltask (server)

+    THEN begin (PROC server start, server)

+  FI .

+

+stop cmd :

+  IF NOT is niltask (server)

+    THEN command dialogue (FALSE) ;

+         end (server) ;

+         server := niltask 

+  FI .

+

+first cmd :

+  line ;

+  to first que entry ;

+  get next que entry (entry name, entry task);

+  IF entry name = ""

+    THEN LEAVE first cmd

+  FI ;

+  REP

+    get next que entry (entry name, entry task) ;

+    IF entry name = ""

+      THEN LEAVE first cmd

+    FI;

+    say (text (entry task, 15) + " : " + entry name) ;

+    IF yes ("   als erstes")

+      THEN make to first entry ;

+           LEAVE first cmd

+    FI 

+  PER .

+

+make to first entry :

+  IF first = next (last)

+    THEN errorstop ("spool overflow")

+    ELSE dec first ;

+         que (first) := que (list index) ;

+         erase entry (list index)

+  FI .

+

+

+killer cmd :

+  line ;

+  to first que entry ;

+  REP

+    get next que entry (entry name, entry task) ;

+    IF entry name = "" 

+      THEN LEAVE killer cmd

+    FI ;

+    say (text (entry task, 15) + " : " + entry name) ;

+    IF yes ("   loeschen")

+      THEN erase entry (list index)

+    FI 

+  PER .

+ 

+ENDPROC spool command ;

+

+ENDPACKET spool manager ;

diff --git a/system/std.zusatz/1.7.3/src/std printer b/system/std.zusatz/1.7.3/src/std printer
new file mode 100644
index 0000000..91a07c7
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer
@@ -0,0 +1,434 @@
+PACKET std printer DEFINES reset printer,        (* F. Klapper *)

+                           new page,             (* 21.05.84   *)

+                           start, 

+                           printer cmd, 

+                           on, 

+                           off, 

+                           material, 

+                           papersize, 

+                           limit,

+                           change type, 

+                           print text, 

+                           x pos,

+                           y pos,

+                           line: 

+

+LET begin mark cmd    = ""15"",   (* Kommandos für 'output buffer' *)

+    end   mark cmd    = ""14"",

+    bsp        cmd    = ""8"" , 

+    printercmd cmd    = ""16"",

+    begin mark code   = 15,

+    end   mark code   = 14, 

+    bsp        code   = 8, 

+    printercmd code   = 16,

+

+    cr                = ""13"",   (* Steuerzeichen für die Ausgabe *)

+    lf                = ""10"", 

+    underline char    = "_",

+

+    inch = 2.54,                  (* Konstanten *)

+    max printer cmds per line = 10;

+

+INT CONST std length of paper :: 12 * y factor per inch,

+          std width  of paper :: cm to x steps (13.2 * inch),

+          std limit           :: cm to x steps (12.0 * inch), 

+          std first line      :: 5, 

+          std first collumn   :: cm to x steps (inch),

+ 

+          no xpos :: - 10;       (* beliebige negative ganze Zahl *)

+

+INT VAR first collumn,

+        first line,

+        xlimit,

+        actual line,

+        x pos steps,

+        width  of paper,

+        length of paper,

+        x pos mode;

+

+BOOL VAR block mode,

+         underline on,   (* gibt durch on / off gesetzten Zustand an *)

+         underline out;  (* gibt Zustand an der bis jetzt durch output buffer

+                            ausgegebenen Stelle an                   *)

+TEXT VAR buffer,

+         x pos buffer,

+         left margin;

+ 

+ROW max printer cmds per line TEXT VAR cmd arry;

+INT VAR cmd pointer;

+

+  length of paper    := std length of paper;

+  first line         := std first line; 

+  actual line        := 0;

+  buffer             := ""; 

+  reset printer;

+ 

+INT PROC cm to x steps (REAL CONST cm): 

+  int ((abs (cm) * real (x factor per inch) / inch) + 0.5)

+END PROC cm to x steps; 

+ 

+INT PROC cm to y steps (REAL CONST cm): 

+  int ((abs (cm) * real (y factor per inch) / inch) + 0.5)

+END PROC cm to y steps; 

+ 

+PROC start (REAL CONST x, y):

+  first collumn := cm to x steps (x);

+  first line    := cm to y steps (y);

+  left margin   := first collumn * " "

+END PROC start;

+ 

+PROC papersize (REAL CONST w, l): 

+  width of paper  := cm to x steps (w);

+  length of paper := cm to y steps (l); 

+END PROC papersize;

+

+PROC limit (REAL CONST x): 

+   xlimit := cm to x steps (x);

+END PROC limit;

+ 

+PROC on (TEXT CONST attribute):

+  IF (attribute SUB 1) = "u"

+  THEN underline on := TRUE;

+       buff CAT begin mark cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC on;

+

+PROC off (TEXT CONST attribute):

+  IF (attribute SUB 1) = "u"

+  THEN underline on := FALSE;

+       buff CAT end mark cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC off;

+

+PROC printer cmd (TEXT CONST cmd): 

+  IF cmd pointer < max printer cmds per line

+  THEN cmd pointer INCR 1;

+       cmd arry (cmd pointer) := cmd;

+       buff CAT printercmd cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC printer cmd; 

+ 

+PROC material (TEXT CONST name of material):

+END PROC material;

+ 

+PROC change type (TEXT CONST name of type): 

+ENDPROC change type; 

+

+PROC reset printer :

+  new page;                                   (* actual line := 0 *)

+  width  of paper    := std width  of paper;

+  length of paper    := std length of paper;

+  first line         := std first line; 

+  first collumn      := std first collumn;

+  xlimit             := std limit;

+  xpos mode          := 0;

+  cmd pointer        := 0;

+  x pos steps        := no x pos;

+  buffer             := ""; 

+  xpos buffer        := "";

+  left margin        := first collumn * " ";

+  block mode         := FALSE;

+  underline on       := FALSE;

+  underline out      := FALSE;

+ENDPROC reset printer;

+ 

+PROC print text (TEXT CONST content, INT CONST mode):

+  IF x pos steps >= 0

+  THEN x pos buffer CAT content;

+       x pos mode := mode MOD 4;

+       block mode := FALSE

+  ELSE buffer CAT content ;

+       block mode := (mode MOD 4) = 3

+  FI.

+END PROC print text;

+

+PROC tab and print:

+  SELECT x pos mode OF

+  CASE 0: fill (buffer, " ", x pos steps);

+  CASE 1: fill (buffer, " ", x pos steps - outputlength (x pos buffer));

+  CASE 2: fill (buffer, " ", 

+                x pos steps - outputlength (xpos buffer) DIV 2);

+  CASE 3: fill (buffer, " ", x pos steps);

+          block (x pos buffer, xlimit - x pos steps);

+  OTHERWISE

+  END SELECT;

+  buffer CAT x pos buffer;

+  x pos buffer := "";

+  x pos steps := no x pos.

+END PROC tab and print;

+ 

+INT PROC outputlength (TEXT CONST buff):

+  length (buff) - chars (buff, printercmd cmd) - chars (buff, begin mark cmd)

+                - chars (buff, end mark cmd) - chars (buff, bsp cmd) * 2 

+END PROC outputlength;

+

+PROC x pos (REAL CONST cm):

+  IF x pos steps >= 0

+  THEN tab and print

+  FI;

+  IF underline on

+  THEN       buffer CAT end   mark cmd;

+       x pos buffer CAT begin mark cmd

+  FI;

+  x pos steps := cm to x steps (cm)

+END PROC x pos;

+

+PROC y pos (REAL CONST cm):

+  IF actual line = 0

+  THEN output linefeed (first line - actual line); 

+       actual line := first line 

+  FI;

+  output buffer;

+  INT VAR y lf steps := cm to y steps (cm);

+  output linefeed (y lf steps + first line - actual line);

+  actual line := first line + y lf steps. 

+END PROC y pos;

+

+PROC line (REAL CONST proposed lf) :

+  IF actual line = 0

+  THEN output linefeed (first line - actual line); 

+       actual line := first line 

+  FI;

+  output buffer;

+  INT VAR done lf;

+  convert into min y steps (proposed lf, done lf);

+  output line feed (done lf);

+  actual line INCR done lf;

+END PROC line;

+

+PROC convert into min y steps (REAL CONST in, INT VAR out): 

+  IF in < 0.001

+  THEN out := 0

+  ELSE out := int (in);

+       IF out < 1 THEN out := 1 FI

+  FI; 

+ENDPROC convert into min y steps;

+

+PROC new page:

+  IF buffer <> ""

+  THEN line (1.0)

+  FI;

+  actual line := actual line MOD length of paper;

+  IF actual line > first line 

+  THEN output pagefeed (length of paper - actual line);

+       actual line := 0 

+  FI;

+END PROC new page;

+

+PROC output buffer:

+  IF x pos steps >= 0

+  THEN tab and print

+  ELIF block mode

+  THEN block (buffer, xlimit)

+  FI ;

+  TEXT VAR bsp buffer := "",

+           underline buffer := "";

+  INT VAR cmd pos := pos (buffer, ""1"", ""31"", 1),

+          akt cmd pointer := 0,

+          soon out := 0;

+  out (left margin);

+  put leading blanks not underlined;

+  WHILE cmd pos > 0

+  REP analyze cmd;

+      cmd pos := pos (buffer, ""1"", ""31"", cmd pos)

+  PER;

+  IF underline out

+  THEN fill (underline buffer, underline char, LENGTH buffer)

+  FI;

+  out buffer;

+  out bsp buffer;

+  out underline buffer;

+  buffer := "";

+  cmd pointer := 0.

+

+put leading blanks not underlined:

+  IF underline out

+  THEN INT VAR first non blank pos := pos (buffer, ""33"", ""254"", 1);

+       IF cmd pos > 0 CAND first non blank pos > 0

+       THEN fill (underline buffer, " ", 

+                  min (first non blank pos, cmd pos) - 1)

+       ELIF cmd pos > 0

+       THEN fill (underline buffer, " ", cmd pos - 1)

+       ELSE fill (underline buffer, " ", first non blank pos -1)

+       FI;

+  FI.

+

+analyze cmd:

+  SELECT code (buffer SUB cmd pos) OF 

+  CASE bsp code        : do bsp cmd

+  CASE begin mark code : do begin mark cmd

+  CASE end mark code   : do end   mark cmd

+  CASE printercmd code : do printercmd cmd

+  OTHERWISE 

+  END SELECT.

+

+do bsp cmd:

+  fill (bsp buffer, " ", cmd pos - 2);

+  cmd pos DECR 1;

+  bsp buffer CAT (buffer SUB cmd pos);

+  delete char (buffer, cmd pos);

+  delete char (buffer, cmd pos).

+

+do begin mark cmd:

+  IF NOT underline out

+  THEN underline out := TRUE;

+       fill (underline buffer, " ", cmd pos -1);

+       delete char (buffer, cmd pos)

+  FI.

+

+do end mark cmd:

+  IF underline out

+  THEN underline out := FALSE;

+       fill (underline buffer, underline char, cmd pos - 1);

+       delete char (buffer, cmd pos)

+  FI.

+

+do printercmd cmd:

+  IF akt cmd pointer < cmd pointer

+  THEN akt cmd pointer INCR 1;

+       out subtext (buffer, soon out + 1, cmd pos - 1);

+       soon out := cmd pos - 1;

+       delete char (buffer, cmd pos);

+       out (cmd arry (akt cmd pointer))

+  FI.

+

+out buffer:

+  (* out (left margin) steht schon weiter oben *)

+  outsubtext (buffer, soon out + 1).

+

+out bsp buffer:

+  IF bsp buffer <> ""

+  THEN out (cr);

+       out (left margin);

+       out (bsp buffer)

+  FI.

+

+out underline buffer:

+  IF underline buffer <> ""

+  THEN out (cr);

+       out (left margin);

+       out (underline buffer)

+  FI.

+END PROC output buffer;

+

+PROC fill (TEXT VAR buff, TEXT CONST char, INT CONST len):

+  buff CAT (len - outputlength (buff)) * char

+END PROC fill;

+

+PROC output linefeed (INT CONST min y steps):

+  IF min y steps > 0

+    THEN out (cr);

+         out (min y steps * lf)

+  FI

+ENDPROC output linefeed ;

+

+PROC output pagefeed (INT CONST rest) :

+  out (cr) ;

+  rest TIMESOUT lf

+ENDPROC output pagefeed ;

+

+(********************* B L O C K **********************************)

+LET blank = " " ,

+    enumeration list = "-).:" ;

+

+INT VAR to insert,

+        nr of blanks ,

+        nr of big spaces ,

+        begin ;

+

+TEXT VAR small space ,

+         big space ;

+

+BOOL VAR right := TRUE ;

+

+PROC block (TEXT VAR blockline, INT CONST len):

+  to insert := len - outputlength (blockline);

+  nr of blanks := 0; begin:=0;

+  IF to insert <= 0 THEN LEAVE block FI;

+  IF to insert > (xlimit DIV 3 ) THEN LEAVE block FI;

+  mark the variable blanks;

+  IF nr of blanks <= 0 THEN LEAVE block FI;

+  right := NOT right;

+  compute spaces;

+  insert spaces.

+

+mark the variable blanks:

+  skip blanks ;

+  begin := pos(blockline,blank,begin+1);

+  IF (pos (enumeration  list, (blockline SUB (begin-1))) > 0 )

+    THEN skip blanks ;

+         begin := pos(blockline,blank,begin+1);

+  FI;

+  WHILE begin > 0 REP

+     IF single blank gap

+       THEN change (blockline,begin,begin,""0""); 

+            nr of blanks INCR 1;

+       ELSE skip blanks

+     FI;

+     begin := pos(blockline,blank,begin+1);

+  ENDREP.

+

+single  blank gap :

+  ((blockline SUB (begin+1)) <> blank).

+

+skip blanks :

+  begin := pos (blockline, ""33"", ""254"", begin+1) .

+

+compute spaces:

+  INT VAR steps :=  to insert ;

+  INT VAR small :=  steps DIV nr of blanks;

+  nr of big spaces  :=  steps MOD nr of blanks;

+  small space := (small+1) * blank ;

+  big space := small space ;

+  big space CAT blank .

+

+insert spaces:

+  IF right THEN insert big spaces on right side

+           ELSE insert big spaces on left side

+  FI.

+

+insert big spaces on right side:

+  INT VAR nr of small spaces := nr of blanks - nr of big spaces;

+  INT VAR i;

+  FOR i FROM 1 UPTO nr of small spaces REP

+      change (blockline, ""0"",small space)

+  ENDREP;

+  changeall (blockline,""0"",big space).

+

+insert big spaces on left side:

+  INT VAR j;

+  FOR j FROM 1 UPTO nr of big spaces REP

+     change (blockline,""0"",big space)

+  ENDREP;

+  changeall (blockline,""0"",small space).

+ENDPROC block;

+

+INT PROC chars (TEXT CONST text, char) :

+  INT VAR how many := 0 ,

+  cmd pos := pos (text, char) ;

+  WHILE cmd pos > 0 REP

+    how many INCR 1 ;

+    cmd pos := pos (text, char, cmd pos+1)

+  PER ;

+  how many

+ENDPROC chars ;

+

+ENDPACKET std printer ;

diff --git a/system/std.zusatz/1.7.3/src/std printer generator-M b/system/std.zusatz/1.7.3/src/std printer generator-M
new file mode 100644
index 0000000..f07d31c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer generator-M
@@ -0,0 +1,22 @@
+forget ("std printer generator/M", quiet) ;

+check off ;

+

+fetch ("minimal fonts routines", archive); 

+fetch ("std printer", archive); 

+fetch ("eumel printer", archive);

+fetch ("elan lister", archive);

+fetch ("spool manager", archive);

+fetch ("printer/M", archive); 

+ 

+ins ("minimal fonts routines"); 

+ins ("std printer"); 

+ins ("eumel printer");

+ins ("elan lister");

+ins ("spool manager");

+run ("printer/M");

+ 

+PROC ins (TEXT CONST name): 

+  insert (name); 

+  forget (name, quiet) 

+END PROC ins;

+ 

diff --git a/system/std.zusatz/1.7.3/src/std printer generator-S b/system/std.zusatz/1.7.3/src/std printer generator-S
new file mode 100644
index 0000000..067df88
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer generator-S
@@ -0,0 +1,15 @@
+forget ("std printer generator/S", quiet) ;

+check off ;

+

+ins ("minimal fonts routines"); 

+ins ("std printer"); 

+ins ("eumel printer");

+ins ("elan lister");

+ins ("printer/S");

+ 

+PROC ins (TEXT CONST name): 

+  fetch (name, archive);

+  insert (name); 

+  forget (name, quiet) 

+END PROC ins;

+ 

diff --git a/system/std.zusatz/1.7.3/src/vector b/system/std.zusatz/1.7.3/src/vector
new file mode 100644
index 0000000..fd1b0ef
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/vector
@@ -0,0 +1,213 @@
+PACKET vector DEFINES VECTOR, :=, vector,         (* Autor : H.Indenbirken *)

+                      SUB, LENGTH, length, norm,  (* Stand : 21.10.83      *)

+                      nilvector, replace, =, <>,

+                      +, -, *, /,

+                      get, put :

+

+LET n = 4000;

+

+TYPE VECTOR = STRUCT (INT lng, TEXT elem);

+TYPE INITVECTOR = STRUCT (INT lng, REAL value);

+

+INT VAR i;

+TEXT VAR t :: "12345678";

+VECTOR VAR v :: nilvector;

+

+(****************************************************************************

+PROC dump (VECTOR CONST v) :

+  put line (text (v.lng) + " Elemente :");

+  FOR i FROM 1 UPTO v.lng

+  REP put line (text (i) + ": " + text (element i)) PER  .

+

+element i :

+  v.elem RSUB i  .

+

+END PROC dump;

+****************************************************************************)

+

+OP := (VECTOR VAR l, VECTOR CONST r) :

+  l.lng := r.lng;

+  l.elem := r.elem

+

+END OP :=;

+

+OP := (VECTOR VAR l, INITVECTOR CONST r) :

+  l.lng := r.lng;

+  replace (t, 1, r.value);

+  l.elem := r.lng * t

+

+END OP :=;

+

+INITVECTOR PROC nilvector :

+   vector (1, 0.0)

+

+END PROC nilvector;

+

+INITVECTOR PROC vector (INT CONST lng, REAL CONST value) :

+  IF lng <= 0

+  THEN errorstop ("PROC vector : lng <= 0") FI;

+  INITVECTOR : (lng, value)

+

+END PROC vector;

+

+INITVECTOR PROC vector (INT CONST lng) :

+  vector (lng, 0.0)

+

+END PROC vector;

+

+REAL OP SUB (VECTOR CONST v, INT CONST i) :

+  test ("REAL OP SUB : ", v, i);

+  v.elem RSUB i

+

+END OP SUB;

+

+INT OP LENGTH (VECTOR CONST v) :

+  v.lng

+

+END OP LENGTH;

+

+INT PROC length (VECTOR CONST v) :

+  v.lng

+

+END PROC length;

+

+REAL PROC norm (VECTOR CONST v) :

+  REAL VAR result :: 0.0;

+  FOR i FROM 1 UPTO v.lng

+  REP result INCR ((v.elem RSUB i)**2) PER;

+  sqrt (result)  .

+

+END PROC norm;

+

+PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) :

+  test ("PROC replace : ", v, i);

+  replace (v.elem, i, r)

+

+END PROC replace;

+

+BOOL OP = (VECTOR CONST l, r) :

+  l.elem = r.elem

+END OP =;

+

+BOOL OP <> (VECTOR CONST l, r) :

+  l.elem <> r.elem

+END OP <>;

+

+VECTOR OP + (VECTOR CONST v) :

+  v

+END OP +;

+

+VECTOR OP + (VECTOR CONST l, r) :

+  test ("VECTOR OP + : ", l, r);

+  v := l;

+  FOR i FROM 1 UPTO v.lng

+  REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER;

+  v

+

+END OP +;

+

+VECTOR OP - (VECTOR CONST a) :

+  v := a;

+  FOR i FROM 1 UPTO v.lng

+  REP replace (v.elem, i, - (a.elem RSUB i)) PER;

+  v

+

+END OP -;

+

+VECTOR OP - (VECTOR CONST l, r) :

+  test ("VECTOR OP - : ", l, r);

+  v := l;

+  FOR i FROM 1 UPTO v.lng

+  REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER;

+  v

+END OP -;

+

+REAL OP * (VECTOR CONST l, r) :

+  test ("REAL OP * : ", l, r);

+  REAL VAR x :: 0.0;

+  FOR i FROM 1 UPTO l.lng

+  REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER;

+  x

+

+END OP *;

+

+VECTOR OP * (VECTOR CONST v, REAL CONST r) :

+  r*v

+

+END OP *;

+

+VECTOR OP * (REAL CONST r, VECTOR CONST a) :

+  v := a;

+  FOR i FROM 1 UPTO v.lng

+  REP replace (v.elem, i, r*(a.elem RSUB i)) PER;

+  v

+

+END OP *;

+

+VECTOR OP / (VECTOR CONST a, REAL CONST r) :

+  v := a;

+  FOR i FROM 1 UPTO v.lng

+  REP replace (v.elem, i, (a.elem RSUB i)/r) PER;

+  v

+

+END OP /;

+

+TEXT VAR error :: "";

+PROC test (TEXT CONST proc, VECTOR CONST v, INT CONST i) :

+  IF i > v.lng

+  THEN error := proc;

+       error CAT "subscript overflow (LENGTH v=";

+       error CAT text (v.lng);

+       error CAT ", i=";

+       error CAT text (i);

+       error CAT ")";

+       errorstop (error)

+  ELIF i < 1

+  THEN error := proc;

+       error CAT "subscript underflow (i = ";

+       error CAT text (i);

+       error CAT ")";

+       errorstop (error)

+  FI  .

+

+END PROC test;

+

+PROC test (TEXT CONST proc, VECTOR CONST a, b) :

+  IF a.lng <> b.lng

+  THEN error := proc;

+       error CAT "LENGTH a (";

+       IF a.lng <= 0

+       THEN error CAT "undefined"

+       ELSE error CAT text (a.lng) FI;

+       error CAT ") <> LENGTH b (";

+       error CAT text (b.lng);

+       error CAT ")";

+       errorstop (error)

+  FI

+

+END PROC test;

+

+PROC get (VECTOR VAR v, INT CONST lng) :

+  v.lng := lng;

+  v.elem := lng * "12345678";

+  REAL VAR x;

+  FOR i FROM 1 UPTO lng

+  REP get (x);

+      replace (v.elem, i, x)

+  PER  .

+

+END PROC get;

+

+PROC put (VECTOR CONST v, INT CONST length, fracs) :

+  FOR i FROM 1 UPTO v.lng

+  REP put (text (v.elem RSUB i, length, fracs)) PER

+

+END PROC put;

+

+PROC put (VECTOR CONST v) :

+  FOR i FROM 1 UPTO v.lng

+  REP put (text (v.elem RSUB i)) PER

+

+END PROC put;

+

+END PACKET vector;

diff --git a/system/std.zusatz/1.7.5/src/eumel printer b/system/std.zusatz/1.7.5/src/eumel printer
new file mode 100644
index 0000000..2fd3f38
--- /dev/null
+++ b/system/std.zusatz/1.7.5/src/eumel printer
@@ -0,0 +1,3067 @@
+PACKET eumel printer                           (* Autor   : Rudolf Ruland *)

+                                               (* Version : 4             *)

+                                               (* Stand   : 07.08.86      *)

+       DEFINES print, 

+               with elan listings,

+               is elan source,

+               bottom label for elan listings,

+               x pos,

+               y pos,

+               y offset index,

+               line type,

+               material,

+               pages printed :

+ 

+

+LET std x wanted                   =  2.54,

+    std y wanted                   =  2.35,

+    std limit                      =  16.0,

+    std pagelength                 =  25.0,

+    std linefeed faktor            =  1.0,

+    std material                   =  "";

+

+LET blank                          =  " ",

+    blank code 1                   =  33,

+    geschuetztes blank             =  ""223"", 

+    keine blankanalyse             =  0,

+    einfach blank                  =  1,

+    doppel blank                   =  2,

+ 

+    anweisungszeichen              =  "#",

+    anweisungszeichen code 1       =  36,

+    geschuetztes anweisungszeichen =  ""222"",

+    druckerkommando zeichen        =  "/",

+    quote                          =  """",

+ 

+    erweiterungs ausgang           =  32767,

+    blank ausgang                  =  32766,

+    anweisungs ausgang             =  32765,

+    d code ausgang                 =  32764,

+    max breite                     =  32763,

+ 

+    punkt                          =  ".",

+ 

+    leer                           =   0,

+

+    kommando token                 =  0,

+    text token                     =  1,

+ 

+    underline linetype             =  1,

+    underline bit                  =  0,

+    bold bit                       =  1,

+    italics bit                    =  2,

+    modifikations liste            =  "ubir",

+    anzahl modifikationen          =  4, 

+ 

+    document                       =  1,

+    page                           =  2,

+ 

+    write text                     =  1,

+    write cmd                      =  2,

+    carriage return                =  3, 

+    move                           =  4,

+    draw                           =  5,

+    on                             =  6, 

+    off                            =  7,

+    type                           =  8,

+ 

+    tag type                       =  1,

+    bold type                      =  2,

+    number type                    =  3,

+    text type                      =  4,

+    delimiter type                 =  6,

+    eof type                       =  7;

+ 

+ 

+INT CONST null ausgang            := -32767-1;

+ 

+ROW anzahl modifikationen INT CONST modifikations werte :=

+                               ROW anzahl modifikationen INT : (1, 2, 4, 8);

+ 

+TEXT CONST anweisungsliste := 

+    "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" +

+    "fillchar:10.1mark:11.2markend:12.0" +

+    "ub:13.0ue:14.0fb:15.0fe:16.0" +

+    "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + 

+    "material:26.1page:27.01pagelength:29.1start:30.2" + 

+    "table:31.0tableend:32.0clearpos:33.01" + 

+    "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" +

+    "textbegin:40.02textend:42.0" +

+    "indentation:43.1ytab:44.1";

+ 

+LET a type             =   1,      a block            =  20,

+    a on               =   2,      a columns          =  21,

+    a off              =   3,      a columnsend       =  22,

+    a center           =   4,      a free             =  23,

+    a right            =   5,      a limit            =  24,

+    a up               =   6,      a linefeed         =  25,

+    a down             =   7,      a material         =  26,

+    a end up or down   =   8,      a page0            =  27,

+    a bsp              =   9,      a page1            =  28,

+    a fill char        =  10,      a pagelength       =  29,

+    a mark             =  11,      a start            =  30,

+    a markend          =  12,      a table            =  31,

+    a ub               =  13,      a tableend         =  32,

+    a ue               =  14,      a clearpos0        =  33,

+    a fb               =  15,      a clearpos1        =  34,

+    a fe               =  16,      a lpos             =  35,

+                                   a rpos             =  36,

+                                   a cpos             =  37,

+                                   a dpos             =  38,

+                                   a bpos             =  39,

+                                   a textbegin0       =  40,

+                                   a textbegin2       =  41,

+                                   a textend          =  42,

+                                   a indentation      =  43,

+                                   a y tab            =  44;

+ 

+INT VAR  a xpos, a breite, a font, a modifikationen,

+         a modifikationen fuer x move, a ypos, aktuelle ypos,

+         letzter font, letzte modifikationen,

+         d ypos, d xpos, d font, d modifikationen, 

+ 

+         zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang,

+         anzahl einrueck blanks, blankbreite,

+         einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite,

+         font durchschuss, fonthoehe, font tiefe,

+         groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe,

+         blankmodus, alter blankmodus,

+         token zeiger, erstes token der zeile, 

+

+         erstes tab token, tab anfang, anzahl blanks, 

+         d code 1, d pitch, fuell zeichen breite, erstes fuell token, 

+         letztes fuell token, 

+ 

+         x size, y size, x wanted, y wanted, x start, y start,

+         pagelength, limit, indentation,

+         left margin, top margin, seitenlaenge,

+         papierlaenge, papierbreite,

+         luecke, anzahl spalten, aktuelle spalte,

+

+         verschiebung, rest, neue modifikationen, modifikations modus, pass,

+ 

+         int param, anweisungs index, anzahl params, index,

+ 

+         gedruckte seiten;

+ 

+BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile,

+         zeile muss geblockt werden, rechts, a block token, offsets,

+         tabellen modus, block modus, center modus, right modus,

+         seite ist offen, vor erster seite;

+ 

+REAL VAR linefeed faktor, real param;

+ 

+TEXT VAR zeile, anweisung, par1, par2, material wert, replacements,

+         fuell zeichen, d string, font offsets;

+ 

+ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler;

+ 

+INITFLAG VAR in dieser task := FALSE;

+ 

+. zeile ist zu ende               : zeilenpos > zeilen laenge

+ 

+. zeilen breite                   : a xpos - left margin

+ 

+. neue zeilenhoehe                : int (linefeed faktor * real (fonthoehe) + 0.5)

+ 

+. naechstes zeichen ist blank     : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0

+ 

+. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos)

+ 

+. in letzter spalte               : aktuelle spalte >= anzahl spalten

+ 

+. anfangs blankmodus :

+    INT VAR dummy;

+    IF   center modus OR right modus

+         THEN dummy

+    ELIF index zaehler = 0

+         THEN blankmodus

+         ELSE alter blankmodus

+    FI

+ 

+. initialisiere tab variablen : 

+    erstes tab token := token index f + 1;

+    tab anfang       := zeilen breite;

+    anzahl blanks    := 0;

+.;

+ 

+(******************************************************************)

+ 

+LET zeilen nr laenge  =  4,

+    teil einrueckung  =  5,

+ 

+    headline pre  = "Zeile    ****   E L A N    EUMEL 1.7.5  ****   ",

+    headline post = "   ****    ";

+ 

+INT  VAR zeilen nr, rest auf seite,

+         max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name,

+         symbol type, naechster symbol type;

+ 

+BOOL VAR vor erstem packet, innerhalb der define liste;

+ 

+TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile;

+ 

+ 

+. symbol           : fuell zeichen

+. naechstes symbol : d string

+. elan text        : d token. text

+.; 

+ 

+(******************************************************************)

+(*** tokenspeicher                                              ***)

+

+LET max token  = 3000,

+    max ypos   = 1000,

+ 

+    TOKEN      = STRUCT (TEXT text,

+                         INT  xpos, breite, font, modifikationen,

+                              modifikationen fuer x move, 

+                              offset index, naechster token index, 

+                         BOOL block token ),

+

+    YPOS       = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index,

+                             erster token index, letzter token index ), 

+ 

+    TOKENLISTE = STRUCT (ROW max token TOKEN token liste,

+                         ROW max ypos  YPOS  ypos  liste );

+ 

+DATASPACE VAR ds;

+ 

+BOUND TOKENLISTE VAR tokenspeicher;

+ 

+TOKEN VAR d token, offset token;

+ 

+INT VAR erster ypos index a, letzter ypos index a, 

+        erster ypos index d, letzter ypos index d, 

+        ypos  index, ypos  index f, ypos  index a, ypos  index d, 

+        token index, token index f;

+ 

+. t  : tokenspeicher. token liste (token index)

+. tf : tokenspeicher. token liste (token index f)

+ 

+. y  : tokenspeicher. ypos  liste (ypos  index) 

+. yf : tokenspeicher. ypos  liste (ypos  index f) 

+. ya : tokenspeicher. ypos  liste (ypos  index a)

+. yd : tokenspeicher. ypos  liste (ypos  index d)

+ 

+. loesche druckspeicher :

+    erster ypos index d := 0;

+           ypos index f := 0;

+          token index f := 0;

+ 

+. druckspeicher ist nicht leer :

+    erster ypos index d <> 0

+ 

+. loesche analysespeicher :

+    erster ypos index a := 0;

+ 

+. analysespeicher ist nicht leer :

+    erster ypos index a <> 0

+.; 

+ 

+(******************************************************************)

+(*** anweisungsspeicher                                         ***)

+ 

+INT  VAR anweisungszaehler;

+TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger;

+THESAURUS VAR params1, params2; 

+ 

+PROC loesche anweisungsspeicher :

+ 

+    anweisungs zaehler := 0;

+    anweisungs indizes := "";

+    params1 zeiger     := "";

+    params2 zeiger     := "";

+    params1            := empty thesaurus;

+    params2            := empty thesaurus;

+ 

+END PROC loesche anweisungsspeicher; 

+ 

+(******************************************************************)

+(*** indexspeicher                                              ***)

+ 

+INT  VAR index zaehler;

+TEXT VAR grosse fonts, verschiebungen;

+

+PROC loesche indexspeicher :

+ 

+    index zaehler  := 0;

+    grosse fonts   := "";

+    verschiebungen := "";

+ 

+END PROC loesche indexspeicher; 

+ 

+ 

+(******************************************************************)

+(*** tabellenspeicher                                           ***)

+ 

+LET max tabs          =  30,

+    TABELLENEINTRAG   =  STRUCT (INT tab typ, tab position, tab param);

+

+TEXT VAR tab liste, fill char;

+THESAURUS VAR d strings;

+ROW max tabs TABELLENEINTRAG VAR tabspeicher;

+ 

+INT VAR tab index;

+ 

+. tab typ       : tab speicher (tab liste ISUB tab index). tab typ

+. tab position  : tab speicher (tab liste ISUB tab index). tab position

+. tab param     : tab speicher (tab liste ISUB tab index). tab param 

+. anzahl tabs   : LENGTH tab liste DIV 2 

+.;

+ 

+PROC loesche tabellenspeicher :

+ 

+    fill char := " ";

+    tabliste  := "";

+    d strings := empty thesaurus;

+    FOR tab index FROM 1 UPTO max tabs

+        REP tab speicher (tab index). tab typ := leer PER;

+ 

+END PROC loesche tabellenspeicher;

+ 

+(******************************************************************)

+(*** markierungsspeicher                                        ***)

+ 

+INT VAR mark index l, mark index r, alter mark index l, alter mark index r;

+ 

+ROW 4 TOKEN VAR mark token;

+ 

+. markierung links  : mark index l > 0

+. markierung rechts : mark index r > 0

+.;

+ 

+PROC loesche markierung :

+ 

+     mark index l := 0;

+     mark index r := 0;

+

+END PROC loesche markierung;

+ 

+ 

+PROC loesche alte markierung :

+ 

+     alter mark index l := 0;

+     alter mark index r := 0;

+

+END PROC loesche alte markierung;

+ 

+

+PROC initialisiere markierung :

+ 

+     FOR mark index l FROM 1 UPTO 4

+     REP mark token (mark index l). modifikationen fuer x move := 0;

+         mark token (mark index l). offset index               := text token;

+         mark token (mark index l). block token                := FALSE;

+         mark token (mark index l). naechster token index      := 0;

+     PER;

+ 

+END PROC initialisiere markierung;

+ 

+(******************************************************************)

+(*** durchschuss                                                ***)

+ 

+INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, 

+        anzahl durchschuss, zeilen zaehler;

+ 

+BOOL VAR wechsel := TRUE;

+ 

+INT PROC durchschuss :

+ 

+     zeilen zaehler INCR 1;

+     IF   zeilen zaehler <= anzahl durchschuss 1

+          THEN durchschuss 1

+     ELIF zeilen zaehler <= anzahl durchschuss 

+          THEN durchschuss 2

+          ELSE 0

+     FI

+ 

+END PROC durchschuss;

+ 

+ 

+PROC neuer durchschuss (INT CONST anzahl, rest) :

+ 

+     zeilen zaehler     := 0;

+     anzahl durchschuss := anzahl;

+     IF anzahl > 0 

+        THEN IF wechsel

+                THEN durchschuss 1        := rest DIV anzahl durchschuss;

+                     durchschuss 2        := durchschuss 1 + sign (rest);

+                     anzahl durchschuss 1 := anzahl durchschuss -

+                                             abs (rest) MOD anzahl durchschuss;

+                     wechsel              := FALSE;

+                ELSE durchschuss 2        := rest DIV anzahl durchschuss; 

+                     durchschuss 1        := durchschuss 2 + sign (rest);

+                     anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss;

+                     wechsel              := TRUE;

+             FI;

+        ELSE loesche durchschuss

+     FI;

+ 

+END PROC neuer durchschuss;

+ 

+ 

+PROC loesche durchschuss :

+

+     durchschuss 1           := 0;

+     durchschuss 2           := 0;

+     anzahl durchschuss 1    := 0;

+     anzahl durchschuss      := 0;

+     zeilen zaehler          := 0;

+ 

+END PROC loesche durchschuss;

+ 

+(****************************************************************)

+ 

+PROC initialisierung :

+ 

+  forget (ds);

+  ds := nilspace; tokenspeicher := ds;

+  loesche druckspeicher;

+  loesche anweisungsspeicher;

+  loesche indexspeicher;

+  initialisiere markierung;

+  right  modus                 := FALSE;

+  center modus                 := FALSE;

+  seite ist offen              := FALSE;

+  pass                         := 0;

+  a breite                     := 0;

+  a block token                := FALSE;

+  a modifikationen fuer x move := 0;

+  d code 1                     := leer;

+  erstes fuell token           := leer;

+  IF two bytes

+     THEN FOR index FROM   1 UPTO 129 REP zeichen zaehler (index) := 1 PER; 

+          FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER;

+          FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER;

+          FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER;

+          FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER;

+     ELSE FOR index FROM   1 UPTO 256 REP zeichen zaehler (index) := 1 PER; 

+  FI;

+ 

+END PROC initialisierung;

+ 

+(****************************************************************)

+(*** print - Kommando                                         ***)

+

+BOOL VAR elan listings erlaubt;

+FILE VAR eingabe;

+ 

+with elan listings (TRUE);

+ 

+PROC with elan listings (BOOL CONST flag) :

+     elan listings erlaubt := flag;

+END PROC with elan listings;

+ 

+BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings;

+ 

+ 

+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ):

+ 

+  print (PROC (TEXT VAR) next line, BOOL PROC eof,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 

+         FALSE, "");

+ 

+END PROC print;

+ 

+ 

+PROC print (FILE VAR file,

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+

+  eingabe := file;

+  input (eingabe);

+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 

+         elan listings erlaubt CAND is elan source (eingabe), 

+         headline (eingabe) );

+ 

+END PROC print;

+ 

+PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile;

+ 

+BOOL PROC eof : eof (eingabe) END PROC eof;

+ 

+BOOL PROC is elan source (FILE VAR eingabe) :

+ 

+hole erstes symbol;

+elan programm tag COR elan programm bold COR kommentar

+

+. elan programm tag :

+    symbol type = tag type CAND pos (zeile, ";") > 0 

+ 

+. elan programm bold :

+    symbol type = bold type CAND is elan bold

+

+    . is elan bold :

+        symbol = "PACKET" COR symbol = "LET"

+            COR proc oder op (symbol) COR deklaration

+            COR proc oder op (naechstes symbol)

+ 

+    . deklaration :

+        next symbol (naechstes symbol);

+        naechstes symbol = "VAR" OR naechstes symbol = "CONST"

+

+. kommentar :

+    pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 

+

+. 

+  hole erstes symbol :

+    hole erstes nicht blankes symbol; 

+    scan (zeile);

+    next symbol (symbol, symbol type);

+ 

+    . hole erstes nicht blankes symbol :

+        IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI;

+        REP getline (eingabe, zeile);

+        UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER;

+        reset (eingabe);

+ 

+END PROC is elan source;

+

+(****************************************************************)

+ 

+bottom label for elan listings ("");

+ 

+PROC bottom label for elan listings (TEXT CONST label) :

+     bottom label := label;

+END PROC bottom label for elan listings;

+ 

+TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings;

+ 

+ 

+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+            BOOL CONST elan listing, TEXT CONST file name) :

+ 

+disable stop;

+gedruckte seiten := 0;

+drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,

+              PROC (INT CONST, INT VAR, INT VAR) open,

+              PROC (INT CONST, INT CONST) close,

+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+              elan listing, file name );

+IF is error THEN behandle fehlermeldung FI;

+ 

+. behandle fehlermeldung :

+    par1 := error message;

+    int param := error line;

+    clear error;

+    IF NOT vor erster seite

+       THEN IF seite ist offen

+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )

+            FI;

+            clear error;

+            close (document, 0);

+            clear error;

+    FI;

+    initialisierung;

+    errorstop (par1 (* + " -> " + text (int param) *) );

+ 

+END PROC print; 

+ 

+INT PROC x pos          : d xpos                END PROC x pos;

+INT PROC y pos          : d ypos                END PROC y pos;

+INT PROC y offset index : d token. offset index END PROC y offset index;

+INT PROC linetype       : underline linetype    END PROC linetype;

+TEXT PROC material      : material wert         END PROC material;

+INT PROC pages printed  : gedruckte seiten      END PROC pages printed;

+ 

+(****************************************************************)

+ 

+PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,

+                   PROC (INT CONST, INT VAR, INT VAR) open,

+                   PROC (INT CONST, INT CONST) close,

+                   PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+                   BOOL CONST elan listing, TEXT CONST file name ) :

+ 

+ 

+enable stop;

+IF elan listing

+   THEN dateiname := file name;

+        drucke elan listing;

+   ELSE drucke text datei;

+FI;

+ 

+.

+  drucke text datei :

+    initialisiere druck; 

+    WHILE NOT eof

+    REP next line (zeile); 

+        analysiere zeile; 

+        drucke token soweit wie moeglich;

+        werte anweisungsspeicher aus;

+    PER;

+    schliesse druck ab; 

+ 

+. 

+  initialisiere druck :

+    IF NOT initialized (in dieser task)

+       THEN ds := nilspace;

+            initialisierung

+    FI;

+    vor erster seite               := TRUE;

+    tabellen modus                 := FALSE;

+    block modus                    := FALSE;

+    zeile ist absatzzeile          := TRUE;

+    x wanted                       := x step conversion (std x wanted);

+    y wanted                       := y step conversion (std y wanted);

+    limit                          := x step conversion (std limit);

+    pagelength                     := y step conversion (std pagelength);

+    linefeed faktor                := std linefeed faktor;

+    material wert                  := std material;

+    indentation                    := 0;

+    modifikations modus            := maxint; 

+    seitenlaenge                   := maxint;

+    papierlaenge                   := maxint;

+    left margin                    := 0;

+    top  margin                    := 0;

+    a ypos                         := top margin;

+    a font                         := -1;

+    a modifikationen               := 0;

+    aktuelle spalte                := 1;

+    anzahl spalten                 := 1;

+    stelle neuen font ein (1);

+    loesche tabellenspeicher;

+    loesche markierung;

+    loesche alte markierung;

+    loesche durchschuss;

+ 

+. 

+  schliesse druck ab :

+    IF NOT vor erster seite

+       THEN IF seite ist offen

+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )

+            FI;

+            close (document, 0);

+    FI;

+ 

+.

+  drucke token soweit wie moeglich :

+    IF analysespeicher ist nicht leer

+       THEN letztes token bei gleicher ypos; 

+            IF NOT seite ist offen

+               THEN eroeffne seite (x wanted, y wanted,

+                                  PROC (INT CONST, INT VAR, INT VAR) open);

+            FI;

+            gehe zur letzten neuen ypos;

+            IF seitenlaenge ueberschritten OR papierlaenge ueberschritten 

+               THEN neue seite oder spalte;

+                    analysiere zeile nochmal;

+               ELSE sortiere neue token ein;

+                    IF in letzter spalte

+                       THEN drucke tokenspeicher (a ypos,

+                            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                    FI;

+            FI;

+    FI;

+ 

+    . gehe zur letzten neuen ypos :

+        ypos index a := letzter ypos index a

+ 

+    . seitenlaenge ueberschritten :

+        ya. ypos > seitenlaenge 

+ 

+    . papierlaenge ueberschritten :

+        ya. ypos > papierlaenge 

+ 

+    . neue seite oder spalte :

+        IF in letzter spalte

+           THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                      PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                eroeffne seite (x wanted, aktuelles y wanted,

+                      PROC (INT CONST, INT VAR, INT VAR) open);

+           ELSE neue spalte;

+        FI;

+ 

+        . aktuelles y wanted :

+            IF seitenlaenge ueberschritten

+               THEN y wanted

+               ELSE 0

+            FI

+ 

+    . analysiere zeile nochmal :

+        setze auf alte werte zurueck;

+        loesche anweisungsspeicher;

+        analysiere zeile;

+        letztes token bei gleicher ypos;

+        sortiere neue token ein;

+ 

+        . setze auf alte werte zurueck :

+           zeile ist absatzzeile := letzte zeile war absatzzeile;

+           a modifikationen      := letzte modifikationen;

+           stelle neuen font ein (letzter font);

+ 

+.

+  werte anweisungsspeicher aus :

+    INT VAR index;

+    FOR index  FROM 1 UPTO anweisungszaehler

+    REP

+        SELECT anweisungs indizes ISUB index OF

+          CASE a block             : block anweisung

+          CASE a columns           : columns anweisung

+          CASE a columnsend        : columnsend anweisung

+          CASE a free              : free anweisung

+          CASE a limit             : limit anweisung

+          CASE a linefeed          : linefeed anweisung

+          CASE a material          : material anweisung

+          CASE a page0, a page1    : page anweisung

+          CASE a pagelength        : pagelength anweisung

+          CASE a start             : start anweisung

+          CASE a table             : table anweisung

+          CASE a tableend          : tableend anweisung 

+          CASE a clearpos0         : clearpos0 anweisung

+          CASE a clearpos1         : clearpos1 anweisung

+          CASE a lpos, a rpos, a cpos, a dpos

+                                   : lpos rpos cpos dpos anweisung

+          CASE a bpos              : bpos anweisung

+          CASE a fillchar          : fillchar anweisung

+          CASE a textbegin0        : textbegin0 anweisung

+          CASE a textbegin2        : textbegin2 anweisung

+          CASE a textend           : textend anweisung

+          CASE a indentation       : indentation anweisung

+          CASE a y tab             : y tab anweisung

+        END SELECT

+   PER; 

+   loesche anweisungsspeicher;

+ 

+   . block anweisung :

+       blockmodus := TRUE;

+ 

+   . columns anweisung :

+       IF anzahl spalten = 1 AND int  conversion ok (param1)

+                             AND real conversion ok (param2) 

+          THEN anzahl spalten := max (1, int param); 

+               luecke         := x step conversion (real param);

+       FI;

+ 

+   . columnsend anweisung :

+       anzahl spalten  := 1;

+       aktuelle spalte := 1; 

+       left margin     := x wanted - x start + indentation;

+ 

+   . free anweisung :

+       IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI;

+ 

+   . limit anweisung :

+       IF real conversion ok (param1) THEN limit := x step conversion (real param) FI;

+ 

+   . linefeed anweisung :

+       IF real conversion ok (param1)

+          THEN linefeed faktor    := real param;

+               letzte zeilenhoehe := neue zeilenhoehe;

+       FI;

+

+   . material anweisung :

+       material wert := param1;

+ 

+   . page anweisung :

+       IF seite ist offen

+          THEN IF NOT in letzter spalte

+                  THEN neue spalte

+                  ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                       papier laenge := maxint;

+               FI;

+          ELSE a ypos        := top margin;

+               papier laenge := maxint;

+       FI;

+ 

+   . pagelength anweisung :

+       IF real conversion ok (param1)

+          THEN pagelength   := y step conversion (real param);

+       FI;

+ 

+   . start anweisung :

+       IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI;

+       IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI;

+ 

+   . table anweisung :

+       tabellenmodus := TRUE;

+ 

+   . tableend anweisung :

+       tabellenmodus := FALSE;

+ 

+   . clearpos0 anweisung :

+       loesche tabellenspeicher;

+ 

+   . clearpos1 anweisung :

+       IF real conversion ok (param1) 

+          THEN int param := x step conversion (real param);

+               FOR tab index FROM 1 UPTO anzahl tabs

+               REP IF tab position = int param

+                      THEN tab typ := leer;

+                           delete int (tab liste, tab index);

+                           LEAVE clearpos1 anweisung;

+                   FI;

+               PER;

+       FI; 

+ 

+   . lpos rpos cpos dpos anweisung :

+       IF real conversion ok (param1)

+          THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; 

+ 

+   . bpos anweisung :

+       IF real conversion ok (param2) CAND real conversion ok (param1)

+            CAND real (param2) > real param

+          THEN neuer tab eintrag (a bpos, param2) FI;

+ 

+   . fillchar anweisung :

+        fill char := param1;

+ 

+   . textbegin0 anweisung :

+       aktuelle einrueckbreite := alte einrueckbreite;

+       mark index l            := alter mark index l;

+       mark index r            := alter mark index r;

+       loesche alte markierung;

+ 

+   . textbegin2 anweisung :

+       aktuelle einrueckbreite := alte einrueckbreite;

+       mark index l            := alter mark index l;

+       mark index r            := alter mark index r;

+       loesche alte markierung;

+       neuer durchschuss (int (param1), y step conversion (real (param 2)));

+ 

+   . textend anweisung :

+       alte einrueckbreite := aktuelle einrueckbreite;

+       alter mark index l  := mark index l;

+       alter mark index r  := mark index r;

+       loesche markierung;

+       loesche durchschuss;

+

+   . indentation anweisung :

+(*     IF real conversion ok (param1)

+          THEN int param   := x step conversion (real param);

+               left margin INCR (int param - indentation);

+               indentation :=    int param;

+       FI;

+  *)

+   . y tab anweisung :

+(*     IF real conversion ok (param1)

+          THEN int param := y step conversion (real param);

+               IF int param <= seitenlaenge THEN a ypos := int param FI;

+       FI;

+  *)

+       . param1 :

+           IF (params1 zeiger ISUB index) <> 0

+              THEN name (params1, params1 zeiger ISUB index)

+              ELSE ""

+           FI

+ 

+       . param2 :

+           IF (params2 zeiger ISUB index) <> 0

+              THEN name (params2, params2 zeiger ISUB index)

+              ELSE ""

+           FI

+ 

+

+.

+  drucke elan listing :

+    initialisiere elan listing;

+    WHILE NOT eof

+    REP next line (zeile);

+        zeilen nr INCR 1;

+        drucke elan zeile;

+    PER;

+    schliesse elan listing ab;

+ 

+.

+  initialisiere elan listing :

+    open document cmd;

+    hole elan list font;

+    initialisiere variablen;

+    elan fuss und kopf (1,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+    . open document cmd :

+        material wert         := "";

+        d token. offset index := 1;

+        erster ypos index d   := 0; 

+        vor erster seite      := FALSE;

+        seite ist offen       := FALSE;

+        open (document, x size, y size);

+        vor erster seite      := TRUE;

+ 

+    . hole elan list font :

+        d font := max (1, font ("elanlist"));

+        get replacements (d font, replacements, replacement tabelle);

+        einrueckbreite := indentation pitch (d font) ;

+        font hoehe     := font lead (d font) + font height (d font) + font depth (d font);

+ 

+    . initialisiere variablen :

+        innerhalb der define liste := FALSE;

+        vor erstem packet       := TRUE;

+        zeilen nr               := 0;

+        y wanted                := y size DIV 23;

+        pagelength              := y size - y wanted - y wanted; 

+        x wanted                := (min (x size DIV 10, x step conversion (2.54))

+                                        DIV einrueckbreite) * einrueckbreite; 

+        max zeichen zeile       := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite;

+        max zeichen fuss        := fusszeilenbreite;

+        layout laenge           := min (38, max zeichen zeile DIV 3);

+        layout laenge name      :=  layout laenge - zeilen nr laenge - 8; 

+        layout blanks           := (layout laenge - zeilen nr laenge - 1) * " "; 

+        refinement layout zeile := (layout laenge - 1) * " " ;

+        refinement layout zeile CAT "|" ;

+        IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65

+           THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI;

+ 

+        . fusszeilenbreite :

+            INT CONST dina 4 breite := x step conversion (21.0);

+            IF   x size <= dina 4 breite

+                 THEN (x size - 2 * x wanted) DIV einrueckbreite 

+            ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted

+                 THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite 

+                 ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite)

+            FI

+ 

+.

+  schliesse elan listing ab :

+    elan fuss und kopf (-1,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    close (document, 0);

+ 

+. 

+  drucke elan zeile :

+    IF pos (zeile, "#page#") = 1 

+       THEN IF nicht am seiten anfang THEN seiten wechsel FI;

+       ELSE bestimme elan layout;

+            bestimme elan zeile;

+            gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+            seitenwechsel wenn noetig;

+    FI;

+ 

+    . nicht am seitenanfang :

+        rest auf seite < pagelength - 3 * font hoehe

+ 

+    . seiten wechsel :

+        elan fuss und kopf (0,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. 

+  bestimme elan layout :

+    IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0

+       THEN leeres layout 

+       ELSE analysiere elan zeile

+    FI;

+    elan text CAT "|";

+ 

+    . leeres layout :

+        elan text := text (zeilen nr, zeilen nr laenge);

+        elan text CAT layout blanks;

+ 

+    . analysiere elan zeile :

+        scan (zeile);

+        next symbol (symbol, symbol type);

+        next symbol (naechstes symbol, naechster symbol type) ;

+        IF   packet anfang              THEN packet     layout 

+        ELIF innerhalb der define liste THEN leeres     layout; pruefe ende der define liste 

+        ELIF proc op anfang             THEN proc op    layout

+        ELIF refinement anfang          THEN refinement layout

+                                        ELSE leeres     layout

+        FI;

+ 

+    . packet anfang :

+        symbol = "PACKET"

+ 

+    . proc op anfang :

+        IF   proc oder op (symbol)

+             THEN naechster symbol type <> delimiter type

+        ELIF (symbol <> "END") AND proc oder op (naechstes symbol)

+             THEN symbol := naechstes symbol;

+                  next symbol (naechstes symbol, naechster symbol type) ;

+                  naechster symbol type <> delimiter type

+             ELSE FALSE

+        FI

+ 

+    . refinement anfang :

+        symbol type = tag type AND naechstes symbol = ":" 

+                                  AND NOT innerhalb der define liste 

+ 

+    . packet layout :

+        IF nicht am seiten anfang AND

+             (NOT vor erstem packet OR gedruckte seiten > 1)

+           THEN seiten wechsel FI;

+        layout ("   ", naechstes symbol, "*") ;

+        vor erstem packet := FALSE ;

+        innerhalb der define liste := TRUE;

+        pruefe ende der define liste;

+

+       . pruefe ende der define liste :

+           IF pos (zeile, ":") <> 0

+              THEN scan (zeile);

+                   WHILE innerhalb der define liste

+                   REP next symbol (symbol);

+                       IF symbol = ":" THEN innerhalb der define liste := FALSE FI;

+                   UNTIL symbol = "" PER;

+           FI;

+

+    . proc op layout :

+        IF   keine vier zeilen mehr

+             THEN seiten wechsel

+        ELIF nicht am seitenanfang

+             THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        FI ; 

+        layout ("   ", naechstes symbol, ".");

+ 

+        . keine vier zeilen mehr :

+            rest auf seite <= 8 * font hoehe 

+ 

+    . refinement layout :

+        IF   keine drei zeilen mehr

+             THEN seiten wechsel

+        ELIF nicht am seitenanfang

+             THEN elan text := refinement layout zeile;

+                  gib elan text aus

+                       (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+        FI ; 

+        layout ("      ", symbol, " ");

+ 

+        . keine drei zeilen mehr :

+            rest auf seite <= 7 * font hoehe 

+ 

+. 

+  bestimme elan zeile : 

+    IF zeile ist nicht zu lang

+       THEN elan text CAT zeile;

+       ELSE drucke zeile in teilen 

+    FI;

+ 

+    . zeile ist nicht zu lang :

+        zeilen laenge := LENGTH zeile;

+        zeilen laenge <= rest auf zeile

+ 

+       . rest auf zeile :

+           max zeichen zeile - LENGTH elan text

+ 

+    . drucke zeile in teilen :

+        zeilen pos := 1;

+        bestimme einrueckung;

+        WHILE zeile noch nicht ganz gedruckt REP teil layout PER;

+ 

+    . bestimme einrueckung :

+        anzahl einrueck blanks := naechstes nicht blankes zeichen - 1;

+        IF anzahl einrueck blanks > rest auf zeile - 20

+           THEN anzahl einrueck blanks := 0 FI;

+ 

+    . zeile noch nicht ganz gedruckt :

+        bestimme zeilenteil;

+        NOT zeile ist zu ende

+ 

+        . bestimme zeilenteil :

+            bestimme laenge;

+            zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1);

+            elan text CAT zeilen teil;

+            zeilen pos INCR laenge;

+ 

+            . zeilen teil : par1

+

+            . bestimme laenge :

+               INT VAR laenge := zeilen laenge - zeilen pos + 1;

+               IF laenge > rest auf zeile

+                  THEN laenge := rest auf zeile;

+                       WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " "

+                       REP laenge DECR 1 UNTIL laenge = 0 PER;

+                       IF laenge = 0 THEN laenge := rest auf zeile FI;

+               FI;

+ 

+    . teil layout :

+        gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        elan text :=  (zeilen nr laenge - 1) * " "; 

+        elan text CAT "+";

+        elan text CAT layout blanks;

+        elan text CAT "|";

+        elan text cat blanks (anzahl einrueck blanks + teil einrueckung);

+ 

+. 

+  seiten wechsel wenn noetig :

+    IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; 

+ 

+    . keine zeilen mehr :

+        rest auf seite <= 4 * font hoehe 

+ 

+END PROC drucke datei;

+ 

+ 

+BOOL PROC real conversion ok (TEXT CONST param) :

+     real param := real (param);

+     last conversion ok AND real param >= 0.0

+END PROC real conversion ok;

+ 

+ 

+BOOL PROC int conversion ok (TEXT CONST param) :

+     int param := int (param);

+     last conversion ok AND int param >= 0 

+END PROC int conversion ok;

+ 

+ 

+PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) :

+ 

+     suche neuen eintrag;

+     sortiere neue tab position ein;

+     tab typ      := typ;

+     tab position := neue tab position;

+     tab param    := eventueller parameter;

+ 

+     . suche neuen eintrag :

+         INT VAR index := 0;

+         REP index INCR 1;

+             IF tab speicher (index). tab typ = leer

+                THEN LEAVE suche neuen eintrag FI;

+         UNTIL index = max tabs PER;

+         LEAVE neuer tab eintrag;

+ 

+     . sortiere neue tab position ein :

+         INT VAR neue tab position := x step conversion (real param);

+         FOR tab index FROM 1 UPTO anzahl tabs

+         REP IF   tab position = neue tab position

+                THEN LEAVE neuer tab eintrag

+             ELIF tab position > neue tab position

+                THEN insert int (tab liste, tab index, index);

+                     LEAVE sortiere neue tab position ein;

+             FI;

+         PER;

+         tab liste CAT index;

+         tab index :=  anzahl tabs;

+ 

+     . eventueller parameter :

+         INT VAR link;

+         SELECT typ OF

+           CASE a dpos : insert (d strings, param, link); link

+           CASE a bpos : x step conversion (real(param))

+             OTHERWISE : 0

+         END SELECT

+ 

+END PROC neuer tab eintrag;

+ 

+ 

+PROC neue spalte :

+     a ypos           :=  top margin;

+     left margin     INCR (limit + luecke);

+     aktuelle spalte INCR 1;

+END PROC neue spalte ;

+ 

+ 

+BOOL PROC proc oder op (TEXT CONST symbol) :

+

+  symbol = "PROC" OR symbol = "PROCEDURE"

+    OR symbol = "OP" OR symbol = "OPERATOR" 

+

+ENDPROC proc oder op ;

+ 

+ 

+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :

+

+name := subtext (name, 1, layout laenge name) ;

+elan text :=  text (zeilen nr, zeilen nr laenge);

+elan text CAT pre;

+elan text CAT name;

+elan text CAT " ";

+generiere strukturiertes layout;

+ 

+. generiere strukturiertes layout :

+    INT VAR index;

+    FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1

+        REP elan text CAT post PER;

+

+ENDPROC layout ;

+ 

+ 

+PROC elan text cat blanks (INT CONST anzahl) :

+ 

+  par2 := anzahl * " ";

+  elan text CAT par2;

+ 

+END PROC elan text cat blanks;

+ 

+ 

+(***********************************************************************)

+ 

+PROC analysiere zeile : 

+ 

+loesche analysespeicher;

+behandle fuehrende blanks;

+pruefe ob anweisungszeile;

+pruefe ob markierung links;

+ 

+IF   tabellen modus

+     THEN analysiere tabellenzeile

+ELIF letzte zeile war absatzzeile 

+     THEN analysiere zeile nach absatzzeile 

+     ELSE analysiere zeile nach blockzeile

+FI; 

+ 

+pruefe center und right modus;

+pruefe ob tabulation vorliegt;

+werte indexspeicher aus;

+berechne zeilenhoehe;

+pruefe ob markierung rechts;

+ 

+.

+  analysiere zeile nach absatzzeile :

+    test auf aufzaehlung;

+    IF zeile muss geblockt werden 

+       THEN analysiere blockzeile nach absatzzeile 

+       ELSE analysiere absatzzeile nach absatzzeile 

+    FI; 

+.

+  analysiere zeile nach blockzeile :

+    IF zeile muss geblockt werden 

+       THEN analysiere blockzeile nach blockzeile 

+       ELSE analysiere absatzzeile nach blockzeile

+    FI; 

+ 

+ 

+.

+  behandle fuehrende blanks :

+    zeilenpos := 1;

+    zeilenpos := naechstes nicht blankes zeichen; 

+    IF zeilenpos = 0

+       THEN behandle leerzeile;

+            LEAVE analysiere zeile;

+       ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; 

+            IF letzte zeile war absatzzeile THEN neue einrueckung FI;

+            initialisiere analyse;

+    FI;

+ 

+    . behandle leerzeile :

+        a ypos INCR (letzte zeilenhoehe + durchschuss);

+        zeile ist absatzzeile := LENGTH zeile > 0;

+        pruefe ob markierung links;

+        pruefe ob markierung rechts;

+ 

+    . neue einrueckung :

+        aktuelle einrueckbreite := einrueckbreite;

+ 

+    . initialisiere analyse :

+        zeile ist absatzzeile        := (zeile SUB LENGTH zeile) = blank;

+        zeile muss geblockt werden   := block modus AND NOT zeile ist absatzzeile;

+        erstes token der zeile       := token index f + 1;

+        groesste fonthoehe           := fonthoehe;

+        aktuelle zeilenhoehe         := letzte zeilenhoehe;

+        zeilen laenge                := laenge der zeile;

+        anzahl einrueck blanks       := zeilen pos - 1; 

+        anzahl zeichen               := anzahl einrueck blanks;

+        a xpos                       := left margin + anzahl zeichen * aktuelle einrueckbreite; 

+        a modifikationen fuer x move := 0;

+        letzter font                 := a font;

+        letzte modifikationen        := a modifikationen;

+        IF zeile muss geblockt werden THEN initialisiere tab variablen FI;

+

+        . laenge der zeile :

+            IF zeile ist absatzzeile

+               THEN LENGTH zeile - 1

+               ELSE LENGTH zeile 

+            FI

+.

+  pruefe ob anweisungszeile :

+    IF erstes zeichen ist anweisungszeichen

+       THEN REP analysiere anweisung;

+                IF zeile ist zu ende THEN LEAVE analysiere zeile FI;

+            UNTIL zeichen ist kein anweisungs zeichen PER;

+    FI;

+ 

+    . erstes zeichen ist anweisungszeichen :

+        pos (zeile, anweisungszeichen, 1, 1) <> 0

+ 

+    . zeichen ist kein anweisungszeichen :

+        pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0

+ 

+.

+  pruefe ob markierung links :

+    IF markierung links

+       THEN mark token (mark index l). xpos := 

+                             left margin - mark token (mark index l). breite;

+            lege markierungs token an (mark index l);

+            erstes token der zeile := token index f + 1;

+            initialisiere tab variablen;

+    FI;

+ 

+. 

+  analysiere tabellenzeile : 

+    anfangs blankmodus := doppel blank;

+    alte zeilenpos     := zeilen pos;

+    a xpos             := 0;

+    FOR tab index FROM 1 UPTO anzahl tabs

+    REP lege fuell token an wenn noetig;

+        initialisiere tab variablen; 

+        SELECT tab typ OF

+          CASE a lpos  :  linksbuendige spalte

+          CASE a rpos  :  rechtsbuendige spalte

+          CASE a cpos  :  zentrierte spalte

+          CASE a dpos  :  dezimale spalte

+          CASE a bpos  :  geblockte spalte

+        END SELECT;

+        berechne fuell token wenn noetig;

+        tabulation;

+    PER;

+    analysiere rest der zeile;

+ 

+    . lege fuell token an wenn noetig :

+        IF fill char <> blank

+           THEN fuellzeichen                 := fill char;

+                fuellzeichen breite          := string breite (fuellzeichen);

+                token zeiger                 := zeilen pos;

+                erstes fuell token           := token index f + 1;

+                lege text token an;

+                letztes fuell token          := token index f;

+                a modifikationen fuer x move := a modifikationen

+        FI;

+ 

+    . berechne fuell token wenn noetig :

+        IF erstes fuell token <> leer

+           THEN IF letztes fuell token <> token index f 

+                   THEN berechne fuell token;

+                   ELSE loesche letzte token;

+                FI;

+                erstes fuell token := leer

+        FI;

+ 

+        . berechne fuell token :

+            INT VAR anzahl fuellzeichen, fuell breite;

+            token index         := erstes fuell token;

+            anzahl fuellzeichen := (tab anfang - t. xpos + left margin) 

+                                                 DIV fuellzeichen breite;

+            rest                := (tab anfang - t. xpos + left margin) 

+                                                 MOD fuellzeichen breite;

+            IF anzahl fuell zeichen > 0

+               THEN fuell text   := anzahl fuellzeichen * fuellzeichen; 

+                    fuell breite := anzahl fuellzeichen * fuellzeichen breite; 

+                    FOR token index FROM erstes fuell token UPTO letztes fuell token

+                    REP t. text   := fuell text;

+                        t. breite := fuell breite;

+                        IF erstes fuell token <> erstes token der zeile

+                           THEN t. xpos INCR rest DIV 2;

+                                t. modifikationen fuer x move := t. modifikationen;

+                        FI;

+                    PER;

+            FI;

+ 

+            . fuell text : par1

+ 

+        . loesche letzte token :

+            FOR token index FROM letztes fuell token DOWNTO erstes fuell token

+            REP loesche letztes token PER;

+ 

+    . tabulation :

+        alte zeilenpos := zeilenpos;

+        zeilenpos := naechstes nicht blankes zeichen; 

+        IF zeilenpos = 0

+           THEN zeilenpos := zeilenlaenge + 1; 

+                LEAVE analysiere tabellenzeile;

+        FI;

+        anzahl zeichen INCR zeilenpos - alte zeilenpos; 

+ 

+    . linksbuendige spalte : 

+        a xpos     := left margin + tab position;

+        tab anfang := tab position;

+        bestimme token bis terminator oder zeilenende;

+ 

+    . rechtsbuendige spalte :

+        bestimme token bis terminator oder zeilenende;

+        schreibe zeile rechtsbuendig (tab position);

+ 

+    . zentrierte spalte :

+        bestimme token bis terminator oder zeilenende;

+        zentriere zeile (tab position);

+ 

+    . dezimale spalte :

+        d string                  := name (d strings, tab param);

+        d code 1                  := code (d string SUB 1) + 1;

+        d pitch                   := zeichenbreiten (d code 1);

+        zeichenbreiten (d code 1) := d code ausgang;

+        bestimme token bis terminator oder zeilenende;

+        zeichenbreiten (d code 1) := d pitch;

+        d code 1                  := leer;

+        schreibe zeile rechtsbuendig (tab position);

+        IF zeichen ist dezimal zeichen

+           THEN IF tab position <> zeilen breite

+                   THEN a xpos     := left margin + tab position;

+                        tab anfang := tab position;

+                FI;

+                bestimme token bis terminator oder zeilenende

+        FI;

+ 

+        . zeichen ist dezimal zeichen :

+            pos (zeile, d string,  zeilen pos) = zeilen pos

+ 

+    . geblockte spalte :

+        blankmodus := einfach blank;

+        a xpos     := left margin + tab position;

+        tab anfang := tab position;

+        REP bestimme token bis terminator oder zeilenende; 

+            IF zeile ist zu ende OR naechstes zeichen ist blank

+               THEN blocke spalte wenn noetig;

+                    LEAVE geblockte spalte;

+               ELSE dehnbares blank gefunden;

+            FI;

+        PER;

+ 

+        . blocke spalte wenn noetig :

+            IF letztes zeichen ist kein geschuetztes blank

+               THEN blocke zeile (tab param) FI;

+            blank modus := doppel blank;

+ 

+        . letztes zeichen ist kein geschuetztes blank :

+            pos (zeile, geschuetztes blank,  zeilen pos - 1, zeilen pos - 1) = 0

+              AND NOT within kanji (zeile, zeilen pos - 2)

+

+    . analysiere rest der zeile :

+        blankmodus := keine blankanalyse;

+        zeilen pos := alte zeilenpos;

+        bestimme token bis terminator oder zeilenende;

+ 

+.

+  test auf aufzaehlung : 

+    anfangs blankmodus := einfach blank;

+    bestimme token bis terminator oder zeilenende;

+    IF zeile ist zu ende

+       THEN LEAVE analysiere zeile nach absatzzeile

+       ELSE aufzaehlung moeglich

+    FI;

+ 

+    . aufzaehlung moeglich :

+        bestimme letztes zeichen;

+        IF    (anzahl zeichen bei aufzaehlung < 2  AND letztes zeichen = "-")

+           OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":")

+           OR (anzahl zeichen bei aufzaehlung < 7

+                                        AND pos (".)", letztes zeichen) <> 0)

+           OR naechstes zeichen ist blank

+          THEN tabulator position gefunden;

+        ELIF zeile muss geblockt werden

+          THEN dehnbares blank gefunden;

+        FI;

+ 

+        . bestimme letztes zeichen : 

+            token index := token index f;

+            WHILE token index >= erstes token der zeile

+            REP IF token ist text token 

+                   THEN letztes zeichen := t. text SUB LENGTH t. text;

+                        LEAVE bestimme letztes zeichen;

+                FI;

+                token index DECR 1;

+            PER;

+            letztes zeichen := "";

+ 

+        . letztes zeichen : par1

+ 

+        . anzahl zeichen bei aufzaehlung :

+            anzahl zeichen - anzahl einrueck blanks

+ 

+        . token ist text token :

+            t. offset index >= text token

+.

+  analysiere blockzeile nach absatzzeile :

+    REP bestimme token bis terminator oder zeilenende; 

+        IF zeile ist zu ende 

+           THEN blocke zeile (limit);

+                LEAVE analysiere blockzeile nach absatzzeile

+           ELSE analysiere blank in blockzeile nach absatzzeile 

+        FI;

+    PER;

+ 

+    . analysiere blank in blockzeile nach absatzzeile : 

+        IF naechstes zeichen ist blank

+           THEN tabulator position gefunden;

+           ELSE dehnbares blank gefunden;

+        FI;

+ 

+.

+  analysiere absatzzeile nach absatzzeile :

+    blankmodus := doppel blank;

+    REP bestimme token bis terminator oder zeilenende;

+        IF zeile ist zu ende 

+           THEN LEAVE analysiere absatzzeile nach absatzzeile

+           ELSE tabulator position gefunden

+        FI;

+    PER;

+ 

+.

+  analysiere blockzeile nach blockzeile :

+    anfangs blankmodus := einfach blank;

+    REP bestimme token bis terminator oder zeilenende;

+        IF zeile ist zu ende 

+           THEN blocke zeile (limit);

+                LEAVE analysiere blockzeile nach blockzeile

+           ELSE dehnbares blank gefunden 

+        FI;

+    PER;

+ 

+.

+  analysiere absatzzeile nach blockzeile :

+    anfangs blankmodus := keine blankanalyse;

+    bestimme token bis terminator oder zeilenende;

+

+.

+  dehnbares blank gefunden :

+    anzahl zeichen INCR 1;

+    zeilenpos      INCR 1;

+    a xpos         INCR blankbreite;

+    a modifikationen fuer x move := a modifikationen;

+    IF NOT a block token

+       THEN anzahl blanks  INCR 1;

+            a block token := TRUE; 

+    FI;

+.

+  tabulator position gefunden :

+    alte zeilenpos := zeilenpos; 

+    zeilenpos := naechstes nicht blankes zeichen;

+    IF zeilenpos = 0 

+       THEN zeilenpos := zeilen laenge + 1;

+       ELSE IF erstes token der zeile > token index f

+               THEN token zeiger := zeilen pos;

+                    lege text token an;

+            FI;

+            anzahl zeichen INCR (zeilenpos - alte zeilenpos);

+            a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; 

+            a modifikationen fuer x move := a modifikationen;

+            IF zeile muss geblockt werden THEN initialisiere tab variablen FI;

+    FI;

+ 

+.

+  pruefe center und right modus : 

+    IF center modus THEN zentriere zeile (limit DIV 2) FI;

+    IF right  modus THEN schreibe zeile rechtsbuendig (limit) FI;

+.

+  pruefe ob tabulation vorliegt:

+    IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite

+       THEN a modifikationen fuer x move := a modifikationen; 

+            token zeiger := zeilen pos;

+            lege text token an;

+    FI;

+.

+  werte indexspeicher aus :

+    INT VAR index;

+    IF index zaehler > 0

+       THEN FOR index FROM index zaehler DOWNTO 1

+                REP a ypos DECR (verschiebungen ISUB index) PER;

+            stelle neuen font ein (grosse fonts ISUB 1);

+            loesche index speicher;

+    FI;

+.

+  berechne zeilenhoehe :

+    verschiebung := aktuelle zeilenhoehe + durchschuss;

+    a ypos INCR verschiebung;

+    verschiebe token ypos (verschiebung);

+ 

+.

+  pruefe ob markierung rechts :

+    IF markierung rechts

+       THEN mark token (mark index r). xpos := left margin + limit;

+            lege markierungs token an (mark index r);

+    FI;

+ 

+END PROC analysiere zeile;

+ 

+ 

+PROC blocke zeile (INT CONST rechter rand) :

+ 

+rest := rechter rand - zeilen breite;

+IF rest > 0 AND anzahl blanks > 0

+   THEN INT CONST schmaler schritt       := rest DIV anzahl blanks,

+                  breiter schritt        := schmaler schritt + 1,

+                  anzahl breite schritte := rest MOD anzahl blanks;

+        IF rechts

+           THEN blocke token xpos (breiter schritt, schmaler schritt,

+                                                     anzahl breite schritte);

+                rechts := FALSE; 

+           ELSE blocke token xpos (schmaler schritt, breiter schritt,

+                                     anzahl blanks - anzahl breite schritte);

+                rechts := TRUE;

+       FI;

+       a xpos INCR ( breiter schritt * anzahl breite schritte +

+              schmaler schritt * (anzahl blanks - anzahl breite schritte) );

+FI;

+ 

+END PROC blocke zeile;

+ 

+ 

+PROC zentriere zeile (INT CONST zentrier pos) :

+ 

+IF erstes tab token <= token index f

+   THEN verschiebung := zentrier pos - tab anfang -

+                                   (zeilen breite - tab anfang) DIV 2; 

+        verschiebe token xpos (verschiebung);

+        a xpos     INCR verschiebung; 

+        tab anfang INCR verschiebung; 

+FI;

+center modus := FALSE;

+ 

+END PROC zentriere zeile;

+

+

+PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) :

+ 

+IF erstes tab token <= token index f

+   THEN verschiebung := rechte pos - zeilen breite;

+        verschiebe token xpos (verschiebung);

+        a xpos     INCR verschiebung;

+        tab anfang INCR verschiebung; 

+FI;

+right modus := FALSE;

+ 

+ 

+END PROC schreibe zeile rechtsbuendig;

+

+ 

+PROC bestimme token bis terminator oder zeilenende :

+ 

+token zeiger := zeilen pos;

+REP stranalyze (zeichenbreiten, a breite, max breite, 

+                zeile, zeilen pos, zeilen laenge,

+                ausgang);

+    zeilen pos INCR 1;

+    IF   ausgang = blank ausgang

+         THEN analysiere blank

+    ELIF ausgang = anweisungs ausgang

+         THEN anweisung gefunden

+    ELIF ausgang = d code ausgang

+         THEN analysiere d string

+    ELIF ausgang = erweiterungs ausgang

+         THEN erweiterung gefunden

+         ELSE terminator oder zeilenende gefunden

+    FI;

+PER;

+ 

+. analysiere blank :

+    IF blankmodus = einfach blank OR

+       (blankmodus = doppel blank AND naechstes zeichen ist blank)

+       THEN terminator oder zeilenende gefunden 

+       ELSE a breite INCR blankbreite;

+            zeilenpos INCR 1;

+    FI;

+ 

+. analysiere d string :

+    IF pos (zeile, d string, zeilen pos) = zeilen pos 

+       THEN terminator oder zeilenende gefunden 

+       ELSE IF   d pitch = maxint

+                 THEN erweiterung gefunden

+            ELIF d pitch < 0

+                 THEN a breite INCR (d pitch XOR - maxint - 1); 

+                      zeilen pos INCR 2; 

+                 ELSE a breite INCR d pitch; 

+                      zeilenpos INCR 1;

+            FI;

+    FI;

+ 

+. erweiterung gefunden :

+    a breite INCR extended char pitch (a font, zeile SUB zeilen pos, 

+                                               zeile SUB zeilen pos + 1); 

+    zeilen pos INCR 2;

+ 

+. anweisung gefunden :

+    gegebenfalls neues token gefunden;

+    analysiere anweisung;

+    IF zeile ist zu ende

+       THEN LEAVE bestimme token bis terminator oder zeilenende FI;

+    token zeiger := zeilenpos;

+ 

+. terminator oder zeilenende gefunden :

+    IF ausgang = null ausgang THEN  zeilen laenge DECR 1 FI;

+    gegebenfalls neues token gefunden;

+    LEAVE bestimme token bis terminator oder zeilenende;

+ 

+    . gegebenfalls neues token gefunden :

+        IF token zeiger < zeilenpos THEN lege text token an FI;

+ 

+END PROC bestimme token bis terminator oder zeilen ende;

+

+ 

+PROC analysiere anweisung :

+ 

+   bestimme anweisung;

+   IF anweisung ist kommando

+      THEN lege kommando token an;

+      ELSE werte anweisung aus; 

+   FI;

+ 

+    . anweisungsanfang : token zeiger

+ 

+    . anweisungsende   : zeilen pos - 2

+ 

+    . erstes zeichen   : par1

+ 

+. bestimme anweisung :

+    anweisungsanfang := zeilenpos + 1;

+    zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge);

+    IF zeilenpos = 0

+       THEN zeilenpos := anweisungsanfang - 1;

+            replace (zeile, zeilenpos, geschuetztes anweisungszeichen);

+            LEAVE analysiere anweisung;

+    FI;

+    zeilen pos INCR 1; 

+    anweisung      := subtext (zeile, anweisungsanfang, anweisungsende);

+    erstes zeichen := anweisung SUB 1;

+ 

+. anweisung ist kommando : 

+    IF   erstes zeichen = quote

+         THEN scan (anweisung);

+              next symbol (anweisung, symbol type);

+              next symbol (par2, naechster symbol type);

+              IF symbol type <> text type OR naechster symbol type <> eof type

+                 THEN LEAVE analysiere anweisung FI;

+              TRUE

+    ELIF erstes zeichen = druckerkommando zeichen

+         THEN delete char (anweisung, 1);

+              TRUE

+         ELSE FALSE

+    FI

+ 

+. 

+  werte anweisung aus :

+    analyze command (anweisungs liste, anweisung, number type,

+                     anweisungs index, anzahl params, par1, par2);

+    SELECT anweisungs index OF

+      CASE a type           : type anweisung

+      CASE a on             : on anweisung

+      CASE a off            : off anweisung

+      CASE a ub, a fb       : ub fb anweisung

+      CASE a ue, a fe       : ue fe anweisung

+      CASE a center         : center anweisung

+      CASE a right          : right anweisung

+      CASE a up, a down     : index anweisung

+      CASE a end up or down : end index anweisung

+      CASE a bsp            : bsp anweisung

+      CASE a fillchar       : fillchar anweisung

+      CASE a mark           : mark anweisung

+      CASE a markend        : markend anweisung

+      OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI;

+    END SELECT;

+ 

+    . type anweisung :

+        change all (par1, " ", "");

+        stelle neuen font ein (font (par1));

+        groesste fonthoehe := max (groesste fonthoehe, fonthoehe);

+        a modifikationen   := 0;

+        IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI;

+ 

+        . nicht innerhalb eines indexes :

+            index zaehler = 0

+ 

+        . berechne aktuelle zeilenhoehe :

+            IF linefeed faktor >= 1.0

+              THEN aktuelle zeilenhoehe := max (groesste   fonthoehe,

+                                                       letzte zeilenhoehe);

+              ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe,

+                                                       letzte zeilenhoehe);

+           FI;

+ 

+    . on anweisung :

+        par1 := par1 SUB 1;

+        IF pos (modifikations liste, par1) > 0

+           THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 );

+        FI;

+ 

+    . off anweisung :

+        par1 := par1 SUB 1;

+        IF pos (modifikations liste, par1) > 0

+           THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 );

+        FI;

+

+    . ub fb anweisung :

+        IF anweisungs index = a ub

+           THEN par1 := "u"

+           ELSE par1 := "b"

+        FI;

+        on anweisung;

+

+    . ue fe anweisung :

+        IF anweisungs index = a ue

+           THEN par1 := "u"

+           ELSE par1 := "b"

+        FI;

+        off anweisung;

+

+    . center anweisung :

+        IF NOT zeile muss geblockt werden AND NOT tabellen modus

+               AND NOT right modus

+           THEN center modus := TRUE;

+                blankmodus   := keine blankanalyse;

+                initialisiere tab variablen; 

+        FI;

+ 

+    . right anweisung :

+        IF NOT zeile muss geblockt werden AND NOT tabellen modus

+           THEN IF center modus THEN zentriere zeile (limit DIV 2) FI;

+                right modus := TRUE;

+                blankmodus  := keine blankanalyse;

+                initialisiere tab variablen; 

+        FI;

+ 

+    . index anweisung :

+        INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; 

+        INT VAR   kleiner font;

+        IF next smaller font exists (grosser font, kleiner font)

+           THEN stelle neuen font ein (kleiner font) FI;

+        IF font hoehe < grosse fonthoehe

+           THEN berechne verschiebung fuer kleinen font

+           ELSE berechne verschiebung fuer grossen font

+        FI;

+        a ypos INCR verschiebung;

+        merke grossen font und verschiebung;

+ 

+        . berechne verschiebung fuer kleinen font :

+            IF anweisungs index = a down

+               THEN verschiebung :=     15 PROZENT grosse fonthoehe;

+               ELSE verschiebung :=  - ( 9 PROZENT grosse fonthoehe )

+                                     - (grosse fonthoehe - fonthoehe);

+            FI;

+ 

+        . berechne verschiebung fuer grossen font :

+            IF anweisungs index = a down

+               THEN verschiebung :=    25 PROZENT fonthoehe;

+               ELSE verschiebung := - (50 PROZENT fonthoehe);

+            FI;

+ 

+        . merke grossen font und verschiebung :

+            index zaehler INCR 1;

+            grosse fonts   CAT grosser font;

+            verschiebungen CAT verschiebung;

+            IF index zaehler = 1

+               THEN alter blankmodus := blankmodus; 

+                          blankmodus := keine blankanalyse;

+            FI;

+ 

+    . end index anweisung :

+        IF index zaehler > 0

+           THEN schalte auf groesseren font zurueck;

+        FI;

+ 

+        . schalte auf groesseren font zurueck :

+            a ypos DECR (verschiebungen ISUB index zaehler);

+            stelle neuen font ein (grosse fonts ISUB index zaehler);

+            IF index zaehler = 1

+               THEN blankmodus := alter blankmodus;

+            FI;

+            index zaehler DECR 1;

+            verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler);

+            grosse fonts   := subtext (grosse fonts,   1, 2 * index zaehler);

+ 

+    . bsp anweisung :

+        INT VAR breite davor, breite dahinter;

+        IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge

+           THEN IF is kanji esc (zeile SUB anweisungs anfang - 3)

+                   THEN zeichen davor := subtext (zeile, anweisungs anfang - 3,

+                                                         anweisungs anfang - 2);

+                   ELSE zeichen davor := zeile SUB anweisungs anfang - 2;

+                FI;

+                IF is kanji esc (zeile SUB anweisungs ende + 2)

+                   THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2,

+                                                            anweisungs ende + 3 );

+                   ELSE zeichen dahinter := zeile SUB anweisungs ende + 2;

+                FI;

+                IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 

+                   THEN breite davor    := char pitch (a font, zeichen davor);

+                        breite dahinter := char pitch (a font, zeichen dahinter);

+                        IF breite davor < breite dahinter THEN vertausche zeichen FI;

+                        lege token fuer zeichen dahinter an;

+                        a xpos INCR (breite davor - breite dahinter) DIV 2; 

+                FI;

+        FI;

+ 

+        . zeichen davor    : par1

+        . zeichen dahinter : par2

+ 

+        . vertausche zeichen :

+            change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, 

+                           anweisungs anfang - 2, zeichen dahinter);

+            change (zeile, anweisungs ende + 2,

+                           anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor);

+            change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1,

+                              LENGTH tf. text, zeichen dahinter);

+            tf. breite INCR (breite dahinter - breite davor);

+            a xpos     INCR (breite dahinter - breite davor);

+            int param        := breite davor;

+            breite davor     := breite dahinter;

+            breite dahinter  := int param;

+ 

+        . lege token fuer zeichen dahinter an :

+            token zeiger := zeilen pos;

+            a breite     := breite dahinter;

+            zeilen pos INCR LENGTH zeichen dahinter;

+            a xpos     DECR (breite davor + breite dahinter) DIV 2; 

+            lege text token an;

+            anzahl zeichen DECR 1;

+ 

+    . fillchar anweisung :

+        IF par1 = "" THEN par1 := " " FI;

+        fill char := par1;

+        speichere anweisung;

+ 

+    . mark anweisung :

+        IF par1 <> "" 

+           THEN mark index l := (alter mark index l MOD 2) + 1;

+                neue markierung (par1, mark index l);

+           ELSE mark index l := 0;

+        FI;

+        IF par2 <> "" 

+           THEN mark index r := (alter mark index r MOD 2) + 3;

+                neue markierung (par2, mark index r);

+           ELSE mark index r := 0;

+        FI;

+ 

+    . markend anweisung :

+        loesche markierung;

+ 

+    . speichere anweisung :

+        anweisungs zaehler INCR 1;

+        anweisungs indizes CAT anweisungs index;

+        IF par1 <> ""

+           THEN insert (params1, par1); 

+                params1 zeiger CAT highest entry (params1);

+           ELSE params1 zeiger CAT 0;

+        FI;

+        IF par2 <> ""

+           THEN insert (params2, par2); 

+                params2 zeiger CAT highest entry (params2);

+           ELSE params2 zeiger CAT 0;

+        FI;

+ 

+END PROC analysiere anweisung;

+ 

+ 

+PROC stelle neuen font ein (INT CONST font nr ) :

+

+  IF font nr <> a font THEN neuer font FI;

+ 

+  . neuer font :

+      a font := max (1, font nr);

+      get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe,

+                zeichenbreiten);

+      font hoehe INCR (font durchschuss + font tiefe);

+      letzte zeilenhoehe                         := neue zeilenhoehe;

+      blankbreite                                := zeichenbreiten (blank code 1);

+      zeichenbreiten (blank code 1)              := blank ausgang;

+      zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang;

+      font offsets                               := y offsets (a font);

+      offsets                                    := LENGTH font offsets > 2;

+      IF d code 1 <> leer

+         THEN d pitch                            := zeichenbreiten (d code 1);

+              zeichenbreiten (d code 1)          := d code ausgang;

+     FI;

+ 

+END PROC stelle neuen font ein;

+ 

+ 

+INT OP PROZENT (INT CONST prozent, wert) :

+ 

+    (wert * prozent + 99) DIV 100

+ 

+END OP PROZENT; 

+ 

+ 

+PROC neue markierung (TEXT CONST text, INT CONST mark index) :

+ 

+      mark token (mark index). text           := text;

+      mark token (mark index). breite         := string breite (text);

+      mark token (mark index). font           := a font;

+      mark token (mark index). modifikationen := a modifikationen;

+ 

+END PROC neue markierung;

+ 

+ 

+INT PROC string breite (TEXT CONST string) :

+ 

+    INT VAR summe := 0, pos := 1;

+    REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang);

+        IF   ausgang = erweiterungs ausgang

+             THEN summe INCR extended char pitch (a font,

+                                       string SUB pos+1, string SUB pos+2);

+                  pos INCR 3;

+        ELIF ausgang = blank ausgang

+             THEN summe INCR blankbreite;

+                  pos INCR 2;

+        ELIF ausgang = anweisungs ausgang

+             THEN summe INCR char pitch (a font, anweisungszeichen);

+                  pos INCR 2;

+             ELSE LEAVE string breite WITH summe

+        FI;

+    PER;

+    0

+ 

+END PROC string breite;

+ 

+(*******************************************************************)

+ 

+PROC lege text token an :

+ 

+  aktuelle ypos := a ypos + (font offsets ISUB 1); 

+  neuer token index;

+  uebertrage text token (tf);

+  IF offsets THEN lege offsets an (font offsets) FI;

+  stranalyze (zeichen zaehler, anzahl zeichen, max int,

+              zeile, token zeiger, zeilen pos - 1, ausgang);

+  a xpos                       INCR a breite;

+  a breite                     := 0;

+  a modifikationen fuer x move := 0;

+  a block token                := FALSE;

+ 

+END PROC lege text token an;

+ 

+ 

+PROC uebertrage text token (TOKEN VAR tf) :

+ 

+  tf. text                       := subtext (zeile, token zeiger, zeilenpos - 1);

+  tf. xpos                       := a xpos;

+  tf. breite                     := a breite;

+  tf. font                       := a font;

+  tf. modifikationen             := a modifikationen;

+  tf. modifikationen fuer x move := a modifikationen fuer x move;

+  tf. offset index               := text token;

+  tf. block token                := a block token;

+

+END PROC uebertrage text token;

+ 

+ 

+PROC lege kommando token an :

+ 

+  aktuelle ypos := a ypos + (font offsets ISUB 1); 

+  neuer token index;

+  uebertrage kommando token (tf);

+  a modifikationen fuer x move := 0;

+  a block token                := FALSE;

+ 

+END PROC lege kommando token an;

+ 

+ 

+PROC uebertrage kommando token (TOKEN VAR tf) :

+ 

+  tf. text                       := anweisung;

+  tf. breite                     := 0;

+  tf. xpos                       := a xpos;

+  tf. font                       := a font;

+  tf. modifikationen             := a modifikationen;

+  tf. modifikationen fuer x move := a modifikationen fuer x move;

+  tf. offset index               := kommando token;

+  tf. block token                := a block token;

+ 

+END PROC uebertrage kommando token;

+ 

+ 

+PROC lege markierungs token an (INT CONST mark index) :

+ 

+  aktuelle ypos := a ypos + (mark font offsets ISUB 1); 

+  neuer token index;

+  tf := mark token (mark index);

+  IF mark offsets THEN lege offsets an (mark font offsets) FI;

+ 

+  . mark font offsets   : y offsets (mark token (mark index). font)

+ 

+  . mark offsets        : LENGTH mark font offsets > 2

+ 

+END PROC lege markierungs token an;

+ 

+ 

+PROC lege offsets an (TEXT CONST offsets) :

+ 

+  INT CONST anzahl offsets := LENGTH offsets DIV 2;

+  offset token := tf;

+  offset token. block token := FALSE;

+  reset bit (offset token. modifikationen, underline bit);

+  FOR index FROM 2 UPTO anzahl offsets

+  REP aktuelle ypos := a ypos + (offsets ISUB index); 

+      neuer token index;

+      tf               := offset token;

+      tf. offset index := index;

+  PER;

+ 

+END PROC lege offsets an;

+ 

+ 

+PROC neuer token index :

+ 

+IF   erster ypos index a = 0

+     THEN erste ypos

+ELIF ya. ypos = aktuelle ypos 

+     THEN neues token bei gleicher ypos

+     ELSE fuege neue ypos ein

+FI;

+ 

+  . erste ypos :

+      ypos  index f INCR 1;

+          erster     ypos index a := ypos index f;

+          letzter    ypos index a := ypos index f;

+      yf. vorheriger ypos index   := 0;

+      yf. naechster  ypos index   := 0;

+      erstes token bei neuer ypos;

+ 

+  . fuege neue ypos ein :

+      letztes token bei gleicher ypos;

+      IF ya. ypos > aktuelle ypos

+         THEN richtige ypos ist oberhalb

+         ELSE richtige ypos ist unterhalb

+      FI;

+ 

+      . richtige ypos ist oberhalb :

+          REP ypos index a := ya. vorheriger ypos index;

+              IF   ypos index a = 0

+                   THEN fuege ypos vor erstem ypos index ein;

+                        LEAVE richtige ypos ist oberhalb;

+              ELIF ya. ypos = aktuelle ypos

+                   THEN neues token bei neuer ypos;

+                        LEAVE richtige ypos ist oberhalb;

+              ELIF ya. ypos < aktuelle ypos

+                   THEN fuege ypos nach ypos index ein;

+                        LEAVE richtige ypos ist oberhalb;

+              FI;

+          PER;

+ 

+      . richtige ypos ist unterhalb :

+          REP ypos index a := ya. naechster ypos index;

+              IF   ypos index a = 0

+                   THEN fuege ypos nach letztem ypos index ein;

+                        LEAVE richtige ypos ist unterhalb;

+              ELIF ya. ypos = aktuelle ypos

+                   THEN neues token bei neuer ypos;

+                        LEAVE richtige ypos ist unterhalb;

+              ELIF ya. ypos > aktuelle ypos 

+                   THEN fuege ypos vor ypos index ein;

+                        LEAVE richtige ypos ist unterhalb;

+              FI;

+          PER;

+ 

+          . fuege ypos vor erstem ypos index ein :

+              ypos  index f INCR 1;

+              yf. vorheriger ypos index   := 0;

+              yf. naechster  ypos index   :=     erster    ypos index a;

+                  erster     ypos index a :=               ypos index f;

+                             ypos index a := yf. naechster ypos index;

+              ya. vorheriger ypos index   :=               ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos nach ypos index ein :

+              ypos  index f INCR 1;

+              yf. vorheriger ypos index   :=               ypos index a;

+              yf. naechster  ypos index   := ya. naechster ypos index;

+              ya. naechster  ypos index   :=               ypos index f;

+                             ypos index a := yf. naechster ypos index;

+              ya. vorheriger ypos index   :=               ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos vor ypos index ein :

+              ypos  index f INCR 1;

+              yf. naechster  ypos index   :=                ypos index a;

+              yf. vorheriger ypos index   := ya. vorheriger ypos index;

+              ya. vorheriger ypos index   :=                ypos index f;

+                             ypos index a := yf. vorheriger ypos index;

+              ya. naechster  ypos index   :=                ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos nach letztem ypos index ein :

+              ypos  index f INCR 1;

+              yf. naechster  ypos index   := 0;

+              yf. vorheriger ypos index   :=     letzter    ypos index a;

+                  letzter    ypos index a :=                ypos index f;

+                             ypos index a := yf. vorheriger ypos index;

+              ya. naechster  ypos index   :=                ypos index f;

+              erstes token bei neuer ypos;

+ 

+END PROC neuer token index;

+ 

+

+PROC erstes token bei neuer ypos :

+     token index f INCR 1;

+                 ypos index a := ypos index f;

+     ya. erster token index   := token index f; 

+     ya. ypos                 := aktuelle ypos;

+END PROC erstes token bei neuer ypos;

+ 

+ 

+PROC neues token bei neuer ypos :

+     token index f INCR 1;

+     ya. ypos                 := aktuelle ypos;

+                  token index := ya. letzter token index;

+     t. naechster token index := token index f;

+END PROC neues token bei neuer ypos;

+ 

+ 

+PROC neues token bei gleicher ypos :

+     tf. naechster token index := token index f + 1;

+     token index f INCR 1;

+END PROC neues token bei gleicher ypos;

+ 

+ 

+PROC letztes token bei gleicher ypos : 

+     tf. naechster token index := 0;

+     ya. letzter   token index := token index f;

+END PROC letztes token bei gleicher ypos;

+ 

+ 

+PROC loesche letztes token :

+ 

+     IF token index f = ya. erster token index 

+        THEN loesche ypos

+        ELSE token index f DECR 1;

+     FI;

+ 

+     . loesche ypos :

+         kette vorgaenger um;

+         kette nachfolger um;

+         bestimme letzten ypos index;

+ 

+         . kette vorgaenger um :

+             ypos index := ya. vorheriger ypos index; 

+             IF ypos index = 0

+                THEN       erster ypos index a := ya. naechster ypos index;

+                ELSE y. naechster ypos index   := ya. naechster ypos index; 

+             FI;

+ 

+         . kette nachfolger um :

+             ypos index := ya. naechster ypos index;

+             IF ypos index = 0

+                THEN       letzter ypos index a := ya. vorheriger ypos index;

+                ELSE y. vorheriger ypos index   := ya. vorheriger ypos index; 

+             FI;

+ 

+         . bestimme letzten ypos index :

+             IF ypos index a = ypos index f THEN ypos index f DECR 1 FI;

+             token index f DECR 1;

+             ypos index a := letzter ypos index a; 

+             WHILE ypos index a <> 0

+                       CAND ya. letzter token index <> token index f

+             REP ypos index a := ya. vorheriger ypos index PER;

+ 

+END PROC loesche letztes token;

+ 

+ 

+PROC blocke token xpos (INT CONST dehnung 1, dehnung 2,

+                                  anzahl dehnungen fuer dehnung 1 ) :

+

+  INT VAR dehnung := 0, anzahl dehnungen := 0;

+  token index := erstes tab token;

+  WHILE token index <= token index f

+  REP erhoehe token xpos bei block token;

+      t. xpos INCR dehnung;

+      token index INCR 1; 

+  PER;

+ 

+  . erhoehe token xpos bei block token :

+      IF t. block token

+         THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1

+                 THEN anzahl dehnungen INCR 1;

+                      dehnung INCR dehnung 1;

+                 ELSE dehnung INCR dehnung 2;

+              FI;

+      FI;

+ 

+END PROC blocke token xpos;

+ 

+ 

+PROC verschiebe token xpos (INT CONST verschiebung) :

+ 

+  token index := erstes tab token;

+  WHILE token index <= token index f

+  REP t. xpos INCR verschiebung;

+      token index INCR 1; 

+  PER;

+ 

+END PROC verschiebe token xpos;

+ 

+ 

+PROC verschiebe token ypos (INT CONST verschiebung) :

+ 

+  ypos index := erster ypos index a;

+  WHILE ypos index <> 0

+  REP y. ypos INCR verschiebung; 

+      ypos index := y. naechster ypos index;

+  PER;

+ 

+END PROC verschiebe token ypos;

+ 

+ 

+PROC sortiere neue token ein :

+ 

+IF analysespeicher ist nicht leer

+   THEN IF druckspeicher ist nicht leer

+           THEN sortiere neue token in sortierte liste ein

+           ELSE sortierte liste ist leer

+        FI;

+FI;

+

+. sortierte liste ist leer :

+    IF erster ypos index a <> 0

+       THEN erster  ypos index d := erster  ypos index a;

+            letzter ypos index d := letzter ypos index a;

+                    ypos index d := letzter ypos index a;

+    FI;

+ 

+. sortiere neue token in sortierte liste ein :

+    gehe zum ersten neuen token;

+    bestimme erste einsortierposition;

+    WHILE es gibt noch neue token

+    REP IF   ypos index d = 0

+             THEN haenge neue token ans ende der sortierten liste 

+        ELIF ya. ypos > yd. ypos

+             THEN naechste ypos der sortierten liste

+        ELIF ya. ypos = yd. ypos

+             THEN neues token auf gleicher ypos

+             ELSE neue token vor ypos

+        FI; 

+    PER;

+ 

+    . gehe zum ersten neuen token :

+        ypos index a := erster ypos index a;

+ 

+    . bestimme erste einsortierposition :

+        WHILE ypos index d <> 0  CAND  ya. ypos < yd. ypos

+          REP ypos index d := yd. vorheriger ypos index PER;

+        IF ypos index d = 0 THEN erste neue token vor listen anfang FI;

+ 

+        . erste neue token vor listen anfang :

+                   ypos index d := erster ypos index d;

+            erster ypos index d := erster ypos index a;

+            REP ypos index a := ya. naechster ypos index;

+                IF   ypos index a = 0

+                     THEN verkette letztes ya mit yd;

+                          LEAVE sortiere neue token in sortierte liste ein

+                ELIF ya. ypos = yd. ypos

+                     THEN verkette ya mit yd;

+                          LEAVE erste neue token vor listen anfang

+                ELIF ya. ypos > yd. ypos

+                     THEN verkette vorheriges ya mit yd;

+                          ypos index d := yd. naechster ypos index;

+                          LEAVE erste neue token vor listen anfang

+                FI;

+            PER;

+ 

+    . es gibt noch neue token :

+        ypos index a <> 0

+ 

+    . haenge neue token ans ende der sortierten liste : 

+                       ypos index d := letzter ypos index d;

+        yd. naechster  ypos index   :=         ypos index a;

+        ya. vorheriger ypos index   :=         ypos index d;

+            letzter    ypos index d := letzter ypos index a;

+                       ypos index d := letzter ypos index a;

+                       ypos index a := 0;

+ 

+    . naechste ypos der sortierten liste :

+        ypos index d := yd. naechster ypos index;

+ 

+    . neues token auf gleicher ypos :

+                      token index   := yd. letzter   token index;

+        t . naechster token index   := ya. erster    token index;

+        yd. letzter   token index   := ya. letzter   token index;

+                      ypos  index a := ya. naechster ypos  index;

+                      ypos  index d := yd. naechster ypos  index;

+        IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI;

+ 

+    . neue token vor ypos :

+        verkette ya mit vorherigem yd;

+        REP ypos index a := ya. naechster ypos index;

+            IF   ypos index a = 0

+                 THEN verkette letztes ya mit yd;

+                      LEAVE sortiere neue token in sortierte liste ein

+            ELIF ya. ypos = yd. ypos

+                 THEN verkette ya mit yd;

+                      LEAVE neue token vor ypos

+            ELIF ya. ypos > yd. ypos 

+                 THEN verkette vorheriges ya mit yd;

+                      ypos index d := yd. naechster ypos index;

+                      LEAVE neue token vor ypos

+            FI;

+        PER;

+

+ 

+. verkette ya mit vorherigem yd :

+                        index   := ypos index d;

+                   ypos index d := yd. vorheriger ypos index; 

+    yd. naechster  ypos index   :=                ypos index a;

+    ya. vorheriger ypos index   :=                ypos index d;

+                   ypos index d := index;

+ 

+. verkette letztes ya mit yd :

+                   ypos index a := letzter ypos index a;

+    yd. vorheriger ypos index   :=         ypos index a;

+    ya. naechster  ypos index   :=         ypos index d;

+                   ypos index a := 0;

+ 

+. verkette vorheriges ya mit yd :

+                        index   := ypos index a;

+                   ypos index a := ya. vorheriger ypos index; 

+    yd. vorheriger ypos index   :=         ypos index a;

+    ya. naechster  ypos index   :=         ypos index d;

+                   ypos index a := index;

+ 

+. verkette ya mit yd :

+    verkette vorheriges ya mit yd;

+    neues token auf gleicher ypos;

+ 

+END PROC sortiere neue token ein;

+ 

+(***************************************************************)

+ 

+PROC drucke tokenspeicher

+             (INT CONST max ypos,

+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+IF druckspeicher ist nicht leer

+   THEN gehe zur ersten ypos; 

+        WHILE yd. ypos <= max ypos 

+        REP drucke token bei ypos;

+            gehe zur naechsten ypos; 

+        PER;

+        loesche gedruckte token;

+FI;

+ 

+. gehe zur ersten ypos :

+    ypos index d := erster ypos index d;

+

+. drucke token bei ypos :

+    IF yd. ypos >= - y start

+       THEN druck durchgang;

+            IF bold      pass THEN fett         durchgang FI;

+            IF underline pass THEN unterstreich durchgang FI;

+    FI;

+ 

+    . bold      pass : bit (pass, bold bit)

+ 

+    . underline pass : bit (pass, underline bit)

+ 

+. gehe zur naechsten ypos : 

+    IF ypos index d = letzter ypos index d

+       THEN loesche druckspeicher;

+            LEAVE drucke tokenspeicher;

+    FI;

+    ypos index d := yd. naechster ypos index;

+ 

+. loesche gedruckte token :

+        erster     ypos index d := ypos index d;

+    yd. vorheriger ypos index   := 0;

+ 

+. 

+  druck durchgang :

+    verschiebung := yd. ypos - d ypos;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    gehe zum ersten token dieser ypos; 

+    REP drucke token UNTIL kein token mehr vorhanden PER;

+    gib cr aus;

+ 

+    . drucke token :

+        IF NOT token passt in zeile THEN berechne token teil FI;

+        font wechsel wenn noetig;

+        x move mit modifikations ueberpruefung; 

+        IF token ist text token

+           THEN gib text token aus

+                  (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+           ELSE gib kommando token aus

+        FI;

+ 

+    . gib kommando token aus :

+        execute (write cmd, d token. text, 1, LENGTH d token. text)

+ 

+        . berechne token teil :

+            INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt);

+            INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; 

+            IF   d token. xpos < - x start

+                   AND d token. xpos + d token. breite > - x start 

+                 THEN berechne token teil von links

+            ELIF d token. xpos < papierbreite

+                   AND d token. xpos + d token. breite > papierbreite

+                 THEN berechne token teil nach rechts

+                 ELSE LEAVE drucke token

+            FI;

+ 

+        . berechne token teil von links :

+            rest          := min (x size, d token. xpos + d token. breite + x start);

+            d token. xpos := - x start;

+            IF rest <= fuenf punkte 

+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);

+                    d token. text   := anzahl punkte * punkt;

+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);

+               ELSE token pos    := LENGTH d token. text + 1;

+                    token breite := fuenf punkte;

+                    berechne token teil breite von hinten;

+                    change (d token. text, 1, token pos - 1, 5 * punkt);

+                    d token. breite := token breite;

+            FI;

+ 

+            . berechne token teil breite von hinten :

+                WHILE naechstes zeichen passt noch davor

+                REP token breite INCR zeichen breite; 

+                    token pos    DECR zeichen laenge;

+                PER;

+ 

+            . naechstes zeichen passt noch davor :

+                IF within kanji (d token. text, token pos - 1) 

+                   THEN zeichen laenge := 2

+                   ELSE zeichen laenge := 1

+                FI;

+                zeichen breite := char pitch (d token. font,

+                    subtext (d token. text, token pos - zeichen laenge, token pos - 1));

+                token breite + zeichen breite < rest

+ 

+        . berechne token teil nach rechts :

+            rest := papier breite - d token. xpos;

+            IF rest <= fuenf punkte 

+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);

+                    d token. text   := anzahl punkte * punkt;

+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);

+               ELSE token pos    := 0;

+                    token breite := fuenf punkte;

+                    berechne token teil breite von vorne;

+                    change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt);

+                    d token. breite := token breite;

+            FI;

+ 

+            . berechne token teil breite von vorne :

+                WHILE naechstes zeichen passt noch dahinter

+                REP token breite INCR zeichen breite; 

+                    token pos    INCR zeichen laenge;

+                PER;

+ 

+            . naechstes zeichen passt noch dahinter :

+                IF is kanji esc (d token. text SUB token pos + 1) 

+                   THEN zeichen laenge := 2

+                   ELSE zeichen laenge := 1

+                FI;

+                zeichen breite := char pitch (d token. font,

+                    subtext (d token. text, token pos + 1, token pos + zeichen laenge));

+                token breite + zeichen breite < rest

+ 

+.

+  fett durchgang :

+    reset bit (pass, bold bit);

+    gehe zum ersten token dieser ypos;

+    REP gib token nochmal aus UNTIL kein token mehr vorhanden PER;

+    schalte modifikationen aus wenn noetig;

+    gib cr aus;

+ 

+    . gib token nochmal aus :

+        INT CONST min verschiebung := bold offset (d token. font); 

+        d token. xpos INCR min verschiebung;

+        IF bit (d token. modifikationen, bold bit) AND

+               token passt in zeile AND token ist text token 

+          THEN verschiebung := d token. xpos - d xpos;

+               font wechsel wenn noetig;

+               schalte italics ein wenn noetig;

+               x move wenn noetig;

+               gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        FI;

+        d token. xpos DECR min verschiebung;

+ 

+        . schalte italics ein wenn noetig :

+            IF bit (d token. modifikationen, italics bit)

+               THEN neue modifikationen := modifikations werte (italics bit + 1);

+                    schalte modifikationen ein wenn noetig;

+               ELSE schalte modifikationen aus wenn noetig;

+            FI;

+ 

+. 

+  unterstreich durchgang :

+    INT VAR l xpos := 0;

+    reset bit (pass, underline bit);

+    schalte modifikationen aus wenn noetig;

+    gehe zum ersten token dieser ypos;

+    REP unterstreiche token UNTIL kein token mehr vorhanden PER;

+    gib cr aus;

+ 

+    . unterstreiche token :

+        IF token muss unterstrichen werden AND

+                token passt in zeile AND token ist text token 

+           THEN font wechsel wenn noetig;

+                berechne x move laenge; 

+                x move wenn noetig;

+                berechne unterstreich laenge;

+                unterstreiche;

+         FI;

+         l xpos := d token. xpos + d token. breite;

+ 

+         . token muss unterstrichen werden :

+             bit (d token. modifikationen, underline bit) OR

+                bit (d token. modifikationen fuer x move, underline bit)

+ 

+         . berechne x move laenge :

+             IF bit (d token. modifikationen fuer x move, underline bit) 

+                THEN verschiebung := l  xpos - d xpos

+                ELSE verschiebung := d token. xpos - d xpos

+             FI;

+

+         . berechne unterstreich laenge :

+             INT VAR unterstreich verschiebung;

+             IF bit (d token. modifikationen, underline bit) 

+                THEN unterstreich verschiebung := d token. xpos + 

+                                                d token. breite - d xpos

+                ELSE unterstreich verschiebung := d token. xpos - d xpos

+             FI;

+ 

+ 

+. gehe zum ersten token dieser ypos :

+    token index := yd. erster token index;

+    d token := t;

+ 

+. kein token mehr vorhanden :

+    token index := d token. naechster token  index;

+    IF token index = 0

+       THEN TRUE

+       ELSE d token := t;

+            FALSE

+    FI

+ 

+. token ist text token :

+    d token. offset index >= text token

+ 

+. token passt in zeile :

+    d token. xpos >= - x start AND

+         d token. xpos + d token. breite <= papier breite 

+ 

+. font wechsel wenn noetig :

+    IF d token. font <>  d font

+       THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+ 

+. schalte modifikationen ein wenn noetig :

+    IF d modifikationen <> neue modifikationen

+       THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+ 

+. schalte modifikationen aus wenn noetig :

+    IF d modifikationen <> 0

+       THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+

+. x move wenn noetig :

+    IF verschiebung <> 0

+       THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; 

+ 

+. gib cr aus :

+    execute (carriage return, "", d xpos, 0);

+    d xpos := 0;

+ 

+. 

+  x move mit modifikations ueberpruefung :

+    verschiebung := d token. xpos - d xpos;

+    IF verschiebung <> 0

+       THEN neue modifikationen := d token. modifikationen fuer x move;

+            schalte modifikationen ein wenn noetig;

+            x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    FI;

+    neue modifikationen := d token. modifikationen;

+    schalte modifikationen ein wenn noetig;

+ 

+. 

+  unterstreiche :

+    IF unterstreich verschiebung > 0

+       THEN disable stop; 

+            d xpos INCR unterstreich verschiebung;

+            execute (draw, "", unterstreich verschiebung, 0);

+            IF is error

+               THEN unterstreiche nach cr;

+            FI;

+            enable stop;

+    FI;

+ 

+    . unterstreiche nach cr :

+        clear error;

+        d xpos DECR unterstreich verschiebung;

+        verschiebung := d xpos;

+        gib cr aus;

+        x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+        d xpos INCR unterstreich verschiebung;

+        execute (draw, "", unterstreich verschiebung, 0);

+        IF is error

+           THEN clear error; 

+                d xpos DECR unterstreich verschiebung;

+                gib cr aus;

+                LEAVE unterstreich durchgang;

+        FI;

+

+END PROC drucke tokenspeicher;

+ 

+PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+    IF verschiebung <> 0

+       THEN disable stop; 

+            d ypos INCR verschiebung;

+            execute (move, "", 0, verschiebung);

+            IF is error

+               THEN clear error;

+                    d ypos DECR verschiebung;

+                    verschiebung := 0;

+            FI;

+            enable stop;

+    FI;

+ 

+END PROC y move;

+ 

+

+PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+    disable stop;

+    d xpos INCR verschiebung; 

+    execute (move, "", verschiebung, 0);

+    IF is error

+       THEN fuehre x move nach cr aus

+    FI;

+ 

+    . fuehre x move nach cr aus :

+        clear error;

+        schalte modifikationen aus wenn noetig;

+        gib cr aus;

+        IF d xpos <> 0

+           THEN execute (move, "", d xpos, 0);

+                IF is error

+                   THEN clear error;

+                        d xpos := 0;

+                FI

+        FI;

+        schalte modifikationen ein wenn noetig;

+ 

+        . gib cr aus :

+            execute (carriage return,  "", d xpos - verschiebung, 0);

+ 

+        . schalte modifikationen aus wenn noetig :

+            neue modifikationen := d modifikationen;

+            IF d modifikationen <> 0

+               THEN schalte modifikationen aus

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+            FI;

+ 

+        . schalte modifikationen ein wenn noetig :

+            IF d modifikationen <> neue modifikationen

+               THEN schalte modifikationen ein

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+            FI;

+ 

+END PROC x move;

+ 

+ 

+PROC schalte modifikationen ein 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     INT VAR index;

+     IF d modifikationen <> 0

+        THEN schalte modifikationen aus

+               (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+     FI;

+     d modifikationen := neue modifikationen;

+     FOR index FROM 1 UPTO anzahl modifikationen

+     REP IF bit (d modifikationen, modifikations bit)

+            THEN modifikation muss eingeschaltet werden

+         FI; 

+     PER;

+ 

+     . modifikations bit : index - 1

+ 

+     . modifikation muss eingeschaltet werden :

+         IF bit (modifikations modus, modifikations bit) 

+            THEN execute (on, "", modifikations werte (index), 0);

+                 IF is error

+                    THEN clear error;

+                         reset bit (modifikations modus, modifikations bit); 

+                         set bit   (pass,                modifikations bit);

+                 FI;

+            ELSE set bit (pass, modifikations bit); 

+         FI;

+ 

+END PROC schalte modifikationen ein;

+ 

+ 

+PROC schalte modifikationen aus 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     INT VAR index;

+     FOR index FROM 1 UPTO anzahl modifikationen

+     REP IF bit (d modifikationen, modifikations bit)

+            THEN modifikation muss ausgeschaltet werden

+         FI; 

+     PER;

+     d modifikationen := 0;

+ 

+     . modifikations bit : index - 1

+ 

+     . modifikation muss ausgeschaltet werden :

+         IF bit (modifikations modus, modifikations bit) 

+            THEN execute (off, "", modifikations werte (index), 0);

+                 IF is error THEN clear error FI;

+         FI;

+ 

+END PROC schalte modifikationen aus;

+ 

+ 

+PROC font wechsel 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     d font := d token. font;

+     get replacements (d font, replacements, replacement tabelle);

+     execute (type, "", d font, 0);

+     IF is error THEN font wechsel nach cr FI;

+     enable stop;

+ 

+     . font wechsel nach cr :

+         clear error;

+         verschiebung := d xpos;

+         gib cr aus;

+         execute (type, "", d font, 0);

+         IF NOT is error

+            THEN schalte modifikationen aus

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                 x move

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+         FI;

+ 

+        . gib cr aus :

+            execute (carriage return,  "", d xpos, 0);

+            d xpos := 0;

+ 

+END PROC font wechsel;

+ 

+ 

+PROC gib text token aus 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+  INT CONST token laenge := LENGTH d token. text;

+  INT VAR token pos := 1, alte token pos, summe := 0;

+  IF token laenge > 0

+     THEN REP alte token pos := token pos;

+              stranalyze (replacement tabelle, summe, 0,

+                          d token. text, token pos, token laenge,

+                          ausgang);

+              IF ausgang = 0 

+                 THEN gib token rest aus;

+                 ELSE gib token teil aus;

+                      gib ersatzdarstellung aus;

+              FI;

+          PER;

+  FI;

+ 

+  . gib token rest aus :

+      IF token laenge >= alte token pos

+         THEN execute (write text, d token. text, alte token pos, token laenge) FI;

+      d xpos INCR d token. breite;

+      LEAVE gib text token aus;

+

+  . gib token teil aus :

+      IF token pos >= alte token pos

+         THEN execute (write text, d token. text, alte token pos, token pos) FI;

+ 

+  . gib ersatzdarstellung aus :

+      IF ausgang = maxint

+         THEN ersatzdarstellung := extended replacement (d token. font,

+                d token. text SUB token pos + 1, d token. text SUB token pos + 2);

+              execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung);

+              tokenpos INCR 3;

+         ELSE IF ausgang < 0

+                 THEN ausgang := ausgang XOR (-32767-1);

+                      token pos INCR 1;

+              FI;

+              execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang));

+              token pos INCR 2;

+      FI;

+ 

+      . ersatzdarstellung : par1

+ 

+END PROC gib text token aus;

+ 

+ 

+PROC schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+

+enable stop;

+gebe restliche token aus;

+seiten ende kommando;

+

+. gebe restliche token aus :

+    IF erster ypos index d <> 0

+       THEN drucke tokenspeicher (maxint,

+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    FI;

+    rest := papier laenge - d ypos;

+

+. seiten ende kommando :

+    seite ist offen := FALSE;

+    a ypos          := top margin;

+    aktuelle spalte := 1;

+    close (page, rest);

+ 

+END PROC schliesse seite ab;

+ 

+ 

+PROC eroeffne seite (INT CONST x wanted, y wanted,

+                     PROC (INT CONST, INT VAR, INT VAR) open ) :

+ 

+IF vor erster seite THEN eroeffne druck FI;

+seiten anfang kommando;

+initialisiere neue seite;

+

+. eroeffne druck :

+    open (document, x size, y size);

+    vor erster seite := FALSE;

+    d font           := -1;

+    d modifikationen := 0;

+

+. seiten anfang kommando :

+    x start := x wanted;

+    y start := y wanted;

+    open (page, x start, y start);

+    gedruckte seiten INCR 1;

+    seite ist offen := TRUE;

+

+. initialisiere neue seite :

+    INT CONST dif left margin := x wanted - x start - left margin + indentation,

+              dif top  margin := y wanted - y start - top  margin; 

+    IF dif left margin <> 0

+       THEN erstes tab token := 1;

+            verschiebe token xpos (dif left margin);

+            a xpos      INCR dif left margin;

+            left margin INCR dif left margin;

+    FI;

+    IF dif top margin <> 0

+       THEN verschiebe token ypos (dif top margin);

+            a ypos      INCR dif top margin;

+            top margin  INCR dif top margin;

+    FI;

+    d xpos := 0;

+    d ypos := 0;

+    IF seitenlaenge <= papierlaenge

+       THEN seitenlaenge := top margin + pagelength; 

+       ELSE seitenlaenge DECR papierlaenge;

+    FI;

+    papierlaenge := y size - y start;

+    papierbreite := x size - x start;

+

+END PROC eroeffne seite;

+ 

+(****************************************************************)

+ 

+PROC elan fuss und kopf (INT CONST fuss oder kopf,

+                PROC (INT CONST, INT CONST) close,

+                PROC (INT CONST, INT VAR, INT VAR) open,

+                PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+IF fuss oder kopf <= 0 THEN elan fuss FI;

+IF fuss oder kopf >= 0 THEN elan kopf FI;

+ 

+.

+  elan fuss :

+    y move zur fusszeile;

+    drucke elan fuss;

+    close page cmd;

+ 

+. y move zur fusszeile :

+    execute (carriage return,  "", d xpos, 0);

+    d xpos := 0;

+    verschiebung := rest auf seite - font hoehe;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. drucke elan fuss :

+    IF bottom label = ""

+       THEN seiten nr := ""

+       ELSE seiten nr := bottom label;

+            seiten nr CAT "/";

+    FI;

+    seiten nr CAT text (gedruckte seiten);

+    elan text := seiten nr;

+    elan text CAT "   ";

+    elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text);

+    elan text CAT dateiname;

+    elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3);

+    elan text CAT "   ";

+    elan text CAT seiten nr;

+    IF LENGTH elan text > max zeichen zeile

+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;

+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+ 

+    . seiten nr : par1

+ 

+. close page cmd :

+    close (page, papierlaenge - d ypos);

+    seite ist offen := FALSE;

+

+.

+  elan kopf :

+    open page cmd ;

+    y move zur kopfzeile;

+    drucke elan kopf;

+

+. open page cmd :

+    x start         := x wanted;

+    y start         := y wanted;

+    open (page, x start, y start);

+    IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI;

+    gedruckte seiten INCR 1;

+    seite ist offen := TRUE;

+    top  margin     := y wanted - y start;

+    left margin     := x wanted - x start;

+    rest auf seite  := pagelength;

+    papierlaenge    := y size - y start;

+    d ypos          := 0; 

+    d xpos          := 0;

+ 

+. y move zur kopf zeile :

+    verschiebung := top margin;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    IF verschiebung = 0 THEN rest auf seite INCR top margin FI;

+ 

+. drucke elan kopf :

+    elan text :=  headline pre;

+    elan text CAT date;

+    elan text CAT headline post;

+    elan text CAT datei name;

+    IF LENGTH elan text > max zeichen zeile

+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;

+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+    cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+ 

+ENDPROC elan fuss und kopf;

+ 

+ 

+PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+linker rand wenn noetig;

+d token. breite := LENGTH elan text * einrueckbreite;

+gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. linker rand wenn noetig :

+    IF left margin > 0

+       THEN disable stop;

+            d xpos := left margin;

+            execute (move, "", left margin, 0);

+            IF is error 

+               THEN clear error;

+                    d xpos := 0;

+            FI;

+            enable stop;

+    FI;

+ 

+END PROC gib elan text aus;

+ 

+ 

+PROC cr plus lf (INT CONST anzahl,

+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : 

+ 

+gib cr aus;

+gib lf aus;

+rest auf seite DECR verschiebung;

+ 

+. gib cr aus :

+    execute (carriage return,  "", d xpos, 0);

+    d xpos := 0;

+ 

+. gib lf aus :

+    verschiebung := anzahl * font hoehe;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+END PROC cr plus lf ; 

+ 

+ 

+END PACKET eumel printer;

diff --git a/system/std.zusatz/1.7.5/src/font convertor 9 b/system/std.zusatz/1.7.5/src/font convertor 9
new file mode 100644
index 0000000..22ce9af
--- /dev/null
+++ b/system/std.zusatz/1.7.5/src/font convertor 9
@@ -0,0 +1,1065 @@
+PACKET font convertor                             (* Autor : Rudolf Ruland *) 

+                                                  (* Stand : 11.07.86      *)

+        DEFINES create font table ,               (* Version 9             *)

+                add fonts,

+                create font file :

+

+ 

+LET t tag                         =  1,

+    t bold                        =  2,

+    t number                      =  3,

+    t text                        =  4,

+    t operator                    =  5,

+    t delimiter                   =  6,

+    t end of file                 =  7,

+ 

+    nil modus                     =  0,

+    font table modus              =  1,

+    font modus                    =  2,

+    extension modus               =  3,

+ 

+    x unit                        =  1,

+    y unit                        =  2,

+    on string                     =  3,

+    off string                    =  4,

+    indentation pitch             =  5,

+    font lead                     =  6,

+    font height                   =  7,

+    font depth                    =  8,

+    larger font                   =  9,

+    smaller font                  = 10,

+    font string                   = 11,

+    y off sets                    = 12,

+    bold off set                  = 13;

+ 

+THESAURUS VAR names, english identification := empty thesaurus,

+                     german  identification := empty thesaurus;

+ 

+insert (english identification, "xunit");

+insert (english identification, "yunit");

+insert (english identification, "onstring");

+insert (english identification, "offstring");

+insert (english identification, "indentationpitch");

+insert (english identification, "fontlead");

+insert (english identification, "fontheight");

+insert (english identification, "fontdepth");

+insert (english identification, "nextlargerfont");

+insert (english identification, "nextsmallerfont");

+insert (english identification, "fontstring");

+insert (english identification, "yoffsets");

+insert (english identification, "boldoffset");

+ 

+insert (german identification, "xeinheit");

+insert (german identification, "yeinheit");

+insert (german identification, "onsequenz");

+insert (german identification, "offsequenz");

+insert (german identification, "einrueckbreite");

+insert (german identification, "durchschuss");

+insert (german identification, "fonthoehe");

+insert (german identification, "fonttiefe");

+insert (german identification, "groessererfont");

+insert (german identification, "kleinererfont");

+insert (german identification, "fontsequenz");

+insert (german identification, "yverschiebungen");

+insert (german identification, "boldverschiebung");

+

+INT VAR modus, last modus, symbol type, int symbol, pitch,

+        identification nr, link nr, extension code 1,

+        char code 1, char code, char pos, vorzeichen,

+        replacements length, index;

+TEXT VAR symbol, font table name, replacement, char, buffer, z;

+BOOL VAR english;

+FILE VAR file, font file;

+ 

+(*****************************************************************) 

+ 

+LET max fonts       = 50,

+    max extensions  = 120, 

+    font table type = 3009,

+ 

+    FONTTABLE = STRUCT (

+ 

+        THESAURUS font names, 

+ 

+        TEXT replacements, font name links,

+             extension chars, extension indexes, 

+

+        ROW 4 TEXT on strings, off strings,

+ 

+        REAL x unit, y unit,

+ 

+        ROW 256 INT replacements table,

+ 

+        INT last font, last extension

+ 

+        ROW max fonts STRUCT (

+            TEXT font string, font name indexes, replacements,

+                 extension chars, extension indexes, y offsets,

+            ROW 256 INT pitch table, replacements table,

+            INT  indentation pitch, font lead, font height, font depth,

+                 next larger font, next smaller font, bold offset ) fonts ,

+ 

+        ROW max extensions STRUCT (

+            TEXT replacements,

+            ROW 256 INT pitch table, replacements table,

+            INT std pitch                                        ) extensions ,

+ 

+                        );

+ 

+BOUND FONTTABLE VAR font table;

+ 

+DATASPACE VAR ds;

+ 

+INT VAR font nr, extension nr;

+ 

+. font      : font table. fonts (font nr)

+. extension : font table. extensions (extension nr)

+. line nr   : line no (file) - 1

+.;

+ 

+(*****************************************************************) 

+ 

+ 

+PROC create font table :

+ 

+     create font table  (last param)

+ 

+END PROC create font table;

+

+ 

+PROC create font table (TEXT CONST font file) :

+ 

+file := sequential file (input, font file);

+disable stop;

+ds    := nilspace;

+modus := nil modus;

+load;

+IF is error THEN error (errormessage) FI;

+forget (ds);

+ 

+END PROC create font table;

+

+

+PROC add fonts (TEXT CONST font tab name, font file) :

+ 

+file := sequential file (input, font file);

+font table name := font tab name;

+change all (font table name, " ", "");

+IF NOT exists (font table name) COR type (old (font table name)) <> font table type

+   THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht")

+FI;

+disable stop;

+ds           := old (font table name);

+fonttable    := ds;

+modus        := font modus;

+font nr      := fonttable. last font;

+extension nr := fonttable. last extension;

+load;

+IF is error THEN error (errormessage) FI;

+forget (ds);

+

+END PROC add fonts;

+

+ 

+PROC load :

+ 

+enable stop;

+initialize loading;

+REP get kennung; 

+    get identification;

+    get char specifications;

+UNTIL eof (file) OR symbol type = t end of file PER;

+font table found;

+ 

+. initialize loading :

+    scan (file);

+    get next symbol;

+ 

+. font table found :

+    IF font nr = 0

+       THEN errorstop ("Fonts zur Fonttabelle """

+                        + font table name + """ fehlen"); 

+       ELSE font table. last font      := font nr; 

+            font table. last extension := extension nr; 

+            forget (font table name, quiet);

+            copy (ds, font table name);

+            type (old (font table name), font table type);

+            forget (ds); ds := nilspace;

+    FI; 

+ 

+. get next symbol :

+    next symbol (file, symbol, symbol type);

+ 

+. get semicolon :

+    get next symbol;

+    IF symbol <> ";" OR symbol type <> t delimiter 

+       THEN errorstop ("';' erwartet") FI;

+ 

+.

+  get kennung :

+    cout (line nr);

+    IF symbol type <> t bold 

+       THEN errorstop ("Kennung erwartet") FI;

+    IF   symbol = "FONTTABLE" OR symbol = "FONTTABELLE" 

+      THEN initialize font table;

+           get font table name;

+    ELIF symbol = "FONT"

+      THEN initialize font;

+           get font names;

+    ELIF symbol = "EXTENSION" OR symbol = "ERWEITERUNG" 

+      THEN get extension char;

+           initialize extension;

+    ELIF modus = nil modus

+      THEN errorstop ("Kennung 'FONTTABLE' oder 'FONTTABELLE' zu Beginn der Datei erwartet") 

+      ELSE errorstop ("unzulaessige Kennung")

+    FI;

+ 

+    . initialize font table :

+        IF modus <> nil modus THEN font table found FI;

+        modus                          := font table modus;

+        font nr                        := 0;

+        extension nr                   := 0;

+        font table                     := ds;

+        font table. font names         := empty thesaurus; 

+        font table. replacements       := "";

+        font table. font name links    := "";

+        font table. extension chars    := "";

+        font table. extension indexes  := ""; 

+        font table. x unit             := 10.0/2.54;

+        font table. y unit             :=  6.0/2.54;

+        font table. replacements table := 0;

+        FOR index FROM 1 UPTO 4

+        REP font table. on  strings (index) := "";

+            font table. off strings (index) := "";

+        PER;

+ 

+    . get font table name :

+        get name list;

+        symbol type := t text;

+        symbol      := name (names, 1);

+        IF exists (symbol)

+           THEN  forget (symbol);

+                 IF exists (symbol)

+                    THEN errorstop ("Fonttabelle existiert schon") FI;

+        FI;

+        font table name := symbol;

+ 

+    . initialize font :

+        IF font nr = max fonts

+           THEN errorstop ("zu viele Fonts") FI;

+        font nr INCR 1;

+        modus                    := font modus;

+        replacements length      := LENGTH font table. replacements; 

+        font. font string        := "";

+        font. font name indexes  := "";

+        font. replacements       := "";

+        font. extension chars    := "";

+        font. extension indexes  := "";

+        font. y offsets          := ""0""0"";

+        font. indentation pitch  := int (font table. x unit * 2.54 / 10.0);

+        font. font lead          := 0;

+        font. font height        := int (font table. y unit * 2.54 / 6.0); 

+        font. font depth         := 0;

+        font. next larger  font  := 0;

+        font. next smaller font  := 0;

+        font. bold offset        := 0;

+        font. pitch table        := font. indentation pitch;

+        font. replacements table := font table. replacements table;

+        FOR index FROM 1 UPTO LENGTH font table. extension chars

+        REP font. replacements table 

+              ( code (font table. extension chars SUB index) + 1 ) := maxint;

+        PER;

+ 

+    . get font names :

+        get name list;

+        index := 0;

+        symbol type := t text;

+        WHILE next font name

+        REP link nr := link (font table. font names, symbol);

+            IF link nr = 0

+               THEN insert (font table. font names, symbol, link nr); 

+                    font table. font name links CAT font nr;

+            ELIF (font table. font name links ISUB link nr) = 0

+               THEN replace (font table. font name links, link nr, font nr);

+               ELSE errorstop ("Font existiert in Fonttabelle """

+                                + font table name + """ schon")

+            FI;

+            font. font name indexes CAT link nr;

+        PER;

+ 

+        . next font name :

+            get (names, symbol, index);

+            symbol <> ""

+ 

+    . get extension char :

+        get name list;

+        symbol type := t text;

+        symbol      := name (names, 1);

+        IF LENGTH symbol <> 1 

+           THEN errorstop ("nur ein Zeichen bei Erweiterung erlaubt") FI;

+        extension code 1 := code (symbol) + 1;

+        IF NOT is kanji esc (symbol) 

+           THEN errorstop ("ESC-Zeichen erwartet") FI;

+ 

+    . initialize extension :

+        IF NOT two bytes

+           THEN errorstop ("Erweiterungen nur im zwei-Byte-Modus erlaubt") FI;

+        IF extension nr = max extensions

+           THEN errorstop ("zu viele Erweiterungen") FI;

+        extension nr INCR 1;

+        IF modus <> extension modus THEN last modus := modus FI;

+        modus      := extension modus;

+        IF last modus = font table modus

+           THEN initalize font table extension

+           ELSE initalize font extension

+        FI;

+ 

+        . initalize font table extension :

+            IF pos (font table. extension chars, symbol) <> 0

+               THEN errorstop ("Erweiterung wurde schon definiert") FI;

+            extension. replacements        := "";

+            extension. std pitch           := 0;

+            extension. pitch table         := 0;

+            extension. replacements table  := 0;

+            font table. extension chars   CAT symbol;

+            font table. extension indexes CAT extension nr;

+            font table. replacements table (extension code 1) := max int;

+            replacements length            := 0;

+ 

+        . initalize font extension :

+            IF pos (font. extension chars, symbol) <> 0

+               THEN errorstop ("Erweiterung wurde schon definiert") FI;

+            extension. replacements   := "";

+            extension. std pitch      := font. pitch table (extension code 1) XOR (-maxint-1);

+            extension. pitch table    := extension. std pitch;

+            font. extension chars    CAT symbol;

+            font. extension indexes  CAT extension nr;

+            char pos := pos (font table. extension chars, symbol);

+            IF char pos <> 0

+               THEN index := font table. extension indexes ISUB char pos;

+                    extension. replacements table := 

+                          font table. extensions (index). replacements table;

+                    replacements length           :=

+                   LENGTH font table. extensions (index). replacements; 

+                    font. replacements table (extension code 1) := max int;

+               ELSE extension. replacements table := 0;

+                    replacements length           := 0;

+            FI;

+ 

+.

+  get identification :

+    WHILE identification found

+    REP cout (line nr);

+        determine identification link nr;

+        select identification;

+    PER;

+ 

+    . identification found :

+        get next symbol; 

+        symbol type = t tag

+ 

+    . determine identification link nr :

+        identification nr := link (english identification, symbol); 

+        english := TRUE;

+        IF identification nr = 0

+           THEN identification nr := link (german identification, symbol); 

+                english := FALSE;

+                IF identification nr = 0

+                   THEN errorstop ("unzulaesige Identifikation") FI;

+        FI;

+ 

+    . select identification :

+        get next symbol;

+        IF symbol <> "=" OR symbol type <> t operator

+           THEN errorstop ("'=' nach Identifikation fehlt") FI;

+        get next symbol; 

+        SELECT identification nr OF

+          CASE x unit            : x unit found

+          CASE y unit            : y unit found

+          CASE on string         : on string found

+          CASE off string        : off string found

+          CASE indentation pitch : indentation pitch found

+          CASE font lead         : font lead found

+          CASE font height       : font height found

+          CASE font depth        : font depth found

+          CASE larger font       : larger font found

+          CASE smaller font      : smaller font found

+          CASE font string       : font string found

+          CASE y offsets         : y offsets found

+          CASE bold offset       : bold offset found

+        END SELECT;

+ 

+    . x unit found :

+        check modus (font table modus);

+        font table. x unit := real (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("REAL-Denoter nach 'x unit' erwartet") 

+                   ELSE errorstop ("REAL-Denoter nach 'x einheit' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . y unit found :

+        check modus (font table modus);

+        font table. y unit := real (symbol); 

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("REAL-Denoter nach 'y unit' erwartet")

+                   ELSE errorstop ("REAL-Denoter nach 'y einheit' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . on string found :

+        check modus (font table modus);

+        FOR index FROM 1 UPTO 4

+        REP IF symbol type <> t text

+               THEN IF english

+                       THEN errorstop ("TEXT-Denoter nach 'on string' erwartet") 

+                       ELSE errorstop ("TEXT-Denoter nach 'on sequenz' erwartet") 

+                    FI;

+            FI;

+            font table. on strings (index) := symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE on string found FI;

+            IF index = 4 THEN errorstop ("';' erwartet") FI;

+            get next symbol;

+        PER;

+ 

+    . off string found :

+        check modus (font table modus);

+        FOR index FROM 1 UPTO 4

+        REP IF symbol type <> t text

+               THEN IF english

+                       THEN errorstop ("TEXT-Denoter nach 'off string' erwartet") 

+                       ELSE errorstop ("TEXT-Denoter nach 'off sequenz' erwartet") 

+                    FI;

+            FI;

+            font table. off strings (index) := symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE off string found FI;

+            IF index = 4 THEN errorstop ("';' erwartet") FI;

+            get next symbol;

+        PER;

+ 

+    . indentation pitch found :

+        check modus (font modus);

+        font. indentation pitch := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'indentation pitch' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'einrueckbreite' erwartet")

+                FI;

+        FI;

+        font. pitch table       := font. indentation pitch;

+        get semicolon;

+ 

+    . font lead found :

+        check modus (font modus);

+        font. font lead := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font lead' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'durchschuss' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . font height found :

+        check modus (font modus);

+        font. font height := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font height' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'fonthoehe' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . font depth found :

+        check modus (font modus);

+        font. font depth := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font depth' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'fonttiefe' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . larger font found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'next larger font' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'groesserer font' erwartet")

+                FI;

+        FI;

+        determine link nr;

+        font. next larger font := link nr;

+        get semicolon;

+ 

+    . smaller font found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'next smaller font' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'kleinerer font' erwartet")

+                FI;

+        FI;

+        determine link nr;

+        font. next smaller font := link nr;

+        get semicolon;

+ 

+        . determine link nr :

+            change all (symbol, " ", "");

+            IF   symbol = ""

+              THEN link nr := 0

+              ELSE link nr := link (font table. font names, symbol);

+                   IF link nr = 0

+                      THEN insert (font table. font names, symbol, link nr);

+                           font table. font name links CAT 0;

+                   FI;

+            FI;

+ 

+    . font string found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'font string' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'fontsequenz' erwartet")

+                FI;

+        FI;

+        font. font string := symbol;

+        get semicolon;

+ 

+    . y offsets found :

+        check modus (font modus);

+        font. y offsets := "";

+        REP IF symbol = "-" AND symbol type = t operator

+               THEN vorzeichen := -1;

+                    get next symbol;

+               ELSE vorzeichen :=  1;

+            FI;

+            int symbol := vorzeichen * int (symbol);

+            IF NOT last conversion ok

+               THEN IF english

+                       THEN errorstop ("INT-Denoter nach 'y offsets' erwartet")

+                       ELSE errorstop ("INT-Denoter nach 'y verschiebungen' erwartet")

+                    FI;

+            FI;

+            font. y offsets CAT int symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE y offsets found FI;

+            get next symbol;

+        PER;

+

+    . bold offset found :

+        check modus (font modus);

+        IF symbol = "-" AND symbol type = t operator

+           THEN vorzeichen := -1;

+                get next symbol;

+           ELSE vorzeichen :=  1;

+        FI;

+        font. bold offset := vorzeichen * int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'bold offset' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'bold verschiebungen' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+.

+  get char specifications :

+    WHILE char found

+    REP cout (line nr); 

+        char specification;

+        get next symbol; 

+    PER;

+

+    . char found :

+        symbol type = t text

+ 

+    . char specification :

+        IF LENGTH symbol <> 1 

+           THEN errorstop ("nur ein Zeichen bei Zeichenangabe erlaubt") FI;

+        char := symbol; 

+        char code 1 := code (char) + 1;

+        look for specification;

+        look for specification;

+        get semicolon;

+ 

+    . look for specification :

+        get next symbol; 

+        IF   symbol = ";" AND symbol type = t delimiter 

+          THEN LEAVE char specification

+        ELIF symbol = "," AND symbol type = t delimiter 

+          THEN get specification

+          ELSE errorstop ("',' oder ';' bei Zeichenspezifikation erwartet")

+        FI;

+ 

+    . get specification :

+        get next symbol;

+        IF   symbol type = t number

+          THEN pitch specification;

+        ELIF symbol type = t text 

+          THEN replacement specification

+          ELSE errorstop ("unzulaessiger Wert bei Zeichenspezifikation")

+        FI;

+ 

+        . pitch specification :

+            int symbol := int (symbol);

+            IF NOT last conversion ok

+               THEN errorstop ("INT-Denoter bei Breitenangabe erwartet") FI;

+            IF   modus = font modus

+               THEN font. pitch table (char code 1) := int symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font. pitch table (char code 1), 15) FI; 

+            ELIF modus = extension modus

+               THEN IF last modus = font modus AND

+                         font. pitch table (extension code 1) <> max int

+                       THEN font. pitch table (extension code 1) := max int FI;

+                    extension. pitch table (char code 1) := int symbol;

+            FI;

+ 

+        . replacement specification : 

+            IF LENGTH symbol > 255

+               THEN errorstop ("Ersatzdarstellungen duerfen nur 255 Zeichen haben") FI;

+            IF   modus = font table modus

+               THEN font table. replacements table (char code 1) := 

+                                       (LENGTH font table. replacements + 1); 

+                    font table. replacements CAT code (LENGTH symbol);

+                    font table. replacements CAT symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font table. replacements table (char code 1), 15) FI; 

+            ELIF modus = font modus

+               THEN font. replacements table (char code 1) :=

+                       (replacements length + LENGTH font. replacements + 1); 

+                    font. replacements CAT code (LENGTH symbol);

+                    font. replacements CAT symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font. replacements table (char code 1), 15) FI; 

+            ELIF modus = extension modus

+               THEN IF last modus = font modus AND

+                         font. replacements table (extension code 1) <> max int

+                       THEN font. replacements table (extension code 1) := max int FI;

+                    extension. replacements table (char code 1) :=

+                      (replacements length + LENGTH extension. replacements + 1); 

+                    extension. replacements CAT code (LENGTH symbol);

+                    extension. replacements CAT symbol;

+            FI;

+ 

+END PROC load;

+ 

+ 

+PROC get name list :

+ 

+   names := empty thesaurus;

+   get next symbol;

+   IF symbol <> ":" OR symbol type <> t delimiter 

+      THEN errorstop ("':' nach Kennung erwartet") FI;

+   REP get next symbol;

+       change all (symbol, " ", "");

+       IF symbol type <> t text

+          THEN errorstop ("TEXT-Denoter in Namesliste erwartet") FI;

+       IF symbol = ""

+          THEN errorstop ("'niltext' als Name nicht erlaubt") FI;

+       insert (names, symbol);

+       get next symbol;

+       IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+          THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+   UNTIL symbol = ";" PER;

+ 

+   . get next symbol :

+       next symbol (file, symbol, symbol type);

+ 

+END PROC get name list;

+ 

+ 

+OP := (ROW 256 INT VAR l, INT CONST r) :

+ 

+INT VAR i;

+IF modus = extension modus OR NOT two bytes

+   THEN FOR i FROM   1 UPTO 256 REP l (i) := r PER; 

+   ELSE FOR i FROM   1 UPTO 129 REP l (i) := r PER;

+        FOR i FROM 130 UPTO 160 REP l (i) := r - maxint - 1 PER;

+        FOR i FROM 161 UPTO 224 REP l (i) := r PER;

+        FOR i FROM 225 UPTO 240 REP l (i) := r - maxint - 1 PER;

+        FOR i FROM 241 UPTO 256 REP l (i) := r PER;

+FI;

+

+END OP :=;

+ 

+ 

+PROC check modus (INT CONST mod) :

+ 

+  IF mod <> modus THEN errorstop ("unzulaessige Identifikation") FI;

+ 

+END PROC check modus;

+ 

+ 

+PROC error (TEXT CONST message) :

+

+(*INT CONST l := error line;*)

+  clear error;

+  errorstop ("Zeile " + text (line nr) + " bei " + letztes symbol +

+             " : " + message (* + errorline if neccessary *) ); 

+ 

+  . letztes symbol :

+      IF symbol type <> t text

+         THEN symbol

+         ELSE decode (symbol);

+              """" + symbol + """"

+      FI

+(*

+  . errorline if neccessary :

+      IF l = 0 

+         THEN ""

+         ELSE " -> " + text (l) 

+      FI

+*)

+END PROC error;

+ 

+ 

+(*******************************************************************)

+ 

+ 

+PROC create font file (TEXT CONST font table name, font file name) :

+

+enable stop;

+connect font table;

+put font table in font file;

+ 

+.

+  connect font table :

+    buffer := font table name;

+    change all (buffer, " ", "");

+    IF NOT exists (buffer) COR type (old (buffer)) <> font table type

+       THEN errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")

+    FI;

+   font table := old (buffer);

+

+.

+  put font table in font file :

+    enable stop;

+    font file := sequential file (output, font file name);

+    z         := " ";

+    max line length (font file, 1000);

+    put font table;

+    FOR font nr FROM 1 UPTO font table. last font REP put font PER;

+ 

+. put font table :

+    z CAT "FONTTABLE  :  """; z CAT buffer;                  z CAT """;"; put z; 

+    z CAT "  x unit      =  ";   z CAT text (font table. x unit); z CAT ";"; put z; 

+    z CAT "  y unit      =  ";   z CAT text (font table. y unit); z CAT ";"; put z; 

+    z CAT "  on string   =  """; z cat on strings;              z CAT """;"; put z; 

+    z CAT "  off string  =  """; z cat off strings;             z CAT """;"; put z; 

+    put font table replacements;

+    put font table extensions;

+    put z;

+ 

+    . z cat on strings :

+        FOR index FROM 1 UPTO 4

+        REP buffer := font table. on strings (index);

+            decode (buffer); 

+            z CAT buffer;

+            IF index <> 4 THEN z CAT """,  """ FI;

+        PER;

+ 

+    . z cat off strings :

+        FOR index FROM 1 UPTO 4

+        REP buffer := font table. off strings (index);

+            decode (buffer); 

+            z CAT buffer;

+            IF index <> 4 THEN z CAT """,  """ FI;

+        PER;

+ 

+    . put font table replacements : 

+        put z;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            link nr     := font table. replacements table (char code 1);

+            reset bit (link nr, 15);

+            IF link nr > 0 AND link nr <> maxint

+               THEN z CAT "  ";

+                    put char code;

+                    put font table replacement;

+                    put z;

+            FI;

+        PER;

+ 

+        . put font table replacement :

+            replacement := subtext (font table.  replacements, link nr + 1,

+                     link nr + code (font table. replacements SUB link nr) );

+            put replacement;

+

+    . put font table extensions :

+        IF font table. extension chars <> ""

+           THEN FOR index FROM 1 UPTO LENGTH font table. extension chars 

+                REP put font table extension PER;

+        FI;

+ 

+    . put font table extension :

+        put z;

+        z CAT "  EXTENSION  :  """"";

+        z CAT text 3 (code (font table. extension chars SUB index));

+        z CAT """"";";

+        put z; put z; 

+        replacements length := 0;

+        extension nr        := font table. extension indexes ISUB index;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            link nr     := extension. replacements table (char code 1);

+            IF link nr > 0

+               THEN z CAT "  ";

+                    put char code;

+                    put extension replacement;

+                    put z;

+            FI;

+        PER;

+ 

+. put font :

+    put z;

+            z CAT "  FONT  :  "; z cat font names; z CAT ";"; put z; 

+            z CAT "    indentation pitch  =  ";

+            z CAT text(font. indentation pitch);

+            z CAT ";"; put z; 

+    IF font. font lead <> 0 

+       THEN z CAT "    font lead          =  ";

+            z CAT text(font. font lead);

+            z CAT ";"; put z;

+    FI;

+            z CAT "    font height        =  ";

+            z CAT text(font. font height);

+            z CAT ";"; put z; 

+    IF font. font depth <> 0

+       THEN z CAT "    font depth         =  ";

+            z CAT text(font. font depth);

+            z CAT ";"; put z;

+    FI;

+    IF next larger <> ""

+       THEN z CAT "    next larger font   =  """;

+            z CAT next larger;

+            z CAT """;"; put z;

+    FI;

+    IF next smaller <> ""

+       THEN z CAT "    next smaller font  =  """;

+            z CAT next smaller;

+            z CAT """;"; put z;

+    FI;

+    IF font. font string <> ""

+       THEN z CAT "    font string        =  """;

+            z CAT font string;

+            z CAT """;"; put z;

+    FI;

+    IF (font. y offsets ISUB 1) <> 0 OR LENGTH font. y offsets > 2

+       THEN z CAT "    y offsets          =  ";

+            z cat y offsets;

+            z CAT ";"; put z; 

+    FI;

+    IF font. bold offset <> 0

+       THEN z CAT "    bold offset        =  ";

+            z CAT text(font. bold offset);

+            z CAT ";"; put z;

+    FI;

+    put font pitches and replacements;

+    put font extensions;

+ 

+    . next larger  : name (font table. font names, font. next larger font)

+    . next smaller : name (font table. font names, font. next smaller font)

+    . font string  : buffer := font. font string; decode (buffer); buffer

+ 

+    . z cat font names :

+        z CAT """";

+        z CAT name (font table. font names, font. font name indexes ISUB 1);

+        z CAT """";

+        FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2

+        REP z CAT ",  """;

+            z CAT name (font table. font names, font. font name indexes ISUB index);

+            z CAT """";

+        PER;

+ 

+    . z cat y offsets :

+        z CAT text (font. y offsets ISUB 1);

+        FOR index FROM 2 UPTO LENGTH font. y offsets DIV 2

+        REP z CAT ",  ";

+            z CAT text (font. y offsets ISUB index);

+        PER;

+ 

+    . put font pitches and replacements :

+        BOOL VAR ausgabe := FALSE; 

+        replacements length := LENGTH font table. replacements;

+        put z;

+        z CAT "  "; 

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            pitch       := font. pitch table (char code 1); 

+            reset bit (pitch, 15); 

+            link nr     := font. replacements table (char code 1);

+            reset bit (link nr, 15);

+            IF (pitch <> font. indentation pitch) OR

+               (link nr > replacements length AND link nr <> maxint)

+               THEN put font char pitch and replacement;

+                    IF ausgabe 

+                       THEN put z;

+                            ausgabe := FALSE;

+                       ELSE ausgabe := TRUE;

+                    FI;

+                    z CAT "  "; 

+            FI;

+        PER;

+        IF ausgabe THEN put z ELSE z := " " FI;

+

+        . put font char pitch and replacement :

+            put char code;

+            put font char pitch; 

+            IF   link nr > replacements length AND link nr <> maxint

+                 THEN put font replacement;

+                      IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI;

+            ELIF ausgabe

+                 THEN z CAT ";"

+                 ELSE z CAT ";            ";

+            FI;

+ 

+        . put font char pitch :

+            IF pitch = max int 

+               THEN char pos := pos (font. extension chars, code (char code));

+                    IF char pos <> 0

+                       THEN pitch := font table. extensions

+                              (font. extension indexes ISUB char pos). std pitch 

+                    FI;

+            FI;

+            put char pitch; 

+ 

+        . put font replacement :

+            link nr DECR replacements length;

+            replacement := subtext (font.  replacements, link nr + 1,

+                           link nr + code (font. replacements SUB link nr) );

+            put replacement;

+ 

+    . put font extensions :

+        IF font. extension chars <> ""

+           THEN FOR index FROM 1 UPTO LENGTH font. extension chars 

+                REP put font extension PER;

+        FI;

+ 

+    . put font extension :

+        put z;

+        z CAT "  ERWEITERUNG  :  """"";

+        z CAT text 3 (code (font. extension chars SUB index));

+        z CAT """"";";

+        put z; put z; z CAT "  "; 

+        detemine replacements length;

+        extension nr := font. extension indexes ISUB index;

+        ausgabe      := FALSE;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            pitch       := extension. pitch table (char code 1);

+            link nr     := extension. replacements table (char code 1);

+            IF pitch <> extension. std pitch OR link nr > replacements length

+               THEN put extension char pitch and replacement; 

+                    IF ausgabe 

+                       THEN put z;

+                            ausgabe := FALSE;

+                       ELSE ausgabe := TRUE;

+                    FI;

+                    z CAT "  "; 

+            FI;

+        PER;

+        IF ausgabe THEN put z ELSE z := " " FI;

+ 

+        . detemine replacements length :

+            char pos := pos (font table. extension chars,

+                                         font. extension chars SUB index); 

+            IF char pos <> 0

+               THEN replacements length := LENGTH font table. extensions

+                  (font table. extension indexes ISUB char pos). replacements; 

+               ELSE replacements length := 0;

+            FI;

+ 

+        . put extension char pitch and replacement :

+            put char code;

+            put char pitch;

+            IF   link nr > replacements length

+                 THEN put extension replacement;

+                      IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI;

+            ELIF ausgabe

+                 THEN z CAT ";"

+                 ELSE z CAT ";            ";

+            FI;

+ 

+. put extension replacement :

+    link nr DECR replacements length;

+    replacement := subtext (extension. replacements, link nr + 1,

+                     link nr + code (extension. replacements SUB link nr) );

+    put replacement;

+ 

+. put char code :

+    IF (char code >= 32  AND char code <= 122) OR

+       (char code >= 214 AND char code <= 223) OR

+        char code  = 124  OR char code  = 126  OR char code  = 251

+       THEN z CAT "(* ";

+            z CAT code (char code);

+            z CAT " *) """"";

+       ELSE z CAT "        """"";

+    FI;

+    z CAT text 3 (char code);

+    z CAT """""";

+ 

+. put char pitch : 

+    z CAT ",";

+    z CAT text (pitch, 5);

+ 

+. put replacement :

+    decode (replacement);

+    z CAT ",   """;

+    z CAT replacement;

+    z CAT """;"

+ 

+END PROC create font file;

+ 

+ 

+PROC put z :

+ 

+  putline (font file, z);

+  cout (lines (font file));

+  z := " ";

+ 

+END PROC put z;

+ 

+ 

+PROC decode (TEXT VAR string) :

+ 

+  INT VAR p;

+  change all (string, """", """""");

+  p := pos (string, ""0"", ""31"", 1);

+  WHILE p <> 0

+  REP change (string, p, p, """" + text (code(string SUB p)) + """");

+      p := pos (string, ""0"", ""31"", p);

+  PER;

+  p := pos (string, ""127"", ""255"", 1);

+  WHILE p <> 0

+  REP change (string, p, p, """" + text (code(string SUB p)) + """");

+      p := pos (string, ""127"", ""255"", p);

+  PER;

+ 

+END PROC decode;

+ 

+ 

+TEXT PROC text 3 (INT CONST value) :

+ 

+  buffer := text (value, 3);

+  change all (buffer, " ", "0");

+  buffer

+ 

+END PROC text 3;

+ 

+END PACKET font convertor;

diff --git a/system/std.zusatz/1.8.7/source-disk b/system/std.zusatz/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/std.zusatz/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/datatype/complex b/system/std.zusatz/1.8.7/src/complex
index e2139d0..e2139d0 100644
--- a/datatype/complex
+++ b/system/std.zusatz/1.8.7/src/complex
diff --git a/system/crypt b/system/std.zusatz/1.8.7/src/crypt
index b04728a..b04728a 100644
--- a/system/crypt
+++ b/system/std.zusatz/1.8.7/src/crypt
diff --git a/system/eumel printer.5 b/system/std.zusatz/1.8.7/src/eumel printer.5
index e61a073..e61a073 100644
--- a/system/eumel printer.5
+++ b/system/std.zusatz/1.8.7/src/eumel printer.5
diff --git a/system/eumelmeter b/system/std.zusatz/1.8.7/src/eumelmeter
index ba92476..ba92476 100644
--- a/system/eumelmeter
+++ b/system/std.zusatz/1.8.7/src/eumelmeter
diff --git a/system/font convertor 9 b/system/std.zusatz/1.8.7/src/font convertor 9
index a5d0ea7..a5d0ea7 100644
--- a/system/font convertor 9
+++ b/system/std.zusatz/1.8.7/src/font convertor 9
diff --git a/system/free channel b/system/std.zusatz/1.8.7/src/free channel
index 3814f9d..3814f9d 100644
--- a/system/free channel
+++ b/system/std.zusatz/1.8.7/src/free channel
diff --git a/datatype/longint b/system/std.zusatz/1.8.7/src/longint
index e78bb52..e78bb52 100644
--- a/datatype/longint
+++ b/system/std.zusatz/1.8.7/src/longint
diff --git a/datatype/matrix b/system/std.zusatz/1.8.7/src/matrix
index d9de9fb..d9de9fb 100644
--- a/datatype/matrix
+++ b/system/std.zusatz/1.8.7/src/matrix
diff --git a/system/purge b/system/std.zusatz/1.8.7/src/purge
index 55230ff..55230ff 100644
--- a/system/purge
+++ b/system/std.zusatz/1.8.7/src/purge
diff --git a/system/referencer b/system/std.zusatz/1.8.7/src/referencer
index 2ee65e4..2ee65e4 100644
--- a/system/referencer
+++ b/system/std.zusatz/1.8.7/src/referencer
diff --git a/system/reporter b/system/std.zusatz/1.8.7/src/reporter
index 4febc32..4febc32 100644
--- a/system/reporter
+++ b/system/std.zusatz/1.8.7/src/reporter
diff --git a/system/scheduler b/system/std.zusatz/1.8.7/src/scheduler
index cba48e0..cba48e0 100644
--- a/system/scheduler
+++ b/system/std.zusatz/1.8.7/src/scheduler
diff --git a/system/std analysator b/system/std.zusatz/1.8.7/src/std analysator
index 7e14722..7e14722 100644
--- a/system/std analysator
+++ b/system/std.zusatz/1.8.7/src/std analysator
diff --git a/datatype/vector b/system/std.zusatz/1.8.7/src/vector
index 5c9e896..5c9e896 100644
--- a/datatype/vector
+++ b/system/std.zusatz/1.8.7/src/vector
diff --git a/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5)
new file mode 100644
index 0000000..1a3c167
--- /dev/null
+++ b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5)
@@ -0,0 +1,74 @@
+(*************************************************)

+(* Typtabelle   : AT.ascii(SHard>=4.5)           *)

+(* Generiert am : 26.07.88                       *)

+(* Version/Typ  : 1.8.2/32001                    *)

+(*************************************************)

+ 

+forget ("AT.ascii(SHard>=4.5)", quiet) ;

+new type ("AT.ascii(SHard>=4.5)") ;

+

+enter xsize (80) ;

+enter ysize (24) ;

+cursor logic (0, ""6"", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  0, 0, "") ;   

+enter outcode (  1,   1) ; (* Cursor Home : <CTRL-A> *) 

+enter outcode (  2,   2) ; (* Cursor right: <CTRL-B> *) 

+enter outcode (  3,   3) ; (* Cursor up   : <CTRL-C> *) 

+enter outcode (  4,   4) ; (* CLEOP       : <CTRL-D> *) 

+enter outcode (  5,   5) ; (* CLEOL       : <CTRL-E> *) 

+enter outcode (  8,   8) ; (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ; (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ; (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""14" ") ; (* END MARK    : <CTRL-N> <SPACE> *) 

+enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK  : <CTRL-O> <SPACE> *) 

+enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k     : <CTRL-O> k <CTRL-N> 

+*) 

+enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich : <CTRL-O> - <CTRL-N> 

+*) 

+enter outcode (222, 0, ""15"#"14"") ; (* Fest-#      : <CTRL-O> # <CTRL-N> 

+*) 

+enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank  : <CTRL-O> <SPACE> 

+<CTRL-N> *) 

+enter outcode (251, 0, ""225"") ; (* sz          : <225> *) 

+enter outcode (252,  21) ; (* <CTRL-U> *) 

+

+

+(* Eingabe Codes : *)

+enter incode (  7, ""7"") ; (* SV - Call   : <CTRL-G> *)

+enter incode (  4, ""4"") ; (* Info        : <CTRL-D> *)

+enter incode (  1, ""1"") ; (* HOP         : <CTRL-A> *)

+enter incode ( 18, ""18"") ; (* Insert line : <CTRL-R> *)

+enter incode ( 96, "<") ; (* < *)

+enter incode (126, ">") ; (* > *)

+enter incode ( 64, """") ; (* " *)

+enter incode ( 35, ""252"") ; (* <252> *)

+enter incode ( 94, "&") ; (* & *)

+enter incode ( 38, "/") ; (* / *)

+enter incode ( 42, "(") ; (* ( *)

+enter incode ( 40, ")") ; (* ) *)

+enter incode ( 41, "=") ; (* = *)

+enter incode ( 45, "ß") ; (* <251> *)

+enter incode ( 95, "?") ; (* ? *)

+enter incode ( 61, "'") ; (* ' *)

+enter incode ( 43, "`") ; (* ` *)

+enter incode (121, "z") ; (* z *)

+enter incode ( 89, "Z") ; (* Z *)

+enter incode (122, "y") ; (* y *)

+enter incode ( 90, "Y") ; (* Y *)

+enter incode ( 60, ";") ; (* ; *)

+enter incode ( 62, ":") ; (* : *)

+enter incode ( 47, "-") ; (* - *)

+enter incode ( 63, "_") ; (* _ *)

+enter incode ( 59, "ö") ; (* <218> *)

+enter incode ( 58, ""215"") ; (* <215> *)

+enter incode ( 39, "ä") ; (* <217> *)

+enter incode ( 34, ""214"") ; (* <214> *)

+enter incode ( 91, "ü") ; (* <219> *)

+enter incode ( 93, "+") ; (* + *)

+enter incode (123, ""216"") ; (* <216> *)

+enter incode (125, "*") ; (* * *)

+enter incode ( 92, "#") ; (* # *)

+enter incode (124, "^") ; (* ^ *)

+

diff --git a/system/terminal-codes/1.8.2/src/GEN182.ELA b/system/terminal-codes/1.8.2/src/GEN182.ELA
new file mode 100644
index 0000000..be9c208
--- /dev/null
+++ b/system/terminal-codes/1.8.2/src/GEN182.ELA
@@ -0,0 +1,245 @@
+(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) 

+ 

+page ; 

+putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; 

+line ; 

+BOUND STRUCT (INT maxx, maxy, 

+              ROW 248 INT align,

+              ROW 128 INT outcodes, 

+              ROW 128 INT instrings,

+              ROW 128 INT outstrings) VAR x ; 

+ 

+TEXT VAR t , filename ; 

+INT VAR i , laenge , position , eumel code ;

+FILE VAR f ; 

+put ("Name der Tabelle:") ; 

+getline (t) ; 

+IF exists (t+".gen") THEN forget (t+".gen") FI ; 

+IF exists (t+".gen") 

+THEN filename := t + ".new.gen" 

+ELSE filename := t + ".gen"

+FI ; 

+f := sequentialfile (output, filename) ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+putline (f, "(* Typtabelle   : " + text (t, 30) + " *)") ; 

+putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; 

+putline (f, "(* Version/Typ  : " + text ("1.8.2/32001", 30) + " *)") ;

+putline (f, "(" + 49 * "*" + ")") ; 

+line (f) ; 

+putline (f, "forget (""" + t + """, quiet) ;") ; 

+putline (f, "new type (""" + t + """) ;") ; 

+line (f) ; 

+x := old (t, 32001) ; 

+putline (f, "enter xsize ("+text (x.maxx)+") ;") ; 

+putline (f, "enter ysize ("+text (x.maxy)+") ;") ;

+t := "  " ; 

+IF (x.outstrings (1) AND 255) = 2 

+   THEN putline (f, "elbit cursor ;") ; 

+        line (f) ; 

+   ELSE write (f, "cursor logic (") ; 

+        position := x.outstrings(2) ;

+        put (f, text (position AND 255) + ",") ; 

+        position := (x.outcodes (4) AND 127) * 8+1 ;

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        putline (f, denoter (x.outstrings, position, 0) + ") ;") ; 

+        line (f)

+FI ; 

+putline (f, "(* Ausgabe Codes : *)") ; 

+FOR i FROM 1 UPTO 128 REP 

+ cout (lineno (f)) ;

+ replace (t, 1, x.outcodes (i)) ; 

+ IF i <> 4 

+ THEN IF code (t SUB 1) <> 255 

+      THEN eumel code := (i-1) * 2 ; 

+           put (f, "enter outcode (" + text (eumel code, 3) + ",") ; 

+           IF code (t SUB 1) > 127 

+           THEN outstring ((code (t SUB 1)-128)*8) 

+           ELSE numberput (code (t SUB 1)) 

+           FI ; 

+           line (f) 

+      FI 

+ FI ; 

+ IF code (t SUB 2) <> 255 

+ THEN eumel code := (i-1) * 2 + 1 ; 

+      put (f, "enter outcode (" + text (eumel code, 3) + ",") ;

+      IF code (t SUB 2) > 127 

+      THEN outstring ((code (t SUB 2)-128)*8)

+      ELSE numberput (code (t SUB 2)) 

+      FI ; 

+      line (f) 

+ FI ; 

+PER ; 

+line (f) ; 

+line (f) ; 

+ 

+putline (f, "(* Eingabe Codes : *)") ; 

+i := 0 ; 

+WHILE i < 256 CAND incode (i) <> 255 REP

+ cout (lineno (f)) ; 

+ eumel code := incode (i) ; 

+ put (f, "enter incode (" + text (eumel code,3) + ",") ; 

+ write (f, denoter (x.instrings, i + 1, 255)) ; 

+ put (f, ") ; (*") ; 

+ i INCR 1 ; 

+ IF in bezeichnung (eumel code) <> "" 

+ THEN put (f, in bezeichnung (eumel code) + ":") 

+ FI ; 

+ WHILE i < 256 CAND incode (i) <> 255 REP 

+  charput (incode (i)) ; 

+  i INCR 1 

+ PER ; 

+ i INCR 1 ; 

+ putline (f, "*)") 

+PER ; 

+ 

+edit (filename) ; 

+ 

+INT PROC incode (INT CONST element) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.instrings (element DIV 2 + 1)); 

+ IF (element MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC incode ; 

+ 

+ 

+TEXT PROC in bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "HOP         " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "Info        "

+  CASE 7 : "SV - Call   " 

+  CASE 8 : "Cursor left " 

+  CASE 9 : "TAB         " 

+  CASE 10: "Cursor down " 

+  CASE 11: "RUBIN       " 

+  CASE 12: "RUBOUT      "

+  CASE 13: "CR          " 

+  CASE 16: "MARK        " 

+  CASE 17: "Stop        " 

+  CASE 18: "Insert line "

+  CASE 23: "Weiter      " 

+  CASE 27: "Escape      "

+  CASE 214:"ae-Taste    " 

+  CASE 215:"oe-Taste    " 

+  CASE 216:"ue-Taste    "

+  CASE 217:"Ae-Taste    " 

+  CASE 218:"Oe-Taste    " 

+  CASE 219:"Ue-Taste    " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz-Taste    " 

+  OTHERWISE IF code < 32 THEN "Funct.-Taste" 

+                         ELSE "" 

+            FI 

+ ENDSELECT 

+ENDPROC in bezeichnung ; 

+ 

+TEXT PROC out bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "Cursor Home " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "CLEOP       " 

+  CASE 5 : "CLEOL       " 

+  CASE 6 : "Cursor (YX) " 

+  CASE 7 : "Beep        " 

+  CASE 8 : "Cursor left " 

+  CASE 10: "Cursor down " 

+  CASE 13: "CR          " 

+  CASE 14: "END MARK    " 

+  CASE 15: "BEGIN MARK  " 

+  CASE 214:"ae          " 

+  CASE 215:"oe          " 

+  CASE 216:"ue          "

+  CASE 217:"Ae          " 

+  CASE 218:"Oe          " 

+  CASE 219:"Ue          " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz          " 

+  OTHERWISE ""

+ ENDSELECT 

+ENDPROC out bezeichnung ; 

+ 

+PROC charput (INT CONST nr) : 

+ IF   nr =  27 THEN put (f, "<ESC>") 

+ ELIF nr =  10 THEN put (f, "<LF>") 

+ ELIF nr =  13 THEN put (f, "<CR>") 

+ ELIF nr =  32 THEN put (f, "<SPACE>") 

+ ELIF nr = 127 THEN put (f, "<DEL>") 

+ ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") 

+ ELIF nr >  32 THEN put (f, code (nr))

+ ELSE put (f, "<CTRL-" + code (nr+64) + ">") 

+ FI 

+ENDPROC charput ; 

+ 

+PROC numberput (INT CONST nr) : 

+ put (f, text (nr,3 ) + ") ; (*") ;

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ; 

+ charput (nr) ; 

+ put (f, "*)") ; 

+ENDPROC numberput ; 

+ 

+TEXT PROC denoter (ROW 128 INT VAR y, INT CONST pos, ende) : 

+ INT VAR i := pos ; 

+ TEXT VAR t := "  " , zeile := """" ; 

+ laenge := 0 ; 

+ WHILE i < 256 AND zugriff <> ende REP 

+  IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) 

+  ELIF zugriff = 34 THEN zeile CAT """"""

+  ELIF zugriff = 251 THEN zeile CAT "ß" 

+  ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) 

+  ELSE zeile CAT """" ; 

+       zeile CAT text (zugriff) ; 

+       zeile CAT """" 

+  FI ; 

+  i INCR 1 ; 

+  laenge INCR 1 

+ PER ; 

+ zeile CAT """" ; 

+ zeile. 

+ 

+ 

+zugriff : 

+ replace (t, 1, y (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC denoter ; 

+ 

+ 

+PROC outstring (INT CONST element) : 

+ INT VAR i := element ; 

+ put (f, text (zugriff) + ",") ; 

+ put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; 

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ;

+ i INCR 1 ; 

+ WHILE zugriff <> 0 REP 

+  charput (zugriff) ; 

+  i INCR 1 

+ PER ; 

+ put (f, "*)") . 

+ 

+ 

+zugriff : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.outstrings (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC outstring 

+

+

diff --git a/system/terminal-codes/unknown/src/A210 b/system/terminal-codes/unknown/src/A210
new file mode 100644
index 0000000..4b63b40
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A210
@@ -0,0 +1,78 @@
+(*************************************************)

+(* Typtabelle   : A210                           *)

+(* Zeichensatz  : ASCII                          *) 

+(* Keyboard     : ASCII                          *) 

+(* Erstellt am  : 07.12.85                       *)

+(*************************************************)

+

+forget ("A210", quiet) ;

+new type ("A210") ;

+

+enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) 

+INT VAR i ; 

+FOR i FROM 128 UPTO 254 REP 

+ link outcode (i, 4) (* first outstring *)

+PER ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""27"G0") ;(* END MARK    : <ESC> G 0 *) 

+enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK  : <ESC> G 4 *) 

+enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE   : <ESC> G 8 *) 

+enter outcode ( 17, 0, ""27"G2") ;(* FLASH       : <ESC> G 2 *) 

+ 

+(* Low Video on = <ESC> ) , High Video on = <ESC> ( *) 

+enter outcode (214, 0, ""27")A"27"(") ; (* ae     : <ESC> ) A <ESC> ( *) 

+enter outcode (215, 0, ""27")O"27"(") ; (* oe     : <ESC> ) O <ESC> ( *) 

+enter outcode (216, 0, ""27")U"27"(") ; (* ue     : <ESC> ) U <ESC> ( *) 

+enter outcode (217, 0, ""27")a"27"(") ; (* Ae     : <ESC> ) a <ESC> ( *) 

+enter outcode (218, 0, ""27")o"27"(") ; (* Oe     : <ESC> ) o <ESC> ( *) 

+enter outcode (219, 0, ""27")u"27"(") ; (* Ue     : <ESC> ) u <ESC> ( *)

+enter outcode (220, 0, ""27")k"27"(") ; (* Trenn-k     : k *) 

+enter outcode (221, 0, ""27")-"27"(") ; (* Trennstrich : - *) 

+enter outcode (222, 0, ""27")#"27"(") ; (* Fest-#      : # *) 

+enter outcode (223, 0, ""27")_"27"(") ; (* Fest-Blank  : <SPACE> *) 

+enter outcode (251, 0, ""27")B"27"(") ; (* sz     : <ESC> ) B <ESC> ( *) 

+

+(* Eingabecodes : *)

+enter incode (  0, ""0"")  ;  (* Wird beim Einschalten dreimal gesendet *)

+enter incode (  1, ""30"") ;  (* HOP         : <CTRL-^> *)

+enter incode (  2, ""12"") ;  (* Cursor right: <CTRL-L> *)

+enter incode (  3, ""11"") ;  (* Cursor up   : <CTRL-K> *)

+enter incode (  7, ""1"A"13"") ; (* SV - Call   : <CTRL-A> A <CR> *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  8, ""8"") ; 

+enter incode (  9, ""9"") ;   (* TAB         : <CTRL-I> *)

+enter incode ( 10, ""22"") ;  (* Cursor down : <CTRL-Y> *)

+enter incode ( 11, ""27"Q") ; (* RUBIN       : <ESC> Q *)

+enter incode ( 12, ""127"") ; (* RUBOUT      : <DEL> *)

+enter incode ( 12, ""27"W") ; (* RUBOUT      : <ESC> W *)

+enter incode ( 16, ""27"E") ; (* MARK        : <ESC> E *)

+enter incode ( 17, ""19"") ;  (* Stop        : <CTRL-S> *)

+enter incode ( 17, ""1"@"13"") ; (* Stop        : <CTRL-A> @ <CR> *)

+enter incode ( 23, ""17"") ;     (* Weiter      : <CTRL-Q> *)

+enter incode ( 23, ""1"B"13"") ; (* Weiter      : <CTRL-A> B <CR> *)

+enter incode (  4, ""1"C"13"") ; (* Funct.-Taste: <CTRL-A> C <CR> *)

+enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste: <CTRL-A> D <CR> *)

+enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste: <CTRL-A> E <CR> *)

+enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste: <CTRL-A> F <CR> *)

+enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste: <CTRL-A> G <CR> *)

+enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste: <CTRL-A> H <CR> *)

+enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste: <CTRL-A> I <CR> *)

+enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste: <CTRL-A> J <CR> *)

+enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste: <CTRL-A> ` <CR> *)

+enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste: <CTRL-A> a <CR> *)

+enter incode ( 31, ""1"b"13"") ; (* Weiter      : <CTRL-A> b <CR> *)

+ 

+PROC link outcode (INT CONST eumelcode, begin of string) : 

+ enter outcode (eumelcode, begin of string -128) 

+ENDPROC link outcode ;

diff --git a/system/terminal-codes/unknown/src/A210.german b/system/terminal-codes/unknown/src/A210.german
new file mode 100644
index 0000000..656ad31
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A210.german
@@ -0,0 +1,87 @@
+(*************************************************)

+(* Typtabelle   : A210 - Emulation QT102!        *)

+(* Zeichensatz  : German                         *) 

+(* Keyboard     : German                         *) 

+(* Erstellt am  : 04.02.87                       *)

+(*************************************************)

+

+forget ("A210.german", quiet) ;

+new type ("A210.german") ;

+

+enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) 

+INT VAR i ; 

+FOR i FROM 128 UPTO 254 REP 

+ link outcode (i, 4) (* first outstring *)

+PER ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""27"G0") ;(* END MARK    : <ESC> G 0 *) 

+enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK  : <ESC> G 4 *) 

+enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE   : <ESC> G 8 *) 

+enter outcode ( 17, 0, ""27"G2") ;(* FLASH       : <ESC> G 2 *) 

+ 

+(* Low Video on = <ESC> ) , High Video on = <ESC> ( *) 

+enter outcode (214, "[") ; (* Ae     : [ *) 

+enter outcode (215, "\") ; (* Oe     : \ *) 

+enter outcode (216, "]") ; (* Ue     : ] *)

+enter outcode (217, "{") ; (* ae     : {      } *) 

+enter outcode (218, "|") ; (* oe     : | *) 

+enter outcode (219, "}") ; (* ue     : }      { *)

+enter outcode (220, ""27")k"27"(") ; (* Trenn-k     : k *) 

+enter outcode (221, ""27")-"27"(") ; (* Trennstrich : - *) 

+enter outcode (222, ""27")#"27"(") ; (* Fest-#      : # *) 

+enter outcode (223, ""27")_"27"(") ; (* Fest-Blank  : <SPACE> *) 

+enter outcode (251, "~") ; (* sz     : ~ *) 

+enter outcode (252, "@") ; (* Paragraph: @ *)

+

+(* Eingabecodes : *)

+(* Achtung: Tabelle ist randvoll! *) 

+enter incode (  0, ""0"")  ;  (* Wird beim Einschalten dreimal gesendet *)

+enter incode (  1, ""30"") ;  (* HOP         : <CTRL-^> *)

+enter incode (  2, ""12"") ;  (* Cursor right: <CTRL-L> *)

+enter incode (  3, ""11"") ;  (* Cursor up   : <CTRL-K> *)

+enter incode (  7, ""1"A"13"") ; (* SV - Call   : F2 *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  9, ""9"") ;   (* TAB         : <CTRL-I> *)

+enter incode ( 10, ""22"") ;  (* Cursor down : <CTRL-Y> *)

+enter incode ( 11, ""27"Q") ; (* RUBIN       : <ESC> Q *)

+enter incode ( 12, ""127"") ; (* RUBOUT      : <DEL> *)

+enter incode ( 12, ""27"W") ; (* RUBOUT      : <ESC> W *)

+enter incode ( 16, ""27"E") ; (* MARK        : <ESC> E *)

+enter incode ( 17, ""19"") ;  (* Stop        : <CTRL-S> *)

+enter incode ( 23, ""17"") ;  (* Weiter      : <CTRL-Q> *)

+enter incode ( 23, ""3"") ;   (* Weiter      : <CTRL-C> *) 

+enter incode (  4, ""1"C"13"") ; (* Funct.-Taste F4 : <CTRL-A> C <CR>*) 

+enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste F5 : <CTRL-A> D <CR> *)

+enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste F6 : <CTRL-A> E <CR> *)

+enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste F7 : <CTRL-A> F <CR> *)

+enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste F8 : <CTRL-A> G <CR> *)

+enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste F9 : <CTRL-A> H <CR> *)

+enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste F10: <CTRL-A> I <CR> *)

+enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste F11: <CTRL-A> J <CR> *)

+enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste F12: <CTRL-A> ` <CR> *)

+enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste F13: <CTRL-A> a <CR> *)

+enter incode ( 31, ""1"b"13"") ; (* Funct.-Taste F14: <CTRL-A> b <CR> *)

+enter incode (214, "[") ; 

+enter incode (215, "\") ; 

+enter incode (216, "]") ; 

+enter incode (217, "{") ; 

+enter incode (218, "|") ; 

+enter incode (219, "}") ; 

+enter incode (251, "~") ; 

+enter incode (252, "@") ; 

+

+ 

+PROC link outcode (INT CONST eumelcode, begin of string) : 

+ enter outcode (eumelcode, begin of string -128) 

+ENDPROC link outcode ;

diff --git a/system/terminal-codes/unknown/src/A230+ b/system/terminal-codes/unknown/src/A230+
new file mode 100644
index 0000000..89dcb79
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A230+
@@ -0,0 +1,61 @@
+TEXT VAR  name :="A230+"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0 ");

+enter outcode (15,0,""27"G4 ");

+ 

+enter outcode ( 91,0,">");

+enter outcode ( 92,0,"/");

+enter outcode ( 93,0,">");

+enter outcode (123,0,"(");

+enter outcode (124,0,"!");

+enter outcode (125,0,")");

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,126);

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");                            (* HOP *) 

+enter incode ( 2,""12"");                            (* up *) 

+enter incode ( 3,""11"");                            (* right *) 

+enter incode (10,""22"");                            (* down *) 

+enter incode ( 8,""8"");                             (* left *) 

+enter incode (11,""27"Q");enter incode (11,""26"");  (* rubin *) 

+enter incode (12,""27"W");enter incode (12,""127""); (* rubout *) 

+enter incode (12,""27"E");                           (*   "    *) 

+enter incode (16,""16"");                            (* mark *) 

+enter incode (16,""27"T");                           (* mark *) 

+enter incode (7,""2"");                              (* sv *) 

+enter incode (7, ""1""64""13"");                     (* F1 = SV *) 

+enter incode (17,""1""66""13"");                     (* F2 = stop *) 

+enter incode (23,""3"");                             (* weiter *) 

+enter incode (23,""1""65""13"");                     (* F3 = weiter *) 

+

diff --git a/system/terminal-codes/unknown/src/DEC.VT220.ascii b/system/terminal-codes/unknown/src/DEC.VT220.ascii
new file mode 100644
index 0000000..c83f9b9
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DEC.VT220.ascii
@@ -0,0 +1,49 @@
+TEXT VAR  name :="DEC.VT220.ascii";

+new type (name);

+cursor logic  ( 1,  1, ""155"",";","H");

+enter outcode ( 1,  0, ""155"1;1H");  (* home *)

+enter outcode ( 2,  0, ""155"C");     (* right *)

+enter outcode ( 3,  0, ""155"A");     (* up *)

+enter outcode ( 4, 40, ""155"J");     (* clear eop *)

+enter outcode ( 5,  0, ""155"K");     (* clear eol *)

+enter outcode (10,  0, ""132"");      (* down    *) 

+enter outcode (14,  0, ""155"27m ");  (* end mark *)

+enter outcode (15,  0, ""155"7m ");   (* begin mark *)

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+

+enter outcode (214, ""196"");         (* AE *)

+enter outcode (215, ""214"");         (* OE *)

+enter outcode (216, ""220"");         (* UE *)

+enter outcode (217, ""228"");         (* ae *)

+enter outcode (218, ""246"");         (* oe *)

+enter outcode (219, ""252"");         (* ue *)

+enter outcode (220, "k");             (* Trenn-k  *) 

+enter outcode (221, "-");             (* Trenn-   *) 

+enter outcode (222, "#");             (* Pseudo-# *)

+enter outcode (223, " ");             (* gesch. Blank *) 

+enter outcode (251, ""223"");         (* sz *)

+ 

+enter incode ( 1, ""155"4"126"");     (* hop *)

+enter incode ( 2, ""155"C");          (* right *)

+enter incode ( 3, ""155"A");          (* up *)

+enter incode ( 4, ""4"");             (* info *) 

+enter incode ( 7, ""2"");             (* sv *)

+enter incode ( 7, ""254"");           (* sv *)

+enter incode ( 8, ""155"D");          (* left *)

+enter incode (10, ""155"B");          (* down *)

+enter incode (11, ""155"2"126"");     (* rubin *)

+enter incode (12, ""155"3"126"");     (* rubout *)

+enter incode (12, ""127"");           (* rubout *)

+enter incode (16, ""155"1"126"");     (* mark *)

+enter incode (17, ""1"");             (* stop *) 

+enter incode (23, ""3"");             (* weiter *)

+enter incode (27, ""96"");            (* esc *)

+

+enter incode (25, ""155""50""56""126"");  (* help *)

+enter incode (26, ""155""50""57""126"");  (* do *)

+enter incode (28, ""155"5"126"");         (* prev screen *)

+enter incode (29, ""155"6"126"");         (* next screen *)

diff --git a/system/terminal-codes/unknown/src/DEC.VT220.german b/system/terminal-codes/unknown/src/DEC.VT220.german
new file mode 100644
index 0000000..e45114b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DEC.VT220.german
@@ -0,0 +1,66 @@
+TEXT VAR  name :="DEC.VT220.german"; 

+new type (name);

+cursor logic  ( 1, 1, ""155"",";","H");

+enter outcode ( 1,  0, ""155"1;1H");  (* home *)

+enter outcode ( 2,  0, ""155"C");     (* right *)

+enter outcode ( 3,  0, ""155"A");     (* up *)

+enter outcode ( 4, 40, ""155"J");     (* clear eop *)

+enter outcode ( 5,  0, ""155"K");     (* clear eol *)

+enter outcode (10,  0, ""132"");      (* newline *) 

+enter outcode (14,  0, ""155"27m ");  (* end mark *)

+enter outcode (15,  0, ""155"7m ");   (* begin mark *)

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+

+enter outcode (214, ""196"");         (* AE *)

+enter outcode (215, ""214"");         (* OE *)

+enter outcode (216, ""220"");         (* UE *)

+enter outcode (217, ""228"");         (* ae *)

+enter outcode (218, ""246"");         (* oe *)

+enter outcode (219, ""252"");         (* ue *)

+enter outcode (220, "k");             (* Trenn-k  *) 

+enter outcode (221, "-");             (* Trenn-   *) 

+enter outcode (222, "#");             (* Pseudo-# *)

+enter outcode (223, " ");             (* gesch. Blank *) 

+enter outcode (251, ""223"");         (* sz *)

+

+

+enter incode (27, ""155"5"126"");     (* esc *)

+enter incode ( 1, ""155"4"126"");     (* hop *)

+enter incode ( 2, ""155"C");          (* right *)

+enter incode ( 3, ""155"A");          (* up *)

+enter incode ( 4, ""4"");             (* info *) 

+enter incode ( 7, ""2"");             (* sv *)

+enter incode ( 7, ""254"");           (* sv *)

+enter incode ( 8, ""155"D");          (* left *)

+enter incode (10, ""155"B");          (* down *)

+enter incode (11, ""155"2"126"");     (* rubin *)

+enter incode (12, ""155"3"126"");     (* rubout *)

+enter incode (12, ""127"");           (* rubout *)

+enter incode (16, ""155"1"126"");     (* mark *)

+enter incode (17, ""1"");             (* stop *) 

+enter incode (23, ""3"");             (* weiter *)

+enter incode (27, ""155"23~");        (* esc    *)

+enter incode (214, ""196"");         (* AE *)

+enter incode (215, ""214"");         (* OE *)

+enter incode (216, ""220"");         (* UE *)

+enter incode (217, ""228"");         (* ae *)

+enter incode (218, ""246"");         (* oe *)

+enter incode (219, ""252"");         (* ue *)

+enter incode (251, ""223"");         (* sz *)

+

+enter incode (25, ""155""50""56""126"");  (* help *)

+enter incode (26, ""155""50""57""126"");  (* do *)

+enter incode (28, ""155"5"126"");         (* prev screen *)

+enter incode (29, ""155"6"126"");         (* next screen *)

+

+

+

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/DM5 b/system/terminal-codes/unknown/src/DM5
new file mode 100644
index 0000000..a672698
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DM5
@@ -0,0 +1,53 @@
+LET name = "DM5";

+

+   forget (name,quiet); 

+   new type (name);

+

+cursor logic (32,""27"F","","");

+

+(*************************************************)

+(**** Tasten des Beehive Standard Terminals : ****)

+(*************************************************) 

+(** ae -> 24  Ae -> 20   home   -> esc H        **)

+(** oe -> 25  Oe -> 21   hop    -> 1            **)

+(** ue -> 26  Ue -> 22   mark   -> 4            **)

+(** sz -> 30             rubin  -> 5            **)

+(** cursor r -> 12       weiter -> 15           **)

+(** cursor u -> 11       sv     -> 14           **)

+(**                      halt   -> 6            **)

+(*************************************************)

+

+(* Ein- und Ausgabe-Steuerzeichen: *)

+enter incode (1,  ""27"H"); (* home *)  enter outcode (1,  0, ""27"H");

+enter incode (16, ""4"");   (* mark *)  enter outcode (15, 0, ""27"dP ");

+enter incode (11, ""5"");               enter outcode (14, 0, ""27"m ");

+enter incode (12, ""127"");

+enter incode (7,  ""14"");  (* sv *)

+enter incode (17, ""15"");  (* halt *)

+enter incode (23, ""6"");   (* weiter *)

+ 

+enter outcode (5,  0, ""27"K");         enter incode (3, ""11"");

+enter outcode (4, 40, ""27"J");         enter incode (2, ""12"");

+enter outcode (3,  ""11"");

+enter outcode (2,  0, ""27"C");

+

+(* Umlaute *)

+(* Ae *) enter incode (214, ""20""); enter outcode (214, 0, ""27"dQA"27"m");

+(* Oe *) enter incode (215, ""21""); enter outcode (215, 0, ""27"dQO"27"m");

+(* Ue *) enter incode (216, ""22""); enter outcode (216, 0, ""27"dQU"27"m");

+(* ae *) enter incode (217, ""24""); enter outcode (217, 0, ""27"dQa"27"m");

+(* oe *) enter incode (218, ""25""); enter outcode (218, 0, ""27"dQo"27"m");

+(* ue *) enter incode (219, ""26""); enter outcode (219, 0, ""27"dQu"27"m");

+(* ss *) enter incode (251, ""30""); enter outcode (251, 0, ""27"dQB"27"m");

+(* paragraph *)

+         enter incode (252, ""64""); enter outcode (252, 0, ""27"dQ$"27"m");

+

+(* Textkosmetik *)

+enter outcode (124, 0, ""27"Rd"27"S") ;

+enter outcode (220, "k") ;

+enter outcode (221, 0, ""27"dA-"27"m") ; 

+enter outcode (222, 0, ""27"dQ#"27"m") ; 

+enter outcode (223, "_") ;

+

+enter outcode (255, "%");

+

diff --git a/system/terminal-codes/unknown/src/ELBIT.ascii b/system/terminal-codes/unknown/src/ELBIT.ascii
new file mode 100644
index 0000000..3957ee8
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ELBIT.ascii
@@ -0,0 +1,32 @@
+TEXT VAR  name :="ELBIT.ascii"; 

+new type (name);

+elbit cursor;

+enter outcode (1,12); 

+enter outcode (2  ,21  );

+enter outcode (3  ,26  );

+enter outcode (5  ,22  );

+enter outcode (4,64,""20"");

+enter incode (1,""12""); 

+enter incode (2  ,""21""  );

+enter incode (3  ,""26""  );

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

+

+enter outcode (214,"A");

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223,"_") ; 

+ 

+enter incode (11,""126"");  (* rubin *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,"^") ; (* mark *)

diff --git a/system/terminal-codes/unknown/src/ELBIT.german b/system/terminal-codes/unknown/src/ELBIT.german
new file mode 100644
index 0000000..17d5454
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ELBIT.german
@@ -0,0 +1,47 @@
+TEXT VAR  name :="ELBIT.german"; 

+new type (name);

+elbit cursor;

+enter outcode (1,12); 

+enter outcode (2  ,21  );

+enter outcode (3  ,26  );

+enter outcode (5  ,22  );

+enter outcode (4,64,""20"");

+enter incode (1,""12""); 

+enter incode (2  ,""21""  );

+enter incode (3  ,""26""  );

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

+

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""64"");

+ 

+enter outcode ( 91,"(");

+enter outcode ( 92,"/");

+enter outcode ( 93,")");

+enter outcode (123,"<");

+enter outcode (124,"!");

+enter outcode (125,">");

+enter outcode (126,"^");

+enter outcode (214,91);

+enter outcode (215,92); 

+enter outcode (216,93); 

+enter outcode (217,123); 

+enter outcode (218,124); 

+enter outcode (219,125); 

+enter outcode (251,64);

+

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223,"_") ; 

+ 

+enter incode (11,""126"");  (* rubin *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,"^") ; (* mark *)

diff --git a/system/terminal-codes/unknown/src/FT10-20.ascii b/system/terminal-codes/unknown/src/FT10-20.ascii
new file mode 100644
index 0000000..7f26910
--- /dev/null
+++ b/system/terminal-codes/unknown/src/FT10-20.ascii
@@ -0,0 +1,75 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 14.07.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="FT10/20.ascii"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""27"H");                      (* HOP                   *) 

+enter incode ( 2, ""27"C");                      (* RECHTS                *) 

+enter incode ( 3, ""27"A");                      (* OBEN                  *) 

+enter incode ( 4, ""4"");      (* CNTL D    *)   (* INFO                  *) 

+enter incode ( 7, ""2"");      (* CNTL B    *)   (* SV                    *) 

+enter incode ( 7, ""7"");      (* CNTL G    *)   (* SV                    *) 

+enter incode ( 8, ""27"D");                      (* LINKS                 *) 

+enter incode ( 9, ""27">");    (* BACKTAB   *)   (* TAB                   *) 

+enter incode (10, ""27"B");                      (* UNTEN                 *) 

+enter incode (11, ""27"K");                      (* RUBIN                 *) 

+enter incode (12, ""27"E");                      (* RUBOUT                *) 

+enter incode (12, ""127"");    (* DEL       *)   (* RUBOUT                *) 

+enter incode (16, ""27"J");                      (* MARK                  *) 

+enter incode (17, ""1"");      (* CNTL A    *)   (* STOP                  *) 

+enter incode (23, ""3"");      (* CNTL C    *)   (* WEITER                *) 

+enter incode (24, ""0"") ;     (* BREAK     *)   (* weitere ESC-Zeichen   *)

+enter incode (25, ""27"N") ;   (* LOCAL     *)   (*                       *)

+enter incode (26, ""27"V") ;   (* UNLOCK    *)   (*                       *)

+enter incode (28, ""27"I") ;   (* SEND PAGE *)   (*                       *)

+

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, ""27"H");                 (* HOME                  *)

+enter outcode ( 2, 12);                          (* RECHTS                *)

+enter outcode ( 3, 11);                          (* OBEN                  *)

+enter outcode ( 4, 40, ""27"J");                 (* CL EOP                *)

+enter outcode ( 5,  0, ""27"K");                 (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, ""27"d@ ");               (* END MARK              *)

+enter outcode (15,  0, ""27"dP ");               (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+enter outcode (20, 14);                          (* shift out - grafic on *)

+enter outcode (24, 14);

+enter outcode (21, 15);                          (* shift in  - grafic off*)

+enter outcode (25, 15);

+enter outcode (26,  5);                          (* answer back message   *)

+ 

+cursor logic (32,""27"F","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 92, ""27"/");                     (* backslash             *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+enter outcode (214, 0, ""27" 1"14""034""15"");   (* �                     *)

+enter outcode (215, 0, ""27" 1"14""046""15"");   (* �                     *)

+enter outcode (216, 0, ""27" 1"14""052""15"");   (* �                     *)

+enter outcode (217, 0, ""27" 1"14""066""15"");   (* �                     *)

+enter outcode (218, 0, ""27" 1"14""078""15"");   (* �                     *)

+enter outcode (219, 0, ""27" 1"14""084""15"");   (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, 0, ""27" 3"14""077""15"");   (* Trenn-Strich          *)

+enter outcode (222, 0, ""27" 4"14""069""15"");   (* gesch. Nummerkreuz    *)

+enter outcode (223, 0, ""27" 2"14""110""15"");   (* gesch. Blank          *)

+enter outcode (251, 0, ""27" 1"14""062""15"");   (* �                     *)

+enter outcode (252, 0, ""27" 1"14""063""15"");   (* �                     *)

diff --git a/system/terminal-codes/unknown/src/FT10-20.german b/system/terminal-codes/unknown/src/FT10-20.german
new file mode 100644
index 0000000..09d4337
--- /dev/null
+++ b/system/terminal-codes/unknown/src/FT10-20.german
@@ -0,0 +1,94 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 14.07.86      *)

+ 

+INT VAR i; 

+TEXT VAR table :="FT10/20.german"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""27"H");                      (* HOP                   *) 

+enter incode ( 2, ""27"C");                      (* RECHTS                *) 

+enter incode ( 3, ""27"A");                      (* OBEN                  *) 

+enter incode ( 4, ""4"");      (* CNTL D    *)   (* INFO                  *) 

+enter incode ( 7, ""2"");      (* CNTL B    *)   (* SV                    *) 

+enter incode ( 7, ""7"");      (* CNTL G    *)   (* SV                    *) 

+enter incode ( 8, ""27"D");                      (* LINKS                 *) 

+enter incode ( 9, ""27">");    (* BACKTAB   *)   (* TAB                   *) 

+enter incode (10, ""27"B");                      (* UNTEN                 *) 

+enter incode (11, ""27"K");                      (* RUBIN                 *) 

+enter incode (12, ""27"E");                      (* RUBOUT                *) 

+enter incode (12, ""127"");    (* DEL       *)   (* RUBOUT                *) 

+enter incode (16, ""27"J");                      (* MARK                  *) 

+enter incode (17, ""1"");      (* CNTL A    *)   (* STOP                  *) 

+enter incode (23, ""3"");      (* CNTL C    *)   (* WEITER                *) 

+enter incode (24, ""0"") ;     (* BREAK     *)   (* weitere ESC-Zeichen   *)

+enter incode (25, ""27"N") ;   (* LOCAL     *)   (*                       *)

+enter incode (26, ""27"V") ;   (* UNLOCK    *)   (*                       *)

+enter incode (28, ""27"I") ;   (* SEND PAGE *)   (*                       *)

+

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, ""27"H");                 (* HOME                  *)

+enter outcode ( 2, 12);                          (* RECHTS                *)

+enter outcode ( 3, 11);                          (* OBEN                  *)

+enter outcode ( 4, 40, ""27"J");                 (* CL EOP                *)

+enter outcode ( 5,  0, ""27"K");                 (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, ""27"d@ ");               (* END MARK              *)

+enter outcode (15,  0, ""27"dP ");               (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+enter outcode (20, 14);                          (* shift out - grafic on *)

+enter outcode (24, 14);

+enter outcode (21, 15);                          (* shift in  - grafic off*)

+enter outcode (25, 15);

+enter outcode (26,  5);                          (* answer back message   *)

+ 

+cursor logic (32,""27"F","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 39, "/");                         (* '                     *)

+enter incode ( 47, "'");                         (* /                     *)

+enter incode ( 92, ""27"/");                     (* backslash             *)

+enter incode (214, ""91"");                      (* �                     *)

+enter incode (215, ""92"");                      (* �                     *)

+enter incode (216, ""93"");                      (* �                     *)

+enter incode (217, ""123"");                     (* �                     *)

+enter incode (218, ""124"");                     (* �                     *)

+enter incode (219, ""125"");                     (* �                     *)

+enter incode (251, ""126"");                     (* �                     *)

+enter incode (252, ""064"");                     (* �                     *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode ( 64, 0, ""27" 0"14""064""15"");   (* @                     *)

+enter outcode ( 91, 0, ""27" 0"14""091""15"");   (* [                     *)

+enter outcode ( 92, 0, ""27" 0"14""092""15"");   (* \                     *)

+enter outcode ( 93, 0, ""27" 0"14""093""15"");   (* ]                     *)

+enter outcode (123, 0, ""27" 0"14""123""15"");   (* geschw. Klammer auf   *)

+enter outcode (124, 0, ""27" 0"14""124""15"");   (* |                     *)

+enter outcode (125, 0, ""27" 0"14""125""15"");   (* geschw. Klammer zu    *)

+enter outcode (126, 0, ""27" 0"14""126""15"");   (* ~                     *)

+enter outcode (214,  91);                        (* �                     *)

+enter outcode (215,  92);                        (* �                     *)

+enter outcode (216,  93);                        (* �                     *)

+enter outcode (217, 123);                        (* �                     *)

+enter outcode (218, 124);                        (* �                     *)

+enter outcode (219, 125);                        (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, 0, ""27" 3"14""077""15"");   (* Trenn-Strich          *)

+enter outcode (222, 0, ""27" 4"14""069""15"");   (* gesch. Nummerkreuz    *)

+enter outcode (223, 0, ""27" 2"14""110""15"");   (* gesch. Blank          *)

+enter outcode (251, 126);                        (* �                     *)

+enter outcode (252,  64);                        (* �                     *)

diff --git a/system/terminal-codes/unknown/src/GENGEN.ELA b/system/terminal-codes/unknown/src/GENGEN.ELA
new file mode 100644
index 0000000..2add75a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/GENGEN.ELA
@@ -0,0 +1,244 @@
+(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) 

+ 

+page ; 

+putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; 

+line ; 

+BOUND STRUCT (ALIGN space, ROW 128 INT outcodes, 

+                           ROW  64 INT outstrings,

+                           ROW  64 INT instrings) VAR x ; 

+ 

+TEXT VAR t , filename ; 

+INT VAR i , laenge , position , eumel code ; 

+FILE VAR f ; 

+put ("Name der Tabelle:") ; 

+getline (t) ; 

+IF exists (t+".gen") THEN forget (t+".gen") FI ; 

+IF exists (t+".gen") 

+THEN filename := t + ".new.gen" 

+ELSE filename := t + ".gen"

+FI ; 

+f := sequentialfile (output, filename) ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+putline (f, "(* Typtabelle   : " + text (t, 30) + " *)") ; 

+putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+line (f) ; 

+putline (f, "forget (""" + t + """, quiet) ;") ; 

+putline (f, "new type (""" + t + """) ;") ; 

+line (f) ; 

+x := old (t) ; 

+t := "  " ; 

+IF (x.outstrings (1) AND 255) = 2 

+   THEN putline (f, "elbit cursor ;") ; 

+        line (f) ; 

+   ELSE write (f, "cursor logic (") ; 

+        put (f, text (x.outstrings (2) AND 255) + ",") ; 

+        position := (x.outcodes (4) AND 127) + 1 ;

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        putline (f, denoter (x.outstrings, position, 0) + ") ;") ; 

+        line (f)

+FI ; 

+putline (f, "(* Ausgabe Codes : *)") ; 

+FOR i FROM 1 UPTO 128 REP 

+ cout (lineno (f)) ;

+ replace (t, 1, x.outcodes (i)) ; 

+ IF i <> 4 

+ THEN IF code (t SUB 1) <> 255 

+      THEN eumel code := (i-1) * 2 ; 

+           put (f, "enter outcode (" + text (eumel code, 3) + ",") ; 

+           IF code (t SUB 1) > 127 

+           THEN outstring (code (t SUB 1)-128) 

+           ELSE numberput (code (t SUB 1)) 

+           FI ; 

+           line (f) 

+      FI 

+ FI ; 

+ IF code (t SUB 2) <> 255 

+ THEN eumel code := (i-1) * 2 + 1 ; 

+      put (f, "enter outcode (" + text (eumel code, 3) + ",") ;

+      IF code (t SUB 2) > 127 

+      THEN outstring (code (t SUB 2) - 128) 

+      ELSE numberput (code (t SUB 2)) 

+      FI ; 

+      line (f) 

+ FI ; 

+PER ; 

+line (f) ; 

+line (f) ; 

+ 

+putline (f, "(* Eingabe Codes : *)") ; 

+i := 0 ; 

+WHILE i < 128 CAND incode (i) <> 255 REP

+ cout (lineno (f)) ; 

+ eumel code := incode (i) ; 

+ put (f, "enter incode (" + text (eumel code,3) + ",") ; 

+ write (f, denoter (x.instrings, i + 1, 255)) ; 

+ put (f, ") ; (*") ; 

+ i INCR 1 ; 

+ IF in bezeichnung (eumel code) <> "" 

+ THEN put (f, in bezeichnung (eumel code) + ":") 

+ FI ; 

+ WHILE i < 128 CAND incode (i) <> 255 REP 

+  charput (incode (i)) ; 

+  i INCR 1 

+ PER ; 

+ i INCR 1 ; 

+ putline (f, "*)") 

+PER ; 

+ 

+edit (filename) ; 

+ 

+INT PROC incode (INT CONST element) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.instrings (element DIV 2 + 1)); 

+ IF (element MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC incode ; 

+ 

+ 

+TEXT PROC in bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "HOP         " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 7 : "SV - Call   " 

+  CASE 8 : "Cursor left " 

+  CASE 9 : "TAB         " 

+  CASE 10: "Cursor down " 

+  CASE 11: "RUBIN       " 

+  CASE 12: "RUBOUT      "

+  CASE 13: "CR          " 

+  CASE 16: "MARK        " 

+  CASE 17: "Stop        " 

+  CASE 23: "Weiter      " 

+  CASE 27: "Escape      "

+  CASE 214:"ae-Taste    " 

+  CASE 215:"oe-Taste    " 

+  CASE 216:"ue-Taste    "

+  CASE 217:"Ae-Taste    " 

+  CASE 218:"Oe-Taste    " 

+  CASE 219:"Ue-Taste    " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz-Taste    " 

+  OTHERWISE IF code < 32 THEN "Funct.-Taste" 

+                         ELSE "" 

+            FI 

+ ENDSELECT 

+ENDPROC in bezeichnung ; 

+ 

+TEXT PROC out bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "Cursor Home " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "CLEOP       " 

+  CASE 5 : "CLEOL       " 

+  CASE 6 : "Cursor (YX) " 

+  CASE 7 : "Beep        " 

+  CASE 8 : "Cursor left " 

+  CASE 10: "Cursor down " 

+  CASE 13: "CR          " 

+  CASE 14: "END MARK    " 

+  CASE 15: "BEGIN MARK  " 

+  CASE 214:"ae          " 

+  CASE 215:"oe          " 

+  CASE 216:"ue          "

+  CASE 217:"Ae          " 

+  CASE 218:"Oe          " 

+  CASE 219:"Ue          " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz          " 

+  OTHERWISE ""

+ ENDSELECT 

+ENDPROC out bezeichnung ; 

+ 

+PROC charput (INT CONST nr) : 

+ IF nr = 27 THEN put (f, "<ESC>") 

+ ELIF nr = 10 THEN put (f, "<LF>") 

+ ELIF nr = 13 THEN put (f, "<CR>") 

+ ELIF nr = 32 THEN put (f, "<SPACE>") 

+ ELIF nr = 127 THEN put (f, "<DEL>") 

+ ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") 

+ ELIF nr > 32 THEN put (f, code (nr))

+ ELSE put (f, "<CTRL-" + code (nr+64) + ">") 

+ FI 

+ENDPROC charput ; 

+ 

+PROC numberput (INT CONST nr) : 

+ put (f, text (nr,3 ) + ") ; (*") ;

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ; 

+ charput (nr) ; 

+ put (f, "*)") ; 

+ENDPROC numberput ; 

+ 

+TEXT PROC denoter (ROW 64 INT VAR y, INT CONST pos, ende) : 

+ INT VAR i := pos ; 

+ TEXT VAR t := "  " , zeile := """" ; 

+ laenge := 0 ; 

+ WHILE i < 128 AND zugriff <> ende REP 

+  IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) 

+  ELIF zugriff = 34 THEN zeile CAT """"""

+  ELIF zugriff = 251 THEN zeile CAT "ß" 

+  ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) 

+  ELSE zeile CAT """" ; 

+       zeile CAT text (zugriff) ; 

+       zeile CAT """" 

+  FI ; 

+  i INCR 1 ; 

+  laenge INCR 1 

+ PER ; 

+ zeile CAT """" ; 

+ zeile. 

+ 

+ 

+zugriff : 

+ replace (t, 1, y (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC denoter ; 

+ 

+ 

+PROC outstring (INT CONST element) : 

+ INT VAR i := element ; 

+ put (f, text (zugriff) + ",") ; 

+ put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; 

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ;

+ i INCR 1 ; 

+ WHILE zugriff <> 0 REP 

+  charput (zugriff) ; 

+  i INCR 1 

+ PER ; 

+ put (f, "*)") . 

+ 

+ 

+zugriff : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.outstrings (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC outstring 

+

+

+

+

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/GT100 b/system/terminal-codes/unknown/src/GT100
new file mode 100644
index 0000000..c366d09
--- /dev/null
+++ b/system/terminal-codes/unknown/src/GT100
@@ -0,0 +1,44 @@
+TEXT VAR  name :="GT100";

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""27"H");

+enter outcode (2 ,0,""27"C");

+enter outcode (3 ,0,""27"A");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""126"");

+enter outcode (15,0,""126"");

+ 

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (223,"_") ; 

+enter outcode (251,"B");

+ 

+ 

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11""); 

+enter incode (10,""10"");

+enter incode ( 8,""8"");

+enter incode (11,""6"");

+enter incode (12,""127"");

+enter incode (16,""26"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""27"z");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""17"");  (* weiter *)

+

diff --git a/system/terminal-codes/unknown/src/IBM.PC.AT b/system/terminal-codes/unknown/src/IBM.PC.AT
new file mode 100644
index 0000000..7c7a80c
--- /dev/null
+++ b/system/terminal-codes/unknown/src/IBM.PC.AT
@@ -0,0 +1,63 @@
+LET name = "IBM.PC.AT"; 

+forget (name, quiet); 

+new type (name); 

+ 

+cursor logic (0, ""6"", "", "");

+ 

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  7, ""187"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 27,  ""96"");              (* ESC *)

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/M20 b/system/terminal-codes/unknown/src/M20
new file mode 100644
index 0000000..6de575a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M20
@@ -0,0 +1,10 @@
+TEXT VAR  name :="M20"; 

+command dialogue (FALSE); forget (name); 

+new type (name);

+cursor logic (0,""6"","","");

+ 

+enter incode (7,""7"");  (* sv *)

+ 

+ 

+enter outcode (14,""14""); 

+enter outcode (15,""15"");

diff --git a/system/terminal-codes/unknown/src/M20.original b/system/terminal-codes/unknown/src/M20.original
new file mode 100644
index 0000000..31bb7c4
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M20.original
@@ -0,0 +1,27 @@
+TEXT VAR name := "M20.original"; 

+command dialogue (FALSE); forget (name);

+new type (name); 

+cursor logic (0,""6"","",""); 

+ 

+enter outcode (14, ""14""); 

+enter outcode (15, ""15""); 

+ 

+enter incode (7,""7"");  (* sv *)

+enter incode ( code ( ";" ), "!"); 

+enter incode ( code ( "=" ), "@"); 

+enter incode ( code ( "%" ), "$"); 

+enter incode ( code ( "&" ), "%"); 

+enter incode ( code ( "(" ), "&"); 

+enter incode ( code ( ")" ), "/"); 

+enter incode ( code ( "_" ), "("); 

+enter incode ( code ( "@" ), ")"); 

+enter incode ( code ( "/" ), "="); 

+enter incode ( code ( ":" ), "?"); 

+enter incode ( code ( "^" ), "�"); 

+enter incode ( code ( "!" ), ":"); 

+enter incode ( code ( "�" ), "_"); 

+enter incode ( code ( "$" ), "#"); 

+enter incode ( code ( "#" ), "^"); 

+enter incode ( code ( "?" ), ";");

+

+command dialogue (TRUE);

diff --git a/system/terminal-codes/unknown/src/M24 b/system/terminal-codes/unknown/src/M24
new file mode 100644
index 0000000..2588f03
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M24
@@ -0,0 +1,63 @@
+LET name = "M24"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""7"");              (* SV *)

+enter incode (  7, ""206"");              (* SV *)

+enter incode ( 17,  ""17"");              (* STOP *)

+enter incode ( 17, ""208"");              (* STOP *)

+enter incode ( 23,  ""23"");              (* WEITER *)

+enter incode ( 23, ""207"");              (* WEITER *)

+

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 35,  ""96"");              (* # *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 42, ""201"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 43, ""203"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 45, ""202"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 47, ""200"");              (* / *) 

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 64,  ""35"");              (* @ *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 94, ""126"");              (* ^ *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/M24.keybfr1 b/system/terminal-codes/unknown/src/M24.keybfr1
new file mode 100644
index 0000000..33949d4
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M24.keybfr1
@@ -0,0 +1,64 @@
+

+LET name = "M24.keybfr1";

+forget(name,quiet);

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* � *)

+enter outcode (215, 153);                 (* � *)

+enter outcode (216, 154);                 (* � *)

+enter outcode (217, 132);                 (* � *)

+enter outcode (218, 148);                 (* � *)

+enter outcode (219, 129);                 (* � *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225); 

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""7"");              (* SV *)

+enter incode (  7, ""206"");              (* SV *)

+enter incode ( 17,  ""17"");              (* STOP *)

+enter incode ( 17, ""208"");              (* STOP *)

+enter incode ( 23,  ""23"");              (* WEITER *)

+enter incode ( 23, ""207"");              (* WEITER *)

+enter incode ( 45,  ""61"");              (* - *)

+enter incode (125,  ""96"");              (*   *)

+enter incode ( 41,  ""95"");              (* ) *)

+enter incode ( 35,  ""45"");              (* # *)

+enter incode ( 38,  ""33"");              (* & *)

+enter incode (130,  ""64"");              (* � *)

+enter incode ( 34,  ""35"");              (* " *)

+enter incode ( 39,  ""36"");              (* ' *)

+enter incode ( 40,  ""37"");              (* ( *)

+enter incode (151,  ""39"");              (* � *)

+enter incode (138,  ""38"");              (* � *)

+enter incode ( 33,  ""42"");              (* ! *)

+enter incode (135,  ""40"");              (* � *)

+enter incode (133,  ""41"");              (* � *)

+enter incode ( 97, ""113"");              (* a *)

+enter incode ( 65,  ""81"");              (* A *)

+enter incode ( 122,""119"");              (* z *)

+enter incode ( 90,  ""87"");              (* Z *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode (113,  ""97"");              (* q *)

+enter incode ( 81,  ""65"");              (* Q *)

+enter incode (109,  ""59"");              (* m *)

+enter incode ( 77,  ""58"");              (* M *)

+enter incode ( 37,  ""34"");              (* % *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode (119, ""122"");              (* w *)

+enter incode ( 87,  ""90"");              (* W *)

+enter incode ( 44, ""109"");              (* , *)

+enter incode ( 63,  ""77"");              (* ? *)

+enter incode ( 59,  ""44"");              (* ; *)

+enter incode ( 46,  ""60"");              (* . *)

+enter incode ( 58,  ""46"");              (* : *)

+enter incode ( 61,  ""47"");              (* = *)

+enter incode ( 43,  ""63"");              (* + *)

+enter incode ( 47,  ""62"");              (* / *)

+

diff --git a/system/terminal-codes/unknown/src/PC.KB2 b/system/terminal-codes/unknown/src/PC.KB2
new file mode 100644
index 0000000..4917eb0
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.KB2
@@ -0,0 +1,79 @@
+LET type = "PC.KB2";

+IF exists (type) THEN forget (type, quiet) FI;

+new type (type);

+cursor logic (0, ""6"", "", "");

+ 

+enter outcode ( 14, 0, ""14" ");      {end mark}

+enter outcode ( 15, 0, ""15" ");      {begin mark}

+enter outcode (214, ""142"");         {Ä}

+enter outcode (215, ""153"");         {Ö}

+enter outcode (216, ""154"");         {Ü}

+enter outcode (217, ""132"");         {ä}

+enter outcode (218, ""148"");         {ö}

+enter outcode (219, ""129"");         {ü}

+enter outcode (220, 0, ""15"k"14"");  {trenn-k}

+enter outcode (221, 0, ""15"-"14"");  {trenn-strich}

+enter outcode (222, 0, ""15"#"14"");  {pseudo-fis}

+enter outcode (223, 0, ""15" "14"");  {pseudo-blank}

+enter outcode (251, ""225"");         {ß}

+ 

+enter incode (  1, ""199"");          {hop}

+enter incode (  2, ""205"");          {rechts}

+enter incode (  3, ""200"");          {oben}

+enter incode (  7, ""2"");            {sv: ctrl b}

+enter incode (  7, ""187"");          {sv: f1}

+enter incode (  8, ""203"");          {links}

+enter incode ( 10, ""208"");          {unten}

+enter incode ( 11, ""210"");          {rubin: ins}

+enter incode ( 12, ""211"");          {rubout: del}

+enter incode ( 16, ""201"");          {mark: pg up}

+enter incode ( 17, ""1"");            {stop: ctrl a}

+

+(*

+enter incode ( 18, ""190"");          {""18"": f2}

+enter incode ( 19, ""191"");          {""19"": f3}

+enter incode ( 20, ""192"");          {""20"": f4}

+enter incode ( 21, ""193"");          {""21"": f5}

+enter incode ( 22, ""194"");          {""22"": f6}

+*)

+

+enter incode ( 23, ""3"");            {start: ctrl b}

+enter incode ( 23, "00");             {start: 00}

+

+(*

+enter incode ( 24, ""195"");          {""24"": f7}

+enter incode ( 25, ""196"");          {""25"": f8}

+enter incode ( 26, ""212"");          {""26"": f9}

+enter incode ( 28, ""213"");          {""28"": f10}

+enter incode ( 29, ""214"");          {""29"": f11}

+enter incode ( 30, ""215"");          {""30"": f12}

+enter incode ( 31, ""216"");          {""31"": f13}

+*)

+

+enter incode ( 35, ""93"");           {#}

+enter incode ( 39, ""94"");           {'}

+enter incode ( 42, ""123"");          {*}

+enter incode ( 43, ""91"");           {+}

+enter incode ( 45, ""47"");           {-}

+enter incode ( 47, ""39"");           {/}

+enter incode ( 58, ""62"");           {:}

+enter incode ( 59, ""60"");           {;}

+enter incode ( 60, ""92"");           {<}

+enter incode ( 61, ""95"");           {=}

+enter incode ( 62, ""124"");          {>}

+enter incode ( 63, ""61"");           {?}

+enter incode ( 64, ""35"");           {@}

+enter incode ( 89, ""90"");           {Y}

+enter incode ( 90, ""89"");           {Z}

+enter incode ( 94, ""125"");          {^}

+enter incode ( 95, ""63"");           {_}

+enter incode ( 96, ""126"");          {\}

+enter incode (121, ""122"");          {y}

+enter incode (122, ""121"");          {z}

+enter incode (214, ""42"");           {Ä}

+enter incode (215, ""43"");           {Ö}

+enter incode (216, ""96"");           {Ü}

+enter incode (217, ""58"");           {ä}

+enter incode (218, ""59"");           {ö}

+enter incode (219, ""64"");           {ü}

+enter incode (251, ""45"");           {ß}

diff --git a/system/terminal-codes/unknown/src/PC.french b/system/terminal-codes/unknown/src/PC.french
new file mode 100644
index 0000000..6a1675c
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.french
@@ -0,0 +1,68 @@
+LET name = "PC.french"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* � *)

+enter outcode (215, 153);                 (* � *)

+enter outcode (216, 154);                 (* � *)

+enter outcode (217, 132);                 (* � *)

+enter outcode (218, 148);                 (* � *)

+enter outcode (219, 129);                 (* � *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* � *) 

+

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 45,  ""61"");              (* - *)

+enter incode ( 41,  ""95"");              (* ) *)

+enter incode ( 35,  ""45"");              (* # *)

+enter incode ( 38,  ""33"");              (* & *)

+enter incode ( 34,  ""35"");              (* " *)

+enter incode ( 40,  ""37"");              (* ( *)

+enter incode ( 33,  ""42"");              (* ! *)

+enter incode ( 97, ""113"");              (* a *)

+enter incode ( 65,  ""81"");              (* A *)

+enter incode ( 122,""119"");              (* z *)

+enter incode ( 90,  ""87"");              (* Z *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode (113,  ""97"");              (* q *)

+enter incode ( 81,  ""65"");              (* Q *)

+enter incode (109,  ""59"");              (* m *)

+enter incode ( 77,  ""58"");              (* M *)

+enter incode ( 37,  ""34"");              (* % *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode (119, ""122"");              (* w *)

+enter incode ( 87,  ""90"");              (* W *)

+enter incode ( 44, ""109"");              (* , *)

+enter incode ( 63,  ""77"");              (* ? *)

+enter incode ( 59,  ""44"");              (* ; *)

+enter incode ( 46,  ""60"");              (* . *)

+enter incode ( 58,  ""46"");              (* : *)

+enter incode ( 61,  ""47"");              (* = *)

+enter incode ( 43,  ""63"");              (* + *)

+enter incode ( 47,  ""62"");              (* / *)

+enter incode (125,  ""96"");              (* } *)

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/PC.german b/system/terminal-codes/unknown/src/PC.german
new file mode 100644
index 0000000..50a49fc
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.german
@@ -0,0 +1,63 @@
+LET name = "PC.german"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 35,  ""96"");              (* # *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 64, ""249"");              (* @ *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/Qume.german b/system/terminal-codes/unknown/src/Qume.german
new file mode 100644
index 0000000..850a15b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/Qume.german
@@ -0,0 +1,77 @@
+(* 

+    Typdefinition:  Qume deutsch                          12.10.84 

+*)

+TEXT VAR  name :="Qume.german"; 

+command dialogue (FALSE);forget (name); 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,0,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (7,7); 

+enter outcode (8,8); 

+enter outcode (10,10); 

+enter outcode (13,13); 

+enter outcode (14,0,""27"G0");

+enter outcode (15,0,""27"G4");

+enter outcode (130,0,"-"); 

+enter outcode (131,0,"-"); 

+enter outcode (132,0,"-"); 

+enter outcode (133,0,"-"); 

+enter outcode (134,0,"-"); 

+enter outcode (135,0,"I"); 

+enter outcode (136,0,"I"); 

+enter outcode (137,0,"-"); 

+enter outcode (138,0,"-"); 

+enter outcode (139,0,"I"); 

+enter outcode (140,0,"I"); 

+ 

+enter outcode (214,""91"");

+enter outcode (215,""92"");

+enter outcode (216,""93"");

+enter outcode (217,""123"");

+enter outcode (218,""124"");

+enter outcode (219,""125"");

+ 

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223," ") ; 

+enter outcode (251,""126"");

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode ( 1,""26"");

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""10"");

+enter incode ( 8,""8"");

+enter incode (9,""9"");

+enter incode (11,""01""67""13"");

+enter incode (11,""01""71""13"");

+enter incode (11,""01""75""13"");

+enter incode (12,""127""); 

+enter incode (13,""13"");

+enter incode (16,""01""66""13""); 

+enter incode (16,""01""70""13""); 

+enter incode (16,""01""74""13""); 

+enter incode (17,""01""64""13""); (* stop *)

+enter incode (17,""01""68""13""); 

+enter incode (17,""01""72""13""); 

+enter incode (23,""01""65""13"");  (* weiter *)

+enter incode (23,""01""69""13""); 

+enter incode (23,""01""73""13""); 

+ 

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""0"");  (* sv *)

+ 

+command dialogue (TRUE);            (* 12.10.84 *) 

diff --git a/system/terminal-codes/unknown/src/REGENT25 b/system/terminal-codes/unknown/src/REGENT25
new file mode 100644
index 0000000..25955d6
--- /dev/null
+++ b/system/terminal-codes/unknown/src/REGENT25
@@ -0,0 +1,34 @@
+TEXT VAR  name :="REGENT25"; 

+new type (name);

+cursor logic (32,""27"Y","","");

+enter outcode (1,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,120,""27"k");

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223, "_");

+ 

+enter outcode (214,"A");    (* Umlaute *)

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+ 

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" ); (* backspace *)

+enter incode (4,""4"");   (* info   *) 

+enter incode (7,""29"");  (* sv     *)

+enter incode (17,""3"");  (* stop *) 

+enter incode (23,""0"");  (* weiter *)

+

+

+enter incode (11,"^");      (* rubin  *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,""126"") ; (* mark   *)

diff --git a/system/terminal-codes/unknown/src/REGENT40 b/system/terminal-codes/unknown/src/REGENT40
new file mode 100644
index 0000000..4f6323a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/REGENT40
@@ -0,0 +1,37 @@
+TEXT VAR  name :="REGENT40"; 

+new type (name);

+cursor logic (32,""27"Y","","");

+enter outcode (1,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,120,""27"k");

+ 

+   enter outcode (15,0,""27"0@");     (* invers video ein = begin mark*) 

+   enter outcode (14,0,""27"0P");     (* invers video aus = end mark*) 

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223, "_");

+ 

+enter outcode (214,"A");    (* Umlaute *)

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+ 

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" ); (* backspace *)

+enter incode (4,""4"");   (* info   *) 

+enter incode (7,""29"");  (* sv     *)

+enter incode (17,""3"");  (* stop *) 

+enter incode (23,""0"");  (* weiter *)

+

+

+enter incode (11,"^");      (* rubin  *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,""126"") ; (* mark   *)

diff --git a/system/terminal-codes/unknown/src/RUC.AT.ascii b/system/terminal-codes/unknown/src/RUC.AT.ascii
new file mode 100644
index 0000000..cad3c5b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/RUC.AT.ascii
@@ -0,0 +1,75 @@
+(*************************************************)

+(* Typtabelle   : RUC.AT.ascii                   *)

+(* Generiert am : 21.03.87                       *)

+(*************************************************)

+

+forget ("RUC.AT.ascii", quiet) ;

+new type ("RUC.AT.ascii") ;

+

+cursor logic (0, ""6"", "", "") ;

+

+(* Ausgabe Codes : *)

+enter outcode (  1,   1) ; (* Cursor Home : <CTRL-A> *) 

+enter outcode (  2,   2) ; (* Cursor right: <CTRL-B> *) 

+enter outcode (  3,   3) ; (* Cursor up   : <CTRL-C> *) 

+enter outcode (  4,   4) ; (* CLEOP       : <CTRL-D> *) 

+enter outcode (  5,   5) ; (* CLEOL       : <CTRL-E> *) 

+enter outcode (  8,   8) ; (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ; (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ; (* CR          : <CR> *) 

+enter outcode ( 14, 0, " "14"") ; (* END MARK    : <CTRL-N> <SPACE> *) 

+enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK  : <CTRL-O> <SPACE> *) 

+enter outcode (214, 0, ""142"") ; (* Ae          : <142> *) 

+enter outcode (215, 0, ""153"") ; (* Oe          : <153> *) 

+enter outcode (216, 0, ""154"") ; (* Ue          : <154> *) 

+enter outcode (217, 0, ""132"") ; (* ae          : <132> *) 

+enter outcode (218, 0, ""148"") ; (* oe          : <148> *) 

+enter outcode (219, 0, ""129"") ; (* ue          : <129> *) 

+enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k : <CTRL-O> k <CTRL-N> *) 

+enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich: <CTRL-O> - <CTRL-N> *) 

+enter outcode (222, 0, ""15"#"14"") ; (* Fest-#  : <CTRL-O> # <CTRL-N> *) 

+enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank:<CTRL-O><SPACE><CTRL-N>*) 

+enter outcode (251, 0, ""225"") ; (* sz          : <225> *) 

+enter outcode (252, 21) ;         (* paragraph   : <21> *)

+

+

+(* Eingabe Codes : *)

+enter incode ( 17, ""1"") ;   (* Stop        : <CTRL-A> *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  7, ""187"");  (* SV - Call   : F1 *)

+enter incode ( 23, ""3"") ;   (* Weiter      : <CTRL-C> *)

+enter incode (  4, ""4"") ;   (* INFO        : <CTRL-D> *)

+enter incode (  1, ""199"") ; (* HOP         : POS1  *)

+enter incode (  2, ""205"") ; (* Cursor right: <205> *)

+enter incode (  3, ""200"") ; (* Cursor up   : <200> *)

+enter incode (  8, ""203"") ; (* Cursor left : <203> *)

+enter incode ( 10, ""208"") ; (* Cursor down : <208> *)

+enter incode ( 11, ""210"") ; (* RUBIN       : INSERT *)

+enter incode ( 12, ""211"") ; (* RUBOUT      : DELETE *)

+enter incode ( 16, ""201"") ; (* MARK        : Page up *)

+                              (* AE-Taste    : F13 = SHIFT F3 *)

+                              (* OE-Taste    : F14 = SHIFT F4 *)

+                              (* UE-Taste    : F15 = SHIFT F5 *)

+                              (* ae-Taste    : F16 = SHIFT F6 *)

+                              (* oe-Taste    : F17 = SHIFT F7 *)

+                              (* ue-Taste    : F18 = SHIFT F8 *)

+                              (* trenn-k     : F19 = SHIFT F9 *)

+                              (* trenn -     : F20 = SHIFT F10 *)

+                              (* fix #       : F21 = CTRL  F1 *) 

+                              (* fix blank   : F22 = CTRL  F2 *) 

+enter incode (252, ""224"") ; (* paragraph   : F23 = CTRL  F3 *)

+enter incode (251, ""225"") ; (* sz-Taste    : F24 = CTRL  F4 *)

+enter incode ( 14, ""207"") ; (* Funct.-Taste: END   *)

+enter incode ( 15, ""204"") ; (* Funct.-Taste: Num-5 *)

+enter incode ( 18, ""209"") ; (* NEWLINE     : Page down *)

+enter incode ( 19, ""188"") ; (* Funct.-Taste: F2    *)

+enter incode ( 20, ""189"") ; (* Funct.-Taste: F3    *)

+enter incode ( 21, ""190"") ; (* Funct.-Taste: F4    *)

+enter incode ( 22, ""191"") ; (* Funct.-Taste: F5    *)

+enter incode ( 24, ""192"") ; (* Funct.-Taste: F6    *)

+enter incode ( 25, ""193"") ; (* Funct.-Taste: F7    *)

+enter incode ( 26, ""194"") ; (* Funct.-Taste: F8    *)

+enter incode ( 28, ""195"") ; (* Funct.-Taste: F9    *)

+enter incode ( 29, ""196"") ; (* Funct.-Taste: F10   *)

+enter incode ( 30, ""212"") ; (* Funct.-Taste: F11 = SHIFT F1 *)

+enter incode ( 31, ""213"") ; (* Funct.-Taste: F12 = SHIFT F2 *)

diff --git a/system/terminal-codes/unknown/src/SIEMENS.PC-D b/system/terminal-codes/unknown/src/SIEMENS.PC-D
new file mode 100644
index 0000000..8308f72
--- /dev/null
+++ b/system/terminal-codes/unknown/src/SIEMENS.PC-D
@@ -0,0 +1,88 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 13.05.86      *)

+

+LET csi = ""27"[";

+ 

+TEXT VAR table :="SIEMENS.PC-D"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode (  1, ""182"");                     (* HOP                   *)

+enter incode (  1, ""181"");                     (* HOP                   *)

+enter incode (  2, ""205"");                     (* RECHTS                *)

+enter incode (  2, ""207"");                     (* RECHTS                *)

+enter incode (  3, ""200"");                     (* OBEN                  *)

+enter incode (  3, ""201"");                     (* OBEN                  *)

+enter incode (  4, ""004"");   (* CTRL d    *)   (* INFO                  *)

+enter incode (  7, ""187"");   (* F1        *)   (* SV                    *)

+enter incode (  7, ""002"");   (* CTRL b    *)   (* SV                    *)

+enter incode (  8, ""199"");                     (* LINKS                 *)

+enter incode (  8, ""203"");                     (* LINKS                 *)

+enter incode (  9, ""143"");   (* BACKTAB   *)   (* TAB                   *)

+enter incode ( 10, ""208"");                     (* UNTEN                 *)

+enter incode ( 10, ""209"");                     (* UNTEN                 *)

+enter incode ( 11, ""169"");   (* EINFÜGEN  *)   (* RUBIN                 *)

+enter incode ( 11, ""210"");                     (* RUBIN                 *)

+enter incode ( 12, ""008"");   (* BACK  <X| *)   (* RUBOUT                *)

+enter incode ( 12, ""168"");   (* LÖCHEN    *)   (* RUBOUT                *)

+enter incode ( 12, ""211"");                     (* RUBOUT                *)

+enter incode ( 12, ""253"");   (* CE        *)   (* RUBOUT                *)

+enter incode ( 16, ""239"");   (* HILFE     *)   (* MARK                  *)

+enter incode ( 17, ""001"");   (* CTRL a    *)   (* STOP                  *) 

+enter incode ( 18, ""161"");   (* F12       *)   (* newline               *)

+enter incode ( 23, ""003"");   (* CTRL c    *)   (* WEITER                *) 

+enter incode ( 15, ""188"");   (* F2        *)   (* weitere ESC-Zeichen   *)

+enter incode ( 21, ""189"");   (* F3        *)

+enter incode ( 22, ""190"");   (* F4        *)

+enter incode ( 24, ""191"");   (* F5        *)

+enter incode ( 25, ""192"");   (* F6        *)

+enter incode ( 26, ""193"");   (* F7        *)

+enter incode ( 28, ""194"");   (* F8        *)

+enter incode ( 29, ""195"");   (* F9        *)

+enter incode ( 30, ""196"");   (* F10       *)

+enter incode ( 31, ""160"");   (* F11       *)

+

+ 

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, csi + "H");               (* HOME                  *)

+enter outcode ( 2,  0, csi + "C");               (* RECHTS                *)

+enter outcode ( 3,  0, csi + "A");               (* OBEN                  *)

+enter outcode ( 4,  0, csi + "0J");              (* CL EOP                *)

+enter outcode ( 5,  0, csi + "0K");              (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, csi + "m ");              (* END MARK              *)

+enter outcode (15,  0, csi + "7m ");             (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+cursor logic (1,1,csi,";","H"); 

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 46, ""240"");   (* +/-       *)   (* .                     *)

+enter incode (214, ""142"");                     (* Ä                     *)

+enter incode (215, ""153"");                     (* Ö                     *)

+enter incode (216, ""154"");                     (* Ü                     *)

+enter incode (217, ""132"");                     (* ä                     *)

+enter incode (218, ""148"");                     (* ö                     *)

+enter incode (219, ""129"");                     (* ü                     *)

+enter incode (251, ""225"");                     (* ß                     *)

+enter incode (252, ""021"");                     (* ⁿ                     *)

+                                                 

+enter outcode (214, ""142"");                    (* Ä                     *)

+enter outcode (215, ""153"");                    (* Ö                     *)

+enter outcode (216, ""154"");                    (* Ü                     *)

+enter outcode (217, ""132"");                    (* ä                     *)

+enter outcode (218, ""148"");                    (* ö                     *)

+enter outcode (219, ""129"");                    (* ü                     *)

+enter outcode (220, "k"    );                    (* Trenn-k               *)

+enter outcode (221, ""205"");                    (* Trennstrich           *)

+enter outcode (222, ""206"");                    (* gesch. Nummernkreuz   *)

+enter outcode (223, ""176"");                    (* gesch. Blank          *)

+enter outcode (251, ""225"");                    (* ß                     *)

+enter outcode (252, ""021"");                    (* ⁿ                     *)

diff --git a/system/terminal-codes/unknown/src/TAP5060.ELA b/system/terminal-codes/unknown/src/TAP5060.ELA
new file mode 100644
index 0000000..a5a1d70
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TAP5060.ELA
@@ -0,0 +1,49 @@
+ 

+TEXT VAR name := subtext ( std , 1 , length ( std ) - 4 ) ; 

+lastparam ( "" ) ; 

+forget ( name , quiet ) ; 

+new type ( name ) ; 

+ 

+cursor logic ( 0 , ""6"" , "" , "" ) ; 

+ 

+enter outcode ( 15 , 0, ""15" " ) ; 

+enter outcode ( 14 , 0, ""14" " ) ; 

+

+enter outcode ( 214, 142 ) ; 

+enter outcode ( 215, 153 ) ; 

+enter outcode ( 216, 154 ) ; 

+enter outcode ( 217, 132 ) ; 

+enter outcode ( 218, 148 ) ; 

+enter outcode ( 219, 129 ) ; 

+enter outcode ( 220, 0, ""15""107""14"");  (* druck k *)

+enter outcode ( 221, 0, ""15""45""14"");   (* druck - *)

+enter outcode ( 222, 0, ""15""35""14"");   (* druck # *)

+enter outcode ( 223, 0, ""15""32""14"");   (* druck   *)

+enter outcode ( 251, 225);                 (* ß *) 

+ 

+enter incode ( 214, ""142"" ) ;   (* Ä         *) 

+enter incode ( 215, ""153"" ) ;   (* Ö         *) 

+enter incode ( 216, ""154"" ) ;   (* Ü         *) 

+enter incode ( 217, ""132"" ) ;   (* ä         *) 

+enter incode ( 218, ""148"" ) ;   (* ö         *) 

+enter incode ( 219, ""129"" ) ;   (* ü         *) 

+enter incode ( 251, ""225"" ) ;   (* ß         *) 

+enter incode (  64, ""21""  ) ;   (* ⁿ         *) 

+enter incode (  96, ""36""  ) ;   (* `         *)

+ 

+enter incode (  1, ""199"" ) ;    (* hop       *) 

+enter incode (  2, ""205"" ) ;    (* right     *) 

+enter incode (  3, ""200"" ) ;    (* up        *) 

+enter incode (  7, ""187"" ) ;    (* SV -> F1  *) 

+enter incode (  7, ""2""   ) ;    (* SV        *) 

+enter incode (  8, ""203"" ) ;    (* left      *) 

+enter incode (  9, ""143"" ) ;    (* tab       *) 

+enter incode ( 10, ""208"" ) ;    (* down      *) 

+enter incode ( 11, ""210"" ) ;    (* rubin     *) 

+enter incode ( 12, ""211"" ) ;    (* rubout    *) 

+enter incode ( 16, ""198"" ) ;    (* mark      *) 

+enter incode ( 17, ""1""   ) ;    (* stop      *) 

+enter incode ( 23, ""3""   ) ;    (* start     *) 

+

+enter incode ( 187, ""136"") ;    (* F1        *)

+

diff --git a/system/terminal-codes/unknown/src/TVI.german b/system/terminal-codes/unknown/src/TVI.german
new file mode 100644
index 0000000..c24f063
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TVI.german
@@ -0,0 +1,57 @@
+TEXT VAR  name :="TVI.german"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0");

+enter outcode (15,0,""27"G4");

+ 

+enter outcode ( 91,0,"<");

+enter outcode ( 92,0,"/");

+enter outcode ( 93,0,">");

+enter outcode (123,0,"(");

+enter outcode (124,0,"!");

+enter outcode (125,0,")");

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,126);

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""22"");

+enter incode ( 8,""8"");

+enter incode (11,""27"Q");enter incode (11,""26"");

+enter incode (12,""27"W");enter incode (12,""127"");

+enter incode (16,""16"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

diff --git a/system/terminal-codes/unknown/src/TVI914.ascii b/system/terminal-codes/unknown/src/TVI914.ascii
new file mode 100644
index 0000000..4909462
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TVI914.ascii
@@ -0,0 +1,43 @@
+TEXT VAR  name :="TVI914.ascii"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0 ");

+enter outcode (15,0,""27"G4 ");

+ 

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,"A");

+enter outcode (215,"O");

+enter outcode (216,"U");

+enter outcode (217,"a");

+enter outcode (218,"o");

+enter outcode (219,"u");

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,"B");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""22"");

+enter incode ( 8,""8"");

+enter incode (11,""27"Q");enter incode (11,""26"");

+enter incode (12,""27"W");enter incode (12,""127"");

+enter incode (16,""23"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

diff --git a/system/terminal-codes/unknown/src/VC404.ascii b/system/terminal-codes/unknown/src/VC404.ascii
new file mode 100644
index 0000000..614e26d
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.ascii
@@ -0,0 +1,61 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.ascii"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode (214, "A");                        (* �                     *)

+enter outcode (215, "O");                        (* �                     *)

+enter outcode (216, "U");                        (* �                     *)

+enter outcode (217, "a");                        (* �                     *)

+enter outcode (218, "o");                        (* �                     *)

+enter outcode (219, "u");                        (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251, "B");                        (* �                     *)

diff --git a/system/terminal-codes/unknown/src/VC404.german b/system/terminal-codes/unknown/src/VC404.german
new file mode 100644
index 0000000..4c00a44
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.german
@@ -0,0 +1,75 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.german"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode (214, ""091"");                     (* Ä                     *)

+enter incode (215, ""092"");                     (* Ö                     *)

+enter incode (216, ""093"");                     (* Ü                     *)

+enter incode (217, ""123"");                     (* ä                     *)

+enter incode (218, ""124"");                     (* ö                     *)

+enter incode (219, ""125"");                     (* ü                     *)

+enter incode (251, ""064"");                     (* ß                     *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode ( 91, "(");                        (* [                     *)

+enter outcode ( 92, "/");                        (* \                     *)

+enter outcode ( 93, ")");                        (* ]                     *)

+enter outcode (123, "<");                        (* geschw. Klammer auf   *)

+enter outcode (124, "!");                        (* |                     *)

+enter outcode (125, ">");                        (* geschw. Klammer zu    *)

+enter outcode (214,  91);                        (* Ä                     *)

+enter outcode (215,  92);                        (* Ö                     *)

+enter outcode (216,  93);                        (* Ü                     *)

+enter outcode (217, 123);                        (* ä                     *)

+enter outcode (218, 124);                        (* ö                     *)

+enter outcode (219, 125);                        (* ü                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251,  64);                        (* ß                     *)

diff --git a/system/terminal-codes/unknown/src/VC404.hrz b/system/terminal-codes/unknown/src/VC404.hrz
new file mode 100644
index 0000000..ede1743
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.hrz
@@ -0,0 +1,67 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.hrz"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+enter outcode ( 91, "(");                        (* [                     *)

+enter outcode ( 92, "/");                        (* \                     *)

+enter outcode ( 93, ")");                        (* ]                     *)

+enter outcode (123, "<");                        (* geschw. Klammer auf   *)

+enter outcode (124, "!");                        (* |                     *)

+enter outcode (125, ">");                        (* geschw. Klammer zu    *)

+enter outcode (214,  91);                        (* Ä                     *)

+enter outcode (215,  92);                        (* Ö                     *)

+enter outcode (216,  93);                        (* Ü                     *)

+enter outcode (217, 123);                        (* ä                     *)

+enter outcode (218, 124);                        (* ö                     *)

+enter outcode (219, 125);                        (* ü                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251,  64);                        (* ß                     *)

+ 

diff --git a/system/terminal-codes/unknown/src/VIDEOSTAR b/system/terminal-codes/unknown/src/VIDEOSTAR
new file mode 100644
index 0000000..bead5b9
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VIDEOSTAR
@@ -0,0 +1,52 @@
+# 

+      VIDEOSTAR CONFIGURATIONS-PROGRAMM,  VERSION 25.06.1985 

+       Terminal = REGENT40 Emulation, deutscher Zeichensatz 

+#

+TEXT VAR  name :="VIDEOSTAR"; 

+forget(name, quiet);

+new type (name);

+cursor logic  (32,""27"Y","","");

+enter outcode (1  ,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,0,""27"k");

+enter outcode (14,0,""27"0@ ");     (* invers video ein = begin mark*) 

+enter outcode (15,0,""27"0P ");     (* invers video aus = end mark*) 

+ 

+enter outcode (220,"k");            (* Trenn-k *) 

+enter outcode (221,"-");            (* Trenn-  *) 

+enter outcode (222,"#"); 

+enter outcode (223,"_");

+enter outcode (140,""12"");         (* Clear fuer Graphik *) 

+ 

+enter outcode (214, 0,  ""27"9B"91""27"9A");   (* ASCII Klammern *)

+enter outcode (215, 0,  ""27"9B"92""27"9A"); 

+enter outcode (216, 0,  ""27"9B"93""27"9A"); 

+enter outcode (217, 0, ""27"9B"123""27"9A"); 

+enter outcode (218, 0, ""27"9B"124""27"9A"); 

+enter outcode (219, 0, ""27"9B"125""27"9A"); 

+enter outcode (251, 0, ""27"9B"126""27"9A"); 

+ 

+enter incode (1  ,""30"");     (* hop *)

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" );    (* backspace *)

+enter incode (4,""4"");        (* info   *) 

+enter incode (7,""2"");        (* sv     *)

+enter incode (17,""1"");       (* stop   *) 

+enter incode (23,""3"");       (* weiter *)

+enter incode (18, ""27"M");    (*  Insert Line *)

+enter incode (11,""25"");      (* rubin  *) 

+enter incode (12,""127"");     (* rubout *) 

+enter incode (16,""12"") ;     (* mark   *)

+ 

+ 

+enter incode (214,""91"");     (* Umlaute *)

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123""); 

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+

diff --git a/system/terminal-codes/unknown/src/basis108(ascii) b/system/terminal-codes/unknown/src/basis108(ascii)
new file mode 100644
index 0000000..8df50f2
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(ascii)
@@ -0,0 +1,90 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : ASCII    *) 

+                                      (* Zeichensatz: ASCII    *) 

+                                      (* Stand      : 28.04.86 *) 

+ 

+forget  ("basis108(ascii)", quiet) ; 

+new type ("basis108(ascii)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (214, 0, ""15"A"14"") ; 

+enter outcode (215, 0, ""15"O"14"") ; 

+enter outcode (216, 0, ""15"U"14"") ; 

+enter outcode (217, 0, ""15"a"14"") ; 

+enter outcode (218, 0, ""15"o"14"") ; 

+enter outcode (219, 0, ""15"u"14"") ; 

+enter outcode (251, 0, ""15"B"14"") ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode( 4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = � *) 

+                              (* SHIFT F6 = � 

+Andere incodes schon Hardware-   SHIFT F7 = � 

+m��ig implementiert:             SHIFT F8 = � 

+                                 SHIFT F9 = � 

+                                 SHIFT F10= � 

+                                 SHIFT F11= � 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Gesch�tztes Fis   ( # ) 

+                                 SHIFT F15= Gesch�tztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

diff --git a/system/terminal-codes/unknown/src/basis108(deutsch) b/system/terminal-codes/unknown/src/basis108(deutsch)
new file mode 100644
index 0000000..d2125a6
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(deutsch)
@@ -0,0 +1,106 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Deutsch  *) 

+                                      (* Stand      : 28.04.86 *) 

+ 

+forget  ("basis108(deutsch)", quiet) ; 

+new type ("basis108(deutsch)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214,  91) ; 

+enter outcode (215,  92) ; 

+enter outcode (216,  93) ; 

+enter outcode (217, 123) ; 

+enter outcode (218, 124) ; 

+enter outcode (219, 125) ; 

+enter outcode (251, 126) ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode( 4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ; 

diff --git a/system/terminal-codes/unknown/src/basis108(info) b/system/terminal-codes/unknown/src/basis108(info)
new file mode 100644
index 0000000..421c803
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(info)
@@ -0,0 +1,107 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Deutsch  *) 

+                                      (* Stand      : 19.06.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+                                      (* Ohne sz auf SHIFT F5  *) 

+ 

+forget  ("basis108(info)", quiet) ; 

+new type ("basis108(info)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214,  91) ; 

+enter outcode (215,  92) ; 

+enter outcode (216,  93) ; 

+enter outcode (217, 123) ; 

+enter outcode (218, 124) ; 

+enter outcode (219, 125) ; 

+enter outcode (251, 126) ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = � 

+Andere incodes schon Hardware-   SHIFT F7 = � 

+m��ig implementiert:             SHIFT F8 = � 

+                                 SHIFT F9 = � 

+                                 SHIFT F10= � 

+                                 SHIFT F11= � 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Gesch�tztes Fis   ( # ) 

+                                 SHIFT F15= Gesch�tztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ; 

diff --git a/system/terminal-codes/unknown/src/ws580 b/system/terminal-codes/unknown/src/ws580
new file mode 100644
index 0000000..a2e341b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ws580
@@ -0,0 +1,62 @@
+TEXT VAR  name :="ws580"; 

+command dialogue (FALSE); forget (name); 

+new type (name);

+cursor logic (32,""27"Y","","");

+ 

+enter incode (   2,  ""6"");                 (* rechts *)

+enter incode (   3,  ""26"");                (* oben   *)

+enter incode (   7,  ""2"");                 (* sv     *)

+enter incode (   8,  ""21"");                (* links  *)

+enter incode (  11,  ""94"");                (* rubin  *) 

+enter incode (  12,  ""8"");                 (* rubout *)

+enter incode (  16,  ""96"");                (* mark   *)

+enter incode (  23,  ""19"");                (* weiter *)

+ 

+enter incode ( 214, ""91"");                 (*  Ä  *) 

+enter incode ( 215, ""92"");                 (*  Ö  *) 

+enter incode ( 216, ""93"");                 (*  Ü  *) 

+enter incode ( 217, ""123"");                (*  ä  *) 

+enter incode ( 218, ""124"");                (*  ö  *) 

+enter incode ( 219, ""125"");                (*  ü  *) 

+enter incode ( 251, ""126"");                (*  ß  *) 

+ 

+enter outcode (  1, 0, ""27"Y  ");           (* home   *)

+enter outcode (  2, 0, ""6"");               (* rechts *) 

+enter outcode (  3, 0, ""26"");              (* oben   *) 

+enter outcode (  4, 0, ""27"k");             (* cleop  *) 

+enter outcode (  5, 0, ""27"K");             (* cleoln *) 

+enter outcode ( 14, 0, ""47"");              (* endmrk *) 

+enter outcode ( 15, 0, ""47"");              (* mark   *) 

+ 

+clear all 8 bit chars; 

+ 

+enter outcode ( 91, "(");          (*   [   *)

+enter outcode ( 92, "!");          (*   \   *)

+enter outcode ( 93, ")");          (*   ]   *)

+enter outcode (123, "(");          (*       *)

+enter outcode (124, "!");          (*   |   *)

+enter outcode (125, ")");          (*       *)

+enter outcode (126, "-");          (*   ~   *) 

+ 

+enter outcode (214, ""91"");       (*   Ä   *)

+enter outcode (215, ""92"");       (*   Ü   *)

+enter outcode (216, ""93"");       (*   Ö   *)

+enter outcode (217, ""123"");      (*   ä   *)

+enter outcode (218, ""124"");      (*   ü   *)

+enter outcode (219, ""125"");      (*   ö   *)

+enter outcode (251, ""126"");      (*   ß   *) 

+ 

+enter outcode (220, "k");          (* trenn k *) 

+enter outcode (221, "-");          (* trenn - *)

+enter outcode (222, "#");          (* kdo   # *) 

+enter outcode (223, " ");          (* trenn   *)

+ 

+command dialogue (TRUE). 

+ 

+ 

+clear all 8 bit chars : 

+  INT VAR i; 

+ 

+  FOR i FROM 128 UPTO 255 REP 

+    enter outcode (i, " "); 

+  PER.

diff --git a/tools/highlight.py b/tools/highlight.py
new file mode 100755
index 0000000..224d2d9
--- /dev/null
+++ b/tools/highlight.py
@@ -0,0 +1,56 @@
+#!/usr/bin/env python3
+# vim: set fileencoding=utf8 :
+
+"""
+Highlight elan source file
+"""
+
+if __name__ == '__main__':
+    import sys, os, shutil
+    from pygments import highlight
+    from pygments.lexers import get_lexer_by_name
+    from pygments.formatters import HtmlFormatter
+    from jinja2 import Template
+
+    tpl = Template("""<!DOCTYPE html>
+    <html lang="en">
+    <head>
+      <meta charset="utf-8">
+      <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes">
+      <link rel="stylesheet" href="/style.min.css" type="text/css" />
+      <title>{{ path }}</title>
+      <style>
+      body {
+            max-width: none;
+      }
+      </style>
+    </head>
+    <body>
+    <h1>{{ path }}</h1>
+    <p><a href="{{ rawfile }}">Raw file</a><br><a href="{{ index }}">Back to index</a></p>
+    {{ code|safe }}
+    </body></html>""")
+
+    destdir = '_build'
+    f = sys.argv[1]
+
+    basedir = os.path.dirname (f)
+    basedestdir = os.path.join (destdir, basedir)
+    os.makedirs (basedestdir, exist_ok=True)
+    shutil.copy (f, os.path.join (destdir, f))
+    destf = os.path.join (destdir, f + '.html')
+
+    try:
+        with open (f, 'r') as srcfd:
+            code = srcfd.read ()
+    except UnicodeDecodeError as e:
+        # that’s expected for data files
+        print ('skipping', f, e)
+        sys.exit (0)
+
+    print (f)
+    lexer = get_lexer_by_name("elan", stripall=True)
+    formatter = HtmlFormatter (linenos=True, lineanchors='line', anchorlinenos=True)
+    with open (destf, 'w') as destfd:
+        tpl.stream(code=highlight(code, lexer, formatter), path=f, rawfile=os.path.basename (f), index=os.path.relpath ('.', os.path.dirname (f))).dump (destfd)
+
diff --git a/tools/makeindex.py b/tools/makeindex.py
new file mode 100755
index 0000000..76816b2
--- /dev/null
+++ b/tools/makeindex.py
@@ -0,0 +1,53 @@
+#!/usr/bin/env python3
+# vim: set fileencoding=utf8 :
+
+"""
+Create package index
+"""
+
+if __name__ == '__main__':
+    import os
+    from operator import itemgetter
+    from itertools import groupby
+    from yarl import URL
+
+    pkgs = {}
+
+    for dirpath, dirnames, filenames in os.walk ('.'):
+        dirs = dirpath.split (os.sep)
+        if len (dirs) < 4:
+            continue
+
+        cat = dirs[1]
+        if cat not in {'app', 'devel', 'doc', 'lang', 'system'}:
+            continue
+        pkg = dirs[2]
+        ver = dirs[3]
+
+        i = (cat, pkg, ver)
+        pkgs.setdefault (i, [])
+
+        for f in filenames:
+            # not highlighting anything else currently (doc for example)
+            if dirs[-1] == 'src':
+                pkgs[i].append (os.path.join (*dirs[4:], f))
+
+    for cat, pkgs in groupby (sorted (pkgs.items(), key=itemgetter(0)), key=lambda x: x[0][0]):
+        print (f'{cat}\n{"^"*len(cat)}\n')
+        for (cat, pkg, ver), files in pkgs:
+            heading = f'{pkg}-{ver}'
+            print (f'\n{heading}\n{"*"*len(heading)}\n')
+            disklist = os.path.join (cat, pkg, ver, 'source-disk')
+            if os.path.exists (disklist):
+                with open (disklist) as fd:
+                    diskfiles = [x.strip() for x in fd.readlines ()]
+                    assert all (map (lambda x: os.path.isfile (os.path.join ('..', 'disks', x)), diskfiles)), diskfiles
+                    disks = map (lambda x: URL('../disks/' + x.split('/')[0] + '.zip'), diskfiles)
+                print ('Source disk: ')
+                print (',\n'.join (map (lambda x: f'`{x[0]} <{x[1].raw_path}>`__', enumerate (disks, 1))))
+                print ('')
+            for f in sorted (files, key=lambda x: x.lower()):
+                u = URL (f'{cat}/{pkg}/{ver}/{f}.html')
+                print (f'- `{f} <{u.raw_path}>`__')
+        print ('')
+
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
deleted file mode 100644
index 0ac3237..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
+++ /dev/null
@@ -1,204 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 0                    ** 
-         **                                                      ** 
-         **    Anpassung für Kartenleser an  AKTRONIC-Adapter    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 0  DEFINES                       
-       interface anpassung,
-       oeffne interface,
-       schliesse interface,
-       wert von interface,
-       pressed key,
-(* --------------------------- *)
-       kanalkoppler,
-       interfacechannel,
-       init interfacechannel:
-TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";
-LET  max channel = 24,
-     initcode    = 26,
-     endcode     = 27,
-     read code   = 28;
-INT CONST  nicht initialisiert code :: -3,
-           interface error code     :: -4,
-
-           kanal besetzt code       :: -5;
-INT  VAR  interfacekanal  :: 0;
-TEXT VAR  puffer          :: "";
-TASK VAR  hardwaremanager :: niltask,
-          interface task  :: niltask,
-          absender;
-DATASPACE VAR  ds :: nilspace;
-INT PROC interfacechannel:
-  interfacekanal
-END PROC interfacechannel;
-PROC oeffne interface (INT VAR status):
-  puffer := "";
-  forget (ds); ds := nilspace;
-  pingpong (interfacetask, init code, ds, status);
-  IF status > 0 THEN status DECR maxint FI;
-
-  forget (ds); ds := nilspace
-END PROC oeffne interface;
-INT PROC wert von interface:
-  INT VAR wert;
-  puffer CAT incharety (1);
-  call (interface task, read code, ds, wert);
-  wert.
-END PROC wert von interface;
-PROC schliesse interface:
-  forget (ds); ds := nilspace;
-  send (interface task, end code, ds);
-  forget (ds); ds := nilspace
-END PROC schliesse interface;
-TEXT PROC pressed key:
-  IF puffer = ""
-     THEN incharety
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
-  IF puffer = ""
-     THEN incharety (warten)
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-(*************************************************************************)
-PROC kanalkoppler:
-  enable stop;
-  IF name (myself) <> "-"
-
-     THEN errorstop ("Unzulässiges Kommando!")
-     ELSE warte auf anrufe
-  FI.
-  warte auf anrufe:
-    INT VAR codenummer, antwort;
-    disable stop;
-    REP wait (ds, codenummer, absender);
-        reagiere auf anruf;
-        loesche ggf fehlerzustand
-    PER.
-  reagiere auf anruf:
-    IF codenummer = initcode
-       THEN kopple an interface;
-            IF interface ist betriebsbereit
-               THEN bearbeite weitere auftraege
-               ELSE gib negative rueckmeldung
-
-            FI;
-            gib kanal frei
-       ELSE send (absender, nicht initialisiert code, ds)
-    FI.
-  loesche ggf fehlerzustand:
-    IF is error
-       THEN clear error
-    FI.
- kopple an interface:
-  IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself
-     THEN antwort := kanal besetzt code;
-     ELSE continue (interfacekanal);
-          teste interface
-  FI.
- teste interface:
-  leere puffer;
-  out (""240"");
-  IF incharety (1) <> ""
-     THEN antwort := 0;
-
-          out (""176"")
-     ELSE antwort := interface error code
-  FI.
-  leere puffer:
-    REP  UNTIL incharety = "" PER.
- interface ist betriebsbereit:  antwort = 0.
- gib negative rueckmeldung:     send (absender, antwort, ds).
- gib kanal frei:                break (quiet).
- ende:                          out (""176"").
- bearbeite weitere auftraege:
-   REP   pingpong (absender, antwort, ds, codenummer);
-         IF   codenummer = read code
-              THEN hole wert von interface
-
-         ELIF codenummer < 0
-              THEN send (absender, codenummer, ds);
-                   codenummer := endcode
-              ELSE antwort := 0
-         FI
-   UNTIL codenummer = endcode PER;
-   ende.
- hole wert von interface:
-    out (""211"");
-    antwort := code (incharety (1)).
-END PROC kanalkoppler;
-PROC init interfacechannel:
-  teste auf zulaessigkeit;
-  loesche interfacetask;
-  erfrage interface kanal;
-  generiere ggf neue interfacetask.
- teste auf zulaessigkeit:
-
-  enable stop;
-  IF hardwaremanager <> niltask AND hardwaremanager <> myself
-     THEN errorstop ("Dieses Kommando kann nur von der Task '" +
-                      name (hardwaremanager) + "' aus gegeben werden!")
-     ELSE hardwaremanager := myself
-  FI.
- loesche interfacetask:
-  disable stop;
-  end (interfacetask);
-  IF is error THEN clear error FI;
-  enable stop.
- generiere ggf neue interfacetask:
-  IF interface kanal = 0
-     THEN interface task  := niltask;
-          hardwaremanager := niltask
-
-     ELSE begin (PROC kanalkoppler, interface task);
-          hardwaremanager := myself
-  FI.
- erfrage interfacekanal:
-   INT VAR kanalnummer;
-   put ("Gib Interface - Kanal:");
-   get (kanalnummer);
-   set interfacechannel (kanalnummer).
-END PROC init interfacechannel;
-PROC set interface channel (INT CONST channel number):
-  IF channel number < 0 OR channel number > max channel
-     THEN errorstop ("Unzulässige Kanalnummer")
-     ELSE interfacekanal := channel number
-  FI
-END PROC set interface channel;
-
-BOOL OP <> (TASK CONST t1, t2):
-  NOT (t1 = t2)
-END OP <>;
-init interfacechannel
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
deleted file mode 100644
index 0098901..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
+++ /dev/null
@@ -1,211 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 0                    ** 
-         **                                                      ** 
-         **    Anpassung für Kartenleser an MUFI als Endgerät    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 0  DEFINES                       
-       interface anpassung,
-       oeffne interface,
-       schliesse interface,
-       wert von interface,
-       pressed key,
-(* --------------------------- *)
-       kanalkoppler,
-       interfacechannel,
-       init interfacechannel:
-TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";
-LET  mufikennung = ""27""27"",
-     max channel = 24,
-     initcode    = 26,
-     endcode     = 27,
-     read code   = 28;
-INT CONST  nicht initialisiert code :: -3,
-           interface error code     :: -4,
-
-           kanal besetzt code       :: -5;
-INT  VAR  interfacekanal  :: 2;
-TEXT VAR  puffer          :: "";
-TASK VAR  hardwaremanager :: niltask,
-          interface task  :: niltask,
-          absender;
-DATASPACE VAR  ds :: nilspace;
-INT PROC interfacechannel:
-  interfacekanal
-END PROC interfacechannel;
-PROC oeffne interface (INT VAR status):
-  puffer := "";
-  forget (ds); ds := nilspace;
-  pingpong (interfacetask, init code, ds, status);
-  IF status > 0 THEN status DECR maxint FI;
-
-  forget (ds); ds := nilspace
-END PROC oeffne interface;
-INT PROC wert von interface:
-  INT VAR wert;
-  puffer CAT incharety (1);
-  call (interface task, read code, ds, wert);
-  wert.
-END PROC wert von interface;
-PROC schliesse interface:
-  forget (ds); ds := nilspace;
-  send (interface task, end code, ds);
-  forget (ds); ds := nilspace
-END PROC schliesse interface;
-TEXT PROC pressed key:
-  IF puffer = ""
-     THEN incharety
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
-  IF puffer = ""
-     THEN incharety (warten)
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-(*************************************************************************)
-PROC kanalkoppler:
-  enable stop;
-  IF name (myself) <> "-"
-
-     THEN errorstop ("Unzulässiges Kommando!")
-     ELSE warte auf anrufe
-  FI.
-  warte auf anrufe:
-    INT VAR codenummer, antwort;
-    disable stop;
-    REP wait (ds, codenummer, absender);
-        reagiere auf anruf;
-        loesche ggf fehlerzustand
-    PER.
-  reagiere auf anruf:
-    IF codenummer = initcode
-       THEN kopple an interface;
-            IF interface ist betriebsbereit
-               THEN bearbeite weitere auftraege
-               ELSE gib negative rueckmeldung
-
-            FI;
-            gib kanal frei
-       ELSE send (absender, nicht initialisiert code, ds)
-    FI.
-  loesche ggf fehlerzustand:
-    IF is error
-       THEN clear error
-    FI.
- kopple an interface:
-  IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself
-     THEN antwort := kanal besetzt code;
-     ELSE continue (interfacekanal);
-          teste interface
-  FI.
- teste interface:
-  leere puffer;
-  out (mufikennung + "10");
-  fange status;
-  IF status = mufikennung + "00"
-
-     THEN antwort := 0;
-          out (mufikennung + "1A18"22"")
-     ELSE antwort := interface error code
-  FI.
-  leere puffer:
-    REP  UNTIL incharety = "" PER.
-  fange status:
-    INT  VAR zaehler;
-    TEXT VAR status :: "";
-    FOR zaehler FROM 1 UPTO 4 REP
-      status CAT incharety (1)
-    PER.
- interface ist betriebsbereit:  antwort = 0.
- gib negative rueckmeldung:     send (absender, antwort, ds).
- gib kanal frei:                break (quiet).
- ende:                          out (""25"").
-
- bearbeite weitere auftraege:
-   REP   pingpong (absender, antwort, ds, codenummer);
-         IF   codenummer = read code
-              THEN hole wert von interface
-         ELIF codenummer < 0
-              THEN send (absender, codenummer, ds);
-                   codenummer := endcode
-              ELSE antwort := 0
-         FI
-   UNTIL codenummer = endcode PER;
-   ende.
- hole wert von interface:
-    out (""76"");
-    antwort := code (incharety (1)).
-END PROC kanalkoppler;
-PROC init interfacechannel:
-
-  teste auf zulaessigkeit;
-  loesche interfacetask;
-  erfrage interface kanal;
-  generiere ggf neue interfacetask.
- teste auf zulaessigkeit:
-  enable stop;
-  IF hardwaremanager <> niltask AND hardwaremanager <> myself
-     THEN errorstop ("Dieses Kommando kann nur von der Task '" +
-                      name (hardwaremanager) + "' aus gegeben werden!")
-  FI.
- loesche interfacetask:
-  disable stop;
-  end (interfacetask);
-  IF is error THEN clear error FI;
-  enable stop.
- generiere ggf neue interfacetask:
-
-  IF interface kanal = 0
-     THEN interface task  := niltask;
-          hardwaremanager := niltask
-     ELSE begin (PROC kanalkoppler, interface task);
-          hardwaremanager := myself
-  FI.
- erfrage interfacekanal:
-   INT VAR kanalnummer;
-   put ("Gib Interface - Kanal:");
-   get (kanalnummer);
-   set interfacechannel (kanalnummer).
-END PROC init interfacechannel;
-PROC set interface channel (INT CONST channel number):
-  IF channel number < 0 OR channel number > max channel
-     THEN errorstop ("Unzulässige Kanalnummer!")
-
-     ELSE interface kanal := channel number
-  FI
-END PROC set interface channel;
-BOOL OP <> (TASK CONST t1, t2):
-  NOT (t1 = t2)
-END OP <>;
-init interfacechannel
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
deleted file mode 100644
index 54bb73e..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
+++ /dev/null
@@ -1,109 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 0                    ** 
-         **                                                      ** 
-         **  Anpassung für Kartenleser an MUFI im Terminalkanal  ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 0  DEFINES                     
-       interface anpassung,
-       oeffne interface,
-       schliesse interface,
-       wert von interface,
-       pressed key:
-TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";
-LET  mufikennung = ""31""31"";
-INT  CONST interface error code :: -4;
-TEXT CONST readcode :: mufikennung + "4C";
-TEXT VAR   puffer   :: "";
-PROC oeffne interface (INT VAR status):
-  cursor (2,24);
-  warte etwas;
-  leere eingangspuffer;
-  out (""27""27"10");
-  fange antwort;
-  IF antwort = ""27""27"00"
-
-     THEN status := 0;
-          out (""27""27"1C" + hex (mufikennung))
-     ELSE status := interface error code
-  FI.
-  warte etwas:
-    pause (1); pause (1); pause (1); pause (1); pause (1).
-  leere eingangspuffer:
-    puffer := "";
-    REP UNTIL incharety = "" PER.
-  fange antwort:
-    TEXT VAR antwort :: incharety (1);
-    INT VAR i;
-    FOR i FROM 1 UPTO 3 REP
-      antwort CAT incharety (1)
-    PER.
-END PROC oeffne interface;
-INT PROC wert von interface:
-  puffer CAT incharety (1);
-
-  out (readcode);
-  fange mufikennung;
-  dezimalwert (incharety (1), incharety (1)).
-  fange mufikennung:
-    REP puffer CAT incharety
-    UNTIL pos (puffer, mufikennung) > 0 PER;
-    change (puffer, mufikennung, "").
-END PROC wert von interface;
-PROC schliesse interface:
-  cursor (2,24);
-  out (mufikennung + "1C" + hex (""27""27""))
-END PROC schliesse interface;
-TEXT PROC pressed key:
-  IF puffer = ""
-     THEN incharety
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
-  IF puffer = ""
-     THEN incharety (warten)
-     ELSE erstes pufferzeichen
-  FI.
-  erstes pufferzeichen:
-    TEXT VAR zeichen :: puffer SUB 1;
-    puffer := subtext (puffer, 2);
-    zeichen.
-END PROC pressed key;
-INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):
-  16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).
-
-  hexzeichen: "123456789ABCDEF".
-END PROC dezimalwert;
-TEXT PROC hex (TEXT CONST zwei zeichen):
-  hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2))
-END PROC hex;
-TEXT PROC hex (INT CONST wert):
-  (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).
-  hexzeichen: "0123456789ABCDEF".
-END PROC hex
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 1 b/warenhaus/ls-Warenhaus 1
deleted file mode 100644
index c3976b4..0000000
--- a/warenhaus/ls-Warenhaus 1
+++ /dev/null
@@ -1,235 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 1                    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET monitor alt DEFINES original monitor:          
-  PROC original monitor:
-    monitor
-  END PROC originalmonitor
-END PACKET monitor alt;
-PACKET ls warenhaus 1 DEFINES
-       zentrale,
-       monitor,
-       warenhaus direktstart,
-       warenhaus hauptstelle,
-       hauptstellenname:
-LET  max kundenzahl             =  31,
-     min kundennummer           = 129,
-     kundendatei holen code     = 100,
-     kundendatei ergaenzen code = 200;
-TYPE KUNDENDATEN   = STRUCT (TEXT nachname, vorname, geschlecht),
-     KUNDENDATEI   = ROW max kundenzahl KUNDENDATEN;
-
-
-BOUND KUNDENDATEN VAR kundendaten;
-BOUND KUNDENDATEI VAR bound kundendatei;
-KUNDENDATEI VAR kundendatei;
-DATASPACE   VAR ds;
-TASK        VAR absender,
-                zentraltask        :: niltask,
-                hauptstelle        :: niltask,
-                direktstartmanager :: niltask;
-BOOL        VAR mit direktstart    :: FALSE,
-                mit loeschen       :: FALSE;
-INT         VAR codenummer;
-PROC zentrale:
-  enable stop;
-  IF pos (name (myself), ".Zentrale") = 0
-     THEN errorstop ("Unzulaessiger Befehl!")
-
-
-  FI;
-  disable stop;
-  REP wait (ds, codenummer, absender);
-      bearbeite auftrag;
-      send (absender, codenummer, ds);
-      IF is error THEN clear error FI
-  PER.
-  bearbeite auftrag:
-    IF   codenummer = kundendatei holen code
-         THEN hole kundendatei
-    ELIF codenummer = kundendatei ergaenzen code
-         THEN ergaenze kundendatei
-    ELIF codenummer >= min kundennummer
-         THEN lies kundendaten
-         ELSE speichere kundendaten
-    FI.
-END PROC zentrale;
-
-
-PROC hole kundendatei:
-  bound kundendatei := ds;
-  bound kundendatei := kundendatei
-END PROC hole kundendatei;
-PROC ergaenze kundendatei:
-  INT VAR kundennummer;
-  bound kundendatei := ds;
-  FOR kundennummer FROM 1 UPTO max kundenzahl REP
-    IF kundendatei [kundennummer].nachname = ""
-       THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]
-    FI
-  PER;
-  init ds
-END PROC ergaenze kundendatei;
-PROC lies kundendaten:
-  kundendaten := ds;
-  kundendaten := kundendatei [platznummer].
-
-
-  platznummer: codenummer - min kundennummer + 1.
-END PROC lies kundendaten;
-PROC speichere kundendaten:
-  kundendaten := ds;
-  kundendatei [codenummer] := kundendaten;
-  init ds
-END PROC speichere kundendaten;
-PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):
-  enable stop;
-  IF task soll hauptstelle sein
-     THEN mache task zur hauptstelle
-     ELSE mache hauptstellenstatus rueckgaengig
-  FI.
-  mache task zur hauptstelle:
-    sei eine hauptstelle;
-    line (2);
-
-
-    IF NOT mit direktstart CAND yes ("Mit Direktstart")
-       THEN warenhaus direktstart (TRUE)
-       ELSE global manager
-    FI
-END PROC warenhaus hauptstelle;
-PROC sei eine hauptstelle:
-  IF NOT (hauptstelle = niltask OR hauptstelle = myself)
-     THEN errorstop ("Hauptstelle ist bereits die Task '" +
-                      name (hauptstelle) + "'!")
-  FI;
-  disable stop;
-  end (zentraltask);
-  IF is error THEN clear error FI;
-  enable stop;
-  hauptstelle := niltask;
-  begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);
-
-
-  hauptstelle := myself
-END PROC sei eine hauptstelle;
-PROC mache hauptstellenstatus rueckgaengig:
-  IF NOT (hauptstelle = niltask OR hauptstelle = myself)
-     THEN errorstop ("Dieses Kommando darf nur in der Task '" +
-                      name (hauptstelle) + " gegeben werden!")
-  FI;
-  disable stop;
-  end (zentraltask);
-  IF is error THEN clear error FI;
-  enable stop;
-  hauptstelle := niltask;
-  warenhaus direktstart (FALSE)
-END PROC mache hauptstellenstatus rueckgaengig;
-PROC warenhaus direktstart (BOOL CONST wahl):
-
-
-  pruefe zulaessigkeit;
-  mit direktstart := wahl;
-  IF mit direktstart
-     THEN direktstartmanager := myself;
-          mit loeschen := yes ("Mit automatischem Löschen")
-     ELSE direktstartmanager := niltask
-  FI;
-  global manager.
-  pruefe zulaessigkeit:
-    enable stop;
-    IF NOT (direktstartmanager = niltask OR direktstartmanager = myself)
-       THEN errorstop ("Der Direktstart kann nur aus der Task '" +
-                        name (direktstartmanager) + "'geaendert werden!")
-
-
-    FI.
-END PROC warenhaus direktstart;
-TEXT PROC hauptstellenname:
-  name (hauptstelle)
-END PROC hauptstellenname;
-PROC monitor:
-  IF mit direktstart
-     THEN warenhaus monitor
-     ELSE original  monitor
-  FI
-END PROC monitor;
-PROC warenhausmonitor:
-  disable stop;
-  INT VAR previous heapsize := heap size;
-  REP command dialogue (TRUE);
-      sysin (""); sysout ("");
-      cry if not enough storage;
-      reset dialog; erase menunotice;
-      do ("warenhaus");
-      IF is error
-
-
-         THEN clear error
-         ELSE sitzungsende
-      FI
-  PER.
-  sitzungsende:
-    collect heap garbage if necessary;
-    page;
-    IF mit loeschen
-       THEN break; end (myself)
-       ELSE end; break
-    FI.
-  collect heap garbage if necessary:
-    IF heap size > previous heapsize + 10
-       THEN collect heap garbage;
-            previous heapsize := heap size
-    FI.
-  cry if not enough storage:
-    INT VAR size, used;
-    storage (size, used);
-    IF used > size
-       THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"")
-
-
-    FI.
-END PROC warenhausmonitor;
-OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):
-   CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):
-   CONCR (ziel) := CONCR (quelle)
-END OP :=;
-PROC init ds:
-  forget (ds); ds := nilspace
-END PROC init ds;
-PROC initialisiere kundendatei:
-  KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");
-  INT VAR nr;
-  FOR nr FROM 1 UPTO max kundenzahl REP
-      kundendatei [nr] := leer
-  PER
-END PROC initialisiere kundendatei;
-
-
-initialisiere kundendatei
-END PACKET ls warenhaus 1
-
-
-
diff --git a/warenhaus/ls-Warenhaus 2 b/warenhaus/ls-Warenhaus 2
deleted file mode 100644
index f7a9945..0000000
--- a/warenhaus/ls-Warenhaus 2
+++ /dev/null
@@ -1,1257 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 2                    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 2 DEFINES                        
-       max artikelzahl,
-       max kundenzahl,
-       min kundennummer,
-       max kundennummer,
-       min artikelnummer,
-       max artikelnummer,
-       filialverwaltung,
-       initialisiere verwaltung,
-       hole artikeldaten,
-       speichere artikeldaten,
-       registriere verkauf,
-       hole kundendaten,
-       speichere kundendaten,
-       sichere filialdaten,
-       lade filialdaten,
-       hole bestelliste,
-       hole auskunft ein:
-LET  max filialen  =  10,
-     max artikel   =  15,
-
-     max kunden    =  31,
-     min kundennr  = 129,
-     max kundennr  = 159,
-     min artikelnr =   1,
-     max artikelnr =  15;
-LET  zentrale kundendatei holen code     = 100,
-     zentrale kundendatei ergaenzen code = 200,
-     filialdaten holen code              = 201,
-     filialdaten ergaenzen code          = 202;
-INT CONST max artikelzahl   :: max artikel,
-          max kundenzahl    :: max kunden,
-          min kundennummer  :: min kundennr,
-          max kundennummer  :: max kundennr,
-
-          min artikelnummer :: min artikelnr,
-          max artikelnummer :: max artikelnr;
-TYPE ARTIKELDATEN  = STRUCT (TEXT artikelname, REAL preis,
-                             INT  mindestbestand, bestand),
-     KUNDENDATEN   = STRUCT (TEXT nachname, vorname, geschlecht),
-     WARENDATEI    = ROW max artikel ARTIKELDATEN,
-     KUNDENDATEI   = ROW max kunden  KUNDENDATEN,
-     EINKAUFSDATEI = ROW max kunden  ROW max artikel INT,
-     VERKAUFSDATEI = ROW max artikel INT,
-     FILIALDATEN   = STRUCT (WARENDATEI waren, KUNDENDATEI kunden,
-
-                             EINKAUFSDATEI einkaeufe,
-                             VERKAUFSDATEI hitliste);
-KUNDENDATEI   VAR kunde;
-WARENDATEI    VAR artikel;
-EINKAUFSDATEI VAR einkaufsdatei;
-VERKAUFSDATEI VAR verkaufszahl;
-DATASPACE     VAR ds;
-INT           VAR codenummer, reply code;
-TASK          VAR zentrale, verwaltung, absender;
-TEXT          VAR hauptstelle  :: "",
-                  filialnummer :: "0",
-                  filialverwaltungsname :: "";
-PROC filialverwaltung:
-  enable stop;
-
-  IF pos (name (myself), ".Filialverwaltung") = 0
-     THEN errorstop ("Unzulaessiger Befehl!")
-  FI;
-  disable stop;
-  REP wait (ds, codenummer, absender);
-      bearbeite auftrag;
-      send (absender, 0, ds);
-      IF is error THEN clear error FI
-  PER.
-  bearbeite auftrag:
-    IF   codenummer <= max artikel
-         THEN artikeldaten speichern
-    ELIF codenummer <= max kundennr
-         THEN kauf registrieren
-    ELIF codenummer <= max kundennr + max kunden
-         THEN kundendaten speichern
-
-    ELIF codenummer = filialdaten holen code
-         THEN filialdaten holen
-    ELIF codenummer = filialdaten ergaenzen code
-         THEN filialdaten ergaenzen; init ds
-    ELIF codenummer = 256
-         THEN sperre task
-    FI.
-    sperre task:
-      call (absender, 256, ds, codenummer).
-END PROC filialverwaltung;
-PROC artikeldaten speichern:
-  BOUND ARTIKELDATEN VAR artikeldaten :: ds;
-  artikel [codenummer] := artikeldaten;
-  init ds
-END PROC artikeldaten speichern;
-PROC kauf registrieren:
-
-  artikelnummer aus ds lesen;
-  artikel [artikelnummer].bestand DECR 1;
-  verkaufszahl [artikelnummer] INCR 1;
-  IF kundennummer > 0
-     THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1
-  FI.
-  artikelnummer aus ds lesen:
-    BOUND INT VAR nummer    :: ds;
-    INT CONST artikelnummer :: nummer,
-              kundennummer  :: codenummer - min kundennr + 1;
-    init ds
-END PROC kauf registrieren;
-PROC kundendaten speichern:
-  BOUND KUNDENDATEN VAR kundendaten :: ds;
-  kunde [codenummer - min kundennr - max kunden + 1] := kundendaten
-
-END PROC kundendaten speichern;
-PROC filialdaten holen:
-  init ds;
-  BOUND FILIALDATEN VAR filialdaten :: ds;
-  CONCR (filialdaten.waren)     := CONCR (artikel);
-  CONCR (filialdaten.kunden)    := CONCR (kunde);
-  CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei);
-  CONCR (filialdaten.hitliste)  := CONCR (verkaufszahl)
-END PROC filialdaten holen;
-PROC filialdaten ergaenzen:
-  BOUND FILIALDATEN VAR neue daten :: ds;
-  INT VAR kundennummer, artikelnummer;
-  ergaenze artikeldatei und verkaufszahlen;
-
-  ergaenze kundendatei;
-  ergaenze einkaufsdatei.
-  ergaenze artikeldatei und verkaufszahlen:
-    FOR artikelnummer FROM 1 UPTO max artikel REP
-      verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer];
-      IF artikel [artikelnummer].artikelname = ""
-         THEN artikel [artikelnummer] := neue daten.waren [artikelnummer]
-      FI
-    PER.
-  ergaenze kundendatei:
-    FOR kundennummer FROM 1 UPTO max kunden REP
-        IF kunde [kundennummer].nachname = ""
-           THEN kunde [kundennummer] := neue daten.kunden [kundennummer]
-
-        FI
-    PER.
-  ergaenze einkaufsdatei:
-    FOR kundennummer FROM 1 UPTO max kunden REP
-      FOR artikelnummer FROM 1 UPTO max artikel REP
-        einkaufsdatei [kundennummer][artikelnummer]
-          INCR neue daten.einkaeufe [kundennummer][artikelnummer]
-      PER
-    PER.
-END PROC filialdaten ergaenzen;
-OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):
-  CONCR (ziel) := CONCR (quelle)
-
-END OP :=;
-PROC init ds:
-  forget (ds); ds := nilspace
-END PROC init ds;
-(************************************************************************)
-PROC initialisiere verwaltung:
-  hauptstelle := hauptstellenname;
-  zentrale := task (hauptstelle + ".Zentrale");
-  filialnummer := text (channel (myself));
-  filialverwaltungsname := hauptstellenname + ".Filialverwaltung ";
-  begin (filialverwaltungsname + filialnummer,
-         PROC filialverwaltung, verwaltung)
-END PROC initialisiere verwaltung;
-
-PROC hole artikeldaten (INT  CONST artikelnummer,
-                        TEXT VAR name,  REAL VAR preis,
-                        INT  VAR mindestbestand, bestand):
-  enable stop;
-  pruefe artikelnummer;
-  hole daten.
-  pruefe artikelnummer:
-    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
-    IF artikelindex < 1  OR  artikelindex > max artikel
-       THEN errorstop ("Unzulässige Artikelnummer!")
-    FI.
-  hole daten:
-    name           := artikel [artikelindex].artikelname;
-
-    preis          := artikel [artikelindex].preis;
-    mindestbestand := artikel [artikelindex].mindestbestand;
-    bestand        := artikel [artikelindex].bestand.
-END PROC hole artikeldaten;
-PROC speichere artikeldaten (INT  CONST artikelnummer,
-                             TEXT CONST name, REAL CONST preis,
-                             INT  CONST mindestbestand, bestand):
-  enable stop;
-  pruefe artikelnummer;
-  speichere daten;
-  schicke kopie an verwaltung.
-  pruefe artikelnummer:
-
-    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
-    IF artikelindex < 1  OR  artikelindex > max artikel
-       THEN errorstop ("Unzulässige Artikelnummer!")
-    FI.
-  speichere daten:
-    artikel [artikelindex].artikelname   := name;
-    artikel [artikelindex].preis         := preis;
-    artikel [artikelindex].mindestbestand:= mindestbestand;
-    artikel [artikelindex].bestand       := bestand.
-  schicke kopie an verwaltung:
-    init ds;
-    BOUND ARTIKELDATEN VAR artikeldaten :: ds;
-
-    artikeldaten := artikel [artikelindex];
-    call (verwaltung, artikelindex, ds, reply code).
-END PROC speichere artikeldaten;
-PROC registriere verkauf (INT CONST kundennummer, artikelnummer):
-  enable stop;
-  pruefe daten;
-  speichere daten;
-  schicke kopie zur verwaltung.
-  pruefe daten:
-    INT VAR kundenindex  :: kundennummer  - min kundennr  + 1,
-            artikelindex :: artikelnummer - min artikelnr + 1;
-    IF   kundenindex < 0  OR  kundenindex > max kunden
-         THEN errorstop ("Unzulässige Kundennummer!")
-
-    ELIF artikelindex < 1  OR  artikelindex > max artikel
-         THEN errorstop ("Unzulässige Artikelnummer!")
-    FI.
-  speichere daten:
-    IF artikel [artikelindex].bestand > 0
-       THEN artikel [artikelindex].bestand DECR 1;
-            verkaufszahl [artikelindex] INCR 1;
-            IF kundenindex > 0
-               THEN trage evtl in einkaufsdatei ein
-    FI      FI.
-  trage evtl in einkaufsdatei ein:
-    IF kunde [kundenindex].nachname = ""
-       THEN kundenindex := 0
-       ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1
-
-    FI.
-  schicke kopie zur verwaltung:
-    init ds;
-    BOUND INT VAR nummer :: ds;
-    nummer := artikelindex;
-    call (verwaltung, kundenindex + min kundennr - 1, ds, reply code).
-END PROC registriere verkauf;
-PROC hole kundendaten (INT  CONST kundennummer,
-                       TEXT VAR   nachname, vorname, geschlecht):
-  enable stop;
-  pruefe kundennummer;
-  rufe zentrale an;
-  uebergib die zentraldaten;
-  IF aenderungen vorhanden
-     THEN aktualisiere filialdaten
-  FI;
-  forget (ds).
-
-  pruefe kundennummer:
-    INT CONST index :: kundennummer - min kundennr + 1;
-    IF index < 1  OR  index > max kunden
-       THEN errorstop ("Unzulässige Kundennummer!")
-    FI.
-  rufe zentrale an:
-    init ds;
-    call (zentrale, kundennummer, ds, reply code).
-  aenderungen vorhanden:
-    (kunde [index].nachname   <> nachname  ) OR
-    (kunde [index].vorname    <> vorname   ) OR
-    (kunde [index].geschlecht <> geschlecht).
-  aktualisiere filialdaten:
-    kunde [index] := daten von zentrale;
-
-    call (verwaltung, kundennummer + max kunden, ds, reply code).
-  uebergib die zentraldaten:
-    BOUND KUNDENDATEN VAR daten von zentrale :: ds;
-    nachname    := daten von zentrale.nachname;
-    vorname     := daten von zentrale.vorname;
-    geschlecht  := daten von zentrale.geschlecht.
-END PROC hole kundendaten;
-PROC speichere kundendaten(INT  CONST kundennummer,
-                           TEXT CONST nachname, vorname, geschlecht):
-  enable stop;
-  pruefe kundennummer;
-  IF kundendaten geaendert
-
-     THEN speichere daten;
-          schicke kopie an verwaltung und zentrale
-  FI.
-  pruefe kundennummer:
-    IF kundennummer < min kundennr  OR  kundennummer > max kundennr
-       THEN errorstop ("Unzulässige Kundennummer!")
-    FI.
-  kundendaten geaendert:
-    INT CONST index :: kundennummer - min kundennr + 1;
-    nachname    <> kunde [index].nachname    OR
-    vorname     <> kunde [index].vorname     OR
-    geschlecht  <> kunde [index].geschlecht.
-  speichere daten:
-    kunde [index].nachname    := nachname;
-
-    kunde [index].vorname     := vorname;
-    kunde [index].geschlecht  := geschlecht.
-  schicke kopie an verwaltung und zentrale:
-    init ds;
-    BOUND KUNDENDATEN VAR kundendaten :: ds;
-    kundendaten := kunde [index];
-    call (verwaltung, kundennummer + max kunden, ds, reply code);
-    call (zentrale, kundennummer - min kundennr + 1, ds, reply code);
-    forget (ds).
-END PROC speichere kundendaten;
-PROC sichere filialdaten (TEXT CONST name):
-  enable stop;
-  filialdaten holen;
-
-  type (ds, 1951);
-  forget (name, quiet);
-  copy (ds, name);
-  forget (ds)
-END PROC sichere filialdaten;
-PROC lade filialdaten (TEXT CONST name):
-  enable stop;
-  forget (ds);
-  ds := old (name);
-  IF type (ds) = 1951
-     THEN filialdaten ergaenzen;
-          kopie an verwaltung schicken;
-          kopie der kundendatei an zentrale schicken
-     ELSE errorstop ("'" + name + "' enthält keine Filialdaten!")
-  FI.
-  kopie an verwaltung schicken:
-    call (verwaltung, filialdaten ergaenzen code, ds, reply code).
-
-  kopie der kundendatei an zentrale schicken:
-    BOUND KUNDENDATEI VAR kundendatei :: ds;
-    CONCR (CONCR (kundendatei)) := CONCR (kunde);
-    call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code).
-END PROC lade filialdaten;
-PROC hole bestelliste (FILE VAR f):
-  bereite datei vor;
-  schreibe daten in datei.
-  bereite datei vor:
-    forget("Nachbestellung",quiet);
-    f := sequential file (output, "Nachbestellung");
-    line  (f);
-    write (f, "        Nachbestellungen für " +
-
-                       invers ("Filiale " + filialnummer)+":");
-    line;
-    write (f, "        ==================================================");
-    line  (f, 2);
-    write (f, "        |  Art.Nr. | Artikelname             |   Anzahl  |");
-    line  (f);
-    write (f, "        +----------+-------------------------+-----------+");
-    line  (f).
-  schreibe daten in datei:
-    INT VAR artikelnummer;
-    FOR artikelnummer FROM 1 UPTO max artikel REP
-        IF artikel[artikelnummer].bestand
-
-           < artikel[artikelnummer].mindestbestand
-           THEN bestelle artikel nach
-        FI
-    PER;
-    write (f, "        +----------+-------------------------+-----------+");
-    line  (f).
-   bestelle artikel nach:
-    write (f, "        |  " + wirkliche artikelnummer + "   | "
-              + text (artikel [artikelnummer].artikelname, 23) + " |  "
-              + text (nachzubestellende anzahl, 6) + "   |");
-    line  (f);
-    artikel [artikelnummer].bestand
-                           := 2 * artikel [artikelnummer].mindestbestand.
-
-    wirkliche artikelnummer:
-      text (artikelnummer + min artikelnr - 1, 5).
-    nachzubestellende anzahl:
-      2 * artikel [artikelnummer].mindestbestand
-                                  - artikel [artikelnummer].bestand.
-END PROC hole bestelliste;
-PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer,
-                        FILE  VAR f):
-  enable stop;
-  hauptstelle := hauptstellenname;
-  SELECT codenummer OF CASE 66 : hitliste von zentrale (f)
-                       CASE 67 : hitliste von filiale (f)
-
-                       CASE 68 : hitlisten aller filialen (f)
-                    (* --------------------------------------------- *)
-                       CASE 73 : artikelkaeuferliste von zentrale
-                                   (artikel oder kundennummer, f)
-                       CASE 74 : artikelkaeuferliste von filiale
-                                   (artikel oder kundennummer, f)
-                       CASE 75 : artikelkaeuferlisten aller filialen
-                                   (artikel oder kundennummer, f)
-
-                    (* --------------------------------------------- *)
-                       CASE 77 : kundenliste von zentrale (f)
-                       CASE 78 : kundenliste von filiale (f)
-                       CASE 79 : kundenlisten aller filialen (f)
-                    (* --------------------------------------------- *)
-                       CASE 84 : kundeneinkaufsliste von zentrale
-                                   (artikel oder kundennummer, f)
-                       CASE 85 : kundeneinkaufsliste von filiale
-
-                                   (artikel oder kundennummer, f)
-                       CASE 86 : kundeneinkaufslisten aller filialen
-                                   (artikel oder kundennummer, f)
-                    (* --------------------------------------------- *)
-                       CASE 89 : lageruebersicht von zentrale (f)
-                       CASE 90 : lageruebersicht von filiale (f)
-                       CASE 91 : lageruebersichten aller filialen (f)
-                    (* --------------------------------------------- *)
-
-  OTHERWISE  errorstop ("Unzulässige Code - Nummer bei Auskunft!")
-  END SELECT
-END PROC hole auskunft ein;
-PROC hitliste von zentrale (FILE VAR f):
-  INT VAR filialnr;
-  beginne mit eigener filiale;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF filialnr <> int (filialnummer) CAND
-       exists task (aktuelle verwaltung)
-       THEN hole daten dieser filiale;
-            schreibe daten in zentralliste
-
-    FI
-  PER;
-  werte zentralliste aus.
-  beginne mit eigener filiale:
-    WARENDATEI VAR zentrale warendatei;
-    CONCR (zentrale warendatei) := CONCR (artikel);
-    VERKAUFSDATEI VAR zentrale verkaufsdatei;
-    CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl).
-   hole daten dieser filiale:
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-     BOUND FILIALDATEN VAR aktuelle daten :: ds.
-   schreibe daten in zentralliste:
-     INT VAR i;
-
-     FOR i FROM 1 UPTO max artikel REP
-       IF zentrale warendatei [i].artikelname = ""
-          THEN zentrale warendatei [i] := aktuelle daten.waren [i]
-       FI;
-       zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i]
-     PER.
-  werte zentralliste aus:
-    forget (ds);
-    forget ("Auskunft: Zentrale", quiet);
-    f := sequential file (output, "Auskunft: Zentrale");
-    line  (f);
-    write (f, "   Zentrale Warenliste, geordnet nach Verkaufszahlen:");
-    sortiere (zentrale warendatei, zentrale verkaufsdatei);
-
-    fuelle (f, zentrale warendatei, zentrale verkaufsdatei).
-END PROC hitliste von zentrale;
-PROC hitliste von filiale (FILE VAR f):
-  bereite auskunftsdatei vor;
-  kopiere artikeldatei und verkaufsdatei;
-  sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen);
-  fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen).
-  kopiere artikeldatei und verkaufsdatei:
-    WARENDATEI VAR hilfsdatei artikel;
-    CONCR (hilfsdatei artikel) := CONCR (artikel);
-    VERKAUFSDATEI VAR hilfsdatei verkaufszahlen;
-
-    CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl).
-  bereite auskunftsdatei vor:
-    forget ("Auskunft: Filiale " + filialnummer, quiet);
-    f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-    line  (f);
-    write (f, "   Warenliste, geordnet nach Verkaufszahlen:").
-END PROC hitliste von filiale;
-PROC hitlisten aller filialen (FILE VAR f):
-  WARENDATEI    VAR aktuelle warendatei;
-  VERKAUFSDATEI VAR aktuelle verkaufsdatei;
-  INT           VAR filialnr;
-
-  bereite auskunftsdatei vor;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF   filialnr = int (filialnummer)
-         THEN nimm eigene daten
-    ELIF exists task (aktuelle verwaltung)
-    THEN hole daten dieser filiale;
-         arbeite mit diesen daten
-    FI
-  PER;
-  forget (ds).
-  bereite auskunftsdatei vor:
-    forget ("Auskunft: Alle Filialen", quiet);
-    f := sequential file (output, "Auskunft: Alle Filialen");
-
-    line  (f).
-  nimm eigene daten:
-    CONCR (aktuelle warendatei) := CONCR (artikel);
-    CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl);
-    sortiere und fuelle.
-  sortiere und fuelle:
-    write (f, "   Warenliste von " + invers ("Filiale " + text (filialnr))
-            + ", geordnet nach Verkaufszahlen:");
-    sortiere (aktuelle warendatei, aktuelle verkaufsdatei);
-    fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei).
-   hole daten dieser filiale:
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-
-     BOUND FILIALDATEN VAR aktuelle daten :: ds.
-   arbeite mit diesen daten:
-    CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren);
-    CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste);
-    sortiere und fuelle.
-END PROC hitlisten aller filialen;
-PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl):
-  INT VAR i,j;
-  FOR i FROM 1 UPTO max artikel - 1 REP
-    FOR j FROM i + 1 UPTO max artikel REP
-      IF stueckzahl [i] < stueckzahl [j]
-         THEN vertausche
-
-      FI
-  PER PER.
-  vertausche:
-    INT CONST hilfsint :: stueckzahl [i];
-    ARTIKELDATEN CONST hilfsartikel :: warendatei [i];
-    stueckzahl [i] := stueckzahl [j];
-    warendatei [i] := warendatei [j];
-    stueckzahl [j] := hilfsint;
-    warendatei [j] := hilfsartikel.
-END PROC sortiere;
-PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl):
-  INT VAR nummer, platz :: 0;
-  bereite datei vor;
-  schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f,"   ============================================================");
-
- line (f,2);
- write(f,"   | Platz | Verk.Anzahl | Artikelname            |   Preis   |");
- line (f);
- write(f,"   +-------+-------------+------------------------+-----------+");
- line (f).
-schreibe daten in datei:
- FOR nummer FROM 1 UPTO max artikel REP
-     IF warendat [nummer].artikelname <> ""
-        THEN schreibe in datei; line (f)
-     FI
- PER;
- write(f,"   +-------+-------------+------------------------+-----------+");
- line (f,3).
-schreibe in datei:
-  platz INCR 1;
-  write (f, "   |" + text (platz, 5) + "  |"
-
-                   + text (anzahl [nummer], 9) + "    | "
-                   + text (warendat [nummer].artikelname, 22) + " | "
-                   + text (warendat [nummer].preis,8,2) + "  |").
-END PROC fuelle;
-PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f):
-  INT VAR filialnr;
-  pruefe artikelnummer;
-  beginne mit eigener filiale;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-
-    IF filialnr <> int (filialnummer) CAND
-       exists task (aktuelle verwaltung)
-       THEN hole daten dieser filiale;
-            schreibe daten in zentralliste
-    FI
-  PER;
-  werte zentralliste aus.
-  pruefe artikelnummer:
-    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
-    IF artikelindex < 1  OR  artikelindex > max artikel
-       THEN errorstop ("Unzulässige Artikelnummer!")
-    FI.
-  beginne mit eigener filiale:
-    TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname;
-
-    KUNDENDATEI VAR hilfsdatei;
-    CONCR (hilfsdatei) := CONCR (kunde);
-    ROW max kunden INT VAR kaeufe;
-    INT VAR i;
-    FOR i FROM 1 UPTO max kunden REP
-        kaeufe [i] := einkaufsdatei [i][artikelindex]
-    PER.
-   hole daten dieser filiale:
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
-   schreibe daten in zentralliste:
-     BOUND FILIALDATEN VAR aktuelle daten :: ds;
-     IF aktueller artikelname = ""
-        THEN aktueller artikelname
-
-             := aktuelle daten.waren [artikelindex].artikelname
-     FI;
-     FOR i FROM 1 UPTO max kunden REP
-       kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex];
-       IF hilfsdatei [i].nachname = ""
-          THEN hilfsdatei [i] := aktuelle daten.kunden [i]
-       FI
-     PER.
-  werte zentralliste aus:
-    forget (ds);
-    forget ("Auskunft: Zentrale", quiet);
-    f := sequential file (output, "Auskunft: Zentrale");
-    line (f);
-    IF aktueller artikelname = ""
-       THEN write (f, "   Der Artikel Nr. " + text (artikelindex)
-
-                      +  " wird in keiner Filiale geführt.");
-            line (f);
-            write(f,
-        "   ============================================================");
-            line (f,3);
-       ELSE write (f, "   Gesamtkäuferliste des Artikels "
-                       +  invers (aktueller artikelname) + ":");
-            fuelle (f, hilfsdatei, kaeufe)
-    FI.
-END PROC artikelkaeuferliste von zentrale;
-PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f):
-
-  pruefe artikelnummer;
-  kopiere einkaufszahlen in hilfsliste;
-  erstelle filialliste.
-  pruefe artikelnummer:
-    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
-    IF artikelindex < 1  OR  artikelindex > max artikel
-       THEN errorstop ("Unzulässige Artikelnummer!")
-    FI.
-  kopiere einkaufszahlen in hilfsliste:
-    ROW max kunden INT VAR kaeufe;
-    INT VAR i;
-    FOR i FROM 1 UPTO max kunden REP
-        kaeufe [i] := einkaufsdatei [i][artikelindex]
-    PER.
-  erstelle filialliste:
-
-    forget ("Auskunft: Filiale " + filialnummer, quiet);
-    f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-    line (f);
-    IF artikel [artikelindex].artikelname = ""
-       THEN write (f, "   Der Artikel Nr. " + text (artikelindex)
-                   +  " wird in dieser Filiale nicht geführt.");
-            line (f);
-            write(f,
-        "   ============================================================");
-            line (f,3);
-       ELSE write (f, "   Käufer des Artikels "
-
-                   +  invers (artikel [artikelindex].artikelname)
-                   +  ":");
-            fuelle (f, kunde, kaeufe)
-    FI.
-END PROC artikelkaeuferliste von filiale;
-PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f):
-  INT VAR i, filialnr;
-  ROW max kunden INT VAR kaeufe;
-  pruefe artikelnummer;
-  bereite datei vor;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-
-    IF   filialnr = int (filialnummer)
-         THEN kopiere eigene einkaufszahlen in hilfsliste;
-              schreibe eigene daten in auskunftsdatei
-    ELIF exists task (aktuelle verwaltung)
-         THEN hole daten dieser filiale;
-              schreibe daten in auskunftsdatei
-    FI
-  PER;
-  forget (ds).
-  pruefe artikelnummer:
-    INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
-    IF artikelindex < 1  OR  artikelindex > max artikel
-       THEN errorstop ("Unzulässige Artikelnummer!")
-
-    FI.
-  bereite datei vor:
-    forget ("Auskunft: Alle Filialen", quiet);
-    f := sequential file (output, "Auskunft: Alle Filialen");
-    line (f).
-  kopiere eigene einkaufszahlen in hilfsliste:
-    FOR i FROM 1 UPTO max kunden REP
-        kaeufe [i] := einkaufsdatei [i][artikelindex]
-    PER.
-  schreibe eigene daten in auskunftsdatei:
-    IF artikel [artikelindex].artikelname = ""
-       THEN write (f, "   Der Artikel Nr. " + text (artikelindex)
-                   +  " wird in "
-
-                   +    invers ("Filiale " + filialnummer)
-                   +  " nicht geführt.");
-            line (f);
-            write(f,
-        "   ============================================================");
-            line (f,3)
-       ELSE write (f, "   Käufer des Artikels '"
-                   +  artikel [artikelindex].artikelname
-                   +  "' in " + invers ("Filiale " + filialnummer) + ":");
-            fuelle(f, kunde, kaeufe)
-    FI.
-   hole daten dieser filiale:
-
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-     BOUND FILIALDATEN VAR aktuelle daten :: ds;
-     TEXT CONST aktueller artikelname
-                := aktuelle daten.waren [artikelindex].artikelname
-     FOR i FROM 1 UPTO max kunden REP
-       kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex];
-     PER.
-  schreibe daten in auskunftsdatei:
-    IF aktueller artikelname = ""
-       THEN write (f, "   Der Artikel Nr. " + text (artikelindex)
-
-                   +  " wird in "
-                   +    invers ("Filiale " + text (filialnr))
-                   +  " nicht geführt.");
-            line (f);
-            write(f,
-        "   ============================================================");
-            line (f,3)
-       ELSE write (f, "   Käufer des Artikels '"
-                   +  aktueller artikelname
-                   +  "' in " + invers ("Filiale " + text(filialnr)) + ":");
-            fuelle(f, aktuelle daten.kunden, kaeufe)
-
-    FI.
-END PROC artikelkaeuferlisten aller filialen;
-PROC fuelle (FILE VAR f, KUNDENDATEI CONST  kundenliste,
-                         ROW max kunden INT CONST einkaufszahlen):
-  INT VAR kundennummer;
-  bereite datei vor;
-  schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f,"   ============================================================");
- line (f, 2);
- write(f,"   | Anzahl | Nachname,         Vorname          | Geschlecht |");
- line (f);
- write(f,"   +--------+------------------------------------+------------+");
-
- line (f).
-schreibe daten in datei:
- FOR kundennummer FROM 1 UPTO max kunden REP
-     IF  einkaufszahlen [kundennummer] > 0
-         THEN schreibe in  datei; line (f);
-     FI
- PER;
- write(f,"   +--------+------------------------------------+------------+");
- line (f, 3).
-schreibe in datei:
- write(f,"   |" + text(einkaufszahlen [kundennummer], 5) + "   | "
-                + text(kundenliste [kundennummer].nachname + ",", 17) + " "
-                + text(kundenliste [kundennummer].vorname, 16) + " | ");
-
- IF   kundenliste [kundennummer].geschlecht = "m"
-      THEN write (f, " männlich  |")
- ELIF kundenliste [kundennummer].geschlecht = "w"
-      THEN write (f, " weiblich  |")
-      ELSE write (f, "           |")
- FI.
-END PROC fuelle;
-PROC kundenliste von zentrale (FILE VAR f):
-  hole kundenliste von zentrale;
-  bereite datei vor;
-  schreibe daten in datei.
-  hole kundenliste von zentrale:
-    init ds;
-    call (zentrale, zentrale kundendatei holen code, ds, reply code);
-    BOUND KUNDENDATEI VAR zentrale kundenliste :: ds.
-
-  bereite datei vor:
-   forget ("Auskunft: Zentrale", quiet);
-   f := sequential file (output, "Auskunft: Zentrale");
-   line  (f);
-   write (f, "   Zentrale Kundenliste:").
-  schreibe daten in datei:
-    fuelle (f, zentrale kundenliste);
-    forget (ds).
-END PROC kundenliste von zentrale;
-PROC kundenliste von filiale (FILE VAR f):
-  bereite datei vor;
-  schreibe daten in datei.
-  bereite datei vor:
-    forget ("Auskunft: Filiale " + filialnummer, quiet);
-    f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-
-    line  (f);
-    write (f,"   Kundenliste:").
-  schreibe daten in datei:
-    fuelle (f, kunde).
-END PROC kundenliste von filiale;
-PROC kundenlisten aller filialen (FILE VAR f):
-  INT VAR filialnr;
-  bereite datei vor;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF   filialnr = int (filialnummer)
-         THEN schreibe eigene daten in auskunftsdatei
-    ELIF exists task (aktuelle verwaltung)
-
-         THEN hole daten dieser filiale;
-              schreibe daten dieser filiale in auskunftsdatei
-    FI
-  PER.
-  bereite datei vor:
-    forget ("Auskunft: Alle Filialen", quiet);
-    f := sequential file (output, "Auskunft: Alle Filialen");
-    line (f).
-  schreibe eigene daten in auskunftsdatei:
-    schreibe ueberschrift;
-    fuelle (f, kunde).
-  hole daten dieser filiale:
-    init ds;
-    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-    BOUND FILIALDATEN VAR aktuelle filialdaten :: ds.
-
-  schreibe daten dieser filiale in auskunftsdatei:
-    schreibe ueberschrift;
-    fuelle (f, aktuelle filialdaten.kunden).
-  schreibe ueberschrift:
-   write (f, "   Kundenliste für " +
-                 invers ("Filiale " + text (filialnr)) + ":").
-END PROC kundenlisten aller filialen;
-PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei):
-  INT VAR kundennummer;
-  bereite datei vor;
-  schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f,"   ============================================================");
-
- line (f,2);
- write(f,"   | Kun.Nr.| Nachname,         Vorname          | Geschlecht |");
- line (f);
- write(f,"   +--------+------------------------------------+------------+");
- line (f).
-schreibe daten in datei:
- FOR kundennummer FROM 1 UPTO max kunden REP
-     IF kundendatei [kundennummer].nachname <> ""
-        THEN schreibe in datei; line (f)
-     FI
- PER;
- write(f,"   +--------+------------------------------------+------------+");
- line (f, 3).
-schreibe in datei:
-  write (f, "   |" + text (kundennummer + min kundennummer - 1, 6) + "  | "
-
-            + text (kundendatei [kundennummer].nachname + ",", 17) + " "
-            + text (kundendatei [kundennummer].vorname, 16) + " | ");
-    IF   kundendatei [kundennummer].geschlecht = "m"
-         THEN write (f, " männlich  |")
-    ELIF kundendatei [kundennummer].geschlecht = "w"
-         THEN write (f, " weiblich  |")
-         ELSE write (f, "           |")
-    FI.
-END PROC fuelle;
-PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f):
-  INT VAR filialnr;
-
-  pruefe kundennummer;
-  beginne mit eigener filiale;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF filialnr <> int (filialnummer) CAND
-       exists task (aktuelle verwaltung)
-       THEN hole daten dieser filiale;
-            schreibe daten in zentralliste
-    FI
-  PER;
-  werte zentralliste aus.
-  pruefe kundennummer:
-    INT CONST kundenindex :: kundennummer - min kundennr + 1;
-
-    IF kundenindex < 1  OR  kundenindex > max kunden
-       THEN errorstop ("Unzulässige Kundennummer!")
-    FI.
-  beginne mit eigener filiale:
-    KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex];
-    WARENDATEI VAR hilfsdatei;
-    CONCR (hilfsdatei) := CONCR (artikel);
-    ROW max artikel INT VAR kaeufe;
-    INT VAR i;
-    FOR i FROM 1 UPTO max artikel REP
-        kaeufe [i] := einkaufsdatei [kundenindex][i]
-    PER.
-   hole daten dieser filiale:
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
-
-   schreibe daten in zentralliste:
-     BOUND FILIALDATEN VAR aktuelle daten :: ds;
-     IF aktueller kunde.nachname = ""
-        THEN aktueller kunde := aktuelle daten.kunden [kundenindex]
-     FI;
-     FOR i FROM 1 UPTO max artikel REP
-       kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i];
-       IF hilfsdatei [i].artikelname = ""
-          THEN hilfsdatei [i] := aktuelle daten.waren [i]
-       FI
-     PER.
-  werte zentralliste aus:
-    forget (ds);
-    forget ("Auskunft: Zentrale", quiet);
-
-    f := sequential file (output, "Auskunft: Zentrale");
-    line (f);
-    IF aktueller kunde.nachname = ""
-       THEN write (f, "   Ein Kunde mit Nr. " + text (kundenindex)
-                   +  " ist in keiner Filiale bekannt.");
-            line (f);
-            write(f,
-        "   ============================================================");
-            line (f,3);
-       ELSE write (f, "   Gesamteinkaufsliste " + anrede
-                       +  invers (aktueller kundenname) + ":");
-
-            fuelle (f, hilfsdatei, kaeufe)
-    FI.
-  anrede:
-    IF   aktueller kunde.geschlecht = "m"
-         THEN "des Kunden "
-    ELIF aktueller kunde.geschlecht = "w"
-         THEN "der Kundin "
-         ELSE "von "
-    FI.
-  aktueller kundenname:
-    (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname.
-END PROC kundeneinkaufsliste von zentrale;
-PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f):
-  pruefe kundennummer;
-  erstelle filialliste.
-
-  pruefe kundennummer:
-    INT CONST kundenindex :: kundennummer - min kundennr + 1;
-    IF kundenindex < 1  OR  kundenindex > max kunden
-       THEN errorstop ("Unzulässige Kundennummer!")
-    FI.
-  erstelle filialliste:
-    forget ("Auskunft: Filiale " + filialnummer, quiet);
-    f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-    line (f);
-    IF kunde [kundenindex].nachname = ""
-       THEN schicke leere liste zurueck
-       ELSE schreibe dateikopf;
-            fuelle (f, artikel, einkaufsdatei [kundenindex])
-
-    FI.
-  schicke leere liste zurueck:
-    write (f,"   Ein Kunde mit Nr. " + text (kundennummer) + " ist in "
-           +  "dieser Filiale nicht bekannt.");
-    line  (f);
-    write (f,
-      "   ============================================================");
-    line (f,3).
-  schreibe dateikopf:
-   write (f, "   Einkaufsliste " + anrede +
-                 invers ((kunde [kundenindex].vorname  SUB 1) + ". " +
-                  kunde [kundenindex].nachname) + ":").
-  anrede:
-    IF   kunde [kundenindex].geschlecht = "m"
-
-         THEN "des Kunden "
-    ELIF kunde [kundenindex].geschlecht = "w"
-         THEN "der Kundin "
-         ELSE "von "
-    FI.
-END PROC kundeneinkaufsliste von filiale;
-PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f):
-  INT VAR filialnr;
-  pruefe kundennummer;
-  bereite datei vor;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF   filialnr = int (filialnummer)
-
-         THEN schreibe eigene daten in auskunftsdatei
-    ELIF exists task (aktuelle verwaltung)
-         THEN hole daten dieser filiale;
-              schreibe daten in auskunftsdatei
-    FI
-  PER;
-  forget (ds).
-  pruefe kundennummer:
-    INT CONST kundenindex :: kundennummer - min kundennr + 1;
-    IF kundenindex < 1  OR  kundenindex > max kunden
-       THEN errorstop ("Unzulässige Kundennummer!")
-    FI.
-  bereite datei vor:
-    forget ("Auskunft: Alle Filialen", quiet);
-    f := sequential file (output, "Auskunft: Alle Filialen");
-
-    line (f).
-  schreibe eigene daten in auskunftsdatei:
-    IF kunde [kundenindex].nachname = ""
-       THEN write (f,"   Ein Kunde mit Nr. " + text (kundennummer)
-                   + " ist in " + invers ("Filiale " + filialnummer)
-                   + " nicht bekannt.");
-            line  (f);
-            write(f,
-        "   ============================================================");
-            line (f,3)
-       ELSE write (f, "   Einkaufsliste " + anrede hier +
-                  (kunde [kundenindex].vorname  SUB 1) + ". " +
-
-                   kunde [kundenindex].nachname +
-                  " in " + invers ("Filiale " + filialnummer) + ":");
-            fuelle (f, artikel, einkaufsdatei [kundenindex])
-    FI.
-  anrede hier:
-    IF   kunde [kundenindex].geschlecht = "m"
-         THEN "des Kunden "
-    ELIF kunde [kundenindex].geschlecht = "w"
-         THEN "der Kundin "
-         ELSE "von "
-    FI.
-  hole daten dieser filiale:
-    init ds;
-    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-
-    BOUND FILIALDATEN VAR aktuelle daten :: ds;
-    KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex].
-  schreibe daten in auskunftsdatei:
-    IF aktueller kunde.nachname = ""
-       THEN write (f,"   Ein Kunde mit Nr. " + text (kundennummer)
-                   + " ist in " + invers ("Filiale " + text (filialnr))
-                   + " nicht bekannt.");
-            line  (f);
-            write(f,
-        "   ============================================================");
-
-            line (f,3)
-       ELSE write (f, "   Einkaufsliste " + anrede +
-                  (aktueller kunde.vorname  SUB 1) + ". " +
-                   aktueller kunde.nachname +
-                  " in " + invers ("Filiale " + text (filialnr)) + ":");
-            fuelle (f, aktuelle daten.waren,
-                       aktuelle daten.einkaeufe [kundenindex])
-     FI.
-  anrede:
-    IF   aktueller kunde.geschlecht = "m"
-         THEN "des Kunden "
-    ELIF aktueller kunde.geschlecht = "w"
-
-         THEN "der Kundin "
-         ELSE "von "
-    FI.
-END PROC kundeneinkaufslisten aller filialen;
-PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei,
-             ROW max artikel INT CONST einkaufszahlen):
-  INT VAR  artikelnummer;
-  REAL VAR gesamtpreis, summe :: 0.0;
-  bereite datei vor;
-  schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f,"   ============================================================");
- line (f,2);
- write(f,"   | Art.Nr.| Artikelname       | Anzahl |  Preis  |  Gesamt  |");
-
- line (f);
- write(f,"   +--------+-------------------+--------+---------+----------+");
- line (f).
-schreibe daten in datei:
- FOR artikelnummer FROM 1 UPTO max artikel REP
-     IF einkaufszahlen [artikelnummer] > 0
-        THEN schreibe in datei; line (f)
-     FI
- PER;
- write(f,"   +--------+-------------------+--------+---------+----------+");
- line (f);
- write(f,"                                           Summe:   " +
-                                                     text (summe,8,2));
-
- line (f, 3).
-schreibe in datei:
-  gesamtpreis := real (einkaufszahlen [artikelnummer]) *
-                       warendatei [artikelnummer].preis;
-  summe INCR gesamtpreis;
-  write (f,"   |" + text(artikelnummer,5) + "   | "
-                  + text(warendatei [artikelnummer].artikelname,17) + " |  "
-                  + text(einkaufszahlen [artikelnummer],4) + "  |"
-                  + text(warendatei [artikelnummer].preis,7,2) + "  |"
-                  + text(gesamtpreis,8,2) + "  |").
-
-END PROC fuelle;
-PROC lageruebersicht von zentrale (FILE VAR f):
-  INT VAR filialnr;
-  beginne mit eigener filiale;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF filialnr <> int (filialnummer) CAND
-       exists task (aktuelle verwaltung)
-       THEN hole daten dieser filiale;
-            schreibe daten in zentralliste
-    FI
-  PER;
-  werte zentralliste aus.
-  beginne mit eigener filiale:
-
-    WARENDATEI VAR hilfsdatei;
-    CONCR (hilfsdatei) := CONCR (artikel).
-   hole daten dieser filiale:
-     init ds;
-     call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
-   schreibe daten in zentralliste:
-     BOUND FILIALDATEN VAR aktuelle daten :: ds;
-     INT VAR i;
-     FOR i FROM 1 UPTO max artikel REP
-       IF hilfsdatei [i].artikelname = ""
-          THEN hilfsdatei [i] := aktuelle daten.waren [i]
-          ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand;
-
-               hilfsdatei [i].bestand INCR aktuell.bestand
-       FI
-     PER.
-  aktuell: aktuelle daten.waren [i].
-  werte zentralliste aus:
-    forget (ds);
-    forget ("Auskunft: Zentrale", quiet);
-    f := sequential file (output, "Auskunft: Zentrale");
-    line  (f);
-    write (f, "   Zentrale Lagerübersicht:");
-    fuelle (f, hilfsdatei).
-END PROC lageruebersicht von zentrale;
-PROC lageruebersicht von filiale (FILE VAR f):
-  forget ("Auskunft: Filiale " + filialnummer, quiet);
-
-  f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-  schreibe dateikopf;
-  fuelle (f, artikel).
-  schreibe dateikopf:
-   line  (f);
-   write (f, "   Lagerübersicht:").
-END PROC lageruebersicht von filiale;
-PROC lageruebersichten aller filialen (FILE VAR f):
-  INT VAR filialnr;
-  bereite datei vor;
-  FOR filialnr FROM 1 UPTO max filialen REP
-    TEXT CONST aktuelle verwaltung ::
-               hauptstelle + ".Filialverwaltung " + text (filialnr);
-    IF   filialnr = int (filialnummer)
-
-         THEN schreibe eigene daten in auskunftsdatei
-    ELIF exists task (aktuelle verwaltung)
-         THEN hole daten dieser filiale;
-              schreibe daten in auskunftsdatei
-    FI
-  PER;
-  forget (ds).
-  bereite datei vor:
-    forget ("Auskunft: Alle Filialen", quiet);
-    f := sequential file (output, "Auskunft: Alle Filialen").
-  schreibe eigene daten in auskunftsdatei:
-    line   (f);
-    write  (f, "   Lagerübersicht für " +
-                   invers ("Filiale " + filialnummer) + ":");
-
-    fuelle (f, artikel).
-  hole daten dieser filiale:
-    init ds;
-    call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-    BOUND FILIALDATEN VAR aktuelle daten :: ds.
-  schreibe daten in auskunftsdatei:
-    line   (f);
-    write  (f, "   Lagerübersicht für " +
-                  invers ("Filiale " + text (filialnr)) + ":");
-    fuelle (f, aktuelle daten.waren).
-END PROC lageruebersichten aller filialen;
-PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei):
-  INT VAR artikelnummer;
-
-  bereite datei vor;
-  schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f,"   ============================================================");
- line (f,2);
- write(f,"   | Art.Nr.| Artikelname       |  Preis | Min.Best.| Bestand |");
- line (f);
- write(f,"   +--------+-------------------+--------+----------+---------+");
- line (f).
-schreibe daten in datei:
- FOR artikelnummer FROM 1 UPTO max artikel REP
-     IF warendatei[artikelnummer].artikelname <> ""
-        THEN schreibe in datei; line (f)
-
-     FI
- PER;
- write(f,"   +--------+-------------------+--------+----------+---------+");
- line (f, 3).
-schreibe in datei:
-  write (f, "   |" + text(artikelnummer,5) + "   | "
-                   + text(warendatei[artikelnummer].artikelname,17) + " |"
-                   + text(warendatei[artikelnummer].preis,7,2) + " | "
-                   + text(warendatei[artikelnummer].mindestbestand,6)+"   | "
-                   + text(warendatei[artikelnummer].bestand,6) + "  |").
-END PROC fuelle;
-
-PROC initialisiere dateien:
-  INT VAR kundennummer, artikelnummer;
-  FOR kundennummer FROM 1 UPTO max kunden REP
-      kunde [kundennummer].nachname    := "";
-      kunde [kundennummer].vorname     := "";
-      kunde [kundennummer].geschlecht  := ""
-  PER;
-  FOR artikelnummer FROM 1 UPTO max artikel REP
-      verkaufszahl [artikelnummer]                   :=   0;
-      artikel      [artikelnummer].mindestbestand    :=   0;
-      artikel      [artikelnummer].bestand           :=   0;
-      artikel      [artikelnummer].artikelname       :=  "";
-
-      artikel      [artikelnummer].preis             := 0.0;
-      FOR kundennummer FROM 1 UPTO max kunden REP
-          einkaufsdatei[kundennummer][artikelnummer] :=   0
-      PER;
-  PER
-END PROC initialisiere dateien;
-initialisiere dateien
-END PACKET ls warenhaus 2
-
-
diff --git a/warenhaus/ls-Warenhaus 3 b/warenhaus/ls-Warenhaus 3
deleted file mode 100644
index 71ef216..0000000
--- a/warenhaus/ls-Warenhaus 3
+++ /dev/null
@@ -1,986 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 3                    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 3 DEFINES                        
-       artikelnummer lesen,
-       artikeldaten eingeben,
-       kundennummer lesen,
-       kundendaten eingeben,
-       neues blatt,
-       rechnungskopf,
-       artikel kaufen,
-       abrechnung,
-       nachbestellen,
-       auskunft,
-       stoptaste gedrueckt,
-       stoptaste gedrückt,
-       dezimalwert lesen,
-       bitmuster lesen,
-       bildschirm neu,
-(* ------------------------------ *)
-       tastatureingabe,
-       eingabesicherheit,
-       eingabe mit codekartenleser,
-
-       cursor w3 1 1:
-LET esc            = ""27"",
-    stopzeichen    = "q",
-    abbruchzeichen = "h";
-WINDOW VAR w1  :: window (43,  3, 36, 16),
-           w2  :: window (43, 20, 36,  3),
-           w3k :: window ( 2,  4, 40,  3),
-           w3  :: window ( 2,  7, 40, 16),
-           w4  :: window ( 8,  4, 66, 18);
-BOOL VAR ende gewuenscht              := FALSE,
-         artikelnummer ist eingelesen := FALSE,
-         kundennummer  ist eingelesen := FALSE,
-         codekartenleser aktiviert    := FALSE,
-
-         auf neuem blatt              := TRUE;
-INT  VAR artikelnummer  ::  0,
-         mindestbestand ::  0,
-         bestand        ::  0,
-         kundennummer   ::  0,
-         sicherheit     ::  5;
-TEXT VAR artikelname    :: "",
-         nachname       :: "",
-         vorname        :: "",
-         geschlecht     :: "",
-         ueberschrift   :: "    RECHNUNG",
-         hilfstext, exit char;
-REAL VAR preis          :: 0.0,
-         summe          :: 0.0;
-PROC eingabesicherheit (INT CONST wert):
-
-  sicherheit := abs (wert)
-END PROC eingabesicherheit;
-PROC cursor w3 1 1:
-  cursor (w1,  1, 1);
-  cursor (w2,  1, 1);
-  cursor (w3,  1, 1);
-  cursor (w3k, 1, 1);
-  forget ("WARENHAUS:Rechnung", quiet);
-  setze variable in anfangszustand
-END PROC cursor w3 1 1;
-PROC setze variable in anfangszustand:
-  ende gewuenscht              := FALSE;
-  artikelnummer ist eingelesen := FALSE;
-  kundennummer  ist eingelesen := FALSE;
-  artikelnummer  := 0;
-  mindestbestand := 0;
-  bestand        := 0;
-
-  kundennummer   := 0;
-  artikelname    := "";
-  nachname       := "";
-  vorname        := "";
-  geschlecht     := "";
-  ueberschrift   := "    RECHNUNG";
-  preis          := 0.0;
-  summe          := 0.0
-END PROC setze variable in anfangszustand;
-PROC bildschirm neu:
-     cursor off;
-     pruefe abbruch;
-     cursor (w1, 1, 1);
-     cursor (w2, 1, 1);
-     cursor (w3, 1, 1);
-     cursor (w3k,1, 1);
-     auf neuem blatt := TRUE;
-     page;
-     out ("WARENHAUS:  Info  Eingabeart  Kommandos "15"Programme "14" " +
-
-          "Filialdaten  Archiv"); line;
-     out (ecke oben links + (40 * waagerecht) + balken oben
-                          + (36 * waagerecht) + ecke oben rechts);
-     INT VAR zeile;
-     FOR zeile FROM 3 UPTO 22 REP
-         cursor ( 1, zeile); out (senkrecht);
-         cursor (42, zeile); out (senkrecht);
-         cursor (79, zeile); out (senkrecht)
-     PER;
-     cursor (1, 23);
-     out (ecke unten links + (40 * waagerecht) + balken unten
-                           + (36 * waagerecht) + ecke unten rechts);
-
-     cursor (42, 19);
-     out (balken links + (36 * waagerecht) + balken rechts);
-     cursor (2, 24);
-     out ("Programmabbruch: <ESC><" + abbruchzeichen + ">");
-     cursor on
-END PROC bildschirm neu;
-PROC pruefe abbruch:
-     IF pressed key = esc
-        THEN pruefe weiter
-     FI.
-     pruefe weiter:
-       TEXT VAR naechstes zeichen :: pressed key (20);
-       IF naechstes zeichen = stopzeichen
-          THEN ende gewuenscht := TRUE
-       ELIF naechstes zeichen = abbruch zeichen
-
-          THEN setze variable in anfangszustand;
-               cursor off;
-               errorstop (1951, "Programm - Abbruch durch <ESC><"
-                               + abbruchzeichen + ">")
-     FI
-END PROC pruefe abbruch;
-PROC regeneriere w2:
-     cursor (42, 19);
-     out (ecke oben links + (36 * waagerecht));
-     INT VAR zeile;
-     FOR zeile FROM 20 UPTO 22 REP
-         cursor (42, zeile); out (senkrecht);
-     PER;
-     cursor (42, 23); out (balken unten);
-     page (w2)
-
-END PROC regeneriere w2;
-PROC fenster putzen:
-     page (w1);
-     page (w2)
-END PROC fenster putzen;
-PROC lies nummer ein (INT VAR nummer):
-   line (w2, 2);
-   out  (w2, " Stoptaste: <ESC><" + stopzeichen + ">");
-   hilfstext := text (nummer);
-   REP cursor  (w1, 19, 2);
-       editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,
-                                                       exit char);
-       pruefe exit char;
-       change all (hilfstext, " ", "")
-   UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;
-
-   nummer := int (hilfstext).
-   pruefe exit char:
-     IF exit char = esc + stopzeichen
-        THEN ende gewuenscht := TRUE;
-             cursor off; fenster putzen; cursor on;
-             nummer := 0;
-             LEAVE lies nummer ein
-     ELIF exit char = esc + abbruchzeichen
-        THEN setze variable in anfangszustand;
-             errorstop (1951, "Progamm - Abbruch durch <ESC><"
-                               + abbruchzeichen + ">")
-        ELSE ende gewuenscht := FALSE
-     FI.
-
-END PROC lies nummer ein;
-PROC lies artikelnummer ein:
-     page (w2);
-     cursor (w1, 2, 2);
-     out  (w1, "Artikelnummer  :           ");
-     IF codekartenleser aktiviert
-        THEN artikelnummer := gesicherter wert von interface
-                 (min artikelnummer , max artikelnummer, "Warenkarte")
-        ELSE artikelnummer von tastatur lesen
-     FI;
-     IF ende gewuenscht
-        THEN artikelnummer ist eingelesen := FALSE
-        ELSE artikelnummer ist eingelesen := TRUE
-
-     FI.
-   artikelnummer von tastatur lesen:
-     cursor on;
-     REP out  (w2, " Artikelnummer eingeben");
-         lies nummer ein (artikelnummer);
-     UNTIL ende gewuenscht COR artikelnummer zulaessig PER.
-     artikelnummer zulaessig:
-       IF  (artikelnummer < min artikelnummer OR
-            artikelnummer > max artikelnummer)
-           THEN page (w2); out (""7"");
-                out  (w2, " Unzulässige Artikelnummer!");
-                line (w2, 2);
-                out  (w2, " Bitte irgendeine Taste tippen!");
-
-                pause; page (w2);
-                FALSE
-           ELSE TRUE
-       FI.
-END PROC lies artikelnummer ein;
-PROC artikelnummer lesen:
-  pruefe abbruch;
-  lies artikelnummer ein;
-  IF artikelnummer ist eingelesen
-     THEN hole artikeldaten (artikelnummer, artikelname, preis,
-                             mindestbestand, bestand)
-  FI
-END PROC artikelnummer lesen;
-PROC kundennummer lesen:
-  pruefe abbruch;
-  lies kundennummer ein;
-  IF kundennummer ist eingelesen
-     THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht)
-
-  FI
-END PROC kundennummer lesen;
-PROC lies kundennummer ein:
-  page (w2);
-  cursor (w1, 2, 2);
-  out  (w1, "Kundennummer   :           ");
-  IF codekartenleser aktiviert
-     THEN kundennummer := gesicherter wert von interface
-                       (min kundennummer , max kundennummer, "Kundenkarte")
-     ELSE kundennummer von tastatur lesen
-  FI;
-  IF ende gewuenscht
-     THEN kundennummer ist eingelesen := FALSE
-     ELSE kundennummer ist eingelesen := TRUE
-  FI.
-  kundennummer von tastatur lesen:
-
-    cursor on;
-    REP out  (w2, " Kundennummer eingeben");
-        lies nummer ein (kundennummer)
-    UNTIL ende gewuenscht COR kundennummer zulaessig PER.
-  kundennummer zulaessig:
-    IF  (kundennummer < min kundennummer OR
-         kundennummer > max kundennummer)
-        THEN page (w2); out (""7"");
-             out  (w2, " Unzulässige Kundennummer!");
-             line (w2, 2);
-             out  (w2, " Bitte irgendeine Taste tippen!");
-             pause; page (w2);
-             FALSE
-
-        ELSE TRUE
-    FI.
-END PROC lies kundennummer ein;
-PROC zeige artikeldaten:
-     cursor (w1, 2, 6);
-     out    (w1, "Artikelname    : " + text (artikelname, 16));
-     cursor (w1, 2, 8);
-     out    (w1, "Preis          : " + text preis + "        ");
-     cursor (w1, 2, 10);
-     out    (w1, "Mindestbestand : " + text (mindestbestand) + "    ");
-     cursor (w1, 2, 12);
-     out    (w1, "Bestand        : " + text (bestand) + "    ").
-     text preis:
-       TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);
-
-       change (hilfe, " ", "0");
-       hilfe.
-END PROC zeige artikeldaten;
-PROC zeige kundendaten:
-     cursor (w1, 2, 6);
-     out    (w1, "Nachname       : " + text (nachname, 16));
-     cursor (w1, 2, 8);
-     out    (w1, "Vorname        : " + text (vorname , 16));
-     cursor (w1, 2, 10);
-     out    (w1, "Geschlecht     : " + geschlecht + "          ");
-END PROC zeige kundendaten;
-PROC artikeldaten speichern:
-  pruefe abbruch;
-  page (w2); line (w2);
-  out (w2, " Artikeldaten werden gespeichert") ;
-
-  speichere artikeldaten (artikelnummer, artikelname, preis,
-                          mindestbestand, bestand);
-  pause (10);
-  IF codekartenleser aktiviert
-     THEN lasse karte entfernen (FALSE)
-  FI
-END PROC artikeldaten speichern;
-PROC kundendaten speichern:
-  pruefe abbruch;
-  page (w2); line (w2);
-  out (w2, " Kundendaten werden gespeichert") ;
-  speichere kundendaten (kundennummer, nachname,vorname, geschlecht);
-  pause (10);
-  IF codekartenleser aktiviert
-     THEN lasse karte entfernen (FALSE)
-
-  FI
-END PROC kundendaten speichern;
-BOOL PROC stoptaste gedrueckt:
-  pruefe abbruch;
-  ende gewuenscht
-END PROC stoptaste gedrueckt;
-BOOL PROC stoptaste gedrückt:
-  stoptaste gedrueckt
-END PROC stoptaste gedrückt;
-PROC neues blatt:
-  pruefe abbruch;
-  page (w3k);
-  page (w3);
-  auf neuem blatt := TRUE;
-  forget ("WARENHAUS:Rechnung", quiet)
-END PROC neues blatt;
-PROC nachbestellen:
-  pruefe abbruch;
-  FILE VAR f;
-  warten in w2;
-  hole bestelliste (f);
-  pruefe abbruch;
-  cursor (2,24);
-
-  out ("Weiter mit <ESC><q>;  Cursor bewegen: <Pfeile>");
-  cursor on;
-  show (w4, f);
-  cursor off;
-  cursor (1, 24); out (""5"");
-  WINDOW VAR  w :: window(45,18,25,3);
-  outframe (w);
-  IF yes (w, "Bestelliste drucken", FALSE)
-     THEN drucke (headline (f))
-  FI;
-  cursor on;
-  forget (headline (f), quiet)
-END PROC nachbestellen;
-PROC warten in w2:
-  cursor off;
-  page (w2);
-  line (w2);
-  out (w2, " Bitte warten!");
-  cursor on
-END PROC warten in w2;
-PROC codenummer von tastatur lesen (INT VAR codenummer):
-
-     codenummer := 0;
-     out  (w2, " Codenummer eingeben");
-     cursor on;
-     lies nummer ein (codenummer)
-END PROC codenummer von tastatur lesen;
-PROC auskunft:
-  pruefe abbruch;
-  FILE VAR f;
-  INT VAR codenummer :: 0;
-  cursor (w1, 2, 2);
-  out  (w1, "Codenummer     :            ");
-  page (w2);
-  IF codekartenleser aktiviert
-     THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");
-          lasse karte entfernen (FALSE)
-     ELSE codenummer von tastatur lesen (codenummer)
-
-  FI;
-  IF ende gewuenscht THEN LEAVE auskunft FI;
-  SELECT codenummer OF CASE 66, 67, 68 : hitliste
-                       CASE 73, 74, 75 : kaeuferliste
-                       CASE 77, 78, 79 : kundenliste
-                       CASE 84, 85, 86 : einkaufsliste
-                       CASE 89, 90, 91 : lageruebersicht
-  OTHERWISE teste auf artikel oder kundennummer
-  END SELECT;
-  IF codekartenleser aktiviert CAND wert von interface <> 255
-     THEN karte entfernen
-  FI.
-  karte entfernen:
-
-    SELECT codenummer OF
-      CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,
-           91:  lasse karte entfernen (TRUE)
-      OTHERWISE lasse karte entfernen (FALSE)
-    END SELECT.
-  teste auf artikel oder kundennummer:
-    IF   codenummer >= min artikelnummer AND codenummer <= max artikelnummer
-         THEN gib auskunft ueber artikeldaten
-    ELIF codenummer >= min kundennummer  AND codenummer <= max kundennummer
-         THEN gib auskunft ueber kundendaten
-    ELSE unzulaessige codenummer
-
-    FI.
-  unzulaessige codenummer:
-    out (10 * ""7"");
-    page (w2);
-    out  (w2, " Unzulässige Codenummer !!!");
-    line (w2, 2);
-    out  (w2, " Bitte irgendeine Taste tippen!");
-    pause;
-    page (w2).
-  gib auskunft ueber artikeldaten:
-    hole artikeldaten (codenummer, artikelname, preis,
-                       mindestbestand, bestand);
-    zeige artikeldaten;
-    artikelnummer ist eingelesen := FALSE;
-    stop w2;
-    page (w1).
-  gib auskunft ueber kundendaten:
-    hole kundendaten (codenummer, nachname, vorname, geschlecht);
-
-    zeige kundendaten;
-    kundennummer ist eingelesen := FALSE;
-    stop w2;
-    page (w1).
-  hitliste:
-    warten in w2;
-    hole auskunft ein (codenummer, 0, f);
-    zeige f.
-  kundenliste:
-    warten in w2;
-    hole auskunft ein (codenummer, 0, f);
-    zeige f.
-  zeige f:
-    pruefe abbruch;
-    cursor (2, 24);
-    out ("Weiter mit <ESC><q>;  Cursor bewegen: <Pfeile>");
-    show (w4, f);
-    cursor (1, 24); out (""5"");
-    evtl drucken.
- lageruebersicht:
-   warten in w2;
-
-   hole auskunft ein (codenummer, 0, f);
-   zeige f.
- kaeuferliste:
-   lies artikelnummer ein;
-   IF artikelnummer ist eingelesen
-      THEN artikelnummer ist eingelesen := FALSE;
-           warten in w2;
-           hole auskunft ein (codenummer, artikelnummer, f);
-           zeige f
-   FI.
- einkaufsliste:
-   lies kundennummer ein;
-   IF kundennummer ist eingelesen
-      THEN kundennummer ist eingelesen := FALSE;
-           warten in w2;
-           hole auskunft ein (codenummer, kundennummer, f);
-
-           zeige f
-   FI.
- evtl drucken:
-   WINDOW VAR  w :: window(46,18,22,3);
-   cursor off;
-   outframe (w);
-   IF yes (w, "Auskunft drucken", FALSE)
-      THEN drucke (headline (f))
-   FI;
-   cursor on;
-   forget (headline (f), quiet).
-END PROC auskunft;
-PROC rechnungskopf:
-  pruefe abbruch;
-  IF kundennummer ist eingelesen AND nachname <> ""
-     THEN ueberschrift := "    RECHNUNG für " + anrede + (vorname SUB 1) +
-                          ". " + text (nachname, 10)
-     ELSE ueberschrift := "    RECHNUNG"
-
-  FI;
-  summe := 0.0;
-  schreibe ueberschrift auf bildschirm;
-  schreibe in rechnungsdatei;
-  IF codekartenleser aktiviert
-     THEN lasse karte entfernen (FALSE)
-  FI.
-  schreibe in rechnungsdatei:
-    sysout ("WARENHAUS:Rechnung");
-    line;
-    put (ueberschrift);
-    line;
-    put ("   ==================================");
-    line (2);
-    sysout ("").
-  anrede:
-    IF   geschlecht = "m"
-         THEN "Herrn "
-    ELIF geschlecht = "w"
-         THEN "Frau "
-         ELSE ""
-
-    FI.
-END PROC rechnungskopf;
-PROC schreibe ueberschrift auf bildschirm:
-  INT VAR spalte, zeile;
-  get cursor (w3, spalte, zeile);
-  IF zeile = 1
-     THEN auf neuem blatt := TRUE;
-          schreibe in w3k
-     ELSE auf neuem blatt := FALSE;
-          schreibe in w3
-  FI.
-  schreibe in w3:
-    IF remaining lines (w3) < 7
-       THEN page (w3);
-            page (w3k);
-            auf neuem blatt := TRUE;
-            schreibe in w3k
-       ELSE line (w3);
-            out  (w3, ueberschrift);
-
-            line (w3);
-            out  (w3, "   ==================================");
-            line (w3, 2)
-    FI.
-  schreibe in w3k:
-            out  (w3k, ueberschrift);
-            line (w3k);
-            out  (w3k, "   ==================================").
-END PROC schreibe ueberschrift auf bildschirm;
-PROC artikel kaufen:
-  pruefe abbruch;
-  IF artikelnummer ist eingelesen
-     THEN kauf registrieren
-     ELSE setze variable in anfangszustand;
-          errorstop ("Es ist keine Artikelnummer eingelesen worden!")
-
-  FI;
-  IF codekartenleser aktiviert
-     THEN lasse karte entfernen (FALSE)
-  FI.
-  kauf registrieren:
-    artikelnummer ist eingelesen := FALSE;
-    IF bestand > 0
-       THEN artikel auf rechnung setzen;
-            registrieren
-       ELSE page (w2); out (""7"");
-            IF artikelname = ""
-               THEN out (w2, " Artikel hier nicht erhältlich!")
-               ELSE out (w2, " Der Artikel ist ausverkauft!")
-            FI;
-            line (w2, 2);
-            out (w2, " Weiter durch Tippen einer Taste");
-
-            pause
-    FI.
-  registrieren:
-    IF kundennummer ist eingelesen
-       THEN registriere verkauf (kundennummer, artikelnummer)
-       ELSE registriere verkauf (min kundennummer - 1, artikelnummer)
-    FI.
-    artikel auf rechnung setzen:
-      summe INCR preis;
-      IF remaining lines (w3) < 3
-         THEN beginne wieder oben
-      FI;
-      out  (w3, "    " + text (artikelname, 15) + text (preis, 12, 2));
-      line (w3);
-      sysout ("WARENHAUS:Rechnung");
-      put  ("    " + text (artikelname, 15) + text preis);
-
-      line;
-      sysout ("").
-      beginne wieder oben:
-        IF auf neuem blatt
-           THEN page (w3)
-           ELSE schreibe ueberschrift auf bildschirm
-       FI.
-      text preis:
-        TEXT VAR hilfe     :: text (preis, 12, 2);
-        INT  VAR vor punkt :: pos  (hilfe, ".") - 1;
-        IF (hilfe SUB vor punkt) = " "
-           THEN change (hilfe, vor punkt, vor punkt, "0")
-        FI;
-        hilfe.
-END PROC artikel kaufen;
-PROC abrechnung:
-  pruefe abbruch;
-  schreibe summe auf bildschirm;
-
-  schreibe summe in rechnungsdatei;
-  setze variable zurueck;
-  frage ob drucken;
-  IF codekartenleser aktiviert
-     THEN lasse karte entfernen (FALSE)
-  FI.
-  schreibe summe auf bildschirm:
-    IF remaining lines (w3) < 2
-       THEN beginne wieder oben
-    FI;
-    put  (w3, "                   -------------");
-    line (w3);
-    put  (w3, "    Summe          " + text (summe, 12, 2));
-    line (w3).
-  beginne wieder oben:
-    IF auf neuem blatt
-       THEN page (w3)
-       ELSE schreibe ueberschrift auf bildschirm
-
-    FI.
-  schreibe summe in rechnungsdatei:
-    sysout ("WARENHAUS:Rechnung");
-    put ("                   -------------");
-    line;
-    put ("    Summe          " + text (summe, 12, 2));
-    line;
-    sysout ("").
-  setze variable zurueck:
-    BOOL VAR alter wert :: ende gewuenscht;
-    setze variable in anfangszustand;
-    ende gewuenscht := alter wert.
-  frage ob drucken:
-    IF yes (w2, "Rechnung drucken", FALSE)
-       THEN cursor (3, 22);
-            disable stop;
-            print ("WARENHAUS:Rechnung");
-
-            IF is error THEN clear error FI;
-            enable stop
-    FI.
-END PROC abrechnung;
-PROC artikeldaten eingeben:
-  pruefe abbruch;
-  IF artikelnummer ist eingelesen
-     THEN lies artikeldaten ein;
-          artikeldaten speichern
-     ELSE setze variable in anfangszustand;
-          errorstop ("Es ist keine Artikelnummer eingelesen worden!")
-  FI.
-  lies artikeldaten ein:
-    zeige artikeldaten;
-    IF artikelname <> ""
-       THEN vielleicht schon fertig
-       ELSE page (w2)
-
-    FI;
-    REP line (w2);
-        put  (w2, " Artikeldaten eingeben");
-        eingabe
-    UNTIL yes (w2, "Alles richtig", TRUE)
-    PER;
-    artikelnummer ist eingelesen := FALSE.
-  vielleicht schon fertig:
-    IF yes (w2, "Alles richtig", TRUE)
-       THEN  artikelnummer ist eingelesen := FALSE;
-             IF codekartenleser aktiviert
-                THEN lasse karte entfernen (FALSE)
-             FI;
-             LEAVE artikeldaten eingeben
-    FI.
-  eingabe:
-    name holen;
-
-    preis holen;
-    mindestbestand holen;
-    bestand holen.
-  name holen:
-    REP cursor  (w1, 19, 6);
-        editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,
-                                              exit char);
-        teste auf abbruch
-    UNTIL artikelname <> "" PER.
-  preis holen:
-    hilfstext := text (preis, pos(text(preis),".") + 2, 2);
-    change (hilfstext, " ", "0");
-    REP cursor  (w1, 19, 8);
-        editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,
-
-                                          exit char);
-        change (hilfstext, ",", ".");
-        preis := round (real (hilfstext), 2);
-        teste auf abbruch
-    UNTIL preis >= 0.0 PER.
-  mindestbestand holen:
-    hilfstext := text (mindestbestand);
-    REP cursor  (w1, 19, 10);
-        editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,
-                                          exit char);
-        mindestbestand := int (hilfstext);
-        teste auf abbruch
-    UNTIL mindestbestand >= 0 PER.
-
-  bestand holen:
-    hilfstext := text (bestand);
-    REP cursor  (w1, 19, 12);
-        editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,
-                                          exit char);
-        bestand := int (hilfstext);
-        teste auf abbruch
-    UNTIL bestand >= 0 PER.
-  teste auf abbruch:
-    IF   exit char = esc + stopzeichen
-         THEN ende gewuenscht := TRUE
-    ELIF exit char = esc + abbruchzeichen
-         THEN setze variable in anfangszustand;
-              errorstop (1951, "Programm - Abbruch durch <ESC><"
-
-                                + abbruchzeichen + ">")
-    FI.
-END PROC artikeldaten eingeben;
-PROC kundendaten eingeben:
-  IF kundennummer ist eingelesen
-     THEN lies kundendaten ein;
-          kundendaten speichern
-  ELSE setze variable in anfangszustand;
-       errorstop ("Es ist keine Kundennummer eingelesen worden!")
-  FI.
-  lies kundendaten ein:
-    zeige kundendaten;
-    IF nachname <> ""
-       THEN vielleicht schon fertig
-       ELSE page (w2)
-    FI;
-    REP line (w2);
-
-        put  (w2, " Kundendaten eingeben");
-        eingabe
-    UNTIL  yes (w2, "Alles richtig", TRUE) PER;
-    kundennummer ist eingelesen := FALSE.
-  vielleicht schon fertig:
-    IF yes (w2, "Alles richtig", TRUE)
-       THEN  kundennummer ist eingelesen := FALSE;
-             IF codekartenleser aktiviert
-                THEN lasse karte entfernen (FALSE)
-             FI;
-             LEAVE kundendaten eingeben
-    FI.
-  eingabe:
-    nachname holen;
-    vorname holen;
-    geschlecht holen.
-
-  nachname holen:
-    REP cursor  (w1, 19, 6);
-        editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,
-                                           exit char);
-        teste auf abbruch
-    UNTIL nachname <> "" PER.
-  vorname holen:
-    REP cursor  (w1, 19, 8);
-        editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,
-                                          exit char);
-        teste auf abbruch
-    UNTIL vorname <> "" PER.
-  geschlecht holen:
-    REP cursor  (w1, 19, 10);
-
-        editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,
-                                           exit char);
-        geschlecht  := geschlecht SUB 1;
-        teste auf abbruch
-    UNTIL geschlecht = "m" OR geschlecht = "w" PER.
-  teste auf abbruch:
-    IF   exit char = esc + stopzeichen
-         THEN ende gewuenscht := TRUE
-    ELIF exit char = esc + abbruchzeichen
-         THEN setze variable in anfangszustand;
-              errorstop (1951, "Programm - Abbruch durch <ESC><"
-
-                                + abbruchzeichen + ">")
-    FI.
-END PROC kundendaten eingeben;
-PROC drucke (TEXT CONST name):
-  TEXT VAR zeile;
-  FILE VAR f :: sequential file (modify, name);
-  to line (f, 1);
-  insert record (f);
-  write  record (f, "#center#" + name);
-  down (f);
-  insert record (f);
-  down (f);
-  WHILE NOT eof (f) REP
-    read record (f, zeile);
-    IF pos (zeile, ""15"") > 0
-       THEN change (zeile, ""15"", "#on(""r"")#");
-            change (zeile, ""14"", "#off(""r"")#");
-
-            write record (f, zeile)
-    FI;
-    down (f)
-  PER;
-  cursor (3, 22);
-  print (name)
-END PROC drucke;
-PROC stop w2:
-  cursor off;
-  page (w2);
-  out (w2," Zum Weitermachen bitte");line(w2);
-  out (w2," irgendeine Taste tippen!");
-  pause;
-  page (w2);
-  cursor on
-END PROC stop w2;
-BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):
-  BOOL VAR antwort :: default;
-  TEXT VAR taste;
-  INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;
-  cursor off;
-  cursor (42,24); out ("Ändern: <Pfeile>  Bestätigen: <RETURN>");
-
-  page (w);
-  out (w, center (w, frage + " ?"));
-  cursor (w, ja pos, 3);
-  IF default
-     THEN  out (w, ""15"Ja "14" Nein ");
-           cursor (w, ja pos, 3)
-     ELSE  out (w, " Ja  "15"Nein "14"");
-           cursor (w, ja pos + 5, 3)
-  FI;
-  tastendruck auswerten;
-  page (w);
-  cursor (42,24); out (""5"");
-  cursor on;
-  antwort.
-  tastendruck auswerten:
-    REP inchar (taste);
-        SELECT code (taste) OF CASE  2,   8 : position aendern
-                               CASE      13 : LEAVE tastendruck auswerten
-
-                               CASE 74, 106 : antwort := TRUE;  (*Jj*)
-                                              LEAVE tastendruck auswerten
-                               CASE 78, 110 : antwort := FALSE; (*Nn*)
-                                              LEAVE tastendruck auswerten
-        OTHERWISE out (""7"")  END SELECT
-    PER.
-    position aendern:
-      IF antwort THEN antwort := FALSE;
-                      cursor (w, ja pos, 3);
-                      out (w, " Ja  "15"Nein "14"");
-
-                      cursor (w, ja pos + 5, 3)
-                 ELSE antwort := TRUE;
-                      cursor (w, ja pos, 3);
-                      out (w, ""15"Ja "14" Nein ");
-                      cursor (w, ja pos, 3)
-      FI.
-END PROC yes;
-PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):
-  IF erwuenscht
-     THEN rueckmeldung := 0;
-          codekartenleser aktiviert := FALSE;
-          schliesse interface
-     ELSE oeffne interface (rueckmeldung);
-          IF rueckmeldung >= 0
-
-             THEN codekartenleser aktiviert := TRUE
-             ELSE codekartenleser aktiviert := FALSE
-          FI
-  FI
-END PROC tastatureingabe;
-BOOL PROC eingabe mit codekartenleser:
-  codekartenleser aktiviert
-END PROC eingabe mit codekartenleser;
-PROC dezimalwert lesen:
-  pruefe abbruch;
-  IF codekartenleser aktiviert
-     THEN interfacewerte zeigen
-     ELSE setze variable in anfangszustand;
-          errorstop ("Eingabeart ist auf Tastatur eingestellt!")
-  FI.
-  interfacewerte zeigen:
-
-    cursor off;
-    fenster putzen;
-    line (w1, 4); line (w2);
-    out (w1, " Dezimalwert :");
-    out (w2, " Lesen beenden mit <ESC><q>");
-    ende gewuenscht := FALSE;
-    REP pruefe abbruch;
-        cursor (w1, 17, 5);
-        out (w1, text (wert von interface, 3))
-    UNTIL ende gewuenscht PER;
-    page (w2); cursor (w1, 1, 5); out ("                         ");
-    cursor on.
-END PROC dezimalwert lesen;
-PROC bitmuster lesen:
-  pruefe abbruch;
-  IF codekartenleser aktiviert
-
-     THEN interfacewerte zeigen
-     ELSE setze variable in anfangszustand;
-          errorstop ("Eingabeart ist auf Tastatur eingestellt!")
-  FI.
-  interfacewerte zeigen:
-    cursor off;
-    fenster putzen;
-    line (w1, 4); line (w2);
-    out (w1, " Bitmuster :");
-    out (w2, " Lesen beenden mit <ESC><q>");
-    ende gewuenscht := FALSE;
-    REP pruefe abbruch;
-        cursor (w1, 16, 5);
-        out (w1, bitmuster (wert von interface))
-    UNTIL ende gewuenscht PER;
-    page (w2); cursor (w1, 1, 5); out ("                         ");
-
-    cursor on.
-END PROC bitmuster lesen;
-TEXT PROC bitmuster (INT CONST wert):
-  INT VAR bitnr;
-  TEXT VAR muster :: "";
-  FOR bitnr FROM 7 DOWNTO 0 REP
-    IF bit (wert, bitnr)
-       THEN muster CAT "I"
-       ELSE muster CAT "O"
-    FI
-  PER;
-  muster
-END PROC bitmuster;
-PROC lasse karte entfernen (BOOL CONST mit rahmen):
-  IF wert von interface <> 255
-     THEN cursor off;
-          IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;
-          line (w2);
-          out (w2, " Bitte Karte entfernen");
-
-          REP pruefe abbruch
-          UNTIL (wert von interface = 255) OR ende gewuenscht PER;
-          cursor on
-  FI
-END PROC lasse karte entfernen;
-INT PROC gesicherter wert von interface (INT  CONST von, bis,
-                                         TEXT CONST kartenart):
-  INT VAR wert, zaehler;
-  ende gewuenscht := FALSE;
-  cursor off;
-  REP out (w2, " Bitte " + kartenart + " einschieben");
-      line (w2, 2);
-      out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");
-      cursor (79, 24);
-
-      gesicherten wert einlesen;
-      cursor (w1, 19, 2);
-      out (w1, text (wert, 3));
-      IF wert < von  OR  wert > bis
-         THEN warnung
-      FI
-  UNTIL wert >= von  AND  wert <= bis PER;
-  cursor on;
-  wert.
-  gesicherten wert einlesen:
-    REP zaehler := 0;
-        warte auf karte;
-        wert := wert von interface;
-        lies wert
-    UNTIL wert gesichert AND wert <> 255 PER.
-  warte auf karte:
-    REP beachte esc q
-    UNTIL wert von interface <> 255 PER.
-  beachte esc q:
-
-    pruefe abbruch;
-    IF ende gewuenscht
-       THEN cursor on;
-            LEAVE gesicherter wert von interface WITH 0
-    FI.
-  lies wert:
-    REP beachte esc q;
-        IF wert = wert von interface
-           THEN zaehler INCR 1
-           ELSE LEAVE lies wert
-        FI
-    UNTIL wert gesichert PER.
-    wert gesichert: zaehler = sicherheit.
-  warnung:
-    page (w2); out (""7"");
-    out (w2, " Dies ist keine " + kartenart + "!");
-    line (w2, 2);
-    out (w2, " Bitte Karte entfernen");
-
-    REP beachte esc q
-    UNTIL wert von interface = 255 PER;
-    page (w2).
-END PROC gesicherter wert von interface
-END PACKET ls warenhaus 3
-
-
diff --git a/warenhaus/ls-Warenhaus 4 b/warenhaus/ls-Warenhaus 4
deleted file mode 100644
index e90e60a..0000000
--- a/warenhaus/ls-Warenhaus 4
+++ /dev/null
@@ -1,421 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 4                    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 4 DEFINES                        
-       uebersetze:
-TYPE VOKABEL    = STRUCT (TEXT grin, elan),
-     REFINEMENT = STRUCT (TEXT name, INT aufruf);
-LET  befehlsanzahl         = 10,
-     max refinements       = 20,
-     max offene strukturen = 10,
-     schleife              =  1,
-     abfrage               =  2;
-ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :
-    (VOKABEL : ("Artikelnummerlesen",   "artikelnummer lesen"),
-     VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),
-     VOKABEL : ("Kundennummerlesen",    "kundennummer lesen"),
-
-
-     VOKABEL : ("Kundendateneingeben",  "kundendaten eingeben"),
-     VOKABEL : ("Rechnungskopf",        "rechnungskopf"),
-     VOKABEL : ("Artikelkaufen",        "artikel kaufen"),
-     VOKABEL : ("Abrechnung",           "abrechnung"),
-     VOKABEL : ("Auskunft",             "auskunft"),
-     VOKABEL : ("neuesBlatt",           "neues blatt"),
-     VOKABEL : ("Bildschirmneu",        "bildschirm neu"));
-ROW max refinements REFINEMENT VAR refinement;
-ROW max offene strukturen  INT VAR offene struktur;
-
-
-INT VAR zeilennummer, erster fehler;
-OP := (VOKABEL VAR links, VOKABEL CONST rechts):
-   CONCR (links) := CONCR (rechts)
-END OP :=;
-PROC uebersetze (TEXT CONST dateiname):
-forget ("elanprogramm", quiet);
-FILE VAR quelle :: sequential file (input, dateiname),
-         ziel   :: sequential file (output, "elanprogramm");
-suche programmanfang;
-WHILE NOT (eof (quelle) OR anything noted) REP
-  bearbeite zeile
-PER;
-IF NOT anything noted
-   THEN abschlusspruefung
-FI;
-IF anything noted
-   THEN quelle := sequential file (modify, dateiname);
-
-
-        to line (quelle, erster fehler);
-        col (1);
-        noteedit (quelle);
-        errorstop ("")
-FI.
-abschlusspruefung:
-  IF anzahl refinements > 0
-     THEN pruefe refinementliste
-     ELSE pruefe programmende
-  FI.
-pruefe programmende:
-  IF programmende fehlt
-     THEN zeilennummer INCR 1;
-          fehler (16)
-  FI.
-pruefe refinementliste:
-  zeilennummer INCR 1;
-  pruefe auf offene schleife oder abfrage;
-  put (ziel, "END PROC refinement " + text (letztes refinement));
-
-
-  FOR index FROM 1 UPTO anzahl refinements REP
-    IF refinement [index].aufruf > 0
-       THEN zeilennummer := refinement [index].aufruf;
-            fehler (25)
-    ELIF refinement [index].aufruf < 0
-       THEN zeilennummer := - refinement [index].aufruf;
-            fehler (26)
-    FI
-  PER.
-suche programmanfang:
-  TEXT VAR restzeile, zeile :: "";
-  BOOL VAR programmende fehlt := FALSE,
-           refinement muss folgen := FALSE;
-  INT VAR anzahl refinements := 0,
-          letztes refinement := 0,
-
-
-          letzte geoeffnete  := 0,
-          index;
-  zeilennummer       := 0;
-  erster fehler      := 0;
-  WHILE NOT eof (quelle) AND zeile = "" REP
-    getline (quelle, zeile);
-    zeile := compress (zeile);
-    zeilennummer INCR 1;
-    cout (zeilennummer);
-    IF zeile = "" THEN line (ziel) FI;
-  PER;
-  put (ziel, "bildschirm neu;");
-  IF zeile = "" THEN LEAVE uebersetze
-  ELIF pos (zeile, "PROGRAMM") = 1
-       THEN programmende fehlt := TRUE
-       ELSE fehler (1)
-  FI.
-bearbeite zeile:
-
-
-  zeilennummer INCR 1;
-  cout (zeilennummer);
-  getline (quelle, zeile);
-  zeile := compress (zeile);
-  change all (zeile, " ", "");
-  IF zeile = ""
-     THEN line (ziel)
-     ELSE analysiere und uebersetze
-  FI.
-analysiere und uebersetze:
-  IF refinement muss folgen
-     THEN erstes refinement
-     ELSE pruefe zunaechst auf schluesselworte;
-          durchsuche befehlsliste
-  FI.
-erstes refinement:
-  IF pos (zeile, ":") = 0
-     THEN fehler (19)
-  ELIF pos (zeile, ":") < length (zeile)
-
-
-     THEN fehler (20)
-  ELIF (pos (zeile, "PROGRAMM")   = 1) OR
-       (pos (zeile, "ENDE")       = 1) OR
-       (pos (zeile, "WIEDERHOLE") = 1) OR
-       (pos (zeile, "BIS")        = 1) OR
-       (pos (zeile, "WENN")       = 1)
-     THEN fehler (21)
-  ELIF (zeile = "Stoptastegedrückt:") OR
-       (zeile = "nichtStoptastegedrückt:") OR
-       (zeile = "Stoptastegedrueckt:") OR
-       (zeile = "nichtStoptastegedrueckt:")
-     THEN fehler (22)
-     ELSE refinement muss folgen := FALSE;
-
-
-          line (ziel);
-          trage befehlsdefinition ein
-  FI.
-trage befehlsdefinition ein:
-   change (zeile, ":", "");
-   FOR index FROM 1 UPTO anzahl refinements REP
-     IF refinement [index].name = zeile
-        THEN pruefe aufruf; LEAVE trage befehlsdefinition ein
-     FI
-   PER;
-   anzahl refinements INCR 1;
-   IF anzahl refinements > max refinements
-      THEN fehler (24)
-   ELSE refinement [anzahl refinements].name := zeile;
-        refinement [anzahl refinements].aufruf := - zeilennummer;
-
-
-        letztes refinement := anzahl refinements;
-        line (ziel);
-        put (ziel, "PROC refinement " + text (anzahl refinements) + ":")
-   FI.
-pruefe aufruf:
-  IF refinement [index].aufruf > 0
-     THEN refinement [index].aufruf := 0;
-          line (ziel);
-          put (ziel, "PROC refinement " + text (index) + ":");
-          letztes refinement := index
-     ELSE fehler (23)
-  FI.
-pruefe zunaechst auf schluesselworte:
-  IF   pos (zeile, "WIEDERHOLE") = 1
-       THEN oeffne schleife; LEAVE analysiere und uebersetze
-
-
-  ELIF pos (zeile, "WENN") = 1
-       THEN oeffne if; LEAVE analysiere und uebersetze
-  ELIF pos (zeile, "BIS")  = 1
-       THEN schliesse mit until; LEAVE analysiere und uebersetze
-  ELIF pos (zeile, "ENDE") = 1
-       THEN schliesse; LEAVE analysiere und uebersetze
-  ELIF pos (zeile, "PROGRAMM") = 1
-       THEN fehler (18); LEAVE analysiere und uebersetze
-  FI.
-oeffne schleife:
-  IF letzte geoeffnete = max offene strukturen
-     THEN fehler (2)
-     ELSE letzte geoeffnete INCR 1;
-          offene struktur [letzte geoeffnete] := schleife;
-
-
-          analysiere schleifenart
-  FI.
-analysiere schleifenart:
-  IF zeile = "WIEDERHOLE"
-     THEN line (ziel); put (ziel, "REPEAT")
-     ELSE es muss eine zaehlschleife sein
-  FI.
-es muss eine zaehlschleife sein:
-  restzeile := subtext (zeile, 11);
-  INT  VAR malpos := pos (restzeile, "MAL");
-  IF malpos > 0
-     THEN zaehlschleife
-     ELSE fehler (3)
-  FI.
-zaehlschleife:
-  IF length (restzeile) > malpos + 2
-     THEN fehler (4)
-     ELSE bestimme anzahl der wiederholungen
-  FI.
-
-
-bestimme anzahl der wiederholungen:
-  INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));
-  IF last conversion ok
-     THEN line (ziel);
-          put (ziel, "INT VAR index" + text (zeilennummer) +
-                     "; FOR index" + text (zeilennummer) +
-                     " FROM 1 UPTO " + text (wdh) + " REPEAT")
-     ELSE fehler (5)
-  FI.
-oeffne if:
-  IF letzte geoeffnete = max offene strukturen
-     THEN fehler (6)
-     ELSE letzte geoeffnete INCR 1;
-          offene struktur [letzte geoeffnete] := abfrage;
-
-
-          uebersetze abfrage
-  FI.
-uebersetze abfrage:
-  restzeile := subtext (zeile, 5);
-  IF   (restzeile = "Stoptastegedrückt") OR
-       (restzeile = "Stoptastegedrueckt")
-       THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN")
-  ELIF (restzeile = "nichtStoptastegedrückt") OR
-       (restzeile = "nichtStoptastegedrueckt")
-       THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN")
-  ELIF restzeile = ""
-       THEN fehler (7)
-       ELSE fehler (8)
-  FI.
-schliesse mit until:
-
-
-  teste ob als letztes schleife offen;
-  letzte geoeffnete DECR 1;
-  restzeile := subtext (zeile, 4);
-  IF   (restzeile = "Stoptastegedrückt") OR
-       (restzeile = "Stoptastegedrueckt")
-       THEN line (ziel);
-            put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");
-  ELIF (restzeile = "nichtStoptastegedrückt") OR
-       (restzeile = "nichtStoptastegedrueckt")
-       THEN line (ziel);
-            put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");
-  ELIF restzeile = ""
-
-
-       THEN fehler (9)
-       ELSE fehler (8)
-  FI.
-schliesse:
-  restzeile := subtext (zeile, 5);
-  IF restzeile = "WIEDERHOLE"
-     THEN schliesse schleife
-  ELIF restzeile = "WENN"
-     THEN schliesse if
-  ELIF restzeile = "PROGRAMM"
-     THEN programmende
-     ELSE fehler (10)
-  FI.
-schliesse schleife:
-  teste ob als letztes schleife offen;
-  letzte geoeffnete DECR 1;
-  line (ziel); put (ziel, "END REPEAT;").
-teste ob als letztes schleife offen:
-  IF letzte geoeffnete = 0
-     THEN fehler (11);
-
-
-          LEAVE bearbeite zeile
-  ELIF offene struktur [letzte geoeffnete] = abfrage
-     THEN fehler (12)
-  FI.
-schliesse if:
-  teste ob als letztes abfrage offen;
-  line (ziel); put (ziel, "END IF;");
-  letzte geoeffnete DECR 1.
-teste ob als letztes abfrage offen:
-  IF letzte geoeffnete = 0
-     THEN fehler (13);
-          LEAVE bearbeite zeile
-  ELIF offene struktur [letzte geoeffnete] = schleife
-     THEN fehler (14)
-  FI.
-programmende:
-  IF programmende fehlt
-     THEN programmende fehlt     := FALSE;
-
-
-          refinement muss folgen := TRUE
-     ELSE fehler (17);
-          LEAVE programmende
-  FI;
-  pruefe auf offene schleife oder abfrage.
-pruefe auf offene schleife oder abfrage:
-  IF letzte geoeffnete = 0
-     THEN alles okay
-  ELIF offene struktur [letzte geoeffnete] = schleife
-     THEN fehler (14)
-     ELSE fehler (12)
-  FI.
-  alles okay: .
-durchsuche befehlsliste:
-  IF pos (zeile, ":") > 0
-     THEN auf refinementdefinition pruefen
-     ELSE befehl suchen
-  FI.
-befehl suchen:
-
-
-  BOOL VAR gefunden := FALSE;
-  INT VAR i;
-  verhindere bedingung;
-  FOR i FROM 1 UPTO befehlsanzahl REP
-    IF befehl [i].grin = zeile
-       THEN gefunden := TRUE;
-            line (ziel);
-            put (ziel, befehl [i].elan + ";")
-    FI
-  UNTIL gefunden PER;
-  IF NOT gefunden
-     THEN trage in refinementliste ein
-  FI.
-auf refinementdefinition pruefen:
-  IF pos (zeile, ":") < length (zeile)
-     THEN fehler (20)
-  ELIF programmende fehlt
-     THEN fehler (16)
-  ELIF (zeile = "Stoptastegedrückt:") OR
-
-
-       (zeile = "nichtStoptastegedrückt:") OR
-       (zeile = "Stoptastegedrueckt:") OR
-       (zeile = "nichtStoptastegedrueckt:")
-     THEN fehler (22)
-     ELSE pruefe auf offene schleife oder abfrage;
-          put (ziel, "END PROC refinement " + text (letztes refinement)
-                                             + ";");
-          trage befehlsdefinition ein
-  FI.
-trage in refinementliste ein:
-  FOR index FROM 1 UPTO anzahl refinements REP
-    IF refinement [index].name = zeile
-
-
-       THEN trage evtl aufruf ein;
-            LEAVE trage in refinementliste ein
-    FI
-  PER;
-  anzahl refinements INCR 1;
-  IF anzahl refinements > max refinements
-     THEN fehler (24)
-     ELSE refinement [anzahl refinements].name := zeile;
-          refinement [anzahl refinements].aufruf := zeilennummer;
-          line (ziel);
-          put (ziel, "refinement " + text (anzahl refinements) + ";")
-  FI.
-trage evtl aufruf ein:
-  line (ziel);
-  put (ziel, "refinement " + text (index) + ";");
-
-
-  IF refinement [index].aufruf < 0
-     THEN refinement [index].aufruf := 0
-  FI.
-verhindere bedingung:
-  IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR
-     (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt")
-     THEN fehler (15);
-          LEAVE bearbeite zeile
-  FI.
-END PROC uebersetze;
-PROC fehler (INT CONST fehlernr):
-  noteline;
-  note ("FEHLER in Zeile " + text (zeilennummer) + ": ");
-  noteline;
-  note ("       " + anwendungstext (fehlernr + 20));
-
-
-  noteline;
-  IF erster fehler = 0
-     THEN erster fehler := zeilennummer
-  FI
-END PROC fehler
-END PACKET ls warenhaus 4
-
-
-
diff --git a/warenhaus/ls-Warenhaus 5 b/warenhaus/ls-Warenhaus 5
deleted file mode 100644
index 3a64e00..0000000
--- a/warenhaus/ls-Warenhaus 5
+++ /dev/null
@@ -1,1299 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                    ls-Warenhaus 5                    ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-PACKET ls warenhaus 5 DEFINES                        
-       warenhaus,
-       grin,
-       direktbefehl 1,
-       direktbefehl 2,
-       direktbefehl 3,
-       direktbefehl 4,
-       direktbefehl 5,
-       direktbefehl 6,
-       direktbefehl 7,
-       warenhausbefehle zeigen,
-       eingabe grundeinstellung,
-       tastatur einstellen,
-       kartenleser einstellen,
-       evtl d und b sperren,
-       loesche zwischenraum,
-       eingabeart anzeigen,
-       filialdaten zusammenstellen,
-       filialdaten eintragen,
-       filialdaten verzeichnis,
-
-       filialdaten umbenennen,
-       filialdaten loeschen,
-       warenhausprogramme verzeichnis,
-       warenhausprogramm neu erstellen,
-       warenhausprogramm ansehen,
-       warenhausprogramm kopieren,
-       warenhausprogramm umbenennen,
-       warenhausprogramme loeschen,
-       warenhausprogramme drucken,
-       warenhausprogramm starten,
-       warenhausprogramm wiederholen:
-LET  menukarte       = "ls-MENUKARTE:Warenhaus",
-     praefix         = "Filialdaten:",
-     filialdatentyp  =       1951,
-
-     niltext         =         "",
-     maxlaenge       =         45,
-     maxnamenslaenge =         35;
-TEXT VAR  filialdatenname :: "",
-          programmname    :: "";
-INT  VAR  fehlerzeile     :: 0;
-BOOL VAR  grin version    :: FALSE,
-          noch kein programm gelaufen :: TRUE,
-          bildschirm neu eingesetzt   :: FALSE;
-WINDOW VAR w :: window (1, 3, 79, 19);
-INITFLAG VAR in this task :: FALSE;
-PROC warenhausbefehle zeigen:
-  TEXT VAR info, liste, tasten;
-  INT  VAR grinoffset;
-
-  IF grin version
-     THEN grinbefehle
-     ELSE elanbefehle
-  FI;
-  REP
-   INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);
-   SELECT auswahl OF
-     CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset))
-     CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset))
-     CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset))
-   END SELECT
-  UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.
-  grinbefehle:
-    grinoffset := 13;
-    info := "       "15"Info zu den Programmierbefehlen "14""13""13""
-
-          + "          d  Datei - Bearbeitung           "13""
-          + "          e  Einkaufen und Auskunft        "13""
-          + "          k  Kontroll - Strukturen         "13""13""
-          + "          z  Zurück zum Hauptmenü          ";
-  liste  := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";
-  tasten := "dekzDEKZ".
-  elanbefehle:
-    grinoffset := 0;
-    info := "       "15"Info zu den Programmierbefehlen "14""13""13""
-          + "          d  Datei - Bearbeitung           "13""
-
-          + "          e  Einkaufen und Auskunft        "13""
-          + "          s  Sonstige Befehle              "13""13""
-          + "          z  Zurück zum Hauptmenü          ";
-  liste  := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";
-  tasten := "deszDESZ".
-END PROC warenhausbefehle zeigen;
-PROC eingabe grundeinstellung:
-  INT VAR dummy;
-  IF eingabe mit codekartenleser
-     THEN tastatureingabe (TRUE, dummy)
-  FI
-END PROC eingabe grundeinstellung;
-PROC tastatur einstellen:
-
-  eingabe grundeinstellung;
-  menuinfo (anwendungstext (6), 4)
-END PROC tastatur einstellen;
-PROC kartenleser einstellen:
-  INT VAR ergebnis;
-  IF eingabe mit codekartenleser
-     THEN tastatureingabe (TRUE, ergebnis)
-  FI;
-  pause (10);
-  tastatureingabe (FALSE, ergebnis);
-  IF ergebnis < 0
-     THEN menuinfo (anwendungstext (7 - ergebnis), 5)
-     ELSE menuinfo (anwendungstext (7), 4)
-  FI
-END PROC kartenleser einstellen;
-PROC loesche zwischenraum:
-  INT VAR zeile;
-  cursor (1, 2); out (79 * waagerecht + " ");
-
-  FOR zeile FROM 3 UPTO 22 REP
-    cursor (1, zeile); out (""5"");
-  PER;
-  cursor (1, 23); out (79 * waagerecht + " ");
-  cursor (1, 24); out (""5"");
-END PROC loesche zwischenraum;
-PROC ergaenze bildschirm:
-  cursor ( 1, 2); out (ecke oben links);
-  cursor (42, 2); out (balken oben);
-  cursor (80, 2); out (ecke oben rechts);
-  INT VAR zeile;
-  FOR zeile FROM 3 UPTO 22 REP
-    cursor ( 1, zeile); out (senkrecht);
-    cursor (42, zeile); out (senkrecht);
-    cursor (80, zeile); out (senkrecht)
-
-  PER;
-  cursor ( 1, 23); out (ecke unten links);
-  cursor (42, 23); out (balken unten);
-  cursor (80, 23); out (ecke unten rechts);
-  cursor (42, 19);
-  out (balken links + (37 * waagerecht) + balken rechts);
-  cursor w3 1 1
-END PROC ergaenze bildschirm;
-PROC zweite zeile:
-  cursor (1, 2); out (79 * waagerecht + " ")
-END PROC zweite zeile;
-PROC evtl d und b sperren:
-  IF eingabe mit codekartenleser
-     THEN activate ( 9);
-          activate (10)
-     ELSE deactivate ( 9);
-          deactivate (10)
-
-  FI
-END PROC evtl d und b sperren;
-PROC direktbefehl 1:
-  disable stop;
-  warendatei bearbeiten;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 1;
-PROC warendatei bearbeiten:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Warendatei bearbeiten"));
-  REP artikelnummer lesen;
-
-      IF NOT stoptaste gedrueckt
-         THEN artikeldaten eingeben
-      FI
-  UNTIL stoptaste gedrueckt PER
-END PROC warendatei bearbeiten;
-PROC direktbefehl 2:
-  disable stop;
-  kundendatei bearbeiten;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 2;
-PROC kundendatei bearbeiten:
-  enable stop;
-  loesche zwischenraum;
-
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Kundendatei bearbeiten"));
-  REP kundennummer lesen;
-      IF NOT stoptaste gedrueckt
-         THEN kundendaten eingeben
-      FI
-  UNTIL stoptaste gedrueckt PER
-END PROC kundendatei bearbeiten;
-PROC direktbefehl 3:
-  disable stop;
-  einkaufen gehen;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-
-  FI;
-  enable stop
-END PROC direktbefehl 3;
-PROC einkaufen gehen:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Einkaufen"));
-  forget ("WARENHAUS:Rechnung", quiet);
-  kundennummer lesen;
-  rechnungskopf;
-  REP   einkaufen
-  UNTIL stoptaste gedrueckt PER;
-  abrechnung;
-  forget ("WARENHAUS:Rechnung", quiet).
-  einkaufen:
-    artikelnummer lesen;
-    IF NOT stoptaste gedrueckt
-       THEN artikel kaufen
-    FI.
-END PROC einkaufen gehen;
-
-PROC direktbefehl 4:
-  disable stop;
-  auskunft einholen;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 4;
-PROC auskunft einholen:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Auskunft"));
-  auskunft
-END PROC auskunft einholen;
-PROC direktbefehl 5:
-  disable stop;
-
-  ware nachbestellen;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 5;
-PROC ware nachbestellen:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Nachbestellen"));
-  nachbestellen
-END PROC ware nachbestellen;
-PROC direktbefehl 6:
-  disable stop;
-  dezimalwerte von interface lesen;
-
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 6;
-PROC dezimalwerte von interface lesen:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Dezimalwert lesen"));
-  dezimalwert lesen
-END PROC dezimalwerte von interface lesen;
-PROC direktbefehl 7:
-  disable stop;
-
-  bitmuster von interface lesen;
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          menuinfo (" " + invers (errormessage));
-          clear error
-     ELSE zweite zeile;
-          menu bildschirm
-  FI;
-  enable stop
-END PROC direktbefehl 7;
-PROC bitmuster von interface lesen:
-  enable stop;
-  loesche zwischenraum;
-  ergaenze bildschirm;
-  cursor (2, 24); out (invers ("Bitmuster lesen"));
-  bitmuster lesen
-END PROC bitmuster von interface lesen;
-PROC eingabeart anzeigen:
-
-  IF eingabe mit codekartenleser
-     THEN menuinfo (anwendungstext (7), 4)
-     ELSE menuinfo (anwendungstext (6), 4)
-  FI
-END PROC eingabeart anzeigen;
-PROC warenhaus:
-  BOOL VAR am ende loeschen :: TRUE;
-  pruefe zulaessigkeit;
-  installiere menukarte mit anfangsbild;
-  initialisiere warenhaus;
-  handle menu ("WARENHAUS");
-  IF am ende loeschen
-     THEN sperre verwaltungstask;
-          end (task (verwaltung))
-  FI.
-  installiere menukarte mit anfangsbild:
-    install menu (menukarte, TRUE);
-
-    cursor off;
-    cursor (17, 20);
-    out (" W A R E N H A U S ");
-    cursor (21, 22);
-    out (invers("Filiale " + text (channel (myself))));
-    cursor (79, 24);
-    pause (10).
-  sperre verwaltungstask:
-    DATASPACE VAR ds;
-    INT VAR dummy;
-    forget (ds); ds := nilspace;
-    call (task (verwaltung), 256, ds, dummy).
-  pruefe zulaessigkeit:
-    IF   hauptstellenname = ""
-         THEN line;
-         putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");
-              end; LEAVE warenhaus
-
-    ELIF name (myself) = hauptstellenname
-         THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "
-                       + "Task aus gegeben werden!");
-              LEAVE warenhaus
-    FI.
- initialisiere warenhaus:
-  TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "
-                                            + text (channel (myself));
-  IF NOT exists task (verwaltung)
-     THEN initialisiere verwaltung
-     ELSE biete evtl loeschen an
-  FI;
-  IF NOT initialized (in this task)
-
-     THEN filialdatenname := "";
-          programmname    := ""
-  FI;
-  noch kein programm gelaufen := TRUE.
-  biete evtl loeschen an:
-    access catalogue;
-    IF NOT (father (task (verwaltung)) = myself)
-       THEN fehlermeldung;
-            line;
-            end;
-            am ende loeschen := FALSE
-    FI.
-    fehlermeldung:
-      cursor (1, 22);
-      putline ("Filiale " + text (channel (myself)) +
-               " ist bereits besetzt durch TASK '"
-               + name (father (task (verwaltung))) + "'!");
-
-      putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").
-END PROC warenhaus;
-PROC grin (BOOL CONST entscheidung):
-  enable stop;
-  IF hauptstellenname = "" OR hauptstellenname = name (myself)
-     THEN grin version := entscheidung
-     ELSE errorstop ("Dieser Befehl darf nur von der Task '" +
-                      hauptstellenname + "' aus gegeben werden!")
-  FI;
-  bildschirm neu eingesetzt := FALSE
-END PROC grin;
-PROC filialdaten verzeichnis:
-  disable stop;
-  THESAURUS VAR filialdaten ::
-
-  ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);
-  forget ("Verzeichnis der Filialdaten-Dateien", quiet);
-  FILE VAR f ::
-  sequential file (output, "Verzeichnis der Filialdaten-Dateien");
-  f FILLBY filialdaten;
-  modify (f);
-  to line (f, 1); insert record (f);
-  menufootnote ("Verlassen: <ESC> <q>");
-  cursor on;
-  show (w, f);
-  cursor off;
-  forget ("Verzeichnis der Filialdaten-Dateien", quiet);
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop
-END PROC filialdaten verzeichnis;
-PROC warenhausprogramme verzeichnis:
-  disable stop;
-  forget ("Verzeichnis der Programme", quiet);
-  THESAURUS VAR programme ::
-  ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-  IF exists ("WARENHAUS:Rechnung")
-     THEN programme := programme - "WARENHAUS:Rechnung"
-  FI;
-  FILE VAR f ::
-  sequential file (output, "Verzeichnis der Programme");
-
-  f FILLBY programme;
-  modify (f);
-  to line (f, 1); insert record (f);
-  menufootnote ("Verlassen: <ESC> <q>");
-  cursor on;
-  show (w, f);
-  cursor off;
-  forget ("Verzeichnis der Programme", quiet);
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop
-END PROC warenhausprogramme verzeichnis;
-PROC filialdaten zusammenstellen:
-  hole filialdatenname;
-
-  kontrolliere den filialdatennamen;
-  disable stop;
-  sichere filialdaten (praefix + filialdatenname);
-  IF is error
-     THEN out (""7"");
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE bestaetige
-  FI;
-  enable stop.
-  hole filialdatenname:
-    filialdatenname :=  menuanswer (ausgabe, filialdatenname, 5).
-  ausgabe:
-    center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""
-                   + " Bitte den Namen für die Filialdaten "13""13"".
-
-  kontrolliere den filialdatennamen:
-    IF   filialdatenname = niltext
-         THEN enable stop; LEAVE filialdaten zusammenstellen
-    ELIF length (filialdatenname) > maxnamenslaenge
-         THEN meckere zu langen namen an;
-              filialdatenname := niltext;
-              enable stop; LEAVE filialdaten zusammenstellen
-    ELIF exists (praefix + filialdatenname)
-         THEN meckere existierenden filialdatennamen an;
-              enable stop; LEAVE filialdaten zusammenstellen
-
-    FI.
-    bestaetige:
-      menuinfo ("           "15"Bestätigung "14" "13""13"" +
-                "  Die  Filialdaten  wurden von der  "13"" +
-                "  Verwaltung unter dem gewünschten  "13"" +
-                "  Namen zusammengestellt.           "13"" , 3).
-END PROC filialdaten zusammenstellen;
-PROC warenhausprogramm neu erstellen:
-  hole programmname;
-  kontrolliere den programmnamen;
-  command dialogue (FALSE);
-  cursor on;
-  disable stop;
-  stdinfoedit (programmname, 3);
-
-  cursor off;
-  command dialogue (TRUE);
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers (errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop.
-  hole programmname:
-    programmname := "";
-    programmname :=  menuanswer (ausgabe, programmname, 5).
-  ausgabe:
-    center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""
-                 + " Bitte den Namen für das Programm "13""13"".
-  kontrolliere den programmnamen:
-
-    IF   programmname = niltext
-         THEN LEAVE warenhausprogramm neu erstellen
-    ELIF length (programmname) > maxnamenslaenge
-         THEN meckere zu langen namen an;
-              programmname := niltext;
-              LEAVE warenhausprogramm neu erstellen
-    ELIF exists (programmname)
-         THEN meckere existierendes programm an;
-              LEAVE warenhausprogramm neu erstellen
-    FI.
-END PROC warenhausprogramm neu erstellen;
-PROC warenhausprogramm ansehen:
-  IF programmname <> niltext CAND exists (programmname)
-
-     THEN frage nach diesem programm
-     ELSE lasse programm auswaehlen
-  FI;
-  cursor on;
-  disable stop;
-  stdinfoedit (programmname, 3);
-  cursor off;
-  IF is error
-     THEN regenerate menuscreen;
-          out (""7"");
-          menuinfo  (" " + invers ("FEHLER: " + errormessage));
-          clear error
-     ELSE menu bildschirm
-  FI;
-  enable stop.
-  frage nach diesem programm:
-    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name
-              + " Soll mit diesem Programm gearbeitet werden", 5)
-
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare ::
-    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-    IF exists ("WARENHAUS:Rechnung")
-       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
-    FI;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-
-            LEAVE warenhausprogramm ansehen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    programmname := menuone (verfuegbare, "Programm ansehen/ändern",
-                             "Bitte das gewünschte Programm ankreuzen!",
-                              FALSE);
-    IF programmname = niltext
-       THEN menu bildschirm;
-            LEAVE warenhausprogramm ansehen
-    FI.
-END PROC warenhausprogramm ansehen;
-PROC filialdaten eintragen:
-  lasse filialdaten auswaehlen;
-
-  trage filialdaten ein;
-  menu bildschirm.
-  lasse filialdaten auswaehlen:
-    THESAURUS VAR verfuegbare ::
-    ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);
-    IF NOT not empty (verfuegbare)
-       THEN noch keine filialdaten;
-            LEAVE filialdaten eintragen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, bezeichnung,
-    "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).
-  trage filialdaten ein:
-
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers (bezeichnung)));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (schlussbemerkung);
-    menuwindowstop.
-  bezeichnung:
-    "Filialdaten eintragen/ergänzen".
-  schlussbemerkung:
-    " Alle ausgewählten Filialdaten wurden eingetragen!".
-  fuehre einzelne operationen aus:
-
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              menuwindowout ( " Filialdaten """ + name (verfuegbare, k)
-                                    + """ werden eingetragen!");
-              menuwindowline;
-              lade filialdaten (praefix + name (verfuegbare, k));
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");
-            menuwindowstop;
-            menu bildschirm;
-            LEAVE filialdaten eintragen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen; out (""7"");
-            menuinfo  (" " + invers (errormessage));
-
-            clear error; enable stop;
-            LEAVE filialdaten eintragen
-       ELSE enable stop
-    FI.
-END PROC filialdaten eintragen;
-PROC warenhausprogramme drucken:
-  lasse programme auswaehlen;
-  drucke programme;
-  menu bildschirm.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare ::
-    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-    IF exists ("WARENHAUS:Rechnung")
-       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
-    FI;
-    IF NOT not empty (verfuegbare)
-
-       THEN noch kein programm;
-            LEAVE warenhausprogramme drucken
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, "Programme drucken",
-                   "Bitte die Programme ankreuzen, die gedruckt werden sollen!",
-                    FALSE).
-  drucke programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers ("Programme drucken")));
-    menuwindowline (2);
-    command dialogue (FALSE);
-
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              menuwindowout ( " """ + name (verfuegbare, k) +
-                              """ wird gedruckt!");
-              menuwindowline;
-
-              print (name (verfuegbare, k));
-              fehlerbehandlung
-      FI
-    PER.
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde kein Programm ausgewählt!");
-            menuwindowstop;
-            menu bildschirm;
-            LEAVE warenhausprogramme drucken
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen; out (""7"");
-            menuinfo  (" " + invers (errormessage));
-            clear error; enable stop;
-            LEAVE warenhausprogramme drucken
-       ELSE enable stop
-    FI.
-END PROC warenhausprogramme drucken;
-PROC warenhausprogramm kopieren:
-  ermittle alten programmnamen;
-  erfrage neuen programmnamen;
-  kopiere ggf das programm.
-  ermittle alten programmnamen:
-    IF NOT not empty (bestand)
-
-       THEN noch kein programm;
-            LEAVE warenhausprogramm kopieren
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, "Programm kopieren",
-            "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);
-    menu bildschirm;
-    IF alter name = niltext
-       THEN LEAVE warenhausprogramm kopieren
-    FI.
-  bestand:
-    ALL myself - infix namen (ALL myself, praefix, filialdatentyp)
-               - "WARENHAUS:Rechnung".
-
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + " Name des 'alten' Programms: " + bisheriger name
-                  + " Bitte den Namen für die Kopie: ".
-  ueberschrift:
-    center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  kopiere ggf das programm:
-    IF   neuer name = niltext
-         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
-
-              LEAVE warenhausprogramm kopieren
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE warenhausprogramm kopieren
-       ELSE copy (alter name, neuer name)
-    FI.
-  mache vorwurf:
-    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).
-END PROC warenhausprogramm kopieren;
-PROC filialdaten umbenennen:
-  ermittle alten filialdatennamen;
-  erfrage neuen filialdatennamen;
-  benenne ggf die filialdaten um.
-  ermittle alten filialdatennamen:
-
-    IF NOT not empty (bestand)
-       THEN noch keine filialdaten;
-            LEAVE filialdaten umbenennen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);
-    menu bildschirm;
-    IF alter name = niltext
-       THEN LEAVE filialdaten umbenennen
-    FI.
-  bestand:
-    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).
-  text1: "Filialdaten umbenennen".
-  text2:
-    "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .
-
-  erfrage neuen filialdatennamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
-  ueberschrift:
-    center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".
-  hinweis auf alt:
-    " Bisheriger  Filialdaten-Name: ".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-  aufforderung:
-    " Zukünftiger Filialdaten-Name: ".
-  benenne ggf die filialdaten um:
-    IF   neuer name = niltext
-
-         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
-              LEAVE filialdaten umbenennen
-    ELIF exists (praefix + neuer name)
-         THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));
-              LEAVE filialdaten umbenennen
-    ELSE rename (praefix + alter name, praefix + neuer name);
-         filialdatenname := neuer name
-    FI.
-END PROC filialdaten umbenennen;
-PROC warenhausprogramm umbenennen:
-  ermittle alten programmnamen;
-
-  erfrage neuen programmnamen;
-  benenne ggf das programm um.
-  ermittle alten programmnamen:
-    IF NOT not empty (bestand)
-       THEN noch kein programm;
-            LEAVE warenhausprogramm umbenennen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",
-        "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);
-    menu bildschirm;
-    IF alter name = niltext
-       THEN LEAVE warenhausprogramm umbenennen
-
-    FI.
-  bestand:
-    ALL myself - infix namen (ALL myself, praefix, filialdatentyp)
-               - "WARENHAUS:Rechnung".
-  erfrage neuen programmnamen:
-    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
-  ausgabe:
-     ueberschrift + " Bisheriger  Programmname: " + bisheriger name
-                  + " Zukünftiger Programmname: ".
-  ueberschrift:
-    center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".
-  bisheriger name:
-    ""13""13" " + invers (alter name) + ""13""13"".
-
-  benenne ggf das programm um:
-    IF   neuer name = niltext
-         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
-              LEAVE warenhausprogramm umbenennen
-    ELIF exists (neuer name)
-         THEN mache vorwurf;
-              LEAVE warenhausprogramm umbenennen
-       ELSE rename (alter name, neuer name);
-            programmname := neuer name
-    FI.
-  mache vorwurf:
-    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).
-END PROC warenhausprogramm umbenennen;
-
-PROC filialdaten loeschen:
-  lasse filialdaten auswaehlen;
-  loesche filialdaten;
-  menu bildschirm.
-  lasse filialdaten auswaehlen:
-    THESAURUS VAR verfuegbare ::
-    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);
-    IF NOT not empty (verfuegbare)
-       THEN noch keine filialdaten;
-            LEAVE filialdaten loeschen
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",
-    "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).
-
-  loesche filialdaten:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-    menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              IF menuwindowyes (" """ + name (verfuegbare, k)
-                                      + """ löschen")
-                 THEN forget (praefix + name (verfuegbare, k), quiet)
-              FI;
-              fehlerbehandlung
-      FI
-    PER;
-    filialdatenname := "".
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");
-
-            menuwindowstop;
-            menu bildschirm;
-            LEAVE filialdaten loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            menuinfo  (" " + invers (errormessage));
-            clear error; enable stop;
-            LEAVE filialdaten loeschen
-       ELSE enable stop
-    FI.
-
-END PROC filialdaten loeschen;
-PROC warenhausprogramme loeschen:
-  lasse programme auswaehlen;
-  loesche programme;
-  menu bildschirm.
-  lasse programme auswaehlen:
-    THESAURUS VAR verfuegbare ::
-              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-    IF exists ("WARENHAUS:Rechnung")
-       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
-    FI;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE warenhausprogramme loeschen
-
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    verfuegbare := menusome (verfuegbare, "Programm löschen",
-    "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).
-  loesche programme:
-    show menuwindow;
-    steige ggf bei leerem thesaurus aus;
-    menuwindowout (menuwindowcenter (invers ("Programme löschen")));
-    menuwindowline (2);
-    command dialogue (FALSE);
-    fuehre einzelne operationen aus;
-    command dialogue (TRUE);
-    schlage ggf neue seite auf;
-
-    menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");
-    menuwindowstop.
-  fuehre einzelne operationen aus:
-    INT VAR k;
-    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
-      IF name (verfuegbare, k) <> ""
-         THEN disable stop;
-              IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen")
-                 THEN forget (name (verfuegbare, k), quiet)
-              FI;
-              fehlerbehandlung
-      FI
-    PER;
-    programmname := "".
-
-  steige ggf bei leerem thesaurus aus:
-    IF NOT not empty (verfuegbare)
-       THEN menuwindowline (2);
-            menuwindowout (" Es wurde kein Programm ausgewählt!");
-            menuwindowstop;
-            menu bildschirm;
-            LEAVE warenhausprogramme loeschen
-    FI.
-  schlage ggf neue seite auf:
-    IF remaining menuwindowlines < 7
-       THEN menuwindowpage; menuwindowline
-       ELSE menuwindowline (2)
-    FI.
-  fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen; out (""7"");
-
-            menuinfo  (" " + invers (errormessage));
-            clear error; enable stop;
-            LEAVE warenhausprogramme loeschen
-       ELSE enable stop
-    FI.
-END PROC warenhausprogramme loeschen;
-PROC warenhausprogramm starten:
-  IF grin version
-     THEN warenhausprogramm uebersetzen und starten
-     ELSE warenhausprogramm direkt starten
-  FI
-END PROC warenhausprogramm starten;
-PROC warenhausprogramm direkt starten:
-  programmname ermitteln;
-  bildschirm neu eingesetzt := FALSE;
-
-  untersuche programmdatei auf bildschirm neu;
-  cursor w3 1 1;
-  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");
-  cursor on;
-  check on;
-  warnings off;
-  disable stop;
-  run (programmname);
-  noch kein programm gelaufen := FALSE;
-  IF bildschirm neu eingesetzt
-     THEN entferne befehl aus programmdatei
-  FI;
-  cursor off;
-  fehlerbehandlung;
-  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
-  cursor (2,24);
-  out ("Das Programm ist beendet. " +
-
-       "Zum Weitermachen bitte irgendeine Taste tippen!");
-  pause;
-  regenerate menuscreen.
-  fehlerbehandlung:
-    IF is error
-       THEN fehler ggf melden
-       ELSE enable stop
-    FI.
-  fehler ggf melden:
-    IF errormessage = ""
-       THEN regenerate menuscreen
-       ELSE fehler melden
-    FI;
-    clear error; enable stop;
-    LEAVE warenhausprogramm direkt starten.
-  fehler melden:
-    out (""7"");
-    IF errorcode = 1  OR  errorcode = 1951
-       THEN regenerate menuscreen;
-
-            menuinfo  (" " + invers (errormessage))
-       ELSE programm mit fehler zeigen;
-            regenerate menuscreen
-    FI.
-  programmname ermitteln:
-    IF programmname <> niltext CAND exists (programmname)
-       THEN frage nach diesem programm
-       ELSE lasse programm auswaehlen
-    FI.
-  frage nach diesem programm:
-    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +
-               name + " Soll mit diesem Programm gearbeitet werden", 5)
-       THEN lasse programm auswaehlen
-
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers ("Programm starten")) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare ::
-              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-    IF exists ("WARENHAUS:Rechnung")
-       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
-    FI;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE warenhausprogramm direkt starten
-
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    programmname := menuone (verfuegbare, "Programm starten",
-                    "Bitte das gewünschte Programm ankreuzen!", FALSE);
-    menubildschirm;
-    menufootnote ("");
-    IF programmname = niltext
-       THEN LEAVE warenhaus programm direkt starten
-    FI.
-  untersuche programmdatei auf bildschirm neu:
-    FILE VAR a :: sequential file (modify, programmname);
-    TEXT VAR zeile;
-    to line (a, 1);
-    REP
-      read record (a, zeile);
-
-      IF NOT eof (a) THEN down (a) FI
-    UNTIL zeile <> "" OR eof (a) PER;
-    change all (zeile, " ", "");
-    IF pos (zeile, "bildschirmneu") = 0
-       THEN setze befehl in datei ein
-    FI.
-  setze befehl in datei ein:
-    to line (a, 1);
-    zeile := "bildschirm neu; (* ergänzt *)";
-    insert record (a);
-    write record (a, zeile);
-    bildschirm neu eingesetzt := TRUE.
-  entferne befehl aus programmdatei:
-    FILE VAR b :: sequential file (modify, programmname);
-    to line (b, 1);
-
-    REP
-      read record (b, zeile);
-      IF NOT eof (b) THEN down (b) FI
-    UNTIL zeile <> "" OR eof (b) PER;
-    change all (zeile, " ", "");
-    IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0
-       THEN up (b); delete record (b)
-    FI.
-END PROC warenhausprogramm direkt starten;
-PROC warenhausprogramm uebersetzen und starten:
-  programmname ermitteln;
-  cursor w3 1 1;
-  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");
-  cursor on;
-  disable stop;
-  uebersetze (programmname);
-
-  IF NOT is error
-     THEN check on;
-          warnings off;
-          run ("elanprogramm");
-          noch kein programm gelaufen := FALSE
-  FI;
-  forget ("elanprogramm", quiet);
-  cursor off;
-  fehlerbehandlung;
-  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
-  cursor (2,24);
-  out ("Das Programm ist beendet. " +
-       "Zum Weitermachen bitte irgendeine Taste tippen!");
-  pause;
-  regenerate menuscreen.
-  fehlerbehandlung:
-    IF is error
-       THEN fehler ggf melden
-
-       ELSE enable stop
-    FI.
-  fehler ggf melden:
-    IF errormessage = ""
-       THEN regenerate menuscreen
-       ELSE fehler melden
-    FI;
-    clear error; enable stop;
-    LEAVE warenhausprogramm uebersetzen und starten.
-  fehler melden:
-    out (""7"");
-    IF errorcode = 1  OR  errorcode = 1951
-       THEN regenerate menuscreen;
-            menuinfo  (" " + invers (errormessage))
-       ELSE programm mit fehler zeigen ;
-            regenerate menuscreen
-    FI.
- programmname ermitteln:
-
-    IF programmname <> niltext CAND exists (programmname)
-       THEN frage nach diesem programm
-       ELSE lasse programm auswaehlen
-    FI.
-  frage nach diesem programm:
-    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +
-               name + " Soll mit diesem Programm gearbeitet werden", 5)
-       THEN lasse programm auswaehlen
-    FI.
-  ueberschrift:
-    center (maxlaenge, invers ("Programm starten")) + ""13""13"".
-  name:
-    ""13""13" " + invers (programmname) + ""13""13"".
-
-  lasse programm auswaehlen:
-    THESAURUS VAR verfuegbare ::
-              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
-    IF exists ("WARENHAUS:Rechnung")
-       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
-    FI;
-    IF NOT not empty (verfuegbare)
-       THEN noch kein programm;
-            LEAVE warenhausprogramm uebersetzen und starten
-       ELSE biete auswahl an
-    FI.
-  biete auswahl an:
-    programmname := menuone (verfuegbare, "Programm starten",
-
-                    "Bitte das gewünschte Programm ankreuzen!", FALSE);
-    menubildschirm;
-    menufootnote ("");
-    IF programmname = niltext
-       THEN LEAVE warenhaus programm uebersetzen und starten
-    FI.
-END PROC warenhausprogramm uebersetzen und starten;
-PROC programm mit fehler zeigen:
-  IF exists (programmname)
-    THEN noteline;
-         note (fehlermeldung mit zeilennummer);
-         INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;
-         note (invers ("Verlassen: <ESC><q>"));
-
-         FILE VAR f :: sequential file (modify, programmname);
-         to line (f, max (1, fehlerzeile));
-         col (1);
-         clear error;
-         cursor on;
-         noteedit (f);
-        cursor off
-    ELSE menuinfo (invers (fehlermeldung mit zeilennummer))
-  FI
-END PROC programm mit fehler zeigen;
-PROC warenhausprogramm wiederholen:
-  cursor on;
-  disable stop;
-  IF noch kein programm gelaufen
-     THEN errorstop ("'run again' nicht moeglich")
-     ELSE runagain
-  FI;
-
-  cursor off;
-  fehlerbehandlung;
-  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
-  cursor (2,24);
-  out ("Das Programm ist beendet. " +
-       "Zum Weitermachen bitte irgendeine Taste tippen!");
-  pause;
-  regenerate menuscreen.
-fehlerbehandlung:
-    IF is error
-       THEN regenerate menuscreen;
-            fehler melden;
-            clear error; enable stop;
-            LEAVE warenhausprogramm wiederholen
-       ELSE enable stop
-    FI.
-  fehler melden:
-
-    out (""7"");
-    IF errorcode = 1  OR  errorcode = 1951
-       THEN menuinfo  (" " + invers (errormessage))
-    ELIF errormessage = "'run again' nicht moeglich"
-       THEN menuinfo  (" " + invers ("Wiederholung nicht möglich!"))
-       ELSE menuinfo  (" " + invers (fehlermeldung mit zeilennummer))
-    FI
-END PROC warenhausprogramm wiederholen;
-TEXT PROC fehlermeldung mit zeilennummer:
-  TEXT VAR meldung :: "FEHLER: " + errormessage;
-  fuege ggf fehlerzeile an;
-  IF length (meldung) < 70
-
-     THEN meldung
-     ELSE subtext (meldung, 1, 69)
-  FI.
-  fuege ggf fehlerzeile an:
-    fehlerzeile := errorline;
-    IF errorline < 1
-       THEN LEAVE fuege ggf fehlerzeile an
-    ELIF bildschirm neu eingesetzt
-       THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"
-       ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"
-    FI.
-END PROC fehlermeldung mit zeilennummer;
-PROC meckere zu langen namen an:
-  menuinfo (" " + invers ("Hier dürfen Namen höchstens "
-
-                + text (max namenslaenge)
-                + " Zeichen lang sein!"))
-END PROC meckere zu langen namen an;
-PROC meckere existierenden filialdatennamen an:
-  menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!"))
-END PROC meckere existierenden filialdatennamen an;
-PROC meckere existierendes programm an:
-  menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!"))
-END PROC meckere existierendes programm an;
-PROC noch keine filialdaten:
-  menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!"))
-
-END PROC noch keine filialdaten;
-PROC noch kein programm:
-  menuinfo (" " + invers ("Es existiert noch kein Programm!"))
-END PROC noch kein programm;
-PROC menu bildschirm:
-  cursor (1, 2);
-  out (5 * waagerecht);
-  cursor (1, 3);
-  out (""4"");
-  cursor (1, 23);
-  out (79 * waagerecht);
-  refresh submenu
-END PROC menu bildschirm
-END PACKET ls warenhaus 5
-
-
diff --git a/warenhaus/ls-Warenhaus-gen b/warenhaus/ls-Warenhaus-gen
deleted file mode 100644
index 2e0476e..0000000
--- a/warenhaus/ls-Warenhaus-gen
+++ /dev/null
@@ -1,95 +0,0 @@
-(* 
-        
-         ********************************************************** 
-         ********************************************************** 
-         **                                                      ** 
-         **                   ls-Warenhaus/gen                   ** 
-         **                                                      ** 
-         **                     Version 1.01                     ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                  (Stand:  30.08.89)                  ** 
-         **                                                      ** 
-         **                                                      ** 
-         **                                                      ** 
-         **           Autor: Bruno Pollok, Bielefeld             ** 
-         **                                                      ** 
-         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
-         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
-         **                                                      ** 
-         ********************************************************** 
-         ********************************************************** 
- 
-                                                                           *) 
-LET kartenleserkennung = "ls-Warenhaus 0: mit Kartenleser";
-baue bildschirm auf;
-schicke menukarte ab;
-erfrage anpassung;
-check off;
-warnings off;
-insertiere (anpassung);
-loesche alle anpassungen;
-insertiere ("ls-Warenhaus 1");
-insertiere ("ls-Warenhaus 2");
-insertiere ("ls-Warenhaus 3");
-insertiere ("ls-Warenhaus 4");
-insertiere ("ls-Warenhaus 5");
-check on;
-frage nach grin;
-frage nach hauptstelle.
-baue bildschirm auf:
-  page;
-  cursor (18, 1);
-  out (invers ("ls-Warenhaus :  Automatische Generierung"));
-  line (3).
-erfrage anpassung:
-
-  WINDOW VAR w :: window (1, 1, 79, 24);
-  TEXT VAR anpassung :: boxone (w, alle kartenleser,
-           "Auswahl einer Interface - Anpassung für den Codekartenleser",
-           "Wenn kein Kartenleser benutzt wird, <ESC><q> tippen!", FALSE);
-  IF anpassung = ""
-     THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser"
-  FI;
-  baue bildschirm auf.
-alle kartenleser:
-  infix namen (ALL myself, kartenleserkennung).
-loesche alle anpassungen:
-  command dialogue (FALSE);
-  forget (infixnamen (ALL myself, "ls-Warenhaus 0"));
-
-  forget ("--------------------------------------------------------",quiet);
-  command dialogue (TRUE).
-schicke menukarte ab:
-  command dialogue (FALSE);
-  save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN");
-  command dialogue (TRUE);
-  forget ("ls-MENUKARTE:Warenhaus", quiet);
-  forget ("ls-Warenhaus/gen", quiet).
-frage nach grin:
-  line;
-  IF yes ("Version für GRIN")
-     THEN do ("grin (TRUE)")
-     ELSE do ("grin (FALSE)")
-  FI.
-frage nach hauptstelle:
-  line (2);
-  IF yes ("Soll diese Task Warenhaus - Hauptstelle sein")
-
-     THEN do ("warenhaus hauptstelle (TRUE)")
-     ELSE global manager
-  FI.
-;
-PROC insertiere (TEXT CONST dateiname):
-  INT VAR s, z;
-  out ("'" + dateiname + "'");
-  get cursor (s, z);
-  out (" wird insertiert.  ");
-  insert (dateiname);
-  forget (dateiname, quiet);
-  cursor (s, z);
-  out (""4"") ;
-  line
-END PROC insertiere
-
-